From 2de1cf4d051f9b3f1b84b62c62606cb6265a2d6c Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Thu, 12 Nov 2026 09:12:16 +0000 Subject: [PATCH 01/23] Checkpoint compiling Apollonian superharmonic port --- LeanPool/ApollonianSuperharmonic.lean | 39 + .../AcyclicIndegreeOrientation.lean | 53 + .../AffineOpposingStripCorridor.lean | 1281 +++++ .../AffineTriangularComplexChart.lean | 74 + .../AffineTriangularCorridorStep.lean | 65 + .../AffineTriangularFace.lean | 36 + .../AffineTriangularFaceCoordinateSwap.lean | 47 + .../AffineTriangularFaceVertices.lean | 42 + .../AffineTriangularNoFourfoldCellOwners.lean | 209 + .../AffineTriangularPlaneTriangulation.lean | 1248 +++++ .../AffineTriangularStrip.lean | 675 +++ .../AllowedSubtileIncidence.lean | 65 + ...owedSubtileIncidenceZeroOppositeChord.lean | 180 + .../AncestorOdometer.lean | 44 + .../AncestorOdometerCentralCovariance.lean | 94 + ...storOdometerInnerSupportNormalization.lean | 97 + ...storOdometerOuterSupportNormalization.lean | 90 + .../AncestorOdometerRestriction.lean | 620 +++ .../AncestorOdometerTrans.lean | 39 + .../ApollonianSuperharmonic/AncestorTile.lean | 56 + .../AncestorTileCentralCovariance.lean | 189 + .../BandCanonicalPeriodicExtension.lean | 244 + .../ApollonianSuperharmonic/BandCircle.lean | 35 + .../BandCircleEnclosureDichotomy.lean | 176 + .../BandCircleEuclideanData.lean | 42 + .../BandDescartesGapSubdivision.lean | 157 + .../BandDiskExteriorDensity.lean | 162 + .../BandDoubleDecomposition.lean | 1008 ++++ ...BandExceptionalRestorationSectorOrder.lean | 1584 ++++++ .../BandGenealogy.lean | 156 + .../BandGeneralCircle.lean | 48 + .../BandInterfaceRootedForest.lean | 157 + .../BandLatticeEquality.lean | 97 + .../BandModifiedCellPartition.lean | 574 ++ .../BandModifiedCoverage.lean | 37 + .../BandModifiedOrbitArea.lean | 60 + .../BandModifiedPeriodicComplex.lean | 1180 ++++ .../BandModifiedUnionEquality.lean | 93 + .../BandOdometerInteriorTable.lean | 435 ++ .../BandOdometerMaximality.lean | 131 + .../BandOdometerTheorem.lean | 172 + .../BandOrderedGeneralAggregatePatches.lean | 160 + .../BandOrderedGeneralChildInterfaces.lean | 1654 ++++++ .../BandOrderedGeneralConfiguration.lean | 100 + .../BandOrderedGeneralFinitePatches.lean | 216 + .../BandOrderedGeneralGeometricSectors.lean | 1294 +++++ ...eredGeneralInteriorStarClassification.lean | 190 + .../BandOrderedGeneralInteriorWebRow.lean | 290 + ...deredGeneralLargestParentOdometerRows.lean | 2276 ++++++++ .../BandOrderedGeneralLayout.lean | 1149 ++++ .../BandOrderedGeneralLayoutCertificate.lean | 281 + ...ndOrderedGeneralMarkedSectorTransport.lean | 369 ++ ...ndOrderedGeneralMixedAggregatePatches.lean | 107 + ...OrderedGeneralNestedRightOdometerRows.lean | 269 + ...eredGeneralNormalizedOccurrenceBundle.lean | 262 + .../BandOrderedGeneralOdometerRowData.lean | 238 + ...dOrderedGeneralOuterMixedOdometerRows.lean | 2329 ++++++++ .../BandOrderedGeneralPeriodicBlockCells.lean | 142 + ...BandOrderedGeneralPositiveCutGeometry.lean | 2059 +++++++ ...OrderedGeneralPositiveCutOdometerRows.lean | 1031 ++++ .../BandOrderedGeneralRawSupport.lean | 976 ++++ ...deredGeneralRightInterfaceCertificate.lean | 81 + ...eneralRightInterfaceCertificateExists.lean | 1257 +++++ ...dGeneralRightNormalizationCertificate.lean | 272 + ...alRightNormalizationCertificateExists.lean | 861 +++ ...redGeneralRightNormalizedBundleExists.lean | 180 + ...eredGeneralRightOuterMarkingCriterion.lean | 188 + .../BandOrderedGeneralRightPlacement.lean | 232 + ...OrderedGeneralRightRoutingCertificate.lean | 152 + ...dGeneralRightRoutingCertificateExists.lean | 1207 ++++ ...dOrderedGeneralRightSelectedAdjacency.lean | 685 +++ ...rderedGeneralRightSelectedRowGeometry.lean | 4918 +++++++++++++++++ ...ndOrderedGeneralRoutedSelectedContact.lean | 155 + .../BandOrderedGeneralSelectedContactRow.lean | 220 + ...rderedGeneralSelectedContactRowExists.lean | 171 + ...eredGeneralSelectedSCompanionGeometry.lean | 459 ++ ...eralShiftedRoutedBoundaryLocalization.lean | 290 + ...andOrderedGeneralSubtileCanonicalRows.lean | 188 + ...eredGeneralSubtileCanonicalSeparation.lean | 452 ++ ...redGeneralSubtileInterfaceCertificate.lean | 83 + ...eralSubtileInterfaceCertificateExists.lean | 2393 ++++++++ ...eneralSubtileNormalizationCertificate.lean | 248 + ...SubtileNormalizationCertificateExists.lean | 1449 +++++ ...dGeneralSubtileNormalizedBundleExists.lean | 178 + .../BandOrderedGeneralSubtilePlacement.lean | 130 + ...deredGeneralSubtileRoutingCertificate.lean | 112 + ...eneralSubtileRoutingCertificateExists.lean | 164 + ...eredGeneralSubtileSelectedRowGeometry.lean | 332 ++ ...ndOrientedBoundaryOccurrenceGenealogy.lean | 145 + .../BandOrientedBoundaryParentChain.lean | 109 + .../BandOrientedChildParentEndpoints.lean | 590 ++ ...ndOrientedChildParentIncomingEndpoint.lean | 187 + .../BandOrientedChildParentRightEndpoint.lean | 840 +++ .../BandOrientedGapRefinement.lean | 222 + .../BandOrientedGapRefinementExists.lean | 202 + ...lOccurrenceIntersectionClassification.lean | 1259 +++++ .../BandOriginalPairSeparation.lean | 175 + .../BandPackingExterior.lean | 41 + .../BandPackingShiftPotential.lean | 40 + .../BandPackingSymmetry.lean | 45 + ...BandPackingSymmetryAffineVectorAction.lean | 58 + ...PackingSymmetryAffineVectorCovariance.lean | 1039 ++++ .../BandPackingSymmetryCircleAction.lean | 50 + .../BandPackingSymmetryCovariance.lean | 819 +++ ...ackingSymmetryGlobalOdometerTransport.lean | 39 + ...ckingSymmetryInversePhaseCancellation.lean | 612 ++ ...ndPackingSymmetryMarkedDataCovariance.lean | 1810 ++++++ ...dPackingSymmetryPartialOdometerAction.lean | 76 + ...SymmetryPartialOdometerActionFormulas.lean | 194 + ...ingSymmetryProjectiveVectorCovariance.lean | 568 ++ .../BandPackingSymmetryProperCovariance.lean | 234 + .../BandPackingSymmetryQuadrupleAction.lean | 43 + ...andPackingSymmetryReversesOrientation.lean | 42 + .../BandPackingSymmetryScopedPhase.lean | 105 + .../BandPackingSymmetryScopedPhaseUnique.lean | 106 + .../BandPackingSymmetrySlopeAction.lean | 73 + .../BandPackingSymmetryT3T5Covariance.lean | 1069 ++++ .../BandPackingSymmetryTileAction.lean | 48 + ...PackingSymmetryTileOdometerCovariance.lean | 2380 ++++++++ .../BandPackingSymmetryTilingTransport.lean | 699 +++ .../BandPackingSymmetryVectorAction.lean | 48 + .../BandParentBoundaryGenealogy.lean | 160 + ...andParentRotationOccurrenceCovariance.lean | 100 + .../BandPeriodicOdometer.lean | 61 + .../BandPeriodicSuperharmonicity.lean | 546 ++ ...ndPositiveCutBranchCompanionExclusion.lean | 1748 ++++++ .../BandPredecessorNoCollision.lean | 92 + .../BandPrototile.lean | 71 + .../BandPrototileCentralSymmetry.lean | 276 + .../BandPrototileCentroidUnique.lean | 233 + .../BandPrototileCompleteSquareCentroid.lean | 756 +++ .../BandPrototileExists.lean | 2236 ++++++++ ...BandPrototileFootprintSlopeCovariance.lean | 141 + .../BandPrototileReindexedDecomposition.lean | 137 + .../BandPrototileTranslation.lean | 72 + .../BandPrototileTranslationNormalForm.lean | 294 + .../BandRegimeClassification.lean | 138 + ...BandRegularTileTouchingClassification.lean | 217 + .../BandRegularTranslatePeriodicComplex.lean | 767 +++ .../BandRetainedBoundaryGenealogy.lean | 1340 +++++ .../BandSignedOccurrenceHalfTurn.lean | 196 + .../BandSubtileOccurrence.lean | 58 + .../BandSubtileOccurrenceTranslation.lean | 68 + .../BandSuccessorClassification.lean | 118 + .../ApollonianSuperharmonic/BandTangency.lean | 39 + .../BandTangencyDensity.lean | 241 + .../BandTileAcyclicIndegree.lean | 879 +++ .../BandTileSimultaneousInduction.lean | 788 +++ .../BandTileTopologyApplication.lean | 752 +++ .../BandTwelveParentSurround.lean | 542 ++ .../BandUnmodifiedCoreCertificate.lean | 78 + .../BandUnmodifiedCoverage.lean | 38 + .../BandUnmodifiedPeriodicCore.lean | 202 + .../BandVectorOrientationDichotomy.lean | 52 + .../ApollonianSuperharmonic/BandVectors.lean | 42 + .../BoundaryFootprintEdges.lean | 44 + .../BoundaryFootprintVertexDegreeTwo.lean | 207 + .../BoundaryFootprintVertices.lean | 38 + .../BoundaryJoinChamberCertificate.lean | 219 + .../BoundaryString.lean | 65 + .../BoundaryStringConcatenation.lean | 1000 ++++ .../BoundaryStringOdometerRespect.lean | 676 +++ .../BoundedDifference.lean | 34 + .../CellDisjointCommonEdgesBoundary.lean | 149 + .../CellDisjointCommonFootprintIncidence.lean | 503 ++ .../CellSupportedFootprintVertices.lean | 38 + .../CentrallyReflectedAt.lean | 41 + .../CircleCoordinates.lean | 35 + .../ApollonianSuperharmonic/CircleMatrix.lean | 42 + .../CircleMatrixEnclosureCriterion.lean | 192 + .../CircleMatrixIncomingVector.lean | 157 + .../ClosedSquareRealization.lean | 38 + .../CommonFootprintEdgeVertices.lean | 40 + .../ConnectedCommonBoundaryPath.lean | 102 + .../ConnectedGridEdgeCarrierGraph.lean | 565 ++ .../ConnectedGridEdgeCarrierUnion.lean | 114 + .../ConsecutivePatchInterface.lean | 56 + ...CoveredInterfaceOppositeIncidentCells.lean | 528 ++ .../CurvatureOneBandCircleClassification.lean | 96 + .../CurvatureOneBandPrototileSingleton.lean | 53 + .../CurvatureOneOdometer.lean | 46 + .../CurvatureOnePeriodicOdometer.lean | 296 + .../CurvatureOneTileBase.lean | 70 + .../DiamondBaseT1.lean | 256 + .../DiamondBaseT2.lean | 441 ++ .../DiamondBaseTouching.lean | 147 + .../DiamondCellDomain.lean | 44 + .../DiamondCoordinateConfiguration.lean | 818 +++ .../DiamondExceptionalLattice.lean | 40 + ...xceptionalMatrixLatticeIdentification.lean | 150 + .../DiamondExceptionalMaximality.lean | 627 +++ .../DiamondLaplacianTable.lean | 643 +++ .../DiamondOdometer.lean | 34 + .../DiamondOdometerExistsUnique.lean | 141 + ...amondOpposingBoundaryStarLocalization.lean | 1662 ++++++ .../DiamondOrientedChildParentEndpoints.lean | 112 + .../DiamondParameter.lean | 32 + .../DiamondPeakMatrix.lean | 38 + .../DiamondRecursiveQuadruple.lean | 50 + .../DiamondRegimeConverse.lean | 196 + .../DiamondTerminalWebStencilLedger.lean | 272 + .../ApollonianSuperharmonic/DiamondTile.lean | 35 + .../DiamondTileAcyclicIndegree.lean | 84 + .../DiamondTileGeometry.lean | 131 + .../DiamondTileOdometerRestriction.lean | 467 ++ .../DiamondTileRecursiveIdentification.lean | 234 + .../DiamondVertexDomains.lean | 48 + ...isjointBoundaryCommonEdgeGraphAcyclic.lean | 673 +++ .../DisjointSquareUnionCommonEdgeCarrier.lean | 292 + .../EuclideanCircleData.lean | 40 + .../ExactPatchBoundaryInterface.lean | 54 + ...leInterfaceDisjointCompanionEndpoints.lean | 97 + .../ExactTileInterfaceTriple.lean | 61 + ...actTileInterfaceTripleLatticeTouching.lean | 177 + ...erfaceTriplePackingSymmetryCovariance.lean | 64 + ...xactTileInterfaceTripleRetargetMiddle.lean | 52 + .../ExactTileInterfaceTripleSwapLast.lean | 45 + .../ExactTileTiling.lean | 37 + .../ExceptionalConnectorSegments.lean | 140 + .../ExceptionalModifiedABPath.lean | 488 ++ .../ExceptionalRestorationSectorData.lean | 165 + .../FiniteAcyclicGraphCardConnected.lean | 54 + .../FiniteAcyclicOrientationObstruction.lean | 126 + .../FiniteBiconnectedHorizontalRunTree.lean | 1501 +++++ ...niteConnectedAcyclicDegreeTwoGridPath.lean | 582 ++ .../FiniteConnectedCellSetNoCheckerboard.lean | 201 + .../FiniteCycleComponentList.lean | 74 + .../FiniteGridEdgeGraphEncoding.lean | 477 ++ .../FiniteInducedTilePatch.lean | 63 + .../FinitePatchTopology.lean | 98 + .../FinitePolyominoDiskCriterion.lean | 80 + .../FiniteSquareIncidenceIdentities.lean | 1018 ++++ .../ApollonianSuperharmonic/FiniteTile.lean | 34 + .../FootprintDeletionRetention.lean | 139 + .../FootprintEdges.lean | 39 + .../FootprintVertices.lean | 38 + .../ApollonianSuperharmonic/FordBaseT1.lean | 251 + .../ApollonianSuperharmonic/FordBaseT2.lean | 189 + .../ApollonianSuperharmonic/FordBaseT6.lean | 160 + .../FordBaseTouching.lean | 164 + .../FordBoundaryMultiplicity.lean | 39 + .../FordCellDomain.lean | 39 + .../FordCenteredInteriorOdometerStencil.lean | 137 + .../FordCircleCoordinate.lean | 37 + .../FordCoordinateConfiguration.lean | 1353 +++++ .../FordDoubledBoundary.lean | 39 + .../FordExceptionalLattice.lean | 40 + ...xceptionalMatrixLatticeIdentification.lean | 164 + .../FordExceptionalMaximality.lean | 241 + .../FordFareyParameter.lean | 60 + .../FordFareyParentsExist.lean | 211 + .../FordLaplacianTable.lean | 1380 +++++ .../FordLeftBoundaryCompatibility.lean | 968 ++++ .../ApollonianSuperharmonic/FordOdometer.lean | 34 + .../FordOdometerFamilyExistsUnique.lean | 222 + .../FordOpposingBoundaryStarLocalization.lean | 501 ++ .../FordOrientedChildParentEndpoints.lean | 2221 ++++++++ ...rdOrientedChildParentIncomingEndpoint.lean | 367 ++ .../FordOrientedChildParentRightEndpoint.lean | 227 + .../FordPeakMatrix.lean | 40 + .../FordRecursiveQuadruple.lean | 45 + .../FordRecursiveVertexDomains.lean | 47 + .../FordRegimeConverse.lean | 507 ++ .../FordTerminalWebStencilLedger.lean | 701 +++ .../ApollonianSuperharmonic/FordTile.lean | 35 + .../FordTileAcyclicIndegree.lean | 234 + .../FordTileGeometry.lean | 287 + .../FordTileOdometerRestriction.lean | 689 +++ .../FordTileRecursiveIdentification.lean | 258 + .../FordVertexDomain.lean | 37 + .../ForwardBoundaryStringData.lean | 361 ++ .../FourNeighborAdjacent.lean | 35 + .../FourNeighborConnected.lean | 39 + .../FourNeighborLaplacian.lean | 38 + .../GaussianQuarterTurn.lean | 33 + .../GaussianRealPoint.lean | 34 + .../GaussianReflection.lean | 33 + .../GaussianTranslation.lean | 34 + .../GlobalOdometerExtends.lean | 35 + .../GridCellCenter.lean | 37 + .../GridEdgeCarrier.lean | 40 + .../GridHorizontalLogLiftDelta.lean | 61 + .../GridRayCrossingIndex.lean | 63 + .../GridRayCrossingIndexAdjacentCell.lean | 459 ++ .../GridRayCrossingIndexZeroOfEdgeLifts.lean | 149 + .../GridSegmentLogLiftDelta.lean | 88 + .../GridStepLogLiftDelta.lean | 92 + .../GridVerticalDownLogLiftDelta.lean | 156 + .../GridVerticalUpLogLiftDelta.lean | 166 + LeanPool/ApollonianSuperharmonic/Imports.lean | 1242 +++++ .../IncomingSuperbasisRelation.lean | 80 + .../IntegerCeilDiv.lean | 36 + .../IntegerLaplacianCastBridge.lean | 33 + .../IntegerLatticeFunction.lean | 34 + .../IntegerPreservingNormalization.lean | 204 + .../IntegerSuperharmonicCharacterization.lean | 101 + .../IntegerSuperharmonicClosedness.lean | 160 + .../IntegerSuperharmonicRepresentative.lean | 44 + .../IntegralityLattice.lean | 68 + .../IntegralityLatticeIndex.lean | 148 + .../IntegralityTiling.lean | 41 + .../IsolatedPrecursorCoverage.lean | 298 + .../ApollonianSuperharmonic/LambdaTiling.lean | 53 + .../LatticeAdjacentInterfacePath.lean | 1032 ++++ .../ApollonianSuperharmonic/LatticeCell.lean | 34 + ...LatticeDiskUnionIntersectionConnected.lean | 204 + .../LatticeEdgeRegularity.lean | 198 + .../LatticeFundamentalSet.lean | 35 + .../LatticeQuadraticForm.lean | 40 + .../ApollonianSuperharmonic/LatticeTile.lean | 36 + .../LatticeTileBoundarySimpleGridCycle.lean | 840 +++ .../LatticeTileComplementGridConnected.lean | 723 +++ .../LatticeTileDiskUnionInterface.lean | 74 + .../LatticeTileFourNeighborConnected.lean | 402 ++ .../LatticeTileGridEulerCount.lean | 466 ++ .../LatticeTileGridStructure.lean | 45 + .../LatticeTileNoCheckerboard.lean | 463 ++ .../LatticeTileThreeDiskJunction.lean | 1108 ++++ .../LatticeVertexBoundary.lean | 39 + .../LatticeVertexIncidentCell.lean | 41 + .../LeftAdjacentOdometerCompatibility.lean | 562 ++ .../LeftLatticeAdjacent.lean | 71 + ...tticeAdjacentPackingSymmetryTransport.lean | 638 +++ .../LocalExponentialEstimate.lean | 152 + .../LocalLatticeInterfaceSectors.lean | 649 +++ .../MarkedOdometerAdjacencyReduction.lean | 3732 +++++++++++++ ...difiedSubtileOccurrenceInterpretation.lean | 51 + .../NoCheckerboardCellVertex.lean | 41 + .../OdometerAdjacencyInduction.lean | 561 ++ .../OdometerCompatibility.lean | 40 + .../OdometerGluing.lean | 984 ++++ .../OdometerStringRespect.lean | 42 + ...dometerStringRespectCentralCovariance.lean | 196 + ...RespectRegularFamilyCentralCovariance.lean | 192 + .../OdometerTranslation.lean | 45 + .../ApollonianSuperharmonic/OdometerWeb.lean | 365 ++ .../OpenLatticeEdge.lean | 35 + .../OpposingBoundaryInterfaceExhaustion.lean | 266 + .../OpposingBoundaryOdometerStrings.lean | 2569 +++++++++ .../OpposingBoundaryStarLocalization.lean | 955 ++++ .../OpposingStringInterfacePath.lean | 1544 ++++++ ...siteRoutedCommonEdgeOutsideCellUnique.lean | 195 + ...eneralOdometerAdjacencyClassification.lean | 543 ++ .../OrientedTouchingCovariance.lean | 833 +++ .../OrientedUnimodularStripConcatenation.lean | 130 + .../OuterLayoutTouching.lean | 831 +++ .../OuterTouchingAlternative.lean | 41 + ...eredGeneralMixedAggregateJunctionData.lean | 2818 ++++++++++ ...dGeneralMixedAggregatePairedEndpoints.lean | 2208 ++++++++ .../P2999T1CompleteSquareTransport.lean | 124 + .../P2999T1OrthogonalSlopeTransport.lean | 137 + .../P2999T1ShiftSlopeTransport.lean | 141 + .../P3019T1ChamberSegmentOrder.lean | 131 + .../P3019T1ChamberStripGeometry.lean | 92 + .../P3019T1UnimodularStripWindow.lean | 79 + ...045T1RightBoundaryDisplacementAlgebra.lean | 100 + .../P3055T1ExteriorCentralIncidence.lean | 359 ++ .../P3055T1ParentVectorNormalForms.lean | 112 + .../P3055T1SignedCentroidNormalForms.lean | 55 + .../P3092T1CenteredRectangleDisk.lean | 743 +++ .../P3092T1DiamondCenteredRectangles.lean | 114 + .../P3102T2CommonEdgeSectorTransition.lean | 149 + .../P3102T2IsolatedRoutedCellSurvival.lean | 95 + .../P3102T2OppositeOwnersCommonEdge.lean | 130 + .../P3102T2PeriodicFourSectorObstruction.lean | 160 + ...3161T1AggregateComplementConnectivity.lean | 143 + .../P3161T1AggregateInducedConnectivity.lean | 93 + .../P3161T1BlockTreeReachability.lean | 56 + .../P3161T1SquareTriangleComplement.lean | 161 + .../P3161T2IncidentBoundary.lean | 98 + .../P3161T2PathExhaustion.lean | 135 + .../P3161T2PathSubwalk.lean | 93 + .../P3192T1FourOwnerTriangleExclusion.lean | 90 + .../P3192T1PeriodicIndicesInfinite.lean | 46 + .../P3192T1SimplePathOrientation.lean | 95 + .../P3221T2ClosedWalkCirculation.lean | 615 +++ .../P3221T2ConnectedPathIntegration.lean | 94 + .../P3221T2IntegralSquareFilling.lean | 195 + .../P3221T2TileFillingSupport.lean | 174 + .../P3350T1GraphCellUnionConnected.lean | 207 + .../P3381T1AffineTriangleMap.lean | 84 + .../P3381T1PairedTriangulation.lean | 106 + .../P3381T1PiecewiseAffinePolygonModel.lean | 335 ++ .../P3381T1PolygonBoundary.lean | 50 + .../P3381T1TriangleDeterminant.lean | 38 + .../P3381T1TriangulationBoundary.lean | 1477 +++++ .../P3475T1BoundaryReduction.lean | 68 + .../P3475T1BoundaryRestoration.lean | 66 + .../P3475T1BoundarySubdivision.lean | 67 + .../P3475T1GridBoundary.lean | 974 ++++ .../P3475T1PolygonTriangleConstruction.lean | 73 + .../P3475T1PolygonalSeparation.lean | 792 +++ .../P3475T1SquareUnionIdentification.lean | 1725 ++++++ .../P3475T1TriangleTree.lean | 62 + .../P3475T1UnitSegmentIntersection.lean | 233 + .../P3497T1SingleStraightDeletion.lean | 1079 ++++ .../P3497T1StrictCornerSplice.lean | 134 + .../P3497T1SubdivisionComposition.lean | 130 + .../P3497T1TriangleCornerNonzero.lean | 83 + .../P3511T1AttachmentIntersection.lean | 91 + .../P3511T1ConvexComparison.lean | 81 + .../P3511T1ConvexRealization.lean | 72 + .../P3511T1CyclicDissection.lean | 57 + .../P3511T1LeafOrder.lean | 534 ++ .../P3511T1SourceConstruction.lean | 111 + .../P3511T1SourceDissection.lean | 78 + .../P3523T1BoundaryFaceSplit.lean | 44 + .../P3523T1FaceEnumeration.lean | 49 + .../P3523T1InsertionConstruction.lean | 77 + .../P3523T1InsertionData.lean | 67 + .../P3523T1InsertionGeometry.lean | 2785 ++++++++++ .../P3523T1InsertionIncidence.lean | 1806 ++++++ .../P3523T1InterpolatedTarget.lean | 47 + .../P3523T1OrderedInsertion.lean | 1797 ++++++ .../P3523T1SplitDeterminants.lean | 49 + .../P3523T1SubdivisionExit.lean | 70 + .../P3523T1TargetBoundary.lean | 688 +++ .../P3523T1TargetHull.lean | 57 + .../P3523T1TwoTriangleSplit.lean | 1084 ++++ .../P3544T1BoundaryCarrier.lean | 45 + .../P3544T1DiagonalSelection.lean | 91 + .../P3544T1DiagonalSplit.lean | 128 + .../P3544T1IndexedGluing.lean | 128 + .../P3544T1LocalParity.lean | 182 + .../P3544T1RayParity.lean | 46 + .../P3544T1TriangleRayGeometry.lean | 1806 ++++++ .../P3555T2ParabolaChordCuts.lean | 1925 +++++++ .../P3555T2ParabolaHullFrontier.lean | 1329 +++++ .../P3555T2ParabolaSupporting.lean | 99 + .../P3555T2SavedDissectionGeometry.lean | 1502 +++++ .../P3597T1DirectionParity.lean | 1416 +++++ .../P3597T1GenericRayStability.lean | 612 ++ .../P3597T1SideCrossing.lean | 1912 +++++++ .../P3597T1VertexSectors.lean | 3368 +++++++++++ .../P3650T1CyclicChildren.lean | 83 + .../P3650T1CyclicChildrenExists.lean | 2365 ++++++++ .../P3650T1EmptyTriangleDiagonal.lean | 2156 ++++++++ .../P3650T1ExposedCorner.lean | 62 + .../P3650T1ExposedCornerExists.lean | 3483 ++++++++++++ .../P3650T1LocalCoherence.lean | 1138 ++++ .../P3650T1MaximalHeightDiagonal.lean | 929 ++++ .../P3650T1OldArcEven.lean | 3300 +++++++++++ .../P3650T1ParitySum.lean | 619 +++ .../P3650T1TriangleEntry.lean | 381 ++ .../P3650T1VisibleDiagonal.lean | 60 + .../P3652T1ChildFillSeparation.lean | 120 + .../P3652T1DiagonalFaceIntersections.lean | 161 + .../P3652T1IndexedFaceLedger.lean | 2677 +++++++++ .../P3652T1ParentOddGluing.lean | 155 + .../P3652T1TriangleFaceRestriction.lean | 73 + .../P3723T1AllContactDrawingExists.lean | 3646 ++++++++++++ .../P3723T1AllContactRouting.lean | 104 + .../P3723T1ContactPorts.lean | 111 + .../P3723T1ContactPortsExist.lean | 1982 +++++++ .../P3723T1ContactStabilizer.lean | 82 + .../P3723T1ConvexRadialIntersection.lean | 91 + .../P3723T1ConvexRadialParameterization.lean | 77 + .../P3723T1EdgeContact.lean | 36 + .../P3723T1GridDiskBoundaryStars.lean | 157 + .../P3723T1GridDiskPairedModel.lean | 91 + .../P3723T1PairedModelSegmentPullback.lean | 560 ++ .../P3723T1PolygonalParameterization.lean | 50 + .../P3767T1BarrierRegionMaximal.lean | 44 + .../P3767T1FixedFaceComponents.lean | 102 + .../P3767T1FixedTrace.lean | 42 + .../P3767T1VertexEdgeIncidence.lean | 65 + .../P3776T1BoundedDisplacementSurjective.lean | 793 +++ .../P3776T1CellCenterMembership.lean | 56 + .../P3776T1DiskMapExponentialLift.lean | 44 + .../P3776T1DualEdges.lean | 67 + .../P3776T1DualEdgesExist.lean | 970 ++++ .../P3776T1EquivariantDisplacementBound.lean | 80 + .../P3776T1FixedGeometry.lean | 793 +++ .../P3776T1OpenStar.lean | 40 + .../P3776T1PlaneMapExists.lean | 589 ++ .../P3776T1SectorMaps.lean | 69 + .../P3776T1SectorMapsExist.lean | 1893 +++++++ .../P3776T1StarWeights.lean | 51 + .../P3776T1StarWeightsExist.lean | 545 ++ .../P3776T1TileContractions.lean | 53 + .../P3776T1TileContractionsExist.lean | 403 ++ .../P3776T1WalkMap.lean | 49 + .../P3776T1WalkMapProperties.lean | 774 +++ .../P3821T1AngularIncrement.lean | 51 + .../P3821T1AngularIncrementLaws.lean | 159 + .../P3821T1CircleComponentBound.lean | 481 ++ .../P3821T1ComponentContours.lean | 1815 ++++++ .../P3821T1ControlledNeighborhood.lean | 1227 ++++ .../P3821T1LoopIndex.lean | 44 + .../P3821T1LoopIndexLaws.lean | 629 +++ .../P3821T1ThreeArcCircle.lean | 877 +++ .../P3832T1ChamberOverlap.lean | 427 ++ .../P3832T1CollapsedConeDescent.lean | 104 + .../P3832T1ConeCollapse.lean | 46 + .../P3832T1FiniteClosedCoverPasting.lean | 58 + .../P3861T1ExtraArcLocalization.lean | 186 + .../P3861T1FacialDomains.lean | 61 + .../P3861T1FixedFacialDeletion.lean | 1009 ++++ .../P3861T1RealPolygonDomains.lean | 697 +++ .../P3861T1RoutedFaceOrientation.lean | 410 ++ .../P3861T1RoutedFacialDomains.lean | 139 + .../P3889T1ExactRadialStar.lean | 634 +++ .../P3889T1FaceGapCoverage.lean | 2123 +++++++ .../P3889T1TwoRaySectorDecomposition.lean | 79 + .../P3889T1TwoRaySectors.lean | 1215 ++++ .../P3913T1OffFaceExterior.lean | 187 + .../P3913T1PeriodicPositionUnbounded.lean | 110 + .../P3913T1RoutedArcExterior.lean | 196 + .../P3913T1RoutedFaceSubdivision.lean | 2062 +++++++ .../P3913T1RoutedTraceClosed.lean | 72 + .../P3934T1ArcSide.lean | 42 + .../P3934T1ArcSideComparison.lean | 1211 ++++ .../P3934T1LocalSide.lean | 43 + .../P3934T1PolygonalSide.lean | 47 + .../P3934T1PolygonalSidePropagation.lean | 1732 ++++++ .../P3934T1SectorContinuation.lean | 2444 ++++++++ .../P3934T1SectorSelection.lean | 123 + .../P3963T1DeletedPairExteriorConnected.lean | 86 + .../P3963T1EdgeFreeDiskCorners.lean | 93 + .../P3963T1ExteriorMixedCycleObstruction.lean | 2247 ++++++++ .../P3963T1MixedBoundaryCycle.lean | 1549 ++++++ .../P3996T1AdjacentParentPlacement.lean | 126 + .../P3996T1CenteredQuarterTurnInclusion.lean | 75 + .../P3996T1PlacementCompanionBlocks.lean | 1308 +++++ .../P3996T1SRowAlignment.lean | 1046 ++++ .../P3996T1SRowParameters.lean | 63 + .../P3996T1SRowTable.lean | 174 + .../P4055T1BandQuarterTurn.lean | 54 + .../P4055T1ExactTripleImage.lean | 74 + .../P4055T1GridPathImage.lean | 114 + ...4055T1OrderedGeneralOppositeEndpoints.lean | 1581 ++++++ .../P4055T1PackingGridEquivalence.lean | 154 + .../P4055T1PlacementNormalization.lean | 2232 ++++++++ .../P4062T1CanonicalSupport.lean | 352 ++ .../P4062T1InteriorGeometry.lean | 550 ++ .../P4062T1InteriorSquare.lean | 36 + .../P4062T1LiteralReduction.lean | 543 ++ .../P4062T1OrientationTransport.lean | 97 + .../P4062T1OverlapDescent.lean | 1141 ++++ .../P4062T1ParentGluing.lean | 78 + .../P4062T1ParentalRestriction.lean | 518 ++ .../P4062T1RankedAttachment.lean | 178 + .../P4062T1RecursiveInteriors.lean | 43 + .../P4062T1RemainderGeometry.lean | 164 + .../P4062T1RemainderPaths.lean | 67 + .../P4062T1ZeroIncoming.lean | 115 + .../P4085T1FordIncomingNormalization.lean | 139 + .../P4085T1MinusTouching.lean | 211 + .../P4085T1RestrictedAdaptedActions.lean | 95 + .../P4112T1BoundaryMultiplicity.lean | 210 + .../P4112T1LowerNeighbors.lean | 1742 ++++++ .../P4112T1ParentalNeighbors.lean | 976 ++++ .../P4112T1PathGeometry.lean | 1499 +++++ .../P4120T1AffineComparison.lean | 101 + .../P4120T1DiamondGeometry.lean | 217 + .../P4120T1FordGeometry.lean | 1714 ++++++ .../P4120T1GeneralDescent.lean | 1651 ++++++ .../P4120T1GeneralRowData.lean | 140 + .../P4120T1RootNormalization.lean | 703 +++ .../P4158T1AncestorCells.lean | 55 + .../P4158T1EdgeSectorSelection.lean | 2509 +++++++++ .../P4158T1LargeFirstRestrictions.lean | 1037 ++++ .../P4158T1LargeSecondRestrictions.lean | 1039 ++++ .../P4158T1MatchedFordPair.lean | 738 +++ .../P4158T1SmallerStringEdges.lean | 1131 ++++ .../P4158T1StringSlopeTelescoping.lean | 167 + .../P4194T1DiamondBoundaryLedger.lean | 1037 ++++ .../P4194T1DiamondCellRows.lean | 101 + .../P4194T1DiamondCentroid.lean | 108 + .../P4194T1DiamondVertexIncidence.lean | 88 + .../P4207T1DiamondFormula.lean | 41 + .../P4207T1FloorArithmetic.lean | 86 + .../P4207T1FormulaRestriction.lean | 51 + .../P4207T1ShiftedPredecessor.lean | 83 + .../P4207T1UnitRestrictions.lean | 173 + .../P4210T1FordCellRectangles.lean | 69 + .../P4210T1FordSquareCentroid.lean | 85 + .../P4217T2RectangularBoundarySlope.lean | 166 + .../P4217T2SquareGeometry.lean | 74 + .../P4217T2SquareRestriction.lean | 52 + .../P4223T1DiamondRowNumerators.lean | 94 + .../P4250T1DefinedHalfIntegralSlope.lean | 109 + .../P4250T1IntegralAffinePlacement.lean | 46 + .../P4250T1NestedCompatibility.lean | 3409 ++++++++++++ .../P4250T1OrdinaryCompatibility.lean | 1927 +++++++ .../P4250T1ParentSlopePhase.lean | 164 + .../P4250T1ReflectedGluingSlope.lean | 1068 ++++ .../P4250T1SlopeOffset.lean | 37 + .../P4250T2FiniteForestCompletion.lean | 915 +++ .../P4250T2IndegreeSubtraction.lean | 164 + .../P4250T2InterfaceCycleExclusion.lean | 1313 +++++ .../P4250T2InterfaceNeighborCount.lean | 1736 ++++++ .../P4250T2PrecursorRootSeparation.lean | 98 + .../P4261T1CentralCoordinates.lean | 625 +++ .../P4261T1ContactAdjacency.lean | 206 + .../P4261T1EdgeExterior.lean | 84 + .../P4261T1ExteriorAdjacency.lean | 280 + .../P4261T1ExteriorIndices.lean | 40 + .../P4261T1PlacedOdometer.lean | 99 + .../P4261T1RightCoordinates.lean | 1117 ++++ .../P4261T1SubtileCoordinates.lean | 1293 +++++ .../P4261T2AdjacentMatrixSlope.lean | 63 + .../P4261T2AncestorSymmetry.lean | 618 +++ .../P4261T2DiamondBoundary.lean | 142 + .../P4261T2InterfacePropagation.lean | 96 + .../P4261T2LiteralInterface.lean | 91 + .../P4261T2PairNormalization.lean | 143 + .../P4261T2RegularEdgeReduction.lean | 168 + .../P4261T2UnitBoundary.lean | 1065 ++++ .../P4261T2UnitInterface.lean | 1414 +++++ .../P4261T2UnitStringTelescoping.lean | 101 + .../P4339T1EmptyPrecursorRoots.lean | 216 + .../P4339T1PositivePrecursorRoots.lean | 868 +++ .../P4339T1PrecursorArcSeparation.lean | 138 + .../P4339T1PrecursorSupportGeometry.lean | 174 + .../P4366T1AttachedRemainderIndexZero.lean | 220 + .../P4366T1PrecursorPathLoop.lean | 798 +++ .../P4366T1PrecursorRemainderFamily.lean | 43 + .../P4366T1RemainderOuterAttachments.lean | 544 ++ .../P4366T2LocalSectors.lean | 1992 +++++++ .../P4366T2OuterGeometry.lean | 1602 ++++++ .../P4366T2WalkExhaustion.lean | 151 + .../P4387T1ParentSlopeNormalForms.lean | 112 + .../P4387T1PlacedCoordinates.lean | 80 + .../P4397T1PathAvoidsPrecursorEdges.lean | 88 + .../P4397T1ReflectedEdgeNotBoundary.lean | 76 + .../P4397T1SimplePathSplicing.lean | 107 + .../P4397T1UnitEdgeCells.lean | 957 ++++ .../P4418T3EndpointOwnerIndices.lean | 83 + .../P4418T3NestedCompanionEndpoint.lean | 818 +++ .../P4418T3NestedCompanionGeometry.lean | 103 + .../P4418T3OuterCompanionAlignment.lean | 709 +++ .../P4418T3PresentedRowAdjacency.lean | 1341 +++++ .../P4418T3RoutedBlockCriterion.lean | 843 +++ .../P4418T3SelectedInterfaceData.lean | 60 + .../P4418T3SelectedInterfaceExists.lean | 1928 +++++++ .../P4431T1OwnerTransitionSelector.lean | 78 + .../P4456T2BandGraphTriangle.lean | 1025 ++++ .../P4456T2CrosscutIndex.lean | 965 ++++ .../P4456T2DiamondNoChord.lean | 395 ++ .../P4456T2EdgeInterior.lean | 352 ++ .../P4456T2MissingEdge.lean | 600 ++ .../P4456T2OrderedNoChord.lean | 671 +++ .../P4456T2PackingNoChord.lean | 436 ++ .../P4456T2ParentSide.lean | 188 + .../P4456T2SquareEdges.lean | 911 +++ .../P4456T2VertexInterior.lean | 382 ++ .../P4458T1BoundaryFrame.lean | 88 + .../P4458T1BoundaryPlacement.lean | 54 + .../P4458T1BoundarySide.lean | 54 + .../P4458T1FirstProperRows.lean | 1243 +++++ .../P4458T1LargestParentRows.lean | 2971 ++++++++++ .../P4458T1RespectAppend.lean | 708 +++ .../P4458T1RestrictionFamily.lean | 70 + .../P4458T1SecondNewerRows.lean | 4674 ++++++++++++++++ .../P4458T1SmallPairRows.lean | 108 + .../P4458T1ThirdNewerRows.lean | 129 + .../P4536T1AFrameB.lean | 1540 ++++++ .../P4536T1AFrameD.lean | 1674 ++++++ .../P4536T1EndpointAlgebra.lean | 62 + .../P4536T1EndpointDifferences.lean | 161 + .../P4536T1HalfOffsetBridge.lean | 46 + .../P4536T1RegularJoin.lean | 101 + .../P4536T1SmallUnitSides.lean | 190 + .../P4536T1TangentPairMatrix.lean | 107 + .../P4549T1DeeperFrameB.lean | 205 + .../P4549T1NegativeIncomingSide.lean | 122 + .../P4564T2DiamondGeometry.lean | 1043 ++++ .../P4564T2DiamondOrderExclusion.lean | 42 + .../P4564T2ElementaryQuarterTurn.lean | 41 + .../P4564T2FordGeometry.lean | 987 ++++ .../P4564T2FordT6Transport.lean | 1204 ++++ .../P4564T2GeneralT6Transport.lean | 623 +++ .../P4564T2GeometryPullback.lean | 79 + .../P4566T1LiteralSuccessorCharts.lean | 113 + .../P4566T1SmallPairCoordinates.lean | 101 + .../P4566T1SmallRetainedSides.lean | 365 ++ .../P4566T1StrictRetainedGenealogy.lean | 194 + .../P4566T1UnitPairCharts.lean | 149 + .../P4590T1CentralDiskSectors.lean | 94 + .../P4590T1JunctionRefinement.lean | 2251 ++++++++ .../P4590T1JunctionRouting.lean | 196 + .../P4590T1MixedCompanionMarks.lean | 561 ++ .../P4590T1MixedInteriorGeometry.lean | 648 +++ .../P4590T1OppositeCellsStar.lean | 53 + .../P4590T1OriginalNonedges.lean | 154 + .../P4590T1PositivePrototileDisk.lean | 48 + .../P4590T1ReflectedCenterBoundary.lean | 101 + .../P4590T1RestoredBoundaryGeometry.lean | 1127 ++++ .../P4590T1RightInteriorGeometry.lean | 2269 ++++++++ .../P4590T1RotationalDiskCenter.lean | 86 + .../P4590T1SixLabelBoundaryCount.lean | 70 + .../P4616T1FirstPredecessorCentroids.lean | 93 + .../P4616T1MixedCoarseSectors.lean | 134 + .../P4616T1NestedCompanionFootprints.lean | 88 + .../P4616T1OriginalMixedPaths.lean | 242 + .../P4616T1PeriodicEndpointExclusion.lean | 68 + .../P4616T1ThirdOwnerPathEndpoint.lean | 51 + .../P4623T1ZeroBlockExterior.lean | 99 + .../P4623T1ZeroBlockLinks.lean | 129 + .../P4623T1ZeroBlockPaths.lean | 116 + .../P4630T1AffineCellSymmetry.lean | 78 + .../P4630T1CellRouteLift.lean | 491 ++ .../P4630T1ExteriorNeighbors.lean | 47 + .../P4630T1ExteriorWalks.lean | 162 + .../P4630T1GridComplementCriterion.lean | 140 + .../P4630T1ParentRotation.lean | 237 + .../P4630T1RingIndex.lean | 44 + .../P4638T1AntipodalContactArcs.lean | 217 + .../P4638T1ContactStarCoverage.lean | 991 ++++ .../P4638T1EmptyCurvature.lean | 45 + .../P4638T1EmptyFordLocalization.lean | 1039 ++++ .../P4638T1FordIncidentCells.lean | 38 + .../P4638T1MidpointReflection.lean | 56 + .../P4651T1ContactEdgeSeparation.lean | 77 + .../P4651T1CycleComplementaryArcs.lean | 1463 +++++ .../P4651T1FreeBoundaryHalfTurn.lean | 90 + .../P4651T1GridHalfTurnTransport.lean | 134 + .../P4670T1ComplementReflection.lean | 642 +++ .../P4670T1OrdinaryEdges.lean | 240 + .../P4670T1SmallerGeometry.lean | 62 + .../P4677T2DrawingData.lean | 132 + .../P4677T2DrawingExists.lean | 155 + .../P4677T2FacePoints.lean | 682 +++ .../P4677T2IncidenceLedger.lean | 203 + .../P4677T2PeriodicWalkAssembly.lean | 148 + .../P4677T2PrecursorWalk.lean | 620 +++ .../P4677T2ThreeConnected.lean | 932 ++++ .../P4677T2TouchingWalk.lean | 171 + .../ApollonianSuperharmonic/P4715T1Arc.lean | 35 + .../P4715T1BoundaryCycle.lean | 35 + .../P4715T1CoefficientEdges.lean | 213 + .../P4715T1CoefficientFaces.lean | 1458 +++++ .../P4715T1CoefficientTranslation.lean | 63 + .../P4715T1FaceShift.lean | 34 + .../P4715T1Hexagon.lean | 36 + .../P4715T1HexagonSubdivision.lean | 54 + .../P4715T1HexagonTessellation.lean | 191 + .../P4715T1IndexAction.lean | 99 + .../P4715T1LatticeCoordinates.lean | 67 + .../P4715T1Offsets.lean | 43 + .../P4715T1OrbitRepresentatives.lean | 99 + .../P4715T1PatchEnumeration.lean | 52 + .../P4715T1PatchFaces.lean | 41 + .../P4715T1PlaneMap.lean | 80 + .../P4715T1Position.lean | 34 + .../P4715T1PositionInjective.lean | 45 + .../P4715T1Region.lean | 41 + .../P4715T1VertexShift.lean | 34 + .../P4733T1ContainedWalk.lean | 44 + .../P4733T1Coordinates.lean | 40 + .../P4733T1EdgeOrbit.lean | 113 + .../P4733T1EdgeRow.lean | 79 + .../P4733T1FacePairNormalForm.lean | 110 + .../P4733T1FacePairOrbit.lean | 42 + .../P4733T1OccurrenceTranslation.lean | 54 + .../P4733T1RepresentativeWalks.lean | 183 + .../P4733T1RowIncidence.lean | 60 + .../P4733T1RowLabelRigidity.lean | 33 + .../P4733T1WalkExtension.lean | 113 + .../P4733T1WalkTransport.lean | 66 + .../P4780T1ActiveFacets.lean | 67 + .../P4780T1HullHalfspaces.lean | 129 + .../P4780T1IntegerCoverage.lean | 83 + .../P4780T1InteriorSeparation.lean | 61 + .../P4780T1NeighborCorners.lean | 44 + .../P4780T1NeighborFacets.lean | 56 + .../P4780T1OverlapBound.lean | 46 + .../P4780T1StrictInterior.lean | 76 + .../P4783T1ParallelogramFan.lean | 74 + .../P4783T1PatchCoordinates.lean | 47 + .../P4783T1PatchCoverage.lean | 228 + .../P4783T1PatchDeterminants.lean | 35 + .../P4793T1FacetForms.lean | 48 + .../P4793T1PatchBoundaryTraces.lean | 82 + .../P4793T1PatchFacetLedger.lean | 94 + .../P4793T1PatchIntersections.lean | 65 + .../P4793T1PatchSeparators.lean | 126 + .../P4793T1SeparatorIntersection.lean | 55 + .../P4793T1SupportingFace.lean | 72 + .../P4802T1CrossPatchFaces.lean | 136 + .../P4802T1HexagonOverlapSide.lean | 94 + .../P4802T1PatchFaceRestriction.lean | 81 + .../P4802T1SideRestriction.lean | 375 ++ .../P4802T1SimplexFaces.lean | 42 + .../P4802T1TriangleIndependent.lean | 62 + .../P4812T1AffineDrawing.lean | 71 + .../P4812T1AffineTransport.lean | 237 + .../P4812T1LatticeCoordinates.lean | 114 + .../P4812T1ReflectedTouching.lean | 86 + .../P4812T1RegularFaceWalks.lean | 2666 +++++++++ .../P4818T1AffineTransversalExtension.lean | 137 + .../P4818T1BoundaryRecovery.lean | 156 + .../P4818T1ClosedOverlaps.lean | 174 + .../P4818T1HalfOpen.lean | 50 + .../P4818T1OverlapDifferences.lean | 149 + .../P4818T1Representatives.lean | 730 +++ .../P4828T1CircularPlacement.lean | 1059 ++++ .../P4828T1ConstructorSupport.lean | 130 + .../ApollonianSuperharmonic/P4828T1Disk.lean | 36 + .../P4828T1Evaluate.lean | 42 + .../P4828T1FiniteWordSeparation.lean | 134 + .../ApollonianSuperharmonic/P4828T1Gap.lean | 52 + .../P4828T1HistoryNormalForm.lean | 85 + .../P4828T1HistoryRealization.lean | 88 + .../P4828T1LeftRootGeometry.lean | 576 ++ .../P4828T1LinePlacement.lean | 401 ++ .../P4828T1LineSupport.lean | 44 + .../P4828T1ParentsDistinct.lean | 40 + .../P4828T1ResidualPatches.lean | 623 +++ .../P4828T1RightRootGeometry.lean | 591 ++ .../ApollonianSuperharmonic/P4828T1Root.lean | 44 + .../P4828T1RootSeparation.lean | 71 + .../P4828T1Rotate.lean | 36 + .../P4828T1RotationLaws.lean | 58 + .../ApollonianSuperharmonic/P4828T1Step.lean | 38 + .../P4840T6ConstructorCovariance.lean | 46 + .../P4840T6DiamondRecurrence.lean | 40 + .../P4840T6NegatedRoot.lean | 40 + .../P4840T6ProperGrowth.lean | 44 + .../P4840T6ShiftRoot.lean | 38 + .../P4849T1Component.lean | 39 + .../P4849T1ComponentRestriction.lean | 86 + .../P4849T1InfiniteLimitComponent.lean | 276 + .../P4849T1LargePositiveComponents.lean | 543 ++ .../P4849T1LocalLimitAdmissibility.lean | 52 + .../P4849T1MinimumTruncation.lean | 57 + .../P4849T1PeriodAnchoring.lean | 139 + .../P4849T1PeriodResidues.lean | 60 + .../P4849T1SetDiagonalSubsequence.lean | 56 + .../P4903T1ScalarTangencies.lean | 86 + .../P4903T1SignedDiskHull.lean | 186 + .../P4909T1LineFan.lean | 1310 +++++ .../P4909T1OmittedDiskBarrier.lean | 105 + .../P4909T1ParentEdges.lean | 45 + .../P4909T1ParentPolygon.lean | 85 + .../P4909T1TangentSegments.lean | 63 + .../P4909T1TriangleFan.lean | 1015 ++++ .../P4953T1HullHeight.lean | 76 + .../P4953T1LiteralHulls.lean | 69 + .../P4953T1QuadrilateralSections.lean | 1000 ++++ .../P4953T1TriangleSections.lean | 1300 +++++ .../P4981T1EdgePrescription.lean | 48 + .../P4981T1EdgeRank.lean | 34 + .../P4981T1PrescriptionCoherence.lean | 90 + .../P4981T1PrescriptionLocality.lean | 50 + .../P4981T1PrescriptionValue.lean | 54 + .../P4981T1ProperEquations.lean | 84 + .../P4981T1Recursion.lean | 46 + .../P4981T1RootEquations.lean | 175 + .../P4984T1BranchDecay.lean | 75 + .../P4984T1ClosedGap.lean | 45 + .../P4984T1ClosedSubdivision.lean | 693 +++ .../P4984T1ContactDiameter.lean | 102 + .../P4984T1IncidentArcs.lean | 846 +++ .../P4984T1RootGaps.lean | 436 ++ .../P4984T1UnitIncidence.lean | 1113 ++++ .../P4994T6Chamber.lean | 36 + .../P4994T6ChamberAdditions.lean | 40 + .../P4994T6ChartCovolume.lean | 101 + .../P4994T6NonunitBirth.lean | 132 + .../P4994T6NonunitChamber.lean | 164 + .../P4994T6Rotation.lean | 43 + .../P4994T6RotationLaws.lean | 78 + .../P4994T6StepChamber.lean | 58 + .../P4994T6UnitChartRotation.lean | 58 + .../P4994T6UnitCoordinates.lean | 47 + .../P4994T6UnitOccurrenceChamber.lean | 182 + .../P4994T6UnitRootTable.lean | 83 + .../P5023T1CircularEstimate.lean | 68 + .../P5023T1CircularSide.lean | 1263 +++++ .../P5023T1ContactHull.lean | 329 ++ .../P5023T1ContactVertices.lean | 65 + .../P5023T1ConvexDiameter.lean | 44 + .../P5023T1LineEstimate.lean | 63 + .../P5023T1LineSideGeometry.lean | 176 + .../P5050T1OmittedHullSeparation.lean | 571 ++ .../P5050T1ParentSphereSection.lean | 365 ++ .../P5050T1RadialSection.lean | 109 + .../P5050T1TangentLineSection.lean | 491 ++ .../P5050T1TangentTriangleSection.lean | 59 + .../P5064T3CrossParentSupport.lean | 77 + .../P5064T3LiteralLocalization.lean | 116 + .../P5064T3OrderedPredecessor.lean | 134 + .../P5064T3PrecursorSupport.lean | 71 + .../P5064T3RectangleContacts.lean | 233 + .../P5064T3Rectangles.lean | 52 + .../P5090T1TangentCircleMetric.lean | 56 + .../P5090T1ThreeDiskContactTriangle.lean | 177 + .../P5090T1TwoDiskLineTriangle.lean | 177 + .../P5098T1ABIntervals.lean | 38 + .../P5098T1ACIntervals.lean | 38 + .../P5098T1ADIntervals.lean | 39 + .../P5098T1BCIntervals.lean | 38 + .../P5098T1BDIntervals.lean | 38 + .../P5098T1CDIntervals.lean | 38 + .../P5098T1EqualIntervals.lean | 42 + .../P5098T1OccurrenceSquares.lean | 58 + .../P5098T1PeriodWindow.lean | 58 + .../P5098T1SquareIntersection.lean | 166 + .../P5104T1CornerDeletionDisk.lean | 110 + .../P5110T1AnchoredTriples.lean | 92 + .../P5110T1ParentLocalization.lean | 163 + .../P5110T1ParentModel.lean | 54 + .../P5110T1PositiveParentTriples.lean | 148 + .../P5110T1SquareInterface.lean | 807 +++ .../P5110T1TranslationTriples.lean | 159 + .../P5116T1PredecessorDeletionDisk.lean | 194 + .../P5116T1UnitDeletionDisk.lean | 119 + .../P5124T1BoundaryGeometry.lean | 98 + .../P5124T1EmptyParents.lean | 932 ++++ .../P5124T1ParentModel.lean | 55 + .../P5124T1ParentPlacement.lean | 75 + .../P5124T1SmallerParents.lean | 157 + .../P5124T1TranslatedDiamonds.lean | 162 + .../P5124T1UnitParents.lean | 163 + .../P5130T5BoundaryConsistency.lean | 50 + .../P5130T5DomainCover.lean | 46 + .../P5130T5MixedOverlaps.lean | 134 + .../P5130T5ParentArithmetic.lean | 66 + .../P5130T5PeriodicExtension.lean | 406 ++ .../P5130T5Prescription.lean | 48 + .../P5130T5SameParentOverlaps.lean | 450 ++ .../P5130T5UnitCase.lean | 63 + .../P5157T1AlternatingStaircase.lean | 85 + .../P5157T1DiamondSingletonIntersections.lean | 281 + .../P5157T1DiamondStaircaseIntersections.lean | 97 + .../P5157T1StaircasePoint.lean | 43 + .../P5188T1CeilingBelow.lean | 37 + .../P5188T1CeilingShift.lean | 37 + .../P5188T1CeilingStability.lean | 73 + .../P5188T1E1Boundary.lean | 176 + .../P5188T1E2Boundary.lean | 524 ++ .../P5188T1E3E4Boundary.lean | 236 + .../P5203T1CapInterface.lean | 351 ++ .../P5203T1DecreasingInterface.lean | 403 ++ .../P5203T1IncreasingInterface.lean | 231 + .../P5250T1CommonVertices.lean | 152 + .../P5250T1ConsecutiveEdges.lean | 176 + .../P5250T1RankedCommonEdges.lean | 68 + .../P5250T1SeparatedCells.lean | 68 + .../P5253T1BottomSquareContact.lean | 95 + .../P5253T1LeftSquareContacts.lean | 97 + .../P5253T1OneEdgeInterface.lean | 95 + .../P5253T1SingletonBoundary.lean | 76 + .../P5253T1TopSquareContacts.lean | 103 + .../P5260T1LiteralPlacement.lean | 257 + .../P5260T1PlacementLedger.lean | 81 + .../P5260T1PredecessorInterfaces.lean | 3255 +++++++++++ .../P5260T1UnitInterfaces.lean | 253 + .../P5269T1CenteredSquareTripleTransport.lean | 140 + .../P5269T1FordSquareNormalForm.lean | 62 + .../P5269T1IncomingSquareJunctions.lean | 153 + .../P5290T1ColumnReflection.lean | 174 + .../P5290T1EqualDiamondPaths.lean | 2542 +++++++++ .../P5290T1PredecessorPath.lean | 902 +++ .../P5290T1RawBoundaryInterfaces.lean | 89 + .../P5290T1UnitContactPaths.lean | 613 ++ .../P5300T1AffineCellObservables.lean | 97 + .../P5300T1CanonicalRowArithmetic.lean | 198 + .../P5300T1CenteredCellGeometry.lean | 106 + .../P5327T1RightSquareJunctions.lean | 152 + .../P5332T1LiteralNormalization.lean | 230 + .../P5332T1Parent1Rotation0Values.lean | 250 + .../P5332T1Parent1Rotation1Values.lean | 280 + .../P5332T1Parent1Rotation2Values.lean | 233 + .../P5332T1Parent1Rotation3Values.lean | 198 + .../P5332T1Parent2Rotation0Values.lean | 321 ++ .../P5332T1Parent2Rotation1Values.lean | 312 ++ .../P5332T1Parent2Rotation2Values.lean | 405 ++ .../P5332T1Parent2Rotation3Values.lean | 231 + .../P5332T1ParentRounding.lean | 121 + .../P5332T1ParentRows.lean | 117 + .../P5332T1RightFirstValues.lean | 228 + .../P5332T1RightHorizontalValues.lean | 166 + .../P5332T1RightRounding.lean | 148 + .../P5332T1RightRows.lean | 66 + .../P5332T1RightSecondValues.lean | 379 ++ .../P5332T1SignedParentIntervals.lean | 87 + .../P5332T1Stencil.lean | 46 + .../P5332T1VectorPlacements.lean | 82 + .../P5352T2DomainRows.lean | 56 + .../P5352T2FirstUnit.lean | 602 ++ .../P5352T2LiteralNormalization.lean | 167 + .../P5352T2PlacementData.lean | 73 + .../P5352T2Predecessor0.lean | 983 ++++ .../P5352T2Predecessor1.lean | 1202 ++++ .../P5352T2Predecessor2.lean | 1133 ++++ .../P5352T2Predecessor3.lean | 1059 ++++ .../P5352T2RightFirst.lean | 797 +++ .../P5352T2RightHorizontal.lean | 550 ++ .../P5352T2RightSecond.lean | 814 +++ .../P5352T2SecondUnit.lean | 174 + .../P5352T2SourceCertificates.lean | 92 + .../P5352T2Sources.lean | 51 + .../P5352T2VectorPlacements.lean | 74 + .../P5416T1DiamondAxialDifferences.lean | 80 + .../P5416T1SecondUnitGeometry.lean | 128 + .../P5432T1EdgeLedger.lean | 175 + .../P5432T1Interior.lean | 80 + .../P5432T1Normalization.lean | 95 + .../P5435T1Cocycle.lean | 152 + .../P5435T1PeriodGap.lean | 78 + .../P5435T1ShellPaths.lean | 169 + .../P5435T1WebGeometry.lean | 196 + .../P5442T1Cocycle.lean | 143 + .../P5442T1LaplacianBound.lean | 144 + .../P5442T1WebGeometry.lean | 438 ++ .../P5448T1CanonicalFordBoundary.lean | 80 + .../P5448T1CenteredFordGeometry.lean | 181 + .../P5448T1CommonAffineFordPair.lean | 165 + .../P5455T2AlignedPredecessor.lean | 72 + .../P5455T2CurvatureGrowth.lean | 81 + .../P5455T2LeftRegressions.lean | 92 + .../P5455T2OccurrenceDeterministic.lean | 348 ++ .../P5455T2OccurrenceExists.lean | 117 + .../P5455T2OccurrenceRotation.lean | 62 + .../P5455T2RightRegressions.lean | 92 + .../P5455T2RootAlignment.lean | 52 + .../P5455T2WholeJoin.lean | 57 + .../P5472T1AffineDifferenceTransport.lean | 127 + .../P5472T1CyclicAffineCommutation.lean | 95 + .../P5472T1CyclicPhaseCovariance.lean | 79 + .../P5472T1FordNormalization.lean | 431 ++ .../P5472T1FordSlopeDifference.lean | 199 + .../P5472T1LiteralFordPlacement.lean | 754 +++ .../P5478T1ExteriorPlacementIndex.lean | 131 + .../P5485T1FullInterfaceMarking.lean | 90 + .../P5485T1OtherCompanionCoordinates.lean | 75 + .../P5485T1RoutedInterfaceAvoidance.lean | 78 + .../P5491T1AffinePairReduction.lean | 125 + .../P5491T1DiamondParentBoundary.lean | 101 + .../P5491T1DiamondRightBoundary.lean | 795 +++ .../P5491T1ExceptionalPresentation.lean | 96 + .../P5491T1FordBoundarySlope.lean | 70 + .../P5491T1FordParentBoundary.lean | 196 + .../P5491T1FordRightBoundary.lean | 130 + .../P5532T1FiniteOrientationGluing.lean | 95 + .../P5532T1ForestAttachment.lean | 109 + .../P5532T1OrientationPullback.lean | 74 + .../P5532T1OverlapNoEntry.lean | 100 + .../P5532T1ParentInteriorGeometry.lean | 197 + .../P5532T1RestrictionMassBalance.lean | 121 + .../P5532T1SymmetryOrientationTransport.lean | 171 + .../P5537T1PredecessorCoordinates.lean | 56 + .../P5537T1PredecessorValues.lean | 111 + .../P5537T1ScaledDiamondFormula.lean | 67 + .../P5537T1UnitParentBoundary.lean | 236 + .../P5570T1UnitNormalForm.lean | 135 + .../P5570T1UnitQuadratic.lean | 38 + .../P5589T1EndpointCompatibility.lean | 106 + .../P5589T1LinkedUnitValues.lean | 167 + .../P5589T1UnitInterfaceSelection.lean | 259 + .../P5596T1CommonExtensionTransport.lean | 122 + .../P5596T1LeftWeb.lean | 1176 ++++ .../P5596T1LineParent.lean | 239 + .../P5606T1RightTerminalTransport.lean | 140 + .../P5606T1SubtileTerminalTransport.lean | 143 + ...eReachabilityAndBasepointConnectivity.lean | 134 + .../P5620T1BoundaryComponentCycle.lean | 404 ++ ...25T1CentroidSlopeDifferenceCovariance.lean | 127 + ...MarkedRightOdometerAdjacencyReduction.lean | 1085 ++++ ...0T1SymmetricMatrixPositivityCriterion.lean | 203 + .../P5635T1EndpointDiagonalOwnership.lean | 1987 +++++++ .../P5635T1RightBoundaryInterfaceRecords.lean | 1139 ++++ ...640T1NonpairedOccurrenceIntersections.lean | 792 +++ ...ivePointDomainCoverSymmetryCovariance.lean | 169 + ...T1TriangulationBarycentricCoordinates.lean | 180 + ...67T1CyclicChildrenOldArcsPreconnected.lean | 276 + .../P5667T1RoundedSupportingSlope.lean | 202 + .../P5667T1StraightFrontierLocalSides.lean | 970 ++++ .../P5682T1AlignedSquareRawInterfaces.lean | 115 + ...P5686T1UniformGlobalOdometerTransport.lean | 192 + .../P5691T1DiamondReflectionFootprints.lean | 359 ++ .../P5691T1PosDefQuadraticLowerBound.lean | 90 + .../PSDQuadraticIntegerApproximation.lean | 264 + .../ParentVectorsInTilingLattice.lean | 157 + .../ParentalOrientationGluing.lean | 466 ++ .../PartialOdometer.lean | 39 + .../PartialOdometerAffineTranslate.lean | 51 + ...artialOdometerAffineTranslateFormulas.lean | 300 + .../PartialOdometerHalfTurn.lean | 45 + .../PartialOdometerHalfTurnFormulas.lean | 239 + .../PartialOdometerSlope.lean | 52 + .../PartialOdometerSquares.lean | 37 + .../PeriodicBoundaryWebConnected.lean | 1084 ++++ .../PeriodicBoundaryWebLaplacian.lean | 1781 ++++++ .../PeriodicOdometerIndicatorRigidity.lean | 685 +++ .../PeriodicQuadraticRemainder.lean | 233 + .../PeriodicSubtileFaceIndex.lean | 41 + .../PeriodicSubtileIndex.lean | 40 + ...PeriodicTileAdjacentContactRegularity.lean | 47 + .../PeriodicTileComplex.lean | 48 + .../PeriodicTileContactRouting.lean | 136 + .../PeriodicTileContactRoutingRigidity.lean | 585 ++ .../PeriodicTileCore.lean | 130 + .../PeriodicTileCoverage.lean | 43 + .../PeriodicTileIndexedMultiplicityOne.lean | 152 + ...eriodicTileIntersectionClassification.lean | 148 + .../PeriodicTileIntersectionPaths.lean | 640 +++ .../PeriodicTileMultiplicityOne.lean | 42 + .../PeriodicTileTotalIndegree.lean | 2142 +++++++ .../PlaneEmbeddingAgreement.lean | 103 + .../PlaneFaceOrientation.lean | 54 + .../PlaneTriangulation.lean | 93 + .../PointwiseDiagonalCompactness.lean | 808 +++ .../PositiveCurvatureGeneratorCocycles.lean | 498 ++ .../PositiveCurvatureTileOdometerDomain.lean | 87 + ...CurvatureTileOdometerSupportTransport.lean | 95 + .../PositiveCurvatureTranslatedOdometers.lean | 730 +++ .../PositiveCutCompanionRow.lean | 175 + .../PositiveDefiniteRepresentativeGap.lean | 165 + .../PositiveTracePackingDichotomy.lean | 48 + .../ApollonianSuperharmonic/Preamble.lean | 35 + .../PrecursorBoundaryArcData.lean | 116 + .../PrimitiveVectorOrientation.lean | 68 + .../PrimitiveVectorOrientationUnique.lean | 256 + .../ProperBandCurvatureStructure.lean | 123 + .../ProperBandQuadruple.lean | 41 + .../ApollonianSuperharmonic/ProtoTile.lean | 39 + .../ProtoTileObservableExtensionality.lean | 70 + .../QuadraticAffineLaplacian.lean | 40 + .../QuadraticGrowthAtInfinity.lean | 45 + .../QuarterTurnSymmetric.lean | 38 + ...QuarterTurnSymmetricCenteredTransport.lean | 268 + ...rTurnSymmetricExactInterfaceTransport.lean | 580 ++ .../QuarterTurnSymmetricOccurrence.lean | 176 + .../RealFourNeighborLaplacian.lean | 37 + .../RealLaplacianContactComparison.lean | 80 + .../RealLaplacianLinearity.lean | 34 + .../RecursiveVectorSystem.lean | 76 + .../RecursiveVectorsExistUnique.lean | 207 + .../RegularTileFamily.lean | 34 + .../RegularTileFamilyTranslationUnique.lean | 49 + .../RightLatticeAdjacent.lean | 54 + ...tticeAdjacentPackingSymmetryTransport.lean | 1085 ++++ .../RightSubtileOdometerCompatibility.lean | 767 +++ .../RootedFourNeighborForest.lean | 44 + .../SemiProperForestClassification.lean | 154 + .../SemiProperQuadruple.lean | 55 + .../SimpleGridCycle.lean | 46 + .../SimpleGridCycleSubgraphDegreeTwo.lean | 193 + .../SimpleGridPath.lean | 45 + .../SimpleGridPathBetween.lean | 45 + .../SimpleGridPathEndpointPairUnique.lean | 482 ++ .../SimpleGridPathEquivariance.lean | 317 ++ .../SimpleGridPathPointTrichotomy.lean | 124 + .../SimpleGridPathVertexIncidentEdge.lean | 64 + .../SixSubtileFaceLabel.lean | 37 + .../SixSubtileFaceVertices.lean | 63 + .../SixSubtileLabel.lean | 39 + .../StandardSimplex.lean | 31 + .../SubtileLatticeAdjacent.lean | 65 + ...tticeAdjacentPackingSymmetryTransport.lean | 465 ++ .../SubtileOccurrenceInterpretation.lean | 51 + ...ileOccurrenceInterpretationCovariance.lean | 115 + .../SufficientBoundedMaximality.lean | 130 + .../SuperharmonicDownwardClosure.lean | 119 + ...SwappedAffineTriangularChartAlignment.lean | 108 + .../SymmetricMatrixCoordinateIdentity.lean | 36 + .../SymmetricMatrixCoordinates.lean | 40 + .../TangencyCoordinateBaseTables.lean | 43 + .../TangencyCoordinateIdentity.lean | 46 + .../TangencyCoordinateNormLaw.lean | 41 + .../TangencyCoordinatePolarizationLaw.lean | 47 + .../TangencyCoordinateRotation.lean | 41 + .../TangencyCoordinateSuccessorNorm.lean | 66 + ...ngencyCoordinateSuccessorPolarization.lean | 478 ++ .../ThreeOwnerDesignatedOppositePair.lean | 184 + .../ApollonianSuperharmonic/TileArea.lean | 34 + .../TileBordering.lean | 36 + .../TileCellComplement.lean | 35 + .../TileCellComplementCovariance.lean | 93 + .../ApollonianSuperharmonic/TileCentroid.lean | 37 + .../TileDiskAreaCovariance.lean | 127 + .../ApollonianSuperharmonic/TileHalfTurn.lean | 42 + .../TileHalfTurnFormulas.lean | 156 + .../ApollonianSuperharmonic/TileOdometer.lean | 114 + .../TileOdometerAffineTranslation.lean | 153 + .../TileOdometerBandPrototile.lean | 41 + .../TileOdometerCentralSymmetry.lean | 438 ++ .../TileOdometerExists.lean | 648 +++ .../TileOdometerReindexedDecomposition.lean | 127 + .../TileOdometerTranslationUniqueness.lean | 892 +++ .../TileQuarterTurn.lean | 39 + .../TileQuarterTurnFormulas.lean | 594 ++ .../TileRealization.lean | 37 + .../TileReflection.lean | 38 + .../TileReflectionFormulas.lean | 499 ++ .../ApollonianSuperharmonic/TileString.lean | 80 + .../TileStringCentralCovariance.lean | 524 ++ .../TileStringCoordinateTransport.lean | 896 +++ .../TileStringExists.lean | 70 + ...eStringRegularFamilyCentralCovariance.lean | 654 +++ .../TileStringUnique.lean | 72 + .../TileSubodometer.lean | 76 + ...eSubodometerLiteralDecompositionPiece.lean | 148 + .../TileT1DiskArea.lean | 496 ++ .../TileT2QuarterTurn.lean | 656 +++ .../TileT3TranslateTouching.lean | 159 + .../TileT4ParentTranslateTouching.lean | 150 + .../TileT5ParentTouching.lean | 169 + .../ApollonianSuperharmonic/TileTouching.lean | 46 + .../TileTouchingCovariance.lean | 212 + .../TileTranslation.lean | 35 + .../TileTranslationFormulas.lean | 447 ++ .../TilingLattice.lean | 45 + .../TilingLatticeBasis.lean | 829 +++ .../TilingLatticeCocycleExtension.lean | 143 + .../TilingLatticeInclusion.lean | 109 + .../TilingLatticeIndex.lean | 516 ++ .../TopologicalDisk.lean | 35 + .../TopologicalDiskExponentialLift.lean | 75 + ...pologicalDiskGridRayCrossingIndexZero.lean | 91 + ...gicalDiskLocallyPuncturedPreconnected.lean | 308 ++ .../TouchingTriple.lean | 40 + .../TouchingTripleCovariance.lean | 157 + .../TouchingTriplePermutations.lean | 105 + .../TraceNonpositivePackingApproximation.lean | 131 + .../TranslatedMinimumEnvelope.lean | 212 + .../TriangularBoundaryStrip.lean | 45 + .../TriangularLatticeAdjacent.lean | 43 + .../TriangularMaxIncrement.lean | 39 + .../TriangularSignedHeight.lean | 39 + .../TriangularStripSegment.lean | 46 + .../TriangularStripSegmentOrderInterval.lean | 404 ++ .../UniqueBoundedGridComplementComponent.lean | 54 + .../UnitOccurrenceOrientation.lean | 143 + .../UnitOccurrenceOrientationUnique.lean | 91 + .../UnitSquareOpposingStripInterfacePath.lean | 207 + .../UnitTriangularStep.lean | 50 + .../VectorDeterminant.lean | 231 + .../VectorNonvanishing.lean | 80 + .../VectorRecursionLaws.lean | 113 + .../VectorSquareProduct.lean | 759 +++ .../projects/apollonian-superharmonic.yaml | 58 + 1236 files changed, 448030 insertions(+) create mode 100644 LeanPool/ApollonianSuperharmonic.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AcyclicIndegreeOrientation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AffineTriangularComplexChart.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AffineTriangularCorridorStep.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AffineTriangularFace.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AffineTriangularFaceCoordinateSwap.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AffineTriangularFaceVertices.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AffineTriangularNoFourfoldCellOwners.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AffineTriangularStrip.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidenceZeroOppositeChord.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AncestorOdometer.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AncestorOdometerCentralCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AncestorOdometerInnerSupportNormalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AncestorOdometerOuterSupportNormalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AncestorOdometerTrans.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AncestorTile.lean create mode 100644 LeanPool/ApollonianSuperharmonic/AncestorTileCentralCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandCanonicalPeriodicExtension.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandCircle.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandCircleEnclosureDichotomy.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandCircleEuclideanData.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandDescartesGapSubdivision.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandDiskExteriorDensity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandGenealogy.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandGeneralCircle.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandInterfaceRootedForest.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandLatticeEquality.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandModifiedCellPartition.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandModifiedCoverage.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandModifiedOrbitArea.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandModifiedPeriodicComplex.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandModifiedUnionEquality.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOdometerMaximality.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOdometerTheorem.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralAggregatePatches.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralConfiguration.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralFinitePatches.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorStarClassification.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorWebRow.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayoutCertificate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMarkedSectorTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMixedAggregatePatches.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNestedRightOdometerRows.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNormalizedOccurrenceBundle.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOdometerRowData.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPeriodicBlockCells.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutOdometerRows.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizedBundleExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightOuterMarkingCriterion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightPlacement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedAdjacency.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRoutedSelectedContact.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRow.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRowExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedSCompanionGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralShiftedRoutedBoundaryLocalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalRows.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizedBundleExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtilePlacement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificateExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileSelectedRowGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryOccurrenceGenealogy.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryParentChain.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrientedChildParentEndpoints.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrientedChildParentIncomingEndpoint.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrientedGapRefinement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOrientedGapRefinementExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOriginalPairSeparation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingExterior.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingShiftPotential.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorAction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCircleAction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryGlobalOdometerTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryInversePhaseCancellation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerAction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerActionFormulas.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProjectiveVectorCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProperCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryQuadrupleAction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryReversesOrientation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhase.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhaseUnique.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetrySlopeAction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileAction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandParentBoundaryGenealogy.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandParentRotationOccurrenceCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPeriodicOdometer.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPredecessorNoCollision.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPrototile.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPrototileCentralSymmetry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPrototileCentroidUnique.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPrototileFootprintSlopeCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPrototileReindexedDecomposition.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPrototileTranslation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandRegimeClassification.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandRegularTileTouchingClassification.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandSignedOccurrenceHalfTurn.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandSubtileOccurrence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandSubtileOccurrenceTranslation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandSuccessorClassification.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandTangency.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandTangencyDensity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandTileSimultaneousInduction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandTwelveParentSurround.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoreCertificate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoverage.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandUnmodifiedPeriodicCore.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandVectorOrientationDichotomy.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandVectors.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BoundaryFootprintEdges.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertexDegreeTwo.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertices.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BoundaryJoinChamberCertificate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BoundaryString.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BoundedDifference.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CellDisjointCommonEdgesBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CellSupportedFootprintVertices.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CentrallyReflectedAt.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CircleCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CircleMatrix.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CircleMatrixEnclosureCriterion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CircleMatrixIncomingVector.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ClosedSquareRealization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CommonFootprintEdgeVertices.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ConnectedCommonBoundaryPath.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierGraph.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierUnion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ConsecutivePatchInterface.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CurvatureOneBandCircleClassification.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CurvatureOneBandPrototileSingleton.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CurvatureOneOdometer.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CurvatureOnePeriodicOdometer.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CurvatureOneTileBase.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondBaseT1.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondBaseT2.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondBaseTouching.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondCellDomain.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondCoordinateConfiguration.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondExceptionalLattice.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondExceptionalMatrixLatticeIdentification.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondLaplacianTable.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondOdometer.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondOdometerExistsUnique.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondOrientedChildParentEndpoints.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondParameter.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondPeakMatrix.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondRecursiveQuadruple.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondRegimeConverse.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondTerminalWebStencilLedger.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondTile.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondTileAcyclicIndegree.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondTileGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondTileOdometerRestriction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondTileRecursiveIdentification.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondVertexDomains.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DisjointSquareUnionCommonEdgeCarrier.lean create mode 100644 LeanPool/ApollonianSuperharmonic/EuclideanCircleData.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ExactPatchBoundaryInterface.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ExactTileInterfaceDisjointCompanionEndpoints.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTriple.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleLatticeTouching.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTriplePackingSymmetryCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleRetargetMiddle.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleSwapLast.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ExactTileTiling.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ExceptionalConnectorSegments.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ExceptionalRestorationSectorData.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FiniteAcyclicGraphCardConnected.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FiniteAcyclicOrientationObstruction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FiniteConnectedCellSetNoCheckerboard.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FiniteCycleComponentList.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FiniteGridEdgeGraphEncoding.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FiniteInducedTilePatch.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FinitePatchTopology.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FinitePolyominoDiskCriterion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FiniteTile.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FootprintDeletionRetention.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FootprintEdges.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FootprintVertices.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordBaseT1.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordBaseT2.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordBaseT6.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordBaseTouching.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordBoundaryMultiplicity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordCellDomain.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordCenteredInteriorOdometerStencil.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordCircleCoordinate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordDoubledBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordExceptionalLattice.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordExceptionalMatrixLatticeIdentification.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordExceptionalMaximality.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordFareyParameter.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordFareyParentsExist.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordOdometer.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordOdometerFamilyExistsUnique.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordOrientedChildParentRightEndpoint.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordPeakMatrix.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordRecursiveQuadruple.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordRecursiveVertexDomains.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordRegimeConverse.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordTile.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordTileAcyclicIndegree.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordTileGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordTileRecursiveIdentification.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordVertexDomain.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FourNeighborAdjacent.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FourNeighborConnected.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FourNeighborLaplacian.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GaussianQuarterTurn.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GaussianRealPoint.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GaussianReflection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GaussianTranslation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GlobalOdometerExtends.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GridCellCenter.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GridEdgeCarrier.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GridHorizontalLogLiftDelta.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GridRayCrossingIndex.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexAdjacentCell.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexZeroOfEdgeLifts.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GridSegmentLogLiftDelta.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GridStepLogLiftDelta.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GridVerticalDownLogLiftDelta.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GridVerticalUpLogLiftDelta.lean create mode 100644 LeanPool/ApollonianSuperharmonic/Imports.lean create mode 100644 LeanPool/ApollonianSuperharmonic/IncomingSuperbasisRelation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/IntegerCeilDiv.lean create mode 100644 LeanPool/ApollonianSuperharmonic/IntegerLaplacianCastBridge.lean create mode 100644 LeanPool/ApollonianSuperharmonic/IntegerLatticeFunction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/IntegerPreservingNormalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicCharacterization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicClosedness.lean create mode 100644 LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicRepresentative.lean create mode 100644 LeanPool/ApollonianSuperharmonic/IntegralityLattice.lean create mode 100644 LeanPool/ApollonianSuperharmonic/IntegralityLatticeIndex.lean create mode 100644 LeanPool/ApollonianSuperharmonic/IntegralityTiling.lean create mode 100644 LeanPool/ApollonianSuperharmonic/IsolatedPrecursorCoverage.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LambdaTiling.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeCell.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeDiskUnionIntersectionConnected.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeEdgeRegularity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeFundamentalSet.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeQuadraticForm.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeTile.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeTileDiskUnionInterface.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeTileFourNeighborConnected.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeTileGridStructure.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeTileNoCheckerboard.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeVertexBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeVertexIncidentCell.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LeftAdjacentOdometerCompatibility.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacent.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LocalExponentialEstimate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean create mode 100644 LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ModifiedSubtileOccurrenceInterpretation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/NoCheckerboardCellVertex.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OdometerAdjacencyInduction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OdometerCompatibility.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OdometerGluing.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OdometerStringRespect.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OdometerStringRespectCentralCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OdometerTranslation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OdometerWeb.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OpenLatticeEdge.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OpposingBoundaryInterfaceExhaustion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OrientedUnimodularStripConcatenation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OuterLayoutTouching.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OuterTouchingAlternative.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P2999T1CompleteSquareTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P2999T1OrthogonalSlopeTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P2999T1ShiftSlopeTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3019T1ChamberSegmentOrder.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3019T1ChamberStripGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3019T1UnimodularStripWindow.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3045T1RightBoundaryDisplacementAlgebra.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3055T1ExteriorCentralIncidence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3055T1ParentVectorNormalForms.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3055T1SignedCentroidNormalForms.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3092T1DiamondCenteredRectangles.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3102T2CommonEdgeSectorTransition.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3102T2IsolatedRoutedCellSurvival.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3102T2OppositeOwnersCommonEdge.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3102T2PeriodicFourSectorObstruction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3161T1AggregateComplementConnectivity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3161T1AggregateInducedConnectivity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3161T1BlockTreeReachability.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3161T1SquareTriangleComplement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3161T2IncidentBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3161T2PathExhaustion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3161T2PathSubwalk.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3192T1FourOwnerTriangleExclusion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3192T1PeriodicIndicesInfinite.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3192T1SimplePathOrientation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3221T2ClosedWalkCirculation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3221T2ConnectedPathIntegration.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3221T2IntegralSquareFilling.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3221T2TileFillingSupport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3350T1GraphCellUnionConnected.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3381T1AffineTriangleMap.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3381T1PairedTriangulation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3381T1PiecewiseAffinePolygonModel.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3381T1PolygonBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3381T1TriangleDeterminant.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3475T1BoundaryReduction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3475T1BoundaryRestoration.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3475T1BoundarySubdivision.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3475T1PolygonTriangleConstruction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3475T1PolygonalSeparation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3475T1SquareUnionIdentification.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3475T1TriangleTree.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3475T1UnitSegmentIntersection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3497T1StrictCornerSplice.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3497T1SubdivisionComposition.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3497T1TriangleCornerNonzero.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3511T1AttachmentIntersection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3511T1ConvexComparison.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3511T1ConvexRealization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3511T1CyclicDissection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3511T1LeafOrder.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3511T1SourceConstruction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3511T1SourceDissection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3523T1BoundaryFaceSplit.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3523T1FaceEnumeration.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3523T1InsertionConstruction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3523T1InsertionData.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3523T1InterpolatedTarget.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3523T1SplitDeterminants.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3523T1SubdivisionExit.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3523T1TargetHull.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3544T1BoundaryCarrier.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSelection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSplit.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3544T1IndexedGluing.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3544T1LocalParity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3544T1RayParity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3555T2ParabolaSupporting.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3597T1GenericRayStability.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildren.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3650T1ExposedCorner.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3650T1ParitySum.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3650T1VisibleDiagonal.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3652T1ChildFillSeparation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3652T1DiagonalFaceIntersections.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3652T1ParentOddGluing.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3652T1TriangleFaceRestriction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3723T1AllContactRouting.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3723T1ContactPorts.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3723T1ContactStabilizer.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialIntersection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialParameterization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3723T1EdgeContact.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3723T1GridDiskBoundaryStars.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3723T1GridDiskPairedModel.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3723T1PairedModelSegmentPullback.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3723T1PolygonalParameterization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3767T1BarrierRegionMaximal.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3767T1FixedFaceComponents.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3767T1FixedTrace.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3767T1VertexEdgeIncidence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1CellCenterMembership.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1DiskMapExponentialLift.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1DualEdges.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1EquivariantDisplacementBound.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1FixedGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1OpenStar.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1PlaneMapExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1SectorMaps.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1StarWeights.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1StarWeightsExist.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1TileContractions.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1TileContractionsExist.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1WalkMap.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrementLaws.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3821T1LoopIndex.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3821T1LoopIndexLaws.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3832T1ChamberOverlap.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3832T1CollapsedConeDescent.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3832T1ConeCollapse.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3832T1FiniteClosedCoverPasting.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3861T1ExtraArcLocalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3861T1FacialDomains.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3861T1RealPolygonDomains.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3861T1RoutedFaceOrientation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3861T1RoutedFacialDomains.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectorDecomposition.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3913T1OffFaceExterior.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3913T1PeriodicPositionUnbounded.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3913T1RoutedArcExterior.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3913T1RoutedTraceClosed.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3934T1ArcSide.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3934T1LocalSide.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSide.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSidePropagation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3934T1SectorSelection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3963T1DeletedPairExteriorConnected.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3963T1EdgeFreeDiskCorners.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3996T1AdjacentParentPlacement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3996T1CenteredQuarterTurnInclusion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3996T1SRowParameters.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P3996T1SRowTable.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4055T1BandQuarterTurn.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4055T1ExactTripleImage.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4055T1GridPathImage.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4055T1PackingGridEquivalence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4062T1InteriorSquare.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4062T1OrientationTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4062T1ParentGluing.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4062T1RankedAttachment.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4062T1RecursiveInteriors.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4062T1RemainderGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4062T1RemainderPaths.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4062T1ZeroIncoming.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4085T1FordIncomingNormalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4085T1MinusTouching.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4085T1RestrictedAdaptedActions.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4112T1BoundaryMultiplicity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4120T1AffineComparison.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4120T1DiamondGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4120T1GeneralRowData.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4120T1RootNormalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4158T1AncestorCells.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4158T1StringSlopeTelescoping.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4194T1DiamondCellRows.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4194T1DiamondCentroid.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4194T1DiamondVertexIncidence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4207T1DiamondFormula.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4207T1FloorArithmetic.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4207T1FormulaRestriction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4207T1ShiftedPredecessor.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4207T1UnitRestrictions.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4210T1FordCellRectangles.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4210T1FordSquareCentroid.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4217T2RectangularBoundarySlope.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4217T2SquareGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4217T2SquareRestriction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4223T1DiamondRowNumerators.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4250T1DefinedHalfIntegralSlope.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4250T1IntegralAffinePlacement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4250T1ParentSlopePhase.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4250T1SlopeOffset.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4250T2IndegreeSubtraction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4250T2PrecursorRootSeparation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T1ContactAdjacency.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T1EdgeExterior.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T1ExteriorAdjacency.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T1ExteriorIndices.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T1PlacedOdometer.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T2AdjacentMatrixSlope.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T2DiamondBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T2InterfacePropagation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T2LiteralInterface.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T2PairNormalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T2RegularEdgeReduction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4261T2UnitStringTelescoping.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4339T1EmptyPrecursorRoots.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4339T1PrecursorArcSeparation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4339T1PrecursorSupportGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4366T1AttachedRemainderIndexZero.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4366T1PrecursorRemainderFamily.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4366T2WalkExhaustion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4387T1ParentSlopeNormalForms.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4387T1PlacedCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4397T1PathAvoidsPrecursorEdges.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4397T1ReflectedEdgeNotBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4397T1SimplePathSplicing.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4397T1UnitEdgeCells.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4418T3EndpointOwnerIndices.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceData.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4431T1OwnerTransitionSelector.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4456T2DiamondNoChord.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4456T2EdgeInterior.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4456T2PackingNoChord.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4456T2ParentSide.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4456T2VertexInterior.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4458T1BoundaryFrame.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4458T1BoundaryPlacement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4458T1BoundarySide.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4458T1RestrictionFamily.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4458T1SmallPairRows.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4458T1ThirdNewerRows.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4536T1EndpointAlgebra.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4536T1EndpointDifferences.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4536T1HalfOffsetBridge.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4536T1RegularJoin.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4536T1SmallUnitSides.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4536T1TangentPairMatrix.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4549T1DeeperFrameB.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4549T1NegativeIncomingSide.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4564T2DiamondOrderExclusion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4564T2ElementaryQuarterTurn.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4564T2GeometryPullback.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4566T1LiteralSuccessorCharts.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4566T1SmallPairCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4566T1SmallRetainedSides.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4566T1StrictRetainedGenealogy.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4566T1UnitPairCharts.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4590T1CentralDiskSectors.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4590T1JunctionRouting.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4590T1MixedCompanionMarks.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4590T1OppositeCellsStar.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4590T1OriginalNonedges.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4590T1PositivePrototileDisk.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4590T1ReflectedCenterBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4590T1RotationalDiskCenter.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4590T1SixLabelBoundaryCount.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4616T1FirstPredecessorCentroids.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4616T1MixedCoarseSectors.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4616T1NestedCompanionFootprints.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4616T1OriginalMixedPaths.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4616T1PeriodicEndpointExclusion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4616T1ThirdOwnerPathEndpoint.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockExterior.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockLinks.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockPaths.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4630T1AffineCellSymmetry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4630T1CellRouteLift.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4630T1ExteriorNeighbors.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4630T1ExteriorWalks.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4630T1GridComplementCriterion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4630T1ParentRotation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4630T1RingIndex.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4638T1AntipodalContactArcs.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4638T1EmptyCurvature.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4638T1FordIncidentCells.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4638T1MidpointReflection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4651T1ContactEdgeSeparation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4651T1FreeBoundaryHalfTurn.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4651T1GridHalfTurnTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4670T1ComplementReflection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4670T1OrdinaryEdges.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4670T1SmallerGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4677T2DrawingData.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4677T2DrawingExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4677T2IncidenceLedger.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4677T2PeriodicWalkAssembly.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4677T2TouchingWalk.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1Arc.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1BoundaryCycle.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1CoefficientEdges.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1CoefficientTranslation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1FaceShift.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1Hexagon.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1HexagonSubdivision.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1HexagonTessellation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1IndexAction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1LatticeCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1Offsets.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1OrbitRepresentatives.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1PatchEnumeration.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1PatchFaces.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1PlaneMap.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1Position.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1PositionInjective.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1Region.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4715T1VertexShift.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4733T1ContainedWalk.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4733T1Coordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4733T1EdgeOrbit.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4733T1EdgeRow.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4733T1FacePairNormalForm.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4733T1FacePairOrbit.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4733T1OccurrenceTranslation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4733T1RepresentativeWalks.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4733T1RowIncidence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4733T1RowLabelRigidity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4733T1WalkExtension.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4733T1WalkTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4780T1ActiveFacets.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4780T1HullHalfspaces.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4780T1IntegerCoverage.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4780T1InteriorSeparation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4780T1NeighborCorners.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4780T1NeighborFacets.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4780T1OverlapBound.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4780T1StrictInterior.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4783T1ParallelogramFan.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4783T1PatchCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4783T1PatchCoverage.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4783T1PatchDeterminants.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4793T1FacetForms.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4793T1PatchBoundaryTraces.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4793T1PatchFacetLedger.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4793T1PatchIntersections.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4793T1PatchSeparators.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4793T1SeparatorIntersection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4793T1SupportingFace.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4802T1CrossPatchFaces.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4802T1HexagonOverlapSide.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4802T1PatchFaceRestriction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4802T1SideRestriction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4802T1SimplexFaces.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4802T1TriangleIndependent.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4812T1AffineDrawing.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4812T1AffineTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4812T1LatticeCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4812T1ReflectedTouching.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4818T1AffineTransversalExtension.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4818T1BoundaryRecovery.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4818T1ClosedOverlaps.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4818T1HalfOpen.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4818T1OverlapDifferences.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1ConstructorSupport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1Disk.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1Evaluate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1FiniteWordSeparation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1Gap.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1HistoryNormalForm.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1HistoryRealization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1LinePlacement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1LineSupport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1ParentsDistinct.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1ResidualPatches.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1Root.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1RootSeparation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1Rotate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1RotationLaws.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4828T1Step.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4840T6ConstructorCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4840T6DiamondRecurrence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4840T6NegatedRoot.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4840T6ProperGrowth.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4840T6ShiftRoot.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4849T1Component.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4849T1ComponentRestriction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4849T1InfiniteLimitComponent.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4849T1LocalLimitAdmissibility.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4849T1MinimumTruncation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4849T1PeriodAnchoring.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4849T1PeriodResidues.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4849T1SetDiagonalSubsequence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4903T1ScalarTangencies.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4903T1SignedDiskHull.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4909T1LineFan.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4909T1OmittedDiskBarrier.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4909T1ParentEdges.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4909T1ParentPolygon.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4909T1TangentSegments.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4909T1TriangleFan.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4953T1HullHeight.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4953T1LiteralHulls.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4981T1EdgePrescription.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4981T1EdgeRank.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionCoherence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionLocality.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionValue.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4981T1ProperEquations.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4981T1Recursion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4981T1RootEquations.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4984T1BranchDecay.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4984T1ClosedGap.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4984T1ClosedSubdivision.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4984T1ContactDiameter.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4984T1RootGaps.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4994T6Chamber.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4994T6ChamberAdditions.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4994T6ChartCovolume.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4994T6NonunitBirth.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4994T6NonunitChamber.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4994T6Rotation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4994T6RotationLaws.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4994T6StepChamber.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4994T6UnitChartRotation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4994T6UnitCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4994T6UnitOccurrenceChamber.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P4994T6UnitRootTable.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5023T1CircularEstimate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5023T1ContactHull.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5023T1ContactVertices.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5023T1ConvexDiameter.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5023T1LineEstimate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5023T1LineSideGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5050T1ParentSphereSection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5050T1RadialSection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5050T1TangentLineSection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5050T1TangentTriangleSection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5064T3CrossParentSupport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5064T3LiteralLocalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5064T3OrderedPredecessor.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5064T3PrecursorSupport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5064T3RectangleContacts.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5064T3Rectangles.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5090T1TangentCircleMetric.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5090T1ThreeDiskContactTriangle.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5090T1TwoDiskLineTriangle.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5098T1ABIntervals.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5098T1ACIntervals.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5098T1ADIntervals.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5098T1BCIntervals.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5098T1BDIntervals.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5098T1CDIntervals.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5098T1EqualIntervals.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5098T1OccurrenceSquares.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5098T1PeriodWindow.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5098T1SquareIntersection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5104T1CornerDeletionDisk.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5110T1AnchoredTriples.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5110T1ParentLocalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5110T1ParentModel.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5110T1PositiveParentTriples.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5110T1TranslationTriples.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5116T1PredecessorDeletionDisk.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5116T1UnitDeletionDisk.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5124T1BoundaryGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5124T1EmptyParents.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5124T1ParentModel.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5124T1ParentPlacement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5124T1SmallerParents.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5124T1TranslatedDiamonds.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5124T1UnitParents.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5130T5BoundaryConsistency.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5130T5DomainCover.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5130T5MixedOverlaps.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5130T5ParentArithmetic.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5130T5PeriodicExtension.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5130T5Prescription.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5130T5UnitCase.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5157T1AlternatingStaircase.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5157T1DiamondSingletonIntersections.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5157T1DiamondStaircaseIntersections.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5157T1StaircasePoint.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5188T1CeilingBelow.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5188T1CeilingShift.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5188T1CeilingStability.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5188T1E1Boundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5188T1E3E4Boundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5203T1IncreasingInterface.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5250T1CommonVertices.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5250T1ConsecutiveEdges.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5250T1RankedCommonEdges.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5250T1SeparatedCells.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5253T1BottomSquareContact.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5253T1LeftSquareContacts.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5253T1OneEdgeInterface.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5253T1SingletonBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5253T1TopSquareContacts.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5260T1LiteralPlacement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5260T1PlacementLedger.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5260T1UnitInterfaces.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5269T1CenteredSquareTripleTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5269T1FordSquareNormalForm.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5269T1IncomingSquareJunctions.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5290T1ColumnReflection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5290T1RawBoundaryInterfaces.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5300T1AffineCellObservables.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5300T1CanonicalRowArithmetic.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5300T1CenteredCellGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5327T1RightSquareJunctions.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1LiteralNormalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation0Values.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation1Values.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation2Values.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation3Values.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation3Values.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1ParentRounding.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1ParentRows.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1RightFirstValues.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1RightHorizontalValues.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1RightRounding.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1RightRows.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1SignedParentIntervals.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1Stencil.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5332T1VectorPlacements.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5352T2DomainRows.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5352T2LiteralNormalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5352T2PlacementData.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5352T2RightFirst.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5352T2SecondUnit.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5352T2SourceCertificates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5352T2Sources.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5352T2VectorPlacements.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5416T1DiamondAxialDifferences.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5416T1SecondUnitGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5432T1EdgeLedger.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5432T1Interior.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5432T1Normalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5435T1Cocycle.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5435T1PeriodGap.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5435T1ShellPaths.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5435T1WebGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5442T1Cocycle.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5442T1LaplacianBound.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5442T1WebGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5448T1CanonicalFordBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5448T1CenteredFordGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5448T1CommonAffineFordPair.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5455T2AlignedPredecessor.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5455T2CurvatureGrowth.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5455T2LeftRegressions.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceRotation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5455T2RightRegressions.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5455T2RootAlignment.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5455T2WholeJoin.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5472T1AffineDifferenceTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5472T1CyclicAffineCommutation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5472T1CyclicPhaseCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5472T1FordNormalization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5472T1LiteralFordPlacement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5478T1ExteriorPlacementIndex.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5485T1FullInterfaceMarking.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5485T1OtherCompanionCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5485T1RoutedInterfaceAvoidance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5491T1AffinePairReduction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5491T1DiamondParentBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5491T1ExceptionalPresentation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5491T1FordBoundarySlope.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5491T1FordParentBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5491T1FordRightBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5532T1FiniteOrientationGluing.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5532T1ForestAttachment.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5532T1OrientationPullback.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5532T1OverlapNoEntry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5532T1ParentInteriorGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5532T1RestrictionMassBalance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5532T1SymmetryOrientationTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5537T1PredecessorCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5537T1PredecessorValues.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5537T1ScaledDiamondFormula.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5537T1UnitParentBoundary.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5570T1UnitNormalForm.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5570T1UnitQuadratic.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5589T1EndpointCompatibility.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5589T1LinkedUnitValues.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5589T1UnitInterfaceSelection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5596T1CommonExtensionTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5596T1LineParent.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5606T1RightTerminalTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5606T1SubtileTerminalTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5617T1RectangleReachabilityAndBasepointConnectivity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5620T1BoundaryComponentCycle.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5625T1CentroidSlopeDifferenceCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5630T1SymmetricMatrixPositivityCriterion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5635T1RightBoundaryInterfaceRecords.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5640T1NonpairedOccurrenceIntersections.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5658T1FivePointDomainCoverSymmetryCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5662T1TriangulationBarycentricCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5667T1CyclicChildrenOldArcsPreconnected.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5667T1RoundedSupportingSlope.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5682T1AlignedSquareRawInterfaces.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5686T1UniformGlobalOdometerTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5691T1DiamondReflectionFootprints.lean create mode 100644 LeanPool/ApollonianSuperharmonic/P5691T1PosDefQuadraticLowerBound.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PSDQuadraticIntegerApproximation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ParentVectorsInTilingLattice.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ParentalOrientationGluing.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PartialOdometer.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslate.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslateFormulas.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurn.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurnFormulas.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PartialOdometerSlope.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PartialOdometerSquares.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicQuadraticRemainder.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicSubtileFaceIndex.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicSubtileIndex.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicTileAdjacentContactRegularity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicTileComplex.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicTileContactRouting.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicTileContactRoutingRigidity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicTileCore.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicTileCoverage.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicTileIndexedMultiplicityOne.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionClassification.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionPaths.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicTileMultiplicityOne.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PlaneEmbeddingAgreement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PlaneFaceOrientation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PlaneTriangulation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PointwiseDiagonalCompactness.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerDomain.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerSupportTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PositiveCutCompanionRow.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PositiveDefiniteRepresentativeGap.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PositiveTracePackingDichotomy.lean create mode 100644 LeanPool/ApollonianSuperharmonic/Preamble.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PrecursorBoundaryArcData.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientationUnique.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ProperBandCurvatureStructure.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ProperBandQuadruple.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ProtoTile.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ProtoTileObservableExtensionality.lean create mode 100644 LeanPool/ApollonianSuperharmonic/QuadraticAffineLaplacian.lean create mode 100644 LeanPool/ApollonianSuperharmonic/QuadraticGrowthAtInfinity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetric.lean create mode 100644 LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricExactInterfaceTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricOccurrence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/RealFourNeighborLaplacian.lean create mode 100644 LeanPool/ApollonianSuperharmonic/RealLaplacianContactComparison.lean create mode 100644 LeanPool/ApollonianSuperharmonic/RealLaplacianLinearity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean create mode 100644 LeanPool/ApollonianSuperharmonic/RecursiveVectorsExistUnique.lean create mode 100644 LeanPool/ApollonianSuperharmonic/RegularTileFamily.lean create mode 100644 LeanPool/ApollonianSuperharmonic/RegularTileFamilyTranslationUnique.lean create mode 100644 LeanPool/ApollonianSuperharmonic/RightLatticeAdjacent.lean create mode 100644 LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean create mode 100644 LeanPool/ApollonianSuperharmonic/RootedFourNeighborForest.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SemiProperForestClassification.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SemiProperQuadruple.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SimpleGridCycle.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SimpleGridCycleSubgraphDegreeTwo.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SimpleGridPath.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SimpleGridPathBetween.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SimpleGridPathPointTrichotomy.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SimpleGridPathVertexIncidentEdge.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SixSubtileFaceLabel.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SixSubtileFaceVertices.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SixSubtileLabel.lean create mode 100644 LeanPool/ApollonianSuperharmonic/StandardSimplex.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacent.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretationCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SufficientBoundedMaximality.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SuperharmonicDownwardClosure.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SwappedAffineTriangularChartAlignment.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinateIdentity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TangencyCoordinateBaseTables.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TangencyCoordinateIdentity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TangencyCoordinateNormLaw.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TangencyCoordinatePolarizationLaw.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TangencyCoordinateRotation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorNorm.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorPolarization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ThreeOwnerDesignatedOppositePair.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileArea.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileBordering.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileCellComplement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileCellComplementCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileCentroid.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileDiskAreaCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileHalfTurn.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileHalfTurnFormulas.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileOdometer.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileOdometerAffineTranslation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileOdometerBandPrototile.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileOdometerReindexedDecomposition.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileQuarterTurn.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileRealization.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileReflection.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileString.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileStringCentralCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileStringExists.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileStringUnique.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileSubodometer.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileSubodometerLiteralDecompositionPiece.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileT3TranslateTouching.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileT4ParentTranslateTouching.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileT5ParentTouching.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileTouching.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileTouchingCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileTranslation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileTranslationFormulas.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TilingLattice.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TilingLatticeCocycleExtension.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TilingLatticeInclusion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TilingLatticeIndex.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TopologicalDisk.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TopologicalDiskExponentialLift.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TopologicalDiskGridRayCrossingIndexZero.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TopologicalDiskLocallyPuncturedPreconnected.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TouchingTriple.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TouchingTripleCovariance.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TouchingTriplePermutations.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TraceNonpositivePackingApproximation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TranslatedMinimumEnvelope.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TriangularBoundaryStrip.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TriangularLatticeAdjacent.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TriangularMaxIncrement.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TriangularSignedHeight.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TriangularStripSegment.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TriangularStripSegmentOrderInterval.lean create mode 100644 LeanPool/ApollonianSuperharmonic/UniqueBoundedGridComplementComponent.lean create mode 100644 LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientationUnique.lean create mode 100644 LeanPool/ApollonianSuperharmonic/UnitSquareOpposingStripInterfacePath.lean create mode 100644 LeanPool/ApollonianSuperharmonic/UnitTriangularStep.lean create mode 100644 LeanPool/ApollonianSuperharmonic/VectorDeterminant.lean create mode 100644 LeanPool/ApollonianSuperharmonic/VectorNonvanishing.lean create mode 100644 LeanPool/ApollonianSuperharmonic/VectorRecursionLaws.lean create mode 100644 LeanPool/ApollonianSuperharmonic/VectorSquareProduct.lean create mode 100644 LeanPool/projects/apollonian-superharmonic.yaml diff --git a/LeanPool/ApollonianSuperharmonic.lean b/LeanPool/ApollonianSuperharmonic.lean new file mode 100644 index 0000000000..8777e961a5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicCharacterization +public import LeanPool.ApollonianSuperharmonic.BandOdometerTheorem +public import LeanPool.ApollonianSuperharmonic.IntegralityTiling +public import LeanPool.ApollonianSuperharmonic.LambdaTiling +public import LeanPool.ApollonianSuperharmonic.BandLatticeEquality + +/-! +# Apollonian classification of integer superharmonic matrices + +Source: arxiv:1309.3267, url:https://github.com/wpegden/superharmonic +Authors: Wesley Pegden +Status: verified +Main declarations: `ApollonianSuperharmonic.IntegerSuperharmonicCharacterization`, + `ApollonianSuperharmonic.BandOdometerTheorem`, `ApollonianSuperharmonic.IntegralityTiling`, + `ApollonianSuperharmonic.LambdaTiling`, `ApollonianSuperharmonic.BandLatticeEquality` +Tags: apollonian-packings, superharmonic-functions, discrete-potential-theory, lattice-tilings +MSC: 31C20, 52C15, 60G50 +-/ + +/-! +## Upstream formalization + +Adapted from Wesley Pegden's Apache-2.0 Trellis formalization at commit +`45094b210503f117502dec51caf737e96da221f8`. The mathematical source is Levine, +Pegden and Smart, *The Apollonian structure of integer superharmonic matrices*. +Trellis produced the Lean proofs using AI agents; the project records `AI` provenance. + +The imported scope is the dependency closure of the five public root theorems. +The upstream paper, process tooling and development history are not imported. +The upstream reference notes explain two local repairs to the printed proof: +edge-supported interfaces with isolated corners, and occurrence-oriented unit strings. +-/ diff --git a/LeanPool/ApollonianSuperharmonic/AcyclicIndegreeOrientation.lean b/LeanPool/ApollonianSuperharmonic/AcyclicIndegreeOrientation.lean new file mode 100644 index 0000000000..bbd93a1439 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AcyclicIndegreeOrientation.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian + +-- [TABLET NODE: AcyclicIndegreeOrientation] + +/-! +# AcyclicIndegreeOrientation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $D$ be a finite set of lattice vertices and let +$\sigma:\mathbb Z[i]\to\mathbb Z$ be an ambient lattice function. An +\emph{acyclic indegree orientation with data $\sigma$} chooses exactly one +direction on every four-neighbor edge of the induced graph on $D$, chooses +no other directed edges, and has indegree $\sigma(x)$ at each $x\in D$. +Thus only the restriction of the ambient function $\sigma$ to $D$ supplies +the prescribed indegrees. A natural-valued rank strictly increasing along +every directed edge is included as an explicit certificate of acyclicity. +-/ +structure AcyclicIndegreeOrientation (D : Finset GaussianInt) + (σ : GaussianInt → ℤ) where +-- BODY + /-- The chosen direction of each edge of the finite lattice graph. -/ + edge : GaussianInt → GaussianInt → Prop + /-- Decidable membership in the chosen directed edge relation. -/ + edge_decidable : ∀ x y, Decidable (edge x y) + /-- A natural rank that increases strictly along each directed edge. -/ + rank : GaussianInt → ℕ + supported : ∀ x y, edge x y → + x ∈ D ∧ y ∈ D ∧ FourNeighborAdjacent x y + oriented : ∀ x ∈ D, ∀ y ∈ D, FourNeighborAdjacent x y → + (edge x y ∧ ¬ edge y x) ∨ (edge y x ∧ ¬ edge x y) + increasing : ∀ x y, edge x y → rank x < rank y + indegree : ∀ x ∈ D, + ((D.filter fun y => @decide (edge y x) (edge_decidable y x)).card : ℤ) = σ x + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean b/LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean new file mode 100644 index 0000000000..993ed1dd30 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean @@ -0,0 +1,1281 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AffineTriangularCorridorStep +public import LeanPool.ApollonianSuperharmonic.TriangularStripSegmentOrderInterval +public import Mathlib.Data.List.Range + +-- [TABLET NODE: AffineOpposingStripCorridor] + +/-! +# AffineOpposingStripCorridor + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OpposingStripProof + +private theorem ppseg : + (by + classical + exact + ∀ (A : ℤ), ∀ (B : ℤ), ((2 : ℤ) ≤ A) → ( + let h : Int → Int := fun k => (B*k+A-1)/A + (∀ (k : Int), 0 ≤ A*h k-B*k ∧ A*h k-B*k < A) → ((∀ (k : Int), h (k+1) = h k ∨ h (k+1) = h + k+1) → ((TriangularMaxIncrement (0,0) (A,B) = A) → ((TriangularMaxIncrement (A,B) (0,0) = + A) → ( + let N := A.toNat + ((N : Int) = A) → ( + let p : Nat → Int × Int := fun k => (k, h k) + let PP := (List.range (N+1)).map p + (Function.Injective p) → ((PP.head? = some (0,0)) → ((PP.getLast? = some (A,B)) → + (TriangularStripSegment (0,0) (A,B) PP))))))))) ) := by + classical + intro A B hA h hh hnext hmax hrmax N hN p PP pinj phead plast + rw [TriangularStripSegment, ite_eq_right (by + intro he + have := congrArg Prod.fst he + simp at this + omega)] + refine ⟨phead, plast, List.nodup_range.map pinj, ?_, ?_⟩ + · intro z hz + obtain ⟨k, _, rfl⟩ := List.mem_map.mp hz + simpa [TriangularBoundaryStrip, TriangularSignedHeight, hmax, p] using hh k + · apply (List.isChain_map p).mpr + apply (List.isChain_range_succ _ N).mpr + intro k hk + rcases hnext k with he | he <;> + simp [TriangularLatticeAdjacent, p, Nat.cast_add, Prod.sub_def, he] + +private theorem qqseg : + (by + classical + exact + ∀ (A : ℤ), ∀ (B : ℤ), ((2 : ℤ) ≤ A) → ( + let l : Int → Int := fun k => (B*k)/A + (∀ (k : Int), 0 ≤ B*k-A*l k ∧ B*k-A*l k < A) → ((∀ (k : Int), l (k+1) = l k ∨ l (k+1) = l + k+1) → ((TriangularMaxIncrement (0,0) (A,B) = A) → ((TriangularMaxIncrement (A,B) (0,0) = + A) → ( + let N := A.toNat + ((N : Int) = A) → ( + let q : Nat → Int × Int := fun k => (k, l k) + let QQ := ((List.range (N+1)).map q).reverse + (Function.Injective q) → ((((List.range (N+1)).map q).head? = some (0,0)) → ((((List.range + (N+1)).map q).getLast? = some (A,B)) → (TriangularStripSegment (A,B) (0,0) QQ))))))))) ) + := by + classical + intro A B hA l hl lnext hmax hrmax N hN q QQ qinj qhead qlast + rw [TriangularStripSegment, ite_eq_right (by + intro he + have := congrArg Prod.fst he + simp at this + omega)] + refine ⟨?_, ?_, List.nodup_reverse.mpr (List.nodup_range.map qinj), ?_, ?_⟩ + · simpa [QQ] using qlast + · simpa [QQ] using qhead + · intro z hz + obtain ⟨k, _, rfl⟩ := List.mem_map.mp (List.mem_reverse.mp hz) + have he : TriangularSignedHeight (A,B) (0,0) (q k) = B*k-A*l k := by + dsimp [TriangularSignedHeight, q] + ring + simpa [TriangularBoundaryStrip, hrmax, he] using hl k + · apply List.isChain_reverse.mpr + apply (List.isChain_map q).mpr + apply (List.isChain_range_succ _ N).mpr + intro k hk + rcases lnext k with he | he <;> + simp [TriangularLatticeAdjacent, q, Nat.cast_add, Prod.sub_def, he] + +private theorem interior : + (by + classical + exact + ∀ (path : List (ℤ × ℤ)), ∀ (a : ℤ × ℤ), ∀ (b : ℤ × ℤ), ∀ (z : ℤ × ℤ), path.head? = some a → + path.getLast? = some b → z ∈ path → z ≠ a → z ≠ b → z ∈ (List.drop (1 : ℕ) path).dropLast + ) := by + classical + intro path a b z ha hb hz hza hzb + cases path with + | nil => simp at hz + | cons c t => + have hc : c = a := by simpa using ha + have hzt : z ∈ t := by simpa [hc, hza] using hz + have ht : t ≠ [] := List.ne_nil_of_mem hzt + have hbt : t.getLast? = some b := by simpa [List.getLast?_cons_of_ne_nil ht] using hb + apply List.mem_dropLast_of_mem_of_ne_getLast? hzt + simpa [hbt] using hzb + +private theorem bvertices : + (by + classical + exact + ∀ (P : List (ℤ × ℤ)), ∀ (Q : List (ℤ × ℤ)), ∀ (A : ℤ), ∀ (B : ℤ), + let l : Int → Int := fun k => (B*k)/A + let h : Int → Int := fun k => (B*k+A-1)/A + let N := A.toNat + let p : Nat → Int × Int := fun k => (k, h k) + let q : Nat → Int × Int := fun k => (k, l k) + (∀ (k : Nat), (0 < k ∧ k < N) → (p k ∈ (P.drop 1).dropLast)) → ((∀ (k : Nat), (0 < k ∧ k + < N) + → (q k ∈ (Q.drop 1).dropLast)) → ((∀ (k : Int), h k = l k ∨ h k = l k+1) → ( + let block : Nat → List AffineTriangularFace := fun k => + if h k = l k then + [.down (k,l k), .up (k,l k+1), .down ((k : Int)+1,l k), .up (k,h k)] + else [.down (k,l k), .up (k,h k)] + ∀ (k : ℕ), (0 : ℕ) < k ∧ k < N → ∀ f ∈ block k, (∃ a ∈ (List.drop (1 : ℕ) P).dropLast, a ∈ + AffineTriangularFaceVertices f) ∧ ∃ b ∈ (List.drop (1 : ℕ) Q).dropLast, b ∈ + AffineTriangularFaceVertices f))) ) := by + classical + intro P Q A B l h N p q pmem qmem gap block k hk f hf + have hp := pmem k hk + have hq := qmem k hk + dsimp [block] at hf + split at hf + · rename_i he + refine ⟨⟨p k,hp,?_⟩,⟨q k,hq,?_⟩⟩ + all_goals + simp only [List.mem_cons, List.not_mem_nil, or_false] at hf + rcases hf with rfl | rfl | rfl | rfl <;> + simp [AffineTriangularFaceVertices, p,q,he,Prod.add_def,Prod.sub_def] + · rename_i he + have hg : h k = l k+1 := (gap k).resolve_left he + refine ⟨⟨p k,hp,?_⟩,⟨q k,hq,?_⟩⟩ + all_goals + simp only [List.mem_cons, List.not_mem_nil, or_false] at hf + rcases hf with rfl | rfl <;> + simp [AffineTriangularFaceVertices,p,q,hg,Prod.add_def,Prod.sub_def] + +private theorem bchain : + (by + classical + exact + ∀ (P : List (ℤ × ℤ)), ∀ (Q : List (ℤ × ℤ)), ∀ (A : ℤ), ∀ (B : ℤ), + let l : Int → Int := fun k => (B*k)/A + let h : Int → Int := fun k => (B*k+A-1)/A + let N := A.toNat + let p : Nat → Int × Int := fun k => (k, h k) + let q : Nat → Int × Int := fun k => (k, l k) + (∀ (k : Nat), (0 < k ∧ k < N) → (p k ∈ (P.drop 1).dropLast)) → ((∀ (k : Nat), (0 < k ∧ k + < N) + → (q k ∈ (Q.drop 1).dropLast)) → ((∀ (k : Int), h k = l k ∨ h k = l k+1) → ( + let block : Nat → List AffineTriangularFace := fun k => + if h k = l k then + [.down (k,l k), .up (k,l k+1), .down ((k : Int)+1,l k), .up (k,h k)] + else [.down (k,l k), .up (k,h k)] + (∀ (f : AffineTriangularFace), ∀ (g : AffineTriangularFace), ∀ (u : Int × Int), ∀ (v : Int × + Int), (f ≠ g) → ((u ≠ v) → ((TriangularLatticeAdjacent u v) → ((u ∈ + AffineTriangularFaceVertices f) → ((v ∈ AffineTriangularFaceVertices f) → ((u ∈ + AffineTriangularFaceVertices g) → ((v ∈ AffineTriangularFaceVertices g) → (((u ∈ (P.drop + 1).dropLast ∧ v ∈ (Q.drop 1).dropLast) ∨ (u ∈ (P.drop 1).dropLast ∧ u ∈ (Q.drop + 1).dropLast)) → (AffineTriangularCorridorStep P Q f g))))))))) → (∀ (k : ℕ), (0 : ℕ) < k + ∧ k < N → List.IsChain (AffineTriangularCorridorStep P Q) (block k))))) ) := by + classical + intro P Q A B l h N p q pmem qmem gap block mkstep k hk + have hp := pmem k hk + have hq := qmem k hk + dsimp [block] + split + · rename_i he + have pq : p k = q k := by simp [p,q,he] + have hm : p k ∈ (P.drop 1).dropLast ∧ p k ∈ (Q.drop 1).dropLast := + ⟨hp, pq ▸ hq⟩ + have s1 : AffineTriangularCorridorStep P Q (.down (k,l k)) (.up (k,l k+1)) := by + apply mkstep _ _ (p k) ((k : Int),l k+1) + · simp + · simp [p,he] + · simp [TriangularLatticeAdjacent,p,he,Prod.sub_def] + · simp [AffineTriangularFaceVertices,p,he] + · simp [AffineTriangularFaceVertices,Prod.add_def] + · simp [AffineTriangularFaceVertices,p,he,Prod.sub_def] + · simp [AffineTriangularFaceVertices] + · exact Or.inr hm + have s2 : AffineTriangularCorridorStep P Q (.up (k,l k+1)) (.down ((k : Int)+1,l k)) := by + apply mkstep _ _ (p k) ((k : Int)+1,l k+1) + · simp + · simp [p,he] + · simp [TriangularLatticeAdjacent,p,he,Prod.sub_def] + · simp [AffineTriangularFaceVertices,p,he,Prod.sub_def] + · simp [AffineTriangularFaceVertices,Prod.add_def] + · simp [AffineTriangularFaceVertices,p,he,Prod.sub_def] + · simp [AffineTriangularFaceVertices,Prod.add_def] + · exact Or.inr hm + have s3 : AffineTriangularCorridorStep P Q (.down ((k : Int)+1,l k)) (.up (k,h k)) := by + apply mkstep _ _ (p k) ((k : Int)+1,l k) + · simp + · simp [p,he] + · simp [TriangularLatticeAdjacent,p,he,Prod.sub_def] + · simp [AffineTriangularFaceVertices,p,he,Prod.sub_def] + · simp [AffineTriangularFaceVertices] + · simp [AffineTriangularFaceVertices,p] + · simp [AffineTriangularFaceVertices,he,Prod.add_def] + · exact Or.inr hm + simpa only [List.isChain_cons_cons, List.isChain_singleton, and_true] using ⟨s1,s2,s3⟩ + · rename_i he + have hg : h k = l k+1 := (gap k).resolve_left he + have ss : AffineTriangularCorridorStep P Q (.down (k,l k)) (.up (k,h k)) := by + apply mkstep _ _ (p k) (q k) + · simp + · simp [p,q,hg] + · simp [TriangularLatticeAdjacent,p,q,hg,Prod.sub_def] + · simp [AffineTriangularFaceVertices,p,hg,Prod.add_def] + · simp [AffineTriangularFaceVertices,q] + · simp [AffineTriangularFaceVertices,p] + · simp [AffineTriangularFaceVertices,q,hg,Prod.sub_def] + · exact Or.inl ⟨hp,hq⟩ + simpa using ss + +private theorem joinstep : + (by + classical + exact + ∀ (P : List (ℤ × ℤ)), ∀ (Q : List (ℤ × ℤ)), ∀ (A : ℤ), ∀ (B : ℤ), + let l : Int → Int := fun k => (B*k)/A + let h : Int → Int := fun k => (B*k+A-1)/A + let N := A.toNat + let p : Nat → Int × Int := fun k => (k, h k) + let q : Nat → Int × Int := fun k => (k, l k) + (∀ (k : Nat), (0 < k ∧ k < N) → (p k ∈ (P.drop 1).dropLast)) → ((∀ (k : Nat), (0 < k ∧ k + < N) + → (q k ∈ (Q.drop 1).dropLast)) → ((∀ (k : Int), l (k+1) = h k ∨ l (k+1) = h k-1) → ((∀ (k + : Int), (l (k+1) = h k-1) → (h k = l k+1 ∧ h (k+1) = h k)) → ((∀ (f : + AffineTriangularFace), ∀ (g : AffineTriangularFace), ∀ (u : Int × Int), ∀ (v : Int × + Int), (f ≠ g) → ((u ≠ v) → ((TriangularLatticeAdjacent u v) → ((u ∈ + AffineTriangularFaceVertices f) → ((v ∈ AffineTriangularFaceVertices f) → ((u ∈ + AffineTriangularFaceVertices g) → ((v ∈ AffineTriangularFaceVertices g) → (((u ∈ (P.drop + 1).dropLast ∧ v ∈ (Q.drop 1).dropLast) ∨ (u ∈ (P.drop 1).dropLast ∧ u ∈ (Q.drop + 1).dropLast)) → (AffineTriangularCorridorStep P Q f g))))))))) → (∀ (k : ℕ), (0 : ℕ) < k + ∧ k + (1 : ℕ) < N → AffineTriangularCorridorStep P Q (AffineTriangularFace.up ((↑k : ℤ), + h (↑k : ℤ))) (AffineTriangularFace.down ((↑k : ℤ) + (1 : ℤ), l ((↑k : ℤ) + (1 : + ℤ))))))))) ) := by + classical + intro P Q A B l h N p q pmem qmem between below mkstep k hk + rcases between k with he | he + · apply mkstep _ _ (p k) (q (k+1)) + · simp + · simp [p,q] + · simp [TriangularLatticeAdjacent,p,q,Nat.cast_add,he,Prod.sub_def] + · simp [AffineTriangularFaceVertices,p] + · simp [AffineTriangularFaceVertices,q,Nat.cast_add,he,Prod.add_def] + · simp [AffineTriangularFaceVertices,p,he,Prod.sub_def] + · simp [AffineTriangularFaceVertices,q] + · exact Or.inl ⟨pmem k (by omega), qmem (k+1) (by omega)⟩ + · obtain ⟨he1,he2⟩ := below k he + apply mkstep _ _ (p (k+1)) (q k) + · simp + · simp [p,q] + · simp [TriangularLatticeAdjacent,p,q,Nat.cast_add,he1,he2,Prod.sub_def] + · simp [AffineTriangularFaceVertices,p,Nat.cast_add,he2,Prod.add_def] + · simp [AffineTriangularFaceVertices,q,he1,Prod.sub_def] + · simp [AffineTriangularFaceVertices,p,Nat.cast_add,he,he2,Prod.add_def] + · simp [AffineTriangularFaceVertices,q,he,he1,Prod.sub_def] + · exact Or.inl ⟨pmem (k+1) (by omega), qmem k (by omega)⟩ + +private theorem fsproperties : + (by + classical + exact + ∀ (P : List (ℤ × ℤ)), ∀ (Q : List (ℤ × ℤ)), ∀ (A : ℤ), ∀ (B : ℤ), + let l : Int → Int := fun k => (B*k)/A + let h : Int → Int := fun k => (B*k+A-1)/A + let N := A.toNat + let block : Nat → List AffineTriangularFace := fun k => + if h k = l k then + [.down (k,l k), .up (k,l k+1), .down ((k : Int)+1,l k), .up (k,h k)] + else [.down (k,l k), .up (k,h k)] + (∀ (k : Nat), (block k).head? = some (.down (k,l k))) → ((∀ (k : Nat), (block k).getLast? = + some (.up (k,h k))) → ((∀ (k : Nat), block k ≠ []) → ((∀ (k : Nat), (0 < k ∧ k < N) → (∀ + f ∈ block k, (∃ a ∈ (P.drop 1).dropLast, a ∈ AffineTriangularFaceVertices f) ∧ (∃ b ∈ + (Q.drop 1).dropLast, b ∈ AffineTriangularFaceVertices f))) → ((∀ (k : Nat), (0 < k ∧ k < + N) → ((block k).IsChain (AffineTriangularCorridorStep P Q))) → ((∀ (k : Nat), (0 < k ∧ + k+1 < N) → (AffineTriangularCorridorStep P Q (.up (k,h k)) (.down (k+1,l (k+1))))) → ( + let fs : Nat → List AffineTriangularFace := fun n => + (List.range n).flatMap (fun i => block (i+1)) + ∀ (n : ℕ), (0 : ℕ) < n ∧ n < N → fs n ≠ [] ∧ (fs n).head? = some (AffineTriangularFace.down + ((1 : ℤ), l (1 : ℤ))) ∧ (fs n).getLast? = some (AffineTriangularFace.up ((↑n : ℤ), h (↑n + : ℤ))) ∧ (∀ f ∈ fs n, (∃ a ∈ (List.drop (1 : ℕ) P).dropLast, a ∈ + AffineTriangularFaceVertices f) ∧ ∃ b ∈ (List.drop (1 : ℕ) Q).dropLast, b ∈ + AffineTriangularFaceVertices f) ∧ List.IsChain (AffineTriangularCorridorStep P Q) (fs + n))))))) ) := by + classical + intro P Q A B l h N block bhead blast bne bvertices bchain joinstep fs n hn + induction n with + | zero => omega + | succ n ih => + by_cases hn0 : n = 0 + · subst n + have he : fs 1 = block 1 := by simp [fs] + rw [he] + exact ⟨bne 1,bhead 1,blast 1,bvertices 1 hn,bchain 1 hn⟩ + · obtain ⟨hne,hhead,hlast,hvertices,hchain⟩ := ih (by omega) + have he : fs (n+1) = fs n ++ block (n+1) := by + simp [fs,List.range_succ,List.flatMap_append] + rw [he] + refine ⟨by simp [hne],?_,?_,?_,?_⟩ + · simp [List.head?_append, hhead] + · simp [List.getLast?_append, blast (n + 1)] + · intro f hf + rcases List.mem_append.mp hf with hf | hf + · exact hvertices f hf + · exact bvertices (n+1) (by omega) f hf + · apply hchain.append (bchain (n+1) (by omega)) + intro f hf g hg + have hf' : f = .up (n,h n) := by simpa [hlast] using hf.symm + have hg' : g = .down (n+1,l (n+1)) := by simpa [bhead] using hg.symm + subst f; subst g + exact joinstep n (by omega) + +private theorem pullback : + (by + classical + exact + let corridor (x y : Int × Int) (P Q : List (Int × Int)) : Prop := + ∃ faces : List AffineTriangularFace, + faces ≠ [] ∧ + (∃ f, faces.head? = some f ∧ x ∈ AffineTriangularFaceVertices f) ∧ + (∃ f, faces.getLast? = some f ∧ y ∈ AffineTriangularFaceVertices f) ∧ + (∀ f ∈ faces, + (∃ a ∈ (P.drop 1).dropLast, a ∈ AffineTriangularFaceVertices f) ∧ + (∃ b ∈ (Q.drop 1).dropLast, b ∈ AffineTriangularFaceVertices f)) ∧ + faces.IsChain (AffineTriangularCorridorStep P Q) + ∀ (E : ℤ × ℤ ≃ ℤ × ℤ), ∀ (F : AffineTriangularFace ≃ AffineTriangularFace), (∀ (u : ℤ × + ℤ), ∀ (v : ℤ × ℤ), TriangularLatticeAdjacent ((E : ℤ × ℤ → ℤ × ℤ) u) ((E : ℤ × ℤ → ℤ + × ℤ) v) ↔ + TriangularLatticeAdjacent u v) → (∀ (z : ℤ × ℤ), ∀ (f : AffineTriangularFace), (E : ℤ × ℤ + → ℤ × ℤ) z ∈ AffineTriangularFaceVertices ((F : AffineTriangularFace → + AffineTriangularFace) f) ↔ z ∈ AffineTriangularFaceVertices f) → ∀ (x : ℤ × ℤ), ∀ (y : ℤ + × ℤ), ∀ (P : List (ℤ × ℤ)), ∀ (Q : List (ℤ × ℤ)), corridor ((E : ℤ × ℤ → ℤ × ℤ) x) ((E : + ℤ × ℤ → ℤ × ℤ) y) (List.map (⇑E : ℤ × ℤ → ℤ × ℤ) P) (List.map (⇑E : ℤ × ℤ → ℤ × ℤ) Q) → + corridor x y P Q ) := by + classical + intro corridor E F hAdj hInc x y P Q hcorr + classical + obtain ⟨fs,hne,⟨f0,hhead,hx⟩,⟨f1,hlast,hy⟩,hv,hc⟩ := hcorr + have inc (z : Int × Int) (f : AffineTriangularFace) + (hz : z ∈ AffineTriangularFaceVertices f) : + E.symm z ∈ AffineTriangularFaceVertices (F.symm f) := by + apply (hInc (E.symm z) (F.symm f)).mp + simpa using hz + have inner (p : List (Int × Int)) (z : Int × Int) + (hz : z ∈ ((p.map E).drop 1).dropLast) : E.symm z ∈ (p.drop 1).dropLast := by + rw [← List.map_drop, ← List.map_dropLast] at hz + obtain ⟨u,hu,rfl⟩ := List.mem_map.mp hz + simpa using hu + have step (f g : AffineTriangularFace) (hs : AffineTriangularCorridorStep (P.map E) (Q.map E) f + g) : + AffineTriangularCorridorStep P Q (F.symm f) (F.symm g) := by + obtain ⟨hfg,u,v,huv,hadj,huf,hvf,hug,hvg,hm⟩ := hs + refine ⟨fun he => hfg (F.symm.injective he), E.symm u,E.symm v, + fun he => huv (E.symm.injective he),?_,inc u f huf,inc v f hvf,inc u g hug,inc v g hvg,?_⟩ + · apply (hAdj (E.symm u) (E.symm v)).mp + simpa using hadj + · rcases hm with ⟨hp,hq⟩ | ⟨hp,hq⟩ + · exact Or.inl ⟨inner P u hp,inner Q v hq⟩ + · exact Or.inr ⟨inner P u hp,inner Q u hq⟩ + refine ⟨fs.map F.symm,by simpa using hne, + ⟨F.symm f0,?_,?_⟩,⟨F.symm f1,?_,?_⟩,?_,?_⟩ + · simp [hhead] + · simpa using inc (E x) f0 hx + · simp [hlast] + · simpa using inc (E y) f1 hy + · intro f hf + obtain ⟨g,hg,rfl⟩ := List.mem_map.mp hf + obtain ⟨⟨a,ha,haf⟩,⟨b,hb,hbf⟩⟩ := hv g hg + exact ⟨⟨E.symm a,inner P a ha,inc a g haf⟩, + ⟨E.symm b,inner Q b hb,inc b g hbf⟩⟩ + · apply (List.isChain_map F.symm).mpr + exact hc.imp step + +private theorem segmentMap : + (by + classical + exact + ∀ (E : ℤ × ℤ ≃ ℤ × ℤ), (∀ (x : ℤ × ℤ), ∀ (y : ℤ × ℤ), ∀ (z : ℤ × ℤ), TriangularSignedHeight + ((E : ℤ × ℤ → ℤ × ℤ) x) ((E : ℤ × ℤ → ℤ × ℤ) y) ((E : ℤ × ℤ → ℤ × ℤ) z) = + TriangularSignedHeight x y z) → (∀ (x : ℤ × ℤ), ∀ (y : ℤ × ℤ), TriangularMaxIncrement ((E + : ℤ × ℤ → ℤ × ℤ) x) ((E : ℤ × ℤ → ℤ × ℤ) y) = TriangularMaxIncrement x y) → (∀ (u : ℤ × + ℤ), ∀ (v : ℤ × ℤ), TriangularLatticeAdjacent ((E : ℤ × ℤ → ℤ × ℤ) u) ((E : ℤ × ℤ → ℤ × ℤ) + v) ↔ TriangularLatticeAdjacent u v) → ∀ (x : ℤ × ℤ), ∀ (y : ℤ × ℤ), x ≠ y → ∀ (P : List + (ℤ × ℤ)), TriangularStripSegment x y P → TriangularStripSegment ((E : ℤ × ℤ → ℤ × ℤ) x) + ((E : ℤ × ℤ → ℤ × ℤ) y) (List.map (⇑E : ℤ × ℤ → ℤ × ℤ) P) ) := by + classical + intro E hH hM hAdj x y hxy P hP + have hexy : E x ≠ E y := fun he => hxy (E.injective he) + simp only [TriangularStripSegment,ite_eq_right hxy] at hP + simp only [TriangularStripSegment,ite_eq_right hexy] + refine ⟨by simp [hP.1],by simp [hP.2.1],hP.2.2.1.map E.injective,?_,?_⟩ + · intro z hz + obtain ⟨u,hu,rfl⟩ := List.mem_map.mp hz + simpa [TriangularBoundaryStrip,hH,hM] using hP.2.2.2.1 u hu + · apply (List.isChain_map E).mpr + exact hP.2.2.2.2.imp (fun u v h => (hAdj u v).mpr h) + +private theorem chamber : + (by + classical + exact + ∀ (x : Int × Int), ∀ (y : Int × Int), + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1-z.2,z.1) + invFun := fun z => (z.2,z.2-z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + let T : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => z-x + invFun := fun z => z+x + left_inv := fun z => by simp + right_inv := fun z => by simp } + let E : Nat → (Int × Int) ≃ (Int × Int) := fun n => T.trans (R^n) + (y.1-x.1 ≠ 0 ∨ y.2-x.2 ≠ 0) → (∃ n : Nat, 0 < (E n y).1 ∧ 0 ≤ (E n y).2 ∧ (E n y).2 < (E n + y).1) ) := by + classical + intro x y R T E hnonzero + by_cases ha : 0 ≤ y.1-x.1 + · by_cases hb : 0 ≤ y.2-x.2 + · by_cases hba : y.2-x.2 < y.1-x.1 + · refine ⟨0,?_⟩ + simp [E,T] + omega + · by_cases ha0 : y.1-x.1 = 0 + · refine ⟨4,?_⟩ + norm_num [E,T,R,pow_succ,Equiv.Perm.mul_apply] + omega + · refine ⟨5,?_⟩ + norm_num [E,T,R,pow_succ,Equiv.Perm.mul_apply] + omega + · refine ⟨1,?_⟩ + norm_num [E,T,R,pow_succ,Equiv.Perm.mul_apply] + omega + · by_cases hb : 0 ≤ y.2-x.2 + · by_cases hb0 : y.2-x.2 = 0 + · refine ⟨3,?_⟩ + norm_num [E,T,R,pow_succ,Equiv.Perm.mul_apply] + omega + · refine ⟨4,?_⟩ + norm_num [E,T,R,pow_succ,Equiv.Perm.mul_apply] + omega + · by_cases hba : y.2-x.2 ≤ y.1-x.1 + · refine ⟨2,?_⟩ + norm_num [E,T,R,pow_succ,Equiv.Perm.mul_apply] + omega + · refine ⟨3,?_⟩ + norm_num [E,T,R,pow_succ,Equiv.Perm.mul_apply] + omega + +end OpposingStripProof + +namespace OpposingStripDetails + +private theorem hl : + (by + classical + exact + ∀ (A : ℤ), ∀ (B : ℤ), ((2 : ℤ) ≤ A) → ( + let l : Int → Int := fun k => (B*k)/A + ∀ (k : ℤ), (0 : ℤ) ≤ B * k - A * l k ∧ B * k - A * l k < A) ) := by + classical + intro A B hA l k + have h0 := Int.emod_nonneg (B*k) (by omega : A ≠ 0) + have h1 := Int.emod_lt_of_pos (B*k) (by omega : 0 < A) + have h2 := Int.emod_add_mul_ediv (B*k) A + dsimp [l] + omega + +private theorem hh : + (by + classical + exact + ∀ (A : ℤ), ∀ (B : ℤ), ((2 : ℤ) ≤ A) → ( + let h : Int → Int := fun k => (B*k+A-1)/A + ∀ (k : ℤ), (0 : ℤ) ≤ A * h k - B * k ∧ A * h k - B * k < A) ) := by + classical + intro A B hA h k + have h0 := Int.emod_nonneg (B*k+A-1) (by omega : A ≠ 0) + have h1 := Int.emod_lt_of_pos (B*k+A-1) (by omega : 0 < A) + have h2 := Int.emod_add_mul_ediv (B*k+A-1) A + dsimp [h] + omega + +private theorem hluniq : + (by + classical + exact + ∀ (A : ℤ), ∀ (B : ℤ), ((2 : ℤ) ≤ A) → ( + let l : Int → Int := fun k => (B*k)/A + (∀ (k : Int), 0 ≤ B*k-A*l k ∧ B*k-A*l k < A) → (∀ (k : ℤ), ∀ (s : ℤ), (0 : ℤ) ≤ B * k - A + * s ∧ B * k - A * s < A → s = l k)) ) := by + classical + intro A B hA l hl k s hs + have := hl k + have : -1 < s-l k ∧ s-l k < 1 := by constructor <;> nlinarith + omega + +private theorem hhuniq : + (by + classical + exact + ∀ (A : ℤ), ∀ (B : ℤ), ((2 : ℤ) ≤ A) → ( + let h : Int → Int := fun k => (B*k+A-1)/A + (∀ (k : Int), 0 ≤ A*h k-B*k ∧ A*h k-B*k < A) → (∀ (k : ℤ), ∀ (s : ℤ), (0 : ℤ) ≤ A * s - B + * k ∧ A * s - B * k < A → s = h k)) ) := by + classical + intro A B hA h hh k s hs + have := hh k + have : -1 < s-h k ∧ s-h k < 1 := by constructor <;> nlinarith + omega + +private theorem lnext : + (by + classical + exact + ∀ (A : ℤ), ∀ (B : ℤ), ((2 : ℤ) ≤ A) → (((0 : ℤ) ≤ B) → ((B < A) → ( + let l : Int → Int := fun k => (B*k)/A + (∀ (k : Int), 0 ≤ B*k-A*l k ∧ B*k-A*l k < A) → (∀ (k : ℤ), l (k + (1 : ℤ)) = l k ∨ l (k + + (1 : ℤ)) = l k + (1 : ℤ))))) ) := by + classical + intro A B hA hB hBA l hl k + have := hl k + have := hl (k+1) + have : -1 < l (k+1)-l k ∧ l (k+1)-l k < 2 := by constructor <;> nlinarith + omega + +private theorem hnext : + (by + classical + exact + ∀ (A : ℤ), ∀ (B : ℤ), ((2 : ℤ) ≤ A) → (((0 : ℤ) ≤ B) → ((B < A) → ( + let h : Int → Int := fun k => (B*k+A-1)/A + (∀ (k : Int), 0 ≤ A*h k-B*k ∧ A*h k-B*k < A) → (∀ (k : ℤ), h (k + (1 : ℤ)) = h k ∨ h (k + + (1 : ℤ)) = h k + (1 : ℤ))))) ) := by + classical + intro A B hA hB hBA h hh k + have := hh k + have := hh (k+1) + have : -1 < h (k+1)-h k ∧ h (k+1)-h k < 2 := by constructor <;> nlinarith + omega + +private theorem hmax : + (by + classical + exact + ∀ (A : ℤ), ∀ (B : ℤ), ((2 : ℤ) ≤ A) → (((0 : ℤ) ≤ B) → ((B < A) → ( + let l : Int → Int := fun k => (B*k)/A + let h : Int → Int := fun k => (B*k+A-1)/A + (l A = B) → ((h A = B) → (TriangularMaxIncrement (0,0) (A,B) = A))))) ) := by + classical + intro A B hA hB hBA l h hlA hhA + simp only [TriangularMaxIncrement, sub_zero] + rw [abs_of_nonneg (by omega : 0 ≤ A), abs_of_nonneg hB, + abs_of_nonneg (by omega : 0 ≤ A-B)] + omega + +private theorem hrmax : + (by + classical + exact + ∀ (A : ℤ), ∀ (B : ℤ), ((2 : ℤ) ≤ A) → (((0 : ℤ) ≤ B) → ((B < A) → ( + let l : Int → Int := fun k => (B*k)/A + let h : Int → Int := fun k => (B*k+A-1)/A + (l A = B) → ((h A = B) → ((TriangularMaxIncrement (0,0) (A,B) = A) → + (TriangularMaxIncrement (A,B) (0,0) = A)))))) ) := by + classical + intro A B hA hB hBA l h hlA hhA hmax + simp only [TriangularMaxIncrement, zero_sub, abs_neg] + have he : -A - -B = -(A-B) := by ring + rw [he, abs_neg, abs_of_nonneg (by omega : 0 ≤ A), abs_of_nonneg hB, + abs_of_nonneg (by omega : 0 ≤ A-B)] + omega + +private theorem pinj : + (by + classical + exact + ∀ (A : ℤ), ∀ (B : ℤ), + let h : Int → Int := fun k => (B*k+A-1)/A + let p : Nat → Int × Int := fun k => (k, h k) + Function.Injective p ) := by + classical + intro A B h p i j he + have := congrArg Prod.fst he + simpa [p] using this + +private theorem qinj : + (by + classical + exact + ∀ (A : ℤ), ∀ (B : ℤ), + let l : Int → Int := fun k => (B*k)/A + let q : Nat → Int × Int := fun k => (k, l k) + Function.Injective q ) := by + classical + intro A B l q i j he + have := congrArg Prod.fst he + simpa [q] using this + +private theorem pmem : + (by + classical + exact + ∀ (P : List (ℤ × ℤ)), ∀ (A : ℤ), ∀ (B : ℤ), + let h : Int → Int := fun k => (B*k+A-1)/A + (TriangularMaxIncrement (0,0) (A,B) = A) → ((TriangularMaxIncrement (A,B) (0,0) = A) → ( + let N := A.toNat + ((N : Int) = A) → ( + let p : Nat → Int × Int := fun k => (k, h k) + let PP := (List.range (N+1)).map p + (PP.head? = some (0,0)) → ((PP.getLast? = some (A,B)) → ((P = PP) → ((∀ (path : List (Int + × Int)), ∀ (a : Int × Int), ∀ (b : Int × Int), ∀ (z : Int × Int), (path.head? = some + a) → ((path.getLast? = some b) → ((z ∈ path) → ((z ≠ a) → ((z ≠ b) → (z ∈ (path.drop + 1).dropLast)))))) → (∀ (k : ℕ), (0 : ℕ) < k ∧ k < N → p k ∈ (List.drop (1 : ℕ) + P).dropLast))))))) ) := by + classical + intro P A B h hmax hrmax N hN p PP phead plast Peq interior k hk + rw [Peq] + apply interior PP (0,0) (A,B) (p k) phead plast + · apply List.mem_map.mpr + exact ⟨k, List.mem_range.mpr (by omega), rfl⟩ + · intro he; have := congrArg Prod.fst he; dsimp [p] at this; omega + · intro he; have := congrArg Prod.fst he; dsimp [p] at this; omega + +private theorem qmem : + (by + classical + exact + ∀ (Q : List (ℤ × ℤ)), ∀ (A : ℤ), ∀ (B : ℤ), + let l : Int → Int := fun k => (B*k)/A + (TriangularMaxIncrement (0,0) (A,B) = A) → ((TriangularMaxIncrement (A,B) (0,0) = A) → ( + let N := A.toNat + ((N : Int) = A) → ( + let q : Nat → Int × Int := fun k => (k, l k) + let QQ := ((List.range (N+1)).map q).reverse + (((List.range (N+1)).map q).head? = some (0,0)) → ((((List.range (N+1)).map q).getLast? = + some (A,B)) → ((Q = QQ) → ((∀ (path : List (Int × Int)), ∀ (a : Int × Int), ∀ (b : + Int × Int), ∀ (z : Int × Int), (path.head? = some a) → ((path.getLast? = some b) → + ((z ∈ path) → ((z ≠ a) → ((z ≠ b) → (z ∈ (path.drop 1).dropLast)))))) → (∀ (k : ℕ), + (0 : ℕ) < k ∧ k < N → q k ∈ (List.drop (1 : ℕ) Q).dropLast))))))) ) := by + classical + intro Q A B l hmax hrmax N hN q QQ qhead qlast Qeq interior k hk + rw [Qeq] + apply interior QQ (A,B) (0,0) (q k) + · simpa [QQ] using qlast + · simpa [QQ] using qhead + · apply List.mem_reverse.mpr + exact List.mem_map.mpr ⟨k, List.mem_range.mpr (by omega), rfl⟩ + · intro he; have := congrArg Prod.fst he; dsimp [q] at this; omega + · intro he; have := congrArg Prod.fst he; dsimp [q] at this; omega + +private theorem gap : + (by + classical + exact + ∀ (A : ℤ), ∀ (B : ℤ), ((2 : ℤ) ≤ A) → ( + let l : Int → Int := fun k => (B*k)/A + let h : Int → Int := fun k => (B*k+A-1)/A + (∀ (k : Int), 0 ≤ B*k-A*l k ∧ B*k-A*l k < A) → ((∀ (k : Int), 0 ≤ A*h k-B*k ∧ A*h k-B*k < + A) → (∀ (k : ℤ), h k = l k ∨ h k = l k + (1 : ℤ)))) ) := by + classical + intro A B hA l h hl hh k + have := hl k + have := hh k + have : -1 < h k-l k ∧ h k-l k < 2 := by constructor <;> nlinarith + omega + +private theorem between : + (by + classical + exact + ∀ (A : ℤ), ∀ (B : ℤ), ((2 : ℤ) ≤ A) → (((0 : ℤ) ≤ B) → ((B < A) → ( + let l : Int → Int := fun k => (B*k)/A + let h : Int → Int := fun k => (B*k+A-1)/A + (∀ (k : Int), 0 ≤ B*k-A*l k ∧ B*k-A*l k < A) → ((∀ (k : Int), 0 ≤ A*h k-B*k ∧ A*h k-B*k < + A) → (∀ (k : ℤ), l (k + (1 : ℤ)) = h k ∨ l (k + (1 : ℤ)) = h k - (1 : ℤ)))))) ) := by + classical + intro A B hA hB hBA l h hl hh k + have := hl (k+1) + have := hh k + have : -2 < l (k+1)-h k ∧ l (k+1)-h k < 1 := by constructor <;> nlinarith + omega + +private theorem below : + (by + classical + exact + ∀ (A : ℤ), ∀ (B : ℤ), + let l : Int → Int := fun k => (B*k)/A + let h : Int → Int := fun k => (B*k+A-1)/A + (∀ (k : Int), l (k+1) = l k ∨ l (k+1) = l k+1) → ((∀ (k : Int), h (k+1) = h k ∨ h (k+1) = + h k+1) → ((∀ (k : Int), h k = l k ∨ h k = l k+1) → (∀ (k : ℤ), l (k + (1 : ℤ)) = h k + - (1 : ℤ) → h k = l k + (1 : ℤ) ∧ h (k + (1 : ℤ)) = h k))) ) := by + classical + intro A B l h lnext hnext gap k he + have hg := gap k + have hg' := gap (k+1) + have hn := lnext k + have hn' := hnext k + omega + +private theorem rH : + (by + classical + exact + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1-z.2,z.1) + invFun := fun z => (z.2,z.2-z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + ∀ (a : ℤ × ℤ), ∀ (b : ℤ × ℤ), ∀ (z : ℤ × ℤ), TriangularSignedHeight ((R : ℤ × ℤ → ℤ × ℤ) + a) ((R : ℤ × ℤ → ℤ × ℤ) b) ((R : ℤ × ℤ → ℤ × ℤ) z) = TriangularSignedHeight a b z ) + := by + classical + intro R a b z + simp only [TriangularSignedHeight,R,Equiv.coe_fn_mk] + ring + +private theorem rM : + (by + classical + exact + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1-z.2,z.1) + invFun := fun z => (z.2,z.2-z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + ∀ (a : ℤ × ℤ), ∀ (b : ℤ × ℤ), TriangularMaxIncrement ((R : ℤ × ℤ → ℤ × ℤ) a) ((R : ℤ × ℤ + → ℤ × ℤ) b) = TriangularMaxIncrement a b ) := by + classical + intro R a b + have h1 : b.1-b.2-(a.1-a.2) = (b.1-a.1)-(b.2-a.2) := by ring + have h2 : (b.1-a.1)-(b.2-a.2)-(b.1-a.1) = -(b.2-a.2) := by ring + simp only [TriangularMaxIncrement,R,Equiv.coe_fn_mk,h1,h2,abs_neg] + simp only [max_comm,max_left_comm] + +private theorem rAdj : + (by + classical + exact + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1-z.2,z.1) + invFun := fun z => (z.2,z.2-z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + ∀ (a : ℤ × ℤ), ∀ (b : ℤ × ℤ), TriangularLatticeAdjacent ((R : ℤ × ℤ → ℤ × ℤ) a) ((R : ℤ × + ℤ → ℤ × ℤ) b) ↔ TriangularLatticeAdjacent a b ) := by + classical + intro R a b + simp only [TriangularLatticeAdjacent,R,Equiv.coe_fn_mk,Prod.sub_def,Prod.mk.injEq] + omega + +private theorem rInc : + (by + classical + exact + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1-z.2,z.1) + invFun := fun z => (z.2,z.2-z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + let S : AffineTriangularFace ≃ AffineTriangularFace := + { toFun := fun f => match f with + | .up z => .down (R z+(1,0)) + | .down z => .up (R z-(1,0)) + invFun := fun f => match f with + | .up z => .down (R.symm (z+(1,0))) + | .down z => .up (R.symm (z-(1,0))) + left_inv := by intro f; cases f <;> simp + right_inv := by intro f; cases f <;> simp } + ∀ (z : ℤ × ℤ), ∀ (f : AffineTriangularFace), (R : ℤ × ℤ → ℤ × ℤ) z ∈ + AffineTriangularFaceVertices ((S : AffineTriangularFace → AffineTriangularFace) f) ↔ + z ∈ AffineTriangularFaceVertices f ) := by + classical + intro R S z f + cases f <;> + simp only [S,Equiv.coe_fn_mk,AffineTriangularFaceVertices,Finset.mem_insert, + Finset.mem_singleton,R,Prod.add_def,Prod.sub_def,Prod.ext_iff] <;> omega + +private theorem tH : + (by + classical + exact + ∀ (x : Int × Int), + let T : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => z-x + invFun := fun z => z+x + left_inv := fun z => by simp + right_inv := fun z => by simp } + ∀ (a : ℤ × ℤ), ∀ (b : ℤ × ℤ), ∀ (z : ℤ × ℤ), TriangularSignedHeight ((T : ℤ × ℤ → ℤ × ℤ) + a) ((T : ℤ × ℤ → ℤ × ℤ) b) ((T : ℤ × ℤ → ℤ × ℤ) z) = TriangularSignedHeight a b z ) + := by + classical + intro x T a b z + simp [T,TriangularSignedHeight,Prod.sub_def] + +private theorem tAdj : + (by + classical + exact + ∀ (x : Int × Int), + let T : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => z-x + invFun := fun z => z+x + left_inv := fun z => by simp + right_inv := fun z => by simp } + ∀ (a : ℤ × ℤ), ∀ (b : ℤ × ℤ), TriangularLatticeAdjacent ((T : ℤ × ℤ → ℤ × ℤ) a) ((T : ℤ × + ℤ → ℤ × ℤ) b) ↔ TriangularLatticeAdjacent a b ) := by + classical + intro x T a b + simp only [TriangularLatticeAdjacent,T,Equiv.coe_fn_mk] + rw [sub_sub_sub_cancel_right] + +private theorem tInc : + (by + classical + exact + ∀ (x : Int × Int), + let T : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => z-x + invFun := fun z => z+x + left_inv := fun z => by simp + right_inv := fun z => by simp } + let U : AffineTriangularFace ≃ AffineTriangularFace := + { toFun := fun f => match f with + | .up z => .up (z-x) + | .down z => .down (z-x) + invFun := fun f => match f with + | .up z => .up (z+x) + | .down z => .down (z+x) + left_inv := by intro f; cases f <;> simp + right_inv := by intro f; cases f <;> simp } + ∀ (z : ℤ × ℤ), ∀ (f : AffineTriangularFace), (T : ℤ × ℤ → ℤ × ℤ) z ∈ + AffineTriangularFaceVertices ((U : AffineTriangularFace → AffineTriangularFace) f) ↔ + z ∈ AffineTriangularFaceVertices f ) := by + classical + intro x T U z f + cases f <;> + simp only [U,T,Equiv.coe_fn_mk,AffineTriangularFaceVertices,Finset.mem_insert, + Finset.mem_singleton,Prod.add_def,Prod.sub_def,Prod.ext_iff] <;> omega + +private theorem eH : + (by + classical + exact + ∀ (x : Int × Int), + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1-z.2,z.1) + invFun := fun z => (z.2,z.2-z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + (∀ (a : Int × Int), ∀ (b : Int × Int), ∀ (z : Int × Int), TriangularSignedHeight + (R a) (R b) (R z) = TriangularSignedHeight a b z) → ( + let T : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => z-x + invFun := fun z => z+x + left_inv := fun z => by simp + right_inv := fun z => by simp } + (∀ (a : Int × Int), ∀ (b : Int × Int), ∀ (z : Int × Int), TriangularSignedHeight (T a) (T + b) (T z) = TriangularSignedHeight a b z) → ( + let E : Nat → (Int × Int) ≃ (Int × Int) := fun n => T.trans (R^n) + ∀ (n : ℕ), ∀ (a : ℤ × ℤ), ∀ (b : ℤ × ℤ), ∀ (z : ℤ × ℤ), TriangularSignedHeight ((E n : ℤ + × ℤ → ℤ × ℤ) a) ((E n : ℤ × ℤ → ℤ × ℤ) b) ((E n : ℤ × ℤ → ℤ × ℤ) z) = + TriangularSignedHeight a b z))) := by + classical + intro x R rH T tH E n a b z + induction n with + | zero => simpa [E] using tH a b z + | succ n ih => + simpa [E,pow_succ',Equiv.Perm.mul_apply] using (rH (E n a) (E n b) (E n z)).trans ih + +private theorem eM : + (by + classical + exact + ∀ (x : Int × Int), + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1-z.2,z.1) + invFun := fun z => (z.2,z.2-z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + (∀ (a : Int × Int), ∀ (b : Int × Int), TriangularMaxIncrement (R a) (R b) = + TriangularMaxIncrement a b) → ( + let T : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => z-x + invFun := fun z => z+x + left_inv := fun z => by simp + right_inv := fun z => by simp } + (∀ (a : Int × Int), ∀ (b : Int × Int), TriangularMaxIncrement (T a) (T b) = + TriangularMaxIncrement a b) → ( + let E : Nat → (Int × Int) ≃ (Int × Int) := fun n => T.trans (R^n) + ∀ (n : ℕ), ∀ (a : ℤ × ℤ), ∀ (b : ℤ × ℤ), TriangularMaxIncrement ((E n : ℤ × ℤ → ℤ × ℤ) a) + ((E n : ℤ × ℤ → ℤ × ℤ) b) = TriangularMaxIncrement a b))) := by + classical + intro x R rM T tM E n a b + induction n with + | zero => simpa [E] using tM a b + | succ n ih => + simpa [E,pow_succ',Equiv.Perm.mul_apply] using (rM (E n a) (E n b)).trans ih + +private theorem eAdj : + (by + classical + exact + ∀ (x : Int × Int), + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1-z.2,z.1) + invFun := fun z => (z.2,z.2-z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + (∀ (a : Int × Int), ∀ (b : Int × Int), TriangularLatticeAdjacent (R a) (R b) ↔ + TriangularLatticeAdjacent a b) → ( + let T : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => z-x + invFun := fun z => z+x + left_inv := fun z => by simp + right_inv := fun z => by simp } + (∀ (a : Int × Int), ∀ (b : Int × Int), TriangularLatticeAdjacent (T a) (T b) ↔ + TriangularLatticeAdjacent a b) → ( + let E : Nat → (Int × Int) ≃ (Int × Int) := fun n => T.trans (R^n) + ∀ (n : ℕ), ∀ (a : ℤ × ℤ), ∀ (b : ℤ × ℤ), TriangularLatticeAdjacent ((E n : ℤ × ℤ → ℤ × ℤ) + a) ((E n : ℤ × ℤ → ℤ × ℤ) b) ↔ TriangularLatticeAdjacent a b))) := by + classical + intro x R rAdj T tAdj E n a b + induction n with + | zero => simpa [E] using tAdj a b + | succ n ih => + simpa [E,pow_succ',Equiv.Perm.mul_apply] using (rAdj (E n a) (E n b)).trans ih + +private theorem eInc : + (by + classical + exact + ∀ (x : Int × Int), + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1-z.2,z.1) + invFun := fun z => (z.2,z.2-z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + let S : AffineTriangularFace ≃ AffineTriangularFace := + { toFun := fun f => match f with + | .up z => .down (R z+(1,0)) + | .down z => .up (R z-(1,0)) + invFun := fun f => match f with + | .up z => .down (R.symm (z+(1,0))) + | .down z => .up (R.symm (z-(1,0))) + left_inv := by intro f; cases f <;> simp + right_inv := by intro f; cases f <;> simp } + (∀ (z : Int × Int), ∀ (f : AffineTriangularFace), R z ∈ + AffineTriangularFaceVertices (S f) ↔ z ∈ AffineTriangularFaceVertices f) → ( + let T : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => z-x + invFun := fun z => z+x + left_inv := fun z => by simp + right_inv := fun z => by simp } + let U : AffineTriangularFace ≃ AffineTriangularFace := + { toFun := fun f => match f with + | .up z => .up (z-x) + | .down z => .down (z-x) + invFun := fun f => match f with + | .up z => .up (z+x) + | .down z => .down (z+x) + left_inv := by intro f; cases f <;> simp + right_inv := by intro f; cases f <;> simp } + (∀ (z : Int × Int), ∀ (f : AffineTriangularFace), T z ∈ AffineTriangularFaceVertices (U + f) ↔ z ∈ AffineTriangularFaceVertices f) → ( + let E : Nat → (Int × Int) ≃ (Int × Int) := fun n => T.trans (R^n) + let F : Nat → AffineTriangularFace ≃ AffineTriangularFace := fun n => U.trans (S^n) + ∀ (n : ℕ), ∀ (z : ℤ × ℤ), ∀ (f : AffineTriangularFace), (E n : ℤ × ℤ → ℤ × ℤ) z ∈ + AffineTriangularFaceVertices ((F n : AffineTriangularFace → AffineTriangularFace) f) + ↔ z ∈ AffineTriangularFaceVertices f))) := by + classical + intro x R S rInc T U tInc E F n z f + induction n with + | zero => simpa [E,F] using tInc z f + | succ n ih => + simpa [E,F,pow_succ',Equiv.Perm.mul_apply] using (rInc (E n z) (F n f)).trans ih + +private theorem e0 : + (by + classical + exact + ∀ (x : Int × Int), + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1-z.2,z.1) + invFun := fun z => (z.2,z.2-z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + let T : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => z-x + invFun := fun z => z+x + left_inv := fun z => by simp + right_inv := fun z => by simp } + let E : Nat → (Int × Int) ≃ (Int × Int) := fun n => T.trans (R^n) + ∀ (n : ℕ), (E n : ℤ × ℤ → ℤ × ℤ) x = ((0 : ℤ), (0 : ℤ)) ) := by + classical + intro x R T E n + induction n with + | zero => ext <;> simp [E,T,Prod.sub_def] + | succ n ih => simpa [E,pow_succ',Equiv.Perm.mul_apply,R] using congrArg R ih + +private theorem hnonzero : + (by + classical + exact + ∀ (x : Int × Int), ∀ (y : Int × Int), (x ≠ y) → (y.1-x.1 ≠ 0 ∨ y.2-x.2 ≠ 0) ) := by + classical + intro x y hxy + by_contra hn + simp only [not_or,not_not] at hn + apply hxy + ext <;> omega + +private theorem hA2 : + (by + classical + exact + ∀ (x : Int × Int), ∀ (y : Int × Int), + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1-z.2,z.1) + invFun := fun z => (z.2,z.2-z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + let T : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => z-x + invFun := fun z => z+x + left_inv := fun z => by simp + right_inv := fun z => by simp } + let E : Nat → (Int × Int) ≃ (Int × Int) := fun n => T.trans (R^n) + (∀ (n : Nat), E n x = (0,0)) → (∀ (n : ℕ), ((0 : ℤ) < ((E n : ℤ × ℤ → ℤ × ℤ) y).1) → (((0 + : ℤ) ≤ ((E n : ℤ × ℤ → ℤ × ℤ) y).2) → ((((E n : ℤ × ℤ → ℤ × ℤ) y).2 < ((E n : ℤ × ℤ → + ℤ × ℤ) y).1) → ((¬ TriangularLatticeAdjacent (E n x) (E n y)) → (2 ≤ (E n y).1))))) ) + := by + classical + intro x y R T E e0 n hA hB hBA hn + by_contra hh + have ha1 : (E n y).1 = 1 := by omega + have hb0 : (E n y).2 = 0 := by omega + apply hn + rw [e0] + simp [TriangularLatticeAdjacent,Prod.sub_def,ha1,hb0] + +end OpposingStripDetails + +theorem AffineOpposingStripCorridor + (x y : Int × Int) (hxy : x ≠ y) + (hnadj : ¬ TriangularLatticeAdjacent x y) + (forward reverse : List (Int × Int)) + (hforward : TriangularStripSegment x y forward) + (hreverse : TriangularStripSegment y x reverse) : + ∃ faces : List AffineTriangularFace, + faces ≠ [] ∧ + (∃ f, faces.head? = some f ∧ + x ∈ AffineTriangularFaceVertices f) ∧ + (∃ f, faces.getLast? = some f ∧ + y ∈ AffineTriangularFaceVertices f) ∧ + (∀ f ∈ faces, + (∃ a ∈ (forward.drop 1).dropLast, + a ∈ AffineTriangularFaceVertices f) ∧ + (∃ b ∈ (reverse.drop 1).dropLast, + b ∈ AffineTriangularFaceVertices f)) ∧ + faces.IsChain (AffineTriangularCorridorStep forward reverse) := by +-- BODY + classical + let P := forward + let Q := reverse + have hP : TriangularStripSegment x y P := hforward + have hQ : TriangularStripSegment y x Q := hreverse + let corridor (x y : Int × Int) (P Q : List (Int × Int)) : Prop := + ∃ faces : List AffineTriangularFace, + faces ≠ [] ∧ + (∃ f, faces.head? = some f ∧ x ∈ AffineTriangularFaceVertices f) ∧ + (∃ f, faces.getLast? = some f ∧ y ∈ AffineTriangularFaceVertices f) ∧ + (∀ f ∈ faces, + (∃ a ∈ (P.drop 1).dropLast, a ∈ AffineTriangularFaceVertices f) ∧ + (∃ b ∈ (Q.drop 1).dropLast, b ∈ AffineTriangularFaceVertices f)) ∧ + faces.IsChain (AffineTriangularCorridorStep P Q) + -- Reconstruct the strips and concatenate the interior-column face blocks. + have normalized (A B : Int) (hA : 2 ≤ A) (hB : 0 ≤ B) (hBA : B < A) + (P Q : List (Int × Int)) + (hP : TriangularStripSegment (0,0) (A,B) P) + (hQ : TriangularStripSegment (A,B) (0,0) Q) : + corridor (0,0) (A,B) P Q := by + classical + let l : Int → Int := fun k => (B*k)/A + let h : Int → Int := fun k => (B*k+A-1)/A + have hl (k : Int) := OpposingStripDetails.hl A B hA k + have hh (k : Int) := OpposingStripDetails.hh A B hA k + have hluniq (k s : Int) (hs : 0 ≤ B*k-A*s ∧ B*k-A*s < A) := OpposingStripDetails.hluniq A B + hA hl k s hs + have hhuniq (k s : Int) (hs : 0 ≤ A*s-B*k ∧ A*s-B*k < A) := OpposingStripDetails.hhuniq A B + hA hh k s hs + have hl0 : l 0 = 0 := (hluniq 0 0 (by constructor <;> nlinarith)).symm + have hh0 : h 0 = 0 := (hhuniq 0 0 (by constructor <;> nlinarith)).symm + have hlA : l A = B := (hluniq A B (by constructor <;> nlinarith)).symm + have hhA : h A = B := (hhuniq A B (by constructor <;> nlinarith)).symm + have lnext (k : Int) := OpposingStripDetails.lnext A B hA + hB hBA hl k + have hnext (k : Int) := OpposingStripDetails.hnext A B hA + hB hBA hh k + have hmax := OpposingStripDetails.hmax A B hA hB hBA + hlA hhA + have hrmax := OpposingStripDetails.hrmax A B hA hB + hBA hlA hhA hmax + let N := A.toNat + have hN : (N : Int) = A := by dsimp [N]; omega + let p : Nat → Int × Int := fun k => (k, h k) + let q : Nat → Int × Int := fun k => (k, l k) + let PP := (List.range (N+1)).map p + let QQ := ((List.range (N+1)).map q).reverse + have p0 : p 0 = (0,0) := by simp [p, hh0] + have q0 : q 0 = (0,0) := by simp [q, hl0] + have pN : p N = (A,B) := by simp [p, hN, hhA] + have qN : q N = (A,B) := by simp [q, hN, hlA] + have pinj := OpposingStripDetails.pinj A B + have qinj := OpposingStripDetails.qinj A B + have phead : PP.head? = some (0,0) := by + simp [PP, List.range_succ_eq_map, p0] + have qhead : ((List.range (N+1)).map q).head? = some (0,0) := by + simp [List.range_succ_eq_map, q0] + have plast : PP.getLast? = some (A,B) := by + simp [PP, List.range_succ, pN] + have qlast : ((List.range (N+1)).map q).getLast? = some (A,B) := by + simp [List.range_succ, qN] + have ppseg := OpposingStripProof.ppseg A B hA hh + hnext hmax hrmax hN pinj phead plast + have qqseg := OpposingStripProof.qqseg A B hA hl + lnext hmax hrmax hN qinj qhead qlast + have Peq : P = PP := (AffineTriangularStrip.1 (0,0) (A,B)).unique hP ppseg + have Qeq : Q = QQ := (AffineTriangularStrip.1 (A,B) (0,0)).unique hQ qqseg + have interior (path : List (Int × Int)) (a b z : Int × Int) + (ha : path.head? = some a) (hb : path.getLast? = some b) + (hz : z ∈ path) (hza : z ≠ a) (hzb : z ≠ b) := OpposingStripProof.interior path a b z ha + hb hz hza hzb + have pmem (k : Nat) (hk : 0 < k ∧ k < N) := OpposingStripDetails.pmem P A B hmax hrmax hN + phead plast Peq interior k hk + have qmem (k : Nat) (hk : 0 < k ∧ k < N) := OpposingStripDetails.qmem Q A B hmax hrmax hN + qhead qlast Qeq interior k hk + have gap (k : Int) := OpposingStripDetails.gap A B hA hl hh k + have between (k : Int) := OpposingStripDetails.between A B + hA hB hBA hl hh k + have below (k : Int) (he : l (k+1) = h k-1) := OpposingStripDetails.below A B lnext hnext gap + k he + -- A height-zero vertex requires the four-face fan instead of a two-face block. + let block : Nat → List AffineTriangularFace := fun k => + if h k = l k then + [.down (k,l k), .up (k,l k+1), .down ((k : Int)+1,l k), .up (k,h k)] + else [.down (k,l k), .up (k,h k)] + have bhead (k : Nat) : (block k).head? = some (.down (k,l k)) := by + dsimp [block]; split <;> rfl + have blast (k : Nat) : (block k).getLast? = some (.up (k,h k)) := by + dsimp [block]; split <;> rfl + have bne (k : Nat) : block k ≠ [] := by + dsimp [block]; split <;> simp + have mkstep (f g : AffineTriangularFace) (u v : Int × Int) + (hfg : f ≠ g) (huv : u ≠ v) (hadj : TriangularLatticeAdjacent u v) + (huf : u ∈ AffineTriangularFaceVertices f) (hvf : v ∈ AffineTriangularFaceVertices f) + (hug : u ∈ AffineTriangularFaceVertices g) (hvg : v ∈ AffineTriangularFaceVertices g) + (hmem : (u ∈ (P.drop 1).dropLast ∧ v ∈ (Q.drop 1).dropLast) ∨ + (u ∈ (P.drop 1).dropLast ∧ u ∈ (Q.drop 1).dropLast)) : + AffineTriangularCorridorStep P Q f g := + ⟨hfg,u,v,huv,hadj,huf,hvf,hug,hvg,hmem⟩ + have bvertices (k : Nat) (hk : 0 < k ∧ k < N) := OpposingStripProof.bvertices P Q A B pmem + qmem gap k hk + have bchain (k : Nat) (hk : 0 < k ∧ k < N) := OpposingStripProof.bchain P Q A B + pmem qmem gap mkstep k hk + have joinstep (k : Nat) (hk : 0 < k ∧ k+1 < N) := OpposingStripProof.joinstep P Q A B pmem + qmem between below mkstep k hk + let fs : Nat → List AffineTriangularFace := fun n => + (List.range n).flatMap (fun i => block (i+1)) + have fsproperties (n : Nat) (hn : 0 < n ∧ n < N) := OpposingStripProof.fsproperties P Q + A B bhead blast bne bvertices bchain joinstep n hn + obtain ⟨hne,hhead,hlast,hvertices,hchain⟩ := fsproperties (N-1) (by omega) + have firstlower : l 1 = 0 := (hluniq 1 0 (by constructor <;> nlinarith)).symm + have lasthigher : h (A-1) = B := + (hhuniq (A-1) B (by constructor <;> nlinarith)).symm + refine ⟨fs (N-1),hne,⟨.down (1,l 1),hhead,?_⟩, + ⟨.up (((N-1 : Nat) : Int),h ((N-1 : Nat) : Int)),hlast,?_⟩,hvertices,hchain⟩ + · simp [AffineTriangularFaceVertices,firstlower] + · have hn1 : ((N-1 : Nat) : Int) = A-1 := by omega + simp [AffineTriangularFaceVertices,hn1,lasthigher,Prod.add_def] + -- Pull back every corridor field, including endpoint-deleted memberships. + have pullback (E : (Int × Int) ≃ (Int × Int)) + (F : AffineTriangularFace ≃ AffineTriangularFace) + (hAdj : ∀ u v, TriangularLatticeAdjacent (E u) (E v) ↔ TriangularLatticeAdjacent u v) + (hInc : ∀ z f, E z ∈ AffineTriangularFaceVertices (F f) ↔ z ∈ AffineTriangularFaceVertices f) + (x y : Int × Int) (P Q : List (Int × Int)) + (hcorr : corridor (E x) (E y) (P.map E) (Q.map E)) := OpposingStripProof.pullback E F hAdj + hInc x y P Q hcorr + have segmentMap (E : (Int × Int) ≃ (Int × Int)) + (hH : ∀ x y z, TriangularSignedHeight (E x) (E y) (E z) = TriangularSignedHeight x y z) + (hM : ∀ x y, TriangularMaxIncrement (E x) (E y) = TriangularMaxIncrement x y) + (hAdj : ∀ u v, TriangularLatticeAdjacent (E u) (E v) ↔ TriangularLatticeAdjacent u v) + (x y : Int × Int) (hxy : x ≠ y) (P : List (Int × Int)) + (hP : TriangularStripSegment x y P) := OpposingStripProof.segmentMap E hH hM hAdj x y hxy P hP + change corridor x y P Q + -- Translation and the six powers of the determinant-one lattice rotation. + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1-z.2,z.1) + invFun := fun z => (z.2,z.2-z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + let S : AffineTriangularFace ≃ AffineTriangularFace := + { toFun := fun f => match f with + | .up z => .down (R z+(1,0)) + | .down z => .up (R z-(1,0)) + invFun := fun f => match f with + | .up z => .down (R.symm (z+(1,0))) + | .down z => .up (R.symm (z-(1,0))) + left_inv := by intro f; cases f <;> simp + right_inv := by intro f; cases f <;> simp } + have rH (a b z : Int × Int) := OpposingStripDetails.rH a b z + have rM (a b : Int × Int) := OpposingStripDetails.rM a b + have rAdj (a b : Int × Int) := OpposingStripDetails.rAdj a b + have rInc (z : Int × Int) (f : AffineTriangularFace) := OpposingStripDetails.rInc z f + let T : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => z-x + invFun := fun z => z+x + left_inv := fun z => by simp + right_inv := fun z => by simp } + let U : AffineTriangularFace ≃ AffineTriangularFace := + { toFun := fun f => match f with + | .up z => .up (z-x) + | .down z => .down (z-x) + invFun := fun f => match f with + | .up z => .up (z+x) + | .down z => .down (z+x) + left_inv := by intro f; cases f <;> simp + right_inv := by intro f; cases f <;> simp } + have tH (a b z : Int × Int) := OpposingStripDetails.tH x a b z + have tM (a b : Int × Int) : TriangularMaxIncrement (T a) (T b) = TriangularMaxIncrement a b := by + simp [T,TriangularMaxIncrement,Prod.sub_def] + have tAdj (a b : Int × Int) := OpposingStripDetails.tAdj x a b + have tInc (z : Int × Int) (f : AffineTriangularFace) := OpposingStripDetails.tInc x z f + let E : Nat → (Int × Int) ≃ (Int × Int) := fun n => T.trans (R^n) + let F : Nat → AffineTriangularFace ≃ AffineTriangularFace := fun n => U.trans (S^n) + have eH (n : Nat) (a b z : Int × Int) := OpposingStripDetails.eH x rH tH n a b z + have eM (n : Nat) (a b : Int × Int) := OpposingStripDetails.eM x rM tM n a b + have eAdj (n : Nat) (a b : Int × Int) := OpposingStripDetails.eAdj x rAdj tAdj n a b + have eInc (n : Nat) (z : Int × Int) (f : AffineTriangularFace) := OpposingStripDetails.eInc x + rInc tInc n z f + have e0 (n : Nat) := OpposingStripDetails.e0 x n + have hnonzero := OpposingStripDetails.hnonzero x y hxy + have chamber := OpposingStripProof.chamber x y hnonzero + obtain ⟨n,hA,hB,hBA⟩ := chamber + have hn : ¬ TriangularLatticeAdjacent (E n x) (E n y) := + fun hh => hnadj ((eAdj n x y).mp hh) + have hA2 := OpposingStripDetails.hA2 x y e0 n hA hB hBA hn + have hp := segmentMap (E n) (eH n) (eM n) (eAdj n) x y hxy P hP + have hq := segmentMap (E n) (eH n) (eM n) (eAdj n) y x (Ne.symm hxy) Q hQ + apply pullback (E n) (F n) (eAdj n) (eInc n) x y P Q + have he : E n y = ((E n y).1,(E n y).2) := rfl + rw [e0,he] at hp hq ⊢ + exact normalized _ _ hA2 hB hBA _ _ hp hq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularComplexChart.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularComplexChart.lean new file mode 100644 index 0000000000..ee925c9841 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularComplexChart.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent + +-- [TABLET NODE: AffineTriangularComplexChart] + +/-! +# AffineTriangularComplexChart + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $P$ be a periodic tile complex and let +$\operatorname{tileAt}:\mathbb Z^2\to\mathcal T$ be a coordinate-indexed +family of prototiles. An affine triangular complex chart for +$(P,\operatorname{tileAt})$ consists of a bijection +$\kappa:\mathbb Z^2\to V(P)$ and two face maps +$U,D:\mathbb Z^2\to F(P)$ with the following properties. In chart +coordinates, adjacency is exactly `TriangularLatticeAdjacent`. +Both $U$ and $D$ are injective, their images are disjoint, and every face is +in exactly one of their images. Writing $e_1=(1,0)$ and $e_2=(0,1)$, the +ordered incident vertices are exactly +$$ + U_x=(\kappa(x),\kappa(x+e_1),\kappa(x-e_2)),\qquad + D_x=(\kappa(x),\kappa(x-e_1),\kappa(x+e_2)). +$$ +Finally, the tile indexed by $\kappa(x)$ in $P$ is +$\operatorname{tileAt}(x)$ for every $x\in\mathbb Z^2$. +-/ +structure AffineTriangularComplexChart {ι : Type} + (P : PeriodicTileComplex ι) (tileAt : (Int × Int) → ProtoTile) where +-- BODY + /-- Identify integer coordinate pairs with the vertices of the periodic complex. -/ + vertexEquiv : (Int × Int) ≃ ι + adjacent_iff : ∀ x y, + P.plane.adjacent (vertexEquiv x) (vertexEquiv y) ↔ + TriangularLatticeAdjacent x y + /-- The upward face based at each integer coordinate pair. -/ + up : (Int × Int) → P.plane.Face + /-- The downward face based at each integer coordinate pair. -/ + down : (Int × Int) → P.plane.Face + up_injective : Function.Injective up + down_injective : Function.Injective down + up_ne_down : ∀ x y, up x ≠ down y + face_exhaustive : ∀ f, (∃ x, f = up x) ∨ ∃ x, f = down x + up_vertices : ∀ x, + P.plane.faceVertex (up x) 0 = vertexEquiv x ∧ + P.plane.faceVertex (up x) 1 = + vertexEquiv (x + ((1, 0) : Int × Int)) ∧ + P.plane.faceVertex (up x) 2 = + vertexEquiv (x - ((0, 1) : Int × Int)) + down_vertices : ∀ x, + P.plane.faceVertex (down x) 0 = vertexEquiv x ∧ + P.plane.faceVertex (down x) 1 = + vertexEquiv (x - ((1, 0) : Int × Int)) ∧ + P.plane.faceVertex (down x) 2 = + vertexEquiv (x + ((0, 1) : Int × Int)) + tile_eq : ∀ x, P.tile (vertexEquiv x) = tileAt x + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularCorridorStep.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularCorridorStep.lean new file mode 100644 index 0000000000..10c9c4c9d9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularCorridorStep.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AffineTriangularFaceVertices +public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent + +-- [TABLET NODE: AffineTriangularCorridorStep] + +/-! +# AffineTriangularCorridorStep + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $P,Q$ be two finite lattice-vertex lists and let $F,G$ be tagged +`AffineTriangularFace`s. They make an affine triangular corridor +step, relative to $(P,Q)$, when $F\ne G$ and they share an entire +elementary edge $\{u,v\}$: the vertices $u\ne v$ are +`TriangularLatticeAdjacent` and both belong to +$V(F)\cap V(G)$ as defined by +`AffineTriangularFaceVertices`. The shared edge must have one of +the following two audited forms after possibly naming its endpoints in the +opposite order: +$$ + \begin{array}{ll} + \textnormal{crossing:}&u\in(P.\operatorname{drop}1).\operatorname{dropLast} + \textnormal{ and } + v\in(Q.\operatorname{drop}1).\operatorname{dropLast},\\ + \textnormal{fan:}&u\in(P.\operatorname{drop}1).\operatorname{dropLast} + \cap(Q.\operatorname{drop}1).\operatorname{dropLast}. + \end{array} +$$ +In the fan case the second endpoint $v$ is unrestricted beyond being the +other endpoint of the common elementary edge. +-/ +def AffineTriangularCorridorStep + (forward reverse : List (Int × Int)) + (f g : AffineTriangularFace) : Prop := +-- BODY + f ≠ g ∧ + ∃ u v : Int × Int, + u ≠ v ∧ + TriangularLatticeAdjacent u v ∧ + u ∈ AffineTriangularFaceVertices f ∧ + v ∈ AffineTriangularFaceVertices f ∧ + u ∈ AffineTriangularFaceVertices g ∧ + v ∈ AffineTriangularFaceVertices g ∧ + ((u ∈ (forward.drop 1).dropLast ∧ + v ∈ (reverse.drop 1).dropLast) ∨ + (u ∈ (forward.drop 1).dropLast ∧ + u ∈ (reverse.drop 1).dropLast)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularFace.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularFace.lean new file mode 100644 index 0000000000..31f0aae5dd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularFace.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: AffineTriangularFace] + +/-! +# AffineTriangularFace + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +An affine triangular face is a tagged lattice point: for each +$z\in\mathbb Z^2$ there is an upward face $U_z$ and a downward face $D_z$. +The tags distinguish the two face orbits even when their base points differ. +-/ +inductive AffineTriangularFace : Type where +-- BODY + | up (base : Int × Int) + | down (base : Int × Int) + deriving DecidableEq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularFaceCoordinateSwap.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularFaceCoordinateSwap.lean new file mode 100644 index 0000000000..d4a19cb836 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularFaceCoordinateSwap.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AffineTriangularFace + +-- [TABLET NODE: AffineTriangularFaceCoordinateSwap] + +/-! +# AffineTriangularFaceCoordinateSwap + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Coordinate swap acts on a tagged affine triangular face by swapping its base +coordinates and exchanging its tag: +$$ + U_z^\sigma=D_{\sigma(z)},\qquad + D_z^\sigma=U_{\sigma(z)}, +$$ +where $\sigma:\mathbb Z^2\to\mathbb Z^2$ is the coordinate swap +$\sigma(m,n)=(n,m)$. +This names the canonical face corresponding to a source face when a +$(b,a)$-indexed source family is aligned with an $(a,b)$-indexed canonical +chart. The tag exchange records the reflection of the two triangular +chambers. It is intended to identify their unordered vertex incidences; +it does not assert equality of their ordered vertex triples. +-/ +def AffineTriangularFaceCoordinateSwap + (f : AffineTriangularFace) : AffineTriangularFace := +-- BODY + match f with + | .up z => .down ((Prod.swap : Int × Int → Int × Int) z) + | .down z => .up ((Prod.swap : Int × Int → Int × Int) z) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularFaceVertices.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularFaceVertices.lean new file mode 100644 index 0000000000..f63138f5cf --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularFaceVertices.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AffineTriangularFace + +-- [TABLET NODE: AffineTriangularFaceVertices] + +/-! +# AffineTriangularFaceVertices + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The vertex set of the tagged affine triangular face based at +$z\in\mathbb Z^2$ is +$$ + V(U_z)=\{z,z+(1,0),z-(0,1)\},\qquad + V(D_z)=\{z,z-(1,0),z+(0,1)\}. +$$ +Thus each tagged face records exactly one elementary triangle in the +six-neighbor affine triangular lattice. +-/ +def AffineTriangularFaceVertices + (f : AffineTriangularFace) : Finset (Int × Int) := +-- BODY + match f with + | .up z => {z, z + ((1, 0) : Int × Int), z - ((0, 1) : Int × Int)} + | .down z => {z, z - ((1, 0) : Int × Int), z + ((0, 1) : Int × Int)} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularNoFourfoldCellOwners.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularNoFourfoldCellOwners.lean new file mode 100644 index 0000000000..2d566c248b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularNoFourfoldCellOwners.lean @@ -0,0 +1,209 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AffineTriangularComplexChart +public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.OppositeRoutedCommonEdgeOutsideCellUnique +public import Mathlib.Tactic.Abel + +-- [TABLET NODE: AffineTriangularNoFourfoldCellOwners] + +/-! +# AffineTriangularNoFourfoldCellOwners + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem AffineTriangularNoFourfoldCellOwners {ι : Type} + (P : PeriodicTileComplex ι) (tileAt : (Int × Int) → ProtoTile) + (chart : AffineTriangularComplexChart P tileAt) + (x : GaussianInt) (a0 a1 a2 a3 : ι) + (h0 : x ∈ (P.tile a0).cells) + (h1 : x - 1 ∈ (P.tile a1).cells) + (h2 : x - 1 - ⟨0, 1⟩ ∈ (P.tile a2).cells) + (h3 : x - ⟨0, 1⟩ ∈ (P.tile a3).cells) : + a0 = a1 ∨ a0 = a2 ∨ a0 = a3 ∨ + a1 = a2 ∨ a1 = a3 ∨ a2 = a3 := by +-- BODY + classical + by_contra h + push Not at h + obtain ⟨hne01, hne02, hne03, hne12, hne13, hne23⟩ := h + have classification := (PeriodicTileIntersectionClassification P).1 + have absent (a b : ι) (hne : a ≠ b) (y : GaussianInt) + (hy : y ∈ (P.tile b).cells) : y ∉ (P.tile a).cells := by + intro ha + exact hne ((PeriodicTileIndexedMultiplicityOne P y).unique ha hy) + have cell_disjoint (a b : ι) (hne : a ≠ b) : + Disjoint (P.tile a).cells (P.tile b).cells := by + apply Finset.disjoint_left.mpr + intro y ha hb + exact absent a b hne y hb ha + have vertical_adj (a b : ι) (hne : a ≠ b) (y : GaussianInt) + (ha : y ∈ (P.tile a).cells) + (hb : y - 1 ∈ (P.tile b).cells) : P.plane.adjacent a b := by + apply (classification a b hne).1.mp + refine ⟨{y, y + ⟨0, 1⟩}, ?_, ?_⟩ + · exact ⟨y, ha, Or.inr (Or.inl rfl)⟩ + · refine ⟨y - 1, hb, Or.inr (Or.inr (Or.inl ?_))⟩ + simp + have horizontal_adj (a b : ι) (hne : a ≠ b) (y : GaussianInt) + (ha : y ∈ (P.tile a).cells) + (hb : y - ⟨0, 1⟩ ∈ (P.tile b).cells) : P.plane.adjacent a b := by + apply (classification a b hne).1.mp + refine ⟨{y, y + 1}, ?_, ?_⟩ + · exact ⟨y, ha, Or.inl rfl⟩ + · refine ⟨y - ⟨0, 1⟩, hb, Or.inr (Or.inr (Or.inr ?_))⟩ + have : y - ⟨0, 1⟩ + 1 + ⟨0, 1⟩ = y + 1 := by abel + simp only [sub_add_cancel, this] + have hadj01 := vertical_adj a0 a1 hne01 x h0 h1 + have hadj12 := horizontal_adj a1 a2 hne12 (x - 1) h1 h2 + have hadj32 : P.plane.adjacent a3 a2 := by + apply vertical_adj a3 a2 hne23.symm (x - ⟨0, 1⟩) h3 + have : x - ⟨0, 1⟩ - 1 = x - 1 - ⟨0, 1⟩ := by abel + simpa only [this] using h2 + have hadj23 := (P.plane.adjacent_symmetric a3 a2).mp hadj32 + have hadj03 := horizontal_adj a0 a3 hne03 x h0 h3 + have hadj30 := (P.plane.adjacent_symmetric a0 a3).mp hadj03 + -- Every simple four-cycle of triangular-lattice steps has a diagonal chord. + have chord (p0 p1 p2 p3 : Int × Int) + (h02 : p0 ≠ p2) (h13 : p1 ≠ p3) + (h01 : TriangularLatticeAdjacent p0 p1) + (h12 : TriangularLatticeAdjacent p1 p2) + (h23 : TriangularLatticeAdjacent p2 p3) + (h30 : TriangularLatticeAdjacent p3 p0) : + TriangularLatticeAdjacent p0 p2 ∨ TriangularLatticeAdjacent p1 p3 := by + let step : Fin 6 → Int × Int := ![(1, 0), (0, 1), (-1, -1), + (-1, 0), (0, -1), (1, 1)] + have step_of_adj (u v : Int × Int) (h : TriangularLatticeAdjacent u v) : + ∃ i, v - u = step i := by + rcases h with h | h | h | h | h | h + · exact ⟨0, h⟩ + · exact ⟨1, h⟩ + · exact ⟨2, h⟩ + · exact ⟨3, h⟩ + · exact ⟨4, h⟩ + · exact ⟨5, h⟩ + have certificate : ∀ i j k : Fin 6, + TriangularLatticeAdjacent (step i + step j + step k) 0 → + step i + step j ≠ 0 → step j + step k ≠ 0 → + TriangularLatticeAdjacent 0 (step i + step j) ∨ + TriangularLatticeAdjacent 0 (step j + step k) := by + unfold TriangularLatticeAdjacent + decide +kernel + have translate_adj (u v w : Int × Int) : + TriangularLatticeAdjacent u v ↔ + TriangularLatticeAdjacent (u - w) (v - w) := by + unfold TriangularLatticeAdjacent + have : (v - w) - (u - w) = v - u := by abel + rw [this] + obtain ⟨i, hi⟩ := step_of_adj p0 p1 h01 + obtain ⟨j, hj⟩ := step_of_adj p1 p2 h12 + obtain ⟨k, hk⟩ := step_of_adj p2 p3 h23 + have hsum02 : p2 - p0 = step i + step j := by + rw [← hi, ← hj] + abel + have hsum13 : p3 - p1 = step j + step k := by + rw [← hj, ← hk] + abel + have hsum03 : p3 - p0 = step i + step j + step k := by + rw [← hi, ← hj, ← hk] + abel + have hclose : TriangularLatticeAdjacent (step i + step j + step k) 0 := by + simpa only [sub_self, hsum03] using (translate_adj p3 p0 p0).mp h30 + have hn02 : step i + step j ≠ 0 := by + rw [← hsum02] + exact sub_ne_zero.mpr h02.symm + have hn13 : step j + step k ≠ 0 := by + rw [← hsum13] + exact sub_ne_zero.mpr h13.symm + rcases certificate i j k hclose hn02 hn13 with h | h + · left + apply (translate_adj p0 p2 p0).mpr + simpa only [sub_self, hsum02] using h + · right + apply (translate_adj p1 p3 p1).mpr + simpa only [sub_self, hsum13] using h + have chart_adj (a b : ι) : P.plane.adjacent a b ↔ + TriangularLatticeAdjacent (chart.vertexEquiv.symm a) (chart.vertexEquiv.symm b) := by + simpa using chart.adjacent_iff (chart.vertexEquiv.symm a) (chart.vertexEquiv.symm b) + have hchord : P.plane.adjacent a0 a2 ∨ P.plane.adjacent a1 a3 := by + have hc := chord (chart.vertexEquiv.symm a0) (chart.vertexEquiv.symm a1) + (chart.vertexEquiv.symm a2) (chart.vertexEquiv.symm a3) + (fun he => hne02 (chart.vertexEquiv.symm.injective he)) + (fun he => hne13 (chart.vertexEquiv.symm.injective he)) + ((chart_adj a0 a1).mp hadj01) ((chart_adj a1 a2).mp hadj12) + ((chart_adj a2 a3).mp hadj23) ((chart_adj a3 a0).mp hadj30) + exact hc.imp (chart_adj a0 a2).mpr (chart_adj a1 a3).mpr + have vertex_of_cell (a : ι) (y : GaussianInt) (hy : y ∈ (P.tile a).cells) + (hx : x = y ∨ x = y + 1 ∨ x = y + ⟨0, 1⟩ ∨ + x = y + 1 + ⟨0, 1⟩) : x ∈ FootprintVertices (P.tile a) := by + rw [FootprintVertices, ite_eq_left ⟨y, hy⟩] + exact ⟨y, hy, hx⟩ + have hv0 : x ∈ FootprintVertices (P.tile a0) := + vertex_of_cell a0 x h0 (Or.inl rfl) + have hv1 : x ∈ FootprintVertices (P.tile a1) := by + apply vertex_of_cell a1 (x - 1) h1 + exact Or.inr (Or.inl (by simp)) + have hv2 : x ∈ FootprintVertices (P.tile a2) := by + apply vertex_of_cell a2 (x - 1 - ⟨0, 1⟩) h2 + exact Or.inr (Or.inr (Or.inr (by abel))) + have hv3 : x ∈ FootprintVertices (P.tile a3) := by + apply vertex_of_cell a3 (x - ⟨0, 1⟩) h3 + exact Or.inr (Or.inr (Or.inl (by simp))) + have common_edge_at_vertex (a b : ι) (hne : a ≠ b) + (hadj : P.plane.adjacent a b) + (ha : x ∈ FootprintVertices (P.tile a)) + (hb : x ∈ FootprintVertices (P.tile b)) : + ∃ e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b), x ∈ e := by + have hnonempty := (classification a b hne).1.mpr hadj + have hv := ((classification a b hne).2.1 hnonempty).2 + have hx : x ∈ FootprintVertices (P.tile a) ∩ FootprintVertices (P.tile b) := ⟨ha, hb⟩ + rw [hv] at hx + exact hx + rcases hchord with hadj02 | hadj13 + · obtain ⟨e, he, hxe⟩ := common_edge_at_vertex a0 a2 hne02 hadj02 hv0 hv2 + have hE : LatticeVertexIncidentCell x 0 ∈ (P.tile a0).cells := by + simpa [LatticeVertexIncidentCell] using h0 + have hF : LatticeVertexIncidentCell x (0 + 2) ∈ (P.tile a2).cells := by + simpa [LatticeVertexIncidentCell] using h2 + have heq := OppositeRoutedCommonEdgeOutsideCellUnique (P.tile a0) (P.tile a2) + x 0 e (cell_disjoint a0 a2 hne02) hxe he hE hF 1 3 + (by simpa [LatticeVertexIncidentCell] using absent a0 a1 hne01 (x - 1) h1) + (by simpa [LatticeVertexIncidentCell] using absent a2 a1 hne12.symm (x - 1) h1) + (by simpa [LatticeVertexIncidentCell] using absent a0 a3 hne03 (x - ⟨0, 1⟩) h3) + (by simpa [LatticeVertexIncidentCell] using absent a2 a3 hne23 (x - ⟨0, 1⟩) h3) + have hre := congrArg Zsqrtd.re heq + simp [LatticeVertexIncidentCell] at hre + · obtain ⟨e, he, hxe⟩ := common_edge_at_vertex a1 a3 hne13 hadj13 hv1 hv3 + have hE : LatticeVertexIncidentCell x 1 ∈ (P.tile a1).cells := by + simpa [LatticeVertexIncidentCell] using h1 + have hF : LatticeVertexIncidentCell x (1 + 2) ∈ (P.tile a3).cells := by + simpa [LatticeVertexIncidentCell] using h3 + have heq := OppositeRoutedCommonEdgeOutsideCellUnique (P.tile a1) (P.tile a3) + x 1 e (cell_disjoint a1 a3 hne13) hxe he hE hF 0 2 + (by simpa [LatticeVertexIncidentCell] using absent a1 a0 hne01.symm x h0) + (by simpa [LatticeVertexIncidentCell] using absent a3 a0 hne03.symm x h0) + (by simpa [LatticeVertexIncidentCell] using absent a1 a2 hne12 (x - 1 - ⟨0, 1⟩) h2) + (by simpa [LatticeVertexIncidentCell] using absent a3 a2 hne23.symm (x - 1 - ⟨0, 1⟩) h2) + have hre := congrArg Zsqrtd.re heq + simp [LatticeVertexIncidentCell] at hre + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean new file mode 100644 index 0000000000..5d6d153ab3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean @@ -0,0 +1,1248 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation +public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.NormNum +public import Mathlib.Data.List.Chain +public import Mathlib.Analysis.Convex.Topology +public import Mathlib.Analysis.Convex.PathConnected +public import Mathlib.Topology.Homeomorph.Lemmas +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring +public import Mathlib.Tactic.FunProp +public import Mathlib.Tactic.ClearExclamation + +-- [TABLET NODE: AffineTriangularPlaneTriangulation] + +/-! +# AffineTriangularPlaneTriangulation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace AffineTriangulationLemmas + +private theorem symm_adj : + ∀ (a : (Int × Int)), ∀ (b : (Int × Int)), TriangularLatticeAdjacent a b ↔ + TriangularLatticeAdjacent b a := by + classical + intro a b + simp only [TriangularLatticeAdjacent, Prod.ext_iff, Prod.fst_sub, Prod.snd_sub] + omega + +private theorem irrefl_adj : + ∀ (a : (Int × Int)), ¬ TriangularLatticeAdjacent a a := by + classical + intro a + simp [TriangularLatticeAdjacent, Prod.ext_iff] + +private theorem finite_adj : + ∀ (a : (Int × Int)), Set.Finite {b | TriangularLatticeAdjacent a b} := by + classical + intro a + apply (Set.toFinite ({a + (1, 0), a + (0, 1), a + (-1, -1), + a + (-1, 0), a + (0, -1), a + (1, 1)} : Set (Int × Int))).subset + intro b hb + simp only [Set.mem_ofPred_eq, TriangularLatticeAdjacent] at hb + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + rcases hb with h | h | h | h | h | h + all_goals simp only [Prod.ext_iff, Prod.fst_sub, Prod.snd_sub, + Prod.fst_add, Prod.snd_add] at h ⊢ + all_goals omega + +private theorem distinct_fv : + let fv : (Sum (Int × Int) (Int × Int)) → Fin 3 → (Int × Int) := fun + | Sum.inl x => ![x, x + (1, 0), x - (0, 1)] + | Sum.inr x => ![x, x - (1, 0), x + (0, 1)] + ∀ (f : (Sum (Int × Int) (Int × Int))), Function.Injective (fv f) := by + classical + intro fv f i j h + cases f <;> fin_cases i <;> fin_cases j <;> + simp [fv, Prod.ext_iff] at h ⊢ <;> omega + +private theorem edges_fv : + let fv : (Sum (Int × Int) (Int × Int)) → Fin 3 → (Int × Int) := fun + | Sum.inl x => ![x, x + (1, 0), x - (0, 1)] + | Sum.inr x => ![x, x - (1, 0), x + (0, 1)] + ∀ (f : (Sum (Int × Int) (Int × Int))), ∀ (i : Fin 3), ∀ (j : Fin 3), (i ≠ j) → + (TriangularLatticeAdjacent (fv f i) (fv f j)) := by + classical + intro fv f i j h + cases f <;> fin_cases i <;> fin_cases j <;> + simp [fv, TriangularLatticeAdjacent, Prod.ext_iff] at h ⊢ + +private theorem two_faces : + let fv : (Sum (Int × Int) (Int × Int)) → Fin 3 → (Int × Int) := fun + | Sum.inl x => ![x, x + (1, 0), x - (0, 1)] + | Sum.inr x => ![x, x - (1, 0), x + (0, 1)] + ∀ (a : (Int × Int)), ∀ (b : (Int × Int)), (TriangularLatticeAdjacent a b) → (∃ f g : (Sum + (Int × Int) (Int × Int)), f ≠ g ∧ + ((∃ i, fv f i = a) ∧ (∃ i, fv f i = b)) ∧ + ((∃ i, fv g i = a) ∧ (∃ i, fv g i = b)) ∧ + ∀ h : (Sum (Int × Int) (Int × Int)), + ((∃ i, fv h i = a) ∧ (∃ i, fv h i = b)) → h = f ∨ h = g) := by + classical + intro fv a b hab + have classify (a b : (Int × Int)) (f g : (Sum (Int × Int) (Int × Int))) + (hf : f ≠ g) + (hi : (∃ i, fv f i = a) ∧ (∃ i, fv f i = b)) + (hj : (∃ i, fv g i = a) ∧ (∃ i, fv g i = b)) + (hunique : ∀ h : (Sum (Int × Int) (Int × Int)), ∀ i j : Fin 3, + fv h i = a → fv h j = b → h = f ∨ h = g) : + ∃ f g : (Sum (Int × Int) (Int × Int)), f ≠ g ∧ + ((∃ i, fv f i = a) ∧ (∃ i, fv f i = b)) ∧ + ((∃ i, fv g i = a) ∧ (∃ i, fv g i = b)) ∧ + ∀ h : (Sum (Int × Int) (Int × Int)), ((∃ i, fv h i = a) ∧ (∃ i, fv h i = b)) → + h = f ∨ h = g := by + exact ⟨f, g, hf, hi, hj, fun h ⟨⟨i, hi⟩, ⟨j, hj⟩⟩ => hunique h i j hi hj⟩ + let incidence : (Int × Int) → (Int × Int) → Prop := fun a b => + ∃ f g : (Sum (Int × Int) (Int × Int)), f ≠ g ∧ + ((∃ i, fv f i = a) ∧ (∃ i, fv f i = b)) ∧ + ((∃ i, fv g i = a) ∧ (∃ i, fv g i = b)) ∧ + ∀ h, ((∃ i, fv h i = a) ∧ (∃ i, fv h i = b)) → h = f ∨ h = g + have flip {a b : Int × Int} (h : incidence b a) : incidence a b := by + rcases h with ⟨f, g, hfg, hf, hg, hunique⟩ + exact ⟨f, g, hfg, ⟨hf.2, hf.1⟩, ⟨hg.2, hg.1⟩, + fun h hh => hunique h ⟨hh.2, hh.1⟩⟩ + have positive (a b : Int × Int) + (hab : b - a = ((1, 0) : Int × Int) ∨ + b - a = ((0, 1) : Int × Int) ∨ b - a = ((1, 1) : Int × Int)) : + incidence a b := by + rcases hab with h | h | h + · apply classify a b (Sum.inl a) (Sum.inr b) + · simp + · refine ⟨⟨0, rfl⟩, ⟨1, ?_⟩⟩ + simp [fv, Prod.ext_iff] at h ⊢ + omega + · refine ⟨⟨1, ?_⟩, ⟨0, rfl⟩⟩ + simp [fv, Prod.ext_iff] at h ⊢ + omega + · intro f i j hi hj + cases f <;> fin_cases i <;> fin_cases j <;> + simp [fv, Prod.ext_iff] at h hi hj ⊢ <;> omega + · apply classify a b (Sum.inr a) (Sum.inl b) + · simp + · refine ⟨⟨0, rfl⟩, ⟨2, ?_⟩⟩ + simp [fv, Prod.ext_iff] at h ⊢ + omega + · refine ⟨⟨2, ?_⟩, ⟨0, rfl⟩⟩ + simp [fv, Prod.ext_iff] at h ⊢ + omega + · intro f i j hi hj + cases f <;> fin_cases i <;> fin_cases j <;> + simp [fv, Prod.ext_iff] at h hi hj ⊢ <;> omega + · apply classify a b (Sum.inl (a + (0, 1))) (Sum.inr (a + (1, 0))) + · simp + · refine ⟨⟨2, ?_⟩, ⟨1, ?_⟩⟩ + all_goals + first + | solve | simp [fv, Prod.ext_iff] at h ⊢ + | simp? [fv, Prod.ext_iff] at h ⊢ + omega + · refine ⟨⟨1, ?_⟩, ⟨2, ?_⟩⟩ + all_goals + first + | solve | simp [fv, Prod.ext_iff] at h ⊢ + | simp? [fv, Prod.ext_iff] at h ⊢ + omega + · intro f i j hi hj + cases f <;> fin_cases i <;> fin_cases j <;> + simp [fv, Prod.ext_iff] at h hi hj ⊢ <;> omega + rcases hab with h | h | h | h | h | h + · exact positive a b (Or.inl h) + · exact positive a b (Or.inr (Or.inl h)) + · apply flip (positive b a ?_) + right; right + simp only [Prod.ext_iff, Prod.fst_sub, Prod.snd_sub] at h ⊢ + omega + · apply flip (positive b a ?_) + left + simp only [Prod.ext_iff, Prod.fst_sub, Prod.snd_sub] at h ⊢ + omega + · apply flip (positive b a ?_) + right; left + simp only [Prod.ext_iff, Prod.fst_sub, Prod.snd_sub] at h ⊢ + omega + · exact positive a b (Or.inr (Or.inr h)) + +private theorem int_walk : + ∀ {R : (Int × Int) → (Int × Int) → Prop}, (∀ a b, R a b → R b a) → (∀ (f : Int → (Int × + Int)), (∀ k, R (f k) (f (k + 1))) → (∀ (m : Int), ∀ (n : Int), Relation.ReflTransGen R (f + m) (f n))) := by + classical + intro R hs f step m n + have reverse {x y : (Int × Int)} (h : Relation.ReflTransGen R x y) : + Relation.ReflTransGen R y x := by + induction h with + | refl => exact .refl + | @tail b c hbc hstep ih => exact ih.head (hs _ _ hstep) + have forward (m n : Int) (hmn : m ≤ n) : + Relation.ReflTransGen R (f m) (f n) := by + induction n, hmn using Int.leInduction with + | base => exact .refl + | succ n hn ih => exact ih.tail (step n) + by_cases hmn : m ≤ n + · exact forward m n hmn + · exact reverse (forward n m (by omega)) + +private theorem deletion_walk : + (∀ (a : (Int × Int)), ∀ (b : (Int × Int)), TriangularLatticeAdjacent a b ↔ + TriangularLatticeAdjacent b a) → ((∀ {R : (Int × Int) → (Int × Int) → Prop}, (∀ a b, R a + b → R b a) → (∀ (f : Int → (Int × Int)), (∀ k, R (f k) (f (k + 1))) → (∀ (m : Int), ∀ (n + : Int), Relation.ReflTransGen R (f m) (f n)))) → (∀ (D : Finset (Int × Int)), (D.card < + 3) → (∀ (a : (Int × Int)), ∀ (b : (Int × Int)), (a ∉ D) → ((b ∉ D) → (∃ p : List (Int × + Int), p.head? = some a ∧ p.getLast? = some b ∧ + (∀ x ∈ p, x ∉ D) ∧ + ∀ x y : (Int × Int), ∀ l₁ l₂ : List (Int × Int), + p = l₁ ++ x :: y :: l₂ → TriangularLatticeAdjacent x y))))) := by + classical + intro symm_adj int_walk D hD a b ha hb + classical + let R : (Int × Int) → (Int × Int) → Prop := fun x y => TriangularLatticeAdjacent x y ∧ x ∉ D ∧ + y ∉ D + have symmR (x y : (Int × Int)) (h : R x y) : R y x := + ⟨(symm_adj x y).mp h.1, h.2.2, h.2.1⟩ + have reverse {x y : (Int × Int)} (h : Relation.ReflTransGen R x y) : + Relation.ReflTransGen R y x := by + induction h with + | refl => exact .refl + | @tail b c hbc hstep ih => exact ih.head (symmR _ _ hstep) + have column (k : Int) : ∃ r : Int, + (r = k - 1 ∨ r = k ∨ r = k + 1) ∧ ∀ t : Int, (r, t) ∉ D := by + have triple : ({k - 1, k, k + 1} : Finset Int).card = 3 := by + have h1 : k - 1 ≠ k := by omega + have h2 : k - 1 ≠ k + 1 := by omega + have h3 : k ≠ k + 1 := by omega + simp [h1, h2, h3] + have hsub : ¬ ({k - 1, k, k + 1} : Finset Int) ⊆ D.image Prod.fst := by + intro h + have hh := Finset.card_le_card h + have hi := Finset.card_image_le (s := D) (f := Prod.fst) + omega + obtain ⟨r, hr, hd⟩ := Finset.not_subset.mp hsub + refine ⟨r, ?_, ?_⟩ + · simpa only [Finset.mem_insert, Finset.mem_singleton] using hr + · intro t ht + exact hd (Finset.mem_image.mpr ⟨(r, t), ht, rfl⟩) + obtain ⟨r, hr, hrclean⟩ := column a.1 + obtain ⟨s, hs, hsclean⟩ := column b.1 + obtain ⟨h, _, hh⟩ := (Set.infinite_univ : (Set.univ : Set Int).Infinite).exists_notMem_finset + (D.image Prod.snd) + have rowclean (k : Int) : (k, h) ∉ D := by + intro hk + exact hh (Finset.mem_image.mpr ⟨(k, h), hk, rfl⟩) + have endpoint (x : (Int × Int)) (hx : x ∉ D) (r : Int) + (hr : r = x.1 - 1 ∨ r = x.1 ∨ r = x.1 + 1) + (hc : ∀ t : Int, (r, t) ∉ D) : Relation.ReflTransGen R x (r, x.2) := by + rcases hr with hr | hr | hr + · apply Relation.ReflTransGen.single + refine ⟨?_, hx, hc _⟩ + simp [TriangularLatticeAdjacent, Prod.ext_iff] + omega + · have heq : x = (r, x.2) := Prod.ext hr.symm rfl + rw [heq] + · apply Relation.ReflTransGen.single + refine ⟨?_, hx, hc _⟩ + simp [TriangularLatticeAdjacent, Prod.ext_iff] + omega + have vertical (r : Int) (hc : ∀ t : Int, (r, t) ∉ D) (m n : Int) : + Relation.ReflTransGen R (r, m) (r, n) := by + apply int_walk symmR (fun t => (r, t)) (m := m) (n := n) + intro k + refine ⟨?_, hc _, hc _⟩ + simp [TriangularLatticeAdjacent, Prod.ext_iff] + have horizontal : Relation.ReflTransGen R (r, h) (s, h) := by + apply int_walk symmR (fun k => (k, h)) (m := r) (n := s) + intro k + refine ⟨?_, rowclean _, rowclean _⟩ + simp [TriangularLatticeAdjacent, Prod.ext_iff] + have finalStep : Relation.ReflTransGen R (s, b.2) b := + reverse (endpoint b hb s hs hsclean) + have route : Relation.ReflTransGen R a b := + (endpoint a ha r hr hrclean).trans + ((vertical r hrclean a.2 h).trans + (horizontal.trans ((vertical s hsclean h b.2).trans finalStep))) + obtain ⟨l, hl, hlast⟩ := List.exists_isChain_cons_of_relationReflTransGen route + refine ⟨a :: l, rfl, ?_, ?_, ?_⟩ + · rw [List.getLast?_eq_some_getLast (List.cons_ne_nil a l), hlast] + · exact hl.induction (fun x => x ∉ D) (a :: l) (fun {_ _} h _ => h.2.2) (fun _ => ha) + · intro x y l₁ l₂ heq + exact ((List.isChain_iff_forall_rel_of_append_cons_cons.mp hl) heq).1 + +private theorem coord_injective : + let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) + Function.Injective coord := by + classical + intro coord x y h + have h1 := congrArg Prod.fst h + have h2 := congrArg Prod.snd h + simp only [coord] at h1 h2 + exact Prod.ext (by exact_mod_cast h1) (by exact_mod_cast h2) + +private theorem segment_homeo : + ∀ (a : (Real × Real)), ∀ (b : (Real × Real)), (a ≠ b) → (∃ h : (Set.Icc (0 : Real) 1) ≃ₜ + segment Real a b, + ((h ⟨0, by norm_num⟩ : segment Real a b) : (Real × Real)) = a ∧ + ((h ⟨1, by norm_num⟩ : segment Real a b) : (Real × Real)) = b) := by + classical + intro a b hne + let g : Set.Icc (0 : Real) 1 → segment Real a b := fun t => + ⟨AffineMap.lineMap a b (t : Real), lineMap_mem_segment Real a b t.property⟩ + have hg : Function.Bijective g := by + constructor + · intro s t h + apply Subtype.ext + exact AffineMap.lineMap_injective Real hne (congrArg Subtype.val h) + · intro p + have hp : (p : (Real × Real)) ∈ AffineMap.lineMap a b '' Set.Icc (0 : Real) 1 := by + simpa only [segment_eq_image_lineMap] using p.property + obtain ⟨t, ht, heq⟩ := hp + exact ⟨⟨t, ht⟩, Subtype.ext heq⟩ + let e := Equiv.ofBijective g hg + have hc : Continuous (e : Set.Icc (0 : Real) 1 → segment Real a b) := by + change Continuous g + fun_prop + refine ⟨hc.homeoOfEquivCompactToT2, ?_, ?_⟩ + · change AffineMap.lineMap a b (0 : Real) = a + simp + · change AffineMap.lineMap a b (1 : Real) = b + simp + +private theorem arc_homeo : + let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) + let shear : (Real × Real) ≃ₜ (Real × Real) := { + toFun p := (p.1 - p.2 / 2, p.2) + invFun p := (p.1 + p.2 / 2, p.2) + left_inv p := by ext <;> simp + right_inv p := by ext <;> simp + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + (Function.Injective coord) → ( + let arc (a b : (Int × Int)) : Set (Real × Real) := shear '' segment Real (coord a) (coord b) + (∀ (a : (Real × Real)), ∀ (b : (Real × Real)), (a ≠ b) → (∃ h : (Set.Icc (0 : Real) 1) ≃ₜ + segment Real a b, ((h ⟨0, by norm_num⟩ : segment Real a b) : (Real × Real)) = a ∧ ((h ⟨1, + by norm_num⟩ : segment Real a b) : (Real × Real)) = b)) → (∀ (a : (Int × Int)), ∀ (b : + (Int × Int)), (a ≠ b) → (∃ h : (Set.Icc (0 : Real) 1) ≃ₜ arc a b, + ((h ⟨0, by norm_num⟩ : arc a b) : (Real × Real)) = shear (coord a) ∧ + ((h ⟨1, by norm_num⟩ : arc a b) : (Real × Real)) = shear (coord b)))) := by + classical + intro coord shear coord_injective arc segment_homeo a b hne + obtain ⟨h, h0, h1⟩ := segment_homeo (coord a) (coord b) (fun h => hne (coord_injective h)) + refine ⟨h.trans (shear.image _), ?_, ?_⟩ + · change shear ((h ⟨0, by norm_num⟩ : segment Real (coord a) (coord b)) : (Real × Real)) = _ + rw [h0] + · change shear ((h ⟨1, by norm_num⟩ : segment Real (coord a) (coord b)) : (Real × Real)) = _ + rw [h1] + +private theorem open_T : + let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} + IsOpen T := by + classical + intro T + exact (isOpen_lt continuous_const continuous_fst).inter + ((isOpen_lt continuous_const continuous_snd).inter + (isOpen_lt (continuous_fst.add continuous_snd) continuous_const)) + +private theorem closed_C : + let C : Set (Real × Real) := {p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 ≤ 1} + IsClosed C := by + classical + intro C + exact (isClosed_le continuous_const continuous_fst).inter + ((isClosed_le continuous_const continuous_snd).inter + (isClosed_le (continuous_fst.add continuous_snd) continuous_const)) + +private theorem convex_T : + let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} + Convex Real T := by + classical + intro T + exact (convex_halfSpace_gt (LinearMap.fst Real Real Real).isLinear 0).inter + ((convex_halfSpace_gt (LinearMap.snd Real Real Real).isLinear 0).inter + (convex_halfSpace_lt ((LinearMap.fst Real Real Real) + + (LinearMap.snd Real Real Real)).isLinear 1)) + +private theorem connected_T : + let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} + (Convex Real T) → (IsConnected T) := by + classical + intro T convex_T + exact convex_T.isConnected ⟨(1 / 3, 1 / 3), by norm_num [T]⟩ + +private theorem closure_T : + let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} + let C : Set (Real × Real) := {p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 ≤ 1} + (IsClosed C) → (closure T = C) := by + classical + intro T C closed_C + apply Set.Subset.antisymm + · apply closed_C.closure_subset_iff.mpr + intro p hp + exact ⟨hp.1.le, hp.2.1.le, hp.2.2.le⟩ + · intro p hp + have hsegment : openSegment Real p (1 / 3, 1 / 3) ⊆ T := by + intro q hq + rcases hq with ⟨a, b, ha, hb, hab, rfl⟩ + simp only [C, Set.mem_ofPred_eq] at hp + simp only [T, Set.mem_ofPred_eq, Prod.fst_add, Prod.snd_add, + Prod.smul_fst, Prod.smul_snd, smul_eq_mul] + refine ⟨?_, ?_, ?_⟩ <;> + nlinarith [mul_nonneg ha.le hp.1, mul_nonneg ha.le hp.2.1, + mul_nonneg ha.le (show 0 ≤ 1 - (p.1 + p.2) by linarith [hp.2.2])] + apply closure_mono hsegment + exact segment_subset_closure_openSegment (left_mem_segment Real p (1 / 3, 1 / 3)) + +private theorem boundary_T : + let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} + let C : Set (Real × Real) := {p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 ≤ 1} + (IsOpen T) → ((closure T = C) → (frontier T = + segment Real ((0, 0) : (Real × Real)) (1, 0) ∪ + segment Real ((1, 0) : (Real × Real)) (0, 1) ∪ + segment Real ((0, 1) : (Real × Real)) (0, 0))) := by + classical + intro T C open_T closure_T + rw [frontier, open_T.interior_eq, closure_T] + ext p + simp only [Set.mem_sdiff, C, T, Set.mem_ofPred_eq, Set.mem_union] + constructor + · rintro ⟨⟨hx, hy, hsum⟩, hnot⟩ + have heq : p.2 = 0 ∨ p.1 + p.2 = 1 ∨ p.1 = 0 := by + by_contra h + simp only [not_or] at h + exact hnot ⟨lt_of_le_of_ne hx (Ne.symm h.2.2), + lt_of_le_of_ne hy (Ne.symm h.1), lt_of_le_of_ne hsum h.2.1⟩ + rcases heq with heq | heq | heq + · left; left + rw [segment_eq_image' Real] + refine ⟨p.1, ⟨hx, by linarith⟩, ?_⟩ + ext <;> simp [heq] + · left; right + rw [segment_eq_image' Real] + refine ⟨p.2, ⟨hy, by linarith⟩, ?_⟩ + ext <;> simp; linarith + · right + rw [segment_eq_image' Real] + refine ⟨1 - p.2, ⟨by linarith, by linarith⟩, ?_⟩ + ext <;> simp [heq] + · intro hp + rcases hp with (hp | hp) | hp + all_goals rw [segment_eq_image' Real] at hp + all_goals rcases hp with ⟨t, ⟨h0, h1⟩, rfl⟩ + all_goals simp only [Prod.fst_add, Prod.snd_add, Prod.smul_fst, Prod.smul_snd, + Prod.fst_sub, Prod.snd_sub, smul_eq_mul] + all_goals norm_num at h0 h1 ⊢ + all_goals constructor + all_goals assumption + +private theorem tile_segment : + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun + | Sum.inl x => { + toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) + invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + | Sum.inr x => { + toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) + invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + ∀ (f : (Sum (Int × Int) (Int × Int))), ∀ (a : (Real × Real)), ∀ (b : (Real × Real)), tile f + '' segment Real a b = segment Real (tile f a) (tile f b) := by + classical + intro tile f a b + rw [segment_eq_image' Real, segment_eq_image' Real, Set.image_image] + congr 1 + funext t + cases f <;> ext <;> + simp [tile, Prod.smul_fst, Prod.smul_snd, smul_eq_mul] <;> ring + +private theorem tile_vertices : + let fv : (Sum (Int × Int) (Int × Int)) → Fin 3 → (Int × Int) := fun + | Sum.inl x => ![x, x + (1, 0), x - (0, 1)] + | Sum.inr x => ![x, x - (1, 0), x + (0, 1)] + let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun + | Sum.inl x => { + toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) + invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + | Sum.inr x => { + toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) + invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + ∀ (f : (Sum (Int × Int) (Int × Int))), tile f (0, 0) = coord (fv f 0) ∧ + tile f (1, 0) = coord (fv f 1) ∧ + tile f (0, 1) = coord (fv f 2) := by + classical + intro fv coord tile f + cases f <;> simp [tile, fv, coord] + +private theorem boundary_region : + let fv : (Sum (Int × Int) (Int × Int)) → Fin 3 → (Int × Int) := fun + | Sum.inl x => ![x, x + (1, 0), x - (0, 1)] + | Sum.inr x => ![x, x - (1, 0), x + (0, 1)] + let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) + let shear : (Real × Real) ≃ₜ (Real × Real) := { + toFun p := (p.1 - p.2 / 2, p.2) + invFun p := (p.1 + p.2 / 2, p.2) + left_inv p := by ext <;> simp + right_inv p := by ext <;> simp + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + let arc (a b : (Int × Int)) : Set (Real × Real) := shear '' segment Real (coord a) (coord b) + let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} + (frontier T = segment Real ((0, 0) : (Real × Real)) (1, 0) ∪ segment Real ((1, 0) : (Real × + Real)) (0, 1) ∪ segment Real ((0, 1) : (Real × Real)) (0, 0)) → ( + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun + | Sum.inl x => { + toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) + invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + | Sum.inr x => { + toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) + invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + let region (f : (Sum (Int × Int) (Int × Int))) : Set (Real × Real) := shear '' tile f '' T + (∀ (f : (Sum (Int × Int) (Int × Int))), ∀ (a : (Real × Real)), ∀ (b : (Real × Real)), tile f + '' segment Real a b = segment Real (tile f a) (tile f b)) → ((∀ (f : (Sum (Int × Int) + (Int × Int))), tile f (0, 0) = coord (fv f 0) ∧ tile f (1, 0) = coord (fv f 1) ∧ tile f + (0, 1) = coord (fv f 2)) → (∀ (f : (Sum (Int × Int) (Int × Int))), frontier (region f) = + arc (fv f 0) (fv f 1) ∪ arc (fv f 1) (fv f 2) ∪ arc (fv f 2) (fv f 0)))) := by + classical + intro fv coord shear arc T boundary_T tile region tile_segment tile_vertices f + dsimp only [region] + rw [← shear.image_frontier, ← (tile f).image_frontier, boundary_T] + simp only [Set.image_union, tile_segment] + rw [(tile_vertices f).1, (tile_vertices f).2.1, (tile_vertices f).2.2] + +private theorem open_region : + let shear : (Real × Real) ≃ₜ (Real × Real) := { + toFun p := (p.1 - p.2 / 2, p.2) + invFun p := (p.1 + p.2 / 2, p.2) + left_inv p := by ext <;> simp + right_inv p := by ext <;> simp + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} + (IsOpen T) → ( + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun + | Sum.inl x => { + toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) + invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + | Sum.inr x => { + toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) + invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + let region (f : (Sum (Int × Int) (Int × Int))) : Set (Real × Real) := shear '' tile f '' T + ∀ (f : (Sum (Int × Int) (Int × Int))), IsOpen (region f)) := by + classical + intro shear T open_T tile region f + exact shear.isOpenMap _ ((tile f).isOpenMap _ open_T) + +private theorem connected_region : + let shear : (Real × Real) ≃ₜ (Real × Real) := { + toFun p := (p.1 - p.2 / 2, p.2) + invFun p := (p.1 + p.2 / 2, p.2) + left_inv p := by ext <;> simp + right_inv p := by ext <;> simp + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} + (IsConnected T) → ( + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun + | Sum.inl x => { + toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) + invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + | Sum.inr x => { + toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) + invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + let region (f : (Sum (Int × Int) (Int × Int))) : Set (Real × Real) := shear '' tile f '' T + ∀ (f : (Sum (Int × Int) (Int × Int))), IsConnected (region f)) := by + classical + intro shear T connected_T tile region f + exact (connected_T.image (tile f) (tile f).continuous.continuousOn).image + shear shear.continuous.continuousOn + +private theorem closed_cover : + let C : Set (Real × Real) := {p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 ≤ 1} + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun + | Sum.inl x => { + toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) + invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + | Sum.inr x => { + toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) + invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + ∀ (p : (Real × Real)), ∃ f : (Sum (Int × Int) (Int × Int)), p ∈ tile f '' C := by + classical + intro C tile p + let m : Int := ⌊p.1⌋ + let n : Int := ⌊p.2⌋ + have hm0 : (m : Real) ≤ p.1 := Int.floor_le p.1 + have hm1 : p.1 < (m : Real) + 1 := Int.lt_floor_add_one p.1 + have hn0 : (n : Real) ≤ p.2 := Int.floor_le p.2 + have hn1 : p.2 < (n : Real) + 1 := Int.lt_floor_add_one p.2 + by_cases h : p.1 - (m : Real) + ((n : Real) + 1 - p.2) ≤ 1 + · refine ⟨Sum.inl (m, n + 1), (p.1 - (m : Real), (n : Real) + 1 - p.2), ?_, ?_⟩ + · simp only [C, Set.mem_ofPred_eq] + exact ⟨by linarith, by linarith, h⟩ + · ext <;> simp [tile] + · refine ⟨Sum.inr (m + 1, n), ((m : Real) + 1 - p.1, p.2 - (n : Real)), ?_, ?_⟩ + · simp only [C, Set.mem_ofPred_eq] + exact ⟨by linarith, by linarith, by linarith⟩ + · ext <;> simp [tile] + +private theorem strip_unique : + ∀ (m : Int), ∀ (n : Int), ∀ (r : Real), ((m : Real) < r ∧ r < (m : Real) + 1) → (((n : Real) + < r ∧ r < (n : Real) + 1) → (m = n)) := by + classical + intro m n r hm hn + rcases lt_trichotomy m n with h | h | h + · have h' : (m : Real) + 1 ≤ (n : Real) := by exact_mod_cast (show m + 1 ≤ n by omega) + linarith + · exact h + · have h' : (n : Real) + 1 ≤ (m : Real) := by exact_mod_cast (show n + 1 ≤ m by omega) + linarith + +private theorem tiles_disjoint : + let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun + | Sum.inl x => { + toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) + invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + | Sum.inr x => { + toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) + invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + (∀ (m : Int), ∀ (n : Int), ∀ (r : Real), ((m : Real) < r ∧ r < (m : Real) + 1) → (((n : Real) + < r ∧ r < (n : Real) + 1) → (m = n))) → (Pairwise fun f g => Disjoint (tile f '' T) (tile + g '' T)) := by + classical + intro T tile strip_unique f g hfg + apply Set.disjoint_left.mpr + rintro p ⟨u, hu, hup⟩ ⟨v, hv, hvp⟩ + have heq : tile f u = tile g v := hup.trans hvp.symm + have hu1 : u.1 < 1 := by linarith [hu.1, hu.2.1, hu.2.2] + have hu2 : u.2 < 1 := by linarith [hu.1, hu.2.1, hu.2.2] + have hv1 : v.1 < 1 := by linarith [hv.1, hv.2.1, hv.2.2] + have hv2 : v.2 < 1 := by linarith [hv.1, hv.2.1, hv.2.2] + cases f with + | inl x => + cases g with + | inl y => + simp only [tile, Prod.ext_iff] at heq + dsimp at heq + have hx : x.1 = y.1 := strip_unique x.1 y.1 ((x.1 : Real) + u.1) + ⟨by linarith [hu.1], by linarith⟩ ⟨by linarith [hv.1, heq.1], by linarith [heq.1]⟩ + have hy : x.2 - 1 = y.2 - 1 := strip_unique (x.2 - 1) (y.2 - 1) ((x.2 : Real) - u.2) + ⟨by push_cast; linarith, by push_cast; linarith [hu.2.1]⟩ + ⟨by push_cast; linarith [heq.2], by push_cast; linarith [hv.2.1, heq.2]⟩ + exact hfg (congrArg Sum.inl (Prod.ext hx (by omega))) + | inr y => + simp only [tile, Prod.ext_iff] at heq + dsimp at heq + have hx : x.1 = y.1 - 1 := strip_unique x.1 (y.1 - 1) ((x.1 : Real) + u.1) + ⟨by linarith [hu.1], by linarith⟩ + ⟨by push_cast; linarith [heq.1], by push_cast; linarith [hv.1, heq.1]⟩ + have hy : x.2 - 1 = y.2 := strip_unique (x.2 - 1) y.2 ((x.2 : Real) - u.2) + ⟨by push_cast; linarith, by push_cast; linarith [hu.2.1]⟩ + ⟨by linarith [hv.2.1, heq.2], by linarith [heq.2]⟩ + have hx' : (x.1 : Real) = (y.1 : Real) - 1 := by exact_mod_cast hx + have hy' : (x.2 : Real) - 1 = (y.2 : Real) := by exact_mod_cast hy + linarith [hu.2.2, hv.2.2, heq.1, heq.2] + | inr x => + cases g with + | inl y => + simp only [tile, Prod.ext_iff] at heq + dsimp at heq + have hx : x.1 - 1 = y.1 := strip_unique (x.1 - 1) y.1 ((x.1 : Real) - u.1) + ⟨by push_cast; linarith, by push_cast; linarith [hu.1]⟩ + ⟨by linarith [hv.1, heq.1], by linarith [heq.1]⟩ + have hy : x.2 = y.2 - 1 := strip_unique x.2 (y.2 - 1) ((x.2 : Real) + u.2) + ⟨by linarith [hu.2.1], by linarith⟩ + ⟨by push_cast; linarith [heq.2], by push_cast; linarith [hv.2.1, heq.2]⟩ + have hx' : (x.1 : Real) - 1 = (y.1 : Real) := by exact_mod_cast hx + have hy' : (x.2 : Real) = (y.2 : Real) - 1 := by exact_mod_cast hy + linarith [hu.2.2, hv.2.2, heq.1, heq.2] + | inr y => + simp only [tile, Prod.ext_iff] at heq + dsimp at heq + have hx : x.1 - 1 = y.1 - 1 := strip_unique (x.1 - 1) (y.1 - 1) ((x.1 : Real) - u.1) + ⟨by push_cast; linarith, by push_cast; linarith [hu.1]⟩ + ⟨by push_cast; linarith [heq.1], by push_cast; linarith [hv.1, heq.1]⟩ + have hy : x.2 = y.2 := strip_unique x.2 y.2 ((x.2 : Real) + u.2) + ⟨by linarith [hu.2.1], by linarith⟩ ⟨by linarith [hv.2.1, heq.2], by linarith [heq.2]⟩ + exact hfg (congrArg Sum.inr (Prod.ext (by omega) hy)) + +private theorem regions_disjoint : + let shear : (Real × Real) ≃ₜ (Real × Real) := { + toFun p := (p.1 - p.2 / 2, p.2) + invFun p := (p.1 + p.2 / 2, p.2) + left_inv p := by ext <;> simp + right_inv p := by ext <;> simp + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun + | Sum.inl x => { + toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) + invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + | Sum.inr x => { + toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) + invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + let region (f : (Sum (Int × Int) (Int × Int))) : Set (Real × Real) := shear '' tile f '' T + (Pairwise fun f g => Disjoint (tile f '' T) (tile g '' T)) → (Pairwise fun f g => Disjoint + (region f) (region g)) := by + classical + intro shear T tile region tiles_disjoint f g hfg + exact (tiles_disjoint hfg).image (shear.injective.injOn (s := Set.univ)) + (Set.subset_univ _) (Set.subset_univ _) + +private theorem plane_cover : + let fv : (Sum (Int × Int) (Int × Int)) → Fin 3 → (Int × Int) := fun + | Sum.inl x => ![x, x + (1, 0), x - (0, 1)] + | Sum.inr x => ![x, x - (1, 0), x + (0, 1)] + (∀ (f : (Sum (Int × Int) (Int × Int))), ∀ (i : Fin 3), ∀ (j : Fin 3), (i ≠ j) → + (TriangularLatticeAdjacent (fv f i) (fv f j))) → ( + let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) + let shear : (Real × Real) ≃ₜ (Real × Real) := { + toFun p := (p.1 - p.2 / 2, p.2) + invFun p := (p.1 + p.2 / 2, p.2) + left_inv p := by ext <;> simp + right_inv p := by ext <;> simp + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + let arc (a b : (Int × Int)) : Set (Real × Real) := shear '' segment Real (coord a) (coord b) + let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} + let C : Set (Real × Real) := {p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 ≤ 1} + (closure T = C) → ( + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun + | Sum.inl x => { + toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) + invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + | Sum.inr x => { + toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) + invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + let region (f : (Sum (Int × Int) (Int × Int))) : Set (Real × Real) := shear '' tile f '' T + (∀ (f : (Sum (Int × Int) (Int × Int))), frontier (region f) = arc (fv f 0) (fv f 1) ∪ arc (fv + f 1) (fv f 2) ∪ arc (fv f 2) (fv f 0)) → ((∀ (p : (Real × Real)), ∃ f : (Sum (Int × Int) + (Int × Int)), p ∈ tile f '' C) → (Set.range (fun x => shear (coord x)) ∪ + {p | ∃ a b, TriangularLatticeAdjacent a b ∧ p ∈ arc a b} ∪ + {p | ∃ f, p ∈ region f} = Set.univ)))) := by + classical + intro fv edges_fv coord shear arc T C closure_T tile region boundary_region closed_cover + apply Set.eq_univ_of_forall + intro p + obtain ⟨q, rfl⟩ := shear.surjective p + obtain ⟨f, u, hu, huq⟩ := closed_cover q + rw [← closure_T, closure_eq_self_union_frontier] at hu + rcases hu with hu | hu + · exact Or.inr ⟨f, ⟨q, ⟨u, hu, huq⟩, rfl⟩⟩ + · have hp : shear q ∈ frontier (region f) := by + dsimp only [region] + rw [← shear.image_frontier, ← (tile f).image_frontier] + exact ⟨q, ⟨u, hu, huq⟩, rfl⟩ + rw [boundary_region] at hp + rcases hp with (hp | hp) | hp + · exact Or.inl (Or.inr ⟨fv f 0, fv f 1, edges_fv f 0 1 (by decide), hp⟩) + · exact Or.inl (Or.inr ⟨fv f 1, fv f 2, edges_fv f 1 2 (by decide), hp⟩) + · exact Or.inl (Or.inr ⟨fv f 2, fv f 0, edges_fv f 2 0 (by decide), hp⟩) + +private theorem fraction_integer : + ∀ (m : Int), ∀ (n : Int), ∀ (s : Real), (s ∈ Set.Icc (0 : Real) 1) → (((m : Real) + s = (n : + Real)) → (s = 0 ∨ s = 1)) := by + classical + intro m n s hs h + have lo : m ≤ n := by exact_mod_cast (show (m : Real) ≤ (n : Real) by linarith [hs.1]) + have hi : n ≤ m + 1 := by + exact_mod_cast (show (n : Real) ≤ (m : Real) + 1 by linarith [hs.2]) + rcases (show n = m ∨ n = m + 1 by omega) with heq | heq + · have h' : (n : Real) = (m : Real) := by exact_mod_cast heq + left; linarith + · have h' : (n : Real) = (m : Real) + 1 := by exact_mod_cast heq + right; linarith + +private theorem fraction_gap : + ∀ (m : Int), ∀ (n : Int), ∀ (s : Real), ∀ (t : Real), (s ∈ Set.Icc (0 : Real) 1) → ((t ∈ + Set.Icc (0 : Real) 1) → (((m : Real) + s = (n : Real) + t) → ((m ≠ n) → ((s = 0 ∨ s = 1) + ∧ (t = 0 ∨ t = 1))))) := by + classical + intro m n s t hs ht h hne + rcases lt_trichotomy m n with hmn | hmn | hmn + · have h' : (m : Real) + 1 ≤ (n : Real) := by exact_mod_cast (show m + 1 ≤ n by omega) + exact ⟨Or.inr (by linarith [hs.1, hs.2, ht.1, ht.2]), + Or.inl (by linarith [hs.1, hs.2, ht.1, ht.2])⟩ + · exact (hne hmn).elim + · have h' : (n : Real) + 1 ≤ (m : Real) := by exact_mod_cast (show n + 1 ≤ m by omega) + exact ⟨Or.inl (by linarith [hs.1, hs.2, ht.1, ht.2]), + Or.inr (by linarith [hs.1, hs.2, ht.1, ht.2])⟩ + +private theorem endpoint_parameters : + let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) + let delta : Fin 3 → (Int × Int) := ![(1, 0), (0, 1), (1, 1)] + (∀ (m : Int), ∀ (n : Int), ∀ (s : Real), (s ∈ Set.Icc (0 : Real) 1) → (((m : Real) + s = (n : + Real)) → (s = 0 ∨ s = 1))) → ((∀ (m : Int), ∀ (n : Int), ∀ (s : Real), ∀ (t : Real), (s ∈ + Set.Icc (0 : Real) 1) → ((t ∈ Set.Icc (0 : Real) 1) → (((m : Real) + s = (n : Real) + t) + → ((m ≠ n) → ((s = 0 ∨ s = 1) ∧ (t = 0 ∨ t = 1)))))) → (∀ (x : (Int × Int)), ∀ (y : (Int + × Int)), ∀ (k : Fin 3), ∀ (l : Fin 3), ∀ (s : Real), ∀ (t : Real), (s ∈ Set.Icc (0 : + Real) 1) → ((t ∈ Set.Icc (0 : Real) 1) → ((coord x + s • (coord (x + delta k) - coord x) = + coord y + t • (coord (y + delta l) - coord y)) → ((({x, x + delta k} : Set (Int × Int)) ≠ + {y, y + delta l}) → ((s = 0 ∨ s = 1) ∧ (t = 0 ∨ t = 1))))))) := by + classical + intro coord delta fraction_integer fraction_gap x y k l s t hs ht h hne + fin_cases k <;> fin_cases l + all_goals simp? [delta, coord, Prod.ext_iff, smul_eq_mul] at h + · have hx : x.1 ≠ y.1 := by + intro hx + have hy : x.2 = y.2 := by exact_mod_cast h.2 + have heq := Prod.ext hx hy + exact hne (by rw [heq]) + exact fraction_gap x.1 y.1 s t hs ht h.1 hx + · exact ⟨fraction_integer x.1 y.1 s hs h.1, fraction_integer y.2 x.2 t ht h.2.symm⟩ + · have hte := fraction_integer y.2 x.2 t ht h.2.symm + refine ⟨?_, hte⟩ + rcases hte with heq | heq + · exact fraction_integer x.1 y.1 s hs (by linarith [h.1]) + · exact fraction_integer x.1 (y.1 + 1) s hs (by push_cast; linarith [h.1]) + · exact ⟨fraction_integer x.2 y.2 s hs h.2, fraction_integer y.1 x.1 t ht h.1.symm⟩ + · have hx : x.2 ≠ y.2 := by + intro hx + have hy : x.1 = y.1 := by exact_mod_cast h.1 + have heq := Prod.ext hy hx + exact hne (by rw [heq]) + exact fraction_gap x.2 y.2 s t hs ht h.2 hx + · have hte := fraction_integer y.1 x.1 t ht h.1.symm + refine ⟨?_, hte⟩ + rcases hte with heq | heq + · exact fraction_integer x.2 y.2 s hs (by linarith [h.2]) + · exact fraction_integer x.2 (y.2 + 1) s hs (by push_cast; linarith [h.2]) + · have hse := fraction_integer x.2 y.2 s hs h.2 + refine ⟨hse, ?_⟩ + rcases hse with heq | heq + · exact fraction_integer y.1 x.1 t ht (by linarith [h.1]) + · exact fraction_integer y.1 (x.1 + 1) t ht (by push_cast; linarith [h.1]) + · have hse := fraction_integer x.1 y.1 s hs h.1 + refine ⟨hse, ?_⟩ + rcases hse with heq | heq + · exact fraction_integer y.2 x.2 t ht (by linarith [h.2]) + · exact fraction_integer y.2 (x.2 + 1) t ht (by push_cast; linarith [h.2]) + · have hx : x.1 ≠ y.1 := by + intro hx + have hx' : (x.1 : Real) = (y.1 : Real) := by exact_mod_cast hx + have hst : s = t := by linarith [h.1] + have hy : x.2 = y.2 := by + exact_mod_cast (show (x.2 : Real) = (y.2 : Real) by linarith [h.2]) + have heq := Prod.ext hx hy + exact hne (by rw [heq]) + exact fraction_gap x.1 y.1 s t hs ht h.1 hx + +private theorem canonical_intersection : + let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) + (Function.Injective coord) → ( + let delta : Fin 3 → (Int × Int) := ![(1, 0), (0, 1), (1, 1)] + (∀ (x : (Int × Int)), ∀ (y : (Int × Int)), ∀ (k : Fin 3), ∀ (l : Fin 3), ∀ (s : Real), ∀ (t : + Real), (s ∈ Set.Icc (0 : Real) 1) → ((t ∈ Set.Icc (0 : Real) 1) → ((coord x + s • (coord + (x + delta k) - coord x) = coord y + t • (coord (y + delta l) - coord y)) → ((({x, + x + delta k} : Set (Int × Int)) ≠ {y, y + delta l}) → ((s = 0 ∨ s = 1) ∧ (t = 0 ∨ t = + 1)))))) → (∀ (x : (Int × Int)), ∀ (y : (Int × Int)), ∀ (k : Fin 3), ∀ (l : Fin 3), (({x, + x + delta k} : Set (Int × Int)) ≠ {y, y + delta l}) → (segment Real (coord x) (coord (x + + delta k)) ∩ segment Real (coord y) (coord (y + delta l)) = coord '' (({x, x + delta k} : + Set (Int × Int)) ∩ {y, y + delta l})))) := by + classical + intro coord coord_injective delta endpoint_parameters x y k l hne + ext p + constructor + · rintro ⟨hp, hq⟩ + rw [segment_eq_image' Real] at hp hq + obtain ⟨s, hs, hsp⟩ := hp + obtain ⟨t, ht, htp⟩ := hq + obtain ⟨hse, hte⟩ := endpoint_parameters x y k l s t hs ht (hsp.trans htp.symm) hne + have endpoints (a b : (Int × Int)) (u : Real) + (he : u = 0 ∨ u = 1) (heq : coord a + u • (coord b - coord a) = p) : + p ∈ coord '' ({a, b} : Set (Int × Int)) := by + rcases he with rfl | rfl + · refine ⟨a, by simp, ?_⟩ + simpa using heq + · refine ⟨b, by simp, ?_⟩ + simpa using heq + obtain ⟨a, ha, hap⟩ := endpoints x (x + delta k) s hse hsp + obtain ⟨b, hb, hbp⟩ := endpoints y (y + delta l) t hte htp + have hab : a = b := coord_injective (hap.trans hbp.symm) + exact ⟨a, ⟨ha, hab.symm ▸ hb⟩, hap⟩ + · rintro ⟨a, ⟨ha, hb⟩, rfl⟩ + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at ha hb + constructor + · rcases ha with rfl | rfl + · exact left_mem_segment Real _ _ + · exact right_mem_segment Real _ _ + · rcases hb with rfl | rfl + · exact left_mem_segment Real _ _ + · exact right_mem_segment Real _ _ + +private theorem orient_edge : + let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) + let delta : Fin 3 → (Int × Int) := ![(1, 0), (0, 1), (1, 1)] + ∀ (a : (Int × Int)), ∀ (b : (Int × Int)), (TriangularLatticeAdjacent a b) → (∃ (k : Fin 3) (x + : (Int × Int)), ({a, b} : Set (Int × Int)) = {x, x + delta k} ∧ + segment Real (coord a) (coord b) = segment Real (coord x) (coord (x + delta k))) := by + classical + intro coord delta a b hab + rcases hab with h | h | h | h | h | h + · have heq : b = a + delta 0 := by simp [delta, Prod.ext_iff] at h ⊢; omega + subst b + exact ⟨0, a, rfl, rfl⟩ + · have heq : b = a + delta 1 := by simp [delta, Prod.ext_iff] at h ⊢; omega + subst b + exact ⟨1, a, rfl, rfl⟩ + · have heq : a = b + delta 2 := by simp [delta, Prod.ext_iff] at h ⊢; omega + subst a + exact ⟨2, b, Set.pair_comm _ _, segment_symm Real _ _⟩ + · have heq : a = b + delta 0 := by simp [delta, Prod.ext_iff] at h ⊢; omega + subst a + exact ⟨0, b, Set.pair_comm _ _, segment_symm Real _ _⟩ + · have heq : a = b + delta 1 := by simp [delta, Prod.ext_iff] at h ⊢; omega + subst a + exact ⟨1, b, Set.pair_comm _ _, segment_symm Real _ _⟩ + · have heq : b = a + delta 2 := by simp [delta, Prod.ext_iff] at h ⊢; omega + subst b + exact ⟨2, a, rfl, rfl⟩ + +private theorem segment_intersections : + let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) + let delta : Fin 3 → (Int × Int) := ![(1, 0), (0, 1), (1, 1)] + (∀ (x : (Int × Int)), ∀ (y : (Int × Int)), ∀ (k : Fin 3), ∀ (l : Fin 3), (({x, x + delta k} : + Set (Int × Int)) ≠ {y, y + delta l}) → (segment Real (coord x) (coord (x + delta k)) ∩ + segment Real (coord y) (coord (y + delta l)) = coord '' (({x, x + delta k} : Set (Int × + Int)) ∩ {y, y + delta l}))) → ((∀ (a : (Int × Int)), ∀ (b : (Int × Int)), + (TriangularLatticeAdjacent a b) → (∃ (k : Fin 3) (x : (Int × Int)), ({a, b} : Set (Int × + Int)) = {x, x + delta k} ∧ segment Real (coord a) (coord b) = segment Real (coord x) + (coord (x + delta k)))) → (∀ (a : (Int × Int)), ∀ (b : (Int × Int)), ∀ (c : (Int × Int)), + ∀ (d : (Int × Int)), (TriangularLatticeAdjacent a b) → ((TriangularLatticeAdjacent c d) → + ((({a, b} : Set (Int × Int)) ≠ {c, d}) → (segment Real (coord a) (coord b) ∩ segment Real + (coord c) (coord d) = + coord '' (({a, b} : Set (Int × Int)) ∩ {c, d})))))) := by + classical + intro coord delta canonical_intersection orient_edge a b c d hab hcd hne + obtain ⟨k, x, hp, he⟩ := orient_edge a b hab + obtain ⟨l, y, hq, hf⟩ := orient_edge c d hcd + rw [hp, hq] at hne + rw [he, hf, hp, hq] + exact canonical_intersection x y k l hne + +private theorem arc_symmetric : + let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) + let shear : (Real × Real) ≃ₜ (Real × Real) := { + toFun p := (p.1 - p.2 / 2, p.2) + invFun p := (p.1 + p.2 / 2, p.2) + left_inv p := by ext <;> simp + right_inv p := by ext <;> simp + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + let arc (a b : (Int × Int)) : Set (Real × Real) := shear '' segment Real (coord a) (coord b) + ∀ (a : Int × Int), ∀ (b : Int × Int), arc a b = arc b a := by + classical + intro coord shear arc a b + dsimp [arc] + rw [segment_symm] + +private theorem arc_intersections : + let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) + let shear : (Real × Real) ≃ₜ (Real × Real) := { + toFun p := (p.1 - p.2 / 2, p.2) + invFun p := (p.1 + p.2 / 2, p.2) + left_inv p := by ext <;> simp + right_inv p := by ext <;> simp + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + let arc (a b : (Int × Int)) : Set (Real × Real) := shear '' segment Real (coord a) (coord b) + (∀ (a : (Int × Int)), ∀ (b : (Int × Int)), ∀ (c : (Int × Int)), ∀ (d : (Int × Int)), + (TriangularLatticeAdjacent a b) → ((TriangularLatticeAdjacent c d) → ((({a, b} : Set (Int + × Int)) ≠ {c, d}) → (segment Real (coord a) (coord b) ∩ segment Real (coord c) (coord d) + = coord '' (({a, b} : Set (Int × Int)) ∩ {c, d}))))) → (∀ (a : Int × Int), ∀ (b : Int × + Int), ∀ (c : Int × Int), ∀ (d : Int × Int), (TriangularLatticeAdjacent a b) → + ((TriangularLatticeAdjacent c d) → ((({a, b} : Set (Int × Int)) ≠ {c, d}) → (arc a b ∩ + arc c d = + (fun x => shear (coord x)) '' (({a, b} : Set (Int × Int)) ∩ {c, d}))))) := by + classical + intro coord shear arc segment_intersections a b c d hab hcd hne + dsimp only [arc] + rw [← Set.image_inter shear.injective, segment_intersections a b c d hab hcd hne, + Set.image_image] + +end AffineTriangulationLemmas + +theorem AffineTriangularPlaneTriangulation : + ∃ (P : PlaneTriangulation (Int × Int)) + (up down : (Int × Int) → P.Face), + (∀ x y, P.adjacent x y ↔ + TriangularLatticeAdjacent x y) ∧ + Function.Injective up ∧ Function.Injective down ∧ + (∀ x y, up x ≠ down y) ∧ + (∀ f, (∃ x, f = up x) ∨ ∃ x, f = down x) ∧ + (∀ x, + P.faceVertex (up x) 0 = x ∧ + P.faceVertex (up x) 1 = x + ((1, 0) : Int × Int) ∧ + P.faceVertex (up x) 2 = x - ((0, 1) : Int × Int)) ∧ + (∀ x, + P.faceVertex (down x) 0 = x ∧ + P.faceVertex (down x) 1 = x - ((1, 0) : Int × Int) ∧ + P.faceVertex (down x) 2 = x + ((0, 1) : Int × Int)) ∧ + (∀ x, P.position x = + (((x.1 : Real) - (x.2 : Real) / 2), (x.2 : Real))) ∧ + (∀ x y, P.edgeArc x y = segment Real (P.position x) (P.position y)) ∧ + (∀ x, P.faceRegion (up x) = + (fun p : Real × Real => + (((x.1 : Real) + p.1) - ((x.2 : Real) - p.2) / 2, + (x.2 : Real) - p.2)) '' + {p : Real × Real | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1}) ∧ + (∀ x, P.faceRegion (down x) = + (fun p : Real × Real => + (((x.1 : Real) - p.1) - ((x.2 : Real) + p.2) / 2, + (x.2 : Real) + p.2)) '' + {p : Real × Real | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1}) := by +-- BODY + classical + -- The tags distinguish the two translation orbits of faces. + let fv : (Sum (Int × Int) (Int × Int)) → Fin 3 → (Int × Int) := fun + | Sum.inl x => ![x, x + (1, 0), x - (0, 1)] + | Sum.inr x => ![x, x - (1, 0), x + (0, 1)] + have symm_adj (a b : (Int × Int)) := AffineTriangulationLemmas.symm_adj a b + have irrefl_adj (a : (Int × Int)) := AffineTriangulationLemmas.irrefl_adj a + have finite_adj (a : (Int × Int)) := AffineTriangulationLemmas.finite_adj a + have distinct_fv (f : (Sum (Int × Int) (Int × Int))) := AffineTriangulationLemmas.distinct_fv f + have edges_fv (f : (Sum (Int × Int) (Int × Int))) (i j : Fin 3) (h : i ≠ j) := + AffineTriangulationLemmas.edges_fv f i j h + have two_faces (a b : (Int × Int)) (hab : TriangularLatticeAdjacent a b) := + AffineTriangulationLemmas.two_faces a b hab + have int_walk {R : (Int × Int) → (Int × Int) → Prop} + (hs : ∀ a b, R a b → R b a) + (f : Int → (Int × Int)) (step : ∀ k, R (f k) (f (k + 1))) (m n : Int) := + AffineTriangulationLemmas.int_walk (R := R) hs f + step m n + -- Route surviving vertices through clean columns and a clean row. + have deletion_walk (D : Finset (Int × Int)) (hD : D.card < 3) + (a b : (Int × Int)) (ha : a ∉ D) (hb : b ∉ D) := AffineTriangulationLemmas.deletion_walk + symm_adj int_walk D hD a b ha hb + -- Construct the geometry before applying the invertible shear. + let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) + let shear : (Real × Real) ≃ₜ (Real × Real) := { + toFun p := (p.1 - p.2 / 2, p.2) + invFun p := (p.1 + p.2 / 2, p.2) + left_inv p := by ext <;> simp + right_inv p := by ext <;> simp + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + have coord_injective := AffineTriangulationLemmas.coord_injective + let arc (a b : (Int × Int)) : Set (Real × Real) := shear '' segment Real (coord a) (coord b) + have segment_homeo (a b : (Real × Real)) (hne : a ≠ b) := + AffineTriangulationLemmas.segment_homeo a b hne + have arc_homeo (a b : (Int × Int)) (hne : a ≠ b) := AffineTriangulationLemmas.arc_homeo + coord_injective segment_homeo a b hne + let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} + let C : Set (Real × Real) := {p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 ≤ 1} + have open_T := AffineTriangulationLemmas.open_T + have closed_C := AffineTriangulationLemmas.closed_C + have convex_T := AffineTriangulationLemmas.convex_T + have connected_T := AffineTriangulationLemmas.connected_T convex_T + have closure_T := AffineTriangulationLemmas.closure_T closed_C + have boundary_T := AffineTriangulationLemmas.boundary_T open_T + closure_T + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun + | Sum.inl x => { + toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) + invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + | Sum.inr x => { + toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) + invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + let region (f : (Sum (Int × Int) (Int × Int))) : Set (Real × Real) := shear '' tile f '' T + have tile_segment (f : (Sum (Int × Int) (Int × Int))) (a b : (Real × Real)) := + AffineTriangulationLemmas.tile_segment f a b + have tile_vertices (f : (Sum (Int × Int) (Int × Int))) := + AffineTriangulationLemmas.tile_vertices f + have boundary_region (f : (Sum (Int × Int) (Int × Int))) := + AffineTriangulationLemmas.boundary_region boundary_T tile_segment tile_vertices f + have open_region (f : (Sum (Int × Int) (Int × Int))) := AffineTriangulationLemmas.open_region + open_T f + have connected_region (f : (Sum (Int × Int) (Int × Int))) := + AffineTriangulationLemmas.connected_region connected_T f + have closed_cover (p : (Real × Real)) := AffineTriangulationLemmas.closed_cover p + have strip_unique (m n : Int) (r : Real) + (hm : (m : Real) < r ∧ r < (m : Real) + 1) + (hn : (n : Real) < r ∧ r < (n : Real) + 1) := AffineTriangulationLemmas.strip_unique m n r + hm hn + have tiles_disjoint := AffineTriangulationLemmas.tiles_disjoint strip_unique + have regions_disjoint := AffineTriangulationLemmas.regions_disjoint tiles_disjoint + have plane_cover := AffineTriangulationLemmas.plane_cover edges_fv + closure_T boundary_region closed_cover + -- Normalize undirected edges to horizontal, vertical, or diagonal unit steps. + let delta : Fin 3 → (Int × Int) := ![(1, 0), (0, 1), (1, 1)] + have fraction_integer (m n : Int) (s : Real) (hs : s ∈ Set.Icc (0 : Real) 1) + (h : (m : Real) + s = (n : Real)) := AffineTriangulationLemmas.fraction_integer m n s hs h + have fraction_gap (m n : Int) (s t : Real) + (hs : s ∈ Set.Icc (0 : Real) 1) (ht : t ∈ Set.Icc (0 : Real) 1) + (h : (m : Real) + s = (n : Real) + t) (hne : m ≠ n) := + AffineTriangulationLemmas.fraction_gap m n s t hs ht h + hne + have endpoint_parameters (x y : (Int × Int)) (k l : Fin 3) (s t : Real) + (hs : s ∈ Set.Icc (0 : Real) 1) (ht : t ∈ Set.Icc (0 : Real) 1) + (h : coord x + s • (coord (x + delta k) - coord x) = + coord y + t • (coord (y + delta l) - coord y)) + (hne : ({x, x + delta k} : Set (Int × Int)) ≠ {y, y + delta l}) := + AffineTriangulationLemmas.endpoint_parameters + fraction_integer fraction_gap x y k l s t hs ht h hne + have canonical_intersection (x y : (Int × Int)) (k l : Fin 3) + (hne : ({x, x + delta k} : Set (Int × Int)) ≠ {y, y + delta l}) := + AffineTriangulationLemmas.canonical_intersection coord_injective endpoint_parameters + x y k l hne + have orient_edge (a b : (Int × Int)) (hab : TriangularLatticeAdjacent a b) := + AffineTriangulationLemmas.orient_edge a b hab + have segment_intersections (a b c d : (Int × Int)) + (hab : TriangularLatticeAdjacent a b) (hcd : TriangularLatticeAdjacent c d) + (hne : ({a, b} : Set (Int × Int)) ≠ {c, d}) := + AffineTriangulationLemmas.segment_intersections canonical_intersection orient_edge a + b c d hab hcd hne + have arc_symmetric (a b : Int × Int) := AffineTriangulationLemmas.arc_symmetric a b + have arc_intersections (a b c d : Int × Int) + (hab : TriangularLatticeAdjacent a b) (hcd : TriangularLatticeAdjacent c d) + (hne : ({a, b} : Set (Int × Int)) ≠ {c, d}) := AffineTriangulationLemmas.arc_intersections + segment_intersections a b c d hab hcd hne + let P : PlaneTriangulation (Int × Int) := { + adjacent := TriangularLatticeAdjacent + Face := Sum (Int × Int) (Int × Int) + faceVertex := fv + position := fun x => shear (coord x) + edgeArc := arc + faceRegion := region + adjacent_symmetric := symm_adj + adjacent_irreflexive := irrefl_adj + locally_finite := finite_adj + three_connected := fun D hD a ha b hb => deletion_walk D hD a b ha hb + face_vertices_distinct := distinct_fv + face_edges := edges_fv + every_edge_two_faces := two_faces + position_injective := shear.injective.comp coord_injective + arc_symmetric := arc_symmetric + arc_homeomorph := by + intro a b hab + apply arc_homeo a b + intro heq + subst b + exact irrefl_adj a hab + arc_intersections := arc_intersections + region_open := open_region + region_connected := connected_region + region_disjoint := regions_disjoint + face_boundary := boundary_region + plane_cover := plane_cover } + refine ⟨P, Sum.inl, Sum.inr, ?_⟩ + refine ⟨(fun _ _ => Iff.rfl), (fun _ _ h => Sum.inl.inj h), + (fun _ _ h => Sum.inr.inj h), (fun _ _ => Sum.inl_ne_inr), ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro f + cases f with + | inl x => exact Or.inl ⟨x, rfl⟩ + | inr x => exact Or.inr ⟨x, rfl⟩ + · intro x + exact ⟨rfl, rfl, rfl⟩ + · intro x + exact ⟨rfl, rfl, rfl⟩ + · intro x + rfl + · intro x y + change shear '' segment Real (coord x) (coord y) = + segment Real (shear (coord x)) (shear (coord y)) + rw [segment_eq_image' Real, segment_eq_image' Real, Set.image_image] + congr 1 + funext t + ext <;> simp [shear, Prod.smul_fst, Prod.smul_snd, smul_eq_mul]; ring + · intro x + change shear '' tile (Sum.inl x) '' T = _ + rw [Set.image_image] + rfl + · intro x + change shear '' tile (Sum.inr x) '' T = _ + rw [Set.image_image] + rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularStrip.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularStrip.lean new file mode 100644 index 0000000000..1b889faf2b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularStrip.lean @@ -0,0 +1,675 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TriangularStripSegment +public import Mathlib.Data.List.Chain +public import Mathlib.Data.List.Nodup +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: AffineTriangularStrip] + +/-! +# AffineTriangularStrip + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TriangularStripProof + +private theorem rotHeight : + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1 - z.2, z.1) + invFun := fun z => (z.2, z.2 - z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + ∀ (x : (Int × Int)), ∀ (y : (Int × Int)), ∀ (z : (Int × Int)), TriangularSignedHeight (R x) + (R y) (R z) = TriangularSignedHeight x y z := by + classical + intro R x y z + simp only [TriangularSignedHeight, R, Equiv.coe_fn_mk] + ring + +private theorem rotMax : + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1 - z.2, z.1) + invFun := fun z => (z.2, z.2 - z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + ∀ (x : (Int × Int)), ∀ (y : (Int × Int)), TriangularMaxIncrement (R x) (R y) = + TriangularMaxIncrement x y := by + classical + intro R x y + have h₁ : y.1 - y.2 - (x.1 - x.2) = (y.1 - x.1) - (y.2 - x.2) := by ring + have h₂ : (y.1 - x.1) - (y.2 - x.2) - (y.1 - x.1) = -(y.2 - x.2) := by ring + simp only [TriangularMaxIncrement, R, Equiv.coe_fn_mk, h₁, h₂, abs_neg] + simp only [max_comm, max_left_comm] + +private theorem rotAdj : + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1 - z.2, z.1) + invFun := fun z => (z.2, z.2 - z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + ∀ (x : (Int × Int)), ∀ (y : (Int × Int)), TriangularLatticeAdjacent (R x) (R y) ↔ + TriangularLatticeAdjacent x y := by + classical + intro R x y + simp only [TriangularLatticeAdjacent, R, Equiv.coe_fn_mk, Prod.sub_def, Prod.mk.injEq] + omega + +private theorem normOrder : + ∀ (A : Int), ∀ (B : Int), (0 < A) → ((0 ≤ B) → ((B ≤ A) → (∃ e : Int ≃ + {z : (Int × Int) // 0 ≤ A * z.2 - B * z.1 ∧ A * z.2 - B * z.1 < A}, + ∀ m n : Int, + TriangularLatticeAdjacent (e m).1 (e n).1 ↔ n = m + 1 ∨ m = n + 1))) := by + classical + intro A B hA hB hBA + let c : Int → Int := fun r => (B * r + A - 1) / A + have hc (r : Int) : 0 ≤ A * c r - B * r ∧ A * c r - B * r < A := by + have h := Int.emod_nonneg (B * r + A - 1) (ne_of_gt hA) + have h' := Int.emod_lt_of_pos (B * r + A - 1) hA + have h'' := Int.emod_add_mul_ediv (B * r + A - 1) A + dsimp [c] + omega + have hu (r s : Int) (hs : 0 ≤ A * s - B * r ∧ A * s - B * r < A) : s = c r := by + have h := hc r + have : -1 < s - c r ∧ s - c r < 1 := by + constructor <;> nlinarith + omega + let e : Int ≃ {z : (Int × Int) // 0 ≤ A * z.2 - B * z.1 ∧ A * z.2 - B * z.1 < A} := + { toFun := fun r => ⟨(r, c r), hc r⟩ + invFun := fun z => z.1.1 + left_inv := fun _ => rfl + right_inv := fun z => by + apply Subtype.ext + apply Prod.ext + · rfl + · exact (hu _ _ z.2).symm } + refine ⟨e, ?_⟩ + intro m n + change TriangularLatticeAdjacent (m, c m) (n, c n) ↔ _ + have hm := hc m + have hn := hc n + have next (r : Int) : c (r + 1) = c r ∨ c (r + 1) = c r + 1 := by + have hr := hc r + have hr' := hc (r + 1) + have : -1 < c (r + 1) - c r ∧ c (r + 1) - c r < 2 := by + constructor <;> nlinarith + omega + simp only [TriangularLatticeAdjacent, Prod.sub_def, Prod.mk.injEq] + constructor + · intro h + rcases h with h | h | h | h | h | h <;> rcases h with ⟨h₁, h₂⟩ + all_goals + first + | omega + | have he : n = m := by omega + exfalso + simp [he] at h₂ + · rintro (rfl | h) + · rcases next m with h | h <;> omega + · subst m + rcases next n with h' | h' <;> omega + +private theorem monotoneChain : + ∀ (l : List Int), (l.Nodup) → ((l.IsChain (fun a b => b = a + 1 ∨ a = b + 1)) → (l.IsChain + (fun a b => b = a + 1) ∨ l.IsChain (fun a b => a = b + 1))) := by + classical + intro l hn hc + induction l with + | nil => simp + | cons a l ih => + cases l with + | nil => simp + | cons b l => + have hn' := (List.nodup_cons.mp hn).2 + have hc' := (List.isChain_cons_cons.mp hc).2 + have hab := (List.isChain_cons_cons.mp hc).1 + cases l with + | nil => simpa using hab + | cons c l => + have hac : a ≠ c := by + intro h + exact (List.nodup_cons.mp hn).1 (by simp [h]) + rcases ih hn' hc' with hf | hb + · have hbc := (List.isChain_cons_cons.mp hf).1 + left + exact List.isChain_cons_cons.mpr ⟨by omega, hf⟩ + · have hbc := (List.isChain_cons_cons.mp hb).1 + right + exact List.isChain_cons_cons.mpr ⟨by omega, hb⟩ + +private theorem forwardLast : + ∀ (a : Int), ∀ (l : List Int), ((a :: l).IsChain (fun a b => b = a + 1)) → ((a :: l).getLast? + = some (a + l.length)) := by + classical + intro a l hc + induction l generalizing a with + | nil => simp + | cons b l ih => + obtain ⟨rfl, hc⟩ := List.isChain_cons_cons.mp hc + rw [List.getLast?_cons_cons, ih _ hc] + congr 1 + simp only [List.length_cons, Nat.cast_add, Nat.cast_one] + ring + +private theorem backwardLast : + ∀ (a : Int), ∀ (l : List Int), ((a :: l).IsChain (fun a b => a = b + 1)) → ((a :: l).getLast? + = some (a - l.length)) := by + classical + intro a l hc + induction l generalizing a with + | nil => simp + | cons b l ih => + obtain ⟨hab, hc⟩ := List.isChain_cons_cons.mp hc + have he : b = a - 1 := by omega + subst b + simpa [List.getLast?_cons_cons, Nat.cast_add, sub_sub, add_comm] using ih (a - 1) hc + +private theorem forwardUnique : + ∀ (a : Int), ∀ (l : List Int), ∀ (k : List Int), ((a :: l).IsChain (fun a b => b = a + 1)) → + (((a :: k).IsChain (fun a b => b = a + 1)) → ((l.length = k.length) → (l = k))) := by + classical + intro a l k hl hk hlen + induction l generalizing a k with + | nil => simpa using hlen.symm + | cons b l ih => + cases k with + | nil => simp at hlen + | cons c k => + obtain ⟨rfl, hl⟩ := List.isChain_cons_cons.mp hl + obtain ⟨rfl, hk⟩ := List.isChain_cons_cons.mp hk + congr 1 + exact ih _ _ hl hk (by simpa using hlen) + +private theorem backwardUnique : + ∀ (a : Int), ∀ (l : List Int), ∀ (k : List Int), ((a :: l).IsChain (fun a b => a = b + 1)) → + (((a :: k).IsChain (fun a b => a = b + 1)) → ((l.length = k.length) → (l = k))) := by + classical + intro a l k hl hk hlen + induction l generalizing a k with + | nil => simpa using hlen.symm + | cons b l ih => + cases k with + | nil => simp at hlen + | cons c k => + obtain ⟨hab, hl⟩ := List.isChain_cons_cons.mp hl + obtain ⟨hac, hk⟩ := List.isChain_cons_cons.mp hk + have : c = b := by omega + subst c + congr 1 + exact ih _ _ hl hk (by simpa using hlen) + +private theorem intUnique : + (∀ (l : List Int), (l.Nodup) → ((l.IsChain (fun a b => b = a + 1 ∨ a = b + 1)) → (l.IsChain + (fun a b => b = a + 1) ∨ l.IsChain (fun a b => a = b + 1)))) → ((∀ (a : Int), ∀ (l : List + Int), ((a :: l).IsChain (fun a b => b = a + 1)) → ((a :: l).getLast? = some (a + + l.length))) → ((∀ (a : Int), ∀ (l : List Int), ((a :: l).IsChain (fun a b => a = b + 1)) + → ((a :: l).getLast? = some (a - l.length))) → ((∀ (a : Int), ∀ (l : List Int), ∀ (k : + List Int), ((a :: l).IsChain (fun a b => b = a + 1)) → (((a :: k).IsChain (fun a b => b = + a + 1)) → ((l.length = k.length) → (l = k)))) → ((∀ (a : Int), ∀ (l : List Int), ∀ (k : + List Int), ((a :: l).IsChain (fun a b => a = b + 1)) → (((a :: k).IsChain (fun a b => a = + b + 1)) → ((l.length = k.length) → (l = k)))) → (∀ (a : Int), ∀ (b : Int), ∀ (l : List + Int), ∀ (k : List Int), (l.head? = some a ∧ l.getLast? = some b ∧ l.Nodup ∧ + l.IsChain (fun a b => b = a + 1 ∨ a = b + 1)) → ((k.head? = some a ∧ k.getLast? = some b + ∧ k.Nodup ∧ + k.IsChain (fun a b => b = a + 1 ∨ a = b + 1)) → (l = k))))))) := by + classical + intro monotoneChain forwardLast backwardLast forwardUnique backwardUnique a b l k hl hk + cases l with + | nil => simp at hl + | cons a' l => + cases k with + | nil => simp at hk + | cons a'' k => + have ha : a' = a := by simpa using hl.1 + have ha' : a'' = a := by simpa using hk.1 + subst a' + subst a'' + rcases monotoneChain _ hl.2.2.1 hl.2.2.2 with hf | hb <;> + rcases monotoneChain _ hk.2.2.1 hk.2.2.2 with kf | kb + · have hlast := forwardLast _ _ hf + have klast := forwardLast _ _ kf + have hlen : l.length = k.length := by + rw [hl.2.1] at hlast + rw [hk.2.1] at klast + simp only [Option.some.injEq] at hlast klast + omega + exact congrArg (List.cons a) (forwardUnique _ _ _ hf kf hlen) + · have hlast := forwardLast _ _ hf + have klast := backwardLast _ _ kb + rw [hl.2.1] at hlast + rw [hk.2.1] at klast + simp only [Option.some.injEq] at hlast klast + have hl0 : l = [] := List.length_eq_zero_iff.mp (by omega) + have hk0 : k = [] := List.length_eq_zero_iff.mp (by omega) + simp [hl0, hk0] + · have hlast := backwardLast _ _ hb + have klast := forwardLast _ _ kf + rw [hl.2.1] at hlast + rw [hk.2.1] at klast + simp only [Option.some.injEq] at hlast klast + have hl0 : l = [] := List.length_eq_zero_iff.mp (by omega) + have hk0 : k = [] := List.length_eq_zero_iff.mp (by omega) + simp [hl0, hk0] + · have hlast := backwardLast _ _ hb + have klast := backwardLast _ _ kb + have hlen : l.length = k.length := by + rw [hl.2.1] at hlast + rw [hk.2.1] at klast + simp only [Option.some.injEq] at hlast klast + omega + exact congrArg (List.cons a) (backwardUnique _ _ _ hb kb hlen) + +private theorem intExists : + ∀ (a : Int), ∀ (b : Int), ∃ l : List Int, + l.head? = some a ∧ l.getLast? = some b ∧ l.Nodup ∧ + l.IsChain (fun a b => b = a + 1 ∨ a = b + 1) := by + classical + intro a b + have forward (a : Int) (d : Nat) : ∃ l : List Int, + l.head? = some a ∧ l.getLast? = some (a + d) ∧ l.Nodup ∧ + l.IsChain (fun a b => b = a + 1) := by + induction d generalizing a with + | zero => exact ⟨[a], by simp⟩ + | succ d ih => + obtain ⟨l, hh, ht, hn, hc⟩ := ih (a + 1) + have lower : ∀ z ∈ l, a + 1 ≤ z := by + cases l with + | nil => simp at hh + | cons a' l => + have : a' = a + 1 := by simpa using hh + subst a' + exact hc.induction (fun z => a + 1 ≤ z) _ + (by intro x y hxy h; omega) (by simp) + refine ⟨a :: l, by simp, ?_, ?_, ?_⟩ + · have hne : l ≠ [] := by intro he; simp [he] at hh + rw [List.getLast?_cons_of_ne_nil hne, ht] + congr 1 + simp only [Nat.cast_succ] + ring + · exact List.nodup_cons.mpr ⟨by intro h; have := lower a h; omega, hn⟩ + · exact hc.cons (by intro y hy; simpa [hh, eq_comm] using hy) + by_cases hab : a ≤ b + · have hd : a + ((b - a).toNat : Int) = b := by omega + obtain ⟨l, hh, ht, hn, hc⟩ := forward a (b - a).toNat + exact ⟨l, hh, hd ▸ ht, hn, hc.imp (by intro a b h; exact Or.inl h)⟩ + · have hd : b + ((a - b).toNat : Int) = a := by omega + obtain ⟨l, hh, ht, hn, hc⟩ := forward b (a - b).toNat + refine ⟨l.reverse, ?_, ?_, List.nodup_reverse.mpr hn, ?_⟩ + · rw [List.head?_reverse, ht, hd] + · simpa using hh + · apply List.isChain_reverse.mpr + exact hc.imp (by intro a b h; exact Or.inr h) + +private theorem normalizeStrip : + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1 - z.2, z.1) + invFun := fun z => (z.2, z.2 - z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + (∀ (x : (Int × Int)), ∀ (y : (Int × Int)), ∀ (z : (Int × Int)), TriangularSignedHeight (R x) + (R y) (R z) = TriangularSignedHeight x y z) → ((∀ (x : (Int × Int)), ∀ (y : (Int × Int)), + TriangularMaxIncrement (R x) (R y) = TriangularMaxIncrement x y) → ((∀ (x : (Int × Int)), + ∀ (y : (Int × Int)), TriangularLatticeAdjacent (R x) (R y) ↔ TriangularLatticeAdjacent x + y) → (∀ (x : (Int × Int)), ∀ (y : (Int × Int)), (x ≠ y) → (∃ e : (Int × Int) ≃ (Int × + Int), e x = (0, 0) ∧ 0 < (e y).1 ∧ 0 ≤ (e y).2 ∧ (e y).2 ≤ (e y).1 ∧ + (∀ z, TriangularSignedHeight (e x) (e y) (e z) = TriangularSignedHeight x y z) ∧ + TriangularMaxIncrement (e x) (e y) = TriangularMaxIncrement x y ∧ + (∀ z u, TriangularLatticeAdjacent (e z) (e u) ↔ TriangularLatticeAdjacent z u))))) := by + classical + intro R rotHeight rotMax rotAdj x y hxy + let T : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => z - x + invFun := fun z => z + x + left_inv := fun z => by simp + right_inv := fun z => by simp } + have htH (z : (Int × Int)) : TriangularSignedHeight (T x) (T y) (T z) = + TriangularSignedHeight x y z := by + simp [T, TriangularSignedHeight, Prod.sub_def] + have htM : TriangularMaxIncrement (T x) (T y) = TriangularMaxIncrement x y := by + simp [T, TriangularMaxIncrement, Prod.sub_def] + have htAdj (z u : (Int × Int)) : TriangularLatticeAdjacent (T z) (T u) ↔ + TriangularLatticeAdjacent z u := by + simp only [TriangularLatticeAdjacent, T, Equiv.coe_fn_mk] + rw [sub_sub_sub_cancel_right] + let E : Nat → (Int × Int) ≃ (Int × Int) := fun n => T.trans (R ^ n) + have heH (n : Nat) (z : (Int × Int)) : TriangularSignedHeight (E n x) (E n y) (E n z) = + TriangularSignedHeight x y z := by + induction n with + | zero => simpa [E] using htH z + | succ n ih => + simpa [E, pow_succ', Equiv.Perm.mul_apply] using + (rotHeight (E n x) (E n y) (E n z)).trans ih + have heM (n : Nat) : TriangularMaxIncrement (E n x) (E n y) = + TriangularMaxIncrement x y := by + induction n with + | zero => simpa [E] using htM + | succ n ih => + simpa [E, pow_succ', Equiv.Perm.mul_apply] using + (rotMax (E n x) (E n y)).trans ih + have heAdj (n : Nat) (z u : (Int × Int)) : TriangularLatticeAdjacent (E n z) (E n u) ↔ + TriangularLatticeAdjacent z u := by + induction n with + | zero => simpa [E] using htAdj z u + | succ n ih => + simpa [E, pow_succ', Equiv.Perm.mul_apply] using + (rotAdj (E n z) (E n u)).trans ih + have he0 (n : Nat) : E n x = (0, 0) := by + induction n with + | zero => ext <;> simp [E, T, Prod.sub_def] + | succ n ih => simpa [E, pow_succ', Equiv.Perm.mul_apply, R] using congrArg R ih + have hnonzero : y.1 - x.1 ≠ 0 ∨ y.2 - x.2 ≠ 0 := by + by_contra h + simp only [not_or, not_not] at h + apply hxy + ext <;> omega + have hex : ∃ n : Nat, 0 < (E n y).1 ∧ 0 ≤ (E n y).2 ∧ (E n y).2 ≤ (E n y).1 := by + by_cases ha : 0 ≤ y.1 - x.1 + · by_cases hb : 0 ≤ y.2 - x.2 + · by_cases hba : y.2 - x.2 ≤ y.1 - x.1 + · refine ⟨0, ?_⟩ + simp [E, T] + omega + · refine ⟨5, ?_⟩ + norm_num [E, T, R, pow_succ, Equiv.Perm.mul_apply] + omega + · refine ⟨1, ?_⟩ + norm_num [E, T, R, pow_succ, Equiv.Perm.mul_apply] + omega + · by_cases hb : 0 ≤ y.2 - x.2 + · refine ⟨4, ?_⟩ + norm_num [E, T, R, pow_succ, Equiv.Perm.mul_apply] + omega + · by_cases hba : y.2 - x.2 ≤ y.1 - x.1 + · refine ⟨2, ?_⟩ + norm_num [E, T, R, pow_succ, Equiv.Perm.mul_apply] + omega + · refine ⟨3, ?_⟩ + norm_num [E, T, R, pow_succ, Equiv.Perm.mul_apply] + omega + obtain ⟨n, hn⟩ := hex + exact ⟨E n, he0 n, hn.1, hn.2.1, hn.2.2, heH n, heM n, heAdj n⟩ + +private theorem stripOrder : + (∀ (A : Int), ∀ (B : Int), (0 < A) → ((0 ≤ B) → ((B ≤ A) → (∃ e : Int ≃ + {z : (Int × Int) // 0 ≤ A * z.2 - B * z.1 ∧ A * z.2 - B * z.1 < A}, ∀ m n : Int, + TriangularLatticeAdjacent (e m).1 (e n).1 ↔ n = m + 1 ∨ m = n + 1)))) → ((∀ (x : (Int × + Int)), ∀ (y : (Int × Int)), (x ≠ y) → (∃ e : (Int × Int) ≃ (Int × Int), e x = (0, 0) ∧ 0 + < (e y).1 ∧ 0 ≤ (e y).2 ∧ (e y).2 ≤ (e y).1 ∧ (∀ z, TriangularSignedHeight (e x) (e y) (e + z) = TriangularSignedHeight x y z) ∧ TriangularMaxIncrement (e x) (e y) = + TriangularMaxIncrement x y ∧ (∀ z u, TriangularLatticeAdjacent (e z) (e u) ↔ + TriangularLatticeAdjacent z u))) → (∀ (x : (Int × Int)), ∀ (y : (Int × Int)), (x ≠ y) → + (0 < TriangularMaxIncrement x y ∧ + ∃ order : Int ≃ {z : (Int × Int) // TriangularBoundaryStrip x y z}, + ∀ m n : Int, + TriangularLatticeAdjacent (order m).1 (order n).1 ↔ n = m + 1 ∨ m = n + 1))) := by + classical + intro normOrder normalizeStrip x y hxy + obtain ⟨e, he0, hA, hB, hBA, heH, heM, heAdj⟩ := normalizeStrip x y hxy + let A := (e y).1 + let B := (e y).2 + have hmax : TriangularMaxIncrement (e x) (e y) = A := by + rw [he0] + dsimp [TriangularMaxIncrement, A, B] + rw [sub_zero, sub_zero, abs_of_nonneg hA.le, abs_of_nonneg hB, + abs_of_nonneg (sub_nonneg.mpr hBA)] + omega + have hM : TriangularMaxIncrement x y = A := heM.symm.trans hmax + have hstrip (z : (Int × Int)) : TriangularBoundaryStrip x y z ↔ + 0 ≤ A * (e z).2 - B * (e z).1 ∧ A * (e z).2 - B * (e z).1 < A := by + unfold TriangularBoundaryStrip + rw [← heH z, he0, hM] + simp [TriangularSignedHeight, A, B] + obtain ⟨f, hf⟩ := normOrder A B hA hB hBA + let t : {z : (Int × Int) // TriangularBoundaryStrip x y z} ≃ + {z : (Int × Int) // 0 ≤ A * z.2 - B * z.1 ∧ A * z.2 - B * z.1 < A} := + { toFun := fun z => ⟨e z.1, (hstrip z.1).mp z.2⟩ + invFun := fun z => ⟨e.symm z.1, (hstrip (e.symm z.1)).mpr (by simpa using z.2)⟩ + left_inv := fun z => by apply Subtype.ext; simp + right_inv := fun z => by apply Subtype.ext; simp } + refine ⟨by simpa [hM] using hA, f.trans t.symm, ?_⟩ + intro m n + change TriangularLatticeAdjacent (e.symm (f m).1) (e.symm (f n).1) ↔ _ + rw [← heAdj] + simpa using hf m n + +private theorem crossing : + ∀ (x : (Int × Int)), ∀ (y : (Int × Int)), ∀ (z : (Int × Int)), (0 ≤ TriangularSignedHeight x + y z ∧ + ∃ u : (Int × Int), TriangularLatticeAdjacent z u ∧ TriangularSignedHeight x y u < 0) ↔ + TriangularBoundaryStrip x y z := by + classical + intro x y z + let a := y.1 - x.1 + let b := y.2 - x.2 + have hbound : ∀ u, TriangularLatticeAdjacent z u → + TriangularSignedHeight x y z - TriangularSignedHeight x y u ≤ TriangularMaxIncrement x y := by + intro u hu + simp only [TriangularLatticeAdjacent, Prod.sub_def, Prod.mk.injEq] at hu + have ha : |a| ≤ TriangularMaxIncrement x y := le_max_left _ _ + have hb : |b| ≤ TriangularMaxIncrement x y := (le_max_left _ _).trans (le_max_right _ _) + have hab : |a - b| ≤ TriangularMaxIncrement x y := (le_max_right _ _).trans (le_max_right _ _) + have ha' := le_abs_self a + have ha'' := neg_le_abs a + have hb' := le_abs_self b + have hb'' := neg_le_abs b + have hab' := le_abs_self (a - b) + have hab'' := neg_le_abs (a - b) + dsimp [a, b] at * + rcases hu with hu | hu | hu | hu | hu | hu <;> + rcases hu with ⟨hu₁, hu₂⟩ <;> dsimp [TriangularSignedHeight] <;> nlinarith + have hstep : ∃ d : (Int × Int), + TriangularLatticeAdjacent (0, 0) d ∧ + a * d.2 - b * d.1 = -TriangularMaxIncrement x y := by + have ha : |a| = a ∨ |a| = -a := abs_choice a + have hb : |b| = b ∨ |b| = -b := abs_choice b + have hab : |a - b| = a - b ∨ |a - b| = -(a - b) := abs_choice (a - b) + change ∃ d : (Int × Int), TriangularLatticeAdjacent (0, 0) d ∧ + a * d.2 - b * d.1 = -max |a| (max |b| |a - b|) + by_cases h₁ : max |b| |a - b| ≤ |a| + · rw [max_eq_left h₁] + rcases ha with ha | ha + · refine ⟨(0, -1), ?_, ?_⟩ <;> simp [TriangularLatticeAdjacent, Prod.sub_def, ha] + · refine ⟨(0, 1), ?_, ?_⟩ <;> simp [TriangularLatticeAdjacent, Prod.sub_def, ha] + · rw [max_eq_right (le_of_not_ge h₁)] + by_cases h₂ : |a - b| ≤ |b| + · rw [max_eq_left h₂] + rcases hb with hb | hb + · refine ⟨(1, 0), ?_, ?_⟩ <;> simp [TriangularLatticeAdjacent, Prod.sub_def, hb] + · refine ⟨(-1, 0), ?_, ?_⟩ <;> simp [TriangularLatticeAdjacent, Prod.sub_def, hb] + · rw [max_eq_right (le_of_not_ge h₂)] + rcases hab with hab | hab + · refine ⟨(-1, -1), ?_, ?_⟩ <;> simp [TriangularLatticeAdjacent, Prod.sub_def, hab]; ring + · refine ⟨(1, 1), ?_, ?_⟩ <;> simp [TriangularLatticeAdjacent, Prod.sub_def, hab] + constructor + · rintro ⟨hz, u, hu, hn⟩ + exact ⟨hz, by have := hbound u hu; omega⟩ + · rintro ⟨hz, hm⟩ + obtain ⟨d, hd, hh⟩ := hstep + refine ⟨hz, z + d, ?_, ?_⟩ + · simpa [TriangularLatticeAdjacent, Prod.sub_def, Prod.add_def] using hd + · have he : TriangularSignedHeight x y (z + d) = + TriangularSignedHeight x y z + (a * d.2 - b * d.1) := by + simp only [TriangularSignedHeight, Prod.add_def] + dsimp [a, b] + ring + rw [he, hh] + omega + +private theorem stripSegment : + (∀ (a : Int), ∀ (b : Int), ∀ (l : List Int), ∀ (k : List Int), (l.head? = some a ∧ l.getLast? + = some b ∧ l.Nodup ∧ l.IsChain (fun a b => b = a + 1 ∨ a = b + 1)) → ((k.head? = some a ∧ + k.getLast? = some b ∧ k.Nodup ∧ k.IsChain (fun a b => b = a + 1 ∨ a = b + 1)) → (l = k))) + → ((∀ (a : Int), ∀ (b : Int), ∃ l : List Int, l.head? = some a ∧ l.getLast? = some b ∧ + l.Nodup ∧ l.IsChain (fun a b => b = a + 1 ∨ a = b + 1)) → ((∀ (x : (Int × Int)), ∀ (y : + (Int × Int)), (x ≠ y) → (0 < TriangularMaxIncrement x y ∧ ∃ order : Int ≃ + {z : (Int × Int) // TriangularBoundaryStrip x y z}, ∀ m n : Int, + TriangularLatticeAdjacent (order m).1 (order n).1 ↔ n = m + 1 ∨ m = n + 1)) → (∀ (x : + (Int × Int)), ∀ (y : (Int × Int)), ∃! path : List (Int × Int), TriangularStripSegment x y + path))) := by + classical + intro intUnique intExists stripOrder x y + classical + by_cases hxy : x = y + · exact ⟨[x], by simp [TriangularStripSegment, hxy], + by intro path h; simpa [TriangularStripSegment, hxy] using h⟩ + obtain ⟨hM, order, hadj⟩ := stripOrder x y hxy + let f : Int → (Int × Int) := fun n => (order n).1 + let g : (Int × Int) → Int := fun z => if hz : TriangularBoundaryStrip x y z then order.symm ⟨z, + hz⟩ else 0 + have hx : TriangularBoundaryStrip x y x := by + simpa [TriangularBoundaryStrip, TriangularSignedHeight] using hM + have hy : TriangularBoundaryStrip x y y := by + simpa [TriangularBoundaryStrip, TriangularSignedHeight, mul_comm] using hM + have hfg (z : (Int × Int)) (hz : TriangularBoundaryStrip x y z) : f (g z) = z := by + simp [f, g, hz] + have hgf (n : Int) : g (f n) = n := by + have hn : TriangularBoundaryStrip x y (f n) := (order n).2 + simp [g, hn, f] + have hfi : Function.Injective f := fun m n h => by + have := congrArg g h + simpa only [hgf] using this + have hfstrip (n : Int) : TriangularBoundaryStrip x y (f n) := (order n).2 + have hrecover (path : List (Int × Int)) (hs : ∀ z ∈ path, TriangularBoundaryStrip x y z) : + (path.map g).map f = path := by + rw [List.map_map] + calc + path.map (f ∘ g) = path.map id := List.map_congr_left (fun z hz => hfg z (hs z hz)) + _ = path := List.map_id path + have hcoords (path : List (Int × Int)) (hp : TriangularStripSegment x y path) : + (path.map g).head? = some (g x) ∧ (path.map g).getLast? = some (g y) ∧ + (path.map g).Nodup ∧ + (path.map g).IsChain (fun a b => b = a + 1 ∨ a = b + 1) := by + simp only [TriangularStripSegment, ite_eq_right hxy] at hp + refine ⟨by simp [hp.1], by simp [hp.2.1], ?_, ?_⟩ + · have hn : ((path.map g).map f).Nodup := by rw [hrecover path hp.2.2.2.1]; exact hp.2.2.1 + exact (List.nodup_map_iff hfi).mp hn + · apply (List.isChain_map g).mpr + apply hp.2.2.2.2.imp_of_mem_imp + intro z u hz hu hzu + apply (hadj (g z) (g u)).mp + change TriangularLatticeAdjacent (f (g z)) (f (g u)) + rw [hfg z (hp.2.2.2.1 z hz), hfg u (hp.2.2.2.1 u hu)] + exact hzu + obtain ⟨l, hh, ht, hn, hc⟩ := intExists (g x) (g y) + refine ⟨l.map f, ?_, ?_⟩ + · simp only [TriangularStripSegment, ite_eq_right hxy] + refine ⟨?_, ?_, hn.map hfi, ?_, ?_⟩ + · simp [hh, hfg x hx] + · simp [ht, hfg y hy] + · intro z hz + obtain ⟨n, _, rfl⟩ := List.mem_map.mp hz + exact hfstrip n + · exact (List.isChain_map f).mpr (hc.imp fun m n h => (hadj m n).mpr h) + · intro path hp + have hco := hcoords path hp + have hl : (l.map f).map g = l := by simp [List.map_map, Function.comp_def, hgf] + have he : path.map g = l := intUnique _ _ _ _ hco ⟨hh, ht, hn, hc⟩ + have hp' := hp + simp only [TriangularStripSegment, ite_eq_right hxy] at hp' + rw [← hrecover path hp'.2.2.2.1, he] + +end TriangularStripProof + +theorem AffineTriangularStrip : + (∀ x y : Int × Int, + ∃! path : List (Int × Int), TriangularStripSegment x y path) ∧ + ∀ x y : Int × Int, x ≠ y → + 0 < TriangularMaxIncrement x y ∧ + (∀ z : Int × Int, + (0 ≤ TriangularSignedHeight x y z ∧ + ∃ u : Int × Int, + TriangularLatticeAdjacent z u ∧ + TriangularSignedHeight x y u < 0) ↔ + TriangularBoundaryStrip x y z) ∧ + ∃ order : Int ≃ {z : Int × Int // TriangularBoundaryStrip x y z}, + ∀ m n : Int, + TriangularLatticeAdjacent (order m).1 (order n).1 ↔ + n = m + 1 ∨ m = n + 1 := by +-- BODY + classical + let R : (Int × Int) ≃ (Int × Int) := + { toFun := fun z => (z.1 - z.2, z.1) + invFun := fun z => (z.2, z.2 - z.1) + left_inv := fun z => by ext <;> simp + right_inv := fun z => by ext <;> simp } + have rotHeight (x y z : (Int × Int)) : + TriangularSignedHeight (R x) (R y) (R z) = TriangularSignedHeight x y z := + TriangularStripProof.rotHeight x y z + have rotMax (x y : (Int × Int)) : + TriangularMaxIncrement (R x) (R y) = TriangularMaxIncrement x y := + TriangularStripProof.rotMax x y + have rotAdj (x y : (Int × Int)) : + TriangularLatticeAdjacent (R x) (R y) ↔ TriangularLatticeAdjacent x y := + TriangularStripProof.rotAdj x y + have normOrder (A B : Int) (hA : 0 < A) (hB : 0 ≤ B) (hBA : B ≤ A) : + ∃ e : Int ≃ {z : (Int × Int) // 0 ≤ A * z.2 - B * z.1 ∧ A * z.2 - B * z.1 < A}, + ∀ m n : Int, + TriangularLatticeAdjacent (e m).1 (e n).1 ↔ n = m + 1 ∨ m = n + 1 := + TriangularStripProof.normOrder A B hA hB hBA + have monotoneChain (l : List Int) (hn : l.Nodup) + (hc : l.IsChain (fun a b => b = a + 1 ∨ a = b + 1)) : + l.IsChain (fun a b => b = a + 1) ∨ l.IsChain (fun a b => a = b + 1) := + TriangularStripProof.monotoneChain l hn hc + have forwardLast (a : Int) (l : List Int) + (hc : (a :: l).IsChain (fun a b => b = a + 1)) : + (a :: l).getLast? = some (a + l.length) := TriangularStripProof.forwardLast a l hc + have backwardLast (a : Int) (l : List Int) + (hc : (a :: l).IsChain (fun a b => a = b + 1)) : + (a :: l).getLast? = some (a - l.length) := TriangularStripProof.backwardLast a l hc + have forwardUnique (a : Int) (l k : List Int) + (hl : (a :: l).IsChain (fun a b => b = a + 1)) + (hk : (a :: k).IsChain (fun a b => b = a + 1)) + (hlen : l.length = k.length) : l = k := TriangularStripProof.forwardUnique a l k hl hk hlen + have backwardUnique (a : Int) (l k : List Int) + (hl : (a :: l).IsChain (fun a b => a = b + 1)) + (hk : (a :: k).IsChain (fun a b => a = b + 1)) + (hlen : l.length = k.length) : l = k := TriangularStripProof.backwardUnique a l k hl hk hlen + have intUnique (a b : Int) (l k : List Int) + (hl : l.head? = some a ∧ l.getLast? = some b ∧ l.Nodup ∧ + l.IsChain (fun a b => b = a + 1 ∨ a = b + 1)) + (hk : k.head? = some a ∧ k.getLast? = some b ∧ k.Nodup ∧ + k.IsChain (fun a b => b = a + 1 ∨ a = b + 1)) : l = k := TriangularStripProof.intUnique + monotoneChain forwardLast backwardLast forwardUnique backwardUnique a b l k hl hk + have intExists (a b : Int) : ∃ l : List Int, + l.head? = some a ∧ l.getLast? = some b ∧ l.Nodup ∧ + l.IsChain (fun a b => b = a + 1 ∨ a = b + 1) := TriangularStripProof.intExists a b + have normalizeStrip (x y : (Int × Int)) (hxy : x ≠ y) : + ∃ e : (Int × Int) ≃ (Int × Int), e x = (0, 0) ∧ 0 < (e y).1 ∧ 0 ≤ (e y).2 ∧ (e y).2 ≤ (e + y).1 ∧ + (∀ z, TriangularSignedHeight (e x) (e y) (e z) = TriangularSignedHeight x y z) ∧ + TriangularMaxIncrement (e x) (e y) = TriangularMaxIncrement x y ∧ + (∀ z u, TriangularLatticeAdjacent (e z) (e u) ↔ TriangularLatticeAdjacent z u) := + TriangularStripProof.normalizeStrip rotHeight rotMax rotAdj x y hxy + have stripOrder (x y : (Int × Int)) (hxy : x ≠ y) : + 0 < TriangularMaxIncrement x y ∧ + ∃ order : Int ≃ {z : (Int × Int) // TriangularBoundaryStrip x y z}, + ∀ m n : Int, + TriangularLatticeAdjacent (order m).1 (order n).1 ↔ n = m + 1 ∨ m = n + 1 := + TriangularStripProof.stripOrder normOrder normalizeStrip x y hxy + have crossing (x y z : (Int × Int)) : + (0 ≤ TriangularSignedHeight x y z ∧ + ∃ u : (Int × Int), TriangularLatticeAdjacent z u ∧ TriangularSignedHeight x y u < 0) ↔ + TriangularBoundaryStrip x y z := TriangularStripProof.crossing x y z + have stripSegment (x y : (Int × Int)) : ∃! path : List (Int × Int), TriangularStripSegment x y + path := TriangularStripProof.stripSegment intUnique intExists stripOrder x y + refine ⟨stripSegment, ?_⟩ + intro x y hxy + obtain ⟨hM, horder⟩ := stripOrder x y hxy + exact ⟨hM, crossing x y, horder⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidence.lean b/LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidence.lean new file mode 100644 index 0000000000..64fa58e78a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidence.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex + +-- [TABLET NODE: AllowedSubtileIncidence] + +/-! +# AllowedSubtileIncidence + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Allowed incidence is the symmetric relation on periodic labeled-subtile +indices generated, for every common translate $(m,n)$, by the following +eighteen edge orbits from the manuscript's fixed $A$--$F$ ledger: +$$ +\begin{gathered} + A B,\ A B_{0,1},\ A B_{1,1},\ A C,\ A C_{1,1},\ A D,\ + A E_{0,1},\ A F,\\ + B C,\ B D_{-1,-1},\ B D,\ B E,\ B F_{0,-1},\\ + C D_{-1,0},\ C E_{-1,0},\ C F,\ D E,\ D F_{1,0}. +\end{gathered} +$$ +Here every displayed subscript is added to the common translate $(m,n)$. +This is a purely combinatorial relation defined from the paper's face/edge +ledger; in particular it is not defined by asking whether the interpreted +tiles happen to intersect. +-/ +inductive AllowedSubtileIncidence : + PeriodicSubtileIndex → PeriodicSubtileIndex → Prop where +-- BODY + | AB (m n : Int) : AllowedSubtileIncidence ⟨.A, m, n⟩ ⟨.B, m, n⟩ + | AB01 (m n : Int) : AllowedSubtileIncidence ⟨.A, m, n⟩ ⟨.B, m, n + 1⟩ + | AB11 (m n : Int) : AllowedSubtileIncidence ⟨.A, m, n⟩ ⟨.B, m + 1, n + 1⟩ + | AC (m n : Int) : AllowedSubtileIncidence ⟨.A, m, n⟩ ⟨.C, m, n⟩ + | AC11 (m n : Int) : AllowedSubtileIncidence ⟨.A, m, n⟩ ⟨.C, m + 1, n + 1⟩ + | AD (m n : Int) : AllowedSubtileIncidence ⟨.A, m, n⟩ ⟨.D, m, n⟩ + | AE01 (m n : Int) : AllowedSubtileIncidence ⟨.A, m, n⟩ ⟨.E, m, n + 1⟩ + | AF (m n : Int) : AllowedSubtileIncidence ⟨.A, m, n⟩ ⟨.F, m, n⟩ + | BC (m n : Int) : AllowedSubtileIncidence ⟨.B, m, n⟩ ⟨.C, m, n⟩ + | BDm1m1 (m n : Int) : AllowedSubtileIncidence ⟨.B, m, n⟩ ⟨.D, m - 1, n - 1⟩ + | BD (m n : Int) : AllowedSubtileIncidence ⟨.B, m, n⟩ ⟨.D, m, n⟩ + | BE (m n : Int) : AllowedSubtileIncidence ⟨.B, m, n⟩ ⟨.E, m, n⟩ + | BF0m1 (m n : Int) : AllowedSubtileIncidence ⟨.B, m, n⟩ ⟨.F, m, n - 1⟩ + | CDm10 (m n : Int) : AllowedSubtileIncidence ⟨.C, m, n⟩ ⟨.D, m - 1, n⟩ + | CEm10 (m n : Int) : AllowedSubtileIncidence ⟨.C, m, n⟩ ⟨.E, m - 1, n⟩ + | CF (m n : Int) : AllowedSubtileIncidence ⟨.C, m, n⟩ ⟨.F, m, n⟩ + | DE (m n : Int) : AllowedSubtileIncidence ⟨.D, m, n⟩ ⟨.E, m, n⟩ + | DF10 (m n : Int) : AllowedSubtileIncidence ⟨.D, m, n⟩ ⟨.F, m + 1, n⟩ + | symm {a b} : AllowedSubtileIncidence a b → AllowedSubtileIncidence b a + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidenceZeroOppositeChord.lean b/LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidenceZeroOppositeChord.lean new file mode 100644 index 0000000000..b97062c999 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidenceZeroOppositeChord.lean @@ -0,0 +1,180 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence + +-- [TABLET NODE: AllowedSubtileIncidenceZeroOppositeChord] + +/-! +# AllowedSubtileIncidenceZeroOppositeChord + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem AllowedSubtileIncidenceZeroOppositeChord + (a b c d : PeriodicSubtileIndex) + (ha : a.first = 0 ∧ a.second = 0) + (hc : c.first = 0 ∧ c.second = 0) + (hab : AllowedSubtileIncidence a b) + (hbc : AllowedSubtileIncidence b c) + (hcd : AllowedSubtileIncidence c d) + (hda : AllowedSubtileIncidence d a) + (hab_ne : a ≠ b) (hac_ne : a ≠ c) (had_ne : a ≠ d) + (hbc_ne : b ≠ c) (hbd_ne : b ≠ d) (hcd_ne : c ≠ d) : + AllowedSubtileIncidence a c ∨ AllowedSubtileIncidence b d := by +-- BODY + -- Normalize all symmetric reversals to the eighteen displacement families. + let ledger : SixSubtileLabel → SixSubtileLabel → Int → Int → Prop := + fun x y m n => match x, y with + | .A, .B => (m = 0 ∧ (n = 0 ∨ n = 1)) ∨ (m = 1 ∧ n = 1) + | .A, .C => (m = 0 ∧ n = 0) ∨ (m = 1 ∧ n = 1) + | .A, .D => m = 0 ∧ n = 0 + | .A, .E => m = 0 ∧ n = 1 + | .A, .F => m = 0 ∧ n = 0 + | .B, .C => m = 0 ∧ n = 0 + | .B, .D => (m = -1 ∧ n = -1) ∨ (m = 0 ∧ n = 0) + | .B, .E => m = 0 ∧ n = 0 + | .B, .F => m = 0 ∧ n = -1 + | .C, .D => m = -1 ∧ n = 0 + | .C, .E => m = -1 ∧ n = 0 + | .C, .F => m = 0 ∧ n = 0 + | .D, .E => m = 0 ∧ n = 0 + | .D, .F => m = 1 ∧ n = 0 + | _, _ => False + let adjacent := fun x y m n => ledger x y m n ∨ ledger y x (-m) (-n) + have reverse : ∀ x y m n, adjacent x y m n → adjacent y x (-m) (-n) := by + intro x y m n h + simpa only [adjacent, neg_neg, or_comm] using h + have normalize : ∀ {u v : PeriodicSubtileIndex}, AllowedSubtileIncidence u v → + adjacent u.label v.label (v.first - u.first) (v.second - u.second) := by + intro u v h + induction h with + | symm h ih => + simpa only [neg_sub] using reverse _ _ _ _ ih + | AB m n | AB01 m n | AB11 m n | AC m n | AC11 m n + | AD m n | AE01 m n | AF m n | BC m n | BDm1m1 m n + | BD m n | BE m n | BF0m1 m n | CDm10 m n | CEm10 m n + | CF m n | DE m n | DF10 m n => + dsimp [adjacent, ledger] + omega + -- The six nonadjacent zero-label pairs have precisely these neighbor bounds. + have rowAE : ∀ u : PeriodicSubtileIndex, + adjacent .A u.label u.first u.second → + adjacent .E u.label u.first u.second → + u = ⟨.B, 0, 0⟩ ∨ u = ⟨.D, 0, 0⟩ := by + rintro ⟨l, m, n⟩ hA hE + cases l <;> simp [adjacent, ledger] at hA hE ⊢ <;> omega + have rowBF : ∀ u : PeriodicSubtileIndex, + adjacent .B u.label u.first u.second → + adjacent .F u.label u.first u.second → + u = ⟨.A, 0, 0⟩ ∨ u = ⟨.C, 0, 0⟩ := by + rintro ⟨l, m, n⟩ hB hF + cases l <;> simp [adjacent, ledger] at hB hF ⊢ <;> omega + have rowCD : ∀ u : PeriodicSubtileIndex, + adjacent .C u.label u.first u.second → + adjacent .D u.label u.first u.second → + u = ⟨.A, 0, 0⟩ ∨ u = ⟨.B, 0, 0⟩ := by + rintro ⟨l, m, n⟩ hC hD + cases l <;> simp [adjacent, ledger] at hC hD ⊢ <;> omega + have rowCE : ∀ u : PeriodicSubtileIndex, + adjacent .C u.label u.first u.second → + adjacent .E u.label u.first u.second → + u = ⟨.B, 0, 0⟩ := by + rintro ⟨l, m, n⟩ hC hE + cases l <;> simp [adjacent, ledger] at hC hE ⊢ <;> omega + have rowDF : ∀ u : PeriodicSubtileIndex, + adjacent .D u.label u.first u.second → + adjacent .F u.label u.first u.second → + u = ⟨.A, 0, 0⟩ := by + rintro ⟨l, m, n⟩ hD hF + cases l <;> simp [adjacent, ledger] at hD hF ⊢ <;> omega + have rowEF : ∀ u : PeriodicSubtileIndex, + adjacent .E u.label u.first u.second → + adjacent .F u.label u.first u.second → False := by + rintro ⟨l, m, n⟩ hE hF + cases l <;> simp [adjacent, ledger] at hE hF <;> omega + have two {x y : PeriodicSubtileIndex} (hxy : AllowedSubtileIncidence x y) + (hb : b = x ∨ b = y) (hd : d = x ∨ d = y) : + AllowedSubtileIncidence b d := by + rcases hb with rfl | rfl + · rcases hd with rfl | rfl + · exact (hbd_ne rfl).elim + · exact hxy + · rcases hd with rfl | rfl + · exact AllowedSubtileIncidence.symm hxy + · exact (hbd_ne rfl).elim + -- Both opposite indices must be at zero before applying the neighbor rows. + rcases a with ⟨al, am, an⟩ + rcases c with ⟨cl, cm, cn⟩ + rcases ha with ⟨ham, han⟩ + rcases hc with ⟨hcm, hcn⟩ + dsimp at ham han hcm hcn + subst am + subst an + subst cm + subst cn + have hbA := normalize hab + have hbC := normalize (AllowedSubtileIncidence.symm hbc) + have hdA := normalize (AllowedSubtileIncidence.symm hda) + have hdC := normalize hcd + change adjacent al b.label (b.first - 0) (b.second - 0) at hbA + change adjacent cl b.label (b.first - 0) (b.second - 0) at hbC + change adjacent al d.label (d.first - 0) (d.second - 0) at hdA + change adjacent cl d.label (d.first - 0) (d.second - 0) at hdC + simp only [Int.sub_zero] at hbA hbC hdA hdC + cases al <;> cases cl + · exact (hac_ne rfl).elim + · exact Or.inl (AllowedSubtileIncidence.AB 0 0) + · exact Or.inl (AllowedSubtileIncidence.AC 0 0) + · exact Or.inl (AllowedSubtileIncidence.AD 0 0) + · exact Or.inr (two (AllowedSubtileIncidence.BD 0 0) + (rowAE b hbA hbC) (rowAE d hdA hdC)) + · exact Or.inl (AllowedSubtileIncidence.AF 0 0) + · exact Or.inl (AllowedSubtileIncidence.symm (AllowedSubtileIncidence.AB 0 0)) + · exact (hac_ne rfl).elim + · exact Or.inl (AllowedSubtileIncidence.BC 0 0) + · exact Or.inl (AllowedSubtileIncidence.BD 0 0) + · exact Or.inl (AllowedSubtileIncidence.BE 0 0) + · exact Or.inr (two (AllowedSubtileIncidence.AC 0 0) + (rowBF b hbA hbC) (rowBF d hdA hdC)) + · exact Or.inl (AllowedSubtileIncidence.symm (AllowedSubtileIncidence.AC 0 0)) + · exact Or.inl (AllowedSubtileIncidence.symm (AllowedSubtileIncidence.BC 0 0)) + · exact (hac_ne rfl).elim + · exact Or.inr (two (AllowedSubtileIncidence.AB 0 0) + (rowCD b hbA hbC) (rowCD d hdA hdC)) + · exact (hbd_ne ((rowCE b hbA hbC).trans (rowCE d hdA hdC).symm)).elim + · exact Or.inl (AllowedSubtileIncidence.CF 0 0) + · exact Or.inl (AllowedSubtileIncidence.symm (AllowedSubtileIncidence.AD 0 0)) + · exact Or.inl (AllowedSubtileIncidence.symm (AllowedSubtileIncidence.BD 0 0)) + · exact Or.inr (two (AllowedSubtileIncidence.AB 0 0) + (rowCD b hbC hbA) (rowCD d hdC hdA)) + · exact (hac_ne rfl).elim + · exact Or.inl (AllowedSubtileIncidence.DE 0 0) + · exact (hbd_ne ((rowDF b hbA hbC).trans (rowDF d hdA hdC).symm)).elim + · exact Or.inr (two (AllowedSubtileIncidence.BD 0 0) + (rowAE b hbC hbA) (rowAE d hdC hdA)) + · exact Or.inl (AllowedSubtileIncidence.symm (AllowedSubtileIncidence.BE 0 0)) + · exact (hbd_ne ((rowCE b hbC hbA).trans (rowCE d hdC hdA).symm)).elim + · exact Or.inl (AllowedSubtileIncidence.symm (AllowedSubtileIncidence.DE 0 0)) + · exact (hac_ne rfl).elim + · exact (rowEF b hbA hbC).elim + · exact Or.inl (AllowedSubtileIncidence.symm (AllowedSubtileIncidence.AF 0 0)) + · exact Or.inr (two (AllowedSubtileIncidence.AC 0 0) + (rowBF b hbC hbA) (rowBF d hdC hdA)) + · exact Or.inl (AllowedSubtileIncidence.symm (AllowedSubtileIncidence.CF 0 0)) + · exact (hbd_ne ((rowDF b hbC hbA).trans (rowDF d hdC hdA).symm)).elim + · exact (rowEF b hbC hbA).elim + · exact (hac_ne rfl).elim + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometer.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometer.lean new file mode 100644 index 0000000000..fbb0acbb84 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometer.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorTile +public import LeanPool.ApollonianSuperharmonic.TileOdometer + +-- [TABLET NODE: AncestorOdometer] + +/-! +# AncestorOdometer + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $h'$ be a tile odometer on $T'$. If $T$ is an +`AncestorTile` of $T'$, the ancestor restriction of $h'$ to $T$ +is the partial odometer $h$ whose domain is exactly $\operatorname{foot}(T)$, whose +domain is contained in that of $h'$, and whose values there equal those of +$h'$. The predicate *ancestor odometer* records these data, but does +not assume that $h$ is already a tile odometer; that is the content of the +ancestor-restriction lemma. The reflexive ancestor gives the restriction +to the whole tile. +-/ +def AncestorOdometer (C C' : CircleCoordinates) (T T' : ProtoTile) + (h h' : PartialOdometer) : Prop := +-- BODY + TileOdometer C' T' h' ∧ AncestorTile C C' T T' ∧ + (h.domain : Set GaussianInt) = FootprintVertices T ∧ + h.domain ⊆ h'.domain ∧ + ∀ x, x ∈ h.domain → h.value x = h'.value x + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerCentralCovariance.lean new file mode 100644 index 0000000000..25883f73a5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerCentralCovariance.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.AncestorTileCentralCovariance +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry + +-- [TABLET NODE: AncestorOdometerCentralCovariance] + +/-! +# AncestorOdometerCentralCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem AncestorOdometerCentralCovariance + (C C' : CircleCoordinates) (T T' : ProtoTile) + (h h' : PartialOdometer) (u a : GaussianInt) (b : Int) + (hancestor : AncestorOdometer C C' T T' h h') : + AncestorOdometer C C' + (TileTranslation (TileHalfTurn T) u) + (TileTranslation (TileHalfTurn T') u) + (PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) u a b) + (PartialOdometerAffineTranslate (PartialOdometerHalfTurn h') u a b) := by +-- BODY + rcases hancestor with ⟨hO, hAT, hfoot, hsub, hval⟩ + have hsym := TileOdometerCentralSymmetry C' T' h' hO + have hout := TileOdometerAffineTranslation C' (TileHalfTurn T') + (PartialOdometerHalfTurn h') u a b hsym.1 + have hat := AncestorTileCentralCovariance C C' T T' u hAT + have hhalf : (PartialOdometerHalfTurn h).domain = + FootprintVertices (TileHalfTurn T) := by + ext x + change x ∈ (PartialOdometerHalfTurn h).domain ↔ + x ∈ FootprintVertices (TileHalfTurn T) + rw [(PartialOdometerHalfTurnFormulas h).1] + rw [(TileHalfTurnFormulas T).2.2.2.2.2.2.1] + simp only [Set.mem_image] + constructor + · intro hx + exact ⟨-x, hfoot ▸ hx, by simp⟩ + · rintro ⟨y, hy, rfl⟩ + have hz : y ∈ (h.domain : Set GaussianInt) := hfoot.symm ▸ hy + simpa using hz + have hfoot' : + (PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) u a b).domain = + FootprintVertices (TileTranslation (TileHalfTurn T) u) := by + exact ((PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn h) u a b).2.2.2.2.1 (TileHalfTurn T) hhalf) + refine ⟨hout, hat, hfoot', ?_, ?_⟩ + · intro x hx + have hx' := ((PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn h) u a b).2.1 x).mp hx + have hy : - (x - u) ∈ h.domain := + (PartialOdometerHalfTurnFormulas h).1 (x - u) |>.mp hx' + have hy' := hsub hy + apply ((PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn h') u a b).2.1 x).mpr + apply (PartialOdometerHalfTurnFormulas h').1 (x - u) |>.mpr + exact hy' + · intro x hx + have hx' := ((PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn h) u a b).2.1 x).mp hx + have hy : - (x - u) ∈ h.domain := + (PartialOdometerHalfTurnFormulas h).1 (x - u) |>.mp hx' + have hy' := hval (-(x - u)) hy + rw [(PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn h) u a b).2.2.1 x hx] + rw [(PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn h') u a b).2.2.1 x + (((PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn h') u a b).2.1 x).mpr + ((PartialOdometerHalfTurnFormulas h').1 (x - u) |>.mpr + (hsub hy)))] + rw [(PartialOdometerHalfTurnFormulas h).2.1 (x - u) hx', + (PartialOdometerHalfTurnFormulas h').2.1 (x - u) + ((PartialOdometerHalfTurnFormulas h').1 (x - u) |>.mpr (hsub hy))] + simpa using hy' + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerInnerSupportNormalization.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerInnerSupportNormalization.lean new file mode 100644 index 0000000000..1e62e2f4a8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerInnerSupportNormalization.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileCentroid + +-- [TABLET NODE: AncestorOdometerInnerSupportNormalization] + +/-! +# AncestorOdometerInnerSupportNormalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem AncestorOdometerInnerSupportNormalization + (C C' : CircleCoordinates) (V U T : ProtoTile) + (h g : PartialOdometer) + (hpositive : 0 < C.1) (hstrict : C.1 < C'.1) + (hancestor : AncestorOdometer C C' V T h g) + (hU : BandPrototile C U) (hcells : V.cells = U.cells) : + AncestorOdometer C C' U T h g := by +-- BODY + classical + rcases hancestor with ⟨hO, hAT, hfoot, hsub, hval⟩ + have positive_cells : ∀ (D : CircleCoordinates) (W : ProtoTile), + 0 < D.1 → BandPrototile D W → W.cells.Nonempty := by + intro D W hD hW + induction hW with + | line w x hw => simp at hD + | unit z x => simp + | @decompose q hq S W hS hcells hfoot hcentroid ih => + have facts := ProperBandCurvatureStructure q hq + have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by + by_cases h0 : 0 < (q (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (q (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + by_cases h2 : 0 < (q (2 : Fin 3).succ).1 + · exact ⟨2, h2⟩ + have n0 := facts.2.1 (0 : Fin 3) + have n1 := facts.2.1 (1 : Fin 3) + have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim + rcases hp with ⟨i, hi⟩ + rcases ih i false hi with ⟨x, hx⟩ + exact ⟨x, (hcells x).mpr ⟨i, false, hx⟩⟩ + have hUne : U.cells.Nonempty := positive_cells C U hpositive hU + have hVne : V.cells.Nonempty := by rw [hcells]; exact hUne + have hfoot_eq : FootprintVertices V = FootprintVertices U := by + simp only [FootprintVertices, ite_eq_left hVne, ite_eq_left hUne] + rw [hcells] + have hcent_eq : TileCentroid V = TileCentroid U := by + simp only [TileCentroid, ite_eq_left hVne, ite_eq_left hUne] + rw [hcells] + change Relation.ReflTransGen + (fun X Y : CircleCoordinates × ProtoTile => + ∃ q : Fin 4 → CircleCoordinates, ∃ i : Fin 3, ∃ s : Bool, + ProperBandQuadruple q ∧ q 0 = Y.1 ∧ q i.succ = X.1 ∧ + BandPrototile Y.1 Y.2 ∧ BandPrototile X.1 X.2 ∧ + FootprintVertices X.2 ⊆ FootprintVertices Y.2 ∧ + TileCentroid X.2 - TileCentroid Y.2 = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1)))) + (C, V) (C', T) at hAT + rcases Relation.ReflTransGen.cases_head hAT with same | ⟨M, first, rest⟩ + · have coordinates : C = C' := congrArg (fun z : CircleCoordinates × ProtoTile => z.1) same + exact ((lt_irrefl C'.1) (coordinates ▸ hstrict)).elim + · rcases first with ⟨q, i, s, hq, hq0, hqi, hY, hX, hinc, hcent⟩ + refine ⟨hO, ?_, ?_, hsub, hval⟩ + · exact rest.head ⟨q, i, s, hq, hq0, hqi, hY, hU, hfoot_eq ▸ hinc, + hcent_eq ▸ hcent⟩ + exact hfoot_eq ▸ hfoot + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerOuterSupportNormalization.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerOuterSupportNormalization.lean new file mode 100644 index 0000000000..05b64b281b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerOuterSupportNormalization.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileCentroid + +-- [TABLET NODE: AncestorOdometerOuterSupportNormalization] + +/-! +# AncestorOdometerOuterSupportNormalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem AncestorOdometerOuterSupportNormalization + (C C' : CircleCoordinates) (T V U : ProtoTile) + (h g : PartialOdometer) + (hpositive : 0 < C'.1) (hstrict : C.1 < C'.1) + (hancestor : AncestorOdometer C C' T V h g) + (hU : BandPrototile C' U) (hcells : V.cells = U.cells) : + AncestorOdometer C C' T U h g := by +-- BODY + classical + rcases hancestor with ⟨hodo, hAT, hdom, hsub, hval⟩ + have hnewodo := PositiveCurvatureTileOdometerSupportTransport C' V U g + hpositive hodo hU hcells + have positive_cells : ∀ (D : CircleCoordinates) (W : ProtoTile), + 0 < D.1 → BandPrototile D W → W.cells.Nonempty := by + intro D W hD hW + induction hW with + | line w x hw => simp at hD + | unit z x => simp + | @decompose q hq S W hS hcells' hfoot hcentroid ih => + have facts := ProperBandCurvatureStructure q hq + have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by + by_cases h0 : 0 < (q (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (q (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + by_cases h2 : 0 < (q (2 : Fin 3).succ).1 + · exact ⟨2, h2⟩ + have n0 := facts.2.1 (0 : Fin 3) + have n1 := facts.2.1 (1 : Fin 3) + have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim + rcases hp with ⟨i, hi⟩ + rcases ih i false hi with ⟨x, hx⟩ + exact ⟨x, (hcells' x).mpr ⟨i, false, hx⟩⟩ + have hVne : V.cells.Nonempty := by + have hu : U.cells.Nonempty := positive_cells C' U hpositive hU + rw [hcells] + exact hu + have hfoot_eq : FootprintVertices V = FootprintVertices U := by + simp only [FootprintVertices, ite_eq_left hVne, ite_eq_left (positive_cells C' U hpositive hU)] + rw [hcells] + have hcent_eq : TileCentroid V = TileCentroid U := by + simp only [TileCentroid, ite_eq_left hVne, ite_eq_left (positive_cells C' U hpositive hU)] + rw [hcells] + have hATU : AncestorTile C C' T U := by + unfold AncestorTile at hAT ⊢ + rcases Relation.ReflTransGen.cases_tail hAT with heq | ⟨D, hchain, hedge⟩ + · have hc : C' = C := congrArg (fun z : CircleCoordinates × ProtoTile => z.1) heq + have hc1 : C'.1 = C.1 := congrArg (fun z : CircleCoordinates => z.1) hc + exact (lt_irrefl _ (hc1 ▸ hstrict)).elim + · rcases hedge with ⟨q, i, s, hq, hq0, hqi, hDV, hD, hfoot, hcent⟩ + apply Relation.ReflTransGen.tail hchain + refine ⟨q, i, s, hq, hq0, hqi, hU, hD, ?_, ?_⟩ + · rw [← hfoot_eq] + exact hfoot + · rw [← hcent_eq] + exact hcent + exact ⟨hnewodo, hATU, hdom, hsub, hval⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean new file mode 100644 index 0000000000..5e35748230 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean @@ -0,0 +1,620 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.AncestorTile +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.PartialOdometer +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.TileOdometer + +-- [TABLET NODE: AncestorOdometerRestriction] + +/-! +# AncestorOdometerRestriction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace AncestorRestrictionProof + +private theorem domain_from_odo : + (by + classical + exact + ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), TileOdometer c U k → + (k.domain : Set GaussianInt) = FootprintVertices U ) := by + classical + intro c U k ho + induction ho with + | line w x hw k hdom => + simp [hdom, FootprintVertices] + | unit z x U k hU hdom htrans => + exact hdom + | @decompose q hq S U hs k hU hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + ext y + change (y ∈ k.domain) ↔ y ∈ FootprintVertices U + rw [hdom] + have child (i : Fin 3) (s : Bool) : + ((hs i s).domain : Set GaussianInt) = FootprintVertices (S i s) := + ih i s + change (∃ i s, y ∈ (hs i s).domain) ↔ y ∈ FootprintVertices U + constructor + · rintro ⟨i, s, hy⟩ + exact hfoot i s ((Set.ext_iff.mp (child i s) y).mp hy) + · intro hy + by_cases hu : U.cells.Nonempty + · simp only [FootprintVertices, ite_eq_left hu, Set.mem_ofPred_eq] at hy + rcases hy with ⟨x, hx, hv⟩ + rcases (hcells x).mp hx with ⟨i, s, hxs⟩ + have hs' : (S i s).cells.Nonempty := ⟨x, hxs⟩ + refine ⟨i, s, (Set.ext_iff.mp (child i s) y).mpr ?_⟩ + simp only [FootprintVertices, ite_eq_left hs', Set.mem_ofPred_eq] + exact ⟨x, hxs, hv⟩ + · have hs' : ∀ i s, ¬ (S i s).cells.Nonempty := by + intro i s hne + rcases hne with ⟨x, hx⟩ + exact hu ⟨x, (hcells x).mpr ⟨i, s, hx⟩⟩ + simp only [FootprintVertices, ite_eq_right hu, Set.mem_singleton_iff] at hy + have ha : (S 0 false).anchor = U.anchor := by + have hh := hfoot 0 false + rw [FootprintVertices, ite_eq_right (hs' 0 false), + FootprintVertices, ite_eq_right hu] at hh + simpa using hh (Set.mem_singleton _) + refine ⟨0, false, (Set.ext_iff.mp (child 0 false) y).mpr ?_⟩ + simp only [FootprintVertices, ite_eq_right (hs' 0 false), Set.mem_singleton_iff] + simpa [ha] using hy + +private theorem positive_cells : + (by + classical + exact + ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), 0 < c.1 → BandPrototile c U → + U.cells.Nonempty ) := by + classical + intro c U hc hu + induction hu with + | line w x hw => simp at hc + | unit z x => simp + | @decompose q hq S U hs hcells hfoot hcentroid ih => + have facts := ProperBandCurvatureStructure q hq + have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by + by_cases h0 : 0 < (q (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (q (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + by_cases h2 : 0 < (q (2 : Fin 3).succ).1 + · exact ⟨2, h2⟩ + have n0 := facts.2.1 (0 : Fin 3) + have n1 := facts.2.1 (1 : Fin 3) + have n2 := facts.2.1 (2 : Fin 3) + have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega + have bad := facts.2.2 0 1 z0 z1 + exact ((by decide : (0 : Fin 3) ≠ 1) bad).elim + rcases hp with ⟨i, hi⟩ + rcases ih i false hi with ⟨x, hx⟩ + exact ⟨x, (hcells x).mpr ⟨i, false, hx⟩⟩ + +private theorem odo_eq : + (by + classical + exact + ∀ a b : PartialOdometer, (a.domain : Set GaussianInt) = b.domain → (∀ x, x ∈ a.domain → + a.value x = b.value x) → a = b ) := by + classical + intro a b hab hv + cases a with + | mk ad av ao => + cases b with + | mk bd bv bo => + have hd : ad = bd := by + ext x + exact Set.ext_iff.mp hab x + subst bd + have he : av = bv := by + funext x + by_cases hx : x ∈ ad + · exact hv x hx + · rw [ao x hx, bo x hx] + subst bv + rfl + +private theorem band_from_odo : + (by + classical + exact + ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), TileOdometer c U k → + BandPrototile c U ) := by + classical + intro c U k ho + induction ho with + | line w x hw hdom => exact BandPrototile.line w x hw + | unit z x U k hU hdom htrans => + cases U with + | mk cells anchor => + dsimp at hU ⊢ + subst cells + exact BandPrototile.unit z x anchor + | decompose hq hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + exact BandPrototile.decompose hq (fun i s => ih i s) + hcells hfoot hcentroid + +private theorem band_one : + (by + classical + exact + ∀ c : CircleCoordinates, ∀ U : ProtoTile, BandPrototile c U → c.1 = 1 → ∃ x : GaussianInt, + U.cells = {x} ) := by + classical + intro c U hu + induction hu with + | line w x hw => + intro hc + norm_num at hc + | unit z x anchor => + intro hc + exact ⟨x, rfl⟩ + | @decompose q hq S U hS hcells hfoot hcent ih => + intro hc + have facts := ProperBandCurvatureStructure q hq + have hz : ∀ j : Fin 3, (q j.succ).1 = 0 := by + intro j + have hlt := hq.2 j + have hn := facts.2.1 j + omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 (hz 0) (hz 1))).elim + +private theorem parent_gt_one : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → (((0 : ℤ) < (q (0 : + Fin (4 + : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (j : + Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) → (1 < (q + 0).1)) ) := by + classical + intro q hq facts + have hp := facts.1 + by_contra hn + have hle : (q 0).1 ≤ 1 := by omega + have z0 : (q (0 : Fin 3).succ).1 = 0 := by + have hb := hq.2 0 + have hn0 := facts.2.1 (0 : Fin 3) + omega + have z1 : (q (1 : Fin 3).succ).1 = 0 := by + have hb := hq.2 1 + have hn1 := facts.2.1 (1 : Fin 3) + omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim + +private theorem hrestrict : + (by + classical + exact + ∀ (domain_from_odo : ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : + PartialOdometer), TileOdometer c U k → (k.domain : Set GaussianInt) = + FootprintVertices U), + let vertices : ProtoTile → Finset GaussianInt := fun U => + if U.cells.Nonempty then + U.cells.biUnion (fun x => {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) + else {U.anchor} + let restrict : ProtoTile → PartialOdometer → PartialOdometer := + fun U g => + { domain := vertices U + value := fun x => if x ∈ vertices U then g.value x else 0 + value_outside := by + intro x hx + simp [hx] } + (∀ U, ∀ g, ((restrict U g).domain : Set GaussianInt) = FootprintVertices U) → ((∀ a b : + PartialOdometer, (a.domain : Set GaussianInt) = b.domain → (∀ x, x ∈ a.domain → a.value x + = b.value x) → a = b) → ((∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : + PartialOdometer), TileOdometer c U k → BandPrototile c U) → (∀ (X : CircleCoordinates × + ProtoTile), ∀ (Y : CircleCoordinates × ProtoTile), ∀ (g : PartialOdometer), ((↑g.domain : + Set GaussianInt) = FootprintVertices Y.2) → ((TileOdometer Y.1 Y.2 g) → (∀ (q : Fin (4 : + ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (ProperBandQuadruple q) → ((q + (0 : Fin (4 : ℕ)) = Y.1) → ((q i.succ = X.1) → ((BandPrototile Y.1 Y.2) → ((BandPrototile + X.1 X.2) → ((FootprintVertices X.2 ⊆ FootprintVertices Y.2) → ((TileCentroid X.2 - + TileCentroid Y.2 = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : + ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((1 < (q 0).1) → (TileOdometer X.1 + X.2 (restrict X.2 g)))))))))))))) ) := by + classical + intro domain_from_odo vertices restrict restrict_domain odo_eq band_from_odo X Y g hgd hgo q i + s hq hq0 hqi hY hX hfoot hcent parent_gt_one + cases Y with + | mk yc yt => + cases hgo with + | line w x hw hdom => + have bad : (q 0).1 = 0 := by + have hh := congrArg (fun c : CircleCoordinates => c.1) hq0 + simpa using hh + omega + | unit z x U hU hdom htrans => + have bad : (q 0).1 = 1 := by + have hh := congrArg (fun c : CircleCoordinates => c.1) hq0 + simpa using hh + omega + | @decompose q' hq' S V hs hV hsub hcells hfoot' hcentroid hdom hvalue hcompat hslope => + have hrot := BandPredecessorNoCollision q q' hq hq' + (by simp [hq0]) + rcases hrot with ⟨r, hrotation, _⟩ + let a : Fin 3 := i - r + have har : a + r = i := by + fin_cases i <;> fin_cases r <;> simp [a] + have hqa : q' a.succ = X.1 := by + calc + q' a.succ = q ((a + r).succ) := hrotation a + _ = q i.succ := by rw [har] + _ = X.1 := hqi + have hv1 : q' ((a + 2).succ) = q ((i + 2).succ) := by + have hh := hrotation (a + 2) + convert hh using 1; fin_cases i <;> fin_cases r <;> simp [a] + have hv2 : q' ((a + 1).succ) = q ((i + 1).succ) := by + have hh := hrotation (a + 1) + convert hh using 1; fin_cases i <;> fin_cases r <;> simp [a] + have hcentS : TileCentroid (S a s) = TileCentroid X.2 := by + have hd : TileCentroid (S a s) - TileCentroid (q' 0, yt).2 = + TileCentroid X.2 - TileCentroid (q' 0, yt).2 := by + rw [hdom a s, hv1, hv2] + exact hcent.symm + exact sub_left_inj.mp hd.symm |>.symm + have hbandS : BandPrototile X.1 (S a s) := by + have hh := band_from_odo _ _ _ (hcells a s) + rw [hqa] at hh + exact hh + have huniq := BandPrototileCentroidUnique X.1 X.2 (S a s) + hX hbandS hcentS.symm + have hfp : FootprintVertices (S a s) = FootprintVertices X.2 := by + rcases huniq with ⟨heq, hempty⟩ + by_cases hn : (S a s).cells.Nonempty + · have hn' : X.2.cells.Nonempty := by simpa [heq] using hn + simp [FootprintVertices, hn, heq] + · have he : (S a s).cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hn + have he' : X.2.cells = ∅ := by simpa [heq] using he + have ha := hempty he' + simp [FootprintVertices, hn, he', ha] + have hkeq : restrict X.2 g = hs a s := by + apply odo_eq + focus rw [restrict_domain, domain_from_odo _ _ _ (hcells a s), hfp] + intro x hx + have hx' : x ∈ FootprintVertices (S a s) := + Set.ext_iff.mp hfp x |>.mpr + (Set.ext_iff.mp (restrict_domain X.2 g) x |>.mp hx) + have hxhs : x ∈ (hs a s).domain := + Set.ext_iff.mp (domain_from_odo _ _ _ (hcells a s)) x |>.mpr hx' + have hxg : x ∈ g.domain := + Set.ext_iff.mp hgd x |>.mpr + (hfoot (Set.ext_iff.mp (restrict_domain X.2 g) x |>.mp hx)) + simp [restrict, hx, hcompat a s x hxhs] + rw [hkeq] + have ho := hcells a s + have htarget : TileOdometer (q' a.succ) (S a s) (hs a s) := by + generalize hcoord : q' a.succ = coord at ho ⊢ + generalize htile : S a s = tile at ho ⊢ + cases ho with + | line w x hw => + exact TileOdometer.line w x hw (hs a s) (by assumption) + | unit z x => + exact TileOdometer.unit z x tile (hs a s) (by assumption) + (by assumption) (by assumption) + | decompose hqz hTz hsz hcz hfz hdz hvz hcoz hslz => + apply TileOdometer.decompose <;> assumption + have htarget' : TileOdometer X.1 (S a s) (hs a s) := by + simpa [hqa] using htarget + generalize hcoord : X.1 = coord at htarget' ⊢ + generalize htileX : X.2 = target at htarget' ⊢ + generalize htileS : S a s = source at htarget' ⊢ + cases htarget' with + | line w x hw => + have hc : target.cells = ∅ := by + have hcX : X.2.cells = ∅ := by rw [huniq.1, htileS] + exact (congrArg ProtoTile.cells htileX).symm ▸ hcX + have ha : target.anchor = x := by + have he := huniq.2 (by rw [huniq.1, htileS]) + have hx : X.2.anchor = x := by simpa [htileS] using he + exact (congrArg ProtoTile.anchor htileX).symm ▸ hx + have ht : target = ⟨∅, x⟩ := by + cases target + simp only [ProtoTile.mk.injEq] + exact ⟨hc, ha⟩ + rw [ht] + exact TileOdometer.line w x hw (hs a s) (by assumption) + | unit z x => + have hd := domain_from_odo _ _ _ ho + have hsource : source.cells = {x} := by assumption + have htargetcells : target.cells = {x} := by + have heX : X.2.cells = source.cells := + huniq.1.trans (congrArg ProtoTile.cells htileS) + have he : target.cells = source.cells := + (congrArg ProtoTile.cells htileX).symm ▸ heX + exact he.trans hsource + have hsource_ne : source.cells.Nonempty := by + rw [hsource] + simp + have htarget_ne : target.cells.Nonempty := by + rw [htargetcells] + simp + have hfootst : FootprintVertices source = + FootprintVertices target := by + simp only [FootprintVertices, ite_eq_left hsource_ne, + ite_eq_left htarget_ne] + rw [htargetcells, hsource] + exact TileOdometer.unit z x target (hs a s) htargetcells + (by + rw [htileS] at hd + exact hd.trans hfootst) + (by assumption) + | decompose hqz hTz hsz hcz hfz hdz hvz hcoz hslz hslopez => + have hX' := hX + rw [htileX, hcoord] at hX' + have hcst : target.cells = source.cells := by + exact (congrArg ProtoTile.cells htileX).symm ▸ + huniq.1.trans (congrArg ProtoTile.cells htileS) + have hpst : FootprintVertices source = FootprintVertices target := by + rw [← htileS, hfp, htileX] + have hcentst : TileCentroid source = TileCentroid target := by + rw [← htileS, hcentS, htileX] + refine TileOdometer.decompose hqz hX' hsz ?_ ?_ ?_ hvz hcoz hslz hslopez + · intro x + rw [hcst] + exact hcz x + · intro j t x hx + rw [← hpst] + exact hfz j t hx + · intro j t + simpa [hcentst] using hdz j t + +private theorem chain_foot : + (by + classical + exact + ∀ (p : CircleCoordinates × ProtoTile), ∀ (q : CircleCoordinates × ProtoTile), AncestorTile + p.1 q.1 p.2 q.2 → FootprintVertices p.2 ⊆ FootprintVertices q.2 ) := by + classical + intro p q hc + unfold AncestorTile at hc + refine Relation.ReflTransGen.head_induction_on + (motive := fun a _ => FootprintVertices a.2 ⊆ FootprintVertices q.2) hc ?_ ?_ + · intro x hx + exact hx + · intro a c hedge hrest ih + rcases hedge with ⟨q, i, s, hq, hq0, hqi, hY, hX, hfoot, hcent⟩ + exact Set.Subset.trans hfoot ih + +private theorem main : + (by + classical + exact + let vertices : ProtoTile → Finset GaussianInt := fun U => + if U.cells.Nonempty then + U.cells.biUnion (fun x => {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) + else {U.anchor} + let restrict : ProtoTile → PartialOdometer → PartialOdometer := + fun U g => + { domain := vertices U + value := fun x => if x ∈ vertices U then g.value x else 0 + value_outside := by + intro x hx + simp [hx] } + (∀ U, ∀ g, ((restrict U g).domain : Set GaussianInt) = FootprintVertices U) → ((∀ (X : + CircleCoordinates × ProtoTile), ∀ (Y : CircleCoordinates × ProtoTile), (∃ r : Fin 4 → + CircleCoordinates, ∃ i : Fin 3, ∃ s : Bool, ProperBandQuadruple r ∧ r 0 = Y.1 ∧ r i.succ + = X.1 ∧ BandPrototile Y.1 Y.2 ∧ BandPrototile X.1 X.2 ∧ FootprintVertices X.2 ⊆ + FootprintVertices Y.2 ∧ TileCentroid X.2 - TileCentroid Y.2 = (if s = true then (1 : + Real) else -1) • ((1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (r ((i + 2).succ)) + (r ((i + 1).succ))) - (-((GaussianRealPoint (BandVectors.1 (r ((i + 2).succ)) (r ((i + + 1).succ)))).2), (GaussianRealPoint (BandVectors.1 (r ((i + 2).succ)) (r ((i + + 1).succ)))).1)))) → ∀ g : PartialOdometer, (g.domain : Set GaussianInt) = + FootprintVertices Y.2 → TileOdometer Y.1 Y.2 g → TileOdometer X.1 X.2 (restrict X.2 g)) → + ((∀ (p : CircleCoordinates × ProtoTile), ∀ (q : CircleCoordinates × ProtoTile), + AncestorTile p.1 q.1 p.2 q.2 → FootprintVertices p.2 ⊆ FootprintVertices q.2) → (∀ (p + : CircleCoordinates × ProtoTile), ∀ (q : CircleCoordinates × ProtoTile), + Relation.ReflTransGen (fun X Y : CircleCoordinates × ProtoTile => ∃ r : Fin 4 → + CircleCoordinates, ∃ i : Fin 3, ∃ s : Bool, ProperBandQuadruple r ∧ r 0 = Y.1 ∧ r i.succ + = X.1 ∧ BandPrototile Y.1 Y.2 ∧ BandPrototile X.1 X.2 ∧ FootprintVertices X.2 ⊆ + FootprintVertices Y.2 ∧ TileCentroid X.2 - TileCentroid Y.2 = (if s = true then (1 : + Real) else -1) • ((1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (r ((i + 2).succ)) + (r ((i + 1).succ))) - (-((GaussianRealPoint (BandVectors.1 (r ((i + 2).succ)) (r ((i + + 1).succ)))).2), (GaussianRealPoint (BandVectors.1 (r ((i + 2).succ)) (r ((i + + 1).succ)))).1)))) p q → ∀ (k : PartialOdometer), ∀ (g : PartialOdometer), (g.domain : Set + GaussianInt) = FootprintVertices q.2 → (k.domain : Set GaussianInt) = FootprintVertices + p.2 → k.domain ⊆ g.domain → (∀ x, x ∈ k.domain → k.value x = g.value x) → TileOdometer + q.1 q.2 g → TileOdometer p.1 p.2 k))) ) := by + classical + intro vertices restrict restrict_domain one_step chain_foot p q hac + induction hac with + | refl => + intro k g hdom hkd hsub hval hodo + cases p with + | mk c u => + have heqdom : (g.domain : Set GaussianInt) = (k.domain : Set GaussianInt) := by + rw [hdom, hkd] + have heqval : ∀ x, k.value x = g.value x := by + intro x + by_cases hx : x ∈ k.domain + · exact hval x hx + · have hg : x ∉ g.domain := by + intro hgx + apply hx + exact Set.ext_iff.mp heqdom x |>.mp hgx + rw [k.value_outside x hx, g.value_outside x hg] + have hk : k = g := by + cases k with + | mk kd kv ko => + cases g with + | mk gd gv go => + simp only at heqdom heqval ⊢ + have hd : kd = gd := by + ext x + exact (Set.ext_iff.mp heqdom x).symm + subst gd + have hv : kv = gv := by + funext x + exact heqval x + subst gv + rfl + simpa [hk] using hodo + | @tail b c hxy hy ih => + intro k g hgd hkd hsub hval hodo + rcases hy with ⟨r, j, t, hr, hr0, hrj, hY, hX, hinc, hdiff⟩ + have hpq : FootprintVertices p.2 ⊆ FootprintVertices b.2 := + chain_foot _ _ hxy + let gm := restrict b.2 g + have hgm : TileOdometer b.1 b.2 gm := by + exact one_step (b.1, b.2) (c.1, c.2) + ⟨r, j, t, hr, hr0, hrj, hY, hX, hinc, hdiff⟩ g hgd hodo + apply ih k gm (restrict_domain b.2 g) hkd + · intro x hx + have hxb : x ∈ FootprintVertices b.2 := + hpq (Set.ext_iff.mp hkd x |>.mp hx) + exact Set.ext_iff.mp (restrict_domain b.2 g) x |>.mpr hxb + · intro x hx + have hxb : x ∈ FootprintVertices b.2 := + hpq (Set.ext_iff.mp hkd x |>.mp hx) + rw [hval x hx] + have hxv : x ∈ vertices b.2 := + Set.ext_iff.mp (restrict_domain b.2 g) x |>.mpr hxb + simp [gm, restrict, hxv] + · exact hgm + +end AncestorRestrictionProof + +theorem AncestorOdometerRestriction + (C C₀ : CircleCoordinates) (T T₀ : ProtoTile) + (h h₀ : PartialOdometer) + (ha : AncestorOdometer C C₀ T T₀ h h₀) : + TileOdometer C T h := by +-- BODY + classical + have domain_from_odo : ∀ (c : CircleCoordinates) (U : ProtoTile) + (k : PartialOdometer), TileOdometer c U k → + (k.domain : Set GaussianInt) = FootprintVertices U := + AncestorRestrictionProof.domain_from_odo + have positive_cells : ∀ (c : CircleCoordinates) (U : ProtoTile), + 0 < c.1 → BandPrototile c U → U.cells.Nonempty := AncestorRestrictionProof.positive_cells + let vertices : ProtoTile → Finset GaussianInt := fun U => + if U.cells.Nonempty then + U.cells.biUnion (fun x => {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) + else {U.anchor} + have vertices_spec : ∀ U : ProtoTile, + (vertices U : Set GaussianInt) = FootprintVertices U := by + intro U + classical + by_cases hn : U.cells.Nonempty + · ext x + simp [vertices, FootprintVertices, hn] + · ext x + simp [vertices, FootprintVertices, hn] + let restrict : ProtoTile → PartialOdometer → PartialOdometer := + fun U g => + { domain := vertices U + value := fun x => if x ∈ vertices U then g.value x else 0 + value_outside := by + intro x hx + simp [hx] } + have restrict_domain : ∀ U g, + ((restrict U g).domain : Set GaussianInt) = FootprintVertices U := by + intro U g + exact vertices_spec U + have restrict_subset : ∀ U g V, + (g.domain : Set GaussianInt) = FootprintVertices V → + FootprintVertices U ⊆ FootprintVertices V → + (restrict U g).domain ⊆ g.domain := by + intro U g V hgd hincl x hx + have hx' : x ∈ FootprintVertices U := + Set.ext_iff.mp (restrict_domain U g) x |>.mp hx + have hx'' := hincl hx' + exact Set.ext_iff.mp hgd x |>.mpr hx'' + have restrict_agrees : ∀ U g, + ∀ x, x ∈ (restrict U g).domain → (restrict U g).value x = g.value x := by + intro U g x hx + have hx' : x ∈ vertices U := hx + simp [restrict, hx'] + have odo_eq : ∀ a b : PartialOdometer, + (a.domain : Set GaussianInt) = b.domain → + (∀ x, x ∈ a.domain → a.value x = b.value x) → a = b := AncestorRestrictionProof.odo_eq + have band_from_odo : ∀ (c : CircleCoordinates) (U : ProtoTile) + (k : PartialOdometer), TileOdometer c U k → BandPrototile c U := + AncestorRestrictionProof.band_from_odo + have one_step : ∀ (X Y : CircleCoordinates × ProtoTile), + (∃ r : Fin 4 → CircleCoordinates, ∃ i : Fin 3, ∃ s : Bool, + ProperBandQuadruple r ∧ r 0 = Y.1 ∧ r i.succ = X.1 ∧ + BandPrototile Y.1 Y.2 ∧ BandPrototile X.1 X.2 ∧ + FootprintVertices X.2 ⊆ FootprintVertices Y.2 ∧ + TileCentroid X.2 - TileCentroid Y.2 = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) (r ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) + (r ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) + (r ((i + 1).succ)))).1)))) → + ∀ g : PartialOdometer, + (g.domain : Set GaussianInt) = FootprintVertices Y.2 → + TileOdometer Y.1 Y.2 g → + TileOdometer X.1 X.2 (restrict X.2 g) := by + intro X Y hedge g hgd hgo + rcases hedge with ⟨q, i, s, hq, hq0, hqi, hY, hX, hfoot, hcent⟩ + have band_one : ∀ c : CircleCoordinates, ∀ U : ProtoTile, + BandPrototile c U → c.1 = 1 → ∃ x : GaussianInt, U.cells = {x} := + AncestorRestrictionProof.band_one + have facts := ProperBandCurvatureStructure q hq + have parent_gt_one : 1 < (q 0).1 := AncestorRestrictionProof.parent_gt_one q hq facts + have hrestrict : TileOdometer X.1 X.2 (restrict X.2 g) := AncestorRestrictionProof.hrestrict + domain_from_odo restrict_domain odo_eq band_from_odo X Y g hgd hgo q i s hq hq0 hqi hY hX + hfoot hcent parent_gt_one + exact hrestrict + have chain_foot : ∀ (p q : CircleCoordinates × ProtoTile), + AncestorTile p.1 q.1 p.2 q.2 → FootprintVertices p.2 ⊆ FootprintVertices q.2 := + AncestorRestrictionProof.chain_foot + have main : ∀ (p q : CircleCoordinates × ProtoTile), + Relation.ReflTransGen (fun X Y : CircleCoordinates × ProtoTile => + ∃ r : Fin 4 → CircleCoordinates, ∃ i : Fin 3, ∃ s : Bool, + ProperBandQuadruple r ∧ r 0 = Y.1 ∧ r i.succ = X.1 ∧ + BandPrototile Y.1 Y.2 ∧ BandPrototile X.1 X.2 ∧ + FootprintVertices X.2 ⊆ FootprintVertices Y.2 ∧ + TileCentroid X.2 - TileCentroid Y.2 = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) (r ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) + (r ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) + (r ((i + 1).succ)))).1)))) p q → + ∀ (k g : PartialOdometer), + (g.domain : Set GaussianInt) = FootprintVertices q.2 → + (k.domain : Set GaussianInt) = FootprintVertices p.2 → + k.domain ⊆ g.domain → + (∀ x, x ∈ k.domain → k.value x = g.value x) → + TileOdometer q.1 q.2 g → TileOdometer p.1 p.2 k := AncestorRestrictionProof.main + restrict_domain one_step chain_foot + exact main (C, T) (C₀, T₀) ha.2.1 h h₀ + (domain_from_odo C₀ T₀ h₀ ha.1) ha.2.2.1 ha.2.2.2.1 ha.2.2.2.2 ha.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerTrans.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerTrans.lean new file mode 100644 index 0000000000..6be9c8a9df --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerTrans.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.AncestorTile + +-- [TABLET NODE: AncestorOdometerTrans] + +/-! +# AncestorOdometerTrans + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem AncestorOdometerTrans + (C₁ C₂ C₃ : CircleCoordinates) (T₁ T₂ T₃ : ProtoTile) + (h₁ h₂ h₃ : PartialOdometer) + (h12 : AncestorOdometer C₁ C₂ T₁ T₂ h₁ h₂) + (h23 : AncestorOdometer C₂ C₃ T₂ T₃ h₂ h₃) : + AncestorOdometer C₁ C₃ T₁ T₃ h₁ h₃ := by +-- BODY + rcases h12 with ⟨hO2, hT12, hdom1, hsub12, hval12⟩ + rcases h23 with ⟨hO3, hT23, hdom2, hsub23, hval23⟩ + refine ⟨hO3, hT12.trans hT23, hdom1, hsub12.trans hsub23, ?_⟩ + intro x hx + rw [hval12 x hx, hval23 x (hsub12 hx)] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AncestorTile.lean b/LeanPool/ApollonianSuperharmonic/AncestorTile.lean new file mode 100644 index 0000000000..0f322bc6a6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AncestorTile.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile + +-- [TABLET NODE: AncestorTile] + +/-! +# AncestorTile + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +An ancestor tile is a tile reached by restriction through the recursive +six-piece construction. Formally, $(C,T)$ is an ancestor of $(C',T')$ +when there is a finite chain beginning at $(C,T)$ and ending at $(C',T')$ +such that each term is a parent prototile in one of the six signed +positions inside the next term. Thus its footprint is contained in the +next footprint and its centroid displacement is +$\pm\frac12(v_{kj}-iv_{kj})$ for the corresponding proper quadruple. +The reflexive case allows a tile to be its own ancestor. +-/ +def AncestorTile (C C' : CircleCoordinates) (T T' : ProtoTile) : Prop := +-- BODY + Relation.ReflTransGen + (fun X Y : CircleCoordinates × ProtoTile => + ∃ q : Fin 4 → CircleCoordinates, ∃ i : Fin 3, ∃ s : Bool, + ProperBandQuadruple q ∧ q 0 = Y.1 ∧ q i.succ = X.1 ∧ + BandPrototile Y.1 Y.2 ∧ BandPrototile X.1 X.2 ∧ + FootprintVertices X.2 ⊆ FootprintVertices Y.2 ∧ + TileCentroid X.2 - TileCentroid Y.2 = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1)))) + (C, T) (C', T') + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/AncestorTileCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/AncestorTileCentralCovariance.lean new file mode 100644 index 0000000000..0045d37e50 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AncestorTileCentralCovariance.lean @@ -0,0 +1,189 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorTile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: AncestorTileCentralCovariance] + +/-! +# AncestorTileCentralCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem AncestorTileCentralCovariance + (C C' : CircleCoordinates) (T T' : ProtoTile) (u : GaussianInt) + (hancestor : AncestorTile C C' T T') : + AncestorTile C C' + (TileTranslation (TileHalfTurn T) u) + (TileTranslation (TileHalfTurn T') u) := by +-- BODY + unfold AncestorTile at hancestor ⊢ + let transform : ProtoTile → ProtoTile := + fun V => TileTranslation (TileHalfTurn V) u + have centroid_transform : ∀ V : ProtoTile, + TileCentroid (transform V) = + (-(TileCentroid V).1 + (u.re : Real), + -(TileCentroid V).2 + (u.im : Real)) := by + intro V + dsimp [transform] + rw [(TileTranslationFormulas (TileHalfTurn V) u).2.2.2.2.1, + (TileHalfTurnFormulas V).2.2.2.2.2.2.2.1] + have footprint_transform : ∀ V : ProtoTile, + FootprintVertices (transform V) = + GaussianTranslation u '' ((fun x : GaussianInt => -x) '' + FootprintVertices V) := by + intro V + dsimp [transform] + rw [(TileTranslationFormulas (TileHalfTurn V) u).2.2.2.2.2.1, + (TileHalfTurnFormulas V).2.2.2.2.2.2.1] + have band_transform : ∀ (D : CircleCoordinates) (V : ProtoTile), + BandPrototile D V → BandPrototile D (transform V) := by + intro D V hV + induction hV with + | line w x hw => + apply BandPrototile.line + exact hw + | unit z x => + apply BandPrototile.unit + | @decompose q hq S V hS hcells hfoot hcentroid ih => + let R : Fin 3 → Bool → ProtoTile := + fun i s => transform (S i (!s)) + have hR : ∀ i s, BandPrototile (q i.succ) (R i s) := by + intro i s + exact ih i (!s) + apply BandPrototile.decompose hq hR + · intro x + constructor + · intro hx + dsimp [transform, TileTranslation, TileHalfTurn] at hx + rcases Finset.mem_image.mp hx with ⟨z, hz, rfl⟩ + rcases Finset.mem_image.mp hz with ⟨y, hy, rfl⟩ + rcases (hcells y).mp hy with ⟨i, s, hs⟩ + refine ⟨i, !s, ?_⟩ + dsimp [R] + simp only [Bool.not_not] + change GaussianTranslation u (-y - 1 - ⟨0, 1⟩) ∈ + (transform (S i s)).cells + change GaussianTranslation u (-y - 1 - ⟨0, 1⟩) ∈ + (TileTranslation (TileHalfTurn (S i s)) u).cells + exact Finset.mem_image.mpr ⟨-y - 1 - ⟨0, 1⟩, + Finset.mem_image.mpr ⟨y, hs, rfl⟩, rfl⟩ + · rintro ⟨i, s, hs⟩ + have hs' : x ∈ (transform (S i (!s))).cells := hs + have hx' : x ∈ (transform V).cells := by + dsimp [transform, TileTranslation, TileHalfTurn] + rcases Finset.mem_image.mp hs' with ⟨z, hz, heq⟩ + rcases Finset.mem_image.mp hz with ⟨y, hy, heq'⟩ + exact Finset.mem_image.mpr ⟨z, + Finset.mem_image.mpr ⟨y, (hcells y).mpr ⟨i, !s, hy⟩, heq'⟩, + heq⟩ + exact hx' + · intro i s + rw [footprint_transform, footprint_transform] + intro x hx + rcases hx with ⟨y, ⟨v, hv, rfl⟩, rfl⟩ + refine ⟨-v, ⟨v, hfoot i (!s) hv, rfl⟩, rfl⟩ + · intro i s + have hp := hcentroid i (!s) + rw [centroid_transform, centroid_transform] + have hfirst := congrArg Prod.fst hp + have hsecond := congrArg Prod.snd hp + have hsign : + (if (!s) = true then (1 : Real) else -1) = + -(if s = true then (1 : Real) else -1) := by + cases s <;> norm_num + rw [hsign] at hfirst hsecond + dsimp [R, transform] at hfirst hsecond ⊢ + dsimp [GaussianRealPoint] at hfirst hsecond ⊢ + ring_nf at hfirst hsecond ⊢ + apply Prod.ext + all_goals try dsimp at * + all_goals linarith + have transformed_link : ∀ X Y : CircleCoordinates × ProtoTile, + (∃ q : Fin 4 → CircleCoordinates, ∃ i : Fin 3, ∃ s : Bool, + ProperBandQuadruple q ∧ q 0 = Y.1 ∧ q i.succ = X.1 ∧ + BandPrototile Y.1 Y.2 ∧ BandPrototile X.1 X.2 ∧ + FootprintVertices X.2 ⊆ FootprintVertices Y.2 ∧ + TileCentroid X.2 - TileCentroid Y.2 = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1)))) → + (∃ q : Fin 4 → CircleCoordinates, ∃ i : Fin 3, ∃ s : Bool, + ProperBandQuadruple q ∧ q 0 = Y.1 ∧ q i.succ = X.1 ∧ + BandPrototile Y.1 (transform Y.2) ∧ BandPrototile X.1 (transform X.2) ∧ + FootprintVertices (transform X.2) ⊆ FootprintVertices (transform Y.2) ∧ + TileCentroid (transform X.2) - TileCentroid (transform Y.2) = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1)))) := by + intro X Y h + rcases h with ⟨q, i, s, hq, hq0, hqi, hY, hX, hfoot, hcent⟩ + refine ⟨q, i, !s, hq, hq0, hqi, band_transform _ _ hY, + band_transform _ _ hX, ?_, ?_⟩ + · rw [footprint_transform, footprint_transform] + intro z hz + rcases hz with ⟨w, hw, rfl⟩ + rcases hw with ⟨v, hv, rfl⟩ + exact ⟨-v, ⟨v, hfoot hv, by simp⟩, rfl⟩ + · rw [centroid_transform, centroid_transform] + have hfirst := congrArg Prod.fst hcent + have hsecond := congrArg Prod.snd hcent + dsimp [GaussianRealPoint] at hfirst hsecond ⊢ + rcases s with _ | _ <;> simp at * <;> constructor <;> linarith + refine Relation.ReflTransGen.head_induction_on + (motive := fun a _ => + Relation.ReflTransGen + (fun X Y : CircleCoordinates × ProtoTile => + ∃ q : Fin 4 → CircleCoordinates, ∃ i : Fin 3, ∃ s : Bool, + ProperBandQuadruple q ∧ q 0 = Y.1 ∧ q i.succ = X.1 ∧ + BandPrototile Y.1 Y.2 ∧ BandPrototile X.1 X.2 ∧ + FootprintVertices X.2 ⊆ FootprintVertices Y.2 ∧ + TileCentroid X.2 - TileCentroid Y.2 = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1)))) + (a.1, transform a.2) (C', transform T')) hancestor + ?_ ?_ + · exact Relation.ReflTransGen.refl + · intro a c hedge hrest ih + exact Relation.ReflTransGen.head (transformed_link a c hedge) ih + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandCanonicalPeriodicExtension.lean b/LeanPool/ApollonianSuperharmonic/BandCanonicalPeriodicExtension.lean new file mode 100644 index 0000000000..8f0a54cc7f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandCanonicalPeriodicExtension.lean @@ -0,0 +1,244 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPeriodicOdometer +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.BandTileTopologyApplication +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.PeriodicBoundaryWebLaplacian +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness + +-- [TABLET NODE: BandCanonicalPeriodicExtension] + +/-! +# BandCanonicalPeriodicExtension + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandCanonicalPeriodicExtension (C : BandCircle) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hqC : q 0 = C.1.1) (T : ProtoTile) (h : PartialOdometer) + (g : IntegerLatticeFunction) (hT : BandPrototile (q 0) T) + (hodo : TileOdometer (q 0) T h) + (hdom : (h.domain : Set GaussianInt) = FootprintVertices T) + (hext : GlobalOdometerExtends g h) : + ∃ g₀ : IntegerLatticeFunction, + GlobalOdometerExtends g₀ h ∧ + LatticeTile T ∧ + ExactTileTiling (RegularTileFamily T (TilingLattice C)) ∧ + (∀ x, x ∈ BoundaryFootprintVertices T → + FourNeighborLaplacian g₀ x = 1) ∧ + (∃ b : ℝ × ℝ, ∀ v, v ∈ TilingLattice C → ∀ x, + (g₀ (x + v) : ℝ) - LatticeQuadraticForm (CircleMatrix C) (x + v) - + (b.1 * (x + v).re + b.2 * (x + v).im) = + (g₀ x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x - + (b.1 * x.re + b.2 * x.im)) ∧ + (∀ x, x ∈ h.domain → x ∉ BoundaryFootprintVertices T → + FourNeighborLaplacian g₀ x = FourNeighborLaplacian g x) := by +-- BODY + classical + obtain ⟨U, k, G, hU, hk, hG, hcocycle, hperiod⟩ := BandPeriodicOdometer C + have hpos : 0 < (q 0).1 := (ProperBandCurvatureStructure q hq).1 + have hTC : BandPrototile C.1.1 T := by simpa [hqC] using hT + have hodoC : TileOdometer C.1.1 T h := by simpa [hqC] using hodo + obtain ⟨u, hu, hunique⟩ := TileOdometerTranslationUniqueness + (q 0) T U h k hpos hodo (by simpa [hqC] using hk) + obtain ⟨a, d, hdomu, hval⟩ := hu.2.2 + obtain ⟨c, hc⟩ := hG + let g₀ : IntegerLatticeFunction := fun x => + G (x - u) + a.re * x.re + a.im * x.im - G (-u) + have hext₀ : GlobalOdometerExtends g₀ h := by + refine ⟨c - d - G (-u), ?_⟩ + intro x hx + have hx' : x - u ∈ k.domain := (hdomu x).mp hx + have hv := hval x hx + have hg := hc (x - u) hx' + dsimp [g₀] + rw [hg] + omega + have htile := (BandTileSimultaneousInduction q hq T hT).1 + have htop := (BandTileTopologyApplication C q hq hqC T hT).1 + have hcocycle₀ : ∀ v, v ∈ TilingLattice C → ∃ aa : GaussianInt, + Matrix.mulVec (CircleMatrix C) ![(v.re : ℝ), (v.im : ℝ)] = + ![(aa.re : ℝ), (aa.im : ℝ)] ∧ + ∀ x, g₀ (x + v) = g₀ x + x.re * aa.re + x.im * aa.im + g₀ v := by + intro v hv + obtain ⟨aa, haa, hgv⟩ := hcocycle v hv + refine ⟨aa, haa, ?_⟩ + intro x + have h1 : G (x + v - u) = G (x - u) + (x - u).re * aa.re + + (x - u).im * aa.im + G v := by + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hgv (x - u) + have h2 : G (v - u) = G (-u) + (-u).re * aa.re + + (-u).im * aa.im + G v := by + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hgv (-u) + dsimp [g₀] + rw [h1, h2] + simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + ring + have hboundary : ∀ x, x ∈ BoundaryFootprintVertices T → + FourNeighborLaplacian g₀ x = 1 := by + intro x hx + apply PeriodicBoundaryWebLaplacian C T h g₀ hTC hodoC hext₀ hcocycle₀ + refine ⟨0, (TilingLattice C).zero_mem, ?_⟩ + have hz := (TileTranslationFormulas T 0).2.2.2.2.2.2.2.1 + rw [hz] + simpa [GaussianTranslation] using hx + refine ⟨g₀, hext₀, htile, htop, hboundary, ?_, ?_⟩ + · obtain ⟨b, hb⟩ := hperiod + obtain ⟨b0, hb0⟩ := PeriodicQuadraticRemainder C g₀ hcocycle₀ + refine ⟨b0, ?_⟩ + intro v hv x + exact hb0 v hv x + · intro x hx hxb + have hfoot : x ∈ FootprintVertices T := by + rw [← hdom] + exact hx + have hnonempty : T.cells.Nonempty := by + by_contra hn + have hxa : x = T.anchor := by + simpa [FootprintVertices, hn] using hfoot + apply hxb + simp [BoundaryFootprintVertices, hn, hxa] + have hfoot' := hfoot + simp? [FootprintVertices, hnonempty] at hfoot' + have some : x ∈ T.cells ∨ x - 1 ∈ T.cells ∨ + x - 1 - ⟨0, 1⟩ ∈ T.cells ∨ x - ⟨0, 1⟩ ∈ T.cells := by + rcases hfoot' with ⟨z, hz, rfl | rfl | rfl | rfl⟩ + · exact Or.inl hz + · exact Or.inr (Or.inl (by simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using + hz)) + · exact Or.inr (Or.inr (Or.inr (by simpa [sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] using hz))) + · exact Or.inr (Or.inr (Or.inl (by simpa [sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] using hz))) + have edge03a (p0 : x ∈ T.cells) (p3 : x - ⟨0, 1⟩ ∉ T.cells) : + x ∈ BoundaryFootprintVertices T := by + simp only [BoundaryFootprintVertices, ite_eq_left hnonempty, Set.mem_ofPred_eq] + refine ⟨{x, x + 1}, ?_, by simp⟩ + exact ⟨x, Or.inl ⟨rfl, Or.inl ⟨p0, p3⟩⟩⟩ + have edge03b (p0 : x ∉ T.cells) (p3 : x - ⟨0, 1⟩ ∈ T.cells) : + x ∈ BoundaryFootprintVertices T := by + simp only [BoundaryFootprintVertices, ite_eq_left hnonempty, Set.mem_ofPred_eq] + refine ⟨{x, x + 1}, ?_, by simp⟩ + exact ⟨x, Or.inl ⟨rfl, Or.inr ⟨p0, p3⟩⟩⟩ + have edge12a (p1 : x - 1 ∈ T.cells) (p2 : x - 1 - ⟨0, 1⟩ ∉ T.cells) : + x ∈ BoundaryFootprintVertices T := by + simp only [BoundaryFootprintVertices, ite_eq_left hnonempty, Set.mem_ofPred_eq] + refine ⟨{x - 1, x}, ?_, by simp⟩ + exact ⟨x - 1, Or.inl ⟨(by ext; simp), Or.inl ⟨p1, p2⟩⟩⟩ + have edge12b (p1 : x - 1 ∉ T.cells) (p2 : x - 1 - ⟨0, 1⟩ ∈ T.cells) : + x ∈ BoundaryFootprintVertices T := by + simp only [BoundaryFootprintVertices, ite_eq_left hnonempty, Set.mem_ofPred_eq] + refine ⟨{x - 1, x}, ?_, by simp⟩ + exact ⟨x - 1, Or.inl ⟨(by ext; simp), Or.inr ⟨p1, p2⟩⟩⟩ + have edge01a (p0 : x ∈ T.cells) (p1 : x - 1 ∉ T.cells) : + x ∈ BoundaryFootprintVertices T := by + simp only [BoundaryFootprintVertices, ite_eq_left hnonempty, Set.mem_ofPred_eq] + refine ⟨{x, x + ⟨0, 1⟩}, ?_, by simp⟩ + exact ⟨x, Or.inr ⟨rfl, Or.inl ⟨p0, p1⟩⟩⟩ + have edge01b (p0 : x ∉ T.cells) (p1 : x - 1 ∈ T.cells) : + x ∈ BoundaryFootprintVertices T := by + simp only [BoundaryFootprintVertices, ite_eq_left hnonempty, Set.mem_ofPred_eq] + refine ⟨{x, x + ⟨0, 1⟩}, ?_, by simp⟩ + exact ⟨x, Or.inr ⟨rfl, Or.inr ⟨p0, p1⟩⟩⟩ + have edge32a (p3 : x - ⟨0, 1⟩ ∈ T.cells) (p2 : x - 1 - ⟨0, 1⟩ ∉ T.cells) : + x ∈ BoundaryFootprintVertices T := by + simp only [BoundaryFootprintVertices, ite_eq_left hnonempty, Set.mem_ofPred_eq] + refine ⟨{x - ⟨0, 1⟩, x}, ?_, by simp⟩ + refine ⟨x - ⟨0, 1⟩, Or.inr ⟨(by ext; simp), Or.inl ⟨p3, ?_⟩⟩⟩ + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using p2 + have edge32b (p3 : x - ⟨0, 1⟩ ∉ T.cells) (p2 : x - 1 - ⟨0, 1⟩ ∈ T.cells) : + x ∈ BoundaryFootprintVertices T := by + simp only [BoundaryFootprintVertices, ite_eq_left hnonempty, Set.mem_ofPred_eq] + refine ⟨{x - ⟨0, 1⟩, x}, ?_, by simp⟩ + refine ⟨x - ⟨0, 1⟩, Or.inr ⟨(by ext; simp), Or.inr ⟨p3, ?_⟩⟩⟩ + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using p2 + have iff03 : x ∈ T.cells ↔ x - ⟨0, 1⟩ ∈ T.cells := by + constructor <;> intro hp <;> by_contra hn + · exact hxb (edge03a hp hn) + · exact hxb (edge03b hn hp) + have iff12 : x - 1 ∈ T.cells ↔ x - 1 - ⟨0, 1⟩ ∈ T.cells := by + constructor <;> intro hp <;> by_contra hn + · exact hxb (edge12a hp hn) + · exact hxb (edge12b hn hp) + have iff01 : x ∈ T.cells ↔ x - 1 ∈ T.cells := by + constructor <;> intro hp <;> by_contra hn + · exact hxb (edge01a hp hn) + · exact hxb (edge01b hn hp) + have iff32 : x - ⟨0, 1⟩ ∈ T.cells ↔ x - 1 - ⟨0, 1⟩ ∈ T.cells := by + constructor <;> intro hp <;> by_contra hn + · exact hxb (edge32a hp hn) + · exact hxb (edge32b hn hp) + have allfour : x ∈ T.cells ∧ x - 1 ∈ T.cells ∧ + x - 1 - ⟨0, 1⟩ ∈ T.cells ∧ x - ⟨0, 1⟩ ∈ T.cells := by + rcases some with p0 | p1 | p2 | p3 + · have p1' := iff01.mp p0 + have p2' := iff12.mp p1' + have p3' := iff03.mp p0 + exact ⟨p0, p1', p2', p3'⟩ + · have p0' := iff01.mpr p1 + have p2' := iff12.mp p1 + have p3' := iff03.mp p0' + exact ⟨p0', p1, p2', p3'⟩ + · have p1' := iff12.mpr p2 + have p0' := iff01.mpr p1' + have p3' := iff03.mp p0' + exact ⟨p0', p1', p2, p3'⟩ + · have p0' := iff03.mpr p3 + have p1' := iff01.mp p0' + have p2' := iff32.mp p3 + exact ⟨p0', p1', p2', p3⟩ + have hxp : x + 1 ∈ h.domain := by + change x + 1 ∈ (h.domain : Set GaussianInt) + rw [hdom] + simp only [FootprintVertices, ite_eq_left hnonempty, Set.mem_ofPred_eq] + exact ⟨x, allfour.1, Or.inr (Or.inl rfl)⟩ + have hxm : x - 1 ∈ h.domain := by + change x - 1 ∈ (h.domain : Set GaussianInt) + rw [hdom] + simp only [FootprintVertices, ite_eq_left hnonempty, Set.mem_ofPred_eq] + exact ⟨x - 1, allfour.2.1, Or.inl rfl⟩ + have hxpi : x + ⟨0, 1⟩ ∈ h.domain := by + change x + ⟨0, 1⟩ ∈ (h.domain : Set GaussianInt) + rw [hdom] + simp only [FootprintVertices, ite_eq_left hnonempty, Set.mem_ofPred_eq] + exact ⟨x, allfour.1, Or.inr (Or.inr (Or.inl rfl))⟩ + have hxmi : x - ⟨0, 1⟩ ∈ h.domain := by + change x - ⟨0, 1⟩ ∈ (h.domain : Set GaussianInt) + rw [hdom] + simp only [FootprintVertices, ite_eq_left hnonempty, Set.mem_ofPred_eq] + exact ⟨x - ⟨0, 1⟩, allfour.2.2.2, Or.inl rfl⟩ + obtain ⟨cg, hcg⟩ := hext + obtain ⟨c0, hc0⟩ := hext₀ + simp only [FourNeighborLaplacian] + rw [hc0 (x + 1) hxp, hc0 (x - 1) hxm, hc0 (x + ⟨0, 1⟩) hxpi, + hc0 (x - ⟨0, 1⟩) hxmi, hc0 x hx] + rw [hcg (x + 1) hxp, hcg (x - 1) hxm, + hcg (x + ⟨0, 1⟩) hxpi, hcg (x - ⟨0, 1⟩) hxmi, hcg x hx] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandCircle.lean b/LeanPool/ApollonianSuperharmonic/BandCircle.lean new file mode 100644 index 0000000000..a57da67b04 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandCircle.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle + +-- [TABLET NODE: BandCircle] + +/-! +# BandCircle + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A band circle is an element $C=(c,w)$ of $\mathcal B^{\rm gen}$ with +$c>0$. The notation $\mathcal B$ below always means this +positive-curvature subtype. The oriented lines remain available only +through $\mathcal B^{\rm gen}$ for Descartes recursion. +-/ +def BandCircle : Type := +-- BODY + {C : BandGeneralCircle // 0 < C.1.1} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandCircleEnclosureDichotomy.lean b/LeanPool/ApollonianSuperharmonic/BandCircleEnclosureDichotomy.lean new file mode 100644 index 0000000000..92a5a1ebc1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandCircleEnclosureDichotomy.lean @@ -0,0 +1,176 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandDiskExteriorDensity +public import LeanPool.ApollonianSuperharmonic.BandTangencyDensity +public import LeanPool.ApollonianSuperharmonic.EuclideanCircleData + +-- [TABLET NODE: BandCircleEnclosureDichotomy] + +/-! +# BandCircleEnclosureDichotomy + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandCircleEnclosureDichotomy (E : EuclideanCircleData) : + (∃ C : BandCircle, + dist E.center (BandCircleEuclideanData C).center + E.radius ≤ + (BandCircleEuclideanData C).radius) ∨ + (∃ C : BandCircle, + dist E.center (BandCircleEuclideanData C).center + + (BandCircleEuclideanData C).radius < E.radius) := by +-- BODY + by_cases hfirst : ∃ C : BandCircle, + dist E.center (BandCircleEuclideanData C).center + E.radius ≤ + (BandCircleEuclideanData C).radius + · exact Or.inl hfirst + by_cases hexterior : BandPackingExterior E.center + · obtain ⟨C, hC, hdist⟩ := BandDiskExteriorDensity E.center hexterior (E.radius / 4) (by + linarith [E.radius_pos]) + right + refine ⟨C, ?_⟩ + nlinarith [E.radius_pos, hC, hdist] + · simp only [BandPackingExterior, not_forall] at hexterior + obtain ⟨D, hD⟩ := hexterior + let d : Real := dist E.center (BandCircleEuclideanData D).center + let r : Real := (BandCircleEuclideanData D).radius + have hd : d < r := by + dsimp [d, r] + exact lt_of_not_ge hD + have hrd : r < d + E.radius := by + by_contra h + have hh : d + E.radius ≤ r := le_of_not_gt h + apply hfirst + exact ⟨D, by simpa [d, r, add_comm] using hh⟩ + let p : Complex := if d = 0 then + (BandCircleEuclideanData D).center + (r : Complex) else + (BandCircleEuclideanData D).center + (r / d) • + (E.center - (BandCircleEuclideanData D).center) + have hp : dist p (BandCircleEuclideanData D).center = r := by + dsimp [p] + by_cases hd0 : d = 0 + · rw [ite_eq_left hd0] + simp only [Complex.dist_eq, add_sub_cancel_left, Complex.norm_real] + exact abs_of_pos (by simpa [r] using (BandCircleEuclideanData D).radius_pos) + · rw [ite_eq_right hd0, Complex.dist_eq] + change ‖(BandCircleEuclideanData D).center + (r / d) • + (E.center - (BandCircleEuclideanData D).center) - + (BandCircleEuclideanData D).center‖ = r + have hident : (BandCircleEuclideanData D).center + (r / d) • + (E.center - (BandCircleEuclideanData D).center) - + (BandCircleEuclideanData D).center = + (r / d) • (E.center - (BandCircleEuclideanData D).center) := by module + rw [hident, norm_smul] + simp only [Real.norm_eq_abs] + rw [abs_of_pos (div_pos (by simpa [r] using (BandCircleEuclideanData D).radius_pos) (by + positivity))] + dsimp [d] at hd0 ⊢ + rw [show ‖E.center - (BandCircleEuclideanData D).center‖ = d by + simpa [d] using (Complex.dist_eq E.center (BandCircleEuclideanData D).center).symm] + field_simp + dsimp [d] + have hpz : dist p E.center < E.radius := by + dsimp [p] + by_cases hd0 : d = 0 + · rw [ite_eq_left hd0] + have hc : E.center = (BandCircleEuclideanData D).center := by + have hz : dist E.center (BandCircleEuclideanData D).center = 0 := by + simpa [d] using hd0 + have hz' : ‖E.center - (BandCircleEuclideanData D).center‖ = 0 := by + simpa [Complex.dist_eq] using hz + exact sub_eq_zero.mp (norm_eq_zero.mp hz') + rw [hc, Complex.dist_eq] + simp only [add_sub_cancel_left, Complex.norm_real] + rw [Real.norm_eq_abs, abs_of_pos (by simpa [r] using (BandCircleEuclideanData + D).radius_pos)] + linarith + · rw [ite_eq_right hd0, Complex.dist_eq] + have hdpos : 0 < d := by + dsimp [d] + exact dist_pos.mpr (by + intro h + apply hd0 + simp [d, h]) + have hcoef : 0 < r / d - 1 := by + apply (sub_pos.mpr) + rw [lt_div_iff₀ hdpos] + linarith + change ‖(BandCircleEuclideanData D).center + (r / d) • + (E.center - (BandCircleEuclideanData D).center) - E.center‖ < E.radius + have hident : (BandCircleEuclideanData D).center + (r / d) • + (E.center - (BandCircleEuclideanData D).center) - E.center = + (r / d - 1) • (E.center - (BandCircleEuclideanData D).center) := by module + rw [hident, norm_smul] + simp only [Real.norm_eq_abs, abs_of_pos hcoef] + dsimp [d] at hd0 ⊢ + rw [show ‖E.center - (BandCircleEuclideanData D).center‖ = d by + simpa [d] using (Complex.dist_eq E.center (BandCircleEuclideanData D).center).symm] + field_simp + nlinarith [hrd, hdpos] + obtain ⟨C, hDC, hCr, t, htp, htD, htC, hcent⟩ := + BandTangencyDensity D p hp ((E.radius - dist p E.center) / 4) (by linarith) + right + refine ⟨C, ?_⟩ + have htri : dist E.center (BandCircleEuclideanData C).center ≤ + dist E.center p + dist p t + dist t (BandCircleEuclideanData C).center := by + calc + dist E.center (BandCircleEuclideanData C).center ≤ + dist E.center t + dist t (BandCircleEuclideanData C).center := + dist_triangle _ _ _ + _ ≤ dist E.center p + dist p t + dist t (BandCircleEuclideanData C).center := by + gcongr + exact dist_triangle _ _ _ + calc + dist E.center (BandCircleEuclideanData C).center + + (BandCircleEuclideanData C).radius ≤ + dist E.center p + dist p t + dist t (BandCircleEuclideanData C).center + + (BandCircleEuclideanData C).radius := by linarith + _ < E.radius := by + have hbound : dist p t + dist t (BandCircleEuclideanData C).center + + (BandCircleEuclideanData C).radius < E.radius - dist E.center p := by + rw [htC] + have htp0 : dist p t < (E.radius - dist E.center p) / 4 := by + simpa [dist_comm] using htp + have hCr0 : (BandCircleEuclideanData C).radius < + (E.radius - dist E.center p) / 4 := by + simpa [dist_comm] using hCr + have htp' : dist p t * 4 < E.radius - dist E.center p := + (lt_div_iff₀ (by norm_num)).mp htp0 + have hCr' : (BandCircleEuclideanData C).radius * 4 < + E.radius - dist E.center p := + (lt_div_iff₀ (by norm_num)).mp hCr0 + have hsum : 4 * (dist p t + 2 * (BandCircleEuclideanData C).radius) < + 3 * (E.radius - dist E.center p) := by + linarith [htp', hCr'] + have hpz0 : dist E.center p < E.radius := by simpa [dist_comm] using hpz + have heta : 0 < E.radius - dist E.center p := by linarith [hpz0] + have hmul : 4 * (dist p t + 2 * (BandCircleEuclideanData C).radius) < + 4 * (E.radius - dist E.center p) := by + linarith [hsum, heta] + have hsmall : dist p t + 2 * (BandCircleEuclideanData C).radius < + E.radius - dist E.center p := + lt_of_mul_lt_mul_left hmul (by norm_num) + convert hsmall using 1; ring + calc + dist E.center p + dist p t + dist t (BandCircleEuclideanData C).center + + (BandCircleEuclideanData C).radius = + dist E.center p + (dist p t + dist t (BandCircleEuclideanData C).center + + (BandCircleEuclideanData C).radius) := by ring + _ < dist E.center p + (E.radius - dist E.center p) := by + have hsum := add_lt_add_right hbound (dist E.center p) + convert hsum using 1 + _ = E.radius := by ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandCircleEuclideanData.lean b/LeanPool/ApollonianSuperharmonic/BandCircleEuclideanData.lean new file mode 100644 index 0000000000..edfaf10394 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandCircleEuclideanData.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandCircle +public import LeanPool.ApollonianSuperharmonic.EuclideanCircleData + +-- [TABLET NODE: BandCircleEuclideanData] + +/-! +# BandCircleEuclideanData + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +If $C=(c,w)$ is a positive-curvature band circle, its Euclidean circle +datum is +$$ + \operatorname{circ}(C)=(w/c,1/c). +$$ +This is well-defined because $c>0$. In particular, this construction is +never applied to either curvature-zero line used inside the Descartes +recursion. +-/ +noncomputable def BandCircleEuclideanData (C : BandCircle) : EuclideanCircleData := +-- BODY + { center := (C.1.1.2 : Complex) / (C.1.1.1 : Real) + radius := 1 / (C.1.1.1 : Real) + radius_pos := one_div_pos.mpr (by exact_mod_cast C.2) } + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandDescartesGapSubdivision.lean b/LeanPool/ApollonianSuperharmonic/BandDescartesGapSubdivision.lean new file mode 100644 index 0000000000..d422353af6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandDescartesGapSubdivision.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData +public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity + +-- [TABLET NODE: BandDescartesGapSubdivision] + +/-! +# BandDescartesGapSubdivision + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandDescartesGapSubdivision + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) : + let D : CircleCoordinates := + (2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2) + ∃ C₀ D₀ : BandCircle, + C₀.1.1 = q 0 ∧ D₀.1.1 = D ∧ + dist (BandCircleEuclideanData C₀).center + (BandCircleEuclideanData D₀).center = + (BandCircleEuclideanData C₀).radius + + (BandCircleEuclideanData D₀).radius ∧ + (BandCircleEuclideanData D₀).radius < + (BandCircleEuclideanData C₀).radius ∧ + (∀ k : Fin 4, (k = 2 ∨ k = 3) → 0 < (q k).1 → + ∃ Cₖ : BandCircle, Cₖ.1.1 = q k ∧ + dist (BandCircleEuclideanData Cₖ).center + (BandCircleEuclideanData D₀).center = + (BandCircleEuclideanData Cₖ).radius + + (BandCircleEuclideanData D₀).radius ∧ + (BandCircleEuclideanData D₀).radius < + (BandCircleEuclideanData Cₖ).radius) := by +-- BODY + dsimp + have makeCircle : ∀ (r : Fin 4 → CircleCoordinates), + SemiProperQuadruple r → ∀ i : Fin 4, 0 < (r i).1 → + ∃ C : BandCircle, C.1.1 = r i := by + intro r hr i hi + refine ⟨⟨⟨r i, ?_⟩, hi⟩, rfl⟩ + exact ⟨Or.inl hi, ⟨r, hr, i, rfl⟩⟩ + have curvature := ProperBandCurvatureStructure q hq + have successor := SemiProperQuadruple.successor hq.1 + have classified := BandSuccessorClassification q hq.1 + dsimp at classified + rcases classified with special | classified + · exfalso + have hpos := curvature.1 + have n1 : 0 ≤ (q 1).1 := by simpa using curvature.2.1 (0 : Fin 3) + have n2 : 0 ≤ (q 2).1 := by simpa using curvature.2.1 (1 : Fin 3) + have n3 : 0 ≤ (q 3).1 := by simpa using curvature.2.1 (2 : Fin 3) + have hlt : (q 1).1 < (q 0).1 := by simpa using hq.2 (0 : Fin 3) + have hzero := curvature.2.2 + change 2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1 = 1 at special + have hz2 : (q 2).1 = 0 := by omega + have hz3 : (q 3).1 = 0 := by omega + have hz1 : (q 1).1 = 0 := by omega + have : (1 : Fin 3) = 2 := hzero 1 2 (by simpa using hz2) (by simpa using hz3) + exact (by decide : (1 : Fin 3) ≠ 2) this + rcases classified with ⟨hs, h0, h2, h3⟩ + let s : Fin 4 → CircleCoordinates := + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + have hsdef : s = ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] := rfl + have hssemi : SemiProperQuadruple s := by + simpa [s] using successor + have hdpos : 0 < (s 0).1 := by + change 0 < 2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1 + omega + have hcpos : 0 < (s 1).1 := by simpa [s] using curvature.1 + obtain ⟨C₀, hC₀⟩ := makeCircle s hssemi 1 hcpos + obtain ⟨D₀, hD₀⟩ := makeCircle s hssemi 0 hdpos + have tangentNorm : ∀ (r : Fin 4 → CircleCoordinates), + SemiProperQuadruple r → ∀ i j : Fin 4, i ≠ j → + 0 < (r i).1 → 0 < (r j).1 → + ‖((r i).2 : Complex) / (r i).1 - (r j).2 / (r j).1‖ = + (1 / (r i).1 : ℝ) + 1 / (r j).1 := by + intro r hr i j hij hi hj + have ht := TangencyCoordinateIdentity r hr i j hij + have htcast := congrArg (fun z : ℤ => (z : ℝ)) ht + simp only [GaussianInt.intCast_real_norm, Int.cast_pow, Int.cast_add] at htcast + have hsq : + ‖((r i).2 : Complex) / (r i).1 - (r j).2 / (r j).1‖ ^ 2 = + ((1 / (r i).1 : ℝ) + 1 / (r j).1) ^ 2 := by + rw [Complex.sq_norm] + simp only [Complex.normSq_apply, GaussianInt.toComplex_def₂] + norm_num [Complex.div_re, Complex.div_im, Complex.normSq_apply] + field_simp + simp only [Complex.normSq_apply, GaussianInt.toComplex_def₂] at htcast + norm_num at htcast + have ire : (GaussianInt.toComplex (r i).2).re = ((r i).2.re : ℝ) := by + rw [GaussianInt.toComplex_def₂] + have iim : (GaussianInt.toComplex (r i).2).im = ((r i).2.im : ℝ) := by + rw [GaussianInt.toComplex_def₂] + have jre : (GaussianInt.toComplex (r j).2).re = ((r j).2.re : ℝ) := by + rw [GaussianInt.toComplex_def₂] + have jim : (GaussianInt.toComplex (r j).2).im = ((r j).2.im : ℝ) := by + rw [GaussianInt.toComplex_def₂] + rw [ire, iim, jre, jim] at htcast + rw [ire, iim, jre, jim] at ⊢ + ring_nf at htcast ⊢ + nlinarith [htcast] + have hnon : 0 ≤ ‖((r i).2 : Complex) / (r i).1 - (r j).2 / (r j).1‖ := norm_nonneg _ + have hright : 0 ≤ (1 / (r i).1 : ℝ) + 1 / (r j).1 := by positivity + nlinarith + refine ⟨C₀, D₀, ?_, ?_, ?_, ?_, ?_⟩ + · simp [hC₀, s] + · simp [hD₀, s] + · have ht := tangentNorm s hssemi 1 0 (by decide) hcpos hdpos + simpa [BandCircleEuclideanData, hC₀, hD₀, dist_eq_norm] using ht + · have hlt : (1 / (s 0).1 : ℝ) < 1 / (s 1).1 := by + apply one_div_lt_one_div_of_lt + · exact_mod_cast hcpos + · exact_mod_cast h0 + simpa [BandCircleEuclideanData, hC₀, hD₀] using hlt + · intro k hk hkpos + rcases hk with rfl | rfl + · obtain ⟨Cₖ, hCₖ⟩ := makeCircle s hssemi 2 hkpos + refine ⟨Cₖ, ?_, ?_, ?_⟩ + · simp [hCₖ, s] + · have ht := tangentNorm s hssemi 2 0 (by decide) (by simpa [s] using hkpos) hdpos + simpa [BandCircleEuclideanData, hCₖ, hD₀, dist_eq_norm] using ht + · have hlt : (1 / (s 0).1 : ℝ) < 1 / (s 2).1 := by + apply one_div_lt_one_div_of_lt + · exact_mod_cast (show 0 < (s 2).1 by simpa [s] using hkpos) + · exact_mod_cast h2 + simpa [BandCircleEuclideanData, hCₖ, hD₀] using hlt + · obtain ⟨Cₖ, hCₖ⟩ := makeCircle s hssemi 3 hkpos + refine ⟨Cₖ, ?_, ?_, ?_⟩ + · simp [hCₖ, s] + · have ht := tangentNorm s hssemi 3 0 (by decide) (by simpa [s] using hkpos) hdpos + simpa [BandCircleEuclideanData, hCₖ, hD₀, dist_eq_norm] using ht + · have hlt : (1 / (s 0).1 : ℝ) < 1 / (s 3).1 := by + apply one_div_lt_one_div_of_lt + · exact_mod_cast (show 0 < (s 3).1 by simpa [s] using hkpos) + · exact_mod_cast h3 + simpa [BandCircleEuclideanData, hCₖ, hD₀] using hlt + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandDiskExteriorDensity.lean b/LeanPool/ApollonianSuperharmonic/BandDiskExteriorDensity.lean new file mode 100644 index 0000000000..6a98d55e51 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandDiskExteriorDensity.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandDescartesGapSubdivision +public import LeanPool.ApollonianSuperharmonic.BandPackingExterior +public import LeanPool.ApollonianSuperharmonic.BandOrientedGapRefinementExists + +-- [TABLET NODE: BandDiskExteriorDensity] + +/-! +# BandDiskExteriorDensity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandDiskExteriorDensity (z : Complex) (hz : BandPackingExterior z) + (eps : Real) (heps : 0 < eps) : + ∃ C : BandCircle, + (BandCircleEuclideanData C).radius < eps ∧ + dist z (BandCircleEuclideanData C).center < eps := by +-- BODY + obtain ⟨R⟩ := BandOrientedGapRefinementExists + obtain ⟨a, side, hzroot⟩ := R.root_cover z hz + let chooseChild : ∀ (l : List (Fin 3)), z ∈ R.gap (a, side, l) → + {b : Fin 3 // z ∈ R.gap (a, side, l ++ [b])} := + fun l hl => by + have existence : ∃ b : Fin 3, z ∈ R.gap (a, side, l ++ [b]) := by + have hsplit : z ∈ Metric.closedBall + (BandCircleEuclideanData (R.circle (a, side, l))).center + (BandCircleEuclideanData (R.circle (a, side, l))).radius ∨ + z ∈ ⋃ b : Fin 3, R.gap (a, side, l ++ [b]) := by + have decomposition := congrArg (fun s : Set Complex => z ∈ s) + (R.exact_three_residual (a, side, l)) + have normalized : (z ∈ R.gap (a, side, l)) = + (z ∈ Metric.closedBall + (BandCircleEuclideanData (R.circle (a, side, l))).center + (BandCircleEuclideanData (R.circle (a, side, l))).radius ∨ + z ∈ ⋃ b : Fin 3, R.gap (a, side, l ++ [b])) := by + simpa only [Set.mem_union] using decomposition + exact normalized ▸ hl + rcases hsplit with hball | hres + · have hle : dist z (BandCircleEuclideanData (R.circle (a, side, l))).center ≤ + (BandCircleEuclideanData (R.circle (a, side, l))).radius := by + simpa [Metric.mem_closedBall] using hball + have hge := hz (R.circle (a, side, l)) + have heq : dist z (BandCircleEuclideanData (R.circle (a, side, l))).center = + (BandCircleEuclideanData (R.circle (a, side, l))).radius := le_antisymm hle hge + have hs : z ∈ Metric.sphere + (BandCircleEuclideanData (R.circle (a, side, l))).center + (BandCircleEuclideanData (R.circle (a, side, l))).radius := by + change dist z (BandCircleEuclideanData (R.circle (a, side, l))).center = + (BandCircleEuclideanData (R.circle (a, side, l))).radius + exact heq + have hu := R.inserted_boundary_covered (a, side, l) hs + rcases Set.mem_iUnion.1 hu with ⟨b, hb⟩ + exact ⟨b, hb⟩ + · rcases Set.mem_iUnion.1 hres with ⟨b, hb⟩ + exact ⟨b, hb⟩ + exact ⟨Classical.choose existence, Classical.choose_spec existence⟩ + let step : {l : List (Fin 3) // z ∈ R.gap (a, side, l)} → + {l : List (Fin 3) // z ∈ R.gap (a, side, l)} := fun previous => + let child := chooseChild previous.1 previous.2 + ⟨previous.1 ++ [child.1], child.2⟩ + let path : Nat → {l : List (Fin 3) // z ∈ R.gap (a, side, l)} := + Nat.rec ⟨[], hzroot⟩ (fun _ previous => step previous) + let branch : Nat → Fin 3 := fun n => + (chooseChild (path n).1 (path n).2).1 + have hpath : ∀ n, (path n).1 = (List.range n).map branch := by + intro n + induction n with + | zero => simp [path] + | succ n ih => + change (path n).1 ++ [branch n] = (List.range (n + 1)).map branch + rw [ih] + rw [List.range_succ, List.map_append] + rfl + have hshrink := R.branch_shrinks a side branch + have hdiam : ∀ᶠ n in Filter.atTop, + Metric.diam (R.gap (a, side, (List.range n).map branch)) < eps := by + filter_upwards [Metric.tendsto_nhds.1 hshrink.1 eps heps] with n hn + simpa only [Real.dist_eq, sub_zero, abs_of_nonneg Metric.diam_nonneg] using hn + have hradius : ∀ᶠ n in Filter.atTop, + (BandCircleEuclideanData (R.circle (a, side, (List.range n).map branch))).radius < eps := by + filter_upwards [Metric.tendsto_nhds.1 hshrink.2 eps heps] with n hn + simpa only [Real.dist_eq, sub_zero, abs_of_pos + (BandCircleEuclideanData (R.circle (a, side, (List.range n).map branch))).radius_pos] using hn + obtain ⟨n, hn⟩ := Filter.Eventually.exists (hdiam.and hradius) + let l := (List.range n).map branch + let C := R.circle (a, side, l) + have hzmem : z ∈ R.gap (a, side, l) := by + dsimp [l] + rw [← hpath n] + exact (path n).2 + have rootBound : Bornology.IsBounded (R.gap (a, side, [])) := by + apply Metric.isBounded_iff.2 + refine ⟨3, ?_⟩ + intro x hx y hy + rcases side with _ | _ + · rw [R.root_left a] at hx hy + simp only [Set.mem_ofPred_eq] at hx hy + rw [Complex.dist_eq_re_im] + apply Real.sqrt_le_iff.2 + constructor + · positivity + · nlinarith [sq_nonneg (x.re - y.re), sq_nonneg (x.im - y.im)] + · rw [R.root_right a] at hx hy + simp only [Set.mem_ofPred_eq] at hx hy + rw [Complex.dist_eq_re_im] + apply Real.sqrt_le_iff.2 + constructor + · positivity + · nlinarith [sq_nonneg (x.re - y.re), sq_nonneg (x.im - y.im)] + have hcontained : ∀ (u v : List (Fin 3)), + R.gap (a, side, u ++ v) ⊆ R.gap (a, side, u) := by + intro u v + induction v generalizing u with + | nil => intro x hx; simpa using hx + | cons b v ih => + intro x hx + have hx' : x ∈ R.gap (a, side, u ++ [b] ++ v) := by + simpa [List.append_assoc] using hx + exact R.child_contained (a, side, u) b (ih (u ++ [b]) hx') + have hbounded : Bornology.IsBounded (R.gap (a, side, l)) := by + rcases rootBound with ⟨bound, root_bound⟩ + refine ⟨bound, ?_⟩ + intro x hx y hy + have hx0 : x ∈ R.gap (a, side, l) := by simpa using hx + have hy0 : y ∈ R.gap (a, side, l) := by simpa using hy + have hx1 : x ∈ (R.gap (a, side, []))ᶜᶜ := by simpa using hcontained [] l hx0 + have hy1 : y ∈ (R.gap (a, side, []))ᶜᶜ := by simpa using hcontained [] l hy0 + exact root_bound hx1 hy1 + have hcenter : (BandCircleEuclideanData C).center ∈ R.gap (a, side, l) := by + have hball : (BandCircleEuclideanData C).center ∈ + Metric.closedBall (BandCircleEuclideanData C).center + (BandCircleEuclideanData C).radius := + Metric.mem_closedBall_self (BandCircleEuclideanData C).radius_pos.le + have normalized : R.gap (a, side, l) = + Metric.closedBall (BandCircleEuclideanData C).center + (BandCircleEuclideanData C).radius ∪ + ⋃ b : Fin 3, R.gap (a, side, l ++ [b]) := by + simpa [C] using R.exact_three_residual (a, side, l) + rw [normalized] + exact Or.inl hball + have hdist : dist z (BandCircleEuclideanData C).center ≤ + Metric.diam (R.gap (a, side, l)) := by + exact Metric.dist_le_diam_of_mem hbounded hzmem hcenter + refine ⟨C, ?_, ?_⟩ + · exact hn.2 + · exact lt_of_le_of_lt hdist hn.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean b/LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean new file mode 100644 index 0000000000..5a5ab7a136 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean @@ -0,0 +1,1008 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandParentBoundaryGenealogy +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandDoubleDecomposition] + +/-! +# BandDoubleDecomposition + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DoubleDecompositionProof + +private theorem observable : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (X : ProtoTile), ∀ (Y : ProtoTile), T.cells = + U.cells → (T.cells = ∅ → T.anchor = U.anchor) → (TouchingTriple X T Y ↔ + TouchingTriple X U Y) + ) := by + classical + intro T U X Y he ha + have obs := ProtoTileObservableExtensionality T U he ha + have left : TileTouching X T ↔ TileTouching X U := by + by_cases hz : T.cells = ∅ + · simp only [TileTouching, he, obs.2.1, obs.2.2.1, ha hz] + · have hz' : U.cells ≠ ∅ := by rwa [← he] + simp only [TileTouching, hz', false_and, or_false, he, + obs.2.1, obs.2.2.1] + have right : TileTouching T Y ↔ TileTouching U Y := by + by_cases hz : T.cells = ∅ + · simp only [TileTouching, he, obs.2.1, obs.2.2.1, ha hz] + · have hz' : U.cells ≠ ∅ := by rwa [← he] + simp only [TileTouching, hz', false_and, he, obs.2.1, obs.2.2.1] + simp only [TouchingTriple, left, right, obs.2.1] + +private theorem preimage : + (by + classical + exact + ∀ (C : CircleCoordinates), ∀ (W : ProtoTile), BandPrototile C W → QuarterTurnSymmetric W + → ∃ (W' : ProtoTile), BandPrototile C W' ∧ (TileQuarterTurn W').cells = W.cells ∧ + ((TileQuarterTurn W').cells = ∅ → (TileQuarterTurn W').anchor = W.anchor) ∧ + TileCentroid (TileQuarterTurn W') = TileCentroid W + ) := by + classical + intro C W hW hs + obtain ⟨u, _, hc, ha, _, hcent⟩ := QuarterTurnSymmetricCenteredTransport W hs + let v : GaussianInt := ⟨u.im, -u.re⟩ + have he : TileQuarterTurn (TileTranslation W v) = + TileTranslation (TileQuarterTurn W) u := by + change ProtoTile.mk _ _ = ProtoTile.mk _ _ + congr 1 + · simp only [TileQuarterTurn, TileTranslation, Finset.image_image] + congr 1 + funext z + ext <;> simp [GaussianQuarterTurn, GaussianTranslation, v]; ring + · ext <;> simp [TileQuarterTurn, TileTranslation, GaussianQuarterTurn, + GaussianTranslation, v]; ring + refine ⟨TileTranslation W v, BandPrototileTranslation C W v hW, ?_, ?_, ?_⟩ + · rw [he]; exact hc + · rw [he]; intro hz; exact ha (hc ▸ hz) + · rw [he]; exact hcent + +private theorem rotatedT5 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (Fin (4 : ℕ) → CircleCoordinates) → ((∀ (D : + CircleCoordinates), ∀ (U : ProtoTile), BandPrototile D U → D.1.toNat < (q (0 : Fin (4 + : ℕ))).1.toNat → QuarterTurnSymmetric U) → ((∀ (q' : Fin (4 : ℕ) → + CircleCoordinates), ∀ (T' : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), + ProperBandQuadruple q' → BandPrototile (q' (0 : Fin (4 : ℕ))) T' → (q' (0 : Fin (4 : + ℕ))).1.toNat < (q (0 : Fin (4 : ℕ))).1.toNat → ∀ (i : Fin (3 : ℕ)), BandPrototile (q' + i.succ) U → BandPrototile (q' (i + (1 : Fin (3 : ℕ))).succ) V → TileCentroid U - + TileCentroid T' = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q' i.succ) (q' (0 + : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' + i.succ))) → TileCentroid V - TileCentroid T' = (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q' (i + (1 : Fin (3 : ℕ))).succ) (q' (0 : Fin (4 : ℕ)))) - + GaussianRealPoint (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' (i + (1 : Fin (3 : + ℕ))).succ))) → TouchingTriple T' U V) → ((∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (X + : ProtoTile), ∀ (Y : ProtoTile), (T.cells = U.cells) → ((T.cells = ∅ → T.anchor = + U.anchor) → (TouchingTriple X T Y ↔ TouchingTriple X U Y))) → ((∀ (C : + CircleCoordinates), ∀ (W : ProtoTile), (BandPrototile C W) → ((QuarterTurnSymmetric + W) → (∃ W' : ProtoTile, BandPrototile C W' ∧ (TileQuarterTurn W').cells = W.cells ∧ + ((TileQuarterTurn W').cells = ∅ → (TileQuarterTurn W').anchor = W.anchor) ∧ + TileCentroid (TileQuarterTurn W') = TileCentroid W))) → (∀ (p : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple p → (p (0 : Fin (4 : ℕ))).1.toNat < (q (0 : + Fin (4 : ℕ))).1.toNat → ∀ (n : ℕ), ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), BandPrototile (p (0 : Fin (4 : ℕ))) T → BandPrototile (p (2 : Fin (4 : + ℕ))) U → BandPrototile (p (3 : Fin (4 : ℕ))) V → TileCentroid U - TileCentroid T = (1 + / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[n] (BandVectors.1 (p (2 : Fin (4 + : ℕ))) (p (0 : Fin (4 : ℕ))))) + GaussianRealPoint (GaussianQuarterTurn^[n] + (BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ)))))) → TileCentroid V - + TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[n] + (BandVectors.1 (p (3 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))))) - GaussianRealPoint + (GaussianQuarterTurn^[n] (BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (3 : Fin (4 : + ℕ)))))) → TouchingTriple T U V))))) + ) := by + classical + intro q t hT2 hT5 observable preimage p hp hsmall + have hsmall2 : Int.toNat (p 2).1 < Int.toNat (q 0).1 := by + have hn := (SemiProperForestClassification p hp.1).1 2 + have hl := hp.2 1 + change (p 2).1 < (p 0).1 at hl + omega + have hsmall3 : Int.toNat (p 3).1 < Int.toNat (q 0).1 := by + have hn := (SemiProperForestClassification p hp.1).1 3 + have hl := hp.2 2 + change (p 3).1 < (p 0).1 at hl + omega + intro n + induction n with + | zero => + intro T U V hT hU hV hu hv + exact hT5 p T U V hp hT hsmall 1 hU hV hu hv + | succ n ih => + intro T U V hT hU hV hu hv + obtain ⟨T', hT', htcell, htanchor, htcent⟩ := + preimage _ T hT (hT2 _ T hT hsmall) + obtain ⟨U', hU', hucell, huanchor, hucent⟩ := + preimage _ U hU (hT2 _ U hU hsmall2) + obtain ⟨V', hV', hvcell, hvanchor, hvcent⟩ := + preimage _ V hV (hT2 _ V hV hsmall3) + have tc := (TileQuarterTurnFormulas T').2.2.2.2.1.symm.trans htcent + have uc := (TileQuarterTurnFormulas U').2.2.2.2.1.symm.trans hucent + have vc := (TileQuarterTurnFormulas V').2.2.2.2.1.symm.trans hvcent + have tx := congrArg Prod.fst tc + have ty := congrArg Prod.snd tc + have ux := congrArg Prod.fst uc + have uy := congrArg Prod.snd uc + have vx := congrArg Prod.fst vc + have vy := congrArg Prod.snd vc + have hux := congrArg Prod.fst hu + have huy := congrArg Prod.snd hu + have hvx := congrArg Prod.fst hv + have hvy := congrArg Prod.snd hv + simp? [Function.iterate_succ_apply', GaussianRealPoint, GaussianQuarterTurn] + at hux huy hvx hvy + have h : TouchingTriple T' U' V' := by + apply ih T' U' V' hT' hU' hV' + · apply Prod.ext <;> simp [GaussianRealPoint] <;> + linarith only [hux, huy, tx, ty, ux, uy] + · apply Prod.ext <;> simp [GaussianRealPoint] <;> + linarith only [hvx, hvy, tx, ty, vx, vy] + have h := (TouchingTripleCovariance T' U' V' 0).2.1.mp h + have h := ((TouchingTriplePermutations _ _ _).mp h).2.1 + have h := (observable _ _ _ _ htcell htanchor).mp h + have h := ((TouchingTriplePermutations _ _ _).mp h).2.1 + have h := (observable _ _ _ _ hucell huanchor).mp h + have h := ((TouchingTriplePermutations _ _ _).mp h).1 + have h := (observable _ _ _ _ hvcell hvanchor).mp h + exact ((TouchingTriplePermutations _ _ _).mp h).1 + +private theorem hd : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple r) → ((r (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ))) → ((r (3 : Fin + (4 : ℕ)) = q (3 : Fin (4 : ℕ))) → ( + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + let d := BandVectors.1 (r 1) (r 3) + (BandVectors.1 (r 3) (r 2) = a) → (d = b - I * a)))) + ) := by + classical + intro q r hr hr0 hr3 I a b d hr32 + have step := (VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hr.1))).2.2.1 + change BandVectors.1 (r 3) (r 0) = BandVectors.1 (r 3) (r 2) - I * d at step + rw [hr32] at step + have flip := ((VectorRecursionLaws r hr.1).2.2.2.2 hr 2).1 + change BandVectors.1 (r 0) (r 3) = I * BandVectors.1 (r 3) (r 0) at flip + have hr03 : BandVectors.1 (r 0) (r 3) = b := by rw [hr0, hr3] + rw [hr03] at flip + change b = I * BandVectors.1 (r 3) (r 0) at flip + calc + d = I * (a - I * d) - I * a := by ext <;> simp [I] + _ = b - I * a := by rw [← step, ← flip] + +private theorem literal : + (by + classical + exact + ∀ (t : Fin (4 : ℕ) → CircleCoordinates), (∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (X : + ProtoTile), ∀ (Y : ProtoTile), (T.cells = U.cells) → ((T.cells = ∅ → T.anchor = + U.anchor) → (TouchingTriple X T Y ↔ TouchingTriple X U Y))) → (∀ (X : ProtoTile), ∀ + (X' : ProtoTile), ∀ (Y : ProtoTile), ∀ (z : GaussianInt), BandPrototile (t (0 : Fin + (4 : ℕ))) X → BandPrototile (t (0 : Fin (4 : ℕ))) X' → TileCentroid X' - TileCentroid + X = GaussianRealPoint z → TouchingTriple X (TileTranslation X z) Y → TouchingTriple X + X' Y) + ) := by + classical + intro t observable X X' Y z hX hX' hoff h + have hcent : TileCentroid (TileTranslation X z) = TileCentroid X' := by + rw [(TileTranslationFormulas X z).2.2.2.2.1] + change TileCentroid X + GaussianRealPoint z = TileCentroid X' + rw [← hoff] + abel + have eqs := BandPrototileCentroidUnique (t 0) (TileTranslation X z) X' + (BandPrototileTranslation _ _ _ hX) hX' hcent + exact (observable _ _ _ _ eqs.1 eqs.2).mp h + +private theorem cross1 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (t : Fin (4 : ℕ) → CircleCoordinates), (∀ (T₀ + : ProtoTile), ∀ (T₁ : ProtoTile), ∀ (s : Fin (4 : ℕ)), BandPrototile (t (0 : Fin (4 : + ℕ))) T₀ → BandPrototile (t (1 : Fin (4 : ℕ))) T₁ → TileCentroid T₁ - TileCentroid T₀ + = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (t + (1 : Fin (4 : ℕ))) (t (0 : Fin (4 : ℕ))))) + GaussianRealPoint + (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (t (0 : Fin (4 : ℕ))) (t (1 : Fin (4 : + ℕ)))))) → TouchingTriple T₀ (TileTranslation T₀ (GaussianQuarterTurn^[(↑s : ℕ)] + (BandVectors.1 (t (1 : Fin (4 : ℕ))) (t (0 : Fin (4 : ℕ)))))) T₁) → (∀ (x : ℝ × ℝ), ∀ + (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : + Fin (3 : ℕ) → Bool → ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + (BandVectors.1 (t 1) (t 0) = a) → ((BandVectors.1 (t 0) (t 1) = I * a) → (((TileCentroid + (P (0 : Fin (3 : ℕ)) true)).1 - x.1 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : + GaussianInt → ℂ) a).re + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)) → + (((TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 - x.2 = (2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) a).re)) → (((TileCentroid (P (0 : Fin (3 : ℕ)) false)).1 - x.1 = + -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → (((TileCentroid (P (0 : Fin (3 + : ℕ)) false)).2 - x.2 = -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) + a).im - ((GaussianInt.toComplex : GaussianInt → ℂ) a).re))) → (((TileCentroid (P (1 : + Fin (3 : ℕ)) true)).1 - x.1 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) + b).re + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im)) → (((TileCentroid (P (1 : + Fin (3 : ℕ)) true)).2 - x.2 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) + b).im - ((GaussianInt.toComplex : GaussianInt → ℂ) b).re)) → (((TileCentroid (Q (1 : + Fin (3 : ℕ)) true)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) true)).1 = (2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + ((GaussianInt.toComplex : + GaussianInt → ℂ) a).im - (((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im))) → (((TileCentroid (Q (1 : Fin (3 + : ℕ)) true)).2 - (TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 = (2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) a).re - (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → (((TileCentroid (S (2 : Fin (3 + : ℕ)) false)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) false)).1 = -((2 : ℝ)⁻¹ * + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : + GaussianInt → ℂ) b).re + -((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re + (((GaussianInt.toComplex : + GaussianInt → ℂ) b).im + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))))) → + (((TileCentroid (S (2 : Fin (3 : ℕ)) false)).2 - (TileCentroid (P (0 : Fin (3 : ℕ)) + false)).2 = -((2 : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im + ((GaussianInt.toComplex : + GaussianInt → ℂ) a).re - (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re + -((GaussianInt.toComplex : + GaussianInt → ℂ) a).im)))) → ((BandPrototile (t 0) (Q 1 true)) → ((BandPrototile (t + 0) (P 1 true)) → ((BandPrototile (t 1) (S 2 false)) → ((∀ (X : ProtoTile), ∀ (X' : + ProtoTile), ∀ (Y : ProtoTile), ∀ (z : GaussianInt), (BandPrototile (t 0) X) → + ((BandPrototile (t 0) X') → ((TileCentroid X' - TileCentroid X = GaussianRealPoint z) + → ((TouchingTriple X (TileTranslation X z) Y) → (TouchingTriple X X' Y))))) → + (TouchingTriple (Q 1 true) (S 2 false) (P 1 true)))))))))))))))))) + ) := by + classical + intro q t hT4t x P Q S I a b ht10 ht01 p0x p0y m0x m0y p1x p1y q1x q1y s2x s2y hQt hPpt hSmt + literal + have h : TouchingTriple (Q 1 true) (P 1 true) (S 2 false) := by + refine literal _ _ _ ((GaussianQuarterTurn^[1]) (BandVectors.1 (t 1) (t 0))) + hQt hPpt ?_ (hT4t _ _ 1 hQt hSmt ?_) + · apply Prod.ext <;> + simp [ht10, GaussianRealPoint, GaussianQuarterTurn] + · linarith only [p0x, q1x, p1x] + · linarith only [p0y, q1y, p1y] + · apply Prod.ext <;> + simp [ht10, ht01, GaussianRealPoint, GaussianQuarterTurn, I, + ] + · linarith only [p0x, m0x, q1x, s2x] + · linarith only [p0y, m0y, q1y, s2y] + exact ((TouchingTriplePermutations _ _ _).mp h).1 + +private theorem cross2 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (t : Fin (4 : ℕ) → CircleCoordinates), (∀ (T₀ + : ProtoTile), ∀ (T₁ : ProtoTile), ∀ (s : Fin (4 : ℕ)), BandPrototile (t (0 : Fin (4 : + ℕ))) T₀ → BandPrototile (t (1 : Fin (4 : ℕ))) T₁ → TileCentroid T₁ - TileCentroid T₀ + = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (t + (1 : Fin (4 : ℕ))) (t (0 : Fin (4 : ℕ))))) + GaussianRealPoint + (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (t (0 : Fin (4 : ℕ))) (t (1 : Fin (4 : + ℕ)))))) → TouchingTriple T₀ (TileTranslation T₀ (GaussianQuarterTurn^[(↑s : ℕ)] + (BandVectors.1 (t (1 : Fin (4 : ℕ))) (t (0 : Fin (4 : ℕ)))))) T₁) → (∀ (x : ℝ × ℝ), ∀ + (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : + Fin (3 : ℕ) → Bool → ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + (BandVectors.1 (t 1) (t 0) = a) → ((BandVectors.1 (t 0) (t 1) = I * a) → (((TileCentroid + (P (0 : Fin (3 : ℕ)) true)).1 - x.1 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : + GaussianInt → ℂ) a).re + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)) → + (((TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 - x.2 = (2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) a).re)) → (((TileCentroid (P (0 : Fin (3 : ℕ)) false)).1 - x.1 = + -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → (((TileCentroid (P (0 : Fin (3 + : ℕ)) false)).2 - x.2 = -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) + a).im - ((GaussianInt.toComplex : GaussianInt → ℂ) a).re))) → (((TileCentroid (P (1 : + Fin (3 : ℕ)) false)).1 - x.1 = -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → + ℂ) b).re + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im))) → (((TileCentroid (P + (1 : Fin (3 : ℕ)) false)).2 - x.2 = -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : + GaussianInt → ℂ) b).im - ((GaussianInt.toComplex : GaussianInt → ℂ) b).re))) → + (((TileCentroid (Q (2 : Fin (3 : ℕ)) true)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) + true)).1 = (2 : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re + -((GaussianInt.toComplex : + GaussianInt → ℂ) a).im - (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re + + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im + ((GaussianInt.toComplex : + GaussianInt → ℂ) a).im)))) → (((TileCentroid (Q (2 : Fin (3 : ℕ)) true)).2 - + (TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 = (2 : ℝ)⁻¹ * (-((GaussianInt.toComplex : + GaussianInt → ℂ) a).im - ((GaussianInt.toComplex : GaussianInt → ℂ) b).im + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re - (-((GaussianInt.toComplex : + GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + -((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → (((TileCentroid (S (1 : Fin (3 + : ℕ)) false)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) false)).1 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + ((GaussianInt.toComplex : + GaussianInt → ℂ) a).im - (((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im)))) → (((TileCentroid (S (1 : Fin (3 + : ℕ)) false)).2 - (TileCentroid (P (0 : Fin (3 : ℕ)) false)).2 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) a).re - (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)))) → ((BandPrototile (t 0) (S 1 + false)) → ((BandPrototile (t 0) (P 1 false)) → ((BandPrototile (t 1) (Q 2 true)) → + ((∀ (X : ProtoTile), ∀ (X' : ProtoTile), ∀ (Y : ProtoTile), ∀ (z : GaussianInt), + (BandPrototile (t 0) X) → ((BandPrototile (t 0) X') → ((TileCentroid X' - + TileCentroid X = GaussianRealPoint z) → ((TouchingTriple X (TileTranslation X z) Y) → + (TouchingTriple X X' Y))))) → (TouchingTriple (Q 2 true) (S 1 false) (P 1 + false)))))))))))))))))) + ) := by + classical + intro q t hT4t x P Q S I a b ht10 ht01 p0x p0y m0x m0y m1x m1y q2x q2y s1x s1y hSt hPmt hQpt + literal + have h : TouchingTriple (S 1 false) (P 1 false) (Q 2 true) := by + refine literal _ _ _ ((GaussianQuarterTurn^[3]) (BandVectors.1 (t 1) (t 0))) + hSt hPmt ?_ (hT4t _ _ 3 hSt hQpt ?_) + · apply Prod.ext <;> + simp [ht10, GaussianRealPoint, GaussianQuarterTurn, Function.iterate_succ_apply] + · linarith only [m0x, s1x, m1x] + · linarith only [m0y, s1y, m1y] + · apply Prod.ext <;> + simp [ht10, ht01, GaussianRealPoint, GaussianQuarterTurn, I, + Function.iterate_succ_apply] + · linarith only [p0x, m0x, q2x, s1x] + · linarith only [p0y, m0y, q2y, s1y] + exact ((TouchingTriplePermutations _ _ _).mp h).2.2.2.1 + +private theorem cross3 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (t : Fin (4 : ℕ) → CircleCoordinates), (∀ (T₀ + : ProtoTile), ∀ (T₁ : ProtoTile), ∀ (s : Fin (4 : ℕ)), BandPrototile (t (0 : Fin (4 : + ℕ))) T₀ → BandPrototile (t (1 : Fin (4 : ℕ))) T₁ → TileCentroid T₁ - TileCentroid T₀ + = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (t + (1 : Fin (4 : ℕ))) (t (0 : Fin (4 : ℕ))))) + GaussianRealPoint + (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (t (0 : Fin (4 : ℕ))) (t (1 : Fin (4 : + ℕ)))))) → TouchingTriple T₀ (TileTranslation T₀ (GaussianQuarterTurn^[(↑s : ℕ)] + (BandVectors.1 (t (1 : Fin (4 : ℕ))) (t (0 : Fin (4 : ℕ)))))) T₁) → (∀ (x : ℝ × ℝ), ∀ + (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + (BandVectors.1 (t 1) (t 0) = a) → ((BandVectors.1 (t 0) (t 1) = I * a) → (((TileCentroid + (P (0 : Fin (3 : ℕ)) true)).1 - x.1 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : + GaussianInt → ℂ) a).re + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)) → + (((TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 - x.2 = (2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) a).re)) → (((TileCentroid (P (1 : Fin (3 : ℕ)) true)).1 - x.1 = (2 : + ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + ((GaussianInt.toComplex : + GaussianInt → ℂ) b).im)) → (((TileCentroid (P (1 : Fin (3 : ℕ)) true)).2 - x.2 = (2 : + ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) b).re)) → (((TileCentroid (P (2 : Fin (3 : ℕ)) false)).1 - x.1 = + -((2 : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re - (((GaussianInt.toComplex : + GaussianInt → ℂ) b).im + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)))) → + (((TileCentroid (P (2 : Fin (3 : ℕ)) false)).2 - x.2 = -((2 : ℝ)⁻¹ * + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) b).im - (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re)))) → (((TileCentroid (Q (1 : Fin (3 + : ℕ)) true)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) true)).1 = (2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + ((GaussianInt.toComplex : + GaussianInt → ℂ) a).im - (((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im))) → (((TileCentroid (Q (1 : Fin (3 + : ℕ)) true)).2 - (TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 = (2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) a).re - (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → ((BandPrototile (t 0) (Q 1 + true)) → ((BandPrototile (t 0) (P 1 true)) → ((BandPrototile (t 1) (P 2 false)) → ((∀ + (X : ProtoTile), ∀ (X' : ProtoTile), ∀ (Y : ProtoTile), ∀ (z : GaussianInt), + (BandPrototile (t 0) X) → ((BandPrototile (t 0) X') → ((TileCentroid X' - + TileCentroid X = GaussianRealPoint z) → ((TouchingTriple X (TileTranslation X z) Y) → + (TouchingTriple X X' Y))))) → (TouchingTriple (Q 1 true) (P 1 true) (P 2 + false)))))))))))))))) + ) := by + classical + intro q t hT4t x P Q I a b ht10 ht01 p0x p0y p1x p1y m2x m2y q1x q1y hQt hPpt hP2mt literal + have h : TouchingTriple (P 1 true) (Q 1 true) (P 2 false) := by + refine literal _ _ _ ((GaussianQuarterTurn^[3]) (BandVectors.1 (t 1) (t 0))) + hPpt hQt ?_ (hT4t _ _ 3 hPpt hP2mt ?_) + · apply Prod.ext <;> + simp [ht10, GaussianRealPoint, GaussianQuarterTurn, Function.iterate_succ_apply] + · linarith only [p0x, q1x, p1x] + · linarith only [p0y, q1y, p1y] + · apply Prod.ext <;> + simp [ht10, ht01, GaussianRealPoint, GaussianQuarterTurn, I, + Function.iterate_succ_apply] + · linarith only [p1x, m2x] + · linarith only [p1y, m2y] + exact ((TouchingTriplePermutations _ _ _).mp h).2.1 + +private theorem cross4 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (t : Fin (4 : ℕ) → CircleCoordinates), (∀ (T₀ + : ProtoTile), ∀ (T₁ : ProtoTile), ∀ (s : Fin (4 : ℕ)), BandPrototile (t (0 : Fin (4 : + ℕ))) T₀ → BandPrototile (t (1 : Fin (4 : ℕ))) T₁ → TileCentroid T₁ - TileCentroid T₀ + = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (t + (1 : Fin (4 : ℕ))) (t (0 : Fin (4 : ℕ))))) + GaussianRealPoint + (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (t (0 : Fin (4 : ℕ))) (t (1 : Fin (4 : + ℕ)))))) → TouchingTriple T₀ (TileTranslation T₀ (GaussianQuarterTurn^[(↑s : ℕ)] + (BandVectors.1 (t (1 : Fin (4 : ℕ))) (t (0 : Fin (4 : ℕ)))))) T₁) → (∀ (x : ℝ × ℝ), ∀ + (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + (BandVectors.1 (t 1) (t 0) = a) → ((BandVectors.1 (t 0) (t 1) = I * a) → (((TileCentroid + (P (0 : Fin (3 : ℕ)) false)).1 - x.1 = -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : + GaussianInt → ℂ) a).re + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → + (((TileCentroid (P (0 : Fin (3 : ℕ)) false)).2 - x.2 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) a).re))) → (((TileCentroid (P (1 : Fin (3 : ℕ)) false)).1 - x.1 = + -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im))) → (((TileCentroid (P (1 : Fin (3 + : ℕ)) false)).2 - x.2 = -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) + b).im - ((GaussianInt.toComplex : GaussianInt → ℂ) b).re))) → (((TileCentroid (P (2 : + Fin (3 : ℕ)) true)).1 - x.1 = (2 : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → + ℂ) a).re - ((GaussianInt.toComplex : GaussianInt → ℂ) b).re - + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im + ((GaussianInt.toComplex : + GaussianInt → ℂ) a).im))) → (((TileCentroid (P (2 : Fin (3 : ℕ)) true)).2 - x.2 = (2 + : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex + : GaussianInt → ℂ) b).im - (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re))) → (((TileCentroid (S (1 : Fin (3 + : ℕ)) false)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) false)).1 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + ((GaussianInt.toComplex : + GaussianInt → ℂ) a).im - (((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im)))) → (((TileCentroid (S (1 : Fin (3 + : ℕ)) false)).2 - (TileCentroid (P (0 : Fin (3 : ℕ)) false)).2 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) a).re - (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)))) → ((BandPrototile (t 0) (S 1 + false)) → ((BandPrototile (t 0) (P 1 false)) → ((BandPrototile (t 1) (P 2 true)) → + ((∀ (X : ProtoTile), ∀ (X' : ProtoTile), ∀ (Y : ProtoTile), ∀ (z : GaussianInt), + (BandPrototile (t 0) X) → ((BandPrototile (t 0) X') → ((TileCentroid X' - + TileCentroid X = GaussianRealPoint z) → ((TouchingTriple X (TileTranslation X z) Y) → + (TouchingTriple X X' Y))))) → (TouchingTriple (S 1 false) (P 1 false) (P 2 + true)))))))))))))))) + ) := by + classical + intro q t hT4t x P S I a b ht10 ht01 m0x m0y m1x m1y p2x p2y s1x s1y hSt hPmt hP2pt literal + have h : TouchingTriple (P 1 false) (S 1 false) (P 2 true) := by + refine literal _ _ _ ((GaussianQuarterTurn^[1]) (BandVectors.1 (t 1) (t 0))) + hPmt hSt ?_ (hT4t _ _ 1 hPmt hP2pt ?_) + · apply Prod.ext <;> + simp [ht10, GaussianRealPoint, GaussianQuarterTurn] + · linarith only [m0x, s1x, m1x] + · linarith only [m0y, s1y, m1y] + · apply Prod.ext <;> + simp [ht10, ht01, GaussianRealPoint, GaussianQuarterTurn, I, + ] + · linarith only [m1x, p2x] + · linarith only [m1y, p2y] + exact ((TouchingTriplePermutations _ _ _).mp h).2.1 + +private theorem precursors : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), (Fin (4 + : ℕ) → CircleCoordinates) → ((ProperBandQuadruple q) → ((ProperBandQuadruple r) → ((r + (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ))) → ((r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : + ℕ))) → (((q (2 : Fin (4 : ℕ))).1 < (q (1 : Fin (4 : ℕ))).1) → (((4 : ℤ) ≤ (q (2 : Fin + (4 : ℕ))).1) → (∀ (x : ℝ × ℝ), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 + : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), BandPrototile (r i.succ) (Q i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), BandPrototile (r i.succ) (S i s)) → ((∀ (p : Fin 4 → CircleCoordinates), + (ProperBandQuadruple p) → ((Int.toNat (p 0).1 < Int.toNat (q 0).1) → (∀ (n : Nat), ∀ + (T : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (p 0) T → + BandPrototile (p 2) U → BandPrototile (p 3) V → TileCentroid U - TileCentroid T = (1 + / 2 : Real) • (GaussianRealPoint ((GaussianQuarterTurn^[n]) (BandVectors.1 (p 2) (p + 0))) + GaussianRealPoint ((GaussianQuarterTurn^[n]) (BandVectors.1 (p 0) (p 2)))) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint + ((GaussianQuarterTurn^[n]) (BandVectors.1 (p 3) (p 0))) - GaussianRealPoint + ((GaussianQuarterTurn^[n]) (BandVectors.1 (p 0) (p 3)))) → TouchingTriple T U V))) → ( + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + let c := BandVectors.1 (q 2) (q 1) + let d := BandVectors.1 (r 1) (r 3) + let e := BandVectors.1 (r 2) (r 1) + (c = -a - b) → ((BandVectors.1 (r 3) (r 2) = a) → ((e = c + I * a) → ((d = b - I * a) → + ((∀ (z : GaussianInt), ∀ (w : GaussianInt), (z = I * w) → (w = -I * z)) → + (((TileCentroid (P (0 : Fin (3 : ℕ)) true)).1 - x.1 = (2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + ((GaussianInt.toComplex : + GaussianInt → ℂ) a).im)) → (((TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 - x.2 = (2 : + ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) a).re)) → (((TileCentroid (P (0 : Fin (3 : ℕ)) false)).1 - x.1 = + -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → (((TileCentroid (P (0 : Fin (3 + : ℕ)) false)).2 - x.2 = -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) + a).im - ((GaussianInt.toComplex : GaussianInt → ℂ) a).re))) → (((TileCentroid (Q (0 : + Fin (3 : ℕ)) false)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) true)).1 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + ((GaussianInt.toComplex : + GaussianInt → ℂ) a).im))) → (((TileCentroid (Q (0 : Fin (3 : ℕ)) false)).2 - + (TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 = -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex + : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex : GaussianInt → ℂ) a).re))) → + (((TileCentroid (Q (1 : Fin (3 : ℕ)) true)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) + true)).1 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im - (((GaussianInt.toComplex : + GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : GaussianInt → ℂ) b).im))) → + (((TileCentroid (Q (1 : Fin (3 : ℕ)) true)).2 - (TileCentroid (P (0 : Fin (3 : ℕ)) + true)).2 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re - (((GaussianInt.toComplex : + GaussianInt → ℂ) b).re + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → + (((TileCentroid (Q (2 : Fin (3 : ℕ)) true)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) + true)).1 = (2 : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re + -((GaussianInt.toComplex : + GaussianInt → ℂ) a).im - (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re + + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im + ((GaussianInt.toComplex : + GaussianInt → ℂ) a).im)))) → (((TileCentroid (Q (2 : Fin (3 : ℕ)) true)).2 - + (TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 = (2 : ℝ)⁻¹ * (-((GaussianInt.toComplex : + GaussianInt → ℂ) a).im - ((GaussianInt.toComplex : GaussianInt → ℂ) b).im + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re - (-((GaussianInt.toComplex : + GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + -((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → (((TileCentroid (S (1 : Fin (3 + : ℕ)) false)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) false)).1 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + ((GaussianInt.toComplex : + GaussianInt → ℂ) a).im - (((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im)))) → (((TileCentroid (S (1 : Fin (3 + : ℕ)) false)).2 - (TileCentroid (P (0 : Fin (3 : ℕ)) false)).2 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) a).re - (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)))) → (((TileCentroid (S (2 : Fin (3 + : ℕ)) false)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) false)).1 = -((2 : ℝ)⁻¹ * + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : + GaussianInt → ℂ) b).re + -((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re + (((GaussianInt.toComplex : + GaussianInt → ℂ) b).im + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))))) → + (((TileCentroid (S (2 : Fin (3 : ℕ)) false)).2 - (TileCentroid (P (0 : Fin (3 : ℕ)) + false)).2 = -((2 : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im + ((GaussianInt.toComplex : + GaussianInt → ℂ) a).re - (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re + -((GaussianInt.toComplex : + GaussianInt → ℂ) a).im)))) → (TouchingTriple (Q 1 true) (S 2 false) (Q 0 false) ∧ + TouchingTriple (Q 2 true) (S 1 false) (Q 0 false)))))))))))))))))))))))))))))) + ) := by + classical + intro q r t hq hr hr0 hr2 h12 h2four x P Q S hQ hS rotatedT5 I a b c d e hc hr32 he hd inverse + p0x p0y m0x m0y q0x q0y q1x q1y q2x q2y s1x s1y s2x s2y + have rsmall (j : Fin 3) : Int.toNat (r j.succ).1 < Int.toNat (q 0).1 := by + have hn := (SemiProperForestClassification r hr.1).1 j.succ + have hl := hr.2 j + have hq1 := hq.2 0 + change (q 1).1 < (q 0).1 at hq1 + rw [hr0] at hl + omega + rcases BandParentBoundaryGenealogy r hr with roots | first | second | third + · rcases roots with ⟨_, hz, _⟩ | ⟨_, hz, _⟩ | ⟨_, hz, _⟩ <;> + rw [hr2] at hz <;> omega + · obtain ⟨p, hp, _, hp0, hp2, hp3, _, _⟩ := first + have small : Int.toNat (p 0).1 < Int.toNat (q 0).1 := by + simpa [hp0] using rsmall 0 + have v20 : BandVectors.1 (p 2) (p 0) = e := by rw [hp2, hp0] + have v02 : BandVectors.1 (p 0) (p 2) = I * e := by + have h := ((VectorRecursionLaws p hp.1).2.2.2.2 hp 1).1 + change BandVectors.1 (p 0) (p 2) = I * BandVectors.1 (p 2) (p 0) at h + simpa only [v20] using h + have v03 : BandVectors.1 (p 0) (p 3) = d := by rw [hp0, hp3] + have v30 : BandVectors.1 (p 3) (p 0) = -I * d := by + have h := ((VectorRecursionLaws p hp.1).2.2.2.2 hp 2).1 + change BandVectors.1 (p 0) (p 3) = I * BandVectors.1 (p 3) (p 0) at h + exact inverse _ _ (v03.symm.trans h) + have h0 : BandPrototile (p 0) (Q 0 false) := by + simpa [hp0] using hQ 0 false + have h2q : BandPrototile (p 2) (Q 1 true) := by + simpa [hp2] using hQ 1 true + have h2s : BandPrototile (p 2) (S 1 false) := by + simpa [hp2] using hS 1 false + have h3q : BandPrototile (p 3) (Q 2 true) := by + simpa [hp3] using hQ 2 true + have h3s : BandPrototile (p 3) (S 2 false) := by + simpa [hp3] using hS 2 false + have one : TouchingTriple (Q 0 false) (Q 1 true) (S 2 false) := by + apply rotatedT5 p hp small 1 _ _ _ h0 h2q h3s + · apply Prod.ext <;> + simp [v20, v02, he, hc, I, GaussianRealPoint, GaussianQuarterTurn, + ] + · linarith only [p0x, q0x, q1x] + · linarith only [p0y, q0y, q1y] + · apply Prod.ext <;> + simp [v30, v03, hd, I, GaussianRealPoint, GaussianQuarterTurn, + ] + · linarith only [p0x, m0x, q0x, s2x] + · linarith only [p0y, m0y, q0y, s2y] + have three : TouchingTriple (Q 0 false) (S 1 false) (Q 2 true) := by + apply rotatedT5 p hp small 3 _ _ _ h0 h2s h3q + · apply Prod.ext <;> + simp [v20, v02, he, hc, I, GaussianRealPoint, GaussianQuarterTurn, + Function.iterate_succ_apply] + · linarith only [p0x, m0x, q0x, s1x] + · linarith only [p0y, m0y, q0y, s1y] + · apply Prod.ext <;> + simp [v30, v03, hd, I, GaussianRealPoint, GaussianQuarterTurn, + Function.iterate_succ_apply] + · linarith only [p0x, q0x, q2x] + · linarith only [p0y, q0y, q2y] + exact ⟨((TouchingTriplePermutations _ _ _).mp one).2.2.1, + ((TouchingTriplePermutations _ _ _).mp three).2.2.2.2⟩ + · obtain ⟨p, hp, _, hp0, hp2, hp3, _, _⟩ := second + have small : Int.toNat (p 0).1 < Int.toNat (q 0).1 := by + simpa [hp0] using rsmall 1 + have v20 : BandVectors.1 (p 2) (p 0) = a := by rw [hp2, hp0, hr32] + have v02 : BandVectors.1 (p 0) (p 2) = I * a := by + have h := ((VectorRecursionLaws p hp.1).2.2.2.2 hp 1).1 + change BandVectors.1 (p 0) (p 2) = I * BandVectors.1 (p 2) (p 0) at h + simpa only [v20] using h + have v03 : BandVectors.1 (p 0) (p 3) = e := by rw [hp0, hp3] + have v30 : BandVectors.1 (p 3) (p 0) = -I * e := by + have h := ((VectorRecursionLaws p hp.1).2.2.2.2 hp 2).1 + change BandVectors.1 (p 0) (p 3) = I * BandVectors.1 (p 3) (p 0) at h + exact inverse _ _ (v03.symm.trans h) + have h0q : BandPrototile (p 0) (Q 1 true) := by + simpa [hp0] using hQ 1 true + have h0s : BandPrototile (p 0) (S 1 false) := by + simpa [hp0] using hS 1 false + have h2s : BandPrototile (p 2) (S 2 false) := by + simpa [hp2] using hS 2 false + have h2q : BandPrototile (p 2) (Q 2 true) := by + simpa [hp2] using hQ 2 true + have h3 : BandPrototile (p 3) (Q 0 false) := by + simpa [hp3] using hQ 0 false + have one : TouchingTriple (Q 1 true) (S 2 false) (Q 0 false) := by + apply rotatedT5 p hp small 1 _ _ _ h0q h2s h3 + · apply Prod.ext <;> + simp [v20, v02, I, GaussianRealPoint, GaussianQuarterTurn, + ] + · linarith only [p0x, m0x, q1x, s2x] + · linarith only [p0y, m0y, q1y, s2y] + · apply Prod.ext <;> + simp [v30, v03, he, hc, I, GaussianRealPoint, GaussianQuarterTurn, + ] + · linarith only [q0x, q1x] + · linarith only [q0y, q1y] + have three : TouchingTriple (S 1 false) (Q 2 true) (Q 0 false) := by + apply rotatedT5 p hp small 3 _ _ _ h0s h2q h3 + · apply Prod.ext <;> + simp [v20, v02, I, GaussianRealPoint, GaussianQuarterTurn, + Function.iterate_succ_apply] + · linarith only [p0x, m0x, s1x, q2x] + · linarith only [p0y, m0y, s1y, q2y] + · apply Prod.ext <;> + simp [v30, v03, he, hc, I, GaussianRealPoint, GaussianQuarterTurn, + Function.iterate_succ_apply] + · linarith only [p0x, m0x, q0x, s1x] + · linarith only [p0y, m0y, q0y, s1y] + exact ⟨one, ((TouchingTriplePermutations _ _ _).mp three).2.1⟩ + · obtain ⟨p, hp, _, hp0, hp2, hp3, _, _⟩ := third + have small : Int.toNat (p 0).1 < Int.toNat (q 0).1 := by + simpa [hp0] using rsmall 2 + have v20 : BandVectors.1 (p 2) (p 0) = d := by rw [hp2, hp0] + have v02 : BandVectors.1 (p 0) (p 2) = I * d := by + have h := ((VectorRecursionLaws p hp.1).2.2.2.2 hp 1).1 + change BandVectors.1 (p 0) (p 2) = I * BandVectors.1 (p 2) (p 0) at h + simpa only [v20] using h + have v03 : BandVectors.1 (p 0) (p 3) = a := by rw [hp0, hp3, hr32] + have v30 : BandVectors.1 (p 3) (p 0) = -I * a := by + have h := ((VectorRecursionLaws p hp.1).2.2.2.2 hp 2).1 + change BandVectors.1 (p 0) (p 3) = I * BandVectors.1 (p 3) (p 0) at h + exact inverse _ _ (v03.symm.trans h) + have h0s : BandPrototile (p 0) (S 2 false) := by + simpa [hp0] using hS 2 false + have h0q : BandPrototile (p 0) (Q 2 true) := by + simpa [hp0] using hQ 2 true + have h2 : BandPrototile (p 2) (Q 0 false) := by + simpa [hp2] using hQ 0 false + have h3q : BandPrototile (p 3) (Q 1 true) := by + simpa [hp3] using hQ 1 true + have h3s : BandPrototile (p 3) (S 1 false) := by + simpa [hp3] using hS 1 false + have one : TouchingTriple (S 2 false) (Q 0 false) (Q 1 true) := by + apply rotatedT5 p hp small 1 _ _ _ h0s h2 h3q + · apply Prod.ext <;> + simp [v20, v02, hd, I, GaussianRealPoint, GaussianQuarterTurn, + ] + · linarith only [p0x, m0x, q0x, s2x] + · linarith only [p0y, m0y, q0y, s2y] + · apply Prod.ext <;> + simp [v30, v03, I, GaussianRealPoint, GaussianQuarterTurn, + ] + · linarith only [p0x, m0x, q1x, s2x] + · linarith only [p0y, m0y, q1y, s2y] + have three : TouchingTriple (Q 2 true) (Q 0 false) (S 1 false) := by + apply rotatedT5 p hp small 3 _ _ _ h0q h2 h3s + · apply Prod.ext <;> + simp [v20, v02, hd, I, GaussianRealPoint, GaussianQuarterTurn, + Function.iterate_succ_apply] + · linarith only [q0x, q2x] + · linarith only [q0y, q2y] + · apply Prod.ext <;> + simp [v30, v03, I, GaussianRealPoint, GaussianQuarterTurn, + Function.iterate_succ_apply] + · linarith only [p0x, m0x, q2x, s1x] + · linarith only [p0y, m0y, q2y, s1y] + exact ⟨((TouchingTriplePermutations _ _ _).mp one).2.2.2.1, + ((TouchingTriplePermutations _ _ _).mp three).1⟩ + +end DoubleDecompositionProof + +theorem BandDoubleDecomposition : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin 4 → CircleCoordinates), ∀ (t : Fin 4 → + CircleCoordinates), (ProperBandQuadruple q) → ((ProperBandQuadruple r) → + ((ProperBandQuadruple t) → ((r 0 = q 1) → ((r 2 = q 2) → ((r 3 = q 3) → ((t 0 = q 2) → + ((t 1 = q 3) → (((q 2).1 < (q 1).1) → ((4 ≤ (q 2).1) → (((q 3).1 ≤ (q 2).1) → (((t 0).1 < + (q 0).1) → ((∀ (D : CircleCoordinates), ∀ (U : ProtoTile), BandPrototile D U → Int.toNat + D.1 < Int.toNat (q 0).1 → + QuarterTurnSymmetric U) → ((∀ (q' : Fin 4 → CircleCoordinates), ∀ (T' : ProtoTile), ∀ (U : + ProtoTile), ∀ (V : ProtoTile), ProperBandQuadruple q' → + BandPrototile (q' 0) T' → + Int.toNat (q' 0).1 < Int.toNat (q 0).1 → + ∀ i : Fin 3, BandPrototile (q' i.succ) U → + BandPrototile (q' ((i + 1).succ)) V → + TileCentroid U - TileCentroid T' = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q' i.succ) (q' 0)) + + GaussianRealPoint (BandVectors.1 (q' 0) (q' i.succ))) → + TileCentroid V - TileCentroid T' = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q' ((i + 1).succ)) (q' 0)) - + GaussianRealPoint (BandVectors.1 (q' 0) (q' ((i + 1).succ)))) → + TouchingTriple T' U V) → ((∀ (T₀ : ProtoTile), ∀ (T₁ : ProtoTile), ∀ (s : Fin 4), + BandPrototile (t 0) T₀ → BandPrototile (t 1) T₁ → + TileCentroid T₁ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (t 1) (t 0))) + + GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (t 0) (t 1)))) → + TouchingTriple T₀ + (TileTranslation T₀ + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (t 1) (t 0)))) T₁) → (∀ (x : Real × Real), ∀ (P : Fin 3 → Bool → + ProtoTile), ∀ (Q : Fin 3 → Bool → ProtoTile), ∀ (S : Fin 3 → Bool → ProtoTile), + (∀ i, ∀ s, BandPrototile (q i.succ) (P i s)) → ((∀ i, ∀ s, BandPrototile (r + i.succ) (Q i s)) → ((∀ i, ∀ s, BandPrototile (r i.succ) (S i s)) → ((∀ i, ∀ s, + TileCentroid (P i s) - x = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1)))) → ((∀ i, ∀ s, TileCentroid (Q i s) - TileCentroid + (P 0 true) = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) (r ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) + (r ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) + (r ((i + 1).succ)))).1)))) → ((∀ i, ∀ s, TileCentroid (S i s) - TileCentroid + (P 0 false) = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) (r ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) + (r ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) + (r ((i + 1).succ)))).1)))) → ((Q 0 false).cells = (S 0 true).cells ∧ + ((Q 0 false).cells = ∅ → (Q 0 false).anchor = (S 0 true).anchor) ∧ + TouchingTriple (Q 1 true) (S 2 false) (Q 0 false) ∧ + TouchingTriple (Q 2 true) (S 1 false) (Q 0 false) ∧ + TouchingTriple (Q 1 true) (S 2 false) (P 1 true) ∧ + TouchingTriple (Q 2 true) (S 1 false) (P 1 false) ∧ + TouchingTriple (Q 1 true) (P 1 true) (P 2 false) ∧ + TouchingTriple (S 1 false) (P 1 false) (P 2 true)))))))))))))))))))))) := by + intro q r t hq hr ht hr0 hr2 hr3 ht0 ht1 h12 h2four h23 htlt hT2 hT5 hT4t x P Q S hP hQ hS + hPcent hQcent hScent +-- BODY + have observable (T U X Y : ProtoTile) (he : T.cells = U.cells) + (ha : T.cells = ∅ → T.anchor = U.anchor) : + TouchingTriple X T Y ↔ TouchingTriple X U Y := DoubleDecompositionProof.observable T U X Y + he ha + have preimage (C : CircleCoordinates) (W : ProtoTile) + (hW : BandPrototile C W) (hs : QuarterTurnSymmetric W) : + ∃ W' : ProtoTile, BandPrototile C W' ∧ + (TileQuarterTurn W').cells = W.cells ∧ + ((TileQuarterTurn W').cells = ∅ → + (TileQuarterTurn W').anchor = W.anchor) ∧ + TileCentroid (TileQuarterTurn W') = TileCentroid W := DoubleDecompositionProof.preimage C + W hW hs + -- Smaller T5 is transported through translated quarter-turn preimages. + have rotatedT5 (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (hsmall : Int.toNat (p 0).1 < Int.toNat (q 0).1) : + ∀ (n : Nat) (T U V : ProtoTile), BandPrototile (p 0) T → + BandPrototile (p 2) U → BandPrototile (p 3) V → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint ((GaussianQuarterTurn^[n]) + (BandVectors.1 (p 2) (p 0))) + + GaussianRealPoint ((GaussianQuarterTurn^[n]) + (BandVectors.1 (p 0) (p 2)))) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint ((GaussianQuarterTurn^[n]) + (BandVectors.1 (p 3) (p 0))) - + GaussianRealPoint ((GaussianQuarterTurn^[n]) + (BandVectors.1 (p 0) (p 3)))) → TouchingTriple T U V := + DoubleDecompositionProof.rotatedT5 q t hT2 hT5 observable preimage p hp hsmall + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + let c := BandVectors.1 (q 2) (q 1) + let d := BandVectors.1 (r 1) (r 3) + let e := BandVectors.1 (r 2) (r 1) + have hsum := (VectorRecursionLaws q hq.1).1 + have hc : c = -a - b := by + change a + b + c = 0 at hsum + calc + c = (a + b + c) - a - b := by ring + _ = -a - b := by rw [hsum]; ring + have hr32 : BandVectors.1 (r 3) (r 2) = a := by rw [hr3, hr2] + have he : e = c + I * a := by + have h := (VectorRecursionLaws _ (SemiProperQuadruple.rotate hr.1)).2.2.1 + change BandVectors.1 (r 2) (r 0) = e - I * BandVectors.1 (r 3) (r 2) at h + rw [hr32, hr2, hr0] at h + change c = e - I * a at h + rw [h] + ring + have hd : d = b - I * a := DoubleDecompositionProof.hd q r hr hr0 hr3 hr32 + have ht10 : BandVectors.1 (t 1) (t 0) = a := by rw [ht1, ht0] + have ht01 : BandVectors.1 (t 0) (t 1) = I * a := by + have h := ((VectorRecursionLaws t ht.1).2.2.2.2 ht 0).1 + change BandVectors.1 (t 0) (t 1) = I * BandVectors.1 (t 1) (t 0) at h + simpa only [ht10] using h + have inverse (z w : GaussianInt) (h : z = I * w) : w = -I * z := by + rw [h] + ext <;> simp [I] + have cp0 := hPcent 0 true + have cm0 := hPcent 0 false + have cp1 := hPcent 1 true + have cm1 := hPcent 1 false + have cp2 := hPcent 2 true + have cm2 := hPcent 2 false + have cq0 := hQcent 0 false + have cs0 := hScent 0 true + have cq1 := hQcent 1 true + have cq2 := hQcent 2 true + have cs1 := hScent 1 false + have cs2 := hScent 2 false + change TileCentroid (P 0 true) - x = (1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint a - (-(GaussianRealPoint a).2, (GaussianRealPoint a).1))) at cp0 + change TileCentroid (P 0 false) - x = (-1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint a - (-(GaussianRealPoint a).2, (GaussianRealPoint a).1))) at cm0 + change TileCentroid (P 1 true) - x = (1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint b - (-(GaussianRealPoint b).2, (GaussianRealPoint b).1))) at cp1 + change TileCentroid (P 1 false) - x = (-1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint b - (-(GaussianRealPoint b).2, (GaussianRealPoint b).1))) at cm1 + change TileCentroid (P 2 true) - x = (1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint c - (-(GaussianRealPoint c).2, (GaussianRealPoint c).1))) at cp2 + change TileCentroid (P 2 false) - x = (-1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint c - (-(GaussianRealPoint c).2, (GaussianRealPoint c).1))) at cm2 + change TileCentroid (Q 0 false) - TileCentroid (P 0 true) = + (-1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (r 3) (r 2)) - + (-(GaussianRealPoint (BandVectors.1 (r 3) (r 2))).2, + (GaussianRealPoint (BandVectors.1 (r 3) (r 2))).1))) at cq0 + change TileCentroid (S 0 true) - TileCentroid (P 0 false) = + (1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (r 3) (r 2)) - + (-(GaussianRealPoint (BandVectors.1 (r 3) (r 2))).2, + (GaussianRealPoint (BandVectors.1 (r 3) (r 2))).1))) at cs0 + rw [hr32] at cq0 cs0 + change TileCentroid (Q 0 false) - TileCentroid (P 0 true) = + (-1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint a - (-(GaussianRealPoint a).2, (GaussianRealPoint a).1))) at cq0 + change TileCentroid (S 0 true) - TileCentroid (P 0 false) = + (1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint a - (-(GaussianRealPoint a).2, (GaussianRealPoint a).1))) at cs0 + change TileCentroid (Q 1 true) - TileCentroid (P 0 true) = + (1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint d - (-(GaussianRealPoint d).2, (GaussianRealPoint d).1))) at cq1 + change TileCentroid (Q 2 true) - TileCentroid (P 0 true) = + (1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint e - (-(GaussianRealPoint e).2, (GaussianRealPoint e).1))) at cq2 + change TileCentroid (S 1 false) - TileCentroid (P 0 false) = + (-1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint d - (-(GaussianRealPoint d).2, (GaussianRealPoint d).1))) at cs1 + change TileCentroid (S 2 false) - TileCentroid (P 0 false) = + (-1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint e - (-(GaussianRealPoint e).2, (GaussianRealPoint e).1))) at cs2 + have p0x := congrArg Prod.fst cp0 + have p0y := congrArg Prod.snd cp0 + have m0x := congrArg Prod.fst cm0 + have m0y := congrArg Prod.snd cm0 + have p1x := congrArg Prod.fst cp1 + have p1y := congrArg Prod.snd cp1 + have m1x := congrArg Prod.fst cm1 + have m1y := congrArg Prod.snd cm1 + have p2x := congrArg Prod.fst cp2 + have p2y := congrArg Prod.snd cp2 + have m2x := congrArg Prod.fst cm2 + have m2y := congrArg Prod.snd cm2 + have q0x := congrArg Prod.fst cq0 + have q0y := congrArg Prod.snd cq0 + have s0x := congrArg Prod.fst cs0 + have s0y := congrArg Prod.snd cs0 + have q1x := congrArg Prod.fst cq1 + have q1y := congrArg Prod.snd cq1 + have q2x := congrArg Prod.fst cq2 + have q2y := congrArg Prod.snd cq2 + have s1x := congrArg Prod.fst cs1 + have s1y := congrArg Prod.snd cs1 + have s2x := congrArg Prod.fst cs2 + have s2y := congrArg Prod.snd cs2 + simp? [GaussianRealPoint] at p0x p0y m0x m0y p1x p1y m1x m1y + simp? [GaussianRealPoint, hc] at p2x p2y m2x m2y q0x q0y s0x s0y + simp? [GaussianRealPoint, hd, he, hc, I] at q1x q1y q2x q2y s1x s1y s2x s2y + have qcenter : TileCentroid (Q 0 false) = x := by + apply Prod.ext + · linarith only [p0x, q0x] + · linarith only [p0y, q0y] + have scenter : TileCentroid (S 0 true) = x := by + apply Prod.ext + · linarith only [m0x, s0x] + · linarith only [m0y, s0y] + have common := BandPrototileCentroidUnique (r 1) (Q 0 false) (S 0 true) + (hQ 0 false) (hS 0 true) (qcenter.trans scenter.symm) + have hQt : BandPrototile (t 0) (Q 1 true) := by rw [ht0, ← hr2]; exact hQ 1 true + have hSt : BandPrototile (t 0) (S 1 false) := by rw [ht0, ← hr2]; exact hS 1 false + have hPpt : BandPrototile (t 0) (P 1 true) := by rw [ht0]; exact hP 1 true + have hPmt : BandPrototile (t 0) (P 1 false) := by rw [ht0]; exact hP 1 false + have hQpt : BandPrototile (t 1) (Q 2 true) := by rw [ht1, ← hr3]; exact hQ 2 true + have hSmt : BandPrototile (t 1) (S 2 false) := by rw [ht1, ← hr3]; exact hS 2 false + have hP2pt : BandPrototile (t 1) (P 2 true) := by rw [ht1]; exact hP 2 true + have hP2mt : BandPrototile (t 1) (P 2 false) := by rw [ht1]; exact hP 2 false + have literal (X X' Y : ProtoTile) (z : GaussianInt) + (hX : BandPrototile (t 0) X) (hX' : BandPrototile (t 0) X') + (hoff : TileCentroid X' - TileCentroid X = GaussianRealPoint z) + (h : TouchingTriple X (TileTranslation X z) Y) : TouchingTriple X X' Y := + DoubleDecompositionProof.literal t observable X X' Y z hX hX' hoff h + have cross1 : TouchingTriple (Q 1 true) (S 2 false) (P 1 true) := + DoubleDecompositionProof.cross1 q t hT4t x P Q S ht10 ht01 p0x p0y m0x m0y p1x p1y q1x q1y + s2x s2y hQt hPpt hSmt literal + have cross2 : TouchingTriple (Q 2 true) (S 1 false) (P 1 false) := + DoubleDecompositionProof.cross2 q t hT4t x P Q S ht10 ht01 p0x p0y m0x m0y m1x m1y q2x q2y + s1x s1y hSt hPmt hQpt literal + have cross3 : TouchingTriple (Q 1 true) (P 1 true) (P 2 false) := + DoubleDecompositionProof.cross3 q t hT4t x P Q ht10 ht01 p0x p0y p1x p1y m2x m2y q1x q1y + hQt hPpt hP2mt literal + have cross4 : TouchingTriple (S 1 false) (P 1 false) (P 2 true) := + DoubleDecompositionProof.cross4 q t hT4t x P S ht10 ht01 m0x m0y m1x m1y p2x p2y s1x s1y + hSt hPmt hP2pt literal + have precursors : TouchingTriple (Q 1 true) (S 2 false) (Q 0 false) ∧ + TouchingTriple (Q 2 true) (S 1 false) (Q 0 false) := DoubleDecompositionProof.precursors q + r t hq hr hr0 hr2 h12 h2four x P Q S hQ hS rotatedT5 hc hr32 he hd inverse p0x p0y m0x + m0y q0x q0y q1x q1y q2x q2y s1x s1y s2x s2y + exact ⟨common.1, common.2, precursors.1, precursors.2, cross1, cross2, cross3, cross4⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean b/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean new file mode 100644 index 0000000000..5337d34bdd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean @@ -0,0 +1,1584 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoreCertificate +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary +public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments +public import LeanPool.ApollonianSuperharmonic.ExceptionalRestorationSectorData +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: BandExceptionalRestorationSectorOrder] + +/-! +# BandExceptionalRestorationSectorOrder + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RestorationSectorGeometry + +private theorem tile_from_band : + (by + classical + exact + ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), BandPrototile c U → (0 < c.1 ∨ + U.cells.Nonempty) → LatticeTile U ) := by + classical + intro c U hU + induction hU with + | line w x hw => + intro h + rcases h with h | h + · simp at h + · simp at h + | unit z x anchor => + intro _ + have hgeom := (FordTileGeometry 1 (by norm_num)).1 + have htrans := (TileDiskAreaCovariance (FordTile 1) x).1.mp hgeom + have hcells : (TileTranslation (FordTile 1) x).cells = ({x} : Finset GaussianInt) := by + rw [(TileTranslationFormulas (FordTile 1) x).1] + simp [FordTile, FordCellDomain, GaussianTranslation, Zsqrtd.ext_iff] + have hcell : (⟨{x}, anchor⟩ : ProtoTile).cells = + (TileTranslation (FordTile 1) x).cells := by rw [hcells] + have hobs := ProtoTileObservableExtensionality _ _ hcell (by intro he; simp at he) + have hre : TileRealization (⟨{x}, anchor⟩ : ProtoTile) = + TileRealization (TileTranslation (FordTile 1) x) := hobs.2.2.2.1 + change TopologicalDisk (TileRealization (⟨{x}, anchor⟩ : ProtoTile)) + rw [hre] + exact htrans + | @decompose r hproper F W hF hcells hfoot hcentroid => + intro _ + exact (BandTileSimultaneousInduction r hproper W + (BandPrototile.decompose hproper hF hcells hfoot hcentroid)).1 + +private theorem hQ : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let Q := cert.Q 1 true + (∀ (c : CircleCoordinates), ∀ (U : ProtoTile), BandPrototile c U → (0 < c.1 ∨ + U.cells.Nonempty) → LatticeTile U) → (LatticeTile Q) ) := by + classical + intro q cfg C₀ T cert Q tile_from_band + have hocc := cert.plus_occurrence (1 : Fin 3) true + have hcurv := (ProperBandCurvatureStructure _ cfg.firstProper).2.1 1 + have hcoord : cfg.firstPredecessor 2 = q 2 := cfg.firstParentTwo + have hnonzero : (cfg.firstPredecessor 2).1 ≠ 0 := by rw [hcoord]; exact cfg.noLine 2 + have hpos : 0 < (cfg.firstPredecessor 2).1 := lt_of_le_of_ne hcurv (Ne.symm hnonzero) + exact tile_from_band (cfg.firstPredecessor (1 : Fin 3).succ) Q hocc.1 + (Or.inl (by simpa using hpos)) + +private theorem hS : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let S := cert.S 2 false + (∀ (c : CircleCoordinates), ∀ (U : ProtoTile), BandPrototile c U → (0 < c.1 ∨ + U.cells.Nonempty) → LatticeTile U) → (LatticeTile S) ) := by + classical + intro q cfg C₀ T cert S tile_from_band + have hocc := cert.minus_occurrence (2 : Fin 3) false + have hcurv := (ProperBandCurvatureStructure _ cfg.firstProper).2.1 2 + have hcoord : cfg.firstPredecessor 3 = q 3 := cfg.firstParentThree + have hnonzero : (cfg.firstPredecessor 3).1 ≠ 0 := by rw [hcoord]; exact cfg.noLine 3 + have hpos : 0 < (cfg.firstPredecessor 3).1 := lt_of_le_of_ne hcurv (Ne.symm hnonzero) + exact tile_from_band (cfg.firstPredecessor (2 : Fin 3).succ) S hocc.1 + (Or.inl (by simpa using hpos)) + +private theorem hR : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let R := cert.Q 2 true + (∀ (c : CircleCoordinates), ∀ (U : ProtoTile), BandPrototile c U → (0 < c.1 ∨ + U.cells.Nonempty) → LatticeTile U) → (LatticeTile R) ) := by + classical + intro q cfg C₀ T cert R tile_from_band + have hocc := cert.plus_occurrence (2 : Fin 3) true + have hcurv := (ProperBandCurvatureStructure _ cfg.firstProper).2.1 2 + have hcoord : cfg.firstPredecessor 3 = q 3 := cfg.firstParentThree + have hnonzero : (cfg.firstPredecessor 3).1 ≠ 0 := by rw [hcoord]; exact cfg.noLine 3 + have hpos : 0 < (cfg.firstPredecessor 3).1 := lt_of_le_of_ne hcurv (Ne.symm hnonzero) + exact tile_from_band (cfg.firstPredecessor (2 : Fin 3).succ) R hocc.1 + (Or.inl (by simpa using hpos)) + +private theorem hV : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let V := cert.S 1 false + (∀ (c : CircleCoordinates), ∀ (U : ProtoTile), BandPrototile c U → (0 < c.1 ∨ + U.cells.Nonempty) → LatticeTile U) → (LatticeTile V) ) := by + classical + intro q cfg C₀ T cert V tile_from_band + have hocc := cert.minus_occurrence (1 : Fin 3) false + have hcurv := (ProperBandCurvatureStructure _ cfg.firstProper).2.1 1 + have hcoord : cfg.firstPredecessor 2 = q 2 := cfg.firstParentTwo + have hnonzero : (cfg.firstPredecessor 2).1 ≠ 0 := by rw [hcoord]; exact cfg.noLine 2 + have hpos : 0 < (cfg.firstPredecessor 2).1 := lt_of_le_of_ne hcurv (Ne.symm hnonzero) + exact tile_from_band (cfg.firstPredecessor (1 : Fin 3).succ) V hocc.1 + (Or.inl (by simpa using hpos)) + +private theorem hO : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let O := cert.O + (∀ (c : CircleCoordinates), ∀ (U : ProtoTile), BandPrototile c U → (0 < c.1 ∨ + U.cells.Nonempty) → LatticeTile U) → (O.cells.Nonempty → LatticeTile O) ) := by + classical + intro q cfg C₀ T cert O tile_from_band hOne + have hocc := cert.plus_occurrence (0 : Fin 3) false + rw [← cert.precursor_eq] at hocc + exact tile_from_band (cfg.firstPredecessor (0 : Fin 3).succ) O hocc.1 (Or.inr hOne) + +private theorem nonempty_cells : + (by + classical + exact + ∀ (U : ProtoTile), (LatticeTile U) → (U.cells.Nonempty) ) := by + classical + intro U hU + rcases hU with ⟨hhome⟩ + let z : (Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) := + ⟨0, by simp [Metric.mem_closedBall]⟩ + have hreal : (TileRealization U).Nonempty := ⟨(hhome z).val, (hhome z).property⟩ + by_contra hn + have he : U.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hn + simp [TileRealization, he] at hreal + +private theorem touching_disjoint : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → ((Y.cells.Nonempty) → + ((TileTouching X Y) → (Disjoint X.cells Y.cells))) ) := by + classical + intro X Y hX hY hxy + rcases hxy with ⟨_, _, hd, _⟩ | ⟨he, _⟩ | ⟨he, _⟩ + · exact hd + · simp [he] at hX + · simp [he] at hY + +private theorem trzero : + (by + classical + exact + ∀ (Y : ProtoTile), TileTranslation Y 0 = Y ) := by + classical + intro Y + have hfun : GaussianTranslation 0 = id := by + funext z + simp [GaussianTranslation] + cases Y + simp [TileTranslation, hfun] + +private theorem htileComp : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let A := cert.P 0 true + let O := cert.O + (∀ (Y : ProtoTile), TileTranslation Y 0 = Y) → ( + let iA : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + cert.modified.tile iA = TileCellComplement A O) ) := by + classical + intro q cfg C₀ T cert A O trzero iA + rw [cert.modified_tile] + simp [iA, A, O, ModifiedSubtileOccurrenceInterpretation, trzero] + +private theorem htileB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let B := cert.P 0 false + (∀ (Y : ProtoTile), TileTranslation Y 0 = Y) → ( + let iB : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + cert.modified.tile iB = B) ) := by + classical + intro q cfg C₀ T cert B trzero iB + rw [cert.modified_tile] + simp [iB, B, ModifiedSubtileOccurrenceInterpretation, trzero] + +private theorem hcompB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let A := cert.P 0 true + let B := cert.P 0 false + let O := cert.O + let iA : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let iB : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + (cert.modified.tile iA = TileCellComplement A O) → ((cert.modified.tile iB = B) → + (Disjoint (TileCellComplement A O).cells B.cells)) ) := by + classical + intro q cfg C₀ T cert A B O iA iB htileComp htileB + apply Finset.disjoint_left.mpr + intro x hxComp hxB + have hxA : x ∈ (cert.modified.tile iA).cells := by rw [htileComp]; exact hxComp + have hxBi : x ∈ (cert.modified.tile iB).cells := by rw [htileB]; exact hxB + have hxA' : x ∈ (ModifiedSubtileOccurrenceInterpretation cert.P O cert.u cert.v iA).cells := by + rw [← cert.modified_tile] + exact hxA + have hxBi' : x ∈ (ModifiedSubtileOccurrenceInterpretation cert.P O cert.u cert.v iB).cells := by + rw [← cert.modified_tile] + exact hxBi + have hEq := (cert.partition x).unique hxA' hxBi' + exact (show iA ≠ iB by decide) hEq + +private theorem hAC : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let A := cert.P 0 true + let C := cert.P 1 true + (∀ (Y : ProtoTile), TileTranslation Y 0 = Y) → ( + (∀ (i : PeriodicSubtileIndex), ∀ (j : PeriodicSubtileIndex), (i ≠ j) → ((¬ ((i.label = .A + ∧ j.label = .B ∨ i.label = .B ∧ j.label = .A) ∧ i.first = j.first ∧ i.second = + j.second)) → (Disjoint (SubtileOccurrenceInterpretation cert.P cert.u cert.v i).cells + (SubtileOccurrenceInterpretation cert.P cert.u cert.v j).cells))) → (Disjoint A.cells + C.cells)) ) := by + classical + intro q cfg C₀ T cert A C trzero indexed_disjoint + let iA : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let iC : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + have h := indexed_disjoint iA iC (by decide) (by simp [iA, iC]) + simpa [iA, iC, SubtileOccurrenceInterpretation, trzero] using h + +private theorem hAD : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let A := cert.P 0 true + let D := cert.P 1 false + (∀ (Y : ProtoTile), TileTranslation Y 0 = Y) → ( + (∀ (i : PeriodicSubtileIndex), ∀ (j : PeriodicSubtileIndex), (i ≠ j) → ((¬ ((i.label = .A + ∧ j.label = .B ∨ i.label = .B ∧ j.label = .A) ∧ i.first = j.first ∧ i.second = + j.second)) → (Disjoint (SubtileOccurrenceInterpretation cert.P cert.u cert.v i).cells + (SubtileOccurrenceInterpretation cert.P cert.u cert.v j).cells))) → (Disjoint A.cells + D.cells)) ) := by + classical + intro q cfg C₀ T cert A D trzero indexed_disjoint + let iA : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let iD : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + have h := indexed_disjoint iA iD (by decide) (by simp [iA, iD]) + simpa [iA, iD, SubtileOccurrenceInterpretation, trzero] using h + +private theorem hBC : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let B := cert.P 0 false + let C := cert.P 1 true + (∀ (Y : ProtoTile), TileTranslation Y 0 = Y) → ( + (∀ (i : PeriodicSubtileIndex), ∀ (j : PeriodicSubtileIndex), (i ≠ j) → ((¬ ((i.label = .A + ∧ j.label = .B ∨ i.label = .B ∧ j.label = .A) ∧ i.first = j.first ∧ i.second = + j.second)) → (Disjoint (SubtileOccurrenceInterpretation cert.P cert.u cert.v i).cells + (SubtileOccurrenceInterpretation cert.P cert.u cert.v j).cells))) → (Disjoint B.cells + C.cells)) ) := by + classical + intro q cfg C₀ T cert B C trzero indexed_disjoint + let iB : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let iC : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + have h := indexed_disjoint iB iC (by decide) (by simp [iB, iC]) + simpa [iB, iC, SubtileOccurrenceInterpretation, trzero] using h + +private theorem hBD : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let B := cert.P 0 false + let D := cert.P 1 false + (∀ (Y : ProtoTile), TileTranslation Y 0 = Y) → ( + (∀ (i : PeriodicSubtileIndex), ∀ (j : PeriodicSubtileIndex), (i ≠ j) → ((¬ ((i.label = .A + ∧ j.label = .B ∨ i.label = .B ∧ j.label = .A) ∧ i.first = j.first ∧ i.second = + j.second)) → (Disjoint (SubtileOccurrenceInterpretation cert.P cert.u cert.v i).cells + (SubtileOccurrenceInterpretation cert.P cert.u cert.v j).cells))) → (Disjoint B.cells + D.cells)) ) := by + classical + intro q cfg C₀ T cert B D trzero indexed_disjoint + let iB : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let iD : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + have h := indexed_disjoint iB iD (by decide) (by simp [iB, iD]) + simpa [iB, iD, SubtileOccurrenceInterpretation, trzero] using h + +private theorem hCD : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let C := cert.P 1 true + let D := cert.P 1 false + (∀ (Y : ProtoTile), TileTranslation Y 0 = Y) → ( + (∀ (i : PeriodicSubtileIndex), ∀ (j : PeriodicSubtileIndex), (i ≠ j) → ((¬ ((i.label = .A + ∧ j.label = .B ∨ i.label = .B ∧ j.label = .A) ∧ i.first = j.first ∧ i.second = + j.second)) → (Disjoint (SubtileOccurrenceInterpretation cert.P cert.u cert.v i).cells + (SubtileOccurrenceInterpretation cert.P cert.u cert.v j).cells))) → (Disjoint C.cells + D.cells)) ) := by + classical + intro q cfg C₀ T cert C D trzero indexed_disjoint + let iC : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let iD : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + have h := indexed_disjoint iC iD (by decide) (by simp [iC, iD]) + simpa [iC, iD, SubtileOccurrenceInterpretation, trzero] using h + +private theorem hOC : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let A := cert.P 0 true + let C := cert.P 1 true + let O := cert.O + (Disjoint A.cells C.cells) → (Disjoint O.cells C.cells) ) := by + classical + intro q cfg C₀ T cert A C O hAC + let seg := cert.exceptional_segments + apply Finset.disjoint_left.mpr + intro x hxO hxC + exact Finset.disjoint_left.mp hAC (seg.precursor_in_left hxO) hxC + +private theorem hOD : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let A := cert.P 0 true + let D := cert.P 1 false + let O := cert.O + (Disjoint A.cells D.cells) → (Disjoint O.cells D.cells) ) := by + classical + intro q cfg C₀ T cert A D O hAD + let seg := cert.exceptional_segments + apply Finset.disjoint_left.mpr + intro x hxO hxD + exact Finset.disjoint_left.mp hAD (seg.precursor_in_left hxO) hxD + +private theorem boundary_edge_footprint : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges U) → (e ∈ + FootprintEdges U) ) := by + classical + intro U e he + let I : GaussianInt := ⟨0, 1⟩ + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [I, Zsqrtd.ext_iff] + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + +private theorem edge_vertex_footprint : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges U) → (∀ (x : + GaussianInt), (x ∈ e) → (x ∈ FootprintVertices U)) ) := by + classical + intro U e he x hx + rcases he with ⟨c, hc, he⟩ + simp only [FootprintVertices, ite_eq_left (show U.cells.Nonempty from ⟨c, hc⟩), + Set.mem_ofPred_eq] + rcases he with h | h | h | h <;> subst e + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hx + · rcases hx with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ + · rcases hx with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · rcases hx with rfl | rfl + · exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ + · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + · rcases hx with rfl | rfl + · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + +private theorem boundary_raw : + (by + classical + exact + (∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges U) → (e ∈ + FootprintEdges U)) → ((∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ + FootprintEdges U) → (∀ (x : GaussianInt), (x ∈ e) → (x ∈ FootprintVertices U))) → (∀ + (U : ProtoTile), (U.cells.Nonempty) → (BoundaryFootprintVertices U ⊆ + FootprintVertices U))) ) := by + classical + intro boundary_edge_footprint edge_vertex_footprint U hne x hx + simp only [BoundaryFootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hx + obtain ⟨e, he, hxe⟩ := hx + exact edge_vertex_footprint U e (boundary_edge_footprint U e he) x hxe + +private theorem footprint_incident : + (by + classical + exact + ∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ (x : GaussianInt), (x ∈ FootprintVertices U) → + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells)) ) := by + classical + intro U hne x hx + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hx + rcases hx with ⟨c, hc, h | h | h | h⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using h ▸ hc⟩ + · subst x + exact ⟨1, by simpa [LatticeVertexIncidentCell] using hc⟩ + · subst x + exact ⟨3, by simpa [LatticeVertexIncidentCell] using hc⟩ + · refine ⟨2, ?_⟩ + change x - 1 - ⟨0, 1⟩ ∈ U.cells + rw [h] + convert hc using 1; ext <;> simp + +private theorem boundary_missing_incident : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (x ∈ BoundaryFootprintVertices U) → (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∉ U.cells) ) := by + classical + intro U x hx + by_cases hne : U.cells.Nonempty + · simp only [BoundaryFootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hx + obtain ⟨e, he, hxe⟩ := hx + rcases he with ⟨z, ⟨rfl, hcross⟩ | ⟨rfl, hcross⟩⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hcross with ⟨hz, hzi⟩ | ⟨hz, hzi⟩ + · rcases hxe with hxe | hxe + · subst x + exact ⟨3, by simpa [LatticeVertexIncidentCell] using hzi⟩ + · subst x + exact ⟨2, by + simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] using hzi⟩ + · rcases hxe with hxe | hxe + · subst x + exact ⟨0, by simpa [LatticeVertexIncidentCell] using hz⟩ + · subst x + exact ⟨1, by simpa [LatticeVertexIncidentCell] using hz⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hcross with ⟨hz, hz1⟩ | ⟨hz, hz1⟩ + · rcases hxe with hxe | hxe + · subst x + exact ⟨1, by simpa [LatticeVertexIncidentCell] using hz1⟩ + · subst x + exact ⟨2, by + simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] using hz1⟩ + · rcases hxe with hxe | hxe + · subst x + exact ⟨0, by simpa [LatticeVertexIncidentCell] using hz⟩ + · subst x + exact ⟨3, by + simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] using hz⟩ + · exact ⟨0, by simp [Finset.not_nonempty_iff_eq_empty.mp hne]⟩ + +private theorem hQO : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let O := cert.O + let Q := cert.Q 1 true + (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → ((Y.cells.Nonempty) → + ((TileTouching X Y) → (Disjoint X.cells Y.cells)))) → ((Finset.Nonempty Q.cells) → + (O.cells.Nonempty → Disjoint Q.cells O.cells)) ) := by + classical + intro q cfg C₀ T cert O Q touching_disjoint hQne hOne + exact (touching_disjoint O Q hOne hQne cert.precursor_first.2.2.1).symm + +private theorem hSO : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let O := cert.O + let S := cert.S 2 false + (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → ((Y.cells.Nonempty) → + ((TileTouching X Y) → (Disjoint X.cells Y.cells)))) → ((Finset.Nonempty S.cells) → + (O.cells.Nonempty → Disjoint S.cells O.cells)) ) := by + classical + intro q cfg C₀ T cert O S touching_disjoint hSne hOne + exact touching_disjoint S O hSne hOne cert.precursor_first.2.1 + +private theorem hRO : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let O := cert.O + let R := cert.Q 2 true + (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → ((Y.cells.Nonempty) → + ((TileTouching X Y) → (Disjoint X.cells Y.cells)))) → ((Finset.Nonempty R.cells) → + (O.cells.Nonempty → Disjoint R.cells O.cells)) ) := by + classical + intro q cfg C₀ T cert O R touching_disjoint hRne hOne + exact (touching_disjoint O R hOne hRne cert.precursor_second.2.2.1).symm + +private theorem hVO : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let O := cert.O + let V := cert.S 1 false + (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → ((Y.cells.Nonempty) → + ((TileTouching X Y) → (Disjoint X.cells Y.cells)))) → ((Finset.Nonempty V.cells) → + (O.cells.Nonempty → Disjoint V.cells O.cells)) ) := by + classical + intro q cfg C₀ T cert O V touching_disjoint hVne hOne + exact touching_disjoint V O hVne hOne cert.precursor_second.2.1 + +private theorem rho_mem : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (f : PeriodicSubtileFaceIndex), ∀ (k : Fin 3), cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm f) ∈ FootprintVertices + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (SixSubtileFaceVertices f k)) ) + := by + classical + intro q cfg C₀ T cert f k + have h := cert.unmodified.core.rho_common (cert.unmodified.faceEquiv.symm f) k + rw [cert.unmodified.face_vertices, cert.unmodified.faceEquiv.apply_symm_apply, + cert.unmodified.tile_eq] at h + exact h + +private theorem hp1C : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let C := cert.P 1 true + let p1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + (∀ (Y : ProtoTile), TileTranslation Y 0 = Y) → ((∀ (f : PeriodicSubtileFaceIndex), ∀ (k : + Fin 3), cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm f) ∈ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (SixSubtileFaceVertices f k))) → ( + p1 ∈ FootprintVertices C)) ) := by + classical + intro q cfg C₀ T cert C p1 trzero rho_mem + let f1 : PeriodicSubtileFaceIndex := ⟨.I1, 0, 0⟩ + have h := rho_mem f1 2 + simpa [p1, f1, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, trzero] using h + +private theorem hp2D : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let D := cert.P 1 false + let p2 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) + (∀ (Y : ProtoTile), TileTranslation Y 0 = Y) → ((∀ (f : PeriodicSubtileFaceIndex), ∀ (k : + Fin 3), cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm f) ∈ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (SixSubtileFaceVertices f k))) → ( + p2 ∈ FootprintVertices D)) ) := by + classical + intro q cfg C₀ T cert D p2 trzero rho_mem + let f2 : PeriodicSubtileFaceIndex := ⟨.I2, 0, 0⟩ + have h := rho_mem f2 2 + simpa [p2, f2, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, trzero] using h + +private theorem cutData : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), + LatticeTile X → LatticeTile Y → LatticeTile Z → TouchingTriple X Y Z → x ∈ + FootprintVertices X ∩ FootprintVertices Y ∩ FootprintVertices Z → (∀ (j : Fin (4 : + ℕ)), LatticeVertexIncidentCell x j ∈ X.cells ∨ LatticeVertexIncidentCell x j ∈ + Y.cells ∨ LatticeVertexIncidentCell x j ∈ Z.cells) ∧ (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ X.cells) ∧ (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ Y.cells) ∧ (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ Z.cells) ∧ ((∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ X.cells ∧ LatticeVertexIncidentCell x (j + (2 : Fin + (4 : ℕ))) ∈ Y.cells) ∨ (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ X.cells + ∧ LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ Z.cells) ∨ ∃ (j : Fin (4 : + ℕ)), LatticeVertexIncidentCell x j ∈ Y.cells ∧ LatticeVertexIncidentCell x (j + (2 : + Fin (4 : ℕ))) ∈ Z.cells)) → ( + let O := cert.O + let Q := cert.Q 1 true + let S := cert.S 2 false + let seg := cert.exceptional_segments + (LatticeTile Q) → ((LatticeTile S) → ((O.cells.Nonempty → LatticeTile O) → + ((Finset.Nonempty Q.cells) → ((Finset.Nonempty S.cells) → ((∀ (U : ProtoTile), + (U.cells.Nonempty) → (BoundaryFootprintVertices U ⊆ FootprintVertices U)) → + ((O.cells.Nonempty) → ((∀ j : Fin 4, LatticeVertexIncidentCell seg.a j ∈ Q.cells ∨ + LatticeVertexIncidentCell seg.a j ∈ S.cells ∨ LatticeVertexIncidentCell seg.a j ∈ + O.cells) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell seg.a j ∈ O.cells) ∧ ((∃ j : Fin + 4, LatticeVertexIncidentCell seg.a j ∈ Q.cells ∧ LatticeVertexIncidentCell seg.a (j + + 2) ∈ S.cells) ∨ (∃ j : Fin 4, LatticeVertexIncidentCell seg.a j ∈ Q.cells ∧ + LatticeVertexIncidentCell seg.a (j + 2) ∈ O.cells) ∨ (∃ j : Fin 4, + LatticeVertexIncidentCell seg.a j ∈ S.cells ∧ LatticeVertexIncidentCell seg.a (j + 2) + ∈ O.cells)))))))))) ) := by + classical + intro q cfg C₀ T cert three_owner_sectors O Q S seg hQ hS hO hQne hSne boundary_raw hOne + have hb := (seg.first_cut_unique seg.a).mpr rfl + have hfQ := boundary_raw Q hQne hb.1 + have hfS := boundary_raw S hSne hb.2.1 + have hfO := boundary_raw O hOne hb.2.2 + have h := three_owner_sectors Q S O seg.a hQ hS (hO hOne) + cert.precursor_first ⟨⟨hfQ, hfS⟩, hfO⟩ + exact ⟨h.1, h.2.2.2.1, h.2.2.2.2⟩ + +private theorem cutDataR : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), + LatticeTile X → LatticeTile Y → LatticeTile Z → TouchingTriple X Y Z → x ∈ + FootprintVertices X ∩ FootprintVertices Y ∩ FootprintVertices Z → (∀ (j : Fin (4 : + ℕ)), LatticeVertexIncidentCell x j ∈ X.cells ∨ LatticeVertexIncidentCell x j ∈ + Y.cells ∨ LatticeVertexIncidentCell x j ∈ Z.cells) ∧ (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ X.cells) ∧ (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ Y.cells) ∧ (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ Z.cells) ∧ ((∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ X.cells ∧ LatticeVertexIncidentCell x (j + (2 : Fin + (4 : ℕ))) ∈ Y.cells) ∨ (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ X.cells + ∧ LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ Z.cells) ∨ ∃ (j : Fin (4 : + ℕ)), LatticeVertexIncidentCell x j ∈ Y.cells ∧ LatticeVertexIncidentCell x (j + (2 : + Fin (4 : ℕ))) ∈ Z.cells)) → ( + let O := cert.O + let R := cert.Q 2 true + let V := cert.S 1 false + let seg := cert.exceptional_segments + (LatticeTile R) → ((LatticeTile V) → ((O.cells.Nonempty → LatticeTile O) → + ((Finset.Nonempty R.cells) → ((Finset.Nonempty V.cells) → ((∀ (U : ProtoTile), + (U.cells.Nonempty) → (BoundaryFootprintVertices U ⊆ FootprintVertices U)) → + ((O.cells.Nonempty) → ((∀ j : Fin 4, LatticeVertexIncidentCell seg.b j ∈ R.cells ∨ + LatticeVertexIncidentCell seg.b j ∈ V.cells ∨ LatticeVertexIncidentCell seg.b j ∈ + O.cells) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell seg.b j ∈ O.cells) ∧ ((∃ j : Fin + 4, LatticeVertexIncidentCell seg.b j ∈ R.cells ∧ LatticeVertexIncidentCell seg.b (j + + 2) ∈ V.cells) ∨ (∃ j : Fin 4, LatticeVertexIncidentCell seg.b j ∈ R.cells ∧ + LatticeVertexIncidentCell seg.b (j + 2) ∈ O.cells) ∨ (∃ j : Fin 4, + LatticeVertexIncidentCell seg.b j ∈ V.cells ∧ LatticeVertexIncidentCell seg.b (j + 2) + ∈ O.cells)))))))))) ) := by + classical + intro q cfg C₀ T cert three_owner_sectors O R V seg hR hV hO hRne hVne boundary_raw hOne + have hb := (seg.second_cut_unique seg.b).mpr rfl + have hfR := boundary_raw R hRne hb.1 + have hfV := boundary_raw V hVne hb.2.1 + have hfO := boundary_raw O hOne hb.2.2 + have h := three_owner_sectors R V O seg.b hR hV (hO hOne) + cert.precursor_second ⟨⟨hfR, hfV⟩, hfO⟩ + exact ⟨h.1, h.2.2.2.1, h.2.2.2.2⟩ + +private theorem cutNoC : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let C := cert.P 1 true + let O := cert.O + let Q := cert.Q 1 true + let S := cert.S 2 false + let seg := cert.exceptional_segments + (Disjoint O.cells C.cells) → ((Disjoint Q.cells C.cells) → ((Disjoint S.cells C.cells) → + (((O.cells.Nonempty) → ((∀ j : Fin 4, LatticeVertexIncidentCell seg.a j ∈ Q.cells ∨ + LatticeVertexIncidentCell seg.a j ∈ S.cells ∨ LatticeVertexIncidentCell seg.a j ∈ + O.cells) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell seg.a j ∈ O.cells) ∧ ((∃ j : Fin + 4, LatticeVertexIncidentCell seg.a j ∈ Q.cells ∧ LatticeVertexIncidentCell seg.a (j + + 2) ∈ S.cells) ∨ (∃ j : Fin 4, LatticeVertexIncidentCell seg.a j ∈ Q.cells ∧ + LatticeVertexIncidentCell seg.a (j + 2) ∈ O.cells) ∨ (∃ j : Fin 4, + LatticeVertexIncidentCell seg.a j ∈ S.cells ∧ LatticeVertexIncidentCell seg.a (j + 2) + ∈ O.cells)))) → ((O.cells.Nonempty) → (∀ (j : Fin 4), LatticeVertexIncidentCell seg.a + j ∉ C.cells))))) ) := by + classical + intro q cfg C₀ T cert C O Q S seg hOC hQC hSC cutData hOne j + rcases (cutData hOne).1 j with hq | hs | ho + · exact fun hc => Finset.disjoint_left.mp hQC hq hc + · exact fun hc => Finset.disjoint_left.mp hSC hs hc + · exact fun hc => Finset.disjoint_left.mp hOC ho hc + +private theorem cutNoD : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let D := cert.P 1 false + let O := cert.O + let R := cert.Q 2 true + let V := cert.S 1 false + let seg := cert.exceptional_segments + (Disjoint O.cells D.cells) → ((Disjoint R.cells D.cells) → ((Disjoint V.cells D.cells) → + (((O.cells.Nonempty) → ((∀ j : Fin 4, LatticeVertexIncidentCell seg.b j ∈ R.cells ∨ + LatticeVertexIncidentCell seg.b j ∈ V.cells ∨ LatticeVertexIncidentCell seg.b j ∈ + O.cells) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell seg.b j ∈ O.cells) ∧ ((∃ j : Fin + 4, LatticeVertexIncidentCell seg.b j ∈ R.cells ∧ LatticeVertexIncidentCell seg.b (j + + 2) ∈ V.cells) ∨ (∃ j : Fin 4, LatticeVertexIncidentCell seg.b j ∈ R.cells ∧ + LatticeVertexIncidentCell seg.b (j + 2) ∈ O.cells) ∨ (∃ j : Fin 4, + LatticeVertexIncidentCell seg.b j ∈ V.cells ∧ LatticeVertexIncidentCell seg.b (j + 2) + ∈ O.cells)))) → ((O.cells.Nonempty) → (∀ (j : Fin 4), LatticeVertexIncidentCell seg.b + j ∉ D.cells))))) ) := by + classical + intro q cfg C₀ T cert D O R V seg hOD hRD hVD cutDataR hOne j + rcases (cutDataR hOne).1 j with hr | hv | ho + · exact fun hd => Finset.disjoint_left.mp hRD hr hd + · exact fun hd => Finset.disjoint_left.mp hVD hv hd + · exact fun hd => Finset.disjoint_left.mp hOD ho hd + +private theorem cuts_ne_marked : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let C := cert.P 1 true + let D := cert.P 1 false + let O := cert.O + let p1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let p2 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) + let seg := cert.exceptional_segments + (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell p1 j ∈ C.cells) → ((∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell p2 j ∈ D.cells) → (((O.cells.Nonempty) → (∀ (j : Fin 4), + LatticeVertexIncidentCell seg.a j ∉ C.cells)) → (((O.cells.Nonempty) → (∀ (j : Fin + 4), LatticeVertexIncidentCell seg.b j ∉ D.cells)) → ((O.cells.Nonempty) → (seg.a ≠ p1 + ∧ seg.b ≠ p2))))) ) := by + classical + intro q cfg C₀ T cert C D O p1 p2 seg hmark1C hmark2D cutNoC cutNoD hOne + constructor + · intro heq + rcases hmark1C with ⟨j, hj⟩ + exact cutNoC hOne j (heq ▸ hj) + · intro heq + rcases hmark2D with ⟨j, hj⟩ + exact cutNoD hOne j (heq ▸ hj) + +private theorem splitInternal : + (by + classical + exact + ∀ (l : List GaussianInt), ∀ (x : GaussianInt), ∀ (h : GaussianInt), ∀ (t : GaussianInt), + l.Nodup → l.head? = some h → l.getLast? = some t → x ∈ l → x ≠ h → x ≠ t → ∃ pre y z + post, l = pre ++ y :: x :: z :: post ) := by + classical + intro l + induction l with + | nil => intro x h t hn hh ht hx; simp at hx + | cons a tail ih => + intro x h t hn hh ht hx hxh hxt + have hah : a = h := by simpa using hh + subst h + rcases List.mem_cons.mp hx with hxa | hx + · exact (hxh hxa).elim + · cases tail with + | nil => simp at hx + | cons b rest => + by_cases hxb : x = b + · subst x + have hrest : rest ≠ [] := by + intro he + subst rest + have hb : b = t := by simpa using ht + exact hxt hb + cases rest with + | nil => exact (hrest rfl).elim + | cons c u => + refine ⟨[], a, c, u, ?_⟩ + simp + · obtain ⟨pre, y, z, post, heq⟩ := + ih x b t hn.tail (by rfl) (by simpa using ht) hx hxb hxt + refine ⟨a :: pre, y, z, post, ?_⟩ + simp [heq] + +private theorem leftInternal : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (x : GaussianInt), LatticeTile X → + LatticeTile Y → Disjoint X.cells Y.cells → (∃ (e : Finset GaussianInt) (f : Finset + GaussianInt), e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ e ∈ FootprintEdges X ∩ FootprintEdges Y ∧ f ∈ + FootprintEdges X ∩ FootprintEdges Y) → (∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ X.cells ∨ LatticeVertexIncidentCell x j ∈ Y.cells) ∧ + ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ X.cells ∧ + LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ Y.cells) → ( + let Q := cert.Q 1 true + let S := cert.S 2 false + let p1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let seg := cert.exceptional_segments + (LatticeTile Q) → ((LatticeTile S) → ((Disjoint Q.cells S.cells) → ((∀ (l : List + GaussianInt), ∀ (x : GaussianInt), ∀ (h : GaussianInt), ∀ (t : GaussianInt), l.Nodup + → l.head? = some h → l.getLast? = some t → x ∈ l → x ≠ h → x ≠ t → ∃ pre y z post, l + = pre ++ y :: x :: z :: post) → (∀ (x : GaussianInt), (x ∈ seg.left) → ((x ≠ p1) → + ((x ≠ seg.a) → ((∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ Q.cells ∨ + LatticeVertexIncidentCell x j ∈ S.cells) ∧ ∃ j : Fin 4, LatticeVertexIncidentCell x j + ∈ Q.cells ∧ LatticeVertexIncidentCell x (j + 2) ∈ S.cells)))))))) ) := by + classical + intro q cfg C₀ T cert two_owner_sectors Q S p1 seg hQ hS hQSC splitInternal x hx hh ht + obtain ⟨pre, y, z, post, hlist⟩ := + splitInternal seg.left x p1 seg.a seg.left_nodup seg.left_head seg.left_last hx hh ht + have he₁ := seg.left_edges y x pre (z :: post) hlist + have he₂ := seg.left_edges x z (pre ++ [y]) post (by + rw [hlist] + simp [List.append_assoc]) + have hnod := seg.left_nodup + rw [hlist] at hnod + have htail : (y :: x :: z :: post).Nodup := (List.nodup_append.mp hnod).2.1 + have hnot : y ∉ x :: z :: post := (List.nodup_cons.mp htail).1 + have hyx : y ≠ x := by intro h; exact hnot (by simp [h]) + have hyz : y ≠ z := by intro h; exact hnot (by simp [h]) + have hne : ({y, x} : Finset GaussianInt) ≠ {x, z} := by + intro h + have hy' : y = x ∨ y = z := by + have : y ∈ ({x, z} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + rcases hy' with h' | h' + · exact hyx h' + · exact hyz h' + have hsectors := two_owner_sectors Q S x hQ hS hQSC + ⟨{y, x}, {x, z}, hne, by simp, by simp, he₁, he₂⟩ + exact hsectors + +private theorem rightInternal : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (x : GaussianInt), LatticeTile X → + LatticeTile Y → Disjoint X.cells Y.cells → (∃ (e : Finset GaussianInt) (f : Finset + GaussianInt), e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ e ∈ FootprintEdges X ∩ FootprintEdges Y ∧ f ∈ + FootprintEdges X ∩ FootprintEdges Y) → (∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ X.cells ∨ LatticeVertexIncidentCell x j ∈ Y.cells) ∧ + ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ X.cells ∧ + LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ Y.cells) → ( + let R := cert.Q 2 true + let V := cert.S 1 false + let p2 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) + let seg := cert.exceptional_segments + (LatticeTile R) → ((LatticeTile V) → ((Disjoint R.cells V.cells) → ((∀ (l : List + GaussianInt), ∀ (x : GaussianInt), ∀ (h : GaussianInt), ∀ (t : GaussianInt), l.Nodup + → l.head? = some h → l.getLast? = some t → x ∈ l → x ≠ h → x ≠ t → ∃ pre y z post, l + = pre ++ y :: x :: z :: post) → (∀ (x : GaussianInt), (x ∈ seg.right) → ((x ≠ seg.b) + → ((x ≠ p2) → ((∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ R.cells ∨ + LatticeVertexIncidentCell x j ∈ V.cells) ∧ ∃ j : Fin 4, LatticeVertexIncidentCell x j + ∈ R.cells ∧ LatticeVertexIncidentCell x (j + 2) ∈ V.cells)))))))) ) := by + classical + intro q cfg C₀ T cert two_owner_sectors R V p2 seg hR hV hRVD splitInternal x hx hh ht + obtain ⟨pre, y, z, post, hlist⟩ := + splitInternal seg.right x seg.b p2 seg.right_nodup seg.right_head seg.right_last hx hh ht + have he₁ := seg.right_edges y x pre (z :: post) hlist + have he₂ := seg.right_edges x z (pre ++ [y]) post (by + rw [hlist] + simp [List.append_assoc]) + have hnod := seg.right_nodup + rw [hlist] at hnod + have htail : (y :: x :: z :: post).Nodup := (List.nodup_append.mp hnod).2.1 + have hnot : y ∉ x :: z :: post := (List.nodup_cons.mp htail).1 + have hyx : y ≠ x := by intro h; exact hnot (by simp [h]) + have hyz : y ≠ z := by intro h; exact hnot (by simp [h]) + have hne : ({y, x} : Finset GaussianInt) ≠ {x, z} := by + intro h + have hy' : y = x ∨ y = z := by + have : y ∈ ({x, z} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + rcases hy' with h' | h' + · exact hyx h' + · exact hyz h' + exact two_owner_sectors R V x hR hV hRVD + ⟨{y, x}, {x, z}, hne, by simp, by simp, he₁, he₂⟩ + +private theorem middleInternal : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (x : GaussianInt), LatticeTile X → + LatticeTile Y → Disjoint X.cells Y.cells → (∃ (e : Finset GaussianInt) (f : Finset + GaussianInt), e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ e ∈ FootprintEdges X ∩ FootprintEdges Y ∧ f ∈ + FootprintEdges X ∩ FootprintEdges Y) → (∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ X.cells ∨ LatticeVertexIncidentCell x j ∈ Y.cells) ∧ + ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ X.cells ∧ + LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ Y.cells) → ( + let A := cert.P 0 true + let O := cert.O + let seg := cert.exceptional_segments + (O.cells.Nonempty → LatticeTile O) → ((∀ (l : List GaussianInt), ∀ (x : GaussianInt), ∀ + (h : GaussianInt), ∀ (t : GaussianInt), l.Nodup → l.head? = some h → l.getLast? = + some t → x ∈ l → x ≠ h → x ≠ t → ∃ pre y z post, l = pre ++ y :: x :: z :: post) → (∀ + (x : GaussianInt), (x ∈ seg.middle) → ((x ≠ seg.a) → ((x ≠ seg.b) → ((∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (TileCellComplement A O).cells ∨ + LatticeVertexIncidentCell x j ∈ O.cells) ∧ O.cells.Nonempty)))))) ) := by + classical + intro q cfg C₀ T cert two_owner_sectors A O seg hO splitInternal x hx ha hb + obtain ⟨pre, y, z, post, hlist⟩ := + splitInternal seg.middle x seg.a seg.b seg.middle_nodup + seg.middle_head seg.middle_last hx ha hb + have he := seg.middle_edges y x pre (z :: post) hlist + have he₂ := seg.middle_edges x z (pre ++ [y]) post (by + rw [hlist] + simp [List.append_assoc]) + have hnod := seg.middle_nodup + rw [hlist] at hnod + have htail : (y :: x :: z :: post).Nodup := (List.nodup_append.mp hnod).2.1 + have hnot : y ∉ x :: z :: post := (List.nodup_cons.mp htail).1 + have hyx : y ≠ x := by intro h; exact hnot (by simp [h]) + have hyz : y ≠ z := by intro h; exact hnot (by simp [h]) + have hne : ({y, x} : Finset GaussianInt) ≠ {x, z} := by + intro h + have hy' : y = x ∨ y = z := by + have : y ∈ ({x, z} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + rcases hy' with h' | h' + · exact hyx h' + · exact hyz h' + have hOne : O.cells.Nonempty := by + by_contra hn + rcases he.2 with ⟨c, hc, _⟩ + exact hn ⟨c, hc⟩ + have hcomp : Disjoint (TileCellComplement A O).cells O.cells := by + apply Finset.disjoint_left.mpr + intro c hc hco + exact (Finset.mem_sdiff.mp hc).2 hco + have hsec := two_owner_sectors (TileCellComplement A O) O x + cert.precursor_complement_lattice.1 (hO hOne) hcomp + ⟨{y, x}, {x, z}, hne, by simp, by simp, he, he₂⟩ + exact ⟨hsec.1, hOne⟩ + +private theorem middleRestored : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let A := cert.P 0 true + let O := cert.O + let seg := cert.exceptional_segments + (∀ (x : GaussianInt), (x ∈ seg.middle) → ((x ≠ seg.a) → ((x ≠ seg.b) → ((∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (TileCellComplement A O).cells ∨ + LatticeVertexIncidentCell x j ∈ O.cells) ∧ O.cells.Nonempty)))) → (∀ (x : + GaussianInt), (x ∈ seg.middle) → ((x ≠ seg.a) → ((x ≠ seg.b) → (∀ (j : Fin 4), + LatticeVertexIncidentCell x j ∈ A.cells)))) ) := by + classical + intro q cfg C₀ T cert A O seg middleInternal x hx ha hb j + rcases (middleInternal x hx ha hb).1 j with hcomp | hOcell + · exact (Finset.mem_sdiff.mp hcomp).1 + · exact seg.precursor_in_left hOcell + +private theorem middleWalkEdge : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let A := cert.P 0 true + let B := cert.P 0 false + let O := cert.O + let seg := cert.exceptional_segments + (∀ (l : List GaussianInt), ∀ (x : GaussianInt), ∀ (h : GaussianInt), ∀ (t : GaussianInt), + l.Nodup → l.head? = some h → l.getLast? = some t → x ∈ l → x ≠ h → x ≠ t → ∃ pre y z + post, l = pre ++ y :: x :: z :: post) → (∀ (x : GaussianInt), (x ∈ seg.middle) → ((x + ≠ seg.a) → ((x ≠ seg.b) → (∃ e : Finset GaussianInt, x ∈ e ∧ e ∈ FootprintEdges + (TileCellComplement A O) ∩ FootprintEdges B ∧ (TileCellComplement A + O).cells.Nonempty)))) ) := by + classical + intro q cfg C₀ T cert A B O seg splitInternal x hx ha hb + obtain ⟨pre, y, z, post, hlist⟩ := + splitInternal seg.middle x seg.a seg.b seg.middle_nodup + seg.middle_head seg.middle_last hx ha hb + have heMid := seg.middle_edges y x pre (z :: post) hlist + have hDne : (TileCellComplement A O).cells.Nonempty := by + rcases heMid.1 with ⟨c, hc, _⟩ + exact ⟨c, hc⟩ + have hwalk : ∃ wl wr, seg.walk = wl ++ y :: x :: wr := by + cases pre with + | nil => + have hy : y = seg.a := by + have h := seg.middle_head + rw [hlist] at h + simpa using h + have hleft := (List.getLast?_eq_some_iff.mp seg.left_last) + rcases hleft with ⟨lp, hleft⟩ + have htail : seg.middle.tail = x :: z :: post := by + simp [hlist, hy] + refine ⟨lp, z :: post ++ seg.right.tail, ?_⟩ + rw [seg.walk_order, hleft, htail, hy] + simp [List.append_assoc] + | cons d ds => + have htail : seg.middle.tail = ds ++ y :: x :: z :: post := by + simp [hlist] + refine ⟨seg.left ++ ds, z :: post ++ seg.right.tail, ?_⟩ + rw [seg.walk_order, htail] + simp [List.append_assoc] + obtain ⟨wl, wr, hwalk⟩ := hwalk + have heWalk := seg.walk_edges y x wl wr hwalk + exact ⟨{y, x}, by simp, heWalk, hDne⟩ + +end RestorationSectorGeometry + +namespace RestorationSectorCertificate + +private theorem sectorOrderCertificate : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let A := cert.P 0 true + let B := cert.P 0 false + let C := cert.P 1 true + let D := cert.P 1 false + let O := cert.O + let Q := cert.Q 1 true + let S := cert.S 2 false + let R := cert.Q 2 true + let V := cert.S 1 false + let p1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let p2 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) + (Finset.Nonempty B.cells) → ((Finset.Nonempty Q.cells) → ((Finset.Nonempty S.cells) → + ((Finset.Nonempty R.cells) → ((Finset.Nonempty V.cells) → ((Disjoint Q.cells S.cells) + → ((Disjoint R.cells V.cells) → ((Disjoint (TileCellComplement A O).cells B.cells) → + ((Disjoint Q.cells C.cells) → ((Disjoint S.cells C.cells) → ((Disjoint R.cells + D.cells) → ((Disjoint V.cells D.cells) → ((∀ (U : ProtoTile), Finset.Nonempty U.cells + → ∀ x ∈ FootprintVertices U, ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ + U.cells) → ((∀ (U : ProtoTile), ∀ x ∈ BoundaryFootprintVertices U, ∃ (j : Fin (4 : + ℕ)), LatticeVertexIncidentCell x j ∉ U.cells) → ((Finset.Nonempty cert.O.cells → + Disjoint (cert.Q (1 : Fin (3 : ℕ)) true).cells cert.O.cells) → ((Finset.Nonempty + cert.O.cells → Disjoint (cert.Q (2 : Fin (3 : ℕ)) true).cells cert.O.cells) → + ((Finset.Nonempty cert.O.cells → (∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell + cert.exceptional_segments.a j ∈ (cert.Q (1 : Fin (3 : ℕ)) true).cells ∨ + LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S (2 : Fin (3 : ℕ)) + false).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ + cert.O.cells) ∧ (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell + cert.exceptional_segments.a j ∈ cert.O.cells) ∧ ((∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.Q (1 : Fin (3 : ℕ)) + true).cells ∧ LatticeVertexIncidentCell cert.exceptional_segments.a (j + (2 : Fin (4 + : ℕ))) ∈ (cert.S (2 : Fin (3 : ℕ)) false).cells) ∨ (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.Q (1 : Fin (3 : ℕ)) + true).cells ∧ LatticeVertexIncidentCell cert.exceptional_segments.a (j + (2 : Fin (4 + : ℕ))) ∈ cert.O.cells) ∨ ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell + cert.exceptional_segments.a j ∈ (cert.S (2 : Fin (3 : ℕ)) false).cells ∧ + LatticeVertexIncidentCell cert.exceptional_segments.a (j + (2 : Fin (4 : ℕ))) ∈ + cert.O.cells)) → ((Finset.Nonempty cert.O.cells → (∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q (2 : Fin (3 : ℕ)) + true).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S (1 : + Fin (3 : ℕ)) false).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ + cert.O.cells) ∧ (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell + cert.exceptional_segments.b j ∈ cert.O.cells) ∧ ((∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q (2 : Fin (3 : ℕ)) + true).cells ∧ LatticeVertexIncidentCell cert.exceptional_segments.b (j + (2 : Fin (4 + : ℕ))) ∈ (cert.S (1 : Fin (3 : ℕ)) false).cells) ∨ (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q (2 : Fin (3 : ℕ)) + true).cells ∧ LatticeVertexIncidentCell cert.exceptional_segments.b (j + (2 : Fin (4 + : ℕ))) ∈ cert.O.cells) ∨ ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell + cert.exceptional_segments.b j ∈ (cert.S (1 : Fin (3 : ℕ)) false).cells ∧ + LatticeVertexIncidentCell cert.exceptional_segments.b (j + (2 : Fin (4 : ℕ))) ∈ + cert.O.cells)) → ((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell p1 j ∈ Q.cells ∨ + LatticeVertexIncidentCell p1 j ∈ S.cells ∨ LatticeVertexIncidentCell p1 j ∈ C.cells) + → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell p1 j ∈ C.cells) → (((∃ (j : Fin (4 + : ℕ)), LatticeVertexIncidentCell p1 j ∈ Q.cells ∧ LatticeVertexIncidentCell p1 (j + + (2 : Fin (4 : ℕ))) ∈ S.cells) ∨ (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell p1 j + ∈ Q.cells ∧ LatticeVertexIncidentCell p1 (j + (2 : Fin (4 : ℕ))) ∈ C.cells) ∨ ∃ (j : + Fin (4 : ℕ)), LatticeVertexIncidentCell p1 j ∈ S.cells ∧ LatticeVertexIncidentCell p1 + (j + (2 : Fin (4 : ℕ))) ∈ C.cells) → ((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell + p2 j ∈ R.cells ∨ LatticeVertexIncidentCell p2 j ∈ V.cells ∨ LatticeVertexIncidentCell + p2 j ∈ D.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell p2 j ∈ D.cells) → + (((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell p2 j ∈ R.cells ∧ + LatticeVertexIncidentCell p2 (j + (2 : Fin (4 : ℕ))) ∈ V.cells) ∨ (∃ (j : Fin (4 : + ℕ)), LatticeVertexIncidentCell p2 j ∈ R.cells ∧ LatticeVertexIncidentCell p2 (j + (2 + : Fin (4 : ℕ))) ∈ D.cells) ∨ ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell p2 j ∈ + V.cells ∧ LatticeVertexIncidentCell p2 (j + (2 : Fin (4 : ℕ))) ∈ D.cells) → + ((Finset.Nonempty cert.O.cells → ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell + cert.exceptional_segments.a j ∉ (cert.P (1 : Fin (3 : ℕ)) true).cells) → + ((Finset.Nonempty cert.O.cells → ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell + cert.exceptional_segments.b j ∉ (cert.P (1 : Fin (3 : ℕ)) false).cells) → + ((Finset.Nonempty cert.O.cells → cert.exceptional_segments.a ≠ + cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex + → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I1, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex)) ∧ cert.exceptional_segments.b ≠ cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) → ((∀ x ∈ cert.exceptional_segments.left, x ≠ + cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex + → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I1, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex)) → x ≠ cert.exceptional_segments.a → (∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ (cert.Q (1 : Fin (3 : ℕ)) true).cells ∨ + LatticeVertexIncidentCell x j ∈ (cert.S (2 : Fin (3 : ℕ)) false).cells) ∧ ∃ (j : Fin + (4 : ℕ)), LatticeVertexIncidentCell x j ∈ (cert.Q (1 : Fin (3 : ℕ)) true).cells ∧ + LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ (cert.S (2 : Fin (3 : ℕ)) + false).cells) → ((∀ x ∈ cert.exceptional_segments.right, x ≠ + cert.exceptional_segments.b → x ≠ cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex)) → (∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ + (cert.Q (2 : Fin (3 : ℕ)) true).cells ∨ LatticeVertexIncidentCell x j ∈ (cert.S (1 : + Fin (3 : ℕ)) false).cells) ∧ ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ + (cert.Q (2 : Fin (3 : ℕ)) true).cells ∧ LatticeVertexIncidentCell x (j + (2 : Fin (4 + : ℕ))) ∈ (cert.S (1 : Fin (3 : ℕ)) false).cells) → ((∀ x ∈ + cert.exceptional_segments.middle, x ≠ cert.exceptional_segments.a → x ≠ + cert.exceptional_segments.b → ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ + (cert.P (0 : Fin (3 : ℕ)) true).cells) → ((∀ x ∈ cert.exceptional_segments.middle, x + ≠ cert.exceptional_segments.a → x ≠ cert.exceptional_segments.b → ∃ (e : Finset + GaussianInt), x ∈ e ∧ e ∈ FootprintEdges (TileCellComplement (cert.P (0 : Fin (3 : + ℕ)) true) cert.O) ∩ FootprintEdges (cert.P (0 : Fin (3 : ℕ)) false) ∧ Finset.Nonempty + (TileCellComplement (cert.P (0 : Fin (3 : ℕ)) true) cert.O).cells) → + (ExceptionalRestorationSectorData (cert.P 0 true) (cert.P 0 false) cert.O (cert.Q 1 + true) (cert.S 2 false) (cert.Q 2 true) (cert.S 1 false) (cert.P 1 true) (cert.P 1 + false) (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) + (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩)) + cert.exceptional_segments))))))))))))))))))))))))))))))) ) := by + classical + intro q cfg C₀ T cert A B C D O Q S R V p1 p2 hBne hQne hSne hRne hVne hQSC hRVD hcompB hQC hSC + hRD hVD footprint_incident boundary_missing_incident hQO hRO cutData cutDataR hmark1cover + hmark1C hmark1opp hmark2cover hmark2D hmark2opp cutNoC cutNoD cuts_ne_marked leftInternal + rightInternal middleRestored middleWalkEdge + let seg := cert.exceptional_segments + refine { + left_opposite := by + intro x hx guard hNoC hNoO + by_cases hp : x = p1 + · subst x + exact (hNoC hmark1C.choose hmark1C.choose_spec).elim + by_cases ha : x = seg.a + · subst x + rcases guard with hOne | hne + · exact (hNoO (cutData hOne).2.1.choose + (cutData hOne).2.1.choose_spec).elim + · exact (hne rfl).elim + · exact (leftInternal x hx hp ha).2 + right_opposite := by + intro x hx guard hNoD hNoO + by_cases hp : x = p2 + · subst x + exact (hNoD hmark2D.choose hmark2D.choose_spec).elim + by_cases hb : x = seg.b + · subst x + rcases guard with hOne | hne + · exact (hNoO (cutDataR hOne).2.1.choose + (cutDataR hOne).2.1.choose_spec).elim + · exact (hne rfl).elim + · exact (rightInternal x hx hb hp).2 + left_owners := by + intro x hx guard j + by_cases hp : x = p1 + · subst x + rcases hmark1cover j with hQcell | hScell | hCcell + · exact Or.inl hQcell + · exact Or.inr (Or.inl hScell) + · exact Or.inr (Or.inr (Or.inl ⟨rfl, hCcell⟩)) + by_cases ha : x = seg.a + · subst x + rcases guard with hOne | hne + · rcases (cutData hOne).1 j with hQcell | hScell | hOcell + · exact Or.inl hQcell + · exact Or.inr (Or.inl hScell) + · exact Or.inr (Or.inr (Or.inr ⟨rfl, hOcell⟩)) + · exact (hne rfl).elim + · rcases (leftInternal x hx hp ha).1 j with hQcell | hScell + · exact Or.inl hQcell + · exact Or.inr (Or.inl hScell) + right_owners := by + intro x hx guard j + by_cases hp : x = p2 + · subst x + rcases hmark2cover j with hRcell | hVcell | hDcell + · exact Or.inl hRcell + · exact Or.inr (Or.inl hVcell) + · exact Or.inr (Or.inr (Or.inl ⟨rfl, hDcell⟩)) + by_cases hb : x = seg.b + · subst x + rcases guard with hOne | hne + · rcases (cutDataR hOne).1 j with hRcell | hVcell | hOcell + · exact Or.inl hRcell + · exact Or.inr (Or.inl hVcell) + · exact Or.inr (Or.inr (Or.inr ⟨rfl, hOcell⟩)) + · exact (hne rfl).elim + · rcases (rightInternal x hx hb hp).1 j with hRcell | hVcell + · exact Or.inl hRcell + · exact Or.inr (Or.inl hVcell) + left_companion := by + intro x hx guard + constructor + · rintro ⟨j, hc⟩ + by_contra hp + by_cases ha : x = seg.a + · subst x + rcases guard with hOne | hne + · exact cutNoC hOne j hc + · exact hne rfl + · rcases (leftInternal x hx hp ha).1 j with hq | hs + · exact Finset.disjoint_left.mp hQC hq hc + · exact Finset.disjoint_left.mp hSC hs hc + · intro hp + subst x + exact hmark1C + right_companion := by + intro x hx guard + constructor + · rintro ⟨j, hd⟩ + by_contra hp + by_cases hb : x = seg.b + · subst x + rcases guard with hOne | hne + · exact cutNoD hOne j hd + · exact hne rfl + · rcases (rightInternal x hx hb hp).1 j with hr | hv + · exact Finset.disjoint_left.mp hRD hr hd + · exact Finset.disjoint_left.mp hVD hv hd + · intro hp + subst x + exact hmark2D + positive_left_precursor := by + intro hOne x hx + constructor + · intro hOinc + have hQS := seg.left_vertices x hx + have hQinc := footprint_incident Q hQne x hQS.1 + have hSinc := footprint_incident S hSne x hQS.2 + have hQmissS : ∃ j, LatticeVertexIncidentCell x j ∉ Q.cells := + ⟨hSinc.choose, fun hq => + Finset.disjoint_left.mp hQSC hq hSinc.choose_spec⟩ + have hSmissQ : ∃ j, LatticeVertexIncidentCell x j ∉ S.cells := + ⟨hQinc.choose, fun hs => + Finset.disjoint_left.mp hQSC hQinc.choose_spec hs⟩ + have hOmissQ : ∃ j, LatticeVertexIncidentCell x j ∉ Q.cells := + ⟨hOinc.choose, fun hq => + Finset.disjoint_left.mp (hQO hOne) hq hOinc.choose_spec⟩ + have hbQ := P3161T2IncidentBoundary Q x hQinc hQmissS + have hbS := P3161T2IncidentBoundary S x hSinc hSmissQ + have hOmissO : ∃ j, LatticeVertexIncidentCell x j ∉ O.cells := + ⟨hQinc.choose, fun ho => + Finset.disjoint_left.mp (hQO hOne) hQinc.choose_spec ho⟩ + have hbO := P3161T2IncidentBoundary O x hOinc hOmissO + exact (seg.first_cut_unique x).mp ⟨hbQ, hbS, hbO⟩ + · intro hxa + subst x + exact (cutData hOne).2.1 + positive_right_precursor := by + intro hOne x hx + constructor + · intro hOinc + have hRV := seg.right_vertices x hx + have hRinc := footprint_incident R hRne x hRV.1 + have hVinc := footprint_incident V hVne x hRV.2 + have hRmissV : ∃ j, LatticeVertexIncidentCell x j ∉ R.cells := + ⟨hVinc.choose, fun hr => + Finset.disjoint_left.mp hRVD hr hVinc.choose_spec⟩ + have hVmissR : ∃ j, LatticeVertexIncidentCell x j ∉ V.cells := + ⟨hRinc.choose, fun hv => + Finset.disjoint_left.mp hRVD hRinc.choose_spec hv⟩ + have hOmissR : ∃ j, LatticeVertexIncidentCell x j ∉ R.cells := + ⟨hOinc.choose, fun hr => + Finset.disjoint_left.mp (hRO hOne) hr hOinc.choose_spec⟩ + have hbR := P3161T2IncidentBoundary R x hRinc hRmissV + have hbV := P3161T2IncidentBoundary V x hVinc hVmissR + have hOmissO : ∃ j, LatticeVertexIncidentCell x j ∉ O.cells := + ⟨hRinc.choose, fun ho => + Finset.disjoint_left.mp (hRO hOne) hRinc.choose_spec ho⟩ + have hbO := P3161T2IncidentBoundary O x hOinc hOmissO + exact (seg.second_cut_unique x).mp ⟨hbR, hbV, hbO⟩ + · intro hxb + subst x + exact (cutDataR hOne).2.1 + positive_cut_separation := cuts_ne_marked + positive_first_cut_no_companion := fun h j => cutNoC h j + positive_second_cut_no_companion := fun h j => cutNoD h j + first_marked_companion := hmark1C + second_marked_companion := hmark2D + first_marked_opposite := hmark1opp + second_marked_opposite := hmark2opp + positive_first_cut_precursor := fun h => (cutData h).2.1 + positive_second_cut_precursor := fun h => (cutDataR h).2.1 + positive_first_cut_opposite := fun h => (cutData h).2.2 + positive_second_cut_opposite := fun h => (cutDataR h).2.2 + empty_cut := seg.empty_cut + proper_middle_modified_boundary := by + intro x hx ha hb + obtain ⟨e, hxe, he, hDne⟩ := middleWalkEdge x hx ha hb + rw [CellDisjointCommonEdgesBoundary (TileCellComplement A O) B hcompB] at he + have hDne' : (TileCellComplement (cert.P 0 true) cert.O).cells.Nonempty := by + simpa [A, O] using hDne + have hBne' : (cert.P 0 false).cells.Nonempty := by simpa [B] using hBne + constructor + · simp only [BoundaryFootprintVertices, ite_eq_left hDne', Set.mem_ofPred_eq] + exact ⟨e, he.1, hxe⟩ + · simp only [BoundaryFootprintVertices, ite_eq_left hBne', Set.mem_ofPred_eq] + exact ⟨e, he.2, hxe⟩ + proper_middle_restored_left := by + intro x hx ha hb j + exact middleRestored x hx ha hb j + proper_middle_not_original_common := by + intro x hx ha hb hxAB + have hmiss := boundary_missing_incident A x hxAB.1 + exact hmiss.choose_spec (middleRestored x hx ha hb hmiss.choose) } + +end RestorationSectorCertificate + +theorem BandExceptionalRestorationSectorOrder + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + ExceptionalRestorationSectorData + (cert.P 0 true) (cert.P 0 false) cert.O + (cert.Q 1 true) (cert.S 2 false) + (cert.Q 2 true) (cert.S 1 false) + (cert.P 1 true) (cert.P 1 false) + (cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) + (cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩)) + cert.exceptional_segments := by +-- BODY + classical + obtain ⟨three_owner_sectors, two_owner_sectors⟩ := + LocalLatticeInterfaceSectors + let A := cert.P 0 true + let B := cert.P 0 false + let C := cert.P 1 true + let D := cert.P 1 false + let O := cert.O + let Q := cert.Q 1 true + let S := cert.S 2 false + let R := cert.Q 2 true + let V := cert.S 1 false + let p1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let p2 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) + let seg := cert.exceptional_segments + have tile_from_band := RestorationSectorGeometry.tile_from_band + have hQ := RestorationSectorGeometry.hQ q cfg C₀ T cert tile_from_band + have hS := RestorationSectorGeometry.hS q cfg C₀ T cert tile_from_band + have hR := RestorationSectorGeometry.hR q cfg C₀ T cert tile_from_band + have hV := RestorationSectorGeometry.hV q cfg C₀ T cert tile_from_band + have hO := RestorationSectorGeometry.hO q cfg C₀ T cert + tile_from_band + have nonempty_cells := RestorationSectorGeometry.nonempty_cells + have touching_disjoint := RestorationSectorGeometry.touching_disjoint + have hA : LatticeTile A := cert.parent_lattice 0 true + have hB : LatticeTile B := cert.parent_lattice 0 false + have hCparent : LatticeTile C := cert.parent_lattice 1 true + have hDparent : LatticeTile D := cert.parent_lattice 1 false + have hAne := nonempty_cells A hA + have hBne := nonempty_cells B hB + have hCne := nonempty_cells C hCparent + have hDne := nonempty_cells D hDparent + have hQne := nonempty_cells Q hQ + have hSne := nonempty_cells S hS + have hRne := nonempty_cells R hR + have hVne := nonempty_cells V hV + have hQSC : Disjoint Q.cells S.cells := + touching_disjoint Q S hQne hSne cert.double_first.1 + have hRVD : Disjoint R.cells V.cells := + touching_disjoint R V hRne hVne cert.double_second.1 + have trzero := RestorationSectorGeometry.trzero + have hsep := BandOriginalPairSeparation cert.P O cert.u cert.v + seg.precursor_in_left seg.precursor_in_right cert.partition + let iA : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let iB : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let iC : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let iD : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + have hcompB : Disjoint (TileCellComplement A O).cells B.cells := + RestorationSectorGeometry.hcompB q cfg C₀ T cert (RestorationSectorGeometry.htileComp q cfg + C₀ T cert trzero) (RestorationSectorGeometry.htileB q cfg C₀ T cert trzero) + have indexed_disjoint (i j : PeriodicSubtileIndex) (hij : i ≠ j) + (hlabels : ¬ ((i.label = .A ∧ j.label = .B ∨ + i.label = .B ∧ j.label = .A) ∧ i.first = j.first ∧ i.second = j.second)) : + Disjoint (SubtileOccurrenceInterpretation cert.P cert.u cert.v i).cells + (SubtileOccurrenceInterpretation cert.P cert.u cert.v j).cells := hsep.2 i j hij hlabels + have hBC := RestorationSectorGeometry.hBC q cfg C₀ T cert trzero + indexed_disjoint + have hBD := RestorationSectorGeometry.hBD q cfg C₀ T cert trzero + indexed_disjoint + have hCD := RestorationSectorGeometry.hCD q cfg C₀ T cert trzero + indexed_disjoint + have hOC := RestorationSectorGeometry.hOC q cfg C₀ T cert (RestorationSectorGeometry.hAC q cfg + C₀ T cert trzero indexed_disjoint) + have hOD := RestorationSectorGeometry.hOD q cfg C₀ T cert (RestorationSectorGeometry.hAD q cfg + C₀ T cert trzero indexed_disjoint) + have hQC : Disjoint Q.cells C.cells := + (touching_disjoint C Q hCne hQne cert.double_first.2.2.1).symm + have hSC : Disjoint S.cells C.cells := + touching_disjoint S C hSne hCne cert.double_first.2.1 + have hRD : Disjoint R.cells D.cells := + (touching_disjoint D R hDne hRne cert.double_second.2.2.1).symm + have hVD : Disjoint V.cells D.cells := + touching_disjoint V D hVne hDne cert.double_second.2.1 + have boundary_raw := RestorationSectorGeometry.boundary_raw + (RestorationSectorGeometry.boundary_edge_footprint) + (RestorationSectorGeometry.edge_vertex_footprint) + have footprint_incident := RestorationSectorGeometry.footprint_incident + have boundary_missing_incident := RestorationSectorGeometry.boundary_missing_incident + have hQO := RestorationSectorGeometry.hQO q cfg + C₀ T cert touching_disjoint hQne + have hSO := RestorationSectorGeometry.hSO q cfg + C₀ T cert touching_disjoint hSne + have hRO := RestorationSectorGeometry.hRO q cfg + C₀ T cert touching_disjoint hRne + have hVO := RestorationSectorGeometry.hVO q cfg + C₀ T cert touching_disjoint hVne + have rho_mem := RestorationSectorGeometry.rho_mem q cfg C₀ T cert + let f1 : PeriodicSubtileFaceIndex := ⟨.I1, 0, 0⟩ + let f2 : PeriodicSubtileFaceIndex := ⟨.I2, 0, 0⟩ + have hp1QS : p1 ∈ FootprintVertices Q ∩ FootprintVertices S := by + exact cert.inner_first + have hp2RV : p2 ∈ FootprintVertices R ∩ FootprintVertices V := by + exact cert.inner_second + have cutData := RestorationSectorGeometry.cutData q cfg C₀ T cert three_owner_sectors hQ hS hO + hQne hSne boundary_raw + have cutDataR := RestorationSectorGeometry.cutDataR q cfg C₀ T cert three_owner_sectors hR hV + hO hRne hVne boundary_raw + have hmark1 := three_owner_sectors Q S C p1 hQ hS hCparent + cert.double_first ⟨hp1QS, (RestorationSectorGeometry.hp1C q cfg C₀ T cert trzero rho_mem)⟩ + have hmark2 := three_owner_sectors R V D p2 hR hV hDparent + cert.double_second ⟨hp2RV, (RestorationSectorGeometry.hp2D q cfg C₀ T cert trzero rho_mem)⟩ + rcases hmark1 with ⟨hmark1cover, hmark1Q, hmark1S, hmark1C, hmark1opp⟩ + rcases hmark2 with ⟨hmark2cover, hmark2R, hmark2V, hmark2D, hmark2opp⟩ + have cutNoC := RestorationSectorGeometry.cutNoC q cfg C₀ T cert hOC hQC hSC cutData + have cutNoD := RestorationSectorGeometry.cutNoD q cfg C₀ T cert hOD hRD hVD cutDataR + have cuts_ne_marked := RestorationSectorGeometry.cuts_ne_marked q cfg C₀ T cert hmark1C hmark2D + cutNoC cutNoD + have splitInternal := RestorationSectorGeometry.splitInternal + have leftInternal := RestorationSectorGeometry.leftInternal q cfg C₀ T cert two_owner_sectors + hQ hS hQSC splitInternal + have rightInternal := RestorationSectorGeometry.rightInternal q cfg C₀ T cert two_owner_sectors + hR hV hRVD splitInternal + have middleRestored := RestorationSectorGeometry.middleRestored q cfg C₀ T cert + (RestorationSectorGeometry.middleInternal q cfg C₀ T cert two_owner_sectors hO splitInternal) + have middleWalkEdge := RestorationSectorGeometry.middleWalkEdge q cfg C₀ T cert splitInternal + have sectorOrderCertificate : + ExceptionalRestorationSectorData + (cert.P 0 true) (cert.P 0 false) cert.O + (cert.Q 1 true) (cert.S 2 false) + (cert.Q 2 true) (cert.S 1 false) + (cert.P 1 true) (cert.P 1 false) + (cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) + (cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩)) + cert.exceptional_segments := RestorationSectorCertificate.sectorOrderCertificate q cfg C₀ T + cert hBne hQne hSne hRne hVne hQSC hRVD hcompB hQC hSC hRD hVD footprint_incident + boundary_missing_incident hQO hRO cutData cutDataR hmark1cover hmark1C hmark1opp + hmark2cover hmark2D hmark2opp cutNoC cutNoD cuts_ne_marked leftInternal rightInternal + middleRestored middleWalkEdge + exact sectorOrderCertificate + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandGenealogy.lean b/LeanPool/ApollonianSuperharmonic/BandGenealogy.lean new file mode 100644 index 0000000000..7d7a3eecfe --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandGenealogy.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandCircle +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: BandGenealogy] + +/-! +# BandGenealogy + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandGenealogy : ∀ C : BandCircle, + C.1.1.1 = 1 ∨ + ∃ q : Fin 4 → CircleCoordinates, + SemiProperQuadruple q ∧ q 0 = C.1.1 ∧ + (∀ j : Fin 3, (q j.succ).1 < C.1.1.1) ∧ + ∀ q' : Fin 4 → CircleCoordinates, + SemiProperQuadruple q' → q' 0 = C.1.1 → + (∀ j : Fin 3, (q' j.succ).1 < C.1.1.1) → + ∀ D : CircleCoordinates, + (∃ j : Fin 3, q j.succ = D) ↔ ∃ j : Fin 3, q' j.succ = D := by +-- BODY + intro C + have genealogy : ∀ (q : Fin 4 → CircleCoordinates), + SemiProperQuadruple q → ∀ i : Fin 4, 0 < (q i).1 → + (q i).1 = 1 ∨ + ∃ p : Fin 4 → CircleCoordinates, + SemiProperQuadruple p ∧ p 0 = q i ∧ + (∀ j : Fin 3, (p j.succ).1 < (q i).1) ∧ + ∀ p' : Fin 4 → CircleCoordinates, + SemiProperQuadruple p' → p' 0 = q i → + (∀ j : Fin 3, (p' j.succ).1 < (q i).1) → + ∀ D : CircleCoordinates, + (∃ j : Fin 3, p j.succ = D) ↔ + ∃ j : Fin 3, p' j.succ = D := by + intro q hq + induction hq with + | base z => + intro i hi + fin_cases i <;> simp_all + | rotate hq ih => + intro i hi + fin_cases i + · exact ih 0 hi + · exact ih 2 hi + · exact ih 3 hi + · exact ih 1 hi + | @successor q hq ih => + let s : Fin 4 → CircleCoordinates := + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + change ∀ i : Fin 4, 0 < (s i).1 → + (s i).1 = 1 ∨ + ∃ p : Fin 4 → CircleCoordinates, + SemiProperQuadruple p ∧ p 0 = s i ∧ + (∀ j : Fin 3, (p j.succ).1 < (s i).1) ∧ + ∀ p' : Fin 4 → CircleCoordinates, + SemiProperQuadruple p' → p' 0 = s i → + (∀ j : Fin 3, (p' j.succ).1 < (s i).1) → + ∀ D : CircleCoordinates, + (∃ j : Fin 3, p j.succ = D) ↔ + ∃ j : Fin 3, p' j.succ = D + have classification : + (s 0).1 = 1 ∨ + (ProperBandQuadruple s ∧ + (q 0).1 < (s 0).1 ∧ + (q 2).1 < (s 0).1 ∧ + (q 3).1 < (s 0).1) := by + simpa [s] using BandSuccessorClassification q hq + intro i hi + fin_cases i + · rcases classification with hunit | hproper + · exact Or.inl (by simpa using hunit) + · rcases hproper with ⟨hs, h01, h02, h03⟩ + right + refine ⟨s, hs.1, ?_, ?_, ?_⟩ + · simp [s] + · intro j + fin_cases j + · simpa [s] using h01 + · simpa [s] using h02 + · simpa [s] using h03 + · intro p' hp' hchild hless D + have hp'proper : ProperBandQuadruple p' := + ⟨hp', by simpa [hchild] using hless⟩ + have hsproper : ProperBandQuadruple s := ⟨hs.1, hs.2⟩ + have hchild_rev : s 0 = p' 0 := by simpa using hchild.symm + obtain ⟨r, hr, _⟩ := + BandPredecessorNoCollision s p' hsproper hp'proper hchild_rev + fin_cases r + · constructor + · rintro ⟨j, hj⟩ + fin_cases j + · exact ⟨0, by simpa [Fin.add_def] using (hr 0).trans hj⟩ + · exact ⟨1, by simpa [Fin.add_def] using (hr 1).trans hj⟩ + · exact ⟨2, by simpa [Fin.add_def] using (hr 2).trans hj⟩ + · rintro ⟨j, hj⟩ + fin_cases j + · exact ⟨0, by simpa [Fin.add_def] using (hr 0).symm.trans hj⟩ + · exact ⟨1, by simpa [Fin.add_def] using (hr 1).symm.trans hj⟩ + · exact ⟨2, by simpa [Fin.add_def] using (hr 2).symm.trans hj⟩ + · constructor + · rintro ⟨j, hj⟩ + fin_cases j + · exact ⟨2, by simpa [Fin.add_def] using (hr 2).trans hj⟩ + · exact ⟨0, by simpa [Fin.add_def] using (hr 0).trans hj⟩ + · exact ⟨1, by simpa [Fin.add_def] using (hr 1).trans hj⟩ + · rintro ⟨j, hj⟩ + fin_cases j + · exact ⟨1, by simpa [Fin.add_def] using (hr 0).symm.trans hj⟩ + · exact ⟨2, by simpa [Fin.add_def] using (hr 1).symm.trans hj⟩ + · exact ⟨0, by simpa [Fin.add_def] using (hr 2).symm.trans hj⟩ + · constructor + · rintro ⟨j, hj⟩ + fin_cases j + · exact ⟨1, by simpa [Fin.add_def] using (hr 1).trans hj⟩ + · exact ⟨2, by simpa [Fin.add_def] using (hr 2).trans hj⟩ + · exact ⟨0, by simpa [Fin.add_def] using (hr 0).trans hj⟩ + · rintro ⟨j, hj⟩ + fin_cases j + · exact ⟨2, by simpa [Fin.add_def] using (hr 0).symm.trans hj⟩ + · exact ⟨0, by simpa [Fin.add_def] using (hr 1).symm.trans hj⟩ + · exact ⟨1, by simpa [Fin.add_def] using (hr 2).symm.trans hj⟩ + · exact ih 0 hi + · exact ih 2 hi + · exact ih 3 hi + rcases C.1.2.2 with ⟨q, hq, j, hj⟩ + have hpositive : 0 < (q j).1 := by simpa [hj] using C.2 + rcases genealogy q hq j hpositive with hunit | ⟨p, hp, hchild, hless, huniq⟩ + · exact Or.inl (by simpa [hj] using hunit) + · right + refine ⟨p, hp, ?_, ?_, ?_⟩ + · simpa [hj] using hchild + · simpa [hj] using hless + · intro p' hp' hchild' hless' D + exact huniq p' hp' (by simpa [hj] using hchild') + (by simpa [hj] using hless') D + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandGeneralCircle.lean b/LeanPool/ApollonianSuperharmonic/BandGeneralCircle.lean new file mode 100644 index 0000000000..11470d4c45 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandGeneralCircle.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple + +-- [TABLET NODE: BandGeneralCircle] + +/-! +# BandGeneralCircle + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The band packing of general circles, denoted $\mathcal B^{\rm gen}$, consists +of the raw integral curvature-coordinate pairs +$C=(c,w)\in\mathbb Z\times\mathbb Z[i]$ which occur as an entry of a +semi-proper Descartes quadruple and satisfy +$$ + c>0\qquad\text{or}\qquad + c=0\ \text{ and }\ w\in\{1,-1\}. +$$ +Pairs in the first alternative are called positive-curvature coordinates. +The two pairs in the second alternative are retained solely as the two +admissible oriented-line coordinate symbols for Descartes recursion; their +second coordinates are the corresponding unit Gaussian normals. Equality +in $\mathcal B^{\rm gen}$ is coordinate equality. In particular, no other +curvature-zero raw pair belongs to $\mathcal B^{\rm gen}$. +-/ +def BandGeneralCircle : Type := +-- BODY + {C : CircleCoordinates // + (0 < C.1 ∨ (C.1 = 0 ∧ (C.2 = 1 ∨ C.2 = -1))) ∧ + ∃ q : Fin 4 → CircleCoordinates, + SemiProperQuadruple q ∧ ∃ j : Fin 4, q j = C} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandInterfaceRootedForest.lean b/LeanPool/ApollonianSuperharmonic/BandInterfaceRootedForest.lean new file mode 100644 index 0000000000..7800ceeaea --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandInterfaceRootedForest.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOdometerInteriorTable +public import LeanPool.ApollonianSuperharmonic.PeriodicTileTotalIndegree +public import LeanPool.ApollonianSuperharmonic.P4250T2InterfaceCycleExclusion +public import LeanPool.ApollonianSuperharmonic.P4250T2PrecursorRootSeparation +public import LeanPool.ApollonianSuperharmonic.P4250T2InterfaceNeighborCount +public import LeanPool.ApollonianSuperharmonic.P4250T2IndegreeSubtraction +public import LeanPool.ApollonianSuperharmonic.P4250T2FiniteForestCompletion + +-- [TABLET NODE: BandInterfaceRootedForest] + +/-! +# BandInterfaceRootedForest + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandInterfaceRootedForest + (C : BandCircle) (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (h : PartialOdometer) (hs : Fin 3 → Bool → PartialOdometer) + (g : IntegerLatticeFunction) + (hT : BandPrototile (q 0) T) + (hlat : LatticeTile T) + (hodo : TileOdometer (q 0) T h) + (hdom : (h.domain : Set GaussianInt) = FootprintVertices T) + (hsub : ∀ i s, TileOdometer (q i.succ) (cert.P i s) (hs i s)) + (hsdom : ∀ i s, ((hs i s).domain : Set GaussianInt) = + FootprintVertices (cert.P i s)) + (hext : GlobalOdometerExtends g h) + (hrest : ∀ i s, GlobalOdometerExtends g (hs i s)) + (htile : ExactTileTiling (RegularTileFamily T (TilingLattice C))) + (hweb : ∀ x, x ∈ BoundaryFootprintVertices T → + FourNeighborLaplacian g x = 1) + (hperiod : ∃ b : ℝ × ℝ, ∀ v, v ∈ TilingLattice C → ∀ x, + (g (x + v) : ℝ) - LatticeQuadraticForm (CircleMatrix C) (x + v) - + (b.1 * (x + v).re + b.2 * (x + v).im) = + (g x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x - + (b.1 * x.re + b.2 * x.im)) + (hPorient : + let D := h.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _) + let P := D.filter fun x => + @decide (∃ i s, x ∈ (hs i s).domain ∧ + x ∉ BoundaryFootprintVertices (cert.P i s)) (Classical.propDecidable _) + Nonempty (AcyclicIndegreeOrientation P + (fun x => 2 + FourNeighborLaplacian g x))) : + let D := h.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _) + let P := D.filter fun x => + @decide (∃ i s, x ∈ (hs i s).domain ∧ + x ∉ BoundaryFootprintVertices (cert.P i s)) (Classical.propDecidable _) + let W := D \ P + ∃ R : Finset GaussianInt, + RootedFourNeighborForest W R ∧ R.card ≤ 2 ∧ + ∀ x ∈ W, + (2 + FourNeighborLaplacian g x) - + (((P.filter fun y => @decide (FourNeighborAdjacent y x) + (Classical.propDecidable _)).card : ℕ) : ℤ) = + 1 - if x ∈ R then 1 else 0 := by +-- BODY + classical + let D := h.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _) + let P := D.filter fun x => + @decide (∃ i s, x ∈ (hs i s).domain ∧ + x ∉ BoundaryFootprintVertices (cert.P i s)) (Classical.propDecidable _) + let W := D \ P + let R : Finset GaussianInt := {cert.precursor_boundary.a, cert.precursor_boundary.b} + have hD : ∀ x, x ∈ D ↔ + x ∈ FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T := by + intro x + have hmem : x ∈ h.domain ↔ x ∈ FootprintVertices T := by + change x ∈ (h.domain : Set GaussianInt) ↔ _ + rw [hdom] + simp only [D, Finset.mem_filter, decide_eq_true_eq, hmem] + have hP : ∀ x, x ∈ P ↔ x ∈ D ∧ ∃ i s, + x ∈ FootprintVertices (cert.P i s) ∧ + x ∉ BoundaryFootprintVertices (cert.P i s) := by + intro x + have hmem : ∀ i s, x ∈ (hs i s).domain ↔ + x ∈ FootprintVertices (cert.P i s) := by + intro i s + change x ∈ ((hs i s).domain : Set GaussianInt) ↔ _ + rw [hsdom] + simp only [P, Finset.mem_filter, decide_eq_true_eq, hmem] + have hPD : P ⊆ D := Finset.filter_subset _ _ + obtain ⟨hattach, hcycle⟩ := + P4250T2InterfaceCycleExclusion C q cfg T cert hT hlat D P hD hP + obtain ⟨hRW, hprecursor, hrootType, hcentral, hseparate⟩ := + P4250T2PrecursorRootSeparation C q cfg T cert hT hlat D P hD hP hattach + have hneighbors := P4250T2InterfaceNeighborCount + C q cfg T cert hT hlat D P hD hP hprecursor hcentral + have residual : ∀ x ∈ W, + (2 + FourNeighborLaplacian g x) - + ((P.filter fun y => @decide (FourNeighborAdjacent y x) + (Classical.propDecidable _)).card : ℤ) = + 1 - if x ∈ R then 1 else 0 := by + intro x hx + have hxT := (hD x).mp (Finset.mem_sdiff.mp hx).1 + have table := BandOdometerInteriorTable q cfg.proper T cert.P h hs g + hT hodo hext cert.outer_occurrence cert.outer_union hsub hrest x hxT.1 hxT.2 + have neighbors := hneighbors x hx + dsimp only at table neighbors + by_cases hr : x ∈ R + · obtain ⟨hk, hc⟩ := hrootType x hr + have hn := neighbors.2 hr + by_cases ho : cert.O.cells = ∅ + · have hl := table.2.1 hk (hc.mpr ho) + rw [ite_eq_left ho] at hn + simp only [hl, hn, ite_eq_left hr] + norm_num + · have hnc : GaussianRealPoint x ≠ TileCentroid T := + fun hcenter => ho (hc.mp hcenter) + have hl := table.1 hk hnc + rw [ite_eq_right ho] at hn + simp only [hl, hn, ite_eq_left hr] + norm_num + · obtain ⟨hn, hk, hnc⟩ := neighbors.1 hr + rcases hk with hk | hk + · have hl := table.1 hk hnc + rw [hl, ite_eq_right hr] + omega + · have hl := table.2.2.1 hk + rw [hl, ite_eq_right hr] + omega + have hTC : BandPrototile C.1.1 T := cert.child_eq ▸ hT + have total := PeriodicTileTotalIndegree C T h g hdom hTC hlat htile hweb hperiod + have subtracted := P4250T2IndegreeSubtraction D P + (fun x => 2 + FourNeighborLaplacian g x) hPD hPorient total + have hcount : (∑ x ∈ W, (1 - if x ∈ R then (1 : ℤ) else 0)) = + ((((W.product W).filter fun e => @decide (FourNeighborAdjacent e.1 e.2) + (Classical.propDecidable _)).card / 2 : ℕ) : ℤ) := by + calc + _ = ∑ x ∈ W, ((2 + FourNeighborLaplacian g x) - + ((P.filter fun y => @decide (FourNeighborAdjacent y x) + (Classical.propDecidable _)).card : ℤ)) := + Finset.sum_congr rfl (fun x hx => (residual x hx).symm) + _ = _ := subtracted + exact ⟨R, P4250T2FiniteForestCompletion W R hRW hcycle hseparate hcount, + Finset.card_le_two, residual⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandLatticeEquality.lean b/LeanPool/ApollonianSuperharmonic/BandLatticeEquality.lean new file mode 100644 index 0000000000..382dbd4f5b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandLatticeEquality.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegralityLatticeIndex + +-- [TABLET NODE: BandLatticeEquality] + +/-! +# BandLatticeEquality + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandLatticeEquality : ∀ C : BandCircle, + IntegralityLattice C = TilingLattice C := by +-- BODY + intro C + classical + obtain ⟨R, hR, hRcard⟩ := IntegralityLatticeIndex C + obtain ⟨S, hS, hScard⟩ := TilingLatticeIndex C + have contain : TilingLattice C ≤ IntegralityLattice C := TilingLatticeInclusion C + let representative : GaussianInt → GaussianInt := fun x => + Classical.choose (hS x) + have representative_spec (x : GaussianInt) : + representative x ∈ S ∧ x - representative x ∈ TilingLattice C := by + exact (Classical.choose_spec (hS x)).1 + have representative_injective : Set.InjOn representative (↑R : Set GaussianInt) := by + intro x hx y hy hxy + have hxS := representative_spec x + have hyS := representative_spec y + have hxi : x - representative x ∈ IntegralityLattice C := contain hxS.2 + have hyi : y - representative y ∈ IntegralityLattice C := contain hyS.2 + have hxyI : x - y ∈ IntegralityLattice C := by + simpa [sub_eq_add_neg, hxy, add_assoc, add_left_comm, add_comm] using + (IntegralityLattice C).sub_mem hxi hyi + apply (hR x).unique + · exact ⟨hx, (by simp)⟩ + · exact ⟨hy, hxyI⟩ + have image_eq : Finset.image representative R = S := by + apply Finset.eq_of_subset_of_card_le + · intro z hz + obtain ⟨a, ha, haz⟩ := Finset.mem_image.mp hz + rw [← haz] + exact (representative_spec a).1 + · rw [Finset.card_image_of_injOn representative_injective, hRcard, hScard] + have representative_congruent (x y : GaussianInt) + (hxy : x - y ∈ IntegralityLattice C) : representative x = representative y := by + have hxmem : representative x ∈ Finset.image representative R := by + rw [image_eq] + exact (representative_spec x).1 + have hymem : representative y ∈ Finset.image representative R := by + rw [image_eq] + exact (representative_spec y).1 + obtain ⟨r, hr, hrf⟩ := Finset.mem_image.mp hxmem + obtain ⟨q, hq, hqf⟩ := Finset.mem_image.mp hymem + have hxr : x - r ∈ TilingLattice C := by + have hsum := (TilingLattice C).add_mem (representative_spec x).2 + ((TilingLattice C).neg_mem (representative_spec r).2) + simpa [sub_eq_add_neg, ← hrf] using hsum + have hyq : y - q ∈ TilingLattice C := by + have hsum := (TilingLattice C).add_mem (representative_spec y).2 + ((TilingLattice C).neg_mem (representative_spec q).2) + simpa [sub_eq_add_neg, ← hqf] using hsum + have hyr : y - r ∈ IntegralityLattice C := by + have hsum := (IntegralityLattice C).add_mem + ((IntegralityLattice C).neg_mem hxy) (contain hxr) + convert hsum using 1; abel + have hqr : q = r := by + apply (hR y).unique + · exact ⟨hq, contain hyq⟩ + · exact ⟨hr, hyr⟩ + rw [← hqf, hqr, hrf] + apply le_antisymm + · intro x hx + have hrep : representative x = representative 0 := + representative_congruent x 0 (by simpa using hx) + have hxf := (representative_spec x).2 + have hzero := (representative_spec 0).2 + have hdiff : x - representative 0 ∈ TilingLattice C := by + simpa [hrep] using hxf + have hsum := (TilingLattice C).add_mem hdiff + ((TilingLattice C).neg_mem hzero) + convert hsum using 1; abel + · exact contain + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandModifiedCellPartition.lean b/LeanPool/ApollonianSuperharmonic/BandModifiedCellPartition.lean new file mode 100644 index 0000000000..866ee05987 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandModifiedCellPartition.lean @@ -0,0 +1,574 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeFundamentalSet +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileArea + +-- [TABLET NODE: BandModifiedCellPartition] + +/-! +# BandModifiedCellPartition + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ModifiedCellPartitionConstruction + +private noncomputable abbrev base (P : Fin 3 -> Bool -> ProtoTile) (O : ProtoTile) : + SixSubtileLabel → Finset GaussianInt := by + classical + exact fun j => + match j with + | .A => (P 0 true).cells \ O.cells + | .B => (P 0 false).cells + | .C => (P 1 true).cells + | .D => (P 1 false).cells + | .E => (P 2 true).cells + | .F => (P 2 false).cells + +private noncomputable abbrev incidences (P : Fin 3 -> Bool -> ProtoTile) (O : ProtoTile) : Finset + (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ (base P O) j}) := by + classical + let base : SixSubtileLabel → Finset GaussianInt := fun j => + match j with + | .A => (P 0 true).cells \ O.cells + | .B => (P 0 false).cells + | .C => (P 1 true).cells + | .D => (P 1 false).cells + | .E => (P 2 true).cells + | .F => (P 2 false).cells + change (Finset (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j})) + exact Finset.sigma ({.A, .B, .C, .D, .E, .F} : Finset SixSubtileLabel) + (fun j => (base j).attach) + +private noncomputable abbrev representative (L : AddSubgroup GaussianInt) (R : Finset + GaussianInt) (hfund : LatticeFundamentalSet L R) : GaussianInt → GaussianInt := by + classical + exact fun y => + Classical.choose (hfund y) + +private theorem representative_spec (L : AddSubgroup GaussianInt) (R : Finset GaussianInt) (hfund + : LatticeFundamentalSet L R) (y : GaussianInt) : + (representative L R hfund) y ∈ R ∧ y - (representative L R hfund) y ∈ L := by + classical + let representative : GaussianInt → GaussianInt := fun y => + Classical.choose (hfund y) + change (representative y ∈ R ∧ y - representative y ∈ L) + exact (Classical.choose_spec (hfund y)).1 + +private theorem map_mem (P : Fin 3 -> Bool -> ProtoTile) (O : ProtoTile) (L : AddSubgroup + GaussianInt) (R : Finset GaussianInt) (hfund : LatticeFundamentalSet L R) (z : Σ j : + SixSubtileLabel, {y : GaussianInt // y ∈ (base P O) j}) : + (representative L R hfund) z.2 ∈ R := by + classical + let base : SixSubtileLabel → Finset GaussianInt := fun j => + match j with + | .A => (P 0 true).cells \ O.cells + | .B => (P 0 false).cells + | .C => (P 1 true).cells + | .D => (P 1 false).cells + | .E => (P 2 true).cells + | .F => (P 2 false).cells + let representative : GaussianInt → GaussianInt := fun y => + Classical.choose (hfund y) + have representative_spec (y : GaussianInt) : + representative y ∈ R ∧ y - representative y ∈ L := representative_spec L R hfund y + change (representative z.2 ∈ R) + exact (representative_spec z.2).1 + +private noncomputable abbrev mapped (P : Fin 3 -> Bool -> ProtoTile) (O : ProtoTile) (L : + AddSubgroup GaussianInt) (R : Finset GaussianInt) (hfund : LatticeFundamentalSet L R) : (Σ j + : SixSubtileLabel, {y : GaussianInt // y ∈ (base P O) j}) → GaussianInt := by + classical + let base : SixSubtileLabel → Finset GaussianInt := fun j => + match j with + | .A => (P 0 true).cells \ O.cells + | .B => (P 0 false).cells + | .C => (P 1 true).cells + | .D => (P 1 false).cells + | .E => (P 2 true).cells + | .F => (P 2 false).cells + let representative : GaussianInt → GaussianInt := fun y => + Classical.choose (hfund y) + change ((Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}) → GaussianInt) + exact fun z => representative z.2 + +private theorem hsurj (P : Fin 3 -> Bool -> ProtoTile) (O : ProtoTile) (u : GaussianInt) (v : + GaussianInt) (L : AddSubgroup GaussianInt) (R : Finset GaussianInt) (hu : u ∈ L) (hv : v ∈ L) + (hfund : LatticeFundamentalSet L R) (hcover : forall x : LatticeCell, exists o : + PeriodicSubtileIndex, + x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells) : Set.SurjOn (mapped P O L R + hfund) ((incidences P O) : Set _) (R : Set GaussianInt) := by + classical + let base : SixSubtileLabel → Finset GaussianInt := fun j => + match j with + | .A => (P 0 true).cells \ O.cells + | .B => (P 0 false).cells + | .C => (P 1 true).cells + | .D => (P 1 false).cells + | .E => (P 2 true).cells + | .F => (P 2 false).cells + let incidences : Finset (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}) := + Finset.sigma ({.A, .B, .C, .D, .E, .F} : Finset SixSubtileLabel) + (fun j => (base j).attach) + let representative : GaussianInt → GaussianInt := fun y => + Classical.choose (hfund y) + have representative_spec (y : GaussianInt) : + representative y ∈ R ∧ y - representative y ∈ L := representative_spec L R hfund y + let mapped : (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}) → GaussianInt := + fun z => representative z.2 + change (Set.SurjOn mapped (incidences : Set _) (R : Set GaussianInt)) + intro r hr + obtain ⟨o, ho⟩ := hcover r + cases o with + | mk label first second => + cases label with + | A => + change r ∈ (TileCellComplement (P 0 true) O).cells.image + (GaussianTranslation ((first : GaussianInt) * u + (second : GaussianInt) * v)) at ho + obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp ho + have hyb : y ∈ base .A := by simpa [base, TileCellComplement] using hy + have hyl : y - r ∈ L := by + rw [← heq] + dsimp [GaussianTranslation] + have h1 : (first : GaussianInt) * u ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hu first + have h2 : (second : GaussianInt) * v ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hv second + convert L.neg_mem (L.add_mem h1 h2) using 1; abel + have hre : representative y = r := by + apply (hfund y).unique + · exact ⟨(representative_spec y).1, (representative_spec y).2⟩ + · exact ⟨hr, hyl⟩ + refine ⟨⟨.A, ⟨y, hyb⟩⟩, ?_, hre⟩ + simp [incidences] + | B => + change r ∈ (P 0 false).cells.image + (GaussianTranslation ((first : GaussianInt) * u + (second : GaussianInt) * v)) at ho + obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp ho + have hyb : y ∈ base .B := by simpa [base] using hy + have hyl : y - r ∈ L := by + rw [← heq] + dsimp [GaussianTranslation] + have h1 : (first : GaussianInt) * u ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hu first + have h2 : (second : GaussianInt) * v ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hv second + convert L.neg_mem (L.add_mem h1 h2) using 1; abel + have hre : representative y = r := by + apply (hfund y).unique + · exact ⟨(representative_spec y).1, (representative_spec y).2⟩ + · exact ⟨hr, hyl⟩ + refine ⟨⟨.B, ⟨y, hyb⟩⟩, ?_, hre⟩ + simp [incidences] + | C => + change r ∈ (P 1 true).cells.image + (GaussianTranslation ((first : GaussianInt) * u + (second : GaussianInt) * v)) at ho + obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp ho + have hyb : y ∈ base .C := by simpa [base] using hy + have hyl : y - r ∈ L := by + rw [← heq] + dsimp [GaussianTranslation] + have h1 : (first : GaussianInt) * u ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hu first + have h2 : (second : GaussianInt) * v ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hv second + convert L.neg_mem (L.add_mem h1 h2) using 1; abel + have hre : representative y = r := by + apply (hfund y).unique + · exact ⟨(representative_spec y).1, (representative_spec y).2⟩ + · exact ⟨hr, hyl⟩ + refine ⟨⟨.C, ⟨y, hyb⟩⟩, ?_, hre⟩ + simp [incidences] + | D => + change r ∈ (P 1 false).cells.image + (GaussianTranslation ((first : GaussianInt) * u + (second : GaussianInt) * v)) at ho + obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp ho + have hyb : y ∈ base .D := by simpa [base] using hy + have hyl : y - r ∈ L := by + rw [← heq] + dsimp [GaussianTranslation] + have h1 : (first : GaussianInt) * u ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hu first + have h2 : (second : GaussianInt) * v ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hv second + convert L.neg_mem (L.add_mem h1 h2) using 1; abel + have hre : representative y = r := by + apply (hfund y).unique + · exact ⟨(representative_spec y).1, (representative_spec y).2⟩ + · exact ⟨hr, hyl⟩ + refine ⟨⟨.D, ⟨y, hyb⟩⟩, ?_, hre⟩ + simp [incidences] + | E => + change r ∈ (P 2 true).cells.image + (GaussianTranslation ((first : GaussianInt) * u + (second : GaussianInt) * v)) at ho + obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp ho + have hyb : y ∈ base .E := by simpa [base] using hy + have hyl : y - r ∈ L := by + rw [← heq] + dsimp [GaussianTranslation] + have h1 : (first : GaussianInt) * u ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hu first + have h2 : (second : GaussianInt) * v ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hv second + convert L.neg_mem (L.add_mem h1 h2) using 1; abel + have hre : representative y = r := by + apply (hfund y).unique + · exact ⟨(representative_spec y).1, (representative_spec y).2⟩ + · exact ⟨hr, hyl⟩ + refine ⟨⟨.E, ⟨y, hyb⟩⟩, ?_, hre⟩ + simp [incidences] + | F => + change r ∈ (P 2 false).cells.image + (GaussianTranslation ((first : GaussianInt) * u + (second : GaussianInt) * v)) at ho + obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp ho + have hyb : y ∈ base .F := by simpa [base] using hy + have hyl : y - r ∈ L := by + rw [← heq] + dsimp [GaussianTranslation] + have h1 : (first : GaussianInt) * u ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hu first + have h2 : (second : GaussianInt) * v ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hv second + convert L.neg_mem (L.add_mem h1 h2) using 1; abel + have hre : representative y = r := by + apply (hfund y).unique + · exact ⟨(representative_spec y).1, (representative_spec y).2⟩ + · exact ⟨hr, hyl⟩ + refine ⟨⟨.F, ⟨y, hyb⟩⟩, ?_, hre⟩ + simp [incidences] + +private theorem hcard (P : Fin 3 -> Bool -> ProtoTile) (O : ProtoTile) (R : Finset GaussianInt) + (harea : TileArea (TileCellComplement (P 0 true) O) + + TileArea (P 0 false) + TileArea (P 1 true) + + TileArea (P 1 false) + TileArea (P 2 true) + + TileArea (P 2 false) = R.card) : (incidences P O).card = R.card := by + classical + let base : SixSubtileLabel → Finset GaussianInt := fun j => + match j with + | .A => (P 0 true).cells \ O.cells + | .B => (P 0 false).cells + | .C => (P 1 true).cells + | .D => (P 1 false).cells + | .E => (P 2 true).cells + | .F => (P 2 false).cells + let incidences : Finset (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}) := + Finset.sigma ({.A, .B, .C, .D, .E, .F} : Finset SixSubtileLabel) + (fun j => (base j).attach) + change (incidences.card = R.card) + simp [incidences, base, TileArea] at harea ⊢ + simp [TileCellComplement] at harea ⊢ + omega + +private theorem himage (P : Fin 3 -> Bool -> ProtoTile) (O : ProtoTile) (u : GaussianInt) (v : + GaussianInt) (L : AddSubgroup GaussianInt) (R : Finset GaussianInt) (hu : u ∈ L) (hv : v ∈ L) + (hfund : LatticeFundamentalSet L R) (hcover : forall x : LatticeCell, exists o : + PeriodicSubtileIndex, + x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells) : (incidences P O).image + (mapped P O L R hfund) = R := by + classical + let base : SixSubtileLabel → Finset GaussianInt := fun j => + match j with + | .A => (P 0 true).cells \ O.cells + | .B => (P 0 false).cells + | .C => (P 1 true).cells + | .D => (P 1 false).cells + | .E => (P 2 true).cells + | .F => (P 2 false).cells + let incidences : Finset (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}) := + Finset.sigma ({.A, .B, .C, .D, .E, .F} : Finset SixSubtileLabel) + (fun j => (base j).attach) + let representative : GaussianInt → GaussianInt := fun y => + Classical.choose (hfund y) + have map_mem (z : Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}) : + representative z.2 ∈ R := map_mem P O L R hfund z + let mapped : (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}) → GaussianInt := + fun z => representative z.2 + have hsurj : Set.SurjOn mapped (incidences : Set _) (R : Set GaussianInt) := hsurj P O u v L R + hu hv hfund hcover + change (incidences.image mapped = R) + apply Finset.eq_of_subset_of_card_le + · intro z hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + exact map_mem w + · apply Finset.card_le_card + intro z hz + obtain ⟨w, hw, hwm⟩ := hsurj hz + exact Finset.mem_image.mpr ⟨w, hw, hwm⟩ + +private theorem hinj (P : Fin 3 -> Bool -> ProtoTile) (O : ProtoTile) (u : GaussianInt) (v : + GaussianInt) (L : AddSubgroup GaussianInt) (R : Finset GaussianInt) (hu : u ∈ L) (hv : v ∈ L) + (hfund : LatticeFundamentalSet L R) (hcover : forall x : LatticeCell, exists o : + PeriodicSubtileIndex, + x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells) (harea : TileArea + (TileCellComplement (P 0 true) O) + + TileArea (P 0 false) + TileArea (P 1 true) + + TileArea (P 1 false) + TileArea (P 2 true) + + TileArea (P 2 false) = R.card) : Set.InjOn (mapped P O L R hfund) ((incidences P O) : Set + _) := by + classical + let base : SixSubtileLabel → Finset GaussianInt := fun j => + match j with + | .A => (P 0 true).cells \ O.cells + | .B => (P 0 false).cells + | .C => (P 1 true).cells + | .D => (P 1 false).cells + | .E => (P 2 true).cells + | .F => (P 2 false).cells + let incidences : Finset (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}) := + Finset.sigma ({.A, .B, .C, .D, .E, .F} : Finset SixSubtileLabel) + (fun j => (base j).attach) + let representative : GaussianInt → GaussianInt := fun y => + Classical.choose (hfund y) + let mapped : (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}) → GaussianInt := + fun z => representative z.2 + have hcard : incidences.card = R.card := hcard P O R harea + have himage : incidences.image mapped = R := himage P O u v L R hu hv hfund hcover + change (Set.InjOn mapped (incidences : Set _)) + apply (Finset.card_image_iff).mp + rw [himage, hcard] + +private theorem decode (P : Fin 3 -> Bool -> ProtoTile) (O : ProtoTile) (u : GaussianInt) (v : + GaussianInt) : ∀ (o : PeriodicSubtileIndex) (x : GaussianInt), + x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells → + ∃ z : (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ (base P O) j}), + z ∈ (incidences P O) ∧ z.1 = o.label ∧ x = z.2 + (o.first : GaussianInt) * u + + (o.second : GaussianInt) * v := by + classical + let base : SixSubtileLabel → Finset GaussianInt := fun j => + match j with + | .A => (P 0 true).cells \ O.cells + | .B => (P 0 false).cells + | .C => (P 1 true).cells + | .D => (P 1 false).cells + | .E => (P 2 true).cells + | .F => (P 2 false).cells + let incidences : Finset (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}) := + Finset.sigma ({.A, .B, .C, .D, .E, .F} : Finset SixSubtileLabel) + (fun j => (base j).attach) + change (∀ (o : PeriodicSubtileIndex) (x : GaussianInt), + x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells → + ∃ z : (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}), + z ∈ incidences ∧ z.1 = o.label ∧ x = z.2 + (o.first : GaussianInt) * u + + (o.second : GaussianInt) * v) + intro o x hx + cases o with + | mk label first second => + cases label with + | A => + change x ∈ (TileCellComplement (P 0 true) O).cells.image + (GaussianTranslation ((first : GaussianInt) * u + (second : GaussianInt) * v)) at hx + obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp hx + refine ⟨⟨.A, ⟨y, by simpa [base, TileCellComplement] using hy⟩⟩, ?_, rfl, ?_⟩ + · simp [incidences] + · dsimp [GaussianTranslation] at heq + simpa [add_assoc] using heq.symm + | B => + change x ∈ (P 0 false).cells.image + (GaussianTranslation ((first : GaussianInt) * u + (second : GaussianInt) * v)) at hx + obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp hx + refine ⟨⟨.B, ⟨y, by simpa [base] using hy⟩⟩, ?_, rfl, ?_⟩ + · simp [incidences] + · dsimp [GaussianTranslation] at heq + simpa [add_assoc] using heq.symm + | C => + change x ∈ (P 1 true).cells.image + (GaussianTranslation ((first : GaussianInt) * u + (second : GaussianInt) * v)) at hx + obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp hx + refine ⟨⟨.C, ⟨y, by simpa [base] using hy⟩⟩, ?_, rfl, ?_⟩ + · simp [incidences] + · dsimp [GaussianTranslation] at heq + simpa [add_assoc] using heq.symm + | D => + change x ∈ (P 1 false).cells.image + (GaussianTranslation ((first : GaussianInt) * u + (second : GaussianInt) * v)) at hx + obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp hx + refine ⟨⟨.D, ⟨y, by simpa [base] using hy⟩⟩, ?_, rfl, ?_⟩ + · simp [incidences] + · dsimp [GaussianTranslation] at heq + simpa [add_assoc] using heq.symm + | E => + change x ∈ (P 2 true).cells.image + (GaussianTranslation ((first : GaussianInt) * u + (second : GaussianInt) * v)) at hx + obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp hx + refine ⟨⟨.E, ⟨y, by simpa [base] using hy⟩⟩, ?_, rfl, ?_⟩ + · simp [incidences] + · dsimp [GaussianTranslation] at heq + simpa [add_assoc] using heq.symm + | F => + change x ∈ (P 2 false).cells.image + (GaussianTranslation ((first : GaussianInt) * u + (second : GaussianInt) * v)) at hx + obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp hx + refine ⟨⟨.F, ⟨y, by simpa [base] using hy⟩⟩, ?_, rfl, ?_⟩ + · simp [incidences] + · dsimp [GaussianTranslation] at heq + simpa [add_assoc] using heq.symm + +end ModifiedCellPartitionConstruction + +theorem BandModifiedCellPartition (P : Fin 3 -> Bool -> ProtoTile) + (O : ProtoTile) (u v : GaussianInt) + (L : AddSubgroup GaussianInt) (R : Finset GaussianInt) + (hu : u ∈ L) (hv : v ∈ L) + (hfund : LatticeFundamentalSet L R) + (hcoords : ∀ w : L, ∃! mn : Int × Int, + ((mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v) = + (w : GaussianInt)) + (hcover : forall x : LatticeCell, exists o : PeriodicSubtileIndex, + x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells) + (harea : TileArea (TileCellComplement (P 0 true) O) + + TileArea (P 0 false) + TileArea (P 1 true) + + TileArea (P 1 false) + TileArea (P 2 true) + + TileArea (P 2 false) = R.card) : + ∀ x : LatticeCell, ∃! o : PeriodicSubtileIndex, + x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells := by +-- BODY + classical + let base : SixSubtileLabel → Finset GaussianInt := fun j => + match j with + | .A => (P 0 true).cells \ O.cells + | .B => (P 0 false).cells + | .C => (P 1 true).cells + | .D => (P 1 false).cells + | .E => (P 2 true).cells + | .F => (P 2 false).cells + let incidences : Finset (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}) := + Finset.sigma ({.A, .B, .C, .D, .E, .F} : Finset SixSubtileLabel) + (fun j => (base j).attach) + let representative : GaussianInt → GaussianInt := fun y => + Classical.choose (hfund y) + have representative_spec (y : GaussianInt) : + representative y ∈ R ∧ y - representative y ∈ L := + ModifiedCellPartitionConstruction.representative_spec L R hfund y + have map_mem (z : Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}) : + representative z.2 ∈ R := ModifiedCellPartitionConstruction.map_mem P O L R hfund z + let mapped : (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}) → GaussianInt := + fun z => representative z.2 + have hsurj : Set.SurjOn mapped (incidences : Set _) (R : Set GaussianInt) := + ModifiedCellPartitionConstruction.hsurj P O u v L R hu hv hfund hcover + have hcard : incidences.card = R.card := ModifiedCellPartitionConstruction.hcard P O R harea + have himage : incidences.image mapped = R := ModifiedCellPartitionConstruction.himage P O u v L + R hu hv hfund hcover + have hinj : Set.InjOn mapped (incidences : Set _) := ModifiedCellPartitionConstruction.hinj P O + u v L R hu hv hfund hcover harea + have decode : ∀ (o : PeriodicSubtileIndex) (x : GaussianInt), + x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells → + ∃ z : (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}), + z ∈ incidences ∧ z.1 = o.label ∧ x = z.2 + (o.first : GaussianInt) * u + + (o.second : GaussianInt) * v := ModifiedCellPartitionConstruction.decode P O u v + intro x + obtain ⟨o, ho⟩ := hcover x + refine ⟨o, ho, ?_⟩ + intro q hq + obtain ⟨z, hz, hzl, heqz⟩ := decode o x ho + obtain ⟨w, hw, hwl, heqw⟩ := decode q x hq + have hshift : ((o.first : GaussianInt) * u + (o.second : GaussianInt) * v) - + ((q.first : GaussianInt) * u + (q.second : GaussianInt) * v) ∈ L := by + have ho1 : (o.first : GaussianInt) * u ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hu o.first + have ho2 : (o.second : GaussianInt) * v ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hv o.second + have hq1 : (q.first : GaussianInt) * u ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hu q.first + have hq2 : (q.second : GaussianInt) * v ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hv q.second + exact L.sub_mem (L.add_mem ho1 ho2) (L.add_mem hq1 hq2) + have hycoset : (z.2 : GaussianInt) - (w.2 : GaussianInt) ∈ L := by + have he : (z.2 : GaussianInt) + + ((o.first : GaussianInt) * u + (o.second : GaussianInt) * v) = + (w.2 : GaussianInt) + + ((q.first : GaussianInt) * u + (q.second : GaussianInt) * v) := + by simpa [add_assoc] using heqz.symm.trans heqw + have he' : (z.2 : GaussianInt) - (w.2 : GaussianInt) = - + (((o.first : GaussianInt) * u + (o.second : GaussianInt) * v) - + ((q.first : GaussianInt) * u + (q.second : GaussianInt) * v)) := by + have he2 : ((z.2 : GaussianInt) + + ((o.first : GaussianInt) * u + (o.second : GaussianInt) * v)) - + ((w.2 : GaussianInt) + + ((q.first : GaussianInt) * u + (q.second : GaussianInt) * v)) = 0 := by + rw [he] + abel + calc + (z.2 : GaussianInt) - (w.2 : GaussianInt) = + ((z.2 : GaussianInt) + ((o.first : GaussianInt) * u + (o.second : GaussianInt) * v)) - + ((w.2 : GaussianInt) + ((q.first : GaussianInt) * u + (q.second : GaussianInt) * v)) - + (((o.first : GaussianInt) * u + (o.second : GaussianInt) * v) - + ((q.first : GaussianInt) * u + (q.second : GaussianInt) * v)) := by abel + _ = -(((o.first : GaussianInt) * u + (o.second : GaussianInt) * v) - + ((q.first : GaussianInt) * u + (q.second : GaussianInt) * v)) := by rw [he2]; abel + rw [he'] + exact L.neg_mem hshift + have hrep : mapped z = mapped w := by + dsimp [mapped] + apply (hfund z.2).unique + · exact ⟨(representative_spec z.2).1, (representative_spec z.2).2⟩ + · have hwmem := (representative_spec w.2).2 + exact ⟨(representative_spec w.2).1, by + have := L.add_mem hycoset hwmem + convert this using 1; abel⟩ + have hzw : z = w := hinj hz hw hrep + cases hzw + have hl : o.label = q.label := hzl.symm.trans hwl + cases o with + | mk ol ofirst osecond => + cases q with + | mk ql qfirst qsecond => + cases hl + have hcoord : (ofirst, osecond) = (qfirst, qsecond) := by + apply (hcoords ⟨x - (z.2 : GaussianInt), by + have hs : (ofirst : GaussianInt) * u + (osecond : GaussianInt) * v ∈ L := by + have h1 : (ofirst : GaussianInt) * u ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hu ofirst + have h2 : (osecond : GaussianInt) * v ∈ L := by + rw [← zsmul_eq_mul] + exact L.zsmul_mem hv osecond + exact L.add_mem h1 h2 + have hxz : x - (z.2 : GaussianInt) = + (ofirst : GaussianInt) * u + (osecond : GaussianInt) * v := by + rw [heqz] + abel + rw [hxz] + exact hs⟩).unique + · have hxz : x - (z.2 : GaussianInt) = + (ofirst : GaussianInt) * u + (osecond : GaussianInt) * v := by + rw [heqz] + abel + exact hxz.symm + · have hxq : x - (z.2 : GaussianInt) = + (qfirst : GaussianInt) * u + (qsecond : GaussianInt) * v := by + rw [heqw] + abel + exact hxq.symm + cases hcoord + rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandModifiedCoverage.lean b/LeanPool/ApollonianSuperharmonic/BandModifiedCoverage.lean new file mode 100644 index 0000000000..238b8537f7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandModifiedCoverage.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandModifiedUnionEquality +public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoverage + +-- [TABLET NODE: BandModifiedCoverage] + +/-! +# BandModifiedCoverage + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandModifiedCoverage (P : Fin 3 -> Bool -> ProtoTile) + (O : ProtoTile) (u v : GaussianInt) (L : AddSubgroup GaussianInt) + (K : BandUnmodifiedCoreCertificate P u v L) + (hOB : O.cells ⊆ (P 0 false).cells) : + forall x : LatticeCell, exists o : PeriodicSubtileIndex, + x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells := by +-- BODY + intro x + have covered := BandUnmodifiedCoverage P u v L K x + exact (BandModifiedUnionEquality P O u v hOB x).mp covered + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandModifiedOrbitArea.lean b/LeanPool/ApollonianSuperharmonic/BandModifiedOrbitArea.lean new file mode 100644 index 0000000000..f0572a3167 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandModifiedOrbitArea.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileArea + +-- [TABLET NODE: BandModifiedOrbitArea] + +/-! +# BandModifiedOrbitArea + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandModifiedOrbitArea (P : Fin 3 -> Bool -> ProtoTile) + (O : ProtoTile) (R : Finset GaussianInt) + (c0 c1 c2 c3 c4 : Nat) + (hO : O.cells ⊆ (P 0 true).cells) + (hA : TileArea (P 0 true) = c1) + (hB : TileArea (P 0 false) = c1) + (hC : TileArea (P 1 true) = c2) + (hD : TileArea (P 1 false) = c2) + (hE : TileArea (P 2 true) = c3) + (hF : TileArea (P 2 false) = c3) + (hOarea : TileArea O = c4) + (hcurvature : 2 * c1 + 2 * c2 + 2 * c3 = c0 + c4) + (hindex : R.card = c0) : + TileArea (TileCellComplement (P 0 true) O) + + TileArea (P 0 false) + TileArea (P 1 true) + + TileArea (P 1 false) + TileArea (P 2 true) + + TileArea (P 2 false) = R.card := by +-- BODY + classical + simp only [TileArea, TileCellComplement] + rw [Finset.card_sdiff_of_subset hO] + have areaA : (P 0 true).cells.card = c1 := hA + have areaB : (P 0 false).cells.card = c1 := hB + have areaC : (P 1 true).cells.card = c2 := hC + have areaD : (P 1 false).cells.card = c2 := hD + have areaE : (P 2 true).cells.card = c3 := hE + have areaF : (P 2 false).cells.card = c3 := hF + have areaO : O.cells.card = c4 := hOarea + have sizeBound : c4 ≤ c1 := by + have cellBound : O.cells.card ≤ (P 0 true).cells.card := Finset.card_le_card hO + omega + rw [areaA, areaB, areaC, areaD, areaE, areaF, areaO, hindex] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandModifiedPeriodicComplex.lean b/LeanPool/ApollonianSuperharmonic/BandModifiedPeriodicComplex.lean new file mode 100644 index 0000000000..c1a42410c0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandModifiedPeriodicComplex.lean @@ -0,0 +1,1180 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandModifiedCellPartition +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoreCertificate +public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: BandModifiedPeriodicComplex] + +/-! +# BandModifiedPeriodicComplex + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ModifiedPeriodicComplexProof + +private theorem tile_ext : + ∀ (A : ProtoTile), ∀ (B : ProtoTile), (A.cells = B.cells) → ((A.anchor = B.anchor) → (A = B)) + := by + classical + intro A B hc ha + cases A; cases B; cases hc; cases ha; rfl + +private theorem trans_comp : + (∀ (A : ProtoTile), ∀ (B : ProtoTile), (A.cells = B.cells) → ((A.anchor = B.anchor) → (A = + B))) → (∀ (A : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), TileTranslation + (TileTranslation A x) y = TileTranslation A (x + y)) := by + classical + intro tile_ext A x y + apply tile_ext + · change (A.cells.image (GaussianTranslation x)).image (GaussianTranslation y) = + A.cells.image (GaussianTranslation (x + y)) + rw [Finset.image_image] + congr 1 + funext z + exact add_assoc z x y + · exact add_assoc A.anchor x y + +private theorem trans_zero : + (∀ (A : ProtoTile), ∀ (B : ProtoTile), (A.cells = B.cells) → ((A.anchor = B.anchor) → (A = + B))) → (∀ (A : ProtoTile), TileTranslation A 0 = A) := by + classical + intro tile_ext A + apply tile_ext + · change A.cells.image (GaussianTranslation 0) = A.cells + have hz : GaussianTranslation 0 = id := by funext z; exact add_zero z + rw [hz, Finset.image_id] + · exact add_zero A.anchor + +private theorem face_row : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (L : + AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v L), ∀ (w : + K.core.lattice), ∀ (f : PeriodicSubtileFaceIndex), ∀ (i : Fin 3), K.core.shift w + (SixSubtileFaceVertices f i) = + SixSubtileFaceVertices + ⟨f.label, f.first + (K.latticeCoordinates w).1, f.second + (K.latticeCoordinates w).2⟩ + i := by + classical + intro P u v L K w f i + have h := K.core.face_vertices_periodic w (K.faceEquiv.symm f) i + rw [K.face_vertices, K.face_vertices, K.face_shift] at h + simpa using h.symm + +private theorem shift_eq : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (L : + AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v L), (∀ (w : + K.core.lattice), ∀ (f : PeriodicSubtileFaceIndex), ∀ (i : Fin 3), K.core.shift w + (SixSubtileFaceVertices f i) = SixSubtileFaceVertices ⟨f.label, f.first + + (K.latticeCoordinates w).1, f.second + (K.latticeCoordinates w).2⟩ i) → (∀ (w : + K.core.lattice), ∀ (a : PeriodicSubtileIndex), K.core.shift w a = + ⟨a.label, a.first + (K.latticeCoordinates w).1, a.second + (K.latticeCoordinates w).2⟩) + := by + classical + intro P u v L K face_row w a + rcases a with ⟨l, m, n⟩ + cases l with + | A => exact face_row w ⟨.I1, m, n⟩ 0 + | B => exact face_row w ⟨.I1, m, n⟩ 1 + | C => exact face_row w ⟨.I1, m, n⟩ 2 + | D => exact face_row w ⟨.I2, m, n⟩ 2 + | E => exact face_row w ⟨.I4, m, n⟩ 2 + | F => exact face_row w ⟨.I3, m, n⟩ 2 + +private theorem t_shift : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (L : + AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v L), + let t : Int → Int → GaussianInt := fun m n => (m : GaussianInt) * u + (n : GaussianInt) * v + ∀ (w : K.core.lattice), ∀ (m : Int), ∀ (n : Int), t (m + (K.latticeCoordinates w).1) (n + + (K.latticeCoordinates w).2) = + t m n + (w : GaussianInt) := by + classical + intro P u v L K t w m n + dsimp [t] + rw [Int.cast_add, Int.cast_add, add_mul, add_mul, + ← K.latticeCoordinates_spec w] + abel + +private theorem tile_periodic : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), ∀ (L : AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v + L), + let T := ModifiedSubtileOccurrenceInterpretation P O u v + let t : Int → Int → GaussianInt := fun m n => (m : GaussianInt) * u + (n : GaussianInt) * v + (∀ (A : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), TileTranslation + (TileTranslation A x) y = TileTranslation A (x + y)) → ((∀ (w : K.core.lattice), ∀ (a : + PeriodicSubtileIndex), K.core.shift w a = ⟨a.label, a.first + + (K.latticeCoordinates w).1, a.second + (K.latticeCoordinates w).2⟩) → ((∀ (w : + K.core.lattice), ∀ (m : Int), ∀ (n : Int), t (m + (K.latticeCoordinates w).1) (n + + (K.latticeCoordinates w).2) = t m n + (w : GaussianInt)) → (∀ (w : K.core.lattice), ∀ (a + : PeriodicSubtileIndex), T (K.core.shift w a) = TileTranslation (T a) w))) := by + classical + intro P O u v L K T t trans_comp shift_eq t_shift w a + rw [shift_eq] + rcases a with ⟨l, m, n⟩ + cases l <;> change TileTranslation _ (t (m + _) (n + _)) = + TileTranslation (TileTranslation _ (t m n)) w <;> + rw [trans_comp, t_shift] + +private theorem unchanged : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), + let T := ModifiedSubtileOccurrenceInterpretation P O u v + let S := SubtileOccurrenceInterpretation P u v + ∀ (a : PeriodicSubtileIndex), (a.label ≠ .A) → (T a = S a) := by + classical + intro P O u v T S a ha + rcases a with ⟨l, m, n⟩ + cases l <;> simp_all [T, S, ModifiedSubtileOccurrenceInterpretation, + SubtileOccurrenceInterpretation] + +private theorem modified_a : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), + let T := ModifiedSubtileOccurrenceInterpretation P O u v + let S := SubtileOccurrenceInterpretation P u v + let t : Int → Int → GaussianInt := fun m n => (m : GaussianInt) * u + (n : GaussianInt) * v + ∀ (m : Int), ∀ (n : Int), T ⟨.A, m, n⟩ = + TileCellComplement (S ⟨.A, m, n⟩) (TileTranslation O (t m n)) := by + classical + intro P O u v T S t m n + exact (TileCellComplementCovariance (P 0 true) O (t m n)).1 + +private theorem cells_nonempty : + ∀ (A : ProtoTile), (LatticeTile A) → (A.cells.Nonempty) := by + classical + intro A hA + rcases hA with ⟨e⟩ + have hp := (e ⟨0, by simp⟩).property + simp only [TileRealization, Set.mem_iUnion] at hp + obtain ⟨x, hx, _⟩ := hp + exact ⟨x, hx⟩ + +private theorem original_nonempty : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (L : + AddSubgroup GaussianInt), (BandUnmodifiedCoreCertificate P u v L) → ( + let S := SubtileOccurrenceInterpretation P u v + (∀ (A : ProtoTile), (LatticeTile A) → (A.cells.Nonempty)) → (∀ (a : PeriodicSubtileIndex), (S + a).cells.Nonempty)) := by + classical + intro P u v L K S cells_nonempty a + change (SubtileOccurrenceInterpretation P u v a).cells.Nonempty + rw [← K.tile_eq] + exact cells_nonempty _ (K.core.tiles_are_disks a) + +private theorem modified_nonempty : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), (forall o : PeriodicSubtileIndex, LatticeTile + (ModifiedSubtileOccurrenceInterpretation P O u v o)) → ( + let T := ModifiedSubtileOccurrenceInterpretation P O u v + (∀ (A : ProtoTile), (LatticeTile A) → (A.cells.Nonempty)) → (∀ (a : PeriodicSubtileIndex), (T + a).cells.Nonempty)) := by + classical + intro P O u v hdisks T cells_nonempty a + exact cells_nonempty _ (hdisks a) + +private theorem separation : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), (∀ x : LatticeCell, ∃! o : PeriodicSubtileIndex, x ∈ + (ModifiedSubtileOccurrenceInterpretation P O u v o).cells) → ((O.cells ⊆ (P 0 + true).cells) → ((O.cells ⊆ (P 0 false).cells) → (∀ (a : PeriodicSubtileIndex), ∀ (b : + PeriodicSubtileIndex), a ≠ b → + ¬((a.label = SixSubtileLabel.A ∧ b.label = SixSubtileLabel.B ∨ + a.label = SixSubtileLabel.B ∧ b.label = SixSubtileLabel.A) ∧ + a.first = b.first ∧ a.second = b.second) → + Disjoint (SubtileOccurrenceInterpretation P u v a).cells (SubtileOccurrenceInterpretation P + u v b).cells))) := by + classical + intro P O u v hpartition hOA hOB + exact (BandOriginalPairSeparation P O u v hOA hOB hpartition).2 + +private theorem retention : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), (O.cells ⊆ (P 0 true).cells) → ((∀ m n : Int, ∀ x ∈ FootprintVertices + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)), ∀ a : GaussianInt, x + ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) -> a ∈ (SubtileOccurrenceInterpretation P u v + ⟨.A, m, n⟩).cells ∨ a ∈ (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) → ( + let T := ModifiedSubtileOccurrenceInterpretation P O u v + let S := SubtileOccurrenceInterpretation P u v + let t : Int → Int → GaussianInt := fun m n => (m : GaussianInt) * u + (n : GaussianInt) * v + (∀ (a : PeriodicSubtileIndex), (a.label ≠ .A) → (T a = S a)) → ((∀ (m : Int), ∀ (n : Int), T + ⟨.A, m, n⟩ = TileCellComplement (S ⟨.A, m, n⟩) (TileTranslation O (t m n))) → ((∀ (a : + PeriodicSubtileIndex), (S a).cells.Nonempty) → ((∀ (a : PeriodicSubtileIndex), (T + a).cells.Nonempty) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b + → ¬((a.label = SixSubtileLabel.A ∧ b.label = SixSubtileLabel.B ∨ a.label = + SixSubtileLabel.B ∧ b.label = SixSubtileLabel.A) ∧ a.first = b.first ∧ a.second = + b.second) → Disjoint (SubtileOccurrenceInterpretation P u v a).cells + (SubtileOccurrenceInterpretation P u v b).cells) → (∀ (m : Int), ∀ (n : Int), ∀ (b : + PeriodicSubtileIndex), (b.label ≠ .A) → ((b ≠ ⟨.B, m, n⟩) → (FootprintEdges (T ⟨.A, m, + n⟩) ∩ FootprintEdges (T b) = + FootprintEdges (S ⟨.A, m, n⟩) ∩ FootprintEdges (S b) ∧ + FootprintVertices (T ⟨.A, m, n⟩) ∩ FootprintVertices (T b) = + FootprintVertices (S ⟨.A, m, n⟩) ∩ FootprintVertices (S b)))))))))) := by + classical + intro P O u v hOA hisolated T S t unchanged modified_a original_nonempty modified_nonempty + separation m n b hbA hb + have hsepA : Disjoint (S b).cells (S ⟨.A, m, n⟩).cells := by + apply separation + · intro h; exact hbA (congrArg PeriodicSubtileIndex.label h) + · rcases b with ⟨l, r, s⟩ + simp only [ + ] at * + intro h + rcases h with ⟨h, hr, hs⟩ + rcases h with h | h + · cases h.2 + · exact hb (by cases h.1; cases hr; cases hs; rfl) + have hsepB : Disjoint (S b).cells (S ⟨.B, m, n⟩).cells := by + apply separation b _ hb + simp [hbA] + have hO : (TileTranslation O (t m n)).cells ⊆ (S ⟨.A, m, n⟩).cells := by + intro x hx + rcases Finset.mem_image.mp hx with ⟨z, hz, rfl⟩ + exact Finset.mem_image.mpr ⟨z, hOA hz, rfl⟩ + have hi : ∀ x ∈ CellSupportedFootprintVertices (TileTranslation O (t m n)), + ∀ a : GaussianInt, x ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) → + a ∈ (S ⟨.A, m, n⟩).cells ∨ a ∈ (S ⟨.B, m, n⟩).cells := by + intro x hx a ha + apply hisolated m n x _ a ha + rcases hx with ⟨z, hz, hzx⟩ + have hn : (TileTranslation O (t m n)).cells.Nonempty := ⟨z, hz⟩ + change x ∈ FootprintVertices (TileTranslation O (t m n)) + simpa [FootprintVertices, hn, CellSupportedFootprintVertices] using + (show x ∈ CellSupportedFootprintVertices (TileTranslation O (t m n)) from + ⟨z, hz, hzx⟩) + have hr := FootprintDeletionRetention (S ⟨.A, m, n⟩) + (S ⟨.B, m, n⟩) (TileTranslation O (t m n)) (S b) hO hi hsepA hsepB + rw [modified_a, unchanged b hbA] + exact ⟨hr.2.1, hr.2.2 (Or.inr + ⟨by rw [← modified_a]; exact modified_nonempty _, original_nonempty b⟩)⟩ + +private theorem no_AA : + ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a b) → + (¬ (a.label = .A ∧ b.label = .A)) := by + classical + intro a b h + induction h <;> try (simp; done) + rename_i a' b' h ih + exact fun hh => ih ⟨hh.2, hh.1⟩ + +private theorem ordinary_retention : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), + let T := ModifiedSubtileOccurrenceInterpretation P O u v + let S := SubtileOccurrenceInterpretation P u v + (∀ (a : PeriodicSubtileIndex), (a.label ≠ .A) → (T a = S a)) → ((∀ (m : Int), ∀ (n : Int), ∀ + (b : PeriodicSubtileIndex), (b.label ≠ .A) → ((b ≠ ⟨.B, m, n⟩) → (FootprintEdges (T ⟨.A, + m, n⟩) ∩ FootprintEdges (T b) = FootprintEdges (S ⟨.A, m, n⟩) ∩ FootprintEdges (S b) ∧ + FootprintVertices (T ⟨.A, m, n⟩) ∩ FootprintVertices (T b) = FootprintVertices (S ⟨.A, m, + n⟩) ∩ FootprintVertices (S b)))) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : + PeriodicSubtileIndex), (AllowedSubtileIncidence a b) → (¬ (a.label = .A ∧ b.label = .A))) + → ( + let exceptional : PeriodicSubtileIndex → PeriodicSubtileIndex → Prop := fun a b => + ((a.label = .A ∧ b.label = .B ∨ a.label = .B ∧ b.label = .A) ∧ + a.first = b.first ∧ a.second = b.second) + ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a b) → + ((¬ exceptional a b) → (FootprintEdges (T a) ∩ FootprintEdges (T b) = + FootprintEdges (S a) ∩ FootprintEdges (S b) ∧ + FootprintVertices (T a) ∩ FootprintVertices (T b) = + FootprintVertices (S a) ∩ FootprintVertices (S b)))))) := by + classical + intro P O u v T S unchanged retention no_AA exceptional a b h he + by_cases ha : a.label = .A + · have hb : b.label ≠ .A := fun hb => no_AA a b h ⟨ha, hb⟩ + rcases a with ⟨l, m, n⟩ + cases ha + apply retention m n b hb + intro hB + subst b + exact he (by simp [exceptional]) + · by_cases hb : b.label = .A + · rcases b with ⟨l, m, n⟩ + cases hb + have hr := retention m n a ha (by + intro hA + subst a + exact he (by simp [exceptional])) + simpa only [Set.inter_comm] using hr + · rw [unchanged a ha, unchanged b hb] + exact ⟨rfl, rfl⟩ + +private theorem rho_common : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), ∀ (L : AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v + L), + let T := ModifiedSubtileOccurrenceInterpretation P O u v + let S := SubtileOccurrenceInterpretation P u v + (∀ (a : PeriodicSubtileIndex), (a.label ≠ .A) → (T a = S a)) → ((∀ (m : Int), ∀ (n : Int), ∀ + (b : PeriodicSubtileIndex), (b.label ≠ .A) → ((b ≠ ⟨.B, m, n⟩) → (FootprintEdges (T ⟨.A, + m, n⟩) ∩ FootprintEdges (T b) = FootprintEdges (S ⟨.A, m, n⟩) ∩ FootprintEdges (S b) ∧ + FootprintVertices (T ⟨.A, m, n⟩) ∩ FootprintVertices (T b) = FootprintVertices (S ⟨.A, m, + n⟩) ∩ FootprintVertices (S b)))) → (∀ (f : K.core.plane.Face), ∀ (i : Fin 3), K.core.rho + f ∈ FootprintVertices (T (K.core.plane.faceVertex f i)))) := by + classical + intro P O u v L K T S unchanged retention f i + have old (j : Fin 3) : + K.core.rho f ∈ FootprintVertices (S (K.core.plane.faceVertex f j)) := by + change K.core.rho f ∈ FootprintVertices + (SubtileOccurrenceInterpretation P u v (K.core.plane.faceVertex f j)) + rw [← K.tile_eq] + exact K.core.rho_common f j + by_cases ha : (K.core.plane.faceVertex f i).label = .A + · let b := K.core.plane.faceVertex f 2 + have hbA : b.label ≠ .A := by + dsimp [b] + rw [K.face_vertices] + cases h : (K.faceEquiv f).label <;> simp [SixSubtileFaceVertices, h] + have hbB : b.label ≠ .B := by + dsimp [b] + rw [K.face_vertices] + cases h : (K.faceEquiv f).label <;> simp [SixSubtileFaceVertices, h] + generalize hidx : K.core.plane.faceVertex f i = a at ha ⊢ + rcases a with ⟨l, m, n⟩ + cases ha + have hr := (retention m n b hbA (by + intro h; exact hbB (congrArg PeriodicSubtileIndex.label h))).2 + have hx : K.core.rho f ∈ FootprintVertices (S ⟨.A, m, n⟩) ∩ + FootprintVertices (S b) := ⟨hidx ▸ old i, old 2⟩ + rw [← hr] at hx + exact hx.1 + · rw [unchanged _ ha] + exact old i + +private theorem walk_reverse : + let Walk := fun (A B : ProtoTile) (r s : GaussianInt) (q : List GaussianInt) => + q.head? = some r ∧ q.getLast? = some s ∧ + (∀ x ∈ q, x ∈ FootprintVertices A ∩ FootprintVertices B) ∧ + ∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + q = l1 ++ x :: y :: l2 → {x, y} ∈ FootprintEdges A ∩ FootprintEdges B + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (r : GaussianInt), ∀ (s : GaussianInt), ∀ (q : List + GaussianInt), (Walk A B r s q) → (Walk A B s r q.reverse) := by + classical + intro Walk A B r s q hq + refine ⟨by simpa using hq.2.1, by simpa using hq.1, ?_, ?_⟩ + · intro x hx + exact hq.2.2.1 x (List.mem_reverse.mp hx) + · intro x y l1 l2 he + have hr := congrArg List.reverse he + have hp : q = l2.reverse ++ y :: x :: l1.reverse := by + simpa [List.reverse_append, List.reverse_cons, List.append_assoc] using hr + simpa [Finset.pair_comm] using hq.2.2.2 y x _ _ hp + +private theorem walk_swap : + let Walk := fun (A B : ProtoTile) (r s : GaussianInt) (q : List GaussianInt) => + q.head? = some r ∧ q.getLast? = some s ∧ + (∀ x ∈ q, x ∈ FootprintVertices A ∩ FootprintVertices B) ∧ + ∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + q = l1 ++ x :: y :: l2 → {x, y} ∈ FootprintEdges A ∩ FootprintEdges B + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (r : GaussianInt), ∀ (s : GaussianInt), ∀ (q : List + GaussianInt), (Walk A B r s q) → (Walk B A r s q) := by + classical + intro Walk A B r s q hq + refine ⟨hq.1, hq.2.1, ?_, ?_⟩ + · intro x hx + exact ⟨(hq.2.2.1 x hx).2, (hq.2.2.1 x hx).1⟩ + · intro x y l1 l2 he + exact ⟨(hq.2.2.2 x y l1 l2 he).2, (hq.2.2.2 x y l1 l2 he).1⟩ + +private theorem walk_map : + let Walk := fun (A B : ProtoTile) (r s : GaussianInt) (q : List GaussianInt) => + q.head? = some r ∧ q.getLast? = some s ∧ + (∀ x ∈ q, x ∈ FootprintVertices A ∩ FootprintVertices B) ∧ + ∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + q = l1 ++ x :: y :: l2 → {x, y} ∈ FootprintEdges A ∩ FootprintEdges B + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (r : GaussianInt), ∀ (s : GaussianInt), ∀ (w : + GaussianInt), ∀ (q : List GaussianInt), (Walk A B r s q) → (Walk (TileTranslation A w) + (TileTranslation B w) (r + w) (s + w) + (q.map (fun x => x + w))) := by + classical + intro Walk A B r s w q hq + have hv (C : ProtoTile) : FootprintVertices (TileTranslation C w) = + GaussianTranslation w '' FootprintVertices C := + (TileTranslationFormulas C w).2.2.2.2.2.1 + have he (C : ProtoTile) : FootprintEdges (TileTranslation C w) = + (fun e : Finset GaussianInt => e.image (GaussianTranslation w)) '' + FootprintEdges C := (TileTranslationFormulas C w).2.2.2.2.2.2.1 + refine ⟨by simp [hq.1], by simp [hq.2.1], ?_, ?_⟩ + · intro x hx + rcases List.mem_map.mp hx with ⟨z, hz, rfl⟩ + rcases hq.2.2.1 z hz with ⟨ha, hb⟩ + rw [hv, hv] + exact ⟨⟨z, ha, rfl⟩, ⟨z, hb, rfl⟩⟩ + · intro x y l1 l2 hxy + have hinv := congrArg (List.map (fun z : GaussianInt => z - w)) hxy + have hp : q = l1.map (fun z => z - w) ++ + (x - w) :: (y - w) :: l2.map (fun z => z - w) := by + simpa [List.map_map, Function.comp_def] using hinv + rcases hq.2.2.2 (x - w) (y - w) _ _ hp with ⟨ha, hb⟩ + have image_pair : ({x - w, y - w} : Finset GaussianInt).image + (GaussianTranslation w) = {x, y} := by + simp [GaussianTranslation] + rw [he, he] + exact ⟨⟨_, ha, image_pair⟩, ⟨_, hb, image_pair⟩⟩ + +private theorem rho_index : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (L : + AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v L), + let t : Int → Int → GaussianInt := fun m n => (m : GaussianInt) * u + (n : GaussianInt) * v + ∀ (f : PeriodicSubtileFaceIndex), K.core.rho (K.faceEquiv.symm f) = + K.core.rho (K.faceEquiv.symm ⟨f.label, 0, 0⟩) + t f.first f.second := by + classical + intro P u v L K t f + rcases K.core.face_orbit_representatives (K.faceEquiv.symm f) with + ⟨r, hr, w, hf⟩ + rcases (K.face_reps r).mp hr with ⟨hr1, hr2⟩ + have hi := congrArg K.faceEquiv hf + rw [K.face_shift] at hi + simp only [Equiv.apply_symm_apply] at hi + have hl := congrArg PeriodicSubtileFaceIndex.label hi + have hm := congrArg PeriodicSubtileFaceIndex.first hi + have hn := congrArg PeriodicSubtileFaceIndex.second hi + simp only [hr1, zero_add] at hm + simp only [hr2, zero_add] at hn + have hre : K.faceEquiv r = ⟨f.label, 0, 0⟩ := by + rcases hfr : K.faceEquiv r with ⟨l, m, n⟩ + simp only [hfr, + ] at hl hr1 hr2 ⊢ + rw [← hl, hr1, hr2] + have hw : (w : GaussianInt) = t f.first f.second := by + change (w : GaussianInt) = (f.first : GaussianInt) * u + + (f.second : GaussianInt) * v + rw [hm, hn] + exact (K.latticeCoordinates_spec w).symm + rw [hf, K.core.rho_periodic, hw] + congr 1 + exact congrArg K.core.rho ((K.faceEquiv.eq_symm_apply).mpr hre) + +private theorem pm_spec : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), ∀ (L : AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v + L), + let T := ModifiedSubtileOccurrenceInterpretation P O u v + let t : Int → Int → GaussianInt := fun m n => (m : GaussianInt) * u + (n : GaussianInt) * v + let Walk := fun (A B : ProtoTile) (r s : GaussianInt) (q : List GaussianInt) => + q.head? = some r ∧ q.getLast? = some s ∧ + (∀ x ∈ q, x ∈ FootprintVertices A ∩ FootprintVertices B) ∧ + ∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + q = l1 ++ x :: y :: l2 → {x, y} ∈ FootprintEdges A ∩ FootprintEdges B + (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (r : GaussianInt), ∀ (s : GaussianInt), ∀ (w : + GaussianInt), ∀ (q : List GaussianInt), (Walk A B r s q) → (Walk (TileTranslation A w) + (TileTranslation B w) (r + w) (s + w) (q.map (fun x => x + w)))) → ((∀ (f : + PeriodicSubtileFaceIndex), K.core.rho (K.faceEquiv.symm f) = K.core.rho (K.faceEquiv.symm + ⟨f.label, 0, 0⟩) + t f.first f.second) → (∀ (p : List GaussianInt), (p.head? = some + (K.core.rho ((K.faceEquiv.symm : PeriodicSubtileFaceIndex → K.core.plane.Face) + ⟨SixSubtileFaceLabel.I1, (0 : ℤ), (0 : ℤ)⟩)) ∧ p.getLast? = some (K.core.rho + ((K.faceEquiv.symm : PeriodicSubtileFaceIndex → K.core.plane.Face) + ⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩)) ∧ (∀ x ∈ p, x ∈ FootprintVertices + (TileCellComplement (P (0 : Fin (3 : ℕ)) true) O) ∩ FootprintVertices (P (0 : Fin (3 : + ℕ)) false)) ∧ ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (l1 : List GaussianInt), ∀ (l2 + : List GaussianInt), p = l1 ++ x :: y :: l2 → {x, y} ∈ FootprintEdges (TileCellComplement + (P (0 : Fin (3 : ℕ)) true) O) ∩ FootprintEdges (P (0 : Fin (3 : ℕ)) false)) → ( + let pm : Int → Int → List GaussianInt := fun m n => p.map (fun x => x + t m n) + ∀ (m : Int), ∀ (n : Int), Walk (T ⟨.A, m, n⟩) (T ⟨.B, m, n⟩) + (K.core.rho (K.faceEquiv.symm ⟨.I1, m, n⟩)) + (K.core.rho (K.faceEquiv.symm ⟨.I2, m, n⟩)) (pm m n)))) := by + classical + intro P O u v L K T t Walk walk_map rho_index p hp pm m n + rw [rho_index ⟨.I1, m, n⟩, rho_index ⟨.I2, m, n⟩] + exact walk_map _ _ _ _ (t m n) p hp + +private theorem E_asymm : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (L : + AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v L), + let E : K.core.plane.Face → K.core.plane.Face → Prop := fun f g => + (K.faceEquiv f).label = .I1 ∧ (K.faceEquiv g).label = .I2 ∧ + (K.faceEquiv f).first = (K.faceEquiv g).first ∧ + (K.faceEquiv f).second = (K.faceEquiv g).second + ∀ (f : K.core.plane.Face), ∀ (g : K.core.plane.Face), (E f g) → (¬ E g f) := by + classical + intro P u v L K E f g h h' + have hc : SixSubtileFaceLabel.I1 = .I2 := h.1.symm.trans h'.2.1 + cases hc + +private theorem E_shift : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (L : + AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v L), + let E : K.core.plane.Face → K.core.plane.Face → Prop := fun f g => + (K.faceEquiv f).label = .I1 ∧ (K.faceEquiv g).label = .I2 ∧ + (K.faceEquiv f).first = (K.faceEquiv g).first ∧ + (K.faceEquiv f).second = (K.faceEquiv g).second + ∀ (w : K.core.lattice), ∀ (f : K.core.plane.Face), ∀ (g : K.core.plane.Face), E + (K.core.faceShift w f) (K.core.faceShift w g) ↔ E f g := by + classical + intro P u v L K E w f g + simp [E, K.face_shift] + +private theorem path_reverse : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (L : + AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v L), + let t : Int → Int → GaussianInt := fun m n => (m : GaussianInt) * u + (n : GaussianInt) * v + ∀ (p : List GaussianInt), + let pm : Int → Int → List GaussianInt := fun m n => p.map (fun x => x + t m n) + let E : K.core.plane.Face → K.core.plane.Face → Prop := fun f g => + (K.faceEquiv f).label = .I1 ∧ (K.faceEquiv g).label = .I2 ∧ + (K.faceEquiv f).first = (K.faceEquiv g).first ∧ + (K.faceEquiv f).second = (K.faceEquiv g).second + let path : K.core.plane.Face → K.core.plane.Face → List GaussianInt := fun f g => + if E f g then pm (K.faceEquiv f).first (K.faceEquiv f).second + else if E g f then (pm (K.faceEquiv g).first (K.faceEquiv g).second).reverse + else K.core.facePath f g + (∀ (f : K.core.plane.Face), ∀ (g : K.core.plane.Face), (E f g) → (¬ E g f)) → (∀ (f : + K.core.plane.Face), ∀ (g : K.core.plane.Face), path g f = (path f g).reverse) := by + classical + intro P u v L K t p pm E path E_asymm f g + by_cases h : E f g + · simp [path, h, E_asymm f g h] + · by_cases h' : E g f + · simp [path, h, h'] + · simpa [path, h, h'] using K.core.facePath_reverse f g + +private theorem pm_shift : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (L : + AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v L), + let t : Int → Int → GaussianInt := fun m n => (m : GaussianInt) * u + (n : GaussianInt) * v + (∀ (w : K.core.lattice), ∀ (m : Int), ∀ (n : Int), t (m + (K.latticeCoordinates w).1) (n + + (K.latticeCoordinates w).2) = t m n + (w : GaussianInt)) → (∀ (p : List GaussianInt), + let pm : Int → Int → List GaussianInt := fun m n => p.map (fun x => x + t m n) + ∀ (w : K.core.lattice), ∀ (m : Int), ∀ (n : Int), pm (m + (K.latticeCoordinates w).1) (n + + (K.latticeCoordinates w).2) = + (pm m n).map (fun x => x + (w : GaussianInt))) := by + classical + intro P u v L K t t_shift p pm w m n + simp [pm, t_shift, List.map_map, Function.comp_def, add_assoc] + +private theorem path_periodic : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (L : + AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v L), + let t : Int → Int → GaussianInt := fun m n => (m : GaussianInt) * u + (n : GaussianInt) * v + ∀ (p : List GaussianInt), + let pm : Int → Int → List GaussianInt := fun m n => p.map (fun x => x + t m n) + let E : K.core.plane.Face → K.core.plane.Face → Prop := fun f g => + (K.faceEquiv f).label = .I1 ∧ (K.faceEquiv g).label = .I2 ∧ + (K.faceEquiv f).first = (K.faceEquiv g).first ∧ + (K.faceEquiv f).second = (K.faceEquiv g).second + let path : K.core.plane.Face → K.core.plane.Face → List GaussianInt := fun f g => + if E f g then pm (K.faceEquiv f).first (K.faceEquiv f).second + else if E g f then (pm (K.faceEquiv g).first (K.faceEquiv g).second).reverse + else K.core.facePath f g + (∀ (w : K.core.lattice), ∀ (f : K.core.plane.Face), ∀ (g : K.core.plane.Face), E + (K.core.faceShift w f) (K.core.faceShift w g) ↔ E f g) → ((∀ (w : K.core.lattice), ∀ (m : + Int), ∀ (n : Int), pm (m + (K.latticeCoordinates w).1) (n + (K.latticeCoordinates w).2) = + (pm m n).map (fun x => x + (w : GaussianInt))) → (∀ (w : K.core.lattice), ∀ (f : + K.core.plane.Face), ∀ (g : K.core.plane.Face), path (K.core.faceShift w f) + (K.core.faceShift w g) = + (path f g).map (fun x => x + (w : GaussianInt)))) := by + classical + intro P u v L K t p pm E path E_shift pm_shift w f g + by_cases h : E f g + · simp only [path, ite_eq_left h, ite_eq_left ((E_shift w f g).mpr h)] + simp only [K.face_shift, + ] + exact pm_shift w _ _ + · by_cases h' : E g f + · simp only [path, ite_eq_right h, ite_eq_right (mt (E_shift w f g).mp h), + ite_eq_left h', ite_eq_left ((E_shift w g f).mpr h')] + simp only [K.face_shift, + pm_shift, List.map_reverse] + · simp only [path, ite_eq_right h, ite_eq_right h', ite_eq_right (mt (E_shift w f g).mp h), + ite_eq_right (mt (E_shift w g f).mp h')] + exact K.core.facePath_periodic w f g + +private theorem E_indices : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (L : + AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v L), + let E : K.core.plane.Face → K.core.plane.Face → Prop := fun f g => + (K.faceEquiv f).label = .I1 ∧ (K.faceEquiv g).label = .I2 ∧ + (K.faceEquiv f).first = (K.faceEquiv g).first ∧ + (K.faceEquiv f).second = (K.faceEquiv g).second + ∀ (f : K.core.plane.Face), ∀ (g : K.core.plane.Face), (E f g) → (K.faceEquiv f = ⟨.I1, + (K.faceEquiv f).first, (K.faceEquiv f).second⟩ ∧ + K.faceEquiv g = ⟨.I2, (K.faceEquiv f).first, (K.faceEquiv f).second⟩) := by + classical + intro P u v L K E f g h + rcases h with ⟨hlf, hlg, hm, hn⟩ + constructor + · rcases hf : K.faceEquiv f with ⟨lf, m, n⟩ + simp only [hf, + ] at hlf ⊢ + rw [hlf] + · rcases hg : K.faceEquiv g with ⟨lg, r, s⟩ + simp only [hg, + ] at hlg hm hn ⊢ + rw [hlg, ← hm, ← hn] + +private theorem common_I : + ∀ (m : Int), ∀ (n : Int), ∀ (a : PeriodicSubtileIndex), (∃ i, SixSubtileFaceVertices ⟨.I1, m, + n⟩ i = a) → ((∃ i, SixSubtileFaceVertices ⟨.I2, m, n⟩ i = a) → (a = ⟨.A, m, n⟩ ∨ a = ⟨.B, + m, n⟩)) := by + classical + intro m n a h1 h2 + rcases h1 with ⟨i, hi⟩ + fin_cases i + · exact Or.inl hi.symm + · exact Or.inr hi.symm + · have ha : a = ⟨.C, m, n⟩ := hi.symm + subst a + rcases h2 with ⟨j, hj⟩ + fin_cases j <;> simp [SixSubtileFaceVertices] at hj + +private theorem E_pair : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (L : + AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v L), + let E : K.core.plane.Face → K.core.plane.Face → Prop := fun f g => + (K.faceEquiv f).label = .I1 ∧ (K.faceEquiv g).label = .I2 ∧ + (K.faceEquiv f).first = (K.faceEquiv g).first ∧ + (K.faceEquiv f).second = (K.faceEquiv g).second + (∀ (f : K.core.plane.Face), ∀ (g : K.core.plane.Face), (E f g) → (K.faceEquiv f = ⟨.I1, + (K.faceEquiv f).first, (K.faceEquiv f).second⟩ ∧ K.faceEquiv g = ⟨.I2, (K.faceEquiv + f).first, (K.faceEquiv f).second⟩)) → ((∀ (m : Int), ∀ (n : Int), ∀ (a : + PeriodicSubtileIndex), (∃ i, SixSubtileFaceVertices ⟨.I1, m, n⟩ i = a) → ((∃ i, + SixSubtileFaceVertices ⟨.I2, m, n⟩ i = a) → (a = ⟨.A, m, n⟩ ∨ a = ⟨.B, m, n⟩))) → (∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (f : K.core.plane.Face), ∀ (g : + K.core.plane.Face), (K.core.plane.adjacent a b) → ((E f g) → ((∃ i, + K.core.plane.faceVertex f i = a) → ((∃ i, K.core.plane.faceVertex f i = b) → ((∃ i, + K.core.plane.faceVertex g i = a) → ((∃ i, K.core.plane.faceVertex g i = b) → ((a = ⟨.A, + (K.faceEquiv f).first, (K.faceEquiv f).second⟩ ∧ + b = ⟨.B, (K.faceEquiv f).first, (K.faceEquiv f).second⟩) ∨ + (a = ⟨.B, (K.faceEquiv f).first, (K.faceEquiv f).second⟩ ∧ + b = ⟨.A, (K.faceEquiv f).first, (K.faceEquiv f).second⟩))))))))) := by + classical + intro P u v L K E E_indices common_I a b f g hab hE hfa hfb hga hgb + rcases E_indices f g hE with ⟨hf, hg⟩ + rcases hfa with ⟨ia, hia⟩ + rcases hfb with ⟨ib, hib⟩ + rcases hga with ⟨ja, hja⟩ + rcases hgb with ⟨jb, hjb⟩ + rw [K.face_vertices, hf] at hia hib + rw [K.face_vertices, hg] at hja hjb + have ha := common_I _ _ a ⟨ia, hia⟩ ⟨ja, hja⟩ + have hb := common_I _ _ b ⟨ib, hib⟩ ⟨jb, hjb⟩ + have hne : a ≠ b := by + intro he + apply K.core.plane.adjacent_irreflexive a + simpa only [← he] using hab + rcases ha with ha | ha <;> rcases hb with hb | hb + · exact False.elim (hne (ha.trans hb.symm)) + · exact Or.inl ⟨ha, hb⟩ + · exact Or.inr ⟨ha, hb⟩ + · exact False.elim (hne (ha.trans hb.symm)) + +private theorem E_walk : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), ∀ (L : AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v + L), + let T := ModifiedSubtileOccurrenceInterpretation P O u v + let t : Int → Int → GaussianInt := fun m n => (m : GaussianInt) * u + (n : GaussianInt) * v + let Walk := fun (A B : ProtoTile) (r s : GaussianInt) (q : List GaussianInt) => + q.head? = some r ∧ q.getLast? = some s ∧ + (∀ x ∈ q, x ∈ FootprintVertices A ∩ FootprintVertices B) ∧ + ∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + q = l1 ++ x :: y :: l2 → {x, y} ∈ FootprintEdges A ∩ FootprintEdges B + ∀ (p : List GaussianInt), + let pm : Int → Int → List GaussianInt := fun m n => p.map (fun x => x + t m n) + (∀ (m : Int), ∀ (n : Int), Walk (T ⟨.A, m, n⟩) (T ⟨.B, m, n⟩) (K.core.rho (K.faceEquiv.symm + ⟨.I1, m, n⟩)) (K.core.rho (K.faceEquiv.symm ⟨.I2, m, n⟩)) (pm m n)) → ( + let E : K.core.plane.Face → K.core.plane.Face → Prop := fun f g => + (K.faceEquiv f).label = .I1 ∧ (K.faceEquiv g).label = .I2 ∧ + (K.faceEquiv f).first = (K.faceEquiv g).first ∧ + (K.faceEquiv f).second = (K.faceEquiv g).second + let path : K.core.plane.Face → K.core.plane.Face → List GaussianInt := fun f g => + if E f g then pm (K.faceEquiv f).first (K.faceEquiv f).second + else if E g f then (pm (K.faceEquiv g).first (K.faceEquiv g).second).reverse + else K.core.facePath f g + (∀ (f : K.core.plane.Face), ∀ (g : K.core.plane.Face), (E f g) → (K.faceEquiv f = ⟨.I1, + (K.faceEquiv f).first, (K.faceEquiv f).second⟩ ∧ K.faceEquiv g = ⟨.I2, (K.faceEquiv + f).first, (K.faceEquiv f).second⟩)) → (∀ (f : K.core.plane.Face), ∀ (g : + K.core.plane.Face), (E f g) → (Walk (T ⟨.A, (K.faceEquiv f).first, (K.faceEquiv f).second⟩) + (T ⟨.B, (K.faceEquiv f).first, (K.faceEquiv f).second⟩) + (K.core.rho f) (K.core.rho g) (path f g)))) := by + classical + intro P O u v L K T t Walk p pm pm_spec E path E_indices f g hE + rcases E_indices f g hE with ⟨hf, hg⟩ + have ff : f = K.faceEquiv.symm + ⟨.I1, (K.faceEquiv f).first, (K.faceEquiv f).second⟩ := + (K.faceEquiv.eq_symm_apply).mpr hf + have gg : g = K.faceEquiv.symm + ⟨.I2, (K.faceEquiv f).first, (K.faceEquiv f).second⟩ := + (K.faceEquiv.eq_symm_apply).mpr hg + simp only [path, ite_eq_left hE] + rw [ff, gg] + simp only [Equiv.apply_symm_apply] + exact pm_spec _ _ + +private theorem AB_faces : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (L : + AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v L), ∀ (m : Int), ∀ + (n : Int), ∀ (f : K.core.plane.Face), (∃ i, K.core.plane.faceVertex f i = ⟨.A, m, n⟩) → + ((∃ i, K.core.plane.faceVertex f i = ⟨.B, m, n⟩) → (K.faceEquiv f = ⟨.I1, m, n⟩ ∨ + K.faceEquiv f = ⟨.I2, m, n⟩)) := by + classical + intro P u v L K m n f ha hb + let F := K.faceEquiv.symm (PeriodicSubtileFaceIndex.mk .I1 m n) + let G := K.faceEquiv.symm (PeriodicSubtileFaceIndex.mk .I2 m n) + have hF : (∃ i, K.core.plane.faceVertex F i = ⟨.A, m, n⟩) ∧ + (∃ i, K.core.plane.faceVertex F i = ⟨.B, m, n⟩) := by + constructor + · exact ⟨0, by simp [F, K.face_vertices, SixSubtileFaceVertices]⟩ + · exact ⟨1, by simp [F, K.face_vertices, SixSubtileFaceVertices]⟩ + have hG : (∃ i, K.core.plane.faceVertex G i = ⟨.A, m, n⟩) ∧ + (∃ i, K.core.plane.faceVertex G i = ⟨.B, m, n⟩) := by + constructor + · exact ⟨0, by simp [G, K.face_vertices, SixSubtileFaceVertices]⟩ + · exact ⟨1, by simp [G, K.face_vertices, SixSubtileFaceVertices]⟩ + have hFG : F ≠ G := by + intro h + have hh := congrArg K.faceEquiv h + simp [F, G] at hh + have hab := (K.adjacent_iff _ _).mpr (AllowedSubtileIncidence.AB m n) + rcases K.core.plane.every_edge_two_faces _ _ hab with + ⟨f0, g0, _, _, _, hall⟩ + have hFF := hall F hF + have hGG := hall G hG + have hff := hall f ⟨ha, hb⟩ + have hf : f = F ∨ f = G := by + rcases hFF with hFF | hFF <;> rcases hGG with hGG | hGG + · exact False.elim (hFG (hFF.trans hGG.symm)) + · rcases hff with hff | hff + · exact Or.inl (hff.trans hFF.symm) + · exact Or.inr (hff.trans hGG.symm) + · rcases hff with hff | hff + · exact Or.inr (hff.trans hGG.symm) + · exact Or.inl (hff.trans hFF.symm) + · exact False.elim (hFG (hFF.trans hGG.symm)) + rcases hf with rfl | rfl + · exact Or.inl (K.faceEquiv.apply_symm_apply _) + · exact Or.inr (K.faceEquiv.apply_symm_apply _) + +private theorem path_spec : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), ∀ (L : AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v + L), + let T := ModifiedSubtileOccurrenceInterpretation P O u v + let S := SubtileOccurrenceInterpretation P u v + let t : Int → Int → GaussianInt := fun m n => (m : GaussianInt) * u + (n : GaussianInt) * v + let exceptional : PeriodicSubtileIndex → PeriodicSubtileIndex → Prop := fun a b => + ((a.label = .A ∧ b.label = .B ∨ a.label = .B ∧ b.label = .A) ∧ + a.first = b.first ∧ a.second = b.second) + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a b) → + ((¬ exceptional a b) → (FootprintEdges (T a) ∩ FootprintEdges (T b) = FootprintEdges (S + a) ∩ FootprintEdges (S b) ∧ FootprintVertices (T a) ∩ FootprintVertices (T b) = + FootprintVertices (S a) ∩ FootprintVertices (S b)))) → ( + let Walk := fun (A B : ProtoTile) (r s : GaussianInt) (q : List GaussianInt) => + q.head? = some r ∧ q.getLast? = some s ∧ + (∀ x ∈ q, x ∈ FootprintVertices A ∩ FootprintVertices B) ∧ + ∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + q = l1 ++ x :: y :: l2 → {x, y} ∈ FootprintEdges A ∩ FootprintEdges B + (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (r : GaussianInt), ∀ (s : GaussianInt), ∀ (q : List + GaussianInt), (Walk A B r s q) → (Walk A B s r q.reverse)) → ((∀ (A : ProtoTile), ∀ (B : + ProtoTile), ∀ (r : GaussianInt), ∀ (s : GaussianInt), ∀ (q : List GaussianInt), (Walk A B + r s q) → (Walk B A r s q)) → (∀ (p : List GaussianInt), + let pm : Int → Int → List GaussianInt := fun m n => p.map (fun x => x + t m n) + let E : K.core.plane.Face → K.core.plane.Face → Prop := fun f g => + (K.faceEquiv f).label = .I1 ∧ (K.faceEquiv g).label = .I2 ∧ + (K.faceEquiv f).first = (K.faceEquiv g).first ∧ + (K.faceEquiv f).second = (K.faceEquiv g).second + let path : K.core.plane.Face → K.core.plane.Face → List GaussianInt := fun f g => + if E f g then pm (K.faceEquiv f).first (K.faceEquiv f).second + else if E g f then (pm (K.faceEquiv g).first (K.faceEquiv g).second).reverse + else K.core.facePath f g + (∀ (f : K.core.plane.Face), ∀ (g : K.core.plane.Face), path g f = (path f g).reverse) → ((∀ + (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (f : K.core.plane.Face), ∀ (g + : K.core.plane.Face), (K.core.plane.adjacent a b) → ((E f g) → ((∃ i, + K.core.plane.faceVertex f i = a) → ((∃ i, K.core.plane.faceVertex f i = b) → ((∃ i, + K.core.plane.faceVertex g i = a) → ((∃ i, K.core.plane.faceVertex g i = b) → ((a = ⟨.A, + (K.faceEquiv f).first, (K.faceEquiv f).second⟩ ∧ b = ⟨.B, (K.faceEquiv f).first, + (K.faceEquiv f).second⟩) ∨ (a = ⟨.B, (K.faceEquiv f).first, (K.faceEquiv f).second⟩ ∧ b = + ⟨.A, (K.faceEquiv f).first, (K.faceEquiv f).second⟩)))))))) → ((∀ (f : + K.core.plane.Face), ∀ (g : K.core.plane.Face), (E f g) → (Walk (T ⟨.A, (K.faceEquiv + f).first, (K.faceEquiv f).second⟩) (T ⟨.B, (K.faceEquiv f).first, (K.faceEquiv + f).second⟩) (K.core.rho f) (K.core.rho g) (path f g))) → ((∀ (m : Int), ∀ (n : Int), ∀ (f + : K.core.plane.Face), (∃ i, K.core.plane.faceVertex f i = ⟨.A, m, n⟩) → ((∃ i, + K.core.plane.faceVertex f i = ⟨.B, m, n⟩) → (K.faceEquiv f = ⟨.I1, m, n⟩ ∨ K.faceEquiv f + = ⟨.I2, m, n⟩))) → (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), + (K.core.plane.adjacent a b) → (∀ (f : K.core.plane.Face), ∀ (g : K.core.plane.Face), (f ≠ + g) → ((∃ i, K.core.plane.faceVertex f i = a) → ((∃ i, K.core.plane.faceVertex f i = b) → + ((∃ i, K.core.plane.faceVertex g i = a) → ((∃ i, K.core.plane.faceVertex g i = b) → (Walk + (T a) (T b) (K.core.rho f) (K.core.rho g) (path f g)))))))))))))) := by + classical + intro P O u v L K T S t exceptional ordinary_retention Walk walk_reverse walk_swap p pm E path + path_reverse E_pair E_walk AB_faces a b hab f g hfg hfa hfb hga hgb + by_cases hE : E f g + · have hw := E_walk f g hE + rcases E_pair a b f g hab hE hfa hfb hga hgb with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact hw + · exact walk_swap _ _ _ _ _ hw + · by_cases hE' : E g f + · have hw := walk_reverse _ _ _ _ _ (E_walk g f hE') + rw [← path_reverse g f] at hw + rcases E_pair a b g f hab hE' hga hgb hfa hfb with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact hw + · exact walk_swap _ _ _ _ _ hw + · have he : ¬ exceptional a b := by + intro he + rcases a with ⟨la, m, n⟩ + rcases b with ⟨lb, r, s⟩ + rcases he with ⟨hh, hmr, hns⟩ + dsimp at hmr hns + subst r; subst s + rcases hh with ⟨hla, hlb⟩ | ⟨hla, hlb⟩ <;> dsimp at hla hlb <;> + cases hla <;> cases hlb + all_goals + have hf := AB_faces m n f (by assumption) (by assumption) + have hg := AB_faces m n g (by assumption) (by assumption) + rcases hf with hf | hf <;> rcases hg with hg | hg + · exact hfg (K.faceEquiv.injective (hf.trans hg.symm)) + · exact hE (by simp [E, hf, hg]) + · exact hE' (by simp [E, hf, hg]) + · exact hfg (K.faceEquiv.injective (hf.trans hg.symm)) + have hr := ordinary_retention a b ((K.adjacent_iff a b).mp hab) he + have hw := K.core.facePath_spec a b hab f g hfg hfa hfb hga hgb + simp only [K.tile_eq] at hw + simp only [path, ite_eq_right hE, ite_eq_right hE'] + refine ⟨hw.1, hw.2.1, ?_, ?_⟩ + · intro x hx + rw [hr.2] + exact hw.2.2.1 x hx + · intro x y l1 l2 heq + rw [hr.1] + exact hw.2.2.2 x y l1 l2 heq + +private theorem edge_AB : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), ((FootprintEdges (TileCellComplement (P 0 true) O) ∩ FootprintEdges (P 0 + false)).Nonempty) → ( + let T := ModifiedSubtileOccurrenceInterpretation P O u v + ∀ (m : Int), ∀ (n : Int), (FootprintEdges (T ⟨.A, m, n⟩) ∩ FootprintEdges (T ⟨.B, m, + n⟩)).Nonempty) := by + classical + intro P O u v hABedge T m n + let t : Int → Int → GaussianInt := fun m n => (m : GaussianInt) * u + (n : GaussianInt) * v + rcases hABedge with ⟨e, ha, hb⟩ + refine ⟨e.image (GaussianTranslation (t m n)), ?_, ?_⟩ + · change _ ∈ FootprintEdges (TileTranslation (TileCellComplement (P 0 true) O) (t m n)) + rw [(TileTranslationFormulas _ _).2.2.2.2.2.2.1] + exact ⟨e, ha, rfl⟩ + · change _ ∈ FootprintEdges (TileTranslation (P 0 false) (t m n)) + rw [(TileTranslationFormulas _ _).2.2.2.2.2.2.1] + exact ⟨e, hb, rfl⟩ + +private theorem common_edge : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), ∀ (L : AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v + L), (∀ a b : PeriodicSubtileIndex, AllowedSubtileIncidence a b -> ¬ ((a.label = .A ∧ + b.label = .B ∨ a.label = .B ∧ b.label = .A) ∧ a.first = b.first ∧ a.second = b.second) -> + (FootprintEdges (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty) → ( + let T := ModifiedSubtileOccurrenceInterpretation P O u v + let S := SubtileOccurrenceInterpretation P u v + let exceptional : PeriodicSubtileIndex → PeriodicSubtileIndex → Prop := fun a b => + ((a.label = .A ∧ b.label = .B ∨ a.label = .B ∧ b.label = .A) ∧ + a.first = b.first ∧ a.second = b.second) + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a b) → + ((¬ exceptional a b) → (FootprintEdges (T a) ∩ FootprintEdges (T b) = FootprintEdges (S + a) ∩ FootprintEdges (S b) ∧ FootprintVertices (T a) ∩ FootprintVertices (T b) = + FootprintVertices (S a) ∩ FootprintVertices (S b)))) → ((∀ (m : Int), ∀ (n : Int), + (FootprintEdges (T ⟨.A, m, n⟩) ∩ FootprintEdges (T ⟨.B, m, n⟩)).Nonempty) → (∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (K.core.plane.adjacent a b) → + ((FootprintEdges (T a) ∩ FootprintEdges (T b)).Nonempty)))) := by + classical + intro P O u v L K hordinaryEdge T S exceptional ordinary_retention edge_AB a b hab + by_cases he : exceptional a b + · rcases a with ⟨la, m, n⟩ + rcases b with ⟨lb, r, s⟩ + rcases he with ⟨hh, hmr, hns⟩ + dsimp at hmr hns + subst r; subst s + rcases hh with ⟨hla, hlb⟩ | ⟨hla, hlb⟩ <;> dsimp at hla hlb <;> + cases hla <;> cases hlb + · exact edge_AB m n + · simpa only [Set.inter_comm] using edge_AB m n + · have ha := (K.adjacent_iff a b).mp hab + rw [(ordinary_retention a b ha he).1] + exact hordinaryEdge a b ha he + +private theorem reps : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (L : + AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v L), + K.core.vertexOrbitReps = + {⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, + ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} := by + classical + intro P u v L K + ext a + rw [K.vertex_reps] + rcases a with ⟨l, m, n⟩ + cases l <;> simp + +private theorem area_balance : + ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), ∀ (L : AddSubgroup GaussianInt), ∀ (K : BandUnmodifiedCoreCertificate P u v + L), (TileArea (TileCellComplement (P 0 true) O) + TileArea (P 0 false) + TileArea (P 1 + true) + TileArea (P 1 false) + TileArea (P 2 true) + TileArea (P 2 false) = + K.core.latticeReps.card) → ( + let T := ModifiedSubtileOccurrenceInterpretation P O u v + (∀ (A : ProtoTile), TileTranslation A 0 = A) → ((K.core.vertexOrbitReps = {⟨.A, 0, 0⟩, ⟨.B, + 0, 0⟩, ⟨.C, 0, 0⟩, ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩}) → ((∑ a ∈ K.core.vertexOrbitReps, + TileArea (T a)) = + K.core.latticeReps.card))) := by + classical + intro P O u v L K harea T trans_zero reps + simpa [reps, T, ModifiedSubtileOccurrenceInterpretation, trans_zero, add_assoc] + using harea + +end ModifiedPeriodicComplexProof + +theorem BandModifiedPeriodicComplex + (P : Fin 3 -> Bool -> ProtoTile) (O : ProtoTile) + (u v : GaussianInt) (L : AddSubgroup GaussianInt) + (K : BandUnmodifiedCoreCertificate P u v L) + (hdisks : forall o : PeriodicSubtileIndex, + LatticeTile (ModifiedSubtileOccurrenceInterpretation P O u v o)) + (hpartition : ∀ x : LatticeCell, ∃! o : PeriodicSubtileIndex, + x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells) + (hOA : O.cells ⊆ (P 0 true).cells) + (hOB : O.cells ⊆ (P 0 false).cells) + (harea : TileArea (TileCellComplement (P 0 true) O) + + TileArea (P 0 false) + TileArea (P 1 true) + + TileArea (P 1 false) + TileArea (P 2 true) + + TileArea (P 2 false) = K.core.latticeReps.card) + (hisolated : ∀ m n : Int, + ∀ x ∈ FootprintVertices + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)), + ∀ a : GaussianInt, + x ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) -> + a ∈ (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells ∨ + a ∈ (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) + (hordinaryEdge : ∀ a b : PeriodicSubtileIndex, + AllowedSubtileIncidence a b -> + ¬ ((a.label = .A ∧ b.label = .B ∨ + a.label = .B ∧ b.label = .A) ∧ + a.first = b.first ∧ a.second = b.second) -> + (FootprintEdges (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty) + (hABedge : + (FootprintEdges (TileCellComplement (P 0 true) O) ∩ + FootprintEdges (P 0 false)).Nonempty) + (hABpath : + ∃ p : List GaussianInt, + p.head? = some + (K.core.rho (K.faceEquiv.symm ⟨.I1, 0, 0⟩)) ∧ + p.getLast? = some + (K.core.rho (K.faceEquiv.symm ⟨.I2, 0, 0⟩)) ∧ + (∀ x ∈ p, + x ∈ FootprintVertices (TileCellComplement (P 0 true) O) ∩ + FootprintVertices (P 0 false)) ∧ + (∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + p = l1 ++ x :: y :: l2 -> + {x, y} ∈ FootprintEdges (TileCellComplement (P 0 true) O) ∩ + FootprintEdges (P 0 false))) : + ∃ M : PeriodicTileComplex PeriodicSubtileIndex, + M.lattice = L ∧ + (∀ o, M.tile o = ModifiedSubtileOccurrenceInterpretation P O u v o) ∧ + (∀ a b, M.plane.adjacent a b <-> AllowedSubtileIncidence a b) ∧ + ∃ e : M.plane.Face ≃ PeriodicSubtileFaceIndex, + (∀ f : PeriodicSubtileFaceIndex, + M.rho (e.symm f) = K.core.rho (K.faceEquiv.symm f)) ∧ + (∀ f i, M.plane.faceVertex f i = SixSubtileFaceVertices (e f) i) ∧ + (∀ f, f ∈ M.faceOrbitReps <-> + (e f).first = 0 ∧ (e f).second = 0) := by +-- BODY + classical + let T := ModifiedSubtileOccurrenceInterpretation P O u v + let S := SubtileOccurrenceInterpretation P u v + let t : Int → Int → GaussianInt := fun m n => (m : GaussianInt) * u + (n : GaussianInt) * v + have tile_ext (A B : ProtoTile) (hc : A.cells = B.cells) (ha : A.anchor = B.anchor) : + A = B := ModifiedPeriodicComplexProof.tile_ext A B hc ha + have trans_comp (A : ProtoTile) (x y : GaussianInt) : + TileTranslation (TileTranslation A x) y = TileTranslation A (x + y) := + ModifiedPeriodicComplexProof.trans_comp tile_ext A x y + have trans_zero (A : ProtoTile) : TileTranslation A 0 = A := + ModifiedPeriodicComplexProof.trans_zero tile_ext A + -- The face rows determine the inherited action on all six labels. + have face_row (w : K.core.lattice) (f : PeriodicSubtileFaceIndex) (i : Fin 3) : + K.core.shift w (SixSubtileFaceVertices f i) = + SixSubtileFaceVertices + ⟨f.label, f.first + (K.latticeCoordinates w).1, f.second + (K.latticeCoordinates w).2⟩ + i := + ModifiedPeriodicComplexProof.face_row P u v L K w f i + have shift_eq (w : K.core.lattice) (a : PeriodicSubtileIndex) : + K.core.shift w a = + ⟨a.label, a.first + (K.latticeCoordinates w).1, a.second + (K.latticeCoordinates w).2⟩ := + ModifiedPeriodicComplexProof.shift_eq P u v L K face_row w a + have t_shift (w : K.core.lattice) (m n : Int) : + t (m + (K.latticeCoordinates w).1) (n + (K.latticeCoordinates w).2) = + t m n + (w : GaussianInt) := ModifiedPeriodicComplexProof.t_shift P u v L K w m n + have tile_periodic (w : K.core.lattice) (a : PeriodicSubtileIndex) : + T (K.core.shift w a) = TileTranslation (T a) w := + ModifiedPeriodicComplexProof.tile_periodic P O u v L K trans_comp shift_eq t_shift w a + have unchanged (a : PeriodicSubtileIndex) (ha : a.label ≠ .A) : T a = S a := + ModifiedPeriodicComplexProof.unchanged P O u v a ha + have modified_a (m n : Int) : T ⟨.A, m, n⟩ = + TileCellComplement (S ⟨.A, m, n⟩) (TileTranslation O (t m n)) := + ModifiedPeriodicComplexProof.modified_a P O u v m n + have cells_nonempty (A : ProtoTile) (hA : LatticeTile A) : A.cells.Nonempty := + ModifiedPeriodicComplexProof.cells_nonempty A hA + have original_nonempty (a : PeriodicSubtileIndex) : (S a).cells.Nonempty := + ModifiedPeriodicComplexProof.original_nonempty P u v L K cells_nonempty a + have modified_nonempty (a : PeriodicSubtileIndex) : (T a).cells.Nonempty := + ModifiedPeriodicComplexProof.modified_nonempty P O u v hdisks cells_nonempty a + have separation := ModifiedPeriodicComplexProof.separation P O u v hpartition hOA hOB + -- Ordinary partners retain both footprint vertices and footprint edges. + have retention (m n : Int) (b : PeriodicSubtileIndex) + (hbA : b.label ≠ .A) (hb : b ≠ ⟨.B, m, n⟩) : + FootprintEdges (T ⟨.A, m, n⟩) ∩ FootprintEdges (T b) = + FootprintEdges (S ⟨.A, m, n⟩) ∩ FootprintEdges (S b) ∧ + FootprintVertices (T ⟨.A, m, n⟩) ∩ FootprintVertices (T b) = + FootprintVertices (S ⟨.A, m, n⟩) ∩ FootprintVertices (S b) := + ModifiedPeriodicComplexProof.retention P O u v hOA hisolated unchanged modified_a + original_nonempty modified_nonempty separation m n b hbA hb + have no_AA (a b : PeriodicSubtileIndex) (h : AllowedSubtileIncidence a b) : + ¬ (a.label = .A ∧ b.label = .A) := ModifiedPeriodicComplexProof.no_AA a b h + let exceptional : PeriodicSubtileIndex → PeriodicSubtileIndex → Prop := fun a b => + ((a.label = .A ∧ b.label = .B ∨ a.label = .B ∧ b.label = .A) ∧ + a.first = b.first ∧ a.second = b.second) + have ordinary_retention (a b : PeriodicSubtileIndex) + (h : AllowedSubtileIncidence a b) (he : ¬ exceptional a b) : + FootprintEdges (T a) ∩ FootprintEdges (T b) = + FootprintEdges (S a) ∩ FootprintEdges (S b) ∧ + FootprintVertices (T a) ∩ FootprintVertices (T b) = + FootprintVertices (S a) ∩ FootprintVertices (S b) := + ModifiedPeriodicComplexProof.ordinary_retention P O u v unchanged retention no_AA a + b h he + have rho_common (f : K.core.plane.Face) (i : Fin 3) : + K.core.rho f ∈ FootprintVertices (T (K.core.plane.faceVertex f i)) := + ModifiedPeriodicComplexProof.rho_common P O u v L K unchanged retention f i + let Walk := fun (A B : ProtoTile) (r s : GaussianInt) (q : List GaussianInt) => + q.head? = some r ∧ q.getLast? = some s ∧ + (∀ x ∈ q, x ∈ FootprintVertices A ∩ FootprintVertices B) ∧ + ∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + q = l1 ++ x :: y :: l2 → {x, y} ∈ FootprintEdges A ∩ FootprintEdges B + have walk_reverse (A B : ProtoTile) (r s : GaussianInt) (q : List GaussianInt) + (hq : Walk A B r s q) : Walk A B s r q.reverse := ModifiedPeriodicComplexProof.walk_reverse + A B r s q hq + have walk_swap (A B : ProtoTile) (r s : GaussianInt) (q : List GaussianInt) + (hq : Walk A B r s q) : Walk B A r s q := ModifiedPeriodicComplexProof.walk_swap A B r s q hq + have walk_map (A B : ProtoTile) (r s w : GaussianInt) (q : List GaussianInt) + (hq : Walk A B r s q) : + Walk (TileTranslation A w) (TileTranslation B w) (r + w) (s + w) + (q.map (fun x => x + w)) := ModifiedPeriodicComplexProof.walk_map A B r s w q hq + have rho_index (f : PeriodicSubtileFaceIndex) : + K.core.rho (K.faceEquiv.symm f) = + K.core.rho (K.faceEquiv.symm ⟨f.label, 0, 0⟩) + t f.first f.second := + ModifiedPeriodicComplexProof.rho_index P u v L K f + rcases hABpath with ⟨p, hp⟩ + let pm : Int → Int → List GaussianInt := fun m n => p.map (fun x => x + t m n) + have pm_spec (m n : Int) : Walk (T ⟨.A, m, n⟩) (T ⟨.B, m, n⟩) + (K.core.rho (K.faceEquiv.symm ⟨.I1, m, n⟩)) + (K.core.rho (K.faceEquiv.symm ⟨.I2, m, n⟩)) (pm m n) := + ModifiedPeriodicComplexProof.pm_spec P O u v L K walk_map rho_index p hp m n + -- Define the exceptional replacement on every ordered face pair. + let E : K.core.plane.Face → K.core.plane.Face → Prop := fun f g => + (K.faceEquiv f).label = .I1 ∧ (K.faceEquiv g).label = .I2 ∧ + (K.faceEquiv f).first = (K.faceEquiv g).first ∧ + (K.faceEquiv f).second = (K.faceEquiv g).second + let path : K.core.plane.Face → K.core.plane.Face → List GaussianInt := fun f g => + if E f g then pm (K.faceEquiv f).first (K.faceEquiv f).second + else if E g f then (pm (K.faceEquiv g).first (K.faceEquiv g).second).reverse + else K.core.facePath f g + have E_asymm (f g : K.core.plane.Face) (h : E f g) : ¬ E g f := + ModifiedPeriodicComplexProof.E_asymm P u v L K f g h + have E_shift (w : K.core.lattice) (f g : K.core.plane.Face) : + E (K.core.faceShift w f) (K.core.faceShift w g) ↔ E f g := + ModifiedPeriodicComplexProof.E_shift P u v L K w f g + have path_reverse (f g : K.core.plane.Face) : path g f = (path f g).reverse := + ModifiedPeriodicComplexProof.path_reverse P u v L K p E_asymm f g + have pm_shift (w : K.core.lattice) (m n : Int) : + pm (m + (K.latticeCoordinates w).1) (n + (K.latticeCoordinates w).2) = + (pm m n).map (fun x => x + (w : GaussianInt)) := ModifiedPeriodicComplexProof.pm_shift P + u v L K t_shift p w m n + have path_periodic (w : K.core.lattice) (f g : K.core.plane.Face) : + path (K.core.faceShift w f) (K.core.faceShift w g) = + (path f g).map (fun x => x + (w : GaussianInt)) := + ModifiedPeriodicComplexProof.path_periodic P u v L K p E_shift pm_shift w f g + have E_indices (f g : K.core.plane.Face) (h : E f g) : + K.faceEquiv f = ⟨.I1, (K.faceEquiv f).first, (K.faceEquiv f).second⟩ ∧ + K.faceEquiv g = ⟨.I2, (K.faceEquiv f).first, (K.faceEquiv f).second⟩ := + ModifiedPeriodicComplexProof.E_indices P u v L K f g h + have common_I (m n : Int) (a : PeriodicSubtileIndex) + (h1 : ∃ i, SixSubtileFaceVertices ⟨.I1, m, n⟩ i = a) + (h2 : ∃ i, SixSubtileFaceVertices ⟨.I2, m, n⟩ i = a) : + a = ⟨.A, m, n⟩ ∨ a = ⟨.B, m, n⟩ := ModifiedPeriodicComplexProof.common_I m n a h1 h2 + have E_pair (a b : PeriodicSubtileIndex) (f g : K.core.plane.Face) + (hab : K.core.plane.adjacent a b) (hE : E f g) + (hfa : ∃ i, K.core.plane.faceVertex f i = a) + (hfb : ∃ i, K.core.plane.faceVertex f i = b) + (hga : ∃ i, K.core.plane.faceVertex g i = a) + (hgb : ∃ i, K.core.plane.faceVertex g i = b) : + (a = ⟨.A, (K.faceEquiv f).first, (K.faceEquiv f).second⟩ ∧ + b = ⟨.B, (K.faceEquiv f).first, (K.faceEquiv f).second⟩) ∨ + (a = ⟨.B, (K.faceEquiv f).first, (K.faceEquiv f).second⟩ ∧ + b = ⟨.A, (K.faceEquiv f).first, (K.faceEquiv f).second⟩) := + ModifiedPeriodicComplexProof.E_pair P u v L K E_indices common_I a b f g hab hE hfa + hfb hga hgb + have E_walk (f g : K.core.plane.Face) (hE : E f g) : + Walk (T ⟨.A, (K.faceEquiv f).first, (K.faceEquiv f).second⟩) + (T ⟨.B, (K.faceEquiv f).first, (K.faceEquiv f).second⟩) + (K.core.rho f) (K.core.rho g) (path f g) := ModifiedPeriodicComplexProof.E_walk P O u v L + K p pm_spec E_indices f g hE + have AB_faces (m n : Int) (f : K.core.plane.Face) + (ha : ∃ i, K.core.plane.faceVertex f i = ⟨.A, m, n⟩) + (hb : ∃ i, K.core.plane.faceVertex f i = ⟨.B, m, n⟩) : + K.faceEquiv f = ⟨.I1, m, n⟩ ∨ K.faceEquiv f = ⟨.I2, m, n⟩ := + ModifiedPeriodicComplexProof.AB_faces P u v L K m n f ha hb + have path_spec (a b : PeriodicSubtileIndex) (hab : K.core.plane.adjacent a b) + (f g : K.core.plane.Face) (hfg : f ≠ g) + (hfa : ∃ i, K.core.plane.faceVertex f i = a) + (hfb : ∃ i, K.core.plane.faceVertex f i = b) + (hga : ∃ i, K.core.plane.faceVertex g i = a) + (hgb : ∃ i, K.core.plane.faceVertex g i = b) : + Walk (T a) (T b) (K.core.rho f) (K.core.rho g) (path f g) := + ModifiedPeriodicComplexProof.path_spec P O u v L K ordinary_retention walk_reverse + walk_swap p path_reverse E_pair E_walk AB_faces a b hab f g hfg hfa hfb hga hgb + have edge_AB (m n : Int) : + (FootprintEdges (T ⟨.A, m, n⟩) ∩ FootprintEdges (T ⟨.B, m, n⟩)).Nonempty := + ModifiedPeriodicComplexProof.edge_AB P O u v hABedge m n + have common_edge (a b : PeriodicSubtileIndex) (hab : K.core.plane.adjacent a b) : + (FootprintEdges (T a) ∩ FootprintEdges (T b)).Nonempty := + ModifiedPeriodicComplexProof.common_edge P O u v L K hordinaryEdge ordinary_retention + edge_AB a b hab + have reps : K.core.vertexOrbitReps = + {⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, + ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} := ModifiedPeriodicComplexProof.reps P u v L K + have area_balance : (∑ a ∈ K.core.vertexOrbitReps, TileArea (T a)) = + K.core.latticeReps.card := ModifiedPeriodicComplexProof.area_balance P O u v L K harea + trans_zero reps + let M : PeriodicTileComplex PeriodicSubtileIndex := + { toPeriodicTileCore := + { K.core with + tile := T + tiles_are_disks := hdisks + tile_periodic := tile_periodic + rho_common := rho_common + facePath := path + facePath_reverse := path_reverse + facePath_periodic := path_periodic + facePath_spec := path_spec } + area_balance := area_balance + adjacent_has_common_edge := common_edge } + refine ⟨M, K.lattice_eq, (fun _ => rfl), K.adjacent_iff, K.faceEquiv, + (fun _ => rfl), K.face_vertices, K.face_reps⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandModifiedUnionEquality.lean b/LeanPool/ApollonianSuperharmonic/BandModifiedUnionEquality.lean new file mode 100644 index 0000000000..7b5090aa75 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandModifiedUnionEquality.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: BandModifiedUnionEquality] + +/-! +# BandModifiedUnionEquality + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandModifiedUnionEquality (P : Fin 3 -> Bool -> ProtoTile) + (O : ProtoTile) (u v : GaussianInt) + (hOB : O.cells ⊆ (P 0 false).cells) : + forall x : LatticeCell, + (exists o : PeriodicSubtileIndex, + x ∈ (SubtileOccurrenceInterpretation P u v o).cells) <-> + (exists o : PeriodicSubtileIndex, + x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells) := by +-- BODY + classical + intro x + constructor + · rintro ⟨o, hx⟩ + cases o with + | mk label first second => + cases label with + | A => + change x ∈ (TileTranslation (P 0 true) + ((first : GaussianInt) * u + (second : GaussianInt) * v)).cells at hx + rcases Finset.mem_image.mp hx with ⟨y, hy, hxy⟩ + by_cases hyo : y ∈ O.cells + · have hyb : y ∈ (P 0 false).cells := hOB hyo + refine ⟨⟨.B, first, second⟩, ?_⟩ + change x ∈ (TileTranslation (P 0 false) + ((first : GaussianInt) * u + (second : GaussianInt) * v)).cells + apply Finset.mem_image.mpr + exact ⟨y, hyb, hxy⟩ + · refine ⟨⟨.A, first, second⟩, ?_⟩ + change x ∈ (TileTranslation (TileCellComplement (P 0 true) O) + ((first : GaussianInt) * u + (second : GaussianInt) * v)).cells + apply Finset.mem_image.mpr + exact ⟨y, Finset.mem_sdiff.mpr ⟨hy, hyo⟩, hxy⟩ + | B => + exact ⟨⟨.B, first, second⟩, hx⟩ + | C => + exact ⟨⟨.C, first, second⟩, hx⟩ + | D => + exact ⟨⟨.D, first, second⟩, hx⟩ + | E => + exact ⟨⟨.E, first, second⟩, hx⟩ + | F => + exact ⟨⟨.F, first, second⟩, hx⟩ + · rintro ⟨o, hx⟩ + cases o with + | mk label first second => + cases label with + | A => + change x ∈ (TileTranslation (TileCellComplement (P 0 true) O) + ((first : GaussianInt) * u + (second : GaussianInt) * v)).cells at hx + rcases Finset.mem_image.mp hx with ⟨y, hy, hxy⟩ + refine ⟨⟨.A, first, second⟩, ?_⟩ + change x ∈ (TileTranslation (P 0 true) + ((first : GaussianInt) * u + (second : GaussianInt) * v)).cells + apply Finset.mem_image.mpr + exact ⟨y, (Finset.mem_sdiff.mp hy).1, hxy⟩ + | B => + exact ⟨⟨.B, first, second⟩, hx⟩ + | C => + exact ⟨⟨.C, first, second⟩, hx⟩ + | D => + exact ⟨⟨.D, first, second⟩, hx⟩ + | E => + exact ⟨⟨.E, first, second⟩, hx⟩ + | F => + exact ⟨⟨.F, first, second⟩, hx⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean b/LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean new file mode 100644 index 0000000000..b1313732fd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean @@ -0,0 +1,435 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4120T1RootNormalization +public import LeanPool.ApollonianSuperharmonic.P4120T1AffineComparison +public import LeanPool.ApollonianSuperharmonic.P4120T1FordGeometry +public import LeanPool.ApollonianSuperharmonic.P4120T1DiamondGeometry +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.P4120T1GeneralRowData +public import LeanPool.ApollonianSuperharmonic.P4120T1GeneralDescent +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorStarClassification +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOuterMixedOdometerRows +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNestedRightOdometerRows +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLargestParentOdometerRows +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPositiveCutOdometerRows +public import LeanPool.ApollonianSuperharmonic.FordCenteredInteriorOdometerStencil +public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable +public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable + +-- [TABLET NODE: BandOdometerInteriorTable] + +/-! +# BandOdometerInteriorTable + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace InteriorTableGeometry + +private theorem orderedGeneralRowDispatch : + (by + classical + exact + ∀ (q' : Fin 4 → CircleCoordinates), ∀ (cfg' : BandOrderedGeneralConfiguration q'), ∀ (C0' + : BandCircle), ∀ (T' : ProtoTile), ∀ (cert' : BandOrderedGeneralLayoutCertificate q' + cfg' C0' T'), ∀ (h' : PartialOdometer), ∀ (P' : Fin 3 → Bool → ProtoTile), ∀ (r' : + Fin 3 → Bool → PartialOdometer), ∀ (Q' : Fin 3 → Bool → ProtoTile), ∀ (S' : Fin 3 → + Bool → ProtoTile), ∀ (u' : Fin 3 → Bool → PartialOdometer), ∀ (v' : Fin 3 → Bool → + PartialOdometer), ∀ (g'' : IntegerLatticeFunction), ∀ (x' : GaussianInt), ∀ (marked : + Bool), BandOrderedGeneralOdometerRowData q' cfg' C0' T' cert' h' P' r' Q' S' u' v' + g'' → BandOrderedGeneralInteriorWebRow cert' x' marked → (marked = true → + FourNeighborLaplacian g'' x' = 0) ∧ (marked = false → FourNeighborLaplacian g'' x' = + 1) ) := by + classical + intro q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' marked data row + cases row with + | outer12 left_mem right_mem star coarseThird webCompanion => + exact BandOrderedGeneralOuterMixedOdometerRows + q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' marked data + (.outer12 left_mem right_mem star coarseThird webCompanion) + (Or.inl ⟨left_mem, right_mem, star, coarseThird, webCompanion, rfl⟩) + | outer13 left_mem right_mem star coarseThird webCompanion => + exact BandOrderedGeneralOuterMixedOdometerRows + q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' marked data + (.outer13 left_mem right_mem star coarseThird webCompanion) + (Or.inr (Or.inl + ⟨left_mem, right_mem, star, coarseThird, webCompanion, rfl⟩)) + | outer21 left_mem right_mem star coarseThird webCompanion => + exact BandOrderedGeneralOuterMixedOdometerRows + q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' marked data + (.outer21 left_mem right_mem star coarseThird webCompanion) + (Or.inr (Or.inr (Or.inl + ⟨left_mem, right_mem, star, coarseThird, webCompanion, rfl⟩))) + | outer31 left_mem right_mem star coarseThird webCompanion => + exact BandOrderedGeneralOuterMixedOdometerRows + q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' marked data + (.outer31 left_mem right_mem star coarseThird webCompanion) + (Or.inr (Or.inr (Or.inr (Or.inl + ⟨left_mem, right_mem, star, coarseThird, webCompanion, rfl⟩)))) + | outer23 left_mem right_mem star coarseThird webCompanion => + exact BandOrderedGeneralOuterMixedOdometerRows + q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' marked data + (.outer23 left_mem right_mem star coarseThird webCompanion) + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + ⟨left_mem, right_mem, star, coarseThird, webCompanion, rfl⟩))))) + | outer32 left_mem right_mem star coarseThird webCompanion => + exact BandOrderedGeneralOuterMixedOdometerRows + q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' marked data + (.outer32 left_mem right_mem star coarseThird webCompanion) + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + ⟨left_mem, right_mem, star, coarseThird, webCompanion, rfl⟩))))) + | rightPositive left_mem right_mem star squares => + have result := BandOrderedGeneralNestedRightOdometerRows + q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' marked data + (.rightPositive left_mem right_mem star squares) + (Or.inl ⟨left_mem, right_mem, star, squares, rfl⟩) + exact ⟨result.2, result.1⟩ + | rightReflected left_mem right_mem star squares => + have result := BandOrderedGeneralNestedRightOdometerRows + q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' marked data + (.rightReflected left_mem right_mem star squares) + (Or.inr ⟨left_mem, right_mem, star, squares, rfl⟩) + exact ⟨result.2, result.1⟩ + | largestPositive left_mem right_mem star companion => + exact BandOrderedGeneralLargestParentOdometerRows + q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' marked data + (.largestPositive left_mem right_mem star companion) + (Or.inl ⟨left_mem, right_mem, star, companion, rfl⟩) + | largestReflected left_mem right_mem star companion => + exact BandOrderedGeneralLargestParentOdometerRows + q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' marked data + (.largestReflected left_mem right_mem star companion) + (Or.inr ⟨left_mem, right_mem, star, companion, rfl⟩) + | leftPositiveCut unmarked at_cut geometry => + have lap := BandOrderedGeneralPositiveCutOdometerRows + q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' data geometry + constructor + · intro marked_true + simp [unmarked] at marked_true + · intro _ + exact lap + | rightPositiveCut unmarked at_cut geometry => + have lap := BandOrderedGeneralPositiveCutOdometerRows + q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' data geometry + constructor + · intro marked_true + simp [unmarked] at marked_true + · intro _ + exact lap + +private theorem orderedGeneralCenteredDispatch : + (by + classical + exact + ∀ (q' : Fin 4 → CircleCoordinates), ∀ (cfg' : BandOrderedGeneralConfiguration q'), ∀ (C0' + : BandCircle), ∀ (T' : ProtoTile), ∀ (cert' : BandOrderedGeneralLayoutCertificate q' + cfg' C0' T'), ∀ (h' : PartialOdometer), ∀ (P' : Fin 3 → Bool → ProtoTile), ∀ (r' : + Fin 3 → Bool → PartialOdometer), ∀ (Q' : Fin 3 → Bool → ProtoTile), ∀ (S' : Fin 3 → + Bool → ProtoTile), ∀ (u' : Fin 3 → Bool → PartialOdometer), ∀ (v' : Fin 3 → Bool → + PartialOdometer), ∀ (g'' : IntegerLatticeFunction), ∀ (x' : GaussianInt), + BandOrderedGeneralOdometerRowData q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' → + GlobalOdometerExtends g'' h' → Nat.card + {is : Fin 3 × Bool // x' ∈ BoundaryFootprintVertices (cert'.P is.1 is.2)} = 2 → + GaussianRealPoint x' = TileCentroid T' → (cfg'.firstPredecessor 1).1 = 0 → + FourNeighborLaplacian g'' x' = 0 ) := by + classical + intro q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' + data hext' hk' hcenter' hzero' + exact FordCenteredInteriorOdometerStencil + q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' + data hext' hk' hcenter' hzero' + +private theorem layout : + (by + classical + exact + ∀ (qn : Fin (4 : ℕ) → CircleCoordinates), ∀ (Tn : ProtoTile), ∀ (hqn : + ProperBandQuadruple qn), (BandPrototile (qn (0 : Fin (4 : ℕ))) Tn) → (∀ (cfg : + BandOrderedGeneralConfiguration qn), ∀ (hpos : (0 : ℤ) < (qn (0 : Fin (4 : ℕ))).1), + let C : BandCircle := + ⟨⟨qn 0, ⟨Or.inl hpos, ⟨qn, hqn.1, ⟨0, rfl⟩⟩⟩⟩, hpos⟩ + Nonempty (BandOrderedGeneralLayoutCertificate qn cfg C Tn)) ) := by + classical + intro qn Tn hqn hTn cfg hpos C + apply BandOrderedGeneralLayout qn cfg C rfl Tn hTn + · intro q' T' S' hq' hT' hocc hcells _ + have hI := BandTileSimultaneousInduction q' hq' T' hT' + exact ⟨hI.1, hI.2.1, hI.2.2.1 S' hocc hcells⟩ + · intro D U hU _ + cases hU with + | line w z hw => + intro p + simp [TileRealization, TileCentroid] + | unit z a anchor => + intro p + have hc : TileCentroid (⟨{a}, anchor⟩ : ProtoTile) = + (((a.re : Int) : Real) + (1 / 2 : Real), + ((a.im : Int) : Real) + (1 / 2 : Real)) := by + simp [TileCentroid] + rw [hc] + rcases p with ⟨px, py⟩ + simp only [TileRealization, Finset.mem_singleton, Set.mem_iUnion] + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor + · rintro ⟨b, rfl, hlo, hhi⟩ + refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> + linarith [hlo.1, hlo.2, hhi.1, hhi.2] + · rintro ⟨b, rfl, hlo, hhi⟩ + refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> + linarith [hlo.1, hlo.2, hhi.1, hhi.2] + | @decompose q' hq' S' U' hS hcells hfoot hcent => + exact (BandTileSimultaneousInduction q' hq' U + (.decompose hq' hS hcells hfoot hcent)).2.2.2.1 + · intro q' T' U hq' hT' _ hlarge i hU hcentU + exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.1 + hlarge i U hU hcentU + · intro q' T' U V hq' hT' _ i hU hV hcentU hcentV + exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.2.1 + i U V hU hV hcentU hcentV + +private theorem obsAt414 : + (by + classical + exact + ∀ (qn : Fin (4 : ℕ) → CircleCoordinates), ∀ (Tn : ProtoTile), ∀ (Sn : Fin (3 : ℕ) → Bool + → ProtoTile), ∀ (hqn : ProperBandQuadruple qn), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence qn Tn i s (Sn i s)) → (∀ (cfg : BandOrderedGeneralConfiguration + qn), ∀ (hpos : (0 : ℤ) < (qn (0 : Fin (4 : ℕ))).1), + let C : BandCircle := + ⟨⟨qn 0, ⟨Or.inl hpos, ⟨qn, hqn.1, ⟨0, rfl⟩⟩⟩⟩, hpos⟩ + ∀ (cert : BandOrderedGeneralLayoutCertificate qn cfg C Tn), ∀ i, ∀ s, FootprintVertices + (Sn i s) = FootprintVertices (cert.P i s) ∧ BoundaryFootprintVertices (Sn i s) = + BoundaryFootprintVertices (cert.P i s)) ) := by + classical + intro qn Tn Sn hqn hSn cfg hpos C cert i s + have hc : TileCentroid (Sn i s) = TileCentroid (cert.P i s) := + sub_left_injective ((hSn i s).2.2.trans (cert.outer_occurrence i s).2.2.symm) + obtain ⟨hcell, hanchor⟩ := BandPrototileCentroidUnique + (qn i.succ) (Sn i s) (cert.P i s) + (hSn i s).1 (cert.outer_occurrence i s).1 hc + have ho := ProtoTileObservableExtensionality _ _ hcell hanchor + exact ⟨ho.1, ho.2.1⟩ + +private theorem hcount : + (by + classical + exact + ∀ (qn : Fin (4 : ℕ) → CircleCoordinates), ∀ (Tn : ProtoTile), ∀ (Sn : Fin (3 : ℕ) → Bool + → ProtoTile), ∀ (xn : GaussianInt), ∀ (hqn : ProperBandQuadruple qn), ∀ (cfg : + BandOrderedGeneralConfiguration qn), ∀ (hpos : (0 : ℤ) < (qn (0 : Fin (4 : ℕ))).1), + let C : BandCircle := + ⟨⟨qn 0, ⟨Or.inl hpos, ⟨qn, hqn.1, ⟨0, rfl⟩⟩⟩⟩, hpos⟩ + ∀ (cert : BandOrderedGeneralLayoutCertificate qn cfg C Tn), (∀ i, ∀ s, FootprintVertices + (Sn i s) = FootprintVertices (cert.P i s) ∧ BoundaryFootprintVertices (Sn i s) = + BoundaryFootprintVertices (cert.P i s)) → (Nat.card + {a : Fin 3 × Bool // xn ∈ BoundaryFootprintVertices (Sn a.1 a.2)} = Nat.card + {a : Fin 3 × Bool // xn ∈ BoundaryFootprintVertices (cert.P a.1 a.2)}) ) := by + classical + intro qn Tn Sn xn hqn cfg hpos C cert obs + have hp : (fun a : Fin 3 × Bool => + xn ∈ BoundaryFootprintVertices (Sn a.1 a.2)) = + (fun a : Fin 3 × Bool => + xn ∈ BoundaryFootprintVertices (cert.P a.1 a.2)) := by + funext a + rw [(obs a.1 a.2).2] + change Nat.card (Subtype _) = Nat.card (Subtype _) + rw [hp] + +end InteriorTableGeometry + +theorem BandOdometerInteriorTable : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (T : ProtoTile), ∀ (S : Fin 3 + → Bool → ProtoTile), ∀ (h : PartialOdometer), ∀ (hs : Fin 3 → Bool → PartialOdometer), ∀ + (g : IntegerLatticeFunction), (BandPrototile (q 0) T) → ((TileOdometer (q 0) T h) → + ((GlobalOdometerExtends g h) → ((∀ i, ∀ s, BandSubtileOccurrence q T i s (S i s)) → ((∀ + x, x ∈ T.cells ↔ ∃ i s, x ∈ (S i s).cells) → ((∀ i, ∀ s, TileOdometer (q i.succ) (S i s) + (hs i s)) → ((∀ i, ∀ s, GlobalOdometerExtends g (hs i s)) → (∀ (x : GaussianInt), (x ∈ + FootprintVertices T) → ((x ∉ BoundaryFootprintVertices T) → ( + let k := Nat.card {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (S is.1 is.2)} + (k = 2 → GaussianRealPoint x ≠ TileCentroid T → + FourNeighborLaplacian g x = 1) ∧ + (k = 2 → GaussianRealPoint x = TileCentroid T → + FourNeighborLaplacian g x = 0) ∧ + (k = 3 → FourNeighborLaplacian g x = 0) ∧ + (k = 4 → GaussianRealPoint x ≠ TileCentroid T → + FourNeighborLaplacian g x = -1) ∧ + (k = 4 → GaussianRealPoint x = TileCentroid T → + FourNeighborLaplacian g x = -2) ∧ + ((k = 2 ∨ k = 3 ∨ k = 4) ∨ + ∃ i : Fin 3, ∃ s : Bool, + 0 < (q i.succ).1 ∧ + x ∈ FootprintVertices (S i s) ∧ + x ∉ BoundaryFootprintVertices (S i s)))))))))))) := by + intro q hq T S h hs g hT hodo hext hS hcells hsub hrest x hx hxb +-- BODY + obtain ⟨qn, Tn, Sn, hn, gn, xn, e, hqn, hTn, hodon, hextn, + hSn, hcellsn, hxn, hxbn, hobsn, hcountn, hcentern, hlapn, regimes⟩ := + P4120T1RootNormalization q hq T S h g hT hodo hext hS hcells x hx hxb + suffices result : + let k := Nat.card {a : Fin 3 × Bool // + xn ∈ BoundaryFootprintVertices (Sn a.1 a.2)} + (k = 2 → GaussianRealPoint xn ≠ TileCentroid Tn → + FourNeighborLaplacian gn xn = 1) ∧ + (k = 2 → GaussianRealPoint xn = TileCentroid Tn → + FourNeighborLaplacian gn xn = 0) ∧ + (k = 3 → FourNeighborLaplacian gn xn = 0) ∧ + (k = 4 → GaussianRealPoint xn ≠ TileCentroid Tn → + FourNeighborLaplacian gn xn = -1) ∧ + (k = 4 → GaussianRealPoint xn = TileCentroid Tn → + FourNeighborLaplacian gn xn = -2) ∧ + ((k = 2 ∨ k = 3 ∨ k = 4) ∨ + ∃ i : Fin 3, ∃ s : Bool, 0 < (qn i.succ).1 ∧ + xn ∈ FootprintVertices (Sn i s) ∧ + xn ∉ BoundaryFootprintVertices (Sn i s)) by + dsimp only at result ⊢ + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro hk hnc + exact hlapn.symm.trans + (result.1 (hcountn.trans hk) (fun hc => hnc (hcentern.mp hc))) + · intro hk hc + exact hlapn.symm.trans (result.2.1 (hcountn.trans hk) (hcentern.mpr hc)) + · intro hk + exact hlapn.symm.trans (result.2.2.1 (hcountn.trans hk)) + · intro hk hnc + exact hlapn.symm.trans + (result.2.2.2.1 (hcountn.trans hk) (fun hc => hnc (hcentern.mp hc))) + · intro hk hc + exact hlapn.symm.trans + (result.2.2.2.2.1 (hcountn.trans hk) (hcentern.mpr hc)) + · rcases result.2.2.2.2.2 with hd | ⟨i, s, hp, hf, hb⟩ + · left + rcases hd with hk | hk | hk + · exact Or.inl (hcountn.symm.trans hk) + · exact Or.inr (Or.inl (hcountn.symm.trans hk)) + · exact Or.inr (Or.inr (hcountn.symm.trans hk)) + · right + obtain ⟨a, ha⟩ := e.surjective (i, s) + have obs := hobsn a + rw [ha] at obs + exact ⟨a.1, a.2, by simpa only [obs.1] using hp, + obs.2.1.mp hf, fun hboundary => hb (obs.2.2.mpr hboundary)⟩ + have orderedGeneralRowDispatch := InteriorTableGeometry.orderedGeneralRowDispatch + have orderedGeneralCenteredDispatch := InteriorTableGeometry.orderedGeneralCenteredDispatch + dsimp only + rcases regimes with ⟨P, hP, hqP⟩ | ⟨K, hK, hqK⟩ | ⟨cfg⟩ + · subst qn + obtain ⟨f, hfodo, _, hfvalue⟩ := FordTileOdometerRestriction P + obtain ⟨u, hu, ha, hlap⟩ := + P4120T1AffineComparison ((FordRecursiveQuadruple P) 0) + Tn (FordTile P.q) hn f gn (FordOdometer P) + (ProperBandCurvatureStructure _ hqn).1 hodon hfodo hextn hfvalue + xn hxn hxbn + have geometry := P4120T1FordGeometry P hP Tn Sn u hu ha hSn xn hxn hxbn + dsimp only at geometry + obtain ⟨bounds, hcount, htwo, hfour, hdescent⟩ := geometry + have table := (FordLaplacianTable P).2.2 hP (xn - u) + bounds.1 bounds.2.1 bounds.2.2.1 bounds.2.2.2 + dsimp only at table + refine ⟨?_, ?_, ?_, ?_, ?_, hdescent⟩ + · intro hk _ + exact hlap.trans (table.1 (hcount.symm.trans hk)) + · intro hk hc + exact (htwo hk hc).elim + · intro hk + exact hlap.trans (table.2.1 (hcount.symm.trans hk)) + · intro hk hnc + exact (hnc (hfour hk).2).elim + · intro hk _ + exact hlap.trans (table.2.2 (hcount.symm.trans hk)) + · subst qn + obtain ⟨f, hfodo, _, _, _, hfvalue, _⟩ := DiamondTileOdometerRestriction K + obtain ⟨u, hu, ha, hlap⟩ := + P4120T1AffineComparison ((DiamondRecursiveQuadruple K) 0) + Tn (DiamondTile K.1) hn f gn (DiamondOdometer K) + (ProperBandCurvatureStructure _ hqn).1 hodon hfodo hextn hfvalue + xn hxn hxbn + have geometry := P4120T1DiamondGeometry K hK Tn Sn u hu ha hSn xn hxn hxbn + dsimp only at geometry + obtain ⟨htwo, hthree, hfour, hdescent⟩ := geometry + refine ⟨?_, ?_, ?_, ?_, ?_, hdescent⟩ + · intro hk hnc + have facts := htwo hk + have hnz : (xn - u).re ≠ 0 := fun hz => hnc (facts.2.2.1.mp hz) + rw [hlap, (DiamondLaplacianTable K).2.2 _ facts.1] + simp only [ite_eq_left facts.2.1, ite_eq_right hnz] + norm_num + · intro hk hc + have facts := htwo hk + have hz : (xn - u).re = 0 := facts.2.2.1.mpr hc + rw [hlap, (DiamondLaplacianTable K).2.2 _ facts.1] + simp only [ite_eq_left facts.2.1, ite_eq_left hz] + norm_num + · intro hk + exact (hthree hk).elim + · intro hk _ + have facts := hfour hk + rw [hlap, (DiamondLaplacianTable K).2.2 _ facts.1] + simp only [ite_eq_right facts.2.1, ite_eq_right facts.2.2.1] + norm_num + · intro hk hc + exact ((hfour hk).2.2.2 hc).elim + · obtain ⟨cfg⟩ := cfg + have hpos := (ProperBandCurvatureStructure qn hqn).1 + let C : BandCircle := + ⟨⟨qn 0, ⟨Or.inl hpos, ⟨qn, hqn.1, ⟨0, rfl⟩⟩⟩⟩, hpos⟩ + have layout := InteriorTableGeometry.layout qn Tn hqn hTn cfg hpos + obtain ⟨cert⟩ := layout + obtain ⟨P, r, Q, S', u, v, data⟩ := + P4120T1GeneralRowData qn cfg C Tn cert hn gn hodon hextn + have obs : ∀ i s, + FootprintVertices (Sn i s) = FootprintVertices (cert.P i s) ∧ + BoundaryFootprintVertices (Sn i s) = + BoundaryFootprintVertices (cert.P i s) := InteriorTableGeometry.obsAt414 qn Tn Sn hqn + hSn cfg hpos cert + have hcount : + Nat.card {a : Fin 3 × Bool // xn ∈ BoundaryFootprintVertices (Sn a.1 a.2)} = + Nat.card {a : Fin 3 × Bool // + xn ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} := InteriorTableGeometry.hcount qn Tn + Sn xn hqn cfg hpos cert obs + have classification := BandOrderedGeneralInteriorStarClassification + qn cfg C Tn cert (BandTileSimultaneousInduction qn hqn Tn hTn).1 + xn hxn hxbn + have descent := P4120T1GeneralDescent qn cfg C Tn cert xn hxn hxbn + dsimp only at classification descent + rw [← hcount] at classification descent + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro hk hnc + exact (orderedGeneralRowDispatch qn cfg C Tn cert hn P r Q S' u v + gn xn false data (classification.1 hk hnc)).2 rfl + · intro hk hc + exact orderedGeneralCenteredDispatch qn cfg C Tn cert hn P r Q S' u v + gn xn data hextn (hcount.symm.trans hk) hc (classification.2.2.2 hk hc) + · intro hk + exact (orderedGeneralRowDispatch qn cfg C Tn cert hn P r Q S' u v + gn xn true data (classification.2.1 hk).1).1 rfl + · intro hk _ + exact (classification.2.2.1 hk).elim + · intro hk _ + exact (classification.2.2.1 hk).elim + · rcases descent with hd | ⟨i, s, hp, hf, hb⟩ + · exact Or.inl hd + · right + refine ⟨i, s, hp, ?_, ?_⟩ + · rw [(obs i s).1] + exact hf + · rw [(obs i s).2] + exact hb + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOdometerMaximality.lean b/LeanPool/ApollonianSuperharmonic/BandOdometerMaximality.lean new file mode 100644 index 0000000000..2ee309309b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOdometerMaximality.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPeriodicSuperharmonicity +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.PeriodicBoundaryWebLaplacian +public import LeanPool.ApollonianSuperharmonic.PeriodicOdometerIndicatorRigidity +public import LeanPool.ApollonianSuperharmonic.SufficientBoundedMaximality +public import LeanPool.ApollonianSuperharmonic.TilingLattice +public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis + +-- [TABLET NODE: BandOdometerMaximality] + +/-! +# BandOdometerMaximality + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOdometerMaximality (C : BandCircle) + (T : ProtoTile) (h : PartialOdometer) (g : IntegerLatticeFunction) + (hT : BandPrototile C.1.1 T) (hlat : LatticeTile T) + (hodo : TileOdometer C.1.1 T h) + (hdom : (h.domain : Set GaussianInt) = FootprintVertices T) + (hext : GlobalOdometerExtends g h) + (htile : ExactTileTiling (RegularTileFamily T (TilingLattice C))) + (hrep : IntegerSuperharmonicRepresentative (CircleMatrix C) g) + (hcocycle : ∀ v, v ∈ TilingLattice C → ∃ a : GaussianInt, + Matrix.mulVec (CircleMatrix C) ![(v.re : ℝ), (v.im : ℝ)] = + ![(a.re : ℝ), (a.im : ℝ)] ∧ + ∀ x, g (x + v) = g x + x.re * a.re + x.im * a.im + g v) : + ∀ f : IntegerLatticeFunction, (∀ x, g x ≤ f x) → + (∀ x, FourNeighborLaplacian f x ≤ 1) → BoundedDifference f g := by +-- BODY + have hbound : ∀ x, FourNeighborLaplacian g x ≤ 1 := hrep.2.2 + have lapshift : ∀ w : GaussianInt, w ∈ TilingLattice C → + ∀ x, FourNeighborLaplacian g (x + w) = FourNeighborLaplacian g x := by + intro w hw x + obtain ⟨a, ha, hg⟩ := hcocycle w hw + rw [FourNeighborLaplacian, FourNeighborLaplacian] + rw [show x + w + 1 = (x + 1) + w by abel, + show x + w - 1 = (x - 1) + w by abel, + show x + w + ⟨0, 1⟩ = (x + ⟨0, 1⟩) + w by abel, + show x + w - ⟨0, 1⟩ = (x - ⟨0, 1⟩) + w by abel] + rw [hg, hg, hg, hg, hg] + simp + ring + have hweb := PeriodicBoundaryWebLaplacian C T h g hT hodo hext hcocycle + have hrigid := PeriodicOdometerIndicatorRigidity C T h g hT hlat hodo hdom + hext htile lapshift hweb + have periods : ∃ u v : GaussianInt, + u.re * v.im - u.im * v.re ≠ 0 ∧ + (∀ x, FourNeighborLaplacian g (x + u) = FourNeighborLaplacian g x) ∧ + ∀ x, FourNeighborLaplacian g (x + v) = FourNeighborLaplacian g x := by + by_cases hunit : C.1.1.1 = 1 + · refine ⟨1, ⟨0, 1⟩, ?_, ?_, ?_⟩ + · norm_num + · intro x + apply lapshift 1 (by simp [TilingLattice, hunit]) + · intro x + apply lapshift ⟨0, 1⟩ (by simp [TilingLattice, hunit]) + · obtain ⟨q, hsemi, hqC, hlt, huniq⟩ := + Or.resolve_left (BandGenealogy C) hunit + have hproper : ProperBandQuadruple q := ⟨hsemi, by + intro j + simpa [hqC] using hlt j⟩ + have basis := TilingLatticeBasis C q hproper hqC + let a : GaussianInt := BandVectors.1 (q 1) (q 0) + let b : GaussianInt := BandVectors.1 (q 2) (q 0) + have ha : a ∈ TilingLattice C := by simpa [a] using basis.1 + have hb : b ∈ TilingLattice C := by simpa [b] using basis.2.1 + have hu : ∀ m n : Int × Int, + (m.1 : GaussianInt) * a + (m.2 : GaussianInt) * b = + (n.1 : GaussianInt) * a + (n.2 : GaussianInt) * b → m = n := by + intro m n hmn + let z : GaussianInt := (m.1 : GaussianInt) * a + (m.2 : GaussianInt) * b + have hzmem : z ∈ TilingLattice C := by + apply (TilingLattice C).add_mem + · simpa [z] using (TilingLattice C).zsmul_mem ha m.1 + · simpa [z] using (TilingLattice C).zsmul_mem hb m.2 + obtain ⟨w, hw, hwu⟩ := basis.2.2.1 (⟨z, hzmem⟩ : TilingLattice C) + apply (hwu m ?_).trans (hwu n ?_).symm + · rfl + · simpa [a, b, z] using hmn.symm + have determinant : a.re * b.im - a.im * b.re ≠ 0 := by + intro hz + have ha0 : a ≠ 0 := by + intro ha0 + have he := hu (1, 0) (0, 0) + apply (by norm_num : (1 : Int) ≠ 0) + have := he (by simp [ha0]) + exact congrArg Prod.fst this + by_cases him : a.im = 0 ∧ b.im = 0 + · have hre : b.re * a.re - a.re * b.re = 0 := by + linarith [hz] + have he := hu (b.re, -a.re) (0, 0) + have hzero : (b.re : GaussianInt) * a + + ((-a.re : Int) : GaussianInt) * b = 0 := by + ext <;> simp [him.1, him.2]; ring + have hpair := he (by simpa using hzero) + have hbre : b.re = 0 := congrArg Prod.fst hpair + have hare : a.re = 0 := by + have hh := congrArg Prod.snd hpair + simpa using neg_eq_zero.mp hh + apply ha0 + ext <;> simp [hare, him.1] + · have he := hu (b.im, -a.im) (0, 0) + have hzero : (b.im : GaussianInt) * a + + ((-a.im : Int) : GaussianInt) * b = 0 := by + ext <;> simp <;> linarith [hz] + have hpair := he (by simpa using hzero) + have hi1 : b.im = 0 := congrArg Prod.fst hpair + have hi2 : a.im = 0 := by + have hh := congrArg Prod.snd hpair + simpa using neg_eq_zero.mp hh + exact him ⟨hi2, hi1⟩ + exact ⟨a, b, determinant, lapshift a ha, lapshift b hb⟩ + exact SufficientBoundedMaximality g hbound periods hrigid + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOdometerTheorem.lean b/LeanPool/ApollonianSuperharmonic/BandOdometerTheorem.lean new file mode 100644 index 0000000000..ea4706fc0a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOdometerTheorem.lean @@ -0,0 +1,172 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry + +public import LeanPool.ApollonianSuperharmonic.BandLatticeEquality +public import LeanPool.ApollonianSuperharmonic.BandOdometerMaximality +public import LeanPool.ApollonianSuperharmonic.BandPeriodicOdometer +public import LeanPool.ApollonianSuperharmonic.BandPeriodicSuperharmonicity +public import LeanPool.ApollonianSuperharmonic.BandTileTopologyApplication +public import LeanPool.ApollonianSuperharmonic.CurvatureOneTileBase + +-- [TABLET NODE: BandOdometerTheorem] + +/-! +# BandOdometerTheorem + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOdometerTheorem : ∀ C : BandCircle, + ∃ g : IntegerLatticeFunction, + IntegerSuperharmonicRepresentative (CircleMatrix C) g ∧ + (∀ v, v ∈ IntegralityLattice C → ∃ a : GaussianInt, + Matrix.mulVec (CircleMatrix C) ![(v.re : ℝ), (v.im : ℝ)] = + ![(a.re : ℝ), (a.im : ℝ)] ∧ + ∀ x, g (x + v) = g x + x.re * a.re + x.im * a.im + g v) ∧ + ∀ f : IntegerLatticeFunction, (∀ x, g x ≤ f x) → + (∀ x, FourNeighborLaplacian f x ≤ 1) → BoundedDifference f g := by +-- BODY + intro C + obtain ⟨T, h, g, hT, hodo, hext, hcocycle, hremainder⟩ := BandPeriodicOdometer C + have domain_from_odo : ∀ (c : CircleCoordinates) (U : ProtoTile) (k : PartialOdometer), + TileOdometer c U k → (k.domain : Set GaussianInt) = FootprintVertices U := by + intro c U k ho + induction ho with + | line w x hw k hdom => + simp [hdom, FootprintVertices] + | unit z x U k hU hdom htrans => + exact hdom + | @decompose q hq S U hs k hU hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + ext y + change (y ∈ k.domain) ↔ y ∈ FootprintVertices U + rw [hdom] + have child (i : Fin 3) (s : Bool) : + (hs i s).domain = FootprintVertices (S i s) := + ih i s + change (∃ i s, y ∈ (hs i s).domain) ↔ y ∈ FootprintVertices U + have union : (∃ i s, y ∈ (hs i s).domain) ↔ + ∃ i s, y ∈ FootprintVertices (S i s) := by + constructor + · rintro ⟨i, s, hy⟩ + exact ⟨i, s, (Set.ext_iff.mp (child i s) y).mp hy⟩ + · rintro ⟨i, s, hy⟩ + exact ⟨i, s, (Set.ext_iff.mp (child i s) y).mpr hy⟩ + rw [union] + clear hq hU hsub hcentroid hvalue hcompat hslope ih child union + classical + simp only [FootprintVertices] + constructor + · rintro ⟨i, s, hy⟩ + exact hfoot i s hy + · intro hy + by_cases hu : U.cells.Nonempty + · simp only [ite_eq_left hu, Set.mem_ofPred_eq] at hy + rcases hy with ⟨x, hx, hv⟩ + rcases (hcells x).mp hx with ⟨i, s, hxs⟩ + have hs : (S i s).cells.Nonempty := ⟨x, hxs⟩ + refine ⟨i, s, ?_⟩ + simp only [ite_eq_left hs, Set.mem_ofPred_eq] + exact ⟨x, hxs, hv⟩ + · have hs_empty : ∀ i s, ¬ (S i s).cells.Nonempty := by + intro i s hs + rcases hs with ⟨x, hx⟩ + apply hu + exact ⟨x, (hcells x).mpr ⟨i, s, hx⟩⟩ + have ha : (S 0 false).anchor = U.anchor := by + have hh := hfoot 0 false + rw [FootprintVertices, ite_eq_right (hs_empty 0 false), + FootprintVertices, ite_eq_right hu] at hh + have hm := hh (Set.mem_singleton _) + simpa using hm + simp only [ite_eq_right hu, Set.mem_singleton_iff] at hy + refine ⟨0, false, ?_⟩ + simp only [ite_eq_right (hs_empty 0 false), Set.mem_singleton_iff] + simpa [ha] using hy + have hdom : (h.domain : Set GaussianInt) = FootprintVertices T := by + exact domain_from_odo _ _ _ hodo + classical + have tiling_data : LatticeTile T ∧ + ExactTileTiling (RegularTileFamily T (TilingLattice C)) := by + generalize coordinate : C.1.1 = c at hT + cases hT with + | line w x hw => + exfalso + have hc := C.2 + simp_all [] + | unit z x anchor => + have hc : C.1.1.1 = 1 := by + have := congrArg Prod.fst coordinate + simpa using this + let square : ProtoTile := ⟨{0}, 0⟩ + have square_disk : LatticeTile square := by + have hunit : FordTile 1 = square := by + have zero_coordinates : (⟨0, 0⟩ : GaussianInt) = 0 := rfl + simp [square, FordTile, FordCellDomain, zero_coordinates] + simpa only [hunit] using (FordTileGeometry 1 (by omega)).1 + have translated := (TileDiskAreaCovariance square x).1.mp square_disk + have identify : ({ cells := {x}, anchor := x } : ProtoTile) = + TileTranslation square x := by + simp [square, TileTranslation, GaussianTranslation] + refine ⟨by + simpa [LatticeTile, TileRealization, square, TileTranslation, + GaussianTranslation] using translated, ?_⟩ + have lattice : TilingLattice C = ⊤ := by simp [TilingLattice, hc] + unfold ExactTileTiling RegularTileFamily + rw [lattice] + constructor + · intro V hV + rcases hV with ⟨u, hu, rfl⟩ + have hd := (TileDiskAreaCovariance (TileTranslation square x) u).1.mp + (by simpa [identify] using translated) + simpa [LatticeTile, TileRealization, square, TileTranslation, + GaussianTranslation] using hd + · intro y + refine ⟨{ cells := {x + (y - x)}, anchor := anchor + (y - x)}, ?_, ?_, ?_⟩ + · simp only [TileTranslation, GaussianTranslation] + refine ⟨(y : GaussianInt) - x, ?_⟩ + constructor + · simp + · simp [GaussianTranslation] + · simp [sub_eq_add_neg] + · intro V hV hy + rcases hV with ⟨a, ha, rfl⟩ + simp? [TileTranslation, GaussianTranslation] at hy ⊢ + obtain rfl := hy + constructor + · rfl + · simp [] + | @decompose q hq S U hS hcells' hfoot' hcentroid' => + have hqC : q 0 = C.1.1 := by simp [coordinate] + have hparent : BandPrototile (q 0) T := by + exact BandPrototile.decompose hq hS hcells' hfoot' hcentroid' + obtain ⟨hlat, harea, hcomplements, hsym, hT3, hT4, hT5, hT6⟩ := + BandTileSimultaneousInduction q hq T hparent + obtain ⟨htile, hcard⟩ := + BandTileTopologyApplication C q hq hqC T hparent + exact ⟨hlat, htile⟩ + have hrep : IntegerSuperharmonicRepresentative (CircleMatrix C) g := + BandPeriodicSuperharmonicity C T h g hT hodo hext hcocycle hremainder + refine ⟨g, hrep, ?_, ?_⟩ + · intro v hv + have hv' : v ∈ TilingLattice C := by + rw [← BandLatticeEquality C] + exact hv + exact hcocycle v hv' + · intro f hfg hlf + exact BandOdometerMaximality C T h g hT tiling_data.1 hodo hdom hext + tiling_data.2 hrep hcocycle f hfg hlf + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralAggregatePatches.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralAggregatePatches.lean new file mode 100644 index 0000000000..1863364e1b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralAggregatePatches.lean @@ -0,0 +1,160 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.P3161T1AggregateInducedConnectivity +public import LeanPool.ApollonianSuperharmonic.P3161T1AggregateComplementConnectivity +public import Mathlib.Data.List.Chain + +-- [TABLET NODE: BandOrderedGeneralAggregatePatches] + +/-! +# BandOrderedGeneralAggregatePatches + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralAggregatePatches + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let triangles : Finset (Finset (Int × Int)) := + { + {(0, 0), (1, 0), (0, -1)}, + {(0, 0), (0, 1), (1, 1)}, + {(0, 0), (-1, -1), (-1, 0)} + } + ∀ τ ∈ triangles, ∀ σ ∈ τ.powerset, σ.Nonempty → + ∃ patch : FiniteInducedTilePatch + cert.modified.plane cert.modified.tile, + patch.indices = σ.biUnion (fun mn ↦ K mn.1 mn.2) ∧ + ∀ x, x ∈ patch.unionTile.cells ↔ + ∃ mn ∈ σ, ∃ a ∈ K mn.1 mn.2, + x ∈ (cert.modified.tile a).cells := by +-- BODY + classical + dsimp only + intro τ hτ σ hσ hnonempty + have hsubset : σ ⊆ τ := Finset.mem_powerset.mp hσ + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let I := σ.biUnion (fun mn ↦ K mn.1 mn.2) + have memI (a : PeriodicSubtileIndex) : + a ∈ I ↔ (a.first, a.second) ∈ σ := by + constructor + · intro ha + obtain ⟨z, hz, ha⟩ := Finset.mem_biUnion.mp ha + simp only [K, Finset.mem_insert, Finset.mem_singleton] at ha + rcases ha with rfl | rfl | rfl | rfl | rfl | rfl <;> exact hz + · intro ha + refine Finset.mem_biUnion.mpr ⟨(a.first, a.second), ha, ?_⟩ + cases a with | mk label m n => cases label <;> simp [K] + have hI : I.Nonempty := by + obtain ⟨z, hz⟩ := hnonempty + exact ⟨⟨.A, z.1, z.2⟩, (memI _).mpr hz⟩ + let U : ProtoTile := ⟨I.biUnion (fun a ↦ (cert.modified.tile a).cells), 0⟩ + have exactU (x : LatticeCell) : + x ∈ U.cells ↔ ∃ a ∈ I, x ∈ (cert.modified.tile a).cells := + Finset.mem_biUnion + have injective : Set.InjOn cert.modified.tile (I : Set PeriodicSubtileIndex) := by + intro a _ b _ hab + obtain ⟨homeo⟩ := cert.modified.tiles_are_disks a + have hp := (homeo ⟨0, by simp⟩).property + change (homeo ⟨0, by simp⟩ : Real × Real) ∈ + TileRealization (cert.modified.tile a) at hp + simp only [TileRealization, Set.mem_iUnion] at hp + obtain ⟨x, hxa, _⟩ := hp + have hxb : x ∈ (cert.modified.tile b).cells := by rw [← hab]; exact hxa + have ha : x ∈ (ModifiedSubtileOccurrenceInterpretation + cert.P cert.O cert.u cert.v a).cells := by + simpa only [cert.modified_tile a] using hxa + have hb : x ∈ (ModifiedSubtileOccurrenceInterpretation + cert.P cert.O cert.u cert.v b).cells := by + simpa only [cert.modified_tile b] using hxb + obtain ⟨o, _, unique⟩ := cert.partition x + exact (unique a ha).trans (unique b hb).symm + have walk (S : PeriodicSubtileIndex → Prop) (a b : PeriodicSubtileIndex) + (ha : S a) + (h : Relation.ReflTransGen + (fun x y ↦ AllowedSubtileIncidence x y ∧ S x ∧ S y) a b) : + ∃ p : List PeriodicSubtileIndex, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ x ∈ p, S x) ∧ + ∀ x y : PeriodicSubtileIndex, ∀ l₁ l₂ : List PeriodicSubtileIndex, + p = l₁ ++ x :: y :: l₂ → cert.modified.plane.adjacent x y := by + obtain ⟨l, hc, hl⟩ := List.exists_isChain_cons_of_relationReflTransGen h + refine ⟨a :: l, rfl, ?_, ?_, ?_⟩ + · simpa only [List.getLast?_eq_some_getLast (List.cons_ne_nil a l)] + using congrArg some hl + · have go : ∀ (u : PeriodicSubtileIndex) (p : List PeriodicSubtileIndex), S u → + (u :: p).IsChain (fun x y ↦ AllowedSubtileIncidence x y ∧ S x ∧ S y) → + ∀ x ∈ u :: p, S x := by + intro u p + induction p generalizing u with + | nil => simp_all + | cons v p ih => + intro hu hc x hx + simp only [List.mem_cons] at hx + rcases hx with hx | hx + · exact hx.symm ▸ hu + · exact ih v hc.rel.2.2 hc.tail x (by simpa only [List.mem_cons] using hx) + exact go a l ha hc + · intro x y l₁ l₂ he + exact (cert.modified_adjacency x y).mpr + ((List.isChain_iff_forall_rel_of_append_cons_cons.mp hc he).1) + let patch : FiniteInducedTilePatch cert.modified.plane cert.modified.tile := { + indices := I + unionTile := U + nonempty := hI + tile_injective := injective + exact_union := exactU + induced_connected := by + intro a ha b hb + apply walk (fun x ↦ x ∈ I) a b ha + exact Relation.ReflTransGen.mono + (fun x y e ↦ ⟨e.1, (memI x).mpr e.2.1, (memI y).mpr e.2.2⟩) a b + (P3161T1AggregateInducedConnectivity τ σ hτ hsubset a b + ((memI a).mp ha) ((memI b).mp hb)) + complement_connected := by + intro a ha b hb + apply walk (fun x ↦ x ∉ I) a b ha + exact Relation.ReflTransGen.mono + (fun x y e ↦ ⟨e.1, fun hx ↦ e.2.1 ((memI x).mp hx), + fun hy ↦ e.2.2 ((memI y).mp hy)⟩) a b + (P3161T1AggregateComplementConnectivity τ σ hτ hsubset a b + (fun hx ↦ ha ((memI a).mpr hx)) (fun hy ↦ hb ((memI b).mpr hy))) + } + refine ⟨patch, rfl, ?_⟩ + intro x + change x ∈ U.cells ↔ ∃ mn ∈ σ, ∃ a ∈ K mn.1 mn.2, + x ∈ (cert.modified.tile a).cells + rw [exactU] + simp only [I, Finset.mem_biUnion] + constructor + · rintro ⟨a, ⟨mn, hmn, ha⟩, hx⟩ + exact ⟨mn, hmn, a, ha, hx⟩ + · rintro ⟨mn, hmn, a, ha, hx⟩ + exact ⟨a, ⟨mn, hmn, ha⟩, hx⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean new file mode 100644 index 0000000000..e0ef3f4009 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean @@ -0,0 +1,1654 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralAggregatePatches +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMixedAggregatePatches +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleRetargetMiddle +public import LeanPool.ApollonianSuperharmonic.FinitePatchTopology +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation +public import LeanPool.ApollonianSuperharmonic.LatticeTileThreeDiskJunction +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricExactInterfaceTransport +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandOrderedGeneralChildInterfaces] + +/-! +# BandOrderedGeneralChildInterfaces + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +private noncomputable def retargetNonemptyTriple (A A' B B' C C' : ProtoTile) + (hAc : A.cells = A'.cells) (hAn : A.cells.Nonempty) + (hBc : B.cells = B'.cells) (hBn : B.cells.Nonempty) + (hCc : C.cells = C'.cells) (hCn : C.cells.Nonempty) + (E : ExactTileInterfaceTriple A B C) : ExactTileInterfaceTriple A' B' C' := by + classical + have ha : A.cells = ∅ → A.anchor = A'.anchor := by + intro he + exact False.elim ((Finset.not_nonempty_iff_eq_empty.mpr he) hAn) + have hb : B.cells = ∅ → B.anchor = B'.anchor := by + intro he + exact False.elim ((Finset.not_nonempty_iff_eq_empty.mpr he) hBn) + have hc : C.cells = ∅ → C.anchor = C'.anchor := by + intro he + exact False.elim ((Finset.not_nonempty_iff_eq_empty.mpr he) hCn) + have oa := ProtoTileObservableExtensionality A A' hAc ha + have ob := ProtoTileObservableExtensionality B B' hBc hb + have oc := ProtoTileObservableExtensionality C C' hCc hc + have ea : FootprintEdges A = FootprintEdges A' := by simp [FootprintEdges, hAc] + have eb : FootprintEdges B = FootprintEdges B' := by simp [FootprintEdges, hBc] + have ec : FootprintEdges C = FootprintEdges C' := by simp [FootprintEdges, hCc] + exact { + point := E.point + otherAB := E.otherAB + otherBC := E.otherBC + otherCA := E.otherCA + pathAB := by simpa [oa.1, ob.1, ea, eb] using E.pathAB + pathBC := by simpa [ob.1, oc.1, eb, ec] using E.pathBC + pathCA := by simpa [oc.1, oa.1, ec, ea] using E.pathCA + unique_common := by intro x; simpa [oa.1, ob.1, oc.1] using E.unique_common x } + +namespace ChildInterfaceGeometry + +private theorem first_parent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ( + let junctionData := fun (A B C : ProtoTile) => ∃ (AB : ProtoTile) (BC : ProtoTile) (CA : + ProtoTile) (ABC : ProtoTile), LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ Disjoint A.cells + B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ (∀ (z : LatticeCell), + z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ (∀ (z : LatticeCell), z ∈ BC.cells ↔ z ∈ + B.cells ∨ z ∈ C.cells) ∧ (∀ (z : LatticeCell), z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ + A.cells) ∧ (∀ (z : LatticeCell), z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ + C.cells) ∧ (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ (FootprintEdges B ∩ + FootprintEdges C).Nonempty ∧ (FootprintEdges C ∩ FootprintEdges A).Nonempty; + let pairedEndpointData := fun (i : Fin (3 : ℕ)) (s : Fin (4 : ℕ)) (U V : ProtoTile) => + have uR := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) else BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))); + let uL := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then + BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) else BandVectors.1 (q (0 : Fin (4 : + ℕ))) (q i.succ); ∃ (rightData : ExactTileInterfaceTriple T (TileTranslation T uR) U) + (incomingData : ExactTileInterfaceTriple T (TileTranslation T uL) U) (t5Data : + ExactTileInterfaceTriple T U V), rightData.point = t5Data.point ∧ incomingData.point + ≠ t5Data.point ∧ incomingData.otherCA = t5Data.point ∧ rightData.otherCA = + incomingData.point ∧ t5Data.otherAB = incomingData.point; (∀ (i : Fin (3 : ℕ)), ∀ (U + : ProtoTile), BandPrototile (q i.succ) U → TileCentroid U - TileCentroid T = (1 / 2 : + ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → junctionData T + (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ (∀ (i : Fin + (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → + BandPrototile (q (i + (1 : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = + (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V + - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin + (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin + (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → junctionData T U V) ∧ ∀ (i : Fin (3 : + ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q + i.succ) U → BandPrototile (q (if Even (↑s : ℕ) then i + (1 : Fin (3 : ℕ)) else i - (1 + : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → + TileCentroid V - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (q (i + (1 : Fin + (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ))) - BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + + (1 : Fin (3 : ℕ))).succ) else BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i - (1 : Fin (3 + : ℕ))).succ) - BandVectors.1 (q (i - (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) + → pairedEndpointData i s U V) → (∀ (i : Fin 3), ∀ (U : ProtoTile), (BandPrototile (q + i.succ) U) → ((TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))) → (Nonempty + (ExactTileInterfaceTriple T (TileTranslation T (BandVectors.1 (q i.succ) (q + 0))) U)))) ) := by + classical + intro q T mixed i U hU hc + obtain ⟨AB, BC, CA, ABC, hA, hB, hC, hAB, hBC, hCA, hABC, + hdAB, hdBC, hdCA, huAB, huBC, huCA, huABC, heAB, heBC, heCA⟩ := + mixed.1 i U hU hc + exact LatticeTileThreeDiskJunction T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U AB BC CA ABC + hA hB hC hAB hBC hCA hABC hdAB hdBC hdCA + huAB huBC huCA huABC heAB heBC heCA + +private theorem parent_pair : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ( + let junctionData := fun (A B C : ProtoTile) => ∃ (AB : ProtoTile) (BC : ProtoTile) (CA : + ProtoTile) (ABC : ProtoTile), LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ Disjoint A.cells + B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ (∀ (z : LatticeCell), + z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ (∀ (z : LatticeCell), z ∈ BC.cells ↔ z ∈ + B.cells ∨ z ∈ C.cells) ∧ (∀ (z : LatticeCell), z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ + A.cells) ∧ (∀ (z : LatticeCell), z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ + C.cells) ∧ (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ (FootprintEdges B ∩ + FootprintEdges C).Nonempty ∧ (FootprintEdges C ∩ FootprintEdges A).Nonempty; + let pairedEndpointData := fun (i : Fin (3 : ℕ)) (s : Fin (4 : ℕ)) (U V : ProtoTile) => + have uR := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) else BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))); + let uL := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then + BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) else BandVectors.1 (q (0 : Fin (4 : + ℕ))) (q i.succ); ∃ (rightData : ExactTileInterfaceTriple T (TileTranslation T uR) U) + (incomingData : ExactTileInterfaceTriple T (TileTranslation T uL) U) (t5Data : + ExactTileInterfaceTriple T U V), rightData.point = t5Data.point ∧ incomingData.point + ≠ t5Data.point ∧ incomingData.otherCA = t5Data.point ∧ rightData.otherCA = + incomingData.point ∧ t5Data.otherAB = incomingData.point; (∀ (i : Fin (3 : ℕ)), ∀ (U + : ProtoTile), BandPrototile (q i.succ) U → TileCentroid U - TileCentroid T = (1 / 2 : + ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → junctionData T + (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ (∀ (i : Fin + (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → + BandPrototile (q (i + (1 : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = + (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V + - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin + (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin + (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → junctionData T U V) ∧ ∀ (i : Fin (3 : + ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q + i.succ) U → BandPrototile (q (if Even (↑s : ℕ) then i + (1 : Fin (3 : ℕ)) else i - (1 + : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → + TileCentroid V - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (q (i + (1 : Fin + (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ))) - BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + + (1 : Fin (3 : ℕ))).succ) else BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i - (1 : Fin (3 + : ℕ))).succ) - BandVectors.1 (q (i - (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) + → pairedEndpointData i s U V) → (∀ (i : Fin 3), ∀ (U : ProtoTile), ∀ (V : ProtoTile), + (BandPrototile (q i.succ) U) → ((BandPrototile (q ((i + 1).succ)) V) → ((TileCentroid + U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))) → ((TileCentroid V - + TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ))))) → (Nonempty + (ExactTileInterfaceTriple T U V)))))) ) := by + classical + intro q T mixed i U V hU hV hcU hcV + obtain ⟨AB, BC, CA, ABC, hA, hB, hC, hAB, hBC, hCA, hABC, + hdAB, hdBC, hdCA, huAB, huBC, huCA, huABC, heAB, heBC, heCA⟩ := + mixed.2.1 i U V hU hV hcU hcV + exact LatticeTileThreeDiskJunction T U V AB BC CA ABC + hA hB hC hAB hBC hCA hABC hdAB hdBC hdCA + huAB huBC huCA huABC heAB heBC heCA + +private theorem τmem : + (by + classical + exact + let τ : Finset (Int × Int) := {(0, 0), (0, 1), (1, 1)} + τ ∈ ({ {(0, 0), (1, 0), (0, -1)}, {(0, 0), (0, 1), (1, 1)}, {(0, 0), (-1, -1), (-1, 0)}} + : Finset (Finset (Int × Int))) ) := by + classical + intro τ + simp [τ] + +private theorem patchFor : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let τ : Finset (Int × Int) := {(0, 0), (0, 1), (1, 1)} + (∀ (τ : Finset (Int × Int)), τ ∈ ({{((0 : ℤ), (0 : ℤ)), ((1 : ℤ), (0 : ℤ)), ((0 : ℤ), + (-1 : ℤ))}, {((0 : ℤ), + (0 : ℤ)), ((0 : ℤ), (1 : ℤ)), ((1 : ℤ), (1 : ℤ))}, {((0 : ℤ), (0 : ℤ)), ((-1 : ℤ), + (-1 : ℤ)), ((-1 : ℤ), (0 : ℤ))}} : Finset (Finset (Int × Int))) → ∀ (σ : Finset (Int + × Int)), σ ∈ τ.powerset → σ.Nonempty → ∃ (patch : + FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (patch.indices = + σ.biUnion fun (mn : ℤ × ℤ) => (K mn.1 mn.2)) ∧ ∀ (x : LatticeCell), x ∈ + patch.unionTile.cells ↔ ∃ mn ∈ σ, + ∃ a ∈ (K mn.1 mn.2), x ∈ (cert.modified.tile a).cells) → ((τ ∈ ({ {(0, 0), + (1, 0), (0, -1)}, {(0, 0), (0, 1), (1, 1)}, {(0, 0), (-1, -1), (-1, 0)}} : Finset + (Finset (Int × Int)))) → (∀ (σ : Finset (Int × Int)), (σ ⊆ τ) → ((σ.Nonempty) → (∃ p + : FiniteInducedTilePatch cert.modified.plane cert.modified.tile, p.indices = + σ.biUnion (fun mn => K mn.1 mn.2) ∧ ∀ x, x ∈ p.unionTile.cells ↔ ∃ mn ∈ σ, ∃ a ∈ K + mn.1 mn.2, x ∈ (cert.modified.tile a).cells)))) ) := by + classical + intro q cfg C₀ T cert K τ aggregate' τmem σ hσ hne + exact aggregate' τ τmem σ (Finset.mem_powerset.mpr hσ) hne + +private theorem patchForAt : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + (∀ (τ : Finset (Int × Int)), τ ∈ ({{((0 : ℤ), (0 : ℤ)), ((1 : ℤ), (0 : ℤ)), ((0 : ℤ), + (-1 : ℤ))}, {((0 : ℤ), + (0 : ℤ)), ((0 : ℤ), (1 : ℤ)), ((1 : ℤ), (1 : ℤ))}, {((0 : ℤ), (0 : ℤ)), ((-1 : ℤ), + (-1 : ℤ)), ((-1 : ℤ), (0 : ℤ))}} : Finset (Finset (Int × Int))) → ∀ (σ : Finset (Int + × Int)), σ ∈ τ.powerset → σ.Nonempty → ∃ (patch : + FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (patch.indices = + σ.biUnion fun (mn : ℤ × ℤ) => (K mn.1 mn.2)) ∧ ∀ (x : LatticeCell), x ∈ + patch.unionTile.cells ↔ ∃ mn ∈ σ, + ∃ a ∈ (K mn.1 mn.2), x ∈ (cert.modified.tile a).cells) → (∀ (ρ : Finset + (Int × Int)), ∀ (σ : Finset (Int × Int)), (ρ ∈ ({ + {(0, 0), (1, 0), (0, -1)}, + {(0, 0), (0, 1), (1, 1)}, + {(0, 0), (-1, -1), (-1, 0)}} : Finset (Finset (Int × Int)))) → ((σ ⊆ ρ) → ((σ.Nonempty) + → (∃ p : FiniteInducedTilePatch cert.modified.plane cert.modified.tile, p.indices = + σ.biUnion (fun mn => K mn.1 mn.2) ∧ ∀ x, x ∈ p.unionTile.cells ↔ ∃ mn ∈ σ, ∃ a ∈ K + mn.1 mn.2, x ∈ (cert.modified.tile a).cells)))) ) := by + classical + intro q cfg C₀ T cert K aggregate' ρ σ hρ hσ hne + exact aggregate' ρ hρ σ (Finset.mem_powerset.mpr hσ) hne + +private theorem blockEq : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + ∀ (m : Int), ∀ (n : Int), (blockTile m n).cells = (TileTranslation T ((m : GaussianInt) * + cert.u + (n : GaussianInt) * cert.v)).cells ) := by + classical + intro q cfg C₀ T cert K blockTile m n + ext x + change x ∈ (K m n).biUnion (fun a => (cert.modified.tile a).cells) ↔ _ + rw [Finset.mem_biUnion] + constructor + · rintro ⟨a, ha, hx⟩ + have hcoords : a.first = m ∧ a.second = n := by + cases a with + | mk l r s => cases l <;> simp? [K] at ha <;> exact ha + have haeq : a = ⟨a.label, m, n⟩ := by + cases a with + | mk l r s => + simp only [PeriodicSubtileIndex.mk.injEq] + exact ⟨trivial, by simpa using hcoords.1, by simpa using hcoords.2⟩ + rw [haeq] at hx + apply (BandOrderedGeneralPeriodicBlockCells q cfg C₀ T cert).1 m n x |>.mpr + exact ⟨a.label, by simpa [cert.modified_tile] using hx⟩ + · intro hx + obtain ⟨label, hx⟩ := (BandOrderedGeneralPeriodicBlockCells q cfg C₀ T cert).1 m n x |>.mp hx + refine ⟨⟨label,m,n⟩, ?_, ?_⟩ + · cases label <;> simp [K] + · simpa [cert.modified_tile] using hx + +private theorem blockDisjoint : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (m : Int), ∀ (n : Int), (blockTile m n).cells = (TileTranslation T ((m : GaussianInt) + * cert.u + (n : GaussianInt) * cert.v)).cells) → (∀ (m : Int), ∀ (n : Int), ∀ (r : + Int), ∀ (s : Int), ((m,n) ≠ (r,s)) → (Disjoint (blockTile m n).cells (blockTile r + s).cells)) ) := by + classical + intro q cfg C₀ T cert K blockTile blockEq m n r s hne + rw [blockEq m n, blockEq r s] + exact (BandOrderedGeneralPeriodicBlockCells q cfg C₀ T cert).2 m n r s hne + +private theorem patchUnion : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + ∀ (p : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), ∀ (σ : Finset (Int + × Int)), (p.indices = σ.biUnion (fun mn => K mn.1 mn.2)) → ((∀ x, x ∈ + p.unionTile.cells ↔ + ∃ mn ∈ σ, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile a).cells) → (∀ x, x ∈ + p.unionTile.cells ↔ ∃ mn ∈ σ, x ∈ (blockTile mn.1 mn.2).cells)) ) := by + classical + intro q cfg C₀ T cert K blockTile p σ hp he x + rw [he x] + simp only [blockTile, Finset.mem_biUnion] + +private theorem hUA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (p : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), ∀ (σ : Finset + (Int × Int)), (p.indices = σ.biUnion (fun mn => K mn.1 mn.2)) → ((∀ x, x ∈ + p.unionTile.cells ↔ ∃ mn ∈ σ, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile a).cells) → + (∀ x, x ∈ p.unionTile.cells ↔ ∃ mn ∈ σ, x ∈ (blockTile mn.1 mn.2).cells))) → ( + let σA : Finset (Int × Int) := {(0,0)} + ∀ (pA : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (pA.indices = + σA.biUnion fun (mn : ℤ × ℤ) => K mn.1 mn.2) → ((∀ (x : LatticeCell), x ∈ + pA.unionTile.cells ↔ ∃ mn ∈ σA, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile a).cells) + → (∀ x, x ∈ pA.unionTile.cells ↔ x ∈ (blockTile 0 0).cells))) ) := by + classical + intro q cfg C₀ T cert K blockTile patchUnion σA pA hpA hexA x + simpa [σA] using patchUnion pA σA hpA hexA x + +private theorem hUB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (p : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), ∀ (σ : Finset + (Int × Int)), (p.indices = σ.biUnion (fun mn => K mn.1 mn.2)) → ((∀ x, x ∈ + p.unionTile.cells ↔ ∃ mn ∈ σ, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile a).cells) → + (∀ x, x ∈ p.unionTile.cells ↔ ∃ mn ∈ σ, x ∈ (blockTile mn.1 mn.2).cells))) → ( + let σB : Finset (Int × Int) := {(0,1)} + ∀ (pB : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (pB.indices = + σB.biUnion fun (mn : ℤ × ℤ) => K mn.1 mn.2) → ((∀ (x : LatticeCell), x ∈ + pB.unionTile.cells ↔ ∃ mn ∈ σB, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile a).cells) + → (∀ x, x ∈ pB.unionTile.cells ↔ x ∈ (blockTile 0 1).cells))) ) := by + classical + intro q cfg C₀ T cert K blockTile patchUnion σB pB hpB hexB x + simpa [σB] using patchUnion pB σB hpB hexB x + +private theorem hUC : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (p : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), ∀ (σ : Finset + (Int × Int)), (p.indices = σ.biUnion (fun mn => K mn.1 mn.2)) → ((∀ x, x ∈ + p.unionTile.cells ↔ ∃ mn ∈ σ, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile a).cells) → + (∀ x, x ∈ p.unionTile.cells ↔ ∃ mn ∈ σ, x ∈ (blockTile mn.1 mn.2).cells))) → ( + let σC : Finset (Int × Int) := {(1,1)} + ∀ (pC : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (pC.indices = + σC.biUnion fun (mn : ℤ × ℤ) => K mn.1 mn.2) → ((∀ (x : LatticeCell), x ∈ + pC.unionTile.cells ↔ ∃ mn ∈ σC, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile a).cells) + → (∀ x, x ∈ pC.unionTile.cells ↔ x ∈ (blockTile 1 1).cells))) ) := by + classical + intro q cfg C₀ T cert K blockTile patchUnion σC pC hpC hexC x + simpa [σC] using patchUnion pC σC hpC hexC x + +private theorem hUAB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (p : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), ∀ (σ : Finset + (Int × Int)), (p.indices = σ.biUnion (fun mn => K mn.1 mn.2)) → ((∀ x, x ∈ + p.unionTile.cells ↔ ∃ mn ∈ σ, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile a).cells) → + (∀ x, x ∈ p.unionTile.cells ↔ ∃ mn ∈ σ, x ∈ (blockTile mn.1 mn.2).cells))) → ( + let σAB : Finset (Int × Int) := {(0,0),(0,1)} + ∀ (pAB : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (pAB.indices = + σAB.biUnion fun (mn : ℤ × ℤ) => K mn.1 mn.2) → ((∀ (x : LatticeCell), x ∈ + pAB.unionTile.cells ↔ ∃ mn ∈ σAB, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile + a).cells) → (∀ x, x ∈ pAB.unionTile.cells ↔ x ∈ (blockTile 0 0).cells ∨ x ∈ + (blockTile 0 1).cells))) ) := by + classical + intro q cfg C₀ T cert K blockTile patchUnion σAB pAB hpAB hexAB x + simpa [σAB] using patchUnion pAB σAB hpAB hexAB x + +private theorem hUBC : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (p : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), ∀ (σ : Finset + (Int × Int)), (p.indices = σ.biUnion (fun mn => K mn.1 mn.2)) → ((∀ x, x ∈ + p.unionTile.cells ↔ ∃ mn ∈ σ, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile a).cells) → + (∀ x, x ∈ p.unionTile.cells ↔ ∃ mn ∈ σ, x ∈ (blockTile mn.1 mn.2).cells))) → ( + let σBC : Finset (Int × Int) := {(0,1),(1,1)} + ∀ (pBC : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (pBC.indices = + σBC.biUnion fun (mn : ℤ × ℤ) => K mn.1 mn.2) → ((∀ (x : LatticeCell), x ∈ + pBC.unionTile.cells ↔ ∃ mn ∈ σBC, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile + a).cells) → (∀ x, x ∈ pBC.unionTile.cells ↔ x ∈ (blockTile 0 1).cells ∨ x ∈ + (blockTile 1 1).cells))) ) := by + classical + intro q cfg C₀ T cert K blockTile patchUnion σBC pBC hpBC hexBC x + simpa [σBC] using patchUnion pBC σBC hpBC hexBC x + +private theorem hUCA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (p : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), ∀ (σ : Finset + (Int × Int)), (p.indices = σ.biUnion (fun mn => K mn.1 mn.2)) → ((∀ x, x ∈ + p.unionTile.cells ↔ ∃ mn ∈ σ, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile a).cells) → + (∀ x, x ∈ p.unionTile.cells ↔ ∃ mn ∈ σ, x ∈ (blockTile mn.1 mn.2).cells))) → ( + let σCA : Finset (Int × Int) := {(1,1),(0,0)} + ∀ (pCA : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (pCA.indices = + σCA.biUnion fun (mn : ℤ × ℤ) => K mn.1 mn.2) → ((∀ (x : LatticeCell), x ∈ + pCA.unionTile.cells ↔ ∃ mn ∈ σCA, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile + a).cells) → (∀ x, x ∈ pCA.unionTile.cells ↔ x ∈ (blockTile 1 1).cells ∨ x ∈ + (blockTile 0 0).cells))) ) := by + classical + intro q cfg C₀ T cert K blockTile patchUnion σCA pCA hpCA hexCA x + simpa [σCA] using patchUnion pCA σCA hpCA hexCA x + +private theorem hUABC : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let τ : Finset (Int × Int) := {(0, 0), (0, 1), (1, 1)} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (p : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), ∀ (σ : Finset + (Int × Int)), (p.indices = σ.biUnion (fun mn => K mn.1 mn.2)) → ((∀ x, x ∈ + p.unionTile.cells ↔ ∃ mn ∈ σ, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile a).cells) → + (∀ x, x ∈ p.unionTile.cells ↔ ∃ mn ∈ σ, x ∈ (blockTile mn.1 mn.2).cells))) → (∀ (pABC + : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (pABC.indices = + τ.biUnion fun (mn : ℤ × ℤ) => K mn.1 mn.2) → ((∀ (x : LatticeCell), x ∈ + pABC.unionTile.cells ↔ ∃ mn ∈ τ, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile a).cells) + → (∀ x, x ∈ pABC.unionTile.cells ↔ x ∈ (blockTile 0 0).cells ∨ x ∈ (blockTile 0 + 1).cells ∨ x ∈ (blockTile 1 1).cells))) ) := by + classical + intro q cfg C₀ T cert K τ blockTile patchUnion pABC hpABC hexABC x + constructor + · intro hx + obtain ⟨mn, hmn, hcell⟩ := (patchUnion pABC τ hpABC hexABC x).mp hx + simp only [τ, Finset.mem_insert, Finset.mem_singleton] at hmn + rcases hmn with hmn | hmn | hmn + · rcases hmn with rfl + exact Or.inl hcell + · rcases hmn with rfl + exact Or.inr (Or.inl hcell) + · rcases hmn with rfl + exact Or.inr (Or.inr hcell) + · intro hx + rcases hx with hx | hx | hx + · exact (patchUnion pABC τ hpABC hexABC x).mpr ⟨(0,0), by simp [τ], hx⟩ + · exact (patchUnion pABC τ hpABC hexABC x).mpr ⟨(0,1), by simp [τ], hx⟩ + · exact (patchUnion pABC τ hpABC hexABC x).mpr ⟨(1,1), by simp [τ], hx⟩ + +private theorem hcommonAB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (FootprintEdges (blockTile 0 0) ∩ FootprintEdges (blockTile 0 1)).Nonempty ) := by + classical + intro q cfg C₀ T cert K blockTile + have hadj := (cert.modified_adjacency ⟨.A,0,0⟩ ⟨.E,0,1⟩).2 + (AllowedSubtileIncidence.AE01 0 0) + have he := cert.modified.adjacent_has_common_edge _ _ hadj + rcases he with ⟨e, heA, heB⟩ + rcases heA with ⟨x, hx, hedge⟩ + rcases heB with ⟨y, hy, hedgeB⟩ + refine ⟨e, ?_, ?_⟩ + · exact ⟨x, Finset.mem_biUnion.mpr ⟨⟨.A,0,0⟩, by simp [K], hx⟩, hedge⟩ + · exact ⟨y, Finset.mem_biUnion.mpr ⟨⟨.E,0,1⟩, by simp [K], hy⟩, hedgeB⟩ + +private theorem hcommonBC : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (FootprintEdges (blockTile 0 1) ∩ FootprintEdges (blockTile 1 1)).Nonempty ) := by + classical + intro q cfg C₀ T cert K blockTile + have hadj := (cert.modified_adjacency ⟨.C,1,1⟩ ⟨.E,0,1⟩).2 + (AllowedSubtileIncidence.CEm10 1 1) + have he := cert.modified.adjacent_has_common_edge _ _ hadj + rcases he with ⟨e, heC, heB⟩ + rcases heB with ⟨x, hx, hedge⟩ + rcases heC with ⟨y, hy, hedgeC⟩ + refine ⟨e, ?_, ?_⟩ + · exact ⟨x, Finset.mem_biUnion.mpr ⟨⟨.E,0,1⟩, by simp [K], hx⟩, hedge⟩ + · exact ⟨y, Finset.mem_biUnion.mpr ⟨⟨.C,1,1⟩, by simp [K], hy⟩, hedgeC⟩ + +private theorem hcommonCA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (FootprintEdges (blockTile 1 1) ∩ FootprintEdges (blockTile 0 0)).Nonempty ) := by + classical + intro q cfg C₀ T cert K blockTile + have hadj := (cert.modified_adjacency ⟨.A,0,0⟩ ⟨.C,1,1⟩).2 + (AllowedSubtileIncidence.AC11 0 0) + have he := cert.modified.adjacent_has_common_edge _ _ hadj + rcases he with ⟨e, heA, heC⟩ + rcases heC with ⟨x, hx, hedge⟩ + rcases heA with ⟨y, hy, hedgeA⟩ + refine ⟨e, ?_, ?_⟩ + · exact ⟨x, Finset.mem_biUnion.mpr ⟨⟨.C,1,1⟩, by simp [K], hx⟩, hedge⟩ + · exact ⟨y, Finset.mem_biUnion.mpr ⟨⟨.A,0,0⟩, by simp [K], hy⟩, hedgeA⟩ + +private theorem blockLattice : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + ∀ (m : Int), ∀ (n : Int), ∀ (p : FiniteInducedTilePatch cert.modified.plane + cert.modified.tile), (∀ x, x ∈ p.unionTile.cells ↔ x ∈ (blockTile m n).cells) → + ((LatticeTile p.unionTile) → (LatticeTile (blockTile m n))) ) := by + classical + intro q cfg C₀ T cert K blockTile m n p hp hLp + have hcells : p.unionTile.cells = (blockTile m n).cells := Finset.ext fun x => hp x + have hne : p.unionTile.cells.Nonempty := (LatticeTileGridStructure _ hLp).1.1 + have hanchor : p.unionTile.cells = ∅ → p.unionTile.anchor = (blockTile m n).anchor := by + intro h + rw [h] at hne + exact False.elim ((Finset.not_nonempty_iff_eq_empty.mpr rfl) hne) + have hobs := ProtoTileObservableExtensionality p.unionTile (blockTile m n) hcells hanchor + change TopologicalDisk (TileRealization p.unionTile) at hLp + change TopologicalDisk (TileRealization (blockTile m n)) + rw [← hobs.2.2.2.1] + exact hLp + +private theorem blockJunction : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + ∀ (pAB : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), ∀ (pBC : + FiniteInducedTilePatch cert.modified.plane cert.modified.tile), ∀ (pCA : + FiniteInducedTilePatch cert.modified.plane cert.modified.tile), ∀ (pABC : + FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (LatticeTile + pAB.unionTile) → ((LatticeTile pBC.unionTile) → ((LatticeTile pCA.unionTile) → + ((LatticeTile pABC.unionTile) → ((∀ x, x ∈ pAB.unionTile.cells ↔ x ∈ (blockTile 0 + 0).cells ∨ x ∈ (blockTile 0 1).cells) → ((∀ x, x ∈ pBC.unionTile.cells ↔ x ∈ + (blockTile 0 1).cells ∨ x ∈ (blockTile 1 1).cells) → ((∀ x, x ∈ pCA.unionTile.cells ↔ + x ∈ (blockTile 1 1).cells ∨ x ∈ (blockTile 0 0).cells) → ((∀ x, x ∈ + pABC.unionTile.cells ↔ x ∈ (blockTile 0 0).cells ∨ x ∈ (blockTile 0 1).cells ∨ x ∈ + (blockTile 1 1).cells) → ((Disjoint (blockTile 0 0).cells (blockTile 0 1).cells) → + ((Disjoint (blockTile 0 1).cells (blockTile 1 1).cells) → ((Disjoint (blockTile 1 + 1).cells (blockTile 0 0).cells) → (((FootprintEdges (blockTile 0 0) ∩ FootprintEdges + (blockTile 0 1)).Nonempty) → (((FootprintEdges (blockTile 0 1) ∩ FootprintEdges + (blockTile 1 1)).Nonempty) → (((FootprintEdges (blockTile 1 1) ∩ FootprintEdges + (blockTile 0 0)).Nonempty) → ((LatticeTile (blockTile (0 : ℤ) (0 : ℤ))) → + ((LatticeTile (blockTile (0 : ℤ) (1 : ℤ))) → ((LatticeTile (blockTile (1 : ℤ) (1 : + ℤ))) → (Nonempty (ExactTileInterfaceTriple (blockTile 0 0) (blockTile 0 1) (blockTile + 1 1))))))))))))))))))) ) := by + classical + intro q cfg C₀ T cert K blockTile pAB pBC pCA pABC hLAB hLBC hLCA hLABC hUAB hUBC hUCA hUABC + hdisjAB hdisjBC hdisjCA hcommonAB hcommonBC hcommonCA hLA' hLB' hLC' + exact LatticeTileThreeDiskJunction (blockTile 0 0) (blockTile 0 1) (blockTile 1 1) + pAB.unionTile pBC.unionTile pCA.unionTile pABC.unionTile + hLA' hLB' hLC' hLAB hLBC hLCA hLABC + hdisjAB hdisjBC hdisjCA hUAB hUBC hUCA hUABC hcommonAB hcommonBC hcommonCA + +private theorem ha : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (A' : ProtoTile), (Finset.Nonempty A.cells) → (A.cells = ∅ → + A.anchor = A'.anchor) ) := by + classical + intro A A' hAn he + exact False.elim ((Finset.not_nonempty_iff_eq_empty.mpr he) hAn) + +private theorem hb : + (by + classical + exact + ∀ (B : ProtoTile), ∀ (B' : ProtoTile), (Finset.Nonempty B.cells) → (B.cells = ∅ → + B.anchor = B'.anchor) ) := by + classical + intro B B' hBn he + exact False.elim ((Finset.not_nonempty_iff_eq_empty.mpr he) hBn) + +private theorem hc : + (by + classical + exact + ∀ (C : ProtoTile), ∀ (C' : ProtoTile), (Finset.Nonempty C.cells) → (C.cells = ∅ → + C.anchor = C'.anchor) ) := by + classical + intro C C' hCn he + exact False.elim ((Finset.not_nonempty_iff_eq_empty.mpr he) hCn) + +private theorem hzero : + (by + classical + exact + ∀ (T : ProtoTile), (TileTranslation T 0).cells = T.cells ) := by + classical + intro T + rw [(TileTranslationFormulas T 0).1] + have hz : GaussianTranslation (0 : GaussianInt) = id := by + funext x + simp [GaussianTranslation] + rw [hz, Finset.image_id] + +private theorem rootNe : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (m : Int), ∀ (n : Int), (blockTile m n).cells = (TileTranslation T ((m : GaussianInt) + * cert.u + (n : GaussianInt) * cert.v)).cells) → ((LatticeTile (blockTile (0 : ℤ) (0 + : ℤ))) → (((TileTranslation T 0).cells = T.cells) → (T.cells.Nonempty))) ) := by + classical + intro q cfg C₀ T cert K blockTile blockEq hLA' hzero + have hne : (blockTile 0 0).cells.Nonempty := (LatticeTileGridStructure _ hLA').1.1 + rw [blockEq 0 0] at hne + simpa only [Int.cast_zero, zero_mul, zero_add, hzero] using hne + +private theorem blockAne : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (m : Int), ∀ (n : Int), (blockTile m n).cells = (TileTranslation T ((m : GaussianInt) + * cert.u + (n : GaussianInt) * cert.v)).cells) → (((TileTranslation T + 0).cells.Nonempty) → ((blockTile 0 0).cells.Nonempty)) ) := by + classical + intro q cfg C₀ T cert K blockTile blockEq transZeroNe + rw [blockEq 0 0] + simpa only [Int.cast_zero, zero_mul, zero_add] using transZeroNe + +private theorem row2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (m : Int), ∀ (n : Int), (blockTile m n).cells = (TileTranslation T ((m : + GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells) → (∀ [Nonempty + (ExactTileInterfaceTriple (blockTile 0 0) (blockTile 0 1) (blockTile 1 + 1))], ((TileTranslation T 0).cells = T.cells) → (((blockTile 0 0).cells.Nonempty) → + (((blockTile 0 1).cells.Nonempty) → (((blockTile 1 1).cells.Nonempty) → (Nonempty + (ExactTileInterfaceTriple T (TileTranslation T cert.v) (TileTranslation T (cert.u + + cert.v))))))))) := by + classical + intro q cfg C₀ T cert K blockTile blockEq blockJunction hzero blockAne blockBne blockCne + let retargetTriple := retargetNonemptyTriple + obtain ⟨E⟩ := blockJunction + refine ⟨retargetTriple (blockTile 0 0) T (blockTile 0 1) + (TileTranslation T cert.v) (blockTile 1 1) + (TileTranslation T (cert.u + cert.v)) ?_ blockAne ?_ blockBne ?_ blockCne E⟩ + · have hA0 : (blockTile 0 0).cells = (TileTranslation T 0).cells := by + simpa only [Int.cast_zero, zero_mul, zero_add] using blockEq 0 0 + exact hA0.trans hzero + · simpa only [Int.cast_zero, Int.cast_one, zero_mul, one_mul, zero_add] using blockEq 0 1 + · simpa only [Int.cast_one, one_mul] using blockEq 1 1 + +private theorem rowJunction : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + (∀ (ρ : Finset (Int × Int)), ∀ (σ : Finset (Int × Int)), (ρ ∈ ({ {(0, 0), (1, 0), (0, + -1)}, {(0, 0), (0, 1), (1, 1)}, {(0, 0), (-1, -1), (-1, 0)}} : Finset (Finset (Int × + Int)))) → ((σ ⊆ ρ) → ((σ.Nonempty) → (∃ p : FiniteInducedTilePatch + cert.modified.plane cert.modified.tile, p.indices = σ.biUnion (fun mn => K mn.1 mn.2) + ∧ ∀ x, x ∈ p.unionTile.cells ↔ ∃ mn ∈ σ, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile + a).cells)))) → ( + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (m : Int), ∀ (n : Int), ∀ (r : Int), ∀ (s : Int), ((m,n) ≠ (r,s)) → (Disjoint + (blockTile m n).cells (blockTile r s).cells)) → ((∀ (p : FiniteInducedTilePatch + cert.modified.plane cert.modified.tile), ∀ (σ : Finset (Int × Int)), (p.indices = + σ.biUnion (fun mn => K mn.1 mn.2)) → ((∀ x, x ∈ p.unionTile.cells ↔ ∃ mn ∈ σ, ∃ a ∈ K + mn.1 mn.2, x ∈ (cert.modified.tile a).cells) → (∀ x, x ∈ p.unionTile.cells ↔ ∃ mn ∈ + σ, x ∈ (blockTile mn.1 mn.2).cells))) → ((∀ (m : Int), ∀ (n : Int), ∀ (p : + FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (∀ x, x ∈ + p.unionTile.cells ↔ x ∈ (blockTile m n).cells) → ((LatticeTile p.unionTile) → + (LatticeTile (blockTile m n)))) → (∀ (ρ : Finset (Int × Int)), (ρ ∈ ({ + {(0,0),(1,0),(0,-1)}, {(0,0),(0,1),(1,1)}, + {(0,0),(-1,-1),(-1,0)} } : Finset (Finset (Int × Int)))) → (∀ (a : Int × Int), ∀ (b : + Int × Int), ∀ (c : Int × Int), (ρ = {a,b,c}) → (((a.1,a.2) ≠ (b.1,b.2)) → + (((b.1,b.2) ≠ (c.1,c.2)) → (((c.1,c.2) ≠ (a.1,a.2)) → (((FootprintEdges + (blockTile a.1 a.2) ∩ FootprintEdges (blockTile b.1 b.2)).Nonempty) → + (((FootprintEdges (blockTile b.1 b.2) ∩ FootprintEdges (blockTile c.1 + c.2)).Nonempty) → (((FootprintEdges (blockTile c.1 c.2) ∩ FootprintEdges + (blockTile a.1 a.2)).Nonempty) → (Nonempty (ExactTileInterfaceTriple (blockTile + a.1 a.2) (blockTile b.1 b.2) (blockTile c.1 c.2)))))))))))))) ) := by + classical + intro q cfg C₀ T cert K patchForAt blockTile blockDisjoint patchUnion blockLattice ρ hρ a b c + hρeq hneAB hneBC hneCA hab hbc hca + let sa : Finset (Int × Int) := {a} + let sb : Finset (Int × Int) := {b} + let sc : Finset (Int × Int) := {c} + let sab : Finset (Int × Int) := {a,b} + let sbc : Finset (Int × Int) := {b,c} + let sca : Finset (Int × Int) := {c,a} + obtain ⟨pa, hpa, epa⟩ := patchForAt ρ sa hρ (by rw [hρeq]; simp [sa]) (by simp [sa]) + obtain ⟨pb, hpb, epb⟩ := patchForAt ρ sb hρ (by rw [hρeq]; simp [sb]) (by simp [sb]) + obtain ⟨pc, hpc, epc⟩ := patchForAt ρ sc hρ (by rw [hρeq]; simp [sc]) (by simp [sc]) + obtain ⟨pab, hpab, epab⟩ := patchForAt ρ sab hρ (by rw [hρeq]; simp [sab]) (by simp [sab]) + obtain ⟨pbc, hpbc, epbc⟩ := patchForAt ρ sbc hρ (by rw [hρeq]; simp [sbc]) (by simp [sbc]) + obtain ⟨pca, hpca, epca⟩ := patchForAt ρ sca hρ (by + rw [hρeq] + intro z hz + simp only [sca, Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl <;> simp) (by simp [sca]) + obtain ⟨pabc, hpabc, epabc⟩ := patchForAt ρ ρ hρ (by simp) (by simp [hρeq]) + have la := FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) (PeriodicTileIndexedMultiplicityOne cert.modified) + (fun x y _ hadj => cert.modified.adjacent_has_common_edge x y hadj) pa + have lb := FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) (PeriodicTileIndexedMultiplicityOne cert.modified) + (fun x y _ hadj => cert.modified.adjacent_has_common_edge x y hadj) pb + have lc := FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) (PeriodicTileIndexedMultiplicityOne cert.modified) + (fun x y _ hadj => cert.modified.adjacent_has_common_edge x y hadj) pc + have lab := FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) (PeriodicTileIndexedMultiplicityOne cert.modified) + (fun x y _ hadj => cert.modified.adjacent_has_common_edge x y hadj) pab + have lbc := FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) (PeriodicTileIndexedMultiplicityOne cert.modified) + (fun x y _ hadj => cert.modified.adjacent_has_common_edge x y hadj) pbc + have lca := FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) (PeriodicTileIndexedMultiplicityOne cert.modified) + (fun x y _ hadj => cert.modified.adjacent_has_common_edge x y hadj) pca + have labc := FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) (PeriodicTileIndexedMultiplicityOne cert.modified) + (fun x y _ hadj => cert.modified.adjacent_has_common_edge x y hadj) pabc + have ua : ∀ x, x ∈ pa.unionTile.cells ↔ x ∈ (blockTile a.1 a.2).cells := by + intro x; simpa [sa] using patchUnion pa sa hpa epa x + have ub : ∀ x, x ∈ pb.unionTile.cells ↔ x ∈ (blockTile b.1 b.2).cells := by + intro x; simpa [sb] using patchUnion pb sb hpb epb x + have uc : ∀ x, x ∈ pc.unionTile.cells ↔ x ∈ (blockTile c.1 c.2).cells := by + intro x; simpa [sc] using patchUnion pc sc hpc epc x + have uab : ∀ x, x ∈ pab.unionTile.cells ↔ + x ∈ (blockTile a.1 a.2).cells ∨ x ∈ (blockTile b.1 b.2).cells := by + intro x + constructor + · intro hx + obtain ⟨z,hz,hcell⟩ := (patchUnion pab sab hpab epab x).mp hx + simp only [sab, Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl + · exact Or.inl hcell + · exact Or.inr hcell + · rintro (hx | hx) + · exact (patchUnion pab sab hpab epab x).mpr ⟨a, by simp [sab], hx⟩ + · exact (patchUnion pab sab hpab epab x).mpr ⟨b, by simp [sab], hx⟩ + have ubc : ∀ x, x ∈ pbc.unionTile.cells ↔ + x ∈ (blockTile b.1 b.2).cells ∨ x ∈ (blockTile c.1 c.2).cells := by + intro x + constructor + · intro hx + obtain ⟨z,hz,hcell⟩ := (patchUnion pbc sbc hpbc epbc x).mp hx + simp only [sbc, Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl + · exact Or.inl hcell + · exact Or.inr hcell + · rintro (hx | hx) + · exact (patchUnion pbc sbc hpbc epbc x).mpr ⟨b, by simp [sbc], hx⟩ + · exact (patchUnion pbc sbc hpbc epbc x).mpr ⟨c, by simp [sbc], hx⟩ + have uca : ∀ x, x ∈ pca.unionTile.cells ↔ + x ∈ (blockTile c.1 c.2).cells ∨ x ∈ (blockTile a.1 a.2).cells := by + intro x + constructor + · intro hx + obtain ⟨z,hz,hcell⟩ := (patchUnion pca sca hpca epca x).mp hx + simp only [sca, Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl + · exact Or.inl hcell + · exact Or.inr hcell + · rintro (hx | hx) + · exact (patchUnion pca sca hpca epca x).mpr ⟨c, by simp [sca], hx⟩ + · exact (patchUnion pca sca hpca epca x).mpr ⟨a, by simp [sca], hx⟩ + have uabc : ∀ x, x ∈ pabc.unionTile.cells ↔ + x ∈ (blockTile a.1 a.2).cells ∨ x ∈ (blockTile b.1 b.2).cells ∨ + x ∈ (blockTile c.1 c.2).cells := by + intro x + constructor + · intro hx + obtain ⟨z,hz,hcell⟩ := (patchUnion pabc ρ hpabc epabc x).mp hx + rw [hρeq] at hz + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl | rfl + · exact Or.inl hcell + · exact Or.inr (Or.inl hcell) + · exact Or.inr (Or.inr hcell) + · rintro (hx | hx | hx) + · exact (patchUnion pabc ρ hpabc epabc x).mpr ⟨a, by simp [hρeq], hx⟩ + · exact (patchUnion pabc ρ hpabc epabc x).mpr ⟨b, by simp [hρeq], hx⟩ + · exact (patchUnion pabc ρ hpabc epabc x).mpr ⟨c, by simp [hρeq], hx⟩ + have dab := blockDisjoint a.1 a.2 b.1 b.2 hneAB + have dbc := blockDisjoint b.1 b.2 c.1 c.2 hneBC + have dca := blockDisjoint c.1 c.2 a.1 a.2 hneCA + exact LatticeTileThreeDiskJunction _ _ _ pab.unionTile pbc.unionTile pca.unionTile pabc.unionTile + (blockLattice _ _ pa ua la) (blockLattice _ _ pb ub lb) (blockLattice _ _ pc uc lc) + lab lbc lca labc dab dbc dca uab ubc uca uabc hab hbc hca + +private theorem blockEdge : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (m : Int), ∀ (n : Int), ∀ + (r : Int), ∀ (s : Int), (a ∈ K m n) → ((b ∈ K r s) → ((cert.modified.plane.adjacent a + b) → ((FootprintEdges (blockTile m n) ∩ FootprintEdges (blockTile r s)).Nonempty))) ) + := by + classical + intro q cfg C₀ T cert K blockTile a b m n r s ha hb hadj + rcases cert.modified.adjacent_has_common_edge a b hadj with ⟨e, hea, heb⟩ + rcases hea with ⟨x, hx, hedgeA⟩ + rcases heb with ⟨y, hy, hedgeB⟩ + refine ⟨e, ?_, ?_⟩ + · exact ⟨x, Finset.mem_biUnion.mpr ⟨a, ha, hx⟩, hedgeA⟩ + · exact ⟨y, Finset.mem_biUnion.mpr ⟨b, hb, hy⟩, hedgeB⟩ + +private theorem row1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (ρ : Finset (Int × Int)), (ρ ∈ ({ {(0,0),(1,0),(0,-1)}, {(0,0),(0,1),(1,1)}, + {(0,0),(-1,-1),(-1,0)} } : Finset (Finset (Int × Int)))) → (∀ (a : Int × Int), ∀ (b : + Int × Int), ∀ (c : Int × Int), (ρ = {a,b,c}) → (((a.1,a.2) ≠ (b.1,b.2)) → (((b.1,b.2) + ≠ (c.1,c.2)) → (((c.1,c.2) ≠ (a.1,a.2)) → (((FootprintEdges (blockTile a.1 a.2) ∩ + FootprintEdges (blockTile b.1 b.2)).Nonempty) → (((FootprintEdges (blockTile b.1 b.2) + ∩ FootprintEdges (blockTile c.1 c.2)).Nonempty) → (((FootprintEdges (blockTile c.1 + c.2) ∩ FootprintEdges (blockTile a.1 a.2)).Nonempty) → (Nonempty + (ExactTileInterfaceTriple (blockTile a.1 a.2) (blockTile b.1 b.2) (blockTile c.1 + c.2))))))))))) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (m : + Int), ∀ (n : Int), ∀ (r : Int), ∀ (s : Int), (a ∈ K m n) → ((b ∈ K r s) → + ((cert.modified.plane.adjacent a b) → ((FootprintEdges (blockTile m n) ∩ + FootprintEdges (blockTile r s)).Nonempty)))) → ( + Nonempty (ExactTileInterfaceTriple (blockTile 0 0) (blockTile 1 0) (blockTile 0 (-1))))) + ) := by + classical + intro q cfg C₀ T cert K blockTile rowJunction blockEdge + let τ1 : Finset (Int × Int) := {(0,0),(1,0),(0,-1)} + apply rowJunction τ1 (by simp [τ1]) (0,0) (1,0) (0,-1) (by ext; simp [τ1]) + (by decide) (by decide) (by decide) ?_ ?_ ?_ + · exact blockEdge ⟨.D,0,0⟩ ⟨.F,1,0⟩ 0 0 1 0 (by simp [K]) (by simp [K]) + ((cert.modified_adjacency _ _).2 (AllowedSubtileIncidence.DF10 0 0)) + · exact blockEdge ⟨.B,1,0⟩ ⟨.D,0,-1⟩ 1 0 0 (-1) (by simp [K]) (by simp [K]) + ((cert.modified_adjacency _ _).2 (AllowedSubtileIncidence.BDm1m1 1 0)) + · exact blockEdge ⟨.F,0,-1⟩ ⟨.B,0,0⟩ 0 (-1) 0 0 (by simp [K]) (by simp [K]) + ((cert.modified_adjacency _ _).2 (AllowedSubtileIncidence.BF0m1 0 0).symm) + +private theorem row3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (ρ : Finset (Int × Int)), (ρ ∈ ({ {(0,0),(1,0),(0,-1)}, {(0,0),(0,1),(1,1)}, + {(0,0),(-1,-1),(-1,0)} } : Finset (Finset (Int × Int)))) → (∀ (a : Int × Int), ∀ (b : + Int × Int), ∀ (c : Int × Int), (ρ = {a,b,c}) → (((a.1,a.2) ≠ (b.1,b.2)) → (((b.1,b.2) + ≠ (c.1,c.2)) → (((c.1,c.2) ≠ (a.1,a.2)) → (((FootprintEdges (blockTile a.1 a.2) ∩ + FootprintEdges (blockTile b.1 b.2)).Nonempty) → (((FootprintEdges (blockTile b.1 b.2) + ∩ FootprintEdges (blockTile c.1 c.2)).Nonempty) → (((FootprintEdges (blockTile c.1 + c.2) ∩ FootprintEdges (blockTile a.1 a.2)).Nonempty) → (Nonempty + (ExactTileInterfaceTriple (blockTile a.1 a.2) (blockTile b.1 b.2) (blockTile c.1 + c.2))))))))))) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (m : + Int), ∀ (n : Int), ∀ (r : Int), ∀ (s : Int), (a ∈ K m n) → ((b ∈ K r s) → + ((cert.modified.plane.adjacent a b) → ((FootprintEdges (blockTile m n) ∩ + FootprintEdges (blockTile r s)).Nonempty)))) → ( + Nonempty (ExactTileInterfaceTriple (blockTile 0 0) (blockTile (-1) (-1)) (blockTile (-1) + 0)))) ) := by + classical + intro q cfg C₀ T cert K blockTile rowJunction blockEdge + let τ3 : Finset (Int × Int) := {(0,0),(-1,-1),(-1,0)} + apply rowJunction τ3 (by simp [τ3]) (0,0) (-1,-1) (-1,0) (by ext; simp [τ3]) + (by decide) (by decide) (by decide) ?_ ?_ ?_ + · exact blockEdge ⟨.B,0,0⟩ ⟨.D,-1,-1⟩ 0 0 (-1) (-1) (by simp [K]) (by simp [K]) + ((cert.modified_adjacency _ _).2 (AllowedSubtileIncidence.BDm1m1 0 0)) + · exact blockEdge ⟨.A,-1,-1⟩ ⟨.E,-1,0⟩ (-1) (-1) (-1) 0 (by simp [K]) (by simp [K]) + ((cert.modified_adjacency _ _).2 (AllowedSubtileIncidence.AE01 (-1) (-1))) + · exact blockEdge ⟨.D,-1,0⟩ ⟨.F,0,0⟩ (-1) 0 0 0 (by simp [K]) (by simp [K]) + ((cert.modified_adjacency _ _).2 (AllowedSubtileIncidence.DF10 (-1) 0)) + +private theorem blockNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (m : Int), ∀ (n : Int), (blockTile m n).cells = (TileTranslation T ((m : GaussianInt) + * cert.u + (n : GaussianInt) * cert.v)).cells) → ((T.cells.Nonempty) → (∀ (m : Int), + ∀ (n : Int), (blockTile m n).cells.Nonempty)) ) := by + classical + intro q cfg C₀ T cert K blockTile blockEq rootNe m n + rw [blockEq m n] + apply Finset.nonempty_iff_ne_empty.mpr + intro hempty + exact (Finset.nonempty_iff_ne_empty.mp rootNe) + ((TileTranslationFormulas T + ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).2.2.1.mp hempty) + +private theorem block00T : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (m : Int), ∀ (n : Int), (blockTile m n).cells = (TileTranslation T ((m : GaussianInt) + * cert.u + (n : GaussianInt) * cert.v)).cells) → (((TileTranslation T 0).cells = + T.cells) → ((blockTile 0 0).cells = T.cells)) ) := by + classical + intro q cfg C₀ T cert K blockTile blockEq hzero + have hA0 : (blockTile 0 0).cells = (TileTranslation T 0).cells := by + simpa only [Int.cast_zero, zero_mul, zero_add] using blockEq 0 0 + exact hA0.trans hzero + +private theorem htransNegV : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (m : Int), ∀ (n : Int), (blockTile m n).cells = (TileTranslation T ((m : GaussianInt) + * cert.u + (n : GaussianInt) * cert.v)).cells) → ((blockTile 0 (-1)).cells = + (TileTranslation T (-cert.v)).cells) ) := by + classical + intro q cfg C₀ T cert K blockTile blockEq + simpa only [Int.cast_zero, Int.cast_neg, Int.cast_one, zero_mul, neg_one_mul, + zero_add] using blockEq 0 (-1) + +private theorem htransNegUV : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (m : Int), ∀ (n : Int), (blockTile m n).cells = (TileTranslation T ((m : GaussianInt) + * cert.u + (n : GaussianInt) * cert.v)).cells) → ((blockTile (-1) (-1)).cells = + (TileTranslation T (-cert.u - cert.v)).cells) ) := by + classical + intro q cfg C₀ T cert K blockTile blockEq + simpa only [Int.cast_neg, Int.cast_one, neg_one_mul, sub_eq_add_neg] using + blockEq (-1) (-1) + +private theorem htransNegU : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + (∀ (m : Int), ∀ (n : Int), (blockTile m n).cells = (TileTranslation T ((m : GaussianInt) + * cert.u + (n : GaussianInt) * cert.v)).cells) → ((blockTile (-1) 0).cells = + (TileTranslation T (-cert.u)).cells) ) := by + classical + intro q cfg C₀ T cert K blockTile blockEq + simpa only [Int.cast_neg, Int.cast_one, neg_one_mul, Int.cast_zero, zero_mul, + add_zero] using blockEq (-1) 0 + +private theorem row1T : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + ∀ [Nonempty (ExactTileInterfaceTriple (blockTile 0 0) (blockTile 1 0) (blockTile 0 + (-1)))], (∀ (m : Int), ∀ (n : Int), (blockTile m n).cells.Nonempty) → (((blockTile 0 + 0).cells = T.cells) → (((blockTile 1 0).cells = (TileTranslation T cert.u).cells) → + (((blockTile 0 (-1)).cells = (TileTranslation T (-cert.v)).cells) → (Nonempty + (ExactTileInterfaceTriple T (TileTranslation T cert.u) (TileTranslation T + (-cert.v))))))) ) := by + classical + intro q cfg C₀ T cert K blockTile row1 blockNonempty block00T htransU htransNegV + let retargetTriple := retargetNonemptyTriple + obtain ⟨E⟩ := row1 + exact ⟨retargetTriple (blockTile 0 0) T (blockTile 1 0) (TileTranslation T cert.u) + (blockTile 0 (-1)) (TileTranslation T (-cert.v)) + block00T (blockNonempty 0 0) htransU (blockNonempty 1 0) + htransNegV (blockNonempty 0 (-1)) E⟩ + +private theorem row3T : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + ∀ [Nonempty (ExactTileInterfaceTriple (blockTile 0 0) (blockTile (-1) (-1)) + (blockTile (-1) 0))], (∀ (m : Int), ∀ (n : Int), (blockTile m n).cells.Nonempty) → + (((blockTile 0 0).cells = T.cells) → (((blockTile (-1) (-1)).cells = (TileTranslation + T (-cert.u - cert.v)).cells) → (((blockTile (-1) 0).cells = (TileTranslation T + (-cert.u)).cells) → (Nonempty (ExactTileInterfaceTriple T (TileTranslation T (-cert.u + - cert.v)) (TileTranslation T (-cert.u))))))) ) := by + classical + intro q cfg C₀ T cert K blockTile row3 blockNonempty block00T htransNegUV htransNegU + let retargetTriple := retargetNonemptyTriple + obtain ⟨E⟩ := row3 + exact ⟨retargetTriple (blockTile 0 0) T (blockTile (-1) (-1)) + (TileTranslation T (-cert.u - cert.v)) (blockTile (-1) 0) + (TileTranslation T (-cert.u)) block00T (blockNonempty 0 0) + htransNegUV (blockNonempty (-1) (-1)) htransNegU (blockNonempty (-1) 0) E⟩ + +private theorem hturn1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (z : GaussianInt), GaussianQuarterTurn z = (⟨0,1⟩ : GaussianInt) * z) → ((∀ + (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q j.succ) = (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 + (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ)))) → (GaussianQuarterTurn (BandVectors.1 + (q 1) (q 0)) = cert.u)) ) := by + classical + intro q cfg C₀ T cert hmul hflip + rw [hmul, cert.period_u] + simpa using (hflip 0).1.symm + +private theorem hturn2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (z : GaussianInt), GaussianQuarterTurn z = (⟨0,1⟩ : GaussianInt) * z) → ((∀ + (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q j.succ) = (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 + (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ)))) → (GaussianQuarterTurn (BandVectors.1 + (q 2) (q 0)) = cert.v)) ) := by + classical + intro q cfg C₀ T cert hmul hflip + rw [hmul, cert.period_v] + simpa using (hflip 1).1.symm + +private theorem hsum : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (BandVectors.1 + (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) ) := by + classical + intro q cfg + simpa [Fin.sum_univ_succ, add_assoc] using (IncomingSuperbasisRelation q cfg.proper).1 + +private theorem hthird : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + + BandVectors.1 (q 3) (q 0) = 0) → (BandVectors.1 (q 3) (q 0) = -BandVectors.1 (q 1) + (q 0) - BandVectors.1 (q 2) (q 0)) ) := by + classical + intro q hsum + linear_combination hsum + +private theorem qneg3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (z : GaussianInt), GaussianQuarterTurn z = (⟨0,1⟩ : GaussianInt) * z) → + ((GaussianQuarterTurn (BandVectors.1 (q 3) (q 0)) = -cert.u - cert.v) → + (GaussianQuarterTurn (-BandVectors.1 (q 3) (q 0)) = cert.u + cert.v)) ) := by + classical + intro q cfg C₀ T cert hmul hturn3 + rw [hmul, mul_neg, ← hmul, hturn3] + simp [add_comm] + +private theorem qfour : + (by + classical + exact + ∀ (z : GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn z))) = z ) := by + classical + intro z + ext <;> simp [GaussianQuarterTurn] + +private theorem turnThree : + (by + classical + exact + ∀ (T : ProtoTile), (QuarterTurnSymmetric T) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), + (ExactTileInterfaceTriple T (TileTranslation T a) (TileTranslation T b)) → (Nonempty + (ExactTileInterfaceTriple T (TileTranslation T (GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn a)))) (TileTranslation T + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn b))))))) ) := by + classical + intro T hsym a b E + obtain ⟨g, hg, E1, hp1, ha1, hb1, hc1⟩ := + QuarterTurnSymmetricExactInterfaceTransport T a b E hsym + obtain ⟨g, hg, E2, hp2, ha2, hb2, hc2⟩ := + QuarterTurnSymmetricExactInterfaceTransport T (GaussianQuarterTurn a) + (GaussianQuarterTurn b) E1 hsym + obtain ⟨g, hg, E3, hp3, ha3, hb3, hc3⟩ := + QuarterTurnSymmetricExactInterfaceTransport T + (GaussianQuarterTurn (GaussianQuarterTurn a)) + (GaussianQuarterTurn (GaussianQuarterTurn b)) E2 hsym + exact ⟨E3⟩ + +private theorem hback1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (GaussianQuarterTurn (BandVectors.1 (q 1) (q 0)) = cert.u) → + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn cert.u)) = + BandVectors.1 (q 1) (q 0)) ) := by + classical + intro q cfg C₀ T cert hturn1 + rw [← hturn1] + simp [GaussianQuarterTurn] + +private theorem hback2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (GaussianQuarterTurn (BandVectors.1 (q 2) (q 0)) = cert.v) → + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn cert.v)) = + BandVectors.1 (q 2) (q 0)) ) := by + classical + intro q cfg C₀ T cert hturn2 + rw [← hturn2] + simp [GaussianQuarterTurn] + +private theorem hback3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (GaussianQuarterTurn (BandVectors.1 (q 3) (q 0)) = -cert.u - cert.v) → + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (-cert.u-cert.v))) = + BandVectors.1 (q 3) (q 0)) ) := by + classical + intro q cfg C₀ T cert hturn3 + rw [← hturn3] + simp [GaussianQuarterTurn] + +private theorem hbackNeg1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (GaussianQuarterTurn (-BandVectors.1 (q 1) (q 0)) = -cert.u) → ((∀ (z : + GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn z))) = z) → (GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn (-cert.u))) = -BandVectors.1 (q 1) (q 0))) ) := by + classical + intro q cfg C₀ T cert qneg1 qfour + rw [← qneg1] + exact qfour _ + +private theorem hbackNeg2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (GaussianQuarterTurn (-BandVectors.1 (q 2) (q 0)) = -cert.v) → ((∀ (z : + GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn z))) = z) → (GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn (-cert.v))) = -BandVectors.1 (q 2) (q 0))) ) := by + classical + intro q cfg C₀ T cert qneg2 qfour + rw [← qneg2] + exact qfour _ + +private theorem hbackNeg3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (GaussianQuarterTurn (-BandVectors.1 (q 3) (q 0)) = cert.u + cert.v) → ((∀ (z + : GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn z))) = z) → (GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn (cert.u+cert.v))) = -BandVectors.1 (q 3) (q 0))) ) := by + classical + intro q cfg C₀ T cert qneg3 qfour + rw [← qneg3] + exact qfour _ + +end ChildInterfaceGeometry + +theorem BandOrderedGeneralChildInterfaces + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) + (hsym : QuarterTurnSymmetric T) : + (∀ i : Fin 3, Nonempty (ExactTileInterfaceTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) + (TileTranslation T (-BandVectors.1 (q ((i + 1).succ)) (q 0))))) ∧ + (∀ (i : Fin 3) (U : ProtoTile), BandPrototile (q i.succ) U → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + Nonempty (ExactTileInterfaceTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U)) ∧ + (∀ (i : Fin 3) (U V : ProtoTile), BandPrototile (q i.succ) U → + BandPrototile (q ((i + 1).succ)) V → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ)))) → + Nonempty (ExactTileInterfaceTriple T U V)) ∧ + (∀ (i : Fin 3) (s : Fin 4) (U V : ProtoTile), + BandPrototile (q i.succ) U → + BandPrototile + (q ((if Even s.val then i + 1 else i - 1).succ)) V → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (q ((i + 1).succ)) (q 0) - + BandVectors.1 (q 0) (q ((i + 1).succ)) + else + BandVectors.1 (q 0) (q ((i - 1).succ)) - + BandVectors.1 (q ((i - 1).succ)) (q 0))) → + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) + let uL := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q i.succ) (q 0) + else BandVectors.1 (q 0) (q i.succ)) + ∃ rightData : ExactTileInterfaceTriple T (TileTranslation T uR) U, + ∃ incomingData : ExactTileInterfaceTriple T (TileTranslation T uL) U, + ∃ t5Data : ExactTileInterfaceTriple T U V, + rightData.point = t5Data.point ∧ + incomingData.point ≠ t5Data.point ∧ + incomingData.otherCA = t5Data.point ∧ + rightData.otherCA = incomingData.point ∧ + t5Data.otherAB = incomingData.point) := by +-- BODY + classical + have mixed := BandOrderedGeneralMixedAggregatePatches q cfg C₀ T cert hsym + have first_parent := ChildInterfaceGeometry.first_parent q T mixed + have parent_pair := ChildInterfaceGeometry.parent_pair q T mixed + let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ + {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, + ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} + let τ : Finset (Int × Int) := {(0, 0), (0, 1), (1, 1)} + let aggregate := BandOrderedGeneralAggregatePatches q cfg C₀ T cert + have aggregate' := aggregate + dsimp only at aggregate' + have patchFor (σ : Finset (Int × Int)) (hσ : σ ⊆ τ) + (hne : σ.Nonempty) : + ∃ p : FiniteInducedTilePatch cert.modified.plane cert.modified.tile, + p.indices = σ.biUnion (fun mn => K mn.1 mn.2) ∧ + ∀ x, x ∈ p.unionTile.cells ↔ + ∃ mn ∈ σ, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile a).cells := + ChildInterfaceGeometry.patchFor q cfg C₀ T cert aggregate' + (ChildInterfaceGeometry.τmem) σ hσ hne + have patchForAt := ChildInterfaceGeometry.patchForAt q cfg C₀ T cert aggregate' + let blockTile (m n : Int) : ProtoTile := + ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + have blockEq (m n : Int) : (blockTile m n).cells = + (TileTranslation T ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v)).cells := ChildInterfaceGeometry.blockEq q cfg C₀ T cert m n + have blockDisjoint := ChildInterfaceGeometry.blockDisjoint q cfg C₀ T cert blockEq + have patchUnion := ChildInterfaceGeometry.patchUnion q cfg C₀ T cert + let σA : Finset (Int × Int) := {(0,0)} + let σB : Finset (Int × Int) := {(0,1)} + let σC : Finset (Int × Int) := {(1,1)} + let σAB : Finset (Int × Int) := {(0,0),(0,1)} + let σBC : Finset (Int × Int) := {(0,1),(1,1)} + let σCA : Finset (Int × Int) := {(1,1),(0,0)} + obtain ⟨pA, hpA, hexA⟩ := patchFor σA (by decide) (by simp [σA]) + obtain ⟨pB, hpB, hexB⟩ := patchFor σB (by decide) (by simp [σB]) + obtain ⟨pC, hpC, hexC⟩ := patchFor σC (by decide) (by simp [σC]) + obtain ⟨pAB, hpAB, hexAB⟩ := patchFor σAB (by decide) (by simp [σAB]) + obtain ⟨pBC, hpBC, hexBC⟩ := patchFor σBC (by decide) (by simp [σBC]) + obtain ⟨pCA, hpCA, hexCA⟩ := patchFor σCA (by decide) (by simp [σCA]) + obtain ⟨pABC, hpABC, hexABC⟩ := patchFor τ (by decide) (by simp [τ]) + have hLA := FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) + (PeriodicTileIndexedMultiplicityOne cert.modified) + (fun a b hne hadj => cert.modified.adjacent_has_common_edge a b hadj) pA + have hLB := FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) + (PeriodicTileIndexedMultiplicityOne cert.modified) + (fun a b hne hadj => cert.modified.adjacent_has_common_edge a b hadj) pB + have hLC := FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) + (PeriodicTileIndexedMultiplicityOne cert.modified) + (fun a b hne hadj => cert.modified.adjacent_has_common_edge a b hadj) pC + have hLAB := FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) + (PeriodicTileIndexedMultiplicityOne cert.modified) + (fun a b hne hadj => cert.modified.adjacent_has_common_edge a b hadj) pAB + have hLBC := FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) + (PeriodicTileIndexedMultiplicityOne cert.modified) + (fun a b hne hadj => cert.modified.adjacent_has_common_edge a b hadj) pBC + have hLCA := FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) + (PeriodicTileIndexedMultiplicityOne cert.modified) + (fun a b hne hadj => cert.modified.adjacent_has_common_edge a b hadj) pCA + have hLABC := FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) + (PeriodicTileIndexedMultiplicityOne cert.modified) + (fun a b hne hadj => cert.modified.adjacent_has_common_edge a b hadj) pABC + have hdisjAB : Disjoint (blockTile 0 0).cells (blockTile 0 1).cells := + blockDisjoint 0 0 0 1 (by decide) + have hdisjBC : Disjoint (blockTile 0 1).cells (blockTile 1 1).cells := + blockDisjoint 0 1 1 1 (by decide) + have hdisjCA : Disjoint (blockTile 1 1).cells (blockTile 0 0).cells := + blockDisjoint 1 1 0 0 (by decide) + have blockLattice := ChildInterfaceGeometry.blockLattice q cfg C₀ T cert + have hLA' := blockLattice 0 0 pA (ChildInterfaceGeometry.hUA q cfg C₀ T cert patchUnion pA hpA + hexA) hLA + have hLB' := blockLattice 0 1 pB (ChildInterfaceGeometry.hUB q cfg C₀ T cert patchUnion pB hpB + hexB) hLB + have hLC' := blockLattice 1 1 pC (ChildInterfaceGeometry.hUC q cfg C₀ T cert patchUnion pC hpC + hexC) hLC + have blockJunction := ChildInterfaceGeometry.blockJunction q + cfg C₀ T cert pAB pBC pCA pABC hLAB hLBC hLCA hLABC (ChildInterfaceGeometry.hUAB q cfg + C₀ T cert patchUnion pAB hpAB hexAB) (ChildInterfaceGeometry.hUBC q cfg C₀ T cert + patchUnion pBC hpBC hexBC) (ChildInterfaceGeometry.hUCA q cfg C₀ T cert patchUnion + pCA hpCA hexCA) (ChildInterfaceGeometry.hUABC q cfg C₀ T cert patchUnion pABC hpABC + hexABC) hdisjAB + hdisjBC hdisjCA (ChildInterfaceGeometry.hcommonAB q cfg C₀ T cert) + (ChildInterfaceGeometry.hcommonBC q cfg C₀ T cert) + (ChildInterfaceGeometry.hcommonCA q cfg C₀ T cert) hLA' hLB' hLC' + let retargetTriple := retargetNonemptyTriple + have hzero : (TileTranslation T 0).cells = T.cells := ChildInterfaceGeometry.hzero T + have rootNe : T.cells.Nonempty := ChildInterfaceGeometry.rootNe q cfg C₀ T cert blockEq hLA' hzero + have transZeroNe : (TileTranslation T 0).cells.Nonempty := by + simpa [hzero] using rootNe + have blockBne : (blockTile 0 1).cells.Nonempty := + (LatticeTileGridStructure _ hLB').1.1 + have blockCne : (blockTile 1 1).cells.Nonempty := + (LatticeTileGridStructure _ hLC').1.1 + have row2 := @ChildInterfaceGeometry.row2 q cfg C₀ T cert blockEq blockJunction + hzero (ChildInterfaceGeometry.blockAne q cfg C₀ T cert blockEq transZeroNe) blockBne + blockCne + have rowJunction := ChildInterfaceGeometry.rowJunction q cfg C₀ T cert patchForAt blockDisjoint + patchUnion blockLattice + have blockEdge := ChildInterfaceGeometry.blockEdge q cfg C₀ T cert + let τ1 : Finset (Int × Int) := {(0,0),(1,0),(0,-1)} + let τ3 : Finset (Int × Int) := {(0,0),(-1,-1),(-1,0)} + have row1 := ChildInterfaceGeometry.row1 q cfg C₀ T cert + rowJunction blockEdge + have row3 := ChildInterfaceGeometry.row3 q cfg C₀ T cert + rowJunction blockEdge + have blockNonempty := ChildInterfaceGeometry.blockNonempty q cfg C₀ T cert blockEq rootNe + have block00T := ChildInterfaceGeometry.block00T q cfg C₀ T + cert blockEq hzero + have htransU : (blockTile 1 0).cells = (TileTranslation T cert.u).cells := by + simpa only [Int.cast_one, Int.cast_zero, one_mul, zero_mul, add_zero] using blockEq 1 0 + have row1T := @ChildInterfaceGeometry.row1T q + cfg C₀ T cert row1 blockNonempty block00T htransU + (ChildInterfaceGeometry.htransNegV q cfg C₀ T cert blockEq) + have row3T := @ChildInterfaceGeometry.row3T q cfg C₀ T cert row3 blockNonempty block00T + (ChildInterfaceGeometry.htransNegUV q cfg C₀ T cert blockEq) + (ChildInterfaceGeometry.htransNegU q cfg C₀ T cert blockEq) + have hmul (z : GaussianInt) : GaussianQuarterTurn z = (⟨0,1⟩ : GaussianInt) * z := by + ext <;> simp [GaussianQuarterTurn] + have hflip := (VectorRecursionLaws q cfg.proper.1).2.2.2.2 cfg.proper + have hturn1 : GaussianQuarterTurn (BandVectors.1 (q 1) (q 0)) = cert.u := + ChildInterfaceGeometry.hturn1 q cfg C₀ T cert hmul hflip + have hturn2 : GaussianQuarterTurn (BandVectors.1 (q 2) (q 0)) = cert.v := + ChildInterfaceGeometry.hturn2 q cfg C₀ T cert hmul hflip + have hthird : BandVectors.1 (q 3) (q 0) = + -BandVectors.1 (q 1) (q 0) - BandVectors.1 (q 2) (q 0) := ChildInterfaceGeometry.hthird q + (ChildInterfaceGeometry.hsum q cfg) + have hturn3 : GaussianQuarterTurn (BandVectors.1 (q 3) (q 0)) = -cert.u - cert.v := by + rw [hthird, hmul, mul_sub, mul_neg, ← hmul, ← hmul, hturn1, hturn2] + have qneg1 : GaussianQuarterTurn (-BandVectors.1 (q 1) (q 0)) = -cert.u := by + rw [hmul, mul_neg, ← hmul, hturn1] + have qneg2 : GaussianQuarterTurn (-BandVectors.1 (q 2) (q 0)) = -cert.v := by + rw [hmul, mul_neg, ← hmul, hturn2] + have qfour := ChildInterfaceGeometry.qfour + have turnThree := ChildInterfaceGeometry.turnThree T hsym + have hback1 : GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn cert.u)) = BandVectors.1 (q 1) (q 0) := ChildInterfaceGeometry.hback1 + q cfg C₀ T cert hturn1 + have hback2 : GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn cert.v)) = BandVectors.1 (q 2) (q 0) := ChildInterfaceGeometry.hback2 + q cfg C₀ T cert hturn2 + have hback3 : GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn (-cert.u-cert.v))) = BandVectors.1 (q 3) (q 0) := + ChildInterfaceGeometry.hback3 q cfg C₀ T cert hturn3 + have hbackNeg1 : GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn (-cert.u))) = -BandVectors.1 (q 1) (q 0) := + ChildInterfaceGeometry.hbackNeg1 q cfg C₀ T cert qneg1 qfour + have hbackNeg2 : GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn (-cert.v))) = -BandVectors.1 (q 2) (q 0) := + ChildInterfaceGeometry.hbackNeg2 q cfg C₀ T cert qneg2 qfour + have hbackNeg3 : GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn (cert.u+cert.v))) = -BandVectors.1 (q 3) (q 0) := + ChildInterfaceGeometry.hbackNeg3 q cfg C₀ T cert (ChildInterfaceGeometry.qneg3 q cfg C₀ + T cert hmul hturn3) qfour + refine ⟨?_, ?_, ?_, ?_⟩ + · intro i + fin_cases i + · obtain ⟨E⟩ := row1T + obtain ⟨E⟩ := turnThree cert.u (-cert.v) E + exact ⟨by simpa [Fin.add_def] using (show ExactTileInterfaceTriple T + (TileTranslation T (BandVectors.1 (q 1) (q 0))) + (TileTranslation T (-BandVectors.1 (q 2) (q 0))) from by + simpa only [hback1, hbackNeg2] using E)⟩ + · obtain ⟨E⟩ := row2 + obtain ⟨E⟩ := turnThree cert.v (cert.u + cert.v) E + exact ⟨by simpa [Fin.add_def] using (show ExactTileInterfaceTriple T + (TileTranslation T (BandVectors.1 (q 2) (q 0))) + (TileTranslation T (-BandVectors.1 (q 3) (q 0))) from by + simpa only [hback2, hbackNeg3] using E)⟩ + · obtain ⟨E⟩ := row3T + obtain ⟨E⟩ := turnThree (-cert.u-cert.v) (-cert.u) E + exact ⟨by simpa [Fin.add_def] using (show ExactTileInterfaceTriple T + (TileTranslation T (BandVectors.1 (q 3) (q 0))) + (TileTranslation T (-BandVectors.1 (q 1) (q 0))) from by + simpa only [hback3, hbackNeg1] using E)⟩ + · intro i U hU hc + exact first_parent i U hU hc + · intro i U V hU hV hcU hcV + exact parent_pair i U V hU hV hcU hcV + · intro i s U V hU hV hcU hcV + exact mixed.2.2 i s U V hU hV hcU hcV + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralConfiguration.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralConfiguration.lean new file mode 100644 index 0000000000..8c2ee28a92 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralConfiguration.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple + +-- [TABLET NODE: BandOrderedGeneralConfiguration] + +/-! +# BandOrderedGeneralConfiguration + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +An *ordered general configuration* for an ordered coordinate +quadruple $q=(C_0,C_1,C_2,C_3)$ consists of the following data and facts. +The quadruple is proper; none of its four entries is a line; and at most one +entry has curvature one. Its curvatures satisfy +$$ + c_0>4,\qquad c_1>c_2\geq4,\qquad c_2\geq c_3. +$$ +There are proper predecessor quadruples +$$ + r=(C_1,C_4,C_2,C_3),\qquad t=(C_2,C_3,C_5,C_6), +$$ +where the full coordinate of the Soddy twin is +$$ + C_4=2(C_1+C_2+C_3)-C_0. +$$ +Both predecessor children have curvature strictly less than $c_0$, and +the signed and nonnegative curvature identities +$$ + 2c_1+2c_2+2c_3=c_0+c_4 +$$ +hold (the latter is expressed after taking nonnegative integer +curvatures). Finally, the canonical vector identities obtained from the +displayed coordinate identifications are recorded explicitly: +$$ + v(r_2,r_0)=v(C_2,C_1),\quad + v(r_3,r_0)=v(C_3,C_1),\quad + v(t_1,t_0)=v(C_3,C_2). +$$ +The entries $C_5,C_6$ are part of the second predecessor data. +-/ +structure BandOrderedGeneralConfiguration + (q : Fin 4 → CircleCoordinates) where +-- BODY + proper : ProperBandQuadruple q + noLine : ∀ i, (q i).1 ≠ 0 + atMostOneUnit : ∀ i j, (q i).1 = 1 → (q j).1 = 1 → i = j + childLarge : 4 < (q 0).1 + order12 : (q 2).1 < (q 1).1 + secondLarge : 4 ≤ (q 2).1 + order23 : (q 3).1 ≤ (q 2).1 + /-- The predecessor presentation containing the first two parent circles. -/ + firstPredecessor : Fin 4 → CircleCoordinates + /-- The second predecessor presentation used by the remaining parent pair. -/ + secondPredecessor : Fin 4 → CircleCoordinates + firstProper : ProperBandQuadruple firstPredecessor + secondProper : ProperBandQuadruple secondPredecessor + firstChild : firstPredecessor 0 = q 1 + firstTwin : firstPredecessor 1 = + (2 * (q 1).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 0).1, + 2 * (q 1).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 0).2) + firstParentTwo : firstPredecessor 2 = q 2 + firstParentThree : firstPredecessor 3 = q 3 + secondChild : secondPredecessor 0 = q 2 + secondParentOne : secondPredecessor 1 = q 3 + firstSmaller : (firstPredecessor 0).1 < (q 0).1 + secondSmaller : (secondPredecessor 0).1 < (q 0).1 + soddy : + 2 * (q 1).1 + 2 * (q 2).1 + 2 * (q 3).1 = + (q 0).1 + (firstPredecessor 1).1 + soddyNat : + 2 * Int.toNat (q 1).1 + 2 * Int.toNat (q 2).1 + + 2 * Int.toNat (q 3).1 = + Int.toNat (q 0).1 + Int.toNat (firstPredecessor 1).1 + firstVectorTwo : + BandVectors.1 (firstPredecessor 2) (firstPredecessor 0) = + BandVectors.1 (q 2) (q 1) + firstVectorThree : + BandVectors.1 (firstPredecessor 3) (firstPredecessor 0) = + BandVectors.1 (q 3) (q 1) + secondVectorOne : + BandVectors.1 (secondPredecessor 1) (secondPredecessor 0) = + BandVectors.1 (q 3) (q 2) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralFinitePatches.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralFinitePatches.lean new file mode 100644 index 0000000000..e9f472ccca --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralFinitePatches.lean @@ -0,0 +1,216 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.ConsecutivePatchInterface +public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.P4623T1ZeroBlockPaths +public import LeanPool.ApollonianSuperharmonic.P4623T1ZeroBlockExterior +public import LeanPool.ApollonianSuperharmonic.P4623T1ZeroBlockLinks +public import Mathlib.Data.List.Chain + +-- [TABLET NODE: BandOrderedGeneralFinitePatches] + +/-! +# BandOrderedGeneralFinitePatches + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralFinitePatches + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + ∃ whole : FiniteInducedTilePatch + cert.modified.plane cert.modified.tile, + whole.indices = + ({⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, + ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} : + Finset PeriodicSubtileIndex) ∧ + whole.unionTile = T ∧ + cert.modified.tile ⟨.A, 0, 0⟩ = + TileCellComplement (cert.P 0 true) cert.O ∧ + ∀ d ∈ whole.indices, + ∃ rest : FiniteInducedTilePatch + cert.modified.plane cert.modified.tile, + rest.indices = whole.indices.erase d ∧ + rest.unionTile = TileCellComplement T (cert.modified.tile d) ∧ + Nonempty (ConsecutivePatchInterface + cert.modified.plane cert.modified.tile rest d) := by +-- BODY + classical + let K : Finset PeriodicSubtileIndex := + {⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, + ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} + have zero (l : SixSubtileLabel) : cert.modified.tile ⟨l, 0, 0⟩ = + match l with + | .A => TileCellComplement (cert.P 0 true) cert.O + | .B => cert.P 0 false + | .C => cert.P 1 true + | .D => cert.P 1 false + | .E => cert.P 2 true + | .F => cert.P 2 false := by + rw [cert.modified_tile] + have ht : GaussianTranslation 0 = id := by + funext z + simp [GaussianTranslation] + simp [ModifiedSubtileOccurrenceInterpretation, TileTranslation, + ht, GaussianTranslation] + cases l <;> rfl + have unique (x : LatticeCell) (a b : PeriodicSubtileIndex) + (ha : x ∈ (cert.modified.tile a).cells) + (hb : x ∈ (cert.modified.tile b).cells) : a = b := by + obtain ⟨o, _, ho⟩ := cert.partition x + have ha' : x ∈ (ModifiedSubtileOccurrenceInterpretation + cert.P cert.O cert.u cert.v a).cells := by + simpa only [cert.modified_tile a] using ha + have hb' : x ∈ (ModifiedSubtileOccurrenceInterpretation + cert.P cert.O cert.u cert.v b).cells := by + simpa only [cert.modified_tile b] using hb + exact (ho a ha').trans (ho b hb').symm + have injective : Function.Injective cert.modified.tile := by + intro a b hab + obtain ⟨homeo⟩ := cert.modified.tiles_are_disks a + have hp := (homeo ⟨0, by simp⟩).property + change (homeo ⟨0, by simp⟩ : Real × Real) ∈ + TileRealization (cert.modified.tile a) at hp + simp only [TileRealization, Set.mem_iUnion] at hp + obtain ⟨x, hxa, _⟩ := hp + exact unique x a b hxa (by rw [← hab]; exact hxa) + have precursor_in_minus (x : LatticeCell) (hx : x ∈ cert.O.cells) : + x ∈ (cert.P 0 false).cells := by + apply (cert.minus_union x).mpr + exact ⟨0, true, by simpa only [← cert.precursor_cells] using hx⟩ + have whole_union (x : LatticeCell) : x ∈ T.cells ↔ + ∃ a ∈ K, x ∈ (cert.modified.tile a).cells := by + constructor + · intro hx + obtain ⟨i, s, hx⟩ := (cert.outer_union x).mp hx + fin_cases i <;> cases s + · exact ⟨⟨.B, 0, 0⟩, by decide, by simpa [zero] using hx⟩ + · by_cases hO : x ∈ cert.O.cells + · exact ⟨⟨.B, 0, 0⟩, by decide, by + simpa [zero] using precursor_in_minus x hO⟩ + · exact ⟨⟨.A, 0, 0⟩, by decide, by + simpa [zero, TileCellComplement, Finset.mem_sdiff] using + And.intro hx hO⟩ + · exact ⟨⟨.D, 0, 0⟩, by decide, by simpa [zero] using hx⟩ + · exact ⟨⟨.C, 0, 0⟩, by decide, by simpa [zero] using hx⟩ + · exact ⟨⟨.F, 0, 0⟩, by decide, by simpa [zero] using hx⟩ + · exact ⟨⟨.E, 0, 0⟩, by decide, by simpa [zero] using hx⟩ + · rintro ⟨a, ha, hx⟩ + simp only [K, Finset.mem_insert, Finset.mem_singleton] at ha + rcases ha with rfl | rfl | rfl | rfl | rfl | rfl + · apply (cert.outer_union x).mpr + exact ⟨0, true, (Finset.mem_sdiff.mp (by + simpa only [zero, TileCellComplement] using hx)).1⟩ + · exact (cert.outer_union x).mpr ⟨0, false, by simpa [zero] using hx⟩ + · exact (cert.outer_union x).mpr ⟨1, true, by simpa [zero] using hx⟩ + · exact (cert.outer_union x).mpr ⟨1, false, by simpa [zero] using hx⟩ + · exact (cert.outer_union x).mpr ⟨2, true, by simpa [zero] using hx⟩ + · exact (cert.outer_union x).mpr ⟨2, false, by simpa [zero] using hx⟩ + have rest_union (d : PeriodicSubtileIndex) (x : LatticeCell) : + x ∈ (TileCellComplement T (cert.modified.tile d)).cells ↔ + ∃ a ∈ K.erase d, x ∈ (cert.modified.tile a).cells := by + change x ∈ T.cells \ (cert.modified.tile d).cells ↔ _ + rw [Finset.mem_sdiff] + constructor + · rintro ⟨hxT, hxd⟩ + obtain ⟨a, ha, hxa⟩ := (whole_union x).mp hxT + refine ⟨a, Finset.mem_erase.mpr ⟨?_, ha⟩, hxa⟩ + intro had + exact hxd (had ▸ hxa) + · rintro ⟨a, ha, hxa⟩ + refine ⟨(whole_union x).mpr ⟨a, Finset.mem_of_mem_erase ha, hxa⟩, ?_⟩ + intro hxd + exact (Finset.mem_erase.mp ha).1 (unique x a d hxa hxd) + have walk (S : PeriodicSubtileIndex → Prop) (a b : PeriodicSubtileIndex) + (ha : S a) + (h : Relation.ReflTransGen + (fun x y ↦ AllowedSubtileIncidence x y ∧ S x ∧ S y) a b) : + ∃ p : List PeriodicSubtileIndex, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ x ∈ p, S x) ∧ + ∀ x y : PeriodicSubtileIndex, ∀ l₁ l₂ : List PeriodicSubtileIndex, + p = l₁ ++ x :: y :: l₂ → cert.modified.plane.adjacent x y := by + obtain ⟨l, hc, hl⟩ := List.exists_isChain_cons_of_relationReflTransGen h + refine ⟨a :: l, rfl, ?_, ?_, ?_⟩ + · simpa only [List.getLast?_eq_some_getLast (List.cons_ne_nil a l)] + using congrArg some hl + · have go : ∀ (u : PeriodicSubtileIndex) (p : List PeriodicSubtileIndex), S u → + (u :: p).IsChain (fun x y ↦ AllowedSubtileIncidence x y ∧ S x ∧ S y) → + ∀ x ∈ u :: p, S x := by + intro u p + induction p generalizing u with + | nil => simp_all + | cons v p ih => + intro hu hc x hx + simp only [List.mem_cons] at hx + rcases hx with hx | hx + · exact hx.symm ▸ hu + · exact ih v hc.rel.2.2 hc.tail x (by simpa only [List.mem_cons] using hx) + exact go a l ha hc + · intro x y l₁ l₂ he + exact (cert.modified_adjacency x y).mpr + (List.isChain_iff_forall_rel_of_append_cons_cons.mp hc he).1 + let makePatch (S : Finset PeriodicSubtileIndex) (U : ProtoTile) + (hS : S = K ∨ ∃ d ∈ K, S = K.erase d) (hne : S.Nonempty) + (hU : ∀ x, x ∈ U.cells ↔ ∃ a ∈ S, x ∈ (cert.modified.tile a).cells) : + FiniteInducedTilePatch cert.modified.plane cert.modified.tile := { + indices := S + unionTile := U + nonempty := hne + tile_injective := injective.injOn + exact_union := hU + induced_connected := by + intro a ha b hb + exact walk (fun x ↦ x ∈ S) a b ha + (P4623T1ZeroBlockPaths S hS a ha b hb) + complement_connected := by + intro a ha b hb + exact walk (fun x ↦ x ∉ S) a b ha + (P4623T1ZeroBlockExterior S hS a ha b hb) + } + let whole := makePatch K T (Or.inl rfl) (by decide) whole_union + refine ⟨whole, rfl, rfl, zero .A, ?_⟩ + intro d hd + change d ∈ K at hd + have hne : (K.erase d).Nonempty := by + simp only [K, Finset.mem_insert, Finset.mem_singleton] at hd + rcases hd with rfl | rfl | rfl | rfl | rfl | rfl <;> decide + let rest := makePatch (K.erase d) (TileCellComplement T (cert.modified.tile d)) + (Or.inr ⟨d, hd, rfl⟩) hne (rest_union d) + obtain ⟨n, N, F, hn, hN, hF, hneighbors, hfaces⟩ := P4623T1ZeroBlockLinks d hd + refine ⟨rest, rfl, rfl, ⟨{ + exterior := by change d ∉ K.erase d; exact Finset.notMem_erase d K + length := n + positive := hn + neighbor := N + face := cert.modified_face_equiv.symm ∘ F + neighbor_injective := hN + face_injective := cert.modified_face_equiv.symm.injective.comp hF + neighbors_exact := ?_ + consecutive_faces := ?_ + }⟩⟩ + · intro b + change b ∈ K.erase d ∧ cert.modified.plane.adjacent d b ↔ ∃ k, N k = b + rw [cert.modified_adjacency] + exact hneighbors b + · intro k + simpa only [Function.comp_apply, cert.modified_face_vertices, + Equiv.apply_symm_apply] using hfaces k + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean new file mode 100644 index 0000000000..1ce34ddd8e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean @@ -0,0 +1,1294 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidenceZeroOppositeChord +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices +public import LeanPool.ApollonianSuperharmonic.ExactPatchBoundaryInterface +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch +public import LeanPool.ApollonianSuperharmonic.FinitePatchTopology +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileDiskUnionInterface +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex +public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileAdjacentContactRegularity +public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandOrderedGeneralGeometricSectors] + +/-! +# BandOrderedGeneralGeometricSectors + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace GeometricSectorGeometry + +private theorem hdisjoint : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + (∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells) → (∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → (Disjoint (P.tile + a).cells (P.tile b).cells)) ) := by + classical + intro q cfg C₀ T cert P hindexed a b hab + apply Finset.disjoint_left.mpr + intro x hxa hxb + exact hab ((hindexed x).unique hxa hxb) + +private theorem raw_incident : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ FootprintVertices U) → + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells)) ) := by + classical + intro U x hne hx + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hx + rcases hx with ⟨c, hc, h | h | h | h⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using h ▸ hc⟩ + · refine ⟨1, ?_⟩ + subst x + convert hc using 1; simp [LatticeVertexIncidentCell] + · refine ⟨3, ?_⟩ + subst x + convert hc using 1; simp [LatticeVertexIncidentCell] + · refine ⟨2, ?_⟩ + change x - 1 - ⟨0, 1⟩ ∈ U.cells + rw [h] + convert hc using 1 + ext <;> simp + +private theorem radial : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + ∀ (x : GaussianInt), ∀ (owner : Fin 4 → PeriodicSubtileIndex), (∀ j, + LatticeVertexIncidentCell x j ∈ (P.tile (owner j)).cells) → (∀ (j : Fin 4), x ∈ + edgeAt x j ∧ edgeAt x j ∈ FootprintEdges (P.tile (owner j)) ∩ FootprintEdges (P.tile + (owner (j + 1)))) ) := by + classical + intro q cfg C₀ T cert P edgeAt x owner howner j + refine ⟨?_, ?_, ?_⟩ + · fin_cases j <;> simp [edgeAt] + · refine ⟨LatticeVertexIncidentCell x j, howner j, ?_⟩ + fin_cases j <;> simp [LatticeVertexIncidentCell, edgeAt, + sub_eq_add_neg, add_comm, add_left_comm, add_assoc, Finset.pair_comm] + · refine ⟨LatticeVertexIncidentCell x (j + 1), howner (j + 1), ?_⟩ + fin_cases j <;> simp [LatticeVertexIncidentCell, edgeAt, + sub_eq_add_neg, add_comm, add_left_comm, add_assoc, Finset.pair_comm] + +private theorem radialMembers : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (x : GaussianInt), ∀ (owner : Fin 4 → PeriodicSubtileIndex), (∀ j, + LatticeVertexIncidentCell x j ∈ (P.tile (owner j)).cells) → (∀ (j : Fin 4), x ∈ + edgeAt x j ∧ edgeAt x j ∈ FootprintEdges (P.tile (owner j)) ∩ FootprintEdges (P.tile + (owner (j + 1))))) → (∀ (x : GaussianInt), ∀ (owner : Fin 4 → PeriodicSubtileIndex), + (∀ j, LatticeVertexIncidentCell x j ∈ (P.tile (owner j)).cells) → (∀ (j : Fin 4), + edgeAt x j ∈ FootprintEdges (P.tile (owner j)) ∧ edgeAt x j ∈ FootprintEdges (P.tile + (owner (j + 1))))) ) := by + classical + intro q cfg C₀ T cert P edgeAt radial x owner howner j + simpa only [Set.mem_inter_iff] using (radial x owner howner j).2 + +private theorem hzero : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (whole : FiniteInducedTilePatch P.plane P.tile), (whole.indices = + ({⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, + ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} : + Finset PeriodicSubtileIndex)) → (∀ (a : PeriodicSubtileIndex), (a ∈ whole.indices) + → (a.first = 0 ∧ a.second = 0)) ) := by + classical + intro q cfg C₀ T cert P whole hidx a ha + rw [hidx] at ha + simp only [Finset.mem_insert, Finset.mem_singleton] at ha + rcases ha with rfl | rfl | rfl | rfl | rfl | rfl <;> simp + +private theorem hnoedge : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → ((¬P.plane.adjacent + a b) → (¬ (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty)) ) := by + classical + intro q cfg C₀ T cert P a b hab hadj hne + exact hadj (((PeriodicTileIntersectionClassification P).1 a b hab).1.1 hne) + +private theorem hcommonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (¬ (FootprintEdges (P.tile a) + ∩ FootprintEdges (P.tile b)).Nonempty) → (CommonFootprintEdgeVertices (P.tile a) + (P.tile b) = ∅) ) := by + classical + intro q cfg C₀ T cert P a b hnoedge + ext x + simp only [CommonFootprintEdgeVertices, Set.mem_ofPred_eq, + Set.mem_empty_iff_false, iff_false] + intro hx + obtain ⟨e, he, hx⟩ := hx + exact hnoedge ⟨e, he⟩ + +private theorem hjk : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), ∀ + (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → (∀ (x : + GaussianInt), ∀ (j : Fin (4 : ℕ)), ∀ (k : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (owner j = a) → ((owner k = b) → (j ≠ k))) ) := by + classical + intro q cfg C₀ T cert P hindexed a b hab x j k owner hja' hkb' h + exact hab (hja'.symm.trans (h ▸ hkb')) + +private theorem hnotconsecutive : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (x : GaussianInt), ∀ (owner : Fin 4 → PeriodicSubtileIndex), (∀ j, + LatticeVertexIncidentCell x j ∈ (P.tile (owner j)).cells) → (∀ (j : Fin 4), x ∈ + edgeAt x j ∧ edgeAt x j ∈ FootprintEdges (P.tile (owner j)) ∩ FootprintEdges (P.tile + (owner (j + 1))))) → (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (¬ + (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty) → (∀ (x : + GaussianInt), ∀ (j : Fin (4 : ℕ)), ∀ (k : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (∀ (r : Fin 4), LatticeVertexIncidentCell x r ∈ (P.tile (owner r)).cells) → ((owner j = + a) → ((owner k = b) → (¬ (k = j + 1 ∨ j = k + 1)))))) ) := by + classical + intro q cfg C₀ T cert P hindexed edgeAt radial a b hnoedge x j k owner ho hja' hkb' h + rcases h with h | h + · have he := radial x owner ho j + have hown : owner (j + 1) = b := by rw [← h]; exact hkb' + apply hnoedge + exact ⟨edgeAt x j, by + rcases he.2 with ⟨h1, h2⟩ + exact ⟨by simpa [hja'] using h1, + by simpa [hown] using h2⟩⟩ + · have he := radial x owner ho k + have hown : owner (k + 1) = a := by rw [← h]; exact hja' + apply hnoedge + exact ⟨edgeAt x k, by + rcases he.2 with ⟨h1, h2⟩ + exact ⟨by simpa [hown] using h2, + by simpa [hkb'] using h1⟩⟩ + +private theorem hpos : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), ∀ + (a : PeriodicSubtileIndex), ∀ (x : GaussianInt), ∀ (j : Fin (4 : ℕ)), + (LatticeVertexIncidentCell x j ∈ (P.tile a).cells) → (∀ (k : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (owner j = a) → ((j ≠ k) → ((¬ (k = j + 1 ∨ j = k + 1)) → ((k = j + 2) → ( + let l := j + 1 + let m := j + 3 + j ≠ l ∧ j ≠ k ∧ j ≠ m ∧ l ≠ k ∧ l ≠ m ∧ k ≠ m))))) ) := by + classical + intro q cfg C₀ T cert P hindexed a x j hja k owner hja' hjk hnotconsecutive hop l m + rw [hop] + fin_cases j <;> decide + +private theorem hlk : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), ∀ + (a : PeriodicSubtileIndex), ∀ (x : GaussianInt), ∀ (j : Fin (4 : ℕ)), + (LatticeVertexIncidentCell x j ∈ (P.tile a).cells) → (∀ (k : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (owner j = a) → ((j ≠ k) → ((¬ (k = j + 1 ∨ j = k + 1)) → ((k = j + 2) → ( + let l := j + 1 + let m := j + 3 + (j ≠ l ∧ j ≠ k ∧ j ≠ m ∧ l ≠ k ∧ l ≠ m ∧ k ≠ m) → (l + 1 = k)))))) ) := by + classical + intro q cfg C₀ T cert P hindexed a x j hja k owner hja' hjk hnotconsecutive hop l m hpos + rw [hop] + fin_cases j <;> decide + +private theorem hkm : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), ∀ + (a : PeriodicSubtileIndex), ∀ (x : GaussianInt), ∀ (j : Fin (4 : ℕ)), + (LatticeVertexIncidentCell x j ∈ (P.tile a).cells) → (∀ (k : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (owner j = a) → ((j ≠ k) → ((¬ (k = j + 1 ∨ j = k + 1)) → ((k = j + 2) → ( + let l := j + 1 + let m := j + 3 + (j ≠ l ∧ j ≠ k ∧ j ≠ m ∧ l ≠ k ∧ l ≠ m ∧ k ≠ m) → ((l + 1 = k) → (k + 1 = m))))))) ) := by + classical + intro q cfg C₀ T cert P hindexed a x j hja k owner hja' hjk hnotconsecutive hop l m hpos hlk + rw [hop] + fin_cases j <;> decide + +private theorem hlA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (x : GaussianInt), ∀ (owner : Fin 4 → PeriodicSubtileIndex), (∀ j, + LatticeVertexIncidentCell x j ∈ (P.tile (owner j)).cells) → (∀ (j : Fin 4), edgeAt x + j ∈ FootprintEdges (P.tile (owner j)) ∧ edgeAt x j ∈ FootprintEdges (P.tile (owner (j + + 1))))) → (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (¬ + (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty) → (∀ (x : + GaussianInt), ∀ (j : Fin (4 : ℕ)), ∀ (k : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (∀ (r : Fin 4), LatticeVertexIncidentCell x r ∈ (P.tile (owner r)).cells) → ((owner k = + b) → ( + let l := j + 1 + (l + 1 = k) → (owner l ≠ a))))) ) := by + classical + intro q cfg C₀ T cert P hindexed edgeAt radialMembers a b hnoedge x j k owner ho hkb' l hlk heq + have hoK : owner (l + 1) = b := by rw [hlk]; exact hkb' + have he := radialMembers x owner ho l + apply hnoedge + refine ⟨edgeAt x l, ?_⟩ + exact ⟨by simpa [heq] using he.1, + by simpa [heq, hoK] using he.2⟩ + +private theorem hlB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (x : GaussianInt), ∀ (owner : Fin 4 → PeriodicSubtileIndex), (∀ j, + LatticeVertexIncidentCell x j ∈ (P.tile (owner j)).cells) → (∀ (j : Fin 4), edgeAt x + j ∈ FootprintEdges (P.tile (owner j)) ∧ edgeAt x j ∈ FootprintEdges (P.tile (owner (j + + 1))))) → (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (¬ + (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty) → (∀ (x : + GaussianInt), ∀ (j : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (∀ (r : Fin 4), LatticeVertexIncidentCell x r ∈ (P.tile (owner r)).cells) → ((owner j = + a) → ( + let l := j + 1 + owner l ≠ b)))) ) := by + classical + intro q cfg C₀ T cert P hindexed edgeAt radialMembers a b hnoedge x j owner ho hja' l heq + have hoJ : owner j = a := hja' + have hoL : owner (j + 1) = b := by simpa [l] using heq + have he := radialMembers x owner ho j + apply hnoedge + refine ⟨edgeAt x j, ?_⟩ + exact ⟨by simpa [hoJ] using he.1, + by simpa [hoL] using he.2⟩ + +private theorem hmA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (x : GaussianInt), ∀ (owner : Fin 4 → PeriodicSubtileIndex), (∀ j, + LatticeVertexIncidentCell x j ∈ (P.tile (owner j)).cells) → (∀ (j : Fin 4), edgeAt x + j ∈ FootprintEdges (P.tile (owner j)) ∧ edgeAt x j ∈ FootprintEdges (P.tile (owner (j + + 1))))) → (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (¬ + (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty) → (∀ (x : + GaussianInt), ∀ (j : Fin (4 : ℕ)), ∀ (k : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (∀ (r : Fin 4), LatticeVertexIncidentCell x r ∈ (P.tile (owner r)).cells) → ((owner k = + b) → ( + let m := j + 3 + (k + 1 = m) → (owner m ≠ a))))) ) := by + classical + intro q cfg C₀ T cert P hindexed edgeAt radialMembers a b hnoedge x j k owner ho hkb' m hkm heq + have hoM : owner (k + 1) = a := by rw [hkm]; exact heq + have he := radialMembers x owner ho k + apply hnoedge + refine ⟨edgeAt x k, ?_⟩ + exact ⟨by simpa [hoM] using he.2, + by simpa [hkb'] using he.1⟩ + +private theorem hmB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (x : GaussianInt), ∀ (owner : Fin 4 → PeriodicSubtileIndex), (∀ j, + LatticeVertexIncidentCell x j ∈ (P.tile (owner j)).cells) → (∀ (j : Fin 4), edgeAt x + j ∈ FootprintEdges (P.tile (owner j)) ∧ edgeAt x j ∈ FootprintEdges (P.tile (owner (j + + 1))))) → (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (¬ + (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty) → (∀ (x : + GaussianInt), ∀ (j : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (∀ (r : Fin 4), LatticeVertexIncidentCell x r ∈ (P.tile (owner r)).cells) → ((owner j = + a) → ( + let m := j + 3 + (m + 1 = j) → (owner m ≠ b))))) ) := by + classical + intro q cfg C₀ T cert P hindexed edgeAt radialMembers a b hnoedge x j owner ho hja' m hmj heq + have hoJ : owner (m + 1) = a := by rw [hmj]; exact hja' + have he := radialMembers x owner ho m + apply hnoedge + refine ⟨edgeAt x m, ?_⟩ + exact ⟨by simpa [hoJ] using he.2, + by simpa [heq] using he.1⟩ + +private theorem hlm : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), (∀ + (a : PeriodicSubtileIndex), LatticeTile (P.tile a)) → (∀ (a : PeriodicSubtileIndex), + ∀ (b : PeriodicSubtileIndex), ∀ (x : GaussianInt), ∀ (j : Fin (4 : ℕ)), + (LatticeVertexIncidentCell x j ∈ (P.tile a).cells) → (∀ (k : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (∀ (r : Fin 4), LatticeVertexIncidentCell x r ∈ (P.tile (owner r)).cells) → ((owner j = + a) → ((owner k = b) → ((j ≠ k) → ((¬ (k = j + 1 ∨ j = k + 1)) → ((k = j + 2) → ( + let l := j + 1 + let m := j + 3 + (j ≠ l ∧ j ≠ k ∧ j ≠ m ∧ l ≠ k ∧ l ≠ m ∧ k ≠ m) → ((l + 1 = k) → ((k + 1 = m) → ((m + 1 = + j) → ((owner l ≠ a) → ((owner l ≠ b) → ((owner m ≠ a) → ((owner m ≠ b) → (owner l ≠ + owner m)))))))))))))))) ) := by + classical + intro q cfg C₀ T cert P hindexed htiles a b x j hja k owner ho hja' hkb' hjk hnotconsecutive + hop l m hpos hlk hkm hmj hlA hlB hmA hmB heq + have hcheck := (LatticeTileGridStructure _ (htiles (owner l))).2.1 x + have hnJ : LatticeVertexIncidentCell x j ∉ (P.tile (owner l)).cells := by + intro hmem + exact hlA ((hindexed _).unique hmem (by simpa [hja'] using ho j)) + have hnK : LatticeVertexIncidentCell x k ∉ (P.tile (owner l)).cells := by + intro hmem + exact hlB ((hindexed _).unique hmem (by simpa [hkb'] using ho k)) + have hcellM : LatticeVertexIncidentCell x m ∈ (P.tile (owner l)).cells := by + simpa [heq] using ho m + have hcellL : LatticeVertexIncidentCell x l ∈ (P.tile (owner l)).cells := ho l + rw [hop] at hnK + fin_cases j + · apply hcheck + right + exact ⟨by simpa [l, LatticeVertexIncidentCell] using hcellL, + by simpa [m, LatticeVertexIncidentCell] using hcellM, + by simpa [LatticeVertexIncidentCell] using hnJ, + by simpa [LatticeVertexIncidentCell] using hnK⟩ + · apply hcheck + left + exact ⟨by simpa [m, LatticeVertexIncidentCell] using hcellM, + by simpa [l, LatticeVertexIncidentCell] using hcellL, + by simpa [LatticeVertexIncidentCell] using hnJ, + by simpa [LatticeVertexIncidentCell] using hnK⟩ + · apply hcheck + right + exact ⟨by simpa [m, LatticeVertexIncidentCell] using hcellM, + by simpa [l, LatticeVertexIncidentCell] using hcellL, + by simpa [LatticeVertexIncidentCell] using hnK, + by simpa [LatticeVertexIncidentCell] using hnJ⟩ + · apply hcheck + left + exact ⟨by simpa [l, LatticeVertexIncidentCell] using hcellL, + by simpa [m, LatticeVertexIncidentCell] using hcellM, + by simpa [LatticeVertexIncidentCell] using hnK, + by simpa [LatticeVertexIncidentCell] using hnJ⟩ + +private theorem hjlO : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), ∀ + (a : PeriodicSubtileIndex), ∀ (x : GaussianInt), ∀ (j : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (owner j = a) → ( + let l := j + 1 + (owner l ≠ a) → (owner j ≠ owner l)) ) := by + classical + intro q cfg C₀ T cert P hindexed a x j owner hja' l hlA heq + exact hlA (heq.symm.trans hja') + +private theorem hjkO : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), ∀ + (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → (∀ (x : + GaussianInt), ∀ (j : Fin (4 : ℕ)), ∀ (k : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (owner j = a) → ((owner k = b) → (owner j ≠ owner k))) ) := by + classical + intro q cfg C₀ T cert P hindexed a b hab x j k owner hja' hkb' heq + exact hab (hja'.symm.trans (heq.trans hkb')) + +private theorem hjmO : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), ∀ + (a : PeriodicSubtileIndex), ∀ (x : GaussianInt), ∀ (j : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (owner j = a) → ( + let m := j + 3 + (owner m ≠ a) → (owner j ≠ owner m)) ) := by + classical + intro q cfg C₀ T cert P hindexed a x j owner hja' m hmA heq + exact hmA (heq.symm.trans hja') + +private theorem hlkO : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), ∀ + (b : PeriodicSubtileIndex), ∀ (x : GaussianInt), ∀ (j : Fin (4 : ℕ)), ∀ (k : Fin (4 : + ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (owner k = b) → ( + let l := j + 1 + (owner l ≠ b) → (owner l ≠ owner k)) ) := by + classical + intro q cfg C₀ T cert P hindexed b x j k owner hkb' l hlB heq + exact hlB (heq.trans hkb') + +private theorem hkmO : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), ∀ + (b : PeriodicSubtileIndex), ∀ (x : GaussianInt), ∀ (j : Fin (4 : ℕ)), ∀ (k : Fin (4 : + ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (owner k = b) → ( + let m := j + 3 + (owner m ≠ b) → (owner k ≠ owner m)) ) := by + classical + intro q cfg C₀ T cert P hindexed b x j k owner hkb' m hmB heq + exact hmB (heq.symm.trans hkb') + +private theorem hinj : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), ∀ + (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (x : GaussianInt), ∀ (j : + Fin (4 : ℕ)), (LatticeVertexIncidentCell x j ∈ (P.tile a).cells) → (∀ (k : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (owner j = a) → ((j ≠ k) → ((¬ (k = j + 1 ∨ j = k + 1)) → ((k = j + 2) → ( + let l := j + 1 + let m := j + 3 + (j ≠ l ∧ j ≠ k ∧ j ≠ m ∧ l ≠ k ∧ l ≠ m ∧ k ≠ m) → ((l + 1 = k) → ((k + 1 = m) → ((m + 1 = + j) → ((owner l ≠ a) → ((owner l ≠ b) → ((owner m ≠ a) → ((owner m ≠ b) → ((owner l ≠ + owner m) → ((owner j ≠ owner l) → ((owner j ≠ owner k) → ((owner j ≠ owner m) → + ((owner l ≠ owner k) → ((owner k ≠ owner m) → (Function.Injective + owner))))))))))))))))))) ) := by + classical + intro q cfg C₀ T cert P hindexed a b x j hja k owner hja' hjk hnotconsecutive hop l m hpos hlk + hkm hmj hlA hlB hmA hmB hlm hjlO hjkO hjmO hlkO hkmO r s hrs + have positions (t : Fin 4) : t = j ∨ t = l ∨ t = k ∨ t = m := by + rw [hop] + fin_cases j <;> fin_cases t <;> simp [l, m] + rcases positions r with hr | hr | hr | hr <;> + rcases positions s with hs | hs | hs | hs + all_goals subst r; subst s + all_goals first + | rfl + | exact (hjlO hrs).elim + | exact (hjlO hrs.symm).elim + | exact (hjkO hrs).elim + | exact (hjkO hrs.symm).elim + | exact (hjmO hrs).elim + | exact (hjmO hrs.symm).elim + | exact (hlkO hrs).elim + | exact (hlkO hrs.symm).elim + | exact (hlm hrs).elim + | exact (hlm hrs.symm).elim + | exact (hkmO hrs).elim + | exact (hkmO hrs.symm).elim + +private theorem edgeAdjacent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (u : PeriodicSubtileIndex), ∀ (v : PeriodicSubtileIndex), (u ≠ v) → (((FootprintEdges + (P.tile u) ∩ + FootprintEdges (P.tile v)).Nonempty) → (AllowedSubtileIncidence u v)) ) := by + classical + intro q cfg C₀ T cert P u v huv hedge + have hclassification := (PeriodicTileIntersectionClassification P).1 u v huv + have hadj := hclassification.1.1 hedge + exact cert.modified_adjacency u v |>.mp hadj + +private theorem rawCell : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), (∀ + (a : PeriodicSubtileIndex), LatticeTile (P.tile a)) → (∀ (x : GaussianInt), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + (∀ (r : Fin 4), LatticeVertexIncidentCell x r ∈ (P.tile (owner r)).cells) → (∀ (r : Fin + 4), x ∈ FootprintVertices (P.tile (owner r)))) ) := by + classical + intro q cfg C₀ T cert P hindexed htiles x owner ho r + have hneSet := (LatticeTileGridStructure _ (htiles (owner r))).1.1 + obtain ⟨c, hc⟩ := hneSet + have hne : (P.tile (owner r)).cells.Nonempty := ⟨c, hc⟩ + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] + refine ⟨LatticeVertexIncidentCell x r, ho r, ?_⟩ + fin_cases r <;> simp [LatticeVertexIncidentCell, + sub_eq_add_neg, add_comm, add_left_comm, add_assoc, + Zsqrtd.ext_iff] + +private theorem hxEdges : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), + (PeriodicTileAdjacentContactRegularity P) → (∀ (x : GaussianInt), ∀ (j : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + let l := j + 1 + let m := j + 3 + (cert.modified.plane.adjacent (owner l) (owner m)) → ((x ∈ FootprintVertices (P.tile + (owner l)) ∩ FootprintVertices (P.tile (owner m))) → (x ∈ CommonFootprintEdgeVertices + (P.tile (owner l)) (P.tile (owner m))))) ) := by + classical + intro q cfg C₀ T cert P hindexed hregular x j owner l m hadjBD hxRaw + rw [← hregular.adjacent_raw_eq_edge_vertices _ _ hadjBD] + exact hxRaw + +private theorem hnotseq (j r : Fin 4) : + ¬ ((r = j + 1 ∧ r + 1 = j + 3) ∨ (r = j + 3 ∧ r + 1 = j + 1)) := by + fin_cases j <;> fin_cases r <;> decide +kernel + +private theorem hdnot : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (whole : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), ∀ + (d : PeriodicSubtileIndex), ∀ (rest : FiniteInducedTilePatch cert.modified.plane + cert.modified.tile), (rest.indices = whole.indices.erase d) → (d ∉ rest.indices) ) := by + classical + intro q cfg C₀ T cert whole d rest hrestIdx + rw [hrestIdx] + simp + +private theorem hdisj : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + (∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells) → (∀ (d : + PeriodicSubtileIndex), ∀ (rest : FiniteInducedTilePatch cert.modified.plane + cert.modified.tile), (d ∉ rest.indices) → (Disjoint (rest.unionTile).cells (P.tile + d).cells)) ) := by + classical + intro q cfg C₀ T cert P hindexed d rest hdnot + apply Finset.disjoint_left.mpr + intro x hxU hxd + obtain ⟨a, ha, hxa⟩ := (rest.exact_union x).1 hxU + have had : a = d := (hindexed x).unique hxa hxd + exact hdnot (had ▸ ha) + +private theorem hunion : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (whole : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), + (whole.unionTile = T) → (∀ (d : PeriodicSubtileIndex), (d ∈ whole.indices) → (∀ (rest + : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (rest.unionTile = + TileCellComplement T (cert.modified.tile d)) → (∀ z : LatticeCell, z ∈ + whole.unionTile.cells ↔ z ∈ (P.tile d).cells ∨ z ∈ rest.unionTile.cells))) ) := by + classical + intro q cfg C₀ T cert P whole hwhole d hd rest hrestUnion + have hwholeCells : whole.unionTile.cells = T.cells := + congrArg ProtoTile.cells hwhole + have hrestCells : rest.unionTile.cells = + T.cells \ (P.tile d).cells := by + rw [hrestUnion] + rfl + intro z + constructor + · intro hz + have hzT : z ∈ T.cells := hwholeCells ▸ hz + by_cases hzd : z ∈ (P.tile d).cells + · exact Or.inl hzd + · right + rw [hrestCells] + exact Finset.mem_sdiff.mpr ⟨hzT, hzd⟩ + · rintro (hzd | hzr) + · rw [hwholeCells] + exact hwholeCells ▸ (whole.exact_union z).2 ⟨d, hd, hzd⟩ + · have hzT : z ∈ T.cells := by + rw [hrestCells] at hzr + exact (Finset.mem_sdiff.mp hzr).1 + exact hwholeCells.symm ▸ hzT + +private theorem hdn : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + (∀ (whole : FiniteInducedTilePatch P.plane P.tile), (whole.indices = ({⟨.A, 0, 0⟩, ⟨.B, + 0, 0⟩, ⟨.C, 0, 0⟩, ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} : Finset + PeriodicSubtileIndex)) → (∀ (a : PeriodicSubtileIndex), (a ∈ whole.indices) → + (a.first = 0 ∧ a.second = 0))) → (∀ (whole : FiniteInducedTilePatch + cert.modified.plane cert.modified.tile), (whole.indices = {(⟨SixSubtileLabel.A, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), (⟨SixSubtileLabel.B, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.C, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.D, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.E, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.F, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex)}) → (∀ (d : PeriodicSubtileIndex), (d ∈ whole.indices) → (∀ + (rest : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (rest.indices + = whole.indices.erase d) → ((rest.unionTile = TileCellComplement T + (cert.modified.tile d)) → ((d ∉ rest.indices) → ((Disjoint (rest.unionTile).cells + (P.tile d).cells) → ((∀ z : LatticeCell, z ∈ whole.unionTile.cells ↔ z ∈ (P.tile + d).cells ∨ z ∈ rest.unionTile.cells) → ( + let n : PeriodicSubtileIndex := match d.label with + | .A => ⟨.B, 0, 0⟩ + | .B => ⟨.A, 0, 0⟩ + | .C => ⟨.A, 0, 0⟩ + | .D => ⟨.A, 0, 0⟩ + | .E => ⟨.B, 0, 0⟩ + | .F => ⟨.A, 0, 0⟩ + AllowedSubtileIncidence d n)))))))) ) := by + classical + intro q cfg C₀ T cert P hzero whole hidx d hd rest hrestIdx hrestUnion hdnot hdisj hunion n + cases d with + | mk lab i j => + have hz := hzero whole hidx ⟨lab, i, j⟩ hd + rcases hz with ⟨hi, hj⟩ + change i = 0 at hi + change j = 0 at hj + subst i + subst j + cases lab + · exact AllowedSubtileIncidence.AB 0 0 + · exact AllowedSubtileIncidence.symm (AllowedSubtileIncidence.AB 0 0) + · exact AllowedSubtileIncidence.symm (AllowedSubtileIncidence.AC 0 0) + · exact AllowedSubtileIncidence.symm (AllowedSubtileIncidence.AD 0 0) + · exact AllowedSubtileIncidence.symm (AllowedSubtileIncidence.BE 0 0) + · exact AllowedSubtileIncidence.symm (AllowedSubtileIncidence.AF 0 0) + +private theorem hnd : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + (∀ (whole : FiniteInducedTilePatch P.plane P.tile), (whole.indices = ({⟨.A, 0, 0⟩, ⟨.B, + 0, 0⟩, ⟨.C, 0, 0⟩, ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} : Finset + PeriodicSubtileIndex)) → (∀ (a : PeriodicSubtileIndex), (a ∈ whole.indices) → + (a.first = 0 ∧ a.second = 0))) → (∀ (whole : FiniteInducedTilePatch + cert.modified.plane cert.modified.tile), (whole.indices = {(⟨SixSubtileLabel.A, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), (⟨SixSubtileLabel.B, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.C, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.D, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.E, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.F, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex)}) → (∀ (d : PeriodicSubtileIndex), (d ∈ whole.indices) → (∀ + (rest : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (rest.indices + = whole.indices.erase d) → ((rest.unionTile = TileCellComplement T + (cert.modified.tile d)) → ((d ∉ rest.indices) → ((Disjoint (rest.unionTile).cells + (P.tile d).cells) → ((∀ z : LatticeCell, z ∈ whole.unionTile.cells ↔ z ∈ (P.tile + d).cells ∨ z ∈ rest.unionTile.cells) → ( + let n : PeriodicSubtileIndex := match d.label with + | .A => ⟨.B, 0, 0⟩ + | .B => ⟨.A, 0, 0⟩ + | .C => ⟨.A, 0, 0⟩ + | .D => ⟨.A, 0, 0⟩ + | .E => ⟨.B, 0, 0⟩ + | .F => ⟨.A, 0, 0⟩ + (AllowedSubtileIncidence d n) → (n ≠ d))))))))) ) := by + classical + intro q cfg C₀ T cert P hzero whole hidx d hd rest hrestIdx hrestUnion hdnot hdisj hunion n hdn + cases d with + | mk lab i j => + have hz := hzero whole hidx ⟨lab, i, j⟩ hd + rcases hz with ⟨hi, hj⟩ + change i = 0 at hi + change j = 0 at hj + subst i + subst j + cases lab <;> decide + +private theorem hnWhole : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + (∀ (whole : FiniteInducedTilePatch P.plane P.tile), (whole.indices = ({⟨.A, 0, 0⟩, ⟨.B, + 0, 0⟩, ⟨.C, 0, 0⟩, ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} : Finset + PeriodicSubtileIndex)) → (∀ (a : PeriodicSubtileIndex), (a ∈ whole.indices) → + (a.first = 0 ∧ a.second = 0))) → (∀ (whole : FiniteInducedTilePatch + cert.modified.plane cert.modified.tile), (whole.indices = {(⟨SixSubtileLabel.A, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), (⟨SixSubtileLabel.B, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.C, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.D, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.E, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.F, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex)}) → (∀ (d : PeriodicSubtileIndex), (d ∈ whole.indices) → (∀ + (rest : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (rest.indices + = whole.indices.erase d) → ((rest.unionTile = TileCellComplement T + (cert.modified.tile d)) → ((d ∉ rest.indices) → ((Disjoint (rest.unionTile).cells + (P.tile d).cells) → ((∀ z : LatticeCell, z ∈ whole.unionTile.cells ↔ z ∈ (P.tile + d).cells ∨ z ∈ rest.unionTile.cells) → ( + let n : PeriodicSubtileIndex := match d.label with + | .A => ⟨.B, 0, 0⟩ + | .B => ⟨.A, 0, 0⟩ + | .C => ⟨.A, 0, 0⟩ + | .D => ⟨.A, 0, 0⟩ + | .E => ⟨.B, 0, 0⟩ + | .F => ⟨.A, 0, 0⟩ + (AllowedSubtileIncidence d n) → ((n ≠ d) → (n ∈ whole.indices)))))))))) ) := by + classical + intro q cfg C₀ T cert P hzero whole hidx d hd rest hrestIdx hrestUnion hdnot hdisj hunion n hdn + hnd + cases d with + | mk lab i j => + have hz := hzero whole hidx ⟨lab, i, j⟩ hd + rcases hz with ⟨hi, hj⟩ + change i = 0 at hi + change j = 0 at hj + subst i + subst j + rw [hidx] + cases lab <;> simp [n] + +private theorem hnrest : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (whole : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), ∀ + (d : PeriodicSubtileIndex), ∀ (rest : FiniteInducedTilePatch cert.modified.plane + cert.modified.tile), (rest.indices = whole.indices.erase d) → ( + let n : PeriodicSubtileIndex := match d.label with + | .A => ⟨.B, 0, 0⟩ + | .B => ⟨.A, 0, 0⟩ + | .C => ⟨.A, 0, 0⟩ + | .D => ⟨.A, 0, 0⟩ + | .E => ⟨.B, 0, 0⟩ + | .F => ⟨.A, 0, 0⟩ + (n ≠ d) → ((n ∈ whole.indices) → (n ∈ rest.indices))) ) := by + classical + intro q cfg C₀ T cert whole d rest hrestIdx n hnd hnWhole + rw [hrestIdx, Finset.mem_erase] + exact ⟨hnd, hnWhole⟩ + +private theorem hcommon : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (d : PeriodicSubtileIndex), ∀ (rest : FiniteInducedTilePatch cert.modified.plane + cert.modified.tile), + let n : PeriodicSubtileIndex := match d.label with + | .A => ⟨.B, 0, 0⟩ + | .B => ⟨.A, 0, 0⟩ + | .C => ⟨.A, 0, 0⟩ + | .D => ⟨.A, 0, 0⟩ + | .E => ⟨.B, 0, 0⟩ + | .F => ⟨.A, 0, 0⟩ + (n ∈ rest.indices) → ((P.plane.adjacent d n) → ((FootprintEdges (P.tile d) ∩ + FootprintEdges rest.unionTile).Nonempty)) ) := by + classical + intro q cfg C₀ T cert P d rest n hnrest hneAdj + obtain ⟨e, he⟩ := P.adjacent_has_common_edge d n hneAdj + change e ∈ FootprintEdges (P.tile d) ∧ e ∈ FootprintEdges (P.tile n) at he + rcases he with ⟨hed, hen⟩ + change ∃ x ∈ (P.tile n).cells, _ at hen + rcases hen with ⟨x, hx, hedge⟩ + refine ⟨e, hed, ?_⟩ + refine ⟨x, (rest.exact_union x).2 ⟨n, hnrest, hx⟩, hedge⟩ + +private theorem hcommonComm : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + ∀ (d : PeriodicSubtileIndex), ∀ (rest : FiniteInducedTilePatch cert.modified.plane + cert.modified.tile), CommonFootprintEdgeVertices (P.tile d) rest.unionTile = + CommonFootprintEdgeVertices rest.unionTile (P.tile d) ) := by + classical + intro q cfg C₀ T cert P d rest + ext x + simp [CommonFootprintEdgeVertices, Set.mem_inter_iff, and_comm] + +end GeometricSectorGeometry + +namespace GeometricSectorAssembly + +private theorem hnoPinch : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.modified + (∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells) → + ((PeriodicTileAdjacentContactRegularity P) → ((∀ (a : PeriodicSubtileIndex), + LatticeTile (P.tile a)) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : + PeriodicSubtileIndex), (a ≠ b) → (Disjoint (P.tile a).cells (P.tile b).cells)) → ((∀ + (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ FootprintVertices U) + → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells))) → ( + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (x : GaussianInt), ∀ (owner : Fin 4 → PeriodicSubtileIndex), (∀ j, + LatticeVertexIncidentCell x j ∈ (P.tile (owner j)).cells) → (∀ (j : Fin 4), x ∈ + edgeAt x j ∧ edgeAt x j ∈ FootprintEdges (P.tile (owner j)) ∩ FootprintEdges (P.tile + (owner (j + 1))))) → ((∀ (x : GaussianInt), ∀ (owner : Fin 4 → PeriodicSubtileIndex), + (∀ j, LatticeVertexIncidentCell x j ∈ (P.tile (owner j)).cells) → (∀ (j : Fin 4), + edgeAt x j ∈ FootprintEdges (P.tile (owner j)) ∧ edgeAt x j ∈ FootprintEdges (P.tile + (owner (j + 1))))) → (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), + (a.first = 0 ∧ a.second = 0) → ((b.first = 0 ∧ b.second = 0) → ((a ≠ b) → + (FootprintVertices (P.tile a) ∩ FootprintVertices (P.tile b) = + CommonFootprintEdgeVertices (P.tile a) (P.tile b))))))))))) ) := by + classical + intro q cfg C₀ T cert P hindexed hregular htiles hdisjoint raw_incident edgeAt radial + radialMembers a b ha hb hab + by_cases hadj : P.plane.adjacent a b + · exact hregular.adjacent_raw_eq_edge_vertices a b hadj + · have hnoedge : ¬ (FootprintEdges (P.tile a) ∩ + FootprintEdges (P.tile b)).Nonempty := GeometricSectorGeometry.hnoedge q cfg C₀ T cert + a b hab hadj + have hcommonempty : CommonFootprintEdgeVertices (P.tile a) (P.tile b) = ∅ := + GeometricSectorGeometry.hcommonempty q cfg C₀ T cert a b hnoedge + have hrawempty : FootprintVertices (P.tile a) ∩ + FootprintVertices (P.tile b) = ∅ := by + ext x + simp only [Set.mem_empty_iff_false, iff_false] + intro hx + have hneA : (P.tile a).cells.Nonempty := + (LatticeTileGridStructure _ (htiles a)).1.1 + have hneB : (P.tile b).cells.Nonempty := + (LatticeTileGridStructure _ (htiles b)).1.1 + obtain ⟨j, hja⟩ := raw_incident (P.tile a) x hneA hx.1 + obtain ⟨k, hkb⟩ := raw_incident (P.tile b) x hneB hx.2 + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + have ho (r : Fin 4) : + LatticeVertexIncidentCell x r ∈ (P.tile (owner r)).cells := + (hindexed _).choose_spec.1 + have hja' : owner j = a := (hindexed _).unique (ho j) hja + have hkb' : owner k = b := (hindexed _).unique (ho k) hkb + have hjk : j ≠ k := GeometricSectorGeometry.hjk q cfg C₀ T cert hindexed a b hab x j k + hja' hkb' + have hnotconsecutive : ¬ (k = j + 1 ∨ j = k + 1) := + GeometricSectorGeometry.hnotconsecutive q cfg C₀ T cert hindexed radial a b hnoedge x + j k ho hja' hkb' + have hop : k = j + 2 := by + fin_cases j <;> fin_cases k <;> simp_all + let l := j + 1 + let m := j + 3 + -- The remaining incident sectors are owned by the two other labels. + have hfalse : False := by + have hpos : j ≠ l ∧ j ≠ k ∧ j ≠ m ∧ l ≠ k ∧ l ≠ m ∧ k ≠ m := + GeometricSectorGeometry.hpos q cfg C₀ T cert hindexed a x j hja k hja' hjk + hnotconsecutive hop + have hlk : l + 1 = k := GeometricSectorGeometry.hlk q cfg C₀ T cert hindexed a x j hja + k hja' hjk hnotconsecutive hop hpos + have hkm : k + 1 = m := GeometricSectorGeometry.hkm q cfg C₀ T cert hindexed a x j hja + k hja' hjk hnotconsecutive hop hpos hlk + have hmj : m + 1 = j := by fin_cases j <;> simp [m] + have hlA : owner l ≠ a := GeometricSectorGeometry.hlA q cfg C₀ T cert hindexed + radialMembers a b hnoedge x j k ho hkb' hlk + have hlB : owner l ≠ b := GeometricSectorGeometry.hlB q cfg C₀ T cert hindexed + radialMembers a b hnoedge x j ho hja' + have hmA : owner m ≠ a := GeometricSectorGeometry.hmA q cfg C₀ T cert hindexed + radialMembers a b hnoedge x j k ho hkb' hkm + have hmB : owner m ≠ b := GeometricSectorGeometry.hmB q cfg C₀ T cert hindexed + radialMembers a b hnoedge x j ho hja' hmj + have hlm : owner l ≠ owner m := GeometricSectorGeometry.hlm q cfg C₀ T cert hindexed + htiles a b x j hja k ho hja' hkb' hjk hnotconsecutive hop hpos hlk hkm hmj hlA hlB + hmA hmB + have hjlO : owner j ≠ owner l := GeometricSectorGeometry.hjlO q cfg C₀ T cert hindexed + a x j hja' hlA + have hjkO : owner j ≠ owner k := GeometricSectorGeometry.hjkO q cfg C₀ T cert hindexed + a b hab x j k hja' hkb' + have hjmO : owner j ≠ owner m := GeometricSectorGeometry.hjmO q cfg C₀ T cert hindexed + a x j hja' hmA + have hlkO : owner l ≠ owner k := GeometricSectorGeometry.hlkO q cfg C₀ T cert hindexed + b x j k hkb' hlB + have hkmO : owner k ≠ owner m := GeometricSectorGeometry.hkmO q cfg C₀ T cert hindexed + b x j k hkb' hmB + have hinj : Function.Injective owner := GeometricSectorGeometry.hinj q cfg C₀ T cert + hindexed a b x j hja k hja' hjk hnotconsecutive hop hpos hlk hkm hmj hlA hlB hmA + hmB hlm hjlO hjkO hjmO hlkO hkmO + have edgeAdjacent (u v : PeriodicSubtileIndex) (huv : u ≠ v) + (hedge : (FootprintEdges (P.tile u) ∩ + FootprintEdges (P.tile v)).Nonempty) : + AllowedSubtileIncidence u v := GeometricSectorGeometry.edgeAdjacent q cfg C₀ T cert + u v huv hedge + have hcycle01 : AllowedSubtileIncidence (owner j) (owner l) := + edgeAdjacent _ _ hjlO ⟨edgeAt x j, by + exact ⟨(radialMembers x owner ho j).1, + by simpa [l] using (radialMembers x owner ho j).2⟩⟩ + have hcycle12 : AllowedSubtileIncidence (owner l) (owner k) := + edgeAdjacent _ _ hlkO ⟨edgeAt x l, by + exact ⟨(radialMembers x owner ho l).1, + by simpa [hlk] using (radialMembers x owner ho l).2⟩⟩ + have hcycle23 : AllowedSubtileIncidence (owner k) (owner m) := + edgeAdjacent _ _ hkmO ⟨edgeAt x k, by + exact ⟨(radialMembers x owner ho k).1, + by simpa [hkm] using (radialMembers x owner ho k).2⟩⟩ + have hcycle30 : AllowedSubtileIncidence (owner m) (owner j) := + edgeAdjacent _ _ (by + intro heq + exact hmA (heq.trans hja')) + ⟨edgeAt x m, by + exact ⟨(radialMembers x owner ho m).1, + by simpa [hmj] using (radialMembers x owner ho m).2⟩⟩ + have hzeroJ : (owner j).first = 0 ∧ (owner j).second = 0 := by + simpa [hja'] using ha + have hzeroK : (owner k).first = 0 ∧ (owner k).second = 0 := by + simpa [hkb'] using hb + have hchord := AllowedSubtileIncidenceZeroOppositeChord + (owner j) (owner l) (owner k) (owner m) hzeroJ hzeroK + hcycle01 hcycle12 hcycle23 hcycle30 + (hinj.ne hpos.1) (hinj.ne hpos.2.1) (hinj.ne hpos.2.2.1) + (hinj.ne hpos.2.2.2.1) (hinj.ne hpos.2.2.2.2.1) + (hinj.ne hpos.2.2.2.2.2) + rcases hchord with hac | hbd + · exact hadj ((cert.modified_adjacency a b).mpr (by + simpa [hja', hkb'] using hac)) + · have hadjBD := (cert.modified_adjacency (owner l) (owner m)).mpr hbd + have rawCell (r : Fin 4) : + x ∈ FootprintVertices (P.tile (owner r)) := GeometricSectorGeometry.rawCell q cfg + C₀ T cert hindexed htiles x ho r + have hxRaw : x ∈ FootprintVertices (P.tile (owner l)) ∩ + FootprintVertices (P.tile (owner m)) := ⟨rawCell l, rawCell m⟩ + have hxEdges : x ∈ CommonFootprintEdgeVertices + (P.tile (owner l)) (P.tile (owner m)) := GeometricSectorGeometry.hxEdges q cfg C₀ + T cert hindexed hregular x j hadjBD hxRaw + obtain ⟨e, he, hxe⟩ := hxEdges + obtain ⟨r, _, hsector⟩ := P3102T2CommonEdgeSectorTransition + (P.tile (owner l)) (P.tile (owner m)) x e + (hdisjoint _ _ (hinj.ne hpos.2.2.2.2.1)) hxe he + have hnotseq (r : Fin 4) : + ¬ ((r = l ∧ r + 1 = m) ∨ (r = m ∧ r + 1 = l)) := GeometricSectorGeometry.hnotseq j r + rcases hsector with ⟨hr, hs⟩ | ⟨hr, hs⟩ + · have hrl : owner r = owner l := (hindexed _).unique (ho r) hr + have hsm : owner (r + 1) = owner m := + (hindexed _).unique (ho (r + 1)) hs + exact hnotseq r (Or.inl ⟨hinj hrl, hinj hsm⟩) + · have hrm : owner r = owner m := (hindexed _).unique (ho r) hr + have hsl : owner (r + 1) = owner l := + (hindexed _).unique (ho (r + 1)) hs + exact hnotseq r (Or.inr ⟨hinj hrm, hinj hsl⟩) + exact hfalse + rw [hrawempty, hcommonempty] + +end GeometricSectorAssembly + +theorem BandOrderedGeneralGeometricSectors + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + ∀ whole : FiniteInducedTilePatch + cert.modified.plane cert.modified.tile, + whole.indices = + ({⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, + ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} : + Finset PeriodicSubtileIndex) → + whole.unionTile = T → + (∀ a ∈ whole.indices, ∀ b ∈ whole.indices, a ≠ b → + FootprintVertices (cert.modified.tile a) ∩ + FootprintVertices (cert.modified.tile b) = + CommonFootprintEdgeVertices + (cert.modified.tile a) (cert.modified.tile b)) ∧ + ∀ d ∈ whole.indices, + ∀ rest : FiniteInducedTilePatch + cert.modified.plane cert.modified.tile, + rest.indices = whole.indices.erase d → + rest.unionTile = + TileCellComplement T (cert.modified.tile d) → + ExactPatchBoundaryInterface rest d := by +-- BODY + classical + let P := cert.modified + have hindexed := PeriodicTileIndexedMultiplicityOne P + have hregular := (PeriodicTileIntersectionClassification P).2 + have htiles (a : PeriodicSubtileIndex) : LatticeTile (P.tile a) := + P.tiles_are_disks a + have hdisjoint (a b : PeriodicSubtileIndex) (hab : a ≠ b) : + Disjoint (P.tile a).cells (P.tile b).cells := GeometricSectorGeometry.hdisjoint q cfg C₀ T + cert hindexed a b hab + have raw_incident (U : ProtoTile) (x : GaussianInt) + (hne : U.cells.Nonempty) (hx : x ∈ FootprintVertices U) : + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells := + GeometricSectorGeometry.raw_incident U x hne hx + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + have radial (x : GaussianInt) (owner : Fin 4 → PeriodicSubtileIndex) + (howner : ∀ j, LatticeVertexIncidentCell x j ∈ (P.tile (owner j)).cells) + (j : Fin 4) : + x ∈ edgeAt x j ∧ edgeAt x j ∈ + FootprintEdges (P.tile (owner j)) ∩ + FootprintEdges (P.tile (owner (j + 1))) := GeometricSectorGeometry.radial q cfg C₀ T + cert x owner howner j + have radialMembers (x : GaussianInt) (owner : Fin 4 → PeriodicSubtileIndex) + (howner : ∀ j, LatticeVertexIncidentCell x j ∈ (P.tile (owner j)).cells) + (j : Fin 4) : + edgeAt x j ∈ FootprintEdges (P.tile (owner j)) ∧ + edgeAt x j ∈ FootprintEdges (P.tile (owner (j + 1))) := + GeometricSectorGeometry.radialMembers q cfg C₀ T cert radial x owner howner j + have hzero (whole : FiniteInducedTilePatch P.plane P.tile) + (hidx : whole.indices = + ({⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, + ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} : + Finset PeriodicSubtileIndex)) + (a : PeriodicSubtileIndex) (ha : a ∈ whole.indices) : + a.first = 0 ∧ a.second = 0 := GeometricSectorGeometry.hzero q cfg C₀ T cert whole hidx a ha + have hnoPinch (a b : PeriodicSubtileIndex) + (ha : a.first = 0 ∧ a.second = 0) + (hb : b.first = 0 ∧ b.second = 0) (hab : a ≠ b) : + FootprintVertices (P.tile a) ∩ FootprintVertices (P.tile b) = + CommonFootprintEdgeVertices (P.tile a) (P.tile b) := GeometricSectorAssembly.hnoPinch q + cfg C₀ T cert hindexed hregular htiles hdisjoint raw_incident radial radialMembers a + b ha hb hab + intro whole hidx hwhole + have hwholeTile : LatticeTile whole.unionTile := + FinitePatchTopology P.plane P.tile (PeriodicTileMultiplicityOne P) + hindexed (fun a b _ hab => P.adjacent_has_common_edge a b hab) whole + constructor + · intro a ha b hb hab + exact hnoPinch a b (hzero whole hidx a ha) (hzero whole hidx b hb) hab + · intro d hd rest hrestIdx hrestUnion + have hrestTile : LatticeTile rest.unionTile := + FinitePatchTopology P.plane P.tile (PeriodicTileMultiplicityOne P) + hindexed (fun a b _ hab => P.adjacent_has_common_edge a b hab) rest + have hdnot : d ∉ rest.indices := GeometricSectorGeometry.hdnot q cfg C₀ T cert whole d rest + hrestIdx + have hdisj : Disjoint (rest.unionTile).cells (P.tile d).cells := + GeometricSectorGeometry.hdisj q cfg C₀ T cert hindexed d rest hdnot + have hunion : ∀ z : LatticeCell, + z ∈ whole.unionTile.cells ↔ z ∈ (P.tile d).cells ∨ + z ∈ rest.unionTile.cells := GeometricSectorGeometry.hunion q cfg C₀ T cert whole hwhole + d hd rest hrestUnion + let n : PeriodicSubtileIndex := match d.label with + | .A => ⟨.B, 0, 0⟩ + | .B => ⟨.A, 0, 0⟩ + | .C => ⟨.A, 0, 0⟩ + | .D => ⟨.A, 0, 0⟩ + | .E => ⟨.B, 0, 0⟩ + | .F => ⟨.A, 0, 0⟩ + have hdn : AllowedSubtileIncidence d n := GeometricSectorGeometry.hdn q cfg C₀ T cert hzero + whole hidx d hd rest hrestIdx hrestUnion hdnot hdisj hunion + have hnd : n ≠ d := GeometricSectorGeometry.hnd q cfg C₀ T cert hzero whole hidx d hd rest + hrestIdx hrestUnion hdnot hdisj hunion hdn + have hnWhole : n ∈ whole.indices := GeometricSectorGeometry.hnWhole q cfg C₀ T cert hzero + whole hidx d hd rest hrestIdx hrestUnion hdnot hdisj hunion hdn hnd + have hnrest : n ∈ rest.indices := GeometricSectorGeometry.hnrest q cfg C₀ T cert whole d rest + hrestIdx hnd hnWhole + have hneAdj : P.plane.adjacent d n := + (cert.modified_adjacency d n).mpr hdn + have hcommon : (FootprintEdges (P.tile d) ∩ + FootprintEdges rest.unionTile).Nonempty := GeometricSectorGeometry.hcommon q cfg C₀ T + cert d rest hnrest hneAdj + have hinterface := LatticeTileDiskUnionInterface + (P.tile d) rest.unionTile whole.unionTile (htiles d) hrestTile hwholeTile + hdisj.symm hunion hcommon + rcases hinterface with ⟨_, ⟨x, y, hpath⟩, hedges, hvertices⟩ + have hcommonComm : + CommonFootprintEdgeVertices (P.tile d) rest.unionTile = + CommonFootprintEdgeVertices rest.unionTile (P.tile d) := + GeometricSectorGeometry.hcommonComm q cfg C₀ T cert d rest + exact ⟨x, y, by + simpa [hcommonComm, Set.inter_comm] using hpath, + by simpa [Set.inter_comm] using hedges, + by simpa [hcommonComm, Set.inter_comm] using hvertices⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorStarClassification.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorStarClassification.lean new file mode 100644 index 0000000000..d1b39a37a7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorStarClassification.lean @@ -0,0 +1,190 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorWebRow +public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn +public import LeanPool.ApollonianSuperharmonic.P4055T1BandQuarterTurn +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import LeanPool.ApollonianSuperharmonic.P4590T1CentralDiskSectors +public import LeanPool.ApollonianSuperharmonic.P4590T1OriginalNonedges +public import LeanPool.ApollonianSuperharmonic.P4590T1ReflectedCenterBoundary +public import LeanPool.ApollonianSuperharmonic.P4590T1SixLabelBoundaryCount +public import LeanPool.ApollonianSuperharmonic.P4590T1MixedInteriorGeometry +public import LeanPool.ApollonianSuperharmonic.P4590T1RightInteriorGeometry +public import LeanPool.ApollonianSuperharmonic.P4590T1RestoredBoundaryGeometry +public import LeanPool.ApollonianSuperharmonic.P4590T1JunctionRefinement +public import LeanPool.ApollonianSuperharmonic.P4590T1JunctionRouting +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPositiveCutGeometry +public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior + +-- [TABLET NODE: BandOrderedGeneralInteriorStarClassification] + +/-! +# BandOrderedGeneralInteriorStarClassification + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralInteriorStarClassification + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) + (hT : LatticeTile T) + (x : GaussianInt) (hx : x ∈ FootprintVertices T) + (hxb : x ∉ BoundaryFootprintVertices T) : + let k := Nat.card {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} + (k = 2 → GaussianRealPoint x ≠ TileCentroid T → + BandOrderedGeneralInteriorWebRow cert x false) ∧ + (k = 3 → + BandOrderedGeneralInteriorWebRow cert x true ∧ + GaussianRealPoint x ≠ TileCentroid T) ∧ + k ≠ 4 ∧ + (k = 2 → GaussianRealPoint x = TileCentroid T → + (cfg.firstPredecessor 1).1 = 0) := by +-- BODY + classical + have hne (i : Fin 3) (s : Bool) : (cert.P i s).cells.Nonempty := + (LatticeTileGridStructure _ (cert.parent_lattice i s)).1.1 + have boundary_raw (i : Fin 3) (s : Bool) + (hb : x ∈ BoundaryFootprintVertices (cert.P i s)) : + x ∈ FootprintVertices (cert.P i s) := by + simp only [BoundaryFootprintVertices, hne i s, ite_true, Set.mem_ofPred_eq] at hb + obtain ⟨e, he, hz⟩ := hb + simp only [FootprintVertices, hne i s, ite_true, Set.mem_ofPred_eq] + obtain ⟨a, ⟨rfl, ha⟩ | ⟨rfl, ha⟩⟩ := he + all_goals + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases ha with ⟨ha, _⟩ | ⟨_, ha⟩ + · refine ⟨a, ha, ?_⟩ + rcases hz with rfl | rfl <;> simp + · refine ⟨_, ha, ?_⟩ + rcases hz with rfl | rfl <;> + simp [sub_eq_add_neg, add_comm, add_left_comm, add_assoc] + have nonedges := P4590T1OriginalNonedges q cfg C₀ T cert + have exclude (i j : Fin 3) (s t : Bool) + (hempty : FootprintVertices (cert.P i s) ∩ + FootprintVertices (cert.P j t) = ∅) : + ¬ (x ∈ BoundaryFootprintVertices (cert.P i s) ∧ + x ∈ BoundaryFootprintVertices (cert.P j t)) := by + rintro ⟨hi, hj⟩ + have hf : x ∈ (∅ : Set GaussianInt) := + hempty ▸ ⟨boundary_raw i s hi, boundary_raw j t hj⟩ + exact hf + have count := P4590T1SixLabelBoundaryCount + (fun i s => x ∈ BoundaryFootprintVertices (cert.P i s)) + (exclude 0 2 true true nonedges.1) + (exclude 0 2 false false nonedges.2.1) + (exclude 1 1 true false nonedges.2.2.1) + (exclude 1 2 true true nonedges.2.2.2.1) + (exclude 1 2 false false nonedges.2.2.2.2.1) + (exclude 2 2 true false nonedges.2.2.2.2.2) + have central_pairing (hc : GaussianRealPoint x = TileCentroid T) : + ∀ i, x ∈ BoundaryFootprintVertices (cert.P i true) ↔ + x ∈ BoundaryFootprintVertices (cert.P i false) := by + have signed := BandSignedOccurrenceHalfTurn q (TileCentroid T) cert.P + (fun i s => (cert.outer_occurrence i s).1) + (fun i s => (cert.outer_occurrence i s).2.2) + intro i + apply P4590T1ReflectedCenterBoundary _ _ x (hne i true) (hne i false) + simpa only [hc] using (signed i).2.2.2.2.2 + dsimp only at count ⊢ + refine ⟨?_, ?_, ?_, ?_⟩ + · intro hk hnoncentral + rcases count.2.1 hk with hAB | hAC | hBD | ⟨i, j, hij, hi, hj⟩ + · rcases P4590T1RestoredBoundaryGeometry q cfg C₀ T cert hT x hx hxb + hk hnoncentral hAB.1 hAB.2 with h | h | ⟨ha, hO⟩ | ⟨hb, hO⟩ + · exact .largestPositive h.1 h.2.1 h.2.2.1 (by simp [h.2.2.2]) + · exact .largestReflected h.1 h.2.1 h.2.2.1 (by simp [h.2.2.2]) + · subst x + exact .leftPositiveCut rfl rfl + (Classical.choice (BandOrderedGeneralPositiveCutGeometry q cfg C₀ T cert hO).1) + · subst x + exact .rightPositiveCut rfl rfl + (Classical.choice (BandOrderedGeneralPositiveCutGeometry q cfg C₀ T cert hO).2) + · have h := (P4590T1RightInteriorGeometry q cfg C₀ T cert hT x hx hxb hk).1 + (boundary_raw 0 true hAC.1) (boundary_raw 1 true hAC.2) + exact .rightPositive h.1 (boundary_raw 1 true hAC.2) h.2.1 (by simp [h.2.2]) + · have h := (P4590T1RightInteriorGeometry q cfg C₀ T cert hT x hx hxb hk).2 + (boundary_raw 0 false hBD.1) (boundary_raw 1 false hBD.2) + exact .rightReflected h.1 (boundary_raw 1 false hBD.2) h.2.1 (by simp [h.2.2]) + · have hi' := boundary_raw i true hi + have hj' := boundary_raw j false hj + obtain ⟨g12, g13, g21, g31, g23, g32⟩ := + P4590T1MixedInteriorGeometry q cfg C₀ T cert hT x hx hxb hk + obtain ⟨m12, m13, m21, m31, m23, m32⟩ := + P4590T1MixedCompanionMarks q cfg C₀ T cert hT x hx hxb + fin_cases i <;> fin_cases j + · exact (hij rfl).elim + · obtain ⟨hs, hn⟩ := g12 hi' hj' + exact .outer12 hi' hj' hs (by simp [hn]) + ((m12 hi' hj').trans (by simp [hn])) + · obtain ⟨hs, hn⟩ := g13 hi' hj' + exact .outer13 hi' hj' hs (by simp [hn]) + ((m13 hi' hj').trans (by simp [hn])) + · obtain ⟨hs, hn⟩ := g21 hi' hj' + exact .outer21 hi' hj' hs (by simp [hn]) + ((m21 hi' hj').trans (by simp [hn])) + · exact (hij rfl).elim + · obtain ⟨hs, hn⟩ := g23 hi' hj' + exact .outer23 hi' hj' hs (by simp [hn]) + ((m23 hi' hj').trans (by simp [hn])) + · obtain ⟨hs, hn⟩ := g31 hi' hj' + exact .outer31 hi' hj' hs (by simp [hn]) + ((m31 hi' hj').trans (by simp [hn])) + · obtain ⟨hs, hn⟩ := g32 hi' hj' + exact .outer32 hi' hj' hs (by simp [hn]) + ((m32 hi' hj').trans (by simp [hn])) + · exact (hij rfl).elim + · intro hk + refine ⟨?_, ?_⟩ + · have refineJunction := P4590T1JunctionRefinement q cfg C₀ T cert hT x hx hxb + apply P4590T1JunctionRouting q cfg C₀ T cert hT x hx hxb + rcases count.2.2.1 hk with h | h | h | h + · exact Or.inl (refineJunction.1 + ⟨boundary_raw 0 true h.1, boundary_raw 0 false h.2.1, + boundary_raw 1 true h.2.2⟩) + · exact Or.inr (Or.inl (refineJunction.2.1 + ⟨boundary_raw 0 true h.1, boundary_raw 0 false h.2.1, + boundary_raw 1 false h.2.2⟩)) + · exact Or.inr (Or.inr (Or.inl (refineJunction.2.2.1 + ⟨boundary_raw 0 true h.1, boundary_raw 1 true h.2.1, + boundary_raw 2 false h.2.2⟩))) + · exact Or.inr (Or.inr (Or.inr (refineJunction.2.2.2 + ⟨boundary_raw 0 false h.1, boundary_raw 1 false h.2.1, + boundary_raw 2 true h.2.2⟩))) + · intro hc + exact (count.2.2.2 (central_pairing hc)).1 hk + · omega + · intro hk hc + have hAB := (count.2.2.2 (central_pairing hc)).2 hk + have precursor := P4339T1PrecursorSupportGeometry C₀ q cfg T cert + by_contra hcurvature + have hO : cert.O.cells.Nonempty := Finset.nonempty_iff_ne_empty.mpr + (fun hempty => hcurvature (precursor.2.1.mp hempty)) + have hOlattice : LatticeTile cert.O := precursor.2.2.2.1 hO + have hOquarter : QuarterTurnSymmetric cert.O := + P4055T1BandQuarterTurn _ _ precursor.2.2.1 + have all_precursor := P4590T1CentralDiskSectors cert.O hOlattice hOquarter + x (precursor.1.trans hc.symm) + have hmissing : ∃ j : Fin 4, + LatticeVertexIncidentCell x j ∉ (cert.P 0 true).cells := by + by_contra! hall + exact ((P4456T2VertexInterior _ (hne 0 true) x + (boundary_raw 0 true hAB.1)).2.mpr hall) hAB.1 + obtain ⟨j, hj⟩ := hmissing + exact hj (cert.exceptional_segments.precursor_in_left (all_precursor j)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorWebRow.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorWebRow.lean new file mode 100644 index 0000000000..3f1449485f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorWebRow.lean @@ -0,0 +1,290 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.PositiveCutCompanionRow +public import LeanPool.ApollonianSuperharmonic.TileTranslation + +-- [TABLET NODE: BandOrderedGeneralInteriorWebRow] + +/-! +# BandOrderedGeneralInteriorWebRow + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Fix a `BandOrderedGeneralLayoutCertificate` and a lattice vertex +$x$. For +$m\in\{0,1\}$, an \emph{ordered-general interior web row of mark $m$} is +one of the following twelve labelled rows. In each of the first ten rows, +$x$ belongs to both displayed `FootprintVertices` sets and their +union contains the five-point star +$$ + x,\qquad x+1,\qquad x-1,\qquad x+\mathrm{i},\qquad x-\mathrm{i}. +$$ + +Write $r^{(1)}$ and $r^{(2)}$ for the certificate's first and second +predecessor tuples. There are six outer mixed rows with the following +geometric third owner and directed subtile data: +$$ +\begin{array}{c|c|c|c|c} +\text{pair}&\text{coarse third}&\text{child}&(r,j)&s\ \hline +(P_1^+,P_2^-)&P_1^-&P_1^+&(r^{(1)},2)&3\\ +(P_1^+,P_3^-)&P_2^+&P_1^+&(r^{(1)},3)&0\\ +(P_2^+,P_1^-)&P_1^+&P_1^-&(r^{(1)},2)&1\\ +(P_3^+,P_1^-)&P_2^-&P_1^-&(r^{(1)},3)&2\\ +(P_2^+,P_3^-)&P_1^+&P_2^+&(r^{(2)},1)&3\\ +(P_3^+,P_2^-)&P_1^-&P_2^-&(r^{(2)},1)&1 . +\end{array} +$$ +For each mixed row, $x$ belongs to the displayed coarse third footprint if +and only if $m=1$. This is only a zero-translate ownership assertion. It +does not identify that owner with the web companion. + +For the directed child $U$ in the same row, define literally +$$ + u_R=\mathrm{i}^s + \begin{cases} + \operatorname{BandVectors}_1(r_0,r_j),&s\text{ even},\\ + \operatorname{BandVectors}_1(r_j,r_0),&s\text{ odd}. + \end{cases} +$$ +The actual right companion of the directed subtile web is the +`TileTranslation` $U+u_R$, and +$$ + x\in\operatorname{FootprintVertices}(U+u_R)\quad\Longleftrightarrow\quad m=1. +$$ +The coarse third owner and this translated child are retained as distinct +objects, even though their footprints both contain $x$ exactly in the +marked case. + +There are two restricted right rows +$$ + (Q_2^+,P_2^+),\qquad(S_2^-,P_2^-). +$$ +For either row, the two tiles contain all four lattice cells incident with +$x$ if and only if $m=0$. + +There are two largest-parent child rows +$$ + (Q_2^+,S_3^-),\qquad(Q_3^+,S_2^-), +$$ +whose right companions are respectively $P_2^+$ and $P_2^-$. In either +row, $x$ belongs to the companion footprint if and only if $m=1$. + +Finally there are a left positive-cut row and a right positive-cut row. +Both are available only with mark zero. The left constructor requires +$x=a$, the first attachment vertex of the exceptional connector, and the +right constructor requires $x=b$, its second attachment vertex. Each +carries a `PositiveCutCompanionRow` at that same $x$. Thus neither +constructor chooses a fixed $Q/S$ pair. Through its row it retains one +proper birth tuple, raw parent slot and rotation, the selected child and +parent, their cut memberships, an opposite pair of incident cells, the +five-point-star cover, and the computed right translate $U+u_R$ with +$x\notin\operatorname{foot}(U+u_R)$. It also retains the literal eight-case tag and, +only in the two fixed $Q$--$S$ rows, the observable $P_2^\pm$ companion +identification. No marked point, hidden parent, exact interface triple, or +endpoint identity is present. + +This is geometric routing data only. In particular, it contains no +right- or subtile-lattice adjacency assertion, no slope or odometer data, +and no Laplacian conclusion. +-/ +inductive BandOrderedGeneralInteriorWebRow + {q : Fin 4 → CircleCoordinates} + {cfg : BandOrderedGeneralConfiguration q} + {C₀ : BandCircle} {T : ProtoTile} + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) + (x : GaussianInt) (marked : Bool) : Prop where +-- BODY + | outer12 + (left_mem : x ∈ FootprintVertices (cert.P 0 true)) + (right_mem : x ∈ FootprintVertices (cert.P 1 false)) + (star : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.P 0 true) ∨ + y ∈ FootprintVertices (cert.P 1 false)) + (coarseThird : + x ∈ FootprintVertices (cert.P 0 false) ↔ marked = true) + (webCompanion : + x ∈ FootprintVertices + (TileTranslation (cert.P 0 true) + ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * + (if Even (3 : Nat) then + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2) + else + BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0)))) ↔ marked = true) : + BandOrderedGeneralInteriorWebRow cert x marked + | outer13 + (left_mem : x ∈ FootprintVertices (cert.P 0 true)) + (right_mem : x ∈ FootprintVertices (cert.P 2 false)) + (star : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.P 0 true) ∨ + y ∈ FootprintVertices (cert.P 2 false)) + (coarseThird : + x ∈ FootprintVertices (cert.P 1 true) ↔ marked = true) + (webCompanion : + x ∈ FootprintVertices + (TileTranslation (cert.P 0 true) + ((⟨0, 1⟩ : GaussianInt) ^ (0 : Nat) * + (if Even (0 : Nat) then + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 3) + else + BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0)))) ↔ marked = true) : + BandOrderedGeneralInteriorWebRow cert x marked + | outer21 + (left_mem : x ∈ FootprintVertices (cert.P 1 true)) + (right_mem : x ∈ FootprintVertices (cert.P 0 false)) + (star : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.P 1 true) ∨ + y ∈ FootprintVertices (cert.P 0 false)) + (coarseThird : + x ∈ FootprintVertices (cert.P 0 true) ↔ marked = true) + (webCompanion : + x ∈ FootprintVertices + (TileTranslation (cert.P 0 false) + ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * + (if Even (1 : Nat) then + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2) + else + BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0)))) ↔ marked = true) : + BandOrderedGeneralInteriorWebRow cert x marked + | outer31 + (left_mem : x ∈ FootprintVertices (cert.P 2 true)) + (right_mem : x ∈ FootprintVertices (cert.P 0 false)) + (star : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.P 2 true) ∨ + y ∈ FootprintVertices (cert.P 0 false)) + (coarseThird : + x ∈ FootprintVertices (cert.P 1 false) ↔ marked = true) + (webCompanion : + x ∈ FootprintVertices + (TileTranslation (cert.P 0 false) + ((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + (if Even (2 : Nat) then + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 3) + else + BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0)))) ↔ marked = true) : + BandOrderedGeneralInteriorWebRow cert x marked + | outer23 + (left_mem : x ∈ FootprintVertices (cert.P 1 true)) + (right_mem : x ∈ FootprintVertices (cert.P 2 false)) + (star : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.P 1 true) ∨ + y ∈ FootprintVertices (cert.P 2 false)) + (coarseThird : + x ∈ FootprintVertices (cert.P 0 true) ↔ marked = true) + (webCompanion : + x ∈ FootprintVertices + (TileTranslation (cert.P 1 true) + ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * + (if Even (3 : Nat) then + BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) + else + BandVectors.1 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0)))) ↔ marked = true) : + BandOrderedGeneralInteriorWebRow cert x marked + | outer32 + (left_mem : x ∈ FootprintVertices (cert.P 2 true)) + (right_mem : x ∈ FootprintVertices (cert.P 1 false)) + (star : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.P 2 true) ∨ + y ∈ FootprintVertices (cert.P 1 false)) + (coarseThird : + x ∈ FootprintVertices (cert.P 0 false) ↔ marked = true) + (webCompanion : + x ∈ FootprintVertices + (TileTranslation (cert.P 1 false) + ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * + (if Even (1 : Nat) then + BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) + else + BandVectors.1 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0)))) ↔ marked = true) : + BandOrderedGeneralInteriorWebRow cert x marked + | rightPositive + (left_mem : x ∈ FootprintVertices (cert.Q 1 true)) + (right_mem : x ∈ FootprintVertices (cert.P 1 true)) + (star : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.Q 1 true) ∨ + y ∈ FootprintVertices (cert.P 1 true)) + (squares : + (∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩ → + z ∈ (cert.Q 1 true).cells ∨ z ∈ (cert.P 1 true).cells) ↔ + marked = false) : + BandOrderedGeneralInteriorWebRow cert x marked + | rightReflected + (left_mem : x ∈ FootprintVertices (cert.S 1 false)) + (right_mem : x ∈ FootprintVertices (cert.P 1 false)) + (star : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.S 1 false) ∨ + y ∈ FootprintVertices (cert.P 1 false)) + (squares : + (∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩ → + z ∈ (cert.S 1 false).cells ∨ z ∈ (cert.P 1 false).cells) ↔ + marked = false) : + BandOrderedGeneralInteriorWebRow cert x marked + | largestPositive + (left_mem : x ∈ FootprintVertices (cert.Q 1 true)) + (right_mem : x ∈ FootprintVertices (cert.S 2 false)) + (star : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.Q 1 true) ∨ + y ∈ FootprintVertices (cert.S 2 false)) + (companion : + x ∈ FootprintVertices (cert.P 1 true) ↔ marked = true) : + BandOrderedGeneralInteriorWebRow cert x marked + | largestReflected + (left_mem : x ∈ FootprintVertices (cert.Q 2 true)) + (right_mem : x ∈ FootprintVertices (cert.S 1 false)) + (star : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.Q 2 true) ∨ + y ∈ FootprintVertices (cert.S 1 false)) + (companion : + x ∈ FootprintVertices (cert.P 1 false) ↔ marked = true) : + BandOrderedGeneralInteriorWebRow cert x marked + | leftPositiveCut + (unmarked : marked = false) + (at_cut : x = cert.exceptional_segments.a) + (geometry : PositiveCutCompanionRow cert x) : + BandOrderedGeneralInteriorWebRow cert x marked + | rightPositiveCut + (unmarked : marked = false) + (at_cut : x = cert.exceptional_segments.b) + (geometry : PositiveCutCompanionRow cert x) : + BandOrderedGeneralInteriorWebRow cert x marked + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean new file mode 100644 index 0000000000..368ac54ebf --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean @@ -0,0 +1,2276 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorWebRow +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.OdometerWeb +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandOrderedGeneralLargestParentOdometerRows] + +/-! +# BandOrderedGeneralLargestParentOdometerRows + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace LargestParentOdometerGeometry + +private theorem band_of_odo : + (by + classical + exact + ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), TileOdometer c U k + → BandPrototile c U ) := by + classical + intro c U k hk + induction hk with + | line w x hw k hdom => exact BandPrototile.line w x hw + | unit z x U k hU hdom htrans => + cases U with + | mk cells anchor => + change cells = {x} at hU + rw [hU] + exact BandPrototile.unit z x anchor + | @decompose q hq S U hs k hU hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + exact hU + +private theorem firstRotateV : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) - I * BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 2) ) := by + classical + intro q cfg I + simpa [I] using + (VectorRecursionLaws _ (SemiProperQuadruple.rotate cfg.firstProper.1)).2.2.1 + +private theorem firstRotateA : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + I * BandVectors.2 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 2) ) := by + classical + intro q cfg I + simpa [I] using + (VectorRecursionLaws _ (SemiProperQuadruple.rotate cfg.firstProper.1)).2.2.2.1 + +private theorem v21 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) - I * BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 2)) → (BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = U + I * W) ) := by + classical + intro q cfg I U W firstRotateV + rw [cfg.firstParentThree] at firstRotateV + rw [cfg.firstParentTwo, cfg.firstChild] at firstRotateV + rw [cfg.firstParentTwo] + dsimp [U, W] at firstRotateV ⊢ + linear_combination -firstRotateV + +private theorem a21 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + I * BandVectors.2 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 2)) → (BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = A - I * B) ) := by + classical + intro q cfg I A B firstRotateA + rw [cfg.firstParentTwo, cfg.firstChild] at firstRotateA + rw [cfg.firstParentThree] at firstRotateA + rw [cfg.firstParentTwo] + dsimp [A, B] at firstRotateA ⊢ + linear_combination -firstRotateA + +private theorem v13 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = U + I * W) → + (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -U - (1 + I) * W) + ) := by + classical + intro q cfg I U W v21 + have hsum := (VectorRecursionLaws cfg.firstPredecessor + cfg.firstProper.1).1 + rw [cfg.firstParentThree, cfg.firstParentTwo] at hsum + have v21q := v21 + rw [cfg.firstParentTwo] at v21q + rw [v21q] at hsum + rw [cfg.firstParentThree] + dsimp [U, W, I] + linear_combination hsum + +private theorem a13 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = A - I * B) → + (BandVectors.2 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -A - (1 - I) * B) + ) := by + classical + intro q cfg I A B a21 + have hsum := (VectorRecursionLaws cfg.firstPredecessor + cfg.firstProper.1).2.1 + rw [cfg.firstParentThree, cfg.firstParentTwo] at hsum + have a21q := a21 + rw [cfg.firstParentTwo] at a21q + rw [a21q] at hsum + rw [cfg.firstParentThree] + dsimp [A, B, I] + linear_combination hsum + +private theorem centroidAlgebra : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (-cOff W - cOff (U + I * W)) - (cOff W + cOff (-U - (1 + I) * W)) = (1 / 2 : Real) • + GaussianRealPoint (I * (W + I * W)) ∧ (cOff W + cOff (U + I * W)) - (-cOff W - cOff + (-U - (1 + I) * W)) = (1 / 2 : Real) • GaussianRealPoint ((I : GaussianInt) ^ (3 : + Nat) * (W + I * W)) ∧ cOff W + cOff (-U - (1 + I) * W) + GaussianRealPoint (I * W) = + cOff (-U - W) ∧ -cOff W - cOff (-U - (1 + I) * W) + GaussianRealPoint ((I : + GaussianInt) ^ (3 : Nat) * W) = -cOff (-U - W) ) := by + classical + intro q cOff I U W + refine ⟨?_, ?_, ?_, ?_⟩ <;> apply Prod.ext <;> + norm_num [cOff, GaussianRealPoint, I, Prod.smul_mk, + Prod.add_def, Prod.sub_def, pow_succ] <;> ring + +private theorem slopeAlgebra : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (-sOff B - sOff (A - I * B)) - (sOff B + sOff (-A - (1 - I) * B)) = (1 / 2 : Real) • + GaussianRealPoint (-I * (B - I * B)) ∧ (sOff B + sOff (A - I * B)) - (-sOff B - sOff + (-A - (1 - I) * B)) = (1 / 2 : Real) • GaussianRealPoint ((-I : GaussianInt) ^ (3 : + Nat) * (B - I * B)) ) := by + classical + intro q sOff I A B + refine ⟨?_, ?_⟩ <;> apply Prod.ext <;> + norm_num [sOff, GaussianRealPoint, I, Prod.smul_mk, + Prod.add_def, Prod.sub_def, pow_succ] <;> ring + +private theorem hpos2 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (BandOrderedGeneralConfiguration q) → (0 < (q 2).1) ) + := by + classical + intro q cfg + have hnonneg := (ProperBandCurvatureStructure q cfg.proper).2.1 1 + have hnonneg' : 0 ≤ (q 2).1 := by simpa using hnonneg + have hne : (q 2).1 ≠ 0 := cfg.noLine 2 + omega + +private theorem hpos3 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (BandOrderedGeneralConfiguration q) → (0 < (q 3).1) ) + := by + classical + intro q cfg + have hnonneg := (ProperBandCurvatureStructure q cfg.proper).2.1 2 + have hnonneg' : 0 ≤ (q 3).1 := by simpa using hnonneg + have hne : (q 3).1 ≠ 0 := cfg.noLine 3 + omega + +private theorem hQleafAt284 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (TileCentroid (Q 1 true) - TileCentroid (P 0 true) + = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3)) - (-((GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3))).2), (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3))).1))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data + simpa [Fin.add_def] using data.hQcent 1 true + +private theorem hSleafAt293 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (TileCentroid (S 2 false) - TileCentroid (P 0 + false) = -((1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor + 2) (cfg.firstPredecessor 1)) - (-((GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1))).2), (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1))).1)))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data + simpa [Fin.add_def] using data.hScent 2 false + +private theorem hQleafOffAt302 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (P : + Fin 3 -> Bool -> ProtoTile), ∀ (Q : Fin 3 -> Bool -> ProtoTile), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (TileCentroid (Q 1 true) - TileCentroid (P 0 true) = (1 / 2 : Real) • (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)) - + (-((GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor + 3))).2), (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3))).1))) → (TileCentroid (Q 1 true) - TileCentroid (P 0 true) + = cOff (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3))) ) := by + classical + intro q cfg P Q cOff hQleaf + simpa [cOff] using hQleaf + +private theorem hSleafOffAt305 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (P : + Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> ProtoTile), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (TileCentroid (S 2 false) - TileCentroid (P 0 false) = -((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1)) + - (-((GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor + 1))).2), (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1))).1)))) → (TileCentroid (S 2 false) - TileCentroid (P 0 + false) = -cOff (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1))) ) + := by + classical + intro q cfg P S cOff hSleaf + simpa [cOff] using hSleaf + +private theorem hcentdiffAt312 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ + (S : Fin 3 -> Bool -> ProtoTile), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = U + I * W) → + ((BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -U - (1 + I) * W) + → (((-cOff W - cOff (U + I * W)) - (cOff W + cOff (-U - (1 + I) * W)) = (1 / 2 : + Real) • GaussianRealPoint (I * (W + I * W)) ∧ (cOff W + cOff (U + I * W)) - (-cOff W + - cOff (-U - (1 + I) * W)) = (1 / 2 : Real) • GaussianRealPoint ((I : GaussianInt) ^ + (3 : Nat) * (W + I * W)) ∧ cOff W + cOff (-U - (1 + I) * W) + GaussianRealPoint (I * + W) = cOff (-U - W) ∧ -cOff W - cOff (-U - (1 + I) * W) + GaussianRealPoint ((I : + GaussianInt) ^ (3 : Nat) * W) = -cOff (-U - W)) → ((TileCentroid (Q 1 true) - + TileCentroid (P 0 true) = cOff (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3))) → ((TileCentroid (S 2 false) - TileCentroid (P 0 false) = + -cOff (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1))) → + ((TileCentroid (P 0 true) - TileCentroid T = cOff W) → ((TileCentroid (P 0 false) - + TileCentroid T = -cOff W) → (TileCentroid (S 2 false) - TileCentroid (Q 1 true) = (1 + / 2 : Real) • GaussianRealPoint (I * (W + I * W))))))))) ) := by + classical + intro q cfg T P Q S cOff I U W v21 v13 centroidAlgebra hQleafOff hSleafOff hPplus hPminus + calc + _ = (TileCentroid (S 2 false) - TileCentroid (P 0 false)) + + (TileCentroid (P 0 false) - TileCentroid T) - + (TileCentroid (Q 1 true) - TileCentroid (P 0 true)) - + (TileCentroid (P 0 true) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = (-cOff W - cOff (U + I * W)) - + (cOff W + cOff (-U - (1 + I) * W)) := by + rw [hSleafOff, hPminus, hQleafOff, hPplus, v21, v13] + ext <;> dsimp [cOff] <;> ring + _ = (1 / 2 : Real) • GaussianRealPoint (I * (W + I * W)) := + centroidAlgebra.1 + +private theorem hQpackAt326 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (∃ p pQ : Real × Real, PartialOdometerSlope (r 0 + true) = some p ∧ PartialOdometerSlope (u 1 true) = some pQ ∧ pQ.1 - p.1 = (1 / 2) * + (((BandVectors.2 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)).re : Int) - + ((BandVectors.2 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)).im : Int)) ∧ pQ.2 + - p.2 = (1 / 2) * (((BandVectors.2 (cfg.firstPredecessor 1) (cfg.firstPredecessor + 3)).im : Int) + ((BandVectors.2 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)).re + : Int))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data + rcases data.hQslope 1 true with hzero | hgood + · have hbad : (q 2).1 = 0 := by + rw [← cfg.firstParentTwo] + exact hzero + exact False.elim ((cfg.noLine 2) hbad) + · simpa [Fin.add_def] using hgood + +private theorem hSpackAt345 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (∃ p pS : Real × Real, PartialOdometerSlope (r 0 + false) = some p ∧ PartialOdometerSlope (v 2 false) = some pS ∧ pS.1 - p.1 = -(1 / 2) + * (((BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1)).re : Int) - + ((BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1)).im : Int)) ∧ pS.2 + - p.2 = -(1 / 2) * (((BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor + 1)).im : Int) + ((BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1)).re + : Int))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data + rcases data.hSslope 2 false with hzero | hgood + · have hbad : (q 3).1 = 0 := by + rw [← cfg.firstParentThree] + exact hzero + exact False.elim ((cfg.noLine 3) hbad) + · simpa [Fin.add_def] using hgood + +private theorem hPplusPackAt364 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + ∃ p pP : Real × Real, PartialOdometerSlope h = some p ∧ PartialOdometerSlope (r 0 true) = + some pP ∧ pP.1 - p.1 = (1 / 2) * (((B.re : Int) : Real) - ((B.im : Int) : Real)) ∧ + pP.2 - p.2 = (1 / 2) * (((B.im : Int) : Real) + ((B.re : Int) : Real))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data B + rcases data.hPslope 0 true with hzero | hgood + · have hbad : (q 1).1 = 0 := by simpa using hzero + exact False.elim ((cfg.noLine 1) hbad) + · simpa [Fin.add_def, B] using hgood + +private theorem hPminusPackAt375 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + ∃ p pP : Real × Real, PartialOdometerSlope h = some p ∧ PartialOdometerSlope (r 0 false) + = some pP ∧ pP.1 - p.1 = -(1 / 2) * (((B.re : Int) : Real) - ((B.im : Int) : Real)) ∧ + pP.2 - p.2 = -(1 / 2) * (((B.im : Int) : Real) + ((B.re : Int) : Real))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data B + rcases data.hPslope 0 false with hzero | hgood + · have hbad : (q 1).1 = 0 := by simpa using hzero + exact False.elim ((cfg.noLine 1) hbad) + · simpa [Fin.add_def, B] using hgood + +private theorem hQdeltaAt398 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + ∀ (pQroot : ℝ × ℝ), ∀ (pQ : ℝ × ℝ), (pQ.1 - pQroot.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ)))).re + : ℝ) - (↑(BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) + (cfg.firstPredecessor (3 : Fin (4 : ℕ)))).im : ℝ))) → ((pQ.2 - pQroot.2 = (1 / 2 : ℝ) + * ((↑(BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 + : Fin (4 : ℕ)))).im : ℝ) + (↑(BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) + (cfg.firstPredecessor (3 : Fin (4 : ℕ)))).re : ℝ))) → (pQ - pQroot = sOff + (BandVectors.2 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)))) ) := by + classical + intro q cfg sOff pQroot pQ hQre hQim + apply Prod.ext + · change pQ.1 - pQroot.1 = _ + simpa [sOff, Prod.smul_mk] using hQre + · change pQ.2 - pQroot.2 = _ + simpa [sOff, Prod.smul_mk] using hQim + +private theorem hSdeltaAt405 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + ∀ (pSroot : ℝ × ℝ), ∀ (pS : ℝ × ℝ), (pS.1 - pSroot.1 = -(1 / 2 : ℝ) * ((↑(BandVectors.2 + (cfg.firstPredecessor (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ)))).re + : ℝ) - (↑(BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ)))).im : ℝ))) → ((pS.2 - pSroot.2 = -(1 / 2 : + ℝ) * ((↑(BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) (cfg.firstPredecessor + (1 : Fin (4 : ℕ)))).im : ℝ) + (↑(BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 : + ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ)))).re : ℝ))) → (pS - pSroot = -sOff + (BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1)))) ) := by + classical + intro q cfg sOff pSroot pS hSre hSim + apply Prod.ext + · change pS.1 - pSroot.1 = _ + simpa [sOff, Prod.smul_mk] using hSre + · change pS.2 - pSroot.2 = _ + simpa [sOff, Prod.smul_mk] using hSim + +private theorem hPplusDeltaAt412 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + ∀ (pRoot : ℝ × ℝ), ∀ (pPplus : ℝ × ℝ), (pPplus.1 - pRoot.1 = (1 / 2 : ℝ) * ((↑B.re : ℝ) - + (↑B.im : ℝ))) → ((pPplus.2 - pRoot.2 = (1 / 2 : ℝ) * ((↑B.im : ℝ) + (↑B.re : ℝ))) → + (pPplus - pRoot = sOff B)) ) := by + classical + intro q sOff B pRoot pPplus hPplusRe hPplusIm + apply Prod.ext + · change pPplus.1 - pRoot.1 = _ + simpa [sOff, Prod.smul_mk] using hPplusRe + · change pPplus.2 - pRoot.2 = _ + simpa [sOff, Prod.smul_mk] using hPplusIm + +private theorem hPminusDeltaAt418 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + ∀ (pRoot' : ℝ × ℝ), ∀ (pPminus : ℝ × ℝ), (pPminus.1 - pRoot'.1 = -(1 / 2 : ℝ) * ((↑B.re : + ℝ) - (↑B.im : ℝ))) → ((pPminus.2 - pRoot'.2 = -(1 / 2 : ℝ) * ((↑B.im : ℝ) + (↑B.re : + ℝ))) → (pPminus - pRoot' = -sOff B)) ) := by + classical + intro q sOff B pRoot' pPminus hPminusRe hPminusIm + apply Prod.ext + · change pPminus.1 - pRoot'.1 = _ + simpa [sOff, Prod.smul_mk] using hPminusRe + · change pPminus.2 - pRoot'.2 = _ + simpa [sOff, Prod.smul_mk] using hPminusIm + +private theorem hPplusDelta' : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + ∀ (pRoot : ℝ × ℝ), ∀ (pPplus : ℝ × ℝ), ∀ (pRoot' : ℝ × ℝ), (pRoot = pRoot') → ((pPplus - + pRoot = sOff B) → (pPplus - pRoot' = sOff B)) ) := by + classical + intro q sOff B pRoot pPplus pRoot' hrootAlign hPplusDelta + rw [← hrootAlign] + exact hPplusDelta + +private theorem hslopeDiffAt427 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = A - I * B) → + ((BandVectors.2 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -A - (1 - I) * B) + → (((-sOff B - sOff (A - I * B)) - (sOff B + sOff (-A - (1 - I) * B)) = (1 / 2 : + Real) • GaussianRealPoint (-I * (B - I * B)) ∧ (sOff B + sOff (A - I * B)) - (-sOff B + - sOff (-A - (1 - I) * B)) = (1 / 2 : Real) • GaussianRealPoint ((-I : GaussianInt) ^ + (3 : Nat) * (B - I * B))) → (∀ (pQroot : ℝ × ℝ), ∀ (pQ : ℝ × ℝ), ∀ (pSroot : ℝ × ℝ), + ∀ (pS : ℝ × ℝ), ∀ (pPplus : ℝ × ℝ), ∀ (pRoot' : ℝ × ℝ), ∀ (pPminus : ℝ × ℝ), (pQroot + = pPplus) → ((pSroot = pPminus) → ((pQ - pQroot = sOff (BandVectors.2 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3))) → ((pS - pSroot = -sOff + (BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1))) → ((pPminus - + pRoot' = -sOff B) → ((pPplus - pRoot' = sOff B) → (pS - pQ = (1 / 2 : Real) • + GaussianRealPoint (-I * (B - I * B))))))))))) ) := by + classical + intro q cfg sOff I A B a21 a13 slopeAlgebra pQroot pQ pSroot pS pPplus pRoot' pPminus hQalign + hSalign hQdelta hSdelta hPminusDelta hPplusDelta' + calc + pS - pQ = (pS - pSroot) + (pSroot - pRoot') - + (pQ - pQroot) - (pQroot - pRoot') := by + ext <;> dsimp <;> ring + _ = (-sOff B - sOff (A - I * B)) - + (sOff B + sOff (-A - (1 - I) * B)) := by + rw [hSdelta, hQdelta, hSalign, hQalign] + rw [hPminusDelta, hPplusDelta'] + rw [a21, a13] + ext <;> dsimp [sOff] <;> ring + _ = (1 / 2 : Real) • GaussianRealPoint (-I * (B - I * B)) := + slopeAlgebra.1 + +private theorem hP1At441 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + TileCentroid (P 1 true) - TileCentroid T = cOff (BandVectors.1 (q 1) (q 3))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data cOff + simpa [cOff, Fin.add_def] using data.hPcent 1 true + +private theorem hq13At444 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (BandOrderedGeneralConfiguration q) → ( + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 1) (q 3) = -U - W) ) := by + classical + intro q cfg U W + have hsum := (VectorRecursionLaws q cfg.proper.1).1 + dsimp [U, W] + linear_combination hsum + +private theorem htranslateCentAt448 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (Q : Fin 3 -> Bool -> ProtoTile), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -U - (1 + I) * W) → + (((-cOff W - cOff (U + I * W)) - (cOff W + cOff (-U - (1 + I) * W)) = (1 / 2 : Real) + • GaussianRealPoint (I * (W + I * W)) ∧ (cOff W + cOff (U + I * W)) - (-cOff W - cOff + (-U - (1 + I) * W)) = (1 / 2 : Real) • GaussianRealPoint ((I : GaussianInt) ^ (3 : + Nat) * (W + I * W)) ∧ cOff W + cOff (-U - (1 + I) * W) + GaussianRealPoint (I * W) = + cOff (-U - W) ∧ -cOff W - cOff (-U - (1 + I) * W) + GaussianRealPoint ((I : + GaussianInt) ^ (3 : Nat) * W) = -cOff (-U - W)) → ((TileCentroid (Q 1 true) - + TileCentroid (P 0 true) = cOff (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3))) → ((TileCentroid (P 0 true) - TileCentroid T = cOff W) → + ((TileCentroid (P 1 true) - TileCentroid T = cOff (BandVectors.1 (q 1) (q 3))) → + ((BandVectors.1 (q 1) (q 3) = -U - W) → (TileCentroid (TileTranslation (Q 1 true) (I + * W)) = TileCentroid (P 1 true))))))) ) := by + classical + intro q cfg T P Q cOff I U W v13 centroidAlgebra hQleafOff hPplus hP1 hq13 + have hform := (TileTranslationFormulas (Q 1 true) (I * W)).2.2.2.2.1 + have hform' : TileCentroid (TileTranslation (Q 1 true) (I * W)) = + TileCentroid (Q 1 true) + GaussianRealPoint (I * W) := by + simpa [GaussianRealPoint, Prod.add_def] using hform + have hQcentre : TileCentroid (Q 1 true) = + TileCentroid T + cOff W + + cOff (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3)) := by + calc + _ = TileCentroid (P 0 true) + + cOff (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3)) := by + have heq := hQleafOff + apply Prod.ext + · have hf := congrArg Prod.fst heq + dsimp [cOff] at hf ⊢ + linarith + · have hf := congrArg Prod.snd heq + dsimp [cOff] at hf ⊢ + linarith + _ = TileCentroid T + cOff W + + cOff (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3)) := by + have heq := hPplus + apply Prod.ext + · have hf := congrArg Prod.fst heq + dsimp [cOff] at hf ⊢ + linarith + · have hf := congrArg Prod.snd heq + dsimp [cOff] at hf ⊢ + linarith + have hP1centre : TileCentroid (P 1 true) = + TileCentroid T + cOff (-U - W) := by + calc + _ = TileCentroid T + cOff (BandVectors.1 (q 1) (q 3)) := by + have heq := hP1 + apply Prod.ext + · have hf := congrArg Prod.fst heq + dsimp [cOff] at hf ⊢ + linarith + · have hf := congrArg Prod.snd heq + dsimp [cOff] at hf ⊢ + linarith + _ = TileCentroid T + cOff (-U - W) := by rw [hq13] + calc + _ = TileCentroid (Q 1 true) + GaussianRealPoint (I * W) := hform' + _ = TileCentroid T + cOff W + + cOff (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3)) + GaussianRealPoint (I * W) := by + rw [hQcentre] + _ = TileCentroid T + cOff (-U - W) := by + rw [v13] + have h := centroidAlgebra.2.2.1 + apply Prod.ext + · have hf := congrArg Prod.fst h + dsimp [cOff] at hf ⊢ + linear_combination hf + · have hf := congrArg Prod.snd h + dsimp [cOff] at hf ⊢ + linear_combination hf + _ = TileCentroid (P 1 true) := hP1centre.symm + +private theorem hsumVAt525 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = I * BandVectors.1 (q (3 : + Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → (BandVectors.1 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = W + I * W) ) := by + classical + intro q cfg I W hflipV0 + rw [cfg.secondVectorOne, cfg.secondChild, cfg.secondParentOne, hflipV0] + +private theorem hsumAAt529 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = -I * BandVectors.2 (q (3 : + Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → (BandVectors.2 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = B - I * B) ) := by + classical + intro q cfg I B hflipA + rw [cfg.secondParentOne, cfg.secondChild, hflipA] + dsimp [B] + ring + +private theorem hcentTargetAt535 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (Q : + Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (TileCentroid (S 2 false) - TileCentroid (Q 1 true) = (1 / 2 : Real) • GaussianRealPoint + (I * (W + I * W))) → ((BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor + 0) + BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) = W + I * W) → + (TileCentroid (S 2 false) - TileCentroid (Q 1 true) = (1 / 2 : Real) • + GaussianRealPoint ((I : GaussianInt) ^ (1 : Nat) * (BandVectors.1 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.1 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1))))) ) := by + classical + intro q cfg Q S I W hcentdiff hsumV + rw [hcentdiff, hsumV] + simp [I] + +private theorem hslopePairAt543 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + ∀ (pQ : ℝ × ℝ), ∀ (pS : ℝ × ℝ), (pS - pQ = (1 / 2 : Real) • GaussianRealPoint (-I * (B - + I * B))) → ((BandVectors.2 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + + BandVectors.2 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) = B - I * B) → (pS + - pQ = (1 / 2 : Real) • GaussianRealPoint (((-I : GaussianInt) ^ (1 : Nat)) * + (BandVectors.2 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.2 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1))))) ) := by + classical + intro q cfg I B pQ pS hslopeDiff hsumA + rw [hslopeDiff, hsumA] + simp [I] + +private theorem hadjAt550 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let I : GaussianInt := ⟨0, 1⟩ + ∀ (hpos2 : 0 < (q 2).1), ∀ (hpos3 : 0 < (q 3).1), + let C₂ : BandCircle := ⟨⟨q 2, + ⟨Or.inl hpos2, q, cfg.proper.1, ⟨2, rfl⟩⟩⟩, hpos2⟩ + let C₃ : BandCircle := ⟨⟨q 3, + ⟨Or.inl hpos3, q, cfg.proper.1, ⟨3, rfl⟩⟩⟩, hpos3⟩ + ∀ (pQ : ℝ × ℝ), (PartialOdometerSlope (u (1 : Fin (3 : ℕ)) true) = some pQ) → (∀ (pS : ℝ + × ℝ), (PartialOdometerSlope (v (2 : Fin (3 : ℕ)) false) = some pS) → ((TileCentroid + (S 2 false) - TileCentroid (Q 1 true) = (1 / 2 : Real) • GaussianRealPoint ((I : + GaussianInt) ^ (1 : Nat) * (BandVectors.1 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1)))) → ((pS - pQ = (1 / 2 : Real) • GaussianRealPoint (((-I : + GaussianInt) ^ (1 : Nat)) * (BandVectors.2 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1)))) → (SubtileLatticeAdjacent C₂ C₃ (Q 1 true) (S 2 false) + (u 1 true) (v 2 false)))))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data I hpos2 hpos3 C₂ C₃ pQ hQleafSlope pS hSleafSlope + hcentTarget hslopePair + refine ⟨?_, ?_, ⟨pQ, pS, hQleafSlope, hSleafSlope, ?_⟩⟩ + · simpa [C₂, cfg.firstParentTwo] using data.hQ 1 true + · simpa [C₃, cfg.firstParentThree] using data.hS 2 false + refine ⟨cfg.secondPredecessor, 0, 1, cfg.secondProper, ?_, ?_, + hcentTarget, ?_, ?_⟩ + · simpa [C₂] using cfg.secondChild + · simpa [C₃] using cfg.secondParentOne + · exact congrArg Prod.fst hslopePair + · exact congrArg Prod.snd hslopePair + +private theorem hxQAt573 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), + (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → ((x ∈ + FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true)) → (x ∈ FootprintVertices (Q 1 + true))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g x data left_mem + rw [(data.hobsQ 1 true).2.1] + exact left_mem + +private theorem hxSAt576 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), + (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → ((x ∈ + FootprintVertices (cert.S (2 : Fin (3 : ℕ)) false)) → (x ∈ FootprintVertices (S 2 + false))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g x data right_mem + rw [(data.hobsS 2 false).2.1] + exact right_mem + +private theorem hxUAt579 : + (by + classical + exact + ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (x : + GaussianInt), ((↑(u (1 : Fin (3 : ℕ)) true).domain : Set GaussianInt) = + FootprintVertices (Q (1 : Fin (3 : ℕ)) true)) → ((x ∈ FootprintVertices (Q 1 true)) → + (x ∈ (u 1 true).domain)) ) := by + classical + intro Q u x hQdom hxQ + change x ∈ ((u 1 true).domain : Set GaussianInt) + rw [hQdom] + exact hxQ + +private theorem hxVAt583 : + (by + classical + exact + ∀ (S : Fin 3 -> Bool -> ProtoTile), ∀ (v : Fin 3 -> Bool -> PartialOdometer), ∀ (x : + GaussianInt), ((↑(v (2 : Fin (3 : ℕ)) false).domain : Set GaussianInt) = + FootprintVertices (S (2 : Fin (3 : ℕ)) false)) → ((x ∈ FootprintVertices (S 2 false)) + → (x ∈ (v 2 false).domain)) ) := by + classical + intro S v x hSdom hxS + change x ∈ ((v 2 false).domain : Set GaussianInt) + rw [hSdom] + exact hxS + +private theorem hstarAt587 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), + (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → ((∀ (y : + GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ + FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∨ y ∈ FootprintVertices (cert.S (2 + : Fin (3 : ℕ)) false)) → (((↑(u (1 : Fin (3 : ℕ)) true).domain : Set GaussianInt) = + FootprintVertices (Q (1 : Fin (3 : ℕ)) true)) → (((↑(v (2 : Fin (3 : ℕ)) + false).domain : Set GaussianInt) = FootprintVertices (S (2 : Fin (3 : ℕ)) false)) → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ (u 1 + true).domain ∨ y ∈ (v 2 false).domain)))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g x data star hQdom hSdom y hy + rcases star y hy with hq | hs + · left + change y ∈ ((u 1 true).domain : Set GaussianInt) + rw [hQdom] + rw [(data.hobsQ 1 true).2.1] + exact hq + · right + change y ∈ ((v 2 false).domain : Set GaussianInt) + rw [hSdom] + rw [(data.hobsS 2 false).2.1] + exact hs + +private theorem hcompFootAt618 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let I : GaussianInt := ⟨0, 1⟩ + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (FootprintVertices (TileTranslation (Q (1 : Fin (3 : ℕ)) true) (I * W)) = + FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ BoundaryFootprintVertices + (TileTranslation (Q (1 : Fin (3 : ℕ)) true) (I * W)) = BoundaryFootprintVertices (P + (1 : Fin (3 : ℕ)) true) ∧ BoundaryFootprintEdges (TileTranslation (Q (1 : Fin (3 : + ℕ)) true) (I * W)) = BoundaryFootprintEdges (P (1 : Fin (3 : ℕ)) true) ∧ + TileRealization (TileTranslation (Q (1 : Fin (3 : ℕ)) true) (I * W)) = + TileRealization (P (1 : Fin (3 : ℕ)) true) ∧ TileCentroid (TileTranslation (Q (1 : + Fin (3 : ℕ)) true) (I * W)) = TileCentroid (P (1 : Fin (3 : ℕ)) true)) → + (FootprintVertices (TileTranslation (Q 1 true) (I * W)) = FootprintVertices (cert.P 1 + true))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data I W hcompObs + calc + _ = FootprintVertices (P 1 true) := hcompObs.1 + _ = FootprintVertices (cert.P 1 true) := (data.hobsP 1 true).2.1 + +private theorem hmarkAt623 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (x : GaussianInt), ∀ (marked : Bool), + let I : GaussianInt := ⟨0, 1⟩ + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (x ∈ FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true) ↔ marked = true) → + ((FootprintVertices (TileTranslation (Q 1 true) (I * W)) = FootprintVertices (cert.P + 1 true)) → (x ∈ FootprintVertices (TileTranslation (Q 1 true) (I * W)) ↔ marked = + true)) ) := by + classical + intro q cfg C0 T cert Q x marked I W companion hcompFoot + rw [hcompFoot] + exact companion + +private theorem hQleafAt647 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (TileCentroid (Q 2 true) - TileCentroid (P 0 true) + = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1)) - (-((GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1))).2), (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1))).1))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data + simpa [Fin.add_def] using data.hQcent 2 true + +private theorem hSleafAt656 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (TileCentroid (S 1 false) - TileCentroid (P 0 + false) = -((1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor + 1) (cfg.firstPredecessor 3)) - (-((GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3))).2), (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3))).1)))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data + simpa [Fin.add_def] using data.hScent 1 false + +private theorem hQleafOffAt665 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (P : + Fin 3 -> Bool -> ProtoTile), ∀ (Q : Fin 3 -> Bool -> ProtoTile), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (TileCentroid (Q 2 true) - TileCentroid (P 0 true) = (1 / 2 : Real) • (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1)) - + (-((GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor + 1))).2), (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1))).1))) → (TileCentroid (Q 2 true) - TileCentroid (P 0 true) + = cOff (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1))) ) := by + classical + intro q cfg P Q cOff hQleaf + simpa [cOff] using hQleaf + +private theorem hSleafOffAt669 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (P : + Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> ProtoTile), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (TileCentroid (S 1 false) - TileCentroid (P 0 false) = -((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)) + - (-((GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor + 3))).2), (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3))).1)))) → (TileCentroid (S 1 false) - TileCentroid (P 0 + false) = -cOff (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3))) ) + := by + classical + intro q cfg P S cOff hSleaf + simpa [cOff] using hSleaf + +private theorem hcentdiffAt677 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ + (S : Fin 3 -> Bool -> ProtoTile), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = U + I * W) → + ((BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -U - (1 + I) * W) + → (((-cOff W - cOff (U + I * W)) - (cOff W + cOff (-U - (1 + I) * W)) = (1 / 2 : + Real) • GaussianRealPoint (I * (W + I * W)) ∧ (cOff W + cOff (U + I * W)) - (-cOff W + - cOff (-U - (1 + I) * W)) = (1 / 2 : Real) • GaussianRealPoint ((I : GaussianInt) ^ + (3 : Nat) * (W + I * W)) ∧ cOff W + cOff (-U - (1 + I) * W) + GaussianRealPoint (I * + W) = cOff (-U - W) ∧ -cOff W - cOff (-U - (1 + I) * W) + GaussianRealPoint ((I : + GaussianInt) ^ (3 : Nat) * W) = -cOff (-U - W)) → ((TileCentroid (Q 2 true) - + TileCentroid (P 0 true) = cOff (BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1))) → ((TileCentroid (S 1 false) - TileCentroid (P 0 false) = + -cOff (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3))) → + ((TileCentroid (P 0 true) - TileCentroid T = cOff W) → ((TileCentroid (P 0 false) - + TileCentroid T = -cOff W) → (TileCentroid (Q 2 true) - TileCentroid (S 1 false) = (1 + / 2 : Real) • GaussianRealPoint ((I : GaussianInt) ^ (3 : Nat) * (W + I * W))))))))) + ) := by + classical + intro q cfg T P Q S cOff I U W v21 v13 centroidAlgebra hQleafOff hSleafOff hPplus hPminus + calc + _ = (TileCentroid (Q 2 true) - TileCentroid (P 0 true)) + + (TileCentroid (P 0 true) - TileCentroid T) - + (TileCentroid (S 1 false) - TileCentroid (P 0 false)) - + (TileCentroid (P 0 false) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = (cOff W + cOff (U + I * W)) - + (-cOff W - cOff (-U - (1 + I) * W)) := by + rw [hQleafOff, hPplus, hSleafOff, hPminus, v21, v13] + ext <;> dsimp [cOff] <;> ring + _ = (1 / 2 : Real) • GaussianRealPoint + ((I : GaussianInt) ^ (3 : Nat) * (W + I * W)) := + centroidAlgebra.2.1 + +private theorem hQpackAt693 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (∃ p pQ : Real × Real, PartialOdometerSlope (r 0 + true) = some p ∧ PartialOdometerSlope (u 2 true) = some pQ ∧ pQ.1 - p.1 = (1 / 2) * + (((BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1)).re : Int) - + ((BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1)).im : Int)) ∧ pQ.2 + - p.2 = (1 / 2) * (((BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor + 1)).im : Int) + ((BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1)).re + : Int))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data + rcases data.hQslope 2 true with hzero | hgood + · have hbad : (q 3).1 = 0 := by + rw [← cfg.firstParentThree] + exact hzero + exact False.elim ((cfg.noLine 3) hbad) + · simpa [Fin.add_def] using hgood + +private theorem hSpackAt712 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (∃ p pS : Real × Real, PartialOdometerSlope (r 0 + false) = some p ∧ PartialOdometerSlope (v 1 false) = some pS ∧ pS.1 - p.1 = -(1 / 2) + * (((BandVectors.2 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)).re : Int) - + ((BandVectors.2 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)).im : Int)) ∧ pS.2 + - p.2 = -(1 / 2) * (((BandVectors.2 (cfg.firstPredecessor 1) (cfg.firstPredecessor + 3)).im : Int) + ((BandVectors.2 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)).re + : Int))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data + rcases data.hSslope 1 false with hzero | hgood + · have hbad : (q 2).1 = 0 := by + rw [← cfg.firstParentTwo] + exact hzero + exact False.elim ((cfg.noLine 2) hbad) + · simpa [Fin.add_def] using hgood + +private theorem hPplusPackAt731 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + ∃ p pP : Real × Real, PartialOdometerSlope h = some p ∧ PartialOdometerSlope (r 0 true) = + some pP ∧ pP.1 - p.1 = (1 / 2) * (((B.re : Int) : Real) - ((B.im : Int) : Real)) ∧ + pP.2 - p.2 = (1 / 2) * (((B.im : Int) : Real) + ((B.re : Int) : Real))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data B + rcases data.hPslope 0 true with hzero | hgood + · have hbad : (q 1).1 = 0 := by simpa using hzero + exact False.elim ((cfg.noLine 1) hbad) + · simpa [Fin.add_def, B] using hgood + +private theorem hPminusPackAt742 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + ∃ p pP : Real × Real, PartialOdometerSlope h = some p ∧ PartialOdometerSlope (r 0 false) + = some pP ∧ pP.1 - p.1 = -(1 / 2) * (((B.re : Int) : Real) - ((B.im : Int) : Real)) ∧ + pP.2 - p.2 = -(1 / 2) * (((B.im : Int) : Real) + ((B.re : Int) : Real))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data B + rcases data.hPslope 0 false with hzero | hgood + · have hbad : (q 1).1 = 0 := by simpa using hzero + exact False.elim ((cfg.noLine 1) hbad) + · simpa [Fin.add_def, B] using hgood + +private theorem hQdeltaAt765 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + ∀ (pQroot : ℝ × ℝ), ∀ (pQ : ℝ × ℝ), (pQ.1 - pQroot.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 + (cfg.firstPredecessor (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ)))).re + : ℝ) - (↑(BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ)))).im : ℝ))) → ((pQ.2 - pQroot.2 = (1 / 2 : ℝ) + * ((↑(BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 + : Fin (4 : ℕ)))).im : ℝ) + (↑(BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ)))).re : ℝ))) → (pQ - pQroot = sOff + (BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1)))) ) := by + classical + intro q cfg sOff pQroot pQ hQre hQim + apply Prod.ext + · change pQ.1 - pQroot.1 = _ + simpa [sOff, Prod.smul_mk] using hQre + · change pQ.2 - pQroot.2 = _ + simpa [sOff, Prod.smul_mk] using hQim + +private theorem hSdeltaAt772 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + ∀ (pSroot : ℝ × ℝ), ∀ (pS : ℝ × ℝ), (pS.1 - pSroot.1 = -(1 / 2 : ℝ) * ((↑(BandVectors.2 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ)))).re + : ℝ) - (↑(BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) + (cfg.firstPredecessor (3 : Fin (4 : ℕ)))).im : ℝ))) → ((pS.2 - pSroot.2 = -(1 / 2 : + ℝ) * ((↑(BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor + (3 : Fin (4 : ℕ)))).im : ℝ) + (↑(BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : + ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ)))).re : ℝ))) → (pS - pSroot = -sOff + (BandVectors.2 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)))) ) := by + classical + intro q cfg sOff pSroot pS hSre hSim + apply Prod.ext + · change pS.1 - pSroot.1 = _ + simpa [sOff, Prod.smul_mk] using hSre + · change pS.2 - pSroot.2 = _ + simpa [sOff, Prod.smul_mk] using hSim + +private theorem hPplusDeltaAt779 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + ∀ (pRoot : ℝ × ℝ), ∀ (pPplus : ℝ × ℝ), (pPplus.1 - pRoot.1 = (1 / 2 : ℝ) * ((↑B.re : ℝ) - + (↑B.im : ℝ))) → ((pPplus.2 - pRoot.2 = (1 / 2 : ℝ) * ((↑B.im : ℝ) + (↑B.re : ℝ))) → + (pPplus - pRoot = sOff B)) ) := by + classical + intro q sOff B pRoot pPplus hPplusRe hPplusIm + apply Prod.ext + · change pPplus.1 - pRoot.1 = _ + simpa [sOff, Prod.smul_mk] using hPplusRe + · change pPplus.2 - pRoot.2 = _ + simpa [sOff, Prod.smul_mk] using hPplusIm + +private theorem hPminusDeltaAt785 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + ∀ (pRoot' : ℝ × ℝ), ∀ (pPminus : ℝ × ℝ), (pPminus.1 - pRoot'.1 = -(1 / 2 : ℝ) * ((↑B.re : + ℝ) - (↑B.im : ℝ))) → ((pPminus.2 - pRoot'.2 = -(1 / 2 : ℝ) * ((↑B.im : ℝ) + (↑B.re : + ℝ))) → (pPminus - pRoot' = -sOff B)) ) := by + classical + intro q sOff B pRoot' pPminus hPminusRe hPminusIm + apply Prod.ext + · change pPminus.1 - pRoot'.1 = _ + simpa [sOff, Prod.smul_mk] using hPminusRe + · change pPminus.2 - pRoot'.2 = _ + simpa [sOff, Prod.smul_mk] using hPminusIm + +private theorem hPminusDelta' : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + ∀ (pRoot : ℝ × ℝ), ∀ (pRoot' : ℝ × ℝ), ∀ (pPminus : ℝ × ℝ), (pRoot = pRoot') → ((pPminus + - pRoot' = -sOff B) → (pPminus - pRoot = -sOff B)) ) := by + classical + intro q sOff B pRoot pRoot' pPminus hrootAlign hPminusDelta + rw [hrootAlign] + exact hPminusDelta + +private theorem hslopeDiffAt794 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = A - I * B) → + ((BandVectors.2 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -A - (1 - I) * B) + → (((-sOff B - sOff (A - I * B)) - (sOff B + sOff (-A - (1 - I) * B)) = (1 / 2 : + Real) • GaussianRealPoint (-I * (B - I * B)) ∧ (sOff B + sOff (A - I * B)) - (-sOff B + - sOff (-A - (1 - I) * B)) = (1 / 2 : Real) • GaussianRealPoint ((-I : GaussianInt) ^ + (3 : Nat) * (B - I * B))) → (∀ (pQroot : ℝ × ℝ), ∀ (pQ : ℝ × ℝ), ∀ (pSroot : ℝ × ℝ), + ∀ (pS : ℝ × ℝ), ∀ (pRoot : ℝ × ℝ), ∀ (pPplus : ℝ × ℝ), ∀ (pPminus : ℝ × ℝ), (pQroot = + pPplus) → ((pSroot = pPminus) → ((pQ - pQroot = sOff (BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1))) → ((pS - pSroot = -sOff + (BandVectors.2 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3))) → ((pPplus - pRoot + = sOff B) → ((pPminus - pRoot = -sOff B) → (pQ - pS = (1 / 2 : Real) • + GaussianRealPoint (((-I : GaussianInt) ^ (3 : Nat)) * (B - I * B))))))))))) ) := by + classical + intro q cfg sOff I A B a21 a13 slopeAlgebra pQroot pQ pSroot pS pRoot pPplus pPminus hQalign + hSalign hQdelta hSdelta hPplusDelta hPminusDelta' + calc + pQ - pS = (pQ - pQroot) + (pQroot - pRoot) - + (pS - pSroot) - (pSroot - pRoot) := by + ext <;> dsimp <;> ring + _ = (sOff B + sOff (A - I * B)) - + (-sOff B - sOff (-A - (1 - I) * B)) := by + rw [hQdelta, hSdelta, hQalign, hSalign] + rw [hPplusDelta, hPminusDelta'] + rw [a21, a13] + ext <;> dsimp [sOff] <;> ring + _ = (1 / 2 : Real) • GaussianRealPoint + (((-I : GaussianInt) ^ (3 : Nat)) * (B - I * B)) := + slopeAlgebra.2 + +private theorem hP1At810 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + TileCentroid (P 1 false) - TileCentroid T = -cOff (BandVectors.1 (q 1) (q 3))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data cOff + simpa [cOff, Fin.add_def] using data.hPcent 1 false + +private theorem hq13At813 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (BandOrderedGeneralConfiguration q) → ( + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 1) (q 3) = -U - W) ) := by + classical + intro q cfg U W + have hsum := (VectorRecursionLaws q cfg.proper.1).1 + dsimp [U, W] + linear_combination hsum + +private theorem hform'At819 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (S : Fin 3 -> Bool -> ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (TileCentroid (TileTranslation (S (1 : Fin (3 : ℕ)) false) (I ^ (3 : ℕ) * W)) = + ((TileCentroid (S (1 : Fin (3 : ℕ)) false)).1 + (↑(I ^ (3 : ℕ) * W).re : ℝ), + (TileCentroid (S (1 : Fin (3 : ℕ)) false)).2 + (↑(I ^ (3 : ℕ) * W).im : ℝ))) → + (TileCentroid (TileTranslation (S 1 false) (I ^ (3 : Nat) * W)) = TileCentroid (S 1 + false) + GaussianRealPoint (I ^ (3 : Nat) * W)) ) := by + classical + intro q S I W hform + simpa [GaussianRealPoint, Prod.add_def] using hform + +private theorem hScentre : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> ProtoTile), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (TileCentroid (S 1 false) - TileCentroid (P 0 false) = -cOff (BandVectors.1 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3))) → ((TileCentroid (P 0 false) - + TileCentroid T = -cOff W) → (TileCentroid (S 1 false) = TileCentroid T - cOff W - + cOff (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)))) ) := by + classical + intro q cfg T P S cOff W hSleafOff hPminus + calc + _ = TileCentroid (P 0 false) - + cOff (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3)) := by + have heq := hSleafOff + apply Prod.ext + · have hf := congrArg Prod.fst heq + dsimp [cOff] at hf ⊢ + linear_combination hf + · have hf := congrArg Prod.snd heq + dsimp [cOff] at hf ⊢ + linear_combination hf + _ = TileCentroid T - cOff W - + cOff (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3)) := by + have heq := hPminus + apply Prod.ext + · have hf := congrArg Prod.fst heq + dsimp [cOff] at hf ⊢ + linarith + · have hf := congrArg Prod.snd heq + dsimp [cOff] at hf ⊢ + linarith + +private theorem hP1centreAt851 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (T : ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (TileCentroid (P 1 false) - TileCentroid T = -cOff (BandVectors.1 (q 1) (q 3))) → + ((BandVectors.1 (q 1) (q 3) = -U - W) → (TileCentroid (P 1 false) = TileCentroid T - + cOff (-U - W))) ) := by + classical + intro q T P cOff U W hP1 hq13 + calc + _ = TileCentroid T - cOff (BandVectors.1 (q 1) (q 3)) := by + have heq := hP1 + apply Prod.ext + · have hf := congrArg Prod.fst heq + dsimp [cOff] at hf ⊢ + linear_combination hf + · have hf := congrArg Prod.snd heq + dsimp [cOff] at hf ⊢ + linear_combination hf + _ = TileCentroid T - cOff (-U - W) := by rw [hq13] + +private theorem htranslateCentAt864 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> ProtoTile), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -U - (1 + I) * W) → + (((-cOff W - cOff (U + I * W)) - (cOff W + cOff (-U - (1 + I) * W)) = (1 / 2 : Real) + • GaussianRealPoint (I * (W + I * W)) ∧ (cOff W + cOff (U + I * W)) - (-cOff W - cOff + (-U - (1 + I) * W)) = (1 / 2 : Real) • GaussianRealPoint ((I : GaussianInt) ^ (3 : + Nat) * (W + I * W)) ∧ cOff W + cOff (-U - (1 + I) * W) + GaussianRealPoint (I * W) = + cOff (-U - W) ∧ -cOff W - cOff (-U - (1 + I) * W) + GaussianRealPoint ((I : + GaussianInt) ^ (3 : Nat) * W) = -cOff (-U - W)) → ((TileCentroid (TileTranslation (S + 1 false) (I ^ (3 : Nat) * W)) = TileCentroid (S 1 false) + GaussianRealPoint (I ^ (3 + : Nat) * W)) → ((TileCentroid (S 1 false) = TileCentroid T - cOff W - cOff + (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3))) → ((TileCentroid + (P 1 false) = TileCentroid T - cOff (-U - W)) → (TileCentroid (TileTranslation (S 1 + false) (I ^ (3 : Nat) * W)) = TileCentroid (P 1 false)))))) ) := by + classical + intro q cfg T P S cOff I U W v13 centroidAlgebra hform' hScentre hP1centre + calc + _ = TileCentroid (S 1 false) + + GaussianRealPoint (I ^ (3 : Nat) * W) := hform' + _ = TileCentroid T - cOff W - + cOff (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3)) + + GaussianRealPoint (I ^ (3 : Nat) * W) := by rw [hScentre] + _ = TileCentroid T - cOff (-U - W) := by + rw [v13] + have h := centroidAlgebra.2.2.2 + apply Prod.ext + · have hf := congrArg Prod.fst h + dsimp [cOff] at hf ⊢ + linear_combination hf + · have hf := congrArg Prod.snd h + dsimp [cOff] at hf ⊢ + linear_combination hf + _ = TileCentroid (P 1 false) := hP1centre.symm + +private theorem hsumVAt899 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = I * BandVectors.1 (q (3 : + Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → (BandVectors.1 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = W + I * W) ) := by + classical + intro q cfg I W hflipV0 + rw [cfg.secondVectorOne, cfg.secondChild, cfg.secondParentOne, hflipV0] + +private theorem hsumAAt903 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = -I * BandVectors.2 (q (3 : + Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → (BandVectors.2 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = B - I * B) ) := by + classical + intro q cfg I B hflipA + rw [cfg.secondParentOne, cfg.secondChild, hflipA] + dsimp [B] + ring + +private theorem hcentTargetAt909 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (Q : + Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (TileCentroid (Q 2 true) - TileCentroid (S 1 false) = (1 / 2 : Real) • GaussianRealPoint + ((I : GaussianInt) ^ (3 : Nat) * (W + I * W))) → ((BandVectors.1 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.1 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) = W + I * W) → (TileCentroid (Q 2 + true) - TileCentroid (S 1 false) = (1 / 2 : Real) • GaussianRealPoint ((I : + GaussianInt) ^ (3 : Nat) * (BandVectors.1 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1))))) ) := by + classical + intro q cfg Q S I W hcentdiff hsumV + rw [hcentdiff, hsumV] + +private theorem hslopePairAt916 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + ∀ (pQ : ℝ × ℝ), ∀ (pS : ℝ × ℝ), (pQ - pS = (1 / 2 : Real) • GaussianRealPoint (((-I : + GaussianInt) ^ (3 : Nat)) * (B - I * B))) → ((BandVectors.2 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = B - I * B) → (pQ - pS = (1 / 2 : Real) • + GaussianRealPoint (((-I : GaussianInt) ^ (3 : Nat)) * (BandVectors.2 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.2 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1))))) ) := by + classical + intro q cfg I B pQ pS hslopeDiff hsumA + rw [hslopeDiff, hsumA] + +private theorem hadjAt922 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let I : GaussianInt := ⟨0, 1⟩ + ∀ (hpos2 : 0 < (q 2).1), ∀ (hpos3 : 0 < (q 3).1), + let C₂ : BandCircle := ⟨⟨q 2, + ⟨Or.inl hpos2, q, cfg.proper.1, ⟨2, rfl⟩⟩⟩, hpos2⟩ + let C₃ : BandCircle := ⟨⟨q 3, + ⟨Or.inl hpos3, q, cfg.proper.1, ⟨3, rfl⟩⟩⟩, hpos3⟩ + ∀ (pQ : ℝ × ℝ), (PartialOdometerSlope (u (2 : Fin (3 : ℕ)) true) = some pQ) → (∀ (pS : ℝ + × ℝ), (PartialOdometerSlope (v (1 : Fin (3 : ℕ)) false) = some pS) → ((TileCentroid + (Q 2 true) - TileCentroid (S 1 false) = (1 / 2 : Real) • GaussianRealPoint ((I : + GaussianInt) ^ (3 : Nat) * (BandVectors.1 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1)))) → ((pQ - pS = (1 / 2 : Real) • GaussianRealPoint (((-I : + GaussianInt) ^ (3 : Nat)) * (BandVectors.2 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1)))) → (SubtileLatticeAdjacent C₂ C₃ (S 1 false) (Q 2 true) + (v 1 false) (u 2 true)))))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data I hpos2 hpos3 C₂ C₃ pQ hQleafSlope pS hSleafSlope + hcentTarget hslopePair + refine ⟨?_, ?_, ⟨pS, pQ, hSleafSlope, hQleafSlope, ?_⟩⟩ + · simpa [C₂, cfg.firstParentTwo] using data.hS 1 false + · simpa [C₃, cfg.firstParentThree] using data.hQ 2 true + refine ⟨cfg.secondPredecessor, 0, 3, cfg.secondProper, ?_, ?_, + hcentTarget, ?_, ?_⟩ + · simpa [C₂] using cfg.secondChild + · simpa [C₃] using cfg.secondParentOne + · exact congrArg Prod.fst hslopePair + · exact congrArg Prod.snd hslopePair + +private theorem hxSAt945 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), + (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → ((x ∈ + FootprintVertices (cert.S (1 : Fin (3 : ℕ)) false)) → (x ∈ FootprintVertices (S 1 + false))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g x data right_mem + rw [(data.hobsS 1 false).2.1] + exact right_mem + +private theorem hxQAt948 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), + (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → ((x ∈ + FootprintVertices (cert.Q (2 : Fin (3 : ℕ)) true)) → (x ∈ FootprintVertices (Q 2 + true))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g x data left_mem + rw [(data.hobsQ 2 true).2.1] + exact left_mem + +private theorem hxVAt951 : + (by + classical + exact + ∀ (S : Fin 3 -> Bool -> ProtoTile), ∀ (v : Fin 3 -> Bool -> PartialOdometer), ∀ (x : + GaussianInt), ((↑(v (1 : Fin (3 : ℕ)) false).domain : Set GaussianInt) = + FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → ((x ∈ FootprintVertices (S 1 false)) + → (x ∈ (v 1 false).domain)) ) := by + classical + intro S v x hSdom hxS + change x ∈ ((v 1 false).domain : Set GaussianInt) + rw [hSdom] + exact hxS + +private theorem hxUAt955 : + (by + classical + exact + ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (x : + GaussianInt), ((↑(u (2 : Fin (3 : ℕ)) true).domain : Set GaussianInt) = + FootprintVertices (Q (2 : Fin (3 : ℕ)) true)) → ((x ∈ FootprintVertices (Q 2 true)) → + (x ∈ (u 2 true).domain)) ) := by + classical + intro Q u x hQdom hxQ + change x ∈ ((u 2 true).domain : Set GaussianInt) + rw [hQdom] + exact hxQ + +private theorem hstarAt959 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), + (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → ((∀ (y : + GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ + FootprintVertices (cert.Q (2 : Fin (3 : ℕ)) true) ∨ y ∈ FootprintVertices (cert.S (1 + : Fin (3 : ℕ)) false)) → (((↑(v (1 : Fin (3 : ℕ)) false).domain : Set GaussianInt) = + FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → (((↑(u (2 : Fin (3 : ℕ)) + true).domain : Set GaussianInt) = FootprintVertices (Q (2 : Fin (3 : ℕ)) true)) → (∀ + y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ (v 1 + false).domain ∨ y ∈ (u 2 true).domain)))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g x data star hSdom hQdom y hy + rcases star y hy with hq | hs + · right + change y ∈ ((u 2 true).domain : Set GaussianInt) + rw [hQdom] + rw [(data.hobsQ 2 true).2.1] + exact hq + · left + change y ∈ ((v 1 false).domain : Set GaussianInt) + rw [hSdom] + rw [(data.hobsS 1 false).2.1] + exact hs + +private theorem hcompFootAt990 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let I : GaussianInt := ⟨0, 1⟩ + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (FootprintVertices (TileTranslation (S (1 : Fin (3 : ℕ)) false) (I ^ (3 : ℕ) * W)) = + FootprintVertices (P (1 : Fin (3 : ℕ)) false) ∧ BoundaryFootprintVertices + (TileTranslation (S (1 : Fin (3 : ℕ)) false) (I ^ (3 : ℕ) * W)) = + BoundaryFootprintVertices (P (1 : Fin (3 : ℕ)) false) ∧ BoundaryFootprintEdges + (TileTranslation (S (1 : Fin (3 : ℕ)) false) (I ^ (3 : ℕ) * W)) = + BoundaryFootprintEdges (P (1 : Fin (3 : ℕ)) false) ∧ TileRealization (TileTranslation + (S (1 : Fin (3 : ℕ)) false) (I ^ (3 : ℕ) * W)) = TileRealization (P (1 : Fin (3 : ℕ)) + false) ∧ TileCentroid (TileTranslation (S (1 : Fin (3 : ℕ)) false) (I ^ (3 : ℕ) * W)) + = TileCentroid (P (1 : Fin (3 : ℕ)) false)) → (FootprintVertices (TileTranslation (S + 1 false) (I ^ (3 : Nat) * W)) = FootprintVertices (cert.P 1 false))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data I W hcompObs + calc + _ = FootprintVertices (P 1 false) := hcompObs.1 + _ = FootprintVertices (cert.P 1 false) := (data.hobsP 1 false).2.1 + +private theorem hmarkAt996 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (S : Fin 3 -> Bool -> ProtoTile), ∀ (x : GaussianInt), ∀ (marked : Bool), + let I : GaussianInt := ⟨0, 1⟩ + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (x ∈ FootprintVertices (cert.P (1 : Fin (3 : ℕ)) false) ↔ marked = true) → + ((FootprintVertices (TileTranslation (S 1 false) (I ^ (3 : Nat) * W)) = + FootprintVertices (cert.P 1 false)) → (x ∈ FootprintVertices (TileTranslation (S 1 + false) (I ^ (3 : Nat) * W)) ↔ marked = true)) ) := by + classical + intro q cfg C0 T cert S x marked I W companion hcompFoot + rw [hcompFoot] + exact companion + +end LargestParentOdometerGeometry + +namespace LargestOdometerConclusions + +private theorem positiveLargestCase : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), ∀ (marked : + Bool), (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → (∀ + (row : BandOrderedGeneralInteriorWebRow cert x marked), (∀ (c : + CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), TileOdometer c U + k → BandPrototile c U) → ( + (BandVectors.1 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 + : ℕ))) = BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → + ((BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : + Fin (4 : ℕ))) = BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) - (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : + ℕ)))) → ((BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) + (cfg.firstPredecessor (3 : Fin (4 : ℕ))) = -BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 + : Fin (4 : ℕ))) - ((1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → ((BandVectors.2 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))) = + -BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) - ((1 : GaussianInt) - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin + (4 : ℕ)))) → (( + let cOff := fun (z : GaussianInt) => (1 / 2 : ℝ) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)); + let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); + let U := BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let W := BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); -cOff W - cOff (U + I + * W) - (cOff W + cOff (-U - ((1 : GaussianInt) + I) * W)) = (1 / 2 : ℝ) • + GaussianRealPoint (I * (W + I * W)) ∧ cOff W + cOff (U + I * W) - (-cOff W - cOff (-U + - ((1 : GaussianInt) + I) * W)) = (1 / 2 : ℝ) • GaussianRealPoint (I ^ (3 : ℕ) * (W + + I * W)) ∧ cOff W + cOff (-U - ((1 : GaussianInt) + I) * W) + GaussianRealPoint (I * + W) = cOff (-U - W) ∧ -cOff W - cOff (-U - ((1 : GaussianInt) + I) * W) + + GaussianRealPoint (I ^ (3 : ℕ) * W) = -cOff (-U - W)) → (( + let sOff := fun (z : GaussianInt) => (1 / 2 : ℝ) • ((↑z.re : ℝ) - (↑z.im : ℝ), (↑z.im : + ℝ) + (↑z.re : ℝ)); + let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); + let A := BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let B := BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); -sOff B - sOff (A - I + * B) - (sOff B + sOff (-A - ((1 : GaussianInt) - I) * B)) = (1 / 2 : ℝ) • + GaussianRealPoint (-I * (B - I * B)) ∧ sOff B + sOff (A - I * B) - (-sOff B - sOff + (-A - ((1 : GaussianInt) - I) * B)) = (1 / 2 : ℝ) • GaussianRealPoint ((-I) ^ (3 : ℕ) + * (B - I * B))) → (((0 : ℤ) < (q (2 : Fin (4 : ℕ))).1) → (((0 : ℤ) + < (q (3 : Fin (4 : ℕ))).1) → (((exists (left_mem : x ∈ FootprintVertices (cert.Q 1 + true)) (right_mem : x ∈ + FootprintVertices (cert.S 2 false)) (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 + \/ y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> y ∈ FootprintVertices (cert.Q 1 true) \/ y ∈ + FootprintVertices (cert.S 2 false)) (companion : x ∈ FootprintVertices (cert.P 1 + true) <-> marked = true), row = .largestPositive left_mem right_mem star companion)) + → (((exists (left_mem : x ∈ FootprintVertices (cert.Q 1 true)) (right_mem : x ∈ + FootprintVertices (cert.S 2 false)) (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 + \/ y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> y ∈ FootprintVertices (cert.Q 1 true) \/ y ∈ + FootprintVertices (cert.S 2 false)) (companion : x ∈ FootprintVertices (cert.P 1 + true) <-> marked = true), row = .largestPositive left_mem right_mem star companion)) + → ((marked = true -> FourNeighborLaplacian g x = 0) /\ (marked = false -> + FourNeighborLaplacian g x = 1)))))))))))))) := by + classical + intro q cfg C0 T cert h P r Q S u v g x marked data row band_of_odo v21 a21 v13 a13 + centroidAlgebra slopeAlgebra hpos2 hpos3 leftCase positiveRow + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + let C₂ : BandCircle := ⟨⟨q 2, + ⟨Or.inl hpos2, q, cfg.proper.1, ⟨2, rfl⟩⟩⟩, hpos2⟩ + let C₃ : BandCircle := ⟨⟨q 3, + ⟨Or.inl hpos3, q, cfg.proper.1, ⟨3, rfl⟩⟩⟩, hpos3⟩ + rcases positiveRow with ⟨left_mem, right_mem, star, companion, rfl⟩ + have bq : BandPrototile (cfg.firstPredecessor 2) (Q 1 true) := + band_of_odo _ _ _ (data.hQ 1 true) + have bs : BandPrototile (cfg.firstPredecessor 3) (S 2 false) := + band_of_odo _ _ _ (data.hS 2 false) + have bp : BandPrototile (q 2) (P 1 true) := by + simpa [cfg.firstParentTwo] using band_of_odo _ _ _ (data.hP 1 true) + have hc := data.hQcent 1 true + have hs := data.hScent 2 false + have hQleaf := LargestParentOdometerGeometry.hQleafAt284 q cfg C0 T cert h P r Q S u v g data + have hSleaf := LargestParentOdometerGeometry.hSleafAt293 q cfg C0 T cert h P r Q S u v g data + have hQleafOff := LargestParentOdometerGeometry.hQleafOffAt302 q cfg P Q hQleaf + have hSleafOff := LargestParentOdometerGeometry.hSleafOffAt305 q cfg P S hSleaf + have hPplus : TileCentroid (P 0 true) - TileCentroid T = cOff W := by + simpa [cOff, Fin.add_def, W] using data.hPcent 0 true + have hPminus : TileCentroid (P 0 false) - TileCentroid T = -cOff W := by + simpa [cOff, Fin.add_def, W] using data.hPcent 0 false + have hcentdiff := LargestParentOdometerGeometry.hcentdiffAt312 q cfg T P Q S v21 v13 + centroidAlgebra hQleafOff hSleafOff hPplus hPminus + have hQpack := LargestParentOdometerGeometry.hQpackAt326 q cfg C0 T cert h P r Q S u v g data + have hSpack := LargestParentOdometerGeometry.hSpackAt345 q cfg C0 T cert h P r Q S u v g data + have hPplusPack := LargestParentOdometerGeometry.hPplusPackAt364 q cfg C0 T cert h P r Q S u + v g data + have hPminusPack := LargestParentOdometerGeometry.hPminusPackAt375 q cfg C0 T cert h P r Q S + u v g data + obtain ⟨pQroot, pQ, hQroot, hQleafSlope, hQre, hQim⟩ := hQpack + obtain ⟨pSroot, pS, hSroot, hSleafSlope, hSre, hSim⟩ := hSpack + obtain ⟨pRoot, pPplus, hRoot, hPplusSlope, hPplusRe, hPplusIm⟩ := + hPplusPack + obtain ⟨pRoot', pPminus, hRoot', hPminusSlope, + hPminusRe, hPminusIm⟩ := hPminusPack + have hQalign : pQroot = pPplus := + Option.some.inj (hQroot.symm.trans hPplusSlope) + have hSalign : pSroot = pPminus := + Option.some.inj (hSroot.symm.trans hPminusSlope) + have hrootAlign : pRoot = pRoot' := + Option.some.inj (hRoot.symm.trans hRoot') + have hQdelta := LargestParentOdometerGeometry.hQdeltaAt398 q cfg pQroot pQ hQre hQim + have hSdelta := LargestParentOdometerGeometry.hSdeltaAt405 q cfg pSroot pS hSre hSim + have hPplusDelta := LargestParentOdometerGeometry.hPplusDeltaAt412 q pRoot pPplus hPplusRe + hPplusIm + have hPminusDelta := LargestParentOdometerGeometry.hPminusDeltaAt418 q pRoot' pPminus + hPminusRe hPminusIm + have hslopeDiff := LargestParentOdometerGeometry.hslopeDiffAt427 q cfg a21 a13 slopeAlgebra + pQroot pQ pSroot pS pPplus pRoot' pPminus hQalign hSalign hQdelta hSdelta hPminusDelta + (LargestParentOdometerGeometry.hPplusDelta' q pRoot pPplus pRoot' hrootAlign hPplusDelta) + have hP1 := LargestParentOdometerGeometry.hP1At441 q cfg C0 T cert h P r Q S u v g data + have hq13 := LargestParentOdometerGeometry.hq13At444 q cfg + have htranslateCent := LargestParentOdometerGeometry.htranslateCentAt448 q cfg T P Q v13 + centroidAlgebra hQleafOff hPplus hP1 hq13 + have hflipV := + (VectorRecursionLaws cfg.secondPredecessor cfg.secondProper.1).2.2.2.2 + cfg.secondProper + have hflipA := (hflipV 0).2 + have hflipV0 := (hflipV 0).1 + change BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = I * + BandVectors.1 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) at hflipV0 + change BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = -I * + BandVectors.2 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) at hflipA + rw [cfg.secondChild, cfg.secondParentOne] at hflipV0 hflipA + have hsumV := LargestParentOdometerGeometry.hsumVAt525 q cfg hflipV0 + have hsumA := LargestParentOdometerGeometry.hsumAAt529 q cfg hflipA + have hcentTarget := LargestParentOdometerGeometry.hcentTargetAt535 q cfg Q S hcentdiff hsumV + have hslopePair := LargestParentOdometerGeometry.hslopePairAt543 q cfg pQ pS hslopeDiff hsumA + have hadj := LargestParentOdometerGeometry.hadjAt550 q cfg C0 T cert h P r Q S u v g data + hpos2 hpos3 pQ hQleafSlope pS hSleafSlope hcentTarget hslopePair + have hcompat : OdometerCompatibility (u 1 true) (v 2 false) := + data.hcompat (u 1 true) (v 2 false) + ⟨1, true, Or.inr (Or.inl rfl)⟩ + ⟨2, false, Or.inr (Or.inr rfl)⟩ + have hQodo : TileOdometer (q 2) (Q 1 true) (u 1 true) := by + simpa [cfg.firstParentTwo] using data.hQ 1 true + have hSodo : TileOdometer (q 3) (S 2 false) (v 2 false) := by + simpa [cfg.firstParentThree] using data.hS 2 false + have hQdom := PositiveCurvatureTileOdometerDomain + (q 2) (Q 1 true) (u 1 true) hpos2 hQodo + have hSdom := PositiveCurvatureTileOdometerDomain + (q 3) (S 2 false) (v 2 false) hpos3 hSodo + have hxQ := LargestParentOdometerGeometry.hxQAt573 q cfg C0 T cert h P r Q S u v g x data + left_mem + have hxS := LargestParentOdometerGeometry.hxSAt576 q cfg C0 T cert h P r Q S u v g x data + right_mem + have hxU := LargestParentOdometerGeometry.hxUAt579 Q u x hQdom hxQ + have hxV := LargestParentOdometerGeometry.hxVAt583 S v x hSdom hxS + have hstar := LargestParentOdometerGeometry.hstarAt587 q cfg C0 T cert h P r Q S u v g x data + star hQdom hSdom + have hweb := (OdometerWeb).2 C₂ C₃ cfg.secondPredecessor 0 1 + (Q 1 true) (S 2 false) (u 1 true) (v 2 false) g x pQ pS + cfg.secondProper (by simpa [C₂] using cfg.secondChild) + (by simpa [C₃] using cfg.secondParentOne) + hQleafSlope hSleafSlope hcentTarget + (congrArg Prod.fst hslopePair) (congrArg Prod.snd hslopePair) + hadj hcompat (data.hextQ 1 true) (data.hextS 2 false) hxU hxV hstar + have bq2 : BandPrototile (q 2) (Q 1 true) := by + simpa [cfg.firstParentTwo] using bq + have hcompUnique := BandPrototileCentroidUnique (q 2) + (TileTranslation (Q 1 true) (I * W)) (P 1 true) + (BandPrototileTranslation (q 2) (Q 1 true) (I * W) bq2) bp + htranslateCent + have hcompObs := ProtoTileObservableExtensionality + (TileTranslation (Q 1 true) (I * W)) (P 1 true) + hcompUnique.1 hcompUnique.2 + have hcompFoot := LargestParentOdometerGeometry.hcompFootAt618 q cfg C0 T cert h P r Q S u v + g data hcompObs + have hmark := LargestParentOdometerGeometry.hmarkAt623 q cfg C0 T cert Q x marked companion + hcompFoot + constructor + · intro hm + apply (by simpa [I, W, cfg.secondVectorOne] using hweb.1) + exact hmark.mpr hm + · intro hm + apply (by simpa [I, W, cfg.secondVectorOne] using hweb.2) + intro ht + have htrue := hmark.mp ht + cases marked with + | false => cases htrue + | true => cases hm + +private theorem reflectedLargestCase : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), ∀ (marked : + Bool), (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → (∀ + (row : BandOrderedGeneralInteriorWebRow cert x marked), (∀ (c : + CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), TileOdometer c U + k → BandPrototile c U) → ( + (BandVectors.1 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 + : ℕ))) = BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → + ((BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : + Fin (4 : ℕ))) = BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) - (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : + ℕ)))) → ((BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) + (cfg.firstPredecessor (3 : Fin (4 : ℕ))) = -BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 + : Fin (4 : ℕ))) - ((1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → ((BandVectors.2 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))) = + -BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) - ((1 : GaussianInt) - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin + (4 : ℕ)))) → (( + let cOff := fun (z : GaussianInt) => (1 / 2 : ℝ) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)); + let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); + let U := BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let W := BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); -cOff W - cOff (U + I + * W) - (cOff W + cOff (-U - ((1 : GaussianInt) + I) * W)) = (1 / 2 : ℝ) • + GaussianRealPoint (I * (W + I * W)) ∧ cOff W + cOff (U + I * W) - (-cOff W - cOff (-U + - ((1 : GaussianInt) + I) * W)) = (1 / 2 : ℝ) • GaussianRealPoint (I ^ (3 : ℕ) * (W + + I * W)) ∧ cOff W + cOff (-U - ((1 : GaussianInt) + I) * W) + GaussianRealPoint (I * + W) = cOff (-U - W) ∧ -cOff W - cOff (-U - ((1 : GaussianInt) + I) * W) + + GaussianRealPoint (I ^ (3 : ℕ) * W) = -cOff (-U - W)) → (( + let sOff := fun (z : GaussianInt) => (1 / 2 : ℝ) • ((↑z.re : ℝ) - (↑z.im : ℝ), (↑z.im : + ℝ) + (↑z.re : ℝ)); + let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); + let A := BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let B := BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); -sOff B - sOff (A - I + * B) - (sOff B + sOff (-A - ((1 : GaussianInt) - I) * B)) = (1 / 2 : ℝ) • + GaussianRealPoint (-I * (B - I * B)) ∧ sOff B + sOff (A - I * B) - (-sOff B - sOff + (-A - ((1 : GaussianInt) - I) * B)) = (1 / 2 : ℝ) • GaussianRealPoint ((-I) ^ (3 : ℕ) + * (B - I * B))) → (((0 : ℤ) < (q (2 : Fin (4 : ℕ))).1) → (((0 : ℤ) + < (q (3 : Fin (4 : ℕ))).1) → (((exists (left_mem : x ∈ FootprintVertices (cert.Q 2 + true)) (right_mem : x ∈ + FootprintVertices (cert.S 1 false)) (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 + \/ y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> y ∈ FootprintVertices (cert.Q 2 true) \/ y ∈ + FootprintVertices (cert.S 1 false)) (companion : x ∈ FootprintVertices (cert.P 1 + false) <-> marked = true), row = .largestReflected left_mem right_mem star + companion)) → (((exists (left_mem : x ∈ FootprintVertices (cert.Q 2 true)) (right_mem + : x ∈ FootprintVertices (cert.S 1 false)) (star : forall y, y = x \/ y = x + 1 \/ y = + x - 1 \/ y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> y ∈ FootprintVertices (cert.Q 2 true) \/ + y ∈ FootprintVertices (cert.S 1 false)) (companion : x ∈ FootprintVertices (cert.P 1 + false) <-> marked = true), row = .largestReflected left_mem right_mem star + companion)) → ((marked = true -> FourNeighborLaplacian g x = 0) /\ (marked = false -> + FourNeighborLaplacian g x = 1)))))))))))))) := by + classical + intro q cfg C0 T cert h P r Q S u v g x marked data row band_of_odo v21 a21 v13 a13 + centroidAlgebra slopeAlgebra hpos2 hpos3 rightCase reflectedRow + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + let C₂ : BandCircle := ⟨⟨q 2, + ⟨Or.inl hpos2, q, cfg.proper.1, ⟨2, rfl⟩⟩⟩, hpos2⟩ + let C₃ : BandCircle := ⟨⟨q 3, + ⟨Or.inl hpos3, q, cfg.proper.1, ⟨3, rfl⟩⟩⟩, hpos3⟩ + rcases reflectedRow with ⟨left_mem, right_mem, star, companion, rfl⟩ + have bq : BandPrototile (cfg.firstPredecessor 3) (Q 2 true) := + band_of_odo _ _ _ (data.hQ 2 true) + have bs : BandPrototile (cfg.firstPredecessor 2) (S 1 false) := + band_of_odo _ _ _ (data.hS 1 false) + have bp : BandPrototile (q 2) (P 1 false) := by + simpa [cfg.firstParentTwo] using band_of_odo _ _ _ (data.hP 1 false) + have hc := data.hQcent 2 true + have hs := data.hScent 1 false + have hQleaf := LargestParentOdometerGeometry.hQleafAt647 q cfg C0 T cert h P r Q S u v g data + have hSleaf := LargestParentOdometerGeometry.hSleafAt656 q cfg C0 T cert h P r Q S u v g data + have hQleafOff := LargestParentOdometerGeometry.hQleafOffAt665 q cfg P Q hQleaf + have hSleafOff := LargestParentOdometerGeometry.hSleafOffAt669 q cfg P S hSleaf + have hPplus : TileCentroid (P 0 true) - TileCentroid T = cOff W := by + simpa [cOff, Fin.add_def, W] using data.hPcent 0 true + have hPminus : TileCentroid (P 0 false) - TileCentroid T = -cOff W := by + simpa [cOff, Fin.add_def, W] using data.hPcent 0 false + have hcentdiff := LargestParentOdometerGeometry.hcentdiffAt677 q cfg T P Q S v21 v13 + centroidAlgebra hQleafOff hSleafOff hPplus hPminus + have hQpack := LargestParentOdometerGeometry.hQpackAt693 q cfg C0 T cert h P r Q S u v g data + have hSpack := LargestParentOdometerGeometry.hSpackAt712 q cfg C0 T cert h P r Q S u v g data + have hPplusPack := LargestParentOdometerGeometry.hPplusPackAt731 q cfg C0 T cert h P r Q S u + v g data + have hPminusPack := LargestParentOdometerGeometry.hPminusPackAt742 q cfg C0 T cert h P r Q S + u v g data + obtain ⟨pQroot, pQ, hQroot, hQleafSlope, hQre, hQim⟩ := hQpack + obtain ⟨pSroot, pS, hSroot, hSleafSlope, hSre, hSim⟩ := hSpack + obtain ⟨pRoot, pPplus, hRoot, hPplusSlope, hPplusRe, hPplusIm⟩ := + hPplusPack + obtain ⟨pRoot', pPminus, hRoot', hPminusSlope, + hPminusRe, hPminusIm⟩ := hPminusPack + have hQalign : pQroot = pPplus := + Option.some.inj (hQroot.symm.trans hPplusSlope) + have hSalign : pSroot = pPminus := + Option.some.inj (hSroot.symm.trans hPminusSlope) + have hrootAlign : pRoot = pRoot' := + Option.some.inj (hRoot.symm.trans hRoot') + have hQdelta := LargestParentOdometerGeometry.hQdeltaAt765 q cfg pQroot pQ hQre hQim + have hSdelta := LargestParentOdometerGeometry.hSdeltaAt772 q cfg pSroot pS hSre hSim + have hPplusDelta := LargestParentOdometerGeometry.hPplusDeltaAt779 q pRoot pPplus hPplusRe + hPplusIm + have hPminusDelta := LargestParentOdometerGeometry.hPminusDeltaAt785 q pRoot' pPminus + hPminusRe hPminusIm + have hslopeDiff := LargestParentOdometerGeometry.hslopeDiffAt794 q cfg a21 a13 slopeAlgebra + pQroot pQ pSroot pS pRoot pPplus pPminus hQalign hSalign hQdelta hSdelta hPplusDelta + (LargestParentOdometerGeometry.hPminusDelta' q pRoot pRoot' pPminus hrootAlign + hPminusDelta) + have hP1 := LargestParentOdometerGeometry.hP1At810 q cfg C0 T cert h P r Q S u v g data + have hq13 := LargestParentOdometerGeometry.hq13At813 q cfg + have hform := (TileTranslationFormulas (S 1 false) + (((I : GaussianInt) ^ (3 : Nat)) * W)).2.2.2.2.1 + have htranslateCent := LargestParentOdometerGeometry.htranslateCentAt864 q cfg T P S v13 + centroidAlgebra (LargestParentOdometerGeometry.hform'At819 q S hform) + (LargestParentOdometerGeometry.hScentre q cfg T P S hSleafOff hPminus) + (LargestParentOdometerGeometry.hP1centreAt851 q T P hP1 hq13) + have hflipV := + (VectorRecursionLaws cfg.secondPredecessor cfg.secondProper.1).2.2.2.2 + cfg.secondProper + have hflipV0 := (hflipV 0).1 + have hflipA := (hflipV 0).2 + change BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = I * + BandVectors.1 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) at hflipV0 + change BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = -I * + BandVectors.2 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) at hflipA + rw [cfg.secondChild, cfg.secondParentOne] at hflipV0 hflipA + have hsumV := LargestParentOdometerGeometry.hsumVAt899 q cfg hflipV0 + have hsumA := LargestParentOdometerGeometry.hsumAAt903 q cfg hflipA + have hcentTarget := LargestParentOdometerGeometry.hcentTargetAt909 q cfg Q S hcentdiff hsumV + have hslopePair := LargestParentOdometerGeometry.hslopePairAt916 q cfg pQ pS hslopeDiff hsumA + have hadj := LargestParentOdometerGeometry.hadjAt922 q cfg C0 T cert h P r Q S u v g data + hpos2 hpos3 pQ hQleafSlope pS hSleafSlope hcentTarget hslopePair + have hcompat : OdometerCompatibility (v 1 false) (u 2 true) := + data.hcompat (v 1 false) (u 2 true) + ⟨1, false, Or.inr (Or.inr rfl)⟩ + ⟨2, true, Or.inr (Or.inl rfl)⟩ + have hSodo : TileOdometer (q 2) (S 1 false) (v 1 false) := by + simpa [cfg.firstParentTwo] using data.hS 1 false + have hQodo : TileOdometer (q 3) (Q 2 true) (u 2 true) := by + simpa [cfg.firstParentThree] using data.hQ 2 true + have hSdom := PositiveCurvatureTileOdometerDomain + (q 2) (S 1 false) (v 1 false) hpos2 hSodo + have hQdom := PositiveCurvatureTileOdometerDomain + (q 3) (Q 2 true) (u 2 true) hpos3 hQodo + have hxS := LargestParentOdometerGeometry.hxSAt945 q cfg C0 T cert h P r Q S u v g x data + right_mem + have hxQ := LargestParentOdometerGeometry.hxQAt948 q cfg C0 T cert h P r Q S u v g x data + left_mem + have hxV := LargestParentOdometerGeometry.hxVAt951 S v x hSdom hxS + have hxU := LargestParentOdometerGeometry.hxUAt955 Q u x hQdom hxQ + have hstar := LargestParentOdometerGeometry.hstarAt959 q cfg C0 T cert h P r Q S u v g x data + star hSdom hQdom + have hweb := (OdometerWeb).2 C₂ C₃ cfg.secondPredecessor 0 3 + (S 1 false) (Q 2 true) (v 1 false) (u 2 true) g x pS pQ + cfg.secondProper (by simpa [C₂] using cfg.secondChild) + (by simpa [C₃] using cfg.secondParentOne) + hSleafSlope hQleafSlope hcentTarget + (congrArg Prod.fst hslopePair) (congrArg Prod.snd hslopePair) + hadj hcompat (data.hextS 1 false) (data.hextQ 2 true) hxV hxU hstar + have bs2 : BandPrototile (q 2) (S 1 false) := by + simpa [cfg.firstParentTwo] using bs + have hcompUnique := BandPrototileCentroidUnique (q 2) + (TileTranslation (S 1 false) (I ^ (3 : Nat) * W)) (P 1 false) + (BandPrototileTranslation (q 2) (S 1 false) (I ^ (3 : Nat) * W) bs2) + bp htranslateCent + have hcompObs := ProtoTileObservableExtensionality + (TileTranslation (S 1 false) (I ^ (3 : Nat) * W)) (P 1 false) + hcompUnique.1 hcompUnique.2 + have hcompFoot := LargestParentOdometerGeometry.hcompFootAt990 q cfg C0 T cert h P r Q S u v + g data hcompObs + have hmark := LargestParentOdometerGeometry.hmarkAt996 q cfg C0 T cert S x marked companion + hcompFoot + constructor + · intro hm + apply (by simpa [I, W, cfg.secondVectorOne] using hweb.1) + exact hmark.mpr hm + · intro hm + apply (by simpa [I, W, cfg.secondVectorOne] using hweb.2) + intro ht + have htrue := hmark.mp ht + cases marked with + | false => cases htrue + | true => cases hm + +end LargestOdometerConclusions + +theorem BandOrderedGeneralLargestParentOdometerRows + (q : Fin 4 -> CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C0 : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C0 T) + (h : PartialOdometer) + (P : Fin 3 -> Bool -> ProtoTile) + (r : Fin 3 -> Bool -> PartialOdometer) + (Q S : Fin 3 -> Bool -> ProtoTile) + (u v : Fin 3 -> Bool -> PartialOdometer) + (g : IntegerLatticeFunction) (x : GaussianInt) (marked : Bool) + (data : BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) + (row : BandOrderedGeneralInteriorWebRow cert x marked) + (largest : + (exists + (left_mem : x ∈ FootprintVertices (cert.Q 1 true)) + (right_mem : x ∈ FootprintVertices (cert.S 2 false)) + (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ FootprintVertices (cert.Q 1 true) \/ + y ∈ FootprintVertices (cert.S 2 false)) + (companion : x ∈ FootprintVertices (cert.P 1 true) <-> + marked = true), + row = .largestPositive left_mem right_mem star companion) \/ + (exists + (left_mem : x ∈ FootprintVertices (cert.Q 2 true)) + (right_mem : x ∈ FootprintVertices (cert.S 1 false)) + (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ FootprintVertices (cert.Q 2 true) \/ + y ∈ FootprintVertices (cert.S 1 false)) + (companion : x ∈ FootprintVertices (cert.P 1 false) <-> + marked = true), + row = .largestReflected left_mem right_mem star companion)) : + (marked = true -> FourNeighborLaplacian g x = 0) /\ + (marked = false -> FourNeighborLaplacian g x = 1) := by +-- BODY + classical + have band_of_odo := LargestParentOdometerGeometry.band_of_odo + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + have v21 := LargestParentOdometerGeometry.v21 q cfg (LargestParentOdometerGeometry.firstRotateV + q cfg) + have a21 := LargestParentOdometerGeometry.a21 q cfg (LargestParentOdometerGeometry.firstRotateA + q cfg) + have v13 := LargestParentOdometerGeometry.v13 q cfg v21 + have a13 := LargestParentOdometerGeometry.a13 q cfg a21 + have centroidAlgebra := LargestParentOdometerGeometry.centroidAlgebra q + have slopeAlgebra := LargestParentOdometerGeometry.slopeAlgebra q + have hpos2 := LargestParentOdometerGeometry.hpos2 q cfg + have hpos3 := LargestParentOdometerGeometry.hpos3 q cfg + let C₂ : BandCircle := ⟨⟨q 2, + ⟨Or.inl hpos2, q, cfg.proper.1, ⟨2, rfl⟩⟩⟩, hpos2⟩ + let C₃ : BandCircle := ⟨⟨q 3, + ⟨Or.inl hpos3, q, cfg.proper.1, ⟨3, rfl⟩⟩⟩, hpos3⟩ + rcases largest with leftCase | rightCase + · have positiveRow : + (exists + (left_mem : x ∈ FootprintVertices (cert.Q 1 true)) + (right_mem : x ∈ FootprintVertices (cert.S 2 false)) + (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ FootprintVertices (cert.Q 1 true) \/ + y ∈ FootprintVertices (cert.S 2 false)) + (companion : x ∈ FootprintVertices (cert.P 1 true) <-> + marked = true), + row = .largestPositive left_mem right_mem star companion) := leftCase + exact (LargestOdometerConclusions.positiveLargestCase q cfg C0 T cert h P r Q S u v g x + marked data row band_of_odo v21 a21 v13 a13 centroidAlgebra slopeAlgebra hpos2 hpos3 + leftCase positiveRow) + · have reflectedRow : + (exists + (left_mem : x ∈ FootprintVertices (cert.Q 2 true)) + (right_mem : x ∈ FootprintVertices (cert.S 1 false)) + (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ FootprintVertices (cert.Q 2 true) \/ + y ∈ FootprintVertices (cert.S 1 false)) + (companion : x ∈ FootprintVertices (cert.P 1 false) <-> + marked = true), + row = .largestReflected left_mem right_mem star companion) := rightCase + exact (LargestOdometerConclusions.reflectedLargestCase q cfg C0 T cert h P r Q S u v g x + marked data row band_of_odo v21 a21 v13 a13 centroidAlgebra slopeAlgebra hpos2 hpos3 + rightCase reflectedRow) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean new file mode 100644 index 0000000000..426515017c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean @@ -0,0 +1,1149 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandDoubleDecomposition +public import LeanPool.ApollonianSuperharmonic.BandModifiedCoverage +public import LeanPool.ApollonianSuperharmonic.BandModifiedOrbitArea +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPrototileReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn +public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedPeriodicCore +public import LeanPool.ApollonianSuperharmonic.ExceptionalModifiedABPath +public import LeanPool.ApollonianSuperharmonic.IsolatedPrecursorCoverage +public import LeanPool.ApollonianSuperharmonic.OrientedTouchingCovariance +public import LeanPool.ApollonianSuperharmonic.OuterLayoutTouching +public import LeanPool.ApollonianSuperharmonic.P4670T1SmallerGeometry +public import LeanPool.ApollonianSuperharmonic.P4670T1ComplementReflection +public import LeanPool.ApollonianSuperharmonic.P4670T1OrdinaryEdges +public import LeanPool.ApollonianSuperharmonic.P4638T1EmptyFordLocalization + +-- [TABLET NODE: BandOrderedGeneralLayout] + +/-! +# BandOrderedGeneralLayout + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OrderedLayoutGeometry + +private theorem hPr : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), BandSubtileOccurrence q T i s (P i s)) → (∀ (s : Bool), BandPrototile + (cfg.firstPredecessor 0) (P 0 s)) ) := by + classical + intro q cfg T P hP s + rw [cfg.firstChild] + exact (hP 0 s).1 + +private theorem hQcells : + (by + classical + exact + ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (x : + LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), + x ∈ (Q i s).cells) → (∀ (i : Fin 3), ∀ (s : Bool), (Q i s).cells ⊆ (P 0 true).cells) + ) := by + classical + intro P Q hQunion i s x hx + exact (hQunion x).mpr ⟨i, s, hx⟩ + +private theorem hScells : + (by + classical + exact + ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (x : + LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), + x ∈ (S i s).cells) → (∀ (i : Fin 3), ∀ (s : Bool), (S i s).cells ⊆ (P 0 false).cells) + ) := by + classical + intro P S hSunion i s x hx + exact (hSunion x).mpr ⟨i, s, hx⟩ + +private theorem pne : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((∀ (i : Fin 3), + 0 < (q i.succ).1) → (∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : + Bool), TileArea (P i s) = (q i.succ).1.toNat) → (∀ (i : Fin 3), ∀ (s : Bool), (P i + s).cells.Nonempty))) ) := by + classical + intro q cfg parentPos P parea i s + have ha := parea i s + have hp := parentPos i + change (P i s).cells.card = _ at ha + exact Finset.card_pos.mp (by omega) + +private theorem rpPos : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), (∀ (i : + Fin 3), 0 < (q i.succ).1) → (∀ (i : Fin 3), (i = 1 ∨ i = 2) → (0 < + (cfg.firstPredecessor i.succ).1)) ) := by + classical + intro q cfg parentPos i hi + rcases hi with rfl | rfl + · simpa [cfg.firstParentTwo] using parentPos 1 + · simpa [cfg.firstParentThree] using parentPos 2 + +private theorem qne : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (Q : + Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (0 : ℤ) ≤ + (cfg.firstPredecessor i.succ).1 ∧ TileArea (Q i s) = (cfg.firstPredecessor + i.succ).1.toNat ∧ ((0 : ℤ) < (cfg.firstPredecessor i.succ).1 → LatticeTile (Q i s))) + → ((∀ (i : Fin 3), (i = 1 ∨ i = 2) → (0 < (cfg.firstPredecessor i.succ).1)) → (∀ (i : + Fin 3), ∀ (s : Bool), (i = 1 ∨ i = 2) → ((Q i s).cells.Nonempty))) ) := by + classical + intro q cfg Q qg rpPos i s hi + have ha := (qg i s).2.1 + have hp := rpPos i hi + change (Q i s).cells.card = _ at ha + exact Finset.card_pos.mp (by omega) + +private theorem sne : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (S : + Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (0 : ℤ) ≤ + (cfg.firstPredecessor i.succ).1 ∧ TileArea (S i s) = (cfg.firstPredecessor + i.succ).1.toNat ∧ ((0 : ℤ) < (cfg.firstPredecessor i.succ).1 → LatticeTile (S i s))) + → ((∀ (i : Fin 3), (i = 1 ∨ i = 2) → (0 < (cfg.firstPredecessor i.succ).1)) → (∀ (i : + Fin 3), ∀ (s : Bool), (i = 1 ∨ i = 2) → ((S i s).cells.Nonempty))) ) := by + classical + intro q cfg S sg rpPos i s hi + have ha := (sg i s).2.1 + have hp := rpPos i hi + change (S i s).cells.card = _ at ha + exact Finset.card_pos.mp (by omega) + +private theorem oriented : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (∀ (D : CircleCoordinates), ∀ (U : ProtoTile), + BandPrototile D U → D.1.toNat < (q (0 : Fin (4 : ℕ))).1.toNat → QuarterTurnSymmetric + U) → ((∀ (q' : Fin (4 : ℕ) → CircleCoordinates), ∀ (T' : ProtoTile), ∀ (U : + ProtoTile), ProperBandQuadruple q' → BandPrototile (q' (0 : Fin (4 : ℕ))) T' → (q' (0 + : Fin (4 : ℕ))).1.toNat < (q (0 : Fin (4 : ℕ))).1.toNat → (1 : ℤ) < (q' (0 : Fin (4 : + ℕ))).1 → ∀ (i : Fin (3 : ℕ)), BandPrototile (q' i.succ) U → TileCentroid U - + TileCentroid T' = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q' i.succ) (q' (0 + : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' + i.succ))) → TouchingTriple T' (TileTranslation T' (BandVectors.1 (q' i.succ) (q' (0 : + Fin (4 : ℕ))))) U) → ((∀ (q' : Fin (4 : ℕ) → CircleCoordinates), ∀ (T' : ProtoTile), + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ProperBandQuadruple q' → BandPrototile (q' (0 : + Fin (4 : ℕ))) T' → (q' (0 : Fin (4 : ℕ))).1.toNat < (q (0 : Fin (4 : ℕ))).1.toNat → ∀ + (i : Fin (3 : ℕ)), BandPrototile (q' i.succ) U → BandPrototile (q' (i + (1 : Fin (3 : + ℕ))).succ) V → TileCentroid U - TileCentroid T' = (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q' i.succ) (q' (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 + (q' (0 : Fin (4 : ℕ))) (q' i.succ))) → TileCentroid V - TileCentroid T' = (1 / 2 : ℝ) + • (GaussianRealPoint (BandVectors.1 (q' (i + (1 : Fin (3 : ℕ))).succ) (q' (0 : Fin (4 + : ℕ)))) - GaussianRealPoint (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' (i + (1 : Fin + (3 : ℕ))).succ))) → TouchingTriple T' U V) → ((0 < (q 0).1) → (∀ (p : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple p → (p (0 : Fin (4 : ℕ))).1 < (q (0 : Fin (4 + : ℕ))).1 → (1 : ℤ) < (p (0 : Fin (4 : ℕ))).1 → (∀ (T₀ : ProtoTile), ∀ (Tᵢ : + ProtoTile), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), BandPrototile (p (0 : Fin (4 : + ℕ))) T₀ → BandPrototile (p i.succ) Tᵢ → TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : + ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (p i.succ) (p + (0 : Fin (4 : ℕ))))) + GaussianRealPoint (GaussianQuarterTurn^[(↑s : ℕ)] + (BandVectors.1 (p (0 : Fin (4 : ℕ))) (p i.succ)))) → TouchingTriple T₀ + (TileTranslation T₀ (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (p i.succ) (p (0 : + Fin (4 : ℕ)))))) Tᵢ) ∧ ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (Tⱼ : ProtoTile), ∀ + (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), BandPrototile (p (0 : Fin (4 : ℕ))) T₀ → + BandPrototile (p i.succ) Tᵢ → BandPrototile (p (i + (1 : Fin (3 : ℕ))).succ) Tⱼ → + TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • (GaussianRealPoint + (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (p i.succ) (p (0 : Fin (4 : ℕ))))) + + GaussianRealPoint (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (p (0 : Fin (4 : + ℕ))) (p i.succ)))) → TileCentroid Tⱼ - TileCentroid T₀ = (1 / 2 : ℝ) • + (GaussianRealPoint (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (p (i + (1 : Fin (3 + : ℕ))).succ) (p (0 : Fin (4 : ℕ))))) - GaussianRealPoint (GaussianQuarterTurn^[(↑s : + ℕ)] (BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (i + (1 : Fin (3 : ℕ))).succ)))) → + TouchingTriple T₀ Tᵢ Tⱼ)))) ) := by + classical + intro q hsmallT2 hsmallT4 hsmallT5 hqpos p hp hlt hlarge + have hs := (Int.toNat_lt_toNat hqpos).mpr hlt + exact OrientedTouchingCovariance p hp + (fun a U hu => hsmallT2 _ U hu ((Int.toNat_lt_toNat hqpos).mpr (by + fin_cases a + · exact hlt + · exact (hp.2 0).trans hlt + · exact (hp.2 1).trans hlt + · exact (hp.2 2).trans hlt))) + (fun V U i hv hu hc => hsmallT4 p V U hp hv hs hlarge i hu hc) + (fun V U W i hv hu hw hc hd => hsmallT5 p V U W hp hv hs i hu hw hc hd) + +private theorem rlarge : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), 1 < + (cfg.firstPredecessor 0).1 ) := by + classical + intro q cfg + rw [cfg.firstChild] + have := cfg.order12 + have := cfg.secondLarge + omega + +private theorem tlarge : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), 1 < + (cfg.secondPredecessor 0).1 ) := by + classical + intro q cfg + rw [cfg.secondChild] + have := cfg.secondLarge + omega + +private theorem nonunitA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (P : Fin (3 : + ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), TileArea (P i s) = (q + i.succ).1.toNat) → (TileArea (P 0 true) ≠ 1)) ) := by + classical + intro q cfg P parea + rw [parea] + have := cfg.order12 + have := cfg.secondLarge + change (q 1).1.toNat ≠ 1 + omega + +private theorem nonunitB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (P : Fin (3 : + ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), TileArea (P i s) = (q + i.succ).1.toNat) → (TileArea (P 0 false) ≠ 1)) ) := by + classical + intro q cfg P parea + rw [parea] + have := cfg.order12 + have := cfg.secondLarge + change (q 1).1.toNat ≠ 1 + omega + +private theorem nonunitC : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (P : Fin (3 : + ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), TileArea (P i s) = (q + i.succ).1.toNat) → (TileArea (P 1 true) ≠ 1)) ) := by + classical + intro q cfg P parea + rw [parea] + have := cfg.secondLarge + change (q 2).1.toNat ≠ 1 + omega + +private theorem Odisk : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (Q : + Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (0 : ℤ) ≤ + (cfg.firstPredecessor i.succ).1 ∧ TileArea (Q i s) = (cfg.firstPredecessor + i.succ).1.toNat ∧ ((0 : ℤ) < (cfg.firstPredecessor i.succ).1 → LatticeTile (Q i s))) → ( + let O := Q 0 false + O.cells.Nonempty → LatticeTile O) ) := by + classical + intro q cfg Q qg O ho + apply (qg 0 false).2.2 + have ha := (qg 0 false).2.1 + have hp := (qg 0 false).1 + have hc := Finset.card_pos.mpr ho + change O.cells.card = _ at ha + change 0 < (cfg.firstPredecessor (0 : Fin 3).succ).1 + omega + +private theorem hindex : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (C₀ : + BandCircle), (q (0 : Fin (4 : ℕ)) = C₀.1.1) → ((∀ (k : Fin (4 : ℕ)), (0 : ℤ) ≤ (q + k).1) → (∀ (R : Finset GaussianInt), (R.card = C₀.1.1.1.natAbs) → (R.card = (q + 0).1.toNat)))) ) := by + classical + intro q cfg C₀ hC₀ hn R hcount + rw [hC₀] + apply hcount.trans + have ha := Int.natAbs_of_nonneg (by simpa [hC₀] using hn 0) + omega + +private theorem ocenter : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), BandSubtileOccurrence q T i s (P i s)) → (∀ (Q : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence + cfg.firstPredecessor (P (0 : Fin (3 : ℕ)) true) i s (Q i s)) → ( + let O := Q 0 false + TileCentroid O = TileCentroid T)) ) := by + classical + intro q cfg T P hP Q hQ O + let d := (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q 3) (q 2)) - + (-(GaussianRealPoint (BandVectors.1 (q 3) (q 2))).2, + (GaussianRealPoint (BandVectors.1 (q 3) (q 2))).1)) + have hp : TileCentroid (P 0 true) - TileCentroid T = d := by + simpa [d] using (hP 0 true).2.2 + have hq : TileCentroid O - TileCentroid (P 0 true) = -d := by + have h := (hQ 0 false).2.2 + change TileCentroid O - TileCentroid (P 0 true) = + (-1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 2)) - + (-(GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 2))).2, + (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 2))).1))) at h + simpa [cfg.firstParentThree, cfg.firstParentTwo, d] using h + apply sub_eq_zero.mp + calc + TileCentroid O - TileCentroid T = + (TileCentroid O - TileCentroid (P 0 true)) + + (TileCentroid (P 0 true) - TileCentroid T) := by abel + _ = 0 := by rw [hp, hq]; simp + +private theorem compEq : + (by + classical + exact + ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : + Fin (3 : ℕ) → Bool → ProtoTile), ((Q (0 : Fin (3 : ℕ)) false).cells = (S (0 : Fin (3 + : ℕ)) true).cells) → ( + let O := Q 0 false + TileCellComplement (P 0 false) (S 0 true) = TileCellComplement (P 0 false) O) ) := by + classical + intro P Q S hcommon O + simp only [TileCellComplement, ← hcommon, O] + +private theorem sameTouch : + (by + classical + exact + ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ((Q (0 : + Fin (3 : ℕ)) false).cells = (S (0 : Fin (3 : ℕ)) true).cells) → (((Q (0 : Fin (3 : + ℕ)) false).cells = ∅ → (Q (0 : Fin (3 : ℕ)) false).anchor = (S (0 : Fin (3 : ℕ)) + true).anchor) → ( + let O := Q 0 false + (FootprintVertices (Q (0 : Fin (3 : ℕ)) false) = FootprintVertices (S (0 : Fin (3 : ℕ)) + true) ∧ BoundaryFootprintVertices (Q (0 : Fin (3 : ℕ)) false) = + BoundaryFootprintVertices (S (0 : Fin (3 : ℕ)) true) ∧ BoundaryFootprintEdges (Q (0 : + Fin (3 : ℕ)) false) = BoundaryFootprintEdges (S (0 : Fin (3 : ℕ)) true) ∧ + TileRealization (Q (0 : Fin (3 : ℕ)) false) = TileRealization (S (0 : Fin (3 : ℕ)) + true) ∧ TileCentroid (Q (0 : Fin (3 : ℕ)) false) = TileCentroid (S (0 : Fin (3 : ℕ)) + true)) → (∀ (U : ProtoTile), TileTouching U (S 0 true) ↔ TileTouching U O))) ) := by + classical + intro Q S hcommon hanchor O sameObs U + unfold TileTouching + rw [← sameObs.2.1, ← sameObs.2.2.1, ← hcommon] + by_cases he : (Q 0 false).cells = ∅ + · simp only [O, he, Finset.not_nonempty_empty, false_and, true_and, + hanchor he] + · simp [O, he] + +private theorem compB : + (by + classical + exact + ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : + Fin (3 : ℕ) → Bool → ProtoTile), (LatticeTile (TileCellComplement (P (0 : Fin (3 : + ℕ)) false) (S (0 : Fin (3 : ℕ)) true)) ∧ TileTouching (TileCellComplement (P (0 : Fin + (3 : ℕ)) false) (S (0 : Fin (3 : ℕ)) true)) (S (0 : Fin (3 : ℕ)) true)) → ( + let O := Q 0 false + (TileCellComplement (P 0 false) (S 0 true) = TileCellComplement (P 0 false) O) → ((∀ (U : + ProtoTile), TileTouching U (S 0 true) ↔ TileTouching U O) → (LatticeTile + (TileCellComplement (P 0 false) O) ∧ TileTouching (TileCellComplement (P 0 false) O) + O))) ) := by + classical + intro P Q S compS O compEq sameTouch + refine ⟨compEq ▸ compS.1, ?_⟩ + exact (sameTouch _).mp (compEq ▸ compS.2) + +private theorem central : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), BandSubtileOccurrence q T i s (P i s)) → (∀ (Q : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence + cfg.firstPredecessor (P (0 : Fin (3 : ℕ)) true) i s (Q i s)) → ((∀ (i : Fin 3), ∀ (s + : Bool), (P i s).cells.Nonempty) → ( + let O := Q 0 false + (TileCentroid O = TileCentroid T) → (CentrallyReflectedAt (TileCentroid O) + (TileCellComplement (P 0 true) O) (TileCellComplement (P 0 false) O))))) ) := by + classical + intro q cfg T P hP Q hQ pne O ocenter + apply P4670T1ComplementReflection _ _ _ _ (pne 0 true) + · rw [ocenter] + exact (BandSignedOccurrenceHalfTurn q (TileCentroid T) P + (fun i s => (hP i s).1) (fun i s => (hP i s).2.2) 0).2.2.2.2.2 + · exact BandPrototileCentralSymmetry _ _ (hQ 0 false).1 + +private theorem compDisjoint : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 + : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let O := Q 0 false + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + ((∀ (m : ℤ), ∀ (n : ℤ), (SubtileOccurrenceInterpretation P u v (⟨SixSubtileLabel.A, m, n⟩ + : PeriodicSubtileIndex)).cells ∩ (SubtileOccurrenceInterpretation P u v + (⟨SixSubtileLabel.B, m, n⟩ : PeriodicSubtileIndex)).cells = (TileTranslation O ((↑m : + GaussianInt) * u + (↑n : GaussianInt) * v)).cells) ∧ ∀ (a : PeriodicSubtileIndex), ∀ + (b : PeriodicSubtileIndex), a ≠ b → ¬((a.label = SixSubtileLabel.A ∧ b.label = + SixSubtileLabel.B ∨ a.label = SixSubtileLabel.B ∧ b.label = SixSubtileLabel.A) ∧ + a.first = b.first ∧ a.second = b.second) → Disjoint (SubtileOccurrenceInterpretation + P u v a).cells (SubtileOccurrenceInterpretation P u v b).cells) → (Disjoint + (TileCellComplement (P 0 true) O).cells (TileCellComplement (P 0 false) (S 0 + true)).cells) ) := by + classical + intro q P Q S O u v hsep + apply Finset.disjoint_left.mpr + intro a ha hb + have hc : a ∈ (P 0 true).cells ∩ (P 0 false).cells := + Finset.mem_inter.mpr ⟨(Finset.mem_sdiff.mp ha).1, (Finset.mem_sdiff.mp hb).1⟩ + have hz := hsep.1 0 0 + have ht0 (U : ProtoTile) : TileTranslation U 0 = U := by + have hz : GaussianTranslation 0 = id := by funext z; exact add_zero z + cases U + simp only [TileTranslation, hz, Finset.image_id, id_eq] + simp only [SubtileOccurrenceInterpretation, Int.cast_zero, zero_mul, zero_add, ht0] at hz + exact (Finset.mem_sdiff.mp ha).2 (hz ▸ hc) + +private theorem periodicIsolation : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 + : ℕ) → Bool → ProtoTile), + let O := Q 0 false + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + (∀ y ∈ FootprintVertices (Q (0 : Fin (3 : ℕ)) false), ∀ (a : GaussianInt), y ∈ + FootprintVertices (⟨{a}, a⟩ : ProtoTile) → a ∈ (P (0 : Fin (3 : ℕ)) true).cells ∨ a ∈ + (P (0 : Fin (3 : ℕ)) false).cells) → (∀ m n : Int, ∀ x ∈ FootprintVertices + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)), ∀ a : + GaussianInt, x ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) → a ∈ + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells ∨ a ∈ + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) ) := by + classical + intro q P Q O u v isolated m n x hx a hxa + let w := (m : GaussianInt) * u + (n : GaussianInt) * v + rw [(TileTranslationFormulas O w).2.2.2.2.2.1] at hx + obtain ⟨z, hz, hzx⟩ := hx + have hs : TileTranslation (⟨{a - w}, a - w⟩ : ProtoTile) w = ⟨{a}, a⟩ := by + simp [TileTranslation, GaussianTranslation] + rw [← hs, (TileTranslationFormulas _ w).2.2.2.2.2.1] at hxa + obtain ⟨b, hb, hbx⟩ := hxa + have hbz : b = z := add_right_cancel (hbx.trans hzx.symm) + subst b + have ht (U : ProtoTile) (ha : a - w ∈ U.cells) : a ∈ (TileTranslation U w).cells := by + exact Finset.mem_image.mpr ⟨a - w, ha, sub_add_cancel a w⟩ + exact (isolated z hz (a - w) hb).imp (ht _) (ht _) + +private theorem diskNonempty : + (by + classical + exact + ∀ (U : ProtoTile), (LatticeTile U) → (U.cells.Nonempty) ) := by + classical + intro U hU + obtain ⟨e⟩ := hU + have hp := (e ⟨0, by simp⟩).property + simp only [TileRealization, Set.mem_iUnion] at hp + obtain ⟨x, hx, _⟩ := hp + exact ⟨x, hx⟩ + +private theorem boundaryEdge : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges U) → (e ∈ + FootprintEdges U) ) := by + classical + intro U e he + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [Zsqrtd.ext_iff] + · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + +private theorem touchEdge : + (by + classical + exact + (∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges U) → (e ∈ + FootprintEdges U)) → (∀ (U : ProtoTile), ∀ (V : ProtoTile), (U.cells.Nonempty) → + ((V.cells.Nonempty) → ((TileTouching U V) → ((FootprintEdges U ∩ FootprintEdges + V).Nonempty)))) ) := by + classical + intro boundaryEdge U V hu hv ht + rcases ht with h | h | h + · obtain ⟨p, _, hp, _, _, he⟩ := h.2.2.2 + cases p with + | nil => simp at hp + | cons a p => + cases p with + | nil => simp at hp + | cons b p => + have h := (he {a, b}).mpr ⟨a, b, [], p, rfl, rfl⟩ + exact ⟨{a, b}, boundaryEdge _ _ h.1, boundaryEdge _ _ h.2⟩ + · exact (hu.ne_empty h.1).elim + · exact (hv.ne_empty h.1).elim + +private theorem edgeMono : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (V : ProtoTile), (U.cells ⊆ V.cells) → (FootprintEdges U ⊆ + FootprintEdges V) ) := by + classical + intro U V h + rintro e ⟨z, hz, he⟩ + exact ⟨z, h hz, he⟩ + +private theorem abEdge : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + (BandCircle) → (∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (s : Bool), BandPrototile + (cfg.firstPredecessor 0) (P 0 s)) → (∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : + Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence cfg.firstPredecessor (P (0 : Fin (3 + : ℕ)) true) i s (Q i s)) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), BandSubtileOccurrence cfg.firstPredecessor (P (0 : Fin (3 : ℕ)) + false) i s (S i s)) → ((LatticeTile (TileCellComplement (P (0 : Fin (3 : ℕ)) true) (Q + (0 : Fin (3 : ℕ)) false)) ∧ TileTouching (TileCellComplement (P (0 : Fin (3 : ℕ)) + true) (Q (0 : Fin (3 : ℕ)) false)) (Q (0 : Fin (3 : ℕ)) false)) → ( + let O := Q 0 false + (O.cells ⊆ (P 0 false).cells) → ((Finset GaussianInt) → ((FootprintVertices (Q (0 : Fin + (3 : ℕ)) false) = FootprintVertices (S (0 : Fin (3 : ℕ)) true) ∧ + BoundaryFootprintVertices (Q (0 : Fin (3 : ℕ)) false) = BoundaryFootprintVertices (S + (0 : Fin (3 : ℕ)) true) ∧ BoundaryFootprintEdges (Q (0 : Fin (3 : ℕ)) false) = + BoundaryFootprintEdges (S (0 : Fin (3 : ℕ)) true) ∧ TileRealization (Q (0 : Fin (3 : + ℕ)) false) = TileRealization (S (0 : Fin (3 : ℕ)) true) ∧ TileCentroid (Q (0 : Fin (3 + : ℕ)) false) = TileCentroid (S (0 : Fin (3 : ℕ)) true)) → (((Q (0 : Fin (3 : ℕ)) + false).cells = ∅ → (cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → ((∀ (U : + ProtoTile), (LatticeTile U) → (U.cells.Nonempty)) → ((∀ (U : ProtoTile), ∀ (V : + ProtoTile), (U.cells.Nonempty) → ((V.cells.Nonempty) → ((TileTouching U V) → + ((FootprintEdges U ∩ FootprintEdges V).Nonempty)))) → ((∀ (U : ProtoTile), ∀ (V : + ProtoTile), (U.cells ⊆ V.cells) → (FootprintEdges U ⊆ FootprintEdges V)) → + ((FootprintEdges (TileCellComplement (P 0 true) O) ∩ FootprintEdges (P 0 + false)).Nonempty)))))))))))) ) := by + classical + intro q cfg C₀ P hPr Q hQ S hS compQ O hOB R sameObs zero diskNonempty touchEdge edgeMono + by_cases he : O.cells = ∅ + · have hac := (hQ 0 false).2.2 + have hbc := (hS 0 true).2.2 + rw [← sameObs.2.2.2.2] at hbc + obtain ⟨F, g, e, h1, h2, _, _, upper, lower⟩ := + P4638T1EmptyFordLocalization cfg.firstPredecessor cfg.firstProper + (P 0 true) (P 0 false) O (hPr true) (hPr false) he (zero he) + (by simpa [O] using hac) (by simpa [O] using hbc) + let a := (BandPackingSymmetryTileAction g O).anchor + have h1' : 0 < (F.q₁ : Int) := by exact_mod_cast h1 + have h2' : 0 < (F.q₂ : Int) := by exact_mod_cast h2 + have hA : a ∈ (BandPackingSymmetryTileAction g (P 0 true)).cells := by + apply (upper a).mpr + simp only [a, sub_self] + change -(F.q₁ : Int) ≤ 0 ∧ 0 < (F.q₂ : Int) ∧ + (0 : Int) ≤ 0 ∧ 0 < ((F.q₁ + F.q₂ : Nat) : Int) + rw [Nat.cast_add] + omega + have hB : a - ⟨0, 1⟩ ∈ (BandPackingSymmetryTileAction g (P 0 false)).cells := by + apply (lower (a - ⟨0, 1⟩)).mpr + have hd : a - ⟨0, 1⟩ - a = -(⟨0, 1⟩ : GaussianInt) := by abel + change -(F.q₂ : Int) ≤ (a - ⟨0, 1⟩ - a).re ∧ _ + rw [hd] + change -(F.q₂ : Int) ≤ 0 ∧ 0 < (F.q₁ : Int) ∧ + -((F.q₁ + F.q₂ : Nat) : Int) ≤ -1 ∧ (-1 : Int) < 0 + rw [Nat.cast_add] + omega + have hcommonEdge : {a, a + 1} ∈ + FootprintEdges (BandPackingSymmetryTileAction g (P 0 true)) ∩ + FootprintEdges (BandPackingSymmetryTileAction g (P 0 false)) := by + refine ⟨⟨a, hA, Or.inl rfl⟩, ⟨a - ⟨0, 1⟩, hB, Or.inr (Or.inr (Or.inr ?_))⟩⟩ + congr 1 <;> congr 1 <;> abel + have inj : ∀ g : BandPackingSymmetry, Function.Injective (BandPackingSymmetryVectorAction + g) := by + intro g + induction g with + | identity => exact fun _ _ h => h + | shift w => exact fun _ _ h => h + | negate => + intro a b h + have hx := congrArg Zsqrtd.re h + have hy := congrArg Zsqrtd.im h + change -a.im = -b.im at hx + change a.re = b.re at hy + exact Zsqrtd.ext hy (neg_injective hx) + | conjugate => + intro a b h + have hx := congrArg Zsqrtd.re h + have hy := congrArg Zsqrtd.im h + change -a.re = -b.re at hx + change -(-a.im) = -(-b.im) at hy + exact Zsqrtd.ext (neg_injective hx) (by simpa only [neg_neg] using hy) + | comp g h ig ih => exact ig.comp ih + have edges := (BandPackingSymmetryTilingTransport g).2.2.2.2.2.2.2.2.1 + rw [edges, edges] at hcommonEdge + obtain ⟨f, hf, hfe⟩ := hcommonEdge.1 + obtain ⟨f', hf', hf'e⟩ := hcommonEdge.2 + have hff' : f = f' := Finset.image_injective (inj g) (hfe.trans hf'e.symm) + have hdel : (TileCellComplement (P 0 true) O).cells = (P 0 true).cells := by + simp [TileCellComplement, he] + refine ⟨f, edgeMono _ _ (by rw [hdel]) hf, hff' ▸ hf'⟩ + · obtain ⟨e, heA, heO⟩ := touchEdge _ _ (diskNonempty _ compQ.1) + (Finset.nonempty_iff_ne_empty.mpr he) compQ.2 + exact ⟨e, heA, edgeMono _ _ hOB heO⟩ + +private theorem edgeVertex : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges U) → (∀ (x : + GaussianInt), (x ∈ e) → (x ∈ FootprintVertices U)) ) := by + classical + intro U e he x hx + obtain ⟨z, hz, he⟩ := he + simp only [FootprintVertices, ite_eq_left (show U.cells.Nonempty from ⟨z, hz⟩), + Set.mem_ofPred_eq] + rcases he with h | h | h | h <;> subst e + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hx + · rcases hx with rfl | rfl + · exact ⟨_, hz, Or.inl rfl⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · rcases hx with rfl | rfl + · exact ⟨_, hz, Or.inl rfl⟩ + · exact ⟨z, hz, Or.inr (Or.inr (Or.inl rfl))⟩ + · rcases hx with rfl | rfl + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · exact ⟨z, hz, Or.inr (Or.inr (Or.inr rfl))⟩ + · rcases hx with rfl | rfl + · exact ⟨z, hz, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨z, hz, Or.inr (Or.inr (Or.inr rfl))⟩ + +private theorem commonVertices : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((BandCircle) → + (∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), + let O := Q 0 false + (Finset GaussianInt) → (((FootprintEdges (TileCellComplement (P 0 true) O) ∩ + FootprintEdges (P 0 false)).Nonempty) → ((∀ (U : ProtoTile), ∀ (e : Finset + GaussianInt), (e ∈ FootprintEdges U) → (∀ (x : GaussianInt), (x ∈ e) → (x ∈ + FootprintVertices U))) → (∃ x y : GaussianInt, x ≠ y ∧ x ∈ FootprintVertices + (TileCellComplement (P 0 true) O) ∩ FootprintVertices (P 0 false) ∧ y ∈ + FootprintVertices (TileCellComplement (P 0 true) O) ∩ FootprintVertices (P 0 + false)))))) ) := by + classical + intro q cfg C₀ P Q O R abEdge edgeVertex + obtain ⟨e, heA, heB⟩ := abEdge + have hc : e.card = 2 := by + obtain ⟨z, _, h⟩ := heA + rcases h with rfl | rfl | rfl | rfl <;> simp [Zsqrtd.ext_iff] + obtain ⟨x, hx, y, hy, hxy⟩ := Finset.one_lt_card.mp (by omega : 1 < e.card) + exact ⟨x, y, hxy, ⟨edgeVertex _ _ heA _ hx, edgeVertex _ _ heB _ hx⟩, + ⟨edgeVertex _ _ heA _ hy, edgeVertex _ _ heB _ hy⟩⟩ + +private theorem modifiedDisks : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 + : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), LatticeTile (P i s)) → + ((LatticeTile (TileCellComplement (P (0 : Fin (3 : ℕ)) true) (Q (0 : Fin (3 : ℕ)) + false)) ∧ TileTouching (TileCellComplement (P (0 : Fin (3 : ℕ)) true) (Q (0 : Fin (3 + : ℕ)) false)) (Q (0 : Fin (3 : ℕ)) false)) → ( + let O := Q 0 false + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + ∀ (o : PeriodicSubtileIndex), LatticeTile (ModifiedSubtileOccurrenceInterpretation P O u + v o))) ) := by + classical + intro q P Q pdisks compQ O u v o + rcases o with ⟨l, m, n⟩ + cases l + all_goals apply ((TileDiskAreaCovariance _ _).1).mp + · exact compQ.1 + · exact pdisks 0 false + · exact pdisks 1 true + · exact pdisks 1 false + · exact pdisks 2 true + · exact pdisks 2 false + +private theorem repCard : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + let L := AddSubgroup.closure ({u, v} : Set GaussianInt) + ∀ (R : Finset GaussianInt), (LatticeFundamentalSet (AddSubgroup.closure + {BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))), + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))}) R) → (∀ (K : + BandUnmodifiedCoreCertificate P u v L), K.core.latticeReps.card = R.card) ) := by + classical + intro q P u v L R hfund K + have hf : LatticeFundamentalSet L K.core.latticeReps := by + simpa only [K.lattice_eq] using K.core.lattice_full_rank + let f : GaussianInt → GaussianInt := fun x => Classical.choose (hfund x) + have fspec (x : GaussianInt) : f x ∈ R ∧ x - f x ∈ L := + (Classical.choose_spec (hfund x)).1 + apply Finset.card_nbij f + · intro x _ + exact (fspec x).1 + · intro x hx y hy hxy + have hxyL : x - y ∈ L := by + have h := L.sub_mem (fspec x).2 (fspec y).2 + rw [hxy] at h + convert h using 1; abel + exact (hf x).unique ⟨hx, by simp⟩ ⟨hy, hxyL⟩ + · intro y hy + obtain ⟨x, hx, _⟩ := hf y + refine ⟨x, hx.1, ?_⟩ + apply (hfund x).unique (fspec x) + refine ⟨hy, ?_⟩ + simpa only [neg_sub] using L.neg_mem hx.2 + +end OrderedLayoutGeometry + +namespace OrderedLayoutCertificate + +private theorem layoutCertificate : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), (q (0 : Fin (4 : ℕ)) = C₀.1.1) → (∀ (T : ProtoTile), (∀ (D : + CircleCoordinates), ∀ (U : ProtoTile), BandPrototile D U → D.1.toNat < (q (0 : Fin (4 + : ℕ))).1.toNat → QuarterTurnSymmetric U) → ((∀ (i : Fin 3), (q i.succ).1.toNat < (q + 0).1.toNat) → (∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), BandSubtileOccurrence q T i s (P i s)) → ((∀ (x : LatticeCell), x ∈ T.cells ↔ + ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (P i s).cells) → (∀ (Q : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence + cfg.firstPredecessor (P (0 : Fin (3 : ℕ)) true) i s (Q i s)) → ((∀ (x : LatticeCell), + x ∈ (P (0 : Fin (3 : ℕ)) true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (Q i + s).cells) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), BandSubtileOccurrence cfg.firstPredecessor (P (0 : Fin (3 : ℕ)) false) i s (S + i s)) → ((∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) false).cells ↔ ∃ (i : Fin (3 + : ℕ)) (s : Bool), x ∈ (S i s).cells) → ((∀ (i : Fin 3), ∀ (s : Bool), LatticeTile (P + i s)) → ((LatticeTile (TileCellComplement (P (0 : Fin (3 : ℕ)) true) (Q (0 : Fin (3 : + ℕ)) false)) ∧ TileTouching (TileCellComplement (P (0 : Fin (3 : ℕ)) true) (Q (0 : Fin + (3 : ℕ)) false)) (Q (0 : Fin (3 : ℕ)) false)) → ((TouchingTriple (P (0 : Fin (3 : ℕ)) + true) (TileTranslation (P (0 : Fin (3 : ℕ)) false) (BandVectors.1 (q (0 : Fin (4 : + ℕ))) (q (2 : Fin (4 : ℕ))))) (TileTranslation (P (2 : Fin (3 : ℕ)) true) + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))) ∧ TouchingTriple (P (0 : + Fin (3 : ℕ)) true) (TileTranslation (P (0 : Fin (3 : ℕ)) false) (BandVectors.1 (q (0 + : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))) (P (2 : Fin (3 : ℕ)) false) ∧ TouchingTriple + (P (0 : Fin (3 : ℕ)) true) (TileTranslation (P (0 : Fin (3 : ℕ)) false) + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : + Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))) (TileTranslation (P (1 : Fin (3 : ℕ)) true) + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : + Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))) ∧ TouchingTriple (P (0 : Fin (3 : ℕ)) true) + (TileTranslation (P (0 : Fin (3 : ℕ)) false) (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + (1 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))) (P + (1 : Fin (3 : ℕ)) false) ∧ TouchingTriple (P (0 : Fin (3 : ℕ)) true) (TileTranslation + (P (1 : Fin (3 : ℕ)) true) (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) + + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))) (TileTranslation (P (2 + : Fin (3 : ℕ)) true) (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))) ∧ + TouchingTriple (P (0 : Fin (3 : ℕ)) false) (TileTranslation (P (1 : Fin (3 : ℕ)) + false) (-BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) - BandVectors.1 (q + (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))) (TileTranslation (P (2 : Fin (3 : ℕ)) + false) (-BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))) ∧ TouchingTriple + (P (1 : Fin (3 : ℕ)) true) (TileTranslation (P (1 : Fin (3 : ℕ)) false) + (-BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))))) (TileTranslation (P (2 + : Fin (3 : ℕ)) true) (-BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))))) ∧ + TouchingTriple (P (1 : Fin (3 : ℕ)) true) (TileTranslation (P (1 : Fin (3 : ℕ)) + false) (-BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))))) (P (2 : Fin (3 : + ℕ)) false)) → (((Q (0 : Fin (3 : ℕ)) false).cells = (S (0 : Fin (3 : ℕ)) true).cells) + → (((Q (0 : Fin (3 : ℕ)) false).cells = ∅ → (Q (0 : Fin (3 : ℕ)) false).anchor = (S + (0 : Fin (3 : ℕ)) true).anchor) → ((TouchingTriple (Q (1 : Fin (3 : ℕ)) true) (S (2 : + Fin (3 : ℕ)) false) (Q (0 : Fin (3 : ℕ)) false)) → ((TouchingTriple (Q (2 : Fin (3 : + ℕ)) true) (S (1 : Fin (3 : ℕ)) false) (Q (0 : Fin (3 : ℕ)) false)) → ((TouchingTriple + (Q (1 : Fin (3 : ℕ)) true) (S (2 : Fin (3 : ℕ)) false) (P (1 : Fin (3 : ℕ)) true)) → + ((TouchingTriple (Q (2 : Fin (3 : ℕ)) true) (S (1 : Fin (3 : ℕ)) false) (P (1 : Fin + (3 : ℕ)) false)) → ((TouchingTriple (Q (1 : Fin (3 : ℕ)) true) (P (1 : Fin (3 : ℕ)) + true) (P (2 : Fin (3 : ℕ)) false)) → ((TouchingTriple (S (1 : Fin (3 : ℕ)) false) (P + (1 : Fin (3 : ℕ)) false) (P (2 : Fin (3 : ℕ)) true)) → ( + let O := Q 0 false + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + let L := AddSubgroup.closure ({u, v} : Set GaussianInt) + (BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) ∈ TilingLattice C₀) → + ((BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) ∈ TilingLattice C₀) → ((∀ + (w : ↥(TilingLattice C₀)), ∃! mn : ℤ × ℤ, (↑mn.1 : GaussianInt) * BandVectors.1 (q (1 + : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑mn.2 : GaussianInt) * BandVectors.1 (q (2 : + Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = (↑w : GaussianInt)) → ((BandVectors.1 (q (0 : + Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∈ AddSubgroup.closure + {BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))), + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))}) → ((BandVectors.1 (q (0 : + Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∈ AddSubgroup.closure + {BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))), + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))}) → ((∀ (z : GaussianInt), + z ∈ AddSubgroup.closure {BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))), + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))} ↔ ∃ w ∈ TilingLattice C₀, + z = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * w) → ((∀ (w : ↥(AddSubgroup.closure + {BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))), + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))})), ∃! mn : ℤ × ℤ, (↑mn.1 : + GaussianInt) * BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) + (↑mn.2 : + GaussianInt) * BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = (↑w : + GaussianInt)) → (∀ (R : Finset GaussianInt), (LatticeFundamentalSet + (AddSubgroup.closure {BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))), + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))}) R) → ((R.card = + C₀.1.1.1.natAbs) → (∀ (K : BandUnmodifiedCoreCertificate P u v L), (K.core.rho + ((K.faceEquiv.symm : PeriodicSubtileFaceIndex → K.core.plane.Face) + (⟨SixSubtileFaceLabel.I1, (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) ∈ + FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin (3 : ℕ)) + false)) → ((K.core.rho ((K.faceEquiv.symm : PeriodicSubtileFaceIndex → + K.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex)) ∈ FootprintVertices (Q (2 : Fin (3 : ℕ)) true) ∩ + FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → ((K.core.rho ((K.faceEquiv.symm : + PeriodicSubtileFaceIndex → K.core.plane.Face) (⟨SixSubtileFaceLabel.I3, (0 : ℤ), (0 : + ℤ)⟩ : PeriodicSubtileFaceIndex)) ∈ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ + FootprintVertices (P (1 : Fin (3 : ℕ)) true)) → ((TileArea (TileCellComplement (P (0 + : Fin (3 : ℕ)) true) O) + TileArea (P (0 : Fin (3 : ℕ)) false) + TileArea (P (1 : Fin + (3 : ℕ)) true) + TileArea (P (1 : Fin (3 : ℕ)) false) + TileArea (P (2 : Fin (3 : ℕ)) + true) + TileArea (P (2 : Fin (3 : ℕ)) false) = R.card) → ((∀ (x : LatticeCell), ∃! o + : PeriodicSubtileIndex, x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v + o).cells) → ((LatticeTile (TileCellComplement (P 0 false) O) ∧ TileTouching + (TileCellComplement (P 0 false) O) O) → (∀ [Nonempty (PrecursorBoundaryArcData + (TileCellComplement (P (0 : Fin (3 : ℕ)) true) (Q (0 : Fin (3 : ℕ)) false)) + (TileCellComplement (P (0 : Fin (3 : ℕ)) false) O) (Q (0 : Fin (3 : ℕ)) false) (S (0 + : Fin (3 : ℕ)) true) (Q (1 : Fin (3 : ℕ)) true) (S (2 : Fin (3 : ℕ)) false) (Q (2 : + Fin (3 : ℕ)) true) (S (1 : Fin (3 : ℕ)) false))], ((Q (0 : Fin (3 : ℕ)) false).cells + = ∅ → (cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → ((∀ m n : Int, ∀ x ∈ + FootprintVertices (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v)), ∀ a : GaussianInt, x ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) → a ∈ + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells ∨ a ∈ + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) → + ((ExceptionalConnectorSegments (P (0 : Fin (3 : ℕ)) true) (P (0 : Fin (3 : ℕ)) false) + O (Q (1 : Fin (3 : ℕ)) true) (S (2 : Fin (3 : ℕ)) false) (Q (2 : Fin (3 : ℕ)) true) + (S (1 : Fin (3 : ℕ)) false) (K.core.rho ((K.faceEquiv.symm : PeriodicSubtileFaceIndex + → K.core.plane.Face) (⟨SixSubtileFaceLabel.I1, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) (K.core.rho ((K.faceEquiv.symm : PeriodicSubtileFaceIndex → + K.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex)))) → (∀ (M : PeriodicTileComplex PeriodicSubtileIndex), + (M.lattice = L) → ((∀ (o : PeriodicSubtileIndex), M.tile o = + ModifiedSubtileOccurrenceInterpretation P O u v o) → ((∀ (a : PeriodicSubtileIndex), + ∀ (b : PeriodicSubtileIndex), M.plane.adjacent a b ↔ AllowedSubtileIncidence a b) → + (∀ (me : M.plane.Face ≃ PeriodicSubtileFaceIndex), (∀ (f : PeriodicSubtileFaceIndex), + M.rho ((me.symm : PeriodicSubtileFaceIndex → M.plane.Face) f) = K.core.rho + ((K.faceEquiv.symm : PeriodicSubtileFaceIndex → K.core.plane.Face) f)) → ((∀ (f : + M.plane.Face), ∀ (i : Fin (3 : ℕ)), M.plane.faceVertex f i = SixSubtileFaceVertices + ((me : M.plane.Face → PeriodicSubtileFaceIndex) f) i) → ((∀ (f : M.plane.Face), f ∈ + M.faceOrbitReps ↔ ((me : M.plane.Face → PeriodicSubtileFaceIndex) f).first = (0 : ℤ) + ∧ ((me : M.plane.Face → PeriodicSubtileFaceIndex) f).second = (0 : ℤ)) → (Nonempty + (BandOrderedGeneralLayoutCertificate q cfg C₀ + T))))))))))))))))))))))))))))))))))))))))))))) ) := by + classical + intro q cfg C₀ hC₀ T hsmallT2 smallParent P hP hPunion Q hQ hQunion S hS hSunion pdisks compQ + houter hcommon hanchor crossO1 crossO2 cross1 cross2 cross3 cross4 O u v L hin1 hin2 + hincoords hu hv hrot hcoords R hfund hcount K point1 point2 point3 harea hpartition compB + arcs zero periodicIsolation segments M mlattice mtiles madj me mpoints mvertices mreps + exact ⟨{ + child_eq := hC₀ + P := P + Q := Q + S := S + O := O + outer_occurrence := hP + outer_union := hPunion + parent_lattice := pdisks + parent_quarter_turn := fun i s => hsmallT2 _ _ (hP i s).1 (smallParent i) + plus_occurrence := hQ + plus_union := hQunion + minus_occurrence := hS + minus_union := hSunion + precursor_eq := rfl + precursor_cells := hcommon + precursor_anchor := hanchor + precursor_complement_lattice := ⟨compQ.1, compB.1⟩ + u := u + v := v + period_u := rfl + period_v := rfl + L := L + lattice_eq := rfl + incoming_mem_first := hin1 + incoming_mem_second := hin2 + incoming_coordinates := hincoords + lattice_rotation := hrot + period_u_mem := hu + period_v_mem := hv + lattice_coordinates := hcoords + R := R + fundamental := hfund + representative_count := hcount + unmodified := K + inner_first := point1 + inner_second := point2 + inner_third := point3 + double_first := cross1 + double_second := cross2 + double_third := cross3 + double_fourth := cross4 + outer_touching := houter + precursor_first := crossO1 + precursor_second := crossO2 + precursor_boundary := Classical.choice arcs + precursor_zero_curvature := zero + exceptional_segments := segments + connector := segments.connector + connector_segmented := rfl + connector_nodup := segments.connector_nodup + connector_head := segments.connector_head + connector_last := segments.connector_last + connector_raw := segments.connector_raw + connector_edges := segments.connector_edges + connector_support := segments.connector_support + orbit_area := harea + partition := hpartition + modified := M + modified_lattice := mlattice + modified_tile := mtiles + modified_adjacency := madj + modified_face_equiv := me + modified_face_points := mpoints + modified_face_vertices := mvertices + modified_face_reps := mreps + precursor_isolated := periodicIsolation }⟩ + +end OrderedLayoutCertificate + +theorem BandOrderedGeneralLayout + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (hC₀ : q 0 = C₀.1.1) + (T : ProtoTile) (hT : BandPrototile (q 0) T) + (hsmallT1 : ∀ (q' : Fin 4 → CircleCoordinates) (T' : ProtoTile) + (S' : Fin 3 → Bool → ProtoTile), ProperBandQuadruple q' → + BandPrototile (q' 0) T' → + (∀ i s, BandSubtileOccurrence q' T' i s (S' i s)) → + (∀ x, x ∈ T'.cells ↔ ∃ i s, x ∈ (S' i s).cells) → + Int.toNat (q' 0).1 < Int.toNat (q 0).1 → + LatticeTile T' ∧ TileArea T' = Int.toNat (q' 0).1 ∧ + ∀ i s, LatticeTile (TileCellComplement T' (S' i s)) ∧ + TileTouching (TileCellComplement T' (S' i s)) (S' i s)) + (hsmallT2 : ∀ (D : CircleCoordinates) (U : ProtoTile), + BandPrototile D U → Int.toNat D.1 < Int.toNat (q 0).1 → + QuarterTurnSymmetric U) + (hsmallT4 : ∀ (q' : Fin 4 → CircleCoordinates) + (T' U : ProtoTile), ProperBandQuadruple q' → + BandPrototile (q' 0) T' → + Int.toNat (q' 0).1 < Int.toNat (q 0).1 → 1 < (q' 0).1 → + ∀ i : Fin 3, BandPrototile (q' i.succ) U → + TileCentroid U - TileCentroid T' = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q' i.succ) (q' 0)) + + GaussianRealPoint (BandVectors.1 (q' 0) (q' i.succ))) → + TouchingTriple T' + (TileTranslation T' (BandVectors.1 (q' i.succ) (q' 0))) U) + (hsmallT5 : ∀ (q' : Fin 4 → CircleCoordinates) + (T' U V : ProtoTile), ProperBandQuadruple q' → + BandPrototile (q' 0) T' → + Int.toNat (q' 0).1 < Int.toNat (q 0).1 → + ∀ i : Fin 3, BandPrototile (q' i.succ) U → + BandPrototile (q' ((i + 1).succ)) V → + TileCentroid U - TileCentroid T' = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q' i.succ) (q' 0)) + + GaussianRealPoint (BandVectors.1 (q' 0) (q' i.succ))) → + TileCentroid V - TileCentroid T' = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q' ((i + 1).succ)) (q' 0)) - + GaussianRealPoint (BandVectors.1 (q' 0) (q' ((i + 1).succ)))) → + TouchingTriple T' U V) : + Nonempty (BandOrderedGeneralLayoutCertificate q cfg C₀ T) := by +-- BODY + classical + have hn := (SemiProperForestClassification q cfg.proper.1).1 + have hqpos : 0 < (q 0).1 := by have := cfg.childLarge; omega + have smallParent (i : Fin 3) : (q i.succ).1.toNat < (q 0).1.toNat := + (Int.toNat_lt_toNat hqpos).mpr (cfg.proper.2 i) + have parentPos (i : Fin 3) : 0 < (q i.succ).1 := + lt_of_le_of_ne (hn i.succ) (Ne.symm (cfg.noLine i.succ)) + have rsmall : (cfg.firstPredecessor 0).1.toNat < (q 0).1.toNat := + (Int.toNat_lt_toNat hqpos).mpr cfg.firstSmaller + have rparents (i : Fin 3) : + (cfg.firstPredecessor i.succ).1.toNat < (q 0).1.toNat := + (Int.toNat_lt_toNat hqpos).mpr ((cfg.firstProper.2 i).trans cfg.firstSmaller) + have smaller (c : CircleCoordinates) (U : ProtoTile) + (hU : BandPrototile c U) (hlt : c.1.toNat < (q 0).1.toNat) := + P4670T1SmallerGeometry (q 0).1.toNat + (fun p V S hp hv hs hc hl => (hsmallT1 p V S hp hv hs hc hl).imp_right + (fun h => h.1)) c U hU hlt + obtain ⟨P, hP, hPunion⟩ := BandPrototileReindexedDecomposition q cfg.proper T hT + have hPr (s : Bool) := OrderedLayoutGeometry.hPr q cfg T P hP s + obtain ⟨Q, hQ, hQunion⟩ := BandPrototileReindexedDecomposition + cfg.firstPredecessor cfg.firstProper (P 0 true) (hPr true) + obtain ⟨S, hS, hSunion⟩ := BandPrototileReindexedDecomposition + cfg.firstPredecessor cfg.firstProper (P 0 false) (hPr false) + have hQcells (i : Fin 3) (s : Bool) := OrderedLayoutGeometry.hQcells P Q hQunion i s + have hScells (i : Fin 3) (s : Bool) : (S i s).cells ⊆ (P 0 false).cells := + OrderedLayoutGeometry.hScells P S hSunion i s + have pg (i : Fin 3) (s : Bool) := smaller _ _ (hP i s).1 (smallParent i) + have pdisks (i : Fin 3) (s : Bool) : LatticeTile (P i s) := + (pg i s).2.2 (parentPos i) + have parea (i : Fin 3) (s : Bool) : TileArea (P i s) = (q i.succ).1.toNat := + (pg i s).2.1 + have pne (i : Fin 3) (s : Bool) := OrderedLayoutGeometry.pne q cfg parentPos P parea i s + have compQ := (hsmallT1 cfg.firstPredecessor (P 0 true) Q cfg.firstProper + (hPr true) hQ hQunion rsmall).2.2 0 false + have compS := (hsmallT1 cfg.firstPredecessor (P 0 false) S cfg.firstProper + (hPr false) hS hSunion rsmall).2.2 0 true + have qg (i : Fin 3) (s : Bool) := smaller _ _ (hQ i s).1 (rparents i) + have sg (i : Fin 3) (s : Bool) := smaller _ _ (hS i s).1 (rparents i) + have rpPos (i : Fin 3) (hi : i = 1 ∨ i = 2) := OrderedLayoutGeometry.rpPos q cfg parentPos i hi + have qne (i : Fin 3) (s : Bool) (hi : i = 1 ∨ i = 2) := OrderedLayoutGeometry.qne q cfg Q qg + rpPos i s hi + have sne (i : Fin 3) (s : Bool) (hi : i = 1 ∨ i = 2) := OrderedLayoutGeometry.sne q cfg S sg + rpPos i s hi + have oriented (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (hlt : (p 0).1 < (q 0).1) (hlarge : 1 < (p 0).1) := OrderedLayoutGeometry.oriented q + hsmallT2 hsmallT4 hsmallT5 hqpos p hp hlt hlarge + have oriR := oriented cfg.firstPredecessor cfg.firstProper cfg.firstSmaller + (OrderedLayoutGeometry.rlarge q cfg) + have oriT := oriented cfg.secondPredecessor cfg.secondProper cfg.secondSmaller + (OrderedLayoutGeometry.tlarge q cfg) + have outer := OuterLayoutTouching q cfg.firstPredecessor cfg.secondPredecessor + cfg.proper cfg.firstProper cfg.secondProper cfg.firstChild cfg.firstParentTwo + cfg.firstParentThree cfg.secondChild cfg.secondParentOne cfg.firstSmaller + cfg.secondSmaller oriR.1 oriR.2 oriT.1 oriT.2 (TileCentroid T) P + (fun i s => (hP i s).1) (fun i s => (hP i s).2.2) + have nonunitA := OrderedLayoutGeometry.nonunitA q cfg P parea + have nonunitC := OrderedLayoutGeometry.nonunitC q cfg P parea + have reject (A B C : ProtoTile) (h : OuterTouchingAlternative A B C) + (ha : TileArea A ≠ 1) : TouchingTriple A B C := + h.resolve_right (fun h => ha h.1) + have houter := And.intro (reject _ _ _ outer.1 nonunitA) + (And.intro (reject _ _ _ outer.2.1 nonunitA) + (And.intro (reject _ _ _ outer.2.2.1 nonunitA) + (And.intro (reject _ _ _ outer.2.2.2.1 nonunitA) + (And.intro (reject _ _ _ outer.2.2.2.2.1 nonunitA) + (And.intro (reject _ _ _ outer.2.2.2.2.2.1 (OrderedLayoutGeometry.nonunitB q cfg P parea)) + (And.intro (reject _ _ _ outer.2.2.2.2.2.2.1 nonunitC) + (reject _ _ _ outer.2.2.2.2.2.2.2 nonunitC))))))) + obtain ⟨hcommon, hanchor, crossO1, crossO2, cross1, cross2, cross3, cross4⟩ := + BandDoubleDecomposition q cfg.firstPredecessor cfg.secondPredecessor cfg.proper + cfg.firstProper cfg.secondProper cfg.firstChild cfg.firstParentTwo + cfg.firstParentThree cfg.secondChild cfg.secondParentOne cfg.order12 + cfg.secondLarge cfg.order23 cfg.secondSmaller hsmallT2 hsmallT5 + (fun V U s => oriT.1 V U 0 s) (TileCentroid T) P Q S + (fun i s => (hP i s).1) (fun i s => (hQ i s).1) (fun i s => (hS i s).1) + (fun i s => (hP i s).2.2) (fun i s => (hQ i s).2.2) + (fun i s => (hS i s).2.2) + let O := Q 0 false + have hOA : O.cells ⊆ (P 0 true).cells := hQcells 0 false + have hOB : O.cells ⊆ (P 0 false).cells := by rw [hcommon]; exact hScells 0 true + have Odisk := OrderedLayoutGeometry.Odisk q cfg Q qg + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + let L := AddSubgroup.closure ({u, v} : Set GaussianInt) + obtain ⟨hin1, hin2, hincoords, hu, hv, hrot, hcoords, R, hfund, hcount⟩ := + TilingLatticeBasis C₀ q cfg.proper hC₀ + obtain ⟨K, point1, point2, point3⟩ := BandUnmodifiedPeriodicCore P Q S u v L R + hu hv hfund hcoords pdisks hQcells hScells + (fun i s => (hQ i s).2.1) (fun i s => (hS i s).2.1) + hcommon hanchor Odisk ⟨crossO1, crossO2⟩ ⟨cross1, cross2, cross3, cross4⟩ houter + have hcover := BandModifiedCoverage P O u v L K hOB + have harea := BandModifiedOrbitArea P O R (q 0).1.toNat (q 1).1.toNat + (q 2).1.toNat (q 3).1.toNat (cfg.firstPredecessor 1).1.toNat hOA + (parea 0 true) (parea 0 false) (parea 1 true) (parea 1 false) + (parea 2 true) (parea 2 false) (qg 0 false).2.1 cfg.soddyNat (OrderedLayoutGeometry.hindex q + cfg C₀ hC₀ hn R hcount) + have hpartition := BandModifiedCellPartition P O u v L R hu hv hfund hcoords hcover harea + have hsep := BandOriginalPairSeparation P O u v hOA hOB hpartition + have compEq : TileCellComplement (P 0 false) (S 0 true) = + TileCellComplement (P 0 false) O := OrderedLayoutGeometry.compEq P Q S hcommon + have sameObs := ProtoTileObservableExtensionality (Q 0 false) (S 0 true) hcommon hanchor + have compB := OrderedLayoutGeometry.compB P Q S compS compEq (OrderedLayoutGeometry.sameTouch Q + S hcommon hanchor sameObs) + have central : CentrallyReflectedAt (TileCentroid O) + (TileCellComplement (P 0 true) O) (TileCellComplement (P 0 false) O) := + OrderedLayoutGeometry.central q cfg T P hP Q hQ pne (OrderedLayoutGeometry.ocenter q + cfg T P hP Q hQ) + have osym : QuarterTurnSymmetric O := hsmallT2 _ _ (hQ 0 false).1 (rparents 0) + obtain ⟨isolated, arcs, zero⟩ := IsolatedPrecursorCoverage q cfg.firstPredecessor + cfg.proper cfg.firstProper cfg.firstChild cfg.firstParentTwo cfg.firstParentThree + (TileCentroid T) P Q S (fun i s => (hP i s).1) (fun i s => (hQ i s).1) + (fun i s => (hS i s).1) (fun i s => (hP i s).2.2) (fun i s => (hQ i s).2.2) + (fun i s => (hS i s).2.2) hQcells hScells (fun i s => (hQ i s).2.1) + (fun i s => (hS i s).2.1) hcommon hanchor compQ compS + (by rw [compEq]; exact central) osym + (fun ho => Odisk (Finset.nonempty_iff_ne_empty.mpr ho)) + (qne 1 true (Or.inl rfl)).ne_empty (sne 2 false (Or.inr rfl)).ne_empty + (qne 2 true (Or.inr rfl)).ne_empty (sne 1 false (Or.inl rfl)).ne_empty + crossO1 crossO2 cross1 cross3 (fun h => nonunitC h.2) (OrderedLayoutGeometry.compDisjoint q P + Q S hsep) + rw [compEq] at arcs + have periodicIsolation := OrderedLayoutGeometry.periodicIsolation q P Q isolated + have ordinary := P4670T1OrdinaryEdges P u v pne (Q 1 true) (S 1 false) + (qne 1 true (Or.inl rfl)) (sne 1 false (Or.inl rfl)) + (hQcells 1 true) (hScells 1 false) cross3.1 cross4.1 houter + have abEdge := OrderedLayoutGeometry.abEdge q cfg C₀ P hPr Q hQ S hS compQ hOB R sameObs zero + (OrderedLayoutGeometry.diskNonempty) (OrderedLayoutGeometry.touchEdge + (OrderedLayoutGeometry.boundaryEdge)) (OrderedLayoutGeometry.edgeMono) + obtain ⟨segments⟩ := ExceptionalModifiedABPath (P 0 true) (P 0 false) O (S 0 true) + (Q 1 true) (S 2 false) (Q 2 true) (S 1 false) _ _ hOA hOB + (hQcells 1 true) (hScells 2 false) (hQcells 2 true) (hScells 1 false) + (qne 1 true (Or.inl rfl)) (sne 2 false (Or.inr rfl)) + (qne 2 true (Or.inr rfl)) (sne 1 false (Or.inl rfl)) crossO1 crossO2 point1 point2 + compQ.2 compB.2 central osym isolated arcs (OrderedLayoutGeometry.commonVertices q cfg C₀ P Q + R abEdge (OrderedLayoutGeometry.edgeVertex)) + obtain ⟨M, mlattice, mtiles, madj, me, mpoints, mvertices, mreps⟩ := + BandModifiedPeriodicComplex P O u v L K (OrderedLayoutGeometry.modifiedDisks q P Q pdisks + compQ) hpartition hOA hOB + (harea.trans (OrderedLayoutGeometry.repCard q P R hfund K).symm) periodicIsolation ordinary + abEdge + ⟨segments.connector, segments.connector_head, segments.connector_last, + segments.connector_raw, segments.connector_edges⟩ + have layoutCertificate : + Nonempty (BandOrderedGeneralLayoutCertificate q cfg C₀ T) := + OrderedLayoutCertificate.layoutCertificate q cfg C₀ hC₀ T hsmallT2 smallParent P hP + hPunion Q hQ hQunion S hS hSunion pdisks compQ houter hcommon hanchor crossO1 crossO2 + cross1 cross2 cross3 cross4 hin1 hin2 hincoords hu hv hrot hcoords R hfund hcount K + point1 point2 point3 harea hpartition compB zero periodicIsolation + segments M mlattice mtiles madj me mpoints mvertices mreps + exact layoutCertificate + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayoutCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayoutCertificate.lean new file mode 100644 index 0000000000..81db7b27b9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayoutCertificate.lean @@ -0,0 +1,281 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandModifiedPeriodicComplex +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoreCertificate +public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments +public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: BandOrderedGeneralLayoutCertificate] + +/-! +# BandOrderedGeneralLayoutCertificate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For an ordered general configuration +$q=(C_0,C_1,C_2,C_3)$, a band circle represented by $C_0$, and a band +prototile $T_0$, an *ordered-general layout certificate* consists of +the following data, with every equality referring to the actual labelled +occurrences rather than merely to isomorphic copies. + +It contains the outer family $P_i^\pm$ decomposing $T_0$, and two families +$Q_i^\pm,S_i^\pm$ decomposing $P_1^+$ and $P_1^-$ for the first predecessor +quadruple. It contains a precursor $O$ equal to $Q_4^-$ in the chosen +indexing, with the same cells as $S_4^+$ and the same anchor when those +cells are empty. Each of the six outer parent occurrences is retained as +a `LatticeTile` and as a `QuarterTurnSymmetric` tile. The +two actual precursor complements +$P_1^+\setminus O$ and $P_1^-\setminus O$ are also retained as lattice +tiles; these are the smaller-T1 facts used when an original $P_1^+$ +occurrence is restored from the modified one. It records +$$ + u=v_{01},\qquad v=v_{02},\qquad + L=\mathbb Zu+\mathbb Zv=i\Lambda_{C_0}, +$$ +the membership and unique-coordinate assertions for the incoming basis +$v_{10},v_{20}$ of the actual `TilingLattice`, the unique integral +coordinates in the layout basis $u,v$, and a complete $L$-coset +representative set $R$ of cardinality $c_0$. + +The certificate further contains the actual +`BandUnmodifiedCoreCertificate`, including the $I_1,I_2$ selections +on the indicated $Q$--$S$ child interfaces and the $I_3$ selection on the +$Q_2^+$--$P_2^+$ child interface. It retains the four exact +touching triples of the double decomposition and the two precursor +touching triples which join those selected interfaces through $O$; thus +their complete pairwise paths and common points remain available to later +label-sensitive arguments. The certificate retains a +`PrecursorBoundaryArcData`: in the positive-area case its two +complement-contact arcs cover $\partial O$, are exchanged by half-turn, and +meet exactly at the two labelled precursor attachments; in the curvature-zero +case the two attachments coincide at the exact common anchor of +$Q_4^-=S_4^+$. In the latter case it also records explicitly that the +precursor circle has curvature zero. + +It also retains an `ExceptionalConnectorSegments` object containing, +in order, the actual $Q_2^+$--$S_3^-$ segment from $I_1$ to the first +attachment, the $(P_1^+\setminus O)$--$O$ segment between the attachments, +and the $Q_3^+$--$S_2^-$ segment from the second attachment to $I_2$. The +two touching triples identify the cuts uniquely, and the segmented walk +retains actual common-edge support on each of its three pieces. Its stored +loop-erasure is the certificate's legacy exceptional connector from the +selected $I_1$ point to the selected $I_2$ point, rather than merely an +unrelated path through the subsequently constructed periodic complex. +Separate fields record its two endpoints, +the membership of every vertex in +$\operatorname{foot}(P_1^+\setminus O)\cap\operatorname{foot}(P_1^-)$, actual common-footprint +support +for every consecutive edge, and the vertex support +$$ + (\operatorname{foot}(Q_2^+)\cap\operatorname{foot}(S_3^-))\cup\operatorname{foot}(O)\cup + (\operatorname{foot}(Q_3^+)\cap\operatorname{foot}(S_2^-)). +$$ +The connector has no repeated vertices, but it may be constant if its two +selected endpoints coincide. Writing +$(A,B,C,D,E,F)=(P_1^+,P_1^-,P_2^+,P_2^-,P_3^+,P_3^-)$, it also retains +the eight translated outer touching triples +$$ +\begin{gathered} + (A,B_{0,1},E_{0,1}),\ (A,B_{0,1},F), + (A,B_{1,1},C_{1,1}),\ (A,B_{1,1},D),\\ + (A,C_{1,1},E_{0,1}),\ (B,D_{-1,-1},F_{0,-1}), + (C,D_{-1,0},E_{-1,0}),\ (C,D_{-1,0},F), +\end{gathered} +$$ +as actual `TouchingTriple` data rather than discarding them after +the weak periodic core is constructed. It also contains the independently +proved six-orbit area identity; and unique indexed membership for the +modified family obtained by replacing $P_1^+$ with $P_1^+\setminus O$. +Finally it contains the actual `PeriodicTileComplex` for this +modified family, identifies its lattice with $L$, its tile at every +$(X,m,n)$ with `ModifiedSubtileOccurrenceInterpretation`, its +selected point on every labelled face with the corresponding selected point +of the unmodified core, its combinatorial adjacency relation with the eighteen rows of +`AllowedSubtileIncidence` (without classifying isolated common +footprint vertices as graph edges), and its faces and face representatives +with the complete twelve-row `SixSubtileFaceVertices` ledger. At +this stage the complex records only actual common-edge support on prescribed +edges and the selected contained face-to-face walks; it does not assert +that these are the complete raw interfaces. It +also retains the translated isolated-precursor conclusion: every lattice +cell incident to a footprint vertex of $O_{m,n}$ belongs to the +corresponding original $A_{m,n}$ or $B_{m,n}$ occurrence. This is the +local datum needed to compare original and modified interfaces after the +periodic complex has been constructed. +No disk, area, or complement conclusion about the outer tile $T_0$ is part +of this certificate. +-/ +structure BandOrderedGeneralLayoutCertificate + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) where +-- BODY + child_eq : q 0 = C₀.1.1 + /-- The six signed parent occurrences decomposing the outer tile. -/ + P : Fin 3 → Bool → ProtoTile + /-- The six signed children decomposing the positive first-parent occurrence. -/ + Q : Fin 3 → Bool → ProtoTile + /-- The six signed children decomposing the negative first-parent occurrence. -/ + S : Fin 3 → Bool → ProtoTile + /-- The literal common precursor selected from the two inner decompositions. -/ + O : ProtoTile + outer_occurrence : ∀ i s, BandSubtileOccurrence q T i s (P i s) + outer_union : ∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (P i s).cells + parent_lattice : ∀ i s, LatticeTile (P i s) + parent_quarter_turn : ∀ i s, QuarterTurnSymmetric (P i s) + plus_occurrence : ∀ i s, + BandSubtileOccurrence cfg.firstPredecessor (P 0 true) i s (Q i s) + plus_union : ∀ x, x ∈ (P 0 true).cells ↔ ∃ i s, x ∈ (Q i s).cells + minus_occurrence : ∀ i s, + BandSubtileOccurrence cfg.firstPredecessor (P 0 false) i s (S i s) + minus_union : ∀ x, x ∈ (P 0 false).cells ↔ ∃ i s, x ∈ (S i s).cells + precursor_eq : O = Q 0 false + precursor_cells : O.cells = (S 0 true).cells + precursor_anchor : O.cells = ∅ → O.anchor = (S 0 true).anchor + precursor_complement_lattice : + LatticeTile (TileCellComplement (P 0 true) O) ∧ + LatticeTile (TileCellComplement (P 0 false) O) + /-- The first period vector of the six-type layout. -/ + u : GaussianInt + /-- The second period vector of the six-type layout. -/ + v : GaussianInt + period_u : u = BandVectors.1 (q 0) (q 1) + period_v : v = BandVectors.1 (q 0) (q 2) + /-- The additive period lattice generated by the two layout vectors. -/ + L : AddSubgroup GaussianInt + lattice_eq : L = AddSubgroup.closure ({u, v} : Set GaussianInt) + incoming_mem_first : BandVectors.1 (q 1) (q 0) ∈ TilingLattice C₀ + incoming_mem_second : BandVectors.1 (q 2) (q 0) ∈ TilingLattice C₀ + incoming_coordinates : ∀ w : TilingLattice C₀, ∃! mn : Int × Int, + (mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (mn.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) = + (w : GaussianInt) + lattice_rotation : ∀ z : GaussianInt, z ∈ L ↔ + ∃ w : GaussianInt, w ∈ TilingLattice C₀ ∧ + z = (⟨0, 1⟩ : GaussianInt) * w + period_u_mem : u ∈ L + period_v_mem : v ∈ L + lattice_coordinates : ∀ w : L, ∃! mn : Int × Int, + (mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v = + (w : GaussianInt) + /-- The complete finite set of period-lattice coset representatives. -/ + R : Finset GaussianInt + fundamental : LatticeFundamentalSet L R + representative_count : R.card = C₀.1.1.1.natAbs + /-- The original periodic core before deleting the precursor from the A occurrences. -/ + unmodified : BandUnmodifiedCoreCertificate P u v L + inner_first : + unmodified.core.rho (unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) ∈ + FootprintVertices (Q 1 true) ∩ FootprintVertices (S 2 false) + inner_second : + unmodified.core.rho (unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) ∈ + FootprintVertices (Q 2 true) ∩ FootprintVertices (S 1 false) + inner_third : + unmodified.core.rho (unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) ∈ + FootprintVertices (Q 1 true) ∩ FootprintVertices (P 1 true) + double_first : TouchingTriple (Q 1 true) (S 2 false) (P 1 true) + double_second : TouchingTriple (Q 2 true) (S 1 false) (P 1 false) + double_third : TouchingTriple (Q 1 true) (P 1 true) (P 2 false) + double_fourth : TouchingTriple (S 1 false) (P 1 false) (P 2 true) + outer_touching : + TouchingTriple (P 0 true) (TileTranslation (P 0 false) v) + (TileTranslation (P 2 true) v) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) v) + (P 2 false) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) (u + v)) + (TileTranslation (P 1 true) (u + v)) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) (u + v)) + (P 1 false) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 1 true) (u + v)) + (TileTranslation (P 2 true) v) ∧ + TouchingTriple (P 0 false) (TileTranslation (P 1 false) (-u - v)) + (TileTranslation (P 2 false) (-v)) ∧ + TouchingTriple (P 1 true) (TileTranslation (P 1 false) (-u)) + (TileTranslation (P 2 true) (-u)) ∧ + TouchingTriple (P 1 true) (TileTranslation (P 1 false) (-u)) + (P 2 false) + precursor_first : TouchingTriple (Q 1 true) (S 2 false) O + precursor_second : TouchingTriple (Q 2 true) (S 1 false) O + precursor_boundary : PrecursorBoundaryArcData + (TileCellComplement (P 0 true) O) + (TileCellComplement (P 0 false) O) O (S 0 true) + (Q 1 true) (S 2 false) (Q 2 true) (S 1 false) + precursor_zero_curvature : O.cells = ∅ → + (cfg.firstPredecessor 1).1 = 0 + exceptional_segments : ExceptionalConnectorSegments + (P 0 true) (P 0 false) O + (Q 1 true) (S 2 false) (Q 2 true) (S 1 false) + (unmodified.core.rho (unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) + (unmodified.core.rho (unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩)) + /-- The retained loop-erased connector between the two selected inner interfaces. -/ + connector : List GaussianInt + connector_segmented : connector = exceptional_segments.connector + connector_nodup : connector.Nodup + connector_head : connector.head? = some + (unmodified.core.rho (unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) + connector_last : connector.getLast? = some + (unmodified.core.rho (unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩)) + connector_raw : ∀ x ∈ connector, + x ∈ FootprintVertices (TileCellComplement (P 0 true) O) ∩ + FootprintVertices (P 0 false) + connector_edges : ∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + connector = l1 ++ x :: y :: l2 → + {x, y} ∈ FootprintEdges (TileCellComplement (P 0 true) O) ∩ + FootprintEdges (P 0 false) + connector_support : ∀ x ∈ connector, + x ∈ (FootprintVertices (Q 1 true) ∩ FootprintVertices (S 2 false)) ∪ + FootprintVertices O ∪ + (FootprintVertices (Q 2 true) ∩ FootprintVertices (S 1 false)) + orbit_area : TileArea (TileCellComplement (P 0 true) O) + + TileArea (P 0 false) + TileArea (P 1 true) + + TileArea (P 1 false) + TileArea (P 2 true) + + TileArea (P 2 false) = R.card + partition : ∀ x : LatticeCell, ∃! o : PeriodicSubtileIndex, + x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells + /-- The periodic complex with the precursor deleted from each A occurrence. -/ + modified : PeriodicTileComplex PeriodicSubtileIndex + modified_lattice : modified.lattice = L + modified_tile : ∀ o, + modified.tile o = ModifiedSubtileOccurrenceInterpretation P O u v o + modified_adjacency : ∀ a b, + modified.plane.adjacent a b ↔ AllowedSubtileIncidence a b + /-- Identify modified-complex faces with the fixed twelve-label periodic face ledger. -/ + modified_face_equiv : modified.plane.Face ≃ PeriodicSubtileFaceIndex + modified_face_points : ∀ f : PeriodicSubtileFaceIndex, + modified.rho (modified_face_equiv.symm f) = + unmodified.core.rho (unmodified.faceEquiv.symm f) + modified_face_vertices : ∀ f i, + modified.plane.faceVertex f i = + SixSubtileFaceVertices (modified_face_equiv f) i + modified_face_reps : ∀ f, f ∈ modified.faceOrbitReps ↔ + (modified_face_equiv f).first = 0 ∧ + (modified_face_equiv f).second = 0 + precursor_isolated : ∀ m n : Int, + ∀ x ∈ FootprintVertices + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)), + ∀ a : GaussianInt, + x ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) → + a ∈ (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells ∨ + a ∈ (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMarkedSectorTransport.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMarkedSectorTransport.lean new file mode 100644 index 0000000000..09c8d21cd8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMarkedSectorTransport.lean @@ -0,0 +1,369 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightSelectedRowGeometry +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedSCompanionGeometry +public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceExists +public import LeanPool.ApollonianSuperharmonic.P4418T3RoutedBlockCriterion +public import LeanPool.ApollonianSuperharmonic.P5478T1ExteriorPlacementIndex + +-- [TABLET NODE: BandOrderedGeneralMarkedSectorTransport] + +/-! +# BandOrderedGeneralMarkedSectorTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralMarkedSectorTransport + (C D : BandCircle) (T N : ProtoTile) (h k : PartialOdometer) + (x : GaussianInt) + (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x) + (placement : BandOrderedGeneralRightPlacement bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction + bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces + bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection) + (selectedEdge : Finset GaussianInt) + (hx : bundle.normalizedPoint ∈ selectedEdge) + (hedge : selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.centralIndex)) + (row : BandOrderedGeneralSelectedContactRow + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout + placement.exteriorIndex placement.centralIndex) : + let q := bundle.normalizedPresentation + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + let observableEq := fun A B : ProtoTile => + A.cells = B.cells ∧ (A.cells = ∅ → A.anchor = B.anchor) + let rowConclusion := fun (a b : PeriodicSubtileIndex) + (selectedRow : BandOrderedGeneralSelectedContactRow + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout a b) + (oldRight : ProtoTile) => + match selectedRow with + | .positiveL1 _ _ => + bundle.normalizedPoint ∉ FootprintVertices oldRight + | .positiveL2 _ _ => + bundle.normalizedPoint ∉ FootprintVertices oldRight + | .positiveL3 _ _ => + bundle.normalizedPoint ∉ FootprintVertices oldRight + | .reflectedL1 _ _ => + bundle.normalizedPoint ∉ FootprintVertices oldRight + | .reflectedL2 _ _ => + bundle.normalizedPoint ∉ FootprintVertices oldRight + | .reflectedL3 _ _ => + bundle.normalizedPoint ∉ FootprintVertices oldRight + | .positiveS1 _ => + let d := BandVectors.1 + (bundle.configuration.firstPredecessor 0) + (bundle.configuration.firstPredecessor 2) + let newRight := TileTranslation (occurrence ⟨.A, -1, -1⟩) d + observableEq newRight + (TileTranslation (placement.layout.P 0 true) + (-placement.layout.u - placement.layout.v + d)) ∧ + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ + bundle.normalizedPoint ∈ FootprintVertices newRight) + | .positiveS2 _ => + let d := (⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * + BandVectors.1 (bundle.configuration.firstPredecessor 3) + (bundle.configuration.firstPredecessor 0) + let newRight := TileTranslation (occurrence ⟨.A, 0, -1⟩) d + observableEq newRight + (TileTranslation (placement.layout.P 0 true) + (-placement.layout.v + d)) ∧ + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ + bundle.normalizedPoint ∈ FootprintVertices newRight) + | .positiveS3 _ => + let d := BandVectors.1 + (bundle.configuration.secondPredecessor 0) + (bundle.configuration.secondPredecessor 1) + let newRight := TileTranslation (occurrence ⟨.C, 1, 0⟩) d + observableEq newRight + (TileTranslation (placement.layout.P 1 true) + (placement.layout.u + d)) ∧ + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ + bundle.normalizedPoint ∈ FootprintVertices newRight) + | .positiveS4 _ => + let d := BandVectors.1 + (bundle.configuration.firstPredecessor 0) + (bundle.configuration.firstPredecessor 2) + let newRight := TileTranslation (occurrence ⟨.A, 0, 0⟩) d + observableEq newRight + (TileTranslation (placement.layout.P 0 true) d) ∧ + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ + bundle.normalizedPoint ∈ FootprintVertices newRight) + | .positiveS5 _ => + let d := (⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * + BandVectors.1 (bundle.configuration.firstPredecessor 3) + (bundle.configuration.firstPredecessor 0) + let newRight := TileTranslation (occurrence ⟨.A, 0, 0⟩) d + observableEq newRight + (TileTranslation (placement.layout.P 0 true) d) ∧ + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ + bundle.normalizedPoint ∈ FootprintVertices newRight) + | .positiveS6 _ => + let d := BandVectors.1 + (bundle.configuration.secondPredecessor 0) + (bundle.configuration.secondPredecessor 1) + let newRight := TileTranslation (occurrence ⟨.C, 0, 0⟩) d + observableEq newRight + (TileTranslation (placement.layout.P 1 true) d) ∧ + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ + bundle.normalizedPoint ∈ FootprintVertices newRight) + | .reflectedS1 _ => + let d := (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + BandVectors.1 (bundle.configuration.firstPredecessor 0) + (bundle.configuration.firstPredecessor 2) + let newRight := TileTranslation (occurrence ⟨.B, 1, 1⟩) d + observableEq newRight + (TileTranslation (placement.layout.P 0 false) + (placement.layout.u + placement.layout.v + d)) ∧ + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ + bundle.normalizedPoint ∈ FootprintVertices newRight) + | .reflectedS2 _ => + let d := (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (bundle.configuration.firstPredecessor 3) + (bundle.configuration.firstPredecessor 0) + let newRight := TileTranslation (occurrence ⟨.B, 0, 1⟩) d + observableEq newRight + (TileTranslation (placement.layout.P 0 false) + (placement.layout.v + d)) ∧ + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ + bundle.normalizedPoint ∈ FootprintVertices newRight) + | .reflectedS3 _ => + let d := (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + BandVectors.1 (bundle.configuration.secondPredecessor 0) + (bundle.configuration.secondPredecessor 1) + let newRight := TileTranslation (occurrence ⟨.D, -1, 0⟩) d + observableEq newRight + (TileTranslation (placement.layout.P 1 false) + (-placement.layout.u + d)) ∧ + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ + bundle.normalizedPoint ∈ FootprintVertices newRight) + | .reflectedS4 _ => + let d := (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + BandVectors.1 (bundle.configuration.firstPredecessor 0) + (bundle.configuration.firstPredecessor 2) + let newRight := TileTranslation (occurrence ⟨.B, 0, 0⟩) d + observableEq newRight + (TileTranslation (placement.layout.P 0 false) d) ∧ + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ + bundle.normalizedPoint ∈ FootprintVertices newRight) + | .reflectedS5 _ => + let d := (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (bundle.configuration.firstPredecessor 3) + (bundle.configuration.firstPredecessor 0) + let newRight := TileTranslation (occurrence ⟨.B, 0, 0⟩) d + observableEq newRight + (TileTranslation (placement.layout.P 0 false) d) ∧ + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ + bundle.normalizedPoint ∈ FootprintVertices newRight) + | .reflectedS6 _ => + let d := (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + BandVectors.1 (bundle.configuration.secondPredecessor 0) + (bundle.configuration.secondPredecessor 1) + let newRight := TileTranslation (occurrence ⟨.D, 0, 0⟩) d + observableEq newRight + (TileTranslation (placement.layout.P 1 false) d) ∧ + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ + bundle.normalizedPoint ∈ FootprintVertices newRight) + let positiveFirst := TileTranslation bundle.normalizedFixed + (-BandVectors.1 (q 0) (q placement.rightFirstSlot.succ)) + let positiveSecond := TileTranslation bundle.normalizedFixed + (-BandVectors.1 (q 0) (q placement.rightSecondSlot.succ)) + let reflectedFirst := TileTranslation bundle.normalizedFixed + (BandVectors.1 (q 0) (q placement.rightFirstSlot.succ)) + let reflectedSecond := TileTranslation bundle.normalizedFixed + (BandVectors.1 (q 0) (q placement.rightSecondSlot.succ)) + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ + bundle.selectedSign = true → + rowConclusion placement.exteriorIndex placement.centralIndex row + positiveFirst) ∧ + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = false → + rowConclusion placement.exteriorIndex placement.centralIndex row + positiveSecond) ∧ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ + bundle.selectedSign = false → + rowConclusion placement.exteriorIndex placement.centralIndex row + reflectedFirst) ∧ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = true → + rowConclusion placement.exteriorIndex placement.centralIndex row + reflectedSecond) := by +-- BODY + classical + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + have hindex := P5478T1ExteriorPlacementIndex C D T N h k x bundle placement + have hgeometry := BandOrderedGeneralRightSelectedRowGeometry + C D T N h k x bundle placement selectedEdge hx hedge row + have hsGeometry := BandOrderedGeneralSelectedSCompanionGeometry + C D T N h k x bundle placement selectedEdge hx hedge row + obtain ⟨data⟩ := P4418T3SelectedInterfaceExists bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedFixed + placement.layout placement.exteriorIndex placement.centralIndex row + have hrouted := P4418T3RoutedBlockCriterion bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedFixed + placement.layout placement.exteriorIndex placement.centralIndex row + bundle.fixed_lattice data bundle.normalizedPoint bundle.routedDirection + selectedEdge hx hedge placement.exterior_routed_cell placement.central_routed_cell + have hL (hnone : P3996T1SRowTable bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedFixed + placement.layout row = none) : + bundle.normalizedPoint ∉ FootprintVertices (TileTranslation bundle.normalizedFixed + (match placement.exteriorIndex.label with + | .A => if placement.exteriorIndex.first = -1 then -placement.layout.u else + placement.layout.u + | .B => if placement.exteriorIndex.first = 1 then placement.layout.u else + -placement.layout.u + | .C => -placement.layout.v + | .D => placement.layout.v + | .E | .F => 0)) := by + dsimp only at hrouted + rw [hnone] at hrouted + exact fun hy => (hrouted.mp hy).elim + clear hrouted data + have exterior_in : FootprintVertices (occurrence placement.exteriorIndex) ⊆ + FootprintVertices bundle.normalizedRoot := by + rw [← placement.selected_exterior_footprint] + exact bundle.piece_footprint _ _ + have zeroTranslation : GaussianTranslation 0 = id := by + funext z + simp [GaussianTranslation] + have central_in : FootprintVertices (occurrence placement.centralIndex) ⊆ + FootprintVertices bundle.normalizedFixed := by + rcases placement.central_index with hc | hc | hc | hc | hc | hc + · simpa [occurrence, hc, SubtileOccurrenceInterpretation, TileTranslation, + zeroTranslation] using (placement.layout.outer_occurrence 0 true).2.1 + · simpa [occurrence, hc, SubtileOccurrenceInterpretation, TileTranslation, + zeroTranslation] using (placement.layout.outer_occurrence 0 false).2.1 + · simpa [occurrence, hc, SubtileOccurrenceInterpretation, TileTranslation, + zeroTranslation] using (placement.layout.outer_occurrence 1 true).2.1 + · simpa [occurrence, hc, SubtileOccurrenceInterpretation, TileTranslation, + zeroTranslation] using (placement.layout.outer_occurrence 1 false).2.1 + · simpa [occurrence, hc, SubtileOccurrenceInterpretation, TileTranslation, + zeroTranslation] using (placement.layout.outer_occurrence 2 true).2.1 + · simpa [occurrence, hc, SubtileOccurrenceInterpretation, TileTranslation, + zeroTranslation] using (placement.layout.outer_occurrence 2 false).2.1 + have incident_footprint (U : ProtoTile) (z : GaussianInt) (j : Fin 4) + (hc : LatticeVertexIncidentCell z j ∈ U.cells) : z ∈ FootprintVertices U := by + simp only [FootprintVertices, ite_eq_left (show U.cells.Nonempty from ⟨_, hc⟩), + Set.mem_ofPred_eq] + refine ⟨_, hc, ?_⟩ + fin_cases j <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] + have hxExterior := incident_footprint _ _ _ placement.exterior_routed_cell + have hxCentral := incident_footprint _ _ _ placement.central_routed_cell + have fullData : + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ bundle.selectedSign = true → + Nonempty (ExactTileInterfaceTriple bundle.normalizedRoot bundle.normalizedFixed + (TileTranslation bundle.normalizedFixed (-BandVectors.1 + (bundle.normalizedPresentation 0) + (bundle.normalizedPresentation placement.rightFirstSlot.succ))))) ∧ + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ bundle.selectedSign = false → + Nonempty (ExactTileInterfaceTriple bundle.normalizedRoot bundle.normalizedFixed + (TileTranslation bundle.normalizedFixed (-BandVectors.1 + (bundle.normalizedPresentation 0) + (bundle.normalizedPresentation placement.rightSecondSlot.succ))))) ∧ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ bundle.selectedSign = false → + Nonempty (ExactTileInterfaceTriple bundle.normalizedRoot bundle.normalizedFixed + (TileTranslation bundle.normalizedFixed (BandVectors.1 + (bundle.normalizedPresentation 0) + (bundle.normalizedPresentation placement.rightFirstSlot.succ))))) ∧ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ bundle.selectedSign = true → + Nonempty (ExactTileInterfaceTriple bundle.normalizedRoot bundle.normalizedFixed + (TileTranslation bundle.normalizedFixed (BandVectors.1 + (bundle.normalizedPresentation 0) + (bundle.normalizedPresentation placement.rightSecondSlot.succ))))) := by + rcases hgeometry with ⟨hp, _, _, _, _, F, S, _⟩ | ⟨hp, _, _, _, _, F, S, _⟩ | + ⟨hp, _, _, _, _, F, S, _⟩ | ⟨hp, _, _, _, _, F, S, _⟩ + all_goals refine ⟨?_, ?_, ?_, ?_⟩ + all_goals intro hbranch + all_goals first + | exact ⟨by simpa only [neg_one_mul, one_mul] using F⟩ + | exact ⟨by simpa only [neg_one_mul, one_mul] using S⟩ + | exact False.elim (Bool.noConfusion (hp.symm.trans hbranch.1)) + have finishS (oldRight newRight signedPiece : ProtoTile) + (full : Nonempty (ExactTileInterfaceTriple bundle.normalizedRoot + bundle.normalizedFixed oldRight)) + (geom : + (newRight.cells = signedPiece.cells ∧ + (newRight.cells = ∅ → newRight.anchor = signedPiece.anchor)) ∧ + (Nonempty (ExactTileInterfaceTriple (occurrence placement.exteriorIndex) + newRight (occurrence placement.centralIndex)) ∨ + Nonempty (ExactTileInterfaceTriple (occurrence placement.centralIndex) + newRight (occurrence placement.exteriorIndex))) ∧ + newRight.cells ⊆ oldRight.cells ∧ + FootprintVertices newRight ⊆ FootprintVertices oldRight) : + (newRight.cells = signedPiece.cells ∧ + (newRight.cells = ∅ → newRight.anchor = signedPiece.anchor)) ∧ + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ + bundle.normalizedPoint ∈ FootprintVertices newRight) := by + obtain ⟨E⟩ := full + obtain ⟨hobs, htriple, _, hsub⟩ := geom + refine ⟨hobs, ⟨?_, fun hy => hsub hy⟩⟩ + intro hold + have hxE := (E.unique_common bundle.normalizedPoint).mp + ⟨⟨exterior_in hxExterior, central_in hxCentral⟩, hold⟩ + rcases htriple with hG | hG + · obtain ⟨G⟩ := hG + have hg := (G.unique_common G.point).mpr rfl + have hp := (E.unique_common G.point).mp + ⟨⟨exterior_in hg.1.1, central_in hg.2⟩, hsub hg.1.2⟩ + simpa only [hxE, ← hp] using hg.1.2 + · obtain ⟨G⟩ := hG + have hg := (G.unique_common G.point).mpr rfl + have hp := (E.unique_common G.point).mp + ⟨⟨exterior_in hg.2, central_in hg.1.1⟩, hsub hg.1.2⟩ + simpa only [hxE, ← hp] using hg.1.2 + have hu := placement.layout.period_u.symm + have hv := placement.layout.period_v.symm + generalize hExt : placement.exteriorIndex = ext at row hL hsGeometry ⊢ + generalize hCentral : placement.centralIndex = central at row hL hsGeometry ⊢ + cases row <;> dsimp only at hsGeometry ⊢ + all_goals refine ⟨?_, ?_, ?_, ?_⟩ + all_goals intro hbranch + all_goals first + | exact finishS _ _ _ (fullData.1 hbranch) (by + simpa only [← hExt, ← hCentral] using hsGeometry.1 hbranch) + | exact finishS _ _ _ (fullData.2.1 hbranch) (by + simpa only [← hExt, ← hCentral] using hsGeometry.2.1 hbranch) + | exact finishS _ _ _ (fullData.2.2.1 hbranch) (by + simpa only [← hExt, ← hCentral] using hsGeometry.2.2.1 hbranch) + | exact finishS _ _ _ (fullData.2.2.2 hbranch) (by + simpa only [← hExt, ← hCentral] using hsGeometry.2.2.2 hbranch) + | (have hrouted := hL rfl + have hi := hindex.symm.trans hExt + rcases placement.right_slots_cyclic with ⟨hr, ht, hd⟩ | ⟨hr, ht, hd⟩ | ⟨hr, ht, hd⟩ + all_goals simp [hbranch.1, hbranch.2.1, hbranch.2.2, hr, ht, hd] at hi + all_goals simpa [hr, ht, hd, hu, hv] using hrouted) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMixedAggregatePatches.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMixedAggregatePatches.lean new file mode 100644 index 0000000000..67161e6521 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMixedAggregatePatches.lean @@ -0,0 +1,107 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P1BandOrderedGeneralMixedAggregateJunctionData +public import LeanPool.ApollonianSuperharmonic.P1BandOrderedGeneralMixedAggregatePairedEndpoints + +-- [TABLET NODE: BandOrderedGeneralMixedAggregatePatches] + +/-! +# BandOrderedGeneralMixedAggregatePatches + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralMixedAggregatePatches + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) + (hsym : QuarterTurnSymmetric T) : + let junctionData : ProtoTile → ProtoTile → ProtoTile → Prop := + fun A B C ↦ ∃ AB BC CA ABC : ProtoTile, + LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ + LatticeTile ABC ∧ + Disjoint A.cells B.cells ∧ Disjoint B.cells C.cells ∧ + Disjoint C.cells A.cells ∧ + (∀ z : LatticeCell, + z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ + (∀ z : LatticeCell, + z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (∀ z : LatticeCell, + z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) ∧ + (∀ z : LatticeCell, + z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ + (FootprintEdges B ∩ FootprintEdges C).Nonempty ∧ + (FootprintEdges C ∩ FootprintEdges A).Nonempty + let pairedEndpointData : Fin 3 → Fin 4 → ProtoTile → ProtoTile → Prop := + fun i s U V ↦ + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) + let uL := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q i.succ) (q 0) + else BandVectors.1 (q 0) (q i.succ)) + ∃ rightData : ExactTileInterfaceTriple T + (TileTranslation T uR) U, + ∃ incomingData : ExactTileInterfaceTriple T + (TileTranslation T uL) U, + ∃ t5Data : ExactTileInterfaceTriple T U V, + rightData.point = t5Data.point ∧ + incomingData.point ≠ t5Data.point ∧ + incomingData.otherCA = t5Data.point ∧ + rightData.otherCA = incomingData.point ∧ + t5Data.otherAB = incomingData.point + (∀ (i : Fin 3) (U : ProtoTile), BandPrototile (q i.succ) U → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + junctionData T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U) ∧ + (∀ (i : Fin 3) (U V : ProtoTile), BandPrototile (q i.succ) U → + BandPrototile (q ((i + 1).succ)) V → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ)))) → + junctionData T U V) ∧ + (∀ (i : Fin 3) (s : Fin 4) (U V : ProtoTile), + BandPrototile (q i.succ) U → + BandPrototile + (q ((if Even s.val then i + 1 else i - 1).succ)) V → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (q ((i + 1).succ)) (q 0) - + BandVectors.1 (q 0) (q ((i + 1).succ)) + else + BandVectors.1 (q 0) (q ((i - 1).succ)) - + BandVectors.1 (q ((i - 1).succ)) (q 0))) → + pairedEndpointData i s U V) := by +-- BODY + have junctions := P1BandOrderedGeneralMixedAggregateJunctionData q cfg C₀ T cert hsym + exact ⟨junctions.1, junctions.2, + P1BandOrderedGeneralMixedAggregatePairedEndpoints q cfg C₀ T cert hsym⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNestedRightOdometerRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNestedRightOdometerRows.lean new file mode 100644 index 0000000000..1e2c86d918 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNestedRightOdometerRows.lean @@ -0,0 +1,269 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorWebRow +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData +public import LeanPool.ApollonianSuperharmonic.BandCircle +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.OdometerWeb +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandOrderedGeneralNestedRightOdometerRows] + +/-! +# BandOrderedGeneralNestedRightOdometerRows + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralNestedRightOdometerRows + (q : Fin 4 -> CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C0 : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C0 T) + (h : PartialOdometer) + (P : Fin 3 -> Bool -> ProtoTile) + (r : Fin 3 -> Bool -> PartialOdometer) + (Q S : Fin 3 -> Bool -> ProtoTile) + (u v : Fin 3 -> Bool -> PartialOdometer) + (g : IntegerLatticeFunction) (x : GaussianInt) (marked : Bool) + (data : BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) + (row : BandOrderedGeneralInteriorWebRow cert x marked) + (right : + (exists + (left_mem : x ∈ FootprintVertices (cert.Q 1 true)) + (right_mem : x ∈ FootprintVertices (cert.P 1 true)) + (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ FootprintVertices (cert.Q 1 true) \/ + y ∈ FootprintVertices (cert.P 1 true)) + (squares : + (forall z, z = x \/ z = x - 1 \/ z = x - ⟨0, 1⟩ \/ + z = x - 1 - ⟨0, 1⟩ -> + z ∈ (cert.Q 1 true).cells \/ + z ∈ (cert.P 1 true).cells) <-> marked = false), + row = .rightPositive left_mem right_mem star squares) \/ + (exists + (left_mem : x ∈ FootprintVertices (cert.S 1 false)) + (right_mem : x ∈ FootprintVertices (cert.P 1 false)) + (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ FootprintVertices (cert.S 1 false) \/ + y ∈ FootprintVertices (cert.P 1 false)) + (squares : + (forall z, z = x \/ z = x - 1 \/ z = x - ⟨0, 1⟩ \/ + z = x - 1 - ⟨0, 1⟩ -> + z ∈ (cert.S 1 false).cells \/ + z ∈ (cert.P 1 false).cells) <-> marked = false), + row = .rightReflected left_mem right_mem star squares)) : + (marked = false -> FourNeighborLaplacian g x = 1) /\ + (marked = true -> FourNeighborLaplacian g x = 0) := by +-- BODY + have laws0 := VectorRecursionLaws q cfg.proper.1 + have hv13 : BandVectors.1 (q 1) (q 3) = + -BandVectors.1 (q 2) (q 1) - BandVectors.1 (q 3) (q 2) := by + apply eq_of_sub_eq_zero + calc + _ = BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 1) (q 3) + + BandVectors.1 (q 2) (q 1) := by ring + _ = 0 := laws0.1 + have ha13 : BandVectors.2 (q 1) (q 3) = + -BandVectors.2 (q 2) (q 1) - BandVectors.2 (q 3) (q 2) := by + apply eq_of_sub_eq_zero + calc + _ = BandVectors.2 (q 3) (q 2) + BandVectors.2 (q 1) (q 3) + + BandVectors.2 (q 2) (q 1) := by ring + _ = 0 := laws0.2.1 + have laws := VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1 + have rotated := VectorRecursionLaws _ + (SemiProperQuadruple.rotate cfg.firstProper.1) + have hv : BandVectors.1 (q 2) (q 1) = + BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) - + (Zsqrtd.mk 0 1 : GaussianInt) * BandVectors.1 (q 3) (q 2) := by + simpa [cfg.firstChild, cfg.firstParentTwo, cfg.firstParentThree] + using rotated.2.2.1 + have ha : BandVectors.2 (q 2) (q 1) = + BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + + (Zsqrtd.mk 0 1 : GaussianInt) * BandVectors.2 (q 3) (q 2) := by + simpa [cfg.firstChild, cfg.firstParentTwo, cfg.firstParentThree] + using rotated.2.2.2.1 + have hvs := laws.1 + have has := laws.2.1 + rw [cfg.firstParentTwo] at hv ha + rw [cfg.firstParentTwo, cfg.firstParentThree] at hvs has + have hv43 : BandVectors.1 (cfg.firstPredecessor 1) (q 3) = + -BandVectors.1 (q 2) (q 1) - + (1 + (Zsqrtd.mk 0 1 : GaussianInt)) * BandVectors.1 (q 3) (q 2) := by + apply eq_of_sub_eq_zero + calc + _ = (BandVectors.1 (q 3) (q 2) + + BandVectors.1 (cfg.firstPredecessor 1) (q 3) + + BandVectors.1 (q 2) (cfg.firstPredecessor 1)) + + (BandVectors.1 (q 2) (q 1) - + (BandVectors.1 (q 2) (cfg.firstPredecessor 1) - + (Zsqrtd.mk 0 1 : GaussianInt) * BandVectors.1 (q 3) (q 2))) := by + ring + _ = 0 := by rw [hvs, hv]; ring + have ha43 : BandVectors.2 (cfg.firstPredecessor 1) (q 3) = + -BandVectors.2 (q 2) (q 1) - + (1 - (Zsqrtd.mk 0 1 : GaussianInt)) * BandVectors.2 (q 3) (q 2) := by + apply eq_of_sub_eq_zero + calc + _ = (BandVectors.2 (q 3) (q 2) + + BandVectors.2 (cfg.firstPredecessor 1) (q 3) + + BandVectors.2 (q 2) (cfg.firstPredecessor 1)) + + (BandVectors.2 (q 2) (q 1) - + (BandVectors.2 (q 2) (cfg.firstPredecessor 1) + + (Zsqrtd.mk 0 1 : GaussianInt) * BandVectors.2 (q 3) (q 2))) := by + ring + _ = 0 := by rw [has, ha]; ring + have flip := (VectorRecursionLaws cfg.secondPredecessor + cfg.secondProper.1).2.2.2.2 cfg.secondProper 0 + simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl, + cfg.secondChild, cfg.secondParentOne] at flip + have positive : 0 < (q 2).1 := by linarith [cfg.secondLarge] + let C2 : BandCircle := + ⟨⟨q 2, Or.inl positive, q, cfg.proper.1, 2, rfl⟩, positive⟩ + -- Keep the nested leaf first, with its own defined slope witness. + have makeRight (s : Bool) (N : ProtoTile) (k : PartialOdometer) + (hNk : TileOdometer (q 2) N k) + (hcent : TileCentroid N - TileCentroid (P 0 s) = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 1) (q 3)) - + (-(GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor 1) (q 3))).2, + (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor 1) (q 3))).1)))) + (hslope : exists p pi : Real × Real, + PartialOdometerSlope (r 0 s) = some p /\ + PartialOdometerSlope k = some pi /\ + pi.1 - p.1 = (if s = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (cfg.firstPredecessor 1) (q 3)).re : Int) - + ((BandVectors.2 (cfg.firstPredecessor 1) (q 3)).im : Int)) /\ + pi.2 - p.2 = (if s = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (cfg.firstPredecessor 1) (q 3)).im : Int) + + ((BandVectors.2 (cfg.firstPredecessor 1) (q 3)).re : Int))) : + RightLatticeAdjacent C2 N (P 1 s) k (r 1 s) := by + obtain ⟨p, p1, hp, hp1, hp1x, hp1y⟩ := + (data.hPslope 0 s).resolve_left (cfg.noLine 1) + obtain ⟨p', p2, hp', hp2, hp2x, hp2y⟩ := + (data.hPslope 1 s).resolve_left (cfg.noLine 2) + have hbase : p' = p := Option.some.inj (hp'.symm.trans hp) + subst p' + obtain ⟨p1', pn, hp1', hpn, hpnx, hpny⟩ := hslope + have hbase1 : p1' = p1 := Option.some.inj (hp1'.symm.trans hp1) + subst p1' + refine ⟨hNk, data.hP 1 s, pn, p2, hpn, hp2, + cfg.secondPredecessor, 0, s, cfg.secondProper, cfg.secondChild, ?_, ?_, ?_⟩ + · have hc1 := data.hPcent 0 s + have hc2 := data.hPcent 1 s + have hn1 := congrArg Prod.fst hcent + have hn2 := congrArg Prod.snd hcent + have hc1x := congrArg Prod.fst hc1 + have hc1y := congrArg Prod.snd hc1 + have hc2x := congrArg Prod.fst hc2 + have hc2y := congrArg Prod.snd hc2 + apply Prod.ext + · cases s <;> + simp [GaussianRealPoint, cfg.secondChild, cfg.secondParentOne, + hv13, hv43, flip.1] at hn1 hc1x hc2x ⊢ <;> linarith + · cases s <;> + simp [GaussianRealPoint, cfg.secondChild, cfg.secondParentOne, + hv13, hv43, flip.1] at hn2 hc1y hc2y ⊢ <;> linarith + · cases s <;> + simp [cfg.secondChild, cfg.secondParentOne, ha13, ha43, flip.2] + at hp1x hp2x hpnx ⊢ <;> linarith + · cases s <;> + simp [cfg.secondChild, cfg.secondParentOne, ha13, ha43, flip.2] + at hp1y hp2y hpny ⊢ <;> linarith + have rightPositive : RightLatticeAdjacent C2 + (Q 1 true) (P 1 true) (u 1 true) (r 1 true) := by + apply makeRight true (Q 1 true) (u 1 true) + · simpa [cfg.firstParentTwo] using data.hQ 1 true + · simpa [cfg.firstParentThree] using data.hQcent 1 true + · have hs := (data.hQslope 1 true).resolve_left (by + simpa [cfg.firstParentTwo] using cfg.noLine 2) + simpa [cfg.firstParentThree] using hs + have rightReflected : RightLatticeAdjacent C2 + (S 1 false) (P 1 false) (v 1 false) (r 1 false) := by + apply makeRight false (S 1 false) (v 1 false) + · simpa [cfg.firstParentTwo] using data.hS 1 false + · simpa [cfg.firstParentThree] using data.hScent 1 false + · have hs := (data.hSslope 1 false).resolve_left (by + simpa [cfg.firstParentTwo] using cfg.noLine 2) + simpa [cfg.firstParentThree] using hs + have finish (N R : ProtoTile) (k l : PartialOdometer) + (adj : RightLatticeAdjacent C2 N R k l) + (extk : GlobalOdometerExtends g k) (extl : GlobalOdometerExtends g l) + (compat : OdometerCompatibility k l) + (memk : x ∈ FootprintVertices N) (meml : x ∈ FootprintVertices R) + (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ FootprintVertices N \/ y ∈ FootprintVertices R) + (squares : (forall z, z = x \/ z = x - 1 \/ z = x - ⟨0, 1⟩ \/ + z = x - 1 - ⟨0, 1⟩ -> z ∈ N.cells \/ z ∈ R.cells) <-> marked = false) : + (marked = false -> FourNeighborLaplacian g x = 1) /\ + (marked = true -> FourNeighborLaplacian g x = 0) := by + have domk := PositiveCurvatureTileOdometerDomain (q 2) N k positive adj.1 + have doml := PositiveCurvatureTileOdometerDomain (q 2) R l positive adj.2.1 + have web := (OdometerWeb.1 C2 N R k l g x compat extk extl + (by + change x ∈ (k.domain : Set GaussianInt) + rw [domk] + exact memk) + (by + change x ∈ (l.domain : Set GaussianInt) + rw [doml] + exact meml) + (by + intro y hy + change y ∈ (k.domain : Set GaussianInt) ∨ y ∈ (l.domain : Set GaussianInt) + rw [domk, doml] + exact star y hy)).2 adj + constructor + · intro hm + exact web.1 (squares.mpr hm) + · intro hm + apply web.2 + intro full + have := squares.mp full + simp [hm] at this + rcases right with pos | neg + · obtain ⟨memQ, memP, star, squares, _⟩ := pos + apply finish (Q 1 true) (P 1 true) (u 1 true) (r 1 true) + rightPositive (data.hextQ 1 true) (data.hextP 1 true) + · exact data.hcompat _ _ ⟨1, true, Or.inr (Or.inl rfl)⟩ + ⟨1, true, Or.inl rfl⟩ + · simpa [(data.hobsQ 1 true).2.1] using memQ + · simpa [(data.hobsP 1 true).2.1] using memP + · simpa [(data.hobsQ 1 true).2.1, (data.hobsP 1 true).2.1] using star + · simpa [(data.hobsQ 1 true).1, (data.hobsP 1 true).1] using squares + · obtain ⟨memS, memP, star, squares, _⟩ := neg + apply finish (S 1 false) (P 1 false) (v 1 false) (r 1 false) + rightReflected (data.hextS 1 false) (data.hextP 1 false) + · exact data.hcompat _ _ ⟨1, false, Or.inr (Or.inr rfl)⟩ + ⟨1, false, Or.inl rfl⟩ + · simpa [(data.hobsS 1 false).2.1] using memS + · simpa [(data.hobsP 1 false).2.1] using memP + · simpa [(data.hobsS 1 false).2.1, (data.hobsP 1 false).2.1] using star + · simpa [(data.hobsS 1 false).1, (data.hobsP 1 false).1] using squares + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNormalizedOccurrenceBundle.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNormalizedOccurrenceBundle.lean new file mode 100644 index 0000000000..c6e1d8f625 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNormalizedOccurrenceBundle.lean @@ -0,0 +1,262 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightPlacement +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtilePlacement +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileOdometer + +-- [TABLET NODE: BandOrderedGeneralNormalizedOccurrenceBundle] + +/-! +# BandOrderedGeneralNormalizedOccurrenceBundle + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $C,D$ be positive band circles, let $(T,h)$ and $(N,k)$ be tile +odometers, and let $x$ be a lattice vertex. A +*normalized routed occurrence bundle* for these data consists of the +following single, mutually aligned package. + +It contains one proper presentation of $C$, one cyclic parent rotation, and +one packing symmetry. Applying that symmetry after that rotation produces +one ordered-general presentation $\bar q$, positive circles $\bar C,\bar D$, +literal transformed supports $\bar T,\bar N$, literal transformed functions +$\bar h,\bar k$, the transformed point $\bar x$, and their defined slopes. +All equalities with the corresponding circle, tile, function, and point +actions are part of the data. + +The bundle contains exactly one family $(S_i^e,f_i^e)$ carrying every +conclusion of the single reindexed six-piece odometer decomposition of +$(\bar T,\bar h)$: the outer band-prototile certificate, all six +tile-odometer certificates, exact cell and domain covers, footprint +containments, centroid formulas, restriction equalities, pairwise +compatibility, and the six zero-curvature-or-slope alternatives. + +It also contains the complete interface of $\bar T$ and $\bar N$ and both +of its endpoint packages. More precisely it stores two third tiles, two +`ExactTileInterfaceTriple` records whose $\bar T$--$\bar N$ paths +are the same path in opposite orientations, lattice-tile certificates, all +five required cell-disjointness assertions, the two literal touching +triples, an actual common edge through $\bar x$, and the induced-edge +properties for the two outer tiles. It stores the transported five-point +star cover and the direction $j$ returned by +`CoveredInterfaceOppositeIncidentCells`, so that +$$ + \operatorname{inc}(\bar x,j)\in\operatorname{cells}(\bar T),\qquad + \operatorname{inc}(\bar x,j+2)\in\operatorname{cells}(\bar N). +$$ +The selected signed piece $S_i^e$ contains the first of these squares. + +Finally the bundle is tagged with exactly one of two placement +certificates. In the right-adjacent case it contains a +`BandOrderedGeneralRightPlacement`: the layout is literally rooted +at $\bar N$, exactly the two pieces of $\bar T$ meeting $\bar N$ are the +cyclically labelled boundary occurrences, the selected routed piece is one +of those two, and the central routed occurrence is only a child of +$\bar N$; the exact translated outer-neighbor alignment of $\bar T$ with +$\bar N$ is retained separately. The other four pieces remain present in +the bundle's single six-piece decomposition but acquire no exterior role. +In the subtile-adjacent case it contains a +`BandOrderedGeneralSubtilePlacement`: the layout is literally +rooted at $\bar T$, its six decomposed pieces are central occurrences, and +$\bar N$ is aligned with the exterior occurrence. Each alternative stores +the routed occurrence memberships and the five-point cover derived from +the same two opposite incident squares. Thus the package uses one packing +symmetry and one decomposition family, while never imposing the right +branch's exterior/central roles on the subtile branch or conversely. +-/ +structure BandOrderedGeneralNormalizedOccurrenceBundle + (C D : BandCircle) (T N : ProtoTile) (h k : PartialOdometer) + (x : GaussianInt) where +-- BODY + /-- The proper source presentation of the root circle. -/ + presentation : Fin 4 -> CircleCoordinates + presentation_proper : ProperBandQuadruple presentation + presentation_child : presentation 0 = C.1.1 + /-- The cyclic parent rotation used before applying the packing symmetry. -/ + parentRotation : Fin 3 + /-- The single packing-symmetry word used throughout the normalization. -/ + symmetry : BandPackingSymmetry + /-- The source presentation after the chosen cyclic parent rotation. -/ + rotatedPresentation : Fin 4 -> CircleCoordinates + rotated_presentation_eq : rotatedPresentation = + ![presentation 0, presentation parentRotation.succ, + presentation (parentRotation + 1).succ, + presentation (parentRotation + 2).succ] + /-- The ordered-general presentation obtained by the symmetry action. -/ + normalizedPresentation : Fin 4 -> CircleCoordinates + normalized_presentation_eq : normalizedPresentation = + BandPackingSymmetryQuadrupleAction symmetry rotatedPresentation + /-- The ordered-general predecessor data for the normalized presentation. -/ + configuration : BandOrderedGeneralConfiguration normalizedPresentation + /-- The positive root circle in the normalized presentation. -/ + normalizedCircle : BandCircle + normalized_circle_eq : normalizedPresentation 0 = normalizedCircle.1.1 + /-- The transformed positive circle of the fixed tile odometer. -/ + normalizedFixedCircle : BandCircle + normalized_fixed_circle_eq : + normalizedFixedCircle.1.1 = BandPackingSymmetryCircleAction symmetry D.1.1 + /-- The literal transformed root support. -/ + normalizedRoot : ProtoTile + /-- The literal transformed fixed support. -/ + normalizedFixed : ProtoTile + /-- The transformed root odometer on its actual finite domain. -/ + normalizedRootFunction : PartialOdometer + /-- The transformed fixed odometer on its actual finite domain. -/ + normalizedFixedFunction : PartialOdometer + /-- The transformed lattice contact point. -/ + normalizedPoint : GaussianInt + normalized_root_eq : normalizedRoot = BandPackingSymmetryTileAction symmetry T + normalized_fixed_eq : normalizedFixed = BandPackingSymmetryTileAction symmetry N + normalized_root_function_eq : normalizedRootFunction = + BandPackingSymmetryPartialOdometerAction symmetry h + normalized_fixed_function_eq : normalizedFixedFunction = + BandPackingSymmetryPartialOdometerAction symmetry k + normalized_point_eq : normalizedPoint = + BandPackingSymmetryVectorAction symmetry x + normalized_root_odometer : + TileOdometer (normalizedPresentation 0) normalizedRoot normalizedRootFunction + normalized_fixed_odometer : + TileOdometer normalizedFixedCircle.1.1 normalizedFixed normalizedFixedFunction + /-- The defined slope of the transformed root odometer. -/ + normalizedRootSlope : Real × Real + /-- The defined slope of the transformed fixed odometer. -/ + normalizedFixedSlope : Real × Real + normalized_root_slope : + PartialOdometerSlope normalizedRootFunction = some normalizedRootSlope + normalized_fixed_slope : + PartialOdometerSlope normalizedFixedFunction = some normalizedFixedSlope + /-- The single family of six signed supports in the normalized root decomposition. -/ + pieces : Fin 3 -> Bool -> ProtoTile + /-- The literal partial odometers on that same six-piece family. -/ + functions : Fin 3 -> Bool -> PartialOdometer + root_band : BandPrototile (normalizedPresentation 0) normalizedRoot + piece_odometer : forall i s, TileOdometer (normalizedPresentation i.succ) + (pieces i s) (functions i s) + piece_cell_cover : forall z, z ∈ normalizedRoot.cells ↔ + exists i s, z ∈ (pieces i s).cells + piece_footprint : forall i s, + FootprintVertices (pieces i s) ⊆ FootprintVertices normalizedRoot + piece_centroid : forall i s, + TileCentroid (pieces i s) - TileCentroid normalizedRoot = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (normalizedPresentation ((i + 2).succ)) + (normalizedPresentation ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (normalizedPresentation ((i + 2).succ)) + (normalizedPresentation ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (normalizedPresentation ((i + 2).succ)) + (normalizedPresentation ((i + 1).succ)))).1))) + function_domain_cover : forall z, z ∈ normalizedRootFunction.domain ↔ + exists i s, z ∈ (functions i s).domain + function_restriction : forall i s z, z ∈ (functions i s).domain -> + normalizedRootFunction.value z = (functions i s).value z + function_compatibility : forall i s j t, + OdometerCompatibility (functions i s) (functions j t) + piece_slope : forall i s, (normalizedPresentation i.succ).1 = 0 ∨ + exists p p_i : Real × Real, + PartialOdometerSlope normalizedRootFunction = some p ∧ + PartialOdometerSlope (functions i s) = some p_i ∧ + p_i.1 - p.1 = + (if s = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (normalizedPresentation ((i + 2).succ)) + (normalizedPresentation ((i + 1).succ))).re : Int) - + ((BandVectors.2 (normalizedPresentation ((i + 2).succ)) + (normalizedPresentation ((i + 1).succ))).im : Int)) ∧ + p_i.2 - p.2 = + (if s = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (normalizedPresentation ((i + 2).succ)) + (normalizedPresentation ((i + 1).succ))).im : Int) + + ((BandVectors.2 (normalizedPresentation ((i + 2).succ)) + (normalizedPresentation ((i + 1).succ))).re : Int)) + /-- The literal third tile at the initial endpoint of the root-fixed interface. -/ + startCompanion : ProtoTile + /-- The literal third tile at the terminal endpoint of that same interface. -/ + endCompanion : ProtoTile + /-- The complete interface triple with its distinguished initial endpoint. -/ + startData : ExactTileInterfaceTriple normalizedRoot normalizedFixed startCompanion + /-- The complete interface triple with the two root-fixed endpoints exchanged. -/ + endData : ExactTileInterfaceTriple normalizedRoot normalizedFixed endCompanion + interface_endpoints : + endData.point = startData.otherAB ∧ endData.otherAB = startData.point + root_lattice : LatticeTile normalizedRoot + fixed_lattice : LatticeTile normalizedFixed + start_lattice : LatticeTile startCompanion + end_lattice : LatticeTile endCompanion + root_fixed_disjoint : Disjoint normalizedRoot.cells normalizedFixed.cells + root_start_disjoint : Disjoint normalizedRoot.cells startCompanion.cells + fixed_start_disjoint : Disjoint normalizedFixed.cells startCompanion.cells + root_end_disjoint : Disjoint normalizedRoot.cells endCompanion.cells + fixed_end_disjoint : Disjoint normalizedFixed.cells endCompanion.cells + start_touching : TouchingTriple normalizedRoot normalizedFixed startCompanion + end_touching : TouchingTriple normalizedRoot normalizedFixed endCompanion + edgeAtPoint : exists edge : Finset GaussianInt, + normalizedPoint ∈ edge ∧ + edge ∈ FootprintEdges normalizedRoot ∩ FootprintEdges normalizedFixed + root_induced : forall y, y ∈ FootprintVertices normalizedRoot -> forall z, + z ∈ FootprintVertices normalizedRoot -> FourNeighborAdjacent y z -> + ({y, z} : Finset GaussianInt) ∈ FootprintEdges normalizedRoot + fixed_induced : forall y, y ∈ FootprintVertices normalizedFixed -> forall z, + z ∈ FootprintVertices normalizedFixed -> FourNeighborAdjacent y z -> + ({y, z} : Finset GaussianInt) ∈ FootprintEdges normalizedFixed + normalized_star : forall y, + y = normalizedPoint ∨ y = normalizedPoint + 1 ∨ + y = normalizedPoint - 1 ∨ y = normalizedPoint + ⟨0, 1⟩ ∨ + y = normalizedPoint - ⟨0, 1⟩ -> + y ∈ FootprintVertices normalizedRoot ∨ + y ∈ FootprintVertices normalizedFixed + /-- The incident-square direction with root and fixed cells in opposite sectors. -/ + routedDirection : Fin 4 + routed_root_cell : + LatticeVertexIncidentCell normalizedPoint routedDirection ∈ normalizedRoot.cells + routed_fixed_cell : LatticeVertexIncidentCell normalizedPoint + (routedDirection + 2) ∈ normalizedFixed.cells + /-- The selected parent slot of the fixed six-piece decomposition. -/ + selectedSlot : Fin 3 + /-- The sign of that selected occurrence in the same decomposition family. -/ + selectedSign : Bool + selected_piece_cell : LatticeVertexIncidentCell normalizedPoint routedDirection ∈ + (pieces selectedSlot selectedSign).cells + /-- The branch-specific right or subtile placement of the single normalized decomposition. -/ + placement : + BandOrderedGeneralRightPlacement normalizedPresentation configuration + normalizedCircle normalizedRoot normalizedFixed normalizedRootFunction + normalizedFixedFunction normalizedPoint pieces functions selectedSlot + selectedSign routedDirection ⊕ + BandOrderedGeneralSubtilePlacement normalizedPresentation configuration + normalizedCircle normalizedFixedCircle normalizedRoot normalizedFixed + normalizedRootFunction normalizedFixedFunction normalizedPoint pieces + functions selectedSlot selectedSign routedDirection + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOdometerRowData.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOdometerRowData.lean new file mode 100644 index 0000000000..a35c1bb679 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOdometerRowData.lean @@ -0,0 +1,238 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import LeanPool.ApollonianSuperharmonic.TileOdometer + +-- [TABLET NODE: BandOrderedGeneralOdometerRowData] + +/-! +# BandOrderedGeneralOdometerRowData + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Fix an ordered-general configuration $q$, its layout certificate, a root +support and tile odometer $(T,h)$, literal outer restriction families +$(P_i^s,r_i^s)$, literal positive and negative first-predecessor restriction +families $(Q_i^s,u_i^s)$ and $(S_i^s,v_i^s)$, and an integer lattice +function $g$. An *ordered-general odometer row datum* consists of the +following simultaneous data. + +First, $(T,h)$ is a `TileOdometer` and $T$ is a +`BandPrototile` for $q_0$. The family $(P,r)$ is the full literal +six-piece decomposition of $(T,h)$: its members are tile odometers for the +three parents of $q$, their cells exactly cover $T$, their footprints lie in +the footprint of $T$, and their centroids have the signed decomposition +offset +$$ + \operatorname{cent}(P_i^s)-\operatorname{cent}(T)={\epsilon_s\over2}(w_i-Jw_i), + \qquad w_i=\operatorname{BandVectors}.1(q_{i+2},q_{i+1}), + \quad J(a,b)=(-b,a). +$$ +Their domains exactly cover $\operatorname{dom} h$, their values are the restrictions of +$h$, and they are pairwise `OdometerCompatibility`-compatible. For +each member, either its parent curvature is zero or its slope and the slope +of $h$ exist and differ by +$$ + {\epsilon_s\over2}(\Re b_i-\Im b_i,\Im b_i+\Re b_i), + \qquad b_i=\operatorname{BandVectors}.2(q_{i+2},q_{i+1}). +$$ + +Second, $(P_1^+,r_1^+)$ and $(P_1^-,r_1^-)$ are tile odometers and band +prototiles for the child of the first predecessor. The families $(Q,u)$ +and $(S,v)$ are their respective full literal six-piece decompositions. +Each retains the same exact cell cover, footprint inclusions, signed +centroid formulas, exact domain cover, pointwise restriction equations, +within-family compatibility, and zero-curvature-or-defined-slope +alternative just specified, now for the certificate's first predecessor. + +Finally, $g$ `GlobalOdometerExtends` every member of all three +function families. Any two functions drawn from their union are +compatible. For each literal support in $P,Q,S$, its cell set, +`FootprintVertices`, boundary footprint, and centroid equal the +corresponding observable of the certificate's labelled support. No +adjacency, marked-point, local-sector, or Laplacian assertion is part of +this datum. +-/ +structure BandOrderedGeneralOdometerRowData + (q : Fin 4 -> CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C0 : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C0 T) + (h : PartialOdometer) + (P : Fin 3 -> Bool -> ProtoTile) + (r : Fin 3 -> Bool -> PartialOdometer) + (Q S : Fin 3 -> Bool -> ProtoTile) + (u v : Fin 3 -> Bool -> PartialOdometer) + (g : IntegerLatticeFunction) : Prop where +-- BODY + hroot : TileOdometer (q 0) T h + hPband : BandPrototile (q 0) T + hP : forall i s, TileOdometer (q i.succ) (P i s) (r i s) + hPcells : forall z, z ∈ T.cells <-> exists i s, z ∈ (P i s).cells + hPfoot : forall i s, + FootprintVertices (P i s) ⊆ FootprintVertices T + hPcent : forall i s, + TileCentroid (P i s) - TileCentroid T = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1))) + hPdom : forall z, z ∈ h.domain <-> exists i s, z ∈ (r i s).domain + hPvalue : forall i s z, z ∈ (r i s).domain -> + h.value z = (r i s).value z + hPcompat : forall i s j t, OdometerCompatibility (r i s) (r j t) + hPslope : forall i s, (q i.succ).1 = 0 \/ + exists p pi : Real × Real, + PartialOdometerSlope h = some p /\ + PartialOdometerSlope (r i s) = some pi /\ + pi.1 - p.1 = + (if s = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).re : Int) - + ((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).im : Int)) /\ + pi.2 - p.2 = + (if s = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).im : Int) + + ((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).re : Int)) + hQroot : TileOdometer (cfg.firstPredecessor 0) + (P 0 true) (r 0 true) + hSroot : TileOdometer (cfg.firstPredecessor 0) + (P 0 false) (r 0 false) + hQband : BandPrototile (cfg.firstPredecessor 0) (P 0 true) + hSband : BandPrototile (cfg.firstPredecessor 0) (P 0 false) + hQ : forall i s, + TileOdometer (cfg.firstPredecessor i.succ) (Q i s) (u i s) + hS : forall i s, + TileOdometer (cfg.firstPredecessor i.succ) (S i s) (v i s) + hQcells : forall z, z ∈ (P 0 true).cells <-> + exists i s, z ∈ (Q i s).cells + hScells : forall z, z ∈ (P 0 false).cells <-> + exists i s, z ∈ (S i s).cells + hQfoot : forall i s, + FootprintVertices (Q i s) ⊆ FootprintVertices (P 0 true) + hSfoot : forall i s, + FootprintVertices (S i s) ⊆ FootprintVertices (P 0 false) + hQcent : forall i s, + TileCentroid (Q i s) - TileCentroid (P 0 true) = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ))) - + (-((GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ)))).2), + (GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ)))).1))) + hScent : forall i s, + TileCentroid (S i s) - TileCentroid (P 0 false) = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ))) - + (-((GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ)))).2), + (GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ)))).1))) + hQdom : forall z, z ∈ (r 0 true).domain <-> + exists i s, z ∈ (u i s).domain + hSdom : forall z, z ∈ (r 0 false).domain <-> + exists i s, z ∈ (v i s).domain + hQvalue : forall i s z, z ∈ (u i s).domain -> + (r 0 true).value z = (u i s).value z + hSvalue : forall i s z, z ∈ (v i s).domain -> + (r 0 false).value z = (v i s).value z + hQcompat : forall i s j t, OdometerCompatibility (u i s) (u j t) + hScompat : forall i s j t, OdometerCompatibility (v i s) (v j t) + hQslope : forall i s, (cfg.firstPredecessor i.succ).1 = 0 \/ + exists p pi : Real × Real, + PartialOdometerSlope (r 0 true) = some p /\ + PartialOdometerSlope (u i s) = some pi /\ + pi.1 - p.1 = + (if s = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ))).re : Int) - + ((BandVectors.2 (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ))).im : Int)) /\ + pi.2 - p.2 = + (if s = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ))).im : Int) + + ((BandVectors.2 (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ))).re : Int)) + hSslope : forall i s, (cfg.firstPredecessor i.succ).1 = 0 \/ + exists p pi : Real × Real, + PartialOdometerSlope (r 0 false) = some p /\ + PartialOdometerSlope (v i s) = some pi /\ + pi.1 - p.1 = + (if s = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ))).re : Int) - + ((BandVectors.2 (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ))).im : Int)) /\ + pi.2 - p.2 = + (if s = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ))).im : Int) + + ((BandVectors.2 (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ))).re : Int)) + hextP : forall i s, GlobalOdometerExtends g (r i s) + hextQ : forall i s, GlobalOdometerExtends g (u i s) + hextS : forall i s, GlobalOdometerExtends g (v i s) + hcompat : forall a b : PartialOdometer, + (exists i s, a = r i s \/ a = u i s \/ a = v i s) -> + (exists i s, b = r i s \/ b = u i s \/ b = v i s) -> + OdometerCompatibility a b + hobsP : forall i s, + (P i s).cells = (cert.P i s).cells /\ + FootprintVertices (P i s) = FootprintVertices (cert.P i s) /\ + BoundaryFootprintVertices (P i s) = + BoundaryFootprintVertices (cert.P i s) /\ + TileCentroid (P i s) = TileCentroid (cert.P i s) + hobsQ : forall i s, + (Q i s).cells = (cert.Q i s).cells /\ + FootprintVertices (Q i s) = FootprintVertices (cert.Q i s) /\ + BoundaryFootprintVertices (Q i s) = + BoundaryFootprintVertices (cert.Q i s) /\ + TileCentroid (Q i s) = TileCentroid (cert.Q i s) + hobsS : forall i s, + (S i s).cells = (cert.S i s).cells /\ + FootprintVertices (S i s) = FootprintVertices (cert.S i s) /\ + BoundaryFootprintVertices (S i s) = + BoundaryFootprintVertices (cert.S i s) /\ + TileCentroid (S i s) = TileCentroid (cert.S i s) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean new file mode 100644 index 0000000000..3a30b658ee --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean @@ -0,0 +1,2329 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorWebRow +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData +public import LeanPool.ApollonianSuperharmonic.OdometerWeb +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandOrderedGeneralOuterMixedOdometerRows] + +/-! +# BandOrderedGeneralOuterMixedOdometerRows + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OuterMixedOdometerGeometry + +private theorem hW : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : + ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : + Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin + (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 + : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q + (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → (BandVectors.1 (q + 1) (q 3) = -U - W) ) := by + classical + intro q U W laws + apply eq_of_sub_eq_zero + dsimp [U, W] + linear_combination laws.1 + +private theorem hA : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : + ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : + Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin + (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 + : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q + (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → (BandVectors.2 (q + 1) (q 3) = -A - B) ) := by + classical + intro q A B laws + apply eq_of_sub_eq_zero + dsimp [A, B] + linear_combination laws.2.1 + +private theorem hrotV : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) - I * W ) := by + classical + intro q cfg I W + simpa [I, W, cfg.firstParentThree, cfg.firstParentTwo] using + (VectorRecursionLaws _ (SemiProperQuadruple.rotate cfg.firstProper.1)).2.2.1 + +private theorem hrotA : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + I * B ) := by + classical + intro q cfg I B + simpa [I, B, cfg.firstParentThree, cfg.firstParentTwo] using + (VectorRecursionLaws _ (SemiProperQuadruple.rotate cfg.firstProper.1)).2.2.2.1 + +private theorem hV21 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) - I * W) → (BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = U + I * W) ) := by + classical + intro q cfg I U W hrotV + have h := hrotV + rw [cfg.firstParentTwo, cfg.firstChild] at h + rw [cfg.firstParentTwo] + dsimp [U, W, I] at h ⊢ + linear_combination -h + +private theorem hA21 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + I * B) → (BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = A - I * B) ) := by + classical + intro q cfg I A B hrotA + have h := hrotA + rw [cfg.firstParentTwo, cfg.firstChild] at h + rw [cfg.firstParentTwo] + dsimp [A, B, I] at h ⊢ + linear_combination -h + +private theorem hV13 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 + : ℕ))) + BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor + (3 : Fin (4 : ℕ))) + BandVectors.1 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 + (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + + BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin + (4 : ℕ))) + BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) = + BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin + (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (cfg.firstPredecessor + (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) = + BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin + (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (cfg.firstPredecessor + (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple + cfg.firstPredecessor → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (cfg.firstPredecessor (0 : + Fin (4 : ℕ))) (cfg.firstPredecessor j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (cfg.firstPredecessor j.succ) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) + ∧ BandVectors.2 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor + j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (cfg.firstPredecessor + j.succ) (cfg.firstPredecessor (0 : Fin (4 : ℕ))))) → ((BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = U + I * W) → (BandVectors.1 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -U - (1 + I) * W)) ) := by + classical + intro q cfg I U W firstLaws hV21 + have h := firstLaws.1 + rw [cfg.firstParentThree, cfg.firstParentTwo] at h + have hV21' := hV21 + rw [cfg.firstParentTwo] at hV21' + rw [hV21'] at h + rw [cfg.firstParentThree] + dsimp [U, W, I] + linear_combination h + +private theorem hA13 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.1 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 + : ℕ))) + BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor + (3 : Fin (4 : ℕ))) + BandVectors.1 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 + (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + + BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin + (4 : ℕ))) + BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) = + BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin + (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (cfg.firstPredecessor + (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) = + BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin + (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (cfg.firstPredecessor + (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple + cfg.firstPredecessor → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (cfg.firstPredecessor (0 : + Fin (4 : ℕ))) (cfg.firstPredecessor j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (cfg.firstPredecessor j.succ) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) + ∧ BandVectors.2 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor + j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (cfg.firstPredecessor + j.succ) (cfg.firstPredecessor (0 : Fin (4 : ℕ))))) → ((BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = A - I * B) → (BandVectors.2 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -A - (1 - I) * B)) ) := by + classical + intro q cfg I A B firstLaws hA21 + have h := firstLaws.2.1 + rw [cfg.firstParentThree, cfg.firstParentTwo] at h + have hA21' := hA21 + rw [cfg.firstParentTwo] at hA21' + rw [hA21'] at h + rw [cfg.firstParentThree] + dsimp [A, B, I] + linear_combination h + +private theorem hpos2 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (BandOrderedGeneralConfiguration q) → (0 < (q 2).1) ) + := by + classical + intro q cfg + have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 1 + have hn' : 0 ≤ (q 2).1 := by simpa using hn + have hne : (q 2).1 ≠ 0 := cfg.noLine 2 + rcases lt_or_gt_of_ne hne with hneg | hpos + · linarith + · exact hpos + +private theorem hpos3 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (BandOrderedGeneralConfiguration q) → (0 < (q 3).1) ) + := by + classical + intro q cfg + have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 2 + have hn' : 0 ≤ (q 3).1 := by simpa using hn + have hne : (q 3).1 ≠ 0 := cfg.noLine 3 + rcases lt_or_gt_of_ne hne with hneg | hpos + · linarith + · exact hpos + +private theorem hpos1 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (BandOrderedGeneralConfiguration q) → (0 < (q 1).1) ) + := by + classical + intro q cfg + have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 0 + have hn' : 0 ≤ (q 1).1 := by simpa using hn + have hne : (q 1).1 ≠ 0 := cfg.noLine 1 + rcases lt_or_gt_of_ne hne with hneg | hpos + · linarith + · exact hpos + +private theorem pPack : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (∀ (i : Fin 3), ∀ (s : Bool), ∃ p pi : Real × + Real, PartialOdometerSlope h = some p ∧ PartialOdometerSlope (r i s) = some pi ∧ pi.1 + - p.1 = (if s then (1 : Real) else -1) * (1 / 2) * (((BandVectors.2 (q ((i + 2).succ) + ) (q ((i + 1).succ))).re : Int) - ((BandVectors.2 (q ((i + 2).succ) ) (q ((i + + 1).succ))).im : Int)) ∧ pi.2 - p.2 = (if s then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (q ((i + 2).succ) ) (q ((i + 1).succ))).im : Int) + ((BandVectors.2 + (q ((i + 2).succ) ) (q ((i + 1).succ))).re : Int))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data i s + rcases data.hPslope i s with hzero | hgood + · have hz : (q i.succ).1 = 0 := by simpa using hzero + exact False.elim ((cfg.noLine i.succ) hz) + · exact hgood + +private theorem hdelta0 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + ∀ (p0 : ℝ × ℝ), ∀ (p0leaf : ℝ × ℝ), (p0leaf.1 - p0.1 = (if true = true then (1 : ℝ) else + (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q ((0 : Fin (3 : ℕ)) + (2 : Fin (3 : + ℕ))).succ) (q ((0 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (q ((0 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((0 : Fin (3 : + ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((p0leaf.2 - p0.2 = (if true = true then + (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q ((0 : Fin (3 : ℕ)) + (2 : + Fin (3 : ℕ))).succ) (q ((0 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + + (↑(BandVectors.2 (q ((0 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((0 : Fin (3 : + ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (p0leaf - p0 = sOff B)) ) := by + classical + intro q B sOff p0 p0leaf hp0x hp0y + apply Prod.ext + · dsimp [sOff] + simpa [Fin.add_def, B] using hp0x + · dsimp [sOff] + simpa [Fin.add_def, B] using hp0y + +private theorem hdelta1 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + (BandVectors.2 (q 1) (q 3) = -A - B) → (∀ (p0 : ℝ × ℝ), ∀ (p1leaf : ℝ × ℝ), (p1leaf.1 - + p0.1 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 + (q ((1 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((1 : Fin (3 : ℕ)) + (1 : Fin (3 + : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q ((1 : Fin (3 : ℕ)) + (2 : Fin (3 : + ℕ))).succ) (q ((1 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((p1leaf.2 - + p0.2 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 + (q ((1 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((1 : Fin (3 : ℕ)) + (1 : Fin (3 + : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q ((1 : Fin (3 : ℕ)) + (2 : Fin (3 : + ℕ))).succ) (q ((1 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (p1leaf - p0 + = -sOff (BandVectors.2 (q 1) (q 3))))) ) := by + classical + intro q A B sOff hA p0 p1leaf hp1x hp1y + apply Prod.ext + · dsimp [sOff] + simpa [Fin.add_def, hA] using hp1x + · dsimp [sOff] + simpa [Fin.add_def, hA] using hp1y + +private theorem hc1minus : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + TileCentroid (P 1 false) - TileCentroid T = -cOff (BandVectors.1 (q 1) (q 3))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data cOff + simpa [cOff, Fin.add_def] using data.hPcent 1 false + +private theorem hcent12 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (BandVectors.1 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 + : ℕ))) + BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor + (3 : Fin (4 : ℕ))) + BandVectors.1 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 + (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + + BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin + (4 : ℕ))) + BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) = + BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin + (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (cfg.firstPredecessor + (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) = + BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin + (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (cfg.firstPredecessor + (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple + cfg.firstPredecessor → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (cfg.firstPredecessor (0 : + Fin (4 : ℕ))) (cfg.firstPredecessor j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (cfg.firstPredecessor j.succ) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) + ∧ BandVectors.2 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor + j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (cfg.firstPredecessor + j.succ) (cfg.firstPredecessor (0 : Fin (4 : ℕ))))) → ((BandVectors.1 (q 1) (q 3) = -U + - W) → ((TileCentroid (P 0 true) - TileCentroid T = cOff W) → ((TileCentroid (P 1 + false) - TileCentroid T = -cOff (BandVectors.1 (q 1) (q 3))) → (TileCentroid (P 1 + false) - TileCentroid (P 0 true) = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : + GaussianInt) ^ (3 : Nat) * (BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0) + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2))))))) ) := by + classical + intro q cfg T P U W cOff firstLaws hW hc0plus hc1minus + let I : GaussianInt := ⟨0, 1⟩ + have hbase : TileCentroid (P 1 false) - TileCentroid (P 0 true) = + -cOff (BandVectors.1 (q 1) (q 3)) - cOff W := by + calc + _ = (TileCentroid (P 1 false) - TileCentroid T) - + (TileCentroid (P 0 true) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = _ := by rw [hc1minus, hc0plus] + have hflipPair := firstLaws.2.2.2.2 cfg.firstProper 1 + have hflip := hflipPair.1 + change BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2) = I * BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) at hflip + rw [cfg.firstChild, cfg.firstParentTwo] at hflip + rw [hbase, hW, cfg.firstVectorTwo] + rw [cfg.firstChild, cfg.firstParentTwo] + rw [hflip] + dsimp [cOff, W, U, I, GaussianRealPoint, Prod.smul_mk, + Prod.add_def, Prod.sub_def] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; simp + +private theorem hsumA12 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.1 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 + : ℕ))) + BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor + (3 : Fin (4 : ℕ))) + BandVectors.1 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 + (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + + BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin + (4 : ℕ))) + BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) = + BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin + (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (cfg.firstPredecessor + (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) = + BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin + (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (cfg.firstPredecessor + (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple + cfg.firstPredecessor → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (cfg.firstPredecessor (0 : + Fin (4 : ℕ))) (cfg.firstPredecessor j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (cfg.firstPredecessor j.succ) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) + ∧ BandVectors.2 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor + j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (cfg.firstPredecessor + j.succ) (cfg.firstPredecessor (0 : Fin (4 : ℕ))))) → ((BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + I * B) → ((BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = A - I * B) → (BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = (1 - I) * A))) ) := by + classical + intro q cfg I A B firstLaws hrotA hA21 + have hflipPair := firstLaws.2.2.2.2 cfg.firstProper 1 + have hflip := hflipPair.2 + change BandVectors.2 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2) = -I * BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) at hflip + have hbase : BandVectors.2 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0) = A := by + rw [hrotA, hA21] + dsimp [A, B] + ring + rw [hbase] at hflip ⊢ + linear_combination hflip + +private theorem hslope12 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + (BandVectors.2 (q 1) (q 3) = -A - B) → (∀ (p0 : ℝ × ℝ), ∀ (p0leaf : ℝ × ℝ), ∀ (p1leaf : ℝ + × ℝ), (p0leaf - p0 = sOff B) → ((p1leaf - p0 = -sOff (BandVectors.2 (q 1) (q 3))) → + ((BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = (1 - I) * A) → (p1leaf - p0leaf = + (1 / 2 : Real) • GaussianRealPoint (((-⟨0, 1⟩ : GaussianInt) ^ (3 : Nat)) * + (BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2))))))) ) := by + classical + intro q cfg I A B sOff hA p0 p0leaf p1leaf hdelta0 hdelta1 hsumA12 + have hbase : p1leaf - p0leaf = sOff A := by + calc + _ = (p1leaf - p0) - (p0leaf - p0) := by ext <;> dsimp <;> ring + _ = -sOff (BandVectors.2 (q 1) (q 3)) - sOff B := by rw [hdelta1, hdelta0] + _ = sOff A := by rw [hA]; dsimp [A, B, sOff]; ext <;> norm_num [I] <;> ring + rw [hbase, hsumA12] + dsimp [sOff, GaussianRealPoint] + norm_num [GaussianRealPoint, I, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem adj12 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (∀ (hpos2 : 0 < (q 2).1), ∀ (hpos1 : 0 < (q 1).1), + let C1 : BandCircle := ⟨⟨q 1, Or.inl hpos1, q, cfg.proper.1, 1, rfl⟩, hpos1⟩ + let C2 : BandCircle := ⟨⟨q 2, Or.inl hpos2, q, cfg.proper.1, 2, rfl⟩, hpos2⟩ + ∀ (p0leaf : ℝ × ℝ), (PartialOdometerSlope (r (0 : Fin (3 : ℕ)) true) = some p0leaf) → (∀ + (p1leaf : ℝ × ℝ), (PartialOdometerSlope (r (1 : Fin (3 : ℕ)) false) = some p1leaf) → + ((TileCentroid (P 1 false) - TileCentroid (P 0 true) = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * (BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2)))) → ((p1leaf - p0leaf = (1 / 2 : + Real) • GaussianRealPoint (((-⟨0, 1⟩ : GaussianInt) ^ (3 : Nat)) * (BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2)))) → (SubtileLatticeAdjacent C1 C2 + (P 0 true) (P 1 false) (r 0 true) (r 1 false)))))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data hpos2 hpos1 C1 C2 p0leaf hp0leaf p1leaf hp1leaf + hcent12 hslope12 + refine ⟨?_, ?_, ⟨p0leaf, p1leaf, hp0leaf, hp1leaf, ?_⟩⟩ + · simpa [C1, cfg.firstChild] using data.hP 0 true + · simpa [C2, cfg.firstParentTwo] using data.hP 1 false + refine ⟨cfg.firstPredecessor, 1, 3, cfg.firstProper, ?_, ?_, hcent12, ?_, ?_⟩ + · simpa [C1] using cfg.firstChild + · simpa [C2] using cfg.firstParentTwo + · exact congrArg Prod.fst hslope12 + · exact congrArg Prod.snd hslope12 + +private theorem hdelta2 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + ∀ (p0 : ℝ × ℝ), ∀ (p2leaf : ℝ × ℝ), (p2leaf.1 - p0.1 = (if false = true then (1 : ℝ) else + (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : Fin (3 : + ℕ))).succ) (q ((2 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((2 : Fin (3 : + ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((p2leaf.2 - p0.2 = (if false = true then + (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : + Fin (3 : ℕ))).succ) (q ((2 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + + (↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((2 : Fin (3 : + ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (p2leaf - p0 = -sOff A)) ) := by + classical + intro q A sOff p0 p2leaf hp2x hp2y + apply Prod.ext + · dsimp [sOff] + simpa [Fin.add_def, A] using hp2x + · dsimp [sOff] + simpa [Fin.add_def, A] using hp2y + +private theorem hrot2V : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 2) - I * BandVectors.1 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) ) := by + classical + intro q cfg I + simpa [I] using (VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate cfg.firstProper.1))).2.2.1 + +private theorem hV30 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + (I * I = -1) → ( + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -U - (1 + I) * W) → + ((BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 2) - I * BandVectors.1 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)) → (BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = I * (U + W)))) ) := by + classical + intro q cfg I hImul U W hV13 hrot2V + rw [hrot2V, hV13, cfg.firstParentThree, cfg.firstParentTwo] + dsimp [U, W] + linear_combination hImul * BandVectors.1 (q 3) (q 2) + +private theorem hsumV03 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = I * (U + W)) → + ((BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = I * BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0)) → (BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = (1 + I) * (I * (U + W)))) ) := by + classical + intro q cfg I U W hV30 hflip03 + rw [hflip03, hV30] + ring + +private theorem hcent13 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (TileCentroid (P 0 true) - TileCentroid T = cOff W) → ((TileCentroid (P 2 false) - + TileCentroid T = -cOff U) → ((BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0) + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 3) = (1 + I) * (I * (U + W))) → (TileCentroid (P 2 false) - + TileCentroid (P 0 true) = (1 / 2 : Real) • GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3))))) ) := by + classical + intro q cfg T P I U W cOff hc0plus hc2minus hsumV03 + have hbase : TileCentroid (P 2 false) - TileCentroid (P 0 true) = + -cOff U - cOff W := by + calc + _ = (TileCentroid (P 2 false) - TileCentroid T) - + (TileCentroid (P 0 true) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = _ := by rw [hc2minus, hc0plus] + rw [hbase, hsumV03] + dsimp [cOff, GaussianRealPoint, I, U, W, Prod.smul_mk, + Prod.add_def, Prod.sub_def] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem hrot2A : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = BandVectors.2 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 2) + I * BandVectors.2 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) ) := by + classical + intro q cfg I + simpa [I] using (VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate cfg.firstProper.1))).2.2.2.1 + +private theorem hA30 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + (I * I = -1) → ( + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -A - (1 - I) * B) → + ((BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = BandVectors.2 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 2) + I * BandVectors.2 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)) → (BandVectors.2 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = -I * (A + B)))) ) := by + classical + intro q cfg I hImul A B hA13 hrot2A + rw [hrot2A, hA13, cfg.firstParentThree, cfg.firstParentTwo] + dsimp [A, B] + linear_combination hImul * BandVectors.2 (q 3) (q 2) + +private theorem hsumA03 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = -I * (A + B)) → + ((BandVectors.2 (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = -I * + BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0)) → (BandVectors.2 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = (1 - I) * (-I * (A + B)))) ) := by + classical + intro q cfg I A B hA30 hflip03A + rw [hflip03A, hA30] + ring + +private theorem hslope13 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + ∀ (p0 : ℝ × ℝ), ∀ (p0leaf : ℝ × ℝ), (p0leaf - p0 = sOff B) → (∀ (p2leaf : ℝ × ℝ), (p2leaf + - p0 = -sOff A) → ((BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + + BandVectors.2 (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = (1 - I) * (-I * (A + + B))) → (p2leaf - p0leaf = (1 / 2 : Real) • GaussianRealPoint (BandVectors.2 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3))))) ) := by + classical + intro q cfg I A B sOff p0 p0leaf hdelta0 p2leaf hdelta2 hsumA03 + have hbase : p2leaf - p0leaf = -sOff (A + B) := by + calc + _ = (p2leaf - p0) - (p0leaf - p0) := by ext <;> dsimp <;> ring + _ = -sOff A - sOff B := by rw [hdelta2, hdelta0] + _ = -sOff (A + B) := by + dsimp [sOff] + ext <;> norm_num [I] <;> ring + rw [hbase, hsumA03] + dsimp [sOff, GaussianRealPoint, I, A, B, Prod.smul_mk, Prod.add_def, + Prod.sub_def] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem adj13 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (∀ (hpos3 : 0 < (q 3).1), ∀ (hpos1 : 0 < (q 1).1), + let C1 : BandCircle := ⟨⟨q 1, Or.inl hpos1, q, cfg.proper.1, 1, rfl⟩, hpos1⟩ + let C3 : BandCircle := ⟨⟨q 3, Or.inl hpos3, q, cfg.proper.1, 3, rfl⟩, hpos3⟩ + ∀ (p0leaf : ℝ × ℝ), (PartialOdometerSlope (r (0 : Fin (3 : ℕ)) true) = some p0leaf) → (∀ + (p2leaf : ℝ × ℝ), (PartialOdometerSlope (r (2 : Fin (3 : ℕ)) false) = some p2leaf) → + ((TileCentroid (P 2 false) - TileCentroid (P 0 true) = (1 / 2 : Real) • + GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + + BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 3))) → ((p2leaf - p0leaf + = (1 / 2 : Real) • GaussianRealPoint (BandVectors.2 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0) + BandVectors.2 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 3))) → (SubtileLatticeAdjacent C1 C3 (P 0 true) (P 2 false) (r + 0 true) (r 2 false)))))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data hpos3 hpos1 C1 C3 p0leaf hp0leaf p2leaf hp2leaf + hcent13 hslope13 + refine ⟨?_, ?_, ⟨p0leaf, p2leaf, hp0leaf, hp2leaf, ?_⟩⟩ + · simpa [C1, cfg.firstChild] using data.hP 0 true + · simpa [C3, cfg.firstParentThree] using data.hP 2 false + refine ⟨cfg.firstPredecessor, 2, 0, cfg.firstProper, ?_, ?_, ?_, ?_, ?_⟩ + · simpa [C1] using cfg.firstChild + · simpa [C3] using cfg.firstParentThree + · simpa using hcent13 + · simpa using congrArg Prod.fst hslope13 + · simpa using congrArg Prod.snd hslope13 + +private theorem hdelta1p : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + ∀ (p0 : ℝ × ℝ), ∀ (p1pleaf : ℝ × ℝ), (p1pleaf.1 - p0.1 = (if true = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q ((1 : Fin (3 : ℕ)) + (2 : Fin (3 + : ℕ))).succ) (q ((1 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (q ((1 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((1 : Fin (3 : + ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((p1pleaf.2 - p0.2 = (if true = true then + (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q ((1 : Fin (3 : ℕ)) + (2 : + Fin (3 : ℕ))).succ) (q ((1 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + + (↑(BandVectors.2 (q ((1 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((1 : Fin (3 : + ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (p1pleaf - p0 = sOff (BandVectors.2 (q 1) + (q 3)))) ) := by + classical + intro q sOff p0 p1pleaf hp1px hp1py + apply Prod.ext + · dsimp [sOff] + simpa [Fin.add_def] using hp1px + · dsimp [sOff] + simpa [Fin.add_def] using hp1py + +private theorem hdelta0m : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + ∀ (p0 : ℝ × ℝ), ∀ (p0mleaf : ℝ × ℝ), (p0mleaf.1 - p0.1 = (if false = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q ((0 : Fin (3 : ℕ)) + (2 : Fin (3 + : ℕ))).succ) (q ((0 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (q ((0 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((0 : Fin (3 : + ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((p0mleaf.2 - p0.2 = (if false = true + then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q ((0 : Fin (3 : ℕ)) + + (2 : Fin (3 : ℕ))).succ) (q ((0 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + + (↑(BandVectors.2 (q ((0 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((0 : Fin (3 : + ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (p0mleaf - p0 = -sOff B)) ) := by + classical + intro q B sOff p0 p0mleaf hp0mx hp0my + apply Prod.ext + · dsimp [sOff, B] + simpa [Fin.add_def] using hp0mx + · dsimp [sOff, B] + simpa [Fin.add_def] using hp0my + +private theorem hpair21base : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + (BandVectors.2 (q 1) (q 3) = -A - B) → (∀ (p0 : ℝ × ℝ), ∀ (p1pleaf : ℝ × ℝ), ∀ (p0mleaf : + ℝ × ℝ), (p1pleaf - p0 = sOff (BandVectors.2 (q 1) (q 3))) → ((p0mleaf - p0 = -sOff B) + → (p1pleaf - p0mleaf = -sOff A))) ) := by + classical + intro q A B sOff hA p0 p1pleaf p0mleaf hdelta1p hdelta0m + calc + _ = (p1pleaf - p0) - (p0mleaf - p0) := by ext <;> dsimp <;> ring + _ = sOff (BandVectors.2 (q 1) (q 3)) - (-sOff B) := by + rw [hdelta1p, hdelta0m] + _ = -sOff A := by rw [hA]; dsimp [A, B, sOff]; ext <;> norm_num <;> ring + +private theorem hflip12 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + (BandVectors.1 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor (Fin.succ + (1 : Fin (3 : ℕ)))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 + (cfg.firstPredecessor (Fin.succ (1 : Fin (3 : ℕ)))) (cfg.firstPredecessor (0 : Fin (4 + : ℕ))) ∧ BandVectors.2 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor + (Fin.succ (1 : Fin (3 : ℕ)))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 + (cfg.firstPredecessor (Fin.succ (1 : Fin (3 : ℕ)))) (cfg.firstPredecessor (0 : Fin (4 + : ℕ)))) → (BandVectors.1 (q 1) (q 2) = I * U) ) := by + classical + intro q cfg I U hflip12pair + have hflip := hflip12pair.1 + change BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2) = I * BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) at hflip + rw [cfg.firstVectorTwo, cfg.firstChild, cfg.firstParentTwo] at hflip + exact hflip + +private theorem hsumV12 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + (BandVectors.1 (q 1) (q 2) = I * U) → (BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0) + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2) = (1 + I) * U) ) := by + classical + intro q cfg I U hflip12 + rw [cfg.firstVectorTwo, cfg.firstChild, cfg.firstParentTwo, hflip12] + ring + +private theorem hc1plus : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + TileCentroid (P 1 true) - TileCentroid T = cOff (BandVectors.1 (q 1) (q 3))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data cOff + simpa [cOff, Fin.add_def] using data.hPcent 1 true + +private theorem hcent21 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (BandVectors.1 (q 1) (q 3) = -U - W) → ((BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0) + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2) = (1 + I) * U) → ((TileCentroid (P 1 true) - TileCentroid T + = cOff (BandVectors.1 (q 1) (q 3))) → ((TileCentroid (P 0 false) - TileCentroid T = + -cOff W) → (TileCentroid (P 1 true) - TileCentroid (P 0 false) = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * (BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2))))))) ) := by + classical + intro q cfg T P I U W cOff hW hsumV12 hc1plus hc0minus + have hbase : TileCentroid (P 1 true) - TileCentroid (P 0 false) = + -cOff U := by + calc + _ = (TileCentroid (P 1 true) - TileCentroid T) - + (TileCentroid (P 0 false) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = _ := by + rw [hc1plus, hc0minus, hW] + dsimp [cOff, GaussianRealPoint, U, W] + ext <;> push_cast <;> ring + rw [hbase, hsumV12] + dsimp [cOff, GaussianRealPoint, U, I, Prod.smul_mk, + Prod.add_def, Prod.sub_def] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem hslope21 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + (BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = (1 - I) * A) → (∀ (p1pleaf : ℝ × + ℝ), ∀ (p0mleaf : ℝ × ℝ), (p1pleaf - p0mleaf = -sOff A) → (p1pleaf - p0mleaf = (1 / 2 + : Real) • GaussianRealPoint (((-⟨0, 1⟩ : GaussianInt) ^ (1 : Nat)) * (BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2))))) ) := by + classical + intro q cfg I A sOff hsumA12 p1pleaf p0mleaf hpair21base + rw [hpair21base, hsumA12] + dsimp [sOff, GaussianRealPoint, A, I, Prod.smul_mk, Prod.add_def, + Prod.sub_def] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem adj21 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (∀ (hpos2 : 0 < (q 2).1), ∀ (hpos1 : 0 < (q 1).1), + let C1 : BandCircle := ⟨⟨q 1, Or.inl hpos1, q, cfg.proper.1, 1, rfl⟩, hpos1⟩ + let C2 : BandCircle := ⟨⟨q 2, Or.inl hpos2, q, cfg.proper.1, 2, rfl⟩, hpos2⟩ + ∀ (p1pleaf : ℝ × ℝ), (PartialOdometerSlope (r (1 : Fin (3 : ℕ)) true) = some p1pleaf) → + (∀ (p0mleaf : ℝ × ℝ), (PartialOdometerSlope (r (0 : Fin (3 : ℕ)) false) = some + p0mleaf) → ((TileCentroid (P 1 true) - TileCentroid (P 0 false) = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * (BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2)))) → ((p1pleaf - p0mleaf = (1 / 2 : + Real) • GaussianRealPoint (((-⟨0, 1⟩ : GaussianInt) ^ (1 : Nat)) * (BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2)))) → (SubtileLatticeAdjacent C1 C2 + (P 0 false) (P 1 true) (r 0 false) (r 1 true)))))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data hpos2 hpos1 C1 C2 p1pleaf hp1pleaf p0mleaf hp0mleaf + hcent21 hslope21 + refine ⟨?_, ?_, ⟨p0mleaf, p1pleaf, hp0mleaf, hp1pleaf, ?_⟩⟩ + · simpa [C1, cfg.firstChild] using data.hP 0 false + · simpa [C2, cfg.firstParentTwo] using data.hP 1 true + refine ⟨cfg.firstPredecessor, 1, 1, cfg.firstProper, ?_, ?_, ?_, ?_, ?_⟩ + · simpa [C1] using cfg.firstChild + · simpa [C2] using cfg.firstParentTwo + · simpa using hcent21 + · exact congrArg Prod.fst hslope21 + · exact congrArg Prod.snd hslope21 + +private theorem hdelta2p : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + ∀ (p0 : ℝ × ℝ), ∀ (p2pleaf : ℝ × ℝ), (p2pleaf.1 - p0.1 = (if true = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : Fin (3 + : ℕ))).succ) (q ((2 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((2 : Fin (3 : + ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((p2pleaf.2 - p0.2 = (if true = true then + (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : + Fin (3 : ℕ))).succ) (q ((2 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + + (↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((2 : Fin (3 : + ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (p2pleaf - p0 = sOff A)) ) := by + classical + intro q A sOff p0 p2pleaf hp2px hp2py + apply Prod.ext + · dsimp [sOff, A] + simpa [Fin.add_def] using hp2px + · dsimp [sOff, A] + simpa [Fin.add_def] using hp2py + +private theorem hpair31base : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + ∀ (p0 : ℝ × ℝ), ∀ (p0mleaf : ℝ × ℝ), (p0mleaf - p0 = -sOff B) → (∀ (p2pleaf : ℝ × ℝ), + (p2pleaf - p0 = sOff A) → (p2pleaf - p0mleaf = sOff (A + B))) ) := by + classical + intro q A B sOff p0 p0mleaf hdelta0m p2pleaf hdelta2p + calc + _ = (p2pleaf - p0) - (p0mleaf - p0) := by ext <;> dsimp <;> ring + _ = sOff A - (-sOff B) := by rw [hdelta2p, hdelta0m] + _ = sOff (A + B) := by + dsimp [sOff] + ext <;> norm_num <;> ring + +private theorem hcent31 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = (1 + I) * (I * (U + W))) → + ((TileCentroid (P 0 false) - TileCentroid T = -cOff W) → ((TileCentroid (P 2 true) - + TileCentroid T = cOff U) → (TileCentroid (P 2 true) - TileCentroid (P 0 false) = (1 / + 2 : Real) • GaussianRealPoint (((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat)) * (BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3)))))) ) := by + classical + intro q cfg T P I U W cOff hsumV03 hc0minus hc2plus + have hbase : TileCentroid (P 2 true) - TileCentroid (P 0 false) = + cOff (U + W) := by + calc + _ = (TileCentroid (P 2 true) - TileCentroid T) - + (TileCentroid (P 0 false) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = _ := by rw [hc2plus, hc0minus]; dsimp [cOff, GaussianRealPoint, U, W]; ext <;> + push_cast <;> ring + rw [hbase, hsumV03] + dsimp [cOff, GaussianRealPoint, I, U, W, Prod.smul_mk, + Prod.add_def, Prod.sub_def] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem hslope31 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + (BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = (1 - I) * (-I * (A + B))) → (∀ + (p0mleaf : ℝ × ℝ), ∀ (p2pleaf : ℝ × ℝ), (p2pleaf - p0mleaf = sOff (A + B)) → (p2pleaf + - p0mleaf = (1 / 2 : Real) • GaussianRealPoint (((-⟨0, 1⟩ : GaussianInt) ^ (2 : Nat)) + * (BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3))))) ) := by + classical + intro q cfg I A B sOff hsumA03 p0mleaf p2pleaf hpair31base + rw [hpair31base, hsumA03] + dsimp [sOff, GaussianRealPoint, I, A, B, Prod.smul_mk, Prod.add_def, + Prod.sub_def] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring + +private theorem adj31 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (∀ (hpos3 : 0 < (q 3).1), ∀ (hpos1 : 0 < (q 1).1), + let C1 : BandCircle := ⟨⟨q 1, Or.inl hpos1, q, cfg.proper.1, 1, rfl⟩, hpos1⟩ + let C3 : BandCircle := ⟨⟨q 3, Or.inl hpos3, q, cfg.proper.1, 3, rfl⟩, hpos3⟩ + ∀ (p0mleaf : ℝ × ℝ), (PartialOdometerSlope (r (0 : Fin (3 : ℕ)) false) = some p0mleaf) → + (∀ (p2pleaf : ℝ × ℝ), (PartialOdometerSlope (r (2 : Fin (3 : ℕ)) true) = some + p2pleaf) → ((TileCentroid (P 2 true) - TileCentroid (P 0 false) = (1 / 2 : Real) • + GaussianRealPoint (((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat)) * (BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3)))) → ((p2pleaf - p0mleaf = (1 / 2 : + Real) • GaussianRealPoint (((-⟨0, 1⟩ : GaussianInt) ^ (2 : Nat)) * (BandVectors.2 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3)))) → (SubtileLatticeAdjacent C1 C3 + (P 0 false) (P 2 true) (r 0 false) (r 2 true)))))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data hpos3 hpos1 C1 C3 p0mleaf hp0mleaf p2pleaf hp2pleaf + hcent31 hslope31 + refine ⟨?_, ?_, ⟨p0mleaf, p2pleaf, hp0mleaf, hp2pleaf, ?_⟩⟩ + · simpa [C1, cfg.firstChild] using data.hP 0 false + · simpa [C3, cfg.firstParentThree] using data.hP 2 true + refine ⟨cfg.firstPredecessor, 2, 2, cfg.firstProper, ?_, ?_, ?_, ?_, ?_⟩ + · simpa [C1] using cfg.firstChild + · simpa [C3] using cfg.firstParentThree + · simpa using hcent31 + · exact congrArg Prod.fst hslope31 + · exact congrArg Prod.snd hslope31 + +private theorem hsumVsecond : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = I * BandVectors.1 (q (3 : + Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → (BandVectors.1 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = (1 + I) * W) ) := by + classical + intro q cfg I W hflipV + rw [cfg.secondVectorOne, cfg.secondChild, cfg.secondParentOne, hflipV] + ring + +private theorem hsumAsecond : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = -I * BandVectors.2 (q (3 : + Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → (BandVectors.2 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = (1 - I) * B) ) := by + classical + intro q cfg I B hflipA + rw [cfg.secondParentOne, cfg.secondChild, hflipA] + ring + +private theorem hpair23base : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + (BandVectors.2 (q 1) (q 3) = -A - B) → (∀ (p0 : ℝ × ℝ), ∀ (p2leaf : ℝ × ℝ), (p2leaf - p0 + = -sOff A) → (∀ (p1pleaf : ℝ × ℝ), (p1pleaf - p0 = sOff (BandVectors.2 (q 1) (q 3))) + → (p2leaf - p1pleaf = sOff B))) ) := by + classical + intro q A B sOff hA p0 p2leaf hdelta2 p1pleaf hdelta1p + calc + _ = (p2leaf - p0) - (p1pleaf - p0) := by ext <;> dsimp <;> ring + _ = -sOff A - sOff (BandVectors.2 (q 1) (q 3)) := by + rw [hdelta2, hdelta1p] + _ = sOff B := by rw [hA]; dsimp [A, B, sOff]; ext <;> push_cast <;> ring + +private theorem hcent23 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (BandVectors.1 (q 1) (q 3) = -U - W) → ((TileCentroid (P 2 false) - TileCentroid T = + -cOff U) → ((TileCentroid (P 1 true) - TileCentroid T = cOff (BandVectors.1 (q 1) (q + 3))) → ((BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + + BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) = (1 + I) * W) → + (TileCentroid (P 2 false) - TileCentroid (P 1 true) = (1 / 2 : Real) • + GaussianRealPoint (((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat)) * (BandVectors.1 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.1 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1))))))) ) := by + classical + intro q cfg T P I U W cOff hW hc2minus hc1plus hsumVsecond + have hbase : TileCentroid (P 2 false) - TileCentroid (P 1 true) = cOff W := by + calc + _ = (TileCentroid (P 2 false) - TileCentroid T) - + (TileCentroid (P 1 true) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = _ := by + rw [hc2minus, hc1plus, hW] + dsimp [cOff, GaussianRealPoint, U, W] + ext <;> push_cast <;> ring + rw [hbase, hsumVsecond] + dsimp [cOff, GaussianRealPoint, W, I, Prod.smul_mk, + Prod.add_def, Prod.sub_def] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem hslope23 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + ∀ (p2leaf : ℝ × ℝ), ∀ (p1pleaf : ℝ × ℝ), (BandVectors.2 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = (1 - I) * B) → ((p2leaf - p1pleaf = sOff B) → (p2leaf - + p1pleaf = (1 / 2 : Real) • GaussianRealPoint (((-⟨0, 1⟩ : GaussianInt) ^ (3 : Nat)) * + (BandVectors.2 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.2 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1))))) ) := by + classical + intro q cfg I B sOff p2leaf p1pleaf hsumAsecond hpair23base + rw [hpair23base, hsumAsecond] + dsimp [sOff, GaussianRealPoint, I, B, Prod.smul_mk, Prod.add_def, + Prod.sub_def] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem hpair32base : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + (BandVectors.2 (q 1) (q 3) = -A - B) → (∀ (p0 : ℝ × ℝ), ∀ (p1leaf : ℝ × ℝ), (p1leaf - p0 + = -sOff (BandVectors.2 (q 1) (q 3))) → (∀ (p2pleaf : ℝ × ℝ), (p2pleaf - p0 = sOff A) + → (p2pleaf - p1leaf = -sOff B))) ) := by + classical + intro q A B sOff hA p0 p1leaf hdelta1 p2pleaf hdelta2p + calc + _ = (p2pleaf - p0) - (p1leaf - p0) := by ext <;> dsimp <;> ring + _ = sOff A - sOff (A + B) := by + rw [hdelta2p, hdelta1, hA] + dsimp [sOff, A, B] + ext <;> push_cast <;> ring + _ = -sOff B := by dsimp [sOff]; ext <;> push_cast <;> ring + +private theorem hcent32 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (BandVectors.1 (q 1) (q 3) = -U - W) → ((TileCentroid (P 1 false) - TileCentroid T = + -cOff (BandVectors.1 (q 1) (q 3))) → ((TileCentroid (P 2 true) - TileCentroid T = + cOff U) → ((BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + + BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) = (1 + I) * W) → + (TileCentroid (P 2 true) - TileCentroid (P 1 false) = (1 / 2 : Real) • + GaussianRealPoint (((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat)) * (BandVectors.1 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.1 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1))))))) ) := by + classical + intro q cfg T P I U W cOff hW hc1minus hc2plus hsumVsecond + have hbase : TileCentroid (P 2 true) - TileCentroid (P 1 false) = -cOff W := by + calc + _ = (TileCentroid (P 2 true) - TileCentroid T) - + (TileCentroid (P 1 false) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = _ := by + rw [hc2plus, hc1minus, hW] + dsimp [cOff, GaussianRealPoint, U, W] + ext <;> push_cast <;> ring + rw [hbase, hsumVsecond] + dsimp [cOff, GaussianRealPoint, W, I, Prod.smul_mk, + Prod.add_def, Prod.sub_def] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem hslope32 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + ∀ (p1leaf : ℝ × ℝ), ∀ (p2pleaf : ℝ × ℝ), (BandVectors.2 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = (1 - I) * B) → ((p2pleaf - p1leaf = -sOff B) → (p2pleaf - + p1leaf = (1 / 2 : Real) • GaussianRealPoint (((-⟨0, 1⟩ : GaussianInt) ^ (1 : Nat)) * + (BandVectors.2 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.2 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1))))) ) := by + classical + intro q cfg I B sOff p1leaf p2pleaf hsumAsecond hpair32base + rw [hpair32base, hsumAsecond] + dsimp [sOff, GaussianRealPoint, I, B, Prod.smul_mk, Prod.add_def, + Prod.sub_def] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem adj23 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (∀ (hpos2 : 0 < (q 2).1), ∀ (hpos3 : 0 < (q 3).1), + let C2 : BandCircle := ⟨⟨q 2, Or.inl hpos2, q, cfg.proper.1, 2, rfl⟩, hpos2⟩ + let C3 : BandCircle := ⟨⟨q 3, Or.inl hpos3, q, cfg.proper.1, 3, rfl⟩, hpos3⟩ + ∀ (p2leaf : ℝ × ℝ), (PartialOdometerSlope (r (2 : Fin (3 : ℕ)) false) = some p2leaf) → (∀ + (p1pleaf : ℝ × ℝ), (PartialOdometerSlope (r (1 : Fin (3 : ℕ)) true) = some p1pleaf) → + ((TileCentroid (P 2 false) - TileCentroid (P 1 true) = (1 / 2 : Real) • + GaussianRealPoint (((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat)) * (BandVectors.1 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.1 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1)))) → ((p2leaf - p1pleaf = (1 / 2 + : Real) • GaussianRealPoint (((-⟨0, 1⟩ : GaussianInt) ^ (3 : Nat)) * (BandVectors.2 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.2 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1)))) → (SubtileLatticeAdjacent C2 + C3 (P 1 true) (P 2 false) (r 1 true) (r 2 false)))))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data hpos2 hpos3 C2 C3 p2leaf hp2leaf p1pleaf hp1pleaf + hcent23 hslope23 + refine ⟨?_, ?_, ⟨p1pleaf, p2leaf, hp1pleaf, hp2leaf, ?_⟩⟩ + · simpa [C2, cfg.secondChild, cfg.firstParentTwo] using data.hP 1 true + · simpa [C3, cfg.secondParentOne, cfg.firstParentThree] using data.hP 2 false + refine ⟨cfg.secondPredecessor, 0, 3, cfg.secondProper, ?_, ?_, ?_, ?_, ?_⟩ + · simpa [C2] using cfg.secondChild + · simpa [C3] using cfg.secondParentOne + · simpa using hcent23 + · exact congrArg Prod.fst hslope23 + · exact congrArg Prod.snd hslope23 + +private theorem adj32 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (∀ (hpos2 : 0 < (q 2).1), ∀ (hpos3 : 0 < (q 3).1), + let C2 : BandCircle := ⟨⟨q 2, Or.inl hpos2, q, cfg.proper.1, 2, rfl⟩, hpos2⟩ + let C3 : BandCircle := ⟨⟨q 3, Or.inl hpos3, q, cfg.proper.1, 3, rfl⟩, hpos3⟩ + ∀ (p1leaf : ℝ × ℝ), (PartialOdometerSlope (r (1 : Fin (3 : ℕ)) false) = some p1leaf) → (∀ + (p2pleaf : ℝ × ℝ), (PartialOdometerSlope (r (2 : Fin (3 : ℕ)) true) = some p2pleaf) → + ((TileCentroid (P 2 true) - TileCentroid (P 1 false) = (1 / 2 : Real) • + GaussianRealPoint (((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat)) * (BandVectors.1 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.1 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1)))) → ((p2pleaf - p1leaf = (1 / 2 + : Real) • GaussianRealPoint (((-⟨0, 1⟩ : GaussianInt) ^ (1 : Nat)) * (BandVectors.2 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.2 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1)))) → (SubtileLatticeAdjacent C2 + C3 (P 1 false) (P 2 true) (r 1 false) (r 2 true)))))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data hpos2 hpos3 C2 C3 p1leaf hp1leaf p2pleaf hp2pleaf + hcent32 hslope32 + refine ⟨?_, ?_, ⟨p1leaf, p2pleaf, hp1leaf, hp2pleaf, ?_⟩⟩ + · simpa [C2, cfg.secondChild, cfg.firstParentTwo] using data.hP 1 false + · simpa [C3, cfg.secondParentOne, cfg.firstParentThree] using data.hP 2 true + refine ⟨cfg.secondPredecessor, 0, 1, cfg.secondProper, ?_, ?_, ?_, ?_, ?_⟩ + · simpa [C2] using cfg.secondChild + · simpa [C3] using cfg.secondParentOne + · simpa using hcent32 + · exact congrArg Prod.fst hslope32 + · exact congrArg Prod.snd hslope32 + +private theorem translatedObs : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (∀ (i : Fin 3), ∀ (s : Bool), ∀ (d : GaussianInt), + FootprintVertices (TileTranslation (P i s) d) = FootprintVertices (TileTranslation + (cert.P i s) d)) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data i s d + rw [(TileTranslationFormulas (P i s) d).2.2.2.2.2.1, + (TileTranslationFormulas (cert.P i s) d).2.2.2.2.2.1, + (data.hobsP i s).2.1] + +private theorem finish : + (by + classical + exact + ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), ∀ (marked : Bool), ∀ (leftTile : + ProtoTile), ∀ (rightTile : ProtoTile), ∀ (leftOdo : PartialOdometer), ∀ (rightOdo : + PartialOdometer), ∀ (leftCircle : BandCircle), ∀ (rightCircle : BandCircle), ∀ (tuple + : Fin 4 → CircleCoordinates), ∀ (slot : Fin 3), ∀ (rot : Fin 4), ∀ (pL : Real × + Real), ∀ (pR : Real × Real), (ProperBandQuadruple tuple) → ((tuple 0 = + leftCircle.1.1) → ((tuple slot.succ = rightCircle.1.1) → ((PartialOdometerSlope + leftOdo = some pL) → ((PartialOdometerSlope rightOdo = some pR) → ((TileCentroid + rightTile - TileCentroid leftTile = + (1 / 2 : Real) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ rot.val * + (BandVectors.1 (tuple slot.succ) (tuple 0) + + BandVectors.1 (tuple 0) (tuple slot.succ)))) → ((pR.1 - pL.1 = ((1 / 2 : Real) + • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ rot.val * + (BandVectors.2 (tuple slot.succ) (tuple 0) + + BandVectors.2 (tuple 0) (tuple slot.succ)))).1) → ((pR.2 - pL.2 = ((1 / 2 : Real) + • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ rot.val * + (BandVectors.2 (tuple slot.succ) (tuple 0) + + BandVectors.2 (tuple 0) (tuple slot.succ)))).2) → ((SubtileLatticeAdjacent + leftCircle rightCircle leftTile rightTile leftOdo rightOdo) → + ((GlobalOdometerExtends g leftOdo) → ((GlobalOdometerExtends g rightOdo) → + ((OdometerCompatibility leftOdo rightOdo) → ((x ∈ FootprintVertices leftTile) + → ((x ∈ FootprintVertices rightTile) → ((∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices leftTile ∨ y ∈ FootprintVertices rightTile) → ((x ∈ + FootprintVertices + (TileTranslation leftTile + ((⟨0, 1⟩ : GaussianInt) ^ rot.val * + (if Even rot.val then BandVectors.1 (tuple 0) (tuple slot.succ) + else BandVectors.1 (tuple slot.succ) (tuple 0)))) ↔ marked = true) → ((marked = + true → FourNeighborLaplacian g x = 0) ∧ (marked = false → + FourNeighborLaplacian g x = 1))))))))))))))))) ) := by + classical + intro g x marked leftTile rightTile leftOdo rightOdo leftCircle rightCircle tuple slot rot pL + pR proper tupleRoot tupleChild hrootSlope hchildSlope hcent hslopeRe hslopeIm adj leftExt + rightExt compat leftMem rightMem star companion + have domL := PositiveCurvatureTileOdometerDomain leftCircle.1.1 leftTile leftOdo + leftCircle.2 adj.1 + have domR := PositiveCurvatureTileOdometerDomain rightCircle.1.1 rightTile rightOdo + rightCircle.2 adj.2.1 + have web := (OdometerWeb).2 leftCircle rightCircle tuple slot rot leftTile rightTile + leftOdo rightOdo g x pL pR proper tupleRoot tupleChild hrootSlope hchildSlope + hcent hslopeRe hslopeIm adj compat leftExt rightExt + (by change x ∈ (leftOdo.domain : Set GaussianInt); rw [domL]; exact leftMem) + (by change x ∈ (rightOdo.domain : Set GaussianInt); rw [domR]; exact rightMem) + (by intro y hy; change y ∈ (leftOdo.domain : Set GaussianInt) ∨ + y ∈ (rightOdo.domain : Set GaussianInt) + rw [domL, domR]; exact star y hy) + constructor + · intro hm + exact web.1 (companion.mpr hm) + · intro hm + exact web.2 (fun hmem => by + have := companion.mp hmem + simp [hm] at this) + +private theorem star'At871 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), + (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → ((∀ (y : + GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ + FootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) ∨ y ∈ FootprintVertices (cert.P (1 + : Fin (3 : ℕ)) false)) → (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x + - ⟨0, 1⟩ → y ∈ FootprintVertices (P 0 true) ∨ y ∈ FootprintVertices (P 1 false))) ) + := by + classical + intro q cfg C0 T cert h P r Q S u v g x data star + simpa [(data.hobsP 0 true).2.1, (data.hobsP 1 false).2.1] using star + +private theorem compAt875 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (x : GaussianInt), ∀ (marked : Bool), (∀ + (i : Fin 3), ∀ (s : Bool), ∀ (d : GaussianInt), FootprintVertices (TileTranslation (P + i s) d) = FootprintVertices (TileTranslation (cert.P i s) d)) → ((x ∈ + FootprintVertices (TileTranslation (cert.P (0 : Fin (3 : ℕ)) true) ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (3 : ℕ) * if Even (3 : ℕ) then BandVectors.1 + (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + else BandVectors.1 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 + : Fin (4 : ℕ))))) ↔ marked = true) → (x ∈ FootprintVertices (TileTranslation (P 0 + true) ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * (if Even (3 : Nat) then BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) else BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0)))) ↔ marked = true)) ) := by + classical + intro q cfg C0 T cert P x marked translatedObs webCompanion + rw [translatedObs] + simpa [Even] using webCompanion + +private theorem star'At896 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), + (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → ((∀ (y : + GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ + FootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) ∨ y ∈ FootprintVertices (cert.P (2 + : Fin (3 : ℕ)) false)) → (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x + - ⟨0, 1⟩ → y ∈ FootprintVertices (P 0 true) ∨ y ∈ FootprintVertices (P 2 false))) ) + := by + classical + intro q cfg C0 T cert h P r Q S u v g x data star + simpa [(data.hobsP 0 true).2.1, (data.hobsP 2 false).2.1] using star + +private theorem compAt900 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (x : GaussianInt), ∀ (marked : Bool), (∀ + (i : Fin 3), ∀ (s : Bool), ∀ (d : GaussianInt), FootprintVertices (TileTranslation (P + i s) d) = FootprintVertices (TileTranslation (cert.P i s) d)) → ((x ∈ + FootprintVertices (TileTranslation (cert.P (0 : Fin (3 : ℕ)) true) ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (0 : ℕ) * if Even (0 : ℕ) then BandVectors.1 + (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))) + else BandVectors.1 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 + : Fin (4 : ℕ))))) ↔ marked = true) → (x ∈ FootprintVertices (TileTranslation (P 0 + true) ((⟨0, 1⟩ : GaussianInt) ^ (0 : Nat) * (if Even (0 : Nat) then BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) else BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0)))) ↔ marked = true)) ) := by + classical + intro q cfg C0 T cert P x marked translatedObs webCompanion + rw [translatedObs] + simpa [Even] using webCompanion + +private theorem star'At922 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), + (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → ((∀ (y : + GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ + FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true) ∨ y ∈ FootprintVertices (cert.P (0 + : Fin (3 : ℕ)) false)) → (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x + - ⟨0, 1⟩ → y ∈ FootprintVertices (P 0 false) ∨ y ∈ FootprintVertices (P 1 true))) ) + := by + classical + intro q cfg C0 T cert h P r Q S u v g x data star y hy + rcases star y hy with hL | hR + · exact Or.inr (by simpa [(data.hobsP 1 true).2.1] using hL) + · exact Or.inl (by simpa [(data.hobsP 0 false).2.1] using hR) + +private theorem compAt929 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (x : GaussianInt), ∀ (marked : Bool), (∀ + (i : Fin 3), ∀ (s : Bool), ∀ (d : GaussianInt), FootprintVertices (TileTranslation (P + i s) d) = FootprintVertices (TileTranslation (cert.P i s) d)) → ((x ∈ + FootprintVertices (TileTranslation (cert.P (0 : Fin (3 : ℕ)) false) ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (1 : ℕ) * if Even (1 : ℕ) then BandVectors.1 + (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + else BandVectors.1 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 + : Fin (4 : ℕ))))) ↔ marked = true) → (x ∈ FootprintVertices (TileTranslation (P 0 + false) ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * (if Even (1 : Nat) then BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) else BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0)))) ↔ marked = true)) ) := by + classical + intro q cfg C0 T cert P x marked translatedObs webCompanion + rw [translatedObs] + simpa [Even] using webCompanion + +private theorem star'At950 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), + (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → ((∀ (y : + GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ + FootprintVertices (cert.P (2 : Fin (3 : ℕ)) true) ∨ y ∈ FootprintVertices (cert.P (0 + : Fin (3 : ℕ)) false)) → (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x + - ⟨0, 1⟩ → y ∈ FootprintVertices (P 0 false) ∨ y ∈ FootprintVertices (P 2 true))) ) + := by + classical + intro q cfg C0 T cert h P r Q S u v g x data star y hy + rcases star y hy with hL | hR + · exact Or.inr (by simpa [(data.hobsP 2 true).2.1] using hL) + · exact Or.inl (by simpa [(data.hobsP 0 false).2.1] using hR) + +private theorem compAt957 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (x : GaussianInt), ∀ (marked : Bool), (∀ + (i : Fin 3), ∀ (s : Bool), ∀ (d : GaussianInt), FootprintVertices (TileTranslation (P + i s) d) = FootprintVertices (TileTranslation (cert.P i s) d)) → ((x ∈ + FootprintVertices (TileTranslation (cert.P (0 : Fin (3 : ℕ)) false) ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (2 : ℕ) * if Even (2 : ℕ) then BandVectors.1 + (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))) + else BandVectors.1 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 + : Fin (4 : ℕ))))) ↔ marked = true) → (x ∈ FootprintVertices (TileTranslation (P 0 + false) ((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * (if Even (2 : Nat) then BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) else BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0)))) ↔ marked = true)) ) := by + classical + intro q cfg C0 T cert P x marked translatedObs webCompanion + rw [translatedObs] + simpa [Even] using webCompanion + +private theorem star'At978 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), + (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → ((∀ (y : + GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ + FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true) ∨ y ∈ FootprintVertices (cert.P (2 + : Fin (3 : ℕ)) false)) → (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x + - ⟨0, 1⟩ → y ∈ FootprintVertices (P 1 true) ∨ y ∈ FootprintVertices (P 2 false))) ) + := by + classical + intro q cfg C0 T cert h P r Q S u v g x data star + simpa [(data.hobsP 1 true).2.1, (data.hobsP 2 false).2.1] using star + +private theorem compAt982 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (x : GaussianInt), ∀ (marked : Bool), (∀ + (i : Fin 3), ∀ (s : Bool), ∀ (d : GaussianInt), FootprintVertices (TileTranslation (P + i s) d) = FootprintVertices (TileTranslation (cert.P i s) d)) → ((x ∈ + FootprintVertices (TileTranslation (cert.P (1 : Fin (3 : ℕ)) true) ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (3 : ℕ) * if Even (3 : ℕ) then BandVectors.1 + (cfg.secondPredecessor (0 : Fin (4 : ℕ))) (cfg.secondPredecessor (1 : Fin (4 : ℕ))) + else BandVectors.1 (cfg.secondPredecessor (1 : Fin (4 : ℕ))) (cfg.secondPredecessor + (0 : Fin (4 : ℕ))))) ↔ marked = true) → (x ∈ FootprintVertices (TileTranslation (P 1 + true) ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * (if Even (3 : Nat) then BandVectors.1 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) else BandVectors.1 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0)))) ↔ marked = true)) ) := by + classical + intro q cfg C0 T cert P x marked translatedObs webCompanion + rw [translatedObs] + simpa [Even] using webCompanion + +private theorem star'At1004 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), + (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → ((∀ (y : + GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ + FootprintVertices (cert.P (2 : Fin (3 : ℕ)) true) ∨ y ∈ FootprintVertices (cert.P (1 + : Fin (3 : ℕ)) false)) → (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x + - ⟨0, 1⟩ → y ∈ FootprintVertices (P 1 false) ∨ y ∈ FootprintVertices (P 2 true))) ) + := by + classical + intro q cfg C0 T cert h P r Q S u v g x data star y hy + rcases star y hy with hL | hR + · exact Or.inr (by simpa [(data.hobsP 2 true).2.1] using hL) + · exact Or.inl (by simpa [(data.hobsP 1 false).2.1] using hR) + +private theorem compAt1011 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (x : GaussianInt), ∀ (marked : Bool), (∀ + (i : Fin 3), ∀ (s : Bool), ∀ (d : GaussianInt), FootprintVertices (TileTranslation (P + i s) d) = FootprintVertices (TileTranslation (cert.P i s) d)) → ((x ∈ + FootprintVertices (TileTranslation (cert.P (1 : Fin (3 : ℕ)) false) ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (1 : ℕ) * if Even (1 : ℕ) then BandVectors.1 + (cfg.secondPredecessor (0 : Fin (4 : ℕ))) (cfg.secondPredecessor (1 : Fin (4 : ℕ))) + else BandVectors.1 (cfg.secondPredecessor (1 : Fin (4 : ℕ))) (cfg.secondPredecessor + (0 : Fin (4 : ℕ))))) ↔ marked = true) → (x ∈ FootprintVertices (TileTranslation (P 1 + false) ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * (if Even (1 : Nat) then BandVectors.1 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) else BandVectors.1 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0)))) ↔ marked = true)) ) := by + classical + intro q cfg C0 T cert P x marked translatedObs webCompanion + rw [translatedObs] + simpa [Even] using webCompanion + +end OuterMixedOdometerGeometry + +namespace OuterMixedOdometerConclusion + +private theorem outerMixedConclusion : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), ∀ (marked : + Bool), (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → (∀ (row + : BandOrderedGeneralInteriorWebRow cert x marked), ((exists (left_mem : x ∈ + FootprintVertices (cert.P 0 true)) (right_mem : x ∈ FootprintVertices (cert.P 1 + false)) (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ y = x + ⟨0, 1⟩ \/ y = x + - ⟨0, 1⟩ -> y ∈ FootprintVertices (cert.P 0 true) \/ y ∈ FootprintVertices (cert.P 1 + false)) (coarseThird : x ∈ FootprintVertices (cert.P 0 false) <-> marked = true) + (webCompanion : x ∈ FootprintVertices (TileTranslation (cert.P 0 true) ((⟨0, 1⟩ : + GaussianInt) ^ (3 : Nat) * (if Even (3 : Nat) then BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) else BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0)))) <-> marked = true), row = + .outer12 left_mem right_mem star coarseThird webCompanion) \/ (exists (left_mem : x ∈ + FootprintVertices (cert.P 0 true)) (right_mem : x ∈ FootprintVertices (cert.P 2 + false)) (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ y = x + ⟨0, 1⟩ \/ y = x + - ⟨0, 1⟩ -> y ∈ FootprintVertices (cert.P 0 true) \/ y ∈ FootprintVertices (cert.P 2 + false)) (coarseThird : x ∈ FootprintVertices (cert.P 1 true) <-> marked = true) + (webCompanion : x ∈ FootprintVertices (TileTranslation (cert.P 0 true) ((⟨0, 1⟩ : + GaussianInt) ^ (0 : Nat) * (if Even (0 : Nat) then BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) else BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0)))) <-> marked = true), row = + .outer13 left_mem right_mem star coarseThird webCompanion) \/ (exists (left_mem : x ∈ + FootprintVertices (cert.P 1 true)) (right_mem : x ∈ FootprintVertices (cert.P 0 + false)) (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ y = x + ⟨0, 1⟩ \/ y = x + - ⟨0, 1⟩ -> y ∈ FootprintVertices (cert.P 1 true) \/ y ∈ FootprintVertices (cert.P 0 + false)) (coarseThird : x ∈ FootprintVertices (cert.P 0 true) <-> marked = true) + (webCompanion : x ∈ FootprintVertices (TileTranslation (cert.P 0 false) ((⟨0, 1⟩ : + GaussianInt) ^ (1 : Nat) * (if Even (1 : Nat) then BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) else BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0)))) <-> marked = true), row = + .outer21 left_mem right_mem star coarseThird webCompanion) \/ (exists (left_mem : x ∈ + FootprintVertices (cert.P 2 true)) (right_mem : x ∈ FootprintVertices (cert.P 0 + false)) (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ y = x + ⟨0, 1⟩ \/ y = x + - ⟨0, 1⟩ -> y ∈ FootprintVertices (cert.P 2 true) \/ y ∈ FootprintVertices (cert.P 0 + false)) (coarseThird : x ∈ FootprintVertices (cert.P 1 false) <-> marked = true) + (webCompanion : x ∈ FootprintVertices (TileTranslation (cert.P 0 false) ((⟨0, 1⟩ : + GaussianInt) ^ (2 : Nat) * (if Even (2 : Nat) then BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) else BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0)))) <-> marked = true), row = + .outer31 left_mem right_mem star coarseThird webCompanion) \/ (exists (left_mem : x ∈ + FootprintVertices (cert.P 1 true)) (right_mem : x ∈ FootprintVertices (cert.P 2 + false)) (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ y = x + ⟨0, 1⟩ \/ y = x + - ⟨0, 1⟩ -> y ∈ FootprintVertices (cert.P 1 true) \/ y ∈ FootprintVertices (cert.P 2 + false)) (coarseThird : x ∈ FootprintVertices (cert.P 0 true) <-> marked = true) + (webCompanion : x ∈ FootprintVertices (TileTranslation (cert.P 1 true) ((⟨0, 1⟩ : + GaussianInt) ^ (3 : Nat) * (if Even (3 : Nat) then BandVectors.1 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) else BandVectors.1 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0)))) <-> marked = true), row = + .outer23 left_mem right_mem star coarseThird webCompanion) \/ (exists (left_mem : x ∈ + FootprintVertices (cert.P 2 true)) (right_mem : x ∈ FootprintVertices (cert.P 1 + false)) (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ y = x + ⟨0, 1⟩ \/ y = x + - ⟨0, 1⟩ -> y ∈ FootprintVertices (cert.P 2 true) \/ y ∈ FootprintVertices (cert.P 1 + false)) (coarseThird : x ∈ FootprintVertices (cert.P 0 false) <-> marked = true) + (webCompanion : x ∈ FootprintVertices (TileTranslation (cert.P 1 false) ((⟨0, 1⟩ : + GaussianInt) ^ (1 : Nat) * (if Even (1 : Nat) then BandVectors.1 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) else BandVectors.1 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0)))) <-> marked = true), row = + .outer32 left_mem right_mem star coarseThird webCompanion)) → (∀ (hpos2 : 0 < (q + 2).1), ∀ (hpos3 : 0 < (q 3).1), ∀ (hpos1 : 0 < (q 1).1), + let C1 : BandCircle := ⟨⟨q 1, Or.inl hpos1, q, cfg.proper.1, 1, rfl⟩, hpos1⟩ + let C2 : BandCircle := ⟨⟨q 2, Or.inl hpos2, q, cfg.proper.1, 2, rfl⟩, hpos2⟩ + let C3 : BandCircle := ⟨⟨q 3, Or.inl hpos3, q, cfg.proper.1, 3, rfl⟩, hpos3⟩ + ∀ (p0leaf : ℝ × ℝ), (PartialOdometerSlope (r (0 : Fin (3 : ℕ)) true) = some p0leaf) → (∀ + (p1leaf : ℝ × ℝ), (PartialOdometerSlope (r (1 : Fin (3 : ℕ)) false) = some p1leaf) → + ((TileCentroid (P 1 false) - TileCentroid (P 0 true) = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * (BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2)))) → ((p1leaf - p0leaf = (1 / 2 : + Real) • GaussianRealPoint (((-⟨0, 1⟩ : GaussianInt) ^ (3 : Nat)) * (BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2)))) → ((SubtileLatticeAdjacent C1 C2 + (P 0 true) (P 1 false) (r 0 true) (r 1 false)) → (∀ (p2leaf : ℝ × ℝ), + (PartialOdometerSlope (r (2 : Fin (3 : ℕ)) false) = some p2leaf) → ((TileCentroid (P + 2 false) - TileCentroid (P 0 true) = (1 / 2 : Real) • GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3))) → ((p2leaf - p0leaf = (1 / 2 : + Real) • GaussianRealPoint (BandVectors.2 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0) + BandVectors.2 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 3))) → ((SubtileLatticeAdjacent C1 C3 (P 0 true) (P 2 false) (r + 0 true) (r 2 false)) → (∀ (p1pleaf : ℝ × ℝ), (PartialOdometerSlope (r (1 : Fin (3 : + ℕ)) true) = some p1pleaf) → (∀ (p0mleaf : ℝ × ℝ), (PartialOdometerSlope (r (0 : Fin + (3 : ℕ)) false) = some p0mleaf) → ((TileCentroid (P 1 true) - TileCentroid (P 0 + false) = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2)))) → ((p1pleaf - p0mleaf = (1 / 2 : + Real) • GaussianRealPoint (((-⟨0, 1⟩ : GaussianInt) ^ (1 : Nat)) * (BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2)))) → ((SubtileLatticeAdjacent C1 C2 + (P 0 false) (P 1 true) (r 0 false) (r 1 true)) → (∀ (p2pleaf : ℝ × ℝ), + (PartialOdometerSlope (r (2 : Fin (3 : ℕ)) true) = some p2pleaf) → ((TileCentroid (P + 2 true) - TileCentroid (P 0 false) = (1 / 2 : Real) • GaussianRealPoint (((⟨0, 1⟩ : + GaussianInt) ^ (2 : Nat)) * (BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0) + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 3)))) → ((p2pleaf - p0mleaf = (1 / 2 : Real) • + GaussianRealPoint (((-⟨0, 1⟩ : GaussianInt) ^ (2 : Nat)) * (BandVectors.2 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3)))) → ((SubtileLatticeAdjacent C1 C3 + (P 0 false) (P 2 true) (r 0 false) (r 2 true)) → ((TileCentroid (P 2 false) - + TileCentroid (P 1 true) = (1 / 2 : Real) • GaussianRealPoint (((⟨0, 1⟩ : GaussianInt) + ^ (3 : Nat)) * (BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + + BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1)))) → ((p2leaf - + p1pleaf = (1 / 2 : Real) • GaussianRealPoint (((-⟨0, 1⟩ : GaussianInt) ^ (3 : Nat)) * + (BandVectors.2 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.2 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1)))) → ((TileCentroid (P 2 true) - + TileCentroid (P 1 false) = (1 / 2 : Real) • GaussianRealPoint (((⟨0, 1⟩ : + GaussianInt) ^ (1 : Nat)) * (BandVectors.1 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1)))) → ((p2pleaf - p1leaf = (1 / 2 : Real) • + GaussianRealPoint (((-⟨0, 1⟩ : GaussianInt) ^ (1 : Nat)) * (BandVectors.2 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.2 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1)))) → ((SubtileLatticeAdjacent C2 + C3 (P 1 true) (P 2 false) (r 1 true) (r 2 false)) → ((SubtileLatticeAdjacent C2 C3 (P + 1 false) (P 2 true) (r 1 false) (r 2 true)) → ((∀ (i : Fin 3), ∀ (s : Bool), ∀ (d : + GaussianInt), FootprintVertices (TileTranslation (P i s) d) = FootprintVertices + (TileTranslation (cert.P i s) d)) → ((∀ (leftTile : ProtoTile), ∀ (rightTile : + ProtoTile), ∀ (leftOdo : PartialOdometer), ∀ (rightOdo : PartialOdometer), ∀ + (leftCircle : BandCircle), ∀ (rightCircle : BandCircle), ∀ (tuple : Fin 4 → + CircleCoordinates), ∀ (slot : Fin 3), ∀ (rot : Fin 4), ∀ (pL : Real × Real), ∀ (pR : + Real × Real), (ProperBandQuadruple tuple) → ((tuple 0 = leftCircle.1.1) → ((tuple + slot.succ = rightCircle.1.1) → ((PartialOdometerSlope leftOdo = some pL) → + ((PartialOdometerSlope rightOdo = some pR) → ((TileCentroid rightTile - TileCentroid + leftTile = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ rot.val * + (BandVectors.1 (tuple slot.succ) (tuple 0) + BandVectors.1 (tuple 0) (tuple + slot.succ)))) → ((pR.1 - pL.1 = ((1 / 2 : Real) • GaussianRealPoint ((-⟨0, 1⟩ : + GaussianInt) ^ rot.val * (BandVectors.2 (tuple slot.succ) (tuple 0) + BandVectors.2 + (tuple 0) (tuple slot.succ)))).1) → ((pR.2 - pL.2 = ((1 / 2 : Real) • + GaussianRealPoint ((-⟨0, 1⟩ : GaussianInt) ^ rot.val * (BandVectors.2 (tuple + slot.succ) (tuple 0) + BandVectors.2 (tuple 0) (tuple slot.succ)))).2) → + ((SubtileLatticeAdjacent leftCircle rightCircle leftTile rightTile leftOdo rightOdo) + → ((GlobalOdometerExtends g leftOdo) → ((GlobalOdometerExtends g rightOdo) → + ((OdometerCompatibility leftOdo rightOdo) → ((x ∈ FootprintVertices leftTile) → ((x ∈ + FootprintVertices rightTile) → ((∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ + ∨ y = x - ⟨0, 1⟩ → y ∈ FootprintVertices leftTile ∨ y ∈ FootprintVertices rightTile) + → ((x ∈ FootprintVertices (TileTranslation leftTile ((⟨0, 1⟩ : GaussianInt) ^ rot.val + * (if Even rot.val then BandVectors.1 (tuple 0) (tuple slot.succ) else BandVectors.1 + (tuple slot.succ) (tuple 0)))) ↔ marked = true) → ((marked = true → + FourNeighborLaplacian g x = 0) ∧ (marked = false → FourNeighborLaplacian g x = + 1)))))))))))))))))) → ((marked = true -> FourNeighborLaplacian g x = 0) /\ (marked = + false -> FourNeighborLaplacian g x = 1))))))))))))))))))))))))))))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g x marked data row outer hpos2 hpos3 hpos1 C1 C2 C3 p0leaf + hp0leaf p1leaf hp1leaf hcent12 hslope12 adj12 p2leaf hp2leaf hcent13 hslope13 adj13 p1pleaf + hp1pleaf p0mleaf hp0mleaf hcent21 hslope21 adj21 p2pleaf hp2pleaf hcent31 hslope31 adj31 + hcent23 hslope23 hcent32 hslope32 adj23 adj32 translatedObs finish + rcases outer with case12 | case13 | case21 | case31 | case23 | case32 + · obtain ⟨left_mem, right_mem, star, _coarse, webCompanion, _rowEq⟩ := case12 + have leftMem : x ∈ FootprintVertices (P 0 true) := by + simpa [(data.hobsP 0 true).2.1] using left_mem + have rightMem : x ∈ FootprintVertices (P 1 false) := by + simpa [(data.hobsP 1 false).2.1] using right_mem + have star' := OuterMixedOdometerGeometry.star'At871 q cfg C0 T cert h P r Q S u v g x data + star + have comp := OuterMixedOdometerGeometry.compAt875 q cfg C0 T cert P x marked translatedObs + webCompanion + exact finish (P 0 true) (P 1 false) (r 0 true) (r 1 false) + C1 C2 cfg.firstPredecessor 1 3 p0leaf p1leaf cfg.firstProper + cfg.firstChild cfg.firstParentTwo hp0leaf hp1leaf hcent12 + (congrArg Prod.fst hslope12) (congrArg Prod.snd hslope12) adj12 + (data.hextP 0 true) (data.hextP 1 false) + (data.hcompat _ _ ⟨0, true, Or.inl rfl⟩ ⟨1, false, Or.inl rfl⟩) + leftMem rightMem star' comp + · obtain ⟨left_mem, right_mem, star, _coarse, webCompanion, _rowEq⟩ := case13 + have leftMem : x ∈ FootprintVertices (P 0 true) := by + simpa [(data.hobsP 0 true).2.1] using left_mem + have rightMem : x ∈ FootprintVertices (P 2 false) := by + simpa [(data.hobsP 2 false).2.1] using right_mem + have star' := OuterMixedOdometerGeometry.star'At896 q cfg C0 T cert h P r Q S u v g x data + star + have comp := OuterMixedOdometerGeometry.compAt900 q cfg C0 T cert P x marked translatedObs + webCompanion + exact finish (P 0 true) (P 2 false) (r 0 true) (r 2 false) + C1 C3 cfg.firstPredecessor 2 0 p0leaf p2leaf cfg.firstProper + cfg.firstChild cfg.firstParentThree hp0leaf hp2leaf (by simpa using hcent13) + (by simpa using congrArg Prod.fst hslope13) + (by simpa using congrArg Prod.snd hslope13) adj13 + (data.hextP 0 true) (data.hextP 2 false) + (data.hcompat _ _ ⟨0, true, Or.inl rfl⟩ ⟨2, false, Or.inl rfl⟩) + leftMem rightMem star' comp + · obtain ⟨left_mem, right_mem, star, _coarse, webCompanion, _rowEq⟩ := case21 + have leftMem : x ∈ FootprintVertices (P 0 false) := by + simpa [(data.hobsP 0 false).2.1] using right_mem + have rightMem : x ∈ FootprintVertices (P 1 true) := by + simpa [(data.hobsP 1 true).2.1] using left_mem + have star' := OuterMixedOdometerGeometry.star'At922 q cfg C0 T cert h P r Q S u v g x data + star + have comp := OuterMixedOdometerGeometry.compAt929 q cfg C0 T cert P x marked translatedObs + webCompanion + exact finish (P 0 false) (P 1 true) (r 0 false) (r 1 true) + C1 C2 cfg.firstPredecessor 1 1 p0mleaf p1pleaf cfg.firstProper + cfg.firstChild cfg.firstParentTwo hp0mleaf hp1pleaf hcent21 + (congrArg Prod.fst hslope21) (congrArg Prod.snd hslope21) adj21 + (data.hextP 0 false) (data.hextP 1 true) + (data.hcompat _ _ ⟨0, false, Or.inl rfl⟩ ⟨1, true, Or.inl rfl⟩) + leftMem rightMem star' comp + · obtain ⟨left_mem, right_mem, star, _coarse, webCompanion, _rowEq⟩ := case31 + have leftMem : x ∈ FootprintVertices (P 0 false) := by + simpa [(data.hobsP 0 false).2.1] using right_mem + have rightMem : x ∈ FootprintVertices (P 2 true) := by + simpa [(data.hobsP 2 true).2.1] using left_mem + have star' := OuterMixedOdometerGeometry.star'At950 q cfg C0 T cert h P r Q S u v g x data + star + have comp := OuterMixedOdometerGeometry.compAt957 q cfg C0 T cert P x marked translatedObs + webCompanion + exact finish (P 0 false) (P 2 true) (r 0 false) (r 2 true) + C1 C3 cfg.firstPredecessor 2 2 p0mleaf p2pleaf cfg.firstProper + cfg.firstChild cfg.firstParentThree hp0mleaf hp2pleaf hcent31 + (congrArg Prod.fst hslope31) (congrArg Prod.snd hslope31) adj31 + (data.hextP 0 false) (data.hextP 2 true) + (data.hcompat _ _ ⟨0, false, Or.inl rfl⟩ ⟨2, true, Or.inl rfl⟩) + leftMem rightMem star' comp + · obtain ⟨left_mem, right_mem, star, _coarse, webCompanion, _rowEq⟩ := case23 + have leftMem : x ∈ FootprintVertices (P 1 true) := by + simpa [(data.hobsP 1 true).2.1] using left_mem + have rightMem : x ∈ FootprintVertices (P 2 false) := by + simpa [(data.hobsP 2 false).2.1] using right_mem + have star' := OuterMixedOdometerGeometry.star'At978 q cfg C0 T cert h P r Q S u v g x data + star + have comp := OuterMixedOdometerGeometry.compAt982 q cfg C0 T cert P x marked translatedObs + webCompanion + exact finish (P 1 true) (P 2 false) (r 1 true) (r 2 false) + C2 C3 cfg.secondPredecessor 0 3 p1pleaf p2leaf cfg.secondProper + cfg.secondChild cfg.secondParentOne hp1pleaf hp2leaf (by simpa using hcent23) + (by simpa using congrArg Prod.fst hslope23) + (by simpa using congrArg Prod.snd hslope23) adj23 + (data.hextP 1 true) (data.hextP 2 false) + (data.hcompat _ _ ⟨1, true, Or.inl rfl⟩ ⟨2, false, Or.inl rfl⟩) + leftMem rightMem star' comp + · obtain ⟨left_mem, right_mem, star, _coarse, webCompanion, _rowEq⟩ := case32 + have leftMem : x ∈ FootprintVertices (P 1 false) := by + simpa [(data.hobsP 1 false).2.1] using right_mem + have rightMem : x ∈ FootprintVertices (P 2 true) := by + simpa [(data.hobsP 2 true).2.1] using left_mem + have star' := OuterMixedOdometerGeometry.star'At1004 q cfg C0 T cert h P r Q S u v g x data + star + have comp := OuterMixedOdometerGeometry.compAt1011 q cfg C0 T cert P x marked translatedObs + webCompanion + exact finish (P 1 false) (P 2 true) (r 1 false) (r 2 true) + C2 C3 cfg.secondPredecessor 0 1 p1leaf p2pleaf cfg.secondProper + cfg.secondChild cfg.secondParentOne hp1leaf hp2pleaf (by simpa using hcent32) + (by simpa using congrArg Prod.fst hslope32) + (by simpa using congrArg Prod.snd hslope32) adj32 + (data.hextP 1 false) (data.hextP 2 true) + (data.hcompat _ _ ⟨1, false, Or.inl rfl⟩ ⟨2, true, Or.inl rfl⟩) + leftMem rightMem star' comp + +end OuterMixedOdometerConclusion + +theorem BandOrderedGeneralOuterMixedOdometerRows + (q : Fin 4 -> CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C0 : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C0 T) + (h : PartialOdometer) + (P : Fin 3 -> Bool -> ProtoTile) + (r : Fin 3 -> Bool -> PartialOdometer) + (Q S : Fin 3 -> Bool -> ProtoTile) + (u v : Fin 3 -> Bool -> PartialOdometer) + (g : IntegerLatticeFunction) (x : GaussianInt) (marked : Bool) + (data : BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) + (row : BandOrderedGeneralInteriorWebRow cert x marked) + (outer : + (exists + (left_mem : x ∈ FootprintVertices (cert.P 0 true)) + (right_mem : x ∈ FootprintVertices (cert.P 1 false)) + (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ FootprintVertices (cert.P 0 true) \/ + y ∈ FootprintVertices (cert.P 1 false)) + (coarseThird : x ∈ FootprintVertices (cert.P 0 false) <-> + marked = true) + (webCompanion : + x ∈ FootprintVertices + (TileTranslation (cert.P 0 true) + ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * + (if Even (3 : Nat) then + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2) + else + BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0)))) <-> marked = true), + row = .outer12 left_mem right_mem star coarseThird webCompanion) \/ + (exists + (left_mem : x ∈ FootprintVertices (cert.P 0 true)) + (right_mem : x ∈ FootprintVertices (cert.P 2 false)) + (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ FootprintVertices (cert.P 0 true) \/ + y ∈ FootprintVertices (cert.P 2 false)) + (coarseThird : x ∈ FootprintVertices (cert.P 1 true) <-> + marked = true) + (webCompanion : + x ∈ FootprintVertices + (TileTranslation (cert.P 0 true) + ((⟨0, 1⟩ : GaussianInt) ^ (0 : Nat) * + (if Even (0 : Nat) then + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 3) + else + BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0)))) <-> marked = true), + row = .outer13 left_mem right_mem star coarseThird webCompanion) \/ + (exists + (left_mem : x ∈ FootprintVertices (cert.P 1 true)) + (right_mem : x ∈ FootprintVertices (cert.P 0 false)) + (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ FootprintVertices (cert.P 1 true) \/ + y ∈ FootprintVertices (cert.P 0 false)) + (coarseThird : x ∈ FootprintVertices (cert.P 0 true) <-> + marked = true) + (webCompanion : + x ∈ FootprintVertices + (TileTranslation (cert.P 0 false) + ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * + (if Even (1 : Nat) then + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2) + else + BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0)))) <-> marked = true), + row = .outer21 left_mem right_mem star coarseThird webCompanion) \/ + (exists + (left_mem : x ∈ FootprintVertices (cert.P 2 true)) + (right_mem : x ∈ FootprintVertices (cert.P 0 false)) + (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ FootprintVertices (cert.P 2 true) \/ + y ∈ FootprintVertices (cert.P 0 false)) + (coarseThird : x ∈ FootprintVertices (cert.P 1 false) <-> + marked = true) + (webCompanion : + x ∈ FootprintVertices + (TileTranslation (cert.P 0 false) + ((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + (if Even (2 : Nat) then + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 3) + else + BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0)))) <-> marked = true), + row = .outer31 left_mem right_mem star coarseThird webCompanion) \/ + (exists + (left_mem : x ∈ FootprintVertices (cert.P 1 true)) + (right_mem : x ∈ FootprintVertices (cert.P 2 false)) + (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ FootprintVertices (cert.P 1 true) \/ + y ∈ FootprintVertices (cert.P 2 false)) + (coarseThird : x ∈ FootprintVertices (cert.P 0 true) <-> + marked = true) + (webCompanion : + x ∈ FootprintVertices + (TileTranslation (cert.P 1 true) + ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * + (if Even (3 : Nat) then + BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) + else + BandVectors.1 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0)))) <-> marked = true), + row = .outer23 left_mem right_mem star coarseThird webCompanion) \/ + (exists + (left_mem : x ∈ FootprintVertices (cert.P 2 true)) + (right_mem : x ∈ FootprintVertices (cert.P 1 false)) + (star : forall y, y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ FootprintVertices (cert.P 2 true) \/ + y ∈ FootprintVertices (cert.P 1 false)) + (coarseThird : x ∈ FootprintVertices (cert.P 0 false) <-> + marked = true) + (webCompanion : + x ∈ FootprintVertices + (TileTranslation (cert.P 1 false) + ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * + (if Even (1 : Nat) then + BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) + else + BandVectors.1 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0)))) <-> marked = true), + row = .outer32 left_mem right_mem star coarseThird webCompanion)) : + (marked = true -> FourNeighborLaplacian g x = 0) /\ + (marked = false -> FourNeighborLaplacian g x = 1) := by +-- BODY + classical + let I : GaussianInt := ⟨0, 1⟩ + have hI2 : (⟨0, 1⟩ : GaussianInt) ^ 2 = -1 := by + ext <;> norm_num [pow_two, Zsqrtd.re_mul, Zsqrtd.im_mul] + have hImul : I * I = -1 := by + rw [← pow_two, hI2] + let U : GaussianInt := BandVectors.1 (q 2) (q 1) + let W : GaussianInt := BandVectors.1 (q 3) (q 2) + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let sOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • + (((z.re : Int) : Real) - ((z.im : Int) : Real), + ((z.im : Int) : Real) + ((z.re : Int) : Real)) + have laws := VectorRecursionLaws q cfg.proper.1 + have firstLaws := VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1 + have secondFlip := (VectorRecursionLaws cfg.secondPredecessor + cfg.secondProper.1).2.2.2.2 cfg.secondProper 0 + have hW := OuterMixedOdometerGeometry.hW q laws + have hA := OuterMixedOdometerGeometry.hA q laws + have hrotA := OuterMixedOdometerGeometry.hrotA q cfg + have hA21 := OuterMixedOdometerGeometry.hA21 q cfg hrotA + have hV13 := OuterMixedOdometerGeometry.hV13 q cfg firstLaws (OuterMixedOdometerGeometry.hV21 q + cfg (OuterMixedOdometerGeometry.hrotV q cfg)) + have hA13 := OuterMixedOdometerGeometry.hA13 q cfg firstLaws hA21 + have hflipV := secondFlip.1 + have hflipA := secondFlip.2 + change BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = I * BandVectors.1 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) at hflipV + change BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = -I * BandVectors.2 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) at hflipA + rw [cfg.secondChild, cfg.secondParentOne] at hflipV hflipA + have hpos2 := OuterMixedOdometerGeometry.hpos2 q cfg + have hpos3 := OuterMixedOdometerGeometry.hpos3 q cfg + have hpos1 := OuterMixedOdometerGeometry.hpos1 q cfg + let C1 : BandCircle := ⟨⟨q 1, Or.inl hpos1, q, cfg.proper.1, 1, rfl⟩, hpos1⟩ + let C2 : BandCircle := ⟨⟨q 2, Or.inl hpos2, q, cfg.proper.1, 2, rfl⟩, hpos2⟩ + let C3 : BandCircle := ⟨⟨q 3, Or.inl hpos3, q, cfg.proper.1, 3, rfl⟩, hpos3⟩ + have pPack := OuterMixedOdometerGeometry.pPack q cfg C0 T cert h P r Q S u v g data + have p0plus := pPack 0 true + have p1minus := pPack 1 false + obtain ⟨p0, p0leaf, hp0, hp0leaf, hp0x, hp0y⟩ := p0plus + obtain ⟨p1, p1leaf, hp1, hp1leaf, hp1x, hp1y⟩ := p1minus + have hroot01 : p0 = p1 := Option.some.inj (hp0.symm.trans hp1) + subst p1 + have hdelta0 := OuterMixedOdometerGeometry.hdelta0 q p0 p0leaf hp0x hp0y + have hdelta1 := OuterMixedOdometerGeometry.hdelta1 q hA p0 p1leaf hp1x hp1y + have hc0plus : TileCentroid (P 0 true) - TileCentroid T = cOff W := by + simpa [cOff, Fin.add_def] using data.hPcent 0 true + have hc1minus := OuterMixedOdometerGeometry.hc1minus q cfg C0 T cert h P r Q S u v g data + have hcent12 := OuterMixedOdometerGeometry.hcent12 q cfg T P firstLaws hW hc0plus hc1minus + have hsumA12 := OuterMixedOdometerGeometry.hsumA12 q cfg firstLaws hrotA hA21 + have hslope12 := OuterMixedOdometerGeometry.hslope12 q cfg hA p0 p0leaf p1leaf hdelta0 hdelta1 + hsumA12 + have adj12 := OuterMixedOdometerGeometry.adj12 q cfg C0 T cert h P r Q S u v g data hpos2 hpos1 + p0leaf hp0leaf p1leaf hp1leaf hcent12 hslope12 + obtain ⟨p2, p2leaf, hp2, hp2leaf, hp2x, hp2y⟩ := pPack 2 false + have hroot02 : p0 = p2 := Option.some.inj (hp0.symm.trans hp2) + subst p2 + have hdelta2 := OuterMixedOdometerGeometry.hdelta2 q p0 p2leaf hp2x hp2y + have hc2minus : TileCentroid (P 2 false) - TileCentroid T = -cOff U := by + simpa [cOff, Fin.add_def, U] using data.hPcent 2 false + have hflip03pair := firstLaws.2.2.2.2 cfg.firstProper 2 + have hflip03 : BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 3) = I * BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) := hflip03pair.1 + have hsumV03 := OuterMixedOdometerGeometry.hsumV03 q cfg (OuterMixedOdometerGeometry.hV30 q cfg + hImul hV13 (OuterMixedOdometerGeometry.hrot2V q cfg)) hflip03 + have hcent13 := OuterMixedOdometerGeometry.hcent13 q cfg T P hc0plus hc2minus hsumV03 + have hflip03A : BandVectors.2 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 3) = -I * BandVectors.2 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) := hflip03pair.2 + have hsumA03 := OuterMixedOdometerGeometry.hsumA03 q cfg (OuterMixedOdometerGeometry.hA30 q cfg + hImul hA13 (OuterMixedOdometerGeometry.hrot2A q cfg)) hflip03A + have hslope13 := OuterMixedOdometerGeometry.hslope13 q cfg p0 p0leaf hdelta0 p2leaf hdelta2 + hsumA03 + have adj13 := OuterMixedOdometerGeometry.adj13 q cfg C0 T cert h P r Q S u v g + data hpos3 hpos1 p0leaf hp0leaf p2leaf hp2leaf hcent13 hslope13 + obtain ⟨p1p, p1pleaf, hp1p, hp1pleaf, hp1px, hp1py⟩ := pPack 1 true + have hroot1p : p1p = p0 := Option.some.inj (hp1p.symm.trans hp0) + subst p1p + obtain ⟨p0m, p0mleaf, hp0m, hp0mleaf, hp0mx, hp0my⟩ := pPack 0 false + have hroot0m : p0m = p0 := Option.some.inj (hp0m.symm.trans hp0) + subst p0m + have hdelta1p := OuterMixedOdometerGeometry.hdelta1p q p0 p1pleaf hp1px hp1py + have hdelta0m := OuterMixedOdometerGeometry.hdelta0m q p0 p0mleaf hp0mx hp0my + have hflip12pair := firstLaws.2.2.2.2 cfg.firstProper 1 + have hc1plus := OuterMixedOdometerGeometry.hc1plus q cfg C0 T cert h P r Q S u v g data + have hc0minus : TileCentroid (P 0 false) - TileCentroid T = -cOff W := by + simpa [cOff, Fin.add_def] using data.hPcent 0 false + have hcent21 := OuterMixedOdometerGeometry.hcent21 q cfg T P hW + (OuterMixedOdometerGeometry.hsumV12 q cfg (OuterMixedOdometerGeometry.hflip12 q cfg + hflip12pair)) hc1plus hc0minus + have hslope21 := OuterMixedOdometerGeometry.hslope21 q cfg hsumA12 p1pleaf p0mleaf + (OuterMixedOdometerGeometry.hpair21base q hA p0 p1pleaf p0mleaf hdelta1p hdelta0m) + have adj21 := OuterMixedOdometerGeometry.adj21 q cfg C0 T cert h P r Q S u v g data hpos2 hpos1 + p1pleaf hp1pleaf p0mleaf hp0mleaf hcent21 hslope21 + obtain ⟨p2p, p2pleaf, hp2p, hp2pleaf, hp2px, hp2py⟩ := pPack 2 true + have hroot2p : p2p = p0 := Option.some.inj (hp2p.symm.trans hp0) + subst p2p + have hdelta2p := OuterMixedOdometerGeometry.hdelta2p q p0 p2pleaf hp2px hp2py + have hc2plus : TileCentroid (P 2 true) - TileCentroid T = cOff U := by + simpa [cOff, Fin.add_def, U] using data.hPcent 2 true + have hcent31 := OuterMixedOdometerGeometry.hcent31 q cfg T P hsumV03 hc0minus hc2plus + have hslope31 := OuterMixedOdometerGeometry.hslope31 q cfg hsumA03 p0mleaf p2pleaf + (OuterMixedOdometerGeometry.hpair31base q p0 p0mleaf hdelta0m p2pleaf hdelta2p) + have adj31 := OuterMixedOdometerGeometry.adj31 q cfg C0 T cert h P r Q S u v g data hpos3 hpos1 + p0mleaf hp0mleaf p2pleaf hp2pleaf hcent31 hslope31 + have hsumVsecond := OuterMixedOdometerGeometry.hsumVsecond q cfg hflipV + have hsumAsecond := OuterMixedOdometerGeometry.hsumAsecond q cfg hflipA + have hcent23 := OuterMixedOdometerGeometry.hcent23 q cfg T P hW hc2minus hc1plus hsumVsecond + have hslope23 := OuterMixedOdometerGeometry.hslope23 q cfg p2leaf p1pleaf hsumAsecond + (OuterMixedOdometerGeometry.hpair23base q hA p0 p2leaf hdelta2 p1pleaf hdelta1p) + have hcent32 := OuterMixedOdometerGeometry.hcent32 q cfg T P hW hc1minus hc2plus hsumVsecond + have hslope32 := OuterMixedOdometerGeometry.hslope32 q cfg p1leaf p2pleaf hsumAsecond + (OuterMixedOdometerGeometry.hpair32base q hA p0 p1leaf hdelta1 p2pleaf hdelta2p) + have adj23 := OuterMixedOdometerGeometry.adj23 q cfg C0 T cert h P r Q S u v g + data hpos2 hpos3 p2leaf hp2leaf p1pleaf hp1pleaf hcent23 hslope23 + have adj32 := OuterMixedOdometerGeometry.adj32 q cfg C0 T cert h P r Q S u v g + data hpos2 hpos3 p1leaf hp1leaf p2pleaf hp2pleaf hcent32 hslope32 + have translatedObs := OuterMixedOdometerGeometry.translatedObs q cfg C0 T cert h P r Q S u v g + data + have finish := OuterMixedOdometerGeometry.finish g x marked + have outerMixedConclusion := OuterMixedOdometerConclusion.outerMixedConclusion q cfg C0 T cert + h P r Q S u v g x marked data row outer hpos2 hpos3 hpos1 p0leaf hp0leaf p1leaf hp1leaf + hcent12 hslope12 adj12 p2leaf hp2leaf hcent13 hslope13 adj13 p1pleaf hp1pleaf p0mleaf + hp0mleaf hcent21 hslope21 adj21 p2pleaf hp2pleaf hcent31 hslope31 adj31 hcent23 hslope23 + hcent32 hslope32 adj23 adj32 translatedObs finish + exact outerMixedConclusion + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPeriodicBlockCells.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPeriodicBlockCells.lean new file mode 100644 index 0000000000..e3aff0442a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPeriodicBlockCells.lean @@ -0,0 +1,142 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: BandOrderedGeneralPeriodicBlockCells] + +/-! +# BandOrderedGeneralPeriodicBlockCells + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralPeriodicBlockCells + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (layout : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + (∀ m n : Int, ∀ x : LatticeCell, + (x ∈ (TileTranslation T + ((m : GaussianInt) * layout.u + (n : GaussianInt) * layout.v)).cells ↔ + ∃ label : SixSubtileLabel, + x ∈ (ModifiedSubtileOccurrenceInterpretation layout.P layout.O + layout.u layout.v ⟨label, m, n⟩).cells)) ∧ + ∀ m n r s : Int, (m, n) ≠ (r, s) → + Disjoint + (TileTranslation T + ((m : GaussianInt) * layout.u + (n : GaussianInt) * layout.v)).cells + (TileTranslation T + ((r : GaussianInt) * layout.u + (s : GaussianInt) * layout.v)).cells := by +-- BODY + classical + have precursor_in_second : layout.O.cells ⊆ (layout.P 0 false).cells := by + intro x hx + rw [layout.precursor_cells] at hx + apply (layout.minus_union x).2 + exact ⟨0, true, hx⟩ + have base_union : ∀ x : LatticeCell, x ∈ T.cells ↔ + ∃ label : SixSubtileLabel, + x ∈ (ModifiedSubtileOccurrenceInterpretation layout.P layout.O + layout.u layout.v ⟨label, 0, 0⟩).cells := by + intro x + rw [layout.outer_union] + constructor + · rintro ⟨i, s, hs⟩ + fin_cases i <;> fin_cases s + · by_cases ho : x ∈ layout.O.cells + · exact ⟨.B, by simpa [ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation] using precursor_in_second ho⟩ + · exact ⟨.A, by simpa [ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation, TileCellComplement] using ⟨hs, ho⟩⟩ + · exact ⟨.B, by simpa [ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation] using hs⟩ + · exact ⟨.C, by simpa [ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation] using hs⟩ + · exact ⟨.D, by simpa [ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation] using hs⟩ + · exact ⟨.E, by simpa [ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation] using hs⟩ + · exact ⟨.F, by simpa [ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation] using hs⟩ + · rintro ⟨label, hs⟩ + cases label with + | A => + have hs' : x ∈ (TileCellComplement (layout.P 0 true) layout.O).cells := by + simpa [ModifiedSubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation] using hs + simp? [TileCellComplement] at hs' + exact ⟨0, true, hs'.1⟩ + | B => exact ⟨0, false, by simpa [ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation] using hs⟩ + | C => exact ⟨1, true, by simpa [ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation] using hs⟩ + | D => exact ⟨1, false, by simpa [ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation] using hs⟩ + | E => exact ⟨2, true, by simpa [ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation] using hs⟩ + | F => exact ⟨2, false, by simpa [ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation] using hs⟩ + have zero_decode (label : SixSubtileLabel) (y : LatticeCell) : + y ∈ (ModifiedSubtileOccurrenceInterpretation layout.P layout.O + layout.u layout.v ⟨label, 0, 0⟩).cells ↔ + y ∈ (match label with + | .A => TileCellComplement (layout.P 0 true) layout.O + | .B => layout.P 0 false + | .C => layout.P 1 true + | .D => layout.P 1 false + | .E => layout.P 2 true + | .F => layout.P 2 false).cells := by + cases label <;> simp [ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation] + have cell_iff : ∀ m n : Int, ∀ x : LatticeCell, + (x ∈ (TileTranslation T + ((m : GaussianInt) * layout.u + (n : GaussianInt) * layout.v)).cells ↔ + ∃ label : SixSubtileLabel, + x ∈ (ModifiedSubtileOccurrenceInterpretation layout.P layout.O + layout.u layout.v ⟨label, m, n⟩).cells) := by + intro m n x + let d : GaussianInt := (m : GaussianInt) * layout.u + + (n : GaussianInt) * layout.v + rw [(TileTranslationFormulas T d).1] + constructor + · intro hx + obtain ⟨y, hy, hxy⟩ := Finset.mem_image.mp hx + obtain ⟨label, hlabel⟩ := (base_union y).mp hy + refine ⟨label, ?_⟩ + change x ∈ (TileTranslation _ d).cells + rw [(TileTranslationFormulas _ d).1] + exact Finset.mem_image.mpr ⟨y, (zero_decode label y).mp hlabel, hxy⟩ + · rintro ⟨label, hx⟩ + change x ∈ (TileTranslation _ d).cells at hx + rw [(TileTranslationFormulas _ d).1] at hx + obtain ⟨y, hy, hxy⟩ := Finset.mem_image.mp hx + exact Finset.mem_image.mpr ⟨y, (base_union y).mpr (by + exact ⟨label, (zero_decode label y).mpr hy⟩), hxy⟩ + constructor + · exact cell_iff + · intro m n r s hmn + rw [Finset.disjoint_left] + intro x hmx hrx + obtain ⟨lm, hml⟩ := (cell_iff m n x).mp hmx + obtain ⟨lr, hrl⟩ := (cell_iff r s x).mp hrx + have heq := (layout.partition x).unique hml hrl + exact hmn (by + cases heq + rfl) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean new file mode 100644 index 0000000000..c326b1dd26 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean @@ -0,0 +1,2059 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandExceptionalRestorationSectorOrder +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandParentBoundaryGenealogy +public import LeanPool.ApollonianSuperharmonic.BandPositiveCutBranchCompanionExclusion +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments +public import LeanPool.ApollonianSuperharmonic.ExceptionalRestorationSectorData +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.PositiveCutCompanionRow +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorsExistUnique +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem +public import LeanPool.ApollonianSuperharmonic.ThreeOwnerDesignatedOppositePair +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandOrderedGeneralPositiveCutGeometry] + +/-! +# BandOrderedGeneralPositiveCutGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PositiveCutGeometry + +private theorem birthData : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let ρ := cfg.firstPredecessor + (((ρ (1 : Fin (4 : ℕ))).1 = (1 : ℤ) ∧ (ρ (2 : Fin (4 : ℕ))).1 = (0 : ℤ) ∧ (ρ (3 : Fin (4 + : ℕ))).1 = (1 : ℤ) ∨ (ρ (1 : Fin (4 : ℕ))).1 = (1 : ℤ) ∧ (ρ (2 : Fin (4 : ℕ))).1 = (1 + : ℤ) ∧ (ρ (3 : Fin (4 : ℕ))).1 = (0 : ℤ) ∨ (ρ (1 : Fin (4 : ℕ))).1 = (0 : ℤ) ∧ (ρ (2 + : Fin (4 : ℕ))).1 = (1 : ℤ) ∧ (ρ (3 : Fin (4 : ℕ))).1 = (1 : ℤ)) ∨ (∃ (p : Fin (4 : + ℕ) → CircleCoordinates), ProperBandQuadruple p ∧ ρ = ![((2 : ℤ) * (p (0 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p + (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) + * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin + (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p (0 : + Fin (4 : ℕ)) = ρ (1 : Fin (4 : ℕ)) ∧ p (2 : Fin (4 : ℕ)) = ρ (2 : Fin (4 : ℕ)) ∧ p (3 + : Fin (4 : ℕ)) = ρ (3 : Fin (4 : ℕ)) ∧ (ρ (2 : Fin (4 : ℕ))).1 < (ρ (1 : Fin (4 : + ℕ))).1 ∧ (ρ (3 : Fin (4 : ℕ))).1 < (ρ (1 : Fin (4 : ℕ))).1) ∨ (∃ (p : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple p ∧ ![ρ (0 : Fin (4 : ℕ)), ρ (2 : Fin (4 : + ℕ)), ρ (3 : Fin (4 : ℕ)), ρ (1 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin + (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 + : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : + ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p (0 : Fin + (4 : ℕ)) = ρ (2 : Fin (4 : ℕ)) ∧ p (2 : Fin (4 : ℕ)) = ρ (3 : Fin (4 : ℕ)) ∧ p (3 : + Fin (4 : ℕ)) = ρ (1 : Fin (4 : ℕ)) ∧ (ρ (3 : Fin (4 : ℕ))).1 < (ρ (2 : Fin (4 : + ℕ))).1 ∧ (ρ (1 : Fin (4 : ℕ))).1 < (ρ (2 : Fin (4 : ℕ))).1) ∨ ∃ (p : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple p ∧ ![ρ (0 : Fin (4 : ℕ)), ρ (3 : Fin (4 : + ℕ)), ρ (1 : Fin (4 : ℕ)), ρ (2 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin + (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 + : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : + ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p (0 : Fin + (4 : ℕ)) = ρ (3 : Fin (4 : ℕ)) ∧ p (2 : Fin (4 : ℕ)) = ρ (1 : Fin (4 : ℕ)) ∧ p (3 : + Fin (4 : ℕ)) = ρ (2 : Fin (4 : ℕ)) ∧ (ρ (1 : Fin (4 : ℕ))).1 < (ρ (3 : Fin (4 : + ℕ))).1 ∧ (ρ (2 : Fin (4 : ℕ))).1 < (ρ (3 : Fin (4 : ℕ))).1) → ((ρ 2 = q 2) → ((ρ 3 = + q 3) → ((4 ≤ (ρ 2).1) → (∃ birth : Fin 4 → CircleCoordinates, ProperBandQuadruple + birth ∧ ((birth 0 = q 2 ∧ birth 2 = q 3 ∧ birth 3 = ρ 1) ∨ (birth 0 = ρ 1 ∧ birth 2 = + q 2 ∧ birth 3 = q 3)))))) ) := by + classical + intro q cfg ρ genealogy hρ2 hρ3 hlarge + rcases genealogy with roots | p2 | p4 | bad + · rcases roots with ⟨_, h₂, _⟩ | ⟨_, h₂, _⟩ | ⟨_, h₂, _⟩ + · omega + · omega + · omega + · rcases p2 with ⟨birth, hp, _, h0, h2, h3, _, _⟩ + refine ⟨birth, hp, Or.inr ?_⟩ + exact ⟨by simpa [ρ] using h0, h2.trans hρ2, + h3.trans hρ3⟩ + · rcases p4 with ⟨birth, hp, _, h0, h2, h3, _, _⟩ + refine ⟨birth, hp, Or.inl ?_⟩ + exact ⟨h0.trans hρ2, h2.trans hρ3, + by simpa [ρ] using h3⟩ + · rcases bad with ⟨birth, hp, _, h0, h2, h3, _, hlt⟩ + have h₂ : (ρ 3).1 ≤ (ρ 2).1 := by + simpa [ρ, cfg.firstParentTwo, cfg.firstParentThree] using cfg.order23 + have hbad : (ρ 2).1 < (ρ 3).1 := by + exact hlt + omega + +private theorem prototile_lattice : + (by + classical + exact + ∀ (c : CircleCoordinates), ∀ (X : ProtoTile), BandPrototile c X → 0 < c.1 → LatticeTile X + ) := by + classical + intro c X hX + induction hX with + | line w x hw => intro hc; simp at hc + | unit z x anchor => + intro _ + have hford := (FordTileGeometry 1 (by norm_num)).1 + have hcells : ({x} : Finset GaussianInt) = + (TileTranslation (FordTile 1) x).cells := by + ext y + simp [TileTranslation, FordTile, FordCellDomain, GaussianTranslation, + ] + cases x; cases y; simp [Zsqrtd.ext_iff] + have hreal : TileRealization ⟨{x}, anchor⟩ = + TileRealization (TileTranslation (FordTile 1) x) := by + simp [TileRealization, hcells] + change TopologicalDisk (TileRealization (⟨{x}, anchor⟩ : ProtoTile)) + have htrans : LatticeTile (TileTranslation (FordTile 1) x) := + (TileDiskAreaCovariance (FordTile 1) x).1.mp hford + change TopologicalDisk (TileRealization (TileTranslation (FordTile 1) x)) + at htrans + simpa [hreal] using htrans + | @decompose r hr S X hS hcells hfoot hcentroid ih => + intro _ + exact (BandTileSimultaneousInduction r hr X + (BandPrototile.decompose hr hS hcells hfoot hcentroid)).1 + +private theorem tile_nonempty : + (by + classical + exact + ∀ (X : ProtoTile), (LatticeTile X) → (X.cells.Nonempty) ) := by + classical + intro X hX + by_contra hne + have hempty : X.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hne + have hreal : TileRealization X = ∅ := by simp [TileRealization, hempty] + rcases hX with ⟨homeo⟩ + let p : (Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) := + ⟨0, by simp⟩ + have hp : ((homeo p).val) ∈ TileRealization X := (homeo p).property + simp [hreal] at hp + +private theorem positive_of_nonempty : + (by + classical + exact + ∀ (c : CircleCoordinates), ∀ (X : ProtoTile), BandPrototile c X → X.cells.Nonempty → 0 < + c.1 ) := by + classical + intro c X hX hne + induction hX with + | line w x hw => simp at hne + | unit z x anchor => norm_num + | @decompose r hr S X hS hcells hfoot hcentroid ih => + exact (ProperBandCurvatureStructure r hr).1 + +private theorem hq3pos : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (((0 : ℤ) < (q + (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin (3 + : ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) + → (0 < (q 3).1)) ) := by + classical + intro q cfg hcurv + have hnonneg : 0 ≤ (q 3).1 := by + simpa using hcurv.2.1 ⟨2, by decide⟩ + have hne : (q 3).1 ≠ 0 := cfg.noLine 3 + omega + +private theorem boundary_edge_footprint : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges X) → (e ∈ + FootprintEdges X) ) := by + classical + intro X e he + let I : GaussianInt := ⟨0, 1⟩ + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [I, Zsqrtd.ext_iff] + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + +private theorem edge_vertex_footprint : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges X) → (∀ (z : + GaussianInt), (z ∈ e) → (z ∈ FootprintVertices X)) ) := by + classical + intro X e he z hz + rcases he with ⟨c, hc, he⟩ + unfold FootprintVertices + rw [ite_eq_left ⟨c, hc⟩] + rcases he with h | h | h | h <;> subst e + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hz + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ + · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + +private theorem boundary_to_raw : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges X) → (e ∈ + FootprintEdges X)) → ((∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ + FootprintEdges X) → (∀ (z : GaussianInt), (z ∈ e) → (z ∈ FootprintVertices X))) → (∀ + (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ BoundaryFootprintVertices X) → (x ∈ + FootprintVertices X))) ) := by + classical + intro boundary_edge_footprint edge_vertex_footprint X x hx + by_cases hne : X.cells.Nonempty + · unfold BoundaryFootprintVertices at hx + rw [ite_eq_left hne] at hx + rcases hx with ⟨e, he, hxe⟩ + exact edge_vertex_footprint X e (boundary_edge_footprint X e he) x hxe + · unfold BoundaryFootprintVertices at hx + rw [ite_eq_right hne] at hx + subst x + simp [FootprintVertices, hne] + +private theorem boundary_incident : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ BoundaryFootprintVertices X) → (x ∈ + FootprintVertices X)) → (∀ (X : ProtoTile), ∀ (x : GaussianInt), (X.cells.Nonempty) → + ((x ∈ BoundaryFootprintVertices X) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + X.cells))) ) := by + classical + intro boundary_to_raw X x hne hx + have hraw := boundary_to_raw X x hx + unfold FootprintVertices at hraw + rw [ite_eq_left hne] at hraw + rcases hraw with ⟨z, hz, hcorner⟩ + rcases hcorner with h | h | h | h + · refine ⟨0, ?_⟩ + simpa [LatticeVertexIncidentCell, h] using hz + · refine ⟨1, ?_⟩ + have : x - 1 = z := by rw [h]; simp + simpa [LatticeVertexIncidentCell, this] using hz + · refine ⟨3, ?_⟩ + have : x - ⟨0, 1⟩ = z := by rw [h]; abel + simpa [LatticeVertexIncidentCell, this] using hz + · refine ⟨2, ?_⟩ + have : x - 1 - ⟨0, 1⟩ = z := by rw [h]; abel + simpa [LatticeVertexIncidentCell, this] using hz + +private theorem raw_incident : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (x : GaussianInt), (X.cells.Nonempty) → ((x ∈ FootprintVertices X) → + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ X.cells)) ) := by + classical + intro X x hne hx + unfold FootprintVertices at hx + rw [ite_eq_left hne] at hx + rcases hx with ⟨z, hz, hcorner⟩ + rcases hcorner with h | h | h | h + · refine ⟨0, ?_⟩ + simpa [LatticeVertexIncidentCell, h] using hz + · refine ⟨1, ?_⟩ + have : x - 1 = z := by rw [h]; simp + simpa [LatticeVertexIncidentCell, this] using hz + · refine ⟨3, ?_⟩ + have : x - ⟨0, 1⟩ = z := by rw [h]; abel + simpa [LatticeVertexIncidentCell, this] using hz + · refine ⟨2, ?_⟩ + have : x - 1 - ⟨0, 1⟩ = z := by rw [h]; abel + simpa [LatticeVertexIncidentCell, this] using hz + +private theorem getLast_mem_of_eq_some : + (by + classical + exact + ∀ {α : Type}, ∀ (l : List α), ∀ (x : α), (l.getLast? = some x) → (x ∈ l) ) := by + classical + intro α l x h + induction l with + | nil => simp at h + | cons a l ih => + cases l with + | nil => simp at h; subst x; simp + | cons b l => + have h' : (b :: l).getLast? = some x := by simpa using h + exact List.mem_cons_of_mem a (ih h') + +private theorem head_mem_of_eq_some : + (by + classical + exact + ∀ {α : Type}, ∀ (l : List α), ∀ (x : α), (l.head? = some x) → (x ∈ l) ) := by + classical + intro α l x h + cases l with + | nil => simp at h + | cons a l => simp at h; subst x; simp + +private theorem hAowners : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (Finset.Nonempty cert.O.cells) → ((ExceptionalRestorationSectorData (cert.P (0 + : Fin (3 : ℕ)) true) (cert.P (0 : Fin (3 : ℕ)) false) cert.O (cert.Q (1 : Fin (3 : + ℕ)) true) (cert.S (2 : Fin (3 : ℕ)) false) (cert.Q (2 : Fin (3 : ℕ)) true) (cert.S (1 + : Fin (3 : ℕ)) false) (cert.P (1 : Fin (3 : ℕ)) true) (cert.P (1 : Fin (3 : ℕ)) + false) (cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : + PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I1, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) cert.exceptional_segments) → + ((cert.exceptional_segments.a ∈ cert.exceptional_segments.left) → (∀ j : Fin 4, + LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.Q 1 true).cells ∨ + LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S 2 false).cells ∨ + LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ cert.O.cells))) ) := by + classical + intro q cfg C₀ T cert hO sector haLeft j + have ho := sector.left_owners cert.exceptional_segments.a haLeft (Or.inl hO) j + rcases ho with hq | hs | hc | ho + · exact Or.inl hq + · exact Or.inr (Or.inl hs) + · exact False.elim ((sector.positive_first_cut_no_companion hO j) hc.2) + · exact Or.inr (Or.inr ho.2) + +private theorem hBowners : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (Finset.Nonempty cert.O.cells) → ((ExceptionalRestorationSectorData (cert.P (0 + : Fin (3 : ℕ)) true) (cert.P (0 : Fin (3 : ℕ)) false) cert.O (cert.Q (1 : Fin (3 : + ℕ)) true) (cert.S (2 : Fin (3 : ℕ)) false) (cert.Q (2 : Fin (3 : ℕ)) true) (cert.S (1 + : Fin (3 : ℕ)) false) (cert.P (1 : Fin (3 : ℕ)) true) (cert.P (1 : Fin (3 : ℕ)) + false) (cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : + PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I1, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) cert.exceptional_segments) → + ((cert.exceptional_segments.b ∈ cert.exceptional_segments.right) → (∀ j : Fin 4, + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q 2 true).cells ∨ + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 false).cells ∨ + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ cert.O.cells))) ) := by + classical + intro q cfg C₀ T cert hO sector hbRight j + have ho := sector.right_owners cert.exceptional_segments.b hbRight (Or.inl hO) j + rcases ho with hq | hs | hc | ho + · exact Or.inl hq + · exact Or.inr (Or.inl hs) + · exact False.elim ((sector.positive_second_cut_no_companion hO j) hc.2) + · exact Or.inr (Or.inr ho.2) + +private theorem touching_disjoint : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (TileTouching X Y) → ((X.cells.Nonempty) → + ((Y.cells.Nonempty) → (Disjoint X.cells Y.cells))) ) := by + classical + intro X Y h hneX hneY + rcases h with ⟨_, _, hd, _⟩ | hX | hY + · exact hd + · have hempty : ¬ X.cells.Nonempty := by simp [hX.1] + exact (hempty hneX).elim + · have hempty : ¬ Y.cells.Nonempty := by simp [hY.1] + exact (hempty hneY).elim + +private theorem houterIntersection : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (cert.P 0 true).cells ∩ (cert.P 0 false).cells = cert.O.cells ) := by + classical + intro q cfg C₀ T cert + have gzero : GaussianTranslation (0 : GaussianInt) = id := by + funext z + simp [GaussianTranslation] + simpa [SubtileOccurrenceInterpretation, TileTranslation, GaussianTranslation, + gzero] using + (BandOriginalPairSeparation cert.P cert.O cert.u cert.v + cert.exceptional_segments.precursor_in_left + cert.exceptional_segments.precursor_in_right cert.partition).1 0 0 + +private theorem hQ1S1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (Disjoint cert.O.cells (cert.Q (1 : Fin (3 : ℕ)) true).cells) → (((cert.P 0 + true).cells ∩ (cert.P 0 false).cells = cert.O.cells) → (Disjoint (cert.Q 1 + true).cells (cert.S 1 false).cells)) ) := by + classical + intro q cfg C₀ T cert hOQ1 houterIntersection + rw [Finset.disjoint_left] + intro x hxQ hxS + have hxP : x ∈ (cert.P 0 true).cells := + (cert.plus_union x).2 ⟨1, true, hxQ⟩ + have hxM : x ∈ (cert.P 0 false).cells := + (cert.minus_union x).2 ⟨1, false, hxS⟩ + have hxO : x ∈ cert.O.cells := by + rw [← houterIntersection] + exact Finset.mem_inter.mpr ⟨hxP, hxM⟩ + exact Finset.disjoint_left.mp hOQ1.symm hxQ hxO + +private theorem normalize_pair : + (by + classical + exact + ∀ (D : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), (ProtoTile) → (∀ (x : + GaussianInt), (D = U ∨ D = V) → ((∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ U.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ V.cells) → ((x ∈ FootprintVertices U) → ((x ∈ + FootprintVertices V) → ((∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V) → (∃ W : ProtoTile, ∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ D.cells ∧ LatticeVertexIncidentCell x (j + 2) ∈ + W.cells ∧ x ∈ FootprintVertices D ∧ x ∈ FootprintVertices W ∧ (∀ y, y = x ∨ y = + x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ FootprintVertices D ∨ + y ∈ FootprintVertices W))))))) ) := by + classical + intro D U V R x hD hopp hU hV hstar + rcases hopp with ⟨j, hjU, hjV⟩ + rcases hD with hDU | hDV + · subst U + exact ⟨V, j, hjU, hjV, hU, hV, hstar⟩ + · subst V + have hindex : (j + 2) + 2 = j := by fin_cases j <;> decide + refine ⟨U, j + 2, ?_, ?_, hV, hU, ?_⟩ + · exact hjV + · simpa [hindex] using hjU + · intro y hy + rcases hstar y hy with hyU | hyV + · exact Or.inr hyU + · exact Or.inl hyV + +private theorem selectA_Q : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (LatticeTile (cert.Q 1 true)) → ((LatticeTile (cert.S 2 false)) → + ((LatticeTile cert.O) → ((NoCheckerboardCellVertex (↑(cert.Q (1 : Fin (3 : ℕ)) + true).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑(cert.S (2 : Fin (3 : + ℕ)) false).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑cert.O.cells : + Set LatticeCell)) → ((∃ j : Fin 4, LatticeVertexIncidentCell + cert.exceptional_segments.a j ∈ (cert.Q 1 true).cells) → ((∃ j : Fin 4, + LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S 2 false).cells) → + ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.Q 1 + true).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S 2 + false).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ + cert.O.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell + cert.exceptional_segments.a j ∈ cert.O.cells) → ((Disjoint (cert.Q (1 : Fin (3 : ℕ)) + true).cells (cert.S (2 : Fin (3 : ℕ)) false).cells) → ((Disjoint (cert.S (2 : Fin (3 + : ℕ)) false).cells cert.O.cells) → ((Disjoint cert.O.cells (cert.Q (1 : Fin (3 : ℕ)) + true).cells) → (∀ D, D = cert.Q 1 true ∨ D = cert.S 2 false ∨ D = cert.O → ∃ U V R : + ProtoTile, (D = U ∨ D = V) ∧ ((U = cert.Q 1 true ∧ V = cert.S 2 false ∧ R = cert.O) ∨ + (U = cert.S 2 false ∧ V = cert.Q 1 true ∧ R = cert.O) ∨ (U = cert.Q 1 true ∧ V = + cert.O ∧ R = cert.S 2 false) ∨ (U = cert.O ∧ V = cert.Q 1 true ∧ R = cert.S 2 false) + ∨ (U = cert.S 2 false ∧ V = cert.O ∧ R = cert.Q 1 true) ∨ (U = cert.O ∧ V = cert.S 2 + false ∧ R = cert.Q 1 true)) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell + cert.exceptional_segments.a j ∈ U.cells ∧ LatticeVertexIncidentCell + cert.exceptional_segments.a (j + 2) ∈ V.cells) ∧ cert.exceptional_segments.a ∈ + FootprintVertices U ∧ cert.exceptional_segments.a ∈ FootprintVertices V ∧ (∀ y, y = + cert.exceptional_segments.a ∨ y = cert.exceptional_segments.a + 1 ∨ y = + cert.exceptional_segments.a - 1 ∨ y = cert.exceptional_segments.a + ⟨0, 1⟩ ∨ y = + cert.exceptional_segments.a - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ + FootprintVertices V)))))))))))))) ) := by + classical + intro q cfg C₀ T cert hQ2lat hS3lat hOlat hQ2check hS3check hOcheck hQ2occ hS3occ hAowners + hOoccA hQS hSO hOQ D hD + exact ThreeOwnerDesignatedOppositePair (cert.Q 1 true) (cert.S 2 false) cert.O + cert.exceptional_segments.a hQ2lat hS3lat hOlat hQS hSO hOQ + hQ2check hS3check hOcheck hAowners hQ2occ hS3occ hOoccA D hD + +private theorem selectB_Q : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (LatticeTile (cert.Q 2 true)) → ((LatticeTile (cert.S 1 false)) → + ((LatticeTile cert.O) → ((NoCheckerboardCellVertex (↑(cert.Q (2 : Fin (3 : ℕ)) + true).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑(cert.S (1 : Fin (3 : + ℕ)) false).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑cert.O.cells : + Set LatticeCell)) → ((∃ j : Fin 4, LatticeVertexIncidentCell + cert.exceptional_segments.b j ∈ (cert.Q 2 true).cells) → ((∃ j : Fin 4, + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 false).cells) → + ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q 2 + true).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 + false).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ + cert.O.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell + cert.exceptional_segments.b j ∈ cert.O.cells) → ((Disjoint (cert.Q (2 : Fin (3 : ℕ)) + true).cells (cert.S (1 : Fin (3 : ℕ)) false).cells) → ((Disjoint (cert.S (1 : Fin (3 + : ℕ)) false).cells cert.O.cells) → ((Disjoint cert.O.cells (cert.Q (2 : Fin (3 : ℕ)) + true).cells) → (∀ D, D = cert.Q 2 true ∨ D = cert.S 1 false ∨ D = cert.O → ∃ U V R : + ProtoTile, (D = U ∨ D = V) ∧ ((U = cert.Q 2 true ∧ V = cert.S 1 false ∧ R = cert.O) ∨ + (U = cert.S 1 false ∧ V = cert.Q 2 true ∧ R = cert.O) ∨ (U = cert.Q 2 true ∧ V = + cert.O ∧ R = cert.S 1 false) ∨ (U = cert.O ∧ V = cert.Q 2 true ∧ R = cert.S 1 false) + ∨ (U = cert.S 1 false ∧ V = cert.O ∧ R = cert.Q 2 true) ∨ (U = cert.O ∧ V = cert.S 1 + false ∧ R = cert.Q 2 true)) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell + cert.exceptional_segments.b j ∈ U.cells ∧ LatticeVertexIncidentCell + cert.exceptional_segments.b (j + 2) ∈ V.cells) ∧ cert.exceptional_segments.b ∈ + FootprintVertices U ∧ cert.exceptional_segments.b ∈ FootprintVertices V ∧ (∀ y, y = + cert.exceptional_segments.b ∨ y = cert.exceptional_segments.b + 1 ∨ y = + cert.exceptional_segments.b - 1 ∨ y = cert.exceptional_segments.b + ⟨0, 1⟩ ∨ y = + cert.exceptional_segments.b - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ + FootprintVertices V)))))))))))))) ) := by + classical + intro q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck hQ3occ hS2occ hBowners + hOoccB hQ3S2 hS2O hOQ3 D hD + exact ThreeOwnerDesignatedOppositePair (cert.Q 2 true) (cert.S 1 false) cert.O + cert.exceptional_segments.b hQ3lat hS2lat hOlat hQ3S2 hS2O hOQ3 + hQ3check hS2check hOcheck hBowners hQ3occ hS2occ hOoccB D hD + +private theorem normalize_selected : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), (X ≠ Y) → + ((X ≠ Z) → ((Y ≠ Z) → ((∃ U V R : ProtoTile, + (X = U ∨ X = V) ∧ + ((U = X ∧ V = Y ∧ R = Z) ∨ (U = Y ∧ V = X ∧ R = Z) ∨ + (U = X ∧ V = Z ∧ R = Y) ∨ (U = Z ∧ V = X ∧ R = Y) ∨ + (U = Y ∧ V = Z ∧ R = X) ∨ (U = Z ∧ V = Y ∧ R = X)) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ V.cells) ∧ + x ∈ FootprintVertices U ∧ x ∈ FootprintVertices V ∧ + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V)) → (∃ W : ProtoTile, (W = Y ∨ W + = Z) ∧ ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ X.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ W.cells ∧ x ∈ FootprintVertices X ∧ x ∈ + FootprintVertices W ∧ (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y + = x - ⟨0, 1⟩ → y ∈ FootprintVertices X ∨ y ∈ FootprintVertices W))))) ) := by + classical + intro X Y Z x hXY hXZ hYZ hsel + rcases hsel with ⟨U, V, R, hD, hperm, hopp, hU, hV, hstar⟩ + have reverse (A B : ProtoTile) + (hopp : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ A.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ B.cells) + (hA : x ∈ FootprintVertices A) (hB : x ∈ FootprintVertices B) + (hstar : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices A ∨ y ∈ FootprintVertices B) : + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ B.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ A.cells ∧ + x ∈ FootprintVertices B ∧ x ∈ FootprintVertices A ∧ + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices B ∨ y ∈ FootprintVertices A) := by + rcases hopp with ⟨j, hjA, hjB⟩ + have hindex : (j + 2) + 2 = j := by fin_cases j <;> decide + refine ⟨j + 2, hjB, ?_, hB, hA, ?_⟩ + · simpa [hindex] using hjA + · intro y hy + rcases hstar y hy with ha | hb + · exact Or.inr ha + · exact Or.inl hb + rcases hperm with p1 | p2 | p3 | p4 | p5 | p6 + · rcases p1 with ⟨hUX, hVY, hRZ⟩ + subst U; subst V; subst R + rcases hD with h | h + · rcases hopp with ⟨j, hjX, hjY⟩ + exact ⟨Y, Or.inl rfl, j, hjX, hjY, hU, hV, hstar⟩ + · exact (hXY h).elim + · rcases p2 with ⟨hUY, hVX, hRZ⟩ + subst U; subst V; subst R + rcases hD with h | h + · exact (hXY h).elim + · rcases reverse Y X hopp hU hV hstar with + ⟨j, hjX, hjY, hcx, hpx, hcover⟩ + exact ⟨Y, Or.inl rfl, j, hjX, hjY, hcx, hpx, hcover⟩ + · rcases p3 with ⟨hUX, hVZ, hRY⟩ + subst U; subst V; subst R + rcases hD with h | h + · rcases hopp with ⟨j, hjX, hjZ⟩ + exact ⟨Z, Or.inr rfl, j, hjX, hjZ, hU, hV, hstar⟩ + · exact (hXZ h).elim + · rcases p4 with ⟨hUZ, hVX, hRY⟩ + subst U; subst V; subst R + rcases hD with h | h + · exact (hXZ h).elim + · rcases reverse Z X hopp hU hV hstar with + ⟨j, hjX, hjZ, hcx, hpx, hcover⟩ + exact ⟨Z, Or.inr rfl, j, hjX, hjZ, hcx, hpx, hcover⟩ + · rcases p5 with ⟨hUY, hVZ, hRX⟩ + subst U; subst V; subst R + rcases hD with h | h + · exact (hXY h).elim + · exact (hXZ h).elim + · rcases p6 with ⟨hUZ, hVY, hRX⟩ + subst U; subst V; subst R + rcases hD with h | h + · exact (hXZ h).elim + · exact (hXY h).elim + +private theorem ne_of_disjoint : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (Disjoint X.cells Y.cells) → ((X.cells.Nonempty) → + (X ≠ Y)) ) := by + classical + intro X Y h hne hXYeq + subst Y + rcases hne with ⟨c, hc⟩ + exact Finset.disjoint_left.mp h hc hc + +private theorem selectB_S : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (LatticeTile (cert.Q 2 true)) → ((LatticeTile (cert.S 1 false)) → + ((LatticeTile cert.O) → ((NoCheckerboardCellVertex (↑(cert.Q (2 : Fin (3 : ℕ)) + true).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑(cert.S (1 : Fin (3 : + ℕ)) false).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑cert.O.cells : + Set LatticeCell)) → ((∃ j : Fin 4, LatticeVertexIncidentCell + cert.exceptional_segments.b j ∈ (cert.Q 2 true).cells) → ((∃ j : Fin 4, + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 false).cells) → + ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q 2 + true).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 + false).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ + cert.O.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell + cert.exceptional_segments.b j ∈ cert.O.cells) → ((Disjoint (cert.Q (2 : Fin (3 : ℕ)) + true).cells (cert.S (1 : Fin (3 : ℕ)) false).cells) → ((Disjoint (cert.S (1 : Fin (3 + : ℕ)) false).cells cert.O.cells) → ((Disjoint cert.O.cells (cert.Q (2 : Fin (3 : ℕ)) + true).cells) → (∀ D, D = cert.S 1 false ∨ D = cert.Q 2 true ∨ D = cert.O → ∃ U V R : + ProtoTile, (D = U ∨ D = V) ∧ ((U = cert.S 1 false ∧ V = cert.Q 2 true ∧ R = cert.O) ∨ + (U = cert.Q 2 true ∧ V = cert.S 1 false ∧ R = cert.O) ∨ (U = cert.S 1 false ∧ V = + cert.O ∧ R = cert.Q 2 true) ∨ (U = cert.O ∧ V = cert.S 1 false ∧ R = cert.Q 2 true) ∨ + (U = cert.Q 2 true ∧ V = cert.O ∧ R = cert.S 1 false) ∨ (U = cert.O ∧ V = cert.Q 2 + true ∧ R = cert.S 1 false)) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell + cert.exceptional_segments.b j ∈ U.cells ∧ LatticeVertexIncidentCell + cert.exceptional_segments.b (j + 2) ∈ V.cells) ∧ cert.exceptional_segments.b ∈ + FootprintVertices U ∧ cert.exceptional_segments.b ∈ FootprintVertices V ∧ (∀ y, y = + cert.exceptional_segments.b ∨ y = cert.exceptional_segments.b + 1 ∨ y = + cert.exceptional_segments.b - 1 ∨ y = cert.exceptional_segments.b + ⟨0, 1⟩ ∨ y = + cert.exceptional_segments.b - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ + FootprintVertices V)))))))))))))) ) := by + classical + intro q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck hQ3occ hS2occ hBowners + hOoccB hQ3S2 hS2O hOQ3 D hD + have owners : ∀ j : Fin 4, + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 false).cells ∨ + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q 2 true).cells ∨ + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ cert.O.cells := by + intro j + rcases hBowners j with hq | hs | ho + · exact Or.inr (Or.inl hq) + · exact Or.inl hs + · exact Or.inr (Or.inr ho) + exact ThreeOwnerDesignatedOppositePair (cert.S 1 false) (cert.Q 2 true) cert.O + cert.exceptional_segments.b hS2lat hQ3lat hOlat hQ3S2.symm hOQ3.symm hS2O.symm + hS2check hQ3check hOcheck owners hS2occ hQ3occ hOoccB D hD + +private theorem selectA_O : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (LatticeTile (cert.Q 1 true)) → ((LatticeTile (cert.S 2 false)) → + ((LatticeTile cert.O) → ((NoCheckerboardCellVertex (↑(cert.Q (1 : Fin (3 : ℕ)) + true).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑(cert.S (2 : Fin (3 : + ℕ)) false).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑cert.O.cells : + Set LatticeCell)) → ((∃ j : Fin 4, LatticeVertexIncidentCell + cert.exceptional_segments.a j ∈ (cert.Q 1 true).cells) → ((∃ j : Fin 4, + LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S 2 false).cells) → + ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.Q 1 + true).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S 2 + false).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ + cert.O.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell + cert.exceptional_segments.a j ∈ cert.O.cells) → ((Disjoint (cert.Q (1 : Fin (3 : ℕ)) + true).cells (cert.S (2 : Fin (3 : ℕ)) false).cells) → ((Disjoint (cert.S (2 : Fin (3 + : ℕ)) false).cells cert.O.cells) → ((Disjoint cert.O.cells (cert.Q (1 : Fin (3 : ℕ)) + true).cells) → (∀ D, D = cert.O ∨ D = cert.Q 1 true ∨ D = cert.S 2 false → ∃ U V R : + ProtoTile, (D = U ∨ D = V) ∧ ((U = cert.O ∧ V = cert.Q 1 true ∧ R = cert.S 2 false) ∨ + (U = cert.Q 1 true ∧ V = cert.O ∧ R = cert.S 2 false) ∨ (U = cert.O ∧ V = cert.S 2 + false ∧ R = cert.Q 1 true) ∨ (U = cert.S 2 false ∧ V = cert.O ∧ R = cert.Q 1 true) ∨ + (U = cert.Q 1 true ∧ V = cert.S 2 false ∧ R = cert.O) ∨ (U = cert.S 2 false ∧ V = + cert.Q 1 true ∧ R = cert.O)) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell + cert.exceptional_segments.a j ∈ U.cells ∧ LatticeVertexIncidentCell + cert.exceptional_segments.a (j + 2) ∈ V.cells) ∧ cert.exceptional_segments.a ∈ + FootprintVertices U ∧ cert.exceptional_segments.a ∈ FootprintVertices V ∧ (∀ y, y = + cert.exceptional_segments.a ∨ y = cert.exceptional_segments.a + 1 ∨ y = + cert.exceptional_segments.a - 1 ∨ y = cert.exceptional_segments.a + ⟨0, 1⟩ ∨ y = + cert.exceptional_segments.a - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ + FootprintVertices V)))))))))))))) ) := by + classical + intro q cfg C₀ T cert hQ2lat hS3lat hOlat hQ2check hS3check hOcheck hQ2occ hS3occ hAowners + hOoccA hQS hSO hOQ D hD + have owners : ∀ j : Fin 4, + LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ cert.O.cells ∨ + LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.Q 1 true).cells ∨ + LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S 2 false).cells := by + intro j + rcases hAowners j with hq | hs | ho + · exact Or.inr (Or.inl hq) + · exact Or.inr (Or.inr hs) + · exact Or.inl ho + exact ThreeOwnerDesignatedOppositePair cert.O (cert.Q 1 true) (cert.S 2 false) + cert.exceptional_segments.a hOlat hQ2lat hS3lat hOQ hQS hSO + hOcheck hQ2check hS3check owners hOoccA hQ2occ hS3occ D hD + +private theorem selectB_O : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (LatticeTile (cert.Q 2 true)) → ((LatticeTile (cert.S 1 false)) → + ((LatticeTile cert.O) → ((NoCheckerboardCellVertex (↑(cert.Q (2 : Fin (3 : ℕ)) + true).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑(cert.S (1 : Fin (3 : + ℕ)) false).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑cert.O.cells : + Set LatticeCell)) → ((∃ j : Fin 4, LatticeVertexIncidentCell + cert.exceptional_segments.b j ∈ (cert.Q 2 true).cells) → ((∃ j : Fin 4, + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 false).cells) → + ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q 2 + true).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 + false).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ + cert.O.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell + cert.exceptional_segments.b j ∈ cert.O.cells) → ((Disjoint (cert.Q (2 : Fin (3 : ℕ)) + true).cells (cert.S (1 : Fin (3 : ℕ)) false).cells) → ((Disjoint (cert.S (1 : Fin (3 + : ℕ)) false).cells cert.O.cells) → ((Disjoint cert.O.cells (cert.Q (2 : Fin (3 : ℕ)) + true).cells) → (∀ D, D = cert.O ∨ D = cert.S 1 false ∨ D = cert.Q 2 true → ∃ U V R : + ProtoTile, (D = U ∨ D = V) ∧ ((U = cert.O ∧ V = cert.S 1 false ∧ R = cert.Q 2 true) ∨ + (U = cert.S 1 false ∧ V = cert.O ∧ R = cert.Q 2 true) ∨ (U = cert.O ∧ V = cert.Q 2 + true ∧ R = cert.S 1 false) ∨ (U = cert.Q 2 true ∧ V = cert.O ∧ R = cert.S 1 false) ∨ + (U = cert.S 1 false ∧ V = cert.Q 2 true ∧ R = cert.O) ∨ (U = cert.Q 2 true ∧ V = + cert.S 1 false ∧ R = cert.O)) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell + cert.exceptional_segments.b j ∈ U.cells ∧ LatticeVertexIncidentCell + cert.exceptional_segments.b (j + 2) ∈ V.cells) ∧ cert.exceptional_segments.b ∈ + FootprintVertices U ∧ cert.exceptional_segments.b ∈ FootprintVertices V ∧ (∀ y, y = + cert.exceptional_segments.b ∨ y = cert.exceptional_segments.b + 1 ∨ y = + cert.exceptional_segments.b - 1 ∨ y = cert.exceptional_segments.b + ⟨0, 1⟩ ∨ y = + cert.exceptional_segments.b - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ + FootprintVertices V)))))))))))))) ) := by + classical + intro q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck hQ3occ hS2occ hBowners + hOoccB hQ3S2 hS2O hOQ3 D hD + have owners : ∀ j : Fin 4, + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ cert.O.cells ∨ + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 false).cells ∨ + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q 2 true).cells := by + intro j + rcases hBowners j with hq | hs | ho + · exact Or.inr (Or.inr hq) + · exact Or.inr (Or.inl hs) + · exact Or.inl ho + exact ThreeOwnerDesignatedOppositePair cert.O (cert.S 1 false) (cert.Q 2 true) + cert.exceptional_segments.b hOlat hS2lat hQ3lat hS2O.symm hQ3S2.symm hOQ3.symm + hOcheck hS2check hQ3check owners hOoccB hS2occ hQ3occ D hD + +private theorem hI2mul : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + (I ^ 2 = -1) → (I * I = -1) ) := by + classical + intro I hI2 + calc + I * I = I ^ 2 := by ring + _ = -1 := hI2 + +private theorem hnotEven3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (¬ Even 3) ) := by + classical + intro q cfg + rintro ⟨n, hn⟩ + omega + +private theorem occurrence_centroid : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + ∀ (r : Fin 4 → CircleCoordinates), ∀ (P : ProtoTile), ∀ (X : ProtoTile), ∀ (i : Fin 3), ∀ + (s : Bool), (BandSubtileOccurrence r P i s X) → (TileCentroid X - TileCentroid P = + (if s then (1 : Real) else -1) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) * + BandVectors.1 (r ((i + 2).succ)) (r ((i + 1).succ))))) ) := by + classical + intro I r P X i s ho + change BandPrototile (r i.succ) X ∧ _ ∧ _ at ho + rcases ho with ⟨_, _, hc⟩ + convert hc using 1; + ext <;> + simp [GaussianRealPoint, I, sub_eq_add_neg, add_comm, + smul_eq_mul] + +private theorem hvector : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let ρ := cfg.firstPredecessor + (ρ 2 = q 2) → ((ρ 3 = q 3) → ( + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.1 (ρ (2 : Fin (4 : ℕ))) (ρ (0 : Fin (4 : ℕ))) = BandVectors.1 (ρ (2 : Fin (4 + : ℕ))) (ρ (1 : Fin (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (ρ + (3 : Fin (4 : ℕ))) (ρ (2 : Fin (4 : ℕ))) ∧ BandVectors.1 (ρ (0 : Fin (4 : ℕ))) (ρ (3 + : Fin (4 : ℕ))) = BandVectors.1 (ρ (1 : Fin (4 : ℕ))) (ρ (3 : Fin (4 : ℕ))) + (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (ρ (3 : Fin (4 : ℕ))) (ρ (2 : Fin (4 : + ℕ))) ∧ BandVectors.2 (ρ (2 : Fin (4 : ℕ))) (ρ (0 : Fin (4 : ℕ))) = BandVectors.2 (ρ + (2 : Fin (4 : ℕ))) (ρ (1 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (ρ (3 : Fin (4 : ℕ))) (ρ (2 : Fin (4 : ℕ))) ∧ BandVectors.2 (ρ (0 : Fin + (4 : ℕ))) (ρ (3 : Fin (4 : ℕ))) = BandVectors.2 (ρ (1 : Fin (4 : ℕ))) (ρ (3 : Fin (4 + : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (ρ (3 : Fin (4 : ℕ))) (ρ + (2 : Fin (4 : ℕ)))) → ((ρ 0 = q 1) → (BandVectors.1 (q 1) (q 3) = I * BandVectors.1 + (q 3) (q 2) + BandVectors.1 (ρ 1) (ρ 3))))) ) := by + classical + intro q cfg ρ hρ2 hρ3 I hstep hρ0 + simpa [I, hρ0, hρ2, hρ3, add_comm] using hstep.2.1 + +private theorem hP0cent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let I : GaussianInt := ⟨0, 1⟩ + (∀ (r : Fin 4 → CircleCoordinates), ∀ (P : ProtoTile), ∀ (X : ProtoTile), ∀ (i : Fin 3), + ∀ (s : Bool), (BandSubtileOccurrence r P i s X) → (TileCentroid X - TileCentroid P = + (if s then (1 : Real) else -1) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) * + BandVectors.1 (r ((i + 2).succ)) (r ((i + 1).succ)))))) → (TileCentroid (cert.P 0 + true) - TileCentroid T = (1 / 2 : Real) • GaussianRealPoint ((1 - I) * BandVectors.1 + (q 3) (q 2))) ) := by + classical + intro q cfg C₀ T cert I occurrence_centroid + simpa [I] using occurrence_centroid q T (cert.P 0 true) 0 true + (cert.outer_occurrence 0 true) + +private theorem hP1cent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let I : GaussianInt := ⟨0, 1⟩ + (∀ (r : Fin 4 → CircleCoordinates), ∀ (P : ProtoTile), ∀ (X : ProtoTile), ∀ (i : Fin 3), + ∀ (s : Bool), (BandSubtileOccurrence r P i s X) → (TileCentroid X - TileCentroid P = + (if s then (1 : Real) else -1) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) * + BandVectors.1 (r ((i + 2).succ)) (r ((i + 1).succ)))))) → (TileCentroid (cert.P 1 + true) - TileCentroid T = (1 / 2 : Real) • GaussianRealPoint ((1 - I) * BandVectors.1 + (q 1) (q 3))) ) := by + classical + intro q cfg C₀ T cert I occurrence_centroid + simpa [I] using occurrence_centroid q T (cert.P 1 true) 1 true + (cert.outer_occurrence 1 true) + +private theorem hQ2cent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let ρ := cfg.firstPredecessor + let I : GaussianInt := ⟨0, 1⟩ + (∀ (r : Fin 4 → CircleCoordinates), ∀ (P : ProtoTile), ∀ (X : ProtoTile), ∀ (i : Fin 3), + ∀ (s : Bool), (BandSubtileOccurrence r P i s X) → (TileCentroid X - TileCentroid P = + (if s then (1 : Real) else -1) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) * + BandVectors.1 (r ((i + 2).succ)) (r ((i + 1).succ)))))) → (TileCentroid (cert.Q 1 + true) - TileCentroid (cert.P 0 true) = (1 / 2 : Real) • GaussianRealPoint ((1 - I) * + BandVectors.1 (ρ 1) (ρ 3))) ) := by + classical + intro q cfg C₀ T cert ρ I occurrence_centroid + simpa [I] using occurrence_centroid ρ (cert.P 0 true) (cert.Q 1 true) 1 true + (cert.plus_occurrence 1 true) + +private theorem translation_centroid : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (z : GaussianInt), TileCentroid (TileTranslation X z) = TileCentroid + X + GaussianRealPoint z ) := by + classical + intro X z + rw [(TileTranslationFormulas X z).2.2.2.2.1] + ext <;> simp [GaussianRealPoint] + +private theorem hP0abs : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let I : GaussianInt := ⟨0, 1⟩ + (TileCentroid (cert.P 0 true) - TileCentroid T = (1 / 2 : Real) • GaussianRealPoint ((1 - + I) * BandVectors.1 (q 3) (q 2))) → (TileCentroid (cert.P 0 true) = TileCentroid T + + (1 / 2 : Real) • GaussianRealPoint ((1 - I) * BandVectors.1 (q 3) (q 2))) ) := by + classical + intro q cfg C₀ T cert I hP0cent + calc + _ = (TileCentroid (cert.P 0 true) - TileCentroid T) + TileCentroid T := by abel + _ = _ := by rw [hP0cent]; exact add_comm _ _ + +private theorem hQ2abs : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let ρ := cfg.firstPredecessor + let I : GaussianInt := ⟨0, 1⟩ + (TileCentroid (cert.Q 1 true) - TileCentroid (cert.P 0 true) = (1 / 2 : Real) • + GaussianRealPoint ((1 - I) * BandVectors.1 (ρ 1) (ρ 3))) → (TileCentroid (cert.Q 1 + true) = TileCentroid (cert.P 0 true) + (1 / 2 : Real) • GaussianRealPoint ((1 - I) * + BandVectors.1 (ρ 1) (ρ 3))) ) := by + classical + intro q cfg C₀ T cert ρ I hQ2cent + calc + _ = (TileCentroid (cert.Q 1 true) - TileCentroid (cert.P 0 true)) + + TileCentroid (cert.P 0 true) := by abel + _ = _ := by rw [hQ2cent]; exact add_comm _ _ + +private theorem hP1abs : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let I : GaussianInt := ⟨0, 1⟩ + (TileCentroid (cert.P 1 true) - TileCentroid T = (1 / 2 : Real) • GaussianRealPoint ((1 - + I) * BandVectors.1 (q 1) (q 3))) → (TileCentroid (cert.P 1 true) = TileCentroid T + + (1 / 2 : Real) • GaussianRealPoint ((1 - I) * BandVectors.1 (q 1) (q 3))) ) := by + classical + intro q cfg C₀ T cert I hP1cent + calc + _ = (TileCentroid (cert.P 1 true) - TileCentroid T) + TileCentroid T := by abel + _ = _ := by rw [hP1cent]; exact add_comm _ _ + +private theorem pointAdd : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint (x + y) = GaussianRealPoint x + + GaussianRealPoint y ) := by + classical + intro x y + ext <;> simp [GaussianRealPoint] + +private theorem pointDouble : + (by + classical + exact + ∀ (x : GaussianInt), GaussianRealPoint (2 * x) = (2 : Real) • GaussianRealPoint x ) := by + classical + intro x + ext <;> simp [GaussianRealPoint, Prod.smul_mk, smul_eq_mul] + +private theorem hpoint : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let ρ := cfg.firstPredecessor + let I : GaussianInt := ⟨0, 1⟩ + (I * I = -1) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint (x + y) = + GaussianRealPoint x + GaussianRealPoint y) → ((∀ (x : GaussianInt), GaussianRealPoint + (2 * x) = (2 : Real) • GaussianRealPoint x) → (GaussianRealPoint ((1 - I) * (I * + BandVectors.1 (q 3) (q 2) + BandVectors.1 (ρ 1) (ρ 3))) = GaussianRealPoint ((1 - I) + * BandVectors.1 (q 3) (q 2)) + GaussianRealPoint ((1 - I) * BandVectors.1 (ρ 1) (ρ + 3)) + (2 : Real) • GaussianRealPoint (I * BandVectors.1 (q 3) (q 2))))) ) := by + classical + intro q cfg ρ I hI2mul pointAdd pointDouble + have hv : (1 - I) * (I * BandVectors.1 (q 3) (q 2) + + BandVectors.1 (ρ 1) (ρ 3)) = + (1 - I) * BandVectors.1 (q 3) (q 2) + + (1 - I) * BandVectors.1 (ρ 1) (ρ 3) + + 2 * (I * BandVectors.1 (q 3) (q 2)) := by + have hm (x : GaussianInt) : (1 - I) * (I * x) = + (1 - I) * x + 2 * (I * x) := by + rw [sub_mul, one_mul, ← mul_assoc, hI2mul] + ring + rw [mul_add, hm] + ring + rw [hv, pointAdd, pointAdd, pointDouble] + +private theorem hfixedPlusCentroid : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let ρ := cfg.firstPredecessor + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.1 (q 1) (q 3) = I * BandVectors.1 (q 3) (q 2) + BandVectors.1 (ρ 1) (ρ 3)) → + ((∀ (X : ProtoTile), ∀ (z : GaussianInt), TileCentroid (TileTranslation X z) = + TileCentroid X + GaussianRealPoint z) → ((TileCentroid (cert.P 0 true) = TileCentroid + T + (1 / 2 : Real) • GaussianRealPoint ((1 - I) * BandVectors.1 (q 3) (q 2))) → + ((TileCentroid (cert.Q 1 true) = TileCentroid (cert.P 0 true) + (1 / 2 : Real) • + GaussianRealPoint ((1 - I) * BandVectors.1 (ρ 1) (ρ 3))) → ((TileCentroid (cert.P 1 + true) = TileCentroid T + (1 / 2 : Real) • GaussianRealPoint ((1 - I) * BandVectors.1 + (q 1) (q 3))) → ((GaussianRealPoint ((1 - I) * (I * BandVectors.1 (q 3) (q 2) + + BandVectors.1 (ρ 1) (ρ 3))) = GaussianRealPoint ((1 - I) * BandVectors.1 (q 3) (q 2)) + + GaussianRealPoint ((1 - I) * BandVectors.1 (ρ 1) (ρ 3)) + (2 : Real) • + GaussianRealPoint (I * BandVectors.1 (q 3) (q 2))) → (TileCentroid (TileTranslation + (cert.Q 1 true) (I * BandVectors.1 (q 3) (q 2))) = TileCentroid (cert.P 1 true))))))) + ) := by + classical + intro q cfg C₀ T cert ρ I hvector translation_centroid hP0abs hQ2abs hP1abs hpoint + rw [translation_centroid, hQ2abs, hP0abs, hP1abs, hvector, hpoint] + ext <;> simp [smul_eq_mul] <;> ring + +private theorem hfixedPlusNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (Finset.Nonempty (cert.Q (1 : Fin (3 : ℕ)) true).cells) → ( + let I : GaussianInt := ⟨0, 1⟩ + (TileTranslation (cert.Q 1 true) (I * BandVectors.1 (q 3) (q 2))).cells.Nonempty) ) := by + classical + intro q cfg C₀ T cert hQ2ne I + rw [(TileTranslationFormulas (cert.Q 1 true) + (I * BandVectors.1 (q 3) (q 2))).1] + exact hQ2ne.image _ + +private theorem hfixedPlusAbsent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (Finset.Nonempty cert.O.cells) → ((ExceptionalRestorationSectorData (cert.P (0 + : Fin (3 : ℕ)) true) (cert.P (0 : Fin (3 : ℕ)) false) cert.O (cert.Q (1 : Fin (3 : + ℕ)) true) (cert.S (2 : Fin (3 : ℕ)) false) (cert.Q (2 : Fin (3 : ℕ)) true) (cert.S (1 + : Fin (3 : ℕ)) false) (cert.P (1 : Fin (3 : ℕ)) true) (cert.P (1 : Fin (3 : ℕ)) + false) (cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : + PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I1, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ((∀ (X : ProtoTile), ∀ (x : + GaussianInt), (X.cells.Nonempty) → ((x ∈ FootprintVertices X) → (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ X.cells))) → ( + let I : GaussianInt := ⟨0, 1⟩ + ((TileTranslation (cert.Q (1 : Fin (3 : ℕ)) true) (I * BandVectors.1 (q (3 : Fin (4 : + ℕ))) (q (2 : Fin (4 : ℕ))))).cells = (cert.P (1 : Fin (3 : ℕ)) true).cells ∧ + ((TileTranslation (cert.Q (1 : Fin (3 : ℕ)) true) (I * BandVectors.1 (q (3 : Fin (4 : + ℕ))) (q (2 : Fin (4 : ℕ))))).cells = ∅ → (TileTranslation (cert.Q (1 : Fin (3 : ℕ)) + true) (I * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).anchor = + (cert.P (1 : Fin (3 : ℕ)) true).anchor)) → (((TileTranslation (cert.Q 1 true) (I * + BandVectors.1 (q 3) (q 2))).cells.Nonempty) → (cert.exceptional_segments.a ∉ + FootprintVertices (TileTranslation (cert.Q 1 true) (I * BandVectors.1 (q 3) (q + 2)))))))) ) := by + classical + intro q cfg C₀ T cert hO sector raw_incident I hfixedPlusUnique hfixedPlusNonempty ha + rcases raw_incident _ _ hfixedPlusNonempty ha with ⟨j, hj⟩ + have hp : LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ + (cert.P 1 true).cells := by rw [hfixedPlusUnique.1] at hj; exact hj + exact (sector.positive_first_cut_no_companion hO j) hp + +private theorem hP0minuscent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let I : GaussianInt := ⟨0, 1⟩ + (∀ (r : Fin 4 → CircleCoordinates), ∀ (P : ProtoTile), ∀ (X : ProtoTile), ∀ (i : Fin 3), + ∀ (s : Bool), (BandSubtileOccurrence r P i s X) → (TileCentroid X - TileCentroid P = + (if s then (1 : Real) else -1) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) * + BandVectors.1 (r ((i + 2).succ)) (r ((i + 1).succ)))))) → (TileCentroid (cert.P 0 + false) - TileCentroid T = (-1 : Real) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) + * BandVectors.1 (q 3) (q 2)))) ) := by + classical + intro q cfg C₀ T cert I occurrence_centroid + simpa [I] using occurrence_centroid q T (cert.P 0 false) 0 false + (cert.outer_occurrence 0 false) + +private theorem hP1minuscent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let I : GaussianInt := ⟨0, 1⟩ + (∀ (r : Fin 4 → CircleCoordinates), ∀ (P : ProtoTile), ∀ (X : ProtoTile), ∀ (i : Fin 3), + ∀ (s : Bool), (BandSubtileOccurrence r P i s X) → (TileCentroid X - TileCentroid P = + (if s then (1 : Real) else -1) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) * + BandVectors.1 (r ((i + 2).succ)) (r ((i + 1).succ)))))) → (TileCentroid (cert.P 1 + false) - TileCentroid T = (-1 : Real) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) + * BandVectors.1 (q 1) (q 3)))) ) := by + classical + intro q cfg C₀ T cert I occurrence_centroid + simpa [I] using occurrence_centroid q T (cert.P 1 false) 1 false + (cert.outer_occurrence 1 false) + +private theorem hS1cent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let ρ := cfg.firstPredecessor + let I : GaussianInt := ⟨0, 1⟩ + (∀ (r : Fin 4 → CircleCoordinates), ∀ (P : ProtoTile), ∀ (X : ProtoTile), ∀ (i : Fin 3), + ∀ (s : Bool), (BandSubtileOccurrence r P i s X) → (TileCentroid X - TileCentroid P = + (if s then (1 : Real) else -1) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) * + BandVectors.1 (r ((i + 2).succ)) (r ((i + 1).succ)))))) → (TileCentroid (cert.S 1 + false) - TileCentroid (cert.P 0 false) = (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * BandVectors.1 (ρ 1) (ρ 3)))) ) := by + classical + intro q cfg C₀ T cert ρ I occurrence_centroid + simpa [I] using occurrence_centroid ρ (cert.P 0 false) (cert.S 1 false) 1 false + (cert.minus_occurrence 1 false) + +private theorem hP0minusabs : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let I : GaussianInt := ⟨0, 1⟩ + (TileCentroid (cert.P 0 false) - TileCentroid T = (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * BandVectors.1 (q 3) (q 2)))) → (TileCentroid (cert.P 0 + false) = TileCentroid T + (-1 : Real) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) + * BandVectors.1 (q 3) (q 2)))) ) := by + classical + intro q cfg C₀ T cert I hP0minuscent + calc + _ = (TileCentroid (cert.P 0 false) - TileCentroid T) + TileCentroid T := by abel + _ = _ := by rw [hP0minuscent]; exact add_comm _ _ + +private theorem hS1abs : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let ρ := cfg.firstPredecessor + let I : GaussianInt := ⟨0, 1⟩ + (TileCentroid (cert.S 1 false) - TileCentroid (cert.P 0 false) = (-1 : Real) • ((1 / 2 : + Real) • GaussianRealPoint ((1 - I) * BandVectors.1 (ρ 1) (ρ 3)))) → (TileCentroid + (cert.S 1 false) = TileCentroid (cert.P 0 false) + (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * BandVectors.1 (ρ 1) (ρ 3)))) ) := by + classical + intro q cfg C₀ T cert ρ I hS1cent + calc + _ = (TileCentroid (cert.S 1 false) - TileCentroid (cert.P 0 false)) + + TileCentroid (cert.P 0 false) := by abel + _ = _ := by rw [hS1cent]; exact add_comm _ _ + +private theorem hP1minusabs : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let I : GaussianInt := ⟨0, 1⟩ + (TileCentroid (cert.P 1 false) - TileCentroid T = (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * BandVectors.1 (q 1) (q 3)))) → (TileCentroid (cert.P 1 + false) = TileCentroid T + (-1 : Real) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) + * BandVectors.1 (q 1) (q 3)))) ) := by + classical + intro q cfg C₀ T cert I hP1minuscent + calc + _ = (TileCentroid (cert.P 1 false) - TileCentroid T) + TileCentroid T := by abel + _ = _ := by rw [hP1minuscent]; exact add_comm _ _ + +private theorem pointNeg : + (by + classical + exact + ∀ (z : GaussianInt), GaussianRealPoint (-z) = -GaussianRealPoint z ) := by + classical + intro z + ext <;> simp [GaussianRealPoint] + +private theorem hfixedMinusCentroid : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let ρ := cfg.firstPredecessor + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.1 (q 1) (q 3) = I * BandVectors.1 (q 3) (q 2) + BandVectors.1 (ρ 1) (ρ 3)) → + ((∀ (X : ProtoTile), ∀ (z : GaussianInt), TileCentroid (TileTranslation X z) = + TileCentroid X + GaussianRealPoint z) → ((GaussianRealPoint ((1 - I) * (I * + BandVectors.1 (q 3) (q 2) + BandVectors.1 (ρ 1) (ρ 3))) = GaussianRealPoint ((1 - I) + * BandVectors.1 (q 3) (q 2)) + GaussianRealPoint ((1 - I) * BandVectors.1 (ρ 1) (ρ + 3)) + (2 : Real) • GaussianRealPoint (I * BandVectors.1 (q 3) (q 2))) → + ((TileCentroid (cert.P 0 false) = TileCentroid T + (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * BandVectors.1 (q 3) (q 2)))) → ((TileCentroid (cert.S 1 + false) = TileCentroid (cert.P 0 false) + (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * BandVectors.1 (ρ 1) (ρ 3)))) → ((TileCentroid (cert.P 1 + false) = TileCentroid T + (-1 : Real) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) + * BandVectors.1 (q 1) (q 3)))) → ((∀ (z : GaussianInt), GaussianRealPoint (-z) = + -GaussianRealPoint z) → (TileCentroid (TileTranslation (cert.S 1 false) (-I * + BandVectors.1 (q 3) (q 2))) = TileCentroid (cert.P 1 false)))))))) ) := by + classical + intro q cfg C₀ T cert ρ I hvector translation_centroid hpoint hP0minusabs hS1abs hP1minusabs + pointNeg + rw [translation_centroid, hS1abs, hP0minusabs, hP1minusabs, hvector] + have hshift : -I * BandVectors.1 (q 3) (q 2) = + -(I * BandVectors.1 (q 3) (q 2)) := by ring + rw [hshift, pointNeg, hpoint] + ext <;> simp [smul_eq_mul] <;> ring + +private theorem hfixedMinusNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (Finset.Nonempty (cert.S (1 : Fin (3 : ℕ)) false).cells) → ( + let I : GaussianInt := ⟨0, 1⟩ + (TileTranslation (cert.S 1 false) (-I * BandVectors.1 (q 3) (q 2))).cells.Nonempty) ) := by + classical + intro q cfg C₀ T cert hS2ne I + rw [(TileTranslationFormulas (cert.S 1 false) + (-I * BandVectors.1 (q 3) (q 2))).1] + exact hS2ne.image _ + +private theorem hfixedMinusAbsent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (Finset.Nonempty cert.O.cells) → ((ExceptionalRestorationSectorData (cert.P (0 + : Fin (3 : ℕ)) true) (cert.P (0 : Fin (3 : ℕ)) false) cert.O (cert.Q (1 : Fin (3 : + ℕ)) true) (cert.S (2 : Fin (3 : ℕ)) false) (cert.Q (2 : Fin (3 : ℕ)) true) (cert.S (1 + : Fin (3 : ℕ)) false) (cert.P (1 : Fin (3 : ℕ)) true) (cert.P (1 : Fin (3 : ℕ)) + false) (cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : + PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I1, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ((∀ (X : ProtoTile), ∀ (x : + GaussianInt), (X.cells.Nonempty) → ((x ∈ FootprintVertices X) → (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ X.cells))) → ( + let I : GaussianInt := ⟨0, 1⟩ + ((TileTranslation (cert.S (1 : Fin (3 : ℕ)) false) (-I * BandVectors.1 (q (3 : Fin (4 : + ℕ))) (q (2 : Fin (4 : ℕ))))).cells = (cert.P (1 : Fin (3 : ℕ)) false).cells ∧ + ((TileTranslation (cert.S (1 : Fin (3 : ℕ)) false) (-I * BandVectors.1 (q (3 : Fin (4 + : ℕ))) (q (2 : Fin (4 : ℕ))))).cells = ∅ → (TileTranslation (cert.S (1 : Fin (3 : ℕ)) + false) (-I * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).anchor = + (cert.P (1 : Fin (3 : ℕ)) false).anchor)) → (((TileTranslation (cert.S 1 false) (-I * + BandVectors.1 (q 3) (q 2))).cells.Nonempty) → (cert.exceptional_segments.b ∉ + FootprintVertices (TileTranslation (cert.S 1 false) (-I * BandVectors.1 (q 3) (q + 2)))))))) ) := by + classical + intro q cfg C₀ T cert hO sector raw_incident I hfixedMinusUnique hfixedMinusNonempty hb + rcases raw_incident _ _ hfixedMinusNonempty hb with ⟨j, hj⟩ + have hp : LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ + (cert.P 1 false).cells := by rw [hfixedMinusUnique.1] at hj; exact hj + exact (sector.positive_second_cut_no_companion hO j) hp + +private theorem p2_a_O_row : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (Finset.Nonempty cert.O.cells) → ( + let ρ := cfg.firstPredecessor + ∀ (birth : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple birth) → (((birth (0 : + Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (2 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) ∧ + birth (3 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ + cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation (cert.Q (1 : Fin (3 + : ℕ)) true) (BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : + ℕ))))) ∧ cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation (cert.S (1 + : Fin (3 : ℕ)) false) (-BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 + : Fin (4 : ℕ))))) ∨ (birth (0 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ)) + ∧ birth (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (3 : Fin (4 : ℕ)) = q (3 : + Fin (4 : ℕ))) ∧ cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation + cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))))) ∧ cert.exceptional_segments.a ∉ + FootprintVertices (TileTranslation cert.O (BandVectors.1 (cfg.firstPredecessor (1 : + Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))))) ∧ cert.exceptional_segments.b ∉ + FootprintVertices (TileTranslation cert.O (-((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ)))))) ∧ + cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O + (-BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ)))))) → + ((BandPrototile (ρ 1) cert.O) → ((BandPrototile (q 2) (cert.Q 1 true)) → + ((BandPrototile (q 3) (cert.S 2 false)) → ((cert.Q (1 : Fin (3 : ℕ)) true ≠ cert.S (1 + : Fin (3 : ℕ)) false) → ((cert.S (2 : Fin (3 : ℕ)) false ≠ cert.O) → ((cert.Q (2 : + Fin (3 : ℕ)) true ≠ cert.O) → ((∃ (W : ProtoTile), (W = cert.S (2 : Fin (3 : ℕ)) + false ∨ W = cert.O) ∧ ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell + cert.exceptional_segments.a j ∈ (cert.Q (1 : Fin (3 : ℕ)) true).cells ∧ + LatticeVertexIncidentCell cert.exceptional_segments.a (j + (2 : Fin (4 : ℕ))) ∈ + W.cells ∧ cert.exceptional_segments.a ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) + true) ∧ cert.exceptional_segments.a ∈ FootprintVertices W ∧ ∀ (y : GaussianInt), y = + cert.exceptional_segments.a ∨ y = cert.exceptional_segments.a + (1 : GaussianInt) ∨ y + = cert.exceptional_segments.a - (1 : GaussianInt) ∨ y = cert.exceptional_segments.a + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = cert.exceptional_segments.a - (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∨ y ∈ + FootprintVertices W) → ( + let I : GaussianInt := ⟨0, 1⟩ + ((TileTranslation (cert.Q (1 : Fin (3 : ℕ)) true) (I * BandVectors.1 (q (3 : Fin (4 : + ℕ))) (q (2 : Fin (4 : ℕ))))).cells = (cert.P (1 : Fin (3 : ℕ)) true).cells ∧ + ((TileTranslation (cert.Q (1 : Fin (3 : ℕ)) true) (I * BandVectors.1 (q (3 : Fin (4 : + ℕ))) (q (2 : Fin (4 : ℕ))))).cells = ∅ → (TileTranslation (cert.Q (1 : Fin (3 : ℕ)) + true) (I * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).anchor = + (cert.P (1 : Fin (3 : ℕ)) true).anchor)) → ((cert.exceptional_segments.a ∉ + FootprintVertices (TileTranslation (cert.Q 1 true) (I * BandVectors.1 (q 3) (q 2)))) + → ((birth 0 = q 2 ∧ birth 2 = q 3 ∧ birth 3 = ρ 1) → (Nonempty + (PositiveCutCompanionRow cert cert.exceptional_segments.a)))))))))))))) ) := by + classical + intro q cfg C₀ T cert hO ρ birth hproper branchExclusions hOproto hQ2proto hS3proto hneQ1S1 + hneA_SO hneB_QO selected_p2_a I hfixedPlusUnique hfixedPlusAbsent hp2 + have hbP2 : birth = ![q 2, birth 1, q 3, ρ 1] := by + funext i + fin_cases i + · exact hp2.1 + · rfl + · exact hp2.2.1 + · exact hp2.2.2 + have hnotQ2a : cert.exceptional_segments.a ∉ FootprintVertices + (TileTranslation (cert.Q 1 true) (BandVectors.1 (q 2) (ρ 1))) := by + rcases branchExclusions with hEx | hEx + · exact hEx.2.1 + · have hcycle : birth 3 = birth 0 := hp2.2.2.trans hEx.1.1.symm + have hlt := hproper.2 2 + change (birth 3).1 < (birth 0).1 at hlt + rw [hcycle] at hlt + omega + rcases selected_p2_a with ⟨W, hW, ⟨j, hj, hj2, hchild, hparent, hstar⟩⟩ + rcases hW with hWS | hWO + · subst W + refine ⟨{ + precursorNonempty := hO, + birth := birth, + parentIndex := 1, + rotation := 1, + child := cert.Q 1 true, + parent := cert.S 2 false, + proper := hproper, + childPrototile := by simpa [hp2.1] using hQ2proto, + parentPrototile := by simpa [hp2.2.1] using hS3proto, + child_mem := hchild, + parent_mem := hparent, + opposite := ⟨j, hj, hj2⟩, + star := hstar, + rightPrototile := by + exact BandPrototileTranslation (birth 0) (cert.Q 1 true) + (I ^ 1 * (if Even 1 then BandVectors.1 (birth 0) (birth 2) + else BandVectors.1 (birth 2) (birth 0))) + (by simpa [hp2.1] using hQ2proto), + rightAbsent := by + simpa [I, hp2.1, hp2.2.1] using hfixedPlusAbsent, + fixedPlusCompanion := by + intro _ _ + simpa [I, hp2.1, hp2.2.1] using + (show (TileTranslation (cert.Q 1 true) (I * BandVectors.1 (q 3) (q 2))).cells = + (cert.P 1 true).cells ∧ + ((TileTranslation (cert.Q 1 true) (I * BandVectors.1 (q 3) (q 2))).cells = ∅ → + (TileTranslation (cert.Q 1 true) (I * BandVectors.1 (q 3) (q 2))).anchor = + (cert.P 1 true).anchor) from hfixedPlusUnique), + fixedMinusCompanion := by + intro hchildEq _ + exact (hneQ1S1 hchildEq).elim, + literalRow := Or.inl ⟨hbP2, rfl, rfl, rfl, rfl, rfl⟩ + }⟩ + · subst W + refine ⟨{ + precursorNonempty := hO, + birth := birth, + parentIndex := 2, + rotation := 0, + child := cert.Q 1 true, + parent := cert.O, + proper := hproper, + childPrototile := by simpa [hp2.1] using hQ2proto, + parentPrototile := by simpa [hp2.2.2] using hOproto, + child_mem := hchild, + parent_mem := hparent, + opposite := ⟨j, hj, hj2⟩, + star := hstar, + rightPrototile := by + exact BandPrototileTranslation (birth 0) (cert.Q 1 true) + (I ^ 0 * (if Even 0 then BandVectors.1 (birth 0) (birth 3) + else BandVectors.1 (birth 3) (birth 0))) + (by simpa [hp2.1] using hQ2proto), + rightAbsent := by + simpa [I, hp2.1, hp2.2.2] using hnotQ2a, + fixedPlusCompanion := by + intro _ hparentEq + exact (hneA_SO hparentEq.symm).elim, + fixedMinusCompanion := by + intro _ hparentEq + exact (hneB_QO hparentEq.symm).elim, + literalRow := Or.inr (Or.inl + ⟨hbP2, rfl, rfl, rfl, rfl, rfl⟩) + }⟩ + +private theorem p2_b_O_row : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (Finset.Nonempty cert.O.cells) → ( + let ρ := cfg.firstPredecessor + ∀ (birth : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple birth) → (((birth (0 : + Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (2 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) ∧ + birth (3 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ + cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation (cert.Q (1 : Fin (3 + : ℕ)) true) (BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : + ℕ))))) ∧ cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation (cert.S (1 + : Fin (3 : ℕ)) false) (-BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 + : Fin (4 : ℕ))))) ∨ (birth (0 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ)) + ∧ birth (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (3 : Fin (4 : ℕ)) = q (3 : + Fin (4 : ℕ))) ∧ cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation + cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))))) ∧ cert.exceptional_segments.a ∉ + FootprintVertices (TileTranslation cert.O (BandVectors.1 (cfg.firstPredecessor (1 : + Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))))) ∧ cert.exceptional_segments.b ∉ + FootprintVertices (TileTranslation cert.O (-((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ)))))) ∧ + cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O + (-BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ)))))) → + ((BandPrototile (ρ 1) cert.O) → ((BandPrototile (q 3) (cert.Q 2 true)) → + ((BandPrototile (q 2) (cert.S 1 false)) → ((cert.Q (1 : Fin (3 : ℕ)) true ≠ cert.S (1 + : Fin (3 : ℕ)) false) → ((cert.Q (2 : Fin (3 : ℕ)) true ≠ cert.O) → ((∃ (W : + ProtoTile), (W = cert.Q (2 : Fin (3 : ℕ)) true ∨ W = cert.O) ∧ ∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S (1 : Fin (3 : ℕ)) + false).cells ∧ LatticeVertexIncidentCell cert.exceptional_segments.b (j + (2 : Fin (4 + : ℕ))) ∈ W.cells ∧ cert.exceptional_segments.b ∈ FootprintVertices (cert.S (1 : Fin + (3 : ℕ)) false) ∧ cert.exceptional_segments.b ∈ FootprintVertices W ∧ ∀ (y : + GaussianInt), y = cert.exceptional_segments.b ∨ y = cert.exceptional_segments.b + (1 + : GaussianInt) ∨ y = cert.exceptional_segments.b - (1 : GaussianInt) ∨ y = + cert.exceptional_segments.b + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = + cert.exceptional_segments.b - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ + FootprintVertices (cert.S (1 : Fin (3 : ℕ)) false) ∨ y ∈ FootprintVertices W) → ( + let I : GaussianInt := ⟨0, 1⟩ + (I ^ 2 = -1) → ((I ^ 3 = -I) → ((¬ (∃ r : ℕ, 3 = r + r)) → (((TileTranslation (cert.S (1 + : Fin (3 : ℕ)) false) (-I * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : + ℕ))))).cells = (cert.P (1 : Fin (3 : ℕ)) false).cells ∧ ((TileTranslation (cert.S (1 + : Fin (3 : ℕ)) false) (-I * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : + ℕ))))).cells = ∅ → (TileTranslation (cert.S (1 : Fin (3 : ℕ)) false) (-I * + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).anchor = (cert.P (1 : Fin + (3 : ℕ)) false).anchor)) → ((cert.exceptional_segments.b ∉ FootprintVertices + (TileTranslation (cert.S 1 false) (-I * BandVectors.1 (q 3) (q 2)))) → ((birth 0 = q + 2 ∧ birth 2 = q 3 ∧ birth 3 = ρ 1) → (Nonempty (PositiveCutCompanionRow cert + cert.exceptional_segments.b)))))))))))))))) ) := by + classical + intro q cfg C₀ T cert hO ρ birth hproper branchExclusions hOproto hQ3proto hS2proto hneQ1S1 + hneB_QO' selected_p2_b I hI2 hI3 hodd3 hfixedMinusUnique hfixedMinusAbsent hp2 + have hbP2 : birth = ![q 2, birth 1, q 3, ρ 1] := by + funext i + fin_cases i + · exact hp2.1 + · rfl + · exact hp2.2.1 + · exact hp2.2.2 + have hnotS2b : cert.exceptional_segments.b ∉ FootprintVertices + (TileTranslation (cert.S 1 false) (-BandVectors.1 (q 2) (ρ 1))) := by + rcases branchExclusions with hEx | hEx + · exact hEx.2.2 + · have hcycle : birth 3 = birth 0 := hp2.2.2.trans hEx.1.1.symm + have hlt := hproper.2 2 + change (birth 3).1 < (birth 0).1 at hlt + rw [hcycle] at hlt + omega + rcases selected_p2_b with ⟨W, hW, ⟨j, hj, hj2, hchild, hparent, hstar⟩⟩ + rcases hW with hWQ | hWO + · subst W + refine ⟨{ + precursorNonempty := hO, + birth := birth, + parentIndex := 1, + rotation := 3, + child := cert.S 1 false, + parent := cert.Q 2 true, + proper := hproper, + childPrototile := by simpa [hp2.1] using hS2proto, + parentPrototile := by simpa [hp2.2.1] using hQ3proto, + child_mem := hchild, + parent_mem := hparent, + opposite := ⟨j, hj, hj2⟩, + star := hstar, + rightPrototile := by + exact BandPrototileTranslation (birth 0) (cert.S 1 false) + (I ^ 3 * (if Even 3 then BandVectors.1 (birth 0) (birth 2) + else BandVectors.1 (birth 2) (birth 0))) + (by simpa [hp2.1] using hS2proto), + rightAbsent := by + simpa [Even, hodd3, I, hp2.1, hp2.2.1, hI3] using hfixedMinusAbsent, + fixedPlusCompanion := by + intro hchildEq _ + exact (hneQ1S1 hchildEq.symm).elim, + fixedMinusCompanion := by + intro _ _ + simpa [Even, hodd3, I, hp2.1, hp2.2.1, hI3] using + (show (TileTranslation (cert.S 1 false) (-I * BandVectors.1 (q 3) (q 2))).cells = + (cert.P 1 false).cells ∧ + ((TileTranslation (cert.S 1 false) (-I * BandVectors.1 (q 3) (q 2))).cells = ∅ → + (TileTranslation (cert.S 1 false) (-I * BandVectors.1 (q 3) (q 2))).anchor = + (cert.P 1 false).anchor) from hfixedMinusUnique), + literalRow := Or.inr (Or.inr (Or.inl ⟨hbP2, rfl, rfl, rfl, rfl, rfl⟩)) + }⟩ + · subst W + have hnotS2b' : cert.exceptional_segments.b ∉ FootprintVertices + (TileTranslation (cert.S 1 false) (-BandVectors.1 (q 2) (ρ 1))) := hnotS2b + refine ⟨{ + precursorNonempty := hO, + birth := birth, + parentIndex := 2, + rotation := 2, + child := cert.S 1 false, + parent := cert.O, + proper := hproper, + childPrototile := by simpa [hp2.1] using hS2proto, + parentPrototile := by simpa [hp2.2.2] using hOproto, + child_mem := hchild, + parent_mem := hparent, + opposite := ⟨j, hj, hj2⟩, + star := hstar, + rightPrototile := by + exact BandPrototileTranslation (birth 0) (cert.S 1 false) + (I ^ 2 * (if Even 2 then BandVectors.1 (birth 0) (birth 3) + else BandVectors.1 (birth 3) (birth 0))) + (by simpa [hp2.1] using hS2proto), + rightAbsent := by + simpa [I, hp2.1, hp2.2.2, hI2] using hnotS2b', + fixedPlusCompanion := by + intro hchildEq _ + exact (hneQ1S1 hchildEq.symm).elim, + fixedMinusCompanion := by + intro _ hparentEq + exact (hneB_QO' hparentEq.symm).elim, + literalRow := Or.inr (Or.inr (Or.inr (Or.inl + ⟨hbP2, rfl, rfl, rfl, rfl, rfl⟩))) + }⟩ + +private theorem p4_exclusions : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let ρ := cfg.firstPredecessor + ∀ (birth : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple birth) → (((birth (0 : + Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (2 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) ∧ + birth (3 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ + cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation (cert.Q (1 : Fin (3 + : ℕ)) true) (BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : + ℕ))))) ∧ cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation (cert.S (1 + : Fin (3 : ℕ)) false) (-BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 + : Fin (4 : ℕ))))) ∨ (birth (0 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ)) + ∧ birth (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (3 : Fin (4 : ℕ)) = q (3 : + Fin (4 : ℕ))) ∧ cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation + cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))))) ∧ cert.exceptional_segments.a ∉ + FootprintVertices (TileTranslation cert.O (BandVectors.1 (cfg.firstPredecessor (1 : + Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))))) ∧ cert.exceptional_segments.b ∉ + FootprintVertices (TileTranslation cert.O (-((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ)))))) ∧ + cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O + (-BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ)))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + (birth 0 = ρ 1 ∧ birth 2 = q 2 ∧ birth 3 = q 3) → (cert.exceptional_segments.a ∉ + FootprintVertices (TileTranslation cert.O (I * BandVectors.1 (q 2) (ρ 1))) ∧ + cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation cert.O + (BandVectors.1 (ρ 1) (q 3))) ∧ cert.exceptional_segments.b ∉ FootprintVertices + (TileTranslation cert.O (-I * BandVectors.1 (q 2) (ρ 1))) ∧ + cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O + (-BandVectors.1 (ρ 1) (q 3)))))) ) := by + classical + intro q cfg C₀ T cert ρ birth hproper branchExclusions I hp4 + rcases branchExclusions with hEx | hEx + · have hcycle : birth 3 = birth 0 := hEx.1.2.2.trans hp4.1.symm + have hlt := hproper.2 2 + change (birth 3).1 < (birth 0).1 at hlt + rw [hcycle] at hlt + omega + · exact ⟨hEx.2.1, hEx.2.2.1, + (by simpa [neg_mul] using hEx.2.2.2.1), hEx.2.2.2.2⟩ + +private theorem p4_a_row : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (Finset.Nonempty cert.O.cells) → ( + let ρ := cfg.firstPredecessor + ∀ (birth : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple birth) → + ((BandPrototile (ρ 1) cert.O) → ((BandPrototile (q 2) (cert.Q 1 true)) → + ((BandPrototile (q 3) (cert.S 2 false)) → ((cert.O ≠ cert.Q (1 : Fin (3 : ℕ)) true) → + ((cert.O ≠ cert.S (1 : Fin (3 : ℕ)) false) → ((∃ (W : ProtoTile), (W = cert.Q (1 : + Fin (3 : ℕ)) true ∨ W = cert.S (2 : Fin (3 : ℕ)) false) ∧ ∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ cert.O.cells ∧ + LatticeVertexIncidentCell cert.exceptional_segments.a (j + (2 : Fin (4 : ℕ))) ∈ + W.cells ∧ cert.exceptional_segments.a ∈ FootprintVertices cert.O ∧ + cert.exceptional_segments.a ∈ FootprintVertices W ∧ ∀ (y : GaussianInt), y = + cert.exceptional_segments.a ∨ y = cert.exceptional_segments.a + (1 : GaussianInt) ∨ y + = cert.exceptional_segments.a - (1 : GaussianInt) ∨ y = cert.exceptional_segments.a + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = cert.exceptional_segments.a - (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices cert.O ∨ y ∈ FootprintVertices W) → ( + let I : GaussianInt := ⟨0, 1⟩ + ((birth 0 = ρ 1 ∧ birth 2 = q 2 ∧ birth 3 = q 3) → (cert.exceptional_segments.a ∉ + FootprintVertices (TileTranslation cert.O (I * BandVectors.1 (q 2) (ρ 1))) ∧ + cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation cert.O + (BandVectors.1 (ρ 1) (q 3))) ∧ cert.exceptional_segments.b ∉ FootprintVertices + (TileTranslation cert.O (-I * BandVectors.1 (q 2) (ρ 1))) ∧ + cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O + (-BandVectors.1 (ρ 1) (q 3))))) → ((birth 0 = ρ 1 ∧ birth 2 = q 2 ∧ birth 3 = q 3) → + (Nonempty (PositiveCutCompanionRow cert cert.exceptional_segments.a))))))))))) ) := by + classical + intro q cfg C₀ T cert hO ρ birth hproper hOproto hQ2proto hS3proto hneA_OQ hneB_OS + selected_p4_a I p4_exclusions hp4 + have hbP4 : birth = ![ρ 1, birth 1, q 2, q 3] := by + funext i + fin_cases i + · exact hp4.1 + · rfl + · exact hp4.2.1 + · exact hp4.2.2 + rcases selected_p4_a with ⟨W, hW, ⟨j, hj, hj2, hchild, hparent, hstar⟩⟩ + rcases hW with hWQ | hWS + · subst W + refine ⟨{ + precursorNonempty := hO, + birth := birth, + parentIndex := 1, + rotation := 1, + child := cert.O, + parent := cert.Q 1 true, + proper := hproper, + childPrototile := by simpa [hp4.1] using hOproto, + parentPrototile := by simpa [hp4.2.1] using hQ2proto, + child_mem := hchild, + parent_mem := hparent, + opposite := ⟨j, hj, hj2⟩, + star := hstar, + rightPrototile := by + exact BandPrototileTranslation (birth 0) cert.O + (I ^ 1 * (if Even 1 then BandVectors.1 (birth 0) (birth 2) + else BandVectors.1 (birth 2) (birth 0))) + (by simpa [hp4.1] using hOproto), + rightAbsent := by + simpa [I, hp4.1, hp4.2.1] using (p4_exclusions hp4).1, + fixedPlusCompanion := by + intro hchildEq _ + exact (hneA_OQ hchildEq).elim, + fixedMinusCompanion := by + intro hchildEq _ + exact (hneB_OS hchildEq).elim, + literalRow := Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨hbP4, rfl, rfl, rfl, rfl, rfl⟩)))) + }⟩ + · subst W + refine ⟨{ + precursorNonempty := hO, + birth := birth, + parentIndex := 2, + rotation := 0, + child := cert.O, + parent := cert.S 2 false, + proper := hproper, + childPrototile := by simpa [hp4.1] using hOproto, + parentPrototile := by simpa [hp4.2.2] using hS3proto, + child_mem := hchild, + parent_mem := hparent, + opposite := ⟨j, hj, hj2⟩, + star := hstar, + rightPrototile := by + exact BandPrototileTranslation (birth 0) cert.O + (I ^ 0 * (if Even 0 then BandVectors.1 (birth 0) (birth 3) + else BandVectors.1 (birth 3) (birth 0))) + (by simpa [hp4.1] using hOproto), + rightAbsent := by + simpa [I, hp4.1, hp4.2.2] using (p4_exclusions hp4).2.1, + fixedPlusCompanion := by + intro hchildEq _ + exact (hneA_OQ hchildEq).elim, + fixedMinusCompanion := by + intro hchildEq _ + exact (hneB_OS hchildEq).elim, + literalRow := Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + ⟨hbP4, rfl, rfl, rfl, rfl, rfl⟩))))) + }⟩ + +private theorem p4_b_row : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (Finset.Nonempty cert.O.cells) → ( + let ρ := cfg.firstPredecessor + ∀ (birth : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple birth) → + ((BandPrototile (ρ 1) cert.O) → ((BandPrototile (q 3) (cert.Q 2 true)) → + ((BandPrototile (q 2) (cert.S 1 false)) → ((cert.O ≠ cert.Q (1 : Fin (3 : ℕ)) true) → + ((cert.O ≠ cert.S (1 : Fin (3 : ℕ)) false) → ((∃ (W : ProtoTile), (W = cert.S (1 : + Fin (3 : ℕ)) false ∨ W = cert.Q (2 : Fin (3 : ℕ)) true) ∧ ∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ cert.O.cells ∧ + LatticeVertexIncidentCell cert.exceptional_segments.b (j + (2 : Fin (4 : ℕ))) ∈ + W.cells ∧ cert.exceptional_segments.b ∈ FootprintVertices cert.O ∧ + cert.exceptional_segments.b ∈ FootprintVertices W ∧ ∀ (y : GaussianInt), y = + cert.exceptional_segments.b ∨ y = cert.exceptional_segments.b + (1 : GaussianInt) ∨ y + = cert.exceptional_segments.b - (1 : GaussianInt) ∨ y = cert.exceptional_segments.b + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = cert.exceptional_segments.b - (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices cert.O ∨ y ∈ FootprintVertices W) → ( + let I : GaussianInt := ⟨0, 1⟩ + (I ^ 2 = -1) → ((I ^ 3 = -I) → ((¬ (∃ r : ℕ, 3 = r + r)) → (((birth 0 = ρ 1 ∧ birth 2 = q + 2 ∧ birth 3 = q 3) → (cert.exceptional_segments.a ∉ FootprintVertices + (TileTranslation cert.O (I * BandVectors.1 (q 2) (ρ 1))) ∧ + cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation cert.O + (BandVectors.1 (ρ 1) (q 3))) ∧ cert.exceptional_segments.b ∉ FootprintVertices + (TileTranslation cert.O (-I * BandVectors.1 (q 2) (ρ 1))) ∧ + cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O + (-BandVectors.1 (ρ 1) (q 3))))) → ((birth 0 = ρ 1 ∧ birth 2 = q 2 ∧ birth 3 = q 3) → + (Nonempty (PositiveCutCompanionRow cert cert.exceptional_segments.b)))))))))))))) ) + := by + classical + intro q cfg C₀ T cert hO ρ birth hproper hOproto hQ3proto hS2proto hneA_OQ hneB_OS + selected_p4_b I hI2 hI3 hodd3 p4_exclusions hp4 + have hbP4 : birth = ![ρ 1, birth 1, q 2, q 3] := by + funext i + fin_cases i + · exact hp4.1 + · rfl + · exact hp4.2.1 + · exact hp4.2.2 + rcases selected_p4_b with ⟨W, hW, ⟨j, hj, hj2, hchild, hparent, hstar⟩⟩ + rcases hW with hWS | hWQ + · subst W + refine ⟨{ + precursorNonempty := hO, + birth := birth, + parentIndex := 1, + rotation := 3, + child := cert.O, + parent := cert.S 1 false, + proper := hproper, + childPrototile := by simpa [hp4.1] using hOproto, + parentPrototile := by simpa [hp4.2.1] using hS2proto, + child_mem := hchild, + parent_mem := hparent, + opposite := ⟨j, hj, hj2⟩, + star := hstar, + rightPrototile := by + exact BandPrototileTranslation (birth 0) cert.O + (I ^ 3 * (if Even 3 then BandVectors.1 (birth 0) (birth 2) + else BandVectors.1 (birth 2) (birth 0))) + (by simpa [hp4.1] using hOproto), + rightAbsent := by + simpa [Even, hodd3, I, hp4.1, hp4.2.1, hI3] using + (p4_exclusions hp4).2.2.1, + fixedPlusCompanion := by + intro hchildEq _ + exact (hneA_OQ hchildEq).elim, + fixedMinusCompanion := by + intro hchildEq _ + exact (hneB_OS hchildEq).elim, + literalRow := Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + ⟨hbP4, rfl, rfl, rfl, rfl, rfl⟩)))))) + }⟩ + · subst W + refine ⟨{ + precursorNonempty := hO, + birth := birth, + parentIndex := 2, + rotation := 2, + child := cert.O, + parent := cert.Q 2 true, + proper := hproper, + childPrototile := by simpa [hp4.1] using hOproto, + parentPrototile := by simpa [hp4.2.2] using hQ3proto, + child_mem := hchild, + parent_mem := hparent, + opposite := ⟨j, hj, hj2⟩, + star := hstar, + rightPrototile := by + exact BandPrototileTranslation (birth 0) cert.O + (I ^ 2 * (if Even 2 then BandVectors.1 (birth 0) (birth 3) + else BandVectors.1 (birth 3) (birth 0))) + (by simpa [hp4.1] using hOproto), + rightAbsent := by + simpa [I, hp4.1, hp4.2.2, hI2] using + (p4_exclusions hp4).2.2.2, + fixedPlusCompanion := by + intro hchildEq _ + exact (hneA_OQ hchildEq).elim, + fixedMinusCompanion := by + intro hchildEq _ + exact (hneB_OS hchildEq).elim, + literalRow := Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + ⟨hbP4, rfl, rfl, rfl, rfl, rfl⟩)))))) + }⟩ + +end PositiveCutGeometry + +theorem BandOrderedGeneralPositiveCutGeometry + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) + (hO : cert.O.cells.Nonempty) : + Nonempty (PositiveCutCompanionRow cert cert.exceptional_segments.a) ∧ + Nonempty (PositiveCutCompanionRow cert cert.exceptional_segments.b) := by +-- BODY + let ρ := cfg.firstPredecessor + have genealogy := BandParentBoundaryGenealogy ρ cfg.firstProper + have hρ2 : ρ 2 = q 2 := by simpa [ρ] using cfg.firstParentTwo + have hρ3 : ρ 3 = q 3 := by simpa [ρ] using cfg.firstParentThree + have hlarge : 4 ≤ (ρ 2).1 := by + simpa [ρ, cfg.firstParentTwo] using cfg.secondLarge + have birthData := PositiveCutGeometry.birthData q cfg genealogy hρ2 hρ3 hlarge + rcases birthData with ⟨birth, hproper, hbranch⟩ + have branchExclusions := + BandPositiveCutBranchCompanionExclusion q cfg C₀ T cert hO + birth hproper hbranch + have sector := BandExceptionalRestorationSectorOrder q cfg C₀ T cert + have prototile_lattice := PositiveCutGeometry.prototile_lattice + have tile_nonempty := PositiveCutGeometry.tile_nonempty + have hcurv := ProperBandCurvatureStructure q cfg.proper + have hq3pos := PositiveCutGeometry.hq3pos q cfg hcurv + have hOproto : BandPrototile (ρ 1) cert.O := by + simpa [cert.precursor_eq] using (cert.plus_occurrence 0 false).1 + have hOpos : 0 < (ρ 1).1 := by + exact (PositiveCutGeometry.positive_of_nonempty) (ρ 1) cert.O hOproto hO + have hQ2proto : BandPrototile (q 2) (cert.Q 1 true) := by + simpa [cfg.firstParentTwo] using (cert.plus_occurrence 1 true).1 + have hS3proto : BandPrototile (q 3) (cert.S 2 false) := by + simpa [cfg.firstParentThree] using (cert.minus_occurrence 2 false).1 + have hQ3proto : BandPrototile (q 3) (cert.Q 2 true) := by + simpa [cfg.firstParentThree] using (cert.plus_occurrence 2 true).1 + have hS2proto : BandPrototile (q 2) (cert.S 1 false) := by + simpa [cfg.firstParentTwo] using (cert.minus_occurrence 1 false).1 + have hQ2lat : LatticeTile (cert.Q 1 true) := by + exact prototile_lattice _ _ hQ2proto (by have h := cfg.secondLarge; omega) + have hS3lat : LatticeTile (cert.S 2 false) := by + exact prototile_lattice _ _ hS3proto hq3pos + have hQ3lat : LatticeTile (cert.Q 2 true) := by + exact prototile_lattice _ _ hQ3proto hq3pos + have hS2lat : LatticeTile (cert.S 1 false) := by + exact prototile_lattice _ _ hS2proto (by have h := cfg.secondLarge; omega) + have hOlat : LatticeTile cert.O := prototile_lattice _ _ hOproto hOpos + have hQ2ne := tile_nonempty _ hQ2lat + have hS3ne := tile_nonempty _ hS3lat + have hQ3ne := tile_nonempty _ hQ3lat + have hS2ne := tile_nonempty _ hS2lat + have hOne := tile_nonempty _ hOlat + have no_checker (X : ProtoTile) (hX : LatticeTile X) : + NoCheckerboardCellVertex (X.cells : Set LatticeCell) := + (LatticeTileGridStructure X hX).2.1 + have hQ2check := no_checker _ hQ2lat + have hS3check := no_checker _ hS3lat + have hQ3check := no_checker _ hQ3lat + have hS2check := no_checker _ hS2lat + have hOcheck := no_checker _ hOlat + have boundary_incident := PositiveCutGeometry.boundary_incident + (PositiveCutGeometry.boundary_to_raw (PositiveCutGeometry.boundary_edge_footprint) + (PositiveCutGeometry.edge_vertex_footprint)) + have raw_incident := PositiveCutGeometry.raw_incident + have haLeft : cert.exceptional_segments.a ∈ cert.exceptional_segments.left := + (PositiveCutGeometry.getLast_mem_of_eq_some) _ _ cert.exceptional_segments.left_last + have hbRight : cert.exceptional_segments.b ∈ cert.exceptional_segments.right := + (PositiveCutGeometry.head_mem_of_eq_some) _ _ cert.exceptional_segments.right_head + have hcutA := (cert.exceptional_segments.first_cut_unique + cert.exceptional_segments.a).mpr rfl + have hcutB := (cert.exceptional_segments.second_cut_unique + cert.exceptional_segments.b).mpr rfl + have hQ2occ : ∃ j : Fin 4, + LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.Q 1 true).cells := + boundary_incident _ _ hQ2ne hcutA.1 + have hS3occ : ∃ j : Fin 4, + LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S 2 false).cells := + boundary_incident _ _ hS3ne hcutA.2.1 + have hQ3occ : ∃ j : Fin 4, + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q 2 true).cells := + boundary_incident _ _ hQ3ne hcutB.1 + have hS2occ : ∃ j : Fin 4, + LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 false).cells := + boundary_incident _ _ hS2ne hcutB.2.1 + have hAowners := PositiveCutGeometry.hAowners q cfg C₀ T cert hO sector haLeft + have hBowners := PositiveCutGeometry.hBowners q cfg C₀ T cert hO sector hbRight + have hOoccA := sector.positive_first_cut_precursor hO + have hOoccB := sector.positive_second_cut_precursor hO + have touching_disjoint := PositiveCutGeometry.touching_disjoint + have hQS := touching_disjoint _ _ cert.precursor_first.1 hQ2ne hS3ne + have hSO := touching_disjoint _ _ cert.precursor_first.2.1 hS3ne hOne + have hOQ := touching_disjoint _ _ cert.precursor_first.2.2.1 hOne hQ2ne + have hQ3S2 := touching_disjoint _ _ cert.precursor_second.1 hQ3ne hS2ne + have hS2O := touching_disjoint _ _ cert.precursor_second.2.1 hS2ne hOne + have hOQ3 := touching_disjoint _ _ cert.precursor_second.2.2.1 hOne hQ3ne + have hQ2S2 := touching_disjoint _ _ cert.double_first.1 hQ2ne hS3ne + have hOQ1 := touching_disjoint _ _ cert.precursor_first.2.2.1 hOne hQ2ne + have hS1O := touching_disjoint _ _ cert.precursor_second.2.1 hS2ne hOne + have normalize_pair := PositiveCutGeometry.normalize_pair + have selectB_Q := PositiveCutGeometry.selectB_Q q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check + hS2check hOcheck hQ3occ hS2occ hBowners hOoccB hQ3S2 hS2O hOQ3 + have normalize_selected := PositiveCutGeometry.normalize_selected + have ne_of_disjoint := PositiveCutGeometry.ne_of_disjoint + have hneQ2S2 := ne_of_disjoint _ _ hQ2S2 hQ2ne + have hneQ1S1 := ne_of_disjoint _ _ (PositiveCutGeometry.hQ1S1 q cfg C₀ T cert hOQ1 + (PositiveCutGeometry.houterIntersection q cfg C₀ T cert)) hQ2ne + have hneA_QS := ne_of_disjoint _ _ hQS hQ2ne + have hneA_QO := ne_of_disjoint _ _ hOQ.symm hQ2ne + have hneA_SO := ne_of_disjoint _ _ hSO hS3ne + have hneB_QS := ne_of_disjoint _ _ hQ3S2 hQ3ne + have hneB_QO := ne_of_disjoint _ _ hOQ3.symm hQ3ne + have hneB_SO := ne_of_disjoint _ _ hS2O hS2ne + have hneB_SQ := ne_of_disjoint _ _ hQ3S2.symm hS2ne + have hneB_SO' := ne_of_disjoint _ _ hS2O hS2ne + have hneB_QO' := ne_of_disjoint _ _ hOQ3.symm hQ3ne + have hneA_OQ := ne_of_disjoint _ _ hOQ hOne + have hneA_OS := ne_of_disjoint _ _ hSO.symm hOne + have hneB_OS := ne_of_disjoint _ _ hS2O.symm hOne + have hneB_OQ := ne_of_disjoint _ _ hOQ3 hOne + have selected_p2_a := normalize_selected (cert.Q 1 true) (cert.S 2 false) cert.O + cert.exceptional_segments.a hneA_QS hneA_QO hneA_SO + ((PositiveCutGeometry.selectA_Q q cfg C₀ T cert hQ2lat hS3lat hOlat hQ2check hS3check hOcheck + hQ2occ hS3occ hAowners hOoccA hQS hSO hOQ) (cert.Q 1 true) (Or.inl rfl)) + have selected_p2_b := normalize_selected (cert.S 1 false) (cert.Q 2 true) cert.O + cert.exceptional_segments.b hneB_SQ hneB_SO' hneB_QO' + ((PositiveCutGeometry.selectB_S q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck + hQ3occ hS2occ hBowners hOoccB hQ3S2 hS2O hOQ3) (cert.S 1 false) (Or.inl rfl)) + have selected_p4_a := normalize_selected cert.O (cert.Q 1 true) (cert.S 2 false) + cert.exceptional_segments.a hneA_OQ hneA_OS hneA_QS + ((PositiveCutGeometry.selectA_O q cfg C₀ T cert hQ2lat hS3lat hOlat hQ2check hS3check hOcheck + hQ2occ hS3occ hAowners hOoccA hQS hSO hOQ) cert.O (Or.inl rfl)) + have selected_p4_b := normalize_selected cert.O (cert.S 1 false) (cert.Q 2 true) + cert.exceptional_segments.b hneB_OS hneB_OQ hneB_SQ + ((PositiveCutGeometry.selectB_O q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck + hQ3occ hS2occ hBowners hOoccB hQ3S2 hS2O hOQ3) cert.O (Or.inl rfl)) + let I : GaussianInt := ⟨0, 1⟩ + have hI2 : I ^ 2 = -1 := by dsimp [I]; decide + have hI3 : I ^ 3 = -I := by dsimp [I]; decide + have hnotEven3 := PositiveCutGeometry.hnotEven3 q cfg + have hodd3 : ¬ (∃ r : ℕ, 3 = r + r) := by omega + have occurrence_centroid := PositiveCutGeometry.occurrence_centroid + have vectorSystem : RecursiveVectorSystem BandVectors := by + simpa [BandVectors] using (Classical.choose_spec RecursiveVectorsExistUnique).1 + have hstep := vectorSystem.2.2.1 ρ cfg.firstProper.1 + have hρ0 : ρ 0 = q 1 := by simpa [ρ] using cfg.firstChild + have hvector := PositiveCutGeometry.hvector q cfg hρ2 hρ3 hstep hρ0 + have translation_centroid := PositiveCutGeometry.translation_centroid + have hpoint := PositiveCutGeometry.hpoint q cfg (PositiveCutGeometry.hI2mul hI2) + (PositiveCutGeometry.pointAdd) (PositiveCutGeometry.pointDouble) + have hfixedPlusProto : BandPrototile (q 2) + (TileTranslation (cert.Q 1 true) (I * BandVectors.1 (q 3) (q 2))) := + BandPrototileTranslation (q 2) (cert.Q 1 true) + (I * BandVectors.1 (q 3) (q 2)) hQ2proto + have hP1proto : BandPrototile (q 2) (cert.P 1 true) := + (cert.outer_occurrence 1 true).1 + have hfixedPlusUnique := BandPrototileCentroidUnique (q 2) + (TileTranslation (cert.Q 1 true) (I * BandVectors.1 (q 3) (q 2))) + (cert.P 1 true) hfixedPlusProto hP1proto (PositiveCutGeometry.hfixedPlusCentroid q cfg C₀ T + cert hvector translation_centroid (PositiveCutGeometry.hP0abs q cfg C₀ T cert + (PositiveCutGeometry.hP0cent q cfg C₀ T cert occurrence_centroid)) + (PositiveCutGeometry.hQ2abs q cfg C₀ T cert (PositiveCutGeometry.hQ2cent q cfg C₀ T cert + occurrence_centroid)) (PositiveCutGeometry.hP1abs q cfg C₀ T cert + (PositiveCutGeometry.hP1cent q cfg C₀ T cert occurrence_centroid)) hpoint) + have hfixedMinusProto : BandPrototile (q 2) + (TileTranslation (cert.S 1 false) (-I * BandVectors.1 (q 3) (q 2))) := + BandPrototileTranslation (q 2) (cert.S 1 false) + (-I * BandVectors.1 (q 3) (q 2)) hS2proto + have hP1minusproto : BandPrototile (q 2) (cert.P 1 false) := + (cert.outer_occurrence 1 false).1 + have hfixedMinusUnique := BandPrototileCentroidUnique (q 2) + (TileTranslation (cert.S 1 false) (-I * BandVectors.1 (q 3) (q 2))) + (cert.P 1 false) hfixedMinusProto hP1minusproto (PositiveCutGeometry.hfixedMinusCentroid q + cfg C₀ T cert hvector translation_centroid hpoint (PositiveCutGeometry.hP0minusabs q cfg + C₀ T cert (PositiveCutGeometry.hP0minuscent q cfg C₀ T cert occurrence_centroid)) + (PositiveCutGeometry.hS1abs q cfg C₀ T cert (PositiveCutGeometry.hS1cent q cfg C₀ T cert + occurrence_centroid)) (PositiveCutGeometry.hP1minusabs q cfg C₀ T cert + (PositiveCutGeometry.hP1minuscent q cfg C₀ T cert occurrence_centroid)) + (PositiveCutGeometry.pointNeg)) + have p2_a_O_row := PositiveCutGeometry.p2_a_O_row q cfg C₀ T cert hO birth hproper + branchExclusions hOproto hQ2proto hS3proto hneQ1S1 hneA_SO hneB_QO selected_p2_a + hfixedPlusUnique (PositiveCutGeometry.hfixedPlusAbsent q cfg C₀ T cert hO sector + raw_incident hfixedPlusUnique (PositiveCutGeometry.hfixedPlusNonempty q cfg C₀ T cert hQ2ne)) + have p2_b_O_row := PositiveCutGeometry.p2_b_O_row q cfg C₀ T cert hO birth hproper + branchExclusions hOproto hQ3proto hS2proto hneQ1S1 hneB_QO' selected_p2_b hI2 hI3 hodd3 + hfixedMinusUnique (PositiveCutGeometry.hfixedMinusAbsent q cfg C₀ T cert hO sector + raw_incident hfixedMinusUnique (PositiveCutGeometry.hfixedMinusNonempty q cfg C₀ T cert + hS2ne)) + have p4_exclusions := PositiveCutGeometry.p4_exclusions q cfg C₀ T cert birth hproper + branchExclusions + have p4_a_row := PositiveCutGeometry.p4_a_row q cfg C₀ T cert hO birth hproper hOproto hQ2proto + hS3proto hneA_OQ hneB_OS selected_p4_a p4_exclusions + have p4_b_row := PositiveCutGeometry.p4_b_row q cfg C₀ T cert hO birth hproper hOproto hQ3proto + hS2proto hneA_OQ hneB_OS selected_p4_b hI2 hI3 hodd3 p4_exclusions + rcases hbranch with hp2 | hp4 + · exact ⟨p2_a_O_row hp2, p2_b_O_row hp2⟩ + · exact ⟨p4_a_row hp4, p4_b_row hp4⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutOdometerRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutOdometerRows.lean new file mode 100644 index 0000000000..bf764e9dbb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutOdometerRows.lean @@ -0,0 +1,1031 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData +public import LeanPool.ApollonianSuperharmonic.BandCircle +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.OdometerWeb +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.PositiveCutCompanionRow +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandOrderedGeneralPositiveCutOdometerRows] + +/-! +# BandOrderedGeneralPositiveCutOdometerRows + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PositiveCutOdometerGeometry + +private theorem positive_of_nonempty : + (by + classical + exact + ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), BandPrototile c U → U.cells.Nonempty → 0 < + c.1 ) := by + classical + intro c U hU + induction hU with + | line w z hw => intro hn; simp at hn + | unit z x a => intro _; norm_num + | @decompose p hp S U hs hc hf hcent ih => + intro _ + exact (ProperBandCurvatureStructure p hp).1 + +private theorem pos3 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (BandOrderedGeneralConfiguration q) → (0 < (q 3).1) ) + := by + classical + intro q cfg + have hn : 0 ≤ (q 3).1 := (ProperBandCurvatureStructure q cfg.proper).2.1 2 + have := cfg.noLine 3 + omega + +private theorem posO : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (x : GaussianInt), (PositiveCutCompanionRow cert x) → ((∀ (c : + CircleCoordinates), ∀ (U : ProtoTile), BandPrototile c U → U.cells.Nonempty → 0 < + c.1) → (0 < (cfg.firstPredecessor 1).1)) ) := by + classical + intro q cfg C0 T cert x geometry positive_of_nonempty + apply positive_of_nonempty _ cert.O _ geometry.precursorNonempty + simpa [cert.precursor_eq] using (cert.plus_occurrence 0 false).1 + +private theorem nestedPositive : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), (0 < (q + 2).1) → ((0 < (q 3).1) → ((0 < (cfg.firstPredecessor 1).1) → (∀ (j : Fin 3), 0 < + (cfg.firstPredecessor j.succ).1))) ) := by + classical + intro q cfg pos2 pos3 posO j + fin_cases j + · exact posO + · simpa [cfg.firstParentTwo] using pos2 + · simpa [cfg.firstParentThree] using pos3 + +private theorem sumV : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let W := BandVectors.1 (q 3) (q 2) + let Z := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let X := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + W + Z + X = 0 ) := by + classical + intro q cfg W Z X + simpa [W, Z, X, cfg.firstParentTwo, cfg.firstParentThree] using + (VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).1 + +private theorem sumA : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let A := BandVectors.2 (q 3) (q 2) + let B := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let D := BandVectors.2 (q 2) (cfg.firstPredecessor 1) + A + B + D = 0 ) := by + classical + intro q cfg A B D + simpa [A, B, D, cfg.firstParentTwo, cfg.firstParentThree] using + (VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).2.1 + +private theorem sumC : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let W := BandVectors.1 (q 3) (q 2) + let Z := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let X := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (∀ (a : GaussianInt), ∀ (b : GaussianInt), cOff (a + b) = cOff a + cOff b) → ((W + Z + X + = 0) → (cOff W + cOff Z + cOff X = 0)) ) := by + classical + intro q cfg cOff W Z X cadd sumV + rw [← cadd, ← cadd, sumV] + simp [cOff, GaussianRealPoint] + +private theorem sumS : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let sOff (z : GaussianInt) : Real × Real := + ((1 / 2 : Real) * ((z.re : Real) - (z.im : Real)), + (1 / 2 : Real) * ((z.im : Real) + (z.re : Real))) + let A := BandVectors.2 (q 3) (q 2) + let B := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let D := BandVectors.2 (q 2) (cfg.firstPredecessor 1) + (∀ (a : GaussianInt), ∀ (b : GaussianInt), sOff (a + b) = sOff a + sOff b) → ((A + B + D + = 0) → (sOff A + sOff B + sOff D = 0)) ) := by + classical + intro q cfg sOff A B D sadd sumA + rw [← sadd, ← sadd, sumA] + simp [sOff] + +private theorem pcent : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let W := BandVectors.1 (q 3) (q 2) + ∀ (b : Bool), TileCentroid (P 0 b) - TileCentroid T = (if b then (1 : Real) else -1) • + cOff W) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data cOff W b + simpa [cOff, W, Fin.add_def] using data.hPcent 0 b + +private theorem centO : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (Q : Fin 3 -> Bool -> ProtoTile), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let W := BandVectors.1 (q 3) (q 2) + (∀ (j : Fin 3), ∀ (b : Bool), TileCentroid (Q j b) - TileCentroid (P 0 true) = (if b then + (1 : Real) else -1) • cOff (BandVectors.1 (cfg.firstPredecessor ((j + 2).succ)) + (cfg.firstPredecessor ((j + 1).succ)))) → ((TileCentroid (P 0 true) - TileCentroid T + = cOff W) → (TileCentroid (Q 0 false) - TileCentroid T = 0)) ) := by + classical + intro q cfg T P Q cOff W qcent centPp + have hc : TileCentroid (Q 0 false) - TileCentroid (P 0 true) = -cOff W := by + simpa [Fin.add_def, cfg.firstParentTwo, cfg.firstParentThree, W] using qcent 0 false + rw [← sub_add_sub_cancel (TileCentroid (Q 0 false)) + (TileCentroid (P 0 true)) (TileCentroid T), hc, centPp] + abel + +private theorem centQ1 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (Q : Fin 3 -> Bool -> ProtoTile), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let W := BandVectors.1 (q 3) (q 2) + let Z := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let X := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (cOff W + cOff Z + cOff X = 0) → ((∀ (j : Fin 3), ∀ (b : Bool), TileCentroid (Q j b) - + TileCentroid (P 0 true) = (if b then (1 : Real) else -1) • cOff (BandVectors.1 + (cfg.firstPredecessor ((j + 2).succ)) (cfg.firstPredecessor ((j + 1).succ)))) → + ((TileCentroid (P 0 true) - TileCentroid T = cOff W) → (TileCentroid (Q 1 true) - + TileCentroid T = -cOff X))) ) := by + classical + intro q cfg T P Q cOff W Z X sumC qcent centPp + have hc : TileCentroid (Q 1 true) - TileCentroid (P 0 true) = cOff Z := by + simpa [Fin.add_def, cfg.firstParentThree, Z] using qcent 1 true + rw [← sub_add_sub_cancel (TileCentroid (Q 1 true)) + (TileCentroid (P 0 true)) (TileCentroid T), hc, centPp] + linear_combination sumC + +private theorem centQ2 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (Q : Fin 3 -> Bool -> ProtoTile), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let W := BandVectors.1 (q 3) (q 2) + let Z := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let X := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (cOff W + cOff Z + cOff X = 0) → ((∀ (j : Fin 3), ∀ (b : Bool), TileCentroid (Q j b) - + TileCentroid (P 0 true) = (if b then (1 : Real) else -1) • cOff (BandVectors.1 + (cfg.firstPredecessor ((j + 2).succ)) (cfg.firstPredecessor ((j + 1).succ)))) → + ((TileCentroid (P 0 true) - TileCentroid T = cOff W) → (TileCentroid (Q 2 true) - + TileCentroid T = -cOff Z))) ) := by + classical + intro q cfg T P Q cOff W Z X sumC qcent centPp + have hc : TileCentroid (Q 2 true) - TileCentroid (P 0 true) = cOff X := by + simpa [Fin.add_def, cfg.firstParentTwo, X] using qcent 2 true + rw [← sub_add_sub_cancel (TileCentroid (Q 2 true)) + (TileCentroid (P 0 true)) (TileCentroid T), hc, centPp] + linear_combination sumC + +private theorem centS1 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> ProtoTile), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let W := BandVectors.1 (q 3) (q 2) + let Z := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let X := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (cOff W + cOff Z + cOff X = 0) → ((∀ (j : Fin 3), ∀ (b : Bool), TileCentroid (S j b) - + TileCentroid (P 0 false) = (if b then (1 : Real) else -1) • cOff (BandVectors.1 + (cfg.firstPredecessor ((j + 2).succ)) (cfg.firstPredecessor ((j + 1).succ)))) → + ((TileCentroid (P 0 false) - TileCentroid T = -cOff W) → (TileCentroid (S 1 false) - + TileCentroid T = cOff X))) ) := by + classical + intro q cfg T P S cOff W Z X sumC scent centPm + have hc : TileCentroid (S 1 false) - TileCentroid (P 0 false) = -cOff Z := by + simpa [Fin.add_def, cfg.firstParentThree, Z] using scent 1 false + rw [← sub_add_sub_cancel (TileCentroid (S 1 false)) + (TileCentroid (P 0 false)) (TileCentroid T), hc, centPm] + linear_combination -sumC + +private theorem centS2 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : + ProtoTile), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> ProtoTile), + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let W := BandVectors.1 (q 3) (q 2) + let Z := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let X := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (cOff W + cOff Z + cOff X = 0) → ((∀ (j : Fin 3), ∀ (b : Bool), TileCentroid (S j b) - + TileCentroid (P 0 false) = (if b then (1 : Real) else -1) • cOff (BandVectors.1 + (cfg.firstPredecessor ((j + 2).succ)) (cfg.firstPredecessor ((j + 1).succ)))) → + ((TileCentroid (P 0 false) - TileCentroid T = -cOff W) → (TileCentroid (S 2 false) - + TileCentroid T = cOff Z))) ) := by + classical + intro q cfg T P S cOff W Z X sumC scent centPm + have hc : TileCentroid (S 2 false) - TileCentroid (P 0 false) = -cOff X := by + simpa [Fin.add_def, cfg.firstParentTwo, X] using scent 2 false + rw [← sub_add_sub_cancel (TileCentroid (S 2 false)) + (TileCentroid (P 0 false)) (TileCentroid T), hc, centPm] + linear_combination -sumC + +private theorem pslope : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let sOff (z : GaussianInt) : Real × Real := + ((1 / 2 : Real) * ((z.re : Real) - (z.im : Real)), + (1 / 2 : Real) * ((z.im : Real) + (z.re : Real))) + let A := BandVectors.2 (q 3) (q 2) + ∀ (b : Bool), ∃ a c : Real × Real, PartialOdometerSlope h = some a ∧ PartialOdometerSlope + (r 0 b) = some c ∧ c - a = (if b then (1 : Real) else -1) • sOff A) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data sOff A b + obtain ⟨a, c, ha, hc, hx, hy⟩ := + (data.hPslope 0 b).resolve_left (cfg.noLine 1) + refine ⟨a, c, ha, hc, ?_⟩ + apply Prod.ext + · cases b <;> simpa [sOff, A, Fin.add_def] using hx + · cases b <;> simpa [sOff, A, Fin.add_def] using hy + +private theorem qslope : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ((∀ (j : Fin 3), 0 < (cfg.firstPredecessor + j.succ).1) → ( + let sOff (z : GaussianInt) : Real × Real := + ((1 / 2 : Real) * ((z.re : Real) - (z.im : Real)), + (1 / 2 : Real) * ((z.im : Real) + (z.re : Real))) + ∀ (j : Fin 3), ∀ (b : Bool), ∃ a c : Real × Real, PartialOdometerSlope (r 0 true) = some + a ∧ PartialOdometerSlope (u j b) = some c ∧ c - a = (if b then (1 : Real) else -1) • + sOff (BandVectors.2 (cfg.firstPredecessor ((j + 2).succ)) (cfg.firstPredecessor ((j + + 1).succ))))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data nestedPositive sOff j b + obtain ⟨a, c, ha, hc, hx, hy⟩ := + (data.hQslope j b).resolve_left (ne_of_gt (nestedPositive j)) + refine ⟨a, c, ha, hc, ?_⟩ + apply Prod.ext + · cases b <;> simpa [sOff] using hx + · cases b <;> simpa [sOff] using hy + +private theorem sslope : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ((∀ (j : Fin 3), 0 < (cfg.firstPredecessor + j.succ).1) → ( + let sOff (z : GaussianInt) : Real × Real := + ((1 / 2 : Real) * ((z.re : Real) - (z.im : Real)), + (1 / 2 : Real) * ((z.im : Real) + (z.re : Real))) + ∀ (j : Fin 3), ∀ (b : Bool), ∃ a c : Real × Real, PartialOdometerSlope (r 0 false) = some + a ∧ PartialOdometerSlope (v j b) = some c ∧ c - a = (if b then (1 : Real) else -1) • + sOff (BandVectors.2 (cfg.firstPredecessor ((j + 2).succ)) (cfg.firstPredecessor ((j + + 1).succ))))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data nestedPositive sOff j b + obtain ⟨a, c, ha, hc, hx, hy⟩ := + (data.hSslope j b).resolve_left (ne_of_gt (nestedPositive j)) + refine ⟨a, c, ha, hc, ?_⟩ + apply Prod.ext + · cases b <;> simpa [sOff] using hx + · cases b <;> simpa [sOff] using hy + +private theorem slopeO : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let sOff (z : GaussianInt) : Real × Real := + ((1 / 2 : Real) * ((z.re : Real) - (z.im : Real)), + (1 / 2 : Real) * ((z.im : Real) + (z.re : Real))) + let A := BandVectors.2 (q 3) (q 2) + ∀ (z : ℝ × ℝ), ∀ (zp : ℝ × ℝ), ∀ (zO : ℝ × ℝ), (zO - zp = (if false = true then (1 : ℝ) + else (-1 : ℝ)) • sOff (BandVectors.2 (cfg.firstPredecessor ((0 : Fin (3 : ℕ)) + (2 : + Fin (3 : ℕ))).succ) (cfg.firstPredecessor ((0 : Fin (3 : ℕ)) + (1 : Fin (3 : + ℕ))).succ))) → ((zp - z = sOff A) → (zO - z = 0)) ) := by + classical + intro q cfg sOff A z zp zO dzO slopePp + have hh : zO - zp = -sOff A := by + simpa [Fin.add_def, cfg.firstParentTwo, cfg.firstParentThree, A] using dzO + linear_combination hh + slopePp + +private theorem slopeQ1 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let sOff (z : GaussianInt) : Real × Real := + ((1 / 2 : Real) * ((z.re : Real) - (z.im : Real)), + (1 / 2 : Real) * ((z.im : Real) + (z.re : Real))) + let A := BandVectors.2 (q 3) (q 2) + let B := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let D := BandVectors.2 (q 2) (cfg.firstPredecessor 1) + (sOff A + sOff B + sOff D = 0) → (∀ (z : ℝ × ℝ), ∀ (zp : ℝ × ℝ), ∀ (zQ1 : ℝ × ℝ), (zQ1 - + zp = (if true = true then (1 : ℝ) else (-1 : ℝ)) • sOff (BandVectors.2 + (cfg.firstPredecessor ((1 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor ((1 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ))) → ((zp - z = + sOff A) → (zQ1 - z = -sOff D))) ) := by + classical + intro q cfg sOff A B D sumS z zp zQ1 dzQ1 slopePp + have hh : zQ1 - zp = sOff B := by + simpa [Fin.add_def, cfg.firstParentThree, B] using dzQ1 + linear_combination hh + slopePp + sumS + +private theorem slopeQ2 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let sOff (z : GaussianInt) : Real × Real := + ((1 / 2 : Real) * ((z.re : Real) - (z.im : Real)), + (1 / 2 : Real) * ((z.im : Real) + (z.re : Real))) + let A := BandVectors.2 (q 3) (q 2) + let B := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let D := BandVectors.2 (q 2) (cfg.firstPredecessor 1) + (sOff A + sOff B + sOff D = 0) → (∀ (z : ℝ × ℝ), ∀ (zp : ℝ × ℝ), ∀ (zQ2 : ℝ × ℝ), (zQ2 - + zp = (if true = true then (1 : ℝ) else (-1 : ℝ)) • sOff (BandVectors.2 + (cfg.firstPredecessor ((2 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor ((2 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ))) → ((zp - z = + sOff A) → (zQ2 - z = -sOff B))) ) := by + classical + intro q cfg sOff A B D sumS z zp zQ2 dzQ2 slopePp + have hh : zQ2 - zp = sOff D := by + simpa [Fin.add_def, cfg.firstParentTwo, D] using dzQ2 + linear_combination hh + slopePp + sumS + +private theorem slopeS1 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let sOff (z : GaussianInt) : Real × Real := + ((1 / 2 : Real) * ((z.re : Real) - (z.im : Real)), + (1 / 2 : Real) * ((z.im : Real) + (z.re : Real))) + let A := BandVectors.2 (q 3) (q 2) + let B := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let D := BandVectors.2 (q 2) (cfg.firstPredecessor 1) + (sOff A + sOff B + sOff D = 0) → (∀ (z : ℝ × ℝ), ∀ (zm : ℝ × ℝ), ∀ (zS1 : ℝ × ℝ), (zS1 - + zm = (if false = true then (1 : ℝ) else (-1 : ℝ)) • sOff (BandVectors.2 + (cfg.firstPredecessor ((1 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor ((1 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ))) → ((zm - z = + -sOff A) → (zS1 - z = sOff D))) ) := by + classical + intro q cfg sOff A B D sumS z zm zS1 dzS1 slopePm + have hh : zS1 - zm = -sOff B := by + simpa [Fin.add_def, cfg.firstParentThree, B] using dzS1 + linear_combination hh + slopePm - sumS + +private theorem slopeS2 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let sOff (z : GaussianInt) : Real × Real := + ((1 / 2 : Real) * ((z.re : Real) - (z.im : Real)), + (1 / 2 : Real) * ((z.im : Real) + (z.re : Real))) + let A := BandVectors.2 (q 3) (q 2) + let B := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let D := BandVectors.2 (q 2) (cfg.firstPredecessor 1) + (sOff A + sOff B + sOff D = 0) → (∀ (z : ℝ × ℝ), ∀ (zm : ℝ × ℝ), ∀ (zS2 : ℝ × ℝ), (zS2 - + zm = (if false = true then (1 : ℝ) else (-1 : ℝ)) • sOff (BandVectors.2 + (cfg.firstPredecessor ((2 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor ((2 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ))) → ((zm - z = + -sOff A) → (zS2 - z = sOff B))) ) := by + classical + intro q cfg sOff A B D sumS z zm zS2 dzS2 slopePm + have hh : zS2 - zm = -sOff D := by + simpa [Fin.add_def, cfg.firstParentTwo, D] using dzS2 + linear_combination hh + slopePm - sumS + +private theorem cforms : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (x : GaussianInt), ∀ (geometry : PositiveCutCompanionRow cert x), + let I : GaussianInt := ⟨0, 1⟩ + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let cTarget (s : Fin 4) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint + (I ^ s.val * + (BandVectors.1 (geometry.birth geometry.parentIndex.succ) (geometry.birth 0) + + BandVectors.1 (geometry.birth 0) (geometry.birth geometry.parentIndex.succ))) + (BandVectors.1 (geometry.birth (0 : Fin (4 : ℕ))) (geometry.birth + geometry.parentIndex.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 + (geometry.birth geometry.parentIndex.succ) (geometry.birth (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (geometry.birth (0 : Fin (4 : ℕ))) (geometry.birth + geometry.parentIndex.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 + (geometry.birth geometry.parentIndex.succ) (geometry.birth (0 : Fin (4 : ℕ)))) → + (cTarget 1 = -cOff (BandVectors.1 (geometry.birth geometry.parentIndex.succ) + (geometry.birth 0)) ∧ cTarget 3 = cOff (BandVectors.1 (geometry.birth + geometry.parentIndex.succ) (geometry.birth 0)) ∧ cTarget 0 = cOff (BandVectors.1 + (geometry.birth 0) (geometry.birth geometry.parentIndex.succ)) ∧ cTarget 2 = -cOff + (BandVectors.1 (geometry.birth 0) (geometry.birth geometry.parentIndex.succ))) ) := by + classical + intro q cfg C0 T cert x geometry I cOff cTarget flip + dsimp only [cTarget] + rw [flip.1] + refine ⟨?_, ?_, ?_, ?_⟩ <;> apply Prod.ext <;> + norm_num [cOff, I, GaussianRealPoint, Prod.smul_mk, pow_succ] <;> ring + +private theorem sforms : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (x : GaussianInt), ∀ (geometry : PositiveCutCompanionRow cert x), + let I : GaussianInt := ⟨0, 1⟩ + let sOff (z : GaussianInt) : Real × Real := + ((1 / 2 : Real) * ((z.re : Real) - (z.im : Real)), + (1 / 2 : Real) * ((z.im : Real) + (z.re : Real))) + let sTarget (s : Fin 4) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint + ((-I) ^ s.val * + (BandVectors.2 (geometry.birth geometry.parentIndex.succ) (geometry.birth 0) + + BandVectors.2 (geometry.birth 0) (geometry.birth geometry.parentIndex.succ))) + (BandVectors.1 (geometry.birth (0 : Fin (4 : ℕ))) (geometry.birth + geometry.parentIndex.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 + (geometry.birth geometry.parentIndex.succ) (geometry.birth (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (geometry.birth (0 : Fin (4 : ℕ))) (geometry.birth + geometry.parentIndex.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 + (geometry.birth geometry.parentIndex.succ) (geometry.birth (0 : Fin (4 : ℕ)))) → + (sTarget 1 = -sOff (BandVectors.2 (geometry.birth geometry.parentIndex.succ) + (geometry.birth 0)) ∧ sTarget 3 = sOff (BandVectors.2 (geometry.birth + geometry.parentIndex.succ) (geometry.birth 0)) ∧ sTarget 0 = sOff (BandVectors.2 + (geometry.birth 0) (geometry.birth geometry.parentIndex.succ)) ∧ sTarget 2 = -sOff + (BandVectors.2 (geometry.birth 0) (geometry.birth geometry.parentIndex.succ))) ) := by + classical + intro q cfg C0 T cert x geometry I sOff sTarget flip + dsimp only [sTarget] + rw [flip.2] + refine ⟨?_, ?_, ?_, ?_⟩ <;> apply Prod.ext <;> + norm_num [sOff, I, GaussianRealPoint, Prod.smul_mk, pow_succ] <;> ring + +private theorem finish : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), ∀ (geometry : + PositiveCutCompanionRow cert x), + let I : GaussianInt := ⟨0, 1⟩ + let cTarget (s : Fin 4) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint + (I ^ s.val * + (BandVectors.1 (geometry.birth geometry.parentIndex.succ) (geometry.birth 0) + + BandVectors.1 (geometry.birth 0) (geometry.birth geometry.parentIndex.succ))) + let sTarget (s : Fin 4) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint + ((-I) ^ s.val * + (BandVectors.2 (geometry.birth geometry.parentIndex.succ) (geometry.birth 0) + + BandVectors.2 (geometry.birth 0) (geometry.birth geometry.parentIndex.succ))) + ∀ (Uhat : ProtoTile), ∀ (What : ProtoTile), ∀ (hu : PartialOdometer), ∀ (hw : + PartialOdometer), (TileOdometer (geometry.birth 0) Uhat hu) → ((TileOdometer + (geometry.birth geometry.parentIndex.succ) What hw) → ((FootprintVertices Uhat = + FootprintVertices geometry.child) → ((FootprintVertices What = FootprintVertices + geometry.parent) → ((GlobalOdometerExtends g hu) → ((GlobalOdometerExtends g hw) → + ((OdometerCompatibility hu hw) → ((0 < (geometry.birth geometry.parentIndex.succ).1) + → (∀ (pU : Real × Real), ∀ (pW : Real × Real), (PartialOdometerSlope hu = some pU) → + ((PartialOdometerSlope hw = some pW) → ((TileCentroid What - TileCentroid Uhat = + cTarget geometry.rotation) → ((pW - pU = sTarget geometry.rotation) → + (FourNeighborLaplacian g x = 1)))))))))))) ) := by + classical + intro q cfg C0 T cert g x geometry I cTarget sTarget Uhat What hu hw hUodo hWodo hUfoot hWfoot + hUext hWext hcompat hWpos pU pW hpU hpW hcent hslope + have hp := geometry.proper + have hUpos := (ProperBandCurvatureStructure geometry.birth hp).1 + let CU : BandCircle := + ⟨⟨geometry.birth 0, Or.inl hUpos, geometry.birth, hp.1, 0, rfl⟩, hUpos⟩ + let CW : BandCircle := + ⟨⟨geometry.birth geometry.parentIndex.succ, Or.inl hWpos, + geometry.birth, hp.1, geometry.parentIndex.succ, rfl⟩, hWpos⟩ + have domU := PositiveCurvatureTileOdometerDomain _ Uhat hu hUpos hUodo + have domW := PositiveCurvatureTileOdometerDomain _ What hw hWpos hWodo + have memU : x ∈ hu.domain := by + change x ∈ (hu.domain : Set GaussianInt) + rw [domU, hUfoot] + exact geometry.child_mem + have memW : x ∈ hw.domain := by + change x ∈ (hw.domain : Set GaussianInt) + rw [domW, hWfoot] + exact geometry.parent_mem + have star : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ hu.domain ∨ y ∈ hw.domain := by + intro y hy + change y ∈ (hu.domain : Set GaussianInt) ∨ y ∈ (hw.domain : Set GaussianInt) + rw [domU, domW, hUfoot, hWfoot] + exact geometry.star y hy + let uR := I ^ geometry.rotation.val * + (if Even geometry.rotation.val then + BandVectors.1 (geometry.birth 0) (geometry.birth geometry.parentIndex.succ) + else BandVectors.1 (geometry.birth geometry.parentIndex.succ) (geometry.birth 0)) + have translated : FootprintVertices (TileTranslation Uhat uR) = + FootprintVertices (TileTranslation geometry.child uR) := by + rw [(TileTranslationFormulas Uhat uR).2.2.2.2.2.1, + (TileTranslationFormulas geometry.child uR).2.2.2.2.2.1, hUfoot] + have absent : x ∉ FootprintVertices (TileTranslation Uhat uR) := by + rw [translated] + exact geometry.rightAbsent + have slope1 := congrArg Prod.fst hslope + have slope2 := congrArg Prod.snd hslope + have adj : SubtileLatticeAdjacent CU CW Uhat What hu hw := + ⟨hUodo, hWodo, pU, pW, hpU, hpW, geometry.birth, geometry.parentIndex, + geometry.rotation, hp, rfl, rfl, hcent, slope1, slope2⟩ + exact ((OdometerWeb.2 CU CW geometry.birth geometry.parentIndex geometry.rotation + Uhat What hu hw g x pU pW hp rfl rfl hpU hpW hcent slope1 slope2 adj + hcompat hUext hWext memU memW star).2 absent) + +end PositiveCutOdometerGeometry + +namespace PositiveCutOdometerConclusion + +private theorem positiveCutConclusion : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), + (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → (∀ (geometry : + PositiveCutCompanionRow cert x), (0 < (q 2).1) → ((0 < (q 3).1) → ((0 < + (cfg.firstPredecessor 1).1) → ( + let I : GaussianInt := ⟨0, 1⟩ + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let sOff (z : GaussianInt) : Real × Real := + ((1 / 2 : Real) * ((z.re : Real) - (z.im : Real)), + (1 / 2 : Real) * ((z.im : Real) + (z.re : Real))) + let W := BandVectors.1 (q 3) (q 2) + let Z := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let X := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let A := BandVectors.2 (q 3) (q 2) + let B := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let D := BandVectors.2 (q 2) (cfg.firstPredecessor 1) + (cOff W + cOff Z + cOff X = 0) → ((sOff A + sOff B + sOff D = 0) → ((TileCentroid (Q 0 + false) - TileCentroid T = 0) → ((TileCentroid (Q 1 true) - TileCentroid T = -cOff X) + → ((TileCentroid (Q 2 true) - TileCentroid T = -cOff Z) → ((TileCentroid (S 1 false) + - TileCentroid T = cOff X) → ((TileCentroid (S 2 false) - TileCentroid T = cOff Z) → + (∀ (z : ℝ × ℝ), ∀ (zO : ℝ × ℝ), (PartialOdometerSlope (u (0 : Fin (3 : ℕ)) false) = + some zO) → (∀ (zQ1 : ℝ × ℝ), (PartialOdometerSlope (u (1 : Fin (3 : ℕ)) true) = some + zQ1) → (∀ (zQ2 : ℝ × ℝ), (PartialOdometerSlope (u (2 : Fin (3 : ℕ)) true) = some zQ2) + → (∀ (zS1 : ℝ × ℝ), (PartialOdometerSlope (v (1 : Fin (3 : ℕ)) false) = some zS1) → + (∀ (zS2 : ℝ × ℝ), (PartialOdometerSlope (v (2 : Fin (3 : ℕ)) false) = some zS2) → + ((zO - z = 0) → ((zQ1 - z = -sOff D) → ((zQ2 - z = -sOff B) → ((zS1 - z = sOff D) → + ((zS2 - z = sOff B) → ( + let cTarget (s : Fin 4) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint + (I ^ s.val * + (BandVectors.1 (geometry.birth geometry.parentIndex.succ) (geometry.birth 0) + + BandVectors.1 (geometry.birth 0) (geometry.birth geometry.parentIndex.succ))) + let sTarget (s : Fin 4) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint + ((-I) ^ s.val * + (BandVectors.2 (geometry.birth geometry.parentIndex.succ) (geometry.birth 0) + + BandVectors.2 (geometry.birth 0) (geometry.birth geometry.parentIndex.succ))) + (cTarget 1 = -cOff (BandVectors.1 (geometry.birth geometry.parentIndex.succ) + (geometry.birth 0)) ∧ cTarget 3 = cOff (BandVectors.1 (geometry.birth + geometry.parentIndex.succ) (geometry.birth 0)) ∧ cTarget 0 = cOff (BandVectors.1 + (geometry.birth 0) (geometry.birth geometry.parentIndex.succ)) ∧ cTarget 2 = -cOff + (BandVectors.1 (geometry.birth 0) (geometry.birth geometry.parentIndex.succ))) → + ((sTarget 1 = -sOff (BandVectors.2 (geometry.birth geometry.parentIndex.succ) + (geometry.birth 0)) ∧ sTarget 3 = sOff (BandVectors.2 (geometry.birth + geometry.parentIndex.succ) (geometry.birth 0)) ∧ sTarget 0 = sOff (BandVectors.2 + (geometry.birth 0) (geometry.birth geometry.parentIndex.succ)) ∧ sTarget 2 = -sOff + (BandVectors.2 (geometry.birth 0) (geometry.birth geometry.parentIndex.succ))) → ((∀ + (Uhat : ProtoTile), ∀ (What : ProtoTile), ∀ (hu : PartialOdometer), ∀ (hw : + PartialOdometer), (TileOdometer (geometry.birth 0) Uhat hu) → ((TileOdometer + (geometry.birth geometry.parentIndex.succ) What hw) → ((FootprintVertices Uhat = + FootprintVertices geometry.child) → ((FootprintVertices What = FootprintVertices + geometry.parent) → ((GlobalOdometerExtends g hu) → ((GlobalOdometerExtends g hw) → + ((OdometerCompatibility hu hw) → ((0 < (geometry.birth geometry.parentIndex.succ).1) + → (∀ (pU : Real × Real), ∀ (pW : Real × Real), (PartialOdometerSlope hu = some pU) → + ((PartialOdometerSlope hw = some pW) → ((TileCentroid What - TileCentroid Uhat = + cTarget geometry.rotation) → ((pW - pU = sTarget geometry.rotation) → + (FourNeighborLaplacian g x = 1))))))))))))) → (FourNeighborLaplacian g x = + 1)))))))))))))))))))))))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g x data geometry pos2 pos3 posO I cOff sOff W Z X A B D + sumC sumS centO centQ1 centQ2 centS1 centS2 z zO hzO zQ1 hzQ1 zQ2 hzQ2 zS1 hzS1 zS2 hzS2 + slopeO slopeQ1 slopeQ2 slopeS1 slopeS2 cTarget sTarget cforms sforms finish + rcases geometry.literalRow with row | row | row | row | row | row | row | row + all_goals obtain ⟨hbirth, hindex, hrotation, hx, hchild, hparent⟩ := row + all_goals + have hb0 := congrFun hbirth (0 : Fin 4) + have hb2 := congrFun hbirth (2 : Fin 4) + have hb3 := congrFun hbirth (3 : Fin 4) + norm_num at hb0 hb2 hb3 + · refine finish (Q 1 true) (S 2 false) (u 1 true) (v 2 false) + ?_ ?_ ?_ ?_ (data.hextQ 1 true) (data.hextS 2 false) + ?_ ?_ zQ1 zS2 hzQ1 hzS2 ?_ ?_ + · simpa [hb0, cfg.firstParentTwo] using data.hQ 1 true + · simpa [hindex, hb2, cfg.firstParentThree] using data.hS 2 false + · simpa [hchild] using (data.hobsQ 1 true).2.1 + · simpa [hparent] using (data.hobsS 2 false).2.1 + · exact data.hcompat _ _ ⟨1, true, Or.inr (Or.inl rfl)⟩ + ⟨2, false, Or.inr (Or.inr rfl)⟩ + · simpa [hindex, hb2] using pos3 + · rw [hrotation, cforms.1, hindex] + change TileCentroid (S 2 false) - TileCentroid (Q 1 true) = + -cOff (BandVectors.1 (geometry.birth 2) (geometry.birth 0)) + rw [hb0, hb2] + change TileCentroid (S 2 false) - TileCentroid (Q 1 true) = -cOff W + linear_combination centS2 - centQ1 + sumC + · rw [hrotation, sforms.1, hindex] + change zS2 - zQ1 = -sOff (BandVectors.2 (geometry.birth 2) (geometry.birth 0)) + rw [hb0, hb2] + change zS2 - zQ1 = -sOff A + linear_combination slopeS2 - slopeQ1 + sumS + · refine finish (Q 1 true) (Q 0 false) (u 1 true) (u 0 false) + ?_ ?_ ?_ ?_ (data.hextQ 1 true) (data.hextQ 0 false) + ?_ ?_ zQ1 zO hzQ1 hzO ?_ ?_ + · simpa [hb0, cfg.firstParentTwo] using data.hQ 1 true + · simpa [hindex, hb3] using data.hQ 0 false + · simpa [hchild] using (data.hobsQ 1 true).2.1 + · simpa [hparent, cert.precursor_eq] using (data.hobsQ 0 false).2.1 + · exact data.hcompat _ _ ⟨1, true, Or.inr (Or.inl rfl)⟩ + ⟨0, false, Or.inr (Or.inl rfl)⟩ + · simpa [hindex, hb3] using posO + · rw [hrotation, cforms.2.2.1, hindex] + change TileCentroid (Q 0 false) - TileCentroid (Q 1 true) = + cOff (BandVectors.1 (geometry.birth 0) (geometry.birth 3)) + rw [hb0, hb3] + change TileCentroid (Q 0 false) - TileCentroid (Q 1 true) = cOff X + linear_combination centO - centQ1 + · rw [hrotation, sforms.2.2.1, hindex] + change zO - zQ1 = sOff (BandVectors.2 (geometry.birth 0) (geometry.birth 3)) + rw [hb0, hb3] + change zO - zQ1 = sOff D + linear_combination slopeO - slopeQ1 + · refine finish (S 1 false) (Q 2 true) (v 1 false) (u 2 true) + ?_ ?_ ?_ ?_ (data.hextS 1 false) (data.hextQ 2 true) + ?_ ?_ zS1 zQ2 hzS1 hzQ2 ?_ ?_ + · simpa [hb0, cfg.firstParentTwo] using data.hS 1 false + · simpa [hindex, hb2, cfg.firstParentThree] using data.hQ 2 true + · simpa [hchild] using (data.hobsS 1 false).2.1 + · simpa [hparent] using (data.hobsQ 2 true).2.1 + · exact data.hcompat _ _ ⟨1, false, Or.inr (Or.inr rfl)⟩ + ⟨2, true, Or.inr (Or.inl rfl)⟩ + · simpa [hindex, hb2] using pos3 + · rw [hrotation, cforms.2.1, hindex] + change TileCentroid (Q 2 true) - TileCentroid (S 1 false) = + cOff (BandVectors.1 (geometry.birth 2) (geometry.birth 0)) + rw [hb0, hb2] + change TileCentroid (Q 2 true) - TileCentroid (S 1 false) = cOff W + linear_combination centQ2 - centS1 - sumC + · rw [hrotation, sforms.2.1, hindex] + change zQ2 - zS1 = sOff (BandVectors.2 (geometry.birth 2) (geometry.birth 0)) + rw [hb0, hb2] + change zQ2 - zS1 = sOff A + linear_combination slopeQ2 - slopeS1 - sumS + · refine finish (S 1 false) (Q 0 false) (v 1 false) (u 0 false) + ?_ ?_ ?_ ?_ (data.hextS 1 false) (data.hextQ 0 false) + ?_ ?_ zS1 zO hzS1 hzO ?_ ?_ + · simpa [hb0, cfg.firstParentTwo] using data.hS 1 false + · simpa [hindex, hb3] using data.hQ 0 false + · simpa [hchild] using (data.hobsS 1 false).2.1 + · simpa [hparent, cert.precursor_eq] using (data.hobsQ 0 false).2.1 + · exact data.hcompat _ _ ⟨1, false, Or.inr (Or.inr rfl)⟩ + ⟨0, false, Or.inr (Or.inl rfl)⟩ + · simpa [hindex, hb3] using posO + · rw [hrotation, cforms.2.2.2, hindex] + change TileCentroid (Q 0 false) - TileCentroid (S 1 false) = + -cOff (BandVectors.1 (geometry.birth 0) (geometry.birth 3)) + rw [hb0, hb3] + change TileCentroid (Q 0 false) - TileCentroid (S 1 false) = -cOff X + linear_combination centO - centS1 + · rw [hrotation, sforms.2.2.2, hindex] + change zO - zS1 = -sOff (BandVectors.2 (geometry.birth 0) (geometry.birth 3)) + rw [hb0, hb3] + change zO - zS1 = -sOff D + linear_combination slopeO - slopeS1 + · refine finish (Q 0 false) (Q 1 true) (u 0 false) (u 1 true) + ?_ ?_ ?_ ?_ (data.hextQ 0 false) (data.hextQ 1 true) + ?_ ?_ zO zQ1 hzO hzQ1 ?_ ?_ + · simpa [hb0] using data.hQ 0 false + · simpa [hindex, hb2, cfg.firstParentTwo] using data.hQ 1 true + · simpa [hchild, cert.precursor_eq] using (data.hobsQ 0 false).2.1 + · simpa [hparent] using (data.hobsQ 1 true).2.1 + · exact data.hcompat _ _ ⟨0, false, Or.inr (Or.inl rfl)⟩ + ⟨1, true, Or.inr (Or.inl rfl)⟩ + · simpa [hindex, hb2] using pos2 + · rw [hrotation, cforms.1, hindex] + change TileCentroid (Q 1 true) - TileCentroid (Q 0 false) = + -cOff (BandVectors.1 (geometry.birth 2) (geometry.birth 0)) + rw [hb0, hb2] + change TileCentroid (Q 1 true) - TileCentroid (Q 0 false) = -cOff X + linear_combination centQ1 - centO + · rw [hrotation, sforms.1, hindex] + change zQ1 - zO = -sOff (BandVectors.2 (geometry.birth 2) (geometry.birth 0)) + rw [hb0, hb2] + change zQ1 - zO = -sOff D + linear_combination slopeQ1 - slopeO + · refine finish (Q 0 false) (S 2 false) (u 0 false) (v 2 false) + ?_ ?_ ?_ ?_ (data.hextQ 0 false) (data.hextS 2 false) + ?_ ?_ zO zS2 hzO hzS2 ?_ ?_ + · simpa [hb0] using data.hQ 0 false + · simpa [hindex, hb3, cfg.firstParentThree] using data.hS 2 false + · simpa [hchild, cert.precursor_eq] using (data.hobsQ 0 false).2.1 + · simpa [hparent] using (data.hobsS 2 false).2.1 + · exact data.hcompat _ _ ⟨0, false, Or.inr (Or.inl rfl)⟩ + ⟨2, false, Or.inr (Or.inr rfl)⟩ + · simpa [hindex, hb3] using pos3 + · rw [hrotation, cforms.2.2.1, hindex] + change TileCentroid (S 2 false) - TileCentroid (Q 0 false) = + cOff (BandVectors.1 (geometry.birth 0) (geometry.birth 3)) + rw [hb0, hb3] + change TileCentroid (S 2 false) - TileCentroid (Q 0 false) = cOff Z + linear_combination centS2 - centO + · rw [hrotation, sforms.2.2.1, hindex] + change zS2 - zO = sOff (BandVectors.2 (geometry.birth 0) (geometry.birth 3)) + rw [hb0, hb3] + change zS2 - zO = sOff B + linear_combination slopeS2 - slopeO + · refine finish (Q 0 false) (S 1 false) (u 0 false) (v 1 false) + ?_ ?_ ?_ ?_ (data.hextQ 0 false) (data.hextS 1 false) + ?_ ?_ zO zS1 hzO hzS1 ?_ ?_ + · simpa [hb0] using data.hQ 0 false + · simpa [hindex, hb2, cfg.firstParentTwo] using data.hS 1 false + · simpa [hchild, cert.precursor_eq] using (data.hobsQ 0 false).2.1 + · simpa [hparent] using (data.hobsS 1 false).2.1 + · exact data.hcompat _ _ ⟨0, false, Or.inr (Or.inl rfl)⟩ + ⟨1, false, Or.inr (Or.inr rfl)⟩ + · simpa [hindex, hb2] using pos2 + · rw [hrotation, cforms.2.1, hindex] + change TileCentroid (S 1 false) - TileCentroid (Q 0 false) = + cOff (BandVectors.1 (geometry.birth 2) (geometry.birth 0)) + rw [hb0, hb2] + change TileCentroid (S 1 false) - TileCentroid (Q 0 false) = cOff X + linear_combination centS1 - centO + · rw [hrotation, sforms.2.1, hindex] + change zS1 - zO = sOff (BandVectors.2 (geometry.birth 2) (geometry.birth 0)) + rw [hb0, hb2] + change zS1 - zO = sOff D + linear_combination slopeS1 - slopeO + · refine finish (Q 0 false) (Q 2 true) (u 0 false) (u 2 true) + ?_ ?_ ?_ ?_ (data.hextQ 0 false) (data.hextQ 2 true) + ?_ ?_ zO zQ2 hzO hzQ2 ?_ ?_ + · simpa [hb0] using data.hQ 0 false + · simpa [hindex, hb3, cfg.firstParentThree] using data.hQ 2 true + · simpa [hchild, cert.precursor_eq] using (data.hobsQ 0 false).2.1 + · simpa [hparent] using (data.hobsQ 2 true).2.1 + · exact data.hcompat _ _ ⟨0, false, Or.inr (Or.inl rfl)⟩ + ⟨2, true, Or.inr (Or.inl rfl)⟩ + · simpa [hindex, hb3] using pos3 + · rw [hrotation, cforms.2.2.2, hindex] + change TileCentroid (Q 2 true) - TileCentroid (Q 0 false) = + -cOff (BandVectors.1 (geometry.birth 0) (geometry.birth 3)) + rw [hb0, hb3] + change TileCentroid (Q 2 true) - TileCentroid (Q 0 false) = -cOff Z + linear_combination centQ2 - centO + · rw [hrotation, sforms.2.2.2, hindex] + change zQ2 - zO = -sOff (BandVectors.2 (geometry.birth 0) (geometry.birth 3)) + rw [hb0, hb3] + change zQ2 - zO = -sOff B + linear_combination slopeQ2 - slopeO + +end PositiveCutOdometerConclusion + +theorem BandOrderedGeneralPositiveCutOdometerRows + (q : Fin 4 -> CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C0 : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C0 T) + (h : PartialOdometer) + (P : Fin 3 -> Bool -> ProtoTile) + (r : Fin 3 -> Bool -> PartialOdometer) + (Q S : Fin 3 -> Bool -> ProtoTile) + (u v : Fin 3 -> Bool -> PartialOdometer) + (g : IntegerLatticeFunction) (x : GaussianInt) + (data : BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) + (geometry : PositiveCutCompanionRow cert x) : + FourNeighborLaplacian g x = 1 := by +-- BODY + classical + have pos2 : 0 < (q 2).1 := by linarith [cfg.secondLarge] + have pos3 := PositiveCutOdometerGeometry.pos3 q cfg + have posO := PositiveCutOdometerGeometry.posO q cfg C0 T cert + x geometry (PositiveCutOdometerGeometry.positive_of_nonempty) + have nestedPositive := PositiveCutOdometerGeometry.nestedPositive q cfg pos2 pos3 posO + let I : GaussianInt := ⟨0, 1⟩ + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let sOff (z : GaussianInt) : Real × Real := + ((1 / 2 : Real) * ((z.re : Real) - (z.im : Real)), + (1 / 2 : Real) * ((z.im : Real) + (z.re : Real))) + let W := BandVectors.1 (q 3) (q 2) + let Z := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let X := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let A := BandVectors.2 (q 3) (q 2) + let B := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let D := BandVectors.2 (q 2) (cfg.firstPredecessor 1) + have cadd (a b : GaussianInt) : cOff (a + b) = cOff a + cOff b := by + apply Prod.ext <;> simp [cOff, GaussianRealPoint, Prod.smul_mk] <;> ring + have sadd (a b : GaussianInt) : sOff (a + b) = sOff a + sOff b := by + apply Prod.ext <;> simp [sOff] <;> ring + have sumC := PositiveCutOdometerGeometry.sumC q cfg cadd + (PositiveCutOdometerGeometry.sumV q cfg) + have sumS := PositiveCutOdometerGeometry.sumS q cfg sadd + (PositiveCutOdometerGeometry.sumA q cfg) + have pcent (b : Bool) : TileCentroid (P 0 b) - TileCentroid T = + (if b then (1 : Real) else -1) • cOff W := PositiveCutOdometerGeometry.pcent q cfg C0 T + cert h P r Q S u v g data b + have qcent (j : Fin 3) (b : Bool) : + TileCentroid (Q j b) - TileCentroid (P 0 true) = + (if b then (1 : Real) else -1) • cOff + (BandVectors.1 (cfg.firstPredecessor ((j + 2).succ)) + (cfg.firstPredecessor ((j + 1).succ))) := data.hQcent j b + have scent (j : Fin 3) (b : Bool) : + TileCentroid (S j b) - TileCentroid (P 0 false) = + (if b then (1 : Real) else -1) • cOff + (BandVectors.1 (cfg.firstPredecessor ((j + 2).succ)) + (cfg.firstPredecessor ((j + 1).succ))) := data.hScent j b + have centPp : TileCentroid (P 0 true) - TileCentroid T = cOff W := by + simpa using pcent true + have centPm : TileCentroid (P 0 false) - TileCentroid T = -cOff W := by + simpa using pcent false + have centO := PositiveCutOdometerGeometry.centO + q cfg T P Q qcent centPp + have centQ1 := PositiveCutOdometerGeometry.centQ1 q cfg T P Q sumC qcent centPp + have centQ2 := PositiveCutOdometerGeometry.centQ2 q cfg T P Q sumC qcent centPp + have centS1 := PositiveCutOdometerGeometry.centS1 q cfg T P S sumC scent centPm + have centS2 := PositiveCutOdometerGeometry.centS2 q cfg T P S sumC scent centPm + have pslope : + ∀ (b : Bool), ∃ a c : Real × Real, + PartialOdometerSlope h = some a ∧ + PartialOdometerSlope (r 0 b) = some c ∧ + c - a = (if b then (1 : Real) else -1) • sOff A := PositiveCutOdometerGeometry.pslope q + cfg C0 T cert h P r Q S u v g data + have qslope : + ∀ (j : Fin 3) (b : Bool), ∃ a c : Real × Real, + PartialOdometerSlope (r 0 true) = some a ∧ + PartialOdometerSlope (u j b) = some c ∧ + c - a = (if b then (1 : Real) else -1) • sOff + (BandVectors.2 (cfg.firstPredecessor ((j + 2).succ)) + (cfg.firstPredecessor ((j + 1).succ))) := PositiveCutOdometerGeometry.qslope q cfg + C0 T cert h P r Q S u v g data + nestedPositive + have sslope : + ∀ (j : Fin 3) (b : Bool), ∃ a c : Real × Real, + PartialOdometerSlope (r 0 false) = some a ∧ + PartialOdometerSlope (v j b) = some c ∧ + c - a = (if b then (1 : Real) else -1) • sOff + (BandVectors.2 (cfg.firstPredecessor ((j + 2).succ)) + (cfg.firstPredecessor ((j + 1).succ))) := PositiveCutOdometerGeometry.sslope q cfg + C0 T cert h P r Q S u v g data + nestedPositive + obtain ⟨z, zp, hz, hzp, dzp⟩ := pslope true + obtain ⟨z', zm, hz', hzm, dzm⟩ := pslope false + have align : z' = z := Option.some.inj (hz'.symm.trans hz) + subst z' + obtain ⟨zp', zO, hzp', hzO, dzO⟩ := qslope 0 false + have align : zp' = zp := Option.some.inj (hzp'.symm.trans hzp) + subst zp' + obtain ⟨zp', zQ1, hzp', hzQ1, dzQ1⟩ := qslope 1 true + have align : zp' = zp := Option.some.inj (hzp'.symm.trans hzp) + subst zp' + obtain ⟨zp', zQ2, hzp', hzQ2, dzQ2⟩ := qslope 2 true + have align : zp' = zp := Option.some.inj (hzp'.symm.trans hzp) + subst zp' + obtain ⟨zm', zS1, hzm', hzS1, dzS1⟩ := sslope 1 false + have align : zm' = zm := Option.some.inj (hzm'.symm.trans hzm) + subst zm' + obtain ⟨zm', zS2, hzm', hzS2, dzS2⟩ := sslope 2 false + have align : zm' = zm := Option.some.inj (hzm'.symm.trans hzm) + subst zm' + have slopePp : zp - z = sOff A := by simpa using dzp + have slopePm : zm - z = -sOff A := by simpa using dzm + have slopeO := PositiveCutOdometerGeometry.slopeO q cfg z zp zO dzO slopePp + have slopeQ1 := PositiveCutOdometerGeometry.slopeQ1 q cfg sumS z zp zQ1 + dzQ1 slopePp + have slopeQ2 := PositiveCutOdometerGeometry.slopeQ2 q cfg sumS z zp zQ2 + dzQ2 slopePp + have slopeS1 := PositiveCutOdometerGeometry.slopeS1 q cfg sumS z zm zS1 dzS1 + slopePm + have slopeS2 := PositiveCutOdometerGeometry.slopeS2 q cfg sumS z zm zS2 dzS2 + slopePm + let cTarget (s : Fin 4) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint + (I ^ s.val * + (BandVectors.1 (geometry.birth geometry.parentIndex.succ) (geometry.birth 0) + + BandVectors.1 (geometry.birth 0) (geometry.birth geometry.parentIndex.succ))) + let sTarget (s : Fin 4) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint + ((-I) ^ s.val * + (BandVectors.2 (geometry.birth geometry.parentIndex.succ) (geometry.birth 0) + + BandVectors.2 (geometry.birth 0) (geometry.birth geometry.parentIndex.succ))) + have flip := (VectorRecursionLaws geometry.birth geometry.proper.1).2.2.2.2 + geometry.proper geometry.parentIndex + have cforms := PositiveCutOdometerGeometry.cforms q cfg C0 T cert x geometry flip + have sforms := PositiveCutOdometerGeometry.sforms q cfg C0 T cert x geometry flip + have finish := PositiveCutOdometerGeometry.finish q cfg C0 T cert g x geometry + have positiveCutConclusion := PositiveCutOdometerConclusion.positiveCutConclusion q cfg C0 T + cert h P r Q S u v g x data geometry pos2 pos3 posO sumC sumS centO centQ1 centQ2 centS1 + centS2 z zO hzO zQ1 hzQ1 zQ2 hzQ2 zS1 hzS1 zS2 hzS2 slopeO slopeQ1 slopeQ2 slopeS1 slopeS2 + cforms sforms finish + exact positiveCutConclusion + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean new file mode 100644 index 0000000000..af5b778b71 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean @@ -0,0 +1,976 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.ExceptionalModifiedABPath +public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.P3161T2PathExhaustion +public import LeanPool.ApollonianSuperharmonic.P3161T2PathSubwalk +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: BandOrderedGeneralRawSupport] + +/-! +# BandOrderedGeneralRawSupport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RawSupportGeometry + +private theorem translation_zeroAt149 : + (by + classical + exact + ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by + classical + intro U + have hzero : GaussianTranslation (0 : GaussianInt) = id := by + funext z + simp [GaussianTranslation] + cases U + simp [TileTranslation, hzero, GaussianTranslation] + +private theorem htileAAt155 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + (∀ (U : ProtoTile), TileTranslation U 0 = U) → (cert.modified.tile a = TileCellComplement + (cert.P 0 true) cert.O) ) := by + classical + intro q cfg C₀ T cert a translation_zero + rw [cert.modified_tile] + simp [a, ModifiedSubtileOccurrenceInterpretation, translation_zero] + +private theorem htileC : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + (∀ (U : ProtoTile), TileTranslation U 0 = U) → (cert.modified.tile c = cert.P 1 true) ) + := by + classical + intro q cfg C₀ T cert c translation_zero + rw [cert.modified_tile] + simp [c, ModifiedSubtileOccurrenceInterpretation, translation_zero] + +private theorem hf1At170 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : + cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i + = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = c) → h = f ∨ h = g) + → (f1 = f ∨ f1 = g) ) := by + classical + intro q cfg C₀ T cert a c f1 f g hfaces + apply hfaces + constructor + · exact ⟨0, by simp [f1, a, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + · exact ⟨2, by simp [f1, c, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + +private theorem hf3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : + cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i + = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = c) → h = f ∨ h = g) + → (f3 = f ∨ f3 = g) ) := by + classical + intro q cfg C₀ T cert a c f3 f g hfaces + apply hfaces + constructor + · exact ⟨0, by simp [f3, a, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + · exact ⟨1, by simp [f3, c, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + +private theorem hf13 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + f1 ≠ f3 ) := by + classical + intro q cfg C₀ T cert f1 f3 h + have := congrArg cert.modified_face_equiv h + simp [f1, f3] at this + +private theorem hpair : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (f1 = f ∨ f1 = g) → + ((f3 = f ∨ f3 = g) → ((f1 ≠ f3) → ((f1 = f ∧ f3 = g) ∨ (f1 = g ∧ f3 = f)))) ) := by + classical + intro q cfg C₀ T cert f1 f3 f g hf1 hf3 hf13 + rcases hf1 with h1 | h1 <;> rcases hf3 with h3 | h3 + · exact False.elim (hf13 (h1.trans h3.symm)) + · exact Or.inl ⟨h1, h3⟩ + · exact Or.inr ⟨h1, h3⟩ + · exact False.elim (hf13 (h1.trans h3.symm)) + +private theorem hend : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), + (SimpleGridPathBetween (CommonFootprintEdgeVertices (cert.modified.tile a) + (cert.modified.tile c)) (FootprintEdges (cert.modified.tile a) ∩ FootprintEdges + (cert.modified.tile c)) (cert.modified.rho f) (cert.modified.rho g)) → + (cert.modified.rho f ≠ cert.modified.rho g) ) := by + classical + intro q cfg C₀ T cert a c f g hpath h + rcases hpath with ⟨p, hnd, hlen, hh, ht, _⟩ + have hpne : p ≠ [] := by + intro hp + simp [hp] at hlen + have hh' : p.head hpne = cert.modified.rho f := by + simpa [List.head?_eq_some_head hpne] using hh + have ht' : p.getLast hpne = cert.modified.rho g := by + simpa [List.getLast?_eq_some_getLast hpne] using ht + obtain ⟨z, hz⟩ := (List.Nodup.head_eq_getLast_iff hpne hnd).mp + (hh'.trans (h.trans ht'.symm)) + simp [hz] at hlen + +private theorem hz13 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let z1 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let z3 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), ((f1 = f ∧ f3 = g) ∨ + (f1 = g ∧ f3 = f)) → ((cert.modified.rho f1 = z1) → ((cert.modified.rho f3 = z3) → + ((cert.modified.rho f ≠ cert.modified.rho g) → (z1 ≠ z3)))) ) := by + classical + intro q cfg C₀ T cert f1 f3 z1 z3 f g hpair hrho1 hrho3 hend + rw [← hrho1, ← hrho3] + rcases hpair with ⟨h1, h3⟩ | ⟨h1, h3⟩ + · simpa [h1, h3] using hend + · simpa [h1, h3] using hend.symm + +private theorem hcomplete : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let z1 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let z3 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + (cert.modified.tile a = TileCellComplement (cert.P 0 true) cert.O) → ((cert.modified.tile + c = cert.P 1 true) → ((FootprintVertices (cert.modified.tile a) ∩ FootprintVertices + (cert.modified.tile c) = CommonFootprintEdgeVertices (cert.modified.tile a) + (cert.modified.tile c)) → (∀ (f : cert.modified.plane.Face), ∀ (g : + cert.modified.plane.Face), (SimpleGridPathBetween (CommonFootprintEdgeVertices + (cert.modified.tile a) (cert.modified.tile c)) (FootprintEdges (cert.modified.tile a) + ∩ FootprintEdges (cert.modified.tile c)) (cert.modified.rho f) (cert.modified.rho g)) + → (((f1 = f ∧ f3 = g) ∨ (f1 = g ∧ f3 = f)) → ((cert.modified.rho f1 = z1) → + ((cert.modified.rho f3 = z3) → (SimpleGridPathBetween (FootprintVertices + (TileCellComplement (cert.P 0 true) cert.O) ∩ FootprintVertices (cert.P 1 true)) + (FootprintEdges (TileCellComplement (cert.P 0 true) cert.O) ∩ FootprintEdges (cert.P + 1 true)) z1 z3 ∨ SimpleGridPathBetween (FootprintVertices (TileCellComplement (cert.P + 0 true) cert.O) ∩ FootprintVertices (cert.P 1 true)) (FootprintEdges + (TileCellComplement (cert.P 0 true) cert.O) ∩ FootprintEdges (cert.P 1 true)) z3 + z1))))))) ) := by + classical + intro q cfg C₀ T cert a c f1 f3 z1 z3 htileA htileC hraw f g hpath hpair hrho1 hrho3 + rw [← hraw, htileA, htileC] at hpath + rcases hpair with ⟨h1, h3⟩ | ⟨h1, h3⟩ + · left + simpa [← h1, ← h3, hrho1, hrho3] using hpath + · right + simpa [← h3, ← h1, hrho1, hrho3] using hpath + +private theorem hz1C : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let z1 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + (cert.modified.tile c = cert.P 1 true) → ((cert.modified.rho f1 = z1) → (z1 ∈ + FootprintVertices (cert.P 1 true))) ) := by + classical + intro q cfg C₀ T cert c f1 z1 htileC hrho1 + have hface : cert.modified.plane.faceVertex f1 2 = c := by + simp [f1, c, cert.modified_face_vertices, SixSubtileFaceVertices] + have h := cert.modified.rho_common f1 2 + simpa [hface, htileC, hrho1] using h + +private theorem hQne : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let z1 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let z3 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + (z1 ≠ z3) → ((z1 ∈ FootprintVertices (cert.Q 1 true)) → ((z3 ∈ FootprintVertices (cert.Q + 1 true)) → ((cert.Q 1 true).cells.Nonempty))) ) := by + classical + intro q cfg C₀ T cert z1 z3 hz13 hz1Q hz3Q + by_contra hQempty + have h1 : z1 = (cert.Q 1 true).anchor := by + simpa [FootprintVertices, hQempty] using hz1Q + have h3 : z3 = (cert.Q 1 true).anchor := by + simpa [FootprintVertices, hQempty] using hz3Q + exact hz13 (h1.trans h3.symm) + +private theorem hQC : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ((cert.Q 1 true).cells.Nonempty) → (((cert.P 1 true).cells.Nonempty) → + (Disjoint (cert.Q 1 true).cells (cert.P 1 true).cells ∧ SimpleGridPath + (BoundaryFootprintVertices (cert.Q 1 true) ∩ BoundaryFootprintVertices (cert.P 1 + true)) (BoundaryFootprintEdges (cert.Q 1 true) ∩ BoundaryFootprintEdges (cert.P 1 + true)))) ) := by + classical + intro q cfg C₀ T cert hQne hCne + rcases cert.double_third.1 with h | h | h + · exact ⟨h.2.2.1, h.2.2.2⟩ + · rw [h.1] at hQne + simp at hQne + · rw [h.1] at hCne + simp at hCne + +private theorem raw_incident : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (U.cells.Nonempty) → ((z ∈ FootprintVertices U) → + (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ U.cells)) ) := by + classical + intro U z hne hz + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hz + rcases hz with ⟨cell, hc, h | h | h | h⟩ + · refine ⟨0, ?_⟩ + simpa [LatticeVertexIncidentCell] using h ▸ hc + · refine ⟨1, ?_⟩ + subst z + simpa [LatticeVertexIncidentCell] using hc + · refine ⟨3, ?_⟩ + subst z + simpa [LatticeVertexIncidentCell] using hc + · refine ⟨2, ?_⟩ + change z - 1 - ⟨0, 1⟩ ∈ U.cells + rw [h] + convert hc using 1; ext <;> simp + +private theorem raw_boundary : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ((cert.Q 1 true).cells.Nonempty) → (((cert.P 1 true).cells.Nonempty) → + ((Disjoint (cert.Q 1 true).cells (cert.P 1 true).cells ∧ SimpleGridPath + (BoundaryFootprintVertices (cert.Q 1 true) ∩ BoundaryFootprintVertices (cert.P 1 + true)) (BoundaryFootprintEdges (cert.Q 1 true) ∩ BoundaryFootprintEdges (cert.P 1 + true))) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), (U.cells.Nonempty) → ((z ∈ + FootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ U.cells))) → (∀ + (z : GaussianInt), (z ∈ FootprintVertices (cert.Q 1 true)) → ((z ∈ FootprintVertices + (cert.P 1 true)) → (z ∈ BoundaryFootprintVertices (cert.Q 1 true) ∩ + BoundaryFootprintVertices (cert.P 1 true))))))) ) := by + classical + intro q cfg C₀ T cert hQne hCne hQC raw_incident z hQ hC + obtain ⟨jQ, hjQ⟩ := raw_incident _ z hQne hQ + obtain ⟨jC, hjC⟩ := raw_incident _ z hCne hC + constructor + · exact P3161T2IncidentBoundary _ z ⟨jQ, hjQ⟩ + ⟨jC, fun h => Finset.disjoint_left.mp hQC.1 h hjC⟩ + · exact P3161T2IncidentBoundary _ z ⟨jC, hjC⟩ + ⟨jQ, fun h => Finset.disjoint_left.mp hQC.1 hjQ h⟩ + +private theorem boundary_edge_footprint : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges U) → (e ∈ + FootprintEdges U) ) := by + classical + intro U e he + let I : GaussianInt := ⟨0, 1⟩ + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [I, Zsqrtd.ext_iff] + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + +private theorem hQO : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ((cert.Q 1 true).cells.Nonempty) → (Disjoint (cert.Q 1 true).cells + cert.O.cells) ) := by + classical + intro q cfg C₀ T cert hQne + rcases cert.precursor_first.2.2.1 with h | h | h + · exact h.2.2.1.symm + · simp [h.1] + · rw [h.1] at hQne + simp at hQne + +private theorem hsupportEdges : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (w : List GaussianInt), (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l : + List GaussianInt), ∀ (r : List GaussianInt), w = l ++ a :: b :: r → {a, b} ∈ + BoundaryFootprintEdges (cert.Q (1 : Fin (3 : ℕ)) true) ∩ BoundaryFootprintEdges + (cert.P (1 : Fin (3 : ℕ)) true)) → ((∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), + (e ∈ BoundaryFootprintEdges U) → (e ∈ FootprintEdges U)) → ((Disjoint (cert.Q 1 + true).cells cert.O.cells) → (∀ x y : GaussianInt, ∀ l r : List GaussianInt, w = l ++ + x :: y :: r → {x, y} ∈ FootprintEdges (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintEdges (cert.P 1 true)))) ) := by + classical + intro q cfg C₀ T cert w hwedges boundary_edge_footprint hQO x y l r h + have he := hwedges x y l r h + rcases boundary_edge_footprint _ _ he.1 with ⟨cell, hc, hshape⟩ + refine ⟨⟨cell, ?_, hshape⟩, boundary_edge_footprint _ _ he.2⟩ + exact Finset.mem_sdiff.mpr + ⟨(cert.plus_union cell).mpr ⟨1, true, hc⟩, + fun ho => Finset.disjoint_left.mp hQO hc ho⟩ + +private theorem hexhaustAt317 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let z1 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let z3 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + (SimpleGridPathBetween (FootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintVertices (cert.P 1 true)) (FootprintEdges (TileCellComplement (cert.P 0 + true) cert.O) ∩ FootprintEdges (cert.P 1 true)) z1 z3 ∨ SimpleGridPathBetween + (FootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∩ FootprintVertices + (cert.P 1 true)) (FootprintEdges (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintEdges (cert.P 1 true)) z3 z1) → (∀ (w : List GaussianInt), (w.head? = some + z1) → ((w.getLast? = some z3) → ((∀ x y : GaussianInt, ∀ l r : List GaussianInt, w = + l ++ x :: y :: r → {x, y} ∈ FootprintEdges (TileCellComplement (cert.P 0 true) + cert.O) ∩ FootprintEdges (cert.P 1 true)) → (∀ z ∈ FootprintVertices + (TileCellComplement (cert.P 0 true) cert.O) ∩ FootprintVertices (cert.P 1 true), z ∈ + w)))) ) := by + classical + intro q cfg C₀ T cert z1 z3 hcomplete w hwhead hwlast hsupportEdges + rcases hcomplete with hcomplete | hcomplete + · exact P3161T2PathExhaustion hcomplete w hwhead hwlast hsupportEdges + · have hrevEdges : ∀ x y : GaussianInt, ∀ l r : List GaussianInt, + w.reverse = l ++ x :: y :: r → + {x, y} ∈ FootprintEdges (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintEdges (cert.P 1 true) := by + intro x y l r h + have h' := congrArg List.reverse h + simp only [List.reverse_reverse, List.reverse_append, List.reverse_cons, + List.append_assoc] at h' + have he := hsupportEdges y x r.reverse l.reverse (by simpa using h') + simpa [Finset.pair_comm] using he + have hex := P3161T2PathExhaustion hcomplete w.reverse + (by simpa using hwlast) (by simpa using hwhead) hrevEdges + intro z hz + exact List.mem_reverse.mp (hex z hz) + +private theorem hOA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), cert.O.cells ⊆ (cert.P 0 true).cells ) := by + classical + intro q cfg C₀ T cert cell hc + apply (cert.plus_union cell).mpr + rw [cert.precursor_eq] at hc + exact ⟨0, false, hc⟩ + +private theorem hOB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), cert.O.cells ⊆ (cert.P 0 false).cells ) := by + classical + intro q cfg C₀ T cert cell hc + apply (cert.minus_union cell).mpr + rw [cert.precursor_cells] at hc + exact ⟨0, true, hc⟩ + +private theorem hCA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + (∀ (U : ProtoTile), TileTranslation U 0 = U) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : + PeriodicSubtileIndex), a ≠ b → ¬((a.label = SixSubtileLabel.A ∧ b.label = + SixSubtileLabel.B ∨ a.label = SixSubtileLabel.B ∧ b.label = SixSubtileLabel.A) ∧ + a.first = b.first ∧ a.second = b.second) → Disjoint (SubtileOccurrenceInterpretation + cert.P cert.u cert.v a).cells (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b).cells) → (Disjoint (cert.P 1 true).cells (cert.P 0 true).cells)) ) := by + classical + intro q cfg C₀ T cert translation_zero hsep + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + simpa [c, a, SubtileOccurrenceInterpretation, translation_zero] using + hsep c a (by decide) (by simp [c, a]) + +private theorem hCB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + (∀ (U : ProtoTile), TileTranslation U 0 = U) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : + PeriodicSubtileIndex), a ≠ b → ¬((a.label = SixSubtileLabel.A ∧ b.label = + SixSubtileLabel.B ∨ a.label = SixSubtileLabel.B ∧ b.label = SixSubtileLabel.A) ∧ + a.first = b.first ∧ a.second = b.second) → Disjoint (SubtileOccurrenceInterpretation + cert.P cert.u cert.v a).cells (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b).cells) → (Disjoint (cert.P 1 true).cells (cert.P 0 false).cells)) ) := by + classical + intro q cfg C₀ T cert translation_zero hsep + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + simpa [c, b, SubtileOccurrenceInterpretation, translation_zero] using + hsep c b (by decide) (by simp [c, b]) + +private theorem hisolated : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (U : ProtoTile), TileTranslation U 0 = U) → (∀ z ∈ + CellSupportedFootprintVertices cert.O, ∀ cell : GaussianInt, z ∈ FootprintVertices + (⟨{cell}, cell⟩ : ProtoTile) → cell ∈ (cert.P 0 true).cells ∨ cell ∈ (cert.P 0 + false).cells) ) := by + classical + intro q cfg C₀ T cert translation_zero z hz cell hc + have hzraw : z ∈ FootprintVertices cert.O := by + rcases hz with ⟨cell, hc, hcorner⟩ + simpa only [FootprintVertices, ite_eq_left (show cert.O.cells.Nonempty from ⟨cell, hc⟩), + Set.mem_ofPred_eq] using + (show ∃ cell ∈ cert.O.cells, + z = cell ∨ z = cell + 1 ∨ z = cell + ⟨0, 1⟩ ∨ + z = cell + 1 + ⟨0, 1⟩ from ⟨cell, hc, hcorner⟩) + simpa [SubtileOccurrenceInterpretation, translation_zero] using + cert.precursor_isolated 0 0 z (by simpa [translation_zero] using hzraw) cell hc + +private theorem hzmodified : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (FootprintVertices (TileCellComplement (cert.P (0 : Fin (3 : ℕ)) true) cert.O) + ∩ FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true) = FootprintVertices (cert.P (0 : + Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true)) → (∀ (z : + GaussianInt), (z ∈ FootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) ∩ + FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true)) → (z ∈ FootprintVertices + (TileCellComplement (cert.P 0 true) cert.O) ∩ FootprintVertices (cert.P 1 true))) ) + := by + classical + intro q cfg C₀ T cert hretain z hz + rw [hretain] + exact hz + +private theorem translation_zeroAt397 : + (by + classical + exact + ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by + classical + intro U + have hzero : GaussianTranslation (0 : GaussianInt) = id := by + funext z + simp [GaussianTranslation] + cases U + simp [TileTranslation, hzero, GaussianTranslation] + +private theorem htileAAt403 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + (∀ (U : ProtoTile), TileTranslation U 0 = U) → (cert.modified.tile a = TileCellComplement + (cert.P 0 true) cert.O) ) := by + classical + intro q cfg C₀ T cert a translation_zero + rw [cert.modified_tile] + simp [a, ModifiedSubtileOccurrenceInterpretation, translation_zero] + +private theorem htileB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + (∀ (U : ProtoTile), TileTranslation U 0 = U) → (cert.modified.tile b = cert.P 0 false) ) + := by + classical + intro q cfg C₀ T cert b translation_zero + rw [cert.modified_tile] + simp [b, ModifiedSubtileOccurrenceInterpretation, translation_zero] + +private theorem hf1At418 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : + cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i + = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = b) → h = f ∨ h = g) + → (f1 = f ∨ f1 = g) ) := by + classical + intro q cfg C₀ T cert a b f1 f g hfaces + apply hfaces + constructor + · exact ⟨0, by simp [f1, a, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + · exact ⟨1, by simp [f1, b, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + +private theorem hf2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : + cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i + = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = b) → h = f ∨ h = g) + → (f2 = f ∨ f2 = g) ) := by + classical + intro q cfg C₀ T cert a b f2 f g hfaces + apply hfaces + constructor + · exact ⟨0, by simp [f2, a, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + · exact ⟨1, by simp [f2, b, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + +private theorem hf12 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + f1 ≠ f2 ) := by + classical + intro q cfg C₀ T cert f1 f2 h + have := congrArg cert.modified_face_equiv h + simp [f1, f2] at this + +private theorem hexhaustAt438 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + (cert.modified.tile a = TileCellComplement (cert.P 0 true) cert.O) → ((cert.modified.tile + b = cert.P 0 false) → (∀ (f : cert.modified.plane.Face), ∀ (g : + cert.modified.plane.Face), (SimpleGridPathBetween (CommonFootprintEdgeVertices + (cert.modified.tile a) (cert.modified.tile b)) (FootprintEdges (cert.modified.tile a) + ∩ FootprintEdges (cert.modified.tile b)) (cert.modified.rho f) (cert.modified.rho g)) + → ((f1 = f ∨ f1 = g) → ((f2 = f ∨ f2 = g) → ((f1 ≠ f2) → ((cert.modified.rho f1 = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) → + ((cert.modified.rho f2 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm + ⟨.I2, 0, 0⟩)) → (∀ z ∈ CommonFootprintEdgeVertices (cert.modified.tile a) + (cert.modified.tile b), z ∈ cert.connector)))))))) ) := by + classical + intro q cfg C₀ T cert a b f1 f2 htileA htileB f g hpath hf1 hf2 hf12 hrho1 hrho2 + rcases hf1 with hf1 | hf1 <;> rcases hf2 with hf2 | hf2 + · exact False.elim (hf12 (hf1.trans hf2.symm)) + · rw [← hf1, ← hf2, hrho1, hrho2, htileA, htileB] at hpath + simpa [htileA, htileB] using P3161T2PathExhaustion hpath cert.connector + cert.connector_head cert.connector_last cert.connector_edges + · rw [← hf2, ← hf1, hrho2, hrho1, htileA, htileB] at hpath + have hrevEdges : ∀ x y : GaussianInt, ∀ l r : List GaussianInt, + cert.connector.reverse = l ++ x :: y :: r → + {x, y} ∈ FootprintEdges (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintEdges (cert.P 0 false) := by + intro x y l r h + have h' := congrArg List.reverse h + simp only [List.reverse_reverse, List.reverse_append, List.reverse_cons, + List.append_assoc] at h' + have he := cert.connector_edges y x r.reverse l.reverse (by simpa using h') + simpa [Finset.pair_comm] using he + have hex := P3161T2PathExhaustion hpath cert.connector.reverse + (by simpa using cert.connector_last) + (by simpa using cert.connector_head) hrevEdges + intro z hz + apply List.mem_reverse.mp + apply hex + simpa [htileA, htileB] using hz + · exact False.elim (hf12 (hf1.trans hf2.symm)) + +private theorem hmodifiedSupport : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + (cert.modified.tile a = TileCellComplement (cert.P 0 true) cert.O) → ((cert.modified.tile + b = cert.P 0 false) → ((FootprintVertices (cert.modified.tile a) ∩ FootprintVertices + (cert.modified.tile b) = CommonFootprintEdgeVertices (cert.modified.tile a) + (cert.modified.tile b)) → ((∀ z ∈ CommonFootprintEdgeVertices (cert.modified.tile a) + (cert.modified.tile b), z ∈ cert.connector) → (FootprintVertices (TileCellComplement + (cert.P 0 true) cert.O) ∩ FootprintVertices (cert.P 0 false) ⊆ (FootprintVertices + (cert.Q 1 true) ∩ FootprintVertices (cert.S 2 false)) ∪ FootprintVertices cert.O ∪ + (FootprintVertices (cert.Q 2 true) ∩ FootprintVertices (cert.S 1 false)))))) ) := by + classical + intro q cfg C₀ T cert a b htileA htileB hraw hexhaust z hz + apply cert.connector_support z + apply hexhaust z + rw [← hraw, htileA, htileB] + exact hz + +private theorem hAne : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (cert.P 0 true).cells.Nonempty ) := by + classical + intro q cfg C₀ T cert + have hgrid := LatticeTileGridStructure _ (cert.parent_lattice 0 true) + exact hgrid.1.1 + +private theorem hdeletedNeAt478 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (TileCellComplement (cert.P 0 true) cert.O).cells.Nonempty ) := by + classical + intro q cfg C₀ T cert + have hgrid := LatticeTileGridStructure _ (cert.precursor_complement_lattice.1) + exact hgrid.1.1 + +private theorem hxO : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (z : GaussianInt), (z ∉ FootprintVertices cert.O) → (∀ (x : LatticeCell), (z + = x ∨ z = x + (1 : GaussianInt) ∨ z = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ z = x + + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → (x ∉ cert.O.cells)) ) := by + classical + intro q cfg C₀ T cert z hzO x hcorner hxO + have hOne : cert.O.cells.Nonempty := ⟨x, hxO⟩ + apply hzO + simpa only [FootprintVertices, ite_eq_left hOne, Set.mem_ofPred_eq] using + (show ∃ x ∈ cert.O.cells, + z = x ∨ z = x + 1 ∨ z = x + ⟨0, 1⟩ ∨ + z = x + 1 + ⟨0, 1⟩ from ⟨x, hxO, hcorner⟩) + +end RawSupportGeometry + +theorem BandOrderedGeneralRawSupport + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + FootprintVertices (cert.P 0 true) ∩ + FootprintVertices (cert.P 1 true) ⊆ + FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.P 1 true) ∧ + FootprintVertices (cert.P 0 true) ∩ + FootprintVertices (cert.P 0 false) ⊆ + (FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.S 2 false)) ∪ + FootprintVertices (cert.Q 0 false) ∪ + (FootprintVertices (cert.Q 2 true) ∩ + FootprintVertices (cert.S 1 false)) := by +-- BODY + classical + constructor + · let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let z1 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let z3 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + have translation_zero (U : ProtoTile) : TileTranslation U 0 = U := + RawSupportGeometry.translation_zeroAt149 U + have htileA : cert.modified.tile a = + TileCellComplement (cert.P 0 true) cert.O := RawSupportGeometry.htileAAt155 q cfg C₀ T + cert translation_zero + have htileC : cert.modified.tile c = cert.P 1 true := RawSupportGeometry.htileC q cfg C₀ T + cert translation_zero + have hac : a ≠ c := by decide + have hadj : cert.modified.plane.adjacent a c := + (cert.modified_adjacency a c).mpr (.AC 0 0) + have hcommon := cert.modified.adjacent_has_common_edge a c hadj + obtain ⟨hclass, hregular⟩ := PeriodicTileIntersectionClassification cert.modified + have hraw := ((hclass a c hac).2.1 hcommon).2 + obtain ⟨_, f, g, hfg, hf, hg, hfaces, hpath⟩ := + (PeriodicTileIntersectionPaths cert.modified hregular a c hac).1.mpr hcommon + have hf1 : f1 = f ∨ f1 = g := RawSupportGeometry.hf1At170 q cfg C₀ T cert f g hfaces + have hf3 : f3 = f ∨ f3 = g := RawSupportGeometry.hf3 q cfg C₀ T cert f g hfaces + have hf13 : f1 ≠ f3 := RawSupportGeometry.hf13 q cfg C₀ T cert + have hpair : (f1 = f ∧ f3 = g) ∨ (f1 = g ∧ f3 = f) := RawSupportGeometry.hpair q cfg C₀ T + cert f g hf1 hf3 hf13 + have hrho1 : cert.modified.rho f1 = z1 := cert.modified_face_points _ + have hrho3 : cert.modified.rho f3 = z3 := cert.modified_face_points _ + have hend : cert.modified.rho f ≠ cert.modified.rho g := RawSupportGeometry.hend q cfg C₀ T + cert f g hpath + have hz13 : z1 ≠ z3 := RawSupportGeometry.hz13 q cfg C₀ T cert f g hpair hrho1 hrho3 hend + have hcomplete : + SimpleGridPathBetween + (FootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintVertices (cert.P 1 true)) + (FootprintEdges (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintEdges (cert.P 1 true)) z1 z3 ∨ + SimpleGridPathBetween + (FootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintVertices (cert.P 1 true)) + (FootprintEdges (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintEdges (cert.P 1 true)) z3 z1 := RawSupportGeometry.hcomplete q cfg C₀ T cert + htileA htileC hraw f g hpath hpair hrho1 hrho3 + have hz1Q : z1 ∈ FootprintVertices (cert.Q 1 true) := cert.inner_first.1 + have hz3Q : z3 ∈ FootprintVertices (cert.Q 1 true) := cert.inner_third.1 + have hz3C : z3 ∈ FootprintVertices (cert.P 1 true) := cert.inner_third.2 + have hz1C : z1 ∈ FootprintVertices (cert.P 1 true) := RawSupportGeometry.hz1C q cfg C₀ T cert + htileC hrho1 + have hQne : (cert.Q 1 true).cells.Nonempty := RawSupportGeometry.hQne q cfg C₀ T cert hz13 + hz1Q hz3Q + have hCne : (cert.P 1 true).cells.Nonempty := + (LatticeTileGridStructure _ (cert.parent_lattice 1 true)).1.1 + have hQC : Disjoint (cert.Q 1 true).cells (cert.P 1 true).cells ∧ + SimpleGridPath + (BoundaryFootprintVertices (cert.Q 1 true) ∩ + BoundaryFootprintVertices (cert.P 1 true)) + (BoundaryFootprintEdges (cert.Q 1 true) ∩ + BoundaryFootprintEdges (cert.P 1 true)) := RawSupportGeometry.hQC q cfg C₀ T cert + hQne hCne + have raw_incident (U : ProtoTile) (z : GaussianInt) + (hne : U.cells.Nonempty) (hz : z ∈ FootprintVertices U) : + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ U.cells := RawSupportGeometry.raw_incident U + z hne hz + have raw_boundary (z : GaussianInt) + (hQ : z ∈ FootprintVertices (cert.Q 1 true)) + (hC : z ∈ FootprintVertices (cert.P 1 true)) : + z ∈ BoundaryFootprintVertices (cert.Q 1 true) ∩ + BoundaryFootprintVertices (cert.P 1 true) := RawSupportGeometry.raw_boundary q cfg C₀ T + cert hQne hCne hQC raw_incident z hQ hC + obtain ⟨w, hwhead, hwlast, hwvertices, hwedges⟩ := + P3161T2PathSubwalk hQC.2 z1 z3 + (raw_boundary z1 hz1Q hz1C) (raw_boundary z3 hz3Q hz3C) + have boundary_edge_footprint (U : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges U) : e ∈ FootprintEdges U := + RawSupportGeometry.boundary_edge_footprint U e he + have hQO : Disjoint (cert.Q 1 true).cells cert.O.cells := RawSupportGeometry.hQO q cfg C₀ T + cert hQne + have hsupportEdges : ∀ x y : GaussianInt, ∀ l r : List GaussianInt, + w = l ++ x :: y :: r → + {x, y} ∈ FootprintEdges (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintEdges (cert.P 1 true) := RawSupportGeometry.hsupportEdges q cfg C₀ T cert w + hwedges boundary_edge_footprint hQO + have hexhaust : ∀ z ∈ FootprintVertices + (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintVertices (cert.P 1 true), z ∈ w := RawSupportGeometry.hexhaustAt317 q cfg C₀ T + cert hcomplete w hwhead hwlast hsupportEdges + have hOA : cert.O.cells ⊆ (cert.P 0 true).cells := RawSupportGeometry.hOA q cfg C₀ T cert + have hOB : cert.O.cells ⊆ (cert.P 0 false).cells := RawSupportGeometry.hOB q cfg C₀ T cert + have hsep := (BandOriginalPairSeparation cert.P cert.O cert.u cert.v + hOA hOB cert.partition).2 + have hCA : Disjoint (cert.P 1 true).cells (cert.P 0 true).cells := RawSupportGeometry.hCA q + cfg C₀ T cert translation_zero hsep + have hCB : Disjoint (cert.P 1 true).cells (cert.P 0 false).cells := RawSupportGeometry.hCB q + cfg C₀ T cert translation_zero hsep + have hisolated : ∀ z ∈ CellSupportedFootprintVertices cert.O, + ∀ cell : GaussianInt, z ∈ FootprintVertices (⟨{cell}, cell⟩ : ProtoTile) → + cell ∈ (cert.P 0 true).cells ∨ cell ∈ (cert.P 0 false).cells := + RawSupportGeometry.hisolated q cfg C₀ T cert translation_zero + have hdeletedNe : (TileCellComplement (cert.P 0 true) cert.O).cells.Nonempty := + (LatticeTileGridStructure _ cert.precursor_complement_lattice.1).1.1 + have hretain := (FootprintDeletionRetention (cert.P 0 true) (cert.P 0 false) + cert.O (cert.P 1 true) hOA hisolated hCA hCB).2.2 + (Or.inr ⟨hdeletedNe, hCne⟩) + intro z hz + have hzmodified : z ∈ FootprintVertices + (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintVertices (cert.P 1 true) := RawSupportGeometry.hzmodified q cfg C₀ T cert + hretain z hz + refine ⟨?_, hz.2⟩ + have hzboundary := (hwvertices z (hexhaust z hzmodified)).1 + simp only [BoundaryFootprintVertices, ite_eq_left hQne, Set.mem_ofPred_eq] at hzboundary + rcases hzboundary with ⟨e, he, hze⟩ + rcases boundary_edge_footprint _ _ he with ⟨cell, hc, hshape⟩ + simp only [FootprintVertices, ite_eq_left hQne, Set.mem_ofPred_eq] + refine ⟨cell, hc, ?_⟩ + rcases hshape with rfl | rfl | rfl | rfl <;> + simp only [Finset.mem_insert, Finset.mem_singleton] at hze + · exact hze.elim Or.inl (fun h => Or.inr (Or.inl h)) + · exact hze.elim Or.inl (fun h => Or.inr (Or.inr (Or.inl h))) + · exact hze.elim (fun h => Or.inr (Or.inl h)) + (fun h => Or.inr (Or.inr (Or.inr h))) + · exact hze.elim (fun h => Or.inr (Or.inr (Or.inl h))) + (fun h => Or.inr (Or.inr (Or.inr h))) + · let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + have translation_zero (U : ProtoTile) : TileTranslation U 0 = U := + RawSupportGeometry.translation_zeroAt397 U + have htileA : cert.modified.tile a = + TileCellComplement (cert.P 0 true) cert.O := RawSupportGeometry.htileAAt403 q cfg C₀ T + cert translation_zero + have htileB : cert.modified.tile b = cert.P 0 false := RawSupportGeometry.htileB q cfg C₀ T + cert translation_zero + have hab : a ≠ b := by decide + have hadj : cert.modified.plane.adjacent a b := + (cert.modified_adjacency a b).mpr (.AB 0 0) + have hcommon := cert.modified.adjacent_has_common_edge a b hadj + obtain ⟨hclass, hregular⟩ := PeriodicTileIntersectionClassification cert.modified + have hraw := ((hclass a b hab).2.1 hcommon).2 + obtain ⟨_, f, g, hfg, hf, hg, hfaces, hpath⟩ := + (PeriodicTileIntersectionPaths cert.modified hregular a b hab).1.mpr hcommon + have hf1 : f1 = f ∨ f1 = g := RawSupportGeometry.hf1At418 q cfg C₀ T cert f g hfaces + have hf2 : f2 = f ∨ f2 = g := RawSupportGeometry.hf2 q cfg C₀ T cert f g hfaces + have hf12 : f1 ≠ f2 := RawSupportGeometry.hf12 q cfg C₀ T cert + have hrho1 : cert.modified.rho f1 = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) := + cert.modified_face_points _ + have hrho2 : cert.modified.rho f2 = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) := + cert.modified_face_points _ + have hexhaust : ∀ z ∈ CommonFootprintEdgeVertices + (cert.modified.tile a) (cert.modified.tile b), z ∈ cert.connector := + RawSupportGeometry.hexhaustAt438 q cfg C₀ T cert htileA htileB f g hpath hf1 hf2 hf12 + hrho1 hrho2 + have hmodifiedSupport : + FootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintVertices (cert.P 0 false) ⊆ + (FootprintVertices (cert.Q 1 true) ∩ FootprintVertices (cert.S 2 false)) ∪ + FootprintVertices cert.O ∪ + (FootprintVertices (cert.Q 2 true) ∩ FootprintVertices (cert.S 1 false)) := + RawSupportGeometry.hmodifiedSupport q cfg C₀ T cert htileA htileB hraw hexhaust + have hAne : (cert.P 0 true).cells.Nonempty := RawSupportGeometry.hAne q cfg C₀ T cert + have hdeletedNe : (TileCellComplement (cert.P 0 true) cert.O).cells.Nonempty := + RawSupportGeometry.hdeletedNeAt478 q cfg C₀ T cert + intro z hz + rw [← cert.precursor_eq] + by_cases hzO : z ∈ FootprintVertices cert.O + · exact Or.inl (Or.inr hzO) + · apply hmodifiedSupport + refine ⟨?_, hz.2⟩ + rcases (show ∃ x ∈ (cert.P 0 true).cells, + z = x ∨ z = x + 1 ∨ z = x + ⟨0, 1⟩ ∨ + z = x + 1 + ⟨0, 1⟩ from by + simpa only [FootprintVertices, ite_eq_left hAne, Set.mem_ofPred_eq] using hz.1) + with ⟨x, hx, hcorner⟩ + have hxO : x ∉ cert.O.cells := RawSupportGeometry.hxO q cfg C₀ T cert z hzO x hcorner + simpa only [FootprintVertices, ite_eq_left hdeletedNe, Set.mem_ofPred_eq] using + (show ∃ x ∈ (TileCellComplement (cert.P 0 true) cert.O).cells, + z = x ∨ z = x + 1 ∨ z = x + ⟨0, 1⟩ ∨ + z = x + 1 + ⟨0, 1⟩ from + ⟨x, Finset.mem_sdiff.mpr ⟨hx, hxO⟩, hcorner⟩) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificate.lean new file mode 100644 index 0000000000..9dcf9bb9fd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificate.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizationCertificate +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: BandOrderedGeneralRightInterfaceCertificate] + +/-! +# BandOrderedGeneralRightInterfaceCertificate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Given a `BandOrderedGeneralRightNormalizationCertificate`, a right +interface certificate consists of two companion prototiles and two +literal `ExactTileInterfaceTriple` records on the same transformed +root--fixed pair. Both outer supports and both companions are lattice tiles; +the four tile cell sets have all disjointness relations needed by the endpoint +theorem; and each endpoint record is accompanied by its literal touching +triple. The two records have crossed distinguished endpoints, so the first +record's $AB$ path is the single oriented complete interface path used later; +the normalized point is retained as a vertex of its common root--fixed +footprint. +-/ +structure BandOrderedGeneralRightInterfaceCertificate + {C : BandCircle} {T N : ProtoTile} {h k : PartialOdometer} + {x : GaussianInt} + (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x) where +-- BODY + /-- The literal third tile at the initial endpoint of the root-fixed interface. -/ + startCompanion : ProtoTile + /-- The literal third tile at the terminal endpoint of that same interface. -/ + endCompanion : ProtoTile + /-- The complete interface triple with its distinguished initial endpoint. -/ + startData : ExactTileInterfaceTriple normalization.normalizedRoot + normalization.normalizedFixed startCompanion + /-- The complete interface triple with the two root-fixed endpoints exchanged. -/ + endData : ExactTileInterfaceTriple normalization.normalizedRoot + normalization.normalizedFixed endCompanion + normalized_point_on_start_path : normalization.normalizedPoint ∈ + FootprintVertices normalization.normalizedRoot ∩ + FootprintVertices normalization.normalizedFixed + interface_endpoints : + endData.point = startData.otherAB ∧ endData.otherAB = startData.point + root_lattice : LatticeTile normalization.normalizedRoot + fixed_lattice : LatticeTile normalization.normalizedFixed + start_lattice : LatticeTile startCompanion + end_lattice : LatticeTile endCompanion + root_fixed_disjoint : + Disjoint normalization.normalizedRoot.cells normalization.normalizedFixed.cells + root_start_disjoint : + Disjoint normalization.normalizedRoot.cells startCompanion.cells + fixed_start_disjoint : + Disjoint normalization.normalizedFixed.cells startCompanion.cells + root_end_disjoint : + Disjoint normalization.normalizedRoot.cells endCompanion.cells + fixed_end_disjoint : + Disjoint normalization.normalizedFixed.cells endCompanion.cells + start_end_disjoint : Disjoint startCompanion.cells endCompanion.cells + start_touching : TouchingTriple normalization.normalizedRoot + normalization.normalizedFixed startCompanion + end_touching : TouchingTriple normalization.normalizedRoot + normalization.normalizedFixed endCompanion + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean new file mode 100644 index 0000000000..90c6652bc6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean @@ -0,0 +1,1257 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightInterfaceCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizationCertificate +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceDisjointCompanionEndpoints +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricExactInterfaceTransport +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileT3TranslateTouching +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandOrderedGeneralRightInterfaceCertificateExists] + +/-! +# BandOrderedGeneralRightInterfaceCertificateExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RightInterfaceCertificateGeometry + +private theorem tileTouchingRetarget : + (by + classical + exact + forall (A A' B B' : ProtoTile), A.cells = A'.cells -> (A.cells = ∅ -> A.anchor = + A'.anchor) -> B.cells = B'.cells -> (B.cells = ∅ -> B.anchor = B'.anchor) -> + TileTouching A B -> TileTouching A' B' ) := by + classical + intro A A' B B' hAc hAa hBc hBa ht + have hAo := ProtoTileObservableExtensionality A A' hAc hAa + have hBo := ProtoTileObservableExtensionality B B' hBc hBa + rcases ht with ht | ht | ht + · left + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa [hAc] using ht.1 + · simpa [hBc] using ht.2.1 + · simpa [hAc, hBc] using ht.2.2.1 + · simpa [hAo.2.1, hAo.2.2.1, hBo.2.1, hBo.2.2.1] using ht.2.2.2 + · right; left + refine ⟨?_, ?_⟩ + · simpa [hAc] using ht.1 + · rw [← hAa ht.1, ← hBo.2.1] + exact ht.2 + · right; right + refine ⟨?_, ?_⟩ + · simpa [hBc] using ht.1 + · rw [← hBa ht.1, ← hAo.2.1] + exact ht.2 + +private theorem touchingRetarget : + (by + classical + exact + (forall (A A' B B' : ProtoTile), A.cells = A'.cells -> (A.cells = ∅ -> A.anchor = + A'.anchor) -> B.cells = B'.cells -> (B.cells = ∅ -> B.anchor = B'.anchor) -> + TileTouching A B -> TileTouching A' B') → (forall (A A' B B' D D' : ProtoTile), + A.cells = A'.cells -> (A.cells = ∅ -> A.anchor = A'.anchor) -> B.cells = B'.cells -> + (B.cells = ∅ -> B.anchor = B'.anchor) -> D.cells = D'.cells -> (D.cells = ∅ -> + D.anchor = D'.anchor) -> TouchingTriple A B D -> TouchingTriple A' B' D') ) := by + classical + intro tileTouchingRetarget A A' B B' D D' hAc hAa hBc hBa hDc hDa ht + have hAo := ProtoTileObservableExtensionality A A' hAc hAa + have hBo := ProtoTileObservableExtensionality B B' hBc hBa + have hDo := ProtoTileObservableExtensionality D D' hDc hDa + rcases ht with ⟨hAB, hBD, hDA, p, hp, hpu⟩ + refine ⟨tileTouchingRetarget A A' B B' hAc hAa hBc hBa hAB, + tileTouchingRetarget B B' D D' hBc hBa hDc hDa hBD, + tileTouchingRetarget D D' A A' hDc hDa hAc hAa hDA, p, ?_, ?_⟩ + · simpa [← hAo.2.1, ← hBo.2.1, ← hDo.2.1] using hp + · intro y hy + apply hpu y + simpa [← hAo.2.1, ← hBo.2.1, ← hDo.2.1] using hy + +private theorem hAeAt211 : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (A' : ProtoTile), (A.cells = A'.cells) → (FootprintEdges A = + FootprintEdges A') ) := by + classical + intro A A' hAc + simp only [FootprintEdges] + rw [hAc] + +private theorem quarterTranslate : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (a : GaussianInt), ∀ (u : GaussianInt), TileTranslation + (TileQuarterTurn (TileTranslation A a)) u = TileTranslation (TileTranslation + (TileQuarterTurn A) u) (GaussianQuarterTurn a) ) := by + classical + intro A a u + rcases A with ⟨cells, anchor⟩ + rw [ProtoTile.mk.injEq] + constructor + · ext z + simp only [TileTranslation, TileQuarterTurn, Finset.mem_image, + GaussianTranslation] + constructor + · rintro ⟨y, hy, rfl⟩ + rcases hy with ⟨w, hw, rfl⟩ + rcases hw with ⟨v, hv, rfl⟩ + refine ⟨GaussianQuarterTurn v - 1 + u, ?_, ?_⟩ + · refine ⟨GaussianQuarterTurn v - 1, ?_, rfl⟩ + exact ⟨v, hv, rfl⟩ + · cases a; cases v; cases u + apply Zsqrtd.ext <;> + simp [GaussianQuarterTurn] <;> omega + · rintro ⟨y, hy, rfl⟩ + rcases hy with ⟨w, hw, rfl⟩ + rcases hw with ⟨v, hv, rfl⟩ + refine ⟨GaussianQuarterTurn (GaussianTranslation a v) - 1, ?_, ?_⟩ + · exact ⟨GaussianTranslation a v, ⟨v, hv, rfl⟩, rfl⟩ + · cases a; cases v; cases u + apply Zsqrtd.ext <;> + simp [GaussianQuarterTurn, GaussianTranslation] <;> omega + · ext <;> simp [TileTranslation, TileQuarterTurn, GaussianTranslation, + GaussianQuarterTurn] <;> omega + +private theorem translateObs : + (by + classical + exact + forall (A A' : ProtoTile) (d : GaussianInt), A.cells = A'.cells -> (A.cells = ∅ -> + A.anchor = A'.anchor) -> (TileTranslation A d).cells = (TileTranslation A' d).cells + /\ ((TileTranslation A d).cells = ∅ -> (TileTranslation A d).anchor = + (TileTranslation A' d).anchor) ) := by + classical + intro A A' d hc ha + constructor + · simp [TileTranslation, hc] + · intro he + have hAe : A.cells = ∅ := + (TileTranslationFormulas A d).2.2.1.mp he + simp [TileTranslation, ha hAe] + +private theorem centeredTurnTouching : + (by + classical + exact + (forall (A A' B B' D D' : ProtoTile), A.cells = A'.cells -> (A.cells = ∅ -> A.anchor = + A'.anchor) -> B.cells = B'.cells -> (B.cells = ∅ -> B.anchor = B'.anchor) -> D.cells + = D'.cells -> (D.cells = ∅ -> D.anchor = D'.anchor) -> TouchingTriple A B D -> + TouchingTriple A' B' D') → ((∀ (A : ProtoTile), ∀ (a : GaussianInt), ∀ (u : + GaussianInt), TileTranslation (TileQuarterTurn (TileTranslation A a)) u = + TileTranslation (TileTranslation (TileQuarterTurn A) u) (GaussianQuarterTurn a)) → + ((forall (A A' : ProtoTile) (d : GaussianInt), A.cells = A'.cells -> (A.cells = ∅ -> + A.anchor = A'.anchor) -> (TileTranslation A d).cells = (TileTranslation A' d).cells + /\ ((TileTranslation A d).cells = ∅ -> (TileTranslation A d).anchor = + (TileTranslation A' d).anchor)) → (forall (A : ProtoTile) (a b : GaussianInt), + QuarterTurnSymmetric A -> TouchingTriple A (TileTranslation A a) (TileTranslation A + b) -> TouchingTriple A (TileTranslation A (GaussianQuarterTurn a)) (TileTranslation A + (GaussianQuarterTurn b))))) ) := by + classical + intro touchingRetarget quarterTranslate translateObs A a b hsym ht + obtain ⟨u, hu, hcell, hanchor, hvert, hcent⟩ := + QuarterTurnSymmetricCenteredTransport A hsym + have hanchor' : (TileTranslation (TileQuarterTurn A) u).cells = ∅ -> + (TileTranslation (TileQuarterTurn A) u).anchor = A.anchor := by + intro he + apply hanchor + rw [← hcell] + exact he + have hq := (TouchingTripleCovariance A (TileTranslation A a) + (TileTranslation A b) u).2.1.mp ht + have hqt := (TouchingTripleCovariance (TileQuarterTurn A) + (TileQuarterTurn (TileTranslation A a)) + (TileQuarterTurn (TileTranslation A b)) u).1.mp hq + rw [quarterTranslate A a u, quarterTranslate A b u] at hqt + have ha := translateObs (TileTranslation (TileQuarterTurn A) u) A + (GaussianQuarterTurn a) hcell hanchor' + have hb := translateObs (TileTranslation (TileQuarterTurn A) u) A + (GaussianQuarterTurn b) hcell hanchor' + exact touchingRetarget + (TileTranslation (TileQuarterTurn A) u) A + (TileTranslation (TileTranslation (TileQuarterTurn A) u) + (GaussianQuarterTurn a)) + (TileTranslation A (GaussianQuarterTurn a)) + (TileTranslation (TileTranslation (TileQuarterTurn A) u) + (GaussianQuarterTurn b)) + (TileTranslation A (GaussianQuarterTurn b)) + hcell hanchor' ha.1 ha.2 hb.1 hb.2 hqt + +private theorem centeredTurnExact : + (by + classical + exact + forall (A : ProtoTile) (a b : GaussianInt), QuarterTurnSymmetric A -> + ExactTileInterfaceTriple A (TileTranslation A a) (TileTranslation A b) -> Nonempty + (ExactTileInterfaceTriple A (TileTranslation A (GaussianQuarterTurn a)) + (TileTranslation A (GaussianQuarterTurn b))) ) := by + classical + intro A a b hsym E + obtain ⟨u, hu, E', hp, hab, hbc, hca⟩ := + QuarterTurnSymmetricExactInterfaceTransport A a b E hsym + exact ⟨E'⟩ + +private theorem thirdTurnExact : + (by + classical + exact + (forall (A : ProtoTile) (a b : GaussianInt), QuarterTurnSymmetric A + -> ExactTileInterfaceTriple A (TileTranslation A a) (TileTranslation A b) -> Nonempty + (ExactTileInterfaceTriple A (TileTranslation A (GaussianQuarterTurn a)) + (TileTranslation A (GaussianQuarterTurn b)))) → forall (A : ProtoTile) (a b : + GaussianInt), QuarterTurnSymmetric A -> ExactTileInterfaceTriple A (TileTranslation A + a) (TileTranslation A b) -> Nonempty (ExactTileInterfaceTriple A (TileTranslation A + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn a)))) (TileTranslation + A (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn b))))) ) := by + classical + intro centeredTurnExact A a b hsym E + obtain ⟨E1⟩ := centeredTurnExact A a b hsym E + obtain ⟨E2⟩ := centeredTurnExact A (GaussianQuarterTurn a) + (GaussianQuarterTurn b) hsym E1 + exact centeredTurnExact A (GaussianQuarterTurn (GaussianQuarterTurn a)) + (GaussianQuarterTurn (GaussianQuarterTurn b)) hsym E2 + +private theorem thirdTurnTouching : + (by + classical + exact + (forall (A : ProtoTile) (a b : GaussianInt), QuarterTurnSymmetric A -> TouchingTriple A + (TileTranslation A a) (TileTranslation A b) -> TouchingTriple A (TileTranslation A + (GaussianQuarterTurn a)) (TileTranslation A (GaussianQuarterTurn b))) → (forall (A : + ProtoTile) (a b : GaussianInt), QuarterTurnSymmetric A -> TouchingTriple A + (TileTranslation A a) (TileTranslation A b) -> TouchingTriple A (TileTranslation A + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn a)))) (TileTranslation + A (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn b))))) ) := by + classical + intro centeredTurnTouching A a b hsym ht + exact centeredTurnTouching A _ _ hsym + (centeredTurnTouching A _ _ hsym + (centeredTurnTouching A a b hsym ht)) + +private theorem turn_flip : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + (∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q j.succ) = (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 + (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ)))) → (∀ (s : Fin 3), GaussianQuarterTurn + (BandVectors.1 (q s.succ) (q 0)) = BandVectors.1 (q 0) (q s.succ)) ) := by + classical + intro C T N h k x normalization q flip s + rw [(flip s).1] + rcases BandVectors.1 (q s.succ) (q 0) with ⟨a, b⟩ + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + +private theorem turn_neg : + (by + classical + exact + ∀ (z : GaussianInt), GaussianQuarterTurn (-z) = -GaussianQuarterTurn z ) := by + classical + intro z + rcases z with ⟨a, b⟩ + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + +private theorem turn_three : + (by + classical + exact + ∀ (z : GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) = + -GaussianQuarterTurn z ) := by + classical + intro z + rcases z with ⟨a, b⟩ + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + +private theorem turn_two : + (by + classical + exact + ∀ (z : GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn z) = -z ) := by + classical + intro z + rcases z with ⟨a, b⟩ + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + +private theorem touch0p : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), (forall (A : ProtoTile) + (a b : GaussianInt), QuarterTurnSymmetric A -> TouchingTriple A (TileTranslation A a) + (TileTranslation A b) -> TouchingTriple A (TileTranslation A (GaussianQuarterTurn a)) + (TileTranslation A (GaussianQuarterTurn b))) → ( + let q := normalization.normalizedPresentation + let F := normalization.normalizedFixed + (TouchingTriple F (TileTranslation F (BandVectors.1 (q (Fin.succ (0 : Fin (3 : ℕ)))) (q + (0 : Fin (4 : ℕ))))) (TileTranslation F (-BandVectors.1 (q ((0 : Fin (3 : ℕ)) + (1 : + Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) → ((∀ (z : GaussianInt), + GaussianQuarterTurn (-z) = -GaussianQuarterTurn z) → ((GaussianQuarterTurn + (BandVectors.1 (q 1) (q 0)) = BandVectors.1 (q 0) (q 1)) → ((GaussianQuarterTurn + (BandVectors.1 (q 2) (q 0)) = BandVectors.1 (q 0) (q 2)) → (TouchingTriple F + (TileTranslation F (BandVectors.1 (q 0) (q 1))) (TileTranslation F (-BandVectors.1 (q + 0) (q 2)))))))) ) := by + classical + intro C T N h k x normalization centeredTurnTouching q F touch0 turn_neg turn0 turn1 + simpa [turn0, turn1, turn_neg] using centeredTurnTouching F _ _ + normalization.fixed_quarter_turn touch0 + +private theorem touch1p : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), (forall (A : ProtoTile) + (a b : GaussianInt), QuarterTurnSymmetric A -> TouchingTriple A (TileTranslation A a) + (TileTranslation A b) -> TouchingTriple A (TileTranslation A (GaussianQuarterTurn a)) + (TileTranslation A (GaussianQuarterTurn b))) → ( + let q := normalization.normalizedPresentation + let F := normalization.normalizedFixed + (TouchingTriple F (TileTranslation F (BandVectors.1 (q (Fin.succ (1 : Fin (3 : ℕ)))) (q + (0 : Fin (4 : ℕ))))) (TileTranslation F (-BandVectors.1 (q ((1 : Fin (3 : ℕ)) + (1 : + Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) → ((∀ (z : GaussianInt), + GaussianQuarterTurn (-z) = -GaussianQuarterTurn z) → ((GaussianQuarterTurn + (BandVectors.1 (q 2) (q 0)) = BandVectors.1 (q 0) (q 2)) → ((GaussianQuarterTurn + (BandVectors.1 (q 3) (q 0)) = BandVectors.1 (q 0) (q 3)) → (TouchingTriple F + (TileTranslation F (BandVectors.1 (q 0) (q 2))) (TileTranslation F (-BandVectors.1 (q + 0) (q 3)))))))) ) := by + classical + intro C T N h k x normalization centeredTurnTouching q F touch1 turn_neg turn1 turn2 + simpa [turn1, turn2, turn_neg] using centeredTurnTouching F _ _ + normalization.fixed_quarter_turn touch1 + +private theorem touch2p : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), (forall (A : ProtoTile) + (a b : GaussianInt), QuarterTurnSymmetric A -> TouchingTriple A (TileTranslation A a) + (TileTranslation A b) -> TouchingTriple A (TileTranslation A (GaussianQuarterTurn a)) + (TileTranslation A (GaussianQuarterTurn b))) → ( + let q := normalization.normalizedPresentation + let F := normalization.normalizedFixed + (TouchingTriple F (TileTranslation F (BandVectors.1 (q (Fin.succ (2 : Fin (3 : ℕ)))) (q + (0 : Fin (4 : ℕ))))) (TileTranslation F (-BandVectors.1 (q ((2 : Fin (3 : ℕ)) + (1 : + Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) → ((∀ (z : GaussianInt), + GaussianQuarterTurn (-z) = -GaussianQuarterTurn z) → ((GaussianQuarterTurn + (BandVectors.1 (q 1) (q 0)) = BandVectors.1 (q 0) (q 1)) → ((GaussianQuarterTurn + (BandVectors.1 (q 3) (q 0)) = BandVectors.1 (q 0) (q 3)) → (TouchingTriple F + (TileTranslation F (BandVectors.1 (q 0) (q 3))) (TileTranslation F (-BandVectors.1 (q + 0) (q 1)))))))) ) := by + classical + intro C T N h k x normalization centeredTurnTouching q F touch2 turn_neg turn0 turn2 + simpa [turn2, turn0, turn_neg] using centeredTurnTouching F _ _ + normalization.fixed_quarter_turn touch2 + +private theorem touch0m : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), (forall (A : ProtoTile) + (a b : GaussianInt), QuarterTurnSymmetric A -> TouchingTriple A (TileTranslation A a) + (TileTranslation A b) -> TouchingTriple A (TileTranslation A (GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn a)))) (TileTranslation A + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn b))))) → ( + let q := normalization.normalizedPresentation + let F := normalization.normalizedFixed + (TouchingTriple F (TileTranslation F (BandVectors.1 (q (Fin.succ (0 : Fin (3 : ℕ)))) (q + (0 : Fin (4 : ℕ))))) (TileTranslation F (-BandVectors.1 (q ((0 : Fin (3 : ℕ)) + (1 : + Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) → ((∀ (z : GaussianInt), + GaussianQuarterTurn (-z) = -GaussianQuarterTurn z) → ((∀ (z : GaussianInt), + GaussianQuarterTurn (GaussianQuarterTurn z) = -z) → ((GaussianQuarterTurn + (BandVectors.1 (q 1) (q 0)) = BandVectors.1 (q 0) (q 1)) → ((GaussianQuarterTurn + (BandVectors.1 (q 2) (q 0)) = BandVectors.1 (q 0) (q 2)) → (TouchingTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q 1))) (TileTranslation F (BandVectors.1 (q + 0) (q 2))))))))) ) := by + classical + intro C T N h k x normalization thirdTurnTouching q F touch0 turn_neg turn_two turn0 turn1 + simpa [turn_three, turn_two, turn0, turn1, turn_neg] using + thirdTurnTouching F _ _ normalization.fixed_quarter_turn touch0 + +private theorem touch1m : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), (forall (A : ProtoTile) + (a b : GaussianInt), QuarterTurnSymmetric A -> TouchingTriple A (TileTranslation A a) + (TileTranslation A b) -> TouchingTriple A (TileTranslation A (GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn a)))) (TileTranslation A + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn b))))) → ( + let q := normalization.normalizedPresentation + let F := normalization.normalizedFixed + (TouchingTriple F (TileTranslation F (BandVectors.1 (q (Fin.succ (1 : Fin (3 : ℕ)))) (q + (0 : Fin (4 : ℕ))))) (TileTranslation F (-BandVectors.1 (q ((1 : Fin (3 : ℕ)) + (1 : + Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) → ((∀ (z : GaussianInt), + GaussianQuarterTurn (-z) = -GaussianQuarterTurn z) → ((∀ (z : GaussianInt), + GaussianQuarterTurn (GaussianQuarterTurn z) = -z) → ((GaussianQuarterTurn + (BandVectors.1 (q 2) (q 0)) = BandVectors.1 (q 0) (q 2)) → ((GaussianQuarterTurn + (BandVectors.1 (q 3) (q 0)) = BandVectors.1 (q 0) (q 3)) → (TouchingTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q 2))) (TileTranslation F (BandVectors.1 (q + 0) (q 3))))))))) ) := by + classical + intro C T N h k x normalization thirdTurnTouching q F touch1 turn_neg turn_two turn1 turn2 + simpa [turn_three, turn_two, turn1, turn2, turn_neg] using + thirdTurnTouching F _ _ normalization.fixed_quarter_turn touch1 + +private theorem touch2m : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), (forall (A : ProtoTile) + (a b : GaussianInt), QuarterTurnSymmetric A -> TouchingTriple A (TileTranslation A a) + (TileTranslation A b) -> TouchingTriple A (TileTranslation A (GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn a)))) (TileTranslation A + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn b))))) → ( + let q := normalization.normalizedPresentation + let F := normalization.normalizedFixed + (TouchingTriple F (TileTranslation F (BandVectors.1 (q (Fin.succ (2 : Fin (3 : ℕ)))) (q + (0 : Fin (4 : ℕ))))) (TileTranslation F (-BandVectors.1 (q ((2 : Fin (3 : ℕ)) + (1 : + Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) → ((∀ (z : GaussianInt), + GaussianQuarterTurn (-z) = -GaussianQuarterTurn z) → ((∀ (z : GaussianInt), + GaussianQuarterTurn (GaussianQuarterTurn z) = -z) → ((GaussianQuarterTurn + (BandVectors.1 (q 1) (q 0)) = BandVectors.1 (q 0) (q 1)) → ((GaussianQuarterTurn + (BandVectors.1 (q 3) (q 0)) = BandVectors.1 (q 0) (q 3)) → (TouchingTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q 3))) (TileTranslation F (BandVectors.1 (q + 0) (q 1))))))))) ) := by + classical + intro C T N h k x normalization thirdTurnTouching q F touch2 turn_neg turn_two turn0 turn2 + simpa [turn_three, turn_two, turn2, turn0, turn_neg] using + thirdTurnTouching F _ _ normalization.fixed_quarter_turn touch2 + +private theorem incoming_relation : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : + ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : + Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin + (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 + : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q + (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → (BandVectors.1 (q + 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) ) := by + classical + intro C T N h k x normalization q laws + let r : Fin 4 -> CircleCoordinates := ![q 0, q 2, q 3, q 1] + have hr : SemiProperQuadruple r := by + simpa [r] using SemiProperQuadruple.rotate + normalization.configuration.proper.1 + let s : Fin 4 -> CircleCoordinates := ![r 0, r 2, r 3, r 1] + have hs : SemiProperQuadruple s := by + simpa [s] using SemiProperQuadruple.rotate hr + have second := VectorRecursionLaws r hr + have third := VectorRecursionLaws s hs + have e0 := laws.2.2.1 + have e1 := second.2.2.1 + have e2 := third.2.2.1 + simp? [r, s] at e1 e2 + rw [e0, e1, e2] + calc + _ = (1 - (⟨0, 1⟩ : GaussianInt)) * + (BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 1) (q 3) + + BandVectors.1 (q 2) (q 1)) := by ring + _ = 0 := by rw [laws.1]; simp + +private theorem outgoing_relation : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + (GaussianQuarterTurn (BandVectors.1 (q 1) (q 0)) = BandVectors.1 (q 0) (q 1)) → + ((GaussianQuarterTurn (BandVectors.1 (q 2) (q 0)) = BandVectors.1 (q 0) (q 2)) → + ((GaussianQuarterTurn (BandVectors.1 (q 3) (q 0)) = BandVectors.1 (q 0) (q 3)) → + ((BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = + 0) → (BandVectors.1 (q 0) (q 1) + BandVectors.1 (q 0) (q 2) + BandVectors.1 (q 0) (q + 3) = 0)))) ) := by + classical + intro C T N h k x normalization q turn0 turn1 turn2 incoming_relation + rw [← turn0, ← turn1, ← turn2] + calc + _ = GaussianQuarterTurn (BandVectors.1 (q 1) (q 0) + + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0)) := by + rcases BandVectors.1 (q 1) (q 0) with ⟨a0, b0⟩ + rcases BandVectors.1 (q 2) (q 0) with ⟨a1, b1⟩ + rcases BandVectors.1 (q 3) (q 0) with ⟨a2, b2⟩ + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn]; ring + _ = GaussianQuarterTurn 0 := congrArg GaussianQuarterTurn incoming_relation + _ = 0 := by rfl + +private theorem period2 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + (BandVectors.1 (q 0) (q 1) + BandVectors.1 (q 0) (q 2) + BandVectors.1 (q 0) (q 3) = 0) → + ((BandVectors.1 (q 0) (q 1) = normalization.layout.u) → ((BandVectors.1 (q 0) (q 2) = + normalization.layout.v) → (BandVectors.1 (q 0) (q 3) = -normalization.layout.u - + normalization.layout.v))) ) := by + classical + intro C T N h k x normalization q outgoing_relation period0 period1 + rw [← period0, ← period1] + have h : BandVectors.1 (q 0) (q 3) = + -(BandVectors.1 (q 0) (q 1) + BandVectors.1 (q 0) (q 2)) := + eq_neg_of_add_eq_zero_left (by + simpa [add_assoc, add_comm, add_left_comm] using outgoing_relation) + calc + _ = -(BandVectors.1 (q 0) (q 1) + BandVectors.1 (q 0) (q 2)) := h + _ = _ := by abel + +private theorem finish : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), (forall (A A' B B' D D' + : ProtoTile), A.cells = A'.cells -> (A.cells = ∅ -> A.anchor = + A'.anchor) -> B.cells = B'.cells -> (B.cells = ∅ -> B.anchor = B'.anchor) -> D.cells + = D'.cells -> (D.cells = ∅ -> D.anchor = D'.anchor) -> TouchingTriple A B D -> + TouchingTriple A' B' D') → ( + let F := normalization.normalizedFixed + (∀ (m : ℤ), ∀ (n : ℤ), ∀ (r : ℤ), ∀ (s : ℤ), (m, n) ≠ (r, s) → Disjoint (TileTranslation + F ((↑m : GaussianInt) * normalization.layout.u + (↑n : GaussianInt) * + normalization.layout.v)).cells (TileTranslation F ((↑r : GaussianInt) * + normalization.layout.u + (↑s : GaussianInt) * normalization.layout.v)).cells) → + (forall (uStart uEnd : GaussianInt) (mR nR mS nS mE nE : Int), + normalization.rightNeighborDisplacement = (mR : GaussianInt) * normalization.layout.u + + (nR : GaussianInt) * normalization.layout.v -> uStart = (mS : GaussianInt) * + normalization.layout.u + (nS : GaussianInt) * normalization.layout.v -> uEnd = (mE : + GaussianInt) * normalization.layout.u + (nE : GaussianInt) * normalization.layout.v + -> (0, 0) ≠ (mR, nR) -> (0, 0) ≠ (mS, nS) -> (0, 0) ≠ (mE, nE) -> (mR, nR) ≠ (mS, nS) + -> (mR, nR) ≠ (mE, nE) -> (mS, nS) ≠ (mE, nE) -> ExactTileInterfaceTriple F + (TileTranslation F normalization.rightNeighborDisplacement) (TileTranslation F + uStart) -> ExactTileInterfaceTriple F (TileTranslation F uEnd) (TileTranslation F + normalization.rightNeighborDisplacement) -> TouchingTriple F (TileTranslation F + normalization.rightNeighborDisplacement) (TileTranslation F uStart) -> TouchingTriple + F (TileTranslation F uEnd) (TileTranslation F + normalization.rightNeighborDisplacement) -> Nonempty + (BandOrderedGeneralRightInterfaceCertificate normalization)))) := by + classical + intro C T N h k x normalization touchingRetarget F blocks uStart uEnd mR nR mS nS mE nE hR hS + hE hFR hFS hFE hRS hRE hSE exactStart exactEnd touchStart touchEnd + let swapAB : forall (A B D : ProtoTile), + ExactTileInterfaceTriple A B D -> ExactTileInterfaceTriple B A D := by + intro A B D E + exact + { point := E.point + otherAB := E.otherAB + otherBC := E.otherCA + otherCA := E.otherBC + pathAB := by simpa [Set.inter_comm] using E.pathAB + pathBC := by simpa [Set.inter_comm] using E.pathCA + pathCA := by simpa [Set.inter_comm] using E.pathBC + unique_common := by + intro y + simpa [Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using + E.unique_common y } + have cycleCAB : forall (A B D : ProtoTile), + ExactTileInterfaceTriple A B D -> ExactTileInterfaceTriple D A B := by + intro A B D E + exact + { point := E.point + otherAB := E.otherCA + otherBC := E.otherAB + otherCA := E.otherBC + pathAB := E.pathCA + pathBC := E.pathAB + pathCA := E.pathBC + unique_common := by + intro y + simpa [Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using + E.unique_common y } + have retargetFirst : forall (A A' B D : ProtoTile), + A.cells = A'.cells -> (A.cells = ∅ -> A.anchor = A'.anchor) -> + ExactTileInterfaceTriple A B D -> ExactTileInterfaceTriple A' B D := by + intro A A' B D hAc hAa E + have hAo := ProtoTileObservableExtensionality A A' hAc hAa + have hAe : FootprintEdges A = FootprintEdges A' := by + simp only [FootprintEdges] + rw [hAc] + exact + { point := E.point + otherAB := E.otherAB + otherBC := E.otherBC + otherCA := E.otherCA + pathAB := by simpa [hAo.1, hAe] using E.pathAB + pathBC := E.pathBC + pathCA := by simpa [hAo.1, hAe] using E.pathCA + unique_common := by + intro y + simpa [hAo.1] using E.unique_common y } + let q := normalization.normalizedPresentation + let oldRoot := TileTranslation F normalization.rightNeighborDisplacement + let startCompanion := TileTranslation F uStart + let endCompanion := TileTranslation F uEnd + have oldCells : oldRoot.cells = normalization.normalizedRoot.cells := + normalization.right_neighbor_cells.symm + have oldAnchor : oldRoot.cells = ∅ -> + oldRoot.anchor = normalization.normalizedRoot.anchor := by + intro he + apply (normalization.right_neighbor_empty_anchor ?_).symm + rw [normalization.right_neighbor_cells] + exact he + let start0 := swapAB F oldRoot startCompanion exactStart + let end0 := cycleCAB F endCompanion oldRoot exactEnd + let startData := retargetFirst oldRoot normalization.normalizedRoot F + startCompanion oldCells oldAnchor start0 + let endData := retargetFirst oldRoot normalization.normalizedRoot F + endCompanion oldCells oldAnchor end0 + have touchStart0 : TouchingTriple oldRoot F startCompanion := + (TouchingTriplePermutations F oldRoot startCompanion).mp touchStart |>.2.1 + have touchEnd0 : TouchingTriple oldRoot F endCompanion := + (TouchingTriplePermutations F endCompanion oldRoot).mp touchEnd |>.2.2.2.1 + have startTouching : TouchingTriple normalization.normalizedRoot F + startCompanion := touchingRetarget oldRoot normalization.normalizedRoot + F F startCompanion startCompanion oldCells oldAnchor rfl (by simp) + rfl (by simp) touchStart0 + have endTouching : TouchingTriple normalization.normalizedRoot F + endCompanion := touchingRetarget oldRoot normalization.normalizedRoot + F F endCompanion endCompanion oldCells oldAnchor rfl (by simp) + rfl (by simp) touchEnd0 + have latticeStart : LatticeTile startCompanion := + (TileDiskAreaCovariance F uStart).1.mp normalization.normalized_fixed_lattice + have latticeEnd : LatticeTile endCompanion := + (TileDiskAreaCovariance F uEnd).1.mp normalization.normalized_fixed_lattice + have transZero : (TileTranslation F 0).cells = F.cells := by + ext z + simp [TileTranslation, GaussianTranslation] + have disjFR : Disjoint F.cells oldRoot.cells := by + rw [← transZero] + simpa [oldRoot, hR] using blocks 0 0 mR nR hFR + have disjFS : Disjoint F.cells startCompanion.cells := by + rw [← transZero] + simpa [startCompanion, hS] using blocks 0 0 mS nS hFS + have disjFE : Disjoint F.cells endCompanion.cells := by + rw [← transZero] + simpa [endCompanion, hE] using blocks 0 0 mE nE hFE + have disjRS : Disjoint oldRoot.cells startCompanion.cells := by + simpa [oldRoot, startCompanion, hR, hS] using blocks mR nR mS nS hRS + have disjRE : Disjoint oldRoot.cells endCompanion.cells := by + simpa [oldRoot, endCompanion, hR, hE] using blocks mR nR mE nE hRE + have disjSE : Disjoint startCompanion.cells endCompanion.cells := by + simpa [startCompanion, endCompanion, hS, hE] using blocks mS nS mE nE hSE + have rootFixed : Disjoint normalization.normalizedRoot.cells F.cells := by + rw [← oldCells] + exact disjFR.symm + have rootStart : Disjoint normalization.normalizedRoot.cells + startCompanion.cells := by rw [← oldCells]; exact disjRS + have rootEnd : Disjoint normalization.normalizedRoot.cells + endCompanion.cells := by rw [← oldCells]; exact disjRE + have crossed := ExactTileInterfaceDisjointCompanionEndpoints + normalization.normalizedRoot F startCompanion endCompanion + startData endData normalization.normalized_root_lattice + normalization.normalized_fixed_lattice latticeStart latticeEnd + startTouching endTouching rootStart disjFS disjSE + have rootPositive : 0 < (q 0).1 := by + dsimp [q] + have hc := normalization.configuration.childLarge + omega + have pointRoot : normalization.normalizedPoint ∈ + FootprintVertices normalization.normalizedRoot := by + rw [← PositiveCurvatureTileOdometerDomain _ _ _ rootPositive + normalization.normalized_root_odometer] + exact normalization.normalized_point_root_domain + have pointFixed : normalization.normalizedPoint ∈ FootprintVertices F := by + rw [← PositiveCurvatureTileOdometerDomain _ _ _ + normalization.normalizedFixedCircle.property + normalization.normalized_fixed_odometer] + exact normalization.normalized_point_fixed_domain + exact ⟨ + { startCompanion := startCompanion + endCompanion := endCompanion + startData := startData + endData := endData + normalized_point_on_start_path := ⟨pointRoot, pointFixed⟩ + interface_endpoints := crossed.2 + root_lattice := normalization.normalized_root_lattice + fixed_lattice := normalization.normalized_fixed_lattice + start_lattice := latticeStart + end_lattice := latticeEnd + root_fixed_disjoint := rootFixed + root_start_disjoint := rootStart + fixed_start_disjoint := disjFS + root_end_disjoint := rootEnd + fixed_end_disjoint := disjFE + start_end_disjoint := disjSE + start_touching := startTouching + end_touching := endTouching }⟩ + +private theorem hRAt632 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + (normalization.rightDirectionSlot = (2 : Fin (3 : ℕ))) → + ((normalization.rightNeighborPositive = false) → + (normalization.rightNeighborDisplacement = -BandVectors.1 (q 0) (q 3))) ) := by + classical + intro C T N h k x normalization q hk hpos + simpa [hpos, hk] using normalization.right_neighbor_displacement + +private theorem hRAt651 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + (normalization.rightDirectionSlot = (2 : Fin (3 : ℕ))) → + ((normalization.rightNeighborPositive = true) → + (normalization.rightNeighborDisplacement = BandVectors.1 (q 0) (q 3))) ) := by + classical + intro C T N h k x normalization q hk hpos + simpa [hpos, hk] using normalization.right_neighbor_displacement + +private theorem hRAt674 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + (normalization.rightDirectionSlot = (0 : Fin (3 : ℕ))) → + ((normalization.rightNeighborPositive = false) → + (normalization.rightNeighborDisplacement = -BandVectors.1 (q 0) (q 1))) ) := by + classical + intro C T N h k x normalization q hk hpos + simpa [hpos, hk] using normalization.right_neighbor_displacement + +private theorem hRAt694 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + (normalization.rightDirectionSlot = (0 : Fin (3 : ℕ))) → + ((normalization.rightNeighborPositive = true) → + (normalization.rightNeighborDisplacement = BandVectors.1 (q 0) (q 1))) ) := by + classical + intro C T N h k x normalization q hk hpos + simpa [hpos, hk] using normalization.right_neighbor_displacement + +private theorem hRAt716 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + (normalization.rightDirectionSlot = (1 : Fin (3 : ℕ))) → + ((normalization.rightNeighborPositive = false) → + (normalization.rightNeighborDisplacement = -BandVectors.1 (q 0) (q 2))) ) := by + classical + intro C T N h k x normalization q hk hpos + simpa [hpos, hk] using normalization.right_neighbor_displacement + +private theorem hRAt736 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + (normalization.rightDirectionSlot = (1 : Fin (3 : ℕ))) → + ((normalization.rightNeighborPositive = true) → + (normalization.rightNeighborDisplacement = BandVectors.1 (q 0) (q 2))) ) := by + classical + intro C T N h k x normalization q hk hpos + simpa [hpos, hk] using normalization.right_neighbor_displacement + +end RightInterfaceCertificateGeometry + +namespace RightInterfaceCertificateConclusion + +private theorem rightInterfaceCertificate : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), (∀ (A : ProtoTile), ∀ + (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (D : ProtoTile), ∀ (D' : + ProtoTile), A.cells = A'.cells → (A.cells = ∅ → A.anchor = + A'.anchor) → B.cells = B'.cells → (B.cells = ∅ → B.anchor = B'.anchor) → D.cells = + D'.cells → (D.cells = ∅ → D.anchor = D'.anchor) → TouchingTriple A B D → + TouchingTriple A' B' D') → ( + let q := normalization.normalizedPresentation + let F := normalization.normalizedFixed + (∀ (z : GaussianInt), GaussianQuarterTurn (-z) = -GaussianQuarterTurn z) → ((∀ (z : + GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn z)) = -GaussianQuarterTurn z) → ((∀ (z : GaussianInt), + GaussianQuarterTurn (GaussianQuarterTurn z) = -z) → ((GaussianQuarterTurn + (BandVectors.1 (q 1) (q 0)) = BandVectors.1 (q 0) (q 1)) → ((GaussianQuarterTurn + (BandVectors.1 (q 2) (q 0)) = BandVectors.1 (q 0) (q + 2)) → ((GaussianQuarterTurn (BandVectors.1 (q 3) (q 0)) = BandVectors.1 (q 0) + (q 3)) → ((ExactTileInterfaceTriple F (TileTranslation F (GaussianQuarterTurn + (BandVectors.1 (q (Fin.succ (0 : Fin (3 : ℕ)))) (q (0 : Fin (4 : ℕ)))))) + (TileTranslation F (GaussianQuarterTurn (-BandVectors.1 (q ((0 : Fin (3 : ℕ)) + (1 : + Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ))))))) → ((ExactTileInterfaceTriple F + (TileTranslation F (GaussianQuarterTurn (BandVectors.1 (q (Fin.succ (1 : Fin (3 : + ℕ)))) (q (0 : Fin (4 : ℕ)))))) (TileTranslation F (GaussianQuarterTurn + (-BandVectors.1 (q ((1 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : + ℕ))))))) → ((ExactTileInterfaceTriple F (TileTranslation F + (GaussianQuarterTurn (BandVectors.1 (q (Fin.succ (2 : Fin (3 : ℕ)))) (q (0 : Fin (4 : + ℕ)))))) (TileTranslation F (GaussianQuarterTurn (-BandVectors.1 (q ((2 : Fin (3 : ℕ)) + + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ))))))) → ((ExactTileInterfaceTriple F + (TileTranslation F (GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q (Fin.succ (0 : Fin (3 : + ℕ)))) (q (0 : Fin (4 : ℕ)))))))) (TileTranslation F (GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn (-BandVectors.1 (q ((0 : Fin (3 : ℕ)) + (1 + : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ))))))))) → ((ExactTileInterfaceTriple + F (TileTranslation F (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn + (BandVectors.1 (q (Fin.succ (1 : Fin (3 : ℕ)))) (q (0 : Fin (4 : ℕ)))))))) + (TileTranslation F (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn + (-BandVectors.1 (q ((1 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : + ℕ))))))))) → ((ExactTileInterfaceTriple F (TileTranslation F + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q + (Fin.succ (2 : Fin (3 : ℕ)))) (q (0 : Fin (4 : ℕ)))))))) (TileTranslation F + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (-BandVectors.1 (q ((2 + : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ))))))))) → + ((TouchingTriple F (TileTranslation F (BandVectors.1 (q 0) (q 1))) + (TileTranslation F + (-BandVectors.1 (q 0) (q 2)))) → ((TouchingTriple F (TileTranslation F (BandVectors.1 + (q 0) (q 2))) (TileTranslation F (-BandVectors.1 (q 0) (q 3)))) → ((TouchingTriple F + (TileTranslation F (BandVectors.1 (q 0) (q 3))) (TileTranslation F (-BandVectors.1 (q + 0) (q 1)))) → ((TouchingTriple F (TileTranslation F (-BandVectors.1 (q 0) (q 1))) + (TileTranslation F (BandVectors.1 (q 0) (q 2)))) → ((TouchingTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q 2))) (TileTranslation F (BandVectors.1 (q + 0) (q 3)))) → ((TouchingTriple F (TileTranslation F (-BandVectors.1 (q 0) (q 3))) + (TileTranslation F (BandVectors.1 (q 0) (q 1)))) → ((BandVectors.1 (q 0) (q 1) = + normalization.layout.u) → ((BandVectors.1 (q 0) (q 2) = normalization.layout.v) → + ((BandVectors.1 (q 0) (q 3) = -normalization.layout.u - normalization.layout.v) → + (Nonempty (BandOrderedGeneralRightInterfaceCertificate + normalization)))))))))))))))))))))))) := by + classical + intro C T N h k x normalization touchingRetarget q F turn_neg turn_three turn_two turn0 turn1 + turn2 X0p0 X1p0 X2p0 X0m0 X1m0 X2m0 touch0p touch1p touch2p touch0m touch1m touch2m period0 + period1 period2 + let X0p : ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q 0) (q 1))) + (TileTranslation F (-BandVectors.1 (q 0) (q 2))) := by + simpa [turn0, turn1, turn_neg] using X0p0 + have X1p : ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q 0) (q 2))) + (TileTranslation F (-BandVectors.1 (q 0) (q 3))) := by + simpa [turn1, turn2, turn_neg] using X1p0 + have X2p : ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q 0) (q 3))) + (TileTranslation F (-BandVectors.1 (q 0) (q 1))) := by + simpa [turn2, turn0, turn_neg] using X2p0 + have X0m : ExactTileInterfaceTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q 1))) + (TileTranslation F (BandVectors.1 (q 0) (q 2))) := by + simpa [turn_three, turn_two, turn0, turn1, turn_neg] using X0m0 + have X1m : ExactTileInterfaceTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q 2))) + (TileTranslation F (BandVectors.1 (q 0) (q 3))) := by + simpa [turn_three, turn_two, turn1, turn2, turn_neg] using X1m0 + have X2m : ExactTileInterfaceTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q 3))) + (TileTranslation F (BandVectors.1 (q 0) (q 1))) := by + simpa [turn_three, turn_two, turn2, turn0, turn_neg] using X2m0 + have blocks := (BandOrderedGeneralPeriodicBlockCells q + normalization.configuration normalization.normalizedCircle F + normalization.layout).2 + have finish := RightInterfaceCertificateGeometry.finish C T N h k x normalization + touchingRetarget blocks + rcases normalization.right_slots_cyclic with hslots | hslots | hslots + · rcases hslots with ⟨hi, hj, hk⟩ + cases hpos : normalization.rightNeighborPositive + · have hR : normalization.rightNeighborDisplacement = + -BandVectors.1 (q 0) (q 3) := RightInterfaceCertificateGeometry.hRAt632 C T N h k x + normalization hk hpos + apply finish (BandVectors.1 (q 0) (q 1)) + (BandVectors.1 (q 0) (q 2)) 1 1 1 0 0 1 + · rw [hR, period2] + ring + · simp [period0] + · simp [period1] + · norm_num + · norm_num + · norm_num + · norm_num + · norm_num + · norm_num + · simpa [hR] using X2m + · simpa [hR] using X1p + · simpa [hR] using touch2m + · simpa [hR] using touch1p + · have hR : normalization.rightNeighborDisplacement = + BandVectors.1 (q 0) (q 3) := RightInterfaceCertificateGeometry.hRAt651 C T N h k x + normalization hk hpos + apply finish (-BandVectors.1 (q 0) (q 1)) + (-BandVectors.1 (q 0) (q 2)) (-1) (-1) (-1) 0 0 (-1) + · rw [hR, period2] + ring + · rw [period0] + simp + · rw [period1] + simp + · norm_num + · norm_num + · norm_num + · norm_num + · norm_num + · norm_num + · simpa [hR] using X2p + · simpa [hR] using X1m + · simpa [hR] using touch2p + · simpa [hR] using touch1m + · rcases hslots with ⟨hi, hj, hk⟩ + cases hpos : normalization.rightNeighborPositive + · have hR : normalization.rightNeighborDisplacement = + -BandVectors.1 (q 0) (q 1) := RightInterfaceCertificateGeometry.hRAt674 C T N h k x + normalization hk hpos + apply finish (BandVectors.1 (q 0) (q 2)) + (BandVectors.1 (q 0) (q 3)) (-1) 0 0 1 (-1) (-1) + · rw [hR, period0] + simp + · simp [period1] + · rw [period2] + ring + · norm_num + · norm_num + · norm_num + · norm_num + · norm_num + · norm_num + · simpa [hR] using X0m + · simpa [hR] using X2p + · simpa [hR] using touch0m + · simpa [hR] using touch2p + · have hR : normalization.rightNeighborDisplacement = + BandVectors.1 (q 0) (q 1) := RightInterfaceCertificateGeometry.hRAt694 C T N h k x + normalization hk hpos + apply finish (-BandVectors.1 (q 0) (q 2)) + (-BandVectors.1 (q 0) (q 3)) 1 0 0 (-1) 1 1 + · simp [hR, period0] + · rw [period1] + simp + · rw [period2] + ring + · norm_num + · norm_num + · norm_num + · norm_num + · norm_num + · norm_num + · simpa [hR] using X0p + · simpa [hR] using X2m + · simpa [hR] using touch0p + · simpa [hR] using touch2m + · rcases hslots with ⟨hi, hj, hk⟩ + cases hpos : normalization.rightNeighborPositive + · have hR : normalization.rightNeighborDisplacement = + -BandVectors.1 (q 0) (q 2) := RightInterfaceCertificateGeometry.hRAt716 C T N h k x + normalization hk hpos + apply finish (BandVectors.1 (q 0) (q 3)) + (BandVectors.1 (q 0) (q 1)) 0 (-1) (-1) (-1) 1 0 + · rw [hR, period1] + simp + · rw [period2] + ring + · simp [period0] + · norm_num + · norm_num + · norm_num + · norm_num + · norm_num + · norm_num + · simpa [hR] using X1m + · simpa [hR] using X0p + · simpa [hR] using touch1m + · simpa [hR] using touch0p + · have hR : normalization.rightNeighborDisplacement = + BandVectors.1 (q 0) (q 2) := RightInterfaceCertificateGeometry.hRAt736 C T N h k x + normalization hk hpos + apply finish (-BandVectors.1 (q 0) (q 3)) + (-BandVectors.1 (q 0) (q 1)) 0 1 1 1 (-1) 0 + · simp [hR, period1] + · rw [period2] + ring + · rw [period0] + simp + · norm_num + · norm_num + · norm_num + · norm_num + · norm_num + · norm_num + · simpa [hR] using X1p + · simpa [hR] using X0m + · simpa [hR] using touch1p + · simpa [hR] using touch0m + +end RightInterfaceCertificateConclusion + +theorem BandOrderedGeneralRightInterfaceCertificateExists + {C : BandCircle} {T N : ProtoTile} {h k : PartialOdometer} + {x : GaussianInt} + (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x) : + Nonempty (BandOrderedGeneralRightInterfaceCertificate normalization) := by +-- BODY + classical + have touchingRetarget := RightInterfaceCertificateGeometry.touchingRetarget + (RightInterfaceCertificateGeometry.tileTouchingRetarget) + have swapAB : forall (A B D : ProtoTile), + ExactTileInterfaceTriple A B D -> ExactTileInterfaceTriple B A D := by + intro A B D E + exact + { point := E.point + otherAB := E.otherAB + otherBC := E.otherCA + otherCA := E.otherBC + pathAB := by simpa [Set.inter_comm] using E.pathAB + pathBC := by simpa [Set.inter_comm] using E.pathCA + pathCA := by simpa [Set.inter_comm] using E.pathBC + unique_common := by + intro y + simpa [Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using + E.unique_common y } + have cycleCAB : forall (A B D : ProtoTile), + ExactTileInterfaceTriple A B D -> ExactTileInterfaceTriple D A B := by + intro A B D E + exact + { point := E.point + otherAB := E.otherCA + otherBC := E.otherAB + otherCA := E.otherBC + pathAB := E.pathCA + pathBC := E.pathAB + pathCA := E.pathBC + unique_common := by + intro y + simpa [Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using + E.unique_common y } + have retargetFirst : forall (A A' B D : ProtoTile), + A.cells = A'.cells -> (A.cells = ∅ -> A.anchor = A'.anchor) -> + ExactTileInterfaceTriple A B D -> ExactTileInterfaceTriple A' B D := by + intro A A' B D hAc hAa E + have hAo := ProtoTileObservableExtensionality A A' hAc hAa + have hAe : FootprintEdges A = FootprintEdges A' := RightInterfaceCertificateGeometry.hAeAt211 + A A' hAc + exact + { point := E.point + otherAB := E.otherAB + otherBC := E.otherBC + otherCA := E.otherCA + pathAB := by simpa [hAo.1, hAe] using E.pathAB + pathBC := E.pathBC + pathCA := by simpa [hAo.1, hAe] using E.pathCA + unique_common := by + intro y + simpa [hAo.1] using E.unique_common y } + have centeredTurnTouching := RightInterfaceCertificateGeometry.centeredTurnTouching + touchingRetarget + (RightInterfaceCertificateGeometry.quarterTranslate) + (RightInterfaceCertificateGeometry.translateObs) + have centeredTurnExact := RightInterfaceCertificateGeometry.centeredTurnExact + have thirdTurnExact := RightInterfaceCertificateGeometry.thirdTurnExact centeredTurnExact + have thirdTurnTouching := RightInterfaceCertificateGeometry.thirdTurnTouching centeredTurnTouching + let q := normalization.normalizedPresentation + let F := normalization.normalizedFixed + have child := BandOrderedGeneralChildInterfaces q normalization.configuration + normalization.normalizedCircle F normalization.layout + normalization.fixed_quarter_turn + obtain ⟨X0⟩ := child.1 (0 : Fin 3) + obtain ⟨X1⟩ := child.1 (1 : Fin 3) + obtain ⟨X2⟩ := child.1 (2 : Fin 3) + have touch0 := TileT3TranslateTouching q normalization.configuration + normalization.normalizedCircle F normalization.layout + normalization.fixed_quarter_turn (0 : Fin 3) + have touch1 := TileT3TranslateTouching q normalization.configuration + normalization.normalizedCircle F normalization.layout + normalization.fixed_quarter_turn (1 : Fin 3) + have touch2 := TileT3TranslateTouching q normalization.configuration + normalization.normalizedCircle F normalization.layout + normalization.fixed_quarter_turn (2 : Fin 3) + have laws := VectorRecursionLaws q normalization.configuration.proper.1 + have flip := laws.2.2.2.2 normalization.configuration.proper + have turn_flip (s : Fin 3) : + GaussianQuarterTurn (BandVectors.1 (q s.succ) (q 0)) = + BandVectors.1 (q 0) (q s.succ) := RightInterfaceCertificateGeometry.turn_flip C T N h k x + normalization flip s + have turn_neg (z : GaussianInt) : + GaussianQuarterTurn (-z) = -GaussianQuarterTurn z := + RightInterfaceCertificateGeometry.turn_neg z + have turn_three (z : GaussianInt) : + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) = + -GaussianQuarterTurn z := RightInterfaceCertificateGeometry.turn_three z + have turn_two (z : GaussianInt) : + GaussianQuarterTurn (GaussianQuarterTurn z) = -z := + RightInterfaceCertificateGeometry.turn_two z + have turn0 : GaussianQuarterTurn (BandVectors.1 (q 1) (q 0)) = + BandVectors.1 (q 0) (q 1) := by simpa using turn_flip (0 : Fin 3) + have turn1 : GaussianQuarterTurn (BandVectors.1 (q 2) (q 0)) = + BandVectors.1 (q 0) (q 2) := by simpa using turn_flip (1 : Fin 3) + have turn2 : GaussianQuarterTurn (BandVectors.1 (q 3) (q 0)) = + BandVectors.1 (q 0) (q 3) := by simpa using turn_flip (2 : Fin 3) + obtain ⟨X0p0⟩ := centeredTurnExact F + (BandVectors.1 (q (0 : Fin 3).succ) (q 0)) + (-BandVectors.1 (q (((0 : Fin 3) + 1).succ)) (q 0)) + normalization.fixed_quarter_turn X0 + obtain ⟨X1p0⟩ := centeredTurnExact F + (BandVectors.1 (q (1 : Fin 3).succ) (q 0)) + (-BandVectors.1 (q (((1 : Fin 3) + 1).succ)) (q 0)) + normalization.fixed_quarter_turn X1 + obtain ⟨X2p0⟩ := centeredTurnExact F + (BandVectors.1 (q (2 : Fin 3).succ) (q 0)) + (-BandVectors.1 (q (((2 : Fin 3) + 1).succ)) (q 0)) + normalization.fixed_quarter_turn X2 + obtain ⟨X0m0⟩ := thirdTurnExact F + (BandVectors.1 (q (0 : Fin 3).succ) (q 0)) + (-BandVectors.1 (q (((0 : Fin 3) + 1).succ)) (q 0)) + normalization.fixed_quarter_turn X0 + obtain ⟨X1m0⟩ := thirdTurnExact F + (BandVectors.1 (q (1 : Fin 3).succ) (q 0)) + (-BandVectors.1 (q (((1 : Fin 3) + 1).succ)) (q 0)) + normalization.fixed_quarter_turn X1 + obtain ⟨X2m0⟩ := thirdTurnExact F + (BandVectors.1 (q (2 : Fin 3).succ) (q 0)) + (-BandVectors.1 (q (((2 : Fin 3) + 1).succ)) (q 0)) + normalization.fixed_quarter_turn X2 + have X0p : ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q 0) (q 1))) + (TileTranslation F (-BandVectors.1 (q 0) (q 2))) := by + simpa [turn0, turn1, turn_neg] using X0p0 + have X1p : ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q 0) (q 2))) + (TileTranslation F (-BandVectors.1 (q 0) (q 3))) := by + simpa [turn1, turn2, turn_neg] using X1p0 + have X2p : ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q 0) (q 3))) + (TileTranslation F (-BandVectors.1 (q 0) (q 1))) := by + simpa [turn2, turn0, turn_neg] using X2p0 + have X0m : ExactTileInterfaceTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q 1))) + (TileTranslation F (BandVectors.1 (q 0) (q 2))) := by + simpa [turn_three, turn_two, turn0, turn1, turn_neg] using X0m0 + have X1m : ExactTileInterfaceTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q 2))) + (TileTranslation F (BandVectors.1 (q 0) (q 3))) := by + simpa [turn_three, turn_two, turn1, turn2, turn_neg] using X1m0 + have X2m : ExactTileInterfaceTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q 3))) + (TileTranslation F (BandVectors.1 (q 0) (q 1))) := by + simpa [turn_three, turn_two, turn2, turn0, turn_neg] using X2m0 + have touch0p : TouchingTriple F + (TileTranslation F (BandVectors.1 (q 0) (q 1))) + (TileTranslation F (-BandVectors.1 (q 0) (q 2))) := + RightInterfaceCertificateGeometry.touch0p C T N h k x normalization + centeredTurnTouching touch0 turn_neg turn0 turn1 + have touch1p : TouchingTriple F + (TileTranslation F (BandVectors.1 (q 0) (q 2))) + (TileTranslation F (-BandVectors.1 (q 0) (q 3))) := + RightInterfaceCertificateGeometry.touch1p C T N h k x normalization + centeredTurnTouching touch1 turn_neg turn1 turn2 + have touch2p : TouchingTriple F + (TileTranslation F (BandVectors.1 (q 0) (q 3))) + (TileTranslation F (-BandVectors.1 (q 0) (q 1))) := + RightInterfaceCertificateGeometry.touch2p C T N h k x normalization + centeredTurnTouching touch2 turn_neg turn0 turn2 + have touch0m : TouchingTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q 1))) + (TileTranslation F (BandVectors.1 (q 0) (q 2))) := + RightInterfaceCertificateGeometry.touch0m C T N h k x normalization thirdTurnTouching + touch0 turn_neg turn_two turn0 turn1 + have touch1m : TouchingTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q 2))) + (TileTranslation F (BandVectors.1 (q 0) (q 3))) := + RightInterfaceCertificateGeometry.touch1m C T N h k x normalization thirdTurnTouching + touch1 turn_neg turn_two turn1 turn2 + have touch2m : TouchingTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q 3))) + (TileTranslation F (BandVectors.1 (q 0) (q 1))) := + RightInterfaceCertificateGeometry.touch2m C T N h k x normalization thirdTurnTouching + touch2 turn_neg turn_two turn0 turn2 + have period0 : BandVectors.1 (q 0) (q 1) = normalization.layout.u := + normalization.layout.period_u.symm + have period1 : BandVectors.1 (q 0) (q 2) = normalization.layout.v := + normalization.layout.period_v.symm + have period2 : BandVectors.1 (q 0) (q 3) = + -normalization.layout.u - normalization.layout.v := + RightInterfaceCertificateGeometry.period2 C T N h k x normalization + (RightInterfaceCertificateGeometry.outgoing_relation C T N h k x normalization + turn0 turn1 turn2 (RightInterfaceCertificateGeometry.incoming_relation C T N h k x + normalization laws)) + period0 period1 + have rightInterfaceCertificate : + Nonempty (BandOrderedGeneralRightInterfaceCertificate normalization) := + RightInterfaceCertificateConclusion.rightInterfaceCertificate C T N h k x normalization + touchingRetarget turn_neg turn_three turn_two turn0 turn1 turn2 X0p0 X1p0 X2p0 X0m0 X1m0 + X2m0 touch0p touch1p touch2p touch0m touch1m touch2m period0 period1 period2 + exact rightInterfaceCertificate + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificate.lean new file mode 100644 index 0000000000..b7af2ca935 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificate.lean @@ -0,0 +1,272 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric + +-- [TABLET NODE: BandOrderedGeneralRightNormalizationCertificate] + +/-! +# BandOrderedGeneralRightNormalizationCertificate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For right-lattice adjacent tile odometers $(T,h)$ and $(N,k)$ of a circle +$C$, a right normalization certificate consists of one proper presentation +$q$ of $C$, one cyclic parent rotation, one packing-symmetry word, and the +resulting ordered-general presentation, transformed circle, literal supports, +functions, point, and slopes. It includes one ordered-general layout rooted +at the transformed fixed support and one reindexed six-piece decomposition of +the transformed root support. It retains the transformed point's membership +in both transformed function domains, lattice-tile certificates for both +transformed outer supports, and a named +`QuarterTurnSymmetric` witness for the transformed fixed support. + +Write $\bar q$ for the resulting ordered-general presentation. The +certificate also names three parent slots $(i,j,k)$, records that they are one +of the cyclic triples +$$ + (0,1,2),\qquad(1,2,0),\qquad(2,0,1), +$$ +and stores a right-neighbor polarity $\epsilon$. Writing +$$ + b_s=v(\bar q_0,\bar q_{s+1}) +$$ +for the outgoing vector of the normalized presentation and $d$ for the stored +right-neighbor displacement, its exact displacement field is +$$ + d=\begin{cases} + b_k,&\epsilon=\mathsf{true},\\ + -b_k,&\epsilon=\mathsf{false}. + \end{cases} +$$ +It records the transported adjacency with this complemented polarity, the +cell and empty-anchor alignment of the two outer supports, the corresponding +observable alignments of the two signed boundary pieces, and the transported +five-point footprint cover. In particular, the certificate contains only one +layout and one decomposition. +-/ +structure BandOrderedGeneralRightNormalizationCertificate + (C : BandCircle) (T N : ProtoTile) (h k : PartialOdometer) + (x : GaussianInt) where +-- BODY + /-- The proper source presentation of the root circle. -/ + presentation : Fin 4 -> CircleCoordinates + presentation_proper : ProperBandQuadruple presentation + presentation_child : presentation 0 = C.1.1 + /-- The cyclic parent rotation used before applying the packing symmetry. -/ + parentRotation : Fin 3 + /-- The single packing-symmetry word used throughout the normalization. -/ + symmetry : BandPackingSymmetry + /-- The source presentation after the chosen cyclic parent rotation. -/ + rotatedPresentation : Fin 4 -> CircleCoordinates + rotated_presentation_eq : rotatedPresentation = + ![presentation 0, presentation parentRotation.succ, + presentation (parentRotation + 1).succ, + presentation (parentRotation + 2).succ] + /-- The ordered-general presentation obtained by the symmetry action. -/ + normalizedPresentation : Fin 4 -> CircleCoordinates + normalized_presentation_eq : normalizedPresentation = + BandPackingSymmetryQuadrupleAction symmetry rotatedPresentation + /-- The ordered-general predecessor data for the normalized presentation. -/ + configuration : BandOrderedGeneralConfiguration normalizedPresentation + /-- The positive root circle in the normalized presentation. -/ + normalizedCircle : BandCircle + normalized_circle_eq : normalizedPresentation 0 = normalizedCircle.1.1 + /-- The transformed positive circle of the fixed tile odometer. -/ + normalizedFixedCircle : BandCircle + normalized_fixed_circle_eq : normalizedFixedCircle.1.1 = + BandPackingSymmetryCircleAction symmetry C.1.1 + /-- The literal transformed root support. -/ + normalizedRoot : ProtoTile + /-- The literal transformed fixed support. -/ + normalizedFixed : ProtoTile + /-- The transformed root odometer on its actual finite domain. -/ + normalizedRootFunction : PartialOdometer + /-- The transformed fixed odometer on its actual finite domain. -/ + normalizedFixedFunction : PartialOdometer + /-- The transformed lattice contact point. -/ + normalizedPoint : GaussianInt + normalized_root_eq : normalizedRoot = BandPackingSymmetryTileAction symmetry T + normalized_fixed_eq : normalizedFixed = BandPackingSymmetryTileAction symmetry N + normalized_root_function_eq : normalizedRootFunction = + BandPackingSymmetryPartialOdometerAction symmetry h + normalized_fixed_function_eq : normalizedFixedFunction = + BandPackingSymmetryPartialOdometerAction symmetry k + normalized_point_eq : normalizedPoint = + BandPackingSymmetryVectorAction symmetry x + normalized_point_root_domain : normalizedPoint ∈ normalizedRootFunction.domain + normalized_point_fixed_domain : normalizedPoint ∈ normalizedFixedFunction.domain + normalized_root_odometer : + TileOdometer (normalizedPresentation 0) normalizedRoot normalizedRootFunction + normalized_fixed_odometer : + TileOdometer normalizedFixedCircle.1.1 normalizedFixed normalizedFixedFunction + normalized_root_lattice : LatticeTile normalizedRoot + normalized_fixed_lattice : LatticeTile normalizedFixed + /-- The defined slope of the transformed root odometer. -/ + normalizedRootSlope : Real × Real + /-- The defined slope of the transformed fixed odometer. -/ + normalizedFixedSlope : Real × Real + normalized_root_slope : + PartialOdometerSlope normalizedRootFunction = some normalizedRootSlope + normalized_fixed_slope : + PartialOdometerSlope normalizedFixedFunction = some normalizedFixedSlope + /-- The single family of six signed supports in the normalized root decomposition. -/ + pieces : Fin 3 -> Bool -> ProtoTile + /-- The literal partial odometers on that same six-piece family. -/ + functions : Fin 3 -> Bool -> PartialOdometer + root_band : BandPrototile (normalizedPresentation 0) normalizedRoot + piece_odometer : forall i s, TileOdometer (normalizedPresentation i.succ) + (pieces i s) (functions i s) + piece_cell_cover : forall z, z ∈ normalizedRoot.cells ↔ + exists i s, z ∈ (pieces i s).cells + piece_footprint : forall i s, + FootprintVertices (pieces i s) ⊆ FootprintVertices normalizedRoot + piece_centroid : forall i s, + TileCentroid (pieces i s) - TileCentroid normalizedRoot = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (normalizedPresentation ((i + 2).succ)) + (normalizedPresentation ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (normalizedPresentation ((i + 2).succ)) + (normalizedPresentation ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (normalizedPresentation ((i + 2).succ)) + (normalizedPresentation ((i + 1).succ)))).1))) + function_domain_cover : forall z, z ∈ normalizedRootFunction.domain ↔ + exists i s, z ∈ (functions i s).domain + function_restriction : forall i s z, z ∈ (functions i s).domain -> + normalizedRootFunction.value z = (functions i s).value z + function_compatibility : forall i s j t, + OdometerCompatibility (functions i s) (functions j t) + piece_slope : forall i s, (normalizedPresentation i.succ).1 = 0 ∨ + exists p p_i : Real × Real, + PartialOdometerSlope normalizedRootFunction = some p ∧ + PartialOdometerSlope (functions i s) = some p_i ∧ + p_i.1 - p.1 = + (if s = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (normalizedPresentation ((i + 2).succ)) + (normalizedPresentation ((i + 1).succ))).re : Int) - + ((BandVectors.2 (normalizedPresentation ((i + 2).succ)) + (normalizedPresentation ((i + 1).succ))).im : Int)) ∧ + p_i.2 - p.2 = + (if s = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (normalizedPresentation ((i + 2).succ)) + (normalizedPresentation ((i + 1).succ))).im : Int) + + ((BandVectors.2 (normalizedPresentation ((i + 2).succ)) + (normalizedPresentation ((i + 1).succ))).re : Int)) + adjacency : RightLatticeAdjacent normalizedCircle normalizedRoot normalizedFixed + normalizedRootFunction normalizedFixedFunction + /-- The literal ordered-general layout rooted at the normalized fixed full tile. -/ + layout : BandOrderedGeneralLayoutCertificate normalizedPresentation configuration + normalizedCircle normalizedFixed + fixed_quarter_turn : QuarterTurnSymmetric normalizedFixed + /-- The first parent slot in the retained cyclic boundary triple. -/ + rightFirstSlot : Fin 3 + /-- The second parent slot in that same cyclic boundary triple. -/ + rightSecondSlot : Fin 3 + /-- The parent slot determining the full right-neighbor displacement. -/ + rightDirectionSlot : Fin 3 + right_slots_cyclic : + (rightFirstSlot = 0 ∧ rightSecondSlot = 1 ∧ rightDirectionSlot = 2) ∨ + (rightFirstSlot = 1 ∧ rightSecondSlot = 2 ∧ rightDirectionSlot = 0) ∨ + (rightFirstSlot = 2 ∧ rightSecondSlot = 0 ∧ rightDirectionSlot = 1) + /-- The polarity of the retained right-neighbor presentation. -/ + rightNeighborPositive : Bool + right_adjacency_centroid : TileCentroid normalizedFixed - TileCentroid normalizedRoot = + (if rightNeighborPositive = true then (-1 : Real) else 1) • + GaussianRealPoint + (BandVectors.1 (normalizedPresentation 0) + (normalizedPresentation rightDirectionSlot.succ)) + right_adjacency_slope_real : normalizedFixedSlope.1 - normalizedRootSlope.1 = + (if rightNeighborPositive = true then (-1 : Real) else 1) * + (BandVectors.2 (normalizedPresentation 0) + (normalizedPresentation rightDirectionSlot.succ)).re + right_adjacency_slope_imag : normalizedFixedSlope.2 - normalizedRootSlope.2 = + (if rightNeighborPositive = true then (-1 : Real) else 1) * + (BandVectors.2 (normalizedPresentation 0) + (normalizedPresentation rightDirectionSlot.succ)).im + /-- The actual signed outgoing displacement between the two normalized full tiles. -/ + rightNeighborDisplacement : GaussianInt + right_neighbor_displacement : rightNeighborDisplacement = + (if rightNeighborPositive = true then (1 : GaussianInt) else -1) * + BandVectors.1 (normalizedPresentation 0) + (normalizedPresentation rightDirectionSlot.succ) + right_neighbor_cells : normalizedRoot.cells = + (TileTranslation normalizedFixed rightNeighborDisplacement).cells + right_neighbor_empty_anchor : normalizedRoot.cells = ∅ -> normalizedRoot.anchor = + (TileTranslation normalizedFixed rightNeighborDisplacement).anchor + /-- The sign of the first decomposed piece lying on the fixed-tile boundary. -/ + firstBoundarySign : Bool + /-- The sign of the second decomposed piece lying on that boundary. -/ + secondBoundarySign : Bool + boundary_signs : + (rightNeighborPositive = true ∧ firstBoundarySign = true ∧ + secondBoundarySign = false) ∨ + (rightNeighborPositive = false ∧ firstBoundarySign = false ∧ + secondBoundarySign = true) + first_boundary_cells : (pieces rightFirstSlot firstBoundarySign).cells = + (TileTranslation (layout.P rightFirstSlot firstBoundarySign) + rightNeighborDisplacement).cells + first_boundary_empty_anchor : + (pieces rightFirstSlot firstBoundarySign).cells = ∅ -> + (pieces rightFirstSlot firstBoundarySign).anchor = + (TileTranslation (layout.P rightFirstSlot firstBoundarySign) + rightNeighborDisplacement).anchor + first_boundary_footprint : + FootprintVertices (pieces rightFirstSlot firstBoundarySign) = + FootprintVertices + (TileTranslation (layout.P rightFirstSlot firstBoundarySign) + rightNeighborDisplacement) + first_boundary_domain : + ((functions rightFirstSlot firstBoundarySign).domain : Set GaussianInt) = + FootprintVertices + (TileTranslation (layout.P rightFirstSlot firstBoundarySign) + rightNeighborDisplacement) + second_boundary_cells : (pieces rightSecondSlot secondBoundarySign).cells = + (TileTranslation (layout.P rightSecondSlot secondBoundarySign) + rightNeighborDisplacement).cells + second_boundary_empty_anchor : + (pieces rightSecondSlot secondBoundarySign).cells = ∅ -> + (pieces rightSecondSlot secondBoundarySign).anchor = + (TileTranslation (layout.P rightSecondSlot secondBoundarySign) + rightNeighborDisplacement).anchor + second_boundary_footprint : + FootprintVertices (pieces rightSecondSlot secondBoundarySign) = + FootprintVertices + (TileTranslation (layout.P rightSecondSlot secondBoundarySign) + rightNeighborDisplacement) + second_boundary_domain : + ((functions rightSecondSlot secondBoundarySign).domain : Set GaussianInt) = + FootprintVertices + (TileTranslation (layout.P rightSecondSlot secondBoundarySign) + rightNeighborDisplacement) + normalized_star : forall y, + y = normalizedPoint ∨ y = normalizedPoint + 1 ∨ + y = normalizedPoint - 1 ∨ y = normalizedPoint + ⟨0, 1⟩ ∨ + y = normalizedPoint - ⟨0, 1⟩ -> + y ∈ FootprintVertices normalizedRoot ∨ + y ∈ FootprintVertices normalizedFixed + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean new file mode 100644 index 0000000000..9b84bcf09a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean @@ -0,0 +1,861 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5658T1FivePointDomainCoverSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizationCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandOrderedGeneralRightNormalizationCertificateExists] + +/-! +# BandOrderedGeneralRightNormalizationCertificateExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RightNormalizationGeometry + +private theorem hqrotSemi : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → (∀ (r : Fin (3 : ℕ)), + ∀ (g : BandPackingSymmetry), ( + let q' := BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 + : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : + FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : + DiamondParameter), (1 : ℕ) < K.1 ∧ q' = DiamondRecursiveQuadruple K) (Nonempty + (BandOrderedGeneralConfiguration q')))) → ( + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + SemiProperQuadruple qrot)) ) := by + classical + intro q hq r g hregime qrot + fin_cases r + · convert hq.1 using 1; funext j; fin_cases j <;> simp [qrot] + · convert SemiProperQuadruple.rotate hq.1 using 1; + funext j; fin_cases j <;> simp [qrot] + · convert SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate hq.1) using 1; + funext j; fin_cases j <;> simp [qrot] + +private theorem hqrot : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → (∀ (r : Fin (3 : ℕ)), + ∀ (g : BandPackingSymmetry), ( + let q' := BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 + : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : + FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : + DiamondParameter), (1 : ℕ) < K.1 ∧ q' = DiamondRecursiveQuadruple K) (Nonempty + (BandOrderedGeneralConfiguration q')))) → ( + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + (SemiProperQuadruple qrot) → (ProperBandQuadruple qrot))) ) := by + classical + intro q hq r g hregime qrot hqrotSemi + refine ⟨hqrotSemi, ?_⟩ + intro j + fin_cases r <;> fin_cases j <;> simp [qrot] + · simpa using hq.2 (0 : Fin 3) + · simpa using hq.2 (1 : Fin 3) + · simpa using hq.2 (2 : Fin 3) + · simpa using hq.2 (1 : Fin 3) + · simpa using hq.2 (2 : Fin 3) + · simpa using hq.2 (0 : Fin 3) + · simpa using hq.2 (2 : Fin 3) + · simpa using hq.2 (0 : Fin 3) + · simpa using hq.2 (1 : Fin 3) + +private theorem hgeneral : + (by + classical + exact + ∀ (C : BandCircle), (¬((∃ (g : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction g (FordCircleCoordinate P.p P.q) = C.1.1) ∨ ∃ (g : + BandPackingSymmetry) (K : DiamondParameter), BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ))) = C.1.1)) → (∀ (q : Fin (4 : ℕ) → + CircleCoordinates), (q (0 : Fin (4 : ℕ)) = C.1.1) → (∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), ( + let q' := BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 + : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : + FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : + DiamondParameter), (1 : ℕ) < K.1 ∧ q' = DiamondRecursiveQuadruple K) (Nonempty + (BandOrderedGeneralConfiguration q')))) → ( + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + Nonempty (BandOrderedGeneralConfiguration qbar)))) ) := by + classical + intro C horbit q hqC r g hregime qrot qbar + dsimp [qbar, qrot] at hregime + rcases hregime with hford | hrest + · exfalso + rcases hford.1 with ⟨P, _, heq⟩ + obtain ⟨ginv, hinv, _, _, _, _, _, _, _, _, _⟩ := + BandPackingSymmetryInversePhaseCancellation.2 g + apply horbit + left + refine ⟨ginv, P, ?_⟩ + calc + BandPackingSymmetryCircleAction ginv (FordCircleCoordinate P.p P.q) = + BandPackingSymmetryCircleAction ginv + (BandPackingSymmetryCircleAction g C.1.1) := by + have h0 := congrFun heq 0 + simpa [BandPackingSymmetryQuadrupleAction, + FordRecursiveQuadruple, hqC] using congrArg + (BandPackingSymmetryCircleAction ginv) h0.symm + _ = C.1.1 := hinv _ + · rcases hrest.1 with hdiamond | hgeneral + · exfalso + rcases hdiamond.1 with ⟨K, _, heq⟩ + obtain ⟨ginv, hinv, _, _, _, _, _, _, _, _, _⟩ := + BandPackingSymmetryInversePhaseCancellation.2 g + apply horbit + right + refine ⟨ginv, K, ?_⟩ + calc + BandPackingSymmetryCircleAction ginv + (DiamondRecursiveQuadruple K 0) = + BandPackingSymmetryCircleAction ginv + (BandPackingSymmetryCircleAction g C.1.1) := by + have h0 := congrFun heq 0 + simpa [BandPackingSymmetryQuadrupleAction, hqC] using congrArg + (BandPackingSymmetryCircleAction ginv) h0.symm + _ = C.1.1 := hinv _ + · exact hgeneral.1 + +private theorem hcentRot : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i₀ : + Fin (3 : ℕ)), ∀ (e₀ : Bool), (TileCentroid N - TileCentroid T = (if e₀ = true then (1 + : ℝ) else (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + i₀.succ))) → (∀ (r : Fin (3 : ℕ)), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i₀ - r + (qrot irot.succ = q i₀.succ) → (TileCentroid N - TileCentroid T = (if e₀ = true then (1 : + Real) else -1) • GaussianRealPoint (BandVectors.1 (qrot 0) (qrot irot.succ)))) ) := by + classical + intro T N q i₀ e₀ hcent r qrot irot hrotParent + simpa [qrot, hrotParent] using hcent + +private theorem hslopeReRot : + (by + classical + exact + ∀ (pT : ℝ × ℝ), ∀ (pN : ℝ × ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i₀ : Fin (3 : + ℕ)), ∀ (e₀ : Bool), (pN.1 - pT.1 = (if e₀ = true then (1 : ℝ) else (-1 : ℝ)) * + (↑(BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i₀.succ)).re : ℝ)) → (∀ (r : Fin (3 : ℕ)), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i₀ - r + (qrot irot.succ = q i₀.succ) → (pN.1 - pT.1 = (if e₀ = true then (1 : Real) else -1) * + (BandVectors.2 (qrot 0) (qrot irot.succ)).re)) ) := by + classical + intro pT pN q i₀ e₀ hslopeRe r qrot irot hrotParent + simpa [qrot, hrotParent] using hslopeRe + +private theorem hslopeImRot : + (by + classical + exact + ∀ (pT : ℝ × ℝ), ∀ (pN : ℝ × ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i₀ : Fin (3 : + ℕ)), ∀ (e₀ : Bool), (pN.2 - pT.2 = (if e₀ = true then (1 : ℝ) else (-1 : ℝ)) * + (↑(BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i₀.succ)).im : ℝ)) → (∀ (r : Fin (3 : ℕ)), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i₀ - r + (qrot irot.succ = q i₀.succ) → (pN.2 - pT.2 = (if e₀ = true then (1 : Real) else -1) * + (BandVectors.2 (qrot 0) (qrot irot.succ)).im)) ) := by + classical + intro pT pN q i₀ e₀ hslopeIm r qrot irot hrotParent + simpa [qrot, hrotParent] using hslopeIm + +private theorem hcentBar' : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i₀ : + Fin (3 : ℕ)), ∀ (e₀ : Bool), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i₀ - r + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (negative : Bool), (TileCentroid (BandPackingSymmetryTileAction g N) - TileCentroid + (BandPackingSymmetryTileAction g T) = (if (e₀ ^^ negative ^^ + BandPackingSymmetryReversesOrientation g) = true then (1 : ℝ) else (-1 : ℝ)) • + GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin + (4 : ℕ))) (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ))) → ( + let reverse := BandPackingSymmetryReversesOrientation g + let idir : Fin 3 := if reverse then -irot else irot + let ebar : Bool := xor (xor e₀ negative) reverse + let positive : Bool := !ebar + TileCentroid (BandPackingSymmetryTileAction g N) - TileCentroid + (BandPackingSymmetryTileAction g T) = (if positive = true then (-1 : Real) else 1) • + GaussianRealPoint (BandVectors.1 (qbar 0) (qbar idir.succ))) ) := by + classical + intro T N q i₀ e₀ r g qrot irot qbar negative hcentBar reverse idir ebar positive + simpa [qbar, reverse, idir, ebar, positive] using hcentBar + +private theorem hslopeReBar' : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i₀ : Fin (3 : ℕ)), ∀ (e₀ : Bool), ∀ (r : Fin + (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i₀ - r + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (negative : Bool), ∀ (pTbar : ℝ × ℝ), ∀ (pNbar : ℝ × ℝ), (pNbar.1 - pTbar.1 = (if (e₀ + ^^ negative ^^ BandPackingSymmetryReversesOrientation g) = true then (1 : ℝ) else (-1 + : ℝ)) * (↑(BandVectors.2 (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : + ℕ))) (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ)).re : ℝ)) + → ( + let reverse := BandPackingSymmetryReversesOrientation g + let idir : Fin 3 := if reverse then -irot else irot + let ebar : Bool := xor (xor e₀ negative) reverse + let positive : Bool := !ebar + pNbar.1 - pTbar.1 = (if positive = true then (-1 : Real) else 1) * (BandVectors.2 (qbar + 0) (qbar idir.succ)).re) ) := by + classical + intro q i₀ e₀ r g qrot irot qbar negative pTbar pNbar hslopeReBar reverse idir ebar positive + simpa [qbar, reverse, idir, ebar, positive] using hslopeReBar + +private theorem hslopeImBar' : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i₀ : Fin (3 : ℕ)), ∀ (e₀ : Bool), ∀ (r : Fin + (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i₀ - r + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (negative : Bool), ∀ (pTbar : ℝ × ℝ), ∀ (pNbar : ℝ × ℝ), (pNbar.2 - pTbar.2 = (if (e₀ + ^^ negative ^^ BandPackingSymmetryReversesOrientation g) = true then (1 : ℝ) else (-1 + : ℝ)) * (↑(BandVectors.2 (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : + ℕ))) (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ)).im : ℝ)) + → ( + let reverse := BandPackingSymmetryReversesOrientation g + let idir : Fin 3 := if reverse then -irot else irot + let ebar : Bool := xor (xor e₀ negative) reverse + let positive : Bool := !ebar + pNbar.2 - pTbar.2 = (if positive = true then (-1 : Real) else 1) * (BandVectors.2 (qbar + 0) (qbar idir.succ)).im) ) := by + classical + intro q i₀ e₀ r g qrot irot qbar negative pTbar pNbar hslopeImBar reverse idir ebar positive + simpa [qbar, reverse, idir, ebar, positive] using hslopeImBar + +private theorem hxTbar : + (by + classical + exact + ∀ (h : PartialOdometer), (PartialOdometer) → (∀ (x : GaussianInt), (x ∈ h.domain) → (∀ (g + : BandPackingSymmetry), + let hbar := BandPackingSymmetryPartialOdometerAction g h + let xbar := BandPackingSymmetryVectorAction g x + xbar ∈ hbar.domain)) ) := by + classical + intro h k x hxT g hbar xbar + have hdom := (BandPackingSymmetryPartialOdometerActionFormulas g h k).1 + have hxset : BandPackingSymmetryVectorAction g x ∈ + ((BandPackingSymmetryPartialOdometerAction g h).domain : + Set GaussianInt) := by + rw [hdom] + exact ⟨x, hxT, rfl⟩ + exact hxset + +private theorem hxNbar : + (by + classical + exact + (PartialOdometer) → (∀ (k : PartialOdometer), ∀ (x : GaussianInt), (x ∈ k.domain) → (∀ (g + : BandPackingSymmetry), + let kbar := BandPackingSymmetryPartialOdometerAction g k + let xbar := BandPackingSymmetryVectorAction g x + xbar ∈ kbar.domain)) ) := by + classical + intro h k x hxN g kbar xbar + have hdom := (BandPackingSymmetryPartialOdometerActionFormulas g k h).1 + have hxset : BandPackingSymmetryVectorAction g x ∈ + ((BandPackingSymmetryPartialOdometerAction g k).domain : + Set GaussianInt) := by + rw [hdom] + exact ⟨x, hxN, rfl⟩ + exact hxset + +private theorem hsmallT1 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (q' : Fin 4 → CircleCoordinates), ∀ (T' : ProtoTile), ∀ (S' : Fin 3 → Bool → + ProtoTile), ProperBandQuadruple q' → BandPrototile (q' 0) T' → (∀ i, ∀ s, + BandSubtileOccurrence q' T' i s (S' i s)) → (∀ z, z ∈ T'.cells ↔ ∃ i s, z ∈ (S' i + s).cells) → Int.toNat (q' 0).1 < Int.toNat (qbar 0).1 → LatticeTile T' ∧ TileArea T' + = Int.toNat (q' 0).1 ∧ ∀ i, ∀ s, LatticeTile (TileCellComplement T' (S' i s)) ∧ + TileTouching (TileCellComplement T' (S' i s)) (S' i s) ) := by + classical + intro q r g qrot qbar q' T' S' hq' hT' hocc hcells _ + have hI := BandTileSimultaneousInduction q' hq' T' hT' + exact ⟨hI.1, hI.2.1, hI.2.2.1 S' hocc hcells⟩ + +private theorem hsmallT2 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (D : CircleCoordinates), ∀ (U : ProtoTile), BandPrototile D U → Int.toNat D.1 < + Int.toNat (qbar 0).1 → QuarterTurnSymmetric U ) := by + classical + intro q r g qrot qbar D U hU _ + cases hU with + | line w z hw => + intro p + simp [TileRealization, TileCentroid] + | unit z a anchor => + intro p + have hc : TileCentroid (⟨{a}, anchor⟩ : ProtoTile) = + (((a.re : Int) : Real) + (1 / 2 : Real), + ((a.im : Int) : Real) + (1 / 2 : Real)) := by + simp [TileCentroid] + rw [hc] + rcases p with ⟨px, py⟩ + simp only [TileRealization, Finset.mem_singleton, Set.mem_iUnion] + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor + · rintro ⟨b, rfl, hlo, hhi⟩ + refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> + linarith [hlo.1, hlo.2, hhi.1, hhi.2] + · rintro ⟨b, rfl, hlo, hhi⟩ + refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> + linarith [hlo.1, hlo.2, hhi.1, hhi.2] + | @decompose q' hq' S' U' hS hcells hfoot hcent => + exact (BandTileSimultaneousInduction q' hq' U + (.decompose hq' hS hcells hfoot hcent)).2.2.2.1 + +private theorem hsmallT4 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (q' : Fin 4 → CircleCoordinates), ∀ (T' : ProtoTile), ∀ (U : ProtoTile), + ProperBandQuadruple q' → BandPrototile (q' 0) T' → Int.toNat (q' 0).1 < Int.toNat + (qbar 0).1 → 1 < (q' 0).1 → ∀ i : Fin 3, BandPrototile (q' i.succ) U → TileCentroid U + - TileCentroid T' = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q' i.succ) + (q' 0)) + GaussianRealPoint (BandVectors.1 (q' 0) (q' i.succ))) → TouchingTriple T' + (TileTranslation T' (BandVectors.1 (q' i.succ) (q' 0))) U ) := by + classical + intro q r g qrot qbar q' T' U hq' hT' _ hlarge i hU hcentU + exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.1 + hlarge i U hU hcentU + +private theorem hsmallT5 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (q' : Fin 4 → CircleCoordinates), ∀ (T' : ProtoTile), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), ProperBandQuadruple q' → BandPrototile (q' 0) T' → Int.toNat (q' 0).1 < + Int.toNat (qbar 0).1 → ∀ i : Fin 3, BandPrototile (q' i.succ) U → BandPrototile (q' + ((i + 1).succ)) V → TileCentroid U - TileCentroid T' = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q' i.succ) (q' 0)) + GaussianRealPoint + (BandVectors.1 (q' 0) (q' i.succ))) → TileCentroid V - TileCentroid T' = (1 / 2 : + Real) • (GaussianRealPoint (BandVectors.1 (q' ((i + 1).succ)) (q' 0)) - + GaussianRealPoint (BandVectors.1 (q' 0) (q' ((i + 1).succ)))) → TouchingTriple T' U V + ) := by + classical + intro q r g qrot qbar q' T' U V hq' hT' _ i hU hV hcentU hcentV + exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.2.1 + i U V hU hV hcentU hcentV + +private theorem hadjbar : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), ∀ + (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i₀ : Fin (3 : ℕ)), ∀ (e₀ : Bool), ∀ (r : + Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i₀ - r + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (hqbar : ProperBandQuadruple qbar), ∀ (negative : Bool), ∀ (pTbar : ℝ × ℝ), ∀ (pNbar : + ℝ × ℝ), (TileOdometer (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryTileAction g T) (BandPackingSymmetryPartialOdometerAction g h)) → + ((TileOdometer (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryTileAction g N) (BandPackingSymmetryPartialOdometerAction g k)) → + ((PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = some pTbar) → + ((PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g k) = some pNbar) → + ((TileCentroid (BandPackingSymmetryTileAction g N) - TileCentroid + (BandPackingSymmetryTileAction g T) = (if (e₀ ^^ negative ^^ + BandPackingSymmetryReversesOrientation g) = true then (1 : ℝ) else (-1 : ℝ)) • + GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin + (4 : ℕ))) (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ))) → + ((pNbar.1 - pTbar.1 = (if (e₀ ^^ negative ^^ BandPackingSymmetryReversesOrientation + g) = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 + (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ)).re : ℝ)) + → ((pNbar.2 - pTbar.2 = (if (e₀ ^^ negative ^^ BandPackingSymmetryReversesOrientation + g) = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 + (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ)).im : ℝ)) + → ( + let Tbar := BandPackingSymmetryTileAction g T + let Nbar := BandPackingSymmetryTileAction g N + let hbar := BandPackingSymmetryPartialOdometerAction g h + let kbar := BandPackingSymmetryPartialOdometerAction g k + ∀ (hqbarPos : 0 < (qbar 0).1), + let Cbar : BandCircle := + ⟨⟨qbar 0, ⟨Or.inl hqbarPos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbarPos⟩ + RightLatticeAdjacent Cbar Tbar Nbar hbar kbar))))))) ) := by + classical + intro T N h k q i₀ e₀ r g qrot irot qbar hqbar negative pTbar pNbar hOTbar hONbar hpTbar hpNbar + hcentBar hslopeReBar hslopeImBar Tbar Nbar hbar kbar hqbarPos Cbar + let reverse := BandPackingSymmetryReversesOrientation g + let idir : Fin 3 := if reverse then -irot else irot + let ebar : Bool := xor (xor e₀ negative) reverse + refine ⟨hOTbar, hONbar, pTbar, pNbar, hpTbar, hpNbar, + qbar, idir, ebar, hqbar, rfl, ?_, ?_, ?_⟩ + · simpa [qbar, reverse, idir, ebar] using hcentBar + · simpa [qbar, reverse, idir, ebar] using hslopeReBar + · simpa [qbar, reverse, idir, ebar] using hslopeImBar + +private theorem houterCentroid : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i₀ : + Fin (3 : ℕ)), ∀ (e₀ : Bool), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i₀ - r + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (negative : Bool), ∀ (pTbar : ℝ × ℝ), ∀ (pNbar : ℝ × ℝ), + let reverse := BandPackingSymmetryReversesOrientation g + let idir : Fin 3 := if reverse then -irot else irot + let ebar : Bool := xor (xor e₀ negative) reverse + let positive : Bool := !ebar + (TileCentroid (BandPackingSymmetryTileAction g N) - TileCentroid + (BandPackingSymmetryTileAction g T) = (if positive = true then (-1 : Real) else 1) • + GaussianRealPoint (BandVectors.1 (qbar 0) (qbar idir.succ))) → ((pNbar.1 - pTbar.1 = + (if positive = true then (-1 : Real) else 1) * (BandVectors.2 (qbar 0) (qbar + idir.succ)).re) → ((pNbar.2 - pTbar.2 = (if positive = true then (-1 : Real) else 1) + * (BandVectors.2 (qbar 0) (qbar idir.succ)).im) → ( + let Tbar := BandPackingSymmetryTileAction g T + let Nbar := BandPackingSymmetryTileAction g N + let displacement : GaussianInt := + (if positive = true then (1 : GaussianInt) else -1) * + BandVectors.1 (qbar 0) (qbar idir.succ) + TileCentroid Tbar = TileCentroid (TileTranslation Nbar displacement)))) ) := by + classical + intro T N q i₀ e₀ r g qrot irot qbar negative pTbar pNbar reverse idir ebar positive hcentBar' + hslopeReBar' hslopeImBar' Tbar Nbar displacement + rw [(TileTranslationFormulas Nbar displacement).2.2.2.2.1] + have h₁ := congrArg Prod.fst hcentBar' + have h₂ := congrArg Prod.snd hcentBar' + apply Prod.ext <;> rcases positive with (_ | _) <;> + simp [displacement, GaussianRealPoint] at h₁ h₂ ⊢ <;> linarith + +private theorem boundaryData : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i₀ : + Fin (3 : ℕ)), ∀ (e₀ : Bool), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i₀ - r + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (hqbar : ProperBandQuadruple qbar), ∀ (cfg : BandOrderedGeneralConfiguration qbar), ∀ + (negative : Bool), + let reverse := BandPackingSymmetryReversesOrientation g + let idir : Fin 3 := if reverse then -irot else irot + let ebar : Bool := xor (xor e₀ negative) reverse + let positive : Bool := !ebar + let Tbar := BandPackingSymmetryTileAction g T + let Nbar := BandPackingSymmetryTileAction g N + ∀ (hqbarPos : 0 < (qbar 0).1), + let Cbar : BandCircle := + ⟨⟨qbar 0, ⟨Or.inl hqbarPos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbarPos⟩ + ∀ (layout : BandOrderedGeneralLayoutCertificate qbar cfg Cbar Nbar), ∀ (pieces : Fin (3 : + ℕ) → Bool → ProtoTile), ∀ (functions : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : + Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (qbar i.succ) (pieces i s) (functions i s)) + → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (pieces i s) - TileCentroid Tbar + = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (qbar (i + (2 : Fin (3 : ℕ))).succ) (qbar (i + (1 : Fin (3 : + ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (qbar (i + (2 : Fin (3 : ℕ))).succ) + (qbar (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (qbar (i + + (2 : Fin (3 : ℕ))).succ) (qbar (i + (1 : Fin (3 : ℕ))).succ))).1))) → ( + let displacement : GaussianInt := + (if positive = true then (1 : GaussianInt) else -1) * + BandVectors.1 (qbar 0) (qbar idir.succ) + (TileCentroid Tbar = TileCentroid (TileTranslation Nbar displacement)) → (∀ (a : Fin 3), + ∀ (s : Bool), (pieces a s).cells = (TileTranslation (layout.P a s) + displacement).cells ∧ ((pieces a s).cells = ∅ → (pieces a s).anchor = + (TileTranslation (layout.P a s) displacement).anchor) ∧ FootprintVertices (pieces a + s) = FootprintVertices (TileTranslation (layout.P a s) displacement) ∧ ((functions a + s).domain : Set GaussianInt) = FootprintVertices (TileTranslation (layout.P a s) + displacement)))) ) := by + classical + intro T N q i₀ e₀ r g qrot irot qbar hqbar cfg negative reverse idir ebar positive Tbar Nbar + hqbarPos Cbar layout pieces functions hpieceOdometer hpieceCentroid displacement + houterCentroid a s + have hpieceBand : BandPrototile (qbar a.succ) (pieces a s) := + TileOdometerBandPrototile _ _ _ (hpieceOdometer a s) + have hlayoutBand : BandPrototile (qbar a.succ) (layout.P a s) := + (layout.outer_occurrence a s).1 + have htranslatedLayout : + BandPrototile (qbar a.succ) + (TileTranslation (layout.P a s) displacement) := + BandPrototileTranslation _ _ _ hlayoutBand + have hcentroidAlign : TileCentroid (pieces a s) = + TileCentroid (TileTranslation (layout.P a s) displacement) := by + rw [(TileTranslationFormulas (layout.P a s) displacement).2.2.2.2.1] + have hp₁ := congrArg Prod.fst (hpieceCentroid a s) + have hp₂ := congrArg Prod.snd (hpieceCentroid a s) + have hl₁ := congrArg Prod.fst (layout.outer_occurrence a s).2.2 + have hl₂ := congrArg Prod.snd (layout.outer_occurrence a s).2.2 + have hr₁ := congrArg Prod.fst houterCentroid + have hr₂ := congrArg Prod.snd houterCentroid + rw [(TileTranslationFormulas Nbar displacement).2.2.2.2.1] at hr₁ hr₂ + apply Prod.ext <;> simp only [] + · change (TileCentroid (pieces a s)).1 - (TileCentroid Tbar).1 = _ at hp₁ + change (TileCentroid (layout.P a s)).1 - (TileCentroid Nbar).1 = _ at hl₁ + change (TileCentroid Tbar).1 = (TileCentroid Nbar).1 + _ at hr₁ + linarith + · change (TileCentroid (pieces a s)).2 - (TileCentroid Tbar).2 = _ at hp₂ + change (TileCentroid (layout.P a s)).2 - (TileCentroid Nbar).2 = _ at hl₂ + change (TileCentroid Tbar).2 = (TileCentroid Nbar).2 + _ at hr₂ + linarith + have hu := BandPrototileCentroidUnique (qbar a.succ) (pieces a s) + (TileTranslation (layout.P a s) displacement) hpieceBand + htranslatedLayout hcentroidAlign + have ho := ProtoTileObservableExtensionality (pieces a s) + (TileTranslation (layout.P a s) displacement) hu.1 hu.2 + have hparentNonneg := (ProperBandCurvatureStructure qbar hqbar).2.1 a + have hparentPos : 0 < (qbar a.succ).1 := by + have hn := cfg.noLine a.succ + omega + have hd := PositiveCurvatureTileOdometerDomain (qbar a.succ) + (pieces a s) (functions a s) hparentPos (hpieceOdometer a s) + exact ⟨hu.1, hu.2, ho.1, hd.trans ho.1⟩ + +private theorem hslots : + (by + classical + exact + (ProtoTile) → ((ProtoTile) → ((Fin (4 : ℕ) → CircleCoordinates) → (∀ (i₀ : Fin (3 : ℕ)), + ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let irot : Fin 3 := i₀ - r + let reverse := BandPackingSymmetryReversesOrientation g + let idir : Fin 3 := if reverse then -irot else irot + let firstSlot : Fin 3 := idir + 1 + let secondSlot : Fin 3 := idir + 2 + (firstSlot = 0 ∧ secondSlot = 1 ∧ idir = 2) ∨ (firstSlot = 1 ∧ secondSlot = 2 ∧ idir = 0) + ∨ (firstSlot = 2 ∧ secondSlot = 0 ∧ idir = 1)))) ) := by + classical + intro T N q i₀ r g irot reverse idir firstSlot secondSlot + have hi : idir = 0 ∨ idir = 1 ∨ idir = 2 := by omega + rcases hi with hi | hi | hi <;> simp [firstSlot, secondSlot, hi] + +private theorem hsigns : + (by + classical + exact + ∀ (e₀ : Bool), ∀ (g : BandPackingSymmetry), ∀ (negative : Bool), + let reverse := BandPackingSymmetryReversesOrientation g + let ebar : Bool := xor (xor e₀ negative) reverse + let positive : Bool := !ebar + let firstSign : Bool := positive + let secondSign : Bool := !positive + (positive = true ∧ firstSign = true ∧ secondSign = false) ∨ (positive = false ∧ firstSign + = false ∧ secondSign = true) ) := by + classical + intro e₀ g negative reverse ebar positive firstSign secondSign + rcases Bool.eq_false_or_eq_true positive with hp | hp <;> + simp [firstSign, secondSign, hp] + +private theorem hstarFootprint : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), ∀ + (x : GaussianInt), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g + : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + (TileOdometer (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryTileAction g T) (BandPackingSymmetryPartialOdometerAction g h)) → + ((TileOdometer (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryTileAction g N) (BandPackingSymmetryPartialOdometerAction g k)) → ( + let Tbar := BandPackingSymmetryTileAction g T + let Nbar := BandPackingSymmetryTileAction g N + let hbar := BandPackingSymmetryPartialOdometerAction g h + let kbar := BandPackingSymmetryPartialOdometerAction g k + let xbar := BandPackingSymmetryVectorAction g x + (0 < (qbar 0).1) → ((∀ y, y = xbar ∨ y = xbar + 1 ∨ y = xbar - 1 ∨ y = xbar + ⟨0, 1⟩ ∨ y + = xbar - ⟨0, 1⟩ → y ∈ hbar.domain ∨ y ∈ kbar.domain) → (∀ y, y = xbar ∨ y = xbar + 1 + ∨ y = xbar - 1 ∨ y = xbar + ⟨0, 1⟩ ∨ y = xbar - ⟨0, 1⟩ → y ∈ FootprintVertices Tbar ∨ + y ∈ FootprintVertices Nbar)))) ) := by + classical + intro T N h k x q r g qrot qbar hOTbar hONbar Tbar Nbar hbar kbar xbar hqbarPos hstarBarDomain + y hy + have hs := hstarBarDomain y hy + have hdT := PositiveCurvatureTileOdometerDomain (qbar 0) Tbar hbar + hqbarPos hOTbar + have hdN := PositiveCurvatureTileOdometerDomain (qbar 0) Nbar kbar + hqbarPos hONbar + rcases hs with hs | hs + · left + exact (Set.ext_iff.mp hdT y).mp hs + · right + exact (Set.ext_iff.mp hdN y).mp hs + +end RightNormalizationGeometry + +theorem BandOrderedGeneralRightNormalizationCertificateExists + (C : BandCircle) (T N : ProtoTile) (h k : PartialOdometer) + (x : GaussianInt) + (horbit : + ¬ ((exists (g : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = C.1.1) \/ + (exists (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K 0) = C.1.1))) + (hadj : RightLatticeAdjacent C T N h k) + (hxT : x ∈ h.domain) (hxN : x ∈ k.domain) + (hstar : forall y, + y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ h.domain \/ y ∈ k.domain) : + Nonempty (BandOrderedGeneralRightNormalizationCertificate C T N h k x) := by +-- BODY + classical + rcases hadj with + ⟨hOT, hON, pT, pN, hpT, hpN, q, i₀, e₀, hq, hqC, + hcent, hslopeRe, hslopeIm⟩ + obtain ⟨r, g, hregime⟩ := BandRegimeClassification q hq + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + have hqrot := RightNormalizationGeometry.hqrot q hq r g hregime + (RightNormalizationGeometry.hqrotSemi q hq r g hregime) + let irot : Fin 3 := i₀ - r + have hrotParent : qrot irot.succ = q i₀.succ := by + fin_cases r <;> fin_cases i₀ <;> simp [qrot, irot] + have hqrotC : qrot 0 = C.1.1 := by simpa [qrot] using hqC + let qbar := BandPackingSymmetryQuadrupleAction g qrot + have hqbar : ProperBandQuadruple qbar := by + exact BandPackingSymmetryProperCovariance g qrot hqrot + have hqbarC : qbar 0 = BandPackingSymmetryCircleAction g C.1.1 := by + simp [qbar, qrot, BandPackingSymmetryQuadrupleAction, hqC] + have hgeneral := RightNormalizationGeometry.hgeneral C horbit q hqC r g hregime + obtain ⟨cfg⟩ := hgeneral + have hOTrot : TileOdometer (qrot 0) T h := by rw [hqrotC]; exact hOT + have hONrot : TileOdometer (qrot 0) N k := by rw [hqrotC]; exact hON + have hcentRot := RightNormalizationGeometry.hcentRot T N q i₀ e₀ hcent r hrotParent + have hslopeReRot := RightNormalizationGeometry.hslopeReRot pT + pN q i₀ e₀ hslopeRe r hrotParent + have hslopeImRot := RightNormalizationGeometry.hslopeImRot pT + pN q i₀ e₀ hslopeIm r hrotParent + obtain ⟨negative, pTbar, pNbar, hphase, hOTbar, hONbar, + hpTbar, hpNbar, hcentBar, hslopeReBar, hslopeImBar, hcompatBar⟩ := + RightLatticeAdjacentPackingSymmetryTransport g qrot hqrot irot e₀ + T N h k pT pN hOTrot hONrot hpT hpN hcentRot hslopeReRot hslopeImRot + let reverse := BandPackingSymmetryReversesOrientation g + let idir : Fin 3 := if reverse then -irot else irot + let ebar : Bool := xor (xor e₀ negative) reverse + let positive : Bool := !ebar + have hcentBar' := RightNormalizationGeometry.hcentBar' T N q i₀ e₀ r g negative hcentBar + have hslopeReBar' := RightNormalizationGeometry.hslopeReBar' q + i₀ e₀ r g negative pTbar pNbar hslopeReBar + have hslopeImBar' := RightNormalizationGeometry.hslopeImBar' q + i₀ e₀ r g negative pTbar pNbar hslopeImBar + let Tbar := BandPackingSymmetryTileAction g T + let Nbar := BandPackingSymmetryTileAction g N + let hbar := BandPackingSymmetryPartialOdometerAction g h + let kbar := BandPackingSymmetryPartialOdometerAction g k + let xbar := BandPackingSymmetryVectorAction g x + have hxTbar := RightNormalizationGeometry.hxTbar h k x hxT g + have hxNbar := RightNormalizationGeometry.hxNbar h k x hxN g + have hTbarBand : BandPrototile (qbar 0) Tbar := + TileOdometerBandPrototile _ _ _ hOTbar + have hNbarBand : BandPrototile (qbar 0) Nbar := + TileOdometerBandPrototile _ _ _ hONbar + have hTind := BandTileSimultaneousInduction qbar hqbar Tbar hTbarBand + have hNind := BandTileSimultaneousInduction qbar hqbar Nbar hNbarBand + have hsmallT1 := RightNormalizationGeometry.hsmallT1 q r g + have hsmallT2 := RightNormalizationGeometry.hsmallT2 q r g + have hsmallT4 := RightNormalizationGeometry.hsmallT4 q r g + have hsmallT5 := RightNormalizationGeometry.hsmallT5 q r g + have hqbarPos : 0 < (qbar 0).1 := (ProperBandCurvatureStructure qbar hqbar).1 + let Cbar : BandCircle := + ⟨⟨qbar 0, ⟨Or.inl hqbarPos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbarPos⟩ + obtain ⟨layout⟩ := BandOrderedGeneralLayout qbar cfg Cbar + rfl Nbar hNbarBand hsmallT1 hsmallT2 hsmallT4 hsmallT5 + obtain ⟨pieces, functions, hrootBand, hpieceOdometer, hpieceCells, + hpieceFootprint, hpieceCentroid, hfunctionDomains, + hfunctionRestriction, hfunctionCompatibility, hpieceSlope⟩ := + TileOdometerReindexedDecomposition qbar hqbar Tbar hbar + (by linarith [cfg.childLarge]) hOTbar + let displacement : GaussianInt := + (if positive = true then (1 : GaussianInt) else -1) * + BandVectors.1 (qbar 0) (qbar idir.succ) + have houterCentroid := RightNormalizationGeometry.houterCentroid T N q i₀ e₀ r g negative pTbar + pNbar + hcentBar' hslopeReBar' hslopeImBar' + have htranslatedN : + BandPrototile (qbar 0) (TileTranslation Nbar displacement) := + BandPrototileTranslation _ _ _ hNbarBand + have houterUnique := BandPrototileCentroidUnique (qbar 0) Tbar + (TileTranslation Nbar displacement) hTbarBand htranslatedN houterCentroid + have hstarBarDomain : ∀ y, + y = xbar ∨ y = xbar + 1 ∨ y = xbar - 1 ∨ + y = xbar + ⟨0, 1⟩ ∨ y = xbar - ⟨0, 1⟩ → + y ∈ hbar.domain ∨ y ∈ kbar.domain := + P5658T1FivePointDomainCoverSymmetryCovariance g h k x hstar + have boundaryData := RightNormalizationGeometry.boundaryData T N q i₀ e₀ r g hqbar cfg negative + hqbarPos layout pieces functions hpieceOdometer hpieceCentroid houterCentroid + let firstSlot : Fin 3 := idir + 1 + let secondSlot : Fin 3 := idir + 2 + let firstSign : Bool := positive + let secondSign : Bool := !positive + have hfirstData := boundaryData firstSlot firstSign + have hsecondData := boundaryData secondSlot secondSign + refine ⟨{ + presentation := q + presentation_proper := hq + presentation_child := hqC + parentRotation := r + symmetry := g + rotatedPresentation := qrot + rotated_presentation_eq := rfl + normalizedPresentation := qbar + normalized_presentation_eq := rfl + configuration := cfg + normalizedCircle := Cbar + normalized_circle_eq := rfl + normalizedFixedCircle := Cbar + normalized_fixed_circle_eq := hqbarC + normalizedRoot := Tbar + normalizedFixed := Nbar + normalizedRootFunction := hbar + normalizedFixedFunction := kbar + normalizedPoint := xbar + normalized_root_eq := rfl + normalized_fixed_eq := rfl + normalized_root_function_eq := rfl + normalized_fixed_function_eq := rfl + normalized_point_eq := rfl + normalized_point_root_domain := hxTbar + normalized_point_fixed_domain := hxNbar + normalized_root_odometer := hOTbar + normalized_fixed_odometer := hONbar + normalized_root_lattice := hTind.1 + normalized_fixed_lattice := hNind.1 + normalizedRootSlope := pTbar + normalizedFixedSlope := pNbar + normalized_root_slope := hpTbar + normalized_fixed_slope := hpNbar + pieces := pieces + functions := functions + root_band := hrootBand + piece_odometer := hpieceOdometer + piece_cell_cover := hpieceCells + piece_footprint := hpieceFootprint + piece_centroid := hpieceCentroid + function_domain_cover := hfunctionDomains + function_restriction := hfunctionRestriction + function_compatibility := hfunctionCompatibility + piece_slope := hpieceSlope + adjacency := (RightNormalizationGeometry.hadjbar T N h k q i₀ e₀ r g hqbar negative pTbar + pNbar hOTbar hONbar hpTbar hpNbar hcentBar hslopeReBar hslopeImBar hqbarPos) + layout := layout + fixed_quarter_turn := hNind.2.2.2.1 + rightFirstSlot := firstSlot + rightSecondSlot := secondSlot + rightDirectionSlot := idir + right_slots_cyclic := (RightNormalizationGeometry.hslots T N q i₀ r g) + rightNeighborPositive := positive + right_adjacency_centroid := hcentBar' + right_adjacency_slope_real := hslopeReBar' + right_adjacency_slope_imag := hslopeImBar' + rightNeighborDisplacement := displacement + right_neighbor_displacement := rfl + right_neighbor_cells := houterUnique.1 + right_neighbor_empty_anchor := houterUnique.2 + firstBoundarySign := firstSign + secondBoundarySign := secondSign + boundary_signs := (RightNormalizationGeometry.hsigns e₀ g negative) + first_boundary_cells := hfirstData.1 + first_boundary_empty_anchor := hfirstData.2.1 + first_boundary_footprint := hfirstData.2.2.1 + first_boundary_domain := hfirstData.2.2.2 + second_boundary_cells := hsecondData.1 + second_boundary_empty_anchor := hsecondData.2.1 + second_boundary_footprint := hsecondData.2.2.1 + second_boundary_domain := hsecondData.2.2.2 + normalized_star := (RightNormalizationGeometry.hstarFootprint T N h k x q r g hOTbar hONbar + hqbarPos hstarBarDomain) }⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizedBundleExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizedBundleExists.lean new file mode 100644 index 0000000000..990481b84f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizedBundleExists.lean @@ -0,0 +1,180 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightInterfaceCertificateExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizationCertificateExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightRoutingCertificateExists + +-- [TABLET NODE: BandOrderedGeneralRightNormalizedBundleExists] + +/-! +# BandOrderedGeneralRightNormalizedBundleExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralRightNormalizedBundleExists + (C : BandCircle) (T N : ProtoTile) (h k : PartialOdometer) + (x : GaussianInt) + (horbit : + ¬ ((exists (g : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = C.1.1) \/ + (exists (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K 0) = C.1.1))) + (hadj : RightLatticeAdjacent C T N h k) + (hxT : x ∈ h.domain) (hxN : x ∈ k.domain) + (hstar : forall y, + y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ h.domain \/ y ∈ k.domain) : + exists bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T N h k x, + exists placement : BandOrderedGeneralRightPlacement + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions + bundle.selectedSlot bundle.selectedSign bundle.routedDirection, + bundle.placement = Sum.inl placement := by +-- BODY + obtain ⟨normalization⟩ := + BandOrderedGeneralRightNormalizationCertificateExists C T N h k x + horbit hadj hxT hxN hstar + obtain ⟨interface⟩ := + BandOrderedGeneralRightInterfaceCertificateExists normalization + obtain ⟨routing⟩ := + BandOrderedGeneralRightRoutingCertificateExists interface + let placement : BandOrderedGeneralRightPlacement + normalization.normalizedPresentation normalization.configuration + normalization.normalizedCircle normalization.normalizedRoot + normalization.normalizedFixed normalization.normalizedRootFunction + normalization.normalizedFixedFunction normalization.normalizedPoint + normalization.pieces normalization.functions routing.selectedSlot + routing.selectedSign routing.routedDirection := + { adjacency := normalization.adjacency + layout := normalization.layout + rightFirstSlot := normalization.rightFirstSlot + rightSecondSlot := normalization.rightSecondSlot + rightDirectionSlot := normalization.rightDirectionSlot + right_slots_cyclic := normalization.right_slots_cyclic + rightNeighborPositive := normalization.rightNeighborPositive + rightRootSlope := normalization.normalizedRootSlope + rightFixedSlope := normalization.normalizedFixedSlope + right_root_slope := normalization.normalized_root_slope + right_fixed_slope := normalization.normalized_fixed_slope + right_adjacency_centroid := normalization.right_adjacency_centroid + right_adjacency_slope_real := normalization.right_adjacency_slope_real + right_adjacency_slope_imag := normalization.right_adjacency_slope_imag + rightNeighborDisplacement := normalization.rightNeighborDisplacement + right_neighbor_displacement := normalization.right_neighbor_displacement + right_neighbor_cells := normalization.right_neighbor_cells + right_neighbor_empty_anchor := normalization.right_neighbor_empty_anchor + firstBoundarySign := normalization.firstBoundarySign + secondBoundarySign := normalization.secondBoundarySign + boundary_signs := normalization.boundary_signs + first_boundary_cells := normalization.first_boundary_cells + first_boundary_empty_anchor := normalization.first_boundary_empty_anchor + first_boundary_footprint := normalization.first_boundary_footprint + first_boundary_domain := normalization.first_boundary_domain + second_boundary_cells := normalization.second_boundary_cells + second_boundary_empty_anchor := normalization.second_boundary_empty_anchor + second_boundary_footprint := normalization.second_boundary_footprint + second_boundary_domain := normalization.second_boundary_domain + selected_boundary_piece := routing.selected_boundary_piece + exteriorIndex := routing.exteriorIndex + centralIndex := routing.centralIndex + exterior_index := routing.exterior_index + central_index := routing.central_index + selected_exterior_cells := routing.selected_exterior_cells + selected_exterior_empty_anchor := routing.selected_exterior_empty_anchor + selected_exterior_footprint := routing.selected_exterior_footprint + selected_exterior_domain := routing.selected_exterior_domain + exterior_routed_cell := routing.exterior_routed_cell + central_routed_cell := routing.central_routed_cell + selected_star := routing.selected_star } + let bundle : BandOrderedGeneralNormalizedOccurrenceBundle C C T N h k x := + { presentation := normalization.presentation + presentation_proper := normalization.presentation_proper + presentation_child := normalization.presentation_child + parentRotation := normalization.parentRotation + symmetry := normalization.symmetry + rotatedPresentation := normalization.rotatedPresentation + rotated_presentation_eq := normalization.rotated_presentation_eq + normalizedPresentation := normalization.normalizedPresentation + normalized_presentation_eq := normalization.normalized_presentation_eq + configuration := normalization.configuration + normalizedCircle := normalization.normalizedCircle + normalized_circle_eq := normalization.normalized_circle_eq + normalizedFixedCircle := normalization.normalizedFixedCircle + normalized_fixed_circle_eq := normalization.normalized_fixed_circle_eq + normalizedRoot := normalization.normalizedRoot + normalizedFixed := normalization.normalizedFixed + normalizedRootFunction := normalization.normalizedRootFunction + normalizedFixedFunction := normalization.normalizedFixedFunction + normalizedPoint := normalization.normalizedPoint + normalized_root_eq := normalization.normalized_root_eq + normalized_fixed_eq := normalization.normalized_fixed_eq + normalized_root_function_eq := normalization.normalized_root_function_eq + normalized_fixed_function_eq := normalization.normalized_fixed_function_eq + normalized_point_eq := normalization.normalized_point_eq + normalized_root_odometer := normalization.normalized_root_odometer + normalized_fixed_odometer := normalization.normalized_fixed_odometer + normalizedRootSlope := normalization.normalizedRootSlope + normalizedFixedSlope := normalization.normalizedFixedSlope + normalized_root_slope := normalization.normalized_root_slope + normalized_fixed_slope := normalization.normalized_fixed_slope + pieces := normalization.pieces + functions := normalization.functions + root_band := normalization.root_band + piece_odometer := normalization.piece_odometer + piece_cell_cover := normalization.piece_cell_cover + piece_footprint := normalization.piece_footprint + piece_centroid := normalization.piece_centroid + function_domain_cover := normalization.function_domain_cover + function_restriction := normalization.function_restriction + function_compatibility := normalization.function_compatibility + piece_slope := normalization.piece_slope + startCompanion := interface.startCompanion + endCompanion := interface.endCompanion + startData := interface.startData + endData := interface.endData + interface_endpoints := interface.interface_endpoints + root_lattice := interface.root_lattice + fixed_lattice := interface.fixed_lattice + start_lattice := interface.start_lattice + end_lattice := interface.end_lattice + root_fixed_disjoint := interface.root_fixed_disjoint + root_start_disjoint := interface.root_start_disjoint + fixed_start_disjoint := interface.fixed_start_disjoint + root_end_disjoint := interface.root_end_disjoint + fixed_end_disjoint := interface.fixed_end_disjoint + start_touching := interface.start_touching + end_touching := interface.end_touching + edgeAtPoint := routing.edgeAtPoint + root_induced := routing.root_induced + fixed_induced := routing.fixed_induced + normalized_star := normalization.normalized_star + routedDirection := routing.routedDirection + routed_root_cell := routing.routed_root_cell + routed_fixed_cell := routing.routed_fixed_cell + selectedSlot := routing.selectedSlot + selectedSign := routing.selectedSign + selected_piece_cell := routing.selected_piece_cell + placement := Sum.inl placement } + exact ⟨bundle, placement, rfl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightOuterMarkingCriterion.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightOuterMarkingCriterion.lean new file mode 100644 index 0000000000..f37a1606dd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightOuterMarkingCriterion.lean @@ -0,0 +1,188 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightSelectedRowGeometry +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.P5478T1ExteriorPlacementIndex +public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceExists +public import LeanPool.ApollonianSuperharmonic.P5485T1OtherCompanionCoordinates +public import LeanPool.ApollonianSuperharmonic.P5485T1RoutedInterfaceAvoidance +public import LeanPool.ApollonianSuperharmonic.P5485T1FullInterfaceMarking + +-- [TABLET NODE: BandOrderedGeneralRightOuterMarkingCriterion] + +/-! +# BandOrderedGeneralRightOuterMarkingCriterion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralRightOuterMarkingCriterion + (C D : BandCircle) (T N : ProtoTile) (h k : PartialOdometer) + (x : GaussianInt) + (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x) + (placement : BandOrderedGeneralRightPlacement bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction + bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces + bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection) + (selectedEdge : Finset GaussianInt) + (hx : bundle.normalizedPoint ∈ selectedEdge) + (hedge : selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.centralIndex)) + (row : BandOrderedGeneralSelectedContactRow + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout + placement.exteriorIndex placement.centralIndex) : + let q := bundle.normalizedPresentation + let oldRight := TileTranslation bundle.normalizedFixed + ((if placement.rightNeighborPositive = true then (-1 : GaussianInt) + else 1) * + BandVectors.1 (q 0) (q bundle.selectedSlot.succ)) + (¬ (∀ z, z = bundle.normalizedPoint ∨ + z = bundle.normalizedPoint - 1 ∨ + z = bundle.normalizedPoint - ⟨0, 1⟩ ∨ + z = bundle.normalizedPoint - 1 - ⟨0, 1⟩ → + z ∈ bundle.normalizedRoot.cells ∨ + z ∈ bundle.normalizedFixed.cells) ↔ + bundle.normalizedPoint ∈ FootprintVertices oldRight) := by +-- BODY + classical + let q := bundle.normalizedPresentation + let cert := placement.layout + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let other := if bundle.selectedSlot = placement.rightFirstSlot then + placement.rightSecondSlot else placement.rightFirstSlot + let otherTile := TileTranslation bundle.normalizedFixed + ((if placement.rightNeighborPositive then (-1 : GaussianInt) else 1) * + BandVectors.1 (q 0) (q other.succ)) + let coord : Int × Int := match other.val with + | 0 => (1, 0) | 1 => (0, 1) | _ => (-1, -1) + let scale : Int := if placement.rightNeighborPositive then -1 else 1 + let m := scale * coord.1 + let n := scale * coord.2 + have hselected : + (bundle.selectedSlot = placement.rightFirstSlot ∧ + bundle.selectedSign = placement.rightNeighborPositive) ∨ + (bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = !placement.rightNeighborPositive) := by + rcases placement.boundary_signs with ⟨hp, hf, hs⟩ | ⟨hp, hf, hs⟩ + all_goals rcases placement.selected_boundary_piece with h | h + all_goals simp_all + have coordinates := P5485T1OtherCompanionCoordinates q bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed cert + placement.exteriorIndex placement.centralIndex row + placement.rightFirstSlot placement.rightSecondSlot placement.rightDirectionSlot + bundle.selectedSlot placement.rightNeighborPositive bundle.selectedSign + placement.right_slots_cyclic hselected + (P5478T1ExteriorPlacementIndex C D T N h k x bundle placement) + change ((if placement.rightNeighborPositive then (-1 : GaussianInt) else 1) * + BandVectors.1 (q 0) (q other.succ) = + (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v) ∧ _ at coordinates + obtain ⟨data⟩ := P4418T3SelectedInterfaceExists q bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed cert + placement.exteriorIndex placement.centralIndex row + have parent_cells (i : Fin 3) (s : Bool) (d c : GaussianInt) + (hc : c ∈ (TileTranslation (cert.P i s) d).cells) : + c ∈ (TileTranslation bundle.normalizedFixed d).cells := by + rw [(TileTranslationFormulas _ d).1] at hc ⊢ + obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp hc + exact Finset.mem_image.mpr ⟨y, (cert.outer_union y).2 ⟨i, s, hy⟩, heq⟩ + have original_block (o : PeriodicSubtileIndex) (c : GaussianInt) + (hc : c ∈ (occurrence o).cells) : + c ∈ (TileTranslation bundle.normalizedFixed + ((o.first : GaussianInt) * cert.u + (o.second : GaussianInt) * cert.v)).cells := by + rcases o with ⟨label, r, s⟩ + cases label with + | A => exact parent_cells 0 true _ c hc + | B => exact parent_cells 0 false _ c hc + | C => exact parent_cells 1 true _ c hc + | D => exact parent_cells 1 false _ c hc + | E => exact parent_cells 2 true _ c hc + | F => exact parent_cells 2 false _ c hc + have block_disjoint (o : PeriodicSubtileIndex) + (hcoord : (o.first, o.second) ≠ (m, n)) : + Disjoint (occurrence o).cells otherTile.cells := by + have hblocks := (BandOrderedGeneralPeriodicBlockCells q bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed cert).2 + o.first o.second m n hcoord + rw [Finset.disjoint_left] + intro c hc ho + apply Finset.disjoint_left.mp hblocks (original_block o c hc) + change c ∈ (TileTranslation bundle.normalizedFixed _).cells at ho + rwa [coordinates.1] at ho + have other_lattice : LatticeTile otherTile := + (TileDiskAreaCovariance bundle.normalizedFixed _).1.mp bundle.fixed_lattice + have not_other : bundle.normalizedPoint ∉ FootprintVertices otherTile := + P5485T1RoutedInterfaceAvoidance _ _ _ _ otherTile data + (LatticeTileGridStructure otherTile other_lattice).1.1 + (block_disjoint _ coordinates.2.1) + (block_disjoint _ coordinates.2.2.1) + (block_disjoint _ coordinates.2.2.2.1) + (block_disjoint _ coordinates.2.2.2.2) + bundle.normalizedPoint bundle.routedDirection selectedEdge hx hedge + placement.exterior_routed_cell placement.central_routed_cell + let oldRight := TileTranslation bundle.normalizedFixed + ((if placement.rightNeighborPositive = true then (-1 : GaussianInt) else 1) * + BandVectors.1 (q 0) (q bundle.selectedSlot.succ)) + have finish (U V : ProtoTile) + (eU : ExactTileInterfaceTriple bundle.normalizedRoot bundle.normalizedFixed U) + (eV : ExactTileInterfaceTriple bundle.normalizedRoot bundle.normalizedFixed V) + (hU : U = oldRight) (hV : V = otherTile) + (hUl : LatticeTile U) + (hTU : Disjoint bundle.normalizedRoot.cells U.cells) + (hNU : Disjoint bundle.normalizedFixed.cells U.cells) + (ht : TouchingTriple bundle.normalizedRoot bundle.normalizedFixed U) + (hcross : eU.otherAB = eV.point) : + (¬ (∀ z, z = bundle.normalizedPoint ∨ + z = bundle.normalizedPoint - 1 ∨ + z = bundle.normalizedPoint - ⟨0, 1⟩ ∨ + z = bundle.normalizedPoint - 1 - ⟨0, 1⟩ → + z ∈ bundle.normalizedRoot.cells ∨ z ∈ bundle.normalizedFixed.cells) ↔ + bundle.normalizedPoint ∈ FootprintVertices oldRight) := by + have hother : bundle.normalizedPoint ≠ eU.otherAB := by + intro he + have hcommon := (eV.unique_common bundle.normalizedPoint).2 (he.trans hcross) + exact not_other (hV ▸ hcommon.2) + simpa only [hU] using P5485T1FullInterfaceMarking + bundle.normalizedRoot bundle.normalizedFixed U eU + bundle.root_lattice bundle.fixed_lattice hUl bundle.root_fixed_disjoint + hTU hNU ht bundle.normalizedPoint bundle.edgeAtPoint hother + have slots_ne : placement.rightFirstSlot ≠ placement.rightSecondSlot := by + rcases placement.right_slots_cyclic with ⟨hi, hj, _⟩ | ⟨hi, hj, _⟩ | ⟨hi, hj, _⟩ + all_goals simp [hi, hj] + have geometry := BandOrderedGeneralRightSelectedRowGeometry C D T N h k x + bundle placement selectedEdge hx hedge row + rcases geometry with ⟨hp, hs, hsign, hg⟩ | ⟨hp, hs, hsign, hg⟩ | + ⟨hp, hs, hsign, hg⟩ | ⟨hp, hs, hsign, hg⟩ + all_goals rcases hg with ⟨fb, sb, fd, sd, _, _, _, _, hl1, hl2, + hd1, hd2, hd3, hd4, _, ht1, ht2, _, hc1, hc2, _⟩ + · exact finish _ _ fd sd (by simp [oldRight, hp, hs, q]) + (by simp [otherTile, other, hp, hs, q]) hl1 hd1 hd2 ht1 hc1.symm + · exact finish _ _ sd fd (by simp [oldRight, hp, hs, q]) + (by simp [otherTile, other, hp, hs, Ne.symm slots_ne, q]) hl2 hd3 hd4 ht2 hc2 + · exact finish _ _ fd sd (by simp [oldRight, hp, hs, q]) + (by simp [otherTile, other, hp, hs, q]) hl1 hd1 hd2 ht1 hc1.symm + · exact finish _ _ sd fd (by simp [oldRight, hp, hs, q]) + (by simp [otherTile, other, hp, hs, Ne.symm slots_ne, q]) hl2 hd3 hd4 ht2 hc2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightPlacement.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightPlacement.lean new file mode 100644 index 0000000000..5477233d87 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightPlacement.lean @@ -0,0 +1,232 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileTranslation + +-- [TABLET NODE: BandOrderedGeneralRightPlacement] + +/-! +# BandOrderedGeneralRightPlacement + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Fix an ordered-general presentation $q$, its configuration, a normalized +right-adjacent pair $(\bar T,\bar h),(\bar N,\bar k)$, an externally +supplied family $(S_i^e,f_i^e)$ of six supports and partial odometers, a +selected slot, the normalized contact point, and its routed +incident-square direction. A *right-adjacent normalized placement* +consists of the following data. This record imposes only the +branch-specific adjacency, literal layout root, two boundary-piece +alignments, occurrence-index roles, routed memberships, star cover, and +translated full-neighbor alignment listed below. The +tile-odometer facts, cell and domain covers, restriction values, +compatibility, centroid formulas, and slope alternatives for +$(S_i^e,f_i^e)$ are not fields of this record; they are supplied once by +the enclosing normalized routed occurrence bundle. + +It contains the transported right-lattice adjacency and one +`BandOrderedGeneralLayoutCertificate` whose root is literally the +fixed full tile $\bar N$. It stores a cyclic triple $(i,j,k)$ and a +polarity. The same $q$, direction $k$, and polarity explicitly realize +the centroid and two slope equations in the transported +`RightLatticeAdjacent` witness. In the positive polarity the +full-neighbor displacement is $d=v_{0k}$ and the two boundary signs are +$+$ at $i$ and $-$ at $j$; in the reflected polarity they are +$d=-v_{0k}$, $-$ at $i$, and $+$ at $j$. + +Exactly the two signed pieces on this boundary are retained. In the +positive case they are observably aligned with +$$ + R_i^0=P_i^++v_{0k},\qquad R_j^3=P_j^-+v_{0k}, +$$ +and in the reflected case with +$$ + R_i^2=P_i^--v_{0k},\qquad R_j^1=P_j^+-v_{0k}. +$$ +For each of these two pieces the record stores equality of cells, +conditional equality of anchors when those cells are empty, equality of +footprints, and equality of the corresponding function domain with the +literal boundary footprint. The selected signed piece is one of these +two, and it is observably aligned in the same four senses with the retained +exterior occurrence $a$. No alignment of the other four decomposed pieces +with exterior occurrences is asserted. + +The exterior index $a$ is one of the twelve exterior indices. A retained +central index $b$ is one of the six central indices and its occurrence +contains the routed square belonging to $\bar N$; it is not identified +with the whole tile $\bar N$. The occurrence at $a$ contains the opposite +routed square, and the two occurrences' footprints cover the five axial +vertices at the normalized contact point, as derived from those two routed +squares. + +Finally the certificate retains the resulting right-neighbor displacement +and the observable full-neighbor alignment +$$ + \operatorname{cells}(\bar T)= + \operatorname{cells}(\bar N+d) +$$ +and equality of the two anchors when this common cell set is empty. Thus +the decomposed root is the actual translated outer neighbor of the literal +layout root, while the central occurrence selected by the routed square is +only a child occurrence of that layout root. +-/ +structure BandOrderedGeneralRightPlacement + (q : Fin 4 -> CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (C0 : BandCircle) + (root fixed : ProtoTile) (rootFunction fixedFunction : PartialOdometer) + (point : GaussianInt) (pieces : Fin 3 -> Bool -> ProtoTile) + (functions : Fin 3 -> Bool -> PartialOdometer) + (selectedSlot : Fin 3) (selectedSign : Bool) + (routedDirection : Fin 4) where +-- BODY + adjacency : RightLatticeAdjacent C0 root fixed rootFunction fixedFunction + /-- The literal ordered-general layout rooted at the normalized fixed full tile. -/ + layout : BandOrderedGeneralLayoutCertificate q cfg C0 fixed + /-- The first parent slot in the retained cyclic boundary triple. -/ + rightFirstSlot : Fin 3 + /-- The second parent slot in that same cyclic boundary triple. -/ + rightSecondSlot : Fin 3 + /-- The parent slot determining the full right-neighbor displacement. -/ + rightDirectionSlot : Fin 3 + right_slots_cyclic : + (rightFirstSlot = 0 ∧ rightSecondSlot = 1 ∧ rightDirectionSlot = 2) ∨ + (rightFirstSlot = 1 ∧ rightSecondSlot = 2 ∧ rightDirectionSlot = 0) ∨ + (rightFirstSlot = 2 ∧ rightSecondSlot = 0 ∧ rightDirectionSlot = 1) + /-- The polarity of the retained right-neighbor presentation. -/ + rightNeighborPositive : Bool + /-- The defined root slope appearing in the transported right-adjacency equations. -/ + rightRootSlope : Real × Real + /-- The defined fixed slope in the same transported adjacency witness. -/ + rightFixedSlope : Real × Real + right_root_slope : PartialOdometerSlope rootFunction = some rightRootSlope + right_fixed_slope : PartialOdometerSlope fixedFunction = some rightFixedSlope + right_adjacency_centroid : TileCentroid fixed - TileCentroid root = + (if rightNeighborPositive = true then (-1 : Real) else 1) • + GaussianRealPoint + (BandVectors.1 (q 0) (q rightDirectionSlot.succ)) + right_adjacency_slope_real : rightFixedSlope.1 - rightRootSlope.1 = + (if rightNeighborPositive = true then (-1 : Real) else 1) * + (BandVectors.2 (q 0) (q rightDirectionSlot.succ)).re + right_adjacency_slope_imag : rightFixedSlope.2 - rightRootSlope.2 = + (if rightNeighborPositive = true then (-1 : Real) else 1) * + (BandVectors.2 (q 0) (q rightDirectionSlot.succ)).im + /-- The actual signed outgoing displacement between the two normalized full tiles. -/ + rightNeighborDisplacement : GaussianInt + right_neighbor_displacement : rightNeighborDisplacement = + (if rightNeighborPositive = true then (1 : GaussianInt) else -1) * + BandVectors.1 (q 0) (q rightDirectionSlot.succ) + right_neighbor_cells : root.cells = + (TileTranslation fixed rightNeighborDisplacement).cells + right_neighbor_empty_anchor : root.cells = ∅ -> root.anchor = + (TileTranslation fixed rightNeighborDisplacement).anchor + /-- The sign of the first decomposed piece lying on the fixed-tile boundary. -/ + firstBoundarySign : Bool + /-- The sign of the second decomposed piece lying on that boundary. -/ + secondBoundarySign : Bool + boundary_signs : + (rightNeighborPositive = true ∧ firstBoundarySign = true ∧ + secondBoundarySign = false) ∨ + (rightNeighborPositive = false ∧ firstBoundarySign = false ∧ + secondBoundarySign = true) + first_boundary_cells : (pieces rightFirstSlot firstBoundarySign).cells = + (TileTranslation (layout.P rightFirstSlot firstBoundarySign) + rightNeighborDisplacement).cells + first_boundary_empty_anchor : + (pieces rightFirstSlot firstBoundarySign).cells = ∅ -> + (pieces rightFirstSlot firstBoundarySign).anchor = + (TileTranslation (layout.P rightFirstSlot firstBoundarySign) + rightNeighborDisplacement).anchor + first_boundary_footprint : + FootprintVertices (pieces rightFirstSlot firstBoundarySign) = + FootprintVertices + (TileTranslation (layout.P rightFirstSlot firstBoundarySign) + rightNeighborDisplacement) + first_boundary_domain : + ((functions rightFirstSlot firstBoundarySign).domain : Set GaussianInt) = + FootprintVertices + (TileTranslation (layout.P rightFirstSlot firstBoundarySign) + rightNeighborDisplacement) + second_boundary_cells : (pieces rightSecondSlot secondBoundarySign).cells = + (TileTranslation (layout.P rightSecondSlot secondBoundarySign) + rightNeighborDisplacement).cells + second_boundary_empty_anchor : + (pieces rightSecondSlot secondBoundarySign).cells = ∅ -> + (pieces rightSecondSlot secondBoundarySign).anchor = + (TileTranslation (layout.P rightSecondSlot secondBoundarySign) + rightNeighborDisplacement).anchor + second_boundary_footprint : + FootprintVertices (pieces rightSecondSlot secondBoundarySign) = + FootprintVertices + (TileTranslation (layout.P rightSecondSlot secondBoundarySign) + rightNeighborDisplacement) + second_boundary_domain : + ((functions rightSecondSlot secondBoundarySign).domain : Set GaussianInt) = + FootprintVertices + (TileTranslation (layout.P rightSecondSlot secondBoundarySign) + rightNeighborDisplacement) + selected_boundary_piece : + (selectedSlot = rightFirstSlot ∧ selectedSign = firstBoundarySign) ∨ + (selectedSlot = rightSecondSlot ∧ selectedSign = secondBoundarySign) + /-- The literal exterior occurrence selected by the routed contact. -/ + exteriorIndex : PeriodicSubtileIndex + /-- The literal central child occurrence selected by the opposite routed square. -/ + centralIndex : PeriodicSubtileIndex + exterior_index : + exteriorIndex = ⟨.A, -1, -1⟩ ∨ exteriorIndex = ⟨.A, 0, -1⟩ ∨ + exteriorIndex = ⟨.C, 1, 0⟩ ∨ exteriorIndex = ⟨.C, 1, 1⟩ ∨ + exteriorIndex = ⟨.E, 0, 1⟩ ∨ exteriorIndex = ⟨.E, -1, 0⟩ ∨ + exteriorIndex = ⟨.B, 1, 1⟩ ∨ exteriorIndex = ⟨.B, 0, 1⟩ ∨ + exteriorIndex = ⟨.D, -1, 0⟩ ∨ exteriorIndex = ⟨.D, -1, -1⟩ ∨ + exteriorIndex = ⟨.F, 0, -1⟩ ∨ exteriorIndex = ⟨.F, 1, 0⟩ + central_index : + centralIndex = ⟨.A, 0, 0⟩ ∨ centralIndex = ⟨.B, 0, 0⟩ ∨ + centralIndex = ⟨.C, 0, 0⟩ ∨ centralIndex = ⟨.D, 0, 0⟩ ∨ + centralIndex = ⟨.E, 0, 0⟩ ∨ centralIndex = ⟨.F, 0, 0⟩ + selected_exterior_cells : (pieces selectedSlot selectedSign).cells = + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + exteriorIndex).cells + selected_exterior_empty_anchor : + (pieces selectedSlot selectedSign).cells = ∅ -> + (pieces selectedSlot selectedSign).anchor = + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + exteriorIndex).anchor + selected_exterior_footprint : + FootprintVertices (pieces selectedSlot selectedSign) = FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u layout.v exteriorIndex) + selected_exterior_domain : + ((functions selectedSlot selectedSign).domain : Set GaussianInt) = + FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u layout.v exteriorIndex) + exterior_routed_cell : LatticeVertexIncidentCell point routedDirection ∈ + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + exteriorIndex).cells + central_routed_cell : LatticeVertexIncidentCell point + (routedDirection + 2) ∈ + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + centralIndex).cells + selected_star : forall y, + y = point ∨ y = point + 1 ∨ y = point - 1 ∨ + y = point + ⟨0, 1⟩ ∨ y = point - ⟨0, 1⟩ -> + y ∈ FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u layout.v exteriorIndex) ∨ + y ∈ FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u layout.v centralIndex) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificate.lean new file mode 100644 index 0000000000..0562304189 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificate.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightInterfaceCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation + +-- [TABLET NODE: BandOrderedGeneralRightRoutingCertificate] + +/-! +# BandOrderedGeneralRightRoutingCertificate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Given a `BandOrderedGeneralRightInterfaceCertificate`, a right routing +certificate records an actual common outer footprint edge through the +normalized point, the two induced-edge properties, and opposite incident +cells of the transformed root and fixed tiles. It selects a signed piece of +the fixed decomposition containing the root-side cell and the corresponding +central layout occurrence containing the fixed-side cell. It records their +literal occurrence indices, observable alignment, routed memberships, and +five-point cover, together with the common occurrence edge and selected +contact row returned by shifted routed-boundary localization. +-/ +structure BandOrderedGeneralRightRoutingCertificate + {C : BandCircle} {T N : ProtoTile} {h k : PartialOdometer} + {x : GaussianInt} + {normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x} + (interface : BandOrderedGeneralRightInterfaceCertificate normalization) where +-- BODY + edgeAtPoint : exists edge : Finset GaussianInt, + normalization.normalizedPoint ∈ edge ∧ + edge ∈ FootprintEdges normalization.normalizedRoot ∩ + FootprintEdges normalization.normalizedFixed + root_induced : forall y, + y ∈ FootprintVertices normalization.normalizedRoot -> forall z, + z ∈ FootprintVertices normalization.normalizedRoot -> + FourNeighborAdjacent y z -> + ({y, z} : Finset GaussianInt) ∈ + FootprintEdges normalization.normalizedRoot + fixed_induced : forall y, + y ∈ FootprintVertices normalization.normalizedFixed -> forall z, + z ∈ FootprintVertices normalization.normalizedFixed -> + FourNeighborAdjacent y z -> + ({y, z} : Finset GaussianInt) ∈ + FootprintEdges normalization.normalizedFixed + /-- The incident-square direction with root and fixed cells in opposite sectors. -/ + routedDirection : Fin 4 + routed_root_cell : LatticeVertexIncidentCell normalization.normalizedPoint + routedDirection ∈ normalization.normalizedRoot.cells + routed_fixed_cell : LatticeVertexIncidentCell normalization.normalizedPoint + (routedDirection + 2) ∈ normalization.normalizedFixed.cells + /-- The selected parent slot of the fixed six-piece decomposition. -/ + selectedSlot : Fin 3 + /-- The sign of that selected occurrence in the same decomposition family. -/ + selectedSign : Bool + selected_piece_cell : LatticeVertexIncidentCell normalization.normalizedPoint + routedDirection ∈ (normalization.pieces selectedSlot selectedSign).cells + selected_boundary_piece : + (selectedSlot = normalization.rightFirstSlot ∧ + selectedSign = normalization.firstBoundarySign) ∨ + (selectedSlot = normalization.rightSecondSlot ∧ + selectedSign = normalization.secondBoundarySign) + /-- The literal exterior occurrence selected by the routed contact. -/ + exteriorIndex : PeriodicSubtileIndex + /-- The literal central child occurrence selected by the opposite routed square. -/ + centralIndex : PeriodicSubtileIndex + exterior_index : + exteriorIndex = ⟨.A, -1, -1⟩ ∨ exteriorIndex = ⟨.A, 0, -1⟩ ∨ + exteriorIndex = ⟨.C, 1, 0⟩ ∨ exteriorIndex = ⟨.C, 1, 1⟩ ∨ + exteriorIndex = ⟨.E, 0, 1⟩ ∨ exteriorIndex = ⟨.E, -1, 0⟩ ∨ + exteriorIndex = ⟨.B, 1, 1⟩ ∨ exteriorIndex = ⟨.B, 0, 1⟩ ∨ + exteriorIndex = ⟨.D, -1, 0⟩ ∨ exteriorIndex = ⟨.D, -1, -1⟩ ∨ + exteriorIndex = ⟨.F, 0, -1⟩ ∨ exteriorIndex = ⟨.F, 1, 0⟩ + central_index : + centralIndex = ⟨.A, 0, 0⟩ ∨ centralIndex = ⟨.B, 0, 0⟩ ∨ + centralIndex = ⟨.C, 0, 0⟩ ∨ centralIndex = ⟨.D, 0, 0⟩ ∨ + centralIndex = ⟨.E, 0, 0⟩ ∨ centralIndex = ⟨.F, 0, 0⟩ + selected_exterior_cells : + (normalization.pieces selectedSlot selectedSign).cells = + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v exteriorIndex).cells + selected_exterior_empty_anchor : + (normalization.pieces selectedSlot selectedSign).cells = ∅ -> + (normalization.pieces selectedSlot selectedSign).anchor = + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v exteriorIndex).anchor + selected_exterior_footprint : + FootprintVertices (normalization.pieces selectedSlot selectedSign) = + FootprintVertices + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v exteriorIndex) + selected_exterior_domain : + ((normalization.functions selectedSlot selectedSign).domain : + Set GaussianInt) = + FootprintVertices + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v exteriorIndex) + exterior_routed_cell : + LatticeVertexIncidentCell normalization.normalizedPoint routedDirection ∈ + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v exteriorIndex).cells + central_routed_cell : + LatticeVertexIncidentCell normalization.normalizedPoint + (routedDirection + 2) ∈ + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v centralIndex).cells + selected_star : forall y, + y = normalization.normalizedPoint ∨ + y = normalization.normalizedPoint + 1 ∨ + y = normalization.normalizedPoint - 1 ∨ + y = normalization.normalizedPoint + ⟨0, 1⟩ ∨ + y = normalization.normalizedPoint - ⟨0, 1⟩ -> + y ∈ FootprintVertices + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v exteriorIndex) ∨ + y ∈ FootprintVertices + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v centralIndex) + /-- The common occurrence footprint edge returned by shifted boundary localization. -/ + localizedEdge : Finset GaussianInt + localized_edge_at_point : normalization.normalizedPoint ∈ localizedEdge + localized_edge_common : localizedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v centralIndex) + localized_contact : Nonempty + (BandOrderedGeneralSelectedContactRow normalization.normalizedPresentation + normalization.configuration normalization.normalizedCircle + normalization.normalizedFixed normalization.layout exteriorIndex centralIndex) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean new file mode 100644 index 0000000000..3d46cbb37e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean @@ -0,0 +1,1207 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightRoutingCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightInterfaceCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralShiftedRoutedBoundaryLocalization +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.CoveredInterfaceOppositeIncidentCells +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandOrderedGeneralRightRoutingCertificateExists] + +/-! +# BandOrderedGeneralRightRoutingCertificateExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RightRoutingGeometry + +private theorem hedge : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + (BandOrderedGeneralRightInterfaceCertificate normalization) → (exists edge : Finset + GaussianInt, normalization.normalizedPoint ∈ edge ∧ edge ∈ FootprintEdges + normalization.normalizedRoot ∩ FootprintEdges normalization.normalizedFixed) ) := by + classical + intro C T N h k x normalization interface + rcases interface.startData.pathAB with + ⟨p, hp, hlen, _, _, hvertices, hsteps, hedges⟩ + exact SimpleGridPathVertexIncidentEdge _ _ + ⟨p, hp, hlen, hvertices, hsteps, hedges⟩ + normalization.normalizedPoint interface.normalized_point_on_start_path + +private theorem hrootBand : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), BandPrototile + normalization.normalizedCircle.1.1 normalization.normalizedRoot ) := by + classical + intro C T N h k x normalization + rw [← normalization.normalized_circle_eq] + exact normalization.root_band + +private theorem hend : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (interface : + BandOrderedGeneralRightInterfaceCertificate normalization), + interface.startData.otherAB ∈ FootprintVertices normalization.normalizedRoot ∩ + FootprintVertices normalization.normalizedFixed ∩ FootprintVertices + interface.endCompanion ) := by + classical + intro C T N h k x normalization interface + rw [← interface.interface_endpoints.1] + exact (interface.endData.unique_common interface.endData.point).2 rfl + +private theorem turn_flip : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + (∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q j.succ) = (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 + (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ)))) → (∀ (s : Fin 3), GaussianQuarterTurn + (BandVectors.1 (q s.succ) (q 0)) = BandVectors.1 (q 0) (q s.succ)) ) := by + classical + intro C T N h k x normalization q flip s + rw [(flip s).1] + rcases BandVectors.1 (q s.succ) (q 0) with ⟨a, b⟩ + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + +private theorem incoming_relation : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : + ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : + Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin + (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 + : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q + (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → (BandVectors.1 (q + 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) ) := by + classical + intro C T N h k x normalization q laws + let r : Fin 4 -> CircleCoordinates := ![q 0, q 2, q 3, q 1] + have hr : SemiProperQuadruple r := by + simpa [r] using SemiProperQuadruple.rotate + normalization.configuration.proper.1 + let s : Fin 4 -> CircleCoordinates := ![r 0, r 2, r 3, r 1] + have hs : SemiProperQuadruple s := by + simpa [s] using SemiProperQuadruple.rotate hr + have second := VectorRecursionLaws r hr + have third := VectorRecursionLaws s hs + have e0 := laws.2.2.1 + have e1 := second.2.2.1 + have e2 := third.2.2.1 + simp? [r, s] at e1 e2 + rw [e0, e1, e2] + calc + _ = (1 - (⟨0, 1⟩ : GaussianInt)) * + (BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 1) (q 3) + + BandVectors.1 (q 2) (q 1)) := by ring + _ = 0 := by rw [laws.1]; simp + +private theorem outgoing_relation : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + (GaussianQuarterTurn (BandVectors.1 (q 1) (q 0)) = BandVectors.1 (q 0) (q 1)) → + ((GaussianQuarterTurn (BandVectors.1 (q 2) (q 0)) = BandVectors.1 (q 0) (q 2)) → + ((GaussianQuarterTurn (BandVectors.1 (q 3) (q 0)) = BandVectors.1 (q 0) (q 3)) → + ((BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = + 0) → (BandVectors.1 (q 0) (q 1) + BandVectors.1 (q 0) (q 2) + BandVectors.1 (q 0) (q + 3) = 0)))) ) := by + classical + intro C T N h k x normalization q turn0 turn1 turn2 incoming_relation + rw [← turn0, ← turn1, ← turn2] + calc + _ = GaussianQuarterTurn (BandVectors.1 (q 1) (q 0) + + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0)) := by + rcases BandVectors.1 (q 1) (q 0) with ⟨a0, b0⟩ + rcases BandVectors.1 (q 2) (q 0) with ⟨a1, b1⟩ + rcases BandVectors.1 (q 3) (q 0) with ⟨a2, b2⟩ + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn]; ring + _ = GaussianQuarterTurn 0 := congrArg GaussianQuarterTurn incoming_relation + _ = 0 := by rfl + +private theorem period2 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + (BandVectors.1 (q 0) (q 1) + BandVectors.1 (q 0) (q 2) + BandVectors.1 (q 0) (q 3) = 0) → + ((BandVectors.1 (q 0) (q 1) = normalization.layout.u) → ((BandVectors.1 (q 0) (q 2) = + normalization.layout.v) → (BandVectors.1 (q 0) (q 3) = -normalization.layout.u - + normalization.layout.v))) ) := by + classical + intro C T N h k x normalization q outgoing_relation period0 period1 + rw [← period0, ← period1] + have heq : BandVectors.1 (q 0) (q 3) = + -(BandVectors.1 (q 0) (q 1) + BandVectors.1 (q 0) (q 2)) := + eq_neg_of_add_eq_zero_left (by + simpa [add_assoc, add_comm, add_left_comm] using outgoing_relation) + calc + _ = -(BandVectors.1 (q 0) (q 1) + BandVectors.1 (q 0) (q 2)) := heq + _ = _ := by abel + +private theorem hdisplacement : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + (BandVectors.1 (q 0) (q 1) = normalization.layout.u) → ((BandVectors.1 (q 0) (q 2) = + normalization.layout.v) → ((BandVectors.1 (q 0) (q 3) = -normalization.layout.u - + normalization.layout.v) → ( + let m : Int := if normalization.rightDirectionSlot = 0 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightDirectionSlot = 1 then 0 + else if normalization.rightNeighborPositive = true then -1 else 1 + let n : Int := if normalization.rightDirectionSlot = 0 then 0 + else if normalization.rightDirectionSlot = 1 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightNeighborPositive = true then -1 else 1 + normalization.rightNeighborDisplacement = (m : GaussianInt) * normalization.layout.u + (n + : GaussianInt) * normalization.layout.v))) ) := by + classical + intro C T N h k x normalization q period0 period1 period2 m n + rw [normalization.right_neighbor_displacement] + have hd : normalization.rightDirectionSlot = 0 ∨ + normalization.rightDirectionSlot = 1 ∨ + normalization.rightDirectionSlot = 2 := by omega + rcases hd with hd | hd | hd <;> + cases hp : normalization.rightNeighborPositive <;> + simp [q, m, n, hd, hp, period0, period1, period2] <;> abel + +private theorem hshift : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (selectedSlot : Fin + (3 : ℕ)), ∀ (selectedSign : Bool), + let m : Int := if normalization.rightDirectionSlot = 0 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightDirectionSlot = 1 then 0 + else if normalization.rightNeighborPositive = true then -1 else 1 + let n : Int := if normalization.rightDirectionSlot = 0 then 0 + else if normalization.rightDirectionSlot = 1 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightNeighborPositive = true then -1 else 1 + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then (if s = true then .A else .B) + else if i = 1 then (if s = true then .C else .D) + else (if s = true then .E else .F) + let exteriorIndex : PeriodicSubtileIndex := + ⟨labelOf selectedSlot selectedSign, m, n⟩ + (normalization.rightNeighborPositive = true ∧ ((normalization.rightDirectionSlot = 0 ∧ + exteriorIndex.first = 1 ∧ exteriorIndex.second = 0) ∨ + (normalization.rightDirectionSlot = 1 ∧ exteriorIndex.first = 0 ∧ + exteriorIndex.second = 1) ∨ (normalization.rightDirectionSlot = 2 ∧ + exteriorIndex.first = -1 ∧ exteriorIndex.second = -1))) ∨ + (normalization.rightNeighborPositive = false ∧ ((normalization.rightDirectionSlot = 0 + ∧ exteriorIndex.first = -1 ∧ exteriorIndex.second = 0) ∨ + (normalization.rightDirectionSlot = 1 ∧ exteriorIndex.first = 0 ∧ + exteriorIndex.second = -1) ∨ (normalization.rightDirectionSlot = 2 ∧ + exteriorIndex.first = 1 ∧ exteriorIndex.second = 1))) ) := by + classical + intro C T N h k x normalization selectedSlot selectedSign m n labelOf exteriorIndex + have hd : normalization.rightDirectionSlot = 0 ∨ + normalization.rightDirectionSlot = 1 ∨ + normalization.rightDirectionSlot = 2 := by omega + rcases hd with hd | hd | hd <;> + cases hp : normalization.rightNeighborPositive <;> + simp [exteriorIndex, m, n, hd, hp] + +private theorem hcentralIndex : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (j : Fin (4 : ℕ)), ∀ + (centralSlot : Fin (3 : ℕ)), ∀ (centralSign : Bool), (LatticeVertexIncidentCell + normalization.normalizedPoint (j + (2 : Fin (4 : ℕ))) ∈ (normalization.layout.P + centralSlot centralSign).cells) → ( + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then (if s = true then .A else .B) + else if i = 1 then (if s = true then .C else .D) + else (if s = true then .E else .F) + let centralIndex : PeriodicSubtileIndex := + ⟨labelOf centralSlot centralSign, 0, 0⟩ + centralIndex = ⟨.A, 0, 0⟩ ∨ centralIndex = ⟨.B, 0, 0⟩ ∨ centralIndex = ⟨.C, 0, 0⟩ ∨ + centralIndex = ⟨.D, 0, 0⟩ ∨ centralIndex = ⟨.E, 0, 0⟩ ∨ centralIndex = ⟨.F, 0, 0⟩) ) + := by + classical + intro C T N h k x normalization j centralSlot centralSign hcentral labelOf centralIndex + fin_cases centralSlot <;> cases centralSign <;> + simp [centralIndex, labelOf] + +private theorem translation_zero : + (by + classical + exact + ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by + classical + intro U + cases U with + | mk cells anchor => + have hc : cells.image (GaussianTranslation 0) = cells := by + ext z + simp [GaussianTranslation] + simp [TileTranslation, hc, GaussianTranslation] + +private theorem hcentralOccurrence : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (centralSlot : Fin (3 + : ℕ)), ∀ (centralSign : Bool), + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then (if s = true then .A else .B) + else if i = 1 then (if s = true then .C else .D) + else (if s = true then .E else .F) + let centralIndex : PeriodicSubtileIndex := + ⟨labelOf centralSlot centralSign, 0, 0⟩ + (∀ (U : ProtoTile), TileTranslation U 0 = U) → (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v centralIndex = + normalization.layout.P centralSlot centralSign) ) := by + classical + intro C T N h k x normalization centralSlot centralSign labelOf centralIndex translation_zero + have aux : ∀ (i : Fin 3) (s : Bool), + SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v + ⟨labelOf i s, 0, 0⟩ = normalization.layout.P i s := by + intro i s + fin_cases i <;> cases s <;> + simp [labelOf, SubtileOccurrenceInterpretation, translation_zero] + exact aux centralSlot centralSign + +private theorem hexteriorOccurrence : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (j : Fin (4 : ℕ)), ∀ + (selectedSlot : Fin (3 : ℕ)), ∀ (selectedSign : Bool), (LatticeVertexIncidentCell + normalization.normalizedPoint j ∈ (normalization.pieces selectedSlot + selectedSign).cells) → ( + let m : Int := if normalization.rightDirectionSlot = 0 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightDirectionSlot = 1 then 0 + else if normalization.rightNeighborPositive = true then -1 else 1 + let n : Int := if normalization.rightDirectionSlot = 0 then 0 + else if normalization.rightDirectionSlot = 1 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightNeighborPositive = true then -1 else 1 + (normalization.rightNeighborDisplacement = (m : GaussianInt) * normalization.layout.u + + (n : GaussianInt) * normalization.layout.v) → ( + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then (if s = true then .A else .B) + else if i = 1 then (if s = true then .C else .D) + else (if s = true then .E else .F) + let exteriorIndex : PeriodicSubtileIndex := + ⟨labelOf selectedSlot selectedSign, m, n⟩ + ((normalization.rightNeighborPositive = true ∧ ((normalization.rightDirectionSlot = 0 ∧ + exteriorIndex.first = 1 ∧ exteriorIndex.second = 0) ∨ + (normalization.rightDirectionSlot = 1 ∧ exteriorIndex.first = 0 ∧ + exteriorIndex.second = 1) ∨ (normalization.rightDirectionSlot = 2 ∧ + exteriorIndex.first = -1 ∧ exteriorIndex.second = -1))) ∨ + (normalization.rightNeighborPositive = false ∧ ((normalization.rightDirectionSlot = 0 + ∧ exteriorIndex.first = -1 ∧ exteriorIndex.second = 0) ∨ + (normalization.rightDirectionSlot = 1 ∧ exteriorIndex.first = 0 ∧ + exteriorIndex.second = -1) ∨ (normalization.rightDirectionSlot = 2 ∧ + exteriorIndex.first = 1 ∧ exteriorIndex.second = 1)))) → + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v exteriorIndex = TileTranslation (normalization.layout.P + selectedSlot selectedSign) normalization.rightNeighborDisplacement))) ) := by + classical + intro C T N h k x normalization j selectedSlot selectedSign hselected m n hdisplacement labelOf + exteriorIndex hshift + rw [hdisplacement] + fin_cases selectedSlot <;> cases selectedSign <;> + simp [exteriorIndex, labelOf, SubtileOccurrenceInterpretation] + +private theorem hcentroidAlign : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (selectedSlot : Fin + (3 : ℕ)), ∀ (selectedSign : Bool), (FootprintVertices normalization.normalizedRoot = + FootprintVertices (TileTranslation normalization.normalizedFixed + normalization.rightNeighborDisplacement) ∧ BoundaryFootprintVertices + normalization.normalizedRoot = BoundaryFootprintVertices (TileTranslation + normalization.normalizedFixed normalization.rightNeighborDisplacement) ∧ + BoundaryFootprintEdges normalization.normalizedRoot = BoundaryFootprintEdges + (TileTranslation normalization.normalizedFixed + normalization.rightNeighborDisplacement) ∧ TileRealization + normalization.normalizedRoot = TileRealization (TileTranslation + normalization.normalizedFixed normalization.rightNeighborDisplacement) ∧ TileCentroid + normalization.normalizedRoot = TileCentroid (TileTranslation + normalization.normalizedFixed normalization.rightNeighborDisplacement)) → + (TileCentroid (normalization.pieces selectedSlot selectedSign) = TileCentroid + (TileTranslation (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement)) ) := by + classical + intro C T N h k x normalization selectedSlot selectedSign houterObservables + rw [(TileTranslationFormulas + (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement).2.2.2.2.1] + have hp1 := congrArg Prod.fst + (normalization.piece_centroid selectedSlot selectedSign) + have hp2 := congrArg Prod.snd + (normalization.piece_centroid selectedSlot selectedSign) + have hl1 := congrArg Prod.fst + (normalization.layout.outer_occurrence selectedSlot selectedSign).2.2 + have hl2 := congrArg Prod.snd + (normalization.layout.outer_occurrence selectedSlot selectedSign).2.2 + have hr1 := congrArg Prod.fst houterObservables.2.2.2.2 + have hr2 := congrArg Prod.snd houterObservables.2.2.2.2 + rw [(TileTranslationFormulas normalization.normalizedFixed + normalization.rightNeighborDisplacement).2.2.2.2.1] at hr1 hr2 + apply Prod.ext <;> simp only [] + · change (TileCentroid + (normalization.pieces selectedSlot selectedSign)).1 - + (TileCentroid normalization.normalizedRoot).1 = _ at hp1 + change (TileCentroid + (normalization.layout.P selectedSlot selectedSign)).1 - + (TileCentroid normalization.normalizedFixed).1 = _ at hl1 + change (TileCentroid normalization.normalizedRoot).1 = + (TileCentroid normalization.normalizedFixed).1 + _ at hr1 + linarith + · change (TileCentroid + (normalization.pieces selectedSlot selectedSign)).2 - + (TileCentroid normalization.normalizedRoot).2 = _ at hp2 + change (TileCentroid + (normalization.layout.P selectedSlot selectedSign)).2 - + (TileCentroid normalization.normalizedFixed).2 = _ at hl2 + change (TileCentroid normalization.normalizedRoot).2 = + (TileCentroid normalization.normalizedFixed).2 + _ at hr2 + linarith + +private theorem hselectedCells : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (selectedSlot : Fin + (3 : ℕ)), ∀ (selectedSign : Bool), + let m : Int := if normalization.rightDirectionSlot = 0 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightDirectionSlot = 1 then 0 + else if normalization.rightNeighborPositive = true then -1 else 1 + let n : Int := if normalization.rightDirectionSlot = 0 then 0 + else if normalization.rightDirectionSlot = 1 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightNeighborPositive = true then -1 else 1 + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then (if s = true then .A else .B) + else if i = 1 then (if s = true then .C else .D) + else (if s = true then .E else .F) + let exteriorIndex : PeriodicSubtileIndex := + ⟨labelOf selectedSlot selectedSign, m, n⟩ + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v exteriorIndex = TileTranslation (normalization.layout.P + selectedSlot selectedSign) normalization.rightNeighborDisplacement) → + (((normalization.pieces selectedSlot selectedSign).cells = (TileTranslation + (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement).cells ∧ ((normalization.pieces selectedSlot + selectedSign).cells = ∅ → (normalization.pieces selectedSlot selectedSign).anchor = + (TileTranslation (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement).anchor)) → ((normalization.pieces + selectedSlot selectedSign).cells = (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v + exteriorIndex).cells)) ) := by + classical + intro C T N h k x normalization selectedSlot selectedSign m n labelOf exteriorIndex + hexteriorOccurrence hselectedUnique + rw [hexteriorOccurrence] + exact hselectedUnique.1 + +private theorem hselectedAnchor : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (selectedSlot : Fin + (3 : ℕ)), ∀ (selectedSign : Bool), + let m : Int := if normalization.rightDirectionSlot = 0 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightDirectionSlot = 1 then 0 + else if normalization.rightNeighborPositive = true then -1 else 1 + let n : Int := if normalization.rightDirectionSlot = 0 then 0 + else if normalization.rightDirectionSlot = 1 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightNeighborPositive = true then -1 else 1 + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then (if s = true then .A else .B) + else if i = 1 then (if s = true then .C else .D) + else (if s = true then .E else .F) + let exteriorIndex : PeriodicSubtileIndex := + ⟨labelOf selectedSlot selectedSign, m, n⟩ + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v exteriorIndex = TileTranslation (normalization.layout.P + selectedSlot selectedSign) normalization.rightNeighborDisplacement) → + (((normalization.pieces selectedSlot selectedSign).cells = (TileTranslation + (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement).cells ∧ ((normalization.pieces selectedSlot + selectedSign).cells = ∅ → (normalization.pieces selectedSlot selectedSign).anchor = + (TileTranslation (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement).anchor)) → ((normalization.pieces + selectedSlot selectedSign).cells = ∅ → (normalization.pieces selectedSlot + selectedSign).anchor = (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v exteriorIndex).anchor)) ) := by + classical + intro C T N h k x normalization selectedSlot selectedSign m n labelOf exteriorIndex + hexteriorOccurrence hselectedUnique + rw [hexteriorOccurrence] + exact hselectedUnique.2 + +private theorem hselectedFootprint : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (selectedSlot : Fin + (3 : ℕ)), ∀ (selectedSign : Bool), + let m : Int := if normalization.rightDirectionSlot = 0 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightDirectionSlot = 1 then 0 + else if normalization.rightNeighborPositive = true then -1 else 1 + let n : Int := if normalization.rightDirectionSlot = 0 then 0 + else if normalization.rightDirectionSlot = 1 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightNeighborPositive = true then -1 else 1 + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then (if s = true then .A else .B) + else if i = 1 then (if s = true then .C else .D) + else (if s = true then .E else .F) + let exteriorIndex : PeriodicSubtileIndex := + ⟨labelOf selectedSlot selectedSign, m, n⟩ + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v exteriorIndex = TileTranslation (normalization.layout.P + selectedSlot selectedSign) normalization.rightNeighborDisplacement) → + ((FootprintVertices (normalization.pieces selectedSlot selectedSign) = + FootprintVertices (TileTranslation (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement) ∧ BoundaryFootprintVertices + (normalization.pieces selectedSlot selectedSign) = BoundaryFootprintVertices + (TileTranslation (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement) ∧ BoundaryFootprintEdges + (normalization.pieces selectedSlot selectedSign) = BoundaryFootprintEdges + (TileTranslation (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement) ∧ TileRealization (normalization.pieces + selectedSlot selectedSign) = TileRealization (TileTranslation (normalization.layout.P + selectedSlot selectedSign) normalization.rightNeighborDisplacement) ∧ TileCentroid + (normalization.pieces selectedSlot selectedSign) = TileCentroid (TileTranslation + (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement)) → (FootprintVertices (normalization.pieces + selectedSlot selectedSign) = FootprintVertices (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v exteriorIndex))) + ) := by + classical + intro C T N h k x normalization selectedSlot selectedSign m n labelOf exteriorIndex + hexteriorOccurrence hselectedObservables + rw [hexteriorOccurrence] + exact hselectedObservables.1 + +private theorem hparentPositive : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + ∀ (selectedSlot : Fin (3 : ℕ)), (0 ≤ (q selectedSlot.succ).1) → (0 < (q + selectedSlot.succ).1) ) := by + classical + intro C T N h k x normalization q selectedSlot hparentNonnegative + have hn : (q selectedSlot.succ).1 ≠ 0 := by + simpa [q] using normalization.configuration.noLine selectedSlot.succ + omega + +private theorem hselectedDomain : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + ∀ (selectedSlot : Fin (3 : ℕ)), ∀ (selectedSign : Bool), + let m : Int := if normalization.rightDirectionSlot = 0 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightDirectionSlot = 1 then 0 + else if normalization.rightNeighborPositive = true then -1 else 1 + let n : Int := if normalization.rightDirectionSlot = 0 then 0 + else if normalization.rightDirectionSlot = 1 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightNeighborPositive = true then -1 else 1 + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then (if s = true then .A else .B) + else if i = 1 then (if s = true then .C else .D) + else (if s = true then .E else .F) + let exteriorIndex : PeriodicSubtileIndex := + ⟨labelOf selectedSlot selectedSign, m, n⟩ + (FootprintVertices (normalization.pieces selectedSlot selectedSign) = FootprintVertices + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v exteriorIndex)) → ((0 < (q selectedSlot.succ).1) → + (((normalization.functions selectedSlot selectedSign).domain : Set GaussianInt) = + FootprintVertices (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v exteriorIndex))) ) := by + classical + intro C T N h k x normalization q selectedSlot selectedSign m n labelOf exteriorIndex + hselectedFootprint hparentPositive + calc + _ = FootprintVertices (normalization.pieces selectedSlot selectedSign) := + PositiveCurvatureTileOdometerDomain _ _ _ hparentPositive + (normalization.piece_odometer selectedSlot selectedSign) + _ = _ := hselectedFootprint + +private theorem hexteriorCell : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (j : Fin (4 : ℕ)), ∀ + (selectedSlot : Fin (3 : ℕ)), ∀ (selectedSign : Bool), (LatticeVertexIncidentCell + normalization.normalizedPoint j ∈ (normalization.pieces selectedSlot + selectedSign).cells) → ( + let m : Int := if normalization.rightDirectionSlot = 0 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightDirectionSlot = 1 then 0 + else if normalization.rightNeighborPositive = true then -1 else 1 + let n : Int := if normalization.rightDirectionSlot = 0 then 0 + else if normalization.rightDirectionSlot = 1 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightNeighborPositive = true then -1 else 1 + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then (if s = true then .A else .B) + else if i = 1 then (if s = true then .C else .D) + else (if s = true then .E else .F) + let exteriorIndex : PeriodicSubtileIndex := + ⟨labelOf selectedSlot selectedSign, m, n⟩ + ((normalization.pieces selectedSlot selectedSign).cells = + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v exteriorIndex).cells) → (LatticeVertexIncidentCell + normalization.normalizedPoint j ∈ (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v + exteriorIndex).cells)) ) := by + classical + intro C T N h k x normalization j selectedSlot selectedSign hselected m n labelOf exteriorIndex + hselectedCells + rw [← hselectedCells] + exact hselected + +private theorem hcentralCell : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (j : Fin (4 : ℕ)), ∀ + (centralSlot : Fin (3 : ℕ)), ∀ (centralSign : Bool), (LatticeVertexIncidentCell + normalization.normalizedPoint (j + (2 : Fin (4 : ℕ))) ∈ (normalization.layout.P + centralSlot centralSign).cells) → ( + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then (if s = true then .A else .B) + else if i = 1 then (if s = true then .C else .D) + else (if s = true then .E else .F) + let centralIndex : PeriodicSubtileIndex := + ⟨labelOf centralSlot centralSign, 0, 0⟩ + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v centralIndex = normalization.layout.P centralSlot centralSign) + → (LatticeVertexIncidentCell normalization.normalizedPoint (j + 2) ∈ + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v centralIndex).cells)) ) := by + classical + intro C T N h k x normalization j centralSlot centralSign hcentral labelOf centralIndex + hcentralOccurrence + rw [hcentralOccurrence] + exact hcentral + +private theorem footprint_of_cell : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (c : GaussianInt), (c ∈ U.cells) → (c ∈ FootprintVertices U ∧ c + 1 + ∈ FootprintVertices U ∧ c + ⟨0, 1⟩ ∈ FootprintVertices U ∧ c + 1 + ⟨0, 1⟩ ∈ + FootprintVertices U) ) := by + classical + intro U c hc + have hne : U.cells.Nonempty := ⟨c, hc⟩ + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + exact ⟨⟨c, hc, Or.inl rfl⟩, + ⟨c, hc, Or.inr (Or.inl rfl)⟩, + ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩, + ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩⟩ + +private theorem hstar : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (j : Fin (4 : ℕ)), + (LatticeVertexIncidentCell normalization.normalizedPoint j ∈ + normalization.normalizedRoot.cells) → ((LatticeVertexIncidentCell + normalization.normalizedPoint (j + (2 : Fin (4 : ℕ))) ∈ + normalization.normalizedFixed.cells) → (∀ (selectedSlot : Fin (3 : ℕ)), ∀ + (selectedSign : Bool), (LatticeVertexIncidentCell normalization.normalizedPoint j ∈ + (normalization.pieces selectedSlot selectedSign).cells) → (∀ (centralSlot : Fin (3 : + ℕ)), ∀ (centralSign : Bool), (LatticeVertexIncidentCell normalization.normalizedPoint + (j + (2 : Fin (4 : ℕ))) ∈ (normalization.layout.P centralSlot centralSign).cells) → ( + let m : Int := if normalization.rightDirectionSlot = 0 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightDirectionSlot = 1 then 0 + else if normalization.rightNeighborPositive = true then -1 else 1 + let n : Int := if normalization.rightDirectionSlot = 0 then 0 + else if normalization.rightDirectionSlot = 1 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightNeighborPositive = true then -1 else 1 + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then (if s = true then .A else .B) + else if i = 1 then (if s = true then .C else .D) + else (if s = true then .E else .F) + let exteriorIndex : PeriodicSubtileIndex := + ⟨labelOf selectedSlot selectedSign, m, n⟩ + let centralIndex : PeriodicSubtileIndex := + ⟨labelOf centralSlot centralSign, 0, 0⟩ + (LatticeVertexIncidentCell normalization.normalizedPoint j ∈ + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v exteriorIndex).cells) → ((LatticeVertexIncidentCell + normalization.normalizedPoint (j + 2) ∈ (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v + centralIndex).cells) → ((LatticeVertexIncidentCell normalization.normalizedPoint j ∈ + FootprintVertices (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v exteriorIndex) ∧ + LatticeVertexIncidentCell normalization.normalizedPoint j + (1 : GaussianInt) ∈ + FootprintVertices (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v exteriorIndex) ∧ + LatticeVertexIncidentCell normalization.normalizedPoint j + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∈ FootprintVertices (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v exteriorIndex) ∧ + LatticeVertexIncidentCell normalization.normalizedPoint j + (1 : GaussianInt) + (⟨(0 + : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ FootprintVertices (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v exteriorIndex)) + → ((LatticeVertexIncidentCell normalization.normalizedPoint (j + (2 : Fin (4 : ℕ))) ∈ + FootprintVertices (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v centralIndex) ∧ + LatticeVertexIncidentCell normalization.normalizedPoint (j + (2 : Fin (4 : ℕ))) + (1 + : GaussianInt) ∈ FootprintVertices (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v centralIndex) ∧ + LatticeVertexIncidentCell normalization.normalizedPoint (j + (2 : Fin (4 : ℕ))) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ FootprintVertices + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v centralIndex) ∧ LatticeVertexIncidentCell + normalization.normalizedPoint (j + (2 : Fin (4 : ℕ))) + (1 : GaussianInt) + (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ FootprintVertices (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v centralIndex)) → + (forall y, y = normalization.normalizedPoint ∨ y = normalization.normalizedPoint + 1 + ∨ y = normalization.normalizedPoint - 1 ∨ y = normalization.normalizedPoint + ⟨0, 1⟩ + ∨ y = normalization.normalizedPoint - ⟨0, 1⟩ -> y ∈ FootprintVertices + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v exteriorIndex) ∨ y ∈ FootprintVertices + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v centralIndex))))))))) ) := by + classical + intro C T N h k x normalization j hjroot hjfixed selectedSlot selectedSign hselected + centralSlot centralSign hcentral m n labelOf exteriorIndex centralIndex hexteriorCell + hcentralCell exteriorCorners centralCorners y hy + fin_cases j <;> + simp? [LatticeVertexIncidentCell, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] at exteriorCorners centralCorners + · rcases hy with rfl | rfl | rfl | rfl | rfl + · exact Or.inl exteriorCorners.1 + · exact Or.inl exteriorCorners.2.1 + · exact Or.inr centralCorners.2.2.1 + · exact Or.inl exteriorCorners.2.2.1 + · exact Or.inr centralCorners.2.1 + · rcases hy with rfl | rfl | rfl | rfl | rfl + · exact Or.inl exteriorCorners.2.1 + · exact Or.inr centralCorners.2.2.2 + · exact Or.inl exteriorCorners.1 + · exact Or.inl exteriorCorners.2.2.2 + · exact Or.inr centralCorners.1 + · rcases hy with rfl | rfl | rfl | rfl | rfl + · exact Or.inr centralCorners.1 + · exact Or.inr centralCorners.2.1 + · exact Or.inl exteriorCorners.2.2.1 + · exact Or.inr centralCorners.2.2.1 + · exact Or.inl exteriorCorners.2.1 + · rcases hy with rfl | rfl | rfl | rfl | rfl + · exact Or.inl exteriorCorners.2.2.1 + · exact Or.inl exteriorCorners.2.2.2 + · exact Or.inr centralCorners.1 + · exact Or.inr centralCorners.2.2.2 + · exact Or.inl exteriorCorners.1 + +private theorem hexteriorIndex : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (selectedSlot : Fin + (3 : ℕ)), ∀ (selectedSign : Bool), + let m : Int := if normalization.rightDirectionSlot = 0 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightDirectionSlot = 1 then 0 + else if normalization.rightNeighborPositive = true then -1 else 1 + let n : Int := if normalization.rightDirectionSlot = 0 then 0 + else if normalization.rightDirectionSlot = 1 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightNeighborPositive = true then -1 else 1 + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then (if s = true then .A else .B) + else if i = 1 then (if s = true then .C else .D) + else (if s = true then .E else .F) + let exteriorIndex : PeriodicSubtileIndex := + ⟨labelOf selectedSlot selectedSign, m, n⟩ + (normalization.rightNeighborPositive = true ∧ (normalization.rightDirectionSlot = (0 : + Fin (3 : ℕ)) ∧ (exteriorIndex = (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) ∨ exteriorIndex = (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex)) ∨ normalization.rightDirectionSlot = (1 : Fin (3 : ℕ)) ∧ + (exteriorIndex = (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ + exteriorIndex = (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex)) ∨ + normalization.rightDirectionSlot = (2 : Fin (3 : ℕ)) ∧ (exteriorIndex = + (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ exteriorIndex = + (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex))) ∨ + normalization.rightNeighborPositive = false ∧ (normalization.rightDirectionSlot = (0 + : Fin (3 : ℕ)) ∧ (exteriorIndex = (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) ∨ exteriorIndex = (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex)) ∨ normalization.rightDirectionSlot = (1 : Fin (3 : ℕ)) ∧ + (exteriorIndex = (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ + exteriorIndex = (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex)) ∨ + normalization.rightDirectionSlot = (2 : Fin (3 : ℕ)) ∧ (exteriorIndex = + (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ exteriorIndex = + (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex)))) → (exteriorIndex = + ⟨.A, -1, -1⟩ ∨ exteriorIndex = ⟨.A, 0, -1⟩ ∨ exteriorIndex = ⟨.C, 1, 0⟩ ∨ + exteriorIndex = ⟨.C, 1, 1⟩ ∨ exteriorIndex = ⟨.E, 0, 1⟩ ∨ exteriorIndex = ⟨.E, -1, 0⟩ + ∨ exteriorIndex = ⟨.B, 1, 1⟩ ∨ exteriorIndex = ⟨.B, 0, 1⟩ ∨ exteriorIndex = ⟨.D, -1, + 0⟩ ∨ exteriorIndex = ⟨.D, -1, -1⟩ ∨ exteriorIndex = ⟨.F, 0, -1⟩ ∨ exteriorIndex = + ⟨.F, 1, 0⟩) ) := by + classical + intro C T N h k x normalization selectedSlot selectedSign m n labelOf exteriorIndex + hclassification + have hc := hclassification + rcases hc with ⟨_, h0 | h1 | h2⟩ | ⟨_, h0 | h1 | h2⟩ + · rcases h0 with ⟨_, ha | ha⟩ + · exact Or.inr <| Or.inr <| Or.inl ha + · exact Or.inr <| Or.inr <| Or.inr <| Or.inr <| Or.inr <| + Or.inr <| Or.inr <| Or.inr <| Or.inr <| Or.inr <| Or.inr ha + · rcases h1 with ⟨_, ha | ha⟩ + · exact Or.inr <| Or.inr <| Or.inr <| Or.inr <| Or.inl ha + · exact Or.inr <| Or.inr <| Or.inr <| Or.inr <| Or.inr <| + Or.inr <| Or.inr <| Or.inl ha + · rcases h2 with ⟨_, ha | ha⟩ + · exact Or.inl ha + · exact Or.inr <| Or.inr <| Or.inr <| Or.inr <| Or.inr <| + Or.inr <| Or.inr <| Or.inr <| Or.inr <| Or.inl ha + · rcases h0 with ⟨_, ha | ha⟩ + · exact Or.inr <| Or.inr <| Or.inr <| Or.inr <| Or.inr <| + Or.inr <| Or.inr <| Or.inr <| Or.inl ha + · exact Or.inr <| Or.inr <| Or.inr <| Or.inr <| Or.inr <| Or.inl ha + · rcases h1 with ⟨_, ha | ha⟩ + · exact Or.inr <| Or.inr <| Or.inr <| Or.inr <| Or.inr <| + Or.inr <| Or.inr <| Or.inr <| Or.inr <| Or.inr <| Or.inl ha + · exact Or.inr <| Or.inl ha + · rcases h2 with ⟨_, ha | ha⟩ + · exact Or.inr <| Or.inr <| Or.inr <| Or.inr <| Or.inr <| + Or.inr <| Or.inl ha + · exact Or.inr <| Or.inr <| Or.inr <| Or.inl ha + +private theorem hselectedBoundary : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation + ∀ (j : Fin (4 : ℕ)), ∀ (selectedSlot : Fin (3 : ℕ)), ∀ (selectedSign : Bool), + (LatticeVertexIncidentCell normalization.normalizedPoint j ∈ (normalization.pieces + selectedSlot selectedSign).cells) → (∀ (centralSlot : Fin (3 : ℕ)), ∀ (centralSign : + Bool), + let m : Int := if normalization.rightDirectionSlot = 0 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightDirectionSlot = 1 then 0 + else if normalization.rightNeighborPositive = true then -1 else 1 + let n : Int := if normalization.rightDirectionSlot = 0 then 0 + else if normalization.rightDirectionSlot = 1 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightNeighborPositive = true then -1 else 1 + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then (if s = true then .A else .B) + else if i = 1 then (if s = true then .C else .D) + else (if s = true then .E else .F) + let exteriorIndex : PeriodicSubtileIndex := + ⟨labelOf selectedSlot selectedSign, m, n⟩ + let centralIndex : PeriodicSubtileIndex := + ⟨labelOf centralSlot centralSign, 0, 0⟩ + ((normalization.rightNeighborPositive = true ∧ ((normalization.rightDirectionSlot = 0 ∧ + exteriorIndex.first = 1 ∧ exteriorIndex.second = 0) ∨ + (normalization.rightDirectionSlot = 1 ∧ exteriorIndex.first = 0 ∧ + exteriorIndex.second = 1) ∨ (normalization.rightDirectionSlot = 2 ∧ + exteriorIndex.first = -1 ∧ exteriorIndex.second = -1))) ∨ + (normalization.rightNeighborPositive = false ∧ ((normalization.rightDirectionSlot = 0 + ∧ exteriorIndex.first = -1 ∧ exteriorIndex.second = 0) ∨ + (normalization.rightDirectionSlot = 1 ∧ exteriorIndex.first = 0 ∧ + exteriorIndex.second = -1) ∨ (normalization.rightDirectionSlot = 2 ∧ + exteriorIndex.first = 1 ∧ exteriorIndex.second = 1)))) → + ((SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v exteriorIndex = TileTranslation (normalization.layout.P + selectedSlot selectedSign) normalization.rightNeighborDisplacement) → ((BandPrototile + (q selectedSlot.succ) (normalization.pieces selectedSlot selectedSign)) → + ((BandPrototile (q selectedSlot.succ) (normalization.layout.P selectedSlot + selectedSign)) → ((BandPrototile (q selectedSlot.succ) (TileTranslation + (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement)) → ((TileCentroid (normalization.pieces + selectedSlot selectedSign) = TileCentroid (TileTranslation (normalization.layout.P + selectedSlot selectedSign) normalization.rightNeighborDisplacement)) → + (((normalization.pieces selectedSlot selectedSign).cells = (TileTranslation + (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement).cells ∧ ((normalization.pieces selectedSlot + selectedSign).cells = ∅ → (normalization.pieces selectedSlot selectedSign).anchor = + (TileTranslation (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement).anchor)) → ((FootprintVertices + (normalization.pieces selectedSlot selectedSign) = FootprintVertices (TileTranslation + (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement) ∧ BoundaryFootprintVertices + (normalization.pieces selectedSlot selectedSign) = BoundaryFootprintVertices + (TileTranslation (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement) ∧ BoundaryFootprintEdges + (normalization.pieces selectedSlot selectedSign) = BoundaryFootprintEdges + (TileTranslation (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement) ∧ TileRealization (normalization.pieces + selectedSlot selectedSign) = TileRealization (TileTranslation (normalization.layout.P + selectedSlot selectedSign) normalization.rightNeighborDisplacement) ∧ TileCentroid + (normalization.pieces selectedSlot selectedSign) = TileCentroid (TileTranslation + (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement)) → (((normalization.pieces selectedSlot + selectedSign).cells = (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v exteriorIndex).cells) → + (((normalization.pieces selectedSlot selectedSign).cells = ∅ → (normalization.pieces + selectedSlot selectedSign).anchor = (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v + exteriorIndex).anchor) → ((FootprintVertices (normalization.pieces selectedSlot + selectedSign) = FootprintVertices (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v exteriorIndex)) + → ((0 ≤ (q selectedSlot.succ).1) → ((0 < (q selectedSlot.succ).1) → + ((((normalization.functions selectedSlot selectedSign).domain : Set GaussianInt) = + FootprintVertices (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v exteriorIndex)) → + ((LatticeVertexIncidentCell normalization.normalizedPoint j ∈ + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v exteriorIndex).cells) → ((LatticeVertexIncidentCell + normalization.normalizedPoint j ∈ FootprintVertices (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v exteriorIndex) ∧ + LatticeVertexIncidentCell normalization.normalizedPoint j + (1 : GaussianInt) ∈ + FootprintVertices (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v exteriorIndex) ∧ + LatticeVertexIncidentCell normalization.normalizedPoint j + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∈ FootprintVertices (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v exteriorIndex) ∧ + LatticeVertexIncidentCell normalization.normalizedPoint j + (1 : GaussianInt) + (⟨(0 + : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ FootprintVertices (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v exteriorIndex)) + → ((forall y, y = normalization.normalizedPoint ∨ y = normalization.normalizedPoint + + 1 ∨ y = normalization.normalizedPoint - 1 ∨ y = normalization.normalizedPoint + ⟨0, + 1⟩ ∨ y = normalization.normalizedPoint - ⟨0, 1⟩ -> y ∈ FootprintVertices + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v exteriorIndex) ∨ y ∈ FootprintVertices + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v centralIndex)) → (∀ (localizedEdge : Finset GaussianInt), + (localizedEdge ∈ FootprintEdges (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v exteriorIndex) ∩ + FootprintEdges (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v centralIndex)) → + ((normalization.rightNeighborPositive = true ∧ (normalization.rightDirectionSlot = (0 + : Fin (3 : ℕ)) ∧ (exteriorIndex = (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) ∨ exteriorIndex = (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex)) ∨ normalization.rightDirectionSlot = (1 : Fin (3 : ℕ)) ∧ + (exteriorIndex = (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ + exteriorIndex = (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex)) ∨ + normalization.rightDirectionSlot = (2 : Fin (3 : ℕ)) ∧ (exteriorIndex = + (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ exteriorIndex = + (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex))) ∨ + normalization.rightNeighborPositive = false ∧ (normalization.rightDirectionSlot = (0 + : Fin (3 : ℕ)) ∧ (exteriorIndex = (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) ∨ exteriorIndex = (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex)) ∨ normalization.rightDirectionSlot = (1 : Fin (3 : ℕ)) ∧ + (exteriorIndex = (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ + exteriorIndex = (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex)) ∨ + normalization.rightDirectionSlot = (2 : Fin (3 : ℕ)) ∧ (exteriorIndex = + (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ exteriorIndex = + (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex)))) → (∀ [ + Nonempty (BandOrderedGeneralSelectedContactRow q normalization.configuration + normalization.normalizedCircle normalization.normalizedFixed normalization.layout + exteriorIndex centralIndex)], (exteriorIndex = ⟨.A, -1, -1⟩ ∨ exteriorIndex = ⟨.A, 0, + -1⟩ ∨ exteriorIndex = ⟨.C, 1, 0⟩ ∨ exteriorIndex = ⟨.C, 1, 1⟩ ∨ exteriorIndex = ⟨.E, + 0, 1⟩ ∨ exteriorIndex = ⟨.E, -1, 0⟩ ∨ exteriorIndex = ⟨.B, 1, 1⟩ ∨ exteriorIndex = + ⟨.B, 0, 1⟩ ∨ exteriorIndex = ⟨.D, -1, 0⟩ ∨ exteriorIndex = ⟨.D, -1, -1⟩ ∨ + exteriorIndex = ⟨.F, 0, -1⟩ ∨ exteriorIndex = ⟨.F, 1, 0⟩) → ((selectedSlot = + normalization.rightFirstSlot ∧ selectedSign = normalization.firstBoundarySign) ∨ + (selectedSlot = normalization.rightSecondSlot ∧ selectedSign = + normalization.secondBoundarySign)))))))))))))))))))))) ) := by + classical + intro C T N h k x normalization q j selectedSlot selectedSign hselected centralSlot centralSign + m n labelOf exteriorIndex centralIndex hshift hexteriorOccurrence hpieceBand hlayoutBand + htranslatedLayout hcentroidAlign hselectedUnique hselectedObservables hselectedCells + hselectedAnchor hselectedFootprint hparentNonnegative hparentPositive hselectedDomain + hexteriorCell exteriorCorners hstar localizedEdge hlocalizedCommon hclassification hcontact + hexteriorIndex + rcases normalization.right_slots_cyclic with hslots | hslots | hslots <;> + rcases hslots with ⟨hfirst, hsecond, hdirection⟩ <;> + rcases normalization.boundary_signs with hsigns | hsigns <;> + rcases hsigns with ⟨hpositive, hfirstSign, hsecondSign⟩ <;> + fin_cases selectedSlot <;> cases selectedSign <;> + simp [exteriorIndex, labelOf, m, n, hfirst, hsecond, hdirection, + hpositive, hfirstSign, hsecondSign] at hclassification ⊢ + +end RightRoutingGeometry + +theorem BandOrderedGeneralRightRoutingCertificateExists + {C : BandCircle} {T N : ProtoTile} {h k : PartialOdometer} + {x : GaussianInt} + {normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x} + (interface : BandOrderedGeneralRightInterfaceCertificate normalization) : + Nonempty (BandOrderedGeneralRightRoutingCertificate interface) := by +-- BODY + let q := normalization.normalizedPresentation + have hedge := RightRoutingGeometry.hedge C T N h k x normalization interface + have hfixedBand : BandPrototile normalization.normalizedFixedCircle.1.1 + normalization.normalizedFixed := + TileOdometerBandPrototile _ _ _ normalization.normalized_fixed_odometer + have hrootRegular := LatticeEdgeRegularity normalization.normalizedCircle + normalization.normalizedRoot (RightRoutingGeometry.hrootBand C T N h k x normalization) + interface.root_lattice + have hfixedRegular := LatticeEdgeRegularity normalization.normalizedFixedCircle + normalization.normalizedFixed hfixedBand interface.fixed_lattice + have hstart : interface.startData.point ∈ + FootprintVertices normalization.normalizedRoot ∩ + FootprintVertices normalization.normalizedFixed ∩ + FootprintVertices interface.startCompanion := + (interface.startData.unique_common interface.startData.point).2 rfl + have hend := RightRoutingGeometry.hend C T N h k x normalization interface + obtain ⟨j, hjroot, hjfixed⟩ := CoveredInterfaceOppositeIncidentCells + normalization.normalizedRoot normalization.normalizedFixed + interface.startCompanion interface.endCompanion + interface.startData.point interface.startData.otherAB + normalization.normalizedPoint interface.root_lattice interface.fixed_lattice + interface.start_lattice interface.end_lattice interface.root_fixed_disjoint + interface.root_start_disjoint interface.fixed_start_disjoint + interface.root_end_disjoint interface.fixed_end_disjoint + interface.startData.pathAB hedge interface.start_touching + interface.end_touching hstart hend hrootRegular.2.1 hfixedRegular.2.1 + normalization.normalized_star + obtain ⟨selectedSlot, selectedSign, hselected⟩ := + (normalization.piece_cell_cover _).mp hjroot + obtain ⟨centralSlot, centralSign, hcentral⟩ := + (normalization.layout.outer_union _).mp hjfixed + have laws := VectorRecursionLaws q normalization.configuration.proper.1 + have flip := laws.2.2.2.2 normalization.configuration.proper + have turn_flip (s : Fin 3) : + GaussianQuarterTurn (BandVectors.1 (q s.succ) (q 0)) = + BandVectors.1 (q 0) (q s.succ) := RightRoutingGeometry.turn_flip C T N h k x + normalization flip s + have turn0 : GaussianQuarterTurn (BandVectors.1 (q 1) (q 0)) = + BandVectors.1 (q 0) (q 1) := by simpa using turn_flip (0 : Fin 3) + have turn1 : GaussianQuarterTurn (BandVectors.1 (q 2) (q 0)) = + BandVectors.1 (q 0) (q 2) := by simpa using turn_flip (1 : Fin 3) + have turn2 : GaussianQuarterTurn (BandVectors.1 (q 3) (q 0)) = + BandVectors.1 (q 0) (q 3) := by simpa using turn_flip (2 : Fin 3) + have period0 : BandVectors.1 (q 0) (q 1) = normalization.layout.u := + normalization.layout.period_u.symm + have period1 : BandVectors.1 (q 0) (q 2) = normalization.layout.v := + normalization.layout.period_v.symm + let m : Int := if normalization.rightDirectionSlot = 0 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightDirectionSlot = 1 then 0 + else if normalization.rightNeighborPositive = true then -1 else 1 + let n : Int := if normalization.rightDirectionSlot = 0 then 0 + else if normalization.rightDirectionSlot = 1 then + (if normalization.rightNeighborPositive = true then 1 else -1) + else if normalization.rightNeighborPositive = true then -1 else 1 + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then (if s = true then .A else .B) + else if i = 1 then (if s = true then .C else .D) + else (if s = true then .E else .F) + let exteriorIndex : PeriodicSubtileIndex := + ⟨labelOf selectedSlot selectedSign, m, n⟩ + let centralIndex : PeriodicSubtileIndex := + ⟨labelOf centralSlot centralSign, 0, 0⟩ + have hshift := RightRoutingGeometry.hshift C T N h k x normalization selectedSlot selectedSign + have hcentralIndex := RightRoutingGeometry.hcentralIndex C T N h k x normalization j + centralSlot centralSign hcentral + have hexteriorOccurrence := RightRoutingGeometry.hexteriorOccurrence C T N h k x normalization + j selectedSlot selectedSign hselected (RightRoutingGeometry.hdisplacement C T N h k x + normalization period0 period1 (RightRoutingGeometry.period2 C T N h k x normalization + (RightRoutingGeometry.outgoing_relation C T N h k x normalization turn0 turn1 turn2 + (RightRoutingGeometry.incoming_relation C T N h k x normalization laws)) period0 period1)) + hshift + have houterObservables := ProtoTileObservableExtensionality + normalization.normalizedRoot + (TileTranslation normalization.normalizedFixed + normalization.rightNeighborDisplacement) + normalization.right_neighbor_cells normalization.right_neighbor_empty_anchor + have hpieceBand : BandPrototile (q selectedSlot.succ) + (normalization.pieces selectedSlot selectedSign) := + TileOdometerBandPrototile _ _ _ + (normalization.piece_odometer selectedSlot selectedSign) + have hlayoutBand : BandPrototile (q selectedSlot.succ) + (normalization.layout.P selectedSlot selectedSign) := + (normalization.layout.outer_occurrence selectedSlot selectedSign).1 + have htranslatedLayout : BandPrototile (q selectedSlot.succ) + (TileTranslation (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement) := + BandPrototileTranslation _ _ _ hlayoutBand + have hcentroidAlign := RightRoutingGeometry.hcentroidAlign C T N h k x normalization + selectedSlot selectedSign houterObservables + have hselectedUnique := BandPrototileCentroidUnique (q selectedSlot.succ) + (normalization.pieces selectedSlot selectedSign) + (TileTranslation (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement) + hpieceBand htranslatedLayout hcentroidAlign + have hselectedObservables := ProtoTileObservableExtensionality + (normalization.pieces selectedSlot selectedSign) + (TileTranslation (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement) + hselectedUnique.1 hselectedUnique.2 + have hselectedCells := RightRoutingGeometry.hselectedCells C T N h k x normalization + selectedSlot selectedSign hexteriorOccurrence hselectedUnique + have hselectedAnchor := RightRoutingGeometry.hselectedAnchor C T N h k x normalization + selectedSlot selectedSign hexteriorOccurrence hselectedUnique + have hselectedFootprint := RightRoutingGeometry.hselectedFootprint C T N h k x normalization + selectedSlot selectedSign hexteriorOccurrence hselectedObservables + have hparentNonnegative : 0 ≤ (q selectedSlot.succ).1 := + (ProperBandCurvatureStructure q normalization.configuration.proper).2.1 + selectedSlot + have hparentPositive := RightRoutingGeometry.hparentPositive C T N h k x normalization + selectedSlot hparentNonnegative + have hselectedDomain := RightRoutingGeometry.hselectedDomain C T N h k x normalization + selectedSlot selectedSign hselectedFootprint hparentPositive + have hexteriorCell := RightRoutingGeometry.hexteriorCell C T N h k x normalization j + selectedSlot selectedSign hselected hselectedCells + have hcentralCell := RightRoutingGeometry.hcentralCell C T N h k x normalization j centralSlot + centralSign hcentral (RightRoutingGeometry.hcentralOccurrence C T N h k x normalization + centralSlot centralSign (RightRoutingGeometry.translation_zero)) + have footprint_of_cell := RightRoutingGeometry.footprint_of_cell + have exteriorCorners := footprint_of_cell _ _ hexteriorCell + have centralCorners := footprint_of_cell _ _ hcentralCell + have hstar := RightRoutingGeometry.hstar C T N h k x normalization j hjroot hjfixed + selectedSlot selectedSign hselected centralSlot centralSign hcentral hexteriorCell + hcentralCell exteriorCorners centralCorners + obtain ⟨localizedEdge, hlocalizedPoint, hlocalizedCommon, + hclassification, hcontact⟩ := + BandOrderedGeneralShiftedRoutedBoundaryLocalization q + normalization.configuration normalization.normalizedCircle + normalization.normalizedFixed normalization.layout exteriorIndex + centralIndex normalization.normalizedPoint j + normalization.rightDirectionSlot normalization.rightNeighborPositive + hshift hcentralIndex hexteriorCell hcentralCell hstar + have hexteriorIndex := RightRoutingGeometry.hexteriorIndex C T N h k x normalization + selectedSlot selectedSign hclassification + exact ⟨ + { edgeAtPoint := hedge + root_induced := hrootRegular.2.1 + fixed_induced := hfixedRegular.2.1 + routedDirection := j + routed_root_cell := hjroot + routed_fixed_cell := hjfixed + selectedSlot := selectedSlot + selectedSign := selectedSign + selected_piece_cell := hselected + selected_boundary_piece := (@RightRoutingGeometry.hselectedBoundary C T N h k x + normalization j selectedSlot selectedSign hselected centralSlot centralSign hshift + hexteriorOccurrence hpieceBand hlayoutBand htranslatedLayout hcentroidAlign + hselectedUnique hselectedObservables hselectedCells hselectedAnchor hselectedFootprint + hparentNonnegative hparentPositive hselectedDomain hexteriorCell exteriorCorners hstar + localizedEdge hlocalizedCommon hclassification hcontact hexteriorIndex) + exteriorIndex := exteriorIndex + centralIndex := centralIndex + exterior_index := hexteriorIndex + central_index := hcentralIndex + selected_exterior_cells := hselectedCells + selected_exterior_empty_anchor := hselectedAnchor + selected_exterior_footprint := hselectedFootprint + selected_exterior_domain := hselectedDomain + exterior_routed_cell := hexteriorCell + central_routed_cell := hcentralCell + selected_star := hstar + localizedEdge := localizedEdge + localized_edge_at_point := hlocalizedPoint + localized_edge_common := hlocalizedCommon + localized_contact := hcontact }⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedAdjacency.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedAdjacency.lean new file mode 100644 index 0000000000..70d29422d2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedAdjacency.lean @@ -0,0 +1,685 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandCircle +public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightPlacement +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.P3045T1RightBoundaryDisplacementAlgebra +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileSubodometer +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandOrderedGeneralRightSelectedAdjacency] + +/-! +# BandOrderedGeneralRightSelectedAdjacency + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RightSelectedGeometry + +private theorem hpos : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + let i := bundle.selectedSlot + (ProperBandQuadruple q) → (0 < (q i.succ).1) ) := by + classical + intro C D T N h k x bundle q i hq + have hn := (ProperBandCurvatureStructure q hq).2.1 i + have hne := bundle.configuration.noLine i.succ + change (q i.succ).1 ≠ 0 at hne + omega + +private theorem hsub : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + let i := bundle.selectedSlot + let e := bundle.selectedSign + ∀ (hq : ProperBandQuadruple q), ∀ (hpos : 0 < (q i.succ).1), + let C' : BandCircle := ⟨⟨q i.succ, + ⟨Or.inl hpos, q, hq.1, i.succ, rfl⟩⟩, hpos⟩ + TileSubodometer bundle.normalizedCircle.1.1 C'.1.1 bundle.normalizedRoot (bundle.pieces i + e) bundle.normalizedRootFunction (bundle.functions i e) ) := by + classical + intro C D T N h k x bundle q i e hq hpos C' + refine ⟨?_, bundle.piece_odometer i e, bundle.piece_footprint i e, + ?_, bundle.function_restriction i e, q, i, hq, + bundle.normalized_circle_eq, rfl, e, bundle.piece_centroid i e, + bundle.piece_slope i e⟩ + · rw [← bundle.normalized_circle_eq] + exact bundle.normalized_root_odometer + · intro y hy + exact (bundle.function_domain_cover y).mpr ⟨i, e, hy⟩ + +private theorem hsize : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + let i := bundle.selectedSlot + ∀ (hq : ProperBandQuadruple q), ∀ (hpos : 0 < (q i.succ).1), + let C' : BandCircle := ⟨⟨q i.succ, + ⟨Or.inl hpos, q, hq.1, i.succ, rfl⟩⟩, hpos⟩ + Int.toNat bundle.normalizedCircle.1.1.1 + Int.toNat C'.1.1.1 < Int.toNat + bundle.normalizedCircle.1.1.1 + Int.toNat bundle.normalizedCircle.1.1.1 ) := by + classical + intro C D T N h k x bundle q i hq hpos C' + have hlt := hq.2 i + have hnat : Int.toNat (q i.succ).1 < Int.toNat (q 0).1 := by omega + simpa only [q, bundle.normalized_circle_eq] using + Nat.add_lt_add_left hnat (Int.toNat (q 0).1) + +private theorem centralFoot : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), FootprintVertices (SubtileOccurrenceInterpretation + placement.layout.P placement.layout.u placement.layout.v placement.centralIndex) ⊆ + FootprintVertices bundle.normalizedFixed ) := by + classical + intro C D T N h k x bundle placement + have zeroFoot (j : Fin 3) (s : Bool) : + FootprintVertices (TileTranslation (placement.layout.P j s) 0) ⊆ + FootprintVertices bundle.normalizedFixed := by + rw [(TileTranslationFormulas (placement.layout.P j s) 0).2.2.2.2.2.1] + rintro y ⟨z, hz, rfl⟩ + simpa only [GaussianTranslation, add_zero] using + (placement.layout.outer_occurrence j s).2.1 hz + rcases placement.central_index with hA | hB | hC | hD | hE | hF + · simpa [hA, SubtileOccurrenceInterpretation] using zeroFoot 0 true + · simpa [hB, SubtileOccurrenceInterpretation] using zeroFoot 0 false + · simpa [hC, SubtileOccurrenceInterpretation] using zeroFoot 1 true + · simpa [hD, SubtileOccurrenceInterpretation] using zeroFoot 1 false + · simpa [hE, SubtileOccurrenceInterpretation] using zeroFoot 2 true + · simpa [hF, SubtileOccurrenceInterpretation] using zeroFoot 2 false + +private theorem exteriorFoot : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let i := bundle.selectedSlot + let e := bundle.selectedSign + FootprintVertices (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.exteriorIndex) ⊆ FootprintVertices (bundle.pieces i e) ) + := by + classical + intro C D T N h k x bundle placement i e + rw [placement.selected_exterior_footprint] + +private theorem hxFixed : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), + (bundle.normalizedPoint ∈ selectedEdge) → ((selectedEdge ∈ FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.exteriorIndex) ∩ FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.centralIndex)) → ((FootprintVertices + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.centralIndex) ⊆ FootprintVertices + bundle.normalizedFixed) → ((TileOdometer bundle.normalizedCircle.1.1 + bundle.normalizedFixed bundle.normalizedFixedFunction) → (bundle.normalizedPoint ∈ + bundle.normalizedFixedFunction.domain)))) ) := by + classical + intro C D T N h k x bundle placement selectedEdge hx hedge centralFoot hfixedO + let U := SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.centralIndex + have hfoot : bundle.normalizedPoint ∈ FootprintVertices U := by + have he : selectedEdge ∈ FootprintEdges U := hedge.2 + rcases he with ⟨z, hz, rfl | rfl | rfl | rfl⟩ + all_goals + rw [FootprintVertices, ite_eq_left (show U.cells.Nonempty from ⟨z, hz⟩)] + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + refine ⟨z, hz, ?_⟩ + rcases hx with hx | hx <;> simp [hx] + change bundle.normalizedPoint ∈ (bundle.normalizedFixedFunction.domain : Set GaussianInt) + rw [PositiveCurvatureTileOdometerDomain _ _ _ bundle.normalizedCircle.property hfixedO] + exact centralFoot hfoot + +private theorem hxSelected : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), + (bundle.normalizedPoint ∈ selectedEdge) → ((selectedEdge ∈ FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.exteriorIndex) ∩ FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.centralIndex)) → ( + let q := bundle.normalizedPresentation + let i := bundle.selectedSlot + let e := bundle.selectedSign + (0 < (q i.succ).1) → ((FootprintVertices (SubtileOccurrenceInterpretation + placement.layout.P placement.layout.u placement.layout.v placement.exteriorIndex) ⊆ + FootprintVertices (bundle.pieces i e)) → (bundle.normalizedPoint ∈ (bundle.functions + i e).domain)))) ) := by + classical + intro C D T N h k x bundle placement selectedEdge hx hedge q i e hpos exteriorFoot + let U := SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.exteriorIndex + have hfoot : bundle.normalizedPoint ∈ FootprintVertices U := by + have he : selectedEdge ∈ FootprintEdges U := hedge.1 + rcases he with ⟨z, hz, rfl | rfl | rfl | rfl⟩ + all_goals + rw [FootprintVertices, ite_eq_left (show U.cells.Nonempty from ⟨z, hz⟩)] + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + refine ⟨z, hz, ?_⟩ + rcases hx with hx | hx <;> simp [hx] + change bundle.normalizedPoint ∈ ((bundle.functions i e).domain : Set GaussianInt) + rw [PositiveCurvatureTileOdometerDomain _ _ _ hpos (bundle.piece_odometer i e)] + exact exteriorFoot hfoot + +private theorem hstar : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let i := bundle.selectedSlot + let e := bundle.selectedSign + (0 < (q i.succ).1) → ((FootprintVertices (SubtileOccurrenceInterpretation + placement.layout.P placement.layout.u placement.layout.v placement.centralIndex) ⊆ + FootprintVertices bundle.normalizedFixed) → ((FootprintVertices + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.exteriorIndex) ⊆ FootprintVertices (bundle.pieces i e)) + → ((TileOdometer bundle.normalizedCircle.1.1 bundle.normalizedFixed + bundle.normalizedFixedFunction) → (∀ y, y = bundle.normalizedPoint ∨ y = + bundle.normalizedPoint + 1 ∨ y = bundle.normalizedPoint - 1 ∨ y = + bundle.normalizedPoint + ⟨0, 1⟩ ∨ y = bundle.normalizedPoint - ⟨0, 1⟩ → y ∈ + bundle.normalizedFixedFunction.domain ∨ y ∈ (bundle.functions i e).domain)))) ) := by + classical + intro C D T N h k x bundle placement q i e hpos centralFoot exteriorFoot hfixedO y hy + rcases placement.selected_star y hy with hext | hcentral + · right + change y ∈ ((bundle.functions i e).domain : Set GaussianInt) + rw [PositiveCurvatureTileOdometerDomain _ _ _ hpos (bundle.piece_odometer i e)] + exact exteriorFoot hext + · left + change y ∈ (bundle.normalizedFixedFunction.domain : Set GaussianInt) + rw [PositiveCurvatureTileOdometerDomain _ _ _ bundle.normalizedCircle.property hfixedO] + exact centralFoot hcentral + +private theorem rNext : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), placement.rightFirstSlot + 1 = placement.rightSecondSlot ) + := by + classical + intro C D T N h k x bundle placement + rcases placement.right_slots_cyclic with ⟨hr, ht, hk⟩ | ⟨hr, ht, hk⟩ | ⟨hr, ht, hk⟩ + all_goals simp [hr, ht] + +private theorem rPrev : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), placement.rightFirstSlot + 2 = placement.rightDirectionSlot + ) := by + classical + intro C D T N h k x bundle placement + rcases placement.right_slots_cyclic with ⟨hr, ht, hk⟩ | ⟨hr, ht, hk⟩ | ⟨hr, ht, hk⟩ + all_goals simp [hr, hk] + +private theorem tNext : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), placement.rightSecondSlot + 1 = placement.rightDirectionSlot + ) := by + classical + intro C D T N h k x bundle placement + rcases placement.right_slots_cyclic with ⟨hr, ht, hk⟩ | ⟨hr, ht, hk⟩ | ⟨hr, ht, hk⟩ + all_goals simp [ht, hk] + +private theorem tPrev : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), placement.rightSecondSlot + 2 = placement.rightFirstSlot ) + := by + classical + intro C D T N h k x bundle placement + rcases placement.right_slots_cyclic with ⟨hr, ht, hk⟩ | ⟨hr, ht, hk⟩ | ⟨hr, ht, hk⟩ + all_goals simp [ht, hr] + +private theorem hgeometry : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let i := bundle.selectedSlot + let e := bundle.selectedSign + (((1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.1 (q + placement.rightDirectionSlot.succ) (q placement.rightSecondSlot.succ) + (2 : + GaussianInt) * BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + placement.rightDirectionSlot.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + (BandVectors.1 (q placement.rightFirstSlot.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q placement.rightFirstSlot.succ))) → ((-((1 : + GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.1 (q + placement.rightFirstSlot.succ) (q placement.rightDirectionSlot.succ) + (2 : + GaussianInt) * BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + placement.rightDirectionSlot.succ) = -(BandVectors.1 (q + placement.rightSecondSlot.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 + : ℕ))) (q placement.rightSecondSlot.succ))) → ((-((1 : GaussianInt) - (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt)) * BandVectors.1 (q placement.rightDirectionSlot.succ) (q + placement.rightSecondSlot.succ) - (2 : GaussianInt) * BandVectors.1 (q (0 : Fin (4 : + ℕ))) (q placement.rightDirectionSlot.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + (BandVectors.1 (q placement.rightFirstSlot.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q placement.rightFirstSlot.succ))) → ((((1 : + GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.1 (q + placement.rightFirstSlot.succ) (q placement.rightDirectionSlot.succ) - (2 : + GaussianInt) * BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + placement.rightDirectionSlot.succ) = BandVectors.1 (q placement.rightSecondSlot.succ) + (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + placement.rightSecondSlot.succ)) → ((((1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) * BandVectors.2 (q placement.rightDirectionSlot.succ) (q + placement.rightSecondSlot.succ) + (2 : GaussianInt) * BandVectors.2 (q (0 : Fin (4 : + ℕ))) (q placement.rightDirectionSlot.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + (BandVectors.2 (q placement.rightFirstSlot.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q placement.rightFirstSlot.succ))) → ((-((1 : + GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.2 (q + placement.rightFirstSlot.succ) (q placement.rightDirectionSlot.succ) + (2 : + GaussianInt) * BandVectors.2 (q (0 : Fin (4 : ℕ))) (q + placement.rightDirectionSlot.succ) = -(BandVectors.2 (q + placement.rightSecondSlot.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.2 (q (0 : Fin (4 + : ℕ))) (q placement.rightSecondSlot.succ))) → ((-((1 : GaussianInt) + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt)) * BandVectors.2 (q placement.rightDirectionSlot.succ) (q + placement.rightSecondSlot.succ) - (2 : GaussianInt) * BandVectors.2 (q (0 : Fin (4 : + ℕ))) (q placement.rightDirectionSlot.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + (BandVectors.2 (q placement.rightFirstSlot.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q placement.rightFirstSlot.succ))) → ((((1 : + GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.2 (q + placement.rightFirstSlot.succ) (q placement.rightDirectionSlot.succ) - (2 : + GaussianInt) * BandVectors.2 (q (0 : Fin (4 : ℕ))) (q + placement.rightDirectionSlot.succ) = BandVectors.2 (q placement.rightSecondSlot.succ) + (q (0 : Fin (4 : ℕ))) + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q + placement.rightSecondSlot.succ)) → ((∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin + (4 : ℕ))) (q j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) + (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ)))) → (∀ (p' : + ℝ × ℝ), (p'.1 - placement.rightRootSlope.1 = (if e = true then (1 : ℝ) else (-1 : ℝ)) + * (1 / 2 : ℝ) * ((↑(BandVectors.2 (bundle.normalizedPresentation (i + (2 : Fin (3 : + ℕ))).succ) (bundle.normalizedPresentation (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (bundle.normalizedPresentation (i + (2 : Fin (3 : ℕ))).succ) + (bundle.normalizedPresentation (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((p'.2 - + placement.rightRootSlope.2 = (if e = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (bundle.normalizedPresentation (i + (2 : Fin (3 : ℕ))).succ) + (bundle.normalizedPresentation (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + + (↑(BandVectors.2 (bundle.normalizedPresentation (i + (2 : Fin (3 : ℕ))).succ) + (bundle.normalizedPresentation (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → + ((placement.rightFirstSlot + 1 = placement.rightSecondSlot) → + ((placement.rightFirstSlot + 2 = placement.rightDirectionSlot) → + ((placement.rightSecondSlot + 1 = placement.rightDirectionSlot) → + ((placement.rightSecondSlot + 2 = placement.rightFirstSlot) → (((TileCentroid + (bundle.pieces i e) - TileCentroid bundle.normalizedRoot).1 = ((if e = true then (1 : + ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (bundle.normalizedPresentation (i + (2 : Fin (3 : ℕ))).succ) + (bundle.normalizedPresentation (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (bundle.normalizedPresentation (i + (2 : Fin (3 : ℕ))).succ) + (bundle.normalizedPresentation (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint + (BandVectors.1 (bundle.normalizedPresentation (i + (2 : Fin (3 : ℕ))).succ) + (bundle.normalizedPresentation (i + (1 : Fin (3 : ℕ))).succ))).1))).1) → + (((TileCentroid (bundle.pieces i e) - TileCentroid bundle.normalizedRoot).2 = ((if e + = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (bundle.normalizedPresentation (i + (2 : Fin (3 : ℕ))).succ) + (bundle.normalizedPresentation (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (bundle.normalizedPresentation (i + (2 : Fin (3 : ℕ))).succ) + (bundle.normalizedPresentation (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint + (BandVectors.1 (bundle.normalizedPresentation (i + (2 : Fin (3 : ℕ))).succ) + (bundle.normalizedPresentation (i + (1 : Fin (3 : ℕ))).succ))).1))).2) → + (((TileCentroid bundle.normalizedFixed - TileCentroid bundle.normalizedRoot).1 = ((if + placement.rightNeighborPositive = true then (-1 : ℝ) else (1 : ℝ)) • + GaussianRealPoint (BandVectors.1 (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) + (bundle.normalizedPresentation placement.rightDirectionSlot.succ))).1) → + (((TileCentroid bundle.normalizedFixed - TileCentroid bundle.normalizedRoot).2 = ((if + placement.rightNeighborPositive = true then (-1 : ℝ) else (1 : ℝ)) • + GaussianRealPoint (BandVectors.1 (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) + (bundle.normalizedPresentation placement.rightDirectionSlot.succ))).2) → + ((placement.rightFixedSlope.1 - placement.rightRootSlope.1 = (if + placement.rightNeighborPositive = true then (-1 : ℝ) else (1 : ℝ)) * (↑(BandVectors.2 + (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (bundle.normalizedPresentation + placement.rightDirectionSlot.succ)).re : ℝ)) → ((placement.rightFixedSlope.2 - + placement.rightRootSlope.2 = (if placement.rightNeighborPositive = true then (-1 : ℝ) + else (1 : ℝ)) * (↑(BandVectors.2 (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) + (bundle.normalizedPresentation placement.rightDirectionSlot.succ)).im : ℝ)) → (∃ s : + Fin 4, TileCentroid (bundle.pieces i e) - TileCentroid bundle.normalizedFixed = (1 / + 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * (BandVectors.1 (q + i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ))) ∧ p'.1 - placement.rightFixedSlope.1 + = ((1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : GaussianInt) ^ s.val * (BandVectors.2 + (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)))).1 ∧ p'.2 - + placement.rightFixedSlope.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : + GaussianInt) ^ s.val * (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q + i.succ)))).2 ∧ (⟨0, 1⟩ : GaussianInt) ^ s.val * (if Even s.val then BandVectors.1 (q + 0) (q i.succ) else BandVectors.1 (q i.succ) (q 0)) = (if + placement.rightNeighborPositive = true then (-1 : GaussianInt) else 1) * + BandVectors.1 (q 0) (q i.succ)))))))))))))))))))))) ) := by + classical + intro C D T N h k x bundle placement q i e vFirst vSecond vRefFirst vRefSecond aFirst aSecond + aRefFirst aRefSecond flip p' hpieceRe hpieceIm rNext rPrev tNext tPrev hcentRe hcentIm + hfixedRe hfixedIm hfixedSlopeRe hfixedSlopeIm + rcases placement.boundary_signs with ⟨hpol, hfirst, hsecond⟩ | ⟨hpol, hfirst, hsecond⟩ + all_goals rcases placement.selected_boundary_piece with ⟨hslot, hsign⟩ | ⟨hslot, hsign⟩ + case' inl.inl => + have hslot' : i = placement.rightFirstSlot := hslot + have hsign' : e = true := hsign.trans hfirst + refine ⟨3, ?_⟩ + have hv := vFirst + have ha := aFirst + case' inl.inr => + have hslot' : i = placement.rightSecondSlot := hslot + have hsign' : e = false := hsign.trans hsecond + refine ⟨2, ?_⟩ + have hv := vSecond + have ha := aSecond + case' inr.inl => + have hslot' : i = placement.rightFirstSlot := hslot + have hsign' : e = false := hsign.trans hfirst + refine ⟨1, ?_⟩ + have hv := vRefFirst + have ha := aRefFirst + case' inr.inr => + have hslot' : i = placement.rightSecondSlot := hslot + have hsign' : e = true := hsign.trans hsecond + refine ⟨0, ?_⟩ + have hv := vRefSecond + have ha := aRefSecond + all_goals + have hvRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) hv + have hvIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) hv + have haRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) ha + have haIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) ha + simp only [hslot', hsign', rNext, rPrev, tNext, tPrev] at hcentRe hcentIm + simp only [hpol] at hfixedRe hfixedIm + simp only [hslot', hsign', rNext, rPrev, tNext, tPrev] at hpieceRe hpieceIm + simp only [hpol] at hfixedSlopeRe hfixedSlopeIm + norm_num [GaussianRealPoint] at hcentRe hcentIm hfixedRe hfixedIm + norm_num [GaussianRealPoint] at hpieceRe hpieceIm hfixedSlopeRe hfixedSlopeIm + norm_num [GaussianRealPoint] at hvRe hvIm haRe haIm + refine ⟨?_, ?_, ?_, ?_⟩ + · apply Prod.ext + · norm_num [GaussianRealPoint, hslot', hsign', pow_succ] + linarith only [hcentRe, hfixedRe, hvRe] + · norm_num [GaussianRealPoint, hslot', hsign', pow_succ] + linarith only [hcentIm, hfixedIm, hvIm] + · norm_num [GaussianRealPoint, hslot', pow_succ] + linarith only [hpieceRe, hfixedSlopeRe, haRe] + · norm_num [GaussianRealPoint, hslot', pow_succ] + linarith only [hpieceIm, hfixedSlopeIm, haIm] + · have hflip := (flip i).1 + simp only [hslot'] at hflip + ext <;> norm_num [hslot', hpol, pow_succ, hflip, even_iff_two_dvd] + +private theorem hadj : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let i := bundle.selectedSlot + let e := bundle.selectedSign + ∀ (hq : ProperBandQuadruple q), ∀ (hpos : 0 < (q i.succ).1), + let C' : BandCircle := ⟨⟨q i.succ, + ⟨Or.inl hpos, q, hq.1, i.succ, rfl⟩⟩, hpos⟩ + (TileOdometer bundle.normalizedCircle.1.1 bundle.normalizedFixed + bundle.normalizedFixedFunction) → (∀ (p' : ℝ × ℝ), (PartialOdometerSlope + (bundle.functions i e) = some p') → (∀ (s : Fin (4 : ℕ)), (TileCentroid + (bundle.pieces i e) - TileCentroid bundle.normalizedFixed = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)))) → + ((p'.1 - placement.rightFixedSlope.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i.succ)))).1) → ((p'.2 - + placement.rightFixedSlope.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ + : GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i.succ)))).2) → (SubtileLatticeAdjacent + bundle.normalizedCircle C' bundle.normalizedFixed (bundle.pieces i e) + bundle.normalizedFixedFunction (bundle.functions i e)))))) ) := by + classical + intro C D T N h k x bundle placement q i e hq hpos C' hfixedO p' hselectedSlope s hcent + hslopeRe hslopeIm + exact ⟨hfixedO, bundle.piece_odometer i e, + placement.rightFixedSlope, p', placement.right_fixed_slope, hselectedSlope, + q, i, s, hq, bundle.normalized_circle_eq, rfl, hcent, hslopeRe, hslopeIm⟩ + +end RightSelectedGeometry + +theorem BandOrderedGeneralRightSelectedAdjacency : + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction + bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces + bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), (bundle.normalizedPoint ∈ + selectedEdge) → ((selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.centralIndex)) → ((BandOrderedGeneralSelectedContactRow + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout + placement.exteriorIndex placement.centralIndex) → ( + let q := bundle.normalizedPresentation + let i := bundle.selectedSlot + let selectedTile := bundle.pieces i bundle.selectedSign + let selectedFunction := bundle.functions i bundle.selectedSign + let oldRight := TileTranslation bundle.normalizedFixed + ((if placement.rightNeighborPositive = true then (-1 : GaussianInt) + else 1) * BandVectors.1 (q 0) (q i.succ)) + ∃ (C' : BandCircle) (p₀ p' : ℝ × ℝ) (s : Fin 4), + C'.1.1 = q i.succ ∧ + TileSubodometer bundle.normalizedCircle.1.1 C'.1.1 + bundle.normalizedRoot selectedTile bundle.normalizedRootFunction + selectedFunction ∧ + PartialOdometerSlope bundle.normalizedFixedFunction = some p₀ ∧ + PartialOdometerSlope selectedFunction = some p' ∧ + ProperBandQuadruple q ∧ q 0 = bundle.normalizedCircle.1.1 ∧ + q i.succ = C'.1.1 ∧ + TileCentroid selectedTile - TileCentroid bundle.normalizedFixed = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) ∧ + p'.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).1 ∧ + p'.2 - p₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).2 ∧ + SubtileLatticeAdjacent bundle.normalizedCircle C' + bundle.normalizedFixed selectedTile bundle.normalizedFixedFunction + selectedFunction ∧ + bundle.normalizedPoint ∈ bundle.normalizedFixedFunction.domain ∧ + bundle.normalizedPoint ∈ selectedFunction.domain ∧ + (∀ y, y = bundle.normalizedPoint ∨ y = bundle.normalizedPoint + 1 ∨ + y = bundle.normalizedPoint - 1 ∨ + y = bundle.normalizedPoint + ⟨0, 1⟩ ∨ + y = bundle.normalizedPoint - ⟨0, 1⟩ → + y ∈ bundle.normalizedFixedFunction.domain ∨ + y ∈ selectedFunction.domain) ∧ + Int.toNat bundle.normalizedCircle.1.1.1 + Int.toNat C'.1.1.1 < + Int.toNat bundle.normalizedCircle.1.1.1 + + Int.toNat bundle.normalizedCircle.1.1.1 ∧ + TileTranslation bundle.normalizedFixed + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0))) = oldRight))) := by + intro C D T N h k x bundle placement selectedEdge hx hedge row +-- BODY + let q := bundle.normalizedPresentation + let i := bundle.selectedSlot + let e := bundle.selectedSign + have hq : ProperBandQuadruple q := bundle.configuration.proper + have hpos := RightSelectedGeometry.hpos C D T N h k x bundle hq + let C' : BandCircle := ⟨⟨q i.succ, + ⟨Or.inl hpos, q, hq.1, i.succ, rfl⟩⟩, hpos⟩ + have hsub := RightSelectedGeometry.hsub C D T N h k x bundle hq hpos + have hsize := RightSelectedGeometry.hsize C D T N h k x bundle hq hpos + have centralFoot := RightSelectedGeometry.centralFoot C D T N h k x bundle placement + have exteriorFoot := RightSelectedGeometry.exteriorFoot C D T N h k x bundle placement + have hfixedO : TileOdometer bundle.normalizedCircle.1.1 + bundle.normalizedFixed bundle.normalizedFixedFunction := placement.adjacency.2.1 + have hxFixed := RightSelectedGeometry.hxFixed C D T N h k x bundle placement selectedEdge hx + hedge centralFoot hfixedO + have hxSelected := RightSelectedGeometry.hxSelected C D T N h k x bundle placement selectedEdge + hx hedge hpos exteriorFoot + have hstar := RightSelectedGeometry.hstar C D T N h k x bundle placement hpos centralFoot + exteriorFoot hfixedO + obtain ⟨vFirst, vSecond, vRefFirst, vRefSecond, + aFirst, aSecond, aRefFirst, aRefSecond, flip⟩ := + P3045T1RightBoundaryDisplacementAlgebra q hq placement.rightFirstSlot + placement.rightSecondSlot placement.rightDirectionSlot placement.right_slots_cyclic + obtain ⟨p, p', hrootSlope, hselectedSlope, hpieceRe, hpieceIm⟩ := + (bundle.piece_slope i e).resolve_left (ne_of_gt hpos) + have hp : p = placement.rightRootSlope := + Option.some.inj (hrootSlope.symm.trans placement.right_root_slope) + subst p + have rNext := RightSelectedGeometry.rNext C D T N h k x bundle placement + have rPrev := RightSelectedGeometry.rPrev C D T N h k x bundle placement + have tNext := RightSelectedGeometry.tNext C D T N h k x bundle placement + have tPrev := RightSelectedGeometry.tPrev C D T N h k x bundle placement + have hcentRe := congrArg Prod.fst (bundle.piece_centroid i e) + have hcentIm := congrArg Prod.snd (bundle.piece_centroid i e) + have hfixedRe := congrArg Prod.fst placement.right_adjacency_centroid + have hfixedIm := congrArg Prod.snd placement.right_adjacency_centroid + have hfixedSlopeRe := placement.right_adjacency_slope_real + have hfixedSlopeIm := placement.right_adjacency_slope_imag + have hgeometry := RightSelectedGeometry.hgeometry C D T N h k x bundle placement vFirst vSecond + vRefFirst vRefSecond aFirst aSecond aRefFirst aRefSecond flip p' hpieceRe hpieceIm rNext + rPrev tNext tPrev hcentRe hcentIm hfixedRe hfixedIm hfixedSlopeRe hfixedSlopeIm + obtain ⟨s, hcent, hslopeRe, hslopeIm, hcompanion⟩ := hgeometry + have hadj := RightSelectedGeometry.hadj C D T N h k x bundle placement hq hpos hfixedO p' + hselectedSlope s hcent hslopeRe hslopeIm + refine ⟨C', placement.rightFixedSlope, p', s, rfl, hsub, + placement.right_fixed_slope, hselectedSlope, hq, bundle.normalized_circle_eq, + rfl, hcent, hslopeRe, hslopeIm, hadj, hxFixed, hxSelected, hstar, hsize, ?_⟩ + exact congrArg (TileTranslation bundle.normalizedFixed) hcompanion + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean new file mode 100644 index 0000000000..bfcf94cb85 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean @@ -0,0 +1,4918 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5640T1NonpairedOccurrenceIntersections +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.P5635T1RightBoundaryInterfaceRecords +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightPlacement +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizationCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightInterfaceCertificateExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentRightEndpoint +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.CellSupportedFootprintVertices +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceDisjointCompanionEndpoints +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.P3045T1RightBoundaryDisplacementAlgebra +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricExactInterfaceTransport +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileT2QuarterTurn +public import LeanPool.ApollonianSuperharmonic.TileT3TranslateTouching +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandOrderedGeneralRightSelectedRowGeometry] + +/-! +# BandOrderedGeneralRightSelectedRowGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SelectedRowGeometry + +private theorem edgeVertex : + (by + classical + exact + ∀ (tile : ProtoTile), (tile.cells.Nonempty) → (∀ (edge : Finset GaussianInt), (edge ∈ + FootprintEdges tile) → (∀ (point : GaussianInt), (point ∈ edge) → (point ∈ + FootprintVertices tile))) ) := by + classical + intro tile hnon edge hedge point hpoint + rcases hedge with ⟨a, ha, hshape⟩ + rcases hshape with hshape | hshape | hshape | hshape + all_goals rw [hshape] at hpoint + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hpoint + all_goals simp only [FootprintVertices, ite_eq_left hnon, Set.mem_ofPred_eq] + all_goals rcases hpoint with hpoint | hpoint + all_goals rw [hpoint] + all_goals refine ⟨a, ha, ?_⟩; simp + +private theorem turnOutgoing : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + (∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q j.succ) = (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 + (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ)))) → (∀ (s : Fin 3), GaussianQuarterTurn + (BandVectors.1 (q s.succ) (q 0)) = BandVectors.1 (q 0) (q s.succ)) ) := by + classical + intro C D T N h k x bundle q turnFlip s + rw [(turnFlip s).1] + rcases BandVectors.1 (q s.succ) (q 0) with ⟨a, b⟩ + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + +private theorem turnNeg : + (by + classical + exact + ∀ (z : GaussianInt), GaussianQuarterTurn (-z) = -GaussianQuarterTurn z ) := by + classical + intro z + rcases z with ⟨a, b⟩ + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + +private theorem turnTwice : + (by + classical + exact + ∀ (z : GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn z) = -z ) := by + classical + intro z + rcases z with ⟨a, b⟩ + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + +private theorem turnThrice : + (by + classical + exact + (∀ (z : GaussianInt), GaussianQuarterTurn (-z) = -GaussianQuarterTurn z) → ((∀ (z : + GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn z) = -z) → (∀ (z : + GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) = + -GaussianQuarterTurn z)) ) := by + classical + intro turnNeg turnTwice z + calc + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) = + GaussianQuarterTurn (-z) := congrArg GaussianQuarterTurn (turnTwice z) + _ = -GaussianQuarterTurn z := turnNeg z + +private theorem centeredExactTurn : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + (BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection) → ( + let F := bundle.normalizedFixed + ∀ (a : GaussianInt), ∀ (b : GaussianInt), (ExactTileInterfaceTriple F (TileTranslation F a) + (TileTranslation F b)) → (Nonempty (ExactTileInterfaceTriple F (TileTranslation F + (GaussianQuarterTurn a)) (TileTranslation F (GaussianQuarterTurn b))))) ) := by + classical + intro C D T N h k x bundle placement F a b E + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + obtain ⟨_, _, E', _, _, _, _⟩ := + QuarterTurnSymmetricExactInterfaceTransport F a b E + (TileT2QuarterTurn q cfg bundle.normalizedCircle F placement.layout) + exact ⟨E'⟩ + +private theorem twiceExactTurn : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let F := bundle.normalizedFixed + (∀ (a : GaussianInt), ∀ (b : GaussianInt), (ExactTileInterfaceTriple F (TileTranslation F + a) (TileTranslation F b)) → (Nonempty (ExactTileInterfaceTriple F (TileTranslation F + (GaussianQuarterTurn a)) (TileTranslation F (GaussianQuarterTurn b))))) → (∀ (a : + GaussianInt), ∀ (b : GaussianInt), (ExactTileInterfaceTriple F (TileTranslation F a) + (TileTranslation F b)) → (Nonempty (ExactTileInterfaceTriple F (TileTranslation F + (GaussianQuarterTurn (GaussianQuarterTurn a))) (TileTranslation F + (GaussianQuarterTurn (GaussianQuarterTurn b)))))) ) := by + classical + intro C D T N h k x bundle F centeredExactTurn a b E + obtain ⟨E1⟩ := centeredExactTurn a b E + exact centeredExactTurn (GaussianQuarterTurn a) (GaussianQuarterTurn b) E1 + +private theorem thriceExactTurn : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let F := bundle.normalizedFixed + (∀ (a : GaussianInt), ∀ (b : GaussianInt), (ExactTileInterfaceTriple F (TileTranslation F + a) (TileTranslation F b)) → (Nonempty (ExactTileInterfaceTriple F (TileTranslation F + (GaussianQuarterTurn a)) (TileTranslation F (GaussianQuarterTurn b))))) → (∀ (a : + GaussianInt), ∀ (b : GaussianInt), (ExactTileInterfaceTriple F (TileTranslation F a) + (TileTranslation F b)) → (Nonempty (ExactTileInterfaceTriple F (TileTranslation F + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn a)))) + (TileTranslation F (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn + b))))))) ) := by + classical + intro C D T N h k x bundle F centeredExactTurn a b E + obtain ⟨E1⟩ := centeredExactTurn a b E + obtain ⟨E2⟩ := centeredExactTurn (GaussianQuarterTurn a) + (GaussianQuarterTurn b) E1 + exact centeredExactTurn (GaussianQuarterTurn (GaussianQuarterTurn a)) + (GaussianQuarterTurn (GaussianQuarterTurn b)) E2 + +private theorem tripleTurnOutgoing : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + (∀ (s : Fin 3), GaussianQuarterTurn (BandVectors.1 (q s.succ) (q 0)) = BandVectors.1 (q + 0) (q s.succ)) → ((∀ (z : GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn z)) = -GaussianQuarterTurn z) → (∀ (ell : Fin 3), + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q + ell.succ) (q 0)))) = -BandVectors.1 (q 0) (q ell.succ))) ) := by + classical + intro C D T N h k x bundle q turnOutgoing turnThrice ell + calc + _ = -GaussianQuarterTurn (BandVectors.1 (q ell.succ) (q 0)) := + turnThrice _ + _ = _ := by rw [turnOutgoing] + +private theorem tripleTurnNegativeNext : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + (∀ (s : Fin 3), GaussianQuarterTurn (BandVectors.1 (q s.succ) (q 0)) = BandVectors.1 (q + 0) (q s.succ)) → ((∀ (z : GaussianInt), GaussianQuarterTurn (-z) = + -GaussianQuarterTurn z) → ((∀ (z : GaussianInt), GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn z)) = -GaussianQuarterTurn z) → (∀ (ell : + Fin 3), GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (-BandVectors.1 + (q (ell + 1).succ) (q 0)))) = BandVectors.1 (q 0) (q (ell + 1).succ)))) ) := by + classical + intro C D T N h k x bundle q turnOutgoing turnNeg turnThrice ell + calc + _ = -GaussianQuarterTurn (-BandVectors.1 (q (ell + 1).succ) (q 0)) := + turnThrice _ + _ = GaussianQuarterTurn (BandVectors.1 (q (ell + 1).succ) (q 0)) := by + rw [turnNeg] + simp + _ = _ := by rw [turnOutgoing] + +private theorem hedge : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (A' : ProtoTile), (A.cells = A'.cells) → (FootprintEdges A = + FootprintEdges A') ) := by + classical + intro A A' hcell + simp only [FootprintEdges] + rw [hcell] + +private theorem tileTouchingRetarget : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), (A.cells = + A'.cells) → ((A.cells = ∅ → A.anchor = A'.anchor) → ((B.cells = B'.cells) → ((B.cells + = ∅ → B.anchor = B'.anchor) → ((TileTouching A B) → (TileTouching A' B'))))) ) := by + classical + intro A A' B B' hAc hAa hBc hBa ht + have hAo := ProtoTileObservableExtensionality A A' hAc hAa + have hBo := ProtoTileObservableExtensionality B B' hBc hBa + rcases ht with ht | ht | ht + · left + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa [hAc] using ht.1 + · simpa [hBc] using ht.2.1 + · simpa [hAc, hBc] using ht.2.2.1 + · simpa [hAo.2.1, hAo.2.2.1, hBo.2.1, hBo.2.2.1] using ht.2.2.2 + · right; left + refine ⟨?_, ?_⟩ + · simpa [hAc] using ht.1 + · rw [← hAa ht.1, ← hBo.2.1] + exact ht.2 + · right; right + refine ⟨?_, ?_⟩ + · simpa [hBc] using ht.1 + · rw [← hBa ht.1, ← hAo.2.1] + exact ht.2 + +private theorem touchingRetarget : + (by + classical + exact + (∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), (A.cells = + A'.cells) → ((A.cells = ∅ → A.anchor = A'.anchor) → ((B.cells = B'.cells) → ((B.cells + = ∅ → B.anchor = B'.anchor) → ((TileTouching A B) → (TileTouching A' B')))))) → (∀ (A + : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (D : + ProtoTile), ∀ (D' : ProtoTile), (A.cells = A'.cells) → ((A.cells = ∅ → A.anchor = + A'.anchor) → ((B.cells = B'.cells) → ((B.cells = ∅ → B.anchor = B'.anchor) → + ((D.cells = D'.cells) → ((D.cells = ∅ → D.anchor = D'.anchor) → ((TouchingTriple A B + D) → (TouchingTriple A' B' D')))))))) ) := by + classical + intro tileTouchingRetarget A A' B B' D D' hAc hAa hBc hBa hDc hDa ht + have hAo := ProtoTileObservableExtensionality A A' hAc hAa + have hBo := ProtoTileObservableExtensionality B B' hBc hBa + have hDo := ProtoTileObservableExtensionality D D' hDc hDa + rcases ht with ⟨hAB, hBD, hDA, p, hp, hpu⟩ + refine ⟨tileTouchingRetarget A A' B B' hAc hAa hBc hBa hAB, + tileTouchingRetarget B B' D D' hBc hBa hDc hDa hBD, + tileTouchingRetarget D D' A A' hDc hDa hAc hAa hDA, p, ?_, ?_⟩ + · simpa [← hAo.2.1, ← hBo.2.1, ← hDo.2.1] using hp + · intro y hy + apply hpu y + simpa [← hAo.2.1, ← hBo.2.1, ← hDo.2.1] using hy + +private theorem quarterTranslate : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), + (BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x) → (∀ (A : ProtoTile), ∀ + (a : GaussianInt), ∀ (u₀ : GaussianInt), TileTranslation (TileQuarterTurn + (TileTranslation A a)) u₀ = TileTranslation (TileTranslation (TileQuarterTurn A) u₀) + (GaussianQuarterTurn a)) ) := by + classical + intro C D T N h k x bundle A a u₀ + rcases A with ⟨cells, anchor⟩ + rw [ProtoTile.mk.injEq] + constructor + · ext z + simp only [TileTranslation, TileQuarterTurn, Finset.mem_image, + GaussianTranslation] + constructor + · rintro ⟨y, hy, rfl⟩ + rcases hy with ⟨w, hw, rfl⟩ + rcases hw with ⟨v, hv, rfl⟩ + refine ⟨GaussianQuarterTurn v - 1 + u₀, ?_, ?_⟩ + · refine ⟨GaussianQuarterTurn v - 1, ?_, rfl⟩ + exact ⟨v, hv, rfl⟩ + · cases a; cases v; cases u₀ + apply Zsqrtd.ext <;> + simp [GaussianQuarterTurn] <;> omega + · rintro ⟨y, hy, rfl⟩ + rcases hy with ⟨w, hw, rfl⟩ + rcases hw with ⟨v, hv, rfl⟩ + refine ⟨GaussianQuarterTurn (GaussianTranslation a v) - 1, ?_, ?_⟩ + · exact ⟨GaussianTranslation a v, ⟨v, hv, rfl⟩, rfl⟩ + · cases a; cases v; cases u₀ + apply Zsqrtd.ext <;> + simp [GaussianQuarterTurn, GaussianTranslation] <;> omega + · ext <;> simp [TileTranslation, TileQuarterTurn, GaussianTranslation, + GaussianQuarterTurn] <;> omega + +private theorem translateObs : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (d : GaussianInt), (A.cells = A'.cells) → + ((A.cells = ∅ → A.anchor = A'.anchor) → ((TileTranslation A d).cells = + (TileTranslation A' d).cells ∧ ((TileTranslation A d).cells = ∅ → (TileTranslation A + d).anchor = (TileTranslation A' d).anchor))) ) := by + classical + intro A A' d hc ha + constructor + · simp [TileTranslation, hc] + · intro he + have he' : A.cells = ∅ := (TileTranslationFormulas A d).2.2.1.mp he + simp [TileTranslation, ha he'] + +private theorem centeredTurnTouching : + (by + classical + exact + (∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (D : + ProtoTile), ∀ (D' : ProtoTile), (A.cells = A'.cells) → ((A.cells = ∅ → A.anchor = + A'.anchor) → ((B.cells = B'.cells) → ((B.cells = ∅ → B.anchor = B'.anchor) → + ((D.cells = D'.cells) → ((D.cells = ∅ → D.anchor = D'.anchor) → ((TouchingTriple A B + D) → (TouchingTriple A' B' D')))))))) → ((∀ (A : ProtoTile), ∀ (a : GaussianInt), ∀ + (u₀ : GaussianInt), TileTranslation (TileQuarterTurn (TileTranslation A a)) u₀ = + TileTranslation (TileTranslation (TileQuarterTurn A) u₀) (GaussianQuarterTurn a)) → + ((∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (d : GaussianInt), (A.cells = A'.cells) → + ((A.cells = ∅ → A.anchor = A'.anchor) → ((TileTranslation A d).cells = + (TileTranslation A' d).cells ∧ ((TileTranslation A d).cells = ∅ → (TileTranslation A + d).anchor = (TileTranslation A' d).anchor)))) → (∀ (A : ProtoTile), ∀ (a : + GaussianInt), ∀ (b : GaussianInt), (QuarterTurnSymmetric A) → ((TouchingTriple A + (TileTranslation A a) (TileTranslation A b)) → (TouchingTriple A (TileTranslation A + (GaussianQuarterTurn a)) (TileTranslation A (GaussianQuarterTurn b))))))) ) := by + classical + intro touchingRetarget quarterTranslate translateObs A a b hsym ht + obtain ⟨u₀, hu₀, hcell, hanchor, _, _⟩ := + QuarterTurnSymmetricCenteredTransport A hsym + have hanchor' : (TileTranslation (TileQuarterTurn A) u₀).cells = ∅ → + (TileTranslation (TileQuarterTurn A) u₀).anchor = A.anchor := by + intro he + apply hanchor + rw [← hcell] + exact he + have hq := (TouchingTripleCovariance A (TileTranslation A a) + (TileTranslation A b) u₀).2.1.mp ht + have hqt := (TouchingTripleCovariance (TileQuarterTurn A) + (TileQuarterTurn (TileTranslation A a)) + (TileQuarterTurn (TileTranslation A b)) u₀).1.mp hq + rw [quarterTranslate A a u₀, quarterTranslate A b u₀] at hqt + have ha := translateObs (TileTranslation (TileQuarterTurn A) u₀) A + (GaussianQuarterTurn a) hcell hanchor' + have hb := translateObs (TileTranslation (TileQuarterTurn A) u₀) A + (GaussianQuarterTurn b) hcell hanchor' + exact touchingRetarget + (TileTranslation (TileQuarterTurn A) u₀) A + (TileTranslation (TileTranslation (TileQuarterTurn A) u₀) + (GaussianQuarterTurn a)) (TileTranslation A (GaussianQuarterTurn a) + ) + (TileTranslation (TileTranslation (TileQuarterTurn A) u₀) + (GaussianQuarterTurn b)) (TileTranslation A (GaussianQuarterTurn b)) + hcell hanchor' ha.1 ha.2 hb.1 hb.2 hqt + +private theorem twiceTouching : + (by + classical + exact + (∀ (A : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (QuarterTurnSymmetric A) → + ((TouchingTriple A (TileTranslation A a) (TileTranslation A b)) → (TouchingTriple A + (TileTranslation A (GaussianQuarterTurn a)) (TileTranslation A (GaussianQuarterTurn + b))))) → (∀ (A : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + (QuarterTurnSymmetric A) → ((TouchingTriple A (TileTranslation A a) (TileTranslation + A b)) → (TouchingTriple A (TileTranslation A (GaussianQuarterTurn + (GaussianQuarterTurn a))) (TileTranslation A (GaussianQuarterTurn + (GaussianQuarterTurn b)))))) ) := by + classical + intro centeredTurnTouching A a b hsym ht + have ht' := centeredTurnTouching A a b hsym ht + exact centeredTurnTouching A (GaussianQuarterTurn a) (GaussianQuarterTurn b) + hsym ht' + +private theorem thriceTouching : + (by + classical + exact + (∀ (A : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (QuarterTurnSymmetric A) → + ((TouchingTriple A (TileTranslation A a) (TileTranslation A b)) → (TouchingTriple A + (TileTranslation A (GaussianQuarterTurn a)) (TileTranslation A (GaussianQuarterTurn + b))))) → ((∀ (A : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + (QuarterTurnSymmetric A) → ((TouchingTriple A (TileTranslation A a) (TileTranslation + A b)) → (TouchingTriple A (TileTranslation A (GaussianQuarterTurn + (GaussianQuarterTurn a))) (TileTranslation A (GaussianQuarterTurn + (GaussianQuarterTurn b)))))) → (∀ (A : ProtoTile), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), (QuarterTurnSymmetric A) → ((TouchingTriple A (TileTranslation A a) + (TileTranslation A b)) → (TouchingTriple A (TileTranslation A (GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn a)))) (TileTranslation A + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn b)))))))) ) := by + classical + intro centeredTurnTouching twiceTouching A a b hsym ht + exact centeredTurnTouching A _ _ hsym + (twiceTouching A a b hsym ht) + +private theorem touchingPlus : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + (BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection) → ( + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (i : Fin (3 : ℕ)), TouchingTriple F (TileTranslation F (BandVectors.1 (q i.succ) (q (0 + : Fin (4 : ℕ))))) (TileTranslation F (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) + (q (0 : Fin (4 : ℕ)))))) → ((∀ (s : Fin 3), GaussianQuarterTurn (BandVectors.1 (q + s.succ) (q 0)) = BandVectors.1 (q 0) (q s.succ)) → ((∀ (z : GaussianInt), + GaussianQuarterTurn (-z) = -GaussianQuarterTurn z) → ((∀ (A : ProtoTile), ∀ (a : + GaussianInt), ∀ (b : GaussianInt), (QuarterTurnSymmetric A) → ((TouchingTriple A + (TileTranslation A a) (TileTranslation A b)) → (TouchingTriple A (TileTranslation A + (GaussianQuarterTurn a)) (TileTranslation A (GaussianQuarterTurn b))))) → (∀ (ell : + Fin 3), TouchingTriple F (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ)))))))) ) := by + classical + intro C D T N h k x bundle placement q F translatedTouching turnOutgoing turnNeg + centeredTurnTouching ell + let cfg := bundle.configuration + have ht := centeredTurnTouching F + (BandVectors.1 (q ell.succ) (q 0)) + (-BandVectors.1 (q (ell + 1).succ) (q 0)) + (TileT2QuarterTurn q cfg bundle.normalizedCircle F placement.layout) + (translatedTouching ell) + simpa [turnOutgoing, turnNeg] using ht + +private theorem touchingMinus : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + (BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection) → ( + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (i : Fin (3 : ℕ)), TouchingTriple F (TileTranslation F (BandVectors.1 (q i.succ) (q (0 + : Fin (4 : ℕ))))) (TileTranslation F (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) + (q (0 : Fin (4 : ℕ)))))) → ((∀ (ell : Fin 3), GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q ell.succ) (q 0)))) = + -BandVectors.1 (q 0) (q ell.succ)) → ((∀ (ell : Fin 3), GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn (-BandVectors.1 (q (ell + 1).succ) (q 0)))) + = BandVectors.1 (q 0) (q (ell + 1).succ)) → ((∀ (A : ProtoTile), ∀ (a : GaussianInt), + ∀ (b : GaussianInt), (QuarterTurnSymmetric A) → ((TouchingTriple A (TileTranslation A + a) (TileTranslation A b)) → (TouchingTriple A (TileTranslation A (GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn a)))) (TileTranslation A + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn b))))))) → (∀ (ell : + Fin 3), TouchingTriple F (TileTranslation F (-BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (BandVectors.1 (q 0) (q (ell + 1).succ)))))))) ) := by + classical + intro C D T N h k x bundle placement q F translatedTouching tripleTurnOutgoing + tripleTurnNegativeNext thriceTouching ell + let cfg := bundle.configuration + have ht := thriceTouching F + (BandVectors.1 (q ell.succ) (q 0)) + (-BandVectors.1 (q (ell + 1).succ) (q 0)) + (TileT2QuarterTurn q cfg bundle.normalizedCircle F placement.layout) + (translatedTouching ell) + simpa only [tripleTurnOutgoing, tripleTurnNegativeNext] using ht + +private theorem indexNe : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), (BandOrderedGeneralSelectedContactRow + bundle.normalizedPresentation bundle.configuration bundle.normalizedCircle + bundle.normalizedFixed placement.layout placement.exteriorIndex + placement.centralIndex) → ( + placement.exteriorIndex ≠ placement.centralIndex) ) := by + classical + intro C D T N h k x bundle placement row + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let F := bundle.normalizedFixed + have labels : ∀ a b, BandOrderedGeneralSelectedContactRow q cfg + bundle.normalizedCircle F placement.layout a b → a.label ≠ b.label := by + intro a b r + cases r <;> decide +kernel + intro heq + exact labels _ _ row (congrArg PeriodicSubtileIndex.label heq) + +private theorem originalAllowed : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), (selectedEdge ∈ + FootprintEdges (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.exteriorIndex) ∩ FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.centralIndex)) → ( + (placement.exteriorIndex ≠ placement.centralIndex) → (AllowedSubtileIncidence + placement.exteriorIndex placement.centralIndex)) ) := by + classical + intro C D T N h k x bundle placement selectedEdge hedge indexNe + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let F := bundle.normalizedFixed + have hclass := BandOriginalOccurrenceIntersectionClassification q cfg + bundle.normalizedCircle F placement.layout + apply (hclass placement.exteriorIndex placement.centralIndex indexNe).1 + exact ⟨selectedEdge, hedge⟩ + +private theorem modifiedEdgesNonempty : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), (placement.exteriorIndex ≠ placement.centralIndex) → + ((placement.layout.modified.plane.adjacent placement.exteriorIndex + placement.centralIndex) → ((FootprintEdges (placement.layout.modified.tile + placement.exteriorIndex) ∩ FootprintEdges (placement.layout.modified.tile + placement.centralIndex)).Nonempty)) ) := by + classical + intro C D T N h k x bundle placement indexNe modifiedAdjacent + have hclass := PeriodicTileIntersectionClassification + placement.layout.modified + have hadj := (hclass.1 placement.exteriorIndex placement.centralIndex indexNe).1 + exact hadj.mpr modifiedAdjacent + +private theorem modifiedPath : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), (placement.exteriorIndex ≠ placement.centralIndex) → + (((FootprintEdges (placement.layout.modified.tile placement.exteriorIndex) ∩ + FootprintEdges (placement.layout.modified.tile placement.centralIndex)).Nonempty) → + (∃ s t : GaussianInt, SimpleGridPathBetween (FootprintVertices + (placement.layout.modified.tile placement.exteriorIndex) ∩ FootprintVertices + (placement.layout.modified.tile placement.centralIndex)) (FootprintEdges + (placement.layout.modified.tile placement.exteriorIndex) ∩ FootprintEdges + (placement.layout.modified.tile placement.centralIndex)) s t)) ) := by + classical + intro C D T N h k x bundle placement indexNe modifiedEdgesNonempty + have hclassification := PeriodicTileIntersectionClassification + placement.layout.modified + have hpaths := PeriodicTileIntersectionPaths placement.layout.modified + hclassification.2 placement.exteriorIndex placement.centralIndex indexNe + rcases hpaths.1.mpr modifiedEdgesNonempty with + ⟨_, f, g, _, _, _, _, hpath⟩ + have hvertices := (hclassification.1 placement.exteriorIndex + placement.centralIndex indexNe).2.1 modifiedEdgesNonempty + rw [← hvertices.2] at hpath + exact ⟨_, _, hpath⟩ + +private theorem noPairedOccurrence : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), (BandOrderedGeneralSelectedContactRow + bundle.normalizedPresentation bundle.configuration bundle.normalizedCircle + bundle.normalizedFixed placement.layout placement.exteriorIndex + placement.centralIndex) → ( + ¬ ((placement.exteriorIndex.label = .A ∧ placement.centralIndex.label = .B ∨ + placement.exteriorIndex.label = .B ∧ placement.centralIndex.label = .A) ∧ + placement.exteriorIndex.first = placement.centralIndex.first ∧ + placement.exteriorIndex.second = placement.centralIndex.second)) ) := by + classical + intro C D T N h k x bundle placement row + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let F := bundle.normalizedFixed + have coordinates : ∀ a b, BandOrderedGeneralSelectedContactRow q cfg + bundle.normalizedCircle F placement.layout a b → + ¬ (a.first = b.first ∧ a.second = b.second) := by + intro a b r + cases r <;> decide +kernel + intro hp + exact coordinates _ _ row hp.2 + +private theorem originalSelectedPath : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), + (bundle.normalizedPoint ∈ selectedEdge) → ((selectedEdge ∈ FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.exteriorIndex) ∩ FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.centralIndex)) → ( + (∃ s t : GaussianInt, SimpleGridPathBetween (FootprintVertices + (placement.layout.modified.tile placement.exteriorIndex) ∩ FootprintVertices + (placement.layout.modified.tile placement.centralIndex)) (FootprintEdges + (placement.layout.modified.tile placement.exteriorIndex) ∩ FootprintEdges + (placement.layout.modified.tile placement.centralIndex)) s t) → ( + let P := placement.layout.P + let u := placement.layout.u + let v := placement.layout.v + (FootprintEdges (ModifiedSubtileOccurrenceInterpretation placement.layout.P + placement.layout.O placement.layout.u placement.layout.v placement.exteriorIndex) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation placement.layout.P + placement.layout.O placement.layout.u placement.layout.v placement.centralIndex) = + FootprintEdges (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.exteriorIndex) ∩ FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.centralIndex) ∧ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation placement.layout.P placement.layout.O + placement.layout.u placement.layout.v placement.exteriorIndex) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation placement.layout.P placement.layout.O + placement.layout.u placement.layout.v placement.centralIndex) = FootprintVertices + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.exteriorIndex) ∩ FootprintVertices + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.centralIndex)) → ( + let selectedPath : Prop := + (∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + (FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge) + selectedPath)))) ) := by + classical + intro C D T N h k x bundle placement selectedEdge hx hedge modifiedPath P u v + selectedOccurrenceRetarget selectedPath + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let F := bundle.normalizedFixed + rcases modifiedPath with ⟨selectedStart, selectedEnd, hpath⟩ + have hpath' := hpath + rw [placement.layout.modified_tile placement.exteriorIndex, + placement.layout.modified_tile placement.centralIndex] at hpath' + rw [selectedOccurrenceRetarget.2, + selectedOccurrenceRetarget.1] at hpath' + exact ⟨selectedStart, selectedEnd, hpath', hedge, hx⟩ + +private theorem canonicalFinish : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), (selectedEdge ∈ + FootprintEdges (SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v placement.exteriorIndex) ∩ FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.centralIndex)) → ( + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + ∀ (edgeVertex : ∀ (tile : ProtoTile), (tile.cells.Nonempty) → (∀ (edge : Finset + GaussianInt), (edge ∈ FootprintEdges tile) → (∀ (point : GaussianInt), (point ∈ edge) + → (point ∈ FootprintVertices tile)))), + let norm : BandOrderedGeneralRightNormalizationCertificate C T N h k x := { + presentation := bundle.presentation + presentation_proper := bundle.presentation_proper + presentation_child := bundle.presentation_child + parentRotation := bundle.parentRotation + symmetry := bundle.symmetry + rotatedPresentation := bundle.rotatedPresentation + rotated_presentation_eq := bundle.rotated_presentation_eq + normalizedPresentation := q + normalized_presentation_eq := bundle.normalized_presentation_eq + configuration := cfg + normalizedCircle := bundle.normalizedCircle + normalized_circle_eq := bundle.normalized_circle_eq + normalizedFixedCircle := bundle.normalizedCircle + normalized_fixed_circle_eq := by + calc + bundle.normalizedCircle.1.1 = q 0 := bundle.normalized_circle_eq.symm + _ = BandPackingSymmetryCircleAction bundle.symmetry C.1.1 := by + have hq0 := congrFun bundle.normalized_presentation_eq 0 + calc + q 0 = BandPackingSymmetryCircleAction bundle.symmetry + (bundle.rotatedPresentation 0) := by + simpa [BandPackingSymmetryQuadrupleAction] using hq0 + _ = BandPackingSymmetryCircleAction bundle.symmetry C.1.1 := by + rw [bundle.rotated_presentation_eq] + simp [bundle.presentation_child] + normalizedRoot := root + normalizedFixed := F + normalizedRootFunction := bundle.normalizedRootFunction + normalizedFixedFunction := bundle.normalizedFixedFunction + normalizedPoint := bundle.normalizedPoint + normalized_root_eq := bundle.normalized_root_eq + normalized_fixed_eq := bundle.normalized_fixed_eq + normalized_root_function_eq := bundle.normalized_root_function_eq + normalized_fixed_function_eq := bundle.normalized_fixed_function_eq + normalized_point_eq := bundle.normalized_point_eq + normalized_point_root_domain := by + obtain ⟨edge, hp, he⟩ := bundle.edgeAtPoint + have hne := (LatticeTileGridStructure root bundle.root_lattice).1.1 + have hvert := edgeVertex root hne edge he.1 bundle.normalizedPoint hp + have hdom := PositiveCurvatureTileOdometerDomain (q 0) root + bundle.normalizedRootFunction (ProperBandCurvatureStructure q cfg.proper).1 + bundle.normalized_root_odometer + exact (Set.ext_iff.mp hdom bundle.normalizedPoint).mpr hvert + normalized_point_fixed_domain := by + obtain ⟨edge, hp, he⟩ := bundle.edgeAtPoint + have hne := (LatticeTileGridStructure F bundle.fixed_lattice).1.1 + have hvert := edgeVertex F hne edge he.2 bundle.normalizedPoint hp + have hdom := PositiveCurvatureTileOdometerDomain + bundle.normalizedCircle.1.1 F bundle.normalizedFixedFunction + bundle.normalizedCircle.property placement.adjacency.2.1 + exact (Set.ext_iff.mp hdom bundle.normalizedPoint).mpr hvert + normalized_root_odometer := bundle.normalized_root_odometer + normalized_fixed_odometer := placement.adjacency.2.1 + normalized_root_lattice := bundle.root_lattice + normalized_fixed_lattice := bundle.fixed_lattice + normalizedRootSlope := bundle.normalizedRootSlope + normalizedFixedSlope := bundle.normalizedFixedSlope + normalized_root_slope := bundle.normalized_root_slope + normalized_fixed_slope := bundle.normalized_fixed_slope + pieces := bundle.pieces + functions := bundle.functions + root_band := bundle.root_band + piece_odometer := bundle.piece_odometer + piece_cell_cover := bundle.piece_cell_cover + piece_footprint := bundle.piece_footprint + piece_centroid := bundle.piece_centroid + function_domain_cover := bundle.function_domain_cover + function_restriction := bundle.function_restriction + function_compatibility := bundle.function_compatibility + piece_slope := bundle.piece_slope + adjacency := placement.adjacency + layout := placement.layout + fixed_quarter_turn := TileT2QuarterTurn q cfg bundle.normalizedCircle F placement.layout + rightFirstSlot := placement.rightFirstSlot + rightSecondSlot := placement.rightSecondSlot + rightDirectionSlot := placement.rightDirectionSlot + right_slots_cyclic := placement.right_slots_cyclic + rightNeighborPositive := placement.rightNeighborPositive + right_adjacency_centroid := placement.right_adjacency_centroid + right_adjacency_slope_real := by + have hroot : placement.rightRootSlope = bundle.normalizedRootSlope := + Option.some.inj (placement.right_root_slope.symm.trans + bundle.normalized_root_slope) + have hf : placement.rightFixedSlope = bundle.normalizedFixedSlope := + Option.some.inj (placement.right_fixed_slope.symm.trans + bundle.normalized_fixed_slope) + simpa [hroot, hf, q] using placement.right_adjacency_slope_real + right_adjacency_slope_imag := by + have hroot : placement.rightRootSlope = bundle.normalizedRootSlope := + Option.some.inj (placement.right_root_slope.symm.trans + bundle.normalized_root_slope) + have hf : placement.rightFixedSlope = bundle.normalizedFixedSlope := + Option.some.inj (placement.right_fixed_slope.symm.trans + bundle.normalized_fixed_slope) + simpa [hroot, hf, q] using placement.right_adjacency_slope_imag + rightNeighborDisplacement := placement.rightNeighborDisplacement + right_neighbor_displacement := placement.right_neighbor_displacement + right_neighbor_cells := placement.right_neighbor_cells + right_neighbor_empty_anchor := placement.right_neighbor_empty_anchor + firstBoundarySign := placement.firstBoundarySign + secondBoundarySign := placement.secondBoundarySign + boundary_signs := placement.boundary_signs + first_boundary_cells := placement.first_boundary_cells + first_boundary_empty_anchor := placement.first_boundary_empty_anchor + first_boundary_footprint := placement.first_boundary_footprint + first_boundary_domain := placement.first_boundary_domain + second_boundary_cells := placement.second_boundary_cells + second_boundary_empty_anchor := placement.second_boundary_empty_anchor + second_boundary_footprint := placement.second_boundary_footprint + second_boundary_domain := placement.second_boundary_domain + normalized_star := bundle.normalized_star } + ((∀ (m : ℤ), ∀ (n : ℤ), ∀ (x_1 : LatticeCell), x_1 ∈ (TileTranslation F + ((↑m : GaussianInt) * placement.layout.u + (↑n : GaussianInt) * + placement.layout.v)).cells ↔ ∃ (label : SixSubtileLabel), x_1 ∈ + (ModifiedSubtileOccurrenceInterpretation placement.layout.P placement.layout.O + placement.layout.u placement.layout.v ⟨label, m, n⟩).cells) ∧ ∀ (m : ℤ), ∀ (n : ℤ), ∀ + (r : ℤ), ∀ (s : ℤ), (m, n) ≠ (r, s) → Disjoint (TileTranslation F ((↑m : + GaussianInt) + * placement.layout.u + (↑n : GaussianInt) * placement.layout.v)).cells + (TileTranslation F ((↑r : GaussianInt) * placement.layout.u + (↑s : GaussianInt) * + placement.layout.v)).cells) → ((0 < (q 0).1) → ((∀ (A : ProtoTile), ∀ (A' : + ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (D : ProtoTile), ∀ (D' : + ProtoTile), (A.cells = A'.cells) → ((A.cells = ∅ → A.anchor = + A'.anchor) → ((B.cells = B'.cells) → ((B.cells = ∅ → B.anchor = B'.anchor) → + ((D.cells = D'.cells) → ((D.cells = ∅ → D.anchor = D'.anchor) → ((TouchingTriple A B + D) → (TouchingTriple A' B' D')))))))) → (∀ (uStart : GaussianInt), ∀ (uEnd : + GaussianInt), ∀ (mR : Int), ∀ (nR : Int), ∀ (mS : Int), ∀ (nS : Int), ∀ (mE : + Int), ∀ (nE : Int), (placement.rightNeighborDisplacement = + (mR : GaussianInt) * placement.layout.u + + (nR : GaussianInt) * placement.layout.v) → ((uStart = (mS : GaussianInt) * + placement.layout.u + + (nS : GaussianInt) * placement.layout.v) → ((uEnd = (mE : GaussianInt) * + placement.layout.u + + (nE : GaussianInt) * placement.layout.v) → (((0, 0) ≠ (mR, nR)) → (((0, 0) ≠ (mS, + nS)) → (((0, 0) ≠ (mE, nE)) → (((mR, nR) ≠ (mS, nS)) → (((mR, nR) ≠ (mE, nE)) → + (((mS, nS) ≠ (mE, nE)) → ((ExactTileInterfaceTriple F + (TileTranslation F placement.rightNeighborDisplacement) + (TileTranslation F uStart)) → ((ExactTileInterfaceTriple F (TileTranslation F uEnd) + (TileTranslation F placement.rightNeighborDisplacement)) → ((TouchingTriple F + (TileTranslation F placement.rightNeighborDisplacement) + (TileTranslation F uStart)) → ((TouchingTriple F (TileTranslation F uEnd) + (TileTranslation F placement.rightNeighborDisplacement)) → (∃ g : + BandOrderedGeneralRightInterfaceCertificate norm, g.startCompanion = + TileTranslation F uStart ∧ g.endCompanion = TileTranslation F uEnd ∧ + g.startData.point ≠ g.endData.point)))))))))))))))))) := by + classical + intro C D T N h k x bundle placement selectedEdge hedge q cfg F root edgeVertex norm blockCells + fixedPositive touchingRetarget uStart uEnd mR nR mS nS mE nE hR hS hE hFR hFS hFE hRS hRE + hSE eStart eEnd tStart tEnd + let swapExact (A B D : ProtoTile) (E : ExactTileInterfaceTriple A B D) : + ExactTileInterfaceTriple B A D := + { point := E.point + otherAB := E.otherAB + otherBC := E.otherCA + otherCA := E.otherBC + pathAB := by simpa [Set.inter_comm] using E.pathAB + pathBC := by simpa [Set.inter_comm] using E.pathCA + pathCA := by simpa [Set.inter_comm] using E.pathBC + unique_common := by + intro y + simpa [Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using + E.unique_common y } + have cycleExact (A B D : ProtoTile) (E : ExactTileInterfaceTriple A B D) : + ExactTileInterfaceTriple D A B := + { point := E.point + otherAB := E.otherCA + otherBC := E.otherAB + otherCA := E.otherBC + pathAB := E.pathCA + pathBC := E.pathAB + pathCA := E.pathBC + unique_common := by + intro y + simpa [Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using + E.unique_common y } + have retargetExactFirst (A A' B D : ProtoTile) + (hcell : A.cells = A'.cells) + (hanchor : A.cells = ∅ → A.anchor = A'.anchor) + (E : ExactTileInterfaceTriple A B D) : ExactTileInterfaceTriple A' B D := by + have hobs := ProtoTileObservableExtensionality A A' hcell hanchor + have hedge : FootprintEdges A = FootprintEdges A' := by + simp only [FootprintEdges] + rw [hcell] + exact + { point := E.point + otherAB := E.otherAB + otherBC := E.otherBC + otherCA := E.otherCA + pathAB := by simpa [hobs.1, hedge] using E.pathAB + pathBC := E.pathBC + pathCA := by simpa [hobs.1, hedge] using E.pathCA + unique_common := by intro y; simpa [hobs.1] using E.unique_common y } + let oldRoot := TileTranslation F placement.rightNeighborDisplacement + let startCompanion := TileTranslation F uStart + let endCompanion := TileTranslation F uEnd + have oldCells : oldRoot.cells = root.cells := placement.right_neighbor_cells.symm + have oldAnchor : oldRoot.cells = ∅ → oldRoot.anchor = root.anchor := by + intro he + have hr : root.cells = ∅ := by rw [← oldCells]; exact he + exact (placement.right_neighbor_empty_anchor hr).symm + let start0 := swapExact F oldRoot startCompanion eStart + let end0 := cycleExact F endCompanion oldRoot eEnd + let startData := retargetExactFirst oldRoot root F startCompanion + oldCells oldAnchor start0 + let endData := retargetExactFirst oldRoot root F endCompanion + oldCells oldAnchor end0 + have startTouch0 : TouchingTriple oldRoot F startCompanion := + ((TouchingTriplePermutations F oldRoot startCompanion).mp tStart).2.1 + have startTouching : TouchingTriple root F startCompanion := + touchingRetarget oldRoot root F F startCompanion startCompanion + oldCells oldAnchor rfl (by simp) rfl (by simp) startTouch0 + have endTouch0 : TouchingTriple oldRoot F endCompanion := by + have h := (TouchingTriplePermutations F endCompanion oldRoot).mp tEnd + exact h.2.2.2.1 + have endTouching : TouchingTriple root F endCompanion := + touchingRetarget oldRoot root F F endCompanion endCompanion + oldCells oldAnchor rfl (by simp) rfl (by simp) endTouch0 + have latticeStart : LatticeTile startCompanion := + (TileDiskAreaCovariance F uStart).1.mp norm.normalized_fixed_lattice + have latticeEnd : LatticeTile endCompanion := + (TileDiskAreaCovariance F uEnd).1.mp norm.normalized_fixed_lattice + have zeroCells : (TileTranslation F (0 : GaussianInt)).cells = F.cells := by + ext z + simp [TileTranslation, GaussianTranslation] + have disjFR : Disjoint F.cells oldRoot.cells := by + rw [← zeroCells] + simpa [oldRoot, hR] using blockCells.2 0 0 mR nR hFR + have disjFS : Disjoint F.cells startCompanion.cells := by + rw [← zeroCells] + simpa [startCompanion, hS] using blockCells.2 0 0 mS nS hFS + have disjFE : Disjoint F.cells endCompanion.cells := by + rw [← zeroCells] + simpa [endCompanion, hE] using blockCells.2 0 0 mE nE hFE + have disjRS : Disjoint oldRoot.cells startCompanion.cells := by + simpa [oldRoot, startCompanion, hR, hS] using + blockCells.2 mR nR mS nS hRS + have disjRE : Disjoint oldRoot.cells endCompanion.cells := by + simpa [oldRoot, endCompanion, hR, hE] using + blockCells.2 mR nR mE nE hRE + have disjSE : Disjoint startCompanion.cells endCompanion.cells := by + simpa [startCompanion, endCompanion, hS, hE] using + blockCells.2 mS nS mE nE hSE + have rootFixed : Disjoint root.cells F.cells := by + rw [← oldCells] + exact disjFR.symm + have rootStart : Disjoint root.cells startCompanion.cells := by + rw [← oldCells] + exact disjRS + have rootEnd : Disjoint root.cells endCompanion.cells := by + rw [← oldCells] + exact disjRE + have pointRoot : bundle.normalizedPoint ∈ FootprintVertices root := by + rw [← PositiveCurvatureTileOdometerDomain _ _ _ fixedPositive + norm.normalized_root_odometer] + exact norm.normalized_point_root_domain + have pointFixed : bundle.normalizedPoint ∈ FootprintVertices F := by + rw [← PositiveCurvatureTileOdometerDomain _ _ _ + norm.normalizedFixedCircle.property norm.normalized_fixed_odometer] + exact norm.normalized_point_fixed_domain + have crossed := ExactTileInterfaceDisjointCompanionEndpoints + root F startCompanion endCompanion startData endData + norm.normalized_root_lattice norm.normalized_fixed_lattice + latticeStart latticeEnd startTouching endTouching rootStart disjFS disjSE + exact ⟨{ + startCompanion := startCompanion + endCompanion := endCompanion + startData := startData + endData := endData + normalized_point_on_start_path := ⟨pointRoot, pointFixed⟩ + interface_endpoints := crossed.2 + root_lattice := norm.normalized_root_lattice + fixed_lattice := norm.normalized_fixed_lattice + start_lattice := latticeStart + end_lattice := latticeEnd + root_fixed_disjoint := rootFixed + root_start_disjoint := rootStart + fixed_start_disjoint := disjFS + root_end_disjoint := rootEnd + fixed_end_disjoint := disjFE + start_end_disjoint := disjSE + start_touching := startTouching + end_touching := endTouching }, rfl, rfl, crossed.1⟩ + +private theorem coordinateFactsApos : + (by + classical + exact + ((0, 0) : Int × Int) ≠ (1, 1) ∧ ((0, 0) : Int × Int) ≠ (1, 0) ∧ ((0, 0) : Int × Int) ≠ + (0, 1) ∧ ((1, 1) : Int × Int) ≠ (1, 0) ∧ ((1, 1) : Int × Int) ≠ (0, 1) ∧ ((1, 0) : + Int × Int) ≠ (0, 1) ) := by + classical + decide +kernel + +private theorem coordinateFactsAneg : + (by + classical + exact + ((0, 0) : Int × Int) ≠ (-1, -1) ∧ ((0, 0) : Int × Int) ≠ (-1, 0) ∧ ((0, 0) : Int × Int) ≠ + (0, -1) ∧ ((-1, -1) : Int × Int) ≠ (-1, 0) ∧ ((-1, -1) : Int × Int) ≠ (0, -1) ∧ ((-1, + 0) : Int × Int) ≠ (0, -1) ) := by + classical + decide +kernel + +private theorem coordinateFactsBpos : + (by + classical + exact + ((0, 0) : Int × Int) ≠ (-1, 0) ∧ ((0, 0) : Int × Int) ≠ (0, 1) ∧ ((0, 0) : Int × Int) ≠ + (-1, -1) ∧ ((-1, 0) : Int × Int) ≠ (0, 1) ∧ ((-1, 0) : Int × Int) ≠ (-1, -1) ∧ ((0, + 1) : Int × Int) ≠ (-1, -1) ) := by + classical + decide +kernel + +private theorem coordinateFactsBneg : + (by + classical + exact + ((0, 0) : Int × Int) ≠ (1, 0) ∧ ((0, 0) : Int × Int) ≠ (0, -1) ∧ ((0, 0) : Int × Int) ≠ + (1, 1) ∧ ((1, 0) : Int × Int) ≠ (0, -1) ∧ ((1, 0) : Int × Int) ≠ (1, 1) ∧ ((0, -1) : + Int × Int) ≠ (1, 1) ) := by + classical + decide +kernel + +private theorem coordinateFactsCpos : + (by + classical + exact + ((0, 0) : Int × Int) ≠ (0, -1) ∧ ((0, 0) : Int × Int) ≠ (-1, -1) ∧ ((0, 0) : Int × Int) ≠ + (1, 0) ∧ ((0, -1) : Int × Int) ≠ (-1, -1) ∧ ((0, -1) : Int × Int) ≠ (1, 0) ∧ ((-1, + -1) : Int × Int) ≠ (1, 0) ) := by + classical + decide +kernel + +private theorem coordinateFactsCneg : + (by + classical + exact + ((0, 0) : Int × Int) ≠ (0, 1) ∧ ((0, 0) : Int × Int) ≠ (1, 1) ∧ ((0, 0) : Int × Int) ≠ + (-1, 0) ∧ ((0, 1) : Int × Int) ≠ (1, 1) ∧ ((0, 1) : Int × Int) ≠ (-1, 0) ∧ ((1, 1) : + Int × Int) ≠ (-1, 0) ) := by + classical + decide +kernel + +private theorem turnAdd : + (by + classical + exact + ∀ (a : GaussianInt), ∀ (b : GaussianInt), GaussianQuarterTurn (a + b) = + GaussianQuarterTurn a + GaussianQuarterTurn b ) := by + classical + intro a b + rcases a with ⟨ar, ai⟩ + rcases b with ⟨br, bi⟩ + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn]; ring + +private theorem incomingSum : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0 ) + := by + classical + intro C D T N h k x bundle q + let cfg := bundle.configuration + simpa [Fin.sum_univ_succ, add_assoc] using + (IncomingSuperbasisRelation q cfg.proper).1 + +private theorem outgoingSum : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + (∀ (s : Fin 3), GaussianQuarterTurn (BandVectors.1 (q s.succ) (q 0)) = BandVectors.1 (q + 0) (q s.succ)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), GaussianQuarterTurn (a + + b) = GaussianQuarterTurn a + GaussianQuarterTurn b) → ((BandVectors.1 (q 1) (q 0) + + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) → (BandVectors.1 (q 0) (q + 1) + BandVectors.1 (q 0) (q 2) + BandVectors.1 (q 0) (q 3) = 0))) ) := by + classical + intro C D T N h k x bundle q turnOutgoing turnAdd incomingSum + have h0 : GaussianQuarterTurn (BandVectors.1 (q 1) (q 0)) = + BandVectors.1 (q 0) (q 1) := by simpa using turnOutgoing 0 + have h1 : GaussianQuarterTurn (BandVectors.1 (q 2) (q 0)) = + BandVectors.1 (q 0) (q 2) := by simpa using turnOutgoing 1 + have h2 : GaussianQuarterTurn (BandVectors.1 (q 3) (q 0)) = + BandVectors.1 (q 0) (q 3) := by simpa using turnOutgoing 2 + rw [← h0, ← h1, ← h2] + calc + _ = GaussianQuarterTurn + (BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + + BandVectors.1 (q 3) (q 0)) := by rw [turnAdd, turnAdd] + _ = 0 := by rw [incomingSum]; rfl + +private theorem period2 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + (BandVectors.1 (q 0) (q 1) + BandVectors.1 (q 0) (q 2) + BandVectors.1 (q 0) (q 3) = 0) → + ((BandVectors.1 (q 0) (q 1) = placement.layout.u) → ((BandVectors.1 (q 0) (q 2) = + placement.layout.v) → (BandVectors.1 (q 0) (q 3) = -placement.layout.u - + placement.layout.v))) ) := by + classical + intro C D T N h k x bundle placement q outgoingSum period0 period1 + rw [← period0, ← period1] + have hthird : BandVectors.1 (q 0) (q 3) = + -(BandVectors.1 (q 0) (q 1) + BandVectors.1 (q 0) (q 2)) := by + linear_combination outgoingSum + rw [hthird] + abel + +private theorem geometryFields : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + ∀ (edgeVertex : ∀ (tile : ProtoTile), (tile.cells.Nonempty) → (∀ (edge : Finset + GaussianInt), (edge ∈ FootprintEdges tile) → (∀ (point : GaussianInt), (point ∈ edge) + → (point ∈ FootprintVertices tile)))), + let norm : BandOrderedGeneralRightNormalizationCertificate C T N h k x := { + presentation := bundle.presentation + presentation_proper := bundle.presentation_proper + presentation_child := bundle.presentation_child + parentRotation := bundle.parentRotation + symmetry := bundle.symmetry + rotatedPresentation := bundle.rotatedPresentation + rotated_presentation_eq := bundle.rotated_presentation_eq + normalizedPresentation := q + normalized_presentation_eq := bundle.normalized_presentation_eq + configuration := cfg + normalizedCircle := bundle.normalizedCircle + normalized_circle_eq := bundle.normalized_circle_eq + normalizedFixedCircle := bundle.normalizedCircle + normalized_fixed_circle_eq := by + calc + bundle.normalizedCircle.1.1 = q 0 := bundle.normalized_circle_eq.symm + _ = BandPackingSymmetryCircleAction bundle.symmetry C.1.1 := by + have hq0 := congrFun bundle.normalized_presentation_eq 0 + calc + q 0 = BandPackingSymmetryCircleAction bundle.symmetry + (bundle.rotatedPresentation 0) := by + simpa [BandPackingSymmetryQuadrupleAction] using hq0 + _ = BandPackingSymmetryCircleAction bundle.symmetry C.1.1 := by + rw [bundle.rotated_presentation_eq] + simp [bundle.presentation_child] + normalizedRoot := root + normalizedFixed := F + normalizedRootFunction := bundle.normalizedRootFunction + normalizedFixedFunction := bundle.normalizedFixedFunction + normalizedPoint := bundle.normalizedPoint + normalized_root_eq := bundle.normalized_root_eq + normalized_fixed_eq := bundle.normalized_fixed_eq + normalized_root_function_eq := bundle.normalized_root_function_eq + normalized_fixed_function_eq := bundle.normalized_fixed_function_eq + normalized_point_eq := bundle.normalized_point_eq + normalized_point_root_domain := by + obtain ⟨edge, hp, he⟩ := bundle.edgeAtPoint + have hne := (LatticeTileGridStructure root bundle.root_lattice).1.1 + have hvert := edgeVertex root hne edge he.1 bundle.normalizedPoint hp + have hdom := PositiveCurvatureTileOdometerDomain (q 0) root + bundle.normalizedRootFunction (ProperBandCurvatureStructure q cfg.proper).1 + bundle.normalized_root_odometer + exact (Set.ext_iff.mp hdom bundle.normalizedPoint).mpr hvert + normalized_point_fixed_domain := by + obtain ⟨edge, hp, he⟩ := bundle.edgeAtPoint + have hne := (LatticeTileGridStructure F bundle.fixed_lattice).1.1 + have hvert := edgeVertex F hne edge he.2 bundle.normalizedPoint hp + have hdom := PositiveCurvatureTileOdometerDomain + bundle.normalizedCircle.1.1 F bundle.normalizedFixedFunction + bundle.normalizedCircle.property placement.adjacency.2.1 + exact (Set.ext_iff.mp hdom bundle.normalizedPoint).mpr hvert + normalized_root_odometer := bundle.normalized_root_odometer + normalized_fixed_odometer := placement.adjacency.2.1 + normalized_root_lattice := bundle.root_lattice + normalized_fixed_lattice := bundle.fixed_lattice + normalizedRootSlope := bundle.normalizedRootSlope + normalizedFixedSlope := bundle.normalizedFixedSlope + normalized_root_slope := bundle.normalized_root_slope + normalized_fixed_slope := bundle.normalized_fixed_slope + pieces := bundle.pieces + functions := bundle.functions + root_band := bundle.root_band + piece_odometer := bundle.piece_odometer + piece_cell_cover := bundle.piece_cell_cover + piece_footprint := bundle.piece_footprint + piece_centroid := bundle.piece_centroid + function_domain_cover := bundle.function_domain_cover + function_restriction := bundle.function_restriction + function_compatibility := bundle.function_compatibility + piece_slope := bundle.piece_slope + adjacency := placement.adjacency + layout := placement.layout + fixed_quarter_turn := TileT2QuarterTurn q cfg bundle.normalizedCircle F placement.layout + rightFirstSlot := placement.rightFirstSlot + rightSecondSlot := placement.rightSecondSlot + rightDirectionSlot := placement.rightDirectionSlot + right_slots_cyclic := placement.right_slots_cyclic + rightNeighborPositive := placement.rightNeighborPositive + right_adjacency_centroid := placement.right_adjacency_centroid + right_adjacency_slope_real := by + have hroot : placement.rightRootSlope = bundle.normalizedRootSlope := + Option.some.inj (placement.right_root_slope.symm.trans + bundle.normalized_root_slope) + have hf : placement.rightFixedSlope = bundle.normalizedFixedSlope := + Option.some.inj (placement.right_fixed_slope.symm.trans + bundle.normalized_fixed_slope) + simpa [hroot, hf, q] using placement.right_adjacency_slope_real + right_adjacency_slope_imag := by + have hroot : placement.rightRootSlope = bundle.normalizedRootSlope := + Option.some.inj (placement.right_root_slope.symm.trans + bundle.normalized_root_slope) + have hf : placement.rightFixedSlope = bundle.normalizedFixedSlope := + Option.some.inj (placement.right_fixed_slope.symm.trans + bundle.normalized_fixed_slope) + simpa [hroot, hf, q] using placement.right_adjacency_slope_imag + rightNeighborDisplacement := placement.rightNeighborDisplacement + right_neighbor_displacement := placement.right_neighbor_displacement + right_neighbor_cells := placement.right_neighbor_cells + right_neighbor_empty_anchor := placement.right_neighbor_empty_anchor + firstBoundarySign := placement.firstBoundarySign + secondBoundarySign := placement.secondBoundarySign + boundary_signs := placement.boundary_signs + first_boundary_cells := placement.first_boundary_cells + first_boundary_empty_anchor := placement.first_boundary_empty_anchor + first_boundary_footprint := placement.first_boundary_footprint + first_boundary_domain := placement.first_boundary_domain + second_boundary_cells := placement.second_boundary_cells + second_boundary_empty_anchor := placement.second_boundary_empty_anchor + second_boundary_footprint := placement.second_boundary_footprint + second_boundary_domain := placement.second_boundary_domain + normalized_star := bundle.normalized_star } + let P := placement.layout.P + let u := placement.layout.u + let v := placement.layout.v + let selectedPath : Prop := + (∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + (FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge) + (selectedPath) → (∀ (g : BandOrderedGeneralRightInterfaceCertificate norm), ∀ (W : + ProtoTile), ∀ (X : ProtoTile), ∀ (R1 : ExactTileInterfaceTriple F g.startCompanion + W), ∀ (R2 : ExactTileInterfaceTriple F g.endCompanion X), (FootprintVertices W ⊆ + FootprintVertices root) → ((FootprintVertices X ⊆ FootprintVertices root) → + ((g.startData.point ≠ g.endData.point) → (R1.point = g.startData.point ∧ R2.point = + g.endData.point ∧ LatticeTile root ∧ LatticeTile F ∧ LatticeTile g.startCompanion ∧ + LatticeTile g.endCompanion ∧ Disjoint root.cells g.startCompanion.cells ∧ Disjoint + F.cells g.startCompanion.cells ∧ Disjoint root.cells g.endCompanion.cells ∧ Disjoint + F.cells g.endCompanion.cells ∧ Disjoint g.startCompanion.cells g.endCompanion.cells ∧ + TouchingTriple root F g.startCompanion ∧ TouchingTriple root F g.endCompanion ∧ + g.startData.point ≠ g.endData.point ∧ g.endData.point = g.startData.otherAB ∧ + g.endData.otherAB = g.startData.point ∧ selectedPath)))) ) := by + classical + intro C D T N h k x bundle placement selectedEdge q cfg F root edgeVertex norm P u v + selectedPath originalSelectedPath g W X R1 R2 hW hX hneq + have hp1 := (R1.unique_common R1.point).2 rfl + have hp2 := (R2.unique_common R2.point).2 rfl + have hp1' : R1.point ∈ FootprintVertices F ∧ + R1.point ∈ FootprintVertices g.startCompanion ∧ + R1.point ∈ FootprintVertices W := by + simpa only [Set.mem_inter_iff, and_assoc] using hp1 + have hp2' : R2.point ∈ FootprintVertices F ∧ + R2.point ∈ FootprintVertices g.endCompanion ∧ + R2.point ∈ FootprintVertices X := by + simpa only [Set.mem_inter_iff, and_assoc] using hp2 + rcases hp1' with ⟨hF1, hC1, hW1⟩ + rcases hp2' with ⟨hF2, hC2, hX2⟩ + have hroot1 : R1.point ∈ FootprintVertices root := hW hW1 + have hroot2 : R2.point ∈ FootprintVertices root := hX hX2 + have hcommon1 : R1.point ∈ FootprintVertices root ∩ + FootprintVertices F ∩ FootprintVertices g.startCompanion := + ⟨⟨hroot1, hF1⟩, hC1⟩ + have hcommon2 : R2.point ∈ FootprintVertices root ∩ + FootprintVertices F ∩ FootprintVertices g.endCompanion := + ⟨⟨hroot2, hF2⟩, hC2⟩ + have hpoint1 := (g.startData.unique_common R1.point).mp hcommon1 + have hpoint2 := (g.endData.unique_common R2.point).mp hcommon2 + refine ⟨hpoint1, ?_⟩ + refine ⟨hpoint2, ?_⟩ + refine ⟨g.root_lattice, ?_⟩ + refine ⟨g.fixed_lattice, ?_⟩ + refine ⟨g.start_lattice, ?_⟩ + refine ⟨g.end_lattice, ?_⟩ + refine ⟨g.root_start_disjoint, ?_⟩ + refine ⟨g.fixed_start_disjoint, ?_⟩ + refine ⟨g.root_end_disjoint, ?_⟩ + refine ⟨g.fixed_end_disjoint, ?_⟩ + refine ⟨g.start_end_disjoint, ?_⟩ + refine ⟨g.start_touching, ?_⟩ + refine ⟨g.end_touching, ?_⟩ + refine ⟨hneq, ?_⟩ + refine ⟨g.interface_endpoints.1, ?_⟩ + refine ⟨g.interface_endpoints.2, ?_⟩ + exact originalSelectedPath + +private theorem castTriplePointSecond : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (C : ProtoTile), ∀ (h : B = + B'), ∀ (d : ExactTileInterfaceTriple A B C), (Eq.mp (congrArg (fun Y => + ExactTileInterfaceTriple A Y C) h) d).point = d.point ) := by + classical + intro A B B' C h d + cases h + rfl + +private theorem castTriplePointThird : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (C' : ProtoTile), ∀ (h : C = + C'), ∀ (d : ExactTileInterfaceTriple A B C), (Eq.mp (congrArg (fun Y => + ExactTileInterfaceTriple A B Y) h) d).point = d.point ) := by + classical + intro A B C C' h d + cases h + rfl + +private theorem castTripleOtherABSecond : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (C : ProtoTile), ∀ (h : B = + B'), ∀ (d : ExactTileInterfaceTriple A B C), (Eq.mp (congrArg (fun Y => + ExactTileInterfaceTriple A Y C) h) d).otherAB = d.otherAB ) := by + classical + intro A B B' C h d + cases h + rfl + +private theorem castTripleOtherABThird : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (C' : ProtoTile), ∀ (h : C = + C'), ∀ (d : ExactTileInterfaceTriple A B C), (Eq.mp (congrArg (fun Y => + ExactTileInterfaceTriple A B Y) h) d).otherAB = d.otherAB ) := by + classical + intro A B C C' h d + cases h + rfl + +private theorem castRoundTrip : + (by + classical + exact + ∀ (P : ProtoTile → Type), ∀ {a : ProtoTile}, ∀ {b : ProtoTile}, ∀ (h : a = b), ∀ (z : P + a), Eq.mpr (congrArg P h) (Eq.mp (congrArg P h) z) = z ) := by + classical + intro P a b h z + cases h + rfl + +private theorem packageGeometry : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + ∀ (edgeVertex : ∀ (tile : ProtoTile), (tile.cells.Nonempty) → (∀ (edge : Finset + GaussianInt), (edge ∈ FootprintEdges tile) → (∀ (point : GaussianInt), (point ∈ edge) + → (point ∈ FootprintVertices tile)))), + let norm : BandOrderedGeneralRightNormalizationCertificate C T N h k x := { + presentation := bundle.presentation + presentation_proper := bundle.presentation_proper + presentation_child := bundle.presentation_child + parentRotation := bundle.parentRotation + symmetry := bundle.symmetry + rotatedPresentation := bundle.rotatedPresentation + rotated_presentation_eq := bundle.rotated_presentation_eq + normalizedPresentation := q + normalized_presentation_eq := bundle.normalized_presentation_eq + configuration := cfg + normalizedCircle := bundle.normalizedCircle + normalized_circle_eq := bundle.normalized_circle_eq + normalizedFixedCircle := bundle.normalizedCircle + normalized_fixed_circle_eq := by + calc + bundle.normalizedCircle.1.1 = q 0 := bundle.normalized_circle_eq.symm + _ = BandPackingSymmetryCircleAction bundle.symmetry C.1.1 := by + have hq0 := congrFun bundle.normalized_presentation_eq 0 + calc + q 0 = BandPackingSymmetryCircleAction bundle.symmetry + (bundle.rotatedPresentation 0) := by + simpa [BandPackingSymmetryQuadrupleAction] using hq0 + _ = BandPackingSymmetryCircleAction bundle.symmetry C.1.1 := by + rw [bundle.rotated_presentation_eq] + simp [bundle.presentation_child] + normalizedRoot := root + normalizedFixed := F + normalizedRootFunction := bundle.normalizedRootFunction + normalizedFixedFunction := bundle.normalizedFixedFunction + normalizedPoint := bundle.normalizedPoint + normalized_root_eq := bundle.normalized_root_eq + normalized_fixed_eq := bundle.normalized_fixed_eq + normalized_root_function_eq := bundle.normalized_root_function_eq + normalized_fixed_function_eq := bundle.normalized_fixed_function_eq + normalized_point_eq := bundle.normalized_point_eq + normalized_point_root_domain := by + obtain ⟨edge, hp, he⟩ := bundle.edgeAtPoint + have hne := (LatticeTileGridStructure root bundle.root_lattice).1.1 + have hvert := edgeVertex root hne edge he.1 bundle.normalizedPoint hp + have hdom := PositiveCurvatureTileOdometerDomain (q 0) root + bundle.normalizedRootFunction (ProperBandCurvatureStructure q cfg.proper).1 + bundle.normalized_root_odometer + exact (Set.ext_iff.mp hdom bundle.normalizedPoint).mpr hvert + normalized_point_fixed_domain := by + obtain ⟨edge, hp, he⟩ := bundle.edgeAtPoint + have hne := (LatticeTileGridStructure F bundle.fixed_lattice).1.1 + have hvert := edgeVertex F hne edge he.2 bundle.normalizedPoint hp + have hdom := PositiveCurvatureTileOdometerDomain + bundle.normalizedCircle.1.1 F bundle.normalizedFixedFunction + bundle.normalizedCircle.property placement.adjacency.2.1 + exact (Set.ext_iff.mp hdom bundle.normalizedPoint).mpr hvert + normalized_root_odometer := bundle.normalized_root_odometer + normalized_fixed_odometer := placement.adjacency.2.1 + normalized_root_lattice := bundle.root_lattice + normalized_fixed_lattice := bundle.fixed_lattice + normalizedRootSlope := bundle.normalizedRootSlope + normalizedFixedSlope := bundle.normalizedFixedSlope + normalized_root_slope := bundle.normalized_root_slope + normalized_fixed_slope := bundle.normalized_fixed_slope + pieces := bundle.pieces + functions := bundle.functions + root_band := bundle.root_band + piece_odometer := bundle.piece_odometer + piece_cell_cover := bundle.piece_cell_cover + piece_footprint := bundle.piece_footprint + piece_centroid := bundle.piece_centroid + function_domain_cover := bundle.function_domain_cover + function_restriction := bundle.function_restriction + function_compatibility := bundle.function_compatibility + piece_slope := bundle.piece_slope + adjacency := placement.adjacency + layout := placement.layout + fixed_quarter_turn := TileT2QuarterTurn q cfg bundle.normalizedCircle F placement.layout + rightFirstSlot := placement.rightFirstSlot + rightSecondSlot := placement.rightSecondSlot + rightDirectionSlot := placement.rightDirectionSlot + right_slots_cyclic := placement.right_slots_cyclic + rightNeighborPositive := placement.rightNeighborPositive + right_adjacency_centroid := placement.right_adjacency_centroid + right_adjacency_slope_real := by + have hroot : placement.rightRootSlope = bundle.normalizedRootSlope := + Option.some.inj (placement.right_root_slope.symm.trans + bundle.normalized_root_slope) + have hf : placement.rightFixedSlope = bundle.normalizedFixedSlope := + Option.some.inj (placement.right_fixed_slope.symm.trans + bundle.normalized_fixed_slope) + simpa [hroot, hf, q] using placement.right_adjacency_slope_real + right_adjacency_slope_imag := by + have hroot : placement.rightRootSlope = bundle.normalizedRootSlope := + Option.some.inj (placement.right_root_slope.symm.trans + bundle.normalized_root_slope) + have hf : placement.rightFixedSlope = bundle.normalizedFixedSlope := + Option.some.inj (placement.right_fixed_slope.symm.trans + bundle.normalized_fixed_slope) + simpa [hroot, hf, q] using placement.right_adjacency_slope_imag + rightNeighborDisplacement := placement.rightNeighborDisplacement + right_neighbor_displacement := placement.right_neighbor_displacement + right_neighbor_cells := placement.right_neighbor_cells + right_neighbor_empty_anchor := placement.right_neighbor_empty_anchor + firstBoundarySign := placement.firstBoundarySign + secondBoundarySign := placement.secondBoundarySign + boundary_signs := placement.boundary_signs + first_boundary_cells := placement.first_boundary_cells + first_boundary_empty_anchor := placement.first_boundary_empty_anchor + first_boundary_footprint := placement.first_boundary_footprint + first_boundary_domain := placement.first_boundary_domain + second_boundary_cells := placement.second_boundary_cells + second_boundary_empty_anchor := placement.second_boundary_empty_anchor + second_boundary_footprint := placement.second_boundary_footprint + second_boundary_domain := placement.second_boundary_domain + normalized_star := bundle.normalized_star } + let P := placement.layout.P + let u := placement.layout.u + let v := placement.layout.v + let selectedPath : Prop := + (∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + (FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge) + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, + ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ + Disjoint F.cells firstCompanion.cells ∧ + Disjoint root.cells secondCompanion.cells ∧ + Disjoint F.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple root F firstCompanion ∧ + TouchingTriple root F secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ selectedPath + (∀ (g : BandOrderedGeneralRightInterfaceCertificate norm), ∀ (W : ProtoTile), ∀ (X : + ProtoTile), ∀ (R1 : ExactTileInterfaceTriple F g.startCompanion W), ∀ (R2 : + ExactTileInterfaceTriple F g.endCompanion X), (FootprintVertices W ⊆ + FootprintVertices root) → ((FootprintVertices X ⊆ FootprintVertices root) → + ((g.startData.point ≠ g.endData.point) → (R1.point = g.startData.point ∧ R2.point = + g.endData.point ∧ LatticeTile root ∧ LatticeTile F ∧ LatticeTile g.startCompanion ∧ + LatticeTile g.endCompanion ∧ Disjoint root.cells g.startCompanion.cells ∧ Disjoint + F.cells g.startCompanion.cells ∧ Disjoint root.cells g.endCompanion.cells ∧ Disjoint + F.cells g.endCompanion.cells ∧ Disjoint g.startCompanion.cells g.endCompanion.cells ∧ + TouchingTriple root F g.startCompanion ∧ TouchingTriple root F g.endCompanion ∧ + g.startData.point ≠ g.endData.point ∧ g.endData.point = g.startData.otherAB ∧ + g.endData.otherAB = g.startData.point ∧ selectedPath)))) → ((∀ (A : ProtoTile), ∀ (B + : ProtoTile), ∀ (B' : ProtoTile), ∀ (C : ProtoTile), ∀ (h : B = B'), ∀ (d : + ExactTileInterfaceTriple A B C), (Eq.mp (congrArg (fun Y => ExactTileInterfaceTriple + A Y C) h) d).point = d.point) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : + ProtoTile), ∀ (C' : ProtoTile), ∀ (h : C = C'), ∀ (d : ExactTileInterfaceTriple A B + C), (Eq.mp (congrArg (fun Y => ExactTileInterfaceTriple A B Y) h) d).point = d.point) + → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (C' : ProtoTile), ∀ (h + : C = C'), ∀ (d : ExactTileInterfaceTriple A B C), (Eq.mp (congrArg (fun Y => + ExactTileInterfaceTriple A B Y) h) d).otherAB = d.otherAB) → (∀ (i : Fin 3), ∀ (j : + Fin 3), ∀ (sgn : GaussianInt), ∀ (s₁ : Bool), ∀ (s₂ : Bool), ∀ (g : + BandOrderedGeneralRightInterfaceCertificate norm), (g.startCompanion = TileTranslation F + (sgn * BandVectors.1 (q 0) (q i.succ))) → ((g.endCompanion = TileTranslation F + (sgn * BandVectors.1 (q 0) (q j.succ))) → ((g.startData.point ≠ g.endData.point) → + ((ExactTileInterfaceTriple F g.startCompanion + (TileTranslation (placement.layout.P i s₁) + placement.rightNeighborDisplacement)) → ((ExactTileInterfaceTriple F g.endCompanion + (TileTranslation (placement.layout.P j s₂) + placement.rightNeighborDisplacement)) → ((FootprintVertices + (TileTranslation (placement.layout.P i s₁) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root) → ((FootprintVertices + (TileTranslation (placement.layout.P j s₂) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root) → (rightGeometry i j + sgn s₁ s₂))))))))))) ) := by + classical + intro C D T N h k x bundle placement selectedEdge q cfg F root edgeVertex norm P u v + selectedPath rightGeometry geometryFields castTriplePointSecond castTriplePointThird + castTripleOtherABThird i j sgn s₁ s₂ g hgs hge hneq R1 R2 hW hX + dsimp [rightGeometry] + let R1out : ExactTileInterfaceTriple F + (TileTranslation F (sgn * BandVectors.1 (q 0) (q i.succ))) + (TileTranslation (placement.layout.P i s₁) + placement.rightNeighborDisplacement) := + Eq.mp (congrArg (fun Y => ExactTileInterfaceTriple F Y + (TileTranslation (placement.layout.P i s₁) + placement.rightNeighborDisplacement)) hgs) R1 + let R2out : ExactTileInterfaceTriple F + (TileTranslation F (sgn * BandVectors.1 (q 0) (q j.succ))) + (TileTranslation (placement.layout.P j s₂) + placement.rightNeighborDisplacement) := + Eq.mp (congrArg (fun Y => ExactTileInterfaceTriple F Y + (TileTranslation (placement.layout.P j s₂) + placement.rightNeighborDisplacement)) hge) R2 + let startData : ExactTileInterfaceTriple root F + (TileTranslation F (sgn * BandVectors.1 (q 0) (q i.succ))) := + Eq.mp (congrArg (fun Y => ExactTileInterfaceTriple root F Y) hgs) + g.startData + let endData : ExactTileInterfaceTriple root F + (TileTranslation F (sgn * BandVectors.1 (q 0) (q j.succ))) := + Eq.mp (congrArg (fun Y => ExactTileInterfaceTriple root F Y) hge) + g.endData + have fields := geometryFields g _ _ R1 R2 hW hX hneq + have p1 := castTriplePointSecond F g.startCompanion + (TileTranslation F (sgn * BandVectors.1 (q 0) (q i.succ))) + (TileTranslation (placement.layout.P i s₁) + placement.rightNeighborDisplacement) hgs R1 + have p2 := castTriplePointSecond F g.endCompanion + (TileTranslation F (sgn * BandVectors.1 (q 0) (q j.succ))) + (TileTranslation (placement.layout.P j s₂) + placement.rightNeighborDisplacement) hge R2 + have p3 := castTriplePointThird root F g.startCompanion + (TileTranslation F (sgn * BandVectors.1 (q 0) (q i.succ))) hgs g.startData + have p4 := castTriplePointThird root F g.endCompanion + (TileTranslation F (sgn * BandVectors.1 (q 0) (q j.succ))) hge g.endData + have o1 := castTripleOtherABThird root F g.startCompanion + (TileTranslation F (sgn * BandVectors.1 (q 0) (q i.succ))) hgs g.startData + have o2 := castTripleOtherABThird root F g.endCompanion + (TileTranslation F (sgn * BandVectors.1 (q 0) (q j.succ))) hge g.endData + have fields' := fields + rw [← p1, ← p2, ← p3, ← p4, ← o1, ← o2] at fields' + refine ⟨R1out, R2out, startData, endData, ?_⟩ + simpa only [hgs, hge, R1out, R2out, startData, endData, + castRoundTrip] using fields' + +private theorem firstBoundarySubset : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let root := bundle.normalizedRoot + FootprintVertices (TileTranslation (placement.layout.P placement.rightFirstSlot + placement.firstBoundarySign) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root ) := by + classical + intro C D T N h k x bundle placement root + rw [← placement.first_boundary_footprint] + exact bundle.piece_footprint placement.rightFirstSlot + placement.firstBoundarySign + +private theorem secondBoundarySubset : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let root := bundle.normalizedRoot + FootprintVertices (TileTranslation (placement.layout.P placement.rightSecondSlot + placement.secondBoundarySign) placement.rightNeighborDisplacement) ⊆ + FootprintVertices root ) := by + classical + intro C D T N h k x bundle placement root + rw [← placement.second_boundary_footprint] + exact bundle.piece_footprint placement.rightSecondSlot + placement.secondBoundarySign + +private theorem hRAt1171 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + (placement.rightDirectionSlot = (2 : Fin (3 : ℕ))) → ((placement.rightNeighborPositive = + false) → (placement.rightNeighborDisplacement = -BandVectors.1 (q 0) (q 3))) ) := by + classical + intro C D T N h k x bundle placement q hk hpos + simpa [hpos, hk] using placement.right_neighbor_displacement + +private theorem tStartAt1193 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (ell : Fin 3), TouchingTriple F (TileTranslation F (-BandVectors.1 (q 0) (q + ell.succ))) (TileTranslation F (BandVectors.1 (q 0) (q (ell + 1).succ)))) → + ((placement.rightNeighborDisplacement = -BandVectors.1 (q 0) (q 3)) → (TouchingTriple + F (TileTranslation F placement.rightNeighborDisplacement) (TileTranslation F ((1 : + GaussianInt) * BandVectors.1 (q 0) (q 1))))) ) := by + classical + intro C D T N h k x bundle placement q F touchingMinus hR + simpa [hR] using touchingMinus 2 + +private theorem tEndAt1197 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (ell : Fin 3), TouchingTriple F (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ)))) → + ((placement.rightNeighborDisplacement = -BandVectors.1 (q 0) (q 3)) → (TouchingTriple + F (TileTranslation F ((1 : GaussianInt) * BandVectors.1 (q 0) (q 2))) + (TileTranslation F placement.rightNeighborDisplacement))) ) := by + classical + intro C D T N h k x bundle placement q F touchingPlus hR + simpa [hR] using touchingPlus 1 + +private theorem geomAt1214 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + ∀ (edgeVertex : ∀ (tile : ProtoTile), (tile.cells.Nonempty) → (∀ (edge : Finset + GaussianInt), (edge ∈ FootprintEdges tile) → (∀ (point : GaussianInt), (point ∈ edge) + → (point ∈ FootprintVertices tile)))), (placement.rightNeighborPositive = false) → ( + let norm : BandOrderedGeneralRightNormalizationCertificate C T N h k x := { + presentation := bundle.presentation + presentation_proper := bundle.presentation_proper + presentation_child := bundle.presentation_child + parentRotation := bundle.parentRotation + symmetry := bundle.symmetry + rotatedPresentation := bundle.rotatedPresentation + rotated_presentation_eq := bundle.rotated_presentation_eq + normalizedPresentation := q + normalized_presentation_eq := bundle.normalized_presentation_eq + configuration := cfg + normalizedCircle := bundle.normalizedCircle + normalized_circle_eq := bundle.normalized_circle_eq + normalizedFixedCircle := bundle.normalizedCircle + normalized_fixed_circle_eq := by + calc + bundle.normalizedCircle.1.1 = q 0 := bundle.normalized_circle_eq.symm + _ = BandPackingSymmetryCircleAction bundle.symmetry C.1.1 := by + have hq0 := congrFun bundle.normalized_presentation_eq 0 + calc + q 0 = BandPackingSymmetryCircleAction bundle.symmetry + (bundle.rotatedPresentation 0) := by + simpa [BandPackingSymmetryQuadrupleAction] using hq0 + _ = BandPackingSymmetryCircleAction bundle.symmetry C.1.1 := by + rw [bundle.rotated_presentation_eq] + simp [bundle.presentation_child] + normalizedRoot := root + normalizedFixed := F + normalizedRootFunction := bundle.normalizedRootFunction + normalizedFixedFunction := bundle.normalizedFixedFunction + normalizedPoint := bundle.normalizedPoint + normalized_root_eq := bundle.normalized_root_eq + normalized_fixed_eq := bundle.normalized_fixed_eq + normalized_root_function_eq := bundle.normalized_root_function_eq + normalized_fixed_function_eq := bundle.normalized_fixed_function_eq + normalized_point_eq := bundle.normalized_point_eq + normalized_point_root_domain := by + obtain ⟨edge, hp, he⟩ := bundle.edgeAtPoint + have hne := (LatticeTileGridStructure root bundle.root_lattice).1.1 + have hvert := edgeVertex root hne edge he.1 bundle.normalizedPoint hp + have hdom := PositiveCurvatureTileOdometerDomain (q 0) root + bundle.normalizedRootFunction (ProperBandCurvatureStructure q cfg.proper).1 + bundle.normalized_root_odometer + exact (Set.ext_iff.mp hdom bundle.normalizedPoint).mpr hvert + normalized_point_fixed_domain := by + obtain ⟨edge, hp, he⟩ := bundle.edgeAtPoint + have hne := (LatticeTileGridStructure F bundle.fixed_lattice).1.1 + have hvert := edgeVertex F hne edge he.2 bundle.normalizedPoint hp + have hdom := PositiveCurvatureTileOdometerDomain + bundle.normalizedCircle.1.1 F bundle.normalizedFixedFunction + bundle.normalizedCircle.property placement.adjacency.2.1 + exact (Set.ext_iff.mp hdom bundle.normalizedPoint).mpr hvert + normalized_root_odometer := bundle.normalized_root_odometer + normalized_fixed_odometer := placement.adjacency.2.1 + normalized_root_lattice := bundle.root_lattice + normalized_fixed_lattice := bundle.fixed_lattice + normalizedRootSlope := bundle.normalizedRootSlope + normalizedFixedSlope := bundle.normalizedFixedSlope + normalized_root_slope := bundle.normalized_root_slope + normalized_fixed_slope := bundle.normalized_fixed_slope + pieces := bundle.pieces + functions := bundle.functions + root_band := bundle.root_band + piece_odometer := bundle.piece_odometer + piece_cell_cover := bundle.piece_cell_cover + piece_footprint := bundle.piece_footprint + piece_centroid := bundle.piece_centroid + function_domain_cover := bundle.function_domain_cover + function_restriction := bundle.function_restriction + function_compatibility := bundle.function_compatibility + piece_slope := bundle.piece_slope + adjacency := placement.adjacency + layout := placement.layout + fixed_quarter_turn := TileT2QuarterTurn q cfg bundle.normalizedCircle F placement.layout + rightFirstSlot := placement.rightFirstSlot + rightSecondSlot := placement.rightSecondSlot + rightDirectionSlot := placement.rightDirectionSlot + right_slots_cyclic := placement.right_slots_cyclic + rightNeighborPositive := placement.rightNeighborPositive + right_adjacency_centroid := placement.right_adjacency_centroid + right_adjacency_slope_real := by + have hroot : placement.rightRootSlope = bundle.normalizedRootSlope := + Option.some.inj (placement.right_root_slope.symm.trans + bundle.normalized_root_slope) + have hf : placement.rightFixedSlope = bundle.normalizedFixedSlope := + Option.some.inj (placement.right_fixed_slope.symm.trans + bundle.normalized_fixed_slope) + simpa [hroot, hf, q] using placement.right_adjacency_slope_real + right_adjacency_slope_imag := by + have hroot : placement.rightRootSlope = bundle.normalizedRootSlope := + Option.some.inj (placement.right_root_slope.symm.trans + bundle.normalized_root_slope) + have hf : placement.rightFixedSlope = bundle.normalizedFixedSlope := + Option.some.inj (placement.right_fixed_slope.symm.trans + bundle.normalized_fixed_slope) + simpa [hroot, hf, q] using placement.right_adjacency_slope_imag + rightNeighborDisplacement := placement.rightNeighborDisplacement + right_neighbor_displacement := placement.right_neighbor_displacement + right_neighbor_cells := placement.right_neighbor_cells + right_neighbor_empty_anchor := placement.right_neighbor_empty_anchor + firstBoundarySign := placement.firstBoundarySign + secondBoundarySign := placement.secondBoundarySign + boundary_signs := placement.boundary_signs + first_boundary_cells := placement.first_boundary_cells + first_boundary_empty_anchor := placement.first_boundary_empty_anchor + first_boundary_footprint := placement.first_boundary_footprint + first_boundary_domain := placement.first_boundary_domain + second_boundary_cells := placement.second_boundary_cells + second_boundary_empty_anchor := placement.second_boundary_empty_anchor + second_boundary_footprint := placement.second_boundary_footprint + second_boundary_domain := placement.second_boundary_domain + normalized_star := bundle.normalized_star } + let P := placement.layout.P + let u := placement.layout.u + let v := placement.layout.v + let selectedPath : Prop := + (∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + (FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge) + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, + ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ + Disjoint F.cells firstCompanion.cells ∧ + Disjoint root.cells secondCompanion.cells ∧ + Disjoint F.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple root F firstCompanion ∧ + TouchingTriple root F secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ selectedPath + (∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (sgn : GaussianInt), ∀ (s₁ : Bool), ∀ (s₂ : Bool), ∀ (g + : BandOrderedGeneralRightInterfaceCertificate norm), (g.startCompanion = + TileTranslation F (sgn * BandVectors.1 (q 0) (q i.succ))) → ((g.endCompanion = + TileTranslation F (sgn * BandVectors.1 (q 0) (q j.succ))) → ((g.startData.point ≠ + g.endData.point) → ((ExactTileInterfaceTriple F g.startCompanion (TileTranslation + (placement.layout.P i s₁) placement.rightNeighborDisplacement)) → + ((ExactTileInterfaceTriple F g.endCompanion (TileTranslation (placement.layout.P j + s₂) placement.rightNeighborDisplacement)) → ((FootprintVertices (TileTranslation + (placement.layout.P i s₁) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root) → ((FootprintVertices (TileTranslation (placement.layout.P j s₂) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root) → (rightGeometry i j + sgn s₁ s₂)))))))) → ((FootprintVertices (TileTranslation (placement.layout.P + placement.rightFirstSlot placement.firstBoundarySign) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root) → ((FootprintVertices + (TileTranslation (placement.layout.P placement.rightSecondSlot + placement.secondBoundarySign) placement.rightNeighborDisplacement) ⊆ + FootprintVertices root) → ((placement.rightFirstSlot = (0 : Fin (3 : ℕ))) → + ((placement.rightSecondSlot = (1 : Fin (3 : ℕ))) → ((ExactTileInterfaceTriple + bundle.normalizedFixed (TileTranslation bundle.normalizedFixed (BandVectors.1 + (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (bundle.normalizedPresentation + placement.rightFirstSlot.succ))) (TileTranslation (placement.layout.P + placement.rightFirstSlot false) placement.rightNeighborDisplacement)) → + ((ExactTileInterfaceTriple bundle.normalizedFixed (TileTranslation + bundle.normalizedFixed (BandVectors.1 (bundle.normalizedPresentation (0 : Fin (4 : + ℕ))) (bundle.normalizedPresentation placement.rightSecondSlot.succ))) + (TileTranslation (placement.layout.P placement.rightSecondSlot true) + placement.rightNeighborDisplacement)) → (∀ (g : + BandOrderedGeneralRightInterfaceCertificate norm), (g.startCompanion = + TileTranslation F ((1 : GaussianInt) * BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : + Fin (4 : ℕ))))) → ((g.endCompanion = TileTranslation F ((1 : GaussianInt) * + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))) → ((g.startData.point ≠ + g.endData.point) → ((placement.firstBoundarySign = false) → + ((placement.secondBoundarySign = true) → (rightGeometry 0 1 1 false + true)))))))))))))) := by + classical + intro C D T N h k x bundle placement selectedEdge q cfg F root edgeVertex hp norm P u v + selectedPath rightGeometry packageGeometry firstBoundarySubset secondBoundarySubset hi hj + R1 R2 g hgs hge hneq hfirst hsecond + have R1g : ExactTileInterfaceTriple F g.startCompanion + (TileTranslation (placement.layout.P 0 false) + placement.rightNeighborDisplacement) := by + simpa [hgs, hi] using R1 + have R2g : ExactTileInterfaceTriple F g.endCompanion + (TileTranslation (placement.layout.P 1 true) + placement.rightNeighborDisplacement) := by + simpa [hge, hj] using R2 + have hW : FootprintVertices + (TileTranslation (placement.layout.P 0 false) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root := by + simpa [hi, hfirst] using firstBoundarySubset + have hX : FootprintVertices + (TileTranslation (placement.layout.P 1 true) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root := by + simpa [hj, hsecond] using secondBoundarySubset + exact packageGeometry 0 1 1 false true g hgs hge hneq + R1g R2g hW hX + +private theorem hgeomAt1233 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + let P := placement.layout.P + let u := placement.layout.u + let v := placement.layout.v + let selectedPath : Prop := + (∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + (FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge) + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, + ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ + Disjoint F.cells firstCompanion.cells ∧ + Disjoint root.cells secondCompanion.cells ∧ + Disjoint F.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple root F firstCompanion ∧ + TouchingTriple root F secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ selectedPath + (placement.rightFirstSlot = (0 : Fin (3 : ℕ))) → ((placement.rightSecondSlot = (1 : Fin + (3 : ℕ))) → ((rightGeometry 0 1 1 false true) → (rightGeometry + placement.rightFirstSlot placement.rightSecondSlot 1 false true))) ) := by + classical + intro C D T N h k x bundle placement selectedEdge q F root P u v selectedPath rightGeometry hi + hj geom + rw [hi, hj] + exact geom + +private theorem hRAt1245 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + (placement.rightDirectionSlot = (2 : Fin (3 : ℕ))) → ((placement.rightNeighborPositive = + true) → (placement.rightNeighborDisplacement = BandVectors.1 (q 0) (q 3))) ) := by + classical + intro C D T N h k x bundle placement q hk hpos + simpa [hpos, hk] using placement.right_neighbor_displacement + +private theorem tStartAt1267 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (ell : Fin 3), TouchingTriple F (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ)))) → + ((placement.rightNeighborDisplacement = BandVectors.1 (q 0) (q 3)) → (TouchingTriple + F (TileTranslation F placement.rightNeighborDisplacement) (TileTranslation F ((-1 : + GaussianInt) * BandVectors.1 (q 0) (q 1))))) ) := by + classical + intro C D T N h k x bundle placement q F touchingPlus hR + simpa [hR] using touchingPlus 2 + +private theorem tEndAt1271 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (ell : Fin 3), TouchingTriple F (TileTranslation F (-BandVectors.1 (q 0) (q + ell.succ))) (TileTranslation F (BandVectors.1 (q 0) (q (ell + 1).succ)))) → + ((placement.rightNeighborDisplacement = BandVectors.1 (q 0) (q 3)) → (TouchingTriple + F (TileTranslation F ((-1 : GaussianInt) * BandVectors.1 (q 0) (q 2))) + (TileTranslation F placement.rightNeighborDisplacement))) ) := by + classical + intro C D T N h k x bundle placement q F touchingMinus hR + simpa [hR] using touchingMinus 1 + +private theorem geomAt1286 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + ∀ (edgeVertex : ∀ (tile : ProtoTile), (tile.cells.Nonempty) → (∀ (edge : Finset + GaussianInt), (edge ∈ FootprintEdges tile) → (∀ (point : GaussianInt), (point ∈ edge) + → (point ∈ FootprintVertices tile)))), ∀ (hp : placement.rightNeighborPositive = true), + let norm : BandOrderedGeneralRightNormalizationCertificate C T N h k x := { + presentation := bundle.presentation + presentation_proper := bundle.presentation_proper + presentation_child := bundle.presentation_child + parentRotation := bundle.parentRotation + symmetry := bundle.symmetry + rotatedPresentation := bundle.rotatedPresentation + rotated_presentation_eq := bundle.rotated_presentation_eq + normalizedPresentation := q + normalized_presentation_eq := bundle.normalized_presentation_eq + configuration := cfg + normalizedCircle := bundle.normalizedCircle + normalized_circle_eq := bundle.normalized_circle_eq + normalizedFixedCircle := bundle.normalizedCircle + normalized_fixed_circle_eq := by + calc + bundle.normalizedCircle.1.1 = q 0 := bundle.normalized_circle_eq.symm + _ = BandPackingSymmetryCircleAction bundle.symmetry C.1.1 := by + have hq0 := congrFun bundle.normalized_presentation_eq 0 + calc + q 0 = BandPackingSymmetryCircleAction bundle.symmetry + (bundle.rotatedPresentation 0) := by + simpa [BandPackingSymmetryQuadrupleAction] using hq0 + _ = BandPackingSymmetryCircleAction bundle.symmetry C.1.1 := by + rw [bundle.rotated_presentation_eq] + simp [bundle.presentation_child] + normalizedRoot := root + normalizedFixed := F + normalizedRootFunction := bundle.normalizedRootFunction + normalizedFixedFunction := bundle.normalizedFixedFunction + normalizedPoint := bundle.normalizedPoint + normalized_root_eq := bundle.normalized_root_eq + normalized_fixed_eq := bundle.normalized_fixed_eq + normalized_root_function_eq := bundle.normalized_root_function_eq + normalized_fixed_function_eq := bundle.normalized_fixed_function_eq + normalized_point_eq := bundle.normalized_point_eq + normalized_point_root_domain := by + obtain ⟨edge, hp, he⟩ := bundle.edgeAtPoint + have hne := (LatticeTileGridStructure root bundle.root_lattice).1.1 + have hvert := edgeVertex root hne edge he.1 bundle.normalizedPoint hp + have hdom := PositiveCurvatureTileOdometerDomain (q 0) root + bundle.normalizedRootFunction (ProperBandCurvatureStructure q cfg.proper).1 + bundle.normalized_root_odometer + exact (Set.ext_iff.mp hdom bundle.normalizedPoint).mpr hvert + normalized_point_fixed_domain := by + obtain ⟨edge, hp, he⟩ := bundle.edgeAtPoint + have hne := (LatticeTileGridStructure F bundle.fixed_lattice).1.1 + have hvert := edgeVertex F hne edge he.2 bundle.normalizedPoint hp + have hdom := PositiveCurvatureTileOdometerDomain + bundle.normalizedCircle.1.1 F bundle.normalizedFixedFunction + bundle.normalizedCircle.property placement.adjacency.2.1 + exact (Set.ext_iff.mp hdom bundle.normalizedPoint).mpr hvert + normalized_root_odometer := bundle.normalized_root_odometer + normalized_fixed_odometer := placement.adjacency.2.1 + normalized_root_lattice := bundle.root_lattice + normalized_fixed_lattice := bundle.fixed_lattice + normalizedRootSlope := bundle.normalizedRootSlope + normalizedFixedSlope := bundle.normalizedFixedSlope + normalized_root_slope := bundle.normalized_root_slope + normalized_fixed_slope := bundle.normalized_fixed_slope + pieces := bundle.pieces + functions := bundle.functions + root_band := bundle.root_band + piece_odometer := bundle.piece_odometer + piece_cell_cover := bundle.piece_cell_cover + piece_footprint := bundle.piece_footprint + piece_centroid := bundle.piece_centroid + function_domain_cover := bundle.function_domain_cover + function_restriction := bundle.function_restriction + function_compatibility := bundle.function_compatibility + piece_slope := bundle.piece_slope + adjacency := placement.adjacency + layout := placement.layout + fixed_quarter_turn := TileT2QuarterTurn q cfg bundle.normalizedCircle F placement.layout + rightFirstSlot := placement.rightFirstSlot + rightSecondSlot := placement.rightSecondSlot + rightDirectionSlot := placement.rightDirectionSlot + right_slots_cyclic := placement.right_slots_cyclic + rightNeighborPositive := placement.rightNeighborPositive + right_adjacency_centroid := placement.right_adjacency_centroid + right_adjacency_slope_real := by + have hroot : placement.rightRootSlope = bundle.normalizedRootSlope := + Option.some.inj (placement.right_root_slope.symm.trans + bundle.normalized_root_slope) + have hf : placement.rightFixedSlope = bundle.normalizedFixedSlope := + Option.some.inj (placement.right_fixed_slope.symm.trans + bundle.normalized_fixed_slope) + simpa [hroot, hf, q] using placement.right_adjacency_slope_real + right_adjacency_slope_imag := by + have hroot : placement.rightRootSlope = bundle.normalizedRootSlope := + Option.some.inj (placement.right_root_slope.symm.trans + bundle.normalized_root_slope) + have hf : placement.rightFixedSlope = bundle.normalizedFixedSlope := + Option.some.inj (placement.right_fixed_slope.symm.trans + bundle.normalized_fixed_slope) + simpa [hroot, hf, q] using placement.right_adjacency_slope_imag + rightNeighborDisplacement := placement.rightNeighborDisplacement + right_neighbor_displacement := placement.right_neighbor_displacement + right_neighbor_cells := placement.right_neighbor_cells + right_neighbor_empty_anchor := placement.right_neighbor_empty_anchor + firstBoundarySign := placement.firstBoundarySign + secondBoundarySign := placement.secondBoundarySign + boundary_signs := placement.boundary_signs + first_boundary_cells := placement.first_boundary_cells + first_boundary_empty_anchor := placement.first_boundary_empty_anchor + first_boundary_footprint := placement.first_boundary_footprint + first_boundary_domain := placement.first_boundary_domain + second_boundary_cells := placement.second_boundary_cells + second_boundary_empty_anchor := placement.second_boundary_empty_anchor + second_boundary_footprint := placement.second_boundary_footprint + second_boundary_domain := placement.second_boundary_domain + normalized_star := bundle.normalized_star } + let P := placement.layout.P + let u := placement.layout.u + let v := placement.layout.v + let selectedPath : Prop := + (∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + (FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge) + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, + ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ + Disjoint F.cells firstCompanion.cells ∧ + Disjoint root.cells secondCompanion.cells ∧ + Disjoint F.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple root F firstCompanion ∧ + TouchingTriple root F secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ selectedPath + (∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (sgn : GaussianInt), ∀ (s₁ : Bool), ∀ (s₂ : Bool), ∀ (g + : BandOrderedGeneralRightInterfaceCertificate norm), (g.startCompanion = + TileTranslation F (sgn * BandVectors.1 (q 0) (q i.succ))) → ((g.endCompanion = + TileTranslation F (sgn * BandVectors.1 (q 0) (q j.succ))) → ((g.startData.point ≠ + g.endData.point) → ((ExactTileInterfaceTriple F g.startCompanion (TileTranslation + (placement.layout.P i s₁) placement.rightNeighborDisplacement)) → + ((ExactTileInterfaceTriple F g.endCompanion (TileTranslation (placement.layout.P j + s₂) placement.rightNeighborDisplacement)) → ((FootprintVertices (TileTranslation + (placement.layout.P i s₁) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root) → ((FootprintVertices (TileTranslation (placement.layout.P j s₂) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root) → (rightGeometry i j + sgn s₁ s₂)))))))) → ((FootprintVertices (TileTranslation (placement.layout.P + placement.rightFirstSlot placement.firstBoundarySign) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root) → ((FootprintVertices + (TileTranslation (placement.layout.P placement.rightSecondSlot + placement.secondBoundarySign) placement.rightNeighborDisplacement) ⊆ + FootprintVertices root) → ((placement.rightFirstSlot = (0 : Fin (3 : ℕ))) → + ((placement.rightSecondSlot = (1 : Fin (3 : ℕ))) → ((ExactTileInterfaceTriple + bundle.normalizedFixed (TileTranslation bundle.normalizedFixed (-BandVectors.1 + (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (bundle.normalizedPresentation + placement.rightFirstSlot.succ))) (TileTranslation (placement.layout.P + placement.rightFirstSlot true) placement.rightNeighborDisplacement)) → + ((ExactTileInterfaceTriple bundle.normalizedFixed (TileTranslation + bundle.normalizedFixed (-BandVectors.1 (bundle.normalizedPresentation (0 : Fin (4 : + ℕ))) (bundle.normalizedPresentation placement.rightSecondSlot.succ))) + (TileTranslation (placement.layout.P placement.rightSecondSlot false) + placement.rightNeighborDisplacement)) → (∀ (g : + BandOrderedGeneralRightInterfaceCertificate norm), (g.startCompanion = + TileTranslation F ((-1 : GaussianInt) * BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : + Fin (4 : ℕ))))) → ((g.endCompanion = TileTranslation F ((-1 : GaussianInt) * + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))) → ((g.startData.point ≠ + g.endData.point) → ((placement.firstBoundarySign = true) → + ((placement.secondBoundarySign = false) → (rightGeometry 0 1 (-1) true + false)))))))))))) ) := by + classical + intro C D T N h k x bundle placement selectedEdge q cfg F root edgeVertex hp norm P u v + selectedPath rightGeometry packageGeometry firstBoundarySubset secondBoundarySubset hi hj + R1 R2 g hgs hge hneq hfirst hsecond + have R1g : ExactTileInterfaceTriple F g.startCompanion + (TileTranslation (placement.layout.P 0 true) + placement.rightNeighborDisplacement) := by + simpa [hgs, hi] using R1 + have R2g : ExactTileInterfaceTriple F g.endCompanion + (TileTranslation (placement.layout.P 1 false) + placement.rightNeighborDisplacement) := by + simpa [hge, hj] using R2 + have hW : FootprintVertices + (TileTranslation (placement.layout.P 0 true) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root := by + simpa [hi, hfirst] using firstBoundarySubset + have hX : FootprintVertices + (TileTranslation (placement.layout.P 1 false) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root := by + simpa [hj, hsecond] using secondBoundarySubset + exact packageGeometry 0 1 (-1) true false g hgs hge hneq + R1g R2g hW hX + +private theorem hgeomAt1305 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + let P := placement.layout.P + let u := placement.layout.u + let v := placement.layout.v + let selectedPath : Prop := + (∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + (FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge) + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, + ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ + Disjoint F.cells firstCompanion.cells ∧ + Disjoint root.cells secondCompanion.cells ∧ + Disjoint F.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple root F firstCompanion ∧ + TouchingTriple root F secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ selectedPath + (placement.rightFirstSlot = (0 : Fin (3 : ℕ))) → ((placement.rightSecondSlot = (1 : Fin + (3 : ℕ))) → ((rightGeometry 0 1 (-1) true false) → (rightGeometry + placement.rightFirstSlot placement.rightSecondSlot (-1) true false))) ) := by + classical + intro C D T N h k x bundle placement selectedEdge q F root P u v selectedPath rightGeometry hi + hj geom + rw [hi, hj] + exact geom + +private theorem hRAt1329 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + (placement.rightDirectionSlot = (0 : Fin (3 : ℕ))) → ((placement.rightNeighborPositive = + false) → (placement.rightNeighborDisplacement = -BandVectors.1 (q 0) (q 1))) ) := by + classical + intro C D T N h k x bundle placement q hk hpos + simpa [hpos, hk] using placement.right_neighbor_displacement + +private theorem tStartAt1341 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (ell : Fin 3), TouchingTriple F (TileTranslation F (-BandVectors.1 (q 0) (q + ell.succ))) (TileTranslation F (BandVectors.1 (q 0) (q (ell + 1).succ)))) → + ((placement.rightNeighborDisplacement = -BandVectors.1 (q 0) (q 1)) → (TouchingTriple + F (TileTranslation F placement.rightNeighborDisplacement) (TileTranslation F ((1 : + GaussianInt) * BandVectors.1 (q 0) (q 2))))) ) := by + classical + intro C D T N h k x bundle placement q F touchingMinus hR + simpa [hR] using touchingMinus 0 + +private theorem tEndAt1345 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (ell : Fin 3), TouchingTriple F (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ)))) → + ((placement.rightNeighborDisplacement = -BandVectors.1 (q 0) (q 1)) → (TouchingTriple + F (TileTranslation F ((1 : GaussianInt) * BandVectors.1 (q 0) (q 3))) + (TileTranslation F placement.rightNeighborDisplacement))) ) := by + classical + intro C D T N h k x bundle placement q F touchingPlus hR + simpa [hR] using touchingPlus 2 + +private theorem hWAt1369 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let root := bundle.normalizedRoot + (FootprintVertices (TileTranslation (placement.layout.P placement.rightFirstSlot + placement.firstBoundarySign) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root) → ((placement.rightFirstSlot = (1 : Fin (3 : ℕ))) → + ((placement.firstBoundarySign = false) → (FootprintVertices (TileTranslation + (placement.layout.P 1 false) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root))) ) := by + classical + intro C D T N h k x bundle placement root firstBoundarySubset hi hfirst + simpa [hi, hfirst] using firstBoundarySubset + +private theorem hXAt1373 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let root := bundle.normalizedRoot + (FootprintVertices (TileTranslation (placement.layout.P placement.rightSecondSlot + placement.secondBoundarySign) placement.rightNeighborDisplacement) ⊆ + FootprintVertices root) → ((placement.rightSecondSlot = (2 : Fin (3 : ℕ))) → + ((placement.secondBoundarySign = true) → (FootprintVertices (TileTranslation + (placement.layout.P 2 true) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root))) ) := by + classical + intro C D T N h k x bundle placement root secondBoundarySubset hj hsecond + simpa [hj, hsecond] using secondBoundarySubset + +private theorem hgeomAt1378 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + let P := placement.layout.P + let u := placement.layout.u + let v := placement.layout.v + let selectedPath : Prop := + (∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + (FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge) + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, + ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ + Disjoint F.cells firstCompanion.cells ∧ + Disjoint root.cells secondCompanion.cells ∧ + Disjoint F.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple root F firstCompanion ∧ + TouchingTriple root F secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ selectedPath + (placement.rightFirstSlot = (1 : Fin (3 : ℕ))) → ((placement.rightSecondSlot = (2 : Fin + (3 : ℕ))) → ((rightGeometry (1 : Fin (3 : ℕ)) (2 : Fin (3 : ℕ)) (1 : GaussianInt) + false true) → (rightGeometry placement.rightFirstSlot placement.rightSecondSlot 1 + false true))) ) := by + classical + intro C D T N h k x bundle placement selectedEdge q F root P u v selectedPath rightGeometry hi + hj geom + rw [hi, hj] + exact geom + +private theorem hRAt1390 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + (placement.rightDirectionSlot = (0 : Fin (3 : ℕ))) → ((placement.rightNeighborPositive = + true) → (placement.rightNeighborDisplacement = BandVectors.1 (q 0) (q 1))) ) := by + classical + intro C D T N h k x bundle placement q hk hpos + simpa [hpos, hk] using placement.right_neighbor_displacement + +private theorem tStartAt1402 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (ell : Fin 3), TouchingTriple F (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ)))) → + ((placement.rightNeighborDisplacement = BandVectors.1 (q 0) (q 1)) → (TouchingTriple + F (TileTranslation F placement.rightNeighborDisplacement) (TileTranslation F ((-1 : + GaussianInt) * BandVectors.1 (q 0) (q 2))))) ) := by + classical + intro C D T N h k x bundle placement q F touchingPlus hR + simpa [hR] using touchingPlus 0 + +private theorem tEndAt1406 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (ell : Fin 3), TouchingTriple F (TileTranslation F (-BandVectors.1 (q 0) (q + ell.succ))) (TileTranslation F (BandVectors.1 (q 0) (q (ell + 1).succ)))) → + ((placement.rightNeighborDisplacement = BandVectors.1 (q 0) (q 1)) → (TouchingTriple + F (TileTranslation F ((-1 : GaussianInt) * BandVectors.1 (q 0) (q 3))) + (TileTranslation F placement.rightNeighborDisplacement))) ) := by + classical + intro C D T N h k x bundle placement q F touchingMinus hR + simpa [hR] using touchingMinus 2 + +private theorem hWAt1428 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let root := bundle.normalizedRoot + (FootprintVertices (TileTranslation (placement.layout.P placement.rightFirstSlot + placement.firstBoundarySign) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root) → ((placement.rightFirstSlot = (1 : Fin (3 : ℕ))) → + ((placement.firstBoundarySign = true) → (FootprintVertices (TileTranslation + (placement.layout.P 1 true) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root))) ) := by + classical + intro C D T N h k x bundle placement root firstBoundarySubset hi hfirst + simpa [hi, hfirst] using firstBoundarySubset + +private theorem hXAt1432 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let root := bundle.normalizedRoot + (FootprintVertices (TileTranslation (placement.layout.P placement.rightSecondSlot + placement.secondBoundarySign) placement.rightNeighborDisplacement) ⊆ + FootprintVertices root) → ((placement.rightSecondSlot = (2 : Fin (3 : ℕ))) → + ((placement.secondBoundarySign = false) → (FootprintVertices (TileTranslation + (placement.layout.P 2 false) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root))) ) := by + classical + intro C D T N h k x bundle placement root secondBoundarySubset hj hsecond + simpa [hj, hsecond] using secondBoundarySubset + +private theorem hgeomAt1437 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + let P := placement.layout.P + let u := placement.layout.u + let v := placement.layout.v + let selectedPath : Prop := + (∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + (FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge) + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, + ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ + Disjoint F.cells firstCompanion.cells ∧ + Disjoint root.cells secondCompanion.cells ∧ + Disjoint F.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple root F firstCompanion ∧ + TouchingTriple root F secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ selectedPath + (placement.rightFirstSlot = (1 : Fin (3 : ℕ))) → ((placement.rightSecondSlot = (2 : Fin + (3 : ℕ))) → ((rightGeometry (1 : Fin (3 : ℕ)) (2 : Fin (3 : ℕ)) (-1 : GaussianInt) + true false) → (rightGeometry placement.rightFirstSlot placement.rightSecondSlot (-1) + true false))) ) := by + classical + intro C D T N h k x bundle placement selectedEdge q F root P u v selectedPath rightGeometry hi + hj geom + rw [hi, hj] + exact geom + +private theorem hRAt1461 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + (placement.rightDirectionSlot = (1 : Fin (3 : ℕ))) → ((placement.rightNeighborPositive = + false) → (placement.rightNeighborDisplacement = -BandVectors.1 (q 0) (q 2))) ) := by + classical + intro C D T N h k x bundle placement q hk hpos + simpa [hpos, hk] using placement.right_neighbor_displacement + +private theorem tStartAt1473 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (ell : Fin 3), TouchingTriple F (TileTranslation F (-BandVectors.1 (q 0) (q + ell.succ))) (TileTranslation F (BandVectors.1 (q 0) (q (ell + 1).succ)))) → + ((placement.rightNeighborDisplacement = -BandVectors.1 (q 0) (q 2)) → (TouchingTriple + F (TileTranslation F placement.rightNeighborDisplacement) (TileTranslation F ((1 : + GaussianInt) * BandVectors.1 (q 0) (q 3))))) ) := by + classical + intro C D T N h k x bundle placement q F touchingMinus hR + simpa [hR] using touchingMinus 1 + +private theorem tEndAt1477 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (ell : Fin 3), TouchingTriple F (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ)))) → + ((placement.rightNeighborDisplacement = -BandVectors.1 (q 0) (q 2)) → (TouchingTriple + F (TileTranslation F ((1 : GaussianInt) * BandVectors.1 (q 0) (q 1))) + (TileTranslation F placement.rightNeighborDisplacement))) ) := by + classical + intro C D T N h k x bundle placement q F touchingPlus hR + simpa [hR] using touchingPlus 0 + +private theorem hWAt1501 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let root := bundle.normalizedRoot + (FootprintVertices (TileTranslation (placement.layout.P placement.rightFirstSlot + placement.firstBoundarySign) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root) → ((placement.rightFirstSlot = (2 : Fin (3 : ℕ))) → + ((placement.firstBoundarySign = false) → (FootprintVertices (TileTranslation + (placement.layout.P 2 false) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root))) ) := by + classical + intro C D T N h k x bundle placement root firstBoundarySubset hi hfirst + simpa [hi, hfirst] using firstBoundarySubset + +private theorem hXAt1505 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let root := bundle.normalizedRoot + (FootprintVertices (TileTranslation (placement.layout.P placement.rightSecondSlot + placement.secondBoundarySign) placement.rightNeighborDisplacement) ⊆ + FootprintVertices root) → ((placement.rightSecondSlot = (0 : Fin (3 : ℕ))) → + ((placement.secondBoundarySign = true) → (FootprintVertices (TileTranslation + (placement.layout.P 0 true) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root))) ) := by + classical + intro C D T N h k x bundle placement root secondBoundarySubset hj hsecond + simpa [hj, hsecond] using secondBoundarySubset + +private theorem hgeomAt1510 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + let P := placement.layout.P + let u := placement.layout.u + let v := placement.layout.v + let selectedPath : Prop := + (∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + (FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge) + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, + ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ + Disjoint F.cells firstCompanion.cells ∧ + Disjoint root.cells secondCompanion.cells ∧ + Disjoint F.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple root F firstCompanion ∧ + TouchingTriple root F secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ selectedPath + (placement.rightFirstSlot = (2 : Fin (3 : ℕ))) → ((placement.rightSecondSlot = (0 : Fin + (3 : ℕ))) → ((rightGeometry (2 : Fin (3 : ℕ)) (0 : Fin (3 : ℕ)) (1 : GaussianInt) + false true) → (rightGeometry placement.rightFirstSlot placement.rightSecondSlot 1 + false true))) ) := by + classical + intro C D T N h k x bundle placement selectedEdge q F root P u v selectedPath rightGeometry hi + hj geom + rw [hi, hj] + exact geom + +private theorem hRAt1522 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + (placement.rightDirectionSlot = (1 : Fin (3 : ℕ))) → ((placement.rightNeighborPositive = + true) → (placement.rightNeighborDisplacement = BandVectors.1 (q 0) (q 2))) ) := by + classical + intro C D T N h k x bundle placement q hk hpos + simpa [hpos, hk] using placement.right_neighbor_displacement + +private theorem tStartAt1534 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (ell : Fin 3), TouchingTriple F (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ)))) → + ((placement.rightNeighborDisplacement = BandVectors.1 (q 0) (q 2)) → (TouchingTriple + F (TileTranslation F placement.rightNeighborDisplacement) (TileTranslation F ((-1 : + GaussianInt) * BandVectors.1 (q 0) (q 3))))) ) := by + classical + intro C D T N h k x bundle placement q F touchingPlus hR + simpa [hR] using touchingPlus 1 + +private theorem tEndAt1538 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (ell : Fin 3), TouchingTriple F (TileTranslation F (-BandVectors.1 (q 0) (q + ell.succ))) (TileTranslation F (BandVectors.1 (q 0) (q (ell + 1).succ)))) → + ((placement.rightNeighborDisplacement = BandVectors.1 (q 0) (q 2)) → (TouchingTriple + F (TileTranslation F ((-1 : GaussianInt) * BandVectors.1 (q 0) (q 1))) + (TileTranslation F placement.rightNeighborDisplacement))) ) := by + classical + intro C D T N h k x bundle placement q F touchingMinus hR + simpa [hR] using touchingMinus 0 + +private theorem hWAt1560 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let root := bundle.normalizedRoot + (FootprintVertices (TileTranslation (placement.layout.P placement.rightFirstSlot + placement.firstBoundarySign) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root) → ((placement.rightFirstSlot = (2 : Fin (3 : ℕ))) → + ((placement.firstBoundarySign = true) → (FootprintVertices (TileTranslation + (placement.layout.P 2 true) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root))) ) := by + classical + intro C D T N h k x bundle placement root firstBoundarySubset hi hfirst + simpa [hi, hfirst] using firstBoundarySubset + +private theorem hXAt1564 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let root := bundle.normalizedRoot + (FootprintVertices (TileTranslation (placement.layout.P placement.rightSecondSlot + placement.secondBoundarySign) placement.rightNeighborDisplacement) ⊆ + FootprintVertices root) → ((placement.rightSecondSlot = (0 : Fin (3 : ℕ))) → + ((placement.secondBoundarySign = false) → (FootprintVertices (TileTranslation + (placement.layout.P 0 false) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root))) ) := by + classical + intro C D T N h k x bundle placement root secondBoundarySubset hj hsecond + simpa [hj, hsecond] using secondBoundarySubset + +private theorem hgeomAt1569 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + let P := placement.layout.P + let u := placement.layout.u + let v := placement.layout.v + let selectedPath : Prop := + (∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + (FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge) + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, + ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ + Disjoint F.cells firstCompanion.cells ∧ + Disjoint root.cells secondCompanion.cells ∧ + Disjoint F.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple root F firstCompanion ∧ + TouchingTriple root F secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ selectedPath + (placement.rightFirstSlot = (2 : Fin (3 : ℕ))) → ((placement.rightSecondSlot = (0 : Fin + (3 : ℕ))) → ((rightGeometry (2 : Fin (3 : ℕ)) (0 : Fin (3 : ℕ)) (-1 : GaussianInt) + true false) → (rightGeometry placement.rightFirstSlot placement.rightSecondSlot (-1) + true false))) ) := by + classical + intro C D T N h k x bundle placement selectedEdge q F root P u v selectedPath rightGeometry hi + hj geom + rw [hi, hj] + exact geom + +end SelectedRowGeometry + +namespace SelectedRowNormalization + +private noncomputable def certificate + (C D : BandCircle) (T N : ProtoTile) (h k : PartialOdometer) + (x : GaussianInt) + (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x) + (placement : BandOrderedGeneralRightPlacement bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction + bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces + bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection) + : + BandOrderedGeneralRightNormalizationCertificate C T N h k x := by + classical + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + exact { + presentation := bundle.presentation + presentation_proper := bundle.presentation_proper + presentation_child := bundle.presentation_child + parentRotation := bundle.parentRotation + symmetry := bundle.symmetry + rotatedPresentation := bundle.rotatedPresentation + rotated_presentation_eq := bundle.rotated_presentation_eq + normalizedPresentation := q + normalized_presentation_eq := bundle.normalized_presentation_eq + configuration := cfg + normalizedCircle := bundle.normalizedCircle + normalized_circle_eq := bundle.normalized_circle_eq + normalizedFixedCircle := bundle.normalizedCircle + normalized_fixed_circle_eq := by + calc + bundle.normalizedCircle.1.1 = q 0 := bundle.normalized_circle_eq.symm + _ = BandPackingSymmetryCircleAction bundle.symmetry C.1.1 := by + have hq0 := congrFun bundle.normalized_presentation_eq 0 + calc + q 0 = BandPackingSymmetryCircleAction bundle.symmetry + (bundle.rotatedPresentation 0) := by + simpa [BandPackingSymmetryQuadrupleAction] using hq0 + _ = BandPackingSymmetryCircleAction bundle.symmetry C.1.1 := by + rw [bundle.rotated_presentation_eq] + simp [bundle.presentation_child] + normalizedRoot := root + normalizedFixed := F + normalizedRootFunction := bundle.normalizedRootFunction + normalizedFixedFunction := bundle.normalizedFixedFunction + normalizedPoint := bundle.normalizedPoint + normalized_root_eq := bundle.normalized_root_eq + normalized_fixed_eq := bundle.normalized_fixed_eq + normalized_root_function_eq := bundle.normalized_root_function_eq + normalized_fixed_function_eq := bundle.normalized_fixed_function_eq + normalized_point_eq := bundle.normalized_point_eq + normalized_point_root_domain := by + obtain ⟨edge, hp, he⟩ := bundle.edgeAtPoint + have hne := (LatticeTileGridStructure root bundle.root_lattice).1.1 + have hvert := SelectedRowGeometry.edgeVertex root hne edge he.1 bundle.normalizedPoint hp + have hdom := PositiveCurvatureTileOdometerDomain (q 0) root + bundle.normalizedRootFunction (ProperBandCurvatureStructure q cfg.proper).1 + bundle.normalized_root_odometer + exact (Set.ext_iff.mp hdom bundle.normalizedPoint).mpr hvert + normalized_point_fixed_domain := by + obtain ⟨edge, hp, he⟩ := bundle.edgeAtPoint + have hne := (LatticeTileGridStructure F bundle.fixed_lattice).1.1 + have hvert := SelectedRowGeometry.edgeVertex F hne edge he.2 bundle.normalizedPoint hp + have hdom := PositiveCurvatureTileOdometerDomain + bundle.normalizedCircle.1.1 F bundle.normalizedFixedFunction + bundle.normalizedCircle.property placement.adjacency.2.1 + exact (Set.ext_iff.mp hdom bundle.normalizedPoint).mpr hvert + normalized_root_odometer := bundle.normalized_root_odometer + normalized_fixed_odometer := placement.adjacency.2.1 + normalized_root_lattice := bundle.root_lattice + normalized_fixed_lattice := bundle.fixed_lattice + normalizedRootSlope := bundle.normalizedRootSlope + normalizedFixedSlope := bundle.normalizedFixedSlope + normalized_root_slope := bundle.normalized_root_slope + normalized_fixed_slope := bundle.normalized_fixed_slope + pieces := bundle.pieces + functions := bundle.functions + root_band := bundle.root_band + piece_odometer := bundle.piece_odometer + piece_cell_cover := bundle.piece_cell_cover + piece_footprint := bundle.piece_footprint + piece_centroid := bundle.piece_centroid + function_domain_cover := bundle.function_domain_cover + function_restriction := bundle.function_restriction + function_compatibility := bundle.function_compatibility + piece_slope := bundle.piece_slope + adjacency := placement.adjacency + layout := placement.layout + fixed_quarter_turn := TileT2QuarterTurn q cfg bundle.normalizedCircle F placement.layout + rightFirstSlot := placement.rightFirstSlot + rightSecondSlot := placement.rightSecondSlot + rightDirectionSlot := placement.rightDirectionSlot + right_slots_cyclic := placement.right_slots_cyclic + rightNeighborPositive := placement.rightNeighborPositive + right_adjacency_centroid := placement.right_adjacency_centroid + right_adjacency_slope_real := by + have hroot : placement.rightRootSlope = bundle.normalizedRootSlope := + Option.some.inj (placement.right_root_slope.symm.trans + bundle.normalized_root_slope) + have hf : placement.rightFixedSlope = bundle.normalizedFixedSlope := + Option.some.inj (placement.right_fixed_slope.symm.trans + bundle.normalized_fixed_slope) + simpa [hroot, hf, q] using placement.right_adjacency_slope_real + right_adjacency_slope_imag := by + have hroot : placement.rightRootSlope = bundle.normalizedRootSlope := + Option.some.inj (placement.right_root_slope.symm.trans + bundle.normalized_root_slope) + have hf : placement.rightFixedSlope = bundle.normalizedFixedSlope := + Option.some.inj (placement.right_fixed_slope.symm.trans + bundle.normalized_fixed_slope) + simpa [hroot, hf, q] using placement.right_adjacency_slope_imag + rightNeighborDisplacement := placement.rightNeighborDisplacement + right_neighbor_displacement := placement.right_neighbor_displacement + right_neighbor_cells := placement.right_neighbor_cells + right_neighbor_empty_anchor := placement.right_neighbor_empty_anchor + firstBoundarySign := placement.firstBoundarySign + secondBoundarySign := placement.secondBoundarySign + boundary_signs := placement.boundary_signs + first_boundary_cells := placement.first_boundary_cells + first_boundary_empty_anchor := placement.first_boundary_empty_anchor + first_boundary_footprint := placement.first_boundary_footprint + first_boundary_domain := placement.first_boundary_domain + second_boundary_cells := placement.second_boundary_cells + second_boundary_empty_anchor := placement.second_boundary_empty_anchor + second_boundary_footprint := placement.second_boundary_footprint + second_boundary_domain := placement.second_boundary_domain + normalized_star := bundle.normalized_star } + +end SelectedRowNormalization + +namespace SelectedRowConclusions + +private theorem firstCyclicCase : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), ∀ (chosenBoundary : + bundle.selectedSlot = placement.rightFirstSlot ∧ bundle.selectedSign = + placement.firstBoundarySign ∨ bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = placement.secondBoundarySign), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + ∀ (edgeVertex : ∀ (tile : ProtoTile), (tile.cells.Nonempty) → (∀ (edge : Finset + GaussianInt), (edge ∈ FootprintEdges tile) → (∀ (point : GaussianInt), (point ∈ edge) + → (point ∈ FootprintVertices tile)))), + let norm := SelectedRowNormalization.certificate C D T N h k x bundle placement + ∀ (childInterfaces : (∀ (i : Fin (3 : ℕ)), Nonempty (ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation + F (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ))))))) ∧ (∀ (i + : Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile (q i.succ) U → TileCentroid U - + TileCentroid F = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) + → Nonempty (ExactTileInterfaceTriple F (TileTranslation F (BandVectors.1 (q i.succ) + (q (0 : Fin (4 : ℕ))))) U)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), BandPrototile (q i.succ) U → BandPrototile (q (i + (1 : Fin (3 : + ℕ))).succ) V → TileCentroid U - TileCentroid F = (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 + (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V - TileCentroid F = (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : + ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + (1 : Fin (3 : + ℕ))).succ))) → Nonempty (ExactTileInterfaceTriple F U V)) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (s + : Fin (4 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → + BandPrototile (q (if Even (↑s : ℕ) then i + (1 : Fin (3 : ℕ)) else i - (1 : Fin (3 : + ℕ))).succ) V → TileCentroid U - TileCentroid F = (1 / 2 : ℝ) • GaussianRealPoint + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V - + TileCentroid F = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q + (0 : Fin (4 : ℕ))) - BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + (1 : Fin (3 : + ℕ))).succ) else BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i - (1 : Fin (3 : ℕ))).succ) + - BandVectors.1 (q (i - (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) → + let uR := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) else BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))); + let uL := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then + BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) else BandVectors.1 (q (0 : Fin (4 : + ℕ))) (q i.succ); ∃ (rightData : ExactTileInterfaceTriple F (TileTranslation F uR) U) + (incomingData : ExactTileInterfaceTriple F (TileTranslation F uL) U) (t5Data : + ExactTileInterfaceTriple F U V), rightData.point = t5Data.point ∧ incomingData.point + ≠ t5Data.point ∧ incomingData.otherCA = t5Data.point ∧ rightData.otherCA = + incomingData.point ∧ t5Data.otherAB = incomingData.point), ∀ (turnOutgoing : ∀ (s : + Fin 3), GaussianQuarterTurn (BandVectors.1 (q s.succ) (q 0)) = BandVectors.1 (q 0) (q + s.succ)), ∀ (turnNeg : ∀ (z : GaussianInt), GaussianQuarterTurn (-z) = + -GaussianQuarterTurn z), ∀ (boundaryRecords : placement.rightFirstSlot = (0 : Fin (3 + : ℕ)) ∧ placement.rightSecondSlot = (1 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot + = (2 : Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (1 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (2 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (0 : + Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (2 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (0 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (1 : + Fin (3 : ℕ)) → (placement.rightNeighborPositive = true → Nonempty + (ExactTileInterfaceTriple bundle.normalizedFixed (TileTranslation + bundle.normalizedFixed (-BandVectors.1 (bundle.normalizedPresentation (0 : Fin (4 : + ℕ))) (bundle.normalizedPresentation placement.rightFirstSlot.succ))) (TileTranslation + (placement.layout.P placement.rightFirstSlot true) + placement.rightNeighborDisplacement)) ∧ Nonempty (ExactTileInterfaceTriple + bundle.normalizedFixed (TileTranslation bundle.normalizedFixed (-BandVectors.1 + (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (bundle.normalizedPresentation + placement.rightSecondSlot.succ))) (TileTranslation (placement.layout.P + placement.rightSecondSlot false) placement.rightNeighborDisplacement))) ∧ + (placement.rightNeighborPositive = false → Nonempty (ExactTileInterfaceTriple + bundle.normalizedFixed (TileTranslation bundle.normalizedFixed (BandVectors.1 + (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (bundle.normalizedPresentation + placement.rightFirstSlot.succ))) (TileTranslation (placement.layout.P + placement.rightFirstSlot false) placement.rightNeighborDisplacement)) ∧ Nonempty + (ExactTileInterfaceTriple bundle.normalizedFixed (TileTranslation + bundle.normalizedFixed (BandVectors.1 (bundle.normalizedPresentation (0 : Fin (4 : + ℕ))) (bundle.normalizedPresentation placement.rightSecondSlot.succ))) + (TileTranslation (placement.layout.P placement.rightSecondSlot true) + placement.rightNeighborDisplacement)))), ∀ (centeredExactTurn : ∀ (a : GaussianInt), + ∀ (b : GaussianInt), (ExactTileInterfaceTriple F (TileTranslation F a) + (TileTranslation F b)) → (Nonempty (ExactTileInterfaceTriple F (TileTranslation F + (GaussianQuarterTurn a)) (TileTranslation F (GaussianQuarterTurn b))))), ∀ + (tripleTurnOutgoing : ∀ (ell : Fin 3), GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn (BandVectors.1 (q ell.succ) (q 0)))) = -BandVectors.1 (q 0) (q + ell.succ)), ∀ (tripleTurnNegativeNext : ∀ (ell : Fin 3), GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn (-BandVectors.1 (q (ell + 1).succ) (q 0)))) + = BandVectors.1 (q 0) (q (ell + 1).succ)), + (∀ (ell : Fin 3), TouchingTriple F (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ)))) → ((∀ (ell : Fin 3), + TouchingTriple F (TileTranslation F (-BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (BandVectors.1 (q 0) (q (ell + 1).succ)))) → ( + let P := placement.layout.P + let u := placement.layout.u + let v := placement.layout.v + let selectedPath : Prop := + (∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + (FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge) + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, + ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ + Disjoint F.cells firstCompanion.cells ∧ + Disjoint root.cells secondCompanion.cells ∧ + Disjoint F.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple root F firstCompanion ∧ + TouchingTriple root F secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ selectedPath + (∀ (uStart : GaussianInt), ∀ (uEnd : GaussianInt), ∀ (mR : Int), ∀ (nR : Int), ∀ (mS : + Int), ∀ (nS : Int), ∀ (mE : Int), ∀ (nE : Int), (placement.rightNeighborDisplacement + = (mR : GaussianInt) * placement.layout.u + (nR : GaussianInt) * placement.layout.v) + → ((uStart = (mS : GaussianInt) * placement.layout.u + (nS : GaussianInt) * + placement.layout.v) → ((uEnd = (mE : GaussianInt) * placement.layout.u + (nE : + GaussianInt) * placement.layout.v) → (((0, 0) ≠ (mR, nR)) → (((0, 0) ≠ (mS, nS)) → + (((0, 0) ≠ (mE, nE)) → (((mR, nR) ≠ (mS, nS)) → (((mR, nR) ≠ (mE, nE)) → (((mS, nS) ≠ + (mE, nE)) → ((ExactTileInterfaceTriple F (TileTranslation F + placement.rightNeighborDisplacement) (TileTranslation F uStart)) → + ((ExactTileInterfaceTriple F (TileTranslation F uEnd) (TileTranslation F + placement.rightNeighborDisplacement)) → ((TouchingTriple F (TileTranslation F + placement.rightNeighborDisplacement) (TileTranslation F uStart)) → ((TouchingTriple F + (TileTranslation F uEnd) (TileTranslation F placement.rightNeighborDisplacement)) → + (∃ g : BandOrderedGeneralRightInterfaceCertificate norm, g.startCompanion = + TileTranslation F uStart ∧ g.endCompanion = TileTranslation F uEnd ∧ + g.startData.point ≠ g.endData.point)))))))))))))) → ((((0, 0) : Int × Int) ≠ (1, 1) ∧ + ((0, 0) : Int × Int) ≠ (1, 0) ∧ ((0, 0) : Int × Int) ≠ (0, 1) ∧ ((1, 1) : Int × Int) + ≠ (1, 0) ∧ ((1, 1) : Int × Int) ≠ (0, 1) ∧ ((1, 0) : Int × Int) ≠ (0, 1)) → ((((0, 0) + : Int × Int) ≠ (-1, -1) ∧ ((0, 0) : Int × Int) ≠ (-1, 0) ∧ ((0, 0) : Int × Int) ≠ (0, + -1) ∧ ((-1, -1) : Int × Int) ≠ (-1, 0) ∧ ((-1, -1) : Int × Int) ≠ (0, -1) ∧ ((-1, 0) + : Int × Int) ≠ (0, -1)) → ((BandVectors.1 (q 0) (q 1) = placement.layout.u) → + ((BandVectors.1 (q 0) (q 2) = placement.layout.v) → ((BandVectors.1 (q 0) (q 3) = + -placement.layout.u - placement.layout.v) → ((∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (sgn : + GaussianInt), ∀ (s₁ : Bool), ∀ (s₂ : Bool), ∀ (g : + BandOrderedGeneralRightInterfaceCertificate norm), (g.startCompanion = + TileTranslation F (sgn * BandVectors.1 (q 0) (q i.succ))) → ((g.endCompanion = + TileTranslation F (sgn * BandVectors.1 (q 0) (q j.succ))) → ((g.startData.point ≠ + g.endData.point) → ((ExactTileInterfaceTriple F g.startCompanion (TileTranslation + (placement.layout.P i s₁) placement.rightNeighborDisplacement)) → + ((ExactTileInterfaceTriple F g.endCompanion (TileTranslation (placement.layout.P j + s₂) placement.rightNeighborDisplacement)) → ((FootprintVertices (TileTranslation + (placement.layout.P i s₁) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root) → ((FootprintVertices (TileTranslation (placement.layout.P j s₂) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root) → (rightGeometry i j + sgn s₁ s₂)))))))) → ((FootprintVertices (TileTranslation (placement.layout.P + placement.rightFirstSlot placement.firstBoundarySign) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root) → ((FootprintVertices + (TileTranslation (placement.layout.P placement.rightSecondSlot + placement.secondBoundarySign) placement.rightNeighborDisplacement) ⊆ + FootprintVertices root) → ((placement.rightFirstSlot = (0 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (1 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (2 : + Fin (3 : ℕ))) → ( + let q := bundle.normalizedPresentation + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + let selectedPath := ∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices (occurrence placement.exteriorIndex) ∩ + FootprintVertices (occurrence placement.centralIndex)) + (FootprintEdges (occurrence placement.exteriorIndex) ∩ + FootprintEdges (occurrence placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges (occurrence placement.exteriorIndex) ∩ + FootprintEdges (occurrence placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation bundle.normalizedFixed + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation bundle.normalizedFixed + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple bundle.normalizedFixed + firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple bundle.normalizedFixed + secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple bundle.normalizedRoot + bundle.normalizedFixed firstCompanion, + ∃ secondData : ExactTileInterfaceTriple bundle.normalizedRoot + bundle.normalizedFixed secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile bundle.normalizedRoot ∧ + LatticeTile bundle.normalizedFixed ∧ + LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ + Disjoint bundle.normalizedRoot.cells firstCompanion.cells ∧ + Disjoint bundle.normalizedFixed.cells firstCompanion.cells ∧ + Disjoint bundle.normalizedRoot.cells secondCompanion.cells ∧ + Disjoint bundle.normalizedFixed.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple bundle.normalizedRoot bundle.normalizedFixed + firstCompanion ∧ + TouchingTriple bundle.normalizedRoot bundle.normalizedFixed + secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ + selectedPath + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ + bundle.selectedSign = true ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + (-1) true false) ∨ + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = false ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + (-1) true false) ∨ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ + bundle.selectedSign = false ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + 1 false true) ∨ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = true ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + 1 false true))))))))))))) ) := by + classical + intro C D T N h k x bundle placement selectedEdge chosenBoundary q F root edgeVertex norm + childInterfaces turnOutgoing turnNeg boundaryRecords centeredExactTurn tripleTurnOutgoing + tripleTurnNegativeNext touchingPlus touchingMinus P u v selectedPath rightGeometry + canonicalFinish coordinateFactsApos coordinateFactsAneg period0 period1 period2 + packageGeometry firstBoundarySubset secondBoundarySubset hcycle + let exactMinus (ell : Fin 3) : ExactTileInterfaceTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (BandVectors.1 (q 0) (q (ell + 1).succ))) := by + let E := Classical.choice ((SelectedRowGeometry.thriceExactTurn C D T N h k x bundle + centeredExactTurn) + (BandVectors.1 (q ell.succ) (q 0)) + (-BandVectors.1 (q (ell + 1).succ) (q 0)) + (Classical.choice (childInterfaces.1 ell))) + simpa only [tripleTurnOutgoing, tripleTurnNegativeNext] using E + let exactPlus (ell : Fin 3) : ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ))) := by + let E := Classical.choice (centeredExactTurn + (BandVectors.1 (q ell.succ) (q 0)) + (-BandVectors.1 (q (ell + 1).succ) (q 0)) + (Classical.choice (childInterfaces.1 ell))) + simpa [turnOutgoing, turnNeg] using E + rcases hcycle with ⟨hi, hj, hk⟩ + have hcyc : + (placement.rightFirstSlot = 0 ∧ placement.rightSecondSlot = 1 ∧ + placement.rightDirectionSlot = 2) ∨ + (placement.rightFirstSlot = 1 ∧ placement.rightSecondSlot = 2 ∧ + placement.rightDirectionSlot = 0) ∨ + (placement.rightFirstSlot = 2 ∧ placement.rightSecondSlot = 0 ∧ + placement.rightDirectionSlot = 1) := Or.inl ⟨hi, hj, hk⟩ + have records := boundaryRecords hcyc + cases hpos : placement.rightNeighborPositive + · have hR : placement.rightNeighborDisplacement = + -BandVectors.1 (q 0) (q 3) := SelectedRowGeometry.hRAt1171 C D T N h k x bundle + placement hk hpos + rcases records.2 hpos with ⟨⟨R1⟩, ⟨R2⟩⟩ + have R1' : ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q 0) (q 1))) + (TileTranslation (placement.layout.P 0 false) + placement.rightNeighborDisplacement) := by + simpa [hi] using R1 + have R2' : ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q 0) (q 2))) + (TileTranslation (placement.layout.P 1 true) + placement.rightNeighborDisplacement) := by + simpa [hj] using R2 + have eStart : ExactTileInterfaceTriple F + (TileTranslation F placement.rightNeighborDisplacement) + (TileTranslation F ((1 : GaussianInt) * BandVectors.1 (q 0) (q 1))) := by + simpa [hR] using exactMinus 2 + have eEnd : ExactTileInterfaceTriple F + (TileTranslation F ((1 : GaussianInt) * BandVectors.1 (q 0) (q 2))) + (TileTranslation F placement.rightNeighborDisplacement) := by + simpa [hR] using exactPlus 1 + have tStart := SelectedRowGeometry.tStartAt1193 C D T N h k x bundle placement + touchingMinus hR + have tEnd := SelectedRowGeometry.tEndAt1197 C D T N h k x bundle placement touchingPlus hR + rcases canonicalFinish ((1 : GaussianInt) * BandVectors.1 (q 0) (q 1)) + ((1 : GaussianInt) * BandVectors.1 (q 0) (q 2)) 1 1 1 0 0 1 + (by rw [hR, period2]; ring) + (by rw [period0]; simp) (by rw [period1]; simp) + coordinateFactsApos.1 coordinateFactsApos.2.1 + coordinateFactsApos.2.2.1 coordinateFactsApos.2.2.2.1 + coordinateFactsApos.2.2.2.2.1 coordinateFactsApos.2.2.2.2.2 + eStart eEnd tStart tEnd with + ⟨g, hgs, hge, hneq⟩ + have hsigns := placement.boundary_signs + rcases hsigns with ⟨hp, hfirst, hsecond⟩ | ⟨hp, hfirst, hsecond⟩ + · rw [hpos] at hp + cases hp + · have geom := SelectedRowGeometry.geomAt1214 C D T N h k x bundle placement selectedEdge + edgeVertex hp packageGeometry firstBoundarySubset secondBoundarySubset hi hj R1 R2 g + hgs hge hneq hfirst hsecond + have hgeom := SelectedRowGeometry.hgeomAt1233 C D T N h k x bundle placement selectedEdge + hi hj geom + rcases chosenBoundary with ⟨hs, hsign⟩ | + ⟨hs, hsign⟩ + · have hselectedSign : bundle.selectedSign = false := by + exact hsign.trans hfirst + exact Or.inr (Or.inr (Or.inl ⟨rfl, hs, hselectedSign, hgeom⟩)) + · have hselectedSign : bundle.selectedSign = true := by + exact hsign.trans hsecond + exact Or.inr (Or.inr (Or.inr ⟨rfl, hs, hselectedSign, hgeom⟩)) + · have hR : placement.rightNeighborDisplacement = + BandVectors.1 (q 0) (q 3) := SelectedRowGeometry.hRAt1245 C D T N h k x bundle + placement hk hpos + rcases records.1 hpos with ⟨⟨R1⟩, ⟨R2⟩⟩ + have R1' : ExactTileInterfaceTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q 1))) + (TileTranslation (placement.layout.P 0 true) + placement.rightNeighborDisplacement) := by + simpa [hi] using R1 + have R2' : ExactTileInterfaceTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q 2))) + (TileTranslation (placement.layout.P 1 false) + placement.rightNeighborDisplacement) := by + simpa [hj] using R2 + have eStart : ExactTileInterfaceTriple F + (TileTranslation F placement.rightNeighborDisplacement) + (TileTranslation F ((-1 : GaussianInt) * BandVectors.1 (q 0) (q 1))) := by + simpa [hR] using exactPlus 2 + have eEnd : ExactTileInterfaceTriple F + (TileTranslation F ((-1 : GaussianInt) * BandVectors.1 (q 0) (q 2))) + (TileTranslation F placement.rightNeighborDisplacement) := by + simpa [hR] using exactMinus 1 + have tStart := SelectedRowGeometry.tStartAt1267 C D T N h k x bundle placement + touchingPlus hR + have tEnd := SelectedRowGeometry.tEndAt1271 C D T N h k x bundle placement touchingMinus hR + rcases canonicalFinish ((-1 : GaussianInt) * BandVectors.1 (q 0) (q 1)) + ((-1 : GaussianInt) * BandVectors.1 (q 0) (q 2)) (-1) (-1) (-1) 0 0 (-1) + (by rw [hR, period2]; ring) + (by rw [period0]; simp) (by rw [period1]; simp) + coordinateFactsAneg.1 coordinateFactsAneg.2.1 + coordinateFactsAneg.2.2.1 coordinateFactsAneg.2.2.2.1 + coordinateFactsAneg.2.2.2.2.1 coordinateFactsAneg.2.2.2.2.2 + eStart eEnd tStart tEnd with + ⟨g, hgs, hge, hneq⟩ + have hsigns := placement.boundary_signs + rcases hsigns with ⟨hp, hfirst, hsecond⟩ | ⟨hp, hfirst, hsecond⟩ + · have geom := SelectedRowGeometry.geomAt1286 C D T N h k x bundle placement selectedEdge + edgeVertex hp packageGeometry firstBoundarySubset secondBoundarySubset hi hj R1 R2 g + hgs hge hneq hfirst hsecond + have hgeom := SelectedRowGeometry.hgeomAt1305 C D T N h k x bundle placement selectedEdge + hi hj geom + rcases chosenBoundary with ⟨hs, hsign⟩ | + ⟨hs, hsign⟩ + · have hselectedSign : bundle.selectedSign = true := by + exact hsign.trans hfirst + exact Or.inl ⟨rfl, hs, hselectedSign, hgeom⟩ + · have hselectedSign : bundle.selectedSign = false := by + exact hsign.trans hsecond + exact Or.inr (Or.inl ⟨rfl, hs, hselectedSign, hgeom⟩) + · rw [hpos] at hp + cases hp + +private theorem secondCyclicCase : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), ∀ (chosenBoundary : + bundle.selectedSlot = placement.rightFirstSlot ∧ bundle.selectedSign = + placement.firstBoundarySign ∨ bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = placement.secondBoundarySign), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + ∀ (edgeVertex : ∀ (tile : ProtoTile), (tile.cells.Nonempty) → (∀ (edge : Finset + GaussianInt), (edge ∈ FootprintEdges tile) → (∀ (point : GaussianInt), (point ∈ edge) + → (point ∈ FootprintVertices tile)))), + let norm := SelectedRowNormalization.certificate C D T N h k x bundle placement + ∀ (childInterfaces : (∀ (i : Fin (3 : ℕ)), Nonempty (ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation + F (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ))))))) ∧ (∀ (i + : Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile (q i.succ) U → TileCentroid U - + TileCentroid F = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) + → Nonempty (ExactTileInterfaceTriple F (TileTranslation F (BandVectors.1 (q i.succ) + (q (0 : Fin (4 : ℕ))))) U)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), BandPrototile (q i.succ) U → BandPrototile (q (i + (1 : Fin (3 : + ℕ))).succ) V → TileCentroid U - TileCentroid F = (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 + (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V - TileCentroid F = (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : + ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + (1 : Fin (3 : + ℕ))).succ))) → Nonempty (ExactTileInterfaceTriple F U V)) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (s + : Fin (4 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → + BandPrototile (q (if Even (↑s : ℕ) then i + (1 : Fin (3 : ℕ)) else i - (1 : Fin (3 : + ℕ))).succ) V → TileCentroid U - TileCentroid F = (1 / 2 : ℝ) • GaussianRealPoint + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V - + TileCentroid F = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q + (0 : Fin (4 : ℕ))) - BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + (1 : Fin (3 : + ℕ))).succ) else BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i - (1 : Fin (3 : ℕ))).succ) + - BandVectors.1 (q (i - (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) → + let uR := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) else BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))); + let uL := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then + BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) else BandVectors.1 (q (0 : Fin (4 : + ℕ))) (q i.succ); ∃ (rightData : ExactTileInterfaceTriple F (TileTranslation F uR) U) + (incomingData : ExactTileInterfaceTriple F (TileTranslation F uL) U) (t5Data : + ExactTileInterfaceTriple F U V), rightData.point = t5Data.point ∧ incomingData.point + ≠ t5Data.point ∧ incomingData.otherCA = t5Data.point ∧ rightData.otherCA = + incomingData.point ∧ t5Data.otherAB = incomingData.point), ∀ (turnOutgoing : ∀ (s : + Fin 3), GaussianQuarterTurn (BandVectors.1 (q s.succ) (q 0)) = BandVectors.1 (q 0) (q + s.succ)), ∀ (turnNeg : ∀ (z : GaussianInt), GaussianQuarterTurn (-z) = + -GaussianQuarterTurn z), ∀ (boundaryRecords : placement.rightFirstSlot = (0 : Fin (3 + : ℕ)) ∧ placement.rightSecondSlot = (1 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot + = (2 : Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (1 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (2 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (0 : + Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (2 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (0 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (1 : + Fin (3 : ℕ)) → (placement.rightNeighborPositive = true → Nonempty + (ExactTileInterfaceTriple bundle.normalizedFixed (TileTranslation + bundle.normalizedFixed (-BandVectors.1 (bundle.normalizedPresentation (0 : Fin (4 : + ℕ))) (bundle.normalizedPresentation placement.rightFirstSlot.succ))) (TileTranslation + (placement.layout.P placement.rightFirstSlot true) + placement.rightNeighborDisplacement)) ∧ Nonempty (ExactTileInterfaceTriple + bundle.normalizedFixed (TileTranslation bundle.normalizedFixed (-BandVectors.1 + (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (bundle.normalizedPresentation + placement.rightSecondSlot.succ))) (TileTranslation (placement.layout.P + placement.rightSecondSlot false) placement.rightNeighborDisplacement))) ∧ + (placement.rightNeighborPositive = false → Nonempty (ExactTileInterfaceTriple + bundle.normalizedFixed (TileTranslation bundle.normalizedFixed (BandVectors.1 + (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (bundle.normalizedPresentation + placement.rightFirstSlot.succ))) (TileTranslation (placement.layout.P + placement.rightFirstSlot false) placement.rightNeighborDisplacement)) ∧ Nonempty + (ExactTileInterfaceTriple bundle.normalizedFixed (TileTranslation + bundle.normalizedFixed (BandVectors.1 (bundle.normalizedPresentation (0 : Fin (4 : + ℕ))) (bundle.normalizedPresentation placement.rightSecondSlot.succ))) + (TileTranslation (placement.layout.P placement.rightSecondSlot true) + placement.rightNeighborDisplacement)))), ∀ (centeredExactTurn : ∀ (a : GaussianInt), + ∀ (b : GaussianInt), (ExactTileInterfaceTriple F (TileTranslation F a) + (TileTranslation F b)) → (Nonempty (ExactTileInterfaceTriple F (TileTranslation F + (GaussianQuarterTurn a)) (TileTranslation F (GaussianQuarterTurn b))))), ∀ + (tripleTurnOutgoing : ∀ (ell : Fin 3), GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn (BandVectors.1 (q ell.succ) (q 0)))) = -BandVectors.1 (q 0) (q + ell.succ)), ∀ (tripleTurnNegativeNext : ∀ (ell : Fin 3), GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn (-BandVectors.1 (q (ell + 1).succ) (q 0)))) + = BandVectors.1 (q 0) (q (ell + 1).succ)), + (∀ (ell : Fin 3), TouchingTriple F (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ)))) → ((∀ (ell : Fin 3), + TouchingTriple F (TileTranslation F (-BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (BandVectors.1 (q 0) (q (ell + 1).succ)))) → ( + let P := placement.layout.P + let u := placement.layout.u + let v := placement.layout.v + let selectedPath : Prop := + (∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + (FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge) + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, + ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ + Disjoint F.cells firstCompanion.cells ∧ + Disjoint root.cells secondCompanion.cells ∧ + Disjoint F.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple root F firstCompanion ∧ + TouchingTriple root F secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ selectedPath + (∀ (uStart : GaussianInt), ∀ (uEnd : GaussianInt), ∀ (mR : Int), ∀ (nR : Int), ∀ (mS : + Int), ∀ (nS : Int), ∀ (mE : Int), ∀ (nE : Int), (placement.rightNeighborDisplacement + = (mR : GaussianInt) * placement.layout.u + (nR : GaussianInt) * placement.layout.v) + → ((uStart = (mS : GaussianInt) * placement.layout.u + (nS : GaussianInt) * + placement.layout.v) → ((uEnd = (mE : GaussianInt) * placement.layout.u + (nE : + GaussianInt) * placement.layout.v) → (((0, 0) ≠ (mR, nR)) → (((0, 0) ≠ (mS, nS)) → + (((0, 0) ≠ (mE, nE)) → (((mR, nR) ≠ (mS, nS)) → (((mR, nR) ≠ (mE, nE)) → (((mS, nS) ≠ + (mE, nE)) → ((ExactTileInterfaceTriple F (TileTranslation F + placement.rightNeighborDisplacement) (TileTranslation F uStart)) → + ((ExactTileInterfaceTriple F (TileTranslation F uEnd) (TileTranslation F + placement.rightNeighborDisplacement)) → ((TouchingTriple F (TileTranslation F + placement.rightNeighborDisplacement) (TileTranslation F uStart)) → ((TouchingTriple F + (TileTranslation F uEnd) (TileTranslation F placement.rightNeighborDisplacement)) → + (∃ g : BandOrderedGeneralRightInterfaceCertificate norm, g.startCompanion = + TileTranslation F uStart ∧ g.endCompanion = TileTranslation F uEnd ∧ + g.startData.point ≠ g.endData.point)))))))))))))) → ((((0, 0) : Int × Int) ≠ (-1, 0) + ∧ ((0, 0) : Int × Int) ≠ (0, 1) ∧ ((0, 0) : Int × Int) ≠ (-1, -1) ∧ ((-1, 0) : Int × + Int) ≠ (0, 1) ∧ ((-1, 0) : Int × Int) ≠ (-1, -1) ∧ ((0, 1) : Int × Int) ≠ (-1, -1)) → + ((((0, 0) : Int × Int) ≠ (1, 0) ∧ ((0, 0) : Int × Int) ≠ (0, -1) ∧ ((0, 0) : Int × + Int) ≠ (1, 1) ∧ ((1, 0) : Int × Int) ≠ (0, -1) ∧ ((1, 0) : Int × Int) ≠ (1, 1) ∧ ((0, + -1) : Int × Int) ≠ (1, 1)) → ((BandVectors.1 (q 0) (q 1) = placement.layout.u) → + ((BandVectors.1 (q 0) (q 2) = placement.layout.v) → ((BandVectors.1 (q 0) (q 3) = + -placement.layout.u - placement.layout.v) → ((∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (sgn : + GaussianInt), ∀ (s₁ : Bool), ∀ (s₂ : Bool), ∀ (g : + BandOrderedGeneralRightInterfaceCertificate norm), (g.startCompanion = + TileTranslation F (sgn * BandVectors.1 (q 0) (q i.succ))) → ((g.endCompanion = + TileTranslation F (sgn * BandVectors.1 (q 0) (q j.succ))) → ((g.startData.point ≠ + g.endData.point) → ((ExactTileInterfaceTriple F g.startCompanion (TileTranslation + (placement.layout.P i s₁) placement.rightNeighborDisplacement)) → + ((ExactTileInterfaceTriple F g.endCompanion (TileTranslation (placement.layout.P j + s₂) placement.rightNeighborDisplacement)) → ((FootprintVertices (TileTranslation + (placement.layout.P i s₁) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root) → ((FootprintVertices (TileTranslation (placement.layout.P j s₂) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root) → (rightGeometry i j + sgn s₁ s₂)))))))) → ((FootprintVertices (TileTranslation (placement.layout.P + placement.rightFirstSlot placement.firstBoundarySign) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root) → ((FootprintVertices + (TileTranslation (placement.layout.P placement.rightSecondSlot + placement.secondBoundarySign) placement.rightNeighborDisplacement) ⊆ + FootprintVertices root) → ((placement.rightFirstSlot = (1 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (2 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (0 : + Fin (3 : ℕ))) → ( + let q := bundle.normalizedPresentation + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + let selectedPath := ∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices (occurrence placement.exteriorIndex) ∩ + FootprintVertices (occurrence placement.centralIndex)) + (FootprintEdges (occurrence placement.exteriorIndex) ∩ + FootprintEdges (occurrence placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges (occurrence placement.exteriorIndex) ∩ + FootprintEdges (occurrence placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation bundle.normalizedFixed + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation bundle.normalizedFixed + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple bundle.normalizedFixed + firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple bundle.normalizedFixed + secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple bundle.normalizedRoot + bundle.normalizedFixed firstCompanion, + ∃ secondData : ExactTileInterfaceTriple bundle.normalizedRoot + bundle.normalizedFixed secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile bundle.normalizedRoot ∧ + LatticeTile bundle.normalizedFixed ∧ + LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ + Disjoint bundle.normalizedRoot.cells firstCompanion.cells ∧ + Disjoint bundle.normalizedFixed.cells firstCompanion.cells ∧ + Disjoint bundle.normalizedRoot.cells secondCompanion.cells ∧ + Disjoint bundle.normalizedFixed.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple bundle.normalizedRoot bundle.normalizedFixed + firstCompanion ∧ + TouchingTriple bundle.normalizedRoot bundle.normalizedFixed + secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ + selectedPath + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ + bundle.selectedSign = true ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + (-1) true false) ∨ + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = false ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + (-1) true false) ∨ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ + bundle.selectedSign = false ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + 1 false true) ∨ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = true ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + 1 false true))))))))))))) ) := by + classical + intro C D T N h k x bundle placement selectedEdge chosenBoundary q F root edgeVertex norm + childInterfaces turnOutgoing turnNeg boundaryRecords centeredExactTurn tripleTurnOutgoing + tripleTurnNegativeNext touchingPlus touchingMinus P u v selectedPath rightGeometry + canonicalFinish coordinateFactsBpos coordinateFactsBneg period0 period1 period2 + packageGeometry firstBoundarySubset secondBoundarySubset hcycle + let exactMinus (ell : Fin 3) : ExactTileInterfaceTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (BandVectors.1 (q 0) (q (ell + 1).succ))) := by + let E := Classical.choice ((SelectedRowGeometry.thriceExactTurn C D T N h k x bundle + centeredExactTurn) + (BandVectors.1 (q ell.succ) (q 0)) + (-BandVectors.1 (q (ell + 1).succ) (q 0)) + (Classical.choice (childInterfaces.1 ell))) + simpa only [tripleTurnOutgoing, tripleTurnNegativeNext] using E + let exactPlus (ell : Fin 3) : ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ))) := by + let E := Classical.choice (centeredExactTurn + (BandVectors.1 (q ell.succ) (q 0)) + (-BandVectors.1 (q (ell + 1).succ) (q 0)) + (Classical.choice (childInterfaces.1 ell))) + simpa [turnOutgoing, turnNeg] using E + rcases hcycle with ⟨hi, hj, hk⟩ + have hcyc : + (placement.rightFirstSlot = 0 ∧ placement.rightSecondSlot = 1 ∧ + placement.rightDirectionSlot = 2) ∨ + (placement.rightFirstSlot = 1 ∧ placement.rightSecondSlot = 2 ∧ + placement.rightDirectionSlot = 0) ∨ + (placement.rightFirstSlot = 2 ∧ placement.rightSecondSlot = 0 ∧ + placement.rightDirectionSlot = 1) := Or.inr (Or.inl ⟨hi, hj, hk⟩) + have records := boundaryRecords hcyc + cases hpos : placement.rightNeighborPositive + · have hR : placement.rightNeighborDisplacement = + -BandVectors.1 (q 0) (q 1) := SelectedRowGeometry.hRAt1329 C D T N h k x bundle + placement hk hpos + rcases records.2 hpos with ⟨⟨R1⟩, ⟨R2⟩⟩ + have eStart : ExactTileInterfaceTriple F + (TileTranslation F placement.rightNeighborDisplacement) + (TileTranslation F ((1 : GaussianInt) * BandVectors.1 (q 0) (q 2))) := by + simpa [hR] using exactMinus 0 + have eEnd : ExactTileInterfaceTriple F + (TileTranslation F ((1 : GaussianInt) * BandVectors.1 (q 0) (q 3))) + (TileTranslation F placement.rightNeighborDisplacement) := by + simpa [hR] using exactPlus 2 + have tStart := SelectedRowGeometry.tStartAt1341 C D T N h k x bundle placement + touchingMinus hR + have tEnd := SelectedRowGeometry.tEndAt1345 C D T N h k x bundle placement touchingPlus hR + rcases canonicalFinish ((1 : GaussianInt) * BandVectors.1 (q 0) (q 2)) + ((1 : GaussianInt) * BandVectors.1 (q 0) (q 3)) (-1) 0 0 1 (-1) (-1) + (by rw [hR, period0]; simp) + (by rw [period1]; simp) (by rw [period2]; ring) + coordinateFactsBpos.1 coordinateFactsBpos.2.1 + coordinateFactsBpos.2.2.1 coordinateFactsBpos.2.2.2.1 + coordinateFactsBpos.2.2.2.2.1 coordinateFactsBpos.2.2.2.2.2 + eStart eEnd tStart tEnd with + ⟨g, hgs, hge, hneq⟩ + rcases placement.boundary_signs with ⟨hp, _, _⟩ | ⟨hp, hfirst, hsecond⟩ + · rw [hpos] at hp + cases hp + · have R1g : ExactTileInterfaceTriple F g.startCompanion + (TileTranslation (placement.layout.P 1 false) + placement.rightNeighborDisplacement) := by + simpa [hgs, hi] using R1 + have R2g : ExactTileInterfaceTriple F g.endCompanion + (TileTranslation (placement.layout.P 2 true) + placement.rightNeighborDisplacement) := by + simpa [hge, hj] using R2 + have hW := SelectedRowGeometry.hWAt1369 C D T N h k x bundle placement + firstBoundarySubset hi hfirst + have hX := SelectedRowGeometry.hXAt1373 C D T N h k x bundle placement + secondBoundarySubset hj hsecond + have geom := packageGeometry 1 2 1 false true g hgs hge hneq R1g R2g hW hX + have hgeom := SelectedRowGeometry.hgeomAt1378 C D T N h k x bundle placement selectedEdge + hi hj geom + rcases chosenBoundary with ⟨hs, hsign⟩ | + ⟨hs, hsign⟩ + · have hs' : bundle.selectedSign = false := by + exact hsign.trans hfirst + exact Or.inr (Or.inr (Or.inl ⟨rfl, hs, hs', hgeom⟩)) + · have hs' : bundle.selectedSign = true := by + exact hsign.trans hsecond + exact Or.inr (Or.inr (Or.inr ⟨rfl, hs, hs', hgeom⟩)) + · have hR : placement.rightNeighborDisplacement = + BandVectors.1 (q 0) (q 1) := SelectedRowGeometry.hRAt1390 C D T N h k x bundle + placement hk hpos + rcases records.1 hpos with ⟨⟨R1⟩, ⟨R2⟩⟩ + have eStart : ExactTileInterfaceTriple F + (TileTranslation F placement.rightNeighborDisplacement) + (TileTranslation F ((-1 : GaussianInt) * BandVectors.1 (q 0) (q 2))) := by + simpa [hR] using exactPlus 0 + have eEnd : ExactTileInterfaceTriple F + (TileTranslation F ((-1 : GaussianInt) * BandVectors.1 (q 0) (q 3))) + (TileTranslation F placement.rightNeighborDisplacement) := by + simpa [hR] using exactMinus 2 + have tStart := SelectedRowGeometry.tStartAt1402 C D T N h k x bundle placement + touchingPlus hR + have tEnd := SelectedRowGeometry.tEndAt1406 C D T N h k x bundle placement touchingMinus hR + have finishResult := canonicalFinish ((-1 : GaussianInt) * BandVectors.1 (q 0) (q 2)) + ((-1 : GaussianInt) * BandVectors.1 (q 0) (q 3)) 1 0 0 (-1) 1 1 + (by simp [hR, period0]) + (by rw [period1]; simp) (by rw [period2]; ring) + coordinateFactsBneg.1 coordinateFactsBneg.2.1 + coordinateFactsBneg.2.2.1 coordinateFactsBneg.2.2.2.1 + coordinateFactsBneg.2.2.2.2.1 coordinateFactsBneg.2.2.2.2.2 + eStart eEnd tStart tEnd + rcases finishResult with ⟨g, hgs, hge, hneq⟩ + rcases placement.boundary_signs with ⟨hp, hfirst, hsecond⟩ | ⟨hp, _, _⟩ + · have R1g : ExactTileInterfaceTriple F g.startCompanion + (TileTranslation (placement.layout.P 1 true) + placement.rightNeighborDisplacement) := by + simpa [hgs, hi] using R1 + have R2g : ExactTileInterfaceTriple F g.endCompanion + (TileTranslation (placement.layout.P 2 false) + placement.rightNeighborDisplacement) := by + simpa [hge, hj] using R2 + have hW := SelectedRowGeometry.hWAt1428 C D T N h k x bundle placement + firstBoundarySubset hi hfirst + have hX := SelectedRowGeometry.hXAt1432 C D T N h k x bundle placement + secondBoundarySubset hj hsecond + have geom := packageGeometry 1 2 (-1) true false g hgs hge hneq R1g R2g hW hX + have hgeom := SelectedRowGeometry.hgeomAt1437 C D T N h k x bundle placement selectedEdge + hi hj geom + rcases chosenBoundary with ⟨hs, hsign⟩ | + ⟨hs, hsign⟩ + · have hs' : bundle.selectedSign = true := by + exact hsign.trans hfirst + exact Or.inl ⟨rfl, hs, hs', hgeom⟩ + · have hs' : bundle.selectedSign = false := by + exact hsign.trans hsecond + exact Or.inr (Or.inl ⟨rfl, hs, hs', hgeom⟩) + · rw [hpos] at hp + cases hp + +private theorem thirdCyclicCase : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), ∀ (chosenBoundary : + bundle.selectedSlot = placement.rightFirstSlot ∧ bundle.selectedSign = + placement.firstBoundarySign ∨ bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = placement.secondBoundarySign), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + ∀ (edgeVertex : ∀ (tile : ProtoTile), (tile.cells.Nonempty) → (∀ (edge : Finset + GaussianInt), (edge ∈ FootprintEdges tile) → (∀ (point : GaussianInt), (point ∈ edge) + → (point ∈ FootprintVertices tile)))), + let norm := SelectedRowNormalization.certificate C D T N h k x bundle placement + ∀ (childInterfaces : (∀ (i : Fin (3 : ℕ)), Nonempty (ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation + F (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ))))))) ∧ (∀ (i + : Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile (q i.succ) U → TileCentroid U - + TileCentroid F = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) + → Nonempty (ExactTileInterfaceTriple F (TileTranslation F (BandVectors.1 (q i.succ) + (q (0 : Fin (4 : ℕ))))) U)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), BandPrototile (q i.succ) U → BandPrototile (q (i + (1 : Fin (3 : + ℕ))).succ) V → TileCentroid U - TileCentroid F = (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 + (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V - TileCentroid F = (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : + ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + (1 : Fin (3 : + ℕ))).succ))) → Nonempty (ExactTileInterfaceTriple F U V)) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (s + : Fin (4 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → + BandPrototile (q (if Even (↑s : ℕ) then i + (1 : Fin (3 : ℕ)) else i - (1 : Fin (3 : + ℕ))).succ) V → TileCentroid U - TileCentroid F = (1 / 2 : ℝ) • GaussianRealPoint + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V - + TileCentroid F = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q + (0 : Fin (4 : ℕ))) - BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + (1 : Fin (3 : + ℕ))).succ) else BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i - (1 : Fin (3 : ℕ))).succ) + - BandVectors.1 (q (i - (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) → + let uR := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) else BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))); + let uL := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then + BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) else BandVectors.1 (q (0 : Fin (4 : + ℕ))) (q i.succ); ∃ (rightData : ExactTileInterfaceTriple F (TileTranslation F uR) U) + (incomingData : ExactTileInterfaceTriple F (TileTranslation F uL) U) (t5Data : + ExactTileInterfaceTriple F U V), rightData.point = t5Data.point ∧ incomingData.point + ≠ t5Data.point ∧ incomingData.otherCA = t5Data.point ∧ rightData.otherCA = + incomingData.point ∧ t5Data.otherAB = incomingData.point), ∀ (turnOutgoing : ∀ (s : + Fin 3), GaussianQuarterTurn (BandVectors.1 (q s.succ) (q 0)) = BandVectors.1 (q 0) (q + s.succ)), ∀ (turnNeg : ∀ (z : GaussianInt), GaussianQuarterTurn (-z) = + -GaussianQuarterTurn z), ∀ (boundaryRecords : placement.rightFirstSlot = (0 : Fin (3 + : ℕ)) ∧ placement.rightSecondSlot = (1 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot + = (2 : Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (1 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (2 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (0 : + Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (2 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (0 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (1 : + Fin (3 : ℕ)) → (placement.rightNeighborPositive = true → Nonempty + (ExactTileInterfaceTriple bundle.normalizedFixed (TileTranslation + bundle.normalizedFixed (-BandVectors.1 (bundle.normalizedPresentation (0 : Fin (4 : + ℕ))) (bundle.normalizedPresentation placement.rightFirstSlot.succ))) (TileTranslation + (placement.layout.P placement.rightFirstSlot true) + placement.rightNeighborDisplacement)) ∧ Nonempty (ExactTileInterfaceTriple + bundle.normalizedFixed (TileTranslation bundle.normalizedFixed (-BandVectors.1 + (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (bundle.normalizedPresentation + placement.rightSecondSlot.succ))) (TileTranslation (placement.layout.P + placement.rightSecondSlot false) placement.rightNeighborDisplacement))) ∧ + (placement.rightNeighborPositive = false → Nonempty (ExactTileInterfaceTriple + bundle.normalizedFixed (TileTranslation bundle.normalizedFixed (BandVectors.1 + (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (bundle.normalizedPresentation + placement.rightFirstSlot.succ))) (TileTranslation (placement.layout.P + placement.rightFirstSlot false) placement.rightNeighborDisplacement)) ∧ Nonempty + (ExactTileInterfaceTriple bundle.normalizedFixed (TileTranslation + bundle.normalizedFixed (BandVectors.1 (bundle.normalizedPresentation (0 : Fin (4 : + ℕ))) (bundle.normalizedPresentation placement.rightSecondSlot.succ))) + (TileTranslation (placement.layout.P placement.rightSecondSlot true) + placement.rightNeighborDisplacement)))), ∀ (centeredExactTurn : ∀ (a : GaussianInt), + ∀ (b : GaussianInt), (ExactTileInterfaceTriple F (TileTranslation F a) + (TileTranslation F b)) → (Nonempty (ExactTileInterfaceTriple F (TileTranslation F + (GaussianQuarterTurn a)) (TileTranslation F (GaussianQuarterTurn b))))), ∀ + (tripleTurnOutgoing : ∀ (ell : Fin 3), GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn (BandVectors.1 (q ell.succ) (q 0)))) = -BandVectors.1 (q 0) (q + ell.succ)), ∀ (tripleTurnNegativeNext : ∀ (ell : Fin 3), GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn (-BandVectors.1 (q (ell + 1).succ) (q 0)))) + = BandVectors.1 (q 0) (q (ell + 1).succ)), + (∀ (ell : Fin 3), TouchingTriple F (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ)))) → ((∀ (ell : Fin 3), + TouchingTriple F (TileTranslation F (-BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (BandVectors.1 (q 0) (q (ell + 1).succ)))) → ( + let P := placement.layout.P + let u := placement.layout.u + let v := placement.layout.v + let selectedPath : Prop := + (∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + (FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge) + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, + ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ + Disjoint F.cells firstCompanion.cells ∧ + Disjoint root.cells secondCompanion.cells ∧ + Disjoint F.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple root F firstCompanion ∧ + TouchingTriple root F secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ selectedPath + (∀ (uStart : GaussianInt), ∀ (uEnd : GaussianInt), ∀ (mR : Int), ∀ (nR : Int), ∀ (mS : + Int), ∀ (nS : Int), ∀ (mE : Int), ∀ (nE : Int), (placement.rightNeighborDisplacement + = (mR : GaussianInt) * placement.layout.u + (nR : GaussianInt) * placement.layout.v) + → ((uStart = (mS : GaussianInt) * placement.layout.u + (nS : GaussianInt) * + placement.layout.v) → ((uEnd = (mE : GaussianInt) * placement.layout.u + (nE : + GaussianInt) * placement.layout.v) → (((0, 0) ≠ (mR, nR)) → (((0, 0) ≠ (mS, nS)) → + (((0, 0) ≠ (mE, nE)) → (((mR, nR) ≠ (mS, nS)) → (((mR, nR) ≠ (mE, nE)) → (((mS, nS) ≠ + (mE, nE)) → ((ExactTileInterfaceTriple F (TileTranslation F + placement.rightNeighborDisplacement) (TileTranslation F uStart)) → + ((ExactTileInterfaceTriple F (TileTranslation F uEnd) (TileTranslation F + placement.rightNeighborDisplacement)) → ((TouchingTriple F (TileTranslation F + placement.rightNeighborDisplacement) (TileTranslation F uStart)) → ((TouchingTriple F + (TileTranslation F uEnd) (TileTranslation F placement.rightNeighborDisplacement)) → + (∃ g : BandOrderedGeneralRightInterfaceCertificate norm, g.startCompanion = + TileTranslation F uStart ∧ g.endCompanion = TileTranslation F uEnd ∧ + g.startData.point ≠ g.endData.point)))))))))))))) → ((((0, 0) : Int × Int) ≠ (0, -1) + ∧ ((0, 0) : Int × Int) ≠ (-1, -1) ∧ ((0, 0) : Int × Int) ≠ (1, 0) ∧ ((0, -1) : Int × + Int) ≠ (-1, -1) ∧ ((0, -1) : Int × Int) ≠ (1, 0) ∧ ((-1, -1) : Int × Int) ≠ (1, 0)) → + ((((0, 0) : Int × Int) ≠ (0, 1) ∧ ((0, 0) : Int × Int) ≠ (1, 1) ∧ ((0, 0) : Int × + Int) ≠ (-1, 0) ∧ ((0, 1) : Int × Int) ≠ (1, 1) ∧ ((0, 1) : Int × Int) ≠ (-1, 0) ∧ + ((1, 1) : Int × Int) ≠ (-1, 0)) → ((BandVectors.1 (q 0) (q 1) = placement.layout.u) → + ((BandVectors.1 (q 0) (q 2) = placement.layout.v) → ((BandVectors.1 (q 0) (q 3) = + -placement.layout.u - placement.layout.v) → ((∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (sgn : + GaussianInt), ∀ (s₁ : Bool), ∀ (s₂ : Bool), ∀ (g : + BandOrderedGeneralRightInterfaceCertificate norm), (g.startCompanion = + TileTranslation F (sgn * BandVectors.1 (q 0) (q i.succ))) → ((g.endCompanion = + TileTranslation F (sgn * BandVectors.1 (q 0) (q j.succ))) → ((g.startData.point ≠ + g.endData.point) → ((ExactTileInterfaceTriple F g.startCompanion (TileTranslation + (placement.layout.P i s₁) placement.rightNeighborDisplacement)) → + ((ExactTileInterfaceTriple F g.endCompanion (TileTranslation (placement.layout.P j + s₂) placement.rightNeighborDisplacement)) → ((FootprintVertices (TileTranslation + (placement.layout.P i s₁) placement.rightNeighborDisplacement) ⊆ FootprintVertices + root) → ((FootprintVertices (TileTranslation (placement.layout.P j s₂) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root) → (rightGeometry i j + sgn s₁ s₂)))))))) → ((FootprintVertices (TileTranslation (placement.layout.P + placement.rightFirstSlot placement.firstBoundarySign) + placement.rightNeighborDisplacement) ⊆ FootprintVertices root) → ((FootprintVertices + (TileTranslation (placement.layout.P placement.rightSecondSlot + placement.secondBoundarySign) placement.rightNeighborDisplacement) ⊆ + FootprintVertices root) → ((placement.rightFirstSlot = (2 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (0 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (1 : + Fin (3 : ℕ))) → ( + let q := bundle.normalizedPresentation + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + let selectedPath := ∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices (occurrence placement.exteriorIndex) ∩ + FootprintVertices (occurrence placement.centralIndex)) + (FootprintEdges (occurrence placement.exteriorIndex) ∩ + FootprintEdges (occurrence placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges (occurrence placement.exteriorIndex) ∩ + FootprintEdges (occurrence placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation bundle.normalizedFixed + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation bundle.normalizedFixed + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple bundle.normalizedFixed + firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple bundle.normalizedFixed + secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple bundle.normalizedRoot + bundle.normalizedFixed firstCompanion, + ∃ secondData : ExactTileInterfaceTriple bundle.normalizedRoot + bundle.normalizedFixed secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile bundle.normalizedRoot ∧ + LatticeTile bundle.normalizedFixed ∧ + LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ + Disjoint bundle.normalizedRoot.cells firstCompanion.cells ∧ + Disjoint bundle.normalizedFixed.cells firstCompanion.cells ∧ + Disjoint bundle.normalizedRoot.cells secondCompanion.cells ∧ + Disjoint bundle.normalizedFixed.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple bundle.normalizedRoot bundle.normalizedFixed + firstCompanion ∧ + TouchingTriple bundle.normalizedRoot bundle.normalizedFixed + secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ + selectedPath + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ + bundle.selectedSign = true ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + (-1) true false) ∨ + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = false ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + (-1) true false) ∨ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ + bundle.selectedSign = false ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + 1 false true) ∨ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = true ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + 1 false true))))))))))))) ) := by + classical + intro C D T N h k x bundle placement selectedEdge chosenBoundary q F root edgeVertex norm + childInterfaces turnOutgoing turnNeg boundaryRecords centeredExactTurn tripleTurnOutgoing + tripleTurnNegativeNext touchingPlus touchingMinus P u v selectedPath rightGeometry + canonicalFinish coordinateFactsCpos coordinateFactsCneg period0 period1 period2 + packageGeometry firstBoundarySubset secondBoundarySubset hcycle + let exactMinus (ell : Fin 3) : ExactTileInterfaceTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (BandVectors.1 (q 0) (q (ell + 1).succ))) := by + let E := Classical.choice ((SelectedRowGeometry.thriceExactTurn C D T N h k x bundle + centeredExactTurn) + (BandVectors.1 (q ell.succ) (q 0)) + (-BandVectors.1 (q (ell + 1).succ) (q 0)) + (Classical.choice (childInterfaces.1 ell))) + simpa only [tripleTurnOutgoing, tripleTurnNegativeNext] using E + let exactPlus (ell : Fin 3) : ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ))) := by + let E := Classical.choice (centeredExactTurn + (BandVectors.1 (q ell.succ) (q 0)) + (-BandVectors.1 (q (ell + 1).succ) (q 0)) + (Classical.choice (childInterfaces.1 ell))) + simpa [turnOutgoing, turnNeg] using E + rcases hcycle with ⟨hi, hj, hk⟩ + have hcyc : + (placement.rightFirstSlot = 0 ∧ placement.rightSecondSlot = 1 ∧ + placement.rightDirectionSlot = 2) ∨ + (placement.rightFirstSlot = 1 ∧ placement.rightSecondSlot = 2 ∧ + placement.rightDirectionSlot = 0) ∨ + (placement.rightFirstSlot = 2 ∧ placement.rightSecondSlot = 0 ∧ + placement.rightDirectionSlot = 1) := Or.inr (Or.inr ⟨hi, hj, hk⟩) + have records := boundaryRecords hcyc + cases hpos : placement.rightNeighborPositive + · have hR : placement.rightNeighborDisplacement = + -BandVectors.1 (q 0) (q 2) := SelectedRowGeometry.hRAt1461 C D T N h k x bundle + placement hk hpos + rcases records.2 hpos with ⟨⟨R1⟩, ⟨R2⟩⟩ + have eStart : ExactTileInterfaceTriple F + (TileTranslation F placement.rightNeighborDisplacement) + (TileTranslation F ((1 : GaussianInt) * BandVectors.1 (q 0) (q 3))) := by + simpa [hR] using exactMinus 1 + have eEnd : ExactTileInterfaceTriple F + (TileTranslation F ((1 : GaussianInt) * BandVectors.1 (q 0) (q 1))) + (TileTranslation F placement.rightNeighborDisplacement) := by + simpa [hR] using exactPlus 0 + have tStart := SelectedRowGeometry.tStartAt1473 C D T N h k x bundle placement + touchingMinus hR + have tEnd := SelectedRowGeometry.tEndAt1477 C D T N h k x bundle placement touchingPlus hR + rcases canonicalFinish ((1 : GaussianInt) * BandVectors.1 (q 0) (q 3)) + ((1 : GaussianInt) * BandVectors.1 (q 0) (q 1)) 0 (-1) (-1) (-1) 1 0 + (by rw [hR, period1]; simp) + (by rw [period2]; ring) (by rw [period0]; simp) + coordinateFactsCpos.1 coordinateFactsCpos.2.1 + coordinateFactsCpos.2.2.1 coordinateFactsCpos.2.2.2.1 + coordinateFactsCpos.2.2.2.2.1 coordinateFactsCpos.2.2.2.2.2 + eStart eEnd tStart tEnd with + ⟨g, hgs, hge, hneq⟩ + rcases placement.boundary_signs with ⟨hp, _, _⟩ | ⟨hp, hfirst, hsecond⟩ + · rw [hpos] at hp + cases hp + · have R1g : ExactTileInterfaceTriple F g.startCompanion + (TileTranslation (placement.layout.P 2 false) + placement.rightNeighborDisplacement) := by + simpa [hgs, hi] using R1 + have R2g : ExactTileInterfaceTriple F g.endCompanion + (TileTranslation (placement.layout.P 0 true) + placement.rightNeighborDisplacement) := by + simpa [hge, hj] using R2 + have hW := SelectedRowGeometry.hWAt1501 C D T N h k x bundle placement + firstBoundarySubset hi hfirst + have hX := SelectedRowGeometry.hXAt1505 C D T N h k x bundle placement + secondBoundarySubset hj hsecond + have geom := packageGeometry 2 0 1 false true g hgs hge hneq R1g R2g hW hX + have hgeom := SelectedRowGeometry.hgeomAt1510 C D T N h k x bundle placement selectedEdge + hi hj geom + rcases chosenBoundary with ⟨hs, hsign⟩ | + ⟨hs, hsign⟩ + · have hs' : bundle.selectedSign = false := by + exact hsign.trans hfirst + exact Or.inr (Or.inr (Or.inl ⟨rfl, hs, hs', hgeom⟩)) + · have hs' : bundle.selectedSign = true := by + exact hsign.trans hsecond + exact Or.inr (Or.inr (Or.inr ⟨rfl, hs, hs', hgeom⟩)) + · have hR : placement.rightNeighborDisplacement = + BandVectors.1 (q 0) (q 2) := SelectedRowGeometry.hRAt1522 C D T N h k x bundle + placement hk hpos + rcases records.1 hpos with ⟨⟨R1⟩, ⟨R2⟩⟩ + have eStart : ExactTileInterfaceTriple F + (TileTranslation F placement.rightNeighborDisplacement) + (TileTranslation F ((-1 : GaussianInt) * BandVectors.1 (q 0) (q 3))) := by + simpa [hR] using exactPlus 1 + have eEnd : ExactTileInterfaceTriple F + (TileTranslation F ((-1 : GaussianInt) * BandVectors.1 (q 0) (q 1))) + (TileTranslation F placement.rightNeighborDisplacement) := by + simpa [hR] using exactMinus 0 + have tStart := SelectedRowGeometry.tStartAt1534 C D T N h k x bundle placement + touchingPlus hR + have tEnd := SelectedRowGeometry.tEndAt1538 C D T N h k x bundle placement touchingMinus hR + rcases canonicalFinish ((-1 : GaussianInt) * BandVectors.1 (q 0) (q 3)) + ((-1 : GaussianInt) * BandVectors.1 (q 0) (q 1)) 0 1 1 1 (-1) 0 + (by simp [hR, period1]) + (by rw [period2]; ring) (by rw [period0]; simp) + coordinateFactsCneg.1 coordinateFactsCneg.2.1 + coordinateFactsCneg.2.2.1 coordinateFactsCneg.2.2.2.1 + coordinateFactsCneg.2.2.2.2.1 coordinateFactsCneg.2.2.2.2.2 + eStart eEnd tStart tEnd with + ⟨g, hgs, hge, hneq⟩ + rcases placement.boundary_signs with ⟨hp, hfirst, hsecond⟩ | ⟨hp, _, _⟩ + · have R1g : ExactTileInterfaceTriple F g.startCompanion + (TileTranslation (placement.layout.P 2 true) + placement.rightNeighborDisplacement) := by + simpa [hgs, hi] using R1 + have R2g : ExactTileInterfaceTriple F g.endCompanion + (TileTranslation (placement.layout.P 0 false) + placement.rightNeighborDisplacement) := by + simpa [hge, hj] using R2 + have hW := SelectedRowGeometry.hWAt1560 C D T N h k x bundle placement + firstBoundarySubset hi hfirst + have hX := SelectedRowGeometry.hXAt1564 C D T N h k x bundle placement + secondBoundarySubset hj hsecond + have geom := packageGeometry 2 0 (-1) true false g hgs hge hneq R1g R2g hW hX + have hgeom := SelectedRowGeometry.hgeomAt1569 C D T N h k x bundle placement selectedEdge + hi hj geom + rcases chosenBoundary with ⟨hs, hsign⟩ | + ⟨hs, hsign⟩ + · have hs' : bundle.selectedSign = true := by + exact hsign.trans hfirst + exact Or.inl ⟨rfl, hs, hs', hgeom⟩ + · have hs' : bundle.selectedSign = false := by + exact hsign.trans hsecond + exact Or.inr (Or.inl ⟨rfl, hs, hs', hgeom⟩) + · rw [hpos] at hp + cases hp + +end SelectedRowConclusions + +namespace SelectedRowExactInterfaces + +private noncomputable def swapExact (A B D : ProtoTile) (E : ExactTileInterfaceTriple A B D) : + ExactTileInterfaceTriple B A D := + { point := E.point + otherAB := E.otherAB + otherBC := E.otherCA + otherCA := E.otherBC + pathAB := by simpa [Set.inter_comm] using E.pathAB + pathBC := by simpa [Set.inter_comm] using E.pathCA + pathCA := by simpa [Set.inter_comm] using E.pathBC + unique_common := by + intro y + simpa [Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using + E.unique_common y } + +private noncomputable def cycleExact (A B D : ProtoTile) (E : ExactTileInterfaceTriple A B D) : + ExactTileInterfaceTriple D A B := + { point := E.point + otherAB := E.otherCA + otherBC := E.otherAB + otherCA := E.otherBC + pathAB := E.pathCA + pathBC := E.pathAB + pathCA := E.pathBC + unique_common := by + intro y + simpa [Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using + E.unique_common y } + +private noncomputable def retargetExactFirst (A A' B D : ProtoTile) + (hcell : A.cells = A'.cells) + (hanchor : A.cells = ∅ → A.anchor = A'.anchor) + (E : ExactTileInterfaceTriple A B D) : ExactTileInterfaceTriple A' B D := by + have hobs := ProtoTileObservableExtensionality A A' hcell hanchor + have hedge : FootprintEdges A = FootprintEdges A' := SelectedRowGeometry.hedge A A' hcell + exact + { point := E.point + otherAB := E.otherAB + otherBC := E.otherBC + otherCA := E.otherCA + pathAB := by simpa [hobs.1, hedge] using E.pathAB + pathBC := E.pathBC + pathCA := by simpa [hobs.1, hedge] using E.pathCA + unique_common := by intro y; simpa [hobs.1] using E.unique_common y } + +end SelectedRowExactInterfaces + +theorem BandOrderedGeneralRightSelectedRowGeometry + (C D : BandCircle) (T N : ProtoTile) (h k : PartialOdometer) + (x : GaussianInt) + (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x) + (placement : BandOrderedGeneralRightPlacement bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction + bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces + bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection) + (selectedEdge : Finset GaussianInt) + (hx : bundle.normalizedPoint ∈ selectedEdge) + (hedge : selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.centralIndex)) + (row : BandOrderedGeneralSelectedContactRow + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout + placement.exteriorIndex placement.centralIndex) : + let q := bundle.normalizedPresentation + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + let selectedPath := ∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices (occurrence placement.exteriorIndex) ∩ + FootprintVertices (occurrence placement.centralIndex)) + (FootprintEdges (occurrence placement.exteriorIndex) ∩ + FootprintEdges (occurrence placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges (occurrence placement.exteriorIndex) ∩ + FootprintEdges (occurrence placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation bundle.normalizedFixed + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation bundle.normalizedFixed + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple bundle.normalizedFixed + firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple bundle.normalizedFixed + secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple bundle.normalizedRoot + bundle.normalizedFixed firstCompanion, + ∃ secondData : ExactTileInterfaceTriple bundle.normalizedRoot + bundle.normalizedFixed secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile bundle.normalizedRoot ∧ + LatticeTile bundle.normalizedFixed ∧ + LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ + Disjoint bundle.normalizedRoot.cells firstCompanion.cells ∧ + Disjoint bundle.normalizedFixed.cells firstCompanion.cells ∧ + Disjoint bundle.normalizedRoot.cells secondCompanion.cells ∧ + Disjoint bundle.normalizedFixed.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple bundle.normalizedRoot bundle.normalizedFixed + firstCompanion ∧ + TouchingTriple bundle.normalizedRoot bundle.normalizedFixed + secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ + selectedPath + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ + bundle.selectedSign = true ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + (-1) true false) ∨ + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = false ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + (-1) true false) ∨ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ + bundle.selectedSign = false ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + 1 false true) ∨ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = true ∧ + rightGeometry placement.rightFirstSlot placement.rightSecondSlot + 1 false true) := by +-- BODY + classical + have chosenBoundary := placement.selected_boundary_piece + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let F := bundle.normalizedFixed + let root := bundle.normalizedRoot + have edgeVertex := SelectedRowGeometry.edgeVertex + let norm := SelectedRowNormalization.certificate C D T N h k x bundle placement + have outer := (BandOrderedGeneralRightInterfaceCertificateExists norm).some + have childInterfaces := BandOrderedGeneralChildInterfaces q cfg + bundle.normalizedCircle F placement.layout + (TileT2QuarterTurn q cfg bundle.normalizedCircle F placement.layout) + have translatedTouching := TileT3TranslateTouching q cfg + bundle.normalizedCircle F placement.layout + (TileT2QuarterTurn q cfg bundle.normalizedCircle F placement.layout) + have blockCells := BandOrderedGeneralPeriodicBlockCells q cfg + bundle.normalizedCircle F placement.layout + have vectorLaws := VectorRecursionLaws q cfg.proper.1 + have turnFlip := vectorLaws.2.2.2.2 cfg.proper + have turnOutgoing (s : Fin 3) : + GaussianQuarterTurn (BandVectors.1 (q s.succ) (q 0)) = + BandVectors.1 (q 0) (q s.succ) := SelectedRowGeometry.turnOutgoing C D T N h k x bundle + turnFlip s + have turnNeg (z : GaussianInt) : + GaussianQuarterTurn (-z) = -GaussianQuarterTurn z := SelectedRowGeometry.turnNeg z + have turnThrice := SelectedRowGeometry.turnThrice turnNeg (SelectedRowGeometry.turnTwice) + have fixedPositive : 0 < (q 0).1 := + (ProperBandCurvatureStructure q cfg.proper).1 + have boundaryRecords := P5635T1RightBoundaryInterfaceRecords + C D T N h k x bundle placement + have centeredExactTurn := SelectedRowGeometry.centeredExactTurn C D T N h k x bundle placement + have twiceExactTurn := SelectedRowGeometry.twiceExactTurn C D T N h k x bundle centeredExactTurn + have tripleTurnOutgoing (ell : Fin 3) : + GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn (BandVectors.1 (q ell.succ) (q 0)))) = + -BandVectors.1 (q 0) (q ell.succ) := SelectedRowGeometry.tripleTurnOutgoing C D T N h k x + bundle turnOutgoing turnThrice ell + have tripleTurnNegativeNext (ell : Fin 3) : + GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn (-BandVectors.1 (q (ell + 1).succ) (q 0)))) = + BandVectors.1 (q 0) (q (ell + 1).succ) := SelectedRowGeometry.tripleTurnNegativeNext C D + T N h k x bundle turnOutgoing turnNeg turnThrice ell + have swapExact (A B D : ProtoTile) (E : ExactTileInterfaceTriple A B D) : + ExactTileInterfaceTriple B A D := SelectedRowExactInterfaces.swapExact A B D E + have cycleExact (A B D : ProtoTile) (E : ExactTileInterfaceTriple A B D) : + ExactTileInterfaceTriple D A B := SelectedRowExactInterfaces.cycleExact A B D E + have retargetExactFirst (A A' B D : ProtoTile) + (hcell : A.cells = A'.cells) + (hanchor : A.cells = ∅ → A.anchor = A'.anchor) + (E : ExactTileInterfaceTriple A B D) : ExactTileInterfaceTriple A' B D := + SelectedRowExactInterfaces.retargetExactFirst A A' B D hcell hanchor E + have touchingRetarget := SelectedRowGeometry.touchingRetarget + (SelectedRowGeometry.tileTouchingRetarget) + have centeredTurnTouching := SelectedRowGeometry.centeredTurnTouching touchingRetarget + (SelectedRowGeometry.quarterTranslate C D T N h k x bundle) (SelectedRowGeometry.translateObs) + have exactPlus (ell : Fin 3) : ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ))) := by + let E := Classical.choice (centeredExactTurn + (BandVectors.1 (q ell.succ) (q 0)) + (-BandVectors.1 (q (ell + 1).succ) (q 0)) + (Classical.choice (childInterfaces.1 ell))) + simpa [turnOutgoing, turnNeg] using E + have exactMinus (ell : Fin 3) : ExactTileInterfaceTriple F + (TileTranslation F (-BandVectors.1 (q 0) (q ell.succ))) + (TileTranslation F (BandVectors.1 (q 0) (q (ell + 1).succ))) := by + let E := Classical.choice ((SelectedRowGeometry.thriceExactTurn C D T N h k x bundle + centeredExactTurn) + (BandVectors.1 (q ell.succ) (q 0)) + (-BandVectors.1 (q (ell + 1).succ) (q 0)) + (Classical.choice (childInterfaces.1 ell))) + simpa only [tripleTurnOutgoing, tripleTurnNegativeNext] using E + have touchingPlus := SelectedRowGeometry.touchingPlus C D T N h k x bundle placement + translatedTouching turnOutgoing turnNeg centeredTurnTouching + have touchingMinus := SelectedRowGeometry.touchingMinus C D T N h k x bundle placement + translatedTouching tripleTurnOutgoing tripleTurnNegativeNext + (SelectedRowGeometry.thriceTouching centeredTurnTouching (SelectedRowGeometry.twiceTouching + centeredTurnTouching)) + have indexNe := SelectedRowGeometry.indexNe C D T N h k x bundle placement row + have originalAllowed := SelectedRowGeometry.originalAllowed C D T N h k x bundle placement + selectedEdge hedge indexNe + have modifiedAdjacent : placement.layout.modified.plane.adjacent + placement.exteriorIndex placement.centralIndex := + (placement.layout.modified_adjacency _ _).2 originalAllowed + let P := placement.layout.P + let u := placement.layout.u + let v := placement.layout.v + have selectedOccurrenceRetarget := P5640T1NonpairedOccurrenceIntersections + q cfg bundle.normalizedCircle F placement.layout + placement.exteriorIndex placement.centralIndex originalAllowed + (SelectedRowGeometry.noPairedOccurrence C D T N h k x bundle placement row) + let selectedPath : Prop := + (∃ selectedStart selectedEnd : GaussianInt, + SimpleGridPathBetween + (FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + (FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex)) + selectedStart selectedEnd ∧ + selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ + bundle.normalizedPoint ∈ selectedEdge) + let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) + (firstSign secondSign : Bool) ↦ + let firstCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q i.succ)) + let secondCompanion := TileTranslation F + (sgn * BandVectors.1 (q 0) (q j.succ)) + let firstPiece := TileTranslation (placement.layout.P i firstSign) + placement.rightNeighborDisplacement + let secondPiece := TileTranslation (placement.layout.P j secondSign) + placement.rightNeighborDisplacement + ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, + ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, + ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, + ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, + firstBoundaryData.point = firstData.point ∧ + secondBoundaryData.point = secondData.point ∧ + LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ + LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ + Disjoint F.cells firstCompanion.cells ∧ + Disjoint root.cells secondCompanion.cells ∧ + Disjoint F.cells secondCompanion.cells ∧ + Disjoint firstCompanion.cells secondCompanion.cells ∧ + TouchingTriple root F firstCompanion ∧ + TouchingTriple root F secondCompanion ∧ + firstData.point ≠ secondData.point ∧ + secondData.point = firstData.otherAB ∧ + secondData.otherAB = firstData.point ∧ selectedPath + have canonicalFinish := SelectedRowGeometry.canonicalFinish C D T N h k x bundle placement + selectedEdge hedge edgeVertex blockCells fixedPositive touchingRetarget + have coordinateFactsApos := SelectedRowGeometry.coordinateFactsApos + have coordinateFactsAneg := SelectedRowGeometry.coordinateFactsAneg + have coordinateFactsBpos := SelectedRowGeometry.coordinateFactsBpos + have coordinateFactsBneg := SelectedRowGeometry.coordinateFactsBneg + have coordinateFactsCpos := SelectedRowGeometry.coordinateFactsCpos + have coordinateFactsCneg := SelectedRowGeometry.coordinateFactsCneg + have period0 : BandVectors.1 (q 0) (q 1) = placement.layout.u := + placement.layout.period_u.symm + have period1 : BandVectors.1 (q 0) (q 2) = placement.layout.v := + placement.layout.period_v.symm + have period2 := SelectedRowGeometry.period2 C D T N h k x + bundle placement (SelectedRowGeometry.outgoingSum C D T N h k x bundle turnOutgoing + (SelectedRowGeometry.turnAdd) (SelectedRowGeometry.incomingSum C D T N h k x bundle)) + period0 period1 + have castTripleOtherABSecond := SelectedRowGeometry.castTripleOtherABSecond + have castRoundTrip (P : ProtoTile → Type) {a b : ProtoTile} + (h : a = b) (z : P a) := SelectedRowGeometry.castRoundTrip P (a := a) (b := b) h z + have packageGeometry := SelectedRowGeometry.packageGeometry C D T N h k x bundle placement + selectedEdge edgeVertex (SelectedRowGeometry.geometryFields C D T N h k x bundle placement + selectedEdge edgeVertex (SelectedRowGeometry.originalSelectedPath C D T N h k x bundle + placement selectedEdge hx hedge (SelectedRowGeometry.modifiedPath C D T N h k x bundle + placement indexNe (SelectedRowGeometry.modifiedEdgesNonempty C D T N h k x bundle placement + indexNe modifiedAdjacent)) selectedOccurrenceRetarget)) + (SelectedRowGeometry.castTriplePointSecond) (SelectedRowGeometry.castTriplePointThird) + (SelectedRowGeometry.castTripleOtherABThird) + have firstBoundarySubset := SelectedRowGeometry.firstBoundarySubset C D T N h k x bundle placement + have secondBoundarySubset := SelectedRowGeometry.secondBoundarySubset C D T N h k x bundle + placement + rcases placement.right_slots_cyclic with hcycle | hcycle | hcycle + · have firstCyclicCase := SelectedRowConclusions.firstCyclicCase C D T N h k x bundle placement + selectedEdge chosenBoundary edgeVertex childInterfaces turnOutgoing turnNeg boundaryRecords + centeredExactTurn tripleTurnOutgoing tripleTurnNegativeNext touchingPlus touchingMinus + canonicalFinish coordinateFactsApos coordinateFactsAneg period0 period1 period2 + packageGeometry firstBoundarySubset secondBoundarySubset hcycle + exact firstCyclicCase + · have secondCyclicCase := SelectedRowConclusions.secondCyclicCase C D T N h k x bundle + placement selectedEdge chosenBoundary edgeVertex childInterfaces turnOutgoing turnNeg + boundaryRecords centeredExactTurn tripleTurnOutgoing tripleTurnNegativeNext touchingPlus + touchingMinus canonicalFinish coordinateFactsBpos coordinateFactsBneg period0 period1 + period2 packageGeometry firstBoundarySubset secondBoundarySubset hcycle + exact secondCyclicCase + · have thirdCyclicCase := SelectedRowConclusions.thirdCyclicCase C D T N h k x bundle placement + selectedEdge chosenBoundary edgeVertex childInterfaces turnOutgoing turnNeg boundaryRecords + centeredExactTurn tripleTurnOutgoing tripleTurnNegativeNext touchingPlus touchingMinus + canonicalFinish coordinateFactsCpos coordinateFactsCneg period0 period1 period2 + packageGeometry firstBoundarySubset secondBoundarySubset hcycle + exact thirdCyclicCase + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRoutedSelectedContact.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRoutedSelectedContact.lean new file mode 100644 index 0000000000..679bc89842 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRoutedSelectedContact.lean @@ -0,0 +1,155 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRowExists +public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation +public import LeanPool.ApollonianSuperharmonic.P3102T2IsolatedRoutedCellSurvival +public import LeanPool.ApollonianSuperharmonic.P3102T2OppositeOwnersCommonEdge +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileCellComplement + +-- [TABLET NODE: BandOrderedGeneralRoutedSelectedContact] + +/-! +# BandOrderedGeneralRoutedSelectedContact + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralRoutedSelectedContact + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + ∀ (a b : PeriodicSubtileIndex) (x : GaussianInt) (j : Fin 4), + (a = ⟨.A, -1, -1⟩ ∨ a = ⟨.A, 0, -1⟩ ∨ + a = ⟨.C, 1, 0⟩ ∨ a = ⟨.C, 1, 1⟩ ∨ + a = ⟨.E, 0, 1⟩ ∨ a = ⟨.E, -1, 0⟩ ∨ + a = ⟨.B, 1, 1⟩ ∨ a = ⟨.B, 0, 1⟩ ∨ + a = ⟨.D, -1, 0⟩ ∨ a = ⟨.D, -1, -1⟩ ∨ + a = ⟨.F, 0, -1⟩ ∨ a = ⟨.F, 1, 0⟩) → + (b = ⟨.A, 0, 0⟩ ∨ b = ⟨.B, 0, 0⟩ ∨ + b = ⟨.C, 0, 0⟩ ∨ b = ⟨.D, 0, 0⟩ ∨ + b = ⟨.E, 0, 0⟩ ∨ b = ⟨.F, 0, 0⟩) → + LatticeVertexIncidentCell x j ∈ (occurrence a).cells → + LatticeVertexIncidentCell x (j + 2) ∈ (occurrence b).cells → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (occurrence a) ∨ + y ∈ FootprintVertices (occurrence b)) → + ∃ e : Finset GaussianInt, + x ∈ e ∧ + e ∈ FootprintEdges (occurrence a) ∩ + FootprintEdges (occurrence b) ∧ + Nonempty (BandOrderedGeneralSelectedContactRow + q cfg C₀ T cert a b) := by +-- BODY + classical + intro occurrence a b x j ha hb hca hcb hcover + have hacoords : ¬ (a.first = 0 ∧ a.second = 0) := by + rcases ha with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> + simp + have hbcoords : b.first = 0 ∧ b.second = 0 := by + rcases hb with rfl | rfl | rfl | rfl | rfl | rfl <;> exact ⟨rfl, rfl⟩ + have hab : a ≠ b := by + intro he + apply hacoords + simpa only [he] using hbcoords + have hpair : ¬ ((a.label = .A ∧ b.label = .B ∨ + a.label = .B ∧ b.label = .A) ∧ + a.first = b.first ∧ a.second = b.second) := by + intro h + exact hacoords ⟨h.2.1.trans hbcoords.1, h.2.2.trans hbcoords.2⟩ + have hpair' : ¬ ((b.label = .A ∧ a.label = .B ∨ + b.label = .B ∧ a.label = .A) ∧ + b.first = a.first ∧ b.second = a.second) := by + intro h + apply hpair + exact ⟨h.1.elim (fun h => Or.inr ⟨h.2, h.1⟩) + (fun h => Or.inl ⟨h.2, h.1⟩), h.2.1.symm, h.2.2.symm⟩ + have hOA : cert.O.cells ⊆ (cert.P 0 true).cells := by + intro z hz + apply (cert.plus_union z).mpr + exact ⟨0, false, by simpa [← cert.precursor_eq] using hz⟩ + have hOB : cert.O.cells ⊆ (cert.P 0 false).cells := by + intro z hz + apply (cert.minus_union z).mpr + exact ⟨0, true, by simpa [← cert.precursor_cells] using hz⟩ + have corner (k : Fin 4) : x ∈ FootprintVertices + (⟨{LatticeVertexIncidentCell x k}, LatticeVertexIncidentCell x k⟩ : ProtoTile) := by + simp only [FootprintVertices, Finset.singleton_nonempty, ite_true, + Set.mem_ofPred_eq, Finset.mem_singleton, exists_eq_left] + fin_cases k <;> simp [LatticeVertexIncidentCell, + Zsqrtd.ext_iff] + have hma : LatticeVertexIncidentCell x j ∈ + (ModifiedSubtileOccurrenceInterpretation cert.P cert.O cert.u cert.v a).cells := + P3102T2IsolatedRoutedCellSurvival cert.P cert.O cert.u cert.v + hOA hOB cert.partition cert.precursor_isolated a b hab hpair + x _ _ hca hcb (corner j) (corner (j + 2)) + have hmb : LatticeVertexIncidentCell x (j + 2) ∈ + (ModifiedSubtileOccurrenceInterpretation cert.P cert.O cert.u cert.v b).cells := + P3102T2IsolatedRoutedCellSurvival cert.P cert.O cert.u cert.v + hOA hOB cert.partition cert.precursor_isolated b a (Ne.symm hab) hpair' + x _ _ hcb hca (corner (j + 2)) (corner j) + have hmodified_edge : ∃ e : Finset GaussianInt, x ∈ e ∧ + e ∈ FootprintEdges (cert.modified.tile a) ∩ + FootprintEdges (cert.modified.tile b) := by + have hpartition : ∀ c : LatticeCell, ∃! o : PeriodicSubtileIndex, + c ∈ (cert.modified.tile o).cells := by + intro c + simpa only [cert.modified_tile] using cert.partition c + exact P3102T2OppositeOwnersCommonEdge cert.modified hpartition a b hab x j + (by simpa only [cert.modified_tile] using hma) + (by simpa only [cert.modified_tile] using hmb) + have modified_subset (o : PeriodicSubtileIndex) : + (cert.modified.tile o).cells ⊆ (occurrence o).cells := by + rw [cert.modified_tile] + cases o with + | mk label m n => + cases label with + | B | C | D | E | F => exact Finset.Subset.refl _ + | A => + intro z hz + obtain ⟨c, hc, he⟩ := Finset.mem_image.mp hz + exact Finset.mem_image.mpr ⟨c, (Finset.mem_sdiff.mp hc).1, he⟩ + have restore (o : PeriodicSubtileIndex) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges (cert.modified.tile o)) : + e ∈ FootprintEdges (occurrence o) := by + obtain ⟨c, hc, hedge⟩ := he + exact ⟨c, modified_subset o hc, hedge⟩ + obtain ⟨e, hxe, hea, heb⟩ := hmodified_edge + have he : e ∈ FootprintEdges (occurrence a) ∩ FootprintEdges (occurrence b) := + ⟨restore a e hea, restore b e heb⟩ + exact ⟨e, hxe, he, + BandOrderedGeneralSelectedContactRowExists q cfg C₀ T cert a b ha hb ⟨e, he⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRow.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRow.lean new file mode 100644 index 0000000000..b7286a08fc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRow.lean @@ -0,0 +1,220 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileCentroid + +-- [TABLET NODE: BandOrderedGeneralSelectedContactRow] + +/-! +# BandOrderedGeneralSelectedContactRow + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Fix an ordered-general layout certificate and write +$A,B,C,D,E,F$ for its six signed pieces and $X_{m,n}$ for the corresponding +literal periodic occurrence. An *exact selected contact row* consists +of two distinct literal indices and their directed geometric presentation; +an $S$ constructor also designates the canonical signed old-companion piece. +Its constructors are the following. + +The constructors are exactly the following eighteen exterior--central +rows. Put $r=\mathit{cfg.firstPredecessor}$ and +$t=\mathit{cfg.secondPredecessor}$. The entry $S_{b\to a}(s)$ stores the +directed child--parent centroid presentation with the displayed rotation +$s$: the rows $S_{2\to1}$ use $(r,1)$, the rows $S_{3\to1}$ use $(r,2)$, +and the rows $S_{3\to2}$ use $(t,0)$. Thus the predecessor and parent slot +are part of the constructor, not freely chosen data. In the six positive +$S$ rows, in displayed order, the constructors designate the signed old +companions $P_1^+,P_1^+,P_2^+,P_1^+,P_1^+,P_2^+$; the reflected +constructors designate respectively +$P_1^-,P_1^-,P_2^-,P_1^-,P_1^-,P_2^-$. These labels and signs are likewise +fixed by the constructor. The literal translation is derived later from +the row centroid identity. +$$ +\begin{array}{c|c|c@{\qquad}c|c|c} +A_{-1,-1}&B_{0,0}&L(-v_{21})&B_{1,1}&A_{0,0}&L(+v_{21})\\ +A_{-1,-1}&C_{0,0}&S_{2\to1}(0)&B_{1,1}&D_{0,0}&S_{2\to1}(2)\\ +A_{0,-1}&B_{0,0}&L(-v_{31})&B_{0,1}&A_{0,0}&L(+v_{31})\\ +A_{0,-1}&E_{0,0}&S_{3\to1}(3)&B_{0,1}&F_{0,0}&S_{3\to1}(1)\\ +C_{1,0}&D_{0,0}&L(-v_{32})&D_{-1,0}&C_{0,0}&L(+v_{32})\\ +C_{1,0}&E_{0,0}&S_{3\to2}(0)&D_{-1,0}&F_{0,0}&S_{3\to2}(2)\\ +C_{1,1}&A_{0,0}&S_{2\to1}(0)&D_{-1,-1}&B_{0,0}&S_{2\to1}(2)\\ +E_{0,1}&A_{0,0}&S_{3\to1}(3)&F_{0,-1}&B_{0,0}&S_{3\to1}(1)\\ +E_{-1,0}&C_{0,0}&S_{3\to2}(0)&F_{1,0}&D_{0,0}&S_{3\to2}(2). +\end{array} +$$ +Thus the row data names a literal row before any endpoint, point, touching, +or sector-ownership assertion is made. In particular it contains no mark +membership claim. +-/ +inductive BandOrderedGeneralSelectedContactRow + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + PeriodicSubtileIndex → PeriodicSubtileIndex → Type where +-- BODY + | positiveL1 + (hne : (⟨.A, -1, -1⟩ : PeriodicSubtileIndex) ≠ ⟨.B, 0, 0⟩) + (presentation : TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.A, -1, -1⟩) - + TileCentroid (cert.P 0 false) = + -GaussianRealPoint (BandVectors.1 (q 2) (q 1))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.A, -1, -1⟩ ⟨.B, 0, 0⟩ + | positiveS1 + (presentation : TileCentroid (cert.P 1 true) - + TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.A, -1, -1⟩) = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + + BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.A, -1, -1⟩ ⟨.C, 0, 0⟩ + | positiveL2 + (hne : (⟨.A, 0, -1⟩ : PeriodicSubtileIndex) ≠ ⟨.B, 0, 0⟩) + (presentation : TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.A, 0, -1⟩) - + TileCentroid (cert.P 0 false) = + -GaussianRealPoint (BandVectors.1 (q 3) (q 1))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.A, 0, -1⟩ ⟨.B, 0, 0⟩ + | positiveS2 + (presentation : TileCentroid (cert.P 2 true) - + TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.A, 0, -1⟩) = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * + (BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + + BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 3)))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.A, 0, -1⟩ ⟨.E, 0, 0⟩ + | positiveL3 + (hne : (⟨.C, 1, 0⟩ : PeriodicSubtileIndex) ≠ ⟨.D, 0, 0⟩) + (presentation : TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.C, 1, 0⟩) - + TileCentroid (cert.P 1 false) = + -GaussianRealPoint (BandVectors.1 (q 3) (q 2))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.C, 1, 0⟩ ⟨.D, 0, 0⟩ + | positiveS3 + (presentation : TileCentroid (cert.P 2 true) - + TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.C, 1, 0⟩) = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + + BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.C, 1, 0⟩ ⟨.E, 0, 0⟩ + | positiveS4 + (presentation : TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.C, 1, 1⟩) - + TileCentroid (cert.P 0 true) = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + + BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.C, 1, 1⟩ ⟨.A, 0, 0⟩ + | positiveS5 + (presentation : TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.E, 0, 1⟩) - + TileCentroid (cert.P 0 true) = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * + (BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + + BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 3)))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.E, 0, 1⟩ ⟨.A, 0, 0⟩ + | positiveS6 + (presentation : TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.E, -1, 0⟩) - + TileCentroid (cert.P 1 true) = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + + BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.E, -1, 0⟩ ⟨.C, 0, 0⟩ + | reflectedL1 + (hne : (⟨.B, 1, 1⟩ : PeriodicSubtileIndex) ≠ ⟨.A, 0, 0⟩) + (presentation : TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.B, 1, 1⟩) - + TileCentroid (cert.P 0 true) = + GaussianRealPoint (BandVectors.1 (q 2) (q 1))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.B, 1, 1⟩ ⟨.A, 0, 0⟩ + | reflectedS1 + (presentation : TileCentroid (cert.P 1 false) - + TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.B, 1, 1⟩) = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + + BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2)))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.B, 1, 1⟩ ⟨.D, 0, 0⟩ + | reflectedL2 + (hne : (⟨.B, 0, 1⟩ : PeriodicSubtileIndex) ≠ ⟨.A, 0, 0⟩) + (presentation : TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.B, 0, 1⟩) - + TileCentroid (cert.P 0 true) = + GaussianRealPoint (BandVectors.1 (q 3) (q 1))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.B, 0, 1⟩ ⟨.A, 0, 0⟩ + | reflectedS2 + (presentation : TileCentroid (cert.P 2 false) - + TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.B, 0, 1⟩) = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * + (BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + + BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 3)))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.B, 0, 1⟩ ⟨.F, 0, 0⟩ + | reflectedL3 + (hne : (⟨.D, -1, 0⟩ : PeriodicSubtileIndex) ≠ ⟨.C, 0, 0⟩) + (presentation : TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.D, -1, 0⟩) - + TileCentroid (cert.P 1 true) = + GaussianRealPoint (BandVectors.1 (q 3) (q 2))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.D, -1, 0⟩ ⟨.C, 0, 0⟩ + | reflectedS3 + (presentation : TileCentroid (cert.P 2 false) - + TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.D, -1, 0⟩) = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + (BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + + BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1)))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.D, -1, 0⟩ ⟨.F, 0, 0⟩ + | reflectedS4 + (presentation : TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.D, -1, -1⟩) - + TileCentroid (cert.P 0 false) = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + + BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2)))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.D, -1, -1⟩ ⟨.B, 0, 0⟩ + | reflectedS5 + (presentation : TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.F, 0, -1⟩) - + TileCentroid (cert.P 0 false) = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * + (BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + + BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 3)))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.F, 0, -1⟩ ⟨.B, 0, 0⟩ + | reflectedS6 + (presentation : TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.F, 1, 0⟩) - + TileCentroid (cert.P 1 false) = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + (BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + + BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1)))) : + BandOrderedGeneralSelectedContactRow q cfg C₀ T cert ⟨.F, 1, 0⟩ ⟨.D, 0, 0⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRowExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRowExists.lean new file mode 100644 index 0000000000..fe30873985 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRowExists.lean @@ -0,0 +1,171 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow +public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex +public import LeanPool.ApollonianSuperharmonic.P3055T1ExteriorCentralIncidence +public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms +public import LeanPool.ApollonianSuperharmonic.P3055T1SignedCentroidNormalForms +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandOrderedGeneralSelectedContactRowExists] + +/-! +# BandOrderedGeneralSelectedContactRowExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralSelectedContactRowExists + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + ∀ (a b : PeriodicSubtileIndex), + (a = ⟨.A, -1, -1⟩ ∨ a = ⟨.A, 0, -1⟩ ∨ + a = ⟨.C, 1, 0⟩ ∨ a = ⟨.C, 1, 1⟩ ∨ + a = ⟨.E, 0, 1⟩ ∨ a = ⟨.E, -1, 0⟩ ∨ + a = ⟨.B, 1, 1⟩ ∨ a = ⟨.B, 0, 1⟩ ∨ + a = ⟨.D, -1, 0⟩ ∨ a = ⟨.D, -1, -1⟩ ∨ + a = ⟨.F, 0, -1⟩ ∨ a = ⟨.F, 1, 0⟩) → + (b = ⟨.A, 0, 0⟩ ∨ b = ⟨.B, 0, 0⟩ ∨ + b = ⟨.C, 0, 0⟩ ∨ b = ⟨.D, 0, 0⟩ ∨ + b = ⟨.E, 0, 0⟩ ∨ b = ⟨.F, 0, 0⟩) → + (FootprintEdges (occurrence a) ∩ FootprintEdges (occurrence b)).Nonempty → + Nonempty (BandOrderedGeneralSelectedContactRow q cfg C₀ T cert a b) := by +-- BODY + classical + intro occurrence a b ha hb hedge + have hab : a ≠ b := by + intro he + subst b + rcases ha with h | h | h | h | h | h | h | h | h | h | h | h <;> + subst a <;> simp at hb + have hinc : AllowedSubtileIncidence a b := + (BandOriginalOccurrenceIntersectionClassification q cfg C₀ T cert + a b hab).1 hedge + obtain ⟨_, _, h31, _, h01, h02, _, hr2, hr3, ht1⟩ := + P3055T1ParentVectorNormalForms q cfg + have hcent := P3055T1SignedCentroidNormalForms q cfg C₀ T cert + dsimp only at hcent + have translated (U : ProtoTile) (z : GaussianInt) : + TileCentroid (TileTranslation U z) = TileCentroid U + GaussianRealPoint z := + (TileTranslationFormulas U z).2.2.2.2.1 + rcases P3055T1ExteriorCentralIncidence a b ha hb hinc with + ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | + ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · refine ⟨BandOrderedGeneralSelectedContactRow.positiveL1 (by decide +kernel) ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02] + apply Prod.ext <;> simp [GaussianRealPoint, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.positiveS1 ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02, hr2] + apply Prod.ext <;> simp [GaussianRealPoint, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.positiveL2 (by decide +kernel) ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02, h31] + apply Prod.ext <;> simp [GaussianRealPoint, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.positiveS2 ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02, hr3] + apply Prod.ext <;> simp [GaussianRealPoint, pow_succ, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.positiveL3 (by decide +kernel) ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02] + apply Prod.ext <;> simp [GaussianRealPoint, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.positiveS3 ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02, ht1] + apply Prod.ext <;> simp [GaussianRealPoint, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.positiveS4 ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02, hr2] + apply Prod.ext <;> simp [GaussianRealPoint, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.positiveS5 ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02, hr3] + apply Prod.ext <;> simp [GaussianRealPoint, pow_succ, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.positiveS6 ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02, ht1] + apply Prod.ext <;> simp [GaussianRealPoint, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.reflectedL1 (by decide +kernel) ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02] + apply Prod.ext <;> simp [GaussianRealPoint, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.reflectedS1 ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02, hr2] + apply Prod.ext <;> simp [GaussianRealPoint, pow_succ, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.reflectedL2 (by decide +kernel) ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02, h31] + apply Prod.ext <;> simp [GaussianRealPoint, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.reflectedS2 ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02, hr3] + apply Prod.ext <;> simp [GaussianRealPoint, pow_succ, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.reflectedL3 (by decide +kernel) ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02] + apply Prod.ext <;> simp [GaussianRealPoint, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.reflectedS3 ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02, ht1] + apply Prod.ext <;> simp [GaussianRealPoint, pow_succ, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.reflectedS4 ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02, hr2] + apply Prod.ext <;> simp [GaussianRealPoint, pow_succ, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.reflectedS5 ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02, hr3] + apply Prod.ext <;> simp [GaussianRealPoint, pow_succ, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · refine ⟨BandOrderedGeneralSelectedContactRow.reflectedS6 ?_⟩ + simp only [SubtileOccurrenceInterpretation, translated, hcent, + cert.period_u, cert.period_v, h01, h02, ht1] + apply Prod.ext <;> simp [GaussianRealPoint, pow_succ, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedSCompanionGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedSCompanionGeometry.lean new file mode 100644 index 0000000000..2889426917 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedSCompanionGeometry.lean @@ -0,0 +1,459 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightPlacement +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.P3996T1CenteredQuarterTurnInclusion +public import LeanPool.ApollonianSuperharmonic.P3996T1PlacementCompanionBlocks +public import LeanPool.ApollonianSuperharmonic.P3996T1AdjacentParentPlacement +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentRightEndpoint +public import LeanPool.ApollonianSuperharmonic.P3996T1SRowAlignment +public import LeanPool.ApollonianSuperharmonic.TileT2QuarterTurn + +-- [TABLET NODE: BandOrderedGeneralSelectedSCompanionGeometry] + +/-! +# BandOrderedGeneralSelectedSCompanionGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SelectedSCompanionGeometry + +private theorem solve : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (rrow : + BandOrderedGeneralSelectedContactRow + bundle.normalizedPresentation bundle.configuration bundle.normalizedCircle + bundle.normalizedFixed placement.layout a b), ∀ (z : P3996T1SRowParameters), + (P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout rrow = some z) → ( + let newRight := TileTranslation (occurrence z.childIndex) z.rightShift; + (newRight.cells = (TileTranslation + (placement.layout.P z.childSlot z.childSign) + (z.childShift + z.rightShift)).cells ∧ + (newRight.cells = ∅ → newRight.anchor = (TileTranslation + (placement.layout.P z.childSlot z.childSign) + (z.childShift + z.rightShift)).anchor)) ∧ + (Nonempty (ExactTileInterfaceTriple (occurrence a) newRight (occurrence b)) ∨ + Nonempty (ExactTileInterfaceTriple (occurrence b) newRight (occurrence a))) ∧ + newRight.cells ⊆ (TileTranslation bundle.normalizedFixed z.oldShift).cells ∧ + FootprintVertices newRight ⊆ + FootprintVertices (TileTranslation bundle.normalizedFixed z.oldShift)) ) := by + classical + intro C D T N h k x bundle placement occurrence a b rrow z hz + obtain ⟨hp, hp0, hV, hW, hVpos, hWpos, hindices, hObs, hd, + hWcent, hcent⟩ := P3996T1SRowAlignment bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedFixed + placement.layout a b rrow z hz + dsimp only at hV hW hObs hWcent hcent ⊢ + let newRight := TileTranslation (occurrence z.childIndex) z.rightShift + have hExact : Nonempty (ExactTileInterfaceTriple + (occurrence z.childIndex) newRight (occurrence z.parentIndex)) := by + obtain ⟨Z, hZ, hZcent⟩ := P3996T1AdjacentParentPlacement + z.predecessor hp z.parentSlot z.rotation (occurrence z.childIndex) hV + have ep := BandOrientedChildParentRightEndpoint z.predecessor hp + z.parentSlot z.rotation (occurrence z.childIndex) + (occurrence z.parentIndex) Z hV hW hZ hVpos hWpos hWcent hZcent + simpa only [newRight, hd] using ep + have hsubP : (placement.layout.P z.childSlot z.sourceSign).cells ⊆ + bundle.normalizedFixed.cells := by + intro y hy + exact (placement.layout.outer_union y).mpr + ⟨z.childSlot, z.sourceSign, hy⟩ + obtain ⟨t, p, ht, hp', htransport⟩ := + P3996T1CenteredQuarterTurnInclusion bundle.normalizedFixed + (placement.layout.P z.childSlot z.sourceSign) + (TileT2QuarterTurn bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout) + (placement.layout.parent_quarter_turn z.childSlot z.sourceSign) hsubP + let rotatedPiece := TileTranslation + (placement.layout.P z.childSlot z.sourceSign) (z.oldShift + t - p) + have htransported := htransport z.oldShift + have hnewBand : BandPrototile + (bundle.normalizedPresentation z.childSlot.succ) newRight := by + rw [← hp0] + exact BandPrototileTranslation _ _ z.rightShift hV + have hrotatedBand : BandPrototile + (bundle.normalizedPresentation z.childSlot.succ) rotatedPiece := + BandPrototileTranslation _ _ _ + (placement.layout.outer_occurrence z.childSlot z.sourceSign).1 + have hcentEqual : TileCentroid newRight = TileCentroid rotatedPiece := by + exact sub_left_inj.mp (hcent.trans htransported.2.symm) + have hcells := (BandPrototileCentroidUnique _ _ _ hnewBand hrotatedBand + hcentEqual).1 + have hsub : newRight.cells ⊆ + (TileTranslation bundle.normalizedFixed z.oldShift).cells := by + rw [hcells] + exact htransported.1 + have hne : newRight.cells.Nonempty := by + obtain ⟨E⟩ := hExact + obtain ⟨path, _, hlen, _, _, _, _, hedges⟩ := E.pathAB + cases path with + | nil => simp at hlen + | cons v tail => + cases tail with + | nil => simp at hlen + | cons w rest => + have he : {v, w} ∈ FootprintEdges (occurrence z.childIndex) ∩ + FootprintEdges newRight := + (hedges {v, w}).mpr ⟨v, w, [], rest, rfl, rfl⟩ + obtain ⟨cell, hcell, _⟩ := he.2 + exact ⟨cell, hcell⟩ + have hfoot : FootprintVertices newRight ⊆ + FootprintVertices (TileTranslation bundle.normalizedFixed z.oldShift) := by + have hneOld := hne.mono hsub + simp only [FootprintVertices, ite_eq_left hne, ite_eq_left hneOld] + rintro y ⟨cell, hcell, hcorner⟩ + exact ⟨cell, hsub hcell, hcorner⟩ + refine ⟨hObs, ?_, hsub, hfoot⟩ + cases hflag : z.childIsExterior + · simp only [hflag, Bool.false_eq_true, ↓reduceIte] at hindices + right + simpa only [← hindices.1, ← hindices.2] using hExact + · simp only [hflag, ↓reduceIte] at hindices + left + simpa only [← hindices.1, ← hindices.2] using hExact + +end SelectedSCompanionGeometry + +theorem BandOrderedGeneralSelectedSCompanionGeometry : + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction + bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces + bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), (bundle.normalizedPoint ∈ + selectedEdge) → ((selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.centralIndex)) → (∀ (row : + BandOrderedGeneralSelectedContactRow + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout + placement.exteriorIndex placement.centralIndex), + let q := bundle.normalizedPresentation + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + let observableEq := fun A B : ProtoTile => + A.cells = B.cells ∧ (A.cells = ∅ → A.anchor = B.anchor) + let companionGeometry := fun (newRight signedPiece oldRight : ProtoTile) => + observableEq newRight signedPiece ∧ + (Nonempty (ExactTileInterfaceTriple + (occurrence placement.exteriorIndex) newRight + (occurrence placement.centralIndex)) ∨ + Nonempty (ExactTileInterfaceTriple + (occurrence placement.centralIndex) newRight + (occurrence placement.exteriorIndex))) ∧ + newRight.cells ⊆ oldRight.cells ∧ + FootprintVertices newRight ⊆ FootprintVertices oldRight + let rowGeometry := fun (a b : PeriodicSubtileIndex) + (selectedRow : BandOrderedGeneralSelectedContactRow + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout a b) + (oldRight : ProtoTile) => + match selectedRow with + | .positiveL1 _ _ => True + | .positiveL2 _ _ => True + | .positiveL3 _ _ => True + | .reflectedL1 _ _ => True + | .reflectedL2 _ _ => True + | .reflectedL3 _ _ => True + | .positiveS1 _ => + let d := BandVectors.1 + (bundle.configuration.firstPredecessor 0) + (bundle.configuration.firstPredecessor 2) + let newRight := TileTranslation (occurrence ⟨.A, -1, -1⟩) d + companionGeometry newRight + (TileTranslation (placement.layout.P 0 true) + (-placement.layout.u - placement.layout.v + d)) oldRight + | .positiveS2 _ => + let d := (⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * + BandVectors.1 (bundle.configuration.firstPredecessor 3) + (bundle.configuration.firstPredecessor 0) + let newRight := TileTranslation (occurrence ⟨.A, 0, -1⟩) d + companionGeometry newRight + (TileTranslation (placement.layout.P 0 true) + (-placement.layout.v + d)) oldRight + | .positiveS3 _ => + let d := BandVectors.1 + (bundle.configuration.secondPredecessor 0) + (bundle.configuration.secondPredecessor 1) + let newRight := TileTranslation (occurrence ⟨.C, 1, 0⟩) d + companionGeometry newRight + (TileTranslation (placement.layout.P 1 true) + (placement.layout.u + d)) oldRight + | .positiveS4 _ => + let d := BandVectors.1 + (bundle.configuration.firstPredecessor 0) + (bundle.configuration.firstPredecessor 2) + let newRight := TileTranslation (occurrence ⟨.A, 0, 0⟩) d + companionGeometry newRight + (TileTranslation (placement.layout.P 0 true) d) oldRight + | .positiveS5 _ => + let d := (⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * + BandVectors.1 (bundle.configuration.firstPredecessor 3) + (bundle.configuration.firstPredecessor 0) + let newRight := TileTranslation (occurrence ⟨.A, 0, 0⟩) d + companionGeometry newRight + (TileTranslation (placement.layout.P 0 true) d) oldRight + | .positiveS6 _ => + let d := BandVectors.1 + (bundle.configuration.secondPredecessor 0) + (bundle.configuration.secondPredecessor 1) + let newRight := TileTranslation (occurrence ⟨.C, 0, 0⟩) d + companionGeometry newRight + (TileTranslation (placement.layout.P 1 true) d) oldRight + | .reflectedS1 _ => + let d := (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + BandVectors.1 (bundle.configuration.firstPredecessor 0) + (bundle.configuration.firstPredecessor 2) + let newRight := TileTranslation (occurrence ⟨.B, 1, 1⟩) d + companionGeometry newRight + (TileTranslation (placement.layout.P 0 false) + (placement.layout.u + placement.layout.v + d)) oldRight + | .reflectedS2 _ => + let d := (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (bundle.configuration.firstPredecessor 3) + (bundle.configuration.firstPredecessor 0) + let newRight := TileTranslation (occurrence ⟨.B, 0, 1⟩) d + companionGeometry newRight + (TileTranslation (placement.layout.P 0 false) + (placement.layout.v + d)) oldRight + | .reflectedS3 _ => + let d := (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + BandVectors.1 (bundle.configuration.secondPredecessor 0) + (bundle.configuration.secondPredecessor 1) + let newRight := TileTranslation (occurrence ⟨.D, -1, 0⟩) d + companionGeometry newRight + (TileTranslation (placement.layout.P 1 false) + (-placement.layout.u + d)) oldRight + | .reflectedS4 _ => + let d := (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + BandVectors.1 (bundle.configuration.firstPredecessor 0) + (bundle.configuration.firstPredecessor 2) + let newRight := TileTranslation (occurrence ⟨.B, 0, 0⟩) d + companionGeometry newRight + (TileTranslation (placement.layout.P 0 false) d) oldRight + | .reflectedS5 _ => + let d := (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (bundle.configuration.firstPredecessor 3) + (bundle.configuration.firstPredecessor 0) + let newRight := TileTranslation (occurrence ⟨.B, 0, 0⟩) d + companionGeometry newRight + (TileTranslation (placement.layout.P 0 false) d) oldRight + | .reflectedS6 _ => + let d := (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + BandVectors.1 (bundle.configuration.secondPredecessor 0) + (bundle.configuration.secondPredecessor 1) + let newRight := TileTranslation (occurrence ⟨.D, 0, 0⟩) d + companionGeometry newRight + (TileTranslation (placement.layout.P 1 false) d) oldRight + let positiveFirst := TileTranslation bundle.normalizedFixed + (-BandVectors.1 (q 0) (q placement.rightFirstSlot.succ)) + let positiveSecond := TileTranslation bundle.normalizedFixed + (-BandVectors.1 (q 0) (q placement.rightSecondSlot.succ)) + let reflectedFirst := TileTranslation bundle.normalizedFixed + (BandVectors.1 (q 0) (q placement.rightFirstSlot.succ)) + let reflectedSecond := TileTranslation bundle.normalizedFixed + (BandVectors.1 (q 0) (q placement.rightSecondSlot.succ)) + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ + bundle.selectedSign = true → + rowGeometry placement.exteriorIndex placement.centralIndex row + positiveFirst) ∧ + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = false → + rowGeometry placement.exteriorIndex placement.centralIndex row + positiveSecond) ∧ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ + bundle.selectedSign = false → + rowGeometry placement.exteriorIndex placement.centralIndex row + reflectedFirst) ∧ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ + bundle.selectedSign = true → + rowGeometry placement.exteriorIndex placement.centralIndex row + reflectedSecond))) := by + intro C D T N h k x bundle placement selectedEdge hx hedge row +-- BODY + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + have solve := SelectedSCompanionGeometry.solve C D T N h k x bundle placement + generalize hExt : placement.exteriorIndex = ext at row ⊢ + generalize hCentral : placement.centralIndex = central at row ⊢ + cases row <;> dsimp only at ⊢ + case positiveL1 => exact ⟨fun _ => True.intro, fun _ => True.intro, + fun _ => True.intro, fun _ => True.intro⟩ + case positiveL2 => exact ⟨fun _ => True.intro, fun _ => True.intro, + fun _ => True.intro, fun _ => True.intro⟩ + case positiveL3 => exact ⟨fun _ => True.intro, fun _ => True.intro, + fun _ => True.intro, fun _ => True.intro⟩ + case reflectedL1 => exact ⟨fun _ => True.intro, fun _ => True.intro, + fun _ => True.intro, fun _ => True.intro⟩ + case reflectedL2 => exact ⟨fun _ => True.intro, fun _ => True.intro, + fun _ => True.intro, fun _ => True.intro⟩ + case reflectedL3 => exact ⟨fun _ => True.intro, fun _ => True.intro, + fun _ => True.intro, fun _ => True.intro⟩ + case' positiveS1 presentation => + let rowLit := BandOrderedGeneralSelectedContactRow.positiveS1 presentation + let z : P3996T1SRowParameters := + (P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout rowLit).get (by rfl) + have geometry := solve _ _ rowLit z rfl + have blocks := P3996T1PlacementCompanionBlocks C D T N h k x bundle + placement _ _ rowLit hExt hCentral z rfl + dsimp only at blocks + case' positiveS2 presentation => + let rowLit := BandOrderedGeneralSelectedContactRow.positiveS2 presentation + let z : P3996T1SRowParameters := + (P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout rowLit).get (by rfl) + have geometry := solve _ _ rowLit z rfl + have blocks := P3996T1PlacementCompanionBlocks C D T N h k x bundle + placement _ _ rowLit hExt hCentral z rfl + dsimp only at blocks + case' positiveS3 presentation => + let rowLit := BandOrderedGeneralSelectedContactRow.positiveS3 presentation + let z : P3996T1SRowParameters := + (P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout rowLit).get (by rfl) + have geometry := solve _ _ rowLit z rfl + have blocks := P3996T1PlacementCompanionBlocks C D T N h k x bundle + placement _ _ rowLit hExt hCentral z rfl + dsimp only at blocks + case' positiveS4 presentation => + let rowLit := BandOrderedGeneralSelectedContactRow.positiveS4 presentation + let z : P3996T1SRowParameters := + (P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout rowLit).get (by rfl) + have geometry := solve _ _ rowLit z rfl + have blocks := P3996T1PlacementCompanionBlocks C D T N h k x bundle + placement _ _ rowLit hExt hCentral z rfl + dsimp only at blocks + case' positiveS5 presentation => + let rowLit := BandOrderedGeneralSelectedContactRow.positiveS5 presentation + let z : P3996T1SRowParameters := + (P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout rowLit).get (by rfl) + have geometry := solve _ _ rowLit z rfl + have blocks := P3996T1PlacementCompanionBlocks C D T N h k x bundle + placement _ _ rowLit hExt hCentral z rfl + dsimp only at blocks + case' positiveS6 presentation => + let rowLit := BandOrderedGeneralSelectedContactRow.positiveS6 presentation + let z : P3996T1SRowParameters := + (P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout rowLit).get (by rfl) + have geometry := solve _ _ rowLit z rfl + have blocks := P3996T1PlacementCompanionBlocks C D T N h k x bundle + placement _ _ rowLit hExt hCentral z rfl + dsimp only at blocks + case' reflectedS1 presentation => + let rowLit := BandOrderedGeneralSelectedContactRow.reflectedS1 presentation + let z : P3996T1SRowParameters := + (P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout rowLit).get (by rfl) + have geometry := solve _ _ rowLit z rfl + have blocks := P3996T1PlacementCompanionBlocks C D T N h k x bundle + placement _ _ rowLit hExt hCentral z rfl + dsimp only at blocks + case' reflectedS2 presentation => + let rowLit := BandOrderedGeneralSelectedContactRow.reflectedS2 presentation + let z : P3996T1SRowParameters := + (P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout rowLit).get (by rfl) + have geometry := solve _ _ rowLit z rfl + have blocks := P3996T1PlacementCompanionBlocks C D T N h k x bundle + placement _ _ rowLit hExt hCentral z rfl + dsimp only at blocks + case' reflectedS3 presentation => + let rowLit := BandOrderedGeneralSelectedContactRow.reflectedS3 presentation + let z : P3996T1SRowParameters := + (P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout rowLit).get (by rfl) + have geometry := solve _ _ rowLit z rfl + have blocks := P3996T1PlacementCompanionBlocks C D T N h k x bundle + placement _ _ rowLit hExt hCentral z rfl + dsimp only at blocks + case' reflectedS4 presentation => + let rowLit := BandOrderedGeneralSelectedContactRow.reflectedS4 presentation + let z : P3996T1SRowParameters := + (P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout rowLit).get (by rfl) + have geometry := solve _ _ rowLit z rfl + have blocks := P3996T1PlacementCompanionBlocks C D T N h k x bundle + placement _ _ rowLit hExt hCentral z rfl + dsimp only at blocks + case' reflectedS5 presentation => + let rowLit := BandOrderedGeneralSelectedContactRow.reflectedS5 presentation + let z : P3996T1SRowParameters := + (P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout rowLit).get (by rfl) + have geometry := solve _ _ rowLit z rfl + have blocks := P3996T1PlacementCompanionBlocks C D T N h k x bundle + placement _ _ rowLit hExt hCentral z rfl + dsimp only at blocks + case' reflectedS6 presentation => + let rowLit := BandOrderedGeneralSelectedContactRow.reflectedS6 presentation + let z : P3996T1SRowParameters := + (P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout rowLit).get (by rfl) + have geometry := solve _ _ rowLit z rfl + have blocks := P3996T1PlacementCompanionBlocks C D T N h k x bundle + placement _ _ rowLit hExt hCentral z rfl + dsimp only at blocks + all_goals + refine ⟨?_, ?_, ?_, ?_⟩ + · intro hbranch + rw [blocks.1 hbranch] + simpa only [z, rowLit, P3996T1SRowTable, Option.get_some, occurrence, zero_add] using + geometry + · intro hbranch + rw [blocks.2.1 hbranch] + simpa only [z, rowLit, P3996T1SRowTable, Option.get_some, occurrence, zero_add] using + geometry + · intro hbranch + rw [blocks.2.2.1 hbranch] + simpa only [z, rowLit, P3996T1SRowTable, Option.get_some, occurrence, zero_add] using + geometry + · intro hbranch + rw [blocks.2.2.2 hbranch] + simpa only [z, rowLit, P3996T1SRowTable, Option.get_some, occurrence, zero_add] using + geometry + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralShiftedRoutedBoundaryLocalization.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralShiftedRoutedBoundaryLocalization.lean new file mode 100644 index 0000000000..2e3fb64dfc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralShiftedRoutedBoundaryLocalization.lean @@ -0,0 +1,290 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRowExists +public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.P3102T2IsolatedRoutedCellSurvival +public import LeanPool.ApollonianSuperharmonic.P3102T2OppositeOwnersCommonEdge +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk + +-- [TABLET NODE: BandOrderedGeneralShiftedRoutedBoundaryLocalization] + +/-! +# BandOrderedGeneralShiftedRoutedBoundaryLocalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralShiftedRoutedBoundaryLocalization + (q : Fin 4 -> CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C0 : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C0 T) + (a b : PeriodicSubtileIndex) (x : GaussianInt) (j : Fin 4) + (k : Fin 3) (positive : Bool) + (hshift : + (positive = true /\ + ((k = 0 /\ a.first = 1 /\ a.second = 0) \/ + (k = 1 /\ a.first = 0 /\ a.second = 1) \/ + (k = 2 /\ a.first = -1 /\ a.second = -1))) \/ + (positive = false /\ + ((k = 0 /\ a.first = -1 /\ a.second = 0) \/ + (k = 1 /\ a.first = 0 /\ a.second = -1) \/ + (k = 2 /\ a.first = 1 /\ a.second = 1)))) + (hcentral : + b = ⟨.A, 0, 0⟩ \/ b = ⟨.B, 0, 0⟩ \/ + b = ⟨.C, 0, 0⟩ \/ b = ⟨.D, 0, 0⟩ \/ + b = ⟨.E, 0, 0⟩ \/ b = ⟨.F, 0, 0⟩) + (ha : LatticeVertexIncidentCell x j ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells) + (hb : LatticeVertexIncidentCell x (j + 2) ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) + (hstar : forall y, + y = x \/ y = x + 1 \/ y = x - 1 \/ + y = x + ⟨0, 1⟩ \/ y = x - ⟨0, 1⟩ -> + y ∈ FootprintVertices + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) \/ + y ∈ FootprintVertices + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) : + exists edge : Finset GaussianInt, + x ∈ edge /\ + edge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) /\ + ((positive = true /\ + ((k = 0 /\ + (a = ⟨.C, 1, 0⟩ \/ a = ⟨.F, 1, 0⟩)) \/ + (k = 1 /\ + (a = ⟨.E, 0, 1⟩ \/ a = ⟨.B, 0, 1⟩)) \/ + (k = 2 /\ + (a = ⟨.A, -1, -1⟩ \/ a = ⟨.D, -1, -1⟩)))) \/ + (positive = false /\ + ((k = 0 /\ + (a = ⟨.D, -1, 0⟩ \/ a = ⟨.E, -1, 0⟩)) \/ + (k = 1 /\ + (a = ⟨.F, 0, -1⟩ \/ a = ⟨.A, 0, -1⟩)) \/ + (k = 2 /\ + (a = ⟨.B, 1, 1⟩ \/ a = ⟨.C, 1, 1⟩))))) /\ + Nonempty (BandOrderedGeneralSelectedContactRow q cfg C0 T cert a b) := by +-- BODY + classical + have hcoords : + (a.first = 1 ∧ a.second = 0) ∨ + (a.first = 0 ∧ a.second = 1) ∨ + (a.first = -1 ∧ a.second = -1) ∨ + (a.first = -1 ∧ a.second = 0) ∨ + (a.first = 0 ∧ a.second = -1) ∨ + (a.first = 1 ∧ a.second = 1) := by + rcases hshift with ⟨_, h⟩ | ⟨_, h⟩ + · rcases h with h | h | h + · exact Or.inl ⟨h.2.1, h.2.2⟩ + · exact Or.inr (Or.inl ⟨h.2.1, h.2.2⟩) + · exact Or.inr (Or.inr (Or.inl ⟨h.2.1, h.2.2⟩)) + · rcases h with h | h | h + · exact Or.inr (Or.inr (Or.inr (Or.inl ⟨h.2.1, h.2.2⟩))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨h.2.1, h.2.2⟩)))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr ⟨h.2.1, h.2.2⟩)))) + have hbzero : b.first = 0 ∧ b.second = 0 := by + rcases hcentral with h | h | h | h | h | h <;> simp_all + have hab : a ≠ b := by + intro he + have hfirst := congrArg PeriodicSubtileIndex.first he + have hsecond := congrArg PeriodicSubtileIndex.second he + rcases hcoords with ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | + ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> simp_all + have hpair : ¬ ((a.label = .A ∧ b.label = .B ∨ + a.label = .B ∧ b.label = .A) ∧ + a.first = b.first ∧ a.second = b.second) := by + intro h + have hfirst := h.2.1 + have hsecond := h.2.2 + rcases hcoords with ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ | + ⟨h1, h2⟩ | ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> simp_all + have hpair' : ¬ ((b.label = .A ∧ a.label = .B ∨ + b.label = .B ∧ a.label = .A) ∧ + b.first = a.first ∧ b.second = a.second) := by + intro h + apply hpair + exact ⟨h.1.elim (fun h => Or.inr ⟨h.2, h.1⟩) + (fun h => Or.inl ⟨h.2, h.1⟩), h.2.1.symm, h.2.2.symm⟩ + have hOA : cert.O.cells ⊆ (cert.P 0 true).cells := by + intro z hz + apply (cert.plus_union z).mpr + exact ⟨0, false, by simpa [← cert.precursor_eq] using hz⟩ + have hOB : cert.O.cells ⊆ (cert.P 0 false).cells := by + intro z hz + apply (cert.minus_union z).mpr + exact ⟨0, true, by simpa [← cert.precursor_cells] using hz⟩ + have corner (r : Fin 4) : x ∈ FootprintVertices + (⟨{LatticeVertexIncidentCell x r}, LatticeVertexIncidentCell x r⟩ : ProtoTile) := by + simp only [FootprintVertices, Finset.singleton_nonempty, ite_true, + Set.mem_ofPred_eq, Finset.mem_singleton, exists_eq_left] + fin_cases r <;> simp [LatticeVertexIncidentCell, Zsqrtd.ext_iff] + have hma : LatticeVertexIncidentCell x j ∈ + (ModifiedSubtileOccurrenceInterpretation cert.P cert.O cert.u cert.v a).cells := + P3102T2IsolatedRoutedCellSurvival cert.P cert.O cert.u cert.v + hOA hOB cert.partition cert.precursor_isolated a b hab hpair + x _ _ ha hb (corner j) (corner (j + 2)) + have hmb : LatticeVertexIncidentCell x (j + 2) ∈ + (ModifiedSubtileOccurrenceInterpretation cert.P cert.O cert.u cert.v b).cells := + P3102T2IsolatedRoutedCellSurvival cert.P cert.O cert.u cert.v + hOA hOB cert.partition cert.precursor_isolated b a (Ne.symm hab) hpair' + x _ _ hb ha (corner (j + 2)) (corner j) + have hpartition : ∀ c : LatticeCell, ∃! o : PeriodicSubtileIndex, + c ∈ (cert.modified.tile o).cells := by + intro c + simpa only [cert.modified_tile] using cert.partition c + have hmodified_edge := P3102T2OppositeOwnersCommonEdge cert.modified + hpartition a b hab x j + (by simpa only [cert.modified_tile] using hma) + (by simpa only [cert.modified_tile] using hmb) + have modified_subset (o : PeriodicSubtileIndex) : + (cert.modified.tile o).cells ⊆ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v o).cells := by + rw [cert.modified_tile] + cases o with + | mk label m n => + cases label with + | B | C | D | E | F => exact Finset.Subset.refl _ + | A => + intro z hz + obtain ⟨c, hc, he⟩ := Finset.mem_image.mp hz + exact Finset.mem_image.mpr ⟨c, (Finset.mem_sdiff.mp hc).1, he⟩ + have restore (o : PeriodicSubtileIndex) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges (cert.modified.tile o)) : + e ∈ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v o) := by + obtain ⟨c, hc, hedge⟩ := he + exact ⟨c, modified_subset o hc, hedge⟩ + obtain ⟨e, hxe, hea, heb⟩ := hmodified_edge + have he : e ∈ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) := + ⟨restore a e hea, restore b e heb⟩ + have hinc : AllowedSubtileIncidence a b := + (BandOriginalOccurrenceIntersectionClassification q cfg C0 T cert a b hab).1 + ⟨e, he⟩ + let shiftedBoundaryLabels (z : PeriodicSubtileIndex) : Prop := + ((z.first = 1 ∧ z.second = 0) → z.label = .C ∨ z.label = .F) ∧ + ((z.first = 0 ∧ z.second = 1) → z.label = .E ∨ z.label = .B) ∧ + ((z.first = -1 ∧ z.second = -1) → z.label = .A ∨ z.label = .D) ∧ + ((z.first = -1 ∧ z.second = 0) → z.label = .D ∨ z.label = .E) ∧ + ((z.first = 0 ∧ z.second = -1) → z.label = .F ∨ z.label = .A) ∧ + ((z.first = 1 ∧ z.second = 1) → z.label = .B ∨ z.label = .C) + have ledger (u v : PeriodicSubtileIndex) (h : AllowedSubtileIncidence u v) : + (v.first = 0 ∧ v.second = 0 → shiftedBoundaryLabels u) ∧ + (u.first = 0 ∧ u.second = 0 → shiftedBoundaryLabels v) := by + induction h with + | symm h ih => exact And.symm ih + | AB m n | AB01 m n | AB11 m n | AC m n | AC11 m n + | AD m n | AE01 m n | AF m n | BC m n | BDm1m1 m n + | BD m n | BE m n | BF0m1 m n | CDm10 m n | CEm10 m n + | CF m n | DE m n | DF10 m n => + constructor <;> rintro hm <;> + simp [shiftedBoundaryLabels] at * <;> omega + have hlabels := (ledger a b hinc).1 hbzero + have index_eq (label : SixSubtileLabel) (m n : Int) + (hl : a.label = label) (hm : a.first = m) (hn : a.second = n) : + a = ⟨label, m, n⟩ := by + cases a with + | mk actual first second => + change actual = label at hl + change first = m at hm + change second = n at hn + subst actual + subst first + subst second + rfl + have htable : + ((positive = true /\ + ((k = 0 /\ + (a = ⟨.C, 1, 0⟩ \/ a = ⟨.F, 1, 0⟩)) \/ + (k = 1 /\ + (a = ⟨.E, 0, 1⟩ \/ a = ⟨.B, 0, 1⟩)) \/ + (k = 2 /\ + (a = ⟨.A, -1, -1⟩ \/ a = ⟨.D, -1, -1⟩)))) \/ + (positive = false /\ + ((k = 0 /\ + (a = ⟨.D, -1, 0⟩ \/ a = ⟨.E, -1, 0⟩)) \/ + (k = 1 /\ + (a = ⟨.F, 0, -1⟩ \/ a = ⟨.A, 0, -1⟩)) \/ + (k = 2 /\ + (a = ⟨.B, 1, 1⟩ \/ a = ⟨.C, 1, 1⟩))))) := by + rcases hshift with ⟨hp, hs⟩ | ⟨hp, hs⟩ + · rcases hs with h0 | h1 | h2 + · rcases hlabels.1 ⟨h0.2.1, h0.2.2⟩ with hl | hl + · exact Or.inl ⟨hp, Or.inl ⟨h0.1, Or.inl (index_eq .C 1 0 hl h0.2.1 h0.2.2)⟩⟩ + · exact Or.inl ⟨hp, Or.inl ⟨h0.1, Or.inr (index_eq .F 1 0 hl h0.2.1 h0.2.2)⟩⟩ + · rcases hlabels.2.1 ⟨h1.2.1, h1.2.2⟩ with hl | hl + · exact Or.inl ⟨hp, Or.inr (Or.inl ⟨h1.1, Or.inl (index_eq .E 0 1 hl h1.2.1 h1.2.2)⟩)⟩ + · exact Or.inl ⟨hp, Or.inr (Or.inl ⟨h1.1, Or.inr (index_eq .B 0 1 hl h1.2.1 h1.2.2)⟩)⟩ + · rcases hlabels.2.2.1 ⟨h2.2.1, h2.2.2⟩ with hl | hl + · exact Or.inl ⟨hp, Or.inr (Or.inr (⟨h2.1, Or.inl (index_eq .A (-1) (-1) hl h2.2.1 + h2.2.2)⟩))⟩ + · exact Or.inl ⟨hp, Or.inr (Or.inr (⟨h2.1, Or.inr (index_eq .D (-1) (-1) hl h2.2.1 + h2.2.2)⟩))⟩ + · rcases hs with h0 | h1 | h2 + · rcases hlabels.2.2.2.1 ⟨h0.2.1, h0.2.2⟩ with hl | hl + · exact Or.inr ⟨hp, Or.inl ⟨h0.1, Or.inl (index_eq .D (-1) 0 hl h0.2.1 h0.2.2)⟩⟩ + · exact Or.inr ⟨hp, Or.inl ⟨h0.1, Or.inr (index_eq .E (-1) 0 hl h0.2.1 h0.2.2)⟩⟩ + · rcases hlabels.2.2.2.2.1 ⟨h1.2.1, h1.2.2⟩ with hl | hl + · exact Or.inr ⟨hp, Or.inr (Or.inl ⟨h1.1, Or.inl (index_eq .F 0 (-1) hl h1.2.1 h1.2.2)⟩)⟩ + · exact Or.inr ⟨hp, Or.inr (Or.inl ⟨h1.1, Or.inr (index_eq .A 0 (-1) hl h1.2.1 h1.2.2)⟩)⟩ + · rcases hlabels.2.2.2.2.2 ⟨h2.2.1, h2.2.2⟩ with hl | hl + · exact Or.inr ⟨hp, Or.inr (Or.inr ⟨h2.1, Or.inl (index_eq .B 1 1 hl h2.2.1 h2.2.2)⟩)⟩ + · exact Or.inr ⟨hp, Or.inr (Or.inr ⟨h2.1, Or.inr (index_eq .C 1 1 hl h2.2.1 h2.2.2)⟩)⟩ + have haExterior : + (a = ⟨.A, -1, -1⟩ ∨ a = ⟨.A, 0, -1⟩ ∨ + a = ⟨.C, 1, 0⟩ ∨ a = ⟨.C, 1, 1⟩ ∨ + a = ⟨.E, 0, 1⟩ ∨ a = ⟨.E, -1, 0⟩ ∨ + a = ⟨.B, 1, 1⟩ ∨ a = ⟨.B, 0, 1⟩ ∨ + a = ⟨.D, -1, 0⟩ ∨ a = ⟨.D, -1, -1⟩ ∨ + a = ⟨.F, 0, -1⟩ ∨ a = ⟨.F, 1, 0⟩) := by + rcases htable with ⟨_, h⟩ | ⟨_, h⟩ + · rcases h with ⟨_, z⟩ | ⟨_, z⟩ | ⟨_, z⟩ + · rcases z with h | h <;> simp [h] + · rcases z with h | h <;> simp [h] + · rcases z with h | h <;> simp [h] + · rcases h with ⟨_, z⟩ | ⟨_, z⟩ | ⟨_, z⟩ + · rcases z with h | h <;> simp [h] + · rcases z with h | h <;> simp [h] + · rcases z with h | h <;> simp [h] + exact ⟨e, hxe, he, + htable, + BandOrderedGeneralSelectedContactRowExists q cfg C0 T cert a b haExterior hcentral ⟨e, he⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalRows.lean new file mode 100644 index 0000000000..1ad5ef3971 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalRows.lean @@ -0,0 +1,188 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + + +-- [TABLET NODE: BandOrderedGeneralSubtileCanonicalRows] + +/-! +# BandOrderedGeneralSubtileCanonicalRows + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralSubtileCanonicalRows + (P : Fin 3 → Bool → ProtoTile) (T : ProtoTile) + (u v : GaussianInt) (parentSlot : Fin 3) (turn : Fin 4) + (edge incoming outgoing : Fin 3 → GaussianInt) + (hsuper : edge 0 + edge 1 + edge 2 = 0) + (hin0 : incoming 0 = edge 1 - (⟨0, 1⟩ : GaussianInt) * edge 2) + (hin1 : incoming 1 = edge 2 - (⟨0, 1⟩ : GaussianInt) * edge 0) + (hin2 : incoming 2 = edge 0 - (⟨0, 1⟩ : GaussianInt) * edge 1) + (hflip : ∀ j, outgoing j = (⟨0, 1⟩ : GaussianInt) * incoming j) + (hu : u = outgoing 0) (hv : v = outgoing 1) + (hcentroid : ∀ j e, + TileCentroid (P j e) - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • + ((1 / 2 : ℝ) • + (GaussianRealPoint (edge j) - + (-((GaussianRealPoint (edge j)).2), + (GaussianRealPoint (edge j)).1)))) : + let uIndex : PeriodicSubtileIndex := + if parentSlot = 0 then + if turn = 0 then ⟨.A, 0, -1⟩ + else if turn = 1 then ⟨.B, 1, 1⟩ + else if turn = 2 then ⟨.B, 0, 1⟩ + else ⟨.A, -1, -1⟩ + else if parentSlot = 1 then + if turn = 0 then ⟨.C, 1, 1⟩ + else if turn = 1 then ⟨.D, -1, 0⟩ + else if turn = 2 then ⟨.D, -1, -1⟩ + else ⟨.C, 1, 0⟩ + else + if turn = 0 then ⟨.E, -1, 0⟩ + else if turn = 1 then ⟨.F, 0, -1⟩ + else if turn = 2 then ⟨.F, 1, 0⟩ + else ⟨.E, 0, 1⟩ + let vIndex : PeriodicSubtileIndex := + if parentSlot = 0 then + if turn = 0 then ⟨.C, 1, 0⟩ + else if turn = 1 then ⟨.F, 1, 0⟩ + else if turn = 2 then ⟨.D, -1, 0⟩ + else ⟨.E, -1, 0⟩ + else if parentSlot = 1 then + if turn = 0 then ⟨.E, 0, 1⟩ + else if turn = 1 then ⟨.B, 0, 1⟩ + else if turn = 2 then ⟨.F, 0, -1⟩ + else ⟨.A, 0, -1⟩ + else + if turn = 0 then ⟨.A, -1, -1⟩ + else if turn = 1 then ⟨.D, -1, -1⟩ + else if turn = 2 then ⟨.B, 1, 1⟩ + else ⟨.C, 1, 1⟩ + let U := SubtileOccurrenceInterpretation P u v uIndex + let V := SubtileOccurrenceInterpretation P u v vIndex + TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ turn.val * + (incoming parentSlot + outgoing parentSlot)) ∧ + TileCentroid V - TileCentroid T = (1 / 2 : ℝ) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ turn.val * + (if Even turn.val then + incoming (parentSlot + 1) - outgoing (parentSlot + 1) + else + outgoing (parentSlot - 1) - incoming (parentSlot - 1))) := by +-- BODY + have hf0 := hflip 0 + have hf1 := hflip 1 + have hf2 := hflip 2 + have smul_fst (r : ℝ) (p : ℝ × ℝ) : (r • p).1 = r * p.1 := rfl + have smul_snd (r : ℝ) (p : ℝ × ℝ) : (r • p).2 = r * p.2 := rfl + have translatedCentroid (j : Fin 3) (e : Bool) (d z : GaussianInt) + (hz : (if e = true then (1 : GaussianInt) else -1) * + (edge j - (⟨0, 1⟩ : GaussianInt) * edge j) + 2 * d = z) : + TileCentroid (TileTranslation (P j e) d) - TileCentroid T = + (2 : ℝ)⁻¹ • GaussianRealPoint z := by + have hc := hcentroid j e + rw [(TileTranslationFormulas (P j e) d).2.2.2.2.1] + have hzre := congrArg (fun w : GaussianInt => w.re) hz + have hzim := congrArg (fun w : GaussianInt => w.im) hz + have hreInt : + ((if e = true then (1 : GaussianInt) else -1) * + (edge j - (⟨0, 1⟩ : GaussianInt) * edge j)).re + + 2 * d.re = z.re := by simpa using hzre + have himInt : + ((if e = true then (1 : GaussianInt) else -1) * + (edge j - (⟨0, 1⟩ : GaussianInt) * edge j)).im + + 2 * d.im = z.im := by simpa using hzim + rw [Prod.ext_iff] at hc ⊢ + rcases hc with ⟨hc1, hc2⟩ + rw [Prod.fst_sub] at hc1 + rw [Prod.snd_sub] at hc2 + rw [Prod.fst_sub, Prod.snd_sub] + rw [smul_fst] at hc1 ⊢ + rw [smul_snd] at hc2 ⊢ + fin_cases e + · simp? at hreInt himInt + norm_num only [Bool.true_eq, ↓reduceIte, GaussianRealPoint] at hc1 hc2 ⊢ + dsimp at hc1 hc2 ⊢ + constructor + · have hre : ((edge j).re : ℝ) + ((edge j).im : ℝ) + + 2 * (d.re : ℝ) = (z.re : ℝ) := by exact_mod_cast hreInt + linarith + · have him : ((edge j).im : ℝ) - ((edge j).re : ℝ) + + 2 * (d.im : ℝ) = (z.im : ℝ) := by exact_mod_cast himInt + linarith + · simp? at hreInt himInt + norm_num only [Bool.false_eq_true, ↓reduceIte, GaussianRealPoint] at hc1 hc2 ⊢ + dsimp at hc1 hc2 ⊢ + constructor + · have hre : -((edge j).im : ℝ) - ((edge j).re : ℝ) + + 2 * (d.re : ℝ) = (z.re : ℝ) := by exact_mod_cast hreInt + linarith + · have him : ((edge j).re : ℝ) - ((edge j).im : ℝ) + + 2 * (d.im : ℝ) = (z.im : ℝ) := by exact_mod_cast himInt + linarith + have hsre := congrArg (fun z : GaussianInt => z.re) hsuper + have hsim := congrArg (fun z : GaussianInt => z.im) hsuper + have h0re := congrArg (fun z : GaussianInt => z.re) hin0 + have h0im := congrArg (fun z : GaussianInt => z.im) hin0 + have h1re := congrArg (fun z : GaussianInt => z.re) hin1 + have h1im := congrArg (fun z : GaussianInt => z.im) hin1 + have h2re := congrArg (fun z : GaussianInt => z.re) hin2 + have h2im := congrArg (fun z : GaussianInt => z.im) hin2 + have f0re := congrArg (fun z : GaussianInt => z.re) hf0 + have f0im := congrArg (fun z : GaussianInt => z.im) hf0 + have f1re := congrArg (fun z : GaussianInt => z.re) hf1 + have f1im := congrArg (fun z : GaussianInt => z.im) hf1 + have f2re := congrArg (fun z : GaussianInt => z.re) hf2 + have f2im := congrArg (fun z : GaussianInt => z.im) hf2 + have even0 : Even 0 := ⟨0, rfl⟩ + have notEven1 : ¬ Even 1 := by + rintro ⟨r, hr⟩ + omega + have even2 : Even 2 := ⟨1, rfl⟩ + have notEven3 : ¬ Even 3 := by + rintro ⟨r, hr⟩ + omega + generalize hp : parentSlot = ps + generalize ht : turn = t + fin_cases ps <;> + fin_cases t <;> + simp only [] <;> + norm_num + all_goals + focus + refine ⟨?_, ?_⟩ + · simp? [SubtileOccurrenceInterpretation] + norm_num + rw [one_div] + apply translatedCentroid + apply Zsqrtd.ext <;> + simp [hu, hv, pow_succ, + ] at hsre hsim h0re h0im h1re h1im h2re h2im f0re f0im f1re f1im f2re f2im ⊢ <;> + omega + · simp? [SubtileOccurrenceInterpretation] + norm_num + rw [one_div] + apply translatedCentroid + apply Zsqrtd.ext <;> + simp [hu, hv, Fin.neg_def, pow_succ, + notEven3] at hsre hsim h0re h0im h1re h1im h2re h2im f0re f0im f1re f1im f2re f2im ⊢ <;> + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean new file mode 100644 index 0000000000..c15e863340 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean @@ -0,0 +1,452 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + + +-- [TABLET NODE: BandOrderedGeneralSubtileCanonicalSeparation] + +/-! +# BandOrderedGeneralSubtileCanonicalSeparation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +private theorem rowSeparation + (parentSlot : Fin 3) + (turn : Fin 4) + (uIndex : PeriodicSubtileIndex) + (uBar : PeriodicSubtileIndex) + (vIndex : PeriodicSubtileIndex) + (vBar : PeriodicSubtileIndex) + (wBlock : Int × Int) + (hrow : (parentSlot = 0 ∧ turn = 0 ∧ + uIndex = ⟨.A, 0, -1⟩ ∧ uBar = ⟨.B, 1, 1⟩ ∧ + wBlock = (1, 0) ∧ vIndex = ⟨.C, 1, 0⟩ ∧ vBar = ⟨.C, 1, 1⟩) ∨ + (parentSlot = 0 ∧ turn = 1 ∧ + uIndex = ⟨.B, 1, 1⟩ ∧ uBar = ⟨.B, 0, 1⟩ ∧ + wBlock = (-1, 0) ∧ vIndex = ⟨.F, 1, 0⟩ ∧ vBar = ⟨.E, 0, 1⟩) ∨ + (parentSlot = 0 ∧ turn = 2 ∧ + uIndex = ⟨.B, 0, 1⟩ ∧ uBar = ⟨.A, -1, -1⟩ ∧ + wBlock = (-1, 0) ∧ vIndex = ⟨.D, -1, 0⟩ ∧ vBar = ⟨.D, -1, -1⟩) ∨ + (parentSlot = 0 ∧ turn = 3 ∧ + uIndex = ⟨.A, -1, -1⟩ ∧ uBar = ⟨.A, 0, -1⟩ ∧ + wBlock = (1, 0) ∧ vIndex = ⟨.E, -1, 0⟩ ∧ vBar = ⟨.F, 0, -1⟩) ∨ + (parentSlot = 1 ∧ turn = 0 ∧ + uIndex = ⟨.C, 1, 1⟩ ∧ uBar = ⟨.D, -1, 0⟩ ∧ + wBlock = (0, 1) ∧ vIndex = ⟨.E, 0, 1⟩ ∧ vBar = ⟨.E, -1, 0⟩) ∨ + (parentSlot = 1 ∧ turn = 1 ∧ + uIndex = ⟨.D, -1, 0⟩ ∧ uBar = ⟨.D, -1, -1⟩ ∧ + wBlock = (0, -1) ∧ vIndex = ⟨.B, 0, 1⟩ ∧ vBar = ⟨.A, -1, -1⟩) ∨ + (parentSlot = 1 ∧ turn = 2 ∧ + uIndex = ⟨.D, -1, -1⟩ ∧ uBar = ⟨.C, 1, 0⟩ ∧ + wBlock = (0, -1) ∧ vIndex = ⟨.F, 0, -1⟩ ∧ vBar = ⟨.F, 1, 0⟩) ∨ + (parentSlot = 1 ∧ turn = 3 ∧ + uIndex = ⟨.C, 1, 0⟩ ∧ uBar = ⟨.C, 1, 1⟩ ∧ + wBlock = (0, 1) ∧ vIndex = ⟨.A, 0, -1⟩ ∧ vBar = ⟨.B, 1, 1⟩) ∨ + (parentSlot = 2 ∧ turn = 0 ∧ + uIndex = ⟨.E, -1, 0⟩ ∧ uBar = ⟨.F, 0, -1⟩ ∧ + wBlock = (-1, -1) ∧ vIndex = ⟨.A, -1, -1⟩ ∧ vBar = ⟨.A, 0, -1⟩) ∨ + (parentSlot = 2 ∧ turn = 1 ∧ + uIndex = ⟨.F, 0, -1⟩ ∧ uBar = ⟨.F, 1, 0⟩ ∧ + wBlock = (1, 1) ∧ vIndex = ⟨.D, -1, -1⟩ ∧ vBar = ⟨.C, 1, 0⟩) ∨ + (parentSlot = 2 ∧ turn = 2 ∧ + uIndex = ⟨.F, 1, 0⟩ ∧ uBar = ⟨.E, 0, 1⟩ ∧ + wBlock = (1, 1) ∧ vIndex = ⟨.B, 1, 1⟩ ∧ vBar = ⟨.B, 0, 1⟩) ∨ + (parentSlot = 2 ∧ turn = 3 ∧ + uIndex = ⟨.E, 0, 1⟩ ∧ uBar = ⟨.E, -1, 0⟩ ∧ + wBlock = (-1, -1) ∧ vIndex = ⟨.C, 1, 1⟩ ∧ vBar = ⟨.D, -1, 0⟩)) : + (0, 0) ≠ wBlock ∧ + (uIndex.first, uIndex.second) ≠ (0, 0) ∧ + (uBar.first, uBar.second) ≠ wBlock ∧ + (vIndex.first, vIndex.second) ≠ (0, 0) ∧ + uBar ≠ vBar ∧ + ¬ ((uBar.label = .A ∧ vBar.label = .B ∨ + uBar.label = .B ∧ vBar.label = .A) ∧ + uBar.first = vBar.first ∧ uBar.second = vBar.second) ∧ + wBlock ≠ (vBar.first, vBar.second) := by + rcases hrow with h | h | h | h | h | h | h | h | h | h | h | h + all_goals + rcases h with ⟨_, _, rfl, rfl, rfl, rfl, rfl⟩ + decide + +namespace GeneralSeparationProof + +private theorem occurrence_subset_block : + ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (O : ProtoTile), ∀ (T : ProtoTile), ∀ (u : GaussianInt), + ∀ (v : GaussianInt), (O.cells ⊆ (P (0 : Fin (3 : ℕ)) false).cells) → ((∀ (m : ℤ), ∀ (n : + ℤ), ∀ (z : LatticeCell), z ∈ (TileTranslation T ((↑m : GaussianInt) * u + (↑n : + GaussianInt) * v)).cells ↔ ∃ (label : SixSubtileLabel), z ∈ + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨label, m, n⟩).cells) → (∀ (o : + PeriodicSubtileIndex), (SubtileOccurrenceInterpretation P u v o).cells ⊆ + (TileTranslation + T ((↑o.first : GaussianInt) * u + (↑o.second : GaussianInt) * v)).cells)) := by + classical + intro P O T u v hOB hBlockCells o z hz + apply (hBlockCells o.first o.second z).2 + cases o with + | mk label m n => + cases label with + | A => + change z ∈ (TileTranslation (P 0 true) + ((m : GaussianInt) * u + (n : GaussianInt) * v)).cells at hz + rw [(TileTranslationFormulas _ _).1] at hz + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hz + by_cases hyO : y ∈ O.cells + · refine ⟨.B, ?_⟩ + change GaussianTranslation _ y ∈ + (TileTranslation (P 0 false) _).cells + rw [(TileTranslationFormulas _ _).1] + exact Finset.mem_image.mpr ⟨y, hOB hyO, rfl⟩ + · refine ⟨.A, ?_⟩ + change GaussianTranslation _ y ∈ + (TileTranslation (TileCellComplement (P 0 true) O) _).cells + rw [(TileTranslationFormulas _ _).1] + exact Finset.mem_image.mpr ⟨y, Finset.mem_sdiff.mpr ⟨hy, hyO⟩, rfl⟩ + | B => + refine ⟨.B, ?_⟩ + simpa [SubtileOccurrenceInterpretation, + ModifiedSubtileOccurrenceInterpretation] using hz + | C => + refine ⟨.C, ?_⟩ + simpa [SubtileOccurrenceInterpretation, + ModifiedSubtileOccurrenceInterpretation] using hz + | D => + refine ⟨.D, ?_⟩ + simpa [SubtileOccurrenceInterpretation, + ModifiedSubtileOccurrenceInterpretation] using hz + | E => + refine ⟨.E, ?_⟩ + simpa [SubtileOccurrenceInterpretation, + ModifiedSubtileOccurrenceInterpretation] using hz + | F => + refine ⟨.F, ?_⟩ + simpa [SubtileOccurrenceInterpretation, + ModifiedSubtileOccurrenceInterpretation] using hz + +private theorem root_occurrence_disjoint : + ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (O : ProtoTile), ∀ (T : ProtoTile), ∀ (W : ProtoTile), ∀ + (u : GaussianInt), ∀ (v : GaussianInt), ∀ (g : GaussianInt), ∀ (wShift : GaussianInt), ∀ + (wBlock : Int × Int), (LatticeTile T) → ((∀ (m : ℤ), ∀ (n : ℤ), ∀ (z : LatticeCell), z ∈ + (TileTranslation T ((↑m : GaussianInt) * u + (↑n : GaussianInt) * v)).cells ↔ ∃ (label : + SixSubtileLabel), z ∈ (ModifiedSubtileOccurrenceInterpretation P O u v ⟨label, m, + n⟩).cells) → ((∀ (m : ℤ), ∀ (n : ℤ), ∀ (r : ℤ), ∀ (s : ℤ), (m, n) ≠ (r, s) → Disjoint + (TileTranslation T ((↑m : GaussianInt) * u + (↑n : GaussianInt) * v)).cells + (TileTranslation T ((↑r : GaussianInt) * u + (↑s : GaussianInt) * v)).cells) → ((W = + TileTranslation T wShift) → (((TileTranslation (TileQuarterTurn T) g).cells = T.cells) → + (((TileTranslation (TileQuarterTurn W) g).cells = (TileTranslation T ((↑wBlock.1 : + GaussianInt) * u + (↑wBlock.2 : GaussianInt) * v)).cells) → ((LatticeTile T) → ((∀ (m : + ℤ), ∀ (n : ℤ), ∀ (r : ℤ), ∀ (s : ℤ), (m, n) ≠ (r, s) → Disjoint (TileTranslation T + ((↑m : + GaussianInt) * u + (↑n : GaussianInt) * v)).cells (TileTranslation T ((↑r : GaussianInt) + * u + (↑s : GaussianInt) * v)).cells) → ((∀ (o : PeriodicSubtileIndex), + (SubtileOccurrenceInterpretation P u v o).cells ⊆ (TileTranslation T ((o.first : + GaussianInt) * u + (o.second : GaussianInt) * v)).cells) → (∀ (o : PeriodicSubtileIndex), + (o.first, o.second) ≠ ((0 : ℤ), (0 : ℤ)) → Disjoint T.cells + (SubtileOccurrenceInterpretation P u v o).cells))))))))) := by + classical + intro P O T W u v g wShift wBlock hRootLattice hBlockCells hBlockDisjoint hW hrootBar hWBar + hTlattice hblocks occurrence_subset_block o hnonzero + have h := hblocks 0 0 o.first o.second (by + intro heq + exact hnonzero heq.symm) + have hzero : (TileTranslation T 0).cells = T.cells := by + have ht : TileTranslation T 0 = T := by + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · ext z + simp [GaussianTranslation] + · simp [GaussianTranslation] + exact congrArg ProtoTile.cells ht + rw [← hzero] + simpa using h.mono_right (occurrence_subset_block o) + +private theorem turn_map_injective : + ∀ (g : GaussianInt), Function.Injective (fun z : LatticeCell => GaussianTranslation g + (GaussianQuarterTurn z - 1)) := by + classical + intro g a b hab + apply Zsqrtd.ext + · have him := congrArg (fun z : GaussianInt => z.im) hab + simp [GaussianTranslation, GaussianQuarterTurn] at him + omega + · have hre := congrArg (fun z : GaussianInt => z.re) hab + simp [GaussianTranslation, GaussianQuarterTurn] at hre + omega + +private theorem hrootW : + ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (O : ProtoTile), ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ + (W : ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (g : GaussianInt), ∀ (wShift + : GaussianInt), ∀ (parentSlot : Fin 3), ∀ (turn : Fin 4), ∀ (uIndex : + PeriodicSubtileIndex), ∀ (uBar : PeriodicSubtileIndex), ∀ (vIndex : + PeriodicSubtileIndex), ∀ (vBar : PeriodicSubtileIndex), ∀ (wBlock : Int × Int), + (parentSlot = (0 : Fin (3 : ℕ)) ∧ turn = (0 : Fin (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.A, + (0 : ℤ), (-1 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ ∧ wBlock = ((1 : ℤ), (0 + : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.C, (1 : + ℤ), (1 : ℤ)⟩ ∨ parentSlot = (0 : Fin (3 : ℕ)) ∧ turn = (1 : Fin (4 : ℕ)) ∧ uIndex = + ⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ ∧ + wBlock = ((-1 : ℤ), (0 : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ ∧ vBar = + ⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ ∨ parentSlot = (0 : Fin (3 : ℕ)) ∧ turn = (2 : Fin + (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.A, + (-1 : ℤ), (-1 : ℤ)⟩ ∧ wBlock = ((-1 : ℤ), (0 : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.D, (-1 : + ℤ), (0 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ ∨ parentSlot = (0 : Fin (3 + : ℕ)) ∧ turn = (3 : Fin (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ ∧ + uBar = ⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ ∧ wBlock = ((1 : ℤ), (0 : ℤ)) ∧ vIndex = + ⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ ∨ + parentSlot = (1 : Fin (3 : ℕ)) ∧ turn = (0 : Fin (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.C, + (1 : ℤ), (1 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ ∧ wBlock = ((0 : ℤ), (1 + : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.E, (-1 : + ℤ), (0 : ℤ)⟩ ∨ parentSlot = (1 : Fin (3 : ℕ)) ∧ turn = (1 : Fin (4 : ℕ)) ∧ uIndex = + ⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ ∧ + wBlock = ((0 : ℤ), (-1 : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ ∧ vBar = + ⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ ∨ parentSlot = (1 : Fin (3 : ℕ)) ∧ turn = (2 : + Fin (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ ∧ uBar = + ⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ ∧ wBlock = ((0 : ℤ), (-1 : ℤ)) ∧ vIndex = + ⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ ∨ + parentSlot = (1 : Fin (3 : ℕ)) ∧ turn = (3 : Fin (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.C, + (1 : ℤ), (0 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ ∧ wBlock = ((0 : ℤ), (1 + : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.B, (1 : + ℤ), (1 : ℤ)⟩ ∨ parentSlot = (2 : Fin (3 : ℕ)) ∧ turn = (0 : Fin (4 : ℕ)) ∧ uIndex = + ⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ ∧ + wBlock = ((-1 : ℤ), (-1 : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ ∧ vBar = + ⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ ∨ parentSlot = (2 : Fin (3 : ℕ)) ∧ turn = (1 : Fin + (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.F, + (1 : ℤ), (0 : ℤ)⟩ ∧ wBlock = ((1 : ℤ), (1 : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.D, (-1 : ℤ), + (-1 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ ∨ parentSlot = (2 : Fin (3 : ℕ)) + ∧ turn = (2 : Fin (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ ∧ uBar = + ⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ ∧ wBlock = ((1 : ℤ), (1 : ℤ)) ∧ vIndex = + ⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ ∨ + parentSlot = (2 : Fin (3 : ℕ)) ∧ turn = (3 : Fin (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.E, + (0 : ℤ), (1 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ ∧ wBlock = ((-1 : ℤ), + (-1 : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.D, + (-1 : ℤ), (0 : ℤ)⟩) → ((LatticeTile T) → ((∀ (m : ℤ), ∀ (n : ℤ), ∀ (z : LatticeCell), z ∈ + (TileTranslation T ((↑m : GaussianInt) * u + (↑n : GaussianInt) * v)).cells ↔ ∃ (label : + SixSubtileLabel), z ∈ (ModifiedSubtileOccurrenceInterpretation P O u v ⟨label, m, + n⟩).cells) → ((∀ (m : ℤ), ∀ (n : ℤ), ∀ (r : ℤ), ∀ (s : ℤ), (m, n) ≠ (r, s) → Disjoint + (TileTranslation T ((↑m : GaussianInt) * u + (↑n : GaussianInt) * v)).cells + (TileTranslation T ((↑r : GaussianInt) * u + (↑s : GaussianInt) * v)).cells) → ((W = + TileTranslation T wShift) → (((TileTranslation (TileQuarterTurn T) g).cells = T.cells) → + (((TileTranslation (TileQuarterTurn W) g).cells = (TileTranslation T ((↑wBlock.1 : + GaussianInt) * u + (↑wBlock.2 : GaussianInt) * v)).cells) → ((LatticeTile T) → ((∀ (m : + ℤ), ∀ (n : ℤ), ∀ (r : ℤ), ∀ (s : ℤ), (m, n) ≠ (r, s) → Disjoint (TileTranslation T + ((↑m : + GaussianInt) * u + (↑n : GaussianInt) * v)).cells (TileTranslation T ((↑r : GaussianInt) + * u + (↑s : GaussianInt) * v)).cells) → ((∀ (o : PeriodicSubtileIndex), + (SubtileOccurrenceInterpretation P u v o).cells ⊆ (TileTranslation T ((o.first : + GaussianInt) * u + (o.second : GaussianInt) * v)).cells) → ((∀ (o : + PeriodicSubtileIndex), ((o.first, o.second) ≠ (0, 0)) → (Disjoint T.cells + (SubtileOccurrenceInterpretation P u v o).cells)) → ((∀ (A : ProtoTile), ∀ (B : + ProtoTile), (Disjoint (TileTranslation (TileQuarterTurn A) g).cells (TileTranslation + (TileQuarterTurn B) g).cells) → (Disjoint A.cells B.cells)) → ((Disjoint T.cells U.cells) + → (Disjoint T.cells W.cells))))))))))))) := by + classical + intro P O T U W u v g wShift parentSlot turn uIndex uBar vIndex vBar wBlock hrow hRootLattice + hBlockCells hBlockDisjoint hW hrootBar hWBar hTlattice hblocks occurrence_subset_block + root_occurrence_disjoint pull_disjoint hrootfixed + apply pull_disjoint + rw [hrootBar, hWBar] + have h := hblocks 0 0 wBlock.1 wBlock.2 (by + exact (rowSeparation parentSlot turn uIndex uBar vIndex vBar wBlock hrow).1) + have hzero : (TileTranslation T 0).cells = T.cells := by + have ht : TileTranslation T 0 = T := by + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · ext z + simp [GaussianTranslation] + · simp [GaussianTranslation] + exact congrArg ProtoTile.cells ht + simpa [hzero] using h + +end GeneralSeparationProof + +theorem BandOrderedGeneralSubtileCanonicalSeparation + (P : Fin 3 → Bool → ProtoTile) (O T U W V : ProtoTile) + (u v g wShift : GaussianInt) (parentSlot : Fin 3) (turn : Fin 4) + (uIndex uBar vIndex vBar : PeriodicSubtileIndex) + (wBlock : Int × Int) + (hrow : + (parentSlot = 0 ∧ turn = 0 ∧ + uIndex = ⟨.A, 0, -1⟩ ∧ uBar = ⟨.B, 1, 1⟩ ∧ + wBlock = (1, 0) ∧ vIndex = ⟨.C, 1, 0⟩ ∧ vBar = ⟨.C, 1, 1⟩) ∨ + (parentSlot = 0 ∧ turn = 1 ∧ + uIndex = ⟨.B, 1, 1⟩ ∧ uBar = ⟨.B, 0, 1⟩ ∧ + wBlock = (-1, 0) ∧ vIndex = ⟨.F, 1, 0⟩ ∧ vBar = ⟨.E, 0, 1⟩) ∨ + (parentSlot = 0 ∧ turn = 2 ∧ + uIndex = ⟨.B, 0, 1⟩ ∧ uBar = ⟨.A, -1, -1⟩ ∧ + wBlock = (-1, 0) ∧ vIndex = ⟨.D, -1, 0⟩ ∧ vBar = ⟨.D, -1, -1⟩) ∨ + (parentSlot = 0 ∧ turn = 3 ∧ + uIndex = ⟨.A, -1, -1⟩ ∧ uBar = ⟨.A, 0, -1⟩ ∧ + wBlock = (1, 0) ∧ vIndex = ⟨.E, -1, 0⟩ ∧ vBar = ⟨.F, 0, -1⟩) ∨ + (parentSlot = 1 ∧ turn = 0 ∧ + uIndex = ⟨.C, 1, 1⟩ ∧ uBar = ⟨.D, -1, 0⟩ ∧ + wBlock = (0, 1) ∧ vIndex = ⟨.E, 0, 1⟩ ∧ vBar = ⟨.E, -1, 0⟩) ∨ + (parentSlot = 1 ∧ turn = 1 ∧ + uIndex = ⟨.D, -1, 0⟩ ∧ uBar = ⟨.D, -1, -1⟩ ∧ + wBlock = (0, -1) ∧ vIndex = ⟨.B, 0, 1⟩ ∧ vBar = ⟨.A, -1, -1⟩) ∨ + (parentSlot = 1 ∧ turn = 2 ∧ + uIndex = ⟨.D, -1, -1⟩ ∧ uBar = ⟨.C, 1, 0⟩ ∧ + wBlock = (0, -1) ∧ vIndex = ⟨.F, 0, -1⟩ ∧ vBar = ⟨.F, 1, 0⟩) ∨ + (parentSlot = 1 ∧ turn = 3 ∧ + uIndex = ⟨.C, 1, 0⟩ ∧ uBar = ⟨.C, 1, 1⟩ ∧ + wBlock = (0, 1) ∧ vIndex = ⟨.A, 0, -1⟩ ∧ vBar = ⟨.B, 1, 1⟩) ∨ + (parentSlot = 2 ∧ turn = 0 ∧ + uIndex = ⟨.E, -1, 0⟩ ∧ uBar = ⟨.F, 0, -1⟩ ∧ + wBlock = (-1, -1) ∧ vIndex = ⟨.A, -1, -1⟩ ∧ vBar = ⟨.A, 0, -1⟩) ∨ + (parentSlot = 2 ∧ turn = 1 ∧ + uIndex = ⟨.F, 0, -1⟩ ∧ uBar = ⟨.F, 1, 0⟩ ∧ + wBlock = (1, 1) ∧ vIndex = ⟨.D, -1, -1⟩ ∧ vBar = ⟨.C, 1, 0⟩) ∨ + (parentSlot = 2 ∧ turn = 2 ∧ + uIndex = ⟨.F, 1, 0⟩ ∧ uBar = ⟨.E, 0, 1⟩ ∧ + wBlock = (1, 1) ∧ vIndex = ⟨.B, 1, 1⟩ ∧ vBar = ⟨.B, 0, 1⟩) ∨ + (parentSlot = 2 ∧ turn = 3 ∧ + uIndex = ⟨.E, 0, 1⟩ ∧ uBar = ⟨.E, -1, 0⟩ ∧ + wBlock = (-1, -1) ∧ vIndex = ⟨.C, 1, 1⟩ ∧ vBar = ⟨.D, -1, 0⟩)) + (hRootLattice : LatticeTile T) + (hParentLattice : ∀ j e, LatticeTile (P j e)) + (hOA : O.cells ⊆ (P 0 true).cells) + (hOB : O.cells ⊆ (P 0 false).cells) + (hpartition : ∀ z : LatticeCell, ∃! o : PeriodicSubtileIndex, + z ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells) + (hBlockCells : ∀ m n : Int, ∀ z : LatticeCell, + (z ∈ (TileTranslation T + ((m : GaussianInt) * u + (n : GaussianInt) * v)).cells ↔ + ∃ label : SixSubtileLabel, + z ∈ (ModifiedSubtileOccurrenceInterpretation P O u v + ⟨label, m, n⟩).cells)) + (hBlockDisjoint : ∀ m n r s : Int, (m, n) ≠ (r, s) → + Disjoint + (TileTranslation T + ((m : GaussianInt) * u + (n : GaussianInt) * v)).cells + (TileTranslation T + ((r : GaussianInt) * u + (s : GaussianInt) * v)).cells) + (hfixedSource : U.cells = + (SubtileOccurrenceInterpretation P u v uIndex).cells) + (hVSource : V.cells = + (SubtileOccurrenceInterpretation P u v vIndex).cells) + (hW : W = TileTranslation T wShift) + (hrootBar : (TileTranslation (TileQuarterTurn T) g).cells = T.cells) + (hfixedBar : (TileTranslation (TileQuarterTurn U) g).cells = + (SubtileOccurrenceInterpretation P u v uBar).cells) + (hWBar : (TileTranslation (TileQuarterTurn W) g).cells = + (TileTranslation T + ((wBlock.1 : GaussianInt) * u + (wBlock.2 : GaussianInt) * v)).cells) + (hVBar : (TileTranslation (TileQuarterTurn V) g).cells = + (SubtileOccurrenceInterpretation P u v vBar).cells) : + LatticeTile T ∧ LatticeTile U ∧ LatticeTile W ∧ LatticeTile V ∧ + Disjoint T.cells U.cells ∧ Disjoint T.cells W.cells ∧ + Disjoint U.cells W.cells ∧ Disjoint T.cells V.cells ∧ + Disjoint U.cells V.cells ∧ + Disjoint W.cells V.cells := by +-- BODY + classical + have hTlattice : LatticeTile T := hRootLattice + have occurrence_lattice (o : PeriodicSubtileIndex) : + LatticeTile (SubtileOccurrenceInterpretation P u v o) := by + cases o with + | mk label m n => + cases label <;> + exact (TileDiskAreaCovariance _ + ((m : GaussianInt) * u + (n : GaussianInt) * v)).1.mp + (hParentLattice _ _) + have lattice_of_cells_eq (A B : ProtoTile) (h : A.cells = B.cells) + (hB : LatticeTile B) : LatticeTile A := by + change TopologicalDisk (TileRealization A) + rw [show TileRealization A = TileRealization B by + simp only [TileRealization, h]] + exact hB + have hfixedLattice : LatticeTile U := + lattice_of_cells_eq _ _ hfixedSource (by + simpa using occurrence_lattice uIndex) + have hWLattice : LatticeTile W := by + rw [hW] + exact (TileDiskAreaCovariance T wShift).1.mp hTlattice + have hVLattice : LatticeTile V := + lattice_of_cells_eq _ _ hVSource (by + simpa using occurrence_lattice vIndex) + have hblocks := hBlockDisjoint + have horiginal := (BandOriginalPairSeparation P O u v + hOA hOB hpartition).2 + have occurrence_subset_block (o : PeriodicSubtileIndex) : + (SubtileOccurrenceInterpretation P u v o).cells ⊆ + (TileTranslation T + ((o.first : GaussianInt) * u + (o.second : GaussianInt) * v)).cells := + GeneralSeparationProof.occurrence_subset_block P O T u v hOB hBlockCells o + have disjoint_of_blocks (a b : PeriodicSubtileIndex) + (hcoord : (a.first, a.second) ≠ (b.first, b.second)) : + Disjoint (SubtileOccurrenceInterpretation P u v a).cells + (SubtileOccurrenceInterpretation P u v b).cells := by + apply Finset.disjoint_left.2 + intro z hza hzb + exact (Finset.disjoint_left.1 (hblocks a.first a.second b.first b.second hcoord) + (occurrence_subset_block a hza) (occurrence_subset_block b hzb)) + have root_occurrence_disjoint (o : PeriodicSubtileIndex) + (hnonzero : (o.first, o.second) ≠ (0, 0)) : + Disjoint T.cells (SubtileOccurrenceInterpretation P u v o).cells := + GeneralSeparationProof.root_occurrence_disjoint P O T W u v g wShift wBlock + hRootLattice hBlockCells hBlockDisjoint hW hrootBar hWBar hTlattice hblocks + occurrence_subset_block o hnonzero + have turn_map_injective : Function.Injective (fun z : LatticeCell => + GaussianTranslation g (GaussianQuarterTurn z - 1)) := + GeneralSeparationProof.turn_map_injective g + have turn_mem (A : ProtoTile) (z : LatticeCell) (hz : z ∈ A.cells) : + GaussianTranslation g (GaussianQuarterTurn z - 1) ∈ + (TileTranslation (TileQuarterTurn A) g).cells := by + rw [(TileTranslationFormulas _ _).1, (TileQuarterTurnFormulas A).1] + exact Finset.mem_image.mpr ⟨_, Finset.mem_image.mpr ⟨z, hz, rfl⟩, rfl⟩ + have pull_disjoint (A B : ProtoTile) + (h : Disjoint (TileTranslation (TileQuarterTurn A) g).cells + (TileTranslation (TileQuarterTurn B) g).cells) : + Disjoint A.cells B.cells := by + rw [Finset.disjoint_left] at h ⊢ + intro z hzA hzB + exact h (turn_mem A z hzA) (turn_mem B z hzB) + have hrootfixed : Disjoint T.cells U.cells := by + rw [hfixedSource] + simpa using root_occurrence_disjoint uIndex (by + exact (rowSeparation parentSlot turn uIndex uBar vIndex vBar wBlock hrow).2.1) + have hrootW : Disjoint T.cells W.cells := GeneralSeparationProof.hrootW P O T U W u v g wShift + parentSlot turn uIndex uBar vIndex vBar wBlock hrow hRootLattice hBlockCells hBlockDisjoint + hW hrootBar hWBar hTlattice hblocks occurrence_subset_block root_occurrence_disjoint + pull_disjoint hrootfixed + have hfixedW : Disjoint U.cells W.cells := by + apply pull_disjoint + rw [hfixedBar, hWBar] + exact (hblocks uBar.first uBar.second wBlock.1 wBlock.2 (by + exact (rowSeparation parentSlot turn uIndex uBar vIndex vBar wBlock hrow).2.2.1)).mono + (occurrence_subset_block uBar) (by intro z hz; exact hz) + have hrootV : Disjoint T.cells V.cells := by + rw [hVSource] + simpa using root_occurrence_disjoint vIndex (by + exact (rowSeparation parentSlot turn uIndex uBar vIndex vBar wBlock hrow).2.2.2.1) + have hfixedV : Disjoint U.cells V.cells := by + apply pull_disjoint + rw [hfixedBar, hVBar] + apply horiginal uBar vBar + · exact (rowSeparation parentSlot turn uIndex uBar vIndex vBar wBlock hrow).2.2.2.2.1 + · exact (rowSeparation parentSlot turn uIndex uBar vIndex vBar wBlock hrow).2.2.2.2.2.1 + have hWV : Disjoint W.cells V.cells := by + apply pull_disjoint + rw [hWBar, hVBar] + exact (hblocks wBlock.1 wBlock.2 vBar.first vBar.second (by + exact (rowSeparation parentSlot turn uIndex uBar vIndex vBar wBlock + hrow).2.2.2.2.2.2)).mono (by intro z hz; exact hz) (occurrence_subset_block vBar) + exact ⟨hTlattice, hfixedLattice, hWLattice, hVLattice, + hrootfixed, hrootW, hfixedW, hrootV, hfixedV, hWV⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificate.lean new file mode 100644 index 0000000000..15dd117718 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificate.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileNormalizationCertificate +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: BandOrderedGeneralSubtileInterfaceCertificate] + +/-! +# BandOrderedGeneralSubtileInterfaceCertificate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Given a `BandOrderedGeneralSubtileNormalizationCertificate`, a +subtile interface certificate consists of two companion prototiles and two +literal `ExactTileInterfaceTriple` records on the same normalized +root--fixed pair. The normalized point lies on their complete common outer +interface. The two records have crossed distinguished endpoints. + +The certificate separately retains lattice-tile witnesses for the two outer +supports and both companions, all six pairwise cell-disjointness facts, and +literal `TouchingTriple` witnesses for the two endpoint triples. +Thus every geometric and topological fact about the original normalized +outer interface is fixed before any decomposition piece is selected. +-/ +structure BandOrderedGeneralSubtileInterfaceCertificate + {C₀ Cᵢ : BandCircle} {q : Fin 4 → CircleCoordinates} + {i : Fin 3} {T₀ Tᵢ : ProtoTile} + {h₀ hᵢ : PartialOdometer} {x : GaussianInt} + (normalization : BandOrderedGeneralSubtileNormalizationCertificate + C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x) where +-- BODY + /-- The literal third tile at the initial endpoint of the root-fixed interface. -/ + startCompanion : ProtoTile + /-- The literal third tile at the terminal endpoint of that same interface. -/ + endCompanion : ProtoTile + /-- The complete interface triple with its distinguished initial endpoint. -/ + startData : ExactTileInterfaceTriple normalization.normalizedRoot + normalization.normalizedFixed startCompanion + /-- The complete interface triple with the two root-fixed endpoints exchanged. -/ + endData : ExactTileInterfaceTriple normalization.normalizedRoot + normalization.normalizedFixed endCompanion + normalized_point_on_start_path : normalization.normalizedPoint ∈ + FootprintVertices normalization.normalizedRoot ∩ + FootprintVertices normalization.normalizedFixed + interface_endpoints : + endData.point = startData.otherAB ∧ endData.otherAB = startData.point + root_lattice : LatticeTile normalization.normalizedRoot + fixed_lattice : LatticeTile normalization.normalizedFixed + start_lattice : LatticeTile startCompanion + end_lattice : LatticeTile endCompanion + root_fixed_disjoint : + Disjoint normalization.normalizedRoot.cells normalization.normalizedFixed.cells + root_start_disjoint : + Disjoint normalization.normalizedRoot.cells startCompanion.cells + fixed_start_disjoint : + Disjoint normalization.normalizedFixed.cells startCompanion.cells + root_end_disjoint : + Disjoint normalization.normalizedRoot.cells endCompanion.cells + fixed_end_disjoint : + Disjoint normalization.normalizedFixed.cells endCompanion.cells + start_end_disjoint : Disjoint startCompanion.cells endCompanion.cells + start_touching : TouchingTriple normalization.normalizedRoot + normalization.normalizedFixed startCompanion + end_touching : TouchingTriple normalization.normalizedRoot + normalization.normalizedFixed endCompanion + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean new file mode 100644 index 0000000000..5742ba7897 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean @@ -0,0 +1,2393 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileInterfaceCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileCanonicalRows +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileCanonicalSeparation +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMixedAggregatePatches +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleLatticeTouching +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleRetargetMiddle +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleSwapLast +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + + +-- [TABLET NODE: BandOrderedGeneralSubtileInterfaceCertificateExists] + +/-! +# BandOrderedGeneralSubtileInterfaceCertificateExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +private def subtileOccurrenceLabel (j : Fin 3) (e : Bool) : SixSubtileLabel := + match j, e with + | 0, true => .A + | 0, false => .B + | 1, true => .C + | 1, false => .D + | 2, true => .E + | 2, false => .F + +namespace SubtileInterfaceGeometry + +private theorem quarterSymmetricTranslation (A : ProtoTile) (d : GaussianInt) + (h : QuarterTurnSymmetric A) : QuarterTurnSymmetric (TileTranslation A d) := by + classical + intro p + rw [(TileTranslationFormulas A d).2.2.2.1, + (TileTranslationFormulas A d).2.2.2.2.1] + simp only [Set.mem_image] + constructor + · rintro ⟨y, hy, rfl⟩ + have hy' := (h y).mp hy + refine ⟨((TileCentroid A).1 - (y.2 - (TileCentroid A).2), + (TileCentroid A).2 + (y.1 - (TileCentroid A).1)), hy', ?_⟩ + apply Prod.ext <;> dsimp <;> ring + · rintro ⟨y, hy, heq⟩ + let z : Real × Real := (p.1 - d.re, p.2 - d.im) + refine ⟨z, ?_, ?_⟩ + · apply (h z).mpr + convert hy using 1 + apply Prod.ext <;> + have hcoord := congrArg (fun w => w.1) heq <;> + have hcoord2 := congrArg (fun w => w.2) heq <;> + dsimp [z] at hcoord hcoord2 ⊢ <;> linarith + · apply Prod.ext <;> dsimp [z] <;> ring + +private theorem centeredCompare (g : GaussianInt) (C : CircleCoordinates) (Y Z : ProtoTile) + (hY : BandPrototile C Y) (hZ : BandPrototile C Z) + (hsym : QuarterTurnSymmetric Y) + (hcent : TileCentroid (TileTranslation (TileQuarterTurn Y) g) = + TileCentroid Z) : + (TileTranslation (TileQuarterTurn Y) g).cells = Z.cells ∧ + ((TileTranslation (TileQuarterTurn Y) g).cells = ∅ → + (TileTranslation (TileQuarterTurn Y) g).anchor = Z.anchor) := by + classical + obtain ⟨k, hkreal, hkcells, hkanchor, hkfoot, hkcent⟩ := + QuarterTurnSymmetricCenteredTransport Y hsym + let Ytr := TileTranslation Y (g - k) + have htrband : BandPrototile C Ytr := + BandPrototileTranslation C Y (g - k) hY + have hcells : (TileTranslation (TileQuarterTurn Y) g).cells = Ytr.cells := by + dsimp [Ytr] + rw [(TileTranslationFormulas (TileQuarterTurn Y) g).1, + (TileTranslationFormulas Y (g - k)).1] + ext z + simp only [Finset.mem_image] + constructor + · rintro ⟨a, ha, rfl⟩ + have hy : GaussianTranslation k a ∈ Y.cells := by + rw [← hkcells, (TileTranslationFormulas (TileQuarterTurn Y) k).1] + exact Finset.mem_image.mpr ⟨a, ha, rfl⟩ + refine ⟨GaussianTranslation k a, hy, ?_⟩ + apply Zsqrtd.ext <;> simp [GaussianTranslation] + · rintro ⟨y, hy, rfl⟩ + have hy' : y ∈ (TileTranslation (TileQuarterTurn Y) k).cells := by + rw [hkcells] + exact hy + rw [(TileTranslationFormulas (TileQuarterTurn Y) k).1] at hy' + obtain ⟨a, ha, hay⟩ := Finset.mem_image.mp hy' + refine ⟨a, ha, ?_⟩ + have hre := congrArg (fun z : GaussianInt => z.re) hay + have him := congrArg (fun z : GaussianInt => z.im) hay + apply Zsqrtd.ext <;> + simp [GaussianTranslation] at hre him ⊢ <;> omega + have hanchor : (TileTranslation (TileQuarterTurn Y) g).cells = ∅ → + (TileTranslation (TileQuarterTurn Y) g).anchor = Ytr.anchor := by + intro he + have hkempty : (TileTranslation (TileQuarterTurn Y) k).cells = ∅ := by + rw [hkcells] + rw [hcells] at he + exact (TileTranslationFormulas Y (g - k)).2.2.1.mp he + have hyempty := (TileQuarterTurnFormulas Y).2.2.1.mp + ((TileTranslationFormulas (TileQuarterTurn Y) k).2.2.1.mp hkempty) + have ha := hkanchor hyempty + dsimp [Ytr] + calc + (TileTranslation (TileQuarterTurn Y) g).anchor = + GaussianTranslation (g - k) + (TileTranslation (TileQuarterTurn Y) k).anchor := by + apply Zsqrtd.ext <;> + simp [TileTranslation, TileQuarterTurn, GaussianTranslation, + GaussianQuarterTurn] + _ = GaussianTranslation (g - k) Y.anchor := by rw [ha] + _ = (TileTranslation Y (g - k)).anchor := rfl + have hobs := ProtoTileObservableExtensionality + (TileTranslation (TileQuarterTurn Y) g) Ytr hcells hanchor + have hunique := BandPrototileCentroidUnique C Ytr Z htrband hZ + (hobs.2.2.2.2.symm.trans hcent) + exact ⟨hcells.trans hunique.1, fun he => + (hanchor he).trans (hunique.2 (hcells.symm.trans he))⟩ + +private theorem quarterTranslate (A : ProtoTile) (a d : GaussianInt) : + TileTranslation (TileQuarterTurn (TileTranslation A a)) d = + TileTranslation (TileTranslation (TileQuarterTurn A) d) + (GaussianQuarterTurn a) := by + classical + rcases A with ⟨cells, anchor⟩ + rw [ProtoTile.mk.injEq] + constructor + · ext z + simp only [TileTranslation, TileQuarterTurn, Finset.mem_image, + GaussianTranslation] + constructor + · rintro ⟨y, ⟨w, ⟨v, hv, rfl⟩, rfl⟩, rfl⟩ + refine ⟨GaussianQuarterTurn v - 1 + d, ?_, ?_⟩ + · exact ⟨GaussianQuarterTurn v - 1, ⟨v, hv, rfl⟩, rfl⟩ + · apply Zsqrtd.ext <;> + simp [GaussianQuarterTurn] <;> omega + · rintro ⟨y, ⟨w, ⟨v, hv, rfl⟩, rfl⟩, rfl⟩ + refine ⟨GaussianQuarterTurn (GaussianTranslation a v) - 1, + ⟨GaussianTranslation a v, ⟨v, hv, rfl⟩, rfl⟩, ?_⟩ + apply Zsqrtd.ext <;> + simp [GaussianQuarterTurn, GaussianTranslation] <;> omega + · ext <;> simp [TileTranslation, TileQuarterTurn, GaussianTranslation, + GaussianQuarterTurn] <;> omega + +end SubtileInterfaceGeometry + +namespace SubtileInterfacePreparation + +private theorem hin1 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let edge : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q ((j + 2).succ)) (Q ((j + 1).succ)) + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + let R : Fin 4 → CircleCoordinates := ![Q 0, Q 2, Q 3, Q 1] + (SemiProperQuadruple R) → (incoming 1 = edge 2 - (⟨0, 1⟩ : GaussianInt) * edge 0) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q edge incoming R hR + simpa [incoming, edge, R] using (VectorRecursionLaws R hR).2.2.1 + +private theorem hin2 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let edge : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q ((j + 2).succ)) (Q ((j + 1).succ)) + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + let R : Fin 4 → CircleCoordinates := ![Q 0, Q 2, Q 3, Q 1] + let S : Fin 4 → CircleCoordinates := ![R 0, R 2, R 3, R 1] + (SemiProperQuadruple S) → (incoming 2 = edge 0 - (⟨0, 1⟩ : GaussianInt) * edge 1) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q edge incoming R S hS + simpa [incoming, edge, R, S] using (VectorRecursionLaws S hS).2.2.1 + +private theorem hOA : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + normalization.layout.O.cells ⊆ (normalization.layout.P 0 true).cells ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization z hz + apply (normalization.layout.plus_union z).2 + exact ⟨0, false, by simpa [normalization.layout.precursor_eq] using hz⟩ + +private theorem hOB : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + normalization.layout.O.cells ⊆ (normalization.layout.P 0 false).cells ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization z hz + apply (normalization.layout.minus_union z).2 + exact ⟨0, true, by simpa [normalization.layout.precursor_cells] using hz⟩ + +private theorem occurrenceBand : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + ∀ (j : Fin 3), ∀ (e : Bool), ∀ (m : Int), ∀ (n : Int), BandPrototile (Q j.succ) + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v ⟨subtileOccurrenceLabel j e, m, n⟩) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q j e m n + fin_cases j <;> cases e <;> + simp? [subtileOccurrenceLabel, Q, SubtileOccurrenceInterpretation] + all_goals first + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 0 false).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 0 true).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 1 false).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 1 true).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 2 false).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 2 true).1 + +private theorem occurrenceSymmetric : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), (∀ (A : + ProtoTile), ∀ (d : GaussianInt), (QuarterTurnSymmetric A) → (QuarterTurnSymmetric + (TileTranslation A d))) → (∀ (j : Fin 3), ∀ (e : Bool), ∀ (m : Int), ∀ (n : Int), + QuarterTurnSymmetric (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v ⟨subtileOccurrenceLabel j e, m, n⟩)) ) + := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization quarterSymmetricTranslation j e m n + fin_cases j <;> fin_cases e <;> + simpa [subtileOccurrenceLabel, SubtileOccurrenceInterpretation] using + quarterSymmetricTranslation _ + ((m : GaussianInt) * normalization.layout.u + + (n : GaussianInt) * normalization.layout.v) + (normalization.layout.parent_quarter_turn _ _) + +private theorem rotatedCentroid : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), ∀ (g : + GaussianInt), (GaussianRealPoint g = ((TileCentroid normalization.normalizedRoot).1 + + (TileCentroid normalization.normalizedRoot).2, (TileCentroid + normalization.normalizedRoot).2 - (TileCentroid normalization.normalizedRoot).1)) → + (∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (z : GaussianInt), (TileCentroid Y - + TileCentroid normalization.normalizedRoot = + (1 / 2 : Real) • GaussianRealPoint z) → ((TileCentroid Z - TileCentroid + normalization.normalizedRoot = + (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * z)) → (TileCentroid (TileTranslation + (TileQuarterTurn Y) g) = TileCentroid Z))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization g hg Y Z z hY hZ + rw [(TileTranslationFormulas (TileQuarterTurn Y) g).2.2.2.2.1, + (TileQuarterTurnFormulas Y).2.2.2.2.1] + have hgre := congrArg Prod.fst hg + have hgim := congrArg Prod.snd hg + dsimp [GaussianRealPoint] at hgre hgim + rw [Prod.ext_iff] at hY hZ ⊢ + rcases hY with ⟨hYre, hYim⟩ + rcases hZ with ⟨hZre, hZim⟩ + norm_num only [GaussianRealPoint, Prod.fst_sub, Prod.snd_sub, + Prod.smul_fst, Prod.smul_snd] at hYre hYim hZre hZim ⊢ + norm_num at hZre hZim + rw [← GaussianInt.intCast_im z] at hZre + rw [← GaussianInt.intCast_re z] at hZim + dsimp at hgre hgim hYre hYim hZre hZim ⊢ + constructor <;> linarith + +private theorem hout0 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + (∀ (j : Fin (3 : ℕ)), BandVectors.1 (Q (0 : Fin (4 : ℕ))) (Q j.succ) = (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (Q j.succ) (Q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 + (Q (0 : Fin (4 : ℕ))) (Q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (Q j.succ) (Q (0 : Fin (4 : ℕ)))) → ((⟨0, 1⟩ : GaussianInt) * incoming + 0 = normalization.layout.u) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming hflips + rw [← (hflips 0).1] + simpa [Q] using normalization.layout.period_u.symm + +private theorem hout1 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + (∀ (j : Fin (3 : ℕ)), BandVectors.1 (Q (0 : Fin (4 : ℕ))) (Q j.succ) = (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (Q j.succ) (Q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 + (Q (0 : Fin (4 : ℕ))) (Q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (Q j.succ) (Q (0 : Fin (4 : ℕ)))) → ((⟨0, 1⟩ : GaussianInt) * incoming + 1 = normalization.layout.v) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming hflips + rw [← (hflips 1).1] + simpa [Q] using normalization.layout.period_v.symm + +private theorem hout2 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let edge : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q ((j + 2).succ)) (Q ((j + 1).succ)) + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + (BandVectors.1 (Q (3 : Fin (4 : ℕ))) (Q (2 : Fin (4 : ℕ))) + BandVectors.1 (Q (1 : Fin (4 + : ℕ))) (Q (3 : Fin (4 : ℕ))) + BandVectors.1 (Q (2 : Fin (4 : ℕ))) (Q (1 : Fin (4 : + ℕ))) = (0 : GaussianInt)) → ((BandVectors.1 (Q (1 : Fin (4 : ℕ))) (Q (0 : Fin (4 : + ℕ))) = BandVectors.1 (Q (1 : Fin (4 : ℕ))) (Q (3 : Fin (4 : ℕ))) - (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (Q (2 : Fin (4 : ℕ))) (Q (1 : Fin (4 : ℕ)))) → + ((incoming 1 = edge 2 - (⟨0, 1⟩ : GaussianInt) * edge 0) → ((incoming 2 = edge 0 - + (⟨0, 1⟩ : GaussianInt) * edge 1) → (((⟨0, 1⟩ : GaussianInt) * incoming 0 = + normalization.layout.u) → (((⟨0, 1⟩ : GaussianInt) * incoming 1 = + normalization.layout.v) → ((⟨0, 1⟩ : GaussianInt) * incoming 2 = + -normalization.layout.u - normalization.layout.v)))))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q edge incoming hsuper hin0 hin1 hin2 hout0 hout1 + have hsum : (⟨0, 1⟩ : GaussianInt) * incoming 0 + + (⟨0, 1⟩ : GaussianInt) * incoming 1 + + (⟨0, 1⟩ : GaussianInt) * incoming 2 = 0 := by + have hs : edge 0 + edge 1 + edge 2 = 0 := by + simpa [edge] using hsuper + rw [show incoming 0 = edge 1 - (⟨0, 1⟩ : GaussianInt) * edge 2 from hin0, + show incoming 1 = edge 2 - (⟨0, 1⟩ : GaussianInt) * edge 0 from hin1, + show incoming 2 = edge 0 - (⟨0, 1⟩ : GaussianInt) * edge 1 from hin2] + calc + (⟨0, 1⟩ : GaussianInt) * + (edge 1 - (⟨0, 1⟩ : GaussianInt) * edge 2) + + (⟨0, 1⟩ : GaussianInt) * + (edge 2 - (⟨0, 1⟩ : GaussianInt) * edge 0) + + (⟨0, 1⟩ : GaussianInt) * + (edge 0 - (⟨0, 1⟩ : GaussianInt) * edge 1) = + (1 + (⟨0, 1⟩ : GaussianInt)) * + (edge 0 + edge 1 + edge 2) := by + apply Zsqrtd.ext <;> simp <;> ring + _ = 0 := by rw [hs]; ring + rw [← hout0, ← hout1] + linear_combination hsum + +private theorem quarterPower : + (by + classical + exact + ∀ (t : Fin 4), ∀ (z : GaussianInt), (⟨0, 1⟩ : GaussianInt) ^ (t + 1).val * z = (⟨0, 1⟩ : + GaussianInt) * ((⟨0, 1⟩ : GaussianInt) ^ t.val * z) ) := by + classical + intro t z + fin_cases t <;> apply Zsqrtd.ext <;> + simp [Fin.add_def, pow_succ] + +private theorem quarterTurnMul : + (by + classical + exact + ∀ (z : GaussianInt), GaussianQuarterTurn z = (⟨0, 1⟩ : GaussianInt) * z ) := by + classical + intro z + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + +end SubtileInterfacePreparation + +namespace SubtileInterfaceAssembly + +private theorem hUBand : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let uIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ + else ⟨.A, -1, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ + else ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ + else ⟨.E, 0, 1⟩ + let U := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v uIndex + BandPrototile (Q normalization.normalizedParentSlot.succ) U ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q uIndex U + generalize hp : normalization.normalizedParentSlot = p + generalize ht : normalization.normalizedQuarterTurn = t + fin_cases p <;> fin_cases t <;> + simp? [Q, U, uIndex, hp, ht, SubtileOccurrenceInterpretation] + all_goals first + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 0 true).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 0 false).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 1 true).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 1 false).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 2 true).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 2 false).1 + +private theorem hVBand : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let vIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, 0⟩ + else ⟨.E, -1, 0⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.E, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 0, -1⟩ + else ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.A, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 1, 1⟩ + else ⟨.C, 1, 1⟩ + let V := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v vIndex + BandPrototile (Q ((if Even normalization.normalizedQuarterTurn.val then + normalization.normalizedParentSlot + 1 else normalization.normalizedParentSlot - + 1).succ)) V ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q vIndex V + generalize hp : normalization.normalizedParentSlot = p + generalize ht : normalization.normalizedQuarterTurn = t + fin_cases p <;> fin_cases t <;> + simp? [V, vIndex, hp, ht, SubtileOccurrenceInterpretation] <;> + first + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 0 true).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 0 false).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 1 true).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 1 false).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 2 true).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 2 false).1 + +private theorem hUSym : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), (∀ (A : + ProtoTile), ∀ (d : GaussianInt), (QuarterTurnSymmetric A) → (QuarterTurnSymmetric + (TileTranslation A d))) → ( + let uIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ + else ⟨.A, -1, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ + else ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ + else ⟨.E, 0, 1⟩ + let U := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v uIndex + QuarterTurnSymmetric U) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization quarterSymmetricTranslation uIndex U + generalize hp : normalization.normalizedParentSlot = p + generalize ht : normalization.normalizedQuarterTurn = t + fin_cases p <;> fin_cases t <;> + simp? [U, uIndex, hp, ht, SubtileOccurrenceInterpretation] <;> + apply quarterSymmetricTranslation <;> + first + | exact normalization.layout.parent_quarter_turn 0 true + | exact normalization.layout.parent_quarter_turn 0 false + | exact normalization.layout.parent_quarter_turn 1 true + | exact normalization.layout.parent_quarter_turn 1 false + | exact normalization.layout.parent_quarter_turn 2 true + | exact normalization.layout.parent_quarter_turn 2 false + +private theorem hFixedBand : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + BandPrototile (Q normalization.normalizedParentSlot.succ) normalization.normalizedFixed ) + := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q + rw [show Q normalization.normalizedParentSlot.succ = + normalization.normalizedFixedCircle.1.1 by + simpa [Q] using normalization.normalized_parent_coordinate] + exact TileOdometerBandPrototile _ _ _ normalization.normalized_fixed_odometer + +private theorem hUcent : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + let outgoing : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q 0) (Q j.succ) + (TileCentroid (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v (if normalization.normalizedParentSlot + = (0 : Fin (3 : ℕ)) then if normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if + normalization.normalizedQuarterTurn = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 + : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = + (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) + else (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if + normalization.normalizedParentSlot = (1 : Fin (3 : ℕ)) then if + normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.C, (1 + : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = + (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = (2 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if + normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.E, (-1 + : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = + (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = (2 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex))) - TileCentroid + normalization.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑normalization.normalizedQuarterTurn : ℕ) * (incoming + normalization.normalizedParentSlot + outgoing normalization.normalizedParentSlot))) → ( + let uIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ + else ⟨.A, -1, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ + else ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ + else ⟨.E, 0, 1⟩ + let U := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v uIndex + TileCentroid U - TileCentroid normalization.normalizedRoot = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ normalization.normalizedQuarterTurn.val * + (incoming normalization.normalizedParentSlot + outgoing + normalization.normalizedParentSlot))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing hUcentroid uIndex U + simpa [U, uIndex] using hUcentroid + +private theorem hfixedCent : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + let outgoing : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q 0) (Q j.succ) + TileCentroid normalization.normalizedFixed - TileCentroid normalization.normalizedRoot = + (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ + normalization.normalizedQuarterTurn.val * (incoming + normalization.normalizedParentSlot + outgoing normalization.normalizedParentSlot)) ) + := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing + simpa [Q, incoming, outgoing] using normalization.normalized_adjacency_centroid + +private theorem hcentUF : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + let outgoing : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q 0) (Q j.succ) + let uIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ + else ⟨.A, -1, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ + else ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ + else ⟨.E, 0, 1⟩ + let U := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v uIndex + (TileCentroid U - TileCentroid normalization.normalizedRoot = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ normalization.normalizedQuarterTurn.val * + (incoming normalization.normalizedParentSlot + outgoing + normalization.normalizedParentSlot))) → ((TileCentroid normalization.normalizedFixed + - TileCentroid normalization.normalizedRoot = (1 / 2 : Real) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ normalization.normalizedQuarterTurn.val * (incoming + normalization.normalizedParentSlot + outgoing normalization.normalizedParentSlot))) → + (TileCentroid U = TileCentroid normalization.normalizedFixed)) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing uIndex U hUcent hfixedCent + calc + TileCentroid U = + (TileCentroid U - TileCentroid normalization.normalizedRoot) + + TileCentroid normalization.normalizedRoot := by abel + _ = (TileCentroid normalization.normalizedFixed - + TileCentroid normalization.normalizedRoot) + + TileCentroid normalization.normalizedRoot := by rw [hUcent, hfixedCent] + _ = TileCentroid normalization.normalizedFixed := by abel + +private theorem hrow' : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let uIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ + else ⟨.A, -1, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ + else ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ + else ⟨.E, 0, 1⟩ + let vIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, 0⟩ + else ⟨.E, -1, 0⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.E, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 0, -1⟩ + else ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.A, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 1, 1⟩ + else ⟨.C, 1, 1⟩ + let uBar : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.A, -1, -1⟩ + else ⟨.A, 0, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.D, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.C, 1, 0⟩ + else ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.F, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.E, 0, 1⟩ + else ⟨.E, -1, 0⟩ + let vBar : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.E, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ + else ⟨.F, 0, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.A, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ + else ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ + else ⟨.D, -1, 0⟩ + let wBlock : Int × Int := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 ∨ + normalization.normalizedQuarterTurn = 3 then (1, 0) else (-1, 0) + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 ∨ + normalization.normalizedQuarterTurn = 3 then (0, 1) else (0, -1) + else if normalization.normalizedQuarterTurn = 0 ∨ + normalization.normalizedQuarterTurn = 3 then (-1, -1) else (1, 1) + ((normalization.normalizedParentSlot = 0 ∧ normalization.normalizedQuarterTurn = 0 ∧ + uIndex = ⟨.A, 0, -1⟩ ∧ uBar = ⟨.B, 1, 1⟩ ∧ wBlock = (1, 0) ∧ vIndex = ⟨.C, 1, 0⟩ ∧ + vBar = ⟨.C, 1, 1⟩) ∨ (normalization.normalizedParentSlot = 0 ∧ + normalization.normalizedQuarterTurn = 1 ∧ uIndex = ⟨.B, 1, 1⟩ ∧ uBar = ⟨.B, 0, 1⟩ ∧ + wBlock = (-1, 0) ∧ vIndex = ⟨.F, 1, 0⟩ ∧ vBar = ⟨.E, 0, 1⟩) ∨ + (normalization.normalizedParentSlot = 0 ∧ normalization.normalizedQuarterTurn = 2 ∧ + uIndex = ⟨.B, 0, 1⟩ ∧ uBar = ⟨.A, -1, -1⟩ ∧ wBlock = (-1, 0) ∧ vIndex = ⟨.D, -1, 0⟩ ∧ + vBar = ⟨.D, -1, -1⟩) ∨ (normalization.normalizedParentSlot = 0 ∧ + normalization.normalizedQuarterTurn = 3 ∧ uIndex = ⟨.A, -1, -1⟩ ∧ uBar = ⟨.A, 0, -1⟩ + ∧ wBlock = (1, 0) ∧ vIndex = ⟨.E, -1, 0⟩ ∧ vBar = ⟨.F, 0, -1⟩) ∨ + (normalization.normalizedParentSlot = 1 ∧ normalization.normalizedQuarterTurn = 0 ∧ + uIndex = ⟨.C, 1, 1⟩ ∧ uBar = ⟨.D, -1, 0⟩ ∧ wBlock = (0, 1) ∧ vIndex = ⟨.E, 0, 1⟩ ∧ + vBar = ⟨.E, -1, 0⟩) ∨ (normalization.normalizedParentSlot = 1 ∧ + normalization.normalizedQuarterTurn = 1 ∧ uIndex = ⟨.D, -1, 0⟩ ∧ uBar = ⟨.D, -1, -1⟩ + ∧ wBlock = (0, -1) ∧ vIndex = ⟨.B, 0, 1⟩ ∧ vBar = ⟨.A, -1, -1⟩) ∨ + (normalization.normalizedParentSlot = 1 ∧ normalization.normalizedQuarterTurn = 2 ∧ + uIndex = ⟨.D, -1, -1⟩ ∧ uBar = ⟨.C, 1, 0⟩ ∧ wBlock = (0, -1) ∧ vIndex = ⟨.F, 0, -1⟩ ∧ + vBar = ⟨.F, 1, 0⟩) ∨ (normalization.normalizedParentSlot = 1 ∧ + normalization.normalizedQuarterTurn = 3 ∧ uIndex = ⟨.C, 1, 0⟩ ∧ uBar = ⟨.C, 1, 1⟩ ∧ + wBlock = (0, 1) ∧ vIndex = ⟨.A, 0, -1⟩ ∧ vBar = ⟨.B, 1, 1⟩) ∨ + (normalization.normalizedParentSlot = 2 ∧ normalization.normalizedQuarterTurn = 0 ∧ + uIndex = ⟨.E, -1, 0⟩ ∧ uBar = ⟨.F, 0, -1⟩ ∧ wBlock = (-1, -1) ∧ vIndex = ⟨.A, -1, -1⟩ + ∧ vBar = ⟨.A, 0, -1⟩) ∨ (normalization.normalizedParentSlot = 2 ∧ + normalization.normalizedQuarterTurn = 1 ∧ uIndex = ⟨.F, 0, -1⟩ ∧ uBar = ⟨.F, 1, 0⟩ ∧ + wBlock = (1, 1) ∧ vIndex = ⟨.D, -1, -1⟩ ∧ vBar = ⟨.C, 1, 0⟩) ∨ + (normalization.normalizedParentSlot = 2 ∧ normalization.normalizedQuarterTurn = 2 ∧ + uIndex = ⟨.F, 1, 0⟩ ∧ uBar = ⟨.E, 0, 1⟩ ∧ wBlock = (1, 1) ∧ vIndex = ⟨.B, 1, 1⟩ ∧ + vBar = ⟨.B, 0, 1⟩) ∨ (normalization.normalizedParentSlot = 2 ∧ + normalization.normalizedQuarterTurn = 3 ∧ uIndex = ⟨.E, 0, 1⟩ ∧ uBar = ⟨.E, -1, 0⟩ ∧ + wBlock = (-1, -1) ∧ vIndex = ⟨.C, 1, 1⟩ ∧ vBar = ⟨.D, -1, 0⟩)) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization uIndex vIndex uBar vBar wBlock + generalize hp : normalization.normalizedParentSlot = p + generalize ht : normalization.normalizedQuarterTurn = t + fin_cases p <;> fin_cases t <;> + simp [uIndex, uBar, vIndex, vBar, wBlock, hp, ht] + +private theorem hUbarBand : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let uBar : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.A, -1, -1⟩ + else ⟨.A, 0, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.D, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.C, 1, 0⟩ + else ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.F, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.E, 0, 1⟩ + else ⟨.E, -1, 0⟩ + let Ubar := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v uBar + BandPrototile (Q normalization.normalizedParentSlot.succ) Ubar ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q uBar Ubar + generalize hp : normalization.normalizedParentSlot = p + generalize ht : normalization.normalizedQuarterTurn = t + fin_cases p <;> fin_cases t <;> + simp? [Q, Ubar, uBar, hp, ht, SubtileOccurrenceInterpretation] + all_goals first + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 0 true).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 0 false).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 1 true).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 1 false).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 2 true).1 + | exact BandPrototileTranslation _ _ _ + (normalization.layout.outer_occurrence 2 false).1 + +private theorem hUbarCent : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + let outgoing : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q 0) (Q j.succ) + let uBar : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.A, -1, -1⟩ + else ⟨.A, 0, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.D, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.C, 1, 0⟩ + else ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.F, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.E, 0, 1⟩ + else ⟨.E, -1, 0⟩ + (∀ (p : Fin (3 : ℕ)), ∀ (t : Fin (4 : ℕ)), + let uIndex := if p = (0 : Fin (3 : ℕ)) then if t = (0 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if + t = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if p = (1 : Fin (3 : ℕ)) then if t = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : + Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) + else if t = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if t = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.E, (-1 : + ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (2 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); + let vIndex := if p = (0 : Fin (3 : ℕ)) then if t = (0 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if + t = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if p = (1 : Fin (3 : ℕ)) then if t = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : + Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else + if t = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if t = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.A, (-1 : + ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (2 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); + let U := SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v uIndex; + let V := SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v vIndex; TileCentroid U - TileCentroid + normalization.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑t : ℕ) * (incoming p + outgoing p)) ∧ TileCentroid V - TileCentroid + normalization.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑t : ℕ) * if Even (↑t : ℕ) then incoming (p + (1 : Fin (3 : ℕ))) - + outgoing (p + (1 : Fin (3 : ℕ))) else outgoing (p - (1 : Fin (3 : ℕ))) - incoming (p + - (1 : Fin (3 : ℕ))))) → ((∀ (t : Fin 4), ∀ (z : GaussianInt), (⟨0, 1⟩ : GaussianInt) + ^ (t + 1).val * z = (⟨0, 1⟩ : GaussianInt) * ((⟨0, 1⟩ : GaussianInt) ^ t.val * z)) → ( + let Ubar := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v uBar + TileCentroid Ubar - TileCentroid normalization.normalizedRoot = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * ((⟨0, 1⟩ : GaussianInt) ^ + normalization.normalizedQuarterTurn.val * (incoming + normalization.normalizedParentSlot + outgoing normalization.normalizedParentSlot))))) + ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing uBar rowsAt quarterPower Ubar + let uIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ + else ⟨.A, -1, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ + else ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ + else ⟨.E, 0, 1⟩ + let vIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, 0⟩ + else ⟨.E, -1, 0⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.E, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 0, -1⟩ + else ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.A, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 1, 1⟩ + else ⟨.C, 1, 1⟩ + let U := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v uIndex + let V := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v vIndex + rw [← quarterPower normalization.normalizedQuarterTurn + (incoming normalization.normalizedParentSlot + + outgoing normalization.normalizedParentSlot)] + generalize hp : normalization.normalizedParentSlot = p + generalize ht : normalization.normalizedQuarterTurn = t + fin_cases p <;> fin_cases t + · simpa [Ubar, uBar, hp, ht, Fin.add_def] using (rowsAt 0 1).1 + · simpa [Ubar, uBar, hp, ht, Fin.add_def] using (rowsAt 0 2).1 + · simpa [Ubar, uBar, hp, ht, Fin.add_def] using (rowsAt 0 3).1 + · simpa [Ubar, uBar, hp, ht, Fin.add_def] using (rowsAt 0 0).1 + · simpa [Ubar, uBar, hp, ht, Fin.add_def] using (rowsAt 1 1).1 + · simpa [Ubar, uBar, hp, ht, Fin.add_def] using (rowsAt 1 2).1 + · simpa [Ubar, uBar, hp, ht, Fin.add_def] using (rowsAt 1 3).1 + · simpa [Ubar, uBar, hp, ht, Fin.add_def] using (rowsAt 1 0).1 + · simpa [Ubar, uBar, hp, ht, Fin.add_def] using (rowsAt 2 1).1 + · simpa [Ubar, uBar, hp, ht, Fin.add_def] using (rowsAt 2 2).1 + · simpa [Ubar, uBar, hp, ht, Fin.add_def] using (rowsAt 2 3).1 + · simpa [Ubar, uBar, hp, ht, Fin.add_def] using (rowsAt 2 0).1 + +private theorem hshift : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + let outgoing : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q 0) (Q j.succ) + (∀ (j : Fin (3 : ℕ)), BandVectors.1 (Q (0 : Fin (4 : ℕ))) (Q j.succ) = (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (Q j.succ) (Q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 + (Q (0 : Fin (4 : ℕ))) (Q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (Q j.succ) (Q (0 : Fin (4 : ℕ)))) → ( + let wBlock : Int × Int := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 ∨ + normalization.normalizedQuarterTurn = 3 then (1, 0) else (-1, 0) + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 ∨ + normalization.normalizedQuarterTurn = 3 then (0, 1) else (0, -1) + else if normalization.normalizedQuarterTurn = 0 ∨ + normalization.normalizedQuarterTurn = 3 then (-1, -1) else (1, 1) + let wShift : GaussianInt := + (⟨0, 1⟩ : GaussianInt) ^ normalization.normalizedQuarterTurn.val * + (if Even normalization.normalizedQuarterTurn.val then + incoming normalization.normalizedParentSlot + else outgoing normalization.normalizedParentSlot) + ((⟨0, 1⟩ : GaussianInt) * incoming 0 = normalization.layout.u) → (((⟨0, 1⟩ : GaussianInt) + * incoming 1 = normalization.layout.v) → (((⟨0, 1⟩ : GaussianInt) * incoming 2 = + -normalization.layout.u - normalization.layout.v) → ((∀ (z : GaussianInt), + GaussianQuarterTurn z = (⟨0, 1⟩ : GaussianInt) * z) → (GaussianQuarterTurn wShift = + (wBlock.1 : GaussianInt) * normalization.layout.u + (wBlock.2 : GaussianInt) * + normalization.layout.v))))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing hflips wBlock wShift hout0 + hout1 hout2 quarterTurnMul + rw [quarterTurnMul] + have hf0 : outgoing 0 = (⟨0, 1⟩ : GaussianInt) * incoming 0 := by + simpa [outgoing, incoming] using (hflips 0).1 + have hf1 : outgoing 1 = (⟨0, 1⟩ : GaussianInt) * incoming 1 := by + simpa [outgoing, incoming] using (hflips 1).1 + have hf2 : outgoing 2 = (⟨0, 1⟩ : GaussianInt) * incoming 2 := by + simpa [outgoing, incoming] using (hflips 2).1 + have even0 : Even 0 := ⟨0, rfl⟩ + have notEven1 : ¬ Even 1 := by + rintro ⟨r, hr⟩ + omega + have even2 : Even 2 := ⟨1, rfl⟩ + have notEven3 : ¬ Even 3 := by + rintro ⟨r, hr⟩ + omega + have h0re := congrArg (fun z : GaussianInt => z.re) hout0 + have h0im := congrArg (fun z : GaussianInt => z.im) hout0 + have h1re := congrArg (fun z : GaussianInt => z.re) hout1 + have h1im := congrArg (fun z : GaussianInt => z.im) hout1 + have h2re := congrArg (fun z : GaussianInt => z.re) hout2 + have h2im := congrArg (fun z : GaussianInt => z.im) hout2 + have hf0re := congrArg (fun z : GaussianInt => z.re) hf0 + have hf0im := congrArg (fun z : GaussianInt => z.im) hf0 + have hf1re := congrArg (fun z : GaussianInt => z.re) hf1 + have hf1im := congrArg (fun z : GaussianInt => z.im) hf1 + have hf2re := congrArg (fun z : GaussianInt => z.re) hf2 + have hf2im := congrArg (fun z : GaussianInt => z.im) hf2 + generalize hp : normalization.normalizedParentSlot = p + generalize ht : normalization.normalizedQuarterTurn = t + fin_cases p <;> fin_cases t <;> apply Zsqrtd.ext + all_goals + simp [ + ] at h0re h0im h1re h1im h2re h2im hf0re hf0im hf1re hf1im hf2re hf2im + all_goals + simp [wShift, wBlock, hp, ht, even0, notEven1, even2, notEven3, + pow_succ]; omega + +private theorem hVbarBand : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + (∀ (j : Fin 3), ∀ (e : Bool), ∀ (m : Int), ∀ (n : Int), BandPrototile (Q j.succ) + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v ⟨subtileOccurrenceLabel j e, m, n⟩)) → ( + let vBar : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.E, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ + else ⟨.F, 0, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.A, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ + else ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ + else ⟨.D, -1, 0⟩ + let Vbar := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v vBar + BandPrototile (Q ((if Even normalization.normalizedQuarterTurn.val then + normalization.normalizedParentSlot + 1 else normalization.normalizedParentSlot - + 1).succ)) Vbar) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q occurrenceBand vBar Vbar + generalize hp : normalization.normalizedParentSlot = p + generalize ht : normalization.normalizedQuarterTurn = t + fin_cases p <;> fin_cases t <;> + simp? [Vbar, vBar, hp, ht] <;> + first + | exact occurrenceBand 0 true _ _ + | exact occurrenceBand 0 false _ _ + | exact occurrenceBand 1 true _ _ + | exact occurrenceBand 1 false _ _ + | exact occurrenceBand 2 true _ _ + | exact occurrenceBand 2 false _ _ + +private theorem hVSym : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), (∀ (A : + ProtoTile), ∀ (d : GaussianInt), (QuarterTurnSymmetric A) → (QuarterTurnSymmetric + (TileTranslation A d))) → ( + let vIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, 0⟩ + else ⟨.E, -1, 0⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.E, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 0, -1⟩ + else ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.A, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 1, 1⟩ + else ⟨.C, 1, 1⟩ + let V := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v vIndex + QuarterTurnSymmetric V) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization quarterSymmetricTranslation vIndex V + generalize hp : normalization.normalizedParentSlot = p + generalize ht : normalization.normalizedQuarterTurn = t + fin_cases p <;> fin_cases t <;> + simp? [V, vIndex, hp, ht, SubtileOccurrenceInterpretation] <;> + apply quarterSymmetricTranslation <;> + first + | exact normalization.layout.parent_quarter_turn 0 true + | exact normalization.layout.parent_quarter_turn 0 false + | exact normalization.layout.parent_quarter_turn 1 true + | exact normalization.layout.parent_quarter_turn 1 false + | exact normalization.layout.parent_quarter_turn 2 true + | exact normalization.layout.parent_quarter_turn 2 false + +private theorem hVcent : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + let outgoing : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q 0) (Q j.succ) + (TileCentroid (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v (if normalization.normalizedParentSlot + = (0 : Fin (3 : ℕ)) then if normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if + normalization.normalizedQuarterTurn = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 + : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = + (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if normalization.normalizedParentSlot = (1 : Fin (3 : ℕ)) + then if normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if + normalization.normalizedQuarterTurn = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 + : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = + (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if + normalization.normalizedQuarterTurn = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 + : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = + (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) + else (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex))) - TileCentroid + normalization.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑normalization.normalizedQuarterTurn : ℕ) * if Even + (↑normalization.normalizedQuarterTurn : ℕ) then incoming + (normalization.normalizedParentSlot + (1 : Fin (3 : ℕ))) - outgoing + (normalization.normalizedParentSlot + (1 : Fin (3 : ℕ))) else outgoing + (normalization.normalizedParentSlot - (1 : Fin (3 : ℕ))) - incoming + (normalization.normalizedParentSlot - (1 : Fin (3 : ℕ))))) → ( + let vIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, 0⟩ + else ⟨.E, -1, 0⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.E, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 0, -1⟩ + else ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.A, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 1, 1⟩ + else ⟨.C, 1, 1⟩ + let V := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v vIndex + TileCentroid V - TileCentroid normalization.normalizedRoot = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ normalization.normalizedQuarterTurn.val * + (if Even normalization.normalizedQuarterTurn.val then incoming + (normalization.normalizedParentSlot + 1) - outgoing + (normalization.normalizedParentSlot + 1) else outgoing + (normalization.normalizedParentSlot - 1) - incoming + (normalization.normalizedParentSlot - 1)))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing hVcentroid vIndex V + simpa [V, vIndex] using hVcentroid + +private theorem hVbarCent : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + let outgoing : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q 0) (Q j.succ) + (∀ (j : Fin (3 : ℕ)), BandVectors.1 (Q (0 : Fin (4 : ℕ))) (Q j.succ) = (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (Q j.succ) (Q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 + (Q (0 : Fin (4 : ℕ))) (Q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (Q j.succ) (Q (0 : Fin (4 : ℕ)))) → ( + let vBar : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.E, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ + else ⟨.F, 0, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.A, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ + else ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ + else ⟨.D, -1, 0⟩ + (∀ (p : Fin (3 : ℕ)), ∀ (t : Fin (4 : ℕ)), + let uIndex := if p = (0 : Fin (3 : ℕ)) then if t = (0 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if + t = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if p = (1 : Fin (3 : ℕ)) then if t = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : + Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) + else if t = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if t = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.E, (-1 : + ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (2 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); + let vIndex := if p = (0 : Fin (3 : ℕ)) then if t = (0 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if + t = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if p = (1 : Fin (3 : ℕ)) then if t = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : + Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else + if t = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if t = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.A, (-1 : + ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (2 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); + let U := SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v uIndex; + let V := SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v vIndex; TileCentroid U - TileCentroid + normalization.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑t : ℕ) * (incoming p + outgoing p)) ∧ TileCentroid V - TileCentroid + normalization.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑t : ℕ) * if Even (↑t : ℕ) then incoming (p + (1 : Fin (3 : ℕ))) - + outgoing (p + (1 : Fin (3 : ℕ))) else outgoing (p - (1 : Fin (3 : ℕ))) - incoming (p + - (1 : Fin (3 : ℕ))))) → ( + let Vbar := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v vBar + TileCentroid Vbar - TileCentroid normalization.normalizedRoot = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * ((⟨0, 1⟩ : GaussianInt) ^ + normalization.normalizedQuarterTurn.val * (if Even + normalization.normalizedQuarterTurn.val then incoming + (normalization.normalizedParentSlot + 1) - outgoing + (normalization.normalizedParentSlot + 1) else outgoing + (normalization.normalizedParentSlot - 1) - incoming + (normalization.normalizedParentSlot - 1)))))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing hflips vBar rowsAt Vbar + let uIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ + else ⟨.A, -1, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ + else ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ + else ⟨.E, 0, 1⟩ + let vIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, 0⟩ + else ⟨.E, -1, 0⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.E, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 0, -1⟩ + else ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.A, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 1, 1⟩ + else ⟨.C, 1, 1⟩ + let U := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v uIndex + let V := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v vIndex + have hf0 : outgoing 0 = (⟨0, 1⟩ : GaussianInt) * incoming 0 := by + simpa [outgoing, incoming] using (hflips 0).1 + have hf1 : outgoing 1 = (⟨0, 1⟩ : GaussianInt) * incoming 1 := by + simpa [outgoing, incoming] using (hflips 1).1 + have hf2 : outgoing 2 = (⟨0, 1⟩ : GaussianInt) * incoming 2 := by + simpa [outgoing, incoming] using (hflips 2).1 + have even0 : Even 0 := ⟨0, rfl⟩ + have notEven1 : ¬ Even 1 := by rintro ⟨r, hr⟩; omega + have even2 : Even 2 := ⟨1, rfl⟩ + have notEven3 : ¬ Even 3 := by rintro ⟨r, hr⟩; omega + have zeroSubOne : (0 : Fin 3) - 1 = 2 := by decide + generalize hp : normalization.normalizedParentSlot = p + generalize ht : normalization.normalizedQuarterTurn = t + fin_cases p <;> fin_cases t + · convert (rowsAt 1 0).1 using 1 + · simp [Vbar, vBar, hp, ht] + · congr 2 + apply Zsqrtd.ext <;> simp [hf1, even0] <;> ring + · convert (rowsAt 2 3).1 using 1 + · simp [Vbar, vBar, hp, ht] + · congr 2 + apply Zsqrtd.ext <;> + simp [hf2, notEven1, zeroSubOne, pow_succ] <;> ring + · convert (rowsAt 1 2).1 using 1 + · simp [Vbar, vBar, hp, ht] + · congr 2 + apply Zsqrtd.ext <;> simp [hf1, even2, pow_succ] <;> ring + · convert (rowsAt 2 1).1 using 1 + · simp [Vbar, vBar, hp, ht] + · congr 2 + apply Zsqrtd.ext <;> + simp [hf2, notEven3, zeroSubOne, pow_succ] <;> ring + · convert (rowsAt 2 0).1 using 1 + · simp [Vbar, vBar, hp, ht] + · congr 2 + apply Zsqrtd.ext <;> simp [hf2, even0] <;> ring + · convert (rowsAt 0 3).1 using 1 + · simp [Vbar, vBar, hp, ht] + · congr 2 + apply Zsqrtd.ext <;> + simp [hf0, notEven1, pow_succ] <;> ring + · convert (rowsAt 2 2).1 using 1 + · simp [Vbar, vBar, hp, ht] + · congr 2 + apply Zsqrtd.ext <;> simp [hf2, even2, pow_succ] <;> ring + · convert (rowsAt 0 1).1 using 1 + · simp [Vbar, vBar, hp, ht] + · congr 2 + apply Zsqrtd.ext <;> + simp [hf0, notEven3, pow_succ] <;> ring + · convert (rowsAt 0 0).1 using 1 + · simp [Vbar, vBar, hp, ht] + · congr 2 + apply Zsqrtd.ext <;> simp [hf0, even0] <;> ring + · convert (rowsAt 1 3).1 using 1 + · simp [Vbar, vBar, hp, ht] + · congr 2 + apply Zsqrtd.ext <;> + simp [hf1, notEven1, Fin.sub_def, pow_succ] <;> ring + · convert (rowsAt 0 2).1 using 1 + · simp [Vbar, vBar, hp, ht] + · congr 2 + apply Zsqrtd.ext <;> simp [hf0, even2, pow_succ] <;> ring + · convert (rowsAt 1 1).1 using 1 + · simp [Vbar, vBar, hp, ht] + · congr 2 + apply Zsqrtd.ext <;> + simp [hf1, notEven3, Fin.sub_def, pow_succ] <;> ring + +private theorem hWExact : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + let outgoing : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q 0) (Q j.succ) + ∀ (wShift : GaussianInt), ∀ (W : ProtoTile), (W = TileTranslation + normalization.normalizedRoot wShift) → ((wShift = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ^ (↑normalization.normalizedQuarterTurn : ℕ) * if Even + (↑normalization.normalizedQuarterTurn : ℕ) then incoming + normalization.normalizedParentSlot else outgoing normalization.normalizedParentSlot) + → (W = TileTranslation normalization.normalizedRoot ((⟨0, 1⟩ : GaussianInt) ^ + normalization.normalizedQuarterTurn.val * (if Even + normalization.normalizedQuarterTurn.val then BandVectors.1 (Q + normalization.normalizedParentSlot.succ) (Q 0) else BandVectors.1 (Q 0) (Q + normalization.normalizedParentSlot.succ))))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing wShift W hW hwShift + rw [hW, hwShift] + +private theorem hincomingPoint : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + ∀ (g : GaussianInt), ∀ (uIndex : PeriodicSubtileIndex), ∀ (wBlock : ℤ × ℤ), ∀ (wShift : + GaussianInt), ∀ (V : ProtoTile), ∀ (W : ProtoTile), (W = TileTranslation + normalization.normalizedRoot wShift) → (((TileTranslation (TileQuarterTurn W) + g).cells = (TileTranslation normalization.normalizedRoot ((↑wBlock.1 : GaussianInt) * + normalization.layout.u + (↑wBlock.2 : GaussianInt) * normalization.layout.v)).cells) + → ((LatticeTile W) → ((Disjoint normalization.normalizedRoot.cells W.cells) → + ((Disjoint normalization.normalizedFixed.cells W.cells) → ((Disjoint W.cells V.cells) + → ( + let source := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v uIndex + ∀ (incomingRaw : ExactTileInterfaceTriple normalization.normalizedRoot (TileTranslation + normalization.normalizedRoot ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ + (↑normalization.normalizedQuarterTurn : ℕ) * if Even + (↑normalization.normalizedQuarterTurn : ℕ) then BandVectors.1 (Q + normalization.normalizedParentSlot.succ) (Q (0 : Fin (4 : ℕ))) else BandVectors.1 (Q + (0 : Fin (4 : ℕ))) (Q normalization.normalizedParentSlot.succ))) source), ∀ (hWExact + : W = TileTranslation normalization.normalizedRoot ((⟨0, 1⟩ : GaussianInt) ^ + normalization.normalizedQuarterTurn.val * (if Even + normalization.normalizedQuarterTurn.val then BandVectors.1 (Q + normalization.normalizedParentSlot.succ) (Q 0) else BandVectors.1 (Q 0) (Q + normalization.normalizedParentSlot.succ)))), + let incomingData : ExactTileInterfaceTriple + normalization.normalizedRoot W source := hWExact.symm ▸ incomingRaw + incomingData.point = incomingRaw.point)))))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q g uIndex wBlock wShift V W hW hWBar hWLattice + hRootW hFixedW hWV source incomingRaw hWExact incomingData + dsimp [incomingData] + cases hWExact + rfl + +private theorem hincomingOtherCA : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + ∀ (g : GaussianInt), ∀ (uIndex : PeriodicSubtileIndex), ∀ (wBlock : ℤ × ℤ), ∀ (wShift : + GaussianInt), ∀ (V : ProtoTile), ∀ (W : ProtoTile), (W = TileTranslation + normalization.normalizedRoot wShift) → (((TileTranslation (TileQuarterTurn W) + g).cells = (TileTranslation normalization.normalizedRoot ((↑wBlock.1 : GaussianInt) * + normalization.layout.u + (↑wBlock.2 : GaussianInt) * normalization.layout.v)).cells) + → ((LatticeTile W) → ((Disjoint normalization.normalizedRoot.cells W.cells) → + ((Disjoint normalization.normalizedFixed.cells W.cells) → ((Disjoint W.cells V.cells) + → ( + let source := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v uIndex + ∀ (incomingRaw : ExactTileInterfaceTriple normalization.normalizedRoot (TileTranslation + normalization.normalizedRoot ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ + (↑normalization.normalizedQuarterTurn : ℕ) * if Even + (↑normalization.normalizedQuarterTurn : ℕ) then BandVectors.1 (Q + normalization.normalizedParentSlot.succ) (Q (0 : Fin (4 : ℕ))) else BandVectors.1 (Q + (0 : Fin (4 : ℕ))) (Q normalization.normalizedParentSlot.succ))) source), ∀ (hWExact + : W = TileTranslation normalization.normalizedRoot ((⟨0, 1⟩ : GaussianInt) ^ + normalization.normalizedQuarterTurn.val * (if Even + normalization.normalizedQuarterTurn.val then BandVectors.1 (Q + normalization.normalizedParentSlot.succ) (Q 0) else BandVectors.1 (Q 0) (Q + normalization.normalizedParentSlot.succ)))), + let incomingData : ExactTileInterfaceTriple + normalization.normalizedRoot W source := hWExact.symm ▸ incomingRaw + (incomingData.point = incomingRaw.point) → (incomingData.otherCA = + incomingRaw.otherCA))))))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q g uIndex wBlock wShift V W hW hWBar hWLattice + hRootW hFixedW hWV source incomingRaw hWExact incomingData hincomingPoint + dsimp [incomingData] + cases hWExact + rfl + +private theorem hEndpoints : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + ∀ (uIndex : PeriodicSubtileIndex), ∀ (V : ProtoTile), ∀ (W : ProtoTile), + let source := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v uIndex + ∀ (incomingRaw : ExactTileInterfaceTriple normalization.normalizedRoot (TileTranslation + normalization.normalizedRoot ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ + (↑normalization.normalizedQuarterTurn : ℕ) * if Even + (↑normalization.normalizedQuarterTurn : ℕ) then BandVectors.1 (Q + normalization.normalizedParentSlot.succ) (Q (0 : Fin (4 : ℕ))) else BandVectors.1 (Q + (0 : Fin (4 : ℕ))) (Q normalization.normalizedParentSlot.succ))) source), ∀ (t5Data : + ExactTileInterfaceTriple normalization.normalizedRoot source V), (incomingRaw.otherCA + = t5Data.point) → ((t5Data.otherAB = incomingRaw.point) → (∀ (hWExact : W = + TileTranslation normalization.normalizedRoot ((⟨0, 1⟩ : GaussianInt) ^ + normalization.normalizedQuarterTurn.val * (if Even + normalization.normalizedQuarterTurn.val then BandVectors.1 (Q + normalization.normalizedParentSlot.succ) (Q 0) else BandVectors.1 (Q 0) (Q + normalization.normalizedParentSlot.succ)))), + let incomingData : ExactTileInterfaceTriple + normalization.normalizedRoot W source := hWExact.symm ▸ incomingRaw + (incomingData.point = incomingRaw.point) → ((incomingData.otherCA = incomingRaw.otherCA) + → (∀ (startSource : ExactTileInterfaceTriple normalization.normalizedRoot source W), + (startSource.point = incomingData.point) → ((startSource.otherAB = + incomingData.otherCA) → (∀ (startData : ExactTileInterfaceTriple + normalization.normalizedRoot normalization.normalizedFixed W), (startData.point = + startSource.point) → ((startData.otherAB = startSource.otherAB) → (∀ (endData : + ExactTileInterfaceTriple normalization.normalizedRoot normalization.normalizedFixed + V), (endData.point = t5Data.point) → ((endData.otherAB = t5Data.otherAB) → + (endData.point = startData.otherAB ∧ endData.otherAB = startData.point)))))))))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q uIndex V W source incomingRaw t5Data + hincomingOther ht5Other hWExact incomingData hincomingPoint hincomingOtherCA startSource + hswapPoint hswapOtherAB startData hstartPoint hstartOtherAB endData hendPoint hendOtherAB + constructor + · calc + endData.point = t5Data.point := hendPoint + _ = incomingRaw.otherCA := hincomingOther.symm + _ = incomingData.otherCA := hincomingOtherCA.symm + _ = startSource.otherAB := hswapOtherAB.symm + _ = startData.otherAB := hstartOtherAB.symm + · calc + endData.otherAB = t5Data.otherAB := hendOtherAB + _ = incomingRaw.point := ht5Other + _ = incomingData.point := hincomingPoint.symm + _ = startSource.point := hswapPoint.symm + _ = startData.point := hstartPoint.symm + +end SubtileInterfaceAssembly + +namespace SubtileInterfaceRowPackage + +private theorem rowPackage : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let edge : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q ((j + 2).succ)) (Q ((j + 1).succ)) + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + let outgoing : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q 0) (Q j.succ) + (BandVectors.1 (Q (3 : Fin (4 : ℕ))) (Q (2 : Fin (4 : ℕ))) + BandVectors.1 (Q (1 : Fin (4 + : ℕ))) (Q (3 : Fin (4 : ℕ))) + BandVectors.1 (Q (2 : Fin (4 : ℕ))) (Q (1 : Fin (4 : + ℕ))) = (0 : GaussianInt)) → ((BandVectors.1 (Q (1 : Fin (4 : ℕ))) (Q (0 : Fin (4 : + ℕ))) = BandVectors.1 (Q (1 : Fin (4 : ℕ))) (Q (3 : Fin (4 : ℕ))) - (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (Q (2 : Fin (4 : ℕ))) (Q (1 : Fin (4 : ℕ)))) → ((∀ + (j : Fin (3 : ℕ)), BandVectors.1 (Q (0 : Fin (4 : ℕ))) (Q j.succ) = (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (Q j.succ) (Q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 + (Q (0 : Fin (4 : ℕ))) (Q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (Q j.succ) (Q (0 : Fin (4 : ℕ)))) → ((incoming 1 = edge 2 - (⟨0, 1⟩ : + GaussianInt) * edge 0) → ((incoming 2 = edge 0 - (⟨0, 1⟩ : GaussianInt) * edge 1) → + ((TileCentroid (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v (if normalization.normalizedParentSlot + = (0 : Fin (3 : ℕ)) then if normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if + normalization.normalizedQuarterTurn = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 + : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = + (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) + else (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if + normalization.normalizedParentSlot = (1 : Fin (3 : ℕ)) then if + normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.C, (1 + : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = + (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = (2 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if + normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.E, (-1 + : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = + (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = (2 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex))) - TileCentroid + normalization.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑normalization.normalizedQuarterTurn : ℕ) * (incoming + normalization.normalizedParentSlot + outgoing normalization.normalizedParentSlot))) → + ((TileCentroid (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v (if normalization.normalizedParentSlot + = (0 : Fin (3 : ℕ)) then if normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if + normalization.normalizedQuarterTurn = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 + : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = + (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if normalization.normalizedParentSlot = (1 : Fin (3 : ℕ)) + then if normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if + normalization.normalizedQuarterTurn = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 + : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = + (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if + normalization.normalizedQuarterTurn = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 + : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = + (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) + else (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex))) - TileCentroid + normalization.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑normalization.normalizedQuarterTurn : ℕ) * if Even + (↑normalization.normalizedQuarterTurn : ℕ) then incoming + (normalization.normalizedParentSlot + (1 : Fin (3 : ℕ))) - outgoing + (normalization.normalizedParentSlot + (1 : Fin (3 : ℕ))) else outgoing + (normalization.normalizedParentSlot - (1 : Fin (3 : ℕ))) - incoming + (normalization.normalizedParentSlot - (1 : Fin (3 : ℕ))))) → (( + let Q := normalization.normalizedPresentation; ∀ (j : Fin (3 : ℕ)), ∀ (e : Bool), ∀ (m : + ℤ), ∀ (n : ℤ), BandPrototile (Q j.succ) (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v + ⟨subtileOccurrenceLabel j e, m, n⟩)) → ((∀ (A : ProtoTile), ∀ (d : GaussianInt), + QuarterTurnSymmetric A → QuarterTurnSymmetric (TileTranslation A d)) → (∀ (g : + GaussianInt), ((TileTranslation (TileQuarterTurn normalization.normalizedRoot) + g).cells = normalization.normalizedRoot.cells) → ((∀ (Y : ProtoTile), ∀ (Z : + ProtoTile), ∀ (z : GaussianInt), TileCentroid Y - TileCentroid + normalization.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint z → TileCentroid Z - + TileCentroid normalization.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt) * z) → TileCentroid (TileTranslation (TileQuarterTurn Y) + g) = TileCentroid Z) → ((∀ (C : CircleCoordinates), ∀ (Y : ProtoTile), ∀ (Z : + ProtoTile), BandPrototile C Y → BandPrototile C Z → QuarterTurnSymmetric Y → + TileCentroid (TileTranslation (TileQuarterTurn Y) g) = TileCentroid Z → + (TileTranslation (TileQuarterTurn Y) g).cells = Z.cells ∧ ((TileTranslation + (TileQuarterTurn Y) g).cells = ∅ → (TileTranslation (TileQuarterTurn Y) g).anchor = + Z.anchor)) → ((∀ (A : ProtoTile), ∀ (a : GaussianInt), ∀ (d : GaussianInt), + TileTranslation (TileQuarterTurn (TileTranslation A a)) d = TileTranslation + (TileTranslation (TileQuarterTurn A) d) (GaussianQuarterTurn a)) → ( + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * (fun (j : Fin (3 : ℕ)) => BandVectors.1 + (normalization.normalizedPresentation j.succ) (normalization.normalizedPresentation + (0 : Fin (4 : ℕ)))) (0 : Fin (3 : ℕ)) = normalization.layout.u) → (((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * (fun (j : Fin (3 : ℕ)) => BandVectors.1 + (normalization.normalizedPresentation j.succ) (normalization.normalizedPresentation + (0 : Fin (4 : ℕ)))) (1 : Fin (3 : ℕ)) = normalization.layout.v) → ((∀ (p : Fin (3 : + ℕ)), ∀ (t : Fin (4 : ℕ)), + let uIndex := if p = (0 : Fin (3 : ℕ)) then if t = (0 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if + t = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if p = (1 : Fin (3 : ℕ)) then if t = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : + Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) + else if t = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if t = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.E, (-1 : + ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (2 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); + let vIndex := if p = (0 : Fin (3 : ℕ)) then if t = (0 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if + t = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if p = (1 : Fin (3 : ℕ)) then if t = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : + Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else + if t = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if t = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.A, (-1 : + ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (1 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if t = (2 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); + let U := SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v uIndex; + let V := SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v vIndex; TileCentroid U - TileCentroid + normalization.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑t : ℕ) * (incoming p + outgoing p)) ∧ TileCentroid V - TileCentroid + normalization.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑t : ℕ) * if Even (↑t : ℕ) then incoming (p + (1 : Fin (3 : ℕ))) - + outgoing (p + (1 : Fin (3 : ℕ))) else outgoing (p - (1 : Fin (3 : ℕ))) - incoming (p + - (1 : Fin (3 : ℕ))))) → (∃ (W V : ProtoTile) (g wShift : GaussianInt) (uIndex uBar + vIndex vBar : PeriodicSubtileIndex) (wBlock : Int × Int), + ((normalization.normalizedParentSlot = 0 ∧ normalization.normalizedQuarterTurn = 0 ∧ + uIndex = ⟨.A, 0, -1⟩ ∧ uBar = ⟨.B, 1, 1⟩ ∧ wBlock = (1, 0) ∧ vIndex = ⟨.C, 1, 0⟩ ∧ + vBar = ⟨.C, 1, 1⟩) ∨ (normalization.normalizedParentSlot = 0 ∧ + normalization.normalizedQuarterTurn = 1 ∧ uIndex = ⟨.B, 1, 1⟩ ∧ uBar = ⟨.B, 0, 1⟩ ∧ + wBlock = (-1, 0) ∧ vIndex = ⟨.F, 1, 0⟩ ∧ vBar = ⟨.E, 0, 1⟩) ∨ + (normalization.normalizedParentSlot = 0 ∧ normalization.normalizedQuarterTurn = 2 ∧ + uIndex = ⟨.B, 0, 1⟩ ∧ uBar = ⟨.A, -1, -1⟩ ∧ wBlock = (-1, 0) ∧ vIndex = ⟨.D, -1, 0⟩ ∧ + vBar = ⟨.D, -1, -1⟩) ∨ (normalization.normalizedParentSlot = 0 ∧ + normalization.normalizedQuarterTurn = 3 ∧ uIndex = ⟨.A, -1, -1⟩ ∧ uBar = ⟨.A, 0, -1⟩ + ∧ wBlock = (1, 0) ∧ vIndex = ⟨.E, -1, 0⟩ ∧ vBar = ⟨.F, 0, -1⟩) ∨ + (normalization.normalizedParentSlot = 1 ∧ normalization.normalizedQuarterTurn = 0 ∧ + uIndex = ⟨.C, 1, 1⟩ ∧ uBar = ⟨.D, -1, 0⟩ ∧ wBlock = (0, 1) ∧ vIndex = ⟨.E, 0, 1⟩ ∧ + vBar = ⟨.E, -1, 0⟩) ∨ (normalization.normalizedParentSlot = 1 ∧ + normalization.normalizedQuarterTurn = 1 ∧ uIndex = ⟨.D, -1, 0⟩ ∧ uBar = ⟨.D, -1, -1⟩ + ∧ wBlock = (0, -1) ∧ vIndex = ⟨.B, 0, 1⟩ ∧ vBar = ⟨.A, -1, -1⟩) ∨ + (normalization.normalizedParentSlot = 1 ∧ normalization.normalizedQuarterTurn = 2 ∧ + uIndex = ⟨.D, -1, -1⟩ ∧ uBar = ⟨.C, 1, 0⟩ ∧ wBlock = (0, -1) ∧ vIndex = ⟨.F, 0, -1⟩ ∧ + vBar = ⟨.F, 1, 0⟩) ∨ (normalization.normalizedParentSlot = 1 ∧ + normalization.normalizedQuarterTurn = 3 ∧ uIndex = ⟨.C, 1, 0⟩ ∧ uBar = ⟨.C, 1, 1⟩ ∧ + wBlock = (0, 1) ∧ vIndex = ⟨.A, 0, -1⟩ ∧ vBar = ⟨.B, 1, 1⟩) ∨ + (normalization.normalizedParentSlot = 2 ∧ normalization.normalizedQuarterTurn = 0 ∧ + uIndex = ⟨.E, -1, 0⟩ ∧ uBar = ⟨.F, 0, -1⟩ ∧ wBlock = (-1, -1) ∧ vIndex = ⟨.A, -1, -1⟩ + ∧ vBar = ⟨.A, 0, -1⟩) ∨ (normalization.normalizedParentSlot = 2 ∧ + normalization.normalizedQuarterTurn = 1 ∧ uIndex = ⟨.F, 0, -1⟩ ∧ uBar = ⟨.F, 1, 0⟩ ∧ + wBlock = (1, 1) ∧ vIndex = ⟨.D, -1, -1⟩ ∧ vBar = ⟨.C, 1, 0⟩) ∨ + (normalization.normalizedParentSlot = 2 ∧ normalization.normalizedQuarterTurn = 2 ∧ + uIndex = ⟨.F, 1, 0⟩ ∧ uBar = ⟨.E, 0, 1⟩ ∧ wBlock = (1, 1) ∧ vIndex = ⟨.B, 1, 1⟩ ∧ + vBar = ⟨.B, 0, 1⟩) ∨ (normalization.normalizedParentSlot = 2 ∧ + normalization.normalizedQuarterTurn = 3 ∧ uIndex = ⟨.E, 0, 1⟩ ∧ uBar = ⟨.E, -1, 0⟩ ∧ + wBlock = (-1, -1) ∧ vIndex = ⟨.C, 1, 1⟩ ∧ vBar = ⟨.D, -1, 0⟩)) ∧ + normalization.normalizedFixed.cells = (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v uIndex).cells ∧ + V.cells = (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v vIndex).cells ∧ W = TileTranslation + normalization.normalizedRoot wShift ∧ wShift = (⟨0, 1⟩ : GaussianInt) ^ + normalization.normalizedQuarterTurn.val * (if Even + normalization.normalizedQuarterTurn.val then incoming + normalization.normalizedParentSlot else outgoing normalization.normalizedParentSlot) + ∧ (TileTranslation (TileQuarterTurn normalization.normalizedRoot) g).cells = + normalization.normalizedRoot.cells ∧ (TileTranslation (TileQuarterTurn + normalization.normalizedFixed) g).cells = (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v uBar).cells ∧ + (TileTranslation (TileQuarterTurn W) g).cells = (TileTranslation + normalization.normalizedRoot ((wBlock.1 : GaussianInt) * normalization.layout.u + + (wBlock.2 : GaussianInt) * normalization.layout.v)).cells ∧ (TileTranslation + (TileQuarterTurn V) g).cells = (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v vBar).cells ∧ + BandPrototile (Q normalization.normalizedParentSlot.succ) + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v uIndex) ∧ BandPrototile (Q ((if Even + normalization.normalizedQuarterTurn.val then normalization.normalizedParentSlot + 1 + else normalization.normalizedParentSlot - 1).succ)) V ∧ + ((SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v uIndex).cells = ∅ → (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v uIndex).anchor = + normalization.normalizedFixed.anchor) ∧ TileCentroid (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v uIndex) - + TileCentroid normalization.normalizedRoot = (1 / 2 : Real) • GaussianRealPoint ((⟨0, + 1⟩ : GaussianInt) ^ normalization.normalizedQuarterTurn.val * (incoming + normalization.normalizedParentSlot + outgoing normalization.normalizedParentSlot)) ∧ + TileCentroid V - TileCentroid normalization.normalizedRoot = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ normalization.normalizedQuarterTurn.val * + (if Even normalization.normalizedQuarterTurn.val then incoming + (normalization.normalizedParentSlot + 1) - outgoing + (normalization.normalizedParentSlot + 1) else outgoing + (normalization.normalizedParentSlot - 1) - incoming + (normalization.normalizedParentSlot - 1))))))))))))))))))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q edge incoming outgoing hsuper hin0 hflips hin1 + hin2 hUcentroid hVcentroid occurrenceBand quarterSymmetricTranslation g hrootBar + rotatedCentroid centeredCompare quarterTranslate hout0 hout1 rowsAt + let uIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ + else ⟨.A, -1, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ + else ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ + else ⟨.E, 0, 1⟩ + let vIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, 0⟩ + else ⟨.E, -1, 0⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.E, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 0, -1⟩ + else ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.A, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 1, 1⟩ + else ⟨.C, 1, 1⟩ + let wShift : GaussianInt := + (⟨0, 1⟩ : GaussianInt) ^ normalization.normalizedQuarterTurn.val * + (if Even normalization.normalizedQuarterTurn.val then + incoming normalization.normalizedParentSlot + else outgoing normalization.normalizedParentSlot) + let uBar : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.A, -1, -1⟩ + else ⟨.A, 0, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.D, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.C, 1, 0⟩ + else ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.F, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.E, 0, 1⟩ + else ⟨.E, -1, 0⟩ + let vBar : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.E, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ + else ⟨.F, 0, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.A, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ + else ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ + else ⟨.D, -1, 0⟩ + let wBlock : Int × Int := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 ∨ + normalization.normalizedQuarterTurn = 3 then (1, 0) else (-1, 0) + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 ∨ + normalization.normalizedQuarterTurn = 3 then (0, 1) else (0, -1) + else if normalization.normalizedQuarterTurn = 0 ∨ + normalization.normalizedQuarterTurn = 3 then (-1, -1) else (1, 1) + let U := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v uIndex + let V := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v vIndex + let W := TileTranslation normalization.normalizedRoot wShift + have hUBand := SubtileInterfaceAssembly.hUBand C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization + have hVBand := SubtileInterfaceAssembly.hVBand + C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization + have hUcent := SubtileInterfaceAssembly.hUcent C₀ + Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization hUcentroid + have hfixedEq := BandPrototileCentroidUnique + (Q normalization.normalizedParentSlot.succ) U normalization.normalizedFixed + hUBand (SubtileInterfaceAssembly.hFixedBand C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization) + (SubtileInterfaceAssembly.hcentUF C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization hUcent + (SubtileInterfaceAssembly.hfixedCent C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization)) + refine ⟨W, V, g, wShift, uIndex, uBar, vIndex, vBar, wBlock, + (SubtileInterfaceAssembly.hrow' C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization), hfixedEq.1.symm, + rfl, rfl, rfl, hrootBar, ?_, ?_, ?_, + hUBand, hVBand, hfixedEq.2, hUcent, ?_⟩ + · let Ubar := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v uBar + have hrot := rotatedCentroid U Ubar _ hUcent (SubtileInterfaceAssembly.hUbarCent C₀ Cᵢ q i + T₀ Tᵢ h₀ hᵢ x normalization rowsAt (SubtileInterfacePreparation.quarterPower)) + have hbar := centeredCompare _ U Ubar hUBand (SubtileInterfaceAssembly.hUbarBand C₀ Cᵢ q i + T₀ Tᵢ h₀ hᵢ x normalization) (SubtileInterfaceAssembly.hUSym C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x + normalization quarterSymmetricTranslation) hrot + simpa [Ubar, U, TileTranslation, TileQuarterTurn, hfixedEq.1] using hbar.1 + · have hshift : GaussianQuarterTurn wShift = + (wBlock.1 : GaussianInt) * normalization.layout.u + + (wBlock.2 : GaussianInt) * normalization.layout.v := SubtileInterfaceAssembly.hshift + C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization hflips hout0 hout1 + (SubtileInterfacePreparation.hout2 C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization + hsuper hin0 hin1 hin2 hout0 hout1) (SubtileInterfacePreparation.quarterTurnMul) + rw [show W = TileTranslation normalization.normalizedRoot wShift by rfl, + quarterTranslate normalization.normalizedRoot wShift g, hshift] + rw [(TileTranslationFormulas + (TileTranslation (TileQuarterTurn normalization.normalizedRoot) g) _).1, + (TileTranslationFormulas normalization.normalizedRoot _).1, hrootBar] + · let Vbar := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v vBar + have hrot := rotatedCentroid V Vbar _ (SubtileInterfaceAssembly.hVcent C₀ Cᵢ q i T₀ Tᵢ h₀ + hᵢ x normalization hVcentroid) (SubtileInterfaceAssembly.hVbarCent C₀ Cᵢ q i T₀ Tᵢ h₀ + hᵢ x normalization hflips rowsAt) + exact (centeredCompare _ V Vbar hVBand (SubtileInterfaceAssembly.hVbarBand C₀ Cᵢ q i T₀ Tᵢ + h₀ hᵢ x normalization occurrenceBand) (SubtileInterfaceAssembly.hVSym C₀ Cᵢ q i T₀ Tᵢ + h₀ hᵢ x normalization quarterSymmetricTranslation) hrot).1 + · simpa [V, vIndex] using hVcentroid + +end SubtileInterfaceRowPackage + +namespace SubtileInterfaceConclusion + +private theorem subtileInterfaceCertificate : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + let outgoing : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q 0) (Q j.succ) + (ProperBandQuadruple Q) → ((LatticeTile normalization.normalizedRoot) → + ((normalization.layout.O.cells ⊆ (normalization.layout.P (0 : Fin (3 : ℕ)) + true).cells) → ((normalization.layout.O.cells ⊆ (normalization.layout.P (0 : Fin (3 : + ℕ)) false).cells) → (((∀ (m : ℤ), ∀ (n : ℤ), ∀ (x_1 : LatticeCell), x_1 ∈ + (TileTranslation normalization.normalizedRoot ((↑m : GaussianInt) * + normalization.layout.u + (↑n : GaussianInt) * normalization.layout.v)).cells ↔ ∃ + (label : SixSubtileLabel), x_1 ∈ (ModifiedSubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.O normalization.layout.u + normalization.layout.v ⟨label, m, n⟩).cells) ∧ ∀ (m : ℤ), ∀ (n : ℤ), ∀ (r : ℤ), ∀ (s + : ℤ), (m, n) ≠ (r, s) → Disjoint (TileTranslation normalization.normalizedRoot ((↑m : + GaussianInt) * normalization.layout.u + (↑n : GaussianInt) * + normalization.layout.v)).cells (TileTranslation normalization.normalizedRoot ((↑r : + GaussianInt) * normalization.layout.u + (↑s : GaussianInt) * + normalization.layout.v)).cells) → (∀ (g : GaussianInt), ((TileTranslation + (TileQuarterTurn normalization.normalizedRoot) g).cells = + normalization.normalizedRoot.cells) → (∀ (uIndex : PeriodicSubtileIndex), ∀ (vIndex : + PeriodicSubtileIndex), ∀ (uBar : PeriodicSubtileIndex), ∀ (vBar : + PeriodicSubtileIndex), ∀ (wBlock : ℤ × ℤ), ∀ (wShift : GaussianInt), ∀ (V : + ProtoTile), ∀ (W : ProtoTile), (normalization.normalizedParentSlot = (0 : Fin (3 : + ℕ)) ∧ normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) ∧ uIndex = + (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ uBar = + (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ wBlock = ((1 : ℤ), + (0 : ℤ)) ∧ vIndex = (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) ∧ + vBar = (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ + normalization.normalizedParentSlot = (0 : Fin (3 : ℕ)) ∧ + normalization.normalizedQuarterTurn = (1 : Fin (4 : ℕ)) ∧ uIndex = + (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ uBar = + (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ wBlock = ((-1 : ℤ), + (0 : ℤ)) ∧ vIndex = (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) ∧ + vBar = (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ + normalization.normalizedParentSlot = (0 : Fin (3 : ℕ)) ∧ + normalization.normalizedQuarterTurn = (2 : Fin (4 : ℕ)) ∧ uIndex = + (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ uBar = + (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ wBlock = ((-1 : + ℤ), (0 : ℤ)) ∧ vIndex = (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) ∧ vBar = (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) ∨ normalization.normalizedParentSlot = (0 : Fin (3 : ℕ)) ∧ + normalization.normalizedQuarterTurn = (3 : Fin (4 : ℕ)) ∧ uIndex = + (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ uBar = + (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ wBlock = ((1 : ℤ), + (0 : ℤ)) ∧ vIndex = (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) ∧ + vBar = (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ + normalization.normalizedParentSlot = (1 : Fin (3 : ℕ)) ∧ + normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) ∧ uIndex = + (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ uBar = + (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) ∧ wBlock = ((0 : ℤ), + (1 : ℤ)) ∧ vIndex = (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ + vBar = (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) ∨ + normalization.normalizedParentSlot = (1 : Fin (3 : ℕ)) ∧ + normalization.normalizedQuarterTurn = (1 : Fin (4 : ℕ)) ∧ uIndex = + (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) ∧ uBar = + (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ wBlock = ((0 : ℤ), + (-1 : ℤ)) ∧ vIndex = (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ + vBar = (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ + normalization.normalizedParentSlot = (1 : Fin (3 : ℕ)) ∧ + normalization.normalizedQuarterTurn = (2 : Fin (4 : ℕ)) ∧ uIndex = + (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ uBar = + (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) ∧ wBlock = ((0 : ℤ), + (-1 : ℤ)) ∧ vIndex = (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) + ∧ vBar = (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) ∨ + normalization.normalizedParentSlot = (1 : Fin (3 : ℕ)) ∧ + normalization.normalizedQuarterTurn = (3 : Fin (4 : ℕ)) ∧ uIndex = + (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) ∧ uBar = + (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ wBlock = ((0 : ℤ), + (1 : ℤ)) ∧ vIndex = (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ + vBar = (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ + normalization.normalizedParentSlot = (2 : Fin (3 : ℕ)) ∧ + normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) ∧ uIndex = + (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) ∧ uBar = + (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ wBlock = ((-1 : ℤ), + (-1 : ℤ)) ∧ vIndex = (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) + ∧ vBar = (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ + normalization.normalizedParentSlot = (2 : Fin (3 : ℕ)) ∧ + normalization.normalizedQuarterTurn = (1 : Fin (4 : ℕ)) ∧ uIndex = + (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ uBar = + (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) ∧ wBlock = ((1 : ℤ), + (1 : ℤ)) ∧ vIndex = (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) + ∧ vBar = (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) ∨ + normalization.normalizedParentSlot = (2 : Fin (3 : ℕ)) ∧ + normalization.normalizedQuarterTurn = (2 : Fin (4 : ℕ)) ∧ uIndex = + (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) ∧ uBar = + (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ wBlock = ((1 : ℤ), + (1 : ℤ)) ∧ vIndex = (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ + vBar = (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ + normalization.normalizedParentSlot = (2 : Fin (3 : ℕ)) ∧ + normalization.normalizedQuarterTurn = (3 : Fin (4 : ℕ)) ∧ uIndex = + (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ uBar = + (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) ∧ wBlock = ((-1 : ℤ), + (-1 : ℤ)) ∧ vIndex = (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∧ + vBar = (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex)) → + ((normalization.normalizedFixed.cells = (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v uIndex).cells) → + ((V.cells = (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v vIndex).cells) → ((W = TileTranslation + normalization.normalizedRoot wShift) → ((wShift = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ^ (↑normalization.normalizedQuarterTurn : ℕ) * if Even + (↑normalization.normalizedQuarterTurn : ℕ) then incoming + normalization.normalizedParentSlot else outgoing normalization.normalizedParentSlot) + → (((TileTranslation (TileQuarterTurn normalization.normalizedFixed) g).cells = + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v uBar).cells) → (((TileTranslation (TileQuarterTurn W) g).cells + = (TileTranslation normalization.normalizedRoot ((↑wBlock.1 : GaussianInt) * + normalization.layout.u + (↑wBlock.2 : GaussianInt) * normalization.layout.v)).cells) + → (((TileTranslation (TileQuarterTurn V) g).cells = (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v vBar).cells) → + ((BandPrototile (Q normalization.normalizedParentSlot.succ) + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v uIndex)) → ((BandPrototile (Q (if Even + (↑normalization.normalizedQuarterTurn : ℕ) then normalization.normalizedParentSlot + + (1 : Fin (3 : ℕ)) else normalization.normalizedParentSlot - (1 : Fin (3 : ℕ))).succ) + V) → (((SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v uIndex).cells = ∅ → (SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v uIndex).anchor = + normalization.normalizedFixed.anchor) → ((TileCentroid + (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u + normalization.layout.v uIndex) - TileCentroid normalization.normalizedRoot = (1 / 2 : + ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ + (↑normalization.normalizedQuarterTurn : ℕ) * (incoming + normalization.normalizedParentSlot + outgoing normalization.normalizedParentSlot))) → + ((TileCentroid V - TileCentroid normalization.normalizedRoot = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ + (↑normalization.normalizedQuarterTurn : ℕ) * if Even + (↑normalization.normalizedQuarterTurn : ℕ) then incoming + (normalization.normalizedParentSlot + (1 : Fin (3 : ℕ))) - outgoing + (normalization.normalizedParentSlot + (1 : Fin (3 : ℕ))) else outgoing + (normalization.normalizedParentSlot - (1 : Fin (3 : ℕ))) - incoming + (normalization.normalizedParentSlot - (1 : Fin (3 : ℕ))))) → (Nonempty + (BandOrderedGeneralSubtileInterfaceCertificate normalization)))))))))))))))))))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing hproper hrootLattice hOA hOB + hblocks g hrootBar uIndex vIndex uBar vBar wBlock wShift V W hrow hfixedSource hVSource hW + hwShift hfixedBar hWBar hVBar hSourceBand hOtherBand hSourceAnchor hSourceCentroid + hOtherCentroid + have hseparation := BandOrderedGeneralSubtileCanonicalSeparation + normalization.layout.P normalization.layout.O normalization.normalizedRoot + normalization.normalizedFixed W V normalization.layout.u normalization.layout.v + g wShift normalization.normalizedParentSlot normalization.normalizedQuarterTurn + uIndex uBar vIndex vBar wBlock hrow hrootLattice + normalization.layout.parent_lattice hOA hOB normalization.layout.partition + hblocks.1 hblocks.2 hfixedSource hVSource hW hrootBar hfixedBar hWBar hVBar + rcases hseparation with + ⟨hRootLattice, hFixedLattice, hWLattice, hVLattice, + hRootFixed, hRootW, hFixedW, hRootV, hFixedV, hWV⟩ + let source := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v uIndex + change BandPrototile (Q normalization.normalizedParentSlot.succ) source at hSourceBand + change normalization.normalizedFixed.cells = source.cells at hfixedSource + change source.cells = ∅ → + source.anchor = normalization.normalizedFixed.anchor at hSourceAnchor + change TileCentroid source - TileCentroid normalization.normalizedRoot = + (1 / 2 : Real) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ normalization.normalizedQuarterTurn.val * + (incoming normalization.normalizedParentSlot + + outgoing normalization.normalizedParentSlot)) at hSourceCentroid + have hpaired := + (BandOrderedGeneralMixedAggregatePatches Q normalization.configuration + normalization.normalizedCircle normalization.normalizedRoot + normalization.layout normalization.root_quarter_turn).2.2 + normalization.normalizedParentSlot normalization.normalizedQuarterTurn + source V hSourceBand hOtherBand hSourceCentroid hOtherCentroid + dsimp only at hpaired + obtain ⟨rightData, incomingRaw, t5Data, hrightPoint, hpointNe, + hincomingOther, hrightOther, ht5Other⟩ := hpaired + have hWExact : W = TileTranslation normalization.normalizedRoot + ((⟨0, 1⟩ : GaussianInt) ^ normalization.normalizedQuarterTurn.val * + (if Even normalization.normalizedQuarterTurn.val then + BandVectors.1 + (Q normalization.normalizedParentSlot.succ) (Q 0) + else BandVectors.1 + (Q 0) (Q normalization.normalizedParentSlot.succ))) := + SubtileInterfaceAssembly.hWExact C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization wShift W + hW hwShift + let incomingData : ExactTileInterfaceTriple + normalization.normalizedRoot W source := hWExact.symm ▸ incomingRaw + have hincomingPoint := SubtileInterfaceAssembly.hincomingPoint C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x + normalization g uIndex + wBlock wShift V W hW hWBar hWLattice hRootW hFixedW hWV incomingRaw hWExact + have hincomingOtherCA := SubtileInterfaceAssembly.hincomingOtherCA C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x + normalization g uIndex + wBlock wShift V W hW hWBar hWLattice hRootW hFixedW hWV incomingRaw hWExact hincomingPoint + obtain ⟨startSource, hswapPoint, hswapOtherAB, hswapOtherBC, + hswapOtherCA⟩ := ExactTileInterfaceTripleSwapLast + normalization.normalizedRoot W source incomingData + obtain ⟨startData, hstartPoint, hstartOtherAB, hstartOtherBC, + hstartOtherCA⟩ := ExactTileInterfaceTripleRetargetMiddle + normalization.normalizedRoot source normalization.normalizedFixed W + hfixedSource.symm hSourceAnchor startSource + obtain ⟨endData, hendPoint, hendOtherAB, hendOtherBC, hendOtherCA⟩ := + ExactTileInterfaceTripleRetargetMiddle + normalization.normalizedRoot source normalization.normalizedFixed V + hfixedSource.symm hSourceAnchor t5Data + have hStartTouching : TouchingTriple normalization.normalizedRoot + normalization.normalizedFixed W := + ExactTileInterfaceTripleLatticeTouching + normalization.normalizedRoot normalization.normalizedFixed W startData + hRootLattice hFixedLattice hWLattice hRootFixed hFixedW hRootW.symm + have hEndTouching : TouchingTriple normalization.normalizedRoot + normalization.normalizedFixed V := + ExactTileInterfaceTripleLatticeTouching + normalization.normalizedRoot normalization.normalizedFixed V endData + hRootLattice hFixedLattice hVLattice hRootFixed hFixedV hRootV.symm + have hRootPositive : 0 < (Q 0).1 := + (ProperBandCurvatureStructure Q hproper).1 + have hFixedPositive : + 0 < normalization.normalizedFixedCircle.1.1.1 := + normalization.normalizedFixedCircle.2 + have hPointRoot : normalization.normalizedPoint ∈ + FootprintVertices normalization.normalizedRoot := + (Set.ext_iff.mp (PositiveCurvatureTileOdometerDomain + (Q 0) normalization.normalizedRoot normalization.normalizedRootFunction + hRootPositive normalization.normalized_root_odometer) + normalization.normalizedPoint).mp + normalization.normalized_point_root_domain + have hPointFixed : normalization.normalizedPoint ∈ + FootprintVertices normalization.normalizedFixed := + (Set.ext_iff.mp (PositiveCurvatureTileOdometerDomain + normalization.normalizedFixedCircle.1.1 normalization.normalizedFixed + normalization.normalizedFixedFunction hFixedPositive + normalization.normalized_fixed_odometer) + normalization.normalizedPoint).mp + normalization.normalized_point_fixed_domain + exact ⟨{ + startCompanion := W + endCompanion := V + startData := startData + endData := endData + normalized_point_on_start_path := ⟨hPointRoot, hPointFixed⟩ + interface_endpoints := (SubtileInterfaceAssembly.hEndpoints C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x + normalization uIndex V W incomingRaw t5Data hincomingOther ht5Other hWExact + hincomingPoint hincomingOtherCA startSource hswapPoint hswapOtherAB startData + hstartPoint hstartOtherAB endData hendPoint hendOtherAB) + root_lattice := hRootLattice + fixed_lattice := hFixedLattice + start_lattice := hWLattice + end_lattice := hVLattice + root_fixed_disjoint := hRootFixed + root_start_disjoint := hRootW + fixed_start_disjoint := hFixedW + root_end_disjoint := hRootV + fixed_end_disjoint := hFixedV + start_end_disjoint := hWV + start_touching := hStartTouching + end_touching := hEndTouching }⟩ + +end SubtileInterfaceConclusion + +theorem BandOrderedGeneralSubtileInterfaceCertificateExists + {C₀ Cᵢ : BandCircle} {q : Fin 4 → CircleCoordinates} + {i : Fin 3} {T₀ Tᵢ : ProtoTile} + {h₀ hᵢ : PartialOdometer} {x : GaussianInt} + (normalization : BandOrderedGeneralSubtileNormalizationCertificate + C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x) : + Nonempty (BandOrderedGeneralSubtileInterfaceCertificate normalization) := by +-- BODY + let Q := normalization.normalizedPresentation + let edge : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q ((j + 2).succ)) (Q ((j + 1).succ)) + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q j.succ) (Q 0) + let outgoing : Fin 3 → GaussianInt := fun j => + BandVectors.1 (Q 0) (Q j.succ) + have hproper : ProperBandQuadruple Q := by + simpa [Q] using normalization.configuration.proper + obtain ⟨hsuper, _, hin0, _, hflip⟩ := VectorRecursionLaws Q hproper.1 + have hflips := hflip hproper + let R : Fin 4 → CircleCoordinates := ![Q 0, Q 2, Q 3, Q 1] + have hR : SemiProperQuadruple R := by + simpa [R] using SemiProperQuadruple.rotate hproper.1 + let S : Fin 4 → CircleCoordinates := ![R 0, R 2, R 3, R 1] + have hS : SemiProperQuadruple S := by + simpa [S] using SemiProperQuadruple.rotate hR + have hin1 : incoming 1 = + edge 2 - (⟨0, 1⟩ : GaussianInt) * edge 0 := SubtileInterfacePreparation.hin1 C₀ Cᵢ q i T₀ + Tᵢ h₀ hᵢ x normalization hR + have hin2 : incoming 2 = + edge 0 - (⟨0, 1⟩ : GaussianInt) * edge 1 := SubtileInterfacePreparation.hin2 C₀ Cᵢ q i T₀ + Tᵢ h₀ hᵢ x normalization hS + have hrows := BandOrderedGeneralSubtileCanonicalRows + normalization.layout.P normalization.normalizedRoot + normalization.layout.u normalization.layout.v + normalization.normalizedParentSlot normalization.normalizedQuarterTurn + edge incoming outgoing + (by simpa [edge] using hsuper) + (by simpa [incoming, edge] using hin0) + hin1 hin2 + (by + intro j + simpa [incoming, outgoing] using (hflips j).1) + (by simpa [outgoing, Q] using normalization.layout.period_u) + (by simpa [outgoing, Q] using normalization.layout.period_v) + (by + intro j e + simpa [edge, Q] using + (normalization.layout.outer_occurrence j e).2.2) + obtain ⟨hUcentroid, hVcentroid⟩ := hrows + have hrootLattice : LatticeTile normalization.normalizedRoot := + (BandTileSimultaneousInduction Q hproper normalization.normalizedRoot + (by simpa [Q] using normalization.root_band)).1 + have hOA := SubtileInterfacePreparation.hOA C₀ Cᵢ q i T₀ Tᵢ h₀ + hᵢ x normalization + have hOB := SubtileInterfacePreparation.hOB C₀ Cᵢ q i T₀ Tᵢ + h₀ hᵢ x normalization + have hblocks := BandOrderedGeneralPeriodicBlockCells Q + normalization.configuration normalization.normalizedCircle + normalization.normalizedRoot normalization.layout + have occurrenceBand := SubtileInterfacePreparation.occurrenceBand C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x + normalization + have quarterSymmetricTranslation := SubtileInterfaceGeometry.quarterSymmetricTranslation + have occurrenceSymmetric := SubtileInterfacePreparation.occurrenceSymmetric C₀ Cᵢ q i T₀ Tᵢ h₀ + hᵢ x normalization quarterSymmetricTranslation + obtain ⟨g, hg, hrootBar, hrootAnchor, hrootFoot, hrootCentroid⟩ := + QuarterTurnSymmetricCenteredTransport normalization.normalizedRoot + normalization.root_quarter_turn + let uIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ + else ⟨.A, -1, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ + else ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ + else ⟨.E, 0, 1⟩ + let vIndex : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, 0⟩ + else ⟨.E, -1, 0⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.E, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 0, -1⟩ + else ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.A, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 1, 1⟩ + else ⟨.C, 1, 1⟩ + let uBar : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.A, -1, -1⟩ + else ⟨.A, 0, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.D, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.C, 1, 0⟩ + else ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.F, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.E, 0, 1⟩ + else ⟨.E, -1, 0⟩ + let vBar : PeriodicSubtileIndex := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.E, 0, 1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ + else ⟨.F, 0, -1⟩ + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.A, -1, -1⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ + else ⟨.B, 1, 1⟩ + else if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ + else if normalization.normalizedQuarterTurn = 1 then ⟨.C, 1, 0⟩ + else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ + else ⟨.D, -1, 0⟩ + let wBlock : Int × Int := + if normalization.normalizedParentSlot = 0 then + if normalization.normalizedQuarterTurn = 0 ∨ + normalization.normalizedQuarterTurn = 3 then (1, 0) else (-1, 0) + else if normalization.normalizedParentSlot = 1 then + if normalization.normalizedQuarterTurn = 0 ∨ + normalization.normalizedQuarterTurn = 3 then (0, 1) else (0, -1) + else if normalization.normalizedQuarterTurn = 0 ∨ + normalization.normalizedQuarterTurn = 3 then (-1, -1) else (1, 1) + let wShift : GaussianInt := + (⟨0, 1⟩ : GaussianInt) ^ normalization.normalizedQuarterTurn.val * + (if Even normalization.normalizedQuarterTurn.val then + incoming normalization.normalizedParentSlot + else outgoing normalization.normalizedParentSlot) + let U := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v uIndex + let V := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v vIndex + let W := TileTranslation normalization.normalizedRoot wShift + have rowsAt (p : Fin 3) (t : Fin 4) := + BandOrderedGeneralSubtileCanonicalRows + normalization.layout.P normalization.normalizedRoot + normalization.layout.u normalization.layout.v p t edge incoming outgoing + (by simpa [edge] using hsuper) + (by simpa [incoming, edge] using hin0) hin1 hin2 + (by intro j; simpa [incoming, outgoing] using (hflips j).1) + (by simpa [outgoing, Q] using normalization.layout.period_u) + (by simpa [outgoing, Q] using normalization.layout.period_v) + (by + intro j e + simpa [edge, Q] using + (normalization.layout.outer_occurrence j e).2.2) + have rowPackage := SubtileInterfaceRowPackage.rowPackage C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization + hsuper hin0 hflips hin1 hin2 hUcentroid hVcentroid occurrenceBand + quarterSymmetricTranslation g hrootBar + (SubtileInterfacePreparation.rotatedCentroid C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x + normalization g hg) (SubtileInterfaceGeometry.centeredCompare g) + (SubtileInterfaceGeometry.quarterTranslate) + (SubtileInterfacePreparation.hout0 C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x + normalization hflips) (SubtileInterfacePreparation.hout1 C₀ Cᵢ q i T₀ + Tᵢ h₀ hᵢ x normalization hflips) rowsAt + obtain ⟨W, V, g, wShift, uIndex, uBar, vIndex, vBar, wBlock, + hrow, hfixedSource, hVSource, hW, hwShift, hrootBar, hfixedBar, hWBar, + hVBar, hSourceBand, hOtherBand, hSourceAnchor, hSourceCentroid, + hOtherCentroid⟩ := rowPackage + exact (SubtileInterfaceConclusion.subtileInterfaceCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x + normalization hproper hrootLattice hOA hOB hblocks g hrootBar uIndex vIndex uBar vBar + wBlock wShift V W hrow hfixedSource hVSource hW hwShift hfixedBar hWBar hVBar hSourceBand + hOtherBand hSourceAnchor hSourceCentroid hOtherCentroid) + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificate.lean new file mode 100644 index 0000000000..6bc85a00a6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificate.lean @@ -0,0 +1,248 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation + +-- [TABLET NODE: BandOrderedGeneralSubtileNormalizationCertificate] + +/-! +# BandOrderedGeneralSubtileNormalizationCertificate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For the supplied proper presentation $q$ of a subtile-lattice pair +$(C_0,C_i,T_0,T_i,h_0,h_i)$, a subtile normalization certificate records +one cyclic parent rotation and one packing-symmetry word, the resulting +ordered-general presentation, transformed circles, literal supports, +functions, point, and slopes, and the transported subtile adjacency. It +retains the transformed parent slot and quarter-turn index and the literal +parent-coordinate, centroid, and two slope equations returned by transport. +It contains one ordered-general layout rooted at the transformed $T_0$, a +centered quarter-turn symmetry of that root, and one reindexed six-piece +decomposition of its transformed odometer. + +The certificate assigns each of the six decomposition pieces to one of the +six central periodic occurrences and records equality of cells, conditional +equality of empty anchors, equality of footprints, and equality of function +domains. It also assigns the transformed fixed support to one of the twelve +exterior occurrences +$$ + A_{-1,-1},A_{0,-1},C_{1,0},C_{1,1},E_{0,1},E_{-1,0}, + B_{1,1},B_{0,1},D_{-1,0},D_{-1,-1},F_{0,-1},F_{1,0} +$$ +with cell and conditional empty-anchor equality. Finally it retains the +transformed point in both function domains and the transported five-point +footprint cover. It contains no outer-interface record and makes no choice +of a decomposition piece. +-/ +structure BandOrderedGeneralSubtileNormalizationCertificate + (C₀ Cᵢ : BandCircle) (q : Fin 4 → CircleCoordinates) + (i : Fin 3) (T₀ Tᵢ : ProtoTile) + (h₀ hᵢ : PartialOdometer) (x : GaussianInt) where +-- BODY + presentation_proper : ProperBandQuadruple q + presentation_child : q 0 = C₀.1.1 + presentation_parent : q i.succ = Cᵢ.1.1 + /-- The cyclic parent rotation used before applying the packing symmetry. -/ + parentRotation : Fin 3 + /-- The single packing-symmetry word used throughout the normalization. -/ + symmetry : BandPackingSymmetry + /-- The source presentation after the chosen cyclic parent rotation. -/ + rotatedPresentation : Fin 4 → CircleCoordinates + rotated_presentation_eq : rotatedPresentation = + ![q 0, q parentRotation.succ, q (parentRotation + 1).succ, + q (parentRotation + 2).succ] + /-- The ordered-general presentation obtained by the symmetry action. -/ + normalizedPresentation : Fin 4 → CircleCoordinates + normalized_presentation_eq : normalizedPresentation = + BandPackingSymmetryQuadrupleAction symmetry rotatedPresentation + /-- The ordered-general predecessor data for the normalized presentation. -/ + configuration : BandOrderedGeneralConfiguration normalizedPresentation + /-- The positive root circle in the normalized presentation. -/ + normalizedCircle : BandCircle + normalized_circle_eq : normalizedPresentation 0 = normalizedCircle.1.1 + /-- The transformed positive circle of the fixed tile odometer. -/ + normalizedFixedCircle : BandCircle + normalized_fixed_circle_eq : normalizedFixedCircle.1.1 = + BandPackingSymmetryCircleAction symmetry Cᵢ.1.1 + /-- The literal transformed root support. -/ + normalizedRoot : ProtoTile + /-- The literal transformed fixed support. -/ + normalizedFixed : ProtoTile + /-- The transformed root odometer on its actual finite domain. -/ + normalizedRootFunction : PartialOdometer + /-- The transformed fixed odometer on its actual finite domain. -/ + normalizedFixedFunction : PartialOdometer + /-- The transformed lattice contact point. -/ + normalizedPoint : GaussianInt + normalized_root_eq : normalizedRoot = BandPackingSymmetryTileAction symmetry T₀ + normalized_fixed_eq : normalizedFixed = BandPackingSymmetryTileAction symmetry Tᵢ + normalized_root_function_eq : normalizedRootFunction = + BandPackingSymmetryPartialOdometerAction symmetry h₀ + normalized_fixed_function_eq : normalizedFixedFunction = + BandPackingSymmetryPartialOdometerAction symmetry hᵢ + normalized_point_eq : normalizedPoint = + BandPackingSymmetryVectorAction symmetry x + normalized_point_root_domain : normalizedPoint ∈ normalizedRootFunction.domain + normalized_point_fixed_domain : normalizedPoint ∈ normalizedFixedFunction.domain + normalized_root_odometer : + TileOdometer (normalizedPresentation 0) normalizedRoot normalizedRootFunction + normalized_fixed_odometer : + TileOdometer normalizedFixedCircle.1.1 normalizedFixed normalizedFixedFunction + /-- The defined slope of the transformed root odometer. -/ + normalizedRootSlope : ℝ × ℝ + /-- The defined slope of the transformed fixed odometer. -/ + normalizedFixedSlope : ℝ × ℝ + normalized_root_slope : + PartialOdometerSlope normalizedRootFunction = some normalizedRootSlope + normalized_fixed_slope : + PartialOdometerSlope normalizedFixedFunction = some normalizedFixedSlope + /-- The parent slot after transporting the supplied subtile adjacency. -/ + normalizedParentSlot : Fin 3 + /-- The transported quarter-turn index of that subtile-adjacency witness. -/ + normalizedQuarterTurn : Fin 4 + normalized_parent_coordinate : + normalizedPresentation normalizedParentSlot.succ = normalizedFixedCircle.1.1 + normalized_adjacency_centroid : + TileCentroid normalizedFixed - TileCentroid normalizedRoot = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ normalizedQuarterTurn.val * + (BandVectors.1 (normalizedPresentation normalizedParentSlot.succ) + (normalizedPresentation 0) + + BandVectors.1 (normalizedPresentation 0) + (normalizedPresentation normalizedParentSlot.succ))) + normalized_adjacency_slope_real : + normalizedFixedSlope.1 - normalizedRootSlope.1 = + ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ normalizedQuarterTurn.val * + (BandVectors.2 (normalizedPresentation normalizedParentSlot.succ) + (normalizedPresentation 0) + + BandVectors.2 (normalizedPresentation 0) + (normalizedPresentation normalizedParentSlot.succ)))).1 + normalized_adjacency_slope_imag : + normalizedFixedSlope.2 - normalizedRootSlope.2 = + ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ normalizedQuarterTurn.val * + (BandVectors.2 (normalizedPresentation normalizedParentSlot.succ) + (normalizedPresentation 0) + + BandVectors.2 (normalizedPresentation 0) + (normalizedPresentation normalizedParentSlot.succ)))).2 + /-- The single family of six signed supports in the normalized root decomposition. -/ + pieces : Fin 3 → Bool → ProtoTile + /-- The literal partial odometers on that same six-piece family. -/ + functions : Fin 3 → Bool → PartialOdometer + root_band : BandPrototile (normalizedPresentation 0) normalizedRoot + piece_odometer : ∀ j e, TileOdometer (normalizedPresentation j.succ) + (pieces j e) (functions j e) + piece_cell_cover : ∀ z, z ∈ normalizedRoot.cells ↔ + ∃ j e, z ∈ (pieces j e).cells + piece_footprint : ∀ j e, + FootprintVertices (pieces j e) ⊆ FootprintVertices normalizedRoot + piece_centroid : ∀ j e, + TileCentroid (pieces j e) - TileCentroid normalizedRoot = + (if e = true then (1 : ℝ) else -1) • + ((1 / 2 : ℝ) • + (GaussianRealPoint + (BandVectors.1 (normalizedPresentation ((j + 2).succ)) + (normalizedPresentation ((j + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (normalizedPresentation ((j + 2).succ)) + (normalizedPresentation ((j + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (normalizedPresentation ((j + 2).succ)) + (normalizedPresentation ((j + 1).succ)))).1))) + function_domain_cover : ∀ z, z ∈ normalizedRootFunction.domain ↔ + ∃ j e, z ∈ (functions j e).domain + function_restriction : ∀ j e z, z ∈ (functions j e).domain → + normalizedRootFunction.value z = (functions j e).value z + function_compatibility : ∀ j e k t, + OdometerCompatibility (functions j e) (functions k t) + piece_slope : ∀ j e, (normalizedPresentation j.succ).1 = 0 ∨ + ∃ p p_j : ℝ × ℝ, + PartialOdometerSlope normalizedRootFunction = some p ∧ + PartialOdometerSlope (functions j e) = some p_j ∧ + p_j.1 - p.1 = + (if e = true then (1 : ℝ) else -1) * (1 / 2) * + (((BandVectors.2 (normalizedPresentation ((j + 2).succ)) + (normalizedPresentation ((j + 1).succ))).re : ℤ) - + ((BandVectors.2 (normalizedPresentation ((j + 2).succ)) + (normalizedPresentation ((j + 1).succ))).im : ℤ)) ∧ + p_j.2 - p.2 = + (if e = true then (1 : ℝ) else -1) * (1 / 2) * + (((BandVectors.2 (normalizedPresentation ((j + 2).succ)) + (normalizedPresentation ((j + 1).succ))).im : ℤ) + + ((BandVectors.2 (normalizedPresentation ((j + 2).succ)) + (normalizedPresentation ((j + 1).succ))).re : ℤ)) + adjacency : SubtileLatticeAdjacent normalizedCircle normalizedFixedCircle + normalizedRoot normalizedFixed normalizedRootFunction normalizedFixedFunction + root_quarter_turn : QuarterTurnSymmetric normalizedRoot + /-- The literal ordered-general layout rooted at the normalized decomposed root tile. -/ + layout : BandOrderedGeneralLayoutCertificate normalizedPresentation configuration + normalizedCircle normalizedRoot + /-- The central periodic occurrence index aligned with each signed decomposition piece. -/ + pieceIndex : Fin 3 → Bool → PeriodicSubtileIndex + piece_index_central : ∀ j e, + pieceIndex j e = ⟨.A, 0, 0⟩ ∨ pieceIndex j e = ⟨.B, 0, 0⟩ ∨ + pieceIndex j e = ⟨.C, 0, 0⟩ ∨ pieceIndex j e = ⟨.D, 0, 0⟩ ∨ + pieceIndex j e = ⟨.E, 0, 0⟩ ∨ pieceIndex j e = ⟨.F, 0, 0⟩ + piece_layout_cells : ∀ j e, (pieces j e).cells = + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e)).cells + piece_layout_empty_anchor : ∀ j e, (pieces j e).cells = ∅ → + (pieces j e).anchor = + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e)).anchor + piece_layout_footprint : ∀ j e, + FootprintVertices (pieces j e) = FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e)) + piece_layout_domain : ∀ j e, + ((functions j e).domain : Set GaussianInt) = FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e)) + /-- The literal exterior occurrence aligned with the entire normalized fixed support. -/ + exteriorIndex : PeriodicSubtileIndex + exterior_index : + exteriorIndex = ⟨.A, -1, -1⟩ ∨ exteriorIndex = ⟨.A, 0, -1⟩ ∨ + exteriorIndex = ⟨.C, 1, 0⟩ ∨ exteriorIndex = ⟨.C, 1, 1⟩ ∨ + exteriorIndex = ⟨.E, 0, 1⟩ ∨ exteriorIndex = ⟨.E, -1, 0⟩ ∨ + exteriorIndex = ⟨.B, 1, 1⟩ ∨ exteriorIndex = ⟨.B, 0, 1⟩ ∨ + exteriorIndex = ⟨.D, -1, 0⟩ ∨ exteriorIndex = ⟨.D, -1, -1⟩ ∨ + exteriorIndex = ⟨.F, 0, -1⟩ ∨ exteriorIndex = ⟨.F, 1, 0⟩ + fixed_exterior_cells : + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + exteriorIndex).cells = normalizedFixed.cells + fixed_exterior_empty_anchor : + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + exteriorIndex).cells = ∅ → + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + exteriorIndex).anchor = normalizedFixed.anchor + normalized_star : ∀ y, + y = normalizedPoint ∨ y = normalizedPoint + 1 ∨ + y = normalizedPoint - 1 ∨ y = normalizedPoint + ⟨0, 1⟩ ∨ + y = normalizedPoint - ⟨0, 1⟩ → + y ∈ FootprintVertices normalizedRoot ∨ + y ∈ FootprintVertices normalizedFixed + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean new file mode 100644 index 0000000000..f173f9ae7e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean @@ -0,0 +1,1449 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5658T1FivePointDomainCoverSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileNormalizationCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileCanonicalRows +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandOrderedGeneralSubtileNormalizationCertificateExists] + +/-! +# BandOrderedGeneralSubtileNormalizationCertificateExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SubtileNormalizationGeometry + +private theorem hqrotSemi : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (q' : Fin (4 : ℕ) → + CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), ( + let q' := BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 + : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : + FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : + DiamondParameter), (1 : ℕ) < K.1 ∧ q' = DiamondRecursiveQuadruple K) (Nonempty + (BandOrderedGeneralConfiguration q')))) → ( + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + SemiProperQuadruple qrot)) ) := by + classical + intro q hq q' r g hregime qrot + fin_cases r + · convert hq.1 using 1; funext j; fin_cases j <;> simp [qrot] + · convert SemiProperQuadruple.rotate hq.1 using 1; + funext j; fin_cases j <;> simp [qrot] + · convert SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate hq.1) using 1; + funext j; fin_cases j <;> simp [qrot] + +private theorem hqrot : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (q' : Fin (4 : ℕ) → + CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), ( + let q' := BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 + : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : + FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : + DiamondParameter), (1 : ℕ) < K.1 ∧ q' = DiamondRecursiveQuadruple K) (Nonempty + (BandOrderedGeneralConfiguration q')))) → ( + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + (SemiProperQuadruple qrot) → (ProperBandQuadruple qrot))) ) := by + classical + intro q hq q' r g hregime qrot hqrotSemi + refine ⟨hqrotSemi, ?_⟩ + intro j + fin_cases r <;> fin_cases j <;> simp [qrot] + · simpa using hq.2 (0 : Fin 3) + · simpa using hq.2 (1 : Fin 3) + · simpa using hq.2 (2 : Fin 3) + · simpa using hq.2 (1 : Fin 3) + · simpa using hq.2 (2 : Fin 3) + · simpa using hq.2 (0 : Fin 3) + · simpa using hq.2 (2 : Fin 3) + · simpa using hq.2 (0 : Fin 3) + · simpa using hq.2 (1 : Fin 3) + +private theorem hgeneral : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), (¬((∃ (g : BandPackingSymmetry) + (P : FordFareyParameter), BandPackingSymmetryCircleAction g (FordCircleCoordinate P.p + P.q) = C₀.1.1) ∨ ∃ (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction g (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ))) = + C₀.1.1)) → ((q (0 : Fin (4 : ℕ)) = C₀.1.1) → (∀ (q' : Fin (4 : ℕ) → + CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), ( + let q' := BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 + : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : + FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : + DiamondParameter), (1 : ℕ) < K.1 ∧ q' = DiamondRecursiveQuadruple K) (Nonempty + (BandOrderedGeneralConfiguration q')))) → ( + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + Nonempty (BandOrderedGeneralConfiguration qbar)))) ) := by + classical + intro C₀ q horbit hq₀ q' r g hregime qrot qbar + dsimp [qbar, qrot] at hregime + rcases hregime with hford | hrest + · exfalso + rcases hford.1 with ⟨P, _, heq⟩ + obtain ⟨ginv, hinv, _, _, _, _, _, _, _, _, _⟩ := + BandPackingSymmetryInversePhaseCancellation.2 g + apply horbit + left + refine ⟨ginv, P, ?_⟩ + calc + BandPackingSymmetryCircleAction ginv (FordCircleCoordinate P.p P.q) = + BandPackingSymmetryCircleAction ginv + (BandPackingSymmetryCircleAction g C₀.1.1) := by + have h0 := congrFun heq 0 + simpa [BandPackingSymmetryQuadrupleAction, + FordRecursiveQuadruple, hq₀] using congrArg + (BandPackingSymmetryCircleAction ginv) h0.symm + _ = C₀.1.1 := hinv _ + · rcases hrest.1 with hdiamond | hgeneral + · exfalso + rcases hdiamond.1 with ⟨K, _, heq⟩ + obtain ⟨ginv, hinv, _, _, _, _, _, _, _, _, _⟩ := + BandPackingSymmetryInversePhaseCancellation.2 g + apply horbit + right + refine ⟨ginv, K, ?_⟩ + calc + BandPackingSymmetryCircleAction ginv + (DiamondRecursiveQuadruple K 0) = + BandPackingSymmetryCircleAction ginv + (BandPackingSymmetryCircleAction g C₀.1.1) := by + have h0 := congrFun heq 0 + simpa [BandPackingSymmetryQuadrupleAction, hq₀] using congrArg + (BandPackingSymmetryCircleAction ginv) h0.symm + _ = C₀.1.1 := hinv _ + · exact hgeneral.1 + +private theorem hO₀rot : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T₀ : ProtoTile), ∀ (h₀ : + PartialOdometer), (TileOdometer C₀.1.1 T₀ h₀) → (∀ (r : Fin (3 : ℕ)), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + (qrot 0 = C₀.1.1) → (TileOdometer (qrot 0) T₀ h₀)) ) := by + classical + intro C₀ q T₀ h₀ hO₀ r qrot hqrot₀ + rw [hqrot₀] + exact hO₀ + +private theorem hOᵢrot : + (by + classical + exact + ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (Tᵢ : + ProtoTile), ∀ (hᵢ : PartialOdometer), (q i.succ = Cᵢ.1.1) → ((TileOdometer Cᵢ.1.1 Tᵢ + hᵢ) → (∀ (r : Fin (3 : ℕ)), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i - r + (qrot irot.succ = q i.succ) → (TileOdometer (qrot irot.succ) Tᵢ hᵢ))) ) := by + classical + intro Cᵢ q i Tᵢ hᵢ hqᵢ hOᵢ r qrot irot hrotParent + rw [hrotParent, hqᵢ] + exact hOᵢ + +private theorem hcentroidRot : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (T₀ : ProtoTile), ∀ + (Tᵢ : ProtoTile), (TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)))) → + (∀ (r : Fin (3 : ℕ)), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i - r + (qrot irot.succ = q i.succ) → (TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * (BandVectors.1 (qrot irot.succ) + (qrot 0) + BandVectors.1 (qrot 0) (qrot irot.succ))))) ) := by + classical + intro q i s T₀ Tᵢ hcentroid r qrot irot hrotParent + simpa [qrot, hrotParent] using hcentroid + +private theorem hslopexRot : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (p₀ : ℝ × ℝ), ∀ (pᵢ : + ℝ × ℝ), (pᵢ.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i.succ)))).1) → (∀ (r : Fin (3 : ℕ)), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i - r + (qrot irot.succ = q i.succ) → (pᵢ.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : + GaussianInt) ^ s.val * (BandVectors.2 (qrot irot.succ) (qrot 0) + BandVectors.2 (qrot + 0) (qrot irot.succ)))).1)) ) := by + classical + intro q i s p₀ pᵢ hslopex r qrot irot hrotParent + simpa [qrot, hrotParent] using hslopex + +private theorem hslopeyRot : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (p₀ : ℝ × ℝ), ∀ (pᵢ : + ℝ × ℝ), (pᵢ.2 - p₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i.succ)))).2) → (∀ (r : Fin (3 : ℕ)), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i - r + (qrot irot.succ = q i.succ) → (pᵢ.2 - p₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : + GaussianInt) ^ s.val * (BandVectors.2 (qrot irot.succ) (qrot 0) + BandVectors.2 (qrot + 0) (qrot irot.succ)))).2)) ) := by + classical + intro q i s p₀ pᵢ hslopey r qrot irot hrotParent + simpa [qrot, hrotParent] using hslopey + +private theorem hqbarᵢ : + (by + classical + exact + ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), (q i.succ = + Cᵢ.1.1) → (∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i - r + (qrot irot.succ = q i.succ) → ( + let qbar := BandPackingSymmetryQuadrupleAction g qrot + let reverse := BandPackingSymmetryReversesOrientation g + let ibar : Fin 3 := if reverse then -irot else irot + qbar ibar.succ = BandPackingSymmetryCircleAction g Cᵢ.1.1)) ) := by + classical + intro Cᵢ q i hqᵢ r g qrot irot hrotParent qbar reverse ibar + have hact := congrArg (BandPackingSymmetryCircleAction g) + (hrotParent.trans hqᵢ) + generalize hi : irot = k at hact ⊢ + fin_cases k <;> + cases hrev : BandPackingSymmetryReversesOrientation g <;> + simpa [qbar, ibar, reverse, BandPackingSymmetryQuadrupleAction, + hi, hrev, Fin.neg_def, Fin.add_def] using hact + +private theorem hqbarᵢPos : + (by + classical + exact + (BandCircle) → (∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), (Fin 4) → (∀ (r : Fin + (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i - r + let qbar := BandPackingSymmetryQuadrupleAction g qrot + (ProperBandQuadruple qbar) → ((BandOrderedGeneralConfiguration qbar) → ((Bool) → ((Fin (4 + : ℕ)) → ( + let reverse := BandPackingSymmetryReversesOrientation g + let ibar : Fin 3 := if reverse then -irot else irot + 0 < (qbar ibar.succ).1)))))) ) := by + classical + intro Cᵢ q i s r g qrot irot qbar hqbar cfg negative sbar reverse ibar + have hn := (ProperBandCurvatureStructure qbar hqbar).2.1 ibar + have hnl := cfg.noLine ibar.succ + omega + +private theorem hx₀bar : + (by + classical + exact + ∀ (h₀ : PartialOdometer), (PartialOdometer) → (∀ (x : GaussianInt), (x ∈ h₀.domain) → (∀ + (g : BandPackingSymmetry), + let h₀bar := BandPackingSymmetryPartialOdometerAction g h₀ + let xbar := BandPackingSymmetryVectorAction g x + xbar ∈ h₀bar.domain)) ) := by + classical + intro h₀ hᵢ x hx₀ g h₀bar xbar + have hdom := (BandPackingSymmetryPartialOdometerActionFormulas g h₀ hᵢ).1 + have hxset : BandPackingSymmetryVectorAction g x ∈ + ((BandPackingSymmetryPartialOdometerAction g h₀).domain : + Set GaussianInt) := by + rw [hdom] + exact ⟨x, hx₀, rfl⟩ + exact hxset + +private theorem hxᵢbar : + (by + classical + exact + (PartialOdometer) → (∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), (x ∈ hᵢ.domain) → (∀ + (g : BandPackingSymmetry), + let hᵢbar := BandPackingSymmetryPartialOdometerAction g hᵢ + let xbar := BandPackingSymmetryVectorAction g x + xbar ∈ hᵢbar.domain)) ) := by + classical + intro h₀ hᵢ x hxᵢ g hᵢbar xbar + have hdom := (BandPackingSymmetryPartialOdometerActionFormulas g hᵢ h₀).1 + have hxset : BandPackingSymmetryVectorAction g x ∈ + ((BandPackingSymmetryPartialOdometerAction g hᵢ).domain : + Set GaussianInt) := by + rw [hdom] + exact ⟨x, hxᵢ, rfl⟩ + exact hxset + +private theorem hadjbar : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), + ∀ (h₀ : PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i - r + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (hqbar : ProperBandQuadruple qbar), ∀ (p₀bar : ℝ × ℝ), ∀ (pᵢbar : ℝ × ℝ), ∀ (sbar : Fin + (4 : ℕ)), (TileOdometer (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryTileAction g T₀) (BandPackingSymmetryPartialOdometerAction g h₀)) + → ((TileOdometer (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) + => if BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ) + (BandPackingSymmetryTileAction g Tᵢ) (BandPackingSymmetryPartialOdometerAction g hᵢ)) + → ((PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h₀) = some + p₀bar) → ((PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g hᵢ) = + some pᵢbar) → ((TileCentroid (BandPackingSymmetryTileAction g Tᵢ) - TileCentroid + (BandPackingSymmetryTileAction g T₀) = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ^ (↑sbar : ℕ) * (BandVectors.1 + (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ) + (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + BandVectors.1 + (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ)))) → + ((pᵢbar.1 - p₀bar.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑sbar : ℕ) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction g + qrot ((fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true + then -j else j) irot).succ) (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : + ℕ))) + BandVectors.2 (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ)))).1) → + ((pᵢbar.2 - p₀bar.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑sbar : ℕ) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction g + qrot ((fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true + then -j else j) irot).succ) (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : + ℕ))) + BandVectors.2 (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ)))).2) → ( + let reverse := BandPackingSymmetryReversesOrientation g + let ibar : Fin 3 := if reverse then -irot else irot + let T₀bar := BandPackingSymmetryTileAction g T₀ + let Tᵢbar := BandPackingSymmetryTileAction g Tᵢ + let h₀bar := BandPackingSymmetryPartialOdometerAction g h₀ + let hᵢbar := BandPackingSymmetryPartialOdometerAction g hᵢ + ∀ (hqbar₀Pos : 0 < (qbar 0).1), ∀ (hqbarᵢPos : 0 < (qbar ibar.succ).1), + let C₀bar : BandCircle := + ⟨⟨qbar 0, ⟨Or.inl hqbar₀Pos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbar₀Pos⟩ + let Cᵢbar : BandCircle := + ⟨⟨qbar ibar.succ, + ⟨Or.inl hqbarᵢPos, ⟨qbar, hqbar.1, ⟨ibar.succ, rfl⟩⟩⟩⟩, + hqbarᵢPos⟩ + SubtileLatticeAdjacent C₀bar Cᵢbar T₀bar Tᵢbar h₀bar hᵢbar))))))) ) := by + classical + intro q i T₀ Tᵢ h₀ hᵢ r g qrot irot qbar hqbar p₀bar pᵢbar sbar hO₀bar hOᵢbar hp₀bar hpᵢbar + hcentroidBar hslopexBar hslopeyBar reverse ibar T₀bar Tᵢbar h₀bar hᵢbar hqbar₀Pos hqbarᵢPos + C₀bar Cᵢbar + refine ⟨hO₀bar, hOᵢbar, p₀bar, pᵢbar, hp₀bar, hpᵢbar, + qbar, ibar, sbar, hqbar, rfl, rfl, ?_, ?_, ?_⟩ + · simpa [qbar, reverse, ibar] using hcentroidBar + · simpa [qbar, reverse, ibar] using hslopexBar + · simpa [qbar, reverse, ibar] using hslopeyBar + +private theorem hsmallT1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (q' : Fin 4 → CircleCoordinates), ∀ (T' : ProtoTile), ∀ (S' : Fin 3 → Bool → + ProtoTile), ProperBandQuadruple q' → BandPrototile (q' 0) T' → (∀ i, ∀ s, + BandSubtileOccurrence q' T' i s (S' i s)) → (∀ z, z ∈ T'.cells ↔ ∃ i s, z ∈ (S' i + s).cells) → Int.toNat (q' 0).1 < Int.toNat (qbar 0).1 → LatticeTile T' ∧ TileArea T' + = Int.toNat (q' 0).1 ∧ ∀ i, ∀ s, LatticeTile (TileCellComplement T' (S' i s)) ∧ + TileTouching (TileCellComplement T' (S' i s)) (S' i s) ) := by + classical + intro q r g qrot qbar q' T' S' hq' hT' hocc hcells _ + have hI := BandTileSimultaneousInduction q' hq' T' hT' + exact ⟨hI.1, hI.2.1, hI.2.2.1 S' hocc hcells⟩ + +private theorem hsmallT2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (D : CircleCoordinates), ∀ (U : ProtoTile), BandPrototile D U → Int.toNat D.1 < + Int.toNat (qbar 0).1 → QuarterTurnSymmetric U ) := by + classical + intro q r g qrot qbar D U hU _ + cases hU with + | line w z hw => + intro p + simp [TileRealization, TileCentroid] + | unit z a anchor => + intro p + have hc : TileCentroid (⟨{a}, anchor⟩ : ProtoTile) = + (((a.re : Int) : Real) + (1 / 2 : Real), + ((a.im : Int) : Real) + (1 / 2 : Real)) := by + simp [TileCentroid] + rw [hc] + rcases p with ⟨px, py⟩ + simp only [TileRealization, Finset.mem_singleton, Set.mem_iUnion] + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor + · rintro ⟨b, rfl, hlo, hhi⟩ + refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> + linarith [hlo.1, hlo.2, hhi.1, hhi.2] + · rintro ⟨b, rfl, hlo, hhi⟩ + refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> + linarith [hlo.1, hlo.2, hhi.1, hhi.2] + | @decompose q' hq' S' U' hS hcells hfoot hcent => + exact (BandTileSimultaneousInduction q' hq' U + (.decompose hq' hS hcells hfoot hcent)).2.2.2.1 + +private theorem hsmallT4 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (q' : Fin 4 → CircleCoordinates), ∀ (T' : ProtoTile), ∀ (U : ProtoTile), + ProperBandQuadruple q' → BandPrototile (q' 0) T' → Int.toNat (q' 0).1 < Int.toNat + (qbar 0).1 → 1 < (q' 0).1 → ∀ i : Fin 3, BandPrototile (q' i.succ) U → TileCentroid U + - TileCentroid T' = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q' i.succ) + (q' 0)) + GaussianRealPoint (BandVectors.1 (q' 0) (q' i.succ))) → TouchingTriple T' + (TileTranslation T' (BandVectors.1 (q' i.succ) (q' 0))) U ) := by + classical + intro q r g qrot qbar q' T' U hq' hT' _ hlarge i hU hcentU + exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.1 + hlarge i U hU hcentU + +private theorem hsmallT5 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (q' : Fin 4 → CircleCoordinates), ∀ (T' : ProtoTile), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), ProperBandQuadruple q' → BandPrototile (q' 0) T' → Int.toNat (q' 0).1 < + Int.toNat (qbar 0).1 → ∀ i : Fin 3, BandPrototile (q' i.succ) U → BandPrototile (q' + ((i + 1).succ)) V → TileCentroid U - TileCentroid T' = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q' i.succ) (q' 0)) + GaussianRealPoint + (BandVectors.1 (q' 0) (q' i.succ))) → TileCentroid V - TileCentroid T' = (1 / 2 : + Real) • (GaussianRealPoint (BandVectors.1 (q' ((i + 1).succ)) (q' 0)) - + GaussianRealPoint (BandVectors.1 (q' 0) (q' ((i + 1).succ)))) → TouchingTriple T' U V + ) := by + classical + intro q r g qrot qbar q' T' U V hq' hT' _ i hU hV hcentU hcentV + exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.2.1 + i U V hU hV hcentU hcentV + +private theorem hstarFootprint : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), + ∀ (h₀ : PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (r : Fin + (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i - r + let qbar := BandPackingSymmetryQuadrupleAction g qrot + (TileOdometer (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryTileAction g T₀) (BandPackingSymmetryPartialOdometerAction g h₀)) + → ((TileOdometer (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) + => if BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ) + (BandPackingSymmetryTileAction g Tᵢ) (BandPackingSymmetryPartialOdometerAction g hᵢ)) + → ( + let reverse := BandPackingSymmetryReversesOrientation g + let ibar : Fin 3 := if reverse then -irot else irot + let T₀bar := BandPackingSymmetryTileAction g T₀ + let Tᵢbar := BandPackingSymmetryTileAction g Tᵢ + let h₀bar := BandPackingSymmetryPartialOdometerAction g h₀ + let hᵢbar := BandPackingSymmetryPartialOdometerAction g hᵢ + let xbar := BandPackingSymmetryVectorAction g x + (0 < (qbar 0).1) → ((0 < (qbar ibar.succ).1) → ((∀ y, y = xbar ∨ y = xbar + 1 ∨ y = xbar + - 1 ∨ y = xbar + ⟨0, 1⟩ ∨ y = xbar - ⟨0, 1⟩ → y ∈ h₀bar.domain ∨ y ∈ hᵢbar.domain) → + (∀ y, y = xbar ∨ y = xbar + 1 ∨ y = xbar - 1 ∨ y = xbar + ⟨0, 1⟩ ∨ y = xbar - ⟨0, 1⟩ + → y ∈ FootprintVertices T₀bar ∨ y ∈ FootprintVertices Tᵢbar))))) ) := by + classical + intro q i T₀ Tᵢ h₀ hᵢ x r g qrot irot qbar hO₀bar hOᵢbar reverse ibar T₀bar Tᵢbar h₀bar hᵢbar + xbar hqbar₀Pos hqbarᵢPos hstarBarDomain y hy + have hs := hstarBarDomain y hy + have hd₀ := PositiveCurvatureTileOdometerDomain (qbar 0) T₀bar h₀bar + hqbar₀Pos hO₀bar + have hdᵢ := PositiveCurvatureTileOdometerDomain (qbar ibar.succ) + Tᵢbar hᵢbar hqbarᵢPos hOᵢbar + rcases hs with hs | hs + · left + exact (Set.ext_iff.mp hd₀ y).mp hs + · right + exact (Set.ext_iff.mp hdᵢ y).mp hs + +private theorem hpieceIndexCentral : + (by + classical + exact + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun j e => + match j, e with + | 0, true => .A | 0, false => .B + | 1, true => .C | 1, false => .D + | 2, true => .E | 2, false => .F + let pieceIndex : Fin 3 → Bool → PeriodicSubtileIndex := fun j e => + ⟨labelOf j e, 0, 0⟩ + ∀ (j : Fin 3), ∀ (e : Bool), pieceIndex j e = ⟨.A, 0, 0⟩ ∨ pieceIndex j e = ⟨.B, 0, 0⟩ ∨ + pieceIndex j e = ⟨.C, 0, 0⟩ ∨ pieceIndex j e = ⟨.D, 0, 0⟩ ∨ pieceIndex j e = ⟨.E, 0, + 0⟩ ∨ pieceIndex j e = ⟨.F, 0, 0⟩ ) := by + classical + intro labelOf pieceIndex j e + fin_cases j <;> cases e <;> simp [pieceIndex, labelOf] + +private theorem translation_zero : + (by + classical + exact + ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by + classical + intro U + cases U with + | mk cells anchor => + have hc : cells.image (GaussianTranslation 0) = cells := by + ext z + simp [GaussianTranslation] + simp [TileTranslation, hc, GaussianTranslation] + +private theorem centralOccurrence : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T₀ : ProtoTile), ∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (hqbar : ProperBandQuadruple qbar), ∀ (cfg : BandOrderedGeneralConfiguration qbar), + let T₀bar := BandPackingSymmetryTileAction g T₀ + ∀ (hqbar₀Pos : 0 < (qbar 0).1), + let C₀bar : BandCircle := + ⟨⟨qbar 0, ⟨Or.inl hqbar₀Pos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbar₀Pos⟩ + ∀ (layout : BandOrderedGeneralLayoutCertificate qbar cfg C₀bar T₀bar), + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun j e => + match j, e with + | 0, true => .A | 0, false => .B + | 1, true => .C | 1, false => .D + | 2, true => .E | 2, false => .F + let pieceIndex : Fin 3 → Bool → PeriodicSubtileIndex := fun j e => + ⟨labelOf j e, 0, 0⟩ + (∀ (U : ProtoTile), TileTranslation U 0 = U) → (∀ (j : Fin 3), ∀ (e : Bool), + SubtileOccurrenceInterpretation layout.P layout.u layout.v (pieceIndex j e) = + layout.P j e) ) := by + classical + intro q T₀ r g qrot qbar hqbar cfg T₀bar hqbar₀Pos C₀bar layout labelOf pieceIndex + translation_zero j e + fin_cases j <;> cases e <;> + simp [pieceIndex, labelOf, SubtileOccurrenceInterpretation, + translation_zero] + +private theorem centralData : + (by + classical + exact + (BandCircle) → (∀ (q : Fin 4 → CircleCoordinates), (Fin 3) → ((Fin 4) → (∀ (T₀ : + ProtoTile), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (hqbar : ProperBandQuadruple qbar), ∀ (cfg : BandOrderedGeneralConfiguration qbar), + (Bool) → ((Fin (4 : ℕ)) → ( + let T₀bar := BandPackingSymmetryTileAction g T₀ + ∀ (hqbar₀Pos : 0 < (qbar 0).1), + let C₀bar : BandCircle := + ⟨⟨qbar 0, ⟨Or.inl hqbar₀Pos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbar₀Pos⟩ + ∀ (layout : BandOrderedGeneralLayoutCertificate qbar cfg C₀bar T₀bar), ∀ (pieces : Fin (3 + : ℕ) → Bool → ProtoTile), ∀ (functions : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i + : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (qbar i.succ) (pieces i s) (functions i + s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (pieces i s) - TileCentroid + T₀bar = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (qbar (i + (2 : Fin (3 : ℕ))).succ) (qbar (i + (1 : Fin (3 : + ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (qbar (i + (2 : Fin (3 : ℕ))).succ) + (qbar (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (qbar (i + + (2 : Fin (3 : ℕ))).succ) (qbar (i + (1 : Fin (3 : ℕ))).succ))).1))) → ( + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun j e => + match j, e with + | 0, true => .A | 0, false => .B + | 1, true => .C | 1, false => .D + | 2, true => .E | 2, false => .F + let pieceIndex : Fin 3 → Bool → PeriodicSubtileIndex := fun j e => + ⟨labelOf j e, 0, 0⟩ + (∀ (j : Fin 3), ∀ (e : Bool), SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e) = layout.P j e) → (∀ (j : Fin 3), ∀ (e : Bool), (pieces j e).cells = + (SubtileOccurrenceInterpretation layout.P layout.u layout.v (pieceIndex j e)).cells ∧ + ((pieces j e).cells = ∅ → (pieces j e).anchor = (SubtileOccurrenceInterpretation + layout.P layout.u layout.v (pieceIndex j e)).anchor) ∧ FootprintVertices (pieces j e) + = FootprintVertices (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e)) ∧ ((functions j e).domain : Set GaussianInt) = FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u layout.v (pieceIndex j e)))))))))) ) + := by + classical + intro Cᵢ q i s T₀ r g qrot qbar hqbar cfg negative sbar T₀bar hqbar₀Pos C₀bar layout pieces + functions hpieceOdometer hpieceCentroid labelOf pieceIndex centralOccurrence j e + have hpieceBand : BandPrototile (qbar j.succ) (pieces j e) := + TileOdometerBandPrototile _ _ _ (hpieceOdometer j e) + have hlayoutBand : BandPrototile (qbar j.succ) + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e)) := by + rw [centralOccurrence] + exact (layout.outer_occurrence j e).1 + have hcentroidAlign : TileCentroid (pieces j e) = + TileCentroid (SubtileOccurrenceInterpretation layout.P layout.u + layout.v (pieceIndex j e)) := by + rw [centralOccurrence] + have hp := hpieceCentroid j e + have hl := (layout.outer_occurrence j e).2.2 + have hd : TileCentroid (pieces j e) - TileCentroid T₀bar = + TileCentroid (layout.P j e) - TileCentroid T₀bar := hp.trans hl.symm + apply Prod.ext + · have h := congrArg Prod.fst hd + simp only [Prod.fst_sub] at h + linarith + · have h := congrArg Prod.snd hd + simp only [Prod.snd_sub] at h + linarith + have hu := BandPrototileCentroidUnique (qbar j.succ) (pieces j e) + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e)) hpieceBand hlayoutBand hcentroidAlign + have ho := ProtoTileObservableExtensionality (pieces j e) + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e)) hu.1 hu.2 + have hparentPos : 0 < (qbar j.succ).1 := by + have hn := (ProperBandCurvatureStructure qbar hqbar).2.1 j + have hnl := cfg.noLine j.succ + omega + have hd := PositiveCurvatureTileOdometerDomain (qbar j.succ) + (pieces j e) (functions j e) hparentPos (hpieceOdometer j e) + exact ⟨hu.1, hu.2, ho.1, hd.trans ho.1⟩ + +private theorem hin1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + let edge : Fin 3 → GaussianInt := fun j => + BandVectors.1 (qbar ((j + 2).succ)) (qbar ((j + 1).succ)) + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (qbar j.succ) (qbar 0) + let R : Fin 4 → CircleCoordinates := ![qbar 0, qbar 2, qbar 3, qbar 1] + (SemiProperQuadruple R) → (incoming 1 = edge 2 - (⟨0, 1⟩ : GaussianInt) * edge 0) ) := by + classical + intro q r g qrot qbar edge incoming R hR + simpa [incoming, edge, R] using (VectorRecursionLaws R hR).2.2.1 + +private theorem hin2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + let edge : Fin 3 → GaussianInt := fun j => + BandVectors.1 (qbar ((j + 2).succ)) (qbar ((j + 1).succ)) + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (qbar j.succ) (qbar 0) + let R : Fin 4 → CircleCoordinates := ![qbar 0, qbar 2, qbar 3, qbar 1] + let S : Fin 4 → CircleCoordinates := ![R 0, R 2, R 3, R 1] + (SemiProperQuadruple S) → (incoming 2 = edge 0 - (⟨0, 1⟩ : GaussianInt) * edge 1) ) := by + classical + intro q r g qrot qbar edge incoming R S hS + simpa [incoming, edge, R, S] using (VectorRecursionLaws S hS).2.2.1 + +private theorem hexteriorIndex : + (by + classical + exact + ∀ (i : Fin 3), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let irot : Fin 3 := i - r + ∀ (sbar : Fin (4 : ℕ)), + let reverse := BandPackingSymmetryReversesOrientation g + let ibar : Fin 3 := if reverse then -irot else irot + let exteriorIndex : PeriodicSubtileIndex := + if ibar = 0 then + if sbar = 0 then ⟨.A, 0, -1⟩ + else if sbar = 1 then ⟨.B, 1, 1⟩ + else if sbar = 2 then ⟨.B, 0, 1⟩ + else ⟨.A, -1, -1⟩ + else if ibar = 1 then + if sbar = 0 then ⟨.C, 1, 1⟩ + else if sbar = 1 then ⟨.D, -1, 0⟩ + else if sbar = 2 then ⟨.D, -1, -1⟩ + else ⟨.C, 1, 0⟩ + else + if sbar = 0 then ⟨.E, -1, 0⟩ + else if sbar = 1 then ⟨.F, 0, -1⟩ + else if sbar = 2 then ⟨.F, 1, 0⟩ + else ⟨.E, 0, 1⟩ + exteriorIndex = ⟨.A, -1, -1⟩ ∨ exteriorIndex = ⟨.A, 0, -1⟩ ∨ exteriorIndex = ⟨.C, 1, 0⟩ ∨ + exteriorIndex = ⟨.C, 1, 1⟩ ∨ exteriorIndex = ⟨.E, 0, 1⟩ ∨ exteriorIndex = ⟨.E, -1, 0⟩ + ∨ exteriorIndex = ⟨.B, 1, 1⟩ ∨ exteriorIndex = ⟨.B, 0, 1⟩ ∨ exteriorIndex = ⟨.D, -1, + 0⟩ ∨ exteriorIndex = ⟨.D, -1, -1⟩ ∨ exteriorIndex = ⟨.F, 0, -1⟩ ∨ exteriorIndex = + ⟨.F, 1, 0⟩ ) := by + classical + intro i r g irot sbar reverse ibar exteriorIndex + generalize hi : ibar = j at ⊢ + generalize hs : sbar = t at ⊢ + fin_cases j <;> fin_cases t <;> simp [exteriorIndex, hi, hs] + +private theorem hexteriorCentroid : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T₀ : ProtoTile), ∀ (r : Fin (3 : + ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i - r + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (hqbar : ProperBandQuadruple qbar), ∀ (cfg : BandOrderedGeneralConfiguration qbar), ∀ + (sbar : Fin (4 : ℕ)), + let reverse := BandPackingSymmetryReversesOrientation g + let ibar : Fin 3 := if reverse then -irot else irot + let T₀bar := BandPackingSymmetryTileAction g T₀ + ∀ (hqbar₀Pos : 0 < (qbar 0).1), + let C₀bar : BandCircle := + ⟨⟨qbar 0, ⟨Or.inl hqbar₀Pos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbar₀Pos⟩ + ∀ (layout : BandOrderedGeneralLayoutCertificate qbar cfg C₀bar T₀bar), + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (qbar j.succ) (qbar 0) + let outgoing : Fin 3 → GaussianInt := fun j => + BandVectors.1 (qbar 0) (qbar j.succ) + let exteriorIndex : PeriodicSubtileIndex := + if ibar = 0 then + if sbar = 0 then ⟨.A, 0, -1⟩ + else if sbar = 1 then ⟨.B, 1, 1⟩ + else if sbar = 2 then ⟨.B, 0, 1⟩ + else ⟨.A, -1, -1⟩ + else if ibar = 1 then + if sbar = 0 then ⟨.C, 1, 1⟩ + else if sbar = 1 then ⟨.D, -1, 0⟩ + else if sbar = 2 then ⟨.D, -1, -1⟩ + else ⟨.C, 1, 0⟩ + else + if sbar = 0 then ⟨.E, -1, 0⟩ + else if sbar = 1 then ⟨.F, 0, -1⟩ + else if sbar = 2 then ⟨.F, 1, 0⟩ + else ⟨.E, 0, 1⟩ + ( + let uIndex := if ibar = (0 : Fin (3 : ℕ)) then if sbar = (0 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar = (1 : + Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else + if sbar = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if ibar = (1 : Fin (3 : ℕ)) then if sbar = (0 : Fin (4 : + ℕ)) then (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar + = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if sbar = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 + : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if sbar = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.E, (-1 + : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar = (1 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar = (2 : + Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); + let vIndex := if ibar = (0 : Fin (3 : ℕ)) then if sbar = (0 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar = (1 : + Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else + if sbar = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if ibar = (1 : Fin (3 : ℕ)) then if sbar = (0 : Fin (4 : + ℕ)) then (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar + = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : + PeriodicSubtileIndex) else if sbar = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (0 : + ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if sbar = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.A, (-1 + : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar = (1 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar = (2 : + Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); + let U := SubtileOccurrenceInterpretation layout.P layout.u layout.v uIndex; + let V := SubtileOccurrenceInterpretation layout.P layout.u layout.v vIndex; TileCentroid + U - TileCentroid T₀bar = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑sbar : ℕ) * (incoming ibar + outgoing ibar)) ∧ TileCentroid V - + TileCentroid T₀bar = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑sbar : ℕ) * if Even (↑sbar : ℕ) then incoming (ibar + (1 : Fin (3 : + ℕ))) - outgoing (ibar + (1 : Fin (3 : ℕ))) else outgoing (ibar - (1 : Fin (3 : ℕ))) - + incoming (ibar - (1 : Fin (3 : ℕ))))) → (TileCentroid + (SubtileOccurrenceInterpretation layout.P layout.u layout.v exteriorIndex) - + TileCentroid T₀bar = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ + sbar.val * (incoming ibar + outgoing ibar))) ) := by + classical + intro q i T₀ r g qrot irot qbar hqbar cfg sbar reverse ibar T₀bar hqbar₀Pos C₀bar layout + incoming outgoing exteriorIndex hrows + simpa [exteriorIndex] using hrows.1 + +private theorem hexteriorBand : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T₀ : ProtoTile), ∀ (r : Fin (3 : + ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i - r + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (hqbar : ProperBandQuadruple qbar), ∀ (cfg : BandOrderedGeneralConfiguration qbar), ∀ + (sbar : Fin (4 : ℕ)), + let reverse := BandPackingSymmetryReversesOrientation g + let ibar : Fin 3 := if reverse then -irot else irot + let T₀bar := BandPackingSymmetryTileAction g T₀ + ∀ (hqbar₀Pos : 0 < (qbar 0).1), + let C₀bar : BandCircle := + ⟨⟨qbar 0, ⟨Or.inl hqbar₀Pos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbar₀Pos⟩ + ∀ (layout : BandOrderedGeneralLayoutCertificate qbar cfg C₀bar T₀bar), + let exteriorIndex : PeriodicSubtileIndex := + if ibar = 0 then + if sbar = 0 then ⟨.A, 0, -1⟩ + else if sbar = 1 then ⟨.B, 1, 1⟩ + else if sbar = 2 then ⟨.B, 0, 1⟩ + else ⟨.A, -1, -1⟩ + else if ibar = 1 then + if sbar = 0 then ⟨.C, 1, 1⟩ + else if sbar = 1 then ⟨.D, -1, 0⟩ + else if sbar = 2 then ⟨.D, -1, -1⟩ + else ⟨.C, 1, 0⟩ + else + if sbar = 0 then ⟨.E, -1, 0⟩ + else if sbar = 1 then ⟨.F, 0, -1⟩ + else if sbar = 2 then ⟨.F, 1, 0⟩ + else ⟨.E, 0, 1⟩ + BandPrototile (qbar ibar.succ) (SubtileOccurrenceInterpretation layout.P layout.u + layout.v exteriorIndex) ) := by + classical + intro q i T₀ r g qrot irot qbar hqbar cfg sbar reverse ibar T₀bar hqbar₀Pos C₀bar layout + exteriorIndex + generalize hi : ibar = j at ⊢ + generalize hs : sbar = t at ⊢ + fin_cases j <;> fin_cases t <;> + simp? [exteriorIndex, hi, hs, SubtileOccurrenceInterpretation] + all_goals first + | exact BandPrototileTranslation _ _ _ (layout.outer_occurrence 0 false).1 + | exact BandPrototileTranslation _ _ _ (layout.outer_occurrence 0 true).1 + | exact BandPrototileTranslation _ _ _ (layout.outer_occurrence 1 false).1 + | exact BandPrototileTranslation _ _ _ (layout.outer_occurrence 1 true).1 + | exact BandPrototileTranslation _ _ _ (layout.outer_occurrence 2 false).1 + | exact BandPrototileTranslation _ _ _ (layout.outer_occurrence 2 true).1 + +private theorem hfixedCentroid : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), + ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i - r + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (hqbar : ProperBandQuadruple qbar), ∀ (cfg : BandOrderedGeneralConfiguration qbar), ∀ + (sbar : Fin (4 : ℕ)), (TileCentroid (BandPackingSymmetryTileAction g Tᵢ) - + TileCentroid (BandPackingSymmetryTileAction g T₀) = (1 / 2 : ℝ) • GaussianRealPoint + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑sbar : ℕ) * (BandVectors.1 + (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ) + (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + BandVectors.1 + (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ)))) → ( + let reverse := BandPackingSymmetryReversesOrientation g + let ibar : Fin 3 := if reverse then -irot else irot + let T₀bar := BandPackingSymmetryTileAction g T₀ + let Tᵢbar := BandPackingSymmetryTileAction g Tᵢ + ∀ (hqbar₀Pos : 0 < (qbar 0).1), + let C₀bar : BandCircle := + ⟨⟨qbar 0, ⟨Or.inl hqbar₀Pos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbar₀Pos⟩ + ∀ (layout : BandOrderedGeneralLayoutCertificate qbar cfg C₀bar T₀bar), + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (qbar j.succ) (qbar 0) + let outgoing : Fin 3 → GaussianInt := fun j => + BandVectors.1 (qbar 0) (qbar j.succ) + let exteriorIndex : PeriodicSubtileIndex := + if ibar = 0 then + if sbar = 0 then ⟨.A, 0, -1⟩ + else if sbar = 1 then ⟨.B, 1, 1⟩ + else if sbar = 2 then ⟨.B, 0, 1⟩ + else ⟨.A, -1, -1⟩ + else if ibar = 1 then + if sbar = 0 then ⟨.C, 1, 1⟩ + else if sbar = 1 then ⟨.D, -1, 0⟩ + else if sbar = 2 then ⟨.D, -1, -1⟩ + else ⟨.C, 1, 0⟩ + else + if sbar = 0 then ⟨.E, -1, 0⟩ + else if sbar = 1 then ⟨.F, 0, -1⟩ + else if sbar = 2 then ⟨.F, 1, 0⟩ + else ⟨.E, 0, 1⟩ + (TileCentroid (SubtileOccurrenceInterpretation layout.P layout.u layout.v exteriorIndex) + - TileCentroid T₀bar = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ + sbar.val * (incoming ibar + outgoing ibar))) → (TileCentroid + (SubtileOccurrenceInterpretation layout.P layout.u layout.v exteriorIndex) = + TileCentroid Tᵢbar)) ) := by + classical + intro q i T₀ Tᵢ r g qrot irot qbar hqbar cfg sbar hcentroidBar reverse ibar T₀bar Tᵢbar + hqbar₀Pos C₀bar layout incoming outgoing exteriorIndex hexteriorCentroid + have hd : TileCentroid (SubtileOccurrenceInterpretation layout.P layout.u + layout.v exteriorIndex) - TileCentroid T₀bar = + TileCentroid Tᵢbar - TileCentroid T₀bar := by + calc + _ = (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ sbar.val * + (incoming ibar + outgoing ibar)) := hexteriorCentroid + _ = _ := by + simpa [qbar, reverse, ibar, incoming, outgoing] using + hcentroidBar.symm + apply Prod.ext + · have h := congrArg Prod.fst hd + simp only [Prod.fst_sub] at h + linarith + · have h := congrArg Prod.snd hd + simp only [Prod.snd_sub] at h + linarith + +end SubtileNormalizationGeometry + +namespace SubtileNormalizationConclusion + +private theorem subtileNormalizationCertificate : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : + PartialOdometer), ∀ (x : GaussianInt), (ProperBandQuadruple q) → ((q (0 : Fin (4 : + ℕ)) = C₀.1.1) → ((q i.succ = Cᵢ.1.1) → (∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let irot : Fin 3 := i - r + let qbar := BandPackingSymmetryQuadrupleAction g qrot + ∀ (hqbar : ProperBandQuadruple qbar), ∀ (cfg : BandOrderedGeneralConfiguration qbar), ∀ + (p₀bar : ℝ × ℝ), ∀ (pᵢbar : ℝ × ℝ), ∀ (sbar : Fin (4 : ℕ)), (TileOdometer + (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryTileAction g T₀) (BandPackingSymmetryPartialOdometerAction g h₀)) + → ((TileOdometer (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) + => if BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ) + (BandPackingSymmetryTileAction g Tᵢ) (BandPackingSymmetryPartialOdometerAction g hᵢ)) + → ((PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h₀) = some + p₀bar) → ((PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g hᵢ) = + some pᵢbar) → ((TileCentroid (BandPackingSymmetryTileAction g Tᵢ) - TileCentroid + (BandPackingSymmetryTileAction g T₀) = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ^ (↑sbar : ℕ) * (BandVectors.1 + (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ) + (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + BandVectors.1 + (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ)))) → + ((pᵢbar.1 - p₀bar.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑sbar : ℕ) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction g + qrot ((fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true + then -j else j) irot).succ) (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : + ℕ))) + BandVectors.2 (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ)))).1) → + ((pᵢbar.2 - p₀bar.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑sbar : ℕ) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction g + qrot ((fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true + then -j else j) irot).succ) (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : + ℕ))) + BandVectors.2 (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ)))).2) → ( + let reverse := BandPackingSymmetryReversesOrientation g + let ibar : Fin 3 := if reverse then -irot else irot + let T₀bar := BandPackingSymmetryTileAction g T₀ + let Tᵢbar := BandPackingSymmetryTileAction g Tᵢ + let h₀bar := BandPackingSymmetryPartialOdometerAction g h₀ + let hᵢbar := BandPackingSymmetryPartialOdometerAction g hᵢ + let xbar := BandPackingSymmetryVectorAction g x + (qbar ibar.succ = BandPackingSymmetryCircleAction g Cᵢ.1.1) → (∀ (hqbar₀Pos : 0 < (qbar + 0).1), ∀ (hqbarᵢPos : 0 < (qbar ibar.succ).1), + let C₀bar : BandCircle := + ⟨⟨qbar 0, ⟨Or.inl hqbar₀Pos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbar₀Pos⟩ + let Cᵢbar : BandCircle := + ⟨⟨qbar ibar.succ, + ⟨Or.inl hqbarᵢPos, ⟨qbar, hqbar.1, ⟨ibar.succ, rfl⟩⟩⟩⟩, + hqbarᵢPos⟩ + (xbar ∈ h₀bar.domain) → ((xbar ∈ hᵢbar.domain) → ((SubtileLatticeAdjacent C₀bar Cᵢbar + T₀bar Tᵢbar h₀bar hᵢbar) → ((BandPrototile (qbar ibar.succ) Tᵢbar) → (∀ (layout : + BandOrderedGeneralLayoutCertificate qbar cfg C₀bar T₀bar), ∀ (pieces : Fin (3 : ℕ) → + Bool → ProtoTile), ∀ (functions : Fin (3 : ℕ) → Bool → PartialOdometer), + (BandPrototile (qbar (0 : Fin (4 : ℕ))) T₀bar) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + TileOdometer (qbar i.succ) (pieces i s) (functions i s)) → ((∀ (x : LatticeCell), x ∈ + T₀bar.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (pieces i s).cells) → ((∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), FootprintVertices (pieces i s) ⊆ FootprintVertices T₀bar) → + ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (pieces i s) - TileCentroid T₀bar = + (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (qbar (i + (2 : Fin (3 : ℕ))).succ) (qbar (i + (1 : Fin (3 : + ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (qbar (i + (2 : Fin (3 : ℕ))).succ) + (qbar (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (qbar (i + + (2 : Fin (3 : ℕ))).succ) (qbar (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((∀ (x : + GaussianInt), x ∈ h₀bar.domain ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (functions i + s).domain) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (functions i s).domain, + h₀bar.value x = (functions i s).value x) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j + : Fin (3 : ℕ)), ∀ (t : Bool), OdometerCompatibility (functions i s) (functions j t)) + → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (qbar i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ × ℝ) (p_i + : ℝ × ℝ), PartialOdometerSlope h₀bar = some p ∧ PartialOdometerSlope (functions i s) + = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (qbar (i + (2 : Fin (3 : ℕ))).succ) (qbar (i + (1 : Fin (3 : + ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (qbar (i + (2 : Fin (3 : ℕ))).succ) (qbar (i + + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = true then (1 : ℝ) else (-1 + : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (qbar (i + (2 : Fin (3 : ℕ))).succ) (qbar (i + + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (qbar (i + (2 : Fin (3 : + ℕ))).succ) (qbar (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((∀ y, y = xbar ∨ y = + xbar + 1 ∨ y = xbar - 1 ∨ y = xbar + ⟨0, 1⟩ ∨ y = xbar - ⟨0, 1⟩ → y ∈ + FootprintVertices T₀bar ∨ y ∈ FootprintVertices Tᵢbar) → ( + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun j e => + match j, e with + | 0, true => .A | 0, false => .B + | 1, true => .C | 1, false => .D + | 2, true => .E | 2, false => .F + let pieceIndex : Fin 3 → Bool → PeriodicSubtileIndex := fun j e => + ⟨labelOf j e, 0, 0⟩ + (∀ (j : Fin 3), ∀ (e : Bool), pieceIndex j e = ⟨.A, 0, 0⟩ ∨ pieceIndex j e = ⟨.B, 0, 0⟩ ∨ + pieceIndex j e = ⟨.C, 0, 0⟩ ∨ pieceIndex j e = ⟨.D, 0, 0⟩ ∨ pieceIndex j e = ⟨.E, 0, + 0⟩ ∨ pieceIndex j e = ⟨.F, 0, 0⟩) → ((∀ (j : Fin 3), ∀ (e : Bool), (pieces j e).cells + = (SubtileOccurrenceInterpretation layout.P layout.u layout.v (pieceIndex j e)).cells + ∧ ((pieces j e).cells = ∅ → (pieces j e).anchor = (SubtileOccurrenceInterpretation + layout.P layout.u layout.v (pieceIndex j e)).anchor) ∧ FootprintVertices (pieces j e) + = FootprintVertices (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e)) ∧ ((functions j e).domain : Set GaussianInt) = FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u layout.v (pieceIndex j e))) → + ((QuarterTurnSymmetric T₀bar) → (Nonempty + (BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ + x))))))))))))))))))))))))))))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x hq hq₀ hqᵢ r g qrot irot qbar hqbar cfg p₀bar pᵢbar sbar hO₀bar + hOᵢbar hp₀bar hpᵢbar hcentroidBar hslopexBar hslopeyBar reverse ibar T₀bar Tᵢbar h₀bar + hᵢbar xbar hqbarᵢ hqbar₀Pos hqbarᵢPos C₀bar Cᵢbar hx₀bar hxᵢbar hadjbar hTᵢbarBand layout + pieces functions hrootBand hpieceOdometer hpieceCells hpieceFootprint hpieceCentroid + hfunctionDomains hfunctionRestriction hfunctionCompatibility hpieceSlope hstarFootprint + labelOf pieceIndex hpieceIndexCentral centralData hrootSym + let edge : Fin 3 → GaussianInt := fun j => + BandVectors.1 (qbar ((j + 2).succ)) (qbar ((j + 1).succ)) + let incoming : Fin 3 → GaussianInt := fun j => + BandVectors.1 (qbar j.succ) (qbar 0) + let outgoing : Fin 3 → GaussianInt := fun j => + BandVectors.1 (qbar 0) (qbar j.succ) + obtain ⟨hsuper, _, hin0, _, hflip⟩ := VectorRecursionLaws qbar hqbar.1 + have hflips := hflip hqbar + let R : Fin 4 → CircleCoordinates := ![qbar 0, qbar 2, qbar 3, qbar 1] + have hR : SemiProperQuadruple R := by + simpa [R] using SemiProperQuadruple.rotate hqbar.1 + let S : Fin 4 → CircleCoordinates := ![R 0, R 2, R 3, R 1] + have hS : SemiProperQuadruple S := by + simpa [S] using SemiProperQuadruple.rotate hR + have hin1 : incoming 1 = + edge 2 - (⟨0, 1⟩ : GaussianInt) * edge 0 := SubtileNormalizationGeometry.hin1 q r g hR + have hin2 : incoming 2 = + edge 0 - (⟨0, 1⟩ : GaussianInt) * edge 1 := SubtileNormalizationGeometry.hin2 q r g hS + let exteriorIndex : PeriodicSubtileIndex := + if ibar = 0 then + if sbar = 0 then ⟨.A, 0, -1⟩ + else if sbar = 1 then ⟨.B, 1, 1⟩ + else if sbar = 2 then ⟨.B, 0, 1⟩ + else ⟨.A, -1, -1⟩ + else if ibar = 1 then + if sbar = 0 then ⟨.C, 1, 1⟩ + else if sbar = 1 then ⟨.D, -1, 0⟩ + else if sbar = 2 then ⟨.D, -1, -1⟩ + else ⟨.C, 1, 0⟩ + else + if sbar = 0 then ⟨.E, -1, 0⟩ + else if sbar = 1 then ⟨.F, 0, -1⟩ + else if sbar = 2 then ⟨.F, 1, 0⟩ + else ⟨.E, 0, 1⟩ + have hexteriorIndex : + exteriorIndex = ⟨.A, -1, -1⟩ ∨ exteriorIndex = ⟨.A, 0, -1⟩ ∨ + exteriorIndex = ⟨.C, 1, 0⟩ ∨ exteriorIndex = ⟨.C, 1, 1⟩ ∨ + exteriorIndex = ⟨.E, 0, 1⟩ ∨ exteriorIndex = ⟨.E, -1, 0⟩ ∨ + exteriorIndex = ⟨.B, 1, 1⟩ ∨ exteriorIndex = ⟨.B, 0, 1⟩ ∨ + exteriorIndex = ⟨.D, -1, 0⟩ ∨ exteriorIndex = ⟨.D, -1, -1⟩ ∨ + exteriorIndex = ⟨.F, 0, -1⟩ ∨ exteriorIndex = ⟨.F, 1, 0⟩ := + SubtileNormalizationGeometry.hexteriorIndex i r g sbar + have hrows := BandOrderedGeneralSubtileCanonicalRows + layout.P T₀bar layout.u layout.v ibar sbar edge incoming outgoing + (by simpa [edge] using hsuper) + (by simpa [incoming, edge] using hin0) + hin1 hin2 + (by + intro j + simpa [incoming, outgoing] using (hflips j).1) + (by simpa [outgoing, qbar] using layout.period_u) + (by simpa [outgoing, qbar] using layout.period_v) + (by + intro j e + simpa [edge] using (layout.outer_occurrence j e).2.2) + have hexteriorCentroid : + TileCentroid (SubtileOccurrenceInterpretation layout.P layout.u + layout.v exteriorIndex) - TileCentroid T₀bar = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ sbar.val * + (incoming ibar + outgoing ibar)) := SubtileNormalizationGeometry.hexteriorCentroid q + i T₀ r g hqbar cfg sbar hqbar₀Pos layout hrows + have hexteriorBand : BandPrototile (qbar ibar.succ) + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + exteriorIndex) := SubtileNormalizationGeometry.hexteriorBand q i T₀ r g hqbar cfg sbar + hqbar₀Pos layout + have hfixedCentroid : + TileCentroid (SubtileOccurrenceInterpretation layout.P layout.u + layout.v exteriorIndex) = TileCentroid Tᵢbar := + SubtileNormalizationGeometry.hfixedCentroid q i T₀ Tᵢ r g hqbar cfg sbar hcentroidBar + hqbar₀Pos layout hexteriorCentroid + have hfixedUnique := BandPrototileCentroidUnique (qbar ibar.succ) + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + exteriorIndex) Tᵢbar hexteriorBand hTᵢbarBand hfixedCentroid + refine ⟨{ + presentation_proper := hq + presentation_child := hq₀ + presentation_parent := hqᵢ + parentRotation := r + symmetry := g + rotatedPresentation := qrot + rotated_presentation_eq := rfl + normalizedPresentation := qbar + normalized_presentation_eq := rfl + configuration := cfg + normalizedCircle := C₀bar + normalized_circle_eq := rfl + normalizedFixedCircle := Cᵢbar + normalized_fixed_circle_eq := hqbarᵢ + normalizedRoot := T₀bar + normalizedFixed := Tᵢbar + normalizedRootFunction := h₀bar + normalizedFixedFunction := hᵢbar + normalizedPoint := xbar + normalized_root_eq := rfl + normalized_fixed_eq := rfl + normalized_root_function_eq := rfl + normalized_fixed_function_eq := rfl + normalized_point_eq := rfl + normalized_point_root_domain := hx₀bar + normalized_point_fixed_domain := hxᵢbar + normalized_root_odometer := hO₀bar + normalized_fixed_odometer := hOᵢbar + normalizedRootSlope := p₀bar + normalizedFixedSlope := pᵢbar + normalized_root_slope := hp₀bar + normalized_fixed_slope := hpᵢbar + normalizedParentSlot := ibar + normalizedQuarterTurn := sbar + normalized_parent_coordinate := rfl + normalized_adjacency_centroid := by + simpa [qbar, reverse, ibar] using hcentroidBar + normalized_adjacency_slope_real := by + simpa [qbar, reverse, ibar] using hslopexBar + normalized_adjacency_slope_imag := by + simpa [qbar, reverse, ibar] using hslopeyBar + pieces := pieces + functions := functions + root_band := hrootBand + piece_odometer := hpieceOdometer + piece_cell_cover := hpieceCells + piece_footprint := hpieceFootprint + piece_centroid := hpieceCentroid + function_domain_cover := hfunctionDomains + function_restriction := hfunctionRestriction + function_compatibility := hfunctionCompatibility + piece_slope := hpieceSlope + adjacency := hadjbar + root_quarter_turn := hrootSym + layout := layout + pieceIndex := pieceIndex + piece_index_central := hpieceIndexCentral + piece_layout_cells := fun j e => (centralData j e).1 + piece_layout_empty_anchor := fun j e => (centralData j e).2.1 + piece_layout_footprint := fun j e => (centralData j e).2.2.1 + piece_layout_domain := fun j e => (centralData j e).2.2.2 + exteriorIndex := exteriorIndex + exterior_index := hexteriorIndex + fixed_exterior_cells := hfixedUnique.1 + fixed_exterior_empty_anchor := hfixedUnique.2 + normalized_star := hstarFootprint }⟩ + +end SubtileNormalizationConclusion + +theorem BandOrderedGeneralSubtileNormalizationCertificateExists + (C₀ Cᵢ : BandCircle) (q : Fin 4 → CircleCoordinates) + (i : Fin 3) (s : Fin 4) (T₀ Tᵢ : ProtoTile) + (h₀ hᵢ : PartialOdometer) (x : GaussianInt) (p₀ pᵢ : ℝ × ℝ) + (horbit : + ¬ ((∃ (g : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = C₀.1.1) ∨ + (∃ (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K 0) = C₀.1.1))) + (hq : ProperBandQuadruple q) (hq₀ : q 0 = C₀.1.1) + (hqᵢ : q i.succ = Cᵢ.1.1) + (hslope₀ : PartialOdometerSlope h₀ = some p₀) + (hslopeᵢ : PartialOdometerSlope hᵢ = some pᵢ) + (hcentroid : TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ)))) + (hslopex : pᵢ.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).1) + (hslopey : pᵢ.2 - p₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).2) + (hadj : SubtileLatticeAdjacent C₀ Cᵢ T₀ Tᵢ h₀ hᵢ) + (hx₀ : x ∈ h₀.domain) (hxᵢ : x ∈ hᵢ.domain) + (hstar : ∀ y, + y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h₀.domain ∨ y ∈ hᵢ.domain) : + Nonempty (BandOrderedGeneralSubtileNormalizationCertificate + C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x) := by +-- BODY + classical + rcases hadj with + ⟨hO₀, hOᵢ, p₀', pᵢ', hp₀', hpᵢ', q', i', s', hq', hq₀', hqᵢ', + hcentroid', hslopex', hslopey'⟩ + have hparentPos : 0 < Cᵢ.1.1.1 := by + exact Cᵢ.2 + obtain ⟨r, g, hregime⟩ := BandRegimeClassification q hq + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + have hqrotSemi : SemiProperQuadruple qrot := SubtileNormalizationGeometry.hqrotSemi q hq q' r g + hregime + have hqrot : ProperBandQuadruple qrot := SubtileNormalizationGeometry.hqrot q hq q' r g hregime + hqrotSemi + let irot : Fin 3 := i - r + have hrotParent : qrot irot.succ = q i.succ := by + fin_cases r <;> fin_cases i <;> simp [qrot, irot] + have hqrot₀ : qrot 0 = C₀.1.1 := by simpa [qrot] using hq₀ + let qbar := BandPackingSymmetryQuadrupleAction g qrot + have hqbar : ProperBandQuadruple qbar := + BandPackingSymmetryProperCovariance g qrot hqrot + have hqbar₀ : qbar 0 = BandPackingSymmetryCircleAction g C₀.1.1 := by + simp [qbar, qrot, BandPackingSymmetryQuadrupleAction, hq₀] + have hgeneral : Nonempty (BandOrderedGeneralConfiguration qbar) := + SubtileNormalizationGeometry.hgeneral C₀ q horbit hq₀ q' r g hregime + obtain ⟨cfg⟩ := hgeneral + have hO₀rot : TileOdometer (qrot 0) T₀ h₀ := SubtileNormalizationGeometry.hO₀rot C₀ q T₀ h₀ hO₀ + r hqrot₀ + have hOᵢrot : TileOdometer (qrot irot.succ) Tᵢ hᵢ := SubtileNormalizationGeometry.hOᵢrot Cᵢ q i + Tᵢ hᵢ hqᵢ hOᵢ r hrotParent + have hcentroidRot : TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (qrot irot.succ) (qrot 0) + + BandVectors.1 (qrot 0) (qrot irot.succ))) := SubtileNormalizationGeometry.hcentroidRot + q i s T₀ Tᵢ hcentroid r hrotParent + have hslopexRot : pᵢ.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (qrot irot.succ) (qrot 0) + + BandVectors.2 (qrot 0) (qrot irot.succ)))).1 := SubtileNormalizationGeometry.hslopexRot + q i s p₀ pᵢ hslopex r hrotParent + have hslopeyRot : pᵢ.2 - p₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (qrot irot.succ) (qrot 0) + + BandVectors.2 (qrot 0) (qrot irot.succ)))).2 := SubtileNormalizationGeometry.hslopeyRot + q i s p₀ pᵢ hslopey r hrotParent + obtain ⟨negative, p₀bar, pᵢbar, sbar, hphase, hsbar, + hO₀bar, hOᵢbar, hp₀bar, hpᵢbar, hcentroidBar, + hslopexBar, hslopeyBar, hcompatBar⟩ := + SubtileLatticeAdjacentPackingSymmetryTransport g qrot hqrot irot s + (by simpa [hrotParent, hqᵢ] using hparentPos) + T₀ Tᵢ h₀ hᵢ p₀ pᵢ hO₀rot hOᵢrot hslope₀ hslopeᵢ + hcentroidRot hslopexRot hslopeyRot + let reverse := BandPackingSymmetryReversesOrientation g + let ibar : Fin 3 := if reverse then -irot else irot + let T₀bar := BandPackingSymmetryTileAction g T₀ + let Tᵢbar := BandPackingSymmetryTileAction g Tᵢ + let h₀bar := BandPackingSymmetryPartialOdometerAction g h₀ + let hᵢbar := BandPackingSymmetryPartialOdometerAction g hᵢ + let xbar := BandPackingSymmetryVectorAction g x + have hqbarᵢ : qbar ibar.succ = + BandPackingSymmetryCircleAction g Cᵢ.1.1 := SubtileNormalizationGeometry.hqbarᵢ Cᵢ q i hqᵢ + r g hrotParent + have hqbar₀Pos : 0 < (qbar 0).1 := + (ProperBandCurvatureStructure qbar hqbar).1 + have hqbarᵢPos : 0 < (qbar ibar.succ).1 := SubtileNormalizationGeometry.hqbarᵢPos Cᵢ q i s r g + hqbar cfg negative sbar + let C₀bar : BandCircle := + ⟨⟨qbar 0, ⟨Or.inl hqbar₀Pos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbar₀Pos⟩ + let Cᵢbar : BandCircle := + ⟨⟨qbar ibar.succ, + ⟨Or.inl hqbarᵢPos, ⟨qbar, hqbar.1, ⟨ibar.succ, rfl⟩⟩⟩⟩, + hqbarᵢPos⟩ + have hx₀bar : xbar ∈ h₀bar.domain := SubtileNormalizationGeometry.hx₀bar h₀ hᵢ x hx₀ g + have hxᵢbar : xbar ∈ hᵢbar.domain := SubtileNormalizationGeometry.hxᵢbar h₀ hᵢ x hxᵢ g + have hadjbar : SubtileLatticeAdjacent C₀bar Cᵢbar + T₀bar Tᵢbar h₀bar hᵢbar := SubtileNormalizationGeometry.hadjbar q i T₀ Tᵢ h₀ hᵢ r g hqbar + p₀bar pᵢbar sbar hO₀bar hOᵢbar hp₀bar hpᵢbar hcentroidBar hslopexBar hslopeyBar + hqbar₀Pos hqbarᵢPos + have hT₀barBand : BandPrototile (qbar 0) T₀bar := + TileOdometerBandPrototile _ _ _ hO₀bar + have hTᵢbarBand : BandPrototile (qbar ibar.succ) Tᵢbar := + TileOdometerBandPrototile _ _ _ hOᵢbar + have hT₀ind := BandTileSimultaneousInduction qbar hqbar T₀bar hT₀barBand + have hsmallT1 : ∀ (q' : Fin 4 → CircleCoordinates) (T' : ProtoTile) + (S' : Fin 3 → Bool → ProtoTile), ProperBandQuadruple q' → + BandPrototile (q' 0) T' → + (∀ i s, BandSubtileOccurrence q' T' i s (S' i s)) → + (∀ z, z ∈ T'.cells ↔ ∃ i s, z ∈ (S' i s).cells) → + Int.toNat (q' 0).1 < Int.toNat (qbar 0).1 → + LatticeTile T' ∧ TileArea T' = Int.toNat (q' 0).1 ∧ + ∀ i s, LatticeTile (TileCellComplement T' (S' i s)) ∧ + TileTouching (TileCellComplement T' (S' i s)) (S' i s) := + SubtileNormalizationGeometry.hsmallT1 q r g + have hsmallT2 : ∀ (D : CircleCoordinates) (U : ProtoTile), + BandPrototile D U → Int.toNat D.1 < Int.toNat (qbar 0).1 → + QuarterTurnSymmetric U := SubtileNormalizationGeometry.hsmallT2 q r g + have hsmallT4 : ∀ (q' : Fin 4 → CircleCoordinates) + (T' U : ProtoTile), ProperBandQuadruple q' → + BandPrototile (q' 0) T' → + Int.toNat (q' 0).1 < Int.toNat (qbar 0).1 → 1 < (q' 0).1 → + ∀ i : Fin 3, BandPrototile (q' i.succ) U → + TileCentroid U - TileCentroid T' = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q' i.succ) (q' 0)) + + GaussianRealPoint (BandVectors.1 (q' 0) (q' i.succ))) → + TouchingTriple T' + (TileTranslation T' (BandVectors.1 (q' i.succ) (q' 0))) U := + SubtileNormalizationGeometry.hsmallT4 q r g + have hsmallT5 : ∀ (q' : Fin 4 → CircleCoordinates) + (T' U V : ProtoTile), ProperBandQuadruple q' → + BandPrototile (q' 0) T' → + Int.toNat (q' 0).1 < Int.toNat (qbar 0).1 → + ∀ i : Fin 3, BandPrototile (q' i.succ) U → + BandPrototile (q' ((i + 1).succ)) V → + TileCentroid U - TileCentroid T' = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q' i.succ) (q' 0)) + + GaussianRealPoint (BandVectors.1 (q' 0) (q' i.succ))) → + TileCentroid V - TileCentroid T' = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q' ((i + 1).succ)) (q' 0)) - + GaussianRealPoint (BandVectors.1 (q' 0) (q' ((i + 1).succ)))) → + TouchingTriple T' U V := SubtileNormalizationGeometry.hsmallT5 q r g + obtain ⟨layout⟩ := BandOrderedGeneralLayout qbar cfg C₀bar + rfl T₀bar hT₀barBand hsmallT1 hsmallT2 hsmallT4 hsmallT5 + obtain ⟨pieces, functions, hrootBand, hpieceOdometer, hpieceCells, + hpieceFootprint, hpieceCentroid, hfunctionDomains, + hfunctionRestriction, hfunctionCompatibility, hpieceSlope⟩ := + TileOdometerReindexedDecomposition qbar hqbar T₀bar h₀bar + (by linarith [cfg.childLarge]) hO₀bar + have hstarBarDomain : ∀ y, + y = xbar ∨ y = xbar + 1 ∨ y = xbar - 1 ∨ + y = xbar + ⟨0, 1⟩ ∨ y = xbar - ⟨0, 1⟩ → + y ∈ h₀bar.domain ∨ y ∈ hᵢbar.domain := + P5658T1FivePointDomainCoverSymmetryCovariance g h₀ hᵢ x hstar + have hstarFootprint : ∀ y, + y = xbar ∨ y = xbar + 1 ∨ y = xbar - 1 ∨ + y = xbar + ⟨0, 1⟩ ∨ y = xbar - ⟨0, 1⟩ → + y ∈ FootprintVertices T₀bar ∨ + y ∈ FootprintVertices Tᵢbar := SubtileNormalizationGeometry.hstarFootprint q i T₀ Tᵢ h₀ + hᵢ x r g hO₀bar hOᵢbar hqbar₀Pos hqbarᵢPos hstarBarDomain + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun j e => + match j, e with + | 0, true => .A | 0, false => .B + | 1, true => .C | 1, false => .D + | 2, true => .E | 2, false => .F + let pieceIndex : Fin 3 → Bool → PeriodicSubtileIndex := fun j e => + ⟨labelOf j e, 0, 0⟩ + have hpieceIndexCentral (j : Fin 3) (e : Bool) : + pieceIndex j e = ⟨.A, 0, 0⟩ ∨ pieceIndex j e = ⟨.B, 0, 0⟩ ∨ + pieceIndex j e = ⟨.C, 0, 0⟩ ∨ pieceIndex j e = ⟨.D, 0, 0⟩ ∨ + pieceIndex j e = ⟨.E, 0, 0⟩ ∨ pieceIndex j e = ⟨.F, 0, 0⟩ := + SubtileNormalizationGeometry.hpieceIndexCentral j e + have translation_zero (U : ProtoTile) : TileTranslation U 0 = U := + SubtileNormalizationGeometry.translation_zero U + have centralOccurrence (j : Fin 3) (e : Bool) : + SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e) = layout.P j e := SubtileNormalizationGeometry.centralOccurrence q T₀ r + g hqbar cfg hqbar₀Pos layout translation_zero j e + have centralData (j : Fin 3) (e : Bool) : + (pieces j e).cells = + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e)).cells ∧ + ((pieces j e).cells = ∅ → + (pieces j e).anchor = + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e)).anchor) ∧ + FootprintVertices (pieces j e) = FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e)) ∧ + ((functions j e).domain : Set GaussianInt) = FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e)) := SubtileNormalizationGeometry.centralData Cᵢ q i s T₀ r g hqbar + cfg negative sbar hqbar₀Pos layout pieces functions hpieceOdometer hpieceCentroid + centralOccurrence j e + have hrootSym : QuarterTurnSymmetric T₀bar := hT₀ind.2.2.2.1 + have subtileNormalizationCertificate : + Nonempty (BandOrderedGeneralSubtileNormalizationCertificate + C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x) := SubtileNormalizationConclusion.subtileNormalizationCertificate + C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x hq hq₀ hqᵢ r g hqbar cfg p₀bar pᵢbar sbar hO₀bar hOᵢbar hp₀bar + hpᵢbar hcentroidBar hslopexBar hslopeyBar hqbarᵢ hqbar₀Pos hqbarᵢPos hx₀bar hxᵢbar + hadjbar hTᵢbarBand layout pieces functions hrootBand hpieceOdometer hpieceCells + hpieceFootprint hpieceCentroid hfunctionDomains hfunctionRestriction + hfunctionCompatibility hpieceSlope hstarFootprint hpieceIndexCentral centralData hrootSym + exact subtileNormalizationCertificate + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizedBundleExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizedBundleExists.lean new file mode 100644 index 0000000000..4132c71e4c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizedBundleExists.lean @@ -0,0 +1,178 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileInterfaceCertificateExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileNormalizationCertificateExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileRoutingCertificateExists + +-- [TABLET NODE: BandOrderedGeneralSubtileNormalizedBundleExists] + +/-! +# BandOrderedGeneralSubtileNormalizedBundleExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralSubtileNormalizedBundleExists + (C₀ Cᵢ : BandCircle) (q : Fin 4 → CircleCoordinates) + (i : Fin 3) (s : Fin 4) (T₀ Tᵢ : ProtoTile) + (h₀ hᵢ : PartialOdometer) (x : GaussianInt) (p₀ pᵢ : ℝ × ℝ) + (horbit : + ¬ ((∃ (g : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = C₀.1.1) ∨ + (∃ (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K 0) = C₀.1.1))) + (hq : ProperBandQuadruple q) (hq₀ : q 0 = C₀.1.1) + (hqᵢ : q i.succ = Cᵢ.1.1) + (hslope₀ : PartialOdometerSlope h₀ = some p₀) + (hslopeᵢ : PartialOdometerSlope hᵢ = some pᵢ) + (hcentroid : TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ)))) + (hslopex : pᵢ.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).1) + (hslopey : pᵢ.2 - p₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).2) + (hadj : SubtileLatticeAdjacent C₀ Cᵢ T₀ Tᵢ h₀ hᵢ) + (hx₀ : x ∈ h₀.domain) (hxᵢ : x ∈ hᵢ.domain) + (hstar : ∀ y, + y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h₀.domain ∨ y ∈ hᵢ.domain) : + ∃ bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x, + ∃ placement : BandOrderedGeneralSubtilePlacement + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle + bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions + bundle.selectedSlot bundle.selectedSign bundle.routedDirection, + bundle.placement = Sum.inr placement := by +-- BODY + obtain ⟨normalization⟩ := + BandOrderedGeneralSubtileNormalizationCertificateExists + C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x p₀ pᵢ horbit hq hq₀ hqᵢ + hslope₀ hslopeᵢ hcentroid hslopex hslopey hadj hx₀ hxᵢ hstar + obtain ⟨interface⟩ := + BandOrderedGeneralSubtileInterfaceCertificateExists normalization + obtain ⟨routing⟩ := + BandOrderedGeneralSubtileRoutingCertificateExists interface + let placement : BandOrderedGeneralSubtilePlacement + normalization.normalizedPresentation normalization.configuration + normalization.normalizedCircle normalization.normalizedFixedCircle + normalization.normalizedRoot normalization.normalizedFixed + normalization.normalizedRootFunction normalization.normalizedFixedFunction + normalization.normalizedPoint normalization.pieces normalization.functions + routing.selectedSlot routing.selectedSign routing.routedDirection := + { adjacency := normalization.adjacency + layout := normalization.layout + pieceIndex := normalization.pieceIndex + piece_index_central := normalization.piece_index_central + piece_layout_cells := normalization.piece_layout_cells + piece_layout_empty_anchor := normalization.piece_layout_empty_anchor + piece_layout_footprint := normalization.piece_layout_footprint + piece_layout_domain := normalization.piece_layout_domain + exteriorIndex := normalization.exteriorIndex + centralIndex := routing.centralIndex + exterior_index := normalization.exterior_index + central_index := routing.central_index + selected_central_index := routing.selected_central_index + fixed_exterior_cells := normalization.fixed_exterior_cells + fixed_exterior_empty_anchor := normalization.fixed_exterior_empty_anchor + exterior_routed_cell := routing.exterior_routed_cell + central_routed_cell := routing.central_routed_cell + selected_star := routing.selected_star } + let bundle : BandOrderedGeneralNormalizedOccurrenceBundle + C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x := + { presentation := q + presentation_proper := normalization.presentation_proper + presentation_child := normalization.presentation_child + parentRotation := normalization.parentRotation + symmetry := normalization.symmetry + rotatedPresentation := normalization.rotatedPresentation + rotated_presentation_eq := normalization.rotated_presentation_eq + normalizedPresentation := normalization.normalizedPresentation + normalized_presentation_eq := normalization.normalized_presentation_eq + configuration := normalization.configuration + normalizedCircle := normalization.normalizedCircle + normalized_circle_eq := normalization.normalized_circle_eq + normalizedFixedCircle := normalization.normalizedFixedCircle + normalized_fixed_circle_eq := normalization.normalized_fixed_circle_eq + normalizedRoot := normalization.normalizedRoot + normalizedFixed := normalization.normalizedFixed + normalizedRootFunction := normalization.normalizedRootFunction + normalizedFixedFunction := normalization.normalizedFixedFunction + normalizedPoint := normalization.normalizedPoint + normalized_root_eq := normalization.normalized_root_eq + normalized_fixed_eq := normalization.normalized_fixed_eq + normalized_root_function_eq := normalization.normalized_root_function_eq + normalized_fixed_function_eq := normalization.normalized_fixed_function_eq + normalized_point_eq := normalization.normalized_point_eq + normalized_root_odometer := normalization.normalized_root_odometer + normalized_fixed_odometer := normalization.normalized_fixed_odometer + normalizedRootSlope := normalization.normalizedRootSlope + normalizedFixedSlope := normalization.normalizedFixedSlope + normalized_root_slope := normalization.normalized_root_slope + normalized_fixed_slope := normalization.normalized_fixed_slope + pieces := normalization.pieces + functions := normalization.functions + root_band := normalization.root_band + piece_odometer := normalization.piece_odometer + piece_cell_cover := normalization.piece_cell_cover + piece_footprint := normalization.piece_footprint + piece_centroid := normalization.piece_centroid + function_domain_cover := normalization.function_domain_cover + function_restriction := normalization.function_restriction + function_compatibility := normalization.function_compatibility + piece_slope := normalization.piece_slope + startCompanion := interface.startCompanion + endCompanion := interface.endCompanion + startData := interface.startData + endData := interface.endData + interface_endpoints := interface.interface_endpoints + root_lattice := interface.root_lattice + fixed_lattice := interface.fixed_lattice + start_lattice := interface.start_lattice + end_lattice := interface.end_lattice + root_fixed_disjoint := interface.root_fixed_disjoint + root_start_disjoint := interface.root_start_disjoint + fixed_start_disjoint := interface.fixed_start_disjoint + root_end_disjoint := interface.root_end_disjoint + fixed_end_disjoint := interface.fixed_end_disjoint + start_touching := interface.start_touching + end_touching := interface.end_touching + edgeAtPoint := routing.edgeAtPoint + root_induced := routing.root_induced + fixed_induced := routing.fixed_induced + normalized_star := normalization.normalized_star + routedDirection := routing.routedDirection + routed_root_cell := routing.routed_root_cell + routed_fixed_cell := routing.routed_fixed_cell + selectedSlot := routing.selectedSlot + selectedSign := routing.selectedSign + selected_piece_cell := routing.selected_piece_cell + placement := Sum.inr placement } + exact ⟨bundle, placement, rfl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtilePlacement.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtilePlacement.lean new file mode 100644 index 0000000000..c4d4f6f288 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtilePlacement.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation + +-- [TABLET NODE: BandOrderedGeneralSubtilePlacement] + +/-! +# BandOrderedGeneralSubtilePlacement + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Fix an ordered-general presentation $q$, its configuration, a normalized +subtile-adjacent pair $(\bar T,\bar h),(\bar N,\bar k)$, an externally +supplied family $(S_i^e,f_i^e)$ of six supports and partial odometers, a +selected slot, the normalized contact point, and its routed +incident-square direction. A *subtile-adjacent normalized placement* +consists of the following data. This record imposes only the +branch-specific adjacency, literal layout root, occurrence-index roles, +cells, empty-anchor, footprint, and domain alignments, routed memberships, +star cover, and fixed-to-exterior observable alignment listed below. The +tile-odometer facts, cell and domain covers, restriction values, +compatibility, centroid formulas, and slope alternatives for +$(S_i^e,f_i^e)$ are not fields of this record; they are supplied once by +the enclosing normalized routed occurrence bundle. + +It contains the transported directed subtile-lattice adjacency and one +`BandOrderedGeneralLayoutCertificate` whose root is literally the +decomposed full tile $\bar T$. Each of the six pieces $S_i^e$ is aligned, +in cells, empty-case anchor, footprint, and function domain, with a literal +occurrence in this layout, and every one of those six indices is one of the +six central indices. The selected piece index is the retained central +index $b$. A retained exterior index $a$ is one of the twelve exterior +indices; its occurrence has exactly the cells of the fixed tile $\bar N$ +and the same anchor when this cell set is empty. The occurrences at $a$ +and $b$ contain the two routed opposite squares and their footprints cover +the five axial vertices at the normalized contact point, as derived from +those squares. In particular, no decomposed piece is forced to play an +exterior role in this branch. +-/ +structure BandOrderedGeneralSubtilePlacement + (q : Fin 4 -> CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (C0 fixedCircle : BandCircle) + (root fixed : ProtoTile) (rootFunction fixedFunction : PartialOdometer) + (point : GaussianInt) (pieces : Fin 3 -> Bool -> ProtoTile) + (functions : Fin 3 -> Bool -> PartialOdometer) + (selectedSlot : Fin 3) (selectedSign : Bool) + (routedDirection : Fin 4) where +-- BODY + adjacency : SubtileLatticeAdjacent C0 fixedCircle root fixed + rootFunction fixedFunction + /-- The literal ordered-general layout rooted at the normalized decomposed root tile. -/ + layout : BandOrderedGeneralLayoutCertificate q cfg C0 root + /-- The central periodic occurrence index aligned with each signed decomposition piece. -/ + pieceIndex : Fin 3 -> Bool -> PeriodicSubtileIndex + piece_index_central : forall i s, + pieceIndex i s = ⟨.A, 0, 0⟩ ∨ pieceIndex i s = ⟨.B, 0, 0⟩ ∨ + pieceIndex i s = ⟨.C, 0, 0⟩ ∨ pieceIndex i s = ⟨.D, 0, 0⟩ ∨ + pieceIndex i s = ⟨.E, 0, 0⟩ ∨ pieceIndex i s = ⟨.F, 0, 0⟩ + piece_layout_cells : forall i s, (pieces i s).cells = + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex i s)).cells + piece_layout_empty_anchor : forall i s, (pieces i s).cells = ∅ -> + (pieces i s).anchor = + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex i s)).anchor + piece_layout_footprint : forall i s, + FootprintVertices (pieces i s) = FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex i s)) + piece_layout_domain : forall i s, + ((functions i s).domain : Set GaussianInt) = FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex i s)) + /-- The literal exterior occurrence selected by the routed contact. -/ + exteriorIndex : PeriodicSubtileIndex + /-- The literal central child occurrence selected by the opposite routed square. -/ + centralIndex : PeriodicSubtileIndex + exterior_index : + exteriorIndex = ⟨.A, -1, -1⟩ ∨ exteriorIndex = ⟨.A, 0, -1⟩ ∨ + exteriorIndex = ⟨.C, 1, 0⟩ ∨ exteriorIndex = ⟨.C, 1, 1⟩ ∨ + exteriorIndex = ⟨.E, 0, 1⟩ ∨ exteriorIndex = ⟨.E, -1, 0⟩ ∨ + exteriorIndex = ⟨.B, 1, 1⟩ ∨ exteriorIndex = ⟨.B, 0, 1⟩ ∨ + exteriorIndex = ⟨.D, -1, 0⟩ ∨ exteriorIndex = ⟨.D, -1, -1⟩ ∨ + exteriorIndex = ⟨.F, 0, -1⟩ ∨ exteriorIndex = ⟨.F, 1, 0⟩ + central_index : + centralIndex = ⟨.A, 0, 0⟩ ∨ centralIndex = ⟨.B, 0, 0⟩ ∨ + centralIndex = ⟨.C, 0, 0⟩ ∨ centralIndex = ⟨.D, 0, 0⟩ ∨ + centralIndex = ⟨.E, 0, 0⟩ ∨ centralIndex = ⟨.F, 0, 0⟩ + selected_central_index : centralIndex = pieceIndex selectedSlot selectedSign + fixed_exterior_cells : + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + exteriorIndex).cells = fixed.cells + fixed_exterior_empty_anchor : + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + exteriorIndex).cells = ∅ -> + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + exteriorIndex).anchor = fixed.anchor + exterior_routed_cell : LatticeVertexIncidentCell point + (routedDirection + 2) ∈ + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + exteriorIndex).cells + central_routed_cell : LatticeVertexIncidentCell point routedDirection ∈ + (SubtileOccurrenceInterpretation layout.P layout.u layout.v + centralIndex).cells + selected_star : forall y, + y = point ∨ y = point + 1 ∨ y = point - 1 ∨ + y = point + ⟨0, 1⟩ ∨ y = point - ⟨0, 1⟩ -> + y ∈ FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u layout.v exteriorIndex) ∨ + y ∈ FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u layout.v centralIndex) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificate.lean new file mode 100644 index 0000000000..4e8a242b3c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificate.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileInterfaceCertificate +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation + +-- [TABLET NODE: BandOrderedGeneralSubtileRoutingCertificate] + +/-! +# BandOrderedGeneralSubtileRoutingCertificate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Given a `BandOrderedGeneralSubtileInterfaceCertificate`, a subtile +routing certificate records an actual common footprint edge through the +normalized point, the induced-edge properties of both outer lattice tiles, +and a direction whose opposite incident cells lie in the normalized root and +fixed supports. It then chooses exactly one signed piece of the already +fixed decomposition containing the root-side incident cell. + +The certificate retains that same slot and sign by naming its central +periodic occurrence, recording equality with the normalization certificate's +central index for that piece, and transferring the routed root-side cell to +that occurrence. It transfers the opposite cell to the already fixed +exterior occurrence and records that these same two occurrences cover the +normalized point and its four axial neighbors. No second decomposition or +second piece selection is permitted by the data. +-/ +structure BandOrderedGeneralSubtileRoutingCertificate + {C₀ Cᵢ : BandCircle} {q : Fin 4 → CircleCoordinates} + {i : Fin 3} {T₀ Tᵢ : ProtoTile} + {h₀ hᵢ : PartialOdometer} {x : GaussianInt} + {normalization : BandOrderedGeneralSubtileNormalizationCertificate + C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x} + (interface : BandOrderedGeneralSubtileInterfaceCertificate normalization) where +-- BODY + edgeAtPoint : ∃ edge : Finset GaussianInt, + normalization.normalizedPoint ∈ edge ∧ + edge ∈ FootprintEdges normalization.normalizedRoot ∩ + FootprintEdges normalization.normalizedFixed + root_induced : ∀ y, + y ∈ FootprintVertices normalization.normalizedRoot → ∀ z, + z ∈ FootprintVertices normalization.normalizedRoot → + FourNeighborAdjacent y z → + ({y, z} : Finset GaussianInt) ∈ + FootprintEdges normalization.normalizedRoot + fixed_induced : ∀ y, + y ∈ FootprintVertices normalization.normalizedFixed → ∀ z, + z ∈ FootprintVertices normalization.normalizedFixed → + FourNeighborAdjacent y z → + ({y, z} : Finset GaussianInt) ∈ + FootprintEdges normalization.normalizedFixed + /-- The incident-square direction with root and fixed cells in opposite sectors. -/ + routedDirection : Fin 4 + routed_root_cell : LatticeVertexIncidentCell normalization.normalizedPoint + routedDirection ∈ normalization.normalizedRoot.cells + routed_fixed_cell : LatticeVertexIncidentCell normalization.normalizedPoint + (routedDirection + 2) ∈ normalization.normalizedFixed.cells + /-- The selected parent slot of the fixed six-piece decomposition. -/ + selectedSlot : Fin 3 + /-- The sign of that selected occurrence in the same decomposition family. -/ + selectedSign : Bool + selected_piece_cell : LatticeVertexIncidentCell normalization.normalizedPoint + routedDirection ∈ (normalization.pieces selectedSlot selectedSign).cells + /-- The central occurrence containing the selected root-side incident square. -/ + centralIndex : PeriodicSubtileIndex + central_index : + centralIndex = ⟨.A, 0, 0⟩ ∨ centralIndex = ⟨.B, 0, 0⟩ ∨ + centralIndex = ⟨.C, 0, 0⟩ ∨ centralIndex = ⟨.D, 0, 0⟩ ∨ + centralIndex = ⟨.E, 0, 0⟩ ∨ centralIndex = ⟨.F, 0, 0⟩ + selected_central_index : + centralIndex = normalization.pieceIndex selectedSlot selectedSign + exterior_routed_cell : LatticeVertexIncidentCell normalization.normalizedPoint + (routedDirection + 2) ∈ + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v + normalization.exteriorIndex).cells + central_routed_cell : LatticeVertexIncidentCell normalization.normalizedPoint + routedDirection ∈ + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v centralIndex).cells + selected_star : ∀ y, + y = normalization.normalizedPoint ∨ + y = normalization.normalizedPoint + 1 ∨ + y = normalization.normalizedPoint - 1 ∨ + y = normalization.normalizedPoint + ⟨0, 1⟩ ∨ + y = normalization.normalizedPoint - ⟨0, 1⟩ → + y ∈ FootprintVertices + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v + normalization.exteriorIndex) ∨ + y ∈ FootprintVertices + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v centralIndex) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificateExists.lean new file mode 100644 index 0000000000..cdda0461b5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificateExists.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileRoutingCertificate +public import LeanPool.ApollonianSuperharmonic.CoveredInterfaceOppositeIncidentCells +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile + +-- [TABLET NODE: BandOrderedGeneralSubtileRoutingCertificateExists] + +/-! +# BandOrderedGeneralSubtileRoutingCertificateExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralSubtileRoutingCertificateExists + {C₀ Cᵢ : BandCircle} {q : Fin 4 → CircleCoordinates} + {i : Fin 3} {T₀ Tᵢ : ProtoTile} + {h₀ hᵢ : PartialOdometer} {x : GaussianInt} + {normalization : BandOrderedGeneralSubtileNormalizationCertificate + C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x} + (interface : BandOrderedGeneralSubtileInterfaceCertificate normalization) : + Nonempty (BandOrderedGeneralSubtileRoutingCertificate interface) := by +-- BODY + classical + have hedge : ∃ edge : Finset GaussianInt, + normalization.normalizedPoint ∈ edge ∧ + edge ∈ FootprintEdges normalization.normalizedRoot ∩ + FootprintEdges normalization.normalizedFixed := by + rcases interface.startData.pathAB with + ⟨p, hp, hlen, _, _, hvertices, hsteps, hedges⟩ + exact SimpleGridPathVertexIncidentEdge _ _ + ⟨p, hp, hlen, hvertices, hsteps, hedges⟩ + normalization.normalizedPoint interface.normalized_point_on_start_path + have hrootBand : BandPrototile normalization.normalizedCircle.1.1 + normalization.normalizedRoot := by + rw [← normalization.normalized_circle_eq] + exact normalization.root_band + have hfixedBand : BandPrototile normalization.normalizedFixedCircle.1.1 + normalization.normalizedFixed := + TileOdometerBandPrototile _ _ _ normalization.normalized_fixed_odometer + have hrootRegular := LatticeEdgeRegularity normalization.normalizedCircle + normalization.normalizedRoot hrootBand interface.root_lattice + have hfixedRegular := LatticeEdgeRegularity normalization.normalizedFixedCircle + normalization.normalizedFixed hfixedBand interface.fixed_lattice + have hstart : interface.startData.point ∈ + FootprintVertices normalization.normalizedRoot ∩ + FootprintVertices normalization.normalizedFixed ∩ + FootprintVertices interface.startCompanion := + (interface.startData.unique_common interface.startData.point).2 rfl + have hend : interface.startData.otherAB ∈ + FootprintVertices normalization.normalizedRoot ∩ + FootprintVertices normalization.normalizedFixed ∩ + FootprintVertices interface.endCompanion := by + rw [← interface.interface_endpoints.1] + exact (interface.endData.unique_common interface.endData.point).2 rfl + obtain ⟨direction, hrootCell, hfixedCell⟩ := CoveredInterfaceOppositeIncidentCells + normalization.normalizedRoot normalization.normalizedFixed + interface.startCompanion interface.endCompanion + interface.startData.point interface.startData.otherAB + normalization.normalizedPoint interface.root_lattice interface.fixed_lattice + interface.start_lattice interface.end_lattice interface.root_fixed_disjoint + interface.root_start_disjoint interface.fixed_start_disjoint + interface.root_end_disjoint interface.fixed_end_disjoint + interface.startData.pathAB hedge interface.start_touching + interface.end_touching hstart hend hrootRegular.2.1 hfixedRegular.2.1 + normalization.normalized_star + obtain ⟨selectedSlot, selectedSign, hselected⟩ := + (normalization.piece_cell_cover _).mp hrootCell + let centralIndex := normalization.pieceIndex selectedSlot selectedSign + have hcentralIndex := normalization.piece_index_central selectedSlot selectedSign + have hpieceCells := normalization.piece_layout_cells selectedSlot selectedSign + have hexteriorCells := normalization.fixed_exterior_cells + have hcentralCell : LatticeVertexIncidentCell normalization.normalizedPoint + direction ∈ (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v centralIndex).cells := by + dsimp [centralIndex] + rw [← hpieceCells] + exact hselected + have hexteriorCell : LatticeVertexIncidentCell normalization.normalizedPoint + (direction + 2) ∈ + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v normalization.exteriorIndex).cells := by + rw [hexteriorCells] + exact hfixedCell + have hstar : ∀ y, y = normalization.normalizedPoint ∨ + y = normalization.normalizedPoint + 1 ∨ + y = normalization.normalizedPoint - 1 ∨ + y = normalization.normalizedPoint + ⟨0, 1⟩ ∨ + y = normalization.normalizedPoint - ⟨0, 1⟩ → + y ∈ FootprintVertices + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v normalization.exteriorIndex) ∨ + y ∈ FootprintVertices + (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v centralIndex) := by + have cell_corner (T : ProtoTile) (c : GaussianInt) (hc : c ∈ T.cells) : + ∀ y, y = c ∨ y = c + 1 ∨ y = c + ⟨0, 1⟩ ∨ + y = c + 1 + ⟨0, 1⟩ → y ∈ FootprintVertices T := by + intro y hy + have hn : T.cells.Nonempty := ⟨c, hc⟩ + simp only [FootprintVertices, ite_eq_left hn, Set.mem_ofPred_eq] + rcases hy with h | h | h | h + · exact ⟨c, hc, Or.inl h⟩ + · exact ⟨c, hc, Or.inr (Or.inl h)⟩ + · exact ⟨c, hc, Or.inr (Or.inr (Or.inl h))⟩ + · exact ⟨c, hc, Or.inr (Or.inr (Or.inr h))⟩ + let centralTile := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v centralIndex + let exteriorTile := SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v normalization.exteriorIndex + have centralCorners := cell_corner centralTile + (LatticeVertexIncidentCell normalization.normalizedPoint direction) hcentralCell + have exteriorCorners := cell_corner exteriorTile + (LatticeVertexIncidentCell normalization.normalizedPoint (direction + 2)) hexteriorCell + intro y hy + fin_cases direction <;> + simp? [LatticeVertexIncidentCell] at hcentralCell hexteriorCell ⊢ <;> + rcases hy with rfl | rfl | rfl | rfl | rfl <;> + solve + | apply Or.inr + apply centralCorners + simp [LatticeVertexIncidentCell, sub_eq_add_neg, add_assoc, add_comm, add_left_comm, + Zsqrtd.ext_iff] + | apply Or.inl + apply exteriorCorners + simp [LatticeVertexIncidentCell, sub_eq_add_neg, add_assoc, add_comm, add_left_comm, + Zsqrtd.ext_iff] + exact ⟨ + { edgeAtPoint := hedge + root_induced := hrootRegular.2.1 + fixed_induced := hfixedRegular.2.1 + routedDirection := direction + routed_root_cell := hrootCell + routed_fixed_cell := hfixedCell + selectedSlot := selectedSlot + selectedSign := selectedSign + selected_piece_cell := hselected + centralIndex := centralIndex + central_index := hcentralIndex + selected_central_index := rfl + exterior_routed_cell := hexteriorCell + central_routed_cell := hcentralCell + selected_star := hstar } + ⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileSelectedRowGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileSelectedRowGeometry.lean new file mode 100644 index 0000000000..e98ea5e847 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileSelectedRowGeometry.lean @@ -0,0 +1,332 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceExists +public import LeanPool.ApollonianSuperharmonic.P4418T3OuterCompanionAlignment +public import LeanPool.ApollonianSuperharmonic.P4418T3PresentedRowAdjacency +public import LeanPool.ApollonianSuperharmonic.P4418T3RoutedBlockCriterion +public import LeanPool.ApollonianSuperharmonic.P4418T3NestedCompanionGeometry +public import LeanPool.ApollonianSuperharmonic.P4418T3NestedCompanionEndpoint +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileSubodometer +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: BandOrderedGeneralSubtileSelectedRowGeometry] + +/-! +# BandOrderedGeneralSubtileSelectedRowGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrderedGeneralSubtileSelectedRowGeometry : + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle + bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions + bundle.selectedSlot bundle.selectedSign bundle.routedDirection), ∀ (selectedEdge : Finset + GaussianInt), (bundle.normalizedPoint ∈ selectedEdge) → ((selectedEdge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.exteriorIndex) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation placement.layout.P placement.layout.u + placement.layout.v placement.centralIndex)) → ((BandOrderedGeneralSelectedContactRow + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot placement.layout + placement.exteriorIndex placement.centralIndex) → ((¬ ((∃ (g : BandPackingSymmetry) (P : + FordFareyParameter), + BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = bundle.normalizedCircle.1.1) ∨ + (∃ (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K 0) = bundle.normalizedCircle.1.1))) → (∀ (r : Fin 4 → + CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), (ProperBandQuadruple r) → ((r 0 + = bundle.normalizedCircle.1.1) → ((r i.succ = bundle.normalizedFixedCircle.1.1) → + ((TileCentroid bundle.normalizedFixed - + TileCentroid bundle.normalizedRoot = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (r i.succ) (r 0) + + BandVectors.1 (r 0) (r i.succ)))) → ((bundle.normalizedFixedSlope.1 - + bundle.normalizedRootSlope.1 = + ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (r i.succ) (r 0) + + BandVectors.2 (r 0) (r i.succ)))).1) → ((bundle.normalizedFixedSlope.2 - + bundle.normalizedRootSlope.2 = + ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (r i.succ) (r 0) + + BandVectors.2 (r 0) (r i.succ)))).2) → ( + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let oldRight := TileTranslation bundle.normalizedRoot + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0))) + ∃ (C' : BandCircle) (selectedSlope : ℝ × ℝ), + C'.1.1 = bundle.normalizedPresentation bundle.selectedSlot.succ ∧ + TileSubodometer bundle.normalizedCircle.1.1 C'.1.1 + bundle.normalizedRoot selectedSupport bundle.normalizedRootFunction + selectedFunction ∧ + PartialOdometerSlope selectedFunction = some selectedSlope ∧ + bundle.normalizedPoint ∈ bundle.normalizedFixedFunction.domain ∧ + bundle.normalizedPoint ∈ selectedFunction.domain ∧ + (∀ y, y = bundle.normalizedPoint ∨ y = bundle.normalizedPoint + 1 ∨ + y = bundle.normalizedPoint - 1 ∨ + y = bundle.normalizedPoint + ⟨0, 1⟩ ∨ + y = bundle.normalizedPoint - ⟨0, 1⟩ → + y ∈ bundle.normalizedFixedFunction.domain ∨ + y ∈ selectedFunction.domain) ∧ + Int.toNat bundle.normalizedFixedCircle.1.1.1 + Int.toNat C'.1.1.1 < + Int.toNat bundle.normalizedCircle.1.1.1 + + Int.toNat bundle.normalizedFixedCircle.1.1.1 ∧ + ((C' = bundle.normalizedFixedCircle ∧ + LeftLatticeAdjacent bundle.normalizedFixedCircle + bundle.normalizedFixed selectedSupport + bundle.normalizedFixedFunction selectedFunction ∧ + bundle.normalizedPoint ∉ FootprintVertices oldRight) ∨ + (∃ (q : Fin 4 → CircleCoordinates) (j : Fin 3) (t : Fin 4), + ProperBandQuadruple q ∧ + q 0 = bundle.normalizedFixedCircle.1.1 ∧ q j.succ = C'.1.1 ∧ + TileCentroid selectedSupport - TileCentroid bundle.normalizedFixed = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ t.val * + (BandVectors.1 (q j.succ) (q 0) + + BandVectors.1 (q 0) (q j.succ))) ∧ + selectedSlope.1 - bundle.normalizedFixedSlope.1 = + ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ t.val * + (BandVectors.2 (q j.succ) (q 0) + + BandVectors.2 (q 0) (q j.succ)))).1 ∧ + selectedSlope.2 - bundle.normalizedFixedSlope.2 = + ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ t.val * + (BandVectors.2 (q j.succ) (q 0) + + BandVectors.2 (q 0) (q j.succ)))).2 ∧ + SubtileLatticeAdjacent bundle.normalizedFixedCircle C' + bundle.normalizedFixed selectedSupport + bundle.normalizedFixedFunction selectedFunction ∧ + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ + bundle.normalizedPoint ∈ FootprintVertices + (TileTranslation bundle.normalizedFixed + ((⟨0, 1⟩ : GaussianInt) ^ t.val * + (if Even t.val then BandVectors.1 (q 0) (q j.succ) + else BandVectors.1 (q j.succ) (q 0)))))) ∨ + (∃ (q : Fin 4 → CircleCoordinates) (j : Fin 3) (t : Fin 4), + ProperBandQuadruple q ∧ q 0 = C'.1.1 ∧ + q j.succ = bundle.normalizedFixedCircle.1.1 ∧ + TileCentroid bundle.normalizedFixed - TileCentroid selectedSupport = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ t.val * + (BandVectors.1 (q j.succ) (q 0) + + BandVectors.1 (q 0) (q j.succ))) ∧ + bundle.normalizedFixedSlope.1 - selectedSlope.1 = + ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ t.val * + (BandVectors.2 (q j.succ) (q 0) + + BandVectors.2 (q 0) (q j.succ)))).1 ∧ + bundle.normalizedFixedSlope.2 - selectedSlope.2 = + ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ t.val * + (BandVectors.2 (q j.succ) (q 0) + + BandVectors.2 (q 0) (q j.succ)))).2 ∧ + SubtileLatticeAdjacent C' bundle.normalizedFixedCircle + selectedSupport bundle.normalizedFixed selectedFunction + bundle.normalizedFixedFunction ∧ + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ + bundle.normalizedPoint ∈ FootprintVertices + (TileTranslation selectedSupport + ((⟨0, 1⟩ : GaussianInt) ^ t.val * + (if Even t.val then BandVectors.1 (q 0) (q j.succ) + else BandVectors.1 (q j.succ) (q 0))))))))))))))))) := by + intro C D T N h k x bundle placement selectedEdge hx hedge row horbit r i s hr hr0 hri + hcentroid hslopex hslopey +-- BODY + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let cert := placement.layout + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let a := placement.exteriorIndex + let b := placement.centralIndex + let S := bundle.pieces bundle.selectedSlot bundle.selectedSign + let f := bundle.functions bundle.selectedSlot bundle.selectedSign + have hq : ProperBandQuadruple q := cfg.proper + have hpos : 0 < (q bundle.selectedSlot.succ).1 := by + have hn := (ProperBandCurvatureStructure q hq).2.1 bundle.selectedSlot + have hne := cfg.noLine bundle.selectedSlot.succ + change (q bundle.selectedSlot.succ).1 ≠ 0 at hne + omega + let C' : BandCircle := ⟨⟨q bundle.selectedSlot.succ, + ⟨Or.inl hpos, q, hq.1, bundle.selectedSlot.succ, rfl⟩⟩, hpos⟩ + have hsub : TileSubodometer bundle.normalizedCircle.1.1 C'.1.1 + bundle.normalizedRoot S bundle.normalizedRootFunction f := by + refine ⟨?_, bundle.piece_odometer _ _, bundle.piece_footprint _ _, + ?_, bundle.function_restriction _ _, q, bundle.selectedSlot, hq, + bundle.normalized_circle_eq, rfl, bundle.selectedSign, + bundle.piece_centroid _ _, bundle.piece_slope _ _⟩ + · rw [← bundle.normalized_circle_eq] + exact bundle.normalized_root_odometer + · intro y hy + exact (bundle.function_domain_cover y).mpr + ⟨bundle.selectedSlot, bundle.selectedSign, hy⟩ + obtain ⟨p, hp⟩ : ∃ p, PartialOdometerSlope f = some p := by + rcases bundle.piece_slope bundle.selectedSlot bundle.selectedSign with + hz | ⟨p₀, p, _, hp, _, _⟩ + · change (q bundle.selectedSlot.succ).1 = 0 at hz + omega + · exact ⟨p, hp⟩ + have exteriorFoot : FootprintVertices (occurrence a) = + FootprintVertices bundle.normalizedFixed := + (ProtoTileObservableExtensionality _ _ placement.fixed_exterior_cells + placement.fixed_exterior_empty_anchor).1 + have centralFoot : FootprintVertices (occurrence b) = FootprintVertices S := by + change FootprintVertices (occurrence placement.centralIndex) = FootprintVertices S + rw [placement.selected_central_index] + exact (placement.piece_layout_footprint _ _).symm + have edgeVertex (U : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges U) (y : GaussianInt) (hy : y ∈ e) : + y ∈ FootprintVertices U := by + rcases he with ⟨c, hc, he⟩ + unfold FootprintVertices + rw [ite_eq_left ⟨c, hc⟩] + rcases he with he | he | he | he <;> subst e + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hy + all_goals rcases hy with rfl | rfl + all_goals exact ⟨_, hc, by simp⟩ + have fixedDomain := PositiveCurvatureTileOdometerDomain + bundle.normalizedFixedCircle.1.1 bundle.normalizedFixed + bundle.normalizedFixedFunction bundle.normalizedFixedCircle.property + bundle.normalized_fixed_odometer + have selectedDomain := PositiveCurvatureTileOdometerDomain C'.1.1 S f + C'.property hsub.2.1 + have hxFixed : bundle.normalizedPoint ∈ bundle.normalizedFixedFunction.domain := by + apply (Set.ext_iff.mp fixedDomain _).mpr + rw [← exteriorFoot] + exact edgeVertex _ _ hedge.1 _ hx + have hxSelected : bundle.normalizedPoint ∈ f.domain := by + apply (Set.ext_iff.mp selectedDomain _).mpr + rw [← centralFoot] + exact edgeVertex _ _ hedge.2 _ hx + have hstar : ∀ y, y = bundle.normalizedPoint ∨ y = bundle.normalizedPoint + 1 ∨ + y = bundle.normalizedPoint - 1 ∨ y = bundle.normalizedPoint + ⟨0, 1⟩ ∨ + y = bundle.normalizedPoint - ⟨0, 1⟩ → + y ∈ bundle.normalizedFixedFunction.domain ∨ y ∈ f.domain := by + intro y hy + rcases placement.selected_star y hy with h | h + · exact Or.inl ((Set.ext_iff.mp fixedDomain y).mpr (exteriorFoot ▸ h)) + · exact Or.inr ((Set.ext_iff.mp selectedDomain y).mpr (centralFoot ▸ h)) + have hsize : + Int.toNat bundle.normalizedFixedCircle.1.1.1 + Int.toNat C'.1.1.1 < + Int.toNat bundle.normalizedCircle.1.1.1 + + Int.toNat bundle.normalizedFixedCircle.1.1.1 := by + have hlt := hq.2 bundle.selectedSlot + have hrootpos := (ProperBandCurvatureStructure q hq).1 + have hnat : Int.toNat (q bundle.selectedSlot.succ).1 < + Int.toNat (q 0).1 := (Int.toNat_lt_toNat hrootpos).mpr hlt + change Int.toNat bundle.normalizedFixedCircle.1.1.1 + + Int.toNat (q bundle.selectedSlot.succ).1 < + Int.toNat bundle.normalizedCircle.1.1.1 + + Int.toNat bundle.normalizedFixedCircle.1.1.1 + have heq : q 0 = bundle.normalizedCircle.1.1 := bundle.normalized_circle_eq + rw [heq] at hnat + omega + obtain ⟨data⟩ := P4418T3SelectedInterfaceExists q cfg + bundle.normalizedCircle bundle.normalizedRoot cert a b row + have twice : bundle.routedDirection + 2 + 2 = bundle.routedDirection := by + generalize bundle.routedDirection = d + fin_cases d <;> rfl + have mark := P4418T3RoutedBlockCriterion q cfg bundle.normalizedCircle + bundle.normalizedRoot cert a b row bundle.root_lattice data + bundle.normalizedPoint (bundle.routedDirection + 2) selectedEdge hx hedge + placement.exterior_routed_cell + (by simpa only [twice] using placement.central_routed_cell) + have align := (P4418T3OuterCompanionAlignment C D T N h k x bundle + placement row r i s hr hr0 hri hcentroid hslopex hslopey).2.2 + dsimp only at mark + have mark := (congrArg (fun d => bundle.normalizedPoint ∈ + FootprintVertices (TileTranslation bundle.normalizedRoot d)) align).to_iff.trans mark + have adj := P4418T3PresentedRowAdjacency C D T N h k x bundle placement + row r i s hr hr0 hri hcentroid hslopex hslopey C' p rfl hp hsub + refine ⟨C', p, rfl, hsub, hp, hxFixed, hxSelected, hstar, hsize, ?_⟩ + cases ht : P3996T1SRowTable q cfg bundle.normalizedCircle + bundle.normalizedRoot cert row with + | none => + rw [ht] at adj mark + exact Or.inl ⟨adj.1, adj.2, fun hxOld => mark.mp hxOld⟩ + | some z => + rw [ht] at adj mark + obtain ⟨⟨E⟩, hcontained, hfoot⟩ := P4418T3NestedCompanionGeometry q cfg + bundle.normalizedCircle bundle.normalizedRoot cert a b row z ht + have endpoint := P4418T3NestedCompanionEndpoint q cfg + bundle.normalizedCircle bundle.normalizedRoot cert a b row data z ht E hcontained + have reducedMark : + bundle.normalizedPoint ∈ FootprintVertices + (TileTranslation bundle.normalizedRoot + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)))) ↔ + bundle.normalizedPoint ∈ FootprintVertices + (TileTranslation (occurrence z.childIndex) z.rightShift) := by + constructor + · intro hxOld + have heq : bundle.normalizedPoint = E.point := + (mark.mp hxOld).trans endpoint.symm + exact ((E.unique_common _).mpr heq).1.2 + · intro hxNew + rw [align] + have ht' : P3996T1SRowTable bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedRoot + placement.layout row = some z := ht + simpa only [ht'] using hfoot hxNew + obtain ⟨_, _, _, _, _, _, hindices, _, hd, _, _⟩ := + P3996T1SRowAlignment q cfg bundle.normalizedCircle + bundle.normalizedRoot cert a b row z ht + have translateFoot (U V : ProtoTile) + (hf : FootprintVertices U = FootprintVertices V) (d : GaussianInt) : + FootprintVertices (TileTranslation U d) = + FootprintVertices (TileTranslation V d) := by + rw [(TileTranslationFormulas U d).2.2.2.2.2.1, + (TileTranslationFormulas V d).2.2.2.2.2.1, hf] + cases hflag : z.childIsExterior + · simp only [hflag, Bool.false_eq_true, ↓reduceIte] at adj hindices + have hcfoot : FootprintVertices (occurrence z.childIndex) = + FootprintVertices S := by + rw [hindices.1] + exact centralFoot + rw [translateFoot _ _ hcfoot, hd] at reducedMark + rcases adj with ⟨hpr, h₀, hj, hc, hs, hadj⟩ + exact Or.inr (Or.inr ⟨z.predecessor, z.parentSlot, z.rotation, + hpr, h₀, hj, hc, congrArg Prod.fst hs, congrArg Prod.snd hs, + hadj, reducedMark⟩) + · simp only [hflag, ↓reduceIte] at adj hindices + have hcfoot : FootprintVertices (occurrence z.childIndex) = + FootprintVertices bundle.normalizedFixed := by + rw [hindices.1] + exact exteriorFoot + rw [translateFoot _ _ hcfoot, hd] at reducedMark + rcases adj with ⟨hpr, h₀, hj, hc, hs, hadj⟩ + exact Or.inr (Or.inl ⟨z.predecessor, z.parentSlot, z.rotation, + hpr, h₀, hj, hc, congrArg Prod.fst hs, congrArg Prod.snd hs, + hadj, reducedMark⟩) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryOccurrenceGenealogy.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryOccurrenceGenealogy.lean new file mode 100644 index 0000000000..55db3edb8f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryOccurrenceGenealogy.lean @@ -0,0 +1,145 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrientedBoundaryParentChain +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorsExistUnique +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique +public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep +public import LeanPool.ApollonianSuperharmonic.P4566T1LiteralSuccessorCharts +public import LeanPool.ApollonianSuperharmonic.P4566T1SmallRetainedSides +public import LeanPool.ApollonianSuperharmonic.P4566T1StrictRetainedGenealogy + +-- [TABLET NODE: BandOrientedBoundaryOccurrenceGenealogy] + +/-! +# BandOrientedBoundaryOccurrenceGenealogy + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrientedBoundaryOccurrenceGenealogy + (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) : + let q : Fin 4 → CircleCoordinates := + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] + let r : Fin 4 → CircleCoordinates := + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + ProperBandQuadruple q ∧ + (p 0).1 < (q 0).1 ∧ (p 2).1 < (q 0).1 ∧ (p 3).1 < (q 0).1 ∧ + ((((p 2).1 = 1) → ∀ orientation : Bool, + UnitOccurrenceOrientation q 1 orientation → + UnitOccurrenceOrientation p 1 orientation) ∧ + (((p 3).1 = 1) → ∀ orientation : Bool, + UnitOccurrenceOrientation q 2 orientation → + UnitOccurrenceOrientation p 2 orientation)) ∧ + (((((p 2).1 = 0 ∨ (p 2).1 = 1) ∧ + ((p 3).1 = 0 ∨ (p 3).1 = 1)) ∧ + ((PrimitiveVectorOrientation (p 2) (p 3) ∧ + (∀ orientation : Bool, + UnitOccurrenceOrientation q 1 orientation → + UnitTriangularStep orientation (BandVectors.1 (p 3) (p 2)) ∧ + ((p 3).1 = 0 ∨ orientation = false)) ∧ + (∀ orientation : Bool, + UnitOccurrenceOrientation q 2 orientation → + UnitTriangularStep orientation + ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (p 3) (p 2)) ∧ + ((p 2).1 = 0 ∨ orientation = true)) ∧ + ((p 2).1 = 1 → (p 3).1 = 1 → + UnitOccurrenceOrientation q 1 false ∧ + UnitOccurrenceOrientation q 2 true ∧ + UnitOccurrenceOrientation r 1 false ∧ + UnitOccurrenceOrientation r 2 true)) ∨ + (PrimitiveVectorOrientation (p 3) (p 2) ∧ + (∀ orientation : Bool, + UnitOccurrenceOrientation q 1 orientation → + UnitTriangularStep orientation (BandVectors.1 (p 3) (p 2)) ∧ + ((p 3).1 = 0 ∨ orientation = true)) ∧ + (∀ orientation : Bool, + UnitOccurrenceOrientation q 2 orientation → + UnitTriangularStep orientation + ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (p 3) (p 2)) ∧ + ((p 2).1 = 0 ∨ orientation = false)) ∧ + ((p 2).1 = 1 → (p 3).1 = 1 → + UnitOccurrenceOrientation q 1 true ∧ + UnitOccurrenceOrientation q 2 false ∧ + UnitOccurrenceOrientation r 1 true ∧ + UnitOccurrenceOrientation r 2 false)))) ∨ + (∃ t : Fin 4 → CircleCoordinates, + ProperBandQuadruple t ∧ t 0 = p 2 ∧ t 1 = p 3 ∧ + (p 3).1 < (p 2).1 ∧ + ∀ orientation : Bool, + UnitOccurrenceOrientation p 2 orientation → + (((t 2).1 ≠ 1 → + UnitOccurrenceOrientation t 0 orientation) ∧ + ((t 2).1 = 1 → + ((PrimitiveVectorOrientation (t 1) (t 2) ∧ + orientation = false) ∨ + (PrimitiveVectorOrientation (t 2) (t 1) ∧ + orientation = true))))) ∨ + ∃ t : Fin 4 → CircleCoordinates, + ProperBandQuadruple t ∧ t 0 = p 3 ∧ t 1 = p 2 ∧ + (p 2).1 < (p 3).1 ∧ + ∀ orientation : Bool, + UnitOccurrenceOrientation p 1 orientation → + (((t 3).1 ≠ 1 → + UnitOccurrenceOrientation t 0 orientation) ∧ + ((t 3).1 = 1 → + ((PrimitiveVectorOrientation (t 1) (t 3) ∧ + orientation = false) ∨ + (PrimitiveVectorOrientation (t 3) (t 1) ∧ + orientation = true))))) := by +-- BODY + classical + dsimp only + let q : Fin 4 → CircleCoordinates := + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] + have nn := (SemiProperForestClassification p hp.1).1 + have hx : (p 1).1 < (p 0).1 := hp.2 0 + have h0 := nn 0 + have h2 := nn 2 + have h3 := nn 3 + have growth : (p 0).1 < (q 0).1 ∧ + (p 2).1 < (q 0).1 ∧ (p 3).1 < (q 0).1 := by + dsimp [q] + omega + have hq : ProperBandQuadruple q := by + refine ⟨SemiProperQuadruple.successor hp.1, ?_⟩ + intro j + fin_cases j + · exact growth.1 + · exact growth.2.1 + · exact growth.2.2 + refine ⟨hq, growth.1, growth.2.1, growth.2.2, ?_, ?_⟩ + · have charts := P4566T1LiteralSuccessorCharts p hp + exact ⟨fun h b hb => (charts.1 h b).mp hb, + fun h b hb => (charts.2 h b).mp hb⟩ + · by_cases small : ((p 2).1 = 0 ∨ (p 2).1 = 1) ∧ + ((p 3).1 = 0 ∨ (p 3).1 = 1) + · exact Or.inl ⟨small, P4566T1SmallRetainedSides p hp small.1 small.2⟩ + · exact Or.inr (P4566T1StrictRetainedGenealogy p hp small) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryParentChain.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryParentChain.lean new file mode 100644 index 0000000000..9a9fc0a261 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryParentChain.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple + +-- [TABLET NODE: BandOrientedBoundaryParentChain] + +/-! +# BandOrientedBoundaryParentChain + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrientedBoundaryParentChain + (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) : + (((p 2).1 = 0 ∨ (p 2).1 = 1) ∧ + ((p 3).1 = 0 ∨ (p 3).1 = 1)) ∨ + (∃ t : Fin 4 → CircleCoordinates, + ProperBandQuadruple t ∧ t 0 = p 2 ∧ t 1 = p 3 ∧ + (p 3).1 < (p 2).1) ∨ + ∃ t : Fin 4 → CircleCoordinates, + ProperBandQuadruple t ∧ t 0 = p 3 ∧ t 1 = p 2 ∧ + (p 2).1 < (p 3).1 := by +-- BODY + let Rel (a b : CircleCoordinates) : Prop := + ((a.1 = 0 ∨ a.1 = 1) ∧ (b.1 = 0 ∨ b.1 = 1)) ∨ + (∃ t : Fin 4 → CircleCoordinates, + ProperBandQuadruple t ∧ t 0 = a ∧ t 1 = b ∧ b.1 < a.1) ∨ + ∃ t : Fin 4 → CircleCoordinates, + ProperBandQuadruple t ∧ t 0 = b ∧ t 1 = a ∧ a.1 < b.1 + have claim : ∀ r : Fin 4 → CircleCoordinates, + SemiProperQuadruple r → ProperBandQuadruple r → + Rel (r 1) (r 2) ∧ Rel (r 2) (r 3) ∧ Rel (r 3) (r 1) := by + intro r hr + induction hr with + | base z => + intro hproper + have hbad := hproper.2 0 + simp at hbad + | @rotate r hr ih => + intro hproper + have old : ProperBandQuadruple r := by + refine ⟨hr, ?_⟩ + intro j + fin_cases j + · simpa using hproper.2 2 + · simpa using hproper.2 0 + · simpa using hproper.2 1 + rcases ih old with ⟨h12, h23, h31⟩ + exact ⟨by simpa [Rel] using h23, + by simpa [Rel] using h31, + by simpa [Rel] using h12⟩ + | @successor r hr ih => + intro hproper + rcases SemiProperForestClassification r hr with ⟨_, cases⟩ + rcases cases with root | root | root | old + · rcases root with ⟨z, hz⟩ + rw [hz] + simp [Rel] + · rcases root with ⟨z, hz⟩ + rw [hz] + simp [Rel] + · rcases root with ⟨z, hz⟩ + rw [hz] + simp [Rel] + · rcases ih old with ⟨h12, h23, h31⟩ + have rot1 : ProperBandQuadruple ![r 0, r 2, r 3, r 1] := by + refine ⟨SemiProperQuadruple.rotate old.1, ?_⟩ + intro j + fin_cases j + · simpa using old.2 1 + · simpa using old.2 2 + · simpa using old.2 0 + have rot2 : ProperBandQuadruple ![r 0, r 3, r 1, r 2] := by + refine ⟨SemiProperQuadruple.rotate rot1.1, ?_⟩ + intro j + fin_cases j + · simpa using old.2 2 + · simpa using old.2 0 + · simpa using old.2 1 + constructor + · dsimp + right + left + exact ⟨![r 0, r 2, r 3, r 1], rot1, rfl, rfl, + by simpa using old.2 1⟩ + constructor + · simpa [Rel] using h23 + · dsimp + right + right + exact ⟨![r 0, r 3, r 1, r 2], rot2, rfl, rfl, + by simpa using old.2 2⟩ + exact (claim p hp.1 hp).2.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentEndpoints.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentEndpoints.lean new file mode 100644 index 0000000000..b25e963877 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentEndpoints.lean @@ -0,0 +1,590 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentEndpoints +public import LeanPool.ApollonianSuperharmonic.DiamondOrientedChildParentEndpoints +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout +public import LeanPool.ApollonianSuperharmonic.P4055T1PlacementNormalization +public import LeanPool.ApollonianSuperharmonic.P4055T1BandQuarterTurn +public import LeanPool.ApollonianSuperharmonic.P4055T1OrderedGeneralOppositeEndpoints +public import LeanPool.ApollonianSuperharmonic.P4055T1PackingGridEquivalence +public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage + +-- [TABLET NODE: BandOrientedChildParentEndpoints] + +/-! +# BandOrientedChildParentEndpoints + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OrientedEndpointGeometry + +private theorem hregimeNormalized : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (a : Fin (3 : ℕ)), ∀ (g' : BandPackingSymmetry), + let p : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + let qg := BandPackingSymmetryQuadrupleAction g' p + (Xor (∃ (P : FordFareyParameter), (1 : ℕ) < P.q ∧ BandPackingSymmetryQuadrupleAction g' p + = FordRecursiveQuadruple P) (Xor (∃ (K : DiamondParameter), (1 : ℕ) < K.1 ∧ + BandPackingSymmetryQuadrupleAction g' p = DiamondRecursiveQuadruple K) (Nonempty + (BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g' p))))) → (Xor + (∃ P, 1 < P.q ∧ qg = FordRecursiveQuadruple P) (Xor (∃ K : DiamondParameter, 1 < K.1 + ∧ qg = DiamondRecursiveQuadruple K) (Nonempty (BandOrderedGeneralConfiguration qg)))) + ) := by + classical + intro r a g' p qg hregimeQ + simpa [qg] using hregimeQ + +private theorem normalized : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), ∀ (Z : ProtoTile), ∀ (a : Fin (3 : ℕ)), ∀ (g' : BandPackingSymmetry), + let p : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + let qg := BandPackingSymmetryQuadrupleAction g' p + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + let U' := BandPackingSymmetryTileAction g' U + let W' := BandPackingSymmetryTileAction g' W + let Z' := BandPackingSymmetryTileAction g' Z + let ii : GaussianInt := ⟨0, 1⟩ + (ProperBandQuadruple qg) → ((BandPrototile (qg (0 : Fin (4 : ℕ))) U') → ((BandPrototile + (qg k.succ) W') → ((BandPrototile (qg j.succ) Z') → (((0 : ℤ) < (qg (0 : Fin (4 : + ℕ))).1) → (((0 : ℤ) < (qg k.succ).1) → (((0 : ℤ) < (qg j.succ).1) → ((TileCentroid W' + - TileCentroid U' = (1 / 2 : ℝ) • GaussianRealPoint (ii ^ (↑t : ℕ) * (BandVectors.1 + (qg k.succ) (qg (0 : Fin (4 : ℕ))) + BandVectors.1 (qg (0 : Fin (4 : ℕ))) (qg + k.succ)))) → ((TileCentroid Z' - TileCentroid U' = (1 / 2 : ℝ) • GaussianRealPoint + (ii ^ (↑t : ℕ) * if Even (↑t : ℕ) then BandVectors.1 (qg (0 : Fin (4 : ℕ))) (qg + j.succ) - BandVectors.1 (qg j.succ) (qg (0 : Fin (4 : ℕ))) else BandVectors.1 (qg + j.succ) (qg (0 : Fin (4 : ℕ))) - BandVectors.1 (qg (0 : Fin (4 : ℕ))) (qg j.succ))) → + ((Xor (∃ P, 1 < P.q ∧ qg = FordRecursiveQuadruple P) (Xor (∃ K : DiamondParameter, 1 + < K.1 ∧ qg = DiamondRecursiveQuadruple K) (Nonempty (BandOrderedGeneralConfiguration + qg)))) → ( + let uR := (⟨0, 1⟩ : GaussianInt) ^ t.val * + (if Even t.val then BandVectors.1 (qg 0) (qg k.succ) + else BandVectors.1 (qg k.succ) (qg 0)) + let uL := (⟨0, 1⟩ : GaussianInt) ^ t.val * + (if Even t.val then BandVectors.1 (qg k.succ) (qg 0) + else BandVectors.1 (qg 0) (qg k.succ)) + ∃ rightData : ExactTileInterfaceTriple U' (TileTranslation U' uR) W', + ∃ incomingData : ExactTileInterfaceTriple U' (TileTranslation U' uL) W', + ∃ adjacentData : ExactTileInterfaceTriple U' W' Z', + rightData.point ≠ incomingData.point ∧ + adjacentData.point = incomingData.point ∧ + rightData.otherCA = incomingData.point ∧ + incomingData.otherCA = rightData.point ∧ + adjacentData.otherAB = rightData.point)))))))))) ) := by + classical + intro r i s U W Z a g' p qg k t j U' W' Z' ii hproperG hU' hW' hZ' hUpos' hWpos' hZpos' + hWcentNorm hZcentNorm hregimeNormalized + rcases hregimeNormalized with ⟨hFord, _⟩ | ⟨hrest, _⟩ + · rcases hFord with ⟨P, hP, hqFord⟩ + have hUF : BandPrototile (FordRecursiveQuadruple P 0) U' := by + simpa [hqFord] using hU' + have hWF : BandPrototile (FordRecursiveQuadruple P k.succ) + (BandPackingSymmetryTileAction g' W) := by + simpa [hqFord] using hW' + have hZF : BandPrototile + (FordRecursiveQuadruple P j.succ) (BandPackingSymmetryTileAction g' Z) := by + simpa [hqFord] using hZ' + have hUFpos : 0 < (FordRecursiveQuadruple P 0).1 := by + simpa [hqFord] using hUpos' + have hWFpos : 0 < (FordRecursiveQuadruple P k.succ).1 := by + simpa [hqFord] using hWpos' + have hZFpos : 0 < (FordRecursiveQuadruple P j.succ).1 := by + simpa [hqFord] using hZpos' + have _fordData := FordOrientedChildParentEndpoints P hP k t U' + W' Z' hUF hWF hZF hUFpos hWFpos hZFpos + (by simpa [hqFord, ii, U', W'] using hWcentNorm) + (by + by_cases ht : Even t.val + · simpa [ht, hqFord, ii, U', Z', j] using hZcentNorm + · simpa [ht, hqFord, ii, U', Z', j] using hZcentNorm) + rw [hqFord] + exact _fordData + · rcases hrest with ⟨hDiamond, _⟩ | ⟨hGeneral, _⟩ + · rcases hDiamond with ⟨K, hK, hqDiamond⟩ + have hUD : BandPrototile (DiamondRecursiveQuadruple K 0) U' := by + simpa [hqDiamond] using hU' + have hWD : BandPrototile (DiamondRecursiveQuadruple K k.succ) + (BandPackingSymmetryTileAction g' W) := by + simpa [hqDiamond] using hW' + have hZD : BandPrototile + (DiamondRecursiveQuadruple K j.succ) (BandPackingSymmetryTileAction g' Z) := by + simpa [hqDiamond] using hZ' + have hUDpos : 0 < (DiamondRecursiveQuadruple K 0).1 := by + simpa [hqDiamond] using hUpos' + have hWDpos : 0 < (DiamondRecursiveQuadruple K k.succ).1 := by + simpa [hqDiamond] using hWpos' + have hZDpos : 0 < (DiamondRecursiveQuadruple K j.succ).1 := by + simpa [hqDiamond] using hZpos' + have _diamondData := DiamondOrientedChildParentEndpoints K k t U' + W' Z' hUD hWD hZD hUDpos hWDpos hZDpos + (by simpa [hqDiamond, ii, U', W'] using hWcentNorm) + (by + by_cases ht : Even t.val + · simpa [ht, hqDiamond, ii, U', Z', j] using hZcentNorm + · simpa [ht, hqDiamond, ii, U', Z', j] using hZcentNorm) + rw [hqDiamond] + exact _diamondData + · rcases hGeneral with ⟨cfg⟩ + let C₀ : BandCircle := + ⟨⟨qg 0, Or.inl hUpos', ⟨qg, hproperG.1, ⟨0, rfl⟩⟩⟩, hUpos'⟩ + have hUQuarter : QuarterTurnSymmetric U' := + (BandTileSimultaneousInduction qg hproperG U' hU').2.2.2.1 + have hcertificate := BandOrderedGeneralLayout qg cfg C₀ rfl U' hU' + (by + intro q₀ T₀ S₀ hq₀ hT₀ hocc hunion hsmall + have hI := BandTileSimultaneousInduction q₀ hq₀ T₀ hT₀ + exact ⟨hI.1, hI.2.1, hI.2.2.1 S₀ hocc hunion⟩) + (fun D V hV _ => P4055T1BandQuarterTurn D V hV) + (by + intro q₀ T₀ V hq₀ hT₀ hsmall hlarge m hV hcent + exact (BandTileSimultaneousInduction q₀ hq₀ T₀ hT₀).2.2.2.2.2.1 + hlarge m V hV hcent) + (by + intro q₀ T₀ V W hq₀ hT₀ hsmall m hV hW hcentV hcentW + exact (BandTileSimultaneousInduction q₀ hq₀ T₀ hT₀).2.2.2.2.2.2.1 + m V W hV hW hcentV hcentW) + rcases hcertificate with ⟨cert⟩ + exact P4055T1OrderedGeneralOppositeEndpoints qg hproperG cfg C₀ + k t U' W' Z' hU' hW' hZ' hUpos' hWpos' hZpos' hWcentNorm + (by + by_cases ht : Even t.val <;> + simpa only [j, ht, ite_true, ite_false] using hZcentNorm) + cert hUQuarter (P4055T1BandQuarterTurn _ _ hW') + (P4055T1BandQuarterTurn _ _ hZ') + +private theorem transR : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (a + : Fin (3 : ℕ)), ∀ (g' : BandPackingSymmetry), + let p : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + let qg := BandPackingSymmetryQuadrupleAction g' p + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let U' := BandPackingSymmetryTileAction g' U + let ii : GaussianInt := ⟨0, 1⟩ + (BandPackingSymmetryVectorAction g' (ii ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 + (r (0 : Fin (4 : ℕ))) (r i.succ) else BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ)))) + = ii ^ (↑t : ℕ) * if Even (↑t : ℕ) then BandVectors.1 (qg (0 : Fin (4 : ℕ))) (qg + k.succ) else BandVectors.1 (qg k.succ) (qg (0 : Fin (4 : ℕ)))) → ( + let uR := ii ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + let vR := ii ^ t.val * + (if Even t.val then BandVectors.1 (qg 0) (qg k.succ) + else BandVectors.1 (qg k.succ) (qg 0)) + BandPackingSymmetryTileAction g' (TileTranslation U uR) = TileTranslation U' vR) ) := by + classical + intro r i s U a g' p qg k t U' ii hdispR uR vR + rw [(BandPackingSymmetryTilingTransport g').2.2.2.2.2.2.1] + exact congrArg (TileTranslation U') hdispR + +private theorem transL : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (a + : Fin (3 : ℕ)), ∀ (g' : BandPackingSymmetry), + let p : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + let qg := BandPackingSymmetryQuadrupleAction g' p + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let U' := BandPackingSymmetryTileAction g' U + let ii : GaussianInt := ⟨0, 1⟩ + (BandPackingSymmetryVectorAction g' (ii ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 + (r i.succ) (r (0 : Fin (4 : ℕ))) else BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)) + = ii ^ (↑t : ℕ) * if Even (↑t : ℕ) then BandVectors.1 (qg k.succ) (qg (0 : Fin (4 : + ℕ))) else BandVectors.1 (qg (0 : Fin (4 : ℕ))) (qg k.succ)) → ( + let uL := ii ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + let vL := ii ^ t.val * + (if Even t.val then BandVectors.1 (qg k.succ) (qg 0) + else BandVectors.1 (qg 0) (qg k.succ)) + BandPackingSymmetryTileAction g' (TileTranslation U uL) = TileTranslation U' vL) ) := by + classical + intro r i s U a g' p qg k t U' ii hdispL uL vL + rw [(BandPackingSymmetryTilingTransport g').2.2.2.2.2.2.1] + exact congrArg (TileTranslation U') hdispL + +private theorem hv : + (by + classical + exact + ∀ (g' : BandPackingSymmetry), ∀ (f : GaussianInt ≃ GaussianInt), ((f : GaussianInt → + GaussianInt) = BandPackingSymmetryVectorAction g') → (∀ (T : ProtoTile), + FootprintVertices (BandPackingSymmetryTileAction g' T) = f '' FootprintVertices T) ) + := by + classical + intro g' f hfun T + simpa only [hfun] using (BandPackingSymmetryTilingTransport g').2.2.2.2.2.2.2.1 T + +private theorem he : + (by + classical + exact + ∀ (g' : BandPackingSymmetry), ∀ (f : GaussianInt ≃ GaussianInt), ((f : GaussianInt → + GaussianInt) = BandPackingSymmetryVectorAction g') → (∀ (T : ProtoTile), + FootprintEdges (BandPackingSymmetryTileAction g' T) = (fun e : Finset GaussianInt => + e.image f) '' FootprintEdges T) ) := by + classical + intro g' f hfun T + simpa only [hfun] using (BandPackingSymmetryTilingTransport g').2.2.2.2.2.2.2.2.1 T + +private theorem hiv : + (by + classical + exact + ∀ (g' : BandPackingSymmetry), ∀ (f : GaussianInt ≃ GaussianInt), (∀ (T : ProtoTile), + FootprintVertices (BandPackingSymmetryTileAction g' T) = f '' FootprintVertices T) → + (∀ (T : ProtoTile), FootprintVertices T = f.symm '' FootprintVertices + (BandPackingSymmetryTileAction g' T)) ) := by + classical + intro g' f hv T + rw [hv] + simp [Set.image_image] + +private theorem hie : + (by + classical + exact + ∀ (g' : BandPackingSymmetry), ∀ (f : GaussianInt ≃ GaussianInt), (∀ (T : ProtoTile), + FootprintEdges (BandPackingSymmetryTileAction g' T) = (fun e : Finset GaussianInt => + e.image f) '' FootprintEdges T) → (∀ (T : ProtoTile), FootprintEdges T = (fun e : + Finset GaussianInt => e.image f.symm) '' FootprintEdges + (BandPackingSymmetryTileAction g' T)) ) := by + classical + intro g' f he T + rw [he] + simp [Set.image_image, Finset.image_image] + +private theorem hivR : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (a + : Fin (3 : ℕ)), ∀ (g' : BandPackingSymmetry), + let p : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + let qg := BandPackingSymmetryQuadrupleAction g' p + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let U' := BandPackingSymmetryTileAction g' U + let ii : GaussianInt := ⟨0, 1⟩ + let uR := ii ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + let vR := ii ^ t.val * + (if Even t.val then BandVectors.1 (qg 0) (qg k.succ) + else BandVectors.1 (qg k.succ) (qg 0)) + (BandPackingSymmetryTileAction g' (TileTranslation U uR) = TileTranslation U' vR) → (∀ (f + : GaussianInt ≃ GaussianInt), (∀ (T : ProtoTile), FootprintVertices T = f.symm '' + FootprintVertices (BandPackingSymmetryTileAction g' T)) → (FootprintVertices + (TileTranslation U uR) = f.symm '' FootprintVertices (TileTranslation U' vR))) ) := by + classical + intro r i s U a g' p qg k t U' ii uR vR transR f hiv + rw [← transR] + exact hiv _ + +private theorem hieR : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (a + : Fin (3 : ℕ)), ∀ (g' : BandPackingSymmetry), + let p : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + let qg := BandPackingSymmetryQuadrupleAction g' p + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let U' := BandPackingSymmetryTileAction g' U + let ii : GaussianInt := ⟨0, 1⟩ + let uR := ii ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + let vR := ii ^ t.val * + (if Even t.val then BandVectors.1 (qg 0) (qg k.succ) + else BandVectors.1 (qg k.succ) (qg 0)) + (BandPackingSymmetryTileAction g' (TileTranslation U uR) = TileTranslation U' vR) → (∀ (f + : GaussianInt ≃ GaussianInt), (∀ (T : ProtoTile), FootprintEdges T = (fun e : Finset + GaussianInt => e.image f.symm) '' FootprintEdges (BandPackingSymmetryTileAction g' + T)) → (FootprintEdges (TileTranslation U uR) = (fun e : Finset GaussianInt => e.image + f.symm) '' FootprintEdges (TileTranslation U' vR))) ) := by + classical + intro r i s U a g' p qg k t U' ii uR vR transR f hie + rw [← transR] + exact hie _ + +private theorem hivL : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (a + : Fin (3 : ℕ)), ∀ (g' : BandPackingSymmetry), + let p : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + let qg := BandPackingSymmetryQuadrupleAction g' p + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let U' := BandPackingSymmetryTileAction g' U + let ii : GaussianInt := ⟨0, 1⟩ + let uL := ii ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + let vL := ii ^ t.val * + (if Even t.val then BandVectors.1 (qg k.succ) (qg 0) + else BandVectors.1 (qg 0) (qg k.succ)) + (BandPackingSymmetryTileAction g' (TileTranslation U uL) = TileTranslation U' vL) → (∀ (f + : GaussianInt ≃ GaussianInt), (∀ (T : ProtoTile), FootprintVertices T = f.symm '' + FootprintVertices (BandPackingSymmetryTileAction g' T)) → (FootprintVertices + (TileTranslation U uL) = f.symm '' FootprintVertices (TileTranslation U' vL))) ) := by + classical + intro r i s U a g' p qg k t U' ii uL vL transL f hiv + rw [← transL] + exact hiv _ + +private theorem hieL : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (a + : Fin (3 : ℕ)), ∀ (g' : BandPackingSymmetry), + let p : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + let qg := BandPackingSymmetryQuadrupleAction g' p + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let U' := BandPackingSymmetryTileAction g' U + let ii : GaussianInt := ⟨0, 1⟩ + let uL := ii ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + let vL := ii ^ t.val * + (if Even t.val then BandVectors.1 (qg k.succ) (qg 0) + else BandVectors.1 (qg 0) (qg k.succ)) + (BandPackingSymmetryTileAction g' (TileTranslation U uL) = TileTranslation U' vL) → (∀ (f + : GaussianInt ≃ GaussianInt), (∀ (T : ProtoTile), FootprintEdges T = (fun e : Finset + GaussianInt => e.image f.symm) '' FootprintEdges (BandPackingSymmetryTileAction g' + T)) → (FootprintEdges (TileTranslation U uL) = (fun e : Finset GaussianInt => e.image + f.symm) '' FootprintEdges (TileTranslation U' vL))) ) := by + classical + intro r i s U a g' p qg k t U' ii uL vL transL f hie + rw [← transL] + exact hie _ + +end OrientedEndpointGeometry + +theorem BandOrientedChildParentEndpoints + (r : Fin 4 → CircleCoordinates) (hproper : ProperBandQuadruple r) + (i : Fin 3) (s : Fin 4) (U W Z : ProtoTile) + (hU : BandPrototile (r 0) U) + (hW : BandPrototile (r i.succ) W) + (hZ : BandPrototile + (r ((if Even s.val then i - 1 else i + 1).succ)) Z) + (hUpos : 0 < (r 0).1) (hWpos : 0 < (r i.succ).1) + (hZpos : 0 < (r ((if Even s.val then i - 1 else i + 1).succ)).1) + (hWcent : TileCentroid W - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (r i.succ) (r 0) + + BandVectors.1 (r 0) (r i.succ)))) + (hZcent : TileCentroid Z - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (r 0) (r ((i - 1).succ)) - + BandVectors.1 (r ((i - 1).succ)) (r 0) + else + BandVectors.1 (r ((i + 1).succ)) (r 0) - + BandVectors.1 (r 0) (r ((i + 1).succ))))) : + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + let uL := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + ∃ rightData : ExactTileInterfaceTriple U (TileTranslation U uR) W, + ∃ incomingData : ExactTileInterfaceTriple U (TileTranslation U uL) W, + ∃ adjacentData : ExactTileInterfaceTriple U W Z, + rightData.point ≠ incomingData.point ∧ + adjacentData.point = incomingData.point ∧ + rightData.otherCA = incomingData.point ∧ + incomingData.otherCA = rightData.point ∧ + adjacentData.otherAB = rightData.point := by +-- BODY + classical + obtain ⟨a, g, hregime⟩ := BandRegimeClassification r hproper + obtain ⟨g', hquadg, hdata⟩ := P4055T1PlacementNormalization + r hproper i s U W Z hU hW hZ hUpos hWpos hZpos hWcent hZcent a g + let p : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + let qg := BandPackingSymmetryQuadrupleAction g' p + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + let U' := BandPackingSymmetryTileAction g' U + let W' := BandPackingSymmetryTileAction g' W + let Z' := BandPackingSymmetryTileAction g' Z + let ii : GaussianInt := ⟨0, 1⟩ + change + ProperBandQuadruple qg ∧ + BandPrototile (qg 0) U' ∧ BandPrototile (qg k.succ) W' ∧ + BandPrototile (qg j.succ) Z' ∧ + 0 < (qg 0).1 ∧ 0 < (qg k.succ).1 ∧ 0 < (qg j.succ).1 ∧ + TileCentroid W' - TileCentroid U' = (1 / 2 : Real) • + GaussianRealPoint (ii ^ t.val * + (BandVectors.1 (qg k.succ) (qg 0) + BandVectors.1 (qg 0) (qg k.succ))) ∧ + TileCentroid Z' - TileCentroid U' = (1 / 2 : Real) • + GaussianRealPoint (ii ^ t.val * (if Even t.val then + BandVectors.1 (qg 0) (qg j.succ) - BandVectors.1 (qg j.succ) (qg 0) + else BandVectors.1 (qg j.succ) (qg 0) - BandVectors.1 (qg 0) (qg j.succ))) ∧ + BandPackingSymmetryVectorAction g' + (ii ^ s.val * (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0))) = + ii ^ t.val * (if Even t.val then BandVectors.1 (qg 0) (qg k.succ) + else BandVectors.1 (qg k.succ) (qg 0)) ∧ + BandPackingSymmetryVectorAction g' + (ii ^ s.val * (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ))) = + ii ^ t.val * (if Even t.val then BandVectors.1 (qg k.succ) (qg 0) + else BandVectors.1 (qg 0) (qg k.succ)) at hdata + rcases hdata with ⟨hproperG, hU', hW', hZ', hUpos', hWpos', hZpos', + hWcentNorm, hZcentNorm, hdispR, hdispL⟩ + have hregimeQ := hregime + change Xor + (∃ P, 1 < P.q ∧ + BandPackingSymmetryQuadrupleAction g p = FordRecursiveQuadruple P) + (Xor + (∃ K : DiamondParameter, 1 < K.1 ∧ + BandPackingSymmetryQuadrupleAction g p = DiamondRecursiveQuadruple K) + (Nonempty (BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g p)))) at hregimeQ + rw [← hquadg p] at hregimeQ + have hregimeNormalized : Xor + (∃ P, 1 < P.q ∧ qg = FordRecursiveQuadruple P) + (Xor + (∃ K : DiamondParameter, 1 < K.1 ∧ qg = DiamondRecursiveQuadruple K) + (Nonempty (BandOrderedGeneralConfiguration qg))) := + OrientedEndpointGeometry.hregimeNormalized r a g' hregimeQ + have normalized : + let uR := (⟨0, 1⟩ : GaussianInt) ^ t.val * + (if Even t.val then BandVectors.1 (qg 0) (qg k.succ) + else BandVectors.1 (qg k.succ) (qg 0)) + let uL := (⟨0, 1⟩ : GaussianInt) ^ t.val * + (if Even t.val then BandVectors.1 (qg k.succ) (qg 0) + else BandVectors.1 (qg 0) (qg k.succ)) + ∃ rightData : ExactTileInterfaceTriple U' (TileTranslation U' uR) W', + ∃ incomingData : ExactTileInterfaceTriple U' (TileTranslation U' uL) W', + ∃ adjacentData : ExactTileInterfaceTriple U' W' Z', + rightData.point ≠ incomingData.point ∧ + adjacentData.point = incomingData.point ∧ + rightData.otherCA = incomingData.point ∧ + incomingData.otherCA = rightData.point ∧ + adjacentData.otherAB = rightData.point := OrientedEndpointGeometry.normalized r i s U W + Z a g' hproperG hU' hW' hZ' hUpos' hWpos' hZpos' hWcentNorm hZcentNorm + hregimeNormalized + rcases normalized with ⟨R, I, A, hne, hap, hrca, hica, haab⟩ + let uR := ii ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + let uL := ii ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + let vR := ii ^ t.val * + (if Even t.val then BandVectors.1 (qg 0) (qg k.succ) + else BandVectors.1 (qg k.succ) (qg 0)) + let vL := ii ^ t.val * + (if Even t.val then BandVectors.1 (qg k.succ) (qg 0) + else BandVectors.1 (qg 0) (qg k.succ)) + have transR : BandPackingSymmetryTileAction g' (TileTranslation U uR) = + TileTranslation U' vR := OrientedEndpointGeometry.transR r i s U a g' hdispR + have transL : BandPackingSymmetryTileAction g' (TileTranslation U uL) = + TileTranslation U' vL := OrientedEndpointGeometry.transL r i s U a g' hdispL + obtain ⟨f, hf, _, hi⟩ := P4055T1PackingGridEquivalence g' + have hfun : (f : GaussianInt → GaussianInt) = BandPackingSymmetryVectorAction g' := + funext hf + have hv (T : ProtoTile) : + FootprintVertices (BandPackingSymmetryTileAction g' T) = f '' FootprintVertices T := + OrientedEndpointGeometry.hv g' f hfun T + have he (T : ProtoTile) : + FootprintEdges (BandPackingSymmetryTileAction g' T) = + (fun e : Finset GaussianInt => e.image f) '' FootprintEdges T := + OrientedEndpointGeometry.he g' f hfun T + have hiv (T : ProtoTile) : + FootprintVertices T = f.symm '' FootprintVertices (BandPackingSymmetryTileAction g' T) := + OrientedEndpointGeometry.hiv g' f hv T + have hie (T : ProtoTile) : + FootprintEdges T = (fun e : Finset GaussianInt => e.image f.symm) '' + FootprintEdges (BandPackingSymmetryTileAction g' T) := OrientedEndpointGeometry.hie g' f + he T + have hivR : FootprintVertices (TileTranslation U uR) = + f.symm '' FootprintVertices (TileTranslation U' vR) := OrientedEndpointGeometry.hivR r i s + U a g' transR f hiv + have hieR : FootprintEdges (TileTranslation U uR) = + (fun e : Finset GaussianInt => e.image f.symm) '' FootprintEdges (TileTranslation U' vR) := + OrientedEndpointGeometry.hieR r i s U a g' transR f hie + have hivL : FootprintVertices (TileTranslation U uL) = + f.symm '' FootprintVertices (TileTranslation U' vL) := OrientedEndpointGeometry.hivL r i s + U a g' transL f hiv + have hieL : FootprintEdges (TileTranslation U uL) = + (fun e : Finset GaussianInt => e.image f.symm) '' FootprintEdges (TileTranslation U' vL) := + OrientedEndpointGeometry.hieL r i s U a g' transL f hie + obtain ⟨R₀, hrp, _, _, hrc⟩ := P4055T1ExactTripleImage f.symm f.symm.injective hi + _ _ _ U (TileTranslation U uR) W + (hiv U) hivR (hiv W) (hie U) hieR (hie W) R + obtain ⟨I₀, hip, _, _, hic⟩ := P4055T1ExactTripleImage f.symm f.symm.injective hi + _ _ _ U (TileTranslation U uL) W + (hiv U) hivL (hiv W) (hie U) hieL (hie W) I + obtain ⟨A₀, hpa, hab, _, _⟩ := P4055T1ExactTripleImage f.symm f.symm.injective hi + _ _ _ U W Z + (hiv U) (hiv W) (hiv Z) (hie U) (hie W) (hie Z) A + refine ⟨R₀, I₀, A₀, ?_, ?_, ?_, ?_, ?_⟩ + · rw [hrp, hip] + exact fun h => hne (f.symm.injective h) + · rw [hpa, hip, hap] + · rw [hrc, hip, hrca] + · rw [hic, hrp, hica] + · rw [hab, hrp, haab] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentIncomingEndpoint.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentIncomingEndpoint.lean new file mode 100644 index 0000000000..bb84c8e444 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentIncomingEndpoint.lean @@ -0,0 +1,187 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriplePackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentIncomingEndpoint +public import LeanPool.ApollonianSuperharmonic.OrientedTouchingCovariance +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P4055T1BandQuarterTurn +public import LeanPool.ApollonianSuperharmonic.P4085T1FordIncomingNormalization +public import LeanPool.ApollonianSuperharmonic.P4085T1MinusTouching + +-- [TABLET NODE: BandOrientedChildParentIncomingEndpoint] + +/-! +# BandOrientedChildParentIncomingEndpoint + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOrientedChildParentIncomingEndpoint + (r : Fin 4 → CircleCoordinates) (hproper : ProperBandQuadruple r) + (i : Fin 3) (s : Fin 4) (U W Z : ProtoTile) + (hU : BandPrototile (r 0) U) + (hW : BandPrototile (r i.succ) W) + (hZ : BandPrototile + (r ((if Even s.val then i - 1 else i + 1).succ)) Z) + (hUpos : 0 < (r 0).1) (hWpos : 0 < (r i.succ).1) + (hWcent : TileCentroid W - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (r i.succ) (r 0) + + BandVectors.1 (r 0) (r i.succ)))) + (hZcent : TileCentroid Z - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (r 0) (r ((i - 1).succ)) - + BandVectors.1 (r ((i - 1).succ)) (r 0) + else + BandVectors.1 (r ((i + 1).succ)) (r 0) - + BandVectors.1 (r 0) (r ((i + 1).succ))))) : + let uL := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + ∃ _ : ExactTileInterfaceTriple U (TileTranslation U uL) W, + TouchingTriple U (TileTranslation U uL) W := by +-- BODY + classical + let ii : GaussianInt := ⟨0, 1⟩ + let x := BandVectors.1 (r i.succ) (r 0) + let z := BandVectors.1 (r 0) (r i.succ) + let uL := ii ^ s.val * (if Even s.val then x else z) + change ∃ _ : ExactTileInterfaceTriple U (TileTranslation U uL) W, + TouchingTriple U (TileTranslation U uL) W + have curvature := ProperBandCurvatureStructure r hproper + let j : Fin 3 := if Even s.val then i - 1 else i + 1 + have hjnonneg : 0 ≤ (r j.succ).1 := curvature.2.1 j + by_cases hjpos : 0 < (r j.succ).1 + · obtain ⟨_, incoming, _⟩ := BandOrientedChildParentEndpoints + r hproper i s U W Z hU hW hZ hUpos hWpos hjpos hWcent hZcent + refine ⟨incoming, ?_⟩ + have hlarge : 1 < (r 0).1 := by + by_contra hn + have allzero : ∀ k : Fin 3, (r k.succ).1 = 0 := by + intro k + have := curvature.2.1 k + have := hproper.2 k + omega + exact (by decide : (0 : Fin 3) ≠ 1) + (curvature.2.2 0 1 (allzero 0) (allzero 1)) + have hT2 : ∀ (a : Fin 4) (V : ProtoTile), + BandPrototile (r a) V → QuarterTurnSymmetric V := by + intro a V hV + exact P4055T1BandQuarterTurn _ _ hV + have hcov := OrientedTouchingCovariance r hproper hT2 + (by + intro A B k hA hB hc + exact (BandTileSimultaneousInduction r hproper A hA).2.2.2.2.2.1 + hlarge k B hB hc) + (by + intro A B C k hA hB hC hcB hcC + exact (BandTileSimultaneousInduction r hproper A hA).2.2.2.2.2.2.1 + k B C hB hC hcB hcC) + have qmul (v : GaussianInt) : GaussianQuarterTurn v = ii * v := by + ext <;> simp [ii, GaussianQuarterTurn] + have qiter (n : ℕ) (v : GaussianInt) : + (GaussianQuarterTurn^[n]) v = ii ^ n * v := by + induction n with + | zero => simp + | succ n ih => + rw [Function.iterate_succ_apply', qmul, ih, pow_succ] + ring + have oriented (V : ProtoTile) (t : Fin 4) + (hV : BandPrototile (r i.succ) V) + (hc : TileCentroid V - TileCentroid U = + (1 / 2 : Real) • GaussianRealPoint (ii ^ t.val * (x + z))) : + TouchingTriple U (TileTranslation U (ii ^ t.val * x)) V := by + have hp (a b : GaussianInt) : + GaussianRealPoint (a + b) = GaussianRealPoint a + GaussianRealPoint b := by + ext <;> simp [GaussianRealPoint] + have hc' : TileCentroid V - TileCentroid U = (1 / 2 : Real) • + (GaussianRealPoint ((GaussianQuarterTurn^[t.val]) x) + + GaussianRealPoint ((GaussianQuarterTurn^[t.val]) z)) := by + simpa only [qiter, ← hp, ← mul_add] using hc + simpa only [qiter] using hcov.1 U V i t hU hV hc' + by_cases hs : Even s.val + · simpa only [uL, hs, ite_true] using oriented W s hW hWcent + · let t : Fin 4 := s + 1 + let y := ii ^ t.val * x + have hflip : z = ii * x := + ((VectorRecursionLaws r hproper.1).2.2.2.2 hproper i).1 + have hv : ii ^ s.val * (x + z) = y - GaussianQuarterTurn y := by + rw [qmul, hflip] + fin_cases s <;> dsimp [y, t, ii] <;> ext <;> simp [pow_succ] <;> ring + have hy : uL = y := by + simp only [uL, hs, ite_false, hflip] + fin_cases s <;> dsimp [y, t, ii] <;> ext <;> simp [pow_succ] + have hminus : TileCentroid W - TileCentroid U = + (1 / 2 : Real) • GaussianRealPoint (y - GaussianQuarterTurn y) := by + rw [← hv] + exact hWcent + have hqz : ii ^ t.val * z = GaussianQuarterTurn y := by + rw [qmul, hflip] + dsimp [y] + ring + have hcplus : TileCentroid (TileTranslation W (GaussianQuarterTurn y)) - + TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint (ii ^ t.val * (x + z)) := by + rw [mul_add, hqz] + change TileCentroid (TileTranslation W (GaussianQuarterTurn y)) - + TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (y + GaussianQuarterTurn y) + rw [(TileTranslationFormulas W _).2.2.2.2.1] + have h₁ := congrArg Prod.fst hminus + have h₂ := congrArg Prod.snd hminus + simp? [GaussianRealPoint, GaussianQuarterTurn] at h₁ h₂ ⊢ + apply Prod.ext <;> dsimp <;> linarith + have hp := oriented (TileTranslation W (GaussianQuarterTurn y)) t + (BandPrototileTranslation _ _ _ hW) hcplus + rw [hy] + exact P4085T1MinusTouching U W y (hT2 0 U hU) (hT2 i.succ W hW) hminus hp + · have hjzero : (r j.succ).1 = 0 := by omega + obtain ⟨a, g, P, hP, hnormal, hlabel, hUF, hWF, hUposF, hWposF, hcF, hdF⟩ := + P4085T1FordIncomingNormalization r hproper ⟨j.succ, hjzero⟩ + i s U W hU hW hUpos hWpos hWcent + obtain ⟨dataF, touchingF⟩ := FordOrientedChildParentIncomingEndpoint P hP + (i - a) s (BandPackingSymmetryTileAction g U) + (BandPackingSymmetryTileAction g W) hUF hWF hUposF hWposF hcF + have hmiddle : BandPackingSymmetryTileAction g (TileTranslation U uL) = + TileTranslation (BandPackingSymmetryTileAction g U) + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (FordRecursiveQuadruple P (i - a).succ) (FordRecursiveQuadruple P 0) + else BandVectors.1 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P (i - + a).succ))) := by + rw [(BandPackingSymmetryTilingTransport g).2.2.2.2.2.2.1] + exact congrArg (TileTranslation (BandPackingSymmetryTileAction g U)) hdF + have dataImage : Nonempty (ExactTileInterfaceTriple + (BandPackingSymmetryTileAction g U) + (BandPackingSymmetryTileAction g (TileTranslation U uL)) + (BandPackingSymmetryTileAction g W)) := by + rw [hmiddle] + exact ⟨dataF⟩ + obtain ⟨data⟩ := + (ExactTileInterfaceTriplePackingSymmetryCovariance g U (TileTranslation U uL) W).mpr dataImage + refine ⟨data, ?_⟩ + apply ((BandPackingSymmetryTilingTransport g).2.2.2.2.2.1 U (TileTranslation U uL) W).mpr + rw [hmiddle] + exact touchingF + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean new file mode 100644 index 0000000000..457c1059a8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean @@ -0,0 +1,840 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriplePackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentRightEndpoint +public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandOrientedChildParentRightEndpoint] + +/-! +# BandOrientedChildParentRightEndpoint + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OrientedRightEndpointGeometry + +private theorem hq : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), (ProperBandQuadruple r) → (∀ (a : Fin (3 : ℕ)), ∀ (g0 + : BandPackingSymmetry), ∀ (P : FordFareyParameter), ((r (a + (2 : Fin (3 : + ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g0 ![r (0 : Fin (4 : + ℕ)), r a.succ, r (a + (1 : Fin (3 : ℕ))).succ, r (a + (2 : Fin (3 : ℕ))).succ] = + FordRecursiveQuadruple P) → ( + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ProperBandQuadruple q))) ) := by + classical + intro r hproper a g0 P hzero hford q + fin_cases a + · convert hproper using 1; funext x; fin_cases x <;> rfl + · have rotated := SemiProperQuadruple.rotate hproper.1 + have properRotated : ProperBandQuadruple ![r 0, r 2, r 3, r 1] := by + refine ⟨rotated, ?_⟩ + intro j + fin_cases j + · simpa using hproper.2 (1 : Fin 3) + · simpa using hproper.2 (2 : Fin 3) + · simpa using hproper.2 (0 : Fin 3) + simpa [q] using properRotated + · have rotated := SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate hproper.1) + have properRotated : ProperBandQuadruple ![r 0, r 3, r 1, r 2] := by + refine ⟨rotated, ?_⟩ + intro j + fin_cases j + · simpa using hproper.2 (2 : Fin 3) + · simpa using hproper.2 (0 : Fin 3) + · simpa using hproper.2 (1 : Fin 3) + simpa [q] using properRotated + +private theorem hzeroAction : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (a : Fin (3 : ℕ)), ∀ (g0 : BandPackingSymmetry), ∀ + (P : FordFareyParameter), (BandPackingSymmetryQuadrupleAction g0 ![r (0 : Fin (4 : + ℕ)), r a.succ, r (a + (1 : Fin (3 : ℕ))).succ, r (a + (2 : Fin (3 : ℕ))).succ] = + FordRecursiveQuadruple P) → ( + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g : BandPackingSymmetry), (∀ (p : Fin (4 : ℕ) → CircleCoordinates), + BandPackingSymmetryQuadrupleAction g p = BandPackingSymmetryQuadrupleAction g0 p) → + (BandPackingSymmetryQuadrupleAction g q = FordRecursiveQuadruple P)) ) := by + classical + intro r a g0 P hford q g hquadg + rw [hquadg, hford] + +private theorem hUford : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (U : ProtoTile), ∀ (a : Fin (3 : ℕ)), ∀ (P : + FordFareyParameter), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g : BandPackingSymmetry), (BandPrototile (BandPackingSymmetryCircleAction g (r 0)) + (BandPackingSymmetryTileAction g U)) → ((BandPackingSymmetryQuadrupleAction g q = + FordRecursiveQuadruple P) → (BandPrototile ((FordRecursiveQuadruple P) 0) + (BandPackingSymmetryTileAction g U))) ) := by + classical + intro r U a P q g hU' hzeroAction + have he := congrFun hzeroAction 0 + simpa [q, BandPackingSymmetryQuadrupleAction] using he ▸ hU' + +private theorem hWford : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r i.succ) W) → ((BandPrototile (r + (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → + (((0 : ℤ) < (r i.succ).1) → ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r + i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → + ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : + ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - BandVectors.1 (r (i - (1 : Fin (3 : + ℕ))).succ) (r (0 : Fin (4 : ℕ))) else BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) + (r (0 : Fin (4 : ℕ))) - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : + ℕ))).succ))) → ((0 ≤ (r ((if Even s.val then i - 1 else i + 1).succ)).1) → (((0 : ℤ) + = (r (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : + ℕ))).succ).1) → (∀ (a : Fin (3 : ℕ)), ∀ (g0 : BandPackingSymmetry), ∀ (P : + FordFareyParameter), (BandPackingSymmetryReversesOrientation g0 = false) → (((r (a + + (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g0 ![r + (0 : Fin (4 : ℕ)), r a.succ, r (a + (1 : Fin (3 : ℕ))).succ, r (a + (2 : Fin (3 : + ℕ))).succ] = FordRecursiveQuadruple P) → ( + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + (ProperBandQuadruple q) → (∀ (negative : Bool), (BandPackingSymmetryScopedPhase g0 q + negative) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : + Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 + : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g0 r negative) + → ((∀ (t : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : + ℕ)) = q (2 : Fin (4 : ℕ)) → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → + BandPackingSymmetryScopedPhase g0 t negative) → (∀ (g : BandPackingSymmetry), + (BandPackingSymmetryReversesOrientation g = BandPackingSymmetryReversesOrientation + g0) → ((BandPackingSymmetryScopedPhase g q false) → ((∀ (r : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) + → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : + ℕ)) → BandPackingSymmetryScopedPhase g r false) → ((∀ (t : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) + → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g t + false) → ((BandPrototile (BandPackingSymmetryCircleAction g (r i.succ)) + (BandPackingSymmetryTileAction g W)) → ( + let k : Fin 3 := i - a + (BandPackingSymmetryQuadrupleAction g q = FordRecursiveQuadruple P) → (BandPrototile + ((FordRecursiveQuadruple P) k.succ) (BandPackingSymmetryTileAction g + W))))))))))))))))))))) ) := by + classical + intro r i s U W Z hW hZ hWpos hWcent hZcent nonnegative zero a g0 P horient hzero hford q hq + negative hphase hphase1 hphase2 g horientg hfalse hfalse1 hfalse2 hW' k hzeroAction + have he := congrFun hzeroAction k.succ + have source : + BandPackingSymmetryQuadrupleAction g q k.succ = + BandPackingSymmetryCircleAction g (r i.succ) := by + fin_cases a <;> fin_cases i <;> + simp [k, q, BandPackingSymmetryQuadrupleAction, horientg, horient] + rw [source] at he + exact he ▸ hW' + +private theorem phaseForward : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r i.succ) W) → ((BandPrototile (r + (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → + (((0 : ℤ) < (r i.succ).1) → ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r + i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → + ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : + ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - BandVectors.1 (r (i - (1 : Fin (3 : + ℕ))).succ) (r (0 : Fin (4 : ℕ))) else BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) + (r (0 : Fin (4 : ℕ))) - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : + ℕ))).succ))) → ((0 ≤ (r ((if Even s.val then i - 1 else i + 1).succ)).1) → (((0 : ℤ) + = (r (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : + ℕ))).succ).1) → (∀ (a : Fin (3 : ℕ)), ∀ (g0 : BandPackingSymmetry), ∀ (P : + FordFareyParameter), (BandPackingSymmetryReversesOrientation g0 = false) → (((r (a + + (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g0 ![r + (0 : Fin (4 : ℕ)), r a.succ, r (a + (1 : Fin (3 : ℕ))).succ, r (a + (2 : Fin (3 : + ℕ))).succ] = FordRecursiveQuadruple P) → ( + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + (ProperBandQuadruple q) → (∀ (negative : Bool), (BandPackingSymmetryScopedPhase g0 q + negative) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : + Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 + : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g0 r negative) + → ((∀ (t : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : + ℕ)) = q (2 : Fin (4 : ℕ)) → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → + BandPackingSymmetryScopedPhase g0 t negative) → (∀ (g : BandPackingSymmetry), + (BandPackingSymmetryReversesOrientation g = BandPackingSymmetryReversesOrientation + g0) → ((BandPackingSymmetryScopedPhase g q false) → ((∀ (r : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) + → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : + ℕ)) → BandPackingSymmetryScopedPhase g r false) → ((∀ (t : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) + → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g t + false) → ((BandPrototile (BandPackingSymmetryCircleAction g (r i.succ)) + (BandPackingSymmetryTileAction g W)) → ( + let k : Fin 3 := i - a + (BandPackingSymmetryQuadrupleAction g q = FordRecursiveQuadruple P) → ((BandPrototile + ((FordRecursiveQuadruple P) k.succ) (BandPackingSymmetryTileAction g W)) → + (BandVectors.1 ((FordRecursiveQuadruple P) k.succ) ((FordRecursiveQuadruple P) 0) = + BandPackingSymmetryVectorAction g (BandVectors.1 (r i.succ) (r + 0))))))))))))))))))))))) ) := by + classical + intro r i s U W Z hW hZ hWpos hWcent hZcent nonnegative zero a g0 P horient hzero hford q hq + negative hphase hphase1 hphase2 g horientg hfalse hfalse1 hfalse2 hW' k hzeroAction hWford + have phase := (show BandPackingSymmetryScopedPhase g q false from hfalse) + simp only [BandPackingSymmetryScopedPhase] at phase + rw [hzeroAction] at phase + fin_cases a <;> fin_cases i <;> + simpa [BandPackingSymmetryScopedPhase, horientg, horient, hzeroAction, q, k] + using (phase k).1 + +private theorem phaseBackward : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r i.succ) W) → ((BandPrototile (r + (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → + (((0 : ℤ) < (r i.succ).1) → ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r + i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → + ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : + ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - BandVectors.1 (r (i - (1 : Fin (3 : + ℕ))).succ) (r (0 : Fin (4 : ℕ))) else BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) + (r (0 : Fin (4 : ℕ))) - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : + ℕ))).succ))) → ((0 ≤ (r ((if Even s.val then i - 1 else i + 1).succ)).1) → (((0 : ℤ) + = (r (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : + ℕ))).succ).1) → (∀ (a : Fin (3 : ℕ)), ∀ (g0 : BandPackingSymmetry), ∀ (P : + FordFareyParameter), (BandPackingSymmetryReversesOrientation g0 = false) → (((r (a + + (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g0 ![r + (0 : Fin (4 : ℕ)), r a.succ, r (a + (1 : Fin (3 : ℕ))).succ, r (a + (2 : Fin (3 : + ℕ))).succ] = FordRecursiveQuadruple P) → ( + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + (ProperBandQuadruple q) → (∀ (negative : Bool), (BandPackingSymmetryScopedPhase g0 q + negative) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : + Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 + : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g0 r negative) + → ((∀ (t : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : + ℕ)) = q (2 : Fin (4 : ℕ)) → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → + BandPackingSymmetryScopedPhase g0 t negative) → (∀ (g : BandPackingSymmetry), + (BandPackingSymmetryReversesOrientation g = BandPackingSymmetryReversesOrientation + g0) → ((BandPackingSymmetryScopedPhase g q false) → ((∀ (r : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) + → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : + ℕ)) → BandPackingSymmetryScopedPhase g r false) → ((∀ (t : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) + → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g t + false) → ((BandPrototile (BandPackingSymmetryCircleAction g (r i.succ)) + (BandPackingSymmetryTileAction g W)) → ( + let k : Fin 3 := i - a + (BandPackingSymmetryQuadrupleAction g q = FordRecursiveQuadruple P) → ((BandPrototile + ((FordRecursiveQuadruple P) k.succ) (BandPackingSymmetryTileAction g W)) → + ((BandVectors.1 ((FordRecursiveQuadruple P) k.succ) ((FordRecursiveQuadruple P) 0) = + BandPackingSymmetryVectorAction g (BandVectors.1 (r i.succ) (r 0))) → (BandVectors.1 + ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) k.succ) = + BandPackingSymmetryVectorAction g (BandVectors.1 (r 0) (r + i.succ)))))))))))))))))))))))) ) := by + classical + intro r i s U W Z hW hZ hWpos hWcent hZcent nonnegative zero a g0 P horient hzero hford q hq + negative hphase hphase1 hphase2 g horientg hfalse hfalse1 hfalse2 hW' k hzeroAction hWford + phaseForward + have phase := (show BandPackingSymmetryScopedPhase g q false from hfalse) + simp only [BandPackingSymmetryScopedPhase] at phase + rw [hzeroAction] at phase + fin_cases a <;> fin_cases i <;> + simpa [BandPackingSymmetryScopedPhase, horientg, horient, hzeroAction, q, k] + using (phase k).2.1 + +private theorem centroidAction : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), (TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : + Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → (∀ (g0 : + BandPackingSymmetry), (∃ (w : GaussianInt), g0 = BandPackingSymmetry.shift w ∨ g0 = + (BandPackingSymmetry.shift w).comp BandPackingSymmetry.negate) → (∀ (g : + BandPackingSymmetry), (g = g0 ∨ g = (BandPackingSymmetry.negate.comp + BandPackingSymmetry.negate).comp g0) → (TileCentroid (BandPackingSymmetryTileAction g + W) - TileCentroid (BandPackingSymmetryTileAction g U) = (1 / 2 : Real) • + GaussianRealPoint (BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val + * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))))))) ) := by + classical + intro r i s U W hWcent g0 hword g hglift + rcases hglift with lift | lift + · rw [lift] + rcases hword with ⟨w, word | word⟩ + · rw [word] + simpa [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] using hWcent + · rw [word] + change TileCentroid (TileQuarterTurn W) - + TileCentroid (TileQuarterTurn U) = _ + rw [(TileQuarterTurnFormulas W).2.2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.2.1] + have first := congrArg Prod.fst hWcent + have second := congrArg Prod.snd hWcent + simp [BandPackingSymmetryVectorAction, GaussianRealPoint, + GaussianQuarterTurn] at first second ⊢ + constructor <;> linarith + · rw [lift] + rcases hword with ⟨w, word | word⟩ + · rw [word] + change TileCentroid (TileQuarterTurn (TileQuarterTurn W)) - + TileCentroid (TileQuarterTurn (TileQuarterTurn U)) = _ + rw [(TileQuarterTurnFormulas (TileQuarterTurn W)).2.2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn U)).2.2.2.2.1, + (TileQuarterTurnFormulas W).2.2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.2.1] + have first := congrArg Prod.fst hWcent + have second := congrArg Prod.snd hWcent + simp [BandPackingSymmetryVectorAction, GaussianRealPoint, + GaussianQuarterTurn] at first second ⊢ + constructor <;> linarith + · rw [word] + change TileCentroid (TileQuarterTurn (TileQuarterTurn + (TileQuarterTurn W))) - + TileCentroid (TileQuarterTurn (TileQuarterTurn + (TileQuarterTurn U))) = _ + rw [(TileQuarterTurnFormulas (TileQuarterTurn + (TileQuarterTurn W))).2.2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn + (TileQuarterTurn U))).2.2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn W)).2.2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn U)).2.2.2.2.1, + (TileQuarterTurnFormulas W).2.2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.2.1] + have first := congrArg Prod.fst hWcent + have second := congrArg Prod.snd hWcent + simp [BandPackingSymmetryVectorAction, GaussianRealPoint, + GaussianQuarterTurn] at first second ⊢ + constructor <;> linarith + +private theorem actionAdd : + (by + classical + exact + ∀ (g0 : BandPackingSymmetry), (∃ (w : GaussianInt), g0 = BandPackingSymmetry.shift w ∨ g0 + = (BandPackingSymmetry.shift w).comp BandPackingSymmetry.negate) → (∀ (g : + BandPackingSymmetry), (g = g0 ∨ g = (BandPackingSymmetry.negate.comp + BandPackingSymmetry.negate).comp g0) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), + BandPackingSymmetryVectorAction g (x + y) = BandPackingSymmetryVectorAction g x + + BandPackingSymmetryVectorAction g y)) ) := by + classical + intro g0 hword g hglift x y + rcases hglift with lift | lift + · rw [lift] + rcases hword with ⟨w, word | word⟩ <;> rw [word] + · simp [BandPackingSymmetryVectorAction] + · simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn, + add_comm] + · rw [lift] + rcases hword with ⟨w, word | word⟩ <;> rw [word] + · simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn, + add_comm] + · simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] + simp [add_comm] + +private theorem actionCommute : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if Even (↑s : ℕ) then i - (1 : + Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → ((TileCentroid W - TileCentroid U + = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * + (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r i.succ)))) → ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 + (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - BandVectors.1 (r (i - (1 : + Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) else BandVectors.1 (r (i + (1 : Fin (3 : + ℕ))).succ) (r (0 : Fin (4 : ℕ))) - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : + Fin (3 : ℕ))).succ))) → ((0 ≤ (r ((if Even s.val then i - 1 else i + 1).succ)).1) → + (((0 : ℤ) = (r (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : + ℕ))).succ).1) → (∀ (g0 : BandPackingSymmetry), (∃ (w : GaussianInt), g0 = + BandPackingSymmetry.shift w ∨ g0 = (BandPackingSymmetry.shift w).comp + BandPackingSymmetry.negate) → (∀ (g : BandPackingSymmetry), (g = g0 ∨ g = + (BandPackingSymmetry.negate.comp BandPackingSymmetry.negate).comp g0) → + ((TileCentroid (BandPackingSymmetryTileAction g W) - TileCentroid + (BandPackingSymmetryTileAction g U) = (1 / 2 : Real) • GaussianRealPoint + (BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val * (BandVectors.1 + (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))))) → (∀ (x : GaussianInt), + BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val * x) = (⟨0, 1⟩ : + GaussianInt) ^ s.val * BandPackingSymmetryVectorAction g x)))))))) ) := by + classical + intro r i s U W Z hZ hWcent hZcent nonnegative zero g0 hword g hglift centroidAction x + rcases hglift with lift | lift + · rw [lift] + rcases hword with ⟨w, word | word⟩ <;> rw [word] + · simp [BandPackingSymmetryVectorAction] + · fin_cases s <;> + apply Zsqrtd.ext <;> + simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] <;> + ring + · rw [lift] + rcases hword with ⟨w, word | word⟩ <;> rw [word] + · fin_cases s <;> + apply Zsqrtd.ext <;> + simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] <;> + ring + · fin_cases s <;> + apply Zsqrtd.ext <;> + simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] <;> + ring + +private theorem vectorIdentity : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin (3 : ℕ)), ∀ + (P : FordFareyParameter), ∀ (g : BandPackingSymmetry), + let k : Fin 3 := i - a + (BandVectors.1 ((FordRecursiveQuadruple P) k.succ) ((FordRecursiveQuadruple P) 0) = + BandPackingSymmetryVectorAction g (BandVectors.1 (r i.succ) (r 0))) → ((BandVectors.1 + ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) k.succ) = + BandPackingSymmetryVectorAction g (BandVectors.1 (r 0) (r i.succ))) → ((∀ (x : + GaussianInt), ∀ (y : GaussianInt), BandPackingSymmetryVectorAction g (x + y) = + BandPackingSymmetryVectorAction g x + BandPackingSymmetryVectorAction g y) → ((∀ (x : + GaussianInt), BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val * x) + = (⟨0, 1⟩ : GaussianInt) ^ s.val * BandPackingSymmetryVectorAction g x) → + (BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val * (BandVectors.1 + (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))) = (⟨0, 1⟩ : GaussianInt) ^ s.val + * (BandVectors.1 ((FordRecursiveQuadruple P) k.succ) ((FordRecursiveQuadruple P) 0) + + BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) k.succ)))))) + ) := by + classical + intro r i s a P g k phaseForward phaseBackward actionAdd actionCommute + rw [actionCommute, actionAdd, phaseForward, phaseBackward] + +private theorem transformedCentroid : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), ∀ (a : Fin (3 : ℕ)), ∀ (P : FordFareyParameter), ∀ (g : + BandPackingSymmetry), + let k : Fin 3 := i - a + (TileCentroid (BandPackingSymmetryTileAction g W) - TileCentroid + (BandPackingSymmetryTileAction g U) = (1 / 2 : Real) • GaussianRealPoint + (BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val * (BandVectors.1 + (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))))) → + ((BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val * (BandVectors.1 + (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))) = (⟨0, 1⟩ : GaussianInt) ^ s.val + * (BandVectors.1 ((FordRecursiveQuadruple P) k.succ) ((FordRecursiveQuadruple P) 0) + + BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) k.succ))) → + (TileCentroid (BandPackingSymmetryTileAction g W) - TileCentroid + (BandPackingSymmetryTileAction g U) = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : + GaussianInt) ^ s.val * (BandVectors.1 ((FordRecursiveQuadruple P) k.succ) + ((FordRecursiveQuadruple P) 0) + BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) k.succ))))) ) := by + classical + intro r i s U W a P g k centroidAction vectorIdentity + rw [centroidAction, vectorIdentity] + +private theorem hUposFord : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ((0 : ℤ) < (r (0 : Fin (4 : ℕ))).1) → (∀ (a : Fin (3 : + ℕ)), ∀ (g0 : BandPackingSymmetry), ∀ (P : FordFareyParameter), + (BandPackingSymmetryReversesOrientation g0 = false) → ( + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g : BandPackingSymmetry), (BandPackingSymmetryReversesOrientation g = + BandPackingSymmetryReversesOrientation g0) → (((∀ (C : CircleCoordinates), + (BandPackingSymmetryCircleAction g C).1 = C.1) ∧ (∀ (C : CircleCoordinates), ∀ (T : + ProtoTile), BandPrototile C T ↔ BandPrototile (BandPackingSymmetryCircleAction g C) + (BandPackingSymmetryTileAction g T)) ∧ ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (T + : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ProperBandQuadruple q → + BandPrototile (q (0 : Fin (4 : ℕ))) T → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence q T i s (S i s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : + Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → + let sigma := fun (i : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true + then -i else i; ∃ (negative : Bool) (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool) (S' + : Fin (3 : ℕ) → Bool → ProtoTile), BandPackingSymmetryScopedPhase g q negative ∧ (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) + = (sigma i, s ^^ negative)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : + ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × + Bool) (i, s)).2 = BandPackingSymmetryTileAction g (S i s)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction g q) + (BandPackingSymmetryTileAction g T) i s (S' i s)) ∧ ∀ (x : LatticeCell), x ∈ + (BandPackingSymmetryTileAction g T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S' i + s).cells) → ((BandPackingSymmetryQuadrupleAction g q = FordRecursiveQuadruple P) → (0 + < ((FordRecursiveQuadruple P) 0).1))))) ) := by + classical + intro r hUpos a g0 P horient q g horientg tileCovariance hzeroAction + have he := congrArg (fun x => (x 0).1) hzeroAction + have he' : ((FordRecursiveQuadruple P) 0).1 = (r 0).1 := by + calc + ((FordRecursiveQuadruple P) 0).1 = + (BandPackingSymmetryQuadrupleAction g q 0).1 := he.symm + _ = (BandPackingSymmetryCircleAction g (r 0)).1 := by + simp [q, BandPackingSymmetryQuadrupleAction, horientg, horient] + _ = (r 0).1 := tileCovariance.1 _ + rw [he'] + exact hUpos + +private theorem hWposFord : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r i.succ) W) → ((BandPrototile (r + (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → + (((0 : ℤ) < (r i.succ).1) → ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r + i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → + ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : + ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - BandVectors.1 (r (i - (1 : Fin (3 : + ℕ))).succ) (r (0 : Fin (4 : ℕ))) else BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) + (r (0 : Fin (4 : ℕ))) - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : + ℕ))).succ))) → ((0 ≤ (r ((if Even s.val then i - 1 else i + 1).succ)).1) → (((0 : ℤ) + = (r (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : + ℕ))).succ).1) → (∀ (a : Fin (3 : ℕ)), ∀ (g0 : BandPackingSymmetry), ∀ (P : + FordFareyParameter), (BandPackingSymmetryReversesOrientation g0 = false) → (((r (a + + (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g0 ![r + (0 : Fin (4 : ℕ)), r a.succ, r (a + (1 : Fin (3 : ℕ))).succ, r (a + (2 : Fin (3 : + ℕ))).succ] = FordRecursiveQuadruple P) → ( + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + (ProperBandQuadruple q) → (∀ (negative : Bool), (BandPackingSymmetryScopedPhase g0 q + negative) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : + Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 + : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g0 r negative) + → ((∀ (t : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : + ℕ)) = q (2 : Fin (4 : ℕ)) → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → + BandPackingSymmetryScopedPhase g0 t negative) → (∀ (g : BandPackingSymmetry), + (BandPackingSymmetryReversesOrientation g = BandPackingSymmetryReversesOrientation + g0) → ((BandPackingSymmetryScopedPhase g q false) → ((∀ (r : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) + → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : + ℕ)) → BandPackingSymmetryScopedPhase g r false) → ((∀ (t : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) + → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g t + false) → (((∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction g C).1 = C.1) + ∧ (∀ (C : CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T ↔ BandPrototile + (BandPackingSymmetryCircleAction g C) (BandPackingSymmetryTileAction g T)) ∧ ∀ (q : + Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ProperBandQuadruple q → BandPrototile (q (0 : Fin (4 : ℕ))) T → (∀ (i : + Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : + LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → + let sigma := fun (i : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true + then -i else i; ∃ (negative : Bool) (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool) (S' + : Fin (3 : ℕ) → Bool → ProtoTile), BandPackingSymmetryScopedPhase g q negative ∧ (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) + = (sigma i, s ^^ negative)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : + ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × + Bool) (i, s)).2 = BandPackingSymmetryTileAction g (S i s)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction g q) + (BandPackingSymmetryTileAction g T) i s (S' i s)) ∧ ∀ (x : LatticeCell), x ∈ + (BandPackingSymmetryTileAction g T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S' i + s).cells) → ((BandPrototile (BandPackingSymmetryCircleAction g (r i.succ)) + (BandPackingSymmetryTileAction g W)) → ( + let k : Fin 3 := i - a + (BandPackingSymmetryQuadrupleAction g q = FordRecursiveQuadruple P) → ((BandPrototile + ((FordRecursiveQuadruple P) k.succ) (BandPackingSymmetryTileAction g W)) → + ((BandVectors.1 ((FordRecursiveQuadruple P) k.succ) ((FordRecursiveQuadruple P) 0) = + BandPackingSymmetryVectorAction g (BandVectors.1 (r i.succ) (r 0))) → ((BandVectors.1 + ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) k.succ) = + BandPackingSymmetryVectorAction g (BandVectors.1 (r 0) (r i.succ))) → ((TileCentroid + (BandPackingSymmetryTileAction g W) - TileCentroid (BandPackingSymmetryTileAction g + U) = (1 / 2 : Real) • GaussianRealPoint (BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : + GaussianInt) ^ s.val * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r + i.succ))))) → ((BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))) = (⟨0, 1⟩ : + GaussianInt) ^ s.val * (BandVectors.1 ((FordRecursiveQuadruple P) k.succ) + ((FordRecursiveQuadruple P) 0) + BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) k.succ))) → ((TileCentroid (BandPackingSymmetryTileAction + g W) - TileCentroid (BandPackingSymmetryTileAction g U) = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * (BandVectors.1 + ((FordRecursiveQuadruple P) k.succ) ((FordRecursiveQuadruple P) 0) + BandVectors.1 + ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) k.succ)))) → (0 < + ((FordRecursiveQuadruple P) k.succ).1))))))))))))))))))))))))))) ) := by + classical + intro r i s U W Z hW hZ hWpos hWcent hZcent nonnegative zero a g0 P horient hzero hford q hq + negative hphase hphase1 hphase2 g horientg hfalse hfalse1 hfalse2 tileCovariance hW' k + hzeroAction hWford phaseForward phaseBackward centroidAction vectorIdentity + transformedCentroid + have he := congrArg (fun x => (x k.succ).1) hzeroAction + have source : + BandPackingSymmetryQuadrupleAction g q k.succ = + BandPackingSymmetryCircleAction g (r i.succ) := by + fin_cases a <;> fin_cases i <;> + simp [k, q, BandPackingSymmetryQuadrupleAction, horientg, horient] + have he' : ((FordRecursiveQuadruple P) k.succ).1 = + (r i.succ).1 := by + calc + ((FordRecursiveQuadruple P) k.succ).1 = + (BandPackingSymmetryQuadrupleAction g q k.succ).1 := + (congrArg (fun x => (x k.succ).1) hzeroAction).symm + _ = (BandPackingSymmetryCircleAction g (r i.succ)).1 := + congrArg Prod.fst source + _ = (r i.succ).1 := tileCovariance.1 _ + rw [he'] + exact hWpos + +private theorem middleVector : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin (3 : ℕ)), ∀ + (P : FordFareyParameter), ∀ (g : BandPackingSymmetry), + let k : Fin 3 := i - a + (BandVectors.1 ((FordRecursiveQuadruple P) k.succ) ((FordRecursiveQuadruple P) 0) = + BandPackingSymmetryVectorAction g (BandVectors.1 (r i.succ) (r 0))) → ((BandVectors.1 + ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) k.succ) = + BandPackingSymmetryVectorAction g (BandVectors.1 (r 0) (r i.succ))) → ((∀ (x : + GaussianInt), BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val * x) + = (⟨0, 1⟩ : GaussianInt) ^ s.val * BandPackingSymmetryVectorAction g x) → + (BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val * (if Even s.val + then BandVectors.1 (r 0) (r i.succ) else BandVectors.1 (r i.succ) (r 0))) = (⟨0, 1⟩ : + GaussianInt) ^ s.val * (if Even s.val then BandVectors.1 ((FordRecursiveQuadruple P) + 0) ((FordRecursiveQuadruple P) k.succ) else BandVectors.1 ((FordRecursiveQuadruple P) + k.succ) ((FordRecursiveQuadruple P) 0))))) ) := by + classical + intro r i s a P g k phaseForward phaseBackward actionCommute + by_cases parity : Even s.val + · simp? [parity] + rw [actionCommute, phaseBackward] + · simp? [parity] + rw [actionCommute, phaseForward] + +private theorem transformedTriple : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), ∀ (g : BandPackingSymmetry), ∀ [Nonempty + (ExactTileInterfaceTriple (BandPackingSymmetryTileAction g U) + (BandPackingSymmetryTileAction g (TileTranslation U ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r i.succ) else BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ)))))) + (BandPackingSymmetryTileAction g W))], Nonempty (ExactTileInterfaceTriple + (BandPackingSymmetryTileAction g U) (BandPackingSymmetryTileAction g (TileTranslation + U ((⟨0, 1⟩ : GaussianInt) ^ s.val * (if Even s.val then BandVectors.1 (r 0) (r + i.succ) else BandVectors.1 (r i.succ) (r 0))))) (BandPackingSymmetryTileAction g W)) + ) := by + classical + intro r i s U W g fordResult + exact fordResult + +end OrientedRightEndpointGeometry + +theorem BandOrientedChildParentRightEndpoint + (r : Fin 4 → CircleCoordinates) (hproper : ProperBandQuadruple r) + (i : Fin 3) (s : Fin 4) (U W Z : ProtoTile) + (hU : BandPrototile (r 0) U) + (hW : BandPrototile (r i.succ) W) + (hZ : BandPrototile + (r ((if Even s.val then i - 1 else i + 1).succ)) Z) + (hUpos : 0 < (r 0).1) (hWpos : 0 < (r i.succ).1) + (hWcent : TileCentroid W - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (r i.succ) (r 0) + + BandVectors.1 (r 0) (r i.succ)))) + (hZcent : TileCentroid Z - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (r 0) (r ((i - 1).succ)) - + BandVectors.1 (r ((i - 1).succ)) (r 0) + else + BandVectors.1 (r ((i + 1).succ)) (r 0) - + BandVectors.1 (r 0) (r ((i + 1).succ))))) : + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + Nonempty (ExactTileInterfaceTriple U (TileTranslation U uR) W) := by +-- BODY + dsimp + have curvature := ProperBandCurvatureStructure r hproper + have nonnegative : 0 ≤ (r ((if Even s.val then i - 1 else i + 1).succ)).1 := by + exact curvature.2.1 (if Even s.val then i - 1 else i + 1) + rcases lt_or_eq_of_le nonnegative with positive | zero + · have result := BandOrientedChildParentEndpoints r hproper i s U W Z hU hW hZ + hUpos hWpos positive hWcent hZcent + exact ⟨result.choose⟩ + · obtain ⟨a, g0, P, hP, horient, hword, hzero, hford⟩ := + FordRegimeConverse r hproper + ⟨(if Even s.val then i - 1 else i + 1).succ, zero.symm⟩ + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + have hq : ProperBandQuadruple q := OrientedRightEndpointGeometry.hq r hproper a g0 P hzero hford + have hprojective := BandPackingSymmetryProjectiveVectorCovariance g0 q hq + dsimp at hprojective + rcases hprojective with ⟨negative, hphase, hphase1, hphase2, hcircle, + horient', hquad, hvec, g, hglift, hcircle', horientg, hquadg, hfalse, + hfalse1, hfalse2⟩ + have tileCovariance := BandPackingSymmetryCovariance g + have hU' : BandPrototile + (BandPackingSymmetryCircleAction g (r 0)) + (BandPackingSymmetryTileAction g U) := + (tileCovariance.2.1 _ _).mp hU + have hW' : BandPrototile + (BandPackingSymmetryCircleAction g (r i.succ)) + (BandPackingSymmetryTileAction g W) := + (tileCovariance.2.1 _ _).mp hW + let k : Fin 3 := i - a + have hzeroAction : BandPackingSymmetryQuadrupleAction g q = + FordRecursiveQuadruple P := OrientedRightEndpointGeometry.hzeroAction r a g0 P hford g + hquadg + have hUford : BandPrototile + ((FordRecursiveQuadruple P) 0) + (BandPackingSymmetryTileAction g U) := OrientedRightEndpointGeometry.hUford r U a P g hU' + hzeroAction + have hWford : BandPrototile + ((FordRecursiveQuadruple P) k.succ) + (BandPackingSymmetryTileAction g W) := OrientedRightEndpointGeometry.hWford r i s U W Z + hW hZ hWpos hWcent hZcent nonnegative zero a g0 P horient hzero hford hq negative + hphase hphase1 hphase2 g horientg hfalse hfalse1 hfalse2 hW' hzeroAction + have phaseForward : + BandVectors.1 ((FordRecursiveQuadruple P) k.succ) + ((FordRecursiveQuadruple P) 0) = + BandPackingSymmetryVectorAction g + (BandVectors.1 (r i.succ) (r 0)) := OrientedRightEndpointGeometry.phaseForward r i s + U W Z hW hZ hWpos hWcent hZcent nonnegative zero a g0 P horient hzero hford hq + negative hphase hphase1 hphase2 g horientg hfalse hfalse1 hfalse2 hW' hzeroAction + hWford + have phaseBackward : + BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) k.succ) = + BandPackingSymmetryVectorAction g + (BandVectors.1 (r 0) (r i.succ)) := OrientedRightEndpointGeometry.phaseBackward r i s + U W Z hW hZ hWpos hWcent hZcent nonnegative zero a g0 P horient hzero hford hq + negative hphase hphase1 hphase2 g horientg hfalse hfalse1 hfalse2 hW' hzeroAction + hWford phaseForward + have centroidAction : + TileCentroid (BandPackingSymmetryTileAction g W) - + TileCentroid (BandPackingSymmetryTileAction g U) = + (1 / 2 : Real) • GaussianRealPoint + (BandPackingSymmetryVectorAction g + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (r i.succ) (r 0) + + BandVectors.1 (r 0) (r i.succ)))) := + OrientedRightEndpointGeometry.centroidAction r i s U W hWcent g0 hword g + hglift + have actionAdd (x y : GaussianInt) : + BandPackingSymmetryVectorAction g (x + y) = + BandPackingSymmetryVectorAction g x + + BandPackingSymmetryVectorAction g y := OrientedRightEndpointGeometry.actionAdd g0 + hword g hglift x y + have actionCommute (x : GaussianInt) : + BandPackingSymmetryVectorAction g + ((⟨0, 1⟩ : GaussianInt) ^ s.val * x) = + (⟨0, 1⟩ : GaussianInt) ^ s.val * + BandPackingSymmetryVectorAction g x := OrientedRightEndpointGeometry.actionCommute r + i s U W Z hZ hWcent hZcent nonnegative zero g0 hword g hglift centroidAction x + have vectorIdentity : + BandPackingSymmetryVectorAction g + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (r i.succ) (r 0) + + BandVectors.1 (r 0) (r i.succ))) = + (⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 ((FordRecursiveQuadruple P) k.succ) + ((FordRecursiveQuadruple P) 0) + + BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) k.succ)) := + OrientedRightEndpointGeometry.vectorIdentity r i s a P g phaseForward + phaseBackward actionAdd actionCommute + have transformedCentroid : + TileCentroid (BandPackingSymmetryTileAction g W) - + TileCentroid (BandPackingSymmetryTileAction g U) = + (1 / 2 : Real) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 ((FordRecursiveQuadruple P) k.succ) + ((FordRecursiveQuadruple P) 0) + + BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) k.succ))) := + OrientedRightEndpointGeometry.transformedCentroid r i s U W a P g + centroidAction vectorIdentity + have hUposFord : 0 < ((FordRecursiveQuadruple P) 0).1 := + OrientedRightEndpointGeometry.hUposFord r hUpos a g0 P horient g horientg tileCovariance + hzeroAction + have hWposFord : 0 < ((FordRecursiveQuadruple P) k.succ).1 := + OrientedRightEndpointGeometry.hWposFord r i s U W Z hW hZ hWpos hWcent hZcent nonnegative + zero a g0 P horient hzero hford hq negative hphase hphase1 hphase2 g horientg hfalse + hfalse1 hfalse2 tileCovariance hW' hzeroAction hWford phaseForward phaseBackward + centroidAction vectorIdentity transformedCentroid + have fordResult := FordOrientedChildParentRightEndpoint P hP k s + (BandPackingSymmetryTileAction g U) + (BandPackingSymmetryTileAction g W) hUford hWford hUposFord hWposFord + transformedCentroid + dsimp at fordResult + have middleVector : + BandPackingSymmetryVectorAction g + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0))) = + (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) k.succ) + else + BandVectors.1 ((FordRecursiveQuadruple P) k.succ) + ((FordRecursiveQuadruple P) 0)) := OrientedRightEndpointGeometry.middleVector r i + s a P g phaseForward phaseBackward actionCommute + have transport := (BandPackingSymmetryTilingTransport g).2.2.2.2.2.2.1 + U + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0))) + rw [← middleVector, ← transport] at fordResult + have transformedTriple : Nonempty (ExactTileInterfaceTriple + (BandPackingSymmetryTileAction g U) + (BandPackingSymmetryTileAction g + (TileTranslation U + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0))))) + (BandPackingSymmetryTileAction g W)) := @OrientedRightEndpointGeometry.transformedTriple r + i s U W g fordResult + exact (ExactTileInterfaceTriplePackingSymmetryCovariance g U + (TileTranslation U + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)))) W).mpr transformedTriple + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedGapRefinement.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedGapRefinement.lean new file mode 100644 index 0000000000..7f7321d09e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedGapRefinement.lean @@ -0,0 +1,222 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingExterior +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple + +-- [TABLET NODE: BandOrientedGapRefinement] + +/-! +# BandOrientedGapRefinement + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +An oriented band-gap refinement certificate consists of closed sets +$G(a,\sigma,w)$ indexed by a Gaussian integer $a$, a side +$\sigma\in\{-,+\}$, and a finite word $w\in\{0,1,2\}^*$, together with a +positive band circle $K(a,\sigma,w)$ and a proper ordered Descartes +presentation $q(a,\sigma,w)$, satisfying the following conditions. + +For $a=x+iy$, the two root sets are the closures +$$ +\begin{split} +G(a,-,\varnothing)=\{(X,Y):&,2x\le X\le2x+1, 2y\le Y\le2y+2,\\ + &(X-1-2x)^2+(Y-2y)^2\ge1,\\ + &(X-1-2x)^2+(Y-2y-2)^2\ge1\}, +\end{split} +$$ +and the analogous set $G(a,+,\varnothing)$ with +$2x+1\le X\le2x+2$. These root gaps cover the exterior of all open band +disks. Their ordered boundary lists contain, respectively, the oriented +line $(0,-1)$ or $(0,1)$ and the two unit coordinates +$(1,1+2a)$ and $(1,1+2a+2i)$ in the displayed cyclic order. + +For every index $\iota$, $q(\iota)$ is proper, its child is $K(\iota)$, +and the presentations at $\iota0,\iota1,\iota2$ are exactly the successor +presentations obtained after zero, one, or two cyclic parent rotations. +Moreover +$$ +G(\iota)=\overline{B(K(\iota))}\cup +G(\iota0)\cup G(\iota1)\cup G(\iota2), +$$ +each residual gap is contained in $G(\iota)$, and the interiors of the +three residual gaps are pairwise disjoint. The whole boundary of the +inserted disk is covered by the three residual closures. Quantitatively, +$$ + \operatorname{diam}G(\iota)\le6\sqrt{R_{K(\iota)}}. +$$ + +Along every infinite branch both the Euclidean diameter of the closed gaps +and the radius of their inserted circles tend to zero. + +The remaining data are local incidence data. For each positive band +circle $C$, there is a finite set $S_C$ of gap indices such that the sets +$$ + A_\iota=G(\iota)\cap\partial C + \qquad(\iota\in S_C) +$$ +are nonempty closed connected arcs, every $q(\iota)$ retains $C$ in one +of its three parent slots, and $\partial C=\bigcup_{\iota\in S_C}A_\iota$. +If $q(\iota)$ retains $C$ and $p\in A_\iota$, let $K(\iota)$ be the +circle inserted in $G(\iota)$. Exactly two of the three child +presentations retain $C$; call their digit set $E\subset\{0,1,2\}$. Thus +$|E|=2$, and the retained parent criterion is exact: +$$ + b\in E\quad\Longleftrightarrow\quad + C\text{ occurs in a parent slot of }q(\iota b). +$$ +Their closed connected boundary arcs split the old arc exactly, +$$ + G(\iota)\cap\partial C + =\bigcup_{b\in E}\bigl(G(\iota b)\cap\partial C\bigr). +$$ +Both child arcs contain the contact point $t$ of $C$ with $K(\iota)$, +and at least one contains $p$. The data record +$K(\iota)\ne C$, $R_{K(\iota)} (subdivision ι).1 + circle := circle + presentation := presentation + root_cover := ?_ + root_left := ?_ + root_right := ?_ + proper := proper + presented_circle := fun _ => rfl + root_oriented_lines := ?_ + successor_slots := ?_ + child_contained := ?_ + exact_three_residual := ?_ + inserted_boundary_covered := boundary_cover + residual_interiors_disjoint := ?_ + diameter_bound := ?_ + branch_shrinks := ?_ + initial_incident_arcs := ?_ + incident_arc_step := ?_ }⟩ + · simpa only [gap, presentation, P4828T1Evaluate, List.foldl_nil] using + P4984T1RootGaps.2.2 + · simpa only [gap, presentation, P4828T1Evaluate, List.foldl_nil] using + P4984T1RootGaps.1 + · simpa only [gap, presentation, P4828T1Evaluate, List.foldl_nil] using + P4984T1RootGaps.2.1 + · intro a side + cases side <;> simp [presentation, P4828T1Evaluate, P4828T1Root] + · intro ι b + refine ⟨P4828T1Rotate (presentation ι) b, ?_, ?_⟩ + · fin_cases b + · exact Or.inl ⟨rfl, by funext k; fin_cases k <;> rfl⟩ + · exact Or.inr (Or.inl ⟨rfl, by funext k; fin_cases k <;> rfl⟩) + · exact Or.inr (Or.inr ⟨rfl, by funext k; fin_cases k <;> rfl⟩) + · exact next ι b + · intro ι b + simpa only [gap, next] using (subdivision ι).2.1 b + · intro ι + simpa only [gap, next, circle, BandCircleEuclideanData] using + (subdivision ι).2.2.1 + · intro ι b c hbc + simpa only [gap, next] using (subdivision ι).2.2.2.2 b c hbc + · intro ι + exact P4984T1ContactDiameter _ _ (proper ι) + (history ι).1.2.1 (history ι).1.2.2 + · intro a side branch + exact (P4984T1BranchDecay a side branch).2.2 + · intro C + by_cases hc : C.1.1.1 = 1 + · obtain ⟨a, ha⟩ := CurvatureOneBandCircleClassification C hc + refine ⟨{(a, false, []), (a, true, []), + (a - ⟨0, 1⟩, false, []), (a - ⟨0, 1⟩, true, [])}, ?_⟩ + simpa [gap, presentation, BandCircleEuclideanData, ha] using + P4984T1UnitIncidence a + · rcases BandGenealogy C with hc' | ⟨r, hr, hchild, hless, _⟩ + · exact (hc hc').elim + have hrp : ProperBandQuadruple r := ⟨hr, by simpa [hchild] using hless⟩ + obtain ⟨a, side, word, rot, hform⟩ := P4828T1HistoryNormalForm r hrp + let ι : GaussianInt × Bool × List (Fin 3) := (a, side, word) + have hzero : presentation ι 0 = C.1.1 := by + have heq := congrFun hform 0 + exact heq.symm.trans hchild + have hcircle : circle ι = C := Subtype.ext (Subtype.ext hzero) + let child (b : Fin 3) : GaussianInt × Bool × List (Fin 3) := + (a, side, word ++ [b]) + refine ⟨Finset.univ.image child, ?_, ?_⟩ + · apply Set.Subset.antisymm + · intro p hp + have hp' := boundary_cover ι (by simpa only [hcircle] using hp) + obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hp' + apply Set.mem_iUnion.mpr + refine ⟨child b, Set.mem_iUnion.mpr ⟨Finset.mem_image.mpr + ⟨b, Finset.mem_univ b, rfl⟩, hb, hp⟩⟩ + · intro p hp + obtain ⟨η, hη⟩ := Set.mem_iUnion.mp hp + obtain ⟨_, hmem⟩ := Set.mem_iUnion.mp hη + exact hmem.2 + · intro η hη + obtain ⟨b, _, rfl⟩ := Finset.mem_image.mp hη + have hparent : presentation (child b) (Fin.succ 0) = C.1.1 := by + change presentation (ι.1, ι.2.1, ι.2.2 ++ [b]) (Fin.succ 0) = C.1.1 + rw [next] + exact hzero + have hpos : 0 < (presentation (child b) (Fin.succ 0)).1 := by + rw [hparent]; exact C.2 + have harc := P4984T1IncidentArcs _ _ (proper (child b)) + (history (child b)).1.2.1 (history (child b)).1.2.2 0 hpos + refine ⟨?_, ?_, ?_, 0, hparent⟩ + · simpa only [gap, BandCircleEuclideanData, hparent] using harc.1 + · simpa only [gap, BandCircleEuclideanData, hparent] using harc.2.1 + · simpa only [gap, BandCircleEuclideanData, hparent] using harc.2.2.1 + · intro C ι p hparent hp + obtain ⟨j, hj⟩ := hparent + have hpos : 0 < (presentation ι j.succ).1 := by rw [hj]; exact C.2 + have harc := P4984T1IncidentArcs _ _ (proper ι) + (history ι).1.2.1 (history ι).1.2.2 j hpos + obtain ⟨_, _, _, hkeep, t, hsplit, harcs, htC, htK, hcent⟩ := harc + let keep := Finset.univ.erase j + have hsplit' : + gap ι ∩ Metric.sphere (BandCircleEuclideanData C).center + (BandCircleEuclideanData C).radius = + ⋃ b ∈ keep, gap (ι.1, ι.2.1, ι.2.2 ++ [b]) ∩ + Metric.sphere (BandCircleEuclideanData C).center + (BandCircleEuclideanData C).radius := by + simpa only [gap, next, keep, BandCircleEuclideanData, hj] using hsplit + obtain ⟨b, hb⟩ := Set.mem_iUnion.mp (hsplit' ▸ hp) + obtain ⟨hbkeep, hbp⟩ := Set.mem_iUnion.mp hb + have hsmall : (BandCircleEuclideanData (circle ι)).radius < + (BandCircleEuclideanData C).radius := by + change 1 / ((presentation ι 0).1 : Real) < 1 / (C.1.1.1 : Real) + apply one_div_lt_one_div_of_lt + · exact_mod_cast C.2 + · have hh := (proper ι).2 j + rw [hj] at hh + exact_mod_cast hh + refine ⟨t, keep, b, ?_, hbkeep, ?_, hsplit', ?_, hbp, ?_, hsmall, + ?_, ?_, ?_⟩ + · simp [keep] + · intro c + simpa only [keep, Finset.mem_erase, Finset.mem_univ, and_true, + next, hj] using hkeep c + · simpa only [gap, next, keep, BandCircleEuclideanData, hj] using harcs + · intro heq + rw [heq] at hsmall + exact (lt_irrefl _ hsmall) + · simpa only [BandCircleEuclideanData, hj] using htC + · exact htK + · simpa only [BandCircleEuclideanData, circle, hj] using hcent + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean b/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean new file mode 100644 index 0000000000..094cf47838 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean @@ -0,0 +1,1259 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.CellSupportedFootprintVertices +public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk + +-- [TABLET NODE: BandOriginalOccurrenceIntersectionClassification] + +/-! +# BandOriginalOccurrenceIntersectionClassification + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OriginalIntersectionGeometry + +private theorem hOA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + O.cells ⊆ (P 0 true).cells ) := by + classical + intro q cfg C₀ T cert P O + change cert.O.cells ⊆ (cert.P 0 true).cells + rw [cert.precursor_eq] + intro x hx + exact (cert.plus_union x).2 ⟨0, false, hx⟩ + +private theorem hOB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + O.cells ⊆ (P 0 false).cells ) := by + classical + intro q cfg C₀ T cert P O + change cert.O.cells ⊆ (cert.P 0 false).cells + rw [cert.precursor_cells] + intro x hx + exact (cert.minus_union x).2 ⟨0, true, hx⟩ + +private theorem hmodified : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ∀ (a : PeriodicSubtileIndex), cert.modified.tile a = + ModifiedSubtileOccurrenceInterpretation P O u v a ) := by + classical + intro q cfg C₀ T cert P O u v a + exact cert.modified_tile a + +private theorem hnonempty : + (by + classical + exact + ∀ (X : ProtoTile), (LatticeTile X) → (X.cells.Nonempty) ) := by + classical + intro X hX + unfold LatticeTile TopologicalDisk TileRealization at hX + rcases hX with ⟨e⟩ + have hp : (0 : Real × Real) ∈ + (Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) := by simp + have hm := (e ⟨(0 : Real × Real), hp⟩).property + simp only [Set.mem_iUnion] at hm + obtain ⟨x, hx⟩ := hm + exact ⟨x, by simpa [TileRealization] using hx.1⟩ + +private theorem hmodA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (w : GaussianInt), TileTranslation + (TileCellComplement A B) w = TileCellComplement (TileTranslation A w) + (TileTranslation B w)) → (∀ (m : Int), ∀ (n : Int), + ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩ = TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) ) := by + classical + intro q cfg C₀ T cert P O u v htranslate_complement m n + change TileTranslation (TileCellComplement (P 0 true) O) + ((m : GaussianInt) * u + (n : GaussianInt) * v) = _ + rw [htranslate_complement] + rfl + +private theorem hmodother : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ∀ (a : PeriodicSubtileIndex), (a.label ≠ .A) → (ModifiedSubtileOccurrenceInterpretation P + O u v a = SubtileOccurrenceInterpretation P u v a) ) := by + classical + intro q cfg C₀ T cert P O u v a ha + cases a with + | mk label first second => + cases label <;> simp_all [ModifiedSubtileOccurrenceInterpretation, + SubtileOccurrenceInterpretation] + +private theorem hcell_inclusion : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (w : GaussianInt), (TileTranslation X w).cells = X.cells.image + (GaussianTranslation w)) → (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells ⊆ Y.cells) + → (∀ (w : GaussianInt), (TileTranslation X w).cells ⊆ (TileTranslation Y w).cells)) ) + := by + classical + intro htranscells X Y hXY w + rw [htranscells, htranscells] + intro x hx + obtain ⟨z, hz, rfl⟩ := Finset.mem_image.1 hx + exact Finset.mem_image.2 ⟨z, hXY hz, rfl⟩ + +private theorem hisolated : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ∀ (m : Int), ∀ (n : Int), ∀ x ∈ CellSupportedFootprintVertices (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v)), ∀ a : GaussianInt, x ∈ FootprintVertices + (⟨{a}, a⟩ : ProtoTile) → a ∈ (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells + ∨ a ∈ (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells ) := by + classical + intro q cfg C₀ T cert P O u v m n x hx a hxa + by_cases hnon : (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)).cells.Nonempty + · have hxraw : x ∈ FootprintVertices + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)) := by + simpa [CellSupportedFootprintVertices, FootprintVertices, hnon] using hx + exact cert.precursor_isolated m n x hxraw a hxa + · rcases hx with ⟨z, hz, hshape⟩ + exact False.elim (hnon ⟨z, hz⟩) + +private theorem hdel_edge : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (O.cells ⊆ (P 0 true).cells) → ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells ⊆ + Y.cells) → (∀ (w : GaussianInt), (TileTranslation X w).cells ⊆ (TileTranslation Y + w).cells)) → ((∀ (m : Int), ∀ (n : Int), ∀ x ∈ CellSupportedFootprintVertices + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)), ∀ a : + GaussianInt, x ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) → a ∈ + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells ∨ a ∈ + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) → (∀ (m : Int), ∀ (n : + Int), ∀ (Y : ProtoTile), (Disjoint Y.cells + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells) → ((Disjoint Y.cells + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) → (FootprintEdges + (TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))) ∩ + FootprintEdges Y = FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, m, + n⟩) ∩ FootprintEdges Y))))) ) := by + classical + intro q cfg C₀ T cert P O u v hOA hcell_inclusion hisolated m n Y hYA hYB + have h := FootprintDeletionRetention + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)) Y + (by + exact hcell_inclusion O (P 0 true) hOA _) (hisolated m n) hYA hYB + exact h.2.1 + +private theorem htranslated_nonempty : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (w : GaussianInt), (TileTranslation X w).cells = X.cells.image + (GaussianTranslation w)) → (∀ (X : ProtoTile), (X.cells.Nonempty) → (∀ (w : + GaussianInt), (TileTranslation X w).cells.Nonempty)) ) := by + classical + intro htranscells X hX w + rw [htranscells] + obtain ⟨x, hx⟩ := hX + exact ⟨GaussianTranslation w x, Finset.mem_image.2 ⟨x, hx, rfl⟩⟩ + +private theorem hdel_vertex : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (O.cells ⊆ (P 0 true).cells) → ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells ⊆ + Y.cells) → (∀ (w : GaussianInt), (TileTranslation X w).cells ⊆ (TileTranslation Y + w).cells)) → ((∀ (m : Int), ∀ (n : Int), ∀ x ∈ CellSupportedFootprintVertices + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)), ∀ a : + GaussianInt, x ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) → a ∈ + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells ∨ a ∈ + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) → (∀ (m : Int), ∀ (n : + Int), ∀ (Y : ProtoTile), (Disjoint Y.cells + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells) → ((Disjoint Y.cells + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) → (((TileTranslation O ((m + : GaussianInt) * u + (n : GaussianInt) * v)).cells = ∅ ∨ + ((TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v))).cells.Nonempty ∧ + Y.cells.Nonempty)) → (FootprintVertices (TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) ∩ FootprintVertices Y = + FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ + FootprintVertices Y)))))) ) := by + classical + intro q cfg C₀ T cert P O u v hOA hcell_inclusion hisolated m n Y hYA hYB hsupport + have h := FootprintDeletionRetention + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)) Y + (by + exact hcell_inclusion O (P 0 true) hOA _) (hisolated m n) hYA hYB + exact h.2.2 hsupport + +private theorem hparent_nonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let u := cert.u + let v := cert.v + (∀ (X : ProtoTile), (LatticeTile X) → (X.cells.Nonempty)) → ((∀ (X : ProtoTile), + (X.cells.Nonempty) → (∀ (w : GaussianInt), (TileTranslation X w).cells.Nonempty)) → + (∀ (a : PeriodicSubtileIndex), (SubtileOccurrenceInterpretation P u v + a).cells.Nonempty)) ) := by + classical + intro q cfg C₀ T cert P u v hnonempty htranslated_nonempty a + cases a with + | mk label first second => + cases label with + | A => + simpa [SubtileOccurrenceInterpretation] using + htranslated_nonempty _ (hnonempty (P 0 true) (cert.parent_lattice 0 true)) _ + | B => + simpa [SubtileOccurrenceInterpretation] using + htranslated_nonempty _ (hnonempty (P 0 false) (cert.parent_lattice 0 false)) _ + | C => + simpa [SubtileOccurrenceInterpretation] using + htranslated_nonempty _ (hnonempty (P 1 true) (cert.parent_lattice 1 true)) _ + | D => + simpa [SubtileOccurrenceInterpretation] using + htranslated_nonempty _ (hnonempty (P 1 false) (cert.parent_lattice 1 false)) _ + | E => + simpa [SubtileOccurrenceInterpretation] using + htranslated_nonempty _ (hnonempty (P 2 true) (cert.parent_lattice 2 true)) _ + | F => + simpa [SubtileOccurrenceInterpretation] using + htranslated_nonempty _ (hnonempty (P 2 false) (cert.parent_lattice 2 false)) _ + +private theorem hcomplement_nonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (X : ProtoTile), (LatticeTile X) → (X.cells.Nonempty)) → ((∀ (A : ProtoTile), ∀ (B : + ProtoTile), ∀ (w : GaussianInt), TileTranslation (TileCellComplement A B) w = + TileCellComplement (TileTranslation A w) (TileTranslation B w)) → ((∀ (X : + ProtoTile), (X.cells.Nonempty) → (∀ (w : GaussianInt), (TileTranslation X + w).cells.Nonempty)) → (∀ (m : Int), ∀ (n : Int), (TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))).cells.Nonempty))) ) := by + classical + intro q cfg C₀ T cert P O u v hnonempty htranslate_complement htranslated_nonempty m n + have ht := htranslated_nonempty (TileCellComplement (P 0 true) O) + (hnonempty _ cert.precursor_complement_lattice.1) + ((m : GaussianInt) * u + (n : GaussianInt) * v) + rw [htranslate_complement] at ht + simpa [SubtileOccurrenceInterpretation] using ht + +private theorem hsupport_for : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (m : Int), ∀ (n : Int), (TileCellComplement (SubtileOccurrenceInterpretation P u v + ⟨.A, m, n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v))).cells.Nonempty) → (∀ (m : Int), ∀ (n : Int), ∀ (Y : ProtoTile), + (Y.cells.Nonempty) → ((TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v)).cells = ∅ ∨ ((TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A, m, + n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v))).cells.Nonempty ∧ Y.cells.Nonempty))) ) := by + classical + intro q cfg C₀ T cert P O u v hcomplement_nonempty m n Y hY + by_cases ho : O.cells = ∅ + · left + exact (TileTranslationFormulas O + ((m : GaussianInt) * u + (n : GaussianInt) * v)).2.2.1.mpr ho + · exact Or.inr ⟨hcomplement_nonempty m n, hY⟩ + +private theorem hAedge : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → ((¬ ((a.label = .A + ∧ b.label = .B ∨ a.label = .B ∧ b.label = .A) ∧ a.first = b.first ∧ a.second = + b.second)) → (Disjoint (SubtileOccurrenceInterpretation P u v a).cells + (SubtileOccurrenceInterpretation P u v b).cells))) → ((∀ (m : Int), ∀ (n : Int), + ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩ = TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) → ((∀ (a : PeriodicSubtileIndex), + (a.label ≠ .A) → (ModifiedSubtileOccurrenceInterpretation P O u v a = + SubtileOccurrenceInterpretation P u v a)) → ((∀ (m : Int), ∀ (n : Int), ∀ (Y : + ProtoTile), (Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.A, m, + n⟩).cells) → ((Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.B, m, + n⟩).cells) → (FootprintEdges (TileCellComplement (SubtileOccurrenceInterpretation P u + v ⟨.A, m, n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))) ∩ + FootprintEdges Y = FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) + ∩ FootprintEdges Y))) → (∀ (m : Int), ∀ (n : Int), ∀ (b : PeriodicSubtileIndex), + (b.label ≠ .A) → ((¬ (b.label = .B ∧ b.first = m ∧ b.second = n)) → (FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b))))))) ) := by + classical + intro q cfg C₀ T cert P O u v hpaircells hmodA hmodother hdel_edge m n b hbA hbpair + have hneA : (⟨.A, m, n⟩ : PeriodicSubtileIndex) ≠ b := by + intro he + have := congrArg PeriodicSubtileIndex.label he + exact hbA (by simpa using this.symm) + have hneB : (⟨.B, m, n⟩ : PeriodicSubtileIndex) ≠ b := by + intro he + have hl := congrArg PeriodicSubtileIndex.label he + have hf := congrArg PeriodicSubtileIndex.first he + have hs := congrArg PeriodicSubtileIndex.second he + exact hbpair ⟨by simpa using hl.symm, by simpa using hf.symm, by simpa using hs.symm⟩ + have hfirst := hdel_edge m n + (SubtileOccurrenceInterpretation P u v b) + (hpaircells _ _ hneA.symm (by + intro hp + rcases hp with (⟨ha, hbb⟩ | ⟨ha, hbb⟩) <;> simp_all)) + (hpaircells _ _ hneB.symm (by + intro hp + rcases hp with (⟨ha, hbb⟩ | ⟨ha, hbb⟩) <;> simp_all)) + rw [hmodA m n, hmodother b hbA] + exact hfirst + +private theorem hAvertex : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → ((¬ ((a.label = .A + ∧ b.label = .B ∨ a.label = .B ∧ b.label = .A) ∧ a.first = b.first ∧ a.second = + b.second)) → (Disjoint (SubtileOccurrenceInterpretation P u v a).cells + (SubtileOccurrenceInterpretation P u v b).cells))) → ((∀ (m : Int), ∀ (n : Int), + ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩ = TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) → ((∀ (a : PeriodicSubtileIndex), + (a.label ≠ .A) → (ModifiedSubtileOccurrenceInterpretation P O u v a = + SubtileOccurrenceInterpretation P u v a)) → ((∀ (m : Int), ∀ (n : Int), ∀ (Y : + ProtoTile), (Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.A, m, + n⟩).cells) → ((Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.B, m, + n⟩).cells) → (((TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v)).cells = ∅ ∨ ((TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A, m, + n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v))).cells.Nonempty ∧ Y.cells.Nonempty)) → (FootprintVertices (TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) ∩ FootprintVertices Y = FootprintVertices + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ FootprintVertices Y)))) → ((∀ (a + : PeriodicSubtileIndex), (SubtileOccurrenceInterpretation P u v a).cells.Nonempty) → + ((∀ (m : Int), ∀ (n : Int), ∀ (Y : ProtoTile), (Y.cells.Nonempty) → ((TileTranslation + O ((m : GaussianInt) * u + (n : GaussianInt) * v)).cells = ∅ ∨ ((TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))).cells.Nonempty ∧ Y.cells.Nonempty))) → (∀ + (m : Int), ∀ (n : Int), ∀ (b : PeriodicSubtileIndex), (b.label ≠ .A) → ((¬ (b.label = + .B ∧ b.first = m ∧ b.second = n)) → (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))))))))) ) := by + classical + intro q cfg C₀ T cert P O u v hpaircells hmodA hmodother hdel_vertex hparent_nonempty + hsupport_for m n b hbA hbpair + have hneA : (⟨.A, m, n⟩ : PeriodicSubtileIndex) ≠ b := by + intro he + exact hbA (by simpa using (congrArg PeriodicSubtileIndex.label he).symm) + have hneB : (⟨.B, m, n⟩ : PeriodicSubtileIndex) ≠ b := by + intro he + have hl := congrArg PeriodicSubtileIndex.label he + have hf := congrArg PeriodicSubtileIndex.first he + have hs := congrArg PeriodicSubtileIndex.second he + exact hbpair ⟨by simpa using hl.symm, by simpa using hf.symm, by simpa using hs.symm⟩ + have hfirst := hdel_vertex m n + (SubtileOccurrenceInterpretation P u v b) + (hpaircells _ _ hneA.symm (by + intro hp + rcases hp with (⟨ha, hbb⟩ | ⟨ha, hbb⟩) <;> simp_all)) + (hpaircells _ _ hneB.symm (by + intro hp + rcases hp with (⟨ha, hbb⟩ | ⟨ha, hbb⟩) <;> simp_all)) + (hsupport_for m n _ (hparent_nonempty b)) + rw [hmodA m n, hmodother b hbA] + exact hfirst + +private theorem hAAedge : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → ((¬ ((a.label = .A + ∧ b.label = .B ∨ a.label = .B ∧ b.label = .A) ∧ a.first = b.first ∧ a.second = + b.second)) → (Disjoint (SubtileOccurrenceInterpretation P u v a).cells + (SubtileOccurrenceInterpretation P u v b).cells))) → ((∀ (m : Int), ∀ (n : Int), + ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩ = TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) → ((∀ (m : Int), ∀ (n : Int), ∀ (Y : + ProtoTile), (Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.A, m, + n⟩).cells) → ((Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.B, m, + n⟩).cells) → (FootprintEdges (TileCellComplement (SubtileOccurrenceInterpretation P u + v ⟨.A, m, n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))) ∩ + FootprintEdges Y = FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) + ∩ FootprintEdges Y))) → (∀ (m : Int), ∀ (n : Int), ∀ (p : Int), ∀ (r : Int), ((m, n) + ≠ (p, r)) → (FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, + n⟩) ∩ FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, p, r⟩) = + FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩))))) ) := by + classical + intro q cfg C₀ T cert P O u v hpaircells hmodA hdel_edge m n p r hne + have hmp : (⟨.A, m, n⟩ : PeriodicSubtileIndex) ≠ ⟨.A, p, r⟩ := by + intro he + apply hne + exact Prod.ext (by simpa using congrArg PeriodicSubtileIndex.first he) + (by simpa using congrArg PeriodicSubtileIndex.second he) + have hfirst := hdel_edge m n + (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩) + (hpaircells _ _ hmp.symm (by simp)) + (hpaircells ⟨.A, p, r⟩ ⟨.B, m, n⟩ (by simp) (by + intro hp + rcases hp with ⟨hl, hf, hs⟩ + simp at hl + apply hne + exact Prod.ext (by simpa using hf.symm) (by simpa using hs.symm))) + rw [← hmodA m n] at hfirst + have hsecond := hdel_edge p r + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) + (by + rw [hmodA m n] + apply (hpaircells ⟨.A, p, r⟩ ⟨.A, m, n⟩ hmp.symm (by simp)).symm.mono + · intro x hx + exact Finset.mem_sdiff.mp hx |>.1 + · intro x hx + exact hx) + (by + rw [hmodA m n] + apply (hpaircells ⟨.B, p, r⟩ ⟨.A, m, n⟩ (by simp) (by + intro hp + rcases hp with ⟨hl, hf, hs⟩ + simp at hl + apply hne + exact Prod.ext (by simpa using hf.symm) (by simpa using hs.symm))).symm.mono + · intro x hx + exact Finset.mem_sdiff.mp hx |>.1 + · intro x hx + exact hx) + rw [← hmodA p r] at hsecond + calc + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, p, r⟩) = + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, p, r⟩) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) := by rw + [Set.inter_comm] + _ = FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) := hsecond + _ = FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩) := by rw + [Set.inter_comm] + _ = FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩) := hfirst + +private theorem hAAvertex : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → ((¬ ((a.label = .A + ∧ b.label = .B ∨ a.label = .B ∧ b.label = .A) ∧ a.first = b.first ∧ a.second = + b.second)) → (Disjoint (SubtileOccurrenceInterpretation P u v a).cells + (SubtileOccurrenceInterpretation P u v b).cells))) → ((∀ (m : Int), ∀ (n : Int), + ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩ = TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) → ((∀ (m : Int), ∀ (n : Int), ∀ (Y : + ProtoTile), (Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.A, m, + n⟩).cells) → ((Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.B, m, + n⟩).cells) → (((TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v)).cells = ∅ ∨ ((TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A, m, + n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v))).cells.Nonempty ∧ Y.cells.Nonempty)) → (FootprintVertices (TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) ∩ FootprintVertices Y = FootprintVertices + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ FootprintVertices Y)))) → ((∀ (a + : PeriodicSubtileIndex), (SubtileOccurrenceInterpretation P u v a).cells.Nonempty) → + ((∀ (m : Int), ∀ (n : Int), (TileCellComplement (SubtileOccurrenceInterpretation P u + v ⟨.A, m, n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v))).cells.Nonempty) → ((∀ (m : Int), ∀ (n : Int), ∀ (Y : ProtoTile), + (Y.cells.Nonempty) → ((TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v)).cells = ∅ ∨ ((TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A, m, + n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v))).cells.Nonempty ∧ Y.cells.Nonempty))) → (∀ (m : Int), ∀ (n : Int), ∀ (p : Int), ∀ + (r : Int), ((m, n) ≠ (p, r)) → (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, p, r⟩) = FootprintVertices + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩)))))))) ) := by + classical + intro q cfg C₀ T cert P O u v hpaircells hmodA hdel_vertex hparent_nonempty + hcomplement_nonempty hsupport_for m n p r hne + have hmp : (⟨.A, m, n⟩ : PeriodicSubtileIndex) ≠ ⟨.A, p, r⟩ := by + intro he + apply hne + exact Prod.ext (by simpa using congrArg PeriodicSubtileIndex.first he) + (by simpa using congrArg PeriodicSubtileIndex.second he) + have hfirst := hdel_vertex m n + (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩) + (hpaircells _ _ hmp.symm (by simp)) + (hpaircells ⟨.A, p, r⟩ ⟨.B, m, n⟩ (by simp) (by + intro hp + rcases hp with ⟨hl, hf, hs⟩ + simp at hl + apply hne + exact Prod.ext (by simpa using hf.symm) (by simpa using hs.symm))) + (hsupport_for m n _ (hparent_nonempty ⟨.A, p, r⟩)) + rw [← hmodA m n] at hfirst + have hsecond := hdel_vertex p r + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) + (by + rw [hmodA m n] + apply (hpaircells ⟨.A, p, r⟩ ⟨.A, m, n⟩ hmp.symm (by simp)).symm.mono + · intro x hx + exact Finset.mem_sdiff.mp hx |>.1 + · intro x hx + exact hx) + (by + rw [hmodA m n] + apply (hpaircells ⟨.B, p, r⟩ ⟨.A, m, n⟩ (by simp) (by + intro hp + rcases hp with ⟨hl, hf, hs⟩ + simp at hl + apply hne + exact Prod.ext (by simpa using hf.symm) (by simpa using hs.symm))).symm.mono + · intro x hx + exact Finset.mem_sdiff.mp hx |>.1 + · intro x hx + exact hx) + (hsupport_for p r _ (by simpa [hmodA m n] using hcomplement_nonempty m n)) + rw [← hmodA p r] at hsecond + calc + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, p, r⟩) = + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, p, r⟩) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) := by rw + [Set.inter_comm] + _ = FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) := hsecond + _ = FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ + FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩) := by rw + [Set.inter_comm] + _ = FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ + FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩) := hfirst + +private theorem hmod_edge_allowed : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ((∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges + (cert.modified.tile a) ∩ FootprintEdges (cert.modified.tile b)).Nonempty ↔ + cert.modified.plane.adjacent a b) ∧ ((FootprintEdges (cert.modified.tile a) ∩ + FootprintEdges (cert.modified.tile b)).Nonempty → SimpleGridPath + (CommonFootprintEdgeVertices (cert.modified.tile a) (cert.modified.tile b)) + (FootprintEdges (cert.modified.tile a) ∩ FootprintEdges (cert.modified.tile b)) ∧ + FootprintVertices (cert.modified.tile a) ∩ FootprintVertices (cert.modified.tile b) = + CommonFootprintEdgeVertices (cert.modified.tile a) (cert.modified.tile b)) ∧ + (¬(FootprintEdges (cert.modified.tile a) ∩ FootprintEdges (cert.modified.tile + b)).Nonempty → FootprintVertices (cert.modified.tile a) ∩ FootprintVertices + (cert.modified.tile b) = ∅ ∨ (FootprintVertices (cert.modified.tile a) ∩ + FootprintVertices (cert.modified.tile b)).Subsingleton)) ∧ + PeriodicTileAdjacentContactRegularity cert.modified) → ((∀ (a : + PeriodicSubtileIndex), cert.modified.tile a = ModifiedSubtileOccurrenceInterpretation + P O u v a) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), + cert.modified.plane.adjacent a b ↔ AllowedSubtileIncidence a b) → (∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → ((FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty → + AllowedSubtileIncidence a b)))) ) := by + classical + intro q cfg C₀ T cert P O u v hclass hmodified hmodadj a b hab he + have hc := hclass.1 a b (by + intro heq + apply hab + exact heq) + apply hmodadj a b |>.mp + exact hc.1.mp (by simpa [hmodified a, hmodified b] using he) + +private theorem hmod_vertex_alt : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ((∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges + (cert.modified.tile a) ∩ FootprintEdges (cert.modified.tile b)).Nonempty ↔ + cert.modified.plane.adjacent a b) ∧ ((FootprintEdges (cert.modified.tile a) ∩ + FootprintEdges (cert.modified.tile b)).Nonempty → SimpleGridPath + (CommonFootprintEdgeVertices (cert.modified.tile a) (cert.modified.tile b)) + (FootprintEdges (cert.modified.tile a) ∩ FootprintEdges (cert.modified.tile b)) ∧ + FootprintVertices (cert.modified.tile a) ∩ FootprintVertices (cert.modified.tile b) = + CommonFootprintEdgeVertices (cert.modified.tile a) (cert.modified.tile b)) ∧ + (¬(FootprintEdges (cert.modified.tile a) ∩ FootprintEdges (cert.modified.tile + b)).Nonempty → FootprintVertices (cert.modified.tile a) ∩ FootprintVertices + (cert.modified.tile b) = ∅ ∨ (FootprintVertices (cert.modified.tile a) ∩ + FootprintVertices (cert.modified.tile b)).Subsingleton)) ∧ + PeriodicTileAdjacentContactRegularity cert.modified) → ((∀ (a : + PeriodicSubtileIndex), cert.modified.tile a = ModifiedSubtileOccurrenceInterpretation + P O u v a) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), + cert.modified.plane.adjacent a b ↔ AllowedSubtileIncidence a b) → (∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → ((¬ + AllowedSubtileIncidence a b) → (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = ∅ ∨ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b)).Subsingleton))))) ) := by + classical + intro q cfg C₀ T cert P O u v hclass hmodified hmodadj a b hab hna + have hc := hclass.1 a b hab + have hne : ¬ (FootprintEdges (cert.modified.tile a) ∩ + FootprintEdges (cert.modified.tile b)).Nonempty := by + intro he + apply hna + exact hmodadj a b |>.mp (hc.1.mp he) + have hv := hc.2.2 hne + simpa [hmodified a, hmodified b] using hv + +private theorem hAraw : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (m : Int), ∀ (n : Int), ∀ (b : PeriodicSubtileIndex), (b.label ≠ .A) → ((¬ (b.label = + .B ∧ b.first = m ∧ b.second = n)) → (FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)))) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : + PeriodicSubtileIndex), (a ≠ b) → ((FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty → + AllowedSubtileIncidence a b)) → (∀ (m : Int), ∀ (n : Int), ∀ (b : + PeriodicSubtileIndex), (b.label ≠ .A) → ((¬ (b.label = .B ∧ b.first = m ∧ b.second = + n)) → (((⟨.A, m, n⟩ : PeriodicSubtileIndex) ≠ b) → (((FootprintEdges + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v b)).Nonempty) → + (AllowedSubtileIncidence ⟨.A, m, n⟩ b)))))) ) := by + classical + intro q cfg C₀ T cert P O u v hAedge hmod_edge_allowed m n b hbA hbpair hab he + apply hmod_edge_allowed _ _ hab + rw [hAedge m n b hbA hbpair] + exact he + +private theorem hAAraw : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (m : Int), ∀ (n : Int), ∀ (p : Int), ∀ (r : Int), ((m, n) ≠ (p, r)) → (FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, p, r⟩) = FootprintEdges + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩))) → ((∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → ((FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty → + AllowedSubtileIncidence a b)) → (∀ (m : Int), ∀ (n : Int), ∀ (p : Int), ∀ (r : Int), + ((m, n) ≠ (p, r)) → (((FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, m, + n⟩) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩)).Nonempty) → + (AllowedSubtileIncidence ⟨.A, m, n⟩ ⟨.A, p, r⟩)))) ) := by + classical + intro q cfg C₀ T cert P O u v hAAedge hmod_edge_allowed m n p r hne he + apply hmod_edge_allowed _ _ (by + intro heq + apply hne + exact Prod.ext (by simpa using congrArg PeriodicSubtileIndex.first heq) + (by simpa using congrArg PeriodicSubtileIndex.second heq)) + rw [hAAedge m n p r hne] + exact he + +private theorem hneAt625 : + (by + classical + exact + ∀ (m : ℤ), ∀ (n : ℤ), ∀ (p : ℤ), ∀ (r : ℤ), (¬(⟨SixSubtileLabel.A, m, n⟩ : + PeriodicSubtileIndex) = (⟨SixSubtileLabel.A, p, r⟩ : PeriodicSubtileIndex)) → + ((¬AllowedSubtileIncidence (⟨SixSubtileLabel.A, m, n⟩ : PeriodicSubtileIndex) + (⟨SixSubtileLabel.A, p, r⟩ : PeriodicSubtileIndex)) → ((m, n) ≠ (p, r))) ) := by + classical + intro m n p r hab hna heq + apply hab + cases heq + rfl + +end OriginalIntersectionGeometry + +namespace OriginalIntersectionAssembly + +private theorem edgeImplication : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (a : PeriodicSubtileIndex), (a.label ≠ .A) → (ModifiedSubtileOccurrenceInterpretation + P O u v a = SubtileOccurrenceInterpretation P u v a)) → ((∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → ((FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty → + AllowedSubtileIncidence a b)) → ((∀ (m : Int), ∀ (n : Int), ∀ (b : + PeriodicSubtileIndex), (b.label ≠ .A) → ((¬ (b.label = .B ∧ b.first = m ∧ b.second = + n)) → (((⟨.A, m, n⟩ : PeriodicSubtileIndex) ≠ b) → (((FootprintEdges + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty) → (AllowedSubtileIncidence ⟨.A, + m, n⟩ b))))) → ((∀ (m : ℤ), ∀ (n : ℤ), ∀ (p : ℤ), ∀ (r : ℤ), (m, n) ≠ (p, r) → + (FootprintEdges (SubtileOccurrenceInterpretation P u v (⟨SixSubtileLabel.A, m, n⟩ : + PeriodicSubtileIndex)) ∩ FootprintEdges (SubtileOccurrenceInterpretation P u v + (⟨SixSubtileLabel.A, p, r⟩ : PeriodicSubtileIndex))).Nonempty → + AllowedSubtileIncidence (⟨SixSubtileLabel.A, m, n⟩ : PeriodicSubtileIndex) + (⟨SixSubtileLabel.A, p, r⟩ : PeriodicSubtileIndex)) → (∀ (a : PeriodicSubtileIndex), + ∀ (b : PeriodicSubtileIndex), (a ≠ b) → (((FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v b)).Nonempty) → + (AllowedSubtileIncidence a b)))))) ) := by + classical + intro q cfg C₀ T cert P O u v hmodother hmod_edge_allowed hAraw hAAraw a b hab he + rcases a with ⟨la, m, n⟩ + rcases b with ⟨lb, p, r⟩ + cases la with + | A => + cases lb with + | A => + apply hAAraw m n p r + · intro heq + apply hab + cases heq + rfl + · exact he + | B => + by_cases hcoord : (m, n) = (p, r) + · have hp : m = p := congrArg Prod.fst hcoord + have hr : n = r := congrArg Prod.snd hcoord + subst p + subst r + exact AllowedSubtileIncidence.AB m n + · apply hAraw m n ⟨.B, p, r⟩ (by simp) (by + intro hp + rcases hp with ⟨_, hf, hs⟩ + apply hcoord + exact Prod.ext (by simpa using hf.symm) (by simpa using hs.symm)) hab he + | C => exact hAraw m n ⟨.C, p, r⟩ (by simp) (by simp) hab he + | D => exact hAraw m n ⟨.D, p, r⟩ (by simp) (by simp) hab he + | E => exact hAraw m n ⟨.E, p, r⟩ (by simp) (by simp) hab he + | F => exact hAraw m n ⟨.F, p, r⟩ (by simp) (by simp) hab he + | B => + by_cases hba : lb = .A + · subst lb + have he' : (FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩)).Nonempty := + by simpa [Set.inter_comm] using he + by_cases hc : (m, n) = (p, r) + · have hm : m = p := congrArg Prod.fst hc + have hn : n = r := congrArg Prod.snd hc + subst p + subst r + exact AllowedSubtileIncidence.symm (AllowedSubtileIncidence.AB m n) + · exact AllowedSubtileIncidence.symm + (hAraw p r ⟨.B, m, n⟩ (by simp) (by + intro hp + rcases hp with ⟨_, hf, hs⟩ + apply hc + exact Prod.ext (by simpa using hf) (by simpa using hs)) + (by intro heq; apply hab; exact heq.symm) he') + · apply hmod_edge_allowed _ _ hab + simpa [hmodother ⟨.B, m, n⟩ (by simp), hmodother ⟨lb, p, r⟩ hba] using he + | C => + by_cases hba : lb = .A + · subst lb + have he' : (FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.C, m, n⟩)).Nonempty := + by simpa [Set.inter_comm] using he + exact AllowedSubtileIncidence.symm (hAraw p r ⟨.C, m, n⟩ (by simp) (by simp) (by + intro heq + apply hab + exact heq.symm) he') + · apply hmod_edge_allowed _ _ hab + simpa [hmodother ⟨.C, m, n⟩ (by simp), hmodother ⟨lb, p, r⟩ hba] using he + | D => + by_cases hba : lb = .A + · subst lb + have he' : (FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.D, m, n⟩)).Nonempty := + by simpa [Set.inter_comm] using he + exact AllowedSubtileIncidence.symm (hAraw p r ⟨.D, m, n⟩ (by simp) (by simp) (by + intro heq + apply hab + exact heq.symm) he') + · apply hmod_edge_allowed _ _ hab + simpa [hmodother ⟨.D, m, n⟩ (by simp), hmodother ⟨lb, p, r⟩ hba] using he + | E => + by_cases hba : lb = .A + · subst lb + have he' : (FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.E, m, n⟩)).Nonempty := + by simpa [Set.inter_comm] using he + exact AllowedSubtileIncidence.symm (hAraw p r ⟨.E, m, n⟩ (by simp) (by simp) (by + intro heq + apply hab + exact heq.symm) he') + · apply hmod_edge_allowed _ _ hab + simpa [hmodother ⟨.E, m, n⟩ (by simp), hmodother ⟨lb, p, r⟩ hba] using he + | F => + by_cases hba : lb = .A + · subst lb + have he' : (FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.F, m, n⟩)).Nonempty := + by simpa [Set.inter_comm] using he + exact AllowedSubtileIncidence.symm (hAraw p r ⟨.F, m, n⟩ (by simp) (by simp) (by + intro heq + apply hab + exact heq.symm) he') + · apply hmod_edge_allowed _ _ hab + simpa [hmodother ⟨.F, m, n⟩ (by simp), hmodother ⟨lb, p, r⟩ hba] using he + +private theorem vertexAlternative : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (a : PeriodicSubtileIndex), (a.label ≠ .A) → (ModifiedSubtileOccurrenceInterpretation + P O u v a = SubtileOccurrenceInterpretation P u v a)) → ((∀ (m : Int), ∀ (n : Int), ∀ + (b : PeriodicSubtileIndex), (b.label ≠ .A) → ((¬ (b.label = .B ∧ b.first = m ∧ + b.second = n)) → (FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v + ⟨.A, m, n⟩) ∩ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b) = + FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ + FootprintVertices (SubtileOccurrenceInterpretation P u v b)))) → ((∀ (m : Int), ∀ (n + : Int), ∀ (p : Int), ∀ (r : Int), ((m, n) ≠ (p, r)) → (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, p, r⟩) = FootprintVertices + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩))) → ((∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → ((¬ + AllowedSubtileIncidence a b) → (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = ∅ ∨ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b)).Subsingleton))) → (∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → ((¬ + AllowedSubtileIncidence a b) → (FootprintVertices (SubtileOccurrenceInterpretation P + u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b)).Subsingleton)))))) ) := by + classical + intro q cfg C₀ T cert P O u v hmodother hAvertex hAAvertex hmod_vertex_alt a b hab hna + rcases a with ⟨la, m, n⟩ + rcases b with ⟨lb, p, r⟩ + cases la with + | A => + cases lb with + | A => + have hne : (m, n) ≠ (p, r) := OriginalIntersectionGeometry.hneAt625 m n p r hab hna + have hv := hmod_vertex_alt ⟨.A, m, n⟩ ⟨.A, p, r⟩ (by + intro heq + apply hab + exact heq) hna + rw [hAAvertex m n p r hne] at hv + exact hv + | B => + by_cases hcoord : (m, n) = (p, r) + · have hp : m = p := congrArg Prod.fst hcoord + have hr : n = r := congrArg Prod.snd hcoord + subst p + subst r + exact False.elim (hna (AllowedSubtileIncidence.AB m n)) + · have hv := hmod_vertex_alt ⟨.A, m, n⟩ ⟨.B, p, r⟩ hab hna + rw [hAvertex m n ⟨.B, p, r⟩ (by simp) (by + intro hp + rcases hp with ⟨_, hf, hs⟩ + apply hcoord + exact Prod.ext (by simpa using hf.symm) (by simpa using hs.symm))] at hv + exact hv + | C => + have hv := hmod_vertex_alt ⟨.A, m, n⟩ ⟨.C, p, r⟩ hab hna + rw [hAvertex m n ⟨.C, p, r⟩ (by simp) (by simp)] at hv + exact hv + | D => + have hv := hmod_vertex_alt ⟨.A, m, n⟩ ⟨.D, p, r⟩ hab hna + rw [hAvertex m n ⟨.D, p, r⟩ (by simp) (by simp)] at hv + exact hv + | E => + have hv := hmod_vertex_alt ⟨.A, m, n⟩ ⟨.E, p, r⟩ hab hna + rw [hAvertex m n ⟨.E, p, r⟩ (by simp) (by simp)] at hv + exact hv + | F => + have hv := hmod_vertex_alt ⟨.A, m, n⟩ ⟨.F, p, r⟩ hab hna + rw [hAvertex m n ⟨.F, p, r⟩ (by simp) (by simp)] at hv + exact hv + | B => + by_cases hba : lb = .A + · subst lb + have hv := hmod_vertex_alt ⟨.A, p, r⟩ ⟨.B, m, n⟩ (by intro heq; apply hab; exact heq.symm) + (by intro hp; exact hna (AllowedSubtileIncidence.symm hp)) + rw [hAvertex p r ⟨.B, m, n⟩ (by simp) (by + intro hp + rcases hp with ⟨_, hf, hs⟩ + apply hna + subst p + subst r + exact AllowedSubtileIncidence.symm (AllowedSubtileIncidence.AB m n))] at hv + simpa [Set.inter_comm] using hv + · have hv := hmod_vertex_alt ⟨.B, m, n⟩ ⟨lb, p, r⟩ hab hna + simpa [hmodother ⟨.B, m, n⟩ (by simp), hmodother ⟨lb, p, r⟩ hba] using hv + | C => + by_cases hba : lb = .A + · subst lb + have hv := hmod_vertex_alt ⟨.A, p, r⟩ ⟨.C, m, n⟩ (by intro heq; apply hab; exact heq.symm) + (by intro hp; exact hna (AllowedSubtileIncidence.symm hp)) + rw [hAvertex p r ⟨.C, m, n⟩ (by simp) (by simp)] at hv + simpa [Set.inter_comm] using hv + · have hv := hmod_vertex_alt ⟨.C, m, n⟩ ⟨lb, p, r⟩ hab hna + simpa [hmodother ⟨.C, m, n⟩ (by simp), hmodother ⟨lb, p, r⟩ hba] using hv + | D => + by_cases hba : lb = .A + · subst lb + have hv := hmod_vertex_alt ⟨.A, p, r⟩ ⟨.D, m, n⟩ (by intro heq; apply hab; exact heq.symm) + (by intro hp; exact hna (AllowedSubtileIncidence.symm hp)) + rw [hAvertex p r ⟨.D, m, n⟩ (by simp) (by simp)] at hv + simpa [Set.inter_comm] using hv + · have hv := hmod_vertex_alt ⟨.D, m, n⟩ ⟨lb, p, r⟩ hab hna + simpa [hmodother ⟨.D, m, n⟩ (by simp), hmodother ⟨lb, p, r⟩ hba] using hv + | E => + by_cases hba : lb = .A + · subst lb + have hv := hmod_vertex_alt ⟨.A, p, r⟩ ⟨.E, m, n⟩ (by intro heq; apply hab; exact heq.symm) + (by intro hp; exact hna (AllowedSubtileIncidence.symm hp)) + rw [hAvertex p r ⟨.E, m, n⟩ (by simp) (by simp)] at hv + simpa [Set.inter_comm] using hv + · have hv := hmod_vertex_alt ⟨.E, m, n⟩ ⟨lb, p, r⟩ hab hna + simpa [hmodother ⟨.E, m, n⟩ (by simp), hmodother ⟨lb, p, r⟩ hba] using hv + | F => + by_cases hba : lb = .A + · subst lb + have hv := hmod_vertex_alt ⟨.A, p, r⟩ ⟨.F, m, n⟩ (by intro heq; apply hab; exact heq.symm) + (by intro hp; exact hna (AllowedSubtileIncidence.symm hp)) + rw [hAvertex p r ⟨.F, m, n⟩ (by simp) (by simp)] at hv + simpa [Set.inter_comm] using hv + · have hv := hmod_vertex_alt ⟨.F, m, n⟩ ⟨lb, p, r⟩ hab hna + simpa [hmodother ⟨.F, m, n⟩ (by simp), hmodother ⟨lb, p, r⟩ hba] using hv + +end OriginalIntersectionAssembly + +theorem BandOriginalOccurrenceIntersectionClassification + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + (let u := cert.u + let v := cert.v + ∀ a b : PeriodicSubtileIndex, a ≠ b → + ((FootprintEdges (SubtileOccurrenceInterpretation cert.P u v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P u v b)).Nonempty → + AllowedSubtileIncidence a b) ∧ + (¬ AllowedSubtileIncidence a b → + FootprintVertices (SubtileOccurrenceInterpretation cert.P u v a) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation cert.P u v b) = ∅ ∨ + (FootprintVertices + (SubtileOccurrenceInterpretation cert.P u v a) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation cert.P u v b)).Subsingleton)) := by +-- BODY + classical + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + have hOA := OriginalIntersectionGeometry.hOA q cfg C₀ T cert + have hOB := OriginalIntersectionGeometry.hOB q cfg C₀ T cert + have hseparation := BandOriginalPairSeparation P O u v hOA hOB cert.partition + have hpaircells (a b : PeriodicSubtileIndex) (hab : a ≠ b) + (hnot : ¬ ((a.label = .A ∧ b.label = .B ∨ + a.label = .B ∧ b.label = .A) ∧ a.first = b.first ∧ a.second = b.second)) : + Disjoint (SubtileOccurrenceInterpretation P u v a).cells + (SubtileOccurrenceInterpretation P u v b).cells := + hseparation.2 a b hab hnot + have hclass := PeriodicTileIntersectionClassification cert.modified + have hmodified (a : PeriodicSubtileIndex) := OriginalIntersectionGeometry.hmodified q cfg C₀ T + cert a + have hmodadj (a b : PeriodicSubtileIndex) : + cert.modified.plane.adjacent a b ↔ AllowedSubtileIncidence a b := + cert.modified_adjacency a b + have htranscells (X : ProtoTile) (w : GaussianInt) : + (TileTranslation X w).cells = X.cells.image (GaussianTranslation w) := + (TileTranslationFormulas X w).1 + have hnonempty (X : ProtoTile) (hX : LatticeTile X) := OriginalIntersectionGeometry.hnonempty X hX + have htranslate_complement (A B : ProtoTile) (w : GaussianInt) : + TileTranslation (TileCellComplement A B) w = + TileCellComplement (TileTranslation A w) (TileTranslation B w) := + (TileCellComplementCovariance A B w).1 + have hmodA (m n : Int) := OriginalIntersectionGeometry.hmodA q cfg C₀ T cert + htranslate_complement m n + have hmodother (a : PeriodicSubtileIndex) (ha : a.label ≠ .A) : + ModifiedSubtileOccurrenceInterpretation P O u v a = + SubtileOccurrenceInterpretation P u v a := OriginalIntersectionGeometry.hmodother q cfg + C₀ T cert a ha + have hcell_inclusion (X Y : ProtoTile) (hXY : X.cells ⊆ Y.cells) + (w : GaussianInt) := OriginalIntersectionGeometry.hcell_inclusion htranscells X Y hXY w + have hisolated (m n : Int) := OriginalIntersectionGeometry.hisolated q cfg C₀ T cert m n + have hdel_edge (m n : Int) (Y : ProtoTile) + (hYA : Disjoint Y.cells + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells) + (hYB : Disjoint Y.cells + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) := + OriginalIntersectionGeometry.hdel_edge q cfg C₀ T cert hOA hcell_inclusion hisolated + m n Y hYA hYB + have htranslated_nonempty (X : ProtoTile) (hX : X.cells.Nonempty) + (w : GaussianInt) := OriginalIntersectionGeometry.htranslated_nonempty htranscells X hX w + have hdel_vertex (m n : Int) (Y : ProtoTile) + (hYA : Disjoint Y.cells + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells) + (hYB : Disjoint Y.cells + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) + (hsupport : + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)).cells = ∅ ∨ + ((TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))).cells.Nonempty ∧ + Y.cells.Nonempty)) := OriginalIntersectionGeometry.hdel_vertex q cfg C₀ T cert hOA + hcell_inclusion hisolated m n Y hYA hYB hsupport + have hparent_nonempty (a : PeriodicSubtileIndex) := + OriginalIntersectionGeometry.hparent_nonempty q cfg C₀ T cert hnonempty htranslated_nonempty a + have hcomplement_nonempty (m n : Int) := OriginalIntersectionGeometry.hcomplement_nonempty q + cfg C₀ T cert hnonempty htranslate_complement htranslated_nonempty m n + have hsupport_for (m n : Int) (Y : ProtoTile) (hY : Y.cells.Nonempty) := + OriginalIntersectionGeometry.hsupport_for q cfg C₀ T cert hcomplement_nonempty m n Y hY + have hAedge (m n : Int) (b : PeriodicSubtileIndex) + (hbA : b.label ≠ .A) + (hbpair : ¬ (b.label = .B ∧ b.first = m ∧ b.second = n)) := + OriginalIntersectionGeometry.hAedge q cfg C₀ T cert hpaircells hmodA hmodother + hdel_edge m n b hbA hbpair + have hAvertex (m n : Int) (b : PeriodicSubtileIndex) + (hbA : b.label ≠ .A) + (hbpair : ¬ (b.label = .B ∧ b.first = m ∧ b.second = n)) : + FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ + FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = + FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ + FootprintVertices (SubtileOccurrenceInterpretation P u v b) := + OriginalIntersectionGeometry.hAvertex q cfg C₀ T cert hpaircells hmodA hmodother + hdel_vertex hparent_nonempty hsupport_for m n b hbA hbpair + have hAAedge (m n p r : Int) (hne : (m, n) ≠ (p, r)) := OriginalIntersectionGeometry.hAAedge q + cfg C₀ T cert hpaircells hmodA hdel_edge m n p r hne + have hAAvertex (m n p r : Int) (hne : (m, n) ≠ (p, r)) : + FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ + FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, p, r⟩) = + FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ + FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩) := + OriginalIntersectionGeometry.hAAvertex q cfg C₀ T cert hpaircells hmodA hdel_vertex + hparent_nonempty hcomplement_nonempty hsupport_for m n p r hne + have hmod_edge_allowed (a b : PeriodicSubtileIndex) (hab : a ≠ b) : + (FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty → + AllowedSubtileIncidence a b := OriginalIntersectionGeometry.hmod_edge_allowed q cfg C₀ T + cert hclass hmodified hmodadj a b + hab + have hmod_vertex_alt (a b : PeriodicSubtileIndex) (hab : a ≠ b) + (hna : ¬ AllowedSubtileIncidence a b) : + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b) = ∅ ∨ + (FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)).Subsingleton := + OriginalIntersectionGeometry.hmod_vertex_alt q cfg + C₀ T cert hclass hmodified hmodadj a b hab hna + have hAraw (m n : Int) (b : PeriodicSubtileIndex) + (hbA : b.label ≠ .A) + (hbpair : ¬ (b.label = .B ∧ b.first = m ∧ b.second = n)) + (hab : (⟨.A, m, n⟩ : PeriodicSubtileIndex) ≠ b) + (he : (FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v b)).Nonempty) : + AllowedSubtileIncidence ⟨.A, m, n⟩ b := OriginalIntersectionGeometry.hAraw q cfg C₀ T cert + hAedge hmod_edge_allowed m n b hbA hbpair hab he + have hAAraw (m n p r : Int) (hne : (m, n) ≠ (p, r)) + (he : (FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, p, r⟩)).Nonempty) := + OriginalIntersectionGeometry.hAAraw q cfg C₀ T cert hAAedge hmod_edge_allowed m n p + r hne he + have edgeImplication (a b : PeriodicSubtileIndex) (hab : a ≠ b) + (he : (FootprintEdges (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v b)).Nonempty) : + AllowedSubtileIncidence a b := OriginalIntersectionAssembly.edgeImplication q cfg C₀ T cert + hmodother hmod_edge_allowed hAraw hAAraw a b hab he + have vertexAlternative (a b : PeriodicSubtileIndex) (hab : a ≠ b) + (hna : ¬ AllowedSubtileIncidence a b) : + FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices (SubtileOccurrenceInterpretation P u v b)).Subsingleton := + OriginalIntersectionAssembly.vertexAlternative q cfg C₀ T cert hmodother hAvertex + hAAvertex hmod_vertex_alt a b hab hna + dsimp [P, O, u, v] + intro a b hab + constructor + · exact edgeImplication a b hab + · exact vertexAlternative a b hab + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOriginalPairSeparation.lean b/LeanPool/ApollonianSuperharmonic/BandOriginalPairSeparation.lean new file mode 100644 index 0000000000..f4d9755eba --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOriginalPairSeparation.lean @@ -0,0 +1,175 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandModifiedCellPartition +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: BandOriginalPairSeparation] + +/-! +# BandOriginalPairSeparation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandOriginalPairSeparation (P : Fin 3 -> Bool -> ProtoTile) + (O : ProtoTile) (u v : GaussianInt) + (hOA : O.cells ⊆ (P 0 true).cells) + (hOB : O.cells ⊆ (P 0 false).cells) + (hpartition : ∀ x : LatticeCell, ∃! o : PeriodicSubtileIndex, + x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells) : + (forall m n : Int, + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells ∩ + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells = + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)).cells) ∧ + forall a b : PeriodicSubtileIndex, a ≠ b -> + ¬ ((a.label = .A ∧ b.label = .B ∨ + a.label = .B ∧ b.label = .A) ∧ + a.first = b.first ∧ a.second = b.second) -> + Disjoint (SubtileOccurrenceInterpretation P u v a).cells + (SubtileOccurrenceInterpretation P u v b).cells := by +-- BODY + classical + have translation_cells (T : ProtoTile) (w : GaussianInt) : + (TileTranslation T w).cells = T.cells.image (GaussianTranslation w) := + (TileTranslationFormulas T w).1 + have modified_a (m n : Int) : + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩).cells = + (TileCellComplement (P 0 true) O).cells.image + (GaussianTranslation ((m : GaussianInt) * u + (n : GaussianInt) * v)) := by + rfl + have modified_b (m n : Int) : + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.B, m, n⟩).cells = + (P 0 false).cells.image + (GaussianTranslation ((m : GaussianInt) * u + (n : GaussianInt) * v)) := by + rfl + have original_cells (o : PeriodicSubtileIndex) : + (SubtileOccurrenceInterpretation P u v o).cells = + (match o.label with + | .A => (P 0 true).cells + | .B => (P 0 false).cells + | .C => (P 1 true).cells + | .D => (P 1 false).cells + | .E => (P 2 true).cells + | .F => (P 2 false).cells).image + (GaussianTranslation ((o.first : GaussianInt) * u + (o.second : GaussianInt) * v)) := by + cases o with + | mk label first second => + cases label <;> rfl + constructor + · intro m n + apply Finset.ext + intro x + constructor + · intro hx + rcases Finset.mem_inter.1 hx with ⟨ha, hb⟩ + change x ∈ (P 0 true).cells.image + (GaussianTranslation ((m : GaussianInt) * u + (n : GaussianInt) * v)) at ha + change x ∈ (P 0 false).cells.image + (GaussianTranslation ((m : GaussianInt) * u + (n : GaussianInt) * v)) at hb + rcases Finset.mem_image.1 ha with ⟨z, hz, rfl⟩ + by_cases ho : z ∈ O.cells + · apply Finset.mem_image.2 + exact ⟨z, ho, rfl⟩ + · have hza : z ∈ (TileCellComplement (P 0 true) O).cells := by + exact Finset.mem_sdiff.2 ⟨hz, ho⟩ + have hma : (GaussianTranslation ((m : GaussianInt) * u + (n : GaussianInt) * v) z) ∈ + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩).cells := by + rw [modified_a] + exact Finset.mem_image.2 ⟨z, hza, rfl⟩ + have hmb : (GaussianTranslation ((m : GaussianInt) * u + (n : GaussianInt) * v) z) ∈ + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.B, m, n⟩).cells := by + rw [modified_b] + exact hb + have heq := (hpartition _).unique hma hmb + exact False.elim (by + have : (PeriodicSubtileIndex.mk .A m n) = (PeriodicSubtileIndex.mk .B m n) := heq + cases this) + · intro hx + rw [translation_cells] at hx + rcases Finset.mem_image.1 hx with ⟨z, hz, he⟩ + apply Finset.mem_inter.2 + constructor + · change x ∈ (P 0 true).cells.image + (GaussianTranslation ((m : GaussianInt) * u + (n : GaussianInt) * v)) + exact Finset.mem_image.2 ⟨z, hOA hz, he⟩ + · change x ∈ (P 0 false).cells.image + (GaussianTranslation ((m : GaussianInt) * u + (n : GaussianInt) * v)) + exact Finset.mem_image.2 ⟨z, hOB hz, he⟩ + · intro a b hab hpair + rw [Finset.disjoint_left] + intro x hxa hxb + have choose := hpartition x + have split_member (o : PeriodicSubtileIndex) + (ho : x ∈ (SubtileOccurrenceInterpretation P u v o).cells) : + x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells ∨ + (o.label = .A ∧ + x ∈ (ModifiedSubtileOccurrenceInterpretation P O u v + ⟨.B, o.first, o.second⟩).cells) := by + cases o with + | mk label first second => + cases label with + | A => + change x ∈ (P 0 true).cells.image + (GaussianTranslation ((first : GaussianInt) * u + (second : GaussianInt) * v)) at ho + rcases Finset.mem_image.1 ho with ⟨z, hz, he⟩ + by_cases hzO : z ∈ O.cells + · right + constructor + · rfl + · rw [modified_b] + apply Finset.mem_image.2 + exact ⟨z, hOB hzO, he⟩ + · left + rw [modified_a] + apply Finset.mem_image.2 + exact ⟨z, Finset.mem_sdiff.2 ⟨hz, hzO⟩, he⟩ + | B | C | D | E | F => + left + simpa [SubtileOccurrenceInterpretation, ModifiedSubtileOccurrenceInterpretation, + TileTranslation] using ho + rcases split_member a hxa with hma | ⟨ha, hca⟩ + · rcases split_member b hxb with hmb | ⟨hb, hcb⟩ + · exact hab (choose.unique hma hmb) + · have heq := choose.unique hma hcb + have hl := congrArg PeriodicSubtileIndex.label heq + have hf := congrArg PeriodicSubtileIndex.first heq + have hs := congrArg PeriodicSubtileIndex.second heq + cases a with + | mk la af as => + cases b with + | mk lb bf bs => + cases la <;> cases lb <;> simp_all + · rcases split_member b hxb with hmb | ⟨hb, hcb⟩ + · have heq := choose.unique hca hmb + have hl := congrArg PeriodicSubtileIndex.label heq + have hf := congrArg PeriodicSubtileIndex.first heq + have hs := congrArg PeriodicSubtileIndex.second heq + cases a with + | mk la af as => + cases b with + | mk lb bf bs => + cases la <;> cases lb <;> simp_all + · have heq := choose.unique hca hcb + have hf := congrArg PeriodicSubtileIndex.first heq + have hs := congrArg PeriodicSubtileIndex.second heq + exact hab (by + cases a with + | mk la af as => + cases b with + | mk lb bf bs => + simp_all) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingExterior.lean b/LeanPool/ApollonianSuperharmonic/BandPackingExterior.lean new file mode 100644 index 0000000000..f78154cce8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingExterior.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData + +-- [TABLET NODE: BandPackingExterior] + +/-! +# BandPackingExterior + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A point $z\in\mathbb C$ is exterior to the open disks of the band packing +if, for every positive-curvature band circle $C$, one has +$$ + \operatorname{circ}(C).\operatorname{radius} + \le |z-\operatorname{circ}(C).\operatorname{center}|. +$$ +Boundary and tangency points are therefore exterior; points in an open +band disk are not. +-/ +def BandPackingExterior (z : Complex) : Prop := +-- BODY + ∀ C : BandCircle, + (BandCircleEuclideanData C).radius ≤ + dist z (BandCircleEuclideanData C).center + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingShiftPotential.lean b/LeanPool/ApollonianSuperharmonic/BandPackingShiftPotential.lean new file mode 100644 index 0000000000..907d1364f9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingShiftPotential.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: BandPackingShiftPotential] + +/-! +# BandPackingShiftPotential + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $w=A+Bi\in\mathbb Z[i]$, the integral quadratic correction attached +to a packing shift is +$$ + \Psi_w(x_1,x_2)= + A\frac{x_1(x_1-1)}2-A\frac{x_2(x_2-1)}2+Bx_1x_2. +$$ +The two products in the numerators are even, so this is integer-valued +on the Gaussian lattice. +-/ +def BandPackingShiftPotential (w x : GaussianInt) : ℤ := +-- BODY + w.re * (x.re * (x.re - 1) / 2) - + w.re * (x.im * (x.im - 1) / 2) + w.im * x.re * x.im + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetry.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetry.lean new file mode 100644 index 0000000000..4761a2db84 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetry.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: BandPackingSymmetry] + +/-! +# BandPackingSymmetry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A *band-packing symmetry word* is an expression in the free abstract +syntax generated by +$$ + \operatorname{identity},\qquad \operatorname{negate},\qquad + \operatorname{conjugate},\qquad \operatorname{shift}(w) + \quad (w\in\mathbb Z[i]), +$$ +together with a binary constructor +$\operatorname{comp}(g,h)$ for symmetry words $g$ and $h$. No relations +between these expressions are imposed at the level of this syntax. +-/ +inductive BandPackingSymmetry : Type where +-- BODY + | identity + | negate + | conjugate + | shift (w : GaussianInt) + | comp (g h : BandPackingSymmetry) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorAction.lean new file mode 100644 index 0000000000..bef0f6fb34 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorAction.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.GaussianReflection + +-- [TABLET NODE: BandPackingSymmetryAffineVectorAction] + +/-! +# BandPackingSymmetryAffineVectorAction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The affine action of a band-packing symmetry on a recursive spatial and +slope-vector pair $(v,a)\in\mathbb Z[i]^2$ is +$$ +\begin{array}{c|c} +g&g\diamond(v,a)\\ \hline +1&(v,a)\\ +T_w&(v,a+w\bar v)\\ +N&(iv,ia)\\ +K&(-\bar v,-\bar a). +\end{array} +$$ +Here $N$ is coordinate negation and $K$ is coordinate conjugation in the +band packing. A composite acts by composition with the right-hand word +first. This is an action on the lifted pair; comparison with the +canonical recursive vectors at a proper occurrence still requires the +single local projective phase. +-/ +def BandPackingSymmetryAffineVectorAction : + BandPackingSymmetry → (GaussianInt × GaussianInt) → + (GaussianInt × GaussianInt) := +-- BODY + fun g x => match g with + | .identity => x + | .shift w => (x.1, x.2 + w * GaussianReflection x.1) + | .negate => (GaussianQuarterTurn x.1, GaussianQuarterTurn x.2) + | .conjugate => (-GaussianReflection x.1, -GaussianReflection x.2) + | .comp a b => + BandPackingSymmetryAffineVectorAction a + (BandPackingSymmetryAffineVectorAction b x) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean new file mode 100644 index 0000000000..9ec2459162 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean @@ -0,0 +1,1039 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct + +-- [TABLET NODE: BandPackingSymmetryAffineVectorCovariance] + +/-! +# BandPackingSymmetryAffineVectorCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace AffineSymmetryCoordinates + +private theorem circleCurvature : + (by + classical + exact + ∀ h : BandPackingSymmetry, ∀ C : CircleCoordinates, (BandPackingSymmetryCircleAction h + C).1 = C.1 ) := by + classical + intro h + induction h with + | identity => intro C; rfl + | negate => intro C; rfl + | conjugate => intro C; rfl + | shift w => intro C; rfl + | comp h k ih ih' => + intro C + simp [BandPackingSymmetryCircleAction, ih, ih'] + +private theorem affineFacts : + (by + classical + exact + (∀ h : BandPackingSymmetry, ∀ C : CircleCoordinates, (BandPackingSymmetryCircleAction h + C).1 = C.1) → (∀ (h : BandPackingSymmetry), ∀ (D : CircleCoordinates), ∀ (E : + CircleCoordinates), ∀ (v : GaussianInt), ∀ (a : GaussianInt), Zsqrtd.norm v = D.1 + + E.1 → 2 * v * a = D.2 + E.2 → (BandPackingSymmetryAffineVectorAction h (v, a)).1 = + BandPackingSymmetryVectorAction h v ∧ Zsqrtd.norm + (BandPackingSymmetryAffineVectorAction h (v, a)).1 = D.1 + E.1 ∧ 2 * + (BandPackingSymmetryAffineVectorAction h (v, a)).1 * + (BandPackingSymmetryAffineVectorAction h (v, a)).2 = (BandPackingSymmetryCircleAction + h D).2 + (BandPackingSymmetryCircleAction h E).2) ) := by + classical + intro circleCurvature h + induction h with + | identity => + intro D E v a hv ha + simpa [BandPackingSymmetryAffineVectorAction, + BandPackingSymmetryVectorAction, BandPackingSymmetryCircleAction] using + ⟨hv, ha⟩ + | shift w => + intro D E v a hv ha + simp? [BandPackingSymmetryAffineVectorAction, + BandPackingSymmetryVectorAction, BandPackingSymmetryCircleAction] + constructor + · exact hv + · have reflectionProduct : v * GaussianReflection v = + (Zsqrtd.norm v : GaussianInt) := by + ext <;> simp [GaussianReflection, Zsqrtd.norm]; ring + rw [mul_add, ha] + calc + D.2 + E.2 + 2 * v * (w * GaussianReflection v) = + D.2 + E.2 + 2 * w * (v * GaussianReflection v) := by ring + _ = D.2 + E.2 + 2 * w * (D.1 + E.1) := by + rw [reflectionProduct, hv] + simp only [Int.cast_add] + _ = D.2 + 2 * (D.1 : GaussianInt) * w + + (E.2 + 2 * (E.1 : GaussianInt) * w) := by + ring + | negate => + intro D E v a hv ha + have quarterNorm : Zsqrtd.norm (GaussianQuarterTurn v) = + Zsqrtd.norm v := by + simp [GaussianQuarterTurn, Zsqrtd.norm] + ring + have quarterProduct : + 2 * GaussianQuarterTurn v * GaussianQuarterTurn a = -(2 * v * a) := by + ext <;> simp [GaussianQuarterTurn] + have quarterSum : 2 * GaussianQuarterTurn v * GaussianQuarterTurn a = + -D.2 + -E.2 := by + rw [quarterProduct, ha] + ring + simpa [BandPackingSymmetryAffineVectorAction, + BandPackingSymmetryVectorAction, BandPackingSymmetryCircleAction] using + ⟨by rw [quarterNorm, hv], quarterSum⟩ + | conjugate => + intro D E v a hv ha + have reflectionNorm : Zsqrtd.norm (GaussianReflection v) = + Zsqrtd.norm v := by + simp [GaussianReflection, Zsqrtd.norm] + have reflectionProduct : 2 * GaussianReflection v * GaussianReflection a = + GaussianReflection (2 * v * a) := by + ext <;> simp [GaussianReflection]; ring_nf + have reflectionSum : 2 * GaussianReflection v * GaussianReflection a = + GaussianReflection D.2 + GaussianReflection E.2 := by + rw [reflectionProduct, ha] + ext <;> simp [GaussianReflection]; ring + simpa [BandPackingSymmetryAffineVectorAction, + BandPackingSymmetryVectorAction, BandPackingSymmetryCircleAction] using + ⟨by rw [reflectionNorm, hv], reflectionSum⟩ + | comp h k ih ih' => + intro D E v a hv ha + have first := ih' D E v a hv ha + have second := ih (BandPackingSymmetryCircleAction k D) + (BandPackingSymmetryCircleAction k E) + (BandPackingSymmetryAffineVectorAction k (v, a)).1 + (BandPackingSymmetryAffineVectorAction k (v, a)).2 + (by + calc + Zsqrtd.norm (BandPackingSymmetryAffineVectorAction k (v, a)).1 = + D.1 + E.1 := first.2.1 + _ = (BandPackingSymmetryCircleAction k D).1 + + (BandPackingSymmetryCircleAction k E).1 := by + rw [circleCurvature k D, circleCurvature k E]) first.2.2 + have secondFirst := second.1 + have secondVector : + (BandPackingSymmetryAffineVectorAction h + ((BandPackingSymmetryAffineVectorAction k (v, a)).1, + (BandPackingSymmetryAffineVectorAction k (v, a)).2)).1 = + BandPackingSymmetryVectorAction h + (BandPackingSymmetryVectorAction k v) := by + calc + _ = BandPackingSymmetryVectorAction h + (BandPackingSymmetryAffineVectorAction k (v, a)).1 := secondFirst + _ = _ := by rw [first.1] + have secondNorm : Zsqrtd.norm + (BandPackingSymmetryAffineVectorAction h + ((BandPackingSymmetryAffineVectorAction k (v, a)).1, + (BandPackingSymmetryAffineVectorAction k (v, a)).2)).1 = + D.1 + E.1 := by + rw [second.2.1, circleCurvature k D, circleCurvature k E] + have secondProduct := second.2.2 + have pairEta : ∀ x : GaussianInt × GaussianInt, (x.1, x.2) = x := by + intro x + cases x + rfl + rw [pairEta] at secondVector secondNorm secondProduct + simpa [BandPackingSymmetryAffineVectorAction, + BandPackingSymmetryVectorAction, BandPackingSymmetryCircleAction, + Prod.eta] using ⟨secondVector, secondNorm, secondProduct⟩ + +private theorem epsilonSquare : + (by + classical + exact + ∀ (negative : Bool), + let epsilon : GaussianInt := if negative then -1 else 1 + epsilon * epsilon = 1 ) := by + classical + intro negative epsilon + dsimp [epsilon] + split <;> simp + +private theorem slopeCancel : + (by + classical + exact + ∀ (negative : Bool), + let epsilon : GaussianInt := if negative then -1 else 1 + (epsilon * epsilon = 1) → (∀ (V : GaussianInt), ∀ (A : GaussianInt), ∀ (b : GaussianInt), + V ≠ 0 → 2 * V * A = 2 * (epsilon * V) * b → b = epsilon * A) ) := by + classical + intro negative epsilon epsilonSquare V A b hV hprod + have htwo : (2 : GaussianInt) * V ≠ 0 := by + exact mul_ne_zero (by norm_num) hV + have hmain : ((2 : GaussianInt) * V) * (epsilon * b) = + ((2 : GaussianInt) * V) * A := by + calc + ((2 : GaussianInt) * V) * (epsilon * b) = + 2 * (epsilon * V) * b := by ring + _ = 2 * V * A := hprod.symm + _ = ((2 : GaussianInt) * V) * A := by ring + have hmain' := (mul_left_cancel₀ htwo hmain) + calc + b = 1 * b := by simp + _ = (epsilon * epsilon) * b := by rw [epsilonSquare] + _ = epsilon * (epsilon * b) := by ring + _ = epsilon * A := by rw [hmain'] + +private theorem sourceNorm : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (i : Fin 4), ∀ (j : Fin + 4), i ≠ j → 0 < (q i).1 + (q j).1 → Zsqrtd.norm (BandVectors.1 (q i) (q j)) = (q i).1 + + (q j).1) ) := by + classical + intro q hq i j hij hpos + have hs := (VectorSquareProduct q hq.1 i j hij).1 + have ht := TangencyCoordinateIdentity q hq.1 i j hij + have heq : Zsqrtd.norm (BandVectors.1 (q i) (q j)) ^ 2 = + ((q i).1 + (q j).1) ^ 2 := by + calc + Zsqrtd.norm (BandVectors.1 (q i) (q j)) ^ 2 = + Zsqrtd.norm (BandVectors.1 (q i) (q j) ^ 2) := by + simpa only [pow_two] using (Zsqrtd.norm_mul + (BandVectors.1 (q i) (q j)) (BandVectors.1 (q i) (q j))).symm + _ = Zsqrtd.norm ((q j).1 • (q i).2 - (q i).1 • (q j).2) := by rw [hs] + _ = _ := ht + have hn : 0 ≤ Zsqrtd.norm (BandVectors.1 (q i) (q j)) := + Zsqrtd.norm_nonneg (by norm_num) _ + nlinarith + +private theorem parentPositive : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (r : Fin 3), ∀ (s : Fin + 3), r ≠ s → 0 < (q r.succ).1 + (q s.succ).1) ) := by + classical + intro q hq r s hrs + have hc := ProperBandCurvatureStructure q hq + have hr := hc.2.1 r + have hs := hc.2.1 s + by_contra bad + have hrz : (q r.succ).1 = 0 := by omega + have hsz : (q s.succ).1 = 0 := by omega + exact hrs (hc.2.2 r s hrz hsz) + +private theorem incomingFacts : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → + ((∀ (h : BandPackingSymmetry), ∀ (D : CircleCoordinates), ∀ (E : CircleCoordinates), + ∀ (v : GaussianInt), ∀ (a : GaussianInt), Zsqrtd.norm v = D.1 + E.1 → 2 * v * a = D.2 + + E.2 → (BandPackingSymmetryAffineVectorAction h (v, a)).1 = + BandPackingSymmetryVectorAction h v ∧ Zsqrtd.norm + (BandPackingSymmetryAffineVectorAction h (v, a)).1 = D.1 + E.1 ∧ 2 * + (BandPackingSymmetryAffineVectorAction h (v, a)).1 * + (BandPackingSymmetryAffineVectorAction h (v, a)).2 = (BandPackingSymmetryCircleAction + h D).2 + (BandPackingSymmetryCircleAction h E).2) → ((∀ (i : Fin 4), ∀ (j : Fin 4), i + ≠ j → 0 < (q i).1 + (q j).1 → Zsqrtd.norm (BandVectors.1 (q i) (q j)) = (q i).1 + (q + j).1) → (∀ (j : Fin 4), j ≠ 0 → (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q 0), BandVectors.2 (q j) (q 0))).1 ≠ 0))) ) := by + classical + intro g q hq affineFacts sourceNorm j hj + have hc := ProperBandCurvatureStructure q hq + have hpos : 0 < (q j).1 + (q 0).1 := by + have hnon : 0 ≤ (q j).1 := by + obtain ⟨k, rfl⟩ := Fin.eq_succ_of_ne_zero hj + exact hc.2.1 k + omega + have hv := affineFacts g (q j) (q 0) + (BandVectors.1 (q j) (q 0)) (BandVectors.2 (q j) (q 0)) + (sourceNorm j 0 hj hpos) + (VectorSquareProduct q hq.1 j 0 hj).2 + intro hz + have := hv.2.1 + rw [hz] at this + have : Zsqrtd.norm (0 : GaussianInt) = 0 := by simp + omega + +private theorem cyclicFacts : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → + ((∀ (h : BandPackingSymmetry), ∀ (D : CircleCoordinates), ∀ (E : CircleCoordinates), + ∀ (v : GaussianInt), ∀ (a : GaussianInt), Zsqrtd.norm v = D.1 + E.1 → 2 * v * a = D.2 + + E.2 → (BandPackingSymmetryAffineVectorAction h (v, a)).1 = + BandPackingSymmetryVectorAction h v ∧ Zsqrtd.norm + (BandPackingSymmetryAffineVectorAction h (v, a)).1 = D.1 + E.1 ∧ 2 * + (BandPackingSymmetryAffineVectorAction h (v, a)).1 * + (BandPackingSymmetryAffineVectorAction h (v, a)).2 = (BandPackingSymmetryCircleAction + h D).2 + (BandPackingSymmetryCircleAction h E).2) → ((∀ (i : Fin 4), ∀ (j : Fin 4), i + ≠ j → 0 < (q i).1 + (q j).1 → Zsqrtd.norm (BandVectors.1 (q i) (q j)) = (q i).1 + (q + j).1) → (∀ (j : Fin 4), ∀ (k : Fin 4), j ≠ k → (BandPackingSymmetryAffineVectorAction + g (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).1 ≠ 0))) ) := by + classical + intro g q hq affineFacts sourceNorm j k hjk + have hc := ProperBandCurvatureStructure q hq + have hpos : 0 < (q j).1 + (q k).1 := by + by_cases hj : j = 0 + · subst j + by_cases hk : k = 0 + · exact (hjk hk.symm).elim + · obtain ⟨s, rfl⟩ := Fin.eq_succ_of_ne_zero hk + have hp := hc.1 + have hs := hc.2.1 s + exact add_pos_of_pos_of_nonneg hp hs + · by_cases hk : k = 0 + · subst k + obtain ⟨r, rfl⟩ := Fin.eq_succ_of_ne_zero hj + have hp := hc.1 + have hr := hc.2.1 r + simpa [add_comm] using add_pos_of_pos_of_nonneg hp hr + · obtain ⟨r, rfl⟩ := Fin.eq_succ_of_ne_zero hj + obtain ⟨s, rfl⟩ := Fin.eq_succ_of_ne_zero hk + have hr := hc.2.1 r + have hs := hc.2.1 s + by_contra bad + have hrz : (q r.succ).1 = 0 := by omega + have hsz : (q s.succ).1 = 0 := by omega + have : r = s := hc.2.2 r s hrz hsz + exact hjk (by simp [this]) + have hv := affineFacts g (q j) (q k) + (BandVectors.1 (q j) (q k)) (BandVectors.2 (q j) (q k)) + (sourceNorm j k hjk hpos) + (VectorSquareProduct q hq.1 j k hjk).2 + intro hz + have hnorm := hv.2.1 + rw [hz] at hnorm + have hz0 : Zsqrtd.norm (0 : GaussianInt) = 0 := by simp + omega + +private theorem incomingSlope : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), ∀ (i + : Fin (3 : ℕ)), + let epsilon : GaussianInt := if negative then -1 else 1 + (∀ (V : GaussianInt), ∀ (A : GaussianInt), ∀ (b : GaussianInt), V ≠ 0 → 2 * V * A = 2 * + (epsilon * V) * b → b = epsilon * A) → ((∀ (j : Fin 4), j ≠ 0 → + (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) (q 0), BandVectors.2 (q + j) (q 0))).1 ≠ 0) → ((BandVectors.1 (BandPackingSymmetryQuadrupleAction g q ((fun (i + : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true then -i else i) + i).succ) (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = (if negative = + true then (-1 : GaussianInt) else (1 : GaussianInt)) * + BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) ∧ + (BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) = (if + negative = true then (-1 : GaussianInt) else (1 : GaussianInt)) * if + BandPackingSymmetryReversesOrientation g = true then -BandPackingSymmetryVectorAction + g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) else + BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) ∧ + BandVectors.1 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : + ℕ))).succ) = (if negative = true then (-1 : GaussianInt) else (1 : GaussianInt)) * if + BandPackingSymmetryReversesOrientation g = true then GaussianQuarterTurn + (BandPackingSymmetryVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q + (i + (1 : Fin (3 : ℕ))).succ))) else BandPackingSymmetryVectorAction g (BandVectors.1 + (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))) → ((BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + = true then -i else i).succ) (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : + ℕ))) ^ (2 : ℕ) = (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).1 • + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + = true then -i else i).succ).2 - (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ).1 • + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2 ∧ (2 : GaussianInt) * + BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) * BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + = true then -i else i).succ) (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : + ℕ))) = (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ).2 + + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2) → + (((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = + BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) ∧ + Zsqrtd.norm (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 + : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = (q i.succ).1 + + (q (0 : Fin (4 : ℕ))).1 ∧ (2 : GaussianInt) * (BandPackingSymmetryAffineVectorAction + g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : + Fin (4 : ℕ))))).1 * (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2 = + (BandPackingSymmetryCircleAction g (q i.succ)).2 + (BandPackingSymmetryCircleAction g + (q (0 : Fin (4 : ℕ)))).2) → (BandVectors.2 (BandPackingSymmetryQuadrupleAction g q + (if BandPackingSymmetryReversesOrientation g = true then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = epsilon * + (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2))))) ) := by + classical + intro g q negative i epsilon slopeCancel incomingFacts hspatial incomingProduct incomingAffine + exact slopeCancel + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q i.succ) (q 0), BandVectors.2 (q i.succ) (q 0))).1 + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q i.succ) (q 0), BandVectors.2 (q i.succ) (q 0))).2 + (BandVectors.2 (BandPackingSymmetryQuadrupleAction g q + (if BandPackingSymmetryReversesOrientation g then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q 0)) + (incomingFacts i.succ (by simp)) + (by + calc + 2 * _ * _ = (BandPackingSymmetryCircleAction g (q i.succ)).2 + + (BandPackingSymmetryCircleAction g (q 0)).2 := incomingAffine.2.2 + _ = (BandPackingSymmetryQuadrupleAction g q + (if BandPackingSymmetryReversesOrientation g then -i else i).succ).2 + + (BandPackingSymmetryQuadrupleAction g q 0).2 := by + cases hrev : BandPackingSymmetryReversesOrientation g <;> + fin_cases i <;> + simp [hrev, BandPackingSymmetryQuadrupleAction] <;> + congr 1 + _ = 2 * (epsilon * _) * _ := by + rw [← incomingProduct.2, hspatial.1, incomingAffine.1] + ) + +private theorem unitCancel : + (by + classical + exact + ∀ (V : GaussianInt), ∀ (A : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d + : GaussianInt), V ≠ 0 → c * d = 1 → 2 * V * A = 2 * (c * V) * b → b = d * A ) := by + classical + intro V A b c d hV hcd hp + have htwo : (2 : GaussianInt) * V ≠ 0 := mul_ne_zero (by norm_num) hV + have hh : ((2 : GaussianInt) * V) * (c * b) = + ((2 : GaussianInt) * V) * A := by + calc + ((2 : GaussianInt) * V) * (c * b) = 2 * (c * V) * b := by ring + _ = 2 * V * A := hp.symm + _ = ((2 : GaussianInt) * V) * A := by ring + have hh' := mul_left_cancel₀ htwo hh + have hdc : d * c = 1 := by simpa [mul_comm] using hcd + calc + b = 1 * b := by simp + _ = (d * c) * b := by rw [hdc] + _ = d * (c * b) := by ring + _ = d * A := by rw [hh'] + +private theorem hjkAt434 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), ∀ (i + : Fin (3 : ℕ)), + let epsilon : GaussianInt := if negative then -1 else 1 + (BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) ^ (2 : ℕ) = + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).1 • + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + = true then -i else i).succ).2 - (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ).1 • + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2 ∧ (2 : GaussianInt) * + BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) * BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + = true then -i else i).succ) (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : + ℕ))) = (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ).2 + + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2) → + (((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = + BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) ∧ + Zsqrtd.norm (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 + : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = (q i.succ).1 + + (q (0 : Fin (4 : ℕ))).1 ∧ (2 : GaussianInt) * (BandPackingSymmetryAffineVectorAction + g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : + Fin (4 : ℕ))))).1 * (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2 = + (BandPackingSymmetryCircleAction g (q i.succ)).2 + (BandPackingSymmetryCircleAction g + (q (0 : Fin (4 : ℕ)))).2) → ((BandVectors.2 (BandPackingSymmetryQuadrupleAction g q + (if BandPackingSymmetryReversesOrientation g = true then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = epsilon * + (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2) → (((BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (-i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = if negative = true then + -BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + else BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))))) ∧ (BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q (-i).succ) = -if negative = true then + -BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) + else BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + i.succ))) ∧ BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ) = + if negative = true then -GaussianQuarterTurn (BandPackingSymmetryVectorAction g + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))) + else GaussianQuarterTurn (BandPackingSymmetryVectorAction g (BandVectors.1 (q (i + (2 + : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)))) → ( + let j : Fin 4 := (i + 2).succ + let k : Fin 4 := (i + 1).succ + j ≠ k)))) ) := by + classical + intro g q negative i epsilon incomingProduct incomingAffine incomingSlope hspatial j k + dsimp [j, k] + fin_cases i <;> simp + +private theorem hprodAt446 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), + (BandPackingSymmetryScopedPhase g q negative) → (∀ (i : Fin (3 : ℕ)), + let epsilon : GaussianInt := if negative then -1 else 1 + (epsilon * epsilon = 1) → ((∀ (V : GaussianInt), ∀ (A : GaussianInt), ∀ (b : + GaussianInt), V ≠ 0 → 2 * V * A = 2 * (epsilon * V) * b → b = epsilon * A) → + ((BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) ^ (2 : ℕ) = + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).1 • + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + = true then -i else i).succ).2 - (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ).1 • + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2 ∧ (2 : GaussianInt) * + BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) * BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + = true then -i else i).succ) (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : + ℕ))) = (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ).2 + + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2) → + (((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = + BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) ∧ + Zsqrtd.norm (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 + : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = (q i.succ).1 + + (q (0 : Fin (4 : ℕ))).1 ∧ (2 : GaussianInt) * (BandPackingSymmetryAffineVectorAction + g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : + Fin (4 : ℕ))))).1 * (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2 = + (BandPackingSymmetryCircleAction g (q i.succ)).2 + (BandPackingSymmetryCircleAction g + (q (0 : Fin (4 : ℕ)))).2) → ((BandVectors.2 (BandPackingSymmetryQuadrupleAction g q + (if BandPackingSymmetryReversesOrientation g = true then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = epsilon * + (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2) → + ((BandPackingSymmetryReversesOrientation g = true) → (((BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (-i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = if negative = true then + -BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + else BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))))) ∧ (BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q (-i).succ) = -if negative = true then + -BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) + else BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + i.succ))) ∧ BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ) = + if negative = true then -GaussianQuarterTurn (BandPackingSymmetryVectorAction g + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))) + else GaussianQuarterTurn (BandPackingSymmetryVectorAction g (BandVectors.1 (q (i + (2 + : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)))) → ( + let j : Fin 4 := (i + 2).succ + let k : Fin 4 := (i + 1).succ + let V := (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).1 + let A := (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).2 + (j ≠ k) → (((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) (q k), + BandVectors.2 (q j) (q k))).1 = BandPackingSymmetryVectorAction g (BandVectors.1 (q + j) (q k)) ∧ Zsqrtd.norm (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) + (q k), BandVectors.2 (q j) (q k))).1 = (q j).1 + (q k).1 ∧ (2 : GaussianInt) * + (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) (q k), BandVectors.2 (q + j) (q k))).1 * (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) (q k), + BandVectors.2 (q j) (q k))).2 = (BandPackingSymmetryCircleAction g (q j)).2 + + (BandPackingSymmetryCircleAction g (q k)).2) → ((BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 : ℕ))).succ) + (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ) ^ (2 : ℕ) = + (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ).1 • + (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 : ℕ))).succ).2 - + (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 : ℕ))).succ).1 • + (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ).2 ∧ (2 : + GaussianInt) * BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin + (3 : ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : + ℕ))).succ) * BandVectors.2 (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 + : ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ) = + (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 : ℕ))).succ).2 + + (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ).2) → (2 * V * + A = 2 * (epsilon * GaussianQuarterTurn V) * (BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q (-i + 2).succ) + (BandPackingSymmetryQuadrupleAction g q (-i + 1).succ))))))))))))) ) := by + classical + intro g q negative hphase i epsilon epsilonSquare slopeCancel incomingProduct incomingAffine + incomingSlope hrev hspatial j k V A hjk aff prod + calc + 2 * V * A = (BandPackingSymmetryCircleAction g (q j)).2 + + (BandPackingSymmetryCircleAction g (q k)).2 := aff.2.2 + _ = (BandPackingSymmetryQuadrupleAction g q (-i + 2).succ).2 + + (BandPackingSymmetryQuadrupleAction g q (-i + 1).succ).2 := by + fin_cases i + · have firstIndex : (-(0 : Fin 3) + 2) = 2 := by decide + have secondIndex : (-(0 : Fin 3) + 1) = 1 := by decide + have negativeOne : (-(1 : Fin 3)) = 2 := by decide + have negativeTwo : (-(2 : Fin 3)) = 1 := by decide + simp [j, k, BandPackingSymmetryQuadrupleAction, hrev, + negativeOne, negativeTwo]; ring + · have firstIndex : (-(1 : Fin 3) + 2) = 1 := by decide + have secondIndex : (-(1 : Fin 3) + 1) = 0 := by decide + have negativeOne : (-(1 : Fin 3)) = 2 := by decide + simp [j, k, BandPackingSymmetryQuadrupleAction, hrev, + negativeOne]; ring + · have firstIndex : (-(2 : Fin 3) + 2) = 0 := by decide + have secondIndex : (-(2 : Fin 3) + 1) = 2 := by decide + have negativeTwo : (-(2 : Fin 3)) = 1 := by decide + simp [j, k, BandPackingSymmetryQuadrupleAction, hrev, + negativeTwo]; ring + _ = 2 * (epsilon * GaussianQuarterTurn V) * _ := by + rw [← prod.2] + let W := GaussianQuarterTurn (BandPackingSymmetryVectorAction g + (BandVectors.1 (q (i + 2).succ) (q (i + 1).succ))) + have hf : (if negative then -W else W) = + epsilon * GaussianQuarterTurn V := by + have hqv : GaussianQuarterTurn + (BandPackingSymmetryVectorAction g + (BandVectors.1 (q (i + 2).succ) (q (i + 1).succ))) = + GaussianQuarterTurn V := by + congr 1 + simpa [V] using aff.1.symm + dsimp [W] + rw [hqv] + cases negative <;> simp [epsilon] + rw [hspatial.2.2] + rw [hf] + +private theorem hu : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), + (BandPackingSymmetryScopedPhase g q negative) → (∀ (i : Fin (3 : ℕ)), + let epsilon : GaussianInt := if negative then -1 else 1 + (epsilon * epsilon = 1) → ((∀ (V : GaussianInt), ∀ (A : GaussianInt), ∀ (b : + GaussianInt), V ≠ 0 → 2 * V * A = 2 * (epsilon * V) * b → b = epsilon * A) → + ((BandVectors.2 (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = epsilon * + (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2) → (((BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (-i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = if negative = true then + -BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + else BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))))) ∧ (BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q (-i).succ) = -if negative = true then + -BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) + else BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + i.succ))) ∧ BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ) = + if negative = true then -GaussianQuarterTurn (BandPackingSymmetryVectorAction g + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))) + else GaussianQuarterTurn (BandPackingSymmetryVectorAction g (BandVectors.1 (q (i + (2 + : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)))) → ( + let j : Fin 4 := (i + 2).succ + let k : Fin 4 := (i + 1).succ + let V := (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).1 + let A := (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).2 + (2 * V * A = 2 * (epsilon * GaussianQuarterTurn V) * (BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q (-i + 2).succ) + (BandPackingSymmetryQuadrupleAction g q (-i + 1).succ))) → ((epsilon * + GaussianQuarterTurn 1) * (-epsilon * GaussianQuarterTurn 1) = 1)))))) ) := by + classical + intro g q negative hphase i epsilon epsilonSquare slopeCancel incomingSlope hspatial j k V A hprod + cases negative <;> ext <;> norm_num [epsilon, GaussianQuarterTurn] + +private theorem quarterMul : + (by + classical + exact + ∀ z : GaussianInt, GaussianQuarterTurn z = GaussianQuarterTurn 1 * z ) := by + classical + intro z + ext <;> simp [GaussianQuarterTurn] + +private theorem slopeIndex : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let j : Fin 4 := (i + 2).succ + let k : Fin 4 := (i + 1).succ + let A := (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).2 + (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + 2).succ) (q (i + + 1).succ), BandVectors.2 (q (i + 2).succ) (q (i + 1).succ))).2 = A ) := by + classical + intro g q i j k A + rfl + +private theorem hjkAt531 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), ∀ (i + : Fin (3 : ℕ)), + let epsilon : GaussianInt := if negative then -1 else 1 + (BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) ^ (2 : ℕ) = + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).1 • + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + = true then -i else i).succ).2 - (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ).1 • + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2 ∧ (2 : GaussianInt) * + BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) * BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + = true then -i else i).succ) (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : + ℕ))) = (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ).2 + + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2) → + (((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = + BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) ∧ + Zsqrtd.norm (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 + : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = (q i.succ).1 + + (q (0 : Fin (4 : ℕ))).1 ∧ (2 : GaussianInt) * (BandPackingSymmetryAffineVectorAction + g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : + Fin (4 : ℕ))))).1 * (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2 = + (BandPackingSymmetryCircleAction g (q i.succ)).2 + (BandPackingSymmetryCircleAction g + (q (0 : Fin (4 : ℕ)))).2) → ((BandVectors.2 (BandPackingSymmetryQuadrupleAction g q + (if BandPackingSymmetryReversesOrientation g = true then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = epsilon * + (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2) → (((BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q i.succ) (BandPackingSymmetryQuadrupleAction g + q (0 : Fin (4 : ℕ))) = if negative = true then -BandPackingSymmetryVectorAction g + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) else BandPackingSymmetryVectorAction + g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) ∧ (BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q i.succ) = if negative = true then + -BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) + else BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + i.succ))) ∧ BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ) = if + negative = true then -BandPackingSymmetryVectorAction g (BandVectors.1 (q (i + (2 : + Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) else + BandPackingSymmetryVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q + (i + (1 : Fin (3 : ℕ))).succ))) → ( + let j : Fin 4 := (i + 2).succ + let k : Fin 4 := (i + 1).succ + j ≠ k)))) ) := by + classical + intro g q negative i epsilon incomingProduct incomingAffine incomingSlope hspatial j k + dsimp [j, k] + fin_cases i <;> simp + +private theorem hprodAt542 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), + (BandPackingSymmetryScopedPhase g q negative) → (∀ (i : Fin (3 : ℕ)), + let epsilon : GaussianInt := if negative then -1 else 1 + (epsilon * epsilon = 1) → ((∀ (V : GaussianInt), ∀ (A : GaussianInt), ∀ (b : + GaussianInt), V ≠ 0 → 2 * V * A = 2 * (epsilon * V) * b → b = epsilon * A) → + ((BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) ^ (2 : ℕ) = + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).1 • + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + = true then -i else i).succ).2 - (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ).1 • + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2 ∧ (2 : GaussianInt) * + BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) * BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + = true then -i else i).succ) (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : + ℕ))) = (BandPackingSymmetryQuadrupleAction g q (if + BandPackingSymmetryReversesOrientation g = true then -i else i).succ).2 + + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2) → + (((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = + BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) ∧ + Zsqrtd.norm (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 + : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = (q i.succ).1 + + (q (0 : Fin (4 : ℕ))).1 ∧ (2 : GaussianInt) * (BandPackingSymmetryAffineVectorAction + g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : + Fin (4 : ℕ))))).1 * (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2 = + (BandPackingSymmetryCircleAction g (q i.succ)).2 + (BandPackingSymmetryCircleAction g + (q (0 : Fin (4 : ℕ)))).2) → ((BandVectors.2 (BandPackingSymmetryQuadrupleAction g q + (if BandPackingSymmetryReversesOrientation g = true then -i else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = epsilon * + (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2) → + ((¬BandPackingSymmetryReversesOrientation g = true) → (((BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q i.succ) (BandPackingSymmetryQuadrupleAction g + q (0 : Fin (4 : ℕ))) = if negative = true then -BandPackingSymmetryVectorAction g + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) else BandPackingSymmetryVectorAction + g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) ∧ (BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q i.succ) = if negative = true then + -BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) + else BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + i.succ))) ∧ BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ) = if + negative = true then -BandPackingSymmetryVectorAction g (BandVectors.1 (q (i + (2 : + Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) else + BandPackingSymmetryVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q + (i + (1 : Fin (3 : ℕ))).succ))) → ( + let j : Fin 4 := (i + 2).succ + let k : Fin 4 := (i + 1).succ + let V := (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).1 + let A := (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).2 + (j ≠ k) → (((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) (q k), + BandVectors.2 (q j) (q k))).1 = BandPackingSymmetryVectorAction g (BandVectors.1 (q + j) (q k)) ∧ Zsqrtd.norm (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) + (q k), BandVectors.2 (q j) (q k))).1 = (q j).1 + (q k).1 ∧ (2 : GaussianInt) * + (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) (q k), BandVectors.2 (q + j) (q k))).1 * (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) (q k), + BandVectors.2 (q j) (q k))).2 = (BandPackingSymmetryCircleAction g (q j)).2 + + (BandPackingSymmetryCircleAction g (q k)).2) → ((BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 : ℕ))).succ) + (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ) ^ (2 : ℕ) = + (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ).1 • + (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 : ℕ))).succ).2 - + (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 : ℕ))).succ).1 • + (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ).2 ∧ (2 : + GaussianInt) * BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 + : ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ) * + BandVectors.2 (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 : ℕ))).succ) + (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ) = + (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 : ℕ))).succ).2 + + (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ).2) → (2 * V * A + = 2 * (epsilon * V) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction g q (i + + 2).succ) (BandPackingSymmetryQuadrupleAction g q (i + 1).succ))))))))))))) ) := by + classical + intro g q negative hphase i epsilon epsilonSquare slopeCancel incomingProduct incomingAffine + incomingSlope hrev hspatial j k V A hjk aff prod + calc + 2 * V * A = (BandPackingSymmetryCircleAction g (q j)).2 + + (BandPackingSymmetryCircleAction g (q k)).2 := aff.2.2 + _ = (BandPackingSymmetryQuadrupleAction g q (i + 2).succ).2 + + (BandPackingSymmetryQuadrupleAction g q (i + 1).succ).2 := by + fin_cases i <;> simp [j, k, BandPackingSymmetryQuadrupleAction, hrev, + ] + _ = 2 * (epsilon * V) * _ := by + rw [← prod.2] + have hf : ((if negative then + -BandPackingSymmetryVectorAction g + (BandVectors.1 (q (i + 2).succ) (q (i + 1).succ)) + else BandPackingSymmetryVectorAction g + (BandVectors.1 (q (i + 2).succ) (q (i + 1).succ)))) = + epsilon * V := by + have hv' : BandPackingSymmetryVectorAction g + (BandVectors.1 (q (i + 2).succ) (q (i + 1).succ)) = V := by + simpa [V, j, k] using aff.1.symm + rw [hv'] + cases negative <;> simp [epsilon] + rw [hspatial.2.2] + rw [hf] + +end AffineSymmetryCoordinates + +theorem BandPackingSymmetryAffineVectorCovariance + (g : BandPackingSymmetry) (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) : + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun i => + if BandPackingSymmetryReversesOrientation g then -i else i + ∃ negative : Bool, + BandPackingSymmetryScopedPhase g q negative ∧ + ∀ i : Fin 3, + let e : GaussianInt := if negative then -1 else 1 + let incoming := BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q i.succ) (q 0), + BandVectors.2 (q i.succ) (q 0)) + let cyclic := BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)), + BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ))) + BandVectors.2 (q' (sigma i).succ) (q' 0) = e * incoming.2 ∧ + BandVectors.2 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) = + e * (if BandPackingSymmetryReversesOrientation g then + -GaussianQuarterTurn cyclic.2 else cyclic.2) := by +-- BODY + dsimp + have circleCurvature := AffineSymmetryCoordinates.circleCurvature + have affineFacts : ∀ (h : BandPackingSymmetry) (D E : CircleCoordinates) + (v a : GaussianInt), + Zsqrtd.norm v = D.1 + E.1 → 2 * v * a = D.2 + E.2 → + (BandPackingSymmetryAffineVectorAction h (v, a)).1 = + BandPackingSymmetryVectorAction h v ∧ + Zsqrtd.norm (BandPackingSymmetryAffineVectorAction h (v, a)).1 = D.1 + E.1 ∧ + 2 * (BandPackingSymmetryAffineVectorAction h (v, a)).1 * + (BandPackingSymmetryAffineVectorAction h (v, a)).2 = + (BandPackingSymmetryCircleAction h D).2 + + (BandPackingSymmetryCircleAction h E).2 := AffineSymmetryCoordinates.affineFacts + circleCurvature + obtain ⟨negative, hphase, _⟩ := + BandPackingSymmetryProjectiveVectorCovariance g q hq + refine ⟨negative, hphase, ?_⟩ + intro i + let epsilon : GaussianInt := if negative then -1 else 1 + have epsilonSquare : epsilon * epsilon = 1 := AffineSymmetryCoordinates.epsilonSquare negative + have slopeCancel : ∀ (V A b : GaussianInt), + V ≠ 0 → 2 * V * A = 2 * (epsilon * V) * b → b = epsilon * A := + AffineSymmetryCoordinates.slopeCancel negative epsilonSquare + have sourceNorm : ∀ (i j : Fin 4), i ≠ j → + 0 < (q i).1 + (q j).1 → + Zsqrtd.norm (BandVectors.1 (q i) (q j)) = (q i).1 + (q j).1 := + AffineSymmetryCoordinates.sourceNorm q hq + have parentPositive : ∀ (r s : Fin 3), r ≠ s → + 0 < (q r.succ).1 + (q s.succ).1 := AffineSymmetryCoordinates.parentPositive q hq + have incomingFacts := AffineSymmetryCoordinates.incomingFacts g q hq affineFacts sourceNorm + have cyclicFacts : ∀ (j k : Fin 4), j ≠ k → + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).1 ≠ 0 := + AffineSymmetryCoordinates.cyclicFacts g q hq affineFacts sourceNorm + have hproper := BandPackingSymmetryProperCovariance g q hq + have hspatial := hphase i + have incomingProduct := + VectorSquareProduct (BandPackingSymmetryQuadrupleAction g q) hproper.1 + ((if BandPackingSymmetryReversesOrientation g then -i else i).succ) 0 (by + fin_cases i <;> simp) + have incomingAffine := affineFacts g (q i.succ) (q 0) + (BandVectors.1 (q i.succ) (q 0)) (BandVectors.2 (q i.succ) (q 0)) + (sourceNorm i.succ 0 (by simp) (by + have hc := ProperBandCurvatureStructure q hq + have hn := hc.2.1 i + omega)) + (VectorSquareProduct q hq.1 i.succ 0 (by simp)).2 + have incomingSlope := AffineSymmetryCoordinates.incomingSlope g q negative i slopeCancel + incomingFacts hspatial incomingProduct incomingAffine + refine ⟨?_, ?_⟩ + · simpa [epsilon] using incomingSlope + · have unitCancel : ∀ (V A b c d : GaussianInt), + V ≠ 0 → c * d = 1 → 2 * V * A = 2 * (c * V) * b → + b = d * A := AffineSymmetryCoordinates.unitCancel + by_cases hrev : BandPackingSymmetryReversesOrientation g = true + · simp? [hrev] at hspatial + let j : Fin 4 := (i + 2).succ + let k : Fin 4 := (i + 1).succ + let V := (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).1 + let A := (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).2 + have hjk : j ≠ k := AffineSymmetryCoordinates.hjkAt434 g q negative i incomingProduct + incomingAffine incomingSlope hspatial + have aff := affineFacts g (q j) (q k) + (BandVectors.1 (q j) (q k)) (BandVectors.2 (q j) (q k)) + (sourceNorm j k hjk (by + dsimp [j, k] + exact parentPositive (i + 2) (i + 1) (by fin_cases i <;> simp))) + (VectorSquareProduct q hq.1 j k hjk).2 + have prod := VectorSquareProduct (BandPackingSymmetryQuadrupleAction g q) + hproper.1 ((-i + 2).succ) ((-i + 1).succ) (by + fin_cases i <;> decide) + have hprod : 2 * V * A = + 2 * (epsilon * GaussianQuarterTurn V) * + (BandVectors.2 (BandPackingSymmetryQuadrupleAction g q + (-i + 2).succ) (BandPackingSymmetryQuadrupleAction g q + (-i + 1).succ)) := AffineSymmetryCoordinates.hprodAt446 g q negative hphase i + epsilonSquare slopeCancel incomingProduct incomingAffine incomingSlope hrev + hspatial hjk aff prod + have hv : V ≠ 0 := by + exact cyclicFacts j k hjk + have hu : (epsilon * GaussianQuarterTurn 1) * + (-epsilon * GaussianQuarterTurn 1) = 1 := AffineSymmetryCoordinates.hu g q negative + hphase i epsilonSquare slopeCancel incomingSlope hspatial hprod + have qmul : GaussianQuarterTurn V = GaussianQuarterTurn 1 * V := by + ext <;> simp [GaussianQuarterTurn] + have quarterMul : ∀ z : GaussianInt, + GaussianQuarterTurn z = GaussianQuarterTurn 1 * z := AffineSymmetryCoordinates.quarterMul + have final := unitCancel V A + (BandVectors.2 (BandPackingSymmetryQuadrupleAction g q + (-i + 2).succ) (BandPackingSymmetryQuadrupleAction g q + (-i + 1).succ)) + (epsilon * GaussianQuarterTurn 1) (-epsilon * GaussianQuarterTurn 1) + hv hu (by simpa [qmul, mul_assoc, mul_left_comm, mul_comm] using hprod) + have hi1 : ((if BandPackingSymmetryReversesOrientation g then -i else i) + 2).succ = + (-i + 2).succ := by simp [hrev] + have hi2 : ((if BandPackingSymmetryReversesOrientation g then -i else i) + 1).succ = + (-i + 1).succ := by simp [hrev] + rw [hi1, hi2] + have slopeIndex : + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q (i + 2).succ) (q (i + 1).succ), + BandVectors.2 (q (i + 2).succ) (q (i + 1).succ))).2 = A := + AffineSymmetryCoordinates.slopeIndex g q i + rw [slopeIndex] + cases negative <;> simp? [epsilon, hrev, j, + mul_comm] at final ⊢ + · rw [quarterMul A] + exact final + · rw [quarterMul A] + exact final + · simp? [hrev] at hspatial + let j : Fin 4 := (i + 2).succ + let k : Fin 4 := (i + 1).succ + let V := (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).1 + let A := (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).2 + have hjk : j ≠ k := AffineSymmetryCoordinates.hjkAt531 g q negative i incomingProduct + incomingAffine incomingSlope hspatial + have aff := affineFacts g (q j) (q k) + (BandVectors.1 (q j) (q k)) (BandVectors.2 (q j) (q k)) + (sourceNorm j k hjk (by + dsimp [j, k] + exact parentPositive (i + 2) (i + 1) (by fin_cases i <;> simp))) + (VectorSquareProduct q hq.1 j k hjk).2 + have prod := VectorSquareProduct (BandPackingSymmetryQuadrupleAction g q) + hproper.1 (i + 2).succ (i + 1).succ (by fin_cases i <;> decide) + have hprod : 2 * V * A = + 2 * (epsilon * V) * + (BandVectors.2 (BandPackingSymmetryQuadrupleAction g q + (i + 2).succ) (BandPackingSymmetryQuadrupleAction g q + (i + 1).succ)) := AffineSymmetryCoordinates.hprodAt542 g q negative hphase i + epsilonSquare slopeCancel incomingProduct incomingAffine incomingSlope hrev + hspatial hjk aff prod + have final := slopeCancel V A + (BandVectors.2 (BandPackingSymmetryQuadrupleAction g q + (i + 2).succ) (BandPackingSymmetryQuadrupleAction g q + (i + 1).succ)) (cyclicFacts j k hjk) hprod + have hi1 : ((if BandPackingSymmetryReversesOrientation g then -i else i) + 2).succ = + (i + 2).succ := by simp [hrev] + have hi2 : ((if BandPackingSymmetryReversesOrientation g then -i else i) + 1).succ = + (i + 1).succ := by simp [hrev] + rw [hi1, hi2] + cases negative <;> simp? [epsilon, hrev] at final ⊢ + · exact final + · exact final + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCircleAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCircleAction.lean new file mode 100644 index 0000000000..b7f84d4544 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCircleAction.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates +public import LeanPool.ApollonianSuperharmonic.GaussianReflection + +-- [TABLET NODE: BandPackingSymmetryCircleAction] + +/-! +# BandPackingSymmetryCircleAction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The action of a band-packing symmetry word on curvature coordinates is +defined on generators by +$$ + C\mapsto C,\qquad (c,z)\mapsto(c,-z),\qquad + (c,z)\mapsto(c,\overline z),\qquad + (c,z)\mapsto(c,z+2cw), +$$ +and composition acts by function composition, with the right-hand word +acting first. In particular every symmetry preserves curvature. +-/ +def BandPackingSymmetryCircleAction : + BandPackingSymmetry → CircleCoordinates → CircleCoordinates := +-- BODY + fun g C => match g with + | .identity => C + | .negate => (C.1, -C.2) + | .conjugate => (C.1, GaussianReflection C.2) + | .shift w => (C.1, C.2 + 2 * (C.1 : GaussianInt) * w) + | .comp g h => + BandPackingSymmetryCircleAction g + (BandPackingSymmetryCircleAction h C) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCovariance.lean new file mode 100644 index 0000000000..42ab2af0c4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCovariance.lean @@ -0,0 +1,819 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas + +-- [TABLET NODE: BandPackingSymmetryCovariance] + +/-! +# BandPackingSymmetryCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SymmetryCovarianceProof + +private theorem rsub : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (h : BandPackingSymmetry), ∀ (p : ℝ × ℝ), ∀ (t : ℝ × ℝ), R h (p - t) = R h p - R h t ) + := by + classical + intro R h p t + induction h generalizing p t with + | identity => rfl + | negate => ext <;> simp [R]; ring + | conjugate => ext <;> simp [R]; ring + | shift w => rfl + | comp h k ih ik => simp [R, ih, ik] + +private theorem rsmul : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (h : BandPackingSymmetry), ∀ (c : ℝ), ∀ (p : ℝ × ℝ), R h (c • p) = c • R h p ) := by + classical + intro R h c p + induction h generalizing p with + | identity => rfl + | negate => ext <;> simp [R] + | conjugate => ext <;> simp [R] + | shift w => rfl + | comp h k ih ik => simp [R, ih, ik] + +private theorem rneg : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + (∀ (h : BandPackingSymmetry), ∀ (c : Real), ∀ (p : Real × Real), R h (c • p) = c • R h p) + → (∀ (h : BandPackingSymmetry), ∀ (p : ℝ × ℝ), R h (-p) = -R h p) ) := by + classical + intro R rsmul h p + simpa using rsmul h (-1) p + +private theorem rpoint : + (by + classical + exact + let L := BandPackingSymmetryVectorAction + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (h : BandPackingSymmetry), ∀ (w : GaussianInt), R h (GaussianRealPoint w) = + GaussianRealPoint (L h w) ) := by + classical + intro L R h w + induction h generalizing w with + | identity => rfl + | negate => simp [R, L, BandPackingSymmetryVectorAction, + GaussianRealPoint, GaussianQuarterTurn] + | conjugate => simp [R, L, BandPackingSymmetryVectorAction, + GaussianRealPoint, GaussianReflection] + | shift w => rfl + | comp h k ih ik => simp [R, L, BandPackingSymmetryVectorAction, ih, ik] + +private theorem rminusq : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + (∀ (h : BandPackingSymmetry), ∀ (p : Real × Real), R h (-p) = -R h p) → (∀ (h : + BandPackingSymmetry), ∀ (p : ℝ × ℝ), R h (p.2, -p.1) = -R h (-p.2, p.1)) ) := by + classical + intro R rneg h p + rw [show (p.2, -p.1) = -(-p.2, p.1) by simp, rneg] + +private theorem rq : + (by + classical + exact + let O := BandPackingSymmetryReversesOrientation + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + (∀ (h : BandPackingSymmetry), ∀ (p : Real × Real), R h (p.2, -p.1) = -R h (-p.2, p.1)) → + (∀ (h : BandPackingSymmetry), ∀ (p : ℝ × ℝ), R h (-p.2, p.1) = if O h = true then + -(-(R h p).2, (R h p).1) else (-(R h p).2, (R h p).1)) ) := by + classical + intro O R rminusq h p + induction h generalizing p with + | identity => rfl + | negate => simp [R, O, BandPackingSymmetryReversesOrientation] + | conjugate => simp [R, O, BandPackingSymmetryReversesOrientation] + | shift w => rfl + | comp h k ih ik => + change R h (R k (-p.2, p.1)) = + if xor (O h) (O k) then -(-(R h (R k p)).2, (R h (R k p)).1) + else (-(R h (R k p)).2, (R h (R k p)).1) + rw [ik] + cases hh : O h <;> cases hk : O k <;> simp [hh, rminusq, ih] + +private theorem rd : + (by + classical + exact + let L := BandPackingSymmetryVectorAction + let O := BandPackingSymmetryReversesOrientation + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + let D : GaussianInt → Real × Real := fun w => + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + (∀ (h : BandPackingSymmetry), ∀ (p : Real × Real), ∀ (t : Real × Real), R h (p - t) = R h + p - R h t) → ((∀ (h : BandPackingSymmetry), ∀ (c : Real), ∀ (p : Real × Real), R h (c + • p) = c • R h p) → ((∀ (h : BandPackingSymmetry), ∀ (w : GaussianInt), R h + (GaussianRealPoint w) = GaussianRealPoint (L h w)) → ((∀ (h : BandPackingSymmetry), ∀ + (p : Real × Real), R h (-p.2, p.1) = if O h then -(-(R h p).2, (R h p).1) else (-(R h + p).2, (R h p).1)) → (∀ (h : BandPackingSymmetry), ∀ (w : GaussianInt), R h (D w) = D + (if O h = true then GaussianQuarterTurn (L h w) else L h w))))) ) := by + classical + intro L O R D rsub rsmul rpoint rq h w + dsimp [D] + rw [rsmul, rsub, rq, rpoint] + cases hh : O h <;> ext <;> + simp [GaussianRealPoint, GaussianQuarterTurn] <;> ring + +private theorem dsign : + (by + classical + exact + let D : GaussianInt → Real × Real := fun w => + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + ∀ (d : Bool), ∀ (w : GaussianInt), D ((if d = true then (-1 : GaussianInt) else (1 : + GaussianInt)) * w) = (if d = true then (-1 : ℝ) else (1 : ℝ)) • D w ) := by + classical + intro D d w + cases d <;> ext <;> simp [D, GaussianRealPoint] <;> ring + +private theorem grids : + (by + classical + exact + let B := BandPackingSymmetryTileAction + let L := BandPackingSymmetryVectorAction + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (h : BandPackingSymmetry), ∃ (b : GaussianInt → GaussianInt), ∀ (T : ProtoTile), (B h + T).cells = Finset.image b T.cells ∧ (B h T).anchor = L h T.anchor ∧ FootprintVertices + (B h T) = L h '' FootprintVertices T ∧ TileCentroid (B h T) = R h (TileCentroid T) ) + := by + classical + intro B L R h + induction h with + | identity => + refine ⟨id, fun T => ?_⟩ + simp [B, L, R, BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + | negate => + refine ⟨fun x => GaussianQuarterTurn x - 1, fun T => ?_⟩ + have ht := TileQuarterTurnFormulas T + exact ⟨ht.1, ht.2.1, ht.2.2.2.2.2.1, ht.2.2.2.2.1⟩ + | conjugate => + refine ⟨fun x => GaussianQuarterTurn + (GaussianQuarterTurn (GaussianReflection x - ⟨0, 1⟩) - 1) - 1, + fun T => ?_⟩ + have hr := TileReflectionFormulas T + have hq := TileQuarterTurnFormulas (TileReflection T) + have hqq := TileQuarterTurnFormulas (TileQuarterTurn (TileReflection T)) + change _ = _ ∧ _ = _ ∧ _ = _ ∧ _ = _ + refine ⟨?_, ?_, ?_, ?_⟩ + · simp only [B, BandPackingSymmetryTileAction, hqq.1, hq.1, hr.1, + Finset.image_image, Function.comp_def] + · ext <;> simp [B, L, BandPackingSymmetryTileAction, + BandPackingSymmetryVectorAction, TileQuarterTurn, TileReflection, + GaussianQuarterTurn, GaussianReflection] + · simp only [B, BandPackingSymmetryTileAction, + hqq.2.2.2.2.2.1, hq.2.2.2.2.2.1, hr.2.2.2.2.2.1, Set.image_image] + congr 1 + · simp [B, R, BandPackingSymmetryTileAction, + hqq.2.2.2.2.1, hq.2.2.2.2.1, hr.2.2.2.2.1] + | shift w => + refine ⟨id, fun T => ?_⟩ + simp [B, L, R, BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + | comp h k ih ik => + obtain ⟨b, hb⟩ := ih + obtain ⟨c, hc⟩ := ik + refine ⟨b ∘ c, fun T => ?_⟩ + have ht := hb (B k T) + have kt := hc T + simp [B, L, R, BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction, + ht.1, ht.2.1, ht.2.2.1, ht.2.2.2, kt.1, kt.2.1, kt.2.2.1, kt.2.2.2, + Finset.image_image, Set.image_image] + +private theorem sigmaInv : + (by + classical + exact + let O := BandPackingSymmetryReversesOrientation + let sigma (h : BandPackingSymmetry) (i : Fin 3) : Fin 3 := + if O h then -i else i + ∀ (h : BandPackingSymmetry), ∀ (i : Fin (3 : ℕ)), sigma h (sigma h i) = i ) := by + classical + intro O sigma h i + cases hh : O h <;> simp [sigma, hh] + +private theorem parent : + (by + classical + exact + let A := BandPackingSymmetryCircleAction + let O := BandPackingSymmetryReversesOrientation + let Q := BandPackingSymmetryQuadrupleAction + let sigma (h : BandPackingSymmetry) (i : Fin 3) : Fin 3 := + if O h then -i else i + ∀ (h : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : + ℕ)), Q h q (sigma h i).succ = A h (q i.succ) ) := by + classical + intro A O Q sigma h q i + have neg1 : -(1 : Fin 3) = 2 := rfl + have neg2 : -(2 : Fin 3) = 1 := rfl + cases hh : O h <;> fin_cases i <;> + simp [Q, sigma, A, O, BandPackingSymmetryQuadrupleAction, hh, neg1, neg2] + +private theorem transport : + (by + classical + exact + let A := BandPackingSymmetryCircleAction + let B := BandPackingSymmetryTileAction + let L := BandPackingSymmetryVectorAction + let O := BandPackingSymmetryReversesOrientation + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + let D : GaussianInt → Real × Real := fun w => + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + (∀ (h : BandPackingSymmetry), ∀ (p : Real × Real), ∀ (t : Real × Real), R h (p - t) = R h + p - R h t) → ((∀ (h : BandPackingSymmetry), ∀ (c : Real), ∀ (p : Real × Real), R h (c + • p) = c • R h p) → ((∀ (h : BandPackingSymmetry), ∀ (w : GaussianInt), R h (D w) = D + (if O h then GaussianQuarterTurn (L h w) else L h w)) → ((∀ (d : Bool), ∀ (w : + GaussianInt), D ((if d then (-1 : GaussianInt) else 1) * w) = (if d then (-1 : Real) + else 1) • D w) → ((∀ (h : BandPackingSymmetry), ∃ b : GaussianInt → GaussianInt, ∀ T + : ProtoTile, (B h T).cells = T.cells.image b ∧ (B h T).anchor = L h T.anchor ∧ + FootprintVertices (B h T) = L h '' FootprintVertices T ∧ TileCentroid (B h T) = R h + (TileCentroid T)) → ( + let Q := BandPackingSymmetryQuadrupleAction + let sigma (h : BandPackingSymmetry) (i : Fin 3) : Fin 3 := + if O h then -i else i + (∀ (h : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), Q h q + (sigma h i).succ = A h (q i.succ)) → (∀ (h : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) + → CircleCoordinates), ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (d : Bool), ∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), BandPackingSymmetryScopedPhase h q d → BandPrototile (A h (q + i.succ)) (B h U) → FootprintVertices U ⊆ FootprintVertices T → TileCentroid U - + TileCentroid T = (if s = true then (1 : ℝ) else (-1 : ℝ)) • D (BandVectors.1 (q (i + + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) → BandSubtileOccurrence (Q + h q) (B h T) (sigma h i) (s ^^ d) (B h U))))))) ) := by + classical + intro A B L O R D rsub rsmul rd dsign grids Q sigma parent h q T U d i s hd hp hf hc + obtain ⟨b, hb⟩ := grids h + refine ⟨?_, ?_, ?_⟩ + · rw [parent] + exact hp + · rw [(hb U).2.2.1, (hb T).2.2.1] + exact Set.image_mono hf + · change TileCentroid (B h U) - TileCentroid (B h T) = + (if xor s d = true then (1 : Real) else -1) • + D (BandVectors.1 (Q h q ((sigma h i + 2).succ)) + (Q h q ((sigma h i + 1).succ))) + rw [(hb U).2.2.2, (hb T).2.2.2, ← rsub, hc, rsmul, rd, + (hd i).2.2, dsign] + cases s <;> cases d <;> simp [L, O] + +private theorem families : + (by + classical + exact + let A := BandPackingSymmetryCircleAction + let B := BandPackingSymmetryTileAction + let L := BandPackingSymmetryVectorAction + let O := BandPackingSymmetryReversesOrientation + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + let D : GaussianInt → Real × Real := fun w => + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + (∀ (h : BandPackingSymmetry), ∃ b : GaussianInt → GaussianInt, ∀ T : ProtoTile, (B h + T).cells = T.cells.image b ∧ (B h T).anchor = L h T.anchor ∧ FootprintVertices (B h + T) = L h '' FootprintVertices T ∧ TileCentroid (B h T) = R h (TileCentroid T)) → ( + let Q := BandPackingSymmetryQuadrupleAction + let sigma (h : BandPackingSymmetry) (i : Fin 3) : Fin 3 := + if O h then -i else i + (∀ (h : BandPackingSymmetry), ∀ (i : Fin 3), sigma h (sigma h i) = i) → ((∀ (h : + BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (U : + ProtoTile), ∀ (d : Bool), ∀ (i : Fin 3), ∀ (s : Bool), + (BandPackingSymmetryScopedPhase h q d) → ((BandPrototile (A h (q i.succ)) (B h U)) → + ((FootprintVertices U ⊆ FootprintVertices T) → ((TileCentroid U - TileCentroid T = + (if s = true then (1 : Real) else -1) • D (BandVectors.1 (q ((i + 2).succ)) (q ((i + + 1).succ)))) → (BandSubtileOccurrence (Q h q) (B h T) (sigma h i) (xor s d) (B h + U)))))) → (∀ (h : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (T + : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ProperBandQuadruple q → (∀ (i : + Fin (3 : ℕ)), ∀ (s : Bool), BandPrototile (A h (q i.succ)) (B h (S i s))) → (∀ (i : + Fin (3 : ℕ)), ∀ (s : Bool), FootprintVertices (S i s) ⊆ FootprintVertices T) → (∀ (i + : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S i s) - TileCentroid T = (if s = true + then (1 : ℝ) else (-1 : ℝ)) • D (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + + (1 : Fin (3 : ℕ))).succ))) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : + ℕ)) (s : Bool), x ∈ (S i s).cells) → ∃ (d : Bool) (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : + ℕ) × Bool) (S' : Fin (3 : ℕ) → Bool → ProtoTile), BandPackingSymmetryScopedPhase h q + d ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) + (i, s) = (sigma h i, s ^^ d)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : + ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × + Bool) (i, s)).2 = B h (S i s)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence (Q h q) (B h T) i s (S' i s)) ∧ ∀ (x : LatticeCell), x ∈ (B h + T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S' i s).cells))) ) := by + classical + intro A B L O R D grids Q sigma sigmaInv transport h q T S hq hp hf hc hu + obtain ⟨d, hd, _⟩ := BandPackingSymmetryProjectiveVectorCovariance h q hq + have labelInv : Function.Involutive (fun p : Fin 3 × Bool => + (sigma h p.1, xor p.2 d)) := by + rintro ⟨i, s⟩ + change (sigma h (sigma h i), xor (xor s d) d) = (i, s) + rw [sigmaInv] + cases s <;> cases d <;> rfl + let e : (Fin 3 × Bool) ≃ (Fin 3 × Bool) := + { toFun := fun p => (sigma h p.1, xor p.2 d) + invFun := fun p => (sigma h p.1, xor p.2 d) + left_inv := labelInv + right_inv := labelInv } + let S' : Fin 3 → Bool → ProtoTile := fun j u => + B h (S (e.symm (j, u)).1 (e.symm (j, u)).2) + have he (i : Fin 3) (s : Bool) : e (i, s) = (sigma h i, xor s d) := rfl + have hs (i : Fin 3) (s : Bool) : + S' (e (i, s)).1 (e (i, s)).2 = B h (S i s) := by + change B h (S (e.symm (e (i, s))).1 (e.symm (e (i, s))).2) = _ + rw [e.symm_apply_apply] + refine ⟨d, e, S', hd, he, hs, ?_, ?_⟩ + · intro j u + obtain ⟨⟨i, s⟩, hij⟩ := e.surjective (j, u) + have ht := transport h q T (S i s) d i s hd (hp i s) (hf i s) (hc i s) + change BandSubtileOccurrence (Q h q) (B h T) + (e (i, s)).1 (e (i, s)).2 (B h (S i s)) at ht + rw [← hs i s, hij] at ht + exact ht + · obtain ⟨b, hb⟩ := grids h + have unionImage (x : GaussianInt) : + x ∈ (B h T).cells ↔ ∃ i s, x ∈ (B h (S i s)).cells := by + rw [(hb T).1] + constructor + · rintro hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx + obtain ⟨i, s, hy⟩ := (hu y).mp hy + refine ⟨i, s, ?_⟩ + rw [(hb (S i s)).1] + exact Finset.mem_image.mpr ⟨y, hy, rfl⟩ + · rintro ⟨i, s, hx⟩ + rw [(hb (S i s)).1] at hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx + exact Finset.mem_image.mpr ⟨y, (hu y).mpr ⟨i, s, hy⟩, rfl⟩ + intro x + rw [unionImage] + constructor + · rintro ⟨i, s, hx⟩ + exact ⟨(e (i, s)).1, (e (i, s)).2, by rw [hs]; exact hx⟩ + · rintro ⟨j, u, hx⟩ + obtain ⟨⟨i, s⟩, hij⟩ := e.surjective (j, u) + refine ⟨i, s, ?_⟩ + rw [← hs i s, hij] + exact hx + +private theorem lineAction : + (by + classical + exact + let A := BandPackingSymmetryCircleAction + ∀ (h : BandPackingSymmetry), ∀ (w : GaussianInt), w = (1 : GaussianInt) ∨ w = (-1 : + GaussianInt) → ∃ (w' : GaussianInt), (w' = (1 : GaussianInt) ∨ w' = (-1 : + GaussianInt)) ∧ A h ((0 : ℤ), w) = ((0 : ℤ), w') ) := by + classical + intro A h w hw + induction h generalizing w with + | identity => exact ⟨w, hw, rfl⟩ + | negate => + refine ⟨-w, ?_, rfl⟩ + rcases hw with rfl | rfl <;> simp + | conjugate => + refine ⟨GaussianReflection w, ?_, rfl⟩ + rcases hw with rfl | rfl + · exact Or.inl rfl + · exact Or.inr rfl + | shift z => + exact ⟨w, hw, by simp [A, BandPackingSymmetryCircleAction]⟩ + | comp h k ih ik => + obtain ⟨w', hw', hk⟩ := ik w hw + obtain ⟨w'', hw'', hh⟩ := ih w' hw' + exact ⟨w'', hw'', by simpa [A, BandPackingSymmetryCircleAction, hk] using hh⟩ + +private theorem unitAction : + (by + classical + exact + let A := BandPackingSymmetryCircleAction + ∀ (h : BandPackingSymmetry), ∀ (z : GaussianInt), ∃ (z' : GaussianInt), A h ((1 : ℤ), (1 + : GaussianInt) + (2 : GaussianInt) * z) = ((1 : ℤ), (1 : GaussianInt) + (2 : + GaussianInt) * z') ) := by + classical + intro A h z + induction h generalizing z with + | identity => exact ⟨z, rfl⟩ + | negate => + refine ⟨-1-z, ?_⟩ + apply Prod.ext + · rfl + · change -(1 + 2 * z) = 1 + 2 * (-1-z) + ring + | conjugate => + refine ⟨GaussianReflection z, ?_⟩ + apply Prod.ext + · rfl + · ext <;> simp [A, BandPackingSymmetryCircleAction, GaussianReflection] + | shift w => + refine ⟨z+w, ?_⟩ + apply Prod.ext + · rfl + · change 1 + 2 * z + 2 * (1 : GaussianInt) * w = 1 + 2 * (z+w) + ring + | comp h k ih ik => + obtain ⟨z', hk⟩ := ik z + obtain ⟨z'', hh⟩ := ih z' + exact ⟨z'', by simpa [A, BandPackingSymmetryCircleAction, hk] using hh⟩ + +private theorem tileExt : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), T.cells = U.cells → T.anchor = U.anchor → T = U ) + := by + classical + intro T U hc ha + cases T + cases U + congr + +private theorem forward : + (by + classical + exact + let A := BandPackingSymmetryCircleAction + let B := BandPackingSymmetryTileAction + let L := BandPackingSymmetryVectorAction + let O := BandPackingSymmetryReversesOrientation + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + let D : GaussianInt → Real × Real := fun w => + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + (∀ (h : BandPackingSymmetry), ∃ b : GaussianInt → GaussianInt, ∀ T : ProtoTile, (B h + T).cells = T.cells.image b ∧ (B h T).anchor = L h T.anchor ∧ FootprintVertices (B h + T) = L h '' FootprintVertices T ∧ TileCentroid (B h T) = R h (TileCentroid T)) → ( + let Q := BandPackingSymmetryQuadrupleAction + let sigma (h : BandPackingSymmetry) (i : Fin 3) : Fin 3 := + if O h then -i else i + (∀ (h : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (S + : Fin 3 → Bool → ProtoTile), (ProperBandQuadruple q) → ((∀ i, ∀ s, BandPrototile (A h + (q i.succ)) (B h (S i s))) → ((∀ i, ∀ s, FootprintVertices (S i s) ⊆ + FootprintVertices T) → ((∀ i, ∀ s, TileCentroid (S i s) - TileCentroid T = (if s = + true then (1 : Real) else -1) • D (BandVectors.1 (q ((i + 2).succ)) (q ((i + + 1).succ)))) → ((∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (S i s).cells) → (∃ (d : Bool) (e : + (Fin 3 × Bool) ≃ (Fin 3 × Bool)) (S' : Fin 3 → Bool → ProtoTile), + BandPackingSymmetryScopedPhase h q d ∧ (∀ i, ∀ s, e (i, s) = (sigma h i, xor s d)) ∧ + (∀ i, ∀ s, S' (e (i, s)).1 (e (i, s)).2 = B h (S i s)) ∧ (∀ i, ∀ s, + BandSubtileOccurrence (Q h q) (B h T) i s (S' i s)) ∧ ∀ x, x ∈ (B h T).cells ↔ ∃ i s, + x ∈ (S' i s).cells)))))) → ((∀ (h : BandPackingSymmetry), ∀ (w : GaussianInt), (w = 1 + ∨ w = -1) → (∃ w', (w' = 1 ∨ w' = -1) ∧ A h (0, w) = (0, w'))) → ((∀ (h : + BandPackingSymmetry), ∀ (z : GaussianInt), ∃ z', A h (1, 1 + 2 * z) = (1, 1 + 2 * + z')) → ((∀ (T : ProtoTile), ∀ (U : ProtoTile), (T.cells = U.cells) → ((T.anchor = + U.anchor) → (T = U))) → (∀ (C : CircleCoordinates), ∀ (T : ProtoTile), BandPrototile + C T → ∀ (h : BandPackingSymmetry), BandPrototile (A h C) (B h T)))))) ) := by + classical + intro A B L O R D grids Q sigma families lineAction unitAction tileExt C T ht + induction ht with + | line w x hw => + intro h + obtain ⟨w', hw', ha⟩ := lineAction h w hw + obtain ⟨b, hb⟩ := grids h + have ht : B h ⟨∅, x⟩ = ⟨∅, L h x⟩ := + tileExt _ _ (by simpa using (hb ⟨∅, x⟩).1) (hb ⟨∅, x⟩).2.1 + rw [ha, ht] + exact BandPrototile.line w' (L h x) hw' + | unit z x anchor => + intro h + obtain ⟨z', ha⟩ := unitAction h z + obtain ⟨b, hb⟩ := grids h + have ht : B h ⟨{x}, anchor⟩ = ⟨{b x}, L h anchor⟩ := + tileExt _ _ (by simpa using (hb ⟨{x}, anchor⟩).1) + (hb ⟨{x}, anchor⟩).2.1 + rw [ha, ht] + exact BandPrototile.unit z' (b x) (L h anchor) + | @decompose q hq S T hS hu hf hc ih => + intro h + obtain ⟨d, e, S', hd, he, hs, ho, hu'⟩ := + families h q T S hq (fun i s => ih i s h) hf hc hu + change BandPrototile (Q h q 0) (B h T) + exact BandPrototile.decompose (BandPackingSymmetryProperCovariance h q hq) + (fun i s => (ho i s).1) hu' (fun i s => (ho i s).2.1) + (fun i s => (ho i s).2.2) + +private theorem tileN : + (by + classical + exact + ∀ (T : ProtoTile), TileQuarterTurn (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn + T))) = T ) := by + classical + intro T + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · simp only [TileQuarterTurn, Finset.image_image, Function.comp_def] + have hm : (fun x : GaussianInt => GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x - 1) - 1) - 1) + - 1) = id := by + funext x + ext <;> simp [GaussianQuarterTurn] + rw [hm, Finset.image_id] + · ext <;> simp [TileQuarterTurn, GaussianQuarterTurn] + +private theorem tileK : + (by + classical + exact + let B := BandPackingSymmetryTileAction + ∀ (T : ProtoTile), B BandPackingSymmetry.conjugate (B BandPackingSymmetry.conjugate T) = + T ) := by + classical + intro B T + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · simp only [B, BandPackingSymmetryTileAction, TileQuarterTurn, TileReflection, + Finset.image_image, Function.comp_def] + have hm : (fun x : GaussianInt => GaussianQuarterTurn + (GaussianQuarterTurn (GaussianReflection (GaussianQuarterTurn + (GaussianQuarterTurn (GaussianReflection x - ⟨0, 1⟩) - 1) - 1) - + ⟨0, 1⟩) - 1) - 1) = id := by + funext x + ext <;> simp [GaussianQuarterTurn, GaussianReflection] + rw [hm, Finset.image_id] + · ext <;> simp [B, BandPackingSymmetryTileAction, TileQuarterTurn, + TileReflection, GaussianQuarterTurn, GaussianReflection] + +private theorem inverse : + (by + classical + exact + let A := BandPackingSymmetryCircleAction + let B := BandPackingSymmetryTileAction + (∀ (T : ProtoTile), TileQuarterTurn (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn + T))) = T) → ((∀ (T : ProtoTile), B .conjugate (B .conjugate T) = T) → (∀ (h : + BandPackingSymmetry), ∃ (k : BandPackingSymmetry), (∀ (C : CircleCoordinates), A k (A + h C) = C) ∧ ∀ (T : ProtoTile), B k (B h T) = T)) ) := by + classical + intro A B tileN tileK h + induction h with + | identity => exact ⟨.identity, fun _ => rfl, fun _ => rfl⟩ + | negate => + refine ⟨.comp .negate (.comp .negate .negate), ?_, tileN⟩ + intro C + cases C + simp [A, BandPackingSymmetryCircleAction] + | conjugate => + refine ⟨.conjugate, ?_, tileK⟩ + intro C + cases C + apply Prod.ext + · rfl + · ext <;> simp [A, BandPackingSymmetryCircleAction, GaussianReflection] + | shift w => + refine ⟨.shift (-w), ?_, fun _ => rfl⟩ + intro C + cases C + apply Prod.ext + · rfl + · simp only [A, BandPackingSymmetryCircleAction] + ring + | comp h k ih ik => + obtain ⟨hi, hc, ht⟩ := ih + obtain ⟨ki, kc, kt⟩ := ik + refine ⟨.comp ki hi, ?_, ?_⟩ + · intro C + simp only [A, BandPackingSymmetryCircleAction, hc, kc] + · intro T + simp only [B, BandPackingSymmetryTileAction, ht, kt] + +private theorem covariance : + (by + classical + exact + let A := BandPackingSymmetryCircleAction + let B := BandPackingSymmetryTileAction + (∀ (C : CircleCoordinates), ∀ (T : ProtoTile), (BandPrototile C T) → (∀ h : + BandPackingSymmetry, BandPrototile (A h C) (B h T))) → ((∀ (h : BandPackingSymmetry), + ∃ k : BandPackingSymmetry, (∀ C, A k (A h C) = C) ∧ (∀ T, B k (B h T) = T)) → (∀ (h : + BandPackingSymmetry), ∀ (C : CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T + ↔ BandPrototile (A h C) (B h T))) ) := by + classical + intro A B forward inverse h C T + constructor + · intro ht + exact forward C T ht h + · intro ht + obtain ⟨k, hk, ht'⟩ := inverse h + simpa only [hk, ht'] using forward (A h C) (B h T) ht k + +private theorem curvature : + (by + classical + exact + let A := BandPackingSymmetryCircleAction + ∀ (h : BandPackingSymmetry), ∀ (C : CircleCoordinates), (A h C).1 = C.1 ) := by + classical + intro A h C + induction h generalizing C with + | identity => rfl + | negate => rfl + | conjugate => rfl + | shift w => rfl + | comp h k ih ik => simp [A, BandPackingSymmetryCircleAction, ih, ik] + +end SymmetryCovarianceProof + +theorem BandPackingSymmetryCovariance (g : BandPackingSymmetry) : + (∀ C, (BandPackingSymmetryCircleAction g C).1 = C.1) ∧ + (∀ C T, BandPrototile C T ↔ + BandPrototile (BandPackingSymmetryCircleAction g C) + (BandPackingSymmetryTileAction g T)) ∧ + ∀ (q : Fin 4 → CircleCoordinates) (T : ProtoTile) + (S : Fin 3 → Bool → ProtoTile), + ProperBandQuadruple q → BandPrototile (q 0) T → + (∀ i s, BandSubtileOccurrence q T i s (S i s)) → + (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (S i s).cells) → + let sigma : Fin 3 → Fin 3 := fun i => + if BandPackingSymmetryReversesOrientation g then -i else i + ∃ (negative : Bool) (e : (Fin 3 × Bool) ≃ (Fin 3 × Bool)) + (S' : Fin 3 → Bool → ProtoTile), + BandPackingSymmetryScopedPhase g q negative ∧ + (∀ i s, e (i, s) = (sigma i, xor s negative)) ∧ + (∀ i s, S' (e (i, s)).1 (e (i, s)).2 = + BandPackingSymmetryTileAction g (S i s)) ∧ + (∀ i s, BandSubtileOccurrence + (BandPackingSymmetryQuadrupleAction g q) + (BandPackingSymmetryTileAction g T) i s (S' i s)) ∧ + ∀ x, x ∈ (BandPackingSymmetryTileAction g T).cells ↔ + ∃ i s, x ∈ (S' i s).cells := by +-- BODY + classical + let A := BandPackingSymmetryCircleAction + let B := BandPackingSymmetryTileAction + let L := BandPackingSymmetryVectorAction + let O := BandPackingSymmetryReversesOrientation + -- The real action tracks centroid and signed-offset transport. + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + let D : GaussianInt → Real × Real := fun w => + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + have rsub (h : BandPackingSymmetry) (p t : Real × Real) : + R h (p - t) = R h p - R h t := SymmetryCovarianceProof.rsub h p t + have rsmul (h : BandPackingSymmetry) (c : Real) (p : Real × Real) : + R h (c • p) = c • R h p := SymmetryCovarianceProof.rsmul h c p + have rneg (h : BandPackingSymmetry) (p : Real × Real) : + R h (-p) = -R h p := SymmetryCovarianceProof.rneg rsmul h p + have rpoint (h : BandPackingSymmetry) (w : GaussianInt) : + R h (GaussianRealPoint w) = GaussianRealPoint (L h w) := SymmetryCovarianceProof.rpoint h w + have rminusq (h : BandPackingSymmetry) (p : Real × Real) : + R h (p.2, -p.1) = -R h (-p.2, p.1) := SymmetryCovarianceProof.rminusq rneg h p + have rq (h : BandPackingSymmetry) (p : Real × Real) : + R h (-p.2, p.1) = if O h then + -(-(R h p).2, (R h p).1) else (-(R h p).2, (R h p).1) := SymmetryCovarianceProof.rq + rminusq h p + have rd (h : BandPackingSymmetry) (w : GaussianInt) : + R h (D w) = D (if O h then GaussianQuarterTurn (L h w) else L h w) := + SymmetryCovarianceProof.rd rsub rsmul rpoint rq h w + have dsign (d : Bool) (w : GaussianInt) : + D ((if d then (-1 : GaussianInt) else 1) * w) = + (if d then (-1 : Real) else 1) • D w := SymmetryCovarianceProof.dsign d w + have grids (h : BandPackingSymmetry) : ∃ b : GaussianInt → GaussianInt, + ∀ T : ProtoTile, + (B h T).cells = T.cells.image b ∧ + (B h T).anchor = L h T.anchor ∧ + FootprintVertices (B h T) = L h '' FootprintVertices T ∧ + TileCentroid (B h T) = R h (TileCentroid T) := SymmetryCovarianceProof.grids h + let Q := BandPackingSymmetryQuadrupleAction + let sigma (h : BandPackingSymmetry) (i : Fin 3) : Fin 3 := + if O h then -i else i + have sigmaInv (h : BandPackingSymmetry) (i : Fin 3) : + sigma h (sigma h i) = i := SymmetryCovarianceProof.sigmaInv h i + have parent (h : BandPackingSymmetry) (q : Fin 4 → CircleCoordinates) (i : Fin 3) : + Q h q (sigma h i).succ = A h (q i.succ) := SymmetryCovarianceProof.parent h q i + have transport (h : BandPackingSymmetry) (q : Fin 4 → CircleCoordinates) + (T U : ProtoTile) (d : Bool) (i : Fin 3) (s : Bool) + (hd : BandPackingSymmetryScopedPhase h q d) + (hp : BandPrototile (A h (q i.succ)) (B h U)) + (hf : FootprintVertices U ⊆ FootprintVertices T) + (hc : TileCentroid U - TileCentroid T = + (if s = true then (1 : Real) else -1) • + D (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)))) : + BandSubtileOccurrence (Q h q) (B h T) (sigma h i) (xor s d) (B h U) := + SymmetryCovarianceProof.transport rsub rsmul rd dsign grids parent h q T U d i s hd hp + hf hc + -- Relabel all six pieces using a single phase for the proper tuple. + have families (h : BandPackingSymmetry) (q : Fin 4 → CircleCoordinates) + (T : ProtoTile) (S : Fin 3 → Bool → ProtoTile) + (hq : ProperBandQuadruple q) + (hp : ∀ i s, BandPrototile (A h (q i.succ)) (B h (S i s))) + (hf : ∀ i s, FootprintVertices (S i s) ⊆ FootprintVertices T) + (hc : ∀ i s, TileCentroid (S i s) - TileCentroid T = + (if s = true then (1 : Real) else -1) • + D (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)))) + (hu : ∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (S i s).cells) : + ∃ (d : Bool) (e : (Fin 3 × Bool) ≃ (Fin 3 × Bool)) + (S' : Fin 3 → Bool → ProtoTile), + BandPackingSymmetryScopedPhase h q d ∧ + (∀ i s, e (i, s) = (sigma h i, xor s d)) ∧ + (∀ i s, S' (e (i, s)).1 (e (i, s)).2 = B h (S i s)) ∧ + (∀ i s, BandSubtileOccurrence (Q h q) (B h T) i s (S' i s)) ∧ + ∀ x, x ∈ (B h T).cells ↔ ∃ i s, x ∈ (S' i s).cells := SymmetryCovarianceProof.families + grids sigmaInv transport h q T S hq hp hf hc hu + have lineAction (h : BandPackingSymmetry) (w : GaussianInt) (hw : w = 1 ∨ w = -1) : + ∃ w', (w' = 1 ∨ w' = -1) ∧ A h (0, w) = (0, w') := SymmetryCovarianceProof.lineAction h w hw + have unitAction (h : BandPackingSymmetry) (z : GaussianInt) : + ∃ z', A h (1, 1 + 2 * z) = (1, 1 + 2 * z') := SymmetryCovarianceProof.unitAction h z + have tileExt (T U : ProtoTile) (hc : T.cells = U.cells) (ha : T.anchor = U.anchor) : + T = U := SymmetryCovarianceProof.tileExt T U hc ha + -- Constructor induction uses only the immediate children's hypotheses. + have forward (C : CircleCoordinates) (T : ProtoTile) (ht : BandPrototile C T) : + ∀ h : BandPackingSymmetry, BandPrototile (A h C) (B h T) := SymmetryCovarianceProof.forward + grids families lineAction unitAction tileExt C T ht + have tileN (T : ProtoTile) : + TileQuarterTurn (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T))) = T := + SymmetryCovarianceProof.tileN T + have tileK (T : ProtoTile) : B .conjugate (B .conjugate T) = T := SymmetryCovarianceProof.tileK T + -- Three negations undo the quarter-turn action while undoing the circle negation. + have inverse (h : BandPackingSymmetry) : ∃ k : BandPackingSymmetry, + (∀ C, A k (A h C) = C) ∧ (∀ T, B k (B h T) = T) := SymmetryCovarianceProof.inverse tileN + tileK h + have covariance (h : BandPackingSymmetry) (C : CircleCoordinates) (T : ProtoTile) : + BandPrototile C T ↔ BandPrototile (A h C) (B h T) := SymmetryCovarianceProof.covariance + forward inverse h C T + have curvature (h : BandPackingSymmetry) (C : CircleCoordinates) : + (A h C).1 = C.1 := SymmetryCovarianceProof.curvature h C + refine ⟨curvature g, covariance g, ?_⟩ + intro q T S hq hT ho hu + exact families g q T S hq + (fun i s => forward _ _ (ho i s).1 g) + (fun i s => (ho i s).2.1) (fun i s => (ho i s).2.2) hu + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryGlobalOdometerTransport.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryGlobalOdometerTransport.lean new file mode 100644 index 0000000000..78f9b6c676 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryGlobalOdometerTransport.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5686T1UniformGlobalOdometerTransport + +-- [TABLET NODE: BandPackingSymmetryGlobalOdometerTransport] + +/-! +# BandPackingSymmetryGlobalOdometerTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandPackingSymmetryGlobalOdometerTransport + (s : BandPackingSymmetry) (g : IntegerLatticeFunction) + (h : PartialOdometer) (x : GaussianInt) + (hext : GlobalOdometerExtends g h) : + ∃ g' : IntegerLatticeFunction, + GlobalOdometerExtends g' + (BandPackingSymmetryPartialOdometerAction s h) ∧ + FourNeighborLaplacian g' + (BandPackingSymmetryVectorAction s x) = + FourNeighborLaplacian g x := by +-- BODY + obtain ⟨g', he', hlap⟩ := P5686T1UniformGlobalOdometerTransport s g h hext + exact ⟨g', he', hlap x⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryInversePhaseCancellation.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryInversePhaseCancellation.lean new file mode 100644 index 0000000000..c140c44baa --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryInversePhaseCancellation.lean @@ -0,0 +1,612 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas + +-- [TABLET NODE: BandPackingSymmetryInversePhaseCancellation] + +/-! +# BandPackingSymmetryInversePhaseCancellation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace InversePhaseProof + +private theorem composition : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (b : BandPackingSymmetry), ∀ (q : Fin 4 -> + CircleCoordinates), BandPackingSymmetryQuadrupleAction (.comp a b) q = + BandPackingSymmetryQuadrupleAction a (BandPackingSymmetryQuadrupleAction b q) ) := by + classical + intro a b q + have neg1 : -(1 : Fin 3) = 2 := rfl + have neg2 : -(2 : Fin 3) = 1 := rfl + cases ha : BandPackingSymmetryReversesOrientation a <;> + cases hb : BandPackingSymmetryReversesOrientation b <;> + funext k <;> fin_cases k <;> + simp [BandPackingSymmetryQuadrupleAction, BandPackingSymmetryCircleAction, + BandPackingSymmetryReversesOrientation, ha, hb, neg1, neg2] + +private theorem phaseComposition : + (by + classical + exact + (∀ (a : BandPackingSymmetry), ∀ (b : BandPackingSymmetry), ∀ (q : Fin 4 -> + CircleCoordinates), BandPackingSymmetryQuadrupleAction (.comp a b) q = + BandPackingSymmetryQuadrupleAction a (BandPackingSymmetryQuadrupleAction b q)) → + (forall (a b : BandPackingSymmetry) (q : Fin 4 -> CircleCoordinates) (deltaB deltaA : + Bool), ProperBandQuadruple q -> BandPackingSymmetryScopedPhase b q deltaB -> + BandPackingSymmetryScopedPhase a (BandPackingSymmetryQuadrupleAction b q) deltaA -> + BandPackingSymmetryScopedPhase (.comp a b) q (xor deltaB deltaA)) ) := by + classical + intro composition + have qneg (v : GaussianInt) : GaussianQuarterTurn (-v) = -GaussianQuarterTurn v := by + ext <;> simp [GaussianQuarterTurn] + have qtwo (v : GaussianInt) : + GaussianQuarterTurn (GaussianQuarterTurn v) = -v := by + ext <;> simp [GaussianQuarterTurn] + have vneg (g : BandPackingSymmetry) (v : GaussianInt) : + BandPackingSymmetryVectorAction g (-v) = -BandPackingSymmetryVectorAction g v := by + induction g generalizing v with + | identity => rfl + | negate => exact qneg v + | conjugate => ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] + | shift w => rfl + | comp a b ia ib => simp only [BandPackingSymmetryVectorAction, ib, ia] + have vquarter (g : BandPackingSymmetry) (v : GaussianInt) : + BandPackingSymmetryVectorAction g (GaussianQuarterTurn v) = + if BandPackingSymmetryReversesOrientation g then + -GaussianQuarterTurn (BandPackingSymmetryVectorAction g v) + else GaussianQuarterTurn (BandPackingSymmetryVectorAction g v) := by + induction g generalizing v with + | identity => rfl + | negate => rfl + | conjugate => + ext <;> simp [BandPackingSymmetryVectorAction, + BandPackingSymmetryReversesOrientation, GaussianQuarterTurn, GaussianReflection] + | shift w => rfl + | comp a b ia ib => + cases ha : BandPackingSymmetryReversesOrientation a <;> + cases hb : BandPackingSymmetryReversesOrientation b <;> + simp [BandPackingSymmetryVectorAction, BandPackingSymmetryReversesOrientation, + ib, ia, ha, hb, vneg] + intro a b q db da hq hb ha i + have hbi := hb i + have hai := ha (if BandPackingSymmetryReversesOrientation b then -i else i) + change _ = _ ∧ _ = _ ∧ _ = _ at hbi hai + cases ra : BandPackingSymmetryReversesOrientation a <;> + cases rb : BandPackingSymmetryReversesOrientation b <;> + cases db <;> cases da <;> fin_cases i + all_goals + simp? [BandPackingSymmetryReversesOrientation, ra, rb] at hbi hai ⊢ + simp only [composition] + rcases hbi with ⟨bin, brev, bcyc⟩ + rcases hai with ⟨ain, arev, acyc⟩ + rw [ain, arev, acyc, bin, brev, bcyc] + simp [BandPackingSymmetryVectorAction, vneg, vquarter, ra, qneg, qtwo] + +private theorem qfour : + (by + classical + exact + ∀ (v : GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn v))) = v ) := by + classical + intro v + ext <;> simp [GaussianQuarterTurn] + +private theorem injN : + (by + classical + exact + (∀ (v : GaussianInt), -GaussianQuarterTurn (GaussianQuarterTurn v) = v) → + (Function.Injective GaussianQuarterTurn) ) := by + classical + intro invN x y h + simpa only [invN] using congrArg (fun z => -GaussianQuarterTurn z) h + +private theorem injK : + (by + classical + exact + (∀ (v : GaussianInt), -GaussianReflection (-GaussianReflection v) = v) → + (Function.Injective (fun v => -GaussianReflection v)) ) := by + classical + intro invK x y h + simpa only [invK] using congrArg (fun z => -GaussianReflection z) h + +private theorem domain : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (h : PartialOdometer), + (BandPackingSymmetryPartialOdometerAction g h).domain = h.domain.image + (BandPackingSymmetryVectorAction g) ) := by + classical + intro g h + induction g generalizing h with + | identity => simp [BandPackingSymmetryPartialOdometerAction, BandPackingSymmetryVectorAction] + | negate => rfl + | conjugate => rfl + | shift w => simp [BandPackingSymmetryPartialOdometerAction, BandPackingSymmetryVectorAction] + | comp a b ia ib => + simp only [BandPackingSymmetryPartialOdometerAction, BandPackingSymmetryVectorAction] + rw [ia, ib, Finset.image_image] + rfl + +private theorem nvalue : + (by + classical + exact + (∀ (v : GaussianInt), -GaussianQuarterTurn (GaussianQuarterTurn v) = v) → + ((Function.Injective GaussianQuarterTurn) → (∀ (h : PartialOdometer), ∀ (x : + GaussianInt), (BandPackingSymmetryPartialOdometerAction .negate h).value + (GaussianQuarterTurn x) = h.value x)) ) := by + classical + intro invN injN h x + have mem : GaussianQuarterTurn x ∈ h.domain.image GaussianQuarterTurn ↔ x ∈ h.domain := by + simp [Finset.mem_image, injN.eq_iff] + by_cases hx : x ∈ h.domain + · simp only [BandPackingSymmetryPartialOdometerAction, mem, ite_eq_left hx, invN] + · simp only [BandPackingSymmetryPartialOdometerAction, mem, ite_eq_right hx] + exact (h.value_outside x hx).symm + +private theorem kvalue : + (by + classical + exact + (∀ (v : GaussianInt), -GaussianReflection (-GaussianReflection v) = v) → + ((Function.Injective (fun v => -GaussianReflection v)) → (∀ (h : PartialOdometer), ∀ + (x : GaussianInt), (BandPackingSymmetryPartialOdometerAction .conjugate h).value + (-GaussianReflection x) = h.value x)) ) := by + classical + intro invK injK h x + have mem : -GaussianReflection x ∈ h.domain.image (fun v => -GaussianReflection v) ↔ + x ∈ h.domain := by + simp [Finset.mem_image, injK.eq_iff] + by_cases hx : x ∈ h.domain + · simp only [BandPackingSymmetryPartialOdometerAction, mem, ite_eq_left hx, invK] + · simp only [BandPackingSymmetryPartialOdometerAction, mem, ite_eq_right hx] + exact (h.value_outside x hx).symm + +private theorem partial_ext : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), (h.domain = k.domain) → ((∀ x, h.value + x = k.value x) → (h = k)) ) := by + classical + intro h k hd hv + cases h + cases k + dsimp at hd hv + subst hd + have he := funext hv + subst he + rfl + +private theorem tileN : + (by + classical + exact + (∀ (v : GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn v))) = v) → (∀ (T : ProtoTile), TileQuarterTurn (TileQuarterTurn + (TileQuarterTurn (TileQuarterTurn T))) = T) ) := by + classical + intro qfour T + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · simp only [TileQuarterTurn, Finset.image_image, Function.comp_def] + have map : (fun x : GaussianInt => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn x - 1) - 1) - 1) - 1) = id := by + funext x + ext <;> simp [GaussianQuarterTurn] + rw [map, Finset.image_id] + · exact qfour anchor + +private theorem tileK : + (by + classical + exact + ∀ (T : ProtoTile), BandPackingSymmetryTileAction .conjugate + (BandPackingSymmetryTileAction .conjugate T) = T ) := by + classical + intro T + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · simp only [BandPackingSymmetryTileAction, TileQuarterTurn, TileReflection, + Finset.image_image, Function.comp_def] + have map : (fun x : GaussianInt => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianReflection + (GaussianQuarterTurn (GaussianQuarterTurn + (GaussianReflection x - ⟨0, 1⟩) - 1) - 1) - ⟨0, 1⟩) - 1) - 1) = id := by + funext x + ext <;> simp [GaussianQuarterTurn, GaussianReflection] + rw [map, Finset.image_id] + · ext <;> simp [BandPackingSymmetryTileAction, TileQuarterTurn, TileReflection, + GaussianQuarterTurn, GaussianReflection] + +private theorem partialN : + (by + classical + exact + (∀ (v : GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn + (GaussianQuarterTurn v))) = v) → ((∀ (g : BandPackingSymmetry), ∀ (h : + PartialOdometer), (BandPackingSymmetryPartialOdometerAction g h).domain = + h.domain.image (BandPackingSymmetryVectorAction g)) → ((∀ (h : PartialOdometer), ∀ (x + : GaussianInt), (BandPackingSymmetryPartialOdometerAction .negate h).value + (GaussianQuarterTurn x) = h.value x) → ((∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), (h.domain = k.domain) → ((∀ x, h.value x = k.value x) → (h = + k))) → + (∀ (h : PartialOdometer), BandPackingSymmetryPartialOdometerAction .negate + (BandPackingSymmetryPartialOdometerAction .negate + (BandPackingSymmetryPartialOdometerAction .negate + (BandPackingSymmetryPartialOdometerAction .negate h))) = h)))) ) := by + classical + intro qfour domain nvalue partial_ext h + apply partial_ext + · rw [domain, domain, domain, domain] + simp only [BandPackingSymmetryVectorAction, Finset.image_image, Function.comp_def] + have map : (fun x : GaussianInt => GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)))) = id := + funext qfour + rw [map, Finset.image_id] + · intro x + have he := nvalue + (BandPackingSymmetryPartialOdometerAction .negate + (BandPackingSymmetryPartialOdometerAction .negate + (BandPackingSymmetryPartialOdometerAction .negate h))) + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x))) + rw [qfour, nvalue, nvalue, nvalue] at he + exact he + +private theorem partialK : + (by + classical + exact + (∀ (v : GaussianInt), -GaussianReflection (-GaussianReflection v) = v) → ((∀ (g : + BandPackingSymmetry), ∀ (h : PartialOdometer), + (BandPackingSymmetryPartialOdometerAction g h).domain = h.domain.image + (BandPackingSymmetryVectorAction g)) → ((∀ (h : PartialOdometer), ∀ (x : + GaussianInt), (BandPackingSymmetryPartialOdometerAction .conjugate h).value + (-GaussianReflection x) + = h.value x) → ((∀ (h : PartialOdometer), ∀ (k : PartialOdometer), (h.domain = + k.domain) → ((∀ x, h.value x = k.value x) → (h = k))) → (∀ (h : PartialOdometer), + BandPackingSymmetryPartialOdometerAction .conjugate + (BandPackingSymmetryPartialOdometerAction .conjugate h) = h)))) ) := by + classical + intro invK domain kvalue partial_ext h + apply partial_ext + · rw [domain, domain] + simp only [BandPackingSymmetryVectorAction, Finset.image_image, Function.comp_def] + have map : (fun x : GaussianInt => -GaussianReflection (-GaussianReflection x)) = id := + funext invK + rw [map, Finset.image_id] + · intro x + have he := kvalue (BandPackingSymmetryPartialOdometerAction .conjugate h) + (-GaussianReflection x) + rw [invK, kvalue] at he + exact he + +private theorem potential : + (by + classical + exact + ∀ (w : GaussianInt), ∀ (x : GaussianInt), BandPackingShiftPotential (-w) x = + -BandPackingShiftPotential w x ) := by + classical + intro w x + simp only [BandPackingShiftPotential, Zsqrtd.re_neg, Zsqrtd.im_neg] + ring + +private theorem partialShift : + (by + classical + exact + (∀ (h : PartialOdometer), ∀ (k : PartialOdometer), (h.domain = k.domain) → ((∀ x, h.value + x = k.value x) → (h = k))) → ((∀ (w : GaussianInt), ∀ (x : GaussianInt), + BandPackingShiftPotential (-w) x = -BandPackingShiftPotential w x) → (∀ (w : + GaussianInt), ∀ (h : PartialOdometer), BandPackingSymmetryPartialOdometerAction + (.shift (-w)) (BandPackingSymmetryPartialOdometerAction (.shift w) h) = h)) ) := by + classical + intro partial_ext potential w h + apply partial_ext + · rfl + · intro x + by_cases hx : x ∈ h.domain + · simp [BandPackingSymmetryPartialOdometerAction, hx, potential] + · simp [BandPackingSymmetryPartialOdometerAction, hx, h.value_outside x hx] + +private theorem quadCancel : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (k : BandPackingSymmetry), + (BandPackingSymmetryReversesOrientation k = BandPackingSymmetryReversesOrientation g) + → ((∀ C, BandPackingSymmetryCircleAction k (BandPackingSymmetryCircleAction g C) = C) + → (∀ (q : Fin 4 -> CircleCoordinates), BandPackingSymmetryQuadrupleAction k + (BandPackingSymmetryQuadrupleAction g q) = q)) ) := by + classical + intro g k he hc q + have neg1 : -(1 : Fin 3) = 2 := rfl + have neg2 : -(2 : Fin 3) = 1 := rfl + cases hg : BandPackingSymmetryReversesOrientation g <;> + funext i <;> fin_cases i <;> + simp [BandPackingSymmetryQuadrupleAction, he, hg, hc, neg1, neg2] + +private theorem clAt391 : + (by + classical + exact + let k : BandPackingSymmetry := .comp .negate (.comp .negate .negate) + ∀ (C : CircleCoordinates), BandPackingSymmetryCircleAction k + (BandPackingSymmetryCircleAction .negate C) = C ) := by + classical + intro k C + cases C + simp [k, BandPackingSymmetryCircleAction] + +private theorem crAt395 : + (by + classical + exact + let k : BandPackingSymmetry := .comp .negate (.comp .negate .negate) + ∀ (C : CircleCoordinates), BandPackingSymmetryCircleAction .negate + (BandPackingSymmetryCircleAction k C) = C ) := by + classical + intro k C + cases C + simp [k, BandPackingSymmetryCircleAction] + +private theorem clAt408 : + (by + classical + exact + ∀ (C : CircleCoordinates), BandPackingSymmetryCircleAction .conjugate + (BandPackingSymmetryCircleAction .conjugate C) = C ) := by + classical + intro C + cases C + apply Prod.ext + · rfl + · ext <;> simp [BandPackingSymmetryCircleAction, GaussianReflection] + +private theorem clAt418 : + (by + classical + exact + ∀ (w : GaussianInt), ∀ (C : CircleCoordinates), BandPackingSymmetryCircleAction (.shift + (-w)) (BandPackingSymmetryCircleAction (.shift w) C) = C ) := by + classical + intro w C + cases C + apply Prod.ext + · rfl + · simp only [BandPackingSymmetryCircleAction] + ring + +private theorem crAt426 : + (by + classical + exact + ∀ (w : GaussianInt), ∀ (C : CircleCoordinates), BandPackingSymmetryCircleAction (.shift + w) (BandPackingSymmetryCircleAction (.shift (-w)) C) = C ) := by + classical + intro w C + cases C + apply Prod.ext + · rfl + · simp only [BandPackingSymmetryCircleAction] + ring + +private theorem zeroPhase : + (by + classical + exact + (∀ (a : BandPackingSymmetry), ∀ (b : BandPackingSymmetry), ∀ (q : Fin 4 -> + CircleCoordinates), BandPackingSymmetryQuadrupleAction (.comp a b) q = + BandPackingSymmetryQuadrupleAction a (BandPackingSymmetryQuadrupleAction b q)) → (∀ + (g : BandPackingSymmetry), ∀ (k : BandPackingSymmetry), (∀ (q : Fin (4 : ℕ) → + CircleCoordinates), BandPackingSymmetryQuadrupleAction k + (BandPackingSymmetryQuadrupleAction g q) = q) → ((∀ (v : GaussianInt), + BandPackingSymmetryVectorAction k (BandPackingSymmetryVectorAction g v) = v) → (∀ (q + : Fin (4 : ℕ) → CircleCoordinates), (BandPackingSymmetryReversesOrientation (.comp k + g) = false) → (BandPackingSymmetryScopedPhase (.comp k g) q false)))) ) := by + classical + intro composition g k ql vl q orientation + simp [BandPackingSymmetryScopedPhase, composition, ql, orientation, + BandPackingSymmetryVectorAction, vl] + +end InversePhaseProof + +theorem BandPackingSymmetryInversePhaseCancellation : + (∀ (a : BandPackingSymmetry), ∀ (b : BandPackingSymmetry), ∀ (q : Fin 4 -> + CircleCoordinates), ∀ (deltaB : Bool), ∀ (deltaA : Bool), ProperBandQuadruple q -> + BandPackingSymmetryScopedPhase b q deltaB -> + BandPackingSymmetryScopedPhase a + (BandPackingSymmetryQuadrupleAction b q) deltaA -> + BandPackingSymmetryScopedPhase (.comp a b) q (xor deltaB deltaA)) ∧ + ∀ g : BandPackingSymmetry, exists inverse : BandPackingSymmetry, + (∀ C, BandPackingSymmetryCircleAction inverse + (BandPackingSymmetryCircleAction g C) = C) ∧ + (∀ C, BandPackingSymmetryCircleAction g + (BandPackingSymmetryCircleAction inverse C) = C) ∧ + (∀ q, BandPackingSymmetryQuadrupleAction inverse + (BandPackingSymmetryQuadrupleAction g q) = q) ∧ + (∀ q, BandPackingSymmetryQuadrupleAction g + (BandPackingSymmetryQuadrupleAction inverse q) = q) ∧ + (∀ T, BandPackingSymmetryTileAction inverse + (BandPackingSymmetryTileAction g T) = T) ∧ + (∀ T, BandPackingSymmetryTileAction g + (BandPackingSymmetryTileAction inverse T) = T) ∧ + (∀ v, BandPackingSymmetryVectorAction inverse + (BandPackingSymmetryVectorAction g v) = v) ∧ + (∀ v, BandPackingSymmetryVectorAction g + (BandPackingSymmetryVectorAction inverse v) = v) ∧ + (∀ h, BandPackingSymmetryPartialOdometerAction inverse + (BandPackingSymmetryPartialOdometerAction g h) = h) ∧ + (∀ h, BandPackingSymmetryPartialOdometerAction g + (BandPackingSymmetryPartialOdometerAction inverse h) = h) ∧ + ∀ (q : Fin 4 -> CircleCoordinates), (ProperBandQuadruple q) → (∀ (delta : Bool), + BandPackingSymmetryScopedPhase g q delta -> + BandPackingSymmetryScopedPhase inverse + (BandPackingSymmetryQuadrupleAction g q) delta) := by +-- BODY + classical + have composition (a b : BandPackingSymmetry) (q : Fin 4 -> CircleCoordinates) : + BandPackingSymmetryQuadrupleAction (.comp a b) q = + BandPackingSymmetryQuadrupleAction a (BandPackingSymmetryQuadrupleAction b q) := + InversePhaseProof.composition a b q + have phaseComposition := InversePhaseProof.phaseComposition composition + have cancellations : forall g : BandPackingSymmetry, exists inverse : BandPackingSymmetry, + BandPackingSymmetryReversesOrientation inverse = BandPackingSymmetryReversesOrientation g ∧ + (forall C, BandPackingSymmetryCircleAction inverse (BandPackingSymmetryCircleAction g C) = + C) ∧ + (forall C, BandPackingSymmetryCircleAction g (BandPackingSymmetryCircleAction inverse C) = + C) ∧ + (forall q, BandPackingSymmetryQuadrupleAction inverse (BandPackingSymmetryQuadrupleAction g + q) = q) ∧ + (forall q, BandPackingSymmetryQuadrupleAction g (BandPackingSymmetryQuadrupleAction inverse + q) = q) ∧ + (forall T, BandPackingSymmetryTileAction inverse (BandPackingSymmetryTileAction g T) = T) ∧ + (forall T, BandPackingSymmetryTileAction g (BandPackingSymmetryTileAction inverse T) = T) ∧ + (forall v, BandPackingSymmetryVectorAction inverse (BandPackingSymmetryVectorAction g v) = + v) ∧ + (forall v, BandPackingSymmetryVectorAction g (BandPackingSymmetryVectorAction inverse v) = + v) ∧ + (forall h, BandPackingSymmetryPartialOdometerAction inverse + (BandPackingSymmetryPartialOdometerAction g h) = h) ∧ + (forall h, BandPackingSymmetryPartialOdometerAction g + (BandPackingSymmetryPartialOdometerAction inverse h) = h) := by + have qfour (v : GaussianInt) := InversePhaseProof.qfour v + have invN (v : GaussianInt) : -GaussianQuarterTurn (GaussianQuarterTurn v) = v := by + ext <;> simp [GaussianQuarterTurn] + have invK (v : GaussianInt) : -GaussianReflection (-GaussianReflection v) = v := by + ext <;> simp [GaussianReflection] + have injN := InversePhaseProof.injN invN + have injK := InversePhaseProof.injK invK + have domain (g : BandPackingSymmetry) (h : PartialOdometer) := InversePhaseProof.domain g h + have nvalue (h : PartialOdometer) (x : GaussianInt) := InversePhaseProof.nvalue invN injN h x + have kvalue (h : PartialOdometer) (x : GaussianInt) := InversePhaseProof.kvalue invK injK h x + have partial_ext (h k : PartialOdometer) (hd : h.domain = k.domain) + (hv : ∀ x, h.value x = k.value x) := InversePhaseProof.partial_ext h k hd hv + have tileN (T : ProtoTile) := InversePhaseProof.tileN qfour T + have tileK (T : ProtoTile) := InversePhaseProof.tileK T + have partialN (h : PartialOdometer) := InversePhaseProof.partialN qfour domain nvalue + partial_ext h + have partialK (h : PartialOdometer) := InversePhaseProof.partialK invK domain kvalue + partial_ext h + have potential (w x : GaussianInt) := InversePhaseProof.potential w x + have partialShift (w : GaussianInt) (h : PartialOdometer) : + BandPackingSymmetryPartialOdometerAction (.shift (-w)) + (BandPackingSymmetryPartialOdometerAction (.shift w) h) = h := + InversePhaseProof.partialShift partial_ext potential w h + have quadCancel (g k : BandPackingSymmetry) + (he : BandPackingSymmetryReversesOrientation k = BandPackingSymmetryReversesOrientation g) + (hc : ∀ C, BandPackingSymmetryCircleAction k (BandPackingSymmetryCircleAction g C) = C) + (q : Fin 4 -> CircleCoordinates) := InversePhaseProof.quadCancel g k he hc q + intro g + induction g with + | identity => + refine ⟨.identity, rfl, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + all_goals intro x + all_goals first | rfl | funext i; fin_cases i <;> rfl + | negate => + let k : BandPackingSymmetry := .comp .negate (.comp .negate .negate) + have he : BandPackingSymmetryReversesOrientation k = + BandPackingSymmetryReversesOrientation .negate := rfl + have cl (C : CircleCoordinates) := InversePhaseProof.clAt391 C + have cr (C : CircleCoordinates) := InversePhaseProof.crAt395 C + refine ⟨k, he, cl, cr, quadCancel _ _ he cl, quadCancel _ _ he.symm cr, + ?_, ?_, ?_, ?_, ?_, ?_⟩ + · exact tileN + · exact tileN + · exact qfour + · exact qfour + · exact partialN + · exact partialN + | conjugate => + have cl (C : CircleCoordinates) := InversePhaseProof.clAt408 C + refine ⟨.conjugate, rfl, cl, cl, quadCancel _ _ rfl cl, quadCancel _ _ rfl cl, + tileK, tileK, invK, invK, partialK, partialK⟩ + | shift w => + have cl (C : CircleCoordinates) := InversePhaseProof.clAt418 w C + have cr (C : CircleCoordinates) := InversePhaseProof.crAt426 w C + refine ⟨.shift (-w), rfl, cl, cr, quadCancel _ _ rfl cl, quadCancel _ _ rfl cr, + fun _ => rfl, fun _ => rfl, fun _ => rfl, fun _ => rfl, partialShift w, ?_⟩ + intro h + simpa only [neg_neg] using partialShift (-w) h + | comp a b ia ib => + rcases ia with ⟨ai, ae, acl, acr, aql, aqr, atl, atr, avl, avr, apl, apr⟩ + rcases ib with ⟨bi, be, bcl, bcr, bql, bqr, btl, btr, bvl, bvr, bpl, bpr⟩ + refine ⟨.comp bi ai, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simp [BandPackingSymmetryReversesOrientation, ae, be, Bool.xor_comm] + · intro C + simp only [BandPackingSymmetryCircleAction, acl, bcl] + · intro C + simp only [BandPackingSymmetryCircleAction, bcr, acr] + · intro q + rw [composition, composition, aql, bql] + · intro q + rw [composition, composition, bqr, aqr] + · intro T + simp only [BandPackingSymmetryTileAction, atl, btl] + · intro T + simp only [BandPackingSymmetryTileAction, btr, atr] + · intro v + simp only [BandPackingSymmetryVectorAction, avl, bvl] + · intro v + simp only [BandPackingSymmetryVectorAction, bvr, avr] + · intro h + simp only [BandPackingSymmetryPartialOdometerAction, apl, bpl] + · intro h + simp only [BandPackingSymmetryPartialOdometerAction, bpr, apr] + refine ⟨phaseComposition, ?_⟩ + intro g + rcases cancellations g with ⟨k, he, cl, cr, ql, qr, tl, tr, vl, vr, pl, pr⟩ + refine ⟨k, cl, cr, ql, qr, tl, tr, vl, vr, pl, pr, ?_⟩ + intro q hq delta hd + have proper := BandPackingSymmetryProperCovariance g q hq + obtain ⟨eta, hk, _⟩ := BandPackingSymmetryProjectiveVectorCovariance k _ proper + have composed := phaseComposition k g q delta eta hq hd hk + have orientation : BandPackingSymmetryReversesOrientation (.comp k g) = false := by + simp [BandPackingSymmetryReversesOrientation, he] + have zeroPhase := InversePhaseProof.zeroPhase composition g k ql vl q orientation + have same := BandPackingSymmetryScopedPhaseUnique (.comp k g) q hq + (xor delta eta) false composed zeroPhase + have ed : eta = delta := by + cases delta <;> cases eta <;> simp_all + simpa only [ed] using hk + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean new file mode 100644 index 0000000000..c51f944f81 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean @@ -0,0 +1,1810 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileSubodometer +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandPackingSymmetryMarkedDataCovariance] + +/-! +# BandPackingSymmetryMarkedDataCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace MarkedCovarianceGeometry + +private theorem negCellMap : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (j : Fin 4), LatticeVertexIncidentCell (GaussianQuarterTurn x) j = + GaussianQuarterTurn (LatticeVertexIncidentCell x (j - 1)) - 1 ) := by + classical + intro x j + fin_cases j <;> simp? [LatticeVertexIncidentCell, GaussianQuarterTurn, + Fin.sub_def] <;> ext <;> simp + +private theorem negStar : + (by + classical + exact + (∀ (x : GaussianInt), ∀ (j : Fin 4), LatticeVertexIncidentCell (GaussianQuarterTurn x) j + = GaussianQuarterTurn (LatticeVertexIncidentCell x (j - 1)) - 1) → (∀ (x : + GaussianInt), ∀ (T : ProtoTile), ∀ (U : ProtoTile), (∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T.cells ∨ LatticeVertexIncidentCell x j ∈ U.cells) ↔ + (∀ j : Fin 4, LatticeVertexIncidentCell (GaussianQuarterTurn x) j ∈ (TileQuarterTurn + T).cells ∨ LatticeVertexIncidentCell (GaussianQuarterTurn x) j ∈ (TileQuarterTurn + U).cells)) ) := by + classical + intro negCellMap x T U + constructor + · intro h j + have hj := h (j - 1) + rw [(TileQuarterTurnFormulas T).1, (TileQuarterTurnFormulas U).1] + rw [negCellMap] + simp only [Finset.mem_image] + rcases hj with ht | hu + · exact Or.inl ⟨LatticeVertexIncidentCell x (j - 1), ht, rfl⟩ + · exact Or.inr ⟨LatticeVertexIncidentCell x (j - 1), hu, rfl⟩ + · intro h j + have hj := h (j + 1) + rw [(TileQuarterTurnFormulas T).1, (TileQuarterTurnFormulas U).1] at hj + rw [negCellMap] at hj + simp only [Finset.mem_image] at hj + have hidx : (j + 1 - 1 : Fin 4) = j := by fin_cases j <;> decide + rw [hidx] at hj + have hinj : Function.Injective GaussianQuarterTurn := by + intro a b hab + apply Zsqrtd.ext + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.im) hab + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.re) hab + rcases hj with ht | hu + · rcases ht with ⟨a, ha, he⟩ + left + have he' : GaussianQuarterTurn a = + GaussianQuarterTurn (LatticeVertexIncidentCell x j) := by + have hc := congrArg (fun z : GaussianInt => z + 1) he + simpa using hc + have ae := hinj he' + rw [← ae] + exact ha + · rcases hu with ⟨a, ha, he⟩ + right + have he' : GaussianQuarterTurn a = + GaussianQuarterTurn (LatticeVertexIncidentCell x j) := by + have hc := congrArg (fun z : GaussianInt => z + 1) he + simpa using hc + have ae := hinj he' + rw [← ae] + exact ha + +private theorem conjugateCellMap : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (j : Fin 4), LatticeVertexIncidentCell (-GaussianReflection x) j = + -GaussianReflection (LatticeVertexIncidentCell x (1 - j)) - 1 ) := by + classical + intro x j + fin_cases j <;> simp? [LatticeVertexIncidentCell, GaussianReflection, + Fin.sub_def] <;> ext <;> simp + +private theorem conjugateCells : + (by + classical + exact + ∀ (T : ProtoTile), (BandPackingSymmetryTileAction .conjugate T).cells = T.cells.image + (fun x => -GaussianReflection x - 1) ) := by + classical + intro T + change (TileQuarterTurn (TileQuarterTurn (TileReflection T))).cells = _ + rw [(TileQuarterTurnFormulas (TileQuarterTurn (TileReflection T))).1, + (TileQuarterTurnFormulas (TileReflection T)).1, + (TileReflectionFormulas T).1] + simp only [Finset.image_image] + congr 1 + funext x + ext <;> simp [GaussianQuarterTurn, GaussianReflection] + +private theorem conjugateStar : + (by + classical + exact + (∀ (x : GaussianInt), ∀ (j : Fin 4), LatticeVertexIncidentCell (-GaussianReflection x) j + = -GaussianReflection (LatticeVertexIncidentCell x (1 - j)) - 1) → ((∀ (T : + ProtoTile), (BandPackingSymmetryTileAction .conjugate T).cells = T.cells.image (fun x + => -GaussianReflection x - 1)) → (∀ (x : GaussianInt), ∀ (T : ProtoTile), ∀ (U : + ProtoTile), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells ∨ + LatticeVertexIncidentCell x j ∈ U.cells) ↔ (∀ j : Fin 4, LatticeVertexIncidentCell + (-GaussianReflection x) j ∈ (BandPackingSymmetryTileAction .conjugate T).cells ∨ + LatticeVertexIncidentCell (-GaussianReflection x) j ∈ (BandPackingSymmetryTileAction + .conjugate U).cells))) ) := by + classical + intro conjugateCellMap conjugateCells x T U + constructor + · intro h j + have hj := h (1 - j) + rw [conjugateCells T, conjugateCells U, conjugateCellMap] + simp only [Finset.mem_image] + rcases hj with ht | hu + · exact Or.inl ⟨LatticeVertexIncidentCell x (1 - j), ht, rfl⟩ + · exact Or.inr ⟨LatticeVertexIncidentCell x (1 - j), hu, rfl⟩ + · intro h j + have hj := h (1 - j) + rw [conjugateCells T, conjugateCells U] at hj + rw [conjugateCellMap] at hj + simp only [Finset.mem_image] at hj + have hidx : (1 - (1 - j) : Fin 4) = j := by fin_cases j <;> decide + rw [hidx] at hj + have hinj : Function.Injective (fun z : GaussianInt => -GaussianReflection z) := by + intro a b hab + apply Zsqrtd.ext + · simpa [GaussianReflection] using congrArg (fun z : GaussianInt => z.re) hab + · simpa [GaussianReflection] using congrArg (fun z : GaussianInt => z.im) hab + rcases hj with ht | hu + · rcases ht with ⟨a, ha, he⟩ + left + have he' : -GaussianReflection a = + -GaussianReflection (LatticeVertexIncidentCell x j) := by + have hc := congrArg (fun z : GaussianInt => z + 1) he + simpa using hc + have ae := hinj he' + rw [← ae] + exact ha + · rcases hu with ⟨a, ha, he⟩ + right + have he' : -GaussianReflection a = + -GaussianReflection (LatticeVertexIncidentCell x j) := by + have hc := congrArg (fun z : GaussianInt => z + 1) he + simpa using hc + have ae := hinj he' + rw [← ae] + exact ha + +private theorem starCov : + (by + classical + exact + (∀ (x : GaussianInt), ∀ (T : ProtoTile), ∀ (U : ProtoTile), (∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T.cells ∨ LatticeVertexIncidentCell x j ∈ U.cells) ↔ + (∀ j : Fin 4, LatticeVertexIncidentCell (GaussianQuarterTurn x) j ∈ (TileQuarterTurn + T).cells ∨ LatticeVertexIncidentCell (GaussianQuarterTurn x) j ∈ (TileQuarterTurn + U).cells)) → ((∀ (x : GaussianInt), ∀ (T : ProtoTile), ∀ (U : ProtoTile), (∀ j : Fin + 4, LatticeVertexIncidentCell x j ∈ T.cells ∨ LatticeVertexIncidentCell x j ∈ U.cells) + ↔ (∀ j : Fin 4, LatticeVertexIncidentCell (-GaussianReflection x) j ∈ + (BandPackingSymmetryTileAction .conjugate T).cells ∨ LatticeVertexIncidentCell + (-GaussianReflection x) j ∈ (BandPackingSymmetryTileAction .conjugate U).cells)) → (∀ + (g : BandPackingSymmetry), ∀ (x : GaussianInt), ∀ (T : ProtoTile), ∀ (U : ProtoTile), + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells ∨ LatticeVertexIncidentCell x j + ∈ U.cells) ↔ (∀ j : Fin 4, LatticeVertexIncidentCell (BandPackingSymmetryVectorAction + g x) j ∈ (BandPackingSymmetryTileAction g T).cells ∨ LatticeVertexIncidentCell + (BandPackingSymmetryVectorAction g x) j ∈ (BandPackingSymmetryTileAction g + U).cells))) ) := by + classical + intro negStar conjugateStar g + induction g with + | identity => intro x T U; simp [BandPackingSymmetryVectorAction, + BandPackingSymmetryTileAction] + | shift w => intro x T U; simp [BandPackingSymmetryVectorAction, + BandPackingSymmetryTileAction] + | negate => intro x T U; simpa [BandPackingSymmetryVectorAction, + BandPackingSymmetryTileAction] using negStar x T U + | conjugate => intro x T U; simpa [BandPackingSymmetryVectorAction, + BandPackingSymmetryTileAction] using conjugateStar x T U + | comp a b iha ihb => + intro x T U + change (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells ∨ + LatticeVertexIncidentCell x j ∈ U.cells) ↔ + (∀ j : Fin 4, LatticeVertexIncidentCell + (BandPackingSymmetryVectorAction a + (BandPackingSymmetryVectorAction b x)) j ∈ + (BandPackingSymmetryTileAction a (BandPackingSymmetryTileAction b T)).cells ∨ + LatticeVertexIncidentCell + (BandPackingSymmetryVectorAction a + (BandPackingSymmetryVectorAction b x)) j ∈ + (BandPackingSymmetryTileAction a (BandPackingSymmetryTileAction b U)).cells) + exact (ihb x T U).trans (iha _ _ _) + +private theorem partialValueCov : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : + GaussianInt), x ∈ h.domain → x ∈ k.domain → h.value x = k.value x → + (BandPackingSymmetryPartialOdometerAction g h).value (BandPackingSymmetryVectorAction + g x) = (BandPackingSymmetryPartialOdometerAction g k).value + (BandPackingSymmetryVectorAction g x) ) := by + classical + have forward (g : BandPackingSymmetry) (h : PartialOdometer) (x : GaussianInt) + (hx : x ∈ h.domain) : + BandPackingSymmetryVectorAction g x ∈ + (BandPackingSymmetryPartialOdometerAction g h).domain := by + change BandPackingSymmetryVectorAction g x ∈ + ((BandPackingSymmetryPartialOdometerAction g h).domain : Set GaussianInt) + rw [(BandPackingSymmetryPartialOdometerActionFormulas g h h).1] + exact ⟨x, hx, rfl⟩ + intro g + induction g with + | identity => intro h k x hx hk he; exact he + | shift w => + intro h k x hx hk he + simp [BandPackingSymmetryVectorAction, BandPackingSymmetryPartialOdometerAction, + hx, hk, he] + | negate => + intro h k x hx hk he + have hx' := forward .negate h x hx + have hk' := forward .negate k x hk + have inv (z : GaussianInt) : -GaussianQuarterTurn (GaussianQuarterTurn z) = z := by + ext <;> simp [GaussianQuarterTurn] + rw [(BandPackingSymmetryPartialOdometerActionFormulas .negate h k).2.2.2.1 _ hx', + (BandPackingSymmetryPartialOdometerActionFormulas .negate k h).2.2.2.1 _ hk'] + simp only [BandPackingSymmetryVectorAction, inv] + exact he + | conjugate => + intro h k x hx hk he + have hx' := forward .conjugate h x hx + have hk' := forward .conjugate k x hk + have inv (z : GaussianInt) : + -GaussianReflection (-GaussianReflection z) = z := by + ext <;> simp [GaussianReflection] + rw [(BandPackingSymmetryPartialOdometerActionFormulas .conjugate h k).2.2.2.2.1 _ hx', + (BandPackingSymmetryPartialOdometerActionFormulas .conjugate k h).2.2.2.2.1 _ hk'] + simp only [BandPackingSymmetryVectorAction, inv] + exact he + | comp a b iha ihb => + intro h k x hx hk he + have hb := ihb h k x hx hk he + have hxb := forward b h x hx + have hkb := forward b k x hk + rw [(BandPackingSymmetryPartialOdometerActionFormulas a h k).2.2.2.2.2.1 a b, + (BandPackingSymmetryPartialOdometerActionFormulas a k h).2.2.2.2.2.1 a b] + change (BandPackingSymmetryPartialOdometerAction a + (BandPackingSymmetryPartialOdometerAction b h)).value + (BandPackingSymmetryVectorAction a (BandPackingSymmetryVectorAction b x)) = + (BandPackingSymmetryPartialOdometerAction a + (BandPackingSymmetryPartialOdometerAction b k)).value + (BandPackingSymmetryVectorAction a (BandPackingSymmetryVectorAction b x)) + exact iha _ _ _ hxb hkb hb + +private theorem affineQuarterNeg : + (by + classical + exact + let affineQuarter : GaussianInt × GaussianInt → GaussianInt × GaussianInt := + fun z => (GaussianQuarterTurn z.1, -GaussianQuarterTurn z.2) + ∀ (z : GaussianInt × GaussianInt), affineQuarter (-z) = -affineQuarter z ) := by + classical + intro affineQuarter z + rcases z with ⟨v, a⟩ + ext <;> simp [affineQuarter, GaussianQuarterTurn] + +private theorem affineFacts : + (by + classical + exact + let affineQuarter : GaussianInt × GaussianInt → GaussianInt × GaussianInt := + fun z => (GaussianQuarterTurn z.1, -GaussianQuarterTurn z.2) + ∀ k : BandPackingSymmetry, (∀ y, ∀ z, BandPackingSymmetryAffineVectorAction k (y + z) = + BandPackingSymmetryAffineVectorAction k y + BandPackingSymmetryAffineVectorAction k + z) ∧ (∀ y, BandPackingSymmetryAffineVectorAction k (-y) = + -BandPackingSymmetryAffineVectorAction k y) ∧ (∀ y, + BandPackingSymmetryAffineVectorAction k (affineQuarter y) = if + BandPackingSymmetryReversesOrientation k then -affineQuarter + (BandPackingSymmetryAffineVectorAction k y) else affineQuarter + (BandPackingSymmetryAffineVectorAction k y)) ) := by + classical + intro affineQuarter k + induction k with + | identity => exact ⟨fun _ _ => rfl, fun _ => rfl, fun _ => rfl⟩ + | shift w => + rcases w with ⟨wr, wi⟩ + refine ⟨?_, ?_, ?_⟩ + · rintro ⟨⟨vr, vi⟩, ⟨ar, ai⟩⟩ ⟨⟨ur, ui⟩, ⟨br, bi⟩⟩ + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianReflection] <;> ring + · rintro ⟨⟨vr, vi⟩, ⟨ar, ai⟩⟩ + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianReflection] <;> ring + · rintro ⟨⟨vr, vi⟩, ⟨ar, ai⟩⟩ + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianReflection, + BandPackingSymmetryReversesOrientation, affineQuarter, + GaussianQuarterTurn]; ring + | negate => + refine ⟨?_, ?_, ?_⟩ + · intro y z + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianQuarterTurn] <;> ring + · intro y + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianQuarterTurn] + · intro y + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianQuarterTurn, + BandPackingSymmetryReversesOrientation, affineQuarter] + | conjugate => + refine ⟨?_, ?_, ?_⟩ + · intro y z + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianReflection] <;> ring + · intro y + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianReflection] + · intro y + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianReflection, + BandPackingSymmetryReversesOrientation, affineQuarter, + GaussianQuarterTurn] + | comp a b iha ihb => + refine ⟨?_, ?_, ?_⟩ + · intro y z + change BandPackingSymmetryAffineVectorAction a + (BandPackingSymmetryAffineVectorAction b (y + z)) = _ + rw [ihb.1, iha.1] + rfl + · intro y + change BandPackingSymmetryAffineVectorAction a + (BandPackingSymmetryAffineVectorAction b (-y)) = _ + rw [ihb.2.1, iha.2.1] + rfl + · intro y + change BandPackingSymmetryAffineVectorAction a + (BandPackingSymmetryAffineVectorAction b (affineQuarter y)) = _ + rw [ihb.2.2] + cases ha : BandPackingSymmetryReversesOrientation a <;> + cases hb : BandPackingSymmetryReversesOrientation b <;> + simp [ha, hb, iha.2.1, iha.2.2, + BandPackingSymmetryReversesOrientation, + BandPackingSymmetryAffineVectorAction] + +private theorem affineFirst : + (by + classical + exact + ∀ (k : BandPackingSymmetry), ∀ (z : GaussianInt × GaussianInt), + (BandPackingSymmetryAffineVectorAction k z).1 = BandPackingSymmetryVectorAction k z.1 + ) := by + classical + intro k + induction k with + | identity => intro z; rfl + | negate => intro z; rfl + | conjugate => intro z; rfl + | shift w => intro z; rfl + | comp a b iha ihb => + intro z + change (BandPackingSymmetryAffineVectorAction a + (BandPackingSymmetryAffineVectorAction b z)).1 = + BandPackingSymmetryVectorAction a + (BandPackingSymmetryVectorAction b z.1) + rw [iha, ihb] + +private theorem circleCurvature : + (by + classical + exact + ∀ (k : BandPackingSymmetry), ∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction + k C).1 = C.1 ) := by + classical + intro k + induction k with + | identity => intro C; rfl + | negate => intro C; rfl + | conjugate => intro C; rfl + | shift w => intro C; rfl + | comp a b iha ihb => intro C; simp [BandPackingSymmetryCircleAction, iha, ihb] + +private theorem positiveSupport : + (by + classical + exact + ∀ (C : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (p : ℝ × ℝ), 0 < + C.1 → TileOdometer C U k → PartialOdometerSlope k = some p → U.cells.Nonempty ) := by + classical + intro C U k p hpos hO hp + have hd := PositiveCurvatureTileOdometerDomain C U k hpos hO + by_contra hn + have hde : (k.domain : Set GaussianInt) = {U.anchor} := by + rw [hd] + simp [FootprintVertices, hn] + have hs : (PartialOdometerSquares k).Nonempty := by + by_contra hs + simp [PartialOdometerSlope, hs] at hp + rcases hs with ⟨x, hx⟩ + simp only [PartialOdometerSquares, Finset.mem_filter] at hx + have hz : x + 1 = U.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.2.1 + have hz0 : x = U.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.1 + have hzbad := congrArg (fun z : GaussianInt => z.re) (hz.trans hz0.symm) + norm_num at hzbad + +private theorem hq0 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (C : CircleCoordinates), ∀ (q : Fin (4 : ℕ) → + CircleCoordinates), (q (0 : Fin (4 : ℕ)) = C) → ( + let q' := BandPackingSymmetryQuadrupleAction g q + q' 0 = BandPackingSymmetryCircleAction g C) ) := by + classical + intro g C q hqC q' + simpa [q', BandPackingSymmetryQuadrupleAction] using + congrArg (BandPackingSymmetryCircleAction g) hqC + +private theorem hqi : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (C' : CircleCoordinates), ∀ (T : ProtoTile), ∀ (T' : + ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : PartialOdometer), ∀ (q : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (q i.succ = C') → (∀ (e : Bool), + (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 + : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 + : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((C'.1 = (0 : + ℤ) ∨ ∃ (p : ℝ × ℝ) (p' : ℝ × ℝ), PartialOdometerSlope h = some p ∧ + PartialOdometerSlope h' = some p' ∧ p'.1 - p.1 = (if e = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q + (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p'.2 - p.2 = (if e = true then (1 : ℝ) else + (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ( + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + q' (sigma i).succ = BandPackingSymmetryCircleAction g C'))) ) := by + classical + intro g C' T T' h h' q i hqC' e hcent hslope q' sigma + have hidx : q' (sigma i).succ = + BandPackingSymmetryCircleAction g (q i.succ) := by + cases hor : BandPackingSymmetryReversesOrientation g <;> fin_cases i <;> + simp [q', sigma, BandPackingSymmetryQuadrupleAction, hor] + all_goals rfl + rw [hidx] + exact congrArg (BandPackingSymmetryCircleAction g) hqC' + +private theorem hcentM : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (e : Bool), (TileCentroid T' - TileCentroid T = (if e = true then (1 + : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (2 : + Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).1))) → ( + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + let M : GaussianInt × GaussianInt := + (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) + let eReal : ℝ := if e then 1 else -1 + let k : ℝ := eReal / 2 + TileCentroid T' - TileCentroid T = k • GaussianRealPoint M.1) ) := by + classical + intro T T' q i e hcent W A M eReal k + have hpoint : GaussianRealPoint M.1 = + GaussianRealPoint W - (-(GaussianRealPoint W).2, + (GaussianRealPoint W).1) := by + ext <;> simp [M, GaussianRealPoint, GaussianQuarterTurn] + rw [show k = eReal * (1 / 2) by dsimp [k]; ring] + rw [hpoint] + simpa [eReal, smul_smul, smul_eq_mul] using hcent + +private theorem hWphase : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : + ℕ)), ∀ (delta : Bool), (BandPackingSymmetryScopedPhase g q delta) → ( + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let W' := BandVectors.1 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + W' = (if delta then (-1 : GaussianInt) else 1) * (if + BandPackingSymmetryReversesOrientation g then GaussianQuarterTurn + (BandPackingSymmetryVectorAction g W) else BandPackingSymmetryVectorAction g W)) ) := by + classical + intro g q i delta hphase q' sigma W W' + simpa [W', W, q', sigma, BandPackingSymmetryReversesOrientation] using + (hphase i).2.2 + +private theorem hactM : + (by + classical + exact + let affineQuarter : GaussianInt × GaussianInt → GaussianInt × GaussianInt := + fun z => (GaussianQuarterTurn z.1, -GaussianQuarterTurn z.2) + (∀ k : BandPackingSymmetry, (∀ y, ∀ z, BandPackingSymmetryAffineVectorAction k (y + z) = + BandPackingSymmetryAffineVectorAction k y + BandPackingSymmetryAffineVectorAction k + z) ∧ (∀ y, BandPackingSymmetryAffineVectorAction k (-y) = + -BandPackingSymmetryAffineVectorAction k y) ∧ (∀ y, + BandPackingSymmetryAffineVectorAction k (affineQuarter y) = if + BandPackingSymmetryReversesOrientation k then -affineQuarter + (BandPackingSymmetryAffineVectorAction k y) else affineQuarter + (BandPackingSymmetryAffineVectorAction k y))) → (∀ (g : BandPackingSymmetry), ∀ (q : + Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + let Z : GaussianInt × GaussianInt := (W, A) + let M : GaussianInt × GaussianInt := + (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) + (M = Z + -affineQuarter Z) → (BandPackingSymmetryAffineVectorAction g M = if + BandPackingSymmetryReversesOrientation g then BandPackingSymmetryAffineVectorAction g + Z + affineQuarter (BandPackingSymmetryAffineVectorAction g Z) else + BandPackingSymmetryAffineVectorAction g Z - affineQuarter + (BandPackingSymmetryAffineVectorAction g Z))) ) := by + classical + intro affineQuarter affineFacts g q i W A Z M hpat + calc + _ = BandPackingSymmetryAffineVectorAction g (Z + -affineQuarter Z) := + congrArg (BandPackingSymmetryAffineVectorAction g) hpat + _ = BandPackingSymmetryAffineVectorAction g Z + + BandPackingSymmetryAffineVectorAction g (-affineQuarter Z) := + (affineFacts g).1 _ _ + _ = BandPackingSymmetryAffineVectorAction g Z - + BandPackingSymmetryAffineVectorAction g (affineQuarter Z) := by + rw [(affineFacts g).2.1] + simp [sub_eq_add_neg] + _ = _ := by + rw [(affineFacts g).2.2] + cases BandPackingSymmetryReversesOrientation g <;> + ext <;> simp [affineQuarter, GaussianQuarterTurn]; ring + +private theorem hAphase : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : + ℕ)), ∀ (e : Bool), ∀ (delta : Bool), (∀ (i : Fin (3 : ℕ)), + let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); + let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); + let cyclic := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 + : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ + BandVectors.2 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : + ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation g = true then + -GaussianQuarterTurn cyclic.2 else cyclic.2) → ( + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + let Z : GaussianInt × GaussianInt := (W, A) + let A' := BandVectors.2 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + A' = (if delta then (-1 : GaussianInt) else 1) * (if + BandPackingSymmetryReversesOrientation g then -GaussianQuarterTurn + (BandPackingSymmetryAffineVectorAction g Z).2 else + (BandPackingSymmetryAffineVectorAction g Z).2)) ) := by + classical + intro g q i e delta hcyc q' sigma W A Z A' + simpa [A', Z, q', sigma, BandPackingSymmetryReversesOrientation] using + (hcyc i).2 + +private theorem hMphase : + (by + classical + exact + let affineQuarter : GaussianInt × GaussianInt → GaussianInt × GaussianInt := + fun z => (GaussianQuarterTurn z.1, -GaussianQuarterTurn z.2) + ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : + ℕ)), ∀ (e : Bool), ∀ (delta : Bool), (BandPackingSymmetryScopedPhase g q delta) → ((∀ + (i : Fin (3 : ℕ)), + let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); + let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); + let cyclic := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 + : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ + BandVectors.2 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : + ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation g = true then + -GaussianQuarterTurn cyclic.2 else cyclic.2) → ( + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + let Z : GaussianInt × GaussianInt := (W, A) + let M : GaussianInt × GaussianInt := + (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) + let W' := BandVectors.1 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + let A' := BandVectors.2 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + (W' = (if delta then (-1 : GaussianInt) else 1) * (if + BandPackingSymmetryReversesOrientation g then GaussianQuarterTurn + (BandPackingSymmetryVectorAction g W) else BandPackingSymmetryVectorAction g W)) → + (((BandPackingSymmetryAffineVectorAction g Z).1 = BandPackingSymmetryVectorAction g + Z.1) → ((BandPackingSymmetryAffineVectorAction g M = if + BandPackingSymmetryReversesOrientation g then BandPackingSymmetryAffineVectorAction g + Z + affineQuarter (BandPackingSymmetryAffineVectorAction g Z) else + BandPackingSymmetryAffineVectorAction g Z - affineQuarter + (BandPackingSymmetryAffineVectorAction g Z)) → ((A' = (if delta then (-1 : + GaussianInt) else 1) * (if BandPackingSymmetryReversesOrientation g then + -GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction g Z).2 else + (BandPackingSymmetryAffineVectorAction g Z).2)) → ((W' - GaussianQuarterTurn W', A' + + GaussianQuarterTurn A') = if delta then -(BandPackingSymmetryAffineVectorAction g M) + else BandPackingSymmetryAffineVectorAction g M)))))) ) := by + classical + intro affineQuarter g q i e delta hphase hcyc q' sigma W A Z M W' A' hWphase haffFst hactM hAphase + rw [hWphase, hAphase, ← haffFst, hactM] + cases delta <;> cases hor : BandPackingSymmetryReversesOrientation g <;> + ext <;> simp [affineQuarter, GaussianQuarterTurn] <;> ring + +private theorem hcentGoal : + (by + classical + exact + (∀ (k : BandPackingSymmetry), ∀ (z : GaussianInt × GaussianInt), + (BandPackingSymmetryAffineVectorAction k z).1 = BandPackingSymmetryVectorAction k + z.1) → (∀ (g : BandPackingSymmetry), ∀ (C' : CircleCoordinates), ∀ (T : ProtoTile), ∀ + (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : PartialOdometer), ∀ (q : Fin (4 : + ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (e : Bool), (TileCentroid T' - + TileCentroid T = (if e = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((C'.1 = (0 : + ℤ) ∨ ∃ (p : ℝ × ℝ) (p' : ℝ × ℝ), PartialOdometerSlope h = some p ∧ + PartialOdometerSlope h' = some p' ∧ p'.1 - p.1 = (if e = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q + (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p'.2 - p.2 = (if e = true then (1 : ℝ) else + (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (∀ (delta : Bool), + (BandPackingSymmetryScopedPhase g q delta) → ((∀ (i : Fin (3 : ℕ)), + let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); + let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); + let cyclic := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 + : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ + BandVectors.2 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : + ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation g = true then + -GaussianQuarterTurn cyclic.2 else cyclic.2) → ( + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let e' := xor e delta + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + let Z : GaussianInt × GaussianInt := (W, A) + let M : GaussianInt × GaussianInt := + (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) + let W' := BandVectors.1 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + let A' := BandVectors.2 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + let eReal : ℝ := if e then 1 else -1 + let k : ℝ := eReal / 2 + (TileCentroid T' - TileCentroid T = k • GaussianRealPoint M.1) → ((TileCentroid + (BandPackingSymmetryTileAction g T') - TileCentroid (BandPackingSymmetryTileAction g + T) = k • GaussianRealPoint (BandPackingSymmetryAffineVectorAction g (M.1, (0 : + GaussianInt))).1 ∧ BandPackingSymmetrySlopeAction g T' ((0 : ℝ), (0 : ℝ)) - + BandPackingSymmetrySlopeAction g T ((0 : ℝ), (0 : ℝ)) = k • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g (M.1, (0 : GaussianInt))).2) → ((W' = (if + delta then (-1 : GaussianInt) else 1) * (if BandPackingSymmetryReversesOrientation g + then GaussianQuarterTurn (BandPackingSymmetryVectorAction g W) else + BandPackingSymmetryVectorAction g W)) → ((A' = (if delta then (-1 : GaussianInt) else + 1) * (if BandPackingSymmetryReversesOrientation g then -GaussianQuarterTurn + (BandPackingSymmetryAffineVectorAction g Z).2 else + (BandPackingSymmetryAffineVectorAction g Z).2)) → (((W' - GaussianQuarterTurn W', A' + + GaussianQuarterTurn A') = if delta then -(BandPackingSymmetryAffineVectorAction g + M) else BandPackingSymmetryAffineVectorAction g M) → (((W' - GaussianQuarterTurn W', + A' + GaussianQuarterTurn A').1 = (if delta = true then + -BandPackingSymmetryAffineVectorAction g M else BandPackingSymmetryAffineVectorAction + g M).1) → (TileCentroid (BandPackingSymmetryTileAction g T') - TileCentroid + (BandPackingSymmetryTileAction g T) = (if e' then (1 : ℝ) else -1) • ((1 / 2 : ℝ) • + (GaussianRealPoint W' - (-(GaussianRealPoint W').2, (GaussianRealPoint + W').1)))))))))))))) ) := by + classical + intro affineFirst g C' T T' h h' q i e hcent hslope delta hphase hcyc q' sigma e' W A Z M W' A' + eReal k hcentM htr hWphase hAphase hMphase hmFst + have hreal : GaussianRealPoint (W' - GaussianQuarterTurn W') = + GaussianRealPoint W' - + (-(GaussianRealPoint W').2, (GaussianRealPoint W').1) := by + ext <;> simp [GaussianRealPoint, GaussianQuarterTurn] + have hfst : (BandPackingSymmetryAffineVectorAction g (M.1, 0)).1 = + (BandPackingSymmetryAffineVectorAction g M).1 := by + rw [affineFirst, affineFirst] + rw [← hreal] + have htr' : TileCentroid (BandPackingSymmetryTileAction g T') - + TileCentroid (BandPackingSymmetryTileAction g T) = + k • GaussianRealPoint (BandPackingSymmetryAffineVectorAction g M).1 := by + simpa only [hfst] using htr.1 + calc + _ = k • GaussianRealPoint (BandPackingSymmetryAffineVectorAction g M).1 := htr' + _ = (if e' then (1 : ℝ) else -1) • ((1 / 2 : ℝ) • + GaussianRealPoint (W' - GaussianQuarterTurn W')) := by + have hpointSign : GaussianRealPoint (W' - GaussianQuarterTurn W') = + (if delta then (-1 : ℝ) else 1) • + GaussianRealPoint (BandPackingSymmetryAffineVectorAction g M).1 := by + have hh := congrArg GaussianRealPoint hmFst + cases delta <;> simpa [GaussianRealPoint, smul_eq_mul] using hh + rw [hpointSign] + cases e <;> cases delta <;> + simp? [e', k, eReal, smul_eq_mul, + GaussianRealPoint] <;> ring <;> trivial + _ = _ := by rfl + +private theorem hposC : + (by + classical + exact + ∀ (C : CircleCoordinates), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple + q) → ((q (0 : Fin (4 : ℕ)) = C) → (0 < C.1)) ) := by + classical + intro C q hq hqC + rw [← hqC] + exact (ProperBandCurvatureStructure q hq).1 + +private theorem hsr : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), (Finset.Nonempty + T.cells → PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = + Option.map (BandPackingSymmetrySlopeAction g T) (PartialOdometerSlope h)) → (∀ (p : ℝ + × ℝ), (PartialOdometerSlope h = some p) → ((Finset.Nonempty T.cells) → + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = some + (BandPackingSymmetrySlopeAction g T p)))) ) := by + classical + intro g T h hST p hsp hTne + rw [hST hTne, hsp] + rfl + +private theorem hsr' : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), + (Finset.Nonempty T'.cells → PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction g h') = Option.map + (BandPackingSymmetrySlopeAction g T') (PartialOdometerSlope h')) → (∀ (p' : ℝ × ℝ), + (PartialOdometerSlope h' = some p') → ((Finset.Nonempty T'.cells) → + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h') = some + (BandPackingSymmetrySlopeAction g T' p')))) ) := by + classical + intro g T' h' hST' p' hsp' hT'ne + rw [hST' hT'ne, hsp'] + rfl + +private theorem hsourceSlope : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (e : Bool), (TileCentroid T' - TileCentroid T = (if e = true then (1 + : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (2 : + Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).1))) → ((Bool) → ( + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + let M : GaussianInt × GaussianInt := + (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) + let eReal : ℝ := if e then 1 else -1 + let k : ℝ := eReal / 2 + (TileCentroid T' - TileCentroid T = k • GaussianRealPoint M.1) → (∀ (p : ℝ × ℝ), ∀ (p' : + ℝ × ℝ), (p'.1 - p.1 = (if e = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : + ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ))) → ((p'.2 - p.2 = (if e = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q + (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (p' - p = k • GaussianRealPoint M.2))))) ) + := by + classical + intro T T' q i e hcent delta W A M eReal k hcentM p p' hRe hIm + have hRe' : p'.1 - p.1 = (if e then (1 : ℝ) else -1) * (1 / 2) * + (((GaussianInt.toComplex A).re) - (GaussianInt.toComplex A).im) := by + simpa [A] using hRe + have hIm' : p'.2 - p.2 = (if e then (1 : ℝ) else -1) * (1 / 2) * + (((GaussianInt.toComplex A).im) + (GaussianInt.toComplex A).re) := by + simpa [A] using hIm + apply Prod.ext + · calc + p'.1 - p.1 = (if e then (1 : ℝ) else -1) * (1 / 2) * + (((GaussianInt.toComplex A).re) - (GaussianInt.toComplex A).im) := hRe' + _ = (k • GaussianRealPoint M.2).1 := by + cases e <;> simp [A, M, k, eReal, GaussianRealPoint, + GaussianQuarterTurn, smul_eq_mul] <;> ring + · calc + p'.2 - p.2 = (if e then (1 : ℝ) else -1) * (1 / 2) * + (((GaussianInt.toComplex A).im) + (GaussianInt.toComplex A).re) := hIm' + _ = (k • GaussianRealPoint M.2).2 := by + cases e <;> simp [A, M, k, eReal, GaussianRealPoint, + GaussianQuarterTurn, smul_eq_mul]; ring + +private theorem hdiff : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (q : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (e : Bool), + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + let M : GaussianInt × GaussianInt := + (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) + let eReal : ℝ := if e then 1 else -1 + let k : ℝ := eReal / 2 + ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), (TileCentroid (BandPackingSymmetryTileAction g T') - + TileCentroid (BandPackingSymmetryTileAction g T) = k • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g (M.1, M.2)).1 ∧ + BandPackingSymmetrySlopeAction g T' p' - BandPackingSymmetrySlopeAction g T p = k • + GaussianRealPoint (BandPackingSymmetryAffineVectorAction g (M.1, M.2)).2) → ( + let r := BandPackingSymmetrySlopeAction g T p + let r' := BandPackingSymmetrySlopeAction g T' p' + r' - r = k • GaussianRealPoint (BandPackingSymmetryAffineVectorAction g M).2) ) := by + classical + intro g T T' q i e W A M eReal k p p' htrSlope r r' + simpa [r, r'] using htrSlope.2 + +private theorem hWphase2 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : + ℕ)), ∀ (delta : Bool), (BandPackingSymmetryScopedPhase g q delta) → ( + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let W' := BandVectors.1 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + W' = (if delta then (-1 : GaussianInt) else 1) * (if + BandPackingSymmetryReversesOrientation g then GaussianQuarterTurn + (BandPackingSymmetryVectorAction g W) else BandPackingSymmetryVectorAction g W)) ) := by + classical + intro g q i delta hphase q' sigma W W' + simpa [W', W, q', sigma, BandPackingSymmetryReversesOrientation] using + (hphase i).2.2 + +private theorem hAphase2 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : + ℕ)), ∀ (e : Bool), ∀ (delta : Bool), (∀ (i : Fin (3 : ℕ)), + let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); + let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); + let cyclic := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 + : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ + BandVectors.2 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : + ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation g = true then + -GaussianQuarterTurn cyclic.2 else cyclic.2) → ( + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + let Z : GaussianInt × GaussianInt := (W, A) + let A' := BandVectors.2 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + A' = (if delta then (-1 : GaussianInt) else 1) * (if + BandPackingSymmetryReversesOrientation g then -GaussianQuarterTurn + (BandPackingSymmetryAffineVectorAction g Z).2 else + (BandPackingSymmetryAffineVectorAction g Z).2)) ) := by + classical + intro g q i e delta hcyc q' sigma W A Z A' + simpa [A', Z, q', sigma, BandPackingSymmetryReversesOrientation] using + (hcyc i).2 + +private theorem hactM2 : + (by + classical + exact + let affineQuarter : GaussianInt × GaussianInt → GaussianInt × GaussianInt := + fun z => (GaussianQuarterTurn z.1, -GaussianQuarterTurn z.2) + (∀ k : BandPackingSymmetry, (∀ y, ∀ z, BandPackingSymmetryAffineVectorAction k (y + z) = + BandPackingSymmetryAffineVectorAction k y + BandPackingSymmetryAffineVectorAction k + z) ∧ (∀ y, BandPackingSymmetryAffineVectorAction k (-y) = + -BandPackingSymmetryAffineVectorAction k y) ∧ (∀ y, + BandPackingSymmetryAffineVectorAction k (affineQuarter y) = if + BandPackingSymmetryReversesOrientation k then -affineQuarter + (BandPackingSymmetryAffineVectorAction k y) else affineQuarter + (BandPackingSymmetryAffineVectorAction k y))) → (∀ (g : BandPackingSymmetry), ∀ (q : + Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + let Z : GaussianInt × GaussianInt := (W, A) + let M : GaussianInt × GaussianInt := + (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) + (M = Z + -affineQuarter Z) → (BandPackingSymmetryAffineVectorAction g M = if + BandPackingSymmetryReversesOrientation g then BandPackingSymmetryAffineVectorAction g + Z + affineQuarter (BandPackingSymmetryAffineVectorAction g Z) else + BandPackingSymmetryAffineVectorAction g Z - affineQuarter + (BandPackingSymmetryAffineVectorAction g Z))) ) := by + classical + intro affineQuarter affineFacts g q i W A Z M hpat2 + calc + _ = BandPackingSymmetryAffineVectorAction g (Z + -affineQuarter Z) := + congrArg (BandPackingSymmetryAffineVectorAction g) hpat2 + _ = BandPackingSymmetryAffineVectorAction g Z + + BandPackingSymmetryAffineVectorAction g (-affineQuarter Z) := + (affineFacts g).1 _ _ + _ = BandPackingSymmetryAffineVectorAction g Z - + BandPackingSymmetryAffineVectorAction g (affineQuarter Z) := by + rw [(affineFacts g).2.1] + simp [sub_eq_add_neg] + _ = _ := by + rw [(affineFacts g).2.2] + cases BandPackingSymmetryReversesOrientation g <;> + ext <;> simp [affineQuarter, GaussianQuarterTurn]; ring + +private theorem hMphase2 : + (by + classical + exact + let affineQuarter : GaussianInt × GaussianInt → GaussianInt × GaussianInt := + fun z => (GaussianQuarterTurn z.1, -GaussianQuarterTurn z.2) + (∀ (k : BandPackingSymmetry), ∀ (z : GaussianInt × GaussianInt), + (BandPackingSymmetryAffineVectorAction k z).1 = BandPackingSymmetryVectorAction k + z.1) → (∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (e : Bool), ∀ (delta : Bool), (BandPackingSymmetryScopedPhase g q + delta) → ((∀ (i : Fin (3 : ℕ)), + let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); + let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); + let cyclic := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 + : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ + BandVectors.2 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : + ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation g = true then + -GaussianQuarterTurn cyclic.2 else cyclic.2) → ( + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + let Z : GaussianInt × GaussianInt := (W, A) + let M : GaussianInt × GaussianInt := + (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) + let W' := BandVectors.1 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + let A' := BandVectors.2 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + (W' = (if delta then (-1 : GaussianInt) else 1) * (if + BandPackingSymmetryReversesOrientation g then GaussianQuarterTurn + (BandPackingSymmetryVectorAction g W) else BandPackingSymmetryVectorAction g W)) → + ((A' = (if delta then (-1 : GaussianInt) else 1) * (if + BandPackingSymmetryReversesOrientation g then -GaussianQuarterTurn + (BandPackingSymmetryAffineVectorAction g Z).2 else + (BandPackingSymmetryAffineVectorAction g Z).2)) → + ((BandPackingSymmetryAffineVectorAction g M = if + BandPackingSymmetryReversesOrientation g then BandPackingSymmetryAffineVectorAction g + Z + affineQuarter (BandPackingSymmetryAffineVectorAction g Z) else + BandPackingSymmetryAffineVectorAction g Z - affineQuarter + (BandPackingSymmetryAffineVectorAction g Z)) → ((W' - GaussianQuarterTurn W', A' + + GaussianQuarterTurn A') = if delta then -(BandPackingSymmetryAffineVectorAction g M) + else BandPackingSymmetryAffineVectorAction g M)))))) ) := by + classical + intro affineQuarter affineFirst g q i e delta hphase hcyc q' sigma W A Z M W' A' hWphase2 + hAphase2 hactM2 + rw [hWphase2, hAphase2, ← affineFirst g Z, hactM2] + cases delta <;> cases hor : BandPackingSymmetryReversesOrientation g <;> + ext <;> simp [affineQuarter, GaussianQuarterTurn] <;> ring + +private theorem hpointSignAt762 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : + ℕ)), ∀ (e : Bool), ∀ (delta : Bool), (BandPackingSymmetryScopedPhase g q delta) → ((∀ + (i : Fin (3 : ℕ)), + let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); + let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); + let cyclic := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 + : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ + BandVectors.2 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : + ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation g = true then + -GaussianQuarterTurn cyclic.2 else cyclic.2) → ( + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + let Z : GaussianInt × GaussianInt := (W, A) + let M : GaussianInt × GaussianInt := + (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) + let W' := BandVectors.1 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + let A' := BandVectors.2 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + (W' = (if delta then (-1 : GaussianInt) else 1) * (if + BandPackingSymmetryReversesOrientation g then GaussianQuarterTurn + (BandPackingSymmetryVectorAction g W) else BandPackingSymmetryVectorAction g W)) → + ((A' = (if delta then (-1 : GaussianInt) else 1) * (if + BandPackingSymmetryReversesOrientation g then -GaussianQuarterTurn + (BandPackingSymmetryAffineVectorAction g Z).2 else + (BandPackingSymmetryAffineVectorAction g Z).2)) → (((W' - GaussianQuarterTurn W', A' + + GaussianQuarterTurn A') = if delta then -(BandPackingSymmetryAffineVectorAction g + M) else BandPackingSymmetryAffineVectorAction g M) → (GaussianRealPoint (A' + + GaussianQuarterTurn A') = (if delta then (-1 : ℝ) else 1) • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g M).2))))) ) := by + classical + intro g q i e delta hphase hcyc q' sigma W A Z M W' A' hWphase2 hAphase2 hMphase2 + have hh := congrArg (fun z : GaussianInt × GaussianInt => + GaussianRealPoint z.2) hMphase2 + cases delta <;> simpa [GaussianRealPoint, smul_eq_mul] using hh + +private theorem hdiff' : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (q : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (e : Bool), (TileCentroid T' - + TileCentroid T = (if e = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (delta : + Bool), (BandPackingSymmetryScopedPhase g q delta) → ((∀ (i : Fin (3 : ℕ)), + let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); + let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); + let cyclic := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 + : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ + BandVectors.2 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : + ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation g = true then + -GaussianQuarterTurn cyclic.2 else cyclic.2) → ( + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let e' := xor e delta + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + let Z : GaussianInt × GaussianInt := (W, A) + let M : GaussianInt × GaussianInt := + (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) + let W' := BandVectors.1 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + let A' := BandVectors.2 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + let eReal : ℝ := if e then 1 else -1 + let k : ℝ := eReal / 2 + (TileCentroid T' - TileCentroid T = k • GaussianRealPoint M.1) → (∀ (p : ℝ × ℝ), ∀ (p' : + ℝ × ℝ), (p'.1 - p.1 = (if e = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : + ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ))) → ((p'.2 - p.2 = (if e = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q + (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((p' - p = k • GaussianRealPoint M.2) → + ((TileCentroid (BandPackingSymmetryTileAction g T') - TileCentroid + (BandPackingSymmetryTileAction g T) = k • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g (M.1, M.2)).1 ∧ + BandPackingSymmetrySlopeAction g T' p' - BandPackingSymmetrySlopeAction g T p = k • + GaussianRealPoint (BandPackingSymmetryAffineVectorAction g (M.1, M.2)).2) → ( + let r := BandPackingSymmetrySlopeAction g T p + let r' := BandPackingSymmetrySlopeAction g T' p' + (r' - r = k • GaussianRealPoint (BandPackingSymmetryAffineVectorAction g M).2) → ((W' = + (if delta then (-1 : GaussianInt) else 1) * (if + BandPackingSymmetryReversesOrientation g then GaussianQuarterTurn + (BandPackingSymmetryVectorAction g W) else BandPackingSymmetryVectorAction g W)) → + ((A' = (if delta then (-1 : GaussianInt) else 1) * (if + BandPackingSymmetryReversesOrientation g then -GaussianQuarterTurn + (BandPackingSymmetryAffineVectorAction g Z).2 else + (BandPackingSymmetryAffineVectorAction g Z).2)) → (((W' - GaussianQuarterTurn W', A' + + GaussianQuarterTurn A') = if delta then -(BandPackingSymmetryAffineVectorAction g + M) else BandPackingSymmetryAffineVectorAction g M) → ((GaussianRealPoint (A' + + GaussianQuarterTurn A') = (if delta then (-1 : ℝ) else 1) • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g M).2) → (r' - r = (if e' then (1 : ℝ) else + -1) • ((1 / 2 : ℝ) • GaussianRealPoint (A' + GaussianQuarterTurn A'))))))))))))))) ) + := by + classical + intro g T T' q i e hcent delta hphase hcyc q' sigma e' W A Z M W' A' eReal k hcentM p p' hRe + hIm hsourceSlope htrSlope r r' hdiff hWphase2 hAphase2 hMphase2 hpointSign + rw [hdiff, hpointSign] + cases e <;> cases delta <;> + ext <;> simp [e', k, eReal, smul_smul, smul_eq_mul] <;> ring + +private theorem finiteCompanion : + (by + classical + exact + ∀ (L : GaussianInt → GaussianInt), ∀ (rev : Bool), ∀ (delta : Bool), ∀ (s : Fin 4), ∀ (a + : GaussianInt), ∀ (a' : GaussianInt), (∀ z, L (-z) = -L z) → + (∀ z, L (GaussianQuarterTurn z) = + if rev then -GaussianQuarterTurn (L z) else GaussianQuarterTurn (L z)) → + a' = (if delta then -L a else L a) → + let s' : Fin 4 := if rev then -s - 1 + (if delta then 2 else 0) + else s + (if delta then 2 else 0); + L ((⟨0, 1⟩ : GaussianInt)^s.val * + (if Even s.val then GaussianQuarterTurn a else a)) = + (⟨0, 1⟩ : GaussianInt)^s'.val * + (if Even s'.val then GaussianQuarterTurn a' else a') ) := by + classical + intro L rev delta s a a' hneg hquarter hphase + dsimp + let s' : Fin 4 := if rev then -s - 1 + (if delta then 2 else 0) + else s + (if delta then 2 else 0) + have qm (z : GaussianInt) : GaussianQuarterTurn z = + (⟨0, 1⟩ : GaussianInt) * z := by + ext <;> simp [GaussianQuarterTurn] + have p0 (z : GaussianInt) : (⟨0, 1⟩ : GaussianInt)^0 * z = z := by simp + have p1 (z : GaussianInt) : (⟨0, 1⟩ : GaussianInt)^1 * z = + GaussianQuarterTurn z := by simpa using (qm z).symm + have unit2 : (⟨0, 1⟩ : GaussianInt)^2 = -1 := by + simp only [pow_two] + ext <;> norm_num + have unit3 : (⟨0, 1⟩ : GaussianInt)^3 = -⟨0, 1⟩ := by + rw [pow_succ, unit2] + norm_num + have q2 (z : GaussianInt) : + GaussianQuarterTurn (GaussianQuarterTurn z) = -z := by + ext <;> simp [GaussianQuarterTurn] + have qneg (z : GaussianInt) : + GaussianQuarterTurn (-z) = -GaussianQuarterTurn z := by + ext <;> simp [GaussianQuarterTurn] + have p2 (z : GaussianInt) : (⟨0, 1⟩ : GaussianInt)^2 * z = -z := by + rw [unit2] + simp + have p3 (z : GaussianInt) : (⟨0, 1⟩ : GaussianInt)^3 * z = + -GaussianQuarterTurn z := by + rw [unit3] + calc + (-(⟨0, 1⟩ : GaussianInt)) * z = + -((⟨0, 1⟩ : GaussianInt) * z) := by simp + _ = -GaussianQuarterTurn z := by rw [qm] + have ev0 : Even 0 := ⟨0, by omega⟩ + have ev2 : Even 2 := ⟨1, by omega⟩ + have odd1 : ¬ Even 1 := by rintro ⟨r, hr⟩; omega + have odd3 : ¬ Even 3 := by rintro ⟨r, hr⟩; omega + cases hrev : rev <;> cases hdel : delta <;> fin_cases s + all_goals + norm_num [Fin.val_neg, Fin.val_add, Fin.val_sub] at ⊢ + simp [ev0, ev2, odd3, p2, p3, + hphase, hquarter, hneg, hrev, hdel, qneg, ← qm] + +private theorem allNeg : + (by + classical + exact + ∀ (k : BandPackingSymmetry), ∀ (z : GaussianInt), BandPackingSymmetryVectorAction k (-z) + = -BandPackingSymmetryVectorAction k z ) := by + classical + intro k z + induction k generalizing z with + | identity => rfl + | negate => ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] + | conjugate => ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] + | shift w => rfl + | comp a b iha ihb => + simp only [BandPackingSymmetryVectorAction, ihb, iha] + +private theorem allQuarter : + (by + classical + exact + (∀ (k : BandPackingSymmetry), ∀ (z : GaussianInt), BandPackingSymmetryVectorAction k (-z) + = -BandPackingSymmetryVectorAction k z) → (∀ (k : BandPackingSymmetry), ∀ (z : + GaussianInt), BandPackingSymmetryVectorAction k (GaussianQuarterTurn z) = if + BandPackingSymmetryReversesOrientation k then -GaussianQuarterTurn + (BandPackingSymmetryVectorAction k z) else GaussianQuarterTurn + (BandPackingSymmetryVectorAction k z)) ) := by + classical + intro allNeg k + induction k with + | identity => intro z; rfl + | negate => intro z; rfl + | conjugate => + intro z + ext <;> simp [BandPackingSymmetryVectorAction, + BandPackingSymmetryReversesOrientation, GaussianQuarterTurn, GaussianReflection] + | shift w => intro z; rfl + | comp a b iha ihb => + intro z + cases ha : BandPackingSymmetryReversesOrientation a <;> + cases hb : BandPackingSymmetryReversesOrientation b <;> + simp [BandPackingSymmetryVectorAction, BandPackingSymmetryReversesOrientation, + ihb, iha, ha, hb, allNeg] + +private theorem qmul : + (by + classical + exact + ∀ (z : GaussianInt), GaussianQuarterTurn z = (⟨0, 1⟩ : GaussianInt) * z ) := by + classical + intro z + ext <;> simp [GaussianQuarterTurn] + +private theorem hflipA : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let a := BandVectors.1 (q i.succ) (q 0) + let b := BandVectors.1 (q 0) (q i.succ) + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) + (q i.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (q i.succ) (q (0 : + Fin (4 : ℕ)))) → ((∀ (z : GaussianInt), GaussianQuarterTurn z = (⟨0, 1⟩ : + GaussianInt) * z) → (b = GaussianQuarterTurn a)) ) := by + classical + intro q i a b hflip qmul + calc + b = (⟨0, 1⟩ : GaussianInt) * a := hflip.1 + _ = GaussianQuarterTurn a := (qmul a).symm + +private theorem hflipB : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let a' := BandVectors.1 (q' (sigma i).succ) (q' 0) + let b' := BandVectors.1 (q' 0) (q' (sigma i).succ) + (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' (sigma i).succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.1 (q' (sigma i).succ) (q' (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (q' (0 : Fin (4 : ℕ))) (q' (sigma i).succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q' (sigma i).succ) (q' (0 : Fin (4 : ℕ)))) → ((∀ (z : + GaussianInt), GaussianQuarterTurn z = (⟨0, 1⟩ : GaussianInt) * z) → (b' = + GaussianQuarterTurn a')) ) := by + classical + intro g q i q' sigma a' b' hflip' qmul + calc + b' = (⟨0, 1⟩ : GaussianInt) * a' := hflip'.1 + _ = GaussianQuarterTurn a' := (qmul a').symm + +private theorem hphase : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : + ℕ)), (Fin (4 : ℕ)) → (∀ (delta : Bool), (BandPackingSymmetryScopedPhase g q delta) → + ((ProtoTile) → ( + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let a := BandVectors.1 (q i.succ) (q 0) + let a' := BandVectors.1 (q' (sigma i).succ) (q' 0) + a' = if delta then -BandPackingSymmetryVectorAction g a else + BandPackingSymmetryVectorAction g a))) ) := by + classical + intro g q i s delta hdelta T q' sigma a a' + let b' := BandVectors.1 (q' 0) (q' (sigma i).succ) + have hh := hdelta i + dsimp [BandPackingSymmetryScopedPhase, sigma, a', a] at hh + cases delta <;> simpa using hh.1 + +private theorem linNeg : + (by + classical + exact + (∀ (k : BandPackingSymmetry), ∀ (z : GaussianInt), BandPackingSymmetryVectorAction k (-z) + = -BandPackingSymmetryVectorAction k z) → (∀ (g : BandPackingSymmetry), ∀ (z : + GaussianInt), BandPackingSymmetryVectorAction g (-z) = + -BandPackingSymmetryVectorAction g z) ) := by + classical + intro allNeg g z + exact allNeg g z + +private theorem linQuarter : + (by + classical + exact + (∀ (k : BandPackingSymmetry), ∀ (z : GaussianInt), BandPackingSymmetryVectorAction k + (GaussianQuarterTurn z) = if BandPackingSymmetryReversesOrientation k then + -GaussianQuarterTurn (BandPackingSymmetryVectorAction k z) else GaussianQuarterTurn + (BandPackingSymmetryVectorAction k z)) → (∀ (g : BandPackingSymmetry), ∀ (z : + GaussianInt), BandPackingSymmetryVectorAction g (GaussianQuarterTurn z) = if + BandPackingSymmetryReversesOrientation g then -GaussianQuarterTurn + (BandPackingSymmetryVectorAction g z) else GaussianQuarterTurn + (BandPackingSymmetryVectorAction g z)) ) := by + classical + intro allQuarter g z + exact allQuarter g z + +private theorem hdisp : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (s : Fin (4 : ℕ)), ∀ (delta : Bool), + let s' : Fin 4 := if BandPackingSymmetryReversesOrientation g then + -s - 1 + (if delta then 2 else 0) else s + (if delta then 2 else 0) + (∀ (L : GaussianInt → GaussianInt), ∀ (rev : Bool), ∀ (delta : Bool), ∀ (s : Fin 4), ∀ (a + : GaussianInt), ∀ (a' : GaussianInt), (∀ z, L (-z) = -L z) → + (∀ z, L (GaussianQuarterTurn z) = + if rev then -GaussianQuarterTurn (L z) else GaussianQuarterTurn (L z)) → + a' = (if delta then -L a else L a) → + let s' : Fin 4 := if rev then -s - 1 + (if delta then 2 else 0) + else s + (if delta then 2 else 0); + L ((⟨0, 1⟩ : GaussianInt)^s.val * + (if Even s.val then GaussianQuarterTurn a else a)) = + (⟨0, 1⟩ : GaussianInt)^s'.val * + (if Even s'.val then GaussianQuarterTurn a' else a')) → (∀ (q : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let a := BandVectors.1 (q i.succ) (q 0) + let b := BandVectors.1 (q 0) (q i.succ) + let a' := BandVectors.1 (q' (sigma i).succ) (q' 0) + let b' := BandVectors.1 (q' 0) (q' (sigma i).succ) + let d := (⟨0, 1⟩ : GaussianInt)^s.val * (if Even s.val then b else a) + let d' := (⟨0, 1⟩ : GaussianInt)^s'.val * + (if Even s'.val then b' else a') + (b = GaussianQuarterTurn a) → ((b' = GaussianQuarterTurn a') → ((a' = if delta then + -BandPackingSymmetryVectorAction g a else BandPackingSymmetryVectorAction g a) → ((∀ + (z : GaussianInt), BandPackingSymmetryVectorAction g (-z) = + -BandPackingSymmetryVectorAction g z) → ((∀ (z : GaussianInt), + BandPackingSymmetryVectorAction g (GaussianQuarterTurn z) = if + BandPackingSymmetryReversesOrientation g then -GaussianQuarterTurn + (BandPackingSymmetryVectorAction g z) else GaussianQuarterTurn + (BandPackingSymmetryVectorAction g z)) → (BandPackingSymmetryVectorAction g d = + d')))))) ) := by + classical + intro g s delta s' finiteCompanion q i q' sigma a b a' b' d d' hflipA hflipB hphase linNeg + linQuarter + dsimp [d, d'] + rw [hflipA, hflipB] + exact finiteCompanion (BandPackingSymmetryVectorAction g) + (BandPackingSymmetryReversesOrientation g) delta s a a' + linNeg linQuarter hphase + +private theorem htile : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : + ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (delta : Bool), ∀ (T : ProtoTile), + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let s' : Fin 4 := if BandPackingSymmetryReversesOrientation g then + -s - 1 + (if delta then 2 else 0) else s + (if delta then 2 else 0) + let a := BandVectors.1 (q i.succ) (q 0) + let b := BandVectors.1 (q 0) (q i.succ) + let a' := BandVectors.1 (q' (sigma i).succ) (q' 0) + let b' := BandVectors.1 (q' 0) (q' (sigma i).succ) + let d := (⟨0, 1⟩ : GaussianInt)^s.val * (if Even s.val then b else a) + let d' := (⟨0, 1⟩ : GaussianInt)^s'.val * + (if Even s'.val then b' else a') + let oldRight := TileTranslation T d + let newRight := TileTranslation (BandPackingSymmetryTileAction g T) d' + (BandPackingSymmetryVectorAction g d = d') → ((∀ (T : ProtoTile), ∀ (v : GaussianInt), + BandPackingSymmetryTileAction g (TileTranslation T v) = TileTranslation + (BandPackingSymmetryTileAction g T) (BandPackingSymmetryVectorAction g v)) → + (BandPackingSymmetryTileAction g oldRight = newRight)) ) := by + classical + intro g q i s delta T q' sigma s' a b a' b' d d' oldRight newRight hdisp htranslation + dsimp [oldRight, newRight] + rw [htranslation T d, hdisp] + +private theorem hinjAt948 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), Function.Injective (BandPackingSymmetryVectorAction g) ) := by + classical + intro g + rcases (BandPackingSymmetryInversePhaseCancellation).2 g with + ⟨inv, _, _, _, _, _, _, hleft, _, _, _, _⟩ + intro u v huv + calc + u = BandPackingSymmetryVectorAction inv + (BandPackingSymmetryVectorAction g u) := (hleft u).symm + _ = BandPackingSymmetryVectorAction inv + (BandPackingSymmetryVectorAction g v) := congrArg _ huv + _ = v := hleft v + +private theorem hfoot : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : + ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (delta : Bool), ∀ (T : ProtoTile), + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let s' : Fin 4 := if BandPackingSymmetryReversesOrientation g then + -s - 1 + (if delta then 2 else 0) else s + (if delta then 2 else 0) + let a := BandVectors.1 (q i.succ) (q 0) + let b := BandVectors.1 (q 0) (q i.succ) + let a' := BandVectors.1 (q' (sigma i).succ) (q' 0) + let b' := BandVectors.1 (q' 0) (q' (sigma i).succ) + let d := (⟨0, 1⟩ : GaussianInt)^s.val * (if Even s.val then b else a) + let d' := (⟨0, 1⟩ : GaussianInt)^s'.val * + (if Even s'.val then b' else a') + let oldRight := TileTranslation T d + let newRight := TileTranslation (BandPackingSymmetryTileAction g T) d' + (∀ (T : ProtoTile), FootprintVertices (BandPackingSymmetryTileAction g T) = + BandPackingSymmetryVectorAction g '' FootprintVertices T) → + ((BandPackingSymmetryTileAction g oldRight = newRight) → (FootprintVertices newRight + = BandPackingSymmetryVectorAction g '' FootprintVertices oldRight)) ) := by + classical + intro g q i s delta T q' sigma s' a b a' b' d d' oldRight newRight hfootprint htile + calc + FootprintVertices newRight = + FootprintVertices (BandPackingSymmetryTileAction g oldRight) := + congrArg FootprintVertices htile.symm + _ = BandPackingSymmetryVectorAction g '' FootprintVertices oldRight := hfootprint oldRight + +end MarkedCovarianceGeometry + +namespace MarkedCovarianceAssembly + +private theorem forwardSub : + (by + classical + exact + (∀ (g : BandPackingSymmetry), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), ∀ x ∈ + h.domain, x ∈ k.domain → h.value x = k.value x → + (BandPackingSymmetryPartialOdometerAction g h).value (BandPackingSymmetryVectorAction + g x) = (BandPackingSymmetryPartialOdometerAction g k).value + (BandPackingSymmetryVectorAction g x)) → ((∀ (g : BandPackingSymmetry), ∀ (U : + ProtoTile), ∀ (V : ProtoTile), ∀ (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), ∀ (v : GaussianInt), ∀ + (a : GaussianInt), ∀ (k : ℝ), TileCentroid V - TileCentroid U = k • GaussianRealPoint + v → x - y = k • GaussianRealPoint a → TileCentroid (BandPackingSymmetryTileAction g + V) - TileCentroid (BandPackingSymmetryTileAction g U) = k • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g (v, a)).1 ∧ BandPackingSymmetrySlopeAction g + V x - BandPackingSymmetrySlopeAction g U y = k • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g (v, a)).2) → ( + ( + let affineQuarter := fun (z : GaussianInt × GaussianInt) => (GaussianQuarterTurn z.1, + -GaussianQuarterTurn z.2); ∀ (k : BandPackingSymmetry), (∀ (y : GaussianInt × + GaussianInt), ∀ (z : GaussianInt × GaussianInt), + BandPackingSymmetryAffineVectorAction k (y + z) = + BandPackingSymmetryAffineVectorAction k y + BandPackingSymmetryAffineVectorAction k + z) ∧ (∀ (y : GaussianInt × GaussianInt), BandPackingSymmetryAffineVectorAction k (-y) + = -BandPackingSymmetryAffineVectorAction k y) ∧ ∀ (y : GaussianInt × GaussianInt), + BandPackingSymmetryAffineVectorAction k (affineQuarter y) = if + BandPackingSymmetryReversesOrientation k = true then -affineQuarter + (BandPackingSymmetryAffineVectorAction k y) else affineQuarter + (BandPackingSymmetryAffineVectorAction k y)) → ((∀ (k : BandPackingSymmetry), ∀ (z : + GaussianInt × GaussianInt), (BandPackingSymmetryAffineVectorAction k z).1 = + BandPackingSymmetryVectorAction k z.1) → ((∀ (k : BandPackingSymmetry), ∀ (C : + CircleCoordinates), (BandPackingSymmetryCircleAction k C).1 = C.1) → ((∀ (C : + CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (p : ℝ × ℝ), (0 : + ℤ) < C.1 → TileOdometer C U k → PartialOdometerSlope k = some p → Finset.Nonempty + U.cells) → (∀ (g : BandPackingSymmetry), ∀ (C : CircleCoordinates), ∀ (C' : + CircleCoordinates), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ + (h' : PartialOdometer), TileSubodometer C C' T T' h h' → TileSubodometer + (BandPackingSymmetryCircleAction g C) (BandPackingSymmetryCircleAction g C') + (BandPackingSymmetryTileAction g T) (BandPackingSymmetryTileAction g T') + (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g h'))))))) ) := by + classical + intro partialValueCov differenceTransport affineFacts affineFirst circleCurvature + positiveSupport g C C' T T' h h' hsub + let affineQuarter : GaussianInt × GaussianInt → GaussianInt × GaussianInt := + fun z => (GaussianQuarterTurn z.1, -GaussianQuarterTurn z.2) + rcases hsub with ⟨hO, hO', hfootSub, hdomSub, hvalueSub, hwitness⟩ + obtain ⟨hOT, hdomT, hST⟩ := BandPackingSymmetryTileOdometerCovariance g C T h hO + obtain ⟨hOT', hdomT', hST'⟩ := BandPackingSymmetryTileOdometerCovariance g C' T' h' hO' + rcases BandPackingSymmetryTilingTransport g with + ⟨_, _, _, _, _, _, _, hfootprint, _, _, _⟩ + refine ⟨hOT, hOT', ?_, ?_, ?_, ?_⟩ + · intro y hy + rw [hfootprint T'] at hy + rw [hfootprint T] + rcases hy with ⟨x, hx, rfl⟩ + exact ⟨x, hfootSub hx, rfl⟩ + · intro y hy + change y ∈ ((BandPackingSymmetryPartialOdometerAction g h').domain : + Set GaussianInt) at hy + rw [hdomT'] at hy + change y ∈ ((BandPackingSymmetryPartialOdometerAction g h).domain : + Set GaussianInt) + rw [hdomT] + rcases hy with ⟨x, hx, rfl⟩ + exact ⟨x, hdomSub hx, rfl⟩ + · intro y hy + change y ∈ ((BandPackingSymmetryPartialOdometerAction g h').domain : + Set GaussianInt) at hy + rw [hdomT'] at hy + rcases hy with ⟨x, hx, rfl⟩ + exact partialValueCov g h h' x (hdomSub hx) hx (hvalueSub x hx) + · rcases hwitness with ⟨q, i, hq, hqC, hqC', e, hcent, hslope⟩ + obtain ⟨delta, hphase, hcyc⟩ := + BandPackingSymmetryAffineVectorCovariance g q hq + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let e' := xor e delta + have hq' : ProperBandQuadruple q' := + BandPackingSymmetryProperCovariance g q hq + have hq0 := MarkedCovarianceGeometry.hq0 g C q hqC + have hqi := MarkedCovarianceGeometry.hqi g C' T T' h h' q i hqC' e hcent hslope + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + let Z : GaussianInt × GaussianInt := (W, A) + let M : GaussianInt × GaussianInt := + (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) + let W' := BandVectors.1 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + let A' := BandVectors.2 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)) + let eReal : ℝ := if e then 1 else -1 + let deltaReal : ℝ := if delta then -1 else 1 + let k : ℝ := eReal / 2 + have hcentM := MarkedCovarianceGeometry.hcentM T T' q i e hcent + refine ⟨q', sigma i, hq', hq0, hqi, e', ?_, ?_⟩ + · have htr := differenceTransport g T T' (0, 0) (0, 0) M.1 0 k + hcentM (by ext <;> norm_num [GaussianRealPoint]) + have hWphase := MarkedCovarianceGeometry.hWphase g q i delta hphase + have haffFst := affineFirst g Z + have hpat : M = Z + -affineQuarter Z := by + ext <;> simp [M, Z, affineQuarter, GaussianQuarterTurn]; ring + have hactM := MarkedCovarianceGeometry.hactM affineFacts g q i hpat + have hAphase := MarkedCovarianceGeometry.hAphase g q i e delta hcyc + have hMphase := MarkedCovarianceGeometry.hMphase g q i e delta hphase hcyc hWphase + haffFst hactM hAphase + have hmFst := congrArg Prod.fst hMphase + have hcentGoal := MarkedCovarianceGeometry.hcentGoal affineFirst g C' T T' h h' q i e + hcent hslope delta hphase hcyc hcentM htr hWphase hAphase hMphase hmFst + exact hcentGoal + · by_cases hzero : (q i.succ).1 = 0 + · left + rw [circleCurvature, ← hqC'] + exact hzero + · right + have hnonneg := (ProperBandCurvatureStructure q hq).2.1 i + have hpos : 0 < (q i.succ).1 := by omega + rcases hslope with hz | ⟨p, p', hsp, hsp', hRe, hIm⟩ + · have heq := congrArg Prod.fst hqC' + exact False.elim (hzero (by simpa [heq] using hz)) + have hposC := MarkedCovarianceGeometry.hposC C q hq hqC + have hTne := positiveSupport C T h p hposC hO hsp + have heq := congrArg Prod.fst hqC' + have hT'ne := positiveSupport C' T' h' p' + (by simpa [heq] using hpos) hO' hsp' + have hsr := MarkedCovarianceGeometry.hsr g T h hST p hsp hTne + have hsr' := MarkedCovarianceGeometry.hsr' g T' h' hST' p' hsp' hT'ne + have hsourceSlope := MarkedCovarianceGeometry.hsourceSlope T T' q i e hcent delta + hcentM p p' hRe hIm + have htrSlope := differenceTransport g T T' p' p M.1 M.2 k + hcentM hsourceSlope + let r := BandPackingSymmetrySlopeAction g T p + let r' := BandPackingSymmetrySlopeAction g T' p' + have hdiff := MarkedCovarianceGeometry.hdiff g T T' q i e p p' htrSlope + have hWphase2 := MarkedCovarianceGeometry.hWphase2 g q i delta hphase + have hAphase2 := MarkedCovarianceGeometry.hAphase2 g q i e delta hcyc + have hpat2 : M = Z + -affineQuarter Z := by + ext <;> simp [M, Z, affineQuarter, GaussianQuarterTurn]; ring + have hactM2 := MarkedCovarianceGeometry.hactM2 affineFacts g q i hpat2 + have hMphase2 := MarkedCovarianceGeometry.hMphase2 affineFirst g q i e delta hphase + hcyc hWphase2 hAphase2 hactM2 + have hpointSign := MarkedCovarianceGeometry.hpointSignAt762 g q i e delta hphase hcyc + hWphase2 hAphase2 hMphase2 + have hdiff' := MarkedCovarianceGeometry.hdiff' g T T' q i e hcent delta hphase hcyc + hcentM p p' hRe hIm hsourceSlope htrSlope hdiff hWphase2 hAphase2 hMphase2 hpointSign + refine ⟨r, r', hsr, hsr', ?_, ?_⟩ + · cases e <;> cases delta <;> + have hr := congrArg Prod.fst hdiff' <;> + convert hr using 1 <;> + simp [GaussianRealPoint, GaussianQuarterTurn, e', + smul_eq_mul] <;> ring + · cases e <;> cases delta <;> + have hr := congrArg Prod.snd hdiff' <;> + convert hr using 1 <;> + simp [GaussianRealPoint, GaussianQuarterTurn, e', + smul_eq_mul] <;> ring + +end MarkedCovarianceAssembly + +theorem BandPackingSymmetryMarkedDataCovariance : + (∀ (g : BandPackingSymmetry), ∀ (C : CircleCoordinates), ∀ (C' : CircleCoordinates), ∀ (T : + ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : PartialOdometer), + TileSubodometer C C' T T' h h' ↔ + TileSubodometer + (BandPackingSymmetryCircleAction g C) + (BandPackingSymmetryCircleAction g C') + (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryTileAction g T') + (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g h')) ∧ + (∀ (g : BandPackingSymmetry), ∀ (x : GaussianInt), ∀ (T : ProtoTile), ∀ (U : ProtoTile), (∀ j + : Fin 4, + LatticeVertexIncidentCell x j ∈ T.cells ∨ + LatticeVertexIncidentCell x j ∈ U.cells) ↔ + (∀ j : Fin 4, + LatticeVertexIncidentCell + (BandPackingSymmetryVectorAction g x) j ∈ + (BandPackingSymmetryTileAction g T).cells ∨ + LatticeVertexIncidentCell + (BandPackingSymmetryVectorAction g x) j ∈ + (BandPackingSymmetryTileAction g U).cells)) ∧ + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 -> CircleCoordinates), (ProperBandQuadruple q) → (∀ + (i : Fin 3), ∀ (s : Fin 4), ∀ (delta : Bool), (BandPackingSymmetryScopedPhase g q delta) + → (∀ (T : ProtoTile), ∀ (x : GaussianInt), + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 -> Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let s' : Fin 4 := + if BandPackingSymmetryReversesOrientation g then + -s - 1 + (if delta then 2 else 0) + else s + (if delta then 2 else 0) + let oldRight := TileTranslation T + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0))) + let newRight := TileTranslation (BandPackingSymmetryTileAction g T) + ((⟨0, 1⟩ : GaussianInt) ^ s'.val * + (if Even s'.val then BandVectors.1 (q' 0) (q' (sigma i).succ) + else BandVectors.1 (q' (sigma i).succ) (q' 0))) + BandPackingSymmetryTileAction g oldRight = newRight ∧ + (x ∈ FootprintVertices oldRight ↔ + BandPackingSymmetryVectorAction g x ∈ FootprintVertices newRight))) := by +-- BODY + classical + have negCellMap (x : GaussianInt) (j : Fin 4) := MarkedCovarianceGeometry.negCellMap x j + have negStar (x : GaussianInt) (T U : ProtoTile) := MarkedCovarianceGeometry.negStar negCellMap + x T U + have conjugateCellMap (x : GaussianInt) (j : Fin 4) := + MarkedCovarianceGeometry.conjugateCellMap x j + have conjugateCells (T : ProtoTile) := MarkedCovarianceGeometry.conjugateCells T + have conjugateStar (x : GaussianInt) (T U : ProtoTile) := + MarkedCovarianceGeometry.conjugateStar conjugateCellMap conjugateCells x T U + have starCov := MarkedCovarianceGeometry.starCov negStar conjugateStar + have partialValueCov := MarkedCovarianceGeometry.partialValueCov + have differenceTransport := P5625T1CentroidSlopeDifferenceCovariance.2 + let affineQuarter : GaussianInt × GaussianInt → GaussianInt × GaussianInt := + fun z => (GaussianQuarterTurn z.1, -GaussianQuarterTurn z.2) + have affineQuarterNeg (z : GaussianInt × GaussianInt) := + MarkedCovarianceGeometry.affineQuarterNeg z + have affineFacts := MarkedCovarianceGeometry.affineFacts + have affineFirst := MarkedCovarianceGeometry.affineFirst + have circleCurvature := MarkedCovarianceGeometry.circleCurvature + have positiveSupport := MarkedCovarianceGeometry.positiveSupport + have forwardSub := MarkedCovarianceAssembly.forwardSub partialValueCov differenceTransport + affineFacts affineFirst circleCurvature positiveSupport + have finiteCompanion := MarkedCovarianceGeometry.finiteCompanion + have allNeg := MarkedCovarianceGeometry.allNeg + have allQuarter := MarkedCovarianceGeometry.allQuarter allNeg + refine ⟨?_, ?_, ?_⟩ + · intro g C C' T T' h h' + constructor + · exact forwardSub g C C' T T' h h' + · intro hsub' + rcases (BandPackingSymmetryInversePhaseCancellation).2 g with + ⟨inv, hcl, _, _, _, htl, _, _, _, hpl, _, _⟩ + have hback := forwardSub inv + (BandPackingSymmetryCircleAction g C) + (BandPackingSymmetryCircleAction g C') + (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryTileAction g T') + (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g h') hsub' + simpa only [hcl, htl, hpl] using hback + · intro g x T U + exact starCov g x T U + · intro g q hq i s delta hdelta T x + dsimp + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let s' : Fin 4 := if BandPackingSymmetryReversesOrientation g then + -s - 1 + (if delta then 2 else 0) else s + (if delta then 2 else 0) + let a := BandVectors.1 (q i.succ) (q 0) + let b := BandVectors.1 (q 0) (q i.succ) + let a' := BandVectors.1 (q' (sigma i).succ) (q' 0) + let b' := BandVectors.1 (q' 0) (q' (sigma i).succ) + let epsilon : GaussianInt := if delta then -1 else 1 + let d := (⟨0, 1⟩ : GaussianInt)^s.val * (if Even s.val then b else a) + let d' := (⟨0, 1⟩ : GaussianInt)^s'.val * + (if Even s'.val then b' else a') + let oldRight := TileTranslation T d + let newRight := TileTranslation (BandPackingSymmetryTileAction g T) d' + have hproper' : ProperBandQuadruple q' := + BandPackingSymmetryProperCovariance g q hq + have hflip := (VectorRecursionLaws q hq.1).2.2.2.2 hq i + have hflip' := (VectorRecursionLaws q' hproper'.1).2.2.2.2 hproper' (sigma i) + have qmul (z : GaussianInt) := MarkedCovarianceGeometry.qmul z + have hflipA := MarkedCovarianceGeometry.hflipA q i hflip qmul + have hflipB := MarkedCovarianceGeometry.hflipB g q i hflip' qmul + have hphase := MarkedCovarianceGeometry.hphase g q i s delta hdelta T + have linNeg := MarkedCovarianceGeometry.linNeg allNeg g + have linQuarter := MarkedCovarianceGeometry.linQuarter allQuarter g + have hdisp := MarkedCovarianceGeometry.hdisp g s delta finiteCompanion q i hflipA hflipB + hphase linNeg linQuarter + rcases BandPackingSymmetryTilingTransport g with + ⟨_, _, _, _, _, _, htranslation, hfootprint, _, _, _⟩ + have htile := MarkedCovarianceGeometry.htile g q i s delta T hdisp htranslation + refine ⟨htile, ?_⟩ + have hinj := MarkedCovarianceGeometry.hinjAt948 g + have hfoot : FootprintVertices newRight = + BandPackingSymmetryVectorAction g '' FootprintVertices oldRight := + MarkedCovarianceGeometry.hfoot g q i s delta T hfootprint htile + rw [hfoot] + change x ∈ FootprintVertices oldRight ↔ + BandPackingSymmetryVectorAction g x ∈ + BandPackingSymmetryVectorAction g '' FootprintVertices oldRight + constructor + · intro hx + exact ⟨x, hx, rfl⟩ + · rintro ⟨y, hy, he⟩ + have hxy : y = x := hinj he + simpa [hxy] using hy + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerAction.lean new file mode 100644 index 0000000000..b345663483 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerAction.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.GaussianReflection +public import LeanPool.ApollonianSuperharmonic.PartialOdometer + +-- [TABLET NODE: BandPackingSymmetryPartialOdometerAction] + +/-! +# BandPackingSymmetryPartialOdometerAction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The partial-odometer action of a band-packing symmetry is defined +generator by generator. The identity fixes the function. A packing +shift $T_w$ keeps the literal finite domain and adds +$\operatorname{BandPackingShiftPotential}(w,\cdot)$ on that domain. Coordinate +negation sends a domain point $x$ to $ix$ and transports the value by the +inverse map $y\mapsto-iy$. Coordinate conjugation sends $x$ to +$-\bar x$ and transports the value by this involution. In every case the +stored total-function representative is zero off the transported finite +domain. A composite word acts by composition, with the right-hand word +acting first, in the same order as +`BandPackingSymmetryTileAction`. +-/ +noncomputable def BandPackingSymmetryPartialOdometerAction : + BandPackingSymmetry → PartialOdometer → PartialOdometer := +-- BODY + fun g h => match g with + | .identity => h + | .shift w => + { domain := h.domain + value := fun x => + if x ∈ h.domain then h.value x + BandPackingShiftPotential w x else 0 + value_outside := by + intro x hx + simp [hx] } + | .negate => + { domain := h.domain.image GaussianQuarterTurn + value := fun x => + if x ∈ h.domain.image GaussianQuarterTurn then + h.value (-GaussianQuarterTurn x) + else 0 + value_outside := by + intro x hx + simp [hx] } + | .conjugate => + { domain := h.domain.image (fun x => -GaussianReflection x) + value := fun x => + if x ∈ h.domain.image (fun y => -GaussianReflection y) then + h.value (-GaussianReflection x) + else 0 + value_outside := by + intro x hx + simp [hx] } + | .comp a b => + BandPackingSymmetryPartialOdometerAction a + (BandPackingSymmetryPartialOdometerAction b h) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerActionFormulas.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerActionFormulas.lean new file mode 100644 index 0000000000..3353ac85d5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerActionFormulas.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.GaussianReflection +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import LeanPool.ApollonianSuperharmonic.P2999T1CompleteSquareTransport +public import LeanPool.ApollonianSuperharmonic.P2999T1OrthogonalSlopeTransport +public import LeanPool.ApollonianSuperharmonic.P2999T1ShiftSlopeTransport + +-- [TABLET NODE: BandPackingSymmetryPartialOdometerActionFormulas] + +/-! +# BandPackingSymmetryPartialOdometerActionFormulas + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandPackingSymmetryPartialOdometerActionFormulas + (g : BandPackingSymmetry) (h k : PartialOdometer) : + (((BandPackingSymmetryPartialOdometerAction g h).domain : + Set GaussianInt) = + BandPackingSymmetryVectorAction g '' (h.domain : Set GaussianInt)) ∧ + BandPackingSymmetryPartialOdometerAction .identity h = h ∧ + (∀ w x, x ∈ h.domain → + (BandPackingSymmetryPartialOdometerAction (.shift w) h).value x = + h.value x + BandPackingShiftPotential w x) ∧ + (∀ x, x ∈ (BandPackingSymmetryPartialOdometerAction .negate h).domain → + (BandPackingSymmetryPartialOdometerAction .negate h).value x = + h.value (-GaussianQuarterTurn x)) ∧ + (∀ x, x ∈ + (BandPackingSymmetryPartialOdometerAction .conjugate h).domain → + (BandPackingSymmetryPartialOdometerAction .conjugate h).value x = + h.value (-GaussianReflection x)) ∧ + (∀ a b, + BandPackingSymmetryPartialOdometerAction (.comp a b) h = + BandPackingSymmetryPartialOdometerAction a + (BandPackingSymmetryPartialOdometerAction b h)) ∧ + (OdometerCompatibility + (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g k) ↔ + OdometerCompatibility h k) ∧ + ∀ T : ProtoTile, T.cells.Nonempty → + PartialOdometerSquares h = T.cells → + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = + (PartialOdometerSlope h).map + (BandPackingSymmetrySlopeAction g T) := by +-- BODY + classical + have invN (x : GaussianInt) : -GaussianQuarterTurn (GaussianQuarterTurn x) = x := by + ext <;> simp [GaussianQuarterTurn] + have invK (x : GaussianInt) : -GaussianReflection (-GaussianReflection x) = x := by + ext <;> simp [GaussianReflection] + have injN : Function.Injective GaussianQuarterTurn := by + intro x y he + simpa only [invN] using congrArg (fun z => -GaussianQuarterTurn z) he + have injK : Function.Injective (fun x => -GaussianReflection x) := by + intro x y he + simpa only [invK] using congrArg (fun z => -GaussianReflection z) he + have injective (g : BandPackingSymmetry) : + Function.Injective (BandPackingSymmetryVectorAction g) := by + induction g with + | identity => exact Function.injective_id + | shift w => exact Function.injective_id + | negate => exact injN + | conjugate => exact injK + | comp a b ia ib => exact ia.comp ib + have domain (g : BandPackingSymmetry) (h : PartialOdometer) : + ((BandPackingSymmetryPartialOdometerAction g h).domain : Set GaussianInt) = + BandPackingSymmetryVectorAction g '' (h.domain : Set GaussianInt) := by + induction g generalizing h with + | identity => simp [BandPackingSymmetryPartialOdometerAction, BandPackingSymmetryVectorAction] + | shift w => simp [BandPackingSymmetryPartialOdometerAction, BandPackingSymmetryVectorAction] + | negate => simp [BandPackingSymmetryPartialOdometerAction, BandPackingSymmetryVectorAction] + | conjugate => simp [BandPackingSymmetryPartialOdometerAction, BandPackingSymmetryVectorAction] + | comp a b ia ib => + simp only [BandPackingSymmetryPartialOdometerAction, BandPackingSymmetryVectorAction] + rw [ia, ib, Set.image_image] + have forward (g : BandPackingSymmetry) (h : PartialOdometer) (x : GaussianInt) + (hx : x ∈ h.domain) : + BandPackingSymmetryVectorAction g x ∈ + (BandPackingSymmetryPartialOdometerAction g h).domain := by + change BandPackingSymmetryVectorAction g x ∈ + ((BandPackingSymmetryPartialOdometerAction g h).domain : Set GaussianInt) + rw [domain] + exact ⟨x, hx, rfl⟩ + have difference (g : BandPackingSymmetry) (h k : PartialOdometer) + (x : GaussianInt) (hx : x ∈ h.domain) (hk : x ∈ k.domain) : + (BandPackingSymmetryPartialOdometerAction g k).value + (BandPackingSymmetryVectorAction g x) - + (BandPackingSymmetryPartialOdometerAction g h).value + (BandPackingSymmetryVectorAction g x) = k.value x - h.value x := by + induction g generalizing h k x with + | identity => rfl + | shift w => + simp only [BandPackingSymmetryVectorAction, BandPackingSymmetryPartialOdometerAction, + hx, hk, ↓reduceIte] + ring + | negate => + simp only [BandPackingSymmetryVectorAction, BandPackingSymmetryPartialOdometerAction, + Finset.mem_image_of_mem GaussianQuarterTurn hx, + Finset.mem_image_of_mem GaussianQuarterTurn hk, ↓reduceIte, invN] + | conjugate => + simp only [BandPackingSymmetryVectorAction, BandPackingSymmetryPartialOdometerAction, + Finset.mem_image_of_mem (fun z => -GaussianReflection z) hx, + Finset.mem_image_of_mem (fun z => -GaussianReflection z) hk, ↓reduceIte, invK] + | comp a b ia ib => + exact (ia _ _ _ (forward b h x hx) (forward b k x hk)).trans (ib h k x hx hk) + have compatible (h k : PartialOdometer) : + OdometerCompatibility h k ↔ + ∃ c : ℤ, ∀ x, x ∈ h.domain → x ∈ k.domain → k.value x - h.value x = c := by + constructor + · rintro (hd | hc) + · refine ⟨0, fun x hx hk => ?_⟩ + exact (Set.disjoint_left.mp hd hx hk).elim + · exact hc + · exact Or.inr + have compatibility : + OdometerCompatibility (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g k) ↔ OdometerCompatibility h k := by + rw [compatible, compatible] + constructor + · rintro ⟨c, hc⟩ + refine ⟨c, fun x hx hk => ?_⟩ + rw [← difference g h k x hx hk] + exact hc _ (forward g h x hx) (forward g k x hk) + · rintro ⟨c, hc⟩ + refine ⟨c, fun y hyh hyk => ?_⟩ + change y ∈ ((BandPackingSymmetryPartialOdometerAction g h).domain : Set GaussianInt) at hyh + change y ∈ ((BandPackingSymmetryPartialOdometerAction g k).domain : Set GaussianInt) at hyk + rw [domain] at hyh hyk + obtain ⟨x, hx, rfl⟩ := hyh + obtain ⟨z, hz, he⟩ := hyk + have zx : z = x := (injective g) he + subst z + rw [difference g h k x hx hz] + exact hc x hx hz + refine ⟨domain g h, rfl, ?_, ?_, ?_, ?_, compatibility, ?_⟩ + · intro w x hx + simp [BandPackingSymmetryPartialOdometerAction, hx] + · intro x hx + change x ∈ h.domain.image GaussianQuarterTurn at hx + simp only [BandPackingSymmetryPartialOdometerAction, ite_eq_left hx] + · intro x hx + change x ∈ h.domain.image (fun z => -GaussianReflection z) at hx + simp only [BandPackingSymmetryPartialOdometerAction, ite_eq_left hx] + · intro a b + rfl + · clear compatibility + have nonempty (g : BandPackingSymmetry) (T : ProtoTile) (hne : T.cells.Nonempty) : + (BandPackingSymmetryTileAction g T).cells.Nonempty := by + induction g generalizing T with + | identity => exact hne + | shift w => exact hne + | negate => exact hne.image _ + | conjugate => exact ((hne.image _).image _).image _ + | comp a b ia ib => exact ia _ (ib T hne) + induction g generalizing h with + | identity => + intro T hne hT + simp [BandPackingSymmetryPartialOdometerAction, BandPackingSymmetrySlopeAction] + | shift w => exact fun T hne hT => P2999T1ShiftSlopeTransport h w T hne hT + | negate => + intro T hne hT + exact (P2999T1OrthogonalSlopeTransport h).1 + | conjugate => + intro T hne hT + exact (P2999T1OrthogonalSlopeTransport h).2 + | comp a b ia ib => + intro T hne hT + change PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction a + (BandPackingSymmetryPartialOdometerAction b h)) = _ + rw [ia _ (BandPackingSymmetryTileAction b T) (nonempty b T hne) + (P2999T1CompleteSquareTransport b h T hT), ib h T hne hT] + simp only [Option.map_map, BandPackingSymmetrySlopeAction, Function.comp_def] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProjectiveVectorCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProjectiveVectorCovariance.lean new file mode 100644 index 0000000000..443e90968a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProjectiveVectorCovariance.lean @@ -0,0 +1,568 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct + +-- [TABLET NODE: BandPackingSymmetryProjectiveVectorCovariance] + +/-! +# BandPackingSymmetryProjectiveVectorCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ProjectiveCovarianceProof + +private theorem linj : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + let L := BandPackingSymmetryVectorAction + (ii ≠ 0) → ((∀ (z : GaussianInt), GaussianQuarterTurn z = ii * z) → ((∀ (z : + GaussianInt), GaussianReflection z = star z) → (∀ (h : BandPackingSymmetry), + Function.Injective (L h)))) + ) := by + classical + intro ii L ii_ne quarter reflection h + induction h with + | identity => exact fun _ _ h => h + | negate => + intro x y hxy + change GaussianQuarterTurn x = GaussianQuarterTurn y at hxy + rw [quarter, quarter] at hxy + exact mul_left_cancel₀ ii_ne hxy + | conjugate => + intro x y hxy + change -GaussianReflection x = -GaussianReflection y at hxy + simpa [reflection] using congrArg (fun z : GaussianInt => -star z) hxy + | shift w => exact fun _ _ h => h + | comp h k ih ik => exact ih.comp ik + +private theorem lquarter : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + let L := BandPackingSymmetryVectorAction + let O := BandPackingSymmetryReversesOrientation + (∀ (z : GaussianInt), GaussianQuarterTurn z = ii * z) → ((∀ (h : BandPackingSymmetry), ∀ + (x : GaussianInt), L h (-x) = -L h x) → (∀ (h : BandPackingSymmetry), ∀ (x : + GaussianInt), L h (ii * x) = if O h = true then -ii * L h x else ii * L h x)) + ) := by + classical + intro ii L O quarter lneg h x + induction h generalizing x with + | identity => rfl + | negate => + simp [L, O, BandPackingSymmetryVectorAction, + BandPackingSymmetryReversesOrientation, quarter] + | conjugate => + ext <;> simp [L, O, BandPackingSymmetryVectorAction, + BandPackingSymmetryReversesOrientation, GaussianReflection, ii] + | shift w => rfl + | comp h k ih ik => + change L h (L k (ii * x)) = + if xor (O h) (O k) then -ii * L h (L k x) else ii * L h (L k x) + rw [ik] + cases hh : O h <;> cases hk : O k <;> + simp [hh, neg_mul, lneg, ih] + +private theorem squareMap : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + let L := BandPackingSymmetryVectorAction + let A := BandPackingSymmetryCircleAction + (ii ^ 2 = -1) → ((∀ (z : GaussianInt), GaussianQuarterTurn z = ii * z) → ((∀ (z : + GaussianInt), GaussianReflection z = star z) → (∀ (h : BandPackingSymmetry), ∀ (C : + CircleCoordinates), ∀ (D : CircleCoordinates), ∀ (x : GaussianInt), x ^ (2 : ℕ) = + (↑D.1 : GaussianInt) * C.2 - (↑C.1 : GaussianInt) * D.2 → L h x ^ (2 : ℕ) = (↑(A h + D).1 : GaussianInt) * (A h C).2 - (↑(A h C).1 : GaussianInt) * (A h D).2))) + ) := by + classical + intro ii L A ii_sq quarter reflection h C D x hx + induction h generalizing C D x with + | identity => exact hx + | negate => + change GaussianQuarterTurn x ^ 2 = + (D.1 : GaussianInt) * -C.2 - (C.1 : GaussianInt) * -D.2 + rw [quarter] + calc + (ii * x) ^ 2 = -(x ^ 2) := by rw [mul_pow, ii_sq]; ring + _ = _ := by rw [hx]; ring + | conjugate => + simpa [L, A, BandPackingSymmetryVectorAction, BandPackingSymmetryCircleAction, + reflection] using congrArg star hx + | shift w => + change x ^ 2 = (D.1 : GaussianInt) * (C.2 + 2 * (C.1 : GaussianInt) * w) - + (C.1 : GaussianInt) * (D.2 + 2 * (D.1 : GaussianInt) * w) + rw [hx] + ring + | comp h k ih ik => exact ih (A k C) (A k D) (L k x) (ik C D x hx) + +private theorem parentNonzero : + (by + classical + exact + let v := BandVectors.1 + ∀ (p : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple p → ∀ (i : Fin (3 : ℕ)), ∀ + (j : Fin (3 : ℕ)), i ≠ j → v (p i.succ) (p j.succ) ≠ (0 : GaussianInt) + ) := by + classical + intro v p hp i j hij + have hc := ProperBandCurvatureStructure p hp + have hpos : 0 < (p i.succ).1 ∨ 0 < (p j.succ).1 := by + by_contra hn + push Not at hn + have hi : (p i.succ).1 = 0 := by have := hc.2.1 i; omega + have hj : (p j.succ).1 = 0 := by have := hc.2.1 j; omega + exact hij (hc.2.2 i j hi hj) + exact VectorNonvanishing p hp.1 i.succ j.succ + (fun h => hij (Fin.succ_injective _ h)) hpos + +private theorem squareEdges : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + let L := BandPackingSymmetryVectorAction + let A := BandPackingSymmetryCircleAction + let T := BandPackingSymmetryQuadrupleAction + let O := BandPackingSymmetryReversesOrientation + let v := BandVectors.1 + (ii ^ 2 = -1) → ((∀ (h : BandPackingSymmetry), ∀ (C : CircleCoordinates), ∀ (D : + CircleCoordinates), ∀ (x : GaussianInt), (x ^ 2 = (D.1 : GaussianInt) * C.2 - (C.1 : + GaussianInt) * D.2) → (L h x ^ 2 = ((A h D).1 : GaussianInt) * (A h C).2 - ((A h C).1 + : GaussianInt) * (A h D).2)) → ( + let W (p : Fin 4 → CircleCoordinates) (i : Fin 3) := + v (p ((i + 2).succ)) (p ((i + 1).succ)) + (-(1 : Fin 3) = 2) → ((-(2 : Fin 3) = 1) → (∀ (h : BandPackingSymmetry), ∀ (p : Fin (4 : + ℕ) → CircleCoordinates), ProperBandQuadruple p → ∀ (i : Fin (3 : ℕ)), W (T h p) (if O + h = true then -i else i) ^ (2 : ℕ) = (if O h = true then ii * L h (W p i) else L h (W + p i)) ^ (2 : ℕ))))) + ) := by + classical + intro ii L A T O v ii_sq squareMap W neg1 neg2 h p hp i + have ht := BandPackingSymmetryProperCovariance h p hp + have hij : (i + 2).succ ≠ (i + 1).succ := by fin_cases i <;> decide + have hs := squareMap h (p ((i + 2).succ)) (p ((i + 1).succ)) (W p i) + (by simpa only [W, v, zsmul_eq_mul] using + (VectorSquareProduct p hp.1 (i + 2).succ (i + 1).succ hij).1) + let j : Fin 3 := if O h then -i else i + have hj : (j + 2).succ ≠ (j + 1).succ := by + have allDifferent : ∀ k : Fin 3, (k + 2).succ ≠ (k + 1).succ := by decide +kernel + exact allDifferent j + have hs' := (VectorSquareProduct (T h p) ht.1 + (j + 2).succ (j + 1).succ hj).1 + cases he : O h <;> fin_cases i + all_goals + simp? [j, W, T, O, A, BandPackingSymmetryQuadrupleAction, + he, neg1, neg2, zsmul_eq_mul] at hs' hs ⊢ + first + | exact hs'.trans hs.symm + | rw [mul_pow, ii_sq, hs', hs]; ring + +private theorem commonSign : + (by + classical + exact + ∀ (a : Fin (3 : ℕ) → GaussianInt), ∀ (b : Fin (3 : ℕ) → GaussianInt), a (0 : Fin (3 : ℕ)) + + a (1 : Fin (3 : ℕ)) + a (2 : Fin (3 : ℕ)) = (0 : GaussianInt) → b (0 : Fin (3 : ℕ)) + + b (1 : Fin (3 : ℕ)) + b (2 : Fin (3 : ℕ)) = (0 : GaussianInt) → (∀ (i : Fin (3 : + ℕ)), b i ≠ (0 : GaussianInt)) → (∀ (i : Fin (3 : ℕ)), a i ^ (2 : ℕ) = b i ^ (2 : ℕ)) + → ∃ (d : Bool), ∀ (i : Fin (3 : ℕ)), a i = (if d = true then (-1 : GaussianInt) else + (1 : GaussianInt)) * b i + ) := by + classical + intro a b ha hb hn hs + rcases sq_eq_sq_iff_eq_or_eq_neg.mp (hs 0) with h0 | h0 <;> + rcases sq_eq_sq_iff_eq_or_eq_neg.mp (hs 1) with h1 | h1 <;> + rcases sq_eq_sq_iff_eq_or_eq_neg.mp (hs 2) with h2 | h2 + all_goals + first + | (refine ⟨false, ?_⟩; intro i; fin_cases i <;> + simp only [Bool.false_eq_true, ite_false, one_mul] <;> assumption) + | (refine ⟨true, ?_⟩; intro i; fin_cases i <;> + simp only [ite_true, neg_one_mul] <;> assumption) + | (rw [h0, h1, h2] at ha + have ar := congrArg Zsqrtd.re ha + have ai := congrArg Zsqrtd.im ha + have br := congrArg Zsqrtd.re hb + have bi := congrArg Zsqrtd.im hb + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_neg, + Zsqrtd.im_neg, Zsqrtd.re_zero, Zsqrtd.im_zero] at ar ai br bi + exfalso + first + | (apply hn 0; ext <;> simp only [Zsqrtd.re_zero, Zsqrtd.im_zero] <;> omega) + | (apply hn 1; ext <;> simp only [Zsqrtd.re_zero, Zsqrtd.im_zero] <;> omega) + | (apply hn 2; ext <;> simp only [Zsqrtd.re_zero, Zsqrtd.im_zero] <;> omega)) + +private theorem phaseExists : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + let L := BandPackingSymmetryVectorAction + let T := BandPackingSymmetryQuadrupleAction + let O := BandPackingSymmetryReversesOrientation + let v := BandVectors.1 + (ii ^ 2 = -1) → ((ii ≠ 0) → ((∀ (z : GaussianInt), GaussianQuarterTurn z = ii * z) → ((∀ + (h : BandPackingSymmetry), ∀ (x : GaussianInt), ∀ (y : GaussianInt), L h (x + y) = L + h x + L h y) → ((∀ (h : BandPackingSymmetry), ∀ (x : GaussianInt), L h (-x) = -L h x) + → ((∀ (h : BandPackingSymmetry), L h 0 = 0) → ((∀ (h : BandPackingSymmetry), ∀ (x : + GaussianInt), (x ≠ 0) → (L h x ≠ 0)) → ((∀ (h : BandPackingSymmetry), ∀ (x : + GaussianInt), L h (ii * x) = if O h then -ii * L h x else ii * L h x) → ( + let W (p : Fin 4 → CircleCoordinates) (i : Fin 3) := + v (p ((i + 2).succ)) (p ((i + 1).succ)) + (-(1 : Fin 3) = 2) → ((-(2 : Fin 3) = 1) → ((∀ (p : Fin 4 → CircleCoordinates), + (ProperBandQuadruple p) → (∀ (i : Fin 3), W p i ≠ 0)) → ((∀ (h : + BandPackingSymmetry), ∀ (p : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → (∀ + (i : Fin 3), W (T h p) (if O h then -i else i) ^ 2 = (if O h then ii * L h (W p i) + else L h (W p i)) ^ 2)) → ((∀ (p : Fin 4 → CircleCoordinates), (ProperBandQuadruple + p) → (W p 0 + W p 1 + W p 2 = 0)) → ((∀ (p : Fin 4 → CircleCoordinates), + (ProperBandQuadruple p) → (∀ (i : Fin 3), v (p i.succ) (p 0) = W p (i + 1) - ii * W p + (i + 2))) → ((∀ (p : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → (∀ (i : + Fin 3), v (p 0) (p i.succ) = ii * v (p i.succ) (p 0))) → ((∀ (a : Fin 3 → + GaussianInt), ∀ (b : Fin 3 → GaussianInt), (a 0 + a 1 + a 2 = 0) → ((b 0 + b 1 + b 2 + = 0) → ((∀ i, b i ≠ 0) → ((∀ i, a i ^ 2 = b i ^ 2) → (∃ d : Bool, ∀ i, a i = (if d + then (-1 : GaussianInt) else 1) * b i))))) → (∀ (h : BandPackingSymmetry), ∀ (p : Fin + (4 : ℕ) → CircleCoordinates), ProperBandQuadruple p → ∃ (d : Bool), + BandPackingSymmetryScopedPhase h p d)))))))))))))))) + ) := by + classical + intro ii L T O v ii_sq ii_ne quarter ladd lneg lzero lnonzero lquarter W neg1 neg2 wnonzero + squareEdges wsum rows flips commonSign h p hp + let s : Fin 3 → Fin 3 := fun i => if O h then -i else i + let b : Fin 3 → GaussianInt := fun i => + if O h then ii * L h (W p i) else L h (W p i) + have hp' := BandPackingSymmetryProperCovariance h p hp + have asum : W (T h p) (s 0) + W (T h p) (s 1) + W (T h p) (s 2) = 0 := by + have hs := wsum (T h p) hp' + cases he : O h <;> + simpa [s, he, neg1, neg2, add_assoc, add_left_comm, add_comm] using hs + have bsum : b 0 + b 1 + b 2 = 0 := by + have hs : L h (W p 0) + L h (W p 1) + L h (W p 2) = 0 := by + rw [← ladd, ← ladd, wsum p hp, lzero] + cases he : O h + · simpa [b, he] using hs + · simpa [b, he, mul_add] using congrArg (fun x => ii * x) hs + obtain ⟨d, hc⟩ := commonSign (fun i => W (T h p) (s i)) b asum bsum + (by intro i; dsimp [b]; split + · exact mul_ne_zero ii_ne (lnonzero h _ (wnonzero p hp i)) + · exact lnonzero h _ (wnonzero p hp i)) + (squareEdges h p hp) + let e : GaussianInt := if d then -1 else 1 + -- The rotated successor rows propagate the cyclic sign to incoming edges. + have incoming : ∀ i : Fin 3, + v (T h p (s i).succ) (T h p 0) = e * L h (v (p i.succ) (p 0)) := by + have c0 := hc 0 + have c1 := hc 1 + have c2 := hc 2 + intro i + have row := rows (T h p) hp' (s i) + rw [rows p hp i] + simp only [sub_eq_add_neg, ladd, lneg, lquarter] + cases he : O h <;> fin_cases i + all_goals + simp? [s, b, he, neg1, neg2, e] at c0 c1 c2 row ⊢ + rw [row] + simp only [c0, c1, c2] + cases d <;> simp <;> ring_nf <;> (try simp only [ii_sq]) <;> ring + refine ⟨d, ?_⟩ + intro i + simp only [quarter] + change v (T h p (s i).succ) (T h p 0) = e * L h (v (p i.succ) (p 0)) ∧ + v (T h p 0) (T h p (s i).succ) = e * + (if O h then -L h (v (p 0) (p i.succ)) else L h (v (p 0) (p i.succ))) ∧ + W (T h p) (s i) = e * b i + refine ⟨incoming i, ?_, hc i⟩ + rw [flips (T h p) hp' (s i), incoming i, flips p hp i, lquarter] + cases he : O h <;> simp [] <;> ring + +private theorem pt : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), + let ii : GaussianInt := ⟨0, 1⟩ + let L := BandPackingSymmetryVectorAction + let A := BandPackingSymmetryCircleAction + let O := BandPackingSymmetryReversesOrientation + let v := BandVectors.1 + (ii ≠ 0) → ((∀ (p : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → (∀ (i : Fin 3), + v (p 0) (p i.succ) = ii * v (p i.succ) (p 0))) → ((∀ (h : BandPackingSymmetry), ∀ (p + : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → (∃ d, + BandPackingSymmetryScopedPhase h p d)) → ((∀ (h : BandPackingSymmetry), ∀ (p : Fin 4 + → CircleCoordinates), ∀ (d : Bool), (BandPackingSymmetryScopedPhase h p d) → ((if O h + then v (A h (p 2)) (A h (p 3)) else v (A h (p 3)) (A h (p 2))) = (if d then (-1 : + GaussianInt) else 1) * (if O h then ii * L h (v (p 3) (p 2)) else L h (v (p 3) (p + 2))))) → ((∀ (h : BandPackingSymmetry), ∀ (p : Fin 4 → CircleCoordinates), ∀ (d : + Bool), (BandPackingSymmetryScopedPhase h p d) → (v (A h (p 1)) (A h (p 0)) = (if d + then (-1 : GaussianInt) else 1) * L h (v (p 1) (p 0)))) → ((∀ (d : Bool), ∀ (d' : + Bool), ∀ (x : GaussianInt), (x ≠ 0) → (((if d then (-1 : GaussianInt) else 1) * x = + (if d' then (-1 : GaussianInt) else 1) * x) → (d = d'))) → (∀ (d : Bool), + (BandPackingSymmetryScopedPhase g q d) → ( + let w := v (q 3) (q 2) + (L g w ≠ 0) → (∀ t : Fin 4 → CircleCoordinates, ProperBandQuadruple t → t 0 = q 2 → t 1 = + q 3 → BandPackingSymmetryScopedPhase g t d)))))))) + ) := by + classical + intro g q ii L A O v ii_ne flips phaseExists cyclic0 incoming0 signUnique d pq w ln + let T := BandPackingSymmetryQuadrupleAction + intro t ht ht0 ht1 + obtain ⟨dt, pht⟩ := phaseExists g t ht + have eqt := incoming0 g t dt pht + rw [ht0, ht1] at eqt + have eq0 := cyclic0 g q d pq + have hd : d = dt := by + cases ho : O g + · simp only [ho, Bool.false_eq_true, ite_false] at eq0 + exact signUnique d dt _ ln (eq0.symm.trans eqt) + · have flip := flips (T g t) (BandPackingSymmetryProperCovariance g t ht) 0 + have flip' : v (A g (q 2)) (A g (q 3)) = + ii * v (A g (q 3)) (A g (q 2)) := by + simpa [T, O, A, BandPackingSymmetryQuadrupleAction, ho, ht0, ht1] using flip + simp only [ho, ite_true] at eq0 + have eqs : (if d then (-1 : GaussianInt) else 1) * (ii * L g w) = + (if dt then (-1 : GaussianInt) else 1) * (ii * L g w) := by + calc + _ = v (A g (q 2)) (A g (q 3)) := eq0.symm + _ = ii * v (A g (q 3)) (A g (q 2)) := flip' + _ = _ := by rw [eqt]; ring + exact signUnique d dt _ (mul_ne_zero ii_ne ln) eqs + rwa [← hd] at pht + +end ProjectiveCovarianceProof + +theorem BandPackingSymmetryProjectiveVectorCovariance (g : BandPackingSymmetry) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) : + let n : BandPackingSymmetry := .comp .negate .negate + ∃ negative : Bool, + BandPackingSymmetryScopedPhase g q negative ∧ + (∀ r : Fin 4 → CircleCoordinates, ProperBandQuadruple r → + r 0 = q 1 → r 2 = q 2 → r 3 = q 3 → + BandPackingSymmetryScopedPhase g r negative) ∧ + (∀ t : Fin 4 → CircleCoordinates, ProperBandQuadruple t → + t 0 = q 2 → t 1 = q 3 → + BandPackingSymmetryScopedPhase g t negative) ∧ + (∀ C, BandPackingSymmetryCircleAction (.comp n g) C = + BandPackingSymmetryCircleAction g C) ∧ + BandPackingSymmetryReversesOrientation (.comp n g) = + BandPackingSymmetryReversesOrientation g ∧ + (∀ p, BandPackingSymmetryQuadrupleAction (.comp n g) p = + BandPackingSymmetryQuadrupleAction g p) ∧ + (∀ v, BandPackingSymmetryVectorAction (.comp n g) v = + -BandPackingSymmetryVectorAction g v) ∧ + ∃ g' : BandPackingSymmetry, + (g' = g ∨ g' = .comp n g) ∧ + (∀ C, BandPackingSymmetryCircleAction g' C = + BandPackingSymmetryCircleAction g C) ∧ + BandPackingSymmetryReversesOrientation g' = + BandPackingSymmetryReversesOrientation g ∧ + (∀ p, BandPackingSymmetryQuadrupleAction g' p = + BandPackingSymmetryQuadrupleAction g p) ∧ + BandPackingSymmetryScopedPhase g' q false ∧ + (∀ r : Fin 4 → CircleCoordinates, ProperBandQuadruple r → + r 0 = q 1 → r 2 = q 2 → r 3 = q 3 → + BandPackingSymmetryScopedPhase g' r false) ∧ + (∀ t : Fin 4 → CircleCoordinates, ProperBandQuadruple t → + t 0 = q 2 → t 1 = q 3 → + BandPackingSymmetryScopedPhase g' t false) := by +-- BODY + classical + let ii : GaussianInt := ⟨0, 1⟩ + let L := BandPackingSymmetryVectorAction + let A := BandPackingSymmetryCircleAction + let T := BandPackingSymmetryQuadrupleAction + let O := BandPackingSymmetryReversesOrientation + let v := BandVectors.1 + have ii_sq : ii ^ 2 = -1 := by decide +kernel + have ii_ne : ii ≠ 0 := by decide +kernel + have quarter (z : GaussianInt) : GaussianQuarterTurn z = ii * z := by + ext <;> simp [GaussianQuarterTurn, ii] + have reflection (z : GaussianInt) : GaussianReflection z = star z := rfl + -- Word-level algebra does not assert exact covariance of the canonical vectors. + have ladd (h : BandPackingSymmetry) (x y : GaussianInt) : + L h (x + y) = L h x + L h y := by + induction h generalizing x y with + | identity => rfl + | negate => simp [L, BandPackingSymmetryVectorAction, quarter, mul_add] + | conjugate => simp [L, BandPackingSymmetryVectorAction, reflection, add_comm] + | shift w => rfl + | comp h k ih ik => simp [L, BandPackingSymmetryVectorAction, ih, ik] + have lneg (h : BandPackingSymmetry) (x : GaussianInt) : L h (-x) = -L h x := by + induction h generalizing x with + | identity => rfl + | negate => simp [L, BandPackingSymmetryVectorAction, quarter] + | conjugate => simp [L, BandPackingSymmetryVectorAction, reflection] + | shift w => rfl + | comp h k ih ik => simp [L, BandPackingSymmetryVectorAction, ih, ik] + have lzero (h : BandPackingSymmetry) : L h 0 = 0 := by + induction h with + | identity => rfl + | negate => simp [L, BandPackingSymmetryVectorAction, quarter] + | conjugate => simp [L, BandPackingSymmetryVectorAction, reflection] + | shift w => rfl + | comp h k ih ik => simp [L, BandPackingSymmetryVectorAction, ih, ik] + have linj (h : BandPackingSymmetry) : Function.Injective (L h) := + ProjectiveCovarianceProof.linj ii_ne quarter reflection h + have lnonzero (h : BandPackingSymmetry) (x : GaussianInt) (hx : x ≠ 0) : + L h x ≠ 0 := by + intro hz + exact hx (linj h (hz.trans (lzero h).symm)) + have lquarter (h : BandPackingSymmetry) (x : GaussianInt) : + L h (ii * x) = if O h then -ii * L h x else ii * L h x := + ProjectiveCovarianceProof.lquarter quarter lneg h x + have squareMap (h : BandPackingSymmetry) (C D : CircleCoordinates) + (x : GaussianInt) + (hx : x ^ 2 = (D.1 : GaussianInt) * C.2 - (C.1 : GaussianInt) * D.2) : + L h x ^ 2 = ((A h D).1 : GaussianInt) * (A h C).2 - + ((A h C).1 : GaussianInt) * (A h D).2 := ProjectiveCovarianceProof.squareMap ii_sq + quarter reflection h C D x hx + have parentNonzero (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (i j : Fin 3) (hij : i ≠ j) : v (p i.succ) (p j.succ) ≠ 0 := + ProjectiveCovarianceProof.parentNonzero p hp i j hij + let W (p : Fin 4 → CircleCoordinates) (i : Fin 3) := + v (p ((i + 2).succ)) (p ((i + 1).succ)) + have neg1 : -(1 : Fin 3) = 2 := rfl + have neg2 : -(2 : Fin 3) = 1 := rfl + have wnonzero (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (i : Fin 3) : W p i ≠ 0 := by + apply parentNonzero p hp (i + 2) (i + 1) + fin_cases i <;> decide + have squareEdges (h : BandPackingSymmetry) (p : Fin 4 → CircleCoordinates) + (hp : ProperBandQuadruple p) (i : Fin 3) : + W (T h p) (if O h then -i else i) ^ 2 = + (if O h then ii * L h (W p i) else L h (W p i)) ^ 2 := + ProjectiveCovarianceProof.squareEdges ii_sq squareMap neg1 neg2 h p hp i + have wsum (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) : + W p 0 + W p 1 + W p 2 = 0 := (VectorRecursionLaws p hp.1).1 + have rows (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (i : Fin 3) : + v (p i.succ) (p 0) = W p (i + 1) - ii * W p (i + 2) := by + fin_cases i + · exact (VectorRecursionLaws p hp.1).2.2.1 + · exact (VectorRecursionLaws _ (SemiProperQuadruple.rotate hp.1)).2.2.1 + · exact (VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hp.1))).2.2.1 + have flips (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (i : Fin 3) : v (p 0) (p i.succ) = ii * v (p i.succ) (p 0) := + ((VectorRecursionLaws p hp.1).2.2.2.2 hp i).1 + -- A mixed choice of square roots would force one superbasis vector to vanish. + have commonSign (a b : Fin 3 → GaussianInt) + (ha : a 0 + a 1 + a 2 = 0) (hb : b 0 + b 1 + b 2 = 0) + (hn : ∀ i, b i ≠ 0) (hs : ∀ i, a i ^ 2 = b i ^ 2) : + ∃ d : Bool, ∀ i, a i = (if d then (-1 : GaussianInt) else 1) * b i := + ProjectiveCovarianceProof.commonSign a b ha hb hn hs + have phaseExists (h : BandPackingSymmetry) (p : Fin 4 → CircleCoordinates) + (hp : ProperBandQuadruple p) : ∃ d, BandPackingSymmetryScopedPhase h p d := + ProjectiveCovarianceProof.phaseExists ii_sq ii_ne quarter ladd lneg lzero lnonzero + lquarter neg1 neg2 wnonzero squareEdges wsum rows flips commonSign h p hp + have cyclic0 (h : BandPackingSymmetry) (p : Fin 4 → CircleCoordinates) (d : Bool) + (hp : BandPackingSymmetryScopedPhase h p d) : + (if O h then v (A h (p 2)) (A h (p 3)) else v (A h (p 3)) (A h (p 2))) = + (if d then (-1 : GaussianInt) else 1) * + (if O h then ii * L h (v (p 3) (p 2)) else L h (v (p 3) (p 2))) := by + have he := (hp 0).2.2 + cases ho : O h <;> + simpa [BandPackingSymmetryScopedPhase, T, O, A, v, L, + BandPackingSymmetryQuadrupleAction, ho, neg1, neg2, quarter] using he + have incoming0 (h : BandPackingSymmetry) (p : Fin 4 → CircleCoordinates) (d : Bool) + (hp : BandPackingSymmetryScopedPhase h p d) : + v (A h (p 1)) (A h (p 0)) = + (if d then (-1 : GaussianInt) else 1) * L h (v (p 1) (p 0)) := by + have he := (hp 0).1 + cases ho : O h <;> + simpa [BandPackingSymmetryScopedPhase, T, O, A, v, L, + BandPackingSymmetryQuadrupleAction, ho] using he + have signUnique (d d' : Bool) (x : GaussianInt) (hx : x ≠ 0) + (he : (if d then (-1 : GaussianInt) else 1) * x = + (if d' then (-1 : GaussianInt) else 1) * x) : d = d' := by + have hc := mul_right_cancel₀ hx he + cases d <;> cases d' + · rfl + · have hr := congrArg Zsqrtd.re hc; norm_num at hr + · have hr := congrArg Zsqrtd.re hc; norm_num at hr + · rfl + obtain ⟨d, pq⟩ := phaseExists g q hq + let w := v (q 3) (q 2) + have wn : w ≠ 0 := wnonzero q hq 0 + have ln : L g w ≠ 0 := lnonzero g w wn + have cn : (if O g then ii * L g w else L g w) ≠ 0 := by + split + · exact mul_ne_zero ii_ne ln + · exact ln + -- Both predecessor families share the literal ordered edge v(q 3, q 2). + have pr : ∀ r : Fin 4 → CircleCoordinates, ProperBandQuadruple r → + r 0 = q 1 → r 2 = q 2 → r 3 = q 3 → BandPackingSymmetryScopedPhase g r d := by + intro r hr _ hr2 hr3 + obtain ⟨dr, phr⟩ := phaseExists g r hr + have eqr := cyclic0 g r dr phr + rw [hr2, hr3] at eqr + have hd : d = dr := signUnique d dr _ cn ((cyclic0 g q d pq).symm.trans eqr) + rwa [← hd] at phr + have pt : ∀ t : Fin 4 → CircleCoordinates, ProperBandQuadruple t → + t 0 = q 2 → t 1 = q 3 → BandPackingSymmetryScopedPhase g t d := + ProjectiveCovarianceProof.pt g q ii_ne flips phaseExists cyclic0 incoming0 signUnique d + pq ln + let n : BandPackingSymmetry := .comp .negate .negate + -- Double negation fixes the geometric actions and changes the vector phase. + have centralCircle (h : BandPackingSymmetry) (C : CircleCoordinates) : + BandPackingSymmetryCircleAction (.comp n h) C = BandPackingSymmetryCircleAction h C := by + simp [n, BandPackingSymmetryCircleAction] + have centralParity (h : BandPackingSymmetry) : + BandPackingSymmetryReversesOrientation (.comp n h) = + BandPackingSymmetryReversesOrientation h := by + simp [n, BandPackingSymmetryReversesOrientation] + have centralTuple (h : BandPackingSymmetry) (p : Fin 4 → CircleCoordinates) : + BandPackingSymmetryQuadrupleAction (.comp n h) p = + BandPackingSymmetryQuadrupleAction h p := by + simp only [BandPackingSymmetryQuadrupleAction, centralParity, centralCircle] + have centralVector (h : BandPackingSymmetry) (x : GaussianInt) : + BandPackingSymmetryVectorAction (.comp n h) x = -BandPackingSymmetryVectorAction h x := by + change GaussianQuarterTurn (GaussianQuarterTurn (L h x)) = -L h x + rw [quarter, quarter] + calc + ii * (ii * L h x) = ii ^ 2 * L h x := by ring + _ = -L h x := by rw [ii_sq]; simp + have adaptPhase (h : BandPackingSymmetry) (p : Fin 4 → CircleCoordinates) + (hp : BandPackingSymmetryScopedPhase h p true) : + BandPackingSymmetryScopedPhase (.comp n h) p false := by + unfold BandPackingSymmetryScopedPhase at hp ⊢ + cases ho : BandPackingSymmetryReversesOrientation h <;> + simpa [centralParity, centralTuple, centralVector, ho, quarter] using hp + refine ⟨d, pq, pr, pt, centralCircle g, centralParity g, centralTuple g, + centralVector g, ?_⟩ + cases d + · exact ⟨g, Or.inl rfl, (fun _ => rfl), rfl, (fun _ => rfl), pq, pr, pt⟩ + · refine ⟨.comp n g, Or.inr rfl, centralCircle g, centralParity g, + centralTuple g, adaptPhase g q pq, ?_, ?_⟩ + · intro r hr hr0 hr2 hr3 + exact adaptPhase g r (pr r hr hr0 hr2 hr3) + · intro t ht ht0 ht1 + exact adaptPhase g t (pt t ht ht0 ht1) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProperCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProperCovariance.lean new file mode 100644 index 0000000000..77ee9170ee --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProperCovariance.lean @@ -0,0 +1,234 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple + +-- [TABLET NODE: BandPackingSymmetryProperCovariance] + +/-! +# BandPackingSymmetryProperCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandPackingSymmetryProperCovariance (g : BandPackingSymmetry) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) : + ProperBandQuadruple (BandPackingSymmetryQuadrupleAction g q) := by +-- BODY + let R := fun r : Fin 4 → CircleCoordinates => ![r 0, r 2, r 3, r 1] + let S := fun r : Fin 4 → CircleCoordinates => + ![(2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1, + 2 * (r 0).2 + 2 * (r 2).2 + 2 * (r 3).2 - (r 1).2), + r 0, r 2, r 3] + let Q := BandPackingSymmetryQuadrupleAction + let root := fun z : GaussianInt => + (![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), + (0, 1), (0, -1)] : Fin 4 → CircleCoordinates) + -- The first proper successors of the two rotated roots. + let A := fun z => S (R (root z)) + let B := fun z => S (R (R (root z))) + have neg1 : -(1 : Fin 3) = 2 := rfl + have neg2 : -(2 : Fin 3) = 1 := rfl + have curvature (a : BandPackingSymmetry) (C : CircleCoordinates) : + (BandPackingSymmetryCircleAction a C).1 = C.1 := by + induction a generalizing C with + | identity => rfl + | negate => rfl + | conjugate => rfl + | shift w => rfl + | comp a b iha ihb => simp [BandPackingSymmetryCircleAction, iha, ihb] + have inequalities (a : BandPackingSymmetry) (r : Fin 4 → CircleCoordinates) + (hp : ProperBandQuadruple r) : + ∀ j : Fin 3, ((Q a r) j.succ).1 < ((Q a r) 0).1 := by + intro j + cases he : BandPackingSymmetryReversesOrientation a <;> fin_cases j + all_goals + first + | simpa [Q, BandPackingSymmetryQuadrupleAction, he, curvature, neg1, neg2] using hp.2 0 + | simpa [Q, BandPackingSymmetryQuadrupleAction, he, curvature, neg1, neg2] using hp.2 1 + | simpa [Q, BandPackingSymmetryQuadrupleAction, he, curvature, neg1, neg2] using hp.2 2 + have rotate_action (a : BandPackingSymmetry) (r : Fin 4 → CircleCoordinates) : + Q a (R r) = if BandPackingSymmetryReversesOrientation a then + R (R (Q a r)) else R (Q a r) := by + cases he : BandPackingSymmetryReversesOrientation a <;> + funext k <;> fin_cases k <;> + simp [Q, R, BandPackingSymmetryQuadrupleAction, he, neg1, neg2] + have successor_action (a : BandPackingSymmetry) + (ha : a = .negate ∨ a = .conjugate ∨ ∃ w, a = .shift w) + (r : Fin 4 → CircleCoordinates) : Q a (S r) = S (Q a r) := by + rcases ha with rfl | rfl | ⟨w, rfl⟩ + all_goals + funext k + fin_cases k + all_goals + apply Prod.ext + · simp [Q, S, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, BandPackingSymmetryReversesOrientation, neg1, neg2] + all_goals ring + · apply Zsqrtd.ext <;> + simp [Q, S, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, BandPackingSymmetryReversesOrientation, + GaussianReflection, neg1, neg2] <;> ring + have semiA (z : GaussianInt) : SemiProperQuadruple (A z) := + SemiProperQuadruple.successor (SemiProperQuadruple.rotate (SemiProperQuadruple.base z)) + have semiB (z : GaussianInt) : SemiProperQuadruple (B z) := + SemiProperQuadruple.successor + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate (SemiProperQuadruple.base z))) + have negateA (z : GaussianInt) : Q .negate (A z) = R (B (-1 - z - ⟨0, 1⟩)) := by + funext k + fin_cases k <;> apply Prod.ext + all_goals + simp [Q, A, B, R, S, root, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, BandPackingSymmetryReversesOrientation] + all_goals ring + have negateB (z : GaussianInt) : Q .negate (B z) = R (R (A (-1 - z - ⟨0, 1⟩))) := by + funext k + fin_cases k <;> apply Prod.ext + all_goals + simp [Q, A, B, R, S, root, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, BandPackingSymmetryReversesOrientation] + all_goals ring + have conjugateA (z : GaussianInt) : + Q .conjugate (A z) = R (R (A (GaussianReflection z - ⟨0, 1⟩))) := by + funext k + fin_cases k <;> apply Prod.ext <;> try apply Zsqrtd.ext + all_goals + simp [Q, A, R, S, root, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, BandPackingSymmetryReversesOrientation, + GaussianReflection, neg1, neg2] + all_goals ring + have conjugateB (z : GaussianInt) : + Q .conjugate (B z) = R (B (GaussianReflection z - ⟨0, 1⟩)) := by + funext k + fin_cases k <;> apply Prod.ext <;> try apply Zsqrtd.ext + all_goals + simp [Q, B, R, S, root, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, BandPackingSymmetryReversesOrientation, + GaussianReflection, neg1, neg2] + all_goals ring + have shiftA (w z : GaussianInt) : Q (.shift w) (A z) = A (z + w) := by + funext k + fin_cases k <;> apply Prod.ext + all_goals + simp [Q, A, R, S, root, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, BandPackingSymmetryReversesOrientation] + all_goals ring + have shiftB (w z : GaussianInt) : Q (.shift w) (B z) = B (z + w) := by + funext k + fin_cases k <;> apply Prod.ext + all_goals + simp [Q, B, R, S, root, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, BandPackingSymmetryReversesOrientation] + all_goals ring + have firstA (a : BandPackingSymmetry) + (ha : a = .negate ∨ a = .conjugate ∨ ∃ w, a = .shift w) + (z : GaussianInt) : SemiProperQuadruple (Q a (A z)) := by + rcases ha with rfl | rfl | ⟨w, rfl⟩ + · rw [negateA] + exact SemiProperQuadruple.rotate (semiB _) + · rw [conjugateA] + exact SemiProperQuadruple.rotate (SemiProperQuadruple.rotate (semiA _)) + · rw [shiftA] + exact semiA _ + have firstB (a : BandPackingSymmetry) + (ha : a = .negate ∨ a = .conjugate ∨ ∃ w, a = .shift w) + (z : GaussianInt) : SemiProperQuadruple (Q a (B z)) := by + rcases ha with rfl | rfl | ⟨w, rfl⟩ + · rw [negateB] + exact SemiProperQuadruple.rotate (SemiProperQuadruple.rotate (semiA _)) + · rw [conjugateB] + exact SemiProperQuadruple.rotate (semiB _) + · rw [shiftB] + exact semiB _ + -- Only proper inputs are transported through the semi-proper forest. + have generator (a : BandPackingSymmetry) + (ha : a = .negate ∨ a = .conjugate ∨ ∃ w, a = .shift w) + (r : Fin 4 → CircleCoordinates) (hs : SemiProperQuadruple r) : + ProperBandQuadruple r → ProperBandQuadruple (Q a r) := by + induction hs with + | base z => + intro hp + have bad := hp.2 (0 : Fin 3) + norm_num at bad + | @rotate r hs ih => + intro hp + have old : ProperBandQuadruple r := by + refine ⟨hs, ?_⟩ + intro j + fin_cases j + · simpa using hp.2 2 + · simpa using hp.2 0 + · simpa using hp.2 1 + refine ⟨?_, inequalities a _ hp⟩ + change SemiProperQuadruple (Q a (R r)) + rw [rotate_action] + cases BandPackingSymmetryReversesOrientation a + · exact SemiProperQuadruple.rotate (ih old).1 + · exact SemiProperQuadruple.rotate (SemiProperQuadruple.rotate (ih old).1) + | @successor r hs ih => + intro hp + refine ⟨?_, inequalities a _ hp⟩ + change SemiProperQuadruple (Q a (S r)) + rcases (SemiProperForestClassification r hs).2 with root0 | root1 | root2 | proper + · rcases root0 with ⟨z, hz⟩ + have bad := hp.2 (0 : Fin 3) + rw [hz] at bad + simp at bad + · rcases root1 with ⟨z, hz⟩ + have eq : r = R (root z) := by + rw [hz] + funext k + fin_cases k <;> rfl + rw [eq] + exact firstA a ha z + · rcases root2 with ⟨z, hz⟩ + have eq : r = R (R (root z)) := by + rw [hz] + funext k + fin_cases k <;> rfl + rw [eq] + exact firstB a ha z + · rw [successor_action a ha] + exact SemiProperQuadruple.successor (ih proper).1 + have composition (a b : BandPackingSymmetry) (r : Fin 4 → CircleCoordinates) : + Q (.comp a b) r = Q a (Q b r) := by + cases ha : BandPackingSymmetryReversesOrientation a <;> + cases hb : BandPackingSymmetryReversesOrientation b <;> + funext k <;> fin_cases k <;> + simp [Q, BandPackingSymmetryQuadrupleAction, BandPackingSymmetryCircleAction, + BandPackingSymmetryReversesOrientation, ha, hb, neg1, neg2] + induction g generalizing q with + | identity => + have eq : Q .identity q = q := by + funext k + fin_cases k <;> rfl + change ProperBandQuadruple (Q .identity q) + rw [eq] + exact hq + | negate => exact generator .negate (Or.inl rfl) q hq.1 hq + | conjugate => exact generator .conjugate (Or.inr (Or.inl rfl)) q hq.1 hq + | shift w => exact generator (.shift w) (Or.inr (Or.inr ⟨w, rfl⟩)) q hq.1 hq + | comp a b iha ihb => + change ProperBandQuadruple (Q (.comp a b) q) + rw [composition] + exact iha _ (ihb q hq) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryQuadrupleAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryQuadrupleAction.lean new file mode 100644 index 0000000000..ad2afd380c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryQuadrupleAction.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation + +-- [TABLET NODE: BandPackingSymmetryQuadrupleAction] + +/-! +# BandPackingSymmetryQuadrupleAction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For an ordered quadruple $q=(C_0,C_1,C_2,C_3)$ and a packing symmetry +$g$, the transformed ordered quadruple has child $gC_0$. If $g$ preserves +orientation its parents are $(gC_1,gC_2,gC_3)$; if $g$ reverses orientation +they are $(gC_1,gC_3,gC_2)$. The reversal is part of the action because +proper quadruples remember the cyclic geometric order of their parents. +-/ +def BandPackingSymmetryQuadrupleAction (g : BandPackingSymmetry) + (q : Fin 4 → CircleCoordinates) : Fin 4 → CircleCoordinates := +-- BODY + let parentIndex : Fin 3 → Fin 3 := fun i => + if BandPackingSymmetryReversesOrientation g then -i else i + ![BandPackingSymmetryCircleAction g (q 0), + BandPackingSymmetryCircleAction g (q (parentIndex 0).succ), + BandPackingSymmetryCircleAction g (q (parentIndex 1).succ), + BandPackingSymmetryCircleAction g (q (parentIndex 2).succ)] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryReversesOrientation.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryReversesOrientation.lean new file mode 100644 index 0000000000..443b439e52 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryReversesOrientation.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry + +-- [TABLET NODE: BandPackingSymmetryReversesOrientation] + +/-! +# BandPackingSymmetryReversesOrientation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The orientation parity of a band-packing symmetry word is false for the +identity, coordinate negation, and shifts, true for conjugation, and is +added modulo two under composition. It records whether the cyclic order +of the three parents of an oriented Descartes quadruple must be reversed. +-/ +def BandPackingSymmetryReversesOrientation : BandPackingSymmetry → Bool := +-- BODY + fun g => match g with + | .identity => false + | .negate => false + | .conjugate => true + | .shift _ => false + | .comp g h => + xor (BandPackingSymmetryReversesOrientation g) + (BandPackingSymmetryReversesOrientation h) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhase.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhase.lean new file mode 100644 index 0000000000..a015b29109 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhase.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn + +-- [TABLET NODE: BandPackingSymmetryScopedPhase] + +/-! +# BandPackingSymmetryScopedPhase + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $h$ be a band-packing symmetry word, let +$p=(C_0,C_1,C_2,C_3)$ be an ordered coordinate quadruple, and let +$\delta$ be a Boolean. Put +$$ + P_i=C_{i+1},\qquad + W_i=v(P_{i+2},P_{i+1}),\qquad + \sigma_h(i)=\begin{cases}-i,&h\text{ reverses orientation},\\ + i,&h\text{ preserves orientation},\end{cases} +$$ +where all parent indices lie in $\operatorname{Fin}3$. Thus, with the +zero-based labels used by the occurrence definition, +$$ + (W_0,W_1,W_2)=(v_{32},v_{13},v_{21}). +$$ +Write $p'=h_*p$ and $P'_j=p'_{j+1}$, let $L_h$ be the vector action, let +$Qv=iv$, and set +$\epsilon_\delta=-1$ when $\delta=\mathrm{true}$ and +$\epsilon_\delta=1$ otherwise. The scoped phase predicate +$\operatorname{BandPackingSymmetryScopedPhase}(h,p,\delta)$ means that, +for every $i\in\operatorname{Fin}3$, +$$ +\begin{aligned} + v(p'_{\sigma_h(i)+1},p'_0) + &=\epsilon_\delta L_h\bigl(v(P_i,C_0)\bigr),\\ + v(p'_0,p'_{\sigma_h(i)+1}) + &=\epsilon_\delta + \begin{cases}-L_h\bigl(v(C_0,P_i)\bigr),&h\text{ reverses},\\ + L_h\bigl(v(C_0,P_i)\bigr),&h\text{ preserves}, + \end{cases}\\ + v(P'_{\sigma_h(i)+2},P'_{\sigma_h(i)+1}) + &=\epsilon_\delta + \begin{cases}Q L_h(W_i),&h\text{ reverses},\\ + L_h(W_i),&h\text{ preserves}. + \end{cases} +\end{aligned} +$$ +All subscripts on $P'$ are computed in $\operatorname{Fin}3$. +Equivalently, the last left-hand side is the cyclic occurrence edge +$W'_{\sigma_h(i)}$. In particular orientation reversal keeps the label +$\sigma_h(i)=-i$ and reverses the edge endpoints; the displayed $Q$ is the +resulting flip correction, not an additional cyclic shift. +-/ +def BandPackingSymmetryScopedPhase (h : BandPackingSymmetry) + (p : Fin 4 → CircleCoordinates) (negative : Bool) : Prop := +-- BODY + let sigma : Fin 3 → Fin 3 := fun i => + if BandPackingSymmetryReversesOrientation h then -i else i + ∀ i : Fin 3, + BandVectors.1 + (BandPackingSymmetryQuadrupleAction h p (sigma i).succ) + (BandPackingSymmetryQuadrupleAction h p 0) = + (if negative then (-1 : GaussianInt) else 1) * + BandPackingSymmetryVectorAction h + (BandVectors.1 (p i.succ) (p 0)) ∧ + BandVectors.1 + (BandPackingSymmetryQuadrupleAction h p 0) + (BandPackingSymmetryQuadrupleAction h p (sigma i).succ) = + (if negative then (-1 : GaussianInt) else 1) * + (if BandPackingSymmetryReversesOrientation h then + -BandPackingSymmetryVectorAction h + (BandVectors.1 (p 0) (p i.succ)) + else + BandPackingSymmetryVectorAction h + (BandVectors.1 (p 0) (p i.succ))) ∧ + BandVectors.1 + (BandPackingSymmetryQuadrupleAction h p ((sigma i + 2).succ)) + (BandPackingSymmetryQuadrupleAction h p ((sigma i + 1).succ)) = + (if negative then (-1 : GaussianInt) else 1) * + (if BandPackingSymmetryReversesOrientation h then + GaussianQuarterTurn + (BandPackingSymmetryVectorAction h + (BandVectors.1 (p ((i + 2).succ)) (p ((i + 1).succ)))) + else + BandPackingSymmetryVectorAction h + (BandVectors.1 (p ((i + 2).succ)) (p ((i + 1).succ)))) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhaseUnique.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhaseUnique.lean new file mode 100644 index 0000000000..d67884b888 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhaseUnique.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing + +-- [TABLET NODE: BandPackingSymmetryScopedPhaseUnique] + +/-! +# BandPackingSymmetryScopedPhaseUnique + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandPackingSymmetryScopedPhaseUnique + (g : BandPackingSymmetry) (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) (negative₁ negative₂ : Bool) + (h₁ : BandPackingSymmetryScopedPhase g q negative₁) + (h₂ : BandPackingSymmetryScopedPhase g q negative₂) : + negative₁ = negative₂ := by +-- BODY + have preserves : ∀ (a : BandPackingSymmetry) (v : GaussianInt), + v ≠ 0 → BandPackingSymmetryVectorAction a v ≠ 0 := by + intro a + induction a with + | identity => + intro v hv + exact hv + | negate => + intro v hv hz + apply hv + cases v + rw [Zsqrtd.ext_iff] at hz + simp? [BandPackingSymmetryVectorAction, GaussianQuarterTurn] at hz + rcases hz with ⟨hre, him⟩ + ext <;> simp_all [Zsqrtd.re_zero, Zsqrtd.im_zero] + | conjugate => + intro v hv hz + apply hv + cases v + rw [Zsqrtd.ext_iff] at hz + simp? [BandPackingSymmetryVectorAction, GaussianReflection] at hz + rcases hz with ⟨hre, him⟩ + ext <;> simp_all [Zsqrtd.re_zero, Zsqrtd.im_zero] + | shift w => + intro v hv + exact hv + | comp a b ia ib => + intro v hv hz + exact ia _ (ib v hv) hz + have curvature := ProperBandCurvatureStructure q hq + have vector_nonzero : BandVectors.1 (q ((0 : Fin 3).succ : Fin 4)) (q 0) ≠ 0 := by + apply VectorNonvanishing q hq.1 ((0 : Fin 3).succ : Fin 4) 0 + · decide + · exact Or.inr curvature.1 + have transformed_nonzero : + BandPackingSymmetryVectorAction g + (BandVectors.1 (q ((0 : Fin 3).succ : Fin 4)) (q 0)) ≠ 0 := + preserves g _ vector_nonzero + dsimp [BandPackingSymmetryScopedPhase] at h₁ h₂ + cases negative₁ <;> cases negative₂ + · rfl + · have equal := (h₁ 0).1.symm.trans (h₂ 0).1 + simp? at equal + have opposite : + BandPackingSymmetryVectorAction g + (BandVectors.1 (q ((0 : Fin 3).succ : Fin 4)) (q 0)) = + -BandPackingSymmetryVectorAction g + (BandVectors.1 (q ((0 : Fin 3).succ : Fin 4)) (q 0)) := by + exact equal + apply False.elim + apply transformed_nonzero + rw [Zsqrtd.ext_iff] at opposite + rcases opposite with ⟨hre, him⟩ + simp only [Zsqrtd.re_neg, Zsqrtd.im_neg] at hre him + apply Zsqrtd.ext <;> simp only [Zsqrtd.re_zero, Zsqrtd.im_zero] <;> omega + · have equal := (h₁ 0).1.symm.trans (h₂ 0).1 + simp at equal + have opposite : + BandPackingSymmetryVectorAction g + (BandVectors.1 (q ((0 : Fin 3).succ : Fin 4)) (q 0)) = + -BandPackingSymmetryVectorAction g + (BandVectors.1 (q ((0 : Fin 3).succ : Fin 4)) (q 0)) := by + exact equal.symm + apply False.elim + apply transformed_nonzero + rw [Zsqrtd.ext_iff] at opposite + rcases opposite with ⟨hre, him⟩ + simp only [Zsqrtd.re_neg, Zsqrtd.im_neg] at hre him + apply Zsqrtd.ext <;> simp only [Zsqrtd.re_zero, Zsqrtd.im_zero] <;> omega + · rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetrySlopeAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetrySlopeAction.lean new file mode 100644 index 0000000000..fa256bb23d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetrySlopeAction.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.TileCentroid + +-- [TABLET NODE: BandPackingSymmetrySlopeAction] + +/-! +# BandPackingSymmetrySlopeAction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For every prototile $T$ and every pair $p=(p_1,p_2)\in\mathbb R^2$, the +lifted slope action of a band-packing symmetry word is defined recursively +on generators by +$$ +\begin{aligned} +1\star_Tp&=p,\\ +T_w\star_Tp&=p+M_w\operatorname{cent}(T)+(-A/2,A/2), + \quad w=A+Bi,\quad + M_w=\begin{pmatrix}A&B\\B&-A\end{pmatrix},\\ +N\star_T(p_1,p_2)&=(-p_2,p_1),\\ +K\star_T(p_1,p_2)&=(-p_1,p_2). +\end{aligned} +$$ +Writing $h\cdot T$ for the literal grid action +`BandPackingSymmetryTileAction`, the composition rule is +$$ + \operatorname{comp}(g,h)\star_Tp + =g\star_{h\cdot T}\bigl(h\star_Tp\bigr). +$$ +Here $\operatorname{cent}(T)$ is the total centroid of +`TileCentroid`: if $T.\mathrm{cells}$ is empty, it is the +designated anchor of $T$, so the shift clause uses that anchor. The +half-cell term in the shift clause is part of the definition. It is +independent of $T$ and therefore cancels from a difference of two vectors +acted on by the same shift. Later covariance results specialize this +total algebraic action to vectors that are actual slopes of partial +odometers on nonempty supports. +-/ +noncomputable def BandPackingSymmetrySlopeAction : + BandPackingSymmetry → ProtoTile → (ℝ × ℝ) → (ℝ × ℝ) := +-- BODY + fun g T p => match g with + | .identity => p + | .shift w => + (p.1 + (w.re : ℝ) * (TileCentroid T).1 + + (w.im : ℝ) * (TileCentroid T).2 - (w.re : ℝ) / 2, + p.2 + (w.im : ℝ) * (TileCentroid T).1 - + (w.re : ℝ) * (TileCentroid T).2 + (w.re : ℝ) / 2) + | .negate => (-p.2, p.1) + | .conjugate => (-p.1, p.2) + | .comp a b => + BandPackingSymmetrySlopeAction a + (BandPackingSymmetryTileAction b T) + (BandPackingSymmetrySlopeAction b T p) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean new file mode 100644 index 0000000000..5edc1bc6fc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean @@ -0,0 +1,1069 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandPackingSymmetryT3T5Covariance] + +/-! +# BandPackingSymmetryT3T5Covariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PackingCovarianceProof + +private theorem etranslate : + (by + classical + exact + let E (A B : ProtoTile) : Prop := + A.cells = B.cells ∧ (A.cells = ∅ → A.anchor = B.anchor) + ∀ {A : ProtoTile}, ∀ {B : ProtoTile}, (E A B) → (∀ (v : GaussianInt), E (TileTranslation + A v) (TileTranslation B v)) ) := by + classical + intro E A B h v + refine ⟨congrArg (fun c => c.image (GaussianTranslation v)) h.1, ?_⟩ + intro he + have ha := h.2 ((TileTranslationFormulas A v).2.2.1.mp he) + exact congrArg (GaussianTranslation v) ha + +private theorem equarter : + (by + classical + exact + let E (A B : ProtoTile) : Prop := + A.cells = B.cells ∧ (A.cells = ∅ → A.anchor = B.anchor) + ∀ {A : ProtoTile}, ∀ {B : ProtoTile}, (E A B) → (E (TileQuarterTurn A) (TileQuarterTurn + B)) ) := by + classical + intro E A B h + refine ⟨congrArg (fun c => c.image (fun z => GaussianQuarterTurn z - 1)) h.1, ?_⟩ + intro he + exact congrArg GaussianQuarterTurn (h.2 ((TileQuarterTurnFormulas A).2.2.1.mp he)) + +private theorem touching_obs : + (by + classical + exact + let E (A B : ProtoTile) : Prop := + A.cells = B.cells ∧ (A.cells = ∅ → A.anchor = B.anchor) + ∀ {A : ProtoTile}, ∀ {A' : ProtoTile}, ∀ {B : ProtoTile}, ∀ {B' : ProtoTile}, (E A A') → + ((E B B') → (TileTouching A B ↔ TileTouching A' B')) ) := by + classical + intro E A A' B B' ha hb + have oa := ProtoTileObservableExtensionality A A' ha.1 ha.2 + have ob := ProtoTileObservableExtensionality B B' hb.1 hb.2 + simp only [TileTouching, ← ha.1, ← hb.1, ← oa.2.1, ← ob.2.1, + ← oa.2.2.1, ← ob.2.2.1] + by_cases ea : A.cells = ∅ <;> by_cases eb : B.cells = ∅ + · simp [ea, eb, ha.2 ea, hb.2 eb] + · simp [ea, eb, ha.2 ea] + · simp [ea, eb, hb.2 eb] + · simp [ea, eb] + +private theorem triple_obs : + (by + classical + exact + let E (A B : ProtoTile) : Prop := + A.cells = B.cells ∧ (A.cells = ∅ → A.anchor = B.anchor) + (∀ {A : ProtoTile}, ∀ {A' : ProtoTile}, ∀ {B : ProtoTile}, ∀ {B' : ProtoTile}, (E A A') → + ((E B B') → (TileTouching A B ↔ TileTouching A' B'))) → (∀ {A : ProtoTile}, ∀ + {A' : ProtoTile}, ∀ {B : ProtoTile}, ∀ {B' : ProtoTile}, ∀ {C : ProtoTile}, ∀ + {C' : ProtoTile}, (E A A') → ((E B B') → ((E C C') → (TouchingTriple A B C ↔ + TouchingTriple A' B' C')))) ) := by + classical + intro E touching_obs A A' B B' C C' ha hb hc + have oa := ProtoTileObservableExtensionality A A' ha.1 ha.2 + have ob := ProtoTileObservableExtensionality B B' hb.1 hb.2 + have oc := ProtoTileObservableExtensionality C C' hc.1 hc.2 + simp only [TouchingTriple, touching_obs ha hb, touching_obs hb hc, + touching_obs hc ha, oa.2.1, ob.2.1, oc.2.1] + +private theorem translate_add : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), TileTranslation + (TileTranslation A x) y = TileTranslation A (x + y) ) := by + classical + intro A x y + cases A + simp only [TileTranslation, Finset.image_image, Function.comp_def, + GaussianTranslation, add_assoc] + rfl + +private theorem translate_zero : + (by + classical + exact + ∀ (A : ProtoTile), TileTranslation A 0 = A ) := by + classical + intro A + cases A + have hz : GaussianTranslation 0 = id := by funext z; simp [GaussianTranslation] + simp [TileTranslation, hz, GaussianTranslation] + +private theorem quarter_translate : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (x : GaussianInt), TileQuarterTurn (TileTranslation A x) = + TileTranslation (TileQuarterTurn A) (GaussianQuarterTurn x) ) := by + classical + intro A x + exact (BandPackingSymmetryTilingTransport .negate).2.2.2.2.2.2.1 A x + +private theorem qtwo : + (by + classical + exact + ∀ (x : GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn x) = -x ) := by + classical + intro x + ext <;> simp [GaussianQuarterTurn] + +private theorem half_translate : + (by + classical + exact + (∀ (A : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), TileTranslation + (TileTranslation A x) y = TileTranslation A (x + y)) → ((∀ (A : ProtoTile), ∀ (x : + GaussianInt), TileQuarterTurn (TileTranslation A x) = TileTranslation + (TileQuarterTurn A) (GaussianQuarterTurn x)) → ((∀ (x : GaussianInt), + GaussianQuarterTurn (GaussianQuarterTurn x) = -x) → ( + let H (w : GaussianInt) (A : ProtoTile) := + TileTranslation (TileQuarterTurn (TileQuarterTurn A)) w + ∀ (w : GaussianInt), ∀ (x : GaussianInt), ∀ (A : ProtoTile), H w (TileTranslation A x) = + TileTranslation (H w A) (-x)))) ) := by + classical + intro translate_add quarter_translate qtwo H w x A + dsimp [H] + rw [quarter_translate, quarter_translate, qtwo, translate_add, translate_add] + rw [add_comm] + +private theorem half_cov : + (by + classical + exact + let H (w : GaussianInt) (A : ProtoTile) := + TileTranslation (TileQuarterTurn (TileQuarterTurn A)) w + ∀ (w : GaussianInt), ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), + TouchingTriple A B C ↔ TouchingTriple (H w A) (H w B) (H w C) ) := by + classical + intro H w A B C + exact ((TouchingTripleCovariance A B C 0).2.1.trans + (TouchingTripleCovariance (TileQuarterTurn A) (TileQuarterTurn B) + (TileQuarterTurn C) 0).2.1).trans + (TouchingTripleCovariance (TileQuarterTurn (TileQuarterTurn A)) + (TileQuarterTurn (TileQuarterTurn B)) (TileQuarterTurn (TileQuarterTurn C)) w).1 + +private theorem half_center : + (by + classical + exact + let E (A B : ProtoTile) : Prop := + A.cells = B.cells ∧ (A.cells = ∅ → A.anchor = B.anchor) + (∀ {A : ProtoTile}, ∀ {B : ProtoTile}, ∀ {C : ProtoTile}, (E A B) → ((E B C) → (E A C))) + → ((∀ {A : ProtoTile}, ∀ {B : ProtoTile}, (E A B) → (∀ (v : GaussianInt), E + (TileTranslation A v) (TileTranslation B v))) → ((∀ {A : ProtoTile}, ∀ + {B : ProtoTile}, (E A B) → (E (TileQuarterTurn A) (TileQuarterTurn B))) → ((∀ (A : + ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), TileTranslation + (TileTranslation A x) y = TileTranslation A (x + y)) → ((∀ (A : ProtoTile), ∀ (x : + GaussianInt), TileQuarterTurn (TileTranslation A x) = TileTranslation + (TileQuarterTurn A) (GaussianQuarterTurn x)) → ( + let H (w : GaussianInt) (A : ProtoTile) := + TileTranslation (TileQuarterTurn (TileQuarterTurn A)) w + ∀ (A : ProtoTile), (QuarterTurnSymmetric A) → (∃ w : GaussianInt, GaussianRealPoint w = + (2 : Real) • TileCentroid A ∧ E (H w A) A)))))) ) := by + classical + intro E etrans etranslate equarter translate_add quarter_translate H A hs + obtain ⟨u, hu, hc, ha, _⟩ := QuarterTurnSymmetricCenteredTransport A hs + have he : E (TileTranslation (TileQuarterTurn A) u) A := ⟨hc, fun hz => ha (hc ▸ hz)⟩ + refine ⟨GaussianQuarterTurn u + u, ?_, ?_⟩ + · have hr := congrArg Prod.fst hu + have hi := congrArg Prod.snd hu + apply Prod.ext <;> simp [GaussianRealPoint, GaussianQuarterTurn] at hr hi ⊢ <;> + linarith + · have hh := etrans (etranslate (equarter he) u) he + simpa only [quarter_translate, translate_add] using hh + +private theorem half_other : + (by + classical + exact + let E (A B : ProtoTile) : Prop := + A.cells = B.cells ∧ (A.cells = ∅ → A.anchor = B.anchor) + (∀ {A : ProtoTile}, ∀ {B : ProtoTile}, (E A B) → (∀ (v : GaussianInt), E (TileTranslation + A v) (TileTranslation B v))) → ((∀ (A : ProtoTile), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), TileTranslation (TileTranslation A x) y = TileTranslation A (x + y)) → ( + let H (w : GaussianInt) (A : ProtoTile) := + TileTranslation (TileQuarterTurn (TileQuarterTurn A)) w + (∀ (A : ProtoTile), (QuarterTurnSymmetric A) → (∃ w : GaussianInt, GaussianRealPoint w = + (2 : Real) • TileCentroid A ∧ E (H w A) A)) → (∀ (A : ProtoTile), + (QuarterTurnSymmetric A) → (∀ (w : GaussianInt), ∀ (z : GaussianInt), + (GaussianRealPoint w - (2 : Real) • TileCentroid A = GaussianRealPoint z) → (E (H w + A) (TileTranslation A z)))))) ) := by + classical + intro E etranslate translate_add H half_center A hs w z hz + obtain ⟨v, hv, he⟩ := half_center A hs + have wz : w = v + z := by + rw [← hv] at hz + apply Zsqrtd.ext + · have hr := congrArg Prod.fst hz + change (w.re : Real) - (v.re : Real) = (z.re : Real) at hr + exact_mod_cast (show (w.re : Real) = (v.re : Real) + (z.re : Real) by linarith) + · have hi := congrArg Prod.snd hz + change (w.im : Real) - (v.im : Real) = (z.im : Real) at hi + exact_mod_cast (show (w.im : Real) = (v.im : Real) + (z.im : Real) by linarith) + have hh := etranslate he z + simpa only [H, translate_add, ← wz] using hh + +private theorem neg_triple : + (by + classical + exact + let E (A B : ProtoTile) : Prop := + A.cells = B.cells ∧ (A.cells = ∅ → A.anchor = B.anchor) + (∀ {A : ProtoTile}, ∀ {B : ProtoTile}, (E A B) → (∀ (v : GaussianInt), E (TileTranslation + A v) (TileTranslation B v))) → ((∀ {A : ProtoTile}, ∀ {A' : ProtoTile}, ∀ + {B : ProtoTile}, ∀ {B' : ProtoTile}, ∀ {C : ProtoTile}, ∀ {C' : ProtoTile}, (E A A') + → ((E B B') → ((E C C') → (TouchingTriple A B C ↔ TouchingTriple A' B' C')))) → ( + let H (w : GaussianInt) (A : ProtoTile) := + TileTranslation (TileQuarterTurn (TileQuarterTurn A)) w + (∀ (w : GaussianInt), ∀ (x : GaussianInt), ∀ (A : ProtoTile), H w (TileTranslation A x) = + TileTranslation (H w A) (-x)) → ((∀ (w : GaussianInt), ∀ (A : ProtoTile), ∀ (B : + ProtoTile), ∀ (C : ProtoTile), TouchingTriple A B C ↔ TouchingTriple (H w A) (H w B) + (H w C)) → ((∀ (A : ProtoTile), (QuarterTurnSymmetric A) → (∃ w : GaussianInt, + GaussianRealPoint w = (2 : Real) • TileCentroid A ∧ E (H w A) A)) → (∀ (A : + ProtoTile), (QuarterTurnSymmetric A) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), + TouchingTriple A (TileTranslation A x) (TileTranslation A y) ↔ TouchingTriple A + (TileTranslation A (-x)) (TileTranslation A (-y)))))))) ) := by + classical + intro E etranslate triple_obs H half_translate half_cov half_center A hs x y + obtain ⟨w, _, he⟩ := half_center A hs + exact (half_cov w A (TileTranslation A x) (TileTranslation A y)).trans + (triple_obs he + (by rw [half_translate]; exact etranslate he (-x)) + (by rw [half_translate]; exact etranslate he (-y))) + +private theorem parent_half : + (by + classical + exact + let E (A B : ProtoTile) : Prop := + A.cells = B.cells ∧ (A.cells = ∅ → A.anchor = B.anchor) + (∀ {A : ProtoTile}, ∀ {B : ProtoTile}, (E A B) → (∀ (v : GaussianInt), E (TileTranslation + A v) (TileTranslation B v))) → ((∀ {A : ProtoTile}, ∀ {A' : ProtoTile}, ∀ + {B : ProtoTile}, ∀ {B' : ProtoTile}, ∀ {C : ProtoTile}, ∀ {C' : ProtoTile}, (E A A') + → ((E B B') → ((E C C') → (TouchingTriple A B C ↔ TouchingTriple A' B' C')))) → ((∀ + (A : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), TileTranslation + (TileTranslation A x) y = TileTranslation A (x + y)) → ((∀ (A : ProtoTile), + TileTranslation A 0 = A) → ( + let H (w : GaussianInt) (A : ProtoTile) := + TileTranslation (TileQuarterTurn (TileQuarterTurn A)) w + (∀ (w : GaussianInt), ∀ (x : GaussianInt), ∀ (A : ProtoTile), H w (TileTranslation A x) = + TileTranslation (H w A) (-x)) → ((∀ (w : GaussianInt), ∀ (A : ProtoTile), ∀ (B : + ProtoTile), ∀ (C : ProtoTile), TouchingTriple A B C ↔ TouchingTriple (H w A) (H w B) + (H w C)) → ((∀ (A : ProtoTile), (QuarterTurnSymmetric A) → (∃ w : GaussianInt, + GaussianRealPoint w = (2 : Real) • TileCentroid A ∧ E (H w A) A)) → ((∀ (A : + ProtoTile), (QuarterTurnSymmetric A) → (∀ (w : GaussianInt), ∀ (z : GaussianInt), + (GaussianRealPoint w - (2 : Real) • TileCentroid A = GaussianRealPoint z) → (E (H w + A) (TileTranslation A z)))) → (∀ (A : ProtoTile), ∀ (U : ProtoTile), + (QuarterTurnSymmetric A) → ((QuarterTurnSymmetric U) → (∀ (x : GaussianInt), ∀ (z : + GaussianInt), (TileCentroid U - TileCentroid A = (1 / 2 : Real) • GaussianRealPoint + z) → (TouchingTriple A (TileTranslation A x) U ↔ TouchingTriple A (TileTranslation A + x) (TileTranslation U (x - z))))))))))))) ) := by + classical + intro E etranslate triple_obs translate_add translate_zero H half_translate half_cov + half_center half_other A U hsA hsU x z hcent + obtain ⟨w, hw, he⟩ := half_center A hsA + have hz : GaussianRealPoint w - (2 : Real) • TileCentroid U = GaussianRealPoint (-z) := by + rw [hw] + have hr := congrArg Prod.fst hcent + have hi := congrArg Prod.snd hcent + apply Prod.ext <;> simp [GaussianRealPoint] at hr hi ⊢ <;> linarith + have hu := half_other U hsU w (-z) hz + have hh := (half_cov w A (TileTranslation A x) U).trans + (triple_obs he (by rw [half_translate]; exact etranslate he (-x)) hu) + have ht := (TouchingTripleCovariance A (TileTranslation A (-x)) + (TileTranslation U (-z)) x).1 + rw [translate_add, translate_add, neg_add_cancel, translate_zero] at ht + have perm : TouchingTriple (TileTranslation A x) A + (TileTranslation U (-z + x)) ↔ + TouchingTriple A (TileTranslation A x) (TileTranslation U (-z + x)) := by + constructor + · intro h; exact ((TouchingTriplePermutations _ _ _).mp h).2.1 + · intro h; exact ((TouchingTriplePermutations _ _ _).mp h).2.1 + simpa only [sub_eq_add_neg, add_comm] using hh.trans (ht.trans perm) + +private theorem point_add : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint (x + y) = GaussianRealPoint x + + GaussianRealPoint y ) := by + classical + intro x y + ext <;> simp [GaussianRealPoint] + +private theorem point_sub : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint (x - y) = GaussianRealPoint x + - GaussianRealPoint y ) := by + classical + intro x y + ext <;> simp [GaussianRealPoint] + +private theorem cent_translate : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (x : GaussianInt), TileCentroid (TileTranslation A x) = TileCentroid + A + GaussianRealPoint x ) := by + classical + intro A x + exact (TileTranslationFormulas A x).2.2.2.2.1 + +private theorem signs : + (by + classical + exact + (∀ (A : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), TileTranslation + (TileTranslation A x) y = TileTranslation A (x + y)) → ((∀ (A : ProtoTile), + TileTranslation A 0 = A) → ((∀ (A : ProtoTile), ∀ (U : ProtoTile), + (QuarterTurnSymmetric A) → ((QuarterTurnSymmetric U) → (∀ (x : GaussianInt), ∀ (z : + GaussianInt), (TileCentroid U - TileCentroid A = (1 / 2 : Real) • GaussianRealPoint + z) → (TouchingTriple A (TileTranslation A x) U ↔ TouchingTriple A (TileTranslation A + x) (TileTranslation U (x - z)))))) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), + GaussianRealPoint (x + y) = GaussianRealPoint x + GaussianRealPoint y) → ((∀ (x : + GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint (x - y) = GaussianRealPoint x - + GaussianRealPoint y) → ((∀ (x : GaussianInt), GaussianRealPoint (-x) = + -GaussianRealPoint x) → ((∀ (A : ProtoTile), ∀ (x : GaussianInt), TileCentroid + (TileTranslation A x) = TileCentroid A + GaussianRealPoint x) → ( + let plus (x : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint x + GaussianRealPoint (GaussianQuarterTurn x)) + let minus (x : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint x - GaussianRealPoint (GaussianQuarterTurn x)) + ∀ (C : CircleCoordinates), ∀ (A : ProtoTile), (QuarterTurnSymmetric A) → ((∀ U, + BandPrototile C U → QuarterTurnSymmetric U) → (∀ (x : GaussianInt), (∀ U, + BandPrototile C U → TileCentroid U - TileCentroid A = plus x → TouchingTriple A + (TileTranslation A x) U) ↔ (∀ U, BandPrototile C U → TileCentroid U - TileCentroid A + = minus x → TouchingTriple A (TileTranslation A x) U)))))))))) ) := by + classical + intro translate_add translate_zero parent_half point_add point_sub point_neg cent_translate + plus minus C A hsA hsC x + constructor + · intro hp U hU hc + let U' := TileTranslation U (GaussianQuarterTurn x) + have hU' := BandPrototileTranslation C U (GaussianQuarterTurn x) hU + have hc' : TileCentroid U' - TileCentroid A = plus x := by + rw [cent_translate] + have hr := congrArg Prod.fst hc + have hi := congrArg Prod.snd hc + apply Prod.ext <;> simp [plus, minus] at hr hi ⊢ <;> linarith + have hh := (parent_half A U' hsA (hsC U' hU') x (x + GaussianQuarterTurn x) + (by simpa only [point_add] using hc')).mp (hp U' hU' hc') + dsimp [U'] at hh + rw [translate_add] at hh + have hz : GaussianQuarterTurn x + (x - (x + GaussianQuarterTurn x)) = 0 := by ring + simpa only [hz, translate_zero] using hh + · intro hm U hU hc + let U' := TileTranslation U (-GaussianQuarterTurn x) + have hU' := BandPrototileTranslation C U (-GaussianQuarterTurn x) hU + have hc' : TileCentroid U' - TileCentroid A = minus x := by + rw [cent_translate, point_neg] + have hr := congrArg Prod.fst hc + have hi := congrArg Prod.snd hc + apply Prod.ext <;> simp [plus, minus] at hr hi ⊢ <;> linarith + have hh := (parent_half A U' hsA (hsC U' hU') x (x - GaussianQuarterTurn x) + (by simpa only [point_sub] using hc')).mp (hm U' hU' hc') + dsimp [U'] at hh + rw [translate_add] at hh + have hz : -GaussianQuarterTurn x + (x - (x - GaussianQuarterTurn x)) = 0 := by ring + simpa only [hz, translate_zero] using hh + +private theorem radd : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (h : BandPackingSymmetry), ∀ (p : Real × Real), ∀ (t : Real × Real), R h (p + t) = R h + p + R h t ) := by + classical + intro R h p t + induction h generalizing p t with + | identity => rfl + | negate => ext <;> simp [R]; ring + | conjugate => ext <;> simp [R]; ring + | shift w => rfl + | comp h k ih ik => simp [R, ih, ik] + +private theorem rsub : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (h : BandPackingSymmetry), ∀ (p : Real × Real), ∀ (t : Real × Real), R h (p - t) = R h + p - R h t ) := by + classical + intro R h p t + induction h generalizing p t with + | identity => rfl + | negate => ext <;> simp [R]; ring + | conjugate => ext <;> simp [R]; ring + | shift w => rfl + | comp h k ih ik => simp [R, ih, ik] + +private theorem rsmul : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (h : BandPackingSymmetry), ∀ (c : Real), ∀ (p : Real × Real), R h (c • p) = c • R h p ) + := by + classical + intro R h c p + induction h generalizing p with + | identity => rfl + | negate => ext <;> simp [R] + | conjugate => ext <;> simp [R] + | shift w => rfl + | comp h k ih ik => simp [R, ih, ik] + +private theorem rpoint : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (h : BandPackingSymmetry), ∀ (w : GaussianInt), R h (GaussianRealPoint w) = + GaussianRealPoint (BandPackingSymmetryVectorAction h w) ) := by + classical + intro R h w + induction h generalizing w with + | identity => rfl + | negate => simp [R, BandPackingSymmetryVectorAction, GaussianRealPoint, GaussianQuarterTurn] + | conjugate => simp [R, BandPackingSymmetryVectorAction, GaussianRealPoint, GaussianReflection] + | shift w => rfl + | comp h k ih ik => simp [R, BandPackingSymmetryVectorAction, ih, ik] + +private theorem rminusq : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + (∀ (h : BandPackingSymmetry), ∀ (p : Real × Real), R h (-p) = -R h p) → (∀ (h : + BandPackingSymmetry), ∀ (p : Real × Real), R h (p.2, -p.1) = -R h (-p.2, p.1)) ) := by + classical + intro R rneg h p + rw [show (p.2, -p.1) = -(-p.2, p.1) by simp, rneg] + +private theorem rq : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + (∀ (h : BandPackingSymmetry), ∀ (p : Real × Real), R h (p.2, -p.1) = -R h (-p.2, p.1)) → + (∀ (h : BandPackingSymmetry), ∀ (p : Real × Real), R h (-p.2, p.1) = if + BandPackingSymmetryReversesOrientation h then -(-(R h p).2, (R h p).1) else (-(R h + p).2, (R h p).1)) ) := by + classical + intro R rminusq h p + induction h generalizing p with + | identity => rfl + | negate => simp [R, BandPackingSymmetryReversesOrientation] + | conjugate => simp [R, BandPackingSymmetryReversesOrientation] + | shift w => rfl + | comp h k ih ik => + change R h (R k (-p.2, p.1)) = + if xor (BandPackingSymmetryReversesOrientation h) + (BandPackingSymmetryReversesOrientation k) then + -(-(R h (R k p)).2, (R h (R k p)).1) + else (-(R h (R k p)).2, (R h (R k p)).1) + rw [ik] + cases hh : BandPackingSymmetryReversesOrientation h <;> + cases hk : BandPackingSymmetryReversesOrientation k <;> + simp [hh, rminusq, ih] + +private theorem rinj : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (h : BandPackingSymmetry), Function.Injective (R h) ) := by + classical + intro R h + induction h with + | identity => exact Function.injective_id + | shift w => exact Function.injective_id + | negate => + intro p t he + have hr := congrArg Prod.fst he + have hi := congrArg Prod.snd he + apply Prod.ext <;> simp [R] at hr hi ⊢ <;> linarith + | conjugate => + intro p t he + have hr := congrArg Prod.fst he + have hi := congrArg Prod.snd he + apply Prod.ext <;> simp [R] at hr hi ⊢ <;> linarith + | comp h k ih ik => exact ih.comp ik + +private theorem rcent : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (h : BandPackingSymmetry), ∀ (A : ProtoTile), TileCentroid + (BandPackingSymmetryTileAction h A) = R h (TileCentroid A) ) := by + classical + intro R h A + induction h generalizing A with + | identity => rfl + | shift w => rfl + | negate => exact (TileQuarterTurnFormulas A).2.2.2.2.1 + | conjugate => + simp [BandPackingSymmetryTileAction, R, + (TileQuarterTurnFormulas _).2.2.2.2.1, + (TileReflectionFormulas _).2.2.2.2.1] + | comp h k ih ik => simp [BandPackingSymmetryTileAction, R, ih, ik] + +private theorem rplus : + (by + classical + exact + let plus (x : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint x + GaussianRealPoint (GaussianQuarterTurn x)) + let minus (x : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint x - GaussianRealPoint (GaussianQuarterTurn x)) + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + (∀ (h : BandPackingSymmetry), ∀ (p : Real × Real), ∀ (t : Real × Real), R h (p + t) = R h + p + R h t) → ((∀ (h : BandPackingSymmetry), ∀ (c : Real), ∀ (p : Real × Real), R h (c + • p) = c • R h p) → ((∀ (h : BandPackingSymmetry), ∀ (w : GaussianInt), R h + (GaussianRealPoint w) = GaussianRealPoint (BandPackingSymmetryVectorAction h w)) → + ((∀ (h : BandPackingSymmetry), ∀ (p : Real × Real), R h (-p.2, p.1) = if + BandPackingSymmetryReversesOrientation h then -(-(R h p).2, (R h p).1) else (-(R h + p).2, (R h p).1)) → (∀ (h : BandPackingSymmetry), ∀ (x : GaussianInt), R h (plus x) = + if BandPackingSymmetryReversesOrientation h then minus + (BandPackingSymmetryVectorAction h x) else plus (BandPackingSymmetryVectorAction h + x))))) ) := by + classical + intro plus minus R radd rsmul rpoint rq h x + have hq : GaussianRealPoint (GaussianQuarterTurn x) = + (-(GaussianRealPoint x).2, (GaussianRealPoint x).1) := by + simp [GaussianRealPoint, GaussianQuarterTurn] + dsimp only [plus, minus] + rw [rsmul, radd, hq, rq, rpoint] + cases hh : BandPackingSymmetryReversesOrientation h <;> + simp [GaussianRealPoint, GaussianQuarterTurn, sub_eq_add_neg] + +private theorem rminus : + (by + classical + exact + let plus (x : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint x + GaussianRealPoint (GaussianQuarterTurn x)) + let minus (x : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint x - GaussianRealPoint (GaussianQuarterTurn x)) + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + (∀ (h : BandPackingSymmetry), ∀ (p : Real × Real), ∀ (t : Real × Real), R h (p - t) = R h + p - R h t) → ((∀ (h : BandPackingSymmetry), ∀ (c : Real), ∀ (p : Real × Real), R h (c + • p) = c • R h p) → ((∀ (h : BandPackingSymmetry), ∀ (w : GaussianInt), R h + (GaussianRealPoint w) = GaussianRealPoint (BandPackingSymmetryVectorAction h w)) → + ((∀ (h : BandPackingSymmetry), ∀ (p : Real × Real), R h (-p.2, p.1) = if + BandPackingSymmetryReversesOrientation h then -(-(R h p).2, (R h p).1) else (-(R h + p).2, (R h p).1)) → (∀ (h : BandPackingSymmetry), ∀ (x : GaussianInt), R h (minus x) + = if BandPackingSymmetryReversesOrientation h then plus + (BandPackingSymmetryVectorAction h x) else minus (BandPackingSymmetryVectorAction h + x))))) ) := by + classical + intro plus minus R rsub rsmul rpoint rq h x + have hq : GaussianRealPoint (GaussianQuarterTurn x) = + (-(GaussianRealPoint x).2, (GaussianRealPoint x).1) := by + simp [GaussianRealPoint, GaussianQuarterTurn] + dsimp only [plus, minus] + rw [rsmul, rsub, hq, rq, rpoint] + cases hh : BandPackingSymmetryReversesOrientation h <;> + simp [GaussianRealPoint, GaussianQuarterTurn, sub_eq_add_neg] + +private theorem lneg : + (by + classical + exact + ∀ (h : BandPackingSymmetry), ∀ (x : GaussianInt), BandPackingSymmetryVectorAction h (-x) + = -BandPackingSymmetryVectorAction h x ) := by + classical + intro h x + induction h generalizing x with + | identity => rfl + | negate => ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] + | conjugate => ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] + | shift w => rfl + | comp h k ih ik => simp only [BandPackingSymmetryVectorAction, ih, ik] + +private theorem tile_surj : + (by + classical + exact + ∀ (h : BandPackingSymmetry), Function.Surjective (BandPackingSymmetryTileAction h) ) := by + classical + intro h + obtain ⟨k, _, _, _, _, _, hright, _⟩ := BandPackingSymmetryInversePhaseCancellation.2 h + intro U + exact ⟨BandPackingSymmetryTileAction k U, hright U⟩ + +private theorem sigma_surj : + (by + classical + exact + let sigma (h : BandPackingSymmetry) (i : Fin 3) : Fin 3 := + if BandPackingSymmetryReversesOrientation h then -i else i + (∀ (h : BandPackingSymmetry), ∀ (i : Fin 3), sigma h (sigma h i) = i) → (∀ (h : + BandPackingSymmetry), Function.Surjective (sigma h)) ) := by + classical + intro sigma sigma_inv h i + exact ⟨sigma h i, sigma_inv h i⟩ + +private theorem parent : + (by + classical + exact + let sigma (h : BandPackingSymmetry) (i : Fin 3) : Fin 3 := + if BandPackingSymmetryReversesOrientation h then -i else i + ∀ (h : BandPackingSymmetry), ∀ (p : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), + BandPackingSymmetryQuadrupleAction h p (sigma h i).succ = + BandPackingSymmetryCircleAction h (p i.succ) ) := by + classical + intro sigma h p i + have neg1 : -(1 : Fin 3) = 2 := rfl + have neg2 : -(2 : Fin 3) = 1 := rfl + cases hh : BandPackingSymmetryReversesOrientation h <;> fin_cases i <;> + simp [sigma, BandPackingSymmetryQuadrupleAction, hh, neg1, neg2] + +private theorem forward : + (by + classical + exact + (∀ (A : ProtoTile), (QuarterTurnSymmetric A) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), + TouchingTriple A (TileTranslation A x) (TileTranslation A y) ↔ TouchingTriple A + (TileTranslation A (-x)) (TileTranslation A (-y)))) → ( + let plus (x : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint x + GaussianRealPoint (GaussianQuarterTurn x)) + let minus (x : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint x - GaussianRealPoint (GaussianQuarterTurn x)) + (∀ (C : CircleCoordinates), ∀ (A : ProtoTile), (QuarterTurnSymmetric A) → ((∀ U, + BandPrototile C U → QuarterTurnSymmetric U) → (∀ (x : GaussianInt), (∀ U, + BandPrototile C U → TileCentroid U - TileCentroid A = plus x → TouchingTriple A + (TileTranslation A x) U) ↔ (∀ U, BandPrototile C U → TileCentroid U - TileCentroid A + = minus x → TouchingTriple A (TileTranslation A x) U)))) → ( + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + (∀ (h : BandPackingSymmetry), ∀ (p : Real × Real), ∀ (t : Real × Real), R h (p - t) = R h + p - R h t) → ((∀ (h : BandPackingSymmetry), Function.Injective (R h)) → ((∀ (h : + BandPackingSymmetry), ∀ (A : ProtoTile), TileCentroid (BandPackingSymmetryTileAction + h A) = R h (TileCentroid A)) → ((∀ (h : BandPackingSymmetry), ∀ (x : GaussianInt), R + h (plus x) = if BandPackingSymmetryReversesOrientation h then minus + (BandPackingSymmetryVectorAction h x) else plus (BandPackingSymmetryVectorAction h + x)) → ((∀ (h : BandPackingSymmetry), ∀ (x : GaussianInt), R h (minus x) = if + BandPackingSymmetryReversesOrientation h then plus (BandPackingSymmetryVectorAction h + x) else minus (BandPackingSymmetryVectorAction h x)) → ((∀ (h : BandPackingSymmetry), + ∀ (x : GaussianInt), BandPackingSymmetryVectorAction h (-x) = + -BandPackingSymmetryVectorAction h x) → ((∀ (h : BandPackingSymmetry), + Function.Surjective (BandPackingSymmetryTileAction h)) → ( + let incoming (p : Fin 4 → CircleCoordinates) (i : Fin 3) := + BandVectors.1 (p i.succ) (p 0) + let P3 (p : Fin 4 → CircleCoordinates) (A : ProtoTile) : Prop := + ∀ i : Fin 3, TouchingTriple A (TileTranslation A (incoming p i)) + (TileTranslation A (-incoming p (i + 1))) + let P4 (p : Fin 4 → CircleCoordinates) (A : ProtoTile) : Prop := + ∀ (i : Fin 3), ∀ (U : ProtoTile), BandPrototile (p i.succ) U → + TileCentroid U - TileCentroid A = plus (incoming p i) → + TouchingTriple A (TileTranslation A (incoming p i)) U + let P5 (p : Fin 4 → CircleCoordinates) (A : ProtoTile) : Prop := + ∀ (i : Fin 3), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (p i.succ) U → + BandPrototile (p ((i + 1).succ)) V → + TileCentroid U - TileCentroid A = plus (incoming p i) → + TileCentroid V - TileCentroid A = minus (incoming p (i + 1)) → + TouchingTriple A U V + let P (p : Fin 4 → CircleCoordinates) (A : ProtoTile) : Prop := + (1 < (p 0).1 → P3 p A) ∧ (1 < (p 0).1 → P4 p A) ∧ P5 p A + let sigma (h : BandPackingSymmetry) (i : Fin 3) : Fin 3 := + if BandPackingSymmetryReversesOrientation h then -i else i + (∀ (h : BandPackingSymmetry), Function.Surjective (sigma h)) → ((∀ (h : + BandPackingSymmetry), ∀ (p : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), + BandPackingSymmetryQuadrupleAction h p (sigma h i).succ = + BandPackingSymmetryCircleAction h (p i.succ)) → (∀ (h : BandPackingSymmetry), ∀ (p : + Fin 4 → CircleCoordinates), ∀ (A : ProtoTile), (BandPackingSymmetryScopedPhase h p + false) → ((QuarterTurnSymmetric A) → ((∀ (i : Fin 3), ∀ (U : ProtoTile), + BandPrototile (p i.succ) U → QuarterTurnSymmetric U) → (P p A → P + (BandPackingSymmetryQuadrupleAction h p) (BandPackingSymmetryTileAction h + A))))))))))))))) ) := by + classical + intro neg_triple plus minus signs R rsub rinj rcent rplus rminus lneg tile_surj incoming P3 P4 + P5 P sigma sigma_surj parent h p A hph hsA hsP + let pg := BandPackingSymmetryQuadrupleAction h p + let A' := BandPackingSymmetryTileAction h A + have curv : (pg 0).1 = (p 0).1 := (BandPackingSymmetryCovariance h).1 (p 0) + have hsA' : QuarterTurnSymmetric A' := + ((BandPackingSymmetryTilingTransport h).2.2.2.2.1 A).mp hsA + have vec (i : Fin 3) : incoming pg (sigma h i) = + BandPackingSymmetryVectorAction h (incoming p i) := by + have hv := (hph i).1 + simpa only [BandPackingSymmetryScopedPhase, incoming, sigma, + Bool.false_eq_true, ite_false, one_mul] using hv + have proto (i : Fin 3) (U : ProtoTile) : BandPrototile (p i.succ) U ↔ + BandPrototile (pg (sigma h i).succ) (BandPackingSymmetryTileAction h U) := by + dsimp only [pg] + rw [parent] + exact (BandPackingSymmetryCovariance h).2.1 (p i.succ) U + have pull (i : Fin 3) (U : ProtoTile) (hU : BandPrototile (pg (sigma h i).succ) U) : + ∃ V, BandPrototile (p i.succ) V ∧ BandPackingSymmetryTileAction h V = U := by + obtain ⟨V, rfl⟩ := tile_surj h U + exact ⟨V, (proto i V).mpr hU, rfl⟩ + have offset (U : ProtoTile) : + TileCentroid (BandPackingSymmetryTileAction h U) - TileCentroid A' = + R h (TileCentroid U - TileCentroid A) := by + rw [rcent, rcent, rsub] + have cp (i : Fin 3) : R h (plus (incoming p i)) = + if BandPackingSymmetryReversesOrientation h then minus (incoming pg (sigma h i)) + else plus (incoming pg (sigma h i)) := by + rw [rplus, vec] + have cm (i : Fin 3) : R h (minus (incoming p i)) = + if BandPackingSymmetryReversesOrientation h then plus (incoming pg (sigma h i)) + else minus (incoming pg (sigma h i)) := by + rw [rminus, vec] + have triple (U V W : ProtoTile) := + (BandPackingSymmetryTilingTransport h).2.2.2.2.2.1 U V W + have translate (U : ProtoTile) (x : GaussianInt) := + (BandPackingSymmetryTilingTransport h).2.2.2.2.2.2.1 U x + intro hpack + rcases hpack with ⟨h3, h4, h5⟩ + cases hh : BandPackingSymmetryReversesOrientation h + · have vp (i : Fin 3) : incoming pg i = BandPackingSymmetryVectorAction h (incoming p i) := by + simpa only [sigma, hh, Bool.false_eq_true, ite_false] using vec i + have cpp (i : Fin 3) : R h (plus (incoming p i)) = plus (incoming pg i) := by + simpa only [sigma, hh, Bool.false_eq_true, ite_false] using cp i + have cmm (i : Fin 3) : R h (minus (incoming p i)) = minus (incoming pg i) := by + simpa only [sigma, hh, Bool.false_eq_true, ite_false] using cm i + refine ⟨?_, ?_, ?_⟩ + · intro c i + have ht := (triple _ _ _).mp (h3 (by rwa [curv] at c) i) + rw [translate, translate, lneg, ← vp i, ← vp (i + 1)] at ht + exact ht + · intro c i U hU hc + obtain ⟨V, hV, rfl⟩ := pull i U (by simpa only [sigma, hh, Bool.false_eq_true, ite_false] + using hU) + rw [offset] at hc + have hc0 := rinj h (hc.trans (cpp i).symm) + have ht := (triple _ _ _).mp (h4 (by rwa [curv] at c) i V hV hc0) + rw [translate, ← vp i] at ht + exact ht + · intro i U V hU hV hcU hcV + obtain ⟨U0, hU0, rfl⟩ := pull i U (by simpa only [sigma, hh, Bool.false_eq_true, + ite_false] using hU) + obtain ⟨V0, hV0, rfl⟩ := pull (i + 1) V + (by simpa only [sigma, hh, Bool.false_eq_true, ite_false] using hV) + rw [offset] at hcU hcV + have hcU0 := rinj h (hcU.trans (cpp i).symm) + have hcV0 := rinj h (hcV.trans (cmm (i + 1)).symm) + exact (triple _ _ _).mp (h5 i U0 V0 hU0 hV0 hcU0 hcV0) + · have spred (i : Fin 3) : sigma h (i - 1) = sigma h i + 1 := by + simp only [sigma, hh, ite_true] + abel + have vpred (i : Fin 3) : incoming pg (sigma h i + 1) = + BandPackingSymmetryVectorAction h (incoming p (i - 1)) := by + rw [← spred] + exact vec (i - 1) + have cpm (i : Fin 3) : R h (plus (incoming p i)) = minus (incoming pg (sigma h i)) := by + simpa only [hh, ite_true] using cp i + have cmp (i : Fin 3) : R h (minus (incoming p i)) = plus (incoming pg (sigma h i)) := by + simpa only [hh, ite_true] using cm i + refine ⟨?_, ?_, ?_⟩ + · intro c k + obtain ⟨i, rfl⟩ := sigma_surj h k + have ht := (triple _ _ _).mp (h3 (by rwa [curv] at c) (i - 1)) + rw [translate, translate, lneg, sub_add_cancel, ← vpred i, ← vec i] at ht + have hn := (neg_triple A' hsA' (incoming pg (sigma h i + 1)) + (-incoming pg (sigma h i))).mp ht + simpa only [neg_neg] using ((TouchingTriplePermutations _ _ _).mp hn).1 + · intro c k U hU hc + obtain ⟨i, rfl⟩ := sigma_surj h k + obtain ⟨V, hV, rfl⟩ := pull i U hU + rw [offset] at hc + have hc0 := rinj h (hc.trans (cmp i).symm) + have hm := (signs (p i.succ) A hsA (hsP i) (incoming p i)).mp + (h4 (by rwa [curv] at c) i) + have ht := (triple _ _ _).mp (hm V hV hc0) + rw [translate, ← vec i] at ht + exact ht + · intro k U V hU hV hcU hcV + obtain ⟨i, rfl⟩ := sigma_surj h k + obtain ⟨U0, hU0, rfl⟩ := pull i U hU + obtain ⟨V0, hV0, rfl⟩ := pull (i - 1) V (by simpa only [spred] using hV) + rw [offset] at hcU hcV + have hcU0 := rinj h (hcU.trans (cmp i).symm) + have hcV0 := rinj h (hcV.trans (by simpa only [spred] using (cpm (i - 1)).symm)) + have ht := (triple _ _ _).mp (h5 (i - 1) V0 U0 hV0 + (by simpa only [sub_add_cancel] using hU0) hcV0 + (by simpa only [sub_add_cancel] using hcU0)) + exact ((TouchingTriplePermutations _ _ _).mp ht).1 + +private theorem flip : + (by + classical + exact + let incoming (p : Fin 4 → CircleCoordinates) (i : Fin 3) := + BandVectors.1 (p i.succ) (p 0) + ∀ (p : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → (∀ (i : Fin 3), + BandVectors.1 (p 0) (p i.succ) = GaussianQuarterTurn (incoming p i)) ) := by + classical + intro incoming p hp i + have hf := ((VectorRecursionLaws p hp.1).2.2.2.2 hp i).1 + have hm (x : GaussianInt) : (⟨0, 1⟩ : GaussianInt) * x = GaussianQuarterTurn x := by + ext <;> simp [GaussianQuarterTurn] + exact hf.trans (hm _) + +private theorem hsPg : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (∀ (i : Fin (3 : + ℕ)), ∀ (U : ProtoTile), BandPrototile (q i.succ) U → QuarterTurnSymmetric U) → ((∀ (h + : BandPackingSymmetry), Function.Surjective (BandPackingSymmetryTileAction h)) → ( + let sigma (h : BandPackingSymmetry) (i : Fin 3) : Fin 3 := + if BandPackingSymmetryReversesOrientation h then -i else i + (∀ (h : BandPackingSymmetry), ∀ (i : Fin 3), sigma h (sigma h i) = i) → ((∀ (h : + BandPackingSymmetry), ∀ (p : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), + BandPackingSymmetryQuadrupleAction h p (sigma h i).succ = + BandPackingSymmetryCircleAction h (p i.succ)) → (∀ (i : Fin 3), ∀ (U : ProtoTile), + BandPrototile ((BandPackingSymmetryQuadrupleAction g q) i.succ) U → + QuarterTurnSymmetric U)))) ) := by + classical + intro g q hquarterParents tile_surj sigma sigma_inv parent i U hU + obtain ⟨V, rfl⟩ := tile_surj g U + have he := parent g q (sigma g i) + rw [sigma_inv] at he + rw [he] at hU + have hV := ((BandPackingSymmetryCovariance g).2.1 (q (sigma g i).succ) V).mpr hU + exact ((BandPackingSymmetryTilingTransport g).2.2.2.2.1 V).mp + (hquarterParents (sigma g i) V hV) + +end PackingCovarianceProof + +theorem BandPackingSymmetryT3T5Covariance : + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → + ((BandPackingSymmetryScopedPhase g q false) → (∀ (T : ProtoTile), (BandPrototile (q 0) T) + → ((QuarterTurnSymmetric T) → ((∀ (i : Fin 3), ∀ (U : ProtoTile), BandPrototile (q + i.succ) U → QuarterTurnSymmetric U) → ( + let qg := BandPackingSymmetryQuadrupleAction g q + let Tg := BandPackingSymmetryTileAction g T + ((1 < (q 0).1 → ∀ i : Fin 3, + TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) + (TileTranslation T + (-BandVectors.1 (q ((i + 1).succ)) (q 0)))) ∧ + (1 < (q 0).1 → ∀ (i : Fin 3), ∀ (U : ProtoTile), BandPrototile (q i.succ) U → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U) ∧ + (∀ (i : Fin 3), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → + BandPrototile (q ((i + 1).succ)) V → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ)))) → + TouchingTriple T U V)) ↔ + ((1 < (qg 0).1 → ∀ i : Fin 3, + TouchingTriple Tg + (TileTranslation Tg (BandVectors.1 (qg i.succ) (qg 0))) + (TileTranslation Tg + (-BandVectors.1 (qg ((i + 1).succ)) (qg 0)))) ∧ + (1 < (qg 0).1 → ∀ (i : Fin 3), ∀ (U : ProtoTile), BandPrototile (qg i.succ) U → + TileCentroid U - TileCentroid Tg = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (qg i.succ) (qg 0)) + + GaussianRealPoint (BandVectors.1 (qg 0) (qg i.succ))) → + TouchingTriple Tg + (TileTranslation Tg (BandVectors.1 (qg i.succ) (qg 0))) U) ∧ + (∀ (i : Fin 3), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (qg i.succ) U → + BandPrototile (qg ((i + 1).succ)) V → + TileCentroid U - TileCentroid Tg = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (qg i.succ) (qg 0)) + + GaussianRealPoint (BandVectors.1 (qg 0) (qg i.succ))) → + TileCentroid V - TileCentroid Tg = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (qg ((i + 1).succ)) (qg 0)) - + GaussianRealPoint (BandVectors.1 (qg 0) (qg ((i + 1).succ)))) → + TouchingTriple Tg U V))))))) := by + intro g q hq hphase T hT hquarterT hquarterParents +-- BODY + classical + -- Touching depends on cells and on anchors only for empty tiles. + let E (A B : ProtoTile) : Prop := + A.cells = B.cells ∧ (A.cells = ∅ → A.anchor = B.anchor) + have etrans {A B C : ProtoTile} (h : E A B) (k : E B C) : E A C := + ⟨h.1.trans k.1, fun he => (h.2 he).trans (k.2 (h.1 ▸ he))⟩ + have etranslate {A B : ProtoTile} (h : E A B) (v : GaussianInt) := + PackingCovarianceProof.etranslate (A := A) (B := B) h v + have equarter {A B : ProtoTile} (h : E A B) := PackingCovarianceProof.equarter (A := A) (B := B) h + have touching_obs {A A' B B' : ProtoTile} (ha : E A A') (hb : E B B') := + PackingCovarianceProof.touching_obs (A := A) (A' := A') (B := B) (B' := B') ha hb + have triple_obs {A A' B B' C C' : ProtoTile} + (ha : E A A') (hb : E B B') (hc : E C C') := PackingCovarianceProof.triple_obs touching_obs + (A := A) (A' := A') (B := B) (B' := B') (C := C) (C' := C') ha hb hc + have translate_add := PackingCovarianceProof.translate_add + have translate_zero := PackingCovarianceProof.translate_zero + have quarter_translate := PackingCovarianceProof.quarter_translate + have qtwo := PackingCovarianceProof.qtwo + -- Two centered integral quarter-turns give a common centered half-turn. + let H (w : GaussianInt) (A : ProtoTile) := + TileTranslation (TileQuarterTurn (TileQuarterTurn A)) w + have half_translate := PackingCovarianceProof.half_translate translate_add quarter_translate qtwo + have half_cov := PackingCovarianceProof.half_cov + have half_center := PackingCovarianceProof.half_center etrans etranslate equarter translate_add + quarter_translate + have half_other := PackingCovarianceProof.half_other etranslate translate_add half_center + have neg_triple := PackingCovarianceProof.neg_triple etranslate triple_obs half_translate + half_cov half_center + have parent_half := PackingCovarianceProof.parent_half etranslate triple_obs translate_add + translate_zero half_translate half_cov half_center half_other + have point_add := PackingCovarianceProof.point_add + have point_sub := PackingCovarianceProof.point_sub + have point_neg (x : GaussianInt) : GaussianRealPoint (-x) = -GaussianRealPoint x := by + ext <;> simp [GaussianRealPoint] + have cent_translate := PackingCovarianceProof.cent_translate + let plus (x : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint x + GaussianRealPoint (GaussianQuarterTurn x)) + let minus (x : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint x - GaussianRealPoint (GaussianQuarterTurn x)) + -- Half-turn, common translation, and permutation exchange the two offsets. + have signs := PackingCovarianceProof.signs translate_add translate_zero parent_half point_add + point_sub point_neg cent_translate + -- Word induction is used only for generic linear grid-action facts. + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + have radd := PackingCovarianceProof.radd + have rsub := PackingCovarianceProof.rsub + have rsmul (h : BandPackingSymmetry) (c : Real) (p : Real × Real) : + R h (c • p) = c • R h p := PackingCovarianceProof.rsmul h c p + have rneg (h : BandPackingSymmetry) (p : Real × Real) : R h (-p) = -R h p := by + simpa using rsmul h (-1) p + have rpoint := PackingCovarianceProof.rpoint + have rminusq := PackingCovarianceProof.rminusq rneg + have rq := PackingCovarianceProof.rq rminusq + have rinj := PackingCovarianceProof.rinj + have rcent := PackingCovarianceProof.rcent + have rplus := PackingCovarianceProof.rplus radd rsmul rpoint rq + have rminus := PackingCovarianceProof.rminus rsub rsmul rpoint rq + have lneg := PackingCovarianceProof.lneg + have tile_surj := PackingCovarianceProof.tile_surj + let incoming (p : Fin 4 → CircleCoordinates) (i : Fin 3) := + BandVectors.1 (p i.succ) (p 0) + let P3 (p : Fin 4 → CircleCoordinates) (A : ProtoTile) : Prop := + ∀ i : Fin 3, TouchingTriple A (TileTranslation A (incoming p i)) + (TileTranslation A (-incoming p (i + 1))) + let P4 (p : Fin 4 → CircleCoordinates) (A : ProtoTile) : Prop := + ∀ (i : Fin 3) (U : ProtoTile), BandPrototile (p i.succ) U → + TileCentroid U - TileCentroid A = plus (incoming p i) → + TouchingTriple A (TileTranslation A (incoming p i)) U + let P5 (p : Fin 4 → CircleCoordinates) (A : ProtoTile) : Prop := + ∀ (i : Fin 3) (U V : ProtoTile), BandPrototile (p i.succ) U → + BandPrototile (p ((i + 1).succ)) V → + TileCentroid U - TileCentroid A = plus (incoming p i) → + TileCentroid V - TileCentroid A = minus (incoming p (i + 1)) → + TouchingTriple A U V + let P (p : Fin 4 → CircleCoordinates) (A : ProtoTile) : Prop := + (1 < (p 0).1 → P3 p A) ∧ (1 < (p 0).1 → P4 p A) ∧ P5 p A + let sigma (h : BandPackingSymmetry) (i : Fin 3) : Fin 3 := + if BandPackingSymmetryReversesOrientation h then -i else i + have sigma_inv (h : BandPackingSymmetry) (i : Fin 3) : sigma h (sigma h i) = i := by + cases hh : BandPackingSymmetryReversesOrientation h <;> simp [sigma, hh] + have sigma_surj := PackingCovarianceProof.sigma_surj sigma_inv + have parent := PackingCovarianceProof.parent + -- The scoped phase identifies canonical vectors for the entire word. + have forward := PackingCovarianceProof.forward neg_triple signs rsub rinj rcent rplus rminus + lneg tile_surj sigma_surj parent + have flip (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) (i : Fin 3) : + BandVectors.1 (p 0) (p i.succ) = GaussianQuarterTurn (incoming p i) := + PackingCovarianceProof.flip p hp i + have hqg := BandPackingSymmetryProperCovariance g q hq + have hsTg : QuarterTurnSymmetric (BandPackingSymmetryTileAction g T) := + ((BandPackingSymmetryTilingTransport g).2.2.2.2.1 T).mp hquarterT + have hsPg := PackingCovarianceProof.hsPg g q hquarterParents tile_surj sigma_inv parent + dsimp only + simp only [flip q hq, flip (BandPackingSymmetryQuadrupleAction g q) hqg] + change P q T ↔ P (BandPackingSymmetryQuadrupleAction g q) (BandPackingSymmetryTileAction g T) + constructor + · exact forward g q T hphase hquarterT hquarterParents + · intro hpack + obtain ⟨k, _, _, hQ, _, hTile, _, _, _, _, _, hPh⟩ := + BandPackingSymmetryInversePhaseCancellation.2 g + have hback := forward k (BandPackingSymmetryQuadrupleAction g q) + (BandPackingSymmetryTileAction g T) (hPh q hq false hphase) hsTg hsPg hpack + simpa only [hQ, hTile] using hback + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileAction.lean new file mode 100644 index 0000000000..e18a4c72e3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileAction.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurn +public import LeanPool.ApollonianSuperharmonic.TileReflection + +-- [TABLET NODE: BandPackingSymmetryTileAction] + +/-! +# BandPackingSymmetryTileAction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The grid action associated with a band-packing symmetry word sends a +prototile to itself for the identity and packing shifts and to its grid +quarter-turn for coordinate negation. Coordinate conjugation acts by +reflection followed by a half-turn, so its linear action on grid points is +$v\mapsto-\overline v$, matching the canonical orientation of band +vectors. A composite word acts by composing these tile maps in the same +order as its coordinate action. +-/ +def BandPackingSymmetryTileAction : + BandPackingSymmetry → ProtoTile → ProtoTile := +-- BODY + fun g T => match g with + | .identity => T + | .negate => TileQuarterTurn T + | .conjugate => TileQuarterTurn (TileQuarterTurn (TileReflection T)) + | .shift _ => T + | .comp g h => + BandPackingSymmetryTileAction g + (BandPackingSymmetryTileAction h T) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean new file mode 100644 index 0000000000..645629c98b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean @@ -0,0 +1,2380 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPrototileFootprintSlopeCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential +public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer +public import LeanPool.ApollonianSuperharmonic.OdometerTranslation +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas + +-- [TABLET NODE: BandPackingSymmetryTileOdometerCovariance] + +/-! +# BandPackingSymmetryTileOdometerCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TileOdometerSymmetryProof + +private theorem positiveCells : + (by + classical + exact + ∀ (D : CircleCoordinates), ∀ (V : ProtoTile), 0 < D.1 → BandPrototile D V → + V.cells.Nonempty ) := by + classical + intro D V hD hV + induction hV with + | line w x hw => simp at hD + | unit z x anchor => simp + | @decompose q hq S V hS hcells hfoot hcentroid ih => + have facts := ProperBandCurvatureStructure q hq + have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by + by_cases h0 : 0 < (q (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (q (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + by_cases h2 : 0 < (q (2 : Fin 3).succ).1 + · exact ⟨2, h2⟩ + have n0 := facts.2.1 (0 : Fin 3) + have n1 := facts.2.1 (1 : Fin 3) + have n2 := facts.2.1 (2 : Fin 3) + have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim + rcases hp with ⟨i, hi⟩ + rcases ih i false hi with ⟨x, hx⟩ + exact ⟨x, (hcells x).mpr ⟨i, false, hx⟩⟩ + +private theorem odoPositiveCurvature : + (by + classical + exact + ∀ (D : CircleCoordinates), ∀ (V : ProtoTile), ∀ (k : PartialOdometer), TileOdometer D V k + → V.cells.Nonempty → 0 < D.1 ) := by + classical + intro D V k ho hne + induction ho with + | line w x hw k hdom => simp at hne + | unit z x V k hV hdom htrans => norm_num + | decompose hq hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope => + exact (ProperBandCurvatureStructure _ hq).1 + +private theorem slopeCov : + (by + classical + exact + ∀ (g : BandPackingSymmetry), (∀ (D : CircleCoordinates), ∀ (V : ProtoTile), ∀ (k : + PartialOdometer), TileOdometer D V k → V.cells.Nonempty → 0 < D.1) → (∀ (D : + CircleCoordinates), ∀ (V : ProtoTile), ∀ (k : PartialOdometer), TileOdometer D V k → + V.cells.Nonempty → PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g + k) = (PartialOdometerSlope k).map (BandPackingSymmetrySlopeAction g V)) ) := by + classical + intro g odoPositiveCurvature D V k ho hne + have hproto := TileOdometerBandPrototile D V k ho + have hcurv := odoPositiveCurvature D V k ho hne + have hdom := PositiveCurvatureTileOdometerDomain D V k hcurv ho + exact BandPrototileFootprintSlopeCovariance g D V k hproto hne hdom + +private theorem lineCircle : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (w : GaussianInt), (w = 1 ∨ w = -1) → ∃ w', (w' = 1 ∨ w' = + -1) ∧ BandPackingSymmetryCircleAction a (0, w) = (0, w') ) := by + classical + intro a + induction a with + | identity => intro w hw; exact ⟨w, hw, rfl⟩ + | negate => + intro w hw + refine ⟨-w, ?_, ?_⟩ + · rcases hw with h | h <;> subst w <;> norm_num + · rfl + | conjugate => + intro w hw + refine ⟨GaussianReflection w, ?_, ?_⟩ + · rcases hw with h | h + · subst w + exact Or.inl (by ext <;> simp [GaussianReflection] ) + · subst w + exact Or.inr (by ext <;> simp [GaussianReflection] ) + · rfl + | shift v => + intro w hw + refine ⟨w, hw, ?_⟩ + simp [BandPackingSymmetryCircleAction] + | comp a b iha ihb => + intro w hw + obtain ⟨wb, hwb, hb⟩ := ihb w hw + obtain ⟨wa, hwa, ha⟩ := iha wb hwb + exact ⟨wa, hwa, by simpa [BandPackingSymmetryCircleAction, hb] using ha⟩ + +private theorem tileEmpty : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (x : GaussianInt), BandPackingSymmetryTileAction a ⟨∅, x⟩ + = ⟨∅, BandPackingSymmetryVectorAction a x⟩ ) := by + classical + intro a + induction a with + | identity => intro x; rfl + | negate => intro x; simp [BandPackingSymmetryTileAction, TileQuarterTurn, + BandPackingSymmetryVectorAction] + | conjugate => + intro x + apply congrArg₂ ProtoTile.mk + · simp [TileQuarterTurn, TileReflection] + · ext <;> simp [TileQuarterTurn, TileReflection, + GaussianQuarterTurn, GaussianReflection, BandPackingSymmetryVectorAction] + | shift w => intro x; rfl + | comp a b iha ihb => + intro x + simp only [BandPackingSymmetryTileAction, ihb, iha, + BandPackingSymmetryVectorAction] + +private theorem zeroLine : + (by + classical + exact + ∀ (D : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), D.1 = 0 → + TileOdometer D U k → ∃ w x, (w = 1 ∨ w = -1) ∧ D = (0, w) ∧ U = ⟨∅, x⟩ ∧ k.domain = + {x} ) := by + classical + intro D U k hz ho + cases ho with + | line w x hw k hk => exact ⟨w, x, hw, rfl, rfl, hk⟩ + | unit z x U k hU hdom htrans => simp at hz + | decompose hq hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope => + have hp := (ProperBandCurvatureStructure _ hq).1 + omega + +private theorem actionForward : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), (x ∈ k.domain) + → (BandPackingSymmetryVectorAction a x ∈ (BandPackingSymmetryPartialOdometerAction a + k).domain) ) := by + classical + intro a k x hx + change BandPackingSymmetryVectorAction a x ∈ + ((BandPackingSymmetryPartialOdometerAction a k).domain : Set GaussianInt) + rw [(BandPackingSymmetryPartialOdometerActionFormulas a k k).1] + exact ⟨x, hx, rfl⟩ + +private theorem actionDiff : + (by + classical + exact + (∀ (a : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), (x ∈ + k.domain) → (BandPackingSymmetryVectorAction a x ∈ + (BandPackingSymmetryPartialOdometerAction a k).domain)) → (∀ (a : + BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ (l : PartialOdometer), ∀ (x : + GaussianInt), (x ∈ k.domain) → ((x ∈ l.domain) → + ((BandPackingSymmetryPartialOdometerAction a l).value + (BandPackingSymmetryVectorAction a x) - (BandPackingSymmetryPartialOdometerAction a + k).value (BandPackingSymmetryVectorAction a x) = l.value x - k.value x))) ) := by + classical + intro actionForward a k l x hk hl + induction a generalizing k l x with + | identity => rfl + | shift w => + simp only [BandPackingSymmetryVectorAction, BandPackingSymmetryPartialOdometerAction, + hk, hl, ↓reduceIte] + ring + | negate => + simp only [BandPackingSymmetryVectorAction, BandPackingSymmetryPartialOdometerAction, + Finset.mem_image_of_mem GaussianQuarterTurn hk, + Finset.mem_image_of_mem GaussianQuarterTurn hl, ↓reduceIte] + have hi : -GaussianQuarterTurn (GaussianQuarterTurn x) = x := by + ext <;> simp [GaussianQuarterTurn] + rw [hi] + | conjugate => + simp only [BandPackingSymmetryVectorAction, BandPackingSymmetryPartialOdometerAction, + Finset.mem_image_of_mem (fun z => -GaussianReflection z) hk, + Finset.mem_image_of_mem (fun z => -GaussianReflection z) hl, ↓reduceIte] + have hi : -GaussianReflection (-GaussianReflection x) = x := by + ext <;> simp [GaussianReflection] + rw [hi] + | comp a b iha ihb => + have hbK := actionForward b k x hk + have hbL := actionForward b l x hl + simpa [BandPackingSymmetryVectorAction, BandPackingSymmetryPartialOdometerAction] + using iha (BandPackingSymmetryPartialOdometerAction b k) + (BandPackingSymmetryPartialOdometerAction b l) + (BandPackingSymmetryVectorAction b x) hbK hbL |>.trans + (ihb k l x hk hl) + +private theorem lineCov : + (by + classical + exact + (∀ (a : BandPackingSymmetry), ∀ (w : GaussianInt), (w = 1 ∨ w = -1) → ∃ w', (w' = 1 ∨ w' + = -1) ∧ BandPackingSymmetryCircleAction a (0, w) = (0, w')) → ((∀ (a : + BandPackingSymmetry), ∀ (x : GaussianInt), BandPackingSymmetryTileAction a ⟨∅, x⟩ = + ⟨∅, BandPackingSymmetryVectorAction a x⟩) → ((∀ (D : CircleCoordinates), ∀ (U : + ProtoTile), ∀ (k : PartialOdometer), D.1 = 0 → TileOdometer D U k → ∃ w x, (w = 1 ∨ w + = -1) ∧ D = (0, w) ∧ U = ⟨∅, x⟩ ∧ k.domain = {x}) → (∀ (w : GaussianInt), ∀ (x : + GaussianInt), (w = 1 ∨ w = -1) → (∀ (k : PartialOdometer), k.domain = {x} → ∀ a : + BandPackingSymmetry, TileOdometer (BandPackingSymmetryCircleAction a (0, w)) + (BandPackingSymmetryTileAction a ⟨∅, x⟩) (BandPackingSymmetryPartialOdometerAction a + k))))) ) := by + classical + intro lineCircle tileEmpty zeroLine w x hw k hk a + induction a generalizing w x k with + | identity => + simpa [BandPackingSymmetryCircleAction, BandPackingSymmetryTileAction, + BandPackingSymmetryPartialOdometerAction] using + TileOdometer.line w x hw k hk + | negate => + have hw' : -w = 1 ∨ -w = -1 := by + rcases hw with h | h <;> subst w <;> first | exact Or.inr rfl | exact Or.inl rfl + have ht : BandPackingSymmetryTileAction .negate ⟨∅, x⟩ = + ⟨∅, GaussianQuarterTurn x⟩ := by simp [BandPackingSymmetryTileAction, TileQuarterTurn] + rw [ht] + simpa [BandPackingSymmetryCircleAction, BandPackingSymmetryPartialOdometerAction, + hk] using TileOdometer.line (-w) (GaussianQuarterTurn x) hw' + (BandPackingSymmetryPartialOdometerAction .negate k) (by + simp [BandPackingSymmetryPartialOdometerAction, hk]) + | conjugate => + have hw' : GaussianReflection w = 1 ∨ GaussianReflection w = -1 := by + rcases hw with h | h + · subst w + exact Or.inl (by ext <;> simp [GaussianReflection] ) + · subst w + exact Or.inr (by ext <;> simp [GaussianReflection] ) + have ht : BandPackingSymmetryTileAction .conjugate ⟨∅, x⟩ = + ⟨∅, -GaussianReflection x⟩ := by + rw [tileEmpty] + simp [BandPackingSymmetryVectorAction] + rw [ht] + simpa [BandPackingSymmetryCircleAction, BandPackingSymmetryPartialOdometerAction, + GaussianReflection, hk] using + TileOdometer.line (GaussianReflection w) (-GaussianReflection x) hw' + (BandPackingSymmetryPartialOdometerAction .conjugate k) (by + simp [BandPackingSymmetryPartialOdometerAction, hk]) + | shift v => + simpa [BandPackingSymmetryCircleAction, BandPackingSymmetryTileAction, + BandPackingSymmetryPartialOdometerAction, hk] using + TileOdometer.line w x hw + (BandPackingSymmetryPartialOdometerAction (.shift v) k) (by + simp [BandPackingSymmetryPartialOdometerAction, hk]) + | comp a b iha ihb => + have mid := ihb w x hw k hk + obtain ⟨wm, hwm, hcircle⟩ := lineCircle b w hw + obtain ⟨w', x', hw', hC, hT, hk'⟩ := + zeroLine _ _ _ (by simp [hcircle]) mid + have htile : BandPackingSymmetryTileAction b ⟨∅, x⟩ = ⟨∅, x'⟩ := hT + change TileOdometer + (BandPackingSymmetryCircleAction a (BandPackingSymmetryCircleAction b (0, w))) + (BandPackingSymmetryTileAction a (BandPackingSymmetryTileAction b ⟨∅, x⟩)) + (BandPackingSymmetryPartialOdometerAction a + (BandPackingSymmetryPartialOdometerAction b k)) + rw [hC, htile] + exact iha w' x' hw' _ hk' + +private theorem circleCurvature : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (D : CircleCoordinates), (BandPackingSymmetryCircleAction + a D).1 = D.1 ) := by + classical + intro a D + induction a generalizing D with + | identity => rfl + | negate => rfl + | conjugate => rfl + | shift w => rfl + | comp a b iha ihb => simp [BandPackingSymmetryCircleAction, iha, ihb] + +private theorem extractUnit : + (by + classical + exact + ∀ (D : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), D.1 = 1 → + TileOdometer D U k → ∃ z x, D = (1, 1 + 2 * z) ∧ U.cells = {x} ∧ (k.domain : Set + GaussianInt) = FootprintVertices U ∧ OdometerTranslation k (CurvatureOneOdometer z) ) + := by + classical + intro D U k hcurv ho + cases ho with + | line w x hw l hdom => simp at hcurv + | unit z x V l hV hdom htrans => exact ⟨z, x, rfl, hV, hdom, htrans⟩ + | @decompose q hq S V hs l hV hsub hcells hfoot hcent hdom hvalue hcompat hslope => + have hparent : 1 < (q 0).1 := by + have hpAll : ∃ i : Fin 3, 0 < (q i.succ).1 := by + have hp := (ProperBandCurvatureStructure q hq).2.1 + by_cases h0 : 0 < (q (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (q (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + have n0 := hp 0 + have n1 := hp 1 + have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega + exact ((by decide : (0 : Fin 3) ≠ 1) + ((ProperBandCurvatureStructure q hq).2.2 0 1 z0 z1)).elim + obtain ⟨i, hi⟩ := hpAll + have hb := hq.2 i + omega + omega + +private theorem differenceTransport : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : ℝ × ℝ), ∀ (y : + ℝ × ℝ), ∀ (v : GaussianInt), ∀ (w : GaussianInt), ∀ (r : ℝ), TileCentroid V - + TileCentroid U = r • GaussianRealPoint v → x - y = r • GaussianRealPoint w → + TileCentroid (BandPackingSymmetryTileAction a V) - TileCentroid + (BandPackingSymmetryTileAction a U) = r • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction a (v, w)).1 ∧ BandPackingSymmetrySlopeAction a + V x - BandPackingSymmetrySlopeAction a U y = r • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction a (v, w)).2 ) := by + classical + intro a + induction a with + | identity => intro U V x y v w r hc hp; exact ⟨hc, hp⟩ + | shift t => + intro U V x y v w r hc hp + rcases t with ⟨tr, ti⟩ + rcases v with ⟨vr, vi⟩ + rcases w with ⟨wr, wi⟩ + have hc1 := congrArg Prod.fst hc + have hc2 := congrArg Prod.snd hc + have hp1 := congrArg Prod.fst hp + have hp2 := congrArg Prod.snd hp + refine ⟨hc, ?_⟩ + apply Prod.ext + all_goals + simp [BandPackingSymmetrySlopeAction, BandPackingSymmetryAffineVectorAction, + GaussianRealPoint, GaussianReflection] at hc1 hc2 hp1 hp2 ⊢ + ring_nf + nlinarith [congrArg (fun z : ℝ => (tr : ℝ) * z) hc1, + congrArg (fun z : ℝ => (ti : ℝ) * z) hc2, + congrArg (fun z : ℝ => (ti : ℝ) * z) hc1, + congrArg (fun z : ℝ => (tr : ℝ) * z) hc2] + | negate => + intro U V x y v w r hc hp + have hc1 := congrArg Prod.fst hc + have hc2 := congrArg Prod.snd hc + have hp1 := congrArg Prod.fst hp + have hp2 := congrArg Prod.snd hp + change TileCentroid (TileQuarterTurn V) - TileCentroid (TileQuarterTurn U) = _ ∧ _ + rw [(TileQuarterTurnFormulas V).2.2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.2.1] + constructor + · apply Prod.ext + all_goals simp [BandPackingSymmetryAffineVectorAction, + GaussianRealPoint, GaussianQuarterTurn] at hc1 hc2 hp1 hp2 ⊢; linarith + · apply Prod.ext + all_goals simp [BandPackingSymmetrySlopeAction, + BandPackingSymmetryAffineVectorAction, + GaussianRealPoint, GaussianQuarterTurn] at hp1 hp2 ⊢; linarith + | conjugate => + intro U V x y v w r hc hp + have hc1 := congrArg Prod.fst hc + have hc2 := congrArg Prod.snd hc + have hp1 := congrArg Prod.fst hp + have hp2 := congrArg Prod.snd hp + change TileCentroid (TileQuarterTurn (TileQuarterTurn (TileReflection V))) - + TileCentroid (TileQuarterTurn (TileQuarterTurn (TileReflection U))) = _ ∧ _ + rw [(TileQuarterTurnFormulas (TileQuarterTurn (TileReflection V))).2.2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn (TileReflection U))).2.2.2.2.1, + (TileQuarterTurnFormulas (TileReflection V)).2.2.2.2.1, + (TileQuarterTurnFormulas (TileReflection U)).2.2.2.2.1, + (TileReflectionFormulas V).2.2.2.2.1, + (TileReflectionFormulas U).2.2.2.2.1] + constructor + · apply Prod.ext + all_goals simp [BandPackingSymmetryAffineVectorAction, + GaussianRealPoint, GaussianReflection] at hc1 hc2 hp1 hp2 ⊢; linarith + · apply Prod.ext + all_goals simp [BandPackingSymmetrySlopeAction, + BandPackingSymmetryAffineVectorAction, + GaussianRealPoint, GaussianReflection] at hp1 hp2 ⊢; linarith + | comp a b iha ihb => + intro U V x y v w r hc hp + have hb := ihb U V x y v w r hc hp + exact iha (BandPackingSymmetryTileAction b U) + (BandPackingSymmetryTileAction b V) + (BandPackingSymmetrySlopeAction b V x) + (BandPackingSymmetrySlopeAction b U y) + (BandPackingSymmetryAffineVectorAction b (v, w)).1 + (BandPackingSymmetryAffineVectorAction b (v, w)).2 r hb.1 hb.2 + +private theorem affineMix : + (by + classical + exact + let symmetryMix : Bool → GaussianInt × GaussianInt → GaussianInt × GaussianInt := + fun r z => if r then + (z.1 + GaussianQuarterTurn z.1, z.2 - GaussianQuarterTurn z.2) + else (z.1 - GaussianQuarterTurn z.1, z.2 + GaussianQuarterTurn z.2) + ∀ (a : BandPackingSymmetry), ∀ (r : Bool), ∀ (z : GaussianInt × GaussianInt), + BandPackingSymmetryAffineVectorAction a (symmetryMix r z) = symmetryMix (xor r + (BandPackingSymmetryReversesOrientation a)) (BandPackingSymmetryAffineVectorAction a + z) ) := by + classical + intro symmetryMix a + induction a with + | identity => intro r z; cases r <;> rfl + | shift t => + intro r z + rcases t with ⟨tr, ti⟩ + rcases z with ⟨v, w⟩ + cases r <;> rcases v with ⟨vr, vi⟩ <;> rcases w with ⟨wr, wi⟩ <;> + ext <;> simp [symmetryMix, BandPackingSymmetryAffineVectorAction, + BandPackingSymmetryReversesOrientation, GaussianQuarterTurn, + GaussianReflection] <;> ring + | negate => + intro r z + rcases z with ⟨v, w⟩ + cases r <;> rcases v with ⟨vr, vi⟩ <;> rcases w with ⟨wr, wi⟩ <;> + ext <;> simp [symmetryMix, BandPackingSymmetryAffineVectorAction, + BandPackingSymmetryReversesOrientation, GaussianQuarterTurn] <;> ring + | conjugate => + intro r z + rcases z with ⟨v, w⟩ + cases r <;> rcases v with ⟨vr, vi⟩ <;> rcases w with ⟨wr, wi⟩ <;> + ext <;> simp [symmetryMix, BandPackingSymmetryAffineVectorAction, + BandPackingSymmetryReversesOrientation, GaussianQuarterTurn, + GaussianReflection] <;> ring + | comp a b iha ihb => + intro r z + change BandPackingSymmetryAffineVectorAction a + (BandPackingSymmetryAffineVectorAction b (symmetryMix r z)) = + symmetryMix (xor r (xor (BandPackingSymmetryReversesOrientation a) + (BandPackingSymmetryReversesOrientation b))) + (BandPackingSymmetryAffineVectorAction a + (BandPackingSymmetryAffineVectorAction b z)) + rw [ihb r z, iha] + simp [Bool.xor_comm, Bool.xor_left_comm, + ] + +private theorem triangular : + (by + classical + exact + ∀ (n : ℤ), (n + 1) * (n + 1 - 1) / 2 = n * (n - 1) / 2 + n ) := by + classical + intro n + rw [show (n + 1) * (n + 1 - 1) = n * (n - 1) + n * 2 by ring] + exact Int.add_mul_ediv_right _ _ (by norm_num) + +private theorem shiftDx : + (by + classical + exact + ∀ (wr : ℤ), ∀ (wi : ℤ), (∀ (n : ℤ), (n + 1) * (n + 1 - 1) / 2 = n * (n - 1) / 2 + n) → (∀ + (y : GaussianInt), BandPackingShiftPotential ⟨wr, wi⟩ (y + 1) - + BandPackingShiftPotential ⟨wr, wi⟩ y = wr * y.re + wi * y.im) ) := by + classical + intro wr wi triangular y + simp only [BandPackingShiftPotential, Zsqrtd.re_add, + Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one, add_zero] + rw [triangular] + ring + +private theorem shiftDy : + (by + classical + exact + ∀ (wr : ℤ), ∀ (wi : ℤ), (∀ (n : ℤ), (n + 1) * (n + 1 - 1) / 2 = n * (n - 1) / 2 + n) → (∀ + (y : GaussianInt), BandPackingShiftPotential ⟨wr, wi⟩ (y + ⟨0, 1⟩) - + BandPackingShiftPotential ⟨wr, wi⟩ y = -wr * y.im + wi * y.re) ) := by + classical + intro wr wi triangular y + simp only [BandPackingShiftPotential, Zsqrtd.re_add, + Zsqrtd.im_add, add_zero] + rw [triangular] + ring + +private theorem hcorner : + (by + classical + exact + ∀ (wr : ℤ), ∀ (wi : ℤ), (∀ (y : GaussianInt), BandPackingShiftPotential ⟨wr, wi⟩ (y + 1) + - BandPackingShiftPotential ⟨wr, wi⟩ y = wr * y.re + wi * y.im) → ((∀ (y : + GaussianInt), BandPackingShiftPotential ⟨wr, wi⟩ (y + ⟨0, 1⟩) - + BandPackingShiftPotential ⟨wr, wi⟩ y = -wr * y.im + wi * y.re) → (∀ (v : GaussianInt), + let d1 := BandPackingShiftPotential ⟨wr, wi⟩ (v + 1) - + BandPackingShiftPotential ⟨wr, wi⟩ v + let d2 := BandPackingShiftPotential ⟨wr, wi⟩ (v + ⟨0, 1⟩) - + BandPackingShiftPotential ⟨wr, wi⟩ v + BandPackingShiftPotential ⟨wr, wi⟩ (v + 1 + ⟨0, 1⟩) = BandPackingShiftPotential ⟨wr, wi⟩ + v + d1 + d2 + wi)) ) := by + classical + intro wr wi shiftDx shiftDy v d1 d2 + have hdx := shiftDx (v + ⟨0, 1⟩) + have hdx0 := shiftDx v + have hdy0 := shiftDy v + rw [show v + ⟨0, 1⟩ + 1 = v + 1 + ⟨0, 1⟩ by abel] at hdx + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + add_zero] at hdx + have hd1 : d1 = wr * v.re + wi * v.im := by + simpa [d1] using hdx0 + have hd2 : d2 = -wr * v.im + wi * v.re := by + simpa [d2] using hdy0 + have hv : BandPackingShiftPotential ⟨wr, wi⟩ (v + ⟨0, 1⟩) = + BandPackingShiftPotential ⟨wr, wi⟩ v + d2 := by + dsimp [d2] + linarith [hdy0] + have hd1corner : wr * v.re + wi * (v.im + 1) = d1 + wi := by + rw [hd1] + ring + calc + BandPackingShiftPotential ⟨wr, wi⟩ (v + 1 + ⟨0, 1⟩) = + BandPackingShiftPotential ⟨wr, wi⟩ (v + ⟨0, 1⟩) + + (wr * v.re + wi * (v.im + 1)) := by linarith + _ = BandPackingShiftPotential ⟨wr, wi⟩ v + d2 + d1 + wi := by + rw [hv, hd1corner] + ring + _ = BandPackingShiftPotential ⟨wr, wi⟩ v + d1 + d2 + wi := by ring + +private theorem hpsi : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (wr : ℤ), ∀ (wi : ℤ), ∀ (v : GaussianInt), + let d1 := BandPackingShiftPotential ⟨wr, wi⟩ (v + 1) - + BandPackingShiftPotential ⟨wr, wi⟩ v + let d2 := BandPackingShiftPotential ⟨wr, wi⟩ (v + ⟨0, 1⟩) - + BandPackingShiftPotential ⟨wr, wi⟩ v + let d : GaussianInt := ⟨d1, d2⟩ + (BandPackingShiftPotential ⟨wr, wi⟩ (v + 1 + ⟨0, 1⟩) = BandPackingShiftPotential ⟨wr, wi⟩ + v + d1 + d2 + wi) → (∀ (r : GaussianInt), (r ∈ (CurvatureOneOdometer z).domain) → + (BandPackingShiftPotential ⟨wr, wi⟩ (v + r) = wi * r.re * r.im + d.re * (v + r).re + + d.im * (v + r).im + BandPackingShiftPotential ⟨wr, wi⟩ v - d.re * v.re - d.im * + v.im)) ) := by + classical + intro z wr wi v d1 d2 d hcorner r hr + simp only [CurvatureOneOdometer, Finset.mem_insert, + Finset.mem_singleton] at hr + rcases hr with hr | hr | hr | hr + · subst r + simp [d, d1, d2] + ring + · subst r + simp [d, d1, d2] + ring + · subst r + simp [d, d1, d2] + ring + · subst r + rw [show v + (1 + ⟨0, 1⟩) = v + 1 + ⟨0, 1⟩ by abel, + hcorner] + simp [d, d1, d2] + ring + +private theorem hcurvAt595 : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (wr : ℤ), ∀ (wi : ℤ), ∀ (r : GaussianInt), (r ∈ + (CurvatureOneOdometer z).domain) → ((CurvatureOneOdometer (z + ⟨wr, wi⟩)).value r = + (CurvatureOneOdometer z).value r + wi * r.re * r.im) ) := by + classical + intro z wr wi r hr + simp only [CurvatureOneOdometer, Finset.mem_insert, + Finset.mem_singleton] at hr + rcases hr with hr | hr | hr | hr + · subst r + simp [CurvatureOneOdometer, Zsqrtd.ext_iff] + · subst r + simp [CurvatureOneOdometer, Zsqrtd.ext_iff] + · subst r + simp [CurvatureOneOdometer, Zsqrtd.ext_iff] + · subst r + simp [CurvatureOneOdometer, Zsqrtd.im_add] + + +private theorem hCAt611 : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (wr : ℤ), ∀ (wi : ℤ), BandPackingSymmetryCircleAction (.shift ⟨wr, + wi⟩) (1, 1 + 2 * z) = (1, 1 + 2 * (z + ⟨wr, wi⟩)) ) := by + classical + intro z wr wi + apply Prod.ext + · rfl + · simp [BandPackingSymmetryCircleAction] + ring + +private theorem hyk : + (by + classical + exact + ∀ (k : PartialOdometer), ∀ (wr : ℤ), ∀ (wi : ℤ), ∀ (y : GaussianInt), (y ∈ + (BandPackingSymmetryPartialOdometerAction (BandPackingSymmetry.shift (⟨wr, wi⟩ : + GaussianInt)) k).domain) → (y ∈ k.domain) ) := by + classical + intro k wr wi y hy + change y ∈ k.domain at hy + exact hy + +private theorem hcellAt653 : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells = {x}) → ((TileQuarterTurn U).cells = + {GaussianQuarterTurn x - 1}) ) := by + classical + intro U x hU + rw [(TileQuarterTurnFormulas U).1, hU] + simp + +private theorem hdomainAt657 : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ((↑k.domain : Set GaussianInt) = + FootprintVertices U) → (((BandPackingSymmetryPartialOdometerAction .negate k).domain + : Set GaussianInt) = FootprintVertices (TileQuarterTurn U)) ) := by + classical + intro U k hdom + rw [(BandPackingSymmetryPartialOdometerActionFormulas + .negate k k).1, (TileQuarterTurnFormulas U).2.2.2.2.2.1, + hdom] + simp [BandPackingSymmetryVectorAction] + +private theorem hdomainUnitAt664 : + (by + classical + exact + ∀ (z : GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + ∀ (r : GaussianInt), I - GaussianQuarterTurn r ∈ (CurvatureOneOdometer z).domain ↔ r ∈ + (CurvatureOneOdometer (-z - 1)).domain ) := by + classical + intro z I r + simp only [CurvatureOneOdometer, Finset.mem_insert, + Finset.mem_singleton] + constructor + · intro hr + rcases hr with hr | hr | hr | hr + all_goals + rcases r with ⟨rr, ri⟩ + simp [GaussianQuarterTurn, I, Zsqrtd.ext_iff] at hr ⊢ + omega + · intro hr + rcases hr with hr | hr | hr | hr + all_goals + rcases r with ⟨rr, ri⟩ + simp [GaussianQuarterTurn, I, Zsqrtd.ext_iff] at hr ⊢ + omega + +private theorem hunitValueAt682 : + (by + classical + exact + ∀ (z : GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + ∀ (r : GaussianInt), (r ∈ (CurvatureOneOdometer z).domain) → ((CurvatureOneOdometer + z).value (I - GaussianQuarterTurn r) = (CurvatureOneOdometer (-z - 1)).value r + z.im + * r.im) ) := by + classical + intro z I r hr + simp only [CurvatureOneOdometer, Finset.mem_insert, + Finset.mem_singleton] at hr + rcases hr with hr | hr | hr | hr + all_goals + rcases r with ⟨rr, ri⟩ + simp [CurvatureOneOdometer, GaussianQuarterTurn, I, + Zsqrtd.ext_iff] at hr ⊢ + simp [hr] + +private theorem hinverseAt694 : + (by + classical + exact + ∀ (v : GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let vn := GaussianQuarterTurn v - 1 + ∀ (y : GaussianInt), -GaussianQuarterTurn y - v = I - GaussianQuarterTurn (y - vn) ) := by + classical + intro v I vn y + dsimp [vn, I] + ext <;> simp [GaussianQuarterTurn]; ring + +private theorem himageAt698 : + (by + classical + exact + ∀ (k : PartialOdometer), ∀ (y : GaussianInt), y ∈ k.domain.image GaussianQuarterTurn ↔ + -GaussianQuarterTurn y ∈ k.domain ) := by + classical + intro k y + simp only [Finset.mem_image] + constructor + · rintro ⟨x0, hx0, hxy⟩ + have he : -GaussianQuarterTurn y = x0 := by + rw [← hxy] + ext <;> simp [GaussianQuarterTurn] + simpa [he] using hx0 + · intro hy + refine ⟨-GaussianQuarterTurn y, hy, ?_⟩ + ext <;> simp [GaussianQuarterTurn] + +private theorem htrans'At711 : + (by + classical + exact + ∀ (k : PartialOdometer), ∀ (z : GaussianInt), ∀ (v : GaussianInt), ∀ (a0 : GaussianInt), + ∀ (b0 : ℤ), (∀ (x : GaussianInt), x ∈ k.domain ↔ x - v ∈ (CurvatureOneOdometer + z).domain) → ((∀ x ∈ k.domain, k.value x = (CurvatureOneOdometer z).value (x - v) + + a0.re * x.re + a0.im * x.im + b0) → ( + let I : GaussianInt := ⟨0, 1⟩ + let vn := GaussianQuarterTurn v - 1 + (∀ (r : GaussianInt), I - GaussianQuarterTurn r ∈ (CurvatureOneOdometer z).domain ↔ r ∈ + (CurvatureOneOdometer (-z - 1)).domain) → ((∀ (r : GaussianInt), (r ∈ + (CurvatureOneOdometer z).domain) → ((CurvatureOneOdometer z).value (I - + GaussianQuarterTurn r) = (CurvatureOneOdometer (-z - 1)).value r + z.im * r.im)) → + ((∀ (y : GaussianInt), -GaussianQuarterTurn y - v = I - GaussianQuarterTurn (y - vn)) + → ((∀ (y : GaussianInt), y ∈ k.domain.image GaussianQuarterTurn ↔ + -GaussianQuarterTurn y ∈ k.domain) → (OdometerTranslation + (BandPackingSymmetryPartialOdometerAction .negate k) (CurvatureOneOdometer (-z - + 1)))))))) ) := by + classical + intro k z v a0 b0 hvdom hvval I vn hdomainUnit hunitValue hinverse himage + let an := GaussianQuarterTurn a0 + ⟨0, z.im⟩ + let bn := b0 - z.im * vn.im + refine ⟨vn, an, bn, ?_, ?_⟩ + · intro y + change y ∈ k.domain.image GaussianQuarterTurn ↔ + y - vn ∈ (CurvatureOneOdometer (-z - 1)).domain + rw [himage, hvdom, hinverse] + exact hdomainUnit (y - vn) + · intro y hy + have hyold : -GaussianQuarterTurn y ∈ k.domain := + (himage y).mp hy + have hrTarget : y - vn ∈ + (CurvatureOneOdometer (-z - 1)).domain := by + have h := (hvdom (-GaussianQuarterTurn y)).mp hyold + rw [hinverse] at h + exact (hdomainUnit (y - vn)).mp h + have hr : y - vn ∈ (CurvatureOneOdometer z).domain := by + simpa [CurvatureOneOdometer] using hrTarget + have hval := hvval (-GaussianQuarterTurn y) hyold + have hcanon := hunitValue (y - vn) hr + have hact := (BandPackingSymmetryPartialOdometerActionFormulas + .negate k k).2.2.2.1 y hy + rw [hact, hval, hinverse, hcanon] + dsimp [an, bn, vn] + simp [GaussianQuarterTurn] + ring + +private theorem hCAt738 : + (by + classical + exact + ∀ (z : GaussianInt), BandPackingSymmetryCircleAction .negate (1, 1 + 2 * z) = (1, 1 + 2 * + (-z - 1)) ) := by + classical + intro z + ext <;> simp [BandPackingSymmetryCircleAction]; ring + +private theorem hcellAt753 : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells = {x}) → ((BandPackingSymmetryTileAction + .conjugate U).cells = {-GaussianReflection x - 1}) ) := by + classical + intro U x hU + simp only [BandPackingSymmetryTileAction] + rw [(TileQuarterTurnFormulas + (TileQuarterTurn (TileReflection U))).1, + (TileQuarterTurnFormulas (TileReflection U)).1, + (TileReflectionFormulas U).1, hU] + simp [GaussianQuarterTurn, GaussianReflection, + Finset.image_singleton, Zsqrtd.ext_iff] + +private theorem hdomainAt763 : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ((↑k.domain : Set GaussianInt) = + FootprintVertices U) → (((BandPackingSymmetryPartialOdometerAction .conjugate + k).domain : Set GaussianInt) = FootprintVertices (BandPackingSymmetryTileAction + .conjugate U)) ) := by + classical + intro U k hdom + rw [(BandPackingSymmetryPartialOdometerActionFormulas + .conjugate k k).1] + change (fun y => -GaussianReflection y) '' (k.domain : Set GaussianInt) = + FootprintVertices (TileQuarterTurn + (TileQuarterTurn (TileReflection U))) + rw [(TileQuarterTurnFormulas + (TileQuarterTurn (TileReflection U))).2.2.2.2.2.1, + (TileQuarterTurnFormulas (TileReflection U)).2.2.2.2.2.1, + (TileReflectionFormulas U).2.2.2.2.2.1, hdom] + rw [Set.image_image, Set.image_image] + ext y + simp only [Set.mem_image] + constructor + · rintro ⟨x, hx, rfl⟩ + exact ⟨x, hx, by + ext <;> simp [GaussianQuarterTurn, GaussianReflection] ⟩ + · rintro ⟨x, hx, hxy⟩ + refine ⟨x, hx, ?_⟩ + rw [← hxy] + ext <;> simp [GaussianQuarterTurn, GaussianReflection] + +private theorem hdomainUnitAt787 : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (r : GaussianInt), 1 - GaussianReflection r ∈ + (CurvatureOneOdometer z).domain ↔ r ∈ (CurvatureOneOdometer (GaussianReflection + z)).domain ) := by + classical + intro z r + simp only [CurvatureOneOdometer, Finset.mem_insert, + Finset.mem_singleton] + constructor + · intro hr + rcases hr with hr | hr | hr | hr + all_goals + rcases r with ⟨rr, ri⟩ + simp [GaussianReflection, Zsqrtd.ext_iff] at hr ⊢ + omega + · intro hr + rcases hr with hr | hr | hr | hr + all_goals + rcases r with ⟨rr, ri⟩ + simp [GaussianReflection, Zsqrtd.ext_iff] at hr ⊢ + omega + +private theorem hunitValueAt805 : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (r : GaussianInt), (r ∈ (CurvatureOneOdometer z).domain) → + ((CurvatureOneOdometer z).value (1 - GaussianReflection r) = (CurvatureOneOdometer + (GaussianReflection z)).value r + z.im * r.im) ) := by + classical + intro z r hr + simp only [CurvatureOneOdometer, Finset.mem_insert, + Finset.mem_singleton] at hr + rcases hr with hr | hr | hr | hr + all_goals + rcases r with ⟨rr, ri⟩ + simp [CurvatureOneOdometer, GaussianReflection, + Zsqrtd.ext_iff] at hr ⊢ + simp [hr] + +private theorem hinverseAt818 : + (by + classical + exact + ∀ (v : GaussianInt), + let vk := -GaussianReflection v - 1 + ∀ (y : GaussianInt), -GaussianReflection y - v = 1 - GaussianReflection (y - vk) ) := by + classical + intro v vk y + dsimp [vk] + ext <;> simp [GaussianReflection]; ring + +private theorem himageAt823 : + (by + classical + exact + ∀ (k : PartialOdometer), ∀ (y : GaussianInt), y ∈ k.domain.image (fun x => + -GaussianReflection x) ↔ -GaussianReflection y ∈ k.domain ) := by + classical + intro k y + simp only [Finset.mem_image] + constructor + · rintro ⟨x0, hx0, hxy⟩ + have he : -GaussianReflection y = x0 := by + rw [← hxy] + ext <;> simp [GaussianReflection] + simpa [he] using hx0 + · intro hy + refine ⟨-GaussianReflection y, hy, ?_⟩ + ext <;> simp [GaussianReflection] + +private theorem htrans'At836 : + (by + classical + exact + ∀ (k : PartialOdometer), ∀ (z : GaussianInt), ∀ (v : GaussianInt), ∀ (a0 : GaussianInt), + ∀ (b0 : ℤ), (∀ (x : GaussianInt), x ∈ k.domain ↔ x - v ∈ (CurvatureOneOdometer + z).domain) → ((∀ x ∈ k.domain, k.value x = (CurvatureOneOdometer z).value (x - v) + + a0.re * x.re + a0.im * x.im + b0) → ( + let vk := -GaussianReflection v - 1 + (∀ (r : GaussianInt), 1 - GaussianReflection r ∈ (CurvatureOneOdometer z).domain ↔ r ∈ + (CurvatureOneOdometer (GaussianReflection z)).domain) → ((∀ (r : GaussianInt), (r ∈ + (CurvatureOneOdometer z).domain) → ((CurvatureOneOdometer z).value (1 - + GaussianReflection r) = (CurvatureOneOdometer (GaussianReflection z)).value r + z.im + * r.im)) → ((∀ (y : GaussianInt), -GaussianReflection y - v = 1 - GaussianReflection + (y - vk)) → ((∀ (y : GaussianInt), y ∈ k.domain.image (fun x => -GaussianReflection + x) ↔ -GaussianReflection y ∈ k.domain) → (OdometerTranslation + (BandPackingSymmetryPartialOdometerAction .conjugate k) (CurvatureOneOdometer + (GaussianReflection z)))))))) ) := by + classical + intro k z v a0 b0 hvdom hvval vk hdomainUnit hunitValue hinverse himage + let ak := -GaussianReflection a0 + ⟨0, z.im⟩ + let bk := b0 - z.im * vk.im + refine ⟨vk, ak, bk, ?_, ?_⟩ + · intro y + change y ∈ k.domain.image (fun x => -GaussianReflection x) ↔ + y - vk ∈ + (CurvatureOneOdometer (GaussianReflection z)).domain + rw [himage, hvdom, hinverse] + exact hdomainUnit (y - vk) + · intro y hy + have hyold : -GaussianReflection y ∈ k.domain := + (himage y).mp hy + have hrTarget : y - vk ∈ + (CurvatureOneOdometer (GaussianReflection z)).domain := by + have h := (hvdom (-GaussianReflection y)).mp hyold + rw [hinverse] at h + exact (hdomainUnit (y - vk)).mp h + have hr : y - vk ∈ (CurvatureOneOdometer z).domain := by + simpa [CurvatureOneOdometer] using hrTarget + have hval := hvval (-GaussianReflection y) hyold + have hcanon := hunitValue (y - vk) hr + have hact := (BandPackingSymmetryPartialOdometerActionFormulas + .conjugate k k).2.2.2.2.1 y hy + rw [hact, hval, hinverse, hcanon] + dsimp [ak, bk, vk] + simp [GaussianReflection] + ring + +private theorem hCAt864 : + (by + classical + exact + ∀ (z : GaussianInt), BandPackingSymmetryCircleAction .conjugate (1, 1 + 2 * z) = (1, 1 + + 2 * GaussianReflection z) ) := by + classical + intro z + ext <;> simp [BandPackingSymmetryCircleAction, + GaussianReflection] + +private theorem hocc : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s + : Bool), TileOdometer (q i.succ) (S i s) (hs i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), FootprintVertices (S i s) ⊆ FootprintVertices U) → ((∀ (i : Fin (3 : ℕ)), ∀ (s + : Bool), TileCentroid (S i s) - TileCentroid U = (if s = true then (1 : ℝ) else (-1 : + ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).1))) → (∀ i, ∀ s, BandSubtileOccurrence q U i s (S i s)))) ) := by + classical + intro U q S hs hsub hfoot hcentroid i s + exact ⟨TileOdometerBandPrototile (q i.succ) (S i s) (hs i s) + (hsub i s), hfoot i s, hcentroid i s⟩ + +private theorem hparentAt910 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (a : BandPackingSymmetry), + let Q := BandPackingSymmetryQuadrupleAction + let A := BandPackingSymmetryCircleAction + let q' := Q a q + let sigma : Fin 3 → Fin 3 := fun i => + if BandPackingSymmetryReversesOrientation a then -i else i + (-(1 : Fin 3) = 2) → ((-(2 : Fin 3) = 1) → (∀ (i : Fin 3), q' (sigma i).succ = A a (q + i.succ))) ) := by + classical + intro q a Q A q' sigma hneg1 hneg2 i + dsimp [q', sigma, Q, A] + cases hrev : BandPackingSymmetryReversesOrientation a <;> + fin_cases i <;> + simp [BandPackingSymmetryQuadrupleAction, hrev, hneg1, hneg2] + +private theorem hT' : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (BandPrototile (q (0 : Fin (4 + : ℕ))) U) → (∀ (a : BandPackingSymmetry), + let Q := BandPackingSymmetryQuadrupleAction + let B := BandPackingSymmetryTileAction + let q' := Q a q + ((∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction a C).1 = C.1) ∧ (∀ (C : + CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T ↔ BandPrototile + (BandPackingSymmetryCircleAction a C) (BandPackingSymmetryTileAction a T)) ∧ ∀ (q : + Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ProperBandQuadruple q → BandPrototile (q (0 : Fin (4 : ℕ))) T → (∀ (i : + Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : + LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → + let sigma := fun (i : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation a = true + then -i else i; ∃ (negative : Bool) (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool) (S' + : Fin (3 : ℕ) → Bool → ProtoTile), BandPackingSymmetryScopedPhase a q negative ∧ (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) + = (sigma i, s ^^ negative)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : + ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × + Bool) (i, s)).2 = BandPackingSymmetryTileAction a (S i s)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction a q) + (BandPackingSymmetryTileAction a T) i s (S' i s)) ∧ ∀ (x : LatticeCell), x ∈ + (BandPackingSymmetryTileAction a T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S' i + s).cells) → (BandPrototile (q' 0) (B a U))) ) := by + classical + intro U q hT a Q B q' cov + let sigma : Fin 3 → Fin 3 := fun i => + if BandPackingSymmetryReversesOrientation a then -i else i + have ht := cov.2.1 (q 0) U + have ht' := ht.mp hT + simpa [q', Q, B, BandPackingSymmetryQuadrupleAction] using ht' + +private theorem hsub' : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs : + Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + TileOdometer (q i.succ) (S i s) (hs i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (a + : BandPackingSymmetry), TileOdometer (BandPackingSymmetryCircleAction a (q i.succ)) + (BandPackingSymmetryTileAction a (S i s)) (BandPackingSymmetryPartialOdometerAction a + (hs i s))) → (∀ (a : BandPackingSymmetry), + let Q := BandPackingSymmetryQuadrupleAction + let A := BandPackingSymmetryCircleAction + let P := BandPackingSymmetryPartialOdometerAction + let q' := Q a q + let sigma : Fin 3 → Fin 3 := fun i => + if BandPackingSymmetryReversesOrientation a then -i else i + ∀ (delta : Bool), ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (S' : Fin (3 : ℕ) → + Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin + (3 : ℕ) × Bool) (i, s) = ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation a = true then -i else i) i, s ^^ delta)) → ((∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) + (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).2 = + BandPackingSymmetryTileAction a (S i s)) → ((∀ (i : Fin 3), q' (sigma i).succ = A a + (q i.succ)) → ( + let hs' : Fin 3 → Bool → PartialOdometer := fun j s => + P a (hs (e.symm (j, s)).1 (e.symm (j, s)).2) + ∀ j, ∀ s, TileOdometer (q' j.succ) (S' j s) (hs' j s)))))) ) := by + classical + intro q S hs hsub ih a Q A P q' sigma delta e S' he hS hparent hs' j s + let B := BandPackingSymmetryTileAction + let p := e.symm (j, s) + have hep : e p = (j, s) := e.apply_symm_apply (j, s) + have hchildT : S' j s = B a (S p.1 p.2) := by + have hh := hS p.1 p.2 + simpa [p, hep] using hh + have hchildC : q' j.succ = A a (q p.1.succ) := by + have := hparent p.1 + have hpair : (sigma p.1, xor p.2 delta) = (j, s) := by + calc + (sigma p.1, xor p.2 delta) = e p := by + simpa [p] using (he p.1 p.2).symm + _ = (j, s) := hep + have hidx : sigma p.1 = j := congrArg Prod.fst hpair + simpa [p, hidx] using this + rw [hchildT, hchildC] + exact ih p.1 p.2 a + +private theorem hdom' : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (x : + GaussianInt), x ∈ h.domain ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (hs i s).domain) → + (∀ (a : BandPackingSymmetry), + let P := BandPackingSymmetryPartialOdometerAction + ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), + let hs' : Fin 3 → Bool → PartialOdometer := fun j s => + P a (hs (e.symm (j, s)).1 (e.symm (j, s)).2) + ∀ y, y ∈ (P a h).domain ↔ ∃ j s, y ∈ (hs' j s).domain) ) := by + classical + intro h hs hdom a P e hs' y + change y ∈ ((P a h).domain : Set GaussianInt) ↔ _ + rw [(BandPackingSymmetryPartialOdometerActionFormulas a h h).1] + constructor + · rintro ⟨x, hx, rfl⟩ + rcases (hdom x).mp hx with ⟨i, s, hxs⟩ + refine ⟨(e (i, s)).1, (e (i, s)).2, ?_⟩ + change BandPackingSymmetryVectorAction a x ∈ + ((P a (hs (e.symm ((e (i, s)).1, (e (i, s)).2)).1 + (e.symm ((e (i, s)).1, (e (i, s)).2)).2)).domain : Set GaussianInt) + rw [e.symm_apply_apply] + rw [(BandPackingSymmetryPartialOdometerActionFormulas a + (hs i s) (hs i s)).1] + exact ⟨x, hxs, rfl⟩ + · rintro ⟨j, s, hy⟩ + let p := e.symm (j, s) + have hp : e p = (j, s) := e.apply_symm_apply (j, s) + change y ∈ ((P a (hs p.1 p.2)).domain : Set GaussianInt) at hy + rw [(BandPackingSymmetryPartialOdometerActionFormulas a + (hs p.1 p.2) (hs p.1 p.2)).1] at hy + obtain ⟨x, hx, rfl⟩ := hy + refine ⟨x, (hdom x).mpr ⟨p.1, p.2, hx⟩, rfl⟩ + +private theorem hvalue' : + (by + classical + exact + ∀ (h : PartialOdometer), (∀ (a : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ (l : + PartialOdometer), ∀ (x : GaussianInt), (x ∈ k.domain) → ((x ∈ l.domain) → + ((BandPackingSymmetryPartialOdometerAction a l).value + (BandPackingSymmetryVectorAction a x) - (BandPackingSymmetryPartialOdometerAction a + k).value (BandPackingSymmetryVectorAction a x) = l.value x - k.value x))) → (∀ (hs : + Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (x : GaussianInt), x ∈ h.domain ↔ ∃ (i : + Fin (3 : ℕ)) (s : Bool), x ∈ (hs i s).domain) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + ∀ x ∈ (hs i s).domain, h.value x = (hs i s).value x) → (∀ (a : BandPackingSymmetry), + let P := BandPackingSymmetryPartialOdometerAction + ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), + let hs' : Fin 3 → Bool → PartialOdometer := fun j s => + P a (hs (e.symm (j, s)).1 (e.symm (j, s)).2) + ∀ j, ∀ s, ∀ y, y ∈ (hs' j s).domain → (P a h).value y = (hs' j s).value y))) ) := by + classical + intro h actionDiff hs hdom hvalue a P e hs' j s y hy + let p := e.symm (j, s) + change y ∈ ((P a (hs p.1 p.2)).domain : Set GaussianInt) at hy + rw [(BandPackingSymmetryPartialOdometerActionFormulas a + (hs p.1 p.2) (hs p.1 p.2)).1] at hy + obtain ⟨x, hx, rfl⟩ := hy + have hxOuter : x ∈ h.domain := (hdom x).mpr ⟨p.1, p.2, hx⟩ + have hd := actionDiff a h (hs p.1 p.2) x hxOuter hx + rw [hvalue p.1 p.2 x hx] at hd + simp? at hd + exact (sub_eq_zero.mp hd).symm + +private theorem hcompat' : + (by + classical + exact + ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : + Fin (3 : ℕ)), ∀ (t : Bool), OdometerCompatibility (hs i s) (hs j t)) → (∀ (a : + BandPackingSymmetry), + let P := BandPackingSymmetryPartialOdometerAction + ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), + let hs' : Fin 3 → Bool → PartialOdometer := fun j s => + P a (hs (e.symm (j, s)).1 (e.symm (j, s)).2) + ∀ i, ∀ s, ∀ j, ∀ t, OdometerCompatibility (hs' i s) (hs' j t)) ) := by + classical + intro hs hcompat a P e hs' i s j t + let p := e.symm (i, s) + let r := e.symm (j, t) + apply (BandPackingSymmetryPartialOdometerActionFormulas a + (hs p.1 p.2) (hs r.1 r.2)).2.2.2.2.2.2.1.mpr + exact hcompat p.1 p.2 r.1 r.2 + +private theorem hpairAt1015 : + (by + classical + exact + ∀ (a : BandPackingSymmetry), + let sigma : Fin 3 → Fin 3 := fun i => + if BandPackingSymmetryReversesOrientation a then -i else i + ∀ (delta : Bool), ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) = ((fun (i : Fin + (3 : ℕ)) => if BandPackingSymmetryReversesOrientation a = true then -i else i) i, s + ^^ delta)) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + let p := e.symm (i, s) + (e p = (i, s)) → ((sigma p.1, xor p.2 delta) = (i, s))) ) := by + classical + intro a sigma delta e he i s p hep + calc + (sigma p.1, xor p.2 delta) = e p := by + simpa [p] using (he p.1 p.2).symm + _ = (i, s) := hep + +private theorem hcurvAt1021 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (a : BandPackingSymmetry), + let Q := BandPackingSymmetryQuadrupleAction + let A := BandPackingSymmetryCircleAction + let q' := Q a q + let sigma : Fin 3 → Fin 3 := fun i => + if BandPackingSymmetryReversesOrientation a then -i else i + ((∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction a C).1 = C.1) ∧ (∀ (C : + CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T ↔ BandPrototile + (BandPackingSymmetryCircleAction a C) (BandPackingSymmetryTileAction a T)) ∧ ∀ (q : + Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ProperBandQuadruple q → BandPrototile (q (0 : Fin (4 : ℕ))) T → (∀ (i : + Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : + LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → + let sigma := fun (i : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation a = true + then -i else i; ∃ (negative : Bool) (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool) (S' + : Fin (3 : ℕ) → Bool → ProtoTile), BandPackingSymmetryScopedPhase a q negative ∧ (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) + = (sigma i, s ^^ negative)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : + ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × + Bool) (i, s)).2 = BandPackingSymmetryTileAction a (S i s)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction a q) + (BandPackingSymmetryTileAction a T) i s (S' i s)) ∧ ∀ (x : LatticeCell), x ∈ + (BandPackingSymmetryTileAction a T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S' i + s).cells) → (∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), (∀ (i : Fin 3), q' + (sigma i).succ = A a (q i.succ)) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + let p := e.symm (i, s) + (sigma p.1 = i) → ((q' i.succ).1 = (q p.1.succ).1))) ) := by + classical + intro q a Q A q' sigma cov e hparent i s p hidx + calc + (q' i.succ).1 = (q' (sigma p.1).succ).1 := by rw [hidx] + _ = (A a (q p.1.succ)).1 := by rw [hparent] + _ = (q p.1.succ).1 := cov.1 _ + +private theorem hchildCurvPos : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → ((BandPackingSymmetry) + → (∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + let p := e.symm (i, s) + (¬(q p.1.succ).1 = (0 : ℤ)) → (0 < (q p.1.succ).1))) ) := by + classical + intro q hq a e i s p hz + have hn := (ProperBandCurvatureStructure q hq).2.1 p.1 + omega + +private theorem hout : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (U : ProtoTile), ∀ (a : BandPackingSymmetry), + let P := BandPackingSymmetryPartialOdometerAction + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction a h) = Option.map + (BandPackingSymmetrySlopeAction a U) (PartialOdometerSlope h)) → (∀ (p₀ : ℝ × ℝ), + (PartialOdometerSlope h = some p₀) → (PartialOdometerSlope (P a h) = some + (BandPackingSymmetrySlopeAction a U p₀))) ) := by + classical + intro h U a P houterSlope p₀ hp₀ + rw [houterSlope, hp₀] + rfl + +private theorem hchild : + (by + classical + exact + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ + (a : BandPackingSymmetry), + let P := BandPackingSymmetryPartialOdometerAction + ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + let p := e.symm (i, s) + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction a (hs p.1 p.2)) = + Option.map (BandPackingSymmetrySlopeAction a (S p.1 p.2)) (PartialOdometerSlope (hs + p.1 p.2))) → (∀ (pᵢ : ℝ × ℝ), (PartialOdometerSlope (hs p.1 p.2) = some pᵢ) → + (PartialOdometerSlope (P a (hs p.1 p.2)) = some (BandPackingSymmetrySlopeAction a (S + p.1 p.2) pᵢ))) ) := by + classical + intro S hs a P e i s p hchildSlope pᵢ hpᵢ + rw [hchildSlope, hpᵢ] + rfl + +private theorem hvecTarget : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (a : BandPackingSymmetry), + let Q := BandPackingSymmetryQuadrupleAction + let q' := Q a q + let sigma : Fin 3 → Fin 3 := fun i => + if BandPackingSymmetryReversesOrientation a then -i else i + ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (negative : Bool), (∀ (i : Fin (3 : ℕ)), + let e := if negative = true then (-1 : GaussianInt) else (1 : GaussianInt); + let incoming := BandPackingSymmetryAffineVectorAction a (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); + let cyclic := BandPackingSymmetryAffineVectorAction a (BandVectors.1 (q (i + (2 : Fin (3 + : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 + (BandPackingSymmetryQuadrupleAction a q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation a = true then -i else i) i).succ) + (BandPackingSymmetryQuadrupleAction a q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ + BandVectors.2 (BandPackingSymmetryQuadrupleAction a q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation a = true then -i else i) i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction a q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation a = true then -i else i) i + (1 : Fin (3 : + ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation a = true then + -GaussianQuarterTurn cyclic.2 else cyclic.2) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + let p := e.symm (i, s) + (sigma p.1 + 2 = i + 2) → ((sigma p.1 + 1 = i + 1) → (BandVectors.2 (q' ((i + 2).succ)) + (q' ((i + 1).succ)) = (if negative then (-1 : GaussianInt) else 1) * (if + BandPackingSymmetryReversesOrientation a then -GaussianQuarterTurn + (BandPackingSymmetryAffineVectorAction a (BandVectors.1 (q ((p.1 + 2).succ)) (q ((p.1 + + 1).succ)), BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)))).2 else + (BandPackingSymmetryAffineVectorAction a (BandVectors.1 (q ((p.1 + 2).succ)) (q ((p.1 + + 1).succ)), BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)))).2)))) ) := by + classical + intro q a Q q' sigma e negative hvecAffine i s p hidx2 hidx1 + have hv := (hvecAffine p.1).2 + change BandVectors.2 (Q a q ((i + 2).succ)) (Q a q ((i + 1).succ)) = _ + rw [← hidx2, ← hidx1] + exact hv + +private theorem hsign : + (by + classical + exact + ∀ (a : BandPackingSymmetry), + let sigma : Fin 3 → Fin 3 := fun i => + if BandPackingSymmetryReversesOrientation a then -i else i + ∀ (delta : Bool), ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (negative : Bool), + (negative = delta) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + let p := e.symm (i, s) + ((sigma p.1, xor p.2 delta) = (i, s)) → ((if s = true then (1 : ℝ) else -1) = (if p.2 = + true then (1 : ℝ) else -1) * (if negative then (-1 : ℝ) else 1))) ) := by + classical + intro a sigma delta e negative hphaseEq i s p hpair + have hb := congrArg Prod.snd hpair + rw [← hphaseEq] at hb + cases hp : p.2 <;> cases hn : negative + all_goals + have hb' : s = xor p.2 negative := by + simpa [hp, hn] using hb.symm + simp [hp, hn, hb'] + +private theorem hc1At1079 : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), + let p := e.symm (i, s) + (TileCentroid (S p.1 p.2) - TileCentroid U = (if p.2 = true then (1 : ℝ) else (-1 : ℝ)) • + (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (p.1 + (2 : Fin (3 : ℕ))).succ) (q + (p.1 + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (p.1 + (2 : + Fin (3 : ℕ))).succ) (q (p.1 + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint + (BandVectors.1 (q (p.1 + (2 : Fin (3 : ℕ))).succ) (q (p.1 + (1 : Fin (3 : + ℕ))).succ))).1))) → ((TileCentroid (S p.1 p.2)).1 - (TileCentroid U).1 = (if p.2 = + true then (1 : ℝ) else -1) * (((GaussianInt.toComplex (BandVectors.1 (q ((p.1 + + 2).succ)) (q ((p.1 + 1).succ)))).re + (GaussianInt.toComplex (BandVectors.1 (q ((p.1 + + 2).succ)) (q ((p.1 + 1).succ)))).im) / 2)) ) := by + classical + intro U q S e i s p hc + have h := congrArg Prod.fst hc + cases hp : p.2 <;> simp [hp, GaussianRealPoint, smul_eq_mul] at h ⊢ + · ring_nf at h ⊢; exact h + · ring_nf at h ⊢; exact h + +private theorem hc2At1089 : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), + let p := e.symm (i, s) + (TileCentroid (S p.1 p.2) - TileCentroid U = (if p.2 = true then (1 : ℝ) else (-1 : ℝ)) • + (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (p.1 + (2 : Fin (3 : ℕ))).succ) (q + (p.1 + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (p.1 + (2 : + Fin (3 : ℕ))).succ) (q (p.1 + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint + (BandVectors.1 (q (p.1 + (2 : Fin (3 : ℕ))).succ) (q (p.1 + (1 : Fin (3 : + ℕ))).succ))).1))) → ((TileCentroid (S p.1 p.2)).2 - (TileCentroid U).2 = (if p.2 = + true then (1 : ℝ) else -1) * (((GaussianInt.toComplex (BandVectors.1 (q ((p.1 + + 2).succ)) (q ((p.1 + 1).succ)))).im - (GaussianInt.toComplex (BandVectors.1 (q ((p.1 + + 2).succ)) (q ((p.1 + 1).succ)))).re) / 2)) ) := by + classical + intro U q S e i s p hc + have h := congrArg Prod.snd hc + cases hp : p.2 <;> simp [hp, GaussianRealPoint, smul_eq_mul] at h ⊢ + · ring_nf at h ⊢; exact h + · ring_nf at h ⊢; exact h + +private theorem hcentMix : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), + let p := e.symm (i, s) + (TileCentroid (S p.1 p.2) - TileCentroid U = (if p.2 = true then (1 : ℝ) else (-1 : ℝ)) • + (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (p.1 + (2 : Fin (3 : ℕ))).succ) (q + (p.1 + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (p.1 + (2 : + Fin (3 : ℕ))).succ) (q (p.1 + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint + (BandVectors.1 (q (p.1 + (2 : Fin (3 : ℕ))).succ) (q (p.1 + (1 : Fin (3 : + ℕ))).succ))).1))) → ( + let v0 := BandVectors.1 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) + let vmix := v0 - GaussianQuarterTurn v0 + let scale : ℝ := (if p.2 = true then (1 : ℝ) else -1) * (1 / 2) + TileCentroid (S p.1 p.2) - TileCentroid U = scale • GaussianRealPoint vmix) ) := by + classical + intro U q S e i s p hc v0 vmix scale + cases hp : p.2 <;> + simpa [v0, vmix, scale, GaussianRealPoint, GaussianQuarterTurn, + smul_eq_mul, hp] using hc + +private theorem hslopeMix : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), + ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + let p := e.symm (i, s) + ∀ (p₀ : ℝ × ℝ), ∀ (pᵢ : ℝ × ℝ), (pᵢ.1 - p₀.1 = (if p.2 = true then (1 : ℝ) else (-1 : ℝ)) + * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (p.1 + (2 : Fin (3 : ℕ))).succ) (q (p.1 + (1 : + Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (p.1 + (2 : Fin (3 : ℕ))).succ) (q + (p.1 + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((pᵢ.2 - p₀.2 = (if p.2 = true then (1 : + ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (p.1 + (2 : Fin (3 : + ℕ))).succ) (q (p.1 + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (p.1 + + (2 : Fin (3 : ℕ))).succ) (q (p.1 + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ( + let u0 := BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) + let umix := u0 + GaussianQuarterTurn u0 + let scale : ℝ := (if p.2 = true then (1 : ℝ) else -1) * (1 / 2) + pᵢ - p₀ = scale • GaussianRealPoint umix)) ) := by + classical + intro q e i s p p₀ pᵢ hdx hdy u0 umix scale + apply Prod.ext + · cases hp : p.2 + · have hh := hdx + rw [GaussianInt.intCast_re + (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ))), + GaussianInt.intCast_im + (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)))] at hh + simp? [u0, umix, scale, GaussianRealPoint, + GaussianQuarterTurn, smul_eq_mul, hp] at hh ⊢ + exact hh + · have hh := hdx + rw [GaussianInt.intCast_re + (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ))), + GaussianInt.intCast_im + (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)))] at hh + simp? [u0, umix, scale, GaussianRealPoint, + GaussianQuarterTurn, smul_eq_mul, hp] at hh ⊢ + exact hh + · cases hp : p.2 + · have hh := hdy + rw [GaussianInt.intCast_re + (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ))), + GaussianInt.intCast_im + (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)))] at hh + simp? [u0, umix, scale, GaussianRealPoint, + GaussianQuarterTurn, smul_eq_mul, hp] at hh ⊢ + exact hh + · have hh := hdy + rw [GaussianInt.intCast_re + (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ))), + GaussianInt.intCast_im + (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)))] at hh + simp? [u0, umix, scale, GaussianRealPoint, + GaussianQuarterTurn, smul_eq_mul, hp] at hh ⊢ + exact hh + +private theorem hmix' : + (by + classical + exact + let symmetryMix : Bool → GaussianInt × GaussianInt → GaussianInt × GaussianInt := + fun r z => if r then + (z.1 + GaussianQuarterTurn z.1, z.2 - GaussianQuarterTurn z.2) + else (z.1 - GaussianQuarterTurn z.1, z.2 + GaussianQuarterTurn z.2) + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (a : BandPackingSymmetry), ∀ (e : Fin (3 : ℕ) + × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + let p := e.symm (i, s) + let v0 := BandVectors.1 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) + let u0 := BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) + ((BandPackingSymmetryAffineVectorAction a (symmetryMix false (v0, u0))).2 = (symmetryMix + (false ^^ BandPackingSymmetryReversesOrientation a) + (BandPackingSymmetryAffineVectorAction a (v0, u0))).2) → + ((BandPackingSymmetryAffineVectorAction a (symmetryMix false (v0, u0))).2 = (if + BandPackingSymmetryReversesOrientation a then (BandPackingSymmetryAffineVectorAction + a (v0, u0)).2 - GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction a (v0, + u0)).2 else (BandPackingSymmetryAffineVectorAction a (v0, u0)).2 + + GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction a (v0, u0)).2)) ) := by + classical + intro symmetryMix q a e i s p v0 u0 hmix + cases hr : BandPackingSymmetryReversesOrientation a <;> + simpa [symmetryMix, hr] using hmix + +private theorem hsum : + (by + classical + exact + let symmetryMix : Bool → GaussianInt × GaussianInt → GaussianInt × GaussianInt := + fun r z => if r then + (z.1 + GaussianQuarterTurn z.1, z.2 - GaussianQuarterTurn z.2) + else (z.1 - GaussianQuarterTurn z.1, z.2 + GaussianQuarterTurn z.2) + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (a : BandPackingSymmetry), + let Q := BandPackingSymmetryQuadrupleAction + let q' := Q a q + ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (negative : Bool), ∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), + let p := e.symm (i, s) + (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ)) = (if negative then (-1 : + GaussianInt) else 1) * (if BandPackingSymmetryReversesOrientation a then + -GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction a (BandVectors.1 (q ((p.1 + + 2).succ)) (q ((p.1 + 1).succ)), BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + + 1).succ)))).2 else (BandPackingSymmetryAffineVectorAction a (BandVectors.1 (q ((p.1 + + 2).succ)) (q ((p.1 + 1).succ)), BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + + 1).succ)))).2)) → ( + let v0 := BandVectors.1 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) + let u0 := BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) + ((BandPackingSymmetryAffineVectorAction a (symmetryMix false (v0, u0))).2 = (if + BandPackingSymmetryReversesOrientation a then (BandPackingSymmetryAffineVectorAction + a (v0, u0)).2 - GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction a (v0, + u0)).2 else (BandPackingSymmetryAffineVectorAction a (v0, u0)).2 + + GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction a (v0, u0)).2)) → + (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ)) + GaussianQuarterTurn + (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ))) = (if negative then (-1 : + GaussianInt) else 1) * (BandPackingSymmetryAffineVectorAction a (symmetryMix false + (v0, u0))).2)) ) := by + classical + intro symmetryMix q a Q q' e negative i s p hvecTarget v0 u0 hmix' + rw [hvecTarget, hmix'] + cases hn : negative <;> + cases hr : BandPackingSymmetryReversesOrientation a <;> + ext <;> simp [GaussianQuarterTurn] <;> try ring + +private theorem hslopeCov : + (by + classical + exact + let symmetryMix : Bool → GaussianInt × GaussianInt → GaussianInt × GaussianInt := + fun r z => if r then + (z.1 + GaussianQuarterTurn z.1, z.2 - GaussianQuarterTurn z.2) + else (z.1 - GaussianQuarterTurn z.1, z.2 + GaussianQuarterTurn z.2) + ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (a : BandPackingSymmetry), + let Q := BandPackingSymmetryQuadrupleAction + let q' := Q a q + ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (negative : Bool), ∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), + let p := e.symm (i, s) + ∀ (p₀ : ℝ × ℝ), ∀ (pᵢ : ℝ × ℝ), ((if s = true then (1 : ℝ) else -1) = (if p.2 = true then + (1 : ℝ) else -1) * (if negative then (-1 : ℝ) else 1)) → ( + let v0 := BandVectors.1 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) + let u0 := BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) + let vmix := v0 - GaussianQuarterTurn v0 + let umix := u0 + GaussianQuarterTurn u0 + let scale : ℝ := (if p.2 = true then (1 : ℝ) else -1) * (1 / 2) + (TileCentroid (BandPackingSymmetryTileAction a (S p.1 p.2)) - TileCentroid + (BandPackingSymmetryTileAction a U) = scale • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction a (vmix, umix)).1 ∧ + BandPackingSymmetrySlopeAction a (S p.1 p.2) pᵢ - BandPackingSymmetrySlopeAction a U + p₀ = scale • GaussianRealPoint (BandPackingSymmetryAffineVectorAction a (vmix, + umix)).2) → ((BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ)) + + GaussianQuarterTurn (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ))) = (if + negative then (-1 : GaussianInt) else 1) * (BandPackingSymmetryAffineVectorAction a + (symmetryMix false (v0, u0))).2) → (BandPackingSymmetrySlopeAction a (S p.1 p.2) pᵢ - + BandPackingSymmetrySlopeAction a U p₀ = ((if s = true then (1 : ℝ) else -1) * (1 / + 2)) • GaussianRealPoint (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ)) + + GaussianQuarterTurn (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ))))))) ) := by + classical + intro symmetryMix U q S a Q q' e negative i s p p₀ pᵢ hsign v0 u0 vmix umix scale + hdiffTransport hsum + calc + _ = scale • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction a + (symmetryMix false (v0, u0))).2 := hdiffTransport.2 + _ = _ := by + rw [hsum] + cases hp : p.2 <;> cases hn : negative <;> cases hs' : s + all_goals + simp [hp, hn, hs'] at hsign + all_goals norm_num at hsign + all_goals simp [scale, hp, + GaussianRealPoint, smul_eq_mul] + +end TileOdometerSymmetryProof + +namespace TileOdometerAssembly + +private theorem actionDiff : + (by + classical + exact + (∀ (a : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ x ∈ k.domain, + BandPackingSymmetryVectorAction a x ∈ (BandPackingSymmetryPartialOdometerAction a + k).domain) → (∀ (a : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ (l : + PartialOdometer), ∀ x ∈ k.domain, x ∈ l.domain → + (BandPackingSymmetryPartialOdometerAction a l).value (BandPackingSymmetryVectorAction + a x) - (BandPackingSymmetryPartialOdometerAction a k).value + (BandPackingSymmetryVectorAction a x) = l.value x - k.value x) ) := by + classical + intro actionForward a k l x hk hl + exact TileOdometerSymmetryProof.actionDiff actionForward a k l x hk hl + +private theorem hpsi : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (wr : ℤ), ∀ (wi : ℤ), ∀ (v : GaussianInt), + ( + let d1 := BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v; + let d2 := BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) (v + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) - BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v; + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt) + (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt)) = BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v + + d1 + d2 + wi) → (∀ r ∈ (CurvatureOneOdometer z).domain, BandPackingShiftPotential + (⟨wr, wi⟩ : GaussianInt) (v + r) = wi * r.re * r.im + (⟨BandPackingShiftPotential + (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v, BandPackingShiftPotential + (⟨wr, wi⟩ : GaussianInt) (v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v⟩ : GaussianInt).re * (v + r).re + + (⟨BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v, BandPackingShiftPotential + (⟨wr, wi⟩ : GaussianInt) (v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v⟩ : GaussianInt).im * (v + r).im + + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v - (⟨BandPackingShiftPotential + (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v, BandPackingShiftPotential + (⟨wr, wi⟩ : GaussianInt) (v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v⟩ : GaussianInt).re * v.re - + (⟨BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v, BandPackingShiftPotential + (⟨wr, wi⟩ : GaussianInt) (v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v⟩ : GaussianInt).im * v.im) ) := by + classical + intro z wr wi v hcorner r hr + let d1 := BandPackingShiftPotential ⟨wr, wi⟩ (v + 1) - + BandPackingShiftPotential ⟨wr, wi⟩ v + let d2 := BandPackingShiftPotential ⟨wr, wi⟩ (v + ⟨0, 1⟩) - + BandPackingShiftPotential ⟨wr, wi⟩ v + exact TileOdometerSymmetryProof.hpsi z wr wi v + hcorner r hr + +private theorem hcurvAt1757 : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (wr : ℤ), ∀ (wi : ℤ), ∀ (r : GaussianInt), (r ∈ + (CurvatureOneOdometer z).domain) → ((CurvatureOneOdometer (z + ⟨wr, wi⟩)).value r = + (CurvatureOneOdometer z).value r + wi * r.re * r.im) ) := by + classical + intro z wr wi r hr + exact TileOdometerSymmetryProof.hcurvAt595 z wr wi r hr + +private theorem hCAt1762 : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (wr : ℤ), ∀ (wi : ℤ), BandPackingSymmetryCircleAction (.shift ⟨wr, + wi⟩) (1, 1 + 2 * z) = (1, 1 + 2 * (z + ⟨wr, wi⟩)) ) := by + classical + intro z wr wi + exact TileOdometerSymmetryProof.hCAt611 + z wr wi + +private theorem hunitValueAt1803 : + (by + classical + exact + ∀ (z : GaussianInt), ∀ r ∈ (CurvatureOneOdometer z).domain, (CurvatureOneOdometer + z).value ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - GaussianQuarterTurn r) = + (CurvatureOneOdometer (-z - (1 : GaussianInt))).value r + z.im * r.im ) := by + classical + intro z r hr + exact TileOdometerSymmetryProof.hunitValueAt682 z r hr + +private theorem hcellAt1824 : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells = {x}) → ((BandPackingSymmetryTileAction + .conjugate U).cells = {-GaussianReflection x - 1}) ) := by + classical + intro U x hU + exact TileOdometerSymmetryProof.hcellAt753 U x hU + +private theorem hunitValueAt1829 : + (by + classical + exact + ∀ (z : GaussianInt), ∀ r ∈ (CurvatureOneOdometer z).domain, (CurvatureOneOdometer + z).value ((1 : GaussianInt) - GaussianReflection r) = (CurvatureOneOdometer + (GaussianReflection z)).value r + z.im * r.im ) := by + classical + intro z r hr + exact TileOdometerSymmetryProof.hunitValueAt805 z r hr + +private theorem hCAt1836 : + (by + classical + exact + ∀ (z : GaussianInt), BandPackingSymmetryCircleAction .conjugate (1, 1 + 2 * z) = (1, 1 + + 2 * GaussianReflection z) ) := by + classical + intro z + exact TileOdometerSymmetryProof.hCAt864 z + +private theorem hcentroid' : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (a : BandPackingSymmetry), + let Q := BandPackingSymmetryQuadrupleAction + let B := BandPackingSymmetryTileAction + let q' := Q a q + ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction a q) + (BandPackingSymmetryTileAction a U) i s (S' i s)) → (∀ i, ∀ s, TileCentroid (S' i s) + - TileCentroid (B a U) = (if s = true then (1 : Real) else -1) • ((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q' ((i + 2).succ)) (q' ((i + 1).succ))) - + (-((GaussianRealPoint (BandVectors.1 (q' ((i + 2).succ)) (q' ((i + 1).succ)))).2), + (GaussianRealPoint (BandVectors.1 (q' ((i + 2).succ)) (q' ((i + 1).succ)))).1)))) ) + := by + classical + intro U q a Q B q' S' hocc' + exact fun i s => (hocc' i s).2.2 + +private theorem hphaseEq : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → (∀ (a : + BandPackingSymmetry), ∀ (delta : Bool), (BandPackingSymmetryScopedPhase a q delta) → + (∀ (negative : Bool), (BandPackingSymmetryScopedPhase a q negative) → (negative = + delta))) ) := by + classical + intro q hq a delta hphase negative hphaseAffine + exact BandPackingSymmetryScopedPhaseUnique a q hq negative delta + hphaseAffine hphase + +private theorem hOorig : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple q) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 : + ℕ) → Bool → PartialOdometer), (BandPrototile (q (0 : Fin (4 : ℕ))) U) → ((∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (S i s) (hs i s)) → ((∀ (x : + LatticeCell), x ∈ U.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → ((∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), FootprintVertices (S i s) ⊆ FootprintVertices U) → + ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S i s) - TileCentroid U = (if s = + true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((∀ (x : GaussianInt), x ∈ + h.domain ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (hs i s).domain) → ((∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), ∀ x ∈ (hs i s).domain, h.value x = (hs i s).value x) → ((∀ (i : + Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), OdometerCompatibility + (hs i s) (hs j t)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (q i.succ).1 = (0 : ℤ) ∨ ∃ + (p : ℝ × ℝ) (p_i : ℝ × ℝ), PartialOdometerSlope h = some p ∧ PartialOdometerSlope (hs + i s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : + ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : + ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q + (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (TileOdometer (q 0) U h)))))))))) ) := by + classical + intro h U q hq S hs hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope + exact TileOdometer.decompose hq hT hsub hcells hfoot hcentroid + hdom hvalue hcompat hslope + +private theorem hout : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (U : ProtoTile), ∀ (a : BandPackingSymmetry), + let P := BandPackingSymmetryPartialOdometerAction + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction a h) = Option.map + (BandPackingSymmetrySlopeAction a U) (PartialOdometerSlope h)) → (∀ (p₀ : ℝ × ℝ), + (PartialOdometerSlope h = some p₀) → (PartialOdometerSlope (P a h) = some + (BandPackingSymmetrySlopeAction a U p₀))) ) := by + classical + intro h U a P houterSlope p₀ hp₀ + exact TileOdometerSymmetryProof.hout h + U a houterSlope p₀ hp₀ + +private theorem hchild : + (by + classical + exact + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ + (a : BandPackingSymmetry), + let P := BandPackingSymmetryPartialOdometerAction + ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + let p := e.symm (i, s) + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction a (hs p.1 p.2)) = + Option.map (BandPackingSymmetrySlopeAction a (S p.1 p.2)) (PartialOdometerSlope (hs + p.1 p.2))) → (∀ (pᵢ : ℝ × ℝ), (PartialOdometerSlope (hs p.1 p.2) = some pᵢ) → + (PartialOdometerSlope (P a (hs p.1 p.2)) = some (BandPackingSymmetrySlopeAction a (S + p.1 p.2) pᵢ))) ) := by + classical + intro S hs a P e i s p hchildSlope pᵢ hpᵢ + exact TileOdometerSymmetryProof.hchild S hs a e i s hchildSlope pᵢ hpᵢ + +private theorem hslopeCov : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (a : BandPackingSymmetry), + let Q := BandPackingSymmetryQuadrupleAction + let q' := Q a q + ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (negative : Bool), ∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), + let p := e.symm (i, s) + ∀ (p₀ : ℝ × ℝ), ∀ (pᵢ : ℝ × ℝ), ((if s = true then (1 : ℝ) else (-1 : ℝ)) = (if ((e.symm + : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).2 = true then (1 : ℝ) else (-1 : + ℝ)) * if negative = true then (-1 : ℝ) else (1 : ℝ)) → ( + let v0 := BandVectors.1 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) + let u0 := BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) + let vmix := v0 - GaussianQuarterTurn v0 + let umix := u0 + GaussianQuarterTurn u0 + let scale : ℝ := (if p.2 = true then (1 : ℝ) else -1) * (1 / 2) + (TileCentroid (BandPackingSymmetryTileAction a (S p.1 p.2)) - TileCentroid + (BandPackingSymmetryTileAction a U) = scale • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction a (vmix, umix)).1 ∧ + BandPackingSymmetrySlopeAction a (S p.1 p.2) pᵢ - BandPackingSymmetrySlopeAction a U + p₀ = scale • GaussianRealPoint (BandPackingSymmetryAffineVectorAction a (vmix, + umix)).2) → ((BandVectors.2 (BandPackingSymmetryQuadrupleAction a q (i + (2 : Fin (3 + : ℕ))).succ) (BandPackingSymmetryQuadrupleAction a q (i + (1 : Fin (3 : ℕ))).succ) + + GaussianQuarterTurn (BandVectors.2 (BandPackingSymmetryQuadrupleAction a q (i + (2 : + Fin (3 : ℕ))).succ) (BandPackingSymmetryQuadrupleAction a q (i + (1 : Fin (3 : + ℕ))).succ)) = (if negative = true then (-1 : GaussianInt) else (1 : GaussianInt)) * + (BandPackingSymmetryAffineVectorAction a ((fun (r : Bool) (z : GaussianInt × + GaussianInt) => if r = true then (z.1 + GaussianQuarterTurn z.1, z.2 - + GaussianQuarterTurn z.2) else (z.1 - GaussianQuarterTurn z.1, z.2 + + GaussianQuarterTurn z.2)) false (BandVectors.1 (q (((e.symm : Fin (3 : ℕ) × Bool → + Fin (3 : ℕ) × Bool) (i, s)).1 + (2 : Fin (3 : ℕ))).succ) (q (((e.symm : Fin (3 : ℕ) × + Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q + (((e.symm : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + (2 : Fin (3 : + ℕ))).succ) (q (((e.symm : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + (1 : + Fin (3 : ℕ))).succ)))).2) → (BandPackingSymmetrySlopeAction a (S p.1 p.2) pᵢ - + BandPackingSymmetrySlopeAction a U p₀ = ((if s = true then (1 : ℝ) else -1) * (1 / + 2)) • GaussianRealPoint (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ)) + + GaussianQuarterTurn (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ))))))) ) := by + classical + intro U q S a Q q' e negative i s p p₀ pᵢ hsign v0 u0 vmix umix scale hdiffTransport hsum + exact TileOdometerSymmetryProof.hslopeCov U q S a + e negative i s p₀ pᵢ hsign hdiffTransport hsum + +end TileOdometerAssembly + +namespace TileOdometerConclusion + +private theorem actionDiff : + (by + classical + exact + (∀ (a : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ x ∈ k.domain, + BandPackingSymmetryVectorAction a x ∈ (BandPackingSymmetryPartialOdometerAction a + k).domain) → (∀ (a : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ (l : + PartialOdometer), ∀ x ∈ k.domain, x ∈ l.domain → + (BandPackingSymmetryPartialOdometerAction a l).value (BandPackingSymmetryVectorAction + a x) - (BandPackingSymmetryPartialOdometerAction a k).value + (BandPackingSymmetryVectorAction a x) = l.value x - k.value x) ) := by + classical + intro actionForward a k l x hk hl + exact TileOdometerAssembly.actionDiff actionForward a k l x hk hl + +private theorem hpsi : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (wr : ℤ), ∀ (wi : ℤ), ∀ (v : GaussianInt), + ( + let d1 := BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v; + let d2 := BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) (v + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) - BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v; + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt) + (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt)) = BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v + + d1 + d2 + wi) → (∀ r ∈ (CurvatureOneOdometer z).domain, BandPackingShiftPotential + (⟨wr, wi⟩ : GaussianInt) (v + r) = wi * r.re * r.im + (⟨BandPackingShiftPotential + (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v, BandPackingShiftPotential + (⟨wr, wi⟩ : GaussianInt) (v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v⟩ : GaussianInt).re * (v + r).re + + (⟨BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v, BandPackingShiftPotential + (⟨wr, wi⟩ : GaussianInt) (v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v⟩ : GaussianInt).im * (v + r).im + + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v - (⟨BandPackingShiftPotential + (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v, BandPackingShiftPotential + (⟨wr, wi⟩ : GaussianInt) (v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v⟩ : GaussianInt).re * v.re - + (⟨BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v, BandPackingShiftPotential + (⟨wr, wi⟩ : GaussianInt) (v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - + BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v⟩ : GaussianInt).im * v.im) ) := by + classical + intro z wr wi v hcorner r hr + let d1 := BandPackingShiftPotential ⟨wr, wi⟩ (v + 1) - + BandPackingShiftPotential ⟨wr, wi⟩ v + let d2 := BandPackingShiftPotential ⟨wr, wi⟩ (v + ⟨0, 1⟩) - + BandPackingShiftPotential ⟨wr, wi⟩ v + exact TileOdometerAssembly.hpsi z wr wi v + hcorner r hr + +private theorem hcurvAt2025 : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (wr : ℤ), ∀ (wi : ℤ), ∀ (r : GaussianInt), (r ∈ + (CurvatureOneOdometer z).domain) → ((CurvatureOneOdometer (z + ⟨wr, wi⟩)).value r = + (CurvatureOneOdometer z).value r + wi * r.re * r.im) ) := by + classical + intro z wr wi r hr + exact TileOdometerAssembly.hcurvAt1757 z wr wi r hr + +private theorem hCAt2030 : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (wr : ℤ), ∀ (wi : ℤ), BandPackingSymmetryCircleAction (.shift ⟨wr, + wi⟩) (1, 1 + 2 * z) = (1, 1 + 2 * (z + ⟨wr, wi⟩)) ) := by + classical + intro z wr wi + exact TileOdometerAssembly.hCAt1762 z + wr wi + +private theorem hunitValueAt2071 : + (by + classical + exact + ∀ (z : GaussianInt), ∀ r ∈ (CurvatureOneOdometer z).domain, (CurvatureOneOdometer + z).value ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - GaussianQuarterTurn r) = + (CurvatureOneOdometer (-z - (1 : GaussianInt))).value r + z.im * r.im ) := by + classical + intro z r hr + exact TileOdometerAssembly.hunitValueAt1803 z r hr + +private theorem hcellAt2092 : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells = {x}) → ((BandPackingSymmetryTileAction + .conjugate U).cells = {-GaussianReflection x - 1}) ) := by + classical + intro U x hU + exact TileOdometerAssembly.hcellAt1824 U x hU + +private theorem hunitValueAt2097 : + (by + classical + exact + ∀ (z : GaussianInt), ∀ r ∈ (CurvatureOneOdometer z).domain, (CurvatureOneOdometer + z).value ((1 : GaussianInt) - GaussianReflection r) = (CurvatureOneOdometer + (GaussianReflection z)).value r + z.im * r.im ) := by + classical + intro z r hr + exact TileOdometerAssembly.hunitValueAt1829 z r hr + +private theorem hCAt2104 : + (by + classical + exact + ∀ (z : GaussianInt), BandPackingSymmetryCircleAction .conjugate (1, 1 + 2 * z) = (1, 1 + + 2 * GaussianReflection z) ) := by + classical + intro z + exact TileOdometerAssembly.hCAt1836 z + +private theorem hout : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (U : ProtoTile), ∀ (a : BandPackingSymmetry), + let P := BandPackingSymmetryPartialOdometerAction + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction a h) = Option.map + (BandPackingSymmetrySlopeAction a U) (PartialOdometerSlope h)) → (∀ (p₀ : ℝ × ℝ), + (PartialOdometerSlope h = some p₀) → (PartialOdometerSlope (P a h) = some + (BandPackingSymmetrySlopeAction a U p₀))) ) := by + classical + intro h U a P houterSlope p₀ hp₀ + exact TileOdometerAssembly.hout h U a + houterSlope p₀ hp₀ + +private theorem hchild : + (by + classical + exact + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ + (a : BandPackingSymmetry), + let P := BandPackingSymmetryPartialOdometerAction + ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + let p := e.symm (i, s) + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction a (hs p.1 p.2)) = + Option.map (BandPackingSymmetrySlopeAction a (S p.1 p.2)) (PartialOdometerSlope (hs + p.1 p.2))) → (∀ (pᵢ : ℝ × ℝ), (PartialOdometerSlope (hs p.1 p.2) = some pᵢ) → + (PartialOdometerSlope (P a (hs p.1 p.2)) = some (BandPackingSymmetrySlopeAction a (S + p.1 p.2) pᵢ))) ) := by + classical + intro S hs a P e i s p hchildSlope pᵢ hpᵢ + exact TileOdometerAssembly.hchild S hs a e i s hchildSlope pᵢ hpᵢ + +private theorem hslopeCov : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (a : BandPackingSymmetry), + let Q := BandPackingSymmetryQuadrupleAction + let q' := Q a q + ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (negative : Bool), ∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), + let p := e.symm (i, s) + ∀ (p₀ : ℝ × ℝ), ∀ (pᵢ : ℝ × ℝ), ((if s = true then (1 : ℝ) else (-1 : ℝ)) = (if ((e.symm + : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).2 = true then (1 : ℝ) else (-1 : + ℝ)) * if negative = true then (-1 : ℝ) else (1 : ℝ)) → ( + let v0 := BandVectors.1 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) + let u0 := BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) + let vmix := v0 - GaussianQuarterTurn v0 + let umix := u0 + GaussianQuarterTurn u0 + let scale : ℝ := (if p.2 = true then (1 : ℝ) else -1) * (1 / 2) + (TileCentroid (BandPackingSymmetryTileAction a (S p.1 p.2)) - TileCentroid + (BandPackingSymmetryTileAction a U) = scale • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction a (vmix, umix)).1 ∧ + BandPackingSymmetrySlopeAction a (S p.1 p.2) pᵢ - BandPackingSymmetrySlopeAction a U + p₀ = scale • GaussianRealPoint (BandPackingSymmetryAffineVectorAction a (vmix, + umix)).2) → ((BandVectors.2 (BandPackingSymmetryQuadrupleAction a q (i + (2 : Fin (3 + : ℕ))).succ) (BandPackingSymmetryQuadrupleAction a q (i + (1 : Fin (3 : ℕ))).succ) + + GaussianQuarterTurn (BandVectors.2 (BandPackingSymmetryQuadrupleAction a q (i + (2 : + Fin (3 : ℕ))).succ) (BandPackingSymmetryQuadrupleAction a q (i + (1 : Fin (3 : + ℕ))).succ)) = (if negative = true then (-1 : GaussianInt) else (1 : GaussianInt)) * + (BandPackingSymmetryAffineVectorAction a ((fun (r : Bool) (z : GaussianInt × + GaussianInt) => if r = true then (z.1 + GaussianQuarterTurn z.1, z.2 - + GaussianQuarterTurn z.2) else (z.1 - GaussianQuarterTurn z.1, z.2 + + GaussianQuarterTurn z.2)) false (BandVectors.1 (q (((e.symm : Fin (3 : ℕ) × Bool → + Fin (3 : ℕ) × Bool) (i, s)).1 + (2 : Fin (3 : ℕ))).succ) (q (((e.symm : Fin (3 : ℕ) × + Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q + (((e.symm : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + (2 : Fin (3 : + ℕ))).succ) (q (((e.symm : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + (1 : + Fin (3 : ℕ))).succ)))).2) → (BandPackingSymmetrySlopeAction a (S p.1 p.2) pᵢ - + BandPackingSymmetrySlopeAction a U p₀ = ((if s = true then (1 : ℝ) else -1) * (1 / + 2)) • GaussianRealPoint (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ)) + + GaussianQuarterTurn (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ))))))) ) := by + classical + intro U q S a Q q' e negative i s p p₀ pᵢ hsign v0 u0 vmix umix scale hdiffTransport hsum + exact TileOdometerAssembly.hslopeCov U q S a e + negative i s p₀ pᵢ hsign hdiffTransport hsum + +end TileOdometerConclusion + +namespace UnitOdometerSymmetry + +private theorem unitSymmetry : + (by + classical + exact + (∀ (a : BandPackingSymmetry), ∀ (D : CircleCoordinates), (BandPackingSymmetryCircleAction + a D).1 = D.1) → ((∀ (D : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : + PartialOdometer), D.1 = (1 : ℤ) → TileOdometer D U k → ∃ (z : GaussianInt) (x : + LatticeCell), D = ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z) ∧ U.cells = + {x} ∧ (↑k.domain : Set GaussianInt) = FootprintVertices U ∧ OdometerTranslation k + (CurvatureOneOdometer z)) → (∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (z : + GaussianInt), ∀ (x : GaussianInt), (U.cells = {x}) → (((↑k.domain : Set GaussianInt) + = FootprintVertices U) → ((OdometerTranslation k (CurvatureOneOdometer z)) → (∀ a : + BandPackingSymmetry, TileOdometer (BandPackingSymmetryCircleAction a (1, 1 + 2 * z)) + (BandPackingSymmetryTileAction a U) (BandPackingSymmetryPartialOdometerAction a + k)))))) ) := by + classical + intro circleCurvature extractUnit U k z x hU hdom htrans a + induction a generalizing z x U k hU hdom htrans with + | identity => + simpa [BandPackingSymmetryCircleAction, + BandPackingSymmetryTileAction, + BandPackingSymmetryPartialOdometerAction] using + TileOdometer.unit z x U k hU hdom htrans + | shift w => + rcases w with ⟨wr, wi⟩ + have triangular := TileOdometerSymmetryProof.triangular + have shiftDx := TileOdometerSymmetryProof.shiftDx wr wi triangular + have shiftDy := TileOdometerSymmetryProof.shiftDy wr wi triangular + rcases htrans with ⟨v, a0, b0, hvdom, hvval⟩ + let d1 := BandPackingShiftPotential ⟨wr, wi⟩ (v + 1) - + BandPackingShiftPotential ⟨wr, wi⟩ v + let d2 := BandPackingShiftPotential ⟨wr, wi⟩ (v + ⟨0, 1⟩) - + BandPackingShiftPotential ⟨wr, wi⟩ v + let d : GaussianInt := ⟨d1, d2⟩ + let b1 := b0 + BandPackingShiftPotential ⟨wr, wi⟩ v - + d.re * v.re - d.im * v.im + have hcorner := TileOdometerSymmetryProof.hcorner wr wi shiftDx shiftDy v + have hpsi := TileOdometerConclusion.hpsi z wr wi v hcorner + have hcurv (r : GaussianInt) (hr : + r ∈ (CurvatureOneOdometer z).domain) : + (CurvatureOneOdometer (z + ⟨wr, wi⟩)).value r = + (CurvatureOneOdometer z).value r + wi * r.re * r.im := + TileOdometerConclusion.hcurvAt2025 z wr wi r hr + have hC : BandPackingSymmetryCircleAction (.shift ⟨wr, wi⟩) + (1, 1 + 2 * z) = (1, 1 + 2 * (z + ⟨wr, wi⟩)) := TileOdometerConclusion.hCAt2030 z + wr wi + rw [hC] + simp only [BandPackingSymmetryTileAction] + refine TileOdometer.unit (z + ⟨wr, wi⟩) x U + (BandPackingSymmetryPartialOdometerAction (.shift ⟨wr, wi⟩) k) + ?_ ?_ ?_ + · exact hU + · simpa [BandPackingSymmetryTileAction, + BandPackingSymmetryPartialOdometerAction] using hdom + · refine ⟨v, a0 + d, b1, ?_, ?_⟩ + · intro y + change y ∈ k.domain ↔ + y - v ∈ (CurvatureOneOdometer (z + ⟨wr, wi⟩)).domain + rw [hvdom] + simp [CurvatureOneOdometer] + · intro y hy + have hyk := TileOdometerSymmetryProof.hyk k wr wi y hy + have hr : y - v ∈ (CurvatureOneOdometer z).domain := + (hvdom y).mp hyk + have hval := hvval y hyk + have hshift := (BandPackingSymmetryPartialOdometerActionFormulas + (.shift ⟨wr, wi⟩) k k).2.2.1 ⟨wr, wi⟩ y hyk + rw [hshift, hval] + rw [hcurv (y - v) hr] + have hpsi' := hpsi (y - v) hr + have hvplus : v + (y - v) = y := by abel + rw [hvplus] at hpsi' + dsimp [b1, d, d1, d2] at hpsi' ⊢ + linear_combination hpsi' + | negate => + rcases htrans with ⟨v, a0, b0, hvdom, hvval⟩ + let I : GaussianInt := ⟨0, 1⟩ + let vn := GaussianQuarterTurn v - 1 + let an := GaussianQuarterTurn a0 + ⟨0, z.im⟩ + let bn := b0 - z.im * vn.im + have hcell : (TileQuarterTurn U).cells = + {GaussianQuarterTurn x - 1} := TileOdometerSymmetryProof.hcellAt653 U x hU + have hdomain := TileOdometerSymmetryProof.hdomainAt657 U k hdom + have hdomainUnit := TileOdometerSymmetryProof.hdomainUnitAt664 z + have hunitValue := TileOdometerConclusion.hunitValueAt2071 z + have hinverse := TileOdometerSymmetryProof.hinverseAt694 v + have himage := TileOdometerSymmetryProof.himageAt698 k + have htrans' := TileOdometerSymmetryProof.htrans'At711 k z v a0 b0 hvdom hvval + hdomainUnit hunitValue hinverse himage + have hC : BandPackingSymmetryCircleAction .negate + (1, 1 + 2 * z) = (1, 1 + 2 * (-z - 1)) := TileOdometerSymmetryProof.hCAt738 z + rw [hC] + refine TileOdometer.unit (-z - 1) (GaussianQuarterTurn x - 1) + (TileQuarterTurn U) + (BandPackingSymmetryPartialOdometerAction .negate k) + ?_ hdomain htrans' + simp [hcell] + | conjugate => + rcases htrans with ⟨v, a0, b0, hvdom, hvval⟩ + let I : GaussianInt := ⟨0, 1⟩ + let vk := -GaussianReflection v - 1 + let ak := -GaussianReflection a0 + ⟨0, z.im⟩ + let bk := b0 - z.im * vk.im + have hcell : + (BandPackingSymmetryTileAction .conjugate U).cells = + {-GaussianReflection x - 1} := TileOdometerConclusion.hcellAt2092 U x hU + have hdomain := TileOdometerSymmetryProof.hdomainAt763 U k hdom + have hdomainUnit := TileOdometerSymmetryProof.hdomainUnitAt787 z + have hunitValue := TileOdometerConclusion.hunitValueAt2097 z + have hinverse := TileOdometerSymmetryProof.hinverseAt818 v + have himage := TileOdometerSymmetryProof.himageAt823 k + have htrans' := TileOdometerSymmetryProof.htrans'At836 k z v a0 b0 hvdom hvval + hdomainUnit hunitValue hinverse himage + have hC : BandPackingSymmetryCircleAction .conjugate + (1, 1 + 2 * z) = + (1, 1 + 2 * GaussianReflection z) := TileOdometerConclusion.hCAt2104 z + rw [hC] + refine TileOdometer.unit (GaussianReflection z) + (-GaussianReflection x - 1) + (BandPackingSymmetryTileAction .conjugate U) + (BandPackingSymmetryPartialOdometerAction .conjugate k) + ?_ hdomain htrans' + simp [hcell] + | comp a b iha ihb => + have mid := @ihb U k z x hU hdom htrans + have hcirc := circleCurvature b (1, 1 + 2 * z) + obtain ⟨z', x', hC, hU', hdom', htrans'⟩ := + extractUnit _ _ _ hcirc mid + change TileOdometer + (BandPackingSymmetryCircleAction a + (BandPackingSymmetryCircleAction b (1, 1 + 2 * z))) + (BandPackingSymmetryTileAction a + (BandPackingSymmetryTileAction b U)) + (BandPackingSymmetryPartialOdometerAction a + (BandPackingSymmetryPartialOdometerAction b k)) + rw [hC] + exact @iha _ _ z' x' hU' hdom' htrans' + +end UnitOdometerSymmetry + +theorem BandPackingSymmetryTileOdometerCovariance + (g : BandPackingSymmetry) (C : CircleCoordinates) (T : ProtoTile) + (h : PartialOdometer) (hO : TileOdometer C T h) : + TileOdometer (BandPackingSymmetryCircleAction g C) + (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryPartialOdometerAction g h) ∧ + (((BandPackingSymmetryPartialOdometerAction g h).domain : + Set GaussianInt) = + BandPackingSymmetryVectorAction g '' (h.domain : Set GaussianInt)) ∧ + (T.cells.Nonempty → + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = + (PartialOdometerSlope h).map + (BandPackingSymmetrySlopeAction g T)) := by +-- BODY + classical + have domain := (BandPackingSymmetryPartialOdometerActionFormulas g h h).1 + have positiveCells := TileOdometerSymmetryProof.positiveCells + have odoPositiveCurvature := TileOdometerSymmetryProof.odoPositiveCurvature + have slopeCov := TileOdometerSymmetryProof.slopeCov g odoPositiveCurvature + have slope := slopeCov C T h hO + have lineCircle := TileOdometerSymmetryProof.lineCircle + have tileEmpty := TileOdometerSymmetryProof.tileEmpty + have zeroLine := TileOdometerSymmetryProof.zeroLine + have actionForward := TileOdometerSymmetryProof.actionForward + have actionDiff := TileOdometerConclusion.actionDiff actionForward + have lineCov := TileOdometerSymmetryProof.lineCov lineCircle tileEmpty zeroLine + have circleCurvature := TileOdometerSymmetryProof.circleCurvature + have extractUnit := TileOdometerSymmetryProof.extractUnit + have differenceTransport := TileOdometerSymmetryProof.differenceTransport + let symmetryMix : Bool → GaussianInt × GaussianInt → GaussianInt × GaussianInt := + fun r z => if r then + (z.1 + GaussianQuarterTurn z.1, z.2 - GaussianQuarterTurn z.2) + else (z.1 - GaussianQuarterTurn z.1, z.2 + GaussianQuarterTurn z.2) + have affineMix := TileOdometerSymmetryProof.affineMix + have transform : ∀ (D : CircleCoordinates) (U : ProtoTile) (k : PartialOdometer), + TileOdometer D U k → ∀ a : BandPackingSymmetry, + TileOdometer (BandPackingSymmetryCircleAction a D) + (BandPackingSymmetryTileAction a U) + (BandPackingSymmetryPartialOdometerAction a k) := by + intro D U k ho + induction ho with + | line w x hw k hk => intro a; exact lineCov w x hw k hk a + | unit z x U k hU hdom htrans => + have unitSymmetry : ∀ a : BandPackingSymmetry, + TileOdometer (BandPackingSymmetryCircleAction a (1, 1 + 2 * z)) + (BandPackingSymmetryTileAction a U) + (BandPackingSymmetryPartialOdometerAction a k) := UnitOdometerSymmetry.unitSymmetry + circleCurvature extractUnit U k z x hU hdom htrans + exact unitSymmetry + | @decompose q hq S U hs h hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + intro a + let Q := BandPackingSymmetryQuadrupleAction + let A := BandPackingSymmetryCircleAction + let B := BandPackingSymmetryTileAction + let P := BandPackingSymmetryPartialOdometerAction + let q' := Q a q + let sigma : Fin 3 → Fin 3 := fun i => + if BandPackingSymmetryReversesOrientation a then -i else i + have hocc := TileOdometerSymmetryProof.hocc U q S hs hsub hfoot hcentroid + have cov := BandPackingSymmetryCovariance a + obtain ⟨delta, e, S', hphase, he, hS, hocc', hcells'⟩ := + cov.2.2 q U S hq hT hocc hcells + have hproper' : ProperBandQuadruple q' := by + simpa [q'] using BandPackingSymmetryProperCovariance a q hq + have hneg1 : -(1 : Fin 3) = 2 := rfl + have hneg2 : -(2 : Fin 3) = 1 := rfl + have hparent := TileOdometerSymmetryProof.hparentAt910 q a hneg1 hneg2 + have hT' := TileOdometerSymmetryProof.hT' U q hT a cov + let hs' : Fin 3 → Bool → PartialOdometer := fun j s => + P a (hs (e.symm (j, s)).1 (e.symm (j, s)).2) + have hsub' := TileOdometerSymmetryProof.hsub' q S hs hsub ih a delta e S' he hS hparent + have hdom' := TileOdometerSymmetryProof.hdom' h hs hdom a e + have hvalue' := TileOdometerSymmetryProof.hvalue' h actionDiff hs hdom hvalue a e + have hcompat' := TileOdometerSymmetryProof.hcompat' hs hcompat a e + have hfoot' : ∀ i s, FootprintVertices (S' i s) ⊆ + FootprintVertices (B a U) := fun i s => (hocc' i s).2.1 + have hcentroid' := TileOdometerAssembly.hcentroid' U q a S' hocc' + have hcompatInput := BandPackingSymmetryPartialOdometerActionFormulas a h h + obtain ⟨negative, hphaseAffine, hvecAffine⟩ := + BandPackingSymmetryAffineVectorCovariance a q hq + have hphaseEq := TileOdometerAssembly.hphaseEq q hq a delta hphase negative hphaseAffine + have hUne : U.cells.Nonempty := + positiveCells (q 0) U (ProperBandCurvatureStructure q hq).1 hT + have hOorig := TileOdometerAssembly.hOorig h U q hq S hs hT hsub hcells hfoot hcentroid + hdom hvalue hcompat hslope + have hUdom := PositiveCurvatureTileOdometerDomain (q 0) U h + (ProperBandCurvatureStructure q hq).1 hOorig + have houterSlope := BandPrototileFootprintSlopeCovariance a (q 0) U h + hT hUne hUdom + refine TileOdometer.decompose hproper' hT' hsub' hcells' hfoot' hcentroid' + hdom' hvalue' hcompat' ?_ + intro i s + let p := e.symm (i, s) + have hep : e p = (i, s) := e.apply_symm_apply (i, s) + have hpair := TileOdometerSymmetryProof.hpairAt1015 a delta e he i s hep + have hidx : sigma p.1 = i := congrArg Prod.fst hpair + have hcurv : (q' i.succ).1 = (q p.1.succ).1 := TileOdometerSymmetryProof.hcurvAt1021 q a + cov e hparent i s hidx + have hprotoChild := TileOdometerBandPrototile (q p.1.succ) + (S p.1 p.2) (hs p.1 p.2) (hsub p.1 p.2) + by_cases hz : (q p.1.succ).1 = 0 + · left + rw [hcurv, hz] + · have hchildCurvPos := TileOdometerSymmetryProof.hchildCurvPos q hq a e i s hz + have hchildNe : (S p.1 p.2).cells.Nonempty := + positiveCells (q p.1.succ) (S p.1 p.2) hchildCurvPos hprotoChild + have hchildDom := PositiveCurvatureTileOdometerDomain (q p.1.succ) + (S p.1 p.2) (hs p.1 p.2) hchildCurvPos (hsub p.1 p.2) + have hchildSlope := BandPrototileFootprintSlopeCovariance a + (q p.1.succ) (S p.1 p.2) (hs p.1 p.2) hprotoChild hchildNe hchildDom + rcases hslope p.1 p.2 with hzero | ⟨p₀, pᵢ, hp₀, hpᵢ, hdx, hdy⟩ + · omega + · have hout : PartialOdometerSlope (P a h) = + some (BandPackingSymmetrySlopeAction a U p₀) := TileOdometerConclusion.hout h U a + houterSlope p₀ hp₀ + have hchild : PartialOdometerSlope (P a (hs p.1 p.2)) = + some (BandPackingSymmetrySlopeAction a (S p.1 p.2) pᵢ) := + TileOdometerConclusion.hchild S hs a e i s hchildSlope pᵢ hpᵢ + have hidx2 : sigma p.1 + 2 = i + 2 := congrArg (fun j : Fin 3 => j + 2) hidx + have hidx1 : sigma p.1 + 1 = i + 1 := congrArg (fun j : Fin 3 => j + 1) hidx + have hvecTarget := TileOdometerSymmetryProof.hvecTarget q a e negative hvecAffine i s + hidx2 hidx1 + have hsign := TileOdometerSymmetryProof.hsign a delta e negative hphaseEq i s hpair + have hc := hcentroid p.1 p.2 + have hc1 := TileOdometerSymmetryProof.hc1At1079 U q S e i s hc + have hc2 := TileOdometerSymmetryProof.hc2At1089 U q S e i s hc + let v0 := BandVectors.1 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) + let u0 := BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) + let vmix := v0 - GaussianQuarterTurn v0 + let umix := u0 + GaussianQuarterTurn u0 + let scale : ℝ := (if p.2 = true then (1 : ℝ) else -1) * (1 / 2) + have hcentMix := TileOdometerSymmetryProof.hcentMix U q S e i s hc + have hslopeMix := TileOdometerSymmetryProof.hslopeMix q e i s p₀ pᵢ hdx hdy + have hdiffTransport := differenceTransport a U (S p.1 p.2) + pᵢ p₀ vmix umix scale hcentMix hslopeMix + have hmix := congrArg Prod.snd (affineMix a false (v0, u0)) + have hmix' := TileOdometerSymmetryProof.hmix' q a e i s hmix + have hsum := TileOdometerSymmetryProof.hsum q a e negative i s hvecTarget hmix' + have hslopeCov : + BandPackingSymmetrySlopeAction a (S p.1 p.2) pᵢ - + BandPackingSymmetrySlopeAction a U p₀ = + ((if s = true then (1 : ℝ) else -1) * (1 / 2)) • + GaussianRealPoint + (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ)) + + GaussianQuarterTurn + (BandVectors.2 (q' ((i + 2).succ)) + (q' ((i + 1).succ)))) := TileOdometerConclusion.hslopeCov U q S a e + negative i s p₀ pᵢ hsign hdiffTransport hsum + refine Or.inr ⟨BandPackingSymmetrySlopeAction a U p₀, + BandPackingSymmetrySlopeAction a (S p.1 p.2) pᵢ, ?_, ?_, ?_, ?_⟩ + · simpa [hs'] using hout + · simpa [hs'] using hchild + · cases s <;> + simpa [BandPackingSymmetrySlopeAction, GaussianRealPoint, + GaussianQuarterTurn, GaussianInt.intCast_re, + GaussianInt.intCast_im, smul_eq_mul, sub_eq_add_neg] using + congrArg Prod.fst hslopeCov + · cases s <;> + simpa [BandPackingSymmetrySlopeAction, GaussianRealPoint, + GaussianQuarterTurn, GaussianInt.intCast_re, + GaussianInt.intCast_im, smul_eq_mul] using + congrArg Prod.snd hslopeCov + refine ⟨?_, domain, slope⟩ + · exact transform C T h hO g + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean new file mode 100644 index 0000000000..3b38c4aab3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean @@ -0,0 +1,699 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretationCovariance +public import LeanPool.ApollonianSuperharmonic.TileArea +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance + +-- [TABLET NODE: BandPackingSymmetryTilingTransport] + +/-! +# BandPackingSymmetryTilingTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TilingTransportProof + +private theorem quarter_translate : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), TileQuarterTurn (TileTranslation T x) = + TileTranslation (TileQuarterTurn T) (GaussianQuarterTurn x) + ) := by + classical + intro T x + cases T with + | mk cells anchor => + have map : (fun z : GaussianInt => GaussianQuarterTurn (z + x) - 1) = + (fun z : GaussianInt => (GaussianQuarterTurn z - 1) + + GaussianQuarterTurn x) := by + funext z + ext <;> simp [GaussianQuarterTurn, add_comm]; ring + apply congrArg₂ (fun c : FiniteTile => fun d : GaussianInt => + ProtoTile.mk c d) + · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, + Finset.image_image, Function.comp_def, map] + · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, + GaussianQuarterTurn, add_comm] + +private theorem quarter_symmetryAt181 : + (by + classical + exact + ∀ T : ProtoTile, QuarterTurnSymmetric T ↔ QuarterTurnSymmetric (TileQuarterTurn T) + ) := by + classical + intro T + unfold QuarterTurnSymmetric + have first := TileQuarterTurnFormulas T + simp only [first.2.2.2.1, first.2.2.2.2.1] + simp only [Set.mem_image] + constructor + · intro h p + constructor + · intro hp + rcases hp with ⟨q, hq, rfl⟩ + refine ⟨((TileCentroid T).1 - (q.2 - (TileCentroid T).2), + (TileCentroid T).2 + (q.1 - (TileCentroid T).1)), (h q).mp hq, ?_⟩ + dsimp + ring + · intro hp + rcases hp with ⟨q, hq, hpq⟩ + have heq' := congrArg Prod.fst hpq + have heq'' := congrArg Prod.snd hpq + dsimp at heq' heq'' + have qeq : q = + ((TileCentroid T).1 - ((-p.1) - (TileCentroid T).2), + (TileCentroid T).2 + (p.2 - (TileCentroid T).1)) := by + apply Prod.ext + · dsimp + linarith [heq''] + · dsimp + linarith [heq'] + refine ⟨(p.2, -p.1), ?_, ?_⟩ + · apply (h (p.2, -p.1)).mpr + exact qeq ▸ hq + · dsimp + ring + · intro h p + constructor + · intro hp + have hh := h (-p.2, p.1) + have hr : (-p.2, p.1) ∈ (fun p => (-p.2, p.1)) '' + TileRealization T := ⟨p, hp, rfl⟩ + rcases hh.mp hr with ⟨q, hq, heq⟩ + have heq' := congrArg Prod.fst heq + have heq'' := congrArg Prod.snd heq + have qeq : q = + ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), + (TileCentroid T).2 + (p.1 - (TileCentroid T).1)) := by + apply Prod.ext <;> dsimp at heq' heq'' ⊢ <;> linarith + rw [← qeq] + exact hq + · intro hp + have hh := h (-p.2, p.1) + have hc : ∃ x ∈ TileRealization T, + (-x.2, x.1) = + (-(TileCentroid T).2 - ((-p.2, p.1).2 - (TileCentroid T).1), + (TileCentroid T).1 + ((-p.2, p.1).1 - + -(TileCentroid T).2)) := by + refine ⟨((TileCentroid T).1 - (p.2 - (TileCentroid T).2), + (TileCentroid T).2 + (p.1 - (TileCentroid T).1)), hp, ?_⟩ + dsimp + ring_nf + rcases hh.mpr hc with ⟨q, hq, heq⟩ + have heq' := congrArg Prod.fst heq + have heq'' := congrArg Prod.snd heq + dsimp at heq' heq'' + rw [show q = p by apply Prod.ext <;> linarith] at hq + exact hq + +private theorem image_subsingletonAt247 : + (by + classical + exact + ∀ (f : GaussianInt → GaussianInt), Function.Injective f → ∀ (A : Set GaussianInt), ∀ (B : + Set GaussianInt), (A ∩ B).Subsingleton ↔ (f '' A ∩ f '' B).Subsingleton + ) := by + classical + intro f hf A B + constructor + · intro h x hx y hy + rcases hx with ⟨⟨a, ha, rfl⟩, ⟨b, hb, hab⟩⟩ + rcases hy with ⟨⟨c, hc, rfl⟩, ⟨d, hd, hcd⟩⟩ + have hab' : a = b := hf hab.symm + have hcd' : c = d := hf hcd.symm + subst b + subst d + exact congrArg f (h ⟨ha, hb⟩ ⟨hc, hd⟩) + · intro h a ha b hb + apply hf + exact h ⟨⟨a, ha.1, rfl⟩, ⟨a, ha.2, rfl⟩⟩ + ⟨⟨b, hb.1, rfl⟩, ⟨b, hb.2, rfl⟩⟩ + +private theorem quarter_symmetryAt307 : + (by + classical + exact + ∀ T : ProtoTile, QuarterTurnSymmetric T ↔ QuarterTurnSymmetric (TileQuarterTurn T) + ) := by + classical + intro T + unfold QuarterTurnSymmetric + have first := TileQuarterTurnFormulas T + simp only [first.2.2.2.1, first.2.2.2.2.1] + simp only [Set.mem_image] + constructor + · intro h p + constructor + · intro hp + rcases hp with ⟨q, hq, rfl⟩ + refine ⟨((TileCentroid T).1 - (q.2 - (TileCentroid T).2), + (TileCentroid T).2 + (q.1 - (TileCentroid T).1)), (h q).mp hq, ?_⟩ + dsimp + ring + · intro hp + rcases hp with ⟨q, hq, hpq⟩ + have heq' := congrArg Prod.fst hpq + have heq'' := congrArg Prod.snd hpq + dsimp at heq' heq'' + have qeq : q = + ((TileCentroid T).1 - ((-p.1) - (TileCentroid T).2), + (TileCentroid T).2 + (p.2 - (TileCentroid T).1)) := by + apply Prod.ext + · dsimp + linarith [heq''] + · dsimp + linarith [heq'] + refine ⟨(p.2, -p.1), ?_, ?_⟩ + · apply (h (p.2, -p.1)).mpr + exact qeq ▸ hq + · dsimp + ring + · intro h p + constructor + · intro hp + have hh := h (-p.2, p.1) + have hr : (-p.2, p.1) ∈ (fun p => (-p.2, p.1)) '' + TileRealization T := ⟨p, hp, rfl⟩ + rcases hh.mp hr with ⟨q, hq, heq⟩ + have heq' := congrArg Prod.fst heq + have heq'' := congrArg Prod.snd heq + have qeq : q = + ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), + (TileCentroid T).2 + (p.1 - (TileCentroid T).1)) := by + apply Prod.ext <;> dsimp at heq' heq'' ⊢ <;> linarith + rw [← qeq] + exact hq + · intro hp + have hh := h (-p.2, p.1) + have hc : ∃ x ∈ TileRealization T, + (-x.2, x.1) = + (-(TileCentroid T).2 - ((-p.2, p.1).2 - (TileCentroid T).1), + (TileCentroid T).1 + ((-p.2, p.1).1 - + -(TileCentroid T).2)) := by + refine ⟨((TileCentroid T).1 - (p.2 - (TileCentroid T).2), + (TileCentroid T).2 + (p.1 - (TileCentroid T).1)), hp, ?_⟩ + dsimp + ring_nf + rcases hh.mpr hc with ⟨q, hq, heq⟩ + have heq' := congrArg Prod.fst heq + have heq'' := congrArg Prod.snd heq + dsimp at heq' heq'' + rw [show q = p by apply Prod.ext <;> linarith] at hq + exact hq + +private theorem reflection_symmetry : + (by + classical + exact + ∀ T : ProtoTile, QuarterTurnSymmetric T ↔ QuarterTurnSymmetric (TileReflection T) + ) := by + classical + intro T + unfold QuarterTurnSymmetric + have first := TileReflectionFormulas T + simp only [first.2.2.2.1, first.2.2.2.2.1] + simp only [Set.mem_image] + constructor + · intro h p + constructor + · intro hp + rcases hp with ⟨q, hq, rfl⟩ + let y := ((TileCentroid T).1 + q.2 - (TileCentroid T).2, + (TileCentroid T).2 - q.1 + (TileCentroid T).1) + refine ⟨y, ?_, ?_⟩ + · apply (h y).mpr + convert hq using 1; dsimp [y]; ring + · dsimp [y] + ring_nf + · intro hp + rcases hp with ⟨q, hq, hpq⟩ + have first_eq := congrArg Prod.fst hpq + have second_eq := congrArg Prod.snd hpq + dsimp at first_eq second_eq + refine ⟨(p.1, -p.2), ?_, ?_⟩ + · have hq' := (h q).mp hq + convert hq' using 1 + apply Prod.ext <;> dsimp at first_eq second_eq ⊢ <;> + ring_nf at first_eq second_eq ⊢ <;> linarith + · apply Prod.ext <;> dsimp; linarith + · intro h p + constructor + · intro hp + let target := ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), + (TileCentroid T).2 + (p.1 - (TileCentroid T).1)) + have hc : ∃ x ∈ TileRealization T, + (x.1, -x.2) = + ((TileCentroid T).1 - ((target.1, -target.2).2 - + -(TileCentroid T).2), + -(TileCentroid T).2 + ((target.1, -target.2).1 - + (TileCentroid T).1)) := by + refine ⟨p, hp, ?_⟩ + dsimp [target] + ring + rcases (h (target.1, -target.2)).mpr hc with ⟨q, hq, heq⟩ + have first_eq := congrArg Prod.fst heq + have second_eq := congrArg Prod.snd heq + have qeq : q = target := by + apply Prod.ext <;> dsimp at first_eq second_eq ⊢ <;> linarith + change target ∈ TileRealization T + exact qeq ▸ hq + · intro hp + let target := ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), + (TileCentroid T).2 + (p.1 - (TileCentroid T).1)) + have hc : ∃ x ∈ TileRealization T, + (x.1, -x.2) = (target.1, -target.2) := + ⟨target, hp, rfl⟩ + rcases (h (target.1, -target.2)).mp hc with ⟨q, hq, heq⟩ + have first_eq := congrArg Prod.fst heq + have second_eq := congrArg Prod.snd heq + have qeq : q = p := by + apply Prod.ext <;> dsimp [target] at first_eq second_eq ⊢ <;> linarith + exact qeq ▸ hq + +private theorem image_subsingletonAt436 : + (by + classical + exact + ∀ (f : GaussianInt → GaussianInt), Function.Injective f → ∀ (A : Set GaussianInt), ∀ (B : + Set GaussianInt), (A ∩ B).Subsingleton ↔ (f '' A ∩ f '' B).Subsingleton + ) := by + classical + intro f hf A B + constructor + · intro h x hx y hy + rcases hx with ⟨⟨a, ha, rfl⟩, ⟨b, hb, hab⟩⟩ + rcases hy with ⟨⟨c, hc, rfl⟩, ⟨d, hd, hcd⟩⟩ + have hab' : a = b := hf hab.symm + have hcd' : c = d := hf hcd.symm + subst b + subst d + exact congrArg f (h ⟨ha, hb⟩ ⟨hc, hd⟩) + · intro h a ha b hb + apply hf + exact h ⟨⟨a, ha.1, rfl⟩, ⟨a, ha.2, rfl⟩⟩ + ⟨⟨b, hb.1, rfl⟩, ⟨b, hb.2, rfl⟩⟩ + +end TilingTransportProof + +namespace TilingTransportDetails + +private theorem quarter_injective : + (by + classical + exact + Function.Injective GaussianQuarterTurn ) := by + classical + intro a b hab + apply Zsqrtd.ext + · simpa [GaussianQuarterTurn] using + congrArg (fun z : GaussianInt => z.im) hab + · simpa [GaussianQuarterTurn] using + congrArg (fun z : GaussianInt => z.re) hab + +private theorem reflection_injective : + (by + classical + exact + Function.Injective (fun z : GaussianInt => -GaussianReflection z) ) := by + classical + intro a b hab + apply Zsqrtd.ext + · simpa [GaussianReflection] using + congrArg (fun z : GaussianInt => z.re) hab + · simpa [GaussianReflection] using + congrArg (fun z : GaussianInt => z.im) hab + +private theorem composite_injective : + (by + classical + exact + Function.Injective (fun z : GaussianInt => GaussianQuarterTurn (GaussianQuarterTurn + (GaussianReflection z))) ) := by + classical + intro a b hab + apply Zsqrtd.ext + · simpa [GaussianQuarterTurn, GaussianReflection] using + congrArg (fun z : GaussianInt => z.re) hab + · simpa [GaussianQuarterTurn, GaussianReflection] using + congrArg (fun z : GaussianInt => z.im) hab + +end TilingTransportDetails + +namespace TilingTransportCases + +private theorem negation : + (∀ T, LatticeTile T ↔ + LatticeTile (BandPackingSymmetryTileAction BandPackingSymmetry.negate T)) ∧ + (∀ T, TileArea (BandPackingSymmetryTileAction BandPackingSymmetry.negate T) = TileArea T) ∧ + (∀ T U, + BandPackingSymmetryTileAction BandPackingSymmetry.negate (TileCellComplement T U) = + TileCellComplement (BandPackingSymmetryTileAction BandPackingSymmetry.negate T) + (BandPackingSymmetryTileAction BandPackingSymmetry.negate U)) ∧ + (∀ T U, TileTouching T U ↔ + TileTouching (BandPackingSymmetryTileAction BandPackingSymmetry.negate T) + (BandPackingSymmetryTileAction BandPackingSymmetry.negate U)) ∧ + (∀ T, QuarterTurnSymmetric T ↔ + QuarterTurnSymmetric (BandPackingSymmetryTileAction BandPackingSymmetry.negate T)) ∧ + (∀ T U V, TouchingTriple T U V ↔ + TouchingTriple (BandPackingSymmetryTileAction BandPackingSymmetry.negate T) + (BandPackingSymmetryTileAction BandPackingSymmetry.negate U) + (BandPackingSymmetryTileAction BandPackingSymmetry.negate V)) ∧ + (∀ T v, + BandPackingSymmetryTileAction BandPackingSymmetry.negate (TileTranslation T v) = + TileTranslation (BandPackingSymmetryTileAction BandPackingSymmetry.negate T) + (BandPackingSymmetryVectorAction BandPackingSymmetry.negate v)) ∧ + (∀ T, FootprintVertices (BandPackingSymmetryTileAction BandPackingSymmetry.negate T) = + BandPackingSymmetryVectorAction BandPackingSymmetry.negate '' FootprintVertices T) ∧ + (∀ T, FootprintEdges (BandPackingSymmetryTileAction BandPackingSymmetry.negate T) = + (fun e : Finset GaussianInt => + e.image (BandPackingSymmetryVectorAction BandPackingSymmetry.negate)) '' + FootprintEdges T) ∧ + (∀ T U, + (FootprintVertices T ∩ FootprintVertices U).Subsingleton ↔ + (FootprintVertices (BandPackingSymmetryTileAction BandPackingSymmetry.negate T) ∩ + FootprintVertices + (BandPackingSymmetryTileAction BandPackingSymmetry.negate U)).Subsingleton) ∧ + ∀ (S : Fin 3 → Bool → ProtoTile) (u v : GaussianInt) + (o : PeriodicSubtileIndex), + BandPackingSymmetryTileAction BandPackingSymmetry.negate + (SubtileOccurrenceInterpretation S u v o) = + SubtileOccurrenceInterpretation + (fun i s => BandPackingSymmetryTileAction BandPackingSymmetry.negate (S i s)) + (BandPackingSymmetryVectorAction BandPackingSymmetry.negate u) + (BandPackingSymmetryVectorAction BandPackingSymmetry.negate v) o := by + have quarter_symmetry := TilingTransportProof.quarter_symmetryAt181 + have image_subsingleton (f : GaussianInt → GaussianInt) + (hf : Function.Injective f) (A B : Set GaussianInt) := + TilingTransportProof.image_subsingletonAt247 f hf A B + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro T + exact (TileDiskAreaCovariance T 0).2.1 + · intro T + exact (TileDiskAreaCovariance T 0).2.2.2.2.1 + · intro T U + exact (TileCellComplementCovariance T U 0).2.1 + · intro T U + exact (TileTouchingCovariance T U 0).2.1 + · intro T + exact quarter_symmetry T + · intro T U V + exact (TouchingTripleCovariance T U V 0).2.1 + · intro T v + exact (TilingTransportProof.quarter_translate) T v + · intro T + have h := (TileQuarterTurnFormulas T).2.2.2.2.2.1 + change FootprintVertices (TileQuarterTurn T) = + GaussianQuarterTurn '' FootprintVertices T + exact h + · intro T + simp only [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + change FootprintEdges (TileQuarterTurn T) = + (fun e : Finset GaussianInt => e.image GaussianQuarterTurn) '' + FootprintEdges T + exact (TileQuarterTurnFormulas T).2.2.2.2.2.2.1 + · intro T U + simp only [BandPackingSymmetryTileAction] + rw [(TileQuarterTurnFormulas T).2.2.2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.2.2.1] + exact + (image_subsingleton GaussianQuarterTurn (TilingTransportDetails.quarter_injective) + (FootprintVertices T) (FootprintVertices U)) + · intro S u v o + change TileQuarterTurn (SubtileOccurrenceInterpretation S u v o) = _ + exact (SubtileOccurrenceInterpretationCovariance S u v 0 o).2.1 + +private theorem conjugation : + (∀ T, LatticeTile T ↔ + LatticeTile (BandPackingSymmetryTileAction BandPackingSymmetry.conjugate T)) ∧ + (∀ T, TileArea (BandPackingSymmetryTileAction BandPackingSymmetry.conjugate T) = TileArea + T) ∧ + (∀ T U, + BandPackingSymmetryTileAction BandPackingSymmetry.conjugate (TileCellComplement T U) = + TileCellComplement (BandPackingSymmetryTileAction BandPackingSymmetry.conjugate T) + (BandPackingSymmetryTileAction BandPackingSymmetry.conjugate U)) ∧ + (∀ T U, TileTouching T U ↔ + TileTouching (BandPackingSymmetryTileAction BandPackingSymmetry.conjugate T) + (BandPackingSymmetryTileAction BandPackingSymmetry.conjugate U)) ∧ + (∀ T, QuarterTurnSymmetric T ↔ + QuarterTurnSymmetric (BandPackingSymmetryTileAction BandPackingSymmetry.conjugate T)) ∧ + (∀ T U V, TouchingTriple T U V ↔ + TouchingTriple (BandPackingSymmetryTileAction BandPackingSymmetry.conjugate T) + (BandPackingSymmetryTileAction BandPackingSymmetry.conjugate U) + (BandPackingSymmetryTileAction BandPackingSymmetry.conjugate V)) ∧ + (∀ T v, + BandPackingSymmetryTileAction BandPackingSymmetry.conjugate (TileTranslation T v) = + TileTranslation (BandPackingSymmetryTileAction BandPackingSymmetry.conjugate T) + (BandPackingSymmetryVectorAction BandPackingSymmetry.conjugate v)) ∧ + (∀ T, FootprintVertices (BandPackingSymmetryTileAction BandPackingSymmetry.conjugate T) = + BandPackingSymmetryVectorAction BandPackingSymmetry.conjugate '' FootprintVertices T) ∧ + (∀ T, FootprintEdges (BandPackingSymmetryTileAction BandPackingSymmetry.conjugate T) = + (fun e : Finset GaussianInt => + e.image (BandPackingSymmetryVectorAction BandPackingSymmetry.conjugate)) '' + FootprintEdges T) ∧ + (∀ T U, + (FootprintVertices T ∩ FootprintVertices U).Subsingleton ↔ + (FootprintVertices (BandPackingSymmetryTileAction BandPackingSymmetry.conjugate T) ∩ + FootprintVertices + (BandPackingSymmetryTileAction BandPackingSymmetry.conjugate U)).Subsingleton) ∧ + ∀ (S : Fin 3 → Bool → ProtoTile) (u v : GaussianInt) + (o : PeriodicSubtileIndex), + BandPackingSymmetryTileAction BandPackingSymmetry.conjugate + (SubtileOccurrenceInterpretation S u v o) = + SubtileOccurrenceInterpretation + (fun i s => BandPackingSymmetryTileAction BandPackingSymmetry.conjugate (S i s)) + (BandPackingSymmetryVectorAction BandPackingSymmetry.conjugate u) + (BandPackingSymmetryVectorAction BandPackingSymmetry.conjugate v) o := by + have quarter_symmetry := TilingTransportProof.quarter_symmetryAt307 + have image_subsingleton (f : GaussianInt → GaussianInt) + (hf : Function.Injective f) (A B : Set GaussianInt) := + TilingTransportProof.image_subsingletonAt436 f hf A B + have reflection_injective : Function.Injective + (fun z : GaussianInt => -GaussianReflection z) := + TilingTransportDetails.reflection_injective + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro T + exact ((TileDiskAreaCovariance T 0).2.2.1).trans + ((TileDiskAreaCovariance (TileReflection T) 0).2.1.trans + ((TileDiskAreaCovariance (TileQuarterTurn (TileReflection T)) 0).2.1)) + · intro T + exact (TileDiskAreaCovariance (TileQuarterTurn (TileReflection T)) 0).2.2.2.2.1.trans + ((TileDiskAreaCovariance (TileReflection T) 0).2.2.2.2.1.trans + (TileDiskAreaCovariance T 0).2.2.2.2.2) + · intro T U + simp only [BandPackingSymmetryTileAction] + rw [(TileCellComplementCovariance T U 0).2.2, + (TileCellComplementCovariance (TileReflection T) (TileReflection U) 0).2.1, + (TileCellComplementCovariance (TileQuarterTurn (TileReflection T)) + (TileQuarterTurn (TileReflection U)) 0).2.1] + · intro T U + simp only [BandPackingSymmetryTileAction] + exact (TileTouchingCovariance T U 0).2.2.trans + ((TileTouchingCovariance (TileReflection T) (TileReflection U) 0).2.1.trans + ((TileTouchingCovariance (TileQuarterTurn (TileReflection T)) + (TileQuarterTurn (TileReflection U)) 0).2.1)) + · intro T + simpa [BandPackingSymmetryTileAction] using + ((TilingTransportProof.reflection_symmetry) T).trans + ((quarter_symmetry (TileReflection T)).trans + (quarter_symmetry (TileQuarterTurn (TileReflection T)))) + · intro T U V + simp only [BandPackingSymmetryTileAction] + exact (TouchingTripleCovariance T U V 0).2.2.trans + ((TouchingTripleCovariance (TileReflection T) (TileReflection U) + (TileReflection V) 0).2.1.trans + ((TouchingTripleCovariance (TileQuarterTurn (TileReflection T)) + (TileQuarterTurn (TileReflection U)) + (TileQuarterTurn (TileReflection V)) 0).2.1)) + · intro T v + simp only [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + cases T with + | mk cells anchor => + apply congrArg₂ (fun c : FiniteTile => fun d : GaussianInt => ProtoTile.mk c d) + · simp? [TileQuarterTurn, TileReflection, TileTranslation, + GaussianTranslation, Finset.image_image, Function.comp_def] + congr 1 + funext x + ext <;> simp [GaussianQuarterTurn, GaussianReflection]; ring + · simp? [TileQuarterTurn, TileReflection, TileTranslation, + GaussianTranslation, GaussianQuarterTurn, GaussianReflection] + ext <;> simp []; ring + · intro T + simp only [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + rw [(TileQuarterTurnFormulas (TileQuarterTurn (TileReflection T))).2.2.2.2.2.1, + (TileQuarterTurnFormulas (TileReflection T)).2.2.2.2.2.1, + (TileReflectionFormulas T).2.2.2.2.2.1] + simp only [Set.image_image] + congr 1 + · intro T + simp only [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + rw [(TileQuarterTurnFormulas (TileQuarterTurn (TileReflection T))).2.2.2.2.2.2.1, + (TileQuarterTurnFormulas (TileReflection T)).2.2.2.2.2.2.1, + (TileReflectionFormulas T).2.2.2.2.2.2.1] + simp only [Set.image_image] + congr 1 + funext e + ext z + constructor + · intro hz + rcases Finset.mem_image.mp hz with ⟨y, hy, rfl⟩ + rcases Finset.mem_image.mp hy with ⟨w, hw, rfl⟩ + rcases Finset.mem_image.mp hw with ⟨x, hx, rfl⟩ + refine Finset.mem_image.mpr ⟨x, hx, ?_⟩ + ext <;> simp [GaussianQuarterTurn, GaussianReflection] + · intro hz + rcases Finset.mem_image.mp hz with ⟨x, hx, rfl⟩ + refine Finset.mem_image.mpr + ⟨GaussianQuarterTurn (GaussianReflection x), ?_, ?_⟩ + · refine Finset.mem_image.mpr + ⟨GaussianReflection x, Finset.mem_image.mpr ⟨x, hx, rfl⟩, rfl⟩ + · ext <;> simp [GaussianQuarterTurn, GaussianReflection] + · intro T U + simp only [BandPackingSymmetryTileAction] + rw [(TileQuarterTurnFormulas (TileQuarterTurn (TileReflection T))).2.2.2.2.2.1, + (TileQuarterTurnFormulas (TileReflection T)).2.2.2.2.2.1, + (TileReflectionFormulas T).2.2.2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn (TileReflection U))).2.2.2.2.2.1, + (TileQuarterTurnFormulas (TileReflection U)).2.2.2.2.2.1, + (TileReflectionFormulas U).2.2.2.2.2.1] + simp only [Set.image_image] + exact image_subsingleton (fun z : GaussianInt => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianReflection z))) + (TilingTransportDetails.composite_injective) _ _ + · intro S u v o + simp only [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + rw [(SubtileOccurrenceInterpretationCovariance S u v 0 o).2.2, + (SubtileOccurrenceInterpretationCovariance + (fun i s => TileReflection (S i s)) (GaussianReflection u) + (GaussianReflection v) 0 o).2.1, + (SubtileOccurrenceInterpretationCovariance + (fun i s => TileQuarterTurn (TileReflection (S i s))) + (GaussianQuarterTurn (GaussianReflection u)) + (GaussianQuarterTurn (GaussianReflection v)) 0 o).2.1] + congr 1 + +end TilingTransportCases + +theorem BandPackingSymmetryTilingTransport (g : BandPackingSymmetry) : + (∀ T, LatticeTile T ↔ + LatticeTile (BandPackingSymmetryTileAction g T)) ∧ + (∀ T, TileArea (BandPackingSymmetryTileAction g T) = TileArea T) ∧ + (∀ T U, + BandPackingSymmetryTileAction g (TileCellComplement T U) = + TileCellComplement (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryTileAction g U)) ∧ + (∀ T U, TileTouching T U ↔ + TileTouching (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryTileAction g U)) ∧ + (∀ T, QuarterTurnSymmetric T ↔ + QuarterTurnSymmetric (BandPackingSymmetryTileAction g T)) ∧ + (∀ T U V, TouchingTriple T U V ↔ + TouchingTriple (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryTileAction g U) + (BandPackingSymmetryTileAction g V)) ∧ + (∀ T v, + BandPackingSymmetryTileAction g (TileTranslation T v) = + TileTranslation (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryVectorAction g v)) ∧ + (∀ T, FootprintVertices (BandPackingSymmetryTileAction g T) = + BandPackingSymmetryVectorAction g '' FootprintVertices T) ∧ + (∀ T, FootprintEdges (BandPackingSymmetryTileAction g T) = + (fun e : Finset GaussianInt => + e.image (BandPackingSymmetryVectorAction g)) '' FootprintEdges T) ∧ + (∀ T U, + (FootprintVertices T ∩ FootprintVertices U).Subsingleton ↔ + (FootprintVertices (BandPackingSymmetryTileAction g T) ∩ + FootprintVertices + (BandPackingSymmetryTileAction g U)).Subsingleton) ∧ + ∀ (S : Fin 3 → Bool → ProtoTile) (u v : GaussianInt) + (o : PeriodicSubtileIndex), + BandPackingSymmetryTileAction g + (SubtileOccurrenceInterpretation S u v o) = + SubtileOccurrenceInterpretation + (fun i s => BandPackingSymmetryTileAction g (S i s)) + (BandPackingSymmetryVectorAction g u) + (BandPackingSymmetryVectorAction g v) o := by +-- BODY + induction g with + | identity => + simp [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + | shift w => + simp [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + | negate => exact TilingTransportCases.negation + | conjugate => exact TilingTransportCases.conjugation + | comp g h ihg ihh => + rcases ihg with ⟨lg, ag, cg, tg, sg, qg, vg, fg, eg, pg, og⟩ + rcases ihh with ⟨lh, ah, ch, th, sh, qh, vh, fh, eh, ph, oh⟩ + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro T + exact (lh T).trans (lg _) + · intro T + change TileArea (BandPackingSymmetryTileAction g + (BandPackingSymmetryTileAction h T)) = TileArea T + rw [ag, ah] + · intro T U + simp only [BandPackingSymmetryTileAction] + rw [ch, cg] + · intro T U + exact (th T U).trans (tg _ _) + · intro T + exact (sh T).trans (sg _) + · intro T U V + exact (qh T U V).trans (qg _ _ _) + · intro T v + simp only [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + rw [vh, vg] + · intro T + simp only [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + rw [fg, fh] + ext x + constructor + · rintro ⟨y, ⟨z, hz, rfl⟩, rfl⟩ + simpa [BandPackingSymmetryVectorAction] using ⟨z, hz, rfl⟩ + · rintro ⟨z, hz, rfl⟩ + refine ⟨BandPackingSymmetryVectorAction h z, ?_, rfl⟩ + exact ⟨z, hz, rfl⟩ + · intro T + simp only [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + rw [eg, eh] + simp only [Set.image_image, Finset.image_image] + congr 1 + · intro T U + change (FootprintVertices T ∩ FootprintVertices U).Subsingleton ↔ + (FootprintVertices (BandPackingSymmetryTileAction g + (BandPackingSymmetryTileAction h T)) ∩ + FootprintVertices (BandPackingSymmetryTileAction g + (BandPackingSymmetryTileAction h U))).Subsingleton + exact (ph T U).trans (pg _ _) + · intro S u v o + simp only [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + rw [oh, og] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean new file mode 100644 index 0000000000..d6682920bc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.GaussianReflection + +-- [TABLET NODE: BandPackingSymmetryVectorAction] + +/-! +# BandPackingSymmetryVectorAction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The induced action of a band-packing symmetry word on a canonical Gaussian +lattice vector is defined as follows. The identity fixes $v$, coordinate +negation acts by the quarter-turn $v\mapsto iv$, coordinate conjugation acts +by $v\mapsto-\overline v$, and every shift fixes $v$. For +$\operatorname{comp}(g,h)$, first apply the action of $h$ and then the action +of $g$. These choices use the canonical primitive orientation of the band +vectors; they do not attach data to a constructor history for a circle. +-/ +def BandPackingSymmetryVectorAction : + BandPackingSymmetry → GaussianInt → GaussianInt := +-- BODY + fun g v => match g with + | .identity => v + | .negate => GaussianQuarterTurn v + | .conjugate => -GaussianReflection v + | .shift _ => v + | .comp g h => + BandPackingSymmetryVectorAction g + (BandPackingSymmetryVectorAction h v) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandParentBoundaryGenealogy.lean b/LeanPool/ApollonianSuperharmonic/BandParentBoundaryGenealogy.lean new file mode 100644 index 0000000000..5592aa7c75 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandParentBoundaryGenealogy.lean @@ -0,0 +1,160 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple + +-- [TABLET NODE: BandParentBoundaryGenealogy] + +/-! +# BandParentBoundaryGenealogy + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandParentBoundaryGenealogy (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) : + (((q 1).1 = 1 ∧ (q 2).1 = 0 ∧ (q 3).1 = 1) ∨ + ((q 1).1 = 1 ∧ (q 2).1 = 1 ∧ (q 3).1 = 0) ∨ + ((q 1).1 = 0 ∧ (q 2).1 = 1 ∧ (q 3).1 = 1)) ∨ + (∃ p : Fin 4 → CircleCoordinates, + ProperBandQuadruple p ∧ + q = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] ∧ + p 0 = q 1 ∧ p 2 = q 2 ∧ p 3 = q 3 ∧ + (q 2).1 < (q 1).1 ∧ (q 3).1 < (q 1).1) ∨ + (∃ p : Fin 4 → CircleCoordinates, + ProperBandQuadruple p ∧ + ![q 0, q 2, q 3, q 1] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] ∧ + p 0 = q 2 ∧ p 2 = q 3 ∧ p 3 = q 1 ∧ + (q 3).1 < (q 2).1 ∧ (q 1).1 < (q 2).1) ∨ + (∃ p : Fin 4 → CircleCoordinates, + ProperBandQuadruple p ∧ + ![q 0, q 3, q 1, q 2] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] ∧ + p 0 = q 3 ∧ p 2 = q 1 ∧ p 3 = q 2 ∧ + (q 1).1 < (q 3).1 ∧ (q 2).1 < (q 3).1) := by +-- BODY + have claim : ∀ r : Fin 4 → CircleCoordinates, + SemiProperQuadruple r → ProperBandQuadruple r → + (((r 1).1 = 1 ∧ (r 2).1 = 0 ∧ (r 3).1 = 1) ∨ + ((r 1).1 = 1 ∧ (r 2).1 = 1 ∧ (r 3).1 = 0) ∨ + ((r 1).1 = 0 ∧ (r 2).1 = 1 ∧ (r 3).1 = 1)) ∨ + (∃ p : Fin 4 → CircleCoordinates, + ProperBandQuadruple p ∧ + r = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] ∧ + p 0 = r 1 ∧ p 2 = r 2 ∧ p 3 = r 3 ∧ + (r 2).1 < (r 1).1 ∧ (r 3).1 < (r 1).1) ∨ + (∃ p : Fin 4 → CircleCoordinates, + ProperBandQuadruple p ∧ + ![r 0, r 2, r 3, r 1] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] ∧ + p 0 = r 2 ∧ p 2 = r 3 ∧ p 3 = r 1 ∧ + (r 3).1 < (r 2).1 ∧ (r 1).1 < (r 2).1) ∨ + (∃ p : Fin 4 → CircleCoordinates, + ProperBandQuadruple p ∧ + ![r 0, r 3, r 1, r 2] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] ∧ + p 0 = r 3 ∧ p 2 = r 1 ∧ p 3 = r 2 ∧ + (r 1).1 < (r 3).1 ∧ (r 2).1 < (r 3).1) := by + intro r hr + induction hr with + | base z => + intro hproper + have hbad := hproper.2 0 + simp at hbad + | @rotate r hr ih => + intro hproper + have old : ProperBandQuadruple r := by + refine ⟨hr, ?_⟩ + intro j + fin_cases j + · simpa using hproper.2 2 + · simpa using hproper.2 0 + · simpa using hproper.2 1 + rcases ih old with roots | first | second | third + · rcases roots with roots | roots | roots + · left; right; right + rcases roots with ⟨a, b, c⟩ + exact ⟨by simpa using b, by simpa using c, by simpa using a⟩ + · left; left + rcases roots with ⟨a, b, c⟩ + exact ⟨by simpa using b, by simpa using c, by simpa using a⟩ + · left; right; left + rcases roots with ⟨a, b, c⟩ + exact ⟨by simpa using b, by simpa using c, by simpa using a⟩ + · right; right; right + rcases first with ⟨p, hp, hsucc, h0, h2, h3, h2lt, h3lt⟩ + exact ⟨p, hp, by + apply Eq.trans ?_ hsucc + funext i + fin_cases i <;> rfl, + h0, h2, h3, + by simpa using h2lt, by simpa using h3lt⟩ + · right; left + rcases second with ⟨p, hp, hsucc, h0, h2, h3, h3lt, h1lt⟩ + exact ⟨p, hp, hsucc, h0, h2, h3, + by simpa using h3lt, by simpa using h1lt⟩ + · right; right; left + rcases third with ⟨p, hp, hsucc, h0, h2, h3, h1lt, h2lt⟩ + exact ⟨p, hp, by + apply Eq.trans ?_ hsucc + funext i + fin_cases i <;> rfl, + h0, h2, h3, + by simpa using h1lt, by simpa using h2lt⟩ + | @successor r hr ih => + intro hproper + have forest := SemiProperForestClassification r hr + rcases forest with ⟨nonneg, cases⟩ + rcases cases with root | root | root | old + · rcases root with ⟨z, hz⟩ + have hbad := hproper.2 0 + rw [hz] at hbad + simp at hbad + · rcases root with ⟨z, hz⟩ + left + rw [hz] + simp + · rcases root with ⟨z, hz⟩ + left + rw [hz] + simp + · right + left + refine ⟨r, old, rfl, ?_, ?_, ?_, ?_, ?_⟩ + · rfl + · rfl + · rfl + · simpa using old.2 1 + · simpa using old.2 2 + exact claim q hq.1 hq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandParentRotationOccurrenceCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandParentRotationOccurrenceCovariance.lean new file mode 100644 index 0000000000..404fa25292 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandParentRotationOccurrenceCovariance.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple + +-- [TABLET NODE: BandParentRotationOccurrenceCovariance] + +/-! +# BandParentRotationOccurrenceCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandParentRotationOccurrenceCovariance + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (a : Fin 3) (T : ProtoTile) (_hT : BandPrototile (q 0) T) + (S : Fin 3 → Bool → ProtoTile) + (hS : ∀ i s, BandSubtileOccurrence q T i s (S i s)) + (hunion : ∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (S i s).cells) : + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + let Sa : Fin 3 → Bool → ProtoTile := fun i s => S (a + i) s + ProperBandQuadruple qa ∧ + (∀ i s, BandSubtileOccurrence qa T i s (Sa i s)) ∧ + (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (Sa i s).cells) := by +-- BODY + dsimp + fin_cases a + · refine ⟨?_, ?_, ?_⟩ + · have heq : ![q 0, q 1, q 2, q 3] = q := by + funext i + fin_cases i <;> rfl + change ProperBandQuadruple ![q 0, q 1, q 2, q 3] + rw [heq] + exact hq + · intro i s + simp only [Fin.isValue, Fin.zero_eta, Fin.succ_zero_eq_one, zero_add, + Fin.succ_one_eq_two, Fin.reduceSucc] + have heq : ![q 0, q 1, q 2, q 3] = q := by + funext j + fin_cases j <;> rfl + rw [heq] + exact hS i s + · simpa using hunion + · refine ⟨?_, ?_, ?_⟩ + · refine ⟨SemiProperQuadruple.rotate hq.1, ?_⟩ + intro i + fin_cases i + · simpa using hq.2 (1 : Fin 3) + · simpa using hq.2 (2 : Fin 3) + · simpa using hq.2 (0 : Fin 3) + · intro i s + fin_cases i + · simpa [BandSubtileOccurrence] using hS (1 : Fin 3) s + · simpa [BandSubtileOccurrence] using hS (2 : Fin 3) s + · simpa [BandSubtileOccurrence] using hS (0 : Fin 3) s + · intro x + constructor + · intro hx + rcases (hunion x).1 hx with ⟨i, s, hi⟩ + refine ⟨i - 1, s, ?_⟩ + simpa using hi + · rintro ⟨i, s, hi⟩ + apply (hunion x).2 + exact ⟨1 + i, s, hi⟩ + · refine ⟨?_, ?_, ?_⟩ + · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1), ?_⟩ + intro i + fin_cases i + · simpa using hq.2 (2 : Fin 3) + · simpa using hq.2 (0 : Fin 3) + · simpa using hq.2 (1 : Fin 3) + · intro i s + fin_cases i + · simpa [BandSubtileOccurrence] using hS (2 : Fin 3) s + · simpa [BandSubtileOccurrence] using hS (0 : Fin 3) s + · simpa [BandSubtileOccurrence] using hS (1 : Fin 3) s + · intro x + constructor + · intro hx + rcases (hunion x).1 hx with ⟨i, s, hi⟩ + refine ⟨i - 2, s, ?_⟩ + simpa using hi + · rintro ⟨i, s, hi⟩ + apply (hunion x).2 + exact ⟨2 + i, s, hi⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPeriodicOdometer.lean b/LeanPool/ApollonianSuperharmonic/BandPeriodicOdometer.lean new file mode 100644 index 0000000000..9708a3971e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPeriodicOdometer.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CurvatureOnePeriodicOdometer +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicQuadraticRemainder +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureGeneratorCocycles + +-- [TABLET NODE: BandPeriodicOdometer] + +/-! +# BandPeriodicOdometer + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandPeriodicOdometer (C : BandCircle) : + ∃ (T : ProtoTile) (h : PartialOdometer) (g : IntegerLatticeFunction), + BandPrototile C.1.1 T ∧ TileOdometer C.1.1 T h ∧ + GlobalOdometerExtends g h ∧ + (∀ v, v ∈ TilingLattice C → ∃ a : GaussianInt, + Matrix.mulVec (CircleMatrix C) ![(v.re : ℝ), (v.im : ℝ)] = + ![(a.re : ℝ), (a.im : ℝ)] ∧ + ∀ x, g (x + v) = g x + x.re * a.re + x.im * a.im + g v) ∧ + ∃ b : ℝ × ℝ, ∀ v, v ∈ TilingLattice C → ∀ x, + (g (x + v) : ℝ) - LatticeQuadraticForm (CircleMatrix C) (x + v) - + (b.1 * (x + v).re + b.2 * (x + v).im) = + (g x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x - + (b.1 * x.re + b.2 * x.im) := by +-- BODY + by_cases hc : C.1.1.1 = 1 + · obtain ⟨z, hz⟩ := CurvatureOneBandCircleClassification C hc + let T : ProtoTile := ⟨{0}, 0⟩ + let h : PartialOdometer := CurvatureOneOdometer z + let g : IntegerLatticeFunction := fun x => + (1 + z.re) * (x.re * (x.re - 1) / 2) - + z.re * (x.im * (x.im - 1) / 2) + z.im * x.re * x.im + have result := CurvatureOnePeriodicOdometer C z hz + dsimp at result + obtain ⟨hT, htile, hdomain, hvalue, hext, hrep, hcocycle, hperiod⟩ := result + exact ⟨T, h, g, hT, htile, hext, hcocycle, hperiod⟩ + · have hpos := C.2 + have hcurv : 1 < C.1.1.1 := by omega + obtain ⟨q, T, h, g, hq, hqC, hT, htile, hext, hzero, hgen⟩ := + PositiveCurvatureGeneratorCocycles C hcurv + have hcocycle := TilingLatticeCocycleExtension C q hq hqC g hgen + obtain ⟨b, hperiod⟩ := PeriodicQuadraticRemainder C g hcocycle + exact ⟨T, h, g, hT, htile, hext, hcocycle, ⟨b, hperiod⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean b/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean new file mode 100644 index 0000000000..edf5f885a3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean @@ -0,0 +1,546 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOdometerInteriorTable +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandTileTopologyApplication +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalMaximality +public import LeanPool.ApollonianSuperharmonic.ExactTileTiling +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.FordExceptionalMaximality +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicRepresentative +public import LeanPool.ApollonianSuperharmonic.LatticeFundamentalSet +public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm +public import LeanPool.ApollonianSuperharmonic.PeriodicBoundaryWebLaplacian +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.QuadraticGrowthAtInfinity +public import LeanPool.ApollonianSuperharmonic.RegularTileFamily +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TilingLattice +public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex + +-- [TABLET NODE: BandPeriodicSuperharmonicity] + +/-! +# BandPeriodicSuperharmonicity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PeriodicSuperharmonicGeometry + +private theorem hsym : + (by + classical + exact + ∀ (C : BandCircle), (CircleMatrix C).IsSymm ) := by + classical + intro C + unfold Matrix.IsSymm CircleMatrix + dsimp + ext i j + fin_cases i <;> fin_cases j <;> rfl + +private theorem hRne : + (by + classical + exact + ∀ (C : BandCircle), ∀ (R : Finset GaussianInt), (LatticeFundamentalSet (TilingLattice C) + R) → (R.Nonempty) ) := by + classical + intro C R hR + obtain ⟨r, hr, hv⟩ := hR 0 + exact ⟨r, hr.1⟩ + +private theorem hvals : + (by + classical + exact + ∀ (C : BandCircle), ∀ (g : IntegerLatticeFunction), ∀ (b : ℝ × ℝ), ∀ (R : Finset + GaussianInt), (R.Nonempty) → ( + let vals : Finset ℝ := R.image (fun r => |(g r : ℝ) - + LatticeQuadraticForm (CircleMatrix C) r - + (b.1 * r.re + b.2 * r.im)|) + vals.Nonempty) ) := by + classical + intro C g b R hRne vals + obtain ⟨r, hr⟩ := hRne + exact ⟨_, Finset.mem_image.mpr ⟨r, hr, rfl⟩⟩ + +private theorem hF : + (by + classical + exact + ∀ (C : BandCircle), ∀ (g : IntegerLatticeFunction), ∀ (b : ℝ × ℝ), ∀ (x : GaussianInt), ∀ + (r : GaussianInt), ((↑(g (r + (x - r))) : ℝ) - LatticeQuadraticForm (CircleMatrix C) + (r + (x - r)) - (b.1 * (↑(r + (x - r)).re : ℝ) + b.2 * (↑(r + (x - r)).im : ℝ)) = + (↑(g r) : ℝ) - LatticeQuadraticForm (CircleMatrix C) r - (b.1 * (↑r.re : ℝ) + b.2 * + (↑r.im : ℝ))) → ((g x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x - (b.1 * x.re + + b.2 * x.im) = (g r : ℝ) - LatticeQuadraticForm (CircleMatrix C) r - (b.1 * r.re + b.2 + * r.im)) ) := by + classical + intro C g b x r hrem + convert hrem using 1; simp [sub_eq_add_neg, add_assoc] + +private theorem hM : + (by + classical + exact + ∀ (C : BandCircle), ∀ (g : IntegerLatticeFunction), ∀ (b : ℝ × ℝ), ∀ (R : Finset + GaussianInt), + let vals : Finset ℝ := R.image (fun r => |(g r : ℝ) - + LatticeQuadraticForm (CircleMatrix C) r - + (b.1 * r.re + b.2 * r.im)|) + ∀ (hvals : vals.Nonempty), + let M : ℝ := vals.sup' hvals id + ∀ (x : GaussianInt), ∀ (r : GaussianInt), (r ∈ R ∧ x - r ∈ TilingLattice C) → (|(g r : ℝ) + - LatticeQuadraticForm (CircleMatrix C) r - (b.1 * r.re + b.2 * r.im)| ≤ M) ) := by + classical + intro C g b R vals hvals M x r hr + dsimp [M, vals] + exact Finset.le_sup' (id : ℝ → ℝ) + (show |(g r : ℝ) - LatticeQuadraticForm (CircleMatrix C) r - + (b.1 * r.re + b.2 * r.im)| ∈ vals from + Finset.mem_image.mpr ⟨r, hr.1, rfl⟩) + +private theorem hcross : + (by + classical + exact + ∀ (b : ℝ × ℝ), ∀ (ε : ℝ), ((0 : ℝ) < ε) → (∀ (x : GaussianInt), |b.1 * x.re + b.2 * x.im| + ≤ ε / 4 * ((x.re : ℝ)^2 + (x.im : ℝ)^2) + (b.1^2 + b.2^2) / ε) ) := by + classical + intro b ε hε x + have ha : |b.1 * (x.re : ℝ)| ≤ ε / 4 * (x.re : ℝ)^2 + |b.1|^2 / ε := by + have heq : ε / 4 * (x.re : ℝ)^2 + |b.1|^2 / ε = + (ε^2 * (x.re : ℝ)^2 / 4 + |b.1|^2) / ε := by field_simp + rw [heq] + apply (le_div_iff₀ hε).2 + rw [abs_mul] + have hs := sq_nonneg (ε * |(x.re : ℝ)| - 2 * |b.1|) + nlinarith [sq_abs (x.re : ℝ), sq_abs b.1] + have hb' : |b.2 * (x.im : ℝ)| ≤ ε / 4 * (x.im : ℝ)^2 + |b.2|^2 / ε := by + have heq : ε / 4 * (x.im : ℝ)^2 + |b.2|^2 / ε = + (ε^2 * (x.im : ℝ)^2 / 4 + |b.2|^2) / ε := by field_simp + rw [heq] + apply (le_div_iff₀ hε).2 + rw [abs_mul] + have hs := sq_nonneg (ε * |(x.im : ℝ)| - 2 * |b.2|) + nlinarith [sq_abs (x.im : ℝ), sq_abs b.2] + calc + |b.1 * x.re + b.2 * x.im| ≤ |b.1 * x.re| + |b.2 * x.im| := abs_add_le _ _ + _ ≤ (ε / 4 * (x.re : ℝ)^2 + |b.1|^2 / ε) + + (ε / 4 * (x.im : ℝ)^2 + |b.2|^2 / ε) := add_le_add ha hb' + _ = ε / 4 * ((x.re : ℝ)^2 + (x.im : ℝ)^2) + + (b.1^2 + b.2^2) / ε := by + rw [sq_abs, sq_abs] + field_simp [ne_of_gt hε] + ring + +private theorem hbase : + (by + classical + exact + ∀ (C : BandCircle), ∀ (g : IntegerLatticeFunction), ∀ (b : ℝ × ℝ), ∀ (R : Finset + GaussianInt), + let vals : Finset ℝ := R.image (fun r => |(g r : ℝ) - + LatticeQuadraticForm (CircleMatrix C) r - + (b.1 * r.re + b.2 * r.im)|) + ∀ (hvals : vals.Nonempty), + let M : ℝ := vals.sup' hvals id + ∀ (ε : ℝ), ((0 : ℝ) < ε) → ( + let K : ℝ := M + (b.1 ^ 2 + b.2 ^ 2) / ε + ∀ (x : GaussianInt), ∀ (r : GaussianInt), ((g x : ℝ) - LatticeQuadraticForm (CircleMatrix + C) x - (b.1 * x.re + b.2 * x.im) = (g r : ℝ) - LatticeQuadraticForm (CircleMatrix C) + r - (b.1 * r.re + b.2 * r.im)) → ((|(g r : ℝ) - LatticeQuadraticForm (CircleMatrix C) + r - (b.1 * r.re + b.2 * r.im)| ≤ M) → ((|b.1 * x.re + b.2 * x.im| ≤ ε / 4 * ((x.re : + ℝ)^2 + (x.im : ℝ)^2) + (b.1^2 + b.2^2) / ε) → (|(g x : ℝ) - LatticeQuadraticForm + (CircleMatrix C) x| ≤ ε / 2 * ((x.re : ℝ)^2 + (x.im : ℝ)^2) + K)))) ) := by + classical + intro C g b R vals hvals M ε hε K x r hF hM hcross + calc + |↑(g x) - LatticeQuadraticForm (CircleMatrix C) x| = + |(↑(g x) - LatticeQuadraticForm (CircleMatrix C) x - + (b.1 * x.re + b.2 * x.im)) + (b.1 * x.re + b.2 * x.im)| := by + congr 1 + ring + _ ≤ |↑(g x) - LatticeQuadraticForm (CircleMatrix C) x - + (b.1 * x.re + b.2 * x.im)| + |b.1 * x.re + b.2 * x.im| := abs_add_le _ _ + _ = |↑(g r) - LatticeQuadraticForm (CircleMatrix C) r - + (b.1 * r.re + b.2 * r.im)| + |b.1 * x.re + b.2 * x.im| := by rw [hF] + _ ≤ M + (ε / 2 * ((x.re : ℝ)^2 + (x.im : ℝ)^2) + + (b.1^2 + b.2^2) / ε) := by + apply le_trans (add_le_add hM hcross) + have hs : 0 ≤ ε / 4 * ((x.re : ℝ)^2 + (x.im : ℝ)^2) := by positivity + nlinarith [hs] + _ = ε / 2 * ((x.re : ℝ)^2 + (x.im : ℝ)^2) + K := by dsimp [K]; ring + +private theorem hK : + (by + classical + exact + ∀ (C : BandCircle), ∀ (g : IntegerLatticeFunction), ∀ (b : ℝ × ℝ), ∀ (R : Finset + GaussianInt), + let vals : Finset ℝ := R.image (fun r => |(g r : ℝ) - + LatticeQuadraticForm (CircleMatrix C) r - + (b.1 * r.re + b.2 * r.im)|) + ∀ (hvals : vals.Nonempty), + let M : ℝ := vals.sup' hvals id + ∀ (ε : ℝ), ((0 : ℝ) < ε) → ( + let K : ℝ := M + (b.1 ^ 2 + b.2 ^ 2) / ε + ∀ (x : GaussianInt), ((2 : ℝ) * K / ε ≤ (↑x.re : ℝ) ^ (2 : ℕ) + (↑x.im : ℝ) ^ (2 : ℕ)) → + (K ≤ ε / 2 * ((x.re : ℝ)^2 + (x.im : ℝ)^2))) ) := by + classical + intro C g b R vals hvals M ε hε K x hx + have hx' := (div_le_iff₀ hε).mp hx + dsimp [K] + nlinarith + +private theorem tile_band : + (by + classical + exact + ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), TileOdometer c U k + → BandPrototile c U ) := by + classical + intro c U k ho + induction ho with + | line w z hw k hd => exact BandPrototile.line w z hw + | unit z x U k hU hd ht => + cases U with + | mk cells anchor => + simp_all? + exact BandPrototile.unit z x anchor + | @decompose q hq S U hs k hU hsub hc hf hcent hd hv hcomp hsl ih => + exact BandPrototile.decompose hq (fun i s => ih i s) hc hf hcent + +private theorem local_bound : + (by + classical + exact + ∀ (g : IntegerLatticeFunction), (∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : + PartialOdometer), TileOdometer c U k → BandPrototile c U) → (∀ (c : + CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), TileOdometer c U k → + GlobalOdometerExtends g k → ∀ y, y ∈ FootprintVertices U → y ∉ + BoundaryFootprintVertices U → FourNeighborLaplacian g y ≤ 1) ) := by + classical + intro g tile_band c U k ho + induction ho with + | line w z hw k hd => + intro hg y hy hny + exact (hny hy).elim + | unit z x U k hU hd ht => + intro hglob y hy hny + have hu : U.cells.Nonempty := by rw [hU]; simp + rw [FootprintVertices, ite_eq_left hu, hU] at hy + simp only [Set.mem_ofPred_eq, Finset.mem_singleton] at hy + rcases hy with ⟨w, ⟨hw, hy⟩⟩ + subst w + have hne : (⟨0, 1⟩ : GaussianInt) ≠ 0 := by + intro hh + have hm := congrArg (fun q : GaussianInt => q.im) hh + norm_num at hm + rcases hy with hy | hy | hy | hy + · exfalso + apply hny + simp only [BoundaryFootprintVertices, ite_eq_left hu, Set.mem_ofPred_eq] + refine ⟨{x, x + 1}, ?_, by simp [hy]⟩ + change ∃ z, _ + refine ⟨x, ?_⟩ + simp [hU, hne] + · exfalso + apply hny + simp only [BoundaryFootprintVertices, ite_eq_left hu, Set.mem_ofPred_eq] + refine ⟨{x, x + 1}, ?_, by simp [hy]⟩ + change ∃ z, _ + refine ⟨x, ?_⟩ + simp [hU, hne] + · exfalso + apply hny + simp only [BoundaryFootprintVertices, ite_eq_left hu, Set.mem_ofPred_eq] + refine ⟨{x, x + ⟨0, 1⟩}, ?_, by simp [hy]⟩ + change ∃ z, _ + refine ⟨x, ?_⟩ + simp [hU] + · exfalso + apply hny + simp only [BoundaryFootprintVertices, ite_eq_left hu, Set.mem_ofPred_eq] + refine ⟨{x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}, ?_, by simp [hy]⟩ + change ∃ z, _ + refine ⟨x + ⟨0, 1⟩, ?_⟩ + simp [hU, add_assoc, add_comm, add_left_comm, hne] + | @decompose q hq S U hs k hU hsub hc hf hcent hd hv hcomp hsl ih => + intro hglob y hy hny + obtain ⟨cc, hcc⟩ := hglob + have root_ext : GlobalOdometerExtends g k := ⟨cc, hcc⟩ + have child_ext (i : Fin 3) (s : Bool) : + GlobalOdometerExtends g (hs i s) := by + refine ⟨cc, ?_⟩ + intro t ht + have ht' : t ∈ k.domain := (hd t).2 ⟨i, s, ht⟩ + have hv' := hv i s t ht + rw [hcc t ht', hv'] + have root_band : BandPrototile (q 0) U := + BandPrototile.decompose hq (fun i s => tile_band _ _ _ (hsub i s)) hc hf hcent + have root_odo : TileOdometer (q 0) U k := + TileOdometer.decompose hq hU hsub hc hf hcent hd hv hcomp hsl + have occur (i : Fin 3) (s : Bool) : BandSubtileOccurrence q U i s (S i s) := + ⟨tile_band _ _ _ (hsub i s), hf i s, hcent i s⟩ + have table := BandOdometerInteriorTable q hq U S k hs g root_band + root_odo root_ext + (by intro i s; exact occur i s) hc + (by intro i s; exact hsub i s) + (by intro i s; exact child_ext i s) y hy hny + dsimp at table + rcases table with ⟨h2, h2c, h3, h4, h4c, hlast⟩ + let n : Nat := Nat.card {is : Fin 3 × Bool // + y ∈ BoundaryFootprintVertices (S is.1 is.2)} + by_cases hn2 : n = 2 + · by_cases hcxy : GaussianRealPoint y = TileCentroid U + · rw [h2c hn2 hcxy]; omega + · rw [h2 hn2 hcxy] + by_cases hn3 : n = 3 + · rw [h3 hn3]; omega + by_cases hn4 : n = 4 + · by_cases hcxy : GaussianRealPoint y = TileCentroid U + · have hh := h4c hn4 hcxy + omega + · have hh := h4 hn4 hcxy + omega + rcases hlast with hcases | ⟨i, s, hp, hys, hyn⟩ + · exfalso + omega + · exact ih i s (child_ext i s) y hys hyn + +private theorem lap_periodic : + (by + classical + exact + ∀ (C : BandCircle), ∀ (g : IntegerLatticeFunction), (∀ v, v ∈ TilingLattice C → ∃ a : + GaussianInt, Matrix.mulVec (CircleMatrix C) ![(v.re : ℝ), (v.im : ℝ)] = ![(a.re : ℝ), + (a.im : ℝ)] ∧ ∀ x, g (x + v) = g x + x.re * a.re + x.im * a.im + g v) → (∀ v, v ∈ + TilingLattice C → ∀ y, FourNeighborLaplacian g (y + v) = FourNeighborLaplacian g y) ) + := by + classical + intro C g hcocycle v hv y + obtain ⟨a, ha, hs⟩ := hcocycle v hv + simp only [FourNeighborLaplacian] + rw [show y + v + 1 = (y + 1) + v by abel, + show y + v - 1 = (y - 1) + v by abel, + show y + v + ⟨0, 1⟩ = (y + ⟨0, 1⟩) + v by abel, + show y + v - ⟨0, 1⟩ = (y - ⟨0, 1⟩) + v by abel] + rw [hs (y + 1), hs (y - 1), hs (y + ⟨0, 1⟩), hs (y - ⟨0, 1⟩), hs y] + simp + ring + +private theorem hb : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (z0 : GaussianInt), ∀ (anchor : GaussianInt), + let v : GaussianInt := x - z0 + let T0 : ProtoTile := ⟨{z0}, anchor⟩ + (BoundaryFootprintVertices (TileTranslation T0 v) = GaussianTranslation v '' + BoundaryFootprintVertices T0) → (x ∈ BoundaryFootprintVertices (TileTranslation T0 + v)) ) := by + classical + intro x z0 anchor v T0 hvertices + rw [hvertices] + refine ⟨z0, ?_, ?_⟩ + · have hz : (⟨0, 1⟩ : GaussianInt) ≠ 0 := by + intro hh + have hm := congrArg (fun q : GaussianInt => q.im) hh + norm_num at hm + simp only [BoundaryFootprintVertices, ite_eq_left (show T0.cells.Nonempty by simp [T0]), + Set.mem_ofPred_eq] + refine ⟨{z0, z0 + 1}, ?_, by simp⟩ + change ∃ z, _ + refine ⟨z0, ?_⟩ + simp [T0, hz] + · simp [v, GaussianTranslation, sub_eq_add_neg] + +private theorem hT0 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (z : GaussianInt), ∀ (z0 : GaussianInt), ∀ (anchor : GaussianInt), + (C.1.1 = ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z)) → ( + let T0 : ProtoTile := ⟨{z0}, anchor⟩ + BandPrototile C.1.1 T0) ) := by + classical + intro C z z0 anchor hc T0 + rw [hc] + simpa [T0] using (BandPrototile.unit z z0 anchor) + +private theorem hzAt394 : + (by + classical + exact + ∀ (C : BandCircle), (C.1.1.1 = (1 : ℤ)) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple q) → (((0 : ℤ) < (q (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), + (0 : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 + : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) → ((q 0 = C.1.1) → (∀ (i : Fin 3), (q + i.succ).1 = 0)))) ) := by + classical + intro C hr q hq hcurv hq0 i + have hn := hcurv.2.1 i + have hi := hq.2 i + rw [hq0] at hi + omega + +private theorem hyfoot : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (y : LatticeCell), (y ∈ T.cells) → (y ∈ FootprintVertices T) ) := by + classical + intro T y hyT + rw [FootprintVertices, ite_eq_left ⟨y, hyT⟩] + exact ⟨y, hyT, Or.inl rfl⟩ + +private theorem hyboundary : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (v : GaussianInt), (BoundaryFootprintVertices + (TileTranslation T v) = GaussianTranslation v '' BoundaryFootprintVertices T) → (∀ (y + : LatticeCell), (y + v = x) → ((x ∉ BoundaryFootprintVertices (TileTranslation T v)) + → (y ∉ BoundaryFootprintVertices T))) ) := by + classical + intro T x v hboundaryform y hxy hboundary hyb + apply hboundary + rw [hboundaryform] + exact ⟨y, hyb, hxy⟩ + +end PeriodicSuperharmonicGeometry + +theorem BandPeriodicSuperharmonicity (C : BandCircle) + (T : ProtoTile) (h : PartialOdometer) (g : IntegerLatticeFunction) + (hT : BandPrototile C.1.1 T) (hodo : TileOdometer C.1.1 T h) + (hext : GlobalOdometerExtends g h) + (hcocycle : ∀ v, v ∈ TilingLattice C → ∃ a : GaussianInt, + Matrix.mulVec (CircleMatrix C) ![(v.re : ℝ), (v.im : ℝ)] = + ![(a.re : ℝ), (a.im : ℝ)] ∧ + ∀ x, g (x + v) = g x + x.re * a.re + x.im * a.im + g v) + (hremainder : ∃ b : ℝ × ℝ, ∀ v, v ∈ TilingLattice C → ∀ x, + (g (x + v) : ℝ) - LatticeQuadraticForm (CircleMatrix C) (x + v) - + (b.1 * (x + v).re + b.2 * (x + v).im) = + (g x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x - + (b.1 * x.re + b.2 * x.im)) : + IntegerSuperharmonicRepresentative (CircleMatrix C) g := by +-- BODY + classical + unfold IntegerSuperharmonicRepresentative + refine ⟨(PeriodicSuperharmonicGeometry.hsym C), ?_, ?_⟩ + · unfold QuadraticGrowthAtInfinity + obtain ⟨b, hb⟩ := hremainder + obtain ⟨R, hR, hcard⟩ := TilingLatticeIndex C + have hRne : R.Nonempty := PeriodicSuperharmonicGeometry.hRne C R hR + let vals : Finset ℝ := R.image (fun r => |(g r : ℝ) - + LatticeQuadraticForm (CircleMatrix C) r - + (b.1 * r.re + b.2 * r.im)|) + have hvals : vals.Nonempty := PeriodicSuperharmonicGeometry.hvals C g b R hRne + let M : ℝ := vals.sup' hvals id + intro ε hε + let K : ℝ := M + (b.1 ^ 2 + b.2 ^ 2) / ε + refine ⟨2 * K / ε, ?_⟩ + intro x hx + obtain ⟨r, hr, hv⟩ := hR x + have hper : x - r ∈ TilingLattice C := hr.2 + have hrem := hb (x - r) hper r + have hF : (g x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x - + (b.1 * x.re + b.2 * x.im) = + (g r : ℝ) - LatticeQuadraticForm (CircleMatrix C) r - + (b.1 * r.re + b.2 * r.im) := PeriodicSuperharmonicGeometry.hF C g b x r hrem + have hM : |(g r : ℝ) - LatticeQuadraticForm (CircleMatrix C) r - + (b.1 * r.re + b.2 * r.im)| ≤ M := PeriodicSuperharmonicGeometry.hM C g b R hvals x r hr + have hcross : |b.1 * x.re + b.2 * x.im| ≤ + ε / 4 * ((x.re : ℝ)^2 + (x.im : ℝ)^2) + + (b.1^2 + b.2^2) / ε := PeriodicSuperharmonicGeometry.hcross b ε hε x + have hnon : 0 ≤ (x.re : ℝ)^2 + (x.im : ℝ)^2 := by positivity + have hbase : |(g x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x| ≤ + ε / 2 * ((x.re : ℝ)^2 + (x.im : ℝ)^2) + K := PeriodicSuperharmonicGeometry.hbase C g b R + hvals ε hε x r hF hM hcross + have hK : K ≤ ε / 2 * ((x.re : ℝ)^2 + (x.im : ℝ)^2) := PeriodicSuperharmonicGeometry.hK C g b + R hvals ε hε x hx + nlinarith + · intro x + have hlocal := (PeriodicSuperharmonicGeometry.local_bound g + (PeriodicSuperharmonicGeometry.tile_band)) _ _ _ hodo hext + have lap_periodic := PeriodicSuperharmonicGeometry.lap_periodic C g hcocycle + by_cases hr : C.1.1.1 = 1 + · generalize hc : C.1.1 = c at hT hodo + cases hT with + | line w z hw => + have hz := congrArg Prod.fst hc + simp at hz + omega + | unit z z0 anchor => + have hlat : TilingLattice C = ⊤ := by simp [TilingLattice, hr] + let v : GaussianInt := x - z0 + have hv : v ∈ TilingLattice C := by rw [hlat]; trivial + let T0 : ProtoTile := ⟨{z0}, anchor⟩ + obtain ⟨_, _, _, _, _, _, _, hvertices, _⟩ := TileTranslationFormulas T0 v + have hb : x ∈ BoundaryFootprintVertices (TileTranslation T0 v) := + PeriodicSuperharmonicGeometry.hb x z0 anchor hvertices + have heq := PeriodicBoundaryWebLaplacian C T0 h g (PeriodicSuperharmonicGeometry.hT0 C + z z0 anchor hc) + (by rw [hc]; simpa [T0] using hodo) hext hcocycle x + ⟨v, hv, hb⟩ + omega + | @decompose q hq S U hs hcells hfoot hcent => + have hcurv := ProperBandCurvatureStructure q hq + have hq0 : q 0 = C.1.1 := hc.symm + have hz (i : Fin 3) : (q i.succ).1 = 0 := PeriodicSuperharmonicGeometry.hzAt394 C hr q + hq hcurv hq0 i + have hzero := hcurv.2.2 0 1 (hz 0) (hz 1) + omega + · have bg := BandGenealogy C + rcases bg with hbad | ⟨q, hq, hq0, hlt, huniq⟩ + · exact (hr hbad).elim + · have hq0' : q 0 = C.1.1 := hq0 + have hpq : ProperBandQuadruple q := ⟨hq, by simpa [hq0'] using hlt⟩ + have hT' : BandPrototile (q 0) T := by simpa [hq0'] using hT + obtain ⟨htiling, hcount⟩ := BandTileTopologyApplication C q hpq hq0 T hT' + obtain ⟨U, hUF, hxU, hunique⟩ := htiling.2 x + obtain ⟨v, hv, rfl⟩ := hUF + have hvL : v ∈ TilingLattice C := hv + have hcell : x ∈ (TileTranslation T v).cells := hxU + have hrepr := (TileTranslationFormulas T v).1 + obtain ⟨hcells, hanchor, hempty, hreal, hcentroid, hfootform, hedgeform, + hboundaryform, hboundaryedgeform⟩ := TileTranslationFormulas T v + have hy : ∃ y ∈ T.cells, y + v = x := by + simpa [TileTranslation, GaussianTranslation, hrepr] using hcell + obtain ⟨y, hyT, hxy⟩ := hy + have hxy' : x = y + v := hxy.symm + by_cases hboundary : x ∈ BoundaryFootprintVertices (TileTranslation T v) + · have heq := PeriodicBoundaryWebLaplacian C T h g hT hodo hext hcocycle x + ⟨v, hvL, hboundary⟩ + omega + · have hyboundary := PeriodicSuperharmonicGeometry.hyboundary T x v hboundaryform y hxy + hboundary + rw [hxy'] + exact (lap_periodic v hvL y).trans_le (hlocal y (PeriodicSuperharmonicGeometry.hyfoot T + y hyT) hyboundary) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean b/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean new file mode 100644 index 0000000000..9e1d7eb208 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean @@ -0,0 +1,1748 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple + +-- [TABLET NODE: BandPositiveCutBranchCompanionExclusion] + +/-! +# BandPositiveCutBranchCompanionExclusion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PositiveCutExclusionGeometry + +private theorem positive_of_nonempty : + (by + classical + exact + ∀ (c : CircleCoordinates), ∀ (X : ProtoTile), (BandPrototile c X) → ((X.cells.Nonempty) → + (0 < c.1)) ) := by + classical + intro c X hX hne + cases hX with + | line w x hw => simp at hne + | unit z x a => norm_num + | @decompose r hr S X hS hc hf hcent => + exact (ProperBandCurvatureStructure r hr).1 + +private theorem boundary_edge_footprint : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges X) → (e ∈ + FootprintEdges X) ) := by + classical + intro X e he + let I : GaussianInt := ⟨0, 1⟩ + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [I, Zsqrtd.ext_iff] + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + +private theorem edge_vertex_footprint : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges X) → (∀ (z : + GaussianInt), (z ∈ e) → (z ∈ FootprintVertices X)) ) := by + classical + intro X e he z hz + rcases he with ⟨c, hc, he⟩ + unfold FootprintVertices + rw [ite_eq_left ⟨c, hc⟩] + rcases he with h | h | h | h <;> subst e + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hz + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ + · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + +private theorem boundary_to_raw : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges X) → (e ∈ + FootprintEdges X)) → ((∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ + FootprintEdges X) → (∀ (z : GaussianInt), (z ∈ e) → (z ∈ FootprintVertices X))) → (∀ + (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ BoundaryFootprintVertices X) → (x ∈ + FootprintVertices X))) ) := by + classical + intro boundary_edge_footprint edge_vertex_footprint X x hx + by_cases hne : X.cells.Nonempty + · unfold BoundaryFootprintVertices at hx + rw [ite_eq_left hne] at hx + rcases hx with ⟨e, he, hxe⟩ + exact edge_vertex_footprint X e (boundary_edge_footprint X e he) x hxe + · unfold BoundaryFootprintVertices at hx + rw [ite_eq_right hne] at hx + subst x + simp [FootprintVertices, hne] + +private theorem exact_exclusion : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (W : ProtoTile), ∀ (Z : ProtoTile), ∀ (right : + ExactTileInterfaceTriple U V W), ∀ (adjacent : ExactTileInterfaceTriple U W Z), ∀ + (incomingPoint : GaussianInt), (right.point ≠ incomingPoint) → ((adjacent.point = + incomingPoint) → (∀ (cut : GaussianInt), (cut ∈ FootprintVertices U) → ((cut ∈ + FootprintVertices W) → ((cut ∈ FootprintVertices Z) → (cut ∉ FootprintVertices V))))) + ) := by + classical + intro U V W Z right adjacent incomingPoint hne halign cut hU hW hZ hV + have hr : cut = right.point := + (right.unique_common cut).mp ⟨⟨hU, hV⟩, hW⟩ + have ha : cut = adjacent.point := + (adjacent.unique_common cut).mp ⟨⟨hU, hW⟩, hZ⟩ + exact hne (hr.symm.trans (ha.trans halign)) + +private theorem occurrence_centroid : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (P : ProtoTile), ∀ (X : ProtoTile), ∀ (i : Fin 3), ∀ + (s : Bool), (BandSubtileOccurrence r P i s X) → (TileCentroid X - TileCentroid P = + (if s then (1 : Real) else -1) • ((1 / 2 : Real) • GaussianRealPoint ((1 - (⟨0, 1⟩ : + GaussianInt)) * BandVectors.1 (r ((i + 2).succ)) (r ((i + 1).succ))))) ) := by + classical + intro r P X i s ho + change BandPrototile (r i.succ) X ∧ _ ∧ _ at ho + rcases ho with ⟨_, _, hc⟩ + convert hc using 1; + ext <;> + simp [GaussianRealPoint, sub_eq_add_neg, add_comm, + smul_eq_mul] + +private theorem hq3pos : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (((0 : ℤ) < (q + (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin (3 + : ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) + → (0 < (q 3).1)) ) := by + classical + intro q cfg hcurv + have hnonneg : 0 ≤ (q 3).1 := by + simpa using hcurv.2.1 (2 : Fin 3) + have hne : (q 3).1 ≠ 0 := cfg.noLine 3 + omega + +private theorem hOpos : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (Finset.Nonempty cert.O.cells) → ((∀ (c : CircleCoordinates), ∀ (X : + ProtoTile), (BandPrototile c X) → ((X.cells.Nonempty) → (0 < c.1))) → (0 < + (cfg.firstPredecessor 1).1)) ) := by + classical + intro q cfg C₀ T cert hO positive_of_nonempty + have hproto : BandPrototile (cfg.firstPredecessor 1) cert.O := by + simpa [cert.precursor_eq] using (cert.plus_occurrence 0 false).1 + exact positive_of_nonempty _ _ hproto hO + +private theorem hOcent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (r : Fin 4 → CircleCoordinates), ∀ (P : ProtoTile), ∀ (X : ProtoTile), ∀ (i + : Fin 3), ∀ (s : Bool), (BandSubtileOccurrence r P i s X) → (TileCentroid X - + TileCentroid P = (if s then (1 : Real) else -1) • ((1 / 2 : Real) • GaussianRealPoint + ((1 - (⟨0, 1⟩ : GaussianInt)) * BandVectors.1 (r ((i + 2).succ)) (r ((i + + 1).succ)))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + TileCentroid cert.O - TileCentroid (cert.P 0 true) = (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * w))) ) := by + classical + intro q cfg C₀ T cert occurrence_centroid I w + simpa [cert.precursor_eq, I, w, cfg.firstParentTwo, cfg.firstParentThree] + using occurrence_centroid cfg.firstPredecessor (cert.P 0 true) + (cert.Q 0 false) 0 false (cert.plus_occurrence 0 false) + +private theorem hQ2cent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (r : Fin 4 → CircleCoordinates), ∀ (P : ProtoTile), ∀ (X : ProtoTile), ∀ (i + : Fin 3), ∀ (s : Bool), (BandSubtileOccurrence r P i s X) → (TileCentroid X - + TileCentroid P = (if s then (1 : Real) else -1) • ((1 / 2 : Real) • GaussianRealPoint + ((1 - (⟨0, 1⟩ : GaussianInt)) * BandVectors.1 (r ((i + 2).succ)) (r ((i + + 1).succ)))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + TileCentroid (cert.Q 1 true) - TileCentroid (cert.P 0 true) = (1 / 2 : Real) • + GaussianRealPoint ((1 - I) * t)) ) := by + classical + intro q cfg C₀ T cert occurrence_centroid I t + simpa [I, t, cfg.firstParentTwo, cfg.firstParentThree] + using occurrence_centroid cfg.firstPredecessor (cert.P 0 true) + (cert.Q 1 true) 1 true (cert.plus_occurrence 1 true) + +private theorem hQ3cent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (r : Fin 4 → CircleCoordinates), ∀ (P : ProtoTile), ∀ (X : ProtoTile), ∀ (i + : Fin 3), ∀ (s : Bool), (BandSubtileOccurrence r P i s X) → (TileCentroid X - + TileCentroid P = (if s then (1 : Real) else -1) • ((1 / 2 : Real) • GaussianRealPoint + ((1 - (⟨0, 1⟩ : GaussianInt)) * BandVectors.1 (r ((i + 2).succ)) (r ((i + + 1).succ)))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + TileCentroid (cert.Q 2 true) - TileCentroid (cert.P 0 true) = (1 / 2 : Real) • + GaussianRealPoint ((1 - I) * u)) ) := by + classical + intro q cfg C₀ T cert occurrence_centroid I u + simpa [I, u, cfg.firstParentTwo, cfg.firstParentThree] + using occurrence_centroid cfg.firstPredecessor (cert.P 0 true) + (cert.Q 2 true) 2 true (cert.plus_occurrence 2 true) + +private theorem hS2cent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (r : Fin 4 → CircleCoordinates), ∀ (P : ProtoTile), ∀ (X : ProtoTile), ∀ (i + : Fin 3), ∀ (s : Bool), (BandSubtileOccurrence r P i s X) → (TileCentroid X - + TileCentroid P = (if s then (1 : Real) else -1) • ((1 / 2 : Real) • GaussianRealPoint + ((1 - (⟨0, 1⟩ : GaussianInt)) * BandVectors.1 (r ((i + 2).succ)) (r ((i + + 1).succ)))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + TileCentroid (cert.S 1 false) - TileCentroid (cert.P 0 false) = (-1 : Real) • ((1 / 2 : + Real) • GaussianRealPoint ((1 - I) * t))) ) := by + classical + intro q cfg C₀ T cert occurrence_centroid I t + simpa [I, t, cfg.firstParentTwo, cfg.firstParentThree] + using occurrence_centroid cfg.firstPredecessor (cert.P 0 false) + (cert.S 1 false) 1 false (cert.minus_occurrence 1 false) + +private theorem hS3cent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (r : Fin 4 → CircleCoordinates), ∀ (P : ProtoTile), ∀ (X : ProtoTile), ∀ (i + : Fin 3), ∀ (s : Bool), (BandSubtileOccurrence r P i s X) → (TileCentroid X - + TileCentroid P = (if s then (1 : Real) else -1) • ((1 / 2 : Real) • GaussianRealPoint + ((1 - (⟨0, 1⟩ : GaussianInt)) * BandVectors.1 (r ((i + 2).succ)) (r ((i + + 1).succ)))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + TileCentroid (cert.S 2 false) - TileCentroid (cert.P 0 false) = (-1 : Real) • ((1 / 2 : + Real) • GaussianRealPoint ((1 - I) * u))) ) := by + classical + intro q cfg C₀ T cert occurrence_centroid I u + simpa [I, u, cfg.firstParentTwo, cfg.firstParentThree] + using occurrence_centroid cfg.firstPredecessor (cert.P 0 false) + (cert.S 2 false) 2 false (cert.minus_occurrence 2 false) + +private theorem hPminus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (r : Fin 4 → CircleCoordinates), ∀ (P : ProtoTile), ∀ (X : ProtoTile), ∀ (i + : Fin 3), ∀ (s : Bool), (BandSubtileOccurrence r P i s X) → (TileCentroid X - + TileCentroid P = (if s then (1 : Real) else -1) • ((1 / 2 : Real) • GaussianRealPoint + ((1 - (⟨0, 1⟩ : GaussianInt)) * BandVectors.1 (r ((i + 2).succ)) (r ((i + + 1).succ)))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + TileCentroid (cert.P 0 false) - TileCentroid (cert.P 0 true) = (-1 : Real) • + GaussianRealPoint ((1 - I) * w)) ) := by + classical + intro q cfg C₀ T cert occurrence_centroid I w + have hm := occurrence_centroid q T (cert.P 0 false) 0 false + (cert.outer_occurrence 0 false) + have hp := occurrence_centroid q T (cert.P 0 true) 0 true + (cert.outer_occurrence 0 true) + simp only [I, w] at hm hp ⊢ + calc + _ = (TileCentroid (cert.P 0 false) - TileCentroid T) - + (TileCentroid (cert.P 0 true) - TileCentroid T) := by abel + _ = _ := by rw [hm, hp]; ext <;> simp [GaussianRealPoint, sub_eq_add_neg, + smul_eq_mul] <;> ring + +private theorem hsum : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + w + t + u = 0 ) := by + classical + intro q cfg u w t + simpa [w, t, u, cfg.firstParentTwo, cfg.firstParentThree] using + (VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).1 + +private theorem gaussianPoint_add : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint (x + y) = GaussianRealPoint x + + GaussianRealPoint y ) := by + classical + intro x y + ext <;> simp [GaussianRealPoint] + +private theorem gaussianPoint_neg : + (by + classical + exact + ∀ (x : GaussianInt), GaussianRealPoint (-x) = -GaussianRealPoint x ) := by + classical + intro x + ext <;> simp [GaussianRealPoint] + +private theorem gaussianPoint_Iminus_one : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + (∀ (x : GaussianInt), GaussianRealPoint (-x) = -GaussianRealPoint x) → (∀ (x : + GaussianInt), GaussianRealPoint ((I - 1) * x) = -GaussianRealPoint ((1 - I) * x)) ) + := by + classical + intro I gaussianPoint_neg x + have hx : (I - 1) * x = -((1 - I) * x) := by ring + rw [hx, gaussianPoint_neg] + +private theorem hprod : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (w + t + u = 0) → ((1 - I) * w + (1 - I) * t + (1 - I) * u = 0) ) := by + classical + intro q cfg I u w t hsum + calc + _ = (1 - I) * (w + t + u) := by ring + _ = 0 := by rw [hsum]; simp + +private theorem hsumGaussianPoint : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (∀ (x : GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint (x + y) = GaussianRealPoint + x + GaussianRealPoint y) → (((1 - I) * w + (1 - I) * t + (1 - I) * u = 0) → + (GaussianRealPoint ((1 - I) * w) + GaussianRealPoint ((1 - I) * t) + + GaussianRealPoint ((1 - I) * u) = 0)) ) := by + classical + intro q cfg I u w t gaussianPoint_add hprod + calc + _ = GaussianRealPoint ((1 - I) * w + (1 - I) * t + (1 - I) * u) := by + rw [← gaussianPoint_add, ← gaussianPoint_add] + _ = 0 := by rw [hprod]; simp [GaussianRealPoint] + +private theorem hsumGaussianPointFst : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (GaussianRealPoint ((1 - I) * w) + GaussianRealPoint ((1 - I) * t) + GaussianRealPoint + ((1 - I) * u) = 0) → ((GaussianRealPoint ((1 - I) * w)).1 + (GaussianRealPoint ((1 - + I) * t)).1 + (GaussianRealPoint ((1 - I) * u)).1 = 0) ) := by + classical + intro q cfg I u w t hsumGaussianPoint + simpa using congrArg Prod.fst hsumGaussianPoint + +private theorem hsumGaussianPointSnd : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (GaussianRealPoint ((1 - I) * w) + GaussianRealPoint ((1 - I) * t) + GaussianRealPoint + ((1 - I) * u) = 0) → ((GaussianRealPoint ((1 - I) * w)).2 + (GaussianRealPoint ((1 - + I) * t)).2 + (GaussianRealPoint ((1 - I) * u)).2 = 0) ) := by + classical + intro q cfg I u w t hsumGaussianPoint + simpa using congrArg Prod.snd hsumGaussianPoint + +private theorem hforward : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (birth + : Fin 4 → CircleCoordinates), + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (birth (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (2 : Fin (4 : ℕ)) = q (3 : Fin (4 + : ℕ)) ∧ birth (3 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ))) → ((∀ (j : + Fin (3 : ℕ)), BandVectors.1 (birth (0 : Fin (4 : ℕ))) (birth j.succ) = (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) * BandVectors.1 (birth j.succ) (birth (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (birth (0 : Fin (4 : ℕ))) (birth j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (birth j.succ) (birth (0 : Fin (4 : ℕ)))) → (u = (⟨0, 1⟩ + : GaussianInt) * BandVectors.1 (birth 3) (birth 0))) ) := by + classical + intro q cfg birth u hp2 hf + simpa [u, hp2.1, hp2.2.2] using (hf (2 : Fin 3)).1 + +private theorem hreverse : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (birth + : Fin 4 → CircleCoordinates), + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (u = (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (birth 3) (birth 0)) → (BandVectors.1 (birth + 3) (birth 0) = -(⟨0, 1⟩ : GaussianInt) * u) ) := by + classical + intro q cfg birth u hforward + calc + _ = -(⟨0, 1⟩ : GaussianInt) * + ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (birth 3) (birth 0)) := by + ext <;> simp + _ = _ := by rw [← hforward] + +private theorem hrootAdj : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (birth + : Fin 4 → CircleCoordinates), + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + (birth (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (2 : Fin (4 : ℕ)) = q (3 : Fin (4 + : ℕ)) ∧ birth (3 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ))) → ((∀ (j : + Fin (3 : ℕ)), BandVectors.1 (birth (0 : Fin (4 : ℕ))) (birth j.succ) = (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) * BandVectors.1 (birth j.succ) (birth (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (birth (0 : Fin (4 : ℕ))) (birth j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (birth j.succ) (birth (0 : Fin (4 : ℕ)))) → + (BandVectors.1 (birth 0) (birth 2) = (⟨0, 1⟩ : GaussianInt) * w)) ) := by + classical + intro q cfg birth w hp2 hf + simpa [hp2.1, hp2.2.1, w] using (hf (1 : Fin 3)).1 + +private theorem hargA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (birth + : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (BandVectors.1 (birth 3) (birth 0) = -(⟨0, 1⟩ : GaussianInt) * u) → ((BandVectors.1 + (birth 0) (birth 3) = u) → (BandVectors.1 (birth 3) (birth 0) + BandVectors.1 (birth + 0) (birth 3) = (1 - I) * u)) ) := by + classical + intro q cfg birth I u hreverse hforward' + rw [hreverse, hforward'] + ring + +private theorem hargAdj : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (birth : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (birth 0) (birth 2) = (⟨0, 1⟩ : GaussianInt) * w) → ((BandVectors.1 (birth + 2) (birth 0) = w) → (BandVectors.1 (birth 0) (birth 2) - BandVectors.1 (birth 2) + (birth 0) = (I - 1) * w)) ) := by + classical + intro q birth I w hrootAdj hbackAdj + rw [hrootAdj, hbackAdj] + ring + +private theorem hWcent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (TileCentroid cert.O - TileCentroid (cert.P 0 true) = (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * w))) → ((TileCentroid (cert.Q 1 true) - TileCentroid + (cert.P 0 true) = (1 / 2 : Real) • GaussianRealPoint ((1 - I) * t)) → + (((GaussianRealPoint ((1 - I) * w)).1 + (GaussianRealPoint ((1 - I) * t)).1 + + (GaussianRealPoint ((1 - I) * u)).1 = 0) → (((GaussianRealPoint ((1 - I) * w)).2 + + (GaussianRealPoint ((1 - I) * t)).2 + (GaussianRealPoint ((1 - I) * u)).2 = 0) → + ((BandVectors.1 (birth 3) (birth 0) + BandVectors.1 (birth 0) (birth 3) = (1 - I) * + u) → (TileCentroid cert.O - TileCentroid (cert.Q 1 true) = (1 / 2 : Real) • + GaussianRealPoint (BandVectors.1 (birth 3) (birth 0) + BandVectors.1 (birth 0) (birth + 3))))))) ) := by + classical + intro q cfg C₀ T cert birth I u w t hOcent hQ2cent hsumGaussianPointFst hsumGaussianPointSnd hargA + calc + _ = (TileCentroid cert.O - TileCentroid (cert.P 0 true)) - + (TileCentroid (cert.Q 1 true) - TileCentroid (cert.P 0 true)) := by abel + _ = _ := by + rw [hOcent, hQ2cent, hargA] + ext + · simp [smul_eq_mul] + linear_combination (-1 / 2 : Real) * hsumGaussianPointFst + · simp [smul_eq_mul] + linear_combination (-1 / 2 : Real) * hsumGaussianPointSnd + +private theorem hZcent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (TileCentroid (cert.Q 1 true) - TileCentroid (cert.P 0 true) = (1 / 2 : Real) • + GaussianRealPoint ((1 - I) * t)) → ((TileCentroid (cert.S 2 false) - TileCentroid + (cert.P 0 false) = (-1 : Real) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) * u))) + → ((TileCentroid (cert.P 0 false) - TileCentroid (cert.P 0 true) = (-1 : Real) • + GaussianRealPoint ((1 - I) * w)) → (((GaussianRealPoint ((1 - I) * w)).1 + + (GaussianRealPoint ((1 - I) * t)).1 + (GaussianRealPoint ((1 - I) * u)).1 = 0) → + (((GaussianRealPoint ((1 - I) * w)).2 + (GaussianRealPoint ((1 - I) * t)).2 + + (GaussianRealPoint ((1 - I) * u)).2 = 0) → (TileCentroid (cert.S 2 false) - + TileCentroid (cert.Q 1 true) = (-1 : Real) • ((1 / 2 : Real) • GaussianRealPoint ((1 + - I) * w))))))) ) := by + classical + intro q cfg C₀ T cert I u w t hQ2cent hS3cent hPminus hsumGaussianPointFst hsumGaussianPointSnd + calc + _ = (TileCentroid (cert.P 0 false) - TileCentroid (cert.P 0 true)) + + (TileCentroid (cert.S 2 false) - TileCentroid (cert.P 0 false)) - + (TileCentroid (cert.Q 1 true) - TileCentroid (cert.P 0 true)) := by abel + _ = _ := by + rw [hPminus, hS3cent, hQ2cent] + ext + · simp [smul_eq_mul] + linear_combination (-1 / 2 : Real) * hsumGaussianPointFst + · simp [smul_eq_mul] + linear_combination (-1 / 2 : Real) * hsumGaussianPointSnd + +private theorem hWcent'At387 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), (TileCentroid cert.O - TileCentroid + (cert.Q 1 true) = (1 / 2 : Real) • GaussianRealPoint (BandVectors.1 (birth 3) (birth + 0) + BandVectors.1 (birth 0) (birth 3))) → (TileCentroid cert.O - TileCentroid + (cert.Q 1 true) = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (0 : + Nat) * (BandVectors.1 (birth 3) (birth 0) + BandVectors.1 (birth 0) (birth 3)))) ) := by + classical + intro q cfg C₀ T cert birth hWcent + simpa using hWcent + +private theorem hnotA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), (∀ (U : ProtoTile), ∀ (V : ProtoTile), + ∀ (W : ProtoTile), ∀ (Z : ProtoTile), ∀ (right : ExactTileInterfaceTriple U V W), ∀ + (adjacent : ExactTileInterfaceTriple U W Z), ∀ (incomingPoint : GaussianInt), + (right.point ≠ incomingPoint) → ((adjacent.point = incomingPoint) → (∀ (cut : + GaussianInt), (cut ∈ FootprintVertices U) → ((cut ∈ FootprintVertices W) → ((cut ∈ + FootprintVertices Z) → (cut ∉ FootprintVertices V)))))) → ( + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (BandVectors.1 (birth 0) (birth 3) = u) → (∀ (right : ExactTileInterfaceTriple (cert.Q (1 + : Fin (3 : ℕ)) true) (TileTranslation (cert.Q (1 : Fin (3 : ℕ)) true) ((⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ^ (↑(0 : Fin (4 : ℕ)) : ℕ) * if Even (↑(0 : Fin (4 : ℕ)) : ℕ) + then BandVectors.1 (birth (0 : Fin (4 : ℕ))) (birth (Fin.succ (2 : Fin (3 : ℕ)))) + else BandVectors.1 (birth (Fin.succ (2 : Fin (3 : ℕ)))) (birth (0 : Fin (4 : ℕ))))) + cert.O), ∀ (incoming : ExactTileInterfaceTriple (cert.Q (1 : Fin (3 : ℕ)) true) + (TileTranslation (cert.Q (1 : Fin (3 : ℕ)) true) ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ^ (↑(0 : Fin (4 : ℕ)) : ℕ) * if Even (↑(0 : Fin (4 : ℕ)) : ℕ) then BandVectors.1 + (birth (Fin.succ (2 : Fin (3 : ℕ)))) (birth (0 : Fin (4 : ℕ))) else BandVectors.1 + (birth (0 : Fin (4 : ℕ))) (birth (Fin.succ (2 : Fin (3 : ℕ)))))) cert.O), ∀ (adjacent + : ExactTileInterfaceTriple (cert.Q (1 : Fin (3 : ℕ)) true) cert.O (cert.S (2 : Fin (3 + : ℕ)) false)), (right.point ≠ incoming.point) → ((adjacent.point = incoming.point) → + ((cert.exceptional_segments.a ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true)) → + ((cert.exceptional_segments.a ∈ FootprintVertices (cert.S (2 : Fin (3 : ℕ)) false)) → + ((cert.exceptional_segments.a ∈ FootprintVertices cert.O) → + (cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation (cert.Q 1 true) + u)))))))) ) := by + classical + intro q cfg C₀ T cert birth exact_exclusion u hforward' right incoming adjacent hne halign haU + haZ haW + have hn := exact_exclusion _ _ _ _ right adjacent incoming.point hne halign + cert.exceptional_segments.a haU haW haZ + simpa [hforward'] using hn + +private theorem hWcent'At413 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (TileCentroid cert.O - TileCentroid (cert.P 0 true) = (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * w))) → ((TileCentroid (cert.S 1 false) - TileCentroid + (cert.P 0 false) = (-1 : Real) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) * t))) + → ((TileCentroid (cert.P 0 false) - TileCentroid (cert.P 0 true) = (-1 : Real) • + GaussianRealPoint ((1 - I) * w)) → (((GaussianRealPoint ((1 - I) * w)).1 + + (GaussianRealPoint ((1 - I) * t)).1 + (GaussianRealPoint ((1 - I) * u)).1 = 0) → + (((GaussianRealPoint ((1 - I) * w)).2 + (GaussianRealPoint ((1 - I) * t)).2 + + (GaussianRealPoint ((1 - I) * u)).2 = 0) → (TileCentroid cert.O - TileCentroid + (cert.S 1 false) = (-1 : Real) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) * + u))))))) ) := by + classical + intro q cfg C₀ T cert I u w t hOcent hS2cent hPminus hsumGaussianPointFst hsumGaussianPointSnd + calc + _ = (TileCentroid cert.O - TileCentroid (cert.P 0 true)) - + (TileCentroid (cert.S 1 false) - TileCentroid (cert.P 0 false)) - + (TileCentroid (cert.P 0 false) - TileCentroid (cert.P 0 true)) := by abel + _ = _ := by + rw [hOcent, hS2cent, hPminus] + ext + · simp [smul_eq_mul] + linear_combination (1 / 2 : Real) * hsumGaussianPointFst + · simp [smul_eq_mul] + linear_combination (1 / 2 : Real) * hsumGaussianPointSnd + +private theorem hZcent'At426 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (TileCentroid (cert.Q 2 true) - TileCentroid (cert.P 0 true) = (1 / 2 : Real) • + GaussianRealPoint ((1 - I) * u)) → ((TileCentroid (cert.S 1 false) - TileCentroid + (cert.P 0 false) = (-1 : Real) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) * t))) + → ((TileCentroid (cert.P 0 false) - TileCentroid (cert.P 0 true) = (-1 : Real) • + GaussianRealPoint ((1 - I) * w)) → (((GaussianRealPoint ((1 - I) * w)).1 + + (GaussianRealPoint ((1 - I) * t)).1 + (GaussianRealPoint ((1 - I) * u)).1 = 0) → + (((GaussianRealPoint ((1 - I) * w)).2 + (GaussianRealPoint ((1 - I) * t)).2 + + (GaussianRealPoint ((1 - I) * u)).2 = 0) → (TileCentroid (cert.Q 2 true) - + TileCentroid (cert.S 1 false) = (1 / 2 : Real) • GaussianRealPoint ((1 - I) * w)))))) + ) := by + classical + intro q cfg C₀ T cert I u w t hQ3cent hS2cent hPminus hsumGaussianPointFst hsumGaussianPointSnd + calc + _ = (TileCentroid (cert.Q 2 true) - TileCentroid (cert.P 0 true)) - + (TileCentroid (cert.S 1 false) - TileCentroid (cert.P 0 false)) - + (TileCentroid (cert.P 0 false) - TileCentroid (cert.P 0 true)) := by abel + _ = _ := by + rw [hQ3cent, hS2cent, hPminus] + ext + · simp [smul_eq_mul] + linear_combination (1 / 2 : Real) * hsumGaussianPointFst + · simp [smul_eq_mul] + linear_combination (1 / 2 : Real) * hsumGaussianPointSnd + +private theorem hnotB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), (∀ (U : ProtoTile), ∀ (V : ProtoTile), + ∀ (W : ProtoTile), ∀ (Z : ProtoTile), ∀ (right : ExactTileInterfaceTriple U V W), ∀ + (adjacent : ExactTileInterfaceTriple U W Z), ∀ (incomingPoint : GaussianInt), + (right.point ≠ incomingPoint) → ((adjacent.point = incomingPoint) → (∀ (cut : + GaussianInt), (cut ∈ FootprintVertices U) → ((cut ∈ FootprintVertices W) → ((cut ∈ + FootprintVertices Z) → (cut ∉ FootprintVertices V)))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + (I ^ 2 = -1) → ( + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (BandVectors.1 (birth 0) (birth 3) = u) → (∀ (right' : ExactTileInterfaceTriple (cert.S + (1 : Fin (3 : ℕ)) false) (TileTranslation (cert.S (1 : Fin (3 : ℕ)) false) ((⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑(2 : Fin (4 : ℕ)) : ℕ) * if Even (↑(2 : Fin (4 : ℕ)) + : ℕ) then BandVectors.1 (birth (0 : Fin (4 : ℕ))) (birth (Fin.succ (2 : Fin (3 : + ℕ)))) else BandVectors.1 (birth (Fin.succ (2 : Fin (3 : ℕ)))) (birth (0 : Fin (4 : + ℕ))))) cert.O), ∀ (incoming' : ExactTileInterfaceTriple (cert.S (1 : Fin (3 : ℕ)) + false) (TileTranslation (cert.S (1 : Fin (3 : ℕ)) false) ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑(2 : Fin (4 : ℕ)) : ℕ) * if Even (↑(2 : Fin (4 : ℕ)) : ℕ) then + BandVectors.1 (birth (Fin.succ (2 : Fin (3 : ℕ)))) (birth (0 : Fin (4 : ℕ))) else + BandVectors.1 (birth (0 : Fin (4 : ℕ))) (birth (Fin.succ (2 : Fin (3 : ℕ)))))) + cert.O), ∀ (adjacent' : ExactTileInterfaceTriple (cert.S (1 : Fin (3 : ℕ)) false) + cert.O (cert.Q (2 : Fin (3 : ℕ)) true)), (right'.point ≠ incoming'.point) → + ((adjacent'.point = incoming'.point) → ((cert.exceptional_segments.b ∈ + FootprintVertices (cert.S (1 : Fin (3 : ℕ)) false)) → ((cert.exceptional_segments.b ∈ + FootprintVertices (cert.Q (2 : Fin (3 : ℕ)) true)) → ((cert.exceptional_segments.b ∈ + FootprintVertices cert.O) → (cert.exceptional_segments.b ∉ FootprintVertices + (TileTranslation (cert.S 1 false) (-u)))))))))) ) := by + classical + intro q cfg C₀ T cert birth exact_exclusion I hI2 u hforward' right' incoming' adjacent' hne' + halign' hbU hbZ hbW + have hn := exact_exclusion _ _ _ _ right' adjacent' incoming'.point hne' halign' + cert.exceptional_segments.b hbU hbW hbZ + simpa [I, hI2, hforward'] using hn + +private theorem hback3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (birth + : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (t = I * BandVectors.1 (birth 3) (birth 0)) → (BandVectors.1 (birth 3) (birth 0) = -I * + t) ) := by + classical + intro q cfg birth I t hflip3 + calc + _ = -I * (I * BandVectors.1 (birth 3) (birth 0)) := by + ext <;> simp [I] + _ = _ := by rw [← hflip3] + +private theorem hQ2O : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (TileCentroid cert.O - TileCentroid (cert.P 0 true) = (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * w))) → ((TileCentroid (cert.Q 1 true) - TileCentroid + (cert.P 0 true) = (1 / 2 : Real) • GaussianRealPoint ((1 - I) * t)) → + (((GaussianRealPoint ((1 - I) * w)).1 + (GaussianRealPoint ((1 - I) * t)).1 + + (GaussianRealPoint ((1 - I) * u)).1 = 0) → (((GaussianRealPoint ((1 - I) * w)).2 + + (GaussianRealPoint ((1 - I) * t)).2 + (GaussianRealPoint ((1 - I) * u)).2 = 0) → + (TileCentroid (cert.Q 1 true) - TileCentroid cert.O = (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * u)))))) ) := by + classical + intro q cfg C₀ T cert I u w t hOcent hQ2cent hsumGaussianPointFst hsumGaussianPointSnd + calc + _ = (TileCentroid (cert.Q 1 true) - TileCentroid (cert.P 0 true)) - + (TileCentroid cert.O - TileCentroid (cert.P 0 true)) := by abel + _ = _ := by + rw [hQ2cent, hOcent] + ext + · simp [smul_eq_mul] + linear_combination (1 / 2 : Real) * hsumGaussianPointFst + · simp [smul_eq_mul] + linear_combination (1 / 2 : Real) * hsumGaussianPointSnd + +private theorem hS3O : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (TileCentroid cert.O - TileCentroid (cert.P 0 true) = (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * w))) → ((TileCentroid (cert.S 2 false) - TileCentroid + (cert.P 0 false) = (-1 : Real) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) * u))) + → ((TileCentroid (cert.P 0 false) - TileCentroid (cert.P 0 true) = (-1 : Real) • + GaussianRealPoint ((1 - I) * w)) → (((GaussianRealPoint ((1 - I) * w)).1 + + (GaussianRealPoint ((1 - I) * t)).1 + (GaussianRealPoint ((1 - I) * u)).1 = 0) → + (((GaussianRealPoint ((1 - I) * w)).2 + (GaussianRealPoint ((1 - I) * t)).2 + + (GaussianRealPoint ((1 - I) * u)).2 = 0) → (TileCentroid (cert.S 2 false) - + TileCentroid cert.O = (1 / 2 : Real) • GaussianRealPoint ((1 - I) * t)))))) ) := by + classical + intro q cfg C₀ T cert I u w t hOcent hS3cent hPminus hsumGaussianPointFst hsumGaussianPointSnd + calc + _ = (TileCentroid (cert.S 2 false) - TileCentroid (cert.P 0 false)) + + (TileCentroid (cert.P 0 false) - TileCentroid (cert.P 0 true)) - + (TileCentroid cert.O - TileCentroid (cert.P 0 true)) := by abel + _ = _ := by + rw [hS3cent, hPminus, hOcent] + ext + · simp [smul_eq_mul] + linear_combination (-1 / 2 : Real) * hsumGaussianPointFst + · simp [smul_eq_mul] + linear_combination (-1 / 2 : Real) * hsumGaussianPointSnd + +private theorem hS2O : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (TileCentroid cert.O - TileCentroid (cert.P 0 true) = (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * w))) → ((TileCentroid (cert.S 1 false) - TileCentroid + (cert.P 0 false) = (-1 : Real) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) * t))) + → ((TileCentroid (cert.P 0 false) - TileCentroid (cert.P 0 true) = (-1 : Real) • + GaussianRealPoint ((1 - I) * w)) → (((GaussianRealPoint ((1 - I) * w)).1 + + (GaussianRealPoint ((1 - I) * t)).1 + (GaussianRealPoint ((1 - I) * u)).1 = 0) → + (((GaussianRealPoint ((1 - I) * w)).2 + (GaussianRealPoint ((1 - I) * t)).2 + + (GaussianRealPoint ((1 - I) * u)).2 = 0) → (TileCentroid (cert.S 1 false) - + TileCentroid cert.O = (1 / 2 : Real) • GaussianRealPoint ((1 - I) * u)))))) ) := by + classical + intro q cfg C₀ T cert I u w t hOcent hS2cent hPminus hsumGaussianPointFst hsumGaussianPointSnd + calc + _ = (TileCentroid (cert.S 1 false) - TileCentroid (cert.P 0 false)) + + (TileCentroid (cert.P 0 false) - TileCentroid (cert.P 0 true)) - + (TileCentroid cert.O - TileCentroid (cert.P 0 true)) := by abel + _ = _ := by + rw [hS2cent, hPminus, hOcent] + ext + · simp [smul_eq_mul] + linear_combination (-1 / 2 : Real) * hsumGaussianPointFst + · simp [smul_eq_mul] + linear_combination (-1 / 2 : Real) * hsumGaussianPointSnd + +private theorem hQ3O : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (TileCentroid cert.O - TileCentroid (cert.P 0 true) = (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * w))) → ((TileCentroid (cert.Q 2 true) - TileCentroid + (cert.P 0 true) = (1 / 2 : Real) • GaussianRealPoint ((1 - I) * u)) → + (((GaussianRealPoint ((1 - I) * w)).1 + (GaussianRealPoint ((1 - I) * t)).1 + + (GaussianRealPoint ((1 - I) * u)).1 = 0) → (((GaussianRealPoint ((1 - I) * w)).2 + + (GaussianRealPoint ((1 - I) * t)).2 + (GaussianRealPoint ((1 - I) * u)).2 = 0) → + (TileCentroid (cert.Q 2 true) - TileCentroid cert.O = (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * t)))))) ) := by + classical + intro q cfg C₀ T cert I u w t hOcent hQ3cent hsumGaussianPointFst hsumGaussianPointSnd + calc + _ = (TileCentroid (cert.Q 2 true) - TileCentroid (cert.P 0 true)) - + (TileCentroid cert.O - TileCentroid (cert.P 0 true)) := by abel + _ = _ := by + rw [hQ3cent, hOcent] + ext + · simp [smul_eq_mul] + linear_combination (1 / 2 : Real) * hsumGaussianPointFst + · simp [smul_eq_mul] + linear_combination (1 / 2 : Real) * hsumGaussianPointSnd + +private theorem hA1Wvec : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (birth + : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + (I * I = -1) → ( + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (BandVectors.1 (birth 0) (birth 2) = I * u) → ((BandVectors.1 (birth 2) (birth 0) = u) → + (I * (BandVectors.1 (birth 0) (birth 2) + BandVectors.1 (birth 2) (birth 0)) = (I - + 1) * u))) ) := by + classical + intro q cfg birth I hI2mul u hforward2 hback2 + rw [hforward2, hback2] + rw [mul_add, ← mul_assoc, hI2mul] + ring + +private theorem hA1Zvec : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (birth + : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + (I * I = -1) → ( + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (BandVectors.1 (birth 0) (birth 3) = t) → ((BandVectors.1 (birth 3) (birth 0) = -I * t) → + (I * (BandVectors.1 (birth 3) (birth 0) - BandVectors.1 (birth 0) (birth 3)) = (1 - + I) * t))) ) := by + classical + intro q cfg birth I hI2mul t hforward3 hback3 + rw [hback3, hforward3] + rw [sub_eq_add_neg, mul_add, ← mul_assoc] + simp [hI2mul] + ring + +private theorem hA2Wvec : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (birth + : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (BandVectors.1 (birth 0) (birth 3) = t) → ((BandVectors.1 (birth 3) (birth 0) = -I * t) → + (BandVectors.1 (birth 0) (birth 3) + BandVectors.1 (birth 3) (birth 0) = (1 - I) * + t)) ) := by + classical + intro q cfg birth I t hforward3 hback3 + rw [hforward3, hback3] + ring + +private theorem hA2Zvec : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (birth + : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (BandVectors.1 (birth 0) (birth 2) = I * u) → ((BandVectors.1 (birth 2) (birth 0) = u) → + (BandVectors.1 (birth 0) (birth 2) - BandVectors.1 (birth 2) (birth 0) = (I - 1) * + u)) ) := by + classical + intro q cfg birth I u hforward2 hback2 + rw [hforward2, hback2] + ring + +private theorem hB1Wvec : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (birth + : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + (I ^ 3 = -I) → ((I * I = -1) → ( + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (BandVectors.1 (birth 0) (birth 2) = I * u) → ((BandVectors.1 (birth 2) (birth 0) = u) → + (I ^ 3 * (BandVectors.1 (birth 0) (birth 2) + BandVectors.1 (birth 2) (birth 0)) = (1 + - I) * u)))) ) := by + classical + intro q cfg birth I hI3 hI2mul u hforward2 hback2 + rw [hI3, hforward2, hback2] + rw [mul_add, ← mul_assoc] + simp [hI2mul] + ring + +private theorem hB1Zvec : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (birth + : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + (I ^ 3 = -I) → ((I * I = -1) → ( + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (BandVectors.1 (birth 0) (birth 3) = t) → ((BandVectors.1 (birth 3) (birth 0) = -I * t) → + (I ^ 3 * (BandVectors.1 (birth 3) (birth 0) - BandVectors.1 (birth 0) (birth 3)) = (I + - 1) * t)))) ) := by + classical + intro q cfg birth I hI3 hI2mul t hforward3 hback3 + rw [hI3, hback3, hforward3] + rw [sub_eq_add_neg, mul_add, ← mul_assoc] + simp [hI2mul] + ring + +private theorem hB2Wvec : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (birth + : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + (I ^ 2 = -1) → ( + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (BandVectors.1 (birth 0) (birth 3) = t) → ((BandVectors.1 (birth 3) (birth 0) = -I * t) → + (I ^ 2 * (BandVectors.1 (birth 0) (birth 3) + BandVectors.1 (birth 3) (birth 0)) = + -((1 - I) * t)))) ) := by + classical + intro q cfg birth I hI2 t hforward3 hback3 + rw [hI2, hforward3, hback3] + ring + +private theorem hB2Zvec : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (birth + : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + (I ^ 2 = -1) → ( + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (BandVectors.1 (birth 0) (birth 2) = I * u) → ((BandVectors.1 (birth 2) (birth 0) = u) → + (I ^ 2 * (BandVectors.1 (birth 0) (birth 2) - BandVectors.1 (birth 2) (birth 0)) = (1 + - I) * u))) ) := by + classical + intro q cfg birth I hI2 u hforward2 hback2 + rw [hI2, hforward2, hback2] + ring + +private theorem hA1W : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (∀ (x : GaussianInt), GaussianRealPoint ((I - 1) * x) = -GaussianRealPoint ((1 - I) * x)) + → ((TileCentroid (cert.Q 1 true) - TileCentroid cert.O = (-1 : Real) • ((1 / 2 : + Real) • GaussianRealPoint ((1 - I) * u))) → ((I * (BandVectors.1 (birth 0) (birth 2) + + BandVectors.1 (birth 2) (birth 0)) = (I - 1) * u) → (TileCentroid (cert.Q 1 true) - + TileCentroid cert.O = (1 / 2 : Real) • GaussianRealPoint (I * (BandVectors.1 (birth + 0) (birth 2) + BandVectors.1 (birth 2) (birth 0)))))) ) := by + classical + intro q cfg C₀ T cert birth I u gaussianPoint_Iminus_one hQ2O hA1Wvec + rw [hA1Wvec, gaussianPoint_Iminus_one] + simpa [smul_eq_mul] using hQ2O + +private theorem hA1Z : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (TileCentroid (cert.S 2 false) - TileCentroid cert.O = (1 / 2 : Real) • GaussianRealPoint + ((1 - I) * t)) → ((I * (BandVectors.1 (birth 3) (birth 0) - BandVectors.1 (birth 0) + (birth 3)) = (1 - I) * t) → (TileCentroid (cert.S 2 false) - TileCentroid cert.O = (1 + / 2 : Real) • GaussianRealPoint (I * (BandVectors.1 (birth 3) (birth 0) - + BandVectors.1 (birth 0) (birth 3))))) ) := by + classical + intro q cfg C₀ T cert birth I t hS3O hA1Zvec + rw [hA1Zvec] + exact hS3O + +private theorem hA2W : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (TileCentroid (cert.S 2 false) - TileCentroid cert.O = (1 / 2 : Real) • GaussianRealPoint + ((1 - I) * t)) → ((BandVectors.1 (birth 0) (birth 3) + BandVectors.1 (birth 3) (birth + 0) = (1 - I) * t) → (TileCentroid (cert.S 2 false) - TileCentroid cert.O = (1 / 2 : + Real) • GaussianRealPoint (BandVectors.1 (birth 0) (birth 3) + BandVectors.1 (birth + 3) (birth 0)))) ) := by + classical + intro q cfg C₀ T cert birth I t hS3O hA2Wvec + rw [hA2Wvec] + exact hS3O + +private theorem hA2Z : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (∀ (x : GaussianInt), GaussianRealPoint ((I - 1) * x) = -GaussianRealPoint ((1 - I) * x)) + → ((TileCentroid (cert.Q 1 true) - TileCentroid cert.O = (-1 : Real) • ((1 / 2 : + Real) • GaussianRealPoint ((1 - I) * u))) → ((BandVectors.1 (birth 0) (birth 2) - + BandVectors.1 (birth 2) (birth 0) = (I - 1) * u) → (TileCentroid (cert.Q 1 true) - + TileCentroid cert.O = (1 / 2 : Real) • GaussianRealPoint (BandVectors.1 (birth 0) + (birth 2) - BandVectors.1 (birth 2) (birth 0))))) ) := by + classical + intro q cfg C₀ T cert birth I u gaussianPoint_Iminus_one hQ2O hA2Zvec + rw [hA2Zvec, gaussianPoint_Iminus_one] + simpa [smul_eq_mul] using hQ2O + +private theorem hB1W : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (TileCentroid (cert.S 1 false) - TileCentroid cert.O = (1 / 2 : Real) • GaussianRealPoint + ((1 - I) * u)) → ((I ^ 3 * (BandVectors.1 (birth 0) (birth 2) + BandVectors.1 (birth + 2) (birth 0)) = (1 - I) * u) → (TileCentroid (cert.S 1 false) - TileCentroid cert.O = + (1 / 2 : Real) • GaussianRealPoint (I ^ 3 * (BandVectors.1 (birth 0) (birth 2) + + BandVectors.1 (birth 2) (birth 0))))) ) := by + classical + intro q cfg C₀ T cert birth I u hS2O hB1Wvec + rw [hB1Wvec] + exact hS2O + +private theorem hB1Z : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (∀ (x : GaussianInt), GaussianRealPoint ((I - 1) * x) = -GaussianRealPoint ((1 - I) * x)) + → ((TileCentroid (cert.Q 2 true) - TileCentroid cert.O = (-1 : Real) • ((1 / 2 : + Real) • GaussianRealPoint ((1 - I) * t))) → ((I ^ 3 * (BandVectors.1 (birth 3) (birth + 0) - BandVectors.1 (birth 0) (birth 3)) = (I - 1) * t) → (TileCentroid (cert.Q 2 + true) - TileCentroid cert.O = (1 / 2 : Real) • GaussianRealPoint (I ^ 3 * + (BandVectors.1 (birth 3) (birth 0) - BandVectors.1 (birth 0) (birth 3)))))) ) := by + classical + intro q cfg C₀ T cert birth I t gaussianPoint_Iminus_one hQ3O hB1Zvec + rw [hB1Zvec, gaussianPoint_Iminus_one] + simpa [smul_eq_mul] using hQ3O + +private theorem hB2W : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (∀ (x : GaussianInt), GaussianRealPoint (-x) = -GaussianRealPoint x) → ((TileCentroid + (cert.Q 2 true) - TileCentroid cert.O = (-1 : Real) • ((1 / 2 : Real) • + GaussianRealPoint ((1 - I) * t))) → ((I ^ 2 * (BandVectors.1 (birth 0) (birth 3) + + BandVectors.1 (birth 3) (birth 0)) = -((1 - I) * t)) → (TileCentroid (cert.Q 2 true) + - TileCentroid cert.O = (1 / 2 : Real) • GaussianRealPoint (I ^ 2 * (BandVectors.1 + (birth 0) (birth 3) + BandVectors.1 (birth 3) (birth 0)))))) ) := by + classical + intro q cfg C₀ T cert birth I t gaussianPoint_neg hQ3O hB2Wvec + rw [hB2Wvec, gaussianPoint_neg] + simpa [smul_eq_mul] using hQ3O + +private theorem hB2Z : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (TileCentroid (cert.S 1 false) - TileCentroid cert.O = (1 / 2 : Real) • GaussianRealPoint + ((1 - I) * u)) → ((I ^ 2 * (BandVectors.1 (birth 0) (birth 2) - BandVectors.1 (birth + 2) (birth 0)) = (1 - I) * u) → (TileCentroid (cert.S 1 false) - TileCentroid cert.O = + (1 / 2 : Real) • GaussianRealPoint (I ^ 2 * (BandVectors.1 (birth 0) (birth 2) - + BandVectors.1 (birth 2) (birth 0))))) ) := by + classical + intro q cfg C₀ T cert birth I u hS2O hB2Zvec + rw [hB2Zvec] + exact hS2O + +private theorem hnotA1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), (∀ (U : ProtoTile), ∀ (V : ProtoTile), + ∀ (W : ProtoTile), ∀ (Z : ProtoTile), ∀ (right : ExactTileInterfaceTriple U V W), ∀ + (adjacent : ExactTileInterfaceTriple U W Z), ∀ (incomingPoint : GaussianInt), + (right.point ≠ incomingPoint) → ((adjacent.point = incomingPoint) → (∀ (cut : + GaussianInt), (cut ∈ FootprintVertices U) → ((cut ∈ FootprintVertices W) → ((cut ∈ + FootprintVertices Z) → (cut ∉ FootprintVertices V)))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (BandVectors.1 (birth 2) (birth 0) = u) → ((cert.exceptional_segments.a ∈ + FootprintVertices cert.O) → ((cert.exceptional_segments.a ∈ FootprintVertices (cert.Q + (1 : Fin (3 : ℕ)) true)) → ((cert.exceptional_segments.a ∈ FootprintVertices (cert.S + (2 : Fin (3 : ℕ)) false)) → (∀ (rightA1 : ExactTileInterfaceTriple cert.O + (TileTranslation cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑(1 : Fin (4 : ℕ)) : + ℕ) * if Even (↑(1 : Fin (4 : ℕ)) : ℕ) then BandVectors.1 (birth (0 : Fin (4 : ℕ))) + (birth (Fin.succ (1 : Fin (3 : ℕ)))) else BandVectors.1 (birth (Fin.succ (1 : Fin (3 + : ℕ)))) (birth (0 : Fin (4 : ℕ))))) (cert.Q (1 : Fin (3 : ℕ)) true)), ∀ (incomingA1 : + ExactTileInterfaceTriple cert.O (TileTranslation cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑(1 : Fin (4 : ℕ)) : ℕ) * if Even (↑(1 : Fin (4 : ℕ)) : ℕ) then + BandVectors.1 (birth (Fin.succ (1 : Fin (3 : ℕ)))) (birth (0 : Fin (4 : ℕ))) else + BandVectors.1 (birth (0 : Fin (4 : ℕ))) (birth (Fin.succ (1 : Fin (3 : ℕ)))))) + (cert.Q (1 : Fin (3 : ℕ)) true)), ∀ (adjacentA1 : ExactTileInterfaceTriple cert.O + (cert.Q (1 : Fin (3 : ℕ)) true) (cert.S (2 : Fin (3 : ℕ)) false)), (rightA1.point ≠ + incomingA1.point) → ((adjacentA1.point = incomingA1.point) → + (cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation cert.O (I * + u))))))))) ) := by + classical + intro q cfg C₀ T cert birth exact_exclusion I u hback2 haO haQ2 haS3 rightA1 incomingA1 + adjacentA1 hneA1 halignA1 + have hn := exact_exclusion _ _ _ _ rightA1 adjacentA1 incomingA1.point + hneA1 halignA1 cert.exceptional_segments.a haO haQ2 haS3 + simpa [I, hback2] using hn + +private theorem hnotA2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), (∀ (U : ProtoTile), ∀ (V : ProtoTile), + ∀ (W : ProtoTile), ∀ (Z : ProtoTile), ∀ (right : ExactTileInterfaceTriple U V W), ∀ + (adjacent : ExactTileInterfaceTriple U W Z), ∀ (incomingPoint : GaussianInt), + (right.point ≠ incomingPoint) → ((adjacent.point = incomingPoint) → (∀ (cut : + GaussianInt), (cut ∈ FootprintVertices U) → ((cut ∈ FootprintVertices W) → ((cut ∈ + FootprintVertices Z) → (cut ∉ FootprintVertices V)))))) → ( + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (BandVectors.1 (birth 0) (birth 3) = t) → ((cert.exceptional_segments.a ∈ + FootprintVertices cert.O) → ((cert.exceptional_segments.a ∈ FootprintVertices (cert.Q + (1 : Fin (3 : ℕ)) true)) → ((cert.exceptional_segments.a ∈ FootprintVertices (cert.S + (2 : Fin (3 : ℕ)) false)) → (∀ (rightA2 : ExactTileInterfaceTriple cert.O + (TileTranslation cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑(0 : Fin (4 : ℕ)) : + ℕ) * if Even (↑(0 : Fin (4 : ℕ)) : ℕ) then BandVectors.1 (birth (0 : Fin (4 : ℕ))) + (birth (Fin.succ (2 : Fin (3 : ℕ)))) else BandVectors.1 (birth (Fin.succ (2 : Fin (3 + : ℕ)))) (birth (0 : Fin (4 : ℕ))))) (cert.S (2 : Fin (3 : ℕ)) false)), ∀ (incomingA2 + : ExactTileInterfaceTriple cert.O (TileTranslation cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑(0 : Fin (4 : ℕ)) : ℕ) * if Even (↑(0 : Fin (4 : ℕ)) : ℕ) then + BandVectors.1 (birth (Fin.succ (2 : Fin (3 : ℕ)))) (birth (0 : Fin (4 : ℕ))) else + BandVectors.1 (birth (0 : Fin (4 : ℕ))) (birth (Fin.succ (2 : Fin (3 : ℕ)))))) + (cert.S (2 : Fin (3 : ℕ)) false)), ∀ (adjacentA2 : ExactTileInterfaceTriple cert.O + (cert.S (2 : Fin (3 : ℕ)) false) (cert.Q (1 : Fin (3 : ℕ)) true)), (rightA2.point ≠ + incomingA2.point) → ((adjacentA2.point = incomingA2.point) → + (cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation cert.O t)))))))) ) + := by + classical + intro q cfg C₀ T cert birth exact_exclusion t hforward3 haO haQ2 haS3 rightA2 incomingA2 + adjacentA2 hneA2 halignA2 + have hn := exact_exclusion _ _ _ _ rightA2 adjacentA2 incomingA2.point + hneA2 halignA2 cert.exceptional_segments.a haO haS3 haQ2 + simpa [hforward3] using hn + +private theorem hnotB1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), (∀ (U : ProtoTile), ∀ (V : ProtoTile), + ∀ (W : ProtoTile), ∀ (Z : ProtoTile), ∀ (right : ExactTileInterfaceTriple U V W), ∀ + (adjacent : ExactTileInterfaceTriple U W Z), ∀ (incomingPoint : GaussianInt), + (right.point ≠ incomingPoint) → ((adjacent.point = incomingPoint) → (∀ (cut : + GaussianInt), (cut ∈ FootprintVertices U) → ((cut ∈ FootprintVertices W) → ((cut ∈ + FootprintVertices Z) → (cut ∉ FootprintVertices V)))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + (I ^ 3 = -I) → ( + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + (BandVectors.1 (birth 2) (birth 0) = u) → ((cert.exceptional_segments.b ∈ + FootprintVertices cert.O) → ((cert.exceptional_segments.b ∈ FootprintVertices (cert.Q + (2 : Fin (3 : ℕ)) true)) → ((cert.exceptional_segments.b ∈ FootprintVertices (cert.S + (1 : Fin (3 : ℕ)) false)) → (∀ (rightB1 : ExactTileInterfaceTriple cert.O + (TileTranslation cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑(3 : Fin (4 : ℕ)) : + ℕ) * if Even (↑(3 : Fin (4 : ℕ)) : ℕ) then BandVectors.1 (birth (0 : Fin (4 : ℕ))) + (birth (Fin.succ (1 : Fin (3 : ℕ)))) else BandVectors.1 (birth (Fin.succ (1 : Fin (3 + : ℕ)))) (birth (0 : Fin (4 : ℕ))))) (cert.S (1 : Fin (3 : ℕ)) false)), ∀ (incomingB1 + : ExactTileInterfaceTriple cert.O (TileTranslation cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑(3 : Fin (4 : ℕ)) : ℕ) * if Even (↑(3 : Fin (4 : ℕ)) : ℕ) then + BandVectors.1 (birth (Fin.succ (1 : Fin (3 : ℕ)))) (birth (0 : Fin (4 : ℕ))) else + BandVectors.1 (birth (0 : Fin (4 : ℕ))) (birth (Fin.succ (1 : Fin (3 : ℕ)))))) + (cert.S (1 : Fin (3 : ℕ)) false)), ∀ (adjacentB1 : ExactTileInterfaceTriple cert.O + (cert.S (1 : Fin (3 : ℕ)) false) (cert.Q (2 : Fin (3 : ℕ)) true)), (rightB1.point ≠ + incomingB1.point) → ((adjacentB1.point = incomingB1.point) → + (cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O (-((⟨0, 1⟩ : + GaussianInt) * BandVectors.1 (q 2) (cfg.firstPredecessor 1)))))))))))) ) := by + classical + intro q cfg C₀ T cert birth exact_exclusion I hI3 u hback2 hbO hbQ3 hbS2 rightB1 incomingB1 + adjacentB1 hneB1 halignB1 + have hn := exact_exclusion _ _ _ _ rightB1 adjacentB1 incomingB1.point + hneB1 halignB1 cert.exceptional_segments.b hbO hbS2 hbQ3 + have hn' := hn + have hn'' : cert.exceptional_segments.b ∉ FootprintVertices + (TileTranslation cert.O (I ^ 3 * BandVectors.1 (birth 2) (birth 0))) := by + split_ifs at hn' with hparity + · rcases hparity with ⟨k, hk⟩ + omega + · simpa [I] using hn' + have hn''' : cert.exceptional_segments.b ∉ + FootprintVertices (TileTranslation cert.O (-I * u)) := by + simpa [hI3, hback2] using hn'' + have hshift : -I * u = -((⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (q 2) (cfg.firstPredecessor 1)) := by + dsimp [I, u] + ring + rw [hshift] at hn''' + exact hn''' + +private theorem hnotB2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), (∀ (U : ProtoTile), ∀ (V : ProtoTile), + ∀ (W : ProtoTile), ∀ (Z : ProtoTile), ∀ (right : ExactTileInterfaceTriple U V W), ∀ + (adjacent : ExactTileInterfaceTriple U W Z), ∀ (incomingPoint : GaussianInt), + (right.point ≠ incomingPoint) → ((adjacent.point = incomingPoint) → (∀ (cut : + GaussianInt), (cut ∈ FootprintVertices U) → ((cut ∈ FootprintVertices W) → ((cut ∈ + FootprintVertices Z) → (cut ∉ FootprintVertices V)))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + (I ^ 2 = -1) → ( + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + (BandVectors.1 (birth 0) (birth 3) = t) → ((Even 2) → ((cert.exceptional_segments.b ∈ + FootprintVertices cert.O) → ((cert.exceptional_segments.b ∈ FootprintVertices (cert.Q + (2 : Fin (3 : ℕ)) true)) → ((cert.exceptional_segments.b ∈ FootprintVertices (cert.S + (1 : Fin (3 : ℕ)) false)) → (∀ (rightB2 : ExactTileInterfaceTriple cert.O + (TileTranslation cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑(2 : Fin (4 : ℕ)) : + ℕ) * if Even (↑(2 : Fin (4 : ℕ)) : ℕ) then BandVectors.1 (birth (0 : Fin (4 : ℕ))) + (birth (Fin.succ (2 : Fin (3 : ℕ)))) else BandVectors.1 (birth (Fin.succ (2 : Fin (3 + : ℕ)))) (birth (0 : Fin (4 : ℕ))))) (cert.Q (2 : Fin (3 : ℕ)) true)), ∀ (incomingB2 : + ExactTileInterfaceTriple cert.O (TileTranslation cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑(2 : Fin (4 : ℕ)) : ℕ) * if Even (↑(2 : Fin (4 : ℕ)) : ℕ) then + BandVectors.1 (birth (Fin.succ (2 : Fin (3 : ℕ)))) (birth (0 : Fin (4 : ℕ))) else + BandVectors.1 (birth (0 : Fin (4 : ℕ))) (birth (Fin.succ (2 : Fin (3 : ℕ)))))) + (cert.Q (2 : Fin (3 : ℕ)) true)), ∀ (adjacentB2 : ExactTileInterfaceTriple cert.O + (cert.Q (2 : Fin (3 : ℕ)) true) (cert.S (1 : Fin (3 : ℕ)) false)), (rightB2.point ≠ + incomingB2.point) → ((adjacentB2.point = incomingB2.point) → + (cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O + (-t))))))))))) ) := by + classical + intro q cfg C₀ T cert birth exact_exclusion I hI2 t hforward3 hEven2 hbO hbQ3 hbS2 rightB2 + incomingB2 adjacentB2 hneB2 halignB2 + have hn := exact_exclusion _ _ _ _ rightB2 adjacentB2 incomingB2.point + hneB2 halignB2 cert.exceptional_segments.b hbO hbQ3 hbS2 + simpa [I, hI2, hEven2, hforward3] using hn + +end PositiveCutExclusionGeometry + +namespace PositiveCutBranchConclusion + +private theorem fourthParentExclusion : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (birth : Fin 4 → CircleCoordinates), (ProperBandQuadruple birth) → ((∀ (X : + ProtoTile), ∀ x ∈ BoundaryFootprintVertices X, x ∈ FootprintVertices X) → ((∀ (U : + ProtoTile), ∀ (V : ProtoTile), ∀ (W : ProtoTile), ∀ (Z : ProtoTile), ∀ (right : + ExactTileInterfaceTriple U V W), ∀ (adjacent : ExactTileInterfaceTriple U W Z), ∀ + (incomingPoint : GaussianInt), right.point ≠ incomingPoint → adjacent.point = + incomingPoint → ∀ cut ∈ FootprintVertices U, cut ∈ FootprintVertices W → cut ∈ + FootprintVertices Z → cut ∉ FootprintVertices V) → ((0 < (q 2).1) → ((0 < (q 3).1) → + ((0 < (cfg.firstPredecessor 1).1) → ( + let I : GaussianInt := ⟨0, 1⟩ + (I ^ 2 = -1) → ((I ^ 3 = -I) → ((I * I = -1) → ( + ( + let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); + let w := BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); TileCentroid cert.O - + TileCentroid (cert.P (0 : Fin (3 : ℕ)) true) = (-1 : ℝ) • (1 / 2 : ℝ) • + GaussianRealPoint (((1 : GaussianInt) - I) * w)) → (( + let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); + let t := BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))); + TileCentroid (cert.Q (1 : Fin (3 : ℕ)) true) - TileCentroid (cert.P (0 : Fin (3 : ℕ)) + true) = (1 / 2 : ℝ) • GaussianRealPoint (((1 : GaussianInt) - I) * t)) → (( + let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); + let u := BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))); + TileCentroid (cert.Q (2 : Fin (3 : ℕ)) true) - TileCentroid (cert.P (0 : Fin (3 : ℕ)) + true) = (1 / 2 : ℝ) • GaussianRealPoint (((1 : GaussianInt) - I) * u)) → (( + let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); + let t := BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))); + TileCentroid (cert.S (1 : Fin (3 : ℕ)) false) - TileCentroid (cert.P (0 : Fin (3 : + ℕ)) false) = (-1 : ℝ) • (1 / 2 : ℝ) • GaussianRealPoint (((1 : GaussianInt) - I) * + t)) → (( + let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); + let u := BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))); + TileCentroid (cert.S (2 : Fin (3 : ℕ)) false) - TileCentroid (cert.P (0 : Fin (3 : + ℕ)) false) = (-1 : ℝ) • (1 / 2 : ℝ) • GaussianRealPoint (((1 : GaussianInt) - I) * + u)) → (( + let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); + let w := BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); TileCentroid (cert.P + (0 : Fin (3 : ℕ)) false) - TileCentroid (cert.P (0 : Fin (3 : ℕ)) true) = (-1 : ℝ) • + GaussianRealPoint (((1 : GaussianInt) - I) * w)) → ((∀ (x : GaussianInt), + GaussianRealPoint (-x) = -GaussianRealPoint x) → ((∀ (x : GaussianInt), + GaussianRealPoint ((I - 1) * x) = -GaussianRealPoint ((1 - I) * x)) → + (((GaussianRealPoint (((1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).1 + (GaussianRealPoint + (((1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.1 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))))).1 + + (GaussianRealPoint (((1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * + BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))))).1 = (0 + : ℝ)) → (((GaussianRealPoint (((1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).2 + + (GaussianRealPoint (((1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * + BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))))).2 + + (GaussianRealPoint (((1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * + BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))))).2 = (0 + : ℝ)) → ((birth (0 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ)) ∧ birth (2 + : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ))) + → (((birth 0 = q 2 ∧ birth 2 = q 3 ∧ birth 3 = cfg.firstPredecessor 1) ∧ + cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation (cert.Q 1 true) + (BandVectors.1 (q 2) (cfg.firstPredecessor 1))) ∧ cert.exceptional_segments.b ∉ + FootprintVertices (TileTranslation (cert.S 1 false) (-BandVectors.1 (q 2) + (cfg.firstPredecessor 1)))) ∨ ((birth 0 = cfg.firstPredecessor 1 ∧ birth 2 = q 2 ∧ + birth 3 = q 3) ∧ cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation + cert.O ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 2) (cfg.firstPredecessor 1))) ∧ + cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation cert.O + (BandVectors.1 (cfg.firstPredecessor 1) (q 3))) ∧ cert.exceptional_segments.b ∉ + FootprintVertices (TileTranslation cert.O (-((⟨0, 1⟩ : GaussianInt) * BandVectors.1 + (q 2) (cfg.firstPredecessor 1)))) ∧ cert.exceptional_segments.b ∉ FootprintVertices + (TileTranslation cert.O (-BandVectors.1 (cfg.firstPredecessor 1) (q + 3)))))))))))))))))))))))) ) := by + classical + intro q cfg C₀ T cert birth hproper boundary_to_raw exact_exclusion hq2pos hq3pos hOpos I hI2 + hI3 hI2mul hOcent hQ2cent hQ3cent hS2cent hS3cent hPminus gaussianPoint_neg + gaussianPoint_Iminus_one hsumGaussianPointFst hsumGaussianPointSnd hp4 + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + have hf4 := (VectorRecursionLaws birth hproper.1).2.2.2.2 hproper + have hforward2 : BandVectors.1 (birth 0) (birth 2) = I * u := by + simpa [I, u, hp4.1, hp4.2.1] using (hf4 (1 : Fin 3)).1 + have hback2 : BandVectors.1 (birth 2) (birth 0) = u := by + simp [u, hp4.1, hp4.2.1] + have hforward3 : BandVectors.1 (birth 0) (birth 3) = t := by + simp [t, hp4.1, hp4.2.2] + have hflip3 : t = I * BandVectors.1 (birth 3) (birth 0) := by + simpa [I, t, hp4.1, hp4.2.2] using (hf4 (2 : Fin 3)).1 + have hback3 := PositiveCutExclusionGeometry.hback3 q cfg birth hflip3 + have hOproto : BandPrototile (birth 0) cert.O := by + simpa [hp4.1, cert.precursor_eq] using (cert.plus_occurrence 0 false).1 + have hQ2proto : BandPrototile (birth 2) (cert.Q 1 true) := by + simpa [hp4.2.1, cfg.firstParentTwo] using (cert.plus_occurrence 1 true).1 + have hQ3proto : BandPrototile (birth 3) (cert.Q 2 true) := by + simpa [hp4.2.2, cfg.firstParentThree] using (cert.plus_occurrence 2 true).1 + have hS2proto : BandPrototile (birth 2) (cert.S 1 false) := by + simpa [hp4.2.1, cfg.firstParentTwo] using (cert.minus_occurrence 1 false).1 + have hS3proto : BandPrototile (birth 3) (cert.S 2 false) := by + simpa [hp4.2.2, cfg.firstParentThree] using (cert.minus_occurrence 2 false).1 + have hQ2O := PositiveCutExclusionGeometry.hQ2O q cfg C₀ T cert hOcent hQ2cent + hsumGaussianPointFst + hsumGaussianPointSnd + have hS3O := PositiveCutExclusionGeometry.hS3O q + cfg C₀ T cert hOcent hS3cent hPminus hsumGaussianPointFst hsumGaussianPointSnd + have hS2O := PositiveCutExclusionGeometry.hS2O q + cfg C₀ T cert hOcent hS2cent hPminus hsumGaussianPointFst hsumGaussianPointSnd + have hQ3O := PositiveCutExclusionGeometry.hQ3O q cfg C₀ T cert hOcent hQ3cent + hsumGaussianPointFst + hsumGaussianPointSnd + have hbirth2pos : 0 < (birth 2).1 := by simpa [hp4.2.1] using hq2pos + have hbirth3pos : 0 < (birth 3).1 := by simpa [hp4.2.2] using hq3pos + have hbirth0pos : 0 < (birth 0).1 := by + simpa [hp4.1, cert.precursor_eq] using hOpos + have hEven2 : Even 2 := by decide + have hEven3 : ¬ Even 3 := by decide + have hA1W : TileCentroid (cert.Q 1 true) - TileCentroid cert.O = + (1 / 2 : Real) • GaussianRealPoint + (I * (BandVectors.1 (birth 0) (birth 2) + BandVectors.1 (birth 2) (birth 0))) := + PositiveCutExclusionGeometry.hA1W q cfg C₀ T cert birth gaussianPoint_Iminus_one + hQ2O (PositiveCutExclusionGeometry.hA1Wvec q cfg birth hI2mul hforward2 hback2) + have hA1Z : TileCentroid (cert.S 2 false) - TileCentroid cert.O = + (1 / 2 : Real) • GaussianRealPoint + (I * (BandVectors.1 (birth 3) (birth 0) - BandVectors.1 (birth 0) (birth 3))) := + PositiveCutExclusionGeometry.hA1Z q cfg C₀ T cert birth hS3O + (PositiveCutExclusionGeometry.hA1Zvec q cfg birth hI2mul hforward3 hback3) + have hA2W : TileCentroid (cert.S 2 false) - TileCentroid cert.O = + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.1 (birth 0) (birth 3) + BandVectors.1 (birth 3) (birth 0)) := + PositiveCutExclusionGeometry.hA2W q cfg C₀ T cert birth hS3O + (PositiveCutExclusionGeometry.hA2Wvec q cfg birth hforward3 hback3) + have hA2Z : TileCentroid (cert.Q 1 true) - TileCentroid cert.O = + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.1 (birth 0) (birth 2) - BandVectors.1 (birth 2) (birth 0)) := + PositiveCutExclusionGeometry.hA2Z q cfg C₀ T cert birth gaussianPoint_Iminus_one + hQ2O (PositiveCutExclusionGeometry.hA2Zvec q cfg birth hforward2 hback2) + have hB1W : TileCentroid (cert.S 1 false) - TileCentroid cert.O = + (1 / 2 : Real) • GaussianRealPoint + (I ^ 3 * (BandVectors.1 (birth 0) (birth 2) + BandVectors.1 (birth 2) (birth 0))) := + PositiveCutExclusionGeometry.hB1W q cfg C₀ T cert birth hS2O + (PositiveCutExclusionGeometry.hB1Wvec q cfg birth hI3 hI2mul hforward2 hback2) + have hB1Z : TileCentroid (cert.Q 2 true) - TileCentroid cert.O = + (1 / 2 : Real) • GaussianRealPoint + (I ^ 3 * (BandVectors.1 (birth 3) (birth 0) - BandVectors.1 (birth 0) (birth 3))) := + PositiveCutExclusionGeometry.hB1Z q cfg C₀ T cert birth gaussianPoint_Iminus_one + hQ3O (PositiveCutExclusionGeometry.hB1Zvec q cfg birth hI3 hI2mul hforward3 hback3) + have hB2W : TileCentroid (cert.Q 2 true) - TileCentroid cert.O = + (1 / 2 : Real) • GaussianRealPoint + (I ^ 2 * (BandVectors.1 (birth 0) (birth 3) + BandVectors.1 (birth 3) (birth 0))) := + PositiveCutExclusionGeometry.hB2W q cfg C₀ T cert birth gaussianPoint_neg hQ3O + (PositiveCutExclusionGeometry.hB2Wvec q cfg birth hI2 hforward3 hback3) + have hB2Z : TileCentroid (cert.S 1 false) - TileCentroid cert.O = + (1 / 2 : Real) • GaussianRealPoint + (I ^ 2 * (BandVectors.1 (birth 0) (birth 2) - BandVectors.1 (birth 2) (birth 0))) := + PositiveCutExclusionGeometry.hB2Z q cfg C₀ T cert birth hS2O + (PositiveCutExclusionGeometry.hB2Zvec q cfg birth hI2 hforward2 hback2) + have haBoundary := (cert.exceptional_segments.first_cut_unique + cert.exceptional_segments.a).mpr rfl + have haO := boundary_to_raw cert.O cert.exceptional_segments.a haBoundary.2.2 + have haQ2 := boundary_to_raw (cert.Q 1 true) cert.exceptional_segments.a haBoundary.1 + have haS3 := boundary_to_raw (cert.S 2 false) cert.exceptional_segments.a haBoundary.2.1 + have hbBoundary := (cert.exceptional_segments.second_cut_unique + cert.exceptional_segments.b).mpr rfl + have hbO := boundary_to_raw cert.O cert.exceptional_segments.b hbBoundary.2.2 + have hbQ3 := boundary_to_raw (cert.Q 2 true) cert.exceptional_segments.b hbBoundary.1 + have hbS2 := boundary_to_raw (cert.S 1 false) cert.exceptional_segments.b hbBoundary.2.1 + have endpointA1 := BandOrientedChildParentEndpoints birth hproper + (1 : Fin 3) 1 cert.O (cert.Q 1 true) (cert.S 2 false) + hOproto hQ2proto hS3proto hbirth0pos hbirth2pos hbirth3pos + (by + have hs := add_comm (BandVectors.1 (birth 0) (birth 2)) + (BandVectors.1 (birth 2) (birth 0)) + rw [hs] at hA1W + simpa [I] using hA1W) + (by simpa [I] using hA1Z) + rcases endpointA1 with ⟨rightA1, incomingA1, adjacentA1, hneA1, halignA1, _, _, _⟩ + have hnotA1 := PositiveCutExclusionGeometry.hnotA1 q cfg C₀ T cert + birth exact_exclusion hback2 haO haQ2 haS3 rightA1 incomingA1 adjacentA1 hneA1 halignA1 + have endpointA2 := BandOrientedChildParentEndpoints birth hproper + (2 : Fin 3) 0 cert.O (cert.S 2 false) (cert.Q 1 true) + hOproto hS3proto hQ2proto hbirth0pos hbirth3pos hbirth2pos + (by simpa [add_comm] using hA2W) (by simpa using hA2Z) + rcases endpointA2 with ⟨rightA2, incomingA2, adjacentA2, hneA2, halignA2, _, _, _⟩ + have hnotA2 := PositiveCutExclusionGeometry.hnotA2 q cfg C₀ T cert birth + exact_exclusion hforward3 haO haQ2 haS3 rightA2 incomingA2 adjacentA2 hneA2 halignA2 + have endpointB1 := BandOrientedChildParentEndpoints birth hproper + (1 : Fin 3) 3 cert.O (cert.S 1 false) (cert.Q 2 true) + hOproto hS2proto hQ3proto hbirth0pos hbirth2pos hbirth3pos + (by + have hs := add_comm (BandVectors.1 (birth 0) (birth 2)) + (BandVectors.1 (birth 2) (birth 0)) + rw [hs] at hB1W + simpa [I] using hB1W) + (by simpa [I, hEven3] using hB1Z) + rcases endpointB1 with ⟨rightB1, incomingB1, adjacentB1, hneB1, halignB1, _, _, _⟩ + have hnotB1 := PositiveCutExclusionGeometry.hnotB1 + q cfg C₀ T cert birth exact_exclusion hI3 hback2 hbO hbQ3 hbS2 rightB1 incomingB1 + adjacentB1 hneB1 halignB1 + have endpointB2 := BandOrientedChildParentEndpoints birth hproper + (2 : Fin 3) 2 cert.O (cert.Q 2 true) (cert.S 1 false) + hOproto hQ3proto hS2proto hbirth0pos hbirth3pos hbirth2pos + (by simpa [I, add_comm] using hB2W) (by simpa using hB2Z) + rcases endpointB2 with ⟨rightB2, incomingB2, adjacentB2, hneB2, halignB2, _, _, _⟩ + exact Or.inr ⟨hp4, hnotA1, hnotA2, hnotB1, (PositiveCutExclusionGeometry.hnotB2 q cfg C₀ T + cert birth exact_exclusion hI2 hforward3 hEven2 hbO hbQ3 hbS2 rightB2 incomingB2 + adjacentB2 hneB2 halignB2)⟩ + +end PositiveCutBranchConclusion + +theorem BandPositiveCutBranchCompanionExclusion + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) + (hO : cert.O.cells.Nonempty) + (birth : Fin 4 → CircleCoordinates) + (hproper : ProperBandQuadruple birth) + (hbranch : + (birth 0 = q 2 ∧ birth 2 = q 3 ∧ + birth 3 = cfg.firstPredecessor 1) ∨ + (birth 0 = cfg.firstPredecessor 1 ∧ birth 2 = q 2 ∧ + birth 3 = q 3)) : + ((birth 0 = q 2 ∧ birth 2 = q 3 ∧ + birth 3 = cfg.firstPredecessor 1) ∧ + cert.exceptional_segments.a ∉ FootprintVertices + (TileTranslation (cert.Q 1 true) + (BandVectors.1 (q 2) (cfg.firstPredecessor 1))) ∧ + cert.exceptional_segments.b ∉ FootprintVertices + (TileTranslation (cert.S 1 false) + (-BandVectors.1 (q 2) (cfg.firstPredecessor 1)))) ∨ + ((birth 0 = cfg.firstPredecessor 1 ∧ birth 2 = q 2 ∧ + birth 3 = q 3) ∧ + cert.exceptional_segments.a ∉ FootprintVertices + (TileTranslation cert.O + ((⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (q 2) (cfg.firstPredecessor 1))) ∧ + cert.exceptional_segments.a ∉ FootprintVertices + (TileTranslation cert.O + (BandVectors.1 (cfg.firstPredecessor 1) (q 3))) ∧ + cert.exceptional_segments.b ∉ FootprintVertices + (TileTranslation cert.O + (-((⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (q 2) (cfg.firstPredecessor 1)))) ∧ + cert.exceptional_segments.b ∉ FootprintVertices + (TileTranslation cert.O + (-BandVectors.1 (cfg.firstPredecessor 1) (q 3)))) := by +-- BODY + have boundary_to_raw := PositiveCutExclusionGeometry.boundary_to_raw + (PositiveCutExclusionGeometry.boundary_edge_footprint) + (PositiveCutExclusionGeometry.edge_vertex_footprint) + have exact_exclusion := PositiveCutExclusionGeometry.exact_exclusion + have occurrence_centroid := PositiveCutExclusionGeometry.occurrence_centroid + have hcurv := ProperBandCurvatureStructure q cfg.proper + have hq2pos : 0 < (q 2).1 := by have := cfg.secondLarge; omega + have hq3pos : 0 < (q 3).1 := PositiveCutExclusionGeometry.hq3pos q cfg hcurv + have hOpos : 0 < (cfg.firstPredecessor 1).1 := PositiveCutExclusionGeometry.hOpos q cfg C₀ T + cert hO (PositiveCutExclusionGeometry.positive_of_nonempty) + let I : GaussianInt := ⟨0, 1⟩ + have hI2 : I ^ 2 = -1 := by dsimp [I]; decide + have hI3 : I ^ 3 = -I := by dsimp [I]; decide + have hI2mul : I * I = -1 := by dsimp [I]; decide + let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + have hOcent := PositiveCutExclusionGeometry.hOcent q cfg C₀ T cert occurrence_centroid + have hQ2cent := PositiveCutExclusionGeometry.hQ2cent q + cfg C₀ T cert occurrence_centroid + have hQ3cent := PositiveCutExclusionGeometry.hQ3cent q + cfg C₀ T cert occurrence_centroid + have hS2cent := PositiveCutExclusionGeometry.hS2cent q cfg C₀ T cert occurrence_centroid + have hS3cent := PositiveCutExclusionGeometry.hS3cent q cfg C₀ T cert occurrence_centroid + have hPminus := PositiveCutExclusionGeometry.hPminus q cfg + C₀ T cert occurrence_centroid + have gaussianPoint_neg (x : GaussianInt) : + GaussianRealPoint (-x) = -GaussianRealPoint x := + PositiveCutExclusionGeometry.gaussianPoint_neg x + have gaussianPoint_Iminus_one (x : GaussianInt) : + GaussianRealPoint ((I - 1) * x) = -GaussianRealPoint ((1 - I) * x) := + PositiveCutExclusionGeometry.gaussianPoint_Iminus_one gaussianPoint_neg x + have hsumGaussianPoint := PositiveCutExclusionGeometry.hsumGaussianPoint q + cfg (PositiveCutExclusionGeometry.gaussianPoint_add) + (PositiveCutExclusionGeometry.hprod q cfg (PositiveCutExclusionGeometry.hsum q cfg)) + have hsumGaussianPointFst := PositiveCutExclusionGeometry.hsumGaussianPointFst q cfg + hsumGaussianPoint + have hsumGaussianPointSnd := PositiveCutExclusionGeometry.hsumGaussianPointSnd q cfg + hsumGaussianPoint + rcases hbranch with hp2 | hp4 + · -- The two p2 endpoint packages are used only in this branch. + have hf := (VectorRecursionLaws birth hproper.1).2.2.2.2 hproper + have hforward' : BandVectors.1 (birth 0) (birth 3) = u := by + simp [u, hp2.1, hp2.2.2] + have hbackAdj : BandVectors.1 (birth 2) (birth 0) = w := by + simp [hp2.1, hp2.2.1, w] + have hargA : BandVectors.1 (birth 3) (birth 0) + + BandVectors.1 (birth 0) (birth 3) = (1 - I) * u := PositiveCutExclusionGeometry.hargA q + cfg birth (PositiveCutExclusionGeometry.hreverse q cfg birth + (PositiveCutExclusionGeometry.hforward q cfg birth hp2 hf)) hforward' + have hargAdj : BandVectors.1 (birth 0) (birth 2) - + BandVectors.1 (birth 2) (birth 0) = (I - 1) * w := PositiveCutExclusionGeometry.hargAdj q + birth (PositiveCutExclusionGeometry.hrootAdj q cfg birth hp2 hf) hbackAdj + have hU : BandPrototile (birth 0) (cert.Q 1 true) := by + simpa [hp2.1, cfg.firstParentTwo] using (cert.plus_occurrence 1 true).1 + have hW : BandPrototile (birth 3) cert.O := by + simpa [hp2.2.2, cert.precursor_eq] using (cert.plus_occurrence 0 false).1 + have hZ : BandPrototile (birth 2) (cert.S 2 false) := by + simpa [hp2.2.1, cfg.firstParentThree] using (cert.minus_occurrence 2 false).1 + have hUpos : 0 < (birth 0).1 := by simpa [hp2.1] using hq2pos + have hWpos : 0 < (birth 3).1 := by simpa [hp2.2.2] using hOpos + have hZpos : 0 < (birth 2).1 := by simpa [hp2.2.1] using hq3pos + have hWcent' : TileCentroid cert.O - TileCentroid (cert.Q 1 true) = + (1 / 2 : Real) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (0 : Nat) * + (BandVectors.1 (birth 3) (birth 0) + BandVectors.1 (birth 0) (birth 3))) := + PositiveCutExclusionGeometry.hWcent'At387 q cfg C₀ T cert birth + (PositiveCutExclusionGeometry.hWcent q cfg C₀ T cert birth hOcent hQ2cent + hsumGaussianPointFst hsumGaussianPointSnd hargA) + have hZcent' := (PositiveCutExclusionGeometry.hZcent q cfg C₀ T cert hQ2cent hS3cent hPminus + hsumGaussianPointFst hsumGaussianPointSnd) + have endpoint := BandOrientedChildParentEndpoints birth hproper + (2 : Fin 3) 0 (cert.Q 1 true) cert.O (cert.S 2 false) + hU hW hZ hUpos hWpos hZpos hWcent' + (by simpa [I, hargAdj, gaussianPoint_Iminus_one] using hZcent') + rcases endpoint with ⟨right, incoming, adjacent, hne, halign, _, _, _⟩ + have haBoundary := (cert.exceptional_segments.first_cut_unique + cert.exceptional_segments.a).mpr rfl + have haU := boundary_to_raw (cert.Q 1 true) cert.exceptional_segments.a haBoundary.1 + have haZ := boundary_to_raw (cert.S 2 false) cert.exceptional_segments.a haBoundary.2.1 + have haW := boundary_to_raw cert.O cert.exceptional_segments.a haBoundary.2.2 + have hnotA := PositiveCutExclusionGeometry.hnotA q cfg C₀ T cert + birth exact_exclusion hforward' right incoming adjacent hne halign haU haZ haW + have hU' : BandPrototile (birth 0) (cert.S 1 false) := by + simpa [hp2.1, cfg.firstParentTwo] using (cert.minus_occurrence 1 false).1 + have hZ' : BandPrototile (birth 2) (cert.Q 2 true) := by + simpa [hp2.2.1, cfg.firstParentThree] using (cert.plus_occurrence 2 true).1 + have hWcent' : TileCentroid cert.O - TileCentroid (cert.S 1 false) = + (-1 : Real) • ((1 / 2 : Real) • GaussianRealPoint ((1 - I) * u)) := + PositiveCutExclusionGeometry.hWcent'At413 q cfg C₀ T cert hOcent hS2cent hPminus + hsumGaussianPointFst hsumGaussianPointSnd + have hZcent' : TileCentroid (cert.Q 2 true) - TileCentroid (cert.S 1 false) = + (1 / 2 : Real) • GaussianRealPoint ((1 - I) * w) := + PositiveCutExclusionGeometry.hZcent'At426 q cfg C₀ T cert hQ3cent hS2cent hPminus + hsumGaussianPointFst hsumGaussianPointSnd + have endpoint' := BandOrientedChildParentEndpoints birth hproper + (2 : Fin 3) 2 (cert.S 1 false) cert.O (cert.Q 2 true) + hU' hW hZ' hUpos hWpos hZpos + (by simpa [I, hI2, hargA, gaussianPoint_neg] using hWcent') + (by simpa [I, hI2, hargAdj, gaussianPoint_Iminus_one, gaussianPoint_neg] using hZcent') + rcases endpoint' with ⟨right', incoming', adjacent', hne', halign', _, _, _⟩ + have hbBoundary := (cert.exceptional_segments.second_cut_unique + cert.exceptional_segments.b).mpr rfl + have hbU := boundary_to_raw (cert.S 1 false) cert.exceptional_segments.b hbBoundary.2.1 + have hbZ := boundary_to_raw (cert.Q 2 true) cert.exceptional_segments.b hbBoundary.1 + have hbW := boundary_to_raw cert.O cert.exceptional_segments.b hbBoundary.2.2 + exact Or.inl ⟨hp2, hnotA, (PositiveCutExclusionGeometry.hnotB q cfg C₀ T cert birth + exact_exclusion hI2 hforward' right' incoming' adjacent' hne' halign' hbU hbZ hbW)⟩ + · -- The four p4 endpoint packages are used only in this branch. + have fourthParentExclusion : + ((birth 0 = q 2 ∧ birth 2 = q 3 ∧ + birth 3 = cfg.firstPredecessor 1) ∧ + cert.exceptional_segments.a ∉ FootprintVertices + (TileTranslation (cert.Q 1 true) + (BandVectors.1 (q 2) (cfg.firstPredecessor 1))) ∧ + cert.exceptional_segments.b ∉ FootprintVertices + (TileTranslation (cert.S 1 false) + (-BandVectors.1 (q 2) (cfg.firstPredecessor 1)))) ∨ + ((birth 0 = cfg.firstPredecessor 1 ∧ birth 2 = q 2 ∧ + birth 3 = q 3) ∧ + cert.exceptional_segments.a ∉ FootprintVertices + (TileTranslation cert.O + ((⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (q 2) (cfg.firstPredecessor 1))) ∧ + cert.exceptional_segments.a ∉ FootprintVertices + (TileTranslation cert.O + (BandVectors.1 (cfg.firstPredecessor 1) (q 3))) ∧ + cert.exceptional_segments.b ∉ FootprintVertices + (TileTranslation cert.O + (-((⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (q 2) (cfg.firstPredecessor 1)))) ∧ + cert.exceptional_segments.b ∉ FootprintVertices + (TileTranslation cert.O + (-BandVectors.1 (cfg.firstPredecessor 1) (q 3)))) := + PositiveCutBranchConclusion.fourthParentExclusion q cfg C₀ T cert birth hproper + boundary_to_raw exact_exclusion hq2pos hq3pos hOpos hI2 hI3 hI2mul hOcent hQ2cent + hQ3cent hS2cent hS3cent hPminus gaussianPoint_neg gaussianPoint_Iminus_one + hsumGaussianPointFst hsumGaussianPointSnd hp4 + exact fourthParentExclusion + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPredecessorNoCollision.lean b/LeanPool/ApollonianSuperharmonic/BandPredecessorNoCollision.lean new file mode 100644 index 0000000000..f9f57b5426 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPredecessorNoCollision.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4828T1HistoryNormalForm +public import LeanPool.ApollonianSuperharmonic.P4828T1HistoryRealization +public import LeanPool.ApollonianSuperharmonic.P4828T1RootSeparation +public import LeanPool.ApollonianSuperharmonic.P4828T1FiniteWordSeparation +public import LeanPool.ApollonianSuperharmonic.P4828T1ParentsDistinct + +-- [TABLET NODE: BandPredecessorNoCollision] + +/-! +# BandPredecessorNoCollision + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandPredecessorNoCollision (q q' : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) (hq' : ProperBandQuadruple q') + (hchild : q 0 = q' 0) : + ∃! r : Fin 3, ∀ j : Fin 3, q' j.succ = q ((j + r).succ) := by +-- BODY + let G (a : GaussianInt × Bool) (w : List (Fin 3)) := + P4828T1Gap (2 * (a.1.re : Real)) (P4828T1Evaluate a.1 a.2 w) + let D (a : GaussianInt × Bool) (w : List (Fin 3)) := + P4828T1Disk (P4828T1Evaluate a.1 a.2 w 0) + have separated := P4828T1FiniteWordSeparation G D + (fun a b h => P4828T1RootSeparation a.1 b.1 a.2 b.2 + (by simpa only [Prod.mk.eta] using h)) + (fun a w b => (P4828T1HistoryRealization a.1 a.2 w).2.1 b |>.1) + (fun a w b c h => (P4828T1HistoryRealization a.1 a.2 w).2.2 b c h) + (fun a w b => (P4828T1HistoryRealization a.1 a.2 w).2.1 b |>.2) + (fun a w => (P4828T1HistoryRealization a.1 a.2 w).1.2.2) + (by + intro a w + have pos := (ProperBandCurvatureStructure _ + (P4828T1HistoryRealization a.1 a.2 w).1.1).1 + refine ⟨(P4828T1Evaluate a.1 a.2 w 0).2 / + ((P4828T1Evaluate a.1 a.2 w 0).1 : Real), ?_⟩ + change dist _ _ < 1 / ((P4828T1Evaluate a.1 a.2 w 0).1 : Real) + rw [dist_self] + exact one_div_pos.mpr (by exact_mod_cast pos)) + obtain ⟨a, e, w, r, hqrep⟩ := P4828T1HistoryNormalForm q hq + obtain ⟨a', e', w', r', hq'rep⟩ := P4828T1HistoryNormalForm q' hq' + have hcoord : P4828T1Evaluate a e w 0 = P4828T1Evaluate a' e' w' 0 := by + simpa only [hqrep, hq'rep, P4828T1Rotate, Fin.cases_zero] using hchild + have hindex : ((a, e), w) = ((a', e'), w') := by + by_contra hne + have hdis := separated.2.2.2 (a, e) (a', e') w w' hne + have pos := (ProperBandCurvatureStructure _ + (P4828T1HistoryRealization a e w).1.1).1 + have hp : ((P4828T1Evaluate a e w 0).2 : Complex) / + ((P4828T1Evaluate a e w 0).1 : Real) ∈ D (a, e) w := by + change dist _ _ < 1 / ((P4828T1Evaluate a e w 0).1 : Real) + rw [dist_self] + exact one_div_pos.mpr (by exact_mod_cast pos) + have heq : D (a, e) w = D (a', e') w' := congrArg P4828T1Disk hcoord + exact Set.disjoint_left.mp hdis hp (by rwa [← heq]) + have ha : a = a' := congrArg (fun x => x.1.1) hindex + have he : e = e' := congrArg (fun x => x.1.2) hindex + have hw : w = w' := congrArg Prod.snd hindex + subst a' + subst e' + subst w' + refine ⟨r' - r, ?_, ?_⟩ + · intro j + rw [hqrep, hq'rep] + simp only [P4828T1Rotate, Fin.cases_succ] + congr 2 + omega + · intro s hs + have eqs := hs (0 : Fin 3) + have eqr : q' (0 : Fin 3).succ = q ((0 + (r' - r)).succ) := by + rw [hqrep, hq'rep] + simp only [P4828T1Rotate, Fin.cases_succ] + congr 2 + omega + have idx := P4828T1ParentsDistinct q hq (eqs.symm.trans eqr) + simpa using idx + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototile.lean b/LeanPool/ApollonianSuperharmonic/BandPrototile.lean new file mode 100644 index 0000000000..85e8e37c01 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPrototile.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.TileCentroid + +-- [TABLET NODE: BandPrototile] + +/-! +# BandPrototile + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The relation “$T$ is a band prototile for $C$” is generated recursively as +follows. A line $(0,\pm1)$ has the empty prototile with any chosen singleton +anchor. A curvature-one root $(1,1+2z)$ has any singleton cell $\{s_x\}$; +as for every nonempty prototile, its stored anchor is auxiliary and +unrestricted. +For a proper quadruple $(C_0,C_1,C_2,C_3)$, choose two prototiles +$T_i^\pm$ for every parent. Their union is a prototile $T_0$ when every +parent footprint is contained in the child footprint and, for every cyclic +ordering $(i,j,k)$ of $(1,2,3)$, +$$ + \operatorname{cent}(T_i^\pm)-\operatorname{cent}(T_0) + =\pm\tfrac12\bigl([v_{kj}]-[iv_{kj}]\bigr). +$$ +No disk, symmetry, touching, or tiling conclusion is part of this recursive +definition. +-/ +inductive BandPrototile : CircleCoordinates → ProtoTile → Prop where +-- BODY + | line (w x : GaussianInt) (hw : w = 1 ∨ w = -1) : + BandPrototile (0, w) ⟨∅, x⟩ + | unit (z x anchor : GaussianInt) : + BandPrototile (1, 1 + 2 * z) ⟨{x}, anchor⟩ + | decompose {q : Fin 4 → CircleCoordinates} (hq : ProperBandQuadruple q) + {S : Fin 3 → Bool → ProtoTile} {T : ProtoTile} + (hS : ∀ i s, BandPrototile (q i.succ) (S i s)) + (hcells : ∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (S i s).cells) + (hfoot : ∀ i s, FootprintVertices (S i s) ⊆ FootprintVertices T) + (hcentroid : ∀ i s, + TileCentroid (S i s) - TileCentroid T = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + ((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1))))) : + BandPrototile (q 0) T + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileCentralSymmetry.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileCentralSymmetry.lean new file mode 100644 index 0000000000..20b6cae62e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileCentralSymmetry.lean @@ -0,0 +1,276 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: BandPrototileCentralSymmetry] + +/-! +# BandPrototileCentralSymmetry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CentralSymmetryProof + +private theorem pair : + ∀ (T : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandPrototile (q i.succ) (S i s)) → ((∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S i s) - TileCentroid T = (if s = true + then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (2 + : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : + ℕ))).succ))).1))) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), CentrallyReflectedAt + (TileCentroid (S i s)) (S i s) (S i s)) → (∀ i : Fin 3, CentrallyReflectedAt + (TileCentroid T) (S i true) (S i false)))) := by + classical + intro T q S hS hcentroid ih i + let w := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let u := GaussianQuarterTurn w - w + have hplus := hcentroid i true + have hminus := hcentroid i false + have hu_re : (u.re : Real) = + -(GaussianRealPoint w).1 - (GaussianRealPoint w).2 := by + change (((-w.im - w.re : Int) : Real)) = + -((w.re : Int) : Real) - ((w.im : Int) : Real) + norm_num + ring + have hu_im : (u.im : Real) = + (GaussianRealPoint w).1 - (GaussianRealPoint w).2 := by + change (((w.re - w.im : Int) : Real)) = + ((w.re : Int) : Real) - ((w.im : Int) : Real) + norm_num + have hurexp : (u.re : Real) = + -((BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))).re : Real) - + ((BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))).im : Real) := by + simpa [w, GaussianRealPoint] using hu_re + have huimexp : (u.im : Real) = + ((BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))).re : Real) - + ((BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))).im : Real) := by + simpa [w, GaussianRealPoint] using hu_im + have hcent : TileCentroid (TileTranslation (S i true) u) = + TileCentroid (S i false) := by + rw [(TileTranslationFormulas (S i true) u).2.2.2.2.1] + have hre := congrArg Prod.fst hplus + have him := congrArg Prod.snd hplus + have hrem := congrArg Prod.fst hminus + have himm := congrArg Prod.snd hminus + dsimp [w] at hre him hrem himm + dsimp [w, GaussianRealPoint] at hu_re hu_im + have hre' : (TileCentroid (S i true)).1 - (TileCentroid T).1 = + (1 / 2 : Real) * (((w.re : Int) : Real) + ((w.im : Int) : Real)) := by + simpa [w, GaussianRealPoint] using hre + have him' : (TileCentroid (S i true)).2 - (TileCentroid T).2 = + (1 / 2 : Real) * (((w.im : Int) : Real) - ((w.re : Int) : Real)) := by + simpa [w, GaussianRealPoint] using him + have hrem' : (TileCentroid (S i false)).1 - (TileCentroid T).1 = + -(1 / 2 : Real) * (((w.re : Int) : Real) + ((w.im : Int) : Real)) := by + simpa [w, GaussianRealPoint] using hrem + have himm' : (TileCentroid (S i false)).2 - (TileCentroid T).2 = + -(1 / 2 : Real) * (((w.im : Int) : Real) - ((w.re : Int) : Real)) := by + simpa [w, GaussianRealPoint] using himm + apply Prod.ext + · change (TileCentroid (S i true)).1 + (u.re : Real) = _ + rw [hu_re] + linarith [hrem'] + · change (TileCentroid (S i true)).2 + (u.im : Real) = _ + rw [hu_im] + linarith [himm'] + have translated : BandPrototile (q i.succ) (TileTranslation (S i true) u) := + BandPrototileTranslation (q i.succ) (S i true) u (hS i true) + have unique := BandPrototileCentroidUnique (q i.succ) + (TileTranslation (S i true) u) (S i false) translated (hS i false) hcent + have hcells' : (TileTranslation (S i true) u).cells = (S i false).cells := unique.1 + have hreal : TileRealization (TileTranslation (S i true) u) = + TileRealization (S i false) := by + rw [TileRealization, hcells', TileRealization] + have hcentral := ih i true + have hreflect : CentrallyReflectedAt (TileCentroid T) + (S i true) (S i false) := by + rw [CentrallyReflectedAt, ← hreal, + (TileTranslationFormulas (S i true) u).2.2.2.1] + nth_rewrite 1 [hcentral] + rw [Set.image_image] + have map_eq : + (fun z : Real × Real => + ((2 * (TileCentroid (S i true)).1 - z.1, + 2 * (TileCentroid (S i true)).2 - z.2).1 + (u.re : Real), + (2 * (TileCentroid (S i true)).1 - z.1, + 2 * (TileCentroid (S i true)).2 - z.2).2 + (u.im : Real))) = + (fun z : Real × Real => + (2 * (TileCentroid T).1 - z.1, 2 * (TileCentroid T).2 - z.2)) := by + funext z + apply Prod.ext + · dsimp + rw [hurexp] + have hx := congrArg Prod.fst hplus + have hr := congrArg Prod.fst hminus + dsimp [w, GaussianRealPoint] at hx hr ⊢ + ring_nf at hx hr ⊢ + linarith + · dsimp + rw [huimexp] + have hy := congrArg Prod.snd hplus + have hi := congrArg Prod.snd hminus + dsimp [w, GaussianRealPoint] at hy hi ⊢ + ring_nf at hy hi ⊢ + linarith + rw [map_eq] + exact hreflect + +private theorem realization : + ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (x : LatticeCell), x ∈ T.cells + ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → (TileRealization T = ⋃ i : Fin 3, + ⋃ s : Bool, TileRealization (S i s)) := by + classical + intro T S hcells + ext p + simp only [TileRealization, Set.mem_iUnion] + constructor + · intro hp + rcases hp with ⟨x, hx, hp⟩ + rcases (hcells x).mp hx with ⟨i, s, hs⟩ + exact ⟨i, s, x, hs, hp⟩ + · intro hp + rcases hp with ⟨i, s, x, hs, hp⟩ + exact ⟨x, (hcells x).mpr ⟨i, s, hs⟩, hp⟩ + +private theorem hq' : + ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (x : ℝ × ℝ), ∀ (i : Fin (3 : + ℕ)), (TileRealization (S i false) = (fun (z : ℝ × ℝ) => ((2 : ℝ) * (TileCentroid T).1 - + z.1, (2 : ℝ) * (TileCentroid T).2 - z.2)) '' TileRealization (S i true)) → ((x ∈ + TileRealization (S i false)) → ((2 * (TileCentroid T).1 - x.1, 2 * (TileCentroid T).2 - + x.2) ∈ TileRealization (S i true))) := by + classical + intro T S x i pairEq hx + rcases (pairEq ▸ hx) with ⟨q, hq, hqeq⟩ + have heq : (2 * (TileCentroid T).1 - x.1, + 2 * (TileCentroid T).2 - x.2) = q := by + rw [← hqeq] + dsimp + ring_nf + rw [heq] + exact hq + +end CentralSymmetryProof + +theorem BandPrototileCentralSymmetry : ∀ (C : CircleCoordinates) + (T : ProtoTile), + BandPrototile C T → CentrallyReflectedAt (TileCentroid T) T T := by +-- BODY + intro C T hT + induction hT with + | line w x hw => + rw [CentrallyReflectedAt, TileRealization] + simp + | unit z x => + rw [CentrallyReflectedAt] + ext p + simp only [TileRealization, Finset.mem_singleton, Set.mem_iUnion, + Set.mem_image] + have hx : ({x} : FiniteTile).Nonempty := Finset.singleton_nonempty x + simp only [TileCentroid, ite_eq_left hx, Finset.sum_singleton, Finset.card_singleton] + constructor + · intro hp + rcases hp with ⟨i, hi, hp⟩ + subst i + refine ⟨(2 * (((x.re : Int) : Real) + 1 / 2) - p.1, + 2 * (((x.im : Int) : Real) + 1 / 2) - p.2), + ⟨x, rfl, ?_⟩, ?_⟩ + · simp only [ClosedSquareRealization, Set.mem_Icc] at hp ⊢ + change (_ ≤ _ ∧ _ ≤ _) ∧ (_ ≤ _ ∧ _ ≤ _) at hp ⊢ + have hpx := hp.1.1 + have hpy := hp.1.2 + have hqx := hp.2.1 + have hqy := hp.2.2 + constructor + · constructor <;> norm_num at * <;> linarith + · constructor <;> norm_num at * <;> linarith + · apply Prod.ext <;> dsimp <;> ring + · intro hp + rcases hp with ⟨q, ⟨a, ha, hqa⟩, hqp⟩ + subst a + refine ⟨x, rfl, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc] at hqa ⊢ + change (_ ≤ _ ∧ _ ≤ _) ∧ (_ ≤ _ ∧ _ ≤ _) at hqa ⊢ + have hr := congrArg Prod.fst hqp + have hi := congrArg Prod.snd hqp + dsimp at hr hi + have hpx := hqa.1.1 + have hpy := hqa.1.2 + have hqx := hqa.2.1 + have hqy := hqa.2.2 + constructor + · constructor <;> norm_num at * <;> linarith + · constructor <;> norm_num at * <;> linarith + | @decompose q hq S T hS hcells hfoot hcentroid ih => + have pair : ∀ i : Fin 3, + CentrallyReflectedAt (TileCentroid T) (S i true) (S i false) := + CentralSymmetryProof.pair T q S hS hcentroid ih + rw [CentrallyReflectedAt] + have realization : TileRealization T = + ⋃ i : Fin 3, ⋃ s : Bool, TileRealization (S i s) := CentralSymmetryProof.realization T + S hcells + rw [realization] + ext p + simp only [Set.mem_iUnion, Set.mem_image] + change (∃ i s, p ∈ TileRealization (S i s)) ↔ + ∃ x, (∃ i s, x ∈ TileRealization (S i s)) ∧ + (2 * (TileCentroid T).1 - x.1, 2 * (TileCentroid T).2 - x.2) = p + constructor + · rintro ⟨i, s, hp⟩ + have pairEq := pair i + change TileRealization (S i false) = + (fun z : Real × Real => + (2 * (TileCentroid T).1 - z.1, 2 * (TileCentroid T).2 - z.2)) '' + TileRealization (S i true) at pairEq + by_cases hs : s = true + · subst s + refine ⟨(2 * (TileCentroid T).1 - p.1, + 2 * (TileCentroid T).2 - p.2), ⟨i, false, ?_⟩, ?_⟩ + · rw [pairEq] + exact ⟨p, hp, rfl⟩ + · apply Prod.ext <;> dsimp <;> ring + · have hs' : s = false := Bool.eq_false_of_not_eq_true hs + subst s + rcases (pairEq ▸ hp) with ⟨q, hq, hqp⟩ + exact ⟨q, ⟨i, true, hq⟩, hqp⟩ + · rintro ⟨x, ⟨i, s, hx⟩, hxp⟩ + have pairEq := pair i + change TileRealization (S i false) = + (fun z : Real × Real => + (2 * (TileCentroid T).1 - z.1, 2 * (TileCentroid T).2 - z.2)) '' + TileRealization (S i true) at pairEq + by_cases hs : s = true + · subst s + refine ⟨i, false, ?_⟩ + rw [pairEq] + exact ⟨x, hx, hxp⟩ + · have hs' : s = false := Bool.eq_false_of_not_eq_true hs + subst s + have hq' : (2 * (TileCentroid T).1 - x.1, + 2 * (TileCentroid T).2 - x.2) ∈ TileRealization (S i true) := + CentralSymmetryProof.hq' T S x i pairEq hx + rw [← hxp] + exact ⟨i, true, hq'⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileCentroidUnique.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileCentroidUnique.lean new file mode 100644 index 0000000000..4046216427 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileCentroidUnique.lean @@ -0,0 +1,233 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandPrototileCentroidUnique] + +/-! +# BandPrototileCentroidUnique + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandPrototileCentroidUnique (C : CircleCoordinates) (T U : ProtoTile) + (hT : BandPrototile C T) (hU : BandPrototile C U) + (hcent : TileCentroid T = TileCentroid U) : + T.cells = U.cells ∧ (T.cells = ∅ → T.anchor = U.anchor) := by +-- BODY + revert hcent + revert hU + revert U + have nonnegative : ∀ r : Fin 4 → CircleCoordinates, + SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 := by + intro r hr + induction hr with + | base z => intro k; fin_cases k <;> simp + | rotate hr ih => + intro k + fin_cases k + · simpa using ih 0 + · simpa using ih 2 + · simpa using ih 3 + · simpa using ih 1 + | @successor r hr ih => + intro k + have classification := BandSuccessorClassification r hr + dsimp at classification + rcases classification with special | proper + · fin_cases k + · simp [special] + · simpa using ih 0 + · simpa using ih 2 + · simpa using ih 3 + · rcases proper with ⟨_, larger0, larger2, larger3⟩ + fin_cases k + · change 0 ≤ 2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1 + exact (ih 0).trans larger0.le + · exact ih 0 + · exact ih 2 + · exact ih 3 + have no_unit : ∀ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → + (r 0).1 = 1 → ¬ ProperBandQuadruple r := by + intro r hr + induction hr with + | base z => + intro h hp + have bad := hp.2 0 + simp at h bad + | rotate hr ih => + intro h hp + apply ih h + exact ⟨hr, by + intro j + fin_cases j + · simpa using hp.2 2 + · simpa using hp.2 0 + · simpa using hp.2 1⟩ + | @successor r hr ih => + intro h hp + have child0 := hp.2 0 + have child1 := hp.2 1 + have child2 := hp.2 2 + have non0 := nonnegative r hr 0 + have non1 := nonnegative r hr 1 + have non2 := nonnegative r hr 2 + have non3 := nonnegative r hr 3 + dsimp at h child0 child1 child2 + omega + let property : CircleCoordinates → ProtoTile → Prop := fun D V => + ∀ W, BandPrototile D W → TileCentroid V = TileCentroid W → + V.cells = W.cells ∧ (V.cells = ∅ → V.anchor = W.anchor) + change property C T + induction hT with + | line w x hw => + intro U hU hcent + generalize coordinate : ((0 : ℤ), w) = D at hU ⊢ + cases hU with + | line w' y hw' => + simp? [TileCentroid] at hcent ⊢ + apply GaussianInt.toComplex_injective + apply Complex.ext + · exact hcent.1 + · exact hcent.2 + | unit z' y => simp_all [] + | decompose hq' hS' hcells' hfoot' hcentroid' => + rename_i qcoord schild + have below := hq'.2 0 + have above := nonnegative qcoord hq'.1 1 + change (qcoord (0 : Fin 3).succ).1 < (qcoord 0).1 at below + change 0 ≤ (qcoord (0 : Fin 3).succ).1 at above + have curv := congrArg Prod.fst coordinate + dsimp at curv + have qzero : (qcoord 0).1 = 0 := by simpa using curv.symm + rw [qzero] at below + exfalso + omega + | unit z x => + intro U hU hcent + generalize coordinate : ((1 : ℤ), 1 + 2 * z) = D at hU ⊢ + cases hU with + | line w' y hw' => simp_all [] + | unit z' y => + simp? [TileCentroid] at hcent ⊢ + have equal : x = y := by + apply GaussianInt.toComplex_injective + apply Complex.ext + · exact hcent.1 + · exact hcent.2 + subst y + simp + | decompose hq' hS' hcells' hfoot' hcentroid' => + rename_i qcoord schild + have below := hq'.2 0 + have above := nonnegative qcoord hq'.1 1 + change (qcoord (0 : Fin 3).succ).1 < (qcoord 0).1 at below + change 0 ≤ (qcoord (0 : Fin 3).succ).1 at above + have curv := congrArg Prod.fst coordinate + dsimp at curv + have qone : (qcoord 0).1 = 1 := by simpa using curv.symm + rw [qone] at below + exfalso + exact (no_unit qcoord hq'.1 qone) hq' + | @decompose q hq S T hS hcells hfoot hcentroid ih => + intro U hU hcent + generalize coordinate : q 0 = D at hU ⊢ + cases hU with + | line w x hw => + have below := hq.2 0 + have above := nonnegative q hq.1 1 + change (q (0 : Fin 3).succ).1 < (q 0).1 at below + change 0 ≤ (q (0 : Fin 3).succ).1 at above + have curv := congrArg Prod.fst coordinate + dsimp at curv + have qzero : (q 0).1 = 0 := by simpa using curv + rw [qzero] at below + omega + | unit z x => + have below := hq.2 0 + have above := nonnegative q hq.1 1 + change (q (0 : Fin 3).succ).1 < (q 0).1 at below + change 0 ≤ (q (0 : Fin 3).succ).1 at above + have curv := congrArg Prod.fst coordinate + dsimp at curv + have qone : (q 0).1 = 1 := by simpa using curv + rw [qone] at below + exact False.elim ((no_unit q hq.1 qone) hq) + | decompose hq' hS' hcells' hfoot' hcentroid' => + rename_i qcoord schild + obtain ⟨r, matching, unique⟩ := + BandPredecessorNoCollision q qcoord hq hq' coordinate + have centroid_match : ∀ i : Fin 3, ∀ s : Bool, + TileCentroid (schild i s) = TileCentroid (S (i + r) s) := by + intro i s + have left := hcentroid' i s + have right := hcentroid (i + r) s + have vector_match : + BandVectors.1 (qcoord ((i + 2).succ)) (qcoord ((i + 1).succ)) = + BandVectors.1 (q ((i + r + 2).succ)) (q ((i + r + 1).succ)) := by + rw [matching (i + 2), matching (i + 1)] + fin_cases r <;> fin_cases i <;> rfl + rw [vector_match] at left + have displacement := left.trans right.symm + calc + TileCentroid (schild i s) = + (TileCentroid (schild i s) - TileCentroid U) + TileCentroid U := by + ext <;> simp [sub_eq_add_neg, add_comm] + _ = (TileCentroid (S (i + r) s) - TileCentroid T) + TileCentroid U := by + rw [displacement] + _ = (TileCentroid (S (i + r) s) - TileCentroid T) + TileCentroid T := by + rw [hcent] + _ = TileCentroid (S (i + r) s) := by + ext <;> simp [sub_eq_add_neg, add_comm] + have child_equal : ∀ i : Fin 3, ∀ s : Bool, + (schild i s).cells = (S (i + r) s).cells := by + intro i s + have hs := hS' i s + rw [matching i] at hs + exact (ih (i + r) s (schild i s) hs (centroid_match i s).symm).1.symm + have index_preimage : ∀ k : Fin 3, ∃ i : Fin 3, i + r = k := by + intro k + fin_cases r <;> fin_cases k <;> first | exact ⟨0, by decide⟩ | exact ⟨1, by decide⟩ | + exact ⟨2, by decide⟩ + have cells_equal : T.cells = U.cells := by + ext a + constructor + · intro ha + rcases (hcells a).1 ha with ⟨k, s, ha⟩ + rcases index_preimage k with ⟨i, hi⟩ + apply (hcells' a).2 + refine ⟨i, s, ?_⟩ + rw [child_equal i s] + simpa [hi] using ha + · intro ha + rcases (hcells' a).1 ha with ⟨i, s, ha⟩ + apply (hcells a).2 + refine ⟨i + r, s, ?_⟩ + rw [← child_equal i s] + exact ha + refine ⟨cells_equal, ?_⟩ + intro hempty + have centered := hcent + have uempty : U.cells = ∅ := by rw [← cells_equal]; exact hempty + simp? [TileCentroid, hempty, uempty] at centered + apply GaussianInt.toComplex_injective + apply Complex.ext + · exact centered.1 + · exact centered.2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean new file mode 100644 index 0000000000..19a08472e2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean @@ -0,0 +1,756 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares +public import LeanPool.ApollonianSuperharmonic.TileCentroid + +-- [TABLET NODE: BandPrototileCompleteSquareCentroid] + +/-! +# BandPrototileCompleteSquareCentroid + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CompleteSquareProof + +private theorem hboundRe : + (by + classical + exact + ∀ (T : ProtoTile), + let reCells : Finset Int := T.cells.image (fun x => x.re) + ∀ (reNe : reCells.Nonempty), ∀ p ∈ TileRealization T, (↑(reCells.min' reNe) : Real) ≤ p.1 + ∧ p.1 ≤ (↑(reCells.max' reNe) : Real) + 1 + ) := by + classical + intro T reCells reNe p hp + simp only [TileRealization, Set.mem_iUnion] at hp + rcases hp with ⟨x, hx, hpx⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpx + constructor + · have hm := Finset.min'_le (T.cells.image (fun x => x.re)) x.re + (Finset.mem_image.mpr ⟨x, hx, rfl⟩) + exact le_trans (by exact_mod_cast hm) hpx.1.1 + · have hh := Finset.le_max' (T.cells.image (fun x => x.re)) + (x.re) (Finset.mem_image.mpr ⟨x, hx, rfl⟩) + have hhreal : (x.re : Real) ≤ + (reCells.max' reNe : Real) := by + exact_mod_cast hh + linarith [hhreal, hpx.2.1] + +private theorem centerRe : + (by + classical + exact + ∀ (T : ProtoTile), + let c := TileCentroid T + let reCells : Finset Int := T.cells.image (fun x => x.re) + ∀ (reNe : reCells.Nonempty), (∀ p ∈ TileRealization T, (↑(reCells.min' reNe) : Real) ≤ + p.1 ∧ p.1 ≤ (↑(reCells.max' reNe) : Real) + 1) → ((∀ p ∈ TileRealization T, (2 * c.1 + - p.1, 2 * c.2 - p.2) ∈ TileRealization T) → ( + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + (∃ x ∈ T.cells, x.re = mRe) → ((∃ x ∈ T.cells, x.re = MRe) → (2 * c.1 = (mRe : Real) + + MRe + 1)))) + ) := by + classical + intro T c reCells reNe hboundRe reflect_mem mRe MRe minReCell maxReCell + rcases minReCell with ⟨xmin, hxmin, hxminre⟩ + rcases maxReCell with ⟨xmax, hmax, hmaxre⟩ + have pmin : ((mRe : Real), (xmin.im : Real)) ∈ TileRealization T := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmin, hxmin, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + exact ⟨⟨by simp [hxminre], by simp []⟩, + ⟨by simp [hxminre], by simp⟩⟩ + have pmax : (((MRe : Real) + 1), (xmax.im : Real)) ∈ TileRealization T := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmax, hmax, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + exact ⟨⟨by simp [hmaxre], by simp⟩, + ⟨by simp [hmaxre], by simp⟩⟩ + have qmin := reflect_mem _ pmin + have qmax := reflect_mem _ pmax + have bmin := hboundRe _ qmin + have bmax := hboundRe _ qmax + dsimp at bmin bmax + norm_num at bmin bmax ⊢ + linarith [bmin.2, bmax.1] + +private theorem boundIm : + (by + classical + exact + ∀ (T : ProtoTile), + let imCells : Finset Int := T.cells.image (fun x => x.im) + ∀ (imNe : imCells.Nonempty), ∀ p ∈ TileRealization T, (imCells.min' imNe : Real) ≤ p.2 ∧ + p.2 ≤ (imCells.max' imNe : Real) + 1 + ) := by + classical + intro T imCells imNe p hp + simp only [TileRealization, Set.mem_iUnion] at hp + rcases hp with ⟨x, hx, hpx⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpx + constructor + · exact le_trans (Int.cast_le.mpr (Finset.min'_le _ x.im + (Finset.mem_image.mpr ⟨x, hx, rfl⟩))) hpx.1.2 + · have hh := Finset.le_max' (T.cells.image (fun x => x.im)) + x.im (Finset.mem_image.mpr ⟨x, hx, rfl⟩) + have hhreal : (x.im : Real) ≤ + ((imCells.max' imNe : Int) : Real) := by + exact_mod_cast hh + linarith [hpx.2.2] + +private theorem centerIm : + (by + classical + exact + ∀ (T : ProtoTile), + let c := TileCentroid T + let imCells : Finset Int := T.cells.image (fun x => x.im) + ∀ (imNe : imCells.Nonempty), (∀ p ∈ TileRealization T, (2 * c.1 - p.1, 2 * c.2 - p.2) ∈ + TileRealization T) → ((∀ p ∈ TileRealization T, (imCells.min' imNe : Real) ≤ p.2 ∧ + p.2 ≤ (imCells.max' imNe : Real) + 1) → ( + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + (∃ x ∈ T.cells, x.im = mIm) → ((∃ x ∈ T.cells, x.im = MIm) → (2 * c.2 = (mIm : Real) + + MIm + 1)))) + ) := by + classical + intro T c imCells imNe reflect_mem boundIm mIm MIm minImCell maxImCell + rcases minImCell with ⟨xmin, hxmin, hxminim⟩ + rcases maxImCell with ⟨xmax, hmax, hmaxim⟩ + have pmin : ((xmin.re : Real), (mIm : Real)) ∈ TileRealization T := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmin, hxmin, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + exact ⟨⟨by simp, by simp [hxminim]⟩, + ⟨by simp, by simp [hxminim]⟩⟩ + have pmax : ((xmax.re : Real), ((MIm : Real) + 1)) ∈ TileRealization T := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmax, hmax, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + exact ⟨⟨by simp, by simp [hmaxim]⟩, + ⟨by simp, by simp [hmaxim]⟩⟩ + have bmin := boundIm _ (reflect_mem _ pmin) + have bmax := boundIm _ (reflect_mem _ pmax) + dsimp at bmin bmax + norm_num at bmin bmax ⊢ + linarith + +private theorem tau_cell : + (by + classical + exact + ∀ (T : ProtoTile), + let c := TileCentroid T + let reCells : Finset Int := T.cells.image (fun x => x.re) + let imCells : Finset Int := T.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), (∀ p ∈ TileRealization T, (2 * + c.1 - p.1, 2 * c.2 - p.2) ∈ TileRealization T) → ( + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + (∃ x ∈ T.cells, x.re = mRe) → ((∃ x ∈ T.cells, x.re = MRe) → ((2 * c.1 = (mRe : Real) + + MRe + 1) → ( + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + (∃ x ∈ T.cells, x.im = mIm) → ((∃ x ∈ T.cells, x.im = MIm) → ((2 * c.2 = (mIm : Real) + + MIm + 1) → ( + let t : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let tau : GaussianInt → GaussianInt := fun x => t - x - 1 - ⟨0, 1⟩ + ∀ x ∈ T.cells, tau x ∈ T.cells))))))) + ) := by + classical + intro T c reCells imCells reNe imNe reflect_mem mRe MRe minReCell maxReCell centerRe mIm MIm + minImCell maxImCell centerIm t tau x hx + have hp : ((x.re : Real) + 1 / 2, (x.im : Real) + 1 / 2) ∈ + TileRealization T := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨x, hx, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + norm_num + have hq := reflect_mem _ hp + simp only [TileRealization, Set.mem_iUnion] at hq + rcases hq with ⟨y, hy, hqy⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hqy + change (((y.re : Real) ≤ 2 * c.1 - ((x.re : Real) + 1 / 2) ∧ + (y.im : Real) ≤ 2 * c.2 - ((x.im : Real) + 1 / 2)) ∧ + 2 * c.1 - ((x.re : Real) + 1 / 2) ≤ (y.re : Real) + 1 ∧ + 2 * c.2 - ((x.im : Real) + 1 / 2) ≤ (y.im : Real) + 1) at hqy + have hxr : (y.re : Real) < + ((t.re - x.re - 1 : Int) : Real) + 1 := by + dsimp [t] at hqy ⊢ + rw [centerRe] at hqy + norm_num at hqy ⊢ + rw [← GaussianInt.intCast_re y, ← GaussianInt.intCast_re x] at hqy + rw [← GaussianInt.intCast_re y, ← GaussianInt.intCast_re x] at ⊢ + have hyupper : (y.re : Real) ≤ (mRe : Real) + MRe + 1 - ((x.re : Real) + 1 / 2) := by + exact hqy.1.1 + have hgoal : (y.re : Real) < (mRe : Real) + MRe + 1 - (x.re : Real) - 1 + 1 := by + linarith + convert hgoal using 1; norm_num [t] + have hxl : (((t.re - x.re - 1 : Int) : Real)) ≤ (y.re : Real) := by + dsimp [t] at hqy ⊢ + rw [centerRe] at hqy + norm_num at hqy ⊢ + rw [← GaussianInt.intCast_re y, ← GaussianInt.intCast_re x] at hqy + have hylower : (mRe : Real) + MRe + 1 ≤ (y.re : Real) + 1 + ((x.re : Real) + 1 / 2) := by + exact hqy.2.1 + have hgoal : (mRe : Real) + MRe + 1 - (x.re : Real) - 1 < (y.re : Real) + 1 := by + linarith + have hgoalInt : mRe + MRe + 1 - x.re - 1 < y.re + 1 := by + exact_mod_cast hgoal + have hgoalInt' : mRe + MRe + 1 - x.re - 1 ≤ y.re := by omega + have hreal0 : (mRe : Real) + MRe + 1 - (x.re : Real) - 1 ≤ (y.re : Real) := by + exact_mod_cast hgoalInt' + have hreal : (mRe : Real) + MRe + 1 ≤ (y.re : Real) + 1 + (x.re : Real) := by + linarith + simpa only [GaussianInt.intCast_re] using hreal + have hyr : (y.im : Real) < + ((t.im - x.im - 1 : Int) : Real) + 1 := by + dsimp [t] at hqy ⊢ + rw [centerIm] at hqy + norm_num at hqy ⊢ + rw [← GaussianInt.intCast_im y, ← GaussianInt.intCast_im x] at hqy + rw [← GaussianInt.intCast_im y, ← GaussianInt.intCast_im x] at ⊢ + have hyupper : (y.im : Real) ≤ (mIm : Real) + MIm + 1 - ((x.im : Real) + 1 / 2) := by + exact hqy.1.2 + have hgoal : (y.im : Real) < (mIm : Real) + MIm + 1 - (x.im : Real) - 1 + 1 := by + linarith + convert hgoal using 1; norm_num [t] + have hyl : (((t.im - x.im - 1 : Int) : Real)) ≤ (y.im : Real) := by + dsimp [t] at hqy ⊢ + rw [centerIm] at hqy + norm_num at hqy ⊢ + rw [← GaussianInt.intCast_im y, ← GaussianInt.intCast_im x] at hqy + have hylower : (mIm : Real) + MIm + 1 ≤ (y.im : Real) + 1 + ((x.im : Real) + 1 / 2) := by + exact hqy.2.2 + have hgoal : (mIm : Real) + MIm + 1 - (x.im : Real) - 1 < (y.im : Real) + 1 := by + linarith + have hgoalInt : mIm + MIm + 1 - x.im - 1 < y.im + 1 := by + exact_mod_cast hgoal + have hgoalInt' : mIm + MIm + 1 - x.im - 1 ≤ y.im := by omega + have hreal0 : (mIm : Real) + MIm + 1 - (x.im : Real) - 1 ≤ (y.im : Real) := by + exact_mod_cast hgoalInt' + have hreal : (mIm : Real) + MIm + 1 ≤ (y.im : Real) + 1 + (x.im : Real) := by + linarith + simpa only [GaussianInt.intCast_im] using hreal + have hre : y.re = t.re - x.re - 1 := by + have hu : y.re < t.re - x.re - 1 + 1 := by exact_mod_cast hxr + have hl : t.re - x.re - 1 ≤ y.re := by exact_mod_cast hxl + omega + have him : y.im = t.im - x.im - 1 := by + have hu : y.im < t.im - x.im - 1 + 1 := by exact_mod_cast hyr + have hl : t.im - x.im - 1 ≤ y.im := by exact_mod_cast hyl + omega + have heq : y = tau x := by + apply Zsqrtd.ext <;> dsimp [tau] <;> simp [t, hre, him] + simpa [heq] using hy + +private theorem footprint_forward : + (by + classical + exact + ∀ (T : ProtoTile), (Finset.Nonempty T.cells) → ( + let reCells : Finset Int := T.cells.image (fun x => x.re) + let imCells : Finset Int := T.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let tau : GaussianInt → GaussianInt := fun x => t - x - 1 - ⟨0, 1⟩ + (∀ x ∈ T.cells, tau x ∈ T.cells) → ( + let rho : GaussianInt → GaussianInt := fun v => t - v + ∀ v, v ∈ FootprintVertices T → rho v ∈ FootprintVertices T)) + ) := by + classical + intro T hne reCells imCells reNe imNe mRe MRe mIm MIm t tau tau_cell rho v hv + simp only [FootprintVertices, ite_eq_left hne] at hv ⊢ + rcases hv with ⟨x, hx, hv⟩ + rcases hv with hcase | hcase | hcase | hcase + · refine ⟨tau x, tau_cell x hx, ?_⟩ + dsimp [rho, tau, t] + simp [hcase, sub_eq_add_neg, add_comm, add_left_comm] + · refine ⟨tau x, tau_cell x hx, ?_⟩ + dsimp [rho, tau, t] + simp [hcase, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + · refine ⟨tau x, tau_cell x hx, ?_⟩ + dsimp [rho, tau, t] + simp [hcase, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + · refine ⟨tau x, tau_cell x hx, ?_⟩ + dsimp [rho, tau, t] + simp [hcase, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + +private theorem dom_rho : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ((↑h.domain : Set GaussianInt) = + FootprintVertices T) → ( + let reCells : Finset Int := T.cells.image (fun x => x.re) + let imCells : Finset Int := T.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let rho : GaussianInt → GaussianInt := fun v => t - v + (∀ v, v ∈ FootprintVertices T ↔ rho v ∈ FootprintVertices T) → (∀ v, v ∈ h.domain ↔ rho v + ∈ h.domain)) + ) := by + classical + intro T h hdom reCells imCells reNe imNe mRe MRe mIm MIm t rho footprint_rho v + constructor + · intro hv + have hv0 : v ∈ (h.domain : Set GaussianInt) := hv + have hv' : v ∈ FootprintVertices T := by simpa [hdom] using hv0 + have hw := (footprint_rho v).mp hv' + change rho v ∈ (h.domain : Set GaussianInt) + rw [hdom] + exact hw + · intro hv + have hv0 : rho v ∈ (h.domain : Set GaussianInt) := hv + have hv' : rho v ∈ FootprintVertices T := by simpa [hdom] using hv0 + have hw := (footprint_rho v).mpr hv' + change v ∈ (h.domain : Set GaussianInt) + rw [hdom] + exact hw + +private theorem square_tau : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), + let reCells : Finset Int := T.cells.image (fun x => x.re) + let imCells : Finset Int := T.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let tau : GaussianInt → GaussianInt := fun x => t - x - 1 - ⟨0, 1⟩ + (∀ x, tau (tau x) = x) → ( + let rho : GaussianInt → GaussianInt := fun v => t - v + (∀ v, v ∈ h.domain ↔ rho v ∈ h.domain) → ( + let squares := PartialOdometerSquares h + ∀ x, x ∈ squares ↔ tau x ∈ squares)) + ) := by + classical + intro T h reCells imCells reNe imNe mRe MRe mIm MIm t tau tau_involution rho dom_rho squares x + have forward : ∀ z, z ∈ squares → tau z ∈ squares := by + intro z hz + simp only [squares, PartialOdometerSquares, Finset.mem_filter] at hz ⊢ + rcases hz with ⟨hz, hz1, hzi, hz1i⟩ + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa [rho, tau, t, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using (dom_rho (z + + 1 + ⟨0, 1⟩)).mp hz1i + · simpa [rho, tau, t, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using (dom_rho (z + + ⟨0, 1⟩)).mp hzi + · simpa [rho, tau, t, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using (dom_rho (z + + 1)).mp hz1 + · simpa [rho, tau, t, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using (dom_rho + z).mp hz + constructor + · exact forward x + · intro hz + have hw := forward (tau x) hz + simpa [tau_involution] using hw + +private theorem squares_nonempty : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), (Finset.Nonempty T.cells) → (((↑h.domain : + Set GaussianInt) = FootprintVertices T) → ( + let squares := PartialOdometerSquares h + squares.Nonempty)) + ) := by + classical + intro T h hne hdom squares + have hne' : T.cells.Nonempty := hne + rcases hne with ⟨x, hx⟩ + refine ⟨x, ?_⟩ + simp only [squares, PartialOdometerSquares, Finset.mem_filter] + have hd0 : x ∈ h.domain := by + have hv : x ∈ FootprintVertices T := by + simp only [FootprintVertices, ite_eq_left hne'] + exact ⟨x, hx, by simp⟩ + exact (show x ∈ (h.domain : Set GaussianInt) from hdom ▸ hv) + have hd1 : x + 1 ∈ h.domain := by + have hv : x + 1 ∈ FootprintVertices T := by + simp only [FootprintVertices, ite_eq_left hne'] + exact ⟨x, hx, by simp⟩ + exact (show x + 1 ∈ (h.domain : Set GaussianInt) from hdom ▸ hv) + have hdi : x + ⟨0, 1⟩ ∈ h.domain := by + have hv : x + ⟨0, 1⟩ ∈ FootprintVertices T := by + simp only [FootprintVertices, ite_eq_left hne'] + exact ⟨x, hx, by simp⟩ + exact (show x + ⟨0, 1⟩ ∈ (h.domain : Set GaussianInt) from hdom ▸ hv) + have hd1i : x + 1 + ⟨0, 1⟩ ∈ h.domain := by + have hv : x + 1 + ⟨0, 1⟩ ∈ FootprintVertices T := by + simp only [FootprintVertices, ite_eq_left hne'] + exact ⟨x, hx, by simp⟩ + exact (show x + 1 + ⟨0, 1⟩ ∈ (h.domain : Set GaussianInt) from hdom ▸ hv) + exact ⟨hd0, hd1, hdi, hd1i⟩ + +private theorem sumRe : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), + let reCells : Finset Int := T.cells.image (fun x => x.re) + let imCells : Finset Int := T.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let tau : GaussianInt → GaussianInt := fun x => t - x - 1 - ⟨0, 1⟩ + (∀ x, tau (tau x) = x) → ( + let squares := PartialOdometerSquares h + (∀ x, x ∈ squares ↔ tau x ∈ squares) → (squares.sum (fun x => (x.re : Real)) = + squares.sum (fun x => ((tau x).re : Real)))) + ) := by + classical + intro T h reCells imCells reNe imNe mRe MRe mIm MIm t tau tau_involution squares square_tau + apply Finset.sum_bij (fun x hx => tau x) + · intro x hx + exact (square_tau x).mp hx + · intro x hx y hy heq + have hi := congrArg tau heq + simpa [tau_involution] using hi + · intro y hy + refine ⟨tau y, (square_tau y).mp hy, ?_⟩ + exact tau_involution y + · intro x hx + exact (congrArg (fun z => (z.re : Real)) (tau_involution x)).symm + +private theorem sumIm : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), + let reCells : Finset Int := T.cells.image (fun x => x.re) + let imCells : Finset Int := T.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let tau : GaussianInt → GaussianInt := fun x => t - x - 1 - ⟨0, 1⟩ + (∀ x, tau (tau x) = x) → ( + let squares := PartialOdometerSquares h + (∀ x, x ∈ squares ↔ tau x ∈ squares) → (squares.sum (fun x => (x.im : Real)) = + squares.sum (fun x => ((tau x).im : Real)))) + ) := by + classical + intro T h reCells imCells reNe imNe mRe MRe mIm MIm t tau tau_involution squares square_tau + apply Finset.sum_bij (fun x hx => tau x) + · intro x hx + exact (square_tau x).mp hx + · intro x hx y hy heq + have hi := congrArg tau heq + simpa [tau_involution] using hi + · intro y hy + refine ⟨tau y, (square_tau y).mp hy, ?_⟩ + exact tau_involution y + · intro x hx + exact (congrArg (fun z => (z.im : Real)) (tau_involution x)).symm + +private theorem sumRe_formula : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), + let reCells : Finset Int := T.cells.image (fun x => x.re) + let imCells : Finset Int := T.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let tau : GaussianInt → GaussianInt := fun x => t - x - 1 - ⟨0, 1⟩ + let squares := PartialOdometerSquares h + (squares.sum (fun x => (x.re : Real)) = squares.sum (fun x => ((tau x).re : Real))) → (2 + * squares.sum (fun x => (x.re : Real)) = (squares.card : Real) * (t.re : Real) - + squares.card) + ) := by + classical + intro T h reCells imCells reNe imNe mRe MRe mIm MIm t tau squares sumRe + have hs := sumRe + dsimp [tau, t] at hs + simp only [ + sub_zero, + ] at hs + push_cast at hs + rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib, + Finset.sum_add_distrib, Finset.sum_const] at hs + simp? at hs + have hEq : squares.sum (fun x => (x.re : Real)) = + squares.sum (fun x => (GaussianInt.toComplex x).re) := by + apply Finset.sum_congr rfl + intro x hx + exact (GaussianInt.intCast_re x) + have hs' : squares.sum (fun x => (x.re : Real)) = + (squares.card : Real) * (mRe : Real) + squares.card * MRe + + squares.card - squares.sum (fun x => (x.re : Real)) - squares.card := by + rw [hEq] + simpa using hs + dsimp [t] + push_cast + ring_nf at hs' ⊢ + linarith + +private theorem sumIm_formula : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), + let reCells : Finset Int := T.cells.image (fun x => x.re) + let imCells : Finset Int := T.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let tau : GaussianInt → GaussianInt := fun x => t - x - 1 - ⟨0, 1⟩ + let squares := PartialOdometerSquares h + (squares.sum (fun x => (x.im : Real)) = squares.sum (fun x => ((tau x).im : Real))) → (2 + * squares.sum (fun x => (x.im : Real)) = (squares.card : Real) * (t.im : Real) - + squares.card) + ) := by + classical + intro T h reCells imCells reNe imNe mRe MRe mIm MIm t tau squares sumIm + have hs := sumIm + dsimp [tau, t] at hs + simp only [ + sub_zero, + ] at hs + push_cast at hs + rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib, + Finset.sum_add_distrib, Finset.sum_const] at hs + simp? at hs + have hEq : squares.sum (fun x => (x.im : Real)) = + squares.sum (fun x => (GaussianInt.toComplex x).im) := by + apply Finset.sum_congr rfl + intro x hx + exact (GaussianInt.intCast_im x) + have hs' : squares.sum (fun x => (x.im : Real)) = + (squares.card : Real) * (mIm : Real) + squares.card * MIm + + squares.card - squares.sum (fun x => (x.im : Real)) - squares.card := by + rw [hEq] + simpa using hs + dsimp [t] + push_cast + ring_nf at hs' ⊢ + linarith + +private theorem result_re : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), + let c := TileCentroid T + let reCells : Finset Int := T.cells.image (fun x => x.re) + let imCells : Finset Int := T.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + (2 * c.1 = (mRe : Real) + MRe + 1) → ( + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let squares := PartialOdometerSquares h + (2 * squares.sum (fun x => (x.re : Real)) = (squares.card : Real) * (t.re : Real) - + squares.card) → (((0 : Real) < squares.card) → (squares.sum (fun x => ((x.re : Real) + + 1 / 2)) / (squares.card : Real) = c.1))) + ) := by + classical + intro T h c reCells imCells reNe imNe mRe MRe centerRe mIm MIm t squares sumRe_formula card_pos + dsimp [t] at sumRe_formula + have hcenter : (t.re : Real) = 2 * c.1 := by + dsimp [t] + push_cast + linarith [centerRe] + rw [hcenter] at sumRe_formula + have hshift : squares.sum (fun x => ((x.re : Real) + 1 / 2)) = + squares.sum (fun x => (x.re : Real)) + squares.card / 2 := by + rw [Finset.sum_add_distrib, Finset.sum_const] + ring + rw [hshift] + field_simp + ring_nf at sumRe_formula ⊢ + linarith + +private theorem result_im : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), + let c := TileCentroid T + let reCells : Finset Int := T.cells.image (fun x => x.re) + let imCells : Finset Int := T.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + (2 * c.2 = (mIm : Real) + MIm + 1) → ( + let t : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let squares := PartialOdometerSquares h + (2 * squares.sum (fun x => (x.im : Real)) = (squares.card : Real) * (t.im : Real) - + squares.card) → (((0 : Real) < squares.card) → (squares.sum (fun x => ((x.im : Real) + + 1 / 2)) / (squares.card : Real) = c.2))) + ) := by + classical + intro T h c reCells imCells reNe imNe mRe MRe mIm MIm centerIm t squares sumIm_formula card_pos + dsimp [t] at sumIm_formula + have hcenter : (t.im : Real) = 2 * c.2 := by + dsimp [t] + push_cast + linarith [centerIm] + rw [hcenter] at sumIm_formula + have hshift : squares.sum (fun x => ((x.im : Real) + 1 / 2)) = + squares.sum (fun x => (x.im : Real)) + squares.card / 2 := by + rw [Finset.sum_add_distrib, Finset.sum_const] + ring + rw [hshift] + field_simp + ring_nf at sumIm_formula ⊢ + linarith + +end CompleteSquareProof + +theorem BandPrototileCompleteSquareCentroid + (C : CircleCoordinates) (T : ProtoTile) (h : PartialOdometer) + (hT : BandPrototile C T) (hne : T.cells.Nonempty) + (hdom : (h.domain : Set GaussianInt) = FootprintVertices T) : + let S := PartialOdometerSquares h + S.Nonempty ∧ + ((∑ x ∈ S, ((x.re : Real) + 1 / 2)) / (S.card : Real), + (∑ x ∈ S, ((x.im : Real) + 1 / 2)) / (S.card : Real)) = + TileCentroid T := by +-- BODY + dsimp + let c := TileCentroid T + let reCells : Finset Int := T.cells.image (fun x => x.re) + let imCells : Finset Int := T.cells.image (fun x => x.im) + have reNe : reCells.Nonempty := by + dsimp [reCells] + exact Finset.image_nonempty.mpr hne + have imNe : imCells.Nonempty := by + dsimp [imCells] + exact Finset.image_nonempty.mpr hne + have hcentral : CentrallyReflectedAt c T T := + BandPrototileCentralSymmetry C T hT + have hboundRe : ∀ p ∈ TileRealization T, + (↑(reCells.min' reNe) : Real) ≤ p.1 ∧ + p.1 ≤ (↑(reCells.max' reNe) : Real) + 1 := CompleteSquareProof.hboundRe T reNe + have reflect_mem : ∀ p ∈ TileRealization T, + (2 * c.1 - p.1, 2 * c.2 - p.2) ∈ TileRealization T := by + intro p hp + rw [hcentral] + exact ⟨p, hp, rfl⟩ + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + have minReCell : ∃ x ∈ T.cells, x.re = mRe := by + have hm := Finset.min'_mem reCells reNe + rcases Finset.mem_image.mp hm with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + have maxReCell : ∃ x ∈ T.cells, x.re = MRe := by + have hm := Finset.max'_mem reCells reNe + rcases Finset.mem_image.mp hm with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + have centerRe : 2 * c.1 = (mRe : Real) + MRe + 1 := CompleteSquareProof.centerRe T reNe + hboundRe reflect_mem minReCell maxReCell + have boundIm : ∀ p ∈ TileRealization T, + (imCells.min' imNe : Real) ≤ p.2 ∧ p.2 ≤ (imCells.max' imNe : Real) + 1 := + CompleteSquareProof.boundIm T imNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + have minImCell : ∃ x ∈ T.cells, x.im = mIm := by + rcases Finset.mem_image.mp (Finset.min'_mem imCells imNe) with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + have maxImCell : ∃ x ∈ T.cells, x.im = MIm := by + rcases Finset.mem_image.mp (Finset.max'_mem imCells imNe) with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + have centerIm : 2 * c.2 = (mIm : Real) + MIm + 1 := CompleteSquareProof.centerIm T imNe + reflect_mem boundIm minImCell maxImCell + let t : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let tau : GaussianInt → GaussianInt := fun x => t - x - 1 - ⟨0, 1⟩ + have tau_involution : ∀ x, tau (tau x) = x := by + intro x + dsimp [tau] + apply Zsqrtd.ext <;> dsimp [t] <;> ring + have tau_cell : ∀ x ∈ T.cells, tau x ∈ T.cells := CompleteSquareProof.tau_cell T reNe imNe + reflect_mem minReCell maxReCell centerRe minImCell maxImCell centerIm + let rho : GaussianInt → GaussianInt := fun v => t - v + have footprint_forward : ∀ v, v ∈ FootprintVertices T → + rho v ∈ FootprintVertices T := CompleteSquareProof.footprint_forward T hne reNe imNe tau_cell + have rho_involution : ∀ v, rho (rho v) = v := by + intro v + simp [rho] + have footprint_rho : ∀ v, v ∈ FootprintVertices T ↔ + rho v ∈ FootprintVertices T := by + intro v + constructor + · exact footprint_forward v + · intro hv + have hi := rho_involution v + rw [← hi] + exact footprint_forward (rho v) hv + have dom_rho : ∀ v, v ∈ h.domain ↔ rho v ∈ h.domain := CompleteSquareProof.dom_rho T h hdom + reNe imNe footprint_rho + let squares := PartialOdometerSquares h + have square_tau : ∀ x, x ∈ squares ↔ tau x ∈ squares := CompleteSquareProof.square_tau T h reNe + imNe tau_involution dom_rho + have squares_nonempty : squares.Nonempty := CompleteSquareProof.squares_nonempty T h hne hdom + have sumRe : squares.sum (fun x => (x.re : Real)) = + squares.sum (fun x => ((tau x).re : Real)) := CompleteSquareProof.sumRe T h reNe imNe + tau_involution square_tau + have sumIm : squares.sum (fun x => (x.im : Real)) = + squares.sum (fun x => ((tau x).im : Real)) := CompleteSquareProof.sumIm T h reNe imNe + tau_involution square_tau + have sumRe_formula : 2 * squares.sum (fun x => (x.re : Real)) = + (squares.card : Real) * (t.re : Real) - squares.card := CompleteSquareProof.sumRe_formula T + h reNe imNe sumRe + have sumIm_formula : 2 * squares.sum (fun x => (x.im : Real)) = + (squares.card : Real) * (t.im : Real) - squares.card := CompleteSquareProof.sumIm_formula T + h reNe imNe sumIm + have card_pos : (0 : Real) < squares.card := by + exact_mod_cast squares_nonempty.card_pos + have result_re : + squares.sum (fun x => ((x.re : Real) + 1 / 2)) / + (squares.card : Real) = c.1 := CompleteSquareProof.result_re T h reNe imNe centerRe + sumRe_formula card_pos + have result_im : + squares.sum (fun x => ((x.im : Real) + 1 / 2)) / + (squares.card : Real) = c.2 := CompleteSquareProof.result_im T h reNe imNe centerIm + sumIm_formula card_pos + exact ⟨by simpa [squares] using squares_nonempty, + Prod.ext (by simpa [squares, c] using result_re) + (by simpa [squares, c] using result_im)⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean new file mode 100644 index 0000000000..5974dd0d74 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean @@ -0,0 +1,2236 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn +public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification +public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BandPrototileExists] + +/-! +# BandPrototileExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PrototileConstruction + +private theorem emptyCurv : + (by + classical + exact + ∀ (C : CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T → T.cells = ∅ → C.1 = 0 ) + := by + classical + intro C T hT + induction hT with + | line w x hw => intro _; rfl + | unit z x anchor => simp + | @decompose q hq S T hS hcells hfoot hcentroid ih => + intro hEmpty + have childEmpty (i : Fin 3) (s : Bool) : (S i s).cells = ∅ := by + ext x + constructor + · intro hx + have hxT : x ∈ T.cells := (hcells x).2 ⟨i, s, hx⟩ + simp [hEmpty] at hxT + · intro hx + simp at hx + have z1 := ih 0 false (childEmpty 0 false) + have z2 := ih 1 false (childEmpty 1 false) + have hp := ProperBandCurvatureStructure q hq + have distinct := hp.2.2 0 1 z1 z2 + norm_num at distinct + +private theorem positiveNonempty : + (by + classical + exact + (∀ (C : CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T → T.cells = ∅ → C.1 = 0) + → (∀ (C : CircleCoordinates), ∀ (T : ProtoTile), (0 < C.1) → ((BandPrototile C T) → + (T.cells.Nonempty))) ) := by + classical + intro emptyCurv C T hpos hT + by_contra hne + have hEmpty : T.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hne + have hz := emptyCurv C T hT hEmpty + omega + +private theorem hcurvAt165 : + (by + classical + exact + ∀ (n : ℕ), ∀ (C : BandCircle), (C.1.1.1.toNat = n) → ((n = (1 : ℕ)) → (C.1.1.1 = 1)) ) := by + classical + intro n C hc hone + have hpos : 0 < C.1.1.1 := C.2 + omega + +private theorem hgt : + (by + classical + exact + ∀ (n : ℕ), ∀ (C : BandCircle), (C.1.1.1.toNat = n) → ((¬n = (1 : ℕ)) → (1 < n)) ) := by + classical + intro n C hc hone + have hpos : 0 < C.1.1.1 := C.2 + have : 0 < n := by omega + omega + +private theorem hproper : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (SemiProperQuadruple q) → + ((∀ (j : Fin (3 : ℕ)), (q j.succ).1 < C.1.1.1) → ((q 0 = C.1.1) → + (ProperBandQuadruple q))) ) := by + classical + intro C q hq hless hroot + refine ⟨hq, ?_⟩ + intro j + have hj := hless j + simpa [hroot] using hj + +private theorem hqbase : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → (∀ (r : Fin (3 : ℕ)), + ∀ (g : BandPackingSymmetry), + ( + let q' := BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 + : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : + FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : + DiamondParameter), (1 : ℕ) < K.1 ∧ q' = DiamondRecursiveQuadruple K) (Nonempty + (BandOrderedGeneralConfiguration q')))) → (ProperBandQuadruple ![q 0, q r.succ, q (r + + 1).succ, q (r + 2).succ])) ) := by + classical + intro q hproper r g regime + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + fin_cases r + · have heq : ![q 0, q 1, q 2, q 3] = q := by + funext i + fin_cases i <;> rfl + simpa [heq] using hproper + · refine ⟨SemiProperQuadruple.rotate hproper.1, ?_⟩ + intro j + fin_cases j + · simpa using hproper.2 1 + · simpa using hproper.2 2 + · simpa using hproper.2 0 + · refine ⟨SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate hproper.1), ?_⟩ + intro j + fin_cases j + · simpa using hproper.2 2 + · simpa using hproper.2 0 + · simpa using hproper.2 1 + +private theorem hrootFord : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (P : FordFareyParameter), (BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), + q r.succ, q (r + (1 : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ] = + FordRecursiveQuadruple P) → (q' 0 = FordCircleCoordinate P.p P.q) ) := by + classical + intro q r g q' P hEq + have he := congrFun hEq 0 + simpa [q', FordRecursiveQuadruple] using he + +private theorem hpos1 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + (BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : + ℕ)), q r.succ, q (r + (1 : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ])) → + ((∀ (k : Fin (4 : ℕ)), (0 : ℤ) ≤ (q' k).1) → (0 < (q' 1).1)) ) := by + classical + intro q r g q' cfg hnonneg + have hn := hnonneg 1 + have hne := cfg.noLine 1 + rcases eq_or_lt_of_le hn with hz | hp + · exact (hne hz.symm).elim + · exact hp + +private theorem hlt1 : + (by + classical + exact + ∀ (n : ℕ), ∀ (C : BandCircle), (C.1.1.1.toNat = n) → (∀ (q : Fin (4 : ℕ) → + CircleCoordinates), (q 0 = C.1.1) → (∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + (ProperBandQuadruple q') → ((∀ (k : Fin (4 : ℕ)), (0 : ℤ) ≤ (q' k).1) → ((q' 1).1.toNat < + n)))) ) := by + classical + intro n C hc q hroot r g q' hq' hnonneg + have hrootcurv : (q' 0).1.toNat = n := by + have he : q' 0 = BandPackingSymmetryCircleAction g (q 0) := by + simp [q', BandPackingSymmetryQuadrupleAction] + rw [he, (BandPackingSymmetryCovariance g).1] + simpa [hroot] using hc + have hl := hq'.2 0 + have hnat1 : ((q' 1).1.toNat : Int) = (q' 1).1 := + Int.toNat_of_nonneg (hnonneg 1) + have hnat0 : ((q' 0).1.toNat : Int) = (q' 0).1 := + Int.toNat_of_nonneg (hnonneg 0) + have hlcast : ((q' 1).1.toNat : Int) < ((q' 0).1.toNat : Int) := by + rw [hnat1, hnat0] + exact hl + have hcast : ((q' 0).1.toNat : Int) = (n : Int) := by + exact_mod_cast hrootcurv + have hltcast : ((q' 1).1.toNat : Int) < (n : Int) := by + rw [← hcast] + exact hlcast + exact_mod_cast hltcast + +private theorem hT1' : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (hq' : ProperBandQuadruple q'), ∀ (cfg : BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 : + Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ])), ∀ (hpos1 : 0 < (q' 1).1), + let C1 : BandCircle := ⟨ + ⟨q' 1, ⟨Or.inl hpos1, ⟨q', hq'.1, ⟨1, rfl⟩⟩⟩⟩, hpos1⟩ + ∀ (T1 : ProtoTile), (BandPrototile C1.1.1 T1) → (BandPrototile (cfg.firstPredecessor 0) + T1) ) := by + classical + intro q r g q' hq' cfg hpos1 C1 T1 hT1 + rw [cfg.firstChild] + exact hT1 + +private theorem hparents : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (hq' : ProperBandQuadruple q'), ∀ (cfg : BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 : + Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ])), ∀ (hpos1 : 0 < (q' 1).1), + let C1 : BandCircle := ⟨ + ⟨q' 1, ⟨Or.inl hpos1, ⟨q', hq'.1, ⟨1, rfl⟩⟩⟩⟩, hpos1⟩ + ∀ (T1 : ProtoTile), (BandPrototile C1.1.1 T1) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence cfg.firstPredecessor T1 i s + (S i s)) → ( + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + ∀ i, ∀ s, BandPrototile (q' i.succ) (U i s))) ) := by + classical + intro q r g q' hq' cfg hpos1 C1 T1 hT1 S hocc a U i s + fin_cases i <;> cases s + · simpa [U, C1] using hT1 + · simpa [U, C1] using BandPrototileTranslation _ _ (a - ⟨0, 1⟩ * a) hT1 + · have h := (hocc 1 false).1 + change BandPrototile (cfg.firstPredecessor 2) _ at h + rw [cfg.firstParentTwo] at h + simpa [U] using BandPrototileTranslation _ _ (-⟨0, 1⟩ * a) h + · have h := (hocc 1 true).1 + change BandPrototile (cfg.firstPredecessor 2) _ at h + rw [cfg.firstParentTwo] at h + simpa [U] using BandPrototileTranslation _ _ a h + · have h := (hocc 2 false).1 + change BandPrototile (cfg.firstPredecessor 3) _ at h + rw [cfg.firstParentThree] at h + simpa [U] using BandPrototileTranslation _ _ a h + · have h := (hocc 2 true).1 + change BandPrototile (cfg.firstPredecessor 3) _ at h + rw [cfg.firstParentThree] at h + simpa [U] using BandPrototileTranslation _ _ (-⟨0, 1⟩ * a) h + +private theorem hcells0 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let T0 : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ + ∀ (x : GaussianInt), x ∈ T0.cells ↔ ∃ i s, x ∈ (U i s).cells ) := by + classical + intro q r g q' T1 S a U T0 x + simp? [T0] + constructor + · rintro ⟨i, hi | hi⟩ + · exact ⟨i, Or.inr hi⟩ + · exact ⟨i, Or.inl hi⟩ + · rintro ⟨i, hi | hi⟩ + · exact ⟨i, Or.inr hi⟩ + · exact ⟨i, Or.inl hi⟩ + +private theorem hfoot : + (by + classical + exact + (∀ (C : CircleCoordinates), ∀ (T : ProtoTile), (0 < C.1) → ((BandPrototile C T) → + (T.cells.Nonempty))) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), + ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + (BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : + ℕ)), q r.succ, q (r + (1 : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ])) → + ((∀ (k : Fin (4 : ℕ)), (0 : ℤ) ≤ (q' k).1) → (∀ (T1 : ProtoTile), (T1.cells.Nonempty) + → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + (∀ i, ∀ s, BandPrototile (q' i.succ) (U i s)) → ( + let T0 : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ + (∀ (x : GaussianInt), x ∈ T0.cells ↔ ∃ i s, x ∈ (U i s).cells) → (∀ i, ∀ s, + FootprintVertices (U i s) ⊆ FootprintVertices T0)))))) ) := by + classical + intro positiveNonempty q r g q' cfg hnonneg T1 hT1ne S a U hparents T0 hcells0 i s v hv + have hposChild : 0 < (q' i.succ).1 := by + have hnn := hnonneg i.succ + have hne := cfg.noLine i.succ + rcases eq_or_lt_of_le hnn with hzero | hp + · exact (hne hzero.symm).elim + · exact hp + have hUne : (U i s).cells.Nonempty := + positiveNonempty (q' i.succ) (U i s) hposChild (hparents i s) + have hT0ne : T0.cells.Nonempty := by + rcases hT1ne with ⟨x, hx⟩ + refine ⟨x, ?_⟩ + exact (hcells0 x).2 ⟨0, false, by simpa [U] using hx⟩ + simp only [FootprintVertices, ite_eq_left hUne, ite_eq_left hT0ne, + Set.mem_ofPred_eq] at hv ⊢ + obtain ⟨x, hx, hvertex⟩ := hv + exact ⟨x, (hcells0 x).2 ⟨i, s, hx⟩, hvertex⟩ + +private theorem pointNeg : + (by + classical + exact + ∀ (z : GaussianInt), GaussianRealPoint (-z) = -GaussianRealPoint z ) := by + classical + intro z + ext <;> simp [GaussianRealPoint] + +private theorem pointI : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + ∀ (z : GaussianInt), GaussianRealPoint (I * z) = (-(GaussianRealPoint z).2, + (GaussianRealPoint z).1) ) := by + classical + intro I z + ext <;> simp [I, GaussianRealPoint] + +private theorem rRotateV : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), ∀ (cfg : BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 : + Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ])), + let I : GaussianInt := ⟨0, 1⟩ + BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) - I * BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 2) ) := by + classical + intro q r g cfg I + simpa [I] using + (VectorRecursionLaws _ + (SemiProperQuadruple.rotate cfg.firstProper.1)).2.2.1 + +private theorem hv21 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (cfg : BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g ![q (0 : + Fin (4 : ℕ)), q r.succ, q (r + (1 : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : + ℕ))).succ])), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let I : GaussianInt := ⟨0, 1⟩ + let v : GaussianInt := BandVectors.1 (q' 2) (q' 1) + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) - I * BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 2)) → (BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = v + I * a) ) := by + classical + intro q r g q' cfg a I v rRotateV + rw [cfg.firstParentThree, cfg.firstParentTwo, cfg.firstChild] at rRotateV + rw [cfg.firstParentTwo] + dsimp [v, a, I] at rRotateV ⊢ + linear_combination -rRotateV + +private theorem hv13 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (cfg : BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g ![q (0 : + Fin (4 : ℕ)), q r.succ, q (r + (1 : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : + ℕ))).succ])), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let I : GaussianInt := ⟨0, 1⟩ + let v : GaussianInt := BandVectors.1 (q' 2) (q' 1) + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = v + I * a) → + (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -v - (1 + I) * a) + ) := by + classical + intro q r g q' cfg a I v hv21 + have hsum := + (VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).1 + rw [cfg.firstParentThree, cfg.firstParentTwo] at hsum + have h21 := hv21 + rw [cfg.firstParentTwo] at h21 + rw [h21] at hsum + rw [cfg.firstParentThree] + dsimp [v, a, I] at hsum ⊢ + linear_combination hsum + +private theorem hq13 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + (ProperBandQuadruple q') → ( + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let v : GaussianInt := BandVectors.1 (q' 2) (q' 1) + BandVectors.1 (q' 1) (q' 3) = -a - v) ) := by + classical + intro q r g q' hq' a v + have hsum := (VectorRecursionLaws q' hq'.1).1 + dsimp [a, v] at hsum ⊢ + linear_combination hsum + +private theorem dIdent1 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (cfg : BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g ![q (0 : + Fin (4 : ℕ)), q r.succ, q (r + (1 : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : + ℕ))).succ])), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let I : GaussianInt := ⟨0, 1⟩ + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let v : GaussianInt := BandVectors.1 (q' 2) (q' 1) + (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -v - (1 + I) * a) → + ((BandVectors.1 (q' 1) (q' 3) = -a - v) → (d (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3)) + GaussianRealPoint a - d a = d (BandVectors.1 (q' 1) (q' + 3)))) ) := by + classical + intro q r g q' cfg a I d v hv13 hq13 + rw [hv13, hq13] + ext <;> norm_num [d, GaussianRealPoint, I] <;> ring + +private theorem dIdent2 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (cfg : BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g ![q (0 : + Fin (4 : ℕ)), q r.succ, q (r + (1 : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : + ℕ))).succ])), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let I : GaussianInt := ⟨0, 1⟩ + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let v : GaussianInt := BandVectors.1 (q' 2) (q' 1) + (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -v - (1 + I) * a) → + ((BandVectors.1 (q' 1) (q' 3) = -a - v) → (-d (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3)) - GaussianRealPoint (I * a) - d a = -d (BandVectors.1 (q' + 1) (q' 3)))) ) := by + classical + intro q r g q' cfg a I d v hv13 hq13 + rw [hv13, hq13] + ext <;> norm_num [d, GaussianRealPoint, I] <;> ring + +private theorem dIdent3 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (cfg : BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g ![q (0 : + Fin (4 : ℕ)), q r.succ, q (r + (1 : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : + ℕ))).succ])), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let I : GaussianInt := ⟨0, 1⟩ + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let v : GaussianInt := BandVectors.1 (q' 2) (q' 1) + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = v + I * a) → (d + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1)) - GaussianRealPoint + (I * a) - d a = d v) ) := by + classical + intro q r g q' cfg a I d v hv21 + rw [hv21] + ext <;> norm_num [d, GaussianRealPoint, I] <;> ring + +private theorem dIdent4 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (cfg : BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g ![q (0 : + Fin (4 : ℕ)), q r.succ, q (r + (1 : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : + ℕ))).succ])), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let I : GaussianInt := ⟨0, 1⟩ + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let v : GaussianInt := BandVectors.1 (q' 2) (q' 1) + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = v + I * a) → (-d + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1)) + GaussianRealPoint + a - d a = -d v) ) := by + classical + intro q r g q' cfg a I d v hv21 + rw [hv21] + ext <;> norm_num [d, GaussianRealPoint, I] <;> ring + +private theorem hs1m : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), ∀ (cfg : BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 : + Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ])), ∀ (T1 : ProtoTile), ∀ (S : Fin + (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence cfg.firstPredecessor T1 i s (S i s)) → ( + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + TileCentroid (S 1 false) - TileCentroid T1 = -d (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3))) ) := by + classical + intro q r g cfg T1 S hocc d + simpa [d] using (hocc 1 false).2.2 + +private theorem hs1p : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), ∀ (cfg : BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 : + Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ])), ∀ (T1 : ProtoTile), ∀ (S : Fin + (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence cfg.firstPredecessor T1 i s (S i s)) → ( + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + TileCentroid (S 1 true) - TileCentroid T1 = d (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3))) ) := by + classical + intro q r g cfg T1 S hocc d + simpa [d] using (hocc 1 true).2.2 + +private theorem hs2m : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), ∀ (cfg : BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 : + Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ])), ∀ (T1 : ProtoTile), ∀ (S : Fin + (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence cfg.firstPredecessor T1 i s (S i s)) → ( + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + TileCentroid (S 2 false) - TileCentroid T1 = -d (BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1))) ) := by + classical + intro q r g cfg T1 S hocc d + simpa [d] using (hocc 2 false).2.2 + +private theorem hs2p : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), ∀ (cfg : BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 : + Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ])), ∀ (T1 : ProtoTile), ∀ (S : Fin + (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence cfg.firstPredecessor T1 i s (S i s)) → ( + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + TileCentroid (S 2 true) - TileCentroid T1 = d (BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1))) ) := by + classical + intro q r g cfg T1 S hocc d + simpa [d] using (hocc 2 true).2.2 + +private theorem transCent : + (by + classical + exact + ∀ (V : ProtoTile), ∀ (z : GaussianInt), TileCentroid (TileTranslation V z) = TileCentroid + V + GaussianRealPoint z ) := by + classical + intro V z + rw [(TileTranslationFormulas V z).2.2.2.2.1] + ext <;> simp [GaussianRealPoint] + +private theorem hcent' : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (cfg : BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g ![q (0 : + Fin (4 : ℕ)), q r.succ, q (r + (1 : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : + ℕ))).succ])), ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let I : GaussianInt := ⟨0, 1⟩ + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (∀ (z : GaussianInt), GaussianRealPoint (-z) = -GaussianRealPoint z) → ((∀ (z : + GaussianInt), GaussianRealPoint (I * z) = (-(GaussianRealPoint z).2, + (GaussianRealPoint z).1)) → ( + let v : GaussianInt := BandVectors.1 (q' 2) (q' 1) + (d (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)) + GaussianRealPoint + a - d a = d (BandVectors.1 (q' 1) (q' 3))) → ((-d (BandVectors.1 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)) - GaussianRealPoint (I * a) - d a + = -d (BandVectors.1 (q' 1) (q' 3))) → ((d (BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1)) - GaussianRealPoint (I * a) - d a = d v) → ((-d + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1)) + GaussianRealPoint + a - d a = -d v) → ( + let p0 : Real × Real := TileCentroid T1 + d a + (TileCentroid (S 1 false) - TileCentroid T1 = -d (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3))) → ((TileCentroid (S 1 true) - TileCentroid T1 = d + (BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3))) → ((TileCentroid + (S 2 false) - TileCentroid T1 = -d (BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1))) → ((TileCentroid (S 2 true) - TileCentroid T1 = d + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1))) → ((∀ (V : + ProtoTile), ∀ (z : GaussianInt), TileCentroid (TileTranslation V z) = TileCentroid V + + GaussianRealPoint z) → (∀ i, ∀ s, TileCentroid (U i s) - p0 = (if s = true then (1 + : Real) else -1) • d (BandVectors.1 (q' ((i + 2).succ)) (q' ((i + + 1).succ)))))))))))))) ) := by + classical + intro q r g q' cfg T1 S a U I d pointNeg pointI v dIdent1 dIdent2 dIdent3 dIdent4 p0 hs1m hs1p + hs2m hs2p transCent i s + fin_cases i <;> cases s + · simp [U, p0, a] + · simp? [U, p0] + change TileCentroid (TileTranslation T1 (a - I * a)) - + p0 = d a + rw [transCent] + dsimp [p0] + ext <;> simp [d, I, GaussianRealPoint] <;> ring + · simp? [U, p0] + change TileCentroid (TileTranslation (S 1 false) (-((⟨0, 1⟩ : GaussianInt) * + a))) - + p0 = -d (BandVectors.1 (q' 1) (q' 3)) + rw [transCent] + rw [show GaussianRealPoint (-((⟨0, 1⟩ : GaussianInt) * a)) = + -GaussianRealPoint (I * a) by simpa [I] using pointNeg (I * a)] + rw [pointI] + dsimp [p0] + apply Prod.ext + · have hh := congrArg Prod.fst hs1m + have hd := congrArg Prod.fst dIdent2 + rw [pointI] at hd + dsimp [d] at hh hd ⊢ + linarith + · have hh := congrArg Prod.snd hs1m + have hd := congrArg Prod.snd dIdent2 + rw [pointI] at hd + dsimp [d] at hh hd ⊢ + linarith + · simp? [U, p0] + change TileCentroid (TileTranslation (S 1 true) a) - + p0 = d (BandVectors.1 (q' 1) (q' 3)) + rw [transCent] + dsimp [p0] + apply Prod.ext + · have hh := congrArg Prod.fst hs1p + have hd := congrArg Prod.fst dIdent1 + simp [GaussianRealPoint] at hh hd ⊢ + linarith + · have hh := congrArg Prod.snd hs1p + have hd := congrArg Prod.snd dIdent1 + simp [GaussianRealPoint] at hh hd ⊢ + linarith + · simp? [U, p0] + change TileCentroid (TileTranslation (S 2 false) a) - + p0 = -d v + rw [transCent] + dsimp [p0] + apply Prod.ext + · have hh := congrArg Prod.fst hs2m + have hd := congrArg Prod.fst dIdent4 + simp [GaussianRealPoint] at hh hd ⊢ + linarith + · have hh := congrArg Prod.snd hs2m + have hd := congrArg Prod.snd dIdent4 + simp [GaussianRealPoint] at hh hd ⊢ + linarith + · simp? [U, p0] + change TileCentroid (TileTranslation (S 2 true) (-((⟨0, 1⟩ : GaussianInt) * + a))) - + p0 = d v + rw [transCent] + rw [show GaussianRealPoint (-((⟨0, 1⟩ : GaussianInt) * a)) = + -GaussianRealPoint (I * a) by simpa [I] using pointNeg (I * a)] + rw [pointI] + dsimp [p0] + apply Prod.ext + · have hh := congrArg Prod.fst hs2p + have hd := congrArg Prod.fst dIdent3 + rw [pointI] at hd + dsimp [d] at hh hd ⊢ + linarith + · have hh := congrArg Prod.snd hs2p + have hd := congrArg Prod.snd dIdent3 + rw [pointI] at hd + dsimp [d] at hh hd ⊢ + linarith + +private theorem hboundRe : + (by + classical + exact + ∀ (T1 : ProtoTile), + let reCells : Finset Int := T1.cells.image (fun x => x.re) + ∀ (reNe : reCells.Nonempty), ∀ p ∈ TileRealization T1, (↑(reCells.min' reNe) : Real) ≤ + p.1 ∧ p.1 ≤ (↑(reCells.max' reNe) : Real) + 1 ) := by + classical + intro T1 reCells reNe p hp + simp only [TileRealization, Set.mem_iUnion] at hp + rcases hp with ⟨x, hx, hpx⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpx + constructor + · exact le_trans (by exact_mod_cast + (Finset.min'_le (T1.cells.image fun x => x.re) x.re + (Finset.mem_image.mpr ⟨x, hx, rfl⟩))) hpx.1.1 + · have hh := Finset.le_max' (T1.cells.image fun x => x.re) x.re + (Finset.mem_image.mpr ⟨x, hx, rfl⟩) + have hh' : (x.re : Real) ≤ (reCells.max' reNe : Real) := by + exact_mod_cast hh + linarith [hh', hpx.2.1] + +private theorem reflect1 : + (by + classical + exact + ∀ (T1 : ProtoTile), + let c1 := TileCentroid T1 + (CentrallyReflectedAt c1 T1 T1) → (∀ p ∈ TileRealization T1, (2 * c1.1 - p.1, 2 * c1.2 - + p.2) ∈ TileRealization T1) ) := by + classical + intro T1 c1 hcentral1 p hp + rw [hcentral1] + exact ⟨p, hp, rfl⟩ + +private theorem minReCell : + (by + classical + exact + ∀ (T1 : ProtoTile), + let reCells : Finset Int := T1.cells.image (fun x => x.re) + ∀ (reNe : reCells.Nonempty), + let mRe := reCells.min' reNe + ∃ x ∈ T1.cells, x.re = mRe ) := by + classical + intro T1 reCells reNe mRe + rcases Finset.mem_image.mp (Finset.min'_mem reCells reNe) with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + +private theorem maxReCell : + (by + classical + exact + ∀ (T1 : ProtoTile), + let reCells : Finset Int := T1.cells.image (fun x => x.re) + ∀ (reNe : reCells.Nonempty), + let MRe := reCells.max' reNe + ∃ x ∈ T1.cells, x.re = MRe ) := by + classical + intro T1 reCells reNe MRe + rcases Finset.mem_image.mp (Finset.max'_mem reCells reNe) with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + +private theorem centerRe : + (by + classical + exact + ∀ (T1 : ProtoTile), + let c1 := TileCentroid T1 + let reCells : Finset Int := T1.cells.image (fun x => x.re) + ∀ (reNe : reCells.Nonempty), (∀ p ∈ TileRealization T1, (↑(reCells.min' reNe) : Real) ≤ + p.1 ∧ p.1 ≤ (↑(reCells.max' reNe) : Real) + 1) → ((∀ p ∈ TileRealization T1, (2 * + c1.1 - p.1, 2 * c1.2 - p.2) ∈ TileRealization T1) → ( + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + (∃ x ∈ T1.cells, x.re = mRe) → ((∃ x ∈ T1.cells, x.re = MRe) → (2 * c1.1 = (mRe : Real) + + MRe + 1)))) ) := by + classical + intro T1 c1 reCells reNe hboundRe reflect1 mRe MRe minReCell maxReCell + rcases minReCell with ⟨xmin, hxmin, hxminre⟩ + rcases maxReCell with ⟨xmax, hmax, hmaxre⟩ + have pmin : ((mRe : Real), (xmin.im : Real)) ∈ TileRealization T1 := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmin, hxmin, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + exact ⟨⟨by simp [hxminre], by simp []⟩, + ⟨by simp [hxminre], by simp⟩⟩ + have pmax : (((MRe : Real) + 1), (xmax.im : Real)) ∈ TileRealization T1 := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmax, hmax, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + exact ⟨⟨by simp [hmaxre], by simp⟩, + ⟨by simp [hmaxre], by simp⟩⟩ + have bmin := hboundRe _ (reflect1 _ pmin) + have bmax := hboundRe _ (reflect1 _ pmax) + dsimp at bmin bmax + norm_num at bmin bmax ⊢ + linarith [bmin.2, bmax.1] + +private theorem hboundIm : + (by + classical + exact + ∀ (T1 : ProtoTile), + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (imNe : imCells.Nonempty), ∀ p ∈ TileRealization T1, (↑(imCells.min' imNe) : Real) ≤ + p.2 ∧ p.2 ≤ (↑(imCells.max' imNe) : Real) + 1 ) := by + classical + intro T1 imCells imNe p hp + simp only [TileRealization, Set.mem_iUnion] at hp + rcases hp with ⟨x, hx, hpx⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpx + constructor + · exact le_trans (Int.cast_le.mpr + (Finset.min'_le _ x.im (Finset.mem_image.mpr ⟨x, hx, rfl⟩))) hpx.1.2 + · have hh := Finset.le_max' (T1.cells.image fun x => x.im) x.im + (Finset.mem_image.mpr ⟨x, hx, rfl⟩) + have hh' : (x.im : Real) ≤ (imCells.max' imNe : Real) := by + exact_mod_cast hh + linarith [hpx.2.2] + +private theorem minImCell : + (by + classical + exact + ∀ (T1 : ProtoTile), + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (imNe : imCells.Nonempty), + let mIm := imCells.min' imNe + ∃ x ∈ T1.cells, x.im = mIm ) := by + classical + intro T1 imCells imNe mIm + rcases Finset.mem_image.mp (Finset.min'_mem imCells imNe) with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + +private theorem maxImCell : + (by + classical + exact + ∀ (T1 : ProtoTile), + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (imNe : imCells.Nonempty), + let MIm := imCells.max' imNe + ∃ x ∈ T1.cells, x.im = MIm ) := by + classical + intro T1 imCells imNe MIm + rcases Finset.mem_image.mp (Finset.max'_mem imCells imNe) with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + +private theorem centerIm : + (by + classical + exact + ∀ (T1 : ProtoTile), + let c1 := TileCentroid T1 + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (imNe : imCells.Nonempty), (∀ p ∈ TileRealization T1, (2 * c1.1 - p.1, 2 * c1.2 - p.2) + ∈ TileRealization T1) → ((∀ p ∈ TileRealization T1, (↑(imCells.min' imNe) : Real) ≤ + p.2 ∧ p.2 ≤ (↑(imCells.max' imNe) : Real) + 1) → ( + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + (∃ x ∈ T1.cells, x.im = mIm) → ((∃ x ∈ T1.cells, x.im = MIm) → (2 * c1.2 = (mIm : Real) + + MIm + 1)))) ) := by + classical + intro T1 c1 imCells imNe reflect1 hboundIm mIm MIm minImCell maxImCell + rcases minImCell with ⟨xmin, hxmin, hxminim⟩ + rcases maxImCell with ⟨xmax, hmax, hmaxim⟩ + have pmin : ((xmin.re : Real), (mIm : Real)) ∈ TileRealization T1 := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmin, hxmin, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + exact ⟨⟨by simp, by simp [hxminim]⟩, + ⟨by simp, by simp [hxminim]⟩⟩ + have pmax : ((xmax.re : Real), ((MIm : Real) + 1)) ∈ TileRealization T1 := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmax, hmax, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + exact ⟨⟨by simp, by simp [hmaxim]⟩, + ⟨by simp, by simp [hmaxim]⟩⟩ + have bmin := hboundIm _ (reflect1 _ pmin) + have bmax := hboundIm _ (reflect1 _ pmax) + dsimp at bmin bmax + norm_num at bmin bmax ⊢ + linarith + +private theorem ht1 : + (by + classical + exact + ∀ (T1 : ProtoTile), + let c1 := TileCentroid T1 + let reCells : Finset Int := T1.cells.image (fun x => x.re) + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + (2 * c1.1 = (mRe : Real) + MRe + 1) → ( + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + (2 * c1.2 = (mIm : Real) + MIm + 1) → ( + let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + GaussianRealPoint t1 = (2 * c1.1, 2 * c1.2))) ) := by + classical + intro T1 c1 reCells imCells reNe imNe mRe MRe centerRe mIm MIm centerIm t1 + apply Prod.ext + · simp [t1, GaussianRealPoint] + linarith [centerRe] + · simp [t1, GaussianRealPoint] + linarith [centerIm] + +private theorem ht0 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let I : GaussianInt := ⟨0, 1⟩ + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let p0 : Real × Real := TileCentroid T1 + d a + let c1 := TileCentroid T1 + let reCells : Finset Int := T1.cells.image (fun x => x.re) + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + (GaussianRealPoint t1 = (2 * c1.1, 2 * c1.2)) → ( + let t0 : GaussianInt := t1 + a - I * a + GaussianRealPoint t0 = (2 : Real) • p0) ) := by + classical + intro q r g q' T1 a I d p0 c1 reCells imCells reNe imNe mRe MRe mIm MIm t1 ht1 t0 + apply Prod.ext + · have ht := congrArg Prod.fst ht1 + dsimp [t0, p0, d, I, GaussianRealPoint] at ht ⊢ + norm_num at ht ⊢ + linarith + · have ht := congrArg Prod.snd ht1 + dsimp [t0, p0, d, I, GaussianRealPoint] at ht ⊢ + norm_num at ht ⊢ + linarith + +private theorem hsigned : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + (∀ i, ∀ s, BandPrototile (q' i.succ) (U i s)) → ( + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let p0 : Real × Real := TileCentroid T1 + d a + (∀ i, ∀ s, TileCentroid (U i s) - p0 = (if s = true then (1 : Real) else -1) • d + (BandVectors.1 (q' ((i + 2).succ)) (q' ((i + 1).succ)))) → (∀ (i : Fin (3 : ℕ)), + let w := BandVectors.1 (q' (i + (2 : Fin (3 : ℕ))).succ) (q' (i + (1 : Fin (3 : ℕ))).succ); + let u := GaussianQuarterTurn w - w; (TileTranslation (U i true) u).cells = (U i + false).cells ∧ ((U i true).cells = ∅ → (TileTranslation (U i true) u).anchor = (U i + false).anchor) ∧ FootprintVertices (TileTranslation (U i true) u) = FootprintVertices + (U i false) ∧ TileCentroid (TileTranslation (U i true) u) = TileCentroid (U i false) + ∧ TileArea (U i true) = TileArea (U i false) ∧ CentrallyReflectedAt p0 (U i true) (U + i false))) ) := by + classical + intro q r g q' T1 S a U hparents d p0 hcent' + exact BandSignedOccurrenceHalfTurn q' p0 U hparents (by + intro i s + simpa [d] using hcent' i s) + +private theorem pairEq : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let p0 : Real × Real := TileCentroid T1 + d a + let R : Real × Real → Real × Real := fun p => + (2 * p0.1 - p.1, 2 * p0.2 - p.2) + (∀ (i : Fin (3 : ℕ)), + let w := BandVectors.1 (q' (i + (2 : Fin (3 : ℕ))).succ) (q' (i + (1 : Fin (3 : ℕ))).succ); + let u := GaussianQuarterTurn w - w; (TileTranslation (U i true) u).cells = (U i + false).cells ∧ ((U i true).cells = ∅ → (TileTranslation (U i true) u).anchor = (U i + false).anchor) ∧ FootprintVertices (TileTranslation (U i true) u) = FootprintVertices + (U i false) ∧ TileCentroid (TileTranslation (U i true) u) = TileCentroid (U i false) + ∧ TileArea (U i true) = TileArea (U i false) ∧ CentrallyReflectedAt p0 (U i true) (U + i false)) → (∀ (i : Fin 3), TileRealization (U i false) = R '' TileRealization (U i + true)) ) := by + classical + intro q r g q' T1 S a U d p0 R hsigned i + simpa [R, CentrallyReflectedAt] using (hsigned i).2.2.2.2.2 + +private theorem pairMem : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let p0 : Real × Real := TileCentroid T1 + d a + let R : Real × Real → Real × Real := fun p => + (2 * p0.1 - p.1, 2 * p0.2 - p.2) + (∀ (p : Real × Real), R (R p) = p) → ((∀ (i : Fin 3), TileRealization (U i false) = R '' + TileRealization (U i true)) → (∀ (i : Fin 3), ∀ (p : Real × Real), (p ∈ + TileRealization (U i false) ↔ R p ∈ TileRealization (U i true)))) ) := by + classical + intro q r g q' T1 S a U d p0 R hRinv pairEq i p + constructor + · intro hp + rw [pairEq i] at hp + rcases hp with ⟨q, hq, hqp⟩ + have heq : R p = q := by + calc R p = R (R q) := congrArg R hqp.symm + _ = q := hRinv q + rw [heq] + exact hq + · intro hp + have hp' : p = R (R p) := (hRinv p).symm + rw [hp'] + rw [pairEq i] + exact ⟨R p, hp, rfl⟩ + +private theorem pairMem' : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let p0 : Real × Real := TileCentroid T1 + d a + let R : Real × Real → Real × Real := fun p => + (2 * p0.1 - p.1, 2 * p0.2 - p.2) + (∀ (p : Real × Real), R (R p) = p) → ((∀ (i : Fin 3), ∀ (p : Real × Real), (p ∈ + TileRealization (U i false) ↔ R p ∈ TileRealization (U i true))) → (∀ (i : Fin 3), ∀ + (p : Real × Real), (p ∈ TileRealization (U i true) ↔ R p ∈ TileRealization (U i + false)))) ) := by + classical + intro q r g q' T1 S a U d p0 R hRinv pairMem i p + simpa [hRinv] using (pairMem i (R p)).symm + +private theorem realization0 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let T0 : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ + (∀ (x : GaussianInt), x ∈ T0.cells ↔ ∃ i s, x ∈ (U i s).cells) → (TileRealization T0 = ⋃ + i : Fin 3, ⋃ s : Bool, TileRealization (U i s)) ) := by + classical + intro q r g q' T1 S a U T0 hcells0 + ext p + simp only [TileRealization, Set.mem_iUnion] + constructor + · rintro ⟨x, hx, hp⟩ + rcases (hcells0 x).mp hx with ⟨i, s, hs⟩ + exact ⟨i, s, x, hs, hp⟩ + · rintro ⟨i, s, x, hx, hp⟩ + exact ⟨x, (hcells0 x).mpr ⟨i, s, hx⟩, hp⟩ + +private theorem hcentral0 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let T0 : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let p0 : Real × Real := TileCentroid T1 + d a + let R : Real × Real → Real × Real := fun p => + (2 * p0.1 - p.1, 2 * p0.2 - p.2) + (∀ (p : Real × Real), R (R p) = p) → ((∀ (i : Fin 3), ∀ (p : Real × Real), (p ∈ + TileRealization (U i false) ↔ R p ∈ TileRealization (U i true))) → ((∀ (i : Fin 3), ∀ + (p : Real × Real), (p ∈ TileRealization (U i true) ↔ R p ∈ TileRealization (U i + false))) → ((TileRealization T0 = ⋃ i : Fin 3, ⋃ s : Bool, TileRealization (U i s)) → + (CentrallyReflectedAt p0 T0 T0)))) ) := by + classical + intro q r g q' T1 S a U T0 d p0 R hRinv pairMem pairMem' realization0 + rw [CentrallyReflectedAt, realization0] + ext p + simp only [Set.mem_iUnion, Set.mem_image] + constructor + · rintro ⟨i, s, hp⟩ + cases s + · have hh := (pairMem i p).mp hp + refine ⟨R p, ⟨i, true, hh⟩, ?_⟩ + exact hRinv p + · have hh := (pairMem' i p).mp hp + exact ⟨R p, ⟨i, false, hh⟩, hRinv p⟩ + · rintro ⟨x, ⟨i, s, hx⟩, hxp⟩ + have hx' : R p ∈ TileRealization (U i s) := by + have he : x = R p := by + calc x = R (R x) := (hRinv x).symm + _ = R p := congrArg R hxp + rw [← he] + exact hx + cases s + · exact ⟨i, true, (pairMem' i p).mpr hx'⟩ + · exact ⟨i, false, (pairMem i p).mpr hx'⟩ + +private theorem gridCenter : + (by + classical + exact + (ℕ) → ((BandCircle) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g + : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let T0 : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ + let reCells : Finset Int := T1.cells.image (fun x => x.re) + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + (∃ x ∈ T1.cells, x.re = mRe) → ((∃ x ∈ T1.cells, x.re = MRe) → ( + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + (∃ x ∈ T1.cells, x.im = mIm) → ((∃ x ∈ T1.cells, x.im = MIm) → (∀ (x : GaussianInt), + ((x.re : Real) + 1 / 2, (x.im : Real) + 1 / 2) ∈ TileRealization T0 ↔ x ∈ + T0.cells)))))) ) := by + classical + intro n C q r g q' T1 S a U T0 reCells imCells reNe imNe mRe MRe minReCell maxReCell mIm MIm + minImCell maxImCell x + constructor + · intro hp + simp only [TileRealization, Set.mem_iUnion] at hp + rcases hp with ⟨y, hy, hsq⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hsq + have hyx : y = x := by + apply Zsqrtd.ext + · have h1 : (y.re : Real) < (x.re : Real) + 1 := by linarith [hsq.1.1] + have h2 : (x.re : Real) < (y.re : Real) + 1 := by linarith [hsq.2.1] + have h1' : y.re < x.re + 1 := by exact_mod_cast h1 + have h2' : x.re < y.re + 1 := by exact_mod_cast h2 + omega + · have h1 : (y.im : Real) < (x.im : Real) + 1 := by linarith [hsq.1.2] + have h2 : (x.im : Real) < (y.im : Real) + 1 := by linarith [hsq.2.2] + have h1' : y.im < x.im + 1 := by exact_mod_cast h1 + have h2' : x.im < y.im + 1 := by exact_mod_cast h2 + omega + simpa [hyx] using hy + · intro hx + simp only [TileRealization, Set.mem_iUnion] + refine ⟨x, hx, ?_⟩ + norm_num [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + +private theorem tau_center : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let I : GaussianInt := ⟨0, 1⟩ + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let p0 : Real × Real := TileCentroid T1 + d a + let reCells : Finset Int := T1.cells.image (fun x => x.re) + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let t0 : GaussianInt := t1 + a - I * a + (GaussianRealPoint t0 = (2 : Real) • p0) → ( + let R : Real × Real → Real × Real := fun p => + (2 * p0.1 - p.1, 2 * p0.2 - p.2) + let tau : GaussianInt → GaussianInt := fun x => t0 - x - 1 - I + ∀ (x : GaussianInt), R ((x.re : Real) + 1 / 2, (x.im : Real) + 1 / 2) = (((tau x).re : + Real) + 1 / 2, ((tau x).im : Real) + 1 / 2)) ) := by + classical + intro q r g q' T1 a I d p0 reCells imCells reNe imNe mRe MRe mIm MIm t1 t0 ht0 R tau x + apply Prod.ext + · have hr := congrArg Prod.fst ht0 + have htr : (t0.re : Real) = 2 * p0.1 := by + simpa [GaussianRealPoint] using hr + have htau : (tau x).re = t0.re - x.re - 1 := by + simp [tau, I] + change 2 * p0.1 - ((x.re : Real) + 1 / 2) = + ((tau x).re : Real) + 1 / 2 + rw [← htr, htau] + push_cast + ring + · have hi := congrArg Prod.snd ht0 + have hti : (t0.im : Real) = 2 * p0.2 := by + simpa [GaussianRealPoint] using hi + have htau : (tau x).im = t0.im - x.im - 1 := by + simp [tau, I] + change 2 * p0.2 - ((x.im : Real) + 1 / 2) = + ((tau x).im : Real) + 1 / 2 + rw [← hti, htau] + push_cast + ring + +private theorem tau_cells : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let T0 : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ + let I : GaussianInt := ⟨0, 1⟩ + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let p0 : Real × Real := TileCentroid T1 + d a + let reCells : Finset Int := T1.cells.image (fun x => x.re) + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let t0 : GaussianInt := t1 + a - I * a + let R : Real × Real → Real × Real := fun p => + (2 * p0.1 - p.1, 2 * p0.2 - p.2) + (CentrallyReflectedAt p0 T0 T0) → ((∀ (x : GaussianInt), ((x.re : Real) + 1 / 2, (x.im : + Real) + 1 / 2) ∈ TileRealization T0 ↔ x ∈ T0.cells) → ( + let tau : GaussianInt → GaussianInt := fun x => t0 - x - 1 - I + (∀ (x : GaussianInt), R ((x.re : Real) + 1 / 2, (x.im : Real) + 1 / 2) = (((tau x).re : + Real) + 1 / 2, ((tau x).im : Real) + 1 / 2)) → (∀ (x : GaussianInt), (x ∈ T0.cells) → + (tau x ∈ T0.cells)))) ) := by + classical + intro q r g q' T1 S a U T0 I d p0 reCells imCells reNe imNe mRe MRe mIm MIm t1 t0 R hcentral0 + gridCenter tau tau_center x hx + apply (gridCenter (tau x)).mp + rw [← tau_center] + rw [CentrallyReflectedAt] at hcentral0 + have hc : (R ((x.re : Real) + 1 / 2, (x.im : Real) + 1 / 2)) ∈ + TileRealization T0 := by + rw [hcentral0] + exact ⟨((x.re : Real) + 1 / 2, (x.im : Real) + 1 / 2), + (gridCenter x).mpr hx, rfl⟩ + exact hc + +private theorem hT0neAt738 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), (T1.cells.Nonempty) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let T0 : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ + (∀ (x : GaussianInt), x ∈ T0.cells ↔ ∃ i s, x ∈ (U i s).cells) → (T0.cells.Nonempty)) ) + := by + classical + intro q r g q' T1 hT1ne S a U T0 hcells0 + rcases hT1ne with ⟨x, hx⟩ + refine ⟨x, ?_⟩ + apply (hcells0 x).mpr + refine ⟨0, false, ?_⟩ + simpa [U] using hx + +private theorem sumRe : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let T0 : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ + let I : GaussianInt := ⟨0, 1⟩ + let reCells : Finset Int := T1.cells.image (fun x => x.re) + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let t0 : GaussianInt := t1 + a - I * a + let tau : GaussianInt → GaussianInt := fun x => t0 - x - 1 - I + (∀ (x : GaussianInt), tau (tau x) = x) → ((∀ (x : GaussianInt), (x ∈ T0.cells) → (tau x ∈ + T0.cells)) → (T0.cells.sum (fun x => (x.re : Real)) = T0.cells.sum (fun x => ((tau + x).re : Real)))) ) := by + classical + intro q r g q' T1 S a U T0 I reCells imCells reNe imNe mRe MRe mIm MIm t1 t0 tau tau_invol + tau_cells + apply Finset.sum_bij (fun x _ => tau x) + · intro x hx + exact tau_cells x hx + · intro x hx y hy he + have hh := congrArg tau he + simpa [tau_invol] using hh + · intro y hy + exact ⟨tau y, tau_cells y hy, tau_invol y⟩ + · intro x hx + exact (congrArg (fun z => (z.re : Real)) (tau_invol x)).symm + +private theorem sumIm : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let T0 : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ + let I : GaussianInt := ⟨0, 1⟩ + let reCells : Finset Int := T1.cells.image (fun x => x.re) + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let t0 : GaussianInt := t1 + a - I * a + let tau : GaussianInt → GaussianInt := fun x => t0 - x - 1 - I + (∀ (x : GaussianInt), tau (tau x) = x) → ((∀ (x : GaussianInt), (x ∈ T0.cells) → (tau x ∈ + T0.cells)) → (T0.cells.sum (fun x => (x.im : Real)) = T0.cells.sum (fun x => ((tau + x).im : Real)))) ) := by + classical + intro q r g q' T1 S a U T0 I reCells imCells reNe imNe mRe MRe mIm MIm t1 t0 tau tau_invol + tau_cells + apply Finset.sum_bij (fun x _ => tau x) + · intro x hx + exact tau_cells x hx + · intro x hx y hy he + have hh := congrArg tau he + simpa [tau_invol] using hh + · intro y hy + exact ⟨tau y, tau_cells y hy, tau_invol y⟩ + · intro x hx + exact (congrArg (fun z => (z.im : Real)) (tau_invol x)).symm + +private theorem hre : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let I : GaussianInt := ⟨0, 1⟩ + let reCells : Finset Int := T1.cells.image (fun x => x.re) + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let t0 : GaussianInt := t1 + a - I * a + let tau : GaussianInt → GaussianInt := fun x => t0 - x - 1 - I + ∀ x, ((tau x).re : Real) = (t0.re : Real) - (x.re : Real) - 1 ) := by + classical + intro q r g q' T1 a I reCells imCells reNe imNe mRe MRe mIm MIm t1 t0 tau x + simp [tau, I] + +private theorem him : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let I : GaussianInt := ⟨0, 1⟩ + let reCells : Finset Int := T1.cells.image (fun x => x.re) + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let t0 : GaussianInt := t1 + a - I * a + let tau : GaussianInt → GaussianInt := fun x => t0 - x - 1 - I + ∀ x, ((tau x).im : Real) = (t0.im : Real) - (x.im : Real) - 1 ) := by + classical + intro q r g q' T1 a I reCells imCells reNe imNe mRe MRe mIm MIm t1 t0 tau x + simp [tau, I] + +private theorem sRe : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let T0 : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ + let I : GaussianInt := ⟨0, 1⟩ + let reCells : Finset Int := T1.cells.image (fun x => x.re) + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let t0 : GaussianInt := t1 + a - I * a + let tau : GaussianInt → GaussianInt := fun x => t0 - x - 1 - I + (T0.cells.sum (fun x => (x.re : Real)) = T0.cells.sum (fun x => ((tau x).re : Real))) → + ((∀ x, ((tau x).re : Real) = (t0.re : Real) - (x.re : Real) - 1) → (2 * T0.cells.sum + (fun x => (x.re : Real)) = (T0.cells.card : Real) * (t0.re : Real) - T0.cells.card)) + ) := by + classical + intro q r g q' T1 S a U T0 I reCells imCells reNe imNe mRe MRe mIm MIm t1 t0 tau sumRe hre + have hs := sumRe + simp_rw [hre] at hs + rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib, + Finset.sum_const, Finset.sum_const] at hs + simp? at hs + have hEq : T0.cells.sum (fun x => (x.re : Real)) = + T0.cells.sum (fun x => (GaussianInt.toComplex x).re) := by + apply Finset.sum_congr rfl + intro x hx + exact GaussianInt.intCast_re x + have hs' : T0.cells.sum (fun x => (x.re : Real)) = + (T0.cells.card : Real) * (GaussianInt.toComplex t0).re - + T0.cells.sum (fun x => (x.re : Real)) - T0.cells.card := by + rw [hEq] + simpa using hs + rw [show (GaussianInt.toComplex t0).re = (t0.re : Real) by + exact (GaussianInt.intCast_re t0).symm] at hs' + nlinarith [hs'] + +private theorem sIm : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let T0 : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ + let I : GaussianInt := ⟨0, 1⟩ + let reCells : Finset Int := T1.cells.image (fun x => x.re) + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let t0 : GaussianInt := t1 + a - I * a + let tau : GaussianInt → GaussianInt := fun x => t0 - x - 1 - I + (T0.cells.sum (fun x => (x.im : Real)) = T0.cells.sum (fun x => ((tau x).im : Real))) → + ((∀ x, ((tau x).im : Real) = (t0.im : Real) - (x.im : Real) - 1) → (2 * T0.cells.sum + (fun x => (x.im : Real)) = (T0.cells.card : Real) * (t0.im : Real) - T0.cells.card)) + ) := by + classical + intro q r g q' T1 S a U T0 I reCells imCells reNe imNe mRe MRe mIm MIm t1 t0 tau sumIm him + have hs := sumIm + simp_rw [him] at hs + rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib, + Finset.sum_const, Finset.sum_const] at hs + simp? at hs + have hEq : T0.cells.sum (fun x => (x.im : Real)) = + T0.cells.sum (fun x => (GaussianInt.toComplex x).im) := by + apply Finset.sum_congr rfl + intro x hx + exact GaussianInt.intCast_im x + have hs' : T0.cells.sum (fun x => (x.im : Real)) = + (T0.cells.card : Real) * (GaussianInt.toComplex t0).im - + T0.cells.sum (fun x => (x.im : Real)) - T0.cells.card := by + rw [hEq] + simpa using hs + rw [show (GaussianInt.toComplex t0).im = (t0.im : Real) by + exact (GaussianInt.intCast_im t0).symm] at hs' + nlinarith [hs'] + +private theorem hcentroid0 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let T0 : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ + (T0.cells.Nonempty) → (TileCentroid T0 = (((T0.cells.sum fun x => (x.re : Real)) / + T0.cells.card) + 1 / 2, ((T0.cells.sum fun x => (x.im : Real)) / T0.cells.card) + 1 / + 2)) ) := by + classical + intro q r g q' T1 S a U T0 hT0ne + simp [TileCentroid, hT0ne] + +private theorem hcent : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + let T0 : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let p0 : Real × Real := TileCentroid T1 + d a + (∀ i, ∀ s, TileCentroid (U i s) - p0 = (if s = true then (1 : Real) else -1) • d + (BandVectors.1 (q' ((i + 2).succ)) (q' ((i + 1).succ)))) → ((TileCentroid T0 = p0) → + (∀ i, ∀ s, TileCentroid (U i s) - TileCentroid T0 = (if s = true then (1 : Real) else + -1) • ((1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q' ((i + 2).succ)) (q' ((i + + 1).succ))) - (-((GaussianRealPoint (BandVectors.1 (q' ((i + 2).succ)) (q' ((i + + 1).succ)))).2), (GaussianRealPoint (BandVectors.1 (q' ((i + 2).succ)) (q' ((i + + 1).succ)))).1))))) ) := by + classical + intro q r g q' T1 S a U T0 d p0 hcent' hrootCent i s + rw [hrootCent] + simpa [d, p0] using hcent' i s + +private theorem hq0 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (q 0 = C.1.1) → (∀ (r : Fin + (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (inverse : BandPackingSymmetry), (∀ (C : CircleCoordinates), + BandPackingSymmetryCircleAction inverse (BandPackingSymmetryCircleAction g C) = C) → + (BandPackingSymmetryCircleAction inverse (q' 0) = C.1.1)) ) := by + classical + intro C q hroot r g q' inverse hinvC + have hq0' : q' 0 = BandPackingSymmetryCircleAction g (C.1.1) := by + simp [q', BandPackingSymmetryQuadrupleAction, hroot] + rw [hq0'] + exact hinvC _ + +private theorem hresult' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (normalized : ∃ T : ProtoTile, BandPrototile (q' 0) T), ∀ (inverse : + BandPackingSymmetry), (BandPrototile (BandPackingSymmetryCircleAction inverse (q' (0 + : Fin (4 : ℕ)))) (BandPackingSymmetryTileAction inverse normalized.choose)) → + ((BandPackingSymmetryCircleAction inverse (q' 0) = C.1.1) → (BandPrototile (C.1.1) + (BandPackingSymmetryTileAction inverse normalized.choose))) ) := by + classical + intro C q r g q' normalized inverse hresult hq0 + simpa only [hq0] using hresult + +end PrototileConstruction + +namespace PrototileAssembly + +private theorem hrootCent : + (by + classical + exact + (ℕ) → ((BandCircle) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g + : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), (T1.cells.Nonempty) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + (∀ i, ∀ s, BandPrototile (q' i.succ) (U i s)) → ( + let T0 : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ + (∀ (x : GaussianInt), x ∈ T0.cells ↔ ∃ i s, x ∈ (U i s).cells) → ( + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let p0 : Real × Real := TileCentroid T1 + d a + (∀ i, ∀ s, TileCentroid (U i s) - p0 = (if s = true then (1 : Real) else -1) • d + (BandVectors.1 (q' ((i + 2).succ)) (q' ((i + 1).succ)))) → ( + let c1 := TileCentroid T1 + let reCells : Finset Int := T1.cells.image (fun x => x.re) + let imCells : Finset Int := T1.cells.image (fun x => x.im) + ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + (∃ x ∈ T1.cells, x.re = mRe) → ((∃ x ∈ T1.cells, x.re = MRe) → ( + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + (∃ x ∈ T1.cells, x.im = mIm) → ((∃ x ∈ T1.cells, x.im = MIm) → ( + let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + (GaussianRealPoint t1 = (2 * c1.1, 2 * c1.2)) → (TileCentroid T0 = p0))))))))))) ) := by + classical + intro n C q r g q' T1 hT1ne S a U hparents T0 hcells0 d p0 hcent' c1 reCells imCells reNe imNe + mRe MRe minReCell maxReCell mIm MIm minImCell maxImCell t1 ht1 + let I : GaussianInt := ⟨0, 1⟩ + let t0 : GaussianInt := t1 + a - I * a + have ht0 : GaussianRealPoint t0 = (2 : Real) • p0 := PrototileConstruction.ht0 + q r g T1 reNe imNe ht1 + let R : Real × Real → Real × Real := fun p => + (2 * p0.1 - p.1, 2 * p0.2 - p.2) + have hRinv (p : Real × Real) : R (R p) = p := by + apply Prod.ext <;> dsimp [R] <;> ring + have hsigned := PrototileConstruction.hsigned q r g T1 S hparents hcent' + have pairEq (i : Fin 3) : + TileRealization (U i false) = R '' TileRealization (U i true) := + PrototileConstruction.pairEq q r g T1 S hsigned i + have pairMem (i : Fin 3) (p : Real × Real) : + (p ∈ TileRealization (U i false) ↔ + R p ∈ TileRealization (U i true)) := PrototileConstruction.pairMem q r g + T1 S hRinv pairEq i p + have pairMem' (i : Fin 3) (p : Real × Real) : + (p ∈ TileRealization (U i true) ↔ + R p ∈ TileRealization (U i false)) := PrototileConstruction.pairMem' q r + g T1 S hRinv pairMem i p + have realization0 : TileRealization T0 = + ⋃ i : Fin 3, ⋃ s : Bool, TileRealization (U i s) := + PrototileConstruction.realization0 q r g T1 S hcells0 + have hcentral0 : CentrallyReflectedAt p0 T0 T0 := + PrototileConstruction.hcentral0 q r g T1 S hRinv pairMem pairMem' realization0 + have gridCenter (x : GaussianInt) : + ((x.re : Real) + 1 / 2, (x.im : Real) + 1 / 2) ∈ + TileRealization T0 ↔ x ∈ T0.cells := PrototileConstruction.gridCenter n C + q r g T1 S reNe imNe minReCell maxReCell minImCell maxImCell x + let tau : GaussianInt → GaussianInt := fun x => t0 - x - 1 - I + have tau_invol (x : GaussianInt) : tau (tau x) = x := by + apply Zsqrtd.ext <;> simp [tau, I] <;> omega + have tau_center (x : GaussianInt) : + R ((x.re : Real) + 1 / 2, (x.im : Real) + 1 / 2) = + (((tau x).re : Real) + 1 / 2, ((tau x).im : Real) + 1 / 2) := + PrototileConstruction.tau_center q r g T1 reNe imNe ht0 x + have tau_cells (x : GaussianInt) (hx : x ∈ T0.cells) : + tau x ∈ T0.cells := PrototileConstruction.tau_cells q r g T1 S reNe imNe + hcentral0 gridCenter tau_center x hx + have hT0ne : T0.cells.Nonempty := PrototileConstruction.hT0neAt738 q r g T1 + hT1ne S hcells0 + have sumRe : T0.cells.sum (fun x => (x.re : Real)) = + T0.cells.sum (fun x => ((tau x).re : Real)) := PrototileConstruction.sumRe + q r g T1 S reNe imNe tau_invol tau_cells + have sumIm : T0.cells.sum (fun x => (x.im : Real)) = + T0.cells.sum (fun x => ((tau x).im : Real)) := PrototileConstruction.sumIm + q r g T1 S reNe imNe tau_invol tau_cells + have hre : ∀ x, ((tau x).re : Real) = + (t0.re : Real) - (x.re : Real) - 1 := PrototileConstruction.hre q r g T1 + reNe imNe + have him : ∀ x, ((tau x).im : Real) = + (t0.im : Real) - (x.im : Real) - 1 := PrototileConstruction.him q r g T1 + reNe imNe + have sRe : 2 * T0.cells.sum (fun x => (x.re : Real)) = + (T0.cells.card : Real) * (t0.re : Real) - T0.cells.card := + PrototileConstruction.sRe q r g T1 S reNe imNe sumRe hre + have sIm : 2 * T0.cells.sum (fun x => (x.im : Real)) = + (T0.cells.card : Real) * (t0.im : Real) - T0.cells.card := + PrototileConstruction.sIm q r g T1 S reNe imNe sumIm him + have hcentroid0 : TileCentroid T0 = + (((T0.cells.sum fun x => (x.re : Real)) / T0.cells.card) + 1 / 2, + ((T0.cells.sum fun x => (x.im : Real)) / T0.cells.card) + 1 / 2) := + PrototileConstruction.hcentroid0 q r g T1 S hT0ne + rw [hcentroid0] + apply Prod.ext + · have hh := congrArg Prod.fst ht0 + have hh' : (t0.re : Real) = 2 * p0.1 := by + simpa [GaussianRealPoint] using hh + have hp : p0.1 = (t0.re : Real) / 2 := by linarith + have hcard : (T0.cells.card : Real) ≠ 0 := by + exact_mod_cast (Finset.card_ne_zero.mpr hT0ne) + rw [hp] + field_simp [hcard] + nlinarith [sRe] + · have hh := congrArg Prod.snd ht0 + have hh' : (t0.im : Real) = 2 * p0.2 := by + simpa [GaussianRealPoint] using hh + have hp : p0.2 = (t0.im : Real) / 2 := by linarith + have hcard : (T0.cells.card : Real) ≠ 0 := by + exact_mod_cast (Finset.card_ne_zero.mpr hT0ne) + rw [hp] + field_simp [hcard] + nlinarith [sIm] + +end PrototileAssembly + +namespace PositivePrototileProof + +private theorem unitExists (C : BandCircle) (hcurvature : C.1.1.1 = 1) : + ∃ T : ProtoTile, BandPrototile C.1.1 T := by + obtain ⟨z, hz⟩ := CurvatureOneBandCircleClassification C hcurvature + refine ⟨⟨{0}, 0⟩, ?_⟩ + rw [hz] + exact BandPrototile.unit z 0 0 + +private theorem existence : + (by + classical + exact + (∀ (C : CircleCoordinates), ∀ (T : ProtoTile), (0 < C.1) → ((BandPrototile C T) → + (T.cells.Nonempty))) → (∀ n : Nat, ∀ C : BandCircle, C.1.1.1.toNat = n → ∃ T : + ProtoTile, BandPrototile C.1.1 T) ) := by + classical + intro positiveNonempty n + induction n using Nat.strong_induction_on with + | h n ih => + intro C hc + by_cases hone : n = 1 + · exact unitExists C (PrototileConstruction.hcurvAt165 n C hc hone) + · have hgt := PrototileConstruction.hgt n C hc hone + obtain hunit | ⟨q, hq, hchild, hless, _⟩ := BandGenealogy C + · have hcurvature : n = 1 := by simpa only [hunit, Int.toNat_one] using hc.symm + exact (hone hcurvature).elim + · have hroot : q 0 = C.1.1 := by simpa using hchild + have hproper : ProperBandQuadruple q := PrototileConstruction.hproper C q hq hless hroot + obtain ⟨r, g, regime⟩ := BandRegimeClassification q hproper + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + have hqbase : ProperBandQuadruple + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] := PrototileConstruction.hqbase q + hproper r g regime + have hq' : ProperBandQuadruple q' := + BandPackingSymmetryProperCovariance g _ hqbase + have normalized : ∃ T : ProtoTile, BandPrototile (q' 0) T := by + rcases regime with hford | hrest + · rcases hford with ⟨⟨P, hP, hEq⟩, _⟩ + have htile := (FordTileRecursiveIdentification P).1 + have hrootFord : q' 0 = FordCircleCoordinate P.p P.q := + PrototileConstruction.hrootFord q r g P hEq + exact ⟨FordTile P.q, hrootFord ▸ htile⟩ + · rcases hrest with hdiamond | hgeneral + · rcases hdiamond with ⟨⟨K, hK, hEq⟩, _⟩ + have htile := (DiamondTileRecursiveIdentification K).1 + refine ⟨DiamondTile K.1, ?_⟩ + simpa [q', hEq] using htile + · rcases hgeneral with ⟨cfg⟩ + rcases cfg with ⟨cfg⟩ + have hnonneg := (SemiProperForestClassification q' hq'.1).1 + have hpos1 : 0 < (q' 1).1 := PrototileConstruction.hpos1 q r g cfg hnonneg + have hlt1 : (q' 1).1.toNat < n := PrototileConstruction.hlt1 n C hc q hroot r g + hq' hnonneg + let C1 : BandCircle := ⟨ + ⟨q' 1, ⟨Or.inl hpos1, ⟨q', hq'.1, ⟨1, rfl⟩⟩⟩⟩, hpos1⟩ + obtain ⟨T1, hT1⟩ := ih (Int.toNat (q' 1).1) hlt1 C1 (by rfl) + have hT1' : BandPrototile (cfg.firstPredecessor 0) T1 := + PrototileConstruction.hT1' q r g hq' cfg hpos1 T1 hT1 + have hT1ne : T1.cells.Nonempty := by + apply positiveNonempty _ _ hpos1 hT1 + obtain ⟨S, hocc, hcells⟩ := BandPrototileReindexedDecomposition + cfg.firstPredecessor cfg.firstProper T1 hT1' + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + have hparents : ∀ i s, BandPrototile (q' i.succ) (U i s) := + PrototileConstruction.hparents q r g hq' cfg hpos1 T1 hT1 S hocc + let T0 : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ + have hcells0 (x : GaussianInt) : + x ∈ T0.cells ↔ ∃ i s, x ∈ (U i s).cells := PrototileConstruction.hcells0 q r + g T1 S x + have hfoot : ∀ i s, FootprintVertices (U i s) ⊆ FootprintVertices T0 := + PrototileConstruction.hfoot positiveNonempty q r g cfg hnonneg T1 hT1ne S + hparents hcells0 + let I : GaussianInt := ⟨0, 1⟩ + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + have pointNeg (z : GaussianInt) : + GaussianRealPoint (-z) = -GaussianRealPoint z := + PrototileConstruction.pointNeg z + have pointI (z : GaussianInt) : + GaussianRealPoint (I * z) = + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1) := + PrototileConstruction.pointI z + let v : GaussianInt := BandVectors.1 (q' 2) (q' 1) + have rRotateV : + BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0) = + BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1) - + I * BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 2) := PrototileConstruction.rRotateV q r g cfg + have hv21 : BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1) = v + I * a := PrototileConstruction.hv21 q r g + cfg rRotateV + have hv13 : BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3) = -v - (1 + I) * a := PrototileConstruction.hv13 q + r g cfg hv21 + have hq13 : BandVectors.1 (q' 1) (q' 3) = -a - v := PrototileConstruction.hq13 q + r g hq' + have dIdent1 : d (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3)) + GaussianRealPoint a - d a = + d (BandVectors.1 (q' 1) (q' 3)) := PrototileConstruction.dIdent1 q r g cfg + hv13 hq13 + have dIdent2 : -d (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3)) - GaussianRealPoint (I * a) - d a = + -d (BandVectors.1 (q' 1) (q' 3)) := PrototileConstruction.dIdent2 q r g cfg + hv13 hq13 + have dIdent3 : d (BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1)) - GaussianRealPoint (I * a) - d a = + d v := PrototileConstruction.dIdent3 q r g cfg hv21 + have dIdent4 : -d (BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1)) + GaussianRealPoint a - d a = + -d v := PrototileConstruction.dIdent4 q r g cfg hv21 + let p0 : Real × Real := TileCentroid T1 + d a + have hs1m : TileCentroid (S 1 false) - TileCentroid T1 = + -d (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3)) := PrototileConstruction.hs1m q r g cfg T1 S hocc + have hs1p : TileCentroid (S 1 true) - TileCentroid T1 = + d (BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3)) := PrototileConstruction.hs1p q r g cfg T1 S hocc + have hs2m : TileCentroid (S 2 false) - TileCentroid T1 = + -d (BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1)) := PrototileConstruction.hs2m q r g cfg T1 S hocc + have hs2p : TileCentroid (S 2 true) - TileCentroid T1 = + d (BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1)) := PrototileConstruction.hs2p q r g cfg T1 S hocc + have transCent (V : ProtoTile) (z : GaussianInt) : + TileCentroid (TileTranslation V z) = + TileCentroid V + GaussianRealPoint z := PrototileConstruction.transCent V z + have hcent' : ∀ i s, + TileCentroid (U i s) - p0 = + (if s = true then (1 : Real) else -1) • + d (BandVectors.1 (q' ((i + 2).succ)) + (q' ((i + 1).succ))) := PrototileConstruction.hcent' q r g cfg T1 S + pointNeg pointI dIdent1 dIdent2 dIdent3 dIdent4 hs1m hs1p hs2m hs2p + transCent + let c1 := TileCentroid T1 + let reCells : Finset Int := T1.cells.image (fun x => x.re) + let imCells : Finset Int := T1.cells.image (fun x => x.im) + have reNe : reCells.Nonempty := Finset.image_nonempty.mpr hT1ne + have imNe : imCells.Nonempty := Finset.image_nonempty.mpr hT1ne + have hcentral1 : CentrallyReflectedAt c1 T1 T1 := + BandPrototileCentralSymmetry (q' 1) T1 hT1 + have hboundRe : ∀ p ∈ TileRealization T1, + (↑(reCells.min' reNe) : Real) ≤ p.1 ∧ + p.1 ≤ (↑(reCells.max' reNe) : Real) + 1 := PrototileConstruction.hboundRe + T1 reNe + have reflect1 : ∀ p ∈ TileRealization T1, + (2 * c1.1 - p.1, 2 * c1.2 - p.2) ∈ TileRealization T1 := + PrototileConstruction.reflect1 T1 hcentral1 + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + have minReCell : ∃ x ∈ T1.cells, x.re = mRe := PrototileConstruction.minReCell T1 + reNe + have maxReCell : ∃ x ∈ T1.cells, x.re = MRe := PrototileConstruction.maxReCell T1 + reNe + have centerRe : 2 * c1.1 = (mRe : Real) + MRe + 1 := + PrototileConstruction.centerRe T1 reNe hboundRe reflect1 minReCell maxReCell + have hboundIm : ∀ p ∈ TileRealization T1, + (↑(imCells.min' imNe) : Real) ≤ p.2 ∧ + p.2 ≤ (↑(imCells.max' imNe) : Real) + 1 := PrototileConstruction.hboundIm + T1 imNe + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + have minImCell : ∃ x ∈ T1.cells, x.im = mIm := PrototileConstruction.minImCell T1 + imNe + have maxImCell : ∃ x ∈ T1.cells, x.im = MIm := PrototileConstruction.maxImCell T1 + imNe + have centerIm : 2 * c1.2 = (mIm : Real) + MIm + 1 := + PrototileConstruction.centerIm T1 imNe reflect1 hboundIm minImCell maxImCell + let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + have ht1 : GaussianRealPoint t1 = (2 * c1.1, 2 * c1.2) := + PrototileConstruction.ht1 T1 reNe imNe centerRe centerIm + have hrootCent : TileCentroid T0 = p0 := PrototileAssembly.hrootCent n C q r g T1 + hT1ne S hparents hcells0 hcent' reNe imNe minReCell maxReCell minImCell + maxImCell ht1 + have hcent : ∀ i s, + TileCentroid (U i s) - TileCentroid T0 = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q' ((i + 2).succ)) (q' ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q' ((i + 2).succ)) + (q' ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q' ((i + 2).succ)) + (q' ((i + 1).succ)))).1))) := PrototileConstruction.hcent q r g + T1 S hcent' hrootCent + exact ⟨T0, BandPrototile.decompose hq' hparents hcells0 hfoot hcent⟩ + obtain ⟨inverse, hinvC, _, _, _, hinvT, _, _, _, _, _, _⟩ := + BandPackingSymmetryInversePhaseCancellation.2 g + refine ⟨BandPackingSymmetryTileAction inverse normalized.choose, ?_⟩ + have hcov := (BandPackingSymmetryCovariance inverse).2.1 + have hresult := (hcov (q' 0) normalized.choose).mp normalized.choose_spec + have hq0 : BandPackingSymmetryCircleAction inverse (q' 0) = C.1.1 := + PrototileConstruction.hq0 C q hroot r g inverse hinvC + have hresult' : BandPrototile (C.1.1) + (BandPackingSymmetryTileAction inverse normalized.choose) := + PrototileConstruction.hresult' C q r g normalized inverse hresult hq0 + exact hresult' + +end PositivePrototileProof + +theorem BandPrototileExists : ∀ C : BandGeneralCircle, + ∃ T : ProtoTile, BandPrototile C.1 T := by +-- BODY + classical + have emptyCurv := PrototileConstruction.emptyCurv + have positiveNonempty (C : CircleCoordinates) (T : ProtoTile) + (hpos : 0 < C.1) (hT : BandPrototile C T) : T.cells.Nonempty := + PrototileConstruction.positiveNonempty emptyCurv C T hpos hT + have existence : ∀ n : Nat, ∀ C : BandCircle, + C.1.1.1.toNat = n → ∃ T : ProtoTile, BandPrototile C.1.1 T := + PositivePrototileProof.existence positiveNonempty + intro C + rcases C.2.1 with hpos | ⟨hz, hw⟩ + · let BC : BandCircle := ⟨C, hpos⟩ + obtain ⟨T, hT⟩ := existence BC.1.1.1.toNat BC (by rfl) + exact ⟨T, hT⟩ + · rcases hw with hw | hw + · have hcoord : C.1 = (0, 1) := Prod.ext hz hw + refine ⟨⟨∅, 0⟩, ?_⟩ + rw [hcoord] + exact BandPrototile.line 1 0 (Or.inl rfl) + · have hcoord : C.1 = (0, -1) := Prod.ext hz hw + refine ⟨⟨∅, 0⟩, ?_⟩ + rw [hcoord] + exact BandPrototile.line (-1) 0 (Or.inr rfl) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileFootprintSlopeCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileFootprintSlopeCovariance.lean new file mode 100644 index 0000000000..31f7f31a1f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileFootprintSlopeCovariance.lean @@ -0,0 +1,141 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPrototileCompleteSquareCentroid +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas + +-- [TABLET NODE: BandPrototileFootprintSlopeCovariance] + +/-! +# BandPrototileFootprintSlopeCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandPrototileFootprintSlopeCovariance + (g : BandPackingSymmetry) (C : CircleCoordinates) (T : ProtoTile) + (h : PartialOdometer) (hT : BandPrototile C T) + (hne : T.cells.Nonempty) + (hdom : (h.domain : Set GaussianInt) = FootprintVertices T) : + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = + (PartialOdometerSlope h).map + (BandPackingSymmetrySlopeAction g T) := by +-- BODY + have formulas := BandPackingSymmetryPartialOdometerActionFormulas g h h + have centroid := BandPrototileCompleteSquareCentroid C T h hT hne hdom + dsimp at centroid + let squares := PartialOdometerSquares h + let replacement : ProtoTile := ⟨squares, T.anchor⟩ + have replacement_nonempty : replacement.cells.Nonempty := by + simpa [replacement, squares] using centroid.1 + have squares_nonempty : squares.Nonempty := by + simpa [squares] using centroid.1 + have replacement_cells : PartialOdometerSquares h = replacement.cells := by + rfl + have centroid_action : ∀ k : BandPackingSymmetry, ∀ U V : ProtoTile, + TileCentroid U = TileCentroid V → + TileCentroid (BandPackingSymmetryTileAction k U) = + TileCentroid (BandPackingSymmetryTileAction k V) := by + intro k + induction k with + | identity => + intro U V huv + simpa [BandPackingSymmetryTileAction] using huv + | shift w => + intro U V huv + simpa [BandPackingSymmetryTileAction] using huv + | negate => + intro U V huv + rw [BandPackingSymmetryTileAction, BandPackingSymmetryTileAction, + (TileQuarterTurnFormulas U).2.2.2.2.1, + (TileQuarterTurnFormulas V).2.2.2.2.1, huv] + | conjugate => + intro U V huv + rw [BandPackingSymmetryTileAction, BandPackingSymmetryTileAction, + (TileQuarterTurnFormulas (TileQuarterTurn (TileReflection U))).2.2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn (TileReflection V))).2.2.2.2.1, + (TileQuarterTurnFormulas (TileReflection U)).2.2.2.2.1, + (TileQuarterTurnFormulas (TileReflection V)).2.2.2.2.1, + (TileReflectionFormulas U).2.2.2.2.1, + (TileReflectionFormulas V).2.2.2.2.1, huv] + | comp a b iha ihb => + intro U V huv + apply iha + apply ihb U V huv + have slope_action_centroid : ∀ k : BandPackingSymmetry, ∀ U V : ProtoTile, + TileCentroid U = TileCentroid V → ∀ p : ℝ × ℝ, + BandPackingSymmetrySlopeAction k U p = + BandPackingSymmetrySlopeAction k V p := by + intro k + induction k with + | identity => + intro U V huv p + rfl + | shift w => + intro U V huv p + simp [BandPackingSymmetrySlopeAction, huv] + | negate => + intro U V huv p + rfl + | conjugate => + intro U V huv p + rfl + | comp a b iha ihb => + intro U V huv p + rw [BandPackingSymmetrySlopeAction, BandPackingSymmetrySlopeAction] + rw [ihb U V huv p] + apply iha + exact centroid_action b U V huv + have action_eq : + BandPackingSymmetrySlopeAction g replacement = + BandPackingSymmetrySlopeAction g T := by + funext p + apply slope_action_centroid g replacement T + have hcent : TileCentroid replacement = TileCentroid T := by + simp only [TileCentroid, replacement, squares, ite_eq_left squares_nonempty, + ite_eq_left hne] + apply Prod.ext + · have hc := congrArg Prod.fst centroid.2 + simp only [TileCentroid, ite_eq_left hne] at hc + norm_num [Finset.sum_add_distrib] at hc ⊢ + have hnS : (squares.card : ℝ) ≠ 0 := by + exact_mod_cast (Nat.ne_of_gt (Finset.card_pos.mpr squares_nonempty)) + have hnT : (T.cells.card : ℝ) ≠ 0 := by + exact_mod_cast (Nat.ne_of_gt (Finset.card_pos.mpr hne)) + have hnS' : (PartialOdometerSquares h).card ≠ 0 := by + exact Nat.ne_of_gt (by simpa [squares] using Finset.card_pos.mpr squares_nonempty) + have hnT' : T.cells.card ≠ 0 := Nat.ne_of_gt (Finset.card_pos.mpr hne) + field_simp [hnS, hnT, hnS', hnT'] at hc ⊢ + linarith + · have hc := congrArg Prod.snd centroid.2 + simp only [TileCentroid, ite_eq_left hne] at hc + norm_num [Finset.sum_add_distrib] at hc ⊢ + have hnS : (squares.card : ℝ) ≠ 0 := by + exact_mod_cast (Nat.ne_of_gt (Finset.card_pos.mpr squares_nonempty)) + have hnT : (T.cells.card : ℝ) ≠ 0 := by + exact_mod_cast (Nat.ne_of_gt (Finset.card_pos.mpr hne)) + have hnS' : (PartialOdometerSquares h).card ≠ 0 := by + exact Nat.ne_of_gt (by simpa [squares] using Finset.card_pos.mpr squares_nonempty) + have hnT' : T.cells.card ≠ 0 := Nat.ne_of_gt (Finset.card_pos.mpr hne) + field_simp [hnS, hnT, hnS', hnT'] at hc ⊢ + linarith + exact hcent + have result := formulas.2.2.2.2.2.2.2 replacement replacement_nonempty + replacement_cells + simpa [action_eq] using result + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileReindexedDecomposition.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileReindexedDecomposition.lean new file mode 100644 index 0000000000..80c21401be --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileReindexedDecomposition.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision + +-- [TABLET NODE: BandPrototileReindexedDecomposition] + +/-! +# BandPrototileReindexedDecomposition + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandPrototileReindexedDecomposition (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) (T : ProtoTile) + (hT : BandPrototile (q 0) T) : + ∃ S : Fin 3 → Bool → ProtoTile, + (∀ i s, BandSubtileOccurrence q T i s (S i s)) ∧ + (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (S i s).cells) := by +-- BODY + have nonnegative : ∀ r : Fin 4 → CircleCoordinates, + SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 := by + intro r hr + induction hr with + | base z => intro k; fin_cases k <;> simp + | rotate hr ih => + intro k + fin_cases k <;> simp_all + | @successor r hr ih => + intro k + have cl := BandSuccessorClassification r hr + dsimp at cl + rcases cl with special | proper + · fin_cases k <;> simp_all + · rcases proper with ⟨_, h0, h2, h3⟩ + fin_cases k + · change 0 ≤ 2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1 + exact (ih 0).trans h0.le + · exact ih 0 + · exact ih 2 + · exact ih 3 + have noUnit : ∀ r : Fin 4 → CircleCoordinates, + SemiProperQuadruple r → (r 0).1 = 1 → ¬ ProperBandQuadruple r := by + intro r hr + induction hr with + | base z => + intro h hp + have bad := hp.2 0 + simp at h bad + | rotate hr ih => + intro h hp + apply ih h + refine ⟨hr, ?_⟩ + intro j + fin_cases j + · simpa using hp.2 2 + · simpa using hp.2 0 + · simpa using hp.2 1 + | @successor r hr ih => + intro h hp + have a := nonnegative r hr 0 + have b := nonnegative r hr 1 + have c := nonnegative r hr 2 + have d := nonnegative r hr 3 + have h1 := hp.2 0 + have h2 := hp.2 1 + have h3 := hp.2 2 + dsimp at h h1 h2 h3 + omega + let property : CircleCoordinates → ProtoTile → Prop := fun C U => + ∀ q, ProperBandQuadruple q → C = q 0 → + ∃ S : Fin 3 → Bool → ProtoTile, + (∀ i s, BandSubtileOccurrence q U i s (S i s)) ∧ + (∀ x, x ∈ U.cells ↔ ∃ i s, x ∈ (S i s).cells) + refine (BandPrototile.rec (motive := fun C U _ => property C U) + ?_ ?_ ?_ hT) q hq rfl + · intro w x hw q hq hC + have bad := hq.2 0 + have non := nonnegative q hq.1 1 + change (q (0 : Fin 3).succ).1 < (q 0).1 at bad + change 0 ≤ (q (0 : Fin 3).succ).1 at non + have zero : (q 0).1 = 0 := by + simpa using (congrArg (fun p : CircleCoordinates => p.1) hC).symm + rw [zero] at bad + omega + · intro z x anchor q hq hC + have one : (q 0).1 = 1 := by + have hp := congrArg (fun p : CircleCoordinates => p.1) hC + simpa using hp.symm + exact (noUnit q hq.1 one hq).elim + · intro q' hq' child parent hS hcells hfoot hcentroid ih q hq hC + obtain ⟨r, matchParents, unique⟩ := + BandPredecessorNoCollision q' q hq' hq hC + let reindexed : Fin 3 → Bool → ProtoTile := + fun i s => child (i + r) s + refine ⟨reindexed, ?_, ?_⟩ + · intro i s + refine ⟨?_, ?_, ?_⟩ + · have hp := hS (i + r) s + rw [← matchParents i] at hp + simpa [reindexed] using hp + · exact hfoot (i + r) s + · have hd := hcentroid (i + r) s + have hv : + BandVectors.1 (q' ((i + r + 2).succ)) + (q' ((i + r + 1).succ)) = + BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)) := by + rw [matchParents (i + 2), matchParents (i + 1)] + fin_cases i <;> fin_cases r <;> rfl + rw [hv] at hd + simpa [reindexed] using hd + · intro x + constructor + · intro hx + rcases (hcells x).1 hx with ⟨j, s, hj⟩ + refine ⟨j - r, s, ?_⟩ + simpa [reindexed] + · intro hx + rcases hx with ⟨i, s, hi⟩ + apply (hcells x).2 + refine ⟨i + r, s, ?_⟩ + simpa [reindexed] using hi + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileTranslation.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileTranslation.lean new file mode 100644 index 0000000000..bd885ffee2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileTranslation.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: BandPrototileTranslation] + +/-! +# BandPrototileTranslation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandPrototileTranslation : ∀ (C : CircleCoordinates) (T : ProtoTile) + (u : GaussianInt), + BandPrototile C T → BandPrototile C (TileTranslation T u) := by +-- BODY + intro C T u h + induction h generalizing u with + | line w x hw => + simp? [TileTranslation, GaussianTranslation] + exact BandPrototile.line w (x + u) hw + | unit z x anchor => + simp? [TileTranslation, GaussianTranslation] + exact BandPrototile.unit z (x + u) (anchor + u) + | @decompose q hq S T hS hcells hfoot hcentroid ih => + refine @BandPrototile.decompose q hq + (fun i s => TileTranslation (S i s) u) (TileTranslation T u) ?_ ?_ ?_ ?_ + · intro i s + exact ih i s u + · intro x + change x ∈ (T.cells.image (GaussianTranslation u)) ↔ + ∃ i s, x ∈ (TileTranslation (S i s) u).cells + constructor + · intro hx + have hx' : ∃ y ∈ T.cells, GaussianTranslation u y = x := by + simpa only [Finset.mem_image] using hx + rcases hx' with ⟨y, hy, rfl⟩ + rcases (hcells y).mp hy with ⟨i, s, hz⟩ + refine ⟨i, s, ?_⟩ + rw [(TileTranslationFormulas (S i s) u).1] + exact Finset.mem_image.mpr ⟨y, hz, rfl⟩ + · intro hx + rcases hx with ⟨i, s, hz⟩ + have hz' : ∃ y ∈ (S i s).cells, GaussianTranslation u y = x := by + simpa only [(TileTranslationFormulas (S i s) u).1, Finset.mem_image] using hz + rcases hz' with ⟨y, hy, rfl⟩ + exact Finset.mem_image.mpr ⟨y, (hcells y).mpr ⟨i, s, hy⟩, rfl⟩ + · intro i s x hx + rw [(TileTranslationFormulas (S i s) u).2.2.2.2.2.1, + (TileTranslationFormulas T u).2.2.2.2.2.1] at * + rcases hx with ⟨y, hy, rfl⟩ + exact ⟨y, hfoot i s hy, rfl⟩ + · intro i s + rw [(TileTranslationFormulas (S i s) u).2.2.2.2.1] + rw [(TileTranslationFormulas T u).2.2.2.2.1] + simpa [Prod.ext_iff, sub_eq_add_neg, add_assoc, add_comm, add_left_comm, + smul_add] using hcentroid i s + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean new file mode 100644 index 0000000000..7c3a110633 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean @@ -0,0 +1,294 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: BandPrototileTranslationNormalForm] + +/-! +# BandPrototileTranslationNormalForm + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TranslationNormalFormProof + +private theorem nonnegative : + ∀ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 := by + classical + intro r hr + induction hr with + | base z => intro k; fin_cases k <;> simp + | rotate hr ih => + intro k + fin_cases k <;> simp_all + | @successor r hr ih => + intro k + have classification := BandSuccessorClassification r hr + rcases classification with special | proper + · fin_cases k <;> simp_all + · rcases proper with ⟨_, h0, h2, h3⟩ + fin_cases k + · exact (ih 0).trans h0.le + · exact ih 0 + · exact ih 2 + · exact ih 3 + +private theorem noProperUnit : + (∀ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1) → (∀ r : + Fin 4 → CircleCoordinates, SemiProperQuadruple r → (r 0).1 = 1 → ¬ ProperBandQuadruple r) + := by + classical + intro nonnegative r hr + induction hr with + | base z => + intro h hp + have bad := hp.2 0 + simp at bad + | @rotate r hr ih => + intro h hp + apply ih h + refine ⟨hr, ?_⟩ + intro j + fin_cases j + · simpa using hp.2 2 + · simpa using hp.2 0 + · simpa using hp.2 1 + | @successor r hr ih => + intro h hp + have a := nonnegative r hr 0 + have b := nonnegative r hr 1 + have c := nonnegative r hr 2 + have d := nonnegative r hr 3 + have h1 := hp.2 0 + have h2 := hp.2 1 + have h3 := hp.2 2 + dsimp at h h1 h2 h3 + omega + +private theorem positiveChild : + (∀ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1) → (∀ r : + Fin 4 → CircleCoordinates, SemiProperQuadruple r → 0 < (r 0).1 → ∃ j : Fin 3, 0 < (r + j.succ).1) := by + classical + intro nonnegative r hr + induction hr with + | base z => + intro h + exact ⟨0, by simp⟩ + | @rotate r hr ih => + intro h + rcases ih h with ⟨j, hj⟩ + fin_cases j + · exact ⟨2, by simpa using hj⟩ + · exact ⟨0, by simpa using hj⟩ + · exact ⟨1, by simpa using hj⟩ + | @successor r hr ih => + intro h + have a := nonnegative r hr 0 + have b := nonnegative r hr 1 + have c := nonnegative r hr 2 + have d := nonnegative r hr 3 + by_contra hn + push Not at hn + have e := hn 0 + have f := hn 1 + have g := hn 2 + dsimp at h e f g + omega + +private theorem positiveCells : + (∀ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → 0 < (r 0).1 → ∃ j : Fin 3, 0 < (r + j.succ).1) → (∀ (C : CircleCoordinates), ∀ (P : ProtoTile), 0 < C.1 → BandPrototile C P → + P.cells.Nonempty) := by + classical + intro positiveChild C P hC hP + induction hP with + | line w x hw => + simp at hC + | unit z x anchor => + simp + | @decompose q hq S V hS hcells hfoot hcentroid ih => + rcases positiveChild q hq.1 (by simpa using hC) with ⟨j, hj⟩ + have hp := ih j false hj + rcases hp with ⟨a, ha⟩ + exact ⟨a, (hcells a).mpr ⟨j, false, ha⟩⟩ + +private theorem vectorMatch : + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (q' : Fin + (4 : ℕ) → CircleCoordinates), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (r : Fin (3 : + ℕ)), (∀ (j : Fin (3 : ℕ)), q' j.succ = q (j + r).succ) → ((∀ (y : Fin (3 : ℕ)), (fun (r : + Fin (3 : ℕ)) => ∀ (j : Fin (3 : ℕ)), q' j.succ = q (j + r).succ) y → y = r) → (∀ (k : Fin + (3 : ℕ)), ((0 : ℤ) < (q k.succ).1) → ( + let i : Fin 3 := k - r + (q' i.succ = q k.succ) → (∀ (u : GaussianInt), ((S k true).cells = (TileTranslation (S' i + true) u).cells) → (((S k true).cells = ∅ → (S k true).anchor = (TileTranslation (S' i + true) u).anchor) → (((S k true).cells.Nonempty) → (((TileTranslation (S' i true) + u).cells.Nonempty) → ((TileCentroid (S k true) = TileCentroid (TileTranslation (S' i + true) u)) → (BandVectors.1 (q' ((i + 2).succ)) (q' ((i + 1).succ)) = BandVectors.1 (q ((k + + 2).succ)) (q ((k + 1).succ))))))))))) := by + classical + intro q S q' S' r hrotation hunique k hk i hi u hcellsParent hemptyParent nonemptyParent + translatedNonempty parentCentroid + have idxA : (i + 2 + r : Fin 3) = k + 2 := by + fin_cases k <;> fin_cases r <;> simp [i] + have idxB : (i + 1 + r : Fin 3) = k + 1 := by + fin_cases k <;> fin_cases r <;> simp [i] + have ha := hrotation (i + 2) + have hb := hrotation (i + 1) + rw [idxA] at ha + rw [idxB] at hb + rw [ha, hb] + +private theorem childCentroid : + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (V : ProtoTile), ∀ (S' : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (W : ProtoTile), ∀ (r : Fin (3 : ℕ)), ∀ (k : Fin (3 : ℕ)), + let i : Fin 3 := k - r + ∀ (u : GaussianInt), (TileCentroid (S k true) = TileCentroid (TileTranslation (S' i true) u)) + → ((TileCentroid (S k true) - TileCentroid V = TileCentroid (S' i true) - TileCentroid W) + → (TileCentroid V = TileCentroid (TileTranslation W u))) := by + classical + intro S V S' W r k i u parentCentroid differenceMatch + rw [(TileTranslationFormulas W u).2.2.2.2.1] + apply Prod.ext + · have hp := congrArg Prod.fst parentCentroid + have hd := congrArg Prod.fst differenceMatch + rw [(TileTranslationFormulas (S' i true) u).2.2.2.2.1] at hp + dsimp at hp hd ⊢ + linarith + · have hp := congrArg Prod.snd parentCentroid + have hd := congrArg Prod.snd differenceMatch + rw [(TileTranslationFormulas (S' i true) u).2.2.2.2.1] at hp + dsimp at hp hd ⊢ + linarith + +end TranslationNormalFormProof + +theorem BandPrototileTranslationNormalForm (C : CircleCoordinates) + (T U : ProtoTile) (hT : BandPrototile C T) (hU : BandPrototile C U) : + ∃ u : GaussianInt, + T.cells = (TileTranslation U u).cells ∧ + (T.cells = ∅ → T.anchor = (TileTranslation U u).anchor) := by +-- BODY + have nonnegative : ∀ r : Fin 4 → CircleCoordinates, + SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 := TranslationNormalFormProof.nonnegative + have noProperUnit : ∀ r : Fin 4 → CircleCoordinates, + SemiProperQuadruple r → (r 0).1 = 1 → ¬ ProperBandQuadruple r := + TranslationNormalFormProof.noProperUnit nonnegative + have positiveChild : ∀ r : Fin 4 → CircleCoordinates, + SemiProperQuadruple r → 0 < (r 0).1 → + ∃ j : Fin 3, 0 < (r j.succ).1 := TranslationNormalFormProof.positiveChild nonnegative + have positiveCells : ∀ (C : CircleCoordinates) (P : ProtoTile), + 0 < C.1 → BandPrototile C P → P.cells.Nonempty := TranslationNormalFormProof.positiveCells + positiveChild + refine BandPrototile.rec (motive := fun C T _ => + ∀ U, BandPrototile C U → + ∃ u : GaussianInt, T.cells = (TileTranslation U u).cells ∧ + (T.cells = ∅ → T.anchor = (TileTranslation U u).anchor)) ?_ ?_ ?_ hT U hU + · intro w x hw U hU + refine BandPrototile.rec (motive := fun C U _ => + C = (0, w) → ∃ u : GaussianInt, ({cells := ∅, anchor := x} : ProtoTile).cells = + (TileTranslation U u).cells ∧ + (({cells := ∅, anchor := x} : ProtoTile).cells = ∅ → + ({cells := ∅, anchor := x} : ProtoTile).anchor = (TileTranslation U u).anchor)) + ?_ ?_ ?_ hU rfl + · intro w' y hw' hC + refine ⟨x - y, ?_, ?_⟩ <;> simp [TileTranslation, GaussianTranslation] + · intro z' y anchor hC + simp at hC + · intro q' hq' S' V' hS' hcells' hfoot' hcentroid' ih' hC + have hbad := hq'.2 0 + have hnon := nonnegative q' hq'.1 1 + have hnon' : 0 ≤ (q' 1).1 := by simpa using hnon + rw [hC] at hbad + have hbad' : (q' 1).1 < 0 := by simpa using hbad + have : False := by omega + exact this.elim + · intro z x anchor U hU + refine BandPrototile.rec (motive := fun C U _ => + C = (1, 1 + 2*z) → ∃ u : GaussianInt, ({cells := {x}, anchor := anchor} : ProtoTile).cells = + (TileTranslation U u).cells ∧ + (({cells := {x}, anchor := anchor} : ProtoTile).cells = ∅ → + ({cells := {x}, anchor := anchor} : ProtoTile).anchor = (TileTranslation U u).anchor)) + ?_ ?_ ?_ hU rfl + · intro w' y hw' hC + have hz := congrArg (fun p : CircleCoordinates => p.1) hC + simp at hz + · intro z' y anchor' hC + refine ⟨x-y, ?_, ?_⟩ <;> simp [TileTranslation, GaussianTranslation] + · intro q' hq' S' V' hS' hcells' hfoot' hcentroid' ih' hC + exact (noProperUnit q' hq'.1 + (by simpa using congrArg (fun p : CircleCoordinates => p.1) hC) hq').elim + · intro q hq S V hS hcells hfoot hcentroid ih U hU + have qpos : 0 < (q 0).1 := + lt_of_le_of_lt (nonnegative q hq.1 1) (hq.2 0) + refine BandPrototile.rec (motive := fun C U _ => + q 0 = C → ∃ u : GaussianInt, V.cells = (TileTranslation U u).cells ∧ + (V.cells = ∅ → V.anchor = (TileTranslation U u).anchor)) + ?_ ?_ ?_ hU rfl + · intro w y hw hC + have bad : (q 0).1 = 0 := by simpa using congrArg (fun p : CircleCoordinates => p.1) hC + omega + · intro z y anchor hC + have hone : (q 0).1 = 1 := by + simpa using congrArg (fun p : CircleCoordinates => p.1) hC + exact (noProperUnit q hq.1 hone hq).elim + · intro q' hq' S' W hS' hcells' hfoot' hcentroid' ih' hC + have rotation := BandPredecessorNoCollision q q' hq hq' hC + rcases rotation with ⟨r, hrotation, hunique⟩ + rcases positiveChild q hq.1 qpos with ⟨k, hk⟩ + let i : Fin 3 := k - r + have hi : q' i.succ = q k.succ := by + have hm := hrotation i + convert hm using 1 + fin_cases k <;> fin_cases r <;> simp [i] + have parent := ih k true (S' i true) (by simpa [hi] using hS' i true) + rcases parent with ⟨u, hcellsParent, hemptyParent⟩ + have nonemptyParent : (S k true).cells.Nonempty := + positiveCells (q k.succ) (S k true) hk (hS k true) + have translatedNonempty : (TileTranslation (S' i true) u).cells.Nonempty := by + rw [← hcellsParent] + exact nonemptyParent + have parentCentroid : + TileCentroid (S k true) = + TileCentroid (TileTranslation (S' i true) u) := by + rw [TileCentroid, TileCentroid] + simp [hcellsParent, translatedNonempty] + have vectorMatch : + BandVectors.1 (q' ((i + 2).succ)) (q' ((i + 1).succ)) = + BandVectors.1 (q ((k + 2).succ)) (q ((k + 1).succ)) := + TranslationNormalFormProof.vectorMatch q S q' S' r hrotation hunique k hk hi u + hcellsParent hemptyParent nonemptyParent translatedNonempty parentCentroid + have differenceMatch : + TileCentroid (S k true) - TileCentroid V = + TileCentroid (S' i true) - TileCentroid W := by + rw [hcentroid k true, hcentroid' i true, vectorMatch] + have childCentroid : + TileCentroid V = TileCentroid (TileTranslation W u) := + TranslationNormalFormProof.childCentroid S V S' W r k u parentCentroid differenceMatch + have translated : BandPrototile (q 0) (TileTranslation W u) := + BandPrototileTranslation (q 0) W u (by + have hw : BandPrototile (q' 0) W := + @BandPrototile.decompose q' hq' S' W hS' hcells' hfoot' hcentroid' + simpa [hC] using hw) + have unique := BandPrototileCentroidUnique (q 0) V + (TileTranslation W u) (BandPrototile.decompose hq hS hcells hfoot hcentroid) + translated childCentroid + exact ⟨u, unique.1, unique.2⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandRegimeClassification.lean b/LeanPool/ApollonianSuperharmonic/BandRegimeClassification.lean new file mode 100644 index 0000000000..8f338b336f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandRegimeClassification.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandRetainedBoundaryGenealogy +public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.DiamondRegimeConverse +public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse + +-- [TABLET NODE: BandRegimeClassification] + +/-! +# BandRegimeClassification + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandRegimeClassification (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) : + ∃ (r : Fin 3) (g : BandPackingSymmetry), + let q' := BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + Xor + (∃ P : FordFareyParameter, + 1 < P.q ∧ q' = FordRecursiveQuadruple P) + (Xor + (∃ K : DiamondParameter, + 1 < K.1 ∧ q' = DiamondRecursiveQuadruple K) + (Nonempty (BandOrderedGeneralConfiguration q'))) := by +-- BODY + classical + by_cases hline : ∃ i : Fin 4, (q i).1 = 0 + · obtain ⟨r, g, P, hFord⟩ := FordRegimeConverse q hq hline + have hP := hFord.1 + have heq := hFord.2.2.2.2 + refine ⟨r, g, ?_⟩ + dsimp + apply Or.inl + refine ⟨⟨P, hP, heq⟩, ?_⟩ + intro hright + rcases hright with hdiamond | hgeneral + · rcases hdiamond with ⟨⟨K, hK, hdiamond⟩, hnot⟩ + have hz : + (BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] 3).1 = 0 := by + rw [heq] + simp [FordRecursiveQuadruple] + rw [hdiamond] at hz + simp [DiamondRecursiveQuadruple] at hz + omega + · rcases hgeneral with ⟨hconfig, hnot⟩ + rcases hconfig with ⟨configuration⟩ + apply configuration.noLine 3 + rw [heq] + simp [FordRecursiveQuadruple] + · have hnoLine : ∀ i : Fin 4, (q i).1 ≠ 0 := by + intro i hi + exact hline ⟨i, hi⟩ + by_cases htwoUnits : ∃ i j : Fin 4, + i ≠ j ∧ (q i).1 = 1 ∧ (q j).1 = 1 + · obtain ⟨r, g, K, hK, _, _, heq⟩ := + DiamondRegimeConverse q hq hnoLine htwoUnits + refine ⟨r, g, ?_⟩ + dsimp + apply Or.inr + refine ⟨?_, ?_⟩ + · apply Or.inl + refine ⟨⟨K, hK, heq⟩, ?_⟩ + intro hgeneral + rcases hgeneral with ⟨configuration⟩ + have hfirst : + (BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] 1).1 = 1 := by + rw [heq] + simp [DiamondRecursiveQuadruple] + have hsecond : + (BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] 2).1 = 1 := by + rw [heq] + simp [DiamondRecursiveQuadruple] + have indices := configuration.atMostOneUnit 1 2 hfirst hsecond + omega + · intro hford + rcases hford with ⟨P, hP, hford⟩ + have hz : + (BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] 3).1 = 0 := by + simp [hford, FordRecursiveQuadruple] + rw [heq] at hz + simp [DiamondRecursiveQuadruple] at hz + omega + · have hatMostOneUnit : ∀ i j : Fin 4, + (q i).1 = 1 → (q j).1 = 1 → i = j := by + intro i j hi hj + apply Classical.byContradiction + intro hne + exact htwoUnits ⟨i, j, hne, hi, hj⟩ + obtain ⟨r, g, hgeneral⟩ := + BandRetainedBoundaryGenealogy q hq hnoLine hatMostOneUnit + refine ⟨r, g, ?_⟩ + dsimp + apply Or.inr + refine ⟨?_, ?_⟩ + · apply Or.inr + refine ⟨hgeneral, ?_⟩ + intro hdiamond + rcases hgeneral with ⟨configuration⟩ + rcases hdiamond with ⟨K, hK, heq⟩ + have hfirst : + (BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] 1).1 = 1 := by + rw [heq] + simp [DiamondRecursiveQuadruple] + have hsecond : + (BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] 2).1 = 1 := by + rw [heq] + simp [DiamondRecursiveQuadruple] + have indices := configuration.atMostOneUnit 1 2 hfirst hsecond + omega + · intro hford + rcases hgeneral with ⟨configuration⟩ + rcases hford with ⟨P, hP, heq⟩ + apply configuration.noLine 3 + rw [heq] + simp [FordRecursiveQuadruple] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandRegularTileTouchingClassification.lean b/LeanPool/ApollonianSuperharmonic/BandRegularTileTouchingClassification.lean new file mode 100644 index 0000000000..cfee99fcc0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandRegularTileTouchingClassification.lean @@ -0,0 +1,217 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.RegularTileFamilyTranslationUnique +public import LeanPool.ApollonianSuperharmonic.TileBordering +public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance + +-- [TABLET NODE: BandRegularTileTouchingClassification] + +/-! +# BandRegularTileTouchingClassification + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandRegularTileTouchingClassification (C : BandCircle) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hqC : q 0 = C.1.1) (T : ProtoTile) (hT : BandPrototile (q 0) T) + (U V : ProtoTile) (hU : U ∈ RegularTileFamily T (TilingLattice C)) + (hV : V ∈ RegularTileFamily T (TilingLattice C)) : + TileTouching U V ↔ + ∃ j : Fin 3, + TileCentroid V - TileCentroid U = + GaussianRealPoint (BandVectors.1 (q j.succ) (q 0)) ∨ + TileCentroid V - TileCentroid U = + -GaussianRealPoint (BandVectors.1 (q j.succ) (q 0)) := by +-- BODY + have boundaryEdge_mem_footprintEdges (S : ProtoTile) + (e : Finset GaussianInt) (he : e ∈ BoundaryFootprintEdges S) : + e ∈ FootprintEdges S := by + rcases he with ⟨z, ⟨rfl, hz⟩ | ⟨rfl, hz⟩⟩ + · rcases hz with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · exact ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr (by + ext; simp [Zsqrtd.ext_iff])))⟩ + · rcases hz with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · exact ⟨z - 1, hz, Or.inr (Or.inr (Or.inl (by + ext; simp [Zsqrtd.ext_iff])))⟩ + have centroid_difference (x y : GaussianInt) : + TileCentroid (TileTranslation T y) - + TileCentroid (TileTranslation T x) = + GaussianRealPoint (y - x) := by + rw [(TileTranslationFormulas T y).2.2.2.2.1, + (TileTranslationFormulas T x).2.2.2.2.1] + ext <;> simp [GaussianRealPoint] + have realPoint_injective : Function.Injective GaussianRealPoint := by + intro x y hxy + apply Zsqrtd.ext + · have h := congrArg Prod.fst hxy + dsimp [GaussianRealPoint] at h + exact_mod_cast h + · have h := congrArg Prod.snd hxy + dsimp [GaussianRealPoint] at h + exact_mod_cast h + have translate_add (x y : GaussianInt) : + TileTranslation (TileTranslation T x) y = TileTranslation T (x + y) := by + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · ext z + simp [TileTranslation, GaussianTranslation, add_comm, + add_left_comm] + · simp [TileTranslation, GaussianTranslation, add_comm, + add_left_comm] + have translate_zero : TileTranslation T 0 = T := by + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · ext z + simp [GaussianTranslation] + · simp [GaussianTranslation] + have touching_symm (A B : ProtoTile) : TileTouching A B → TileTouching B A := by + rintro (h | h | h) + · exact Or.inl ⟨h.2.1, h.1, h.2.2.1.symm, by + simpa [Set.inter_comm] using h.2.2.2⟩ + · exact Or.inr (Or.inr h) + · exact Or.inr (Or.inl h) + have hpositive : 0 < (q 0).1 := (ProperBandCurvatureStructure q hq).1 + have harea := (BandTileSimultaneousInduction q hq T hT).2.1 + have hTnonempty : T.cells.Nonempty := by + rw [Finset.nonempty_iff_ne_empty] + intro hempty + have : TileArea T = 0 := by simp [TileArea, hempty] + rw [harea] at this + have : 0 < Int.toNat (q 0).1 := by omega + omega + have translate_nonempty (x : GaussianInt) : + (TileTranslation T x).cells.Nonempty := by + rw [Finset.nonempty_iff_ne_empty] + intro hempty + exact hTnonempty.ne_empty ((TileTranslationFormulas T x).2.2.1.mp hempty) + obtain ⟨a, ha, _⟩ := RegularTileFamilyTranslationUnique T + (TilingLattice C) U hU + obtain ⟨b, hb, _⟩ := RegularTileFamilyTranslationUnique T + (TilingLattice C) V hV + rw [ha, hb] + constructor + · intro htouch + have hborder : TileBordering (TileTranslation T a) (TileTranslation T b) := by + rcases htouch with h | h | h + · refine ⟨h.2.2.1, ?_⟩ + rcases h.2.2.2 with ⟨p, hp_nodup, hp_length, hp_vertices, hp_steps, + hp_edges⟩ + cases p with + | nil => simp at hp_length + | cons x p => + cases p with + | nil => simp at hp_length + | cons y p => + refine ⟨{x, y}, ?_⟩ + rw [hp_edges] + exact ⟨x, y, [], p, by simp⟩ + · exact False.elim ((translate_nonempty a).ne_empty h.1) + · exact False.elim ((translate_nonempty b).ne_empty h.1) + have hab : a ≠ b := by + intro hab + subst b + have hempty : (TileTranslation T (a : GaussianInt)).cells = ∅ := + (Finset.disjoint_self_iff_empty _).mp hborder.1 + exact (translate_nonempty a).ne_empty hempty + obtain ⟨P, _, htile, hadj, _, _, _, _, _⟩ := + BandRegularTranslatePeriodicComplex C q hq hqC T hT + have hpAdjacent : P.plane.adjacent a b := by + apply ((PeriodicTileIntersectionClassification P).1 a b hab).1.mp + rcases hborder.2 with ⟨e, hea, heb⟩ + rw [htile a, htile b] + exact ⟨e, boundaryEdge_mem_footprintEdges _ _ hea, + boundaryEdge_mem_footprintEdges _ _ heb⟩ + rcases (hadj a b).mp hpAdjacent with ⟨j, hj | hj⟩ + · exact ⟨j, Or.inl (centroid_difference a b |>.trans (by rw [hj]))⟩ + · exact ⟨j, Or.inr (centroid_difference a b |>.trans (by + rw [hj] + ext <;> simp [GaussianRealPoint]))⟩ + · rintro ⟨j, hcentroid | hcentroid⟩ + · have hreal : GaussianRealPoint ((b : GaussianInt) - a) = + GaussianRealPoint (BandVectors.1 (q j.succ) (q 0)) := by + rw [← centroid_difference a b] + exact hcentroid + have hdiff : (b : GaussianInt) - a = + BandVectors.1 (q j.succ) (q 0) := realPoint_injective hreal + have hcurvature : 1 < (q 0).1 := by + have hs := ProperBandCurvatureStructure q hq + by_contra hn + have hzero : ∀ k : Fin 3, (q k.succ).1 = 0 := by + intro k + have hnonnegative := hs.2.1 k + have hsmaller := hq.2 k + omega + have heq := hs.2.2 (0 : Fin 3) (1 : Fin 3) (hzero 0) (hzero 1) + norm_num at heq + have hbase : TileTouching T + (TileTranslation T (BandVectors.1 (q j.succ) (q 0))) := + ((BandTileSimultaneousInduction q hq T hT).2.2.2.2.1 + hcurvature j).1 + have htranslated := + ((TileTouchingCovariance T + (TileTranslation T (BandVectors.1 (q j.succ) (q 0))) a).1).mp hbase + have hb : BandVectors.1 (q j.succ) (q 0) + (a : GaussianInt) = b := by + rw [← hdiff] + abel + simpa [translate_add, hb] using htranslated + · have hnegative : + -GaussianRealPoint (BandVectors.1 (q j.succ) (q 0)) = + GaussianRealPoint (-BandVectors.1 (q j.succ) (q 0)) := by + ext <;> simp [GaussianRealPoint] + have hreal : GaussianRealPoint ((b : GaussianInt) - a) = + GaussianRealPoint (-BandVectors.1 (q j.succ) (q 0)) := by + rw [← centroid_difference a b, ← hnegative] + exact hcentroid + have hdiff : (b : GaussianInt) - a = + -BandVectors.1 (q j.succ) (q 0) := realPoint_injective hreal + have hcurvature : 1 < (q 0).1 := by + have hs := ProperBandCurvatureStructure q hq + by_contra hn + have hzero : ∀ k : Fin 3, (q k.succ).1 = 0 := by + intro k + have hnonnegative := hs.2.1 k + have hsmaller := hq.2 k + omega + have heq := hs.2.2 (0 : Fin 3) (1 : Fin 3) (hzero 0) (hzero 1) + norm_num at heq + have hbase : TileTouching T + (TileTranslation T (BandVectors.1 (q j.succ) (q 0))) := + ((BandTileSimultaneousInduction q hq T hT).2.2.2.2.1 + hcurvature j).1 + have hback := + ((TileTouchingCovariance T + (TileTranslation T (BandVectors.1 (q j.succ) (q 0))) + (-BandVectors.1 (q j.succ) (q 0))).1).mp hbase + have hnegativeBase : TileTouching T + (TileTranslation T (-BandVectors.1 (q j.succ) (q 0))) := by + apply touching_symm + simpa [translate_add, translate_zero] using hback + have htranslated := + ((TileTouchingCovariance T + (TileTranslation T (-BandVectors.1 (q j.succ) (q 0))) a).1).mp + hnegativeBase + have hb : -BandVectors.1 (q j.succ) (q 0) + (a : GaussianInt) = b := by + rw [← hdiff] + abel + simpa [translate_add, hb] using htranslated + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean b/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean new file mode 100644 index 0000000000..de3cd8ecaa --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean @@ -0,0 +1,767 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AffineTriangularPlaneTriangulation +public import LeanPool.ApollonianSuperharmonic.AffineTriangularComplexChart +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis +public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.P4812T1LatticeCoordinates +public import LeanPool.ApollonianSuperharmonic.P4812T1AffineTransport +public import LeanPool.ApollonianSuperharmonic.P4812T1ReflectedTouching +public import LeanPool.ApollonianSuperharmonic.P4812T1RegularFaceWalks +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance + +-- [TABLET NODE: BandRegularTranslatePeriodicComplex] + +/-! +# BandRegularTranslatePeriodicComplex + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RegularPeriodicGeometry + +private theorem arcs : + (by + classical + exact + ∀ (G : PlaneTriangulation (ℤ × ℤ)), (∀ (x : ℤ × ℤ), G.position x = ((↑x.1 : ℝ) - (↑x.2 : + ℝ) / (2 : ℝ), (↑x.2 : ℝ))) → ((∀ (x : ℤ × ℤ), ∀ (y : ℤ × ℤ), G.edgeArc x y = segment + ℝ (G.position x) (G.position y)) → ( + let phi (x : Int × Int) : Real × Real := + (((x.1 : Real) - (x.2 : Real) / 2), (x.2 : Real)) + (∀ (x : Int × Int), ∀ (y : Int × Int), phi (x + y) = phi x + phi y) → (∀ (z : Int × Int), + ∀ (x : Int × Int), ∀ (y : Int × Int), G.edgeArc (z + x) (z + y) = (fun p => p + phi + z) '' G.edgeArc x y))) ) := by + classical + intro G hpos harc phi phi_add z x y + simp only [harc, hpos] + change segment Real (phi (z + x)) (phi (z + y)) = + (fun p => p + phi z) '' segment Real (phi x) (phi y) + rw [phi_add, phi_add] + simpa only [add_comm] using (segment_translate_image Real (phi z) (phi x) (phi y)).symm + +private theorem regions : + (by + classical + exact + ∀ (G : PlaneTriangulation (ℤ × ℤ)), ∀ (up : ℤ × ℤ → G.Face), ∀ (down : ℤ × ℤ → G.Face), + (∀ (x : ℤ × ℤ), G.faceRegion (up x) = (fun (p : ℝ × ℝ) => ((↑x.1 : ℝ) + p.1 - ((↑x.2 + : ℝ) - p.2) / (2 : ℝ), (↑x.2 : ℝ) - p.2)) '' {p : ℝ × ℝ | (0 : ℝ) < p.1 ∧ (0 : ℝ) < + p.2 ∧ p.1 + p.2 < (1 : ℝ)}) → ((∀ (x : ℤ × ℤ), G.faceRegion (down x) = (fun (p : ℝ × + ℝ) => ((↑x.1 : ℝ) - p.1 - ((↑x.2 : ℝ) + p.2) / (2 : ℝ), (↑x.2 : ℝ) + p.2)) '' {p : ℝ + × ℝ | (0 : ℝ) < p.1 ∧ (0 : ℝ) < p.2 ∧ p.1 + p.2 < (1 : ℝ)}) → ( + let phi (x : Int × Int) : Real × Real := + (((x.1 : Real) - (x.2 : Real) / 2), (x.2 : Real)) + ∀ (z : Int × Int), ∀ (x : Int × Int), G.faceRegion (up (z + x)) = (fun p => p + phi z) '' + G.faceRegion (up x) ∧ G.faceRegion (down (z + x)) = (fun p => p + phi z) '' + G.faceRegion (down x))) ) := by + classical + intro G up down hru hrd phi z x + constructor + · rw [hru, hru, Set.image_image] + congr 1 + funext p + ext <;> simp [phi] <;> ring + · rw [hrd, hrd, Set.image_image] + congr 1 + funext p + ext <;> simp [phi] <;> ring + +private theorem H_add : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (H : ℝ × ℝ ≃ₜ ℝ × ℝ), (∀ (p : ℝ × ℝ), (H : ℝ × ℝ → ℝ + × ℝ) p = (p.1 + p.2 / (2 : ℝ)) • GaussianRealPoint (BandVectors.1 (q (1 : Fin (4 : + ℕ))) (q (0 : Fin (4 : ℕ)))) + p.2 • GaussianRealPoint (BandVectors.1 (q (2 : Fin (4 : + ℕ))) (q (0 : Fin (4 : ℕ))))) → (∀ (p : Real × Real), ∀ (r : Real × Real), H (p + r) = + H p + H r) ) := by + classical + intro q H hH p r + simp only [hH] + ext <;> simp [Prod.smul_fst, Prod.smul_snd, smul_eq_mul] <;> ring + +private theorem H_coord : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (k : ℤ × ℤ ≃+ ↥(TilingLattice + C)), (∀ (x : ℤ × ℤ), (↑((k : ℤ × ℤ → ↥(TilingLattice C)) x) : GaussianInt) = (↑x.1 : + GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑x.2 : + GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))) → (∀ (H : ℝ + × ℝ ≃ₜ ℝ × ℝ), (∀ (p : ℝ × ℝ), (H : ℝ × ℝ → ℝ × ℝ) p = (p.1 + p.2 / (2 : ℝ)) • + GaussianRealPoint (BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))) + p.2 • + GaussianRealPoint (BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))))) → ( + let phi (x : Int × Int) : Real × Real := + (((x.1 : Real) - (x.2 : Real) / 2), (x.2 : Real)) + ∀ (x : Int × Int), H (phi x) = GaussianRealPoint (k x : GaussianInt))) ) := by + classical + intro C q k hk H hH phi x + rw [hH, hk] + ext <;> simp [phi, GaussianRealPoint, + smul_eq_mul] + +private theorem hc1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (((0 : ℤ) < (q (0 : Fin (4 : + ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (j : + Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) → (1 < (q + 0).1)) ) := by + classical + intro q hq hc + by_contra hn + have hz (i : Fin 3) : (q i.succ).1 = 0 := by + have := hq.2 i + have := hc.2.1 i + omega + have he := hc.2.2 0 1 (hz 0) (hz 1) + norm_num at he + +private theorem hne : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), (1 < (q 0).1) → ((LatticeTile T ∧ + TileArea T = (q (0 : Fin (4 : ℕ))).1.toNat ∧ (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : + LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → ∀ (i + : Fin (3 : ℕ)), ∀ (s : Bool), LatticeTile (TileCellComplement T (S i s)) ∧ + TileTouching (TileCellComplement T (S i s)) (S i s)) ∧ QuarterTurnSymmetric T ∧ ((1 : + ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), TouchingTriple T (TileTranslation + T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation T + (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) ∧ ((1 : ℤ) + < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile (q + i.succ) U → TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 + (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple T (TileTranslation T + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (U : + ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → BandPrototile (q (i + (1 + : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V + - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin + (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin + (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple T U V) ∧ ∀ (r : Fin (4 + : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin + (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : + Fin (4 : ℕ)) → (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → (q (3 : Fin (4 : + ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → ∀ (P : Fin (3 + : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) + → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i + s (P i s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ + (P i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : + Fin (3 : ℕ)) true) i s (Q i s)) → (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) + true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (Q i s).cells) → (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : Fin (3 : ℕ)) false) i s (S i s)) → + (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s + : Bool), x ∈ (S i s).cells) → + let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); (∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty → AllowedSubtileIncidence a b) ∧ + (¬AllowedSubtileIncidence a b → FootprintVertices (SubtileOccurrenceInterpretation P + u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ FootprintVertices (P (0 : + Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ⊆ FootprintVertices + (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ + FootprintVertices (P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (0 : Fin (3 : ℕ)) + false) ⊆ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin + (3 : ℕ)) false) ∪ FootprintVertices (Q (0 : Fin (3 : ℕ)) false) ∪ FootprintVertices + (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → + (T.cells.Nonempty)) ) := by + classical + intro q T hc1 hgeom + apply Finset.card_pos.mp + have harea : T.cells.card = Int.toNat (q 0).1 := hgeom.2.1 + omega + +private theorem htu : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (k : ℤ × ℤ ≃+ + ↥(TilingLattice C)), (1 < (q 0).1) → ((LatticeTile T ∧ TileArea T = (q (0 : Fin (4 : + ℕ))).1.toNat ∧ (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ + (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + LatticeTile (TileCellComplement T (S i s)) ∧ TileTouching (TileCellComplement T (S i + s)) (S i s)) ∧ QuarterTurnSymmetric T ∧ ((1 : ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : + Fin (3 : ℕ)), TouchingTriple T (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))))) (TileTranslation T (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) + (q (0 : Fin (4 : ℕ)))))) ∧ ((1 : ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), + ∀ (U : ProtoTile), BandPrototile (q i.succ) U → TileCentroid U - TileCentroid T = (1 + / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple + T (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ (∀ (i : + Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → + BandPrototile (q (i + (1 : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = + (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V + - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin + (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin + (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple T U V) ∧ ∀ (r : Fin (4 + : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin + (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : + Fin (4 : ℕ)) → (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → (q (3 : Fin (4 : + ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → ∀ (P : Fin (3 + : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) + → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i + s (P i s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ + (P i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : + Fin (3 : ℕ)) true) i s (Q i s)) → (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) + true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (Q i s).cells) → (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : Fin (3 : ℕ)) false) i s (S i s)) → + (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s + : Bool), x ∈ (S i s).cells) → + let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); (∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty → AllowedSubtileIncidence a b) ∧ + (¬AllowedSubtileIncidence a b → FootprintVertices (SubtileOccurrenceInterpretation P + u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ FootprintVertices (P (0 : + Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ⊆ FootprintVertices + (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ + FootprintVertices (P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (0 : Fin (3 : ℕ)) + false) ⊆ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin + (3 : ℕ)) false) ∪ FootprintVertices (Q (0 : Fin (3 : ℕ)) false) ∪ FootprintVertices + (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → (((k + (1, 0) : GaussianInt) = BandVectors.1 (q 1) (q 0)) → (((k (0, 1) : GaussianInt) = + BandVectors.1 (q 2) (q 0)) → (TouchingTriple T (TileTranslation T (k (1, 0) : + GaussianInt)) (TileTranslation T (-(k (0, 1) : GaussianInt))))))) ) := by + classical + intro C q T k hc1 hgeom ka kb + simpa [ka, kb] using hgeom.2.2.2.2.1 hc1 0 + +private theorem fs_zero : + (by + classical + exact + ∀ (C : BandCircle), ∀ (k : ℤ × ℤ ≃+ ↥(TilingLattice C)), ∀ (D : P4812T1AffineDrawing + (TilingLattice C) k), + let fs (u : TilingLattice C) (f : D.plane.Face) := + D.faces (Sum.map (u + ·) (u + ·) (D.faces.symm f)) + ∀ (f : D.plane.Face), fs 0 f = f ) := by + classical + intro C k D fs f + obtain ⟨f, rfl⟩ := D.faces.surjective f + cases f <;> simp [fs] + +private theorem fs_add : + (by + classical + exact + ∀ (C : BandCircle), ∀ (k : ℤ × ℤ ≃+ ↥(TilingLattice C)), ∀ (D : P4812T1AffineDrawing + (TilingLattice C) k), + let fs (u : TilingLattice C) (f : D.plane.Face) := + D.faces (Sum.map (u + ·) (u + ·) (D.faces.symm f)) + ∀ (u : TilingLattice C), ∀ (v : TilingLattice C), ∀ (f : D.plane.Face), fs (u + v) f = fs + u (fs v f) ) := by + classical + intro C k D fs u v f + obtain ⟨f, rfl⟩ := D.faces.surjective f + cases f <;> simp [fs, add_assoc] + +private theorem fv_per : + (by + classical + exact + ∀ (C : BandCircle), ∀ (k : ℤ × ℤ ≃+ ↥(TilingLattice C)), ∀ (D : P4812T1AffineDrawing + (TilingLattice C) k), + let fs (u : TilingLattice C) (f : D.plane.Face) := + D.faces (Sum.map (u + ·) (u + ·) (D.faces.symm f)) + (∀ (u : TilingLattice C), ∀ (f : Sum (TilingLattice C) (TilingLattice C)), fs u (D.faces + f) = D.faces (Sum.map (u + ·) (u + ·) f)) → (∀ (u : TilingLattice C), ∀ (f : + D.plane.Face), ∀ (i : Fin 3), D.plane.faceVertex (fs u f) i = u + D.plane.faceVertex + f i) ) := by + classical + intro C k D fs fs_faces u f i + obtain ⟨f, rfl⟩ := D.faces.surjective f + cases f with + | inl x => + rw [fs_faces] + fin_cases i + · change D.plane.faceVertex (D.faces (.inl (u + x))) (0 : Fin 3) = + u + D.plane.faceVertex (D.faces (.inl x)) (0 : Fin 3) + rw [(D.up_vertices (u + x)).1, (D.up_vertices x).1] + · change D.plane.faceVertex (D.faces (.inl (u + x))) (1 : Fin 3) = + u + D.plane.faceVertex (D.faces (.inl x)) (1 : Fin 3) + rw [(D.up_vertices (u + x)).2.1, (D.up_vertices x).2.1] + abel + · change D.plane.faceVertex (D.faces (.inl (u + x))) (2 : Fin 3) = + u + D.plane.faceVertex (D.faces (.inl x)) (2 : Fin 3) + rw [(D.up_vertices (u + x)).2.2, (D.up_vertices x).2.2] + abel + | inr x => + rw [fs_faces] + fin_cases i + · change D.plane.faceVertex (D.faces (.inr (u + x))) (0 : Fin 3) = + u + D.plane.faceVertex (D.faces (.inr x)) (0 : Fin 3) + rw [(D.down_vertices (u + x)).1, (D.down_vertices x).1] + · change D.plane.faceVertex (D.faces (.inr (u + x))) (1 : Fin 3) = + u + D.plane.faceVertex (D.faces (.inr x)) (1 : Fin 3) + rw [(D.down_vertices (u + x)).2.1, (D.down_vertices x).2.1] + abel + · change D.plane.faceVertex (D.faces (.inr (u + x))) (2 : Fin 3) = + u + D.plane.faceVertex (D.faces (.inr x)) (2 : Fin 3) + rw [(D.down_vertices (u + x)).2.2, (D.down_vertices x).2.2] + abel + +private theorem delta_inj : + (by + classical + exact + let delta : Fin 6 → Int × Int := ![(1, 0), (0, 1), (-1, -1), + (-1, 0), (0, -1), (1, 1)] + Function.Injective delta ) := by + classical + intro delta + as_aux_lemma => + intro i j h + fin_cases i <;> fin_cases j <;> first | rfl | simp [delta] at h + +private theorem coord_adj : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (k : ℤ × ℤ ≃+ + ↥(TilingLattice C)), ∀ (D : P4812T1AffineDrawing (TilingLattice C) k), ((0 : ℤ) < + (q (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin + (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = + j) → ((1 < (q 0).1) → ((LatticeTile T ∧ TileArea T = (q (0 : Fin (4 : ℕ))).1.toNat ∧ + (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence q T i s (S i s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : + Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + LatticeTile (TileCellComplement T (S i s)) ∧ TileTouching (TileCellComplement T (S i + s)) (S i s)) ∧ QuarterTurnSymmetric T ∧ ((1 : ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : + Fin (3 : ℕ)), TouchingTriple T (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))))) (TileTranslation T (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) + (q (0 : Fin (4 : ℕ)))))) ∧ ((1 : ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), + ∀ (U : ProtoTile), BandPrototile (q i.succ) U → TileCentroid U - TileCentroid T = (1 + / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple + T (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ (∀ (i : + Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → + BandPrototile (q (i + (1 : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = + (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V + - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin + (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin + (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple T U V) ∧ ∀ (r : Fin (4 + : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin + (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : + Fin (4 : ℕ)) → (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → (q (3 : Fin (4 : + ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → ∀ (P : Fin (3 + : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) + → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i + s (P i s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ + (P i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : + Fin (3 : ℕ)) true) i s (Q i s)) → (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) + true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (Q i s).cells) → (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : Fin (3 : ℕ)) false) i s (S i s)) → + (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s + : Bool), x ∈ (S i s).cells) → + let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); (∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty → AllowedSubtileIncidence a b) ∧ + (¬AllowedSubtileIncidence a b → FootprintVertices (SubtileOccurrenceInterpretation P + u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ FootprintVertices (P (0 : + Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ⊆ FootprintVertices + (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ + FootprintVertices (P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (0 : Fin (3 : ℕ)) + false) ⊆ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin + (3 : ℕ)) false) ∪ FootprintVertices (Q (0 : Fin (3 : ℕ)) false) ∪ FootprintVertices + (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → ( + let delta : Fin 6 → Int × Int := ![(1, 0), (0, 1), (-1, -1), + (-1, 0), (0, -1), (1, 1)] + ∀ (x : TilingLattice C), ∀ (y : TilingLattice C), D.plane.adjacent x y ↔ ∃ i : Fin 6, + k.symm y - k.symm x = delta i))) ) := by + classical + intro C q T k D hc hc1 hgeom delta x y + rw [D.adjacent_iff] + constructor + · intro h + rcases h with h | h | h | h | h | h + · exact ⟨0, h⟩ + · exact ⟨1, h⟩ + · exact ⟨2, h⟩ + · exact ⟨3, h⟩ + · exact ⟨4, h⟩ + · exact ⟨5, h⟩ + · rintro ⟨i, hi⟩ + fin_cases i <;> simp [TriangularLatticeAdjacent, delta] at hi ⊢ <;> tauto + +private theorem graph_per : + (by + classical + exact + ∀ (C : BandCircle), ∀ (k : ℤ × ℤ ≃+ ↥(TilingLattice C)), ∀ (D : P4812T1AffineDrawing + (TilingLattice C) k), + let delta : Fin 6 → Int × Int := ![(1, 0), (0, 1), (-1, -1), + (-1, 0), (0, -1), (1, 1)] + (∀ (x : TilingLattice C), ∀ (y : TilingLattice C), D.plane.adjacent x y ↔ ∃ i : Fin 6, + k.symm y - k.symm x = delta i) → (∀ (u : TilingLattice C), ∀ (x : TilingLattice C), ∀ + (y : TilingLattice C), D.plane.adjacent (u + x) (u + y) ↔ D.plane.adjacent x y) ) := by + classical + intro C k D delta coord_adj u x y + have he : k.symm u + k.symm y - (k.symm u + k.symm x) = + k.symm y - k.symm x := by abel + simp only [coord_adj, map_add, he] + +private theorem edge_reps : + (by + classical + exact + ∀ (C : BandCircle), ∀ (k : ℤ × ℤ ≃+ ↥(TilingLattice C)), ∀ (D : P4812T1AffineDrawing + (TilingLattice C) k), + let delta : Fin 6 → Int × Int := ![(1, 0), (0, 1), (-1, -1), + (-1, 0), (0, -1), (1, 1)] + ∀ (delta_inj : Function.Injective delta), + let edgeEmbed : Fin 6 ↪ (TilingLattice C × TilingLattice C) := + ⟨fun i => (0, k (delta i)), fun i j h => delta_inj (k.injective (congrArg Prod.snd h))⟩ + let edges := Finset.univ.map edgeEmbed + (∀ (x : TilingLattice C), ∀ (y : TilingLattice C), D.plane.adjacent x y ↔ ∃ i : Fin 6, + k.symm y - k.symm x = delta i) → (∀ (x : TilingLattice C), ∀ (y : TilingLattice C), + (D.plane.adjacent x y) → (∃ r ∈ edges, ∃ u : TilingLattice C, x = u + r.1 ∧ y = u + + r.2)) ) := by + classical + intro C k D delta delta_inj edgeEmbed edges coord_adj x y hxy + obtain ⟨i, hi⟩ := (coord_adj x y).mp hxy + refine ⟨edgeEmbed i, Finset.mem_map.mpr ⟨i, Finset.mem_univ _, rfl⟩, x, ?_, ?_⟩ + · change x = x + 0 + exact (add_zero x).symm + · change y = x + k (delta i) + rw [← hi, map_sub, k.apply_symm_apply, k.apply_symm_apply] + abel + +private theorem incoming_sum : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (BandVectors.1 (q 1) (q 0) + + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) ) := by + classical + intro q hq + simpa [Fin.sum_univ_succ, add_assoc] using (IncomingSuperbasisRelation q hq).1 + +private theorem kc : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (k : ℤ × ℤ ≃+ ↥(TilingLattice + C)), (∀ (x : ℤ × ℤ), (↑((k : ℤ × ℤ → ↥(TilingLattice C)) x) : GaussianInt) = (↑x.1 : + GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑x.2 : + GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))) → + ((BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = + 0) → ((k (-1, -1) : GaussianInt) = BandVectors.1 (q 3) (q 0))) ) := by + classical + intro C q k hk incoming_sum + rw [hk] + simp only [Int.cast_neg, Int.cast_one, neg_one_mul] + calc + _ = BandVectors.1 (q 3) (q 0) - + (BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + + BandVectors.1 (q 3) (q 0)) := by ring + _ = _ := by rw [incoming_sum]; simp + +private theorem signed : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (k : ℤ × ℤ ≃+ ↥(TilingLattice + C)), ∀ (D : P4812T1AffineDrawing (TilingLattice C) k), ((k (1, 0) : GaussianInt) = + BandVectors.1 (q 1) (q 0)) → (((k (0, 1) : GaussianInt) = BandVectors.1 (q 2) (q 0)) → ( + let delta : Fin 6 → Int × Int := ![(1, 0), (0, 1), (-1, -1), + (-1, 0), (0, -1), (1, 1)] + (∀ (x : TilingLattice C), ∀ (y : TilingLattice C), D.plane.adjacent x y ↔ ∃ i : Fin 6, + k.symm y - k.symm x = delta i) → (((k (-1, -1) : GaussianInt) = BandVectors.1 (q 3) + (q 0)) → ((Function.Injective (fun x => (k x : GaussianInt))) → (∀ (x : TilingLattice + C), ∀ (y : TilingLattice C), D.plane.adjacent x y ↔ ∃ j : Fin 3, (y : GaussianInt) - + (x : GaussianInt) = BandVectors.1 (q j.succ) (q 0) ∨ (y : GaussianInt) - (x : + GaussianInt) = -BandVectors.1 (q j.succ) (q 0)))))) ) := by + classical + intro C q k D ka kb delta coord_adj kc kinj x y + have diff : (k (k.symm y - k.symm x) : GaussianInt) = + (y : GaussianInt) - (x : GaussianInt) := by simp + have step (i : Fin 6) : ∃ j : Fin 3, + (k (delta i) : GaussianInt) = BandVectors.1 (q j.succ) (q 0) ∨ + (k (delta i) : GaussianInt) = -BandVectors.1 (q j.succ) (q 0) := by + fin_cases i + · exact ⟨0, Or.inl ka⟩ + · exact ⟨1, Or.inl kb⟩ + · exact ⟨2, Or.inl kc⟩ + · refine ⟨0, Or.inr ?_⟩ + change (k (-((1, 0) : Int × Int)) : GaussianInt) = -BandVectors.1 (q 1) (q 0) + rw [map_neg, AddSubgroup.coe_neg, ka] + · refine ⟨1, Or.inr ?_⟩ + change (k (-((0, 1) : Int × Int)) : GaussianInt) = -BandVectors.1 (q 2) (q 0) + rw [map_neg, AddSubgroup.coe_neg, kb] + · refine ⟨2, Or.inr ?_⟩ + change (k (-((-1, -1) : Int × Int)) : GaussianInt) = -BandVectors.1 (q 3) (q 0) + rw [map_neg, AddSubgroup.coe_neg, kc] + rw [coord_adj] + constructor + · rintro ⟨i, hi⟩ + rw [← diff, hi] + exact step i + · rintro ⟨j, hj | hj⟩ + · fin_cases j + · exact ⟨0, kinj (diff.trans (hj.trans ka.symm))⟩ + · exact ⟨1, kinj (diff.trans (hj.trans kb.symm))⟩ + · exact ⟨2, kinj (diff.trans (hj.trans kc.symm))⟩ + · fin_cases j + · refine ⟨3, kinj (diff.trans (hj.trans ?_))⟩ + change -BandVectors.1 (q 1) (q 0) = (k (-((1, 0) : Int × Int)) : GaussianInt) + rw [map_neg, AddSubgroup.coe_neg, ka] + · refine ⟨4, kinj (diff.trans (hj.trans ?_))⟩ + change -BandVectors.1 (q 2) (q 0) = (k (-((0, 1) : Int × Int)) : GaussianInt) + rw [map_neg, AddSubgroup.coe_neg, kb] + · refine ⟨5, kinj (diff.trans (hj.trans ?_))⟩ + change -BandVectors.1 (q 3) (q 0) = (k (-((-1, -1) : Int × Int)) : GaussianInt) + rw [map_neg, AddSubgroup.coe_neg, kc] + +private theorem facescard : + (by + classical + exact + ∀ (C : BandCircle), ∀ (k : ℤ × ℤ ≃+ ↥(TilingLattice C)), ∀ (D : P4812T1AffineDrawing + (TilingLattice C) k), + let faces : Finset D.plane.Face := {D.faces (.inl 0), D.faces (.inr 0)} + faces.card = 2 ) := by + classical + intro C k D faces + have hn : D.faces (.inl 0) ≠ D.faces (.inr 0) := + fun h => Sum.inl_ne_inr (D.faces.injective h) + simp [faces, hn] + +private theorem translate_add : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), TileTranslation + (TileTranslation U x) y = TileTranslation U (x + y) ) := by + classical + intro U x y + cases U + simp only [TileTranslation, Finset.image_image, Function.comp_def, + GaussianTranslation, add_assoc] + rfl + +private theorem hzero : + (by + classical + exact + ∀ (T : ProtoTile), TileTranslation T 0 = T ) := by + classical + intro T + have hz : GaussianTranslation 0 = id := funext fun z => add_zero z + unfold TileTranslation + rw [hz, Finset.image_id] + rfl + +end RegularPeriodicGeometry + +theorem BandRegularTranslatePeriodicComplex (C : BandCircle) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hqC : q 0 = C.1.1) (T : ProtoTile) (hT : BandPrototile (q 0) T) : + ∃ P : PeriodicTileComplex (TilingLattice C), + P.lattice = TilingLattice C ∧ + (∀ u, P.tile u = TileTranslation T (u : GaussianInt)) ∧ + (∀ u v, P.plane.adjacent u v ↔ + ∃ j : Fin 3, + (v : GaussianInt) - (u : GaussianInt) = + BandVectors.1 (q j.succ) (q 0) ∨ + (v : GaussianInt) - (u : GaussianInt) = + -BandVectors.1 (q j.succ) (q 0)) ∧ + (∀ u, P.plane.position u = GaussianRealPoint (u : GaussianInt)) ∧ + P.vertexOrbitReps.card = 1 ∧ + P.edgeOrbitReps.card = 6 ∧ + P.faceOrbitReps.card = 2 ∧ + Nonempty (AffineTriangularComplexChart P (fun mn : Int × Int => + TileTranslation T + ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (mn.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)))) := by +-- BODY + classical + obtain ⟨k, hk, H, hH⟩ := P4812T1LatticeCoordinates C q hq hqC + obtain ⟨G, up, down, hadj, hu, hd, hud, hall, hup, hdown, hpos, + harc, hru, hrd⟩ := AffineTriangularPlaneTriangulation + let phi (x : Int × Int) : Real × Real := + (((x.1 : Real) - (x.2 : Real) / 2), (x.2 : Real)) + have phi_add (x y : Int × Int) : phi (x + y) = phi x + phi y := by + ext <;> simp [phi]; ring + have arcs (z x y : Int × Int) : G.edgeArc (z + x) (z + y) = + (fun p => p + phi z) '' G.edgeArc x y := RegularPeriodicGeometry.arcs G hpos harc phi_add z + x y + have regions (z x : Int × Int) : + G.faceRegion (up (z + x)) = (fun p => p + phi z) '' G.faceRegion (up x) ∧ + G.faceRegion (down (z + x)) = (fun p => p + phi z) '' G.faceRegion (down x) := + RegularPeriodicGeometry.regions G up down hru hrd z x + have H_add (p r : Real × Real) : H (p + r) = H p + H r := RegularPeriodicGeometry.H_add q H hH p r + have H_coord (x : Int × Int) : H (phi x) = GaussianRealPoint (k x : GaussianInt) := + RegularPeriodicGeometry.H_coord C q k hk H hH x + obtain ⟨D⟩ := P4812T1AffineTransport (TilingLattice C) k G up down + hadj hu hd hud hall hup hdown hpos arcs regions H H_add H_coord + have hc := ProperBandCurvatureStructure q hq + have hc1 : 1 < (q 0).1 := RegularPeriodicGeometry.hc1 q hq hc + have hgeom := BandTileSimultaneousInduction q hq T hT + have hne : T.cells.Nonempty := RegularPeriodicGeometry.hne q T hc1 hgeom + have ka : (k (1, 0) : GaussianInt) = BandVectors.1 (q 1) (q 0) := by + simp [hk] + have kb : (k (0, 1) : GaussianInt) = BandVectors.1 (q 2) (q 0) := by + simp [hk] + have htu : TouchingTriple T + (TileTranslation T (k (1, 0) : GaussianInt)) + (TileTranslation T (-(k (0, 1) : GaussianInt))) := RegularPeriodicGeometry.htu C q T k hc1 + hgeom ka kb + have htd := P4812T1ReflectedTouching T (k (1, 0)) (k (0, 1)) hne + hgeom.2.2.2.1 htu + let fs (u : TilingLattice C) (f : D.plane.Face) := + D.faces (Sum.map (u + ·) (u + ·) (D.faces.symm f)) + obtain ⟨rho, hrho, hrhoper, path, hrev, hpathper, hpath, hedge, _⟩ := + P4812T1RegularFaceWalks (TilingLattice C) k D T hne htu htd + have fs_faces (u : TilingLattice C) (f : Sum (TilingLattice C) (TilingLattice C)) : + fs u (D.faces f) = D.faces (Sum.map (u + ·) (u + ·) f) := by simp [fs] + have fs_zero (f : D.plane.Face) : fs 0 f = f := RegularPeriodicGeometry.fs_zero C k D f + have fs_add (u v : TilingLattice C) (f : D.plane.Face) : + fs (u + v) f = fs u (fs v f) := RegularPeriodicGeometry.fs_add C k D u v f + have fv_per (u : TilingLattice C) (f : D.plane.Face) (i : Fin 3) : + D.plane.faceVertex (fs u f) i = u + D.plane.faceVertex f i := + RegularPeriodicGeometry.fv_per C k D fs_faces u f i + let delta : Fin 6 → Int × Int := ![(1, 0), (0, 1), (-1, -1), + (-1, 0), (0, -1), (1, 1)] + have delta_inj : Function.Injective delta := RegularPeriodicGeometry.delta_inj + let edgeEmbed : Fin 6 ↪ (TilingLattice C × TilingLattice C) := + ⟨fun i => (0, k (delta i)), fun i j h => delta_inj (k.injective (congrArg Prod.snd h))⟩ + let edges := Finset.univ.map edgeEmbed + have edgecard : edges.card = 6 := by simp [edges] + have coord_adj (x y : TilingLattice C) : D.plane.adjacent x y ↔ + ∃ i : Fin 6, k.symm y - k.symm x = delta i := RegularPeriodicGeometry.coord_adj C q T k D + hc hc1 hgeom x y + have graph_per (u x y : TilingLattice C) : + D.plane.adjacent (u + x) (u + y) ↔ D.plane.adjacent x y := + RegularPeriodicGeometry.graph_per C k D coord_adj u x y + have edge_reps (x y : TilingLattice C) (hxy : D.plane.adjacent x y) : + ∃ r ∈ edges, ∃ u : TilingLattice C, x = u + r.1 ∧ y = u + r.2 := + RegularPeriodicGeometry.edge_reps C k D delta_inj coord_adj x y hxy + have incoming_sum : BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + + BandVectors.1 (q 3) (q 0) = 0 := RegularPeriodicGeometry.incoming_sum q hq + have kc : (k (-1, -1) : GaussianInt) = BandVectors.1 (q 3) (q 0) := RegularPeriodicGeometry.kc + C q k hk incoming_sum + have kinj : Function.Injective (fun x => (k x : GaussianInt)) := + fun _ _ h => k.injective (Subtype.ext h) + have signed (x y : TilingLattice C) : D.plane.adjacent x y ↔ + ∃ j : Fin 3, (y : GaussianInt) - (x : GaussianInt) = + BandVectors.1 (q j.succ) (q 0) ∨ + (y : GaussianInt) - (x : GaussianInt) = -BandVectors.1 (q j.succ) (q 0) := + RegularPeriodicGeometry.signed C q k D ka kb coord_adj kc kinj x y + obtain ⟨R, hR, hRcard⟩ := TilingLatticeIndex C + let faces : Finset D.plane.Face := {D.faces (.inl 0), D.faces (.inr 0)} + have facescard : faces.card = 2 := RegularPeriodicGeometry.facescard C k D + have translate_add (U : ProtoTile) (x y : GaussianInt) : + TileTranslation (TileTranslation U x) y = TileTranslation U (x + y) := + RegularPeriodicGeometry.translate_add U x y + let P : PeriodicTileComplex (TilingLattice C) := { + plane := D.plane + tile := fun x => TileTranslation T (x : GaussianInt) + lattice := TilingLattice C + latticeReps := R + vertexOrbitReps := {0} + edgeOrbitReps := edges + faceOrbitReps := faces + shift := fun u x => u + x + faceShift := fs + lattice_full_rank := hR + tiles_are_disks := fun x => (TileDiskAreaCovariance T x).1.mp hgeom.1 + shift_zero := fun x => zero_add x + shift_add := fun u v x => add_assoc u v x + faceShift_zero := fs_zero + faceShift_add := fs_add + tile_periodic := by + intro u x + simp only [AddSubgroup.coe_add, translate_add, add_comm] + edge_periodic := graph_per + face_vertices_periodic := fv_per + position_periodic := by + intro u x + simp [D.position_eq, GaussianRealPoint, add_comm] + edgeArc_periodic := D.edgeArc_periodic + faceRegion_periodic := by + intro u f + simpa only [fs, D.faces.apply_symm_apply] using + D.faceRegion_periodic u (D.faces.symm f) + vertex_orbit_representatives := by + intro x + refine ⟨0, ⟨by simp, x, by simp⟩, ?_⟩ + intro r hr + simpa using hr.1 + edge_orbit_representatives := edge_reps + face_orbit_representatives := by + intro f + obtain ⟨f, rfl⟩ := D.faces.surjective f + cases f with + | inl x => exact ⟨D.faces (.inl 0), by simp [faces], x, by simp [fs]⟩ + | inr x => exact ⟨D.faces (.inr 0), by simp [faces], x, by simp [fs]⟩ + rho := rho + rho_common := hrho + rho_periodic := hrhoper + facePath := path + facePath_reverse := hrev + facePath_periodic := hpathper + facePath_spec := hpath + area_balance := by + simp only [Finset.sum_singleton] + have hzero : TileTranslation T 0 = T := RegularPeriodicGeometry.hzero T + rw [AddSubgroup.coe_zero, hzero, hgeom.2.1, hRcard, ← hqC] + omega + adjacent_has_common_edge := hedge } + refine ⟨P, rfl, fun _ => rfl, signed, D.position_eq, by simp [P], edgecard, facescard, ?_⟩ + refine ⟨{ + vertexEquiv := k.toEquiv + adjacent_iff := by intro x y; simpa [P] using D.adjacent_iff (k x) (k y) + up := fun x => D.faces (.inl (k x)) + down := fun x => D.faces (.inr (k x)) + up_injective := D.faces.injective.comp (Sum.inl_injective.comp k.injective) + down_injective := D.faces.injective.comp (Sum.inr_injective.comp k.injective) + up_ne_down := fun _ _ h => Sum.inl_ne_inr (D.faces.injective h) + face_exhaustive := by + intro f + obtain ⟨f, rfl⟩ := D.faces.surjective f + cases f with + | inl x => exact Or.inl ⟨k.symm x, by simp⟩ + | inr x => exact Or.inr ⟨k.symm x, by simp⟩ + up_vertices := by intro x; simpa [P] using D.up_vertices (k x) + down_vertices := by intro x; simpa [P] using D.down_vertices (k x) + tile_eq := by intro x; change TileTranslation T (k x : GaussianInt) = _; rw [hk] }⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean b/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean new file mode 100644 index 0000000000..5145b34452 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean @@ -0,0 +1,1340 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrientedBoundaryParentChain +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandParentBoundaryGenealogy +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification + +-- [TABLET NODE: BandRetainedBoundaryGenealogy] + +/-! +# BandRetainedBoundaryGenealogy + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RetainedBoundaryProof + +private theorem curvatureBound : + ∀ r : Fin 4 → CircleCoordinates, + SemiProperQuadruple r → ∀ i : Fin 4, + (r i).1 = 0 ∨ (r i).1 = 1 ∨ 4 ≤ (r i).1 := by + classical + intro r hr + induction hr with + | base z => + intro i + fin_cases i <;> simp + | @rotate r hr ih => + intro i + fin_cases i <;> simp_all [] + | @successor r hr ih => + intro i + fin_cases i + · have forest := SemiProperForestClassification r hr + rcases forest with ⟨nonneg, cases⟩ + rcases cases with root | root | root | old + · rcases root with ⟨z, hz⟩ + rw [hz] + simp + · rcases root with ⟨z, hz⟩ + rw [hz] + simp + · rcases root with ⟨z, hz⟩ + rw [hz] + simp + · have curv := ProperBandCurvatureStructure r old + have hpos : 0 < (r 0).1 := curv.1 + have h1 : (r 1).1 < (r 0).1 := old.2 0 + have h2lt : (r 2).1 < (r 0).1 := old.2 1 + have h3lt : (r 3).1 < (r 0).1 := old.2 2 + have h2 : 0 ≤ (r 2).1 := curv.2.1 1 + have h3 : 0 ≤ (r 3).1 := curv.2.1 2 + have hposNew : 0 < + 2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1 := by + omega + have hnotone0 : (r 0).1 ≠ 1 := by + intro hone + have hz2 : (r 2).1 = 0 := by omega + have hz3 : (r 3).1 = 0 := by omega + have e : (1 : Fin 3) = 2 := curv.2.2 1 2 hz2 hz3 + have ev := congrArg Fin.val e + omega + have hlarge0 : 4 ≤ (r 0).1 := by + rcases ih 0 with hz | hone | hlarge + · omega + · exact (hnotone0 hone).elim + · exact hlarge + have hd : 4 ≤ 2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1 := by + omega + exact Or.inr (Or.inr hd) + · simpa using ih 0 + · simpa using ih 2 + · simpa using ih 3 + +private theorem buildConfiguration : + (∀ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → ∀ i : Fin 4, (r i).1 ≠ 0 → (r i).1 + = 1 ∨ 4 ≤ (r i).1) → (∀ (u : Fin 4 → CircleCoordinates), ∀ (p : Fin 4 → + CircleCoordinates), ∀ (t : Fin 4 → CircleCoordinates), ProperBandQuadruple u → + (∀ i : Fin 4, (u i).1 ≠ 0) → + (∀ i j : Fin 4, (u i).1 = 1 → (u j).1 = 1 → i = j) → + ProperBandQuadruple p → + u = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3] → + p 0 = u 1 → p 2 = u 2 → p 3 = u 3 → + (u 2).1 < (u 1).1 → (u 3).1 < (u 1).1 → + ProperBandQuadruple t → t 0 = u 2 → t 1 = u 3 → + (u 3).1 < (u 2).1 → + Nonempty (BandOrderedGeneralConfiguration u)) := by + classical + intro positiveLarge u p t hu hnl haum hp hs h0 h2 h3 hlt2 hlt3 ht ht0 ht1 horder + have cu := ProperBandCurvatureStructure u hu + have cp := ProperBandCurvatureStructure p hp + have hp1nonneg : 0 ≤ (p 1).1 := by simpa using cp.2.1 0 + have hp2nonneg : 0 ≤ (p 2).1 := by simpa using cp.2.1 1 + have hp3nonneg : 0 ≤ (p 3).1 := by simpa using cp.2.1 2 + have hp3 : 0 < (p 3).1 := by + have hn : (p 3).1 ≠ 0 := by simpa [h3] using hnl 3 + omega + have hp2 : 0 < (p 2).1 := by + have hn : (p 2).1 ≠ 0 := by simpa [h2] using hnl 2 + omega + have hu0large : 4 < (u 0).1 := by + have hp0 : 0 < (p 0).1 := by + have hn : (p 0).1 ≠ 0 := by simpa [h0] using hnl 1 + omega + have hp1lt : (p 1).1 < (p 0).1 := by simpa using hp.2 0 + have hp2lt : (p 2).1 < (p 0).1 := by simpa using hp.2 1 + have hp3lt : (p 3).1 < (p 0).1 := by simpa using hp.2 2 + have hf := congrArg (fun z : Fin 4 → CircleCoordinates => (z 0).1) hs + simp at hf + have hp0c := positiveLarge p hp.1 0 (by omega : (p 0).1 ≠ 0) + have hp2c := positiveLarge p hp.1 2 (by omega : (p 2).1 ≠ 0) + have hp3c := positiveLarge p hp.1 3 (by omega : (p 3).1 ≠ 0) + rcases hp0c with hone | hlarge + · have hp1z : (p 1).1 = 0 := by omega + rcases hp2c with hone2 | hlarge2 <;> + rcases hp3c with hone3 | hlarge3 <;> omega + · omega + have hu2large : 4 ≤ (u 2).1 := by + have hp3lt2 : (p 3).1 < (p 2).1 := by simpa [h2, h3] using horder + rcases positiveLarge p hp.1 2 (by omega : (p 2).1 ≠ 0) with hone | hlarge + · omega + · simpa [h2] using hlarge + have htwin : p 1 = + (2 * (u 1).1 + 2 * (u 2).1 + 2 * (u 3).1 - (u 0).1, + 2 * (u 1).2 + 2 * (u 2).2 + 2 * (u 3).2 - (u 0).2) := by + rw [hs] + simp [h0, h2, h3] + have hsmall1 : (p 0).1 < (u 0).1 := by simpa [h0] using hu.2 0 + have hsmall2 : (t 0).1 < (u 0).1 := by + rw [ht0] + exact hu.2 1 + have hsoddy : + 2 * (u 1).1 + 2 * (u 2).1 + 2 * (u 3).1 = + (u 0).1 + (p 1).1 := by + have hf := congrArg Prod.fst htwin + omega + refine ⟨⟨hu, hnl, haum, hu0large, hlt2, hu2large, le_of_lt horder, + p, t, hp, ht, h0, htwin, h2, h3, ht0, ht1, hsmall1, + hsmall2, hsoddy, ?_, ?_, ?_, ?_⟩⟩ + · have n0 : ((u 0).1.toNat : Int) = (u 0).1 := + Int.toNat_of_nonneg (le_of_lt cu.1) + have n1 : ((u 1).1.toNat : Int) = (u 1).1 := + Int.toNat_of_nonneg (by simpa using cu.2.1 0) + have n2 : ((u 2).1.toNat : Int) = (u 2).1 := + Int.toNat_of_nonneg (by simpa using cu.2.1 1) + have n3 : ((u 3).1.toNat : Int) = (u 3).1 := + Int.toNat_of_nonneg (by simpa using cu.2.1 2) + have np : ((p 1).1.toNat : Int) = (p 1).1 := + Int.toNat_of_nonneg (by simpa using cp.2.1 0) + omega + · simp [h0, h2] + · simp [h0, h3] + · simp [ht0, ht1] + +private theorem hq0large : + ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), (q i).1 ≠ (0 : ℤ)) → ((∀ r : Fin 4 → + CircleCoordinates, SemiProperQuadruple r → ∀ i : Fin 4, (r i).1 ≠ 0 → (r i).1 = 1 ∨ 4 ≤ + (r i).1) → (∀ (p : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple p) → ((q = + ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p + (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : + ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 + : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin + (4 : ℕ))]) → ((p (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ))) → (((p (3 : Fin (4 : ℕ))).1 < + (p (2 : Fin (4 : ℕ))).1) → (((0 : ℤ) < (q (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 + : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → + (q j.succ).1 = (0 : ℤ) → i = j) → (((0 : ℤ) < (p (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : + ℕ)), (0 : ℤ) ≤ (p i.succ).1) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), (p i.succ).1 = + (0 : ℤ) → (p j.succ).1 = (0 : ℤ) → i = j) → ((0 ≤ (p 1).1) → (((p 1).1 < (p 0).1) → ((0 < + (p 3).1) → ((0 < (p 2).1) → (4 < (q 0).1)))))))))))) := by + classical + intro q hnoLine positiveLarge p hp hsucc h0 hlt cq cp hp1nonneg' hp1lt' hp3 hp2 + have hp0 : 0 < (p 0).1 := by + have hn : (p 0).1 ≠ 0 := by simpa [h0] using hnoLine 1 + omega + have hp1nonneg := cp.2.1 0 + have hp1lt := hp.2 0 + have hqformula := congrArg + (fun z : Fin 4 → CircleCoordinates => (z 0).1) hsucc + simp? at hqformula + have hqformula' : (q 0).1 = + 2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1 := by + simpa using hqformula + have hp0case := positiveLarge p hp.1 0 (by omega : (p 0).1 ≠ 0) + have hp2case := positiveLarge p hp.1 2 (by omega : (p 2).1 ≠ 0) + have hp3case := positiveLarge p hp.1 3 (by omega : (p 3).1 ≠ 0) + rcases hp0case with hone | hlarge + · have hp1zero : (p 1).1 = 0 := by omega + norm_num [hone, hp1zero] at hqformula' + rcases hp2case with hone2 | hlarge2 <;> + rcases hp3case with hone3 | hlarge3 <;> omega + · omega + +private theorem config : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ((∀ (i : Fin (4 : ℕ)), (q i).1 ≠ + (0 : ℤ)) → ((∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), (q i).1 = (1 : ℤ) → (q j).1 = (1 : + ℤ) → i = j) → (∀ (p : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple p ∧ q = + ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p + (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : + ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 + : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin + (4 : ℕ))] ∧ p (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) ∧ p (2 : Fin (4 : ℕ)) = q (2 : Fin + (4 : ℕ)) ∧ p (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) ∧ (q (2 : Fin (4 : ℕ))).1 < (q (1 : + Fin (4 : ℕ))).1 ∧ (q (3 : Fin (4 : ℕ))).1 < (q (1 : Fin (4 : ℕ))).1) → + ((ProperBandQuadruple p) → ((p (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ))) → ((p (2 : Fin (4 + : ℕ)) = q (2 : Fin (4 : ℕ))) → ((p (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ))) → (∀ (t : Fin + (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple t) → ((t (0 : Fin (4 : ℕ)) = p (2 : + Fin (4 : ℕ))) → ((t (1 : Fin (4 : ℕ)) = p (3 : Fin (4 : ℕ))) → (((0 : ℤ) < (q (0 : Fin (4 + : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (j : + Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) → (((0 : ℤ) < (p + (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (p i.succ).1) ∧ ∀ (i : Fin (3 : + ℕ)), ∀ (j : Fin (3 : ℕ)), (p i.succ).1 = (0 : ℤ) → (p j.succ).1 = (0 : ℤ) → i = j) → ((4 + < (q 0).1) → ((4 ≤ (q 2).1) → ((p 1 = (2 * (q 1).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 0).1, + 2 * (q 1).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 0).2)) → (((p 0).1 < (q 0).1) → (((t 0).1 < + (q 0).1) → (((q 3).1 ≤ (q 2).1) → ((2 * (q 1).1 + 2 * (q 2).1 + 2 * (q 3).1 = (q 0).1 + + (p 1).1) → (Nonempty (BandOrderedGeneralConfiguration q))))))))))))))))))))) := by + classical + intro q hq hnoLine hatMostOneUnit p hfirst hp h0 h2 h3 t ht hb0 hb1 cq cp hq0large hq2large + htwin hfirstsmall hsecondsmall horder23 hsoddy + refine ⟨⟨hq, hnoLine, hatMostOneUnit, hq0large, + hfirst.2.2.2.2.2.1, hq2large, horder23, p, t, hp, ht, h0, htwin, + h2, h3, hb0.trans h2, hb1.trans h3, hfirstsmall, + hsecondsmall, hsoddy, ?_, ?_, ?_, ?_⟩⟩ + · have hnat0 : ((q 0).1.toNat : Int) = (q 0).1 := + Int.toNat_of_nonneg (le_of_lt cq.1) + have hnat1 : ((q 1).1.toNat : Int) = (q 1).1 := + Int.toNat_of_nonneg (by simpa using cq.2.1 0) + have hnat2 : ((q 2).1.toNat : Int) = (q 2).1 := + Int.toNat_of_nonneg (by simpa using cq.2.1 1) + have hnat3 : ((q 3).1.toNat : Int) = (q 3).1 := + Int.toNat_of_nonneg (by simpa using cq.2.1 2) + have hnatt : ((p 1).1.toNat : Int) = (p 1).1 := + Int.toNat_of_nonneg (by simpa using cp.2.1 0) + omega + · simp [h0, h2] + · simp [h0, h3] + · simp [hb0, hb1, h2, h3] + +private theorem haum'At397 : + ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), (q i).1 = (1 : + ℤ) → (q j).1 = (1 : ℤ) → i = j) → ( + let u := BandPackingSymmetryQuadrupleAction .conjugate q + ∀ i j : Fin 4, (u i).1 = 1 → (u j).1 = 1 → i = j) := by + classical + intro q hatMostOneUnit u + let index : Fin 4 → Fin 4 := ![0, 1, 3, 2] + have negOne : (-1 : Fin 3) = 2 := by decide + have negTwo : (-2 : Fin 3) = 1 := by decide + have hiMap : ∀ i : Fin 4, (u i).1 = (q (index i)).1 := by + intro i + fin_cases i <;> simp [index, u, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, + negOne, negTwo] + intro i j hi hj + have hi' : (q (index i)).1 = 1 := by rw [← hiMap i]; exact hi + have hj' : (q (index j)).1 = 1 := by rw [← hiMap j]; exact hj + have he := hatMostOneUnit (index i) (index j) hi' hj' + fin_cases i <;> fin_cases j <;> simp [index] at he ⊢ + +private theorem hs'At413 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (q = ![((2 : ℤ) * + (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : + ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : + GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p + (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ( + let pr : Fin 4 → CircleCoordinates := p + let u := BandPackingSymmetryQuadrupleAction .conjugate q + let pp := BandPackingSymmetryQuadrupleAction .conjugate pr + ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → (u = ![(2 * (pp 0).1 + 2 * (pp 2).1 + 2 + * (pp 3).1 - (pp 1).1, + 2 * (pp 0).2 + 2 * (pp 2).2 + 2 * (pp 3).2 - (pp 1).2), pp 0, pp 2, pp 3]))) := by + classical + intro q p hsucc pr u pp negOneSucc negTwoSucc + have hss := congrArg + (fun z => BandPackingSymmetryQuadrupleAction .conjugate z) hsucc + change BandPackingSymmetryQuadrupleAction .conjugate q = _ + convert hss using 1; + simp? [pp, pr, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, + GaussianReflection, negOneSucc, negTwoSucc]; + try { constructor + · ring + · ext <;> simp [] <;> ring } + +private theorem hs'At528 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (![q (0 : Fin (4 + : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p + (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : + ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : + GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p + (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + let pp := BandPackingSymmetryQuadrupleAction .conjugate p + ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → (u = ![(2 * (pp 0).1 + 2 * (pp 2).1 + 2 + * (pp 3).1 - (pp 1).1, + 2 * (pp 0).2 + 2 * (pp 2).2 + 2 * (pp 3).2 - (pp 1).2), pp 0, pp 2, pp 3]))) := by + classical + intro q p hsucc base u pp negOneSucc negTwoSucc + have hss := congrArg (fun z => BandPackingSymmetryQuadrupleAction .conjugate z) hsucc + change BandPackingSymmetryQuadrupleAction .conjugate base = _ + convert hss using 1; + simp? [pp, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, + GaussianReflection, negOneSucc, negTwoSucc]; + try { constructor + · ring + · ext <;> simp [] <;> ring } + +private theorem hs'At631 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (![q (0 : Fin (4 + : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p + (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : + ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : + GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p + (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + let pp := BandPackingSymmetryQuadrupleAction .conjugate p + ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → (u = ![(2 * (pp 0).1 + 2 * (pp 2).1 + 2 + * (pp 3).1 - (pp 1).1, + 2 * (pp 0).2 + 2 * (pp 2).2 + 2 * (pp 3).2 - (pp 1).2), pp 0, pp 2, pp 3]))) := by + classical + intro q p hsucc base u pp negOneSucc negTwoSucc + have hss := congrArg (fun z => BandPackingSymmetryQuadrupleAction .conjugate z) hsucc + change BandPackingSymmetryQuadrupleAction .conjugate base = _ + convert hss using 1; + simp? [pp, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, + GaussianReflection, negOneSucc, negTwoSucc]; + try { constructor + · ring + · ext <;> simp [] <;> ring } + +end RetainedBoundaryProof + +namespace RetainedBoundaryDetails + +private theorem positiveLarge : + (∀ (r : Fin (4 : ℕ) → CircleCoordinates), SemiProperQuadruple r → ∀ (i : Fin (4 : ℕ)), (r + i).1 = (0 : ℤ) ∨ (r i).1 = (1 : ℤ) ∨ (4 : ℤ) ≤ (r i).1) → (∀ r : Fin 4 → CircleCoordinates, + SemiProperQuadruple r → ∀ i : Fin 4, (r i).1 ≠ 0 → + (r i).1 = 1 ∨ 4 ≤ (r i).1) := by + classical + intro curvatureBound r hr i hi + rcases curvatureBound r hr i with hz | hone | hlarge + · exact (hi hz).elim + · exact Or.inl hone + · exact Or.inr hlarge + +private theorem hp3 : + ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), (q i).1 ≠ (0 : ℤ)) → (∀ (p : Fin (4 + : ℕ) → CircleCoordinates), (p (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ))) → (((0 : ℤ) < (p + (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (p i.succ).1) ∧ ∀ (i : Fin (3 : + ℕ)), ∀ (j : Fin (3 : ℕ)), (p i.succ).1 = (0 : ℤ) → (p j.succ).1 = (0 : ℤ) → i = j) → ((0 + ≤ (p 3).1) → (0 < (p 3).1)))) := by + classical + intro q hnoLine p h3 cp hp3nonneg' + have hn : (p 3).1 ≠ 0 := by simpa [h3] using hnoLine 3 + have hn' : 0 ≤ (p 3).1 := by simpa using cp.2.1 2 + omega + +private theorem hp2 : + ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), (q i).1 ≠ (0 : ℤ)) → (∀ (p : Fin (4 + : ℕ) → CircleCoordinates), (p (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ))) → (((p (3 : Fin (4 + : ℕ))).1 < (p (2 : Fin (4 : ℕ))).1) → (((0 : ℤ) < (p (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin + (3 : ℕ)), (0 : ℤ) ≤ (p i.succ).1) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), (p + i.succ).1 = (0 : ℤ) → (p j.succ).1 = (0 : ℤ) → i = j) → ((0 ≤ (p 2).1) → ((0 < (p 3).1) → + (0 < (p 2).1)))))) := by + classical + intro q hnoLine p h2 hlt cp hp2nonneg' hp3 + have hn : (p 2).1 ≠ 0 := by simpa [h2] using hnoLine 2 + have hn' : 0 ≤ (p 2).1 := by simpa using cp.2.1 1 + omega + +private theorem hq2large : + ∀ (q : Fin 4 → CircleCoordinates), (∀ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → + ∀ i : Fin 4, (r i).1 ≠ 0 → (r i).1 = 1 ∨ 4 ≤ (r i).1) → (∀ (p : Fin (4 : ℕ) → + CircleCoordinates), (ProperBandQuadruple p) → ((p (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : + ℕ))) → (((p (3 : Fin (4 : ℕ))).1 < (p (2 : Fin (4 : ℕ))).1) → ((0 < (p 3).1) → ((0 < (p + 2).1) → (4 ≤ (q 2).1)))))) := by + classical + intro q positiveLarge p hp h2 hlt hp3 hp2 + rcases positiveLarge p hp.1 2 (by omega : (p 2).1 ≠ 0) with hone | hlarge + · omega + · simpa [h2] using hlarge + +private theorem htwin : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (q = ![((2 : ℤ) * + (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : + ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : + GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p + (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → + ((p (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ))) → ((p (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : + ℕ))) → ((p (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ))) → (p 1 = + (2 * (q 1).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 0).1, + 2 * (q 1).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 0).2))))) := by + classical + intro q p hsucc h0 h2 h3 + rw [hsucc] + simp [h0, h2, h3] + +private theorem hsecondsmall : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (p : Fin (4 : ℕ) → + CircleCoordinates), (p (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ))) → (∀ (t : Fin (4 : ℕ) → + CircleCoordinates), (t (0 : Fin (4 : ℕ)) = p (2 : Fin (4 : ℕ))) → ((t 0).1 < (q 0).1))) + := by + classical + intro q hq p h2 t hb0 + calc + (t 0).1 = (q 2).1 := congrArg Prod.fst (hb0.trans h2) + _ < (q 0).1 := hq.2 1 + +private theorem horder23 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (p (2 : Fin (4 : + ℕ)) = q (2 : Fin (4 : ℕ))) → ((p (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ))) → (((p (3 : Fin + (4 : ℕ))).1 < (p (2 : Fin (4 : ℕ))).1) → ((q 3).1 ≤ (q 2).1))) := by + classical + intro q p h2 h3 hlt + have hle := le_of_lt hlt + simpa [h2, h3] using hle + +private theorem hsoddy : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (Fin (4 : ℕ) → + CircleCoordinates) → ((p 1 = (2 * (q 1).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 0).1, 2 * (q + 1).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 0).2)) → (2 * (q 1).1 + 2 * (q 2).1 + 2 * (q 3).1 = + (q 0).1 + (p 1).1)) := by + classical + intro q p t htwin + have hf := congrArg Prod.fst htwin + omega + +private theorem htuple : + ∀ (q : Fin 4 → CircleCoordinates), ![q 0, q 1, q 2, q 3] = q := by + classical + intro q + funext i + fin_cases i <;> rfl + +private theorem hnl'At549 : + ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), (q i).1 ≠ (0 : ℤ)) → ( + let u := BandPackingSymmetryQuadrupleAction .conjugate q + ∀ i : Fin 4, (u i).1 ≠ 0) := by + classical + intro q hnoLine u i + fin_cases i <;> simp? [u, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] <;> + apply hnoLine + +private theorem h0'At562 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (p (0 : Fin (4 : + ℕ)) = q (1 : Fin (4 : ℕ))) → ( + let pr : Fin 4 → CircleCoordinates := p + let u := BandPackingSymmetryQuadrupleAction .conjugate q + let pp := BandPackingSymmetryQuadrupleAction .conjugate pr + ((-1 : Fin 3) = 2) → (((-2 : Fin 3) = 1) → ( + pp 0 = u 1))) := by + classical + intro q p h0 pr u pp negOne negTwo + let reflect : CircleCoordinates → CircleCoordinates := + fun C => (C.1, GaussianReflection C.2) + simpa [u, pp, pr, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, + negOne, negTwo, reflect] using congrArg reflect h0 + +private theorem h2'At566 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (p (3 : Fin (4 : + ℕ)) = q (3 : Fin (4 : ℕ))) → ( + let pr : Fin 4 → CircleCoordinates := p + let u := BandPackingSymmetryQuadrupleAction .conjugate q + let pp := BandPackingSymmetryQuadrupleAction .conjugate pr + ((-1 : Fin 3) = 2) → (((-2 : Fin 3) = 1) → ( + pp 2 = u 2))) := by + classical + intro q p h3 pr u pp negOne negTwo + let reflect : CircleCoordinates → CircleCoordinates := + fun C => (C.1, GaussianReflection C.2) + simpa [u, pp, pr, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, + negOne, negTwo, reflect] using congrArg reflect h3 + +private theorem h3'At570 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (p (2 : Fin (4 : + ℕ)) = q (2 : Fin (4 : ℕ))) → ( + let pr : Fin 4 → CircleCoordinates := p + let u := BandPackingSymmetryQuadrupleAction .conjugate q + let pp := BandPackingSymmetryQuadrupleAction .conjugate pr + ((-1 : Fin 3) = 2) → (((-2 : Fin 3) = 1) → ( + pp 3 = u 3))) := by + classical + intro q p h2 pr u pp negOne negTwo + let reflect : CircleCoordinates → CircleCoordinates := + fun C => (C.1, GaussianReflection C.2) + simpa [u, pp, pr, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, + negOne, negTwo, reflect] using congrArg reflect h2 + +private theorem ht0'At574 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (p (3 : Fin (4 : + ℕ)) = q (3 : Fin (4 : ℕ))) → (∀ (t : Fin (4 : ℕ) → CircleCoordinates), (t (0 : Fin (4 : + ℕ)) = p (3 : Fin (4 : ℕ))) → ( + let tr : Fin 4 → CircleCoordinates := t + let u := BandPackingSymmetryQuadrupleAction .conjugate q + let tt := BandPackingSymmetryQuadrupleAction .conjugate tr + ((-1 : Fin 3) = 2) → (((-2 : Fin 3) = 1) → (tt 0 = u 2)))) := by + classical + intro q p h3 t ht0 tr u tt negOne negTwo + simp [u, tt, tr, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, ht0, h3, + negOne, negTwo] + +private theorem ht1'At577 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (p (2 : Fin (4 : + ℕ)) = q (2 : Fin (4 : ℕ))) → (∀ (t : Fin (4 : ℕ) → CircleCoordinates), (t (1 : Fin (4 : + ℕ)) = p (2 : Fin (4 : ℕ))) → ( + let tr : Fin 4 → CircleCoordinates := t + let u := BandPackingSymmetryQuadrupleAction .conjugate q + let tt := BandPackingSymmetryQuadrupleAction .conjugate tr + ((-1 : Fin 3) = 2) → (((-2 : Fin 3) = 1) → (tt 1 = u 3)))) := by + classical + intro q p h2 t ht1 tr u tt negOne negTwo + simp [u, tt, tr, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, ht1, h2, + negOne, negTwo] + +private theorem hlt2'At580 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple p ∧ q = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin + (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 + : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), + p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) ∧ p + (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ p (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) ∧ (q + (2 : Fin (4 : ℕ))).1 < (q (1 : Fin (4 : ℕ))).1 ∧ (q (3 : Fin (4 : ℕ))).1 < (q (1 : Fin (4 + : ℕ))).1) → ( + let u := BandPackingSymmetryQuadrupleAction .conjugate q + ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → ((u 2).1 < (u 1).1))) := by + classical + intro q p hfirst u negOneSucc negTwoSucc + simpa [u, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, negOneSucc, + negTwoSucc] using hfirst.2.2.2.2.2.2 + +private theorem hlt3'At583 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple p ∧ q = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin + (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 + : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), + p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) ∧ p + (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ p (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) ∧ (q + (2 : Fin (4 : ℕ))).1 < (q (1 : Fin (4 : ℕ))).1 ∧ (q (3 : Fin (4 : ℕ))).1 < (q (1 : Fin (4 + : ℕ))).1) → ( + let u := BandPackingSymmetryQuadrupleAction .conjugate q + ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → ((u 3).1 < (u 1).1))) := by + classical + intro q p hfirst u negOneSucc negTwoSucc + simpa [u, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, negOneSucc, + negTwoSucc] using hfirst.2.2.2.2.2.1 + +private theorem hord'At586 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (p (2 : Fin (4 : + ℕ)) = q (2 : Fin (4 : ℕ))) → ((p (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ))) → (((p (2 : Fin + (4 : ℕ))).1 < (p (3 : Fin (4 : ℕ))).1) → ( + let u := BandPackingSymmetryQuadrupleAction .conjugate q + ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → ((u 3).1 < (u 2).1))))) := by + classical + intro q p h2 h3 hlt u negOneSucc negTwoSucc + simpa [u, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, negOneSucc, + negTwoSucc, h2, h3] using hlt + +private theorem tupleEq : + ∀ (q : Fin 4 → CircleCoordinates), ![q 0, q 1, q 2, q 3] = q := by + classical + intro q + funext i + fin_cases i <;> rfl + +private theorem huAt613 : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ( + let u : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + ProperBandQuadruple u) := by + classical + intro q hq u + refine ⟨SemiProperQuadruple.rotate hq.1, ?_⟩ + intro i + fin_cases i + · simpa [u] using hq.2 1 + · simpa [u] using hq.2 2 + · simpa [u] using hq.2 0 + +private theorem hnl'At620 : + ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), (q i).1 ≠ (0 : ℤ)) → ( + let u : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + ∀ i : Fin 4, (u i).1 ≠ 0) := by + classical + intro q hnoLine u i + fin_cases i <;> simp? [u] <;> apply hnoLine + +private theorem haum'At623 : + ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), (q i).1 = (1 : + ℤ) → (q j).1 = (1 : ℤ) → i = j) → (∀ (p : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple p ∧ ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), + q (1 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * + (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) + * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 + : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ p (2 : Fin (4 : + ℕ)) = q (3 : Fin (4 : ℕ)) ∧ p (3 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) ∧ (q (3 : Fin (4 : + ℕ))).1 < (q (2 : Fin (4 : ℕ))).1 ∧ (q (1 : Fin (4 : ℕ))).1 < (q (2 : Fin (4 : ℕ))).1) → ( + let u : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + ∀ i j : Fin 4, (u i).1 = 1 → (u j).1 = 1 → i = j)) := by + classical + intro q hatMostOneUnit p hsecond u i j hi hj + fin_cases i <;> fin_cases j <;> simp? [u] at hi hj ⊢ <;> + (exfalso; have e := hatMostOneUnit _ _ hi hj; omega) + +private theorem huAt646 : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + ProperBandQuadruple u) := by + classical + intro q hq base u + simpa [u] using BandPackingSymmetryProperCovariance .conjugate _ + (by simpa [base] using (show ProperBandQuadruple base from + ⟨SemiProperQuadruple.rotate hq.1, by + intro i; fin_cases i + · simpa [base] using hq.2 1 + · simpa [base] using hq.2 2 + · simpa [base] using hq.2 0⟩)) + +private theorem hnl'At656 : + ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), (q i).1 ≠ (0 : ℤ)) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + ∀ i : Fin 4, (u i).1 ≠ 0) := by + classical + intro q hnoLine base u i; fin_cases i <;> simp? [u, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] <;> apply hnoLine + +private theorem haum'At660 : + ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), (q i).1 = (1 : + ℤ) → (q j).1 = (1 : ℤ) → i = j) → (∀ (p : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple p ∧ ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), + q (1 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * + (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) + * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 + : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ p (2 : Fin (4 : + ℕ)) = q (3 : Fin (4 : ℕ)) ∧ p (3 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) ∧ (q (3 : Fin (4 : + ℕ))).1 < (q (2 : Fin (4 : ℕ))).1 ∧ (q (1 : Fin (4 : ℕ))).1 < (q (2 : Fin (4 : ℕ))).1) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + ∀ i j : Fin 4, (u i).1 = 1 → (u j).1 = 1 → i = j)) := by + classical + intro q hatMostOneUnit p hsecond base u i j hi hj + fin_cases i <;> fin_cases j <;> simp? [u, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] at hi hj ⊢ <;> + (exfalso; have e := hatMostOneUnit _ _ hi hj; omega) + +private theorem h0'At670 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (p (0 : Fin (4 : + ℕ)) = q (2 : Fin (4 : ℕ))) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + let pp := BandPackingSymmetryQuadrupleAction .conjugate p + ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → ( + pp 0 = u 1))) := by + classical + intro q p h0 base u pp negOneSucc negTwoSucc + let reflect : CircleCoordinates → CircleCoordinates := fun C => (C.1, GaussianReflection + C.2) + simpa [u, pp, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, negOneSucc, + negTwoSucc, reflect] using congrArg reflect h0 + +private theorem h2'At673 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (p (3 : Fin (4 : + ℕ)) = q (1 : Fin (4 : ℕ))) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + let pp := BandPackingSymmetryQuadrupleAction .conjugate p + ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → ( + pp 2 = u 2))) := by + classical + intro q p h3 base u pp negOneSucc negTwoSucc + let reflect : CircleCoordinates → CircleCoordinates := fun C => (C.1, GaussianReflection + C.2) + simpa [u, pp, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, negOneSucc, + negTwoSucc, reflect] using congrArg reflect h3 + +private theorem h3'At676 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (p (2 : Fin (4 : + ℕ)) = q (3 : Fin (4 : ℕ))) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + let pp := BandPackingSymmetryQuadrupleAction .conjugate p + ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → ( + pp 3 = u 3))) := by + classical + intro q p h2 base u pp negOneSucc negTwoSucc + let reflect : CircleCoordinates → CircleCoordinates := fun C => (C.1, GaussianReflection + C.2) + simpa [u, pp, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, negOneSucc, + negTwoSucc, reflect] using congrArg reflect h2 + +private theorem hlt2'At683 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple p ∧ ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), + q (1 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * + (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) + * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 + : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ p (2 : Fin (4 : + ℕ)) = q (3 : Fin (4 : ℕ)) ∧ p (3 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) ∧ (q (3 : Fin (4 : + ℕ))).1 < (q (2 : Fin (4 : ℕ))).1 ∧ (q (1 : Fin (4 : ℕ))).1 < (q (2 : Fin (4 : ℕ))).1) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + (u 2).1 < (u 1).1) := by + classical + intro q p hsecond base u + simpa [u, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] using + hsecond.2.2.2.2.2.2 + +private theorem hlt3'At686 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple p ∧ ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), + q (1 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * + (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) + * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 + : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ p (2 : Fin (4 : + ℕ)) = q (3 : Fin (4 : ℕ)) ∧ p (3 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) ∧ (q (3 : Fin (4 : + ℕ))).1 < (q (2 : Fin (4 : ℕ))).1 ∧ (q (1 : Fin (4 : ℕ))).1 < (q (2 : Fin (4 : ℕ))).1) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + (u 3).1 < (u 1).1) := by + classical + intro q p hsecond base u + simpa [u, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] using + hsecond.2.2.2.2.2.1 + +private theorem hord'At689 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (p (2 : Fin (4 : + ℕ)) = q (3 : Fin (4 : ℕ))) → ((p (3 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ))) → (((p (2 : Fin + (4 : ℕ))).1 < (p (3 : Fin (4 : ℕ))).1) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → ((u 3).1 < (u 2).1))))) := by + classical + intro q p h2 h3 hlt base u negOneSucc negTwoSucc + simpa [u, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, negOneSucc, + negTwoSucc, h2, h3] using hlt + +private theorem huAt713 : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ( + let u : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + ProperBandQuadruple u) := by + classical + intro q hq u + refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1), ?_⟩ + intro i + fin_cases i + · simpa [u] using hq.2 2 + · simpa [u] using hq.2 0 + · simpa [u] using hq.2 1 + +private theorem hnl'At720 : + ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), (q i).1 ≠ (0 : ℤ)) → ( + let u : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + ∀ i : Fin 4, (u i).1 ≠ 0) := by + classical + intro q hnoLine u i + fin_cases i <;> simp? [u] <;> apply hnoLine + +private theorem haum'At723 : + ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), (q i).1 = (1 : + ℤ) → (q j).1 = (1 : ℤ) → i = j) → (∀ (p : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple p ∧ ![q (0 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ)), + q (2 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * + (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) + * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 + : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p (0 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) ∧ p (2 : Fin (4 : + ℕ)) = q (1 : Fin (4 : ℕ)) ∧ p (3 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ (q (1 : Fin (4 : + ℕ))).1 < (q (3 : Fin (4 : ℕ))).1 ∧ (q (2 : Fin (4 : ℕ))).1 < (q (3 : Fin (4 : ℕ))).1) → ( + let u : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + ∀ i j : Fin 4, (u i).1 = 1 → (u j).1 = 1 → i = j)) := by + classical + intro q hatMostOneUnit p hthird u i j hi hj + fin_cases i <;> fin_cases j <;> simp? [u] at hi hj ⊢ <;> + (exfalso; have e := hatMostOneUnit _ _ hi hj; omega) + +private theorem hs'At727 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (![q (0 : Fin (4 + : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p + (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : + ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : + GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p + (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ( + let u : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + u = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) := by + classical + intro q p hsucc u + simpa [u] using hsucc + +private theorem hb : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + ProperBandQuadruple base) := by + classical + intro q hq base + refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1), ?_⟩ + intro i + fin_cases i + · simpa [base] using hq.2 2 + · simpa [base] using hq.2 0 + · simpa [base] using hq.2 1 + +private theorem hnl'At757 : + ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), (q i).1 ≠ (0 : ℤ)) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + ∀ i : Fin 4, (u i).1 ≠ 0) := by + classical + intro q hnoLine base u i; fin_cases i <;> simp? [u, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] <;> apply hnoLine + +private theorem haum'At761 : + ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), (q i).1 = (1 : + ℤ) → (q j).1 = (1 : ℤ) → i = j) → (∀ (p : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple p ∧ ![q (0 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ)), + q (2 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * + (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) + * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 + : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p (0 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) ∧ p (2 : Fin (4 : + ℕ)) = q (1 : Fin (4 : ℕ)) ∧ p (3 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ (q (1 : Fin (4 : + ℕ))).1 < (q (3 : Fin (4 : ℕ))).1 ∧ (q (2 : Fin (4 : ℕ))).1 < (q (3 : Fin (4 : ℕ))).1) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + ∀ i j : Fin 4, (u i).1 = 1 → (u j).1 = 1 → i = j)) := by + classical + intro q hatMostOneUnit p hthird base u i j hi hj + fin_cases i <;> fin_cases j <;> simp? [u, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] at hi hj ⊢ <;> + (exfalso; have e := hatMostOneUnit _ _ hi hj; omega) + +private theorem h0'At771 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (p (0 : Fin (4 : + ℕ)) = q (3 : Fin (4 : ℕ))) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + let pp := BandPackingSymmetryQuadrupleAction .conjugate p + ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → ( + pp 0 = u 1))) := by + classical + intro q p h0 base u pp negOneSucc negTwoSucc + let reflect : CircleCoordinates → CircleCoordinates := fun C => (C.1, GaussianReflection + C.2) + simpa [u, pp, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, negOneSucc, + negTwoSucc, reflect] using congrArg reflect h0 + +private theorem h2'At774 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (p (3 : Fin (4 : + ℕ)) = q (2 : Fin (4 : ℕ))) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + let pp := BandPackingSymmetryQuadrupleAction .conjugate p + ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → ( + pp 2 = u 2))) := by + classical + intro q p h3 base u pp negOneSucc negTwoSucc + let reflect : CircleCoordinates → CircleCoordinates := fun C => (C.1, GaussianReflection + C.2) + simpa [u, pp, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, negOneSucc, + negTwoSucc, reflect] using congrArg reflect h3 + +private theorem h3'At777 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (p (2 : Fin (4 : + ℕ)) = q (1 : Fin (4 : ℕ))) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + let pp := BandPackingSymmetryQuadrupleAction .conjugate p + ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → ( + pp 3 = u 3))) := by + classical + intro q p h2 base u pp negOneSucc negTwoSucc + let reflect : CircleCoordinates → CircleCoordinates := fun C => (C.1, GaussianReflection + C.2) + simpa [u, pp, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, negOneSucc, + negTwoSucc, reflect] using congrArg reflect h2 + +private theorem hlt2'At784 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple p ∧ ![q (0 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ)), + q (2 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * + (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) + * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 + : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p (0 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) ∧ p (2 : Fin (4 : + ℕ)) = q (1 : Fin (4 : ℕ)) ∧ p (3 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ (q (1 : Fin (4 : + ℕ))).1 < (q (3 : Fin (4 : ℕ))).1 ∧ (q (2 : Fin (4 : ℕ))).1 < (q (3 : Fin (4 : ℕ))).1) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + (u 2).1 < (u 1).1) := by + classical + intro q p hthird base u + simpa [u, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] using + hthird.2.2.2.2.2.2 + +private theorem hlt3'At787 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple p ∧ ![q (0 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ)), + q (2 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * + (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) + * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 + : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p (0 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) ∧ p (2 : Fin (4 : + ℕ)) = q (1 : Fin (4 : ℕ)) ∧ p (3 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ (q (1 : Fin (4 : + ℕ))).1 < (q (3 : Fin (4 : ℕ))).1 ∧ (q (2 : Fin (4 : ℕ))).1 < (q (3 : Fin (4 : ℕ))).1) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + (u 3).1 < (u 1).1) := by + classical + intro q p hthird base u + simpa [u, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] using + hthird.2.2.2.2.2.1 + +private theorem hord'At790 : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (p (2 : Fin (4 : + ℕ)) = q (1 : Fin (4 : ℕ))) → ((p (3 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ))) → (((p (2 : Fin + (4 : ℕ))).1 < (p (3 : Fin (4 : ℕ))).1) → ( + let base : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → ((u 3).1 < (u 2).1))))) := by + classical + intro q p h2 h3 hlt base u negOneSucc negTwoSucc + simpa [u, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, negOneSucc, + negTwoSucc, h2, h3] using hlt + +end RetainedBoundaryDetails + +namespace RetainedBoundaryCases + +private theorem firstParentCase : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ((∀ (i : Fin (4 : ℕ)), (q i).1 ≠ + (0 : ℤ)) → ((∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), (q i).1 = (1 : ℤ) → (q j).1 = (1 : + ℤ) → i = j) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), SemiProperQuadruple r → ∀ (i : + Fin (4 : ℕ)), (r i).1 ≠ (0 : ℤ) → (r i).1 = (1 : ℤ) ∨ (4 : ℤ) ≤ (r i).1) → ((∀ (u : + Fin (4 : ℕ) → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), ∀ (t : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple u → (∀ + (i : Fin (4 : ℕ)), (u i).1 ≠ (0 : ℤ)) → (∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), (u + i).1 = (1 : ℤ) → (u j).1 = (1 : ℤ) → i = j) → ProperBandQuadruple p → u = ![((2 : ℤ) * (p + (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : + ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : + GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p + (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))] → p + (0 : Fin (4 : ℕ)) = u (1 : Fin (4 : ℕ)) → p (2 : Fin (4 : ℕ)) = u (2 : Fin (4 : ℕ)) → p + (3 : Fin (4 : ℕ)) = u (3 : Fin (4 : ℕ)) → (u (2 : Fin (4 : ℕ))).1 < (u (1 : Fin (4 : + ℕ))).1 → (u (3 : Fin (4 : ℕ))).1 < (u (1 : Fin (4 : ℕ))).1 → ProperBandQuadruple t → t (0 + : Fin (4 : ℕ)) = u (2 : Fin (4 : ℕ)) → t (1 : Fin (4 : ℕ)) = u (3 : Fin (4 : ℕ)) → (u (3 + : Fin (4 : ℕ))).1 < (u (2 : Fin (4 : ℕ))).1 → Nonempty (BandOrderedGeneralConfiguration + u)) → ((∃ (p : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple p ∧ q = ![((2 : ℤ) * + (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : + ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : + GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p + (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p + (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) ∧ p (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ p + (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) ∧ (q (2 : Fin (4 : ℕ))).1 < (q (1 : Fin (4 : + ℕ))).1 ∧ (q (3 : Fin (4 : ℕ))).1 < (q (1 : Fin (4 : ℕ))).1) → (∃ (r : Fin 3) (g : + BandPackingSymmetry), Nonempty (BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g ![q 0, q r.succ, q (r + 1).succ, q (r + + 2).succ])))))))) := by + classical + intro q hq hnoLine hatMostOneUnit positiveLarge buildConfiguration first + rcases first with ⟨p, hfirst⟩ + have hp := hfirst.1 + have hsucc := hfirst.2.1 + have h0 := hfirst.2.2.1 + have h2 := hfirst.2.2.2.1 + have h3 := hfirst.2.2.2.2.1 + rcases BandOrientedBoundaryParentChain p hp with hsmall | horient + · rcases hsmall with ⟨hroot2, hroot3⟩ + have hone2 := hroot2.resolve_left (by rw [h2]; exact hnoLine 2) + have hone3 := hroot3.resolve_left (by rw [h3]; exact hnoLine 3) + rw [h2] at hone2 + rw [h3] at hone3 + have bad := hatMostOneUnit 2 3 hone2 hone3 + omega + · rcases horient with bd | db + · refine ⟨0, ?_⟩ + rcases bd with ⟨t, ht, hb0, hb1, hlt⟩ + refine ⟨.identity, ?_⟩ + have cq := ProperBandCurvatureStructure q hq + have cp := ProperBandCurvatureStructure p hp + have hp1nonneg' : 0 ≤ (p 1).1 := by simpa using cp.2.1 0 + have hp1lt' : (p 1).1 < (p 0).1 := by simpa using hp.2 0 + have hp2nonneg' : 0 ≤ (p 2).1 := by simpa using cp.2.1 1 + have hp3nonneg' : 0 ≤ (p 3).1 := by simpa using cp.2.1 2 + have hq2nonneg := cq.2.1 1 + have hp2nonneg := cp.2.1 1 + have hp3nonneg := cp.2.1 2 + have hp3 := RetainedBoundaryDetails.hp3 q hnoLine p h3 cp hp3nonneg' + have hp2 := RetainedBoundaryDetails.hp2 q hnoLine p h2 hlt cp hp2nonneg' hp3 + have hq0large := RetainedBoundaryProof.hq0large q hnoLine positiveLarge p + hp hsucc h0 hlt cq cp hp1nonneg' hp1lt' hp3 hp2 + have hq2large := RetainedBoundaryDetails.hq2large q positiveLarge p hp h2 + hlt hp3 hp2 + have htwin := RetainedBoundaryDetails.htwin + q p hsucc h0 h2 h3 + have hfirstsmall : (p 0).1 < (q 0).1 := by + simpa [h0] using hq.2 0 + have hsecondsmall := RetainedBoundaryDetails.hsecondsmall q hq p h2 t + hb0 + have horder23 := RetainedBoundaryDetails.horder23 q p h2 h3 hlt + have hsoddy := RetainedBoundaryDetails.hsoddy q p t htwin + have config := RetainedBoundaryProof.config q hq hnoLine hatMostOneUnit p hfirst hp h0 h2 + h3 t ht + hb0 hb1 cq cp hq0large hq2large htwin hfirstsmall hsecondsmall horder23 hsoddy + have htuple := RetainedBoundaryDetails.htuple q + rw [← htuple] at config + simpa [BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, + BandPackingSymmetryCircleAction] using config + · refine ⟨0, ?_⟩ + rcases db with ⟨t, ht, ht0, ht1, hlt⟩ + let pr : Fin 4 → CircleCoordinates := p + let tr : Fin 4 → CircleCoordinates := t + have hpr : ProperBandQuadruple pr := by + simpa [pr] using hp + have htr : ProperBandQuadruple tr := by + simpa [tr] using ht + have hqr : ProperBandQuadruple q := hq + let u := BandPackingSymmetryQuadrupleAction .conjugate q + let pp := BandPackingSymmetryQuadrupleAction .conjugate pr + let tt := BandPackingSymmetryQuadrupleAction .conjugate tr + have hu : ProperBandQuadruple u := by + simpa [u] using BandPackingSymmetryProperCovariance .conjugate _ hqr + have hp' : ProperBandQuadruple pp := by + simpa [pp] using BandPackingSymmetryProperCovariance .conjugate _ hpr + have ht' : ProperBandQuadruple tt := by + simpa [tt] using BandPackingSymmetryProperCovariance .conjugate _ htr + have hnl' := RetainedBoundaryDetails.hnl'At549 q hnoLine + have haum' := RetainedBoundaryProof.haum'At397 q hatMostOneUnit + have negOneSucc : (-1 : Fin 3).succ = 3 := by decide + have negTwoSucc : (-2 : Fin 3).succ = 2 := by decide + have hs' := RetainedBoundaryProof.hs'At413 q p hsucc negOneSucc negTwoSucc + have negOne : (-1 : Fin 3) = 2 := by decide + have negTwo : (-2 : Fin 3) = 1 := by decide + let reflect : CircleCoordinates → CircleCoordinates := + fun C => (C.1, GaussianReflection C.2) + have h0' := RetainedBoundaryDetails.h0'At562 q p h0 negOne negTwo + have h2' := RetainedBoundaryDetails.h2'At566 q p h3 negOne negTwo + have h3' := RetainedBoundaryDetails.h3'At570 q p h2 negOne negTwo + have ht0' := RetainedBoundaryDetails.ht0'At574 q p h3 t ht0 negOne negTwo + have ht1' := RetainedBoundaryDetails.ht1'At577 q p h2 t ht1 negOne negTwo + have hlt2' := RetainedBoundaryDetails.hlt2'At580 q p hfirst + negOneSucc negTwoSucc + have hlt3' := RetainedBoundaryDetails.hlt3'At583 q p hfirst + negOneSucc negTwoSucc + have hord' := RetainedBoundaryDetails.hord'At586 q p h2 h3 hlt + negOneSucc negTwoSucc + have tupleEq := RetainedBoundaryDetails.tupleEq q + refine ⟨.conjugate, ?_⟩ + simpa [u, tupleEq] using buildConfiguration u pp tt hu hnl' haum' hp' hs' h0' h2' h3' + hlt2' hlt3' ht' ht0' ht1' hord' + +private theorem secondParentCase : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ((∀ (i : Fin (4 : ℕ)), (q i).1 ≠ + (0 : ℤ)) → ((∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), (q i).1 = (1 : ℤ) → (q j).1 = (1 : + ℤ) → i = j) → ((∀ (u : Fin (4 : ℕ) → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), ∀ (t : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple u → + (∀ (i : Fin (4 : ℕ)), (u i).1 ≠ (0 : ℤ)) → (∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), + (u i).1 = (1 : ℤ) → (u j).1 = (1 : ℤ) → i = j) → ProperBandQuadruple + p → u = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : + ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin + (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : + Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p + (3 : Fin (4 : ℕ))] → p (0 : Fin (4 : ℕ)) = u (1 : Fin (4 : ℕ)) → p (2 : Fin (4 : ℕ)) = u + (2 : Fin (4 : ℕ)) → p (3 : Fin (4 : ℕ)) = u (3 : Fin (4 : ℕ)) → (u (2 : Fin (4 : ℕ))).1 < + (u (1 : Fin (4 : ℕ))).1 → (u (3 : Fin (4 : ℕ))).1 < (u (1 : Fin (4 : ℕ))).1 → + ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = u (2 : Fin (4 : ℕ)) → t (1 : Fin (4 : ℕ)) = + u (3 : Fin (4 : ℕ)) → (u (3 : Fin (4 : ℕ))).1 < (u (2 : Fin (4 : ℕ))).1 → Nonempty + (BandOrderedGeneralConfiguration u)) → ((∃ (p : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple p ∧ ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), + q (1 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * + (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) + * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 + : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ p (2 : Fin (4 : + ℕ)) = q (3 : Fin (4 : ℕ)) ∧ p (3 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) ∧ (q (3 : Fin (4 : + ℕ))).1 < (q (2 : Fin (4 : ℕ))).1 ∧ (q (1 : Fin (4 : ℕ))).1 < (q (2 : Fin (4 : ℕ))).1) → + (∃ (r : Fin 3) (g : BandPackingSymmetry), Nonempty (BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g ![q 0, q r.succ, q (r + 1).succ, q (r + + 2).succ]))))))) := by + classical + intro q hq hnoLine hatMostOneUnit buildConfiguration second + rcases second with ⟨p, hsecond⟩ + have hp := hsecond.1 + have hsucc := hsecond.2.1 + have h0 := hsecond.2.2.1 + have h2 := hsecond.2.2.2.1 + have h3 := hsecond.2.2.2.2.1 + rcases BandOrientedBoundaryParentChain p hp with hsmall | horient + · rcases hsmall with ⟨hroot2, hroot3⟩ + have hone3 := hroot2.resolve_left (by rw [h2]; exact hnoLine 3) + have hone1 := hroot3.resolve_left (by rw [h3]; exact hnoLine 1) + rw [h2] at hone3 + rw [h3] at hone1 + have bad := hatMostOneUnit 3 1 hone3 hone1 + omega + · rcases horient with bd | db + · refine ⟨1, ?_⟩ + rcases bd with ⟨t, ht, ht0, ht1, hlt⟩ + let u : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + have hu := RetainedBoundaryDetails.huAt613 q hq + have hnl' := RetainedBoundaryDetails.hnl'At620 q hnoLine + have haum' := RetainedBoundaryDetails.haum'At623 q hatMostOneUnit p hsecond + have hs' : u = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3] := hsucc + have h0' : p 0 = u 1 := by simpa [u] using h0 + have h2' : p 2 = u 2 := by simpa [u] using h2 + have h3' : p 3 = u 3 := by simpa [u] using h3 + have hlt2' : (u 2).1 < (u 1).1 := by simpa [u] using hsecond.2.2.2.2.2.1 + have hlt3' : (u 3).1 < (u 1).1 := by simpa [u] using hsecond.2.2.2.2.2.2 + have hord' : (u 3).1 < (u 2).1 := by simpa [u, h2, h3] using hlt + have hc := buildConfiguration u p t hu hnl' haum' hp hs' h0' h2' h3' + hlt2' hlt3' ht (by simpa [u, h2] using ht0) (by simpa [u, h3] using ht1) hord' + refine ⟨.identity, ?_⟩ + simpa [u, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] using hc + · refine ⟨1, ?_⟩ + rcases db with ⟨t, ht, ht0, ht1, hlt⟩ + let base : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + let pp := BandPackingSymmetryQuadrupleAction .conjugate p + let tt := BandPackingSymmetryQuadrupleAction .conjugate t + have hu := RetainedBoundaryDetails.huAt646 q hq + have hp' : ProperBandQuadruple pp := BandPackingSymmetryProperCovariance .conjugate p hp + have ht' : ProperBandQuadruple tt := BandPackingSymmetryProperCovariance .conjugate t ht + have hnl' := RetainedBoundaryDetails.hnl'At656 q hnoLine + have haum' := RetainedBoundaryDetails.haum'At660 q hatMostOneUnit p hsecond + have negOneSucc : (-1 : Fin 3).succ = 3 := by decide + have negTwoSucc : (-2 : Fin 3).succ = 2 := by decide + have hs' := RetainedBoundaryProof.hs'At528 q p hsucc negOneSucc negTwoSucc + let reflect : CircleCoordinates → CircleCoordinates := fun C => (C.1, GaussianReflection + C.2) + have h0' := RetainedBoundaryDetails.h0'At670 q p h0 negOneSucc negTwoSucc + have h2' := RetainedBoundaryDetails.h2'At673 q p h3 negOneSucc negTwoSucc + have h3' := RetainedBoundaryDetails.h3'At676 q p h2 negOneSucc negTwoSucc + have ht0' : tt 0 = u 2 := by simp [u, tt, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, ht0, h3] + have ht1' : tt 1 = u 3 := by simp [u, tt, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, ht1, h2] + have hlt2' := RetainedBoundaryDetails.hlt2'At683 q p hsecond + have hlt3' := RetainedBoundaryDetails.hlt3'At686 q p hsecond + have hord' := RetainedBoundaryDetails.hord'At689 q p h2 h3 hlt + negOneSucc negTwoSucc + refine ⟨.conjugate, ?_⟩ + simpa [u, base] using buildConfiguration u pp tt hu hnl' haum' hp' hs' h0' h2' h3' + hlt2' hlt3' ht' ht0' ht1' hord' + +private theorem thirdParentCase : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ((∀ (i : Fin (4 : ℕ)), (q i).1 ≠ + (0 : ℤ)) → ((∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), (q i).1 = (1 : ℤ) → (q j).1 = (1 : + ℤ) → i = j) → ((∀ (u : Fin (4 : ℕ) → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), ∀ (t : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple u → + (∀ (i : Fin (4 : ℕ)), (u i).1 ≠ (0 : ℤ)) → (∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), + (u i).1 = (1 : ℤ) → (u j).1 = (1 : ℤ) → i = j) → ProperBandQuadruple + p → u = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : + ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin + (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : + Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p + (3 : Fin (4 : ℕ))] → p (0 : Fin (4 : ℕ)) = u (1 : Fin (4 : ℕ)) → p (2 : Fin (4 : ℕ)) = u + (2 : Fin (4 : ℕ)) → p (3 : Fin (4 : ℕ)) = u (3 : Fin (4 : ℕ)) → (u (2 : Fin (4 : ℕ))).1 < + (u (1 : Fin (4 : ℕ))).1 → (u (3 : Fin (4 : ℕ))).1 < (u (1 : Fin (4 : ℕ))).1 → + ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = u (2 : Fin (4 : ℕ)) → t (1 : Fin (4 : ℕ)) = + u (3 : Fin (4 : ℕ)) → (u (3 : Fin (4 : ℕ))).1 < (u (2 : Fin (4 : ℕ))).1 → Nonempty + (BandOrderedGeneralConfiguration u)) → ((∃ (p : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple p ∧ ![q (0 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ)), + q (2 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * + (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) + * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 + : ℕ)), p (3 : Fin (4 : ℕ))] ∧ p (0 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) ∧ p (2 : Fin (4 : + ℕ)) = q (1 : Fin (4 : ℕ)) ∧ p (3 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ (q (1 : Fin (4 : + ℕ))).1 < (q (3 : Fin (4 : ℕ))).1 ∧ (q (2 : Fin (4 : ℕ))).1 < (q (3 : Fin (4 : ℕ))).1) → + (∃ (r : Fin 3) (g : BandPackingSymmetry), Nonempty (BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g ![q 0, q r.succ, q (r + 1).succ, q (r + + 2).succ]))))))) := by + classical + intro q hq hnoLine hatMostOneUnit buildConfiguration third + rcases third with ⟨p, hthird⟩ + have hp := hthird.1 + have hsucc := hthird.2.1 + have h0 := hthird.2.2.1 + have h2 := hthird.2.2.2.1 + have h3 := hthird.2.2.2.2.1 + rcases BandOrientedBoundaryParentChain p hp with hsmall | horient + · rcases hsmall with ⟨hroot2, hroot3⟩ + have hone1 := hroot2.resolve_left (by rw [h2]; exact hnoLine 1) + have hone2 := hroot3.resolve_left (by rw [h3]; exact hnoLine 2) + rw [h2] at hone1 + rw [h3] at hone2 + have bad := hatMostOneUnit 1 2 hone1 hone2 + omega + · rcases horient with bd | db + · refine ⟨2, ?_⟩ + rcases bd with ⟨t, ht, ht0, ht1, hlt⟩ + let u : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + have hu := RetainedBoundaryDetails.huAt713 q hq + have hnl' := RetainedBoundaryDetails.hnl'At720 q hnoLine + have haum' := RetainedBoundaryDetails.haum'At723 q hatMostOneUnit p hthird + have hs' := RetainedBoundaryDetails.hs'At727 q p hsucc + have h0' : p 0 = u 1 := by simpa [u] using h0 + have h2' : p 2 = u 2 := by simpa [u] using h2 + have h3' : p 3 = u 3 := by simpa [u] using h3 + have hlt2' : (u 2).1 < (u 1).1 := by simpa [u] using hthird.2.2.2.2.2.1 + have hlt3' : (u 3).1 < (u 1).1 := by simpa [u] using hthird.2.2.2.2.2.2 + have hord' : (u 3).1 < (u 2).1 := by simpa [u, h2, h3] using hlt + have hc := buildConfiguration u p t hu hnl' haum' hp hs' h0' h2' h3' + hlt2' hlt3' ht (by simpa [u, h2] using ht0) (by simpa [u, h3] using ht1) hord' + refine ⟨.identity, ?_⟩ + simpa [u, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] using hc + · refine ⟨2, ?_⟩ + rcases db with ⟨t, ht, ht0, ht1, hlt⟩ + let base : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] + let u := BandPackingSymmetryQuadrupleAction .conjugate base + let pp := BandPackingSymmetryQuadrupleAction .conjugate p + let tt := BandPackingSymmetryQuadrupleAction .conjugate t + have hb := RetainedBoundaryDetails.hb q hq + have hu : ProperBandQuadruple u := BandPackingSymmetryProperCovariance .conjugate base hb + have hp' : ProperBandQuadruple pp := BandPackingSymmetryProperCovariance .conjugate p hp + have ht' : ProperBandQuadruple tt := BandPackingSymmetryProperCovariance .conjugate t ht + have hnl' := RetainedBoundaryDetails.hnl'At757 q hnoLine + have haum' := RetainedBoundaryDetails.haum'At761 q hatMostOneUnit p hthird + have negOneSucc : (-1 : Fin 3).succ = 3 := by decide + have negTwoSucc : (-2 : Fin 3).succ = 2 := by decide + have hs' := RetainedBoundaryProof.hs'At631 q p hsucc negOneSucc negTwoSucc + let reflect : CircleCoordinates → CircleCoordinates := fun C => (C.1, GaussianReflection + C.2) + have h0' := RetainedBoundaryDetails.h0'At771 q p h0 negOneSucc negTwoSucc + have h2' := RetainedBoundaryDetails.h2'At774 q p h3 negOneSucc negTwoSucc + have h3' := RetainedBoundaryDetails.h3'At777 q p h2 negOneSucc negTwoSucc + have ht0' : tt 0 = u 2 := by simp [u, tt, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, ht0, h3] + have ht1' : tt 1 = u 3 := by simp [u, tt, base, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, ht1, h2] + have hlt2' := RetainedBoundaryDetails.hlt2'At784 q p hthird + have hlt3' := RetainedBoundaryDetails.hlt3'At787 q p hthird + have hord' := RetainedBoundaryDetails.hord'At790 q p h2 h3 hlt + negOneSucc negTwoSucc + refine ⟨.conjugate, ?_⟩ + simpa [u, base] using buildConfiguration u pp tt hu hnl' haum' hp' hs' h0' h2' h3' + hlt2' hlt3' ht' ht0' ht1' hord' + +end RetainedBoundaryCases + +theorem BandRetainedBoundaryGenealogy + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hnoLine : ∀ i : Fin 4, (q i).1 ≠ 0) + (hatMostOneUnit : ∀ i j : Fin 4, + (q i).1 = 1 → (q j).1 = 1 → i = j) : + ∃ (r : Fin 3) (g : BandPackingSymmetry), + Nonempty (BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ])) := by +-- BODY + have curvatureBound := RetainedBoundaryProof.curvatureBound + have positiveLarge := RetainedBoundaryDetails.positiveLarge curvatureBound + have buildConfiguration := RetainedBoundaryProof.buildConfiguration + positiveLarge + rcases BandParentBoundaryGenealogy q hq with roots | first | second | third + · rcases roots with roots | roots | roots + · exact (hnoLine 2 roots.2.1).elim + · exact (hnoLine 3 roots.2.2).elim + · exact (hnoLine 1 roots.1).elim + · have firstParentCase : + ∃ (r : Fin 3) (g : BandPackingSymmetry), + Nonempty (BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ])) := RetainedBoundaryCases.firstParentCase + q hq hnoLine hatMostOneUnit positiveLarge buildConfiguration first + exact firstParentCase + · have secondParentCase : + ∃ (r : Fin 3) (g : BandPackingSymmetry), + Nonempty (BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ])) := + RetainedBoundaryCases.secondParentCase q hq hnoLine hatMostOneUnit buildConfiguration + second + exact secondParentCase + · have thirdParentCase : + ∃ (r : Fin 3) (g : BandPackingSymmetry), + Nonempty (BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ])) := RetainedBoundaryCases.thirdParentCase + q hq hnoLine hatMostOneUnit buildConfiguration third + exact thirdParentCase +end ApollonianSuperharmonic +end diff --git a/LeanPool/ApollonianSuperharmonic/BandSignedOccurrenceHalfTurn.lean b/LeanPool/ApollonianSuperharmonic/BandSignedOccurrenceHalfTurn.lean new file mode 100644 index 0000000000..32e1e5d604 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandSignedOccurrenceHalfTurn.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.TileArea +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: BandSignedOccurrenceHalfTurn] + +/-! +# BandSignedOccurrenceHalfTurn + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandSignedOccurrenceHalfTurn (q : Fin 4 → CircleCoordinates) + (x : Real × Real) (S : Fin 3 → Bool → ProtoTile) + (hS : ∀ i s, BandPrototile (q i.succ) (S i s)) + (hcent : ∀ i s, + TileCentroid (S i s) - x = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1)))) : + ∀ i : Fin 3, + let w := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let u := GaussianQuarterTurn w - w + (TileTranslation (S i true) u).cells = (S i false).cells ∧ + ((S i true).cells = ∅ → + (TileTranslation (S i true) u).anchor = (S i false).anchor) ∧ + FootprintVertices (TileTranslation (S i true) u) = + FootprintVertices (S i false) ∧ + TileCentroid (TileTranslation (S i true) u) = + TileCentroid (S i false) ∧ + TileArea (S i true) = TileArea (S i false) ∧ + CentrallyReflectedAt x (S i true) (S i false) := by +-- BODY + intro i + dsimp + let w := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let u := GaussianQuarterTurn w - w + have hplus := hcent i true + have hminus := hcent i false + have hu_re : (u.re : Real) = + -(GaussianRealPoint w).1 - (GaussianRealPoint w).2 := by + change (((-w.im - w.re : Int) : Real)) = + -((w.re : Int) : Real) - ((w.im : Int) : Real) + norm_num + ring + have hu_im : (u.im : Real) = + (GaussianRealPoint w).1 - (GaussianRealPoint w).2 := by + change (((w.re - w.im : Int) : Real)) = + ((w.re : Int) : Real) - ((w.im : Int) : Real) + norm_num + have hurexp : (u.re : Real) = + -((BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))).re : Real) - + ((BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))).im : Real) := by + simpa [w, GaussianRealPoint] using hu_re + have huimexp : (u.im : Real) = + ((BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))).re : Real) - + ((BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))).im : Real) := by + simpa [w, GaussianRealPoint] using hu_im + have hcentroid : + TileCentroid (TileTranslation (S i true) u) = TileCentroid (S i false) := by + rw [(TileTranslationFormulas (S i true) u).2.2.2.2.1] + have hre := congrArg Prod.fst hplus + have him := congrArg Prod.snd hplus + have hrem := congrArg Prod.fst hminus + have himm := congrArg Prod.snd hminus + dsimp [w] at hre him hrem himm + dsimp [w, GaussianRealPoint] at hu_re hu_im + have hre' : (TileCentroid (S i true)).1 - x.1 = + (1 / 2 : Real) * + (((w.re : Int) : Real) + ((w.im : Int) : Real)) := by + simpa [w, GaussianRealPoint] using hre + have him' : (TileCentroid (S i true)).2 - x.2 = + (1 / 2 : Real) * + (((w.im : Int) : Real) - ((w.re : Int) : Real)) := by + simpa [w, GaussianRealPoint] using him + have hrem' : (TileCentroid (S i false)).1 - x.1 = + -(1 / 2 : Real) * + (((w.re : Int) : Real) + ((w.im : Int) : Real)) := by + simpa [w, GaussianRealPoint] using hrem + have himm' : (TileCentroid (S i false)).2 - x.2 = + -(1 / 2 : Real) * + (((w.im : Int) : Real) - ((w.re : Int) : Real)) := by + simpa [w, GaussianRealPoint] using himm + apply Prod.ext + · change (TileCentroid (S i true)).1 + (u.re : Real) = _ + rw [hu_re] + linarith [hrem'] + · change (TileCentroid (S i true)).2 + (u.im : Real) = _ + rw [hu_im] + linarith [himm'] + have htranslated : + BandPrototile (q i.succ) (TileTranslation (S i true) u) := by + exact BandPrototileTranslation (q i.succ) (S i true) u (hS i true) + have unique := BandPrototileCentroidUnique (q i.succ) + (TileTranslation (S i true) u) (S i false) htranslated (hS i false) hcentroid + have hcells : (TileTranslation (S i true) u).cells = (S i false).cells := unique.1 + have hempty : (S i true).cells = ∅ → + (TileTranslation (S i true) u).anchor = (S i false).anchor := by + intro h + exact unique.2 ((TileTranslationFormulas (S i true) u).2.2.1.mpr h) + have hfoot : FootprintVertices (TileTranslation (S i true) u) = + FootprintVertices (S i false) := by + by_cases h : (S i true).cells = ∅ + · have hf : (S i false).cells = ∅ := by + rw [← hcells] + exact (TileTranslationFormulas (S i true) u).2.2.1.mpr h + have ht0 : (TileTranslation (S i true) u).cells = ∅ := + (TileTranslationFormulas (S i true) u).2.2.1.mpr h + simp [FootprintVertices, ht0, hf, hempty h] + · have ht : (TileTranslation (S i true) u).cells.Nonempty := by + rw [hcells] + have htne : (TileTranslation (S i true) u).cells ≠ ∅ := + (TileTranslationFormulas (S i true) u).2.2.1.not.mpr h + exact Finset.nonempty_iff_ne_empty.mpr (by + rw [← hcells] + exact htne) + have hfne : (S i false).cells.Nonempty := hcells ▸ ht + rw [FootprintVertices, FootprintVertices] + simp only [ite_eq_left ht, ite_eq_left hfne] + simp [hcells] + have harea : TileArea (S i true) = TileArea (S i false) := by + dsimp [TileArea] + rw [← hcells, (TileTranslationFormulas (S i true) u).1] + symm + apply Finset.card_image_iff.mpr + intro a ha b hb hab + have hre := congrArg Zsqrtd.re hab + have him := congrArg Zsqrtd.im hab + dsimp [GaussianTranslation] at hre him + apply Zsqrtd.ext_iff.mpr + exact ⟨by omega, by omega⟩ + have hcentral : CentrallyReflectedAt (TileCentroid (S i true)) + (S i true) (S i true) := + BandPrototileCentralSymmetry (q i.succ) (S i true) (hS i true) + have hreal : TileRealization (TileTranslation (S i true) u) = + TileRealization (S i false) := by + rw [TileRealization, hcells, TileRealization] + have hreflect : CentrallyReflectedAt x (S i true) (S i false) := by + rw [CentrallyReflectedAt, ← hreal, + (TileTranslationFormulas (S i true) u).2.2.2.1] + nth_rewrite 1 [hcentral] + rw [Set.image_image] + have map_eq : + (fun z : Real × Real => + ((2 * (TileCentroid (S i true)).1 - z.1, 2 * (TileCentroid (S i true)).2 - z.2).1 + + (u.re : Real), + (2 * (TileCentroid (S i true)).1 - z.1, 2 * (TileCentroid (S i true)).2 - z.2).2 + + (u.im : Real))) = + (fun z : Real × Real => (2 * x.1 - z.1, 2 * x.2 - z.2)) := by + funext z + apply Prod.ext + · dsimp + rw [hurexp] + have hx := congrArg Prod.fst hplus + have hr := congrArg Prod.fst hminus + dsimp [w, GaussianRealPoint] at hx hr ⊢ + ring_nf at hx hr ⊢ + linarith + · dsimp + rw [huimexp] + have hy := congrArg Prod.snd hplus + have hi := congrArg Prod.snd hminus + dsimp [w, GaussianRealPoint] at hy hi ⊢ + ring_nf at hy hi ⊢ + linarith + rw [map_eq] + exact ⟨hcells, hempty, hfoot, hcentroid, harea, hreflect⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandSubtileOccurrence.lean b/LeanPool/ApollonianSuperharmonic/BandSubtileOccurrence.lean new file mode 100644 index 0000000000..9802f4c67f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandSubtileOccurrence.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.FootprintVertices + +-- [TABLET NODE: BandSubtileOccurrence] + +/-! +# BandSubtileOccurrence + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For an ordered coordinate quadruple $q=(C_0,C_1,C_2,C_3)$ and a child +prototile $T$, a signed labeled subtile occurrence $S_i^\pm$ is a +prototile for $C_i$ whose footprint lies in that of $T$ and whose centroid +satisfies +$$ + \operatorname{cent}(S_i^\pm)-\operatorname{cent}(T) + =\pm\tfrac12([v_{kj}]-[iv_{kj}]) +$$ +for the corresponding cyclic ordering $(i,j,k)$ of the three parents. +This definition records one labeled occurrence and does not assert that the +quadruple is proper. In particular it also applies to the semiproper unit +configurations containing oriented lines. The assertion that the six +occurrences cover $T$ is stated separately when needed. +-/ +def BandSubtileOccurrence (q : Fin 4 → CircleCoordinates) (T : ProtoTile) + (i : Fin 3) (s : Bool) (S : ProtoTile) : Prop := +-- BODY + BandPrototile (q i.succ) S ∧ + FootprintVertices S ⊆ FootprintVertices T ∧ + TileCentroid S - TileCentroid T = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + ((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1)))) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandSubtileOccurrenceTranslation.lean b/LeanPool/ApollonianSuperharmonic/BandSubtileOccurrenceTranslation.lean new file mode 100644 index 0000000000..67e1109442 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandSubtileOccurrenceTranslation.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: BandSubtileOccurrenceTranslation] + +/-! +# BandSubtileOccurrenceTranslation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandSubtileOccurrenceTranslation : + ∀ (q : Fin 4 → CircleCoordinates) (T S : ProtoTile) + (i : Fin 3) (s : Bool) (u : GaussianInt), + BandSubtileOccurrence q T i s S ↔ + BandSubtileOccurrence q (TileTranslation T u) i s + (TileTranslation S u) := by +-- BODY + intro q T S i s u + have cancel (R : ProtoTile) : + TileTranslation (TileTranslation R u) (-u) = R := by + cases R with + | mk cells anchor => + change ProtoTile.mk ((cells.image (GaussianTranslation u)).image + (GaussianTranslation (-u))) + (GaussianTranslation (-u) (GaussianTranslation u anchor)) = + ProtoTile.mk cells anchor + congr + · ext x + simp [GaussianTranslation, add_assoc, add_comm] + · simp [GaussianTranslation, add_assoc, add_comm] + have forward (A B : ProtoTile) (v : GaussianInt) : + BandSubtileOccurrence q A i s B → + BandSubtileOccurrence q (TileTranslation A v) i s + (TileTranslation B v) := by + intro h + rcases h with ⟨hband, hfoot, hcent⟩ + refine ⟨BandPrototileTranslation (q i.succ) B v hband, ?_, ?_⟩ + · rw [(TileTranslationFormulas B v).2.2.2.2.2.1, + (TileTranslationFormulas A v).2.2.2.2.2.1] + exact Set.image_mono hfoot + · rw [(TileTranslationFormulas B v).2.2.2.2.1, + (TileTranslationFormulas A v).2.2.2.2.1] + simpa [Prod.ext_iff, sub_eq_add_neg, add_assoc, add_comm, add_left_comm, + smul_add] using hcent + constructor + · exact forward T S u + · intro h + have hback := forward (TileTranslation T u) (TileTranslation S u) (-u) h + rw [cancel T, cancel S] at hback + exact hback + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandSuccessorClassification.lean b/LeanPool/ApollonianSuperharmonic/BandSuccessorClassification.lean new file mode 100644 index 0000000000..d06f335c09 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandSuccessorClassification.lean @@ -0,0 +1,118 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity + +-- [TABLET NODE: BandSuccessorClassification] + +/-! +# BandSuccessorClassification + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandSuccessorClassification (q : Fin 4 → CircleCoordinates) + (hq : SemiProperQuadruple q) : + let s : Fin 4 → CircleCoordinates := + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + (s 0).1 = 1 ∨ + (ProperBandQuadruple s ∧ + (q 0).1 < (s 0).1 ∧ + (q 2).1 < (s 0).1 ∧ + (q 3).1 < (s 0).1) := by +-- BODY + have main := SemiProperForestClassification q hq + dsimp + rcases main with ⟨nonneg, cases⟩ + rcases cases with root | root | root | proper + · rcases root with ⟨z, hz⟩ + left + rw [hz] + simp + · rcases root with ⟨z, hz⟩ + right + refine ⟨?_, ?_, ?_, ?_⟩ + · change SemiProperQuadruple _ ∧ _ + refine ⟨SemiProperQuadruple.successor hq, ?_⟩ + intro j + fin_cases j <;> rw [hz] <;> simp + · rw [hz] + simp + · rw [hz] + simp + · rw [hz] + simp + · rcases root with ⟨z, hz⟩ + right + refine ⟨?_, ?_, ?_, ?_⟩ + · change SemiProperQuadruple _ ∧ _ + refine ⟨SemiProperQuadruple.successor hq, ?_⟩ + intro j + fin_cases j <;> rw [hz] <;> simp + · rw [hz] + simp + · rw [hz] + simp + · rw [hz] + simp + · right + refine ⟨?_, ?_, ?_, ?_⟩ + · change SemiProperQuadruple _ ∧ _ + refine ⟨SemiProperQuadruple.successor proper.1, ?_⟩ + have h0 : (q 1).1 < (q 0).1 := by simpa using proper.2 0 + have h1 : (q 2).1 < (q 0).1 := by simpa using proper.2 1 + have h2 : (q 3).1 < (q 0).1 := by simpa using proper.2 2 + intro j + fin_cases j + · have a := nonneg 0 + have b := nonneg 1 + have c := nonneg 2 + have d := nonneg 3 + dsimp + omega + · have a := nonneg 0 + have b := nonneg 1 + have c := nonneg 2 + have d := nonneg 3 + dsimp + omega + · have a := nonneg 0 + have b := nonneg 1 + have c := nonneg 2 + have d := nonneg 3 + dsimp + omega + · have h : (q 1).1 < (q 0).1 := by simpa using proper.2 0 + have a := nonneg 0 + have b := nonneg 1 + have c := nonneg 2 + have d := nonneg 3 + omega + · have h : (q 1).1 < (q 0).1 := by simpa using proper.2 0 + have a := nonneg 0 + have b := nonneg 1 + have c := nonneg 2 + have d := nonneg 3 + omega + · have h : (q 1).1 < (q 0).1 := by simpa using proper.2 0 + have a := nonneg 0 + have b := nonneg 1 + have c := nonneg 2 + have d := nonneg 3 + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandTangency.lean b/LeanPool/ApollonianSuperharmonic/BandTangency.lean new file mode 100644 index 0000000000..af3f17918e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandTangency.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle + +-- [TABLET NODE: BandTangency] + +/-! +# BandTangency + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For raw integral curvature-coordinate pairs $C,D$, the relation +$\operatorname{BandTangency}(C,D)$ holds exactly when there are a +semi-proper Descartes quadruple $q$ and distinct indices +$i,j\in\{0,1,2,3\}$ such that $q_i=C$ and $q_j=D$. If no such quadruple and +indices exist, then $\operatorname{BandTangency}(C,D)$ does not hold. In +particular, the arguments of this ambient relation are not assumed in its +definition to be geometric circles or oriented lines. +-/ +def BandTangency (C D : CircleCoordinates) : Prop := +-- BODY + ∃ q : Fin 4 → CircleCoordinates, SemiProperQuadruple q ∧ + ∃ i j : Fin 4, i ≠ j ∧ q i = C ∧ q j = D + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandTangencyDensity.lean b/LeanPool/ApollonianSuperharmonic/BandTangencyDensity.lean new file mode 100644 index 0000000000..ebcf895fce --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandTangencyDensity.lean @@ -0,0 +1,241 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandDescartesGapSubdivision +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.BandOrientedGapRefinementExists +public import LeanPool.ApollonianSuperharmonic.BandOrientedGapRefinement + +-- [TABLET NODE: BandTangencyDensity] + +/-! +# BandTangencyDensity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandTangencyDensity (C : BandCircle) (p : Complex) + (hp : dist p (BandCircleEuclideanData C).center = + (BandCircleEuclideanData C).radius) (eps : Real) (heps : 0 < eps) : + ∃ D : BandCircle, D ≠ C ∧ + (BandCircleEuclideanData D).radius < eps ∧ + ∃ t : Complex, + dist t p < eps ∧ + dist t (BandCircleEuclideanData C).center = + (BandCircleEuclideanData C).radius ∧ + dist t (BandCircleEuclideanData D).center = + (BandCircleEuclideanData D).radius ∧ + dist (BandCircleEuclideanData C).center + (BandCircleEuclideanData D).center = + (BandCircleEuclideanData C).radius + + (BandCircleEuclideanData D).radius := by +-- BODY + obtain ⟨R⟩ := BandOrientedGapRefinementExists + obtain ⟨seeds, hcover, hseeds⟩ := R.initial_incident_arcs C + have hpSphere : p ∈ Metric.sphere (BandCircleEuclideanData C).center + (BandCircleEuclideanData C).radius := by + exact hp + have hpCover : p ∈ ⋃ ι ∈ seeds, R.gap ι ∩ + Metric.sphere (BandCircleEuclideanData C).center + (BandCircleEuclideanData C).radius := by + rw [← hcover] + exact hpSphere + obtain ⟨ι₀, hp₀⟩ := Set.mem_iUnion.1 hpCover + obtain ⟨hι₀, hp₀⟩ := Set.mem_iUnion.1 hp₀ + obtain ⟨hι₀s, hp₀s, hn₀, hparent₀⟩ := hseeds ι₀ hι₀ + let State := {ι : GaussianInt × Bool × List (Fin 3) // + p ∈ R.gap ι ∩ Metric.sphere (BandCircleEuclideanData C).center + (BandCircleEuclideanData C).radius ∧ + ∃ j : Fin 3, R.presentation ι j.succ = C.1.1} + let digit : State → Fin 3 := fun s => + Classical.choose (Classical.choose_spec + (Classical.choose_spec (R.incident_arc_step C s.1 p s.2.2 s.2.1))) + let next : State → State := fun s => by + have hs := R.incident_arc_step C s.1 p s.2.2 s.2.1 + have h₁ := Classical.choose_spec hs + have h₂ := Classical.choose_spec h₁ + have h₃ := Classical.choose_spec h₂ + have hb : (Classical.choose h₂) ∈ Classical.choose h₁ := h₃.2.1 + have hiff := h₃.2.2.1 + have hpnext := h₃.2.2.2.2.2.1 + refine ⟨(s.1.1, s.1.2.1, s.1.2.2 ++ [digit s]), hpnext, ?_⟩ + exact (hiff (digit s)).mp (by simpa [digit] using hb) + have digit_spec : ∀ s : State, + ∃ t : Complex, ∃ keep : Finset (Fin 3), + ∃ b : Fin 3, b = digit s ∧ keep.card = 2 ∧ b ∈ keep ∧ + (∀ c : Fin 3, c ∈ keep ↔ + ∃ j : Fin 3, + R.presentation (s.1.1, s.1.2.1, s.1.2.2 ++ [c]) j.succ = C.1.1) ∧ + (s.1.1, s.1.2.1, s.1.2.2 ++ [b]) = (next s).1 ∧ + t ∈ R.gap (next s).1 ∩ + Metric.sphere (BandCircleEuclideanData C).center + (BandCircleEuclideanData C).radius ∧ + p ∈ R.gap (next s).1 ∩ + Metric.sphere (BandCircleEuclideanData C).center + (BandCircleEuclideanData C).radius ∧ + R.circle s.1 ≠ C ∧ + (BandCircleEuclideanData (R.circle s.1)).radius < + (BandCircleEuclideanData C).radius ∧ + dist t (BandCircleEuclideanData C).center = + (BandCircleEuclideanData C).radius ∧ + dist t (BandCircleEuclideanData (R.circle s.1)).center = + (BandCircleEuclideanData (R.circle s.1)).radius ∧ + dist (BandCircleEuclideanData C).center + (BandCircleEuclideanData (R.circle s.1)).center = + (BandCircleEuclideanData C).radius + + (BandCircleEuclideanData (R.circle s.1)).radius := by + intro s + have hs := R.incident_arc_step C s.1 p s.2.2 s.2.1 + have h₁ := Classical.choose_spec hs + have h₂ := Classical.choose_spec h₁ + have h₃ := Classical.choose_spec h₂ + rcases h₃ with ⟨hcard, hb, hiff, hsplit, hforall, hpnext, hneq, + hrsmall, htc, htd, hcent⟩ + have htchild := hforall (digit s) (by simpa [digit] using hb) |>.2.2 + refine ⟨Classical.choose hs, Classical.choose h₁, digit s, rfl, hcard, + by simpa [digit] using hb, hiff, rfl, htchild, hpnext, hneq, hrsmall, + htc, htd, hcent⟩ + let s₀ : State := ⟨ι₀, hp₀, hparent₀⟩ + let path : Nat → State := Nat.rec s₀ (fun _ s => next s) + have path_shape : ∀ n, (path n).1 = + (ι₀.1, ι₀.2.1, ι₀.2.2 ++ (List.range n).map (fun k => digit (path k))) := by + intro n + induction n with + | zero => simp [path, s₀] + | succ n ih => + change (next (path n)).1 = + (ι₀.1, ι₀.2.1, ι₀.2.2 ++ + (List.range (n + 1)).map (fun k => digit (path k))) + change ((path n).1.1, (path n).1.2.1, + (path n).1.2.2 ++ [digit (path n)]) = _ + rw [ih, List.range_succ, List.map_append] + simp + let branch : Nat → Fin 3 := fun n => + if h : n < ι₀.2.2.length then ι₀.2.2.get ⟨n, h⟩ + else digit (path (n - ι₀.2.2.length)) + have prefix_map : (List.range ι₀.2.2.length).map branch = ι₀.2.2 := by + have range_fin : (List.finRange ι₀.2.2.length).map Fin.val = + List.range ι₀.2.2.length := by + induction ι₀.2.2.length with + | zero => simp + | succ k ih => + rw [List.finRange_succ, List.range_succ_eq_map] + simp only [List.map_cons, List.map_map] + rw [← ih] + simp only [List.map_map] + congr 1 + rw [← range_fin, List.map_map] + change List.map (fun i => branch i.val) (List.finRange ι₀.2.2.length) = _ + rw [show (fun (i : Fin ι₀.2.2.length) => branch i.val) = + ι₀.2.2.get by + funext i + simp [branch, i.isLt]] + exact List.map_get_finRange ι₀.2.2 + have tail_map (n : Nat) : + (List.range (ι₀.2.2.length + n)).map branch = + ι₀.2.2 ++ (List.range n).map (fun k => digit (path k)) := by + rw [List.range_add, List.map_append, prefix_map] + congr 1 + simp [branch] + have hshrink := R.branch_shrinks ι₀.1 ι₀.2.1 branch + have hdiam : ∀ᶠ n in Filter.atTop, + Metric.diam (R.gap (ι₀.1, ι₀.2.1, + (List.range n).map branch)) < eps := by + filter_upwards [Metric.tendsto_nhds.1 hshrink.1 eps heps] with n hn + simpa only [Real.dist_eq, sub_zero, abs_of_nonneg Metric.diam_nonneg] using hn + have hradius : ∀ᶠ n in Filter.atTop, + (BandCircleEuclideanData (R.circle (ι₀.1, ι₀.2.1, + (List.range n).map branch))).radius < eps := by + filter_upwards [Metric.tendsto_nhds.1 hshrink.2 eps heps] with n hn + simpa only [Real.dist_eq, sub_zero, abs_of_pos + (BandCircleEuclideanData (R.circle (ι₀.1, ι₀.2.1, + (List.range n).map branch))).radius_pos] using hn + have hlarge : ∀ᶠ m in Filter.atTop, ι₀.2.2.length ≤ m := + Filter.eventually_ge_atTop _ + obtain ⟨m, hm⟩ := Filter.Eventually.exists ((hdiam.and hradius).and hlarge) + let n := m - ι₀.2.2.length + have hmn : ι₀.2.2.length + n = m := by + dsimp [n] + exact Nat.add_sub_of_le hm.2 + have hn : Metric.diam (R.gap (ι₀.1, ι₀.2.1, + ι₀.2.2 ++ (List.range n).map (fun k => digit (path k)))) < eps ∧ + (BandCircleEuclideanData (R.circle (ι₀.1, ι₀.2.1, + ι₀.2.2 ++ (List.range n).map (fun k => digit (path k))))).radius < eps := by + have hmn' := hmn + rw [← hmn', tail_map] at hm + exact ⟨hm.1.1, hm.1.2⟩ + have hshape := path_shape n + let D := R.circle (path n).1 + obtain ⟨t, keep, b, hbigit, hcard, hb, hiff, hnext, htarc, hpnext, + hneq, hrsmall, htc, htd, hcent⟩ := digit_spec (path n) + have hpathmem : p ∈ R.gap (path n).1 := (path n).2.1.1 + have hcontained : ∀ (u v : List (Fin 3)), + R.gap (ι₀.1, ι₀.2.1, u ++ v) ⊆ R.gap (ι₀.1, ι₀.2.1, u) := by + intro u v + induction v generalizing u with + | nil => intro x hx; simpa using hx + | cons b v ih => + intro x hx + have hx' : x ∈ R.gap (ι₀.1, ι₀.2.1, u ++ [b] ++ v) := by + simpa [List.append_assoc] using hx + exact R.child_contained (ι₀.1, ι₀.2.1, u) b (ih (u ++ [b]) hx') + have rootBound : Bornology.IsBounded + (R.gap (ι₀.1, ι₀.2.1, [])) := by + apply Metric.isBounded_iff.2 + refine ⟨3, ?_⟩ + intro x hx y hy + by_cases hside : ι₀.2.1 = false + · rw [hside, R.root_left ι₀.1] at hx hy + simp only [Set.mem_ofPred_eq] at hx hy + rw [Complex.dist_eq_re_im] + apply Real.sqrt_le_iff.2 + constructor + · positivity + · nlinarith [sq_nonneg (x.re - y.re), sq_nonneg (x.im - y.im)] + · have hside' : ι₀.2.1 = true := Bool.eq_true_of_not_eq_false hside + rw [hside', R.root_right ι₀.1] at hx hy + simp only [Set.mem_ofPred_eq] at hx hy + rw [Complex.dist_eq_re_im] + apply Real.sqrt_le_iff.2 + constructor + · positivity + · nlinarith [sq_nonneg (x.re - y.re), sq_nonneg (x.im - y.im)] + have hdiamdist : dist p t ≤ Metric.diam (R.gap (path n).1) := by + have hbounded : Bornology.IsBounded (R.gap (path n).1) := by + rw [hshape] + exact rootBound.subset (hcontained [] _) + have htchild : t ∈ R.gap + ((path n).1.1, (path n).1.2.1, (path n).1.2.2 ++ [digit (path n)]) := by + have heq : ((path n).1.1, (path n).1.2.1, + (path n).1.2.2 ++ [digit (path n)]) = (next (path n)).1 := by + simpa [hbigit] using hnext + rw [heq] + simpa [hbigit] using htarc.1 + have htparent : t ∈ R.gap (path n).1 := by + exact R.child_contained (path n).1 (digit (path n)) htchild + apply Metric.dist_le_diam_of_mem hbounded hpathmem + exact htparent + refine ⟨D, ?_, ?_, ?_⟩ + · simpa [D] using hneq + · simpa [D, hshape] using hn.2 + · refine ⟨t, ?_, htc, htd, hcent⟩ + have hn' : Metric.diam (R.gap (path n).1) < eps := by + rw [hshape] + exact hn.1 + simpa [dist_comm] using lt_of_le_of_lt hdiamdist hn' + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean b/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean new file mode 100644 index 0000000000..9c5adebe29 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean @@ -0,0 +1,879 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandInterfaceRootedForest +public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation +public import LeanPool.ApollonianSuperharmonic.BandCanonicalPeriodicExtension +public import LeanPool.ApollonianSuperharmonic.BandCircle +public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryGlobalOdometerTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.DiamondTileAcyclicIndegree +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate +public import LeanPool.ApollonianSuperharmonic.FordTileAcyclicIndegree +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.GaussianReflection +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.ParentalOrientationGluing +public import LeanPool.ApollonianSuperharmonic.PeriodicTileTotalIndegree +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk +public import LeanPool.ApollonianSuperharmonic.P4564T2ElementaryQuarterTurn +public import LeanPool.ApollonianSuperharmonic.P5532T1OrientationPullback +public import LeanPool.ApollonianSuperharmonic.P5532T1SymmetryOrientationTransport +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.P5532T1RestrictionMassBalance +public import LeanPool.ApollonianSuperharmonic.P5532T1ParentInteriorGeometry +public import LeanPool.ApollonianSuperharmonic.P5532T1OverlapNoEntry +public import LeanPool.ApollonianSuperharmonic.P5532T1FiniteOrientationGluing +public import LeanPool.ApollonianSuperharmonic.P5532T1ForestAttachment + +-- [TABLET NODE: BandTileAcyclicIndegree] + +/-! +# BandTileAcyclicIndegree + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace BandAcyclicIndegreeGeometry + +private theorem emptyOrientation : + (by + classical + exact + ∀ (σ : GaussianInt → ℤ), Nonempty (AcyclicIndegreeOrientation (∅ : Finset GaussianInt) σ) + ) := by + classical + intro σ + exact ⟨{ + edge := fun _ _ => False + edge_decidable := fun _ _ => Classical.propDecidable _ + rank := fun _ => 0 + supported := by intro x y he; cases he + oriented := by simp + increasing := by intro x y he; cases he + indegree := by simp }⟩ + +private theorem hemptyAt200 : + (by + classical + exact + ∀ (k : PartialOdometer), ∀ (x : GaussianInt), (k.domain = {x}) → ((k.domain.filter fun y + => @decide (y ∉ BoundaryFootprintVertices (⟨∅, x⟩ : ProtoTile)) + (Classical.propDecidable _)) = ∅) ) := by + classical + intro k x hk + ext y + simp [hk, BoundaryFootprintVertices] + +private theorem bottom : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells = {x}) → ({x, x + 1} ∈ + BoundaryFootprintEdges U) ) := by + classical + intro U x hcell + refine ⟨x, Or.inl ⟨rfl, Or.inl ⟨?_, ?_⟩⟩⟩ + · simp [hcell] + · simp only [hcell, Finset.mem_singleton] + intro hh + have hh' := congrArg Zsqrtd.im hh + simp at hh' + +private theorem left : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells = {x}) → ({x, x + ⟨0, 1⟩} ∈ + BoundaryFootprintEdges U) ) := by + classical + intro U x hcell + refine ⟨x, Or.inr ⟨rfl, Or.inl ⟨?_, ?_⟩⟩⟩ + · simp [hcell] + · simp only [hcell, Finset.mem_singleton] + intro hh + have hh' := congrArg Zsqrtd.re hh + simp at hh' + +private theorem right : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells = {x}) → ({x + 1, x + 1 + ⟨0, 1⟩} ∈ + BoundaryFootprintEdges U) ) := by + classical + intro U x hcell + refine ⟨x + 1, Or.inr ⟨rfl, Or.inr ⟨?_, ?_⟩⟩⟩ + · simp only [hcell, Finset.mem_singleton] + intro hh + have hh' := congrArg Zsqrtd.re hh + simp at hh' + · simp [hcell] + +private theorem hb0 : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → (({x, x + 1} ∈ + BoundaryFootprintEdges U) → (x ∈ BoundaryFootprintVertices U)) ) := by + classical + intro U x hne bottom + rw [BoundaryFootprintVertices, ite_eq_left hne] + exact ⟨{x, x + 1}, bottom, by simp⟩ + +private theorem hb1 : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → (({x, x + 1} ∈ + BoundaryFootprintEdges U) → (x + 1 ∈ BoundaryFootprintVertices U)) ) := by + classical + intro U x hne bottom + rw [BoundaryFootprintVertices, ite_eq_left hne] + exact ⟨{x, x + 1}, bottom, by simp⟩ + +private theorem hbi : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → (({x, x + ⟨0, 1⟩} ∈ + BoundaryFootprintEdges U) → (x + ⟨0, 1⟩ ∈ BoundaryFootprintVertices U)) ) := by + classical + intro U x hne left + rw [BoundaryFootprintVertices, ite_eq_left hne] + exact ⟨{x, x + ⟨0, 1⟩}, left, by simp⟩ + +private theorem hb1i : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → (({x + 1, x + 1 + ⟨0, 1⟩} ∈ + BoundaryFootprintEdges U) → (x + 1 + ⟨0, 1⟩ ∈ BoundaryFootprintVertices U)) ) := by + classical + intro U x hne right + rw [BoundaryFootprintVertices, ite_eq_left hne] + exact ⟨{x + 1, x + 1 + ⟨0, 1⟩}, right, by simp⟩ + +private theorem hemptyAt243 : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ((↑k.domain : Set GaussianInt) = + FootprintVertices U) → (∀ (x : GaussianInt), (U.cells = {x}) → ((U.cells.Nonempty) → + ((x ∈ BoundaryFootprintVertices U) → ((x + 1 ∈ BoundaryFootprintVertices U) → ((x + + ⟨0, 1⟩ ∈ BoundaryFootprintVertices U) → ((x + 1 + ⟨0, 1⟩ ∈ BoundaryFootprintVertices + U) → ((k.domain.filter fun y => @decide (y ∉ BoundaryFootprintVertices U) + (Classical.propDecidable _)) = ∅))))))) ) := by + classical + intro U k hd x hcell hne hb0 hb1 hbi hb1i + ext y + simp only [Finset.mem_filter, decide_eq_true_eq, Finset.notMem_empty, iff_false] + rintro ⟨hy, hnb⟩ + have hyfoot : y ∈ FootprintVertices U := by rw [← hd]; exact hy + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hyfoot + obtain ⟨a, ha, hv⟩ := hyfoot + have hax : a = x := by simpa [hcell] using ha + subst a + rcases hv with hv | hv | hv | hv + · rw [hv] at hnb; exact hnb hb0 + · rw [hv] at hnb; exact hnb hb1 + · rw [hv] at hnb; exact hnb hbi + · rw [hv] at hnb; exact hnb hb1i + +private theorem hcurv : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + (p 0 = BandPackingSymmetryCircleAction s (q 0)) → ((p 0).1 = (q 0).1) ) := by + classical + intro q r s qr p hp0 + rw [hp0] + exact (BandPackingSymmetryCovariance s).1 _ + +private theorem hV : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (BandPrototile (q (0 : Fin (4 + : ℕ))) U) → (∀ (r : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + let V := BandPackingSymmetryTileAction s U + (p 0 = BandPackingSymmetryCircleAction s (q 0)) → (BandPrototile (p 0) V)) ) := by + classical + intro U q hU r s qr p V hp0 + rw [hp0] + exact ((BandPackingSymmetryCovariance s).2.1 _ _).mp hU + +private theorem hl : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + (TileOdometer (q 0) U k) → (∀ (r : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + let V := BandPackingSymmetryTileAction s U + let l := BandPackingSymmetryPartialOdometerAction s k + (p 0 = BandPackingSymmetryCircleAction s (q 0)) → (TileOdometer (p 0) V l)) ) := by + classical + intro U k q hodo r s qr p V l hp0 + rw [hp0] + exact (BandPackingSymmetryTileOdometerCovariance s _ _ _ hodo).1 + +private theorem hroot : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + ∀ (F : FordFareyParameter), (p = FordRecursiveQuadruple F) → (p 0 = FordCircleCoordinate + F.p F.q) ) := by + classical + intro q r s qr p F hpF + rw [hpF] + rfl + +private theorem restrict_dom : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (s : BandPackingSymmetry), + let V := BandPackingSymmetryTileAction s U + let l := BandPackingSymmetryPartialOdometerAction s k + ((l.domain : Set GaussianInt) = FootprintVertices V) → ( + let restrict (W : ProtoTile) : PartialOdometer := + let d := l.domain.filter fun x => decide (x ∈ FootprintVertices W) + { domain := d + value := fun x => if x ∈ d then l.value x else 0 + value_outside := by intro x hx; exact ite_eq_right hx } + ∀ (W : ProtoTile), (FootprintVertices W ⊆ FootprintVertices V) → (((restrict W).domain : + Set GaussianInt) = FootprintVertices W))) := by + classical + intro U k s V l hldom restrict W hW + ext x + simp only [restrict, Finset.mem_coe, Finset.mem_filter, decide_eq_true_eq] + constructor + · exact And.right + · intro hx + exact ⟨(Set.ext_iff.mp hldom x).mpr (hW hx), hx⟩ + +private theorem hls : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r + : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + let V := BandPackingSymmetryTileAction s U + let l := BandPackingSymmetryPartialOdometerAction s k + ∀ (hp : ProperBandQuadruple p), ∀ (hpos : 0 < (p 0).1), (BandPrototile (p 0) V) → + ((TileOdometer (p 0) V l) → (∀ (cfg : BandOrderedGeneralConfiguration p), + let B : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ + ∀ (cert : BandOrderedGeneralLayoutCertificate p cfg B V), + let restrict (W : ProtoTile) : PartialOdometer := + let d := l.domain.filter fun x => decide (x ∈ FootprintVertices W) + { domain := d + value := fun x => if x ∈ d then l.value x else 0 + value_outside := by intro x hx; exact ite_eq_right hx } + let ls := fun i s => restrict (cert.P i s) + (∀ i, ∀ s, ((ls i s).domain : Set GaussianInt) = FootprintVertices (cert.P i s)) → ((∀ i, + ∀ s, ∀ x, x ∈ (ls i s).domain → x ∈ l.domain ∧ l.value x = (ls i s).value x) → (∀ i, + ∀ s, TileOdometer (p i.succ) (cert.P i s) (ls i s)))))) := by + classical + intro U k q r s qr p V l hp hpos hV hl cfg B cert restrict ls hlsdom hlrest i s + apply AncestorOdometerRestriction _ _ _ _ _ l + refine ⟨hl, ?_, hlsdom i s, ?_, ?_⟩ + · exact Relation.ReflTransGen.single + ⟨p, i, s, hp, rfl, rfl, hV, cert.outer_occurrence i s⟩ + · intro x hx + exact (hlrest i s x hx).1 + · intro x hx + exact (hlrest i s x hx).2.symm + +private theorem hOS : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (s : + BandPackingSymmetry), + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + let V := BandPackingSymmetryTileAction s U + ∀ (hp : ProperBandQuadruple p), ∀ (hpos : 0 < (p 0).1), ∀ (cfg : + BandOrderedGeneralConfiguration p), + let B : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ + ∀ (cert : BandOrderedGeneralLayoutCertificate p cfg B V), FootprintVertices cert.O = + FootprintVertices (cert.S 0 true) ) := by + classical + intro U q r s qr p V hp hpos cfg B cert + by_cases hn : cert.O.cells.Nonempty + · have hs : (cert.S 0 true).cells.Nonempty := by + rw [← cert.precursor_cells] + exact hn + simp only [FootprintVertices, ite_eq_left hn, ite_eq_left hs] + rw [cert.precursor_cells] + · have he : cert.O.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hn + have hs : ¬ (cert.S 0 true).cells.Nonempty := by + rw [← cert.precursor_cells] + exact hn + simp only [FootprintVertices, ite_eq_right hn, ite_eq_right hs] + rw [cert.precursor_anchor he] + +private theorem hOparent : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (s : + BandPackingSymmetry), + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + let V := BandPackingSymmetryTileAction s U + ∀ (hp : ProperBandQuadruple p), ∀ (hpos : 0 < (p 0).1), ∀ (cfg : + BandOrderedGeneralConfiguration p), + let B : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ + ∀ (cert : BandOrderedGeneralLayoutCertificate p cfg B V), (FootprintVertices cert.O = + FootprintVertices (cert.S 0 true)) → (∀ s, FootprintVertices cert.O ⊆ + FootprintVertices (cert.P 0 s)) ) := by + classical + intro U q r s qr p V hp hpos cfg B cert hOS s + cases s + · rw [hOS] + exact (cert.minus_occurrence 0 true).2.1 + · rw [cert.precursor_eq] + exact (cert.plus_occurrence 0 false).2.1 + +private theorem hkrest : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r + : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + let V := BandPackingSymmetryTileAction s U + let l := BandPackingSymmetryPartialOdometerAction s k + ∀ (hp : ProperBandQuadruple p), ∀ (hpos : 0 < (p 0).1), ∀ (cfg : + BandOrderedGeneralConfiguration p), + let B : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ + ∀ (cert : BandOrderedGeneralLayoutCertificate p cfg B V), + let restrict (W : ProtoTile) : PartialOdometer := + let d := l.domain.filter fun x => decide (x ∈ FootprintVertices W) + { domain := d + value := fun x => if x ∈ d then l.value x else 0 + value_outside := by intro x hx; exact ite_eq_right hx } + (∀ (W : ProtoTile), ∀ (x : GaussianInt), (x ∈ (restrict W).domain) → (x ∈ l.domain ∧ + l.value x = (restrict W).value x)) → ( + let ls := fun i s => restrict (cert.P i s) + (∀ i, ∀ s, ((ls i s).domain : Set GaussianInt) = FootprintVertices (cert.P i s)) → ((∀ i, + ∀ s, ∀ x, x ∈ (ls i s).domain → x ∈ l.domain ∧ l.value x = (ls i s).value x) → ((∀ s, + FootprintVertices cert.O ⊆ FootprintVertices (cert.P 0 s)) → ( + let ks := fun _ : Bool => restrict cert.O + (∀ s, ((ks s).domain : Set GaussianInt) = FootprintVertices cert.O) → (∀ s, ∀ x, x ∈ (ks + s).domain → x ∈ (ls 0 s).domain ∧ (ls 0 s).value x = (ks s).value x))))) ) := by + classical + intro U k q r s qr p V l hp hpos cfg B cert restrict restrict_rest ls hlsdom hlrest hOparent ks + hksdom s x hx + have hxp : x ∈ (ls 0 s).domain := by + exact (Set.ext_iff.mp (hlsdom 0 s) x).mpr + (hOparent s ((Set.ext_iff.mp (hksdom s) x).mp hx)) + exact ⟨hxp, (hlrest 0 s x hxp).2.symm.trans (restrict_rest _ x hx).2⟩ + +private theorem hOancestor : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (s : + BandPackingSymmetry), + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + let V := BandPackingSymmetryTileAction s U + ∀ (hp : ProperBandQuadruple p), ∀ (hpos : 0 < (p 0).1), ∀ (cfg : + BandOrderedGeneralConfiguration p), + let B : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ + ∀ (cert : BandOrderedGeneralLayoutCertificate p cfg B V), AncestorTile + (cfg.firstPredecessor 1) (p 1) cert.O (cert.P 0 true) ) := by + classical + intro U q r s qr p V hp hpos cfg B cert + rw [cert.precursor_eq] + exact Relation.ReflTransGen.single + ⟨cfg.firstPredecessor, 0, false, cfg.firstProper, cfg.firstChild, rfl, + (cert.outer_occurrence 0 true).1, cert.plus_occurrence 0 false⟩ + +private theorem hks : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r + : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + let V := BandPackingSymmetryTileAction s U + let l := BandPackingSymmetryPartialOdometerAction s k + ∀ (hp : ProperBandQuadruple p), ∀ (hpos : 0 < (p 0).1), ∀ (cfg : + BandOrderedGeneralConfiguration p), + let B : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ + ∀ (cert : BandOrderedGeneralLayoutCertificate p cfg B V), + let restrict (W : ProtoTile) : PartialOdometer := + let d := l.domain.filter fun x => decide (x ∈ FootprintVertices W) + { domain := d + value := fun x => if x ∈ d then l.value x else 0 + value_outside := by intro x hx; exact ite_eq_right hx } + let ls := fun i s => restrict (cert.P i s) + (∀ i, ∀ s, TileOdometer (p i.succ) (cert.P i s) (ls i s)) → ( + let ks := fun _ : Bool => restrict cert.O + (∀ s, ((ks s).domain : Set GaussianInt) = FootprintVertices cert.O) → ((∀ s, ∀ x, x ∈ (ks + s).domain → x ∈ (ls 0 s).domain ∧ (ls 0 s).value x = (ks s).value x) → ((AncestorTile + (cfg.firstPredecessor 1) (p 1) cert.O (cert.P 0 true)) → (∀ s, TileOdometer + (cfg.firstPredecessor 1) cert.O (ks s))))) ) := by + classical + intro U k q r s qr p V l hp hpos cfg B cert restrict ls hls ks hksdom hkrest hOancestor s + exact AncestorOdometerRestriction _ _ _ _ _ (ls 0 true) + ⟨hls 0 true, hOancestor, hksdom s, + (fun x hx => (hkrest true x hx).1), + (fun x hx => (hkrest true x hx).2.symm)⟩ + +private theorem hrest : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r + : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + let V := BandPackingSymmetryTileAction s U + let l := BandPackingSymmetryPartialOdometerAction s k + ∀ (hp : ProperBandQuadruple p), ∀ (hpos : 0 < (p 0).1), ∀ (cfg : + BandOrderedGeneralConfiguration p), + let B : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ + ∀ (cert : BandOrderedGeneralLayoutCertificate p cfg B V), + let restrict (W : ProtoTile) : PartialOdometer := + let d := l.domain.filter fun x => decide (x ∈ FootprintVertices W) + { domain := d + value := fun x => if x ∈ d then l.value x else 0 + value_outside := by intro x hx; exact ite_eq_right hx } + let ls := fun i s => restrict (cert.P i s) + (∀ i, ∀ s, ∀ x, x ∈ (ls i s).domain → x ∈ l.domain ∧ l.value x = (ls i s).value x) → (∀ + (G : IntegerLatticeFunction), (GlobalOdometerExtends G l) → (∀ i, ∀ t, + GlobalOdometerExtends G (ls i t))) ) := by + classical + intro U k q r s qr p V l hp hpos cfg B cert restrict ls hlrest G heG i t + obtain ⟨b, hb⟩ := heG + refine ⟨b, ?_⟩ + intro x hx + rw [hb x (hlrest i t x hx).1, (hlrest i t x hx).2] + +private theorem hkext : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r + : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + let V := BandPackingSymmetryTileAction s U + let l := BandPackingSymmetryPartialOdometerAction s k + ∀ (hp : ProperBandQuadruple p), ∀ (hpos : 0 < (p 0).1), ∀ (cfg : + BandOrderedGeneralConfiguration p), + let B : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ + ∀ (cert : BandOrderedGeneralLayoutCertificate p cfg B V), + let restrict (W : ProtoTile) : PartialOdometer := + let d := l.domain.filter fun x => decide (x ∈ FootprintVertices W) + { domain := d + value := fun x => if x ∈ d then l.value x else 0 + value_outside := by intro x hx; exact ite_eq_right hx } + let ls := fun i s => restrict (cert.P i s) + let ks := fun _ : Bool => restrict cert.O + (∀ s, ∀ x, x ∈ (ks s).domain → x ∈ (ls 0 s).domain ∧ (ls 0 s).value x = (ks s).value x) → + (∀ (G : IntegerLatticeFunction), (∀ i, ∀ t, GlobalOdometerExtends G (ls i t)) → + (GlobalOdometerExtends G (ks true))) ) := by + classical + intro U k q r s qr p V l hp hpos cfg B cert restrict ls ks hkrest G hrest + obtain ⟨b, hb⟩ := hrest 0 true + refine ⟨b, ?_⟩ + intro x hx + rw [hb x (hkrest true x hx).1, (hkrest true x hx).2] + +private theorem kids : + (by + classical + exact + ∀ (n : ℕ), ∀ (U : ProtoTile), ∀ (s : BandPackingSymmetry), + let V := BandPackingSymmetryTileAction s U + ∀ (k : PartialOdometer), + let l := BandPackingSymmetryPartialOdometerAction s k + ∀ (ih : ∀ m < n, + ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (f : + IntegerLatticeFunction), c.1.toNat = m → + TileOdometer c U k → + (↑k.domain : Set GaussianInt) = FootprintVertices U → + GlobalOdometerExtends f k → + let D := k.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices U) (Classical.propDecidable _); + Nonempty (AcyclicIndegreeOrientation D fun (x : GaussianInt) => (2 : ℤ) + + FourNeighborLaplacian f x)), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (hn : + (q (0 : Fin (4 : ℕ))).1.toNat = n), ∀ (r : Fin (3 : ℕ)), + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + ∀ (hp : ProperBandQuadruple p), ∀ (hcurv : (p 0).1 = (q 0).1), ∀ (hpos : 0 < (p 0).1), ∀ + (cfg : BandOrderedGeneralConfiguration p), + let B : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ + ∀ (cert : BandOrderedGeneralLayoutCertificate p cfg B V), + let restrict (W : ProtoTile) : PartialOdometer := + let d := l.domain.filter fun x => decide (x ∈ FootprintVertices W) + { domain := d + value := fun x => if x ∈ d then l.value x else 0 + value_outside := by intro x hx; exact ite_eq_right hx } + let ls := fun i s => restrict (cert.P i s) + (∀ i, ∀ s, ((ls i s).domain : Set GaussianInt) = FootprintVertices (cert.P i s)) → ((∀ i, + ∀ s, TileOdometer (p i.succ) (cert.P i s) (ls i s)) → (∀ (G : + IntegerLatticeFunction), (∀ i, ∀ t, GlobalOdometerExtends G (ls i t)) → ( + let A := fun a : Fin 3 × Bool => (ls a.1 a.2).domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices (cert.P a.1 a.2)) + (Classical.propDecidable _) + let σ := fun x => 2 + FourNeighborLaplacian G x + ∀ a, Nonempty (AcyclicIndegreeOrientation (A a) σ)))) ) := by + classical + intro n U s V k l ih q hn r qr p hp hcurv hpos cfg B cert restrict ls hlsdom hls G hrest A σ a + let D := l.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices V) (Classical.propDecidable _) + have hsmall : (p a.1.succ).1.toNat < n := by + rw [← hn, ← hcurv] + exact (Int.toNat_lt_toNat hpos).mpr (hp.2 a.1) + exact ih _ hsmall _ (cert.P a.1 a.2) (ls a.1 a.2) G rfl + (hls a.1 a.2) (hlsdom a.1 a.2) (hrest a.1 a.2) + +private theorem closed : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r + : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + let V := BandPackingSymmetryTileAction s U + let l := BandPackingSymmetryPartialOdometerAction s k + ∀ (hp : ProperBandQuadruple p), ∀ (hpos : 0 < (p 0).1), ∀ (cfg : + BandOrderedGeneralConfiguration p), + let B : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ + ∀ (cert : BandOrderedGeneralLayoutCertificate p cfg B V), + let restrict (W : ProtoTile) : PartialOdometer := + let d := l.domain.filter fun x => decide (x ∈ FootprintVertices W) + { domain := d + value := fun x => if x ∈ d then l.value x else 0 + value_outside := by intro x hx; exact ite_eq_right hx } + let ls := fun i s => restrict (cert.P i s) + let ks := fun _ : Bool => restrict cert.O + ∀ (G : IntegerLatticeFunction), + let A := fun a : Fin 3 × Bool => (ls a.1 a.2).domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices (cert.P a.1 a.2)) + (Classical.propDecidable _) + let I := (ks true).domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices cert.O) (Classical.propDecidable _) + let σ := fun x => 2 + FourNeighborLaplacian G x + ∀ (kids : ∀ a, Nonempty (AcyclicIndegreeOrientation (A a) σ)), + let os := fun a => Classical.choice (kids a) + ((∑ x ∈ I, σ x) = + (((I.product I).filter fun e => + @decide (FourNeighborAdjacent e.1 e.2) (Classical.propDecidable _)).card / 2 : ℕ)) → + ((∀ (a b : Fin 3 × Bool), a ≠ b → + A a ∩ A b = if a.1 = 0 ∧ b.1 = 0 then I else ∅) → (∀ a, ∀ b, ∀ x ∈ A a ∩ A b, ∀ y ∈ + A a, (os a).edge y x → y ∈ A b)) ) := by + classical + intro U k q r s qr p V l hp hpos cfg B cert restrict ls ks G A I σ kids os mass hpair a b x hx + y hy hexy + by_cases hab : a = b + · simpa [← hab] using hy + by_cases hz : a.1 = 0 ∧ b.1 = 0 + · have hm : (∑ x ∈ A a ∩ A b, σ x) = + (((((A a ∩ A b).product (A a ∩ A b)).filter fun e => + @decide (FourNeighborAdjacent e.1 e.2) (Classical.propDecidable _)).card + / 2 : ℕ) : ℤ) := by + rw [hpair a b hab, ite_eq_left hz] + exact mass + exact (Finset.mem_inter.mp (P5532T1OverlapNoEntry (A a) (A a ∩ A b) + σ Finset.inter_subset_left (os a) hm x hx y hy hexy)).2 + · have hempty : A a ∩ A b = ∅ := by + rw [hpair a b hab, ite_eq_right hz] + simp [hempty] at hx + +private theorem hPo : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r + : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + let V := BandPackingSymmetryTileAction s U + let l := BandPackingSymmetryPartialOdometerAction s k + ∀ (hp : ProperBandQuadruple p), ∀ (hpos : 0 < (p 0).1), ∀ (cfg : + BandOrderedGeneralConfiguration p), + let B : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ + ∀ (cert : BandOrderedGeneralLayoutCertificate p cfg B V), + let restrict (W : ProtoTile) : PartialOdometer := + let d := l.domain.filter fun x => decide (x ∈ FootprintVertices W) + { domain := d + value := fun x => if x ∈ d then l.value x else 0 + value_outside := by intro x hx; exact ite_eq_right hx } + let ls := fun i s => restrict (cert.P i s) + ∀ (G : IntegerLatticeFunction), + let D := l.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices V) (Classical.propDecidable _) + let A := fun a : Fin 3 × Bool => (ls a.1 a.2).domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices (cert.P a.1 a.2)) + (Classical.propDecidable _) + let σ := fun x => 2 + FourNeighborLaplacian G x + (AcyclicIndegreeOrientation (Finset.univ.biUnion A) σ) → ( + let P := D.filter fun x => @decide (∃ i t, x ∈ (ls i t).domain ∧ + x ∉ BoundaryFootprintVertices (cert.P i t)) (Classical.propDecidable _) + (Finset.univ.biUnion A = P) → (Nonempty (AcyclicIndegreeOrientation P σ))) ) := by + classical + intro U k q r s qr p V l hp hpos cfg B cert restrict ls G D A σ oUnion P hUnion + rw [← hUnion] + exact ⟨oUnion⟩ + +end BandAcyclicIndegreeGeometry + +theorem BandTileAcyclicIndegree : + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (g : + IntegerLatticeFunction), (BandPrototile C.1.1 T) → ((TileOdometer C.1.1 T h) → + (((h.domain : Set GaussianInt) = FootprintVertices T) → ((GlobalOdometerExtends g h) → ( + let D := h.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _) + Nonempty (AcyclicIndegreeOrientation D + (fun x => 2 + FourNeighborLaplacian g x)))))) := by + intro C T h g hT hodo hdom hext +-- BODY + classical + have emptyOrientation := BandAcyclicIndegreeGeometry.emptyOrientation + have main : ∀ n : ℕ, ∀ (c : CircleCoordinates) (U : ProtoTile) + (k : PartialOdometer) (f : IntegerLatticeFunction), + c.1.toNat = n → TileOdometer c U k → + (k.domain : Set GaussianInt) = FootprintVertices U → + GlobalOdometerExtends f k → + let D := k.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices U) (Classical.propDecidable _) + Nonempty (AcyclicIndegreeOrientation D + (fun x => 2 + FourNeighborLaplacian f x)) := by + intro n + induction n using Nat.strong_induction_on with + | h n ih => + intro c U k f hn ho hd he + cases ho with + | line w x hw k hk => + have hempty : (k.domain.filter fun y => + @decide (y ∉ BoundaryFootprintVertices (⟨∅, x⟩ : ProtoTile)) + (Classical.propDecidable _)) = ∅ := BandAcyclicIndegreeGeometry.hemptyAt200 k x hk + dsimp only + rw [hempty] + exact emptyOrientation _ + | unit z x U k hcell hdomain htrans => + have hne : U.cells.Nonempty := by rw [hcell]; simp + have bottom := BandAcyclicIndegreeGeometry.bottom U x hcell + have hempty : (k.domain.filter fun y => + @decide (y ∉ BoundaryFootprintVertices U) (Classical.propDecidable _)) = ∅ := + BandAcyclicIndegreeGeometry.hemptyAt243 U k hd x hcell hne + (BandAcyclicIndegreeGeometry.hb0 U x hne bottom) (BandAcyclicIndegreeGeometry.hb1 + U x hne bottom) (BandAcyclicIndegreeGeometry.hbi U x hne + (BandAcyclicIndegreeGeometry.left U x hcell)) (BandAcyclicIndegreeGeometry.hb1i U + x hne (BandAcyclicIndegreeGeometry.right U x hcell)) + dsimp only + rw [hempty] + exact emptyOrientation _ + | @decompose q hq S U hs k hU hsub hcells hfoot hcentroid hdomain + hvalue hcompat hslope => + have hodo : TileOdometer (q 0) U k := TileOdometer.decompose hq hU hsub + hcells hfoot hcentroid hdomain hvalue hcompat hslope + obtain ⟨r, s, hregime⟩ := BandRegimeClassification q hq + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let p := BandPackingSymmetryQuadrupleAction s qr + let V := BandPackingSymmetryTileAction s U + let l := BandPackingSymmetryPartialOdometerAction s k + have hqr : ProperBandQuadruple qr := + (BandParentRotationOccurrenceCovariance q hq r U hU S + (fun i t => ⟨TileOdometerBandPrototile _ _ _ (hsub i t), + hfoot i t, hcentroid i t⟩) hcells).1 + have hp : ProperBandQuadruple p := BandPackingSymmetryProperCovariance s qr hqr + have hp0 : p 0 = BandPackingSymmetryCircleAction s (q 0) := by + simp [p, qr, BandPackingSymmetryQuadrupleAction] + have hcurv := BandAcyclicIndegreeGeometry.hcurv q r s hp0 + have hpos : 0 < (p 0).1 := (ProperBandCurvatureStructure p hp).1 + have hV : BandPrototile (p 0) V := BandAcyclicIndegreeGeometry.hV U q hU r s hp0 + have hl : TileOdometer (p 0) V l := BandAcyclicIndegreeGeometry.hl U k q hodo r s hp0 + have hldom : (l.domain : Set GaussianInt) = FootprintVertices V := + PositiveCurvatureTileOdometerDomain _ _ _ hpos hl + obtain ⟨f', he', htransport⟩ := + P5532T1SymmetryOrientationTransport s (q 0) U k f hodo he + apply htransport.mpr + change Nonempty (AcyclicIndegreeOrientation + (l.domain.filter fun x => @decide (x ∉ BoundaryFootprintVertices V) + (Classical.propDecidable _)) (fun x => 2 + FourNeighborLaplacian f' x)) + change Xor (∃ F : FordFareyParameter, 1 < F.q ∧ p = FordRecursiveQuadruple F) + (Xor (∃ K : DiamondParameter, 1 < K.1 ∧ p = DiamondRecursiveQuadruple K) + (Nonempty (BandOrderedGeneralConfiguration p))) at hregime + rcases hregime with ⟨⟨F, hF, hpF⟩, _⟩ | ⟨hregime, _⟩ + · have hroot : p 0 = FordCircleCoordinate F.p F.q := BandAcyclicIndegreeGeometry.hroot q + r s F hpF + exact FordTileAcyclicIndegree F V l f' (hroot ▸ hV) (hroot ▸ hl) hldom he' + rcases hregime with ⟨⟨K, hK, hpK⟩, _⟩ | ⟨⟨cfg⟩, _⟩ + · exact DiamondTileAcyclicIndegree K V l f' + (congrFun hpK 0 ▸ hV) (congrFun hpK 0 ▸ hl) hldom he' + let B : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ + obtain ⟨cert⟩ := BandOrderedGeneralLayout p cfg B rfl V hV + (by + intro t W Z ht hW hZ hcov hsmall + have htall := BandTileSimultaneousInduction t ht W hW + exact ⟨htall.1, htall.2.1, htall.2.2.1 Z hZ hcov⟩) + (by + intro c W hW hsmall + cases hW with + | line w a hw => exact (P4564T2ElementaryQuarterTurn 0 a).1 + | unit z a anchor => exact (P4564T2ElementaryQuarterTurn a anchor).2 + | @decompose t ht Z W hZ hcov hfo hce => + exact (BandTileSimultaneousInduction t ht W + (BandPrototile.decompose ht hZ hcov hfo hce)).2.2.2.1) + (by + intro t W Z ht hW hsmall hlarge i hZ hce + exact (BandTileSimultaneousInduction t ht W hW).2.2.2.2.2.1 + hlarge i Z hZ hce) + (by + intro t W Z Z' ht hW hsmall i hZ hZ' hce hce' + exact (BandTileSimultaneousInduction t ht W hW).2.2.2.2.2.2.1 + i Z Z' hZ hZ' hce hce') + let restrict (W : ProtoTile) : PartialOdometer := + let d := l.domain.filter fun x => decide (x ∈ FootprintVertices W) + { domain := d + value := fun x => if x ∈ d then l.value x else 0 + value_outside := by intro x hx; exact ite_eq_right hx } + have restrict_dom := BandAcyclicIndegreeGeometry.restrict_dom U k s hldom + have restrict_rest (W : ProtoTile) (x : GaussianInt) + (hx : x ∈ (restrict W).domain) : + x ∈ l.domain ∧ l.value x = (restrict W).value x := + ⟨(Finset.mem_filter.mp hx).1, (ite_eq_left hx).symm⟩ + let ls := fun i s => restrict (cert.P i s) + have hlsdom : ∀ i s, ((ls i s).domain : Set GaussianInt) = + FootprintVertices (cert.P i s) := fun i s => + restrict_dom _ (cert.outer_occurrence i s).2.1 + have hlrest : ∀ i s x, x ∈ (ls i s).domain → + x ∈ l.domain ∧ l.value x = (ls i s).value x := fun i s x hx => + restrict_rest _ x hx + have hls := BandAcyclicIndegreeGeometry.hls U k q r s hp hpos hV hl cfg cert hlsdom hlrest + have hOparent := BandAcyclicIndegreeGeometry.hOparent U q r s hp hpos cfg cert + (BandAcyclicIndegreeGeometry.hOS U q r s hp hpos cfg cert) + let ks := fun _ : Bool => restrict cert.O + have hksdom : ∀ s, ((ks s).domain : Set GaussianInt) = + FootprintVertices cert.O := fun _ => + restrict_dom _ ((hOparent true).trans (cert.outer_occurrence 0 true).2.1) + have hkrest := BandAcyclicIndegreeGeometry.hkrest U k q r s hp hpos cfg cert + restrict_rest hlsdom hlrest hOparent hksdom + have hks := BandAcyclicIndegreeGeometry.hks U k q r s hp hpos cfg cert hls hksdom hkrest + (BandAcyclicIndegreeGeometry.hOancestor U q r s hp hpos cfg cert) + obtain ⟨G, heG, hlat, htile, hweb, hperiod, hlap⟩ := + BandCanonicalPeriodicExtension B p hp rfl V l f' hV hl hldom he' + have hrest := BandAcyclicIndegreeGeometry.hrest U k q r s hp hpos cfg cert hlrest G heG + let D := l.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices V) (Classical.propDecidable _) + let A := fun a : Fin 3 × Bool => (ls a.1 a.2).domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices (cert.P a.1 a.2)) + (Classical.propDecidable _) + let I := (ks true).domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices cert.O) (Classical.propDecidable _) + let σ := fun x => 2 + FourNeighborLaplacian G x + have kids := BandAcyclicIndegreeGeometry.kids n U s k ih q hn r hp hcurv hpos cfg cert + hlsdom hls G hrest + let os := fun a => Classical.choice (kids a) + have mass := P5532T1RestrictionMassBalance (cfg.firstPredecessor 1) + cert.O (ks true) G (hks true) (hksdom true) (BandAcyclicIndegreeGeometry.hkext U k q r + s hp hpos cfg cert hkrest G hrest) + obtain ⟨hAD, hpair, hcross, hUnion⟩ := P5532T1ParentInteriorGeometry + B p cfg V cert l ls (ks true) hlat hldom hlsdom (hksdom true) + have closed := BandAcyclicIndegreeGeometry.closed U k q r s hp hpos cfg cert G kids mass + hpair + obtain ⟨oUnion, _⟩ := P5532T1FiniteOrientationGluing A σ os hcross closed + let P := D.filter fun x => @decide (∃ i t, x ∈ (ls i t).domain ∧ + x ∉ BoundaryFootprintVertices (cert.P i t)) (Classical.propDecidable _) + change Finset.univ.biUnion A = P at hUnion + have hPo := BandAcyclicIndegreeGeometry.hPo U k q r s hp hpos cfg cert G oUnion hUnion + obtain ⟨R, hf, hcard, hres⟩ := BandInterfaceRootedForest B p cfg V cert l ls G + hV hlat hl hldom hls hlsdom heG hrest htile hweb hperiod hPo + obtain ⟨oD, _⟩ := P5532T1ForestAttachment D P R σ (Finset.filter_subset _ _) + (Classical.choice hPo) hf hres + exact P5532T1OrientationPullback D D + (fun x => 2 + FourNeighborLaplacian f' x) σ id (by simp) (fun _ _ h => h) + (fun _ _ => Iff.rfl) + (by + intro x hx + have hx' := Finset.mem_filter.mp hx + have hnb : x ∉ BoundaryFootprintVertices V := + @of_decide_eq_true _ (Classical.propDecidable _) hx'.2 + dsimp [σ] + rw [hlap x hx'.1 hnb]) oD + exact main _ C.1.1 T h g rfl hodo hdom hext + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandTileSimultaneousInduction.lean b/LeanPool/ApollonianSuperharmonic/BandTileSimultaneousInduction.lean new file mode 100644 index 0000000000..7944e6c72e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandTileSimultaneousInduction.lean @@ -0,0 +1,788 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4564T2ElementaryQuarterTurn +public import LeanPool.ApollonianSuperharmonic.P4564T2FordGeometry +public import LeanPool.ApollonianSuperharmonic.P4564T2DiamondGeometry +public import LeanPool.ApollonianSuperharmonic.P4564T2GeometryPullback +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.P4564T2FordT6Transport +public import LeanPool.ApollonianSuperharmonic.P4564T2GeneralT6Transport +public import LeanPool.ApollonianSuperharmonic.P4564T2DiamondOrderExclusion +public import LeanPool.ApollonianSuperharmonic.TileT1DiskArea +public import LeanPool.ApollonianSuperharmonic.TileT2QuarterTurn +public import LeanPool.ApollonianSuperharmonic.TileT3TranslateTouching +public import LeanPool.ApollonianSuperharmonic.TileT4ParentTranslateTouching +public import LeanPool.ApollonianSuperharmonic.TileT5ParentTouching +public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRawSupport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryT3T5Covariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport +public import LeanPool.ApollonianSuperharmonic.BandParentRotationOccurrenceCovariance +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import LeanPool.ApollonianSuperharmonic.DiamondBaseT1 +public import LeanPool.ApollonianSuperharmonic.DiamondBaseT2 +public import LeanPool.ApollonianSuperharmonic.DiamondBaseTouching +public import LeanPool.ApollonianSuperharmonic.FordBaseT1 +public import LeanPool.ApollonianSuperharmonic.FordBaseT2 +public import LeanPool.ApollonianSuperharmonic.FordBaseT6 +public import LeanPool.ApollonianSuperharmonic.FordBaseTouching +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance +public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretationCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle +public import LeanPool.ApollonianSuperharmonic.BandCircle +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate +public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse +public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import LeanPool.ApollonianSuperharmonic.TileArea + +-- [TABLET NODE: BandTileSimultaneousInduction] + +/-! +# BandTileSimultaneousInduction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +private def tileInductionConclusion (q : Fin 4 → CircleCoordinates) (T : ProtoTile) + (m : ℕ) : Prop := + LatticeTile T ∧ TileArea T = m ∧ + (∀ (S : Fin 3 → Bool → ProtoTile), + (∀ i s, BandSubtileOccurrence q T i s (S i s)) → + (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (S i s).cells) → + ∀ i s, LatticeTile (TileCellComplement T (S i s)) ∧ + TileTouching (TileCellComplement T (S i s)) (S i s)) ∧ + QuarterTurnSymmetric T ∧ + (1 < (q 0).1 → ∀ i : Fin 3, + TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) + (TileTranslation T + (-BandVectors.1 (q ((i + 1).succ)) (q 0)))) ∧ + (1 < (q 0).1 → ∀ (i : Fin 3) (U : ProtoTile), + BandPrototile (q i.succ) U → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U) ∧ + (∀ (i : Fin 3) (U V : ProtoTile), + BandPrototile (q i.succ) U → + BandPrototile (q ((i + 1).succ)) V → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ)))) → + TouchingTriple T U V) ∧ + (∀ (r : Fin 4 → CircleCoordinates), ProperBandQuadruple r → + r 0 = q 1 → r 2 = q 2 → r 3 = q 3 → + (q 2).1 ≤ (q 1).1 → (q 3).1 ≤ (q 2).1 → + 1 < (q 2).1 → + ∀ (P Q S : Fin 3 → Bool → ProtoTile), + (∀ i s, BandSubtileOccurrence q T i s (P i s)) → + (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (P i s).cells) → + (∀ i s, BandSubtileOccurrence r (P 0 true) i s (Q i s)) → + (∀ x, x ∈ (P 0 true).cells ↔ ∃ i s, x ∈ (Q i s).cells) → + (∀ i s, BandSubtileOccurrence r (P 0 false) i s (S i s)) → + (∀ x, x ∈ (P 0 false).cells ↔ ∃ i s, x ∈ (S i s).cells) → + (let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + (∀ a b : PeriodicSubtileIndex, a ≠ b → + ((FootprintEdges (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty → + AllowedSubtileIncidence a b) ∧ + (¬ AllowedSubtileIncidence a b → + FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ + FootprintVertices (P 0 true) ∩ FootprintVertices (P 1 true) ⊆ + FootprintVertices (Q 1 true) ∩ FootprintVertices (P 1 true) ∧ + FootprintVertices (P 0 true) ∩ FootprintVertices (P 0 false) ⊆ + (FootprintVertices (Q 1 true) ∩ FootprintVertices (S 2 false)) ∪ + FootprintVertices (Q 0 false) ∪ + (FootprintVertices (Q 2 true) ∩ + FootprintVertices (S 1 false)))) + +private def tileInductionHypothesis (n : ℕ) : Prop := + ∀ m < n, ∀ (q : Fin 4 → CircleCoordinates), ProperBandQuadruple q → + ∀ (T : ProtoTile), BandPrototile (q 0) T → Int.toNat (q 0).1 = m → + tileInductionConclusion q T m + +namespace TileInductionGeometry + +private theorem smallT1 : + (by + classical + exact + ∀ (n : ℕ), tileInductionHypothesis n → + (∀ (p : Fin 4 → + CircleCoordinates), ∀ + (U : ProtoTile), ∀ (S : + Fin 3 → Bool → + ProtoTile), + ProperBandQuadruple p → + BandPrototile (p 0) U → + (∀ i, ∀ s, + BandSubtileOccurrence p + U i s (S i s)) → (∀ x, + x ∈ U.cells ↔ ∃ i s, x + ∈ (S i s).cells) → + Int.toNat (p 0).1 < n → + LatticeTile U ∧ + TileArea U = Int.toNat + (p 0).1 ∧ ∀ i, ∀ s, + LatticeTile + (TileCellComplement U + (S i s)) ∧ TileTouching + (TileCellComplement U + (S i s)) (S i s)) ) := by + classical + intro n ih p U S hp hU hS hcover hlt + have h := ih _ hlt p hp U hU rfl + exact ⟨h.1, h.2.1, h.2.2.1 S hS hcover⟩ + +private theorem smallT2 : + (by + classical + exact + ∀ (n : ℕ), tileInductionHypothesis n → + (∀ (D : + CircleCoordinates), ∀ + (U : ProtoTile), + BandPrototile D U → + Int.toNat D.1 < n → + QuarterTurnSymmetric U) + ) := by + classical + intro n ih D U hU hlt + cases hU with + | line w x hw => + exact (P4564T2ElementaryQuarterTurn x x).1 + | unit z x anchor => + exact (P4564T2ElementaryQuarterTurn x anchor).2 + | @decompose p hp S U hS hcells hfoot hcent => + exact (ih _ hlt p hp U + (BandPrototile.decompose hp hS hcells hfoot hcent) rfl).2.2.2.1 + +private theorem smallT4 : + (by + classical + exact + ∀ (n : ℕ), tileInductionHypothesis n → + (∀ (p : Fin 4 → + CircleCoordinates), ∀ + (U : ProtoTile), ∀ (V : + ProtoTile), + ProperBandQuadruple p → + BandPrototile (p 0) U → + Int.toNat (p 0).1 < n → + 1 < (p 0).1 → ∀ i : Fin + 3, BandPrototile (p + i.succ) V → + TileCentroid V - + TileCentroid U = (1 / 2 + : Real) • + (GaussianRealPoint + (BandVectors.1 (p + i.succ) (p 0)) + + GaussianRealPoint + (BandVectors.1 (p 0) (p + i.succ))) → + TouchingTriple U + (TileTranslation U + (BandVectors.1 (p + i.succ) (p 0))) V) ) := by + classical + intro n ih p U V hp hU hlt hc i hV hcent + exact (ih _ hlt p hp U hU rfl).2.2.2.2.2.1 hc i V hV hcent + +private theorem smallT5 : + (by + classical + exact + ∀ (n : ℕ), tileInductionHypothesis n → + (∀ (p : Fin 4 → + CircleCoordinates), ∀ + (U : ProtoTile), ∀ (V : + ProtoTile), ∀ (W : + ProtoTile), + ProperBandQuadruple p → + BandPrototile (p 0) U → + Int.toNat (p 0).1 < n → + ∀ i : Fin 3, + BandPrototile (p + i.succ) V → + BandPrototile (p ((i + + 1).succ)) W → + TileCentroid V - + TileCentroid U = (1 / 2 + : Real) • + (GaussianRealPoint + (BandVectors.1 (p + i.succ) (p 0)) + + GaussianRealPoint + (BandVectors.1 (p 0) (p + i.succ))) → + TileCentroid W - + TileCentroid U = (1 / 2 + : Real) • + (GaussianRealPoint + (BandVectors.1 (p ((i + + 1).succ)) (p 0)) - + GaussianRealPoint + (BandVectors.1 (p 0) (p + ((i + 1).succ)))) → + TouchingTriple U V W) ) + := by + classical + intro n ih p U V W hp hU hlt i hV hW hcV hcW + exact (ih _ hlt p hp U hU rfl).2.2.2.2.2.2.1 i V W hV hW hcV hcW + +private theorem hqa : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (a : Fin (3 : ℕ)), ∀ (raw + : BandPackingSymmetry), ( + let q' := BandPackingSymmetryQuadrupleAction raw ![q (0 : Fin (4 : ℕ)), q a.succ, q (a + + (1 : Fin (3 : ℕ))).succ, q (a + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : + FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : + DiamondParameter), (1 : ℕ) < K.1 ∧ q' = DiamondRecursiveQuadruple K) (Nonempty + (BandOrderedGeneralConfiguration q')))) → ( + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + ProperBandQuadruple qa)) ) := by + classical + intro q hq a raw regimes qa + fin_cases a + · have heq : qa = q := by funext i; fin_cases i <;> rfl + exact heq.symm ▸ hq + · refine ⟨SemiProperQuadruple.rotate hq.1, ?_⟩ + intro i + fin_cases i + · exact hq.2 1 + · exact hq.2 2 + · exact hq.2 0 + · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1), ?_⟩ + intro i + fin_cases i + · exact hq.2 2 + · exact hq.2 0 + · exact hq.2 1 + +private theorem hregimes : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (a : Fin (3 : ℕ)), ∀ (raw : BandPackingSymmetry), ( + let q' := BandPackingSymmetryQuadrupleAction raw ![q (0 : Fin (4 : ℕ)), q a.succ, q (a + + (1 : Fin (3 : ℕ))).succ, q (a + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : + FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : + DiamondParameter), (1 : ℕ) < K.1 ∧ q' = DiamondRecursiveQuadruple K) (Nonempty + (BandOrderedGeneralConfiguration q')))) → ( + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + ∀ (g : BandPackingSymmetry), (∀ (p : Fin (4 : ℕ) → CircleCoordinates), + BandPackingSymmetryQuadrupleAction g p = BandPackingSymmetryQuadrupleAction raw p) → ( + let qg := BandPackingSymmetryQuadrupleAction g qa + Xor (∃ F : FordFareyParameter, 1 < F.q ∧ qg = FordRecursiveQuadruple F) (Xor (∃ K : + DiamondParameter, 1 < K.1 ∧ qg = DiamondRecursiveQuadruple K) (Nonempty + (BandOrderedGeneralConfiguration qg))))) ) := by + classical + intro q a raw regimes qa g htuple qg + simpa only [qg, htuple] using regimes + +private theorem normalized : + (by + classical + exact + ∀ (n : ℕ), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (T : + ProtoTile), (BandPrototile (q (0 : Fin (4 : ℕ))) T) → ((∀ (p : Fin 4 → + CircleCoordinates), ∀ (U : ProtoTile), ∀ (S : Fin 3 → Bool → ProtoTile), + ProperBandQuadruple p → BandPrototile (p 0) U → (∀ i, ∀ s, BandSubtileOccurrence p U + i s (S i s)) → (∀ x, x ∈ U.cells ↔ ∃ i s, x ∈ (S i s).cells) → Int.toNat (p 0).1 < n + → LatticeTile U ∧ TileArea U = Int.toNat (p 0).1 ∧ ∀ i, ∀ s, LatticeTile + (TileCellComplement U (S i s)) ∧ TileTouching (TileCellComplement U (S i s)) (S i s)) + → ((∀ (D : CircleCoordinates), ∀ (U : ProtoTile), BandPrototile D U → Int.toNat D.1 < + n → QuarterTurnSymmetric U) → ((∀ (p : Fin 4 → CircleCoordinates), ∀ (U : ProtoTile), + ∀ (V : ProtoTile), ProperBandQuadruple p → BandPrototile (p 0) U → Int.toNat (p 0).1 + < n → 1 < (p 0).1 → ∀ i : Fin 3, BandPrototile (p i.succ) V → TileCentroid V - + TileCentroid U = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (p i.succ) (p 0)) + + GaussianRealPoint (BandVectors.1 (p 0) (p i.succ))) → TouchingTriple U + (TileTranslation U (BandVectors.1 (p i.succ) (p 0))) V) → ((∀ (p : Fin 4 → + CircleCoordinates), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (W : ProtoTile), + ProperBandQuadruple p → BandPrototile (p 0) U → Int.toNat (p 0).1 < n → ∀ i : Fin 3, + BandPrototile (p i.succ) V → BandPrototile (p ((i + 1).succ)) W → TileCentroid V - + TileCentroid U = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (p i.succ) (p 0)) + + GaussianRealPoint (BandVectors.1 (p 0) (p i.succ))) → TileCentroid W - TileCentroid + U = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (p ((i + 1).succ)) (p 0)) - + GaussianRealPoint (BandVectors.1 (p 0) (p ((i + 1).succ)))) → TouchingTriple U V W) → + (∀ (a : Fin (3 : ℕ)), + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + ∀ (g : BandPackingSymmetry), (BandPackingSymmetryScopedPhase g qa false) → ((∀ (r : Fin + (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = qa (1 : + Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = qa (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = qa + (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g r false) → ( + let qg := BandPackingSymmetryQuadrupleAction g qa + let Tg := BandPackingSymmetryTileAction g T + (BandPrototile (qg 0) Tg) → ((Int.toNat (qg 0).1 = n) → ((Xor (∃ F : FordFareyParameter, + 1 < F.q ∧ qg = FordRecursiveQuadruple F) (Xor (∃ K : DiamondParameter, 1 < K.1 ∧ qg = + DiamondRecursiveQuadruple K) (Nonempty (BandOrderedGeneralConfiguration qg)))) → + ((LatticeTile Tg ∧ TileArea Tg = Int.toNat (qg 0).1 ∧ + (∀ (S : Fin 3 → Bool → ProtoTile), (∀ i, ∀ s, BandSubtileOccurrence qg Tg i s (S i s)) → + (∀ x, x ∈ Tg.cells ↔ ∃ i s, x ∈ (S i s).cells) → + ∀ i, ∀ s, LatticeTile (TileCellComplement Tg (S i s)) ∧ + TileTouching (TileCellComplement Tg (S i s)) (S i s)) ∧ + QuarterTurnSymmetric Tg ∧ + (1 < (qg 0).1 → ∀ i : Fin 3, + TouchingTriple Tg + (TileTranslation Tg (BandVectors.1 (qg i.succ) (qg 0))) + (TileTranslation Tg + (-BandVectors.1 (qg ((i + 1).succ)) (qg 0)))) ∧ + (1 < (qg 0).1 → ∀ (i : Fin 3), ∀ (U : ProtoTile), BandPrototile (qg i.succ) U → + TileCentroid U - TileCentroid Tg = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (qg i.succ) (qg 0)) + + GaussianRealPoint (BandVectors.1 (qg 0) (qg i.succ))) → + TouchingTriple Tg + (TileTranslation Tg (BandVectors.1 (qg i.succ) (qg 0))) U) ∧ + (∀ (i : Fin 3), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (qg i.succ) U → + BandPrototile (qg ((i + 1).succ)) V → + TileCentroid U - TileCentroid Tg = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (qg i.succ) (qg 0)) + + GaussianRealPoint (BandVectors.1 (qg 0) (qg i.succ))) → + TileCentroid V - TileCentroid Tg = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (qg ((i + 1).succ)) (qg 0)) - + GaussianRealPoint (BandVectors.1 (qg 0) (qg ((i + 1).succ)))) → + TouchingTriple Tg U V)) ∧ + (∀ (r : Fin 4 → CircleCoordinates), ProperBandQuadruple r → + r 0 = q 1 → r 2 = q 2 → r 3 = q 3 → + (q 2).1 ≤ (q 1).1 → (q 3).1 ≤ (q 2).1 → + 1 < (q 2).1 → + ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (Q : Fin 3 → Bool → ProtoTile), ∀ (S : Fin 3 → Bool + → ProtoTile), (∀ i, ∀ s, BandSubtileOccurrence q T i s (P i s)) → + (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (P i s).cells) → + (∀ i, ∀ s, BandSubtileOccurrence r (P 0 true) i s (Q i s)) → + (∀ x, x ∈ (P 0 true).cells ↔ ∃ i s, x ∈ (Q i s).cells) → + (∀ i, ∀ s, BandSubtileOccurrence r (P 0 false) i s (S i s)) → + (∀ x, x ∈ (P 0 false).cells ↔ ∃ i s, x ∈ (S i s).cells) → + ( + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + (∀ a b : PeriodicSubtileIndex, a ≠ b → + ((FootprintEdges (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty → + AllowedSubtileIncidence a b) ∧ + (¬ AllowedSubtileIncidence a b → + FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ + FootprintVertices (P 0 true) ∩ FootprintVertices (P 1 true) ⊆ + FootprintVertices (Q 1 true) ∩ FootprintVertices (P 1 true) ∧ + FootprintVertices (P 0 true) ∩ FootprintVertices (P 0 false) ⊆ + (FootprintVertices (Q 1 true) ∩ FootprintVertices (S 2 false)) ∪ + FootprintVertices (Q 0 false) ∪ + (FootprintVertices (Q 2 true) ∩ + FootprintVertices (S 1 false))))))))))))))) ) := by + classical + intro n q hq T hT smallT1 smallT2 smallT4 smallT5 a qa g hphase hpred qg Tg hTg hng hregimes + rcases hregimes with ⟨hford, _⟩ | ⟨hother, _⟩ + · obtain ⟨F, hF, heq⟩ := hford + refine ⟨?_, P4564T2FordT6Transport q hq T hT a g F hF heq⟩ + have h := P4564T2FordGeometry F hF Tg (heq ▸ hTg) + simpa only [← heq] using h + · rcases hother with ⟨hdiamond, _⟩ | ⟨hgeneral, _⟩ + · obtain ⟨K, hK, heq⟩ := hdiamond + refine ⟨?_, ?_⟩ + · have h := P4564T2DiamondGeometry K hK Tg (heq ▸ hTg) + simpa only [← heq] using h + · intro r hr hr0 hr2 hr3 h12 h23 hlarge + have hle := P4564T2DiamondOrderExclusion q a g K heq h12 h23 + omega + · obtain ⟨cfg⟩ := hgeneral + have hpositive : 0 < (qg 0).1 := lt_trans (by norm_num) cfg.childLarge + let Cg : BandCircle := + ⟨⟨qg 0, Or.inl hpositive, ⟨qg, cfg.proper.1, 0, rfl⟩⟩, hpositive⟩ + obtain ⟨cert⟩ := BandOrderedGeneralLayout qg cfg Cg rfl Tg hTg + (by + intro p U S hp hU hS hcover hlt + exact smallT1 p U S hp hU hS hcover (by simpa only [hng] using hlt)) + (by + intro D U hU hlt + exact smallT2 D U hU (by simpa only [hng] using hlt)) + (by + intro p U V hp hU hlt hc i hV hcent + exact smallT4 p U V hp hU (by simpa only [hng] using hlt) + hc i hV hcent) + (by + intro p U V W hp hU hlt i hV hW hcV hcW + exact smallT5 p U V W hp hU (by simpa only [hng] using hlt) + i hV hW hcV hcW) + have hT1 := TileT1DiskArea qg cfg Cg Tg hTg cert + have hT2 := TileT2QuarterTurn qg cfg Cg Tg cert + refine ⟨⟨hT1.1, hT1.2.1, ?_, hT2, ?_, ?_, ?_⟩, ?_⟩ + · intro S hS _ i s + have hA := hS i s + have hB := cert.outer_occurrence i s + have hc : TileCentroid (S i s) = TileCentroid (cert.P i s) := + sub_left_injective (hA.2.2.trans hB.2.2.symm) + obtain ⟨hcells, hanchor⟩ := + BandPrototileCentroidUnique _ _ _ hA.1 hB.1 hc + have hcomp : TileCellComplement Tg (S i s) = + TileCellComplement Tg (cert.P i s) := by + simp only [TileCellComplement, hcells] + obtain ⟨hdisk, htouch⟩ := hT1.2.2 i s + refine ⟨hcomp.symm ▸ hdisk, ?_⟩ + rw [hcomp] + by_cases hempty : (S i s).cells = ∅ + · have heq : S i s = cert.P i s := by + have ha := hanchor hempty + cases hSi : S i s + cases hPi : cert.P i s + simp only [hSi, hPi] at hcells ha + cases hcells + cases ha + rfl + simpa only [heq] using htouch + · have obs := ProtoTileObservableExtensionality _ _ hcells hanchor + have hnonempty : (cert.P i s).cells ≠ ∅ := by rwa [← hcells] + simpa only [TileTouching, hcells, obs.2.1, obs.2.2.1, + hnonempty, false_and, or_false] using htouch + · intro _ i + exact TileT3TranslateTouching qg cfg Cg Tg cert hT2 i + · intro _ i U hU hcent + exact TileT4ParentTranslateTouching qg cfg Cg Tg U cert hT2 i hU hcent + · intro i U V hU hV hcU hcV + exact TileT5ParentTouching qg cfg Cg Tg U V cert hT2 i hU hV hcU hcV + · exact P4564T2GeneralT6Transport q hq T hT a g hphase hpred cfg Cg cert + +private theorem parentQuarter : + (by + classical + exact + ∀ (n : ℕ), ∀ (q : Fin 4 → CircleCoordinates), ((q (0 : Fin (4 : ℕ))).1.toNat = n) → ((∀ + (D : CircleCoordinates), ∀ (U : ProtoTile), BandPrototile D U → Int.toNat D.1 < n → + QuarterTurnSymmetric U) → (∀ (a : Fin (3 : ℕ)), + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + (ProperBandQuadruple qa) → (∀ (i : Fin 3), ∀ (U : ProtoTile), BandPrototile (qa i.succ) U + → QuarterTurnSymmetric U))) ) := by + classical + intro n q hn smallT2 a qa hqa i U hU + apply smallT2 (qa i.succ) U hU + rw [← hn] + exact (Int.toNat_lt_toNat (ProperBandCurvatureStructure qa hqa).1).mpr (hqa.2 i) + +private theorem parentIndex : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (a : Fin (3 : ℕ)), + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + ∀ i : Fin 3, qa i.succ = q (a + i).succ ) := by + classical + intro q a qa i + fin_cases i <;> simp [qa] + +private theorem cyclicIndices : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (a : Fin (3 : ℕ)), + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + (∀ i : Fin 3, qa i.succ = q (a + i).succ) → (∀ i : Fin 3, qa (i - a).succ = q i.succ ∧ qa + ((i - a + 1).succ) = q ((i + 1).succ)) ) := by + classical + intro q a qa parentIndex i + constructor + · simpa only [add_sub_cancel] using parentIndex (i - a) + · simpa only [← add_assoc, add_sub_cancel] using parentIndex (i - a + 1) + +end TileInductionGeometry + +theorem BandTileSimultaneousInduction (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) (T : ProtoTile) + (hT : BandPrototile (q 0) T) : + LatticeTile T ∧ TileArea T = Int.toNat (q 0).1 ∧ + (∀ (S : Fin 3 → Bool → ProtoTile), + (∀ i s, BandSubtileOccurrence q T i s (S i s)) → + (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (S i s).cells) → + ∀ i s, LatticeTile (TileCellComplement T (S i s)) ∧ + TileTouching (TileCellComplement T (S i s)) (S i s)) ∧ + QuarterTurnSymmetric T ∧ + (1 < (q 0).1 → ∀ i : Fin 3, + TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) + (TileTranslation T + (-BandVectors.1 (q ((i + 1).succ)) (q 0)))) ∧ + (1 < (q 0).1 → ∀ (i : Fin 3) (U : ProtoTile), + BandPrototile (q i.succ) U → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U) ∧ + (∀ (i : Fin 3) (U V : ProtoTile), + BandPrototile (q i.succ) U → + BandPrototile (q ((i + 1).succ)) V → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ)))) → + TouchingTriple T U V) ∧ + (∀ (r : Fin 4 → CircleCoordinates), ProperBandQuadruple r → + r 0 = q 1 → r 2 = q 2 → r 3 = q 3 → + (q 2).1 ≤ (q 1).1 → (q 3).1 ≤ (q 2).1 → + 1 < (q 2).1 → + ∀ (P Q S : Fin 3 → Bool → ProtoTile), + (∀ i s, BandSubtileOccurrence q T i s (P i s)) → + (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (P i s).cells) → + (∀ i s, BandSubtileOccurrence r (P 0 true) i s (Q i s)) → + (∀ x, x ∈ (P 0 true).cells ↔ ∃ i s, x ∈ (Q i s).cells) → + (∀ i s, BandSubtileOccurrence r (P 0 false) i s (S i s)) → + (∀ x, x ∈ (P 0 false).cells ↔ ∃ i s, x ∈ (S i s).cells) → + (let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + (∀ a b : PeriodicSubtileIndex, a ≠ b → + ((FootprintEdges (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty → + AllowedSubtileIncidence a b) ∧ + (¬ AllowedSubtileIncidence a b → + FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ + FootprintVertices (P 0 true) ∩ FootprintVertices (P 1 true) ⊆ + FootprintVertices (Q 1 true) ∩ FootprintVertices (P 1 true) ∧ + FootprintVertices (P 0 true) ∩ FootprintVertices (P 0 false) ⊆ + (FootprintVertices (Q 1 true) ∩ FootprintVertices (S 2 false)) ∪ + FootprintVertices (Q 0 false) ∪ + (FootprintVertices (Q 2 true) ∩ + FootprintVertices (S 1 false)))) := by +-- BODY + classical + generalize hn : Int.toNat (q 0).1 = n + induction n using Nat.strong_induction_on generalizing q T with + | h n ih => + have smallT1 : ∀ (p : Fin 4 → CircleCoordinates) (U : ProtoTile) + (S : Fin 3 → Bool → ProtoTile), ProperBandQuadruple p → + BandPrototile (p 0) U → + (∀ i s, BandSubtileOccurrence p U i s (S i s)) → + (∀ x, x ∈ U.cells ↔ ∃ i s, x ∈ (S i s).cells) → + Int.toNat (p 0).1 < n → + LatticeTile U ∧ TileArea U = Int.toNat (p 0).1 ∧ + ∀ i s, LatticeTile (TileCellComplement U (S i s)) ∧ + TileTouching (TileCellComplement U (S i s)) (S i s) := TileInductionGeometry.smallT1 + n ih + have smallT2 : ∀ (D : CircleCoordinates) (U : ProtoTile), + BandPrototile D U → Int.toNat D.1 < n → + QuarterTurnSymmetric U := TileInductionGeometry.smallT2 n ih + have smallT4 : ∀ (p : Fin 4 → CircleCoordinates) + (U V : ProtoTile), ProperBandQuadruple p → + BandPrototile (p 0) U → Int.toNat (p 0).1 < n → + 1 < (p 0).1 → ∀ i : Fin 3, BandPrototile (p i.succ) V → + TileCentroid V - TileCentroid U = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (p i.succ) (p 0)) + + GaussianRealPoint (BandVectors.1 (p 0) (p i.succ))) → + TouchingTriple U + (TileTranslation U (BandVectors.1 (p i.succ) (p 0))) V := TileInductionGeometry.smallT4 + n ih + have smallT5 : ∀ (p : Fin 4 → CircleCoordinates) + (U V W : ProtoTile), ProperBandQuadruple p → + BandPrototile (p 0) U → Int.toNat (p 0).1 < n → + ∀ i : Fin 3, BandPrototile (p i.succ) V → + BandPrototile (p ((i + 1).succ)) W → + TileCentroid V - TileCentroid U = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (p i.succ) (p 0)) + + GaussianRealPoint (BandVectors.1 (p 0) (p i.succ))) → + TileCentroid W - TileCentroid U = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (p ((i + 1).succ)) (p 0)) - + GaussianRealPoint (BandVectors.1 (p 0) (p ((i + 1).succ)))) → + TouchingTriple U V W := TileInductionGeometry.smallT5 n ih + obtain ⟨a, raw, regimes⟩ := BandRegimeClassification q hq + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + have hqa : ProperBandQuadruple qa := TileInductionGeometry.hqa q hq a raw regimes + obtain ⟨negative, hrawphase, hrawpred, hrawnext, hcentralCircle, + hcentralParity, hcentralTuple, hcentralVector, g, hchoice, hcircle, + hparity, htuple, hphase, hpred, hnext⟩ := + BandPackingSymmetryProjectiveVectorCovariance raw qa hqa + let qg := BandPackingSymmetryQuadrupleAction g qa + let Tg := BandPackingSymmetryTileAction g T + have hTg : BandPrototile (qg 0) Tg := + (BandPackingSymmetryCovariance g).2.1 (q 0) T |>.mp hT + have hcurv : (qg 0).1 = (q 0).1 := + (BandPackingSymmetryCovariance g).1 (q 0) + have hng : Int.toNat (qg 0).1 = n := hcurv ▸ hn + have hregimes : + Xor (∃ F : FordFareyParameter, 1 < F.q ∧ qg = FordRecursiveQuadruple F) + (Xor (∃ K : DiamondParameter, 1 < K.1 ∧ qg = DiamondRecursiveQuadruple K) + (Nonempty (BandOrderedGeneralConfiguration qg))) := TileInductionGeometry.hregimes q + a raw regimes g htuple + have normalized : + (LatticeTile Tg ∧ TileArea Tg = Int.toNat (qg 0).1 ∧ + (∀ (S : Fin 3 → Bool → ProtoTile), + (∀ i s, BandSubtileOccurrence qg Tg i s (S i s)) → + (∀ x, x ∈ Tg.cells ↔ ∃ i s, x ∈ (S i s).cells) → + ∀ i s, LatticeTile (TileCellComplement Tg (S i s)) ∧ + TileTouching (TileCellComplement Tg (S i s)) (S i s)) ∧ + QuarterTurnSymmetric Tg ∧ + (1 < (qg 0).1 → ∀ i : Fin 3, + TouchingTriple Tg + (TileTranslation Tg (BandVectors.1 (qg i.succ) (qg 0))) + (TileTranslation Tg + (-BandVectors.1 (qg ((i + 1).succ)) (qg 0)))) ∧ + (1 < (qg 0).1 → ∀ (i : Fin 3) (U : ProtoTile), + BandPrototile (qg i.succ) U → + TileCentroid U - TileCentroid Tg = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (qg i.succ) (qg 0)) + + GaussianRealPoint (BandVectors.1 (qg 0) (qg i.succ))) → + TouchingTriple Tg + (TileTranslation Tg (BandVectors.1 (qg i.succ) (qg 0))) U) ∧ + (∀ (i : Fin 3) (U V : ProtoTile), + BandPrototile (qg i.succ) U → + BandPrototile (qg ((i + 1).succ)) V → + TileCentroid U - TileCentroid Tg = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (qg i.succ) (qg 0)) + + GaussianRealPoint (BandVectors.1 (qg 0) (qg i.succ))) → + TileCentroid V - TileCentroid Tg = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (qg ((i + 1).succ)) (qg 0)) - + GaussianRealPoint (BandVectors.1 (qg 0) (qg ((i + 1).succ)))) → + TouchingTriple Tg U V)) ∧ + (∀ (r : Fin 4 → CircleCoordinates), ProperBandQuadruple r → + r 0 = q 1 → r 2 = q 2 → r 3 = q 3 → + (q 2).1 ≤ (q 1).1 → (q 3).1 ≤ (q 2).1 → + 1 < (q 2).1 → + ∀ (P Q S : Fin 3 → Bool → ProtoTile), + (∀ i s, BandSubtileOccurrence q T i s (P i s)) → + (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (P i s).cells) → + (∀ i s, BandSubtileOccurrence r (P 0 true) i s (Q i s)) → + (∀ x, x ∈ (P 0 true).cells ↔ ∃ i s, x ∈ (Q i s).cells) → + (∀ i s, BandSubtileOccurrence r (P 0 false) i s (S i s)) → + (∀ x, x ∈ (P 0 false).cells ↔ ∃ i s, x ∈ (S i s).cells) → + (let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + (∀ a b : PeriodicSubtileIndex, a ≠ b → + ((FootprintEdges (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty → + AllowedSubtileIncidence a b) ∧ + (¬ AllowedSubtileIncidence a b → + FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ + FootprintVertices (P 0 true) ∩ FootprintVertices (P 1 true) ⊆ + FootprintVertices (Q 1 true) ∩ FootprintVertices (P 1 true) ∧ + FootprintVertices (P 0 true) ∩ FootprintVertices (P 0 false) ⊆ + (FootprintVertices (Q 1 true) ∩ FootprintVertices (S 2 false)) ∪ + FootprintVertices (Q 0 false) ∪ + (FootprintVertices (Q 2 true) ∩ + FootprintVertices (S 1 false)))) := TileInductionGeometry.normalized n q hq T hT + smallT1 smallT2 smallT4 smallT5 a g hphase hpred hTg hng hregimes + obtain ⟨geometry, hT6⟩ := normalized + have disks := P4564T2GeometryPullback q hq T hT a g + ⟨geometry.1, geometry.2.1, geometry.2.2.1, geometry.2.2.2.1⟩ + have parentQuarter : ∀ (i : Fin 3) (U : ProtoTile), + BandPrototile (qa i.succ) U → QuarterTurnSymmetric U := + TileInductionGeometry.parentQuarter n q hn smallT2 a hqa + have touching := (BandPackingSymmetryT3T5Covariance g qa hqa hphase + T hT disks.2.2.2 parentQuarter).mpr + ⟨geometry.2.2.2.2.1, geometry.2.2.2.2.2.1, geometry.2.2.2.2.2.2⟩ + have childIndex : qa 0 = q 0 := rfl + have parentIndex : ∀ i : Fin 3, qa i.succ = q (a + i).succ := + TileInductionGeometry.parentIndex q a + have cyclicIndices : ∀ i : Fin 3, + qa (i - a).succ = q i.succ ∧ + qa ((i - a + 1).succ) = q ((i + 1).succ) := TileInductionGeometry.cyclicIndices q a + parentIndex + refine ⟨disks.1, disks.2.1.trans hn, disks.2.2.1, disks.2.2.2, + ?_, ?_, ?_, hT6⟩ + · intro hc i + simpa only [childIndex, (cyclicIndices i).1, (cyclicIndices i).2] using + touching.1 hc (i - a) + · intro hc i U hU hcent + have h := touching.2.1 hc (i - a) U + simp only [(cyclicIndices i).1] at h + exact h hU hcent + · intro i U V hU hV hcU hcV + have h := touching.2.2 (i - a) U V + simp only [(cyclicIndices i).1, (cyclicIndices i).2] at h + exact h hU hV hcU hcV + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean new file mode 100644 index 0000000000..155be17248 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean @@ -0,0 +1,752 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileBordering +public import LeanPool.ApollonianSuperharmonic.RegularTileFamily +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis + +-- [TABLET NODE: BandTileTopologyApplication] + +/-! +# BandTileTopologyApplication + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TileTopologyGeometry + +private theorem family_eq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), (∀ + (u : ↥(TilingLattice C)), P.tile u = TileTranslation T (↑u : GaussianInt)) → + (RegularTileFamily T (TilingLattice C) = Set.range P.tile) ) := by + classical + intro C T P htile + ext U + constructor + · rintro ⟨u, hu, rfl⟩ + exact ⟨⟨u, hu⟩, htile ⟨u, hu⟩⟩ + · rintro ⟨u, rfl⟩ + exact ⟨u.1, u.2, htile u⟩ + +private theorem edge_in_footprint : + (by + classical + exact + ∀ (S : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges S) → (e ∈ + FootprintEdges S) ) := by + classical + intro S e he + rcases he with ⟨z, ⟨rfl, hz⟩ | ⟨rfl, hz⟩⟩ + · rcases hz with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · exact ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr (by + ext; simp [Zsqrtd.ext_iff])))⟩ + · rcases hz with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · exact ⟨z - 1, hz, Or.inr (Or.inr (Or.inl (by + ext; simp [Zsqrtd.ext_iff])))⟩ + +private theorem centroid_difference : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), TileCentroid + (TileTranslation T y) - TileCentroid (TileTranslation T x) = GaussianRealPoint (y - + x) ) := by + classical + intro T x y + rw [(TileTranslationFormulas T y).2.2.2.2.1, + (TileTranslationFormulas T x).2.2.2.2.1] + ext <;> simp [GaussianRealPoint] + +private theorem translate_zero : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), (BandPrototile + (q (0 : Fin (4 : ℕ))) T) → (∀ (P : PeriodicTileComplex ↥(TilingLattice C)), (∀ (u : + ↥(TilingLattice C)), P.tile u = TileTranslation T (↑u : GaussianInt)) → (∀ [ + Nonempty (AffineTriangularComplexChart P fun (mn : ℤ × ℤ) => TileTranslation T + ((↑mn.1 : GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + + (↑mn.2 : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))))], + (RegularTileFamily T (TilingLattice C) = Set.range P.tile) → ((∀ (x : GaussianInt), ∀ + (y : GaussianInt), TileCentroid (TileTranslation T y) - TileCentroid (TileTranslation + T x) = GaussianRealPoint (y - x)) → (TileTranslation T 0 = T)))) ) := by + classical + intro C q T hT P htile hchart family_eq centroid_difference + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · ext z + simp [GaussianTranslation] + · simp [GaussianTranslation] + +private theorem realPoint_injective : + (by + classical + exact + Function.Injective GaussianRealPoint ) := by + classical + intro x y hxy + apply Zsqrtd.ext + · have h := congrArg Prod.fst hxy + dsimp [GaussianRealPoint] at h + exact_mod_cast h + · have h := congrArg Prod.snd hxy + dsimp [GaussianRealPoint] at h + exact_mod_cast h + +private theorem hnonempty : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), + (PeriodicTileComplex ↥(TilingLattice C)) → ((0 < (q 0).1) → ((TileArea T = (q (0 : + Fin (4 : ℕ))).1.toNat) → (∀ (x : GaussianInt), (TileTranslation T + x).cells.Nonempty))) ) := by + classical + intro C q T P hpositive harea x + rw [Finset.nonempty_iff_ne_empty] + intro he + have hz : TileArea T = 0 := by + have := (TileTranslationFormulas T x).2.2.1.mp he + simp [TileArea, this] + rw [harea] at hz + have hp : 0 < Int.toNat (q 0).1 := by omega + omega + +private theorem border_touch : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), (BandPrototile + (q (0 : Fin (4 : ℕ))) T) → (∀ (P : PeriodicTileComplex ↥(TilingLattice C)), (∀ (u : + ↥(TilingLattice C)), P.tile u = TileTranslation T (↑u : GaussianInt)) → (∀ [ + Nonempty (AffineTriangularComplexChart P fun (mn : ℤ × ℤ) => TileTranslation T + ((↑mn.1 : GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + + (↑mn.2 : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))))], + (RegularTileFamily T (TilingLattice C) = Set.range P.tile) → ((∀ (x : GaussianInt), ∀ + (y : GaussianInt), TileCentroid (TileTranslation T y) - TileCentroid (TileTranslation + T x) = GaussianRealPoint (y - x)) → ((TileTranslation T 0 = T) → ((TileArea T = (q (0 + : Fin (4 : ℕ))).1.toNat) → ((∀ (x : GaussianInt), (TileTranslation T + x).cells.Nonempty) → (∀ (U : ProtoTile), (U ∈ RegularTileFamily T (TilingLattice C)) + → ((U ≠ T) → (TileTouching T U → TileBordering T U))))))))) ) := by + classical + intro C q T hT P htile hchart family_eq centroid_difference translate_zero harea hnonempty U hU + hneq + obtain ⟨a, ha, hua⟩ := RegularTileFamilyTranslationUnique T + (TilingLattice C) U hU + have hUform : U = TileTranslation T (a : GaussianInt) := ha + have ha0 : a ≠ 0 := by + intro hz + apply hneq + rw [hUform, hz] + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · ext z + simp [GaussianTranslation] + · simp [GaussianTranslation] + rw [hUform] + intro ht + rcases ht with ht | ht | ht + · exact ⟨ht.2.2.1, by + rcases ht.2.2.2 with ⟨p, hp, hl, hvtx, hstep, hed⟩ + cases p with + | nil => simp at hl + | cons x p => + cases p with + | nil => simp at hl + | cons y p => + refine ⟨{x, y}, ?_⟩ + rw [hed] + exact ⟨x, y, [], p, by simp⟩⟩ + · exact False.elim ((hnonempty 0).ne_empty (by simpa [translate_zero] using ht.1)) + · exact False.elim ((hnonempty (a : GaussianInt)).ne_empty ht.1) + +private theorem border_iff_index : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ((q (0 : + Fin (4 : ℕ)) = C.1.1) → (∀ (T : ProtoTile), (BandPrototile (q (0 : Fin (4 : ℕ))) T) → + (∀ (P : PeriodicTileComplex ↥(TilingLattice C)), (∀ (u : ↥(TilingLattice C)), P.tile + u = TileTranslation T (↑u : GaussianInt)) → ((∀ (u : ↥(TilingLattice C)), ∀ (v : + ↥(TilingLattice C)), P.plane.adjacent u v ↔ ∃ (j : Fin (3 : ℕ)), (↑v : GaussianInt) - + (↑u : GaussianInt) = BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ))) ∨ (↑v : + GaussianInt) - (↑u : GaussianInt) = -BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ)))) + → ((∀ (S : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges S) → + (e ∈ FootprintEdges S)) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), TileCentroid + (TileTranslation T y) - TileCentroid (TileTranslation T x) = GaussianRealPoint (y - + x)) → ((TileTranslation T 0 = T) → ((∀ (U : ProtoTile), (U ∈ RegularTileFamily T + (TilingLattice C)) → ((U ≠ T) → (TileTouching T U → TileBordering T U))) → (∀ (a : + TilingLattice C), (a ≠ 0) → (TileBordering T (P.tile a) ↔ ∃ j : Fin 3, (a : + GaussianInt) = BandVectors.1 (q j.succ) (q 0) ∨ (a : GaussianInt) = -BandVectors.1 (q + j.succ) (q 0))))))))))) ) := by + classical + intro C q hq hqC T hT P htile hadj edge_in_footprint centroid_difference translate_zero + border_touch a ha0 + have hmem : P.tile a ∈ RegularTileFamily T (TilingLattice C) := + ⟨a.1, a.2, htile a⟩ + have hneq : P.tile a ≠ T := by + intro heq + have := congrArg TileCentroid heq + rw [htile a, (TileTranslationFormulas T (a : GaussianInt)).2.2.2.2.1] at this + have hr := congrArg Prod.fst this + have hi := congrArg Prod.snd this + dsimp at hr hi + have hz : (a : GaussianInt) = 0 := by + apply Zsqrtd.ext + · have hh : (((a : GaussianInt).re : Int) : Real) = 0 := by linarith + exact_mod_cast hh + · have hh : (((a : GaussianInt).im : Int) : Real) = 0 := by linarith + exact_mod_cast hh + exact ha0 (Subtype.ext hz) + constructor + · intro hb + have hcommon : (FootprintEdges (P.tile 0) ∩ FootprintEdges (P.tile a)).Nonempty := by + rcases hb.2 with ⟨e, heT, heU⟩ + have he0 : e ∈ FootprintEdges (P.tile 0) := by + simpa [htile 0, translate_zero] using edge_in_footprint T e heT + exact ⟨e, he0, + edge_in_footprint (P.tile a) e heU⟩ + have hadj0 := ((PeriodicTileIntersectionClassification P).1 0 a + (by intro h; exact ha0 (Subtype.ext (by simpa using h.symm)))).1.mp hcommon + rcases (hadj 0 a).mp hadj0 with ⟨j, hj | hj⟩ + · exact ⟨j, Or.inl (by simpa using hj)⟩ + · exact ⟨j, Or.inr (by simpa using hj)⟩ + · rintro ⟨j, hj | hj⟩ + · apply border_touch (P.tile a) hmem hneq + apply (BandRegularTileTouchingClassification C q hq hqC T hT T + (P.tile a) ⟨0, (TilingLattice C).zero_mem, translate_zero.symm⟩ hmem).2 + refine ⟨j, Or.inl ?_⟩ + have hc := centroid_difference 0 (a : GaussianInt) + rw [sub_zero, hj] at hc + simpa [htile a, translate_zero, hj] using hc + · apply border_touch (P.tile a) hmem hneq + apply (BandRegularTileTouchingClassification C q hq hqC T hT T + (P.tile a) ⟨0, (TilingLattice C).zero_mem, translate_zero.symm⟩ hmem).2 + refine ⟨j, Or.inr ?_⟩ + have hc := centroid_difference 0 (a : GaussianInt) + rw [sub_zero, hj] at hc + simpa [htile a, translate_zero, hj, GaussianRealPoint] using hc + +private theorem hcAt267 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (∑ j : Fin (3 : ℕ), BandVectors.1 (q j.succ) (q (0 : + Fin (4 : ℕ))) = (0 : GaussianInt) ∧ ∑ j : Fin (3 : ℕ), BandVectors.2 (q j.succ) (q (0 + : Fin (4 : ℕ))) = (0 : GaussianInt)) → (BandVectors.1 (q 3) (q 0) = -BandVectors.1 (q + 1) (q 0) - BandVectors.1 (q 2) (q 0)) ) := by + classical + intro q hsum + have hsum' := hsum.1 + simp? [Fin.sum_univ_succ] at hsum' + have heq : BandVectors.1 (q 3) (q 0) = + -(BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0)) := by + apply (eq_neg_iff_add_eq_zero).2 + convert hsum' using 1; abel + convert heq using 1; abel + +private theorem hcmem : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), (BandVectors.1 (q 1) (q 0) ∈ + TilingLattice C) → ((BandVectors.1 (q 2) (q 0) ∈ TilingLattice C) → ((BandVectors.1 + (q 3) (q 0) = -BandVectors.1 (q 1) (q 0) - BandVectors.1 (q 2) (q 0)) → + (BandVectors.1 (q 3) (q 0) ∈ TilingLattice C))) ) := by + classical + intro C q ha hb hc + rw [hc] + exact (TilingLattice C).add_mem ((TilingLattice C).neg_mem ha) + ((TilingLattice C).neg_mem hb) + +private theorem coordinate_unique : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ( + let a := BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))); + let b := BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))); + let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); + let L := AddSubgroup.closure {u, v}; a ∈ TilingLattice C ∧ b ∈ TilingLattice C ∧ (∀ (w : + ↥(TilingLattice C)), ∃! mn : ℤ × ℤ, (↑mn.1 : GaussianInt) * a + (↑mn.2 : GaussianInt) + * b = (↑w : GaussianInt)) ∧ u ∈ L ∧ v ∈ L ∧ (∀ (z : GaussianInt), z ∈ L ↔ ∃ w ∈ + TilingLattice C, z = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * w) ∧ (∀ (w : ↥L), ∃! mn : ℤ + × ℤ, (↑mn.1 : GaussianInt) * u + (↑mn.2 : GaussianInt) * v = (↑w : GaussianInt)) ∧ ∃ + (R : Finset GaussianInt), LatticeFundamentalSet L R ∧ R.card = C.1.1.1.natAbs) → + ((BandVectors.1 (q 1) (q 0) ∈ TilingLattice C) → ((BandVectors.1 (q 2) (q 0) ∈ + TilingLattice C) → (∀ (m : Int × Int), ∀ (n : Int × Int), ((m.1 : GaussianInt) * + BandVectors.1 (q 1) (q 0) + + (m.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) = + (n.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (n.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) → (m = n)))) ) := by + classical + intro C q hbasis ha hb m n hm + have hu := (hbasis.2.2.1 + ⟨_, (TilingLattice C).add_mem + ((TilingLattice C).zsmul_mem ha m.1) + ((TilingLattice C).zsmul_mem hb m.2)⟩) + apply hu.unique + · simp [zsmul_eq_mul] + · calc + _ = (m.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (m.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) := hm.symm + _ = _ := by simp [zsmul_eq_mul] + +private theorem vector_repr : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandVectors.1 (q 3) (q 0) = -BandVectors.1 (q 1) (q + 0) - BandVectors.1 (q 2) (q 0)) → ( + let vectors : Fin 6 → GaussianInt := + ![BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0), + BandVectors.1 (q 3) (q 0), -BandVectors.1 (q 1) (q 0), + -BandVectors.1 (q 2) (q 0), -BandVectors.1 (q 3) (q 0)] + let coordinates : Fin 6 → Int × Int := + ![(1, 0), (0, 1), (-1, -1), (-1, 0), (0, -1), (1, 1)] + ∀ (i : Fin 6), vectors i = (coordinates i).1 * BandVectors.1 (q 1) (q 0) + (coordinates + i).2 * BandVectors.1 (q 2) (q 0)) ) := by + classical + intro q hc vectors coordinates i + fin_cases i <;> simp [vectors, coordinates, hc] <;> ring + +private theorem vector_injective : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let vectors : Fin 6 → GaussianInt := + ![BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0), + BandVectors.1 (q 3) (q 0), -BandVectors.1 (q 1) (q 0), + -BandVectors.1 (q 2) (q 0), -BandVectors.1 (q 3) (q 0)] + let coordinates : Fin 6 → Int × Int := + ![(1, 0), (0, 1), (-1, -1), (-1, 0), (0, -1), (1, 1)] + (∀ (m : Int × Int), ∀ (n : Int × Int), ((m.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (m.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) = (n.1 : GaussianInt) * BandVectors.1 + (q 1) (q 0) + (n.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) → (m = n)) → ((∀ (i : + Fin 6), vectors i = (coordinates i).1 * BandVectors.1 (q 1) (q 0) + (coordinates i).2 + * BandVectors.1 (q 2) (q 0)) → (Function.Injective vectors)) ) := by + classical + intro q vectors coordinates coordinate_unique vector_repr i j hij + have hcoord : coordinates i = coordinates j := by + apply coordinate_unique + rw [← vector_repr i, hij, vector_repr j] + fin_cases i <;> fin_cases j <;> simp [coordinates] at hcoord ⊢ + +private theorem vector_mem : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), (BandVectors.1 (q 1) (q 0) ∈ + TilingLattice C) → ((BandVectors.1 (q 2) (q 0) ∈ TilingLattice C) → ((BandVectors.1 + (q 3) (q 0) ∈ TilingLattice C) → ( + let vectors : Fin 6 → GaussianInt := + ![BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0), + BandVectors.1 (q 3) (q 0), -BandVectors.1 (q 1) (q 0), + -BandVectors.1 (q 2) (q 0), -BandVectors.1 (q 3) (q 0)] + ∀ (i : Fin 6), vectors i ∈ TilingLattice C))) ) := by + classical + intro C q ha hb hcmem vectors i + fin_cases i + · exact ha + · exact hb + · exact hcmem + · exact (TilingLattice C).neg_mem ha + · exact (TilingLattice C).neg_mem hb + · exact (TilingLattice C).neg_mem hcmem + +private theorem hzAt326 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (P : + PeriodicTileComplex ↥(TilingLattice C)), (∀ (u : ↥(TilingLattice C)), P.tile u = + TileTranslation T (↑u : GaussianInt)) → ( + let vectors : Fin 6 → GaussianInt := + ![BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0), + BandVectors.1 (q 3) (q 0), -BandVectors.1 (q 1) (q 0), + -BandVectors.1 (q 2) (q 0), -BandVectors.1 (q 3) (q 0)] + ∀ (vector_mem : ∀ (i : Fin 6), vectors i ∈ TilingLattice C), ∀ (i : Fin (6 : ℕ)), (P.tile + ⟨vectors i, vector_mem i⟩ = T) → (vectors i = 0)) ) := by + classical + intro C q T P htile vectors vector_mem i heqTile + have hcq := congrArg TileCentroid heqTile + rw [htile, (TileTranslationFormulas T (vectors i)).2.2.2.2.1] at hcq + apply Zsqrtd.ext + · have hh := congrArg Prod.fst hcq + dsimp at hh + exact_mod_cast (by linarith : (((vectors i).re : Int) : Real) = 0) + · have hh := congrArg Prod.snd hcq + dsimp at hh + exact_mod_cast (by linarith : (((vectors i).im : Int) : Real) = 0) + +private theorem hcoordAt336 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let vectors : Fin 6 → GaussianInt := + ![BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0), + BandVectors.1 (q 3) (q 0), -BandVectors.1 (q 1) (q 0), + -BandVectors.1 (q 2) (q 0), -BandVectors.1 (q 3) (q 0)] + let coordinates : Fin 6 → Int × Int := + ![(1, 0), (0, 1), (-1, -1), (-1, 0), (0, -1), (1, 1)] + (∀ (m : Int × Int), ∀ (n : Int × Int), ((m.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (m.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) = (n.1 : GaussianInt) * BandVectors.1 + (q 1) (q 0) + (n.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) → (m = n)) → ((∀ (i : + Fin 6), vectors i = (coordinates i).1 * BandVectors.1 (q 1) (q 0) + (coordinates i).2 + * BandVectors.1 (q 2) (q 0)) → (∀ (i : Fin (6 : ℕ)), (vectors i = 0) → (coordinates i + = (0, 0)))) ) := by + classical + intro q vectors coordinates coordinate_unique vector_repr i hz + apply coordinate_unique + rw [← vector_repr i, hz] + simp + +private theorem hnonzero : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), + let vectors : Fin 6 → GaussianInt := + ![BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0), + BandVectors.1 (q 3) (q 0), -BandVectors.1 (q 1) (q 0), + -BandVectors.1 (q 2) (q 0), -BandVectors.1 (q 3) (q 0)] + let coordinates : Fin 6 → Int × Int := + ![(1, 0), (0, 1), (-1, -1), (-1, 0), (0, -1), (1, 1)] + (∀ (m : Int × Int), ∀ (n : Int × Int), ((m.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (m.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) = (n.1 : GaussianInt) * BandVectors.1 + (q 1) (q 0) + (n.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) → (m = n)) → ((∀ (i : + Fin 6), vectors i = (coordinates i).1 * BandVectors.1 (q 1) (q 0) + (coordinates i).2 + * BandVectors.1 (q 2) (q 0)) → (∀ (vector_mem : ∀ (i : Fin 6), vectors i ∈ + TilingLattice C), ∀ (i : Fin (6 : ℕ)), (⟨vectors i, vector_mem i⟩ : TilingLattice C) + ≠ 0)) ) := by + classical + intro C q vectors coordinates coordinate_unique vector_repr vector_mem i hz + have hz' := congrArg Subtype.val hz + have hz'' : vectors i = 0 := by simpa using hz' + have hcoord : coordinates i = (0, 0) := by + apply coordinate_unique + calc + (coordinates i).1 * BandVectors.1 (q 1) (q 0) + + (coordinates i).2 * BandVectors.1 (q 2) (q 0) = vectors i := + (vector_repr i).symm + _ = 0 := hz'' + _ = (0 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (0 : GaussianInt) * BandVectors.1 (q 2) (q 0) := by simp + fin_cases i <;> simp [coordinates] at hcoord + +private theorem map_injective : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (P : + PeriodicTileComplex ↥(TilingLattice C)), ∀ (htile : ∀ (u : ↥(TilingLattice C)), + P.tile u = TileTranslation T (↑u : GaussianInt)), ∀ (border_iff_index : ∀ (a : + TilingLattice C), (a ≠ 0) → (TileBordering T (P.tile a) ↔ ∃ j : Fin 3, (a : + GaussianInt) = BandVectors.1 (q j.succ) (q 0) ∨ (a : GaussianInt) = -BandVectors.1 (q + j.succ) (q 0))), + let vectors : Fin 6 → GaussianInt := + ![BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0), + BandVectors.1 (q 3) (q 0), -BandVectors.1 (q 1) (q 0), + -BandVectors.1 (q 2) (q 0), -BandVectors.1 (q 3) (q 0)] + let coordinates : Fin 6 → Int × Int := + ![(1, 0), (0, 1), (-1, -1), (-1, 0), (0, -1), (1, 1)] + ∀ (coordinate_unique : ∀ (m : Int × Int), ∀ (n : Int × Int), ((m.1 : GaussianInt) * + BandVectors.1 (q 1) (q 0) + (m.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) = (n.1 : + GaussianInt) * BandVectors.1 (q 1) (q 0) + (n.2 : GaussianInt) * BandVectors.1 (q 2) + (q 0)) → (m = n)), ∀ (vector_repr : ∀ (i : Fin 6), vectors i = (coordinates i).1 * + BandVectors.1 (q 1) (q 0) + (coordinates i).2 * BandVectors.1 (q 2) (q 0)), + (Function.Injective vectors) → (∀ (vector_mem : ∀ (i : Fin 6), vectors i ∈ + TilingLattice C), + let target : Type := {U : ProtoTile // + U ∈ RegularTileFamily T (TilingLattice C) ∧ U ≠ T ∧ TileBordering T U} + let map : Fin 6 → target := fun i => + ⟨P.tile ⟨vectors i, vector_mem i⟩, by + refine ⟨⟨vectors i, vector_mem i, htile _⟩, ?_, ?_⟩ + · intro heq + have heqTile : P.tile ⟨vectors i, vector_mem i⟩ = T := heq + have hz : vectors i = 0 := by + have hcq := congrArg TileCentroid heqTile + rw [htile, (TileTranslationFormulas T (vectors i)).2.2.2.2.1] at hcq + apply Zsqrtd.ext + · have hh := congrArg Prod.fst hcq + dsimp at hh + exact_mod_cast (by linarith : (((vectors i).re : Int) : Real) = 0) + · have hh := congrArg Prod.snd hcq + dsimp at hh + exact_mod_cast (by linarith : (((vectors i).im : Int) : Real) = 0) + have hcoord : coordinates i = (0, 0) := by + apply coordinate_unique + rw [← vector_repr i, hz] + simp + fin_cases i <;> simp [coordinates] at hcoord + · have hnonzero : (⟨vectors i, vector_mem i⟩ : TilingLattice C) ≠ 0 := by + intro hz + have hz' := congrArg Subtype.val hz + have hz'' : vectors i = 0 := by simpa using hz' + have hcoord : coordinates i = (0, 0) := by + apply coordinate_unique + calc + (coordinates i).1 * BandVectors.1 (q 1) (q 0) + + (coordinates i).2 * BandVectors.1 (q 2) (q 0) = vectors i := + (vector_repr i).symm + _ = 0 := hz'' + _ = (0 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (0 : GaussianInt) * BandVectors.1 (q 2) (q 0) := by simp + fin_cases i <;> simp [coordinates] at hcoord + apply (border_iff_index ⟨vectors i, vector_mem i⟩ hnonzero).2 + fin_cases i + · exact ⟨0, Or.inl rfl⟩ + · exact ⟨1, Or.inl rfl⟩ + · exact ⟨2, Or.inl rfl⟩ + · exact ⟨0, Or.inr rfl⟩ + · exact ⟨1, Or.inr rfl⟩ + · exact ⟨2, Or.inr rfl⟩ + ⟩ + Function.Injective map)) := by + classical + intro C q T P htile border_iff_index vectors coordinates coordinate_unique vector_repr + vector_injective vector_mem target map i j hij + have ht : P.tile ⟨vectors i, vector_mem i⟩ = + P.tile ⟨vectors j, vector_mem j⟩ := congrArg Subtype.val hij + have hu := RegularTileFamilyTranslationUnique T (TilingLattice C) + (P.tile ⟨vectors j, vector_mem j⟩) (by + exact (map j).property.1) + have heq : (⟨vectors i, vector_mem i⟩ : TilingLattice C) = + ⟨vectors j, vector_mem j⟩ := hu.unique + (by simpa [htile] using ht.symm) (htile _) + exact vector_injective (Subtype.ext_iff.mp heq) + +private theorem map_surjective : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (P : + PeriodicTileComplex ↥(TilingLattice C)), ∀ (htile : ∀ (u : ↥(TilingLattice C)), + P.tile u = TileTranslation T (↑u : GaussianInt)), ∀ (translate_zero : TileTranslation + T 0 = T), ∀ (border_iff_index : ∀ (a : TilingLattice C), (a ≠ 0) → (TileBordering T + (P.tile a) ↔ ∃ j : Fin 3, (a : GaussianInt) = BandVectors.1 (q j.succ) (q 0) ∨ (a : + GaussianInt) = -BandVectors.1 (q j.succ) (q 0))), + let vectors : Fin 6 → GaussianInt := + ![BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0), + BandVectors.1 (q 3) (q 0), -BandVectors.1 (q 1) (q 0), + -BandVectors.1 (q 2) (q 0), -BandVectors.1 (q 3) (q 0)] + let coordinates : Fin 6 → Int × Int := + ![(1, 0), (0, 1), (-1, -1), (-1, 0), (0, -1), (1, 1)] + ∀ (coordinate_unique : ∀ (m : Int × Int), ∀ (n : Int × Int), ((m.1 : GaussianInt) * + BandVectors.1 (q 1) (q 0) + (m.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) = (n.1 : + GaussianInt) * BandVectors.1 (q 1) (q 0) + (n.2 : GaussianInt) * BandVectors.1 (q 2) + (q 0)) → (m = n)), ∀ (vector_repr : ∀ (i : Fin 6), vectors i = (coordinates i).1 * + BandVectors.1 (q 1) (q 0) + (coordinates i).2 * BandVectors.1 (q 2) (q 0)), ∀ + (vector_mem : ∀ (i : Fin 6), vectors i ∈ TilingLattice C), + let target : Type := {U : ProtoTile // + U ∈ RegularTileFamily T (TilingLattice C) ∧ U ≠ T ∧ TileBordering T U} + let map : Fin 6 → target := fun i => + ⟨P.tile ⟨vectors i, vector_mem i⟩, by + refine ⟨⟨vectors i, vector_mem i, htile _⟩, ?_, ?_⟩ + · intro heq + have heqTile : P.tile ⟨vectors i, vector_mem i⟩ = T := heq + have hz : vectors i = 0 := by + have hcq := congrArg TileCentroid heqTile + rw [htile, (TileTranslationFormulas T (vectors i)).2.2.2.2.1] at hcq + apply Zsqrtd.ext + · have hh := congrArg Prod.fst hcq + dsimp at hh + exact_mod_cast (by linarith : (((vectors i).re : Int) : Real) = 0) + · have hh := congrArg Prod.snd hcq + dsimp at hh + exact_mod_cast (by linarith : (((vectors i).im : Int) : Real) = 0) + have hcoord : coordinates i = (0, 0) := by + apply coordinate_unique + rw [← vector_repr i, hz] + simp + fin_cases i <;> simp [coordinates] at hcoord + · have hnonzero : (⟨vectors i, vector_mem i⟩ : TilingLattice C) ≠ 0 := by + intro hz + have hz' := congrArg Subtype.val hz + have hz'' : vectors i = 0 := by simpa using hz' + have hcoord : coordinates i = (0, 0) := by + apply coordinate_unique + calc + (coordinates i).1 * BandVectors.1 (q 1) (q 0) + + (coordinates i).2 * BandVectors.1 (q 2) (q 0) = vectors i := + (vector_repr i).symm + _ = 0 := hz'' + _ = (0 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (0 : GaussianInt) * BandVectors.1 (q 2) (q 0) := by simp + fin_cases i <;> simp [coordinates] at hcoord + apply (border_iff_index ⟨vectors i, vector_mem i⟩ hnonzero).2 + fin_cases i + · exact ⟨0, Or.inl rfl⟩ + · exact ⟨1, Or.inl rfl⟩ + · exact ⟨2, Or.inl rfl⟩ + · exact ⟨0, Or.inr rfl⟩ + · exact ⟨1, Or.inr rfl⟩ + · exact ⟨2, Or.inr rfl⟩ + ⟩ + Function.Surjective map ) := by + classical + intro C q T P htile translate_zero border_iff_index vectors coordinates coordinate_unique + vector_repr vector_mem target map U + obtain ⟨a, haU, hUa⟩ := RegularTileFamilyTranslationUnique T + (TilingLattice C) U.1 U.property.1 + have translate_eq (i : Fin 6) (hi : vectors i = (a : GaussianInt)) : + map i = U := by + apply Subtype.ext + dsimp [map] + have hidx : (↑(⟨vectors i, vector_mem i⟩ : TilingLattice C) : GaussianInt) = + (a : GaussianInt) := hi + rw [htile, hidx, ← haU] + have hUtile : P.tile a = U.1 := (htile a).trans haU.symm + obtain ⟨j, hj | hj⟩ := (border_iff_index a (by + intro hz + apply U.property.2.1 + calc + U.1 = TileTranslation T (a : GaussianInt) := haU + _ = TileTranslation T 0 := by + have hz' := congrArg Subtype.val hz + rw [hz'] + rfl + _ = T := translate_zero)).1 (by + rw [hUtile] + exact U.property.2.2) + · fin_cases j + · exact ⟨0, translate_eq 0 (by simpa [vectors] using hj.symm)⟩ + · exact ⟨1, translate_eq 1 (by simpa [vectors] using hj.symm)⟩ + · exact ⟨2, translate_eq 2 (by simpa [vectors] using hj.symm)⟩ + · fin_cases j + · exact ⟨3, translate_eq 3 (by simpa [vectors] using hj.symm)⟩ + · exact ⟨4, translate_eq 4 (by simpa [vectors] using hj.symm)⟩ + · exact ⟨5, translate_eq 5 (by simpa [vectors] using hj.symm)⟩ + +end TileTopologyGeometry + +theorem BandTileTopologyApplication (C : BandCircle) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hqC : q 0 = C.1.1) (T : ProtoTile) (hT : BandPrototile (q 0) T) : + ExactTileTiling (RegularTileFamily T (TilingLattice C)) ∧ + Nat.card {U : ProtoTile // + U ∈ RegularTileFamily T (TilingLattice C) ∧ U ≠ T ∧ + TileBordering T U} = 6 := by +-- BODY + classical + obtain ⟨P, hPlattice, htile, hadj, hpos, hv, he, hf, hchart⟩ := + BandRegularTranslatePeriodicComplex C q hq hqC T hT + have family_eq : RegularTileFamily T (TilingLattice C) = Set.range P.tile := + TileTopologyGeometry.family_eq C T P htile + refine ⟨?_, ?_⟩ + · rw [family_eq] + exact PeriodicTileMultiplicityOne P + · have edge_in_footprint (S : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges S) : e ∈ FootprintEdges S := + TileTopologyGeometry.edge_in_footprint S e he + have centroid_difference (x y : GaussianInt) : + TileCentroid (TileTranslation T y) - TileCentroid (TileTranslation T x) = + GaussianRealPoint (y - x) := TileTopologyGeometry.centroid_difference T x y + have translate_zero : TileTranslation T 0 = T := @TileTopologyGeometry.translate_zero C q T hT + P htile hchart family_eq centroid_difference + have realPoint_injective : Function.Injective GaussianRealPoint := + TileTopologyGeometry.realPoint_injective + have hpositive : 0 < (q 0).1 := (ProperBandCurvatureStructure q hq).1 + have harea := (BandTileSimultaneousInduction q hq T hT).2.1 + have hnonempty (x : GaussianInt) : + (TileTranslation T x).cells.Nonempty := TileTopologyGeometry.hnonempty C q T P hpositive + harea x + have border_touch (U : ProtoTile) (hU : U ∈ RegularTileFamily T (TilingLattice C)) + (hneq : U ≠ T) : TileTouching T U → TileBordering T U := + @TileTopologyGeometry.border_touch C q T hT P htile hchart family_eq + centroid_difference translate_zero harea hnonempty U hU hneq + have border_iff_index (a : TilingLattice C) (ha0 : a ≠ 0) : + TileBordering T (P.tile a) ↔ + ∃ j : Fin 3, (a : GaussianInt) = BandVectors.1 (q j.succ) (q 0) ∨ + (a : GaussianInt) = -BandVectors.1 (q j.succ) (q 0) := + TileTopologyGeometry.border_iff_index C q hq hqC T hT P htile hadj + edge_in_footprint centroid_difference translate_zero border_touch a ha0 + have hbasis := TilingLatticeBasis C q hq hqC + have ha : BandVectors.1 (q 1) (q 0) ∈ TilingLattice C := hbasis.1 + have hb : BandVectors.1 (q 2) (q 0) ∈ TilingLattice C := hbasis.2.1 + have hsum := IncomingSuperbasisRelation q hq + have hc : BandVectors.1 (q 3) (q 0) = + -BandVectors.1 (q 1) (q 0) - BandVectors.1 (q 2) (q 0) := TileTopologyGeometry.hcAt267 q + hsum + have hcmem : BandVectors.1 (q 3) (q 0) ∈ TilingLattice C := TileTopologyGeometry.hcmem C q ha + hb hc + let vectors : Fin 6 → GaussianInt := + ![BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0), + BandVectors.1 (q 3) (q 0), -BandVectors.1 (q 1) (q 0), + -BandVectors.1 (q 2) (q 0), -BandVectors.1 (q 3) (q 0)] + let coordinates : Fin 6 → Int × Int := + ![(1, 0), (0, 1), (-1, -1), (-1, 0), (0, -1), (1, 1)] + have coordinate_unique (m n : Int × Int) + (hm : (m.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (m.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) = + (n.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (n.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) : m = n := + TileTopologyGeometry.coordinate_unique C q hbasis ha hb m n hm + have vector_repr (i : Fin 6) : + vectors i = (coordinates i).1 * BandVectors.1 (q 1) (q 0) + + (coordinates i).2 * BandVectors.1 (q 2) (q 0) := TileTopologyGeometry.vector_repr q hc i + have vector_injective : Function.Injective vectors := TileTopologyGeometry.vector_injective q + coordinate_unique vector_repr + have vector_mem (i : Fin 6) : vectors i ∈ TilingLattice C := TileTopologyGeometry.vector_mem + C q ha hb hcmem i + let target : Type := {U : ProtoTile // + U ∈ RegularTileFamily T (TilingLattice C) ∧ U ≠ T ∧ TileBordering T U} + let map : Fin 6 → target := fun i => + ⟨P.tile ⟨vectors i, vector_mem i⟩, by + refine ⟨⟨vectors i, vector_mem i, htile _⟩, ?_, ?_⟩ + · intro heq + have heqTile : P.tile ⟨vectors i, vector_mem i⟩ = T := heq + have hz : vectors i = 0 := TileTopologyGeometry.hzAt326 C q T P htile vector_mem i heqTile + have hcoord : coordinates i = (0, 0) := TileTopologyGeometry.hcoordAt336 q + coordinate_unique vector_repr i hz + fin_cases i <;> simp [coordinates] at hcoord + · have hnonzero : (⟨vectors i, vector_mem i⟩ : TilingLattice C) ≠ 0 := + TileTopologyGeometry.hnonzero C q coordinate_unique vector_repr vector_mem i + apply (border_iff_index ⟨vectors i, vector_mem i⟩ hnonzero).2 + fin_cases i + · exact ⟨0, Or.inl rfl⟩ + · exact ⟨1, Or.inl rfl⟩ + · exact ⟨2, Or.inl rfl⟩ + · exact ⟨0, Or.inr rfl⟩ + · exact ⟨1, Or.inr rfl⟩ + · exact ⟨2, Or.inr rfl⟩ + ⟩ + have map_injective : Function.Injective map := TileTopologyGeometry.map_injective C q T P + htile border_iff_index coordinate_unique vector_repr vector_injective vector_mem + have map_surjective : Function.Surjective map := TileTopologyGeometry.map_surjective C q T P + htile translate_zero border_iff_index coordinate_unique vector_repr vector_mem + change Nat.card target = 6 + rw [← Fintype.card_fin 6] + simpa [Nat.card_eq_fintype_card] using + (Nat.card_congr (Equiv.ofBijective map ⟨map_injective, map_surjective⟩)).symm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandTwelveParentSurround.lean b/LeanPool/ApollonianSuperharmonic/BandTwelveParentSurround.lean new file mode 100644 index 0000000000..def5d371eb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandTwelveParentSurround.lean @@ -0,0 +1,542 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches +public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.FinitePatchTopology +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.UniqueBoundedGridComplementComponent +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.P4630T1AffineCellSymmetry +public import LeanPool.ApollonianSuperharmonic.P4630T1CellRouteLift +public import LeanPool.ApollonianSuperharmonic.P4630T1ExteriorNeighbors +public import LeanPool.ApollonianSuperharmonic.P4630T1ExteriorWalks +public import LeanPool.ApollonianSuperharmonic.P4630T1GridComplementCriterion +public import LeanPool.ApollonianSuperharmonic.P4630T1ParentRotation + +-- [TABLET NODE: BandTwelveParentSurround] + +/-! +# BandTwelveParentSurround + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TwelveParentGeometry + +private theorem incoming : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (BandVectors.1 + (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) ) := by + classical + intro q cfg + simpa [Fin.sum_univ_succ, add_assoc] using + (IncomingSuperbasisRelation q cfg.proper).1 + +private theorem outgoing : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + + BandVectors.1 (q 3) (q 0) = 0) → ((∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin + (4 : ℕ))) (q j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) + (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ)))) → + (BandVectors.1 (q 0) (q 1) + BandVectors.1 (q 0) (q 2) + BandVectors.1 (q 0) (q 3) = + 0)) ) := by + classical + intro q incoming flip + have f₀ : BandVectors.1 (q 0) (q 1) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 1) (q 0) := (flip 0).1 + have f₁ : BandVectors.1 (q 0) (q 2) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 2) (q 0) := (flip 1).1 + have f₂ : BandVectors.1 (q 0) (q 3) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 3) (q 0) := (flip 2).1 + rw [f₀, f₁, f₂] + calc + _ = (⟨0, 1⟩ : GaussianInt) * (BandVectors.1 (q 1) (q 0) + + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0)) := by ring + _ = 0 := by rw [incoming]; simp + +private theorem third : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (BandVectors.1 (q 0) (q 1) + BandVectors.1 (q 0) (q 2) + BandVectors.1 (q 0) + (q 3) = 0) → (BandVectors.1 (q 0) (q 3) = -cert.u - cert.v) ) := by + classical + intro q cfg C₀ T cert outgoing + rw [cert.period_u, cert.period_v] + linear_combination outgoing + +private theorem values : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let R := fun i k => SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4630T1RingIndex i k) + (BandVectors.1 (q 0) (q 3) = -cert.u - cert.v) → (R 0 0 = TileTranslation (cert.P 0 true) + (BandVectors.1 (q 0) (q 3)) ∧ R 0 1 = TileTranslation (cert.P 0 true) (-BandVectors.1 + (q 0) (q 2)) ∧ R 0 2 = TileTranslation (cert.P 0 false) (-BandVectors.1 (q 0) (q 3)) + ∧ R 0 3 = TileTranslation (cert.P 0 false) (BandVectors.1 (q 0) (q 2)) ∧ R 1 0 = + TileTranslation (cert.P 1 true) (BandVectors.1 (q 0) (q 1)) ∧ R 1 1 = TileTranslation + (cert.P 1 true) (-BandVectors.1 (q 0) (q 3)) ∧ R 1 2 = TileTranslation (cert.P 1 + false) (-BandVectors.1 (q 0) (q 1)) ∧ R 1 3 = TileTranslation (cert.P 1 false) + (BandVectors.1 (q 0) (q 3)) ∧ R 2 0 = TileTranslation (cert.P 2 true) (BandVectors.1 + (q 0) (q 2)) ∧ R 2 1 = TileTranslation (cert.P 2 true) (-BandVectors.1 (q 0) (q 1)) ∧ + R 2 2 = TileTranslation (cert.P 2 false) (-BandVectors.1 (q 0) (q 2)) ∧ R 2 3 = + TileTranslation (cert.P 2 false) (BandVectors.1 (q 0) (q 1))) ) := by + classical + intro q cfg C₀ T cert R third + simp [R, P4630T1RingIndex, SubtileOccurrenceInterpretation, third, + ← cert.period_u, ← cert.period_v, sub_eq_add_neg, add_comm] + +private theorem nonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let R := fun i k => SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4630T1RingIndex i k) + let ring : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun k : Fin 4 => (R i k).cells)), 0⟩ + (∀ (x : LatticeCell), x ∈ ring.cells ↔ ∃ i k, x ∈ (R i k).cells) → ((R 0 0 = + TileTranslation (cert.P 0 true) (BandVectors.1 (q 0) (q 3)) ∧ R 0 1 = TileTranslation + (cert.P 0 true) (-BandVectors.1 (q 0) (q 2)) ∧ R 0 2 = TileTranslation (cert.P 0 + false) (-BandVectors.1 (q 0) (q 3)) ∧ R 0 3 = TileTranslation (cert.P 0 false) + (BandVectors.1 (q 0) (q 2)) ∧ R 1 0 = TileTranslation (cert.P 1 true) (BandVectors.1 + (q 0) (q 1)) ∧ R 1 1 = TileTranslation (cert.P 1 true) (-BandVectors.1 (q 0) (q 3)) ∧ + R 1 2 = TileTranslation (cert.P 1 false) (-BandVectors.1 (q 0) (q 1)) ∧ R 1 3 = + TileTranslation (cert.P 1 false) (BandVectors.1 (q 0) (q 3)) ∧ R 2 0 = + TileTranslation (cert.P 2 true) (BandVectors.1 (q 0) (q 2)) ∧ R 2 1 = TileTranslation + (cert.P 2 true) (-BandVectors.1 (q 0) (q 1)) ∧ R 2 2 = TileTranslation (cert.P 2 + false) (-BandVectors.1 (q 0) (q 2)) ∧ R 2 3 = TileTranslation (cert.P 2 false) + (BandVectors.1 (q 0) (q 1))) → (ring.cells.Nonempty)) ) := by + classical + intro q cfg C₀ T cert R ring union values + have lattice : LatticeTile (R 0 0) := by + rw [values.1] + exact (TileDiskAreaCovariance _ _).1.mp (cert.parent_lattice 0 true) + obtain ⟨x, hx⟩ := (LatticeTileGridStructure _ lattice).1.1 + exact ⟨x, (union x).mpr ⟨0, 0, hx⟩⟩ + +private theorem rotation : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let R := fun i k => SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4630T1RingIndex i k) + let ring : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun k : Fin 4 => (R i k).cells)), 0⟩ + (∀ (x : LatticeCell), x ∈ ring.cells ↔ ∃ i k, x ∈ (R i k).cells) → (∀ (t : GaussianInt), + (∀ (i : Fin (3 : ℕ)), ∀ (k : Fin (4 : ℕ)), Finset.image (fun (x : GaussianInt) => + GaussianQuarterTurn x - (1 : GaussianInt) + t) (SubtileOccurrenceInterpretation + cert.P cert.u cert.v (P4630T1RingIndex i k)).cells = + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4630T1RingIndex i (k + (1 : + Fin (4 : ℕ))))).cells) → (ring.cells.image (fun x => GaussianQuarterTurn x - 1 + t) = + ring.cells)) ) := by + classical + intro q cfg C₀ T cert R ring union t rotate + ext x + constructor + · rintro hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx + obtain ⟨i, k, hy⟩ := (union y).mp hy + apply (union _).mpr + refine ⟨i, k + 1, ?_⟩ + rw [← rotate i k] + exact Finset.mem_image.mpr ⟨y, hy, rfl⟩ + · intro hx + obtain ⟨i, k, hx⟩ := (union x).mp hx + have hk : k - 1 + 1 = k := by omega + rw [← hk, ← rotate i (k - 1)] at hx + obtain ⟨y, hy, he⟩ := Finset.mem_image.mp hx + exact Finset.mem_image.mpr ⟨y, (union y).mpr ⟨i, k - 1, hy⟩, he⟩ + +private theorem central : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (whole : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), + (whole.indices = {(⟨SixSubtileLabel.A, (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), + (⟨SixSubtileLabel.B, (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), (⟨SixSubtileLabel.C, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), (⟨SixSubtileLabel.D, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.E, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.F, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex)}) → ((whole.unionTile = T) → (∀ (x : LatticeCell), x ∈ T.cells + ↔ ∃ a : PeriodicSubtileIndex, (a.first = 0 ∧ a.second = 0) ∧ x ∈ (cert.modified.tile + a).cells)) ) := by + classical + intro q cfg C₀ T cert whole whole_indices whole_tile x + have h := whole.exact_union x + rw [whole_tile] at h + rw [h] + apply exists_congr + intro a + rw [whole_indices] + rcases a with ⟨l, m, n⟩ + cases l <;> simp [PeriodicSubtileIndex.mk.injEq] + +private theorem latticeAt243 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (cert.modified.tile + a).cells) → (∀ (whole : FiniteInducedTilePatch cert.modified.plane + cert.modified.tile), (whole.unionTile = T) → (LatticeTile T)) ) := by + classical + intro q cfg C₀ T cert indexed whole whole_tile + rw [← whole_tile] + exact FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) indexed + (fun a b _ h => cert.modified.adjacent_has_common_edge a b h) whole + +private theorem modified_subset : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (a : PeriodicSubtileIndex), (cert.modified.tile a).cells ⊆ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells ) := by + classical + intro q cfg C₀ T cert a + rw [cert.modified_tile] + rcases a with ⟨l, m, n⟩ + cases l <;> intro x hx + all_goals + simp only [ModifiedSubtileOccurrenceInterpretation, + SubtileOccurrenceInterpretation, TileTranslation] at hx ⊢ + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx + apply Finset.mem_image.mpr + refine ⟨y, ?_, rfl⟩ + first | exact (Finset.mem_sdiff.mp hy).1 | exact hy + +private theorem original_owner : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (x : LatticeCell), (x ∈ cert.O.cells) → (x ∈ (cert.P 0 false).cells)) → (∀ + (a : PeriodicSubtileIndex), ∀ (x : LatticeCell), (x ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells) → (x ∈ + (cert.modified.tile a).cells ∨ x ∈ (cert.modified.tile ⟨.B, a.first, + a.second⟩).cells)) ) := by + classical + intro q cfg C₀ T cert precursor a x hx + rcases a with ⟨l, m, n⟩ + cases l + · simp only [SubtileOccurrenceInterpretation, TileTranslation] at hx + obtain ⟨y, hy, he⟩ := Finset.mem_image.mp hx + by_cases ho : y ∈ cert.O.cells + · right + rw [cert.modified_tile] + exact Finset.mem_image.mpr ⟨y, precursor y ho, he⟩ + · left + rw [cert.modified_tile] + exact Finset.mem_image.mpr ⟨y, Finset.mem_sdiff.mpr ⟨hy, ho⟩, he⟩ + all_goals + left + simpa only [cert.modified_tile, ModifiedSubtileOccurrenceInterpretation, + SubtileOccurrenceInterpretation, TileTranslation] using hx + +private theorem external : + (by + classical + exact + ∀ (i k), + ¬ ((P4630T1RingIndex i k).first = 0 ∧ (P4630T1RingIndex i k).second = 0) ) := by + classical + intro i k + fin_cases i <;> fin_cases k <;> decide + +private theorem outside : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (cert.modified.tile + a).cells) → ((∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ a : PeriodicSubtileIndex, (a.first + = 0 ∧ a.second = 0) ∧ x ∈ (cert.modified.tile a).cells) → (∀ (a : + PeriodicSubtileIndex), (¬ (a.first = 0 ∧ a.second = 0)) → (∀ (x : LatticeCell), (x ∈ + (cert.modified.tile a).cells) → (x ∉ T.cells)))) ) := by + classical + intro q cfg C₀ T cert indexed central a ha x hx ht + obtain ⟨b, hb, hxb⟩ := (central x).mp ht + have he := (indexed x).unique hx hxb + exact ha (he.symm ▸ hb) + +private theorem disjoint : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let R := fun i k => SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4630T1RingIndex i k) + let ring : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun k : Fin 4 => (R i k).cells)), 0⟩ + (∀ (x : LatticeCell), x ∈ ring.cells ↔ ∃ i k, x ∈ (R i k).cells) → ((∀ (a : + PeriodicSubtileIndex), ∀ (x : LatticeCell), (x ∈ (SubtileOccurrenceInterpretation + cert.P cert.u cert.v a).cells) → (x ∈ (cert.modified.tile a).cells ∨ x ∈ + (cert.modified.tile ⟨.B, a.first, a.second⟩).cells)) → ((∀ (i k), ¬ + ((P4630T1RingIndex i k).first = 0 ∧ (P4630T1RingIndex i k).second = 0)) → ((∀ (a + : PeriodicSubtileIndex), (¬ (a.first = 0 ∧ a.second = 0)) → (∀ (x : LatticeCell), (x + ∈ (cert.modified.tile a).cells) → (x ∉ T.cells))) → ((T.cells : Set LatticeCell) ⊆ + (ring.cells : Set LatticeCell)ᶜ)))) ) := by + classical + intro q cfg C₀ T cert R ring union original_owner external outside x hx hr + obtain ⟨i, k, hr⟩ := (union x).mp hr + rcases original_owner _ x hr with h | h + · exact outside _ (external i k) x h hx + · exact outside ⟨.B, (P4630T1RingIndex i k).first, + (P4630T1RingIndex i k).second⟩ (external i k) x h hx + +private theorem common_edge : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : LatticeCell), ∀ (y : LatticeCell), (x ∈ + U.cells) → ((y ∈ V.cells) → ((FourNeighborAdjacent x y) → ((FootprintEdges U ∩ + FootprintEdges V).Nonempty))) ) := by + classical + intro U V x y hx hy h + rcases h with rfl | rfl | rfl | rfl + · exact ⟨{x + 1, x + 1 + ⟨0, 1⟩}, + ⟨x, hx, Or.inr (Or.inr (Or.inl rfl))⟩, + ⟨x + 1, hy, Or.inr (Or.inl rfl)⟩⟩ + · refine ⟨{x, x + ⟨0, 1⟩}, ⟨x, hx, Or.inr (Or.inl rfl)⟩, + ⟨x - 1, hy, Or.inr (Or.inr (Or.inl ?_))⟩⟩ + simp + · refine ⟨{x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}, + ⟨x, hx, Or.inr (Or.inr (Or.inr rfl))⟩, + ⟨x + ⟨0, 1⟩, hy, Or.inl ?_⟩⟩ + simp [add_comm, add_left_comm, add_assoc] + · refine ⟨{x, x + 1}, ⟨x, hx, Or.inl rfl⟩, + ⟨x - ⟨0, 1⟩, hy, Or.inr (Or.inr (Or.inr ?_))⟩⟩ + congr 1 <;> abel + +private theorem boundary : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let R := fun i k => SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4630T1RingIndex i k) + let ring : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun k : Fin 4 => (R i k).cells)), 0⟩ + (∀ (x : LatticeCell), x ∈ ring.cells ↔ ∃ i k, x ∈ (R i k).cells) → ((∀ (x : LatticeCell), + ∃! a : PeriodicSubtileIndex, x ∈ (cert.modified.tile a).cells) → ((∀ (x : + LatticeCell), x ∈ T.cells ↔ ∃ a : PeriodicSubtileIndex, (a.first = 0 ∧ a.second = 0) + ∧ x ∈ (cert.modified.tile a).cells) → ((∀ (a : PeriodicSubtileIndex), + (cert.modified.tile a).cells ⊆ (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a).cells) → ((∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : LatticeCell), ∀ (y : + LatticeCell), (x ∈ U.cells) → ((y ∈ V.cells) → ((FourNeighborAdjacent x y) → + ((FootprintEdges U ∩ FootprintEdges V).Nonempty)))) → (∀ x ∈ T.cells, ∀ y, + FourNeighborAdjacent x y → y ∉ T.cells → y ∈ ring.cells))))) ) := by + classical + intro q cfg C₀ T cert R ring union indexed central modified_subset common_edge x hx y hxy hy + obtain ⟨a, ha, hxa⟩ := (central x).mp hx + obtain ⟨b, hyb, _⟩ := indexed y + have hb : ¬ (b.first = 0 ∧ b.second = 0) := + fun hb => hy ((central y).mpr ⟨b, hb, hyb⟩) + have hne : a ≠ b := fun h => hb (h ▸ ha) + have adj := ((PeriodicTileIntersectionClassification cert.modified).1 a b hne).1.mp + (common_edge _ _ x y hxa hyb hxy) + obtain ⟨i, k, he⟩ := P4630T1ExteriorNeighbors + ((cert.modified_adjacency a b).mp adj) ha hb + apply (union y).mpr + exact ⟨i, k, modified_subset _ (he ▸ hyb)⟩ + +private theorem escape : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let R := fun i k => SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4630T1RingIndex i k) + let ring : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun k : Fin 4 => (R i k).cells)), 0⟩ + (∀ (x : LatticeCell), x ∈ ring.cells ↔ ∃ i k, x ∈ (R i k).cells) → ((∀ (x : LatticeCell), + ∃! a : PeriodicSubtileIndex, x ∈ (cert.modified.tile a).cells) → ((∀ (x : + LatticeCell), x ∈ T.cells ↔ ∃ a : PeriodicSubtileIndex, (a.first = 0 ∧ a.second = 0) + ∧ x ∈ (cert.modified.tile a).cells) → ((∀ (a : PeriodicSubtileIndex), + (cert.modified.tile a).cells ⊆ (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a).cells) → ((∀ (a : PeriodicSubtileIndex), ∀ (x : LatticeCell), (x ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells) → (x ∈ + (cert.modified.tile a).cells ∨ x ∈ (cert.modified.tile ⟨.B, a.first, + a.second⟩).cells)) → (∀ x, x ∉ T.cells → x ∉ ring.cells → ∃ f : Nat → LatticeCell, + Function.Injective f ∧ ∀ n, Relation.ReflTransGen (fun a b => FourNeighborAdjacent a + b ∧ a ∉ ring.cells ∧ b ∉ ring.cells) x (f n)))))) ) := by + classical + intro q cfg C₀ T cert R ring union indexed central modified_subset original_owner x hxT hxR + let safe := fun a : PeriodicSubtileIndex => + ¬ (a.first = 0 ∧ a.second = 0) ∧ ∀ i k, a ≠ P4630T1RingIndex i k + let clean := fun z : LatticeCell => ∀ i k, z ∉ (R i k).cells + have clean_iff (z : LatticeCell) : clean z ↔ z ∉ ring.cells := by + simp only [union, not_exists, clean] + obtain ⟨a, hxa, _⟩ := indexed x + have ha : safe a := by + refine ⟨fun hz => hxT ((central x).mpr ⟨a, hz, hxa⟩), ?_⟩ + intro i k he + exact hxR ((union x).mpr ⟨i, k, modified_subset _ (he ▸ hxa)⟩) + obtain ⟨f, hf, hwalk⟩ := P4630T1ExteriorWalks a ha + have cell (n : Nat) : (cert.modified.tile (f n)).cells.Nonempty := + (LatticeTileGridStructure _ (cert.modified.tiles_are_disks (f n))).1.1 + let g : Nat → LatticeCell := fun n => Classical.choose (cell n) + have hg (n : Nat) : g n ∈ (cert.modified.tile (f n)).cells := + Classical.choose_spec (cell n) + have hgclean (n : Nat) : clean (g n) := by + intro i k hn + rcases original_owner _ (g n) hn with h | h + · exact (hwalk n).2.1.2 i k ((indexed _).unique (hg n) h) + · have he := congrArg PeriodicSubtileIndex.label ((indexed _).unique (hg n) h) + rw [(hwalk n).1] at he + cases he + refine ⟨g, ?_, ?_⟩ + · intro n m he + apply hf + exact (indexed (g n)).unique (hg n) (by rw [he]; exact hg m) + · intro n + have h := P4630T1CellRouteLift q cfg C₀ T cert a (f n) ha + (hwalk n).2.1 (hwalk n).2.2 x hxa ((clean_iff x).mpr hxR) + (g n) (hg n) (hgclean n) + exact Relation.ReflTransGen.mono + (fun z w e => ⟨e.1, (clean_iff z).mp e.2.1, + (clean_iff w).mp e.2.2⟩) x (g n) h + +end TwelveParentGeometry + +theorem BandTwelveParentSurround + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + ∃ R : Fin 3 → Fin 4 → ProtoTile, ∃ ring : ProtoTile, + R 0 0 = TileTranslation (cert.P 0 true) (BandVectors.1 (q 0) (q 3)) ∧ + R 0 1 = TileTranslation (cert.P 0 true) (-BandVectors.1 (q 0) (q 2)) ∧ + R 0 2 = TileTranslation (cert.P 0 false) (-BandVectors.1 (q 0) (q 3)) ∧ + R 0 3 = TileTranslation (cert.P 0 false) (BandVectors.1 (q 0) (q 2)) ∧ + R 1 0 = TileTranslation (cert.P 1 true) (BandVectors.1 (q 0) (q 1)) ∧ + R 1 1 = TileTranslation (cert.P 1 true) (-BandVectors.1 (q 0) (q 3)) ∧ + R 1 2 = TileTranslation (cert.P 1 false) (-BandVectors.1 (q 0) (q 1)) ∧ + R 1 3 = TileTranslation (cert.P 1 false) (BandVectors.1 (q 0) (q 3)) ∧ + R 2 0 = TileTranslation (cert.P 2 true) (BandVectors.1 (q 0) (q 2)) ∧ + R 2 1 = TileTranslation (cert.P 2 true) (-BandVectors.1 (q 0) (q 1)) ∧ + R 2 2 = TileTranslation (cert.P 2 false) (-BandVectors.1 (q 0) (q 2)) ∧ + R 2 3 = TileTranslation (cert.P 2 false) (BandVectors.1 (q 0) (q 1)) ∧ + (∀ x, x ∈ ring.cells ↔ ∃ i k, x ∈ (R i k).cells) ∧ + QuarterTurnSymmetric ring ∧ + UniqueBoundedGridComplementComponent + (ring.cells : Set GaussianInt) (T.cells : Set GaussianInt) := by +-- BODY + classical + let R := fun i k => SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4630T1RingIndex i k) + let ring : ProtoTile := + ⟨Finset.univ.biUnion (fun i : Fin 3 => + Finset.univ.biUnion (fun k : Fin 4 => (R i k).cells)), 0⟩ + have union (x : LatticeCell) : x ∈ ring.cells ↔ ∃ i k, x ∈ (R i k).cells := by + simp [ring] + have incoming := TwelveParentGeometry.incoming q cfg + have flip := (VectorRecursionLaws q cfg.proper.1).2.2.2.2 cfg.proper + have outgoing := TwelveParentGeometry.outgoing q incoming flip + have third := TwelveParentGeometry.third q cfg C₀ T cert outgoing + have values := TwelveParentGeometry.values q cfg C₀ T cert third + have nonempty := TwelveParentGeometry.nonempty q cfg C₀ T cert union values + obtain ⟨t, _, rotate⟩ := P4630T1ParentRotation q cfg C₀ T cert + have rotation := TwelveParentGeometry.rotation q cfg C₀ T cert union t rotate + have symmetric := P4630T1AffineCellSymmetry ring t nonempty rotation + have indexed := PeriodicTileIndexedMultiplicityOne cert.modified + obtain ⟨whole, whole_indices, whole_tile, _⟩ := + BandOrderedGeneralFinitePatches q cfg C₀ T cert + have central (x : LatticeCell) := TwelveParentGeometry.central q cfg C₀ T cert whole + whole_indices whole_tile x + have lattice := TwelveParentGeometry.latticeAt243 q cfg C₀ T cert indexed whole whole_tile + have precursor (x : LatticeCell) (hx : x ∈ cert.O.cells) : + x ∈ (cert.P 0 false).cells := + (cert.minus_union x).mpr ⟨0, true, by simpa only [← cert.precursor_cells] using hx⟩ + have modified_subset (a : PeriodicSubtileIndex) := TwelveParentGeometry.modified_subset q cfg + C₀ T cert a + have original_owner (a : PeriodicSubtileIndex) (x : LatticeCell) + (hx : x ∈ (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells) := + TwelveParentGeometry.original_owner q cfg C₀ T cert precursor a x hx + have external (i : Fin 3) (k : Fin 4) := TwelveParentGeometry.external i k + have outside (a : PeriodicSubtileIndex) (ha : ¬ (a.first = 0 ∧ a.second = 0)) + (x : LatticeCell) (hx : x ∈ (cert.modified.tile a).cells) := TwelveParentGeometry.outside q + cfg C₀ T cert indexed central a ha x hx + have disjoint := TwelveParentGeometry.disjoint q cfg C₀ T cert union original_owner external + outside + have common_edge (U V : ProtoTile) (x y : LatticeCell) + (hx : x ∈ U.cells) (hy : y ∈ V.cells) (h : FourNeighborAdjacent x y) := + TwelveParentGeometry.common_edge U V x y hx hy h + have boundary := TwelveParentGeometry.boundary q cfg C₀ T cert union indexed central + modified_subset common_edge + have escape := TwelveParentGeometry.escape q cfg C₀ T cert union indexed central + modified_subset original_owner + refine ⟨R, ring, values.1, values.2.1, values.2.2.1, values.2.2.2.1, + values.2.2.2.2.1, values.2.2.2.2.2.1, values.2.2.2.2.2.2.1, + values.2.2.2.2.2.2.2.1, values.2.2.2.2.2.2.2.2.1, + values.2.2.2.2.2.2.2.2.2.1, values.2.2.2.2.2.2.2.2.2.2.1, + values.2.2.2.2.2.2.2.2.2.2.2, union, symmetric, ?_⟩ + exact P4630T1GridComplementCriterion _ _ T.cells.finite_toSet + (LatticeTileGridStructure T lattice).1 disjoint boundary escape + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoreCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoreCertificate.lean new file mode 100644 index 0000000000..bc48acb66a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoreCertificate.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileFaceIndex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation + +-- [TABLET NODE: BandUnmodifiedCoreCertificate] + +/-! +# BandUnmodifiedCoreCertificate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A band unmodified-core certificate for six occurrences $S_i^\pm$, period +vectors $u,v$, and lattice $L$ is a `PeriodicTileCore` whose vertex +indexed at $(X,m,n)$ is exactly the occurrence prescribed by +`SubtileOccurrenceInterpretation`. Its combinatorial adjacency +relation is exactly the fixed eighteen-edge ledger +`AllowedSubtileIncidence`; this field does not assert that every +pair having an isolated common footprint vertex is adjacent. Its faces are equivariantly +identified with the translated twelve-face ledger of +`SixSubtileFaceVertices`. The certificate also records integral +coordinates of every lattice translation and requires face translation to +add those coordinates to the complete face index. Its selected vertex and +face orbit representatives are exactly the six and twelve indices with +translation coordinates $(0,0)$. Consequently its face +orbits are exactly $I_1,\ldots,I_4,J_1,\ldots,J_8$ and its edge orbits are +exactly the eighteen unoriented rows generating allowed incidence. +Possible zero-dimensional contacts outside those rows are not additional +edges of this ledger. +-/ +structure BandUnmodifiedCoreCertificate (S : Fin 3 -> Bool -> ProtoTile) + (u v : GaussianInt) (L : AddSubgroup GaussianInt) where +-- BODY + /-- The periodic core on the literal six-type occurrence indices. -/ + core : PeriodicTileCore PeriodicSubtileIndex + lattice_eq : core.lattice = L + tile_eq : forall o, + core.tile o = SubtileOccurrenceInterpretation S u v o + vertex_reps : forall o, + o ∈ core.vertexOrbitReps <-> o.first = 0 ∧ o.second = 0 + adjacent_iff : forall a b, + core.plane.adjacent a b <-> AllowedSubtileIncidence a b + /-- Identify the core faces with the twelve translated face labels. -/ + faceEquiv : core.plane.Face ≃ PeriodicSubtileFaceIndex + face_vertices : forall f i, + core.plane.faceVertex f i = SixSubtileFaceVertices (faceEquiv f) i + face_reps : forall f, + f ∈ core.faceOrbitReps <-> + (faceEquiv f).first = 0 ∧ (faceEquiv f).second = 0 + /-- Integral coordinates of a period in the selected two-vector basis. -/ + latticeCoordinates : core.lattice -> Int × Int + latticeCoordinates_spec : forall w, + (latticeCoordinates w).1 * u + (latticeCoordinates w).2 * v = + (w : GaussianInt) + face_shift : forall w f, + faceEquiv (core.faceShift w f) = + { faceEquiv f with + first := (faceEquiv f).first + (latticeCoordinates w).1 + second := (faceEquiv f).second + (latticeCoordinates w).2 } + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoverage.lean b/LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoverage.lean new file mode 100644 index 0000000000..7d1379bef9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoverage.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoreCertificate +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCoverage + +-- [TABLET NODE: BandUnmodifiedCoverage] + +/-! +# BandUnmodifiedCoverage + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandUnmodifiedCoverage (P : Fin 3 -> Bool -> ProtoTile) + (u v : GaussianInt) (L : AddSubgroup GaussianInt) + (K : BandUnmodifiedCoreCertificate P u v L) : + forall x : LatticeCell, exists o : PeriodicSubtileIndex, + x ∈ (SubtileOccurrenceInterpretation P u v o).cells := by +-- BODY + intro x + obtain ⟨o, ho⟩ := PeriodicTileCoverage K.core x + refine ⟨o, ?_⟩ + rw [← K.tile_eq o] + exact ho + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandUnmodifiedPeriodicCore.lean b/LeanPool/ApollonianSuperharmonic/BandUnmodifiedPeriodicCore.lean new file mode 100644 index 0000000000..182c2b9355 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandUnmodifiedPeriodicCore.lean @@ -0,0 +1,202 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoreCertificate +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.P4677T2DrawingExists +public import LeanPool.ApollonianSuperharmonic.P4677T2IncidenceLedger +public import LeanPool.ApollonianSuperharmonic.P4677T2ThreeConnected +public import LeanPool.ApollonianSuperharmonic.P4677T2FacePoints +public import LeanPool.ApollonianSuperharmonic.P4677T2TouchingWalk +public import LeanPool.ApollonianSuperharmonic.P4677T2PrecursorWalk +public import LeanPool.ApollonianSuperharmonic.P4677T2PeriodicWalkAssembly +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.LatticeFundamentalSet +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: BandUnmodifiedPeriodicCore] + +/-! +# BandUnmodifiedPeriodicCore + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandUnmodifiedPeriodicCore + (P Q S : Fin 3 -> Bool -> ProtoTile) (u v : GaussianInt) + (L : AddSubgroup GaussianInt) (R : Finset GaussianInt) + (hu : u ∈ L) (hv : v ∈ L) + (hfund : LatticeFundamentalSet L R) + (hcoords : ∀ w : L, ∃! mn : Int × Int, + ((mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v) = + (w : GaussianInt)) + (hdisks : forall i s, LatticeTile (P i s)) + (hQcells : forall i s, (Q i s).cells ⊆ (P 0 true).cells) + (hScells : forall i s, (S i s).cells ⊆ (P 0 false).cells) + (hQfoot : forall i s, + FootprintVertices (Q i s) ⊆ FootprintVertices (P 0 true)) + (hSfoot : forall i s, + FootprintVertices (S i s) ⊆ FootprintVertices (P 0 false)) + (hcommon : (Q 0 false).cells = (S 0 true).cells) + (hcommonAnchor : (Q 0 false).cells = ∅ -> + (Q 0 false).anchor = (S 0 true).anchor) + (hOdisk : (Q 0 false).cells.Nonempty -> LatticeTile (Q 0 false)) + (hprecursorFaces : + TouchingTriple (Q 1 true) (S 2 false) (Q 0 false) ∧ + TouchingTriple (Q 2 true) (S 1 false) (Q 0 false)) + (hinner : + TouchingTriple (Q 1 true) (S 2 false) (P 1 true) ∧ + TouchingTriple (Q 2 true) (S 1 false) (P 1 false) ∧ + TouchingTriple (Q 1 true) (P 1 true) (P 2 false) ∧ + TouchingTriple (S 1 false) (P 1 false) (P 2 true)) + (houter : + TouchingTriple (P 0 true) (TileTranslation (P 0 false) v) + (TileTranslation (P 2 true) v) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) v) + (P 2 false) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) (u + v)) + (TileTranslation (P 1 true) (u + v)) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) (u + v)) + (P 1 false) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 1 true) (u + v)) + (TileTranslation (P 2 true) v) ∧ + TouchingTriple (P 0 false) (TileTranslation (P 1 false) (-u - v)) + (TileTranslation (P 2 false) (-v)) ∧ + TouchingTriple (P 1 true) (TileTranslation (P 1 false) (-u)) + (TileTranslation (P 2 true) (-u)) ∧ + TouchingTriple (P 1 true) (TileTranslation (P 1 false) (-u)) + (P 2 false)) : + ∃ K : BandUnmodifiedCoreCertificate P u v L, + K.core.rho (K.faceEquiv.symm ⟨.I1, 0, 0⟩) ∈ + FootprintVertices (Q 1 true) ∩ FootprintVertices (S 2 false) ∧ + K.core.rho (K.faceEquiv.symm ⟨.I2, 0, 0⟩) ∈ + FootprintVertices (Q 2 true) ∩ FootprintVertices (S 1 false) ∧ + K.core.rho (K.faceEquiv.symm ⟨.I3, 0, 0⟩) ∈ + FootprintVertices (Q 1 true) ∩ FootprintVertices (P 1 true) := by +-- BODY + classical + obtain ⟨D⟩ := P4677T2DrawingExists u v L hu hv hcoords + obtain ⟨hsymm, hirrefl, hfinite, hdistinct, hedges, hfaces⟩ := + P4677T2IncidenceLedger + obtain ⟨rho, hrho, hrhoper, hI1, hI2, hI3, hI4⟩ := + P4677T2FacePoints P Q S u v L D hQfoot hSfoot hinner houter + have hAB := P4677T2PrecursorWalk + (P 0 true) (P 0 false) (Q 1 true) (S 2 false) + (Q 2 true) (S 1 false) (Q 0 false) (S 0 true) + (rho ⟨.I1, 0, 0⟩) (rho ⟨.I2, 0, 0⟩) + (hQcells 1 true) (hQcells 2 true) (hScells 2 false) (hScells 1 false) + (hQcells 0 false) (hScells 0 true) + (hQfoot 1 true) (hQfoot 2 true) (hSfoot 2 false) (hSfoot 1 false) + (hQfoot 0 false) (hSfoot 0 true) hcommon hcommonAnchor hOdisk + hprecursorFaces.1 hprecursorFaces.2 hI1 hI2 + obtain ⟨path, hreverse, hpathper, hpath⟩ := + P4677T2PeriodicWalkAssembly P Q S u v L D + hQcells hScells hQfoot hSfoot hinner houter rho hrho hrhoper + hI1 hI2 hI3 hI4 P4677T2TouchingWalk hAB + have compose (T : ProtoTile) (a b : GaussianInt) : + TileTranslation (TileTranslation T a) b = TileTranslation T (a + b) := by + cases T + simp only [TileTranslation, GaussianTranslation, Finset.image_image] + congr 1 + · congr 1 + funext x + exact add_assoc x a b + · exact add_assoc _ a b + have tile_periodic (w : L) (a : PeriodicSubtileIndex) : + SubtileOccurrenceInterpretation P u v (D.shift w a) = + TileTranslation (SubtileOccurrenceInterpretation P u v a) w := by + rw [D.shift_eq] + dsimp only [SubtileOccurrenceInterpretation] + have hsum : ((a.first + (D.coordinates w).1 : Int) : GaussianInt) * u + + ((a.second + (D.coordinates w).2 : Int) : GaussianInt) * v = + (a.first : GaussianInt) * u + (a.second : GaussianInt) * v + w := by + rw [← D.coordinates_spec w] + push_cast + ring + rw [hsum, compose] + have tile_disks (a : PeriodicSubtileIndex) : + LatticeTile (SubtileOccurrenceInterpretation P u v a) := by + rcases a with ⟨l, m, n⟩ + cases l <;> exact (TileDiskAreaCovariance _ _).1.mp (hdisks _ _) + let plane : PlaneTriangulation PeriodicSubtileIndex := { + adjacent := AllowedSubtileIncidence + Face := PeriodicSubtileFaceIndex + faceVertex := SixSubtileFaceVertices + position := D.position + edgeArc := D.edgeArc + faceRegion := D.faceRegion + adjacent_symmetric := hsymm + adjacent_irreflexive := hirrefl + locally_finite := hfinite + three_connected := P4677T2ThreeConnected + face_vertices_distinct := hdistinct + face_edges := hedges + every_edge_two_faces := hfaces + position_injective := D.position_injective + arc_symmetric := D.arc_symmetric + arc_homeomorph := D.arc_homeomorph + arc_intersections := D.arc_intersections + region_open := D.region_open + region_connected := D.region_connected + region_disjoint := D.region_disjoint + face_boundary := D.face_boundary + plane_cover := D.plane_cover } + let core : PeriodicTileCore PeriodicSubtileIndex := { + plane := plane + tile := SubtileOccurrenceInterpretation P u v + lattice := L + latticeReps := R + vertexOrbitReps := D.vertexReps + edgeOrbitReps := D.edgeReps + faceOrbitReps := D.faceReps + shift := D.shift + faceShift := D.faceShift + lattice_full_rank := hfund + tiles_are_disks := tile_disks + shift_zero := D.shift_zero + shift_add := D.shift_add + faceShift_zero := D.faceShift_zero + faceShift_add := D.faceShift_add + tile_periodic := tile_periodic + edge_periodic := D.edge_periodic + face_vertices_periodic := D.face_vertices_periodic + position_periodic := D.position_periodic + edgeArc_periodic := D.edgeArc_periodic + faceRegion_periodic := D.faceRegion_periodic + vertex_orbit_representatives := D.vertex_orbits + edge_orbit_representatives := D.edge_orbits + face_orbit_representatives := D.face_orbits + rho := rho + rho_common := hrho + rho_periodic := hrhoper + facePath := path + facePath_reverse := hreverse + facePath_periodic := hpathper + facePath_spec := hpath } + let K : BandUnmodifiedCoreCertificate P u v L := { + core := core + lattice_eq := rfl + tile_eq := fun _ => rfl + vertex_reps := D.vertex_reps + adjacent_iff := fun _ _ => Iff.rfl + faceEquiv := Equiv.refl _ + face_vertices := fun _ _ => rfl + face_reps := D.face_reps + latticeCoordinates := D.coordinates + latticeCoordinates_spec := D.coordinates_spec + face_shift := D.faceShift_eq } + exact ⟨K, hI1, hI2, hI3⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandVectorOrientationDichotomy.lean b/LeanPool/ApollonianSuperharmonic/BandVectorOrientationDichotomy.lean new file mode 100644 index 0000000000..48ebc70eaf --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandVectorOrientationDichotomy.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorsExistUnique + +-- [TABLET NODE: BandVectorOrientationDichotomy] + +/-! +# BandVectorOrientationDichotomy + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BandVectorOrientationDichotomy + (C D : CircleCoordinates) (hCD : BandTangency C D) : + (((⟨0, 1⟩ : GaussianInt) * BandVectors.1 C D = BandVectors.1 D C) ∧ + (-⟨0, 1⟩ : GaussianInt) * BandVectors.2 C D = BandVectors.2 D C) ∨ + (((⟨0, 1⟩ : GaussianInt) * BandVectors.1 C D = -BandVectors.1 D C) ∧ + (-⟨0, 1⟩ : GaussianInt) * BandVectors.2 C D = -BandVectors.2 D C) := by +-- BODY + have hsystem : RecursiveVectorSystem BandVectors := by + simpa [BandVectors] using + (Classical.choose_spec RecursiveVectorsExistUnique).1 + rcases (PrimitiveVectorOrientationUnique C D).2 hCD with ⟨_, horient⟩ + unfold Xor at horient + rcases horient with ⟨hforward, _⟩ | ⟨hbackward, _⟩ + · left + exact ⟨(hsystem.2.2.2 C D hforward).1.symm, + (hsystem.2.2.2 C D hforward).2.symm⟩ + · right + have hv := (hsystem.2.2.2 D C hbackward).1 + have ha := (hsystem.2.2.2 D C hbackward).2 + constructor + · rw [hv] + norm_num [Zsqrtd.ext_iff] + · rw [ha] + norm_num [Zsqrtd.ext_iff] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandVectors.lean b/LeanPool/ApollonianSuperharmonic/BandVectors.lean new file mode 100644 index 0000000000..8bf5012b43 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandVectors.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorsExistUnique +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation + +-- [TABLET NODE: BandVectors] + +/-! +# BandVectors + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Define $(v,a)$ to be the unique recursive vector system supplied by +`RecursiveVectorsExistUnique`. For every ordered +pair of raw curvature coordinates, $v(C,C')$ and $a(C,C')$ are its two +Gaussian-integer components. On ordered tangent pairs they are called the +lattice vector and slope vector; on non-tangent pairs they are zero. The +unique orientation of `PrimitiveVectorOrientation` and uniqueness +of the recursive system make these functions depend on coordinate pairs, +not on a chosen derivation of a semi-proper quadruple. +-/ +noncomputable def BandVectors : + (CircleCoordinates → CircleCoordinates → GaussianInt) × + (CircleCoordinates → CircleCoordinates → GaussianInt) := +-- BODY + Classical.choose RecursiveVectorsExistUnique + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryFootprintEdges.lean b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintEdges.lean new file mode 100644 index 0000000000..05247456dd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintEdges.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: BoundaryFootprintEdges] + +/-! +# BoundaryFootprintEdges + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The boundary-footprint edges of a prototile are the unit lattice edges +incident to exactly one of its cells. Concretely, the horizontal edge +$\{z,z+1\}$ is a boundary edge exactly when precisely one of the cells based +at $z$ and $z-i$ belongs to the prototile, and the vertical edge +$\{z,z+i\}$ is a boundary edge exactly when precisely one of the cells based +at $z$ and $z-1$ belongs to it. Thus these are actual boundary edges, not +edges inferred merely from their endpoints. +-/ +def BoundaryFootprintEdges (T : ProtoTile) : Set (Finset GaussianInt) := +-- BODY + {e | ∃ z : GaussianInt, + (e = {z, z + 1} ∧ + ((z ∈ T.cells ∧ z - ⟨0, 1⟩ ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - ⟨0, 1⟩ ∈ T.cells))) ∨ + (e = {z, z + ⟨0, 1⟩} ∧ + ((z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - 1 ∈ T.cells)))} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertexDegreeTwo.lean b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertexDegreeTwo.lean new file mode 100644 index 0000000000..62bd67d2ff --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertexDegreeTwo.lean @@ -0,0 +1,207 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex + +-- [TABLET NODE: BoundaryFootprintVertexDegreeTwo] + +/-! +# BoundaryFootprintVertexDegreeTwo + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BoundaryFootprintVertexDegreeTwo (T : ProtoTile) (hne : T.cells.Nonempty) + (hchecker : NoCheckerboardCellVertex (T.cells : Set LatticeCell)) + (v : GaussianInt) (hv : v ∈ BoundaryFootprintVertices T) : + Set.ncard {e : Finset GaussianInt | + e ∈ BoundaryFootprintEdges T ∧ v ∈ e} = 2 := by +-- BODY + classical + have incident_classify (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) (hve : v ∈ e) : + e = {v, v + 1} ∨ e = {v - 1, v} ∨ + e = {v, v + ⟨0, 1⟩} ∨ e = {v - ⟨0, 1⟩, v} := by + as_aux_lemma => + rcases he with ⟨z, (⟨rfl, hz⟩ | ⟨rfl, hz⟩)⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hve + rcases hve with rfl | hve + · exact Or.inl rfl + · subst v + right; left + congr 1; apply Zsqrtd.ext <;> simp + · simp only [Finset.mem_insert, Finset.mem_singleton] at hve + rcases hve with rfl | hve + · exact Or.inr (Or.inr (Or.inl rfl)) + · subst v + right; right; right + congr 1; apply Zsqrtd.ext <;> simp + have horizontal_unique (a b : GaussianInt) + (h : {a, a + 1} = ({b, b + 1} : Finset GaussianInt)) : a = b := by + as_aux_lemma => + have ha : a ∈ ({b, b + 1} : Finset GaussianInt) := by rw [← h]; simp + have ha1 : a + 1 ∈ ({b, b + 1} : Finset GaussianInt) := by rw [← h]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at ha ha1 + rcases ha with hab | hab <;> rcases ha1 with ha1b | ha1b + · exact hab + · exact hab + · exfalso + apply_fun Zsqrtd.re at hab ha1b + simp at hab ha1b + omega + · exfalso + apply_fun Zsqrtd.re at hab ha1b + simp at hab ha1b + omega + have vertical_unique (a b : GaussianInt) + (h : {a, a + ⟨0, 1⟩} = + ({b, b + ⟨0, 1⟩} : Finset GaussianInt)) : a = b := by + as_aux_lemma => + have ha : a ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← h]; simp + have ha1 : a + ⟨0, 1⟩ ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← h]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at ha ha1 + rcases ha with hab | hab <;> rcases ha1 with ha1b | ha1b + · exact hab + · exact hab + · exfalso + apply_fun Zsqrtd.im at hab ha1b + simp at hab ha1b + omega + · exfalso + apply_fun Zsqrtd.im at hab ha1b + simp at hab ha1b + omega + have horizontal_vertical_ne (a b : GaussianInt) : + ({a, a + 1} : Finset GaussianInt) ≠ {b, b + ⟨0, 1⟩} := by + as_aux_lemma => + intro h + have ha : a ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← h]; simp + have ha1 : a + 1 ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← h]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at ha ha1 + rcases ha with hab | hab <;> rcases ha1 with ha1b | ha1b + all_goals apply_fun Zsqrtd.re at hab ha1b; simp at hab ha1b; omega + have horizontal_mem_iff (z : GaussianInt) : + ({z, z + 1} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ + ((z ∈ T.cells ∧ z - ⟨0, 1⟩ ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - ⟨0, 1⟩ ∈ T.cells)) := by + as_aux_lemma => + constructor + · rintro ⟨a, (⟨ha, hocc⟩ | ⟨ha, hocc⟩)⟩ + · have haz := horizontal_unique a z ha.symm + simpa [haz] using hocc + · exact False.elim (horizontal_vertical_ne z a ha) + · intro h + exact ⟨z, Or.inl ⟨rfl, h⟩⟩ + have vertical_mem_iff (z : GaussianInt) : + ({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ + ((z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - 1 ∈ T.cells)) := by + as_aux_lemma => + constructor + · rintro ⟨a, (⟨ha, hocc⟩ | ⟨ha, hocc⟩)⟩ + · exact False.elim (horizontal_vertical_ne a z ha.symm) + · have haz := vertical_unique a z ha.symm + simpa [haz] using hocc + · intro h + exact ⟨z, Or.inr ⟨rfl, h⟩⟩ + rw [BoundaryFootprintVertices, ite_eq_left hne] at hv + rcases hv with ⟨e0, he0, hve0⟩ + let F : Finset (Finset GaussianInt) := + {{v, v + 1}, {v - 1, v}, {v, v + ⟨0, 1⟩}, {v - ⟨0, 1⟩, v}} + have hinc : {e : Finset GaussianInt | + e ∈ BoundaryFootprintEdges T ∧ v ∈ e} = + (↑(F.filter fun e => e ∈ BoundaryFootprintEdges T) : + Set (Finset GaussianInt)) := by + as_aux_lemma => + ext e + simp only [Set.mem_ofPred_eq, Finset.mem_coe, Finset.mem_filter] + constructor + · rintro ⟨he, hve⟩ + refine ⟨?_, he⟩ + rcases incident_classify e he hve with h | h | h | h <;> simp [F, h] + · rintro ⟨heF, he⟩ + refine ⟨he, ?_⟩ + simp only [F, Finset.mem_insert, Finset.mem_singleton] at heF + rcases heF with h | h | h | h <;> subst e <;> simp + rw [hinc, Set.ncard_coe_finset] + have hno := hchecker v + have he0cases := incident_classify e0 he0 hve0 + have hHm : ({v - 1, v} : Finset GaussianInt) = {v - 1, (v - 1) + 1} := by + simp + have hVm : ({v - ⟨0, 1⟩, v} : Finset GaussianInt) = + {v - ⟨0, 1⟩, (v - ⟨0, 1⟩) + ⟨0, 1⟩} := by + simp + have hHH : ({v, v + 1} : Finset GaussianInt) ≠ {v - 1, v} := by + intro h + have hvv := horizontal_unique v (v - 1) (h.trans hHm) + apply_fun Zsqrtd.re at hvv + simp at hvv + omega + have hVV : ({v, v + ⟨0, 1⟩} : Finset GaussianInt) ≠ + {v - ⟨0, 1⟩, v} := by + intro h + have hvv := vertical_unique v (v - ⟨0, 1⟩) (h.trans hVm) + apply_fun Zsqrtd.im at hvv + simp at hvv + omega + have hHV00 : ({v, v + 1} : Finset GaussianInt) ≠ + {v, v + ⟨0, 1⟩} := horizontal_vertical_ne v v + have hHV01 : ({v, v + 1} : Finset GaussianInt) ≠ + {v - ⟨0, 1⟩, v} := by + rw [hVm] + exact horizontal_vertical_ne v (v - ⟨0, 1⟩) + have hHV10 : ({v - 1, v} : Finset GaussianInt) ≠ + {v, v + ⟨0, 1⟩} := by + rw [hHm] + exact horizontal_vertical_ne (v - 1) v + have hHV11 : ({v - 1, v} : Finset GaussianInt) ≠ + {v - ⟨0, 1⟩, v} := by + rw [hHm, hVm] + exact horizontal_vertical_ne (v - 1) (v - ⟨0, 1⟩) + have hER := horizontal_mem_iff v + have hEL : ({v - 1, v} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ + ((v - 1 ∈ T.cells ∧ v - 1 - ⟨0, 1⟩ ∉ T.cells) ∨ + (v - 1 ∉ T.cells ∧ v - 1 - ⟨0, 1⟩ ∈ T.cells)) := by + simpa only [hHm] using horizontal_mem_iff (v - 1) + have hEU := vertical_mem_iff v + have hED : ({v - ⟨0, 1⟩, v} : Finset GaussianInt) ∈ + BoundaryFootprintEdges T ↔ + ((v - ⟨0, 1⟩ ∈ T.cells ∧ v - 1 - ⟨0, 1⟩ ∉ T.cells) ∨ + (v - ⟨0, 1⟩ ∉ T.cells ∧ v - 1 - ⟨0, 1⟩ ∈ T.cells)) := by + rw [hVm] + simpa only [sub_sub, add_comm] using vertical_mem_iff (v - ⟨0, 1⟩) + have hsome : + ({v, v + 1} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ∨ + ({v - 1, v} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ∨ + ({v, v + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ∨ + ({v - ⟨0, 1⟩, v} : Finset GaussianInt) ∈ BoundaryFootprintEdges T := by + rcases he0cases with h | h | h | h + · exact Or.inl (h ▸ he0) + · exact Or.inr (Or.inl (h ▸ he0)) + · exact Or.inr (Or.inr (Or.inl (h ▸ he0))) + · exact Or.inr (Or.inr (Or.inr (h ▸ he0))) + by_cases hA : v ∈ T.cells + all_goals by_cases hB : v - 1 ∈ T.cells + all_goals by_cases hC : v - ⟨0, 1⟩ ∈ T.cells + all_goals by_cases hD : v - 1 - ⟨0, 1⟩ ∈ T.cells + all_goals simp [hER, hEL, hEU, hED, hA, hB, hC, hD] at hno hsome + all_goals simp only [F, Finset.filter_insert, Finset.filter_singleton] + all_goals simp [hER, hEL, hEU, hED, hA, hB, hC, hD, + hHH, hVV, hHV00, hHV01, hHV10, hHV11] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertices.lean b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertices.lean new file mode 100644 index 0000000000..d23f73683a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertices.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges + +-- [TABLET NODE: BoundaryFootprintVertices] + +/-! +# BoundaryFootprintVertices + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The boundary-footprint vertices of a nonempty prototile are the endpoints of +its boundary-footprint edges. For an empty prototile, its boundary footprint +is instead the assigned singleton anchor, as in the paper's degenerate-tile +convention. +-/ +def BoundaryFootprintVertices (T : ProtoTile) : Set GaussianInt := +-- BODY + if T.cells.Nonempty then + {v | ∃ e ∈ BoundaryFootprintEdges T, v ∈ e} + else + {T.anchor} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryJoinChamberCertificate.lean b/LeanPool/ApollonianSuperharmonic/BoundaryJoinChamberCertificate.lean new file mode 100644 index 0000000000..08d8be729b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BoundaryJoinChamberCertificate.lean @@ -0,0 +1,219 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification +public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification +public import LeanPool.ApollonianSuperharmonic.BandTangency +public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation +public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TilingLattice +public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis +public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex +public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TriangularSignedHeight +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique +public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep +public import LeanPool.ApollonianSuperharmonic.VectorDeterminant +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P4994T6RotationLaws +public import LeanPool.ApollonianSuperharmonic.P4994T6ChartCovolume +public import LeanPool.ApollonianSuperharmonic.P4994T6NonunitChamber +public import LeanPool.ApollonianSuperharmonic.P4994T6UnitOccurrenceChamber +public import LeanPool.ApollonianSuperharmonic.P4994T6UnitChartRotation + +-- [TABLET NODE: BoundaryJoinChamberCertificate] + +/-! +# BoundaryJoinChamberCertificate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem BoundaryJoinChamberCertificate + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (C : BandCircle) (i : Fin 3) (hC : q i.succ = C.1.1) + (orientation : Bool) + (horientation : (q i.succ).1 = 1 → + UnitOccurrenceOrientation q i orientation) + (base : ProtoTile) (hbase : BandPrototile C.1.1 base) + (e f : GaussianInt) + (hdet : 0 < e.re * f.im - e.im * f.re) + (he : e ∈ TilingLattice C) (hf : f ∈ TilingLattice C) + (hcoord : ∀ w : TilingLattice C, ∃! z : Int × Int, + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f = + (w : GaussianInt)) + (hadj : ∀ x y : Int × Int, + (if C.1.1.1 = 1 then + ∃ t : GaussianInt, + UnitTriangularStep orientation t ∧ + TileCentroid (TileTranslation base + ((y.1 : GaussianInt) * e + (y.2 : GaussianInt) * f)) - + TileCentroid (TileTranslation base + ((x.1 : GaussianInt) * e + (x.2 : GaussianInt) * f)) = + GaussianRealPoint t + else + TileTouching + (TileTranslation base + ((x.1 : GaussianInt) * e + (x.2 : GaussianInt) * f)) + (TileTranslation base + ((y.1 : GaussianInt) * e + (y.2 : GaussianInt) * f))) ↔ + TriangularLatticeAdjacent x y) : + let u := BandVectors.1 (q ((i + 1).succ)) (q i.succ) + let v := (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (q i.succ) (q ((i + 2).succ)) + ∃ σ : (Int × Int) ≃+ (Int × Int), + (∀ x y, TriangularLatticeAdjacent (σ x) (σ y) ↔ + TriangularLatticeAdjacent x y) ∧ + (∀ x y z, TriangularSignedHeight (σ x) (σ y) (σ z) = + TriangularSignedHeight x y z) ∧ + ∃ a b c d : Int, + ((σ.symm (a, b)).1 : GaussianInt) * e + + ((σ.symm (a, b)).2 : GaussianInt) * f = u ∧ + ((σ.symm (c, d)).1 : GaussianInt) * e + + ((σ.symm (c, d)).2 : GaussianInt) * f = v ∧ + 0 ≤ b ∧ b ≤ a ∧ 0 ≤ d ∧ d ≤ c ∧ + a * d - b * c = -1 := by +-- BODY + classical + let u := BandVectors.1 (q ((i + 1).succ)) (q i.succ) + let v := (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (q i.succ) (q ((i + 2).succ)) + have hu_mem : u ∈ TilingLattice C := + (ParentVectorsInTilingLattice q hq i C hC).1 + have hv_mem : v ∈ TilingLattice C := by + have hit : BandTangency (q i.succ) (q ((i + 2).succ)) := by + refine ⟨q, hq.1, i.succ, (i + 2).succ, ?_, rfl, rfl⟩ + fin_cases i <;> decide + have hrev := (ParentVectorsInTilingLattice q hq i C hC).2 + rcases BandVectorOrientationDichotomy _ _ hit with ⟨h, _⟩ | ⟨h, _⟩ + · change (⟨0, 1⟩ : GaussianInt) * _ ∈ _ + rw [h] + exact hrev + · change (⟨0, 1⟩ : GaussianInt) * _ ∈ _ + rw [h] + exact (TilingLattice C).neg_mem hrev + obtain ⟨p, hp, _⟩ := hcoord ⟨u, hu_mem⟩ + obtain ⟨r, hr, _⟩ := hcoord ⟨v, hv_mem⟩ + have positive : 0 < (q i.succ).1 := by rw [hC]; exact C.2 + have physical_det : u.re * v.im - u.im * v.re = -C.1.1.1 := by + let s : Fin 4 → CircleCoordinates := + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + have hs : SemiProperQuadruple s := by + fin_cases i + · have eta : (![q 0, q 1, q 2, q 3] : Fin 4 → CircleCoordinates) = q := by + funext j + fin_cases j <;> rfl + simpa [s, eta] using hq.1 + · simpa [s] using SemiProperQuadruple.rotate hq.1 + · simpa [s] using SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1) + have hspos : 0 < (s 1).1 := by simpa [s] using positive + have signed := congrArg (fun z : GaussianInt => z.re) + (VectorDeterminant s hs hspos).1 + rw [← hC] + simp [s, u, v] at signed ⊢ + ring_nf at signed ⊢ + omega + have coordinate_det : p.1 * r.2 - p.2 * r.1 = -1 := by + have covolume := P4994T6ChartCovolume C e f hdet he hf hcoord + have hpre := congrArg (fun z : GaussianInt => z.re) hp + have hpim := congrArg (fun z : GaussianInt => z.im) hp + have hrre := congrArg (fun z : GaussianInt => z.re) hr + have hrim := congrArg (fun z : GaussianInt => z.im) hr + simp? at hpre hpim hrre hrim + have factor : u.re * v.im - u.im * v.re = + (e.re * f.im - e.im * f.re) * (p.1 * r.2 - p.2 * r.1) := by + rw [← hpre, ← hpim, ← hrre, ← hrim] + ring + rw [physical_det, covolume] at factor + have positive_curvature := C.2 + nlinarith + have common_chamber : ∃ n, P4994T6Chamber n p ∧ P4994T6Chamber n r := by + by_cases hunit : C.1.1.1 = 1 + · have unit_occurrence : (q i.succ).1 = 1 := by rw [hC]; exact hunit + obtain ⟨n, _, hpn, hrn⟩ := P4994T6UnitOccurrenceChamber q hq i + unit_occurrence orientation (horientation unit_occurrence) + have realPoint_injective : Function.Injective GaussianRealPoint := by + intro x y hxy + apply Zsqrtd.ext + · have h := congrArg Prod.fst hxy + dsimp [GaussianRealPoint] at h + exact_mod_cast h + · have h := congrArg Prod.snd hxy + dsimp [GaussianRealPoint] at h + exact_mod_cast h + have centroid_difference (x y : GaussianInt) : + TileCentroid (TileTranslation base y) - + TileCentroid (TileTranslation base x) = GaussianRealPoint (y - x) := by + rw [(TileTranslationFormulas base y).2.2.2.2.1, + (TileTranslationFormulas base x).2.2.2.2.1] + ext <;> simp [GaussianRealPoint] + have step_of_adj (s : Int × Int) (hs : TriangularLatticeAdjacent 0 s) : + UnitTriangularStep orientation + ((s.1 : GaussianInt) * e + (s.2 : GaussianInt) * f) := by + have h := (hadj 0 s).2 hs + simp only [hunit, ↓reduceIte] at h + obtain ⟨t, ht, hcent⟩ := h + rw [centroid_difference] at hcent + simp only [Prod.fst_zero, Prod.snd_zero, Int.cast_zero, zero_mul, + zero_add, sub_zero] at hcent + rw [realPoint_injective hcent] + exact ht + have e_step : UnitTriangularStep orientation e := by + simpa using step_of_adj (1, 0) (by simp [TriangularLatticeAdjacent]) + have f_step : UnitTriangularStep orientation f := by + simpa using step_of_adj (0, 1) (by simp [TriangularLatticeAdjacent]) + have sum_step : UnitTriangularStep orientation (e + f) := by + simpa using step_of_adj (1, 1) (by simp [TriangularLatticeAdjacent]) + obtain ⟨m, _, alignment⟩ := P4994T6UnitChartRotation orientation e f + hdet e_step f_step sum_step + refine ⟨m + n, ?_, ?_⟩ + · unfold P4994T6Chamber at hpn ⊢ + rw [P4994T6RotationLaws.2.2.2 m n p, ← alignment p, hp] + exact hpn + · unfold P4994T6Chamber at hrn ⊢ + rw [P4994T6RotationLaws.2.2.2 m n r, ← alignment r, hr] + exact hrn + · have touching_chart : ∀ x y : Int × Int, + TileTouching + (TileTranslation base ((x.1 : GaussianInt) * e + (x.2 : GaussianInt) * f)) + (TileTranslation base ((y.1 : GaussianInt) * e + (y.2 : GaussianInt) * f)) ↔ + TriangularLatticeAdjacent x y := by + intro x y + simpa only [hunit, ↓reduceIte] using hadj x y + obtain ⟨n, _, hpn, hrn⟩ := P4994T6NonunitChamber q hq C i hC hunit + base hbase e f hdet he hf hcoord touching_chart p r hp hr + exact ⟨n, hpn, hrn⟩ + obtain ⟨n, hpn, hrn⟩ := common_chamber + let σ := P4994T6Rotation n + refine ⟨σ, P4994T6RotationLaws.1 n, P4994T6RotationLaws.2.1 n, + (σ p).1, (σ p).2, (σ r).1, (σ r).2, ?_, ?_, + hpn.1, hpn.2, hrn.1, hrn.2, ?_⟩ + · simpa only [Prod.eta, AddEquiv.symm_apply_apply] using hp + · simpa only [Prod.eta, AddEquiv.symm_apply_apply] using hr + · have invariant := P4994T6RotationLaws.2.1 n 0 p r + have det_invariant : (σ p).1 * (σ r).2 - (σ p).2 * (σ r).1 = + p.1 * r.2 - p.2 * r.1 := by + simpa only [map_zero, TriangularSignedHeight, Prod.fst_zero, + Prod.snd_zero, sub_zero] using invariant + exact det_invariant.trans coordinate_det + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryString.lean b/LeanPool/ApollonianSuperharmonic/BoundaryString.lean new file mode 100644 index 0000000000..b8cbb48a03 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BoundaryString.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileString +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation + +-- [TABLET NODE: BoundaryString] + +/-! +# BoundaryString + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $(C_0,C_1,C_2,C_3)$ be proper, let $c_i>0$, and let $T_0$ be a +band prototile for $C_0$. Choose a unit orientation $\epsilon$. A +$C_i$ boundary string for $T_0$ is the $\epsilon$-oriented +`TileString` in a translate of the $C_i$ regular tiling whose +end tiles $R_i^-,R_i^+$ satisfy +$$ + \operatorname{cent}(R_i^\pm)-\operatorname{cent}(T_0) + =\tfrac12(v_{i0}\pm v_{0i}). +$$ +If $c_i=1$, this orientation is bound to the selected occurrence +$(C_0,C_1,C_2,C_3;i)$ by +`UnitOccurrenceOrientation`. Thus the orientation is transported +from the selected unit parent's genealogical role in one of the two first +proper successor families; it is not inferred from $C_i$ alone. In +particular, the whole endpoint-to-midpoint displacements $v_{ji}$ and +$i v_{ik}$ are not required to be unit steps. They record the lengths and +directions of the two full substrings and may have squared norm greater than +$2$. No ancestor-odometer condition is part of this definition. +The positive-curvature type of $C_i$ makes the string's tiling lattice and +adjacency meaningful; a curvature-zero parent has no boundary string. +-/ +def BoundaryString (C₀ Cᵢ : BandCircle) (i : Fin 3) (orientation : Bool) + (T₀ base Rminus Rplus : ProtoTile) (tiles : List ProtoTile) : Prop := +-- BODY + ∃ q : Fin 4 → CircleCoordinates, + ProperBandQuadruple q ∧ q 0 = C₀.1.1 ∧ q i.succ = Cᵢ.1.1 ∧ + BandPrototile C₀.1.1 T₀ ∧ + (Cᵢ.1.1.1 = 1 → + UnitOccurrenceOrientation q i orientation) ∧ + TileString Cᵢ orientation base Rminus Rplus tiles ∧ + TileCentroid Rminus - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (q i.succ) (q 0) - BandVectors.1 (q 0) (q i.succ)) ∧ + TileCentroid Rplus - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean b/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean new file mode 100644 index 0000000000..14efdd17a7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean @@ -0,0 +1,1000 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AffineTriangularStrip +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BoundaryString +public import LeanPool.ApollonianSuperharmonic.BoundaryJoinChamberCertificate +public import LeanPool.ApollonianSuperharmonic.OrientedUnimodularStripConcatenation +public import LeanPool.ApollonianSuperharmonic.TileString +public import LeanPool.ApollonianSuperharmonic.TileStringCoordinateTransport +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TriangularBoundaryStrip +public import LeanPool.ApollonianSuperharmonic.TriangularMaxIncrement +public import LeanPool.ApollonianSuperharmonic.TriangularStripSegment +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: BoundaryStringConcatenation] + +/-! +# BoundaryStringConcatenation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace BoundaryConcatenationGeometry + +private theorem hleft' : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (Cᵢ : BandCircle), ∀ (i : + Fin 3), (q i.succ = Cᵢ.1.1) → (∀ (orientation : Bool), ∀ (leftOrientation : Bool), + ((q i.succ).1 = (1 : ℤ) → UnitOccurrenceOrientation q i orientation) → (((q i.succ).1 + = (1 : ℤ) → UnitOccurrenceOrientation q i leftOrientation) → (∀ (base : ProtoTile), ∀ + (Tminus : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (left : List ProtoTile), (TileString + Cᵢ leftOrientation base Rminus Tminus left) → (TileString Cᵢ orientation base Rminus + Tminus left))))) ) := by + classical + intro q hq Cᵢ i hCᵢ orientation leftOrientation horientation hleftOrientation base Tminus + Rminus left hleft + by_cases hc : Cᵢ.1.1.1 = 1 + · have hqunit : (q i.succ).1 = 1 := by simpa [hCᵢ] using hc + have horientEq : leftOrientation = orientation := by + exact (UnitOccurrenceOrientationUnique.1 q hq i hqunit).unique + (hleftOrientation hqunit) (horientation hqunit) + simpa [horientEq] using hleft + · simpa [TileString, hc] using hleft + +private theorem hright' : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (Cᵢ : BandCircle), ∀ (i : + Fin 3), (q i.succ = Cᵢ.1.1) → (∀ (orientation : Bool), ∀ (rightOrientation : Bool), + ((q i.succ).1 = (1 : ℤ) → UnitOccurrenceOrientation q i orientation) → (((q i.succ).1 + = (1 : ℤ) → UnitOccurrenceOrientation q i rightOrientation) → (∀ (base : ProtoTile), + ∀ (Tminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (right : List ProtoTile), + (TileString Cᵢ rightOrientation base Tminus Rplus right) → (TileString Cᵢ orientation + base Tminus Rplus right))))) ) := by + classical + intro q hq Cᵢ i hCᵢ orientation rightOrientation horientation hrightOrientation base Tminus + Rplus right hright + by_cases hc : Cᵢ.1.1.1 = 1 + · have hqunit : (q i.succ).1 = 1 := by simpa [hCᵢ] using hc + have horientEq : rightOrientation = orientation := by + exact (UnitOccurrenceOrientationUnique.1 q hq i hqunit).unique + (hrightOrientation hqunit) (horientation hqunit) + simpa [horientEq] using hright + · simpa [TileString, hc] using hright + +private theorem hcyc : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (Cᵢ : BandCircle), ∀ (i : + Fin 3), (q i.succ = Cᵢ.1.1) → (∀ (orientation : Bool), ∀ (leftOrientation : Bool), ∀ + (rightOrientation : Bool), ((q i.succ).1 = (1 : ℤ) → UnitOccurrenceOrientation q i + orientation) → (((q i.succ).1 = (1 : ℤ) → UnitOccurrenceOrientation q i + leftOrientation) → (((q i.succ).1 = (1 : ℤ) → UnitOccurrenceOrientation q i + rightOrientation) → (∀ (T₀ : ProtoTile), ∀ (Tminus : ProtoTile), ∀ (Rminus : + ProtoTile), ∀ (Rplus : ProtoTile), (BandPrototile (q i.succ) Tminus) → ((TileCentroid + Tminus - TileCentroid T₀ = (-1 : ℝ) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((TileCentroid Rminus - + TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))) - BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((TileCentroid + Rplus - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q i.succ) + (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + BandVectors.1 (q ((i + + 1).succ)) (q i.succ) + BandVectors.1 (q i.succ) (q ((i + 2).succ)) = 0))))))))) ) := by + classical + intro q hq Cᵢ i hCᵢ orientation leftOrientation rightOrientation horientation hleftOrientation + hrightOrientation T₀ Tminus Rminus Rplus hTminus hminus hRminus hRplus + fin_cases i + all_goals + convert (VectorRecursionLaws q hq.1).1 using 1; + simp [Fin.add_def]; abel + +private theorem hin : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (Cᵢ : BandCircle), ∀ (i : + Fin 3), (q i.succ = Cᵢ.1.1) → (∀ (orientation : Bool), ∀ (leftOrientation : Bool), ∀ + (rightOrientation : Bool), ((q i.succ).1 = (1 : ℤ) → UnitOccurrenceOrientation q i + orientation) → (((q i.succ).1 = (1 : ℤ) → UnitOccurrenceOrientation q i + leftOrientation) → (((q i.succ).1 = (1 : ℤ) → UnitOccurrenceOrientation q i + rightOrientation) → (∀ (T₀ : ProtoTile), ∀ (Tminus : ProtoTile), ∀ (Rminus : + ProtoTile), ∀ (Rplus : ProtoTile), (BandPrototile (q i.succ) Tminus) → ((TileCentroid + Tminus - TileCentroid T₀ = (-1 : ℝ) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((TileCentroid Rminus - + TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))) - BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((TileCentroid + Rplus - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q i.succ) + (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → + ((BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + BandVectors.1 (q ((i + + 1).succ)) (q i.succ) + BandVectors.1 (q i.succ) (q ((i + 2).succ)) = 0) → + (BandVectors.1 (q i.succ) (q 0) = BandVectors.1 (q i.succ) (q ((i + 2).succ)) - (⟨0, + 1⟩ : GaussianInt) * BandVectors.1 (q ((i + 1).succ)) (q i.succ))))))))))) ) := by + classical + intro q hq Cᵢ i hCᵢ orientation leftOrientation rightOrientation horientation hleftOrientation + hrightOrientation T₀ Tminus Rminus Rplus hTminus hminus hRminus hRplus hcyc + fin_cases i + · exact (VectorRecursionLaws q hq.1).2.2.1 + · have h := (VectorRecursionLaws (![q 0, q 2, q 3, q 1]) + (SemiProperQuadruple.rotate hq.1)).2.2.1 + simpa using h + · have h := (VectorRecursionLaws (![q 0, q 3, q 1, q 2]) + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1))).2.2.1 + simpa using h + +private theorem hrot : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + ∀ (z : GaussianInt), (-(GaussianRealPoint z).2, (GaussianRealPoint z).1) = + GaussianRealPoint (I * z) ) := by + classical + intro I z + ext <;> simp [GaussianRealPoint, I, Zsqrtd.re_mul, Zsqrtd.im_mul] + +private theorem hminus' : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T₀ : ProtoTile), ∀ (Tminus : + ProtoTile), (TileCentroid Tminus - TileCentroid T₀ = (-1 : ℝ) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + (∀ (z : GaussianInt), (-(GaussianRealPoint z).2, (GaussianRealPoint z).1) = + GaussianRealPoint (I * z)) → (TileCentroid Tminus - TileCentroid T₀ = (-1 : ℝ) • ((1 + / 2 : ℝ) • (GaussianRealPoint w - GaussianRealPoint (I * w))))) ) := by + classical + intro q i T₀ Tminus hminus I w hrot + simpa only [hrot] using hminus + +private theorem hW : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), (BandVectors.1 (q ((i + 2).succ)) (q + ((i + 1).succ)) + BandVectors.1 (q ((i + 1).succ)) (q i.succ) + BandVectors.1 (q + i.succ) (q ((i + 2).succ)) = 0) → ( + let w := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let x := BandVectors.1 (q i.succ) (q ((i + 2).succ)) + let y := BandVectors.1 (q ((i + 1).succ)) (q i.succ) + w = -x - y) ) := by + classical + intro q i hcyc w x y + dsimp [w, x, y] + linear_combination hcyc + +private theorem hGplus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let x := BandVectors.1 (q i.succ) (q ((i + 2).succ)) + let y := BandVectors.1 (q ((i + 1).succ)) (q i.succ) + (BandVectors.1 (q i.succ) (q 0) = x - I * y) → ((BandVectors.1 (q 0) (q i.succ) = I * + BandVectors.1 (q i.succ) (q 0)) → ((I ^ 2 = -1) → ((w = -x - y) → (BandVectors.1 (q + i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ) + w - I * w = 2 * (I * x))))) ) := by + classical + intro q i I w x y hA hB hI2 hW + rw [hA, hB, hA, hW] + simp only [mul_sub] + ring_nf + rw [hI2] + ring + +private theorem hGminus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let x := BandVectors.1 (q i.succ) (q ((i + 2).succ)) + let y := BandVectors.1 (q ((i + 1).succ)) (q i.succ) + (BandVectors.1 (q i.succ) (q 0) = x - I * y) → ((BandVectors.1 (q 0) (q i.succ) = I * + BandVectors.1 (q i.succ) (q 0)) → ((I ^ 2 = -1) → ((w = -x - y) → (-w + I * w - + BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ) = 2 * y)))) ) := by + classical + intro q i I w x y hA hB hI2 hW + rw [hA, hB, hA, hW] + simp only [mul_sub] + ring_nf + rw [hI2] + ring + +private theorem hplus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T₀ : ProtoTile), ∀ (Tminus : + ProtoTile), ∀ (Rplus : ProtoTile), (TileCentroid Rplus - TileCentroid T₀ = (1 / 2 : + ℝ) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let x := BandVectors.1 (q i.succ) (q ((i + 2).succ)) + (TileCentroid Tminus - TileCentroid T₀ = (-1 : ℝ) • ((1 / 2 : ℝ) • (GaussianRealPoint w - + GaussianRealPoint (I * w)))) → ((((GaussianInt.toComplex : GaussianInt → ℂ) + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))).re + ((GaussianInt.toComplex : + GaussianInt → ℂ) (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) w).re + ((GaussianInt.toComplex : + GaussianInt → ℂ) w).im = -((2 : ℝ) * ((GaussianInt.toComplex : GaussianInt → ℂ) + x).im)) → ((((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.1 (q i.succ) (q + (0 : Fin (4 : ℕ))))).im + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.1 + (q (0 : Fin (4 : ℕ))) (q i.succ))).im + ((GaussianInt.toComplex : GaussianInt → ℂ) + w).im - ((GaussianInt.toComplex : GaussianInt → ℂ) w).re = (2 : ℝ) * + ((GaussianInt.toComplex : GaussianInt → ℂ) x).re) → (TileCentroid Rplus - + TileCentroid Tminus = GaussianRealPoint (I * x))))) ) := by + classical + intro q i T₀ Tminus Rplus hRplus I w x hminus' hGplusRe hGplusIm + calc + _ = (TileCentroid Rplus - TileCentroid T₀) - + (TileCentroid Tminus - TileCentroid T₀) := by + ext <;> simp + _ = _ := by + rw [hRplus, hminus'] + ext <;> simp [GaussianRealPoint, Prod.smul_def, + Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_mul, Zsqrtd.im_mul, I] <;> + nlinarith [hGplusRe, hGplusIm] + +private theorem hminusInc : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T₀ : ProtoTile), ∀ (Tminus : + ProtoTile), ∀ (Rminus : ProtoTile), (TileCentroid Rminus - TileCentroid T₀ = (1 / 2 : + ℝ) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) - + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let y := BandVectors.1 (q ((i + 1).succ)) (q i.succ) + (TileCentroid Tminus - TileCentroid T₀ = (-1 : ℝ) • ((1 / 2 : ℝ) • (GaussianRealPoint w - + GaussianRealPoint (I * w)))) → ((-((GaussianInt.toComplex : GaussianInt → ℂ) w).re + + -((GaussianInt.toComplex : GaussianInt → ℂ) w).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + i.succ))).re = (2 : ℝ) * ((GaussianInt.toComplex : GaussianInt → ℂ) y).re) → + ((-((GaussianInt.toComplex : GaussianInt → ℂ) w).im + ((GaussianInt.toComplex : + GaussianInt → ℂ) w).re - ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))))).im + ((GaussianInt.toComplex : GaussianInt → ℂ) + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))).im = (2 : ℝ) * + ((GaussianInt.toComplex : GaussianInt → ℂ) y).im) → (TileCentroid Tminus - + TileCentroid Rminus = GaussianRealPoint y)))) ) := by + classical + intro q i T₀ Tminus Rminus hRminus I w y hminus' hGminusRe hGminusIm + calc + _ = (TileCentroid Tminus - TileCentroid T₀) - + (TileCentroid Rminus - TileCentroid T₀) := by + ext <;> simp + _ = _ := by + rw [hminus', hRminus] + ext <;> simp [GaussianRealPoint, Prod.smul_def, + Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_mul, Zsqrtd.im_mul, I] <;> + nlinarith [hGminusRe, hGminusIm] + +private theorem translationDiff : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), TileCentroid + (TileTranslation base u) - TileCentroid (TileTranslation base v) = GaussianRealPoint + (u - v) ) := by + classical + intro base u v + rw [(TileTranslationFormulas base u).2.2.2.2.1, + (TileTranslationFormulas base v).2.2.2.2.1] + ext <;> simp [GaussianRealPoint, Zsqrtd.re_sub, Zsqrtd.im_sub]; + + +private theorem hGRinj : + (by + classical + exact + Function.Injective GaussianRealPoint ) := by + classical + intro u v huv + ext + · have h := congrArg Prod.fst huv + dsimp [GaussianRealPoint] at h + exact_mod_cast h + · have h := congrArg Prod.snd huv + dsimp [GaussianRealPoint] at h + exact_mod_cast h + +private theorem hphysMinus : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (Tminus : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (e : + GaussianInt), ∀ (f : GaussianInt), ∀ (r : ℤ × ℤ), (Rminus = TileTranslation base + ((↑r.1 : GaussianInt) * e + (↑r.2 : GaussianInt) * f)) → (∀ (m : ℤ × ℤ), (Tminus = + TileTranslation base ((↑m.1 : GaussianInt) * e + (↑m.2 : GaussianInt) * f)) → ( + let coord := fun z : Int × Int => + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f + (∀ (u : GaussianInt), ∀ (v : GaussianInt), TileCentroid (TileTranslation base u) - + TileCentroid (TileTranslation base v) = GaussianRealPoint (u - v)) → (TileCentroid + Tminus - TileCentroid Rminus = GaussianRealPoint (coord m - coord r)))) ) := by + classical + intro base Tminus Rminus e f r hr m hm coord translationDiff + rw [hm, hr] + exact translationDiff _ _ + +private theorem hphysPlus : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (Tminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (e : GaussianInt), + ∀ (f : GaussianInt), ∀ (m : ℤ × ℤ), (Tminus = TileTranslation base ((↑m.1 : + GaussianInt) * e + (↑m.2 : GaussianInt) * f)) → (∀ (s : ℤ × ℤ), (Rplus = + TileTranslation base ((↑s.1 : GaussianInt) * e + (↑s.2 : GaussianInt) * f)) → ( + let coord := fun z : Int × Int => + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f + (∀ (u : GaussianInt), ∀ (v : GaussianInt), TileCentroid (TileTranslation base u) - + TileCentroid (TileTranslation base v) = GaussianRealPoint (u - v)) → (TileCentroid + Rplus - TileCentroid Tminus = GaussianRealPoint (coord s - coord m)))) ) := by + classical + intro base Tminus Rplus e f m hm s hs coord translationDiff + rw [hs, hm] + exact translationDiff _ _ + +private theorem hdispMinus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (Tminus : ProtoTile), ∀ (Rminus : + ProtoTile), ∀ (e : GaussianInt), ∀ (f : GaussianInt), ∀ (r : ℤ × ℤ), ∀ (m : ℤ × ℤ), + let y := BandVectors.1 (q ((i + 1).succ)) (q i.succ) + (TileCentroid Tminus - TileCentroid Rminus = GaussianRealPoint y) → ( + let coord := fun z : Int × Int => + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f + (Function.Injective GaussianRealPoint) → ((TileCentroid Tminus - TileCentroid Rminus = + GaussianRealPoint (coord m - coord r)) → (coord m - coord r = y))) ) := by + classical + intro q i Tminus Rminus e f r m y hminusInc coord hGRinj hphysMinus + apply hGRinj + exact hphysMinus.symm.trans hminusInc + +private theorem hdispPlus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (Tminus : ProtoTile), ∀ (Rplus : + ProtoTile), ∀ (e : GaussianInt), ∀ (f : GaussianInt), ∀ (m : ℤ × ℤ), ∀ (s : ℤ × ℤ), + let I : GaussianInt := ⟨0, 1⟩ + let x := BandVectors.1 (q i.succ) (q ((i + 2).succ)) + (TileCentroid Rplus - TileCentroid Tminus = GaussianRealPoint (I * x)) → ( + let coord := fun z : Int × Int => + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f + (Function.Injective GaussianRealPoint) → ((TileCentroid Rplus - TileCentroid Tminus = + GaussianRealPoint (coord s - coord m)) → (coord s - coord m = I * x))) ) := by + classical + intro q i Tminus Rplus e f m s I x hplus coord hGRinj hphysPlus + apply hGRinj + exact hphysPlus.symm.trans hplus + +private theorem hcoordMinus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : GaussianInt), ∀ (f : + GaussianInt), ∀ (r : ℤ × ℤ), ∀ (m : ℤ × ℤ), + let y := BandVectors.1 (q ((i + 1).succ)) (q i.succ) + let coord := fun z : Int × Int => + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f + (coord m - coord r = y) → (coord (m - r) = y) ) := by + classical + intro q i e f r m y coord hdispMinus + calc + coord (m - r) = coord m - coord r := by + dsimp [coord] + ext <;> simp [Int.cast_sub, sub_mul] <;> ring + _ = y := hdispMinus + +private theorem hcoordPlus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : GaussianInt), ∀ (f : + GaussianInt), ∀ (m : ℤ × ℤ), ∀ (s : ℤ × ℤ), + let I : GaussianInt := ⟨0, 1⟩ + let x := BandVectors.1 (q i.succ) (q ((i + 2).succ)) + let coord := fun z : Int × Int => + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f + (coord s - coord m = I * x) → (coord (s - m) = I * x) ) := by + classical + intro q i e f m s I x coord hdispPlus + calc + coord (s - m) = coord s - coord m := by + dsimp [coord] + ext <;> simp [Int.cast_sub, sub_mul] <;> ring + _ = I * x := hdispPlus + +private theorem coord_mem : + (by + classical + exact + ∀ (Cᵢ : BandCircle), ∀ (e : GaussianInt), ∀ (f : GaussianInt), (e ∈ TilingLattice Cᵢ) → + ((f ∈ TilingLattice Cᵢ) → ( + let coord := fun z : Int × Int => + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f + ∀ (z : Int × Int), coord z ∈ TilingLattice Cᵢ)) ) := by + classical + intro Cᵢ e f he hf coord z + dsimp [coord] + apply AddSubgroup.add_mem + · simpa using AddSubgroup.zsmul_mem (TilingLattice Cᵢ) he z.1 + · simpa using AddSubgroup.zsmul_mem (TilingLattice Cᵢ) hf z.2 + +private theorem coord_inj : + (by + classical + exact + ∀ (Cᵢ : BandCircle), ∀ (e : GaussianInt), ∀ (f : GaussianInt), (∀ (w : ↥(TilingLattice + Cᵢ)), ∃! z : ℤ × ℤ, (↑z.1 : GaussianInt) * e + (↑z.2 : GaussianInt) * f = (↑w : + GaussianInt)) → ( + let coord := fun z : Int × Int => + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f + (∀ (z : Int × Int), coord z ∈ TilingLattice Cᵢ) → (Function.Injective coord)) ) := by + classical + intro Cᵢ e f hcoord coord coord_mem z z' hzz + let w : TilingLattice Cᵢ := ⟨coord z, coord_mem z⟩ + obtain ⟨u, hu, huuniq⟩ := hcoord w + have hz : coord z = (w : GaussianInt) := rfl + have hz' : coord z' = (w : GaussianInt) := hzz.symm.trans hz + exact (huuniq z hz).trans (huuniq z' hz').symm + +private theorem hmr : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : GaussianInt), ∀ (f : + GaussianInt), ∀ (r : ℤ × ℤ), ∀ (m : ℤ × ℤ), + let y := BandVectors.1 (q ((i + 1).succ)) (q i.succ) + let coord := fun z : Int × Int => + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f + (coord (m - r) = y) → ((Function.Injective coord) → (∀ (σ : ℤ × ℤ ≃+ ℤ × ℤ), ∀ (a : ℤ), ∀ + (b : ℤ), (coord (σ.symm (a, b)) = y) → (m - r = σ.symm (a, b)))) ) := by + classical + intro q i e f r m y coord hcoordMinus coord_inj σ a b hσminus' + apply coord_inj + exact hcoordMinus.trans hσminus'.symm + +private theorem hsm : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : GaussianInt), ∀ (f : + GaussianInt), ∀ (m : ℤ × ℤ), ∀ (s : ℤ × ℤ), + let I : GaussianInt := ⟨0, 1⟩ + let x := BandVectors.1 (q i.succ) (q ((i + 2).succ)) + let coord := fun z : Int × Int => + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f + (coord (s - m) = I * x) → ((Function.Injective coord) → (∀ (σ : ℤ × ℤ ≃+ ℤ × ℤ), ∀ (c : + ℤ), ∀ (d : ℤ), (coord (σ.symm (c, d)) = I * x) → (s - m = σ.symm (c, d)))) ) := by + classical + intro q i e f m s I x coord hcoordPlus coord_inj σ c d hσplus' + apply coord_inj + exact hcoordPlus.trans hσplus'.symm + +private theorem hσm : + (by + classical + exact + ∀ (r : ℤ × ℤ), ∀ (m : ℤ × ℤ), ∀ (σ : ℤ × ℤ ≃+ ℤ × ℤ), ∀ (a : ℤ), ∀ (b : ℤ), (σ (m - r) = + (a, b)) → (σ m = σ r + (a, b)) ) := by + classical + intro r m σ a b hσmr + have h := hσmr + rw [map_sub] at h + calc + σ m = (σ m - σ r) + σ r := by abel + _ = (a, b) + σ r := by rw [h] + _ = σ r + (a, b) := by abel + +private theorem hσs : + (by + classical + exact + ∀ (m : ℤ × ℤ), ∀ (s : ℤ × ℤ), ∀ (σ : ℤ × ℤ ≃+ ℤ × ℤ), ∀ (c : ℤ), ∀ (d : ℤ), (σ (s - m) = + (c, d)) → (σ s = σ m + (c, d)) ) := by + classical + intro m s σ c d hσsm + have h := hσsm + rw [map_sub] at h + calc + σ s = (σ s - σ m) + σ m := by abel + _ = (c, d) + σ m := by rw [h] + _ = σ m + (c, d) := by abel + +private theorem hDimage : + (by + classical + exact + ∀ (σ : ℤ × ℤ ≃+ ℤ × ℤ), (∀ (x : ℤ × ℤ), ∀ (y : ℤ × ℤ), TriangularLatticeAdjacent ((σ : ℤ + × ℤ → ℤ × ℤ) x) ((σ : ℤ × ℤ → ℤ × ℤ) y) ↔ TriangularLatticeAdjacent x y) → ( + let D : Finset (Int × Int) := + {(1, 0), (0, 1), (-1, -1), (-1, 0), (0, -1), (1, 1)} + (∀ (z : Int × Int), z ∈ D ↔ TriangularLatticeAdjacent 0 z) → ((σ (0 : Int × Int) = 0) → + (D.image σ = D))) ) := by + classical + intro σ hσadj D hD hσ0 + ext z + simp only [Finset.mem_image] + constructor + · rintro ⟨u, hu, rfl⟩ + apply (hD (σ u)).mpr + have h := (hσadj 0 u).mpr ((hD u).mp hu) + simpa only [hσ0] using h + · intro hz + have hpre : TriangularLatticeAdjacent 0 (σ.symm z) := by + have hz' : TriangularLatticeAdjacent (σ 0) + (σ (σ.symm z)) := by simpa only [hσ0, σ.apply_symm_apply] using (hD z).mp hz + exact (hσadj 0 (σ.symm z)).mp hz' + exact ⟨σ.symm z, (hD _).mpr hpre, by simp⟩ + +private theorem hmaxRep : + (by + classical + exact + let D : Finset (Int × Int) := + {(1, 0), (0, 1), (-1, -1), (-1, 0), (0, -1), (1, 1)} + ∀ (hDne : D.Nonempty), ∀ (u : Int × Int), ∀ (v : Int × Int), TriangularMaxIncrement u v = + D.sup' hDne (fun z => |TriangularSignedHeight u v (u + z)|) ) := by + classical + intro D hDne u v + simp? [D, TriangularMaxIncrement, TriangularSignedHeight, Prod.add_def, + abs_sub_comm, max_left_comm] + have hcross : u.1 - v.1 - (u.2 - v.2) = + -(v.1 - u.1 - (v.2 - u.2)) := by ring + rw [hcross, abs_neg] + simp + +private theorem hmaxσ : + (by + classical + exact + ∀ (σ : ℤ × ℤ ≃+ ℤ × ℤ), (∀ (x : ℤ × ℤ), ∀ (y : ℤ × ℤ), ∀ (z : ℤ × ℤ), + TriangularSignedHeight ((σ : ℤ × ℤ → ℤ × ℤ) x) ((σ : ℤ × ℤ → ℤ × ℤ) y) ((σ : ℤ × ℤ → + ℤ × ℤ) z) = TriangularSignedHeight x y z) → ( + let D : Finset (Int × Int) := + {(1, 0), (0, 1), (-1, -1), (-1, 0), (0, -1), (1, 1)} + (D.image σ = D) → (∀ (hDne : D.Nonempty), (∀ (u : Int × Int), ∀ (v : Int × Int), + TriangularMaxIncrement u v = D.sup' hDne (fun z => |TriangularSignedHeight u v (u + + z)|)) → (∀ (u : Int × Int), ∀ (v : Int × Int), TriangularMaxIncrement (σ u) (σ v) = + TriangularMaxIncrement u v))) ) := by + classical + intro σ hσheight D hDimage hDne hmaxRep u v + rw [hmaxRep, hmaxRep] + let g : (Int × Int) → Int := fun z => + |TriangularSignedHeight (σ u) (σ v) (σ u + z)| + have himageNe : (D.image σ).Nonempty := Finset.image_nonempty.mpr hDne + calc + D.sup' hDne g = (D.image σ).sup' himageNe g := by + exact (Finset.sup'_congr (s := D) (H := hDne) + (t := D.image σ) (f := g) (g := g) hDimage.symm + (by intro z hz; rfl)) + _ = D.sup' hDne (g ∘ σ) := by + exact Finset.sup'_image (α := Int) (β := Int × Int) + (γ := Int × Int) (f := σ) himageNe g + _ = D.sup' hDne (fun z => |TriangularSignedHeight u v (u + z)|) := by + apply Finset.sup'_congr (s := D) (H := hDne) (t := D) + (f := g ∘ σ) (g := fun z => |TriangularSignedHeight u v (u + z)|) rfl + intro z hz + dsimp [g] + rw [← hσheight u v (u + z)] + rw [← map_add σ u z] + +private theorem mapSegment : + (by + classical + exact + ∀ (ρ : (Int × Int) ≃+ (Int × Int)), (∀ x, ∀ y, TriangularLatticeAdjacent (ρ x) (ρ y) ↔ + TriangularLatticeAdjacent x y) → ((∀ x, ∀ y, ∀ z, TriangularSignedHeight (ρ x) (ρ y) + (ρ z) = + TriangularSignedHeight x y z) → ((∀ x, ∀ y, TriangularMaxIncrement (ρ x) (ρ y) = + TriangularMaxIncrement x y) → (∀ {x : Int × Int}, ∀ {y : Int × Int}, ∀ + {path : List (Int × Int)}, (TriangularStripSegment x y path) → + (TriangularStripSegment (ρ x) (ρ y) (path.map ρ))))) ) := by + classical + intro ρ hadjρ hheightρ hmaxρ x y path hseg + by_cases hxy : x = y + · subst y + simp only [TriangularStripSegment] at hseg + subst path + simp [TriangularStripSegment] + · have hρxy : ρ x ≠ ρ y := by + intro heq + apply hxy + exact ρ.injective heq + simp only [TriangularStripSegment, ite_eq_right hxy] at hseg + simp only [TriangularStripSegment, ite_eq_right hρxy] + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · simp [hseg.1] + · simp [hseg.2.1] + · exact hseg.2.2.1.map ρ.injective + · intro z hz + rcases List.mem_map.mp hz with ⟨p, hp, rfl⟩ + have hstrip := hseg.2.2.2.1 p hp + change 0 ≤ TriangularSignedHeight (ρ x) (ρ y) (ρ p) ∧ + TriangularSignedHeight (ρ x) (ρ y) (ρ p) < + TriangularMaxIncrement (ρ x) (ρ y) + rw [hheightρ x y p, hmaxρ x y] + exact hstrip + · apply (List.isChain_map ρ).mpr + exact hseg.2.2.2.2.imp (fun u v huv => (hadjρ u v).mpr huv) + +private theorem hσrNe : + (by + classical + exact + ∀ (r : ℤ × ℤ), ∀ (m : ℤ × ℤ), ∀ (σ : ℤ × ℤ ≃+ ℤ × ℤ), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (c : ℤ), ∀ + (d : ℤ), (a * d - b * c = (-1 : ℤ)) → ((σ (m - r) = (a, b)) → (σ r ≠ σ m)) ) := by + classical + intro r m σ a b c d hdetσ hσmr heq + have hzero : (a, b) = 0 := by + calc + (a, b) = σ (m - r) := hσmr.symm + _ = σ m - σ r := by rw [map_sub] + _ = 0 := by rw [heq]; simp + have ha : a = 0 := by simpa using congrArg Prod.fst hzero + have hb : b = 0 := by simpa using congrArg Prod.snd hzero + rw [ha, hb] at hdetσ + norm_num at hdetσ + +private theorem hinvAdj : + (by + classical + exact + ∀ (σ : ℤ × ℤ ≃+ ℤ × ℤ), (∀ (x : ℤ × ℤ), ∀ (y : ℤ × ℤ), TriangularLatticeAdjacent ((σ : ℤ + × ℤ → ℤ × ℤ) x) ((σ : ℤ × ℤ → ℤ × ℤ) y) ↔ TriangularLatticeAdjacent x y) → (∀ (u : + Int × Int), ∀ (v : Int × Int), TriangularLatticeAdjacent (σ.symm u) (σ.symm v) ↔ + TriangularLatticeAdjacent u v) ) := by + classical + intro σ hσadj u v + simpa using (hσadj (σ.symm u) (σ.symm v)).symm + +private theorem hinvHeight : + (by + classical + exact + ∀ (σ : ℤ × ℤ ≃+ ℤ × ℤ), (∀ (x : ℤ × ℤ), ∀ (y : ℤ × ℤ), ∀ (z : ℤ × ℤ), + TriangularSignedHeight ((σ : ℤ × ℤ → ℤ × ℤ) x) ((σ : ℤ × ℤ → ℤ × ℤ) y) ((σ : ℤ × ℤ → + ℤ × ℤ) z) = TriangularSignedHeight x y z) → (∀ (u : Int × Int), ∀ (v : Int × Int), ∀ + (z : Int × Int), TriangularSignedHeight (σ.symm u) (σ.symm v) (σ.symm z) = + TriangularSignedHeight u v z) ) := by + classical + intro σ hσheight u v z + simpa using (hσheight (σ.symm u) (σ.symm v) (σ.symm z)).symm + +private theorem hinvMax : + (by + classical + exact + ∀ (σ : ℤ × ℤ ≃+ ℤ × ℤ), (∀ (u : Int × Int), ∀ (v : Int × Int), TriangularMaxIncrement (σ + u) (σ v) = TriangularMaxIncrement u v) → (∀ (u : Int × Int), ∀ (v : Int × Int), + TriangularMaxIncrement (σ.symm u) (σ.symm v) = TriangularMaxIncrement u v) ) := by + classical + intro σ hmaxσ u v + simpa using (hmaxσ (σ.symm u) (σ.symm v)).symm + +private theorem hcoordSegment' : + (by + classical + exact + ∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), ∀ (P : List (ℤ × ℤ)), ∀ (Q : List (ℤ × ℤ)), ∀ (σ : ℤ × ℤ ≃+ + ℤ × ℤ), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (c : ℤ), ∀ (d : ℤ), (σ s = σ r + (a, b) + (c, d)) → + ((TriangularStripSegment ((σ.symm : ℤ × ℤ → ℤ × ℤ) ((σ : ℤ × ℤ → ℤ × ℤ) r)) ((σ.symm + : ℤ × ℤ → ℤ × ℤ) ((σ : ℤ × ℤ → ℤ × ℤ) r + (a, b) + (c, d))) (List.map (⇑σ.symm : ℤ × + ℤ → ℤ × ℤ) ((List.map (⇑σ : ℤ × ℤ → ℤ × ℤ) P).dropLast ++ List.map (⇑σ : ℤ × ℤ → ℤ × + ℤ) Q))) → (TriangularStripSegment r s (P.dropLast ++ Q))) ) := by + classical + intro r s P Q σ a b c d htotal hcoordSegment + have hfirst : σ.symm (σ r) = r := by simp + have hlast : σ.symm (σ r + (a, b) + (c, d)) = s := by + apply σ.injective + simpa using htotal.symm + simpa [List.map_append, List.map_dropLast, List.map_map, + Function.comp_def, Equiv.symm_apply_apply, hfirst, hlast] using hcoordSegment + +private theorem dropLastForall₂ : + (by + classical + exact + ∀ {α : Type}, ∀ {β : Type}, ∀ {R : α → β → Prop}, ∀ {xs : List α}, ∀ {ys : List β}, + List.Forall₂ R xs ys → List.Forall₂ R xs.dropLast ys.dropLast ) := by + classical + intro α β R xs ys h + induction h with + | nil => simp + | @cons x y xs ys hxy htail ih => + cases htail with + | nil => simp + | cons hnext hrest => + simpa only [List.dropLast_cons_cons] using + (List.Forall₂.cons hxy ih) + +private theorem appendForall₂ : + (by + classical + exact + ∀ {α : Type}, ∀ {β : Type}, ∀ {R : α → β → Prop}, ∀ {xs : List α}, ∀ {ys : List β}, ∀ + {us : List α}, ∀ {vs : List β}, List.Forall₂ R xs ys → List.Forall₂ R us vs → + List.Forall₂ R (xs ++ us) (ys ++ vs) ) := by + classical + intro α β R xs ys us vs h + induction h with + | nil => intro htail; simpa using htail + | cons hxy hrest ih => + intro htail + exact List.Forall₂.cons hxy (ih htail) + +private theorem hcorrespondence : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), ∀ (e : + GaussianInt), ∀ (f : GaussianInt), ∀ (r : ℤ × ℤ), ∀ (m : ℤ × ℤ), ∀ (s : ℤ × ℤ), ∀ (P + : List (ℤ × ℤ)), (List.Forall₂ (fun (T : ProtoTile) (z : ℤ × ℤ) => T = + TileTranslation base ((↑z.1 : GaussianInt) * e + (↑z.2 : GaussianInt) * f)) left P ∧ + TriangularStripSegment r m P) → (∀ (Q : List (ℤ × ℤ)), (List.Forall₂ (fun (T : + ProtoTile) (z : ℤ × ℤ) => T = TileTranslation base ((↑z.1 : GaussianInt) * e + (↑z.2 + : GaussianInt) * f)) right Q ∧ TriangularStripSegment m s Q) → ((∀ {α : Type}, ∀ + {β : Type}, ∀ {R : α → β → Prop}, ∀ {xs : List α}, ∀ {ys : List β}, List.Forall₂ R xs + ys → List.Forall₂ R xs.dropLast ys.dropLast) → ((∀ {α : Type}, ∀ {β : Type}, ∀ + {R : α → β → Prop}, ∀ {xs : List α}, ∀ {ys : List β}, ∀ {us : List α}, ∀ + {vs : List β}, List.Forall₂ R xs ys → List.Forall₂ R us vs → List.Forall₂ R (xs ++ + us) (ys ++ vs)) → (List.Forall₂ (fun T z => T = TileTranslation base ((z.1 : + GaussianInt) * e + (z.2 : GaussianInt) * f)) (left.dropLast ++ right) (P.dropLast ++ + Q))))) ) := by + classical + intro base left right e f r m s P hP Q hQ dropLastForall₂ appendForall₂ + exact appendForall₂ (dropLastForall₂ hP.1) hQ.1 + +private theorem htiles : + (by + classical + exact + ∀ (Cᵢ : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : + ProtoTile), ∀ (Rplus : ProtoTile), ∀ (left : List ProtoTile), ∀ (right : List + ProtoTile), ∀ (e : GaussianInt), ∀ (f : GaussianInt), (∀ (R : ProtoTile), ∀ (S : + ProtoTile), ∀ (tiles : List ProtoTile), ∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), R = + TileTranslation base ((↑r.1 : GaussianInt) * e + (↑r.2 : GaussianInt) * f) → S = + TileTranslation base ((↑s.1 : GaussianInt) * e + (↑s.2 : GaussianInt) * f) → + (TileString Cᵢ orientation base R S tiles ↔ ∃! coordinates : List (ℤ × ℤ), + List.Forall₂ (fun (T : ProtoTile) (z : ℤ × ℤ) => T = TileTranslation base ((↑z.1 : + GaussianInt) * e + (↑z.2 : GaussianInt) * f)) tiles coordinates ∧ + TriangularStripSegment r s coordinates)) → (∀ (r : ℤ × ℤ), (Rminus = TileTranslation + base ((↑r.1 : GaussianInt) * e + (↑r.2 : GaussianInt) * f)) → (∀ (s : ℤ × ℤ), (Rplus + = TileTranslation base ((↑s.1 : GaussianInt) * e + (↑s.2 : GaussianInt) * f)) → (∀ (P + : List (ℤ × ℤ)), ∀ (Q : List (ℤ × ℤ)), (TriangularStripSegment r s (P.dropLast ++ Q)) + → ((List.Forall₂ (fun T z => T = TileTranslation base ((z.1 : GaussianInt) * e + (z.2 + : GaussianInt) * f)) (left.dropLast ++ right) (P.dropLast ++ Q)) → (TileString Cᵢ + orientation base Rminus Rplus (left.dropLast ++ right)))))) ) := by + classical + intro Cᵢ orientation base Rminus Rplus left right e f htransport r hr s hs P Q hcoordSegment' + hcorrespondence + apply (htransport Rminus Rplus (left.dropLast ++ right) r s hr hs).mpr + refine ⟨P.dropLast ++ Q, ⟨hcorrespondence, hcoordSegment'⟩, ?_⟩ + intro other hother + exact (AffineTriangularStrip).1 r s |>.unique hother.2 hcoordSegment' + +private theorem horientation' : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (Cᵢ : BandCircle), ∀ (i : Fin 3), (q i.succ = + Cᵢ.1.1) → (∀ (orientation : Bool), ((q i.succ).1 = (1 : ℤ) → + UnitOccurrenceOrientation q i orientation) → (Cᵢ.1.1.1 = 1 → + UnitOccurrenceOrientation q i orientation)) ) := by + classical + intro q Cᵢ i hCᵢ orientation horientation hc + apply horientation + simpa [hCᵢ] using hc + +end BoundaryConcatenationGeometry + +theorem BoundaryStringConcatenation + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (C₀ Cᵢ : BandCircle) (i : Fin 3) + (hC₀ : q 0 = C₀.1.1) (hCᵢ : q i.succ = Cᵢ.1.1) + (orientation leftOrientation rightOrientation : Bool) + (horientation : (q i.succ).1 = 1 → + UnitOccurrenceOrientation q i orientation) + (hleftOrientation : (q i.succ).1 = 1 → + UnitOccurrenceOrientation q i leftOrientation) + (hrightOrientation : (q i.succ).1 = 1 → + UnitOccurrenceOrientation q i rightOrientation) + (T₀ base Tminus Rminus Rplus : ProtoTile) + (left right : List ProtoTile) + (hT₀ : BandPrototile (q 0) T₀) + (hTminus : BandPrototile (q i.succ) Tminus) + (hminus : TileCentroid Tminus - TileCentroid T₀ = + (-1 : ℝ) • ((1 / 2 : ℝ) • + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1)))) + (hRminus : TileCentroid Rminus - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (q i.succ) (q 0) - BandVectors.1 (q 0) (q i.succ))) + (hRplus : TileCentroid Rplus - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ))) + (hleft : TileString Cᵢ leftOrientation base Rminus Tminus left) + (hright : TileString Cᵢ rightOrientation base Tminus Rplus right) : + TileCentroid Rplus - TileCentroid Tminus = + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (q i.succ) (q ((i + 2).succ))) ∧ + TileCentroid Tminus - TileCentroid Rminus = + GaussianRealPoint + (BandVectors.1 (q ((i + 1).succ)) (q i.succ)) ∧ + BoundaryString C₀ Cᵢ i orientation T₀ base Rminus Rplus + (left.dropLast ++ right) := by +-- BODY + classical + have hbase : BandPrototile Cᵢ.1.1 base := hleft.1 + have hleft' := BoundaryConcatenationGeometry.hleft' q hq Cᵢ i hCᵢ orientation leftOrientation + horientation hleftOrientation base Tminus Rminus left hleft + have hright' := BoundaryConcatenationGeometry.hright' q hq Cᵢ i hCᵢ orientation + rightOrientation horientation hrightOrientation base Tminus Rplus right hright + obtain ⟨e, f, hdet, he, hf, hcoord, horientChart, hchart⟩ := + TileStringCoordinateTransport Cᵢ orientation base hbase + dsimp only at hchart + obtain ⟨hfamily, hadj, hheight, htransport⟩ := hchart + have hRminusMem : Rminus ∈ RegularTileFamily base (TilingLattice Cᵢ) := by + exact hleft'.2.2.2.2.1 Rminus (List.mem_of_mem_head? hleft'.2.1) + have hTminusMem : Tminus ∈ RegularTileFamily base (TilingLattice Cᵢ) := by + exact hleft'.2.2.2.2.1 Tminus (List.mem_of_getLast? hleft'.2.2.1) + have hRplusMem : Rplus ∈ RegularTileFamily base (TilingLattice Cᵢ) := by + exact hright'.2.2.2.2.1 Rplus (List.mem_of_getLast? hright'.2.2.1) + obtain ⟨r, hr, hruniq⟩ := (hfamily Rminus).mp hRminusMem + obtain ⟨m, hm, hmuniq⟩ := (hfamily Tminus).mp hTminusMem + obtain ⟨s, hs, hsuniq⟩ := (hfamily Rplus).mp hRplusMem + obtain ⟨P, hP, hPuniq⟩ := (htransport Rminus Tminus left r m hr hm).mp hleft' + obtain ⟨Q, hQ, hQuniq⟩ := (htransport Tminus Rplus right m s hm hs).mp hright' + have hcyc := BoundaryConcatenationGeometry.hcyc q hq Cᵢ i hCᵢ orientation leftOrientation + rightOrientation horientation hleftOrientation hrightOrientation T₀ Tminus Rminus Rplus + hTminus hminus hRminus hRplus + have hin : BandVectors.1 (q i.succ) (q 0) = + BandVectors.1 (q i.succ) (q ((i + 2).succ)) - + (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (q ((i + 1).succ)) (q i.succ) := BoundaryConcatenationGeometry.hin q hq + Cᵢ i hCᵢ orientation leftOrientation rightOrientation horientation hleftOrientation + hrightOrientation T₀ Tminus Rminus Rplus hTminus hminus hRminus hRplus hcyc + have hflip := (VectorRecursionLaws q hq.1).2.2.2.2 hq i + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let x := BandVectors.1 (q i.succ) (q ((i + 2).succ)) + let y := BandVectors.1 (q ((i + 1).succ)) (q i.succ) + have hminus' := BoundaryConcatenationGeometry.hminus' q i T₀ Tminus hminus + (BoundaryConcatenationGeometry.hrot) + have hA : BandVectors.1 (q i.succ) (q 0) = x - I * y := by + simpa [x, y, I] using hin + have hB : BandVectors.1 (q 0) (q i.succ) = I * + BandVectors.1 (q i.succ) (q 0) := hflip.1 + have hI : I * I = -1 := by + ext <;> norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] + have hI2 : I ^ 2 = -1 := by rw [pow_two, hI] + have hW := BoundaryConcatenationGeometry.hW q i hcyc + have hGplus := BoundaryConcatenationGeometry.hGplus q i hA hB hI2 hW + have hGminus := BoundaryConcatenationGeometry.hGminus q i hA hB hI2 hW + have hGplusRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) hGplus + have hGplusIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) hGplus + have hGminusRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) hGminus + have hGminusIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) hGminus + simp? [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_mul, Zsqrtd.im_mul] at hGplusRe hGplusIm hGminusRe hGminusIm + have hplus := BoundaryConcatenationGeometry.hplus q i T₀ Tminus Rplus hRplus hminus' hGplusRe + hGplusIm + have hminusInc := BoundaryConcatenationGeometry.hminusInc q i T₀ Tminus Rminus hRminus hminus' + hGminusRe hGminusIm + let coord := fun z : Int × Int => + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f + have translationDiff := BoundaryConcatenationGeometry.translationDiff base + have hGRinj := BoundaryConcatenationGeometry.hGRinj + have hcoordMinus := BoundaryConcatenationGeometry.hcoordMinus q i e f r m + (BoundaryConcatenationGeometry.hdispMinus q i Tminus Rminus e f r m hminusInc hGRinj + (BoundaryConcatenationGeometry.hphysMinus base Tminus Rminus e f r hr m hm translationDiff)) + have hcoordPlus := BoundaryConcatenationGeometry.hcoordPlus q i e f m s + (BoundaryConcatenationGeometry.hdispPlus q i Tminus Rplus e f m s hplus hGRinj + (BoundaryConcatenationGeometry.hphysPlus base Tminus Rplus e f m hm s hs translationDiff)) + have coord_inj := BoundaryConcatenationGeometry.coord_inj Cᵢ e f hcoord + (BoundaryConcatenationGeometry.coord_mem Cᵢ e f he hf) + have hch := BoundaryJoinChamberCertificate q hq Cᵢ i hCᵢ orientation + horientation base hbase e f hdet he hf hcoord hadj + dsimp only at hch + obtain ⟨σ, hσadj, hσheight, a, b, c, d, + hσminus, hσplus, hb0, hba, hd0, hdc, hdetσ⟩ := hch + have hab : 0 ≤ b ∧ b ≤ a := ⟨hb0, hba⟩ + have hcd : 0 ≤ d ∧ d ≤ c := ⟨hd0, hdc⟩ + have hσminus' : coord (σ.symm (a, b)) = y := by + simpa [coord] using hσminus + have hσplus' : coord (σ.symm (c, d)) = I * x := by + simpa [coord] using hσplus + have hmr : m - r = σ.symm (a, b) := BoundaryConcatenationGeometry.hmr q i e f r m hcoordMinus + coord_inj σ a b hσminus' + have hsm : s - m = σ.symm (c, d) := BoundaryConcatenationGeometry.hsm q i e f m s hcoordPlus + coord_inj σ c d hσplus' + have hσmr : σ (m - r) = (a, b) := by rw [hmr]; simp + have hσsm : σ (s - m) = (c, d) := by rw [hsm]; simp + have hσm : σ m = σ r + (a, b) := BoundaryConcatenationGeometry.hσm r m σ a b hσmr + have hσs : σ s = σ m + (c, d) := BoundaryConcatenationGeometry.hσs m s σ c d hσsm + let D : Finset (Int × Int) := + {(1, 0), (0, 1), (-1, -1), (-1, 0), (0, -1), (1, 1)} + have hD (z : Int × Int) : z ∈ D ↔ TriangularLatticeAdjacent 0 z := by + simp [D, TriangularLatticeAdjacent] + have hσ0 : σ (0 : Int × Int) = 0 := σ.map_zero + have hDne : D.Nonempty := by simp [D] + have hmaxσ := BoundaryConcatenationGeometry.hmaxσ σ hσheight + (BoundaryConcatenationGeometry.hDimage σ hσadj hD hσ0) hDne + (BoundaryConcatenationGeometry.hmaxRep hDne) + have mapSegment (ρ : (Int × Int) ≃+ (Int × Int)) + (hadjρ : ∀ x y, TriangularLatticeAdjacent (ρ x) (ρ y) ↔ + TriangularLatticeAdjacent x y) + (hheightρ : ∀ x y z, + TriangularSignedHeight (ρ x) (ρ y) (ρ z) = + TriangularSignedHeight x y z) + (hmaxρ : ∀ x y, + TriangularMaxIncrement (ρ x) (ρ y) = TriangularMaxIncrement x y) + {x y : Int × Int} {path : List (Int × Int)} + (hseg : TriangularStripSegment x y path) := BoundaryConcatenationGeometry.mapSegment ρ + hadjρ hheightρ hmaxρ (x := x) (y := y) (path := path) hseg + have hσrNe := BoundaryConcatenationGeometry.hσrNe r m σ a b c d hdetσ hσmr + have hPσ := mapSegment σ hσadj hσheight hmaxσ hP.2 + rw [hσm] at hPσ + have hQσ := mapSegment σ hσadj hσheight hmaxσ hQ.2 + rw [hσs, hσm] at hQσ + have hjoined := OrientedUnimodularStripConcatenation (σ r) a b c d + hab hcd hdetσ (P.map σ) (Q.map σ) hPσ hQσ + have htotal : σ s = σ r + (a, b) + (c, d) := by + rw [hσs, hσm] + have hcoordSegment := mapSegment σ.symm (BoundaryConcatenationGeometry.hinvAdj σ hσadj) + (BoundaryConcatenationGeometry.hinvHeight σ hσheight) + (BoundaryConcatenationGeometry.hinvMax σ hmaxσ) hjoined + have hT₀' : BandPrototile C₀.1.1 T₀ := by simpa [hC₀] using hT₀ + exact ⟨hplus, hminusInc, + ⟨q, hq, hC₀, hCᵢ, hT₀', (BoundaryConcatenationGeometry.horientation' q Cᵢ i hCᵢ orientation + horientation), (BoundaryConcatenationGeometry.htiles Cᵢ orientation base Rminus Rplus + left right e f htransport r hr s hs P Q (BoundaryConcatenationGeometry.hcoordSegment' r s + P Q σ a b c d htotal hcoordSegment) (BoundaryConcatenationGeometry.hcorrespondence base + left right e f r m s P hP Q hQ (BoundaryConcatenationGeometry.dropLastForall₂) + (BoundaryConcatenationGeometry.appendForall₂))), hRminus, hRplus⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean b/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean new file mode 100644 index 0000000000..5c3622bbf1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean @@ -0,0 +1,676 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerTrans +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.BandOrientedBoundaryOccurrenceGenealogy +public import LeanPool.ApollonianSuperharmonic.BandParentBoundaryGenealogy +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique +public import LeanPool.ApollonianSuperharmonic.BoundaryStringConcatenation +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.TileStringExists +public import LeanPool.ApollonianSuperharmonic.TileStringUnique +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P4458T1FirstProperRows +public import LeanPool.ApollonianSuperharmonic.P4458T1LargestParentRows +public import LeanPool.ApollonianSuperharmonic.P4458T1SmallPairRows +public import LeanPool.ApollonianSuperharmonic.P4458T1SecondNewerRows +public import LeanPool.ApollonianSuperharmonic.P4458T1ThirdNewerRows +public import LeanPool.ApollonianSuperharmonic.P4458T1RespectAppend + +-- [TABLET NODE: BoundaryStringOdometerRespect] + +/-! +# BoundaryStringOdometerRespect + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace BoundaryOdometerGeometry + +private theorem dm : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : + Fin (3 : ℕ)), (q (0 : Fin (4 : ℕ)) = C₀.1.1) → ((q i.succ = Cᵢ.1.1) → (∀ (p₀ : ℝ × + ℝ), ∀ (pminus : ℝ × ℝ), (pminus - p₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 + (q i.succ) (q (0 : Fin (4 : ℕ))) - BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i.succ))) → + (∀ (qb : Fin (4 : ℕ) → CircleCoordinates), (qb (0 : Fin (4 : ℕ)) = C₀.1.1) → ((qb + i.succ = Cᵢ.1.1) → (pminus - p₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (qb + i.succ) (qb 0) - BandVectors.2 (qb 0) (qb i.succ))))))) ) := by + classical + intro q C₀ Cᵢ i hC₀ hCᵢ p₀ pminus hdminus qb hb₀ hbᵢ + simpa only [hb₀, hbᵢ, hC₀, hCᵢ] using hdminus + +private theorem dp : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : + Fin (3 : ℕ)), (q (0 : Fin (4 : ℕ)) = C₀.1.1) → ((q i.succ = Cᵢ.1.1) → (∀ (p₀ : ℝ × + ℝ), ∀ (pplus : ℝ × ℝ), (pplus - p₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 + (q i.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i.succ))) → + (∀ (qb : Fin (4 : ℕ) → CircleCoordinates), (qb (0 : Fin (4 : ℕ)) = C₀.1.1) → ((qb + i.succ = Cᵢ.1.1) → (pplus - p₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (qb + i.succ) (qb 0) + BandVectors.2 (qb 0) (qb i.succ))))))) ) := by + classical + intro q C₀ Cᵢ i hC₀ hCᵢ p₀ pplus hdplus qb hb₀ hbᵢ + simpa only [hb₀, hbᵢ, hC₀, hCᵢ] using hdplus + +private theorem rv : + (by + classical + exact + ∀ (i : Fin (3 : ℕ)), ∀ (qb : Fin (4 : ℕ) → CircleCoordinates), (BandVectors.1 (qb (0 : + Fin (4 : ℕ))) (qb i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (qb + i.succ) (qb (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (qb (0 : Fin (4 : ℕ))) (qb i.succ) = + -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (qb i.succ) (qb (0 : Fin (4 : + ℕ)))) → ((⟨0, 1⟩ : GaussianInt) ^ 3 * (BandVectors.1 (qb i.succ) (qb 0) + + BandVectors.1 (qb 0) (qb i.succ)) = BandVectors.1 (qb i.succ) (qb 0) - BandVectors.1 + (qb 0) (qb i.succ)) ) := by + classical + intro i qb flips + rw [flips.1] + ext <;> simp [pow_succ, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring + +private theorem ra : + (by + classical + exact + ∀ (i : Fin (3 : ℕ)), ∀ (qb : Fin (4 : ℕ) → CircleCoordinates), (BandVectors.1 (qb (0 : + Fin (4 : ℕ))) (qb i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (qb + i.succ) (qb (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (qb (0 : Fin (4 : ℕ))) (qb i.succ) = + -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (qb i.succ) (qb (0 : Fin (4 : + ℕ)))) → ((-⟨0, 1⟩ : GaussianInt) ^ 3 * (BandVectors.2 (qb i.succ) (qb 0) + + BandVectors.2 (qb 0) (qb i.succ)) = BandVectors.2 (qb i.succ) (qb 0) - BandVectors.2 + (qb 0) (qb i.succ)) ) := by + classical + intro i qb flips + rw [flips.2] + ext <;> simp [pow_succ, Zsqrtd.re_mul, Zsqrtd.im_mul]; ring + +private theorem adjacentMinus : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin (3 : ℕ)), ∀ (T₀ : ProtoTile), ∀ + (Rminus : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hminus : PartialOdometer), + (TileOdometer C₀.1.1 T₀ h₀) → ((TileOdometer Cᵢ.1.1 Rminus hminus) → (∀ (p₀ : ℝ × ℝ), + ∀ (pminus : ℝ × ℝ), (PartialOdometerSlope h₀ = some p₀) → ((PartialOdometerSlope + hminus = some pminus) → (∀ (qb : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple qb) → ((qb (0 : Fin (4 : ℕ)) = C₀.1.1) → ((qb i.succ = Cᵢ.1.1) → + ((TileCentroid Rminus - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (qb i.succ) (qb (0 : Fin (4 : ℕ))) - BandVectors.1 (qb (0 : Fin (4 : + ℕ))) (qb i.succ))) → ((pminus - p₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 + (qb i.succ) (qb 0) - BandVectors.2 (qb 0) (qb i.succ))) → (((⟨0, 1⟩ : GaussianInt) ^ + 3 * (BandVectors.1 (qb i.succ) (qb 0) + BandVectors.1 (qb 0) (qb i.succ)) = + BandVectors.1 (qb i.succ) (qb 0) - BandVectors.1 (qb 0) (qb i.succ)) → (((-⟨0, 1⟩ : + GaussianInt) ^ 3 * (BandVectors.2 (qb i.succ) (qb 0) + BandVectors.2 (qb 0) (qb + i.succ)) = BandVectors.2 (qb i.succ) (qb 0) - BandVectors.2 (qb 0) (qb i.succ)) → + (SubtileLatticeAdjacent C₀ Cᵢ T₀ Rminus h₀ hminus))))))))))) ) := by + classical + intro C₀ Cᵢ i T₀ Rminus h₀ hminus hO₀ hOminus p₀ pminus hs₀ hsminus qb hqb hb₀ hbᵢ hcminus dm + rv ra + refine ⟨hO₀, hOminus, p₀, pminus, hs₀, hsminus, + qb, i, 3, hqb, hb₀, hbᵢ, ?_, ?_, ?_⟩ + · simpa only [show (3 : Fin 4).val = 3 from rfl, rv] using hcminus + · simpa only [show (3 : Fin 4).val = 3 from rfl, ra, Prod.fst_sub] using congrArg Prod.fst dm + · simpa only [show (3 : Fin 4).val = 3 from rfl, ra, Prod.snd_sub] using congrArg Prod.snd dm + +private theorem adjacentPlus : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin (3 : ℕ)), ∀ (T₀ : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hplus : PartialOdometer), + (TileOdometer C₀.1.1 T₀ h₀) → ((TileOdometer Cᵢ.1.1 Rplus hplus) → (∀ (p₀ : ℝ × ℝ), ∀ + (pplus : ℝ × ℝ), (PartialOdometerSlope h₀ = some p₀) → ((PartialOdometerSlope hplus = + some pplus) → (∀ (qb : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple qb) → + ((qb (0 : Fin (4 : ℕ)) = C₀.1.1) → ((qb i.succ = Cᵢ.1.1) → ((TileCentroid Rplus - + TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (qb i.succ) (qb (0 : + Fin (4 : ℕ))) + BandVectors.1 (qb (0 : Fin (4 : ℕ))) (qb i.succ))) → ((pplus - p₀ = + (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (qb i.succ) (qb 0) + BandVectors.2 (qb + 0) (qb i.succ))) → (SubtileLatticeAdjacent C₀ Cᵢ T₀ Rplus h₀ hplus))))))))) ) := by + classical + intro C₀ Cᵢ i T₀ Rplus h₀ hplus hO₀ hOplus p₀ pplus hs₀ hsplus qb hqb hb₀ hbᵢ hcplus dp + refine ⟨hO₀, hOplus, p₀, pplus, hs₀, hsplus, + qb, i, 0, hqb, hb₀, hbᵢ, ?_, ?_, ?_⟩ + · simpa using hcplus + · simpa using congrArg Prod.fst dp + · simpa using congrArg Prod.snd dp + +private theorem root : + (by + classical + exact + (ℕ) → (∀ (C : BandCircle), ∀ (ε : Bool), ∀ (B : ProtoTile), ∀ (R : ProtoTile), ∀ (S : + ProtoTile), ∀ (g : PartialOdometer), ∀ (h : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C ε B R S g h), 1 < (F.q 0).1) ) := by + classical + intro n C ε B R S g h F + have positive := C.property + have smaller := F.proper.2 F.slot + rw [F.parent] at smaller + omega + +private theorem ancestors : + (by + classical + exact + ∀ (C : BandCircle), ∀ (ε : Bool), ∀ (B : ProtoTile), ∀ (R : ProtoTile), ∀ (S : + ProtoTile), ∀ (g : PartialOdometer), ∀ (h : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C ε B R S g h), ∀ (T : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (H : + Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + TileOdometer (F.q i.succ) (T i s) (H i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + FootprintVertices (T i s) ⊆ FootprintVertices F.tile) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), TileCentroid (T i s) - TileCentroid F.tile = (if s = true then (1 : ℝ) else + (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (i + (2 : Fin (3 : + ℕ))).succ) (F.q (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 + (F.q (i + (2 : Fin (3 : ℕ))).succ) (F.q (i + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint (BandVectors.1 (F.q (i + (2 : Fin (3 : ℕ))).succ) (F.q (i + (1 : + Fin (3 : ℕ))).succ))).1))) → ((∀ (x : GaussianInt), x ∈ F.odometer.domain ↔ ∃ (i : + Fin (3 : ℕ)) (s : Bool), x ∈ (H i s).domain) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ + x ∈ (H i s).domain, F.odometer.value x = (H i s).value x) → (∀ (j : Fin 3), ∀ (s : + Bool), (0 < (F.q j.succ).1) → (AncestorOdometer (F.q j.succ) F.outer.1.1 (T j s) + F.tile (H j s) F.odometer)))))) ) := by + classical + intro C ε B R S g h F T H hsub hfoot hcent hdom hvalue j s hj + refine ⟨F.outer_odo, ?_, + PositiveCurvatureTileOdometerDomain _ _ _ hj (hsub j s), ?_, ?_⟩ + · exact Relation.ReflTransGen.single + ⟨F.q, j, s, F.proper, F.child, rfl, F.outer_band, + TileOdometerBandPrototile _ _ _ (hsub j s), hfoot j s, hcent j s⟩ + · intro x hx + exact (hdom x).mpr ⟨j, s, hx⟩ + · intro x hx + exact (hvalue j s x hx).symm + +private theorem rotateProper : + (by + classical + exact + ∀ (u : Fin 4 → CircleCoordinates), (ProperBandQuadruple u) → (ProperBandQuadruple ![u 0, + u 2, u 3, u 1]) ) := by + classical + intro u hu + refine ⟨SemiProperQuadruple.rotate hu.1, ?_⟩ + intro j + fin_cases j + · simpa using hu.2 1 + · simpa using hu.2 2 + · simpa using hu.2 0 + +private theorem asymmetric : + (by + classical + exact + ∀ {X : CircleCoordinates}, ∀ {Y : CircleCoordinates}, (PrimitiveVectorOrientation X Y) → + ((PrimitiveVectorOrientation Y X) → (False)) ) := by + classical + intro X Y hXY hYX + have hex := ((PrimitiveVectorOrientationUnique X Y).2 + ((PrimitiveVectorOrientationUnique X Y).1 hXY)).2 + rcases hex with ⟨_, hn⟩ | ⟨_, hn⟩ + · exact hn hYX + · exact hn hXY + +private theorem unitPair : + (by + classical + exact + (ℕ) → (∀ (C : BandCircle), ∀ (ε : Bool), ∀ (B : ProtoTile), ∀ (R : ProtoTile), ∀ (S : + ProtoTile), ∀ (g : PartialOdometer), ∀ (h : PartialOdometer), (P4458T1BoundaryFrame + C ε B R S g h) → (∀ (u : Fin 4 → CircleCoordinates), (ProperBandQuadruple u) → (((u + 2).1 = 1) → (((u 3).1 = 1) → ((PrimitiveVectorOrientation (u 2) (u 3) ∧ + UnitOccurrenceOrientation u 1 false ∧ UnitOccurrenceOrientation u 2 true) ∨ + (PrimitiveVectorOrientation (u 3) (u 2) ∧ UnitOccurrenceOrientation u 1 true ∧ + UnitOccurrenceOrientation u 2 false)))))) ) := by + classical + intro n C ε B R S g h F u hu hu2 hu3 + obtain ⟨_, _, _, _, inv, cases⟩ := BandOrientedBoundaryOccurrenceGenealogy u hu + rcases cases with small | second | third + · rcases small.2 with forward | backward + · have cert := forward.2.2.2 hu2 hu3 + exact Or.inl ⟨forward.1, inv.1 hu2 false cert.1, + inv.2 hu3 true cert.2.1⟩ + · have cert := backward.2.2.2 hu2 hu3 + exact Or.inr ⟨backward.1, inv.1 hu2 true cert.1, + inv.2 hu3 false cert.2.1⟩ + · obtain ⟨t, ht, ht0, ht1, hlt, _⟩ := second + omega + · obtain ⟨t, ht, ht0, ht1, hlt, _⟩ := third + omega + +private theorem successorCase : + (by + classical + exact + ∀ (C : BandCircle), ∀ (ε : Bool), ∀ (B : ProtoTile), ∀ (R : ProtoTile), ∀ (S : + ProtoTile), ∀ (g : PartialOdometer), ∀ (h : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C ε B R S g h), ∀ (T : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (H : + Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (hsub : ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + TileOdometer (F.q i.succ) (T i s) (H i s)), ∀ (hfoot : ∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), FootprintVertices (T i s) ⊆ FootprintVertices F.tile), ∀ (hcent : ∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), TileCentroid (T i s) - TileCentroid F.tile = (if s = true + then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (i + + (2 : Fin (3 : ℕ))).succ) (F.q (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (F.q (i + (2 : Fin (3 : ℕ))).succ) (F.q (i + (1 : Fin (3 : + ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q (i + (2 : Fin (3 : ℕ))).succ) + (F.q (i + (1 : Fin (3 : ℕ))).succ))).1))), ∀ (hdom : ∀ (x : GaussianInt), x ∈ + F.odometer.domain ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (H i s).domain), ∀ (hvalue : + ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (H i s).domain, F.odometer.value x = (H i + s).value x), ∀ (hslope : ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (F.q i.succ).1 = (0 : ℤ) + ∨ ∃ (p : ℝ × ℝ) (p_i : ℝ × ℝ), PartialOdometerSlope F.odometer = some p ∧ + PartialOdometerSlope (H i s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (i + (2 : Fin (3 : ℕ))).succ) + (F.q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (i + (2 : Fin (3 + : ℕ))).succ) (F.q (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = + true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (i + (2 : Fin + (3 : ℕ))).succ) (F.q (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q + (i + (2 : Fin (3 : ℕ))).succ) (F.q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))), ∀ + (ancestors : ∀ (j : Fin 3), ∀ (s : Bool), (0 < (F.q j.succ).1) → (AncestorOdometer + (F.q j.succ) F.outer.1.1 (T j s) F.tile (H j s) F.odometer)), + let D : P4458T1RestrictionFamily F := + { tiles := T, functions := H, odometers := hsub + occurrences := fun j s => + ⟨TileOdometerBandPrototile _ _ _ (hsub j s), hfoot j s, hcent j s⟩ + domain_subset := fun j s x hx => (hdom x).mpr ⟨j, s, hx⟩ + value_eq := fun j s x hx => (hvalue j s x hx).symm + ancestors := ancestors, slopes := hslope } + (∀ (u : Fin 4 → CircleCoordinates), (ProperBandQuadruple u) → (ProperBandQuadruple ![u 0, + u 2, u 3, u 1])) → ((∀ {X : CircleCoordinates}, ∀ {Y : CircleCoordinates}, + (PrimitiveVectorOrientation X Y) → ((PrimitiveVectorOrientation Y X) → (False))) → + ((∀ (u : Fin 4 → CircleCoordinates), (ProperBandQuadruple u) → (((u 2).1 = 1) → (((u + 3).1 = 1) → ((PrimitiveVectorOrientation (u 2) (u 3) ∧ UnitOccurrenceOrientation u 1 + false ∧ UnitOccurrenceOrientation u 2 true) ∨ (PrimitiveVectorOrientation (u 3) (u 2) + ∧ UnitOccurrenceOrientation u 1 true ∧ UnitOccurrenceOrientation u 2 false))))) → (∀ + (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → ((![F.q 0, + F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3]) → (Nonempty (P4458T1BoundaryPlacement F D)))))) ) := by + classical + intro C ε B R S g h F T H hsub hfoot hcent hdom hvalue hslope ancestors D rotateProper + asymmetric unitPair a p hp hstep + by_cases selected : F.slot = a + · exact P4458T1LargestParentRows F D a p hp hstep selected + have pq2 : p 2 = F.q (a + 1).succ := by + simpa using (congrFun hstep 2).symm + have pq3 : p 3 = F.q (a + 2).succ := by + simpa using (congrFun hstep 3).symm + obtain ⟨_, _, _, _, inv, cases⟩ := BandOrientedBoundaryOccurrenceGenealogy p hp + have rotatedChart (hc : C.1.1.1 = 1) : + UnitOccurrenceOrientation + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (F.slot - a) ε := by + have hcq := F.chart hc + fin_cases a + · convert hcq using 1 + · funext j + fin_cases j <;> congr 1 + · generalize F.slot = z + fin_cases z <;> decide + · have hcq' := UnitOccurrenceOrientation.rotate hcq + convert hcq' using 1 + · funext j + fin_cases j <;> rfl + · generalize F.slot = z + fin_cases z <;> decide + · have hcq' := UnitOccurrenceOrientation.rotate (UnitOccurrenceOrientation.rotate hcq) + convert hcq' using 1 + · funext j + fin_cases j <;> rfl + · generalize F.slot = z + fin_cases z <;> decide + have hB (hi : F.slot = a + 1) (hc : C.1.1.1 = 1) : + UnitOccurrenceOrientation p 1 ε := by + have hunit : (p 2).1 = 1 := by rw [pq2, ← hi, F.parent]; exact hc + apply inv.1 hunit ε + have hh := rotatedChart hc + rw [hstep] at hh + simpa [hi] using hh + have hD (hi : F.slot = a + 2) (hc : C.1.1.1 = 1) : + UnitOccurrenceOrientation p 2 ε := by + have hunit : (p 3).1 = 1 := by rw [pq3, ← hi, F.parent]; exact hc + apply inv.2 hunit ε + have hh := rotatedChart hc + rw [hstep] at hh + simpa [hi] using hh + rcases cases with small | second | third + · exact P4458T1SmallPairRows F D a p hp hstep hB hD selected small.1 + · obtain ⟨t, ht, ht0, ht1, newer, transport⟩ := second + have olderChart (hi : F.slot = a + 2) (hc : C.1.1.1 = 1) : + UnitOccurrenceOrientation t 0 ε := by + have data := transport ε (hD hi hc) + by_cases hidden : (t 2).1 = 1 + · have htunit : (t 1).1 = 1 := by + rw [ht1, pq3, ← hi, F.parent] + exact hc + let u : Fin 4 → CircleCoordinates := ![t 0, t 3, t 1, t 2] + have hu : ProperBandQuadruple u := by + simpa [u] using rotateProper _ (rotateProper t ht) + have pairs := unitPair u hu (by simpa [u] using htunit) + (by simpa [u] using hidden) + have huChart : UnitOccurrenceOrientation u 1 ε := by + rcases pairs with forward | backward + · rcases data.2 hidden with ⟨arrow, label⟩ | ⟨arrow, label⟩ + · simpa only [label] using forward.2.1 + · exact (asymmetric (by simpa [u] using forward.1) arrow).elim + · rcases data.2 hidden with ⟨arrow, label⟩ | ⟨arrow, label⟩ + · exact (asymmetric arrow (by simpa [u] using backward.1)).elim + · simpa only [label] using backward.2.1 + have he : ![t 0, t 1, t 2, t 3] = t := by + funext j + fin_cases j <;> rfl + simpa [u, he] using UnitOccurrenceOrientation.rotate huChart + · exact data.1 hidden + exact P4458T1SecondNewerRows F D a p hp hstep hB hD selected + t ht ht0 ht1 newer olderChart + · obtain ⟨t, ht, ht0, ht1, newer, transport⟩ := third + have olderChart (hi : F.slot = a + 1) (hc : C.1.1.1 = 1) : + UnitOccurrenceOrientation t 0 ε := by + have data := transport ε (hB hi hc) + by_cases hidden : (t 3).1 = 1 + · have htunit : (t 1).1 = 1 := by + rw [ht1, pq2, ← hi, F.parent] + exact hc + let u : Fin 4 → CircleCoordinates := ![t 0, t 2, t 3, t 1] + have hu : ProperBandQuadruple u := rotateProper t ht + have pairs := unitPair u hu (by simpa [u] using hidden) + (by simpa [u] using htunit) + have huChart : UnitOccurrenceOrientation u 2 ε := by + rcases pairs with forward | backward + · rcases data.2 hidden with ⟨arrow, label⟩ | ⟨arrow, label⟩ + · exact (asymmetric (by simpa [u] using forward.1) arrow).elim + · simpa only [label] using forward.2.2 + · rcases data.2 hidden with ⟨arrow, label⟩ | ⟨arrow, label⟩ + · simpa only [label] using backward.2.2 + · exact (asymmetric arrow (by simpa [u] using backward.1)).elim + have he : ![t 0, t 1, t 2, t 3] = t := by + funext j + fin_cases j <;> rfl + simpa [u, he] using + UnitOccurrenceOrientation.rotate (UnitOccurrenceOrientation.rotate huChart) + · exact data.1 hidden + exact P4458T1ThirdNewerRows F D a p hp hstep hB hD selected + t ht ht0 ht1 newer olderChart + +private theorem placement : + (by + classical + exact + ∀ (C : BandCircle), ∀ (ε : Bool), ∀ (B : ProtoTile), ∀ (R : ProtoTile), ∀ (S : + ProtoTile), ∀ (g : PartialOdometer), ∀ (h : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C ε B R S g h), ∀ (T : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (H : + Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (hsub : ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + TileOdometer (F.q i.succ) (T i s) (H i s)), ∀ (hfoot : ∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), FootprintVertices (T i s) ⊆ FootprintVertices F.tile), ∀ (hcent : ∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), TileCentroid (T i s) - TileCentroid F.tile = (if s = true + then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (i + + (2 : Fin (3 : ℕ))).succ) (F.q (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (F.q (i + (2 : Fin (3 : ℕ))).succ) (F.q (i + (1 : Fin (3 : + ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q (i + (2 : Fin (3 : ℕ))).succ) + (F.q (i + (1 : Fin (3 : ℕ))).succ))).1))), ∀ (hdom : ∀ (x : GaussianInt), x ∈ + F.odometer.domain ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (H i s).domain), ∀ (hvalue : + ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (H i s).domain, F.odometer.value x = (H i + s).value x), ∀ (hslope : ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (F.q i.succ).1 = (0 : ℤ) + ∨ ∃ (p : ℝ × ℝ) (p_i : ℝ × ℝ), PartialOdometerSlope F.odometer = some p ∧ + PartialOdometerSlope (H i s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (i + (2 : Fin (3 : ℕ))).succ) + (F.q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (i + (2 : Fin (3 + : ℕ))).succ) (F.q (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = + true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (i + (2 : Fin + (3 : ℕ))).succ) (F.q (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q + (i + (2 : Fin (3 : ℕ))).succ) (F.q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))), ∀ + (ancestors : ∀ (j : Fin 3), ∀ (s : Bool), (0 < (F.q j.succ).1) → (AncestorOdometer + (F.q j.succ) F.outer.1.1 (T j s) F.tile (H j s) F.odometer)), + let D : P4458T1RestrictionFamily F := + { tiles := T, functions := H, odometers := hsub + occurrences := fun j s => + ⟨TileOdometerBandPrototile _ _ _ (hsub j s), hfoot j s, hcent j s⟩ + domain_subset := fun j s x hx => (hdom x).mpr ⟨j, s, hx⟩ + value_eq := fun j s x hx => (hvalue j s x hx).symm + ancestors := ancestors, slopes := hslope } + (∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → ((![F.q 0, + F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * + (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p + 3]) → (Nonempty (P4458T1BoundaryPlacement F D)))) → (Nonempty + (P4458T1BoundaryPlacement F D)) ) := by + classical + intro C ε B R S g h F T H hsub hfoot hcent hdom hvalue hslope ancestors D successorCase + rcases BandParentBoundaryGenealogy F.q F.proper with roots | first | second | third + · exact P4458T1FirstProperRows F D roots + · obtain ⟨p, hp, hs, _⟩ := first + apply successorCase 0 p hp + convert hs using 1 + funext j + fin_cases j <;> rfl + · obtain ⟨p, hp, hs, _⟩ := second + exact successorCase 1 p hp (by simpa using hs) + · obtain ⟨p, hp, hs, _⟩ := third + exact successorCase 2 p hp (by simpa using hs) + +private theorem realize : + (by + classical + exact + ∀ (n : ℕ), (∀ m < n, ∀ (C : BandCircle), ∀ (ε : Bool), ∀ (B : ProtoTile), ∀ (R : + ProtoTile), ∀ (S : ProtoTile), ∀ (g : PartialOdometer), ∀ (h : PartialOdometer), ∀ (F + : P4458T1BoundaryFrame C ε B R S g h), F.outer.1.1.1.toNat = m → ∃ (ts : List + ProtoTile) (fs : List PartialOdometer), + fs.head? = some g ∧ fs.getLast? = some h ∧ OdometerStringRespect C ε B R S ts fs ∧ ∀ + U ∈ (List.drop (1 : ℕ) ts).dropLast, ∃ (k : PartialOdometer), (U, k) ∈ ts.zip fs ∧ + AncestorOdometer C.1.1 F.outer.1.1 U F.tile + k F.odometer) → (∀ (C : BandCircle), ∀ (ε : Bool), ∀ (B : ProtoTile), ∀ (R : + ProtoTile), ∀ (S : ProtoTile), ∀ (g : PartialOdometer), ∀ (h : PartialOdometer), ∀ (F + : P4458T1BoundaryFrame C ε B R S g h), (F.outer.1.1.1.toNat = n) → (∀ + {U : ProtoTile}, ∀ {V : ProtoTile}, ∀ + {k : PartialOdometer}, ∀ {l : PartialOdometer}, (P4458T1BoundarySide F U V k l) → + (∃ ts fs, fs.head? = some k ∧ fs.getLast? = some l ∧ OdometerStringRespect C ε B U V + ts fs ∧ ∀ W ∈ (ts.drop 1).dropLast, ∃ m, (W, m) ∈ ts.zip fs ∧ AncestorOdometer C.1.1 + F.outer.1.1 W F.tile m F.odometer))) ) := by + classical + intro n ih C ε B R S g h F hn U V k l side + cases side with + | direct string link => + refine ⟨[U, V], [k, l], by simp, by simp, ?_, ?_⟩ + · refine ⟨string, List.Forall₂.cons link.1 + (List.Forall₂.cons link.2.1 List.Forall₂.nil), ?_⟩ + simpa [List.IsChain, List.isChain_pair] using link + · simp + | recursive G j parent ancestor => + have smaller : G.outer.1.1.1 < F.outer.1.1.1 := by + simpa only [← parent, F.child] using F.proper.2 j + have decrease : G.outer.1.1.1.toNat < n := by + have positive := G.outer.property + omega + obtain ⟨ts, hts⟩ := TileStringExists C ε B U V + G.base_band G.minus_family G.plus_family + obtain ⟨us, fs, head, last, respect, inner⟩ := + ih G.outer.1.1.1.toNat decrease C ε B U V k l G rfl + have same := TileStringUnique C ε B U V us ts respect.1 hts + subst us + refine ⟨ts, fs, head, last, respect, ?_⟩ + intro W hW + obtain ⟨m, hm, ha⟩ := inner W hW + exact ⟨m, hm, AncestorOdometerTrans _ _ _ _ _ _ _ _ _ ha ancestor⟩ + +private theorem hxk : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin (3 : ℕ)), ∀ (orientation : Bool), ∀ + (T₀ : ProtoTile), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : + ProtoTile), ∀ (tiles : List ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hminus : + PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (hO₀ : TileOdometer C₀.1.1 T₀ h₀), ∀ + (hOminus : TileOdometer Cᵢ.1.1 Rminus hminus), ∀ (hOplus : TileOdometer Cᵢ.1.1 Rplus + hplus), ∀ (p₀ : ℝ × ℝ), ∀ (pminus : ℝ × ℝ), ∀ (pplus : ℝ × ℝ), ∀ (hs₀ : + PartialOdometerSlope h₀ = some p₀), ∀ (hsminus : PartialOdometerSlope hminus = some + pminus), ∀ (hsplus : PartialOdometerSlope hplus = some pplus), ∀ (qb : Fin (4 : ℕ) → + CircleCoordinates), ∀ (hqb : ProperBandQuadruple qb), ∀ (hb₀ : qb (0 : Fin (4 : ℕ)) = + C₀.1.1), ∀ (hbᵢ : qb i.succ = Cᵢ.1.1), ∀ (hT₀ : BandPrototile C₀.1.1 T₀), ∀ (hchart : + Cᵢ.1.1.1 = (1 : ℤ) → UnitOccurrenceOrientation qb i orientation), ∀ (htiles : + TileString Cᵢ orientation base Rminus Rplus tiles), ∀ (hcminus : TileCentroid Rminus + - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (qb i.succ) (qb (0 + : Fin (4 : ℕ))) - BandVectors.1 (qb (0 : Fin (4 : ℕ))) (qb i.succ))), ∀ (hcplus : + TileCentroid Rplus - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 + (qb i.succ) (qb (0 : Fin (4 : ℕ))) + BandVectors.1 (qb (0 : Fin (4 : ℕ))) (qb + i.succ))), ∀ (dm : pminus - p₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (qb + i.succ) (qb 0) - BandVectors.2 (qb 0) (qb i.succ))), ∀ (dp : pplus - p₀ = (1 / 2 : ℝ) + • GaussianRealPoint (BandVectors.2 (qb i.succ) (qb 0) + BandVectors.2 (qb 0) (qb + i.succ))), + let initial : P4458T1BoundaryFrame Cᵢ orientation base Rminus Rplus hminus hplus := + { outer := C₀, q := qb, proper := hqb, slot := i, child := hb₀, parent := hbᵢ + tile := T₀, odometer := h₀, outer_odo := hO₀, minus_odo := hOminus + plus_odo := hOplus, outer_band := hT₀, base_band := htiles.1 + minus_family := htiles.2.2.2.2.1 _ (List.mem_of_mem_head? htiles.2.1) + plus_family := htiles.2.2.2.2.1 _ (List.mem_of_getLast? htiles.2.2.1) + chart := hchart, minus_centroid := hcminus, plus_centroid := hcplus + outer_slope := p₀, minus_slope := pminus, plus_slope := pplus + slope_outer := hs₀, slope_minus := hsminus, slope_plus := hsplus + minus_difference := dm, plus_difference := dp } + ∀ (U : ProtoTile), ∀ (k : PartialOdometer), (AncestorOdometer Cᵢ.1.1 initial.outer.1.1 U + initial.tile k initial.odometer) → (∀ (x : + GaussianInt), (x ∈ FootprintVertices U) → (x ∈ k.domain)) ) := by + classical + intro C₀ Cᵢ i orientation T₀ base Rminus Rplus tiles h₀ hminus hplus hO₀ hOminus hOplus p₀ + pminus pplus hs₀ hsminus hsplus qb hqb hb₀ hbᵢ hT₀ hchart htiles hcminus hcplus dm dp + initial U k ha x hx + change x ∈ (k.domain : Set GaussianInt) + rw [ha.2.2.1] + exact hx + +end BoundaryOdometerGeometry + +theorem BoundaryStringOdometerRespect : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (C₀ : BandCircle), ∀ (Cᵢ : + BandCircle), ∀ (i : Fin 3), (q 0 = C₀.1.1) → ((q i.succ = Cᵢ.1.1) → (∀ (orientation : + Bool), ∀ (T₀ : ProtoTile), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : + ProtoTile), ∀ (tiles : List ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hminus : + PartialOdometer), ∀ (hplus : PartialOdometer), (TileOdometer C₀.1.1 T₀ h₀) → + ((BoundaryString C₀ Cᵢ i orientation T₀ base Rminus Rplus tiles) → ((TileOdometer Cᵢ.1.1 + Rminus hminus) → ((TileOdometer Cᵢ.1.1 Rplus hplus) → (∀ (p₀ : ℝ × ℝ), ∀ (pminus : ℝ × + ℝ), ∀ (pplus : ℝ × ℝ), (PartialOdometerSlope h₀ = some p₀) → ((PartialOdometerSlope + hminus = some pminus) → ((PartialOdometerSlope hplus = some pplus) → ((pminus - p₀ = (1 / + 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ))) → ((pplus - p₀ = (1 / 2 + : ℝ) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ))) → + (SubtileLatticeAdjacent C₀ Cᵢ T₀ Rminus h₀ hminus ∧ + SubtileLatticeAdjacent C₀ Cᵢ T₀ Rplus h₀ hplus ∧ + (∀ T ∈ (tiles.drop 1).dropLast, FootprintVertices T ⊆ FootprintVertices T₀) ∧ + ∃ hs : List PartialOdometer, + hs.head? = some hminus ∧ hs.getLast? = some hplus ∧ + OdometerStringRespect Cᵢ orientation base Rminus Rplus tiles hs ∧ + ∀ T ∈ (tiles.drop 1).dropLast, + ∃ h, (T, h) ∈ tiles.zip hs ∧ + AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀ h h₀)))))))))))) := by + intro q hq C₀ Cᵢ i hC₀ hCᵢ orientation T₀ base Rminus Rplus tiles h₀ hminus hplus hO₀ hstring + hOminus hOplus p₀ pminus pplus hs₀ hsminus hsplus hdminus hdplus +-- BODY + classical + obtain ⟨qb, hqb, hb₀, hbᵢ, hT₀, hchart, htiles, hcminus, hcplus⟩ := hstring + have dm := BoundaryOdometerGeometry.dm q C₀ Cᵢ i hC₀ hCᵢ p₀ pminus hdminus qb hb₀ hbᵢ + have dp := BoundaryOdometerGeometry.dp q C₀ Cᵢ i hC₀ hCᵢ p₀ pplus hdplus qb hb₀ hbᵢ + have flips := (VectorRecursionLaws qb hqb.1).2.2.2.2 hqb i + have adjacentMinus := BoundaryOdometerGeometry.adjacentMinus C₀ Cᵢ i T₀ Rminus h₀ hminus hO₀ + hOminus p₀ pminus hs₀ hsminus qb hqb hb₀ hbᵢ hcminus dm (BoundaryOdometerGeometry.rv i qb + flips) (BoundaryOdometerGeometry.ra i qb flips) + have adjacentPlus := BoundaryOdometerGeometry.adjacentPlus C₀ Cᵢ i T₀ Rplus h₀ hplus hO₀ hOplus + p₀ pplus hs₀ hsplus qb hqb hb₀ hbᵢ hcplus dp + let initial : P4458T1BoundaryFrame Cᵢ orientation base Rminus Rplus hminus hplus := + { outer := C₀, q := qb, proper := hqb, slot := i, child := hb₀, parent := hbᵢ + tile := T₀, odometer := h₀, outer_odo := hO₀, minus_odo := hOminus + plus_odo := hOplus, outer_band := hT₀, base_band := htiles.1 + minus_family := htiles.2.2.2.2.1 _ (List.mem_of_mem_head? htiles.2.1) + plus_family := htiles.2.2.2.2.1 _ (List.mem_of_getLast? htiles.2.2.1) + chart := hchart, minus_centroid := hcminus, plus_centroid := hcplus + outer_slope := p₀, minus_slope := pminus, plus_slope := pplus + slope_outer := hs₀, slope_minus := hsminus, slope_plus := hsplus + minus_difference := dm, plus_difference := dp } + have construct : ∀ n : ℕ, ∀ (C : BandCircle) (ε : Bool) + (B R S : ProtoTile) (g h : PartialOdometer) + (F : P4458T1BoundaryFrame C ε B R S g h), + F.outer.1.1.1.toNat = n → + ∃ ts fs, fs.head? = some g ∧ fs.getLast? = some h ∧ + OdometerStringRespect C ε B R S ts fs ∧ + ∀ U ∈ (ts.drop 1).dropLast, + ∃ k, (U, k) ∈ ts.zip fs ∧ + AncestorOdometer C.1.1 F.outer.1.1 U F.tile k F.odometer := by + intro n + induction n using Nat.strong_induction_on with + | h n ih => + intro C ε B R S g h F hn + have root := BoundaryOdometerGeometry.root n C ε B R S g h F + obtain ⟨T, H, hband, hsub, hcells, hfoot, hcent, hdom, hvalue, hcompat, hslope⟩ := + TileOdometerReindexedDecomposition F.q F.proper F.tile F.odometer root + (by simpa only [F.child] using F.outer_odo) + have ancestors := BoundaryOdometerGeometry.ancestors C ε B R S g h F T H hsub hfoot hcent + hdom hvalue + let D : P4458T1RestrictionFamily F := + { tiles := T, functions := H, odometers := hsub + occurrences := fun j s => + ⟨TileOdometerBandPrototile _ _ _ (hsub j s), hfoot j s, hcent j s⟩ + domain_subset := fun j s x hx => (hdom x).mpr ⟨j, s, hx⟩ + value_eq := fun j s x hx => (hvalue j s x hx).symm + ancestors := ancestors, slopes := hslope } + -- A hidden unit is resolved through a second literal successor. + have placement := BoundaryOdometerGeometry.placement C ε B R S g h F T H hsub hfoot hcent + hdom hvalue hslope ancestors (BoundaryOdometerGeometry.successorCase C ε B R S g h F T + H hsub hfoot hcent hdom hvalue hslope ancestors (BoundaryOdometerGeometry.rotateProper) + (BoundaryOdometerGeometry.asymmetric) (BoundaryOdometerGeometry.unitPair n C ε B R S g + h F)) + obtain ⟨P⟩ := placement + have realize {U V : ProtoTile} {k l : PartialOdometer} + (side : P4458T1BoundarySide F U V k l) := BoundaryOdometerGeometry.realize n ih C ε B + R S g h F hn (U := U) (V := V) (k := k) (l := l) side + obtain ⟨left, hl, hlhead, hllast, hleft, hleftAnc⟩ := realize P.left + obtain ⟨right, hr, hrhead, hrlast, hright, hrightAnc⟩ := realize P.right + have joinOdometer : TileOdometer C.1.1 P.join (D.functions F.slot false) := + AncestorOdometerRestriction C.1.1 F.outer.1.1 P.join F.tile + (D.functions F.slot false) F.odometer P.ancestor + have chart (hc : (F.q F.slot.succ).1 = 1) : + UnitOccurrenceOrientation F.q F.slot ε := F.chart (by simpa [F.parent] using hc) + obtain ⟨_, _, joined⟩ := + BoundaryStringConcatenation F.q F.proper F.outer C F.slot F.child F.parent + ε ε ε chart chart chart F.tile B P.join R S left right + (by simpa only [F.child] using F.outer_band) + (by simpa only [F.parent] using + TileOdometerBandPrototile _ _ _ joinOdometer) + (by simpa using P.occurrence.2.2) + F.minus_centroid F.plus_centroid hleft.1 hright.1 + obtain ⟨_, _, _, _, _, _, hjoined, _, _⟩ := joined + have appended := P4458T1RespectAppend C F.outer ε B R P.join S F.tile + g (D.functions F.slot false) h F.odometer left right hl hr + hleft hright hlhead hllast hrhead hrlast hjoined P.ancestor hleftAnc hrightAnc + exact ⟨left.dropLast ++ right, hl.dropLast ++ hr, appended⟩ + obtain ⟨ts, fs, head, last, respect, inner⟩ := + construct C₀.1.1.1.toNat Cᵢ orientation base Rminus Rplus hminus hplus initial rfl + have same := TileStringUnique Cᵢ orientation base Rminus Rplus ts tiles respect.1 htiles + subst ts + refine ⟨adjacentMinus, adjacentPlus, ?_, fs, head, last, respect, inner⟩ + intro U hU + obtain ⟨k, _, ha⟩ := inner U hU + have domain := PositiveCurvatureTileOdometerDomain C₀.1.1 T₀ h₀ C₀.property hO₀ + intro x hx + rw [← domain] + exact ha.2.2.2.1 (BoundaryOdometerGeometry.hxk C₀ Cᵢ i orientation T₀ base Rminus Rplus tiles + h₀ hminus hplus hO₀ hOminus hOplus p₀ pminus pplus hs₀ hsminus hsplus qb hqb hb₀ hbᵢ hT₀ + hchart htiles hcminus hcplus dm dp U k ha x hx) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BoundedDifference.lean b/LeanPool/ApollonianSuperharmonic/BoundedDifference.lean new file mode 100644 index 0000000000..a481877c3c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BoundedDifference.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction + +-- [TABLET NODE: BoundedDifference] + +/-! +# BoundedDifference + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Two integer lattice functions $f$ and $g$ have bounded difference if there +is a natural number $B$ such that $|f(x)-g(x)|\leq B$ for every +$x\in\mathbb Z[i]$. +-/ +def BoundedDifference (f g : IntegerLatticeFunction) : Prop := +-- BODY + ∃ B : ℕ, ∀ x, Int.natAbs (f x - g x) ≤ B + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CellDisjointCommonEdgesBoundary.lean b/LeanPool/ApollonianSuperharmonic/CellDisjointCommonEdgesBoundary.lean new file mode 100644 index 0000000000..f4c07683e8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CellDisjointCommonEdgesBoundary.lean @@ -0,0 +1,149 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: CellDisjointCommonEdgesBoundary] + +/-! +# CellDisjointCommonEdgesBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem CellDisjointCommonEdgesBoundary (U V : ProtoTile) + (hdisjoint : Disjoint U.cells V.cells) : + FootprintEdges U ∩ FootprintEdges V = + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V := by +-- BODY + classical + let I : GaussianInt := ⟨0, 1⟩ + have horiz_unique (x y : GaussianInt) + (h : ({x, x + 1} : Finset GaussianInt) = {y, y + 1}) : x = y := by + have hx : x = y ∨ x = y + 1 := by + have : x ∈ ({y, y + 1} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hy : y = x ∨ y = x + 1 := by + have : y ∈ ({x, x + 1} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hx with hxy | hxy + · exact hxy + rcases hy with hyx | hyx + · exact hyx.symm + · exfalso + have hre := congrArg Zsqrtd.re hxy + have hre' := congrArg Zsqrtd.re hyx + norm_num at hre hre' + omega + have vert_unique (x y : GaussianInt) + (h : ({x, x + I} : Finset GaussianInt) = {y, y + I}) : x = y := by + have hx : x = y ∨ x = y + I := by + have : x ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hy : y = x ∨ y = x + I := by + have : y ∈ ({x, x + I} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hx with hxy | hxy + · exact hxy + rcases hy with hyx | hyx + · exact hyx.symm + · exfalso + have him := congrArg Zsqrtd.im hxy + have him' := congrArg Zsqrtd.im hyx + simp [I] at him him' + omega + have horiz_ne_vert (x y : GaussianInt) : + ({x, x + 1} : Finset GaussianInt) ≠ {y, y + I} := by + intro h + have hx : x = y ∨ x = y + I := by + have : x ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hx1 : x + 1 = y ∨ x + 1 = y + I := by + have : x + 1 ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + rcases hx with hx | hx <;> rcases hx1 with hx1 | hx1 + all_goals + have hre := congrArg Zsqrtd.re hx + have him := congrArg Zsqrtd.im hx + have hre1 := congrArg Zsqrtd.re hx1 + have him1 := congrArg Zsqrtd.im hx1 + simp [I] at hre him hre1 him1 + omega + have footprint_normalize (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges T) : + (∃ z, e = {z, z + 1} ∧ (z ∈ T.cells ∨ z - I ∈ T.cells)) ∨ + (∃ z, e = {z, z + I} ∧ (z ∈ T.cells ∨ z - 1 ∈ T.cells)) := by + rcases he with ⟨x, hx, h | h | h | h⟩ + · exact Or.inl ⟨x, h, Or.inl hx⟩ + · exact Or.inr ⟨x, h, Or.inl hx⟩ + · refine Or.inr ⟨x + 1, h, Or.inr ?_⟩ + simpa [add_sub_cancel_right] using hx + · refine Or.inl ⟨x + I, ?_, Or.inr ?_⟩ + · simpa [I, Zsqrtd.ext_iff, add_comm, add_left_comm, add_assoc] using h + simpa [I, Zsqrtd.ext_iff] using hx + have boundary_footprint (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) : e ∈ FootprintEdges T := by + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [I, Zsqrtd.ext_iff] + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp + ext e + constructor + · rintro ⟨heU, heV⟩ + have hd := Finset.disjoint_left.mp hdisjoint + rcases footprint_normalize U e heU with ⟨z, hz, hzU⟩ | ⟨z, hz, hzU⟩ <;> + rcases footprint_normalize V e heV with ⟨w, hw, hwV⟩ | ⟨w, hw, hwV⟩ + · have bzw : z = w := horiz_unique z w (hz.symm.trans hw) + subst w + constructor <;> refine ⟨z, Or.inl ⟨?_, ?_⟩⟩ + · exact hz + · rcases hzU with hzU | hzU <;> rcases hwV with hzV | hzV + · exact (hd hzU hzV).elim + · exact Or.inl ⟨hzU, fun hbad => hd hbad hzV⟩ + · exact Or.inr ⟨fun hbad => hd hbad hzV, hzU⟩ + · exact (hd hzU hzV).elim + · exact hz + · rcases hzU with hzU | hzU <;> rcases hwV with hzV | hzV + · exact (hd hzU hzV).elim + · exact Or.inr ⟨fun hbad => hd hzU hbad, hzV⟩ + · exact Or.inl ⟨hzV, fun hbad => hd hzU hbad⟩ + · exact (hd hzU hzV).elim + · exact (horiz_ne_vert z w (hz.symm.trans hw)).elim + · exact (horiz_ne_vert w z (hw.symm.trans hz)).elim + · have bzw : z = w := vert_unique z w (hz.symm.trans hw) + subst w + constructor <;> refine ⟨z, Or.inr ⟨?_, ?_⟩⟩ + · exact hz + · rcases hzU with hzU | hzU <;> rcases hwV with hzV | hzV + · exact (hd hzU hzV).elim + · exact Or.inl ⟨hzU, fun hbad => hd hbad hzV⟩ + · exact Or.inr ⟨fun hbad => hd hbad hzV, hzU⟩ + · exact (hd hzU hzV).elim + · exact hz + · rcases hzU with hzU | hzU <;> rcases hwV with hzV | hzV + · exact (hd hzU hzV).elim + · exact Or.inr ⟨fun hbad => hd hzU hbad, hzV⟩ + · exact Or.inl ⟨hzV, fun hbad => hd hzU hbad⟩ + · exact (hd hzU hzV).elim + · rintro ⟨heU, heV⟩ + exact ⟨boundary_footprint U e heU, boundary_footprint V e heV⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean b/LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean new file mode 100644 index 0000000000..0ecef01d1c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean @@ -0,0 +1,503 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: CellDisjointCommonFootprintIncidence] + +/-! +# CellDisjointCommonFootprintIncidence + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CommonFootprintIncidence + +private noncomputable def I : GaussianInt := ⟨0, 1⟩ + +private theorem horiz_unique (x y : GaussianInt) + (h : ({x, x + 1} : Finset GaussianInt) = {y, y + 1}) : x = y := by + classical + have hx : x = y ∨ x = y + 1 := by + have : x ∈ ({y, y + 1} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hy : y = x ∨ y = x + 1 := by + have : y ∈ ({x, x + 1} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hx with hxy | hxy + · exact hxy + rcases hy with hyx | hyx + · exact hyx.symm + · exfalso + have hre := congrArg Zsqrtd.re hxy + have hre' := congrArg Zsqrtd.re hyx + norm_num at hre hre' + omega + +private theorem vert_unique (x y : GaussianInt) + (h : ({x, x + I} : Finset GaussianInt) = {y, y + I}) : x = y := by + classical + let I : GaussianInt := ⟨0, 1⟩ + change ({x, x + I} : Finset GaussianInt) = {y, y + I} at h + have hx : x = y ∨ x = y + I := by + have : x ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hy : y = x ∨ y = x + I := by + have : y ∈ ({x, x + I} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hx with hxy | hxy + · exact hxy + rcases hy with hyx | hyx + · exact hyx.symm + · exfalso + have him := congrArg Zsqrtd.im hxy + have him' := congrArg Zsqrtd.im hyx + simp [I] at him him' + omega + +private theorem horiz_ne_vert (x y : GaussianInt) : + ({x, x + 1} : Finset GaussianInt) ≠ {y, y + I} := by + classical + let I : GaussianInt := ⟨0, 1⟩ + change (({x, x + 1} : Finset GaussianInt) ≠ {y, y + I}) + intro h + have hx : x = y ∨ x = y + I := by + have : x ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hx1 : x + 1 = y ∨ x + 1 = y + I := by + have : x + 1 ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + rcases hx with hx | hx <;> rcases hx1 with hx1 | hx1 + all_goals + have hre := congrArg Zsqrtd.re hx + have him := congrArg Zsqrtd.im hx + have hre1 := congrArg Zsqrtd.re hx1 + have him1 := congrArg Zsqrtd.im hx1 + simp [I] at hre him hre1 him1 + omega + +private theorem footprint_normalize (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges T) : + (∃ z, e = {z, z + 1} ∧ (z ∈ T.cells ∨ z - I ∈ T.cells)) ∨ + (∃ z, e = {z, z + I} ∧ (z ∈ T.cells ∨ z - 1 ∈ T.cells)) := by + classical + let I : GaussianInt := ⟨0, 1⟩ + change ((∃ z, e = {z, z + 1} ∧ (z ∈ T.cells ∨ z - I ∈ T.cells)) ∨ + (∃ z, e = {z, z + I} ∧ (z ∈ T.cells ∨ z - 1 ∈ T.cells))) + rcases he with ⟨x, hx, h | h | h | h⟩ + · exact Or.inl ⟨x, h, Or.inl hx⟩ + · exact Or.inr ⟨x, h, Or.inl hx⟩ + · refine Or.inr ⟨x + 1, h, Or.inr ?_⟩ + simpa [add_sub_cancel_right] using hx + · refine Or.inl ⟨x + I, ?_, Or.inr ?_⟩ + · simpa [I, Zsqrtd.ext_iff, add_comm, add_left_comm, add_assoc] using h + simpa [I, Zsqrtd.ext_iff] using hx + +private theorem boundary_footprint (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) : e ∈ FootprintEdges T := by + classical + let I : GaussianInt := ⟨0, 1⟩ + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [I, Zsqrtd.ext_iff] + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + +private theorem hEdge (U : ProtoTile) (V : ProtoTile) (hdisjoint : Disjoint U.cells V.cells) : + FootprintEdges U ∩ FootprintEdges V = + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V := by + classical + let I : GaussianInt := ⟨0, 1⟩ + have horiz_unique (x y : GaussianInt) + (h : ({x, x + 1} : Finset GaussianInt) = {y, y + 1}) : x = y := horiz_unique x y h + have vert_unique (x y : GaussianInt) + (h : ({x, x + I} : Finset GaussianInt) = {y, y + I}) : x = y := vert_unique x y h + have horiz_ne_vert (x y : GaussianInt) : + ({x, x + 1} : Finset GaussianInt) ≠ {y, y + I} := horiz_ne_vert x y + have footprint_normalize (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges T) : + (∃ z, e = {z, z + 1} ∧ (z ∈ T.cells ∨ z - I ∈ T.cells)) ∨ + (∃ z, e = {z, z + I} ∧ (z ∈ T.cells ∨ z - 1 ∈ T.cells)) := footprint_normalize T e he + have boundary_footprint (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) : e ∈ FootprintEdges T := boundary_footprint T e he + as_aux_lemma => + ext e + constructor + · rintro ⟨heU, heV⟩ + have hd := Finset.disjoint_left.mp hdisjoint + rcases footprint_normalize U e heU with ⟨z, hz, hzU⟩ | ⟨z, hz, hzU⟩ <;> + rcases footprint_normalize V e heV with ⟨w, hw, hwV⟩ | ⟨w, hw, hwV⟩ + · have bzw : z = w := horiz_unique z w (hz.symm.trans hw) + subst w + constructor <;> refine ⟨z, Or.inl ⟨?_, ?_⟩⟩ + · exact hz + · rcases hzU with hzU | hzU <;> rcases hwV with hzV | hzV + · exact (hd hzU hzV).elim + · exact Or.inl ⟨hzU, fun hbad => hd hbad hzV⟩ + · exact Or.inr ⟨fun hbad => hd hbad hzV, hzU⟩ + · exact (hd hzU hzV).elim + · exact hz + · rcases hzU with hzU | hzU <;> rcases hwV with hzV | hzV + · exact (hd hzU hzV).elim + · exact Or.inr ⟨fun hbad => hd hzU hbad, hzV⟩ + · exact Or.inl ⟨hzV, fun hbad => hd hzU hbad⟩ + · exact (hd hzU hzV).elim + · exact (horiz_ne_vert z w (hz.symm.trans hw)).elim + · exact (horiz_ne_vert w z (hw.symm.trans hz)).elim + · have bzw : z = w := vert_unique z w (hz.symm.trans hw) + subst w + constructor <;> refine ⟨z, Or.inr ⟨?_, ?_⟩⟩ + · exact hz + · rcases hzU with hzU | hzU <;> rcases hwV with hzV | hzV + · exact (hd hzU hzV).elim + · exact Or.inl ⟨hzU, fun hbad => hd hbad hzV⟩ + · exact Or.inr ⟨fun hbad => hd hbad hzV, hzU⟩ + · exact (hd hzU hzV).elim + · exact hz + · rcases hzU with hzU | hzU <;> rcases hwV with hzV | hzV + · exact (hd hzU hzV).elim + · exact Or.inr ⟨fun hbad => hd hzU hbad, hzV⟩ + · exact Or.inl ⟨hzV, fun hbad => hd hzU hbad⟩ + · exact (hd hzU hzV).elim + · rintro ⟨heU, heV⟩ + exact ⟨boundary_footprint U e heU, boundary_footprint V e heV⟩ + +private noncomputable def toR : GaussianInt → Real × Real := fun z => ((z.re : Int), (z.im : Int)) + +private theorem vertex_realization (T : ProtoTile) (hne : T.cells.Nonempty) + (z : GaussianInt) (hz : z ∈ FootprintVertices T) : + toR z ∈ TileRealization T := by + classical + let toR : GaussianInt → Real × Real := fun z => ((z.re : Int), (z.im : Int)) + change (toR z ∈ TileRealization T) + unfold FootprintVertices at hz + rw [ite_eq_left hne] at hz + rcases hz with ⟨c, hc, h | h | h | h⟩ + all_goals + rw [TileRealization] + refine Set.mem_iUnion.2 ⟨c, Set.mem_iUnion.2 ⟨hc, ?_⟩⟩ + subst z + simp [ClosedSquareRealization, toR, Prod.le_def] + +private theorem edge_vertex_footprint (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges T) (z : GaussianInt) (hz : z ∈ e) : + z ∈ FootprintVertices T := by + classical + rcases he with ⟨c, hc, he⟩ + unfold FootprintVertices + rw [ite_eq_left ⟨c, hc⟩] + rcases he with h | h | h | h <;> subst e + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hz + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ + · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + +private theorem local_cell (z c : GaussianInt) (p : Real × Real) + (hpnear : dist p (toR z) < (1 / 2 : Real)) + (hpsq : p ∈ ClosedSquareRealization c) : + c = z ∨ c = z - 1 ∨ c = z - I ∨ c = z - 1 - I := by + classical + let I : GaussianInt := ⟨0, 1⟩ + let toR : GaussianInt → Real × Real := fun z => ((z.re : Int), (z.im : Int)) + change (c = z ∨ c = z - 1 ∨ c = z - I ∨ c = z - 1 - I) + have hdist1 : |p.1 - (toR z).1| < (1 / 2 : Real) := by + have := lt_of_le_of_lt (le_max_left (dist p.1 (toR z).1) + (dist p.2 (toR z).2)) hpnear + simpa [Prod.dist_eq, Real.dist_eq] using this + have hdist2 : |p.2 - (toR z).2| < (1 / 2 : Real) := by + have := lt_of_le_of_lt (le_max_right (dist p.1 (toR z).1) + (dist p.2 (toR z).2)) hpnear + simpa [Prod.dist_eq, Real.dist_eq] using this + change (((c.re : Int) : Real), ((c.im : Int) : Real)) ≤ p ∧ + p ≤ ((((c.re : Int) : Real) + 1), (((c.im : Int) : Real) + 1)) at hpsq + have hrele : c.re ≤ z.re := by + by_contra hn + have hstep : ((z.re : Int) : Real) + 1 ≤ ((c.re : Int) : Real) := by + exact_mod_cast (show z.re + 1 ≤ c.re by omega) + have habs := (abs_lt.mp hdist1).2 + dsimp [toR] at habs + linarith [hpsq.1.1] + have hrige : z.re - 1 ≤ c.re := by + by_contra hn + have hstep : ((c.re : Int) : Real) + 1 ≤ ((z.re : Int) : Real) - 1 := by + exact_mod_cast (show c.re + 1 ≤ z.re - 1 by omega) + have habs := (abs_lt.mp hdist1).1 + dsimp [toR] at habs + linarith [hpsq.2.1] + have himle : c.im ≤ z.im := by + by_contra hn + have hstep : ((z.im : Int) : Real) + 1 ≤ ((c.im : Int) : Real) := by + exact_mod_cast (show z.im + 1 ≤ c.im by omega) + have habs := (abs_lt.mp hdist2).2 + dsimp [toR] at habs + linarith [hpsq.1.2] + have himge : z.im - 1 ≤ c.im := by + by_contra hn + have hstep : ((c.im : Int) : Real) + 1 ≤ ((z.im : Int) : Real) - 1 := by + exact_mod_cast (show c.im + 1 ≤ z.im - 1 by omega) + have habs := (abs_lt.mp hdist2).1 + dsimp [toR] at habs + linarith [hpsq.2.2] + have hre : c.re = z.re ∨ c.re = z.re - 1 := by omega + have him : c.im = z.im ∨ c.im = z.im - 1 := by omega + rcases hre with hre | hre <;> rcases him with him | him + · left; apply Zsqrtd.ext <;> simp [hre, him] + · right; right; left; apply Zsqrtd.ext <;> simp [I, hre, him] + · right; left; apply Zsqrtd.ext <;> simp [hre, him] + · right; right; right; apply Zsqrtd.ext <;> simp [I, hre, him] + +private theorem hVertex (U : ProtoTile) (V : ProtoTile) (hUne : U.cells.Nonempty) (hVne : + V.cells.Nonempty) (hdisjoint : Disjoint U.cells V.cells) (hconnected : IsConnected + (TileRealization U ∩ TileRealization V)) (hcommon : (FootprintEdges U ∩ FootprintEdges + V).Nonempty) : FootprintVertices U ∩ FootprintVertices V = + CommonFootprintEdgeVertices U V := by + classical + let I : GaussianInt := ⟨0, 1⟩ + let toR : GaussianInt → Real × Real := fun z => ((z.re : Int), (z.im : Int)) + have vertex_realization (T : ProtoTile) (hne : T.cells.Nonempty) + (z : GaussianInt) (hz : z ∈ FootprintVertices T) : + toR z ∈ TileRealization T := vertex_realization T hne z hz + have edge_vertex_footprint (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges T) (z : GaussianInt) (hz : z ∈ e) : + z ∈ FootprintVertices T := edge_vertex_footprint T e he z hz + have local_cell (z c : GaussianInt) (p : Real × Real) + (hpnear : dist p (toR z) < (1 / 2 : Real)) + (hpsq : p ∈ ClosedSquareRealization c) : + c = z ∨ c = z - 1 ∨ c = z - I ∨ c = z - 1 - I := local_cell z c p hpnear hpsq + as_aux_lemma => + apply Set.Subset.antisymm + · rintro z ⟨hzU, hzV⟩ + by_contra hznot + have hd := Finset.disjoint_left.mp hdisjoint + have local_isolation : ∀ p ∈ TileRealization U ∩ TileRealization V, + dist p (toR z) < (1 / 2 : Real) → p = toR z := by + as_aux_lemma => + intro p hp hpnear + simp only [Set.mem_inter_iff, TileRealization, Set.mem_iUnion] at hp + rcases hp.1 with ⟨c, hcU, hpc⟩ + rcases hp.2 with ⟨d, hdV, hpd⟩ + have hcd : c ≠ d := fun h => hd hcU (h ▸ hdV) + rcases local_cell z c p hpnear hpc with hc | hc | hc | hc <;> + rcases local_cell z d p hpnear hpd with hd' | hd' | hd' | hd' + · exact (hcd (hc.trans hd'.symm)).elim + · subst c; subst d + exfalso; apply hznot + refine ⟨{z, z + I}, ⟨⟨z, hcU, Or.inr (Or.inl rfl)⟩, + ⟨z - 1, hdV, Or.inr (Or.inr (Or.inl ?_))⟩⟩, by simp⟩ + simp [I, add_comm] + · subst c; subst d + exfalso; apply hznot + refine ⟨{z, z + 1}, ⟨⟨z, hcU, Or.inl rfl⟩, + ⟨z - I, hdV, Or.inr (Or.inr (Or.inr ?_))⟩⟩, by simp⟩ + simp [I, add_comm, add_left_comm] + · subst c; subst d + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpc hpd + apply Prod.ext <;> dsimp [toR] + · norm_num [I, Zsqrtd.re_sub, Zsqrtd.im_sub] at hpc hpd ⊢; linarith + · norm_num [I, Zsqrtd.re_sub, Zsqrtd.im_sub] at hpc hpd ⊢; linarith + · subst c; subst d + exfalso; apply hznot + refine ⟨{z, z + I}, ⟨⟨z - 1, hcU, Or.inr (Or.inr (Or.inl ?_))⟩, + ⟨z, hdV, Or.inr (Or.inl rfl)⟩⟩, by simp⟩ + simp [I, add_comm] + · exact (hcd (hc.trans hd'.symm)).elim + · subst c; subst d + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpc hpd + apply Prod.ext <;> dsimp [toR] + · norm_num [I, Zsqrtd.re_sub, Zsqrtd.im_sub] at hpc hpd ⊢; linarith + · norm_num [I, Zsqrtd.re_sub, Zsqrtd.im_sub] at hpc hpd ⊢; linarith + · subst c; subst d + exfalso; apply hznot + refine ⟨{z - 1, z}, ⟨⟨z - 1, hcU, Or.inl ?_⟩, + ⟨z - 1 - I, hdV, Or.inr (Or.inr (Or.inr ?_))⟩⟩, by simp⟩ + all_goals simp [I, add_comm, add_left_comm] + · subst c; subst d + exfalso; apply hznot + refine ⟨{z, z + 1}, ⟨⟨z - I, hcU, Or.inr (Or.inr (Or.inr ?_))⟩, + ⟨z, hdV, Or.inl rfl⟩⟩, by simp⟩ + simp [I, add_comm, add_left_comm] + · subst c; subst d + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpc hpd + apply Prod.ext <;> dsimp [toR] + · norm_num [I, Zsqrtd.re_sub, Zsqrtd.im_sub] at hpc hpd ⊢; linarith + · norm_num [I, Zsqrtd.re_sub, Zsqrtd.im_sub] at hpc hpd ⊢; linarith + · exact (hcd (hc.trans hd'.symm)).elim + · subst c; subst d + exfalso; apply hznot + refine ⟨{z - I, z}, ⟨⟨z - I, hcU, Or.inr (Or.inl ?_)⟩, + ⟨z - 1 - I, hdV, Or.inr (Or.inr (Or.inl ?_))⟩⟩, by simp⟩ + all_goals congr 1 + all_goals try simp only [Finset.singleton_inj] + all_goals apply Zsqrtd.ext <;> simp [I] + · subst c; subst d + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpc hpd + apply Prod.ext <;> dsimp [toR] + · norm_num [I, Zsqrtd.re_sub, Zsqrtd.im_sub] at hpc hpd ⊢; linarith + · norm_num [I, Zsqrtd.re_sub, Zsqrtd.im_sub] at hpc hpd ⊢; linarith + · subst c; subst d + exfalso; apply hznot + refine ⟨{z - 1, z}, ⟨⟨z - 1 - I, hcU, Or.inr (Or.inr (Or.inr ?_))⟩, + ⟨z - 1, hdV, Or.inl ?_⟩⟩, by simp⟩ + all_goals congr 1 + all_goals try simp only [Finset.singleton_inj] + all_goals apply Zsqrtd.ext <;> simp [I] + · subst c; subst d + exfalso; apply hznot + refine ⟨{z - I, z}, ⟨⟨z - 1 - I, hcU, Or.inr (Or.inr (Or.inl ?_))⟩, + ⟨z - I, hdV, Or.inr (Or.inl ?_)⟩⟩, by simp⟩ + all_goals congr 1 + all_goals try simp only [Finset.singleton_inj] + all_goals apply Zsqrtd.ext <;> simp [I] + · exact (hcd (hc.trans hd'.symm)).elim + let K := TileRealization U ∩ TileRealization V + let A : Set (Real × Real) := {toR z} + let B : Set (Real × Real) := {p | (1 / 2 : Real) ≤ dist p (toR z)} + have hAclosed : IsClosed A := isClosed_singleton + have hBclosed : IsClosed B := by + change IsClosed ((fun p : Real × Real => dist p (toR z)) ⁻¹' Set.Ici (1 / 2 : Real)) + exact isClosed_Ici.preimage (continuous_id.dist continuous_const) + have hcover : K ⊆ A ∪ B := by + intro p hp + by_cases hnear : dist p (toR z) < (1 / 2 : Real) + · left; simpa [A] using local_isolation p hp hnear + · right; exact le_of_not_gt hnear + have hsep : K ∩ (A ∩ B) = ∅ := by + rw [Set.eq_empty_iff_forall_notMem] + intro p hp + have hpz : p = toR z := by simpa [A] using hp.2.1 + subst p + have hbad : (1 / 2 : Real) ≤ dist (toR z) (toR z) := hp.2.2 + rw [dist_self] at hbad + norm_num at hbad + have hzK : toR z ∈ K := ⟨vertex_realization U hUne z hzU, + vertex_realization V hVne z hzV⟩ + rcases hcommon with ⟨e, heU, heV⟩ + have htwo : ∃ y ∈ e, y ≠ z := by + rcases heU with ⟨c, hc, rfl | rfl | rfl | rfl⟩ + · by_cases h : c = z + · refine ⟨c + 1, by simp, ?_⟩ + intro hh; have := congrArg Zsqrtd.re hh; simp [h] at this + · exact ⟨c, by simp, h⟩ + · by_cases h : c = z + · refine ⟨c + I, by simp [I], ?_⟩ + intro hh; have := congrArg Zsqrtd.im hh; simp [h, I] at this + · exact ⟨c, by simp, h⟩ + · by_cases h : c + 1 = z + · refine ⟨c + 1 + I, by simp [I], ?_⟩ + intro hh; have := congrArg Zsqrtd.im hh; simp [h, I] at this + · exact ⟨c + 1, by simp, h⟩ + · by_cases h : c + I = z + · refine ⟨c + 1 + I, by simp [I], ?_⟩ + intro hh + have h1 := congrArg Zsqrtd.re h + have h2 := congrArg Zsqrtd.re hh + simp [I] at h1 h2 + omega + · exact ⟨c + I, by simp [I], h⟩ + rcases htwo with ⟨y, hye, hyz⟩ + have hyUfp := edge_vertex_footprint U e heU y hye + have hyVfp := edge_vertex_footprint V e heV y hye + have hyK : toR y ∈ K := ⟨vertex_realization U hUne y hyUfp, + vertex_realization V hVne y hyVfp⟩ + have hyRne : toR y ≠ toR z := by + intro h + apply hyz + apply Zsqrtd.ext + · have h' := congrArg Prod.fst h + dsimp [toR] at h' + exact_mod_cast h' + · have h' := congrArg Prod.snd h + dsimp [toR] at h' + exact_mod_cast h' + rcases (isPreconnected_iff_subset_of_disjoint_closed.mp hconnected.isPreconnected + A B hAclosed hBclosed hcover hsep) with hKA | hKB + · exact hyRne (by simpa [A] using hKA hyK) + · have : (1 / 2 : Real) ≤ 0 := by simpa [B] using hKB hzK + norm_num at this + · rintro z ⟨e, ⟨heU, heV⟩, hze⟩ + exact ⟨edge_vertex_footprint U e heU z hze, + edge_vertex_footprint V e heV z hze⟩ + +end CommonFootprintIncidence + +theorem CellDisjointCommonFootprintIncidence (U V : ProtoTile) + (hUne : U.cells.Nonempty) (hVne : V.cells.Nonempty) + (hdisjoint : Disjoint U.cells V.cells) + (hconnected : IsConnected + (TileRealization U ∩ TileRealization V)) + (hcommon : + (FootprintEdges U ∩ FootprintEdges V).Nonempty) : + FootprintEdges U ∩ FootprintEdges V = + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V ∧ + FootprintVertices U ∩ FootprintVertices V = + CommonFootprintEdgeVertices U V ∧ + BoundaryFootprintVertices U ∩ BoundaryFootprintVertices V = + CommonFootprintEdgeVertices U V := by +-- BODY + classical + have boundary_footprint (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) : e ∈ FootprintEdges T := + CommonFootprintIncidence.boundary_footprint T e he + have hEdge : FootprintEdges U ∩ FootprintEdges V = + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V := CommonFootprintIncidence.hEdge U V + hdisjoint + have edge_vertex_footprint (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges T) (z : GaussianInt) (hz : z ∈ e) : + z ∈ FootprintVertices T := CommonFootprintIncidence.edge_vertex_footprint T e he z hz + have hVertex : FootprintVertices U ∩ FootprintVertices V = + CommonFootprintEdgeVertices U V := CommonFootprintIncidence.hVertex U V hUne hVne hdisjoint + hconnected hcommon + refine ⟨hEdge, hVertex, ?_⟩ + apply Set.Subset.antisymm + · rintro z ⟨hzU, hzV⟩ + have boundary_vertex_footprint (T : ProtoTile) (hne : T.cells.Nonempty) + (hz : z ∈ BoundaryFootprintVertices T) : z ∈ FootprintVertices T := by + unfold BoundaryFootprintVertices at hz + rw [ite_eq_left hne] at hz + rcases hz with ⟨e, he, hze⟩ + exact edge_vertex_footprint T e (boundary_footprint T e he) z hze + rw [← hVertex] + exact ⟨boundary_vertex_footprint U hUne hzU, + boundary_vertex_footprint V hVne hzV⟩ + · rintro z ⟨e, he, hze⟩ + have heBoundary : e ∈ BoundaryFootprintEdges U ∩ + BoundaryFootprintEdges V := hEdge ▸ he + constructor + · unfold BoundaryFootprintVertices + rw [ite_eq_left hUne] + exact ⟨e, heBoundary.1, hze⟩ + · unfold BoundaryFootprintVertices + rw [ite_eq_left hVne] + exact ⟨e, heBoundary.2, hze⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CellSupportedFootprintVertices.lean b/LeanPool/ApollonianSuperharmonic/CellSupportedFootprintVertices.lean new file mode 100644 index 0000000000..e2ef03fe27 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CellSupportedFootprintVertices.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: CellSupportedFootprintVertices] + +/-! +# CellSupportedFootprintVertices + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The cell-supported footprint vertices of a prototile $T$ are the lattice +vertices that occur as one of the four corners of an actual constituent +cell of $T$. Thus this set agrees with the usual footprint vertex set when +$T$ has a cell, but it is empty when $T$ has no cells; in particular it does +not include the stored anchor of an empty prototile. +-/ +def CellSupportedFootprintVertices (T : ProtoTile) : Set GaussianInt := +-- BODY + {v | ∃ x ∈ T.cells, + v = x ∨ v = x + 1 ∨ v = x + ⟨0, 1⟩ ∨ + v = x + 1 + ⟨0, 1⟩} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CentrallyReflectedAt.lean b/LeanPool/ApollonianSuperharmonic/CentrallyReflectedAt.lean new file mode 100644 index 0000000000..380a21d74e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CentrallyReflectedAt.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: CentrallyReflectedAt] + +/-! +# CentrallyReflectedAt + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Two prototiles $T,U$ are centrally reflected about a point $x$ when +half-turn about $x$ carries the complete closed-square realization of $T$ +onto that of $U$: +$$ + I(U)=\{\,2x-p:p\in I(T)\,\}. +$$ +This relation concerns supporting cells and their edges, not only the sets +of footprint vertices. +-/ +def CentrallyReflectedAt (x : Real × Real) (T U : ProtoTile) : Prop := +-- BODY + TileRealization U = + (fun p : Real × Real => (2 * x.1 - p.1, 2 * x.2 - p.2)) '' + TileRealization T + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CircleCoordinates.lean b/LeanPool/ApollonianSuperharmonic/CircleCoordinates.lean new file mode 100644 index 0000000000..79050d653a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CircleCoordinates.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: CircleCoordinates] + +/-! +# CircleCoordinates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A raw integral curvature-coordinate pair is an element +$C=(c,w)\in\mathbb Z\times\mathbb Z[i]$. This is only a coordinate carrier: +no sign, tangency, circle, or unit-normal condition is imposed. Equality is +componentwise equality of the two coordinates. +-/ +abbrev CircleCoordinates : Type := +-- BODY + ℤ × GaussianInt + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CircleMatrix.lean b/LeanPool/ApollonianSuperharmonic/CircleMatrix.lean new file mode 100644 index 0000000000..52834ee760 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CircleMatrix.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData + +-- [TABLET NODE: CircleMatrix] + +/-! +# CircleMatrix + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a positive-curvature band circle $C$, let +$E=(z,r)=\operatorname{circ}(C)$ be its Euclidean circle datum from +`BandCircleEuclideanData`, and write $z=x_1+ix_2$. Define +$$ + A_C=\frac12 + \begin{pmatrix}r+x_1&x_2\\ x_2&r-x_1\end{pmatrix}. +$$ +No matrix is assigned to a curvature-zero line. +-/ +noncomputable def CircleMatrix (C : BandCircle) : Matrix (Fin 2) (Fin 2) ℝ := +-- BODY + let E := BandCircleEuclideanData C + (2 : ℝ)⁻¹ • + ![![E.radius + E.center.re, E.center.im], + ![E.center.im, E.radius - E.center.re]] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CircleMatrixEnclosureCriterion.lean b/LeanPool/ApollonianSuperharmonic/CircleMatrixEnclosureCriterion.lean new file mode 100644 index 0000000000..0b23d98664 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CircleMatrixEnclosureCriterion.lean @@ -0,0 +1,192 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5630T1SymmetricMatrixPositivityCriterion +public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.SymmetricMatrixCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.SymmetricMatrixCoordinates + +-- [TABLET NODE: CircleMatrixEnclosureCriterion] + +/-! +# CircleMatrixEnclosureCriterion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem CircleMatrixEnclosureCriterion + (A : Matrix (Fin 2) (Fin 2) Real) (hA : A.IsSymm) + (C : BandCircle) : + (((CircleMatrix C - A).PosSemidef) ↔ + dist (SymmetricMatrixCoordinates A).1 + (BandCircleEuclideanData C).center + + (SymmetricMatrixCoordinates A).2 ≤ + (BandCircleEuclideanData C).radius) ∧ + (((A - CircleMatrix C).PosDef) ↔ + dist (SymmetricMatrixCoordinates A).1 + (BandCircleEuclideanData C).center + + (BandCircleEuclideanData C).radius < + (SymmetricMatrixCoordinates A).2) := by +-- BODY + have hCircleCoordinates : + (CircleMatrix C).IsSymm ∧ + SymmetricMatrixCoordinates (CircleMatrix C) = + ((BandCircleEuclideanData C).center, + (BandCircleEuclideanData C).radius) := by + have hc : (C.1.1.1 : Real) ≠ 0 := by + exact_mod_cast (ne_of_gt C.2) + constructor + · apply Matrix.IsSymm.ext + intro i j + fin_cases i <;> fin_cases j <;> simp [CircleMatrix] + · apply Prod.ext + · apply Complex.ext <;> + simp [SymmetricMatrixCoordinates, CircleMatrix, + BandCircleEuclideanData]; field_simp; ring + · change Matrix.trace (CircleMatrix C) = 1 / (C.1.1.1 : Real) + rw [Matrix.trace_fin_two] + simp [CircleMatrix, BandCircleEuclideanData] + field_simp + ring + have pscale (N : Matrix (Fin 2) (Fin 2) Real) : + (((2 : Real)⁻¹) • N).PosSemidef ↔ N.PosSemidef := by + constructor + · intro h + rw [Matrix.posSemidef_iff_dotProduct_mulVec] at h ⊢ + refine ⟨?_, ?_⟩ + · simpa [Matrix.smul_apply] using h.1 + · intro z + have hz := h.2 z + simp [Matrix.mulVec, Matrix.smul_apply, dotProduct] at hz ⊢ + nlinarith [hz] + · intro h + rw [Matrix.posSemidef_iff_dotProduct_mulVec] at h ⊢ + refine ⟨?_, ?_⟩ + · simpa [Matrix.smul_apply] using h.1 + · intro z + have hz := h.2 z + simp [Matrix.mulVec, Matrix.smul_apply, dotProduct] at hz ⊢ + nlinarith [hz] + have dscale (N : Matrix (Fin 2) (Fin 2) Real) : + (((2 : Real)⁻¹) • N).PosDef ↔ N.PosDef := by + constructor + · intro h + rw [Matrix.posDef_iff_dotProduct_mulVec] at h ⊢ + refine ⟨?_, ?_⟩ + · simpa [Matrix.smul_apply] using h.1 + · intro z hz + have hz' := h.2 hz + simp [Matrix.mulVec, Matrix.smul_apply, dotProduct] at hz' ⊢ + nlinarith [hz'] + · intro h + rw [Matrix.posDef_iff_dotProduct_mulVec] at h ⊢ + refine ⟨?_, ?_⟩ + · simpa [Matrix.smul_apply] using h.1 + · intro z hz + have hz' := h.2 hz + simp [Matrix.mulVec, Matrix.smul_apply, dotProduct] at hz' ⊢ + nlinarith [hz'] + have circleIdentity : + CircleMatrix C = (2 : Real)⁻¹ • + ((![![((BandCircleEuclideanData C).radius + + (BandCircleEuclideanData C).center.re), + (BandCircleEuclideanData C).center.im], + ![(BandCircleEuclideanData C).center.im, + (BandCircleEuclideanData C).radius - + (BandCircleEuclideanData C).center.re]]) : + Matrix (Fin 2) (Fin 2) Real) := by + simpa [hCircleCoordinates.2] using + (SymmetricMatrixCoordinateIdentity (CircleMatrix C) + hCircleCoordinates.1) + let x := SymmetricMatrixCoordinates A + let e := BandCircleEuclideanData C + have entrySub (P Q : Matrix (Fin 2) (Fin 2) Real) (i j : Fin 2) : + (P - Q) i j = P i j - Q i j := by rfl + have entrySmul (a : Real) (P : Matrix (Fin 2) (Fin 2) Real) (i j : Fin 2) : + (a • P) i j = a * P i j := by rfl + have hminus : + CircleMatrix C - A = (2 : Real)⁻¹ • + ((![![e.radius - x.2 + (e.center - x.1).re, + (e.center - x.1).im], + ![(e.center - x.1).im, + e.radius - x.2 - (e.center - x.1).re]]) : Matrix (Fin 2) (Fin 2) Real) := by + rw [circleIdentity, SymmetricMatrixCoordinateIdentity A hA] + dsimp [x, e] + ext i j + fin_cases i <;> fin_cases j + all_goals change ((2 : Real)⁻¹ * _ - (2 : Real)⁻¹ * _) = (2 : Real)⁻¹ * _ + all_goals norm_num [Pi.sub_apply, Pi.smul_apply, sub_eq_add_neg]; ring_nf + have hplus : + A - CircleMatrix C = (2 : Real)⁻¹ • + ((![![x.2 - e.radius + (x.1 - e.center).re, + (x.1 - e.center).im], + ![(x.1 - e.center).im, + x.2 - e.radius - (x.1 - e.center).re]]) : Matrix (Fin 2) (Fin 2) Real) := by + rw [SymmetricMatrixCoordinateIdentity A hA, circleIdentity] + dsimp [x, e] + ext i j + fin_cases i <;> fin_cases j + all_goals change ((2 : Real)⁻¹ * _ - (2 : Real)⁻¹ * _) = (2 : Real)⁻¹ * _ + all_goals norm_num [Pi.sub_apply, Pi.smul_apply, sub_eq_add_neg]; ring_nf + have hnorm : + Real.sqrt (((e.center - x.1).re) ^ 2 + ((e.center - x.1).im) ^ 2) = + dist x.1 e.center := by + rw [Complex.dist_eq, Complex.norm_def, Complex.normSq_apply] + simp only [Complex.sub_re, Complex.sub_im] + congr 1; ring_nf + have hcrit := P5630T1SymmetricMatrixPositivityCriterion + (e.radius - x.2) (e.center - x.1).re (e.center - x.1).im + have hcrit' := P5630T1SymmetricMatrixPositivityCriterion + (x.2 - e.radius) (x.1 - e.center).re (x.1 - e.center).im + let Nminus : Matrix (Fin 2) (Fin 2) Real := + ![![e.radius - x.2 + (e.center - x.1).re, (e.center - x.1).im], + ![(e.center - x.1).im, e.radius - x.2 - (e.center - x.1).re]] + let Nplus : Matrix (Fin 2) (Fin 2) Real := + ![![x.2 - e.radius + (x.1 - e.center).re, (x.1 - e.center).im], + ![(x.1 - e.center).im, x.2 - e.radius - (x.1 - e.center).re]] + have hcminus : Nminus.PosSemidef ↔ + Real.sqrt (((e.center - x.1).re) ^ 2 + ((e.center - x.1).im) ^ 2) ≤ + e.radius - x.2 := by + simpa [Nminus] using hcrit.1 + have hcplus : Nplus.PosDef ↔ + Real.sqrt (((x.1 - e.center).re) ^ 2 + ((x.1 - e.center).im) ^ 2) < + x.2 - e.radius := by + simpa [Nplus] using hcrit'.2 + constructor + · rw [hminus] + change (((2 : Real)⁻¹) • Nminus).PosSemidef ↔ _ + rw [pscale Nminus] + rw [← hnorm] + constructor <;> intro hh + · have ht := hcminus.mp hh + linarith + · apply hcminus.mpr + linarith + · rw [hplus] + change (((2 : Real)⁻¹) • Nplus).PosDef ↔ _ + rw [dscale Nplus] + have hnorm' : + Real.sqrt (((x.1 - e.center).re) ^ 2 + ((x.1 - e.center).im) ^ 2) = + dist x.1 e.center := by + rw [Complex.dist_eq, Complex.norm_def, Complex.normSq_apply] + congr 1; ring_nf + rw [← hnorm'] + constructor <;> intro hh + · have ht := hcplus.mp hh + linarith + · apply hcplus.mpr + linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CircleMatrixIncomingVector.lean b/LeanPool/ApollonianSuperharmonic/CircleMatrixIncomingVector.lean new file mode 100644 index 0000000000..2ff286eaf9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CircleMatrixIncomingVector.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing +public import LeanPool.ApollonianSuperharmonic.CircleMatrix + +-- [TABLET NODE: CircleMatrixIncomingVector] + +/-! +# CircleMatrixIncomingVector + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem CircleMatrixIncomingVector (C : BandCircle) + (q : Fin 4 → CircleCoordinates) (hq : SemiProperQuadruple q) + (hchild : q 0 = C.1.1) (j : Fin 3) : + Matrix.mulVec (CircleMatrix C) + ![((BandVectors.1 (q j.succ) (q 0)).re : ℝ), + ((BandVectors.1 (q j.succ) (q 0)).im : ℝ)] = + ![((BandVectors.2 (q j.succ) (q 0)).re : ℝ), + ((BandVectors.2 (q j.succ) (q 0)).im : ℝ)] := by +-- BODY + have hmatrix : + CircleMatrix C = + let c : ℝ := C.1.1.1 + let x : ℝ := C.1.1.2.re + let y : ℝ := C.1.1.2.im + (2 * c)⁻¹ • ![![1 + x, y], ![y, 1 - x]] := by + ext i j + fin_cases i <;> fin_cases j <;> + simp [CircleMatrix, BandCircleEuclideanData] + all_goals field_simp + have hidx : j.succ ≠ (0 : Fin 4) := by + intro h + have := congr_arg Fin.val h + simp at this + have hpos : 0 < (q 0).1 := by + rw [hchild] + exact C.2 + have hv : BandVectors.1 (q j.succ) (q 0) ≠ 0 := + VectorNonvanishing q hq j.succ 0 hidx (Or.inr hpos) + have hident := VectorSquareProduct q hq j.succ 0 hidx + have htan := TangencyCoordinateIdentity q hq j.succ 0 hidx + have hnorm : Zsqrtd.norm (BandVectors.1 (q j.succ) (q 0)) = + (q j.succ).1 + (q 0).1 := by + have hs : Zsqrtd.norm (BandVectors.1 (q j.succ) (q 0)) ^ 2 = + ((q j.succ).1 + (q 0).1) ^ 2 := by + calc + Zsqrtd.norm (BandVectors.1 (q j.succ) (q 0)) ^ 2 = + Zsqrtd.norm (BandVectors.1 (q j.succ) (q 0) ^ 2) := by + simp [pow_two] + _ = Zsqrtd.norm ((q 0).1 • (q j.succ).2 - + (q j.succ).1 • (q 0).2) := by rw [hident.1] + _ = ((q j.succ).1 + (q 0).1) ^ 2 := htan + have hn := GaussianInt.norm_nonneg (BandVectors.1 (q j.succ) (q 0)) + have nonnegative : ∀ r : Fin 4 → CircleCoordinates, + SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 := by + intro r hr + induction hr with + | base z => + intro k + fin_cases k <;> simp + | rotate hr ih => + intro k + fin_cases k + · simpa using ih 0 + · simpa using ih 2 + · simpa using ih 3 + · simpa using ih 1 + | @successor r hr ih => + intro k + have classification := BandSuccessorClassification r hr + dsimp at classification + rcases classification with special | proper + · fin_cases k + · simp [special] + · simpa using ih 0 + · simpa using ih 2 + · simpa using ih 3 + · rcases proper with ⟨_, larger0, larger2, larger3⟩ + fin_cases k + · change 0 ≤ 2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1 + exact (ih 0).trans larger0.le + · exact ih 0 + · exact ih 2 + · exact ih 3 + have hc : 0 ≤ (q j.succ).1 + (q 0).1 := by + exact add_nonneg (nonnegative q hq j.succ) (nonnegative q hq 0) + nlinarith + have hgauss : + BandVectors.1 (q j.succ) (q 0) + + (q 0).2 * star (BandVectors.1 (q j.succ) (q 0)) = + (2 : GaussianInt) * (q 0).1 * BandVectors.2 (q j.succ) (q 0) := by + apply (mul_left_cancel₀ hv) + calc + BandVectors.1 (q j.succ) (q 0) * + (BandVectors.1 (q j.succ) (q 0) + + (q 0).2 * star (BandVectors.1 (q j.succ) (q 0))) = + BandVectors.1 (q j.succ) (q 0) ^ 2 + + (q 0).2 * (BandVectors.1 (q j.succ) (q 0) * + star (BandVectors.1 (q j.succ) (q 0))) := by ring + _ = (q 0).1 * ((q j.succ).2 + (q 0).2) := by + rw [← Zsqrtd.norm_eq_mul_conj, hnorm, hident.1] + push_cast + ring + _ = BandVectors.1 (q j.succ) (q 0) * + ((2 : GaussianInt) * (q 0).1 * BandVectors.2 (q j.succ) (q 0)) := by + rw [← hident.2] + ring + have hre := congr_arg Zsqrtd.re hgauss + have him := congr_arg Zsqrtd.im hgauss + simp? at hre him + rw [hchild] at hre him + have hrer : + ((BandVectors.1 (q j.succ) (C.1.1)).re : ℝ) + + ((C.1.1.2.re : ℝ) * (BandVectors.1 (q j.succ) (C.1.1)).re + + (C.1.1.2.im : ℝ) * (BandVectors.1 (q j.succ) (C.1.1)).im) = + 2 * (C.1.1.1 : ℝ) * (BandVectors.2 (q j.succ) (C.1.1)).re := by + exact_mod_cast hre + have himr : + ((BandVectors.1 (q j.succ) (C.1.1)).im : ℝ) + + (-((C.1.1.2.re : ℝ) * (BandVectors.1 (q j.succ) (C.1.1)).im) + + (C.1.1.2.im : ℝ) * (BandVectors.1 (q j.succ) (C.1.1)).re) = + 2 * (C.1.1.1 : ℝ) * (BandVectors.2 (q j.succ) (C.1.1)).im := by + exact_mod_cast him + have hcurv : 0 < (C.1.1.1 : ℝ) := by exact_mod_cast C.2 + rw [hmatrix] + dsimp + ext k + fin_cases k + · simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, + Matrix.vecCons, Matrix.vecEmpty, Fin.cons, Fin.cases, Fin.induction, + Fin.induction.go, hchild, -GaussianInt.intCast_re, + -GaussianInt.intCast_im] + field_simp [ne_of_gt hcurv] + nlinarith [hrer] + · simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, + Matrix.vecCons, Matrix.vecEmpty, Fin.cons, Fin.cases, Fin.induction, + Fin.induction.go, hchild, -GaussianInt.intCast_re, + -GaussianInt.intCast_im] + field_simp [ne_of_gt hcurv] + nlinarith [himr] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ClosedSquareRealization.lean b/LeanPool/ApollonianSuperharmonic/ClosedSquareRealization.lean new file mode 100644 index 0000000000..912678468e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ClosedSquareRealization.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeCell + +-- [TABLET NODE: ClosedSquareRealization] + +/-! +# ClosedSquareRealization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For the cell $s_x$, its closed-square realization is +$$ + \overline s_x=[\Re x,\Re x+1]\times[\Im x,\Im x+1]\subset\mathbb R^2. +$$ +In particular, adjacent cells retain their common boundary in the real +realization. +-/ +def ClosedSquareRealization (x : LatticeCell) : Set (Real × Real) := +-- BODY + Set.Icc ((((x.re : Int) : Real)), (((x.im : Int) : Real))) + (((((x.re : Int) : Real)) + 1), ((((x.im : Int) : Real)) + 1)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CommonFootprintEdgeVertices.lean b/LeanPool/ApollonianSuperharmonic/CommonFootprintEdgeVertices.lean new file mode 100644 index 0000000000..5401621883 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CommonFootprintEdgeVertices.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FootprintEdges + +-- [TABLET NODE: CommonFootprintEdgeVertices] + +/-! +# CommonFootprintEdgeVertices + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For prototiles $T$ and $U$, the common-footprint-edge vertex set is the set +of all endpoints of actual edges in +$E(T)\cap E(U)$, where $E$ is `FootprintEdges`. Thus +$$ + V_E(T,U)=\{x:\text{ for some }e\in E(T)\cap E(U),\ x\in e\}. +$$ +In particular, an isolated vertex in $\operatorname{foot}(T)\cap\operatorname{foot}(U)$ does not +belong +to this set unless it is also an endpoint of a common footprint edge. +-/ +def CommonFootprintEdgeVertices (T U : ProtoTile) : Set GaussianInt := +-- BODY + {x | ∃ e ∈ FootprintEdges T ∩ FootprintEdges U, x ∈ e} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ConnectedCommonBoundaryPath.lean b/LeanPool/ApollonianSuperharmonic/ConnectedCommonBoundaryPath.lean new file mode 100644 index 0000000000..748997c83f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ConnectedCommonBoundaryPath.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonFootprintIncidence +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices +public import LeanPool.ApollonianSuperharmonic.ConnectedGridEdgeCarrierGraph +public import LeanPool.ApollonianSuperharmonic.DisjointBoundaryCommonEdgeGraphAcyclic +public import LeanPool.ApollonianSuperharmonic.DisjointSquareUnionCommonEdgeCarrier +public import LeanPool.ApollonianSuperharmonic.FiniteConnectedAcyclicDegreeTwoGridPath +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycleSubgraphDegreeTwo +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: ConnectedCommonBoundaryPath] + +/-! +# ConnectedCommonBoundaryPath + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem ConnectedCommonBoundaryPath (U V : ProtoTile) + (hUne : U.cells.Nonempty) (hVne : V.cells.Nonempty) + (hdisjoint : Disjoint U.cells V.cells) + (hconnected : IsConnected + (TileRealization U ∩ TileRealization V)) + (hUcycle : SimpleGridCycle (BoundaryFootprintVertices U) + (BoundaryFootprintEdges U)) + (hVcycle : SimpleGridCycle (BoundaryFootprintVertices V) + (BoundaryFootprintEdges V)) + (hcommon : + (FootprintEdges U ∩ FootprintEdges V).Nonempty) : + ∃ x y : GaussianInt, + SimpleGridPathBetween + (CommonFootprintEdgeVertices U V) + (FootprintEdges U ∩ FootprintEdges V) x y := by +-- BODY + classical + obtain ⟨hedges, hvertices, hboundaryVertices⟩ := + CellDisjointCommonFootprintIncidence U V hUne hVne hdisjoint + hconnected hcommon + obtain ⟨hEfinite, hcarrier⟩ := + DisjointSquareUnionCommonEdgeCarrier U V hdisjoint hvertices + let E : Set (Finset GaussianInt) := FootprintEdges U ∩ FootprintEdges V + let X : Set GaussianInt := CommonFootprintEdgeVertices U V + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + have hgrid : ∀ e ∈ E, ∃ a b : GaussianInt, + e = {a, b} ∧ FourNeighborAdjacent a b := by + intro e he + rcases he.1 with ⟨c, hc, he | he | he | he⟩ + · exact ⟨c, c + 1, he, Or.inl rfl⟩ + · exact ⟨c, c + ⟨0, 1⟩, he, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨c + 1, c + 1 + ⟨0, 1⟩, he, + Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩, he, Or.inl (by + apply Zsqrtd.ext <;> simp)⟩ + have hgraphConnected : G.Connected := by + apply ConnectedGridEdgeCarrierGraph E hEfinite hgrid + simpa [E] using hcarrier ▸ hconnected + have hXU : X ⊆ BoundaryFootprintVertices U := by + intro x hx + have hx' : x ∈ CommonFootprintEdgeVertices U V := hx + have hx'' : x ∈ BoundaryFootprintVertices U ∩ + BoundaryFootprintVertices V := by + rw [hboundaryVertices] + exact hx' + exact hx''.1 + have hEU : E ⊆ BoundaryFootprintEdges U := by + intro e he + have : e ∈ BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V := + hedges ▸ he + exact this.1 + have hendpoints : X = {x | ∃ e ∈ E, x ∈ e} := by + rfl + have hdegree : ∀ v : X, Set.ncard (G.neighborSet v) ≤ 2 := by + exact SimpleGridCycleSubgraphDegreeTwo X (BoundaryFootprintVertices U) + E (BoundaryFootprintEdges U) hUcycle hXU hEU + have hacyclic : G.IsAcyclic := by + exact DisjointBoundaryCommonEdgeGraphAcyclic U V hdisjoint hUcycle hVcycle + hcommon hedges + exact FiniteConnectedAcyclicDegreeTwoGridPath X E hEfinite hcommon + hendpoints hgrid hgraphConnected hacyclic hdegree + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierGraph.lean b/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierGraph.lean new file mode 100644 index 0000000000..65e13ee729 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierGraph.lean @@ -0,0 +1,565 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Combinatorics.SimpleGraph.Matching +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.GridEdgeCarrier + +-- [TABLET NODE: ConnectedGridEdgeCarrierGraph] + +/-! +# ConnectedGridEdgeCarrierGraph + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ConnectedEdgeGraph + +private noncomputable def X (E : Set (Finset GaussianInt)) : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + +private noncomputable def G (E : Set (Finset GaussianInt)) : SimpleGraph (X E) := + SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + +private noncomputable def J : GaussianInt := ⟨0, 1⟩ + +private theorem carrier_pair (a b : GaussianInt) : + GridEdgeCarrier ({a, b} : Finset GaussianInt) = + Set.uIcc (GaussianRealPoint a) (GaussianRealPoint b) := by + classical + unfold GridEdgeCarrier + simp [Set.uIcc_comm] + +private theorem canonical (E : Set (Finset GaussianInt)) (hgrid : ∀ e ∈ E, ∃ a b : GaussianInt, e + = {a, b} ∧ FourNeighborAdjacent a b) (e : Finset GaussianInt) (he : e ∈ E) : + ∃ a : GaussianInt, e = {a, a + 1} ∨ e = {a, a + J} := by + classical + let J : GaussianInt := ⟨0, 1⟩ + change (∃ a : GaussianInt, e = {a, a + 1} ∨ e = {a, a + J}) + rcases hgrid e he with ⟨a, b, rfl, hab⟩ + rcases hab with rfl | rfl | rfl | rfl + · exact ⟨a, Or.inl rfl⟩ + · refine ⟨a - 1, Or.inl ?_⟩ + have h : a - 1 + 1 = a := by ring + rw [h, Finset.pair_comm] + · exact ⟨a, Or.inr rfl⟩ + · refine ⟨a - J, Or.inr ?_⟩ + have h : a - J + J = a := by ring + rw [h, Finset.pair_comm] + +private theorem point_of_common {e f : Finset GaussianInt} {z : GaussianInt} + (hze : z ∈ e) (hzf : z ∈ f) : + (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty := by + classical + refine ⟨GaussianRealPoint z, ?_, ?_⟩ + · unfold GridEdgeCarrier + exact Set.mem_iUnion.2 ⟨z, Set.mem_iUnion.2 ⟨hze, + Set.mem_iUnion.2 ⟨z, Set.mem_iUnion.2 ⟨hze, by simp⟩⟩⟩⟩ + · unfold GridEdgeCarrier + exact Set.mem_iUnion.2 ⟨z, Set.mem_iUnion.2 ⟨hzf, + Set.mem_iUnion.2 ⟨z, Set.mem_iUnion.2 ⟨hzf, by simp⟩⟩⟩⟩ + +private theorem horizontal_inter (a c : GaussianInt) : + (GridEdgeCarrier ({a, a + 1} : Finset GaussianInt) ∩ + GridEdgeCarrier ({c, c + 1} : Finset GaussianInt)).Nonempty → + ∃ z, z ∈ ({a, a + 1} : Finset GaussianInt) ∧ + z ∈ ({c, c + 1} : Finset GaussianInt) := by + classical + have carrier_pair (a b : GaussianInt) : + GridEdgeCarrier ({a, b} : Finset GaussianInt) = + Set.uIcc (GaussianRealPoint a) (GaussianRealPoint b) := carrier_pair a b + rintro ⟨⟨x, y⟩, hx, hy⟩ + rw [carrier_pair] at hx hy + simp? [Set.uIcc, GaussianRealPoint] at hx hy + rw [← GaussianInt.intCast_re a, ← GaussianInt.intCast_im a] at hx + rw [← GaussianInt.intCast_re c, ← GaussianInt.intCast_im c] at hy + have him : a.im = c.im := by + have himR : ((a.im : Int) : Real) = ((c.im : Int) : Real) := by + linarith [hx.1.2, hx.2.2, hy.1.2, hy.2.2] + exact_mod_cast himR + have hac : a.re ≤ c.re + 1 := by + have hacR : ((a.re : Int) : Real) ≤ ((c.re : Int) : Real) + 1 := by + linarith [hx.1.1, hx.2.1, hy.1.1, hy.2.1] + exact_mod_cast hacR + have hca : c.re ≤ a.re + 1 := by + have hcaR : ((c.re : Int) : Real) ≤ ((a.re : Int) : Real) + 1 := by + linarith [hx.1.1, hx.2.1, hy.1.1, hy.2.1] + exact_mod_cast hcaR + have hre : a.re = c.re ∨ a.re = c.re + 1 ∨ c.re = a.re + 1 := by omega + rcases hre with hre | hre | hre + · have hacEq : a = c := by + apply Zsqrtd.ext <;> simp [hre, him] + exact ⟨a, by simp, by simp [hacEq]⟩ + · have hacEq : a = c + 1 := by + apply Zsqrtd.ext <;> simp [hre, him] + exact ⟨a, by simp, by simp [hacEq]⟩ + · have hcaEq : c = a + 1 := by + apply Zsqrtd.ext <;> simp [hre, him] + exact ⟨c, by simp [hcaEq], by simp⟩ + +private theorem vertical_inter (a c : GaussianInt) : + (GridEdgeCarrier ({a, a + J} : Finset GaussianInt) ∩ + GridEdgeCarrier ({c, c + J} : Finset GaussianInt)).Nonempty → + ∃ z, z ∈ ({a, a + J} : Finset GaussianInt) ∧ + z ∈ ({c, c + J} : Finset GaussianInt) := by + classical + let J : GaussianInt := ⟨0, 1⟩ + have carrier_pair (a b : GaussianInt) : + GridEdgeCarrier ({a, b} : Finset GaussianInt) = + Set.uIcc (GaussianRealPoint a) (GaussianRealPoint b) := carrier_pair a b + change ((GridEdgeCarrier ({a, a + J} : Finset GaussianInt) ∩ + GridEdgeCarrier ({c, c + J} : Finset GaussianInt)).Nonempty → + ∃ z, z ∈ ({a, a + J} : Finset GaussianInt) ∧ + z ∈ ({c, c + J} : Finset GaussianInt)) + rintro ⟨⟨x, y⟩, hx, hy⟩ + rw [carrier_pair] at hx hy + simp? [Set.uIcc, GaussianRealPoint, J] at hx hy + rw [← GaussianInt.intCast_re a, ← GaussianInt.intCast_im a] at hx + rw [← GaussianInt.intCast_re c, ← GaussianInt.intCast_im c] at hy + have hre : a.re = c.re := by + have hreR : ((a.re : Int) : Real) = ((c.re : Int) : Real) := by + linarith [hx.1.1, hx.2.1, hy.1.1, hy.2.1] + exact_mod_cast hreR + have hac : a.im ≤ c.im + 1 := by + have hacR : ((a.im : Int) : Real) ≤ ((c.im : Int) : Real) + 1 := by + linarith [hx.1.2, hx.2.2, hy.1.2, hy.2.2] + exact_mod_cast hacR + have hca : c.im ≤ a.im + 1 := by + have hcaR : ((c.im : Int) : Real) ≤ ((a.im : Int) : Real) + 1 := by + linarith [hx.1.2, hx.2.2, hy.1.2, hy.2.2] + exact_mod_cast hcaR + have him : a.im = c.im ∨ a.im = c.im + 1 ∨ c.im = a.im + 1 := by omega + rcases him with him | him | him + · have hacEq : a = c := by + apply Zsqrtd.ext <;> simp [hre, him] + exact ⟨a, by simp, by simp [hacEq]⟩ + · have hacEq : a = c + J := by + apply Zsqrtd.ext <;> simp [hre, him, J] + exact ⟨a, by simp, by simp [hacEq]⟩ + · have hcaEq : c = a + J := by + apply Zsqrtd.ext <;> simp [hre, him, J] + exact ⟨c, by simp [hcaEq], by simp⟩ + +private theorem cross_inter (a c : GaussianInt) : + (GridEdgeCarrier ({a, a + 1} : Finset GaussianInt) ∩ + GridEdgeCarrier ({c, c + J} : Finset GaussianInt)).Nonempty → + ∃ z, z ∈ ({a, a + 1} : Finset GaussianInt) ∧ + z ∈ ({c, c + J} : Finset GaussianInt) := by + classical + let J : GaussianInt := ⟨0, 1⟩ + have carrier_pair (a b : GaussianInt) : + GridEdgeCarrier ({a, b} : Finset GaussianInt) = + Set.uIcc (GaussianRealPoint a) (GaussianRealPoint b) := carrier_pair a b + change ((GridEdgeCarrier ({a, a + 1} : Finset GaussianInt) ∩ + GridEdgeCarrier ({c, c + J} : Finset GaussianInt)).Nonempty → + ∃ z, z ∈ ({a, a + 1} : Finset GaussianInt) ∧ + z ∈ ({c, c + J} : Finset GaussianInt)) + rintro ⟨⟨x, y⟩, hx, hy⟩ + rw [carrier_pair] at hx hy + simp? [Set.uIcc, GaussianRealPoint, J] at hx hy + rw [← GaussianInt.intCast_re a, ← GaussianInt.intCast_im a] at hx + rw [← GaussianInt.intCast_re c, ← GaussianInt.intCast_im c] at hy + have hca : c.re = a.re ∨ c.re = a.re + 1 := by + have hlo : a.re ≤ c.re := by + have hr : ((a.re : Int) : Real) ≤ ((c.re : Int) : Real) := by + linarith [hx.1.1, hy.2.1] + exact_mod_cast hr + have hhi : c.re ≤ a.re + 1 := by + have hr : ((c.re : Int) : Real) ≤ ((a.re : Int) : Real) + 1 := by + linarith [hy.1.1, hx.2.1] + exact_mod_cast hr + omega + have hac : a.im = c.im ∨ a.im = c.im + 1 := by + have hlo : c.im ≤ a.im := by + have hr : ((c.im : Int) : Real) ≤ ((a.im : Int) : Real) := by + linarith [hy.1.2, hx.2.2] + exact_mod_cast hr + have hhi : a.im ≤ c.im + 1 := by + have hr : ((a.im : Int) : Real) ≤ ((c.im : Int) : Real) + 1 := by + linarith [hx.1.2, hy.2.2] + exact_mod_cast hr + omega + rcases hca with hca | hca <;> rcases hac with hac | hac + · have h : a = c := by apply Zsqrtd.ext <;> simp [hca, hac] + exact ⟨a, by simp, by simp [h]⟩ + · have h : a = c + J := by apply Zsqrtd.ext <;> simp [hca, hac, J] + exact ⟨a, by simp, by simp [h]⟩ + · have h : a + 1 = c := by apply Zsqrtd.ext <;> simp [hca, hac] + exact ⟨a + 1, by simp, by simp [h]⟩ + · have h : a + 1 = c + J := by apply Zsqrtd.ext <;> simp [hca, hac, J] + exact ⟨a + 1, by simp, by simp [h]⟩ + +private theorem carrier_intersection (E : Set (Finset GaussianInt)) (hgrid : ∀ e ∈ E, ∃ a b : + GaussianInt, e = {a, b} ∧ FourNeighborAdjacent a b) {e f : Finset GaussianInt} (he : e ∈ E) + (hf : f ∈ E) : + (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty ↔ + ∃ z, z ∈ e ∧ z ∈ f := by + classical + let J : GaussianInt := ⟨0, 1⟩ + have canonical (e : Finset GaussianInt) (he : e ∈ E) : + ∃ a : GaussianInt, e = {a, a + 1} ∨ e = {a, a + J} := canonical E hgrid e he + have point_of_common {e f : Finset GaussianInt} {z : GaussianInt} + (hze : z ∈ e) (hzf : z ∈ f) : + (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty := point_of_common (e := e) (f := f) (z := + z) hze hzf + have horizontal_inter (a c : GaussianInt) : + (GridEdgeCarrier ({a, a + 1} : Finset GaussianInt) ∩ + GridEdgeCarrier ({c, c + 1} : Finset GaussianInt)).Nonempty → + ∃ z, z ∈ ({a, a + 1} : Finset GaussianInt) ∧ + z ∈ ({c, c + 1} : Finset GaussianInt) := horizontal_inter a c + have vertical_inter (a c : GaussianInt) : + (GridEdgeCarrier ({a, a + J} : Finset GaussianInt) ∩ + GridEdgeCarrier ({c, c + J} : Finset GaussianInt)).Nonempty → + ∃ z, z ∈ ({a, a + J} : Finset GaussianInt) ∧ + z ∈ ({c, c + J} : Finset GaussianInt) := vertical_inter a c + have cross_inter (a c : GaussianInt) : + (GridEdgeCarrier ({a, a + 1} : Finset GaussianInt) ∩ + GridEdgeCarrier ({c, c + J} : Finset GaussianInt)).Nonempty → + ∃ z, z ∈ ({a, a + 1} : Finset GaussianInt) ∧ + z ∈ ({c, c + J} : Finset GaussianInt) := cross_inter a c + constructor + · rcases canonical e he with ⟨a, rfl | rfl⟩ <;> + rcases canonical f hf with ⟨c, rfl | rfl⟩ + · exact horizontal_inter a c + · exact cross_inter a c + · intro h + rcases cross_inter c a (by simpa [Set.inter_comm] using h) with ⟨z, hz1, hz2⟩ + exact ⟨z, hz2, hz1⟩ + · exact vertical_inter a c + · rintro ⟨z, hze, hzf⟩ + exact point_of_common hze hzf + +private noncomputable def step (E : Set (Finset GaussianInt)) : Finset GaussianInt → Finset + GaussianInt → Prop := fun e f => + e ∈ E ∧ f ∈ E ∧ (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty + +private noncomputable def reach (E : Set (Finset GaussianInt)) : Finset GaussianInt → Finset + GaussianInt → Prop := Relation.ReflTransGen (step E) + +private theorem step_symm (E : Set (Finset GaussianInt)) {e f : Finset GaussianInt} (hef : (step + E) e f) : (step E) f e := by + classical + let step : Finset GaussianInt → Finset GaussianInt → Prop := fun e f => + e ∈ E ∧ f ∈ E ∧ (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty + change (step f e) + refine ⟨hef.2.1, hef.1, ?_⟩ + simpa only [Set.inter_comm] using hef.2.2 + +private theorem reach_symm (E : Set (Finset GaussianInt)) {e f : Finset GaussianInt} (hef : + (reach E) e f) : (reach E) f e := by + classical + let step : Finset GaussianInt → Finset GaussianInt → Prop := fun e f => + e ∈ E ∧ f ∈ E ∧ (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty + let reach : Finset GaussianInt → Finset GaussianInt → Prop := + Relation.ReflTransGen step + have step_symm {e f : Finset GaussianInt} (hef : step e f) : step f e := step_symm E (e := e) + (f := f) hef + change (reach f e) + induction hef using Relation.ReflTransGen.head_induction_on with + | refl => exact Relation.ReflTransGen.refl + | @head a b hab hrest ih => + exact Relation.ReflTransGen.trans ih + (Relation.ReflTransGen.single (step_symm hab)) + +private theorem carrier_closed (E : Set (Finset GaussianInt)) (hgrid : ∀ e ∈ E, ∃ a b : + GaussianInt, e = {a, b} ∧ FourNeighborAdjacent a b) {e : Finset GaussianInt} (he : e ∈ E) : + IsClosed (GridEdgeCarrier e) := by + classical + let J : GaussianInt := ⟨0, 1⟩ + have carrier_pair (a b : GaussianInt) : + GridEdgeCarrier ({a, b} : Finset GaussianInt) = + Set.uIcc (GaussianRealPoint a) (GaussianRealPoint b) := carrier_pair a b + have canonical (e : Finset GaussianInt) (he : e ∈ E) : + ∃ a : GaussianInt, e = {a, a + 1} ∨ e = {a, a + J} := canonical E hgrid e he + rcases canonical e he with ⟨a, rfl | rfl⟩ <;> + rw [carrier_pair] <;> exact isClosed_Icc + +private theorem carrier_nonempty (E : Set (Finset GaussianInt)) (hgrid : ∀ e ∈ E, ∃ a b : + GaussianInt, e = {a, b} ∧ FourNeighborAdjacent a b) {e : Finset GaussianInt} (he : e ∈ E) : + (GridEdgeCarrier e).Nonempty := by + classical + let J : GaussianInt := ⟨0, 1⟩ + have canonical (e : Finset GaussianInt) (he : e ∈ E) : + ∃ a : GaussianInt, e = {a, a + 1} ∨ e = {a, a + J} := canonical E hgrid e he + rcases canonical e he with ⟨a, rfl | rfl⟩ + · exact ⟨GaussianRealPoint a, by unfold GridEdgeCarrier; simp⟩ + · exact ⟨GaussianRealPoint a, by unfold GridEdgeCarrier; simp⟩ + +private theorem E_nonempty (E : Set (Finset GaussianInt)) (hconnected : IsConnected (⋃ e ∈ E, + GridEdgeCarrier e)) : E.Nonempty := by + classical + rcases hconnected.nonempty with ⟨p, hp⟩ + simp only [Set.mem_iUnion] at hp + rcases hp with ⟨e, he, hp⟩ + exact ⟨e, he⟩ + +private theorem reach_all (E : Set (Finset GaussianInt)) (hEfinite : E.Finite) (hgrid : ∀ e ∈ E, + ∃ a b : GaussianInt, e = {a, b} ∧ FourNeighborAdjacent a b) (hconnected : IsConnected (⋃ e ∈ + E, GridEdgeCarrier e)) (e0 : Finset GaussianInt) (he0 : e0 ∈ E) : ∀ f ∈ E, (reach E) e0 f := by + classical + let step : Finset GaussianInt → Finset GaussianInt → Prop := fun e f => + e ∈ E ∧ f ∈ E ∧ (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty + let reach : Finset GaussianInt → Finset GaussianInt → Prop := + Relation.ReflTransGen step + have carrier_closed {e : Finset GaussianInt} (he : e ∈ E) : + IsClosed (GridEdgeCarrier e) := carrier_closed E hgrid (e := e) he + have carrier_nonempty {e : Finset GaussianInt} (he : e ∈ E) : + (GridEdgeCarrier e).Nonempty := carrier_nonempty E hgrid (e := e) he + change (∀ f ∈ E, reach e0 f) + intro f hf + by_contra hnot + let edgeFinset : Finset (Finset GaussianInt) := hEfinite.toFinset + let component : Finset (Finset GaussianInt) := + edgeFinset.filter (fun e => reach e0 e) + let remainder : Finset (Finset GaussianInt) := edgeFinset \ component + let A : Set (Real × Real) := ⋃ e ∈ component, GridEdgeCarrier e + let B : Set (Real × Real) := ⋃ e ∈ remainder, GridEdgeCarrier e + have he0C : e0 ∈ component := by + apply Finset.mem_filter.2 + exact ⟨hEfinite.mem_toFinset.mpr he0, Relation.ReflTransGen.refl⟩ + have hfR : f ∈ remainder := by + apply Finset.mem_sdiff.2 + refine ⟨hEfinite.mem_toFinset.mpr hf, ?_⟩ + intro hfC + exact hnot (Finset.mem_filter.1 hfC).2 + have Aclosed : IsClosed A := by + dsimp [A] + apply isClosed_biUnion_finset + intro e heC + exact carrier_closed (hEfinite.mem_toFinset.mp (Finset.mem_filter.1 heC).1) + have Bclosed : IsClosed B := by + dsimp [B] + apply isClosed_biUnion_finset + intro e heR + exact carrier_closed + (hEfinite.mem_toFinset.mp (Finset.mem_sdiff.1 heR).1) + have unionCovers : (⋃ e ∈ E, GridEdgeCarrier e) ⊆ A ∪ B := by + intro p hp + simp only [Set.mem_iUnion] at hp + rcases hp with ⟨e, he, hp⟩ + by_cases heC : e ∈ component + · left + exact Set.mem_iUnion.2 ⟨e, Set.mem_iUnion.2 ⟨heC, hp⟩⟩ + · right + have heR : e ∈ remainder := Finset.mem_sdiff.2 + ⟨hEfinite.mem_toFinset.mpr he, heC⟩ + exact Set.mem_iUnion.2 ⟨e, Set.mem_iUnion.2 ⟨heR, hp⟩⟩ + have separated : A ∩ B = ∅ := by + rw [Set.eq_empty_iff_forall_notMem] + intro p hp + change p ∈ (⋃ e ∈ component, GridEdgeCarrier e) ∩ + (⋃ e ∈ remainder, GridEdgeCarrier e) at hp + rcases Set.mem_iUnion.1 hp.1 with ⟨e, hpA⟩ + rcases Set.mem_iUnion.1 hpA with ⟨heC, hpe⟩ + rcases Set.mem_iUnion.1 hp.2 with ⟨g, hpB⟩ + rcases Set.mem_iUnion.1 hpB with ⟨hgR, hpg⟩ + have heE : e ∈ E := + hEfinite.mem_toFinset.mp (Finset.mem_filter.1 heC).1 + have heReach : reach e0 e := (Finset.mem_filter.1 heC).2 + have hgE : g ∈ E := + hEfinite.mem_toFinset.mp (Finset.mem_sdiff.1 hgR).1 + have hgNot : ¬ reach e0 g := by + intro hgReach + exact (Finset.mem_sdiff.1 hgR).2 + (Finset.mem_filter.2 ⟨hEfinite.mem_toFinset.mpr hgE, hgReach⟩) + exact hgNot (Relation.ReflTransGen.trans heReach + (Relation.ReflTransGen.single ⟨heE, hgE, ⟨p, hpe, hpg⟩⟩)) + have firstPoint : ∃ p, p ∈ (⋃ e ∈ E, GridEdgeCarrier e) ∧ p ∈ A := by + rcases carrier_nonempty he0 with ⟨p, hp⟩ + exact ⟨p, Set.mem_iUnion.2 ⟨e0, Set.mem_iUnion.2 ⟨he0, hp⟩⟩, + Set.mem_iUnion.2 ⟨e0, Set.mem_iUnion.2 ⟨he0C, hp⟩⟩⟩ + have secondPoint : ∃ p, p ∈ (⋃ e ∈ E, GridEdgeCarrier e) ∧ p ∈ B := by + rcases carrier_nonempty hf with ⟨p, hp⟩ + exact ⟨p, Set.mem_iUnion.2 ⟨f, Set.mem_iUnion.2 ⟨hf, hp⟩⟩, + Set.mem_iUnion.2 ⟨f, Set.mem_iUnion.2 ⟨hfR, hp⟩⟩⟩ + have separatedRelative : + (⋃ e ∈ E, GridEdgeCarrier e) ∩ (A ∩ B) = ∅ := by + rw [separated] + simp + rcases (isPreconnected_iff_subset_of_disjoint_closed.mp + hconnected.isPreconnected A B Aclosed Bclosed unionCovers separatedRelative) with + hsubA | hsubB + · rcases secondPoint with ⟨p, hpK, hpB⟩ + have : p ∈ A ∩ B := ⟨hsubA hpK, hpB⟩ + rw [separated] at this + exact this + · rcases firstPoint with ⟨p, hpK, hpA⟩ + have : p ∈ A ∩ B := ⟨hpA, hsubB hpK⟩ + rw [separated] at this + exact this + +private theorem edge_reachable (E : Set (Finset GaussianInt)) (hgrid : ∀ e ∈ E, ∃ a b : + GaussianInt, e = {a, b} ∧ FourNeighborAdjacent a b) {e : Finset GaussianInt} (he : e ∈ E) + (u v : (X E)) (hu : u.1 ∈ e) (hv : v.1 ∈ e) : (G E).Reachable u v := by + classical + let X : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + let J : GaussianInt := ⟨0, 1⟩ + have canonical (e : Finset GaussianInt) (he : e ∈ E) : + ∃ a : GaussianInt, e = {a, a + 1} ∨ e = {a, a + J} := canonical E hgrid e he + change (G.Reachable u v) + by_cases huv : u = v + · subst v + exact SimpleGraph.Reachable.rfl + apply SimpleGraph.Adj.reachable + simp only [G] + refine ⟨huv, Or.inl ?_⟩ + have hval : u.1 ≠ v.1 := by + intro h + exact huv (Subtype.ext h) + rcases canonical e he with ⟨a, rfl | rfl⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hu hv + rcases hu with hu | hu <;> rcases hv with hv | hv + · exact (hval (hu.trans hv.symm)).elim + · simpa [hu, hv] + · simpa [hu, hv, Finset.pair_comm] using he + · exact (hval (hu.trans hv.symm)).elim + · simp only [Finset.mem_insert, Finset.mem_singleton] at hu hv + rcases hu with hu | hu <;> rcases hv with hv | hv + · exact (hval (hu.trans hv.symm)).elim + · simpa [hu, hv] + · simpa [hu, hv, Finset.pair_comm] using he + · exact (hval (hu.trans hv.symm)).elim + +private theorem chain_graph (E : Set (Finset GaussianInt)) (hgrid : ∀ e ∈ E, ∃ a b : GaussianInt, + e = {a, b} ∧ FourNeighborAdjacent a b) : ∀ {e f : Finset GaussianInt}, e ∈ E → f ∈ E → (reach + E) e f → + ∀ (u v : (X E)), u.1 ∈ e → v.1 ∈ f → (G E).Reachable u v := by + classical + let X : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + have carrier_intersection {e f : Finset GaussianInt} (he : e ∈ E) (hf : f ∈ E) : + (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty ↔ + ∃ z, z ∈ e ∧ z ∈ f := carrier_intersection E hgrid (e := e) (f := f) he hf + let step : Finset GaussianInt → Finset GaussianInt → Prop := fun e f => + e ∈ E ∧ f ∈ E ∧ (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty + let reach : Finset GaussianInt → Finset GaussianInt → Prop := + Relation.ReflTransGen step + have edge_reachable {e : Finset GaussianInt} (he : e ∈ E) + (u v : X) (hu : u.1 ∈ e) (hv : v.1 ∈ e) : G.Reachable u v := edge_reachable E hgrid (e := + e) he u v hu hv + change (∀ {e f : Finset GaussianInt}, e ∈ E → f ∈ E → reach e f → + ∀ (u v : X), u.1 ∈ e → v.1 ∈ f → G.Reachable u v) + intro e f he hf hef + induction hef using Relation.ReflTransGen.head_induction_on with + | refl => + intro u v hu hv + exact edge_reachable he u v hu hv + | @head a b hab hrest ih => + intro u v hu hv + rcases (carrier_intersection hab.1 hab.2.1).mp hab.2.2 with + ⟨z, hza, hzb⟩ + let w : X := ⟨z, ⟨a, hab.1, hza⟩⟩ + have huw : G.Reachable u w := edge_reachable hab.1 u w hu hza + have hwv : G.Reachable w v := ih hab.2.1 w v hzb hv + exact huw.trans hwv + +private theorem X_nonempty (E : Set (Finset GaussianInt)) (hgrid : ∀ e ∈ E, ∃ a b : GaussianInt, + e = {a, b} ∧ FourNeighborAdjacent a b) (e0 : Finset GaussianInt) (he0 : e0 ∈ E) : Nonempty (X + E) := by + classical + let X : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + let J : GaussianInt := ⟨0, 1⟩ + have canonical (e : Finset GaussianInt) (he : e ∈ E) : + ∃ a : GaussianInt, e = {a, a + 1} ∨ e = {a, a + J} := canonical E hgrid e he + change (Nonempty X) + rcases canonical e0 he0 with ⟨a, ha | ha⟩ + · refine ⟨⟨a, ?_⟩⟩ + exact ⟨e0, he0, ha.symm ▸ by simp⟩ + · refine ⟨⟨a, ?_⟩⟩ + exact ⟨e0, he0, ha.symm ▸ by simp⟩ + +end ConnectedEdgeGraph + +theorem ConnectedGridEdgeCarrierGraph + (E : Set (Finset GaussianInt)) + (hEfinite : E.Finite) + (hgrid : ∀ e ∈ E, ∃ a b : GaussianInt, + e = {a, b} ∧ FourNeighborAdjacent a b) + (hconnected : IsConnected (⋃ e ∈ E, GridEdgeCarrier e)) : + let X : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + G.Connected := by +-- BODY + classical + dsimp only + let X : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + change G.Connected + let J : GaussianInt := ⟨0, 1⟩ + have carrier_pair (a b : GaussianInt) : + GridEdgeCarrier ({a, b} : Finset GaussianInt) = + Set.uIcc (GaussianRealPoint a) (GaussianRealPoint b) := ConnectedEdgeGraph.carrier_pair a b + have canonical (e : Finset GaussianInt) (he : e ∈ E) : + ∃ a : GaussianInt, e = {a, a + 1} ∨ e = {a, a + J} := ConnectedEdgeGraph.canonical E hgrid + e he + have point_of_common {e f : Finset GaussianInt} {z : GaussianInt} + (hze : z ∈ e) (hzf : z ∈ f) : + (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty := ConnectedEdgeGraph.point_of_common (e + := e) (f := f) (z := z) hze hzf + have horizontal_inter (a c : GaussianInt) : + (GridEdgeCarrier ({a, a + 1} : Finset GaussianInt) ∩ + GridEdgeCarrier ({c, c + 1} : Finset GaussianInt)).Nonempty → + ∃ z, z ∈ ({a, a + 1} : Finset GaussianInt) ∧ + z ∈ ({c, c + 1} : Finset GaussianInt) := ConnectedEdgeGraph.horizontal_inter a c + have vertical_inter (a c : GaussianInt) : + (GridEdgeCarrier ({a, a + J} : Finset GaussianInt) ∩ + GridEdgeCarrier ({c, c + J} : Finset GaussianInt)).Nonempty → + ∃ z, z ∈ ({a, a + J} : Finset GaussianInt) ∧ + z ∈ ({c, c + J} : Finset GaussianInt) := ConnectedEdgeGraph.vertical_inter a c + have cross_inter (a c : GaussianInt) : + (GridEdgeCarrier ({a, a + 1} : Finset GaussianInt) ∩ + GridEdgeCarrier ({c, c + J} : Finset GaussianInt)).Nonempty → + ∃ z, z ∈ ({a, a + 1} : Finset GaussianInt) ∧ + z ∈ ({c, c + J} : Finset GaussianInt) := ConnectedEdgeGraph.cross_inter a c + have carrier_intersection {e f : Finset GaussianInt} (he : e ∈ E) (hf : f ∈ E) : + (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty ↔ + ∃ z, z ∈ e ∧ z ∈ f := ConnectedEdgeGraph.carrier_intersection E hgrid (e := e) (f := f) + he hf + let step : Finset GaussianInt → Finset GaussianInt → Prop := fun e f => + e ∈ E ∧ f ∈ E ∧ (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty + let reach : Finset GaussianInt → Finset GaussianInt → Prop := + Relation.ReflTransGen step + have step_symm {e f : Finset GaussianInt} (hef : step e f) : step f e := + ConnectedEdgeGraph.step_symm E (e := e) (f := f) hef + have reach_symm {e f : Finset GaussianInt} (hef : reach e f) : reach f e := + ConnectedEdgeGraph.reach_symm E (e := e) (f := f) hef + have carrier_closed {e : Finset GaussianInt} (he : e ∈ E) : + IsClosed (GridEdgeCarrier e) := ConnectedEdgeGraph.carrier_closed E hgrid (e := e) he + have carrier_nonempty {e : Finset GaussianInt} (he : e ∈ E) : + (GridEdgeCarrier e).Nonempty := ConnectedEdgeGraph.carrier_nonempty E hgrid (e := e) he + have E_nonempty : E.Nonempty := ConnectedEdgeGraph.E_nonempty E hconnected + rcases E_nonempty with ⟨e0, he0⟩ + have reach_all : ∀ f ∈ E, reach e0 f := ConnectedEdgeGraph.reach_all E hEfinite hgrid + hconnected e0 he0 + have edge_reachable {e : Finset GaussianInt} (he : e ∈ E) + (u v : X) (hu : u.1 ∈ e) (hv : v.1 ∈ e) : G.Reachable u v := + ConnectedEdgeGraph.edge_reachable E hgrid (e := e) he u v hu hv + have chain_graph : ∀ {e f : Finset GaussianInt}, e ∈ E → f ∈ E → reach e f → + ∀ (u v : X), u.1 ∈ e → v.1 ∈ f → G.Reachable u v := ConnectedEdgeGraph.chain_graph E hgrid + have X_nonempty : Nonempty X := ConnectedEdgeGraph.X_nonempty E hgrid e0 he0 + let _ : Nonempty X := X_nonempty + apply SimpleGraph.Connected.mk + intro u v + rcases u.2 with ⟨e, he, hue⟩ + rcases v.2 with ⟨f, hf, hvf⟩ + have hef : reach e f := Relation.ReflTransGen.trans + (reach_symm (reach_all e he)) (reach_all f hf) + exact chain_graph he hf hef u v hue hvf + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierUnion.lean b/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierUnion.lean new file mode 100644 index 0000000000..837e6ed038 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierUnion.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Combinatorics.SimpleGraph.Connectivity.Connected +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.GridEdgeCarrier + +-- [TABLET NODE: ConnectedGridEdgeCarrierUnion] + +/-! +# ConnectedGridEdgeCarrierUnion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem ConnectedGridEdgeCarrierUnion + (X : Set GaussianInt) (E : Set (Finset GaussianInt)) + (hEnonempty : E.Nonempty) + (hgrid : ∀ e ∈ E, ∃ a b : GaussianInt, + e = {a, b} ∧ FourNeighborAdjacent a b) + (hsupport : X = {x | ∃ e ∈ E, x ∈ e}) + (hconnected : (SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E).Connected) : + IsConnected (⋃ e ∈ E, GridEdgeCarrier e) := by +-- BODY + classical + have intervalConnected : ∀ p q : Real × Real, IsConnected (Set.uIcc p q) := by + intro p q + rw [Set.uIcc_prod_eq] + exact (isConnected_Icc inf_le_sup).prod (isConnected_Icc inf_le_sup) + have carrierConnected : ∀ e ∈ E, IsConnected (GridEdgeCarrier e) := by + intro e he + obtain ⟨a, b, hab, hadj⟩ := hgrid e he + have hcarrier : GridEdgeCarrier e = Set.uIcc (GaussianRealPoint a) (GaussianRealPoint b) := by + ext p + simp only [GridEdgeCarrier, hab, Set.mem_iUnion] + constructor + · rintro ⟨x, hx, y, hy, hp⟩ + simp only [Finset.mem_insert, Finset.mem_singleton] at hx hy + rcases hx with rfl | rfl <;> rcases hy with rfl | rfl + · rw [Set.uIcc_self] at hp + rw [hp] + exact Set.left_mem_uIcc + · exact hp + · simpa [Set.uIcc_comm] using hp + · rw [Set.uIcc_self] at hp + rw [hp] + exact Set.right_mem_uIcc + · intro hp + exact ⟨a, by simp, b, by simp, hp⟩ + rw [hcarrier] + exact intervalConnected _ _ + have carrierPoint : ∀ e ∈ E, ∀ x ∈ e, GaussianRealPoint x ∈ GridEdgeCarrier e := by + intro e he x hx + simp only [GridEdgeCarrier, Set.mem_iUnion] + exact ⟨x, hx, x, hx, by simp⟩ + let R : (Finset GaussianInt) → (Finset GaussianInt) → Prop := + fun e f => (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty ∧ e ∈ E + have liftPath : ∀ {x y : X}, Relation.ReflTransGen + ((SimpleGraph.fromRel (fun a b : X => ({a.1, b.1} : Finset GaussianInt) ∈ E)).Adj) x y → + ∀ e ∈ E, x.1 ∈ e → ∀ f ∈ E, y.1 ∈ f → + Relation.ReflTransGen R e f := by + intro x y hpath + induction hpath with + | refl => + intro e he hxe f hf hyf + exact Relation.ReflTransGen.single ⟨⟨GaussianRealPoint x.1, + carrierPoint e he x.1 hxe, carrierPoint f hf x.1 hyf⟩, he⟩ + | @tail z w hprev hadj ih => + intro e he hxe f hf hyf + rcases (SimpleGraph.fromRel_adj _ _ _).mp hadj with ⟨hne, hrel | hrel⟩ + · let g : Finset GaussianInt := {z.1, w.1} + have hg : g ∈ E := by simpa [g] using hrel + have hgz : z.1 ∈ g := by simp [g] + have hgw : w.1 ∈ g := by simp [g] + have hmid := ih e he hxe g hg hgz + exact hmid.tail ⟨⟨GaussianRealPoint w.1, + carrierPoint g hg w.1 hgw, carrierPoint f hf w.1 hyf⟩, hg⟩ + · let g : Finset GaussianInt := {z.1, w.1} + have hg : g ∈ E := by simpa [g, Finset.pair_comm] using hrel + have hgz : z.1 ∈ g := by simp [g] + have hgw : w.1 ∈ g := by simp [g] + have hmid := ih e he hxe g hg hgz + exact hmid.tail ⟨⟨GaussianRealPoint w.1, + carrierPoint g hg w.1 hgw, carrierPoint f hf w.1 hyf⟩, hg⟩ + have hEsub : ∀ e ∈ E, IsConnected (GridEdgeCarrier e) := carrierConnected + have hEne : E.Nonempty := hEnonempty + have hR : ∀ e ∈ E, ∀ f ∈ E, Relation.ReflTransGen R e f := by + intro e he f hf + obtain ⟨a, b, hab, hadj⟩ := hgrid e he + obtain ⟨c, d, hcd, hcdadj⟩ := hgrid f hf + have haX : a ∈ X := by rw [hsupport]; exact ⟨e, he, by rw [hab]; simp⟩ + have hcX : c ∈ X := by rw [hsupport]; exact ⟨f, hf, by rw [hcd]; simp⟩ + have hreach : (SimpleGraph.fromRel (fun u v : X => + ({u.1, v.1} : Finset GaussianInt) ∈ E)).Reachable + ⟨a, haX⟩ ⟨c, hcX⟩ := hconnected ⟨a, haX⟩ ⟨c, hcX⟩ + have hrt := (SimpleGraph.reachable_iff_reflTransGen _ _).mp hreach + exact liftPath hrt e he (by rw [hab]; simp) f hf (by rw [hcd]; simp) + refine IsConnected.biUnion_of_reflTransGen hEne hEsub ?_ + intro e he f hf + exact hR e he f hf + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ConsecutivePatchInterface.lean b/LeanPool/ApollonianSuperharmonic/ConsecutivePatchInterface.lean new file mode 100644 index 0000000000..a0cecdddc2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ConsecutivePatchInterface.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch + +-- [TABLET NODE: ConsecutivePatchInterface] + +/-! +# ConsecutivePatchInterface + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $K$ be a finite induced tile patch and let $d\notin K$. A +\emph{consecutive patch interface at $d$} is a positive-length injective +list of precisely those neighbors of $d$ which lie in $K$, together with an +injective list of one more triangular face, such that the $k$-th neighbor +and $d$ are both vertices of the $k$-th and $(k+1)$-st listed faces. Thus +the edges from $d$ into $K$ form one consecutive interval in the cyclic +link of $d$, and the two end faces are retained explicitly. +-/ +structure ConsecutivePatchInterface {ι : Type} + (G : PlaneTriangulation ι) (tile : ι → ProtoTile) + (K : FiniteInducedTilePatch G tile) (d : ι) where +-- BODY + exterior : d ∉ K.indices + /-- The number of consecutive neighbors in the patch-facing interval. -/ + length : Nat + positive : 0 < length + /-- The ordered patch neighbors along the link of the exterior tile. -/ + neighbor : Fin length → ι + /-- The consecutive incident faces, including the two end faces. -/ + face : Fin (length + 1) → G.Face + neighbor_injective : Function.Injective neighbor + face_injective : Function.Injective face + neighbors_exact : ∀ b, b ∈ K.indices ∧ G.adjacent d b ↔ + ∃ k, neighbor k = b + consecutive_faces : ∀ k, + (∃ i, G.faceVertex (face (Fin.castSucc k)) i = d) ∧ + (∃ i, G.faceVertex (face (Fin.castSucc k)) i = neighbor k) ∧ + (∃ i, G.faceVertex (face k.succ) i = d) ∧ + (∃ i, G.faceVertex (face k.succ) i = neighbor k) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean b/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean new file mode 100644 index 0000000000..739e4d9a39 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean @@ -0,0 +1,528 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: CoveredInterfaceOppositeIncidentCells] + +/-! +# CoveredInterfaceOppositeIncidentCells + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OppositeIncidentGeometry + +private theorem owner_routing : + (by + classical + exact + ∀ (P : Fin 4 → Prop), ∀ (Q : Fin 4 → Prop), ∀ (R : Fin 4 → Prop), (∀ j, ¬ (P j ∧ Q j)) → + ((∀ j, ¬ (P j ∧ R j)) → ((∀ j, ¬ (Q j ∧ R j)) → ((∀ j, P j ∨ Q j ∨ R j) → ((¬ ((P 0 ∧ + P 2 ∧ ¬ P 1 ∧ ¬ P 3) ∨ + (P 1 ∧ P 3 ∧ ¬ P 0 ∧ ¬ P 2))) → ((¬ ((Q 0 ∧ Q 2 ∧ ¬ Q 1 ∧ ¬ Q 3) ∨ + (Q 1 ∧ Q 3 ∧ ¬ Q 0 ∧ ¬ Q 2))) → ((∃ j, (P j ∧ Q (j + 1)) ∨ (Q j ∧ P (j + 1))) → ((∀ + j, ¬ (R j ∧ R (j + 1))) → (∃ j, P j ∧ Q (j + 2))))))))) ) := by + classical + intro P Q R hPQ hPR hQR hcover hcheckP hcheckQ htrans hnoR + rcases htrans with ⟨j, hj⟩ + by_contra hop + push Not at hop + have add21 (r : Fin 4) : r + 2 + 1 = r + 3 := by fin_cases r <;> rfl + have add11 (r : Fin 4) : r + 1 + 1 = r + 2 := by fin_cases r <;> rfl + have add12 (r : Fin 4) : r + 1 + 2 = r + 3 := by fin_cases r <;> rfl + have add13 (r : Fin 4) : r + 1 + 3 = r := by fin_cases r <;> rfl + have add32 (r : Fin 4) : r + 3 + 2 = r + 1 := by fin_cases r <;> rfl + have add22 (r : Fin 4) : r + 2 + 2 = r := by fin_cases r <;> rfl + have checkP (r : Fin 4) : + ¬ (P r ∧ P (r + 2) ∧ ¬ P (r + 1) ∧ ¬ P (r + 3)) := by + intro hr + fin_cases r <;> norm_num at hr + · exact hcheckP (Or.inl hr) + · exact hcheckP (Or.inr ⟨hr.1, hr.2.1, hr.2.2.2, hr.2.2.1⟩) + · exact hcheckP (Or.inl ⟨hr.2.1, hr.1, hr.2.2.2, hr.2.2.1⟩) + · exact hcheckP (Or.inr ⟨hr.2.1, hr.1, hr.2.2.1, hr.2.2.2⟩) + have checkQ (r : Fin 4) : + ¬ (Q r ∧ Q (r + 2) ∧ ¬ Q (r + 1) ∧ ¬ Q (r + 3)) := by + intro hr + fin_cases r <;> norm_num at hr + · exact hcheckQ (Or.inl hr) + · exact hcheckQ (Or.inr ⟨hr.1, hr.2.1, hr.2.2.2, hr.2.2.1⟩) + · exact hcheckQ (Or.inl ⟨hr.2.1, hr.1, hr.2.2.2, hr.2.2.1⟩) + · exact hcheckQ (Or.inr ⟨hr.2.1, hr.1, hr.2.2.1, hr.2.2.2⟩) + rcases hj with hj | hj + · have hnQ2 : ¬ Q (j + 2) := fun hq => hop j hj.1 hq + have hnP3 : ¬ P (j + 3) := by + intro hp + exact hop (j + 3) hp (by simpa [add32] using hj.2) + rcases hcover (j + 2) with hp2 | hq2 | hr2 + · rcases hcover (j + 3) with hp3 | hq3 | hr3 + · exact hnP3 hp3 + · exact checkP j ⟨hj.1, hp2, fun hp => hPQ (j + 1) ⟨hp, hj.2⟩, + fun hp => hPQ (j + 3) ⟨hp, hq3⟩⟩ + · exact checkP j ⟨hj.1, hp2, fun hp => hPQ (j + 1) ⟨hp, hj.2⟩, + fun hp => hPR (j + 3) ⟨hp, hr3⟩⟩ + · exact hnQ2 hq2 + · rcases hcover (j + 3) with hp3 | hq3 | hr3 + · exact hnP3 hp3 + · apply checkQ (j + 1) + refine ⟨hj.2, ?_, ?_, ?_⟩ + · simpa [add12] using hq3 + · simpa [add11] using (fun hq => hQR (j + 2) ⟨hq, hr2⟩) + · simpa [add13] using (fun hq => hPQ j ⟨hj.1, hq⟩) + · exact hnoR (j + 2) ⟨hr2, by simpa [add21] using hr3⟩ + · have hnP2 : ¬ P (j + 2) := by + intro hp + exact hop (j + 2) hp (by simpa [add22] using hj.1) + have hnQ3 : ¬ Q (j + 3) := fun hq => hop (j + 1) hj.2 (by + simpa [add12] using hq) + rcases hcover (j + 2) with hp2 | hq2 | hr2 + · exact hnP2 hp2 + · rcases hcover (j + 3) with hp3 | hq3 | hr3 + · apply checkQ j + exact ⟨hj.1, hq2, fun hq => hPQ (j + 1) ⟨hj.2, hq⟩, + fun hq => hPQ (j + 3) ⟨hp3, hq⟩⟩ + · exact hnQ3 hq3 + · apply checkQ j + exact ⟨hj.1, hq2, fun hq => hPQ (j + 1) ⟨hj.2, hq⟩, + fun hq => hQR (j + 3) ⟨hq, hr3⟩⟩ + · rcases hcover (j + 3) with hp3 | hq3 | hr3 + · apply checkP (j + 1) + refine ⟨hj.2, ?_, ?_, ?_⟩ + · simpa [add12] using hp3 + · simpa [add11] using (fun hp => hPR (j + 2) ⟨hp, hr2⟩) + · simpa [add13] using (fun hp => hPQ j ⟨hp, hj.1⟩) + · exact hnQ3 hq3 + · exact hnoR (j + 2) ⟨hr2, by simpa [add21] using hr3⟩ + +private theorem hcheckP : + (by + classical + exact + ∀ (A : ProtoTile), (LatticeTile A) → (∀ (c : GaussianInt), + let P : Fin 4 → Prop := fun j => LatticeVertexIncidentCell c j ∈ A.cells + ¬ ((P 0 ∧ P 2 ∧ ¬ P 1 ∧ ¬ P 3) ∨ (P 1 ∧ P 3 ∧ ¬ P 0 ∧ ¬ P 2))) ) := by + classical + intro A hAlat c P + simpa [P, LatticeVertexIncidentCell] using + (LatticeTileGridStructure A hAlat).2.1 c + +private theorem hcheckQ : + (by + classical + exact + ∀ (B : ProtoTile), (LatticeTile B) → (∀ (c : GaussianInt), + let Q : Fin 4 → Prop := fun j => LatticeVertexIncidentCell c j ∈ B.cells + ¬ ((Q 0 ∧ Q 2 ∧ ¬ Q 1 ∧ ¬ Q 3) ∨ (Q 1 ∧ Q 3 ∧ ¬ Q 0 ∧ ¬ Q 2))) ) := by + classical + intro B hBlat c Q + simpa [Q, LatticeVertexIncidentCell] using + (LatticeTileGridStructure B hBlat).2.1 c + +private theorem htrans : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), (Disjoint A.cells B.cells) → (∀ (D : ProtoTile), ∀ + (c : GaussianInt), (c ∈ FootprintVertices A ∩ FootprintVertices B ∩ FootprintVertices + D) → ((∀ (y : GaussianInt), y = c ∨ y = c + (1 : GaussianInt) ∨ y = c - (1 : + GaussianInt) ∨ y = c + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = c - (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices A ∨ y ∈ FootprintVertices B) → ( + let P : Fin 4 → Prop := fun j => LatticeVertexIncidentCell c j ∈ A.cells + let Q : Fin 4 → Prop := fun j => LatticeVertexIncidentCell c j ∈ B.cells + let R : Fin 4 → Prop := fun j => LatticeVertexIncidentCell c j ∈ D.cells + (∀ ⦃a : LatticeCell⦄, a ∈ A.cells → a ∉ B.cells) → ((∀ j, ¬ (P j ∧ Q j)) → ((∀ j, ¬ (P j + ∧ R j)) → ((∀ j, ¬ (Q j ∧ R j)) → (((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell c + j ∈ A.cells ∨ LatticeVertexIncidentCell c j ∈ B.cells ∨ LatticeVertexIncidentCell c j + ∈ D.cells) ∧ (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell c j ∈ A.cells) ∧ (∃ (j : + Fin (4 : ℕ)), LatticeVertexIncidentCell c j ∈ B.cells) ∧ (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell c j ∈ D.cells) ∧ ((∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell c j ∈ A.cells ∧ LatticeVertexIncidentCell c (j + (2 : Fin + (4 : ℕ))) ∈ B.cells) ∨ (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell c j ∈ A.cells + ∧ LatticeVertexIncidentCell c (j + (2 : Fin (4 : ℕ))) ∈ D.cells) ∨ ∃ (j : Fin (4 : + ℕ)), LatticeVertexIncidentCell c j ∈ B.cells ∧ LatticeVertexIncidentCell c (j + (2 : + Fin (4 : ℕ))) ∈ D.cells)) → ((∀ j, P j ∨ Q j ∨ R j) → ((¬ ((P 0 ∧ P 2 ∧ ¬ P 1 ∧ ¬ P + 3) ∨ (P 1 ∧ P 3 ∧ ¬ P 0 ∧ ¬ P 2))) → ((¬ ((Q 0 ∧ Q 2 ∧ ¬ Q 1 ∧ ¬ Q 3) ∨ (Q 1 ∧ Q 3 ∧ + ¬ Q 0 ∧ ¬ Q 2))) → (∀ (e : Finset GaussianInt), (c ∈ e) → ((e ∈ FootprintEdges A ∩ + FootprintEdges B) → (∃ j, (P j ∧ Q (j + 1)) ∨ (Q j ∧ P (j + 1))))))))))))))) ) := by + classical + intro A B hAB D c hc hstarc P Q R hdAB hPQ hPR hQR hlocal hcover hcheckP hcheckQ e hce he + change ∃ j : Fin 4, + (LatticeVertexIncidentCell c j ∈ A.cells ∧ + LatticeVertexIncidentCell c (j + 1) ∈ B.cells) ∨ + (LatticeVertexIncidentCell c j ∈ B.cells ∧ + LatticeVertexIncidentCell c (j + 1) ∈ A.cells) + let I : GaussianInt := ⟨0, 1⟩ + have horiz_unique (u v : GaussianInt) + (h : ({u, u + 1} : Finset GaussianInt) = {v, v + 1}) : u = v := by + have hu : u = v ∨ u = v + 1 := by + have : u ∈ ({v, v + 1} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hv : v = u ∨ v = u + 1 := by + have : v ∈ ({u, u + 1} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hu with huv | huv + · exact huv + rcases hv with hvu | hvu + · exact hvu.symm + · have hre := congrArg Zsqrtd.re huv + have hre' := congrArg Zsqrtd.re hvu + norm_num at hre hre' + omega + have vert_unique (u v : GaussianInt) + (h : ({u, u + I} : Finset GaussianInt) = {v, v + I}) : u = v := by + have hu : u = v ∨ u = v + I := by + have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hv : v = u ∨ v = u + I := by + have : v ∈ ({u, u + I} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hu with huv | huv + · exact huv + rcases hv with hvu | hvu + · exact hvu.symm + · have him := congrArg Zsqrtd.im huv + have him' := congrArg Zsqrtd.im hvu + simp [I] at him him' + omega + have horiz_ne_vert (u v : GaussianInt) : + ({u, u + 1} : Finset GaussianInt) ≠ {v, v + I} := by + intro h + have hu : u = v ∨ u = v + I := by + have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hu1 : u + 1 = v ∨ u + 1 = v + I := by + have : u + 1 ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + rcases hu with hu | hu <;> rcases hu1 with hu1 | hu1 + all_goals + have hre := congrArg Zsqrtd.re hu + have him := congrArg Zsqrtd.im hu + have hre1 := congrArg Zsqrtd.re hu1 + have him1 := congrArg Zsqrtd.im hu1 + simp [I] at hre him hre1 him1 + omega + have hboundary := CellDisjointCommonEdgesBoundary A B hAB + have he' : e ∈ BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B := by + rw [← hboundary] + exact he + rcases he'.1 with ⟨u, ⟨heu, hu⟩ | ⟨heu, hu⟩⟩ + · rcases he'.2 with ⟨v, ⟨hev, hv⟩ | ⟨hev, hv⟩⟩ + · have huv : u = v := horiz_unique u v (heu.symm.trans hev) + subst v + have hxuv : c = u ∨ c = u + 1 := by + rw [heu] at hce + simpa using hce + rcases hxuv with rfl | rfl + · rcases hu with hu | hu <;> rcases hv with hv | hv + · exact (hdAB hu.1 hv.1).elim + · exact ⟨3, Or.inr ⟨by + simpa [LatticeVertexIncidentCell, I] using hv.2, by + simpa [LatticeVertexIncidentCell, I] using hu.1⟩⟩ + · exact ⟨3, Or.inl ⟨by + simpa [LatticeVertexIncidentCell, I] using hu.2, by + simpa [LatticeVertexIncidentCell, I] using hv.1⟩⟩ + · exact (hdAB hu.2 hv.2).elim + · rcases hu with hu | hu <;> rcases hv with hv | hv + · exact (hdAB hu.1 hv.1).elim + · exact ⟨1, Or.inl ⟨by + simpa [LatticeVertexIncidentCell, I] using hu.1, by + simpa [LatticeVertexIncidentCell, I] using hv.2⟩⟩ + · exact ⟨1, Or.inr ⟨by + simpa [LatticeVertexIncidentCell, I] using hv.1, by + simpa [LatticeVertexIncidentCell, I] using hu.2⟩⟩ + · exact (hdAB hu.2 hv.2).elim + · exact (horiz_ne_vert u v (heu.symm.trans hev)).elim + · rcases he'.2 with ⟨v, ⟨hev, hv⟩ | ⟨hev, hv⟩⟩ + · exact (horiz_ne_vert v u (hev.symm.trans heu)).elim + · have huv : u = v := vert_unique u v (heu.symm.trans hev) + subst v + have hxuv : c = u ∨ c = u + I := by + rw [heu] at hce + simpa using hce + rcases hxuv with rfl | rfl + · rcases hu with hu | hu <;> rcases hv with hv | hv + · exact (hdAB hu.1 hv.1).elim + · exact ⟨0, Or.inl ⟨by + simpa [LatticeVertexIncidentCell, I] using hu.1, by + simpa [LatticeVertexIncidentCell, I] using hv.2⟩⟩ + · exact ⟨0, Or.inr ⟨by + simpa [LatticeVertexIncidentCell, I] using hv.1, by + simpa [LatticeVertexIncidentCell, I] using hu.2⟩⟩ + · exact (hdAB hu.2 hv.2).elim + · rcases hu with hu | hu <;> rcases hv with hv | hv + · exact (hdAB hu.1 hv.1).elim + · exact ⟨2, Or.inr ⟨by + simpa [LatticeVertexIncidentCell, I, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] using hv.2, by + simpa [LatticeVertexIncidentCell, I] using hu.1⟩⟩ + · exact ⟨2, Or.inl ⟨by + simpa [LatticeVertexIncidentCell, I, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] using hu.2, by + simpa [LatticeVertexIncidentCell, I] using hv.1⟩⟩ + · exact (hdAB hu.2 hv.2).elim + +private theorem hnoR : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), (∀ y ∈ FootprintVertices A, ∀ z ∈ FootprintVertices + A, FourNeighborAdjacent y z → {y, z} ∈ FootprintEdges A) → ((∀ y ∈ FootprintVertices + B, ∀ z ∈ FootprintVertices B, FourNeighborAdjacent y z → {y, z} ∈ FootprintEdges B) → + (∀ (D : ProtoTile), ∀ (c : GaussianInt), (Disjoint A.cells D.cells) → ((Disjoint + B.cells D.cells) → ((c ∈ FootprintVertices A ∩ FootprintVertices B ∩ + FootprintVertices D) → ((∀ (y : GaussianInt), y = c ∨ y = c + (1 : GaussianInt) ∨ y = + c - (1 : GaussianInt) ∨ y = c + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = c - (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices A ∨ y ∈ FootprintVertices B) → ( + let R : Fin 4 → Prop := fun j => LatticeVertexIncidentCell c j ∈ D.cells + ∀ j, ¬ (R j ∧ R (j + 1)))))))) ) := by + classical + intro A B hAinduced hBinduced D c hAD hBD hc hstarc R + let I : GaussianInt := ⟨0, 1⟩ + have horiz_unique (u v : GaussianInt) + (h : ({u, u + 1} : Finset GaussianInt) = {v, v + 1}) : u = v := by + have hu : u = v ∨ u = v + 1 := by + have : u ∈ ({v, v + 1} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hv : v = u ∨ v = u + 1 := by + have : v ∈ ({u, u + 1} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hu with huv | huv + · exact huv + rcases hv with hvu | hvu + · exact hvu.symm + · have hre := congrArg Zsqrtd.re huv + have hre' := congrArg Zsqrtd.re hvu + norm_num at hre hre' + omega + have vert_unique (u v : GaussianInt) + (h : ({u, u + I} : Finset GaussianInt) = {v, v + I}) : u = v := by + have hu : u = v ∨ u = v + I := by + have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hv : v = u ∨ v = u + I := by + have : v ∈ ({u, u + I} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hu with huv | huv + · exact huv + rcases hv with hvu | hvu + · exact hvu.symm + · have him := congrArg Zsqrtd.im huv + have him' := congrArg Zsqrtd.im hvu + simp [I] at him him' + omega + have horiz_ne_vert (u v : GaussianInt) : + ({u, u + 1} : Finset GaussianInt) ≠ {v, v + I} := by + intro h + have hu : u = v ∨ u = v + I := by + have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hu1 : u + 1 = v ∨ u + 1 = v + I := by + have : u + 1 ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + rcases hu with hu | hu <;> rcases hu1 with hu1 | hu1 + all_goals + have hre := congrArg Zsqrtd.re hu + have him := congrArg Zsqrtd.im hu + have hre1 := congrArg Zsqrtd.re hu1 + have him1 := congrArg Zsqrtd.im hu1 + simp [I] at hre him hre1 him1 + omega + have no_horizontal (U : ProtoTile) (z : GaussianInt) + (hUD : Disjoint U.cells D.cells) + (hU : ({z, z + 1} : Finset GaussianInt) ∈ FootprintEdges U) + (hz : z ∈ D.cells) (hzI : z - I ∈ D.cells) : False := by + have hD : ({z, z + 1} : Finset GaussianInt) ∈ FootprintEdges D := + ⟨z, hz, Or.inl rfl⟩ + have hcommon : ({z, z + 1} : Finset GaussianInt) ∈ + FootprintEdges U ∩ FootprintEdges D := ⟨hU, hD⟩ + rw [CellDisjointCommonEdgesBoundary U D hUD] at hcommon + rcases hcommon.2 with ⟨w, ⟨hew, hw⟩ | ⟨hew, hw⟩⟩ + · have hwz : w = z := horiz_unique w z hew.symm + subst w + rcases hw with hw | hw + · exact hw.2 hzI + · exact hw.1 hz + · exact (horiz_ne_vert z w hew).elim + have no_vertical (U : ProtoTile) (z : GaussianInt) + (hUD : Disjoint U.cells D.cells) + (hU : ({z, z + I} : Finset GaussianInt) ∈ FootprintEdges U) + (hz : z ∈ D.cells) (hz1 : z - 1 ∈ D.cells) : False := by + have hD : ({z, z + I} : Finset GaussianInt) ∈ FootprintEdges D := + ⟨z, hz, Or.inr (Or.inl rfl)⟩ + have hcommon : ({z, z + I} : Finset GaussianInt) ∈ + FootprintEdges U ∩ FootprintEdges D := ⟨hU, hD⟩ + rw [CellDisjointCommonEdgesBoundary U D hUD] at hcommon + rcases hcommon.2 with ⟨w, ⟨hew, hw⟩ | ⟨hew, hw⟩⟩ + · exact (horiz_ne_vert w z hew.symm).elim + · have hwz : w = z := vert_unique w z hew.symm + subst w + rcases hw with hw | hw + · exact hw.2 hz1 + · exact hw.1 hz + intro r hr + fin_cases r + · have hD0 : c ∈ D.cells := by simpa [R, LatticeVertexIncidentCell] using hr.1 + have hD1 : c - 1 ∈ D.cells := by + simpa [R, LatticeVertexIncidentCell] using hr.2 + rcases hstarc (c + I) (by right; right; right; left; rfl) with hyA | hyB + · apply no_vertical A c hAD _ hD0 hD1 + exact hAinduced c hc.1.1 (c + I) hyA (by + exact Or.inr (Or.inr (Or.inl rfl))) + · apply no_vertical B c hBD _ hD0 hD1 + exact hBinduced c hc.1.2 (c + I) hyB (by + exact Or.inr (Or.inr (Or.inl rfl))) + · have hD1 : c - 1 ∈ D.cells := by + simpa [R, LatticeVertexIncidentCell] using hr.1 + have hD2 : c - 1 - I ∈ D.cells := by + simpa [R, LatticeVertexIncidentCell, I] using hr.2 + rcases hstarc (c - 1) (by right; right; left; rfl) with hyA | hyB + · apply no_horizontal A (c - 1) hAD _ hD1 hD2 + simpa [I, Zsqrtd.ext_iff, Finset.pair_comm] using + hAinduced c hc.1.1 (c - 1) hyA (Or.inr (Or.inl rfl)) + · apply no_horizontal B (c - 1) hBD _ hD1 hD2 + simpa [I, Zsqrtd.ext_iff, Finset.pair_comm] using + hBinduced c hc.1.2 (c - 1) hyB (Or.inr (Or.inl rfl)) + · have hD2 : c - 1 - I ∈ D.cells := by + simpa [R, LatticeVertexIncidentCell, I] using hr.1 + have hD3 : c - I ∈ D.cells := by + simpa [R, LatticeVertexIncidentCell, I] using hr.2 + rcases hstarc (c - I) (by right; right; right; right; rfl) with hyA | hyB + · apply no_vertical A (c - I) hAD _ hD3 _ + · simpa [I, Zsqrtd.ext_iff, Finset.pair_comm] using + hAinduced c hc.1.1 (c - I) hyA (Or.inr (Or.inr (Or.inr rfl))) + · simpa [I, Zsqrtd.ext_iff, sub_eq_add_neg, add_comm, + add_left_comm, add_assoc] using hD2 + · apply no_vertical B (c - I) hBD _ hD3 _ + · simpa [I, Zsqrtd.ext_iff, Finset.pair_comm] using + hBinduced c hc.1.2 (c - I) hyB (Or.inr (Or.inr (Or.inr rfl))) + · simpa [I, Zsqrtd.ext_iff, sub_eq_add_neg, add_comm, + add_left_comm, add_assoc] using hD2 + · have hD3 : c - I ∈ D.cells := by + simpa [R, LatticeVertexIncidentCell, I] using hr.1 + have hD0 : c ∈ D.cells := by + simpa [R, LatticeVertexIncidentCell] using hr.2 + rcases hstarc (c + 1) (by right; left; rfl) with hyA | hyB + · apply no_horizontal A c hAD _ hD0 hD3 + exact hAinduced c hc.1.1 (c + 1) hyA (Or.inl rfl) + · apply no_horizontal B c hBD _ hD0 hD3 + exact hBinduced c hc.1.2 (c + 1) hyB (Or.inl rfl) + +end OppositeIncidentGeometry + +theorem CoveredInterfaceOppositeIncidentCells + (A B Aend Bend : ProtoTile) (a b x : GaussianInt) + (hAlat : LatticeTile A) (hBlat : LatticeTile B) + (hAendlat : LatticeTile Aend) (hBendlat : LatticeTile Bend) + (hAB : Disjoint A.cells B.cells) + (hAAend : Disjoint A.cells Aend.cells) + (hBAend : Disjoint B.cells Aend.cells) + (hABend : Disjoint A.cells Bend.cells) + (hBBend : Disjoint B.cells Bend.cells) + (hpath : SimpleGridPathBetween + (FootprintVertices A ∩ FootprintVertices B) + (FootprintEdges A ∩ FootprintEdges B) a b) + (hedge : ∃ e : Finset GaussianInt, + x ∈ e ∧ e ∈ FootprintEdges A ∩ FootprintEdges B) + (hAtriple : TouchingTriple A B Aend) + (hBtriple : TouchingTriple A B Bend) + (ha : a ∈ FootprintVertices A ∩ FootprintVertices B ∩ + FootprintVertices Aend) + (hb : b ∈ FootprintVertices A ∩ FootprintVertices B ∩ + FootprintVertices Bend) + (hAinduced : ∀ y, y ∈ FootprintVertices A → ∀ z, + z ∈ FootprintVertices A → + FourNeighborAdjacent y z → + ({y, z} : Finset GaussianInt) ∈ FootprintEdges A) + (hBinduced : ∀ y, y ∈ FootprintVertices B → ∀ z, + z ∈ FootprintVertices B → + FourNeighborAdjacent y z → + ({y, z} : Finset GaussianInt) ∈ FootprintEdges B) + (hstar : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices A ∨ y ∈ FootprintVertices B) : + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ A.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ B.cells := by +-- BODY + classical + have owner_routing (P Q R : Fin 4 → Prop) + (hPQ : ∀ j, ¬ (P j ∧ Q j)) + (hPR : ∀ j, ¬ (P j ∧ R j)) + (hQR : ∀ j, ¬ (Q j ∧ R j)) + (hcover : ∀ j, P j ∨ Q j ∨ R j) + (hcheckP : ¬ ((P 0 ∧ P 2 ∧ ¬ P 1 ∧ ¬ P 3) ∨ + (P 1 ∧ P 3 ∧ ¬ P 0 ∧ ¬ P 2))) + (hcheckQ : ¬ ((Q 0 ∧ Q 2 ∧ ¬ Q 1 ∧ ¬ Q 3) ∨ + (Q 1 ∧ Q 3 ∧ ¬ Q 0 ∧ ¬ Q 2))) + (htrans : ∃ j, (P j ∧ Q (j + 1)) ∨ (Q j ∧ P (j + 1))) + (hnoR : ∀ j, ¬ (R j ∧ R (j + 1))) : + ∃ j, P j ∧ Q (j + 2) := OppositeIncidentGeometry.owner_routing P Q R hPQ hPR hQR hcover + hcheckP hcheckQ htrans hnoR + have endpoint (D : ProtoTile) (c : GaussianInt) + (hDlat : LatticeTile D) + (hAD : Disjoint A.cells D.cells) (hBD : Disjoint B.cells D.cells) + (htriple : TouchingTriple A B D) + (hc : c ∈ FootprintVertices A ∩ FootprintVertices B ∩ + FootprintVertices D) + (hedgec : ∃ e : Finset GaussianInt, + c ∈ e ∧ e ∈ FootprintEdges A ∩ FootprintEdges B) + (hstarc : ∀ y, y = c ∨ y = c + 1 ∨ y = c - 1 ∨ + y = c + ⟨0, 1⟩ ∨ y = c - ⟨0, 1⟩ → + y ∈ FootprintVertices A ∨ y ∈ FootprintVertices B) : + ∃ j : Fin 4, LatticeVertexIncidentCell c j ∈ A.cells ∧ + LatticeVertexIncidentCell c (j + 2) ∈ B.cells := by + let P : Fin 4 → Prop := fun j => LatticeVertexIncidentCell c j ∈ A.cells + let Q : Fin 4 → Prop := fun j => LatticeVertexIncidentCell c j ∈ B.cells + let R : Fin 4 → Prop := fun j => LatticeVertexIncidentCell c j ∈ D.cells + have hdAB := Finset.disjoint_left.mp hAB + have hdAD := Finset.disjoint_left.mp hAD + have hdBD := Finset.disjoint_left.mp hBD + have hPQ : ∀ j, ¬ (P j ∧ Q j) := fun j h => hdAB h.1 h.2 + have hPR : ∀ j, ¬ (P j ∧ R j) := fun j h => hdAD h.1 h.2 + have hQR : ∀ j, ¬ (Q j ∧ R j) := fun j h => hdBD h.1 h.2 + have hlocal := LocalLatticeInterfaceSectors.1 A B D c + hAlat hBlat hDlat htriple hc + have hcover : ∀ j, P j ∨ Q j ∨ R j := by + simpa [P, Q, R] using hlocal.1 + have hcheckP : ¬ ((P 0 ∧ P 2 ∧ ¬ P 1 ∧ ¬ P 3) ∨ + (P 1 ∧ P 3 ∧ ¬ P 0 ∧ ¬ P 2)) := OppositeIncidentGeometry.hcheckP A hAlat c + have hcheckQ : ¬ ((Q 0 ∧ Q 2 ∧ ¬ Q 1 ∧ ¬ Q 3) ∨ + (Q 1 ∧ Q 3 ∧ ¬ Q 0 ∧ ¬ Q 2)) := OppositeIncidentGeometry.hcheckQ B hBlat c + rcases hedgec with ⟨e, hce, he⟩ + have htrans : ∃ j, (P j ∧ Q (j + 1)) ∨ (Q j ∧ P (j + 1)) := OppositeIncidentGeometry.htrans A + B hAB D c hc hstarc hdAB hPQ hPR hQR hlocal hcover hcheckP hcheckQ e hce he + have hnoR : ∀ j, ¬ (R j ∧ R (j + 1)) := OppositeIncidentGeometry.hnoR A B hAinduced hBinduced + D c hAD hBD hc hstarc + simpa [P, Q] using + owner_routing P Q R hPQ hPR hQR hcover hcheckP hcheckQ htrans hnoR + rcases SimpleGridPathPointTrichotomy + (FootprintVertices A ∩ FootprintVertices B) + (FootprintEdges A ∩ FootprintEdges B) a b x hpath hedge with + hxa | hxb | hinterior + · subst x + exact endpoint Aend a hAendlat hAAend hBAend hAtriple ha hedge hstar + · subst x + exact endpoint Bend b hBendlat hABend hBBend hBtriple hb hedge hstar + · exact (LocalLatticeInterfaceSectors.2 A B x hAlat hBlat hAB hinterior).2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CurvatureOneBandCircleClassification.lean b/LeanPool/ApollonianSuperharmonic/CurvatureOneBandCircleClassification.lean new file mode 100644 index 0000000000..01382941dc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CurvatureOneBandCircleClassification.lean @@ -0,0 +1,96 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandCircle +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification + +-- [TABLET NODE: CurvatureOneBandCircleClassification] + +/-! +# CurvatureOneBandCircleClassification + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem CurvatureOneBandCircleClassification (C : BandCircle) + (hc : C.1.1.1 = 1) : + ∃ z : GaussianInt, C.1.1 = (1, 1 + 2 * z) := by +-- BODY + have invariant : ∀ q : Fin 4 → CircleCoordinates, + SemiProperQuadruple q → ∀ k : Fin 4, (q k).1 = 1 → + ∃ z : GaussianInt, q k = (1, 1 + 2 * z) := by + intro q hq + induction hq with + | base z => + intro k hk + fin_cases k + · exact ⟨z, by rfl⟩ + · refine ⟨z + ⟨0, 1⟩, ?_⟩ + change (1, 1 + 2 * z + 2 * ⟨0, 1⟩) = + (1, 1 + 2 * (z + ⟨0, 1⟩)) + congr 1 + ring_nf + · simp at hk + · simp at hk + | rotate hq ih => + intro k hk + fin_cases k + · exact ih 0 hk + · exact ih 2 hk + · exact ih 3 hk + · exact ih 1 hk + | @successor q hq ih => + intro k hk + fin_cases k + · let s : Fin 4 → CircleCoordinates := + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + have hs : SemiProperQuadruple s := by + exact SemiProperQuadruple.successor hq + have classified := SemiProperForestClassification s hs + rcases classified.2 with root | root | root | proper + · rcases root with ⟨z, hz⟩ + refine ⟨z, ?_⟩ + simpa [s] using congrFun hz 0 + · rcases root with ⟨z, hz⟩ + refine ⟨z, ?_⟩ + simpa [s] using congrFun hz 0 + · rcases root with ⟨z, hz⟩ + refine ⟨z, ?_⟩ + simpa [s] using congrFun hz 0 + · have nonneg := classified.1 + have oldNonneg := (SemiProperForestClassification q hq).1 + have h1 := proper.2 0 + have h2 := proper.2 1 + have h3 := proper.2 2 + simp [s] at hk h1 h2 h3 + have a := nonneg 0 + have b := nonneg 1 + have c := nonneg 2 + have d := nonneg 3 + have e := oldNonneg 1 + simp [s] at a b c d + exfalso + omega + · exact ih 0 hk + · exact ih 2 hk + · exact ih 3 hk + rcases C.1.2.2 with ⟨q, hq, j, hj⟩ + have hjcurv : (q j).1 = 1 := by + simpa [hj] using hc + rcases invariant q hq j hjcurv with ⟨z, hz⟩ + exact ⟨z, by simpa [hj] using hz⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CurvatureOneBandPrototileSingleton.lean b/LeanPool/ApollonianSuperharmonic/CurvatureOneBandPrototileSingleton.lean new file mode 100644 index 0000000000..6ca6162690 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CurvatureOneBandPrototileSingleton.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure + +-- [TABLET NODE: CurvatureOneBandPrototileSingleton] + +/-! +# CurvatureOneBandPrototileSingleton + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem CurvatureOneBandPrototileSingleton (C : BandCircle) (base : ProtoTile) + (hcurv : C.1.1.1 = 1) (hbase : BandPrototile C.1.1 base) : + ∃ x : GaussianInt, base.cells = {x} := by +-- BODY + have aux : ∀ (c : CircleCoordinates) (T : ProtoTile), + BandPrototile c T → c.1 = 1 → ∃ x : GaussianInt, T.cells = {x} := by + intro c T h + induction h with + | line w x hw => + intro hc + norm_num at hc + | unit z x anchor => + intro hc + exact ⟨x, rfl⟩ + | @decompose q hq S T hS hcells hfoot hcentroid ih => + intro hc + have hs := ProperBandCurvatureStructure q hq + have hz : ∀ i : Fin 3, (q i.succ).1 = 0 := by + intro i + have hlt := hq.2 i + have hn := hs.2.1 i + omega + have heq := hs.2.2 (0 : Fin 3) (1 : Fin 3) (hz 0) (hz 1) + norm_num at heq + exact aux C.1.1 base hbase hcurv + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CurvatureOneOdometer.lean b/LeanPool/ApollonianSuperharmonic/CurvatureOneOdometer.lean new file mode 100644 index 0000000000..3c4d9b63cd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CurvatureOneOdometer.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PartialOdometer + +-- [TABLET NODE: CurvatureOneOdometer] + +/-! +# CurvatureOneOdometer + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $z\in\mathbb Z[i]$, the standard curvature-one partial odometer +$u_z$ has domain $\{0,1,i,1+i\}$ and values +$$ + u_z(0)=u_z(1)=u_z(i)=0,\qquad u_z(1+i)=\operatorname{Im}z. +$$ +As for every partial odometer, its stored total-function representative is +zero away from the displayed domain. +-/ +def CurvatureOneOdometer (z : GaussianInt) : PartialOdometer := +-- BODY + { domain := {0, 1, ⟨0, 1⟩, 1 + ⟨0, 1⟩} + value := fun x => if x = 1 + ⟨0, 1⟩ then z.im else 0 + value_outside := by + intro x hx + apply ite_eq_right + intro h + apply hx + subst x + simp } + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CurvatureOnePeriodicOdometer.lean b/LeanPool/ApollonianSuperharmonic/CurvatureOnePeriodicOdometer.lean new file mode 100644 index 0000000000..6ab665581b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CurvatureOnePeriodicOdometer.lean @@ -0,0 +1,296 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicRepresentative +public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TilingLattice + +-- [TABLET NODE: CurvatureOnePeriodicOdometer] + +/-! +# CurvatureOnePeriodicOdometer + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CurvatureOneProof + +private theorem triangular : + ∀ (a : ℤ), ∀ (b : ℤ), (a + b) * (a + b - (1 : ℤ)) / (2 : ℤ) = a * (a - (1 : ℤ)) / (2 : ℤ) + b + * (b - (1 : ℤ)) / (2 : ℤ) + a * b := by + classical + intro a b + have ha : Even (a * (a - 1)) := Int.even_mul_pred_self a + have hb : Even (b * (b - 1)) := Int.even_mul_pred_self b + have hsum : Even ((a + b) * (a + b - 1)) := Int.even_mul_pred_self (a + b) + apply Int.ediv_eq_of_eq_mul_left (by norm_num) + have ha' := Int.two_mul_ediv_two_of_even ha + have hb' := Int.two_mul_ediv_two_of_even hb + have hs' := Int.two_mul_ediv_two_of_even hsum + ring_nf at ha' hb' hs' ⊢ + linarith [ha', hb', hs'] + +private theorem circle_formula : + ∀ (C : BandCircle), ∀ (z : GaussianInt), (C.1.1.1 = 1) → ((C.1.1.2 = 1 + 2 * z) → + (CircleMatrix C = ![![((1 + z.re : ℤ) : ℝ), (z.im : ℝ)], ![(z.im : ℝ), (-z.re : ℝ)]])) := by + classical + intro C z hradius hcenter + unfold CircleMatrix BandCircleEuclideanData + simp only [hradius, hcenter] + ext i j; fin_cases i <;> fin_cases j + all_goals simp only [ + Complex.div_re, Complex.div_im, GaussianInt.toComplex_def, + Complex.add_re, Complex.add_im, Complex.mul_re, Complex.mul_im, + Complex.intCast_re, Complex.intCast_im] + all_goals norm_num + all_goals ring + +private theorem linear_difference : + ∀ (C : BandCircle), ∀ (z : GaussianInt), + let g : IntegerLatticeFunction := fun x => + (1 + z.re) * (x.re * (x.re - 1) / 2) - + z.re * (x.im * (x.im - 1) / 2) + z.im * x.re * x.im + (CircleMatrix C = ![![((1 + z.re : ℤ) : ℝ), (z.im : ℝ)], ![(z.im : ℝ), (-z.re : ℝ)]]) → (∀ (x + : GaussianInt), (↑(g x) : ℝ) - LatticeQuadraticForm (CircleMatrix C) x = -((1 : ℝ) + + (↑z.re : ℝ)) / (2 : ℝ) * (↑x.re : ℝ) + (↑z.re : ℝ) / (2 : ℝ) * (↑x.im : ℝ)) := by + classical + intro C z g circle_formula x + have half (a : ℤ) : + ((a * (a - 1) / 2 : ℤ) : ℝ) = + (a : ℝ) * (a - 1 : ℝ) / 2 := by + have he : Even (a * (a - 1)) := Int.even_mul_pred_self a + have hh := Int.two_mul_ediv_two_of_even he + have hh' : a * (a - 1) / 2 * 2 = a * (a - 1) := by + simpa [mul_comm] using hh + apply (eq_div_iff (by norm_num : (2 : ℝ) ≠ 0)).2 + exact_mod_cast hh' + rw [circle_formula] + simp? [g, LatticeQuadraticForm, Matrix.mulVec, dotProduct] + rw [half x.re, half x.im] + rw [← GaussianInt.intCast_re z, ← GaussianInt.intCast_im z, + ← GaussianInt.intCast_re x, ← GaussianInt.intCast_im x] + ring + +private theorem difference : + ∀ (C : BandCircle), ∀ (z : GaussianInt), + let g : IntegerLatticeFunction := fun x => + (1 + z.re) * (x.re * (x.re - 1) / 2) - + z.re * (x.im * (x.im - 1) / 2) + z.im * x.re * x.im + (CircleMatrix C = ![![((1 + z.re : ℤ) : ℝ), (z.im : ℝ)], ![(z.im : ℝ), (-z.re : ℝ)]]) → ( + let α : ℝ := -(1 + (z.re : ℝ)) / 2 + let β : ℝ := (z.re : ℝ) / 2 + (∀ (a : ℤ), ((a * (a - 1) / 2 : ℤ) : ℝ) = (a : ℝ) * (a - 1 : ℝ) / 2) → (∀ (x : GaussianInt), + (↑(g x) : ℝ) - LatticeQuadraticForm (CircleMatrix C) x = α * (↑x.re : ℝ) + β * (↑x.im : + ℝ))) := by + classical + intro C z g circle_formula α β half x + rw [circle_formula] + simp? [g, LatticeQuadraticForm, Matrix.mulVec, dotProduct] + rw [half x.re, half x.im] + rw [← GaussianInt.intCast_re z, ← GaussianInt.intCast_im z, + ← GaussianInt.intCast_re x, ← GaussianInt.intCast_im x] + dsimp [α, β] + ring + +end CurvatureOneProof + +theorem CurvatureOnePeriodicOdometer (C : BandCircle) + (z : GaussianInt) (hC : C.1.1 = (1, 1 + 2 * z)) : + let g : IntegerLatticeFunction := fun x => + (1 + z.re) * (x.re * (x.re - 1) / 2) - + z.re * (x.im * (x.im - 1) / 2) + z.im * x.re * x.im + let T : ProtoTile := ⟨{0}, 0⟩ + let h : PartialOdometer := CurvatureOneOdometer z + BandPrototile C.1.1 T ∧ TileOdometer C.1.1 T h ∧ + (h.domain : Set GaussianInt) = FootprintVertices T ∧ + (∀ x, x ∈ h.domain → g x = h.value x) ∧ + GlobalOdometerExtends g h ∧ + IntegerSuperharmonicRepresentative (CircleMatrix C) g ∧ + (∀ v, v ∈ TilingLattice C → ∃ a : GaussianInt, + Matrix.mulVec (CircleMatrix C) ![(v.re : ℝ), (v.im : ℝ)] = + ![(a.re : ℝ), (a.im : ℝ)] ∧ + ∀ x, g (x + v) = g x + x.re * a.re + x.im * a.im + g v) ∧ + ∃ b : ℝ × ℝ, ∀ v, v ∈ TilingLattice C → ∀ x, + (g (x + v) : ℝ) - LatticeQuadraticForm (CircleMatrix C) (x + v) - + (b.1 * (x + v).re + b.2 * (x + v).im) = + (g x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x - + (b.1 * x.re + b.2 * x.im) := by +-- BODY + dsimp + let g : IntegerLatticeFunction := fun x => + (1 + z.re) * (x.re * (x.re - 1) / 2) - + z.re * (x.im * (x.im - 1) / 2) + z.im * x.re * x.im + let T : ProtoTile := ⟨{0}, 0⟩ + let h : PartialOdometer := CurvatureOneOdometer z + have triangular (a b : ℤ) : + (a + b) * (a + b - 1) / 2 = a * (a - 1) / 2 + b * (b - 1) / 2 + a * b := + CurvatureOneProof.triangular a b + have hcoord : C.1.1 = (1, 1 + 2 * z) := hC + have hradius : C.1.1.1 = 1 := by rw [hcoord] + have hcenter : C.1.1.2 = 1 + 2 * z := by rw [hcoord] + have hne0 : (0 : GaussianInt) ≠ 1 + ⟨0, 1⟩ := by + intro hbad + have him := congrArg (fun q : GaussianInt => q.im) hbad + norm_num at him + have hne1 : (⟨0, 1⟩ : GaussianInt) ≠ 0 := by + intro hbad + have him := congrArg (fun q : GaussianInt => q.im) hbad + norm_num at him + have circle_formula : CircleMatrix C = + ![![((1 + z.re : ℤ) : ℝ), (z.im : ℝ)], + ![(z.im : ℝ), (-z.re : ℝ)]] := CurvatureOneProof.circle_formula C z hradius hcenter + have triangular_real (a b : ℤ) : + (((a + b) * (a + b - 1) / 2 : ℤ) : ℝ) = + ((a * (a - 1) / 2 : ℤ) : ℝ) + + ((b * (b - 1) / 2 : ℤ) : ℝ) + (a * b : ℝ) := by + exact_mod_cast triangular a b + have linear_difference (x : GaussianInt) : + (g x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x = + (-(1 + (z.re : ℝ)) / 2) * x.re + ((z.re : ℝ) / 2) * x.im := + CurvatureOneProof.linear_difference C z circle_formula x + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [hcoord] + exact BandPrototile.unit z 0 0 + · rw [hcoord] + apply TileOdometer.unit z 0 T h + · rfl + · ext x + simp [h, T, CurvatureOneOdometer, FootprintVertices] + · refine ⟨0, 0, 0, ?_, ?_⟩ + · intro x + simp [h, CurvatureOneOdometer] + · intro x hx + simp [h, CurvatureOneOdometer] at hx ⊢ + · ext x + simp [CurvatureOneOdometer, FootprintVertices] + · intro x hx + simp? [CurvatureOneOdometer] at hx ⊢ + rcases hx with rfl | rfl | rfl | rfl <;> simp [hne0, hne1] + · refine ⟨0, ?_⟩ + intro x hx + simp? [CurvatureOneOdometer] at hx ⊢ + rcases hx with rfl | rfl | rfl | rfl <;> simp [hne0, hne1] + · unfold IntegerSuperharmonicRepresentative + constructor + · unfold Matrix.IsSymm + rw [circle_formula] + ext i j; fin_cases i <;> fin_cases j <;> rfl + constructor + · unfold QuadraticGrowthAtInfinity + intro ε hε + let α : ℝ := -(1 + (z.re : ℝ)) / 2 + let β : ℝ := (z.re : ℝ) / 2 + have half (a : ℤ) : + ((a * (a - 1) / 2 : ℤ) : ℝ) = + (a : ℝ) * (a - 1 : ℝ) / 2 := by + have he : Even (a * (a - 1)) := Int.even_mul_pred_self a + have hh := Int.two_mul_ediv_two_of_even he + apply (eq_div_iff (by norm_num : (2 : ℝ) ≠ 0)).2 + have hh' : a * (a - 1) / 2 * 2 = a * (a - 1) := by + simpa [mul_comm] using hh + exact_mod_cast hh' + have difference (x : GaussianInt) : + (g x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x = + α * x.re + β * x.im := CurvatureOneProof.difference C z circle_formula half x + let K : ℝ := |α| ^ 2 + |β| ^ 2 + refine ⟨(2 * K / ε ^ 2) + 1, ?_⟩ + intro x hx + have hx0 : 0 ≤ (x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2 := by positivity + have ha : |α * (x.re : ℝ)| ≤ ε / 4 * (x.re : ℝ) ^ 2 + |α| ^ 2 / ε := by + have heq : ε / 4 * (x.re : ℝ) ^ 2 + |α| ^ 2 / ε = + (ε ^ 2 * (x.re : ℝ) ^ 2 / 4 + |α| ^ 2) / ε := by field_simp + rw [heq] + apply (le_div_iff₀ hε).2 + rw [abs_mul] + have hs := sq_nonneg (ε * |(x.re : ℝ)| - 2 * |α|) + have habs : |(x.re : ℝ)| ^ 2 = (x.re : ℝ) ^ 2 := sq_abs _ + nlinarith + have hb : |β * (x.im : ℝ)| ≤ ε / 4 * (x.im : ℝ) ^ 2 + |β| ^ 2 / ε := by + have heq : ε / 4 * (x.im : ℝ) ^ 2 + |β| ^ 2 / ε = + (ε ^ 2 * (x.im : ℝ) ^ 2 / 4 + |β| ^ 2) / ε := by field_simp + rw [heq] + apply (le_div_iff₀ hε).2 + rw [abs_mul] + have hs := sq_nonneg (ε * |(x.im : ℝ)| - 2 * |β|) + have habs : |(x.im : ℝ)| ^ 2 = (x.im : ℝ) ^ 2 := sq_abs _ + nlinarith + have habs : |α * x.re + β * x.im| ≤ + ε / 4 * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) + K / ε := by + calc + _ ≤ |α * (x.re : ℝ)| + |β * (x.im : ℝ)| := abs_add_le _ _ + _ ≤ (ε / 4 * (x.re : ℝ) ^ 2 + |α| ^ 2 / ε) + + (ε / 4 * (x.im : ℝ) ^ 2 + |β| ^ 2 / ε) := add_le_add ha hb + _ = _ := by dsimp [K]; ring + rw [difference] + have hrel : ε ^ 2 * (K / ε ^ 2) = K := by field_simp + have hrel2 : ε * (K / ε) = K := by field_simp + have hbound : K / ε ≤ ε * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) / 2 := by + have hK : 0 ≤ K := by dsimp [K]; positivity + have hmul := mul_le_mul_of_nonneg_right hx (by positivity : 0 ≤ ε / 2) + calc + K / ε ≤ K / ε + ε / 2 := le_add_of_nonneg_right (by positivity) + _ = (2 * K / ε ^ 2 + 1) * (ε / 2) := by field_simp + _ ≤ ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) * (ε / 2) := hmul + _ = ε * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) / 2 := by ring + nlinarith [habs, hbound] + · intro x + simp? [FourNeighborLaplacian] + have hp : (x.re + 1) * x.re / 2 = x.re * (x.re - 1) / 2 + 1 * 0 / 2 + x.re * 1 := by + convert triangular x.re 1 using 1 <;> ring + have hm : (x.re - 1) * (x.re - 1 - 1) / 2 = x.re * (x.re - 1) / 2 + (-1) * (-1 - 1) / 2 + + x.re * (-1) := by + convert triangular x.re (-1) using 1; ring + have hpi : (x.im + 1) * x.im / 2 = x.im * (x.im - 1) / 2 + 1 * 0 / 2 + x.im * 1 := by + convert triangular x.im 1 using 1 <;> ring + have hmi : (x.im - 1) * (x.im - 1 - 1) / 2 = x.im * (x.im - 1) / 2 + (-1) * (-1 - 1) / 2 + + x.im * (-1) := by + convert triangular x.im (-1) using 1; ring + rw [hp, hm, hpi, hmi] + ring_nf + omega + · intro v hv + have hvtop : v ∈ (⊤ : AddSubgroup GaussianInt) := by + trivial + have hlat : TilingLattice C = ⊤ := by + simp [TilingLattice, hcoord] + rw [hlat] at hv + refine ⟨⟨(1 + z.re) * v.re + z.im * v.im, z.im * v.re - z.re * v.im⟩, ?_, ?_⟩ + · rw [circle_formula] + simp? [] + rw [← GaussianInt.intCast_re z, ← GaussianInt.intCast_im z, + ← GaussianInt.intCast_re v, ← GaussianInt.intCast_im v] + ext i; fin_cases i <;> simp [Matrix.mulVec, dotProduct] + ring + · intro x + simp? [] + rw [triangular x.re v.re, triangular x.im v.im] + ring + · refine ⟨(-(1 + (z.re : ℝ)) / 2, (z.re : ℝ) / 2), ?_⟩ + intro v hv x + have hshift := linear_difference (x + v) + have hbase := linear_difference x + calc + (g (x + v) : ℝ) - LatticeQuadraticForm (CircleMatrix C) (x + v) - + (-(1 + (z.re : ℝ)) / 2 * (x + v).re + (z.re : ℝ) / 2 * (x + v).im) = + 0 := by rw [hshift]; ring + _ = (g x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x - + (-(1 + (z.re : ℝ)) / 2 * x.re + (z.re : ℝ) / 2 * x.im) := by + rw [hbase] + ring + _ = _ := by rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CurvatureOneTileBase.lean b/LeanPool/ApollonianSuperharmonic/CurvatureOneTileBase.lean new file mode 100644 index 0000000000..bd0df82c22 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CurvatureOneTileBase.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.ExactTileTiling +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.RegularTileFamily +public import LeanPool.ApollonianSuperharmonic.TileArea +public import LeanPool.ApollonianSuperharmonic.TilingLattice + +-- [TABLET NODE: CurvatureOneTileBase] + +/-! +# CurvatureOneTileBase + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem CurvatureOneTileBase (C : BandCircle) (hC : C.1.1.1 = 1) : + ∃ T : ProtoTile, + LatticeTile T ∧ TileArea T = 1 ∧ QuarterTurnSymmetric T ∧ + ExactTileTiling (RegularTileFamily T (TilingLattice C)) := by +-- BODY + let T : ProtoTile := ⟨{0}, 0⟩ + have lattice : TilingLattice C = ⊤ := by + simp [TilingLattice, hC] + have hT : LatticeTile T := by + have hunit : FordTile 1 = T := by + have zero_coordinates : (⟨0, 0⟩ : GaussianInt) = 0 := rfl + simp [T, FordTile, FordCellDomain, zero_coordinates] + simpa only [hunit] using (FordTileGeometry 1 (by omega)).1 + refine ⟨T, hT, ?_, ?_, ?_⟩ + · simp [T, TileArea] + · unfold QuarterTurnSymmetric + intro p + norm_num [T, TileRealization, TileCentroid, ClosedSquareRealization] + constructor <;> intro hp + · rcases hp with ⟨⟨hp1, hp2⟩, ⟨hp3, hp4⟩⟩ + constructor <;> constructor <;> linarith + · rcases hp with ⟨⟨hp1, hp2⟩, ⟨hp3, hp4⟩⟩ + constructor <;> constructor <;> linarith + · unfold ExactTileTiling RegularTileFamily + rw [lattice] + constructor + · intro U hU + rcases hU with ⟨u, hu, rfl⟩ + exact (TileDiskAreaCovariance T u).1.mp hT + · intro x + refine ⟨TileTranslation T x, ⟨x, trivial, rfl⟩, ?_, ?_⟩ + · simp [T, TileTranslation, GaussianTranslation] + · intro U hU hx + rcases hU with ⟨u, hu, rfl⟩ + have equality : x = u := by + simpa [T, TileTranslation, GaussianTranslation] using hx + subst x + rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondBaseT1.lean b/LeanPool/ApollonianSuperharmonic/DiamondBaseT1.lean new file mode 100644 index 0000000000..5967f22e1b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondBaseT1.lean @@ -0,0 +1,256 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain +public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.DiamondTileGeometry +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileArea +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk +public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.P5116T1UnitDeletionDisk +public import LeanPool.ApollonianSuperharmonic.P5116T1PredecessorDeletionDisk +public import LeanPool.ApollonianSuperharmonic.P3092T1CenteredRectangleDisk +public import LeanPool.ApollonianSuperharmonic.LatticeTileDiskUnionInterface +public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance + +-- [TABLET NODE: DiamondBaseT1] + +/-! +# DiamondBaseT1 + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem DiamondBaseT1 (K : DiamondParameter) + (S : Fin 3 → Bool → ProtoTile) + (hS : ∀ i s, BandSubtileOccurrence (DiamondRecursiveQuadruple K) + (DiamondTile K.1) i s (S i s)) + (hunion : ∀ x, x ∈ (DiamondTile K.1).cells ↔ + ∃ i s, x ∈ (S i s).cells) : + LatticeTile (DiamondTile K.1) ∧ + TileArea (DiamondTile K.1) = + Int.toNat ((DiamondRecursiveQuadruple K) 0).1 ∧ + ∀ i s, LatticeTile (TileCellComplement (DiamondTile K.1) (S i s)) ∧ + TileTouching (TileCellComplement (DiamondTile K.1) (S i s)) + (S i s) := by +-- BODY + classical + have hk := K.2 + have hgeometry := DiamondTileGeometry K.1 hk + have harea : TileArea (DiamondTile K.1) = + Int.toNat ((DiamondRecursiveQuadruple K) 0).1 := by + rw [hgeometry.2] + change 2 * K.1 * (K.1 + 1) = (2 * (K.1 : Int) * ((K.1 : Int) + 1)).toNat + have he : ((2 * K.1 * (K.1 + 1) : Nat) : Int) = + 2 * (K.1 : Int) * ((K.1 : Int) + 1) := by push_cast; rfl + rw [← he, Int.toNat_natCast] + obtain ⟨_, R, hR, _, h00, h01, h10, h11, h20, h21⟩ := + DiamondTileRecursiveIdentification K + have identify (i : Fin 3) (s : Bool) : + (S i s).cells = (R i s).cells ∧ + ((S i s).cells = ∅ → (S i s).anchor = (R i s).anchor) := by + apply BandPrototileCentroidUnique _ _ _ (hS i s).1 (hR i s).1 + exact sub_left_inj.mp ((hS i s).2.2.trans (hR i s).2.2.symm) + have cell_mem (k : Nat) (z : GaussianInt) : + z ∈ (DiamondTile k).cells ↔ + 0 ≤ z.im ∧ z.im < 2 * (k : Int) ∧ + -(z.im + 1) ≤ z.re ∧ z.re < z.im + 1 ∧ + -(2 * (k : Int) - z.im) ≤ z.re ∧ z.re < 2 * (k : Int) - z.im := + (P4194T1DiamondCellRows k z).1 + have translated_mem (k : Nat) (z : GaussianInt) : + z ∈ (TileTranslation (DiamondTile k) ⟨0, 2⟩).cells ↔ + z - ⟨0, 2⟩ ∈ (DiamondTile k).cells := by + change z ∈ (DiamondTile k).cells.image (GaussianTranslation ⟨0, 2⟩) ↔ _ + constructor + · intro hz + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hy + · intro hz + exact Finset.mem_image.mpr ⟨z - ⟨0, 2⟩, hz, by simp [GaussianTranslation]⟩ + have root_ne : (DiamondTile K.1).cells.Nonempty := by + refine ⟨0, (cell_mem _ _).mpr ?_⟩ + norm_num + omega + have subset (i : Fin 3) (s : Bool) : (S i s).cells ⊆ (DiamondTile K.1).cells := by + intro z hz + exact (hunion z).mpr ⟨i, s, hz⟩ + have positive (i : Fin 3) (s : Bool) + (hU : LatticeTile (S i s)) + (hC : LatticeTile (TileCellComplement (DiamondTile K.1) (S i s))) + (hcommon : (FootprintEdges (TileCellComplement (DiamondTile K.1) (S i s)) ∩ + FootprintEdges (S i s)).Nonempty) : + LatticeTile (TileCellComplement (DiamondTile K.1) (S i s)) ∧ + TileTouching (TileCellComplement (DiamondTile K.1) (S i s)) (S i s) := by + let C := TileCellComplement (DiamondTile K.1) (S i s) + have hdisjoint : Disjoint C.cells (S i s).cells := by + apply Finset.disjoint_left.mpr + intro z hz hzS + exact (Finset.mem_sdiff.mp hz).2 hzS + have hwhole (z : LatticeCell) : z ∈ (DiamondTile K.1).cells ↔ + z ∈ C.cells ∨ z ∈ (S i s).cells := by + change z ∈ (DiamondTile K.1).cells ↔ + z ∈ (DiamondTile K.1).cells \ (S i s).cells ∨ z ∈ (S i s).cells + rw [Finset.mem_sdiff] + constructor + · tauto + · rintro (⟨hz, _⟩ | hz) + · exact hz + · exact subset i s hz + obtain ⟨_, ⟨x, y, p, hp, hp2, _, _, hv, hadj, he⟩, heq, hveq⟩ := + LatticeTileDiskUnionInterface C (S i s) (DiamondTile K.1) + hC hU hgeometry.1 hdisjoint hwhole hcommon + refine ⟨hC, Or.inl ⟨(LatticeTileFourNeighborConnected C hC).1, + (LatticeTileFourNeighborConnected (S i s) hU).1, hdisjoint, ?_⟩⟩ + rw [hveq, ← heq] + exact ⟨p, hp, hp2, hv, hadj, he⟩ + have unit_case (i : Fin 3) (s : Bool) (x : GaussianInt) + (hshape : (S i s).cells = {x}) + (hx : (x.re = -(K.1 : Int) ∨ x.re = (K.1 : Int) - 1) ∧ + (x.im = (K.1 : Int) - 1 ∨ x.im = (K.1 : Int))) : + LatticeTile (TileCellComplement (DiamondTile K.1) (S i s)) ∧ + TileTouching (TileCellComplement (DiamondTile K.1) (S i s)) (S i s) := by + have hU : LatticeTile (S i s) := by + have hd := P3092T1CenteredRectangleDisk {0} (by simp) + ((x.re : Real) + 1 / 2, (x.im : Real) + 1 / 2) + (fun _ => (1 / 2 : Real)) (fun _ => (1 / 2 : Real)) + (by intro j hj; norm_num) (by intro j hj; norm_num) + norm_num [LatticeTile, TileRealization, hshape, ClosedSquareRealization, + add_assoc] at hd ⊢ + exact hd + have hC := P5116T1UnitDeletionDisk K.1 hk x hx + (TileCellComplement (DiamondTile K.1) (S i s)) (by + change (DiamondTile K.1).cells \ (S i s).cells = _ + rw [hshape]) + apply positive i s hU hC + rcases hx.1 with hleft | hright + · have hn : x + 1 ∈ (TileCellComplement (DiamondTile K.1) (S i s)).cells := by + change x + 1 ∈ (DiamondTile K.1).cells \ (S i s).cells + rw [Finset.mem_sdiff, hshape, Finset.mem_singleton, cell_mem] + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one, + Zsqrtd.ext_iff] at * + rcases hx.2 with h | h <;> omega + refine ⟨{x + 1, x + 1 + ⟨0, 1⟩}, ?_, ?_⟩ + · exact ⟨x + 1, hn, Or.inr (Or.inl rfl)⟩ + · exact ⟨x, by simp [hshape], Or.inr (Or.inr (Or.inl rfl))⟩ + · have hn : x - 1 ∈ (TileCellComplement (DiamondTile K.1) (S i s)).cells := by + change x - 1 ∈ (DiamondTile K.1).cells \ (S i s).cells + rw [Finset.mem_sdiff, hshape, Finset.mem_singleton, cell_mem] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, + Zsqrtd.ext_iff] at * + rcases hx.2 with h | h <;> omega + refine ⟨{x, x + ⟨0, 1⟩}, ?_, ?_⟩ + · refine ⟨x - 1, hn, Or.inr (Or.inr (Or.inl ?_))⟩ + simp + · exact ⟨x, by simp [hshape], Or.inr (Or.inl rfl)⟩ + refine ⟨hgeometry.1, harea, ?_⟩ + intro i s + fin_cases i + · cases s + · apply unit_case 0 false ⟨(K.1 : Int) - 1, (K.1 : Int)⟩ + ((identify 0 false).1.trans (congrArg ProtoTile.cells h01)) + exact ⟨Or.inr rfl, Or.inr rfl⟩ + · apply unit_case 0 true ⟨-(K.1 : Int), (K.1 : Int) - 1⟩ + ((identify 0 true).1.trans (congrArg ProtoTile.cells h00)) + exact ⟨Or.inl rfl, Or.inl rfl⟩ + · cases s + · apply unit_case 1 false ⟨-(K.1 : Int), (K.1 : Int)⟩ + ((identify 1 false).1.trans (congrArg ProtoTile.cells h11)) + exact ⟨Or.inl rfl, Or.inr rfl⟩ + · apply unit_case 1 true ⟨(K.1 : Int) - 1, (K.1 : Int) - 1⟩ + ((identify 1 true).1.trans (congrArg ProtoTile.cells h10)) + exact ⟨Or.inr rfl, Or.inl rfl⟩ + · change LatticeTile (TileCellComplement (DiamondTile K.1) (S 2 s)) ∧ + TileTouching (TileCellComplement (DiamondTile K.1) (S 2 s)) (S 2 s) + have hshape : (S 2 s).cells = + (if s then TileTranslation (DiamondTile (K.1 - 1)) ⟨0, 2⟩ + else DiamondTile (K.1 - 1)).cells := by + rw [(identify 2 s).1] + cases s + · exact congrArg ProtoTile.cells h20 + · exact congrArg ProtoTile.cells h21 + by_cases hp : 1 < K.1 + · have hU : LatticeTile (S 2 s) := by + unfold LatticeTile TileRealization + rw [hshape] + have hprev := (DiamondTileGeometry (K.1 - 1) (by omega)).1 + cases s + · exact hprev + · exact (TileDiskAreaCovariance (DiamondTile (K.1 - 1)) ⟨0, 2⟩).1.mp hprev + have hC := P5116T1PredecessorDeletionDisk K.1 hp s + (TileCellComplement (DiamondTile K.1) (S 2 s)) (by + change (DiamondTile K.1).cells \ (S 2 s).cells = _ + rw [hshape]) + apply positive 2 s hU hC + let z : GaussianInt := ⟨0, if s then 2 else 2 * (K.1 : Int) - 2⟩ + have hzout : (if s then z - ⟨0, 1⟩ else z) ∈ + (TileCellComplement (DiamondTile K.1) (S 2 s)).cells := by + change (if s then z - ⟨0, 1⟩ else z) ∈ + (DiamondTile K.1).cells \ (S 2 s).cells + rw [Finset.mem_sdiff, hshape] + cases s <;> simp only [Bool.false_eq_true, ↓reduceIte, + cell_mem, translated_mem, Zsqrtd.re_sub, Zsqrtd.im_sub] <;> + norm_num [z] <;> omega + have hzin : (if s then z else z - ⟨0, 1⟩) ∈ (S 2 s).cells := by + rw [hshape] + cases s <;> simp only [Bool.false_eq_true, ↓reduceIte, + cell_mem, translated_mem, Zsqrtd.re_sub, Zsqrtd.im_sub] <;> + norm_num [z] <;> omega + refine ⟨{z, z + 1}, ?_, ?_⟩ + · cases s + · exact ⟨z, hzout, Or.inl rfl⟩ + · refine ⟨z - ⟨0, 1⟩, hzout, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 + · cases s + · refine ⟨z - ⟨0, 1⟩, hzin, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> abel + · exact ⟨z, hzin, Or.inl rfl⟩ + · have hk1 : K.1 = 1 := by omega + have hempty : (S 2 s).cells = ∅ := by + rw [hshape, hk1] + cases s <;> simp [DiamondTile, DiamondCellDomain, TileTranslation] + have hcomp : TileCellComplement (DiamondTile K.1) (S 2 s) = DiamondTile K.1 := by + cases ht : DiamondTile K.1 + simp [TileCellComplement, hempty] + have hanchor : (S 2 s).anchor = (⟨0, if s then 2 else 0⟩ : GaussianInt) := by + rw [(identify 2 s).2 hempty] + cases s + · rw [h20, hk1] + rfl + · rw [h21, hk1] + rfl + have hb : (S 2 s).anchor ∈ BoundaryFootprintVertices (DiamondTile K.1) := by + rw [hanchor, BoundaryFootprintVertices, ite_eq_left root_ne] + let z : GaussianInt := ⟨0, if s then 2 else 0⟩ + refine ⟨{z, z + 1}, ⟨z, Or.inl ⟨rfl, ?_⟩⟩, by simp [z]⟩ + cases s + · apply Or.inl + constructor <;> rw [cell_mem] <;> norm_num [z, hk1] + · apply Or.inr + constructor <;> rw [cell_mem] <;> norm_num [z, hk1] + rw [hcomp] + exact ⟨hgeometry.1, Or.inr (Or.inr ⟨hempty, hb⟩)⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondBaseT2.lean b/LeanPool/ApollonianSuperharmonic/DiamondBaseT2.lean new file mode 100644 index 0000000000..6bd70038b1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondBaseT2.lean @@ -0,0 +1,441 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.DiamondParameter +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric + +-- [TABLET NODE: DiamondBaseT2] + +/-! +# DiamondBaseT2 + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiamondQuarterTurnConstruction + +private noncomputable abbrev k (K : DiamondParameter) : Nat := by + classical + exact K.1 + +private theorem hk (K : DiamondParameter) : 0 < (k K) := by + classical + let k : Nat := K.1 + dsimp only [DiamondQuarterTurnConstruction.k] at * + change (0 < k) + exact K.2 + +private theorem mem_domain (K : DiamondParameter) (z : GaussianInt) : z ∈ DiamondCellDomain (k K) ↔ + ∃ y : Nat, y < 2 * (k K) ∧ + (let r := Nat.min (y + 1) (2 * (k K) - y); + z.im = (y : Int) ∧ -(r : Int) ≤ z.re ∧ z.re < (r : Int)) := by + classical + let k : Nat := K.1 + dsimp only [DiamondQuarterTurnConstruction.k] at * + change (z ∈ DiamondCellDomain k ↔ + ∃ y : Nat, y < 2 * k ∧ + (let r := Nat.min (y + 1) (2 * k - y); + z.im = (y : Int) ∧ -(r : Int) ≤ z.re ∧ z.re < (r : Int))) + simp only [DiamondCellDomain, Finset.mem_biUnion, Finset.mem_range, + Finset.mem_image] + constructor + · rintro ⟨y, hy, j, hj, hz⟩ + refine ⟨y, hy, ?_⟩ + have hre := congrArg Zsqrtd.re hz + have him := congrArg Zsqrtd.im hz + simp? at hre him + have hj' : (j : Int) < 2 * ((y + 1).min (2 * k - y) : Int) := by + exact_mod_cast hj + norm_num [Nat.cast_min] at hre ⊢ + have hcast : ((2 * k - y : Nat) : Int) = 2 * (k : Int) - y := by omega + rw [hcast] at hre ⊢ + refine ⟨him.symm, ?_⟩ + have hmin1 : min ((y : Int) + 1) (2 * (k : Int) - y) ≤ (y : Int) + 1 := + min_le_left _ _ + have hmin2 : min ((y : Int) + 1) (2 * (k : Int) - y) ≤ 2 * (k : Int) - y := + min_le_right _ _ + have hj'' : (j : Int) < 2 * (min ((y : Int) + 1) (2 * (k : Int) - y)) := by + simpa [Nat.cast_min, hcast] using hj' + omega + · rintro ⟨y, hy, him, hbounds⟩ + rcases hbounds with ⟨hlo, hhi⟩ + let r := Nat.min (y + 1) (2 * k - y) + refine ⟨y, hy, ?_⟩ + refine ⟨(z.re + r).toNat, ?_, ?_⟩ + · omega + · apply Zsqrtd.ext + · have hnon : 0 ≤ z.re + (r : Int) := by omega + rw [Int.toNat_of_nonneg hnon] + simp [r] + · simp [him] + +private noncomputable abbrev domain (K : DiamondParameter) : Finset GaussianInt := by + classical + let k : Nat := K.1 + exact DiamondCellDomain k + +private theorem domain_nonempty (K : DiamondParameter) : (domain K).Nonempty := by + classical + let k : Nat := K.1 + have hk : 0 < k := hk K + have mem_domain (z : GaussianInt) : z ∈ DiamondCellDomain k ↔ + ∃ y : Nat, y < 2 * k ∧ + (let r := Nat.min (y + 1) (2 * k - y); + z.im = (y : Int) ∧ -(r : Int) ≤ z.re ∧ z.re < (r : Int)) := mem_domain K z + let domain : Finset GaussianInt := DiamondCellDomain k + change (domain.Nonempty) + refine ⟨(⟨0, 0⟩ : GaussianInt), ?_⟩ + rw [mem_domain] + refine ⟨0, by omega, ?_⟩ + norm_num + exact hk + +private noncomputable abbrev reflectX : GaussianInt → GaussianInt := by + classical + exact fun z => (⟨-z.re - 1, z.im⟩ : GaussianInt) + +private noncomputable abbrev reflectY (K : DiamondParameter) : GaussianInt → GaussianInt := by + classical + let k : Nat := K.1 + exact fun z => (⟨z.re, 2 * (k : Int) - 1 - z.im⟩ : GaussianInt) + +private theorem reflectX_mem (K : DiamondParameter) (z : GaussianInt) (hz : z ∈ (domain K)) : + reflectX z ∈ (domain K) := by + classical + let k : Nat := K.1 + have mem_domain (z : GaussianInt) : z ∈ DiamondCellDomain k ↔ + ∃ y : Nat, y < 2 * k ∧ + (let r := Nat.min (y + 1) (2 * k - y); + z.im = (y : Int) ∧ -(r : Int) ≤ z.re ∧ z.re < (r : Int)) := mem_domain K z + let domain : Finset GaussianInt := DiamondCellDomain k + let reflectX : GaussianInt → GaussianInt := + fun z => (⟨-z.re - 1, z.im⟩ : GaussianInt) + change (reflectX z ∈ domain) + rw [mem_domain] at hz ⊢ + rcases hz with ⟨y, hy, him, hlo, hhi⟩ + norm_num [Nat.cast_min] at hlo hhi ⊢ + refine ⟨y, hy, ?_, ?_, ?_⟩ + · simp [reflectX, him] + · simp [reflectX] + omega + · simp [reflectX] + omega + +private theorem reflectY_mem (K : DiamondParameter) (z : GaussianInt) (hz : z ∈ (domain K)) : + (reflectY K) z ∈ (domain K) := by + classical + let k : Nat := K.1 + have mem_domain (z : GaussianInt) : z ∈ DiamondCellDomain k ↔ + ∃ y : Nat, y < 2 * k ∧ + (let r := Nat.min (y + 1) (2 * k - y); + z.im = (y : Int) ∧ -(r : Int) ≤ z.re ∧ z.re < (r : Int)) := mem_domain K z + let domain : Finset GaussianInt := DiamondCellDomain k + let reflectY : GaussianInt → GaussianInt := + fun z => (⟨z.re, 2 * (k : Int) - 1 - z.im⟩ : GaussianInt) + change (reflectY z ∈ domain) + rw [mem_domain] at hz ⊢ + rcases hz with ⟨y, hy, him, hlo, hhi⟩ + have hypos : y ≤ 2 * k := Nat.le_of_lt_succ (by omega) + have hcast : ((2 * k - y : Nat) : Int) = 2 * (k : Int) - y := by omega + have hlo' : -min ((y : Int) + 1) (2 * (k : Int) - y) ≤ z.re := by + simpa [Nat.cast_min, hcast] using hlo + have hhi' : z.re < min ((y : Int) + 1) (2 * (k : Int) - y) := by + simpa [Nat.cast_min, hcast] using hhi + have hr : (2 * k - 1 - y + 1).min (2 * k - (2 * k - 1 - y)) = + (y + 1).min (2 * k - y) := by + have hfirst : 2 * k - 1 - y + 1 = 2 * k - y := by omega + have hsecond : 2 * k - (2 * k - 1 - y) = y + 1 := by omega + rw [hfirst, hsecond] + exact Nat.min_comm _ _ + refine ⟨2 * k - 1 - y, by omega, ?_, ?_, ?_⟩ + · simp? [reflectY] + have hsub : ((2 * k - 1 - y : Nat) : Int) = 2 * (k : Int) - 1 - y := by omega + rw [hsub] + omega + · rw [hr] + change -(Nat.min (y + 1) (2 * k - y) : Int) ≤ z.re + exact hlo + · rw [hr] + change z.re < (Nat.min (y + 1) (2 * k - y) : Int) + exact hhi + +private theorem sum_re_reflect (K : DiamondParameter) : (domain K).sum (fun z => z.re) = + (domain K).sum (fun z => (reflectX z).re) := by + classical + let k : Nat := K.1 + let domain : Finset GaussianInt := DiamondCellDomain k + let reflectX : GaussianInt → GaussianInt := + fun z => (⟨-z.re - 1, z.im⟩ : GaussianInt) + have reflectX_mem (z : GaussianInt) (hz : z ∈ domain) : reflectX z ∈ domain := reflectX_mem K z hz + change (domain.sum (fun z => z.re) = + domain.sum (fun z => (reflectX z).re)) + apply Finset.sum_bij (fun z hz => reflectX z) + · exact fun z hz => reflectX_mem z hz + · intro z hz w hw heq + apply Zsqrtd.ext + · simp [reflectX] at heq ⊢ + omega + · simp? [reflectX] at heq ⊢ + exact heq.2 + · intro z hz + refine ⟨reflectX z, reflectX_mem z hz, ?_⟩ + apply Zsqrtd.ext <;> simp [reflectX] + · intro z hz + simp [reflectX] + +private theorem sum_re_formula (K : DiamondParameter) : (domain K).sum (fun z => z.re) * 2 = + -((domain K).card : Int) := by + classical + let k : Nat := K.1 + let domain : Finset GaussianInt := DiamondCellDomain k + let reflectX : GaussianInt → GaussianInt := + fun z => (⟨-z.re - 1, z.im⟩ : GaussianInt) + have sum_re_reflect : domain.sum (fun z => z.re) = + domain.sum (fun z => (reflectX z).re) := sum_re_reflect K + change (domain.sum (fun z => z.re) * 2 = + -(domain.card : Int)) + have hsum := sum_re_reflect + simp only [reflectX] at hsum + rw [Finset.sum_sub_distrib, Finset.sum_const] at hsum + simp at hsum + linarith + +private theorem sum_im_reflect (K : DiamondParameter) : (domain K).sum (fun z => z.im) = + (domain K).sum (fun z => ((reflectY K) z).im) := by + classical + let k : Nat := K.1 + let domain : Finset GaussianInt := DiamondCellDomain k + let reflectY : GaussianInt → GaussianInt := + fun z => (⟨z.re, 2 * (k : Int) - 1 - z.im⟩ : GaussianInt) + have reflectY_mem (z : GaussianInt) (hz : z ∈ domain) : reflectY z ∈ domain := reflectY_mem K z hz + change (domain.sum (fun z => z.im) = + domain.sum (fun z => (reflectY z).im)) + apply Finset.sum_bij (fun z hz => reflectY z) + · exact fun z hz => reflectY_mem z hz + · intro z hz w hw heq + apply Zsqrtd.ext + · simp? [reflectY] at heq ⊢ + exact heq.1 + · simp [reflectY] at heq ⊢ + omega + · intro z hz + refine ⟨reflectY z, reflectY_mem z hz, ?_⟩ + apply Zsqrtd.ext <;> simp [reflectY] + · intro z hz + simp [reflectY] + +private theorem sum_im_formula (K : DiamondParameter) : (domain K).sum (fun z => z.im) * 2 = + (2 * ((k K) : Int) - 1) * (domain K).card := by + classical + let k : Nat := K.1 + let domain : Finset GaussianInt := DiamondCellDomain k + let reflectY : GaussianInt → GaussianInt := + fun z => (⟨z.re, 2 * (k : Int) - 1 - z.im⟩ : GaussianInt) + have sum_im_reflect : domain.sum (fun z => z.im) = + domain.sum (fun z => (reflectY z).im) := sum_im_reflect K + dsimp only [DiamondQuarterTurnConstruction.k] at * + change (domain.sum (fun z => z.im) * 2 = + (2 * (k : Int) - 1) * domain.card) + have hsum := sum_im_reflect + simp only [reflectY] at hsum + rw [Finset.sum_sub_distrib, Finset.sum_const] at hsum + simp at hsum + linarith + +private theorem centroid_formula (K : DiamondParameter) : TileCentroid (DiamondTile (k K)) = (0, + ((k K) : Real)) := by + classical + let k : Nat := K.1 + let domain : Finset GaussianInt := DiamondCellDomain k + have domain_nonempty : domain.Nonempty := domain_nonempty K + have sum_re_formula : domain.sum (fun z => z.re) * 2 = + -(domain.card : Int) := sum_re_formula K + have sum_im_formula : domain.sum (fun z => z.im) * 2 = + (2 * (k : Int) - 1) * domain.card := sum_im_formula K + dsimp only [DiamondQuarterTurnConstruction.k] at * + change (TileCentroid (DiamondTile k) = (0, (k : Real))) + change (if domain.Nonempty then + (((domain.sum (fun z => z.re) : Int) : Real) / domain.card + (1 / 2 : Real), + ((domain.sum (fun z => z.im) : Int) : Real) / domain.card + (1 / 2 : Real)) + else _) = _ + rw [ite_eq_left domain_nonempty] + apply Prod.ext <;> dsimp + · have hc : (0 : Real) < domain.card := by exact_mod_cast domain_nonempty.card_pos + have hs : ((domain.sum (fun z => z.re) : Int) : Real) * 2 = + -(domain.card : Real) := by exact_mod_cast sum_re_formula + field_simp + linarith + · have hc : (0 : Real) < domain.card := by exact_mod_cast domain_nonempty.card_pos + have hs : ((domain.sum (fun z => z.im) : Int) : Real) * 2 = + (2 * (k : Real) - 1) * domain.card := by exact_mod_cast sum_im_formula + field_simp + linarith + +private noncomputable abbrev rotate (K : DiamondParameter) : GaussianInt → GaussianInt := by + classical + let k : Nat := K.1 + exact fun z => (⟨(k : Int) - 1 - z.im, z.re + k⟩ : GaussianInt) + +private theorem rotate_mem (K : DiamondParameter) (z : GaussianInt) (hz : z ∈ (domain K)) : + (rotate K) z ∈ (domain K) := by + classical + let k : Nat := K.1 + have mem_domain (z : GaussianInt) : z ∈ DiamondCellDomain k ↔ + ∃ y : Nat, y < 2 * k ∧ + (let r := Nat.min (y + 1) (2 * k - y); + z.im = (y : Int) ∧ -(r : Int) ≤ z.re ∧ z.re < (r : Int)) := mem_domain K z + let domain : Finset GaussianInt := DiamondCellDomain k + let rotate : GaussianInt → GaussianInt := + fun z => (⟨(k : Int) - 1 - z.im, z.re + k⟩ : GaussianInt) + change (rotate z ∈ domain) + rw [mem_domain] at hz ⊢ + rcases hz with ⟨y, hy, him, hlo, hhi⟩ + have hrk : ((y + 1).min (2 * k - y) : Int) ≤ (k : Int) := by + norm_num [Nat.cast_min] + by_cases hycenter : y < k <;> omega + have hnon : 0 ≤ z.re + (k : Int) := by omega + let yn : Nat := (z.re + (k : Int)).toNat + have hyn : (yn : Int) = z.re + (k : Int) := by + dsimp [yn] + rw [Int.toNat_of_nonneg hnon] + have hynlt : yn < 2 * k := by omega + refine ⟨yn, hynlt, ?_, ?_, ?_⟩ + · dsimp [rotate] + rw [hyn] + · dsimp [rotate] + norm_num [Nat.cast_min] at hlo hhi ⊢ + by_cases hycenter : y < k <;> by_cases hxneg : z.re < 0 <;> omega + · dsimp [rotate] + norm_num [Nat.cast_min] at hlo hhi ⊢ + by_cases hycenter : y < k <;> by_cases hxneg : z.re < 0 <;> omega + +private theorem rotate_injective (K : DiamondParameter) : Set.InjOn (rotate K) ((domain K) : Set + GaussianInt) := by + classical + let k : Nat := K.1 + let domain : Finset GaussianInt := DiamondCellDomain k + let rotate : GaussianInt → GaussianInt := + fun z => (⟨(k : Int) - 1 - z.im, z.re + k⟩ : GaussianInt) + change (Set.InjOn rotate (domain : Set GaussianInt)) + intro z hz w hw heq + apply Zsqrtd.ext + · have h := congrArg Zsqrtd.im heq + simp [rotate] at h + omega + · have h := congrArg Zsqrtd.re heq + simp [rotate] at h + omega + +private theorem rotate_surjective (K : DiamondParameter) (z : GaussianInt) (hz : z ∈ (domain K)) : + ∃ w ∈ (domain K), (rotate K) w = z := by + classical + let k : Nat := K.1 + let domain : Finset GaussianInt := DiamondCellDomain k + let rotate : GaussianInt → GaussianInt := + fun z => (⟨(k : Int) - 1 - z.im, z.re + k⟩ : GaussianInt) + have rotate_mem (z : GaussianInt) (hz : z ∈ domain) : rotate z ∈ domain := rotate_mem K z hz + have rotate_injective : Set.InjOn rotate (domain : Set GaussianInt) := rotate_injective K + change (∃ w ∈ domain, rotate w = z) + have himage : Finset.image rotate domain = domain := by + apply Finset.eq_of_subset_of_card_le + · intro a ha + rcases Finset.mem_image.mp ha with ⟨b, hb, rfl⟩ + exact rotate_mem b hb + · rw [Finset.card_image_iff.mpr rotate_injective] + have : z ∈ Finset.image rotate domain := by rw [himage]; exact hz + exact Finset.mem_image.mp this + +end DiamondQuarterTurnConstruction + +theorem DiamondBaseT2 (K : DiamondParameter) : + QuarterTurnSymmetric (DiamondTile K.1) := by +-- BODY + let k : Nat := K.1 + have hk : 0 < k := DiamondQuarterTurnConstruction.hk K + have mem_domain (z : GaussianInt) : z ∈ DiamondCellDomain k ↔ + ∃ y : Nat, y < 2 * k ∧ + (let r := Nat.min (y + 1) (2 * k - y); + z.im = (y : Int) ∧ -(r : Int) ≤ z.re ∧ z.re < (r : Int)) := + DiamondQuarterTurnConstruction.mem_domain K z + let domain : Finset GaussianInt := DiamondCellDomain k + have domain_nonempty : domain.Nonempty := DiamondQuarterTurnConstruction.domain_nonempty K + let reflectX : GaussianInt → GaussianInt := + fun z => (⟨-z.re - 1, z.im⟩ : GaussianInt) + let reflectY : GaussianInt → GaussianInt := + fun z => (⟨z.re, 2 * (k : Int) - 1 - z.im⟩ : GaussianInt) + have reflectX_mem (z : GaussianInt) (hz : z ∈ domain) : reflectX z ∈ domain := + DiamondQuarterTurnConstruction.reflectX_mem K z hz + have reflectY_mem (z : GaussianInt) (hz : z ∈ domain) : reflectY z ∈ domain := + DiamondQuarterTurnConstruction.reflectY_mem K z hz + have sum_re_reflect : domain.sum (fun z => z.re) = + domain.sum (fun z => (reflectX z).re) := DiamondQuarterTurnConstruction.sum_re_reflect K + have sum_re_formula : domain.sum (fun z => z.re) * 2 = + -(domain.card : Int) := DiamondQuarterTurnConstruction.sum_re_formula K + have sum_im_reflect : domain.sum (fun z => z.im) = + domain.sum (fun z => (reflectY z).im) := DiamondQuarterTurnConstruction.sum_im_reflect K + have sum_im_formula : domain.sum (fun z => z.im) * 2 = + (2 * (k : Int) - 1) * domain.card := DiamondQuarterTurnConstruction.sum_im_formula K + have centroid_formula : TileCentroid (DiamondTile k) = (0, (k : Real)) := + DiamondQuarterTurnConstruction.centroid_formula K + let rotate : GaussianInt → GaussianInt := + fun z => (⟨(k : Int) - 1 - z.im, z.re + k⟩ : GaussianInt) + have rotate_mem (z : GaussianInt) (hz : z ∈ domain) : rotate z ∈ domain := + DiamondQuarterTurnConstruction.rotate_mem K z hz + have rotate_injective : Set.InjOn rotate (domain : Set GaussianInt) := + DiamondQuarterTurnConstruction.rotate_injective K + have rotate_surjective (z : GaussianInt) (hz : z ∈ domain) : + ∃ w ∈ domain, rotate w = z := DiamondQuarterTurnConstruction.rotate_surjective K z hz + change QuarterTurnSymmetric (DiamondTile k) + unfold QuarterTurnSymmetric + rw [centroid_formula] + intro p + simp only [TileRealization, DiamondTile] + norm_num + change (∃ x ∈ domain, p ∈ ClosedSquareRealization x) ↔ + ∃ x ∈ domain, ((k : Real) - p.2, (k : Real) + p.1) ∈ + ClosedSquareRealization x + constructor + · rintro ⟨z, hz, hp⟩ + refine ⟨rotate z, rotate_mem z hz, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc] at hp ⊢ + change (((z.re : Int) : Real) ≤ p.1 ∧ ((z.im : Int) : Real) ≤ p.2) ∧ + (p.1 ≤ (z.re : Real) + 1 ∧ p.2 ≤ (z.im : Real) + 1) at hp + change (((((k : Int) - 1 - z.im : Int) : Real) ≤ (k : Real) - p.2 ∧ + (((z.re + k : Int) : Real) ≤ (k : Real) + p.1)) ∧ + ((k : Real) - p.2 ≤ (((k : Int) - 1 - z.im : Int) : Real) + 1 ∧ + (k : Real) + p.1 ≤ ((z.re + k : Int) : Real) + 1)) + push_cast at hp ⊢ + rcases hp with ⟨⟨h1, h2⟩, ⟨h3, h4⟩⟩ + constructor + · constructor <;> linarith + · constructor <;> linarith + · rintro ⟨z, hz, hq⟩ + obtain ⟨w, hw, hzw⟩ := rotate_surjective z hz + subst z + refine ⟨w, hw, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc] at hq ⊢ + change (((((k : Int) - 1 - w.im : Int) : Real) ≤ (k : Real) - p.2 ∧ + (((w.re + k : Int) : Real) ≤ (k : Real) + p.1)) ∧ + ((k : Real) - p.2 ≤ (((k : Int) - 1 - w.im : Int) : Real) + 1 ∧ + (k : Real) + p.1 ≤ ((w.re + k : Int) : Real) + 1)) at hq + change (((w.re : Int) : Real) ≤ p.1 ∧ ((w.im : Int) : Real) ≤ p.2) ∧ + (p.1 ≤ (w.re : Real) + 1 ∧ p.2 ≤ (w.im : Real) + 1) + push_cast at hq ⊢ + rcases hq with ⟨⟨h1, h2⟩, ⟨h3, h4⟩⟩ + constructor + · constructor <;> linarith + · constructor <;> linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondBaseTouching.lean b/LeanPool/ApollonianSuperharmonic/DiamondBaseTouching.lean new file mode 100644 index 0000000000..ce1261f01c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondBaseTouching.lean @@ -0,0 +1,147 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.P5124T1ParentPlacement +public import LeanPool.ApollonianSuperharmonic.P5124T1UnitParents +public import LeanPool.ApollonianSuperharmonic.P5124T1SmallerParents +public import LeanPool.ApollonianSuperharmonic.P5124T1EmptyParents +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality + +-- [TABLET NODE: DiamondBaseTouching] + +/-! +# DiamondBaseTouching + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem DiamondBaseTouching (K : DiamondParameter) : + let q := DiamondRecursiveQuadruple K + let T := DiamondTile K.1 + (∀ i : Fin 3, + TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) + (TileTranslation T (-BandVectors.1 (q ((i + 1).succ)) (q 0)))) ∧ + (∀ (i : Fin 3) (U : ProtoTile), BandPrototile (q i.succ) U → + TileCentroid U - TileCentroid T = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U) ∧ + (∀ (i : Fin 3) (U V : ProtoTile), + BandPrototile (q i.succ) U → + BandPrototile (q ((i + 1).succ)) V → + TileCentroid U - TileCentroid T = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TileCentroid V - TileCentroid T = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ)))) → + TouchingTriple T U V) := by +-- BODY + classical + dsimp only + let q := DiamondRecursiveQuadruple K + let D := DiamondTile K.1 + have touching_ext (A A' B B' : ProtoTile) + (hA : A.cells = A'.cells ∧ (A.cells = ∅ → A.anchor = A'.anchor)) + (hB : B.cells = B'.cells ∧ (B.cells = ∅ → B.anchor = B'.anchor)) : + TileTouching A B ↔ TileTouching A' B' := by + have oA := ProtoTileObservableExtensionality A A' hA.1 hA.2 + have oB := ProtoTileObservableExtensionality B B' hB.1 hB.2 + have hvA := oA.2.1 + have heA := oA.2.2.1 + have hvB := oB.2.1 + have heB := oB.2.2.1 + by_cases ha : A.cells = ∅ <;> by_cases hb : B.cells = ∅ <;> + simp_all [TileTouching, Finset.nonempty_iff_ne_empty] + have triple_ext (A B B' C C' : ProtoTile) + (hB : B.cells = B'.cells ∧ (B.cells = ∅ → B.anchor = B'.anchor)) + (hC : C.cells = C'.cells ∧ (C.cells = ∅ → C.anchor = C'.anchor)) : + TouchingTriple A B C ↔ TouchingTriple A B' C' := by + have hA : A.cells = A.cells ∧ (A.cells = ∅ → A.anchor = A.anchor) := + ⟨rfl, fun _ => rfl⟩ + have oB := ProtoTileObservableExtensionality B B' hB.1 hB.2 + have oC := ProtoTileObservableExtensionality C C' hC.1 hC.2 + simp only [TouchingTriple, touching_ext A A B B' hA hB, + touching_ext B B' C C' hB hC, touching_ext C C' A A hC hA, + oB.2.1, oC.2.1] + obtain ⟨_, hq, hv0, hv1, hv2, _⟩ := DiamondCoordinateConfiguration K + obtain ⟨t0, t1, t2⟩ := P5124T1TranslatedDiamonds K.1 K.2 + obtain ⟨u0, u1, u2⟩ := P5124T1UnitParents K.1 K.2 + have more : + TouchingTriple D (TileTranslation D ⟨0, -(2 * (K.1 : Int))⟩) + (P5124T1ParentModel K.1 2 true) ∧ + TouchingTriple D (P5124T1ParentModel K.1 1 true) + (P5124T1ParentModel K.1 2 false) ∧ + TouchingTriple D (P5124T1ParentModel K.1 2 true) + (P5124T1ParentModel K.1 0 false) := by + by_cases hk : 1 < K.1 + · exact P5124T1SmallerParents K.1 hk + · have hk1 : K.1 = 1 := by have := K.2; omega + simpa [D, hk1] using P5124T1EmptyParents + have t4 (i : Fin 3) : + TouchingTriple D (TileTranslation D (BandVectors.1 (q i.succ) (q 0))) + (P5124T1ParentModel K.1 i true) := by + fin_cases i + · simpa [q, hv0] using u0 + · simpa [q, hv1] using u1 + · simpa [q, hv2] using more.1 + have t5 (i : Fin 3) : + TouchingTriple D (P5124T1ParentModel K.1 i true) + (P5124T1ParentModel K.1 (i + 1) false) := by + fin_cases i + · exact u2 + · exact more.2.1 + · exact more.2.2 + refine ⟨?_, ?_, ?_⟩ + · intro i + have hn0 : -(⟨(K.1 : Int) + 1, (K.1 : Int)⟩ : GaussianInt) = + ⟨-(K.1 : Int) - 1, -(K.1 : Int)⟩ := by + ext <;> simp; ring + have hn1 : -(⟨-(K.1 : Int) - 1, (K.1 : Int)⟩ : GaussianInt) = + ⟨(K.1 : Int) + 1, -(K.1 : Int)⟩ := by + ext <;> simp; ring + have hn2 : -(⟨0, -(2 * (K.1 : Int))⟩ : GaussianInt) = + ⟨0, 2 * (K.1 : Int)⟩ := by + ext <;> simp + fin_cases i + · simpa [hv0, hv1, hn1] using t0 + · simpa [hv1, hv2, hn2] using t1 + · simpa [hv2, hv0, hn0] using t2 + · intro i U hU hc + obtain ⟨hp, hpc⟩ := P5124T1ParentPlacement K i true + have hcent : TileCentroid U = TileCentroid (P5124T1ParentModel K.1 i true) := by + exact sub_left_inj.mp (hc.trans hpc.symm) + have hobs := BandPrototileCentroidUnique _ _ _ hU hp hcent + exact (triple_ext D _ _ U _ ⟨rfl, fun _ => rfl⟩ hobs).mpr (t4 i) + · intro i U V hU hV hcU hcV + obtain ⟨hp, hpc⟩ := P5124T1ParentPlacement K i true + obtain ⟨hr, hrc⟩ := P5124T1ParentPlacement K (i + 1) false + have hcentU : TileCentroid U = TileCentroid (P5124T1ParentModel K.1 i true) := by + exact sub_left_inj.mp (hcU.trans hpc.symm) + have hcentV : TileCentroid V = + TileCentroid (P5124T1ParentModel K.1 (i + 1) false) := by + apply sub_left_inj.mp + exact hcV.trans (by simpa only [Bool.false_eq_true, ite_false, sub_eq_add_neg] + using hrc.symm) + have hoU := BandPrototileCentroidUnique _ _ _ hU hp hcentU + have hoV := BandPrototileCentroidUnique _ _ _ hV hr hcentV + exact (triple_ext D U _ V _ hoU hoV).mpr (t5 i) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondCellDomain.lean b/LeanPool/ApollonianSuperharmonic/DiamondCellDomain.lean new file mode 100644 index 0000000000..a1893f803f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondCellDomain.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FiniteTile + +-- [TABLET NODE: DiamondCellDomain] + +/-! +# DiamondCellDomain + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The diamond cell domain of parameter $k$ is the $2k$-row staircase +polyomino +$$ + D^{\mathrm D}_k= + \bigcup_{0\leq y<2k} + \{x+yi:-r_y\leq x + let r := Nat.min (y + 1) (2 * k - y) + (Finset.range (2 * r)).image fun j => + (⟨((j : Nat) : Int) - (r : Int), (y : Int)⟩ : GaussianInt) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondCoordinateConfiguration.lean b/LeanPool/ApollonianSuperharmonic/DiamondCoordinateConfiguration.lean new file mode 100644 index 0000000000..0d94d37477 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondCoordinateConfiguration.lean @@ -0,0 +1,818 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandCircle +public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple + +-- [TABLET NODE: DiamondCoordinateConfiguration] + +/-! +# DiamondCoordinateConfiguration + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiamondConfigurationProof + +private theorem semi : + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + ∀ n : Nat, SemiProperQuadruple (configuration n) := by + classical + intro configuration n + induction n with + | zero => + change SemiProperQuadruple + ![((2 * 1 * (1 + 1) : Nat), + ⟨2 * (1 : Int) ^ 2 - 1, 2 * (1 : Int) * (1 + 1)⟩), + (1, ⟨1, 2⟩), (1, 1), + ((2 * (1 - 1) * 1 : Nat), + ⟨2 * ((1 - 1 : Nat) : Int) ^ 2 - 1, + 2 * ((1 - 1 : Nat) : Int) * 1⟩)] + have constructed := + SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate + (SemiProperQuadruple.successor + (SemiProperQuadruple.rotate + (SemiProperQuadruple.base (0 : GaussianInt))))) + convert constructed using 1; + simp [Zsqrtd.ext_iff] + | succ n ih => + have next := SemiProperQuadruple.rotate + (SemiProperQuadruple.successor + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate ih))) + convert next using 1 + all_goals + simp only [configuration, DiamondRecursiveQuadruple, + Nat.cast_add, Nat.cast_mul, Nat.cast_one, Nat.cast_sub (by omega : 1 ≤ n + 1)] + norm_num + constructor + · ring + apply Zsqrtd.ext <;> simp <;> ring + +private theorem root10'At246 : + (BandVectors.1 ((0 : ℤ), (1 : GaussianInt)) ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * + ⟨(0 : ℤ), (1 : ℤ)⟩) = (-1 : GaussianInt)) → ((BandVectors.1 ((1 : ℤ), (1 : GaussianInt) + + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) ((0 : ℤ), (-1 : GaussianInt)) = (1 : + GaussianInt)) → ((BandVectors.1 (![((1 : ℤ), (1 : GaussianInt)), ((1 : ℤ), (1 : + GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩), ((0 : ℤ), (1 : GaussianInt)), ((0 + : ℤ), (-1 : GaussianInt))] (1 : Fin (4 : ℕ))) (![((1 : ℤ), (1 : GaussianInt)), ((1 : ℤ), + (1 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩), ((0 : ℤ), (1 : + GaussianInt)), ((0 : ℤ), (-1 : GaussianInt))] (0 : Fin (4 : ℕ))) = BandVectors.1 (![((1 : + ℤ), (1 : GaussianInt)), ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : + ℤ)⟩), ((0 : ℤ), (1 : GaussianInt)), ((0 : ℤ), (-1 : GaussianInt))] (1 : Fin (4 : ℕ))) + (![((1 : ℤ), (1 : GaussianInt)), ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : + ℤ), (1 : ℤ)⟩), ((0 : ℤ), (1 : GaussianInt)), ((0 : ℤ), (-1 : GaussianInt))] (3 : Fin (4 : + ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (![((1 : ℤ), (1 : GaussianInt)), ((1 : ℤ), (1 : + GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩), ((0 : ℤ), (1 : GaussianInt)), ((0 + : ℤ), (-1 : GaussianInt))] (2 : Fin (4 : ℕ))) (![((1 : ℤ), (1 : GaussianInt)), ((1 : ℤ), + (1 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩), ((0 : ℤ), (1 : + GaussianInt)), ((0 : ℤ), (-1 : GaussianInt))] (1 : Fin (4 : ℕ)))) → ((((1 : Int), 1 + 2 * + (⟨0, 1⟩ : GaussianInt)) = ((1 : Int), ⟨1, 2⟩)) → (BandVectors.1 (1, ⟨1, 2⟩) (1, 1) = + ⟨1, 1⟩)))) := by + classical + intro r21 r13 root10 coordU + simp? at root10 + try + change BandVectors.1 (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) (1, 1) = + BandVectors.1 (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) (0, -1) - + (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (0, 1) (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) at root10 + rw [r13, r21] at root10 + have e := congrArg (fun C : CircleCoordinates => + BandVectors.1 C (1, 1)) coordU + calc + BandVectors.1 (1, ⟨1, 2⟩) (1, 1) = + BandVectors.1 (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) (1, 1) := e.symm + _ = _ := by simpa [Zsqrtd.ext_iff] using root10 + +private theorem hxAt261 : + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + (BandVectors.1 ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) ((0 : + ℤ), (-1 : GaussianInt)) = (1 : GaussianInt)) → ((((1 : Int), 1 + 2 * (⟨0, 1⟩ : + GaussianInt)) = ((1 : Int), ⟨1, 2⟩)) → (BandVectors.1 (configuration 0 1) (configuration + 0 3) = + ⟨(1 : Int), 0⟩)) := by + classical + intro configuration r13 coordU + try + change BandVectors.1 (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) (0, -1) = + ⟨1, 0⟩ at r13 + have e := congrArg (fun C : CircleCoordinates => + BandVectors.1 C (0, -1)) coordU + calc + BandVectors.1 (configuration 0 1) (configuration 0 3) = + BandVectors.1 (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) (0, -1) := by + simpa [configuration, DiamondRecursiveQuadruple] + _ = _ := by simpa [e, Zsqrtd.ext_iff] using r13 + +private theorem hzval : + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + (BandVectors.1 (configuration (0 : ℕ) (3 : Fin (4 : ℕ))) (configuration (0 : ℕ) (2 : Fin (4 : + ℕ))) + ⟨(1 : ℤ), (0 : ℤ)⟩ + ⟨(-1 : ℤ), (1 : ℤ)⟩ = (0 : GaussianInt)) → (BandVectors.1 + (configuration 0 3) (configuration 0 2) = + ⟨0, -1⟩) := by + classical + intro configuration hz + rw [Zsqrtd.ext_iff] at hz ⊢ + constructor + · have h := hz.1 + norm_num at h ⊢ + linarith + · have h := hz.2 + norm_num at h ⊢ + linarith + +private theorem thirdVal : + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + ∀ (n : ℕ), (BandVectors.1 (configuration (n + (1 : ℕ)) (3 : Fin (4 : ℕ))) (configuration (n + + (1 : ℕ)) (2 : Fin (4 : ℕ))) + ⟨(↑n : ℤ) + (2 : ℤ), (↑n : ℤ) + (1 : ℤ)⟩ + ⟨(-1 : ℤ), (1 : + ℤ)⟩ = (0 : GaussianInt)) → (BandVectors.1 (configuration (n + 1) 3) + (configuration (n + 1) 2) = + ⟨-(n + 1 : Int), -(n + 2 : Int)⟩) := by + classical + intro configuration n third + rw [Zsqrtd.ext_iff] at third ⊢ + constructor + · have h := third.1 + norm_num at h ⊢ + linarith + · have h := third.2 + norm_num at h ⊢ + linarith + +private theorem thirdIncomingAt355 : + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + ∀ (n : ℕ), (BandVectors.1 (configuration n (1 : Fin (4 : ℕ))) (configuration n (0 : Fin (4 : + ℕ))) = ⟨(↑n : ℤ) + (2 : ℤ), (↑n : ℤ) + (1 : ℤ)⟩ ∧ BandVectors.1 (configuration n (2 : Fin + (4 : ℕ))) (configuration n (0 : Fin (4 : ℕ))) = ⟨-((↑n : ℤ) + (1 : ℤ)) - (1 : ℤ), (↑n : + ℤ) + (1 : ℤ)⟩ ∧ BandVectors.1 (configuration n (3 : Fin (4 : ℕ))) (configuration n (0 : + Fin (4 : ℕ))) = ⟨(0 : ℤ), -((2 : ℤ) * ((↑n : ℤ) + (1 : ℤ)))⟩ ∧ BandVectors.1 + (configuration n (1 : Fin (4 : ℕ))) (configuration n (3 : Fin (4 : ℕ))) = ⟨(↑n : ℤ) + (1 + : ℤ), (↑n : ℤ)⟩ ∧ BandVectors.1 (configuration n (2 : Fin (4 : ℕ))) (configuration n (1 : + Fin (4 : ℕ))) = ⟨(-1 : ℤ), (1 : ℤ)⟩ ∧ BandVectors.1 (configuration n (3 : Fin (4 : ℕ))) + (configuration n (2 : Fin (4 : ℕ))) = ⟨-(↑n : ℤ), -((↑n : ℤ) + (1 : ℤ))⟩) → + ((BandVectors.1 (configuration (n + (1 : ℕ)) (0 : Fin (4 : ℕ))) (configuration (n + (1 : + ℕ)) (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (configuration (n + + (1 : ℕ)) (Fin.succ (2 : Fin (3 : ℕ)))) (configuration (n + (1 : ℕ)) (0 : Fin (4 : ℕ)))) + → ((BandVectors.1 (configuration (n + (1 : ℕ)) (0 : Fin (4 : ℕ))) (configuration (n + (1 + : ℕ)) (3 : Fin (4 : ℕ))) = BandVectors.1 (configuration n (1 : Fin (4 : ℕ))) + (configuration n (0 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * ⟨-((↑n : ℤ) + (1 : ℤ)), -((↑n + : ℤ) + (2 : ℤ))⟩) → (BandVectors.1 (configuration (n + 1) 3) + (configuration (n + 1) 0) = + ⟨0, -(2 * (n + 2 : Int))⟩))) := by + classical + intro configuration n ih new30 fourth + have h := new30 + change BandVectors.1 (configuration (n + 1) 0) + (configuration (n + 1) 3) = + (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (configuration (n + 1) 3) + (configuration (n + 1) 0) at h + rw [fourth] at h + rw [ih.1] at h + simp [Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + constructor <;> linarith + +private theorem hxAt430 : + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + (BandVectors.2 ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) ((0 : + ℤ), (-1 : GaussianInt)) = ⟨(0 : ℤ), (1 : ℤ)⟩) → ((((1 : Int), 1 + 2 * (⟨0, 1⟩ : + GaussianInt)) = ((1 : Int), ⟨1, 2⟩)) → ((((0 : Int), (-1 : GaussianInt)) = ((0 : Int), + ⟨-1, 0⟩)) → (BandVectors.2 (configuration 0 1) (configuration 0 3) = + ⟨0, 1⟩))) := by + classical + intro configuration root13 coordU coordB + change BandVectors.2 (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) (0, -1) = + ⟨0, 1⟩ at root13 + have e := congrArg (fun C : CircleCoordinates => + BandVectors.2 C (0, -1)) coordU + have eB := congrArg (fun C : CircleCoordinates => + BandVectors.2 (1, ⟨1, 2⟩) C) coordB + calc + BandVectors.2 (configuration 0 1) (configuration 0 3) = + BandVectors.2 (1, ⟨1, 2⟩) (0, ⟨-1, 0⟩) := by + simp [configuration, DiamondRecursiveQuadruple] + _ = BandVectors.2 (1, ⟨1, 2⟩) (0, -1) := eB.symm + _ = BandVectors.2 + (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) (0, -1) := e.symm + _ = _ := root13 + +private theorem hyAt446 : + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + (BandVectors.2 ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * (0 : GaussianInt)) ((1 : ℤ), + (1 : GaussianInt) + (2 : GaussianInt) * (0 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), + (1 : ℤ)⟩) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 ((1 : ℤ), (1 : GaussianInt) + (2 : + GaussianInt) * (0 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) ((1 : ℤ), (1 : + GaussianInt) + (2 : GaussianInt) * (0 : GaussianInt))) → ((((1 : Int), 1 + 2 * (⟨0, 1⟩ : + GaussianInt)) = ((1 : Int), ⟨1, 2⟩)) → ((BandVectors.2 (1, 1 + 2 * (⟨0, 1⟩ : + GaussianInt)) (1, 1) = 1) → (BandVectors.2 (configuration 0 2) (configuration 0 1) = + ⟨0, -1⟩))) := by + classical + intro configuration root01 coordU root10' + have hh := root01 + change BandVectors.2 (1, 1) (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) = + -(⟨0, 1⟩ : GaussianInt) * + BandVectors.2 (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) (1, 1) at hh + rw [root10'] at hh + have e := congrArg (fun C : CircleCoordinates => + BandVectors.2 (1, 1) C) coordU + calc + BandVectors.2 (configuration 0 2) (configuration 0 1) = + BandVectors.2 (1, 1) (1, ⟨1, 2⟩) := by + simp [configuration, DiamondRecursiveQuadruple] + _ = BandVectors.2 + (1, 1) (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) := e.symm + _ = _ := by simpa [Zsqrtd.ext_iff] using hh + +private theorem cyclicThirdValAt467 : + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + (BandVectors.2 (configuration (0 : ℕ) (3 : Fin (4 : ℕ))) (configuration (0 : ℕ) (2 : Fin (4 : + ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ + ⟨(0 : ℤ), (-1 : ℤ)⟩ = (0 : GaussianInt)) → (BandVectors.2 + (configuration 0 3) + (configuration 0 2) = ⟨0, 0⟩) := by + classical + intro configuration cyclicThird + rw [Zsqrtd.ext_iff] at cyclicThird ⊢ + constructor + · have h := cyclicThird.1 + norm_num at h ⊢ + linarith + · have h := cyclicThird.2 + norm_num at h ⊢ + linarith + +private theorem thirdIncomingAt479 : + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + (BandVectors.1 (configuration (0 : ℕ) (0 : Fin (4 : ℕ))) (configuration (0 : ℕ) (Fin.succ (2 + : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (configuration (0 : ℕ) (Fin.succ (2 + : Fin (3 : ℕ)))) (configuration (0 : ℕ) (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (configuration + (0 : ℕ) (0 : Fin (4 : ℕ))) (configuration (0 : ℕ) (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.2 (configuration (0 : ℕ) (Fin.succ (2 : Fin (3 : ℕ)))) + (configuration (0 : ℕ) (0 : Fin (4 : ℕ)))) → ((BandVectors.2 (configuration (0 : ℕ) (0 : + Fin (4 : ℕ))) (configuration (0 : ℕ) (3 : Fin (4 : ℕ))) = ⟨(0 : ℤ), (1 : ℤ)⟩ - ⟨(0 : ℤ), + (1 : ℤ)⟩ * ⟨(0 : ℤ), (0 : ℤ)⟩) → (BandVectors.2 (configuration 0 3) + (configuration 0 0) = ⟨-1, 0⟩)) := by + classical + intro configuration qFlip fourth + have h := qFlip.2 + change BandVectors.2 (configuration 0 0) (configuration 0 3) = + -(⟨0, 1⟩ : GaussianInt) * + BandVectors.2 (configuration 0 3) (configuration 0 0) at h + rw [fourth] at h + rw [Zsqrtd.ext_iff] at h ⊢ + constructor <;> + norm_num [Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ <;> + linarith + +private theorem cyclicThirdValAt517 : + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + ∀ (n : ℕ), (BandVectors.2 (configuration (n + (1 : ℕ)) (3 : Fin (4 : ℕ))) (configuration (n + + (1 : ℕ)) (2 : Fin (4 : ℕ))) + ⟨(↑n : ℤ) + (1 : ℤ), (1 : ℤ)⟩ + ⟨(0 : ℤ), (-1 : ℤ)⟩ = (0 : + GaussianInt)) → (BandVectors.2 (configuration (n + 1) 3) + (configuration (n + 1) 2) = + ⟨-(n + 1 : Int), 0⟩) := by + classical + intro configuration n cyclicThird + rw [Zsqrtd.ext_iff] at cyclicThird ⊢ + constructor + · have h := cyclicThird.1 + norm_num at h ⊢ + linarith + · have h := cyclicThird.2 + norm_num at h ⊢ + linarith + +private theorem thirdIncomingAt532 : + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + ∀ (n : ℕ), (BandVectors.2 (configuration n (1 : Fin (4 : ℕ))) (configuration n (0 : Fin (4 : + ℕ))) = ⟨(↑n : ℤ) + (1 : ℤ), (1 : ℤ)⟩ ∧ BandVectors.2 (configuration n (2 : Fin (4 : ℕ))) + (configuration n (0 : Fin (4 : ℕ))) = ⟨(0 : ℤ), -((↑n : ℤ) + (1 : ℤ))⟩ ∧ BandVectors.2 + (configuration n (3 : Fin (4 : ℕ))) (configuration n (0 : Fin (4 : ℕ))) = ⟨-((↑n : ℤ) + + (1 : ℤ)), (↑n : ℤ)⟩ ∧ BandVectors.2 (configuration n (3 : Fin (4 : ℕ))) (configuration n + (2 : Fin (4 : ℕ))) = ⟨-(↑n : ℤ), (0 : ℤ)⟩ ∧ BandVectors.2 (configuration n (1 : Fin (4 : + ℕ))) (configuration n (3 : Fin (4 : ℕ))) = ⟨(↑n : ℤ), (1 : ℤ)⟩ ∧ BandVectors.2 + (configuration n (2 : Fin (4 : ℕ))) (configuration n (1 : Fin (4 : ℕ))) = ⟨(0 : ℤ), (-1 : + ℤ)⟩) → ((BandVectors.1 (configuration (n + (1 : ℕ)) (0 : Fin (4 : ℕ))) (configuration (n + + (1 : ℕ)) (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 + (configuration (n + (1 : ℕ)) (Fin.succ (2 : Fin (3 : ℕ)))) (configuration (n + (1 : ℕ)) + (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (configuration (n + (1 : ℕ)) (0 : Fin (4 : ℕ))) + (configuration (n + (1 : ℕ)) (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (configuration (n + (1 : ℕ)) (Fin.succ (2 : Fin (3 : ℕ)))) (configuration + (n + (1 : ℕ)) (0 : Fin (4 : ℕ)))) → ((BandVectors.2 (configuration (n + (1 : ℕ)) (0 : Fin + (4 : ℕ))) (configuration (n + (1 : ℕ)) (3 : Fin (4 : ℕ))) = BandVectors.2 (configuration + n (1 : Fin (4 : ℕ))) (configuration n (0 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * ⟨-((↑n : + ℤ) + (1 : ℤ)), (0 : ℤ)⟩) → (BandVectors.2 (configuration (n + 1) 3) + (configuration (n + 1) 0) = + ⟨-(n + 2 : Int), (n + 1 : Int)⟩))) := by + classical + intro configuration n ih newFlip fourth + have h := newFlip.2 + change BandVectors.2 (configuration (n + 1) 0) + (configuration (n + 1) 3) = + -(⟨0, 1⟩ : GaussianInt) * + BandVectors.2 (configuration (n + 1) 3) + (configuration (n + 1) 0) at h + rw [fourth] at h + rw [ih.1] at h + simp [Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + constructor <;> linarith + +end DiamondConfigurationProof + +namespace DiamondConfigurationDetails + +private theorem currentSemi : + ∀ (K : DiamondParameter), + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + (∀ n : Nat, SemiProperQuadruple (configuration n)) → (SemiProperQuadruple + (DiamondRecursiveQuadruple + K)) := by + classical + intro K configuration semi + obtain ⟨k, hk⟩ := K + cases k with + | zero => omega + | succ n => simpa [configuration] using semi n + +private theorem circleWitness : + ∀ (K : DiamondParameter), (SemiProperQuadruple (DiamondRecursiveQuadruple K)) → (∃ C : + BandCircle, + C.1.1 = (DiamondRecursiveQuadruple K) 0) := by + classical + intro K currentSemi + refine ⟨⟨⟨(DiamondRecursiveQuadruple K) 0, ?_⟩, ?_⟩, rfl⟩ + · constructor + · simp? [DiamondRecursiveQuadruple] + exact Or.inl (by exact_mod_cast K.2) + · exact ⟨DiamondRecursiveQuadruple K, currentSemi, 0, rfl⟩ + · simp? [DiamondRecursiveQuadruple] + exact_mod_cast K.2 + +private theorem proper : + ∀ (K : DiamondParameter), (SemiProperQuadruple (DiamondRecursiveQuadruple K)) → + (ProperBandQuadruple (DiamondRecursiveQuadruple K)) := by + classical + intro K currentSemi + refine ⟨currentSemi, ?_⟩ + have hk : 0 < K.1 := K.2 + have hk' : 1 ≤ K.1 := by omega + have hsub : K.1 - 1 ≤ K.1 := Nat.sub_le _ _ + intro j + fin_cases j <;> simp [DiamondRecursiveQuadruple] + all_goals nlinarith + +private theorem properAt : + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + (∀ n : Nat, SemiProperQuadruple (configuration n)) → (∀ n : Nat, ProperBandQuadruple + (configuration + n)) := by + classical + intro configuration semi n + refine ⟨semi n, ?_⟩ + have hn : 0 < n + 1 := Nat.succ_pos n + have hsub : (n + 1) - 1 ≤ n + 1 := Nat.sub_le _ _ + intro j + fin_cases j <;> simp [configuration, DiamondRecursiveQuadruple] + all_goals nlinarith + +private theorem claims : + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + (∀ n : Nat, SemiProperQuadruple (configuration n)) → ((∀ (z : GaussianInt), have q := ![((1 : + ℤ), (1 + : GaussianInt) + (2 : GaussianInt) * z), ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) + * z + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩), ((0 : ℤ), (1 : GaussianInt)), ((0 : ℤ), + (-1 : GaussianInt))]; BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = (0 : + GaussianInt) ∧ BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (-1 : + GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = (1 : + GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = (1 : + GaussianInt) ∧ BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (-1 : + GaussianInt) - z - ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin + (4 : ℕ))) = z + ⟨(0 : ℤ), (1 : ℤ)⟩) → ((∀ (q : Fin (4 : ℕ) → CircleCoordinates), + SemiProperQuadruple q → BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ BandVectors.1 (q (0 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.2 (q (2 : Fin (4 + : ℕ))) (q (1 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (q (3 : Fin (4 : ℕ))) + (q (2 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → ((∀ (C : CircleCoordinates), + ∀ (D : CircleCoordinates), PrimitiveVectorOrientation C D → BandVectors.1 D C = ⟨(0 : ℤ), + (1 : ℤ)⟩ * BandVectors.1 C D ∧ BandVectors.2 D C = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 C + D) → ((∀ n : Nat, ProperBandQuadruple (configuration n)) → (∀ n : Nat, + BandVectors.1 (configuration n 1) (configuration n 0) = + ⟨(n + 2 : Int), (n + 1 : Int)⟩ ∧ + BandVectors.1 (configuration n 2) (configuration n 0) = + ⟨-(n + 1 : Int) - 1, (n + 1 : Int)⟩ ∧ + BandVectors.1 (configuration n 3) (configuration n 0) = + ⟨0, -(2 * (n + 1) : Int)⟩ ∧ + BandVectors.1 (configuration n 1) (configuration n 3) = + ⟨(n + 1 : Int), (n : Int)⟩ ∧ + BandVectors.1 (configuration n 2) (configuration n 1) = + ⟨-1, 1⟩ ∧ + BandVectors.1 (configuration n 3) (configuration n 2) = + ⟨-(n : Int), -(n + 1 : Int)⟩))))) := by + classical + intro configuration semi baseLaw stepLaw flipLaw properAt n + induction n with + | zero => + have root := baseLaw (0 : GaussianInt) + simp? at root + have rootStep := stepLaw + (![(1, 1), (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)), (0, 1), (0, -1)]) + (SemiProperQuadruple.base (0 : GaussianInt)) + have rootRec := VectorRecursionLaws + (![(1, 1), (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)), (0, 1), (0, -1)]) + (SemiProperQuadruple.base (0 : GaussianInt)) + have rootFlip := flipLaw _ _ (PrimitiveVectorOrientation.base10 0) + have qLaw := VectorRecursionLaws (configuration 0) (semi 0) + have qStep := stepLaw (configuration 0) (semi 0) + have qFlip := flipLaw _ _ + (PrimitiveVectorOrientation.parentChild (properAt 0) 2) + rcases root with ⟨r32, r21, r13, _, _, _⟩ + rcases rootStep with ⟨s20, s03, _, _⟩ + rcases rootRec with ⟨_, _, root10, _, _⟩ + rcases rootFlip with ⟨root01, _⟩ + rcases qLaw with ⟨sumv, _, q10, _, _⟩ + rcases qStep with ⟨q20, q03, _, _⟩ + have coordU : ((1 : Int), 1 + 2 * (⟨0, 1⟩ : GaussianInt)) = + ((1 : Int), ⟨1, 2⟩) := by + norm_num [Zsqrtd.ext_iff] + have coordU2 : ((1 : Int), 1 + 2 * (0 : GaussianInt) + + 2 * (⟨0, 1⟩ : GaussianInt)) = (1, ⟨1, 2⟩) := by + norm_num [Zsqrtd.ext_iff] + have coordB : ((0 : Int), (-1 : GaussianInt)) = + ((0 : Int), ⟨-1, 0⟩) := by rfl + have root10' := DiamondConfigurationProof.root10'At246 r21 r13 root10 coordU + have hx := DiamondConfigurationProof.hxAt261 r13 coordU + have hy : BandVectors.1 (configuration 0 2) (configuration 0 1) = + ⟨-1, 1⟩ := by + have hh := root01 + simp? at hh + change BandVectors.1 (1, 1) (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) = + (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) (1, 1) at hh + simp only [coordU, root10'] at hh + simpa [configuration, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] using hh + have ha := q10 + have hb := q20 + have hc := q03 + have hz := sumv + rw [hx, hy] at ha + rw [hx, hy] at hz + have hzval := DiamondConfigurationProof.hzval hz + rw [hy, hzval] at hb + rw [hx, hzval] at hc + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · simpa [configuration, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] using ha + · simpa [configuration, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] using hb + · have hd := qFlip.1 + have hdn : BandVectors.1 (configuration 0 0) (configuration 0 3) = + (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (configuration 0 3) (configuration 0 0) := by + simpa using hd + have hval := hdn + rw [hc] at hval + have hdval : BandVectors.1 (configuration 0 3) (configuration 0 0) = + ⟨0, -2⟩ := by + rw [Zsqrtd.ext_iff] at hval ⊢ + constructor <;> norm_num [Zsqrtd.re_mul, Zsqrtd.im_mul] at hval ⊢ <;> + linarith + simpa [configuration, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] using hdval + · simpa [configuration, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] using hx + · simpa [configuration, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] using hy + · simpa [configuration, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] using hzval + | succ n ih => + have newLaw := VectorRecursionLaws (configuration (n + 1)) (semi (n + 1)) + have newStep := stepLaw (configuration (n + 1)) (semi (n + 1)) + have newFlip := flipLaw _ _ + (PrimitiveVectorOrientation.parentChild (properAt (n + 1)) 2) + rcases newLaw with ⟨newSum, _, new10, _, _⟩ + rcases newStep with ⟨new20, new03, _, _⟩ + rcases newFlip with ⟨new30, _⟩ + have bridge13 : BandVectors.1 (configuration (n + 1) 1) + (configuration (n + 1) 3) = + BandVectors.1 (configuration n 1) (configuration n 0) := by + simp [configuration, DiamondRecursiveQuadruple] + have bridge21 : BandVectors.1 (configuration (n + 1) 2) + (configuration (n + 1) 1) = + BandVectors.1 (configuration n 2) (configuration n 1) := by + rfl + have first := new10 + rw [bridge13, bridge21, ih.1, ih.2.2.2.2.1] at first + have fifth := bridge21.trans ih.2.2.2.2.1 + have third := newSum + rw [bridge13, bridge21, ih.1, ih.2.2.2.2.1] at third + have thirdVal := DiamondConfigurationProof.thirdVal n third + have second := new20 + rw [fifth, thirdVal] at second + have fourth := new03 + rw [bridge13, thirdVal] at fourth + have thirdIncoming := DiamondConfigurationProof.thirdIncomingAt355 n ih new30 + fourth + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · have h := first + rw [Zsqrtd.ext_iff] at h ⊢ + constructor <;> + norm_num [Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ <;> linarith + · have h := second + rw [Zsqrtd.ext_iff] at h ⊢ + constructor <;> + norm_num [Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ <;> linarith + · convert thirdIncoming using 1; + simp []; ring + · convert ih.1 using 1; + simp []; ring + · simpa [Zsqrtd.ext_iff] using fifth + · convert thirdVal using 1; + simp []; ring + +private theorem slopeClaims : + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + (∀ n : Nat, SemiProperQuadruple (configuration n)) → ((∀ (z : GaussianInt), have q := ![((1 : + ℤ), (1 + : GaussianInt) + (2 : GaussianInt) * z), ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) + * z + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩), ((0 : ℤ), (1 : GaussianInt)), ((0 : ℤ), + (-1 : GaussianInt))]; BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = (0 : + GaussianInt) ∧ BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (-1 : + GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = (1 : + GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = (1 : + GaussianInt) ∧ BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (-1 : + GaussianInt) - z - ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin + (4 : ℕ))) = z + ⟨(0 : ℤ), (1 : ℤ)⟩) → ((∀ (q : Fin (4 : ℕ) → CircleCoordinates), + SemiProperQuadruple q → BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ BandVectors.1 (q (0 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.2 (q (2 : Fin (4 + : ℕ))) (q (1 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (q (3 : Fin (4 : ℕ))) + (q (2 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → ((∀ (C : CircleCoordinates), + ∀ (D : CircleCoordinates), PrimitiveVectorOrientation C D → BandVectors.1 D C = ⟨(0 : ℤ), + (1 : ℤ)⟩ * BandVectors.1 C D ∧ BandVectors.2 D C = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 C + D) → ((∀ n : Nat, ProperBandQuadruple (configuration n)) → (∀ n : Nat, + BandVectors.2 (configuration n 1) (configuration n 0) = + ⟨(n + 1 : Int), 1⟩ ∧ + BandVectors.2 (configuration n 2) (configuration n 0) = + ⟨0, -(n + 1 : Int)⟩ ∧ + BandVectors.2 (configuration n 3) (configuration n 0) = + ⟨-(n + 1 : Int), (n : Int)⟩ ∧ + BandVectors.2 (configuration n 3) (configuration n 2) = + ⟨-(n : Int), 0⟩ ∧ + BandVectors.2 (configuration n 1) (configuration n 3) = + ⟨(n : Int), 1⟩ ∧ + BandVectors.2 (configuration n 2) (configuration n 1) = + ⟨0, -1⟩))))) := by + classical + intro configuration semi baseLaw stepLaw flipLaw properAt n + induction n with + | zero => + have root := baseLaw (0 : GaussianInt) + simp? at root + have rootRec := VectorRecursionLaws + (![(1, 1), (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)), (0, 1), (0, -1)]) + (SemiProperQuadruple.base (0 : GaussianInt)) + have rootFlip := flipLaw _ _ (PrimitiveVectorOrientation.base10 0) + have qLaw := VectorRecursionLaws (configuration 0) (semi 0) + have qStep := stepLaw (configuration 0) (semi 0) + have qFlip := flipLaw _ _ + (PrimitiveVectorOrientation.parentChild (properAt 0) 2) + rcases root with ⟨_, _, _, _, root21, root13⟩ + rcases rootRec with ⟨_, _, _, root10, _⟩ + rcases rootFlip with ⟨_, root01⟩ + rcases qLaw with ⟨_, sumA, _, q10, _⟩ + rcases qStep with ⟨_, _, q20, q03⟩ + have coordU : ((1 : Int), 1 + 2 * (⟨0, 1⟩ : GaussianInt)) = + ((1 : Int), ⟨1, 2⟩) := by + norm_num [Zsqrtd.ext_iff] + have coordB : ((0 : Int), (-1 : GaussianInt)) = + ((0 : Int), ⟨-1, 0⟩) := by rfl + have root10' : + BandVectors.2 (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) (1, 1) = 1 := by + change BandVectors.2 (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) (1, 1) = + BandVectors.2 (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) (0, -1) + + (⟨0, 1⟩ : GaussianInt) * + BandVectors.2 (0, 1) (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) at root10 + rw [root13, root21] at root10 + simpa [Zsqrtd.ext_iff] using root10 + have hx := DiamondConfigurationProof.hxAt430 root13 coordU coordB + have hy := DiamondConfigurationProof.hyAt446 root01 coordU root10' + have first := q10 + have second := q20 + have fourth := q03 + have cyclicThird := sumA + rw [hx, hy] at first cyclicThird + have cyclicThirdVal := DiamondConfigurationProof.cyclicThirdValAt467 + cyclicThird + rw [hy, cyclicThirdVal] at second + rw [hx, cyclicThirdVal] at fourth + have thirdIncoming := DiamondConfigurationProof.thirdIncomingAt479 qFlip + fourth + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · simpa [configuration, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] using first + · simpa [configuration, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] using second + · simpa [configuration, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] using thirdIncoming + · simpa [configuration, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] using cyclicThirdVal + · simpa [configuration, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] using hx + · simpa [configuration, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] using hy + | succ n ih => + have newLaw := VectorRecursionLaws (configuration (n + 1)) (semi (n + 1)) + have newStep := stepLaw (configuration (n + 1)) (semi (n + 1)) + have newFlip := flipLaw _ _ + (PrimitiveVectorOrientation.parentChild (properAt (n + 1)) 2) + rcases newLaw with ⟨_, newSum, _, new10, _⟩ + rcases newStep with ⟨_, _, new20, new03⟩ + have bridge13 : BandVectors.2 (configuration (n + 1) 1) + (configuration (n + 1) 3) = + BandVectors.2 (configuration n 1) (configuration n 0) := by + simp [configuration, DiamondRecursiveQuadruple] + have bridge21 : BandVectors.2 (configuration (n + 1) 2) + (configuration (n + 1) 1) = + BandVectors.2 (configuration n 2) (configuration n 1) := by + rfl + have first := new10 + rw [bridge13, bridge21, ih.1, ih.2.2.2.2.2] at first + have sixth := bridge21.trans ih.2.2.2.2.2 + have cyclicThird := newSum + rw [bridge13, bridge21, ih.1, ih.2.2.2.2.2] at cyclicThird + have cyclicThirdVal := DiamondConfigurationProof.cyclicThirdValAt517 n cyclicThird + have second := new20 + rw [sixth, cyclicThirdVal] at second + have fourth := new03 + rw [bridge13, cyclicThirdVal] at fourth + have thirdIncoming := DiamondConfigurationProof.thirdIncomingAt532 n ih + newFlip fourth + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · have h := first + rw [Zsqrtd.ext_iff] at h ⊢ + constructor <;> + norm_num [Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ <;> linarith + · have h := second + rw [Zsqrtd.ext_iff] at h ⊢ + constructor <;> + norm_num [Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ <;> linarith + · exact thirdIncoming + · exact cyclicThirdVal + · convert ih.1 using 1; + simp [] + · exact sixth + +end DiamondConfigurationDetails + +theorem DiamondCoordinateConfiguration (K : DiamondParameter) : + (∃ C : BandCircle, C.1.1 = (DiamondRecursiveQuadruple K) 0) ∧ + ProperBandQuadruple (DiamondRecursiveQuadruple K) ∧ + BandVectors.1 ((DiamondRecursiveQuadruple K) 1) + ((DiamondRecursiveQuadruple K) 0) = + ⟨(K.1 + 1 : Int), (K.1 : Int)⟩ ∧ + BandVectors.1 ((DiamondRecursiveQuadruple K) 2) + ((DiamondRecursiveQuadruple K) 0) = + ⟨-(K.1 : Int) - 1, (K.1 : Int)⟩ ∧ + BandVectors.1 ((DiamondRecursiveQuadruple K) 3) + ((DiamondRecursiveQuadruple K) 0) = + ⟨0, -(2 * K.1 : Int)⟩ ∧ + BandVectors.2 ((DiamondRecursiveQuadruple K) 1) + ((DiamondRecursiveQuadruple K) 0) = + ⟨(K.1 : Int), 1⟩ ∧ + BandVectors.2 ((DiamondRecursiveQuadruple K) 2) + ((DiamondRecursiveQuadruple K) 0) = + ⟨0, -(K.1 : Int)⟩ ∧ + BandVectors.2 ((DiamondRecursiveQuadruple K) 3) + ((DiamondRecursiveQuadruple K) 0) = + ⟨-(K.1 : Int), (K.1 : Int) - 1⟩ ∧ + BandVectors.2 ((DiamondRecursiveQuadruple K) 3) + ((DiamondRecursiveQuadruple K) 2) = + ⟨1 - (K.1 : Int), 0⟩ ∧ + BandVectors.2 ((DiamondRecursiveQuadruple K) 1) + ((DiamondRecursiveQuadruple K) 3) = + ⟨(K.1 : Int) - 1, 1⟩ ∧ + BandVectors.2 ((DiamondRecursiveQuadruple K) 2) + ((DiamondRecursiveQuadruple K) 1) = + ⟨0, -1⟩ := by +-- BODY + let configuration (n : Nat) : Fin 4 → CircleCoordinates := + DiamondRecursiveQuadruple ⟨n + 1, Nat.succ_pos n⟩ + have semi := DiamondConfigurationProof.semi + have currentSemi : SemiProperQuadruple (DiamondRecursiveQuadruple K) := + DiamondConfigurationDetails.currentSemi K semi + have circleWitness : ∃ C : BandCircle, + C.1.1 = (DiamondRecursiveQuadruple K) 0 := DiamondConfigurationDetails.circleWitness K + currentSemi + have proper : ProperBandQuadruple (DiamondRecursiveQuadruple K) := + DiamondConfigurationDetails.proper K currentSemi + have systemLaw : RecursiveVectorSystem BandVectors := + by simpa [BandVectors] using (Classical.choose_spec RecursiveVectorsExistUnique).1 + rcases systemLaw with ⟨zeroLaw, baseLaw, stepLaw, flipLaw⟩ + have properAt : ∀ n : Nat, ProperBandQuadruple (configuration n) := + DiamondConfigurationDetails.properAt semi + have claims : ∀ n : Nat, + BandVectors.1 (configuration n 1) (configuration n 0) = + ⟨(n + 2 : Int), (n + 1 : Int)⟩ ∧ + BandVectors.1 (configuration n 2) (configuration n 0) = + ⟨-(n + 1 : Int) - 1, (n + 1 : Int)⟩ ∧ + BandVectors.1 (configuration n 3) (configuration n 0) = + ⟨0, -(2 * (n + 1) : Int)⟩ ∧ + BandVectors.1 (configuration n 1) (configuration n 3) = + ⟨(n + 1 : Int), (n : Int)⟩ ∧ + BandVectors.1 (configuration n 2) (configuration n 1) = + ⟨-1, 1⟩ ∧ + BandVectors.1 (configuration n 3) (configuration n 2) = + ⟨-(n : Int), -(n + 1 : Int)⟩ := DiamondConfigurationDetails.claims semi baseLaw stepLaw + flipLaw properAt + have slopeClaims : ∀ n : Nat, + BandVectors.2 (configuration n 1) (configuration n 0) = + ⟨(n + 1 : Int), 1⟩ ∧ + BandVectors.2 (configuration n 2) (configuration n 0) = + ⟨0, -(n + 1 : Int)⟩ ∧ + BandVectors.2 (configuration n 3) (configuration n 0) = + ⟨-(n + 1 : Int), (n : Int)⟩ ∧ + BandVectors.2 (configuration n 3) (configuration n 2) = + ⟨-(n : Int), 0⟩ ∧ + BandVectors.2 (configuration n 1) (configuration n 3) = + ⟨(n : Int), 1⟩ ∧ + BandVectors.2 (configuration n 2) (configuration n 1) = + ⟨0, -1⟩ := DiamondConfigurationDetails.slopeClaims semi baseLaw stepLaw flipLaw properAt + refine ⟨circleWitness, proper, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · obtain ⟨k, hk⟩ := K + cases k with + | zero => omega + | succ n => + simpa [configuration, Nat.cast_add, add_assoc] using (claims n).1 + · obtain ⟨k, hk⟩ := K + cases k with + | zero => omega + | succ n => + simpa [configuration, Nat.cast_add, add_assoc] using (claims n).2.1 + · obtain ⟨k, hk⟩ := K + cases k with + | zero => omega + | succ n => + simpa [configuration, Nat.cast_add, add_assoc] using (claims n).2.2.1 + · obtain ⟨k, hk⟩ := K + cases k with + | zero => omega + | succ n => + simpa [configuration, Nat.cast_add, add_assoc] using (slopeClaims n).1 + · obtain ⟨k, hk⟩ := K + cases k with + | zero => omega + | succ n => + simpa [configuration, Nat.cast_add, add_assoc] using (slopeClaims n).2.1 + · obtain ⟨k, hk⟩ := K + cases k with + | zero => omega + | succ n => + simpa [configuration, Nat.cast_add, add_assoc] using (slopeClaims n).2.2.1 + · obtain ⟨k, hk⟩ := K + cases k with + | zero => omega + | succ n => + simpa [configuration, Nat.cast_add, add_assoc] using (slopeClaims n).2.2.2.1 + · obtain ⟨k, hk⟩ := K + cases k with + | zero => omega + | succ n => + simpa [configuration, Nat.cast_add, add_assoc] using (slopeClaims n).2.2.2.2.1 + · obtain ⟨k, hk⟩ := K + cases k with + | zero => omega + | succ n => + simpa [configuration, Nat.cast_add, add_assoc] using (slopeClaims n).2.2.2.2.2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondExceptionalLattice.lean b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalLattice.lean new file mode 100644 index 0000000000..9d1aced1e4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalLattice.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondParameter +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction + +-- [TABLET NODE: DiamondExceptionalLattice] + +/-! +# DiamondExceptionalLattice + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $k>0$, the diamond exceptional period lattice is +$$ + L_k=\langle(0,-2k),(k+1,k)\rangle_{\mathbb Z}. +$$ +Its third displayed displacement $(-k-1,k)$ is the negative sum of the +two generators. +-/ +def DiamondExceptionalLattice (K : DiamondParameter) : AddSubgroup GaussianInt := +-- BODY + AddSubgroup.closure + {v | v = (⟨0, -(2 * K.1 : Int)⟩ : GaussianInt) ∨ + v = (⟨(K.1 + 1 : Int), (K.1 : Int)⟩ : GaussianInt)} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMatrixLatticeIdentification.lean b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMatrixLatticeIdentification.lean new file mode 100644 index 0000000000..78c8b339f1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMatrixLatticeIdentification.lean @@ -0,0 +1,150 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalLattice +public import LeanPool.ApollonianSuperharmonic.DiamondPeakMatrix +public import LeanPool.ApollonianSuperharmonic.IntegralityLattice + +-- [TABLET NODE: DiamondExceptionalMatrixLatticeIdentification] + +/-! +# DiamondExceptionalMatrixLatticeIdentification + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem DiamondExceptionalMatrixLatticeIdentification (K : DiamondParameter) + (C : BandCircle) (hC : C.1.1 = (DiamondRecursiveQuadruple K) 0) : + CircleMatrix C = DiamondPeakMatrix K ∧ + IntegralityLattice C = DiamondExceptionalLattice K := by +-- BODY + have hk : (0 : ℝ) < K.1 := by exact_mod_cast K.2 + have hmatrix : + CircleMatrix C = + let c : ℝ := C.1.1.1 + let x : ℝ := C.1.1.2.re + let y : ℝ := C.1.1.2.im + (2 * c)⁻¹ • ![![1 + x, y], ![y, 1 - x]] := by + ext i j + fin_cases i <;> fin_cases j <;> + simp [CircleMatrix, BandCircleEuclideanData] + all_goals field_simp + have matrixIdentity : CircleMatrix C = DiamondPeakMatrix K := by + ext i j + fin_cases i <;> fin_cases j <;> + simp [hmatrix, DiamondPeakMatrix, hC, DiamondRecursiveQuadruple] + <;> field_simp; ring + constructor + · exact matrixIdentity + · ext u + constructor + · intro hu + change ∀ i : Fin 2, ∃ n : ℤ, + Matrix.mulVec (CircleMatrix C) + ![((u.re : ℤ) : ℝ), ((u.im : ℤ) : ℝ)] i = (n : ℝ) at hu + rw [matrixIdentity] at hu + have first := hu 0 + have second := hu 1 + simp? [DiamondPeakMatrix, Matrix.mulVec] at first second + rcases first with ⟨n, first⟩ + rcases second with ⟨m, second⟩ + field_simp at first second + rw [← GaussianInt.intCast_re u, ← GaussianInt.intCast_im u] at first second + change (K.1 : ℝ) * (u.re : ℝ) + (K.1 + 1) * (u.im : ℝ) = + 2 * (K.1 + 1) * n at first + change (K.1 : ℝ) * (u.re : ℝ) + (u.im : ℝ) * (1 - K.1) = + 2 * K.1 * m at second + have firstZ : (K.1 : ℤ) * u.re + (K.1 + 1) * u.im = + 2 * (K.1 + 1) * n := by exact_mod_cast first + have secondZ : (K.1 : ℤ) * u.re + u.im * (1 - K.1) = + 2 * K.1 * m := by exact_mod_cast second + have copNat : (K.val + 1).Coprime K.val := by + simp [] + have cop : IsCoprime (K.1 + 1 : ℤ) K.1 := + Nat.Coprime.isCoprime copNat + have productDiv : (K.1 + 1 : ℤ) ∣ (K.1 : ℤ) * u.re := by + refine ⟨2 * n - u.im, ?_⟩ + linarith [firstZ] + have aDiv : (K.1 + 1 : ℤ) ∣ u.re := + cop.dvd_of_dvd_mul_left productDiv + obtain ⟨q, hq⟩ := aDiv + have bDiv : (K.1 : ℤ) ∣ u.im := by + refine ⟨2 * m - u.re + u.im, ?_⟩ + linarith [secondZ] + obtain ⟨t, ht⟩ := bDiv + have firstReduced : (K.1 : ℤ) * (q + t) = 2 * n := by + apply (mul_left_cancel₀ (show (K.1 + 1 : ℤ) ≠ 0 by omega)) + rw [hq, ht] at firstZ + linarith [firstZ] + have secondReduced : (K.1 + 1 : ℤ) * q + (1 - K.1) * t = 2 * m := by + have hkz : (K.1 : ℤ) ≠ 0 := by exact_mod_cast (Nat.ne_of_gt K.2) + apply (mul_left_cancel₀ hkz) + rw [hq, ht] at secondZ + linarith [secondZ] + have parity : q + t = 2 * (m - n + K.1 * t) := by + linarith [firstReduced, secondReduced] + have huform : u = q • (⟨(K.1 + 1 : ℤ), K.1⟩ : GaussianInt) + + (q - m + n - K.1 * t) • (⟨0, -(2 * K.1 : ℤ)⟩ : GaussianInt) := by + apply Zsqrtd.ext + · simp [hq]; ring + · simp [ht] + nlinarith [parity] + rw [huform] + apply (DiamondExceptionalLattice K).add_mem + · exact (DiamondExceptionalLattice K).zsmul_mem + (AddSubgroup.mem_closure_of_mem (by right; rfl)) q + · exact (DiamondExceptionalLattice K).zsmul_mem + (AddSubgroup.mem_closure_of_mem (by left; rfl)) (q - m + n - K.1 * t) + · intro hu + change u ∈ AddSubgroup.closure + {v | v = (⟨0, -(2 * K.1 : Int)⟩ : GaussianInt) ∨ + v = (⟨(K.1 + 1 : Int), (K.1 : Int)⟩ : GaussianInt)} at hu + induction hu using AddSubgroup.closure_induction with + | mem v hv => + change ∀ i : Fin 2, ∃ n : ℤ, + Matrix.mulVec (CircleMatrix C) + ![((v.re : ℤ) : ℝ), ((v.im : ℤ) : ℝ)] i = (n : ℝ) + rcases hv with rfl | rfl + · intro i + fin_cases i + · refine ⟨-(K.1 : ℤ), ?_⟩ + rw [matrixIdentity] + simp [DiamondPeakMatrix, Matrix.mulVec] + · refine ⟨(K.1 : ℤ) - 1, ?_⟩ + rw [matrixIdentity] + simp [DiamondPeakMatrix, Matrix.mulVec] + field_simp + ring + · intro i + fin_cases i + · refine ⟨(K.1 : ℤ), ?_⟩ + rw [matrixIdentity] + simp [DiamondPeakMatrix, Matrix.mulVec] + field_simp + ring + · refine ⟨1, ?_⟩ + rw [matrixIdentity] + simp [DiamondPeakMatrix, Matrix.mulVec] + field_simp + ring + | zero => + exact (IntegralityLattice C).zero_mem + | add x y hx hy ihx ihy => + exact (IntegralityLattice C).add_mem ihx ihy + | neg x hx ih => + exact (IntegralityLattice C).neg_mem ih + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean new file mode 100644 index 0000000000..7d14a8d41d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean @@ -0,0 +1,627 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation +public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalLattice +public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalMatrixLatticeIdentification +public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable +public import LeanPool.ApollonianSuperharmonic.DiamondOdometer +public import LeanPool.ApollonianSuperharmonic.DiamondOdometerExistsUnique +public import LeanPool.ApollonianSuperharmonic.DiamondParameter +public import LeanPool.ApollonianSuperharmonic.DiamondPeakMatrix +public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains +public import LeanPool.ApollonianSuperharmonic.FiniteAcyclicOrientationObstruction +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.P5435T1Cocycle +public import LeanPool.ApollonianSuperharmonic.P5435T1WebGeometry +public import LeanPool.ApollonianSuperharmonic.P5432T1EdgeLedger +public import Mathlib.Data.List.Chain + +-- [TABLET NODE: DiamondExceptionalMaximality] + +/-! +# DiamondExceptionalMaximality + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ExceptionalMaximalityProof + +private theorem hgen : + (by + classical + exact + ∀ (K : DiamondParameter), + let g := DiamondOdometer K + let a : GaussianInt := ⟨0, -(2 * K.1 : Int)⟩ + let b : GaussianInt := ⟨(K.1 + 1 : Int), (K.1 : Int)⟩ + ((∀ (x : GaussianInt), FourNeighborLaplacian (DiamondOdometer K) (x + ⟨(0 : ℤ), + (2 : ℤ) * (↑K.1 : ℤ)⟩) = FourNeighborLaplacian (DiamondOdometer K) x ∧ + FourNeighborLaplacian (DiamondOdometer K) (x + ⟨(↑K.1 : ℤ) + (1 : ℤ), (↑K.1 : ℤ)⟩) = + FourNeighborLaplacian (DiamondOdometer K) x) ∧ (∀ x ∈ DiamondVertexDomains K false, x + ∉ DiamondVertexDomains K true → FourNeighborLaplacian (DiamondOdometer K) x = (1 : + ℤ)) ∧ ∀ x ∈ DiamondVertexDomains K true, FourNeighborLaplacian (DiamondOdometer K) x + = (if Even (x.re + x.im) then (1 : ℤ) else (-1 : ℤ)) - if x.re = (0 : ℤ) then (1 : ℤ) + else (0 : ℤ)) → ( + let H : AddSubgroup GaussianInt := + { carrier := {v | ∀ x, FourNeighborLaplacian g (x+v) = FourNeighborLaplacian g x} + zero_mem' := by intro x; simp + add_mem' := by + intro u v hu hv x + rw [← add_assoc, hv, hu] + neg_mem' := by + intro v hv x + have h := hv (x-v) + rw [sub_add_cancel] at h + simpa only [sub_eq_add_neg] using h.symm } + {v : GaussianInt | v = a ∨ v = b} ⊆ H)) := by + classical + intro K g a b tab H v hv + rcases hv with rfl | rfl + · intro x + have h := (tab.1 (x+a)).1 + have he : x+a+⟨0, (2*K.1 : Int)⟩ = x := by + ext <;> simp [a] + rw [he] at h + exact h.symm + · intro x + exact (tab.1 x).2 + +private theorem periods : + (by + classical + exact + ∀ (K : DiamondParameter), + let g := DiamondOdometer K + let a : GaussianInt := ⟨0, -(2 * K.1 : Int)⟩ + let b : GaussianInt := ⟨(K.1 + 1 : Int), (K.1 : Int)⟩ + let H : AddSubgroup GaussianInt := + { carrier := {v | ∀ x, FourNeighborLaplacian g (x+v) = FourNeighborLaplacian g x} + zero_mem' := by intro x; simp + add_mem' := by + intro u v hu hv x + rw [← add_assoc, hv, hu] + neg_mem' := by + intro v hv x + have h := hv (x-v) + rw [sub_add_cancel] at h + simpa only [sub_eq_add_neg] using h.symm } + ({v : GaussianInt | v = a ∨ v = b} ⊆ H) → (∀ v ∈ DiamondExceptionalLattice K, ∀ x, + FourNeighborLaplacian g (x+v) = FourNeighborLaplacian g x) ) := by + classical + intro K g a b H hgen v hv + exact ((AddSubgroup.closure_le H).mpr hgen) hv + +private theorem bound : + (by + classical + exact + ∀ (K : DiamondParameter), + let g := DiamondOdometer K + let a : GaussianInt := ⟨0, -(2 * K.1 : Int)⟩ + let b : GaussianInt := ⟨(K.1 + 1 : Int), (K.1 : Int)⟩ + ((∀ (x : GaussianInt), FourNeighborLaplacian (DiamondOdometer K) (x + ⟨(0 : ℤ), (2 : ℤ) * + (↑K.1 : ℤ)⟩) = FourNeighborLaplacian (DiamondOdometer K) x ∧ FourNeighborLaplacian + (DiamondOdometer K) (x + ⟨(↑K.1 : ℤ) + (1 : ℤ), (↑K.1 : ℤ)⟩) = FourNeighborLaplacian + (DiamondOdometer K) x) ∧ (∀ x ∈ DiamondVertexDomains K false, x ∉ + DiamondVertexDomains K true → FourNeighborLaplacian (DiamondOdometer K) x = (1 : ℤ)) + ∧ ∀ x ∈ DiamondVertexDomains K true, FourNeighborLaplacian (DiamondOdometer K) x = + (if Even (x.re + x.im) then (1 : ℤ) else (-1 : ℤ)) - if x.re = (0 : ℤ) then (1 : ℤ) + else (0 : ℤ)) → ((a ∈ DiamondExceptionalLattice K) → ((b ∈ DiamondExceptionalLattice + K) → ((∀ v ∈ DiamondExceptionalLattice K, ∀ x, FourNeighborLaplacian g (x+v) = + FourNeighborLaplacian g x) → (∀ x, FourNeighborLaplacian g x ≤ 1)))) ) := by + classical + intro K g a b tab ha hb periods x + let D := DiamondVertexDomains K true + obtain ⟨p, hp, _⟩ := P4818T1Representatives K x + let v := p.2.1 • a + p.2.2 • b + have hv : v ∈ DiamondExceptionalLattice K := + (DiamondExceptionalLattice K).add_mem + ((DiamondExceptionalLattice K).zsmul_mem ha _) + ((DiamondExceptionalLattice K).zsmul_mem hb _) + have he : x = p.1+v := by + simpa only [v, a, b, neg_mul, add_assoc] using hp.2 + rw [he, periods v hv] + have hpT : p.1 ∈ DiamondVertexDomains K false := hp.1.1 + by_cases hi : p.1 ∈ D + · have h := tab.2.2 p.1 hi + dsimp [g] + rw [h] + split_ifs <;> omega + · exact le_of_eq (tab.2.1 p.1 hpT hi) + +private theorem hweb : + (by + classical + exact + ∀ (K : DiamondParameter), + let g := DiamondOdometer K + let D := DiamondVertexDomains K true + let S := DiamondVertexDomains K false \ D + let W : Set GaussianInt := + {x | ∃ v ∈ DiamondExceptionalLattice K, x - v ∈ S} + ((∀ (x : GaussianInt), FourNeighborLaplacian (DiamondOdometer K) (x + ⟨(0 : ℤ), (2 : ℤ) * + (↑K.1 : ℤ)⟩) = FourNeighborLaplacian (DiamondOdometer K) x ∧ FourNeighborLaplacian + (DiamondOdometer K) (x + ⟨(↑K.1 : ℤ) + (1 : ℤ), (↑K.1 : ℤ)⟩) = FourNeighborLaplacian + (DiamondOdometer K) x) ∧ (∀ x ∈ DiamondVertexDomains K false, x ∉ + DiamondVertexDomains K true → FourNeighborLaplacian (DiamondOdometer K) x = (1 : ℤ)) + ∧ ∀ x ∈ DiamondVertexDomains K true, FourNeighborLaplacian (DiamondOdometer K) x = + (if Even (x.re + x.im) then (1 : ℤ) else (-1 : ℤ)) - if x.re = (0 : ℤ) then (1 : ℤ) + else (0 : ℤ)) → ((∀ v ∈ DiamondExceptionalLattice K, ∀ x, FourNeighborLaplacian g + (x+v) = FourNeighborLaplacian g x) → (∀ w ∈ W, FourNeighborLaplacian g w = 1)) ) := by + classical + intro K g D S W tab periods + rintro w ⟨v, hv, hs⟩ + have h := periods v hv (w-v) + rw [sub_add_cancel] at h + exact h.trans (tab.2.1 (w-v) hs.1 hs.2) + +private theorem finD : + (by + classical + exact + ∀ (K : DiamondParameter), + let D := DiamondVertexDomains K true + D.Finite ) := by + classical + intro K D + let k : Int := K.1 + let box : Finset GaussianInt := + ((Finset.Icc (-k) k).product (Finset.Icc 0 (2*k))).image + (fun p : Int × Int => (⟨p.1, p.2⟩ : GaussianInt)) + apply box.finite_toSet.subset + intro x hx + change x.re.natAbs + (x.im-k).natAbs ≤ K.1-1 at hx + have hr := Int.natCast_natAbs x.re + have hi := Int.natCast_natAbs (x.im-k) + have hk : 0 < k := by dsimp [k]; exact_mod_cast K.2 + have hkdef : (K.1 : Int) = k := rfl + simp only [abs_eq_max_neg] at hr hi + change x ∈ box + dsimp only [box] + apply Finset.mem_image.mpr + refine ⟨(x.re,x.im), ?_, by ext <;> rfl⟩ + apply Finset.mem_product.mpr + constructor + · apply Finset.mem_Icc.mpr + constructor <;> omega + · apply Finset.mem_Icc.mpr + constructor <;> omega + +private theorem hD : + (by + classical + exact + ∀ (K : DiamondParameter), + let D := DiamondVertexDomains K true + ∀ (finD : D.Finite), + let Df := finD.toFinset + ∀ x, x ∈ Df ↔ x ∈ DiamondVertexDomains K true ) := by + classical + intro K D finD Df x + exact finD.mem_toFinset + +private theorem symm : + (by + classical + exact + ∀ x, ∀ y, FourNeighborAdjacent x y → FourNeighborAdjacent y x ) := by + classical + intro x y h + rcases h with rfl | rfl | rfl | rfl <;> + simp [FourNeighborAdjacent, add_assoc, add_comm, add_left_comm] + +private theorem meet : + (by + classical + exact + ∀ (K : DiamondParameter), + let D := DiamondVertexDomains K true + let S := DiamondVertexDomains K false \ D + let W : Set GaussianInt := + {x | ∃ v ∈ DiamondExceptionalLattice K, x - v ∈ S} + (FourNeighborConnected W ∧ ∀ x ∉ W, ∃ v ∈ DiamondExceptionalLattice K, ∀ (y : + GaussianInt), Relation.ReflTransGen (fun (u z : GaussianInt) => u ∉ W ∧ z ∉ W ∧ + FourNeighborAdjacent u z) x y → y - v ∈ D) → ((D.Finite) → (∀ (X : Set GaussianInt), + (X.Infinite) → ((FourNeighborConnected X) → ((X ∩ W).Nonempty)))) ) := by + classical + intro K D S W geom finD X hXin hXconn + by_contra hn + have hout : ∀ x ∈ X, x ∉ W := by + intro x hx hw + exact hn ⟨x, hx, hw⟩ + obtain ⟨x0, hx0⟩ := hXconn.1 + obtain ⟨v, hv, howner⟩ := geom.2 x0 (hout x0 hx0) + have hsub : X ⊆ (fun t => t+v) '' D := by + intro y hy + obtain ⟨p, hp, hlast, pall, padj⟩ := hXconn.2 x0 hx0 y hy + have hc : p.IsChain + (fun u z => u ∉ W ∧ z ∉ W ∧ FourNeighborAdjacent u z) := by + apply List.isChain_iff_forall_rel_of_append_cons_cons.mpr + intro u z l₁ l₂ he + refine ⟨hout u (pall u (by simp [he])), + hout z (pall z (by simp [he])), padj u z l₁ l₂ he⟩ + have hreach : Relation.ReflTransGen + (fun u z => u ∉ W ∧ z ∉ W ∧ FourNeighborAdjacent u z) x0 y := by + cases p with + | nil => simp at hp + | cons u p => + simp only [List.head?_cons, Option.some.injEq] at hp + subst u + exact List.relationReflTransGen_of_exists_isChain_cons p hc + (List.getLast_of_getLast?_eq_some hlast) + exact ⟨y-v, howner y hreach, sub_add_cancel y v⟩ + exact hXin.not_finite ((finD.image (fun t => t+v)).subset hsub) + +private theorem noCross : + (by + classical + exact + ∀ (K : DiamondParameter), + let g := DiamondOdometer K + let D := DiamondVertexDomains K true + let S := DiamondVertexDomains K false \ D + let W : Set GaussianInt := + {x | ∃ v ∈ DiamondExceptionalLattice K, x - v ∈ S} + (∀ w ∈ W, FourNeighborLaplacian g w = 1) → (∀ (X : Set GaussianInt), (∀ (x : + GaussianInt), FourNeighborLaplacian (fun (y : GaussianInt) => DiamondOdometer K y + + X.indicator ((fun _ : GaussianInt => (1 : ℤ))) y) x ≤ (1 : ℤ)) → (∀ w ∈ W, ∀ z, + FourNeighborAdjacent w z → z ∈ X → w ∈ X))) := by + classical + intro K g D S W hweb X hle w hw z hadj hz + by_contra hn + have ht := hweb w hw + dsimp only [g] at ht + have hh := hle w + rcases hadj with rfl | rfl | rfl | rfl + all_goals + simp only [FourNeighborLaplacian, Set.indicator_apply] at hh ht + simp only [ite_eq_left hz, ite_eq_right hn] at hh + split_ifs at hh <;> omega + +private theorem Wsub : + (by + classical + exact + ∀ (K : DiamondParameter), + let D := DiamondVertexDomains K true + let S := DiamondVertexDomains K false \ D + let W : Set GaussianInt := + {x | ∃ v ∈ DiamondExceptionalLattice K, x - v ∈ S} + (FourNeighborConnected W ∧ ∀ x ∉ W, ∃ v ∈ DiamondExceptionalLattice K, ∀ (y : + GaussianInt), Relation.ReflTransGen (fun (u z : GaussianInt) => u ∉ W ∧ z ∉ W ∧ + FourNeighborAdjacent u z) x y → y - v ∈ D) → (∀ (X : Set GaussianInt), (∀ x, ∀ y, + FourNeighborAdjacent x y → FourNeighborAdjacent y x) → (((X ∩ W).Nonempty) → ((∀ w ∈ + W, ∀ z, FourNeighborAdjacent w z → z ∈ X → w ∈ X) → (W ⊆ X)))) ) := by + classical + intro K D S W geom X symm meet noCross w hw + obtain ⟨x0, hx0, hx0W⟩ := meet + obtain ⟨p, hp, hlast, pall, padj⟩ := geom.1.2 x0 hx0W w hw + have hc : p.IsChain (fun u z => u ∈ W ∧ z ∈ W ∧ FourNeighborAdjacent u z) := by + apply List.isChain_iff_forall_rel_of_append_cons_cons.mpr + intro u z l₁ l₂ he + exact ⟨pall u (by simp [he]), pall z (by simp [he]), padj u z l₁ l₂ he⟩ + have hall : ∀ z ∈ p, z ∈ X := + hc.induction (fun z => z ∈ X) p + (fun {u z} he hu => noCross z he.2.1 u (symm u z he.2.2) hu) + (by + intro hn + have he : p.head hn = x0 := by + simpa only [List.head?_eq_some_head hn, Option.some.injEq] using hp + simpa only [he] using hx0) + exact hall w (by + rw [← List.getLast_of_getLast?_eq_some hlast] + exact List.getLast_mem (by intro he; simp [he] at hp)) + +private theorem Yout : + (by + classical + exact + ∀ (X : Set GaussianInt), ∀ (z : GaussianInt), (z ∉ X) → ( + let R := fun u t => u ∉ X ∧ t ∉ X ∧ FourNeighborAdjacent u t + let Y : Set GaussianInt := {y | Relation.ReflTransGen R z y} + ∀ y ∈ Y, y ∉ X) ) := by + classical + intro X z hz R Y y hy + induction hy with + | refl => exact hz + | tail h e ih => exact e.2.1 + +private theorem Ysub : + (by + classical + exact + ∀ (K : DiamondParameter), + let D := DiamondVertexDomains K true + let S := DiamondVertexDomains K false \ D + let W : Set GaussianInt := + {x | ∃ v ∈ DiamondExceptionalLattice K, x - v ∈ S} + ∀ (X : Set GaussianInt), (W ⊆ X) → (∀ (z : GaussianInt), + let R := fun u t => u ∉ X ∧ t ∉ X ∧ FourNeighborAdjacent u t + let Y : Set GaussianInt := {y | Relation.ReflTransGen R z y} + ∀ (v : GaussianInt), (∀ (y : GaussianInt), Relation.ReflTransGen (fun (u z : GaussianInt) + => u ∉ W ∧ z ∉ W ∧ FourNeighborAdjacent u z) z y → y - v ∈ D) → (∀ y ∈ Y, y-v ∈ D)) ) + := by + classical + intro K D S W X Wsub z R Y v howner y hy + apply howner y + exact Relation.ReflTransGen.mono (fun u t he => + ⟨fun hw => he.1 (Wsub hw), fun hw => he.2.1 (Wsub hw), he.2.2⟩) _ _ hy + +private theorem Yfin : + (by + classical + exact + ∀ (K : DiamondParameter), + let D := DiamondVertexDomains K true + (D.Finite) → (∀ (X : Set GaussianInt), ∀ (z : GaussianInt), + let R := fun u t => u ∉ X ∧ t ∉ X ∧ FourNeighborAdjacent u t + let Y : Set GaussianInt := {y | Relation.ReflTransGen R z y} + ∀ (v : GaussianInt), (∀ y ∈ Y, y-v ∈ D) → (Y.Finite)) ) := by + classical + intro K D finD X z R Y v Ysub + apply (finD.image (fun t => t+v)).subset + intro y hy + exact ⟨y-v, Ysub y hy, sub_add_cancel y v⟩ + +private theorem Zsub : + (by + classical + exact + ∀ (K : DiamondParameter), + let D := DiamondVertexDomains K true + ∀ (finD : D.Finite), + let Df := finD.toFinset + ∀ (X : Set GaussianInt), ∀ (z : GaussianInt), + let R := fun u t => u ∉ X ∧ t ∉ X ∧ FourNeighborAdjacent u t + let Y : Set GaussianInt := {y | Relation.ReflTransGen R z y} + ∀ (v : GaussianInt), (∀ y ∈ Y, y-v ∈ D) → (∀ (Yfin : Y.Finite), + let Z := Yfin.toFinset.image (fun y => y-v) + Z ⊆ Df) ) := by + classical + intro K D finD Df X z R Y v Ysub Yfin Z p hp + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hp + exact finD.mem_toFinset.mpr (Ysub y (Yfin.mem_toFinset.mp hy)) + +private theorem memZ : + (by + classical + exact + ∀ (X : Set GaussianInt), ∀ (z : GaussianInt), + let R := fun u t => u ∉ X ∧ t ∉ X ∧ FourNeighborAdjacent u t + let Y : Set GaussianInt := {y | Relation.ReflTransGen R z y} + ∀ (v : GaussianInt), ∀ (Yfin : Y.Finite), + let Z := Yfin.toFinset.image (fun y => y-v) + ∀ (t : GaussianInt), t ∈ Z ↔ t + v ∈ Y ) := by + classical + intro X z R Y v Yfin Z t + constructor + · intro ht + obtain ⟨y, hy, he⟩ := Finset.mem_image.mp ht + have he' : y=t+v := by rw [← he]; abel + simpa only [he'] using Yfin.mem_toFinset.mp hy + · intro ht + exact Finset.mem_image.mpr + ⟨t+v, Yfin.mem_toFinset.mpr ht, by simp⟩ + +private theorem localMem : + (by + classical + exact + ∀ (K : DiamondParameter), + let g := DiamondOdometer K + ∀ (X : Set GaussianInt), ∀ (z : GaussianInt), + let R := fun u t => u ∉ X ∧ t ∉ X ∧ FourNeighborAdjacent u t + let Y : Set GaussianInt := {y | Relation.ReflTransGen R z y} + (∀ y ∈ Y, y ∉ X) → (∀ (v : GaussianInt), ∀ (Yfin : Y.Finite), + let Z := Yfin.toFinset.image (fun y => y-v) + ∀ (p : GaussianInt), (p ∈ Z) → (((2 : ℤ) ≤ FourNeighborLaplacian (fun (z : GaussianInt) + => g z - if z ∈ Z then (1 : ℤ) else (0 : ℤ)) p) → ((∀ (t : GaussianInt), t ∈ Z ↔ t+v + ∈ Y) → ((p+v ∈ Y) → (∀ t, (t=p ∨ FourNeighborAdjacent p t) → (t ∈ Z ↔ t+v ∉ X)))))) ) + := by + classical + intro K g X z R Y Yout v Yfin Z p hp hobs memZ py t ht + constructor + · intro htZ + exact Yout (t+v) ((memZ t).mp htZ) + · intro htX + apply (memZ t).mpr + rcases ht with rfl | ht + · exact py + · apply Relation.ReflTransGen.tail py + refine ⟨Yout (p+v) py, htX, ?_⟩ + rcases ht with rfl | rfl | rfl | rfl <;> + simp [FourNeighborAdjacent, sub_eq_add_neg, add_assoc, add_comm] + +private theorem value : + (by + classical + exact + ∀ (K : DiamondParameter), + let D := DiamondVertexDomains K true + let S := DiamondVertexDomains K false \ D + let W : Set GaussianInt := + {x | ∃ v ∈ DiamondExceptionalLattice K, x - v ∈ S} + ((∀ (x : GaussianInt), FourNeighborLaplacian (DiamondOdometer K) (x + ⟨(0 : ℤ), (2 : ℤ) * + (↑K.1 : ℤ)⟩) = FourNeighborLaplacian (DiamondOdometer K) x ∧ FourNeighborLaplacian + (DiamondOdometer K) (x + ⟨(↑K.1 : ℤ) + (1 : ℤ), (↑K.1 : ℤ)⟩) = FourNeighborLaplacian + (DiamondOdometer K) x) ∧ (∀ x ∈ DiamondVertexDomains K false, x ∉ + DiamondVertexDomains K true → FourNeighborLaplacian (DiamondOdometer K) x = (1 : ℤ)) + ∧ ∀ x ∈ DiamondVertexDomains K true, FourNeighborLaplacian (DiamondOdometer K) x = + (if Even (x.re + x.im) then (1 : ℤ) else (-1 : ℤ)) - if x.re = (0 : ℤ) then (1 : ℤ) + else (0 : ℤ)) → ((FourNeighborConnected W ∧ ∀ x ∉ W, ∃ v ∈ DiamondExceptionalLattice + K, ∀ (y : GaussianInt), Relation.ReflTransGen (fun (u z : GaussianInt) => u ∉ W ∧ z ∉ + W ∧ FourNeighborAdjacent u z) x y → y - v ∈ D) → (∀ (finD : D.Finite), + let Df := finD.toFinset + (∀ x, x ∈ Df ↔ x ∈ DiamondVertexDomains K true) → ((∀ (x : GaussianInt), ∀ (y : + GaussianInt), (fun (x y : GaussianInt) => x ∈ Df ∧ y ∈ Df ∧ FourNeighborAdjacent x y + ∧ (x.re.natAbs < y.re.natAbs ∨ x.re = y.re ∧ ¬Even (x.re + x.im) ∧ Even (y.re + + y.im))) x y → x ∈ Df ∧ y ∈ Df ∧ FourNeighborAdjacent x y) → ((∀ x ∈ Df, ∀ y ∈ Df, + FourNeighborAdjacent x y → (fun (x y : GaussianInt) => x ∈ Df ∧ y ∈ Df ∧ + FourNeighborAdjacent x y ∧ (x.re.natAbs < y.re.natAbs ∨ x.re = y.re ∧ ¬Even (x.re + + x.im) ∧ Even (y.re + y.im))) x y ∧ ¬(fun (x y : GaussianInt) => x ∈ Df ∧ y ∈ Df ∧ + FourNeighborAdjacent x y ∧ (x.re.natAbs < y.re.natAbs ∨ x.re = y.re ∧ ¬Even (x.re + + x.im) ∧ Even (y.re + y.im))) y x ∨ (fun (x y : GaussianInt) => x ∈ Df ∧ y ∈ Df ∧ + FourNeighborAdjacent x y ∧ (x.re.natAbs < y.re.natAbs ∨ x.re = y.re ∧ ¬Even (x.re + + x.im) ∧ Even (y.re + y.im))) y x ∧ ¬(fun (x y : GaussianInt) => x ∈ Df ∧ y ∈ Df ∧ + FourNeighborAdjacent x y ∧ (x.re.natAbs < y.re.natAbs ∨ x.re = y.re ∧ ¬Even (x.re + + x.im) ∧ Even (y.re + y.im))) x y) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (fun + (x y : GaussianInt) => x ∈ Df ∧ y ∈ Df ∧ FourNeighborAdjacent x y ∧ (x.re.natAbs < + y.re.natAbs ∨ x.re = y.re ∧ ¬Even (x.re + x.im) ∧ Even (y.re + y.im))) x y → (fun (x + : GaussianInt) => (2 : ℕ) * x.re.natAbs + if Even (x.re + x.im) then (1 : ℕ) else (0 + : ℕ)) x < (fun (x : GaussianInt) => (2 : ℕ) * x.re.natAbs + if Even (x.re + x.im) + then (1 : ℕ) else (0 : ℕ)) y) → ((∀ x ∈ Df, (↑{y ∈ Df | @decide ((fun (x y : + GaussianInt) => x ∈ Df ∧ y ∈ Df ∧ FourNeighborAdjacent x y ∧ (x.re.natAbs < + y.re.natAbs ∨ x.re = y.re ∧ ¬Even (x.re + x.im) ∧ Even (y.re + y.im))) y x) + (Classical.propDecidable _) = true}.card : ℤ) = if x.re = (0 : ℤ) then if Even + (x.re + x.im) then (2 : ℤ) else (0 : + ℤ) else if Even (x.re + x.im) then (3 : ℤ) else (1 : ℤ)) → (∀ (X : Set GaussianInt), + ∀ (z : GaussianInt), + let R := fun u t => u ∉ X ∧ t ∉ X ∧ FourNeighborAdjacent u t + let Y : Set GaussianInt := {y | Relation.ReflTransGen R z y} + ∀ (v : GaussianInt), ∀ (Yfin : Y.Finite), + let Z := Yfin.toFinset.image (fun y => y-v) + ∀ (p : GaussianInt), (∀ t, (t=p ∨ FourNeighborAdjacent p t) → (t ∈ Z ↔ t+v ∉ X)) → (∀ (t + : GaussianInt), t = p ∨ FourNeighborAdjacent p t → (if t ∈ Z then (1 : ℤ) else (0 : + ℤ)) + X.indicator ((fun _ : GaussianInt => (1 : ℤ))) (t + v) = (1 : ℤ)))))))))) := by + classical + intro K D S W tab geom finD Df hD hsupp horient hrank hcount X z R Y v Yfin Z p localMem t ht + let g := DiamondOdometer K + have hm := localMem t ht + by_cases h : t ∈ Z + · simp [h, hm.mp h] + · have hx : t+v ∈ X := by tauto + simp [h, hx] + +end ExceptionalMaximalityProof + +theorem DiamondExceptionalMaximality (K : DiamondParameter) : + (∀ x, FourNeighborLaplacian (DiamondOdometer K) x <= 1) ∧ + (∀ v, v ∈ DiamondExceptionalLattice K -> ∃ a : GaussianInt, + Matrix.mulVec (DiamondPeakMatrix K) + ![(v.re : Real), (v.im : Real)] = + ![(a.re : Real), (a.im : Real)] ∧ + ∀ x, DiamondOdometer K (x + v) = DiamondOdometer K x + + x.re * a.re + x.im * a.im + DiamondOdometer K v) ∧ + (∀ X : Set GaussianInt, X.Infinite -> FourNeighborConnected X -> + (∀ x, FourNeighborLaplacian + (fun y => DiamondOdometer K y + + Set.indicator X (fun _ => (1 : Int)) y) x <= 1) -> + X = Set.univ) := by +-- BODY + classical + let g := DiamondOdometer K + let k : Int := K.1 + let a : GaussianInt := ⟨0, -(2 * K.1 : Int)⟩ + let b : GaussianInt := ⟨(K.1 + 1 : Int), (K.1 : Int)⟩ + let D := DiamondVertexDomains K true + let S := DiamondVertexDomains K false \ D + let W : Set GaussianInt := + {x | ∃ v ∈ DiamondExceptionalLattice K, x - v ∈ S} + have tab := DiamondLaplacianTable K + have ha : a ∈ DiamondExceptionalLattice K := + AddSubgroup.subset_closure (Or.inl rfl) + have hb : b ∈ DiamondExceptionalLattice K := + AddSubgroup.subset_closure (Or.inr rfl) + let H : AddSubgroup GaussianInt := + { carrier := {v | ∀ x, FourNeighborLaplacian g (x+v) = FourNeighborLaplacian g x} + zero_mem' := by intro x; simp + add_mem' := by + intro u v hu hv x + rw [← add_assoc, hv, hu] + neg_mem' := by + intro v hv x + have h := hv (x-v) + rw [sub_add_cancel] at h + simpa only [sub_eq_add_neg] using h.symm } + have hgen := ExceptionalMaximalityProof.hgen K tab + have periods := ExceptionalMaximalityProof.periods K hgen + have bound := ExceptionalMaximalityProof.bound K tab ha hb periods + have hweb := ExceptionalMaximalityProof.hweb K tab periods + have geom := P5435T1WebGeometry K + change FourNeighborConnected W ∧ + ∀ x, x ∉ W → ∃ v ∈ DiamondExceptionalLattice K, ∀ y, + Relation.ReflTransGen + (fun u z => u ∉ W ∧ z ∉ W ∧ FourNeighborAdjacent u z) x y → + y-v ∈ D at geom + have finD := ExceptionalMaximalityProof.finD K + let Df := finD.toFinset + have hD := ExceptionalMaximalityProof.hD K finD + obtain ⟨hsupp, horient, hrank, hcount⟩ := P5432T1EdgeLedger K Df hD + let o : AcyclicIndegreeOrientation Df (fun x => 2 + FourNeighborLaplacian g x) := + { edge := fun x y => x ∈ Df ∧ y ∈ Df ∧ FourNeighborAdjacent x y ∧ + (x.re.natAbs < y.re.natAbs ∨ + (x.re = y.re ∧ ¬ Even (x.re+x.im) ∧ Even (y.re+y.im))) + edge_decidable := fun _ _ => Classical.propDecidable _ + rank := fun x => 2*x.re.natAbs + if Even (x.re+x.im) then 1 else 0 + supported := hsupp + oriented := horient + increasing := hrank + indegree := by + intro x hx + have hc := hcount x hx + have hl := tab.2.2 x ((hD x).mp hx) + change _ = 2 + FourNeighborLaplacian (DiamondOdometer K) x + rw [hl, hc] + split_ifs <;> norm_num } + refine ⟨bound, P5435T1Cocycle K, ?_⟩ + intro X hXin hXconn hle + have symm : ∀ x y, FourNeighborAdjacent x y → FourNeighborAdjacent y x := + ExceptionalMaximalityProof.symm + have meet := ExceptionalMaximalityProof.meet K geom finD X hXin hXconn + have noCross := ExceptionalMaximalityProof.noCross K hweb X hle + have Wsub := ExceptionalMaximalityProof.Wsub K geom X symm meet noCross + apply Set.eq_univ_of_forall + intro z + by_contra hz + let R := fun u t => u ∉ X ∧ t ∉ X ∧ FourNeighborAdjacent u t + let Y : Set GaussianInt := {y | Relation.ReflTransGen R z y} + have zY : z ∈ Y := Relation.ReflTransGen.refl + have Yout := ExceptionalMaximalityProof.Yout X z hz + obtain ⟨v, hv, howner⟩ := geom.2 z (fun hw => hz (Wsub hw)) + have Ysub := ExceptionalMaximalityProof.Ysub K X Wsub z v howner + have Yfin := ExceptionalMaximalityProof.Yfin K finD X z v Ysub + let Z := Yfin.toFinset.image (fun y => y-v) + have Zne : Z.Nonempty := + ⟨z-v, Finset.mem_image.mpr ⟨z, Yfin.mem_toFinset.mpr zY, rfl⟩⟩ + have Zsub := ExceptionalMaximalityProof.Zsub K finD X z v Ysub Yfin + obtain ⟨p, hp, hobs⟩ := FiniteAcyclicOrientationObstruction Df g o Z Zne Zsub + have memZ (t : GaussianInt) := ExceptionalMaximalityProof.memZ X z v Yfin t + have py : p+v ∈ Y := (memZ p).mp hp + have localMem := ExceptionalMaximalityProof.localMem K X z Yout v Yfin p hp hobs memZ py + have value (t : GaussianInt) (ht : t=p ∨ FourNeighborAdjacent p t) := + ExceptionalMaximalityProof.value K tab geom finD hD hsupp horient hrank hcount X z v Yfin p + localMem t ht + have e0 := value p (Or.inl rfl) + have e1 := value (p+1) (Or.inr (Or.inl rfl)) + have e2 := value (p-1) (Or.inr (Or.inr (Or.inl rfl))) + have e3 := value (p+⟨0,1⟩) (Or.inr (Or.inr (Or.inr (Or.inl rfl)))) + have e4 := value (p-⟨0,1⟩) (Or.inr (Or.inr (Or.inr (Or.inr rfl)))) + have hperiod := periods v hv p + have hh := hle (p+v) + have c1 : p+1+v=p+v+1 := by abel + have c2 : p-1+v=p+v-1 := by abel + have c3 : p+⟨0,1⟩+v=p+v+⟨0,1⟩ := by abel + have c4 : p-⟨0,1⟩+v=p+v-⟨0,1⟩ := by abel + rw [c1] at e1 + rw [c2] at e2 + rw [c3] at e3 + rw [c4] at e4 + simp only [FourNeighborLaplacian] at hobs hperiod hh + change _ ≤ 1 at hh + linarith only [hobs, hperiod, hh, e0, e1, e2, e3, e4] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondLaplacianTable.lean b/LeanPool/ApollonianSuperharmonic/DiamondLaplacianTable.lean new file mode 100644 index 0000000000..c4709a3465 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondLaplacianTable.lean @@ -0,0 +1,643 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondOdometer +public import LeanPool.ApollonianSuperharmonic.DiamondOdometerExistsUnique +public import LeanPool.ApollonianSuperharmonic.DiamondParameter +public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import Mathlib.Tactic.Abel +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.LinearCombination +public import Mathlib.Tactic.Ring +public import Mathlib.Algebra.Group.Int.Even + +-- [TABLET NODE: DiamondLaplacianTable] + +/-! +# DiamondLaplacianTable + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiamondLaplacianProof + +private theorem habAt289 : + ∀ (F : ℤ → ℤ → ℤ), ∀ (p : ℤ), ∀ (q : ℤ), ((4 : ℤ) * F (p - (1 : ℤ)) q = (2 : ℤ) * (p - (1 : + ℤ)) ^ (2 : ℕ) - (2 : ℤ) * |p - (1 : ℤ)| - (p - (1 : ℤ) - q) ^ (2 : ℕ) + (p - (1 : ℤ) - q) + % (2 : ℤ)) → (((4 : ℤ) * F p (q + (1 : ℤ)) = (2 : ℤ) * p ^ (2 : ℕ) - (2 : ℤ) * |p| - (p - + (q + (1 : ℤ))) ^ (2 : ℕ) + (p - (q + (1 : ℤ))) % (2 : ℤ)) → (((4 : ℤ) * F p (q - (1 : ℤ)) + = (2 : ℤ) * p ^ (2 : ℕ) - (2 : ℤ) * |p| - (p - (q - (1 : ℤ))) ^ (2 : ℕ) + (p - (q - (1 : + ℤ))) % (2 : ℤ)) → (((4 : ℤ) * F p q = (2 : ℤ) * p ^ (2 : ℕ) - (2 : ℤ) * |p| - (p - q) ^ + (2 : ℕ) + (p - q) % (2 : ℤ)) → (|p+1| + |p-1| - 2*|p| = (if p=0 then 2 else 0))))) := by + classical + intro F p q h2 h3 h4 h0 + split_ifs with hp + · simp [hp] + · rcases lt_or_gt_of_ne hp with hp | hp + · rw [abs_of_nonpos (by omega : p+1 ≤ 0), + abs_of_nonpos (by omega : p-1 ≤ 0), abs_of_nonpos (by omega : p ≤ 0)] + omega + · rw [abs_of_nonneg (by omega : 0 ≤ p+1), + abs_of_nonneg (by omega : 0 ≤ p-1), abs_of_nonneg (by omega : 0 ≤ p)] + omega + +private theorem bm : + ∀ (K : DiamondParameter), ∀ (F : ℤ → ℤ → ℤ), ∀ (g : IntegerLatticeFunction), (∀ (x : + GaussianInt), g (x + ⟨(↑K.1 : ℤ) + (1 : ℤ), (↑K.1 : ℤ)⟩) = g x + (↑K.1 : ℤ) * x.re + x.im + + (↑K.1 : ℤ) * ((↑K.1 : ℤ) + (1 : ℤ)) / (2 : ℤ)) → ( + let k : Int := K.1 + let C : Int := k*(k+1)/2 + (∀ (p : Int), ∀ (q : Int), (|p| ≤ k ∧ |q-k| ≤ k ∧ |p|+|q-k| ≤ k+1) → (g ⟨p,q⟩ = F p q)) → (∀ + (p : ℤ), ∀ (q : ℤ), ∀ (e : ℤ), |p + k + (1 : ℤ)| ≤ k ∧ |q| ≤ k ∧ |p + k + (1 : ℤ)| + |q| + ≤ k + (1 : ℤ) → F (p + k + (1 : ℤ)) (q + k) - k * p - q - C = F p q + e → g ⟨p, q⟩ = F p + q + e)) := by + classical + intro K F g hb k C closed p q e hd he + have hh := hb ⟨p,q⟩ + have hz := closed (p+k+1) (q+k) (by simpa using hd) + have hx : (⟨p,q⟩ : GaussianInt)+⟨k+1,k⟩ = ⟨p+k+1,q+k⟩ := by + ext <;> simp; ring + change g ((⟨p,q⟩ : GaussianInt)+⟨k+1,k⟩) = g ⟨p,q⟩+k*p+q+C at hh + rw [hx] at hh + omega + +private theorem cm : + ∀ (K : DiamondParameter), ∀ (F : ℤ → ℤ → ℤ), ∀ (g : IntegerLatticeFunction), (∀ (x : + GaussianInt), g (x + ⟨-(↑K.1 : ℤ) - (1 : ℤ), (↑K.1 : ℤ)⟩) = g x - (↑K.1 : ℤ) * x.im - + (↑K.1 : ℤ) * ((↑K.1 : ℤ) + (1 : ℤ)) / (2 : ℤ)) → ( + let k : Int := K.1 + let C : Int := k*(k+1)/2 + (∀ (p : Int), ∀ (q : Int), (|p| ≤ k ∧ |q-k| ≤ k ∧ |p|+|q-k| ≤ k+1) → (g ⟨p,q⟩ = F p q)) → (∀ + (p : ℤ), ∀ (q : ℤ), ∀ (e : ℤ), |p - k - (1 : ℤ)| ≤ k ∧ |q| ≤ k ∧ |p - k - (1 : ℤ)| + |q| + ≤ k + (1 : ℤ) → F (p - k - (1 : ℤ)) (q + k) + k * q + C = F p q + e → g ⟨p, q⟩ = F p q + + e)) := by + classical + intro K F g hc k C closed p q e hd he + have hh := hc ⟨p,q⟩ + have hz := closed (p-k-1) (q+k) (by simpa using hd) + have hx : (⟨p,q⟩ : GaussianInt)+⟨-k-1,k⟩ = ⟨p-k-1,q+k⟩ := by + ext <;> simp; ring + change g ((⟨p,q⟩ : GaussianInt)+⟨-k-1,k⟩) = g ⟨p,q⟩-k*q-C at hh + rw [hx] at hh + omega + +private theorem bp : + ∀ (K : DiamondParameter), ∀ (F : ℤ → ℤ → ℤ), ∀ (g : IntegerLatticeFunction), (∀ (x : + GaussianInt), g (x + ⟨(↑K.1 : ℤ) + (1 : ℤ), (↑K.1 : ℤ)⟩) = g x + (↑K.1 : ℤ) * x.re + x.im + + (↑K.1 : ℤ) * ((↑K.1 : ℤ) + (1 : ℤ)) / (2 : ℤ)) → ( + let k : Int := K.1 + let C : Int := k*(k+1)/2 + (∀ (p : Int), ∀ (q : Int), (|p| ≤ k ∧ |q-k| ≤ k ∧ |p|+|q-k| ≤ k+1) → (g ⟨p,q⟩ = F p q)) → (∀ + (p : ℤ), ∀ (q : ℤ), ∀ (e : ℤ), |p - k - (1 : ℤ)| ≤ k ∧ |q - (2 : ℤ) * k| ≤ k ∧ |p - k - + (1 : ℤ)| + |q - (2 : ℤ) * k| ≤ k + (1 : ℤ) → F (p - k - (1 : ℤ)) (q - k) + k * (p - k - + (1 : ℤ)) + (q - k) + C = F p q + e → g ⟨p, q⟩ = F p q + e)) := by + classical + intro K F g hb k C closed p q e hd he + have hh := hb ⟨p-k-1,q-k⟩ + have hz := closed (p-k-1) (q-k) + (by simpa only [show q-k-k=q-2*k by ring] using hd) + have hx : (⟨p-k-1,q-k⟩ : GaussianInt)+⟨k+1,k⟩ = ⟨p,q⟩ := by + ext <;> simp + change g ((⟨p-k-1,q-k⟩ : GaussianInt)+⟨k+1,k⟩) = + g ⟨p-k-1,q-k⟩+k*(p-k-1)+(q-k)+C at hh + rw [hx] at hh + omega + +private theorem cp : + ∀ (K : DiamondParameter), ∀ (F : ℤ → ℤ → ℤ), ∀ (g : IntegerLatticeFunction), (∀ (x : + GaussianInt), g (x + ⟨-(↑K.1 : ℤ) - (1 : ℤ), (↑K.1 : ℤ)⟩) = g x - (↑K.1 : ℤ) * x.im - + (↑K.1 : ℤ) * ((↑K.1 : ℤ) + (1 : ℤ)) / (2 : ℤ)) → ( + let k : Int := K.1 + let C : Int := k*(k+1)/2 + (∀ (p : Int), ∀ (q : Int), (|p| ≤ k ∧ |q-k| ≤ k ∧ |p|+|q-k| ≤ k+1) → (g ⟨p,q⟩ = F p q)) → (∀ + (p : ℤ), ∀ (q : ℤ), ∀ (e : ℤ), |p + k + (1 : ℤ)| ≤ k ∧ |q - (2 : ℤ) * k| ≤ k ∧ |p + k + + (1 : ℤ)| + |q - (2 : ℤ) * k| ≤ k + (1 : ℤ) → F (p + k + (1 : ℤ)) (q - k) - k * (q - k) - + C = F p q + e → g ⟨p, q⟩ = F p q + e)) := by + classical + intro K F g hc k C closed p q e hd he + have hh := hc ⟨p+k+1,q-k⟩ + have hz := closed (p+k+1) (q-k) + (by simpa only [show q-k-k=q-2*k by ring] using hd) + have hx : (⟨p+k+1,q-k⟩ : GaussianInt)+⟨-k-1,k⟩ = ⟨p,q⟩ := by + ext <;> simp + change g ((⟨p+k+1,q-k⟩ : GaussianInt)+⟨-k-1,k⟩) = + g ⟨p+k+1,q-k⟩-k*(q-k)-C at hh + rw [hx] at hh + omega + +private theorem am : + ∀ (K : DiamondParameter), ∀ (F : ℤ → ℤ → ℤ), ∀ (g : IntegerLatticeFunction), (∀ (x : + GaussianInt), g (x + ⟨(0 : ℤ), -((2 : ℤ) * (↑K.1 : ℤ))⟩) = g x + -(↑K.1 : ℤ) * x.re + + ((↑K.1 : ℤ) - (1 : ℤ)) * x.im - (↑K.1 : ℤ) * ((↑K.1 : ℤ) - (2 : ℤ))) → ( + let k : Int := K.1 + (∀ (p : Int), ∀ (q : Int), (|p| ≤ k ∧ |q-k| ≤ k ∧ |p|+|q-k| ≤ k+1) → (g ⟨p,q⟩ = F p q)) → (∀ + (p : ℤ), ∀ (q : ℤ), ∀ (e : ℤ), |p| ≤ k ∧ |q + k| ≤ k ∧ |p| + |q + k| ≤ k + (1 : ℤ) → F p + (q + (2 : ℤ) * k) - k * p + (k - (1 : ℤ)) * (q + (2 : ℤ) * k) - k * (k - (2 : ℤ)) = F p q + + e → g ⟨p, q⟩ = F p q + e)) := by + classical + intro K F g ha k closed p q e hd he + have hh := ha ⟨p,q+2*k⟩ + have hz := closed p (q+2*k) + (by simpa only [show q+2*k-k=q+k by ring] using hd) + have hx : (⟨p,q+2*k⟩ : GaussianInt)+⟨0,-(2*k)⟩ = ⟨p,q⟩ := by + ext <;> simp + change g ((⟨p,q+2*k⟩ : GaussianInt)+⟨0,-(2*k)⟩) = + g ⟨p,q+2*k⟩ + -k*p+(k-1)*(q+2*k)-k*(k-2) at hh + rw [hx] at hh + nlinarith only [hh, hz, he] + +private theorem ap : + ∀ (K : DiamondParameter), ∀ (F : ℤ → ℤ → ℤ), ∀ (g : IntegerLatticeFunction), (∀ (x : + GaussianInt), g (x + ⟨(0 : ℤ), -((2 : ℤ) * (↑K.1 : ℤ))⟩) = g x + -(↑K.1 : ℤ) * x.re + + ((↑K.1 : ℤ) - (1 : ℤ)) * x.im - (↑K.1 : ℤ) * ((↑K.1 : ℤ) - (2 : ℤ))) → ( + let k : Int := K.1 + (∀ (p : Int), ∀ (q : Int), (|p| ≤ k ∧ |q-k| ≤ k ∧ |p|+|q-k| ≤ k+1) → (g ⟨p,q⟩ = F p q)) → (∀ + (p : ℤ), ∀ (q : ℤ), ∀ (e : ℤ), |p| ≤ k ∧ |q - (3 : ℤ) * k| ≤ k ∧ |p| + |q - (3 : ℤ) * k| + ≤ k + (1 : ℤ) → F p (q - (2 : ℤ) * k) + k * p - (k - (1 : ℤ)) * q + k * (k - (2 : ℤ)) = F + p q + e → g ⟨p, q⟩ = F p q + e)) := by + classical + intro K F g ha k closed p q e hd he + have hh := ha ⟨p,q⟩ + have hz := closed p (q-2*k) + (by simpa only [show q-2*k-k=q-3*k by ring] using hd) + have hx : (⟨p,q⟩ : GaussianInt)+⟨0,-(2*k)⟩ = ⟨p,q-2*k⟩ := by + ext <;> simp; ring + change g ((⟨p,q⟩ : GaussianInt)+⟨0,-(2*k)⟩) = + g ⟨p,q⟩ + -k*p+(k-1)*q-k*(k-2) at hh + rw [hx] at hh + nlinarith only [hh, hz, he] + +end DiamondLaplacianProof + +theorem DiamondLaplacianTable (K : DiamondParameter) : + (∀ x, FourNeighborLaplacian (DiamondOdometer K) + (x + ⟨0, (2 * K.1 : Int)⟩) = + FourNeighborLaplacian (DiamondOdometer K) x ∧ + FourNeighborLaplacian (DiamondOdometer K) + (x + ⟨(K.1 + 1 : Int), (K.1 : Int)⟩) = + FourNeighborLaplacian (DiamondOdometer K) x) ∧ + (∀ x, x ∈ DiamondVertexDomains K false -> + x ∉ DiamondVertexDomains K true -> + FourNeighborLaplacian (DiamondOdometer K) x = 1) ∧ + (∀ x, x ∈ DiamondVertexDomains K true -> + FourNeighborLaplacian (DiamondOdometer K) x = + (if Even (x.re + x.im) then 1 else -1) - + (if x.re = 0 then 1 else 0)) := by +-- BODY + let F (p q : Int) : Int := + (Int.natAbs p : Int) * ((Int.natAbs p : Int) - 1) / 2 - (p-q)^2 / 4 + let E (k p q : Int) : Int := + if |p| ≤ k ∧ |q-k| ≤ k ∧ |p|+|q-k| ≤ k+1 then 0 + else if q=k then 0 else 1 + have hscale : ∀ p q, 4*F p q=2*p^2-2*|p|-(p-q)^2+(p-q)%2 := scaled + obtain ⟨ha, hb, hc, hf⟩ := + (Classical.choose_spec (DiamondOdometerExistsUnique K)).1 + let k : Int := K.1 + have hk : 1 ≤ k := by dsimp [k]; exact_mod_cast K.2 + have hF : ∀ x, x ∈ DiamondVertexDomains K false → + DiamondOdometer K x = F x.re x.im := hf + have hpa := periodic (DiamondOdometer K) ⟨0,-(2*k)⟩ + (-k) (k-1) (-k*(k-2)) (by + intro x + have h := ha x + change DiamondOdometer K (x+⟨0,-(2*k)⟩) = + DiamondOdometer K x + -k*x.re + (k-1)*x.im - k*(k-2) at h + nlinarith only [h]) + have hpb := periodic (DiamondOdometer K) ⟨k+1,k⟩ + k 1 (k*(k+1)/2) (by + intro x + have h := hb x + change DiamondOdometer K (x+⟨k+1,k⟩) = + DiamondOdometer K x+k*x.re+x.im+k*(k+1)/2 at h + simpa only [one_mul] using h) + refine ⟨?_, ?_, ?_⟩ + · intro x + constructor + · have h := hpa (x+⟨0,2*k⟩) + have he : x+⟨0,2*k⟩+⟨0,-(2*k)⟩ = x := by ext <;> simp + rw [he] at h + exact h.symm + · exact hpb x + · rintro ⟨p,q⟩ hx hi + have hd := bounds K p q hx + change ¬ Int.natAbs p + Int.natAbs (q-k) ≤ K.1-1 at hi + have hpabs := Int.natCast_natAbs p + have hqabs := Int.natCast_natAbs (q-k) + have hshell : k ≤ |p|+|q-k| ∧ |p|+|q-k| ≤ k+1 := by + change |p| ≤ k ∧ |q-k| ≤ k ∧ |p|+|q-k| ≤ k+1 at hd + omega + have hv := extended F hscale K (DiamondOdometer K) ha hb hc hF + have h1 := hv (p+1) q (by simp only [abs_eq_max_neg] at hd ⊢; omega) + (by simp only [abs_eq_max_neg] at hd ⊢; omega) + (by simp only [abs_eq_max_neg] at hd ⊢; omega) + have h2 := hv (p-1) q (by simp only [abs_eq_max_neg] at hd ⊢; omega) + (by simp only [abs_eq_max_neg] at hd ⊢; omega) + (by simp only [abs_eq_max_neg] at hd ⊢; omega) + have h3 := hv p (q+1) (by simp only [abs_eq_max_neg] at hd ⊢; omega) + (by simp only [abs_eq_max_neg] at hd ⊢; omega) + (by simp only [abs_eq_max_neg] at hd ⊢; omega) + have h4 := hv p (q-1) (by simp only [abs_eq_max_neg] at hd ⊢; omega) + (by simp only [abs_eq_max_neg] at hd ⊢; omega) + (by simp only [abs_eq_max_neg] at hd ⊢; omega) + have hl := stencil F hscale (DiamondOdometer K) p q _ _ _ _ (hF _ hx) h1 h2 h3 h4 + have he := shellErrors k p q hk hd.1 hd.2.1 hshell + change FourNeighborLaplacian (DiamondOdometer K) ⟨p,q⟩ = + 1-2*((p-q)%2)-(if p=0 then 1 else 0)+ + E k (p+1) q+E k (p-1) q+E k p (q+1)+E k p (q-1) at hl + linarith only [hl, he] + · rintro ⟨p,q⟩ hx + change Int.natAbs p + Int.natAbs (q-k) ≤ K.1-1 at hx + have hpabs := Int.natCast_natAbs p + have hqabs := Int.natCast_natAbs (q-k) + have hi : |p|+|q-k| ≤ k-1 := by omega + have closed (p' q' : Int) + (hh : |p'| ≤ k ∧ |q'-k| ≤ k ∧ |p'|+|q'-k| ≤ k+1) : + DiamondOdometer K ⟨p',q'⟩ = F p' q' := hF _ (domain K p' q' hh) + have h0 := closed p q (by simp only [abs_eq_max_neg] at hi ⊢; omega) + have h1 : DiamondOdometer K ⟨p+1,q⟩ = F (p+1) q+0 := by + simpa using closed (p+1) q (by simp only [abs_eq_max_neg] at hi ⊢; omega) + have h2 : DiamondOdometer K ⟨p-1,q⟩ = F (p-1) q+0 := by + simpa using closed (p-1) q (by simp only [abs_eq_max_neg] at hi ⊢; omega) + have h3 : DiamondOdometer K ⟨p,q+1⟩ = F p (q+1)+0 := by + simpa using closed p (q+1) (by simp only [abs_eq_max_neg] at hi ⊢; omega) + have h4 : DiamondOdometer K ⟨p,q-1⟩ = F p (q-1)+0 := by + simpa using closed p (q-1) (by simp only [abs_eq_max_neg] at hi ⊢; omega) + have hl := stencil F hscale (DiamondOdometer K) p q 0 0 0 0 h0 h1 h2 h3 h4 + have hpar : (if Even (p+q) then (1 : Int) else -1) = 1-2*((p-q)%2) := by + simp only [Int.even_iff] + split_ifs <;> omega + change FourNeighborLaplacian (DiamondOdometer K) ⟨p,q⟩ = + (if Even (p+q) then 1 else -1) - (if p=0 then 1 else 0) + rw [hpar] + simpa using hl +where + tri (a : Int) : 2 * (a * (a-1) / 2) = a * (a-1) := by + have h := Int.emod_two_eq_zero_or_one a + rcases h with h | h + · have ha : a = 2 * (a / 2) := by omega + rw [ha] + have he : 2 * (a / 2) * (2 * (a / 2) - 1) = + 2 * ((a / 2) * (2 * (a / 2) - 1)) := by ring + rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (2 : Int) ≠ 0)] + · have ha : a = 2 * (a / 2) + 1 := by omega + rw [ha] + have he : (2 * (a / 2) + 1) * (2 * (a / 2) + 1 - 1) = + 2 * ((2 * (a / 2) + 1) * (a / 2)) := by ring + rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (2 : Int) ≠ 0)] + square (d : Int) : 4 * (d^2 / 4) = d^2 - d % 2 := by + rcases Int.emod_two_eq_zero_or_one d with h | h + · have hd : d = 2 * (d / 2) := by omega + have he : d^2 = 4 * (d/2)^2 := by + conv_lhs => rw [hd] + ring + rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (4 : Int) ≠ 0), h] + ring + · have hd : d = 2 * (d / 2) + 1 := by omega + have he : d^2 = 4 * ((d/2)^2 + d/2) + 1 := by + conv_lhs => rw [hd] + ring + rw [he, h] + omega + scaled (p q : Int) : + 4 * (fun (p q : Int) => (Int.natAbs p : Int) * ((Int.natAbs p : Int) - 1) / 2 - (p-q)^2 / + 4) p q = 2*p^2 - 2*|p| - (p-q)^2 + (p-q)%2 := by + let F (p q : Int) : Int := + (Int.natAbs p : Int) * ((Int.natAbs p : Int) - 1) / 2 - (p-q)^2 / 4 + change 4*F p q = 2*p^2-2*|p|-(p-q)^2+(p-q)%2 + have ht := tri (Int.natAbs p : Int) + have hs := square (p-q) + have hab : (Int.natAbs p : Int)^2 = p^2 := by + rw [Int.natCast_natAbs, sq_abs] + unfold F + rw [Int.natCast_natAbs] at ht hab ⊢ + nlinarith only [ht, hs, hab] + domain (K : DiamondParameter) (p q : Int) + (h : |p| ≤ (K.1 : Int) ∧ |q-K.1| ≤ (K.1 : Int) ∧ + |p| + |q-K.1| ≤ (K.1 : Int)+1) : + (⟨p,q⟩ : GaussianInt) ∈ DiamondVertexDomains K false := by + change max (Int.natAbs p) (max (Int.natAbs (q-K.1)) + (Int.natAbs p + Int.natAbs (q-K.1) - 1)) ≤ K.1 + rw [max_le_iff, max_le_iff] + have hp := Int.natCast_natAbs p + have hq := Int.natCast_natAbs (q-K.1) + omega + periodic (g : IntegerLatticeFunction) (v : GaussianInt) + (a b c : Int) + (h : ∀ x, g (x+v) = g x + a*x.re + b*x.im + c) : + ∀ x, FourNeighborLaplacian g (x+v) = FourNeighborLaplacian g x := by + intro x + unfold FourNeighborLaplacian + rw [show x+v+1 = (x+1)+v by abel, + show x+v-1 = (x-1)+v by abel, + show x+v+⟨0,1⟩ = (x+⟨0,1⟩)+v by abel, + show x+v-⟨0,1⟩ = (x-⟨0,1⟩)+v by abel] + rw [h, h, h, h, h] + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, + Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + ring + formalLap (F : Int → Int → Int) + (hscale : ∀ p q, 4*F p q=2*p^2-2*|p|-(p-q)^2+(p-q)%2) (p q : Int) : + F (p+1) q + F (p-1) q + F p (q+1) + F p (q-1) - 4*F p q = + 1 - 2*((p-q)%2) - (if p=0 then 1 else 0) := by + have h1 := hscale (p+1) q + have h2 := hscale (p-1) q + have h3 := hscale p (q+1) + have h4 := hscale p (q-1) + have h0 := hscale p q + have hm : (p+1-q)%2 + (p-1-q)%2 + (p-(q+1))%2 + (p-(q-1))%2 = + 4 - 4*((p-q)%2) := by omega + have hab : |p+1| + |p-1| - 2*|p| = (if p=0 then 2 else 0) := DiamondLaplacianProof.habAt289 F + p q h2 h3 h4 h0 + split_ifs at hab ⊢ + all_goals + apply mul_left_cancel₀ (by norm_num : (4 : Int) ≠ 0) + linear_combination h1+h2+h3+h4-4*h0-2*hab+hm + shellErrors (k p q : Int) (hk : 1 ≤ k) + (hp : |p| ≤ k) (hq : |q-k| ≤ k) + (ht : k ≤ |p|+|q-k| ∧ |p|+|q-k| ≤ k+1) : + (fun (k p q : Int) => if |p| ≤ k ∧ |q-k| ≤ k ∧ |p|+|q-k| ≤ k+1 then 0 + else if q=k then 0 else 1) k (p+1) q + (fun (k p q : Int) => if |p| ≤ k ∧ |q-k| ≤ k ∧ + |p|+|q-k| ≤ k+1 then 0 + else if q=k then 0 else 1) k (p-1) q + (fun (k p q : Int) => if |p| ≤ k ∧ |q-k| ≤ k ∧ + |p|+|q-k| ≤ k+1 then 0 + else if q=k then 0 else 1) k p (q+1) + (fun (k p q : Int) => if |p| ≤ k ∧ |q-k| ≤ k ∧ + |p|+|q-k| ≤ k+1 then 0 + else if q=k then 0 else 1) k p (q-1) = + 2*((p-q)%2) + (if p=0 then 1 else 0) := by + let E (k p q : Int) : Int := + if |p| ≤ k ∧ |q-k| ≤ k ∧ |p|+|q-k| ≤ k+1 then 0 + else if q=k then 0 else 1 + change E k (p+1) q+E k (p-1) q+E k p (q+1)+E k p (q-1) = + 2*((p-q)%2)+(if p=0 then 1 else 0) + by_cases hp0 : p=0 + · subst p + have cases : q=0 ∨ q=2*k := by + simp only [abs_eq_max_neg] at hp hq ht + omega + rcases cases with rfl | rfl + all_goals + simp only [abs_eq_max_neg] at hp hq ht + simp (disch := omega) only [E, abs_eq_max_neg, max_eq_left, + max_eq_right, ite_eq_left, ite_eq_right] + simp + by_cases hq0 : q=k + · subst q + have cases : p = -k ∨ p=k := by + simp only [abs_eq_max_neg] at hp hq ht + omega + have hmod : (p - k) % 2 = 0 := by + rcases cases with h | h + · rw [h, show -k - k = 2 * (-k) by ring] + omega + · simp [h] + rw [hmod] + rcases cases with rfl | rfl + all_goals + simp only [abs_eq_max_neg] at hp hq ht + simp (disch := omega) only [E, abs_eq_max_neg, max_eq_left, + max_eq_right, ite_eq_left, ite_eq_right] + simp + have cases : |p|+|q-k|=k ∨ |p|+|q-k|=k+1 := by omega + rcases cases with ht0 | ht0 <;> + rcases lt_or_gt_of_ne hp0 with hsign | hsign <;> + rcases lt_or_gt_of_ne hq0 with hside | hside + all_goals + simp only [abs_eq_max_neg] at hp hq ht ht0 + simp (disch := omega) only [E, abs_eq_max_neg, max_eq_left, + max_eq_right, ite_eq_left, ite_eq_right] + omega + extended (F : Int → Int → Int) + (hscale : ∀ p q, 4*F p q=2*p^2-2*|p|-(p-q)^2+(p-q)%2) (K : DiamondParameter) (g : + IntegerLatticeFunction) + (ha : ∀ x, g (x + ⟨0, -(2 * K.1 : Int)⟩) = g x + + (-(K.1 : Int))*x.re + ((K.1 : Int)-1)*x.im - (K.1 : Int)*((K.1 : Int)-2)) + (hb : ∀ x, g (x + ⟨(K.1+1 : Int), (K.1 : Int)⟩) = g x + + (K.1 : Int)*x.re + x.im + (K.1 : Int)*(K.1+1)/2) + (hc : ∀ x, g (x + ⟨-(K.1 : Int)-1, (K.1 : Int)⟩) = g x - + (K.1 : Int)*x.im - (K.1 : Int)*(K.1+1)/2) + (hf : ∀ x, x ∈ DiamondVertexDomains K false → g x = F x.re x.im) + (p q : Int) (hp : |p| ≤ (K.1 : Int)+1) + (hq : |q-K.1| ≤ (K.1 : Int)+1) + (ht : |p|+|q-K.1| ≤ (K.1 : Int)+2) : + g ⟨p,q⟩ = F p q + (fun (k p q : Int) => if |p| ≤ k ∧ |q-k| ≤ k ∧ |p|+|q-k| ≤ k+1 then 0 + else if q=k then 0 else 1) K.1 p q := by + let E (k p q : Int) : Int := + if |p| ≤ k ∧ |q-k| ≤ k ∧ |p|+|q-k| ≤ k+1 then 0 + else if q=k then 0 else 1 + change ∀ x, x ∈ DiamondVertexDomains K false → g x=F x.re x.im at hf + change g ⟨p,q⟩=F p q+E K.1 p q + let k : Int := K.1 + let C : Int := k*(k+1)/2 + have hk : 1 ≤ k := by dsimp [k]; exact_mod_cast K.2 + change |p| ≤ k+1 at hp + change |q-k| ≤ k+1 at hq + change |p|+|q-k| ≤ k+2 at ht + change g ⟨p,q⟩ = F p q + E k p q + have closed (p q : Int) (hd : |p| ≤ k ∧ |q-k| ≤ k ∧ |p|+|q-k| ≤ k+1) : + g ⟨p,q⟩ = F p q := hf _ (domain K p q hd) + have bm (p q e : Int) + (hd : |p+k+1| ≤ k ∧ |q| ≤ k ∧ |p+k+1|+|q| ≤ k+1) + (he : F (p+k+1) (q+k) - k*p-q-C = F p q+e) : + g ⟨p,q⟩ = F p q+e := DiamondLaplacianProof.bm K F g hb closed p q e hd he + have cm (p q e : Int) + (hd : |p-k-1| ≤ k ∧ |q| ≤ k ∧ |p-k-1|+|q| ≤ k+1) + (he : F (p-k-1) (q+k) + k*q+C = F p q+e) : + g ⟨p,q⟩ = F p q+e := DiamondLaplacianProof.cm K F g hc closed p q e hd he + have bp (p q e : Int) + (hd : |p-k-1| ≤ k ∧ |q-2*k| ≤ k ∧ |p-k-1|+|q-2*k| ≤ k+1) + (he : F (p-k-1) (q-k) + k*(p-k-1)+(q-k)+C = F p q+e) : + g ⟨p,q⟩ = F p q+e := DiamondLaplacianProof.bp K F g hb closed p q e hd he + have cp (p q e : Int) + (hd : |p+k+1| ≤ k ∧ |q-2*k| ≤ k ∧ |p+k+1|+|q-2*k| ≤ k+1) + (he : F (p+k+1) (q-k) - k*(q-k)-C = F p q+e) : + g ⟨p,q⟩ = F p q+e := DiamondLaplacianProof.cp K F g hc closed p q e hd he + have am (p q e : Int) + (hd : |p| ≤ k ∧ |q+k| ≤ k ∧ |p|+|q+k| ≤ k+1) + (he : F p (q+2*k) - k*p+(k-1)*(q+2*k)-k*(k-2) = F p q+e) : + g ⟨p,q⟩ = F p q+e := DiamondLaplacianProof.am K F g ha closed p q e hd he + have ap (p q e : Int) + (hd : |p| ≤ k ∧ |q-3*k| ≤ k ∧ |p|+|q-3*k| ≤ k+1) + (he : F p (q-2*k) + k*p-(k-1)*q+k*(k-2) = F p q+e) : + g ⟨p,q⟩ = F p q+e := DiamondLaplacianProof.ap K F g ha closed p q e hd he + by_cases hd : |p| ≤ k ∧ |q-k| ≤ k ∧ |p|+|q-k| ≤ k+1 + · simp only [E, ite_eq_left hd, add_zero] + exact closed p q hd + simp only [E, ite_eq_right hd] + have hC : 2*C = k*(k+1) := by + dsimp [C] + have he : k*(k+1) = (k+1)*((k+1)-1) := by ring + rw [he] + exact tri (k+1) + by_cases hzero : p=0 + · subst p + have cases : q = -1 ∨ q = 2*k+1 := by + simp only [abs_eq_max_neg] at hp hq ht hd + omega + rcases cases with rfl | rfl + · rw [ite_eq_right (by omega : (-1 : Int) ≠ k)] + apply am 0 (-1) 1 + · simp only [abs_eq_max_neg]; omega + · have hy := hscale 0 (-1) + have hz := hscale 0 (-1+2*k) + have hm : (0-(-1+2*k))%2=1 := by omega + simp only [abs_zero, hm] at hy hz + have my : (0-(-1 : Int))%2=1 := by norm_num + rw [my] at hy + apply mul_left_cancel₀ (by norm_num : (4 : Int) ≠ 0) + linear_combination hz-hy + · rw [ite_eq_right (by omega : 2*k+1 ≠ k)] + apply ap 0 (2*k+1) 1 + · simp only [abs_eq_max_neg]; omega + · have hy := hscale 0 (2*k+1) + have hz := hscale 0 (2*k+1-2*k) + have hm : (0-(2*k+1))%2=1 := by omega + have hmz : (0-(2*k+1-2*k))%2=1 := by omega + simp only [abs_zero, hm, hmz] at hy hz + apply mul_left_cancel₀ (by norm_num : (4 : Int) ≠ 0) + linear_combination hz-hy + by_cases hmid : q=k + · rw [ite_eq_left hmid] + subst q + have cases : p = -k-1 ∨ p = k+1 := by + simp only [abs_eq_max_neg] at hp hq ht hd + omega + rcases cases with rfl | rfl + · apply bm (-k-1) k 0 + · simp only [abs_eq_max_neg]; omega + · have hy := hscale (-k-1) k + have hz := hscale (-k-1+k+1) (k+k) + have ay : |-k-1|=k+1 := by simp only [abs_eq_max_neg]; omega + have az : |-k-1+k+1|=0 := by simp only [abs_eq_max_neg]; omega + have my : (-k-1-k)%2=1 := by omega + have mz : (-k-1+k+1-(k+k))%2=0 := by omega + rw [ay, my] at hy + rw [az, mz] at hz + apply mul_left_cancel₀ (by norm_num : (4 : Int) ≠ 0) + linear_combination hz-hy-2*hC + · apply bp (k+1) k 0 + · simp only [abs_eq_max_neg]; omega + · have hy := hscale (k+1) k + have hz := hscale (k+1-k-1) (k-k) + have ay : |k+1|=k+1 := by simp only [abs_eq_max_neg]; omega + have az : |k+1-k-1|=0 := by simp only [abs_eq_max_neg]; omega + have my : (k+1-k)%2=1 := by omega + have mz : (k+1-k-1-(k-k))%2=0 := by omega + rw [ay, my] at hy + rw [az, mz] at hz + apply mul_left_cancel₀ (by norm_num : (4 : Int) ≠ 0) + linear_combination hz-hy+2*hC + rw [ite_eq_right hmid] + have hout : |p|+|q-k|=k+2 := by + simp only [abs_eq_max_neg] at hp hq ht hd ⊢ + omega + rcases lt_or_gt_of_ne hzero with hsign | hsign <;> + rcases lt_or_gt_of_ne hmid with hside | hside + · have heq : q = -p-2 := by + simp only [abs_eq_max_neg] at hout + omega + rw [heq] + apply bm p (-p-2) 1 + · simp only [abs_eq_max_neg] at hp hq ht ⊢; omega + · have hy := hscale p (-p-2) + have hz := hscale (p+k+1) ((-p-2)+k) + have ay : |p| = -p := by simp only [abs_eq_max_neg]; omega + have az : |p+k+1| = p+k+1 := by simp only [abs_eq_max_neg] at hp ⊢; omega + have my : (p-(-p-2))%2=0 := by omega + have mz : (p+k+1-((-p-2)+k))%2=1 := by omega + rw [ay, my] at hy + rw [az, mz] at hz + apply mul_left_cancel₀ (by norm_num : (4 : Int) ≠ 0) + linear_combination hz-hy-2*hC + · have heq : q = p+2*k+2 := by + simp only [abs_eq_max_neg] at hout + omega + rw [heq] + apply cp p (p+2*k+2) 1 + · simp only [abs_eq_max_neg] at hp hq ht ⊢; omega + · have hy := hscale p (p+2*k+2) + have hz := hscale (p+k+1) ((p+2*k+2)-k) + have ay : |p| = -p := by simp only [abs_eq_max_neg]; omega + have az : |p+k+1| = p+k+1 := by simp only [abs_eq_max_neg] at hp ⊢; omega + have my : (p-(p+2*k+2))%2=0 := by omega + have mz : (p+k+1-((p+2*k+2)-k))%2=1 := by omega + rw [ay, my] at hy + rw [az, mz] at hz + apply mul_left_cancel₀ (by norm_num : (4 : Int) ≠ 0) + linear_combination hz-hy-2*hC + · have heq : q = p-2 := by + simp only [abs_eq_max_neg] at hout + omega + rw [heq] + apply cm p (p-2) 1 + · simp only [abs_eq_max_neg] at hp hq ht ⊢; omega + · have hy := hscale p (p-2) + have hz := hscale (p-k-1) ((p-2)+k) + have ay : |p| = p := by simp only [abs_eq_max_neg]; omega + have az : |p-k-1| = -(p-k-1) := by simp only [abs_eq_max_neg] at hp ⊢; omega + have my : (p-(p-2))%2=0 := by omega + have mz : (p-k-1-((p-2)+k))%2=1 := by omega + rw [ay, my] at hy + rw [az, mz] at hz + apply mul_left_cancel₀ (by norm_num : (4 : Int) ≠ 0) + linear_combination hz-hy+2*hC + · have heq : q = 2*k+2-p := by + simp only [abs_eq_max_neg] at hout + omega + rw [heq] + apply bp p (2*k+2-p) 1 + · simp only [abs_eq_max_neg] at hp hq ht ⊢; omega + · have hy := hscale p (2*k+2-p) + have hz := hscale (p-k-1) ((2*k+2-p)-k) + have ay : |p| = p := by simp only [abs_eq_max_neg]; omega + have az : |p-k-1| = -(p-k-1) := by simp only [abs_eq_max_neg] at hp ⊢; omega + have my : (p-(2*k+2-p))%2=0 := by omega + have mz : (p-k-1-((2*k+2-p)-k))%2=1 := by omega + rw [ay, my] at hy + rw [az, mz] at hz + apply mul_left_cancel₀ (by norm_num : (4 : Int) ≠ 0) + linear_combination hz-hy+2*hC + bounds (K : DiamondParameter) (p q : Int) + (h : (⟨p,q⟩ : GaussianInt) ∈ DiamondVertexDomains K false) : + |p| ≤ (K.1 : Int) ∧ |q-K.1| ≤ (K.1 : Int) ∧ + |p|+|q-K.1| ≤ (K.1 : Int)+1 := by + change max (Int.natAbs p) (max (Int.natAbs (q-K.1)) + (Int.natAbs p + Int.natAbs (q-K.1) - 1)) ≤ K.1 at h + rw [max_le_iff, max_le_iff] at h + have hp := Int.natCast_natAbs p + have hq := Int.natCast_natAbs (q-K.1) + omega + stencil (F : Int → Int → Int) + (hscale : ∀ p q, 4*F p q=2*p^2-2*|p|-(p-q)^2+(p-q)%2) (g : IntegerLatticeFunction) (p q e1 + e2 e3 e4 : Int) + (h0 : g ⟨p,q⟩ = F p q) + (h1 : g ⟨p+1,q⟩ = F (p+1) q+e1) + (h2 : g ⟨p-1,q⟩ = F (p-1) q+e2) + (h3 : g ⟨p,q+1⟩ = F p (q+1)+e3) + (h4 : g ⟨p,q-1⟩ = F p (q-1)+e4) : + FourNeighborLaplacian g ⟨p,q⟩ = + 1 - 2*((p-q)%2) - (if p=0 then 1 else 0) + e1+e2+e3+e4 := by + change g ⟨p,q⟩=F p q at h0 + change g ⟨p+1,q⟩=F (p+1) q+e1 at h1 + change g ⟨p-1,q⟩=F (p-1) q+e2 at h2 + change g ⟨p,q+1⟩=F p (q+1)+e3 at h3 + change g ⟨p,q-1⟩=F p (q-1)+e4 at h4 + have a : (⟨p,q⟩ : GaussianInt)+1 = ⟨p+1,q⟩ := by ext <;> simp + have b : (⟨p,q⟩ : GaussianInt)-1 = ⟨p-1,q⟩ := by ext <;> simp + have c : (⟨p,q⟩ : GaussianInt)+⟨0,1⟩ = ⟨p,q+1⟩ := by ext <;> simp + have d : (⟨p,q⟩ : GaussianInt)-⟨0,1⟩ = ⟨p,q-1⟩ := by ext <;> simp + rw [FourNeighborLaplacian, a, b, c, d, h0, h1, h2, h3, h4] + linarith only [formalLap F hscale p q] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondOdometer.lean b/LeanPool/ApollonianSuperharmonic/DiamondOdometer.lean new file mode 100644 index 0000000000..933e02d183 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondOdometer.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondOdometerExistsUnique + +-- [TABLET NODE: DiamondOdometer] + +/-! +# DiamondOdometer + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The diamond odometer $g_k:\mathbb Z^2\to\mathbb Z$ is the unique function +selected by `DiamondOdometerExistsUnique` for the positive parameter +$k$. +-/ +noncomputable def DiamondOdometer (K : DiamondParameter) : IntegerLatticeFunction := +-- BODY + Classical.choose (DiamondOdometerExistsUnique K) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondOdometerExistsUnique.lean b/LeanPool/ApollonianSuperharmonic/DiamondOdometerExistsUnique.lean new file mode 100644 index 0000000000..aaf41ce8db --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondOdometerExistsUnique.lean @@ -0,0 +1,141 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4818T1Representatives +public import LeanPool.ApollonianSuperharmonic.P4818T1BoundaryRecovery +public import LeanPool.ApollonianSuperharmonic.P4818T1OverlapDifferences +public import LeanPool.ApollonianSuperharmonic.P4818T1AffineTransversalExtension + +-- [TABLET NODE: DiamondOdometerExistsUnique] + +/-! +# DiamondOdometerExistsUnique + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem DiamondOdometerExistsUnique (K : DiamondParameter) : + ∃! g : IntegerLatticeFunction, + (∀ x, g (x + ⟨0, -(2 * K.1 : Int)⟩) = g x + + (-(K.1 : Int)) * x.re + ((K.1 : Int) - 1) * x.im - + (K.1 : Int) * ((K.1 : Int) - 2)) ∧ + (∀ x, g (x + ⟨(K.1 + 1 : Int), (K.1 : Int)⟩) = g x + + (K.1 : Int) * x.re + x.im + (K.1 : Int) * (K.1 + 1) / 2) ∧ + (∀ x, g (x + ⟨-(K.1 : Int) - 1, (K.1 : Int)⟩) = g x - + (K.1 : Int) * x.im - (K.1 : Int) * (K.1 + 1) / 2) ∧ + (∀ x, x ∈ DiamondVertexDomains K false -> + g x = (Int.natAbs x.re : Int) * ((Int.natAbs x.re : Int) - 1) / 2 - + (x.re - x.im) ^ 2 / 4) := by +-- BODY + classical + let k : Int := K.1 + let a : GaussianInt := ⟨0, -2 * k⟩ + let b : GaussianInt := ⟨k + 1, k⟩ + let c : GaussianInt := ⟨-k - 1, k⟩ + let C : Int := k * (k + 1) / 2 + let α : GaussianInt →+ Int := + { toFun := fun x => -k * x.re + (k - 1) * x.im + map_zero' := by simp + map_add' := by intros; simp; ring } + let β : GaussianInt →+ Int := + { toFun := fun x => k * x.re + x.im + map_zero' := by simp + map_add' := by intros; simp; ring } + have hrep : ∀ x : GaussianInt, ∃! p : GaussianInt × (Int × Int), + p.1 ∈ P4818T1HalfOpen K ∧ x = p.1 + p.2.1 • a + p.2.2 • b := + P4818T1Representatives K + have hcomm : α b = β a := by + simp [α, β, a, b] + ring + obtain ⟨g, hH, hga, hgb, _, huniq⟩ := + P4818T1AffineTransversalExtension (P4818T1HalfOpen K) a b + α β (-k * (k - 2)) C P4207T1DiamondFormula hrep hcomm + have ga (x) : g (x + a) = g x + (-k) * x.re + + (k - 1) * x.im - k * (k - 2) := by + have h := hga x + change g (x + a) = g x + (-k * x.re + (k - 1) * x.im) + + (-k * (k - 2)) at h + linarith + have gb (x) : g (x + b) = g x + k * x.re + x.im + C := by + have h := hgb x + change g (x + b) = g x + (k * x.re + x.im) + C at h + linarith + have gc (x) : g (x + c) = g x - k * x.im - C := by + have h1 := ga (x + c) + have h2 := gb (x + c + a) + have he : x + c + a + b = x := by + ext <;> simp [a, b, c] <;> ring + rw [he] at h2 + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at h1 h2 + dsimp [a, c] at h1 h2 + nlinarith + obtain ⟨oA, oB, oC⟩ := P4818T1OverlapDifferences K + have pa : ∀ x, x ∈ DiamondVertexDomains K false → + x + a ∈ DiamondVertexDomains K false → + (g x = P4207T1DiamondFormula x ↔ + g (x + a) = P4207T1DiamondFormula (x + a)) := by + intro x hx hxa + have hg := ga x + have hf := oA x hx hxa + constructor <;> intro h <;> linarith + have pb : ∀ x, x ∈ DiamondVertexDomains K false → + x + b ∈ DiamondVertexDomains K false → + (g x = P4207T1DiamondFormula x ↔ + g (x + b) = P4207T1DiamondFormula (x + b)) := by + intro x hx hxb + have hg := gb x + have hf := oB x hx hxb + change _ = k * x.re + x.im + C at hf + constructor <;> intro h <;> linarith + have pc : ∀ x, x ∈ DiamondVertexDomains K false → + x + c ∈ DiamondVertexDomains K false → + (g x = P4207T1DiamondFormula x ↔ + g (x + c) = P4207T1DiamondFormula (x + c)) := by + intro x hx hxc + have hg := gc x + have hf := oC x hx hxc + change _ = -k * x.im - C at hf + constructor <;> intro h <;> linarith + have hclosed : ∀ x, x ∈ DiamondVertexDomains K false → + g x = P4207T1DiamondFormula x := + P4818T1BoundaryRecovery K (fun x => g x = P4207T1DiamondFormula x) + hH (by simpa only [a, k, neg_mul] using pa) + (by simpa only [b, k] using pb) (by simpa only [c, k] using pc) + refine ⟨g, ⟨?_, ?_, ?_, ?_⟩, ?_⟩ + · intro x + simpa only [a, k, neg_mul] using ga x + · intro x + exact gb x + · intro x + exact gc x + · exact hclosed + · intro g' hg' + obtain ⟨ha', hb', _, hF'⟩ := hg' + apply huniq g' + · intro x + change g' (x + a) = g' x + (-k * x.re + (k - 1) * x.im) + + (-k * (k - 2)) + have h : g' (x + a) = g' x + (-k) * x.re + + (k - 1) * x.im - k * (k - 2) := by + simpa only [a, k, neg_mul] using ha' x + linarith + · intro x + change g' (x + b) = g' x + (k * x.re + x.im) + C + have h := hb' x + change g' (x + b) = g' x + k * x.re + x.im + C at h + linarith + · intro h hh + exact hF' h hh.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean new file mode 100644 index 0000000000..fca38544e9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean @@ -0,0 +1,1662 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain +public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.DiamondParameter +public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct + +-- [TABLET NODE: DiamondOpposingBoundaryStarLocalization] + +/-! +# DiamondOpposingBoundaryStarLocalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiamondBoundaryStarGeometry + +private theorem hcurv : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (DiamondRecursiveQuadruple + K i.succ = Ci.1.1) → (((1 : ℤ) < Ci.1.1.1) → (1 < (DiamondRecursiveQuadruple K + (i.succ)).1)) ) := by + classical + intro K Ci i hCi hlarge + rw [hCi] + exact hlarge + +private theorem index_two : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (DiamondRecursiveQuadruple + K i.succ = Ci.1.1) → (∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (p0 : Real × Real), + ∀ (p0' : Real × Real), (TileCentroid T0' - TileCentroid T0 = GaussianRealPoint + (BandVectors.1 (DiamondRecursiveQuadruple K i.succ) (DiamondRecursiveQuadruple K (0 : + Fin (4 : ℕ))))) → ((p0' - p0 = GaussianRealPoint (BandVectors.2 + (DiamondRecursiveQuadruple K i.succ) (DiamondRecursiveQuadruple K (0 : Fin (4 : + ℕ))))) → ((1 < (DiamondRecursiveQuadruple K (i.succ)).1) → (i = 2)))) ) := by + classical + intro K Ci i hCi T0 T0' p0 p0' hcentroid hslope hcurv + fin_cases i + · simp [DiamondRecursiveQuadruple] at hcurv + · simp [DiamondRecursiveQuadruple] at hcurv + · rfl + +private theorem hk2 : + (by + classical + exact + ∀ (K : DiamondParameter), (BandCircle) → (((1 : ℤ) < (DiamondRecursiveQuadruple K + (Fin.succ (2 : Fin (3 : ℕ)))).1) → ((0 < K.1) → (2 ≤ K.1))) ) := by + classical + intro K Ci hcurv hKpos + by_contra hnot + have hone : K.1 = 1 := by omega + simp [DiamondRecursiveQuadruple, hone] at hcurv + +private theorem hC0pos : + (by + classical + exact + ∀ (K : DiamondParameter), (ProperBandQuadruple (DiamondRecursiveQuadruple K)) → (∀ (C0 : + BandCircle), (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ)) = C0.1.1) → ( + 0 < C0.1.1.1)) ) := by + classical + intro K hq C0 hC0 + let q := DiamondRecursiveQuadruple K + rw [← hC0] + exact (ProperBandCurvatureStructure q hq).1 + +private theorem hrootCell : + (by + classical + exact + ∀ (K : DiamondParameter), (BandCircle) → ((BandCircle) → ((0 < K.1) → ((2 ≤ K.1) → ((⟨0, + 0⟩ : GaussianInt) ∈ DiamondCellDomain K.1)))) ) := by + classical + intro K C0 Ci hKpos hk2 + simp only [DiamondCellDomain, Finset.mem_biUnion] + refine ⟨0, by simp [hKpos], ?_⟩ + have hr : Nat.min (0 + 1) (2 * K.1 - 0) = 1 := by + simp only [Nat.zero_add, Nat.sub_zero] + exact Nat.min_eq_left (by omega : 1 ≤ 2 * K.1) + rw [hr] + simp only [Finset.mem_image] + refine ⟨1, by simp, ?_⟩ + simp + +private theorem hT0ne : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T0 : ProtoTile), ∀ (u : GaussianInt), (T0.cells = + (TileTranslation (DiamondTile K.1) u).cells) → (((DiamondTile K.1).cells.Nonempty) → + (T0.cells.Nonempty)) ) := by + classical + intro K T0 u huCell hrootNonempty + rw [huCell] + exact Finset.image_nonempty.mpr hrootNonempty + +private theorem hT0'ne : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T0' : ProtoTile), ∀ (u' : GaussianInt), (T0'.cells = + (TileTranslation (DiamondTile K.1) u').cells) → (((DiamondTile K.1).cells.Nonempty) → + (T0'.cells.Nonempty)) ) := by + classical + intro K T0' u' hu'Cell hrootNonempty + rw [hu'Cell] + exact Finset.image_nonempty.mpr hrootNonempty + +private theorem hT0cent : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T0 : ProtoTile), ∀ (u : GaussianInt), (T0.cells = + (TileTranslation (DiamondTile K.1) u).cells) → ((T0.cells.Nonempty) → (TileCentroid + T0 = TileCentroid (DiamondTile K.1) + GaussianRealPoint u)) ) := by + classical + intro K T0 u huCell hT0ne + have htrne : (TileTranslation (DiamondTile K.1) u).cells.Nonempty := by + rw [← huCell] + exact hT0ne + have hc : TileCentroid T0 = TileCentroid (TileTranslation (DiamondTile K.1) u) := by + unfold TileCentroid + rw [ite_eq_left hT0ne, ite_eq_left htrne, huCell] + rw [hc, (TileTranslationFormulas (DiamondTile K.1) u).2.2.2.2.1] + rfl + +private theorem hT0'cent : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T0' : ProtoTile), ∀ (u' : GaussianInt), (T0'.cells = + (TileTranslation (DiamondTile K.1) u').cells) → ((T0'.cells.Nonempty) → (TileCentroid + T0' = TileCentroid (DiamondTile K.1) + GaussianRealPoint u')) ) := by + classical + intro K T0' u' hu'Cell hT0'ne + have htrne : (TileTranslation (DiamondTile K.1) u').cells.Nonempty := by + rw [← hu'Cell] + exact hT0'ne + have hc : TileCentroid T0' = TileCentroid (TileTranslation (DiamondTile K.1) u') := by + unfold TileCentroid + rw [ite_eq_left hT0'ne, ite_eq_left htrne, hu'Cell] + rw [hc, (TileTranslationFormulas (DiamondTile K.1) u').2.2.2.2.1] + rfl + +private theorem hshift : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), (BandVectors.1 + (DiamondRecursiveQuadruple K (3 : Fin (4 : ℕ))) (DiamondRecursiveQuadruple K (0 : Fin + (4 : ℕ))) = (⟨(0 : ℤ), -((2 : ℤ) * (↑K.1 : ℤ))⟩ : GaussianInt)) → ((TileCentroid T0' + - TileCentroid T0 = GaussianRealPoint (BandVectors.1 (DiamondRecursiveQuadruple K + (Fin.succ (2 : Fin (3 : ℕ)))) (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ))))) → (∀ + (u : GaussianInt), ∀ (u' : GaussianInt), (TileCentroid T0 = TileCentroid (DiamondTile + K.1) + GaussianRealPoint u) → ((TileCentroid T0' = TileCentroid (DiamondTile K.1) + + GaussianRealPoint u') → (u' - u = (⟨0, -(2 * (K.1 : Int))⟩ : GaussianInt))))) ) := by + classical + intro K T0 T0' hv30 hcentroid u u' hT0cent hT0'cent + have hv30' : BandVectors.1 (DiamondRecursiveQuadruple K (Fin.succ 2)) + (DiamondRecursiveQuadruple K 0) = ⟨0, -(2 * (K.1 : Int))⟩ := by + simpa using hv30 + have hh := hcentroid + rw [hT0'cent, hT0cent, hv30'] at hh + have hr' : (u'.re : ℝ) - u.re = 0 := by + have h := congrArg Prod.fst hh + simp? [GaussianRealPoint] at h + rw [← GaussianInt.intCast_re, ← GaussianInt.intCast_re] at h + linarith + have hi' : (u'.im : ℝ) - u.im = -(2 * (K.1 : Int)) := by + have h := congrArg Prod.snd hh + simp? [GaussianRealPoint] at h + rw [← GaussianInt.intCast_im, ← GaussianInt.intCast_im] at h + push_cast at h ⊢ + simpa [GaussianInt.intCast_im] using h + have hr : (u' - u).re = 0 := by + have h : u'.re - u.re = 0 := by exact_mod_cast hr' + simpa [Zsqrtd.re_sub] using h + have hi : (u' - u).im = -(2 * (K.1 : Int)) := by + have h : u'.im - u.im = -(2 * (K.1 : Int)) := by exact_mod_cast hi' + simpa [Zsqrtd.im_sub] using h + apply Zsqrtd.ext + · exact hr + · exact hi + +private theorem hshift' : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (u : GaussianInt), ∀ (u' : GaussianInt), (u' - u = (⟨0, -(2 * + (K.1 : Int))⟩ : GaussianInt)) → (u - u' = (⟨0, 2 * (K.1 : Int)⟩ : GaussianInt)) ) := by + classical + intro K u u' hshift + apply Zsqrtd.ext + · have h := congrArg (fun w : GaussianInt => -w) hshift + simpa using congrArg (fun w : GaussianInt => w.re) h + · have h := congrArg (fun w : GaussianInt => -w) hshift + simpa using congrArg (fun w : GaussianInt => w.im) h + +private theorem Hmem : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (H : PartialOdometer), ((↑H.domain : Set GaussianInt) = + DiamondVertexDomains K false) → (∀ (w : GaussianInt), w ∈ H.domain ↔ w ∈ + DiamondVertexDomains K false) ) := by + classical + intro K H hHdom w + have hh := Set.ext_iff.mp hHdom w + simpa using hh + +private theorem hzUpper : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (h0 : PartialOdometer), ∀ (x : GaussianInt), (x ∈ h0.domain) + → (∀ (H : PartialOdometer), ∀ (u : GaussianInt), (∀ (x : GaussianInt), x ∈ h0.domain + ↔ x - u ∈ H.domain) → ((∀ (w : GaussianInt), w ∈ H.domain ↔ w ∈ DiamondVertexDomains + K false) → ( + let z := x - u + z ∈ DiamondVertexDomains K false))) ) := by + classical + intro K h0 x hx0 H u huDom Hmem z + have hx := (huDom x).mp hx0 + exact (Hmem (x - u)).mp (by simpa using hx) + +private theorem hzLower : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (h0' : PartialOdometer), ∀ (x : GaussianInt), (x ∈ + h0'.domain) → (∀ (H : PartialOdometer), ∀ (u : GaussianInt), ∀ (u' : GaussianInt), (∀ + (x : GaussianInt), x ∈ h0'.domain ↔ x - u' ∈ H.domain) → ((u - u' = (⟨0, 2 * (K.1 : + Int)⟩ : GaussianInt)) → ((∀ (w : GaussianInt), w ∈ H.domain ↔ w ∈ + DiamondVertexDomains K false) → ( + let z := x - u + z + ⟨0, 2 * (K.1 : Int)⟩ ∈ DiamondVertexDomains K false)))) ) := by + classical + intro K h0' x hx0' H u u' hu'Dom hshift' Hmem z + have hx := (hu'Dom x).mp hx0' + have heq : x - u' = z + ⟨0, 2 * (K.1 : Int)⟩ := by + calc + x - u' = (x - u) + (u - u') := by abel + _ = z + ⟨0, 2 * (K.1 : Int)⟩ := by rw [hshift'] + rw [heq] at hx + exact (Hmem (z + ⟨0, 2 * (K.1 : Int)⟩)).mp (by simpa using hx) + +private theorem overlap : + (by + classical + exact + ∀ (K : DiamondParameter), (BandCircle) → ((BandCircle) → (∀ (x : GaussianInt), (2 ≤ K.1) + → (∀ (u : GaussianInt), + let z := x - u + (z ∈ DiamondVertexDomains K false) → ((z + ⟨0, 2 * (K.1 : Int)⟩ ∈ DiamondVertexDomains K + false) → (z.im = 0 ∧ Int.natAbs z.re ≤ 1))))) ) := by + classical + intro K C0 Ci x hk2 u z hzUpper hzLower + change max (Int.natAbs z.re) + (max (Int.natAbs (z.im - (K.1 : Int))) + (Int.natAbs z.re + Int.natAbs (z.im - (K.1 : Int)) - 1)) ≤ K.1 at hzUpper + change max (Int.natAbs (z.re + 0)) + (max (Int.natAbs (z.im + 2 * (K.1 : Int) - (K.1 : Int))) + (Int.natAbs (z.re + 0) + + Int.natAbs (z.im + 2 * (K.1 : Int) - (K.1 : Int)) - 1)) ≤ K.1 at hzLower + simp only [max_le_iff, add_zero] at hzUpper hzLower + omega + +private theorem hwest : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (h0 : PartialOdometer), ∀ (h0' : PartialOdometer), ∀ (x : + GaussianInt), (∀ (y : GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : + GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) → y ∈ h0.domain ∨ y ∈ h0'.domain) → (∀ (H : PartialOdometer), ∀ (u + : GaussianInt), (∀ (x : GaussianInt), x ∈ h0.domain ↔ x - u ∈ H.domain) → (∀ (u' : + GaussianInt), (∀ (x : GaussianInt), x ∈ h0'.domain ↔ x - u' ∈ H.domain) → ((u - u' = + (⟨0, 2 * (K.1 : Int)⟩ : GaussianInt)) → ((∀ (w : GaussianInt), w ∈ H.domain ↔ w ∈ + DiamondVertexDomains K false) → ( + let z := x - u + z - 1 ∈ DiamondVertexDomains K false ∨ z - 1 + ⟨0, 2 * (K.1 : Int)⟩ ∈ + DiamondVertexDomains K false))))) ) := by + classical + intro K h0 h0' x hstar H u huDom u' hu'Dom hshift' Hmem z + have hs := hstar (x - 1) (by simp) + rcases hs with hs | hs + · left + have := (huDom (x - 1)).mp hs + simpa [z, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using + (Hmem (x - 1 - u)).mp (by simpa using this) + · right + have := (hu'Dom (x - 1)).mp hs + have heq : (x - 1) - u' = (z - 1) + ⟨0, 2 * (K.1 : Int)⟩ := by + calc + (x - 1) - u' = (x - u) - 1 + (u - u') := by abel + _ = (z - 1) + ⟨0, 2 * (K.1 : Int)⟩ := by rw [hshift'] + rw [heq] at this + exact (Hmem (z - 1 + ⟨0, 2 * (K.1 : Int)⟩)).mp (by simpa using this) + +private theorem heast : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (h0 : PartialOdometer), ∀ (h0' : PartialOdometer), ∀ (x : + GaussianInt), (∀ (y : GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : + GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) → y ∈ h0.domain ∨ y ∈ h0'.domain) → (∀ (H : PartialOdometer), ∀ (u + : GaussianInt), (∀ (x : GaussianInt), x ∈ h0.domain ↔ x - u ∈ H.domain) → (∀ (u' : + GaussianInt), (∀ (x : GaussianInt), x ∈ h0'.domain ↔ x - u' ∈ H.domain) → ((u - u' = + (⟨0, 2 * (K.1 : Int)⟩ : GaussianInt)) → ((∀ (w : GaussianInt), w ∈ H.domain ↔ w ∈ + DiamondVertexDomains K false) → ( + let z := x - u + z + 1 ∈ DiamondVertexDomains K false ∨ z + 1 + ⟨0, 2 * (K.1 : Int)⟩ ∈ + DiamondVertexDomains K false))))) ) := by + classical + intro K h0 h0' x hstar H u huDom u' hu'Dom hshift' Hmem z + have hs := hstar (x + 1) (by simp) + rcases hs with hs | hs + · left + have := (huDom (x + 1)).mp hs + simpa [z, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using + (Hmem (x + 1 - u)).mp (by simpa using this) + · right + have := (hu'Dom (x + 1)).mp hs + have heq : (x + 1) - u' = (z + 1) + ⟨0, 2 * (K.1 : Int)⟩ := by + calc + (x + 1) - u' = (x - u) + 1 + (u - u') := by abel + _ = (z + 1) + ⟨0, 2 * (K.1 : Int)⟩ := by rw [hshift'] + rw [heq] at this + exact (Hmem (z + 1 + ⟨0, 2 * (K.1 : Int)⟩)).mp (by simpa using this) + +private theorem hzzero : + (by + classical + exact + ∀ (K : DiamondParameter), (BandCircle) → ((BandCircle) → (∀ (x : GaussianInt), (2 ≤ K.1) + → (∀ (u : GaussianInt), + let z := x - u + (z.im = 0 ∧ Int.natAbs z.re ≤ 1) → ((z - 1 ∈ DiamondVertexDomains K false ∨ z - 1 + ⟨0, 2 + * (K.1 : Int)⟩ ∈ DiamondVertexDomains K false) → ((z + 1 ∈ DiamondVertexDomains K + false ∨ z + 1 + ⟨0, 2 * (K.1 : Int)⟩ ∈ DiamondVertexDomains K false) → (z = 0)))))) ) + := by + classical + intro K C0 Ci x hk2 u z overlap hwest heast + obtain ⟨hy, hx⟩ := overlap + let bound (w : GaussianInt) : Prop := max (Int.natAbs w.re) + (max (Int.natAbs (w.im - (K.1 : Int))) + (Int.natAbs w.re + Int.natAbs (w.im - (K.1 : Int)) - 1)) ≤ K.1 + change bound (z - 1) ∨ bound (z - 1 + ⟨0, 2 * (K.1 : Int)⟩) at hwest + change bound (z + 1) ∨ bound (z + 1 + ⟨0, 2 * (K.1 : Int)⟩) at heast + simp only [bound, max_le_iff, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one, + add_zero, sub_zero, hy] at hwest heast + apply Zsqrtd.ext + · change z.re = 0 + omega + · exact hy + +private theorem hx_eq_u : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (u : GaussianInt), + let z := x - u + (z = 0) → (x = u) ) := by + classical + intro x u z hzzero + dsimp [z] at hzzero + exact sub_eq_zero.mp hzzero + +private theorem hroot : + (by + classical + exact + ∀ (K : DiamondParameter), + let q := DiamondRecursiveQuadruple K + (2 ≤ K.1) → (1 < (q 0).1) ) := by + classical + intro K q hk2 + have hn : (1 : ℕ) < 2 * K.1 * (K.1 + 1) := by nlinarith [hk2] + change (1 : ℤ) < (2 * K.1 * (K.1 + 1) : ℕ) + exact_mod_cast hn + +private theorem hATU : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), + (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ)) = C0.1.1) → (∀ (T0 : ProtoTile), + let q := DiamondRecursiveQuadruple K + (ProperBandQuadruple q) → ((DiamondRecursiveQuadruple K (Fin.succ (2 : Fin (3 : ℕ))) = + Ci.1.1) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gS : Fin (3 : ℕ) → Bool → + PartialOdometer), (BandPrototile (q (0 : Fin (4 : ℕ))) T0) → ((∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), TileOdometer (q i.succ) (S i s) (gS i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), FootprintVertices (S i s) ⊆ FootprintVertices T0) → ((∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), TileCentroid (S i s) - TileCentroid T0 = (if s = true then (1 : ℝ) else + (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).1))) → ( + let U := S 2 false + AncestorTile Ci.1.1 C0.1.1 U T0))))))) ) := by + classical + intro K C0 Ci hC0 T0 q hqD hCi S gS hband0 hsub0 hfoot0 hcent0 U + unfold AncestorTile + apply Relation.ReflTransGen.single + refine ⟨q, 2, false, hqD, ?_, ?_, ?_, ?_, hfoot0 2 false, ?_⟩ + · exact hC0 + · exact hCi + · exact (by simpa only [← hC0] using hband0) + · have hb := TileOdometerBandPrototile _ _ _ (hsub0 2 false) + simpa only [← hCi] using hb + · exact hcent0 2 false + +private theorem hATV : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), + (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ)) = C0.1.1) → (∀ (T0' : ProtoTile), + let q := DiamondRecursiveQuadruple K + (ProperBandQuadruple q) → ((DiamondRecursiveQuadruple K (Fin.succ (2 : Fin (3 : ℕ))) = + Ci.1.1) → (∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gS' : Fin (3 : ℕ) → Bool → + PartialOdometer), (BandPrototile (q (0 : Fin (4 : ℕ))) T0') → ((∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), TileOdometer (q i.succ) (S' i s) (gS' i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), FootprintVertices (S' i s) ⊆ FootprintVertices T0') → ((∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileCentroid (S' i s) - TileCentroid T0' = (if s = true then (1 : + ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin + (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).1))) → ( + let V := S' 2 true + AncestorTile Ci.1.1 C0.1.1 V T0'))))))) ) := by + classical + intro K C0 Ci hC0 T0' q hqD hCi S' gS' hband0' hsub0' hfoot0' hcent0' V + unfold AncestorTile + apply Relation.ReflTransGen.single + refine ⟨q, 2, true, hqD, ?_, ?_, ?_, ?_, hfoot0' 2 true, ?_⟩ + · exact hC0 + · exact hCi + · exact (by simpa only [← hC0] using hband0') + · have hb := TileOdometerBandPrototile _ _ _ (hsub0' 2 true) + simpa only [← hCi] using hb + · exact hcent0' 2 true + +private theorem hAncU : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), + (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ)) = C0.1.1) → (∀ (T0 : ProtoTile), ∀ (h0 + : PartialOdometer), (TileOdometer C0.1.1 T0 h0) → ( + let q := DiamondRecursiveQuadruple K + (DiamondRecursiveQuadruple K (Fin.succ (2 : Fin (3 : ℕ))) = Ci.1.1) → (∀ (S : Fin (3 : ℕ) + → Bool → ProtoTile), ∀ (gS : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (S i s) (gS i s)) → ((∀ (x : GaussianInt), + x ∈ h0.domain ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (gS i s).domain) → ((∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (gS i s).domain, h0.value x = (gS i s).value x) → ( + let U := S 2 false + let g := gS 2 false + (0 < Ci.1.1.1) → ((AncestorTile Ci.1.1 C0.1.1 U T0) → (AncestorOdometer Ci.1.1 C0.1.1 U + T0 g h0)))))))) ) := by + classical + intro K C0 Ci hC0 T0 h0 hO0 q hCi S gS hsub0 hdom0 hvalue0 U g hCiPos hATU + refine ⟨by simpa only [← hC0] using hO0, hATU, ?_, ?_, ?_⟩ + · exact PositiveCurvatureTileOdometerDomain Ci.1.1 U g hCiPos + (by simpa only [← hCi] using hsub0 2 false) + · intro y hy + exact (hdom0 y).mpr ⟨2, false, hy⟩ + · intro y hy + exact (hvalue0 2 false y hy).symm + +private theorem hAncV : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), + (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ)) = C0.1.1) → (∀ (T0' : ProtoTile), ∀ + (h0' : PartialOdometer), (TileOdometer C0.1.1 T0' h0') → ( + let q := DiamondRecursiveQuadruple K + (DiamondRecursiveQuadruple K (Fin.succ (2 : Fin (3 : ℕ))) = Ci.1.1) → (∀ (S' : Fin (3 : + ℕ) → Bool → ProtoTile), ∀ (gS' : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (S' i s) (gS' i s)) → ((∀ (x : + GaussianInt), x ∈ h0'.domain ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (gS' i s).domain) + → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (gS' i s).domain, h0'.value x = (gS' i + s).value x) → ( + let V := S' 2 true + let k := gS' 2 true + (0 < Ci.1.1.1) → ((AncestorTile Ci.1.1 C0.1.1 V T0') → (AncestorOdometer Ci.1.1 C0.1.1 V + T0' k h0')))))))) ) := by + classical + intro K C0 Ci hC0 T0' h0' hO0' q hCi S' gS' hsub0' hdom0' hvalue0' V k hCiPos hATV + refine ⟨by simpa only [← hC0] using hO0', hATV, ?_, ?_, ?_⟩ + · exact PositiveCurvatureTileOdometerDomain Ci.1.1 V k hCiPos + (by simpa only [← hCi] using hsub0' 2 true) + · intro y hy + exact (hdom0' y).mpr ⟨2, true, hy⟩ + · intro y hy + exact (hvalue0' 2 true y hy).symm + +private theorem hUcent : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T0 : ProtoTile), + let q := DiamondRecursiveQuadruple K + ∀ (u : GaussianInt), (TileCentroid T0 = TileCentroid (DiamondTile K.1) + + GaussianRealPoint u) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), TileCentroid (S i s) - TileCentroid T0 = (if s = true then (1 : ℝ) else + (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).1))) → ( + let U := S 2 false + ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence (DiamondRecursiveQuadruple K) (DiamondTile K.1) i s (Sc i s)) → + (TileCentroid U = TileCentroid (TileTranslation (Sc 2 false) u)))) ) := by + classical + intro K T0 q u hT0cent S hcent0 U Sc hOcc + have ha := hcent0 2 false + have hb := (hOcc 2 false).2.2 + have ht := (TileTranslationFormulas (Sc 2 false) u).2.2.2.2.1 + have hdelta : TileCentroid U - TileCentroid T0 = + TileCentroid (Sc 2 false) - TileCentroid (DiamondTile K.1) := by + rw [ha, hb] + calc + TileCentroid U = (TileCentroid U - TileCentroid T0) + TileCentroid T0 := by abel + _ = (TileCentroid (Sc 2 false) - TileCentroid (DiamondTile K.1)) + + (TileCentroid (DiamondTile K.1) + GaussianRealPoint u) := by + rw [hdelta, hT0cent] + _ = TileCentroid (TileTranslation (Sc 2 false) u) := by + rw [ht] + apply Prod.ext <;> simp [GaussianRealPoint] <;> ring + +private theorem hVcent : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T0' : ProtoTile), + let q := DiamondRecursiveQuadruple K + ∀ (u' : GaussianInt), (TileCentroid T0' = TileCentroid (DiamondTile K.1) + + GaussianRealPoint u') → (∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileCentroid (S' i s) - TileCentroid T0' = (if s = true then (1 : + ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin + (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).1))) → ( + let V := S' 2 true + ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence (DiamondRecursiveQuadruple K) (DiamondTile K.1) i s (Sc i s)) → + (TileCentroid V = TileCentroid (TileTranslation (Sc 2 true) u')))) ) := by + classical + intro K T0' q u' hT0'cent S' hcent0' V Sc hOcc + have ha := hcent0' 2 true + have hb := (hOcc 2 true).2.2 + have ht := (TileTranslationFormulas (Sc 2 true) u').2.2.2.2.1 + have hdelta : TileCentroid V - TileCentroid T0' = + TileCentroid (Sc 2 true) - TileCentroid (DiamondTile K.1) := by + rw [ha, hb] + calc + TileCentroid V = (TileCentroid V - TileCentroid T0') + TileCentroid T0' := by abel + _ = (TileCentroid (Sc 2 true) - TileCentroid (DiamondTile K.1)) + + (TileCentroid (DiamondTile K.1) + GaussianRealPoint u') := by + rw [hdelta, hT0'cent] + _ = TileCentroid (TileTranslation (Sc 2 true) u') := by + rw [ht] + apply Prod.ext <;> simp [GaussianRealPoint] <;> ring + +private theorem hUcells : + (by + classical + exact + ∀ (K : DiamondParameter), + let q := DiamondRecursiveQuadruple K + ∀ (u : GaussianInt), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gS : Fin (3 : ℕ) → Bool → + PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (S i s) + (gS i s)) → ( + let U := S 2 false + ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence (DiamondRecursiveQuadruple K) (DiamondTile K.1) i s (Sc i s)) → + ((TileCentroid U = TileCentroid (TileTranslation (Sc 2 false) u)) → (U.cells = + (TileTranslation (Sc 2 false) u).cells))) ) := by + classical + intro K q u S gS hsub0 U Sc hOcc hUcent + have hUb := TileOdometerBandPrototile _ _ _ + (hsub0 2 false) + have hCb := BandPrototileTranslation (q 3) (Sc 2 false) u (hOcc 2 false).1 + exact (BandPrototileCentroidUnique _ _ _ hUb hCb hUcent).1 + +private theorem hVcells : + (by + classical + exact + ∀ (K : DiamondParameter), + let q := DiamondRecursiveQuadruple K + ∀ (u' : GaussianInt), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gS' : Fin (3 : ℕ) → + Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) + (S' i s) (gS' i s)) → ( + let V := S' 2 true + ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence (DiamondRecursiveQuadruple K) (DiamondTile K.1) i s (Sc i s)) → + ((TileCentroid V = TileCentroid (TileTranslation (Sc 2 true) u')) → (V.cells = + (TileTranslation (Sc 2 true) u').cells))) ) := by + classical + intro K q u' S' gS' hsub0' V Sc hOcc hVcent + have hVb := TileOdometerBandPrototile _ _ _ + (hsub0' 2 true) + have hCb := BandPrototileTranslation (q 3) (Sc 2 true) u' (hOcc 2 true).1 + exact (BandPrototileCentroidUnique _ _ _ hVb hCb hVcent).1 + +private theorem hmcast : + (by + classical + exact + ∀ (K : DiamondParameter), (BandCircle) → ((BandCircle) → ((GaussianInt) → ((2 ≤ K.1) → + ((GaussianInt) → ( + let m := K.1 - 1 + (m : Int) = (K.1 : Int) - 1))))) ) := by + classical + intro K C0 Ci x hk2 u m + dsimp [m] + have hk : 1 ≤ K.1 := by omega + simp [hk] + +private theorem hcell0 : + (by + classical + exact + ∀ (K : DiamondParameter), (BandCircle) → ((BandCircle) → ((GaussianInt) → ((GaussianInt) → ( + let m := K.1 - 1 + (0 < m) → ((0 : GaussianInt) ∈ DiamondCellDomain m))))) ) := by + classical + intro K C0 Ci x u m hmpos + simp only [DiamondCellDomain, Finset.mem_biUnion] + refine ⟨0, by simp [hmpos], ?_⟩ + have hr : Nat.min (0 + 1) (2 * m - 0) = 1 := by + simp only [Nat.zero_add, Nat.sub_zero] + exact Nat.min_eq_left (by omega : 1 ≤ 2 * m) + rw [hr] + simp only [Finset.mem_image] + exact ⟨1, by simp, by ext <;> simp⟩ + +private theorem hrow : + (by + classical + exact + ∀ (K : DiamondParameter), (BandCircle) → ((BandCircle) → ((GaussianInt) → ((GaussianInt) → ( + let m := K.1 - 1 + (0 < m) → (((2 * m - 1 : Nat) : Int) = 2 * (m : Int) - 1))))) ) := by + classical + intro K C0 Ci x u m hmpos + rw [Nat.cast_sub (by omega : 1 ≤ 2 * m)] + push_cast + ring + +private theorem htop : + (by + classical + exact + ∀ (K : DiamondParameter), (BandCircle) → ((BandCircle) → ((GaussianInt) → ((GaussianInt) → ( + let m := K.1 - 1 + (0 < m) → ((((2 * m - 1 : Nat) : Int) = 2 * (m : Int) - 1) → ((⟨-1, 2 * (m : Int) - 1⟩ : + GaussianInt) ∈ DiamondCellDomain m)))))) ) := by + classical + intro K C0 Ci x u m hmpos hrow + simp only [DiamondCellDomain, Finset.mem_biUnion] + refine ⟨2 * m - 1, ?_, ?_⟩ + · simpa only [Finset.mem_range] using + (Nat.sub_lt (by omega : 0 < 2 * m) (by norm_num : 0 < (1 : Nat))) + have hr : Nat.min ((2 * m - 1) + 1) (2 * m - (2 * m - 1)) = 1 := by + have hfirst : (2 * m - 1) + 1 = 2 * m := by omega + have hsecond : 2 * m - (2 * m - 1) = 1 := + (Nat.sub_eq_iff_eq_add (by omega : 2 * m - 1 ≤ 2 * m)).2 (by omega) + rw [hfirst, hsecond] + exact Nat.min_eq_right (by omega) + rw [hr] + simp only [Finset.mem_image] + refine ⟨0, by simp, ?_⟩ + ext <;> simp [hrow] + +private theorem hbaseFoot : + (by + classical + exact + ∀ (K : DiamondParameter), + let m := K.1 - 1 + ∀ (w : GaussianInt), (w ∈ (DiamondTile m).cells) → (w ∈ FootprintVertices (DiamondTile m) + ∧ w + 1 ∈ FootprintVertices (DiamondTile m) ∧ w + ⟨0, 1⟩ ∈ FootprintVertices + (DiamondTile m) ∧ w + 1 + ⟨0, 1⟩ ∈ FootprintVertices (DiamondTile m)) ) := by + classical + intro K m w hw + have hne : (DiamondTile m).cells.Nonempty := ⟨w, hw⟩ + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + exact ⟨⟨w, hw, Or.inl rfl⟩, + ⟨w, hw, Or.inr (Or.inl rfl)⟩, + ⟨w, hw, Or.inr (Or.inr (Or.inl rfl))⟩, + ⟨w, hw, Or.inr (Or.inr (Or.inr rfl))⟩⟩ + +private theorem hVcells' : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (u' : GaussianInt), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), + let V := S' 2 true + ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (Sc (2 : Fin (3 : ℕ)) true = TileTranslation + (DiamondTile (K.1 - (1 : ℕ))) (⟨(0 : ℤ), (2 : ℤ)⟩ : GaussianInt)) → ((V.cells = + (TileTranslation (Sc 2 true) u').cells) → ( + let m := K.1 - 1 + V.cells = (TileTranslation (TileTranslation (DiamondTile m) ⟨0, 2⟩) u').cells)) ) := by + classical + intro K u' S' V Sc h2t hVcells m + simpa only [h2t] using hVcells + +private theorem hUn : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (u : GaussianInt), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let U := S 2 false + let m := K.1 - 1 + ((0 : GaussianInt) ∈ DiamondCellDomain m) → ((U.cells = (TileTranslation (DiamondTile m) + u).cells) → (U.cells.Nonempty)) ) := by + classical + intro K u S U m hcell0 hUcells' + rw [hUcells'] + exact Finset.image_nonempty.mpr ⟨0, hcell0⟩ + +private theorem hUFoot : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (u : GaussianInt), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let U := S 2 false + let m := K.1 - 1 + (U.cells = (TileTranslation (DiamondTile m) u).cells) → ((U.cells.Nonempty) → + (((TileTranslation (DiamondTile m) u).cells.Nonempty) → (FootprintVertices U = + FootprintVertices (TileTranslation (DiamondTile m) u)))) ) := by + classical + intro K u S U m hUcells' hUn hCn + unfold FootprintVertices + rw [ite_eq_left hUn, ite_eq_left hCn, hUcells'] + +private theorem hVn : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (u' : GaussianInt), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), + let V := S' 2 true + let m := K.1 - 1 + ((⟨-1, 2 * (m : Int) - 1⟩ : GaussianInt) ∈ DiamondCellDomain m) → ((V.cells = + (TileTranslation (TileTranslation (DiamondTile m) ⟨0, 2⟩) u').cells) → + (V.cells.Nonempty)) ) := by + classical + intro K u' S' V m htop hVcells' + rw [hVcells'] + apply Finset.image_nonempty.mpr + apply Finset.image_nonempty.mpr + exact ⟨⟨-1, 2 * (m : Int) - 1⟩, htop⟩ + +private theorem hCn' : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (u' : GaussianInt), + let m := K.1 - 1 + ((⟨-1, 2 * (m : Int) - 1⟩ : GaussianInt) ∈ DiamondCellDomain m) → ((TileTranslation + (TileTranslation (DiamondTile m) ⟨0, 2⟩) u').cells.Nonempty) ) := by + classical + intro K u' m htop + apply Finset.image_nonempty.mpr + apply Finset.image_nonempty.mpr + exact ⟨⟨-1, 2 * (m : Int) - 1⟩, htop⟩ + +private theorem hVFoot : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (u' : GaussianInt), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), + let V := S' 2 true + let m := K.1 - 1 + (V.cells = (TileTranslation (TileTranslation (DiamondTile m) ⟨0, 2⟩) u').cells) → + ((V.cells.Nonempty) → (((TileTranslation (TileTranslation (DiamondTile m) ⟨0, 2⟩) + u').cells.Nonempty) → (FootprintVertices V = FootprintVertices (TileTranslation + (TileTranslation (DiamondTile m) ⟨0, 2⟩) u')))) ) := by + classical + intro K u' S' V m hVcells' hVn hCn' + unfold FootprintVertices + rw [ite_eq_left hVn, ite_eq_left hCn', hVcells'] + +private theorem hu' : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (u : GaussianInt), ∀ (u' : GaussianInt), (u' - u = (⟨0, -(2 * + (K.1 : Int))⟩ : GaussianInt)) → (u' = u + ⟨0, -(2 * (K.1 : Int))⟩) ) := by + classical + intro K u u' hshift + have hh := congrArg (fun w : GaussianInt => w + u) hshift + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hh + +private theorem hUpperC : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (u : GaussianInt), + let m := K.1 - 1 + ((0 : GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ (0 : GaussianInt) + (1 : + GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ (0 : GaussianInt) + (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ (0 : GaussianInt) + (1 : + GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile + m)) → (u ∈ FootprintVertices (TileTranslation (DiamondTile m) u)) ) := by + classical + intro K u m hbase0 + rw [(TileTranslationFormulas (DiamondTile m) u).2.2.2.2.2.1] + exact ⟨0, hbase0.1, by simp [GaussianTranslation, add_comm]⟩ + +private theorem hUpperE : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (u : GaussianInt), + let m := K.1 - 1 + ((0 : GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ (0 : GaussianInt) + (1 : + GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ (0 : GaussianInt) + (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ (0 : GaussianInt) + (1 : + GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile + m)) → (u + 1 ∈ FootprintVertices (TileTranslation (DiamondTile m) u)) ) := by + classical + intro K u m hbase0 + rw [(TileTranslationFormulas (DiamondTile m) u).2.2.2.2.2.1] + exact ⟨1, hbase0.2.1, by simp [GaussianTranslation, add_comm]⟩ + +private theorem hUpperN : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (u : GaussianInt), + let m := K.1 - 1 + ((0 : GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ (0 : GaussianInt) + (1 : + GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ (0 : GaussianInt) + (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ (0 : GaussianInt) + (1 : + GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile + m)) → (u + ⟨0, 1⟩ ∈ FootprintVertices (TileTranslation (DiamondTile m) u)) ) := by + classical + intro K u m hbase0 + rw [(TileTranslationFormulas (DiamondTile m) u).2.2.2.2.2.1] + exact ⟨⟨0, 1⟩, hbase0.2.2.1, by simp [GaussianTranslation, add_comm]⟩ + +private theorem hLowerC : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (u : GaussianInt), ∀ (u' : GaussianInt), + let m := K.1 - 1 + ((m : Int) = (K.1 : Int) - 1) → (((⟨(-1 : ℤ), (2 : ℤ) * (↑m : ℤ) - (1 : ℤ)⟩ : + GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ (⟨(-1 : ℤ), (2 : ℤ) * (↑m : ℤ) - + (1 : ℤ)⟩ : GaussianInt) + (1 : GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ + (⟨(-1 : ℤ), (2 : ℤ) * (↑m : ℤ) - (1 : ℤ)⟩ : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ (⟨(-1 : ℤ), (2 : ℤ) * (↑m : ℤ) - + (1 : ℤ)⟩ : GaussianInt) + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ + FootprintVertices (DiamondTile m)) → ((u' = u + ⟨0, -(2 * (K.1 : Int))⟩) → (u ∈ + FootprintVertices (TileTranslation (TileTranslation (DiamondTile m) ⟨0, 2⟩) u')))) ) + := by + classical + intro K u u' m hmcast hbaseTop hu' + rw [(TileTranslationFormulas (TileTranslation (DiamondTile m) ⟨0, 2⟩) u').2.2.2.2.2.1, + (TileTranslationFormulas (DiamondTile m) ⟨0, 2⟩).2.2.2.2.2.1] + refine ⟨GaussianTranslation ⟨0, 2⟩ + (⟨-1, 2 * (m : Int) - 1⟩ + 1 + ⟨0, 1⟩), + ⟨⟨-1, 2 * (m : Int) - 1⟩ + 1 + ⟨0, 1⟩, + hbaseTop.2.2.2, rfl⟩, ?_⟩ + rw [hu'] + simp only [GaussianTranslation] + ext <;> simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, + Zsqrtd.im_one, add_zero, hmcast] <;> ring + +private theorem hLowerW : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (u : GaussianInt), ∀ (u' : GaussianInt), + let m := K.1 - 1 + ((m : Int) = (K.1 : Int) - 1) → (((⟨(-1 : ℤ), (2 : ℤ) * (↑m : ℤ) - (1 : ℤ)⟩ : + GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ (⟨(-1 : ℤ), (2 : ℤ) * (↑m : ℤ) - + (1 : ℤ)⟩ : GaussianInt) + (1 : GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ + (⟨(-1 : ℤ), (2 : ℤ) * (↑m : ℤ) - (1 : ℤ)⟩ : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ (⟨(-1 : ℤ), (2 : ℤ) * (↑m : ℤ) - + (1 : ℤ)⟩ : GaussianInt) + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ + FootprintVertices (DiamondTile m)) → ((u' = u + ⟨0, -(2 * (K.1 : Int))⟩) → (u - 1 ∈ + FootprintVertices (TileTranslation (TileTranslation (DiamondTile m) ⟨0, 2⟩) u')))) ) + := by + classical + intro K u u' m hmcast hbaseTop hu' + rw [(TileTranslationFormulas (TileTranslation (DiamondTile m) ⟨0, 2⟩) u').2.2.2.2.2.1, + (TileTranslationFormulas (DiamondTile m) ⟨0, 2⟩).2.2.2.2.2.1] + refine ⟨GaussianTranslation ⟨0, 2⟩ + (⟨-1, 2 * (m : Int) - 1⟩ + ⟨0, 1⟩), + ⟨⟨-1, 2 * (m : Int) - 1⟩ + ⟨0, 1⟩, + hbaseTop.2.2.1, rfl⟩, ?_⟩ + rw [hu'] + simp only [GaussianTranslation] + ext <;> simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, + Zsqrtd.im_one, Zsqrtd.re_sub, Zsqrtd.im_sub, add_zero, hmcast] <;> ring + +private theorem hLowerS : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (u : GaussianInt), ∀ (u' : GaussianInt), + let m := K.1 - 1 + ((m : Int) = (K.1 : Int) - 1) → (((⟨(-1 : ℤ), (2 : ℤ) * (↑m : ℤ) - (1 : ℤ)⟩ : + GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ (⟨(-1 : ℤ), (2 : ℤ) * (↑m : ℤ) - + (1 : ℤ)⟩ : GaussianInt) + (1 : GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ + (⟨(-1 : ℤ), (2 : ℤ) * (↑m : ℤ) - (1 : ℤ)⟩ : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∈ FootprintVertices (DiamondTile m) ∧ (⟨(-1 : ℤ), (2 : ℤ) * (↑m : ℤ) - + (1 : ℤ)⟩ : GaussianInt) + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ + FootprintVertices (DiamondTile m)) → ((u' = u + ⟨0, -(2 * (K.1 : Int))⟩) → (u - ⟨0, + 1⟩ ∈ FootprintVertices (TileTranslation (TileTranslation (DiamondTile m) ⟨0, 2⟩) + u')))) ) := by + classical + intro K u u' m hmcast hbaseTop hu' + rw [(TileTranslationFormulas (TileTranslation (DiamondTile m) ⟨0, 2⟩) u').2.2.2.2.2.1, + (TileTranslationFormulas (DiamondTile m) ⟨0, 2⟩).2.2.2.2.2.1] + refine ⟨GaussianTranslation ⟨0, 2⟩ + (⟨-1, 2 * (m : Int) - 1⟩ + 1), + ⟨⟨-1, 2 * (m : Int) - 1⟩ + 1, + hbaseTop.2.1, rfl⟩, ?_⟩ + rw [hu'] + simp only [GaussianTranslation] + ext <;> simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, + Zsqrtd.im_one, Zsqrtd.re_sub, Zsqrtd.im_sub, add_zero, hmcast] <;> ring + +private theorem hxu : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (x : GaussianInt), ∀ (u : GaussianInt), (x = u) → (∀ (S : Fin + (3 : ℕ) → Bool → ProtoTile), ∀ (gS : Fin (3 : ℕ) → Bool → PartialOdometer), + let U := S 2 false + let g := gS 2 false + let m := K.1 - 1 + (FootprintVertices U = FootprintVertices (TileTranslation (DiamondTile m) u)) → ((u ∈ + FootprintVertices (TileTranslation (DiamondTile m) u)) → (((g.domain : Set + GaussianInt) = FootprintVertices U) → (x ∈ g.domain)))) ) := by + classical + intro K x u hx_eq_u S gS U g m hUFoot hUpperC hgFoot + rw [hx_eq_u] + change u ∈ (g.domain : Set GaussianInt) + rw [hgFoot, hUFoot] + exact hUpperC + +private theorem hxk : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (x : GaussianInt), ∀ (u : GaussianInt), ∀ (u' : GaussianInt), + (x = u) → (∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gS' : Fin (3 : ℕ) → Bool → + PartialOdometer), + let V := S' 2 true + let k := gS' 2 true + let m := K.1 - 1 + (FootprintVertices V = FootprintVertices (TileTranslation (TileTranslation (DiamondTile + m) ⟨0, 2⟩) u')) → ((u ∈ FootprintVertices (TileTranslation (TileTranslation + (DiamondTile m) ⟨0, 2⟩) u')) → (((k.domain : Set GaussianInt) = FootprintVertices V) + → (x ∈ k.domain)))) ) := by + classical + intro K x u u' hx_eq_u S' gS' V k m hVFoot hLowerC hkFoot + rw [hx_eq_u] + change u ∈ (k.domain : Set GaussianInt) + rw [hkFoot, hVFoot] + exact hLowerC + +private theorem hcoverage : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (h0 : PartialOdometer), ∀ (h0' : PartialOdometer), ∀ (x : + GaussianInt), (x ∈ h0.domain) → ((x ∈ h0'.domain) → ((∀ (y : GaussianInt), y = x ∨ y + = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ h0.domain ∨ y ∈ + h0'.domain) → (∀ (u : GaussianInt), ∀ (u' : GaussianInt), + let z := x - u + (z ∈ DiamondVertexDomains K false) → ((z + ⟨0, 2 * (K.1 : Int)⟩ ∈ DiamondVertexDomains K + false) → ((z.im = 0 ∧ Int.natAbs z.re ≤ 1) → ((z - 1 ∈ DiamondVertexDomains K false ∨ + z - 1 + ⟨0, 2 * (K.1 : Int)⟩ ∈ DiamondVertexDomains K false) → ((z + 1 ∈ + DiamondVertexDomains K false ∨ z + 1 + ⟨0, 2 * (K.1 : Int)⟩ ∈ DiamondVertexDomains K + false) → ((z = 0) → ((x = u) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gS : Fin + (3 : ℕ) → Bool → PartialOdometer), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gS' : + Fin (3 : ℕ) → Bool → PartialOdometer), + let U := S 2 false + let V := S' 2 true + let g := gS 2 false + let k := gS' 2 true + let m := K.1 - 1 + (FootprintVertices U = FootprintVertices (TileTranslation (DiamondTile m) u)) → + ((FootprintVertices V = FootprintVertices (TileTranslation (TileTranslation + (DiamondTile m) ⟨0, 2⟩) u')) → ((u + 1 ∈ FootprintVertices (TileTranslation + (DiamondTile m) u)) → ((u + ⟨0, 1⟩ ∈ FootprintVertices (TileTranslation (DiamondTile + m) u)) → ((u - 1 ∈ FootprintVertices (TileTranslation (TileTranslation (DiamondTile + m) ⟨0, 2⟩) u')) → ((u - ⟨0, 1⟩ ∈ FootprintVertices (TileTranslation (TileTranslation + (DiamondTile m) ⟨0, 2⟩) u')) → (((g.domain : Set GaussianInt) = FootprintVertices U) + → (((k.domain : Set GaussianInt) = FootprintVertices V) → ((x ∈ g.domain) → ((x ∈ + k.domain) → (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y + ∈ g.domain ∨ y ∈ k.domain)))))))))))))))))))) ) := by + classical + intro K h0 h0' x hx0 hx0' hstar u u' z hzUpper hzLower overlap hwest heast hzzero hx_eq_u S gS + S' gS' U V g k m hUFoot hVFoot hUpperE hUpperN hLowerW hLowerS hgFoot hkFoot hxu hxk y hy + rcases hy with rfl | rfl | rfl | rfl | rfl + · exact Or.inl hxu + · left + rw [hx_eq_u] + change u + 1 ∈ (g.domain : Set GaussianInt) + rw [hgFoot, hUFoot] + exact hUpperE + · right + rw [hx_eq_u] + change u - 1 ∈ (k.domain : Set GaussianInt) + rw [hkFoot, hVFoot] + exact hLowerW + · left + rw [hx_eq_u] + change u + ⟨0, 1⟩ ∈ (g.domain : Set GaussianInt) + rw [hgFoot, hUFoot] + exact hUpperN + · right + rw [hx_eq_u] + change u - ⟨0, 1⟩ ∈ (k.domain : Set GaussianInt) + rw [hkFoot, hVFoot] + exact hLowerS + +private theorem h21 : + (by + classical + exact + ∀ (K : DiamondParameter), + let q := DiamondRecursiveQuadruple K + (ProperBandQuadruple q) → ((BandVectors.2 (DiamondRecursiveQuadruple K (2 : Fin (4 : ℕ))) + (DiamondRecursiveQuadruple K (1 : Fin (4 : ℕ))) = (⟨(0 : ℤ), (-1 : ℤ)⟩ : + GaussianInt)) → (BandVectors.1 (q 2) (q 1) = (-1 + ⟨0, 1⟩ : GaussianInt))) ) := by + classical + intro K q hqD hA21 + have hp := (VectorSquareProduct q hqD.1 2 1 (by decide)).2 + have hq2 : q 2 = (1, (1 : GaussianInt)) := by + simp [q, DiamondRecursiveQuadruple] + have hq1 : q 1 = (1, (1 : GaussianInt) + 2 * (⟨0, 1⟩ : GaussianInt)) := by + norm_num [q, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] + rw [hA21, hq2, hq1] at hp + have hre := congrArg (fun z : GaussianInt => z.re) hp + have him := congrArg (fun z : GaussianInt => z.im) hp + norm_num [Zsqrtd.re_mul, Zsqrtd.im_mul] at hre him + have hreal : (BandVectors.1 (q 2) (q 1)).re = -1 := by + change (BandVectors.1 (1, 1) + (1, (1 : GaussianInt) + 2 * (⟨0, 1⟩ : GaussianInt))).re = -1 + linarith [him] + have himag : (BandVectors.1 (q 2) (q 1)).im = 1 := by + change (BandVectors.1 (1, 1) + (1, (1 : GaussianInt) + 2 * (⟨0, 1⟩ : GaussianInt))).im = 1 + linarith [hre] + apply Zsqrtd.ext + · simpa using hreal + · simpa using himag + +private theorem hmreal : + (by + classical + exact + ∀ (K : DiamondParameter), + let m := K.1 - 1 + ((K.1 : Real) = (m : Real) + 1) → ((m : Real) = (K.1 : Real) - 1) ) := by + classical + intro K m hKreal + rw [hKreal] + ring + +private theorem hqprev0 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (Ci : BandCircle), + (DiamondRecursiveQuadruple K (Fin.succ (2 : Fin (3 : ℕ))) = Ci.1.1) → ( + let m := K.1 - 1 + ∀ (hmpos : 0 < m), + let Kprev : DiamondParameter := ⟨m, hmpos⟩ + let qprev := DiamondRecursiveQuadruple Kprev + (m + 1 = K.1) → (((K.1 : Int) = (m : Int) + 1) → (qprev 0 = Ci.1.1))) ) := by + classical + intro K Ci hCi m hmpos Kprev qprev hKrel hKcast + let q := DiamondRecursiveQuadruple K + calc + qprev 0 = q 3 := by + apply Prod.ext + · dsimp [qprev, Kprev, q, DiamondRecursiveQuadruple] + rw [← hKrel] + rw [Nat.succ_sub_one] + push_cast + ring + · apply Zsqrtd.ext + all_goals + dsimp [qprev, Kprev, q, DiamondRecursiveQuadruple] + all_goals rw [hKcast] + _ = Ci.1.1 := hCi + +private theorem hv30'At635 : + (by + classical + exact + ∀ (K : DiamondParameter), + let q := DiamondRecursiveQuadruple K + (BandVectors.1 (DiamondRecursiveQuadruple K (3 : Fin (4 : ℕ))) (DiamondRecursiveQuadruple + K (0 : Fin (4 : ℕ))) = (⟨(0 : ℤ), -((2 : ℤ) * (↑K.1 : ℤ))⟩ : GaussianInt)) → + (BandVectors.1 (q 3) (q 0) = (⟨0, -(2 * (K.1 : Int))⟩ : GaussianInt)) ) := by + classical + intro K q hv30 + simpa [q] using hv30 + +private theorem hrootcent : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), (BandVectors.1 + (DiamondRecursiveQuadruple K (3 : Fin (4 : ℕ))) (DiamondRecursiveQuadruple K (0 : Fin + (4 : ℕ))) = (⟨(0 : ℤ), -((2 : ℤ) * (↑K.1 : ℤ))⟩ : GaussianInt)) → ((TileCentroid T0' + - TileCentroid T0 = GaussianRealPoint (BandVectors.1 (DiamondRecursiveQuadruple K + (Fin.succ (2 : Fin (3 : ℕ)))) (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ))))) → + (TileCentroid T0' - TileCentroid T0 = (0, -(2 * (K.1 : Real))))) ) := by + classical + intro K T0 T0' hv30 hcentroid + have hvec : BandVectors.1 (DiamondRecursiveQuadruple K (Fin.succ 2)) + (DiamondRecursiveQuadruple K 0) = + (⟨0, -(2 * (K.1 : Int))⟩ : GaussianInt) := by simpa using hv30 + rw [hcentroid] + rw [hvec] + simp [GaussianRealPoint] + +private theorem hUoffset : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T0 : ProtoTile), + let q := DiamondRecursiveQuadruple K + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid + (S i s) - TileCentroid T0 = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ( + let U := S 2 false + (BandVectors.1 (q 2) (q 1) = (-1 + ⟨0, 1⟩ : GaussianInt)) → (TileCentroid U - + TileCentroid T0 = (0, -(1 / 2 : Real) * (1 + 1)))) ) := by + classical + intro K T0 q S hcent0 U h21 + have h := hcent0 2 false + simpa [U, h21, GaussianRealPoint] using h + +private theorem hUreverse : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let U := S 2 false + (TileCentroid U - TileCentroid T0 = (0, -(1 / 2 : Real) * (1 + 1))) → (TileCentroid T0 - + TileCentroid U = (0, (1 / 2 : Real) * (1 + 1))) ) := by + classical + intro T0 S U hUoffset + calc + TileCentroid T0 - TileCentroid U = + -(TileCentroid U - TileCentroid T0) := by abel + _ = (0, (1 / 2 : Real) * (1 + 1)) := by + rw [hUoffset] + apply Prod.ext + · simp + · norm_num + +private theorem hVoffset : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T0' : ProtoTile), + let q := DiamondRecursiveQuadruple K + ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid + (S' i s) - TileCentroid T0' = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) + • (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ( + let V := S' 2 true + (BandVectors.1 (q 2) (q 1) = (-1 + ⟨0, 1⟩ : GaussianInt)) → (TileCentroid V - + TileCentroid T0' = (0, (1 / 2 : Real) * (1 + 1)))) ) := by + classical + intro K T0' q S' hcent0' V h21 + have h := hcent0' 2 true + simpa [V, h21, GaussianRealPoint] using h + +private theorem hchildcent : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (S : Fin (3 : ℕ) → + Bool → ProtoTile), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), + let U := S 2 false + let V := S' 2 true + let m := K.1 - 1 + ∀ (hmpos : 0 < m), + let Kprev : DiamondParameter := ⟨m, hmpos⟩ + let qprev := DiamondRecursiveQuadruple Kprev + (BandVectors.1 (DiamondRecursiveQuadruple Kprev (3 : Fin (4 : ℕ))) + (DiamondRecursiveQuadruple Kprev (0 : Fin (4 : ℕ))) = (⟨(0 : ℤ), -((2 : ℤ) * + (↑Kprev.1 : ℤ))⟩ : GaussianInt)) → (((K.1 : Real) = (m : Real) + 1) → + ((TileCentroid T0' - TileCentroid T0 = (0, -(2 * (K.1 : Real)))) → ((TileCentroid T0 + - TileCentroid U = (0, (1 / 2 : Real) * (1 + 1))) → ((TileCentroid V - TileCentroid + T0' = (0, (1 / 2 : Real) * (1 + 1))) → (TileCentroid V - TileCentroid U = + GaussianRealPoint (BandVectors.1 (qprev 3) (qprev 0))))))) ) := by + classical + intro K T0 T0' S S' U V m hmpos Kprev qprev hcentprev hKreal hrootcent hUreverse hVoffset + have hcalc : TileCentroid V - TileCentroid U = + (0, -2 * (K.1 : Real) + 2) := by + calc + TileCentroid V - TileCentroid U = + (TileCentroid V - TileCentroid T0') + + (TileCentroid T0' - TileCentroid T0) + + (TileCentroid T0 - TileCentroid U) := by + abel + _ = (0, (1 / 2 : Real) * (1 + 1)) + + (0, -(2 * (K.1 : Real))) + + (0, (1 / 2 : Real) * (1 + 1)) := by + rw [hVoffset, hrootcent, hUreverse] + _ = (0, -2 * (K.1 : Real) + 2) := by + apply Prod.ext + · simp + · simp; ring + have hcoords : GaussianRealPoint (BandVectors.1 (qprev 3) (qprev 0)) = + (0, -2 * (K.1 : Real) + 2) := by + rw [hcentprev] + dsimp only [GaussianRealPoint, Kprev] + apply Prod.ext + · norm_num + · push_cast + rw [hKreal] + ring + exact hcalc.trans hcoords.symm + +private theorem hrootSlope : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (p0 : Real × Real), ∀ (p0' : Real × Real), (BandVectors.2 + (DiamondRecursiveQuadruple K (3 : Fin (4 : ℕ))) (DiamondRecursiveQuadruple K (0 : Fin + (4 : ℕ))) = (⟨-(↑K.1 : ℤ), (↑K.1 : ℤ) - (1 : ℤ)⟩ : GaussianInt)) → ((p0' - p0 = + GaussianRealPoint (BandVectors.2 (DiamondRecursiveQuadruple K (Fin.succ (2 : Fin (3 : + ℕ)))) (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ))))) → (p0' - p0 = (-(K.1 : Real), + (K.1 : Real) - 1))) ) := by + classical + intro K p0 p0' hA30 hslope + rw [hslope] + have hA30' : BandVectors.2 (DiamondRecursiveQuadruple K (Fin.succ 2)) + (DiamondRecursiveQuadruple K 0) = + (⟨-(K.1 : Int), (K.1 : Int) - 1⟩ : GaussianInt) := by + exact hA30 + rw [hA30'] + simp [GaussianRealPoint] + +private theorem hux' : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (p0 : Real × Real), + let q := DiamondRecursiveQuadruple K + ∀ (pr : ℝ × ℝ), ∀ (pU : ℝ × ℝ), (pU.1 - pr.1 = (if false = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : Fin (3 : + ℕ))).succ) (q ((2 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((2 : Fin (3 : + ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((pr = p0) → ((BandVectors.2 (q 2) (q 1) + = (⟨0, -1⟩ : GaussianInt)) → (pU.1 - p0.1 = -(1 / 2 : Real)))) ) := by + classical + intro K p0 q pr pU hux hpr0 hA21q + rw [← hpr0] + simpa [hA21q] using hux + +private theorem huy' : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (p0 : Real × Real), + let q := DiamondRecursiveQuadruple K + ∀ (pr : ℝ × ℝ), ∀ (pU : ℝ × ℝ), (pU.2 - pr.2 = (if false = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : Fin (3 : + ℕ))).succ) (q ((2 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + + (↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((2 : Fin (3 : + ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((pr = p0) → ((BandVectors.2 (q 2) (q 1) + = (⟨0, -1⟩ : GaussianInt)) → (pU.2 - p0.2 = (1 / 2 : Real)))) ) := by + classical + intro K p0 q pr pU huy hpr0 hA21q + rw [← hpr0] + simpa [hA21q] using huy + +private theorem hvx' : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (p0' : Real × Real), + let q := DiamondRecursiveQuadruple K + ∀ (pr' : ℝ × ℝ), ∀ (pV : ℝ × ℝ), (pV.1 - pr'.1 = (if true = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : Fin (3 : + ℕ))).succ) (q ((2 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((2 : Fin (3 : + ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((pr' = p0') → ((BandVectors.2 (q 2) (q + 1) = (⟨0, -1⟩ : GaussianInt)) → (pV.1 - p0'.1 = (1 / 2 : Real)))) ) := by + classical + intro K p0' q pr' pV hvx hpr'0 hA21q + rw [← hpr'0] + simpa [hA21q] using hvx + +private theorem hvy' : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (p0' : Real × Real), + let q := DiamondRecursiveQuadruple K + ∀ (pr' : ℝ × ℝ), ∀ (pV : ℝ × ℝ), (pV.2 - pr'.2 = (if true = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : Fin (3 : + ℕ))).succ) (q ((2 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + + (↑(BandVectors.2 (q ((2 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (q ((2 : Fin (3 : + ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((pr' = p0') → ((BandVectors.2 (q 2) (q + 1) = (⟨0, -1⟩ : GaussianInt)) → (pV.2 - p0'.2 = -(1 / 2 : Real)))) ) := by + classical + intro K p0' q pr' pV hvy hpr'0 hA21q + rw [← hpr'0] + simpa [hA21q] using hvy + +private theorem huxRev : + (by + classical + exact + ∀ (p0 : Real × Real), ∀ (pU : ℝ × ℝ), (pU.1 - p0.1 = -(1 / 2 : Real)) → (p0.1 - pU.1 = (1 + / 2 : Real)) ) := by + classical + intro p0 pU hux' + calc + p0.1 - pU.1 = -(pU.1 - p0.1) := by ring + _ = (1 / 2 : Real) := by rw [hux']; norm_num + +private theorem huyRev : + (by + classical + exact + ∀ (p0 : Real × Real), ∀ (pU : ℝ × ℝ), (pU.2 - p0.2 = (1 / 2 : Real)) → (p0.2 - pU.2 = -(1 + / 2 : Real)) ) := by + classical + intro p0 pU huy' + calc + p0.2 - pU.2 = -(pU.2 - p0.2) := by ring + _ = -(1 / 2 : Real) := by rw [huy'] + +private theorem hpx : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (p0 : Real × Real), ∀ (p0' : Real × Real), + let m := K.1 - 1 + ((m : Real) = (K.1 : Real) - 1) → (∀ (pU : ℝ × ℝ), ∀ (pV : ℝ × ℝ), (p0'.1 - p0.1 = -(K.1 + : Real)) → ((pV.1 - p0'.1 = (1 / 2 : Real)) → ((p0.1 - pU.1 = (1 / 2 : Real)) → (pV.1 + - pU.1 = -(m : Real))))) ) := by + classical + intro K p0 p0' m hmreal pU pV hrootSx hvx' huxRev + calc + pV.1 - pU.1 = (pV.1 - p0'.1) + (p0'.1 - p0.1) + (p0.1 - pU.1) := by ring + _ = (1 / 2) + (-(K.1 : Real)) + (1 / 2) := by rw [hvx', hrootSx, huxRev] + _ = -(m : Real) := by rw [hmreal]; ring + +private theorem hpy : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (p0 : Real × Real), ∀ (p0' : Real × Real), + let m := K.1 - 1 + ((m : Real) = (K.1 : Real) - 1) → (∀ (pU : ℝ × ℝ), ∀ (pV : ℝ × ℝ), (p0'.2 - p0.2 = (K.1 : + Real) - 1) → ((pV.2 - p0'.2 = -(1 / 2 : Real)) → ((p0.2 - pU.2 = -(1 / 2 : Real)) → + (pV.2 - pU.2 = (m : Real) - 1)))) ) := by + classical + intro K p0 p0' m hmreal pU pV hrootSy hvy' huyRev + calc + pV.2 - pU.2 = (pV.2 - p0'.2) + (p0'.2 - p0.2) + (p0.2 - pU.2) := by ring + _ = (-(1 / 2)) + ((K.1 : Real) - 1) - (1 / 2) := by rw [hvy', hrootSy, huyRev]; ring + _ = (m : Real) - 1 := by rw [hmreal]; ring + +private theorem hLeft : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (Ci : BandCircle), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ + (gS : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), + ∀ (gS' : Fin (3 : ℕ) → Bool → PartialOdometer), + let U := S 2 false + let V := S' 2 true + let g := gS 2 false + let k := gS' 2 true + let m := K.1 - 1 + ∀ (hmpos : 0 < m), + let Kprev : DiamondParameter := ⟨m, hmpos⟩ + let qprev := DiamondRecursiveQuadruple Kprev + (ProperBandQuadruple (DiamondRecursiveQuadruple Kprev)) → ((BandVectors.2 + (DiamondRecursiveQuadruple Kprev (3 : Fin (4 : ℕ))) (DiamondRecursiveQuadruple Kprev + (0 : Fin (4 : ℕ))) = (⟨-(↑Kprev.1 : ℤ), (↑Kprev.1 : ℤ) - (1 : ℤ)⟩ : + GaussianInt)) → (((m : Real) = (K.1 : Real) - 1) → ((qprev 0 = Ci.1.1) → + ((TileCentroid V - TileCentroid U = GaussianRealPoint (BandVectors.1 (qprev 3) (qprev + 0))) → (∀ (pU : ℝ × ℝ), (PartialOdometerSlope (gS (2 : Fin (3 : ℕ)) false) = some pU) + → (∀ (pV : ℝ × ℝ), (PartialOdometerSlope (gS' (2 : Fin (3 : ℕ)) true) = some pV) → + ((pV.1 - pU.1 = -(m : Real)) → ((pV.2 - pU.2 = (m : Real) - 1) → ((TileOdometer + Ci.1.1 U g) → ((TileOdometer Ci.1.1 V k) → (LeftLatticeAdjacent Ci U V g k))))))))))) + ) := by + classical + intro K Ci S gS S' gS' U V g k m hmpos Kprev qprev hqprev hsloprev hmreal hqprev0 hchildcent pU + hpu pV hpv hpx hpy hOg hOk + refine ⟨hOg, hOk, pU, pV, hpu, hpv, Or.inr ?_⟩ + refine ⟨qprev, 2, true, hqprev, hqprev0, ?_, ?_, ?_⟩ + · simpa using hchildcent + · have hsloprev' : BandVectors.2 (qprev (Fin.succ 2)) (qprev 0) = + (⟨-(m : Int), (m : Int) - 1⟩ : GaussianInt) := by + have hidx : (3 : Fin 4) = Fin.succ 2 := by decide + simpa only [qprev, ← hidx] using hsloprev + rw [hsloprev'] + simpa [GaussianInt, GaussianRealPoint, hmreal] using hpx + · have hsloprev' : BandVectors.2 (qprev (Fin.succ 2)) (qprev 0) = + (⟨-(m : Int), (m : Int) - 1⟩ : GaussianInt) := by + have hidx : (3 : Fin 4) = Fin.succ 2 := by decide + simpa only [qprev, ← hidx] using hsloprev + rw [hsloprev'] + simpa [GaussianInt, GaussianRealPoint, hmreal] using hpy + +end DiamondBoundaryStarGeometry + +theorem DiamondOpposingBoundaryStarLocalization + (K : DiamondParameter) + (hq : ProperBandQuadruple (DiamondRecursiveQuadruple K)) + (C0 Ci : BandCircle) (i : Fin 3) + (hC0 : (DiamondRecursiveQuadruple K) 0 = C0.1.1) + (hCi : (DiamondRecursiveQuadruple K) i.succ = Ci.1.1) + (T0 T0' : ProtoTile) (h0 h0' : PartialOdometer) + (hO0 : TileOdometer C0.1.1 T0 h0) + (hO0' : TileOdometer C0.1.1 T0' h0') + (hlarge : 1 < Ci.1.1.1) + (p0 p0' : Real × Real) + (hs0 : PartialOdometerSlope h0 = some p0) + (hs0' : PartialOdometerSlope h0' = some p0') + (hcentroid : TileCentroid T0' - TileCentroid T0 = + GaussianRealPoint + (BandVectors.1 ((DiamondRecursiveQuadruple K) i.succ) + ((DiamondRecursiveQuadruple K) 0))) + (hslope : p0' - p0 = + GaussianRealPoint + (BandVectors.2 ((DiamondRecursiveQuadruple K) i.succ) + ((DiamondRecursiveQuadruple K) 0))) + (x : GaussianInt) (hx0 : x ∈ h0.domain) (hx0' : x ∈ h0'.domain) + (hstar : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h0.domain ∨ y ∈ h0'.domain) : + ∃ (U V : ProtoTile) (g k : PartialOdometer), + AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0 ∧ + AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0' ∧ + LeftLatticeAdjacent Ci U V g k ∧ + x ∈ g.domain ∧ x ∈ k.domain ∧ + ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ g.domain ∨ y ∈ k.domain := by +-- BODY + classical + let q := DiamondRecursiveQuadruple K + have hqD : ProperBandQuadruple q := hq + have coords := DiamondCoordinateConfiguration K + rcases coords with ⟨_, _, _, _, hv30, _, _, hA30, _, _, hA21⟩ + have hcurv : 1 < (DiamondRecursiveQuadruple K (i.succ)).1 := + DiamondBoundaryStarGeometry.hcurv K Ci i hCi hlarge + have index_two := DiamondBoundaryStarGeometry.index_two K Ci i hCi T0 T0' p0 p0' + hcentroid hslope hcurv + subst i + have hKpos : 0 < K.1 := K.2 + have hk2 := DiamondBoundaryStarGeometry.hk2 K Ci hcurv hKpos + obtain ⟨H, hH, hHdom, hHfoot, hHsquares, hHvalue, hHslope⟩ := + DiamondTileOdometerRestriction K + have hC0pos : 0 < C0.1.1.1 := DiamondBoundaryStarGeometry.hC0pos K hq C0 hC0 + obtain ⟨u, huCell, huEmpty, a, b, huDom, huValue⟩ := + (TileOdometerTranslationUniqueness C0.1.1 T0 (DiamondTile K.1) h0 H + hC0pos hO0 (by simpa [hC0] using hH)).exists + obtain ⟨u', hu'Cell, hu'Empty, a', b', hu'Dom, hu'Value⟩ := + (TileOdometerTranslationUniqueness C0.1.1 T0' (DiamondTile K.1) h0' H + hC0pos hO0' (by simpa [hC0] using hH)).exists + have hrootNonempty : (DiamondTile K.1).cells.Nonempty := + ⟨⟨0, 0⟩, (DiamondBoundaryStarGeometry.hrootCell K C0 Ci hKpos hk2)⟩ + have hT0cent := DiamondBoundaryStarGeometry.hT0cent K T0 u huCell + (DiamondBoundaryStarGeometry.hT0ne K T0 u huCell hrootNonempty) + have hT0'cent := DiamondBoundaryStarGeometry.hT0'cent K T0' u' hu'Cell + (DiamondBoundaryStarGeometry.hT0'ne K T0' u' hu'Cell hrootNonempty) + have hshift := DiamondBoundaryStarGeometry.hshift K T0 T0' hv30 hcentroid u u' hT0cent + hT0'cent + have hshift' := DiamondBoundaryStarGeometry.hshift' K u u' hshift + have Hmem := DiamondBoundaryStarGeometry.Hmem K H hHdom + let z := x - u + have hzUpper := DiamondBoundaryStarGeometry.hzUpper K h0 + x hx0 H u huDom Hmem + have hzLower := DiamondBoundaryStarGeometry.hzLower K h0' x hx0' H u u' hu'Dom hshift' Hmem + have overlap := DiamondBoundaryStarGeometry.overlap K C0 + Ci x hk2 u hzUpper hzLower + have hwest := DiamondBoundaryStarGeometry.hwest K h0 h0' x hstar H u huDom u' hu'Dom + hshift' Hmem + have heast := DiamondBoundaryStarGeometry.heast K h0 h0' x hstar H u huDom u' hu'Dom + hshift' Hmem + have hzzero := DiamondBoundaryStarGeometry.hzzero K C0 Ci x hk2 u overlap hwest heast + have hx_eq_u := DiamondBoundaryStarGeometry.hx_eq_u x u hzzero + have hroot := DiamondBoundaryStarGeometry.hroot K hk2 + obtain ⟨S, gS, hband0, hsub0, hcells0, hfoot0, hcent0, + hdom0, hvalue0, hcompat0, hslope0⟩ := + TileOdometerReindexedDecomposition q hqD T0 h0 hroot + (by simpa only [← hC0] using hO0) + obtain ⟨S', gS', hband0', hsub0', hcells0', hfoot0', hcent0', + hdom0', hvalue0', hcompat0', hslope0'⟩ := + TileOdometerReindexedDecomposition q hqD T0' h0' hroot + (by simpa only [← hC0] using hO0') + let U := S 2 false + let V := S' 2 true + let g := gS 2 false + let k := gS' 2 true + have hCiPos : 0 < Ci.1.1.1 := by omega + have hAncU := DiamondBoundaryStarGeometry.hAncU + K C0 Ci hC0 T0 h0 hO0 hCi S gS hsub0 hdom0 hvalue0 hCiPos + (DiamondBoundaryStarGeometry.hATU K C0 Ci hC0 T0 hqD hCi S gS hband0 hsub0 hfoot0 + hcent0) + have hAncV := DiamondBoundaryStarGeometry.hAncV K C0 Ci hC0 T0' h0' hO0' hCi S' gS' hsub0' + hdom0' + hvalue0' hCiPos (DiamondBoundaryStarGeometry.hATV K C0 Ci hC0 T0' hqD hCi S' gS' + hband0' hsub0' hfoot0' hcent0') + obtain ⟨hDK, Sc, hOcc, hCells, h00t, h00f, h10t, h10f, h2f, h2t⟩ := + DiamondTileRecursiveIdentification K + have hUcells : U.cells = (TileTranslation (Sc 2 false) u).cells := + DiamondBoundaryStarGeometry.hUcells K u S gS hsub0 Sc hOcc + (DiamondBoundaryStarGeometry.hUcent K T0 u hT0cent S hcent0 Sc hOcc) + let m := K.1 - 1 + have hmpos : 0 < m := by dsimp [m]; omega + have hmcast := DiamondBoundaryStarGeometry.hmcast K C0 Ci x + hk2 u + have hcell0 := DiamondBoundaryStarGeometry.hcell0 + K C0 Ci x u hmpos + have htop := DiamondBoundaryStarGeometry.htop K C0 Ci x u hmpos + (DiamondBoundaryStarGeometry.hrow K C0 Ci x u hmpos) + have hbaseFoot := DiamondBoundaryStarGeometry.hbaseFoot K + have hbase0 := hbaseFoot 0 hcell0 + have hbaseTop := hbaseFoot ⟨-1, 2 * (m : Int) - 1⟩ htop + have hUcells' : U.cells = (TileTranslation (DiamondTile m) u).cells := by + simpa only [h2f] using hUcells + have hVcells' := DiamondBoundaryStarGeometry.hVcells' K u' S' Sc h2t + (DiamondBoundaryStarGeometry.hVcells K u' S' gS' hsub0' Sc hOcc + (DiamondBoundaryStarGeometry.hVcent K T0' u' hT0'cent S' hcent0' Sc hOcc)) + have hCn : (TileTranslation (DiamondTile m) u).cells.Nonempty := by + exact Finset.image_nonempty.mpr ⟨0, hcell0⟩ + have hUFoot := DiamondBoundaryStarGeometry.hUFoot K u S hUcells' + (DiamondBoundaryStarGeometry.hUn K u S hcell0 hUcells') hCn + have hVFoot := DiamondBoundaryStarGeometry.hVFoot K u' S' hVcells' + (DiamondBoundaryStarGeometry.hVn K u' S' htop hVcells') + (DiamondBoundaryStarGeometry.hCn' K u' htop) + have hu' := DiamondBoundaryStarGeometry.hu' K u u' hshift + have hgFoot : (g.domain : Set GaussianInt) = FootprintVertices U := hAncU.2.2.1 + have hkFoot : (k.domain : Set GaussianInt) = FootprintVertices V := hAncV.2.2.1 + have hxu := DiamondBoundaryStarGeometry.hxu K x u hx_eq_u S gS hUFoot + (DiamondBoundaryStarGeometry.hUpperC K u hbase0) hgFoot + have hxk := DiamondBoundaryStarGeometry.hxk K x u u' hx_eq_u S' gS' hVFoot + (DiamondBoundaryStarGeometry.hLowerC K u u' hmcast hbaseTop hu') hkFoot + have hcoverage := DiamondBoundaryStarGeometry.hcoverage K h0 h0' x hx0 hx0' hstar u u' hzUpper + hzLower overlap hwest heast hzzero hx_eq_u S gS S' gS' hUFoot hVFoot + (DiamondBoundaryStarGeometry.hUpperE K u hbase0) + (DiamondBoundaryStarGeometry.hUpperN K u hbase0) + (DiamondBoundaryStarGeometry.hLowerW K u u' hmcast hbaseTop hu') + (DiamondBoundaryStarGeometry.hLowerS K u u' hmcast hbaseTop hu') hgFoot hkFoot + hxu hxk + have h21 := DiamondBoundaryStarGeometry.h21 K hqD hA21 + let Kprev : DiamondParameter := ⟨m, hmpos⟩ + let qprev := DiamondRecursiveQuadruple Kprev + rcases DiamondCoordinateConfiguration Kprev with + ⟨_, hqprev, _, _, hcentprev, _, _, hsloprev, _, _, _⟩ + have hKrel : m + 1 = K.1 := by dsimp [m]; omega + have hKcast : (K.1 : Int) = (m : Int) + 1 := by exact_mod_cast hKrel.symm + have hKreal : (K.1 : Real) = (m : Real) + 1 := by exact_mod_cast hKrel.symm + have hmreal := DiamondBoundaryStarGeometry.hmreal K hKreal + have hqprev0 := DiamondBoundaryStarGeometry.hqprev0 K Ci hCi hmpos hKrel + hKcast + have hv30' := DiamondBoundaryStarGeometry.hv30'At635 K hv30 + have hchildcent := DiamondBoundaryStarGeometry.hchildcent K T0 T0' S S' hmpos hcentprev hKreal + (DiamondBoundaryStarGeometry.hrootcent K T0 T0' hv30 hcentroid) + (DiamondBoundaryStarGeometry.hUreverse T0 S + (DiamondBoundaryStarGeometry.hUoffset K T0 S hcent0 h21)) + (DiamondBoundaryStarGeometry.hVoffset K T0' S' hcent0' h21) + have hrootSlope : p0' - p0 = (-(K.1 : Real), (K.1 : Real) - 1) := + DiamondBoundaryStarGeometry.hrootSlope K p0 p0' hA30 hslope + rcases hslope0 2 false with hzeroU | ⟨pr, pU, hpr, hpu, hux, huy⟩ + · have : (q 3).1 = 0 := hzeroU + change (DiamondRecursiveQuadruple K (Fin.succ 2)).1 = 0 at this + rw [hCi] at this hcurv + omega + rcases hslope0' 2 true with hzeroV | ⟨pr', pV, hpr', hpv, hvx, hvy⟩ + · have : (q 3).1 = 0 := hzeroV + change (DiamondRecursiveQuadruple K (Fin.succ 2)).1 = 0 at this + rw [hCi] at this hcurv + omega + have hpr0 : pr = p0 := by + exact Option.some.inj (hpr.symm.trans hs0) + have hpr'0 : pr' = p0' := by + exact Option.some.inj (hpr'.symm.trans hs0') + have hrootSx : p0'.1 - p0.1 = -(K.1 : Real) := by + simpa using congrArg Prod.fst hrootSlope + have hrootSy : p0'.2 - p0.2 = (K.1 : Real) - 1 := by + simpa using congrArg Prod.snd hrootSlope + have hA21q : BandVectors.2 (q 2) (q 1) = (⟨0, -1⟩ : GaussianInt) := by + simpa only [q] using hA21 + have hOg : TileOdometer Ci.1.1 U g := by + simpa only [← hCi] using hsub0 2 false + have hOk : TileOdometer Ci.1.1 V k := by + simpa only [← hCi] using hsub0' 2 true + exact ⟨U, V, g, k, hAncU, hAncV, (DiamondBoundaryStarGeometry.hLeft K Ci S gS S' gS' hmpos + hqprev hsloprev hmreal hqprev0 hchildcent pU hpu pV hpv + (DiamondBoundaryStarGeometry.hpx K p0 p0' hmreal pU pV hrootSx + (DiamondBoundaryStarGeometry.hvx' K p0' pr' pV hvx hpr'0 hA21q) + (DiamondBoundaryStarGeometry.huxRev p0 pU (DiamondBoundaryStarGeometry.hux' K p0 pr pU + hux hpr0 hA21q))) (DiamondBoundaryStarGeometry.hpy K p0 p0' hmreal pU pV hrootSy + (DiamondBoundaryStarGeometry.hvy' K p0' pr' pV hvy hpr'0 hA21q) + (DiamondBoundaryStarGeometry.huyRev p0 pU (DiamondBoundaryStarGeometry.huy' K p0 pr pU + huy hpr0 hA21q))) hOg hOk), hxu, hxk, hcoverage⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondOrientedChildParentEndpoints.lean b/LeanPool/ApollonianSuperharmonic/DiamondOrientedChildParentEndpoints.lean new file mode 100644 index 0000000000..64682303f0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondOrientedChildParentEndpoints.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5260T1LiteralPlacement +public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger +public import LeanPool.ApollonianSuperharmonic.P5260T1UnitInterfaces +public import LeanPool.ApollonianSuperharmonic.P5260T1PredecessorInterfaces +public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage + +-- [TABLET NODE: DiamondOrientedChildParentEndpoints] + +/-! +# DiamondOrientedChildParentEndpoints + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem DiamondOrientedChildParentEndpoints (K : DiamondParameter) : + let q := DiamondRecursiveQuadruple K + ∀ (i : Fin 3) (s : Fin 4) (U W Z : ProtoTile), + BandPrototile (q 0) U → + BandPrototile (q i.succ) W → + BandPrototile + (q ((if Even s.val then i - 1 else i + 1).succ)) Z → + 0 < (q 0).1 → 0 < (q i.succ).1 → + 0 < (q ((if Even s.val then i - 1 else i + 1).succ)).1 → + TileCentroid W - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) → + TileCentroid Z - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (q 0) (q ((i - 1).succ)) - + BandVectors.1 (q ((i - 1).succ)) (q 0) + else + BandVectors.1 (q ((i + 1).succ)) (q 0) - + BandVectors.1 (q 0) (q ((i + 1).succ)))) → + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) + let uL := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q i.succ) (q 0) + else BandVectors.1 (q 0) (q i.succ)) + ∃ rightData : ExactTileInterfaceTriple U (TileTranslation U uR) W, + ∃ incomingData : ExactTileInterfaceTriple U (TileTranslation U uL) W, + ∃ adjacentData : ExactTileInterfaceTriple U W Z, + rightData.point ≠ incomingData.point ∧ + adjacentData.point = incomingData.point ∧ + rightData.otherCA = incomingData.point ∧ + incomingData.otherCA = rightData.point ∧ + adjacentData.otherAB = rightData.point := by +-- BODY + dsimp only + intro i s U W Z hU hW hZ hposU hposW hposZ hcentW hcentZ + let b : Bool := decide (s.val % 2 = 1) + let M := P5260T1PlacementLedger K.1 i b + let D := DiamondTile K.1 + obtain ⟨hreg, a, hf, hstep, hv, he⟩ := + P5260T1LiteralPlacement K i s U W Z hU hW hZ + hposU hposW hposZ hcentW hcentZ + let f := fun z : GaussianInt => + a + (if s.val < 2 then z else ⟨0, 2 * (K.1 : Int)⟩ - z) + have canonical : + ∃ R : ExactTileInterfaceTriple D (TileTranslation D M.2.1.1) M.1.1, + ∃ I : ExactTileInterfaceTriple D (TileTranslation D M.2.1.2) M.1.1, + ∃ A : ExactTileInterfaceTriple D M.1.1 M.1.2, + R.point = M.2.2.1 ∧ I.point = M.2.2.2 ∧ + A.point = M.2.2.2 ∧ R.otherCA = M.2.2.2 ∧ + I.otherCA = M.2.2.1 ∧ A.otherAB = M.2.2.1 ∧ + M.2.2.1 ≠ M.2.2.2 := by + by_cases hi : i = 2 + · subst i + have hk : 1 < K.1 := by + rcases hreg with hk | ⟨hi, _⟩ | ⟨hi, _⟩ + · exact hk + · exact False.elim ((by decide : (2 : Fin 3) ≠ 1) hi) + · exact False.elim ((by decide : (2 : Fin 3) ≠ 0) hi) + exact P5260T1PredecessorInterfaces K.1 hk b + · exact P5260T1UnitInterfaces K.1 K.2 i b hi hreg + obtain ⟨R, I, A, hRp, hIp, hAp, hRca, hIca, hAab, hxy⟩ := canonical + obtain ⟨R', hRp', _, _, hRca'⟩ := + P4055T1ExactTripleImage f hf hstep _ _ _ _ _ _ + (hv 0) (hv 1) (hv 3) (he 0) (he 1) (he 3) R + obtain ⟨I', hIp', _, _, hIca'⟩ := + P4055T1ExactTripleImage f hf hstep _ _ _ _ _ _ + (hv 0) (hv 2) (hv 3) (he 0) (he 2) (he 3) I + obtain ⟨A', hAp', hAab', _, _⟩ := + P4055T1ExactTripleImage f hf hstep _ _ _ _ _ _ + (hv 0) (hv 3) (hv 4) (he 0) (he 3) (he 4) A + refine ⟨R', I', A', ?_, ?_, ?_, ?_, ?_⟩ + · rw [hRp', hIp', hRp, hIp] + exact fun h => hxy (hf h) + · rw [hAp', hIp', hAp, hIp] + · rw [hRca', hIp', hRca, hIp] + · rw [hIca', hRp', hIca, hRp] + · rw [hAab', hRp', hAab, hRp] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondParameter.lean b/LeanPool/ApollonianSuperharmonic/DiamondParameter.lean new file mode 100644 index 0000000000..63528c084f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondParameter.lean @@ -0,0 +1,32 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: DiamondParameter] + +/-! +# DiamondParameter + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A diamond parameter is a positive integer $k$. +-/ +def DiamondParameter : Type := +-- BODY + {k : Nat // 0 < k} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondPeakMatrix.lean b/LeanPool/ApollonianSuperharmonic/DiamondPeakMatrix.lean new file mode 100644 index 0000000000..c95f08d875 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondPeakMatrix.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondParameter + +-- [TABLET NODE: DiamondPeakMatrix] + +/-! +# DiamondPeakMatrix + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For the positive diamond parameter $k$, the exceptional peak matrix is +$$ + A_k=\frac12\begin{pmatrix}k/(k+1)&1\\1&(1-k)/k\end{pmatrix}. +$$ +Positivity of $k$ makes both displayed denominators nonzero. +-/ +noncomputable def DiamondPeakMatrix (K : DiamondParameter) : + Matrix (Fin 2) (Fin 2) Real := +-- BODY + let k : Real := K.1 + (1 / 2 : Real) • ![![k / (k + 1), 1], ![1, (1 - k) / k]] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondRecursiveQuadruple.lean b/LeanPool/ApollonianSuperharmonic/DiamondRecursiveQuadruple.lean new file mode 100644 index 0000000000..d5289a4a52 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondRecursiveQuadruple.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates +public import LeanPool.ApollonianSuperharmonic.DiamondParameter + +-- [TABLET NODE: DiamondRecursiveQuadruple] + +/-! +# DiamondRecursiveQuadruple + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a positive integer $k$, the ordered diamond recursive quadruple is +$$ + \bigl(C_k,(1,1+2i),(1,1),C_{k-1}\bigr), +$$ +where +$$ + C_k=(2k(k+1),\,2k^2-1+2k(k+1)i). +$$ +At $k=1$, the last coordinate is $(0,-1)$, so it is an oriented line in +the general-circle recursion rather than a band circle. +-/ +def DiamondRecursiveQuadruple (K : DiamondParameter) : + Fin 4 → CircleCoordinates := +-- BODY + let k := K.1 + ![((2 * k * (k + 1) : Nat), + ⟨2 * (k : Int) ^ 2 - 1, 2 * (k : Int) * (k + 1)⟩), + (1, ⟨1, 2⟩), + (1, 1), + ((2 * (k - 1) * k : Nat), + ⟨2 * ((k - 1 : Nat) : Int) ^ 2 - 1, + 2 * ((k - 1 : Nat) : Int) * k⟩)] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondRegimeConverse.lean b/LeanPool/ApollonianSuperharmonic/DiamondRegimeConverse.lean new file mode 100644 index 0000000000..6cd2e6271f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondRegimeConverse.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification +public import LeanPool.ApollonianSuperharmonic.DiamondParameter +public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.P4840T6ProperGrowth +public import LeanPool.ApollonianSuperharmonic.P4840T6ShiftRoot +public import LeanPool.ApollonianSuperharmonic.P4840T6NegatedRoot +public import LeanPool.ApollonianSuperharmonic.P4840T6ConstructorCovariance +public import LeanPool.ApollonianSuperharmonic.P4840T6DiamondRecurrence + +-- [TABLET NODE: DiamondRegimeConverse] + +/-! +# DiamondRegimeConverse + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem DiamondRegimeConverse (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) + (hnoLine : ∀ i : Fin 4, (q i).1 ≠ 0) + (htwoUnits : ∃ i j : Fin 4, + i ≠ j ∧ (q i).1 = 1 ∧ (q j).1 = 1) : + ∃ (r : Fin 3) (g : BandPackingSymmetry) (K : DiamondParameter), + 1 < K.1 ∧ + BandPackingSymmetryReversesOrientation g = false ∧ + (∃ w : GaussianInt, + g = .shift w ∨ g = .comp (.shift w) .negate) ∧ + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] = + DiamondRecursiveQuadruple K := by +-- BODY + let R := fun x : Fin 4 → CircleCoordinates => ![x 0, x 2, x 3, x 1] + let S := fun x : Fin 4 → CircleCoordinates => + ![(2 * (x 0).1 + 2 * (x 2).1 + 2 * (x 3).1 - (x 1).1, + 2 * (x 0).2 + 2 * (x 2).2 + 2 * (x 3).2 - (x 1).2), + x 0, x 2, x 3] + let rot := fun (a : Fin 3) (x : Fin 4 → CircleCoordinates) => + ![x 0, x a.succ, x (a + 1).succ, x (a + 2).succ] + let Q := BandPackingSymmetryQuadrupleAction + let D := DiamondRecursiveQuadruple + have rotate_action (g : BandPackingSymmetry) + (hg : BandPackingSymmetryReversesOrientation g = false) + (x : Fin 4 → CircleCoordinates) : Q g (R x) = R (Q g x) := by + funext j + fin_cases j <;> simp [Q, R, BandPackingSymmetryQuadrupleAction, hg] + have undo_units (x : Fin 4 → CircleCoordinates) + (hu : ∃ i j : Fin 4, + i ≠ j ∧ ((R x) i).1 = 1 ∧ ((R x) j).1 = 1) : + ∃ i j : Fin 4, i ≠ j ∧ (x i).1 = 1 ∧ (x j).1 = 1 := by + let p : Fin 4 → Fin 4 := ![0, 2, 3, 1] + have hinj : Function.Injective p := by + intro i j + fin_cases i <;> fin_cases j <;> decide + have heval (i : Fin 4) : (R x) i = x (p i) := by + fin_cases i <;> rfl + obtain ⟨i, j, hij, hi, hj⟩ := hu + exact ⟨p i, p j, (fun h => hij (hinj h)), + by simpa only [heval] using hi, by simpa only [heval] using hj⟩ + -- Retain the first proper normalizer while inducting through the forest. + have main : ∀ x : Fin 4 → CircleCoordinates, SemiProperQuadruple x → + ProperBandQuadruple x → + (∃ i j : Fin 4, i ≠ j ∧ (x i).1 = 1 ∧ (x j).1 = 1) → + ∃ (a : Fin 3) (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryReversesOrientation g = false ∧ + (∃ w : GaussianInt, g = .shift w ∨ g = .comp (.shift w) .negate) ∧ + Q g (rot a x) = D K := by + intro x hx + induction hx with + | base z => + intro hp _ + have bad := hp.2 (0 : Fin 3) + norm_num at bad + | @rotate x hx ih => + intro hp hu + have old : ProperBandQuadruple x := by + refine ⟨hx, ?_⟩ + intro j + fin_cases j + · simpa using hp.2 2 + · simpa using hp.2 0 + · simpa using hp.2 1 + obtain ⟨a, g, K, hg, hw, heq⟩ := ih old (undo_units x hu) + fin_cases a + · refine ⟨2, g, K, hg, hw, ?_⟩ + simpa [rot, R] using heq + · refine ⟨0, g, K, hg, hw, ?_⟩ + simpa [rot, R] using heq + · refine ⟨1, g, K, hg, hw, ?_⟩ + simpa [rot, R] using heq + | @successor x hx ih => + intro hp hu + rcases (SemiProperForestClassification x hx).2 with + root | root | root | old + · obtain ⟨z, hz⟩ := root + have bad := hp.2 (0 : Fin 3) + rw [hz] at bad + change (1 : Int) < 1 at bad + exact (lt_irrefl _ bad).elim + · obtain ⟨z, hz⟩ := root + refine ⟨2, .shift (-z), ⟨1, by norm_num⟩, rfl, + ⟨-z, Or.inl rfl⟩, ?_⟩ + have source : rot 2 (S x) = + ![(4, 1 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (1, 1 + 2 * z), (0, -1)] := by + rw [hz] + funext j + fin_cases j <;> apply Prod.ext + all_goals simp [rot, S] + all_goals ring + change Q (.shift (-z)) (rot 2 (S x)) = D _ + rw [source] + exact P4840T6ShiftRoot z + · obtain ⟨z, hz⟩ := root + refine ⟨0, .comp (.shift (z + 1 + ⟨0, 1⟩)) .negate, + ⟨1, by norm_num⟩, rfl, ⟨z + 1 + ⟨0, 1⟩, Or.inr rfl⟩, ?_⟩ + have source : rot 0 (S x) = + ![(4, 7 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (0, 1)] := by + rw [hz] + funext j + fin_cases j <;> apply Prod.ext + all_goals simp [rot, S] + all_goals ring + change Q (.comp (.shift (z + 1 + ⟨0, 1⟩)) .negate) + (rot 0 (S x)) = D _ + rw [source] + exact P4840T6NegatedRoot z + · have retained : (x 2).1 = 1 ∧ (x 3).1 = 1 := by + obtain ⟨hc, hd⟩ := P4840T6ProperGrowth x old + obtain ⟨i, j, hij, hi, hj⟩ := hu + fin_cases i <;> fin_cases j <;> simp at hij hi hj <;> omega + obtain ⟨a, g, K, hg, hw, heq⟩ := + ih old ⟨2, 3, by decide, retained.1, retained.2⟩ + have hcurv := (P4840T6ConstructorCovariance g hw).2.1 + have nonunit : ((D K) 3).1 ≠ 1 := by + change ((2 * (K.1 - 1) * K.1 : Nat) : Int) ≠ 1 + intro h + have h' : 2 * (((K.1 - 1 : Nat) : Int) * (K.1 : Int)) = 1 := by + simpa only [Nat.cast_mul, Nat.cast_ofNat, mul_assoc] using h + omega + fin_cases a + · exfalso + apply nonunit + have h := congrArg (fun y => (y 3).1) heq.symm + simpa [Q, rot, BandPackingSymmetryQuadrupleAction, hg, + hcurv, retained.2] using h + · refine ⟨1, g, ⟨K.1 + 1, by omega⟩, hg, hw, ?_⟩ + have action : Q g x = R (R (D K)) := by + have h : Q g (R x) = D K := by simpa [rot, R] using heq + rw [rotate_action g hg x] at h + have h' := congrArg (fun y => R (R y)) h + funext j + fin_cases j + · exact congrFun h' 0 + · exact congrFun h' 1 + · exact congrFun h' 2 + · exact congrFun h' 3 + change Q g (R (S x)) = D _ + rw [rotate_action g hg (S x)] + have cov := (P4840T6ConstructorCovariance g hw).2.2 x + change Q g (S x) = S (Q g x) at cov + rw [cov, action] + exact P4840T6DiamondRecurrence K + · exfalso + apply nonunit + have h := congrArg (fun y => (y 3).1) heq.symm + simpa [Q, rot, BandPackingSymmetryQuadrupleAction, hg, + hcurv, retained.1] using h + obtain ⟨a, g, K, hg, hw, heq⟩ := main q hq.1 hq htwoUnits + refine ⟨a, g, K, ?_, hg, hw, heq⟩ + by_contra hk + have k1 : K.1 = 1 := by have := K.2; omega + have h := congrArg (fun y => (y 3).1) heq + have hcurv := (P4840T6ConstructorCovariance g hw).2.1 + have line : (q (a + 2).succ).1 = 0 := by + simpa [Q, rot, D, DiamondRecursiveQuadruple, k1, + BandPackingSymmetryQuadrupleAction, hg, hcurv] using h + exact hnoLine _ line + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondTerminalWebStencilLedger.lean b/LeanPool/ApollonianSuperharmonic/DiamondTerminalWebStencilLedger.lean new file mode 100644 index 0000000000..0390343734 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondTerminalWebStencilLedger.lean @@ -0,0 +1,272 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2LiteralNormalization +public import LeanPool.ApollonianSuperharmonic.P5352T2VectorPlacements +public import LeanPool.ApollonianSuperharmonic.P5352T2RightFirst +public import LeanPool.ApollonianSuperharmonic.P5352T2RightSecond +public import LeanPool.ApollonianSuperharmonic.P5352T2RightHorizontal +public import LeanPool.ApollonianSuperharmonic.P5352T2FirstUnit +public import LeanPool.ApollonianSuperharmonic.P5352T2SecondUnit +public import LeanPool.ApollonianSuperharmonic.P5352T2Predecessor0 +public import LeanPool.ApollonianSuperharmonic.P5352T2Predecessor1 +public import LeanPool.ApollonianSuperharmonic.P5352T2Predecessor2 +public import LeanPool.ApollonianSuperharmonic.P5352T2Predecessor3 + +-- [TABLET NODE: DiamondTerminalWebStencilLedger] + +/-! +# DiamondTerminalWebStencilLedger + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem DiamondTerminalWebStencilLedger (K : DiamondParameter) (hk : 1 < K.1) : + let q := DiamondRecursiveQuadruple K + (∀ (i : Fin 3) (e : Bool) (T T' : ProtoTile) + (h h' : PartialOdometer) (p p' : ℝ × ℝ) + (g : IntegerLatticeFunction) (x : GaussianInt), + TileOdometer (q 0) T h → TileOdometer (q 0) T' h' → + PartialOdometerSlope h = some p → + PartialOdometerSlope h' = some p' → + TileCentroid T' - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) → + p'.1 - p.1 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q 0) (q i.succ)).re → + p'.2 - p.2 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q 0) (q i.succ)).im → + OdometerCompatibility h h' → + GlobalOdometerExtends g h → GlobalOdometerExtends g h' → + x ∈ h.domain → x ∈ h'.domain → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h.domain ∨ y ∈ h'.domain) → + ((∀ s, s = x ∨ s = x - 1 ∨ s = x - ⟨0, 1⟩ ∨ + s = x - 1 - ⟨0, 1⟩ → s ∈ T.cells ∨ s ∈ T'.cells) → + FourNeighborLaplacian g x = 1) ∧ + (¬ (∀ s, s = x ∨ s = x - 1 ∨ s = x - ⟨0, 1⟩ ∨ + s = x - 1 - ⟨0, 1⟩ → s ∈ T.cells ∨ s ∈ T'.cells) → + FourNeighborLaplacian g x = 0)) ∧ + ∀ (i : Fin 3) (s : Fin 4) (T₀ Tᵢ : ProtoTile) + (h₀ hᵢ : PartialOdometer) (p₀ pᵢ : ℝ × ℝ) + (g : IntegerLatticeFunction) (x : GaussianInt), + TileOdometer (q 0) T₀ h₀ → TileOdometer (q i.succ) Tᵢ hᵢ → + PartialOdometerSlope h₀ = some p₀ → + PartialOdometerSlope hᵢ = some pᵢ → + TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) → + pᵢ.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).1 → + pᵢ.2 - p₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).2 → + OdometerCompatibility h₀ hᵢ → + GlobalOdometerExtends g h₀ → GlobalOdometerExtends g hᵢ → + x ∈ h₀.domain → x ∈ hᵢ.domain → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h₀.domain ∨ y ∈ hᵢ.domain) → + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) + let UR := TileTranslation T₀ uR + (x ∈ FootprintVertices UR → FourNeighborLaplacian g x = 0) ∧ + (x ∉ FootprintVertices UR → FourNeighborLaplacian g x = 1) := by +-- BODY + classical + dsimp only + have positive (i : Fin 3) (T U : ProtoTile) + (h l : PartialOdometer) (p r : ℝ × ℝ) + (g : IntegerLatticeFunction) (x : GaussianInt) + (hT : TileOdometer ((DiamondRecursiveQuadruple K) 0) T h) + (hU : TileOdometer ((DiamondRecursiveQuadruple K) 0) U l) + (hp : PartialOdometerSlope h = some p) + (hr : PartialOdometerSlope l = some r) + (hc : TileCentroid U - TileCentroid T = + GaussianRealPoint (BandVectors.1 ((DiamondRecursiveQuadruple K) 0) + ((DiamondRecursiveQuadruple K) i.succ))) + (hsx : r.1-p.1 = (BandVectors.2 ((DiamondRecursiveQuadruple K) 0) + ((DiamondRecursiveQuadruple K) i.succ)).re) + (hsy : r.2-p.2 = (BandVectors.2 ((DiamondRecursiveQuadruple K) 0) + ((DiamondRecursiveQuadruple K) i.succ)).im) + (he : GlobalOdometerExtends g h) (he' : GlobalOdometerExtends g l) + (hx : x ∈ h.domain) (hx' : x ∈ l.domain) + (hcover : ∀ y, y=x ∨ y=x+1 ∨ y=x-1 ∨ + y=x+⟨0,1⟩ ∨ y=x-⟨0,1⟩ → y∈h.domain ∨ y∈l.domain) : + ((∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → + y∈T.cells ∨ y∈U.cells) → FourNeighborLaplacian g x=1) ∧ + (¬ (∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → + y∈T.cells ∨ y∈U.cells) → FourNeighborLaplacian g x=0) := by + obtain ⟨w,d,a,B,f,hd,hd',hcell,hcell',hfoot,hcent,hs,hs',hv,hv',hlap⟩ := + P5352T2LiteralNormalization K hk 0 T U h l p r g hT hU hp hr he he' + obtain ⟨hvec,hsl,_⟩ := P5352T2VectorPlacements K hk i 0 + rw [hvec] at hc + rw [hsl] at hsx hsy + have deq : d = (P5352T2PlacementData K.1 i).1.1 := by + have h := hcent.symm.trans hc + simp only [sub_self, zero_add] at h + apply Zsqrtd.ext + · have e := congrArg Prod.fst h + change (d.re : ℝ) = ((P5352T2PlacementData K.1 i).1.1.re : ℝ) at e + exact_mod_cast e + · have e := congrArg Prod.snd h + change (d.im : ℝ) = ((P5352T2PlacementData K.1 i).1.1.im : ℝ) at e + exact_mod_cast e + have aeq : a = (P5352T2PlacementData K.1 i).1.2 := by + simp only [sub_self, zero_add] at hs hs' + apply Zsqrtd.ext + · exact_mod_cast hs.symm.trans hsx + · exact_mod_cast hs'.symm.trans hsy + subst d + subst a + have cover : ∀ y, y=x-w ∨ y=x-w+1 ∨ y=x-w-1 ∨ + y=x-w+⟨0,1⟩ ∨ y=x-w-⟨0,1⟩ → + y ∈ FootprintVertices (P5352T2Sources K hk 0).1 ∨ + y-(P5352T2PlacementData K.1 i).1.1 ∈ + FootprintVertices (P5352T2Sources K hk 0).1 := by + intro y hy + have hh := hcover (y+w) (by + rcases hy with rfl | rfl | rfl | rfl | rfl <;> + simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm]) + rcases hh with hh | hh + · exact Or.inl (by simpa only [add_sub_cancel_right] using (hd _).mp hh) + · exact Or.inr (by simpa only [add_sub_cancel_right] using (hd' _).mp hh) + have cells : + (∀ y, y=x-w ∨ y=x-w-1 ∨ y=x-w-⟨0,1⟩ ∨ y=x-w-1-⟨0,1⟩ → + y ∈ (P5352T2Sources K hk 0).1.cells ∨ + y-(P5352T2PlacementData K.1 i).1.1 ∈ (P5352T2Sources K hk 0).1.cells) ↔ + (∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → + y∈T.cells ∨ y∈U.cells) := by + constructor + · intro H y hy + have hh := H (y-w) (by + rcases hy with rfl | rfl | rfl | rfl <;> + simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm]) + exact hh.imp ((hcell y).mpr) ((hcell' y).mpr) + · intro H y hy + have hh := H (y+w) (by + rcases hy with rfl | rfl | rfl | rfl <;> + simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm]) + rcases hh with hh | hh + · exact Or.inl (by simpa only [add_sub_cancel_right] using (hcell _).mp hh) + · exact Or.inr (by simpa only [add_sub_cancel_right] using (hcell' _).mp hh) + have hcase : + ((∀ y, y=x-w ∨ y=x-w-1 ∨ y=x-w-⟨0,1⟩ ∨ y=x-w-1-⟨0,1⟩ → + y ∈ (P5352T2Sources K hk 0).1.cells ∨ + y-(P5352T2PlacementData K.1 i).1.1 ∈ (P5352T2Sources K hk 0).1.cells) → + FourNeighborLaplacian f (x-w)=1) ∧ + (¬ (∀ y, y=x-w ∨ y=x-w-1 ∨ y=x-w-⟨0,1⟩ ∨ y=x-w-1-⟨0,1⟩ → + y ∈ (P5352T2Sources K hk 0).1.cells ∨ + y-(P5352T2PlacementData K.1 i).1.1 ∈ (P5352T2Sources K hk 0).1.cells) → + FourNeighborLaplacian f (x-w)=0) := by + fin_cases i + · exact P5352T2RightFirst K hk f B (x-w) hv hv' ((hd x).mp hx) ((hd' x).mp hx') cover + · exact P5352T2RightSecond K hk f B (x-w) hv hv' ((hd x).mp hx) ((hd' x).mp hx') cover + · exact P5352T2RightHorizontal K hk f B (x-w) hv hv' ((hd x).mp hx) ((hd' x).mp hx') cover + rw [hlap x] + exact ⟨fun H => hcase.1 (cells.mpr H), fun H => hcase.2 (fun h => H (cells.mp h))⟩ + constructor + · intro i e T U h l p r g x hT hU hp hr hc hsx hsy _ he he' hx hx' hcover + cases e + · have hc' : TileCentroid T - TileCentroid U = + GaussianRealPoint (BandVectors.1 ((DiamondRecursiveQuadruple K) 0) + ((DiamondRecursiveQuadruple K) i.succ)) := by + have hh := congrArg Neg.neg hc + simpa using hh + have hsx' : p.1-r.1 = (BandVectors.2 ((DiamondRecursiveQuadruple K) 0) + ((DiamondRecursiveQuadruple K) i.succ)).re := by + simp only [Bool.false_eq_true, ite_false, neg_one_mul] at hsx + linarith + have hsy' : p.2-r.2 = (BandVectors.2 ((DiamondRecursiveQuadruple K) 0) + ((DiamondRecursiveQuadruple K) i.succ)).im := by + simp only [Bool.false_eq_true, ite_false, neg_one_mul] at hsy + linarith + have H := positive i U T l h r p g x hU hT hr hp hc' hsx' hsy' + he' he hx' hx (fun y hy => (hcover y hy).symm) + simpa only [or_comm] using H + · apply positive i T U h l p r g x hT hU hp hr + · simpa using hc + · simpa using hsx + · simpa using hsy + · exact he + · exact he' + · exact hx + · exact hx' + · exact hcover + · intro i s T U h l p r g x hT hU hp hr hc hsx hsy _ he he' hx hx' hcover + obtain ⟨w,d,a,B,f,hd,hd',hcell,hcell',hfoot,hcent,hs,hs',hv,hv',hlap⟩ := + P5352T2LiteralNormalization K hk i.succ T U h l p r g hT hU hp hr he he' + obtain ⟨_,_,hvect,hslt,hright⟩ := P5352T2VectorPlacements K hk i s + have deq : d = ((P5352T2PlacementData K.1 i).2 s).1 := by + have hh := hcent.symm.trans (hc.trans hvect) + apply Zsqrtd.ext + · have e := congrArg Prod.fst hh + dsimp at e + exact_mod_cast (show (d.re : ℝ) = + (((P5352T2PlacementData K.1 i).2 s).1.re : ℝ) by linarith only [e]) + · have e := congrArg Prod.snd hh + dsimp at e + exact_mod_cast (show (d.im : ℝ) = + (((P5352T2PlacementData K.1 i).2 s).1.im : ℝ) by linarith only [e]) + have aeq : a = ((P5352T2PlacementData K.1 i).2 s).2.1 := by + have ex := congrArg Prod.fst hslt + have ey := congrArg Prod.snd hslt + dsimp only at ex ey + rw [ex] at hsx + rw [ey] at hsy + apply Zsqrtd.ext + · exact_mod_cast (show (a.re : ℝ) = + (((P5352T2PlacementData K.1 i).2 s).2.1.re : ℝ) by linarith only [hs, hsx]) + · exact_mod_cast (show (a.im : ℝ) = + (((P5352T2PlacementData K.1 i).2 s).2.1.im : ℝ) by linarith only [hs', hsy]) + subst d + subst a + have cover : ∀ y, y=x-w ∨ y=x-w+1 ∨ y=x-w-1 ∨ + y=x-w+⟨0,1⟩ ∨ y=x-w-⟨0,1⟩ → + y ∈ FootprintVertices (P5352T2Sources K hk 0).1 ∨ + y-((P5352T2PlacementData K.1 i).2 s).1 ∈ + FootprintVertices (P5352T2Sources K hk i.succ).1 := by + intro y hy + have hh := hcover (y+w) (by + rcases hy with rfl | rfl | rfl | rfl | rfl <;> + simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm]) + rcases hh with hh | hh + · exact Or.inl (by simpa only [add_sub_cancel_right] using (hd _).mp hh) + · exact Or.inr (by simpa only [add_sub_cancel_right] using (hd' _).mp hh) + have hcase : + (x-w-((P5352T2PlacementData K.1 i).2 s).2.2 ∈ + FootprintVertices (P5352T2Sources K hk 0).1 → + FourNeighborLaplacian f (x-w)=0) ∧ + (x-w-((P5352T2PlacementData K.1 i).2 s).2.2 ∉ + FootprintVertices (P5352T2Sources K hk 0).1 → + FourNeighborLaplacian f (x-w)=1) := by + fin_cases i + · exact P5352T2FirstUnit K hk s f B (x-w) hv hv' ((hd x).mp hx) ((hd' x).mp hx') cover + · exact P5352T2SecondUnit K hk s f B (x-w) hv hv' ((hd x).mp hx) ((hd' x).mp hx') cover + · fin_cases s + · exact P5352T2Predecessor0 K hk f B (x-w) hv hv' ((hd x).mp hx) ((hd' x).mp hx') cover + · exact P5352T2Predecessor1 K hk f B (x-w) hv hv' ((hd x).mp hx) ((hd' x).mp hx') cover + · exact P5352T2Predecessor2 K hk f B (x-w) hv hv' ((hd x).mp hx) ((hd' x).mp hx') cover + · exact P5352T2Predecessor3 K hk f B (x-w) hv hv' ((hd x).mp hx) ((hd' x).mp hx') cover + rw [hright, hfoot x, hlap x] + exact hcase + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondTile.lean b/LeanPool/ApollonianSuperharmonic/DiamondTile.lean new file mode 100644 index 0000000000..260760d0ce --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondTile.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: DiamondTile] + +/-! +# DiamondTile + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The explicit diamond prototile of parameter $k$ is the prototile whose cell +set is $D^{\mathrm D}_k$ and whose auxiliary anchor is $0$. For $k>0$ the +cell set is nonempty. +-/ +def DiamondTile (k : Nat) : ProtoTile := +-- BODY + ⟨DiamondCellDomain k, 0⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondTileAcyclicIndegree.lean b/LeanPool/ApollonianSuperharmonic/DiamondTileAcyclicIndegree.lean new file mode 100644 index 0000000000..0487438809 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondTileAcyclicIndegree.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5432T1Normalization +public import LeanPool.ApollonianSuperharmonic.P5432T1EdgeLedger +public import LeanPool.ApollonianSuperharmonic.P4062T1OrientationTransport +public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable + +-- [TABLET NODE: DiamondTileAcyclicIndegree] + +/-! +# DiamondTileAcyclicIndegree + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem DiamondTileAcyclicIndegree : + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (g : + IntegerLatticeFunction), (BandPrototile ((DiamondRecursiveQuadruple K) 0) T) → + ((TileOdometer ((DiamondRecursiveQuadruple K) 0) T h) → (((h.domain : Set GaussianInt) = + FootprintVertices T) → ((GlobalOdometerExtends g h) → ( + let D := h.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _) + Nonempty (AcyclicIndegreeOrientation D + (fun x => 2 + FourNeighborLaplacian g x)))))) := by + intro K T h g hT hodo hdom hext +-- BODY + classical + let D := h.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _) + change Nonempty (AcyclicIndegreeOrientation D (fun x => 2 + FourNeighborLaplacian g x)) + obtain ⟨u, hinterior, hlap⟩ := P5432T1Normalization K T h g hodo hdom hext + have hm (x : GaussianInt) : x ∈ D ↔ x-u ∈ DiamondVertexDomains K true := by + simpa only [D, Finset.mem_filter, decide_eq_true_eq] using hinterior x + let E := D.image (fun x => x-u) + have hE (x : GaussianInt) : x ∈ E ↔ x ∈ DiamondVertexDomains K true := by + constructor + · intro hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx + exact (hm y).mp hy + · intro hx + exact Finset.mem_image.mpr ⟨x+u, (hm _).mpr (by simpa using hx), by simp⟩ + let edge := fun x y : GaussianInt => + x ∈ E ∧ y ∈ E ∧ FourNeighborAdjacent x y ∧ + (x.re.natAbs < y.re.natAbs ∨ + (x.re = y.re ∧ ¬ Even (x.re+x.im) ∧ Even (y.re+y.im))) + let rank := fun x : GaussianInt => + 2 * x.re.natAbs + if Even (x.re+x.im) then 1 else 0 + obtain ⟨hsupported, horiented, hincreasing, hcount⟩ := P5432T1EdgeLedger K E hE + let o : AcyclicIndegreeOrientation E + (fun x => 2 + FourNeighborLaplacian (DiamondOdometer K) x) := { + edge := edge + edge_decidable := fun _ _ => Classical.propDecidable _ + rank := rank + supported := hsupported + oriented := horiented + increasing := hincreasing + indegree := by + intro x hx + rw [hcount x hx, (DiamondLaplacianTable K).2.2 x ((hE x).mp hx)] + split_ifs <;> norm_num } + have hDE : D = E.image (fun x => x+u) := by + simp [E, Finset.image_image, Function.comp_def] + have hsigma : ∀ x ∈ D, 2 + FourNeighborLaplacian g x = + 2 + FourNeighborLaplacian (DiamondOdometer K) (x-u) := by + intro x hx + rw [hlap x ((hm x).mp hx)] + obtain ⟨transported, _, _⟩ := P4062T1OrientationTransport E D + (fun x => 2 + FourNeighborLaplacian (DiamondOdometer K) x) + (fun x => 2 + FourNeighborLaplacian g x) u hDE hsigma o + exact ⟨transported⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondTileGeometry.lean b/LeanPool/ApollonianSuperharmonic/DiamondTileGeometry.lean new file mode 100644 index 0000000000..152f2ffd74 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondTileGeometry.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.TileArea +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk +public import LeanPool.ApollonianSuperharmonic.P3092T1DiamondCenteredRectangles +public import LeanPool.ApollonianSuperharmonic.P3092T1CenteredRectangleDisk +public import Mathlib.Algebra.BigOperators.Intervals +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: DiamondTileGeometry] + +/-! +# DiamondTileGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem DiamondTileGeometry (k : Nat) (hk : 0 < k) : + LatticeTile (DiamondTile k) ∧ + TileArea (DiamondTile k) = 2 * k * (k + 1) := by +-- BODY + constructor + · change TopologicalDisk (TileRealization (DiamondTile k)) + rw [P3092T1DiamondCenteredRectangles k hk] + have hJ : (Finset.Icc 1 k).Nonempty := + ⟨1, Finset.mem_Icc.mpr ⟨le_rfl, hk⟩⟩ + have ha : ∀ j ∈ Finset.Icc 1 k, 0 < (j : Real) := by + intro j hj + exact_mod_cast (Nat.zero_lt_of_lt (Finset.mem_Icc.mp hj).1) + have hb : ∀ j ∈ Finset.Icc 1 k, 0 < (k : Real) - (j : Real) + 1 := by + intro j hj + have hjk : (j : Real) ≤ (k : Real) := by + exact_mod_cast (Finset.mem_Icc.mp hj).2 + linarith + have hdisk := P3092T1CenteredRectangleDisk (Finset.Icc 1 k) hJ + (0, (k : Real)) (fun j => (j : Real)) + (fun j => (k : Real) - (j : Real) + 1) ha hb + have hrect (j : Nat) : + Set.Icc (0 - (j : Real), (k : Real) - ((k : Real) - (j : Real) + 1)) + (0 + (j : Real), (k : Real) + ((k : Real) - (j : Real) + 1)) = + Set.Icc (-(j : Real), (j : Real) - 1) + ((j : Real), 2 * (k : Real) - (j : Real) + 1) := by + congr 1 <;> ext <;> simp <;> ring + simpa only [hrect] using hdisk + · change (DiamondCellDomain k).card = 2 * k * (k + 1) + classical + let r : Nat → Nat := fun y => min (y + 1) (2 * k - y) + let row : Nat → Finset GaussianInt := fun y => + (Finset.range (2 * r y)).image fun j : Nat => + (⟨(j : Int) - (r y : Int), (y : Int)⟩ : GaussianInt) + have hinj (y : Nat) : Function.Injective + (fun j : Nat => (⟨(j : Int) - (r y : Int), (y : Int)⟩ : GaussianInt)) := by + intro i j h + have hre := congrArg Zsqrtd.re h + simp only at hre + omega + have hcard (y : Nat) : (row y).card = 2 * r y := by + dsimp [row] + rw [Finset.card_image_of_injective _ (hinj y), Finset.card_range] + have hdisj : (↑(Finset.range (2 * k)) : Set Nat).PairwiseDisjoint row := by + intro y hy z hz hyz + apply Finset.disjoint_left.mpr + intro x hxy hxz + obtain ⟨i, hi, hix⟩ := Finset.mem_image.mp hxy + obtain ⟨j, hj, hjx⟩ := Finset.mem_image.mp hxz + have him := congrArg Zsqrtd.im (hix.trans hjx.symm) + simp only at him + exact hyz (by omega) + have hsum : (DiamondCellDomain k).card = + ∑ y ∈ Finset.range (2 * k), 2 * r y := by + change ((Finset.range (2 * k)).biUnion row).card = _ + rw [Finset.card_biUnion hdisj] + exact Finset.sum_congr rfl (fun y hy => hcard y) + have hfirst (y : Nat) (hy : y < k) : r y = y + 1 := by + dsimp [r] + apply Nat.min_eq_left + omega + have hlast (y : Nat) (hy : y < k) : r (k + y) = k - y := by + dsimp [r] + rw [Nat.min_eq_right (by omega)] + omega + have htriangle : ∀ n : Nat, + ∑ y ∈ Finset.range n, 2 * (y + 1) = n * (n + 1) := by + intro n + induction n with + | zero => simp + | succ n ih => + rw [Finset.sum_range_succ, ih] + ring + rw [hsum, show 2 * k = k + k by omega, Finset.sum_range_add] + have hs1 : (∑ y ∈ Finset.range k, 2 * r y) = k * (k + 1) := by + rw [← htriangle k] + apply Finset.sum_congr rfl + intro y hy + rw [hfirst y (Finset.mem_range.mp hy)] + have hs2 : (∑ y ∈ Finset.range k, 2 * r (k + y)) = k * (k + 1) := by + calc + _ = ∑ y ∈ Finset.range k, 2 * (k - y) := by + apply Finset.sum_congr rfl + intro y hy + rw [hlast y (Finset.mem_range.mp hy)] + _ = ∑ y ∈ Finset.range k, 2 * (y + 1) := by + rw [← Finset.sum_range_reflect (fun y => 2 * (y + 1)) k] + apply Finset.sum_congr rfl + intro y hy + have hyk := Finset.mem_range.mp hy + congr 1 + omega + _ = k * (k + 1) := htriangle k + rw [hs1, hs2] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondTileOdometerRestriction.lean b/LeanPool/ApollonianSuperharmonic/DiamondTileOdometerRestriction.lean new file mode 100644 index 0000000000..afb68a3229 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondTileOdometerRestriction.lean @@ -0,0 +1,467 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondOdometer +public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence +public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains +public import LeanPool.ApollonianSuperharmonic.DiamondTileGeometry +public import LeanPool.ApollonianSuperharmonic.P4207T1UnitRestrictions +public import LeanPool.ApollonianSuperharmonic.P4207T1ShiftedPredecessor +public import LeanPool.ApollonianSuperharmonic.P4223T1DiamondRowNumerators + +-- [TABLET NODE: DiamondTileOdometerRestriction] + +/-! +# DiamondTileOdometerRestriction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiamondRestrictionProof + +private theorem geometry : + (∀ (T : ProtoTile), ((P4207T1FormulaRestriction T).domain : Set GaussianInt) = + FootprintVertices T) → (∀ K : DiamondParameter, FootprintVertices (DiamondTile K.1) = + DiamondVertexDomains K false ∧ PartialOdometerSquares (P4207T1FormulaRestriction + (DiamondTile K.1)) = DiamondCellDomain K.1) := by + classical + intro domain + rintro ⟨k, hk⟩ + have footprint (x : GaussianInt) : + x ∈ FootprintVertices (DiamondTile k) ↔ + 0 ≤ x.im ∧ x.im ≤ 2 * (k : Int) ∧ + -(k : Int) ≤ x.re ∧ x.re ≤ (k : Int) ∧ + -x.im - 1 ≤ x.re ∧ x.re ≤ x.im + 1 ∧ + -(2 * (k : Int) - x.im + 1) ≤ x.re ∧ + x.re ≤ 2 * (k : Int) - x.im + 1 := by + rw [(P4194T1DiamondVertexIncidence k hk x).1] + have four : (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ DiamondCellDomain k) ↔ + x ∈ DiamondCellDomain k ∨ x - 1 ∈ DiamondCellDomain k ∨ + x - 1 - ⟨0, 1⟩ ∈ DiamondCellDomain k ∨ + x - ⟨0, 1⟩ ∈ DiamondCellDomain k := by + simp only [Fin.exists_fin_succ, LatticeVertexIncidentCell] + simp + rw [four] + simp only [(P4194T1DiamondCellRows _ _).1] + norm_num + omega + have vertex : FootprintVertices (DiamondTile k) = DiamondVertexDomains ⟨k, hk⟩ false := by + ext x + rw [footprint] + change _ ↔ max (Int.natAbs x.re) + (max (Int.natAbs (x.im - (k : Int))) + (Int.natAbs x.re + Int.natAbs (x.im - (k : Int)) - 1)) ≤ k + simp only [max_le_iff] + have h1 := Int.natCast_natAbs x.re + have h2 := Int.natCast_natAbs (x.im - (k : Int)) + rcases le_total 0 x.re with ha | ha <;> + rcases le_total 0 (x.im - (k : Int)) with hb | hb <;> + simp only [abs_of_nonneg, abs_of_nonpos, ha, hb] at h1 h2 <;> + omega + refine ⟨vertex, ?_⟩ + ext x + simp only [PartialOdometerSquares, Finset.mem_filter] + have mem (y : GaussianInt) : + y ∈ (P4207T1FormulaRestriction (DiamondTile k)).domain ↔ + y ∈ FootprintVertices (DiamondTile k) := by + change y ∈ ((P4207T1FormulaRestriction (DiamondTile k)).domain : Set GaussianInt) ↔ _ + rw [domain] + simp only [mem, footprint, (P4194T1DiamondCellRows _ _).1] + norm_num + omega + +private theorem slope : + (∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ (P4207T1FormulaRestriction T).domain) → + ((P4207T1FormulaRestriction T).value x = P4207T1DiamondFormula x)) → ((∀ K : + DiamondParameter, FootprintVertices (DiamondTile K.1) = DiamondVertexDomains K false ∧ + PartialOdometerSquares (P4207T1FormulaRestriction (DiamondTile K.1)) = + DiamondCellDomain K.1) → (∀ (K : DiamondParameter), PartialOdometerSlope + (P4207T1FormulaRestriction (DiamondTile K.1)) = some ((↑K.1 : ℝ) / (2 : ℝ), -((↑K.1 : + ℝ) / (2 : ℝ))))) := by + classical + intro value geometry K + let k := K.1 + let h := P4207T1FormulaRestriction (DiamondTile k) + have squares : PartialOdometerSquares h = DiamondCellDomain k := (geometry K).2 + let r : Nat → Nat := fun y => min (y + 1) (2 * k - y) + let row : Nat → Finset GaussianInt := fun y => + (Finset.range (2 * r y)).image fun j : Nat => + (⟨(j : Int) - (r y : Int), (y : Int)⟩ : GaussianInt) + have hinj (y : Nat) : Function.Injective + (fun j : Nat => (⟨(j : Int) - (r y : Int), (y : Int)⟩ : GaussianInt)) := by + intro i j he + have hre := congrArg Zsqrtd.re he + simp only at hre + omega + have hdisj : (↑(Finset.range (2 * k)) : Set Nat).PairwiseDisjoint row := by + intro y hy z hz hyz + apply Finset.disjoint_left.mpr + intro x hxy hxz + obtain ⟨i, hi, hix⟩ := Finset.mem_image.mp hxy + obtain ⟨j, hj, hjx⟩ := Finset.mem_image.mp hxz + have him := congrArg Zsqrtd.im (hix.trans hjx.symm) + simp only at him + exact hyz (by omega) + have by_rows (f : GaussianInt → Int) : + (∑ x ∈ DiamondCellDomain k, f x) = + ∑ y ∈ Finset.range (2 * k), ∑ j ∈ Finset.range (2 * r y), + f ⟨(j : Int) - (r y : Int), (y : Int)⟩ := by + change (∑ x ∈ (Finset.range (2 * k)).biUnion row, f x) = _ + rw [Finset.sum_biUnion hdisj] + apply Finset.sum_congr rfl + intro y hy + exact Finset.sum_image (fun i hi j hj he => hinj y he) + have hfirst (y : Nat) (hy : y < k) : r y = y + 1 := by + dsimp [r] + apply Nat.min_eq_left + omega + have hlast (y : Nat) (hy : y < k) : r (k + y) = k - y := by + dsimp [r] + rw [Nat.min_eq_right (by omega)] + omega + have triangle : ∀ n : Nat, + (∑ y ∈ Finset.range n, 2 * ((y : Int) + 1)) = + (n : Int) * ((n : Int) + 1) := by + intro n + induction n with + | zero => simp + | succ n ih => + rw [Finset.sum_range_succ, ih] + push_cast + ring + have height_sum : + (∑ y ∈ Finset.range (2 * k), (r y : Int) * (2 * (y : Int) + 1)) = + 2 * (k : Int) * (k : Int) * ((k : Int) + 1) := by + rw [show 2 * k = k + k by omega, Finset.sum_range_add] + have first : + (∑ y ∈ Finset.range k, (r y : Int) * (2 * (y : Int) + 1)) = + ∑ y ∈ Finset.range k, ((y : Int) + 1) * (2 * (y : Int) + 1) := by + apply Finset.sum_congr rfl + intro y hy + rw [hfirst y (Finset.mem_range.mp hy)] + push_cast + rfl + have last : + (∑ y ∈ Finset.range k, (r (k + y) : Int) * (2 * ((k + y : Nat) : Int) + 1)) = + ∑ y ∈ Finset.range k, ((y : Int) + 1) * + (4 * (k : Int) - 2 * (y : Int) - 1) := by + rw [← Finset.sum_range_reflect + (fun y => ((y : Int) + 1) * (4 * (k : Int) - 2 * (y : Int) - 1)) k] + apply Finset.sum_congr rfl + intro y hy + have hyk := Finset.mem_range.mp hy + rw [hlast y hyk] + have he : ((k - y : Nat) : Int) = (k : Int) - y := by omega + have he' : ((k - 1 - y : Nat) : Int) = (k : Int) - 1 - y := by omega + simp only [Nat.cast_add, he, he'] + ring + rw [first, last, ← Finset.sum_add_distrib] + calc + _ = ∑ y ∈ Finset.range k, (2 * (k : Int)) * (2 * ((y : Int) + 1)) := by + apply Finset.sum_congr rfl + intro y hy + ring + _ = _ := by rw [← Finset.mul_sum, triangle]; ring + have count : ((DiamondCellDomain k).card : Int) = + 2 * (k : Int) * ((k : Int) + 1) := by + have hc := (DiamondTileGeometry k K.2).2 + change (DiamondCellDomain k).card = 2 * k * (k + 1) at hc + exact_mod_cast hc + have nonempty : (DiamondCellDomain k).Nonempty := by + apply Finset.card_pos.mp + have hk := K.2 + have hc : 0 < ((DiamondCellDomain k).card : Int) := by + rw [count] + positivity + exact_mod_cast hc + have numerators (vertical : Bool) : + (∑ x ∈ DiamondCellDomain k, + if vertical then + h.value (x + ⟨0, 1⟩) - h.value x + + h.value (x + 1 + ⟨0, 1⟩) - h.value (x + 1) + else + h.value (x + 1) - h.value x + + h.value (x + 1 + ⟨0, 1⟩) - h.value (x + ⟨0, 1⟩)) = + (if vertical then -1 else 1) * (k : Int) * (DiamondCellDomain k).card := by + have replace : + (∑ x ∈ DiamondCellDomain k, + if vertical then + h.value (x + ⟨0, 1⟩) - h.value x + + h.value (x + 1 + ⟨0, 1⟩) - h.value (x + 1) + else + h.value (x + 1) - h.value x + + h.value (x + 1 + ⟨0, 1⟩) - h.value (x + ⟨0, 1⟩)) = + ∑ x ∈ DiamondCellDomain k, + if vertical then + P4207T1DiamondFormula (x + ⟨0, 1⟩) - P4207T1DiamondFormula x + + P4207T1DiamondFormula (x + 1 + ⟨0, 1⟩) - + P4207T1DiamondFormula (x + 1) + else + P4207T1DiamondFormula (x + 1) - P4207T1DiamondFormula x + + P4207T1DiamondFormula (x + 1 + ⟨0, 1⟩) - + P4207T1DiamondFormula (x + ⟨0, 1⟩) := by + apply Finset.sum_congr rfl + intro x hx + have hx' : x ∈ PartialOdometerSquares h := squares.symm ▸ hx + obtain ⟨h0, h1, hi, h1i⟩ := Finset.mem_filter.mp hx' + rw [value _ x h0, value _ _ h1, value _ _ hi, value _ _ h1i] + rw [replace, by_rows] + cases vertical + · simp only [Bool.false_eq_true, ↓reduceIte, one_mul] + calc + _ = ∑ y ∈ Finset.range (2 * k), (r y : Int) * (2 * (y : Int) + 1) := by + apply Finset.sum_congr rfl + intro y hy + exact (P4223T1DiamondRowNumerators (r y) (y : Int)).1 + _ = _ := by rw [height_sum, count]; ring + · simp only [↓reduceIte] + calc + _ = ∑ y ∈ Finset.range (2 * k), -(r y : Int) * (2 * (y : Int) + 1) := by + apply Finset.sum_congr rfl + intro y hy + exact (P4223T1DiamondRowNumerators (r y) (y : Int)).2 + _ = -(∑ y ∈ Finset.range (2 * k), (r y : Int) * (2 * (y : Int) + 1)) := by + simp only [neg_mul, Finset.sum_neg_distrib] + _ = _ := by rw [height_sum, count]; ring + have horizontal := congrArg (fun z : Int => (z : Real)) (numerators false) + have vertical := congrArg (fun z : Int => (z : Real)) (numerators true) + norm_num only [Bool.false_eq_true, ↓reduceIte, one_mul] at horizontal vertical + push_cast at horizontal vertical + change PartialOdometerSlope h = _ + simp only [PartialOdometerSlope, squares, nonempty, ↓reduceIte] + push_cast + rw [horizontal, vertical] + have hc : ((DiamondCellDomain k).card : Real) ≠ 0 := by + exact_mod_cast (Finset.card_ne_zero.mpr nonempty) + dsimp only [k] at hc + congr 1 + ext <;> dsimp [k] <;> field_simp [hc] + +private theorem certificates : + (∀ (T : ProtoTile), ((P4207T1FormulaRestriction T).domain : Set GaussianInt) = + FootprintVertices T) → ((∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ + (P4207T1FormulaRestriction T).domain) → ((P4207T1FormulaRestriction T).value x = + P4207T1DiamondFormula x)) → ((∀ (K : DiamondParameter), PartialOdometerSlope + (P4207T1FormulaRestriction (DiamondTile K.1)) = some (((K.1 : Real) / 2), -((K.1 : + Real) / 2))) → ((∀ (z : GaussianInt), ∀ (x : GaussianInt), (OdometerTranslation + (P4207T1FormulaRestriction ⟨{x}, x⟩) (CurvatureOneOdometer z)) → (TileOdometer (1, 1 + + 2 * z) ⟨{x}, x⟩ (P4207T1FormulaRestriction ⟨{x}, x⟩))) → (∀ n, ∀ (hn : 0 < n), + TileOdometer (DiamondRecursiveQuadruple ⟨n, hn⟩ 0) (DiamondTile n) + (P4207T1FormulaRestriction (DiamondTile n)))))) := by + classical + intro domain value slope unit n + induction n using Nat.strong_induction_on with + | h n ih => + intro hn + let K : DiamondParameter := ⟨n, hn⟩ + let q := DiamondRecursiveQuadruple K + obtain ⟨_, hq, _, _, _, _, _, _, ha32, ha13, ha21⟩ := + DiamondCoordinateConfiguration K + have arows (i : Fin 3) : + BandVectors.2 (q (i + 2).succ) (q (i + 1).succ) = + ![⟨1 - (n : Int), 0⟩, ⟨(n : Int) - 1, 1⟩, ⟨0, -1⟩] i := by + fin_cases i + · exact ha32 + · exact ha13 + · exact ha21 + obtain ⟨hT, S, hocc, hcells, e0t, e0f, e1t, e1f, e2f, e2t⟩ := + DiamondTileRecursiveIdentification K + have units := P4207T1UnitRestrictions K + have outerSlope := slope K + have hprev : TileOdometer (q 3) (DiamondTile (n - 1)) + (P4207T1FormulaRestriction (DiamondTile (n - 1))) := by + by_cases hp : 0 < n - 1 + · have hi := ih (n - 1) (by omega) hp + have he : n - 1 + 1 = n := by omega + have heI : ((n - 1 : Nat) : Int) + 1 = (n : Int) := by omega + simpa [q, K, DiamondRecursiveQuadruple, he, heI] using hi + · have he : n = 1 := by omega + subst n + convert TileOdometer.line (-1) 0 (Or.inr rfl) + (P4207T1FormulaRestriction (DiamondTile 0)) (by + simp [P4207T1FormulaRestriction, DiamondTile, DiamondCellDomain]) using 1 <;> + simp [q, K, DiamondRecursiveQuadruple, DiamondTile, DiamondCellDomain, + Zsqrtd.ext_iff] + have hupper := TileOdometerAffineTranslation _ _ _ ⟨0, 2⟩ ⟨1, -1⟩ 1 hprev + rw [← P4207T1ShiftedPredecessor] at hupper + have hsub (i : Fin 3) (s : Bool) : + TileOdometer (q i.succ) (S i s) (P4207T1FormulaRestriction (S i s)) := by + fin_cases i <;> cases s + · change TileOdometer (q 1) (S 0 false) (P4207T1FormulaRestriction (S 0 false)) + rw [e0f] + convert unit ⟨0, 1⟩ ⟨(n : Int) - 1, (n : Int)⟩ (units 0 false).1 using 1; + simp [q, K, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] + · change TileOdometer (q 1) (S 0 true) (P4207T1FormulaRestriction (S 0 true)) + rw [e0t] + convert unit ⟨0, 1⟩ ⟨-(n : Int), (n : Int) - 1⟩ (units 0 true).1 using 1; + simp [q, K, DiamondRecursiveQuadruple, Zsqrtd.ext_iff] + · change TileOdometer (q 2) (S 1 false) (P4207T1FormulaRestriction (S 1 false)) + rw [e1f] + simpa [q, K, DiamondRecursiveQuadruple] using + unit 0 ⟨-(n : Int), (n : Int)⟩ (units 1 false).1 + · change TileOdometer (q 2) (S 1 true) (P4207T1FormulaRestriction (S 1 true)) + rw [e1t] + simpa [q, K, DiamondRecursiveQuadruple] using + unit 0 ⟨(n : Int) - 1, (n : Int) - 1⟩ (units 1 true).1 + · change TileOdometer (q 3) (S 2 false) (P4207T1FormulaRestriction (S 2 false)) + rw [e2f] + exact hprev + · change TileOdometer (q 3) (S 2 true) (P4207T1FormulaRestriction (S 2 true)) + rw [e2t] + exact hupper + have nonempty : (DiamondTile n).cells.Nonempty := by + refine ⟨0, (P4194T1DiamondCellRows n 0).1.mpr ?_⟩ + norm_num + omega + have cover (x : GaussianInt) : + x ∈ (P4207T1FormulaRestriction (DiamondTile n)).domain ↔ + ∃ i s, x ∈ (P4207T1FormulaRestriction (S i s)).domain := by + have member (T : ProtoTile) (x : GaussianInt) : + x ∈ (P4207T1FormulaRestriction T).domain ↔ x ∈ FootprintVertices T := by + change x ∈ ((P4207T1FormulaRestriction T).domain : Set GaussianInt) ↔ _ + rw [domain] + simp only [member] + constructor + · intro hx + rw [FootprintVertices, ite_eq_left nonempty] at hx + obtain ⟨a, ha, hx⟩ := hx + obtain ⟨i, s, has⟩ := (hcells a).mp ha + have hsne : (S i s).cells.Nonempty := ⟨a, has⟩ + refine ⟨i, s, ?_⟩ + rw [FootprintVertices, ite_eq_left hsne] + exact ⟨a, has, hx⟩ + · rintro ⟨i, s, hx⟩ + exact (hocc i s).2.1 hx + refine TileOdometer.decompose (q := q) (S := S) + (hs := fun i s => P4207T1FormulaRestriction (S i s)) + (h := P4207T1FormulaRestriction (DiamondTile n)) hq hT hsub hcells + (fun i s => (hocc i s).2.1) (fun i s => (hocc i s).2.2) cover ?_ ?_ ?_ + · intro i s x hx + rw [value _ x ((cover x).mpr ⟨i, s, hx⟩), value _ x hx] + · intro i s j t + right + refine ⟨0, ?_⟩ + intro x hx hy + rw [value _ x hy, value _ x hx, sub_self] + · intro i s + rw [arows i] + fin_cases i <;> cases s + · refine Or.inr ⟨_, ((n : Real) - 1 / 2, -1 / 2), outerSlope, ?_, ?_, ?_⟩ + · change PartialOdometerSlope (P4207T1FormulaRestriction (S 0 false)) = _ + rw [e0f]; exact (units 0 false).2 + all_goals norm_num [K]; ring + · refine Or.inr ⟨_, (1 / 2, 1 / 2 - (n : Real)), outerSlope, ?_, ?_, ?_⟩ + · change PartialOdometerSlope (P4207T1FormulaRestriction (S 0 true)) = _ + rw [e0t]; exact (units 0 true).2 + all_goals norm_num [K]; ring + · refine Or.inr ⟨_, (1, -(n : Real)), outerSlope, ?_, ?_, ?_⟩ + · change PartialOdometerSlope (P4207T1FormulaRestriction (S 1 false)) = _ + rw [e1f]; exact (units 1 false).2 + all_goals norm_num [K]; ring + · refine Or.inr ⟨_, ((n : Real) - 1, 0), outerSlope, ?_, ?_, ?_⟩ + · change PartialOdometerSlope (P4207T1FormulaRestriction (S 1 true)) = _ + rw [e1t]; exact (units 1 true).2 + all_goals norm_num [K]; ring + · by_cases hp : 0 < n - 1 + · have hs := slope ⟨n - 1, hp⟩ + refine Or.inr ⟨_, (((n - 1 : Nat) : Real) / 2, + -(((n - 1 : Nat) : Real) / 2)), outerSlope, ?_, ?_, ?_⟩ + · change PartialOdometerSlope (P4207T1FormulaRestriction (S 2 false)) = _ + rw [e2f]; exact hs + all_goals + norm_num [K] + rw [Nat.cast_sub (by omega : 1 ≤ n)] + push_cast + ring + · left + have he : n = 1 := by omega + simp [q, K, DiamondRecursiveQuadruple, he] + · by_cases hp : 0 < n - 1 + · have hs := (PartialOdometerAffineTranslateFormulas + (P4207T1FormulaRestriction (DiamondTile (n - 1))) + ⟨0, 2⟩ ⟨1, -1⟩ 1).2.2.2.2.2 + rw [slope ⟨n - 1, hp⟩] at hs + refine Or.inr ⟨_, ((((n - 1 : Nat) : Real) / 2 + 1), + -(((n - 1 : Nat) : Real) / 2) - 1), outerSlope, ?_, ?_, ?_⟩ + · change PartialOdometerSlope (P4207T1FormulaRestriction (S 2 true)) = _ + rw [e2t, P4207T1ShiftedPredecessor] + simpa [K, sub_eq_add_neg] using hs + all_goals + norm_num [K] + rw [Nat.cast_sub (by omega : 1 ≤ n)] + push_cast + ring + · left + have he : n = 1 := by omega + simp [q, K, DiamondRecursiveQuadruple, he] + +end DiamondRestrictionProof + +theorem DiamondTileOdometerRestriction (K : DiamondParameter) : + ∃ h : PartialOdometer, + TileOdometer ((DiamondRecursiveQuadruple K) 0) + (DiamondTile K.1) h /\ + (h.domain : Set GaussianInt) = DiamondVertexDomains K false /\ + FootprintVertices (DiamondTile K.1) = + DiamondVertexDomains K false /\ + PartialOdometerSquares h = DiamondCellDomain K.1 /\ + (∀ x, x ∈ h.domain → h.value x = DiamondOdometer K x) /\ + PartialOdometerSlope h = + some (((K.1 : Real) / 2), -((K.1 : Real) / 2)) := by +-- BODY + classical + have domain (T : ProtoTile) : + ((P4207T1FormulaRestriction T).domain : Set GaussianInt) = FootprintVertices T := + by + ext x + by_cases h : T.cells.Nonempty <;> + simp [P4207T1FormulaRestriction, FootprintVertices, h] + have value (T : ProtoTile) (x : GaussianInt) + (hx : x ∈ (P4207T1FormulaRestriction T).domain) : + (P4207T1FormulaRestriction T).value x = P4207T1DiamondFormula x := + by + change (if x ∈ (P4207T1FormulaRestriction T).domain then _ else 0) = _ + exact ite_eq_left hx + have geometry : ∀ K : DiamondParameter, + FootprintVertices (DiamondTile K.1) = DiamondVertexDomains K false ∧ + PartialOdometerSquares (P4207T1FormulaRestriction (DiamondTile K.1)) = + DiamondCellDomain K.1 := DiamondRestrictionProof.geometry domain + have slope (K : DiamondParameter) : + PartialOdometerSlope (P4207T1FormulaRestriction (DiamondTile K.1)) = + some (((K.1 : Real) / 2), -((K.1 : Real) / 2)) := DiamondRestrictionProof.slope value + geometry K + have unit (z x : GaussianInt) + (ht : OdometerTranslation (P4207T1FormulaRestriction ⟨{x}, x⟩) + (CurvatureOneOdometer z)) : + TileOdometer (1, 1 + 2 * z) ⟨{x}, x⟩ + (P4207T1FormulaRestriction ⟨{x}, x⟩) := + TileOdometer.unit z x _ _ rfl (domain _) ht + have certificates : ∀ n (hn : 0 < n), + TileOdometer (DiamondRecursiveQuadruple ⟨n, hn⟩ 0) (DiamondTile n) + (P4207T1FormulaRestriction (DiamondTile n)) := DiamondRestrictionProof.certificates + domain value slope unit + refine ⟨P4207T1FormulaRestriction (DiamondTile K.1), certificates K.1 K.2, + (domain _).trans (geometry K).1, + (geometry K).1, + (geometry K).2, ?_, slope K⟩ + intro x hx + rw [value _ x hx] + have hdom : x ∈ DiamondVertexDomains K false := by + rw [← (geometry K).1, ← domain] + exact hx + exact ((Classical.choose_spec (DiamondOdometerExistsUnique K)).1.2.2.2 x hdom).symm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondTileRecursiveIdentification.lean b/LeanPool/ApollonianSuperharmonic/DiamondTileRecursiveIdentification.lean new file mode 100644 index 0000000000..cf28ad977f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondTileRecursiveIdentification.lean @@ -0,0 +1,234 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain +public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCentroid + +-- [TABLET NODE: DiamondTileRecursiveIdentification] + +/-! +# DiamondTileRecursiveIdentification + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem DiamondTileRecursiveIdentification (K : DiamondParameter) : + BandPrototile ((DiamondRecursiveQuadruple K) 0) (DiamondTile K.1) ∧ + ∃ S : Fin 3 → Bool → ProtoTile, + (∀ i s, BandSubtileOccurrence (DiamondRecursiveQuadruple K) + (DiamondTile K.1) i s (S i s)) ∧ + (∀ x, x ∈ (DiamondTile K.1).cells ↔ ∃ i s, x ∈ (S i s).cells) ∧ + S 0 true = + ⟨{⟨-(K.1 : Int), (K.1 : Int) - 1⟩}, + ⟨-(K.1 : Int), (K.1 : Int) - 1⟩⟩ ∧ + S 0 false = + ⟨{⟨(K.1 : Int) - 1, (K.1 : Int)⟩}, + ⟨(K.1 : Int) - 1, (K.1 : Int)⟩⟩ ∧ + S 1 true = + ⟨{⟨(K.1 : Int) - 1, (K.1 : Int) - 1⟩}, + ⟨(K.1 : Int) - 1, (K.1 : Int) - 1⟩⟩ ∧ + S 1 false = + ⟨{⟨-(K.1 : Int), (K.1 : Int)⟩}, + ⟨-(K.1 : Int), (K.1 : Int)⟩⟩ ∧ + S 2 false = DiamondTile (K.1 - 1) ∧ + S 2 true = TileTranslation (DiamondTile (K.1 - 1)) ⟨0, 2⟩ := by +-- BODY + classical + have centroid (n : Nat) : TileCentroid (DiamondTile n) = (0, (n : Real)) := by + by_cases hn : 0 < n + · exact P4194T1DiamondCentroid n hn + · have hn0 : n = 0 := by omega + subst n + simp [TileCentroid, DiamondTile, DiamondCellDomain] + have singleton_centroid (x : GaussianInt) : + TileCentroid (⟨{x}, x⟩ : ProtoTile) = + ((x.re : Real) + 1 / 2, (x.im : Real) + 1 / 2) := by + simp [TileCentroid] + have translated_mem (n : Nat) (x : GaussianInt) : + x ∈ (TileTranslation (DiamondTile n) ⟨0, 2⟩).cells ↔ + x - ⟨0, 2⟩ ∈ DiamondCellDomain n := by + change x ∈ (DiamondCellDomain n).image (GaussianTranslation ⟨0, 2⟩) ↔ _ + constructor + · intro hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx + simpa [GaussianTranslation] using hy + · intro hx + exact Finset.mem_image.mpr + ⟨x - ⟨0, 2⟩, hx, by simp [GaussianTranslation]⟩ + rcases K with ⟨k, hk⟩ + induction k using Nat.strong_induction_on with + | h k ih => + let q := DiamondRecursiveQuadruple ⟨k, hk⟩ + obtain ⟨_, hq, h10, h20, h30, _⟩ := DiamondCoordinateConfiguration ⟨k, hk⟩ + have hs := (VectorRecursionLaws q hq.1).1 + have h1 := (VectorRecursionLaws q hq.1).2.2.1 + have h3 : BandVectors.1 (q 3) (q 0) = + BandVectors.1 (q 3) (q 2) - + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 1) (q 3) := by + simpa using (VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1))).2.2.1 + change BandVectors.1 (q 1) (q 0) = _ at h10 + change BandVectors.1 (q 3) (q 0) = _ at h30 + rw [h10] at h1 + rw [h30] at h3 + simp only [Zsqrtd.ext_iff, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_mul, Zsqrtd.im_mul, + Zsqrtd.re_zero, Zsqrtd.im_zero] at hs h1 h3 + norm_num at hs h1 h3 + have h32 : BandVectors.1 (q 3) (q 2) = + ⟨1 - (k : Int), -(k : Int)⟩ := by + apply Zsqrtd.ext <;> dsimp <;> omega + have h13 : BandVectors.1 (q 1) (q 3) = + ⟨(k : Int), (k : Int) - 1⟩ := by + apply Zsqrtd.ext <;> dsimp <;> omega + have h21 : BandVectors.1 (q 2) (q 1) = ⟨-1, 1⟩ := by + apply Zsqrtd.ext <;> dsimp <;> omega + let S : Fin 3 → Bool → ProtoTile := + ![fun s => if s then + ⟨{⟨-(k : Int), (k : Int) - 1⟩}, ⟨-(k : Int), (k : Int) - 1⟩⟩ else + ⟨{⟨(k : Int) - 1, (k : Int)⟩}, ⟨(k : Int) - 1, (k : Int)⟩⟩, + fun s => if s then + ⟨{⟨(k : Int) - 1, (k : Int) - 1⟩}, + ⟨(k : Int) - 1, (k : Int) - 1⟩⟩ else + ⟨{⟨-(k : Int), (k : Int)⟩}, ⟨-(k : Int), (k : Int)⟩⟩, + fun s => if s then TileTranslation (DiamondTile (k - 1)) ⟨0, 2⟩ else + DiamondTile (k - 1)] + have row_union (x : GaussianInt) : x ∈ DiamondCellDomain k ↔ + x = ⟨-(k : Int), (k : Int) - 1⟩ ∨ + x = ⟨(k : Int) - 1, (k : Int)⟩ ∨ + x = ⟨(k : Int) - 1, (k : Int) - 1⟩ ∨ + x = ⟨-(k : Int), (k : Int)⟩ ∨ + x ∈ DiamondCellDomain (k - 1) ∨ + x - ⟨0, 2⟩ ∈ DiamondCellDomain (k - 1) := by + simp only [(P4194T1DiamondCellRows _ _).1, Zsqrtd.ext_iff] + norm_num + omega + have hcells (x : GaussianInt) : + x ∈ (DiamondTile k).cells ↔ ∃ i s, x ∈ (S i s).cells := by + change x ∈ DiamondCellDomain k ↔ _ + rw [row_union] + constructor + · rintro (hx | hx | hx | hx | hx | hx) + · exact ⟨0, true, by simpa [S] using hx⟩ + · exact ⟨0, false, by simpa [S] using hx⟩ + · exact ⟨1, true, by simpa [S] using hx⟩ + · exact ⟨1, false, by simpa [S] using hx⟩ + · exact ⟨2, false, hx⟩ + · exact ⟨2, true, (translated_mem (k - 1) x).mpr hx⟩ + · rintro ⟨i, s, hx⟩ + fin_cases i <;> cases s + · exact Or.inr (Or.inl (by simpa [S] using hx)) + · exact Or.inl (by simpa [S] using hx) + · exact Or.inr (Or.inr (Or.inr (Or.inl (by simpa [S] using hx)))) + · exact Or.inr (Or.inr (Or.inl (by simpa [S] using hx))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl hx)))) + · exact Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr ((translated_mem (k - 1) x).mp hx))))) + have hsubset (i : Fin 3) (s : Bool) : (S i s).cells ⊆ (DiamondTile k).cells := by + intro x hx + exact (hcells x).mpr ⟨i, s, hx⟩ + have hzero : (0 : GaussianInt) ∈ (DiamondTile k).cells := by + apply (P4194T1DiamondCellRows k 0).1.mpr + norm_num + omega + have hnonempty : (DiamondTile k).cells.Nonempty := ⟨0, hzero⟩ + have zero_foot : (0 : GaussianInt) ∈ FootprintVertices (DiamondTile k) := by + simp only [FootprintVertices, ite_eq_left hnonempty, Set.mem_ofPred_eq] + exact ⟨0, hzero, Or.inl rfl⟩ + have two_foot : (⟨0, 2⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile k) := by + have hcell : (⟨0, 1⟩ : GaussianInt) ∈ (DiamondTile k).cells := by + apply (P4194T1DiamondCellRows k ⟨0, 1⟩).1.mpr + norm_num + omega + simp only [FootprintVertices, ite_eq_left hnonempty, Set.mem_ofPred_eq] + exact ⟨⟨0, 1⟩, hcell, Or.inr (Or.inr (Or.inl rfl))⟩ + have hfoot (i : Fin 3) (s : Bool) : + FootprintVertices (S i s) ⊆ FootprintVertices (DiamondTile k) := by + intro v hv + by_cases hne : (S i s).cells.Nonempty + · simp only [FootprintVertices, ite_eq_left hne, ite_eq_left hnonempty, + Set.mem_ofPred_eq] at hv ⊢ + obtain ⟨x, hx, hv⟩ := hv + exact ⟨x, hsubset i s hx, hv⟩ + · simp only [FootprintVertices, ite_eq_right hne, Set.mem_singleton_iff] at hv + subst v + fin_cases i <;> cases s + · simp [S] at hne + · simp [S] at hne + · simp [S] at hne + · simp [S] at hne + · simpa [S, DiamondTile] using zero_foot + · simpa [S, TileTranslation, GaussianTranslation, DiamondTile] using two_foot + have hprev : BandPrototile (q 3) (DiamondTile (k - 1)) := by + by_cases hp : 0 < k - 1 + · have hpk : k - 1 < k := by omega + have hpred := (ih (k - 1) hpk hp).1 + have hsucc : k - 1 + 1 = k := by omega + have hsuccI : ((k - 1 : Nat) : Int) + 1 = (k : Int) := by omega + simpa [q, DiamondRecursiveQuadruple, hsucc, hsuccI] using hpred + · have hk1 : k = 1 := by omega + subst k + convert (BandPrototile.line (-1) 0 (Or.inr rfl)) using 1 <;> + simp [q, DiamondRecursiveQuadruple, DiamondTile, DiamondCellDomain, + Zsqrtd.ext_iff] + have hparents (i : Fin 3) (s : Bool) : BandPrototile (q i.succ) (S i s) := by + fin_cases i + · cases s + · convert (BandPrototile.unit (⟨0, 1⟩ : GaussianInt) + ⟨(k : Int) - 1, (k : Int)⟩ ⟨(k : Int) - 1, (k : Int)⟩) using 1 <;> + simp [q, DiamondRecursiveQuadruple, S, Zsqrtd.ext_iff] + · convert (BandPrototile.unit (⟨0, 1⟩ : GaussianInt) + ⟨-(k : Int), (k : Int) - 1⟩ ⟨-(k : Int), (k : Int) - 1⟩) using 1 <;> + simp [q, DiamondRecursiveQuadruple, S, Zsqrtd.ext_iff] + · cases s + · simpa [q, DiamondRecursiveQuadruple, S] using + (BandPrototile.unit 0 + ⟨-(k : Int), (k : Int)⟩ ⟨-(k : Int), (k : Int)⟩) + · simpa [q, DiamondRecursiveQuadruple, S] using + (BandPrototile.unit 0 + ⟨(k : Int) - 1, (k : Int) - 1⟩ ⟨(k : Int) - 1, (k : Int) - 1⟩) + · cases s + · exact hprev + · exact BandPrototileTranslation (q 3) (DiamondTile (k - 1)) ⟨0, 2⟩ hprev + have hcentroid (i : Fin 3) (s : Bool) : + TileCentroid (S i s) - TileCentroid (DiamondTile k) = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q (i + 2).succ) (q (i + 1).succ)) - + (-((GaussianRealPoint + (BandVectors.1 (q (i + 2).succ) (q (i + 1).succ))).2), + (GaussianRealPoint + (BandVectors.1 (q (i + 2).succ) (q (i + 1).succ))).1))) := by + have hsucc : 1 ≤ k := by omega + have htrans := (TileTranslationFormulas (DiamondTile (k - 1)) ⟨0, 2⟩).2.2.2.2.1 + fin_cases i <;> cases s <;> + simp [S, singleton_centroid, centroid, htrans, h32, h13, h21, + GaussianRealPoint, Prod.ext_iff, Nat.cast_sub hsucc] <;> ring <;> simp + refine ⟨BandPrototile.decompose hq hparents hcells hfoot hcentroid, + S, ?_, hcells, rfl, rfl, rfl, rfl, rfl, rfl⟩ + intro i s + exact ⟨hparents i s, hfoot i s, hcentroid i s⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondVertexDomains.lean b/LeanPool/ApollonianSuperharmonic/DiamondVertexDomains.lean new file mode 100644 index 0000000000..0882e7d1ac --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondVertexDomains.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondParameter +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction + +-- [TABLET NODE: DiamondVertexDomains] + +/-! +# DiamondVertexDomains + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $k>0$, let +$$ + T_k=\{x:\max(|x_1|,|x_2-k|,|x_1|+|x_2-k|-1)\le k\} +$$ +and let its inner diamond be +$$ + T'_k=\{x:|x_1|+|x_2-k|\le k-1\}. +$$ +We write `false` for $T_k$ and `true` for $T'_k$. These are +closed vertex domains, not the staircase cell set `DiamondCellDomain`. +-/ +def DiamondVertexDomains (K : DiamondParameter) : Bool -> Set GaussianInt := +-- BODY + fun interior x => + if interior then + Int.natAbs x.re + Int.natAbs (x.im - (K.1 : Int)) <= K.1 - 1 + else + max (Int.natAbs x.re) + (max (Int.natAbs (x.im - (K.1 : Int))) + (Int.natAbs x.re + Int.natAbs (x.im - (K.1 : Int)) - 1)) <= K.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean b/LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean new file mode 100644 index 0000000000..2917004bfe --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean @@ -0,0 +1,673 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Combinatorics.SimpleGraph.Acyclic +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle + +-- [TABLET NODE: DisjointBoundaryCommonEdgeGraphAcyclic] + +/-! +# DisjointBoundaryCommonEdgeGraphAcyclic + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CommonBoundaryAcyclicityConstruction + +private noncomputable abbrev X (U : ProtoTile) (V : ProtoTile) := CommonFootprintEdgeVertices U V + +private noncomputable abbrev G (U : ProtoTile) (V : ProtoTile) : SimpleGraph (X U V) := by + classical + let X := CommonFootprintEdgeVertices U V + change (SimpleGraph X) + exact SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ + FootprintEdges U ∩ FootprintEdges V + +private theorem cycle_subcycle_eq {B : SimpleGraph GaussianInt} {u w : GaussianInt} + (outer : B.Walk u u) (inner : B.Walk w w) + (houter : outer.IsCycle) (hinner : inner.IsCycle) + (hle : inner.toSubgraph ≤ outer.toSubgraph) : + inner.toSubgraph = outer.toSubgraph := by + classical + have neighbor_eq {a : GaussianInt} (ha : a ∈ inner.toSubgraph.verts) : + inner.toSubgraph.neighborSet a = outer.toSubgraph.neighborSet a := by + apply Set.eq_of_subset_of_ncard_le + · intro b hab + exact hle.2 hab + · rw [hinner.ncard_neighborSet_toSubgraph_eq_two + (inner.mem_verts_toSubgraph.mp ha)] + rw [houter.ncard_neighborSet_toSubgraph_eq_two + (outer.mem_verts_toSubgraph.mp (hle.1 ha))] + · exact SimpleGraph.Walk.finite_neighborSet_toSubgraph outer + have propagate {a b : GaussianInt} (ha : a ∈ inner.toSubgraph.verts) + (hab : outer.toSubgraph.Adj a b) : b ∈ inner.toSubgraph.verts := by + have hb : b ∈ inner.toSubgraph.neighborSet a := by + rw [neighbor_eq ha] + exact hab + exact inner.toSubgraph.edge_vert hb.symm + have verts_eq : inner.toSubgraph.verts = outer.toSubgraph.verts := by + apply Set.Subset.antisymm hle.1 + intro z hz + have hwInner : w ∈ inner.toSubgraph.verts := by + rw [SimpleGraph.Walk.mem_verts_toSubgraph] + exact inner.start_mem_support + have hwOuter : w ∈ outer.toSubgraph.verts := hle.1 hwInner + obtain ⟨walk⟩ := outer.toSubgraph_connected + ⟨w, hwOuter⟩ ⟨z, hz⟩ + have walk_end_mem : + ∀ {a b : outer.toSubgraph.verts} + (q : outer.toSubgraph.coe.Walk a b), + a.1 ∈ inner.toSubgraph.verts → b.1 ∈ inner.toSubgraph.verts := by + intro a b q ha + induction q with + | nil => exact ha + | @cons a b d hab q ih => + apply ih + exact propagate ha (by simpa using hab) + exact walk_end_mem walk hwInner + apply SimpleGraph.Subgraph.ext + · exact verts_eq + · funext a b + apply propext + constructor + · intro hab + exact hle.2 hab + · intro hab + have ha : a ∈ inner.toSubgraph.verts := verts_eq ▸ outer.toSubgraph.edge_vert hab + have : b ∈ inner.toSubgraph.neighborSet a := by + rw [neighbor_eq ha] + exact hab + exact this + +private noncomputable abbrev boundaryGraph (T : ProtoTile) : SimpleGraph GaussianInt := by + classical + exact SimpleGraph.fromRel fun a b => + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T + +private theorem pair_eq_iff_sym2 (a b r s' : GaussianInt) : + ({a, b} : Finset GaussianInt) = {r, s'} ↔ s(a, b) = s(r, s') := by + classical + constructor + · intro h + have hs : ({a, b} : Set GaussianInt) = {r, s'} := by + ext t + have ht := congrArg (fun e : Finset GaussianInt => t ∈ e) h + apply Iff.of_eq + simpa only [Finset.mem_insert, Finset.mem_singleton, + Set.mem_insert_iff, Set.mem_singleton_iff] using ht + rw [Set.pair_eq_pair_iff] at hs + simpa [Sym2.eq] using hs + · intro h + simp only [Sym2.eq, Sym2.rel_iff', Prod.mk.injEq, + Prod.swap_prod_mk] at h + rcases h with h | h + · simp [h.1, h.2] + · simp [h.1, h.2, Finset.pair_comm] + +private theorem boundary_cycle (T : ProtoTile) + (ht : SimpleGridCycle (BoundaryFootprintVertices T) + (BoundaryFootprintEdges T)) : + ∃ (z : GaussianInt) (d : (boundaryGraph T).Walk z z), d.IsCycle ∧ + ∀ {a b : GaussianInt}, a ≠ b → + (({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ + d.toSubgraph.Adj a b) := by + classical + let boundaryGraph (T : ProtoTile) : SimpleGraph GaussianInt := + SimpleGraph.fromRel fun a b => + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T + have pair_eq_iff_sym2 (a b r s' : GaussianInt) : + ({a, b} : Finset GaussianInt) = {r, s'} ↔ s(a, b) = s(r, s') := pair_eq_iff_sym2 a b r s' + change (∃ (z : GaussianInt) (d : (boundaryGraph T).Walk z z), d.IsCycle ∧ + ∀ {a b : GaussianInt}, a ≠ b → + (({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ + d.toSubgraph.Adj a b)) + obtain ⟨p, x, y, hpNodup, hpLength, hpHead, hpLast, _, hclose, + hpAdj, hpEdges⟩ := ht + have hpne : p ≠ [] := by intro h; simp [h] at hpLength + have hxy : y ≠ x := by + intro h + subst y + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] at hclose + omega + have graph_adj_iff (a b : GaussianInt) : + (boundaryGraph T).Adj a b ↔ a ≠ b ∧ + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T := by + simp only [boundaryGraph, SimpleGraph.fromRel_adj] + constructor + · rintro ⟨hne, hab | hba⟩ + · exact ⟨hne, hab⟩ + · exact ⟨hne, Finset.pair_comm b a ▸ hba⟩ + · rintro ⟨hne, hab⟩ + exact ⟨hne, Or.inl hab⟩ + have hpChain : List.IsChain (boundaryGraph T).Adj p := by + rw [List.isChain_iff_forall_rel_of_append_cons_cons] + intro a b l₁ l₂ heq + apply (graph_adj_iff a b).mpr + refine ⟨?_, ?_⟩ + · have hadj := hpAdj a b l₁ l₂ heq + intro hab + subst b + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] at hadj + omega + · exact (hpEdges {a, b}).mpr (Or.inr ⟨a, b, l₁, l₂, heq, rfl⟩) + have hx : p.head hpne = x := by + exact (List.head_eq_iff_head?_eq_some hpne).mpr hpHead + have hy : p.getLast hpne = y := by + exact (List.getLast_eq_iff_getLast?_eq_some hpne).mpr hpLast + let q : (boundaryGraph T).Walk x y := + (SimpleGraph.Walk.ofSupport p hpne hpChain).copy hx hy + have hqSupport : q.support = p := by + simp [q] + have hqPath : q.IsPath := by + rw [SimpleGraph.Walk.isPath_def, hqSupport] + exact hpNodup + have hcloseAdj : (boundaryGraph T).Adj y x := + (graph_adj_iff y x).mpr ⟨hxy, + (hpEdges {y, x}).mpr (Or.inl rfl)⟩ + have hcloseNotMem : s(y, x) ∉ q.edges := by + intro hmem + have hlen := hqPath.length_eq_one_of_mem_edges (Sym2.eq_swap ▸ hmem) + have hqLength : q.length = p.length - 1 := by + simp [q] + omega + let d : (boundaryGraph T).Walk y y := q.cons hcloseAdj + have hdCycle : d.IsCycle := by + change (q.cons hcloseAdj).IsCycle + rw [SimpleGraph.Walk.cons_isCycle_iff] + exact ⟨hqPath, hcloseNotMem⟩ + refine ⟨y, d, hdCycle, ?_⟩ + intro a b hab + rw [SimpleGraph.Walk.adj_toSubgraph_iff_mem_edges] + simp only [d, SimpleGraph.Walk.edges_cons, List.mem_cons] + rw [hpEdges] + constructor + · intro he + rcases he with he | ⟨r, s', l₁, l₂, heq, hrs⟩ + · left + exact (pair_eq_iff_sym2 a b y x).mp he + · right + rw [SimpleGraph.Walk.edges_eq_zipWith_support, hqSupport] + have adjacent_mem_zip (l₁ l₂ : List GaussianInt) + (r s' : GaussianInt) : s(r, s') ∈ + List.zipWith (fun x y => s(x, y)) + (l₁ ++ r :: s' :: l₂) (l₁ ++ r :: s' :: l₂).tail := by + induction l₁ with + | nil => simp + | cons t l ih => + cases l with + | nil => simp + | cons r' l => + simp only [List.cons_append, List.tail_cons, + List.zipWith_cons_cons, List.mem_cons] + exact Or.inr ih + have hm : s(r, s') ∈ + List.zipWith (fun x y => s(x, y)) p p.tail := by + rw [heq] + exact adjacent_mem_zip l₁ l₂ r s' + have hsym : s(a, b) = s(r, s') := by + exact (pair_eq_iff_sym2 a b r s').mp hrs + exact hsym ▸ hm + · intro he + rcases he with he | he + · left + exact (pair_eq_iff_sym2 a b y x).mpr he + · right + rw [SimpleGraph.Walk.edges_eq_zipWith_support, hqSupport] at he + rw [List.mem_iff_getElem] at he + obtain ⟨i, hi, hieq⟩ := he + have hi' : i + 1 < p.length := by + simp [List.length_zipWith] at hi + omega + let l₁ := p.take i + let l₂ := p.drop (i + 2) + have hpdecomp : p = l₁ ++ p[i] :: p[i + 1] :: l₂ := by + simp only [l₁, l₂] + calc + p = p.take i ++ p.drop i := (List.take_append_drop i p).symm + _ = p.take i ++ p[i] :: p.drop (i + 1) := by + rw [List.drop_eq_getElem_cons (by omega)] + _ = p.take i ++ p[i] :: p[i + 1] :: p.drop (i + 2) := by + rw [List.drop_eq_getElem_cons hi'] + refine ⟨p[i], p[i + 1], l₁, l₂, hpdecomp, ?_⟩ + have hieq' : s(p[i], p[i + 1]) = s(a, b) := by + simpa using hieq + exact (pair_eq_iff_sym2 a b p[i] p[i + 1]).mpr hieq'.symm + +private theorem boundary_pair_common (U : ProtoTile) (V : ProtoTile) (v : ↑(X U V)) (c : (G U + V).Walk v v) (hc : c.IsCycle) (T : ProtoTile) + (ht : SimpleGridCycle (BoundaryFootprintVertices T) + (BoundaryFootprintEdges T)) + (hsub : FootprintEdges U ∩ FootprintEdges V ⊆ + BoundaryFootprintEdges T) : + ∀ {a b : GaussianInt}, a ≠ b → + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T → + ({a, b} : Finset GaussianInt) ∈ FootprintEdges U ∩ FootprintEdges V := by + classical + let X := CommonFootprintEdgeVertices U V + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ + FootprintEdges U ∩ FootprintEdges V + have cycle_subcycle_eq {B : SimpleGraph GaussianInt} {u w : GaussianInt} + (outer : B.Walk u u) (inner : B.Walk w w) + (houter : outer.IsCycle) (hinner : inner.IsCycle) + (hle : inner.toSubgraph ≤ outer.toSubgraph) : + inner.toSubgraph = outer.toSubgraph := cycle_subcycle_eq (B := B) (u := u) (w := w) outer + inner houter hinner hle + let boundaryGraph (T : ProtoTile) : SimpleGraph GaussianInt := + SimpleGraph.fromRel fun a b => + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T + have boundary_cycle (T : ProtoTile) + (ht : SimpleGridCycle (BoundaryFootprintVertices T) + (BoundaryFootprintEdges T)) : + ∃ (z : GaussianInt) (d : (boundaryGraph T).Walk z z), d.IsCycle ∧ + ∀ {a b : GaussianInt}, a ≠ b → + (({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ + d.toSubgraph.Adj a b) := boundary_cycle T ht + obtain ⟨z, outer, houter, houtAdj⟩ := boundary_cycle T ht + let f : G →g boundaryGraph T := { + toFun := fun a => a.1 + map_rel' := by + intro a b hab + have hne : a.1 ≠ b.1 := by + intro h + apply hab.ne + exact Subtype.ext h + have hab' : ({a.1, b.1} : Finset GaussianInt) ∈ + FootprintEdges U ∩ FootprintEdges V := by + simp only [G, SimpleGraph.fromRel_adj] at hab + rcases hab.2 with hab | hab + · exact hab + · simpa [Finset.pair_comm] using hab + simp only [boundaryGraph, SimpleGraph.fromRel_adj] + exact ⟨hne, Or.inl (hsub hab')⟩ } + let inner := c.map f + have hinner : inner.IsCycle := hc.map Subtype.val_injective + have hadjle {a b : GaussianInt} + (hab : inner.toSubgraph.Adj a b) : outer.toSubgraph.Adj a b := by + have habB : (boundaryGraph T).Adj a b := inner.toSubgraph.adj_sub hab + have hne : a ≠ b := habB.ne + apply (houtAdj hne).mp + simp only [boundaryGraph, SimpleGraph.fromRel_adj] at habB + rcases habB.2 with habB | habB + · exact habB + · simpa [Finset.pair_comm] using habB + have hle : inner.toSubgraph ≤ outer.toSubgraph := by + refine ⟨?_, ?_⟩ + · intro a ha + have hncard := hinner.ncard_neighborSet_toSubgraph_eq_two + (inner.mem_verts_toSubgraph.mp ha) + have hn : inner.toSubgraph.neighborSet a |>.Nonempty := by + apply Set.nonempty_of_ncard_ne_zero + omega + obtain ⟨b, hb⟩ := hn + exact outer.toSubgraph.edge_vert (hadjle hb) + · intro a b hab + exact hadjle hab + have heq := cycle_subcycle_eq outer inner houter hinner hle + intro a b hab hboundary + have houterAdj : outer.toSubgraph.Adj a b := (houtAdj hab).mp hboundary + have hinnerAdj : inner.toSubgraph.Adj a b := heq ▸ houterAdj + change (c.map f).toSubgraph.Adj a b at hinnerAdj + rw [SimpleGraph.Walk.toSubgraph_map, SimpleGraph.Subgraph.map_adj] at hinnerAdj + rcases hinnerAdj with ⟨a', b', hab', ha', hb'⟩ + have hG : G.Adj a' b' := c.toSubgraph.adj_sub hab' + have hG' : ({a'.1, b'.1} : Finset GaussianInt) ∈ + FootprintEdges U ∩ FootprintEdges V := by + simp only [G, SimpleGraph.fromRel_adj] at hG + rcases hG.2 with hG | hG + · exact hG + · simpa [Finset.pair_comm] using hG + rw [← ha', ← hb'] + exact hG' + +private theorem hsubU (U : ProtoTile) (V : ProtoTile) (hedges : FootprintEdges U ∩ FootprintEdges + V = + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V) : FootprintEdges U ∩ FootprintEdges V ⊆ + BoundaryFootprintEdges U := by + classical + intro e he + have he' : e ∈ BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V := by + rw [← hedges] + exact he + exact he'.1 + +private theorem hsubV (U : ProtoTile) (V : ProtoTile) (hedges : FootprintEdges U ∩ FootprintEdges + V = + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V) : FootprintEdges U ∩ FootprintEdges V ⊆ + BoundaryFootprintEdges V := by + classical + intro e he + have he' : e ∈ BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V := by + rw [← hedges] + exact he + exact he'.2 + +private theorem vertical_boundary_iff (T : ProtoTile) (z : GaussianInt) : + ({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ + ((z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - 1 ∈ T.cells)) := by + classical + have vertical_unique (a b : GaussianInt) + (h : ({a, a + ⟨0, 1⟩} : Finset GaussianInt) = + {b, b + ⟨0, 1⟩}) : a = b := by + have ha : a ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← h] + simp + have ha1 : a + ⟨0, 1⟩ ∈ + ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← h] + simp + simp only [Finset.mem_insert, Finset.mem_singleton] at ha ha1 + rcases ha with hab | hab <;> rcases ha1 with ha1b | ha1b + · exact hab + · exact hab + · apply_fun Zsqrtd.im at hab ha1b + simp at hab ha1b + omega + · apply_fun Zsqrtd.im at hab ha1b + simp at hab ha1b + omega + have horizontal_vertical_ne (a b : GaussianInt) : + ({a, a + 1} : Finset GaussianInt) ≠ + {b, b + ⟨0, 1⟩} := by + intro h + have ha : a ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← h] + simp + have ha1 : a + 1 ∈ + ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← h] + simp + simp only [Finset.mem_insert, Finset.mem_singleton] at ha ha1 + rcases ha with hab | hab <;> rcases ha1 with ha1b | ha1b + all_goals + apply_fun Zsqrtd.re at hab ha1b + simp at hab ha1b + omega + constructor + · rintro ⟨a, (⟨ha, hocc⟩ | ⟨ha, hocc⟩)⟩ + · exact False.elim (horizontal_vertical_ne a z ha.symm) + · have haz := vertical_unique a z ha.symm + simpa [haz] using hocc + · intro h + exact ⟨z, Or.inr ⟨rfl, h⟩⟩ + +private theorem huOut (U : ProtoTile) (u : ApollonianSuperharmonic.LatticeCell) (huMax : ∀ x' ∈ + U.cells, x'.re ≤ u.re) : u + 1 ∉ U.cells := by + classical + intro hu1 + have := huMax (u + 1) hu1 + simp at this + +private theorem hvOut (V : ProtoTile) (v' : ApollonianSuperharmonic.LatticeCell) (hvMax : ∀ x' ∈ + V.cells, x'.re ≤ v'.re) : v' + 1 ∉ V.cells := by + classical + intro hv1 + have := hvMax (v' + 1) hv1 + simp at this + +private theorem huNotV (U : ProtoTile) (V : ProtoTile) (hdisjoint : Disjoint U.cells V.cells) (u + : ApollonianSuperharmonic.LatticeCell) (hu : u ∈ U.cells) : u ∉ V.cells := by + classical + exact Finset.disjoint_left.mp hdisjoint hu + +private theorem hvNotU (U : ProtoTile) (V : ProtoTile) (hdisjoint : Disjoint U.cells V.cells) (v' + : ApollonianSuperharmonic.LatticeCell) (hv' : v' ∈ V.cells) : v' ∉ U.cells := by + classical + exact Finset.disjoint_left.mp hdisjoint.symm hv' + +private theorem hUne (u : ApollonianSuperharmonic.LatticeCell) : u + 1 ≠ u + 1 + ⟨0, 1⟩ := by + classical + intro h + apply_fun Zsqrtd.im at h + simp at h + +private theorem hVne (v' : ApollonianSuperharmonic.LatticeCell) : v' + 1 ≠ v' + 1 + ⟨0, 1⟩ := by + classical + intro h + apply_fun Zsqrtd.im at h + simp at h + +private theorem hUright (U : ProtoTile) (u : ApollonianSuperharmonic.LatticeCell) (hu : u ∈ + U.cells) (huMax : ∀ x' ∈ U.cells, x'.re ≤ u.re) : ({u + 1, u + 1 + ⟨0, 1⟩} : Finset + GaussianInt) ∈ + BoundaryFootprintEdges U := by + classical + have vertical_boundary_iff (T : ProtoTile) (z : GaussianInt) : + ({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ + ((z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - 1 ∈ T.cells)) := vertical_boundary_iff T z + have huOut : u + 1 ∉ U.cells := huOut U u huMax + apply (vertical_boundary_iff U (u + 1)).mpr + right + simpa [Zsqrtd.ext_iff] using And.intro huOut hu + +private theorem hVright (V : ProtoTile) (v' : ApollonianSuperharmonic.LatticeCell) (hv' : v' ∈ + V.cells) (hvMax : ∀ x' ∈ V.cells, x'.re ≤ v'.re) : ({v' + 1, v' + 1 + ⟨0, 1⟩} : Finset + GaussianInt) ∈ + BoundaryFootprintEdges V := by + classical + have vertical_boundary_iff (T : ProtoTile) (z : GaussianInt) : + ({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ + ((z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - 1 ∈ T.cells)) := vertical_boundary_iff T z + have hvOut : v' + 1 ∉ V.cells := hvOut V v' hvMax + apply (vertical_boundary_iff V (v' + 1)).mpr + right + simpa [Zsqrtd.ext_iff] using And.intro hvOut hv' + +private theorem hUrightV (U : ProtoTile) (V : ProtoTile) (hUcycle : SimpleGridCycle + (BoundaryFootprintVertices U) + (BoundaryFootprintEdges U)) (hedges : FootprintEdges U ∩ FootprintEdges V = + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V) (v : ↑(X U V)) (u : + ApollonianSuperharmonic.LatticeCell) (c : (G U V).Walk v v) (hu : u ∈ U.cells) (huMax : + ∀ x' ∈ U.cells, x'.re ≤ u.re) (hc : c.IsCycle) : ({u + 1, u + 1 + ⟨0, 1⟩} : Finset + GaussianInt) ∈ + BoundaryFootprintEdges V := by + classical + have boundary_pair_common (T : ProtoTile) + (ht : SimpleGridCycle (BoundaryFootprintVertices T) + (BoundaryFootprintEdges T)) + (hsub : FootprintEdges U ∩ FootprintEdges V ⊆ + BoundaryFootprintEdges T) : + ∀ {a b : GaussianInt}, a ≠ b → + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T → + ({a, b} : Finset GaussianInt) ∈ FootprintEdges U ∩ FootprintEdges V := + boundary_pair_common U V v c hc T ht hsub + have hsubU : FootprintEdges U ∩ FootprintEdges V ⊆ + BoundaryFootprintEdges U := hsubU U V hedges + have hUne : u + 1 ≠ u + 1 + ⟨0, 1⟩ := hUne u + have hUright : ({u + 1, u + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges U := hUright U u hu huMax + have hUcommon := boundary_pair_common U hUcycle hsubU hUne hUright + have : ({u + 1, u + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V := by + rw [← hedges] + exact hUcommon + exact this.2 + +private theorem hVrightU (U : ProtoTile) (V : ProtoTile) (hVcycle : SimpleGridCycle + (BoundaryFootprintVertices V) + (BoundaryFootprintEdges V)) (hedges : FootprintEdges U ∩ FootprintEdges V = + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V) (v : ↑(X U V)) (v' : + ApollonianSuperharmonic.LatticeCell) (c : (G U V).Walk v v) (hv' : v' ∈ V.cells) (hvMax + : ∀ x' ∈ V.cells, x'.re ≤ v'.re) (hc : c.IsCycle) : ({v' + 1, v' + 1 + ⟨0, 1⟩} : Finset + GaussianInt) ∈ + BoundaryFootprintEdges U := by + classical + have boundary_pair_common (T : ProtoTile) + (ht : SimpleGridCycle (BoundaryFootprintVertices T) + (BoundaryFootprintEdges T)) + (hsub : FootprintEdges U ∩ FootprintEdges V ⊆ + BoundaryFootprintEdges T) : + ∀ {a b : GaussianInt}, a ≠ b → + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T → + ({a, b} : Finset GaussianInt) ∈ FootprintEdges U ∩ FootprintEdges V := + boundary_pair_common U V v c hc T ht hsub + have hsubV : FootprintEdges U ∩ FootprintEdges V ⊆ + BoundaryFootprintEdges V := hsubV U V hedges + have hVne : v' + 1 ≠ v' + 1 + ⟨0, 1⟩ := hVne v' + have hVright : ({v' + 1, v' + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges V := hVright V v' hv' hvMax + have hVcommon := boundary_pair_common V hVcycle hsubV hVne hVright + have : ({v' + 1, v' + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V := by + rw [← hedges] + exact hVcommon + exact this.1 + +private theorem hu1V (U : ProtoTile) (V : ProtoTile) (hdisjoint : Disjoint U.cells V.cells) + (hUcycle : SimpleGridCycle (BoundaryFootprintVertices U) + (BoundaryFootprintEdges U)) (hedges : FootprintEdges U ∩ FootprintEdges V = + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V) (v : ↑(X U V)) (u : + ApollonianSuperharmonic.LatticeCell) (c : (G U V).Walk v v) (hu : u ∈ U.cells) (huMax : + ∀ x' ∈ U.cells, x'.re ≤ u.re) (hc : c.IsCycle) : u + 1 ∈ V.cells := by + classical + have vertical_boundary_iff (T : ProtoTile) (z : GaussianInt) : + ({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ + ((z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - 1 ∈ T.cells)) := vertical_boundary_iff T z + have huNotV : u ∉ V.cells := huNotV U V hdisjoint u hu + have hUrightV : ({u + 1, u + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges V := hUrightV U V hUcycle hedges v u c hu huMax hc + rcases (vertical_boundary_iff V (u + 1)).mp hUrightV with h | h + · exact h.1 + · exfalso + apply huNotV + simpa [Zsqrtd.ext_iff] using h.2 + +private theorem hv1U (U : ProtoTile) (V : ProtoTile) (hdisjoint : Disjoint U.cells V.cells) + (hVcycle : SimpleGridCycle (BoundaryFootprintVertices V) + (BoundaryFootprintEdges V)) (hedges : FootprintEdges U ∩ FootprintEdges V = + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V) (v : ↑(X U V)) (v' : + ApollonianSuperharmonic.LatticeCell) (c : (G U V).Walk v v) (hv' : v' ∈ V.cells) (hvMax + : ∀ x' ∈ V.cells, x'.re ≤ v'.re) (hc : c.IsCycle) : v' + 1 ∈ U.cells := by + classical + have vertical_boundary_iff (T : ProtoTile) (z : GaussianInt) : + ({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ + ((z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - 1 ∈ T.cells)) := vertical_boundary_iff T z + have hvNotU : v' ∉ U.cells := hvNotU U V hdisjoint v' hv' + have hVrightU : ({v' + 1, v' + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges U := hVrightU U V hVcycle hedges v v' c hv' hvMax hc + rcases (vertical_boundary_iff U (v' + 1)).mp hVrightU with h | h + · exact h.1 + · exfalso + apply hvNotU + simpa [Zsqrtd.ext_iff] using h.2 + +end CommonBoundaryAcyclicityConstruction + +theorem DisjointBoundaryCommonEdgeGraphAcyclic (U V : ProtoTile) + (hdisjoint : Disjoint U.cells V.cells) + (hUcycle : SimpleGridCycle (BoundaryFootprintVertices U) + (BoundaryFootprintEdges U)) + (hVcycle : SimpleGridCycle (BoundaryFootprintVertices V) + (BoundaryFootprintEdges V)) + (hcommon : (FootprintEdges U ∩ FootprintEdges V).Nonempty) + (hedges : FootprintEdges U ∩ FootprintEdges V = + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V) : + let X := CommonFootprintEdgeVertices U V + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ + FootprintEdges U ∩ FootprintEdges V + G.IsAcyclic := by +-- BODY + classical + dsimp only + let X := CommonFootprintEdgeVertices U V + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ + FootprintEdges U ∩ FootprintEdges V + change G.IsAcyclic + intro v c hc + have cycle_subcycle_eq {B : SimpleGraph GaussianInt} {u w : GaussianInt} + (outer : B.Walk u u) (inner : B.Walk w w) + (houter : outer.IsCycle) (hinner : inner.IsCycle) + (hle : inner.toSubgraph ≤ outer.toSubgraph) : + inner.toSubgraph = outer.toSubgraph := + CommonBoundaryAcyclicityConstruction.cycle_subcycle_eq (B := B) (u := u) (w := w) outer + inner houter hinner hle + let boundaryGraph (T : ProtoTile) : SimpleGraph GaussianInt := + SimpleGraph.fromRel fun a b => + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T + have pair_eq_iff_sym2 (a b r s' : GaussianInt) : + ({a, b} : Finset GaussianInt) = {r, s'} ↔ s(a, b) = s(r, s') := + CommonBoundaryAcyclicityConstruction.pair_eq_iff_sym2 a b r s' + have boundary_cycle (T : ProtoTile) + (ht : SimpleGridCycle (BoundaryFootprintVertices T) + (BoundaryFootprintEdges T)) : + ∃ (z : GaussianInt) (d : (boundaryGraph T).Walk z z), d.IsCycle ∧ + ∀ {a b : GaussianInt}, a ≠ b → + (({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ + d.toSubgraph.Adj a b) := CommonBoundaryAcyclicityConstruction.boundary_cycle T ht + have boundary_pair_common (T : ProtoTile) + (ht : SimpleGridCycle (BoundaryFootprintVertices T) + (BoundaryFootprintEdges T)) + (hsub : FootprintEdges U ∩ FootprintEdges V ⊆ + BoundaryFootprintEdges T) : + ∀ {a b : GaussianInt}, a ≠ b → + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T → + ({a, b} : Finset GaussianInt) ∈ FootprintEdges U ∩ FootprintEdges V := + CommonBoundaryAcyclicityConstruction.boundary_pair_common U V v c hc T ht hsub + have hsubU : FootprintEdges U ∩ FootprintEdges V ⊆ + BoundaryFootprintEdges U := CommonBoundaryAcyclicityConstruction.hsubU U V hedges + have hsubV : FootprintEdges U ∩ FootprintEdges V ⊆ + BoundaryFootprintEdges V := CommonBoundaryAcyclicityConstruction.hsubV U V hedges + have vertical_boundary_iff (T : ProtoTile) (z : GaussianInt) : + ({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ + ((z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - 1 ∈ T.cells)) := + CommonBoundaryAcyclicityConstruction.vertical_boundary_iff T z + obtain ⟨e, heU, heV⟩ := hcommon + obtain ⟨u0, hu0, _⟩ := heU + obtain ⟨v0, hv0, _⟩ := heV + obtain ⟨u, hu, huMax⟩ := + U.cells.exists_max_image (fun q => q.re) ⟨u0, hu0⟩ + obtain ⟨v', hv', hvMax⟩ := + V.cells.exists_max_image (fun q => q.re) ⟨v0, hv0⟩ + have huOut : u + 1 ∉ U.cells := CommonBoundaryAcyclicityConstruction.huOut U u huMax + have hvOut : v' + 1 ∉ V.cells := CommonBoundaryAcyclicityConstruction.hvOut V v' hvMax + have huNotV : u ∉ V.cells := CommonBoundaryAcyclicityConstruction.huNotV U V hdisjoint u hu + have hvNotU : v' ∉ U.cells := CommonBoundaryAcyclicityConstruction.hvNotU U V hdisjoint v' hv' + have hUne : u + 1 ≠ u + 1 + ⟨0, 1⟩ := CommonBoundaryAcyclicityConstruction.hUne u + have hVne : v' + 1 ≠ v' + 1 + ⟨0, 1⟩ := CommonBoundaryAcyclicityConstruction.hVne v' + have hUright : ({u + 1, u + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges U := CommonBoundaryAcyclicityConstruction.hUright U u hu huMax + have hVright : ({v' + 1, v' + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges V := CommonBoundaryAcyclicityConstruction.hVright V v' hv' hvMax + have hUcommon := boundary_pair_common U hUcycle hsubU hUne hUright + have hVcommon := boundary_pair_common V hVcycle hsubV hVne hVright + have hUrightV : ({u + 1, u + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges V := CommonBoundaryAcyclicityConstruction.hUrightV U V hUcycle + hedges v u c hu huMax hc + have hVrightU : ({v' + 1, v' + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges U := CommonBoundaryAcyclicityConstruction.hVrightU U V hVcycle + hedges v v' c hv' hvMax hc + have hu1V : u + 1 ∈ V.cells := CommonBoundaryAcyclicityConstruction.hu1V U V hdisjoint hUcycle + hedges v u c hu huMax hc + have hv1U : v' + 1 ∈ U.cells := CommonBoundaryAcyclicityConstruction.hv1U U V hdisjoint hVcycle + hedges v v' c hv' hvMax hc + have huv := hvMax (u + 1) hu1V + have hvu := huMax (v' + 1) hv1U + simp at huv hvu + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DisjointSquareUnionCommonEdgeCarrier.lean b/LeanPool/ApollonianSuperharmonic/DisjointSquareUnionCommonEdgeCarrier.lean new file mode 100644 index 0000000000..8da7a9721d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DisjointSquareUnionCommonEdgeCarrier.lean @@ -0,0 +1,292 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.GridEdgeCarrier +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: DisjointSquareUnionCommonEdgeCarrier] + +/-! +# DisjointSquareUnionCommonEdgeCarrier + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SquareUnionCommonCarrierConstruction + +private noncomputable abbrev I : GaussianInt := by + classical + exact ⟨0, 1⟩ + +private theorem footprint_finite (T : ProtoTile) : (FootprintEdges T).Finite := by + classical + let I : GaussianInt := ⟨0, 1⟩ + let edge : T.cells × (Bool × Bool) → Finset GaussianInt := fun q => + match q.2 with + | (false, false) => {q.1.1, q.1.1 + 1} + | (false, true) => {q.1.1, q.1.1 + I} + | (true, false) => {q.1.1 + 1, q.1.1 + 1 + I} + | (true, true) => {q.1.1 + I, q.1.1 + 1 + I} + apply (Set.finite_range edge).subset + rintro e ⟨c, hc, h | h | h | h⟩ + · exact ⟨(⟨c, hc⟩, false, false), by simpa [edge] using h.symm⟩ + · exact ⟨(⟨c, hc⟩, false, true), by simpa [edge, I] using h.symm⟩ + · exact ⟨(⟨c, hc⟩, true, false), by simpa [edge, I] using h.symm⟩ + · exact ⟨(⟨c, hc⟩, true, true), by simpa [edge, I] using h.symm⟩ + +private theorem edge_endpoint_square (c : LatticeCell) (e : Finset GaussianInt) + (he : e = {c, c + 1} ∨ e = {c, c + I} ∨ + e = {c + 1, c + 1 + I} ∨ e = {c + I, c + 1 + I}) + (z : GaussianInt) (hz : z ∈ e) : + GaussianRealPoint z ∈ ClosedSquareRealization c := by + classical + let I : GaussianInt := ⟨0, 1⟩ + rcases he with rfl | rfl | rfl | rfl + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hz + all_goals rcases hz with rfl | rfl + all_goals simp [GaussianRealPoint, ClosedSquareRealization, Prod.le_def] + +private theorem edge_carrier_subset (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges T) : GridEdgeCarrier e ⊆ TileRealization T := by + classical + let I : GaussianInt := ⟨0, 1⟩ + have edge_endpoint_square (c : LatticeCell) (e : Finset GaussianInt) + (he : e = {c, c + 1} ∨ e = {c, c + I} ∨ + e = {c + 1, c + 1 + I} ∨ e = {c + I, c + 1 + I}) + (z : GaussianInt) (hz : z ∈ e) : + GaussianRealPoint z ∈ ClosedSquareRealization c := edge_endpoint_square c e he z hz + rintro p hp + rcases he with ⟨c, hc, he⟩ + rw [TileRealization] + refine Set.mem_iUnion.2 ⟨c, Set.mem_iUnion.2 ⟨hc, ?_⟩⟩ + unfold GridEdgeCarrier at hp + rcases Set.mem_iUnion.1 hp with ⟨x, hp⟩ + rcases Set.mem_iUnion.1 hp with ⟨hx, hp⟩ + rcases Set.mem_iUnion.1 hp with ⟨y, hp⟩ + rcases Set.mem_iUnion.1 hp with ⟨hy, hp⟩ + have hxSq := edge_endpoint_square c e he x hx + have hySq := edge_endpoint_square c e he y hy + change GaussianRealPoint x ⊓ GaussianRealPoint y ≤ p ∧ + p ≤ GaussianRealPoint x ⊔ GaussianRealPoint y at hp + change (((c.re : Int) : Real), ((c.im : Int) : Real)) ≤ p ∧ + p ≤ ((((c.re : Int) : Real) + 1), (((c.im : Int) : Real) + 1)) + exact ⟨le_trans (le_inf hxSq.1 hySq.1) hp.1, + le_trans hp.2 (sup_le hxSq.2 hySq.2)⟩ + +end SquareUnionCommonCarrierConstruction + +theorem DisjointSquareUnionCommonEdgeCarrier (U V : ProtoTile) + (hdisjoint : Disjoint U.cells V.cells) + (hvertices : FootprintVertices U ∩ FootprintVertices V = + CommonFootprintEdgeVertices U V) : + (FootprintEdges U ∩ FootprintEdges V).Finite ∧ + TileRealization U ∩ TileRealization V = + ⋃ e ∈ FootprintEdges U ∩ FootprintEdges V, GridEdgeCarrier e := by +-- BODY + classical + let I : GaussianInt := ⟨0, 1⟩ + have footprint_finite (T : ProtoTile) : (FootprintEdges T).Finite := + SquareUnionCommonCarrierConstruction.footprint_finite T + have edge_endpoint_square (c : LatticeCell) (e : Finset GaussianInt) + (he : e = {c, c + 1} ∨ e = {c, c + I} ∨ + e = {c + 1, c + 1 + I} ∨ e = {c + I, c + 1 + I}) + (z : GaussianInt) (hz : z ∈ e) : + GaussianRealPoint z ∈ ClosedSquareRealization c := + SquareUnionCommonCarrierConstruction.edge_endpoint_square c e he z hz + have edge_carrier_subset (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges T) : GridEdgeCarrier e ⊆ TileRealization T := + SquareUnionCommonCarrierConstruction.edge_carrier_subset T e he + have carrier_of_endpoints (p : Real × Real) (e : Finset GaussianInt) + (x y : GaussianInt) (hx : x ∈ e) (hy : y ∈ e) + (hp : p ∈ Set.uIcc (GaussianRealPoint x) (GaussianRealPoint y)) : + p ∈ GridEdgeCarrier e := by + unfold GridEdgeCarrier + exact Set.mem_iUnion.2 ⟨x, Set.mem_iUnion.2 ⟨hx, + Set.mem_iUnion.2 ⟨y, Set.mem_iUnion.2 ⟨hy, hp⟩⟩⟩⟩ + refine ⟨(footprint_finite U).inter_of_left (FootprintEdges V), ?_⟩ + apply Set.Subset.antisymm + · rintro p ⟨hpU, hpV⟩ + simp only [TileRealization, Set.mem_iUnion] at hpU hpV + rcases hpU with ⟨c, hc, hpc⟩ + rcases hpV with ⟨d, hd, hpd⟩ + have hcd : c ≠ d := fun h => + (Finset.disjoint_left.mp hdisjoint) hc (h ▸ hd) + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpc hpd + have hrlo : (-1 : ℝ) ≤ (c.re : ℝ) - d.re := by + linarith [hpc.1.1, hpd.1.2] + have hrhi : (c.re : ℝ) - d.re ≤ 1 := by + linarith [hpc.1.2, hpd.1.1] + have hilo : (-1 : ℝ) ≤ (c.im : ℝ) - d.im := by + linarith [hpc.2.1, hpd.2.2] + have hihi : (c.im : ℝ) - d.im ≤ 1 := by + linarith [hpc.2.2, hpd.2.1] + have rlo : (-1 : ℤ) ≤ c.re - d.re := by exact_mod_cast hrlo + have rhi : c.re - d.re ≤ (1 : ℤ) := by exact_mod_cast hrhi + have ilo : (-1 : ℤ) ≤ c.im - d.im := by exact_mod_cast hilo + have ihi : c.im - d.im ≤ (1 : ℤ) := by exact_mod_cast hihi + have rd : c.re - d.re = -1 ∨ c.re - d.re = 0 ∨ c.re - d.re = 1 := by + omega + have id : c.im - d.im = -1 ∨ c.im - d.im = 0 ∨ c.im - d.im = 1 := by + omega + have corner_case (z : GaussianInt) (hzU : z ∈ FootprintVertices U) + (hzV : z ∈ FootprintVertices V) (hpz : p = GaussianRealPoint z) : + p ∈ ⋃ e ∈ FootprintEdges U ∩ FootprintEdges V, GridEdgeCarrier e := by + have hz : z ∈ CommonFootprintEdgeVertices U V := by + rw [← hvertices] + exact ⟨hzU, hzV⟩ + rcases hz with ⟨e, he, hze⟩ + refine Set.mem_iUnion.2 ⟨e, Set.mem_iUnion.2 ⟨he, ?_⟩⟩ + apply carrier_of_endpoints p e z z hze hze + rw [hpz] + exact Set.mem_uIcc_of_le le_rfl le_rfl + rcases rd with hr | hr | hr <;> rcases id with hi | hi | hi + · have hdrel : d = c + 1 + I := by + apply Zsqrtd.ext <;> simp [I] <;> omega + subst d + have hpz : p = GaussianRealPoint (c + 1 + I) := by + apply Prod.ext <;> simp only [GaussianRealPoint] + · norm_num [I] at hpc hpd ⊢ + linarith + · norm_num [I] at hpc hpd ⊢ + linarith + apply corner_case (c + 1 + I) + · unfold FootprintVertices + rw [ite_eq_left ⟨c, hc⟩] + exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + · unfold FootprintVertices + rw [ite_eq_left ⟨c + 1 + I, hd⟩] + exact ⟨c + 1 + I, hd, Or.inl rfl⟩ + · exact hpz + · have hdrel : d = c + 1 := by + apply Zsqrtd.ext <;> simp [] <;> omega + subst d + let e : Finset GaussianInt := {c + 1, c + 1 + I} + have heU : e ∈ FootprintEdges U := by + exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + have heV : e ∈ FootprintEdges V := by + exact ⟨c + 1, hd, Or.inr (Or.inl rfl)⟩ + refine Set.mem_iUnion.2 ⟨e, Set.mem_iUnion.2 ⟨⟨heU, heV⟩, ?_⟩⟩ + apply carrier_of_endpoints p e (c + 1) (c + 1 + I) (by simp [e]) (by simp [e]) + simp only [Set.uIcc, Set.mem_Icc, GaussianRealPoint, Prod.le_def] + norm_num [I] at hpc hpd ⊢ + constructor <;> constructor <;> linarith + · have hdrel : d = c + 1 - I := by + apply Zsqrtd.ext <;> simp [I] <;> omega + subst d + have hpz : p = GaussianRealPoint (c + 1) := by + apply Prod.ext <;> simp only [GaussianRealPoint] + · norm_num [I] at hpc hpd ⊢ + linarith + · norm_num [I] at hpc hpd ⊢ + linarith + apply corner_case (c + 1) + · unfold FootprintVertices + rw [ite_eq_left ⟨c, hc⟩] + exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ + · unfold FootprintVertices + rw [ite_eq_left ⟨c + 1 - I, hd⟩] + refine ⟨c + 1 - I, hd, Or.inr (Or.inr (Or.inl ?_))⟩ + simp [I] + · exact hpz + · have hdrel : d = c + I := by + apply Zsqrtd.ext <;> simp [I] <;> omega + subst d + let e : Finset GaussianInt := {c + I, c + 1 + I} + have heU : e ∈ FootprintEdges U := by + exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + have heV : e ∈ FootprintEdges V := by + refine ⟨c + I, hd, Or.inl ?_⟩ + simp [e, I, add_comm, add_left_comm, add_assoc] + refine Set.mem_iUnion.2 ⟨e, Set.mem_iUnion.2 ⟨⟨heU, heV⟩, ?_⟩⟩ + apply carrier_of_endpoints p e (c + I) (c + 1 + I) (by simp [e]) (by simp [e]) + simp only [Set.uIcc, Set.mem_Icc, GaussianRealPoint, Prod.le_def] + norm_num [I] at hpc hpd ⊢ + constructor <;> constructor <;> linarith + · exfalso + apply hcd + exact Zsqrtd.ext (by omega) (by omega) + · have hdrel : d = c - I := by + apply Zsqrtd.ext <;> simp [I] <;> omega + subst d + let e : Finset GaussianInt := {c, c + 1} + have heU : e ∈ FootprintEdges U := ⟨c, hc, Or.inl rfl⟩ + have heV : e ∈ FootprintEdges V := by + refine ⟨c - I, hd, Or.inr (Or.inr (Or.inr ?_))⟩ + simp [e, I, add_comm, add_left_comm] + refine Set.mem_iUnion.2 ⟨e, Set.mem_iUnion.2 ⟨⟨heU, heV⟩, ?_⟩⟩ + apply carrier_of_endpoints p e c (c + 1) (by simp [e]) (by simp [e]) + simp only [Set.uIcc, Set.mem_Icc, GaussianRealPoint, Prod.le_def] + norm_num [I] at hpc hpd ⊢ + constructor <;> constructor <;> linarith + · have hdrel : d = c - 1 + I := by + apply Zsqrtd.ext <;> simp [I] <;> omega + subst d + have hpz : p = GaussianRealPoint (c + I) := by + apply Prod.ext <;> simp only [GaussianRealPoint] + · norm_num [I] at hpc hpd ⊢ + linarith + · norm_num [I] at hpc hpd ⊢ + linarith + apply corner_case (c + I) + · unfold FootprintVertices + rw [ite_eq_left ⟨c, hc⟩] + exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · unfold FootprintVertices + rw [ite_eq_left ⟨c - 1 + I, hd⟩] + refine ⟨c - 1 + I, hd, Or.inr (Or.inl ?_)⟩ + simp [I, Zsqrtd.ext_iff] + · exact hpz + · have hdrel : d = c - 1 := by + apply Zsqrtd.ext <;> simp [] <;> omega + subst d + let e : Finset GaussianInt := {c, c + I} + have heU : e ∈ FootprintEdges U := ⟨c, hc, Or.inr (Or.inl rfl)⟩ + have heV : e ∈ FootprintEdges V := by + refine ⟨c - 1, hd, Or.inr (Or.inr (Or.inl ?_))⟩ + simp [e, I] + refine Set.mem_iUnion.2 ⟨e, Set.mem_iUnion.2 ⟨⟨heU, heV⟩, ?_⟩⟩ + apply carrier_of_endpoints p e c (c + I) (by simp [e]) (by simp [e]) + simp only [Set.uIcc, Set.mem_Icc, GaussianRealPoint, Prod.le_def] + norm_num [I] at hpc hpd ⊢ + constructor <;> constructor <;> linarith + · have hdrel : d = c - 1 - I := by + apply Zsqrtd.ext <;> simp [I] <;> omega + subst d + have hpz : p = GaussianRealPoint c := by + apply Prod.ext <;> simp only [GaussianRealPoint] + · norm_num [I] at hpc hpd ⊢ + linarith + · norm_num [I] at hpc hpd ⊢ + linarith + apply corner_case c + · unfold FootprintVertices + rw [ite_eq_left ⟨c, hc⟩] + exact ⟨c, hc, Or.inl rfl⟩ + · unfold FootprintVertices + rw [ite_eq_left ⟨c - 1 - I, hd⟩] + refine ⟨c - 1 - I, hd, Or.inr (Or.inr (Or.inr ?_))⟩ + simp [I, Zsqrtd.ext_iff] + · exact hpz + · rintro p hp + rcases Set.mem_iUnion.1 hp with ⟨e, hp⟩ + rcases Set.mem_iUnion.1 hp with ⟨he, hp⟩ + exact ⟨edge_carrier_subset U e he.1 hp, + edge_carrier_subset V e he.2 hp⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/EuclideanCircleData.lean b/LeanPool/ApollonianSuperharmonic/EuclideanCircleData.lean new file mode 100644 index 0000000000..844b41bb6e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/EuclideanCircleData.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Analysis.Complex.Basic +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: EuclideanCircleData] + +/-! +# EuclideanCircleData + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A Euclidean circle datum is a pair $E=(z,r)$ consisting of a center +$z\in\mathbb C$ and a strictly positive radius $r\in\mathbb R$. Its open +disk is $\{x:|x-z| simp [I, Zsqrtd.ext_iff] + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + have edge_vertex_footprint (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges T) (z : GaussianInt) (hz : z ∈ e) : + z ∈ FootprintVertices T := by + rcases he with ⟨c, hc, he⟩ + unfold FootprintVertices + rw [ite_eq_left ⟨c, hc⟩] + rcases he with h | h | h | h <;> subst e + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hz + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ + · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + have boundary_vertex_footprint (T : ProtoTile) (hne : T.cells.Nonempty) + (z : GaussianInt) (hz : z ∈ BoundaryFootprintVertices T) : + z ∈ FootprintVertices T := by + unfold BoundaryFootprintVertices at hz + rw [ite_eq_left hne] at hz + rcases hz with ⟨e, he, hze⟩ + exact edge_vertex_footprint T e (boundary_edge_footprint T e he) z hze + have boundary_vertex_of_edge (T : ProtoTile) (hne : T.cells.Nonempty) + (e : Finset GaussianInt) (he : e ∈ BoundaryFootprintEdges T) + (z : GaussianInt) (hze : z ∈ e) : + z ∈ BoundaryFootprintVertices T := by + unfold BoundaryFootprintVertices + rw [ite_eq_left hne] + exact ⟨e, he, hze⟩ + have rawAB : SimpleGridPath + (FootprintVertices A ∩ FootprintVertices B) + (FootprintEdges A ∩ FootprintEdges B) := + between_to_path _ _ _ _ E.pathAB + have rawBC : SimpleGridPath + (FootprintVertices B ∩ FootprintVertices C) + (FootprintEdges B ∩ FootprintEdges C) := + between_to_path _ _ _ _ E.pathBC + have rawCA : SimpleGridPath + (FootprintVertices C ∩ FootprintVertices A) + (FootprintEdges C ∩ FootprintEdges A) := + between_to_path _ _ _ _ E.pathCA + have edgesAB := CellDisjointCommonEdgesBoundary A B hAB + have edgesBC := CellDisjointCommonEdgesBoundary B C hBC + have edgesCA := CellDisjointCommonEdgesBoundary C A hCA + have verticesAB : FootprintVertices A ∩ FootprintVertices B = + BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B := by + apply Set.Subset.antisymm + · intro z hz + rcases SimpleGridPathVertexIncidentEdge _ _ rawAB z hz with ⟨e, hze, he⟩ + have he' : e ∈ BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B := + edgesAB ▸ he + exact ⟨boundary_vertex_of_edge A hneA e he'.1 z hze, + boundary_vertex_of_edge B hneB e he'.2 z hze⟩ + · rintro z ⟨hzA, hzB⟩ + exact ⟨boundary_vertex_footprint A hneA z hzA, + boundary_vertex_footprint B hneB z hzB⟩ + have verticesBC : FootprintVertices B ∩ FootprintVertices C = + BoundaryFootprintVertices B ∩ BoundaryFootprintVertices C := by + apply Set.Subset.antisymm + · intro z hz + rcases SimpleGridPathVertexIncidentEdge _ _ rawBC z hz with ⟨e, hze, he⟩ + have he' : e ∈ BoundaryFootprintEdges B ∩ BoundaryFootprintEdges C := + edgesBC ▸ he + exact ⟨boundary_vertex_of_edge B hneB e he'.1 z hze, + boundary_vertex_of_edge C hneC e he'.2 z hze⟩ + · rintro z ⟨hzB, hzC⟩ + exact ⟨boundary_vertex_footprint B hneB z hzB, + boundary_vertex_footprint C hneC z hzC⟩ + have verticesCA : FootprintVertices C ∩ FootprintVertices A = + BoundaryFootprintVertices C ∩ BoundaryFootprintVertices A := by + apply Set.Subset.antisymm + · intro z hz + rcases SimpleGridPathVertexIncidentEdge _ _ rawCA z hz with ⟨e, hze, he⟩ + have he' : e ∈ BoundaryFootprintEdges C ∩ BoundaryFootprintEdges A := + edgesCA ▸ he + exact ⟨boundary_vertex_of_edge C hneC e he'.1 z hze, + boundary_vertex_of_edge A hneA e he'.2 z hze⟩ + · rintro z ⟨hzC, hzA⟩ + exact ⟨boundary_vertex_footprint C hneC z hzC, + boundary_vertex_footprint A hneA z hzA⟩ + have pathAB : SimpleGridPath + (BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B) + (BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B) := by + rw [← verticesAB, ← edgesAB] + exact rawAB + have pathBC : SimpleGridPath + (BoundaryFootprintVertices B ∩ BoundaryFootprintVertices C) + (BoundaryFootprintEdges B ∩ BoundaryFootprintEdges C) := by + rw [← verticesBC, ← edgesBC] + exact rawBC + have pathCA : SimpleGridPath + (BoundaryFootprintVertices C ∩ BoundaryFootprintVertices A) + (BoundaryFootprintEdges C ∩ BoundaryFootprintEdges A) := by + rw [← verticesCA, ← edgesCA] + exact rawCA + unfold TouchingTriple + refine ⟨Or.inl ⟨hneA, hneB, hAB, pathAB⟩, + Or.inl ⟨hneB, hneC, hBC, pathBC⟩, + Or.inl ⟨hneC, hneA, hCA, pathCA⟩, E.point, ?_, ?_⟩ + · have hp := (E.unique_common E.point).mpr rfl + have hpAB : E.point ∈ BoundaryFootprintVertices A ∩ + BoundaryFootprintVertices B := verticesAB ▸ hp.1 + have hpBC : E.point ∈ BoundaryFootprintVertices B ∩ + BoundaryFootprintVertices C := verticesBC ▸ ⟨hp.1.2, hp.2⟩ + exact ⟨hpAB.1, hpAB.2, hpBC.2⟩ + · intro z hz + apply (E.unique_common z).mp + have hzAB : z ∈ FootprintVertices A ∩ FootprintVertices B := + verticesAB.symm ▸ ⟨hz.1, hz.2.1⟩ + have hzBC : z ∈ FootprintVertices B ∩ FootprintVertices C := + verticesBC.symm ▸ ⟨hz.2.1, hz.2.2⟩ + exact ⟨hzAB, hzBC.2⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTriplePackingSymmetryCovariance.lean b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTriplePackingSymmetryCovariance.lean new file mode 100644 index 0000000000..c5d3291250 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTriplePackingSymmetryCovariance.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport +public import LeanPool.ApollonianSuperharmonic.P4055T1PackingGridEquivalence +public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage + +-- [TABLET NODE: ExactTileInterfaceTriplePackingSymmetryCovariance] + +/-! +# ExactTileInterfaceTriplePackingSymmetryCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem ExactTileInterfaceTriplePackingSymmetryCovariance + (g : BandPackingSymmetry) (A B C : ProtoTile) : + Nonempty (ExactTileInterfaceTriple A B C) ↔ + Nonempty (ExactTileInterfaceTriple + (BandPackingSymmetryTileAction g A) + (BandPackingSymmetryTileAction g B) + (BandPackingSymmetryTileAction g C)) := by +-- BODY + obtain ⟨f, hf, hs, hi⟩ := P4055T1PackingGridEquivalence g + have hfun : (f : GaussianInt → GaussianInt) = BandPackingSymmetryVectorAction g := + funext hf + have hv (T : ProtoTile) : + FootprintVertices (BandPackingSymmetryTileAction g T) = f '' FootprintVertices T := by + simpa only [hfun] using (BandPackingSymmetryTilingTransport g).2.2.2.2.2.2.2.1 T + have he (T : ProtoTile) : + FootprintEdges (BandPackingSymmetryTileAction g T) = + (fun e : Finset GaussianInt => e.image f) '' FootprintEdges T := by + simpa only [hfun] using (BandPackingSymmetryTilingTransport g).2.2.2.2.2.2.2.2.1 T + have hiv (T : ProtoTile) : + FootprintVertices T = f.symm '' FootprintVertices (BandPackingSymmetryTileAction g T) := by + rw [hv] + simp [Set.image_image] + have hie (T : ProtoTile) : + FootprintEdges T = (fun e : Finset GaussianInt => e.image f.symm) '' + FootprintEdges (BandPackingSymmetryTileAction g T) := by + rw [he] + simp [Set.image_image, Finset.image_image] + constructor + · rintro ⟨d⟩ + obtain ⟨d', _⟩ := P4055T1ExactTripleImage f f.injective hs + A B C _ _ _ (hv A) (hv B) (hv C) (he A) (he B) (he C) d + exact ⟨d'⟩ + · rintro ⟨d⟩ + obtain ⟨d', _⟩ := P4055T1ExactTripleImage f.symm f.symm.injective hi + _ _ _ A B C (hiv A) (hiv B) (hiv C) (hie A) (hie B) (hie C) d + exact ⟨d'⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleRetargetMiddle.lean b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleRetargetMiddle.lean new file mode 100644 index 0000000000..75df31bec5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleRetargetMiddle.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality + +-- [TABLET NODE: ExactTileInterfaceTripleRetargetMiddle] + +/-! +# ExactTileInterfaceTripleRetargetMiddle + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem ExactTileInterfaceTripleRetargetMiddle + (A B B' C : ProtoTile) + (hcells : B.cells = B'.cells) + (hanchor : B.cells = ∅ → B.anchor = B'.anchor) + (E : ExactTileInterfaceTriple A B C) : + ∃ E' : ExactTileInterfaceTriple A B' C, + E'.point = E.point ∧ E'.otherAB = E.otherAB ∧ + E'.otherBC = E.otherBC ∧ E'.otherCA = E.otherCA := by +-- BODY + have hobs := ProtoTileObservableExtensionality B B' hcells hanchor + have hedges : FootprintEdges B = FootprintEdges B' := by + simp only [FootprintEdges] + rw [hcells] + let E' : ExactTileInterfaceTriple A B' C := + { point := E.point + otherAB := E.otherAB + otherBC := E.otherBC + otherCA := E.otherCA + pathAB := by simpa [hobs.1, hedges] using E.pathAB + pathBC := by simpa [hobs.1, hedges] using E.pathBC + pathCA := E.pathCA + unique_common := by + intro y + simpa [hobs.1] using E.unique_common y } + exact ⟨E', rfl, rfl, rfl, rfl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleSwapLast.lean b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleSwapLast.lean new file mode 100644 index 0000000000..3c9683b7c6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleSwapLast.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple + +-- [TABLET NODE: ExactTileInterfaceTripleSwapLast] + +/-! +# ExactTileInterfaceTripleSwapLast + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem ExactTileInterfaceTripleSwapLast (A B C : ProtoTile) + (E : ExactTileInterfaceTriple A B C) : + ∃ E' : ExactTileInterfaceTriple A C B, + E'.point = E.point ∧ E'.otherAB = E.otherCA ∧ + E'.otherBC = E.otherBC ∧ E'.otherCA = E.otherAB := by +-- BODY + let E' : ExactTileInterfaceTriple A C B := + { point := E.point + otherAB := E.otherCA + otherBC := E.otherBC + otherCA := E.otherAB + pathAB := by simpa [Set.inter_comm] using E.pathCA + pathBC := by simpa [Set.inter_comm] using E.pathBC + pathCA := by simpa [Set.inter_comm] using E.pathAB + unique_common := by + intro y + simpa [Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using + E.unique_common y } + exact ⟨E', rfl, rfl, rfl, rfl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ExactTileTiling.lean b/LeanPool/ApollonianSuperharmonic/ExactTileTiling.lean new file mode 100644 index 0000000000..da7b08a654 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ExactTileTiling.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeTile + +-- [TABLET NODE: ExactTileTiling] + +/-! +# ExactTileTiling + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A collection $\mathcal T$ is an exact tiling of the lattice cells when every +member is a topological-disk lattice tile and every cell $s_x$ belongs to +exactly one member of $\mathcal T$. Tile boundaries may intersect, but two +members may not share a cell. +-/ +def ExactTileTiling (F : Set ProtoTile) : Prop := +-- BODY + (∀ T ∈ F, LatticeTile T) ∧ + ∀ x : LatticeCell, ∃ T ∈ F, x ∈ T.cells ∧ + ∀ U ∈ F, x ∈ U.cells → U = T + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ExceptionalConnectorSegments.lean b/LeanPool/ApollonianSuperharmonic/ExceptionalConnectorSegments.lean new file mode 100644 index 0000000000..ab4e00f0ec --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ExceptionalConnectorSegments.lean @@ -0,0 +1,140 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData +public import LeanPool.ApollonianSuperharmonic.TileCellComplement + +-- [TABLET NODE: ExceptionalConnectorSegments] + +/-! +# ExceptionalConnectorSegments + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $O\subseteq A\cap B$. Let $Q_2,Q_3$ be labelled child occurrences +contained in $A$, and let $S_3,S_2$ be their respectively labelled child +partners contained in $B$. Thus $(Q_2,S_3)$ is the first labelled child +pair and $(Q_3,S_2)$ is the second. For selected interface points $p_1,p_2$, +an *exceptional connector segmentation* consists of attachment vertices +$a,b$ and three oriented simple vertex lists +$$ + p_1\xrightarrow{\ Q_2\text{--}S_3\ }a,\qquad + a\xrightarrow{\ (A\setminus O)\text{--}O\ }b,\qquad + b\xrightarrow{\ Q_3\text{--}S_2\ }p_2. +$$ +Every vertex of each list belongs to the displayed pair of footprints and +every consecutive edge has an actual supporting cell in both displayed +prototiles. Their ordered walk is obtained by concatenating the left list, +the tail of the middle list, and the tail of the right list; every vertex +and edge of this walk is also retained in the common footprint of +$A\setminus O$ and $B$. The point $a$ +is the unique common boundary vertex of $Q_2,S_3,O$, and $b$ is the unique +common boundary vertex of $Q_3,S_2,O$; these are therefore the two uniquely +labelled cuts in the ordered walk. When $O$ is empty they coincide at its +anchor. + +The data also retain a loop-erasure as a sublist of this ordered walk. This connector +has no repeated vertices, has endpoints $p_1,p_2$, lies in +$\operatorname{foot}(A\setminus O)\cap\operatorname{foot}(B)$ with actual common-footprint edge +support, +and every retained vertex occurs in the ordered walk. Thus loop erasure +does not replace or forget the three segmented paths. Its vertices retain +the corresponding three-piece support union, and the data retain two +distinct common vertices of the modified $A$ and $B$ footprints independently +of whether the selected connector is constant. +-/ +structure ExceptionalConnectorSegments + (A B O Q2 S3 Q3 S2 : ProtoTile) (p1 p2 : GaussianInt) where +-- BODY + precursor_in_left : O.cells ⊆ A.cells + precursor_in_right : O.cells ⊆ B.cells + first_left_child : Q2.cells ⊆ A.cells + first_right_child : S3.cells ⊆ B.cells + second_left_child : Q3.cells ⊆ A.cells + second_right_child : S2.cells ⊆ B.cells + /-- The first attachment of the precursor to the labelled child interfaces. -/ + a : GaussianInt + /-- The second attachment of the precursor to the labelled child interfaces. -/ + b : GaussianInt + /-- The simple path from the first selected point to the first attachment. -/ + left : List GaussianInt + /-- The simple precursor-boundary path between the two attachments. -/ + middle : List GaussianInt + /-- The simple path from the second attachment to the second selected point. -/ + right : List GaussianInt + /-- The ordered concatenation of the three retained path segments. -/ + walk : List GaussianInt + /-- A loop erasure of the segmented walk with the same selected endpoints. -/ + connector : List GaussianInt + left_nodup : left.Nodup + middle_nodup : middle.Nodup + right_nodup : right.Nodup + left_head : left.head? = some p1 + left_last : left.getLast? = some a + middle_head : middle.head? = some a + middle_last : middle.getLast? = some b + right_head : right.head? = some b + right_last : right.getLast? = some p2 + walk_order : walk = left ++ middle.tail ++ right.tail + walk_raw : ∀ x ∈ walk, + x ∈ FootprintVertices (TileCellComplement A O) ∩ FootprintVertices B + walk_edges : ∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + walk = l1 ++ x :: y :: l2 → + {x, y} ∈ FootprintEdges (TileCellComplement A O) ∩ FootprintEdges B + left_vertices : ∀ x ∈ left, + x ∈ FootprintVertices Q2 ∩ FootprintVertices S3 + middle_vertices : ∀ x ∈ middle, + x ∈ FootprintVertices (TileCellComplement A O) ∩ FootprintVertices O + right_vertices : ∀ x ∈ right, + x ∈ FootprintVertices Q3 ∩ FootprintVertices S2 + left_edges : ∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + left = l1 ++ x :: y :: l2 → + {x, y} ∈ FootprintEdges Q2 ∩ FootprintEdges S3 + middle_edges : ∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + middle = l1 ++ x :: y :: l2 → + {x, y} ∈ FootprintEdges (TileCellComplement A O) ∩ FootprintEdges O + right_edges : ∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + right = l1 ++ x :: y :: l2 → + {x, y} ∈ FootprintEdges Q3 ∩ FootprintEdges S2 + first_cut_unique : ∀ x : GaussianInt, + x ∈ BoundaryFootprintVertices Q2 ∧ + x ∈ BoundaryFootprintVertices S3 ∧ + x ∈ BoundaryFootprintVertices O ↔ x = a + second_cut_unique : ∀ x : GaussianInt, + x ∈ BoundaryFootprintVertices Q3 ∧ + x ∈ BoundaryFootprintVertices S2 ∧ + x ∈ BoundaryFootprintVertices O ↔ x = b + empty_cut : O.cells = ∅ → a = b ∧ a = O.anchor + connector_nodup : connector.Nodup + connector_head : connector.head? = some p1 + connector_last : connector.getLast? = some p2 + connector_raw : ∀ x ∈ connector, + x ∈ FootprintVertices (TileCellComplement A O) ∩ FootprintVertices B + connector_edges : ∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + connector = l1 ++ x :: y :: l2 → + {x, y} ∈ FootprintEdges (TileCellComplement A O) ∩ FootprintEdges B + connector_from_walk : connector.Sublist walk + connector_support : ∀ x ∈ connector, + x ∈ (FootprintVertices Q2 ∩ FootprintVertices S3) ∪ + FootprintVertices O ∪ + (FootprintVertices Q3 ∩ FootprintVertices S2) + common_vertices : ∃ x y : GaussianInt, x ≠ y ∧ + x ∈ FootprintVertices (TileCellComplement A O) ∩ FootprintVertices B ∧ + y ∈ FootprintVertices (TileCellComplement A O) ∩ FootprintVertices B + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean b/LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean new file mode 100644 index 0000000000..b78fbe18a8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean @@ -0,0 +1,488 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments +public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.P3161T2PathSubwalk +public import Mathlib.Data.List.Chain + +-- [TABLET NODE: ExceptionalModifiedABPath] + +/-! +# ExceptionalModifiedABPath + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ExceptionalConnectorProof + +private theorem boundary_edge : + ∀ (U : ProtoTile), ∀ e ∈ BoundaryFootprintEdges U, e ∈ FootprintEdges U := by + classical + intro U e he + let I : GaussianInt := ⟨0, 1⟩ + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [I, Zsqrtd.ext_iff] + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + +private theorem edge_vertex : + ∀ (U : ProtoTile), ∀ e ∈ FootprintEdges U, ∀ x ∈ e, x ∈ FootprintVertices U := by + classical + intro U e he x hx + rcases he with ⟨c, hc, he⟩ + simp only [FootprintVertices, ite_eq_left (show U.cells.Nonempty from ⟨c, hc⟩), + Set.mem_ofPred_eq] + rcases he with h | h | h | h <;> subst e + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hx + · rcases hx with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ + · rcases hx with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · rcases hx with rfl | rfl + · exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ + · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + · rcases hx with rfl | rfl + · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + +private theorem incident : + ∀ (U : ProtoTile), ∀ (x : GaussianInt), Finset.Nonempty U.cells → x ∈ FootprintVertices U → ∃ + (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ U.cells := by + classical + intro U x hne hx + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hx + rcases hx with ⟨c, hc, h | h | h | h⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using h ▸ hc⟩ + · subst x + exact ⟨1, by simpa [LatticeVertexIncidentCell] using hc⟩ + · subst x + exact ⟨3, by simpa [LatticeVertexIncidentCell] using hc⟩ + · refine ⟨2, ?_⟩ + change x - 1 - ⟨0, 1⟩ ∈ U.cells + rw [h] + convert hc using 1; ext <;> simp + +private theorem nonempty_touching : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), Finset.Nonempty U.cells → Finset.Nonempty V.cells → + TileTouching U V → Disjoint U.cells V.cells ∧ SimpleGridPath (BoundaryFootprintVertices U + ∩ BoundaryFootprintVertices V) (BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V) := by + classical + intro U V hU hV ht + rcases ht with h | h | h + · exact ⟨h.2.2.1, h.2.2.2⟩ + · rw [h.1] at hU + simp at hU + · rw [h.1] at hV + simp at hV + +private theorem common_boundary : + (∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ FootprintVertices U) → (∃ + j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells))) → (∀ (U : ProtoTile), ∀ (V : + ProtoTile), Finset.Nonempty U.cells → Finset.Nonempty V.cells → Disjoint U.cells V.cells + → ∀ x ∈ FootprintVertices U ∩ FootprintVertices V, x ∈ BoundaryFootprintVertices U ∩ + BoundaryFootprintVertices V) := by + classical + intro incident U V hU hV hd x hx + obtain ⟨i, hi⟩ := incident U x hU hx.1 + obtain ⟨j, hj⟩ := incident V x hV hx.2 + exact ⟨P3161T2IncidentBoundary U x ⟨i, hi⟩ + ⟨j, fun h => Finset.disjoint_left.mp hd h hj⟩, + P3161T2IncidentBoundary V x ⟨j, hj⟩ + ⟨i, fun h => Finset.disjoint_left.mp hd hi h⟩⟩ + +private theorem erase_loops : + ∀ (R : GaussianInt → GaussianInt → Prop), ∀ (w : List GaussianInt), List.IsChain R w → ∃ (c : + List GaussianInt), c.Nodup ∧ c.head? = w.head? ∧ c.getLast? = w.getLast? ∧ c.Sublist w ∧ + List.IsChain R c := by + classical + intro R w + induction w with + | nil => exact fun _ => ⟨[], by simp⟩ + | cons a w ih => + intro hw + cases w with + | nil => exact ⟨[a], by simp⟩ + | cons b w => + obtain ⟨c, hc, hh, ht, hs, hchain⟩ := ih hw.tail + cases c with + | nil => simp at hh + | cons d c => + have hdb : d = b := by simpa using hh + subst d + by_cases ha : a ∈ b :: c + · obtain ⟨l, r, heq⟩ := List.append_of_mem ha + have hsub : (a :: r).Sublist (b :: c) := by + rw [heq] + exact List.sublist_append_right _ _ + refine ⟨a :: r, hc.sublist hsub, rfl, ?_, + (hsub.trans hs).cons a, ?_⟩ + · rw [List.getLast?_cons_cons, ← ht, heq, List.getLast?_append_cons] + · rw [heq] at hchain + exact hchain.right_of_append + · refine ⟨a :: b :: c, List.nodup_cons.mpr ⟨ha, hc⟩, rfl, ?_, + hs.cons_cons a, ?_⟩ + · simpa only [List.getLast?_cons_cons] using ht + · exact List.isChain_cons_cons.mpr + ⟨(List.isChain_cons_cons.mp hw).1, hchain⟩ + +private theorem child_piece : + (∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges U) → (e ∈ + FootprintEdges U)) → ((∀ (U : ProtoTile), ∀ (x : GaussianInt), (x ∈ + BoundaryFootprintVertices U) → (x ∈ FootprintVertices U)) → ((∀ (U : ProtoTile), ∀ (V : + ProtoTile), (U.cells.Nonempty) → ((V.cells.Nonempty) → ((TileTouching U V) → (Disjoint + U.cells V.cells ∧ SimpleGridPath (BoundaryFootprintVertices U ∩ BoundaryFootprintVertices + V) (BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V))))) → ((∀ (U : ProtoTile), ∀ (V + : ProtoTile), (U.cells.Nonempty) → ((V.cells.Nonempty) → ((Disjoint U.cells V.cells) + → (∀ (x : GaussianInt), (x ∈ FootprintVertices U ∩ FootprintVertices V) → (x ∈ + BoundaryFootprintVertices U ∩ BoundaryFootprintVertices V))))) → ((∀ (R : GaussianInt → + GaussianInt → Prop), ∀ w : List GaussianInt, w.IsChain R → ∃ c : List GaussianInt, + c.Nodup ∧ c.head? = w.head? ∧ c.getLast? = w.getLast? ∧ c.Sublist w ∧ c.IsChain R) → (∀ + (U : ProtoTile), ∀ (V : ProtoTile), Finset.Nonempty U.cells → Finset.Nonempty V.cells → + TileTouching U V → ∀ (x : GaussianInt), ∀ (y : GaussianInt), x ∈ FootprintVertices U ∩ + FootprintVertices V → y ∈ BoundaryFootprintVertices U ∩ BoundaryFootprintVertices V → ∃ + (w : List GaussianInt), w.Nodup ∧ w.head? = some x ∧ w.getLast? = some y ∧ (∀ z ∈ w, z ∈ + FootprintVertices U ∩ FootprintVertices V) ∧ List.IsChain (fun (a b : GaussianInt) => {a, + b} ∈ FootprintEdges U ∩ FootprintEdges V) w))))) := by + classical + intro boundary_edge boundary_vertex nonempty_touching common_boundary erase_loops U V hU hV ht + x y hx hy + obtain ⟨hd, hp⟩ := nonempty_touching U V hU hV ht + obtain ⟨w, hh, hl, hv, he⟩ := P3161T2PathSubwalk hp x y + (common_boundary U V hU hV hd x hx) hy + have hchain : w.IsChain + (fun a b => {a, b} ∈ FootprintEdges U ∩ FootprintEdges V) := by + apply List.isChain_iff_forall_rel_of_append_cons_cons.mpr + intro a b l r h + exact ⟨boundary_edge U _ (he a b l r h).1, + boundary_edge V _ (he a b l r h).2⟩ + obtain ⟨c, hc, hch, hcl, hsub, hce⟩ := erase_loops _ w hchain + refine ⟨c, hc, hch.trans hh, hcl.trans hl, ?_, hce⟩ + intro z hz + exact ⟨boundary_vertex U z (hv z (hsub.subset hz)).1, + boundary_vertex V z (hv z (hsub.subset hz)).2⟩ + +private theorem middle_piece : + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (O : ProtoTile), ∀ (O' : ProtoTile), ∀ (Q2 : + ProtoTile), ∀ (S3 : ProtoTile), ∀ (Q3 : ProtoTile), ∀ (S2 : ProtoTile), (O.cells ⊆ + B.cells) → ((S3.cells ⊆ B.cells) → ((Finset.Nonempty Q2.cells) → ((Finset.Nonempty + S3.cells) → (∀ (arcs : PrecursorBoundaryArcData (TileCellComplement A O) + (TileCellComplement B O) O O' Q2 S3 Q3 S2), + let D := TileCellComplement A O + (∀ (U : ProtoTile), ∀ (V : ProtoTile), (U.cells.Nonempty) → ((U.cells ⊆ V.cells) → + (FootprintVertices U ⊆ FootprintVertices V))) → ((∀ (U : ProtoTile), ∀ (e : Finset + GaussianInt), (e ∈ BoundaryFootprintEdges U) → (e ∈ FootprintEdges U)) → ((∀ (U : + ProtoTile), ∀ (x : GaussianInt), (x ∈ BoundaryFootprintVertices U) → (x ∈ + FootprintVertices U)) → ((arcs.a ∈ BoundaryFootprintVertices Q2 ∧ arcs.a ∈ + BoundaryFootprintVertices S3 ∧ arcs.a ∈ BoundaryFootprintVertices O) → (∃ middle : List + GaussianInt, middle.Nodup ∧ middle.head? = some arcs.a ∧ middle.getLast? = some arcs.b ∧ + (∀ z ∈ middle, z ∈ FootprintVertices D ∩ FootprintVertices O) ∧ middle.IsChain (fun x y + => {x, y} ∈ FootprintEdges D ∩ FootprintEdges O) ∧ (∀ z ∈ middle, z ∈ FootprintVertices + B))))))))) := by + classical + intro A B O O' Q2 S3 Q3 S2 hOb hS3 hQ2ne hS3ne arcs D vertices_mono boundary_edge + boundary_vertex hfirst + rcases arcs.branch with ⟨hOne, plus, minus, hpn, _, hph, hpl, _, _, hpv, + _, hpe, _⟩ | ⟨hO, hab, ha, _⟩ + · have hpfoot : ∀ z ∈ plus, + z ∈ FootprintVertices D ∩ FootprintVertices O := by + intro z hz + have hz' : z ∈ BoundaryFootprintVertices D ∩ BoundaryFootprintVertices O := by + rw [← hpv] + simpa using hz + exact ⟨boundary_vertex D z hz'.1, boundary_vertex O z hz'.2⟩ + refine ⟨plus, hpn, hph, hpl, hpfoot, ?_, ?_⟩ + · apply List.isChain_iff_forall_rel_of_append_cons_cons.mpr + intro x y l r h + exact ⟨boundary_edge D _ (hpe x y l r h).1, + boundary_edge O _ (hpe x y l r h).2⟩ + · intro z hz + exact vertices_mono O B hOne hOb (hpfoot z hz).2 + · refine ⟨[arcs.a], by simp, rfl, ?_, ?_, List.isChain_singleton _, ?_⟩ + · simpa using congrArg some hab + · intro z hz + have hza : z = arcs.a := by simpa using hz + subst z + refine ⟨vertices_mono Q2 D hQ2ne arcs.first_plus_child + (boundary_vertex Q2 arcs.a hfirst.1), ?_⟩ + simp [FootprintVertices, hO, ha] + · intro z hz + have hza : z = arcs.a := by simpa using hz + subst z + exact vertices_mono S3 B hS3ne hS3 + (boundary_vertex S3 arcs.a hfirst.2.1) + +private theorem splice : + ∀ (R : GaussianInt → GaussianInt → Prop), ∀ (u : List GaussianInt), ∀ (v : List GaussianInt), + ∀ (z : GaussianInt), u.getLast? = some z → v.head? = some z → List.IsChain R u → + List.IsChain R v → List.IsChain R (u ++ v.tail) ∧ (u ++ v.tail).head? = u.head? ∧ (u ++ + v.tail).getLast? = v.getLast? := by + classical + intro R u v z hu hv cu cv + have hune : u ≠ [] := by intro h; simp [h] at hu + cases v with + | nil => simp at hv + | cons a v => + have haz : a = z := by simpa using hv + subst a + refine ⟨cu.append cv.tail ?_, ?_, ?_⟩ + · intro x hx y hy + have hxz : x = z := by simpa [hu, eq_comm] using hx + subst x + exact cv.rel_head? hy + · exact List.head?_append_of_ne_nil u hune + · cases v with + | nil => simpa using hu + | cons b v => + simp only [List.tail_cons, List.getLast?_append_cons, + List.getLast?_cons_cons] + +end ExceptionalConnectorProof + +theorem ExceptionalModifiedABPath : + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (O : ProtoTile), ∀ (O' : ProtoTile), ∀ (Q2 : + ProtoTile), ∀ (S3 : ProtoTile), ∀ (Q3 : ProtoTile), ∀ (S2 : ProtoTile), ∀ (p1 : + GaussianInt), ∀ (p2 : GaussianInt), (O.cells ⊆ A.cells) → ((O.cells ⊆ B.cells) → + ((Q2.cells ⊆ A.cells) → ((S3.cells ⊆ B.cells) → ((Q3.cells ⊆ A.cells) → ((S2.cells ⊆ + B.cells) → ((Q2.cells.Nonempty) → ((S3.cells.Nonempty) → ((Q3.cells.Nonempty) → + ((S2.cells.Nonempty) → ((TouchingTriple Q2 S3 O) → ((TouchingTriple Q3 S2 O) → ((p1 ∈ + FootprintVertices Q2 ∩ FootprintVertices S3) → ((p2 ∈ FootprintVertices Q3 ∩ + FootprintVertices S2) → ((TileTouching (TileCellComplement A O) O) → ((TileTouching + (TileCellComplement B O) O) → ((CentrallyReflectedAt (TileCentroid O) + (TileCellComplement A O) (TileCellComplement B O)) → ((QuarterTurnSymmetric O) → ((∀ x ∈ + FootprintVertices O, ∀ a : GaussianInt, + x ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) -> + a ∈ A.cells ∨ a ∈ B.cells) → ((Nonempty (PrecursorBoundaryArcData + (TileCellComplement A O) (TileCellComplement B O) O O' + Q2 S3 Q3 S2)) → ((∃ x y : GaussianInt, x ≠ y ∧ + x ∈ FootprintVertices (TileCellComplement A O) ∩ FootprintVertices B ∧ + y ∈ FootprintVertices (TileCellComplement A O) ∩ FootprintVertices B) → (Nonempty + (ExceptionalConnectorSegments A B O Q2 S3 Q3 S2 p1 p2)))))))))))))))))))))) := by + intro A B O O' Q2 S3 Q3 S2 p1 p2 hOa hOb hQ2 hS3 hQ3 hS2 hQ2ne hS3ne hQ3ne hS2ne + hprecursorFirst hprecursorLast hp1 hp2 hcomplement hcomplementB hcentral hOsym hisolated + harcs hcommonVertices +-- BODY + classical + obtain ⟨arcs⟩ := harcs + let D := TileCellComplement A O + have edges_mono (U V : ProtoTile) (h : U.cells ⊆ V.cells) : + FootprintEdges U ⊆ FootprintEdges V := by + rintro e ⟨c, hc, he⟩ + exact ⟨c, h hc, he⟩ + have vertices_mono (U V : ProtoTile) (hne : U.cells.Nonempty) + (h : U.cells ⊆ V.cells) : FootprintVertices U ⊆ FootprintVertices V := by + have hVne : V.cells.Nonempty := hne.mono h + simp only [FootprintVertices, ite_eq_left hne, ite_eq_left hVne] + rintro x ⟨c, hc, hx⟩ + exact ⟨c, h hc, hx⟩ + have boundary_edge (U : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges U) : e ∈ FootprintEdges U := + ExceptionalConnectorProof.boundary_edge U e he + have edge_vertex (U : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges U) (x : GaussianInt) (hx : x ∈ e) : + x ∈ FootprintVertices U := ExceptionalConnectorProof.edge_vertex U e he x hx + have boundary_vertex (U : ProtoTile) (x : GaussianInt) + (hx : x ∈ BoundaryFootprintVertices U) : x ∈ FootprintVertices U := by + by_cases hne : U.cells.Nonempty + · simp only [BoundaryFootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hx + obtain ⟨e, he, hx⟩ := hx + exact edge_vertex U e (boundary_edge U e he) x hx + · simpa only [BoundaryFootprintVertices, FootprintVertices, ite_eq_right hne] using hx + have incident (U : ProtoTile) (x : GaussianInt) + (hne : U.cells.Nonempty) (hx : x ∈ FootprintVertices U) : + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells := ExceptionalConnectorProof.incident + U x hne hx + have nonempty_touching (U V : ProtoTile) + (hU : U.cells.Nonempty) (hV : V.cells.Nonempty) (ht : TileTouching U V) : + Disjoint U.cells V.cells ∧ + SimpleGridPath (BoundaryFootprintVertices U ∩ BoundaryFootprintVertices V) + (BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V) := + ExceptionalConnectorProof.nonempty_touching U V hU hV ht + have common_boundary (U V : ProtoTile) + (hU : U.cells.Nonempty) (hV : V.cells.Nonempty) + (hd : Disjoint U.cells V.cells) (x : GaussianInt) + (hx : x ∈ FootprintVertices U ∩ FootprintVertices V) : + x ∈ BoundaryFootprintVertices U ∩ BoundaryFootprintVertices V := + ExceptionalConnectorProof.common_boundary incident U V hU hV hd x hx + -- Erasing a loop keeps a suffix beginning at the repeated vertex. + have erase_loops (R : GaussianInt → GaussianInt → Prop) : + ∀ w : List GaussianInt, w.IsChain R → + ∃ c : List GaussianInt, c.Nodup ∧ c.head? = w.head? ∧ + c.getLast? = w.getLast? ∧ c.Sublist w ∧ c.IsChain R := + ExceptionalConnectorProof.erase_loops R + have child_piece (U V : ProtoTile) + (hU : U.cells.Nonempty) (hV : V.cells.Nonempty) (ht : TileTouching U V) + (x y : GaussianInt) (hx : x ∈ FootprintVertices U ∩ FootprintVertices V) + (hy : y ∈ BoundaryFootprintVertices U ∩ BoundaryFootprintVertices V) : + ∃ w : List GaussianInt, w.Nodup ∧ w.head? = some x ∧ + w.getLast? = some y ∧ + (∀ z ∈ w, z ∈ FootprintVertices U ∩ FootprintVertices V) ∧ + w.IsChain (fun a b => {a, b} ∈ FootprintEdges U ∩ FootprintEdges V) := + ExceptionalConnectorProof.child_piece boundary_edge boundary_vertex nonempty_touching + common_boundary erase_loops U V hU hV ht x y hx hy + have hfirst := (arcs.first_transition arcs.a).mpr rfl + have hsecond := (arcs.second_transition arcs.b).mpr rfl + obtain ⟨left, hln, hlh, hll, hlv, hle⟩ := + child_piece Q2 S3 hQ2ne hS3ne hprecursorFirst.1 p1 arcs.a hp1 + ⟨hfirst.1, hfirst.2.1⟩ + obtain ⟨revRight, hrn, hrh, hrl, hrv, hre⟩ := + child_piece Q3 S2 hQ3ne hS2ne hprecursorLast.1 p2 arcs.b hp2 + ⟨hsecond.1, hsecond.2.1⟩ + let right := revRight.reverse + have hrightn : right.Nodup := List.nodup_reverse.mpr hrn + have hrighth : right.head? = some arcs.b := by simpa [right] using hrl + have hrightl : right.getLast? = some p2 := by simpa [right] using hrh + have hrightv : ∀ z ∈ right, + z ∈ FootprintVertices Q3 ∩ FootprintVertices S2 := by + intro z hz + exact hrv z (by simpa [right] using hz) + have hrighte : right.IsChain + (fun x y => {x, y} ∈ FootprintEdges Q3 ∩ FootprintEdges S2) := by + apply List.isChain_reverse.mpr + exact hre.imp (fun x y h => by simpa only [Finset.pair_comm] using h) + have hleftRaw : ∀ z ∈ left, z ∈ FootprintVertices D ∩ FootprintVertices B := by + intro z hz + exact ⟨vertices_mono Q2 D hQ2ne arcs.first_plus_child (hlv z hz).1, + vertices_mono S3 B hS3ne hS3 (hlv z hz).2⟩ + have hrightRaw : ∀ z ∈ right, z ∈ FootprintVertices D ∩ FootprintVertices B := by + intro z hz + exact ⟨vertices_mono Q3 D hQ3ne arcs.second_plus_child (hrightv z hz).1, + vertices_mono S2 B hS2ne hS2 (hrightv z hz).2⟩ + have hleftEdges : left.IsChain + (fun x y => {x, y} ∈ FootprintEdges D ∩ FootprintEdges B) := + hle.imp (fun _ _ h => ⟨edges_mono Q2 D arcs.first_plus_child h.1, + edges_mono S3 B hS3 h.2⟩) + have hrightEdges : right.IsChain + (fun x y => {x, y} ∈ FootprintEdges D ∩ FootprintEdges B) := + hrighte.imp (fun _ _ h => ⟨edges_mono Q3 D arcs.second_plus_child h.1, + edges_mono S2 B hS2 h.2⟩) + have hempty : O.cells = ∅ → arcs.a = arcs.b ∧ arcs.a = O.anchor := by + intro hO + rcases arcs.branch with ⟨hne, _⟩ | ⟨_, hab, ha, _⟩ + · rw [hO] at hne + simp at hne + · exact ⟨hab, ha⟩ + -- The empty branch contributes only its exact anchor, never an edge. + have middle_piece : ∃ middle : List GaussianInt, + middle.Nodup ∧ middle.head? = some arcs.a ∧ + middle.getLast? = some arcs.b ∧ + (∀ z ∈ middle, z ∈ FootprintVertices D ∩ FootprintVertices O) ∧ + middle.IsChain (fun x y => {x, y} ∈ FootprintEdges D ∩ FootprintEdges O) ∧ + (∀ z ∈ middle, z ∈ FootprintVertices B) := ExceptionalConnectorProof.middle_piece A B O O' + Q2 S3 Q3 S2 hOb hS3 hQ2ne hS3ne arcs vertices_mono boundary_edge boundary_vertex hfirst + obtain ⟨middle, hmn, hmh, hml, hmv, hme, hmb⟩ := middle_piece + have hmiddleRaw : ∀ z ∈ middle, + z ∈ FootprintVertices D ∩ FootprintVertices B := + fun z hz => ⟨(hmv z hz).1, hmb z hz⟩ + have hmiddleEdges : middle.IsChain + (fun x y => {x, y} ∈ FootprintEdges D ∩ FootprintEdges B) := + hme.imp (fun _ _ h => ⟨h.1, edges_mono O B hOb h.2⟩) + have splice (R : GaussianInt → GaussianInt → Prop) + (u v : List GaussianInt) (z : GaussianInt) + (hu : u.getLast? = some z) (hv : v.head? = some z) + (cu : u.IsChain R) (cv : v.IsChain R) : + (u ++ v.tail).IsChain R ∧ (u ++ v.tail).head? = u.head? ∧ + (u ++ v.tail).getLast? = v.getLast? := ExceptionalConnectorProof.splice R u v z hu hv cu cv + obtain ⟨hlmc, hlmh, hlml⟩ := splice _ left middle arcs.a hll hmh + hleftEdges hmiddleEdges + obtain ⟨hwc, hwh, hwl⟩ := splice _ (left ++ middle.tail) right arcs.b + (hlml.trans hml) hrighth hlmc hrightEdges + let walk := left ++ middle.tail ++ right.tail + have hwalkHead : walk.head? = some p1 := hwh.trans (hlmh.trans hlh) + have hwalkLast : walk.getLast? = some p2 := hwl.trans hrightl + have hwalkRaw : ∀ z ∈ walk, z ∈ FootprintVertices D ∩ FootprintVertices B := by + intro z hz + rcases List.mem_append.mp hz with hz | hz + · rcases List.mem_append.mp hz with hz | hz + · exact hleftRaw z hz + · exact hmiddleRaw z (List.mem_of_mem_tail hz) + · exact hrightRaw z (List.mem_of_mem_tail hz) + have hwalkSupport : ∀ z ∈ walk, + z ∈ (FootprintVertices Q2 ∩ FootprintVertices S3) ∪ FootprintVertices O ∪ + (FootprintVertices Q3 ∩ FootprintVertices S2) := by + intro z hz + rcases List.mem_append.mp hz with hz | hz + · rcases List.mem_append.mp hz with hz | hz + · exact Or.inl (Or.inl (hlv z hz)) + · exact Or.inl (Or.inr (hmv z (List.mem_of_mem_tail hz)).2) + · exact Or.inr (hrightv z (List.mem_of_mem_tail hz)) + obtain ⟨connector, hcn, hch, hcl, hcs, hce⟩ := erase_loops _ walk hwc + exact ⟨{ + precursor_in_left := hOa + precursor_in_right := hOb + first_left_child := hQ2 + first_right_child := hS3 + second_left_child := hQ3 + second_right_child := hS2 + a := arcs.a + b := arcs.b + left := left + middle := middle + right := right + walk := walk + connector := connector + left_nodup := hln + middle_nodup := hmn + right_nodup := hrightn + left_head := hlh + left_last := hll + middle_head := hmh + middle_last := hml + right_head := hrighth + right_last := hrightl + walk_order := rfl + walk_raw := hwalkRaw + walk_edges := fun _ _ _ _ h => + List.isChain_iff_forall_rel_of_append_cons_cons.mp hwc h + left_vertices := hlv + middle_vertices := hmv + right_vertices := hrightv + left_edges := fun _ _ _ _ h => + List.isChain_iff_forall_rel_of_append_cons_cons.mp hle h + middle_edges := fun _ _ _ _ h => + List.isChain_iff_forall_rel_of_append_cons_cons.mp hme h + right_edges := fun _ _ _ _ h => + List.isChain_iff_forall_rel_of_append_cons_cons.mp hrighte h + first_cut_unique := arcs.first_transition + second_cut_unique := arcs.second_transition + empty_cut := hempty + connector_nodup := hcn + connector_head := hch.trans hwalkHead + connector_last := hcl.trans hwalkLast + connector_raw := fun z hz => hwalkRaw z (hcs.subset hz) + connector_edges := fun _ _ _ _ h => + List.isChain_iff_forall_rel_of_append_cons_cons.mp hce h + connector_from_walk := hcs + connector_support := fun z hz => hwalkSupport z (hcs.subset hz) + common_vertices := hcommonVertices }⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ExceptionalRestorationSectorData.lean b/LeanPool/ApollonianSuperharmonic/ExceptionalRestorationSectorData.lean new file mode 100644 index 0000000000..b6a523f458 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ExceptionalRestorationSectorData.lean @@ -0,0 +1,165 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.TileCellComplement + +-- [TABLET NODE: ExceptionalRestorationSectorData] + +/-! +# ExceptionalRestorationSectorData + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $O\subseteq A\cap B$, let $(Q_2,S_3)$ and $(Q_3,S_2)$ be the two +labelled child pairs, let $C,D$ be their respective primary companions, +and let $p_1,p_2$ and +$\mathcal E$ be an `ExceptionalConnectorSegments` certificate. +An *exceptional restoration-sector certificate* consists of the +following incident-cell assertions, with +$\operatorname{inc}$ as in `LatticeVertexIncidentCell`. + +At every vertex $x$ of the oriented left segment satisfying +$O.\mathrm{cells}\ne\varnothing$ or $x\ne a$, the following assertions +hold. If neither a $C$-cell nor an $O$-cell occurs at $x$, there is a +sector $j$ owned by $Q_2$ whose opposite sector $j+2$ is owned by $S_3$. +Every incident cell is owned by $Q_2$ or $S_3$, except that a $C$-cell may +occur only at $p_1$ and an $O$-cell may occur only at $a$; moreover, an +incident $C$-cell occurs at $x$ if and only if $x=p_1$. A $C$-cell does +occur at $p_1$ unconditionally. +Among the three owners $Q_2,S_3,C$, some two own opposite sectors at +$p_1$. When $O$ has a cell, an incident $O$-cell occurs on this segment +exactly at the cut $a$, and among $Q_2,S_3,O$ some two own opposite +sectors there. The analogous guarded assertions hold on the right segment, +with guard $O.\mathrm{cells}\ne\varnothing$ or $x\ne b$, literal ordered +pair $(Q_3,S_2)$, companion $D$, marked endpoint +$p_2$, and cut $b$. + +If $O$ has a cell, then $a\ne p_1$ and $b\ne p_2$; no incident +$C$-cell occurs at $a$, no incident $D$-cell occurs at $b$, and an +incident $O$-cell occurs at each cut. If $O$ has no cells, then +$a=b=\operatorname{anchor}(O)$. + +Finally, every proper internal vertex $x$ of the middle segment lies on +the common boundary of $A\setminus O$ and $B$. After restoring $O$ to +$A$, all four cells incident with $x$ belong to $A$. Consequently $x$ is +not on the common original boundary of $A$ and $B$. +-/ +structure ExceptionalRestorationSectorData + (A B O Q2 S3 Q3 S2 C D : ProtoTile) + (p1 p2 : GaussianInt) + (segments : ExceptionalConnectorSegments A B O Q2 S3 Q3 S2 p1 p2) where +-- BODY + left_opposite : ∀ x ∈ segments.left, + O.cells.Nonempty ∨ x ≠ segments.a → + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∉ C.cells) → + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∉ O.cells) → + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ Q2.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ S3.cells + right_opposite : ∀ x ∈ segments.right, + O.cells.Nonempty ∨ x ≠ segments.b → + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∉ D.cells) → + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∉ O.cells) → + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ Q3.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ S2.cells + left_owners : ∀ x ∈ segments.left, + O.cells.Nonempty ∨ x ≠ segments.a → ∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ Q2.cells ∨ + LatticeVertexIncidentCell x j ∈ S3.cells ∨ + (x = p1 ∧ LatticeVertexIncidentCell x j ∈ C.cells) ∨ + (x = segments.a ∧ LatticeVertexIncidentCell x j ∈ O.cells) + right_owners : ∀ x ∈ segments.right, + O.cells.Nonempty ∨ x ≠ segments.b → ∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ Q3.cells ∨ + LatticeVertexIncidentCell x j ∈ S2.cells ∨ + (x = p2 ∧ LatticeVertexIncidentCell x j ∈ D.cells) ∨ + (x = segments.b ∧ LatticeVertexIncidentCell x j ∈ O.cells) + left_companion : ∀ x ∈ segments.left, + O.cells.Nonempty ∨ x ≠ segments.a → + ((∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ C.cells) ↔ x = p1) + right_companion : ∀ x ∈ segments.right, + O.cells.Nonempty ∨ x ≠ segments.b → + ((∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ D.cells) ↔ x = p2) + positive_left_precursor : O.cells.Nonempty → ∀ x ∈ segments.left, + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ O.cells) ↔ + x = segments.a + positive_right_precursor : O.cells.Nonempty → ∀ x ∈ segments.right, + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ O.cells) ↔ + x = segments.b + positive_cut_separation : O.cells.Nonempty → + segments.a ≠ p1 ∧ segments.b ≠ p2 + positive_first_cut_no_companion : O.cells.Nonempty → ∀ j : Fin 4, + LatticeVertexIncidentCell segments.a j ∉ C.cells + positive_second_cut_no_companion : O.cells.Nonempty → ∀ j : Fin 4, + LatticeVertexIncidentCell segments.b j ∉ D.cells + first_marked_companion : + ∃ j : Fin 4, LatticeVertexIncidentCell p1 j ∈ C.cells + second_marked_companion : + ∃ j : Fin 4, LatticeVertexIncidentCell p2 j ∈ D.cells + first_marked_opposite : + (∃ j : Fin 4, LatticeVertexIncidentCell p1 j ∈ Q2.cells ∧ + LatticeVertexIncidentCell p1 (j + 2) ∈ S3.cells) ∨ + (∃ j : Fin 4, LatticeVertexIncidentCell p1 j ∈ Q2.cells ∧ + LatticeVertexIncidentCell p1 (j + 2) ∈ C.cells) ∨ + (∃ j : Fin 4, LatticeVertexIncidentCell p1 j ∈ S3.cells ∧ + LatticeVertexIncidentCell p1 (j + 2) ∈ C.cells) + second_marked_opposite : + (∃ j : Fin 4, LatticeVertexIncidentCell p2 j ∈ Q3.cells ∧ + LatticeVertexIncidentCell p2 (j + 2) ∈ S2.cells) ∨ + (∃ j : Fin 4, LatticeVertexIncidentCell p2 j ∈ Q3.cells ∧ + LatticeVertexIncidentCell p2 (j + 2) ∈ D.cells) ∨ + (∃ j : Fin 4, LatticeVertexIncidentCell p2 j ∈ S2.cells ∧ + LatticeVertexIncidentCell p2 (j + 2) ∈ D.cells) + positive_first_cut_precursor : O.cells.Nonempty → + ∃ j : Fin 4, LatticeVertexIncidentCell segments.a j ∈ O.cells + positive_second_cut_precursor : O.cells.Nonempty → + ∃ j : Fin 4, LatticeVertexIncidentCell segments.b j ∈ O.cells + positive_first_cut_opposite : O.cells.Nonempty → + (∃ j : Fin 4, + LatticeVertexIncidentCell segments.a j ∈ Q2.cells ∧ + LatticeVertexIncidentCell segments.a (j + 2) ∈ S3.cells) ∨ + (∃ j : Fin 4, + LatticeVertexIncidentCell segments.a j ∈ Q2.cells ∧ + LatticeVertexIncidentCell segments.a (j + 2) ∈ O.cells) ∨ + (∃ j : Fin 4, + LatticeVertexIncidentCell segments.a j ∈ S3.cells ∧ + LatticeVertexIncidentCell segments.a (j + 2) ∈ O.cells) + positive_second_cut_opposite : O.cells.Nonempty → + (∃ j : Fin 4, + LatticeVertexIncidentCell segments.b j ∈ Q3.cells ∧ + LatticeVertexIncidentCell segments.b (j + 2) ∈ S2.cells) ∨ + (∃ j : Fin 4, + LatticeVertexIncidentCell segments.b j ∈ Q3.cells ∧ + LatticeVertexIncidentCell segments.b (j + 2) ∈ O.cells) ∨ + (∃ j : Fin 4, + LatticeVertexIncidentCell segments.b j ∈ S2.cells ∧ + LatticeVertexIncidentCell segments.b (j + 2) ∈ O.cells) + empty_cut : O.cells = ∅ → + segments.a = segments.b ∧ segments.a = O.anchor + proper_middle_modified_boundary : ∀ x ∈ segments.middle, + x ≠ segments.a → x ≠ segments.b → + x ∈ BoundaryFootprintVertices (TileCellComplement A O) ∩ + BoundaryFootprintVertices B + proper_middle_restored_left : ∀ x ∈ segments.middle, + x ≠ segments.a → x ≠ segments.b → + ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ A.cells + proper_middle_not_original_common : ∀ x ∈ segments.middle, + x ≠ segments.a → x ≠ segments.b → + x ∉ BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FiniteAcyclicGraphCardConnected.lean b/LeanPool/ApollonianSuperharmonic/FiniteAcyclicGraphCardConnected.lean new file mode 100644 index 0000000000..dd56efa5e1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FiniteAcyclicGraphCardConnected.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Combinatorics.SimpleGraph.Acyclic +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: FiniteAcyclicGraphCardConnected] + +/-! +# FiniteAcyclicGraphCardConnected + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FiniteAcyclicGraphCardConnected + {V : Type} [Finite V] [Nonempty V] (G : SimpleGraph V) + (hacyclic : G.IsAcyclic) + (hcard : Nat.card V = Nat.card G.edgeSet + 1) : G.Connected := by +-- BODY + classical + let topGraph : SimpleGraph V := ⊤ + obtain ⟨T, hGT, hT⟩ := + topGraph.exists_maximal_isAcyclic_of_le_isAcyclic le_top hacyclic + have hTtree : T.IsTree := by + apply (SimpleGraph.isTree_iff_maximal_isAcyclic (G := T)).2 + exact ⟨inferInstance, by simpa [topGraph] using hT⟩ + have hTcard : Nat.card T.edgeSet + 1 = Nat.card V := + (SimpleGraph.isTree_iff_connected_and_card (G := T)).1 hTtree |>.2 + have hEqCard : Nat.card T.edgeSet = Nat.card G.edgeSet := by + omega + let := Fintype.ofFinite T.edgeSet + let := Fintype.ofFinite G.edgeSet + have hsubset : G.edgeSet ⊆ T.edgeSet := by + exact (SimpleGraph.edgeSet_subset_edgeSet).2 hGT + have hcardle : Fintype.card T.edgeSet ≤ Fintype.card G.edgeSet := by + simpa [Nat.card_eq_fintype_card] using hEqCard.le + have hEqEdge : G.edgeSet = T.edgeSet := + Set.eq_of_subset_of_card_le hsubset hcardle + have hgraphs : G = T := SimpleGraph.edgeSet_injective hEqEdge + rw [hgraphs] + exact hTtree.connected + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FiniteAcyclicOrientationObstruction.lean b/LeanPool/ApollonianSuperharmonic/FiniteAcyclicOrientationObstruction.lean new file mode 100644 index 0000000000..47adb37e5d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FiniteAcyclicOrientationObstruction.lean @@ -0,0 +1,126 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation + +-- [TABLET NODE: FiniteAcyclicOrientationObstruction] + +/-! +# FiniteAcyclicOrientationObstruction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FiniteAcyclicOrientationObstruction + (D : Finset GaussianInt) (g : IntegerLatticeFunction) + (o : AcyclicIndegreeOrientation D + (fun x => 2 + FourNeighborLaplacian g x)) + (Y : Finset GaussianInt) (hY : Y.Nonempty) (hsub : Y ⊆ D) : + ∃ x ∈ Y, 2 ≤ FourNeighborLaplacian + (fun z => g z - if z ∈ Y then 1 else 0) x := by +-- BODY + classical + obtain ⟨x, hx, hmax⟩ := Finset.exists_max_image Y o.rank hY + have hxD : x ∈ D := hsub hx + have hsubset : Y.filter (fun y => o.edge y x) ⊆ + D.filter (fun y => @decide (o.edge y x) (o.edge_decidable y x)) := by + intro y hy + have hyY := (Finset.mem_filter.mp hy).1 + have hye := (Finset.mem_filter.mp hy).2 + exact Finset.mem_filter.mpr ⟨hsub hyY, by simp [hye]⟩ + have hcard : ((Y.filter (fun y => o.edge y x)).card : ℤ) ≤ + ((D.filter (fun y => @decide (o.edge y x) (o.edge_decidable y x))).card : ℤ) := by + exact_mod_cast Finset.card_le_card hsubset + have hneighbor : ∀ y ∈ Y, FourNeighborAdjacent x y → o.edge y x := by + intro y hy hxy + rcases o.oriented x hxD y (hsub hy) hxy with h | h + · exfalso + exact (Nat.not_lt_of_ge (hmax y hy)) (o.increasing x y h.1) + · exact h.1 + obtain ⟨hyedge, hyedge_mem⟩ := hY + have hcount : (Y.filter (fun y => FourNeighborAdjacent x y)).card ≤ + (Y.filter (fun y => o.edge y x)).card := by + apply Finset.card_le_card + intro y hy + exact Finset.mem_filter.mpr ⟨(Finset.mem_filter.mp hy).1, + hneighbor y (Finset.mem_filter.mp hy).1 (Finset.mem_filter.mp hy).2⟩ + have hcount' : ((Y.filter (fun y => FourNeighborAdjacent x y)).card : ℤ) ≤ + ((D.filter (fun y => @decide (o.edge y x) (o.edge_decidable y x))).card : ℤ) := by + have hcountInt : ((Y.filter (fun y => FourNeighborAdjacent x y)).card : ℤ) ≤ + ((Y.filter (fun y => o.edge y x)).card : ℤ) := by + exact_mod_cast hcount + exact hcountInt.trans hcard + have hindeg := o.indegree x hxD + rw [hindeg] at hcount' + have hset : Y.filter (fun y => FourNeighborAdjacent x y) = + ({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ Y) := by + ext y + rw [Finset.mem_filter, Finset.mem_filter] + rw [Finset.mem_insert, Finset.mem_insert, Finset.mem_insert, Finset.mem_singleton] + unfold FourNeighborAdjacent + tauto + rw [hset] at hcount' + rw [Finset.card_filter] at hcount' + have h12 : x + 1 ≠ x - 1 := by + intro h + have q := congrArg (fun z : GaussianInt => z.re) h + simp at q + omega + have h13 : x + 1 ≠ x + ⟨0, 1⟩ := by + intro h + have q := congrArg (fun z : GaussianInt => z.im) h + simp at q + have h14 : x + 1 ≠ x - ⟨0, 1⟩ := by + intro h + have q := congrArg (fun z : GaussianInt => z.re) h + simp at q + have h23 : x - 1 ≠ x + ⟨0, 1⟩ := by + intro h + have q := congrArg (fun z : GaussianInt => z.re) h + simp at q + have h24 : x - 1 ≠ x - ⟨0, 1⟩ := by + intro h + have q := congrArg (fun z : GaussianInt => z.re) h + simp at q + have h34 : x + ⟨0, 1⟩ ≠ x - ⟨0, 1⟩ := by + intro h + have q := congrArg (fun z : GaussianInt => z.im) h + simp at q + omega + have hsum : (∑ i ∈ ({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt), + if i ∈ Y then 1 else 0) = + (if x + 1 ∈ Y then 1 else 0) + (if x - 1 ∈ Y then 1 else 0) + + (if x + ⟨0, 1⟩ ∈ Y then 1 else 0) + + (if x - ⟨0, 1⟩ ∈ Y then 1 else 0) := by + by_cases q1 : x + 1 ∈ Y <;> by_cases q2 : x - 1 ∈ Y <;> + by_cases q3 : x + ⟨0, 1⟩ ∈ Y <;> by_cases q4 : x - ⟨0, 1⟩ ∈ Y <;> + simp_all [] + rw [hsum] at hcount' + have hineq : + (if x + 1 ∈ Y then (1 : ℤ) else 0) + + (if x - 1 ∈ Y then 1 else 0) + + (if x + ⟨0, 1⟩ ∈ Y then 1 else 0) + + (if x - ⟨0, 1⟩ ∈ Y then 1 else 0) ≤ + 2 + FourNeighborLaplacian g x := by + exact_mod_cast hcount' + refine ⟨x, hx, ?_⟩ + unfold FourNeighborLaplacian + simp only [] + unfold FourNeighborLaplacian at hineq + simp? [hx] at hineq ⊢ + clear hcount' + linarith [hineq] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean b/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean new file mode 100644 index 0000000000..6d2dff7ead --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean @@ -0,0 +1,1501 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Combinatorics.SimpleGraph.Acyclic +public import Mathlib.Data.Finset.Card +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +/-! +# FiniteBiconnectedHorizontalRunTree + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open scoped BigOperators + +-- [TABLET NODE: FiniteBiconnectedHorizontalRunTree] +namespace HorizontalRunTreeProof + +private theorem edgeOf_injective : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let HF : Finset GaussianInt := S.filter fun z => z - 1 ∈ S + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (horizontal_adj : ∀ {z : GaussianInt}, ∀ (hz : z ∈ S), ∀ (hz1 : z + 1 ∈ S), G.Adj ⟨z, hz⟩ + ⟨z + 1, hz1⟩), ∀ (selected_vertical_adj : ∀ {z : GaussianInt}, ∀ (hz : z ∈ S), ∀ (hzI : z + + I ∈ S), (z ∈ JF) → (G.Adj ⟨z, hz⟩ ⟨z + I, hzI⟩)), + let D := {z : GaussianInt // z ∈ HF} ⊕ {z : GaussianInt // z ∈ JF} + let edgeOf : D → G.edgeSet := fun d => match d with + | Sum.inl z => + let hz : z.1 ∈ S := (Finset.mem_filter.mp z.2).1 + let hz1 : z.1 - 1 ∈ S := (Finset.mem_filter.mp z.2).2 + ⟨s(⟨z.1 - 1, hz1⟩, ⟨z.1, hz⟩), by + rw [SimpleGraph.mem_edgeSet] + have h := horizontal_adj (z := z.1 - 1) hz1 + (by simpa [Zsqrtd.ext_iff] using hz) + simpa [Zsqrtd.ext_iff] using h⟩ + | Sum.inr z => + let hzV : z.1 ∈ VF := (Finset.mem_filter.mp z.2).1 + let hz : z.1 ∈ S := (Finset.mem_filter.mp hzV).1 + let hzI : z.1 + I ∈ S := (Finset.mem_filter.mp hzV).2 + ⟨s(⟨z.1, hz⟩, ⟨z.1 + I, hzI⟩), by + rw [SimpleGraph.mem_edgeSet] + exact selected_vertical_adj hz hzI z.2⟩ + Function.Injective edgeOf := by + classical + intro S I HF VF JF X rel G horizontal_adj selected_vertical_adj D edgeOf a b hab + rcases a with a | a <;> rcases b with b | b + · apply congrArg Sum.inl + apply Subtype.ext + dsimp [edgeOf] at hab + have hs := congrArg Subtype.val hab + rcases Sym2.eq_iff.mp hs with h | h + · exact congrArg (fun z : X => z.1) h.2 + · have h1 := congrArg (fun z : X => z.1.re) h.1 + have h2 := congrArg (fun z : X => z.1.re) h.2 + simp at h1 h2 + omega + · dsimp [edgeOf] at hab + have hs := congrArg Subtype.val hab + rcases Sym2.eq_iff.mp hs with h | h + · exfalso + have hi1 := congrArg (fun z : X => z.1.im) h.1 + have hi2 := congrArg (fun z : X => z.1.im) h.2 + simp [I] at hi1 hi2 + omega + · exfalso + have hi1 := congrArg (fun z : X => z.1.im) h.1 + have hi2 := congrArg (fun z : X => z.1.im) h.2 + simp [I] at hi1 hi2 + omega + · dsimp [edgeOf] at hab + have hs := congrArg Subtype.val hab + rcases Sym2.eq_iff.mp hs with h | h + · exfalso + have hi1 := congrArg (fun z : X => z.1.im) h.1 + have hi2 := congrArg (fun z : X => z.1.im) h.2 + simp [I] at hi1 hi2 + omega + · exfalso + have hi1 := congrArg (fun z : X => z.1.im) h.1 + have hi2 := congrArg (fun z : X => z.1.im) h.2 + simp [I] at hi1 hi2 + omega + · apply congrArg Sum.inr + apply Subtype.ext + dsimp [edgeOf] at hab + have hs := congrArg Subtype.val hab + rcases Sym2.eq_iff.mp hs with h | h + · exact congrArg (fun z : X => z.1) h.1 + · have hi1 := congrArg (fun z : X => z.1.im) h.1 + have hi2 := congrArg (fun z : X => z.1.im) h.2 + simp [I] at hi1 hi2 + omega + +private theorem edgeOf_surjective : + ∀ (S : Finset GaussianInt), let I : GaussianInt := ⟨0, 1⟩ + let HF : Finset GaussianInt := S.filter fun z => z - 1 ∈ S + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + (∀ (a : X), ∀ (b : X), G.Adj a b ↔ a ≠ b ∧ (rel a b ∨ rel b a)) → (∀ (horizontal_adj : ∀ + {z : GaussianInt}, ∀ (hz : z ∈ S), ∀ (hz1 : z + 1 ∈ S), G.Adj ⟨z, hz⟩ + ⟨z + 1, hz1⟩), ∀ (selected_vertical_adj : ∀ {z : GaussianInt}, ∀ (hz : z ∈ S), ∀ (hzI : z + + I ∈ S), (z ∈ JF) → (G.Adj ⟨z, hz⟩ ⟨z + I, hzI⟩)), let D := {z : GaussianInt // z ∈ HF} + ⊕ {z : GaussianInt // z ∈ JF} + let edgeOf : D → G.edgeSet := fun d => match d with + | Sum.inl z => + let hz : z.1 ∈ S := (Finset.mem_filter.mp z.2).1 + let hz1 : z.1 - 1 ∈ S := (Finset.mem_filter.mp z.2).2 + ⟨s(⟨z.1 - 1, hz1⟩, ⟨z.1, hz⟩), by + rw [SimpleGraph.mem_edgeSet] + have h := horizontal_adj (z := z.1 - 1) hz1 + (by simpa [Zsqrtd.ext_iff] using hz) + simpa [Zsqrtd.ext_iff] using h⟩ + | Sum.inr z => + let hzV : z.1 ∈ VF := (Finset.mem_filter.mp z.2).1 + let hz : z.1 ∈ S := (Finset.mem_filter.mp hzV).1 + let hzI : z.1 + I ∈ S := (Finset.mem_filter.mp hzV).2 + ⟨s(⟨z.1, hz⟩, ⟨z.1 + I, hzI⟩), by + rw [SimpleGraph.mem_edgeSet] + exact selected_vertical_adj hz hzI z.2⟩ + Function.Surjective edgeOf) := by + classical + intro S I HF VF JF X rel G graph_adj horizontal_adj selected_vertical_adj D edgeOf + rintro ⟨e, he⟩ + induction e using Sym2.inductionOn with + | _ a b => + rw [SimpleGraph.mem_edgeSet, graph_adj] at he + rcases he with ⟨hne, hab | hba⟩ + · rcases hab with hab | hab + · have hbS : b.1 ∈ S := b.2 + have haS : b.1 - 1 ∈ S := by simp [hab] + have hbH : b.1 ∈ HF := by simp [HF, hbS, haS] + refine ⟨Sum.inl ⟨b.1, hbH⟩, ?_⟩ + apply Subtype.ext + dsimp [edgeOf] + rw [Sym2.eq_iff] + left + refine ⟨?_, rfl⟩ + apply Subtype.ext + ext <;> simp [Zsqrtd.ext_iff] at hab ⊢ <;> omega + · have haJ : a.1 ∈ JF := hab.2 + refine ⟨Sum.inr ⟨a.1, haJ⟩, ?_⟩ + apply Subtype.ext + dsimp [edgeOf] + rw [Sym2.eq_iff] + left + exact ⟨rfl, Subtype.ext hab.1.symm⟩ + · rcases hba with hba | hba + · have haS : a.1 ∈ S := a.2 + have hbS : a.1 - 1 ∈ S := by simp [hba] + have haH : a.1 ∈ HF := by simp [HF, haS, hbS] + refine ⟨Sum.inl ⟨a.1, haH⟩, ?_⟩ + apply Subtype.ext + dsimp [edgeOf] + rw [Sym2.eq_iff] + right + refine ⟨?_, rfl⟩ + apply Subtype.ext + ext <;> simp [Zsqrtd.ext_iff] at hba ⊢ <;> omega + · have hbJ : b.1 ∈ JF := hba.2 + refine ⟨Sum.inr ⟨b.1, hbJ⟩, ?_⟩ + apply Subtype.ext + dsimp [edgeOf] + rw [Sym2.eq_iff] + right + exact ⟨rfl, Subtype.ext hba.1.symm⟩ + +private theorem vertical_reachable : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + (∀ {z : GaussianInt}, ∀ (hz : z ∈ S), ∀ (hz1 : z + 1 ∈ S), G.Adj ⟨z, hz⟩ ⟨z + 1, hz1⟩) → ((∀ + {z : GaussianInt}, ∀ (hz : z ∈ S), ∀ (hzI : z + I ∈ S), (z ∈ JF) → (G.Adj ⟨z, hz⟩ ⟨z + I, + hzI⟩)) → (∀ (leftmost : GaussianInt), (∀ x' ∈ S, leftmost.re ≤ x'.re) → (∀ (z : + GaussianInt), ∀ (hz : z ∈ S), ∀ (hzI : z + I ∈ S), G.Reachable ⟨z, hz⟩ ⟨z + I, + hzI⟩))) := by + classical + intro S I VF JF X rel G horizontal_adj selected_vertical_adj leftmost hmin z hz hzI + induction hmeasure : Int.toNat (z.re - leftmost.re) using + Nat.strong_induction_on generalizing z with + | h n ih => + by_cases hzJ : z ∈ JF + · exact (selected_vertical_adj hz hzI hzJ).reachable + · have hzV : z ∈ VF := by simp [VF, hz, hzI] + have hpair : z - 1 ∈ S ∧ z - 1 + I ∈ S := by + simp only [JF, Finset.mem_filter, hzV, true_and] at hzJ + exact not_not.mp hzJ + have hminLeft : leftmost.re ≤ (z - 1).re := hmin (z - 1) hpair.1 + change leftmost.re ≤ z.re - 1 at hminLeft + have hminZ : leftmost.re ≤ z.re := hmin z hz + have hdec : Int.toNat ((z - 1).re - leftmost.re) < n := by + change Int.toNat (z.re - 1 - leftmost.re) < n + rw [← hmeasure] + exact (Int.toNat_lt_toNat (by omega)).2 (by omega) + have hvert := ih _ hdec (z - 1) hpair.1 + (by simpa [I, Zsqrtd.ext_iff] using hpair.2) rfl + have hleft : G.Reachable ⟨z, hz⟩ ⟨z - 1, hpair.1⟩ := by + apply SimpleGraph.Reachable.symm + have h := horizontal_adj (z := z - 1) hpair.1 + (by simpa [Zsqrtd.ext_iff] using hz) + simpa [Zsqrtd.ext_iff] using h.reachable + have hright : G.Reachable + ⟨z - 1 + I, hpair.2⟩ ⟨z + I, hzI⟩ := by + have h := horizontal_adj (z := z - 1 + I) hpair.2 + (by convert hzI using 1; ext <;> simp [I]) + convert h.reachable using 1; apply Subtype.ext; + ext <;> simp [I] + exact hleft.trans (hvert.trans hright) + +private theorem four_reachable : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + (∀ {z : GaussianInt}, ∀ (hz : z ∈ S), ∀ (hz1 : z + 1 ∈ S), G.Adj ⟨z, hz⟩ ⟨z + 1, hz1⟩) → ((∀ + (z : GaussianInt), ∀ (hz : z ∈ S), ∀ (hzI : z + I ∈ S), G.Reachable ⟨z, hz⟩ ⟨z + I, hzI⟩) + → (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ (ha : a ∈ S), ∀ (hb : b ∈ S), + (FourNeighborAdjacent a b) → (G.Reachable ⟨a, ha⟩ ⟨b, hb⟩))) := by + classical + intro S I VF JF X rel G horizontal_adj vertical_reachable a b ha hb hab + rcases hab with rfl | rfl | rfl | rfl + · exact (horizontal_adj ha hb).reachable + · apply SimpleGraph.Reachable.symm + have h := horizontal_adj (z := a - 1) hb + (by simpa [Zsqrtd.ext_iff] using ha) + simpa [Zsqrtd.ext_iff] using h.reachable + · exact vertical_reachable a ha hb + · apply SimpleGraph.Reachable.symm + have h := vertical_reachable (a - I) hb + (by simpa [I, Zsqrtd.ext_iff] using ha) + simpa [I, Zsqrtd.ext_iff] using h + +private theorem hconnected : + ∀ (S : Finset GaussianInt), (FourNeighborConnected (↑S : Set LatticeCell)) → ( + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (base : LatticeCell), (base ∈ (↑S : Set LatticeCell)) → ((∀ {a : GaussianInt}, ∀ + {b : GaussianInt}, ∀ (ha : a ∈ S), ∀ (hb : b ∈ S), (FourNeighborAdjacent a b) → + (G.Reachable ⟨a, ha⟩ ⟨b, hb⟩)) → (G.Connected))) := by + classical + intro S hinside I VF JF X rel G base hbase four_reachable + refine { nonempty := ⟨⟨base, hbase⟩⟩, preconnected := ?_ } + intro a b + obtain ⟨p, hphead, hplast, hpmem, hpadj⟩ := + hinside.2 a.1 a.2 b.1 b.2 + have hpne : p ≠ [] := by intro hp; simp [hp] at hphead + have hpchain : List.IsChain FourNeighborAdjacent p := by + rw [List.isChain_iff_forall_rel_of_append_cons_cons] + exact hpadj + let toX : GaussianInt → X := fun z => + if hz : z ∈ S then ⟨z, hz⟩ else ⟨base, hbase⟩ + have toX_eq (z : GaussianInt) (hz : z ∈ S) : (toX z).1 = z := by + simp [toX, hz] + have hpchain' : List.IsChain (fun x y : GaussianInt => + G.Reachable (toX x) (toX y)) p := by + rw [List.isChain_iff_forall_rel_of_append_cons_cons] + intro x y l₁ l₂ heq + have hx : x ∈ S := hpmem x (by rw [heq]; simp) + have hy : y ∈ S := hpmem y (by rw [heq]; simp) + have h := four_reachable hx hy (hpadj x y l₁ l₂ heq) + convert h using 1 <;> apply Subtype.ext <;> simp [toX, hx, hy] + have hreachRaw : G.Reachable (toX (p.head hpne)) + (toX (p.getLast hpne)) := by + have hr := List.relationReflTransGen_of_exists_isChain p hpchain' hpne + exact hr.trans_induction_on + (motive := fun {a b} _ => G.Reachable (toX a) (toX b)) + (fun _ => SimpleGraph.Reachable.rfl) (fun h => h) + (fun _ _ h₁ h₂ => h₁.trans h₂) + have hhead : p.head hpne = a.1 := by + exact (List.head_eq_iff_head?_eq_some hpne).2 hphead + have hlast : p.getLast hpne = b.1 := by + exact (List.getLast_eq_iff_getLast?_eq_some hpne).2 hplast + convert hreachRaw using 1 <;> apply Subtype.ext <;> + simp [toX, hhead, hlast, a.2, b.2] + +private theorem neighbor_options : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + (∀ (a : X), ∀ (b : X), G.Adj a b ↔ a ≠ b ∧ (rel a b ∨ rel b a)) → (∀ (u : X), ∀ (c : G.Walk u + u), ∀ (v : X), (∀ (w : X), (w ∈ c.support) → (w.1.im ≤ v.1.im)) → ((∀ (w : X), (w ∈ + c.support) → ((w.1.im = v.1.im) → (w.1.re ≤ v.1.re))) → (∀ (w : X), (c.toSubgraph.Adj v + w) → (w.1 = v.1 - 1 ∨ w.1 = v.1 - I)))) := by + classical + intro S I VF JF X rel G graph_adj u c v hv_im_max hv_re_max w hvw + have hwmem : w ∈ c.support := + c.mem_verts_toSubgraph.mp (c.toSubgraph.edge_vert hvw.symm) + have hadj : G.Adj v w := hvw.adj_sub + rw [graph_adj] at hadj + rcases hadj.2 with hvwrel | hwvrel + · rcases hvwrel with hright | hup + · exfalso + have him : w.1.im = v.1.im := by rw [hright]; simp + have hre := hv_re_max w hwmem him + rw [hright] at hre + simp at hre + · exfalso + have him := hv_im_max w hwmem + rw [hup.1] at him + simp [I] at him + · rcases hwvrel with hleft | hdown + · left + rw [hleft] + ext <;> simp + · right + rw [hdown.1] + ext <;> simp [I] + +private theorem hdownJ : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + (∀ (a : X), ∀ (b : X), G.Adj a b ↔ a ≠ b ∧ (rel a b ∨ rel b a)) → (∀ (u : X), ∀ (c : G.Walk u + u), ∀ (v : X), ∀ (hdownX : v.1 - I ∈ S), (c.toSubgraph.Adj v ⟨v.1 - I, hdownX⟩) → (v.1 - + I ∈ JF)) := by + classical + intro S I VF JF X rel G graph_adj u c v hdownX hdownEdge + have h := hdownEdge.adj_sub + rw [graph_adj] at h + rcases h.2 with h | h + · rcases h with h | h + · have hi := congrArg Zsqrtd.im h + simp [I] at hi + · have hi := congrArg Zsqrtd.im h.1 + simp [I] at hi + omega + · rcases h with h | h + · have hr := congrArg Zsqrtd.re h + simp [I] at hr + · have heq : (v.1 - I : GaussianInt) + I = v.1 := by + ext <;> simp [I] + exact h.2 + +private theorem path_zip : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), + let path : List GaussianInt := c.support.tail.map Subtype.val + (3 ≤ path.length) → ((List.IsChain FourNeighborAdjacent path) → (∀ a b, (a, b) ∈ path.zip + path.tail → + FourNeighborAdjacent a b)) := by + classical + intro S I VF JF X rel G u c path path_length path_chain a b hab + rw [List.mem_iff_getElem] at hab + rcases hab with ⟨i, hi, hab⟩ + have hi' : i < path.tail.length := by + simpa [List.length_zip] using hi + have hip : i + 1 < path.length := by + simp only [List.length_tail] at hi' + omega + rw [List.getElem_zip, List.getElem_tail] at hab + injection hab with ha hb + rw [List.isChain_iff_getElem] at path_chain + simpa [ha, hb] using path_chain i hip + +private theorem cycle_edge_oriented : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), + let path : List GaussianInt := c.support.tail.map Subtype.val + let cyclicEdges := path.zip path.tail ++ [(u.1, c.snd.1)] + ∀ {x : X}, ∀ {y : X}, (c.toSubgraph.Adj x y) → ((x.1, y.1) ∈ cyclicEdges ∨ (y.1, x.1) ∈ + cyclicEdges) := by + classical + intro S I VF JF X rel G u c path cyclicEdges x y hxy + rw [c.toSubgraph_adj_iff] at hxy + rcases hxy with ⟨i, heq, hi⟩ + rcases i with _ | i + · rcases Sym2.eq_iff.mp heq with heq | heq + · left + simp only [cyclicEdges, List.mem_append, List.mem_singleton] + right + apply Prod.ext + · simpa using congrArg (fun z : X => z.1) heq.1.symm + · simpa using congrArg (fun z : X => z.1) heq.2.symm + · right + simp only [cyclicEdges, List.mem_append, List.mem_singleton] + right + apply Prod.ext + · simpa using congrArg (fun z : X => z.1) heq.1.symm + · simpa using congrArg (fun z : X => z.1) heq.2.symm + · have hpair : + (c.getVert (i + 1) |>.1, c.getVert (i + 2) |>.1) ∈ + path.zip path.tail := by + rw [List.mem_iff_getElem] + refine ⟨i, ?_, ?_⟩ + · simp [path, List.length_zip, List.length_tail, + SimpleGraph.Walk.length_support] + omega + · rw [List.getElem_zip, List.getElem_tail] + apply Prod.ext + · simp [path, c.support_getElem_eq_getVert] + · simp only [path, List.getElem_map, List.getElem_tail, + ] + congr 1 + convert c.support_getElem_eq_getVert (n := i + 2) _ using 1; + rcases Sym2.eq_iff.mp heq with heq | heq + · left + dsimp only [cyclicEdges] + apply List.mem_append_left + simpa [congrArg (fun z : X => z.1) heq.1, + congrArg (fun z : X => z.1) heq.2] using hpair + · right + dsimp only [cyclicEdges] + apply List.mem_append_left + simpa [congrArg (fun z : X => z.1) heq.1, + congrArg (fun z : X => z.1) heq.2] using hpair + +private theorem crossing_step_zero : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), (G.Walk u u) → (∀ (v : X), + let q : GaussianInt := v.1 - 1 - I + ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a.im ≤ v.1.im) → ((b.im ≤ v.1.im) → ((if b = a + + ⟨0, 1⟩ ∧ a.im = (q + I).im ∧ a.re ≤ (q + I).re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = (q + I).im ∧ + a.re ≤ (q + I).re then -1 else 0) = 0))) := by + classical + intro S I VF JF X rel G u c v q a b ha hb + split_ifs with hup hdown + · have habim := congrArg Zsqrtd.im hup.1 + have haeq := hup.2.1 + simp [q, I] at habim haeq + omega + · have habim := congrArg Zsqrtd.im hdown.1 + have hbeq := hdown.2.1 + simp [q, I] at habim hbeq + omega + · rfl + +private theorem htopzero : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), (c.IsCycle) → (∀ (v : X), (∀ (w : X), (w ∈ c.support) → + (w.1.im ≤ v.1.im)) → ( + let q : GaussianInt := v.1 - 1 - I + let path : List GaussianInt := c.support.tail.map Subtype.val + (path.head? = some c.snd.1) → ((path.getLast? = some u.1) → ((∀ {z : GaussianInt}, (z ∈ path) + → (z.im ≤ v.1.im)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), (a.im ≤ v.1.im) → ((b.im + ≤ v.1.im) → ((if b = a + ⟨0, 1⟩ ∧ a.im = (q + I).im ∧ a.re ≤ (q + I).re then 1 else if b + = a - ⟨0, 1⟩ ∧ b.im = (q + I).im ∧ a.re ≤ (q + I).re then -1 else 0) = 0))) → + (GridRayCrossingIndex (q + I) path = 0)))))) := by + classical + intro S I VF JF X rel G u c hc v hv_im_max q path path_head path_last path_vertex_im_le + crossing_step_zero + rw [GridRayCrossingIndex] + dsimp only + rw [path_last, path_head] + have hzip (f : GaussianInt → GaussianInt → Int) + (as bs : List GaussianInt) : + List.zipWith f as bs = (as.zip bs).map fun e => f e.1 e.2 := by + induction as generalizing bs with + | nil => simp + | cons a as ih => cases bs <;> simp [ih] + rw [hzip] + have hsum : + (path.zip path.tail |>.map fun e => + if e.2 = e.1 + ⟨0, 1⟩ ∧ e.1.im = (q + I).im ∧ + e.1.re ≤ (q + I).re then 1 + else if e.2 = e.1 - ⟨0, 1⟩ ∧ e.2.im = (q + I).im ∧ + e.1.re ≤ (q + I).re then -1 else 0).sum = 0 := by + apply List.sum_eq_zero + intro n hn + rw [List.mem_map] at hn + rcases hn with ⟨e, he, rfl⟩ + rw [List.mem_iff_getElem] at he + rcases he with ⟨i, hi, he⟩ + have hit : i < path.tail.length := by + simpa [List.length_zip] using hi + have hip : i < path.length := + lt_of_lt_of_le hi (by simp [List.length_zip]) + rw [List.getElem_zip, List.getElem_tail] at he + have he1 := congrArg Prod.fst he + have he2 := congrArg Prod.snd he + apply crossing_step_zero + · apply path_vertex_im_le + simp [← he1] + · apply path_vertex_im_le + simp [← he2] + rw [hsum, zero_add] + apply crossing_step_zero + · exact hv_im_max u (by simp) + · exact hv_im_max c.snd + (List.mem_of_mem_tail (c.snd_mem_tail_support hc.not_nil)) + +private theorem htarget : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), ∀ (v : X), ∀ (hleftX : v.1 - 1 ∈ S), (c.toSubgraph.Adj v ⟨v.1 + - 1, hleftX⟩) → ( + let q : GaussianInt := v.1 - 1 - I + let path : List GaussianInt := c.support.tail.map Subtype.val + let cyclicEdges := path.zip path.tail ++ [(u.1, c.snd.1)] + (∀ {x : X}, ∀ {y : X}, (c.toSubgraph.Adj x y) → ((x.1, y.1) ∈ cyclicEdges ∨ (y.1, x.1) ∈ + cyclicEdges)) → ((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∈ cyclicEdges ∨ + (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) ∈ cyclicEdges)) := by + classical + intro S I VF JF X rel G u c v hleftX hleftEdge q path cyclicEdges cycle_edge_oriented + have h := cycle_edge_oriented hleftEdge + have heast : q + 1 + ⟨0, 1⟩ = v.1 := by + ext <;> simp [q, I] + have hnorth : q + ⟨0, 1⟩ = v.1 - 1 := by + ext <;> simp [q, I] + rw [heast, hnorth] + exact h + +private theorem cyclic_edge_occupied : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), (X) → ( + let path : List GaussianInt := c.support.tail.map Subtype.val + (3 ≤ path.length) → ( + let cyclicEdges := path.zip path.tail ++ [(u.1, c.snd.1)] + (∀ {z : GaussianInt}, (z ∈ path) → (z ∈ S)) → (∀ {r : GaussianInt}, ∀ {s : GaussianInt}, ((r, + s) ∈ cyclicEdges) → (r ∈ S ∧ s ∈ S)))) := by + classical + intro S I VF JF X rel G u c v path path_length cyclicEdges path_vertex_mem r s hrs + rcases List.mem_append.mp hrs with hrs | hrs + · rw [List.mem_iff_getElem] at hrs + rcases hrs with ⟨i, hi, hrs⟩ + have hit : i < path.tail.length := by + simpa [List.length_zip] using hi + have hip : i < path.length := + lt_of_lt_of_le hi (by simp [List.length_zip]) + rw [List.getElem_zip, List.getElem_tail] at hrs + have hrs1 := congrArg Prod.fst hrs + have hrs2 := congrArg Prod.snd hrs + have hip1 : i + 1 < path.length := by + simp only [List.length_tail] at hit + omega + have hrs1' : path[i] = r := by simpa using hrs1 + have hrs2' : path[i + 1] = s := by simpa using hrs2 + constructor + · apply path_vertex_mem + rw [← hrs1'] + exact List.getElem_mem (l := path) hip + · apply path_vertex_mem + rw [← hrs2'] + exact List.getElem_mem (l := path) hip1 + · simp only [List.mem_singleton] at hrs + injection hrs with hrs1 hrs2 + simpa [← hrs1, ← hrs2] using And.intro u.2 c.snd.2 + +private theorem index_eq_of_outside_adj : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), + let path : List GaussianInt := c.support.tail.map Subtype.val + (have cyclicEdges := path.zip path.tail ++ [((↑u : GaussianInt), (↑c.snd : GaussianInt))]; ∀ + (q : LatticeCell), ((q + (1 : LatticeCell), q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ + cyclicEdges ∧ (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell)) ∉ + cyclicEdges → GridRayCrossingIndex (q + (1 : LatticeCell)) path = GridRayCrossingIndex q + path) ∧ ((q + (1 : LatticeCell), q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ + cyclicEdges ∨ (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell)) ∈ + cyclicEdges → (GridRayCrossingIndex (q + (1 : LatticeCell)) path - GridRayCrossingIndex q + path).natAbs = (1 : ℕ)) ∧ ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 + : ℤ)⟩) ∉ cyclicEdges ∧ (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : + ℤ)⟩) ∉ cyclicEdges → GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) path = + GridRayCrossingIndex q path) ∧ ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : + ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell) + ⟨(0 : ℤ), + (1 : ℤ)⟩) ∈ cyclicEdges → (GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) path - + GridRayCrossingIndex q path).natAbs = (1 : ℕ))) → ( + let cyclicEdges := path.zip path.tail ++ [(u.1, c.snd.1)] + (∀ {r : GaussianInt}, ∀ {s : GaussianInt}, ((r, s) ∈ cyclicEdges) → (r ∈ S ∧ s ∈ S)) → (∀ + {r : GaussianInt}, ∀ {s : GaussianInt}, (r ∉ S) → ((s ∉ S) → ((FourNeighborAdjacent r s) + → (GridRayCrossingIndex r path = GridRayCrossingIndex s path))))) := by + classical + intro S I VF JF X rel G u c path index_control cyclicEdges cyclic_edge_occupied r s hr hs hrs + rcases hrs with rfl | rfl | rfl | rfl + · exact ((index_control r).1 ⟨ + fun he => hs (cyclic_edge_occupied he).1, + fun he => hs (cyclic_edge_occupied he).2⟩).symm + · have h := (index_control (r - 1)).1 + ⟨fun he => hr (by simpa [Zsqrtd.ext_iff] using + (cyclic_edge_occupied he).1), + fun he => hr (by simpa [Zsqrtd.ext_iff] using + (cyclic_edge_occupied he).2)⟩ + simpa [Zsqrtd.ext_iff] using h + · have h := (index_control r).2.2.1 + ⟨fun he => hs (cyclic_edge_occupied he).2, + fun he => hs (cyclic_edge_occupied he).1⟩ + simpa [I, Zsqrtd.ext_iff] using h.symm + · have h := (index_control (r - I)).2.2.1 + ⟨fun he => hr (by simpa [I, Zsqrtd.ext_iff] using + (cyclic_edge_occupied he).2), + fun he => hr (by simpa [I, Zsqrtd.ext_iff] using + (cyclic_edge_occupied he).1)⟩ + simpa [I, Zsqrtd.ext_iff] using h + +private theorem hqfar : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (leftmost : GaussianInt), ∀ (u : X), ∀ (c : G.Walk u u), ∀ (v : X), + let q : GaussianInt := v.1 - 1 - I + let path : List GaussianInt := c.support.tail.map Subtype.val + let far : GaussianInt := leftmost - 1 + ∀ (outsidePath : List LatticeCell), (outsidePath.head? = some q) → ((outsidePath.getLast? = + some far) → ((outsidePath ≠ []) → ((List.IsChain (fun r s => GridRayCrossingIndex r path + = GridRayCrossingIndex s path) outsidePath) → (GridRayCrossingIndex q path = + GridRayCrossingIndex far path)))) := by + classical + intro S I VF JF X rel G leftmost u c v q path far outsidePath houtHead houtLast houtNe houtChain + have hraw := List.relationReflTransGen_of_exists_isChain + outsidePath houtChain houtNe + have heq : outsidePath.head houtNe = q := + (List.head_eq_iff_head?_eq_some houtNe).2 houtHead + have heqLast : outsidePath.getLast houtNe = far := + (List.getLast_eq_iff_getLast?_eq_some houtNe).2 houtLast + let reachRel : GaussianInt → GaussianInt → Prop := fun r s => + GridRayCrossingIndex r path = GridRayCrossingIndex s path + let : Std.Refl reachRel := ⟨fun _ => rfl⟩ + let : IsTrans GaussianInt reachRel := + ⟨fun _ _ _ h₁ h₂ => h₁.trans h₂⟩ + have h := Relation.reflTransGen_le_of_le + (r := reachRel) (r' := reachRel) (fun _ _ h => h) _ _ hraw + simpa [reachRel, heq, heqLast] using h + +private theorem far_step_zero : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (leftmost : GaussianInt), ∀ (u : X), (G.Walk u u) → ((X) → ( + let far : GaussianInt := leftmost - 1 + ∀ (a : GaussianInt), ∀ (b : GaussianInt), (leftmost.re ≤ a.re) → ((if b = a + ⟨0, 1⟩ ∧ a.im = + far.im ∧ a.re ≤ far.re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = far.im ∧ a.re ≤ far.re + then -1 else 0) = 0))) := by + classical + intro S I VF JF X rel G leftmost u c v far a b ha + split_ifs with hup hdown + · simp [far] at hup + omega + · simp [far] at hdown + omega + · rfl + +private theorem hfarzero : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (leftmost : GaussianInt), (∀ x' ∈ S, leftmost.re ≤ x'.re) → (∀ (u : X), ∀ (c : G.Walk u u), + let path : List GaussianInt := c.support.tail.map Subtype.val + (path.head? = some c.snd.1) → ((path.getLast? = some u.1) → ( + let far : GaussianInt := leftmost - 1 + (∀ {z : GaussianInt}, (z ∈ path) → (leftmost.re ≤ z.re)) → ((∀ (a : GaussianInt), ∀ (b : + GaussianInt), (leftmost.re ≤ a.re) → ((if b = a + ⟨0, 1⟩ ∧ a.im = far.im ∧ a.re ≤ far.re + then 1 else if b = a - ⟨0, 1⟩ ∧ b.im = far.im ∧ a.re ≤ far.re then -1 else 0) = 0)) → + (GridRayCrossingIndex far path = 0))))) := by + classical + intro S I VF JF X rel G leftmost hmin u c path path_head path_last far path_vertex_re_min + far_step_zero + rw [GridRayCrossingIndex] + dsimp only + rw [path_last, path_head] + have hzip (f : GaussianInt → GaussianInt → Int) + (as bs : List GaussianInt) : + List.zipWith f as bs = (as.zip bs).map fun e => f e.1 e.2 := by + induction as generalizing bs with + | nil => simp + | cons a as ih => cases bs <;> simp [ih] + rw [hzip] + have hsum : + (path.zip path.tail |>.map fun e => + if e.2 = e.1 + ⟨0, 1⟩ ∧ e.1.im = far.im ∧ e.1.re ≤ far.re + then 1 + else if e.2 = e.1 - ⟨0, 1⟩ ∧ e.2.im = far.im ∧ + e.1.re ≤ far.re then -1 else 0).sum = 0 := by + apply List.sum_eq_zero + intro n hn + rw [List.mem_map] at hn + rcases hn with ⟨e, he, rfl⟩ + apply far_step_zero + apply path_vertex_re_min + rw [List.mem_iff_getElem] at he + rcases he with ⟨i, hi, he⟩ + have hip : i < path.length := + lt_of_lt_of_le hi (by simp [List.length_zip]) + rw [List.getElem_zip] at he + have he1 := congrArg Prod.fst he + simp [← he1] + rw [hsum, zero_add] + apply far_step_zero + exact hmin u.1 u.2 + +end HorizontalRunTreeProof + +namespace HorizontalRunDetails + +private theorem hpartition : + ∀ (S : Finset GaussianInt), + let HF : Finset GaussianInt := S.filter fun z => z - 1 ∈ S + let RF : Finset GaussianInt := S.filter fun z => z - 1 ∉ S + S.card = HF.card + RF.card := by + classical + intro S HF RF + simpa [HF, RF] using + (Finset.card_filter_add_card_filter_not + (s := S) (fun z => z - 1 ∈ S)).symm + +private theorem graph_adj : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (a : X), ∀ (b : X), G.Adj a b ↔ + a ≠ b ∧ (rel a b ∨ rel b a) := by + classical + intro S I VF JF X rel G a b + simp [G] + +private theorem horizontal_adj : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + (∀ (a : X), ∀ (b : X), G.Adj a b ↔ a ≠ b ∧ (rel a b ∨ rel b a)) → (∀ {z : GaussianInt}, ∀ (hz + : z ∈ S), ∀ (hz1 : z + 1 ∈ S), G.Adj ⟨z, hz⟩ ⟨z + 1, hz1⟩) := by + classical + intro S I VF JF X rel G graph_adj z hz hz1 + rw [graph_adj] + refine ⟨?_, Or.inl (Or.inl rfl)⟩ + intro h + have := congrArg (fun w : X => (w.1.re : Int)) h + simp at this + +private theorem selected_vertical_adj : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + (∀ (a : X), ∀ (b : X), G.Adj a b ↔ a ≠ b ∧ (rel a b ∨ rel b a)) → (∀ {z : GaussianInt}, ∀ (hz + : z ∈ S), ∀ (hzI : z + I ∈ S), (z ∈ JF) → (G.Adj ⟨z, hz⟩ ⟨z + I, hzI⟩)) := by + classical + intro S I VF JF X rel G graph_adj z hz hzI hzJ + rw [graph_adj] + refine ⟨?_, Or.inl (Or.inr ⟨rfl, hzJ⟩)⟩ + intro h + have := congrArg (fun w : X => (w.1.im : Int)) h + simp [I] at this + +private theorem hedgecard : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let HF : Finset GaussianInt := S.filter fun z => z - 1 ∈ S + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (horizontal_adj : ∀ {z : GaussianInt}, ∀ (hz : z ∈ S), ∀ (hz1 : z + 1 ∈ S), G.Adj ⟨z, hz⟩ + ⟨z + 1, hz1⟩), ∀ (selected_vertical_adj : ∀ {z : GaussianInt}, ∀ (hz : z ∈ S), ∀ (hzI : z + + I ∈ S), (z ∈ JF) → (G.Adj ⟨z, hz⟩ ⟨z + I, hzI⟩)), + let D := {z : GaussianInt // z ∈ HF} ⊕ {z : GaussianInt // z ∈ JF} + let edgeOf : D → G.edgeSet := fun d => match d with + | Sum.inl z => + let hz : z.1 ∈ S := (Finset.mem_filter.mp z.2).1 + let hz1 : z.1 - 1 ∈ S := (Finset.mem_filter.mp z.2).2 + ⟨s(⟨z.1 - 1, hz1⟩, ⟨z.1, hz⟩), by + rw [SimpleGraph.mem_edgeSet] + have h := horizontal_adj (z := z.1 - 1) hz1 + (by simpa [Zsqrtd.ext_iff] using hz) + simpa [Zsqrtd.ext_iff] using h⟩ + | Sum.inr z => + let hzV : z.1 ∈ VF := (Finset.mem_filter.mp z.2).1 + let hz : z.1 ∈ S := (Finset.mem_filter.mp hzV).1 + let hzI : z.1 + I ∈ S := (Finset.mem_filter.mp hzV).2 + ⟨s(⟨z.1, hz⟩, ⟨z.1 + I, hzI⟩), by + rw [SimpleGraph.mem_edgeSet] + exact selected_vertical_adj hz hzI z.2⟩ + (Function.Injective edgeOf) → ((Function.Surjective edgeOf) → (Nat.card G.edgeSet = HF.card + + JF.card)) := by + classical + intro S I HF VF JF X rel G horizontal_adj selected_vertical_adj D edgeOf edgeOf_injective + edgeOf_surjective + let e : D ≃ G.edgeSet := Equiv.ofBijective edgeOf + ⟨edgeOf_injective, edgeOf_surjective⟩ + rw [← Nat.card_congr e] + simp [D] + +private theorem htopsne : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), ∀ (top : X), (top ∈ c.support.toFinset) → ( + let tops : Finset X := c.support.toFinset.filter fun z => z.1.im = top.1.im + tops.Nonempty) := by + classical + intro S I VF JF X rel G u c top htop tops + refine ⟨top, ?_⟩ + simp [tops, htop] + +private theorem hvmem : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), ∀ (top : X), + let tops : Finset X := c.support.toFinset.filter fun z => z.1.im = top.1.im + ∀ (v : X), (v ∈ tops) → (v ∈ c.support) := by + classical + intro S I VF JF X rel G u c top tops v hvtop + have := (Finset.mem_filter.mp hvtop).1 + simpa using this + +private theorem hv_im_max : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), ∀ (top : X), (∀ x' ∈ c.support.toFinset, (↑x' : + GaussianInt).im ≤ (↑top : GaussianInt).im) → ( + let tops : Finset X := c.support.toFinset.filter fun z => z.1.im = top.1.im + ∀ (v : X), (v ∈ tops) → (∀ (w : X), (w ∈ c.support) → (w.1.im ≤ v.1.im))) := by + classical + intro S I VF JF X rel G u c top htopmax tops v hvtop w hw + have hvim : v.1.im = top.1.im := (Finset.mem_filter.mp hvtop).2 + rw [hvim] + exact htopmax w (by simpa using hw) + +private theorem hv_re_max : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), ∀ (top : X), + let tops : Finset X := c.support.toFinset.filter fun z => z.1.im = top.1.im + ∀ (v : X), (v ∈ tops) → ((∀ x' ∈ tops, (↑x' : GaussianInt).re ≤ (↑v : GaussianInt).re) → (∀ + (w : X), (w ∈ c.support) → ((w.1.im = v.1.im) → (w.1.re ≤ v.1.re)))) := by + classical + intro S I VF JF X rel G u c top tops v hvtop hvright w hw him + apply hvright w + rw [Finset.mem_filter] + refine ⟨by simpa using hw, ?_⟩ + exact him.trans (Finset.mem_filter.mp hvtop).2 + +private theorem haedge : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), ∀ (v : X), ∀ (a : X), ∀ (b : X), (c.toSubgraph.neighborSet v = + {a, b}) → (c.toSubgraph.Adj v a) := by + classical + intro S I VF JF X rel G u c v a b hneighbors + have : a ∈ c.toSubgraph.neighborSet v := by rw [hneighbors]; simp + exact this + +private theorem hbedge : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), ∀ (v : X), ∀ (a : X), ∀ (b : X), (c.toSubgraph.neighborSet v = + {a, b}) → (c.toSubgraph.Adj v b) := by + classical + intro S I VF JF X rel G u c v a b hneighbors + have : b ∈ c.toSubgraph.neighborSet v := by rw [hneighbors]; simp + exact this + +private theorem hpairs : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let X := {z : GaussianInt // z ∈ S} + ∀ (v : X), ∀ (a : X), ∀ (b : X), (a ≠ b) → (((↑a : GaussianInt) = (↑v : GaussianInt) - (1 : + GaussianInt) ∨ (↑a : GaussianInt) = (↑v : GaussianInt) - I) → (((↑b : GaussianInt) = (↑v + : GaussianInt) - (1 : GaussianInt) ∨ (↑b : GaussianInt) = (↑v : GaussianInt) - I) → ((a.1 + = v.1 - 1 ∧ b.1 = v.1 - I) ∨ + (b.1 = v.1 - 1 ∧ a.1 = v.1 - I)))) := by + classical + intro S I X v a b hab haopt hbopt + rcases haopt with ha | ha <;> rcases hbopt with hb | hb + · exact (hab (Subtype.ext (ha.trans hb.symm))).elim + · exact Or.inl ⟨ha, hb⟩ + · exact Or.inr ⟨hb, ha⟩ + · exact (hab (Subtype.ext (ha.trans hb.symm))).elim + +private theorem hleftX : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let X := {z : GaussianInt // z ∈ S} + ∀ (v : X), ∀ (a : X), ∀ (b : X), ((a.1 = v.1 - 1 ∧ b.1 = v.1 - I) ∨ (b.1 = v.1 - 1 ∧ a.1 = + v.1 - I)) → (v.1 - 1 ∈ S) := by + classical + intro S I X v a b hpairs + rcases hpairs with hp | hp + · simpa [hp.1] using a.2 + · simpa [hp.1] using b.2 + +private theorem hdownX : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let X := {z : GaussianInt // z ∈ S} + ∀ (v : X), ∀ (a : X), ∀ (b : X), ((a.1 = v.1 - 1 ∧ b.1 = v.1 - I) ∨ (b.1 = v.1 - 1 ∧ a.1 = + v.1 - I)) → (v.1 - I ∈ S) := by + classical + intro S I X v a b hpairs + rcases hpairs with hp | hp + · simpa [hp.2] using b.2 + · simpa [hp.2] using a.2 + +private theorem hleftEdge : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), ∀ (v : X), ∀ (a : X), ∀ (b : X), (c.toSubgraph.Adj v a) → + ((c.toSubgraph.Adj v b) → (((a.1 = v.1 - 1 ∧ b.1 = v.1 - I) ∨ (b.1 = v.1 - 1 ∧ a.1 = v.1 + - I)) → (∀ (hleftX : v.1 - 1 ∈ S), c.toSubgraph.Adj v ⟨v.1 - 1, hleftX⟩))) := by + classical + intro S I VF JF X rel G u c v a b haedge hbedge hpairs hleftX + rcases hpairs with hp | hp + · convert haedge using 1; apply Subtype.ext; simp [hp.1] + · convert hbedge using 1; apply Subtype.ext; simp [hp.1] + +private theorem hdownEdge : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), ∀ (v : X), ∀ (a : X), ∀ (b : X), (c.toSubgraph.Adj v a) → + ((c.toSubgraph.Adj v b) → (((a.1 = v.1 - 1 ∧ b.1 = v.1 - I) ∨ (b.1 = v.1 - 1 ∧ a.1 = v.1 + - I)) → (∀ (hdownX : v.1 - I ∈ S), c.toSubgraph.Adj v ⟨v.1 - I, hdownX⟩))) := by + classical + intro S I VF JF X rel G u c v a b haedge hbedge hpairs hdownX + rcases hpairs with hp | hp + · convert hbedge using 1; apply Subtype.ext; simp [hp.2] + · convert haedge using 1; apply Subtype.ext; simp [hp.2] + +private theorem hqout : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + ∀ (v : X), (v.1 - 1 ∈ S) → ((v.1 - I ∈ JF) → ( + let q : GaussianInt := v.1 - 1 - I + q ∉ S)) := by + classical + intro S I VF JF X v hleftX hdownJ q hq + have hnot := (Finset.mem_filter.mp hdownJ).2 + apply hnot + constructor + · simpa [q, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hq + · convert hleftX using 1; ext <;> simp [I] + +private theorem graph_adj_four : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + (∀ (a : X), ∀ (b : X), G.Adj a b ↔ a ≠ b ∧ (rel a b ∨ rel b a)) → (∀ (a : X), ∀ (b : X), + (G.Adj a b) → (FourNeighborAdjacent a.1 b.1)) := by + classical + intro S I VF JF X rel G graph_adj a b hab + rw [graph_adj] at hab + rcases hab.2 with h | h <;> rcases h with h | h + · exact Or.inl h + · exact Or.inr (Or.inr (Or.inl h.1)) + · exact Or.inr (Or.inl (by rw [h]; ext <;> simp)) + · exact Or.inr (Or.inr (Or.inr (by rw [h.1]; ext <;> simp [I]))) + +private theorem path_head : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), + let path : List GaussianInt := c.support.tail.map Subtype.val + (3 ≤ path.length) → (path.head? = some c.snd.1) := by + classical + intro S I VF JF X rel G u c path path_length + have hlen : 1 < c.support.length := by + simp only [path, List.length_map, List.length_tail] at path_length + omega + simp only [path, List.head?_map, List.head?_tail] + rw [List.getElem?_eq_getElem hlen, c.support_getElem_one] + rfl + +private theorem path_last : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), + let path : List GaussianInt := c.support.tail.map Subtype.val + (3 ≤ path.length) → (path.getLast? = some u.1) := by + classical + intro S I VF JF X rel G u c path path_length + have hlen : c.support.length ≠ 1 := by + simp only [path, List.length_map, List.length_tail] at path_length + omega + simp only [path, List.getLast?_map, List.getLast?_tail, hlen, ite_false] + rw [List.getLast?_eq_getLast_of_ne_nil c.support_ne_nil, + c.getLast_support] + rfl + +private theorem path_chain : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), (∀ (a : X), ∀ (b : X), (G.Adj a b) → (FourNeighborAdjacent a.1 + b.1)) → ( + let path : List GaussianInt := c.support.tail.map Subtype.val + List.IsChain FourNeighborAdjacent path) := by + classical + intro S I VF JF X rel G u c graph_adj_four path + change List.IsChain FourNeighborAdjacent + (c.support.tail.map Subtype.val) + rw [List.isChain_map] + exact c.isChain_adj_support.tail.imp fun _ _ h => graph_adj_four _ _ h + +private theorem path_vertex_im_le : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), ∀ (v : X), (∀ (w : X), (w ∈ c.support) → (w.1.im ≤ v.1.im)) → ( + let path : List GaussianInt := c.support.tail.map Subtype.val + ∀ {z : GaussianInt}, (z ∈ path) → (z.im ≤ v.1.im)) := by + classical + intro S I VF JF X rel G u c v hv_im_max path z hz + rcases List.mem_map.mp hz with ⟨w, hw, rfl⟩ + exact hv_im_max w (List.mem_of_mem_tail hw) + +private theorem hqnonzero : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), ∀ (v : X), + let q : GaussianInt := v.1 - 1 - I + let path : List GaussianInt := c.support.tail.map Subtype.val + (GridRayCrossingIndex (q + I) path = 0) → (((GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) + path - GridRayCrossingIndex q path).natAbs = (1 : ℕ)) → (GridRayCrossingIndex q path ≠ + 0)) := by + classical + intro S I VF JF X rel G u c v q path htopzero hjump + rw [htopzero] at hjump + omega + +private theorem path_vertex_mem : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), + let path : List GaussianInt := c.support.tail.map Subtype.val + ∀ {z : GaussianInt}, (z ∈ path) → (z ∈ S) := by + classical + intro S I VF JF X rel G u c path z hz + rcases List.mem_map.mp hz with ⟨w, hw, rfl⟩ + exact w.2 + +private theorem hfarout : + ∀ (S : Finset GaussianInt), ∀ (leftmost : GaussianInt), (∀ x' ∈ S, leftmost.re ≤ x'.re) → ( + let far : GaussianInt := leftmost - 1 + far ∉ S) := by + classical + intro S leftmost hmin far hfar + have h := hmin far hfar + simp [far] at h + +private theorem houtNe : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let X := {z : GaussianInt // z ∈ S} + ∀ (v : X), + let q : GaussianInt := v.1 - 1 - I + ∀ (outsidePath : List LatticeCell), (outsidePath.head? = some q) → (outsidePath ≠ []) := by + classical + intro S I X v q outsidePath houtHead h + simp [h] at houtHead + +private theorem houtChain : + ∀ (S : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + ∀ (u : X), ∀ (c : G.Walk u u), + let path : List GaussianInt := c.support.tail.map Subtype.val + (∀ {r : GaussianInt}, ∀ {s : GaussianInt}, (r ∉ S) → ((s ∉ S) → ((FourNeighborAdjacent r s) → + (GridRayCrossingIndex r path = GridRayCrossingIndex s path)))) → (∀ (outsidePath : List + LatticeCell), (∀ z ∈ outsidePath, z ∈ (↑S : Set LatticeCell)ᶜ) → ((∀ (a : LatticeCell), ∀ + (b : LatticeCell), ∀ (l₁ : List LatticeCell), ∀ (l₂ : List LatticeCell), outsidePath = l₁ + ++ a :: b :: l₂ → FourNeighborAdjacent a b) → (List.IsChain (fun r s => + GridRayCrossingIndex r path = GridRayCrossingIndex s path) outsidePath))) := by + classical + intro S I VF JF X rel G u c path index_eq_of_outside_adj outsidePath houtMem houtAdj + rw [List.isChain_iff_forall_rel_of_append_cons_cons] + intro r s l₁ l₂ heq + apply index_eq_of_outside_adj + · exact houtMem r (by rw [heq]; simp) + · exact houtMem s (by rw [heq]; simp) + · exact houtAdj r s l₁ l₂ heq + +end HorizontalRunDetails + +theorem FiniteBiconnectedHorizontalRunTree (S : Finset GaussianInt) + (hinside : FourNeighborConnected (S : Set LatticeCell)) + (houtside : FourNeighborConnected ((S : Set LatticeCell)ᶜ)) : + let I : GaussianInt := ⟨0, 1⟩ + let R := (S.filter fun z => z - 1 ∉ S).card + let J := ((S.filter fun z => z + I ∈ S).filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S)).card + R = J + 1 := by +-- BODY + classical + dsimp only + let I : GaussianInt := ⟨0, 1⟩ + let HF : Finset GaussianInt := S.filter fun z => z - 1 ∈ S + let RF : Finset GaussianInt := S.filter fun z => z - 1 ∉ S + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S + let JF : Finset GaussianInt := VF.filter fun z => + ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) + have hpartition : S.card = HF.card + RF.card := HorizontalRunDetails.hpartition S + let X := {z : GaussianInt // z ∈ S} + let rel : X → X → Prop := fun a b => + b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) + let G : SimpleGraph X := SimpleGraph.fromRel rel + have graph_adj (a b : X) : G.Adj a b ↔ + a ≠ b ∧ (rel a b ∨ rel b a) := HorizontalRunDetails.graph_adj S a b + have horizontal_adj {z : GaussianInt} (hz : z ∈ S) (hz1 : z + 1 ∈ S) : + G.Adj ⟨z, hz⟩ ⟨z + 1, hz1⟩ := HorizontalRunDetails.horizontal_adj S graph_adj (z := z) hz hz1 + have selected_vertical_adj {z : GaussianInt} (hz : z ∈ S) + (hzI : z + I ∈ S) (hzJ : z ∈ JF) : + G.Adj ⟨z, hz⟩ ⟨z + I, hzI⟩ := HorizontalRunDetails.selected_vertical_adj S graph_adj (z := + z) hz hzI hzJ + let D := {z : GaussianInt // z ∈ HF} ⊕ {z : GaussianInt // z ∈ JF} + let edgeOf : D → G.edgeSet := fun d => match d with + | Sum.inl z => + let hz : z.1 ∈ S := (Finset.mem_filter.mp z.2).1 + let hz1 : z.1 - 1 ∈ S := (Finset.mem_filter.mp z.2).2 + ⟨s(⟨z.1 - 1, hz1⟩, ⟨z.1, hz⟩), by + rw [SimpleGraph.mem_edgeSet] + have h := horizontal_adj (z := z.1 - 1) hz1 + (by simpa [Zsqrtd.ext_iff] using hz) + simpa [Zsqrtd.ext_iff] using h⟩ + | Sum.inr z => + let hzV : z.1 ∈ VF := (Finset.mem_filter.mp z.2).1 + let hz : z.1 ∈ S := (Finset.mem_filter.mp hzV).1 + let hzI : z.1 + I ∈ S := (Finset.mem_filter.mp hzV).2 + ⟨s(⟨z.1, hz⟩, ⟨z.1 + I, hzI⟩), by + rw [SimpleGraph.mem_edgeSet] + exact selected_vertical_adj hz hzI z.2⟩ + have edgeOf_injective : Function.Injective edgeOf := HorizontalRunTreeProof.edgeOf_injective S + horizontal_adj selected_vertical_adj + have edgeOf_surjective : Function.Surjective edgeOf := HorizontalRunTreeProof.edgeOf_surjective + S graph_adj horizontal_adj selected_vertical_adj + have hedgecard : Nat.card G.edgeSet = HF.card + JF.card := HorizontalRunDetails.hedgecard S + horizontal_adj selected_vertical_adj edgeOf_injective edgeOf_surjective + rcases hinside.1 with ⟨base, hbase⟩ + rcases Finset.exists_min_image S (fun z : GaussianInt => z.re) + ⟨base, hbase⟩ with ⟨leftmost, hleftmost, hmin⟩ + have vertical_reachable : ∀ (z : GaussianInt) (hz : z ∈ S) + (hzI : z + I ∈ S), G.Reachable ⟨z, hz⟩ ⟨z + I, hzI⟩ := + HorizontalRunTreeProof.vertical_reachable S horizontal_adj selected_vertical_adj + leftmost hmin + have four_reachable {a b : GaussianInt} (ha : a ∈ S) (hb : b ∈ S) + (hab : FourNeighborAdjacent a b) : G.Reachable ⟨a, ha⟩ ⟨b, hb⟩ := + HorizontalRunTreeProof.four_reachable S horizontal_adj vertical_reachable (a := a) (b + := b) ha hb hab + have hconnected : G.Connected := HorizontalRunTreeProof.hconnected S hinside base hbase + four_reachable + have hacyclic : G.IsAcyclic := by + intro u c hc + have hsuppne : c.support.toFinset.Nonempty := by + exact ⟨u, by simp⟩ + obtain ⟨top, htop, htopmax⟩ := + Finset.exists_max_image c.support.toFinset (fun z : X => z.1.im) hsuppne + let tops : Finset X := c.support.toFinset.filter fun z => z.1.im = top.1.im + have htopsne : tops.Nonempty := HorizontalRunDetails.htopsne S u c top htop + obtain ⟨v, hvtop, hvright⟩ := + Finset.exists_max_image tops (fun z : X => z.1.re) htopsne + have hvmem : v ∈ c.support := HorizontalRunDetails.hvmem S u c top v hvtop + have hv_im_max (w : X) (hw : w ∈ c.support) : w.1.im ≤ v.1.im := + HorizontalRunDetails.hv_im_max S u c top htopmax v hvtop w hw + have hv_re_max (w : X) (hw : w ∈ c.support) + (him : w.1.im = v.1.im) : w.1.re ≤ v.1.re := HorizontalRunDetails.hv_re_max S u c top v + hvtop hvright w hw him + have neighbor_options (w : X) (hvw : c.toSubgraph.Adj v w) : + w.1 = v.1 - 1 ∨ w.1 = v.1 - I := HorizontalRunTreeProof.neighbor_options S graph_adj u c + v hv_im_max hv_re_max w hvw + obtain ⟨a, b, hab, hneighbors⟩ := Set.ncard_eq_two.mp + (hc.ncard_neighborSet_toSubgraph_eq_two hvmem) + have haedge : c.toSubgraph.Adj v a := HorizontalRunDetails.haedge S u c v a b hneighbors + have hbedge : c.toSubgraph.Adj v b := HorizontalRunDetails.hbedge S u c v a b hneighbors + have haopt := neighbor_options a haedge + have hbopt := neighbor_options b hbedge + have hpairs : + (a.1 = v.1 - 1 ∧ b.1 = v.1 - I) ∨ + (b.1 = v.1 - 1 ∧ a.1 = v.1 - I) := HorizontalRunDetails.hpairs S v a b hab haopt hbopt + have hleftX : v.1 - 1 ∈ S := HorizontalRunDetails.hleftX S v a b hpairs + have hdownX : v.1 - I ∈ S := HorizontalRunDetails.hdownX S v a b hpairs + have hleftEdge : c.toSubgraph.Adj v ⟨v.1 - 1, hleftX⟩ := HorizontalRunDetails.hleftEdge S u c + v a b haedge hbedge hpairs hleftX + have hdownEdge : c.toSubgraph.Adj v ⟨v.1 - I, hdownX⟩ := HorizontalRunDetails.hdownEdge S u c + v a b haedge hbedge hpairs hdownX + have hdownJ : v.1 - I ∈ JF := HorizontalRunTreeProof.hdownJ S graph_adj u c v hdownX hdownEdge + let q : GaussianInt := v.1 - 1 - I + have hqout : q ∉ S := HorizontalRunDetails.hqout S v hleftX hdownJ + have graph_adj_four (a b : X) (hab : G.Adj a b) : + FourNeighborAdjacent a.1 b.1 := HorizontalRunDetails.graph_adj_four S graph_adj a b hab + let path : List GaussianInt := c.support.tail.map Subtype.val + have path_nodup : path.Nodup := + hc.support_nodup.map Subtype.val_injective + have path_length : 3 ≤ path.length := by + simpa [path] using hc.three_le_length + have path_head : path.head? = some c.snd.1 := HorizontalRunDetails.path_head S u c path_length + have path_last : path.getLast? = some u.1 := HorizontalRunDetails.path_last S u c path_length + have path_chain : List.IsChain FourNeighborAdjacent path := HorizontalRunDetails.path_chain S + u c graph_adj_four + have path_close : FourNeighborAdjacent u.1 c.snd.1 := by + exact graph_adj_four _ _ (c.adj_snd hc.not_nil) + have path_zip : ∀ a b, (a, b) ∈ path.zip path.tail → + FourNeighborAdjacent a b := HorizontalRunTreeProof.path_zip S u c path_length path_chain + have index_control := GridRayCrossingIndexAdjacentCell path c.snd.1 u.1 + path_head path_last path_nodup path_length path_zip path_close + let cyclicEdges := path.zip path.tail ++ [(u.1, c.snd.1)] + have cycle_edge_oriented {x y : X} (hxy : c.toSubgraph.Adj x y) : + (x.1, y.1) ∈ cyclicEdges ∨ (y.1, x.1) ∈ cyclicEdges := + HorizontalRunTreeProof.cycle_edge_oriented S u c (x := x) (y := y) hxy + have path_vertex_im_le {z : GaussianInt} (hz : z ∈ path) : + z.im ≤ v.1.im := HorizontalRunDetails.path_vertex_im_le S u c v hv_im_max (z := z) hz + have crossing_step_zero (a b : GaussianInt) + (ha : a.im ≤ v.1.im) (hb : b.im ≤ v.1.im) : + (if b = a + ⟨0, 1⟩ ∧ a.im = (q + I).im ∧ a.re ≤ (q + I).re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = (q + I).im ∧ + a.re ≤ (q + I).re then -1 else 0) = 0 := HorizontalRunTreeProof.crossing_step_zero S + u c v a b ha hb + have htopzero : GridRayCrossingIndex (q + I) path = 0 := HorizontalRunTreeProof.htopzero S u + c hc v hv_im_max path_head path_last path_vertex_im_le crossing_step_zero + have htarget : + (q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∈ cyclicEdges ∨ + (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) ∈ cyclicEdges := HorizontalRunTreeProof.htarget S u c v + hleftX hleftEdge cycle_edge_oriented + have hjump := (index_control q).2.2.2 htarget + have hqnonzero : GridRayCrossingIndex q path ≠ 0 := HorizontalRunDetails.hqnonzero S u c v + htopzero hjump + have path_vertex_mem {z : GaussianInt} (hz : z ∈ path) : z ∈ S := + HorizontalRunDetails.path_vertex_mem S u c (z := z) hz + have cyclic_edge_occupied {r s : GaussianInt} + (hrs : (r, s) ∈ cyclicEdges) : r ∈ S ∧ s ∈ S := + HorizontalRunTreeProof.cyclic_edge_occupied S u c v path_length path_vertex_mem (r := + r) (s := s) hrs + have index_eq_of_outside_adj {r s : GaussianInt} + (hr : r ∉ S) (hs : s ∉ S) (hrs : FourNeighborAdjacent r s) : + GridRayCrossingIndex r path = GridRayCrossingIndex s path := + HorizontalRunTreeProof.index_eq_of_outside_adj S u c index_control + cyclic_edge_occupied (r := r) (s := s) hr hs hrs + let far : GaussianInt := leftmost - 1 + have hfarout : far ∉ S := HorizontalRunDetails.hfarout S leftmost hmin + obtain ⟨outsidePath, houtHead, houtLast, houtMem, houtAdj⟩ := + houtside.2 q (by simpa using hqout) far (by simpa using hfarout) + have houtNe : outsidePath ≠ [] := HorizontalRunDetails.houtNe S v outsidePath houtHead + have houtChain : List.IsChain (fun r s => + GridRayCrossingIndex r path = GridRayCrossingIndex s path) outsidePath := + HorizontalRunDetails.houtChain S u c index_eq_of_outside_adj outsidePath houtMem houtAdj + have hqfar : GridRayCrossingIndex q path = + GridRayCrossingIndex far path := HorizontalRunTreeProof.hqfar S leftmost u c v + outsidePath houtHead houtLast houtNe houtChain + have path_vertex_re_min {z : GaussianInt} (hz : z ∈ path) : + leftmost.re ≤ z.re := hmin z (path_vertex_mem hz) + have far_step_zero (a b : GaussianInt) (ha : leftmost.re ≤ a.re) : + (if b = a + ⟨0, 1⟩ ∧ a.im = far.im ∧ a.re ≤ far.re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = far.im ∧ a.re ≤ far.re + then -1 else 0) = 0 := HorizontalRunTreeProof.far_step_zero S leftmost u c v a b ha + have hfarzero : GridRayCrossingIndex far path = 0 := HorizontalRunTreeProof.hfarzero S + leftmost hmin u c path_head path_last path_vertex_re_min far_step_zero + exact hqnonzero (hqfar.trans hfarzero) + have htree : G.IsTree := ⟨hconnected, hacyclic⟩ + have hcard := htree.card_edgeFinset + have hedgecard' : Fintype.card G.edgeSet = HF.card + JF.card := by + simpa [Nat.card_eq_fintype_card] using hedgecard + rw [SimpleGraph.edgeFinset_card, hedgecard'] at hcard + have hvertexcard : Fintype.card X = S.card := by simp [X] + rw [hvertexcard] at hcard + change RF.card = JF.card + 1 + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean b/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean new file mode 100644 index 0000000000..6a6bda9491 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean @@ -0,0 +1,582 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Combinatorics.SimpleGraph.Acyclic +public import Mathlib.Combinatorics.SimpleGraph.Matching +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween + +-- [TABLET NODE: FiniteConnectedAcyclicDegreeTwoGridPath] + +/-! +# FiniteConnectedAcyclicDegreeTwoGridPath + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace GridPathProof + +private theorem hXfinite : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), (E.Finite) → ((X = {x | ∃ e ∈ E, x + ∈ e}) → (X.Finite)) := by + classical + intro X E hEfinite hendpoints + rw [hendpoints] + have heq : {x : GaussianInt | ∃ e ∈ E, x ∈ e} = + ⋃ e ∈ E, (e : Set GaussianInt) := by + ext x + simp + rw [heq] + exact hEfinite.biUnion (fun e he => e.finite_toSet) + +private theorem hXne : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), (E.Nonempty) → ((X = {x | ∃ e ∈ E, + x ∈ e}) → ((∀ e ∈ E, ∃ a b : GaussianInt, e = {a, b} ∧ FourNeighborAdjacent a b) → + (X.Nonempty))) := by + classical + intro X E hEne hendpoints hgrid + obtain ⟨e, he⟩ := hEne + obtain ⟨a, b, hab, habadj⟩ := hgrid e he + have ha : a ∈ X := by + rw [hendpoints] + exact ⟨e, he, hab ▸ by simp⟩ + exact ⟨a, ha⟩ + +private theorem vertexNonempty : + ∀ (X : Set GaussianInt), (X.Nonempty) → (Nonempty X) := by + classical + intro X hXne + exact hXne.to_subtype + +private theorem hGconn : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ((SimpleGraph.fromRel fun a b : X + => ({a.1, b.1} : Finset GaussianInt) ∈ E).Connected) → ( + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + G.Connected) := by + classical + intro X E hconnected G + exact hconnected + +private theorem hGacyc : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ((SimpleGraph.fromRel fun a b : X + => ({a.1, b.1} : Finset GaussianInt) ∈ E).IsAcyclic) → ( + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + G.IsAcyclic) := by + classical + intro X E hacyclic G + exact hacyclic + +private theorem hlengths : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + (X.Finite) → ( + let lengths : Set Nat := {n | ∃ (u v : X) (p : G.Walk u v), + p.IsPath ∧ p.length = n} + lengths.Finite) := by + classical + intro X E G hXfinite lengths + let vertexFiniteness : Fintype X := hXfinite.fintype + let edgeFiniteness : Fintype G.edgeSet := Fintype.ofFinite _ + apply Set.Finite.subset (Set.finite_le_nat G.edgeFinset.card) + intro n hn + obtain ⟨u', v', p', hp', rfl⟩ := hn + exact hp'.isTrail.length_le_card_edgeFinset + +private theorem hmax : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + let lengths : Set Nat := {n | ∃ (u v : X) (p : G.Walk u v), + p.IsPath ∧ p.length = n} + ∀ (n : ℕ), (∀ ⦃y : ℕ⦄, (fun (x : ℕ) => x ∈ lengths) y → n ≤ y → y ≤ n) → (∀ (u : (↑X : + Type)), ∀ (v : (↑X : Type)), ∀ (p : G.Walk u v), (p.length = n) → (∀ (u' : X), ∀ (v' : + X), ∀ (p' : G.Walk u' v'), (p'.IsPath) → (p'.length ≤ p.length))) := by + classical + intro X E G lengths n hnl u v p hp_len u' v' p' hp' + have hm := hnl ⟨u', v', p', hp', rfl⟩ + lia + +private theorem hlong : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), (E.Nonempty) → ((X = {x | ∃ e ∈ E, + x ∈ e}) → ((∀ e ∈ E, ∃ a b : GaussianInt, e = {a, b} ∧ FourNeighborAdjacent a b) → ( + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + ∀ (u : (↑X : Type)), ∀ (v : (↑X : Type)), ∀ (p : G.Walk u v), (∀ (u' : X), ∀ (v' : X), ∀ (p' + : G.Walk u' v'), (p'.IsPath) → (p'.length ≤ p.length)) → (0 < p.length)))) := by + classical + intro X E hEne hendpoints hgrid G u v p hmax + obtain ⟨e, he⟩ := hEne + obtain ⟨a, b, hab, habadj⟩ := hgrid e he + have ha : a ∈ X := by + rw [hendpoints] + exact ⟨e, he, hab ▸ by simp⟩ + have hb : b ∈ X := by + rw [hendpoints] + exact ⟨e, he, hab ▸ by simp⟩ + have habne : (⟨a, ha⟩ : X) ≠ ⟨b, hb⟩ := by + intro heq + have : a = b := congrArg Subtype.val heq + subst b + change a = a + 1 ∨ a = a - 1 ∨ a = a + ⟨0, 1⟩ ∨ a = a - ⟨0, 1⟩ at habadj + rcases habadj with h | h | h | h + · have hc : a + 0 = a + 1 := (add_zero a).trans h + have hz : (0 : GaussianInt) = 1 := add_left_cancel hc + exact one_ne_zero hz.symm + · have hc : a + 0 = a + (-1) := (add_zero a).trans (h.trans (sub_eq_add_neg a 1)) + have hz : (0 : GaussianInt) = -1 := add_left_cancel hc + have hc' := congrArg (fun z : GaussianInt => z + 1) hz + norm_num at hc' + · have hc := congrArg (fun z : GaussianInt => z - a) h + have hi := congrArg Zsqrtd.im hc + norm_num at hi + · have hc := congrArg (fun z : GaussianInt => z - a) h + have hi := congrArg Zsqrtd.im hc + norm_num at hi + have hadj : G.Adj (⟨a, ha⟩ : X) ⟨b, hb⟩ := by + change (⟨a, ha⟩ : X) ≠ ⟨b, hb⟩ ∧ + (({a, b} : Finset GaussianInt) ∈ E ∨ ({b, a} : Finset GaussianInt) ∈ E) + exact ⟨habne, Or.inl (by simpa [← hab] using he)⟩ + have hpath : (SimpleGraph.Walk.cons hadj SimpleGraph.Walk.nil).IsPath := + SimpleGraph.Walk.IsPath.of_adj hadj + have hm := hmax _ _ _ hpath + simpa [Nat.lt_iff_add_one_le] using hm + +private theorem hboundary : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), (∀ v : X, Set.ncard + ((SimpleGraph.fromRel fun a b : X => ({a.1, b.1} : Finset GaussianInt) ∈ E).neighborSet + v) ≤ 2) → ( + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + (X.Finite) → ( + (ℕ) → (∀ (u : (↑X : Type)), ∀ (v : (↑X : Type)), ∀ (p : G.Walk u v), (p.IsPath) → ((∀ (u' : + X), ∀ (v' : X), ∀ (p' : G.Walk u' v'), (p'.IsPath) → (p'.length ≤ p.length)) → (∀ z : X, + z ∈ p.support → + ∀ w : X, G.Adj z w → w ∈ p.support))))) := by + classical + intro X E hdegree G hXfinite n u v p hp hmax + let vertexFiniteness : Fintype X := hXfinite.fintype + intro z hz w hzw + by_contra hwo + obtain ⟨q, r, hq, hr, hpqr⟩ := hp.mem_support_iff_exists_append.mp hz + by_cases hqn : q.Nil + · have hzu : z = u := by exact (hq.nil_iff_eq.mp hqn).symm + subst z + have hpc : (p.cons hzw.symm).IsPath := hp.cons hwo + have hm := hmax w v (p.cons hzw.symm) hpc + simp only [SimpleGraph.Walk.length_cons] at hm + omega + · by_cases hrn : r.Nil + · have hzv : z = v := hr.nil_iff_eq.mp hrn + subst z + have hpc : (p.concat hzw).IsPath := hp.concat hwo hzw + have hm := hmax u w (p.concat hzw) hpc + simp only [SimpleGraph.Walk.length_concat] at hm + omega + · have hleft : G.Adj q.penultimate z := q.adj_penultimate hqn + have hright : G.Adj z r.snd := r.adj_snd hrn + have hqp : q.penultimate ∈ q.support := by + apply q.getVert_mem_support + have hrp : r.snd ∈ r.support.tail := r.snd_mem_tail_support hrn + have hrp' : r.snd ∈ r.tail.support := by + simpa [SimpleGraph.Walk.support_tail_of_not_nil r hrn] using hrp + have hne : q.penultimate ≠ r.snd := by + intro heq + have happ : (q.append r).IsPath := hpqr ▸ hp + have hd := happ.disjoint_support_of_append hrn + apply hd hqp + simpa only [heq] using hrp' + have hqp0 : q.penultimate ∈ p.support := by + rw [hpqr] + simp [SimpleGraph.Walk.support_append, hqp] + have hrp0 : r.snd ∈ p.support := by + rw [hpqr] + simp [SimpleGraph.Walk.support_append, hrp] + have hqw : q.penultimate ≠ w := by + intro heq + exact hwo (heq ▸ hqp0) + have hrw : r.snd ≠ w := by + intro hrw + exact hwo (hrw ▸ hrp0) + have hsub : ({q.penultimate, r.snd, w} : Set X) ⊆ G.neighborSet z := by + intro t ht + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at ht + rcases ht with rfl | rfl | rfl + · exact show G.Adj z q.penultimate from hleft.symm + · exact hright + · exact hzw + have hcard : Set.ncard ({q.penultimate, r.snd, w} : Set X) = 3 := by + simp [hne, hqw, hrw] + have hc := Set.ncard_mono hsub + rw [hcard] at hc + have hd := hdegree z + change (G.neighborSet z).ncard ≤ 2 at hd + exact (by omega) + +private theorem hall : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + (G.Connected) → (∀ (u : (↑X : Type)), ∀ (v : (↑X : Type)), ∀ (p : G.Walk u v), (∀ z : X, z ∈ + p.support → ∀ w : X, G.Adj z w → w ∈ p.support) → (∀ (x : X), x ∈ p.support)) := by + classical + intro X E G hGconn u v p hboundary + have hwalk : ∀ {a b : X} (q : G.Walk a b), + a ∈ p.support → ∀ t, t ∈ q.support → t ∈ p.support := by + intro a b q + induction q with + | nil => + intro ha t ht + simp only [SimpleGraph.Walk.support_nil, List.mem_singleton] at ht + subst t + exact ha + | @cons a b c hadj q ih => + intro ha t ht + simp only [SimpleGraph.Walk.support_cons, List.mem_cons] at ht + rcases ht with rfl | ht + · exact ha + · exact ih (hboundary a ha b hadj) t ht + intro x + obtain ⟨q⟩ := hGconn u x + exact hwalk q p.start_mem_support x q.end_mem_support + +private theorem hsupport : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + ∀ (u : (↑X : Type)), ∀ (v : (↑X : Type)), ∀ (p : G.Walk u v), (∀ (x : X), x ∈ p.support) → + ({x : X | x ∈ p.support} = Set.univ) := by + classical + intro X E G u v p hall + apply Set.eq_univ_of_forall + exact hall + +private theorem hLnodup : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + ∀ (u : (↑X : Type)), ∀ (v : (↑X : Type)), ∀ (p : G.Walk u v), (p.IsPath) → ( + let L : List GaussianInt := p.support.map Subtype.val + L.Nodup) := by + classical + intro X E G u v p hp L + exact hp.support_nodup.map Subtype.val_injective + +private theorem hLlen : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + ∀ (u : (↑X : Type)), ∀ (v : (↑X : Type)), ∀ (p : G.Walk u v), + let L : List GaussianInt := p.support.map Subtype.val + L.length = p.length + 1 := by + classical + intro X E G u v p L + simp [L, SimpleGraph.Walk.length_support] + +private theorem hLchain : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + ∀ (u : (↑X : Type)), ∀ (v : (↑X : Type)), ∀ (p : G.Walk u v), + let L : List GaussianInt := p.support.map Subtype.val + List.IsChain (fun a b : GaussianInt => + ({a, b} : Finset GaussianInt) ∈ E) L := by + classical + intro X E G u v p L + rw [List.isChain_map] + apply p.isChain_adj_support.imp + intro a b hab + change a ≠ b ∧ + (({a.1, b.1} : Finset GaussianInt) ∈ E ∨ + ({b.1, a.1} : Finset GaussianInt) ∈ E) at hab + exact hab.2.elim id (by simp [Finset.pair_comm]) + +private theorem hgridstep : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), (X = {x | ∃ e ∈ E, x ∈ e}) → ((∀ e + ∈ E, ∃ a b : GaussianInt, e = {a, b} ∧ FourNeighborAdjacent a b) → (((SimpleGraph.fromRel + fun a b : X => ({a.1, b.1} : Finset GaussianInt) ∈ E).Connected) → (((SimpleGraph.fromRel + fun a b : X => ({a.1, b.1} : Finset GaussianInt) ∈ E).IsAcyclic) → ((∀ v : X, Set.ncard + ((SimpleGraph.fromRel fun a b : X => ({a.1, b.1} : Finset GaussianInt) ∈ E).neighborSet + v) ≤ 2) → ( + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + (X.Finite) → ((X.Nonempty) → ((G.Connected) → ((G.IsAcyclic) → ( + let lengths : Set Nat := {n | ∃ (u v : X) (p : G.Walk u v), + p.IsPath ∧ p.length = n} + (lengths.Finite) → (∀ (n : ℕ), (∀ ⦃y : ℕ⦄, (fun (x : ℕ) => x ∈ lengths) y → n ≤ y → y ≤ n) → + (∀ (u : (↑X : Type)), ∀ (v : (↑X : Type)), ∀ (p : G.Walk u v), (p.IsPath) → ((p.length = + n) → ((∀ (u' : X), ∀ (v' : X), ∀ (p' : G.Walk u' v'), (p'.IsPath) → (p'.length ≤ + p.length)) → ((0 < p.length) → ((∀ z : X, z ∈ p.support → ∀ w : X, G.Adj z w → w ∈ + p.support) → ((∀ (x : X), x ∈ p.support) → (({x : X | x ∈ p.support} = Set.univ) → ( + let L : List GaussianInt := p.support.map Subtype.val + (L.Nodup) → ((L.length = p.length + 1) → ((List.IsChain (fun a b : GaussianInt => ({a, b} : + Finset GaussianInt) ∈ E) L) → (∀ a b : GaussianInt, + ({a, b} : Finset GaussianInt) ∈ E → FourNeighborAdjacent a b))))))))))))))))))))) := by + classical + intro X E hendpoints hgrid hconnected hacyclic hdegree G hXfinite hXne hGconn hGacyc lengths + hlengths n hnl u v p hp hp_len hmax hlong hboundary hall hsupport L hLnodup hLlen hLchain + have hsymm : ∀ a b : GaussianInt, FourNeighborAdjacent a b → + FourNeighborAdjacent b a := by + intro a b h + unfold FourNeighborAdjacent at h ⊢ + rcases h with h | h | h | h + · right; left + have hh := congrArg (fun z : GaussianInt => z - 1) h + simpa [sub_eq_add_neg, add_comm, add_left_comm, add_assoc] using hh.symm + · left + have hh := congrArg (fun z : GaussianInt => z + 1) h + simpa [sub_eq_add_neg, add_comm, add_left_comm, add_assoc] using hh.symm + · right; right; right + have hh := congrArg (fun z : GaussianInt => z - ⟨0, 1⟩) h + simpa [sub_eq_add_neg, add_comm, add_left_comm, add_assoc] using hh.symm + · right; right; left + have hh := congrArg (fun z : GaussianInt => z + ⟨0, 1⟩) h + simpa [sub_eq_add_neg, add_comm, add_left_comm, add_assoc] using hh.symm + intro a b he + obtain ⟨c, d, hcd, hfour⟩ := hgrid _ he + have hpairs : ({a, b} : Finset GaussianInt) = {c, d} := hcd ▸ rfl + have hpairs' : c = a ∧ d = b ∨ c = b ∧ d = a := by + simp only [Finset.ext_iff, Finset.mem_insert, Finset.mem_singleton] at hpairs + have hc := (hpairs c).mpr (by simp) + have hd := (hpairs d).mpr (by simp) + have ha := (hpairs a).mp (by simp) + have hb := (hpairs b).mp (by simp) + clear hpairs + rcases hc with hc | hc <;> rcases hd with hd | hd <;> + rcases ha with ha | ha <;> rcases hb with hb | hb <;> + subst_vars <;> simp_all only [or_true, true_or, + eq_self, and_self] + rcases hpairs' with ⟨hc, hd⟩ | ⟨hc, hd⟩ + · subst c; subst d; exact hfour + · subst c; subst d + exact hsymm _ _ hfour + +private theorem hstep : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + ∀ (u : (↑X : Type)), ∀ (v : (↑X : Type)), ∀ (p : G.Walk u v), + let L : List GaussianInt := p.support.map Subtype.val + (List.IsChain (fun a b : GaussianInt => ({a, b} : Finset GaussianInt) ∈ E) L) → ((∀ a b : + GaussianInt, ({a, b} : Finset GaussianInt) ∈ E → FourNeighborAdjacent a b) → (∀ a b : + GaussianInt, ∀ l₁ l₂ : List GaussianInt, + L = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b)) := by + classical + intro X E G u v p L hLchain hgridstep a b l₁ l₂ h + have hc := (List.isChain_iff_forall_rel_of_append_cons_cons.mp hLchain) h + exact hgridstep a b hc + +private theorem hset : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + ∀ (u : (↑X : Type)), ∀ (v : (↑X : Type)), ∀ (p : G.Walk u v), (∀ (x : X), x ∈ p.support) → ( + let L : List GaussianInt := p.support.map Subtype.val + (L.toFinset : Set GaussianInt) = X) := by + classical + intro X E G u v p hall L + ext a + constructor + · intro ha + have hz : a ∈ L := by simpa using ha + obtain ⟨z, hz, hza⟩ := List.mem_map.mp hz + have haX : a ∈ X := by simpa [hza] using z.property + exact haX + · intro ha + let z : X := ⟨a, ha⟩ + have hz : z ∈ p.support := hall z + apply List.mem_toFinset.mpr + exact List.mem_map.mpr ⟨z, hz, rfl⟩ + +private theorem hconsecutive : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + (G.IsAcyclic) → (∀ (u : (↑X : Type)), ∀ (v : (↑X : Type)), ∀ (p : G.Walk u v), (p.IsPath) → + ((∀ (x : X), x ∈ p.support) → (∀ {a : X}, ∀ {b : X}, G.Adj a b → + ∃ l₁ l₂ : List X, p.support = l₁ ++ a :: b :: l₂ ∨ + p.support = l₁ ++ b :: a :: l₂))) := by + classical + intro X E G hGacyc u v p hp hall a b hab + obtain ⟨q, r, hq, hr, hpqr⟩ := + hp.mem_support_iff_exists_append.mp (hall b) + have haa : a ∈ q.support ∨ a ∈ r.support := by + have haa' := hall a + rw [hpqr] at haa' + have haa'' : a ∈ q.support ∨ a ∈ r.support.tail := by + simpa [SimpleGraph.Walk.support_append] using haa' + exact haa''.imp id (fun h => List.mem_of_mem_tail h) + rcases haa with haa | haa + · obtain ⟨q₁, q₂, hq₁, hq₂, hqq⟩ := + hq.mem_support_iff_exists_append.mp haa + have heq : q₂ = hab.toWalk := by + exact congrArg Subtype.val + ((hGacyc.subsingleton_path a b).elim ⟨q₂, hq₂⟩ + ⟨hab.toWalk, hab.isPath_toWalk⟩) + refine ⟨q₁.support.dropLast, r.support.tail, Or.inl ?_⟩ + rw [hpqr, hqq, heq] + rw [SimpleGraph.Walk.support_append, + SimpleGraph.Walk.support_append_eq_support_dropLast_append, + hab.support_toWalk] + simp only [List.cons_append, List.nil_append, List.append_assoc] + · obtain ⟨r₁, r₂, hr₁, hr₂, hrr⟩ := + hr.mem_support_iff_exists_append.mp haa + have heq : r₁ = hab.symm.toWalk := by + exact congrArg Subtype.val + ((hGacyc.subsingleton_path b a).elim ⟨r₁, hr₁⟩ + ⟨hab.symm.toWalk, hab.symm.isPath_toWalk⟩) + refine ⟨q.support.dropLast, r₂.support.tail, Or.inr ?_⟩ + rw [hpqr, hrr, heq] + rw [SimpleGraph.Walk.support_append, SimpleGraph.Walk.support_append, + hab.symm.support_toWalk] + have hqend : q.support.dropLast ++ [b] = q.support := by + simpa only [q.getLast_support] using + (List.dropLast_append_getLast q.support_ne_nil) + have htail : ([b, a] ++ r₂.support.tail).tail = a :: r₂.support.tail := by + rfl + rw [htail] + conv_lhs => rw [← hqend] + simp only [List.cons_append, List.nil_append, List.append_assoc] + +end GridPathProof + +theorem FiniteConnectedAcyclicDegreeTwoGridPath + (X : Set GaussianInt) (E : Set (Finset GaussianInt)) + (hEfinite : E.Finite) (hEne : E.Nonempty) + (hendpoints : X = {x | ∃ e ∈ E, x ∈ e}) + (hgrid : ∀ e ∈ E, ∃ a b : GaussianInt, + e = {a, b} ∧ FourNeighborAdjacent a b) + (hconnected : + (SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E).Connected) + (hacyclic : + (SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E).IsAcyclic) + (hdegree : ∀ v : X, + Set.ncard ((SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E).neighborSet v) ≤ 2) : + ∃ x y : GaussianInt, SimpleGridPathBetween X E x y := by +-- BODY + let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => + ({a.1, b.1} : Finset GaussianInt) ∈ E + have hXfinite : X.Finite := GridPathProof.hXfinite X E hEfinite hendpoints + let vertexFiniteness : Fintype X := hXfinite.fintype + have hXne : X.Nonempty := GridPathProof.hXne X E hEne hendpoints hgrid + let vertexNonempty : Nonempty X := GridPathProof.vertexNonempty X hXne + let pairFiniteness : Fintype (Sym2 X) := Fintype.ofFinite _ + let edgeFiniteness : Fintype G.edgeSet := Fintype.ofFinite _ + have hGconn : G.Connected := GridPathProof.hGconn X E hconnected + have hGacyc : G.IsAcyclic := GridPathProof.hGacyc X E hacyclic + let lengths : Set Nat := {n | ∃ (u v : X) (p : G.Walk u v), + p.IsPath ∧ p.length = n} + have hlengths : lengths.Finite := GridPathProof.hlengths X E hXfinite + obtain ⟨n, hn, hnl⟩ := hlengths.exists_maximal + ⟨0, ⟨Classical.choice (inferInstance : Nonempty X), + Classical.choice (inferInstance : Nonempty X), SimpleGraph.Walk.nil, + SimpleGraph.Walk.IsPath.nil, by simp⟩⟩ + obtain ⟨u, v, p, hp, hp_len⟩ := hn + have hmax : ∀ (u' v' : X) (p' : G.Walk u' v') (_ : p'.IsPath), + p'.length ≤ p.length := GridPathProof.hmax X E n hnl u v p hp_len + have hlong : 0 < p.length := GridPathProof.hlong X E hEne hendpoints hgrid u v p hmax + have hboundary : ∀ z : X, z ∈ p.support → + ∀ w : X, G.Adj z w → w ∈ p.support := GridPathProof.hboundary X E hdegree hXfinite n u v p + hp hmax + have hall : ∀ (x : X), x ∈ p.support := GridPathProof.hall X E hGconn u v p hboundary + have hsupport : {x : X | x ∈ p.support} = Set.univ := GridPathProof.hsupport X E u v p hall + let L : List GaussianInt := p.support.map Subtype.val + have hLnodup : L.Nodup := GridPathProof.hLnodup X E u v p hp + have hLlen : L.length = p.length + 1 := GridPathProof.hLlen X E u v p + have hLchain : List.IsChain (fun a b : GaussianInt => + ({a, b} : Finset GaussianInt) ∈ E) L := GridPathProof.hLchain X E u v p + have hgridstep : ∀ a b : GaussianInt, + ({a, b} : Finset GaussianInt) ∈ E → FourNeighborAdjacent a b := GridPathProof.hgridstep X E + hendpoints hgrid hconnected hacyclic hdegree hXfinite hXne hGconn hGacyc hlengths n hnl + u v p hp hp_len hmax hlong hboundary hall hsupport hLnodup hLlen hLchain + have hstep : ∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + L = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b := GridPathProof.hstep X E u v p hLchain + hgridstep + have hset : (L.toFinset : Set GaussianInt) = X := GridPathProof.hset X E u v p hall + have hconsecutive : ∀ {a b : X}, G.Adj a b → + ∃ l₁ l₂ : List X, p.support = l₁ ++ a :: b :: l₂ ∨ + p.support = l₁ ++ b :: a :: l₂ := GridPathProof.hconsecutive X E hGacyc u v p hp hall + refine ⟨u.1, v.1, ?_⟩ + refine ⟨L, hLnodup, ?_, ?_, ?_, ?_, ?_⟩ + · rw [hLlen] + omega + · change (p.support.map Subtype.val).head? = some u.1 + rw [List.head?_map, List.head?_eq_some_head p.support_ne_nil, p.head_support] + rfl + · have hLn : L ≠ [] := by + intro hnil + have hz : L.length = 0 := by simp [hnil] + rw [hLlen] at hz + omega + have hlast : L.getLast hLn = Subtype.val (p.support.getLast p.support_ne_nil) := by + exact List.getLast_map hLn + rw [List.getLast?_eq_some_getLast hLn, hlast] + exact congrArg (fun z => some z) (congrArg Subtype.val p.getLast_support) + · exact hset.symm + · refine ⟨hstep, ?_⟩ + intro e + constructor + · intro he + obtain ⟨a, b, hab, hfour⟩ := hgrid e he + have ha : a ∈ X := by + rw [hendpoints] + exact ⟨e, he, hab ▸ by simp⟩ + have hb : b ∈ X := by + rw [hendpoints] + exact ⟨e, he, hab ▸ by simp⟩ + let a' : X := ⟨a, ha⟩ + let b' : X := ⟨b, hb⟩ + have habne : a ≠ b := by + intro hz + subst b + unfold FourNeighborAdjacent at hfour + rcases hfour with h | h | h | h + · have hc : a + 0 = a + 1 := (add_zero a).trans h + have hz' : (0 : GaussianInt) = 1 := add_left_cancel hc + exact one_ne_zero hz'.symm + · have hc : a + 0 = a + (-1) := (add_zero a).trans (h.trans (sub_eq_add_neg a 1)) + have hz' : (0 : GaussianInt) = -1 := add_left_cancel hc + have hc' := congrArg (fun z : GaussianInt => z + 1) hz' + norm_num at hc' + · have hc := congrArg (fun z : GaussianInt => z - a) h + have hi := congrArg Zsqrtd.im hc + norm_num at hi + · have hc := congrArg (fun z : GaussianInt => z - a) h + have hi := congrArg Zsqrtd.im hc + norm_num at hi + have hadj : G.Adj a' b' := by + change a' ≠ b' ∧ _ + have he' : ({a, b} : Finset GaussianInt) ∈ E := by + simpa [← hab] using he + exact ⟨by + intro heq + exact habne (congrArg Subtype.val heq), + Or.inl (by simpa [a', b'] using he')⟩ + obtain ⟨l₁, l₂, hs | hs⟩ := hconsecutive hadj + · refine ⟨a, b, l₁.map Subtype.val, l₂.map Subtype.val, ?_, hab⟩ + simp [a', b', L, hs, List.map_append] + · refine ⟨b, a, l₁.map Subtype.val, l₂.map Subtype.val, ?_, ?_⟩ + · simp [a', b', L, hs, List.map_append] + · simpa [Finset.pair_comm] using hab + · intro he + obtain ⟨a, b, l₁, l₂, hs, he⟩ := he + rw [he] + exact (List.isChain_iff_forall_rel_of_append_cons_cons.mp hLchain) hs + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FiniteConnectedCellSetNoCheckerboard.lean b/LeanPool/ApollonianSuperharmonic/FiniteConnectedCellSetNoCheckerboard.lean new file mode 100644 index 0000000000..b766e7a70f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FiniteConnectedCellSetNoCheckerboard.lean @@ -0,0 +1,201 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex +public import Mathlib.Data.List.Chain +public import Mathlib.Tactic.Abel + +-- [TABLET NODE: FiniteConnectedCellSetNoCheckerboard] + +/-! +# FiniteConnectedCellSetNoCheckerboard + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FiniteConnectedCellSetNoCheckerboard (S : Finset LatticeCell) + (hinside : FourNeighborConnected (S : Set LatticeCell)) + (houtside : FourNeighborConnected ((S : Set LatticeCell)ᶜ)) : + NoCheckerboardCellVertex (S : Set LatticeCell) := by +-- BODY + -- Signed horizontal-ray intersections, with multiplicity. + let ray (q a b : GaussianInt) : Int := + if a.re ≤ q.re ∧ a.re = b.re then + if a.im = q.im ∧ b.im = q.im + 1 then 1 + else if b.im = q.im ∧ a.im = q.im + 1 then -1 else 0 + else 0 + let potential (q a : GaussianInt) : Int := + if a.im = q.im + 1 ∧ a.re ≤ q.re then 1 else 0 + let weight (p : List GaussianInt) (q : GaussianInt) : Int := + (List.zipWith (ray q) p p.tail).sum + -- The rectilinear closing arc SW -> NW -> NE adds this vertical term. + let correction (z q : GaussianInt) : Int := + if q.im = z.im - 1 ∧ z.re - 1 ≤ q.re then 1 else 0 + have eq_iff (a b : GaussianInt) : a = b ↔ a.re = b.re ∧ a.im = b.im := by + constructor + · rintro rfl + simp + · rintro ⟨hr, hi⟩ + exact Zsqrtd.ext hr hi + have edge_east (q a b : GaussianInt) (hab : FourNeighborAdjacent a b) + (ha : a ≠ q + 1) (hb : b ≠ q + 1) : + ray (q + 1) a b = ray q a b := by + rcases hab with (rfl | rfl | rfl | rfl) <;> + simp only [ray, ne_eq, eq_iff, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] at ha hb ⊢ <;> omega + have edge_north (q a b : GaussianInt) (hab : FourNeighborAdjacent a b) + (ha : a ≠ q + ⟨0, 1⟩) (hb : b ≠ q + ⟨0, 1⟩) : + ray (q + ⟨0, 1⟩) a b - ray q a b = potential q a - potential q b := by + rcases hab with (rfl | rfl | rfl | rfl) <;> + simp only [ray, potential, ne_eq, eq_iff, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] at ha hb ⊢ <;> omega + have telescope (p : List GaussianInt) (x y : GaussianInt) + (f g : GaussianInt → GaussianInt → Int) (t : GaussianInt → Int) + (hhead : p.head? = some x) (hlast : p.getLast? = some y) + (hc : p.IsChain (fun a b => f a b - g a b = t a - t b)) : + (List.zipWith f p p.tail).sum - (List.zipWith g p p.tail).sum = t x - t y := by + induction p generalizing x y with + | nil => simp at hhead + | cons a p ih => + cases p with + | nil => + simp at hhead hlast + subst x + subst y + simp + | cons b p => + simp only [List.head?_cons, Option.some.injEq] at hhead + subst x + have htail : (b :: p).getLast? = some y := by simpa using hlast + have hc' := List.isChain_cons_cons.mp hc + have hi := ih b y rfl htail hc'.2 + simp only [List.tail_cons, List.zipWith_cons_cons, List.sum_cons] + simp only [List.tail_cons] at hi + omega + have east_correction (z q : GaussianInt) (h : q + 1 ≠ z - 1 - ⟨0, 1⟩) : + correction z (q + 1) = correction z q := by + simp [correction, eq_iff] at h ⊢ + omega + have north_correction (z q : GaussianInt) (h : q ≠ z - 1 - ⟨0, 1⟩) : + correction z (q + ⟨0, 1⟩) - correction z q + + potential q z - potential q (z - 1 - ⟨0, 1⟩) = 0 := by + simp [correction, potential, eq_iff] at h ⊢ + omega + have constant_path (p : List GaussianInt) (x y : GaussianInt) + (f : GaussianInt → Int) (hh : p.head? = some x) (hl : p.getLast? = some y) + (hc : p.IsChain (fun a b => f a = f b)) : f x = f y := by + induction p generalizing x y with + | nil => simp at hh + | cons a p ih => + cases p with + | nil => + simp at hh hl + subst x + subst y + rfl + | cons b p => + simp only [List.head?_cons, Option.some.injEq] at hh + subst x + have ht : (b :: p).getLast? = some y := by simpa using hl + have hc' := List.isChain_cons_cons.mp hc + exact hc'.1.trans (ih b y rfl ht hc'.2) + -- Complementary steps avoid occupied edges; the closing term restores + -- invariance of the open-walk ray count. + have separation (S : Set LatticeCell) (hi : FourNeighborConnected S) + (ho : FourNeighborConnected Sᶜ) (z : GaussianInt) + (hne : z ∈ S) (hsw : z - 1 - ⟨0, 1⟩ ∈ S) + (hnw : z - 1 ∉ S) (hse : z - ⟨0, 1⟩ ∉ S) : False := by + obtain ⟨p, hh, hl, hm, ha⟩ := hi.2 z hne (z - 1 - ⟨0, 1⟩) hsw + have hc : p.IsChain FourNeighborAdjacent := + List.isChain_iff_forall_rel_of_append_cons_cons.mpr (by + intro a b l₁ l₂ h + exact ha a b l₁ l₂ h) + have east : ∀ q, q + 1 ∉ S → weight p (q + 1) = weight p q := by + intro q hq + have ht := telescope p z (z - 1 - ⟨0, 1⟩) (ray (q + 1)) (ray q) + (fun _ => 0) hh hl (hc.imp_of_mem_imp (by + intro a b ham hbm hab + have he := edge_east q a b hab + (fun he => hq (he ▸ hm a ham)) (fun he => hq (he ▸ hm b hbm)) + simp only [he, sub_self])) + unfold weight + omega + have north : ∀ q, q + ⟨0, 1⟩ ∉ S → + weight p (q + ⟨0, 1⟩) - weight p q = + potential q z - potential q (z - 1 - ⟨0, 1⟩) := by + intro q hq + apply telescope p z (z - 1 - ⟨0, 1⟩) _ _ _ hh hl + apply hc.imp_of_mem_imp + intro a b ham hbm hab + exact edge_north q a b hab + (fun he => hq (he ▸ hm a ham)) (fun he => hq (he ▸ hm b hbm)) + let f : GaussianInt → Int := fun q => weight p q + correction z q + have fe : ∀ q, q + 1 ∉ S → f (q + 1) = f q := by + intro q hq + have hn : q + 1 ≠ z - 1 - ⟨0, 1⟩ := fun he => hq (he ▸ hsw) + dsimp [f] + rw [east q hq, east_correction z q hn] + have fn : ∀ q, q ∉ S → q + ⟨0, 1⟩ ∉ S → f (q + ⟨0, 1⟩) = f q := by + intro q hq hq' + have hn : q ≠ z - 1 - ⟨0, 1⟩ := fun he => hq (he ▸ hsw) + have hw := north q hq' + have ht := north_correction z q hn + dsimp [f] + omega + obtain ⟨r, rh, rl, rm, ra⟩ := ho.2 (z - 1) hnw (z - ⟨0, 1⟩) hse + have rc : r.IsChain FourNeighborAdjacent := + List.isChain_iff_forall_rel_of_append_cons_cons.mpr (by + intro a b l₁ l₂ h + exact ra a b l₁ l₂ h) + have heq : f (z - 1) = f (z - ⟨0, 1⟩) := by + apply constant_path r _ _ f rh rl + apply rc.imp_of_mem_imp + intro a b ham hbm hab + have ha' : a ∉ S := rm a ham + have hb' : b ∉ S := rm b hbm + rcases hab with (rfl | rfl | rfl | rfl) + · exact (fe a hb').symm + · have he : a - 1 + 1 = a := by abel + have ht := fe (a - 1) (by rwa [he]) + rwa [he] at ht + · exact (fn a ha' hb').symm + · have he : a - ⟨0, 1⟩ + ⟨0, 1⟩ = a := by abel + have ht := fn (a - ⟨0, 1⟩) hb' (by rwa [he]) + rwa [he] at ht + have he : z - 1 - ⟨0, 1⟩ + 1 = z - ⟨0, 1⟩ := by abel + have hn : z - 1 - ⟨0, 1⟩ + ⟨0, 1⟩ = z - 1 := by abel + have we := east (z - 1 - ⟨0, 1⟩) (by rwa [he]) + rw [he] at we + have wn := north (z - 1 - ⟨0, 1⟩) (by rwa [hn]) + rw [hn] at wn + have hp : potential (z - 1 - ⟨0, 1⟩) z = 0 := by + simp [potential] + have hp' : potential (z - 1 - ⟨0, 1⟩) (z - 1 - ⟨0, 1⟩) = 0 := by + simp [potential] + have cn : correction z (z - 1) = 0 := by + simp [correction] + omega + have cs : correction z (z - ⟨0, 1⟩) = 1 := by simp [correction] + dsimp [f] at heq + rw [hp, hp'] at wn + rw [cn, cs] at heq + omega + intro z h + rcases h with ⟨hne, hsw, hnw, hse⟩ | ⟨hnw, hse, hne, hsw⟩ + · exact separation _ hinside houtside z hne hsw hnw hse + · exact separation _ houtside (by simpa using hinside) z hne hsw + (by simpa using hnw) (by simpa using hse) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FiniteCycleComponentList.lean b/LeanPool/ApollonianSuperharmonic/FiniteCycleComponentList.lean new file mode 100644 index 0000000000..0d7a8e1314 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FiniteCycleComponentList.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Combinatorics.SimpleGraph.Matching +public import LeanPool.ApollonianSuperharmonic.Preamble + +/-! +# FiniteCycleComponentList + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open scoped Sym2 + +-- [TABLET NODE: FiniteCycleComponentList] +theorem FiniteCycleComponentList + {V : Type*} [Finite V] [DecidableEq V] + (G : SimpleGraph V) (hG : G.IsCycles) + (c : G.ConnectedComponent) (v : V) (hv : v ∈ c.supp) + (hn : (G.neighborSet v).Nonempty) : + ∃ (p : List V) (x y : V), + p.Nodup ∧ 3 ≤ p.length ∧ + p.head? = some x ∧ p.getLast? = some y ∧ + (p.toFinset : Set V) = c.supp ∧ + G.Adj y x ∧ List.IsChain G.Adj p ∧ + ∀ a b, a ∈ c.supp → + (G.Adj a b ↔ + s(a, b) = s(y, x) ∨ + s(a, b) ∈ List.zipWith (s(·, ·)) p p.tail) := by +-- BODY + classical + let : Fintype V := Fintype.ofFinite V + obtain ⟨w, hwcycle, hwverts⟩ := + hG.exists_cycle_toSubgraph_verts_eq_connectedComponentSupp hv hn + cases w with + | nil => exact (hwcycle.not_nil .nil).elim + | @cons u w x hadj q => + refine ⟨q.support, w, v, hwcycle.support_nodup, ?_, ?_, ?_, ?_, hadj, ?_, ?_⟩ + · simpa using hwcycle.three_le_length + · cases q <;> simp + · exact List.getLast?_eq_some_iff.2 + ⟨q.support.dropLast, q.dropLast_support_concat.symm⟩ + · ext z + simp only [Finset.mem_coe, List.mem_toFinset] + rw [← hwverts, SimpleGraph.Walk.mem_verts_toSubgraph] + simp only [SimpleGraph.Walk.support_cons, List.mem_cons] + constructor + · exact Or.inr + · intro hz + rcases hz with rfl | hz + · exact q.end_mem_support + · exact hz + · exact q.isChain_adj_support + · intro a b ha + have ha' : a ∈ (SimpleGraph.Walk.cons hadj q).toSubgraph.verts := by + rw [hwverts] + exact ha + rw [← hwcycle.adj_toSubgraph_iff_of_isCycles hG ha' b] + rw [SimpleGraph.Walk.adj_toSubgraph_iff_mem_edges] + simp only [SimpleGraph.Walk.edges_cons, List.mem_cons] + rw [q.edges_eq_zipWith_support] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FiniteGridEdgeGraphEncoding.lean b/LeanPool/ApollonianSuperharmonic/FiniteGridEdgeGraphEncoding.lean new file mode 100644 index 0000000000..72c68e0eeb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FiniteGridEdgeGraphEncoding.lean @@ -0,0 +1,477 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Combinatorics.SimpleGraph.Acyclic +public import Mathlib.Data.Set.Card +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent + +-- [TABLET NODE: FiniteGridEdgeGraphEncoding] + +/-! +# FiniteGridEdgeGraphEncoding + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace GridEncodingFacts + +private theorem adjacent_ne : + ∀ a b : GaussianInt, FourNeighborAdjacent a b → a ≠ b := by + intro a b hab heq + rcases hab with hab | hab | hab | hab <;> subst b + all_goals + have hr := congrArg (fun z : GaussianInt => z.re) hab + have hi := congrArg (fun z : GaussianInt => z.im) hab + try norm_num at hr + try norm_num at hi + try omega + +end GridEncodingFacts + +namespace GridEncodingGeometry + +private theorem inc_inj : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (hendpoints : {x : GaussianInt | + ∃ e ∈ E, x ∈ e} ⊆ X), + let Y : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + let inc : Y → X := fun y => ⟨y.1, hendpoints y.2⟩ + Function.Injective inc := by + classical + intro X E hendpoints Y inc a b hab + apply Subtype.ext + exact congrArg (fun z : X => (z : GaussianInt)) hab + +private theorem lift : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (hendpoints : {x : GaussianInt | + ∃ e ∈ E, x ∈ e} ⊆ X), + let Y : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + let H : SimpleGraph Y := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + let inc : Y → X := fun y => ⟨y.1, hendpoints y.2⟩ + let inc_hom : H →g G := by + refine ⟨inc, ?_⟩ + intro a b hab + have hab' := (SimpleGraph.fromRel_adj _ _ _).mp hab + rcases hab' with ⟨hneab, hrel | hrel⟩ + · exact (SimpleGraph.fromRel_adj _ _ _).mpr + ⟨fun h => hneab (Subtype.ext (congrArg (fun z : X => (z : GaussianInt)) h)), Or.inl hrel⟩ + · exact (SimpleGraph.fromRel_adj _ _ _).mpr + ⟨fun h => hneab (Subtype.ext (congrArg (fun z : X => (z : GaussianInt)) h)), Or.inr hrel⟩ + ∀ (inc_val : ∀ (y : Y), (inc_hom y : GaussianInt) = y), ∀ (u : X), ∀ (v : X), ∀ (hu : (u : + GaussianInt) ∈ Y), ∀ (p : G.Walk u v), ∃ hv : (v : GaussianInt) ∈ Y, ∃ q : H.Walk ⟨u, hu⟩ + ⟨v, hv⟩, + q.map inc_hom = p.copy + (by apply Subtype.ext; exact (inc_val ⟨u.1, hu⟩).symm) + (by apply Subtype.ext; exact (inc_val ⟨v.1, hv⟩).symm) := by + classical + intro X E hendpoints Y H G inc inc_hom inc_val u v hu p + induction p with + | nil => exact ⟨hu, .nil, by simp⟩ + | @cons u v w hadj p ih => + have hadj' := (SimpleGraph.fromRel_adj _ _ _).mp hadj + rcases hadj' with ⟨hneuv, hrel | hrel⟩ + · have hv : (v.1 : GaussianInt) ∈ Y := ⟨{u.1, v.1}, hrel, by simp⟩ + have hwq := ih hv + rcases hwq with ⟨hw, q, hq⟩ + have hstep : H.Adj ⟨u, hu⟩ ⟨v, hv⟩ := by + exact (SimpleGraph.fromRel_adj _ _ _).mpr + ⟨fun h => hneuv (Subtype.ext (congrArg (fun z : Y => (z : GaussianInt)) h)), Or.inl + hrel⟩ + exact ⟨hw, .cons hstep q, by + have he : inc_hom ⟨v, hv⟩ = v := Subtype.ext (inc_val ⟨v, hv⟩).symm + simpa [SimpleGraph.Walk.map] using (And.intro he hq)⟩ + · have hv : (v.1 : GaussianInt) ∈ Y := ⟨{v.1, u.1}, hrel, by simp⟩ + have hwq := ih hv + rcases hwq with ⟨hw, q, hq⟩ + have hstep : H.Adj ⟨u, hu⟩ ⟨v, hv⟩ := by + exact (SimpleGraph.fromRel_adj _ _ _).mpr + ⟨fun h => hneuv (Subtype.ext (congrArg (fun z : Y => (z : GaussianInt)) h)), Or.inr + hrel⟩ + exact ⟨hw, .cons hstep q, by + have he : inc_hom ⟨v, hv⟩ = v := Subtype.ext (inc_val ⟨v, hv⟩).symm + simpa [SimpleGraph.Walk.map] using (And.intro he hq)⟩ + +private theorem hac : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (hendpoints : {x : GaussianInt | + ∃ e ∈ E, x ∈ e} ⊆ X), + let Y : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + let H : SimpleGraph Y := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + (H.IsAcyclic) → ( + let inc : Y → X := fun y => ⟨y.1, hendpoints y.2⟩ + (Function.Injective inc) → ( + let inc_hom : H →g G := by + refine ⟨inc, ?_⟩ + intro a b hab + have hab' := (SimpleGraph.fromRel_adj _ _ _).mp hab + rcases hab' with ⟨hneab, hrel | hrel⟩ + · exact (SimpleGraph.fromRel_adj _ _ _).mpr + ⟨fun h => hneab (Subtype.ext (congrArg (fun z : X => (z : GaussianInt)) h)), Or.inl hrel⟩ + · exact (SimpleGraph.fromRel_adj _ _ _).mpr + ⟨fun h => hneab (Subtype.ext (congrArg (fun z : X => (z : GaussianInt)) h)), Or.inr hrel⟩ + ∀ (inc_val : ∀ (y : Y), (inc_hom y : GaussianInt) = y), (∀ (u : X), ∀ (v : X), ∀ (hu : (u : + GaussianInt) ∈ Y), ∀ (p : G.Walk u v), ∃ hv : (v : GaussianInt) ∈ Y, ∃ q : H.Walk ⟨u, hu⟩ + ⟨v, hv⟩, q.map inc_hom = p.copy (by apply Subtype.ext; exact (inc_val ⟨u.1, hu⟩).symm) + (by apply Subtype.ext; exact (inc_val ⟨v.1, hv⟩).symm)) → (G.IsAcyclic))) := by + classical + intro X E hendpoints Y H G hacyclic' inc inc_inj inc_hom inc_val lift u c hc + cases c with + | nil => exact SimpleGraph.Walk.not_isCycle_nil hc + | @cons u v w hadj p => + have hadj' := (SimpleGraph.fromRel_adj _ _ _).mp hadj + rcases hadj' with ⟨hneuv, hrel | hrel⟩ + · have hu : (u : GaussianInt) ∈ Y := ⟨{u.1, v.1}, hrel, by simp⟩ + obtain ⟨hu', q, hq⟩ := lift u u hu (.cons hadj p) + let close : H.Walk ⟨u, hu⟩ ⟨u, hu⟩ := q.copy (Subtype.ext rfl) (Subtype.ext rfl) + have hmap : close.map inc_hom = .cons hadj p := by + simpa [close, SimpleGraph.Walk.map] using hq + have hcycle : (close.map inc_hom).IsCycle := by simpa [hmap] using hc + exact hacyclic' close ((SimpleGraph.Walk.isCycle_map_iff_of_injective inc_inj).mp hcycle) + · have hu : (u : GaussianInt) ∈ Y := + ⟨{u.1, v.1}, by simpa [Finset.pair_comm] using hrel, by simp⟩ + obtain ⟨hu', q, hq⟩ := lift u u hu (.cons hadj p) + let close : H.Walk ⟨u, hu⟩ ⟨u, hu⟩ := q.copy (Subtype.ext rfl) (Subtype.ext rfl) + have hmap : close.map inc_hom = .cons hadj p := by + simpa [close, SimpleGraph.Walk.map] using hq + have hcycle : (close.map inc_hom).IsCycle := by simpa [hmap] using hc + exact hacyclic' close ((SimpleGraph.Walk.isCycle_map_iff_of_injective inc_inj).mp hcycle) + +private theorem pick_spec : + ∀ (E : Set (Finset GaussianInt)), ∀ (hgrid : ∀ e ∈ E, ∃ (a : GaussianInt) (b : GaussianInt), + e = {a, b} ∧ FourNeighborAdjacent a b), + let pair : Finset GaussianInt → GaussianInt × GaussianInt := fun e => + Classical.choose (show ∃ p : GaussianInt × GaussianInt, + (e = {p.1, p.2} ∧ FourNeighborAdjacent p.1 p.2) ∨ e ∉ E by + by_cases he : e ∈ E + · obtain ⟨a, b, hab, hfour⟩ := hgrid e he + exact ⟨(a, b), Or.inl ⟨hab, hfour⟩⟩ + · exact ⟨(0, 0), Or.inr he⟩) + let pickA : Finset GaussianInt → GaussianInt := fun e => (pair e).1 + let pickB : Finset GaussianInt → GaussianInt := fun e => (pair e).2 + ∀ (e : Finset GaussianInt), (e ∈ E) → (e = {pickA e, pickB e} ∧ FourNeighborAdjacent (pickA + e) (pickB e)) := by + classical + intro E hgrid pair pickA pickB e he + rcases Classical.choose_spec (show ∃ p : GaussianInt × GaussianInt, + (e = {p.1, p.2} ∧ FourNeighborAdjacent p.1 p.2) ∨ e ∉ E by + by_cases he' : e ∈ E + · obtain ⟨a, b, hab, hfour⟩ := hgrid e he' + exact ⟨(a, b), Or.inl ⟨hab, hfour⟩⟩ + · exact ⟨(0, 0), Or.inr he'⟩) with hs | hs + · exact hs + · exact (hs he).elim + +private theorem pickA_mem : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (hgrid : ∀ e ∈ E, ∃ (a : + GaussianInt) (b : GaussianInt), e = {a, b} ∧ FourNeighborAdjacent a b), ({x : GaussianInt + | ∃ e ∈ E, x ∈ e} ⊆ X) → ( + let pair : Finset GaussianInt → GaussianInt × GaussianInt := fun e => + Classical.choose (show ∃ p : GaussianInt × GaussianInt, + (e = {p.1, p.2} ∧ FourNeighborAdjacent p.1 p.2) ∨ e ∉ E by + by_cases he : e ∈ E + · obtain ⟨a, b, hab, hfour⟩ := hgrid e he + exact ⟨(a, b), Or.inl ⟨hab, hfour⟩⟩ + · exact ⟨(0, 0), Or.inr he⟩) + let pickA : Finset GaussianInt → GaussianInt := fun e => (pair e).1 + let pickB : Finset GaussianInt → GaussianInt := fun e => (pair e).2 + (∀ (e : Finset GaussianInt), (e ∈ E) → (e = {pickA e, pickB e} ∧ FourNeighborAdjacent (pickA + e) (pickB e))) → (∀ (e : Finset GaussianInt), (e ∈ E) → (pickA e ∈ X))) := by + classical + intro X E hgrid hendpoints pair pickA pickB pick_spec e he + apply hendpoints + refine ⟨e, he, ?_⟩ + have hp : ({pickA e, pickB e} : Finset GaussianInt) = e := (pick_spec e he).1.symm + have hs : ({pickA e, pickB e} : Finset GaussianInt) ⊆ e := by + intro x hx + rw [← hp] + exact hx + exact hs (Finset.mem_insert_self _ _) + +private theorem pickB_mem : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (hgrid : ∀ e ∈ E, ∃ (a : + GaussianInt) (b : GaussianInt), e = {a, b} ∧ FourNeighborAdjacent a b), ({x : GaussianInt + | ∃ e ∈ E, x ∈ e} ⊆ X) → ( + let pair : Finset GaussianInt → GaussianInt × GaussianInt := fun e => + Classical.choose (show ∃ p : GaussianInt × GaussianInt, + (e = {p.1, p.2} ∧ FourNeighborAdjacent p.1 p.2) ∨ e ∉ E by + by_cases he : e ∈ E + · obtain ⟨a, b, hab, hfour⟩ := hgrid e he + exact ⟨(a, b), Or.inl ⟨hab, hfour⟩⟩ + · exact ⟨(0, 0), Or.inr he⟩) + let pickA : Finset GaussianInt → GaussianInt := fun e => (pair e).1 + let pickB : Finset GaussianInt → GaussianInt := fun e => (pair e).2 + (∀ (e : Finset GaussianInt), (e ∈ E) → (e = {pickA e, pickB e} ∧ FourNeighborAdjacent (pickA + e) (pickB e))) → (∀ (e : Finset GaussianInt), (e ∈ E) → (pickB e ∈ X))) := by + classical + intro X E hgrid hendpoints pair pickA pickB pick_spec e he + apply hendpoints + refine ⟨e, he, ?_⟩ + have hp : ({pickA e, pickB e} : Finset GaussianInt) = e := (pick_spec e he).1.symm + have hs : ({pickA e, pickB e} : Finset GaussianInt) ⊆ e := by + intro x hx + rw [← hp] + exact hx + exact hs (Finset.mem_insert_of_mem (Finset.mem_singleton_self _)) + +private theorem edgeOf_mem : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (hgrid : ∀ e ∈ E, ∃ (a : + GaussianInt) (b : GaussianInt), e = {a, b} ∧ FourNeighborAdjacent a b), + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + (∀ (a : GaussianInt), ∀ (b : GaussianInt), FourNeighborAdjacent a b → a ≠ b) → ( + let pair : Finset GaussianInt → GaussianInt × GaussianInt := fun e => + Classical.choose (show ∃ p : GaussianInt × GaussianInt, + (e = {p.1, p.2} ∧ FourNeighborAdjacent p.1 p.2) ∨ e ∉ E by + by_cases he : e ∈ E + · obtain ⟨a, b, hab, hfour⟩ := hgrid e he + exact ⟨(a, b), Or.inl ⟨hab, hfour⟩⟩ + · exact ⟨(0, 0), Or.inr he⟩) + let pickA : Finset GaussianInt → GaussianInt := fun e => (pair e).1 + let pickB : Finset GaussianInt → GaussianInt := fun e => (pair e).2 + (∀ (e : Finset GaussianInt), (e ∈ E) → (e = {pickA e, pickB e} ∧ FourNeighborAdjacent (pickA + e) (pickB e))) → (∀ (pickA_mem : ∀ (e : Finset GaussianInt), (e ∈ E) → (pickA e ∈ X)), ∀ + (pickB_mem : ∀ (e : Finset GaussianInt), (e ∈ E) → (pickB e ∈ X)), + let edgeOf (e : Finset GaussianInt) (he : e ∈ E) : Sym2 X := + s(⟨pickA e, pickA_mem e he⟩, ⟨pickB e, pickB_mem e he⟩) + ∀ (e : Finset GaussianInt), ∀ (he : e ∈ E), edgeOf e he ∈ G.edgeSet)) := by + classical + intro X E hgrid G hne pair pickA pickB pick_spec pickA_mem pickB_mem edgeOf e he + rw [SimpleGraph.mem_edgeSet] + apply (SimpleGraph.fromRel_adj _ _ _).mpr + have hp : ({pickA e, pickB e} : Finset GaussianInt) ∈ E := + (pick_spec e he).1 ▸ he + refine ⟨?_, Or.inl hp⟩ + exact fun h => hne _ _ (pick_spec e he).2 (Subtype.ext_iff.mp h) + +private theorem edgeOf_inj : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (hgrid : ∀ e ∈ E, ∃ (a : + GaussianInt) (b : GaussianInt), e = {a, b} ∧ FourNeighborAdjacent a b), + let pair : Finset GaussianInt → GaussianInt × GaussianInt := fun e => + Classical.choose (show ∃ p : GaussianInt × GaussianInt, + (e = {p.1, p.2} ∧ FourNeighborAdjacent p.1 p.2) ∨ e ∉ E by + by_cases he : e ∈ E + · obtain ⟨a, b, hab, hfour⟩ := hgrid e he + exact ⟨(a, b), Or.inl ⟨hab, hfour⟩⟩ + · exact ⟨(0, 0), Or.inr he⟩) + let pickA : Finset GaussianInt → GaussianInt := fun e => (pair e).1 + let pickB : Finset GaussianInt → GaussianInt := fun e => (pair e).2 + (∀ (e : Finset GaussianInt), (e ∈ E) → (e = {pickA e, pickB e} ∧ FourNeighborAdjacent (pickA + e) (pickB e))) → (∀ (pickA_mem : ∀ (e : Finset GaussianInt), (e ∈ E) → (pickA e ∈ X)), ∀ + (pickB_mem : ∀ (e : Finset GaussianInt), (e ∈ E) → (pickB e ∈ X)), + let edgeOf (e : Finset GaussianInt) (he : e ∈ E) : Sym2 X := + s(⟨pickA e, pickA_mem e he⟩, ⟨pickB e, pickB_mem e he⟩) + ∀ (e : Finset GaussianInt), ∀ (f : Finset GaussianInt), ∀ (he : e ∈ E), ∀ (hf : f ∈ E), + (edgeOf e he = edgeOf f hf) → (e = f)) := by + classical + intro X E hgrid pair pickA pickB pick_spec pickA_mem pickB_mem edgeOf e f he hf h + have hs : ({pickA e, pickB e} : Finset GaussianInt) = {pickA f, pickB f} := by + apply Finset.ext + intro x + dsimp [edgeOf] at h + rcases (Sym2.eq_iff.mp h) with h' | h' + · have h₁ := congrArg (fun z : X => (z : GaussianInt)) h'.1 + have h₂ := congrArg (fun z : X => (z : GaussianInt)) h'.2 + change pickA e = pickA f at h₁ + change pickB e = pickB f at h₂ + rw [h₁, h₂] + · have h₁ := congrArg (fun z : X => (z : GaussianInt)) h'.1 + have h₂ := congrArg (fun z : X => (z : GaussianInt)) h'.2 + change pickA e = pickB f at h₁ + change pickB e = pickA f at h₂ + rw [h₁, h₂] + simp only [Finset.mem_insert, Finset.mem_singleton] + exact or_comm + calc + e = {pickA e, pickB e} := (pick_spec e he).1 + _ = {pickA f, pickB f} := hs + _ = f := (pick_spec f hf).1.symm + +private theorem edgeOf_surj : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (hgrid : ∀ e ∈ E, ∃ (a : + GaussianInt) (b : GaussianInt), e = {a, b} ∧ FourNeighborAdjacent a b), + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + let pair : Finset GaussianInt → GaussianInt × GaussianInt := fun e => + Classical.choose (show ∃ p : GaussianInt × GaussianInt, + (e = {p.1, p.2} ∧ FourNeighborAdjacent p.1 p.2) ∨ e ∉ E by + by_cases he : e ∈ E + · obtain ⟨a, b, hab, hfour⟩ := hgrid e he + exact ⟨(a, b), Or.inl ⟨hab, hfour⟩⟩ + · exact ⟨(0, 0), Or.inr he⟩) + let pickA : Finset GaussianInt → GaussianInt := fun e => (pair e).1 + let pickB : Finset GaussianInt → GaussianInt := fun e => (pair e).2 + (∀ (e : Finset GaussianInt), (e ∈ E) → (e = {pickA e, pickB e} ∧ FourNeighborAdjacent (pickA + e) (pickB e))) → (∀ (pickA_mem : ∀ (e : Finset GaussianInt), (e ∈ E) → (pickA e ∈ X)), ∀ + (pickB_mem : ∀ (e : Finset GaussianInt), (e ∈ E) → (pickB e ∈ X)), + let edgeOf (e : Finset GaussianInt) (he : e ∈ E) : Sym2 X := + s(⟨pickA e, pickA_mem e he⟩, ⟨pickB e, pickB_mem e he⟩) + ∀ (z : Sym2 X), (z ∈ G.edgeSet) → (∃ e, ∃ he : e ∈ E, edgeOf e he = z)) := by + classical + intro X E hgrid G pair pickA pickB pick_spec pickA_mem pickB_mem edgeOf z hz + induction z using Sym2.inductionOn with + | _ x y => + have hadj := (SimpleGraph.mem_edgeSet G).mp hz + have hadj' := (SimpleGraph.fromRel_adj _ _ _).mp hadj + rcases hadj' with ⟨hne_xy, hrel | hrel⟩ + · let e : Finset GaussianInt := {x.1, y.1} + have he : e ∈ E := hrel + refine ⟨e, he, ?_⟩ + have hset : ({pickA e, pickB e} : Finset GaussianInt) = {x.1, y.1} := by + calc + {pickA e, pickB e} = e := (pick_spec e he).1.symm + _ = {x.1, y.1} := rfl + have hxmem : x.1 ∈ ({pickA e, pickB e} : Finset GaussianInt) := by + rw [hset] + simp + have hymem : y.1 ∈ ({pickA e, pickB e} : Finset GaussianInt) := by + rw [hset] + simp + have hx : x.1 = pickA e ∨ x.1 = pickB e := by simpa using hxmem + have hy : y.1 = pickA e ∨ y.1 = pickB e := by simpa using hymem + dsimp [edgeOf] + rcases hx with hx | hx <;> rcases hy with hy | hy + · exact (hne_xy (Subtype.ext (hx.trans hy.symm))).elim + · exact (Sym2.eq_iff.mpr (Or.inl ⟨Subtype.ext hx.symm, Subtype.ext hy.symm⟩)) + · exact (Sym2.eq_iff.mpr (Or.inr ⟨Subtype.ext hy.symm, Subtype.ext hx.symm⟩)) + · exact (hne_xy (Subtype.ext (hx.trans hy.symm))).elim + · let e : Finset GaussianInt := {x.1, y.1} + have he : e ∈ E := by simpa [e, Finset.pair_comm] using hrel + refine ⟨e, he, ?_⟩ + have hset : ({pickA e, pickB e} : Finset GaussianInt) = {x.1, y.1} := by + calc + {pickA e, pickB e} = e := (pick_spec e he).1.symm + _ = {x.1, y.1} := rfl + have hxmem : x.1 ∈ ({pickA e, pickB e} : Finset GaussianInt) := by + rw [hset] + simp + have hymem : y.1 ∈ ({pickA e, pickB e} : Finset GaussianInt) := by + rw [hset] + simp + have hx : x.1 = pickA e ∨ x.1 = pickB e := by simpa using hxmem + have hy : y.1 = pickA e ∨ y.1 = pickB e := by simpa using hymem + dsimp [edgeOf] + rcases hx with hx | hx <;> rcases hy with hy | hy + · exact (hne_xy (Subtype.ext (hx.trans hy.symm))).elim + · exact (Sym2.eq_iff.mpr (Or.inl ⟨Subtype.ext hx.symm, Subtype.ext hy.symm⟩)) + · exact (Sym2.eq_iff.mpr (Or.inr ⟨Subtype.ext hy.symm, Subtype.ext hx.symm⟩)) + · exact (hne_xy (Subtype.ext (hx.trans hy.symm))).elim + +private theorem hcard : + ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (hgrid : ∀ e ∈ E, ∃ (a : + GaussianInt) (b : GaussianInt), e = {a, b} ∧ FourNeighborAdjacent a b), + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + let pair : Finset GaussianInt → GaussianInt × GaussianInt := fun e => + Classical.choose (show ∃ p : GaussianInt × GaussianInt, + (e = {p.1, p.2} ∧ FourNeighborAdjacent p.1 p.2) ∨ e ∉ E by + by_cases he : e ∈ E + · obtain ⟨a, b, hab, hfour⟩ := hgrid e he + exact ⟨(a, b), Or.inl ⟨hab, hfour⟩⟩ + · exact ⟨(0, 0), Or.inr he⟩) + let pickA : Finset GaussianInt → GaussianInt := fun e => (pair e).1 + let pickB : Finset GaussianInt → GaussianInt := fun e => (pair e).2 + ∀ (pickA_mem : ∀ (e : Finset GaussianInt), (e ∈ E) → (pickA e ∈ X)), ∀ (pickB_mem : ∀ (e : + Finset GaussianInt), (e ∈ E) → (pickB e ∈ X)), + let edgeOf (e : Finset GaussianInt) (he : e ∈ E) : Sym2 X := + s(⟨pickA e, pickA_mem e he⟩, ⟨pickB e, pickB_mem e he⟩) + (∀ (e : Finset GaussianInt), ∀ (he : e ∈ E), edgeOf e he ∈ G.edgeSet) → ((∀ (e : Finset + GaussianInt), ∀ (f : Finset GaussianInt), ∀ (he : e ∈ E), ∀ (hf : f ∈ E), (edgeOf e he = + edgeOf f hf) → (e = f)) → ((∀ (z : Sym2 X), (z ∈ G.edgeSet) → (∃ e, ∃ he : e ∈ E, edgeOf + e he = z)) → (E.ncard = G.edgeSet.ncard))) := by + classical + intro X E hgrid G pair pickA pickB pickA_mem pickB_mem edgeOf edgeOf_mem edgeOf_inj edgeOf_surj + apply Set.ncard_congr edgeOf edgeOf_mem + · exact edgeOf_inj + · exact edgeOf_surj + +end GridEncodingGeometry + +theorem FiniteGridEdgeGraphEncoding + (X : Set GaussianInt) (E : Set (Finset GaussianInt)) + (hgrid : ∀ e ∈ E, ∃ a b : GaussianInt, + e = {a, b} ∧ FourNeighborAdjacent a b) + (hendpoints : {x | ∃ e ∈ E, x ∈ e} ⊆ X) + (hacyclic : + let Y : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + let H : SimpleGraph Y := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + H.IsAcyclic) : + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + G.IsAcyclic ∧ Nat.card G.edgeSet = E.ncard := by +-- BODY + let Y : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + let H : SimpleGraph Y := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + have hne := GridEncodingFacts.adjacent_ne + have hacyclic' : H.IsAcyclic := by + simpa [Y, H] using hacyclic + let inc : Y → X := fun y => ⟨y.1, hendpoints y.2⟩ + have inc_inj : Function.Injective inc := GridEncodingGeometry.inc_inj X E hendpoints + let inc_hom : H →g G := by + refine ⟨inc, ?_⟩ + intro a b hab + have hab' := (SimpleGraph.fromRel_adj _ _ _).mp hab + rcases hab' with ⟨hneab, hrel | hrel⟩ + · exact (SimpleGraph.fromRel_adj _ _ _).mpr + ⟨fun h => hneab (Subtype.ext (congrArg (fun z : X => (z : GaussianInt)) h)), Or.inl hrel⟩ + · exact (SimpleGraph.fromRel_adj _ _ _).mpr + ⟨fun h => hneab (Subtype.ext (congrArg (fun z : X => (z : GaussianInt)) h)), Or.inr hrel⟩ + have inc_val (y : Y) : (inc_hom y : GaussianInt) = y := by + rfl + change G.IsAcyclic ∧ Nat.card G.edgeSet = E.ncard + have lift : ∀ (u v : X) (hu : (u : GaussianInt) ∈ Y) (p : G.Walk u v), + ∃ hv : (v : GaussianInt) ∈ Y, ∃ q : H.Walk ⟨u, hu⟩ ⟨v, hv⟩, + q.map inc_hom = p.copy + (by apply Subtype.ext; exact (inc_val ⟨u.1, hu⟩).symm) + (by apply Subtype.ext; exact (inc_val ⟨v.1, hv⟩).symm) := GridEncodingGeometry.lift X E + hendpoints inc_val + have hac : G.IsAcyclic := GridEncodingGeometry.hac X E hendpoints hacyclic' inc_inj inc_val lift + let pair : Finset GaussianInt → GaussianInt × GaussianInt := fun e => + Classical.choose (show ∃ p : GaussianInt × GaussianInt, + (e = {p.1, p.2} ∧ FourNeighborAdjacent p.1 p.2) ∨ e ∉ E by + by_cases he : e ∈ E + · obtain ⟨a, b, hab, hfour⟩ := hgrid e he + exact ⟨(a, b), Or.inl ⟨hab, hfour⟩⟩ + · exact ⟨(0, 0), Or.inr he⟩) + let pickA : Finset GaussianInt → GaussianInt := fun e => (pair e).1 + let pickB : Finset GaussianInt → GaussianInt := fun e => (pair e).2 + have pick_spec (e : Finset GaussianInt) (he : e ∈ E) : + e = {pickA e, pickB e} ∧ FourNeighborAdjacent (pickA e) (pickB e) := + GridEncodingGeometry.pick_spec E hgrid e he + have pickA_mem (e : Finset GaussianInt) (he : e ∈ E) : pickA e ∈ X := + GridEncodingGeometry.pickA_mem X E hgrid hendpoints pick_spec e he + have pickB_mem (e : Finset GaussianInt) (he : e ∈ E) : pickB e ∈ X := + GridEncodingGeometry.pickB_mem X E hgrid hendpoints pick_spec e he + let edgeOf (e : Finset GaussianInt) (he : e ∈ E) : Sym2 X := + s(⟨pickA e, pickA_mem e he⟩, ⟨pickB e, pickB_mem e he⟩) + have edgeOf_mem (e : Finset GaussianInt) (he : e ∈ E) : edgeOf e he ∈ G.edgeSet := + GridEncodingGeometry.edgeOf_mem X E hgrid hne pick_spec pickA_mem pickB_mem e he + have edgeOf_inj (e f : Finset GaussianInt) (he : e ∈ E) (hf : f ∈ E) + (h : edgeOf e he = edgeOf f hf) : e = f := GridEncodingGeometry.edgeOf_inj X E hgrid + pick_spec pickA_mem pickB_mem e f he hf h + have edgeOf_surj (z : Sym2 X) (hz : z ∈ G.edgeSet) : + ∃ e, ∃ he : e ∈ E, edgeOf e he = z := GridEncodingGeometry.edgeOf_surj X E hgrid pick_spec + pickA_mem pickB_mem z hz + have hcard : E.ncard = G.edgeSet.ncard := GridEncodingGeometry.hcard X E hgrid pickA_mem + pickB_mem edgeOf_mem edgeOf_inj edgeOf_surj + exact ⟨hac, hcard.symm⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FiniteInducedTilePatch.lean b/LeanPool/ApollonianSuperharmonic/FiniteInducedTilePatch.lean new file mode 100644 index 0000000000..e9aee8bef0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FiniteInducedTilePatch.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: FiniteInducedTilePatch] + +/-! +# FiniteInducedTilePatch + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $G$ be a plane triangulation whose vertices index prototiles $T_a$. +A *finite induced tile patch* consists of a nonempty finite vertex set +$K$ and a prototile $T_K$ whose cells are exactly +$$ + (T_K)_{\rm cells}=\bigcup_{a\in K}(T_a)_{\rm cells}. +$$ +Distinct indices in $K$ must give distinct tiles. The subgraph of $G$ +induced by $K$ is connected: any two of its vertices are joined by a finite +$G$-path all of whose vertices remain in $K$. The induced graph on the +complement is also connected, in the analogous pathwise sense. The +prototile $T_K$, including its anchor, is retained as data so that later +topological conclusions concern the actual union tile rather than an +unspecified isomorphic copy. +-/ +structure FiniteInducedTilePatch {ι : Type} + (G : PlaneTriangulation ι) (tile : ι → ProtoTile) where +-- BODY + /-- The finite nonempty set of vertices indexing the induced patch. -/ + indices : Finset ι + /-- The literal union prototile, including its auxiliary anchor. -/ + unionTile : ProtoTile + nonempty : indices.Nonempty + tile_injective : Set.InjOn tile (indices : Set ι) + exact_union : ∀ x, x ∈ unionTile.cells ↔ + ∃ a ∈ indices, x ∈ (tile a).cells + induced_connected : ∀ a ∈ indices, ∀ b ∈ indices, + ∃ p : List ι, p.head? = some a ∧ p.getLast? = some b ∧ + (∀ x ∈ p, x ∈ indices) ∧ + ∀ x y : ι, ∀ l₁ l₂ : List ι, + p = l₁ ++ x :: y :: l₂ → G.adjacent x y + complement_connected : ∀ a ∉ indices, ∀ b ∉ indices, + ∃ p : List ι, p.head? = some a ∧ p.getLast? = some b ∧ + (∀ x ∈ p, x ∉ indices) ∧ + ∀ x y : ι, ∀ l₁ l₂ : List ι, + p = l₁ ++ x :: y :: l₂ → G.adjacent x y + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FinitePatchTopology.lean b/LeanPool/ApollonianSuperharmonic/FinitePatchTopology.lean new file mode 100644 index 0000000000..51c5d1a142 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FinitePatchTopology.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ExactTileTiling +public import LeanPool.ApollonianSuperharmonic.FiniteConnectedCellSetNoCheckerboard +public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch +public import LeanPool.ApollonianSuperharmonic.FinitePolyominoDiskCriterion +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.P3350T1GraphCellUnionConnected + +-- [TABLET NODE: FinitePatchTopology] + +/-! +# FinitePatchTopology + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FinitePatchTopology {ι : Type} + (G : PlaneTriangulation ι) (tile : ι → ProtoTile) + (hexact : ExactTileTiling (Set.range tile)) + (hindexed : ∀ x : LatticeCell, ∃! a : ι, x ∈ (tile a).cells) + (hadjacency : ∀ a b, a ≠ b → G.adjacent a b → + (FootprintEdges (tile a) ∩ FootprintEdges (tile b)).Nonempty) + (K : FiniteInducedTilePatch G tile) : + LatticeTile K.unionTile := by +-- BODY + have cellConnected : ∀ a, FourNeighborConnected ((tile a).cells : Set LatticeCell) := by + intro a + have htile : LatticeTile (tile a) := hexact.1 (tile a) ⟨a, rfl⟩ + exact (LatticeTileGridStructure (tile a) htile).1 + have cellDisjoint : ∀ a b, a ≠ b → Disjoint (tile a).cells (tile b).cells := by + intro a b hab + apply Finset.disjoint_left.2 + intro x hx hy + exact hab ((hindexed x).unique hx hy) + have insideUnion : {x : LatticeCell | ∃ a ∈ (K.indices : Set ι), + x ∈ (tile a).cells} = (K.unionTile.cells : Set LatticeCell) := by + ext x + exact (K.exact_union x).symm + have insideConnected : FourNeighborConnected (K.unionTile.cells : Set LatticeCell) := by + rw [← insideUnion] + exact P3350T1GraphCellUnionConnected G.adjacent G.adjacent_irreflexive + tile (K.indices : Set ι) K.nonempty + (fun a _ => cellConnected a) + (fun a _ b _ hab => cellDisjoint a b hab) + (fun a _ b _ hab => hadjacency a b hab) + K.induced_connected + have outsideUnion : {x : LatticeCell | ∃ a ∈ (K.indices : Set ι)ᶜ, + x ∈ (tile a).cells} = (K.unionTile.cells : Set LatticeCell)ᶜ := by + ext x + constructor + · rintro ⟨a, ha, hxa⟩ hx + obtain ⟨b, hb, hxb⟩ := (K.exact_union x).1 hx + have hab : a = b := (hindexed x).unique hxa hxb + exact ha (hab.symm ▸ hb) + · intro hx + obtain ⟨a, hxa, _⟩ := hindexed x + refine ⟨a, ?_, hxa⟩ + intro ha + exact hx ((K.exact_union x).2 ⟨a, ha, hxa⟩) + have outsideConnected : FourNeighborConnected ((K.unionTile.cells : Set LatticeCell)ᶜ) := by + let : Infinite LatticeCell := by + apply Infinite.of_injective (fun n : Nat => (n : GaussianInt)) + intro a b h + have hh := congrArg Zsqrtd.re h + norm_num at hh ⊢ + omega + have hnonempty : ((K.indices : Set ι)ᶜ).Nonempty := by + obtain ⟨x, hx⟩ := K.unionTile.cells.exists_notMem + obtain ⟨a, hxa, _⟩ := hindexed x + refine ⟨a, ?_⟩ + intro ha + exact hx ((K.exact_union x).2 ⟨a, ha, hxa⟩) + rw [← outsideUnion] + exact P3350T1GraphCellUnionConnected G.adjacent G.adjacent_irreflexive + tile (K.indices : Set ι)ᶜ hnonempty + (fun a _ => cellConnected a) + (fun a _ b _ hab => cellDisjoint a b hab) + (fun a _ b _ hab => hadjacency a b hab) + K.complement_connected + have hchecker := FiniteConnectedCellSetNoCheckerboard + K.unionTile.cells insideConnected outsideConnected + exact FinitePolyominoDiskCriterion K.unionTile insideConnected outsideConnected hchecker + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FinitePolyominoDiskCriterion.lean b/LeanPool/ApollonianSuperharmonic/FinitePolyominoDiskCriterion.lean new file mode 100644 index 0000000000..44695eb325 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FinitePolyominoDiskCriterion.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Analysis.Convex.GaugeRescale +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundaryReduction +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundaryRestoration +public import LeanPool.ApollonianSuperharmonic.P3475T1GridBoundary +public import LeanPool.ApollonianSuperharmonic.P3475T1PolygonTriangleConstruction +public import LeanPool.ApollonianSuperharmonic.P3475T1PolygonalSeparation +public import LeanPool.ApollonianSuperharmonic.P3475T1SquareUnionIdentification +public import LeanPool.ApollonianSuperharmonic.P3381T1PiecewiseAffinePolygonModel +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: FinitePolyominoDiskCriterion] + +/-! +# FinitePolyominoDiskCriterion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FinitePolyominoDiskCriterion (T : ProtoTile) + (hinside : FourNeighborConnected (T.cells : Set LatticeCell)) + (houtside : FourNeighborConnected ((T.cells : Set LatticeCell)ᶜ)) + (hchecker : NoCheckerboardCellVertex (T.cells : Set LatticeCell)) : + LatticeTile T := by +-- BODY + obtain ⟨n, p, v, hvertex, _hadj, _hvertices, hedges⟩ := + P3475T1GridBoundary T hinside houtside hchecker + obtain ⟨r, q, ⟨s⟩, hcorner⟩ := P3475T1BoundaryReduction p + obtain ⟨X, K, ⟨tree⟩⟩ := P3475T1PolygonTriangleConstruction q hcorner + obtain ⟨U, V, hUopen, hUconn, hUb, hVopen, hVconn, hVub, + hdisj, hcover, hfrontU, hfrontV, hX⟩ := + P3475T1PolygonalSeparation q X K tree + have hcoverP : U ∪ V = + (⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)))ᶜ := by + rw [s.carrier_eq] + exact hcover + have hfrontUP : frontier U = + ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) := + hfrontU.trans s.carrier_eq.symm + have hfrontVP : frontier V = + ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) := + hfrontV.trans s.carrier_eq.symm + have htile := P3475T1SquareUnionIdentification T hinside houtside + p v hvertex hedges U V hUopen hUconn hUb hVopen hVconn hVub + hdisj hcoverP hfrontUP hfrontVP + have hsource : X = TileRealization T := by + rw [htile, s.carrier_eq] + exact hX + obtain ⟨t⟩ := P3475T1BoundaryRestoration q p s X K tree + rw [hsource] at t + obtain ⟨h, _hboundary, _haffine⟩ := + P3381T1PiecewiseAffinePolygonModel p (TileRealization T) K t + obtain ⟨H, _hinterior, hclosure, _hfrontier⟩ := + exists_homeomorph_image_interior_closure_frontier_eq_unitBall + t.target_convex t.target_interior t.target_bounded + have hK : H '' K = Metric.closedBall 0 1 := by + simpa only [t.target_closed.closure_eq] using hclosure + let model : K ≃ₜ (Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) := + (H.image K).trans (Homeomorph.setCongr hK) + exact ⟨model.symm.trans h.symm⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean b/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean new file mode 100644 index 0000000000..8a18e2c870 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean @@ -0,0 +1,1018 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Algebra.BigOperators.Group.Finset.Basic +public import Mathlib.Data.Multiset.Bind +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +/-! +# FiniteSquareIncidenceIdentities + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open scoped BigOperators + +-- [TABLET NODE: FiniteSquareIncidenceIdentities] +namespace SquareIncidenceProof + +private theorem hbagcard : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + cornerBag.card = 4 * T.cells.card := by + classical + intro T I cornerBag + simp [cornerBag, Nat.mul_comm] + +private theorem hcountpos : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + ∀ (z : GaussianInt), (z ∈ cornerBag.toFinset) → (1 ≤ cornerBag.count z) := by + classical + intro T I cornerBag z hz + rw [Multiset.mem_toFinset] at hz + exact Multiset.count_pos.mpr hz + +private theorem hvertexSet : + ∀ (T : ProtoTile), (T.cells.Nonempty) → ( + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + (cornerBag.toFinset : Set GaussianInt) = FootprintVertices T) := by + classical + intro T hne I cornerBag + ext z + change z ∈ cornerBag.toFinset ↔ z ∈ FootprintVertices T + rw [Multiset.mem_toFinset] + dsimp only [cornerBag, I] + simp [FootprintVertices, hne] + +private theorem hvertexCard : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + ((cornerBag.toFinset : Set GaussianInt) = FootprintVertices T) → (cornerBag.toFinset.card = + (FootprintVertices T).ncard) := by + classical + intro T I cornerBag hvertexSet + have h := congrArg Set.ncard hvertexSet + simpa using h + +private theorem hcountle : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + ∀ (z : GaussianInt), cornerBag.count z ≤ 4 := by + classical + intro T I cornerBag z + let around : Finset GaussianInt := {z, z - 1, z - I, z - 1 - I} + have hcornerNodup (c : GaussianInt) : + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt).Nodup := by + simp [I, Zsqrtd.ext_iff] + have hfilter : + T.cells.filter (fun c => z ∈ ([c, c + 1, c + I, c + 1 + I] : List GaussianInt)) ⊆ + around := by + intro c hc + rw [Finset.mem_filter] at hc + simp only [List.mem_cons, List.not_mem_nil, or_false] at hc + rcases hc.2 with h | h | h | h + · subst c + simp [around] + · subst z + simp [around, I, Zsqrtd.ext_iff] + · subst z + simp [around, I, Zsqrtd.ext_iff] + · subst z + simp [around, I, Zsqrtd.ext_iff] + calc + cornerBag.count z = ∑ c ∈ T.cells, + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt).count z := by + dsimp only [cornerBag] + rw [Multiset.count_bind] + simp + _ = (T.cells.filter (fun c => + z ∈ ([c, c + 1, c + I, c + 1 + I] : List GaussianInt))).card := by + rw [Finset.card_filter] + apply Finset.sum_congr rfl + intro c hc + exact (hcornerNodup c).count + _ ≤ around.card := Finset.card_le_card hfilter + _ ≤ 4 := by + dsimp only [around] + calc + ({z, z - 1, z - I, z - 1 - I} : Finset GaussianInt).card ≤ + ({z - 1, z - I, z - 1 - I} : Finset GaussianInt).card + 1 := + Finset.card_insert_le _ _ + _ ≤ (({z - I, z - 1 - I} : Finset GaussianInt).card + 1) + 1 := by + have h := Finset.card_insert_le (z - 1) + ({z - I, z - 1 - I} : Finset GaussianInt) + omega + _ ≤ (({z - 1 - I} : Finset GaussianInt).card + 1 + 1) + 1 := by + have h := Finset.card_insert_le (z - I) + ({z - 1 - I} : Finset GaussianInt) + omega + _ ≤ 4 := by simp + +private theorem hcornerCount : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + ∀ (z : GaussianInt), cornerBag.count z = + (if z ∈ T.cells then 1 else 0) + + (if z - 1 ∈ T.cells then 1 else 0) + + (if z - I ∈ T.cells then 1 else 0) + + (if z - 1 - I ∈ T.cells then 1 else 0) := by + classical + intro T I cornerBag z + dsimp only [cornerBag] + rw [Multiset.count_bind] + rw [← Finset.sum_eq_multiset_sum] + simp only [Multiset.coe_count, List.count_cons, beq_iff_eq, + List.count_nil] + have h11 : ∀ c : GaussianInt, (c + 1 + I = z) ↔ (c = z - 1 - I) := by + intro c + constructor <;> intro h + · rw [← h]; ring + · rw [h]; ring + have hI : ∀ c : GaussianInt, (c + I = z) ↔ (c = z - I) := by + intro c + constructor <;> intro h + · rw [← h]; ring + · rw [h]; ring + have h1 : ∀ c : GaussianInt, (c + 1 = z) ↔ (c = z - 1) := by + intro c + constructor <;> intro h + · rw [← h]; ring + · rw [h]; ring + simp_rw [h11, hI, h1] + simp only [Finset.sum_add_distrib, zero_add] + rw [Finset.sum_ite_eq', Finset.sum_ite_eq', Finset.sum_ite_eq', + Finset.sum_ite_eq'] + omega + +private theorem hweighted : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let N : Nat → Nat := fun k => + (cornerBag.toFinset.filter fun z => cornerBag.count z = k).card + (∀ (z : GaussianInt), (z ∈ cornerBag.toFinset) → (1 ≤ cornerBag.count z)) → ((∀ (z : + GaussianInt), cornerBag.count z ≤ 4) → (∑ z ∈ cornerBag.toFinset, cornerBag.count z = + N 1 + 2 * N 2 + 3 * N 3 + 4 * N 4)) := by + classical + intro T I cornerBag N hcountpos hcountle + rw [show (∑ z ∈ cornerBag.toFinset, cornerBag.count z) = + ∑ z ∈ cornerBag.toFinset, + ((if cornerBag.count z = 1 then 1 else 0) + + (if cornerBag.count z = 2 then 2 else 0) + + (if cornerBag.count z = 3 then 3 else 0) + + (if cornerBag.count z = 4 then 4 else 0)) by + apply Finset.sum_congr rfl + intro z hz + have hp := hcountpos z hz + have hl := hcountle z + have hc : cornerBag.count z = 1 ∨ cornerBag.count z = 2 ∨ + cornerBag.count z = 3 ∨ cornerBag.count z = 4 := by omega + rcases hc with hc | hc | hc | hc <;> simp [hc]] + simp only [Finset.sum_add_distrib] + simp [N, Finset.sum_ite, Nat.mul_comm] + +private theorem hunweighted : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let N : Nat → Nat := fun k => + (cornerBag.toFinset.filter fun z => cornerBag.count z = k).card + (∀ (z : GaussianInt), (z ∈ cornerBag.toFinset) → (1 ≤ cornerBag.count z)) → ((∀ (z : + GaussianInt), cornerBag.count z ≤ 4) → (cornerBag.toFinset.card = N 1 + N 2 + N 3 + N 4)) + := by + classical + intro T I cornerBag N hcountpos hcountle + rw [show cornerBag.toFinset.card = ∑ z ∈ cornerBag.toFinset, 1 by simp] + rw [show (∑ z ∈ cornerBag.toFinset, 1) = + ∑ z ∈ cornerBag.toFinset, + ((if cornerBag.count z = 1 then 1 else 0) + + (if cornerBag.count z = 2 then 1 else 0) + + (if cornerBag.count z = 3 then 1 else 0) + + (if cornerBag.count z = 4 then 1 else 0)) by + apply Finset.sum_congr rfl + intro z hz + have hp := hcountpos z hz + have hl := hcountle z + have hc : cornerBag.count z = 1 ∨ cornerBag.count z = 2 ∨ + cornerBag.count z = 3 ∨ cornerBag.count z = 4 := by omega + rcases hc with hc | hc | hc | hc <;> simp [hc]] + simp only [Finset.sum_add_distrib] + simp [N] + +private theorem hedgeBagCard : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + edgeBag.card = 4 * T.cells.card := by + classical + intro T I edgeBag + simp [edgeBag, Nat.mul_comm] + +private theorem hedgeCountPos : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + ∀ (e : GaussianInt × Bool), (e ∈ edgeBag.toFinset) → (1 ≤ edgeBag.count e) := by + classical + intro T I edgeBag e he + rw [Multiset.mem_toFinset] at he + exact Multiset.count_pos.mpr he + +private theorem hedgeCountFalse : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + ∀ (z : GaussianInt), edgeBag.count (z, false) = + (if z ∈ T.cells then 1 else 0) + (if z - I ∈ T.cells then 1 else 0) := by + classical + intro T I edgeBag z + dsimp only [edgeBag] + rw [Multiset.count_bind] + rw [← Finset.sum_eq_multiset_sum] + simp only [Multiset.coe_count, List.count_cons, beq_iff_eq, + Prod.mk.injEq, and_false, ite_false, + and_true, Bool.true_eq_false, Nat.zero_add, + List.count_nil, add_zero] + rw [Finset.sum_add_distrib] + rw [Finset.sum_ite_eq'] + have heq : ∀ c : GaussianInt, (c + I = z) ↔ (c = z - I) := by + intro c + constructor <;> intro h + · rw [← h] + ring + · rw [h] + ring + simp_rw [heq] + rw [Finset.sum_ite_eq'] + omega + +private theorem hedgeCountTrue : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + ∀ (z : GaussianInt), edgeBag.count (z, true) = + (if z ∈ T.cells then 1 else 0) + (if z - 1 ∈ T.cells then 1 else 0) := by + classical + intro T I edgeBag z + dsimp only [edgeBag] + rw [Multiset.count_bind] + rw [← Finset.sum_eq_multiset_sum] + simp only [Multiset.coe_count, List.count_cons, beq_iff_eq, + Prod.mk.injEq, and_false, ite_false, + and_true, Bool.false_eq_true, Nat.zero_add, + List.count_nil, add_zero] + rw [Finset.sum_add_distrib] + rw [Finset.sum_ite_eq'] + have heq : ∀ c : GaussianInt, (c + 1 = z) ↔ (c = z - 1) := by + intro c + constructor <;> intro h + · rw [← h] + ring + · rw [h] + ring + simp_rw [heq] + rw [Finset.sum_ite_eq'] + omega + +private theorem hedgeCountLe : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + (∀ (z : GaussianInt), edgeBag.count (z, false) = (if z ∈ T.cells then 1 else 0) + (if z - I ∈ + T.cells then 1 else 0)) → ((∀ (z : GaussianInt), edgeBag.count (z, true) = (if z ∈ + T.cells then 1 else 0) + (if z - 1 ∈ T.cells then 1 else 0)) → (∀ (e : GaussianInt × + Bool), edgeBag.count e ≤ 2)) := by + classical + intro T I edgeBag hedgeCountFalse hedgeCountTrue e + rcases e with ⟨z, b⟩ + cases b + · rw [hedgeCountFalse] + split_ifs <;> omega + · rw [hedgeCountTrue] + split_ifs <;> omega + +private theorem hedgeMultiplicity : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + (∀ (e : GaussianInt × Bool), (e ∈ edgeBag.toFinset) → (1 ≤ edgeBag.count e)) → ((∀ (e : + GaussianInt × Bool), edgeBag.count e ≤ 2) → (edgeBag.card = + (edgeBag.toFinset.filter fun e => edgeBag.count e = 1).card + + 2 * (edgeBag.toFinset.filter fun e => edgeBag.count e = 2).card)) := by + classical + intro T I edgeBag hedgeCountPos hedgeCountLe + rw [← Multiset.toFinset_sum_count_eq edgeBag] + rw [show (∑ e ∈ edgeBag.toFinset, edgeBag.count e) = + ∑ e ∈ edgeBag.toFinset, + ((if edgeBag.count e = 1 then 1 else 0) + + (if edgeBag.count e = 2 then 2 else 0)) by + apply Finset.sum_congr rfl + intro e he + have hp := hedgeCountPos e he + have hl := hedgeCountLe e + have hc : edgeBag.count e = 1 ∨ edgeBag.count e = 2 := by omega + rcases hc with hc | hc <;> simp [hc]] + simp [Finset.sum_add_distrib, Finset.sum_ite, Nat.mul_comm] + +private theorem hedgePartition : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + (∀ (e : GaussianInt × Bool), (e ∈ edgeBag.toFinset) → (1 ≤ edgeBag.count e)) → ((∀ (e : + GaussianInt × Bool), edgeBag.count e ≤ 2) → (edgeBag.toFinset.card = + (edgeBag.toFinset.filter fun e => edgeBag.count e = 1).card + + (edgeBag.toFinset.filter fun e => edgeBag.count e = 2).card)) := by + classical + intro T I edgeBag hedgeCountPos hedgeCountLe + rw [show edgeBag.toFinset.card = ∑ e ∈ edgeBag.toFinset, 1 by simp] + rw [show (∑ e ∈ edgeBag.toFinset, 1) = + ∑ e ∈ edgeBag.toFinset, + ((if edgeBag.count e = 1 then 1 else 0) + + (if edgeBag.count e = 2 then 1 else 0)) by + apply Finset.sum_congr rfl + intro e he + have hp := hedgeCountPos e he + have hl := hedgeCountLe e + have hc : edgeBag.count e = 1 ∨ edgeBag.count e = 2 := by omega + rcases hc with hc | hc <;> simp [hc]] + simp [Finset.sum_add_distrib] + +private theorem hedgeIdentity : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + (edgeBag.card = 4 * T.cells.card) → ((edgeBag.card = (edgeBag.toFinset.filter fun e => + edgeBag.count e = 1).card + 2 * (edgeBag.toFinset.filter fun e => edgeBag.count e = + 2).card) → ((edgeBag.toFinset.card = (edgeBag.toFinset.filter fun e => edgeBag.count e = + 1).card + (edgeBag.toFinset.filter fun e => edgeBag.count e = 2).card) → (2 * + edgeBag.toFinset.card = 4 * T.cells.card + + (edgeBag.toFinset.filter fun e => edgeBag.count e = 1).card))) := by + classical + intro T I edgeBag hedgeBagCard hedgeMultiplicity hedgePartition + rw [hedgePartition, ← hedgeBagCard] at ⊢ + omega + +private theorem pair_eq : + ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ {d : GaussianInt}, (({a, b} + : Finset GaussianInt) = {c, d}) → ((a = c ∧ b = d) ∨ (a = d ∧ b = c)) := by + classical + intro a b c d h + have hs : ({a, b} : Set GaussianInt) = {c, d} := by + ext x + have hx := congrArg (fun s : Finset GaussianInt => x ∈ s) h + apply Iff.of_eq + change (x = a ∨ x = b) = (x = c ∨ x = d) + simpa only [Finset.mem_insert, Finset.mem_singleton] using hx + exact Set.pair_eq_pair_iff.mp hs + +private theorem edgeOf_injective : + (ProtoTile) → ( + let I : GaussianInt := ⟨0, 1⟩ + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ {d : GaussianInt}, (({a, b} + : Finset GaussianInt) = {c, d}) → ((a = c ∧ b = d) ∨ (a = d ∧ b = c))) → + (Function.Injective edgeOf)) := by + classical + intro T I edgeOf pair_eq + rintro ⟨z, b⟩ ⟨w, d⟩ h + cases b <;> cases d + · change ({z, z + 1} : Finset GaussianInt) = {w, w + 1} at h + replace h := pair_eq h + rcases h with ⟨h, _⟩ | ⟨h1, h2⟩ + · subst w; rfl + · exfalso + have h1r := congrArg Zsqrtd.re h1 + have h2r := congrArg Zsqrtd.re h2 + norm_num at h1r h2r + omega + · change ({z, z + 1} : Finset GaussianInt) = {w, w + I} at h + replace h := pair_eq h + rcases h with ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> exfalso + · have h1i := congrArg Zsqrtd.im h1 + have h2i := congrArg Zsqrtd.im h2 + dsimp only [I] at h1i h2i + norm_num at h1i h2i + omega + · have h1r := congrArg Zsqrtd.re h1 + have h2r := congrArg Zsqrtd.re h2 + norm_num at h1r h2r + omega + · change ({z, z + I} : Finset GaussianInt) = {w, w + 1} at h + replace h := pair_eq h + rcases h with ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> exfalso + · have h1r := congrArg Zsqrtd.re h1 + have h2r := congrArg Zsqrtd.re h2 + norm_num at h1r h2r + omega + · have h1i := congrArg Zsqrtd.im h1 + have h2i := congrArg Zsqrtd.im h2 + dsimp only [I] at h1i h2i + norm_num at h1i h2i + omega + · change ({z, z + I} : Finset GaussianInt) = {w, w + I} at h + replace h := pair_eq h + rcases h with ⟨h, _⟩ | ⟨h1, h2⟩ + · subst w; rfl + · exfalso + have h1i := congrArg Zsqrtd.im h1 + have h2i := congrArg Zsqrtd.im h2 + dsimp only [I] at h1i h2i + norm_num at h1i h2i + omega + +private theorem hedgeSet : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + ((edgeBag.toFinset.image edgeOf : Finset (Finset GaussianInt)) : + Set (Finset GaussianInt)) = FootprintEdges T := by + classical + intro T I edgeBag edgeOf + ext e + change e ∈ edgeBag.toFinset.image edgeOf ↔ e ∈ FootprintEdges T + rw [Finset.mem_image] + constructor + · rintro ⟨p, hp, rfl⟩ + rw [Multiset.mem_toFinset] at hp + dsimp only [edgeBag] at hp + rw [Multiset.mem_bind] at hp + rcases hp with ⟨c, hc, hp⟩ + have hp' : p = (c, false) ∨ p = (c, true) ∨ + p = (c + I, false) ∨ p = (c + 1, true) := by + simpa using hp + rcases hp' with rfl | rfl | rfl | rfl + · exact ⟨c, hc, Or.inl rfl⟩ + · exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ + · refine ⟨c, hc, Or.inr (Or.inr (Or.inr ?_))⟩ + change ({c + I, c + I + 1} : Finset GaussianInt) = + {c + I, c + 1 + I} + congr 1; ring + · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · rintro ⟨c, hc, he | he | he | he⟩ + · refine ⟨(c, false), ?_, ?_⟩ + · rw [Multiset.mem_toFinset] + exact Multiset.mem_bind.mpr ⟨c, hc, by simp⟩ + · simpa [edgeOf] using he.symm + · refine ⟨(c, true), ?_, ?_⟩ + · rw [Multiset.mem_toFinset] + exact Multiset.mem_bind.mpr ⟨c, hc, by simp⟩ + · simpa [edgeOf] using he.symm + · refine ⟨(c + 1, true), ?_, ?_⟩ + · rw [Multiset.mem_toFinset] + exact Multiset.mem_bind.mpr ⟨c, hc, by simp⟩ + · simpa [edgeOf] using he.symm + · refine ⟨(c + I, false), ?_, ?_⟩ + · rw [Multiset.mem_toFinset] + exact Multiset.mem_bind.mpr ⟨c, hc, by simp⟩ + · rw [he] + change ({c + I, c + I + 1} : Finset GaussianInt) = + {c + I, c + 1 + I} + congr 1; ring + +private theorem hedgeCard : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + (Function.Injective edgeOf) → ((((edgeBag.toFinset.image edgeOf : Finset (Finset + GaussianInt)) : Set (Finset GaussianInt)) = FootprintEdges T) → (edgeBag.toFinset.card = + (FootprintEdges T).ncard)) := by + classical + intro T I edgeBag edgeOf edgeOf_injective hedgeSet + have h := congrArg Set.ncard hedgeSet + rw [Set.ncard_coe_finset] at h + rw [Finset.card_image_of_injective _ edgeOf_injective] at h + exact h + +private theorem hboundarySet : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + (∀ (z : GaussianInt), edgeBag.count (z, false) = (if z ∈ T.cells then 1 else 0) + (if z - I ∈ + T.cells then 1 else 0)) → ((∀ (z : GaussianInt), edgeBag.count (z, true) = (if z ∈ + T.cells then 1 else 0) + (if z - 1 ∈ T.cells then 1 else 0)) → ( + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let boundaryTags := edgeBag.toFinset.filter fun e => edgeBag.count e = 1 + ((boundaryTags.image edgeOf : Finset (Finset GaussianInt)) : + Set (Finset GaussianInt)) = BoundaryFootprintEdges T)) := by + classical + intro T I edgeBag hedgeCountFalse hedgeCountTrue edgeOf boundaryTags + ext e + change e ∈ boundaryTags.image edgeOf ↔ e ∈ BoundaryFootprintEdges T + rw [Finset.mem_image] + constructor + · rintro ⟨p, hp, rfl⟩ + rw [Finset.mem_filter] at hp + rcases p with ⟨z, b⟩ + cases b + · refine ⟨z, Or.inl ⟨rfl, ?_⟩⟩ + rw [hedgeCountFalse] at hp + have hx : (z ∈ T.cells ∧ z - I ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - I ∈ T.cells) := by + by_cases hz : z ∈ T.cells <;> by_cases hzI : z - I ∈ T.cells + all_goals simp [hz, hzI] at hp ⊢ + simpa only [I] using hx + · refine ⟨z, Or.inr ⟨rfl, ?_⟩⟩ + rw [hedgeCountTrue] at hp + by_cases hz : z ∈ T.cells <;> by_cases hz1 : z - 1 ∈ T.cells + all_goals simp [hz, hz1] at hp ⊢ + · rintro ⟨z, hz | hz⟩ + · have hx : (z ∈ T.cells ∧ z - I ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - I ∈ T.cells) := by + simpa only [I] using hz.2 + refine ⟨(z, false), ?_, ?_⟩ + · rw [Finset.mem_filter] + constructor + · rw [Multiset.mem_toFinset] + apply Multiset.count_pos.mp + rw [hedgeCountFalse] + rcases hx with h | h <;> simp [h.1, h.2] + · rw [hedgeCountFalse] + rcases hx with h | h <;> simp [h.1, h.2] + · simpa [edgeOf] using hz.1.symm + · refine ⟨(z, true), ?_, ?_⟩ + · rw [Finset.mem_filter] + constructor + · rw [Multiset.mem_toFinset] + apply Multiset.count_pos.mp + rw [hedgeCountTrue] + rcases hz.2 with h | h <;> simp [h.1, h.2] + · rw [hedgeCountTrue] + rcases hz.2 with h | h <;> simp [h.1, h.2] + · simpa [edgeOf] using hz.1.symm + +private theorem hboundaryCard : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + (Function.Injective edgeOf) → ( + let boundaryTags := edgeBag.toFinset.filter fun e => edgeBag.count e = 1 + (((boundaryTags.image edgeOf : Finset (Finset GaussianInt)) : Set (Finset GaussianInt)) = + BoundaryFootprintEdges T) → (boundaryTags.card = (BoundaryFootprintEdges T).ncard)) := by + classical + intro T I edgeBag edgeOf edgeOf_injective boundaryTags hboundarySet + have h := congrArg Set.ncard hboundarySet + rw [Set.ncard_coe_finset] at h + rw [Finset.card_image_of_injective _ edgeOf_injective] at h + exact h + +private theorem hboundaryEndpointCard : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + let boundaryTags := edgeBag.toFinset.filter fun e => edgeBag.count e = 1 + let boundaryEndpointBag : Multiset GaussianInt := boundaryTags.1.bind fun p => + if p.2 then ([p.1, p.1 + I] : List GaussianInt) + else ([p.1, p.1 + 1] : List GaussianInt) + boundaryEndpointBag.card = 2 * boundaryTags.card := by + classical + intro T I edgeBag boundaryTags boundaryEndpointBag + simp only [boundaryEndpointBag, Multiset.card_bind] + rw [← Finset.sum_eq_multiset_sum] + change (∑ p ∈ boundaryTags, + (if p.2 then ([p.1, p.1 + I] : List GaussianInt) + else ([p.1, p.1 + 1] : List GaussianInt) : Multiset GaussianInt).card) = + 2 * boundaryTags.card + rw [show (∑ p ∈ boundaryTags, + (if p.2 then ([p.1, p.1 + I] : List GaussianInt) + else ([p.1, p.1 + 1] : List GaussianInt) : Multiset GaussianInt).card) = + boundaryTags.card * 2 by + apply Finset.sum_const_nat + rintro ⟨w, b⟩ hp + cases b <;> simp] + omega + +private theorem hboundaryEndpointCount : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + let boundaryTags := edgeBag.toFinset.filter fun e => edgeBag.count e = 1 + let boundaryEndpointBag : Multiset GaussianInt := boundaryTags.1.bind fun p => + if p.2 then ([p.1, p.1 + I] : List GaussianInt) + else ([p.1, p.1 + 1] : List GaussianInt) + ∀ (z : GaussianInt), boundaryEndpointBag.count z = + (if (z, false) ∈ boundaryTags then 1 else 0) + + (if (z - 1, false) ∈ boundaryTags then 1 else 0) + + (if (z, true) ∈ boundaryTags then 1 else 0) + + (if (z - I, true) ∈ boundaryTags then 1 else 0) := by + classical + intro T I edgeBag boundaryTags boundaryEndpointBag z + calc + boundaryEndpointBag.count z = ∑ p ∈ boundaryTags, + Multiset.count z (if p.2 then ([p.1, p.1 + I] : List GaussianInt) + else ([p.1, p.1 + 1] : List GaussianInt) : Multiset GaussianInt) := by + dsimp only [boundaryEndpointBag] + rw [Multiset.count_bind] + exact (Finset.sum_eq_multiset_sum boundaryTags fun p => + Multiset.count z (if p.2 then ([p.1, p.1 + I] : List GaussianInt) + else ([p.1, p.1 + 1] : List GaussianInt) : Multiset GaussianInt)).symm + _ = ∑ p ∈ boundaryTags, + ((if p = (z, false) then 1 else 0) + + (if p = (z - 1, false) then 1 else 0) + + (if p = (z, true) then 1 else 0) + + (if p = (z - I, true) then 1 else 0)) := by + apply Finset.sum_congr rfl + rintro ⟨w, b⟩ hp + cases b + · have hw : (w = z - 1) ↔ (z = w + 1) := by + constructor <;> intro h + · rw [h]; ring + · rw [h]; ring + simp only [Bool.false_eq, + Prod.mk.injEq] + by_cases h0 : z = w <;> by_cases h1 : z = w + 1 + all_goals + first + | solve | simp [h0, h1, hw, eq_comm, Zsqrtd.ext_iff] + | simp [h0, eq_comm, Zsqrtd.ext_iff] + omega + · have hw : (w = z - I) ↔ (z = w + I) := by + constructor <;> intro h + · rw [h]; ring + · rw [h]; ring + simp only [Bool.true_eq, ite_true, Multiset.coe_count, + List.count_cons, beq_iff_eq, List.count_nil, + Prod.mk.injEq] + by_cases h0 : z = w <;> by_cases hI : z = w + I + all_goals + first + | solve | simp [h0, hI, hw, eq_comm, I, Zsqrtd.ext_iff] + | simp [h0, eq_comm, I, Zsqrtd.ext_iff] + omega + _ = _ := by + simp only [Finset.sum_add_distrib] + simp [] + +private theorem hboundaryFalse : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + (∀ (z : GaussianInt), edgeBag.count (z, false) = (if z ∈ T.cells then 1 else 0) + (if z - I ∈ + T.cells then 1 else 0)) → ( + let boundaryTags := edgeBag.toFinset.filter fun e => edgeBag.count e = 1 + ∀ (z : GaussianInt), (z, false) ∈ boundaryTags ↔ + (z ∈ T.cells ∧ z - I ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - I ∈ T.cells)) := by + classical + intro T I edgeBag hedgeCountFalse boundaryTags z + simp only [boundaryTags, Finset.mem_filter, Multiset.mem_toFinset] + rw [← Multiset.count_pos] + rw [hedgeCountFalse] + by_cases hz : z ∈ T.cells <;> by_cases hzI : z - I ∈ T.cells <;> + simp [hz, hzI] + +private theorem hboundaryTrue : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + (∀ (z : GaussianInt), edgeBag.count (z, true) = (if z ∈ T.cells then 1 else 0) + (if z - 1 ∈ + T.cells then 1 else 0)) → ( + let boundaryTags := edgeBag.toFinset.filter fun e => edgeBag.count e = 1 + ∀ (z : GaussianInt), (z, true) ∈ boundaryTags ↔ + (z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - 1 ∈ T.cells)) := by + classical + intro T I edgeBag hedgeCountTrue boundaryTags z + simp only [boundaryTags, Finset.mem_filter, Multiset.mem_toFinset] + rw [← Multiset.count_pos] + rw [hedgeCountTrue] + by_cases hz : z ∈ T.cells <;> by_cases hz1 : z - 1 ∈ T.cells <;> + simp [hz, hz1] + +private theorem hlocalBoundaryDegree : + ∀ (T : ProtoTile), (NoCheckerboardCellVertex (T.cells : Set LatticeCell)) → ( + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + (∀ (z : GaussianInt), cornerBag.count z = (if z ∈ T.cells then 1 else 0) + (if z - 1 ∈ + T.cells then 1 else 0) + (if z - I ∈ T.cells then 1 else 0) + (if z - 1 - I ∈ T.cells + then 1 else 0)) → ( + let boundaryTags := edgeBag.toFinset.filter fun e => edgeBag.count e = 1 + let boundaryEndpointBag : Multiset GaussianInt := boundaryTags.1.bind fun p => + if p.2 then ([p.1, p.1 + I] : List GaussianInt) + else ([p.1, p.1 + 1] : List GaussianInt) + (∀ (z : GaussianInt), boundaryEndpointBag.count z = (if (z, false) ∈ boundaryTags then 1 else + 0) + (if (z - 1, false) ∈ boundaryTags then 1 else 0) + (if (z, true) ∈ boundaryTags then + 1 else 0) + (if (z - I, true) ∈ boundaryTags then 1 else 0)) → ((∀ (z : GaussianInt), (z, + false) ∈ boundaryTags ↔ (z ∈ T.cells ∧ z - I ∉ T.cells) ∨ (z ∉ T.cells ∧ z - I ∈ + T.cells)) → ((∀ (z : GaussianInt), (z, true) ∈ boundaryTags ↔ (z ∈ T.cells ∧ z - 1 ∉ + T.cells) ∨ (z ∉ T.cells ∧ z - 1 ∈ T.cells)) → (∀ (z : GaussianInt), + boundaryEndpointBag.count z = + if cornerBag.count z = 1 ∨ cornerBag.count z = 2 ∨ + cornerBag.count z = 3 then 2 else 0))))) := by + classical + intro T hcheck I cornerBag edgeBag hcornerCount boundaryTags boundaryEndpointBag + hboundaryEndpointCount hboundaryFalse hboundaryTrue z + rw [hboundaryEndpointCount, hcornerCount] + simp only [hboundaryFalse z, hboundaryFalse (z - 1), + hboundaryTrue z, hboundaryTrue (z - I)] + have hcomm : z - I - 1 = z - 1 - I := by ring + rw [hcomm] + have hno := hcheck z + by_cases h0 : z ∈ T.cells <;> + by_cases h1 : z - 1 ∈ T.cells <;> + by_cases hI : z - I ∈ T.cells <;> + by_cases h1I : z - 1 - I ∈ T.cells + all_goals simp [h0, h1, hI, h1I, I] at hno ⊢ + +private theorem hboundaryVertices : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + let boundaryTags := edgeBag.toFinset.filter fun e => edgeBag.count e = 1 + let boundaryEndpointBag : Multiset GaussianInt := boundaryTags.1.bind fun p => + if p.2 then ([p.1, p.1 + I] : List GaussianInt) + else ([p.1, p.1 + 1] : List GaussianInt) + (∀ (z : GaussianInt), boundaryEndpointBag.count z = if cornerBag.count z = 1 ∨ + cornerBag.count z = 2 ∨ cornerBag.count z = 3 then 2 else 0) → ( + let boundaryVertices := cornerBag.toFinset.filter fun z => + cornerBag.count z = 1 ∨ cornerBag.count z = 2 ∨ cornerBag.count z = 3 + boundaryEndpointBag.toFinset = boundaryVertices) := by + classical + intro T I cornerBag edgeBag boundaryTags boundaryEndpointBag hlocalBoundaryDegree boundaryVertices + ext z + simp only [boundaryVertices, Finset.mem_filter, Multiset.mem_toFinset] + rw [← Multiset.count_pos, ← Multiset.count_pos, hlocalBoundaryDegree] + by_cases hc : cornerBag.count z = 1 ∨ cornerBag.count z = 2 ∨ + cornerBag.count z = 3 + · rcases hc with hc | hc | hc <;> simp [hc] + · simp [hc] + +private theorem hboundaryVerticesCard : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let N : Nat → Nat := fun k => + (cornerBag.toFinset.filter fun z => cornerBag.count z = k).card + let boundaryVertices := cornerBag.toFinset.filter fun z => + cornerBag.count z = 1 ∨ cornerBag.count z = 2 ∨ cornerBag.count z = 3 + boundaryVertices.card = N 1 + N 2 + N 3 := by + classical + intro T I cornerBag N boundaryVertices + change (cornerBag.toFinset.filter fun z => + cornerBag.count z = 1 ∨ cornerBag.count z = 2 ∨ + cornerBag.count z = 3).card = N 1 + N 2 + N 3 + rw [Finset.card_filter] + rw [show (∑ z ∈ cornerBag.toFinset, + if cornerBag.count z = 1 ∨ cornerBag.count z = 2 ∨ + cornerBag.count z = 3 then 1 else 0) = + ∑ z ∈ cornerBag.toFinset, + ((if cornerBag.count z = 1 then 1 else 0) + + (if cornerBag.count z = 2 then 1 else 0) + + (if cornerBag.count z = 3 then 1 else 0)) by + apply Finset.sum_congr rfl + intro z hz + by_cases h1 : cornerBag.count z = 1 <;> + by_cases h2 : cornerBag.count z = 2 <;> + by_cases h3 : cornerBag.count z = 3 <;> simp [h1, h2, h3] at *] + simp [Finset.sum_add_distrib, N] + +private theorem hboundaryNumerical : + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + let N : Nat → Nat := fun k => + (cornerBag.toFinset.filter fun z => cornerBag.count z = k).card + let boundaryTags := edgeBag.toFinset.filter fun e => edgeBag.count e = 1 + (boundaryTags.card = (BoundaryFootprintEdges T).ncard) → ( + let boundaryEndpointBag : Multiset GaussianInt := boundaryTags.1.bind fun p => + if p.2 then ([p.1, p.1 + I] : List GaussianInt) + else ([p.1, p.1 + 1] : List GaussianInt) + (boundaryEndpointBag.card = 2 * boundaryTags.card) → ((∀ (z : GaussianInt), + boundaryEndpointBag.count z = if cornerBag.count z = 1 ∨ cornerBag.count z = 2 ∨ + cornerBag.count z = 3 then 2 else 0) → ( + let boundaryVertices := cornerBag.toFinset.filter fun z => + cornerBag.count z = 1 ∨ cornerBag.count z = 2 ∨ cornerBag.count z = 3 + (boundaryEndpointBag.toFinset = boundaryVertices) → ((boundaryVertices.card = N 1 + N 2 + N + 3) → (boundaryTags.card = N 1 + N 2 + N 3))))) := by + classical + intro T I cornerBag edgeBag N boundaryTags hboundaryCard boundaryEndpointBag + hboundaryEndpointCard hlocalBoundaryDegree boundaryVertices hboundaryVertices + hboundaryVerticesCard + have hendpointSum : boundaryEndpointBag.card = 2 * boundaryVertices.card := by + rw [← Multiset.toFinset_sum_count_eq boundaryEndpointBag, + hboundaryVertices] + rw [show (∑ z ∈ boundaryVertices, boundaryEndpointBag.count z) = + ∑ z ∈ boundaryVertices, 2 by + apply Finset.sum_congr rfl + intro z hz + rw [hlocalBoundaryDegree] + have hc := (Finset.mem_filter.mp hz).2 + simp [hc]] + simp [Nat.mul_comm] + rw [hboundaryEndpointCard, hboundaryVerticesCard] at hendpointSum + omega + +end SquareIncidenceProof + +theorem FiniteSquareIncidenceIdentities (T : ProtoTile) (hne : T.cells.Nonempty) + (hcheck : NoCheckerboardCellVertex (T.cells : Set LatticeCell)) : + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let N : Nat → Nat := fun k => + (cornerBag.toFinset.filter fun z => cornerBag.count z = k).card + 4 * T.cells.card = N 1 + 2 * N 2 + 3 * N 3 + 4 * N 4 ∧ + (FootprintVertices T).ncard = N 1 + N 2 + N 3 + N 4 ∧ + 2 * (FootprintEdges T).ncard = 4 * T.cells.card + + (BoundaryFootprintEdges T).ncard ∧ + (BoundaryFootprintEdges T).ncard = N 1 + N 2 + N 3 := by +-- BODY + classical + dsimp only + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeBag : Multiset (GaussianInt × Bool) := T.cells.1.bind fun c => + ([(c, false), (c, true), (c + I, false), (c + 1, true)] : + List (GaussianInt × Bool)) + let N : Nat → Nat := fun k => + (cornerBag.toFinset.filter fun z => cornerBag.count z = k).card + have hbagcard : cornerBag.card = 4 * T.cells.card := SquareIncidenceProof.hbagcard T + have hcountpos (z : GaussianInt) (hz : z ∈ cornerBag.toFinset) : + 1 ≤ cornerBag.count z := SquareIncidenceProof.hcountpos T z hz + have hvertexSet : (cornerBag.toFinset : Set GaussianInt) = FootprintVertices T := + SquareIncidenceProof.hvertexSet T hne + have hvertexCard : cornerBag.toFinset.card = (FootprintVertices T).ncard := + SquareIncidenceProof.hvertexCard T hvertexSet + have hcountle (z : GaussianInt) : cornerBag.count z ≤ 4 := SquareIncidenceProof.hcountle T z + have hcornerCount (z : GaussianInt) : cornerBag.count z = + (if z ∈ T.cells then 1 else 0) + + (if z - 1 ∈ T.cells then 1 else 0) + + (if z - I ∈ T.cells then 1 else 0) + + (if z - 1 - I ∈ T.cells then 1 else 0) := SquareIncidenceProof.hcornerCount T z + have hweighted : ∑ z ∈ cornerBag.toFinset, cornerBag.count z = + N 1 + 2 * N 2 + 3 * N 3 + 4 * N 4 := SquareIncidenceProof.hweighted T hcountpos hcountle + have hunweighted : cornerBag.toFinset.card = N 1 + N 2 + N 3 + N 4 := + SquareIncidenceProof.hunweighted T hcountpos hcountle + have hedgeBagCard : edgeBag.card = 4 * T.cells.card := SquareIncidenceProof.hedgeBagCard T + have hedgeCountPos (e : GaussianInt × Bool) (he : e ∈ edgeBag.toFinset) : + 1 ≤ edgeBag.count e := SquareIncidenceProof.hedgeCountPos T e he + have hedgeCountFalse (z : GaussianInt) : edgeBag.count (z, false) = + (if z ∈ T.cells then 1 else 0) + (if z - I ∈ T.cells then 1 else 0) := + SquareIncidenceProof.hedgeCountFalse T z + have hedgeCountTrue (z : GaussianInt) : edgeBag.count (z, true) = + (if z ∈ T.cells then 1 else 0) + (if z - 1 ∈ T.cells then 1 else 0) := + SquareIncidenceProof.hedgeCountTrue T z + have hedgeCountLe (e : GaussianInt × Bool) : edgeBag.count e ≤ 2 := + SquareIncidenceProof.hedgeCountLe T hedgeCountFalse hedgeCountTrue e + have hedgeMultiplicity : + edgeBag.card = + (edgeBag.toFinset.filter fun e => edgeBag.count e = 1).card + + 2 * (edgeBag.toFinset.filter fun e => edgeBag.count e = 2).card := + SquareIncidenceProof.hedgeMultiplicity T hedgeCountPos hedgeCountLe + have hedgePartition : edgeBag.toFinset.card = + (edgeBag.toFinset.filter fun e => edgeBag.count e = 1).card + + (edgeBag.toFinset.filter fun e => edgeBag.count e = 2).card := + SquareIncidenceProof.hedgePartition T hedgeCountPos hedgeCountLe + have hedgeIdentity : 2 * edgeBag.toFinset.card = 4 * T.cells.card + + (edgeBag.toFinset.filter fun e => edgeBag.count e = 1).card := + SquareIncidenceProof.hedgeIdentity T hedgeBagCard hedgeMultiplicity hedgePartition + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + have pair_eq {a b c d : GaussianInt} + (h : ({a, b} : Finset GaussianInt) = {c, d}) : + (a = c ∧ b = d) ∨ (a = d ∧ b = c) := SquareIncidenceProof.pair_eq (a := a) (b := b) (c := + c) (d := d) h + have edgeOf_injective : Function.Injective edgeOf := SquareIncidenceProof.edgeOf_injective T + pair_eq + have hedgeSet : + ((edgeBag.toFinset.image edgeOf : Finset (Finset GaussianInt)) : + Set (Finset GaussianInt)) = FootprintEdges T := SquareIncidenceProof.hedgeSet T + have hedgeCard : edgeBag.toFinset.card = (FootprintEdges T).ncard := + SquareIncidenceProof.hedgeCard T edgeOf_injective hedgeSet + let boundaryTags := edgeBag.toFinset.filter fun e => edgeBag.count e = 1 + have hboundarySet : + ((boundaryTags.image edgeOf : Finset (Finset GaussianInt)) : + Set (Finset GaussianInt)) = BoundaryFootprintEdges T := SquareIncidenceProof.hboundarySet + T hedgeCountFalse hedgeCountTrue + have hboundaryCard : boundaryTags.card = (BoundaryFootprintEdges T).ncard := + SquareIncidenceProof.hboundaryCard T edgeOf_injective hboundarySet + let boundaryEndpointBag : Multiset GaussianInt := boundaryTags.1.bind fun p => + if p.2 then ([p.1, p.1 + I] : List GaussianInt) + else ([p.1, p.1 + 1] : List GaussianInt) + have hboundaryEndpointCard : boundaryEndpointBag.card = 2 * boundaryTags.card := + SquareIncidenceProof.hboundaryEndpointCard T + have hboundaryEndpointCount (z : GaussianInt) : boundaryEndpointBag.count z = + (if (z, false) ∈ boundaryTags then 1 else 0) + + (if (z - 1, false) ∈ boundaryTags then 1 else 0) + + (if (z, true) ∈ boundaryTags then 1 else 0) + + (if (z - I, true) ∈ boundaryTags then 1 else 0) := + SquareIncidenceProof.hboundaryEndpointCount T z + have hboundaryFalse (z : GaussianInt) : (z, false) ∈ boundaryTags ↔ + (z ∈ T.cells ∧ z - I ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - I ∈ T.cells) := SquareIncidenceProof.hboundaryFalse T hedgeCountFalse z + have hboundaryTrue (z : GaussianInt) : (z, true) ∈ boundaryTags ↔ + (z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - 1 ∈ T.cells) := SquareIncidenceProof.hboundaryTrue T hedgeCountTrue z + have hlocalBoundaryDegree (z : GaussianInt) : + boundaryEndpointBag.count z = + if cornerBag.count z = 1 ∨ cornerBag.count z = 2 ∨ + cornerBag.count z = 3 then 2 else 0 := SquareIncidenceProof.hlocalBoundaryDegree T + hcheck hcornerCount hboundaryEndpointCount hboundaryFalse hboundaryTrue z + let boundaryVertices := cornerBag.toFinset.filter fun z => + cornerBag.count z = 1 ∨ cornerBag.count z = 2 ∨ cornerBag.count z = 3 + have hboundaryVertices : boundaryEndpointBag.toFinset = boundaryVertices := + SquareIncidenceProof.hboundaryVertices T hlocalBoundaryDegree + have hboundaryVerticesCard : boundaryVertices.card = N 1 + N 2 + N 3 := + SquareIncidenceProof.hboundaryVerticesCard T + have hboundaryNumerical : boundaryTags.card = N 1 + N 2 + N 3 := + SquareIncidenceProof.hboundaryNumerical T hboundaryCard hboundaryEndpointCard + hlocalBoundaryDegree hboundaryVertices hboundaryVerticesCard + constructor + · change 4 * T.cells.card = N 1 + 2 * N 2 + 3 * N 3 + 4 * N 4 + rw [← hbagcard, ← hweighted] + exact (Multiset.toFinset_sum_count_eq cornerBag).symm + · constructor + · change (FootprintVertices T).ncard = N 1 + N 2 + N 3 + N 4 + rw [← hvertexCard] + exact hunweighted + · constructor + · rw [← hedgeCard, ← hboundaryCard] + exact hedgeIdentity + · change (BoundaryFootprintEdges T).ncard = N 1 + N 2 + N 3 + rw [← hboundaryCard] + exact hboundaryNumerical + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FiniteTile.lean b/LeanPool/ApollonianSuperharmonic/FiniteTile.lean new file mode 100644 index 0000000000..7de02a2215 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FiniteTile.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeCell + +-- [TABLET NODE: FiniteTile] + +/-! +# FiniteTile + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A finite lattice-cell family is a finite set of lattice cells. We represent +it by the finite set of their lower-left corners in $\mathbb Z[i]$. At this +stage no connectedness or disk condition is imposed. +-/ +abbrev FiniteTile : Type := +-- BODY + Finset LatticeCell + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FootprintDeletionRetention.lean b/LeanPool/ApollonianSuperharmonic/FootprintDeletionRetention.lean new file mode 100644 index 0000000000..0d9407d381 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FootprintDeletionRetention.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CellSupportedFootprintVertices +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.TileCellComplement + +-- [TABLET NODE: FootprintDeletionRetention] + +/-! +# FootprintDeletionRetention + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FootprintDeletionRetention (A B O Y : ProtoTile) + (hO : O.cells ⊆ A.cells) + (hisolated : ∀ x ∈ CellSupportedFootprintVertices O, + ∀ a : GaussianInt, + x ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) -> + a ∈ A.cells ∨ a ∈ B.cells) + (hYA : Disjoint Y.cells A.cells) (hYB : Disjoint Y.cells B.cells) : + Disjoint (CellSupportedFootprintVertices Y) + (CellSupportedFootprintVertices O) ∧ + FootprintEdges (TileCellComplement A O) ∩ FootprintEdges Y = + FootprintEdges A ∩ FootprintEdges Y ∧ + (O.cells = ∅ ∨ + ((TileCellComplement A O).cells.Nonempty ∧ Y.cells.Nonempty) -> + FootprintVertices (TileCellComplement A O) ∩ FootprintVertices Y = + FootprintVertices A ∩ FootprintVertices Y) := by +-- BODY + classical + have singleton_corner {x a : GaussianInt} + (hx : x = a ∨ x = a + 1 ∨ x = a + ⟨0, 1⟩ ∨ + x = a + 1 + ⟨0, 1⟩) : + x ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) := by + simp only [FootprintVertices, Finset.singleton_nonempty, ite_true, + Set.mem_ofPred_eq] + exact ⟨a, Finset.mem_singleton_self a, hx⟩ + have hdisjoint : Disjoint (CellSupportedFootprintVertices Y) + (CellSupportedFootprintVertices O) := by + rw [Set.disjoint_left] + intro x hxY hxO + rcases hxY with ⟨a, haY, hxa⟩ + rcases hisolated x hxO a (singleton_corner hxa) with haA | haB + · exact (Finset.disjoint_left.mp hYA haY) haA + · exact (Finset.disjoint_left.mp hYB haY) haB + have edge_endpoint_supported (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges T) : + ∀ x ∈ e, x ∈ CellSupportedFootprintVertices T := by + rcases he with ⟨a, ha, hshape⟩ + rcases hshape with hshape | hshape | hshape | hshape + · intro x hx + rw [hshape] at hx + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + rcases hx with hx | hx <;> subst x + · exact ⟨a, ha, Or.inl rfl⟩ + · exact ⟨a, ha, Or.inr (Or.inl rfl)⟩ + · intro x hx + rw [hshape] at hx + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + rcases hx with hx | hx <;> subst x + · exact ⟨a, ha, Or.inl rfl⟩ + · exact ⟨a, ha, Or.inr (Or.inr (Or.inl rfl))⟩ + · intro x hx + rw [hshape] at hx + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + rcases hx with hx | hx <;> subst x + · exact ⟨a, ha, Or.inr (Or.inl rfl)⟩ + · exact ⟨a, ha, Or.inr (Or.inr (Or.inr rfl))⟩ + · intro x hx + rw [hshape] at hx + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + rcases hx with hx | hx <;> subst x + · exact ⟨a, ha, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨a, ha, Or.inr (Or.inr (Or.inr rfl))⟩ + have hedge : + FootprintEdges (TileCellComplement A O) ∩ FootprintEdges Y = + FootprintEdges A ∩ FootprintEdges Y := by + ext e + constructor + · intro he + rcases he with ⟨heAO, heY⟩ + refine ⟨?_, heY⟩ + rcases heAO with ⟨a, ha, hshape⟩ + exact ⟨a, (Finset.mem_sdiff.mp ha).1, hshape⟩ + · intro he + rcases he with ⟨heA, heY⟩ + rcases heA with ⟨a, haA, hshape⟩ + have haO : a ∉ O.cells := by + intro haO + have heO : e ∈ FootprintEdges O := ⟨a, haO, hshape⟩ + have heNonempty : e.Nonempty := by + rcases hshape with rfl | rfl | rfl | rfl <;> simp + rcases heNonempty with ⟨x, hx⟩ + exact (Set.disjoint_left.mp hdisjoint + (edge_endpoint_supported Y e heY x hx)) + (edge_endpoint_supported O e heO x hx) + exact ⟨⟨a, Finset.mem_sdiff.mpr ⟨haA, haO⟩, hshape⟩, heY⟩ + refine ⟨hdisjoint, hedge, ?_⟩ + intro hsupport + rcases hsupport with hOempty | ⟨hAO, hY⟩ + · have htile : TileCellComplement A O = A := by + cases A + cases O + simp_all [TileCellComplement] + rw [htile] + · have footprint_eq_supported (T : ProtoTile) (hT : T.cells.Nonempty) : + FootprintVertices T = CellSupportedFootprintVertices T := by + simp [FootprintVertices, CellSupportedFootprintVertices, hT] + rw [footprint_eq_supported _ hAO, footprint_eq_supported _ hY, + footprint_eq_supported _ (by + rcases hAO with ⟨a, ha⟩ + exact ⟨a, (Finset.mem_sdiff.mp ha).1⟩)] + ext x + constructor + · intro hx + rcases hx with ⟨⟨a, ha, hxa⟩, hxY⟩ + exact ⟨⟨a, (Finset.mem_sdiff.mp ha).1, hxa⟩, hxY⟩ + · intro hx + rcases hx with ⟨⟨a, haA, hxa⟩, hxY⟩ + have haO : a ∉ O.cells := by + intro haO + exact (Set.disjoint_left.mp hdisjoint hxY) ⟨a, haO, hxa⟩ + exact ⟨⟨a, Finset.mem_sdiff.mpr ⟨haA, haO⟩, hxa⟩, hxY⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FootprintEdges.lean b/LeanPool/ApollonianSuperharmonic/FootprintEdges.lean new file mode 100644 index 0000000000..0c3d54f16a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FootprintEdges.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: FootprintEdges] + +/-! +# FootprintEdges + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The footprint edges of a prototile are the four unoriented lattice edges of +each constituent square, represented by their two-element endpoint sets. +Thus an edge belongs to the footprint only when it is contributed by a +constituent square; two footprint vertices do not by themselves create an +edge. +-/ +def FootprintEdges (T : ProtoTile) : Set (Finset GaussianInt) := +-- BODY + {e | ∃ x ∈ T.cells, + e = {x, x + 1} ∨ e = {x, x + ⟨0, 1⟩} ∨ + e = {x + 1, x + 1 + ⟨0, 1⟩} ∨ + e = {x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FootprintVertices.lean b/LeanPool/ApollonianSuperharmonic/FootprintVertices.lean new file mode 100644 index 0000000000..c5e4d8bd08 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FootprintVertices.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: FootprintVertices] + +/-! +# FootprintVertices + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The footprint vertices of a nonempty prototile are exactly the four lattice +vertices of each of its constituent cells. The footprint vertex set of an +empty prototile is the singleton containing its anchor. +-/ +def FootprintVertices (T : ProtoTile) : Set GaussianInt := +-- BODY + if T.cells.Nonempty then + {v | ∃ x ∈ T.cells, + v = x ∨ v = x + 1 ∨ v = x + ⟨0, 1⟩ ∨ + v = x + 1 + ⟨0, 1⟩} + else {T.anchor} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordBaseT1.lean b/LeanPool/ApollonianSuperharmonic/FordBaseT1.lean new file mode 100644 index 0000000000..b53f811357 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordBaseT1.lean @@ -0,0 +1,251 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.P5104T1CornerDeletionDisk +public import LeanPool.ApollonianSuperharmonic.LatticeTileDiskUnionInterface +public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.TileTranslation + +-- [TABLET NODE: FordBaseT1] + +/-! +# FordBaseT1 + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FordBaseT1 (P : FordFareyParameter) (hq : 1 < P.q) + (S : Fin 3 → Bool → ProtoTile) + (hS : ∀ i s, BandSubtileOccurrence (FordRecursiveQuadruple P) + (FordTile P.q) i s (S i s)) + (hunion : ∀ x, x ∈ (FordTile P.q).cells ↔ + ∃ i s, x ∈ (S i s).cells) : + LatticeTile (FordTile P.q) ∧ + TileArea (FordTile P.q) = Int.toNat ((FordRecursiveQuadruple P) 0).1 ∧ + ∀ i s, LatticeTile (TileCellComplement (FordTile P.q) (S i s)) ∧ + TileTouching (TileCellComplement (FordTile P.q) (S i s)) (S i s) := by +-- BODY + classical + have hr : 0 < P.q₁ := by + by_contra hz + have hz' : P.q₁ = 0 := by omega + have hd := P.det₁ + simp [hz'] at hd + have hdv : (P.q : Int) ∣ 1 := ⟨P.p₁, by simpa [mul_comm] using hd.symm⟩ + have hqone := Int.eq_one_of_dvd_one (by omega : 0 ≤ (P.q : Int)) hdv + omega + have hs := P.q₂_pos + have hsum : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by + exact_mod_cast P.sum_q + have hrq : (P.q₁ : Int) < (P.q : Int) := by omega + have hsq : (P.q₂ : Int) < (P.q : Int) := by omega + have hgeometry := FordTileGeometry P.q P.q_pos + have harea : TileArea (FordTile P.q) = + Int.toNat ((FordRecursiveQuadruple P) 0).1 := by + change TileArea (FordTile P.q) = Int.toNat ((P.q * P.q : Nat) : Int) + rw [Int.toNat_natCast] + exact hgeometry.2 + obtain ⟨_, _, hrecursive⟩ := FordTileRecursiveIdentification P + obtain ⟨_, R, hR, _, h00, h01, h10, h11, h20, ha20, h21, ha21⟩ := hrecursive hq + have identify (i : Fin 3) (s : Bool) : + (S i s).cells = (R i s).cells ∧ + ((S i s).cells = ∅ → (S i s).anchor = (R i s).anchor) := by + apply BandPrototileCentroidUnique _ _ _ (hS i s).1 (hR i s).1 + have he := (hS i s).2.2.trans (hR i s).2.2.symm + exact sub_left_inj.mp he + have square_mem (r : Nat) (z : GaussianInt) := (P4210T1FordCellRectangles r z).1 + have translated_mem (r : Nat) (u z : GaussianInt) : + z ∈ (TileTranslation (FordTile r) u).cells ↔ + 0 ≤ z.re - u.re ∧ z.re - u.re < (r : Int) ∧ + 0 ≤ z.im - u.im ∧ z.im - u.im < (r : Int) := by + have hm : z ∈ (TileTranslation (FordTile r) u).cells ↔ + z - u ∈ (FordTile r).cells := by + change z ∈ (FordTile r).cells.image (GaussianTranslation u) ↔ _ + constructor + · rintro hz + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hy + · intro hz + exact Finset.mem_image.mpr ⟨z - u, hz, by simp [GaussianTranslation]⟩ + simpa only [Zsqrtd.re_sub, Zsqrtd.im_sub] using hm.trans (square_mem r (z - u)) + have root_ne : (FordTile P.q).cells.Nonempty := by + refine ⟨0, (square_mem _ _).mpr ?_⟩ + simp only [Zsqrtd.re_zero, Zsqrtd.im_zero] + omega + have subset (i : Fin 3) (s : Bool) : (S i s).cells ⊆ (FordTile P.q).cells := by + intro z hz + exact (hunion z).mpr ⟨i, s, hz⟩ + have positive (i : Fin 3) (s : Bool) (r : Nat) (u : GaussianInt) + (hr : 0 < r) (hshape : (S i s).cells = (TileTranslation (FordTile r) u).cells) + (a b : Int) (ha : 0 < a) (haq : a < (P.q : Int)) + (hb : 0 < b) (hbq : b < (P.q : Int)) (left bottom : Bool) + (hcut : ∀ z : GaussianInt, z ∈ (S i s).cells ↔ + (0 ≤ z.re ∧ z.re < (P.q : Int) ∧ 0 ≤ z.im ∧ z.im < (P.q : Int)) ∧ + ((if left then z.re < a else a ≤ z.re) ∧ + (if bottom then z.im < b else b ≤ z.im))) : + LatticeTile (TileCellComplement (FordTile P.q) (S i s)) ∧ + TileTouching (TileCellComplement (FordTile P.q) (S i s)) (S i s) := by + let C := TileCellComplement (FordTile P.q) (S i s) + have hCmem (z : GaussianInt) : z ∈ C.cells ↔ + (0 ≤ z.re ∧ z.re < (P.q : Int) ∧ 0 ≤ z.im ∧ z.im < (P.q : Int)) ∧ + ¬ ((if left then z.re < a else a ≤ z.re) ∧ + (if bottom then z.im < b else b ≤ z.im)) := by + change z ∈ (FordTile P.q).cells \ (S i s).cells ↔ _ + rw [Finset.mem_sdiff, square_mem, hcut] + tauto + have hC : LatticeTile C := + P5104T1CornerDeletionDisk C P.q a b ha haq hb hbq left bottom hCmem + have hU : LatticeTile (S i s) := by + unfold LatticeTile TileRealization + rw [hshape] + exact (TileDiskAreaCovariance (FordTile r) u).1.mp (FordTileGeometry r hr).1 + have hdisjoint : Disjoint C.cells (S i s).cells := by + apply Finset.disjoint_left.mpr + intro z hz hzS + exact (Finset.mem_sdiff.mp hz).2 hzS + have hwhole (z : LatticeCell) : z ∈ (FordTile P.q).cells ↔ + z ∈ C.cells ∨ z ∈ (S i s).cells := by + change z ∈ (FordTile P.q).cells ↔ + z ∈ (FordTile P.q).cells \ (S i s).cells ∨ z ∈ (S i s).cells + rw [Finset.mem_sdiff] + have := subset i s + constructor + · tauto + · rintro (⟨hz, _⟩ | hz) + · exact hz + · exact this hz + let m : GaussianInt := ⟨a, if bottom then 0 else (P.q : Int) - 1⟩ + have hedge_left (V : ProtoTile) (hv : m - 1 ∈ V.cells) : + ({m, m + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges V := by + refine ⟨m - 1, hv, Or.inr (Or.inr (Or.inl ?_))⟩ + simp + have hedge_right (V : ProtoTile) (hv : m ∈ V.cells) : + ({m, m + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges V := + ⟨m, hv, Or.inr (Or.inl rfl)⟩ + have hcommon : (FootprintEdges C ∩ FootprintEdges (S i s)).Nonempty := by + refine ⟨{m, m + ⟨0, 1⟩}, ?_⟩ + cases left + · have hcm : m - 1 ∈ C.cells := by + rw [hCmem] + cases bottom <;> simp [m] <;> omega + have hum : m ∈ (S i s).cells := by + rw [hcut] + cases bottom <;> simp [m] <;> omega + exact ⟨hedge_left C hcm, hedge_right (S i s) hum⟩ + · have hcm : m ∈ C.cells := by + rw [hCmem] + cases bottom <;> simp [m] <;> omega + have hum : m - 1 ∈ (S i s).cells := by + rw [hcut] + cases bottom <;> simp [m] <;> omega + exact ⟨hedge_right C hcm, hedge_left (S i s) hum⟩ + obtain ⟨_, ⟨x, y, p, hp, hp2, _, _, hv, hadj, he⟩, heq, hveq⟩ := + LatticeTileDiskUnionInterface C (S i s) (FordTile P.q) + hC hU hgeometry.1 hdisjoint hwhole hcommon + refine ⟨hC, Or.inl ⟨(LatticeTileFourNeighborConnected C hC).1, + (LatticeTileFourNeighborConnected (S i s) hU).1, hdisjoint, ?_⟩⟩ + rw [hveq, ← heq] + exact ⟨p, hp, hp2, hv, hadj, he⟩ + have empty_case (s : Bool) (hempty : (S 2 s).cells = ∅) + (hanchor : (S 2 s).anchor ∈ BoundaryFootprintVertices (FordTile P.q)) : + LatticeTile (TileCellComplement (FordTile P.q) (S 2 s)) ∧ + TileTouching (TileCellComplement (FordTile P.q) (S 2 s)) (S 2 s) := by + have hcomp : TileCellComplement (FordTile P.q) (S 2 s) = FordTile P.q := by + cases htile : FordTile P.q + simp [TileCellComplement, hempty] + rw [hcomp] + exact ⟨hgeometry.1, Or.inr (Or.inr ⟨hempty, hanchor⟩)⟩ + refine ⟨hgeometry.1, harea, ?_⟩ + intro i s + fin_cases i + · cases s + · apply positive 0 false P.q₁ ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ hr + ((identify 0 false).1.trans h01) P.q₂ P.q₂ (by omega) hsq (by omega) hsq + false false + intro z + rw [(identify 0 false).1, h01, translated_mem] + dsimp + omega + · apply positive 0 true P.q₁ 0 hr (by + rw [(identify 0 true).1, h00] + change (FordTile P.q₁).cells = (FordTile P.q₁).cells.image (GaussianTranslation 0) + rw [show GaussianTranslation 0 = id by funext z; simp [GaussianTranslation]] + simp) + P.q₁ P.q₁ (by omega) hrq (by omega) hrq true true + intro z + rw [(identify 0 true).1, h00, square_mem] + dsimp + omega + · cases s + · apply positive 1 false P.q₂ ⟨0, (P.q₁ : Int)⟩ hs + ((identify 1 false).1.trans h11) P.q₂ P.q₁ (by omega) hsq (by omega) hrq + true false + intro z + rw [(identify 1 false).1, h11, translated_mem] + dsimp + omega + · apply positive 1 true P.q₂ ⟨(P.q₁ : Int), 0⟩ hs + ((identify 1 true).1.trans h10) P.q₁ P.q₂ (by omega) hrq (by omega) hsq + false true + intro z + rw [(identify 1 true).1, h10, translated_mem] + dsimp + omega + · have htop : (⟨(P.q₂ : Int), (P.q : Int)⟩ : GaussianInt) ∈ + BoundaryFootprintVertices (FordTile P.q) := by + let z : GaussianInt := ⟨(P.q₂ : Int), (P.q : Int)⟩ + have hout : z ∉ (FordTile P.q).cells := by rw [square_mem]; simp [z] + have hin : z - ⟨0, 1⟩ ∈ (FordTile P.q).cells := by + rw [square_mem] + simp [z] + omega + rw [BoundaryFootprintVertices, ite_eq_left root_ne] + exact ⟨{z, z + 1}, ⟨z, Or.inl ⟨rfl, Or.inr ⟨hout, hin⟩⟩⟩, by simp [z]⟩ + have hbottom : (⟨(P.q₁ : Int), 0⟩ : GaussianInt) ∈ + BoundaryFootprintVertices (FordTile P.q) := by + let z : GaussianInt := ⟨(P.q₁ : Int), 0⟩ + have hin : z ∈ (FordTile P.q).cells := by rw [square_mem]; simp [z]; omega + have hout : z - ⟨0, 1⟩ ∉ (FordTile P.q).cells := by rw [square_mem]; simp [z] + rw [BoundaryFootprintVertices, ite_eq_left root_ne] + exact ⟨{z, z + 1}, ⟨z, Or.inl ⟨rfl, Or.inl ⟨hin, hout⟩⟩⟩, by simp [z]⟩ + cases s + · have he : (S 2 false).cells = ∅ := (identify 2 false).1.trans h21 + apply empty_case false he + rw [(identify 2 false).2 he, ha21] + exact hbottom + · have he : (S 2 true).cells = ∅ := (identify 2 true).1.trans h20 + apply empty_case true he + rw [(identify 2 true).2 he, ha20] + exact htop + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordBaseT2.lean b/LeanPool/ApollonianSuperharmonic/FordBaseT2.lean new file mode 100644 index 0000000000..129affbd36 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordBaseT2.lean @@ -0,0 +1,189 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric + +-- [TABLET NODE: FordBaseT2] + +/-! +# FordBaseT2 + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FordBaseT2 (q : Nat) (hq : 0 < q) : + QuarterTurnSymmetric (FordTile q) := by +-- BODY + let domain : Finset GaussianInt := + (Finset.range q).product (Finset.range q) |>.image + (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) + have domain_nonempty : domain.Nonempty := by + refine ⟨(⟨(0 : Int), (0 : Int)⟩ : GaussianInt), ?_⟩ + have hz : (⟨(0 : Int), (0 : Int)⟩ : GaussianInt) ∈ domain := by + apply Finset.mem_image.mpr + exact ⟨(0, 0), by simpa using hq, rfl⟩ + exact hz + have domain_injective : Set.InjOn + (fun a : ℕ × ℕ => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) + ↑((Finset.range q).product (Finset.range q)) := by + intro a ha b hb hab + apply Prod.ext + · have coordinate := congrArg Zsqrtd.re hab + change (a.1 : Int) = (b.1 : Int) at coordinate + exact_mod_cast coordinate + · have coordinate := congrArg Zsqrtd.im hab + change (a.2 : Int) = (b.2 : Int) at coordinate + exact_mod_cast coordinate + have domain_card : domain.card = q * q := by + calc + domain.card = ((Finset.range q).product (Finset.range q)).card := by + dsimp [domain] + exact (Finset.card_image_iff.mpr domain_injective) + _ = q * q := by simp + have domain_re_sum : domain.sum (fun z : GaussianInt => z.re) = + (q : Int) * ((q - 1 : Nat) : Int) / 2 * (q : Int) := by + have range_sum : (Finset.range q).sum (fun x => (x : Int)) = + (q : Int) * ((q - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + simp? [domain, Finset.sum_product] + conv_lhs => rw [← Finset.mul_sum (Finset.range q) (fun x => (x : Int)) (q : Int)] + rw [range_sum] + ring + have domain_im_sum : domain.sum (fun z : GaussianInt => z.im) = + (q : Int) * ((q - 1 : Nat) : Int) / 2 * (q : Int) := by + have range_sum : (Finset.range q).sum (fun x => (x : Int)) = + (q : Int) * ((q - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + simp? [domain, Finset.sum_product] + rw [range_sum] + ring + have centroid_formula : TileCentroid (FordTile q) = + ((q : Real) / 2, (q : Real) / 2) := by + change (if domain.Nonempty then + ((↑(domain.sum (fun z : GaussianInt => z.re) : Int) / + ↑domain.card + (1 / 2 : Real)), + (↑(domain.sum (fun z : GaussianInt => z.im) : Int) / + ↑domain.card + (1 / 2 : Real))) else _) = _ + rw [ite_eq_left domain_nonempty] + rw [domain_card, domain_re_sum, domain_im_sum] + norm_num + field_simp + have arithmetic := Finset.sum_range_id_mul_two q + have range_sum : (Finset.range q).sum (fun x => (x : Int)) = + (q : Int) * ((q - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + have arithmetic_cast : + ((Finset.range q).sum (fun x => (x : Int))) * 2 = + (q : Int) * ((q - 1 : Nat) : Int) := by + rw [← Nat.cast_sum] + exact_mod_cast arithmetic + rw [range_sum] at arithmetic_cast + have qcast : ((q - 1 : Nat) : Int) = (q : Int) - 1 := by omega + rw [qcast] at arithmetic_cast + have nat_identity : q * (q - 1) / 2 * 2 + q = q * q := by + rw [← Finset.sum_range_id q] + rw [Finset.sum_range_id_mul_two] + rw [Nat.mul_sub_left_distrib] + simp only [Nat.mul_one] + have product_bound : q ≤ q * q := by nlinarith + rw [Nat.sub_add_cancel product_bound] + norm_num [Int.subNatNat, pow_two] + exact_mod_cast nat_identity + unfold QuarterTurnSymmetric + rw [centroid_formula] + intro p + change p ∈ ⋃ x ∈ domain, ClosedSquareRealization x ↔ + ((q : Real) / 2 - (p.2 - (q : Real) / 2), + (q : Real) / 2 + (p.1 - (q : Real) / 2)) ∈ + ⋃ x ∈ domain, ClosedSquareRealization x + simp only [Set.mem_iUnion] + constructor + · rintro ⟨x, hx, hp⟩ + change x ∈ Finset.image _ ((Finset.range q).product (Finset.range q)) at hx + rcases Finset.mem_image.mp hx with ⟨a, ha, rfl⟩ + rcases Finset.mem_product.mp ha with ⟨ha, hb⟩ + simp only [ClosedSquareRealization, Set.mem_Icc] at hp ⊢ + change ((a.1 : Real) ≤ p.1 ∧ (a.2 : Real) ≤ p.2) ∧ + (p.1 ≤ (a.1 : Real) + 1 ∧ p.2 ≤ (a.2 : Real) + 1) at hp + rcases hp with ⟨⟨hp1, hp2⟩, ⟨hp3, hp4⟩⟩ + let newbase : GaussianInt := + (⟨((q - 1 - a.2 : Nat) : Int), (a.1 : Int)⟩ : GaussianInt) + refine ⟨newbase, ?_, ?_⟩ + · apply Finset.mem_image.mpr + refine ⟨(q - 1 - a.2, a.1), ?_, rfl⟩ + have first_bound : q - 1 - a.2 < q := + Nat.lt_of_le_of_lt (Nat.sub_le _ _) (Nat.sub_lt hq Nat.zero_lt_one) + exact Finset.mem_product.mpr ⟨Finset.mem_range.mpr first_bound, + Finset.mem_range.mpr (Finset.mem_range.mp ha)⟩ + · change ((q : Real) / 2 - (p.2 - (q : Real) / 2), + (q : Real) / 2 + (p.1 - (q : Real) / 2)) ∈ + ClosedSquareRealization newbase + simp only [ClosedSquareRealization, Set.mem_Icc] + dsimp [newbase] + change ((((q - 1 - a.2 : Nat) : Int) : Real) ≤ + (q : Real) / 2 - (p.2 - (q : Real) / 2) ∧ + (a.1 : Real) ≤ (q : Real) / 2 + (p.1 - (q : Real) / 2)) ∧ + ((q : Real) / 2 - (p.2 - (q : Real) / 2) ≤ + (((q - 1 - a.2 : Nat) : Int) : Real) + 1 ∧ + (q : Real) / 2 + (p.1 - (q : Real) / 2) ≤ (a.1 : Real) + 1) + have base_relation : q - 1 - a.2 = q - (a.2 + 1) := by omega + rw [base_relation] + norm_num [Nat.cast_sub (show a.2 + 1 ≤ q from Nat.succ_le_of_lt (Finset.mem_range.mp hb))] + at * + have first_bound : (a.1 : Real) < q := by exact_mod_cast ha.1 + have second_bound : (a.2 : Real) < q := by exact_mod_cast hb + constructor + · constructor <;> linarith + · constructor <;> linarith + · rintro ⟨x, hx, hp⟩ + change x ∈ Finset.image _ ((Finset.range q).product (Finset.range q)) at hx + rcases Finset.mem_image.mp hx with ⟨a, ha, rfl⟩ + rcases Finset.mem_product.mp ha with ⟨ha, hb⟩ + simp only [ClosedSquareRealization, Set.mem_Icc] at hp ⊢ + change ((a.1 : Real) ≤ (q : Real) / 2 - (p.2 - (q : Real) / 2) ∧ + (a.2 : Real) ≤ (q : Real) / 2 + (p.1 - (q : Real) / 2)) ∧ + ((q : Real) / 2 - (p.2 - (q : Real) / 2) ≤ (a.1 : Real) + 1 ∧ + (q : Real) / 2 + (p.1 - (q : Real) / 2) ≤ (a.2 : Real) + 1) at hp + rcases hp with ⟨⟨hp1, hp2⟩, ⟨hp3, hp4⟩⟩ + let newbase : GaussianInt := + (⟨(a.2 : Int), ((q - 1 - a.1 : Nat) : Int)⟩ : GaussianInt) + refine ⟨newbase, ?_, ?_⟩ + · apply Finset.mem_image.mpr + refine ⟨(a.2, q - 1 - a.1), ?_, rfl⟩ + have second_bound : q - 1 - a.1 < q := + Nat.lt_of_le_of_lt (Nat.sub_le _ _) (Nat.sub_lt hq Nat.zero_lt_one) + exact Finset.mem_product.mpr ⟨Finset.mem_range.mpr (Finset.mem_range.mp hb), + Finset.mem_range.mpr second_bound⟩ + · change p ∈ ClosedSquareRealization newbase + simp only [ClosedSquareRealization, Set.mem_Icc] + dsimp [newbase] + change ((((a.2 : Int) : Real) ≤ p.1 ∧ + (((q - 1 - a.1 : Nat) : Int) : Real) ≤ p.2)) ∧ + (p.1 ≤ ((a.2 : Int) : Real) + 1 ∧ + p.2 ≤ (((q - 1 - a.1 : Nat) : Int) : Real) + 1) + have base_relation : q - 1 - a.1 = q - (a.1 + 1) := by omega + rw [base_relation] + norm_num [Nat.cast_sub (show a.1 + 1 ≤ q from Nat.succ_le_of_lt (Finset.mem_range.mp ha))] + at * + have first_bound : (a.1 : Real) < q := by exact_mod_cast ha.1 + have second_bound : (a.2 : Real) < q := by exact_mod_cast hb + constructor + · constructor <;> linarith + · constructor <;> linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordBaseT6.lean b/LeanPool/ApollonianSuperharmonic/FordBaseT6.lean new file mode 100644 index 0000000000..c930b2b015 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordBaseT6.lean @@ -0,0 +1,160 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist +public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P5064T3OrderedPredecessor +public import LeanPool.ApollonianSuperharmonic.P5064T3LiteralLocalization +public import LeanPool.ApollonianSuperharmonic.P5064T3RectangleContacts +public import LeanPool.ApollonianSuperharmonic.P5064T3CrossParentSupport +public import LeanPool.ApollonianSuperharmonic.P5064T3PrecursorSupport + +-- [TABLET NODE: FordBaseT6] + +/-! +# FordBaseT6 + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FordBaseT6 (P : FordFareyParameter) (hq : 1 < P.q) + (r : Fin 4 → CircleCoordinates) (hr : ProperBandQuadruple r) + (hr0 : r 0 = (FordRecursiveQuadruple P) 1) + (hr2 : r 2 = (FordRecursiveQuadruple P) 2) + (hr3 : r 3 = (FordRecursiveQuadruple P) 3) + (h12 : ((FordRecursiveQuadruple P) 2).1 ≤ + ((FordRecursiveQuadruple P) 1).1) + (h2large : 1 < ((FordRecursiveQuadruple P) 2).1) + (S Q R : Fin 3 → Bool → ProtoTile) + (hS : ∀ i s, BandSubtileOccurrence (FordRecursiveQuadruple P) + (FordTile P.q) i s (S i s)) + (hQ : ∀ i s, BandSubtileOccurrence r (S 0 true) i s (Q i s)) + (hR : ∀ i s, BandSubtileOccurrence r (S 0 false) i s (R i s)) : + let q := FordRecursiveQuadruple P + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + (∀ a b : PeriodicSubtileIndex, a ≠ b → + ((FootprintEdges (SubtileOccurrenceInterpretation S u v a) ∩ + FootprintEdges (SubtileOccurrenceInterpretation S u v b)).Nonempty → + AllowedSubtileIncidence a b) ∧ + (¬ AllowedSubtileIncidence a b → + FootprintVertices (SubtileOccurrenceInterpretation S u v a) ∩ + FootprintVertices (SubtileOccurrenceInterpretation S u v b) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation S u v a) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation S u v b)).Subsingleton)) ∧ + FootprintVertices (S 0 true) ∩ FootprintVertices (S 1 true) ⊆ + FootprintVertices (Q 1 true) ∩ FootprintVertices (S 1 true) ∧ + FootprintVertices (S 0 true) ∩ FootprintVertices (S 0 false) ⊆ + (FootprintVertices (Q 1 true) ∩ FootprintVertices (R 2 false)) ∪ + FootprintVertices (Q 0 false) ∪ + (FootprintVertices (Q 2 true) ∩ + FootprintVertices (R 1 false)) := by +-- BODY + classical + obtain ⟨hs, hrs, hd, P₁, hp, hq₁, hp₁, hd₁, hp₂, hs₂, heq⟩ := + P5064T3OrderedPredecessor P r hr hr0 hr2 hr3 h12 h2large + have zeroTrans (T : ProtoTile) : TileTranslation T 0 = T := by + have hz : GaussianTranslation 0 = id := by + funext z + exact add_zero z + simp only [TileTranslation, hz, Finset.image_id, id_eq] + have loc := P5064T3LiteralLocalization P hq (FordTile P.q) 0 + (by rw [zeroTrans]) S hS + simp only [zeroTrans] at loc + have locQ := P5064T3LiteralLocalization P₁ (by omega) (S 0 true) 0 + (by simpa [zeroTrans, hq₁, P5064T3Rectangles] + using (loc 0 true).2.2.2.2) Q + (by intro i b; simpa only [← heq] using hQ i b) + simp only [hd₁, hs₂, zeroTrans] at locQ + have locR := P5064T3LiteralLocalization P₁ (by omega) (S 0 false) + ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ + (by simpa [P5064T3Rectangles, hq₁] using (loc 0 false).2.2.2.2) R + (by intro i b; simpa only [← heq] using hR i b) + simp only [hd₁, hs₂] at locR + have sf (i : Fin 3) (b : Bool) := (loc i b).2.2.1 + have se (i : Fin 3) (b : Bool) := (loc i b).2.2.2.1 + have qf (i : Fin 3) (b : Bool) := (locQ i b).2.2.1 + have rm : FootprintVertices (R 0 true) = + FootprintVertices (P5064T3Rectangles (P.q₁ - P.q₂) P.q₂ 0 false) := by + simpa [P5064T3Rectangles] using (locR 0 true).2.2.1 + have shared : FootprintVertices (Q 0 false) = FootprintVertices (R 0 true) := + (qf 0 false).trans rm.symm + have transFoot (T : ProtoTile) (d : GaussianInt) := + (TileTranslationFormulas T d).2.2.2.2.2.1 + have transEdge (T : ProtoTile) (d : GaussianInt) := + (TileTranslationFormulas T d).2.2.2.2.2.2.1 + let u : GaussianInt := ⟨-(P.q₁ : Int), (P.q : Int)⟩ + let v : GaussianInt := ⟨-(P.q₂ : Int), -(P.q : Int)⟩ + obtain ⟨hproper, hin1, hin2, _⟩ := (FordCoordinateConfiguration P).2 hq + have reversals := (VectorRecursionLaws _ hproper.1).2.2.2.2 hproper + have hu : BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) 1) = ⟨-(P.q₁ : Int), (P.q : Int)⟩ := by + calc + _ = (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 ((FordRecursiveQuadruple P) 1) + ((FordRecursiveQuadruple P) 0) := (reversals 0).1 + _ = _ := by rw [hin1]; ext <;> simp + have hv : BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) 2) = ⟨-(P.q₂ : Int), -(P.q : Int)⟩ := by + calc + _ = (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 ((FordRecursiveQuadruple P) 2) + ((FordRecursiveQuadruple P) 0) := (reversals 1).1 + _ = _ := by rw [hin2]; ext <;> simp + have pf (o : PeriodicSubtileIndex) : + FootprintVertices (SubtileOccurrenceInterpretation S u v o) = + FootprintVertices + (SubtileOccurrenceInterpretation (P5064T3Rectangles P.q₁ P.q₂) u v o) := by + cases h : o.label <;> simp only [SubtileOccurrenceInterpretation, h, + transFoot, sf] + have pe (o : PeriodicSubtileIndex) : + FootprintEdges (SubtileOccurrenceInterpretation S u v o) = + FootprintEdges + (SubtileOccurrenceInterpretation (P5064T3Rectangles P.q₁ P.q₂) u v o) := by + cases h : o.label <;> simp only [SubtileOccurrenceInterpretation, h, + transEdge, se] + have contacts := P5064T3RectangleContacts P.q₁ P.q₂ hs hrs + dsimp only at contacts + rw [← P.sum_q] at contacts + dsimp only + rw [hu, hv] + refine ⟨?_, ?_, ?_⟩ + · intro a b hab + rw [pe a, pe b, pf a, pf b] + exact contacts a b hab + · rw [sf 0 true, sf 1 true, qf 1 true] + exact (P5064T3CrossParentSupport P.q₁ P.q₂ (by omega) hrs).2 + · intro z hz + rw [sf 0 true, sf 0 false, + (P5064T3PrecursorSupport P.q₁ P.q₂ (by omega) hrs).2, ← rm] at hz + exact Or.inl (Or.inr (by rwa [shared])) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordBaseTouching.lean b/LeanPool/ApollonianSuperharmonic/FordBaseTouching.lean new file mode 100644 index 0000000000..448cc61173 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordBaseTouching.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P5110T1TranslationTriples +public import LeanPool.ApollonianSuperharmonic.P5110T1PositiveParentTriples +public import LeanPool.ApollonianSuperharmonic.P5110T1AnchoredTriples +public import LeanPool.ApollonianSuperharmonic.P5110T1ParentLocalization +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality + +-- [TABLET NODE: FordBaseTouching] + +/-! +# FordBaseTouching + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FordBaseTouching (P : FordFareyParameter) (hq : 1 < P.q) : + let q := FordRecursiveQuadruple P + let T := FordTile P.q + (∀ i : Fin 3, + TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) + (TileTranslation T (-BandVectors.1 (q ((i + 1).succ)) (q 0)))) ∧ + (∀ (i : Fin 3) (U : ProtoTile), BandPrototile (q i.succ) U → + TileCentroid U - TileCentroid T = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U) ∧ + (∀ (i : Fin 3) (U V : ProtoTile), + BandPrototile (q i.succ) U → + BandPrototile (q ((i + 1).succ)) V → + TileCentroid U - TileCentroid T = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TileCentroid V - TileCentroid T = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ)))) → + TouchingTriple T U V) := by +-- BODY + have hr : 0 < P.q₁ := by + by_contra h + have hz : P.q₁ = 0 := by omega + have hd := P.det₁ + simp only [hz, Nat.cast_zero, zero_mul, sub_zero] at hd + have hdv : (P.q : Int) ∣ 1 := ⟨P.p₁, by simpa [mul_comm] using hd.symm⟩ + have := Int.eq_one_of_dvd_one (by omega : 0 ≤ (P.q : Int)) hdv + omega + have hs := P.q₂_pos + obtain ⟨_, h10, h20, h30, _⟩ := (FordCoordinateConfiguration P).2 hq + have ht := P5110T1TranslationTriples P.q₁ P.q₂ hr hs + have hp := P5110T1PositiveParentTriples P.q₁ P.q₂ hr hs + have he := P5110T1AnchoredTriples P.q₁ P.q₂ hr hs + dsimp only at ht hp he ⊢ + rw [← P.sum_q] at ht hp he + have touch_transport (A A' B B' : ProtoTile) + (hA : A.cells = A'.cells ∧ (A.cells = ∅ → A.anchor = A'.anchor)) + (hB : B.cells = B'.cells ∧ (B.cells = ∅ → B.anchor = B'.anchor)) + (h : TileTouching A B) : TileTouching A' B' := by + have oA := ProtoTileObservableExtensionality A A' hA.1 hA.2 + have oB := ProtoTileObservableExtensionality B B' hB.1 hB.2 + rcases h with h | h | h + · rcases h with ⟨ha, hb, hd, hpath⟩ + left + refine ⟨?_, ?_, ?_, ?_⟩ + · rwa [← hA.1] + · rwa [← hB.1] + · rwa [← hA.1, ← hB.1] + · rwa [← oA.2.1, ← oB.2.1, ← oA.2.2.1, ← oB.2.2.1] + · right; left + refine ⟨?_, ?_⟩ + · exact hA.1 ▸ h.1 + · rw [← hA.2 h.1, ← oB.2.1] + exact h.2 + · right; right + refine ⟨?_, ?_⟩ + · exact hB.1 ▸ h.1 + · rw [← hB.2 h.1, ← oA.2.1] + exact h.2 + have triple_transport (A A' B B' C C' : ProtoTile) + (hA : A.cells = A'.cells ∧ (A.cells = ∅ → A.anchor = A'.anchor)) + (hB : B.cells = B'.cells ∧ (B.cells = ∅ → B.anchor = B'.anchor)) + (hC : C.cells = C'.cells ∧ (C.cells = ∅ → C.anchor = C'.anchor)) + (h : TouchingTriple A B C) : TouchingTriple A' B' C' := by + refine ⟨touch_transport A A' B B' hA hB h.1, + touch_transport B B' C C' hB hC h.2.1, + touch_transport C C' A A' hC hA h.2.2.1, ?_⟩ + have oA := (ProtoTileObservableExtensionality A A' hA.1 hA.2).2.1 + have oB := (ProtoTileObservableExtensionality B B' hB.1 hB.2).2.1 + have oC := (ProtoTileObservableExtensionality C C' hC.1 hC.2).2.1 + simpa only [oA, oB, oC] using h.2.2.2 + have obs_symm (A B : ProtoTile) + (h : A.cells = B.cells ∧ (A.cells = ∅ → A.anchor = B.anchor)) : + B.cells = A.cells ∧ (B.cells = ∅ → B.anchor = A.anchor) := + ⟨h.1.symm, fun he => (h.2 (h.1.trans he)).symm⟩ + have obs_refl (A : ProtoTile) : + A.cells = A.cells ∧ (A.cells = ∅ → A.anchor = A.anchor) := ⟨rfl, fun _ => rfl⟩ + have neg_pair (a b : Int) : -(⟨a, b⟩ : GaussianInt) = ⟨-a, -b⟩ := rfl + refine ⟨?_, ?_, ?_⟩ + · intro i + fin_cases i + · simpa [h10, h20, h30, neg_pair] using ht.1 + · simpa [h10, h20, h30, neg_pair] using ht.2.1 + · simpa [h10, h20, h30, neg_pair] using ht.2.2 + · intro i U hU hcent + have hloc := P5110T1ParentLocalization P hq i true U hU (by simpa using hcent) + have hmodel : TouchingTriple (FordTile P.q) + (TileTranslation (FordTile P.q) + (BandVectors.1 ((FordRecursiveQuadruple P) i.succ) ((FordRecursiveQuadruple P) 0))) + (P5110T1ParentModel P.q₁ P.q₂ i true) := by + fin_cases i + · simpa [h10, h20, h30] using hp.1 + · simpa [h10, h20, h30] using hp.2.1 + · simpa [h10, h20, h30] using he.1 + exact triple_transport _ _ _ _ _ _ (obs_refl _) (obs_refl _) + (obs_symm _ _ hloc) hmodel + · intro i U V hU hV hcentU hcentV + have hlocU := P5110T1ParentLocalization P hq i true U hU (by simpa using hcentU) + have hlocV := P5110T1ParentLocalization P hq (i + 1) false V hV (by + simpa [sub_eq_add_neg] using hcentV) + have hmodel : TouchingTriple (FordTile P.q) + (P5110T1ParentModel P.q₁ P.q₂ i true) + (P5110T1ParentModel P.q₁ P.q₂ (i + 1) false) := by + fin_cases i + · simpa using hp.2.2 + · simpa using he.2.1 + · simpa using he.2.2 + exact triple_transport _ _ _ _ _ _ (obs_refl _) + (obs_symm _ _ hlocU) (obs_symm _ _ hlocV) hmodel + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordBoundaryMultiplicity.lean b/LeanPool/ApollonianSuperharmonic/FordBoundaryMultiplicity.lean new file mode 100644 index 0000000000..66c9d9f122 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordBoundaryMultiplicity.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains +public import LeanPool.ApollonianSuperharmonic.LatticeVertexBoundary + +-- [TABLET NODE: FordBoundaryMultiplicity] + +/-! +# FordBoundaryMultiplicity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a Ford--Farey parameter and a lattice vertex $x$, the recursive boundary +multiplicity $m_P(x)$ is the number of indices $i\in\{1,2,3,4\}$ for which +$x\in\partial E_i$. +-/ +noncomputable def FordBoundaryMultiplicity (P : FordFareyParameter) + (x : GaussianInt) : Nat := +-- BODY + by + classical + exact (Finset.univ.filter fun i : Fin 4 => + x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P i)).card + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordCellDomain.lean b/LeanPool/ApollonianSuperharmonic/FordCellDomain.lean new file mode 100644 index 0000000000..87467ac5da --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordCellDomain.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FiniteTile + +-- [TABLET NODE: FordCellDomain] + +/-! +# FordCellDomain + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The Ford cell domain of denominator $q$ is the half-open $q$-by-$q$ square +of cell basepoints +$$ + D^{\mathrm F}_q=\{x+yi:0\leq x (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordCenteredInteriorOdometerStencil.lean b/LeanPool/ApollonianSuperharmonic/FordCenteredInteriorOdometerStencil.lean new file mode 100644 index 0000000000..576e02adbe --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordCenteredInteriorOdometerStencil.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryGlobalOdometerTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordOdometerFamilyExistsUnique +public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P5448T1CenteredFordGeometry +public import LeanPool.ApollonianSuperharmonic.P5448T1CommonAffineFordPair +public import LeanPool.ApollonianSuperharmonic.P5448T1CanonicalFordBoundary +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: FordCenteredInteriorOdometerStencil] + +/-! +# FordCenteredInteriorOdometerStencil + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FordCenteredInteriorOdometerStencil : + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C0 + T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> Bool -> + PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> ProtoTile), + ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> PartialOdometer), ∀ (g + : IntegerLatticeFunction), ∀ (x : GaussianInt), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ((GlobalOdometerExtends g h) → ((Nat.card {is : Fin 3 × + Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2) → ((GaussianRealPoint x = + TileCentroid T) → (((cfg.firstPredecessor 1).1 = 0) → (FourNeighborLaplacian g x = + 0))))) := by + intro q cfg C0 T cert h P r Q S u v g x data hext hk hcenter hzero +-- BODY + obtain ⟨F, s, delta, f, hq, _, _, _, _, _, htP, htM, hdP, hdM, + ⟨sp, sm, hsp, hsm, hsx, hsy⟩, hresP, hresM, hextF, hlap⟩ := + P5448T1CenteredFordGeometry q cfg C0 T cert h P r Q S u v g x + data hext hcenter hzero + have bounds := P5130T5ParentArithmetic F hq + have hsum : (F.q : Int) = F.q₁ + F.q₂ := by exact_mod_cast F.sum_q + have hp0 := (hdP 0).mpr (by simp) + have hm0 := (hdM 0).mpr (by simp) + have hshared := (hresP 0 hp0).2.symm.trans (hresM 0 hm0).2 + obtain ⟨a, b, hvP, hvM⟩ := P5448T1CommonAffineFordPair F hq _ _ _ _ + htP htM hdP hdM sp sm hsp hsm hsx hsy hshared + obtain ⟨c, hc⟩ := hextF + have extP (z : GaussianInt) (hz : z ∈ _) := + (hc z (hresP z hz).1).trans (congrArg (fun t : Int => t + c) (hresP z hz).2) + have extM (z : GaussianInt) (hz : z ∈ _) := + (hc z (hresM z hz).1).trans (congrArg (fun t : Int => t + c) (hresM z hz).2) + obtain ⟨hedge, hup, hdown⟩ := P5448T1CanonicalFordBoundary F hq + have f0 : f 0 = b + c := by + rw [extP 0 hp0, hvP 0 hp0] + simpa using congrArg (fun t : Int => t + b + c) + (hedge (F.q₁ : Int) (by omega) (by omega)).1 + have fp : f 1 = a.re + b + c := by + have hz := (hdP 1).mpr (by simp; omega) + rw [extP 1 hz, hvP 1 hz] + have hb := (hedge (1 + (F.q₁ : Int)) (by omega) (by omega)).1 + have he : (1 : GaussianInt) + ⟨(F.q₁ : Int), 0⟩ = ⟨1 + (F.q₁ : Int), 0⟩ := by + ext <;> simp + rw [he, hb] + simp + have fm : f (-1) = -a.re + b + c := by + have hz := (hdP (-1)).mpr (by simp; omega) + rw [extP (-1) hz, hvP (-1) hz] + have hb := (hedge (-1 + (F.q₁ : Int)) (by omega) (by omega)).1 + have he : (-1 : GaussianInt) + ⟨(F.q₁ : Int), 0⟩ = ⟨-1 + (F.q₁ : Int), 0⟩ := by + ext <;> simp + rw [he, hb] + simp + have fu : f ⟨0, 1⟩ = a.im + b + c := by + have hz := (hdP ⟨0, 1⟩).mpr (by dsimp; omega) + rw [extP _ hz, hvP _ hz] + have he : (⟨0, 1⟩ : GaussianInt) + ⟨(F.q₁ : Int), 0⟩ = ⟨(F.q₁ : Int), 1⟩ := by + ext <;> simp + rw [he, hup] + simp + have fd : f (-⟨0, 1⟩) = -a.im + b + c := by + have hz := (hdM (-⟨0, 1⟩)).mpr (by simp; omega) + rw [extM _ hz, hvM _ hz] + have he : -(⟨0, 1⟩ : GaussianInt) + ⟨(F.q₂ : Int), (F.q : Int)⟩ = + ⟨(F.q₂ : Int), (F.q : Int) - 1⟩ := by + ext <;> simp; ring + rw [he, hdown] + simp + rw [← hlap] + simp only [FourNeighborLaplacian, zero_add, zero_sub, f0, fp, fm, fu, fd] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordCircleCoordinate.lean b/LeanPool/ApollonianSuperharmonic/FordCircleCoordinate.lean new file mode 100644 index 0000000000..6125aef47d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordCircleCoordinate.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates + +-- [TABLET NODE: FordCircleCoordinate] + +/-! +# FordCircleCoordinate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $p\in\mathbb Z$ and $q\in\mathbb N$, the raw Ford curvature coordinate is +$$ + C_{p,q}:=(q^2,\,1+2pq\,i). +$$ +Only positive $q$ are used as circles; the formal pair $(1,0)$ in the +Farey-parent convention is interpreted separately as a line. +-/ +def FordCircleCoordinate (p : Int) (q : Nat) : CircleCoordinates := +-- BODY + ((q * q : Nat), ⟨1, 2 * p * (q : Int)⟩) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean b/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean new file mode 100644 index 0000000000..b3e5c07304 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean @@ -0,0 +1,1353 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandCircle +public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist +public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple + +-- [TABLET NODE: FordCoordinateConfiguration] + +/-! +# FordCoordinateConfiguration + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FordConfigurationProof + +private theorem determinantCoprime : + ∀ (a : Int), ∀ (b : Nat), ∀ (d : Nat), ∀ (c : Int), a * (d : Int) - (b : Int) * c = 1 → + Nat.Coprime b a.natAbs := by + classical + intro a b d c hd + rw [Nat.coprime_iff_gcd_eq_one] + apply Nat.dvd_one.mp + let g := Nat.gcd b a.natAbs + have gb : g ∣ b := Nat.gcd_dvd_left _ _ + have ga : g ∣ a.natAbs := Nat.gcd_dvd_right _ _ + have gb' : (g : Int) ∣ (b : Int) := by exact_mod_cast gb + have ga' : (g : Int) ∣ a := + (Int.dvd_natAbs).mp (by exact_mod_cast ga) + have gd : (g : Int) ∣ a * (d : Int) - (b : Int) * c := by + exact dvd_sub (dvd_mul_of_dvd_left ga' _) (dvd_mul_of_dvd_left gb' _) + have gd1 : (g : Int) ∣ 1 := by simpa [hd] using gd + have ge : (g : Int) = 1 := + Int.eq_one_of_dvd_one (by exact_mod_cast (Nat.zero_le g)) gd1 + have gn : g = 1 := by exact_mod_cast ge + simp [g, gn] + +private theorem hv32At253 : + ∀ (Q : FordFareyParameter), (Q.q₁ = 1) → ((Q.q₂ = 1) → ((Q.p₁ = Q.p₂ + 1) → ((Q.q = 2) → + ((FordCircleCoordinate Q.p₂ 1 = (1, 1 + 2 * (⟨0, Q.p₂ - 1⟩ : GaussianInt) + 2 * (⟨0, 1⟩ : + GaussianInt))) → ((BandVectors.1 ((0 : ℤ), (-1 : GaussianInt)) ((0 : ℤ), (1 : + GaussianInt)) = (0 : GaussianInt) ∧ BandVectors.1 ((0 : ℤ), (1 : GaussianInt)) ((1 : ℤ), + (1 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 : ℤ)⟩ + (2 : GaussianInt) * + ⟨(0 : ℤ), (1 : ℤ)⟩) = (-1 : GaussianInt) ∧ BandVectors.1 ((1 : ℤ), (1 : GaussianInt) + (2 + : GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 : ℤ)⟩ + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) ((0 + : ℤ), (-1 : GaussianInt)) = (1 : GaussianInt) ∧ BandVectors.2 ((0 : ℤ), (-1 : + GaussianInt)) ((0 : ℤ), (1 : GaussianInt)) = (1 : GaussianInt) ∧ BandVectors.2 ((0 : ℤ), + (1 : GaussianInt)) ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 + : ℤ)⟩ + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) = (-1 : GaussianInt) - ⟨(0 : ℤ), Q.p₂ - + (1 : ℤ)⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ BandVectors.2 ((1 : ℤ), (1 : GaussianInt) + (2 : + GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 : ℤ)⟩ + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) ((0 : + ℤ), (-1 : GaussianInt)) = ⟨(0 : ℤ), Q.p₂⟩) → ((BandVectors.1 ((1 : ℤ), (1 : GaussianInt) + + (2 : GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 : ℤ)⟩ + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) + ((0 : ℤ), (-1 : GaussianInt)) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 ((0 : ℤ), (-1 : + GaussianInt)) ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 : ℤ)⟩ + + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) ∧ BandVectors.2 ((1 : ℤ), (1 : GaussianInt) + + (2 : GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 : ℤ)⟩ + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) + ((0 : ℤ), (-1 : GaussianInt)) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 ((0 : ℤ), (-1 : + GaussianInt)) ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 : ℤ)⟩ + + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩)) → (BandVectors.1 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2) = + -((⟨0, 1⟩ : GaussianInt) * (Q.q₂ : GaussianInt))))))))) := by + classical + intro Q qone hqone hp hq coord2 b2 f1 + have hx := f1.1 + have hbase := b2.2.2.1 + have hi : (⟨0, 1⟩ : GaussianInt) * ⟨0, 1⟩ = -1 := by + ext <;> norm_num + have hx' : (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2) = 1 := by + simpa [FordRecursiveQuadruple, qone, hqone, hp, hq, + Q.sum_p, Q.sum_q, coord2] using hx.symm.trans hbase + calc + BandVectors.1 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2) = + (-((⟨0, 1⟩ : GaussianInt))) * + ((⟨0, 1⟩ : GaussianInt) * + BandVectors.1 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2)) := by + simp only [neg_mul] + rw [← mul_assoc, hi] + simp + _ = -((⟨0, 1⟩ : GaussianInt) * (Q.q₂ : GaussianInt)) := by + rw [hx'] + simp [hqone] + +private theorem ha13At278 : + ∀ (Q : FordFareyParameter), (Q.q₁ = 1) → ((Q.q₂ = 1) → ((Q.p₁ = Q.p₂ + 1) → ((Q.q = 2) → ( + let z : GaussianInt := ⟨0, Q.p₂⟩ + (FordCircleCoordinate (Q.p₂ + 1) 1 = (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt))) → + ((BandVectors.1 ((0 : ℤ), (-1 : GaussianInt)) ((0 : ℤ), (1 : GaussianInt)) = (0 : + GaussianInt) ∧ BandVectors.1 ((0 : ℤ), (1 : GaussianInt)) ((1 : ℤ), (1 : GaussianInt) + + (2 : GaussianInt) * z + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) = (-1 : GaussianInt) ∧ + BandVectors.1 ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z + (2 : GaussianInt) * + ⟨(0 : ℤ), (1 : ℤ)⟩) ((0 : ℤ), (-1 : GaussianInt)) = (1 : GaussianInt) ∧ BandVectors.2 ((0 + : ℤ), (-1 : GaussianInt)) ((0 : ℤ), (1 : GaussianInt)) = (1 : GaussianInt) ∧ + BandVectors.2 ((0 : ℤ), (1 : GaussianInt)) ((1 : ℤ), (1 : GaussianInt) + (2 : + GaussianInt) * z + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) = (-1 : GaussianInt) - z - ⟨(0 + : ℤ), (1 : ℤ)⟩ ∧ BandVectors.2 ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z + (2 : + GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) ((0 : ℤ), (-1 : GaussianInt)) = z + ⟨(0 : ℤ), (1 : + ℤ)⟩) → (BandVectors.2 ((FordRecursiveQuadruple Q) 1) + ((FordRecursiveQuadruple Q) 3) = + (⟨0, 1⟩ : GaussianInt) * (Q.p₁ : GaussianInt))))))) := by + classical + intro Q qone hqone hp hq z coord1 b1 + calc + BandVectors.2 ((FordRecursiveQuadruple Q) 1) + ((FordRecursiveQuadruple Q) 3) = ⟨0, Q.p₂ + 1⟩ := by + simpa [FordRecursiveQuadruple, qone, hqone, hp, hq, Q.sum_p, + Q.sum_q, z, coord1] using b1.2.2.2.2.2 + _ = (⟨0, 1⟩ : GaussianInt) * (Q.p₁ : GaussianInt) := by + ext <;> simp [hp] + +private theorem ha32At288 : + ∀ (Q : FordFareyParameter), (Q.q₁ = 1) → ((Q.q₂ = 1) → ((Q.p₁ = Q.p₂ + 1) → ((Q.q = 2) → + ((FordCircleCoordinate Q.p₂ 1 = (1, 1 + 2 * (⟨0, Q.p₂ - 1⟩ : GaussianInt) + 2 * (⟨0, 1⟩ : + GaussianInt))) → ((BandVectors.1 ((0 : ℤ), (-1 : GaussianInt)) ((0 : ℤ), (1 : + GaussianInt)) = (0 : GaussianInt) ∧ BandVectors.1 ((0 : ℤ), (1 : GaussianInt)) ((1 : ℤ), + (1 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 : ℤ)⟩ + (2 : GaussianInt) * + ⟨(0 : ℤ), (1 : ℤ)⟩) = (-1 : GaussianInt) ∧ BandVectors.1 ((1 : ℤ), (1 : GaussianInt) + (2 + : GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 : ℤ)⟩ + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) ((0 + : ℤ), (-1 : GaussianInt)) = (1 : GaussianInt) ∧ BandVectors.2 ((0 : ℤ), (-1 : + GaussianInt)) ((0 : ℤ), (1 : GaussianInt)) = (1 : GaussianInt) ∧ BandVectors.2 ((0 : ℤ), + (1 : GaussianInt)) ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 + : ℤ)⟩ + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) = (-1 : GaussianInt) - ⟨(0 : ℤ), Q.p₂ - + (1 : ℤ)⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ BandVectors.2 ((1 : ℤ), (1 : GaussianInt) + (2 : + GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 : ℤ)⟩ + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) ((0 : + ℤ), (-1 : GaussianInt)) = ⟨(0 : ℤ), Q.p₂⟩) → ((BandVectors.1 ((1 : ℤ), (1 : GaussianInt) + + (2 : GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 : ℤ)⟩ + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) + ((0 : ℤ), (-1 : GaussianInt)) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 ((0 : ℤ), (-1 : + GaussianInt)) ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 : ℤ)⟩ + + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) ∧ BandVectors.2 ((1 : ℤ), (1 : GaussianInt) + + (2 : GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 : ℤ)⟩ + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) + ((0 : ℤ), (-1 : GaussianInt)) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 ((0 : ℤ), (-1 : + GaussianInt)) ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * ⟨(0 : ℤ), Q.p₂ - (1 : ℤ)⟩ + + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩)) → (BandVectors.2 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2) = -(Q.p₂ : GaussianInt)))))))) := by + classical + intro Q qone hqone hp hq coord2 b2 f1 + have hx := f1.2 + have hbase := b2.2.2.2.2.2 + have hi : (⟨0, 1⟩ : GaussianInt) * ⟨0, 1⟩ = -1 := by + ext <;> norm_num + have hx' : -(⟨0, 1⟩ : GaussianInt) * + BandVectors.2 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2) = + ⟨0, Q.p₂⟩ := by + simpa [FordRecursiveQuadruple, qone, hqone, hp, hq, + Q.sum_p, Q.sum_q, coord2] using hx.symm.trans hbase + calc + BandVectors.2 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2) = + (⟨0, 1⟩ : GaussianInt) * + (-(⟨0, 1⟩ : GaussianInt) * + BandVectors.2 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2)) := by + rw [← mul_assoc] + ext <;> norm_num + _ = -(Q.p₂ : GaussianInt) := by + rw [hx'] + ext <;> simp + +private theorem hsemiAt342 : + (ℕ) → (∀ (Q : FordFareyParameter), ∀ (q1pos : 0 < Q.q₁), ∀ (hgtq : Q.q₁ > Q.q₂), + let pd : Int + := Q.p₁ - Q.p₂ + let qd : Nat := Q.q₁ - Q.q₂ + (0 < qd) → (∀ (hqdlt : qd < Q.q₁), ∀ (hd1 : pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = + 1), ∀ (hd2 : Q.p₂ * (Q.q₁ : Int) - (Q.q₂ : Int) * Q.p₁ = -1), ∀ (hred : Nat.Coprime Q.q₁ + Q.p₁.natAbs), ∀ (hq1gt : 1 < Q.q₁), + let R : FordFareyParameter := { + p := Q.p₁, q := Q.q₁, q_pos := q1pos, reduced := hred, + p₁ := pd, q₁ := qd, p₂ := Q.p₂, q₂ := Q.q₂, + sum_p := by dsimp [pd]; ring, + sum_q := by dsimp [qd]; omega, + det₁ := hd1, det₂ := hd2, q₁_lt := hqdlt, + q₂_pos := Q.q₂_pos, + unit_case := by intro hu; omega } + (SemiProperQuadruple ![((2 : ℤ) * (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * + (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (FordRecursiveQuadruple R (3 : + Fin (4 : ℕ))).1 - (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * + (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * + (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))).2 - (FordRecursiveQuadruple R (1 : Fin (4 : + ℕ))).2), FordRecursiveQuadruple R (0 : Fin (4 : ℕ)), FordRecursiveQuadruple R (2 : Fin (4 + : ℕ)), FordRecursiveQuadruple R (3 : Fin (4 : ℕ))]) → (SemiProperQuadruple + (FordRecursiveQuadruple Q)))) := by + classical + intro n Q q1pos hgtq pd qd hqdpos hqdlt hd1 hd2 hred hq1gt R hsucc + convert hsucc using 1; + simp? [FordRecursiveQuadruple, R, pd, qd, Q.sum_p, Q.sum_q, + FordCircleCoordinate, hqdpos.ne'] + all_goals try rw [Nat.cast_sub (by omega)] + repeat' first | constructor | (ext <;> simp; ring) + all_goals try ring + all_goals try (intro hz; omega) + +private theorem hv13At359 : + (ℕ) → (∀ (Q : FordFareyParameter), ∀ (q1pos : 0 < Q.q₁), ∀ (hgtq : Q.q₁ > Q.q₂), + let pd : Int + := Q.p₁ - Q.p₂ + let qd : Nat := Q.q₁ - Q.q₂ + ∀ (hqdlt : qd < Q.q₁), ∀ (hd1 : pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = 1), ∀ (hd2 : Q.p₂ * + (Q.q₁ : Int) - (Q.q₂ : Int) * Q.p₁ = -1), ∀ (hred : Nat.Coprime Q.q₁ Q.p₁.natAbs), ∀ + (hq1gt : 1 < Q.q₁), + let R : FordFareyParameter := { + p := Q.p₁, q := Q.q₁, q_pos := q1pos, reduced := hred, + p₁ := pd, q₁ := qd, p₂ := Q.p₂, q₂ := Q.q₂, + sum_p := by dsimp [pd]; ring, + sum_q := by dsimp [qd]; omega, + det₁ := hd1, det₂ := hd2, q₁_lt := hqdlt, + q₂_pos := Q.q₂_pos, + unit_case := by intro hu; omega } + (BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : + Fin (4 : ℕ))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.q₂ : GaussianInt))) → ((BandVectors.1 + (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + = (↑R.q₁ : GaussianInt)) → ((BandVectors.1 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) = BandVectors.1 (FordRecursiveQuadruple R (2 + : Fin (4 : ℕ))) (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : + Fin (4 : ℕ))) ∧ BandVectors.1 (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = BandVectors.1 (FordRecursiveQuadruple R (1 + : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : + Fin (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) = BandVectors.2 (FordRecursiveQuadruple R (2 + : Fin (4 : ℕ))) (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : + Fin (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = BandVectors.2 (FordRecursiveQuadruple R (1 + : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : + Fin (4 : ℕ)))) → (BandVectors.1 ((FordRecursiveQuadruple Q) 1) + ((FordRecursiveQuadruple Q) 3) = (Q.q₁ : GaussianInt))))) := by + classical + intro n Q q1pos hgtq pd qd hqdlt hd1 hd2 hred hq1gt R rv32 rv13 direct + have hx := direct.2.1 + rw [rv13, rv32] at hx + simp? [FordRecursiveQuadruple, R] at hx + have hqdrel : qd + Q.q₂ = Q.q₁ := by + dsimp [qd] + omega + have hqdrel' : (qd : Int) + (Q.q₂ : Int) = (Q.q₁ : Int) := by + exact_mod_cast hqdrel + have hcalc : (qd : GaussianInt) + + (⟨0, 1⟩ : GaussianInt) * + (-((⟨0, 1⟩ : GaussianInt) * (Q.q₂ : GaussianInt))) = + (Q.q₁ : GaussianInt) := by + have hle : Q.q₂ ≤ Q.q₁ := Nat.le_of_lt hgtq + have hi : (⟨0, 1⟩ : GaussianInt) * ⟨0, 1⟩ = -1 := by + ext <;> norm_num + have hmul : (⟨0, 1⟩ : GaussianInt) * + (-((⟨0, 1⟩ : GaussianInt) * (Q.q₂ : GaussianInt))) = + (Q.q₂ : GaussianInt) := by + rw [mul_neg, ← mul_assoc, hi] + simp + rw [hmul] + ext <;> simp [qd, Nat.cast_sub hle]; + rw [← mul_neg] at hx + rw [hcalc] at hx + simpa [FordRecursiveQuadruple, R, Q.sum_q, q1pos.ne'] using hx + +private theorem ha13At390 : + (ℕ) → (∀ (Q : FordFareyParameter), ∀ (q1pos : 0 < Q.q₁), ∀ (hgtq : Q.q₁ > Q.q₂), + let pd : Int + := Q.p₁ - Q.p₂ + let qd : Nat := Q.q₁ - Q.q₂ + ∀ (hqdlt : qd < Q.q₁), ∀ (hd1 : pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = 1), ∀ (hd2 : Q.p₂ * + (Q.q₁ : Int) - (Q.q₂ : Int) * Q.p₁ = -1), ∀ (hred : Nat.Coprime Q.q₁ Q.p₁.natAbs), ∀ + (hq1gt : 1 < Q.q₁), + let R : FordFareyParameter := { + p := Q.p₁, q := Q.q₁, q_pos := q1pos, reduced := hred, + p₁ := pd, q₁ := qd, p₂ := Q.p₂, q₂ := Q.q₂, + sum_p := by dsimp [pd]; ring, + sum_q := by dsimp [qd]; omega, + det₁ := hd1, det₂ := hd2, q₁_lt := hqdlt, + q₂_pos := Q.q₂_pos, + unit_case := by intro hu; omega } + (BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : + Fin (4 : ℕ))) = -(↑R.p₂ : GaussianInt)) → ((BandVectors.2 (FordRecursiveQuadruple R (1 : + Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.p₁ + : GaussianInt)) → ((BandVectors.1 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) = BandVectors.1 (FordRecursiveQuadruple R (2 + : Fin (4 : ℕ))) (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : + Fin (4 : ℕ))) ∧ BandVectors.1 (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = BandVectors.1 (FordRecursiveQuadruple R (1 + : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : + Fin (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) = BandVectors.2 (FordRecursiveQuadruple R (2 + : Fin (4 : ℕ))) (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : + Fin (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = BandVectors.2 (FordRecursiveQuadruple R (1 + : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : + Fin (4 : ℕ)))) → (BandVectors.2 ((FordRecursiveQuadruple Q) 1) + ((FordRecursiveQuadruple Q) 3) = + (⟨0, 1⟩ : GaussianInt) * (Q.p₁ : GaussianInt))))) := by + classical + intro n Q q1pos hgtq pd qd hqdlt hd1 hd2 hred hq1gt R ra32 ra13 direct + have hx := direct.2.2.2 + rw [ra13, ra32] at hx + have hx' : BandVectors.2 ((FordRecursiveQuadruple Q) 1) + ((FordRecursiveQuadruple Q) 3) = + (⟨0, 1⟩ : GaussianInt) * (pd : GaussianInt) + + (⟨0, 1⟩ : GaussianInt) * (Q.p₂ : GaussianInt) := by + simpa [FordRecursiveQuadruple, R, q1pos.ne'] using hx + calc + BandVectors.2 ((FordRecursiveQuadruple Q) 1) + ((FordRecursiveQuadruple Q) 3) = + (⟨0, 1⟩ : GaussianInt) * (pd : GaussianInt) + + (⟨0, 1⟩ : GaussianInt) * (Q.p₂ : GaussianInt) := hx' + _ = (⟨0, 1⟩ : GaussianInt) * (Q.p₁ : GaussianInt) := by + dsimp [pd] + ext <;> simp + +private theorem hsemiAt448 : + (ℕ) → (∀ (Q : FordFareyParameter), ∀ (hgtq : ¬Q.q₁ > Q.q₂), + let pd : Int := Q.p₂ - Q.p₁ + let qd : Nat := Q.q₂ - Q.q₁ + (0 < Q.q₁) → (∀ (hqdpos : 0 < qd), ∀ (hd1 : Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * + Q.p₂ = 1), ∀ (hd2 : pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1), ∀ (hred : Nat.Coprime + Q.q₂ Q.p₂.natAbs), ∀ (hq2gt : 1 < Q.q₂), + let R : FordFareyParameter := { + p := Q.p₂, q := Q.q₂, q_pos := Q.q₂_pos, reduced := hred, + p₁ := Q.p₁, q₁ := Q.q₁, p₂ := pd, q₂ := qd, + sum_p := by dsimp [pd]; ring, + sum_q := by dsimp [qd]; omega, + det₁ := hd1, det₂ := hd2, q₁_lt := by omega, + q₂_pos := hqdpos, + unit_case := by intro hu; omega } + let rotatedTuple : Fin 4 → CircleCoordinates := + ![FordRecursiveQuadruple R 0, FordRecursiveQuadruple R 2, + FordRecursiveQuadruple R 3, FordRecursiveQuadruple R 1] + (SemiProperQuadruple ![![![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * + (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : + ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * + (rotatedTuple (3 : Fin (4 : ℕ))).2 - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 + : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (0 : Fin + (4 : ℕ)), ![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : + Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin + (4 : ℕ))).1, (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * + (rotatedTuple (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : + ℕ))).2 - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), + rotatedTuple (2 : Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![((2 + : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 + : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : + Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![((2 : ℤ) * + (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : + ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 + : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : + Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), + ![![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : + ℕ))).1, (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * + (rotatedTuple (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : + ℕ))).2 - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), + rotatedTuple (2 : Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![((2 + : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 + : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : + Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![((2 : ℤ) * + (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : + ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 + : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : + Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![((2 : ℤ) * + (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : + ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 + : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : + Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), + ![![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : + ℕ))).1, (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * + (rotatedTuple (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : + ℕ))).2 - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), + rotatedTuple (2 : Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![((2 + : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 + : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : + Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![((2 : ℤ) * + (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : + ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 + : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : + Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![((2 : ℤ) * + (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : + ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 + : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : + Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), + ![![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : + ℕ))).1, (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * + (rotatedTuple (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : + ℕ))).2 - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), + rotatedTuple (2 : Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![((2 + : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 + : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : + Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![((2 : ℤ) * + (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : + ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 + : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : + Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![((2 : ℤ) * + (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : + ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 + : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : + Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))]) → + (SemiProperQuadruple (FordRecursiveQuadruple Q)))) := by + classical + intro n Q hgtq pd qd q1pos' hqdpos hd1 hd2 hred hq2gt R rotatedTuple hfinal + have rcond : R.q₁ ≠ 0 := by simp [R, q1pos'.ne'] + have rentry : FordRecursiveQuadruple R 1 = + FordCircleCoordinate Q.p₁ Q.q₁ := by + simp [FordRecursiveQuadruple, R, q1pos'.ne'] + convert hfinal using 1; + simp? [FordRecursiveQuadruple, R, Q.sum_p, Q.sum_q, + FordCircleCoordinate, rcond] + all_goals try simp? [rotatedTuple] + repeat' first | constructor | (ext <;> simp? <;> ring) + all_goals try ring + all_goals try rw [rentry] + all_goals try simp? [FordCircleCoordinate] + all_goals try simp? [FordRecursiveQuadruple, R, q1pos'.ne'] + all_goals try simp? [FordCircleCoordinate, pd, qd] + all_goals try rw [Nat.cast_sub (by omega)] + all_goals try ring + + +private theorem hv32At473 : + (ℕ) → (∀ (Q : FordFareyParameter), ∀ (hgtq : ¬Q.q₁ > Q.q₂), + let pd : Int := Q.p₂ - Q.p₁ + let qd : Nat := Q.q₂ - Q.q₁ + (0 < Q.q₁) → (∀ (hqdpos : 0 < qd), ∀ (hd1 : Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * + Q.p₂ = 1), ∀ (hd2 : pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1), ∀ (hred : Nat.Coprime + Q.q₂ Q.p₂.natAbs), ∀ (hq2gt : 1 < Q.q₂), + let R : FordFareyParameter := { + p := Q.p₂, q := Q.q₂, q_pos := Q.q₂_pos, reduced := hred, + p₁ := Q.p₁, q₁ := Q.q₁, p₂ := pd, q₂ := qd, + sum_p := by dsimp [pd]; ring, + sum_q := by dsimp [qd]; omega, + det₁ := hd1, det₂ := hd2, q₁_lt := by omega, + q₂_pos := hqdpos, + unit_case := by intro hu; omega } + (BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : + Fin (4 : ℕ))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.q₂ : GaussianInt))) → ((BandVectors.1 + (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + = (↑R.q₁ : GaussianInt)) → ( + let rotatedTuple : Fin 4 → CircleCoordinates := + ![FordRecursiveQuadruple R 0, FordRecursiveQuadruple R 2, + FordRecursiveQuadruple R 3, FordRecursiveQuadruple R 1] + (BandVectors.1 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (0 : Fin (4 : ℕ))) = + BandVectors.1 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (1 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : + ℕ))) ∧ BandVectors.1 (rotatedTuple (0 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) = + BandVectors.1 (rotatedTuple (1 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) + ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : + ℕ))) ∧ BandVectors.2 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (0 : Fin (4 : ℕ))) = + BandVectors.2 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (1 : Fin (4 : ℕ))) + ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.2 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : + ℕ))) ∧ BandVectors.2 (rotatedTuple (0 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) = + BandVectors.2 (rotatedTuple (1 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.2 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : + ℕ)))) → (BandVectors.1 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2) = + -((⟨0, 1⟩ : GaussianInt) * (Q.q₂ : GaussianInt))))))) := by + classical + intro n Q hgtq pd qd q1pos' hqdpos hd1 hd2 hred hq2gt R rv32 rv13 rotatedTuple direct + have hx := direct.1 + have rv32' : BandVectors.1 (rotatedTuple 2) (rotatedTuple 1) = + -((⟨0, 1⟩ : GaussianInt) * (qd : GaussianInt)) := by + simpa [rotatedTuple, FordRecursiveQuadruple, R, q1pos'.ne'] using rv32 + have rv13' : BandVectors.1 (rotatedTuple 3) (rotatedTuple 2) = + (Q.q₁ : GaussianInt) := by + simpa [rotatedTuple, FordRecursiveQuadruple, R, q1pos'.ne'] using rv13 + rw [rv32', rv13'] at hx + have hqdrel : qd + Q.q₁ = Q.q₂ := by + dsimp [qd] + omega + have hqdrel' : (qd : Int) + (Q.q₁ : Int) = (Q.q₂ : Int) := by + exact_mod_cast hqdrel + have hi : (⟨0, 1⟩ : GaussianInt) * ⟨0, 1⟩ = -1 := by + ext <;> norm_num + have hcalc : -((⟨0, 1⟩ : GaussianInt) * (qd : GaussianInt)) - + (⟨0, 1⟩ : GaussianInt) * (Q.q₁ : GaussianInt) = + -((⟨0, 1⟩ : GaussianInt) * (Q.q₂ : GaussianInt)) := by + have hle : Q.q₁ ≤ Q.q₂ := by omega + ext <;> simp [qd, Nat.cast_sub hle]; + rw [hcalc] at hx + simpa [rotatedTuple, FordRecursiveQuadruple, R, q1pos'.ne'] using hx + +private theorem ha32At503 : + (ℕ) → (∀ (Q : FordFareyParameter), ∀ (hgtq : ¬Q.q₁ > Q.q₂), + let pd : Int := Q.p₂ - Q.p₁ + let qd : Nat := Q.q₂ - Q.q₁ + (0 < Q.q₁) → (∀ (hqdpos : 0 < qd), ∀ (hd1 : Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * + Q.p₂ = 1), ∀ (hd2 : pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1), ∀ (hred : Nat.Coprime + Q.q₂ Q.p₂.natAbs), ∀ (hq2gt : 1 < Q.q₂), + let R : FordFareyParameter := { + p := Q.p₂, q := Q.q₂, q_pos := Q.q₂_pos, reduced := hred, + p₁ := Q.p₁, q₁ := Q.q₁, p₂ := pd, q₂ := qd, + sum_p := by dsimp [pd]; ring, + sum_q := by dsimp [qd]; omega, + det₁ := hd1, det₂ := hd2, q₁_lt := by omega, + q₂_pos := hqdpos, + unit_case := by intro hu; omega } + (BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : + Fin (4 : ℕ))) = -(↑R.p₂ : GaussianInt)) → ((BandVectors.2 (FordRecursiveQuadruple R (1 : + Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.p₁ + : GaussianInt)) → ( + let rotatedTuple : Fin 4 → CircleCoordinates := + ![FordRecursiveQuadruple R 0, FordRecursiveQuadruple R 2, + FordRecursiveQuadruple R 3, FordRecursiveQuadruple R 1] + (BandVectors.1 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (0 : Fin (4 : ℕ))) = + BandVectors.1 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (1 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : + ℕ))) ∧ BandVectors.1 (rotatedTuple (0 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) = + BandVectors.1 (rotatedTuple (1 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) + ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : + ℕ))) ∧ BandVectors.2 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (0 : Fin (4 : ℕ))) = + BandVectors.2 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (1 : Fin (4 : ℕ))) + ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.2 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : + ℕ))) ∧ BandVectors.2 (rotatedTuple (0 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) = + BandVectors.2 (rotatedTuple (1 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.2 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : + ℕ)))) → (BandVectors.2 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2) = -(Q.p₂ : GaussianInt)))))) := by + classical + intro n Q hgtq pd qd q1pos' hqdpos hd1 hd2 hred hq2gt R ra32 ra13 rotatedTuple direct + have hx := direct.2.2.1 + have ra32' : BandVectors.2 (rotatedTuple 2) (rotatedTuple 1) = + -(pd : GaussianInt) := by + simpa [rotatedTuple, FordRecursiveQuadruple, R, q1pos'.ne'] using ra32 + have ra13' : BandVectors.2 (rotatedTuple 3) (rotatedTuple 2) = + (⟨0, 1⟩ : GaussianInt) * (Q.p₁ : GaussianInt) := by + simpa [rotatedTuple, FordRecursiveQuadruple, R, q1pos'.ne'] using ra13 + rw [ra32', ra13'] at hx + simp? [rotatedTuple, FordRecursiveQuadruple, R, q1pos'.ne'] at hx + calc + BandVectors.2 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2) = + -(((Q.p₂ - Q.p₁ : Int) : GaussianInt)) + + (⟨0, 1⟩ : GaussianInt) * + ((⟨0, 1⟩ : GaussianInt) * (Q.p₁ : GaussianInt)) := hx + _ = -(Q.p₂ : GaussianInt) := by + ext <;> simp; ring + +private theorem circleExists : + ∀ (P : FordFareyParameter), (∀ n : Nat, ∀ Q : FordFareyParameter, Q.q = n → 1 < Q.q → + SemiProperQuadruple (FordRecursiveQuadruple Q) ∧ BandVectors.1 ((FordRecursiveQuadruple + Q) 3) ((FordRecursiveQuadruple Q) 2) = -((⟨0, 1⟩ : GaussianInt) * (Q.q₂ : GaussianInt)) ∧ + BandVectors.1 ((FordRecursiveQuadruple Q) 1) ((FordRecursiveQuadruple Q) 3) = (Q.q₁ : + GaussianInt) ∧ BandVectors.2 ((FordRecursiveQuadruple Q) 3) ((FordRecursiveQuadruple Q) + 2) = -(Q.p₂ : GaussianInt) ∧ BandVectors.2 ((FordRecursiveQuadruple Q) 1) + ((FordRecursiveQuadruple Q) 3) = (⟨0, 1⟩ : GaussianInt) * (Q.p₁ : GaussianInt)) → (∃ C : + BandCircle, C.1.1 = FordCircleCoordinate P.p P.q) := by + classical + intro P claim + by_cases hu : P.q = 1 + · have hp1 : P.q₁ = 0 := by + have h := P.q₁_lt + omega + have hunit := P.unit_case hu + let z : GaussianInt := ⟨0, P.p - 1⟩ + have hs : SemiProperQuadruple + ![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)), + (0, 1), (0, -1)] := SemiProperQuadruple.base z + have hc : FordCircleCoordinate P.p 1 = + (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)) := by + dsimp [FordCircleCoordinate, z] + ext <;> simp; ring + refine ⟨⟨⟨FordCircleCoordinate P.p P.q, ?_⟩, ?_⟩, rfl⟩ + · refine ⟨Or.inl (by + change (0 : Int) < (P.q : Int) * P.q + exact_mod_cast Nat.mul_pos P.q_pos P.q_pos), ?_⟩ + refine ⟨![((1, 1 + 2 * z)), + (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)), (0, 1), (0, -1)], + hs, 1, ?_⟩ + simp [hu, hc] + · change (0 : Int) < (P.q : Int) * P.q + exact_mod_cast Nat.mul_pos P.q_pos P.q_pos + · have hgt : 1 < P.q := by + have hpq : 1 ≤ P.q := P.q_pos + omega + have hq1pos : 0 < P.q₁ := by + by_contra hz + have hz' : P.q₁ = 0 := by omega + have hd := P.det₁ + simp [hz'] at hd + have hdv : (P.q : Int) ∣ 1 := ⟨P.p₁, by simpa [mul_comm] using hd.symm⟩ + have : (P.q : Int) = 1 := Int.eq_one_of_dvd_one (by omega) hdv + omega + have hs := claim P.q P rfl hgt + refine ⟨⟨⟨FordCircleCoordinate P.p P.q, ?_⟩, ?_⟩, rfl⟩ + · refine ⟨Or.inl (by + change (0 : Int) < (P.q : Int) * P.q + exact_mod_cast Nat.mul_pos P.q_pos P.q_pos), ?_⟩ + refine ⟨FordRecursiveQuadruple P, hs.1, 0, ?_⟩ + simp [FordRecursiveQuadruple, FordCircleCoordinate] + · change (0 : Int) < (P.q : Int) * P.q + exact_mod_cast Nat.mul_pos P.q_pos P.q_pos + +private theorem hproper : + ∀ (P : FordFareyParameter), (0 < P.q₁) → ((P.q₂ < P.q) → ((SemiProperQuadruple + (FordRecursiveQuadruple P) ∧ BandVectors.1 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ * (↑P.q₂ : + GaussianInt)) ∧ BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) = (↑P.q₁ : GaussianInt) ∧ BandVectors.2 + (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + = -(↑P.p₂ : GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * (↑P.p₁ : + GaussianInt)) → (ProperBandQuadruple (FordRecursiveQuadruple P)))) := by + classical + intro P hq1pos hq2lt hs + refine ⟨hs.1, ?_⟩ + intro j + fin_cases j + · simp? [FordRecursiveQuadruple, FordCircleCoordinate, hq1pos.ne', Nat.cast_mul] + change (P.q₁ : Int) * P.q₁ < (P.q : Int) * P.q + exact_mod_cast Nat.mul_self_lt_mul_self P.q₁_lt + · simp? [FordRecursiveQuadruple, FordCircleCoordinate, Nat.cast_mul] + change (P.q₂ : Int) * P.q₂ < (P.q : Int) * P.q + exact_mod_cast Nat.mul_self_lt_mul_self hq2lt + · simp? [FordRecursiveQuadruple, FordCircleCoordinate, Nat.cast_mul] + exact Nat.ne_of_gt P.q_pos + +end FordConfigurationProof + +namespace FordConfigurationDetails + +private theorem q1pos : + ∀ (n : ℕ), ∀ (Q : FordFareyParameter), (Q.q = n) → (((1 : ℕ) < Q.q) → (0 < Q.q₁)) := by + classical + intro n Q hQ hgt + by_contra h + have hz : Q.q₁ = 0 := by omega + have hd := Q.det₁ + simp [hz] at hd + have hdv : (Q.q : Int) ∣ 1 := ⟨Q.p₁, by simpa [mul_comm] using hd.symm⟩ + have hqone : (Q.q : Int) = 1 := + Int.eq_one_of_dvd_one (by omega) hdv + omega + +private theorem q2lt : + ∀ (n : ℕ), ∀ (Q : FordFareyParameter), (Q.q = n) → ((0 < Q.q₁) → (Q.q₂ < Q.q)) := by + classical + intro n Q hQ q1pos + have hsum := Q.sum_q + omega + +private theorem cross : + ∀ (Q : FordFareyParameter), Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1 := by + classical + intro Q + have h1 : Q.p₁ * ((Q.q₁ + Q.q₂ : Nat) : Int) - + (Q.q₁ : Int) * (Q.p₁ + Q.p₂) = 1 := by + simpa [Q.sum_q, Q.sum_p] using Q.det₁ + norm_num [Nat.cast_add] at h1 + nlinarith [h1] + +private theorem qone : + ∀ (Q : FordFareyParameter), (0 < Q.q₁) → ((Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1) → + ((Q.q₁ = Q.q₂) → (Q.q₁ = 1))) := by + classical + intro Q q1pos cross heq + have hc := cross + rw [heq] at hc + have hm : (Q.q₁ : Int) * (Q.p₁ - Q.p₂) = 1 := by + nlinarith [hc] + have hd : (Q.q₁ : Int) ∣ 1 := ⟨Q.p₁ - Q.p₂, hm.symm⟩ + have hu : (Q.q₁ : Int) = 1 := + Int.eq_one_of_dvd_one (by exact_mod_cast (Nat.zero_le Q.q₁)) hd + exact_mod_cast hu + +private theorem hp : + ∀ (Q : FordFareyParameter), (0 < Q.q₁) → ((Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1) → + ((Q.q₁ = Q.q₂) → (Q.p₁ = Q.p₂ + 1))) := by + classical + intro Q q1pos cross heq + have hc := cross + rw [heq] at hc + have hm : (Q.q₁ : Int) * (Q.p₁ - Q.p₂) = 1 := by nlinarith [hc] + have hu : (Q.q₁ : Int) = 1 := by + have hd : (Q.q₁ : Int) ∣ 1 := ⟨Q.p₁ - Q.p₂, hm.symm⟩ + exact Int.eq_one_of_dvd_one + (by exact_mod_cast (Nat.zero_le Q.q₁)) hd + nlinarith [hu] + +private theorem hq : + ∀ (n : ℕ), ∀ (Q : FordFareyParameter), (Q.q = n) → ((Q.q₁ = Q.q₂) → ((Q.q₁ = 1) → (Q.q = 2))) + := by + classical + intro n Q hQ heq qone + have hsum := Q.sum_q + omega + +private theorem coord1 : + ∀ (Q : FordFareyParameter), + let z : GaussianInt := ⟨0, Q.p₂⟩ + FordCircleCoordinate (Q.p₂ + 1) 1 = + (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)) := by + classical + intro Q z + dsimp [FordCircleCoordinate, z] + ext <;> simp; ring + +private theorem coord2 : + ∀ (Q : FordFareyParameter), FordCircleCoordinate Q.p₂ 1 = + (1, 1 + 2 * (⟨0, Q.p₂ - 1⟩ : GaussianInt) + + 2 * (⟨0, 1⟩ : GaussianInt)) := by + classical + intro Q + dsimp [FordCircleCoordinate] + apply Prod.ext + · simp + · ext <;> simp; ring + +private theorem hv13At868 : + ∀ (Q : FordFareyParameter), (Q.q₁ = 1) → ((Q.q₂ = 1) → ((Q.p₁ = Q.p₂ + 1) → ((Q.q = 2) → ( + let z : GaussianInt := ⟨0, Q.p₂⟩ + (FordCircleCoordinate (Q.p₂ + 1) 1 = (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt))) → + ((BandVectors.1 ((0 : ℤ), (-1 : GaussianInt)) ((0 : ℤ), (1 : GaussianInt)) = (0 : + GaussianInt) ∧ BandVectors.1 ((0 : ℤ), (1 : GaussianInt)) ((1 : ℤ), (1 : GaussianInt) + + (2 : GaussianInt) * z + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) = (-1 : GaussianInt) ∧ + BandVectors.1 ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z + (2 : GaussianInt) * + ⟨(0 : ℤ), (1 : ℤ)⟩) ((0 : ℤ), (-1 : GaussianInt)) = (1 : GaussianInt) ∧ BandVectors.2 ((0 + : ℤ), (-1 : GaussianInt)) ((0 : ℤ), (1 : GaussianInt)) = (1 : GaussianInt) ∧ + BandVectors.2 ((0 : ℤ), (1 : GaussianInt)) ((1 : ℤ), (1 : GaussianInt) + (2 : + GaussianInt) * z + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) = (-1 : GaussianInt) - z - ⟨(0 + : ℤ), (1 : ℤ)⟩ ∧ BandVectors.2 ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z + (2 : + GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩) ((0 : ℤ), (-1 : GaussianInt)) = z + ⟨(0 : ℤ), (1 : + ℤ)⟩) → (BandVectors.1 ((FordRecursiveQuadruple Q) 1) + ((FordRecursiveQuadruple Q) 3) = (Q.q₁ : GaussianInt))))))) := by + classical + intro Q qone hqone hp hq z coord1 b1 + simpa [FordRecursiveQuadruple, qone, hqone, hp, hq, Q.sum_p, + Q.sum_q, z, coord1] using b1.2.2.1 + +private theorem hd1At883 : + (ℕ) → (∀ (Q : FordFareyParameter), (Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1) → ((Q.q₁ > + Q.q₂) → ( + let pd : Int := Q.p₁ - Q.p₂ + let qd : Nat := Q.q₁ - Q.q₂ + pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = 1))) := by + classical + intro n Q cross hgtq pd qd + dsimp [pd, qd] + rw [Nat.cast_sub (by omega)] + nlinarith [cross] + +private theorem hq1ltN : + ∀ (n : ℕ), ∀ (Q : FordFareyParameter), (Q.q = n) → (Q.q₁ < n) := by + classical + intro n Q hQ + have hlt := Q.q₁_lt + omega + +private theorem hv32At908 : + (ℕ) → (∀ (Q : FordFareyParameter), ∀ (q1pos : 0 < Q.q₁), ∀ (hgtq : Q.q₁ > Q.q₂), let pd : Int + := Q.p₁ - Q.p₂ + let qd : Nat := Q.q₁ - Q.q₂ + ∀ (hqdlt : qd < Q.q₁), ∀ (hd1 : pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = 1), ∀ (hd2 : Q.p₂ * + (Q.q₁ : Int) - (Q.q₂ : Int) * Q.p₁ = -1), ∀ (hred : Nat.Coprime Q.q₁ Q.p₁.natAbs), ∀ + (hq1gt : 1 < Q.q₁), let R : FordFareyParameter := { + p := Q.p₁, q := Q.q₁, q_pos := q1pos, reduced := hred, + p₁ := pd, q₁ := qd, p₂ := Q.p₂, q₂ := Q.q₂, + sum_p := by dsimp [pd]; ring, + sum_q := by dsimp [qd]; omega, + det₁ := hd1, det₂ := hd2, q₁_lt := hqdlt, + q₂_pos := Q.q₂_pos, + unit_case := by intro hu; omega } + (BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : + Fin (4 : ℕ))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.q₂ : GaussianInt))) → (BandVectors.1 + ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2) = + -((⟨0, 1⟩ : GaussianInt) * (Q.q₂ : GaussianInt)))) := by + classical + intro n Q q1pos hgtq pd qd hqdlt hd1 hd2 hred hq1gt R rv32 + simpa [FordRecursiveQuadruple, R] using rv32 + +private theorem ha32At914 : + (ℕ) → (∀ (Q : FordFareyParameter), ∀ (q1pos : 0 < Q.q₁), ∀ (hgtq : Q.q₁ > Q.q₂), let pd : Int + := Q.p₁ - Q.p₂ + let qd : Nat := Q.q₁ - Q.q₂ + ∀ (hqdlt : qd < Q.q₁), ∀ (hd1 : pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = 1), ∀ (hd2 : Q.p₂ * + (Q.q₁ : Int) - (Q.q₂ : Int) * Q.p₁ = -1), ∀ (hred : Nat.Coprime Q.q₁ Q.p₁.natAbs), ∀ + (hq1gt : 1 < Q.q₁), let R : FordFareyParameter := { + p := Q.p₁, q := Q.q₁, q_pos := q1pos, reduced := hred, + p₁ := pd, q₁ := qd, p₂ := Q.p₂, q₂ := Q.q₂, + sum_p := by dsimp [pd]; ring, + sum_q := by dsimp [qd]; omega, + det₁ := hd1, det₂ := hd2, q₁_lt := hqdlt, + q₂_pos := Q.q₂_pos, + unit_case := by intro hu; omega } + (BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : + Fin (4 : ℕ))) = -(↑R.p₂ : GaussianInt)) → (BandVectors.2 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2) = -(Q.p₂ : GaussianInt))) := by + classical + intro n Q q1pos hgtq pd qd hqdlt hd1 hd2 hred hq1gt R ra32 + simpa [FordRecursiveQuadruple, R] using ra32 + +private theorem hd2At925 : + (ℕ) → (∀ (Q : FordFareyParameter), (Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1) → ((¬Q.q₁ + > Q.q₂) → ( + let pd : Int := Q.p₂ - Q.p₁ + let qd : Nat := Q.q₂ - Q.q₁ + pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1))) := by + classical + intro n Q cross hgtq pd qd + dsimp [pd, qd] + rw [Nat.cast_sub (by omega)] + nlinarith [cross] + +private theorem hredAt929 : + ∀ (Q : FordFareyParameter), (∀ (a : ℤ), ∀ (b : ℕ), ∀ (d : ℕ), ∀ (c : ℤ), a * (↑d : ℤ) - (↑b : + ℤ) * c = (1 : ℤ) → b.Coprime a.natAbs) → ( + let pd : Int := Q.p₂ - Q.p₁ + let qd : Nat := Q.q₂ - Q.q₁ + (pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1) → (Nat.Coprime Q.q₂ Q.p₂.natAbs)) := by + classical + intro Q determinantCoprime pd qd hd2 + have hh : Q.p₂ * (qd : Int) - (Q.q₂ : Int) * pd = 1 := by + calc + Q.p₂ * (qd : Int) - (Q.q₂ : Int) * pd = + -(pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂) := by ring + _ = 1 := by rw [hd2]; norm_num + simpa [Int.natAbs_neg] using + (determinantCoprime Q.p₂ Q.q₂ qd pd hh) + +private theorem hq2ltN : + ∀ (n : ℕ), ∀ (Q : FordFareyParameter), (Q.q = n) → ((Q.q₂ < Q.q) → (Q.q₂ < n)) := by + classical + intro n Q hQ q2lt + have hlt := q2lt + omega + +private theorem hv13At961 : + (ℕ) → (∀ (Q : FordFareyParameter), ∀ (hgtq : ¬Q.q₁ > Q.q₂), let pd : Int := Q.p₂ - Q.p₁ + let qd : Nat := Q.q₂ - Q.q₁ + ∀ (hqdpos : 0 < qd), ∀ (hd1 : Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1), ∀ (hd2 : pd * + (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1), ∀ (hred : Nat.Coprime Q.q₂ Q.p₂.natAbs), ∀ (hq2gt + : 1 < Q.q₂), let R : FordFareyParameter := { + p := Q.p₂, q := Q.q₂, q_pos := Q.q₂_pos, reduced := hred, + p₁ := Q.p₁, q₁ := Q.q₁, p₂ := pd, q₂ := qd, + sum_p := by dsimp [pd]; ring, + sum_q := by dsimp [qd]; omega, + det₁ := hd1, det₂ := hd2, q₁_lt := by omega, + q₂_pos := hqdpos, + unit_case := by intro hu; omega } + (BandVectors.1 (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : + Fin (4 : ℕ))) = (↑R.q₁ : GaussianInt)) → (BandVectors.1 ((FordRecursiveQuadruple Q) 1) + ((FordRecursiveQuadruple Q) 3) = (Q.q₁ : GaussianInt))) := by + classical + intro n Q hgtq pd qd hqdpos hd1 hd2 hred hq2gt R rv13 + simpa [FordRecursiveQuadruple, R] using rv13 + +private theorem ha13At966 : + (ℕ) → (∀ (Q : FordFareyParameter), ∀ (hgtq : ¬Q.q₁ > Q.q₂), let pd : Int := Q.p₂ - Q.p₁ + let qd : Nat := Q.q₂ - Q.q₁ + ∀ (hqdpos : 0 < qd), ∀ (hd1 : Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1), ∀ (hd2 : pd * + (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1), ∀ (hred : Nat.Coprime Q.q₂ Q.p₂.natAbs), ∀ (hq2gt + : 1 < Q.q₂), let R : FordFareyParameter := { + p := Q.p₂, q := Q.q₂, q_pos := Q.q₂_pos, reduced := hred, + p₁ := Q.p₁, q₁ := Q.q₁, p₂ := pd, q₂ := qd, + sum_p := by dsimp [pd]; ring, + sum_q := by dsimp [qd]; omega, + det₁ := hd1, det₂ := hd2, q₁_lt := by omega, + q₂_pos := hqdpos, + unit_case := by intro hu; omega } + (BandVectors.2 (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : + Fin (4 : ℕ))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.p₁ : GaussianInt)) → (BandVectors.2 + ((FordRecursiveQuadruple Q) 1) + ((FordRecursiveQuadruple Q) 3) = + (⟨0, 1⟩ : GaussianInt) * (Q.p₁ : GaussianInt))) := by + classical + intro n Q hgtq pd qd hqdpos hd1 hd2 hred hq2gt R ra13 + simpa [FordRecursiveQuadruple, R] using ra13 + +private theorem hq1pos : + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → (0 < P.q₁) := by + classical + intro P hgt + by_contra hz + have hz' : P.q₁ = 0 := by omega + have hd := P.det₁ + simp [hz'] at hd + have hdv : (P.q : Int) ∣ 1 := ⟨P.p₁, by simpa [mul_comm] using hd.symm⟩ + have : (P.q : Int) = 1 := Int.eq_one_of_dvd_one (by omega) hdv + omega + +private theorem hq2lt : + ∀ (P : FordFareyParameter), (0 < P.q₁) → (P.q₂ < P.q) := by + classical + intro P hq1pos + have hsum := P.sum_q + omega + +private theorem v21 : + ∀ (P : FordFareyParameter), (SemiProperQuadruple (FordRecursiveQuadruple P) ∧ BandVectors.1 + (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + = -(⟨(0 : ℤ), (1 : ℤ)⟩ * (↑P.q₂ : GaussianInt)) ∧ BandVectors.1 (FordRecursiveQuadruple P + (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) = (↑P.q₁ : GaussianInt) ∧ + BandVectors.2 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (2 : + Fin (4 : ℕ))) = -(↑P.p₂ : GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple P (1 : Fin + (4 : ℕ))) (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * (↑P.p₁ : + GaussianInt)) → ((BandVectors.1 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple P (1 + : Fin (4 : ℕ))) (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + BandVectors.1 + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + = (0 : GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + BandVectors.2 (FordRecursiveQuadruple P (1 + : Fin (4 : ℕ))) (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + BandVectors.2 + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + = (0 : GaussianInt) ∧ BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = BandVectors.1 (FordRecursiveQuadruple P (1 + : Fin (4 : ℕ))) (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (1 : + Fin (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = BandVectors.2 (FordRecursiveQuadruple P (1 + : Fin (4 : ℕ))) (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (1 : + Fin (4 : ℕ))) ∧ (ProperBandQuadruple (FordRecursiveQuadruple P) → ∀ (j : Fin (3 : ℕ)), + BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (FordRecursiveQuadruple P j.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple P (0 + : Fin (4 : ℕ))) (FordRecursiveQuadruple P j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 + (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))))) → + (BandVectors.1 ((FordRecursiveQuadruple P) 2) + ((FordRecursiveQuadruple P) 1) = + -((P.q₁ : GaussianInt)) + + (⟨0, 1⟩ : GaussianInt) * (P.q₂ : GaussianInt))) := by + classical + intro P hs laws + have h := laws.1 + have hh := eq_neg_of_add_eq_zero_right h + rw [hs.2.1, hs.2.2.1] at hh + rw [neg_add, neg_neg] at hh + simpa [add_comm] using hh + +private theorem hv20' : + ∀ (P : FordFareyParameter), (BandVectors.1 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple + P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P + (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = + BandVectors.1 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 + : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : + Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 + : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : + Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ)))) → (BandVectors.1 + ((FordRecursiveQuadruple P) 2) + ((FordRecursiveQuadruple P) 0) = + BandVectors.1 ((FordRecursiveQuadruple P) 2) + ((FordRecursiveQuadruple P) 1) - + (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 ((FordRecursiveQuadruple P) 3) + ((FordRecursiveQuadruple P) 2)) := by + classical + intro P hv20 + simpa using hv20 + +private theorem hv30' : + ∀ (P : FordFareyParameter), (BandVectors.1 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple + P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P + (1 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = + BandVectors.1 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 + : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : + Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 + : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : + Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ)))) → (BandVectors.1 + ((FordRecursiveQuadruple P) 3) + ((FordRecursiveQuadruple P) 0) = + BandVectors.1 ((FordRecursiveQuadruple P) 3) + ((FordRecursiveQuadruple P) 2) - + (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 ((FordRecursiveQuadruple P) 1) + ((FordRecursiveQuadruple P) 3)) := by + classical + intro P hv30 + simpa using hv30 + +private theorem a21 : + ∀ (P : FordFareyParameter), (SemiProperQuadruple (FordRecursiveQuadruple P) ∧ BandVectors.1 + (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + = -(⟨(0 : ℤ), (1 : ℤ)⟩ * (↑P.q₂ : GaussianInt)) ∧ BandVectors.1 (FordRecursiveQuadruple P + (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) = (↑P.q₁ : GaussianInt) ∧ + BandVectors.2 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (2 : + Fin (4 : ℕ))) = -(↑P.p₂ : GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple P (1 : Fin + (4 : ℕ))) (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * (↑P.p₁ : + GaussianInt)) → ((BandVectors.1 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple P (1 + : Fin (4 : ℕ))) (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + BandVectors.1 + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + = (0 : GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + BandVectors.2 (FordRecursiveQuadruple P (1 + : Fin (4 : ℕ))) (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + BandVectors.2 + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + = (0 : GaussianInt) ∧ BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = BandVectors.1 (FordRecursiveQuadruple P (1 + : Fin (4 : ℕ))) (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (1 : + Fin (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = BandVectors.2 (FordRecursiveQuadruple P (1 + : Fin (4 : ℕ))) (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (1 : + Fin (4 : ℕ))) ∧ (ProperBandQuadruple (FordRecursiveQuadruple P) → ∀ (j : Fin (3 : ℕ)), + BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (FordRecursiveQuadruple P j.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple P (0 + : Fin (4 : ℕ))) (FordRecursiveQuadruple P j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 + (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))))) → + (BandVectors.2 ((FordRecursiveQuadruple P) 2) + ((FordRecursiveQuadruple P) 1) = + (P.p₂ : GaussianInt) - + (⟨0, 1⟩ : GaussianInt) * (P.p₁ : GaussianInt))) := by + classical + intro P hs laws + have h := laws.2.1 + have hh := eq_neg_of_add_eq_zero_right h + rw [hs.2.2.2.1, hs.2.2.2.2] at hh + rw [hh] + abel + +private theorem ha20' : + ∀ (P : FordFareyParameter), (BandVectors.2 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple + P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P + (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = + BandVectors.2 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 + : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : + Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 + : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : + Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ)))) → (BandVectors.2 + ((FordRecursiveQuadruple P) 2) + ((FordRecursiveQuadruple P) 0) = + BandVectors.2 ((FordRecursiveQuadruple P) 2) + ((FordRecursiveQuadruple P) 1) + + (⟨0, 1⟩ : GaussianInt) * + BandVectors.2 ((FordRecursiveQuadruple P) 3) + ((FordRecursiveQuadruple P) 2)) := by + classical + intro P ha20 + simpa using ha20 + +private theorem ha30' : + ∀ (P : FordFareyParameter), (BandVectors.2 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple + P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P + (1 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = + BandVectors.2 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 + : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : + Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 + : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : + Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), + FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ)))) → (BandVectors.2 + ((FordRecursiveQuadruple P) 3) + ((FordRecursiveQuadruple P) 0) = + BandVectors.2 ((FordRecursiveQuadruple P) 3) + ((FordRecursiveQuadruple P) 2) + + (⟨0, 1⟩ : GaussianInt) * + BandVectors.2 ((FordRecursiveQuadruple P) 1) + ((FordRecursiveQuadruple P) 3)) := by + classical + intro P ha30 + simpa using ha30 + +end FordConfigurationDetails + +theorem FordCoordinateConfiguration (P : FordFareyParameter) : + (∃ C : BandCircle, C.1.1 = FordCircleCoordinate P.p P.q) ∧ + (1 < P.q → + ProperBandQuadruple (FordRecursiveQuadruple P) ∧ + BandVectors.1 ((FordRecursiveQuadruple P) 1) + ((FordRecursiveQuadruple P) 0) = + ⟨(P.q : Int), (P.q₁ : Int)⟩ ∧ + BandVectors.1 ((FordRecursiveQuadruple P) 2) + ((FordRecursiveQuadruple P) 0) = + ⟨-(P.q : Int), (P.q₂ : Int)⟩ ∧ + BandVectors.1 ((FordRecursiveQuadruple P) 3) + ((FordRecursiveQuadruple P) 0) = + ⟨0, -(P.q : Int)⟩ ∧ + BandVectors.2 ((FordRecursiveQuadruple P) 1) + ((FordRecursiveQuadruple P) 0) = + ⟨P.p₁, P.p⟩ ∧ + BandVectors.2 ((FordRecursiveQuadruple P) 2) + ((FordRecursiveQuadruple P) 0) = + ⟨P.p₂, -P.p⟩ ∧ + BandVectors.2 ((FordRecursiveQuadruple P) 3) + ((FordRecursiveQuadruple P) 0) = + ⟨-P.p, 0⟩ ∧ + BandVectors.2 ((FordRecursiveQuadruple P) 3) + ((FordRecursiveQuadruple P) 2) = + ⟨-P.p₂, 0⟩ ∧ + BandVectors.2 ((FordRecursiveQuadruple P) 1) + ((FordRecursiveQuadruple P) 3) = + ⟨0, P.p₁⟩) := by +-- BODY + have claim : ∀ n : Nat, ∀ Q : FordFareyParameter, Q.q = n → + 1 < Q.q → SemiProperQuadruple (FordRecursiveQuadruple Q) ∧ + BandVectors.1 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2) = + -((⟨0, 1⟩ : GaussianInt) * (Q.q₂ : GaussianInt)) ∧ + BandVectors.1 ((FordRecursiveQuadruple Q) 1) + ((FordRecursiveQuadruple Q) 3) = (Q.q₁ : GaussianInt) ∧ + BandVectors.2 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2) = -(Q.p₂ : GaussianInt) ∧ + BandVectors.2 ((FordRecursiveQuadruple Q) 1) + ((FordRecursiveQuadruple Q) 3) = + (⟨0, 1⟩ : GaussianInt) * (Q.p₁ : GaussianInt) := by + have systemLaw : RecursiveVectorSystem BandVectors := + by simpa [BandVectors] using (Classical.choose_spec RecursiveVectorsExistUnique).1 + rcases systemLaw with ⟨zeroLaw, baseLaw, stepLaw, flipLaw⟩ + intro n + induction n using Nat.strong_induction_on with + | h n ih => + intro Q hQ hgt + have q1pos := FordConfigurationDetails.q1pos n Q hQ hgt + have q2lt := FordConfigurationDetails.q2lt n Q hQ q1pos + have cross := FordConfigurationDetails.cross Q + have determinantCoprime := FordConfigurationProof.determinantCoprime + by_cases heq : Q.q₁ = Q.q₂ + · have qone : Q.q₁ = 1 := FordConfigurationDetails.qone Q q1pos cross heq + have hqone : Q.q₂ = 1 := by omega + have hp := FordConfigurationDetails.hp Q q1pos cross heq + have hq := FordConfigurationDetails.hq n Q hQ heq qone + let z : GaussianInt := ⟨0, Q.p₂⟩ + have hb := SemiProperQuadruple.base z + have hr := SemiProperQuadruple.rotate hb + have hs := SemiProperQuadruple.successor hr + have ht := SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hs) + have coord1 := FordConfigurationDetails.coord1 Q + have coord2 := FordConfigurationDetails.coord2 Q + have hsemi : SemiProperQuadruple (FordRecursiveQuadruple Q) := by + convert ht using 1; + simp? [FordRecursiveQuadruple, FordCircleCoordinate, z, qone, + hqone, hp, hq, Q.sum_p] + constructor + · ext <;> simp; ring + constructor + · ext <;> simp; ring + · ext <;> simp + have b1 := baseLaw z + simp? at b1 + have b2 := baseLaw ⟨0, Q.p₂ - 1⟩ + simp? at b2 + have f1 := flipLaw _ _ (PrimitiveVectorOrientation.base31 ⟨0, Q.p₂ - 1⟩) + have hv13 := FordConfigurationDetails.hv13At868 Q qone hqone hp hq coord1 b1 + have hv32 := FordConfigurationProof.hv32At253 Q qone hqone hp hq coord2 b2 f1 + have ha13 := FordConfigurationProof.ha13At278 Q + qone hqone hp hq coord1 b1 + have ha32 := FordConfigurationProof.ha32At288 Q qone hqone hp hq coord2 b2 f1 + exact ⟨hsemi, hv32, hv13, ha32, ha13⟩ + · by_cases hgtq : Q.q₁ > Q.q₂ + · let pd : Int := Q.p₁ - Q.p₂ + let qd : Nat := Q.q₁ - Q.q₂ + have q2pos : 0 < Q.q₂ := Q.q₂_pos + have hqdpos : 0 < qd := by dsimp [qd]; omega + have hqdlt : qd < Q.q₁ := by dsimp [qd]; omega + have hd1 := FordConfigurationDetails.hd1At883 n Q cross hgtq + have hd2 : Q.p₂ * (Q.q₁ : Int) - (Q.q₂ : Int) * Q.p₁ = -1 := by + nlinarith [cross] + have hred : Nat.Coprime Q.q₁ Q.p₁.natAbs := + determinantCoprime Q.p₁ Q.q₁ Q.q₂ Q.p₂ cross + have hq1gt : 1 < Q.q₁ := by omega + have hq1ltN := FordConfigurationDetails.hq1ltN n Q hQ + let R : FordFareyParameter := { + p := Q.p₁, q := Q.q₁, q_pos := q1pos, reduced := hred, + p₁ := pd, q₁ := qd, p₂ := Q.p₂, q₂ := Q.q₂, + sum_p := by dsimp [pd]; ring, + sum_q := by dsimp [qd]; omega, + det₁ := hd1, det₂ := hd2, q₁_lt := hqdlt, + q₂_pos := Q.q₂_pos, + unit_case := by intro hu; omega } + have hrec := ih Q.q₁ hq1ltN R (by simp [R]) (by simpa [R] using hq1gt) + rcases hrec with ⟨rsemi, rv32, rv13, ra32, ra13⟩ + have hsucc := SemiProperQuadruple.successor rsemi + have hsemi := FordConfigurationProof.hsemiAt342 n Q q1pos hgtq hqdpos hqdlt hd1 hd2 + hred hq1gt hsucc + have direct := stepLaw (FordRecursiveQuadruple R) rsemi + have hv32 := FordConfigurationDetails.hv32At908 n Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt + rv32 + have hv13 := FordConfigurationProof.hv13At359 n Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt rv32 + rv13 direct + have ha32 := FordConfigurationDetails.ha32At914 n Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt + ra32 + have ha13 := FordConfigurationProof.ha13At390 + n Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt ra32 ra13 direct + exact ⟨hsemi, hv32, hv13, ha32, ha13⟩ + · let pd : Int := Q.p₂ - Q.p₁ + let qd : Nat := Q.q₂ - Q.q₁ + have q1pos' : 0 < Q.q₁ := q1pos + have hqdpos : 0 < qd := by dsimp [qd]; omega + have hd1 : Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1 := cross + have hd2 := FordConfigurationDetails.hd2At925 n Q cross hgtq + have hred := FordConfigurationDetails.hredAt929 Q + determinantCoprime hd2 + have hq2gt : 1 < Q.q₂ := by omega + have hq2ltN := FordConfigurationDetails.hq2ltN n Q hQ q2lt + let R : FordFareyParameter := { + p := Q.p₂, q := Q.q₂, q_pos := Q.q₂_pos, reduced := hred, + p₁ := Q.p₁, q₁ := Q.q₁, p₂ := pd, q₂ := qd, + sum_p := by dsimp [pd]; ring, + sum_q := by dsimp [qd]; omega, + det₁ := hd1, det₂ := hd2, q₁_lt := by omega, + q₂_pos := hqdpos, + unit_case := by intro hu; omega } + have hrec := ih Q.q₂ hq2ltN R (by simp [R]) + (by simpa [R] using hq2gt) + rcases hrec with ⟨rsemi, rv32, rv13, ra32, ra13⟩ + let rotatedTuple : Fin 4 → CircleCoordinates := + ![FordRecursiveQuadruple R 0, FordRecursiveQuadruple R 2, + FordRecursiveQuadruple R 3, FordRecursiveQuadruple R 1] + have trot : SemiProperQuadruple rotatedTuple := by + simpa [rotatedTuple] using SemiProperQuadruple.rotate rsemi + have hsucc := SemiProperQuadruple.successor trot + have hfinal := SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hsucc) + have hsemi := FordConfigurationProof.hsemiAt448 n Q hgtq q1pos' hqdpos hd1 hd2 hred + hq2gt hfinal + have direct := stepLaw _ trot + have hv13 := FordConfigurationDetails.hv13At961 n Q hgtq hqdpos hd1 hd2 hred hq2gt rv13 + have hv32 := FordConfigurationProof.hv32At473 n Q hgtq q1pos' hqdpos hd1 hd2 hred hq2gt + rv32 rv13 direct + have ha13 := FordConfigurationDetails.ha13At966 n Q hgtq hqdpos hd1 hd2 hred hq2gt ra13 + have ha32 := FordConfigurationProof.ha32At503 n Q hgtq q1pos' hqdpos hd1 hd2 hred hq2gt + ra32 ra13 direct + exact ⟨hsemi, hv32, hv13, ha32, ha13⟩ + have circleExists := FordConfigurationProof.circleExists P claim + refine ⟨circleExists, ?_⟩ + intro hgt + have hq1pos := FordConfigurationDetails.hq1pos P hgt + have hq2lt := FordConfigurationDetails.hq2lt P hq1pos + have hs := claim P.q P rfl hgt + have hproper := FordConfigurationProof.hproper + P hq1pos hq2lt hs + have laws := VectorRecursionLaws (FordRecursiveQuadruple P) hs.1 + have v21 := FordConfigurationDetails.v21 P hs laws + have hv10 := laws.2.2.1 + have hv20 := (VectorRecursionLaws + ![(FordRecursiveQuadruple P) 0, (FordRecursiveQuadruple P) 2, + (FordRecursiveQuadruple P) 3, (FordRecursiveQuadruple P) 1] (by + simpa using SemiProperQuadruple.rotate hs.1)).2.2.1 + have hv30 := (VectorRecursionLaws + ![(FordRecursiveQuadruple P) 0, (FordRecursiveQuadruple P) 3, + (FordRecursiveQuadruple P) 1, (FordRecursiveQuadruple P) 2] (by + simpa using SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate hs.1))).2.2.1 + have hv20' := FordConfigurationDetails.hv20' P hv20 + have hv30' := FordConfigurationDetails.hv30' P hv30 + have a21 := FordConfigurationDetails.a21 P hs laws + have ha10 := laws.2.2.2.1 + have ha20 := (VectorRecursionLaws + ![(FordRecursiveQuadruple P) 0, (FordRecursiveQuadruple P) 2, + (FordRecursiveQuadruple P) 3, (FordRecursiveQuadruple P) 1] (by + simpa using SemiProperQuadruple.rotate hs.1)).2.2.2.1 + have ha30 := (VectorRecursionLaws + ![(FordRecursiveQuadruple P) 0, (FordRecursiveQuadruple P) 3, + (FordRecursiveQuadruple P) 1, (FordRecursiveQuadruple P) 2] (by + simpa using SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate hs.1))).2.2.2.1 + have ha20' := FordConfigurationDetails.ha20' P ha20 + have ha30' := FordConfigurationDetails.ha30' P ha30 + refine ⟨hproper, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [hv10, hs.2.2.1, v21] + have hi : (⟨0, 1⟩ : GaussianInt) * ⟨0, 1⟩ = -1 := by + ext <;> norm_num + ext <;> + simp [P.sum_q, sub_eq_add_neg, mul_add]; + · rw [hv20', v21, hs.2.1] + have hi : (⟨0, 1⟩ : GaussianInt) * ⟨0, 1⟩ = -1 := by + ext <;> norm_num + ext <;> simp [P.sum_q, sub_eq_add_neg]; + ring + · rw [hv30', hs.2.1, hs.2.2.1] + ext <;> simp [P.sum_q]; ring + · rw [ha10, hs.2.2.2.2, a21] + ext <;> simp [P.sum_p] + · rw [ha20', a21, hs.2.2.2.1] + ext <;> simp [P.sum_p]; ring + · rw [ha30', hs.2.2.2.1, hs.2.2.2.2] + ext <;> simp [P.sum_p] + · rw [hs.2.2.2.1] + ext <;> simp + · rw [hs.2.2.2.2] + ext <;> simp + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordDoubledBoundary.lean b/LeanPool/ApollonianSuperharmonic/FordDoubledBoundary.lean new file mode 100644 index 0000000000..36edaf1ce2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordDoubledBoundary.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain + +-- [TABLET NODE: FordDoubledBoundary] + +/-! +# FordDoubledBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The doubled boundary of the closed Ford vertex square is +$$ + B_q=[0,q]^2\setminus[2,q-2]^2. +$$ +Thus it contains the outer two vertex layers (with the evident convention +when the displayed inner square is empty). +-/ +def FordDoubledBoundary (q : Nat) : Set GaussianInt := +-- BODY + {x | x ∈ FordVertexDomain q ∧ + ¬(2 <= x.re ∧ x.re <= (q : Int) - 2 ∧ + 2 <= x.im ∧ x.im <= (q : Int) - 2)} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordExceptionalLattice.lean b/LeanPool/ApollonianSuperharmonic/FordExceptionalLattice.lean new file mode 100644 index 0000000000..8f1e7e5828 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordExceptionalLattice.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction + +-- [TABLET NODE: FordExceptionalLattice] + +/-! +# FordExceptionalLattice + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a Ford--Farey parameter, the exceptional period lattice is +$$ + L_{p,q}=\langle(0,-q),(q,q_1)\rangle_{\mathbb Z}\subseteq\mathbb Z^2. +$$ +The third displayed displacement $(-q,q_2)$ is the negative sum of these +two generators because $q=q_1+q_2$. +-/ +def FordExceptionalLattice (P : FordFareyParameter) : AddSubgroup GaussianInt := +-- BODY + AddSubgroup.closure + {v | v = (⟨0, -(P.q : Int)⟩ : GaussianInt) ∨ + v = (⟨(P.q : Int), (P.q₁ : Int)⟩ : GaussianInt)} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordExceptionalMatrixLatticeIdentification.lean b/LeanPool/ApollonianSuperharmonic/FordExceptionalMatrixLatticeIdentification.lean new file mode 100644 index 0000000000..af058b47a8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordExceptionalMatrixLatticeIdentification.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordExceptionalLattice +public import LeanPool.ApollonianSuperharmonic.FordPeakMatrix +public import LeanPool.ApollonianSuperharmonic.IntegralityLattice + +-- [TABLET NODE: FordExceptionalMatrixLatticeIdentification] + +/-! +# FordExceptionalMatrixLatticeIdentification + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FordExceptionalMatrixLatticeIdentification (P : FordFareyParameter) + (C : BandCircle) (hC : C.1.1 = FordCircleCoordinate P.p P.q) : + CircleMatrix C = FordPeakMatrix P.p P.q P.q_pos P.reduced ∧ + IntegralityLattice C = FordExceptionalLattice P := by +-- BODY + have hmatrix : + CircleMatrix C = + let c : ℝ := C.1.1.1 + let x : ℝ := C.1.1.2.re + let y : ℝ := C.1.1.2.im + (2 * c)⁻¹ • ![![1 + x, y], ![y, 1 - x]] := by + ext i j + fin_cases i <;> fin_cases j <;> + simp [CircleMatrix, BandCircleEuclideanData] + all_goals field_simp + constructor + · rw [FordPeakMatrix] + apply Matrix.ext + intro i j + fin_cases i <;> fin_cases j + all_goals change _ = (1 / ((P.q : ℝ) ^ 2)) * _ + all_goals simp [hmatrix, hC, FordCircleCoordinate] + all_goals field_simp + all_goals ring + · apply le_antisymm + · intro u hu + change ∀ i : Fin 2, ∃ n : ℤ, Matrix.mulVec (CircleMatrix C) + ![((u.re : ℤ) : ℝ), ((u.im : ℤ) : ℝ)] i = (n : ℝ) at hu + have hzero := hu 0 + have hone := hu 1 + simp? [hmatrix, hC, FordCircleCoordinate, Matrix.mulVec, + ] at hzero hone + rcases hzero with ⟨zeroValue, zeroEquation⟩ + rcases hone with ⟨oneValue, oneEquation⟩ + rw [GaussianInt.toComplex_def₂] at zeroEquation oneEquation + field_simp at zeroEquation oneEquation + have qReal : (P.q : ℝ) ≠ 0 := by exact_mod_cast P.q_pos.ne' + have oneProduct := (div_eq_iff qReal).mp oneEquation + have oneInteger : u.re * P.p = oneValue * (P.q : ℤ) := by + exact_mod_cast oneProduct + have qdividesReal : (P.q : ℤ) ∣ u.re := by + refine ⟨P.p₁ * u.re - (P.q₁ : ℤ) * oneValue, ?_⟩ + calc + u.re = (P.p₁ * (P.q : ℤ) - (P.q₁ : ℤ) * P.p) * u.re := by + have determinant : P.p₁ * (P.q : ℤ) - (P.q₁ : ℤ) * P.p = 1 := P.det₁ + rw [determinant] + ring + _ = P.p₁ * ((P.q : ℤ) * u.re) - (P.q₁ : ℤ) * (P.p * u.re) := by ring + _ = P.p₁ * ((P.q : ℤ) * u.re) - (P.q₁ : ℤ) * (u.re * P.p) := by ring + _ = P.p₁ * ((P.q : ℤ) * u.re) - (P.q₁ : ℤ) * (u.re * P.p) := by ring + _ = (P.q : ℤ) * (P.p₁ * u.re - (P.q₁ : ℤ) * oneValue) := by + rw [oneInteger] + ring + rcases qdividesReal with ⟨integerPart, integerEquation⟩ + have qSquare : (P.q : ℝ) ^ 2 ≠ 0 := pow_ne_zero 2 qReal + have zeroProduct := (div_eq_iff qSquare).mp zeroEquation + have zeroCleanReal : (u.re : ℝ) + (P.p : ℝ) * (P.q : ℝ) * u.im = + (zeroValue : ℝ) * (P.q : ℝ) ^ 2 := by + linarith [zeroProduct] + have zeroClean : u.re + P.p * (P.q : ℤ) * u.im = + zeroValue * (P.q : ℤ) ^ 2 := by + exact_mod_cast zeroCleanReal + have reducedEquation : integerPart + P.p * u.im = + zeroValue * (P.q : ℤ) := by + apply (mul_left_cancel₀ (by exact_mod_cast P.q_pos.ne' : (P.q : ℤ) ≠ 0)) + calc + (P.q : ℤ) * (integerPart + P.p * u.im) = + u.re + P.p * (P.q : ℤ) * u.im := by rw [integerEquation]; ring + _ = zeroValue * (P.q : ℤ) ^ 2 := zeroClean + _ = (P.q : ℤ) * (zeroValue * (P.q : ℤ)) := by ring + have secondDivides : (P.q : ℤ) ∣ (P.q₁ : ℤ) * integerPart - u.im := by + refine ⟨(P.q₁ : ℤ) * zeroValue - P.p₁ * u.im, ?_⟩ + calc + (P.q₁ : ℤ) * integerPart - u.im = + (P.q₁ : ℤ) * (integerPart + P.p * u.im) - + (P.p * (P.q₁ : ℤ) + 1) * u.im := by ring + _ = (P.q₁ : ℤ) * (zeroValue * (P.q : ℤ)) - + (P.p₁ * (P.q : ℤ)) * u.im := by + rw [reducedEquation] + congr 1 + calc + (P.p * (P.q₁ : ℤ) + 1) * u.im = + (P.p * (P.q₁ : ℤ) + 1) * u.im := rfl + _ = (P.p₁ * (P.q : ℤ)) * u.im := by + have determinant : P.p₁ * (P.q : ℤ) - (P.q₁ : ℤ) * P.p = 1 := P.det₁ + have relation : P.p * (P.q₁ : ℤ) + 1 = P.p₁ * (P.q : ℤ) := by + linarith [determinant] + rw [relation] + _ = (P.q : ℤ) * ((P.q₁ : ℤ) * zeroValue - P.p₁ * u.im) := by ring + rcases secondDivides with ⟨secondPart, secondEquation⟩ + have generatorOne : (⟨(P.q : ℤ), (P.q₁ : ℤ)⟩ : GaussianInt) ∈ + FordExceptionalLattice P := AddSubgroup.subset_closure (by simp) + have generatorTwo : (⟨0, -(P.q : ℤ)⟩ : GaussianInt) ∈ + FordExceptionalLattice P := AddSubgroup.subset_closure (by simp) + have combination : u = integerPart • (⟨(P.q : ℤ), (P.q₁ : ℤ)⟩ : GaussianInt) + + secondPart • (⟨0, -(P.q : ℤ)⟩ : GaussianInt) := by + ext + · simp [integerEquation] + ring + · simp + linarith [secondEquation] + rw [combination] + exact (FordExceptionalLattice P).add_mem + ((FordExceptionalLattice P).zsmul_mem generatorOne integerPart) + ((FordExceptionalLattice P).zsmul_mem generatorTwo secondPart) + · rw [FordExceptionalLattice, AddSubgroup.closure_le] + intro u hu + rcases hu with (rfl | rfl) + · change ∀ i : Fin 2, ∃ n : ℤ, _ + intro i + fin_cases i + · refine ⟨-P.p, ?_⟩ + simp [hmatrix, hC, FordCircleCoordinate, Matrix.mulVec, + ] + field_simp [show (P.q : ℝ) ≠ 0 by exact_mod_cast P.q_pos.ne'] + · refine ⟨0, ?_⟩ + simp [hmatrix, hC, FordCircleCoordinate, Matrix.mulVec, + ] + · change ∀ i : Fin 2, ∃ n : ℤ, _ + intro i + fin_cases i + · refine ⟨P.p₁, ?_⟩ + simp [hmatrix, hC, FordCircleCoordinate, Matrix.mulVec, + ] + field_simp [show (P.q : ℝ) ≠ 0 by exact_mod_cast P.q_pos.ne'] + have relation : P.p * (P.q₁ : ℤ) + 1 = P.p₁ * (P.q : ℤ) := by + linarith [P.det₁] + have relationReal : (P.p : ℝ) * (P.q₁ : ℝ) + 1 = + (P.p₁ : ℝ) * (P.q : ℝ) := by exact_mod_cast relation + nlinarith [relationReal] + · refine ⟨P.p, ?_⟩ + simp [hmatrix, hC, FordCircleCoordinate, Matrix.mulVec, + ] + field_simp [show (P.q : ℝ) ≠ 0 by exact_mod_cast P.q_pos.ne'] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordExceptionalMaximality.lean b/LeanPool/ApollonianSuperharmonic/FordExceptionalMaximality.lean new file mode 100644 index 0000000000..4dce465f97 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordExceptionalMaximality.lean @@ -0,0 +1,241 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation +public import LeanPool.ApollonianSuperharmonic.FiniteAcyclicOrientationObstruction +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.FordExceptionalLattice +public import LeanPool.ApollonianSuperharmonic.FordExceptionalMatrixLatticeIdentification +public import LeanPool.ApollonianSuperharmonic.FordBoundaryMultiplicity +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordOdometerFamilyExistsUnique +public import LeanPool.ApollonianSuperharmonic.FordPeakMatrix +public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import LeanPool.ApollonianSuperharmonic.LatticeVertexBoundary +public import LeanPool.ApollonianSuperharmonic.P5442T1Cocycle +public import LeanPool.ApollonianSuperharmonic.P5442T1LaplacianBound +public import LeanPool.ApollonianSuperharmonic.FordTileAcyclicIndegree +public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport +public import LeanPool.ApollonianSuperharmonic.P4062T1OrientationTransport +public import Mathlib.Data.List.Chain + +-- [TABLET NODE: FordExceptionalMaximality] + +/-! +# FordExceptionalMaximality + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FordExceptionalMaximality (P : FordFareyParameter) : + (∀ x, FourNeighborLaplacian (FordOdometer P) x <= 1) ∧ + (∀ v, v ∈ FordExceptionalLattice P -> ∃ a : GaussianInt, + Matrix.mulVec (FordPeakMatrix P.p P.q P.q_pos P.reduced) + ![(v.re : Real), (v.im : Real)] = + ![(a.re : Real), (a.im : Real)] ∧ + ∀ x, FordOdometer P (x + v) = FordOdometer P x + + x.re * a.re + x.im * a.im + FordOdometer P v) ∧ + (∀ X : Set GaussianInt, X.Infinite -> FourNeighborConnected X -> + (∀ x, FourNeighborLaplacian + (fun y => FordOdometer P y + + Set.indicator X (fun _ => (1 : Int)) y) x <= 1) -> + X = Set.univ) := by +-- BODY + classical + refine ⟨P5442T1LaplacianBound P, P5442T1Cocycle P, ?_⟩ + intro X hInf hX hbound + let g := FordOdometer P + let t : Int → Int → GaussianInt := fun m n => + ⟨n * (P.q : Int), n * (P.q₁ : Int) - m * (P.q : Int)⟩ + let W : Set GaussianInt := {x | ∃ m n : Int, + x - t m n ∈ LatticeVertexBoundary (FordVertexDomain P.q)} + obtain ⟨periods, webLap, webConnected, owner⟩ := P5442T1WebGeometry P + change (∀ m n, t m n ∈ FordExceptionalLattice P ∧ + ∀ x, FourNeighborLaplacian g (x + t m n) = FourNeighborLaplacian g x) at periods + change (∀ x ∈ W, FourNeighborLaplacian g x = 1) at webLap + change FourNeighborConnected W at webConnected + change (∀ x, x ∉ W → ∃ m n : Int, ∀ y, + Relation.ReflTransGen (fun u z => u ∉ W ∧ z ∉ W ∧ FourNeighborAdjacent u z) x y → + y - t m n ∈ P4062T1InteriorSquare P.q) at owner + have connectedReach (S : Set GaussianInt) (hS : FourNeighborConnected S) + (x : GaussianInt) (hx : x ∈ S) (y : GaussianInt) (hy : y ∈ S) : + Relation.ReflTransGen (fun u z => u ∈ S ∧ z ∈ S ∧ FourNeighborAdjacent u z) x y := by + obtain ⟨p, hp, hlast, pall, padj⟩ := hS.2 x hx y hy + have hc : p.IsChain (fun u z => u ∈ S ∧ z ∈ S ∧ FourNeighborAdjacent u z) := by + apply List.isChain_iff_forall_rel_of_append_cons_cons.mpr + intro u z l₁ l₂ he + exact ⟨pall u (by simp [he]), pall z (by simp [he]), padj u z l₁ l₂ he⟩ + cases p with + | nil => simp at hp + | cons u p => + simp only [List.head?_cons, Option.some.injEq] at hp + subst u + exact List.relationReflTransGen_of_exists_isChain_cons p hc + (List.getLast_of_getLast?_eq_some hlast) + have adjSymm {x y : GaussianInt} (h : FourNeighborAdjacent x y) : + FourNeighborAdjacent y x := by + rcases h with rfl | rfl | rfl | rfl <;> + simp [FourNeighborAdjacent, add_assoc, add_comm, add_left_comm] + have meet : ∃ w, w ∈ X ∧ w ∈ W := by + by_contra hn + have miss : ∀ x ∈ X, x ∉ W := by + intro x hx hw + exact hn ⟨x, hx, hw⟩ + obtain ⟨x, hx⟩ := hX.1 + obtain ⟨m, n, hm⟩ := owner x (miss x hx) + apply hInf.not_finite + apply (Finset.finite_toSet + ((P4062T1InteriorSquare P.q).image (fun y => y + t m n))).subset + intro y hy + have reach := connectedReach X hX x hx y hy + have reach' : Relation.ReflTransGen + (fun u z => u ∉ W ∧ z ∉ W ∧ FourNeighborAdjacent u z) x y := + Relation.ReflTransGen.mono + (fun u z he => ⟨miss u he.1, miss z he.2.1, he.2.2⟩) x y reach + exact Finset.mem_image.mpr ⟨y - t m n, hm y reach', sub_add_cancel _ _⟩ + have noEntry (w : GaussianInt) (hw : w ∈ W) (hwX : w ∉ X) + (y : GaussianInt) (hwy : FourNeighborAdjacent w y) : y ∉ X := by + intro hy + have h := hbound w + change FourNeighborLaplacian + (fun a => g a + Set.indicator X (fun _ => (1 : Int)) a) w ≤ 1 at h + have hl := webLap w hw + unfold FourNeighborLaplacian at h hl + dsimp only at h + simp only [Set.indicator_apply, ite_eq_right hwX] at h + rcases hwy with rfl | rfl | rfl | rfl <;> + simp only [ite_eq_left hy] at h <;> split_ifs at h <;> omega + have webIn : W ⊆ X := by + obtain ⟨w₀, hw₀X, hw₀W⟩ := meet + intro w hw + have reach := connectedReach W webConnected w₀ hw₀W w hw + induction reach with + | refl => exact hw₀X + | @tail u v h e ih => + by_contra hn + exact noEntry v e.2.1 hn u (adjSymm e.2.2) (ih e.1) + obtain ⟨h, hodo, hdom, hval⟩ := FordTileOdometerRestriction P + have hs := P4062T1CanonicalSupport P.q P.q_pos + have hfoot : (h.domain : Set GaussianInt) = FootprintVertices (FordTile P.q) := + hdom.trans hs.1.symm + have hext : GlobalOdometerExtends g h := by + refine ⟨0, ?_⟩ + intro x hx + simpa only [add_zero] using (hval x hx).symm + have hD : (h.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices (FordTile P.q)) (Classical.propDecidable _)) = + P4062T1InteriorSquare P.q := by + have hmem (x : GaussianInt) : x ∈ h.domain ↔ x ∈ FordVertexDomain P.q := + Set.ext_iff.mp hdom x + ext x + simp only [Finset.mem_filter, decide_eq_true_eq, hmem, hs.2, + FordVertexDomain, Set.mem_ofPred_eq] + have square : x ∈ P4062T1InteriorSquare P.q ↔ + 1 ≤ x.re ∧ x.re ≤ (P.q : Int) - 1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q : Int) - 1 := by + constructor + · intro hx + obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hx + obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab + exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, + (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ + · intro hx + exact Finset.mem_image.mpr ⟨(x.re, x.im), Finset.mem_product.mpr + ⟨Finset.mem_Icc.mpr ⟨hx.1, hx.2.1⟩, + Finset.mem_Icc.mpr hx.2.2⟩, by cases x; rfl⟩ + rw [square] + omega + have ho := FordTileAcyclicIndegree P (FordTile P.q) h g + (FordTileRecursiveIdentification P).1 hodo hfoot hext + dsimp only at ho + rw [hD] at ho + obtain ⟨o⟩ := ho + apply Set.eq_univ_of_forall + intro z + by_contra hz + have hzW : z ∉ W := fun h => hz (webIn h) + obtain ⟨m, n, own⟩ := owner z hzW + let R : GaussianInt → GaussianInt → Prop := + fun u v => u ∉ X ∧ v ∉ X ∧ FourNeighborAdjacent u v + let E := (P4062T1InteriorSquare P.q).image (fun y => y + t m n) + let Y := E.filter (fun y => Relation.ReflTransGen R z y) + have outside (y : GaussianInt) (hr : Relation.ReflTransGen R z y) : y ∉ X := by + induction hr with + | refl => exact hz + | tail _ e _ => exact e.2.1 + have owned (y : GaussianInt) (hr : Relation.ReflTransGen R z y) : y ∈ E := by + have hr' : Relation.ReflTransGen + (fun u v => u ∉ W ∧ v ∉ W ∧ FourNeighborAdjacent u v) z y := + Relation.ReflTransGen.mono + (fun u v he => ⟨fun hu => he.1 (webIn hu), + fun hv => he.2.1 (webIn hv), he.2.2⟩) z y hr + exact Finset.mem_image.mpr ⟨y - t m n, own y hr', sub_add_cancel _ _⟩ + have hY : Y.Nonempty := + ⟨z, Finset.mem_filter.mpr ⟨owned z .refl, Relation.ReflTransGen.refl⟩⟩ + have hσ : ∀ x ∈ E, 2 + FourNeighborLaplacian g x = + 2 + FourNeighborLaplacian g (x - t m n) := by + intro x _ + have hp := (periods m n).2 (x - t m n) + rw [sub_add_cancel] at hp + omega + obtain ⟨oE, _, _⟩ := P4062T1OrientationTransport + (P4062T1InteriorSquare P.q) E + (fun x => 2 + FourNeighborLaplacian g x) + (fun x => 2 + FourNeighborLaplacian g x) + (t m n) rfl hσ o + obtain ⟨y, hy, hbad⟩ := FiniteAcyclicOrientationObstruction E g oE Y hY + (Finset.filter_subset _ _) + have hyR : Relation.ReflTransGen R z y := (Finset.mem_filter.mp hy).2 + have hyX : y ∉ X := outside y hyR + have star (a : GaussianInt) (ha : a = y ∨ FourNeighborAdjacent y a) : + g a + Set.indicator X (fun _ => (1 : Int)) a = + (g a - if a ∈ Y then 1 else 0) + 1 := by + have iffY : a ∉ X ↔ a ∈ Y := by + constructor + · intro haX + rcases ha with rfl | ha + · exact hy + · have hr := hyR.tail ⟨hyX, haX, ha⟩ + exact Finset.mem_filter.mpr ⟨owned a hr, hr⟩ + · intro haY + exact outside a (Finset.mem_filter.mp haY).2 + by_cases haX : a ∈ X + · have haY : a ∉ Y := fun hh => (iffY.mpr hh) haX + simp [haX, haY] + · simp [haX, iffY.mp haX] + have hlap : FourNeighborLaplacian + (fun a => g a + Set.indicator X (fun _ => (1 : Int)) a) y = + FourNeighborLaplacian (fun a => g a - if a ∈ Y then 1 else 0) y := by + unfold FourNeighborLaplacian + dsimp only + rw [star _ (Or.inr (Or.inl rfl)), + star _ (Or.inr (Or.inr (Or.inl rfl))), + star _ (Or.inr (Or.inr (Or.inr (Or.inl rfl)))), + star _ (Or.inr (Or.inr (Or.inr (Or.inr rfl)))), star y (Or.inl rfl)] + ring + have hgood := hbound y + change FourNeighborLaplacian + (fun a => g a + Set.indicator X (fun _ => (1 : Int)) a) y ≤ 1 at hgood + rw [hlap] at hgood + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordFareyParameter.lean b/LeanPool/ApollonianSuperharmonic/FordFareyParameter.lean new file mode 100644 index 0000000000..e6432ae408 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordFareyParameter.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: FordFareyParameter] + +/-! +# FordFareyParameter + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A reduced Ford--Farey parameter consists of integers $p,p_1,p_2$ and +natural numbers $q,q_1,q_2$ such that $q>0$, $\gcd(q,|p|)=1$, +$$ + (p,q)=(p_1,q_1)+(p_2,q_2),\qquad + p_1q-q_1p=1,\qquad p_2q-q_2p=-1, +$$ +with $0\leq q_1 omega + · have hqone : 1 < q := by omega + obtain hp | hp := le_total 0 p + · let y : Int := Nat.gcdA p.natAbs q + obtain ⟨q₁, hq₁lt, hq₁mod⟩ := + Nat.exists_mul_mod_eq_of_coprime (q - 1) hred.symm (by omega) + have hq₁mod' : p.natAbs * q₁ % q = q - 1 := by + simpa [Nat.mod_eq_of_lt (show q - 1 < q by omega)] using hq₁mod + have hmodNat : Nat.ModEq q (p.natAbs * q₁) (q - 1) := by + simpa [Nat.ModEq] using hq₁mod' + have hdiv := Nat.ModEq.dvd (n := q) (a := p.natAbs * q₁) (b := q - 1) hmodNat + obtain ⟨t, ht⟩ := hdiv + have hq₁pos : 0 < q₁ := by + by_contra hn + have : q₁ = 0 := by omega + subst q₁ + simp at hq₁mod' + omega + let p₁ : Int := 1 - t + let q₂ : Nat := q - q₁ + let p₂ : Int := p - p₁ + have hdet1 : p₁ * (q : Int) - (q₁ : Int) * p = 1 := by + dsimp [p₁] + rw [Nat.cast_sub (by omega)] at ht + norm_num [Nat.cast_mul, Int.natAbs_of_nonneg hp] at ht ⊢ + nlinarith [ht] + have hdet2 : p₂ * (q : Int) - (q₂ : Int) * p = -1 := by + dsimp [p₁, p₂, q₂] + rw [Nat.cast_sub hq₁lt.le] + nlinarith [hdet1] + let result : FordFareyParameter := by + exact FordFareyParameter.mk p q hq hred p₁ q₁ p₂ q₂ + (by dsimp [p₂]; ring) (by dsimp [q₂]; omega) hdet1 + hdet2 hq₁lt + (by dsimp [q₂]; omega) (by intro h; omega) + refine ⟨result, ?_, ?_⟩ + · simp [result] + · intro other hother + rw [FordFareyParameter.mk.injEq] + have hmul : Nat.ModEq q (p.natAbs * other.q₁) (p.natAbs * q₁) := by + apply Nat.modEq_iff_dvd.mpr + norm_num [Nat.cast_mul, Int.natAbs_of_nonneg hp] + refine ⟨p₁ - other.p₁, ?_⟩ + have hd := other.det₁ + rw [hother.1, hother.2] at hd + dsimp [p₁] at hdet1 + calc + p * (q₁ : Int) - p * (other.q₁ : Int) = + (q : Int) * (p₁ - other.p₁) + + ((other.p₁ * (q : Int) - (other.q₁ : Int) * p) - + (p₁ * (q : Int) - (q₁ : Int) * p)) := by ring + _ = (q : Int) * (p₁ - other.p₁) := by rw [hd, hdet1]; norm_num + have hcancel := Nat.ModEq.cancel_left_of_coprime hred.gcd_eq_one hmul + have hqeq : other.q₁ = q₁ := + hcancel.eq_of_lt_of_lt (by simpa [hother.2] using other.q₁_lt) hq₁lt + have hpone : other.p₁ = p₁ := by + have hd := other.det₁ + rw [hother.1, hother.2, hqeq] at hd + nlinarith [hd, hdet1] + have hqtwo : other.q₂ = q₂ := by + have hs := other.sum_q + rw [hother.2, hqeq] at hs + dsimp [q₂] + omega + have hptwo : other.p₂ = p₂ := by + have hs := other.sum_p + rw [hother.1, hpone] at hs + dsimp [p₂] + omega + exact ⟨by simp [hother.1], hother.2, hpone, hqeq, hptwo, hqtwo⟩ + · by_cases hz : p = 0 + · subst p + have : q = 1 := (Nat.coprime_zero_right q).mp hred + omega + · obtain ⟨q₁, hq₁lt, hq₁mod⟩ := + Nat.exists_mul_mod_eq_one_of_coprime hred.symm hqone + have hdiv : (q : Int) ∣ (1 : Int) - (p.natAbs * q₁ : Int) := by + have hm : Nat.ModEq q (p.natAbs * q₁) 1 := by + simpa [Nat.ModEq, Nat.mod_eq_of_lt hqone] using hq₁mod + exact Nat.ModEq.dvd hm + obtain ⟨t, ht⟩ := hdiv + have hq₁pos : 0 < q₁ := by + by_contra hn + have : q₁ = 0 := by omega + subst q₁ + simp at hq₁mod + obtain ⟨n, hpform⟩ : ∃ n : Nat, p = -(n.succ : Int) := by + cases p with + | ofNat n => simp_all + | negSucc n => exact ⟨n, rfl⟩ + let p₁ : Int := t + let q₂ : Nat := q - q₁ + let p₂ : Int := p - p₁ + have hdet1 : p₁ * (q : Int) - (q₁ : Int) * p = 1 := by + dsimp [p₁] + have hpabs : (p.natAbs : Int) = -p := by + rw [hpform] + change (n.succ : Int) = n.succ + rfl + rw [hpabs] at ht + rw [hpform] at ht ⊢ + norm_num [Nat.cast_mul] at ht ⊢ + nlinarith [ht] + have hdet2 : p₂ * (q : Int) - (q₂ : Int) * p = -1 := by + dsimp [p₁, p₂, q₂] + rw [hpform] + rw [Nat.cast_sub hq₁lt.le] + nlinarith [hdet1] + let result : FordFareyParameter := by + exact FordFareyParameter.mk p q hq hred p₁ q₁ p₂ q₂ + (by dsimp [p₂]; ring) (by dsimp [q₂]; omega) hdet1 hdet2 hq₁lt + (by dsimp [q₂]; omega) (by intro h; omega) + refine ⟨result, ?_, ?_⟩ + · simp [result] + · intro other hother + rw [FordFareyParameter.mk.injEq] + have hpabs : (p.natAbs : Int) = -p := by + rw [hpform] + change (n.succ : Int) = n.succ + rfl + have hmul : Nat.ModEq q (p.natAbs * other.q₁) (p.natAbs * q₁) := by + apply Nat.modEq_iff_dvd.mpr + norm_num [Nat.cast_mul] + rw [← Int.natCast_natAbs, hpabs] + refine ⟨other.p₁ - p₁, ?_⟩ + have hd := other.det₁ + rw [hother.1, hother.2] at hd + calc + -p * (q₁ : Int) - -p * (other.q₁ : Int) = + (q : Int) * (other.p₁ - p₁) + + ((p₁ * (q : Int) - (q₁ : Int) * p) - + (other.p₁ * (q : Int) - (other.q₁ : Int) * p)) := by ring + _ = (q : Int) * (other.p₁ - p₁) := by rw [hd, hdet1]; norm_num + have hcancel := Nat.ModEq.cancel_left_of_coprime hred.gcd_eq_one hmul + have hqeq : other.q₁ = q₁ := + hcancel.eq_of_lt_of_lt (by simpa [hother.2] using other.q₁_lt) hq₁lt + have hpone : other.p₁ = p₁ := by + have hd := other.det₁ + rw [hother.1, hother.2, hqeq] at hd + nlinarith [hd, hdet1] + have hqtwo : other.q₂ = q₂ := by + have hs := other.sum_q + rw [hother.2, hqeq] at hs + dsimp [q₂] + omega + have hptwo : other.p₂ = p₂ := by + have hs := other.sum_p + rw [hother.1, hpone] at hs + dsimp [p₂] + omega + exact ⟨by simp [hother.1], hother.2, hpone, hqeq, hptwo, hqtwo⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean new file mode 100644 index 0000000000..e2cfeeb977 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean @@ -0,0 +1,1380 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordBoundaryMultiplicity +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import LeanPool.ApollonianSuperharmonic.LatticeVertexBoundary +public import Mathlib.RingTheory.Int.Basic +public import Mathlib.Algebra.BigOperators.Group.Finset.Piecewise +public import Mathlib.Algebra.BigOperators.Fin +public import Mathlib.Tactic.ClearExcept + +-- [TABLET NODE: FordLaplacianTable] + +/-! +# FordLaplacianTable + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FordLaplacianProof + +private theorem periodic : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + ∀ (v : GaussianInt), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (c : ℤ), (∀ (x : GaussianInt), g (x + v) = g x + + a * x.re + b * x.im + c) → ∀ (x : GaussianInt), FourNeighborLaplacian g (x + v) = + FourNeighborLaplacian g x := by + classical + intro P g v a b c h x + unfold FourNeighborLaplacian + rw [show x + v + 1 = (x + 1) + v by abel, + show x + v - 1 = (x - 1) + v by abel, + show x + v + ⟨0, 1⟩ = (x + ⟨0, 1⟩) + v by abel, + show x + v - ⟨0, 1⟩ = (x - ⟨0, 1⟩) + v by abel] + rw [h, h, h, h, h] + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, + Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + ring + +private theorem boundaryValue : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (∀ (P : FordFareyParameter), ∀ x ∈ FordDoubledBoundary P.q, Classical.choose + FordOdometerFamilyExistsUnique P x = IntegerCeilDiv (P.p * x.re * x.im) (↑P.q : ℤ) (by + exact_mod_cast P.q_pos.ne')) → (∀ (r : ℤ), ∀ (s : ℤ), (0 : ℤ) ≤ r → r ≤ (↑P.q : ℤ) → (0 : + ℤ) ≤ s → s ≤ (↑P.q : ℤ) → r ≤ (1 : ℤ) ∨ (↑P.q : ℤ) - (1 : ℤ) ≤ r ∨ s ≤ (1 : ℤ) ∨ (↑P.q : + ℤ) - (1 : ℤ) ≤ s → g ⟨r, s⟩ = -(-(P.p * r * s) / (↑P.q : ℤ))) := by + classical + intro P g hbdy r s hr hr' hs hs' hedge + apply hbdy P + change (0 ≤ r ∧ r ≤ P.q ∧ 0 ≤ s ∧ s ≤ P.q) ∧ + ¬(2 ≤ r ∧ r ≤ (P.q : Int) - 2 ∧ + 2 ≤ s ∧ s ≤ (P.q : Int) - 2) + omega + +private theorem below : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (∀ (P : FordFareyParameter), ∀ (x : GaussianInt), Classical.choose + FordOdometerFamilyExistsUnique P (x + ⟨(0 : ℤ), -(↑P.q : ℤ)⟩) = Classical.choose + FordOdometerFamilyExistsUnique P x - P.p * x.re) → ((0 < (P.q : Int)) → ((∀ (n : Int), ∀ + (k : Int), -((-(k * (P.q : Int) - n)) / (P.q : Int)) = k - n / (P.q : Int)) → ((∀ (r + : Int), ∀ (s : Int), (0 ≤ r) → ((r ≤ P.q) → ((0 ≤ s) → ((s ≤ P.q) → ((r ≤ 1 ∨ (P.q : + Int) - + 1 ≤ r ∨ s ≤ 1 ∨ (P.q : Int) - 1 ≤ s) → (g ⟨r, s⟩ = -((-(P.p * r * s)) / (P.q : + Int)))))))) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t ≤ (↑P.q : ℤ) → g ⟨t, (-1 : ℤ)⟩ = -(P.p * t / + (↑P.q : ℤ)))))) := by + classical + intro P g hneg hq ceilShift boundaryValue t ht ht' + have hd := hneg P ⟨t, (P.q : Int) - 1⟩ + change g _ = g _ - _ at hd + have he : (⟨t, (P.q : Int) - 1⟩ : GaussianInt) + + ⟨0, -(P.q : Int)⟩ = ⟨t, -1⟩ := by ext <;> simp; ring + rw [he] at hd + have hv := boundaryValue t ((P.q : Int) - 1) ht ht' + (by omega) (by omega) (by omega) + rw [hv] at hd + rw [show P.p * t * ((P.q : Int) - 1) = + (P.p * t) * (P.q : Int) - P.p * t by ring, ceilShift] at hd + simpa using hd + +private theorem left : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (∀ (P : FordFareyParameter), ∀ (x : GaussianInt), Classical.choose + FordOdometerFamilyExistsUnique P (x + ⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩) = Classical.choose + FordOdometerFamilyExistsUnique P x + P.p₁ * x.re + P.p * x.im + (↑P.q₁ : ℤ) * P.p) → ((∀ + (P : FordFareyParameter), ∀ (x : GaussianInt), Classical.choose + FordOdometerFamilyExistsUnique P (x + ⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩) = Classical.choose + FordOdometerFamilyExistsUnique P x + P.p₂ * x.re - P.p * x.im - (↑P.q : ℤ) * P.p₂) → ((0 + < (P.q : Int)) → (((P.q : Int) ≠ 0) → (((P.q₁ : Int) < P.q) → ((∀ (n : Int), ∀ (k : Int), + -((-(k * (P.q : Int) - n)) / (P.q : Int)) = k - n / (P.q : Int)) → ((∀ (r : Int), ∀ + (s : Int), (0 ≤ r) → ((r ≤ P.q) → ((0 ≤ s) → ((s ≤ P.q) → ((r ≤ 1 ∨ (P.q : Int) - 1 ≤ + r ∨ s ≤ + 1 ∨ (P.q : Int) - 1 ≤ s) → (g ⟨r, s⟩ = -((-(P.p * r * s)) / (P.q : Int)))))))) → (∀ (t : + ℤ), (0 : ℤ) ≤ t → t ≤ (↑P.q : ℤ) → g ⟨(-1 : ℤ), t⟩ = -((P.p * t - (1 : ℤ)) / (↑P.q : + ℤ))))))))) := by + classical + intro P g hpos hneg₂ hq hqne ha ceilShift boundaryValue t ht ht' + have hsum : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q + by_cases htb : t ≤ P.q₂ + · have hd := hpos P ⟨-1, t⟩ + change g _ = g _ + _ + _ + _ at hd + have he : (⟨-1, t⟩ : GaussianInt) + + ⟨(P.q : Int), (P.q₁ : Int)⟩ = + ⟨(P.q : Int) - 1, t + P.q₁⟩ := by ext <;> simp; ring + rw [he] at hd + have hv := boundaryValue ((P.q : Int) - 1) (t + P.q₁) + (by omega) (by omega) (by omega) (by omega) (by omega) + rw [hv] at hd + rw [show P.p * ((P.q : Int) - 1) * (t + P.q₁) = + (P.p * (t + P.q₁)) * (P.q : Int) - P.p * (t + P.q₁) by ring, + ceilShift] at hd + have hdet := P.det₁ + have he' : P.p * (t + P.q₁) = + (P.p * t - 1) + P.p₁ * (P.q : Int) := by nlinarith only [hdet] + rw [he', Int.add_mul_ediv_right _ _ hqne] at hd + dsimp at hd + linarith only [hd, hdet] + · have hd := hneg₂ P ⟨(P.q : Int) - 1, t - P.q₂⟩ + change g _ = g _ + _ - _ - _ at hd + have he : (⟨(P.q : Int) - 1, t - P.q₂⟩ : GaussianInt) + + ⟨-(P.q : Int), (P.q₂ : Int)⟩ = ⟨-1, t⟩ := by + ext <;> simp; ring + rw [he] at hd + have hv := boundaryValue ((P.q : Int) - 1) (t - P.q₂) + (by omega) (by omega) (by omega) (by omega) (by omega) + rw [hv] at hd + rw [show P.p * ((P.q : Int) - 1) * (t - P.q₂) = + (P.p * (t - P.q₂)) * (P.q : Int) - P.p * (t - P.q₂) by ring, + ceilShift] at hd + have hdet := P.det₂ + have he' : P.p * (t - P.q₂) = + (P.p * t - 1) + (-P.p₂) * (P.q : Int) := by nlinarith only [hdet] + rw [he', Int.add_mul_ediv_right _ _ hqne] at hd + dsimp at hd + linarith only [hd] + +private theorem nondiv : + ∀ (P : FordFareyParameter), ∀ (t : ℤ), (0 : ℤ) < t → t < (↑P.q : ℤ) → ¬(↑P.q : ℤ) ∣ P.p * t + := by + classical + intro P t ht ht' + rintro ⟨k, hk⟩ + have hdet := congrArg (fun z : Int => z * t) P.det₁ + have hk' := congrArg (fun z : Int => z * (P.q₁ : Int)) hk + have hd : (P.q : Int) ∣ t := by + refine ⟨P.p₁ * t - (P.q₁ : Int) * k, ?_⟩ + nlinarith only [hk', hdet] + have := Int.le_of_dvd ht hd + omega + +private theorem roundInterior : + ∀ (P : FordFareyParameter), (0 < (P.q : Int)) → (((P.q : Int) ≠ 0) → ((∀ (t : Int), (0 < t) → + ((t < P.q) → (¬ (P.q : Int) ∣ P.p * t))) → (∀ (t : ℤ), (0 : ℤ) < t → t < (↑P.q : ℤ) → + -(-(P.p * t) / (↑P.q : ℤ)) - P.p * t / (↑P.q : ℤ) = (1 : ℤ) ∧ (P.p * t - (1 : ℤ)) / (↑P.q + : ℤ) = P.p * t / (↑P.q : ℤ)))) := by + classical + intro P hq hqne nondiv t ht ht' + have hn := nondiv t ht ht' + constructor + · rw [Int.neg_ediv, ite_eq_right hn, Int.sign_eq_one_of_pos hq] + ring + · apply (Int.ediv_eq_iff_of_pos hq).mpr + have hm := Int.emod_nonneg (P.p * t) hqne + have hml := Int.emod_lt_of_pos (P.p * t) hq + have hmn : P.p * t % (P.q : Int) ≠ 0 := by + intro hh + exact hn (Int.dvd_of_emod_eq_zero hh) + have hmp : 1 ≤ P.p * t % (P.q : Int) := by omega + have hd := Int.emod_add_mul_ediv (P.p * t) (P.q : Int) + constructor <;> nlinarith only [hmp, hml, hd] + +private theorem bottomLap : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (0 < (P.q : Int)) → ((∀ (t : Int), (0 ≤ t) → ((t ≤ P.q) → (g ⟨t, 0⟩ = 0 ∧ g ⟨0, t⟩ = 0 ∧ g + ⟨t, 1⟩ = -((- (P.p * t)) / (P.q : Int)) ∧ g ⟨1, t⟩ = -((- (P.p * t)) / (P.q : Int))))) → + ((∀ (t : Int), (0 ≤ t) → ((t ≤ P.q) → (g ⟨t, -1⟩ = -(P.p * t / (P.q : Int))))) → ((∀ (t : + Int), (0 ≤ t) → ((t ≤ P.q) → (g ⟨-1, t⟩ = -((P.p * t - 1) / (P.q : Int))))) → ((∀ (r + : Int), ∀ (s : Int), FourNeighborLaplacian g ⟨r, s⟩ = g ⟨r + 1, s⟩ + g ⟨r - 1, s⟩ + g + ⟨r, s + + 1⟩ + g ⟨r, s - 1⟩ - 4 * g ⟨r, s⟩) → ((∀ (t : Int), (0 < t) → ((t < P.q) → (-((- (P.p * + t)) / (P.q : Int)) - P.p * t / (P.q : Int) = 1 ∧ (P.p * t - 1) / (P.q : Int) = P.p * t / + (P.q : Int)))) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t < (↑P.q : ℤ) → FourNeighborLaplacian g ⟨t, + (0 : ℤ)⟩ = (1 : ℤ))))))) := by + classical + intro P g hq axes below left lapCoord roundInterior t ht ht' + rw [lapCoord] + norm_num only + by_cases hz : t = 0 + · subst t + have h0 := axes 0 (by omega) (by omega) + have h1 := axes 1 (by omega) (by omega) + have hl := left 0 (by omega) (by omega) + have hd := below 0 (by omega) (by omega) + norm_num [Int.neg_one_ediv, Int.sign_eq_one_of_pos hq] at hl + norm_num at h0 hd ⊢ + rw [h1.1, hl, h1.2.1, hd, h0.1] + norm_num + · have hm := axes (t - 1) (by omega) (by omega) + have hp := axes (t + 1) (by omega) (by omega) + have hc := axes t ht (by omega) + rw [hp.1, hm.1, hc.2.2.1, below t ht (by omega), hc.1] + have hh := (roundInterior t (by omega) ht').1 + linarith only [hh] + +private theorem leftLap : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (0 < (P.q : Int)) → ((∀ (x : GaussianInt), FourNeighborLaplacian g (x + ⟨0, (P.q : Int)⟩) = + FourNeighborLaplacian g x) → ((∀ (t : Int), (0 ≤ t) → ((t ≤ P.q) → (g ⟨t, 0⟩ = 0 ∧ g ⟨0, + t⟩ = 0 ∧ g ⟨t, 1⟩ = -((- (P.p * t)) / (P.q : Int)) ∧ g ⟨1, t⟩ = -((- (P.p * t)) / (P.q : + Int))))) → ((∀ (t : Int), (0 ≤ t) → ((t ≤ P.q) → (g ⟨-1, t⟩ = -((P.p * t - 1) / (P.q : + Int))))) → ((∀ (r : Int), ∀ (s : Int), FourNeighborLaplacian g ⟨r, s⟩ = g ⟨r + 1, s⟩ + g + ⟨r - 1, s⟩ + g ⟨r, s + 1⟩ + g ⟨r, s - 1⟩ - 4 * g ⟨r, s⟩) → ((∀ (t : Int), (0 < t) → ((t < + P.q) → (-((- (P.p * t)) / (P.q : Int)) - P.p * t / (P.q : Int) = 1 ∧ (P.p * t - 1) / (P.q + : Int) = P.p * t / (P.q : Int)))) → ((∀ (t : Int), (0 ≤ t) → ((t < P.q) → + (FourNeighborLaplacian g ⟨t, 0⟩ = 1))) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t ≤ (↑P.q : ℤ) → + FourNeighborLaplacian g ⟨(0 : ℤ), t⟩ = (1 : ℤ)))))))) := by + classical + intro P g hq periodUp axes left lapCoord roundInterior bottomLap t ht ht' + by_cases hz : t = 0 + · subst t + exact bottomLap 0 (by omega) hq + by_cases htop : t = P.q + · subst t + have hp := periodUp ⟨0, 0⟩ + simpa using hp.trans (bottomLap 0 (by omega) hq) + rw [lapCoord] + norm_num only + have hm := axes (t - 1) (by omega) (by omega) + have hp := axes (t + 1) (by omega) (by omega) + have hc := axes t ht ht' + rw [hc.2.2.2, left t ht ht', hp.2.1, hm.2.1, hc.2.1] + obtain ⟨hround, hfloor⟩ := roundInterior t (by omega) (by omega) + rw [hfloor] + linarith only [hround] + +private theorem rightLap : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + ((P.q₁ : Int) < P.q) → ((∀ (x : GaussianInt), FourNeighborLaplacian g (x + ⟨(0 : ℤ), -(↑P.q : + ℤ)⟩) = FourNeighborLaplacian g x) → ((∀ (x : GaussianInt), FourNeighborLaplacian g (x + + ⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩) = FourNeighborLaplacian g x) → ((∀ (t : Int), (0 ≤ t) → ((t ≤ + P.q) → (FourNeighborLaplacian g ⟨0, t⟩ = 1))) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t ≤ (↑P.q : ℤ) + → FourNeighborLaplacian g ⟨(↑P.q : ℤ), t⟩ = (1 : ℤ))))) := by + classical + intro P g ha periodNeg periodPos leftLap t ht ht' + have he : (⟨0, t - P.q₁⟩ : GaussianInt) + + ⟨(P.q : Int), (P.q₁ : Int)⟩ = ⟨(P.q : Int), t⟩ := by + ext <;> simp + rw [← he, periodPos] + by_cases hs : (P.q₁ : Int) ≤ t + · exact leftLap (t - P.q₁) (by omega) (by omega) + · have he' : (⟨0, t - P.q₁ + P.q⟩ : GaussianInt) + + ⟨0, -(P.q : Int)⟩ = ⟨0, t - P.q₁⟩ := by ext <;> simp + rw [← he', periodNeg] + exact leftLap (t - P.q₁ + P.q) (by omega) (by omega) + +private theorem ha0 : + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((GaussianInt) → ( + let a : Int := P.q₁ + let b : Int := P.q₂ + ((P.q : Int) = a + b) → (0 < a))) := by + classical + intro P hbig x a b hsum + let A := P.p₁ + by_contra h + have hanon : 0 ≤ a := by dsimp [a]; omega + have haz : a = 0 := by omega + have hd : (P.q : Int) ∣ 1 := by + refine ⟨A, ?_⟩ + have hh := P.det₁ + change A * (P.q : Int) - a * P.p = 1 at hh + rw [haz] at hh + nlinarith only [hh] + have := Int.le_of_dvd (by norm_num : (0 : Int) < 1) hd + omega + +private theorem parentValue : + (FordFareyParameter) → ((∀ (P : FordFareyParameter), ∀ x ∈ FordDoubledBoundary P.q, + Classical.choose FordOdometerFamilyExistsUnique P x = IntegerCeilDiv (P.p * x.re * x.im) + (↑P.q : ℤ) (by exact_mod_cast P.q_pos.ne')) → ((GaussianInt) → ( + let cdiv (n d : Int) := -((-n) / d) + (FordFareyParameter) → ((FordFareyParameter) → (∀ (R : FordFareyParameter), ∀ (r : ℤ), ∀ (s : + ℤ), (0 : ℤ) ≤ r ∧ r ≤ (↑R.q : ℤ) ∧ (0 : ℤ) ≤ s ∧ s ≤ (↑R.q : ℤ) → r ≤ (1 : ℤ) ∨ (↑R.q : + ℤ) - (1 : ℤ) ≤ r ∨ s ≤ (1 : ℤ) ∨ (↑R.q : ℤ) - (1 : ℤ) ≤ s → Classical.choose + FordOdometerFamilyExistsUnique R ⟨r, s⟩ = cdiv (R.p * r * s) (↑R.q : ℤ)))))) := by + classical + intro P hbdy x cdiv P₁ P₂ R r s hrect hedge + apply hbdy R + change (0 ≤ r ∧ r ≤ R.q ∧ 0 ≤ s ∧ s ≤ R.q) ∧ + ¬(2 ≤ r ∧ r ≤ (R.q : Int) - 2 ∧ + 2 ≤ s ∧ s ≤ (R.q : Int) - 2) + omega + +private theorem v1 : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (GaussianInt) → ( + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + let cdiv (n d : Int) := -((-n) / d) + ((P.q : Int) = a + b) → (∀ (P₁ : FordFareyParameter), (P₁.p = A) → ((P₁.q = P.q₁) → (∀ (P₂ : + FordFareyParameter), (P₂.q = P.q₂) → ((∀ x ∈ FordRecursiveVertexDomains P (1 : Fin (4 : + ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = Classical.choose + FordOdometerFamilyExistsUnique P₁ (x - ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) + P.p₂ * x.re + P.p₂ * + x.im - P.p₂ * (↑P.q₂ : ℤ) + (1 : ℤ)) → ((∀ (R : FordFareyParameter), ∀ (r : Int), ∀ (s : + Int), (0 ≤ r ∧ r ≤ R.q ∧ 0 ≤ s ∧ s ≤ R.q) → ((r ≤ 1 ∨ (R.q : Int) - 1 ≤ r ∨ s ≤ 1 ∨ (R.q + : Int) - 1 ≤ s) → (Classical.choose FordOdometerFamilyExistsUnique R ⟨r, s⟩ = cdiv (R.p * + r * s) R.q))) → (∀ (r : ℤ), ∀ (s : ℤ), b ≤ r ∧ r ≤ (↑P.q : ℤ) ∧ b ≤ s ∧ s ≤ (↑P.q : ℤ) → + r - b ≤ (1 : ℤ) ∨ a - (1 : ℤ) ≤ r - b ∨ s - b ≤ (1 : ℤ) ∨ a - (1 : ℤ) ≤ s - b → g ⟨r, s⟩ + = cdiv (A * (r - b) * (s - b)) a + B * r + B * s - B * b + (1 : ℤ)))))))) := by + classical + intro P g x a b A B cdiv hsum P₁ hp₁ hq₁ P₂ hq₂ rec1 parentValue r s hrect hedge + have hd := rec1 ⟨r, s⟩ (by change b ≤ r ∧ r ≤ P.q ∧ b ≤ s ∧ s ≤ P.q; exact hrect) + have he : (⟨r, s⟩ : GaussianInt) - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ = ⟨r - b, s - b⟩ := rfl + rw [he] at hd + have hv := parentValue P₁ (r - b) (s - b) + (by rw [hq₁]; change 0 ≤ r - b ∧ r - b ≤ a ∧ 0 ≤ s - b ∧ s - b ≤ a; omega) + (by simpa [hq₁, a] using hedge) + rw [hp₁, hq₁] at hv + rw [hv] at hd + exact hd + +private theorem v2 : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (GaussianInt) → ( + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + let cdiv (n d : Int) := -((-n) / d) + ((P.q : Int) = a + b) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : + FordFareyParameter), (P₂.p = B) → ((P₂.q = P.q₂) → ((∀ x ∈ FordRecursiveVertexDomains P + (2 : Fin (4 : ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = Classical.choose + FordOdometerFamilyExistsUnique P₂ (x - ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩) + P.p₁ * x.im) → ((∀ (R : + FordFareyParameter), ∀ (r : Int), ∀ (s : Int), (0 ≤ r ∧ r ≤ R.q ∧ 0 ≤ s ∧ s ≤ R.q) → ((r + ≤ 1 ∨ (R.q : Int) - 1 ≤ r ∨ s ≤ 1 ∨ (R.q : Int) - 1 ≤ s) → (Classical.choose + FordOdometerFamilyExistsUnique R ⟨r, s⟩ = cdiv (R.p * r * s) R.q))) → (∀ (r : ℤ), ∀ (s : + ℤ), a ≤ r ∧ r ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ s ∧ s ≤ b → r - a ≤ (1 : ℤ) ∨ b - (1 : ℤ) ≤ r - a + ∨ s ≤ (1 : ℤ) ∨ b - (1 : ℤ) ≤ s → g ⟨r, s⟩ = cdiv (B * (r - a) * s) b + A * s))))))) := by + classical + intro P g x a b A B cdiv hsum P₁ hq₁ P₂ hp₂ hq₂ rec2 parentValue r s hrect hedge + have hd := rec2 ⟨r, s⟩ (by change a ≤ r ∧ r ≤ P.q ∧ 0 ≤ s ∧ s ≤ b; exact hrect) + have he : (⟨r, s⟩ : GaussianInt) - ⟨(P.q₁ : Int), 0⟩ = ⟨r - a, s⟩ := by ext <;> simp [a] + rw [he] at hd + have hv := parentValue P₂ (r - a) s + (by rw [hq₂]; change 0 ≤ r - a ∧ r - a ≤ b ∧ 0 ≤ s ∧ s ≤ b; omega) + (by simpa [hq₂, b] using hedge) + rw [hp₂, hq₂] at hv + rw [hv] at hd + exact hd + +private theorem v3 : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (GaussianInt) → ( + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + let cdiv (n d : Int) := -((-n) / d) + ((P.q : Int) = a + b) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : + FordFareyParameter), (P₂.p = B) → ((P₂.q = P.q₂) → ((∀ x ∈ FordRecursiveVertexDomains P + (3 : Fin (4 : ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = Classical.choose + FordOdometerFamilyExistsUnique P₂ (x - ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩) + P.p₁ * x.re) → ((∀ (R : + FordFareyParameter), ∀ (r : Int), ∀ (s : Int), (0 ≤ r ∧ r ≤ R.q ∧ 0 ≤ s ∧ s ≤ R.q) → ((r + ≤ 1 ∨ (R.q : Int) - 1 ≤ r ∨ s ≤ 1 ∨ (R.q : Int) - 1 ≤ s) → (Classical.choose + FordOdometerFamilyExistsUnique R ⟨r, s⟩ = cdiv (R.p * r * s) R.q))) → (∀ (r : ℤ), ∀ (s : + ℤ), (0 : ℤ) ≤ r ∧ r ≤ b ∧ a ≤ s ∧ s ≤ (↑P.q : ℤ) → r ≤ (1 : ℤ) ∨ b - (1 : ℤ) ≤ r ∨ s - a + ≤ (1 : ℤ) ∨ b - (1 : ℤ) ≤ s - a → g ⟨r, s⟩ = cdiv (B * r * (s - a)) b + A * r))))))) := by + classical + intro P g x a b A B cdiv hsum P₁ hq₁ P₂ hp₂ hq₂ rec3 parentValue r s hrect hedge + have hd := rec3 ⟨r, s⟩ (by change 0 ≤ r ∧ r ≤ b ∧ a ≤ s ∧ s ≤ P.q; exact hrect) + have he : (⟨r, s⟩ : GaussianInt) - ⟨0, (P.q₁ : Int)⟩ = ⟨r, s - a⟩ := by ext <;> simp [a] + rw [he] at hd + have hv := parentValue P₂ r (s - a) + (by rw [hq₂]; change 0 ≤ r ∧ r ≤ b ∧ 0 ≤ s - a ∧ s - a ≤ b; omega) + (by simpa [hq₂, b] using hedge) + rw [hp₂, hq₂] at hv + rw [hv] at hd + exact hd + +private theorem near0 : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (GaussianInt) → ( + let a : Int := P.q₁ + let A := P.p₁ + let cdiv (n d : Int) := -((-n) / d) + (0 < a) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → ((FordFareyParameter) → ((∀ (r : + Int), ∀ (s : Int), (0 ≤ r ∧ r ≤ a ∧ 0 ≤ s ∧ s ≤ a) → ((r ≤ 1 ∨ a - 1 ≤ r ∨ s ≤ 1 ∨ a - 1 + ≤ s) → (g ⟨r, s⟩ = cdiv (A * r * s) a))) → ((∀ (d : Int), ∀ (n : Int), ∀ (k : Int), (d ≠ + 0) → (cdiv (k * d - n) d = k - n / d)) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t ≤ a → g ⟨a - (1 : + ℤ), t⟩ = A * t - A * t / a ∧ g ⟨t, a - (1 : ℤ)⟩ = A * t - A * t / a)))))) := by + classical + intro P g x a A cdiv ha0 P₁ hq₁ P₂ v0 cminus t ht ht' + have hl := v0 (a - 1) t (by omega) (by omega) + have hv := v0 t (a - 1) (by omega) (by omega) + rw [show A * (a - 1) * t = (A * t) * a - A * t by ring, + cminus _ _ _ (ne_of_gt ha0)] at hl + rw [show A * t * (a - 1) = (A * t) * a - A * t by ring, + cminus _ _ _ (ne_of_gt ha0)] at hv + exact ⟨hl, hv⟩ + +private theorem edge2 : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + ((P.q₁ : Int) < P.q) → ((GaussianInt) → ( + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + let cdiv (n d : Int) := -((-n) / d) + ((P.q : Int) = a + b) → ((A * b - B * a = 1) → ((0 < b) → (∀ (P₁ : FordFareyParameter), (P₁.q + = P.q₁) → (∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) → ((∀ (r : Int), ∀ (s : Int), (a ≤ + r ∧ r ≤ P.q ∧ 0 ≤ s ∧ s ≤ b) → ((r - a ≤ 1 ∨ b - 1 ≤ r - a ∨ s ≤ 1 ∨ b - 1 ≤ s) → (g ⟨r, + s⟩ = cdiv (B * (r - a) * s) b + A * s))) → ((∀ (r : Int), ∀ (s : Int), (0 ≤ r ∧ r ≤ b ∧ a + ≤ s ∧ s ≤ P.q) → ((r ≤ 1 ∨ b - 1 ≤ r ∨ s - a ≤ 1 ∨ b - 1 ≤ s - a) → (g ⟨r, s⟩ = cdiv (B * + r * (s - a)) b + A * r))) → ((∀ (d : Int), ∀ (k : Int), (d ≠ 0) → (cdiv (k * d) d = k)) → + (∀ (r : ℤ), a ≤ r → r ≤ (↑P.q : ℤ) → g ⟨r, b⟩ = B * r + (1 : ℤ) ∧ g ⟨b, r⟩ = B * r + (1 : + ℤ))))))))))) := by + classical + intro P g ha x a b A B cdiv hsum hdet hb P₁ hq₁ P₂ hq₂ v2 v3 cmul r ht ht' + have hl := v2 r b (by omega) (by omega) + have hv := v3 b r (by omega) (by omega) + rw [cmul _ _ (ne_of_gt hb)] at hl + rw [show B * b * (r - a) = (B * (r - a)) * b by ring, + cmul _ _ (ne_of_gt hb)] at hv + constructor + · nlinarith only [hl, hdet] + · nlinarith only [hv, hdet] + +private theorem lowFormula : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (∀ (r : Int), ∀ (s : Int), FourNeighborLaplacian g ⟨r, s⟩ = g ⟨r + 1, s⟩ + g ⟨r - 1, s⟩ + g + ⟨r, s + 1⟩ + g ⟨r, s - 1⟩ - 4 * g ⟨r, s⟩) → ((GaussianInt) → ( + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + let cdiv (n d : Int) := -((-n) / d) + ∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → ((FordFareyParameter) → ((∀ (t : Int), (0 ≤ t) → + ((t ≤ a) → (g ⟨a, t⟩ = A * t ∧ g ⟨t, a⟩ = A * t))) → ((∀ (t : Int), (0 ≤ t) → ((t ≤ a) → + (g ⟨a - 1, t⟩ = A * t - A * t / a ∧ g ⟨t, a - 1⟩ = A * t - A * t / a))) → ((∀ (t : Int), + (0 ≤ t) → ((t ≤ b) → (g ⟨a + 1, t⟩ = cdiv (B * t) b + A * t ∧ g ⟨t, a + 1⟩ = cdiv (B + * t) + b + A * t))) → (∀ (t : ℤ), (0 : ℤ) < t → t < a → t ≤ b → FourNeighborLaplacian g ⟨a, t⟩ = + cdiv (B * t) b - A * t / a ∧ FourNeighborLaplacian g ⟨t, a⟩ = cdiv (B * t) b - A * t / + a))))))) := by + classical + intro P g lapCoord x a b A B cdiv P₁ hq₁ P₂ edge0 near0 outward t ht hta htb + have hc := edge0 t (by omega) (by omega) + have hm := edge0 (t - 1) (by omega) (by omega) + have hp' := edge0 (t + 1) (by omega) (by omega) + have hl := near0 t (by omega) (by omega) + have ho := outward t (by omega) htb + constructor + · rw [lapCoord, ho.1, hl.1, hp'.1, hm.1, hc.1] + ring + · rw [lapCoord, hp'.2, hm.2, ho.2, hl.2, hc.2] + ring + +private theorem highFormula : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (∀ (r : Int), ∀ (s : Int), FourNeighborLaplacian g ⟨r, s⟩ = g ⟨r + 1, s⟩ + g ⟨r - 1, s⟩ + g + ⟨r, s + 1⟩ + g ⟨r, s - 1⟩ - 4 * g ⟨r, s⟩) → ((GaussianInt) → ( + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + let cdiv (n d : Int) := -((-n) / d) + ((P.q : Int) = a + b) → ((A * b - B * a = 1) → ((0 < b) → ((0 < a) → (∀ (P₁ : + FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) → ((∀ (d + : Int), ∀ (n : Int), ∀ (k : Int), (d ≠ 0) → (cdiv (k * d - n) d = k - n / d)) → ((∀ (d : + Int), ∀ (n : Int), ∀ (k : Int), (d ≠ 0) → (cdiv (k * d + n) d = k + cdiv n d)) → ((∀ (r : + Int), (a ≤ r) → ((r ≤ P.q) → (g ⟨r, b⟩ = B * r + 1 ∧ g ⟨b, r⟩ = B * r + 1))) → ((∀ (r : + Int), (b ≤ r) → ((r ≤ P.q) → (g ⟨r, b + 1⟩ = cdiv (A * (r - b)) a + B * r + B + 1 ∧ g ⟨b + + 1, r⟩ = cdiv (A * (r - b)) a + B * r + B + 1))) → ((∀ (r : Int), (a ≤ r) → ((r ≤ P.q) → + (g ⟨r, b - 1⟩ = cdiv (B * (r - a) * (b - 1)) b + A * (b - 1) ∧ g ⟨b - 1, r⟩ = cdiv (B * + (r - a) * (b - 1)) b + A * (b - 1)))) → (∀ (t : ℤ), (0 : ℤ) < t → t ≤ a → t < b → + FourNeighborLaplacian g ⟨(↑P.q : ℤ) - t, b⟩ = cdiv (B * t) b - A * t / a ∧ + FourNeighborLaplacian g ⟨b, (↑P.q : ℤ) - t⟩ = cdiv (B * t) b - A * t / a))))))))))))) := by + classical + intro P g lapCoord x a b A B cdiv hsum hdet hb ha0 P₁ hq₁ P₂ hq₂ cminus cplus edge2 near1 near2 + t ht hta htb + have hc := edge2 ((P.q : Int) - t) (by omega) (by omega) + have hm := edge2 ((P.q : Int) - t - 1) (by omega) (by omega) + have hp' := edge2 ((P.q : Int) - t + 1) (by omega) (by omega) + have hl := near2 ((P.q : Int) - t) (by omega) (by omega) + have ho := near1 ((P.q : Int) - t) (by omega) (by omega) + rw [show A * ((P.q : Int) - t - b) = A * a - A * t by rw [hsum]; ring, + cminus _ _ _ (ne_of_gt ha0)] at ho + rw [show B * ((P.q : Int) - t - a) * (b - 1) = + (B * (b - t) - B) * b + B * t by rw [hsum]; ring, + cplus _ _ _ (ne_of_gt hb)] at hl + constructor + · rw [lapCoord, hp'.1, hm.1, ho.1, hl.1, hc.1] + rw [hsum] + nlinarith only [hdet] + · rw [lapCoord, ho.2, hl.2, hp'.2, hm.2, hc.2] + rw [hsum] + nlinarith only [hdet] + +private theorem roundArm : + ∀ (P : FordFareyParameter), + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + let cdiv (n d : Int) := -((-n) / d) + (A * b - B * a = 1) → ((0 < b) → ((0 < a) → (∀ (t : ℤ), (0 : ℤ) < t → t < a → t < b → cdiv (B + * t) b - A * t / a = (1 : ℤ)))) := by + classical + intro P a b A B cdiv hdet hb ha0 t ht hta htb + have hn : ¬ a ∣ A * t := by + rintro ⟨k, hk⟩ + have hdt := congrArg (fun z : Int => z * t) hdet + have hk' := congrArg (fun z : Int => z * b) hk + have hdiv : a ∣ t := by + refine ⟨b * k - B * t, ?_⟩ + nlinarith only [hk', hdt] + have := Int.le_of_dvd ht hdiv + omega + let k := A * t / a + have hm := Int.emod_nonneg (A * t) (ne_of_gt ha0) + have hml := Int.emod_lt_of_pos (A * t) ha0 + have hmn : A * t % a ≠ 0 := fun h => hn (Int.dvd_of_emod_eq_zero h) + have hmp : 1 ≤ A * t % a := by omega + have hmu : A * t % a ≤ a - 1 := by omega + have he := Int.emod_add_mul_ediv (A * t) a + have hl : k * a + 1 ≤ A * t := by dsimp [k]; nlinarith only [he, hmp] + have hu : A * t ≤ (k + 1) * a - 1 := by dsimp [k]; nlinarith only [he, hmu] + have hdt := congrArg (fun z : Int => z * t) hdet + have hlb := mul_le_mul_of_nonneg_right hl hb.le + have hub := mul_le_mul_of_nonneg_right hu hb.le + have hbl : k * b < B * t := by + by_contra h + have hc := mul_le_mul_of_nonneg_right (show B * t ≤ k * b by omega) ha0.le + nlinarith only [hc, hlb, hdt, htb] + have hbu : B * t < (k + 1) * b := by + by_contra h + have hc := mul_le_mul_of_nonneg_right (show (k + 1) * b ≤ B * t by omega) ha0.le + nlinarith only [hc, hub, hdt, hb, ht] + have hq' : (- (B * t)) / b = -k - 1 := by + apply (Int.ediv_eq_iff_of_pos hb).mpr + constructor <;> nlinarith only [hbl, hbu] + dsimp [cdiv] + rw [hq'] + dsimp [k] + ring + +private theorem rectBoundary : + ∀ (l : ℤ), ∀ (r : ℤ), ∀ (d : ℤ), ∀ (u : ℤ), ∀ (z : GaussianInt), z ∈ LatticeVertexBoundary {w + : GaussianInt | l ≤ w.re ∧ w.re ≤ r ∧ d ≤ w.im ∧ w.im ≤ u} ↔ (l ≤ z.re ∧ z.re ≤ r ∧ d ≤ + z.im ∧ z.im ≤ u) ∧ (z.re = l ∨ z.re = r ∨ z.im = d ∨ z.im = u) := by + classical + intro l r d u z + constructor + · rintro ⟨hz, y, hy, hyr, hyi⟩ + refine ⟨hz, ?_⟩ + change l ≤ z.re ∧ z.re ≤ r ∧ d ≤ z.im ∧ z.im ≤ u at hz + change ¬(l ≤ y.re ∧ y.re ≤ r ∧ d ≤ y.im ∧ y.im ≤ u) at hy + omega + · rintro ⟨hz, he⟩ + refine ⟨hz, ?_⟩ + rcases he with he | he | he | he + · refine ⟨⟨z.re - 1, z.im⟩, ?_, ?_, ?_⟩ <;> + simp only [Set.mem_ofPred_eq] <;> omega + · refine ⟨⟨z.re + 1, z.im⟩, ?_, ?_, ?_⟩ <;> + simp only [Set.mem_ofPred_eq] <;> omega + · refine ⟨⟨z.re, z.im - 1⟩, ?_, ?_, ?_⟩ <;> + simp only [Set.mem_ofPred_eq] <;> omega + · refine ⟨⟨z.re, z.im + 1⟩, ?_, ?_, ?_⟩ <;> + simp only [Set.mem_ofPred_eq] <;> omega + +private theorem count : + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), + let a : Int := P.q₁ + let b : Int := P.q₂ + (FordFareyParameter) → ((FordFareyParameter) → ((x ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 0) ↔ x.re ≤ a ∧ x.im ≤ a ∧ (x.re = a ∨ x.im = a)) → ((x ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 1) ↔ b ≤ x.re ∧ b ≤ x.im ∧ (x.re = b + ∨ x.im = b)) → ((x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) ↔ a ≤ x.re ∧ + x.im ≤ b ∧ (x.re = a ∨ x.im = b)) → ((x ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 3) ↔ x.re ≤ b ∧ a ≤ x.im ∧ (x.re = b ∨ x.im = a)) → + (FordBoundaryMultiplicity P x = (if x.re ≤ a ∧ x.im ≤ a ∧ (x.re = a ∨ x.im = a) then 1 + else 0) + (if b ≤ x.re ∧ b ≤ x.im ∧ (x.re = b ∨ x.im = b) then 1 else 0) + (if a ≤ x.re ∧ + x.im ≤ b ∧ (x.re = a ∨ x.im = b) then 1 else 0) + (if x.re ≤ b ∧ a ≤ x.im ∧ (x.re = b ∨ + x.im = a) then 1 else 0))))))) := by + classical + intro P x a b P₁ P₂ b0 b1 b2 b3 + simp only [FordBoundaryMultiplicity, Finset.card_filter, + Fin.sum_univ_succ, Fin.sum_univ_zero, add_zero] + change (if x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) then 1 else 0) + + ((if x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) then 1 else 0) + + ((if x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) then 1 else 0) + + (if x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) then 1 else 0))) = _ + simp only [b0, b1, b2, b3] + omega + +end FordLaplacianProof + +namespace FordLaplacianDetails + +private theorem periodUp : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (∀ (x : GaussianInt), FourNeighborLaplacian g (x + ⟨(0 : ℤ), -(↑P.q : ℤ)⟩) = + FourNeighborLaplacian g x) → (∀ (x : GaussianInt), FourNeighborLaplacian g (x + ⟨(0 : ℤ), + (↑P.q : ℤ)⟩) = FourNeighborLaplacian g x) := by + classical + intro P g periodNeg x + have h := periodNeg (x + ⟨0, (P.q : Int)⟩) + have he : x + ⟨0, (P.q : Int)⟩ + ⟨0, -(P.q : Int)⟩ = x := by + ext <;> simp + rw [he] at h + exact h.symm + +private theorem ceilShift : + ∀ (P : FordFareyParameter), ((P.q : Int) ≠ 0) → (∀ (n : ℤ), ∀ (k : ℤ), -(-(k * (↑P.q : ℤ) - + n) / (↑P.q : ℤ)) = k - n / (↑P.q : ℤ)) := by + classical + intro P hqne n k + rw [show -(k * (P.q : Int) - n) = n + (-k) * (P.q : Int) by ring, + Int.add_mul_ediv_right _ _ hqne] + ring + +private theorem axes : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (0 < (P.q : Int)) → ((∀ (r : Int), ∀ (s : Int), (0 ≤ r) → ((r ≤ P.q) → ((0 ≤ s) → ((s ≤ P.q) + → ((r ≤ 1 ∨ (P.q : Int) - 1 ≤ r ∨ s ≤ 1 ∨ (P.q : Int) - 1 ≤ s) → (g ⟨r, s⟩ = -((-(P.p * r + * s)) / (P.q : Int)))))))) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t ≤ (↑P.q : ℤ) → g ⟨t, (0 : ℤ)⟩ = + (0 : ℤ) ∧ g ⟨(0 : ℤ), t⟩ = (0 : ℤ) ∧ g ⟨t, (1 : ℤ)⟩ = -(-(P.p * t) / (↑P.q : ℤ)) ∧ g ⟨(1 + : ℤ), t⟩ = -(-(P.p * t) / (↑P.q : ℤ)))) := by + classical + intro P g hq boundaryValue t ht ht' + have h0 := boundaryValue t 0 ht ht' (by omega) (by omega) (by omega) + have h1 := boundaryValue 0 t (by omega) (by omega) ht ht' (by omega) + have h2 := boundaryValue t 1 ht ht' (by omega) (by omega) (by omega) + have h3 := boundaryValue 1 t (by omega) (by omega) ht ht' (by omega) + simpa using And.intro h0 (And.intro h1 (And.intro h2 h3)) + +private theorem lapCoord : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + ∀ (r : ℤ), ∀ (s : ℤ), FourNeighborLaplacian g ⟨r, s⟩ = g ⟨r + (1 : ℤ), s⟩ + g ⟨r - (1 : ℤ), + s⟩ + g ⟨r, s + (1 : ℤ)⟩ + g ⟨r, s - (1 : ℤ)⟩ - (4 : ℤ) * g ⟨r, s⟩ := by + classical + intro P g r s + unfold FourNeighborLaplacian + rw [show (⟨r, s⟩ : GaussianInt) + 1 = ⟨r + 1, s⟩ by ext <;> simp, + show (⟨r, s⟩ : GaussianInt) - 1 = ⟨r - 1, s⟩ by ext <;> simp, + show (⟨r, s⟩ : GaussianInt) + ⟨0, 1⟩ = ⟨r, s + 1⟩ by ext <;> simp, + show (⟨r, s⟩ : GaussianInt) - ⟨0, 1⟩ = ⟨r, s - 1⟩ by ext <;> simp] + +private theorem bottomClosed : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (0 < (P.q : Int)) → ((∀ (t : Int), (0 ≤ t) → ((t < P.q) → (FourNeighborLaplacian g ⟨t, 0⟩ = + 1))) → ((∀ (t : Int), (0 ≤ t) → ((t ≤ P.q) → (FourNeighborLaplacian g ⟨(P.q : Int), t⟩ = + 1))) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t ≤ (↑P.q : ℤ) → FourNeighborLaplacian g ⟨t, (0 : ℤ)⟩ = + (1 : ℤ)))) := by + classical + intro P g hq bottomLap rightLap t ht ht' + by_cases he : t = P.q + · rw [he] + exact rightLap 0 (by omega) (by omega) + · exact bottomLap t ht (by omega) + +private theorem hedge : + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x ∈ LatticeVertexBoundary (FordVertexDomain + P.q)) → (((0 : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q : ℤ)) → + (x.re = 0 ∨ x.re = P.q ∨ x.im = 0 ∨ x.im = P.q)) := by + classical + intro P x hx hxrect + obtain ⟨_, y, hy, hyr, hyi⟩ := hx + change ¬(0 ≤ y.re ∧ y.re ≤ P.q ∧ 0 ≤ y.im ∧ y.im ≤ P.q) at hy + omega + +private theorem hsumAt824 : + ∀ (P : FordFareyParameter), + let a : Int := P.q₁ + let b : Int := P.q₂ + (P.q : Int) = a + b := by + classical + intro P a b + dsimp [a, b] + exact_mod_cast P.sum_q + +private theorem hdetAt828 : + ∀ (P : FordFareyParameter), + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + ((P.q : Int) = a + b) → ((P.p = A + B) → (A * b - B * a = 1)) := by + classical + intro P a b A B hsum hp + have hd := P.det₁ + change A * (P.q : Int) - a * P.p = 1 at hd + rw [hsum, hp] at hd + nlinarith only [hd] + +private theorem hcop : + ∀ (P : FordFareyParameter), + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + (A * b - B * a = 1) → (Nat.Coprime P.q₁ A.natAbs ∧ Nat.Coprime P.q₂ B.natAbs) := by + classical + intro P a b A B hdet + have h1 : IsCoprime (P.q₁ : Int) A := ⟨-B, b, by dsimp [a] at hdet; nlinarith only [hdet]⟩ + have h2 : IsCoprime (P.q₂ : Int) B := ⟨A, -a, by dsimp [b] at hdet; nlinarith only [hdet]⟩ + exact ⟨by simpa using Int.isCoprime_iff_nat_coprime.mp h1, + by simpa using Int.isCoprime_iff_nat_coprime.mp h2⟩ + +private theorem v0 : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + let a : Int := P.q₁ + let A := P.p₁ + let cdiv (n d : Int) := -((-n) / d) + ∀ (P₁ : FordFareyParameter), (P₁.p = A) → ((P₁.q = P.q₁) → ((∀ x ∈ FordRecursiveVertexDomains + P (0 : Fin (4 : ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = + Classical.choose FordOdometerFamilyExistsUnique P₁ x) → ((∀ (R : FordFareyParameter), ∀ + (r : Int), ∀ (s : Int), (0 ≤ r ∧ r ≤ R.q ∧ 0 ≤ s ∧ s ≤ R.q) → ((r ≤ 1 ∨ (R.q : Int) - 1 ≤ + r ∨ s ≤ 1 ∨ (R.q : Int) - 1 ≤ s) → (Classical.choose FordOdometerFamilyExistsUnique R ⟨r, + s⟩ = cdiv (R.p * r * s) R.q))) → (∀ (r : ℤ), ∀ (s : ℤ), (0 : ℤ) ≤ r ∧ r ≤ a ∧ (0 : ℤ) ≤ s + ∧ s ≤ a → r ≤ (1 : ℤ) ∨ a - (1 : ℤ) ≤ r ∨ s ≤ (1 : ℤ) ∨ a - (1 : ℤ) ≤ s → g ⟨r, s⟩ = cdiv + (A * r * s) a)))) := by + classical + intro P g a A cdiv P₁ hp₁ hq₁ rec0 parentValue r s hrect hedge + have hd := rec0 ⟨r, s⟩ (by change 0 ≤ r ∧ r ≤ a ∧ 0 ≤ s ∧ s ≤ a; exact hrect) + have hv := parentValue P₁ r s (by simpa [hq₁, a] using hrect) + (by simpa [hq₁, a] using hedge) + rw [hp₁, hq₁] at hv + exact hd.trans hv + +private theorem cminus : + let cdiv (n d : Int) := -((-n) / d) + ∀ (d : ℤ), ∀ (n : ℤ), ∀ (k : ℤ), d ≠ (0 : ℤ) → cdiv (k * d - n) d = k - n / d := by + classical + intro cdiv d n k hd + dsimp [cdiv] + rw [show -(k * d - n) = n + (-k) * d by ring, Int.add_mul_ediv_right _ _ hd] + ring + +private theorem cplus : + let cdiv (n d : Int) := -((-n) / d) + ∀ (d : ℤ), ∀ (n : ℤ), ∀ (k : ℤ), d ≠ (0 : ℤ) → cdiv (k * d + n) d = k + cdiv n d := by + classical + intro cdiv d n k hd + dsimp [cdiv] + rw [show -(k * d + n) = -n + (-k) * d by ring, Int.add_mul_ediv_right _ _ hd] + ring + +private theorem edge0 : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (GaussianInt) → ( + let a : Int := P.q₁ + let A := P.p₁ + let cdiv (n d : Int) := -((-n) / d) + (0 < a) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → ((FordFareyParameter) → ((∀ (r : + Int), ∀ (s : Int), (0 ≤ r ∧ r ≤ a ∧ 0 ≤ s ∧ s ≤ a) → ((r ≤ 1 ∨ a - 1 ≤ r ∨ s ≤ 1 ∨ a - 1 + ≤ s) → (g ⟨r, s⟩ = cdiv (A * r * s) a))) → ((∀ (d : Int), ∀ (k : Int), (d ≠ 0) → (cdiv (k + * d) d = k)) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t ≤ a → g ⟨a, t⟩ = A * t ∧ g ⟨t, a⟩ = A * + t)))))) := by + classical + intro P g x a A cdiv ha0 P₁ hq₁ P₂ v0 cmul t ht ht' + have hl := v0 a t (by omega) (by omega) + have hv := v0 t a (by omega) (by omega) + rw [show A * a * t = (A * t) * a by ring, cmul _ _ (ne_of_gt ha0)] at hl + rw [cmul _ _ (ne_of_gt ha0)] at hv + exact ⟨hl, hv⟩ + +private theorem outward : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + ((P.q₁ : Int) < P.q) → ((GaussianInt) → ( + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + let cdiv (n d : Int) := -((-n) / d) + ((P.q : Int) = a + b) → ((FordFareyParameter) → (∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) → + ((∀ (r : Int), ∀ (s : Int), (a ≤ r ∧ r ≤ P.q ∧ 0 ≤ s ∧ s ≤ b) → ((r - a ≤ 1 ∨ b - 1 ≤ r - + a ∨ s ≤ 1 ∨ b - 1 ≤ s) → (g ⟨r, s⟩ = cdiv (B * (r - a) * s) b + A * s))) → ((∀ (r : Int), + ∀ (s : Int), (0 ≤ r ∧ r ≤ b ∧ a ≤ s ∧ s ≤ P.q) → ((r ≤ 1 ∨ b - 1 ≤ r ∨ s - a ≤ 1 ∨ b - 1 + ≤ s - a) → (g ⟨r, s⟩ = cdiv (B * r * (s - a)) b + A * r))) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t + ≤ b → g ⟨a + (1 : ℤ), t⟩ = cdiv (B * t) b + A * t ∧ g ⟨t, a + (1 : ℤ)⟩ = cdiv (B * t) b + + A * t))))))) := by + classical + intro P g ha x a b A B cdiv hsum P₁ P₂ hq₂ v2 v3 t ht ht' + have hl := v2 (a + 1) t (by omega) (by omega) + have hv := v3 t (a + 1) (by omega) (by omega) + simpa only [add_sub_cancel_left, mul_one] using And.intro hl hv + +private theorem near1 : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + (GaussianInt) → ( + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + let cdiv (n d : Int) := -((-n) / d) + ((P.q : Int) = a + b) → ((0 < a) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : + FordFareyParameter), (P₂.q = P.q₂) → ((∀ (r : Int), ∀ (s : Int), (b ≤ r ∧ r ≤ P.q ∧ b ≤ s + ∧ s ≤ P.q) → ((r - b ≤ 1 ∨ a - 1 ≤ r - b ∨ s - b ≤ 1 ∨ a - 1 ≤ s - b) → (g ⟨r, s⟩ = cdiv + (A * (r - b) * (s - b)) a + B * r + B * s - B * b + 1))) → (∀ (r : ℤ), b ≤ r → r ≤ (↑P.q + : ℤ) → g ⟨r, b + (1 : ℤ)⟩ = cdiv (A * (r - b)) a + B * r + B + (1 : ℤ) ∧ g ⟨b + (1 : ℤ), + r⟩ = cdiv (A * (r - b)) a + B * r + B + (1 : ℤ))))))) := by + classical + intro P g x a b A B cdiv hsum ha0 P₁ hq₁ P₂ hq₂ v1 r ht ht' + have hl := v1 r (b + 1) (by omega) (by omega) + have hv := v1 (b + 1) r (by omega) (by omega) + simp only [add_sub_cancel_left, mul_one] at hl hv + constructor + · nlinarith only [hl] + · nlinarith only [hv] + +private theorem near2 : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + ((P.q₁ : Int) < P.q) → ((GaussianInt) → ( + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + let cdiv (n d : Int) := -((-n) / d) + ((P.q : Int) = a + b) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : + FordFareyParameter), (P₂.q = P.q₂) → ((∀ (r : Int), ∀ (s : Int), (a ≤ r ∧ r ≤ P.q ∧ 0 ≤ s + ∧ s ≤ b) → ((r - a ≤ 1 ∨ b - 1 ≤ r - a ∨ s ≤ 1 ∨ b - 1 ≤ s) → (g ⟨r, s⟩ = cdiv (B * (r - + a) * s) b + A * s))) → ((∀ (r : Int), ∀ (s : Int), (0 ≤ r ∧ r ≤ b ∧ a ≤ s ∧ s ≤ P.q) → + ((r ≤ 1 ∨ b - 1 ≤ r ∨ s - a ≤ 1 ∨ b - 1 ≤ s - a) → (g ⟨r, s⟩ = cdiv (B * r * (s - a)) b + + A * r))) → (∀ (r : ℤ), a ≤ r → r ≤ (↑P.q : ℤ) → g ⟨r, b - (1 : ℤ)⟩ = cdiv (B * (r - a) * + (b - (1 : ℤ))) b + A * (b - (1 : ℤ)) ∧ g ⟨b - (1 : ℤ), r⟩ = cdiv (B * (r - a) * (b - (1 : + ℤ))) b + A * (b - (1 : ℤ))))))))) := by + classical + intro P g ha x a b A B cdiv hsum P₁ hq₁ P₂ hq₂ v2 v3 r ht ht' + have hl := v2 r (b - 1) (by omega) (by omega) + have hv := v3 (b - 1) r (by omega) (by omega) + rw [show B * (b - 1) * (r - a) = B * (r - a) * (b - 1) by ring] at hv + exact ⟨hl, hv⟩ + +private theorem b0 : + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), ((1 : ℤ) ≤ x.re) → (((1 : ℤ) ≤ x.im) → ( + let a : Int := P.q₁ + (0 < a) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → ((FordFareyParameter) → ((∀ (l : + Int), ∀ (r : Int), ∀ (d : Int), ∀ (u : Int), ∀ (z : GaussianInt), z ∈ + LatticeVertexBoundary {w : GaussianInt | l ≤ w.re ∧ w.re ≤ r ∧ d ≤ w.im ∧ w.im ≤ u} ↔ (l + ≤ z.re ∧ z.re ≤ r ∧ d ≤ z.im ∧ z.im ≤ u) ∧ (z.re = l ∨ z.re = r ∨ z.im = d ∨ z.im = u)) → + (x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) ↔ x.re ≤ a ∧ x.im ≤ a ∧ (x.re + = a ∨ x.im = a))))))) := by + classical + intro P x hr hs a ha0 P₁ hq₁ P₂ rectBoundary + change x ∈ LatticeVertexBoundary {z : GaussianInt | + 0 ≤ z.re ∧ z.re ≤ a ∧ 0 ≤ z.im ∧ z.im ≤ a} ↔ _ + rw [rectBoundary] + omega + +private theorem b1 : + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.re ≤ (↑P.q : ℤ) - (1 : ℤ)) → ((x.im ≤ + (↑P.q : ℤ) - (1 : ℤ)) → ( + let a : Int := P.q₁ + let b : Int := P.q₂ + ((P.q : Int) = a + b) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : + FordFareyParameter), (P₂.q = P.q₂) → ((∀ (l : Int), ∀ (r : Int), ∀ (d : Int), ∀ (u : + Int), ∀ (z : GaussianInt), z ∈ LatticeVertexBoundary {w : GaussianInt | l ≤ w.re ∧ w.re ≤ + r ∧ d ≤ w.im ∧ w.im ≤ u} ↔ (l ≤ z.re ∧ z.re ≤ r ∧ d ≤ z.im ∧ z.im ≤ u) ∧ (z.re = l ∨ z.re + = r ∨ z.im = d ∨ z.im = u)) → (x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) + ↔ b ≤ x.re ∧ b ≤ x.im ∧ (x.re = b ∨ x.im = b))))))) := by + classical + intro P x hr' hs' a b hsum P₁ hq₁ P₂ hq₂ rectBoundary + change x ∈ LatticeVertexBoundary {z : GaussianInt | + b ≤ z.re ∧ z.re ≤ P.q ∧ b ≤ z.im ∧ z.im ≤ P.q} ↔ _ + rw [rectBoundary] + omega + +private theorem b2 : + ∀ (P : FordFareyParameter), ((P.q₁ : Int) < P.q) → (∀ (x : GaussianInt), (x.re ≤ (↑P.q : ℤ) - + (1 : ℤ)) → (((1 : ℤ) ≤ x.im) → ( + let a : Int := P.q₁ + let b : Int := P.q₂ + ((P.q : Int) = a + b) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : + FordFareyParameter), (P₂.q = P.q₂) → ((∀ (l : Int), ∀ (r : Int), ∀ (d : Int), ∀ (u : + Int), ∀ (z : GaussianInt), z ∈ LatticeVertexBoundary {w : GaussianInt | l ≤ w.re ∧ w.re ≤ + r ∧ d ≤ w.im ∧ w.im ≤ u} ↔ (l ≤ z.re ∧ z.re ≤ r ∧ d ≤ z.im ∧ z.im ≤ u) ∧ (z.re = l ∨ z.re + = r ∨ z.im = d ∨ z.im = u)) → (x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) + ↔ a ≤ x.re ∧ x.im ≤ b ∧ (x.re = a ∨ x.im = b)))))))) := by + classical + intro P ha x hr' hs a b hsum P₁ hq₁ P₂ hq₂ rectBoundary + change x ∈ LatticeVertexBoundary {z : GaussianInt | + a ≤ z.re ∧ z.re ≤ P.q ∧ 0 ≤ z.im ∧ z.im ≤ b} ↔ _ + rw [rectBoundary] + omega + +private theorem b3 : + ∀ (P : FordFareyParameter), ((P.q₁ : Int) < P.q) → (∀ (x : GaussianInt), ((1 : ℤ) ≤ x.re) → + ((x.im ≤ (↑P.q : ℤ) - (1 : ℤ)) → ( + let a : Int := P.q₁ + let b : Int := P.q₂ + ((P.q : Int) = a + b) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : + FordFareyParameter), (P₂.q = P.q₂) → ((∀ (l : Int), ∀ (r : Int), ∀ (d : Int), ∀ (u : + Int), ∀ (z : GaussianInt), z ∈ LatticeVertexBoundary {w : GaussianInt | l ≤ w.re ∧ w.re ≤ + r ∧ d ≤ w.im ∧ w.im ≤ u} ↔ (l ≤ z.re ∧ z.re ≤ r ∧ d ≤ z.im ∧ z.im ≤ u) ∧ (z.re = l ∨ z.re + = r ∨ z.im = d ∨ z.im = u)) → (x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) + ↔ x.re ≤ b ∧ a ≤ x.im ∧ (x.re = b ∨ x.im = a)))))))) := by + classical + intro P ha x hr hs' a b hsum P₁ hq₁ P₂ hq₂ rectBoundary + change x ∈ LatticeVertexBoundary {z : GaussianInt | + 0 ≤ z.re ∧ z.re ≤ b ∧ a ≤ z.im ∧ z.im ≤ P.q} ↔ _ + rw [rectBoundary] + omega + +private theorem hcaseAt964 : + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), + let a : Int := P.q₁ + let b : Int := P.q₂ + (FordBoundaryMultiplicity P x = (if x.re ≤ a ∧ x.im ≤ a ∧ (x.re = a ∨ x.im = a) then 1 else + 0) + (if b ≤ x.re ∧ b ≤ x.im ∧ (x.re = b ∨ x.im = b) then 1 else 0) + (if a ≤ x.re ∧ x.im + ≤ b ∧ (x.re = a ∨ x.im = b) then 1 else 0) + (if x.re ≤ b ∧ a ≤ x.im ∧ (x.re = b ∨ x.im = + a) then 1 else 0)) → ((FordBoundaryMultiplicity P x = (2 : ℕ)) → ((x.re = a ∧ x.im < a ∧ + x.im < b) ∨ (x.im = a ∧ x.re < a ∧ x.re < b) ∨ (x.im = b ∧ a < x.re ∧ b < x.re) ∨ (x.re = + b ∧ a < x.im ∧ b < x.im))) := by + classical + intro P x a b count hn + split_ifs at count <;> omega + +private theorem hcaseAt988 : + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), + let a : Int := P.q₁ + let b : Int := P.q₂ + (FordBoundaryMultiplicity P x = (if x.re ≤ a ∧ x.im ≤ a ∧ (x.re = a ∨ x.im = a) then 1 else + 0) + (if b ≤ x.re ∧ b ≤ x.im ∧ (x.re = b ∨ x.im = b) then 1 else 0) + (if a ≤ x.re ∧ x.im + ≤ b ∧ (x.re = a ∨ x.im = b) then 1 else 0) + (if x.re ≤ b ∧ a ≤ x.im ∧ (x.re = b ∨ x.im = + a) then 1 else 0)) → ((FordBoundaryMultiplicity P x = (3 : ℕ)) → ((b < a ∧ ((x.re = a ∧ + x.im = b) ∨ (x.re = b ∧ x.im = a))) ∨ (a < b ∧ ((x.re = a ∧ x.im = a) ∨ (x.re = b ∧ x.im + = b))))) := by + classical + intro P x a b count hn + split_ifs at count <;> omega + +private theorem hfAt993 : + ∀ (P : FordFareyParameter), ((P.q₁ : Int) < P.q) → ((GaussianInt) → ( + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + ((P.q : Int) = a + b) → ((A * b - B * a = 1) → ((0 < a) → (∀ (P₁ : FordFareyParameter), (P₁.q + = P.q₁) → (∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) → ((b < a) → (A * b / a = B)))))))) + := by + classical + intro P ha x a b A B hsum hdet ha0 P₁ hq₁ P₂ hq₂ hab + rw [show A * b = 1 + B * a by nlinarith only [hdet], + Int.add_mul_ediv_right _ _ (ne_of_gt ha0)] + rw [Int.ediv_eq_zero_of_lt (by norm_num) (by omega)] + ring + +private theorem hcAt1006 : + ∀ (P : FordFareyParameter), ((P.q₁ : Int) < P.q) → (((1 : ℕ) < P.q) → ((GaussianInt) → ( + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + let cdiv (n d : Int) := -((-n) / d) + ((P.q : Int) = a + b) → ((A * b - B * a = 1) → ((0 < b) → (∀ (P₁ : FordFareyParameter), (P₁.q + = P.q₁) → (∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) → ((∀ (d : Int), ∀ (n : Int), ∀ (k + : Int), (d ≠ 0) → (cdiv (k * d - n) d = k - n / d)) → ((a < b) → (cdiv (B * a) b = + A)))))))))) := by + classical + intro P ha hbig x a b A B cdiv hsum hdet hb P₁ hq₁ P₂ hq₂ cminus hab + rw [show B * a = A * b - 1 by nlinarith only [hdet], cminus _ _ _ (ne_of_gt hb), + Int.ediv_eq_zero_of_lt (by norm_num) (by omega)] + ring + +private theorem hall : + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (FordBoundaryMultiplicity P x = (4 : ℕ)) → + (∀ i, x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P i)) := by + classical + intro P x hn + change (Finset.univ.filter fun i : Fin 4 => + x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P i)).card = 4 at hn + have hcard : (Finset.univ.filter fun i : Fin 4 => + x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P i)).card = + (Finset.univ : Finset (Fin 4)).card := by simpa using hn + exact fun i => Finset.card_filter_eq_iff.mp hcard i (Finset.mem_univ i) + +private theorem hdAt1050 : + ∀ (P : FordFareyParameter), ((P.q₁ : Int) = P.q₂) → (((P.q : Int) = P.q₁ + P.q₂) → ((P.p₁ * + (↑P.q : ℤ) - (↑P.q₁ : ℤ) * P.p = (1 : ℤ)) → ((P.p = P.p₁ + P.p₂) → ((P.q₁ : Int) ∣ 1)))) + := by + classical + intro P he hsum hdet hp + refine ⟨P.p₁ - P.p₂, ?_⟩ + rw [hsum, ← he, hp] at hdet + nlinarith only [hdet] + +private theorem hnum : + ∀ (P : FordFareyParameter), (P.p₁ * (↑P.q : ℤ) - (↑P.q₁ : ℤ) * P.p = (1 : ℤ)) → (((P.q₁ : + Int) = 1) → (((P.q : Int) = 2) → (P.p = P.p₁ * 2 - 1))) := by + classical + intro P hdet hqa hqq + rw [hqq, hqa] at hdet + norm_num at hdet + linarith only [hdet] + +private theorem hvR : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + ((P.q : Int) = 2) → ((g ⟨(2 : ℤ), (0 : ℤ)⟩ = (0 : ℤ) ∧ g ⟨(0 : ℤ), (2 : ℤ)⟩ = (0 : ℤ) ∧ g ⟨(2 + : ℤ), (1 : ℤ)⟩ = -(-(P.p * (2 : ℤ)) / (↑P.q : ℤ)) ∧ g ⟨(1 : ℤ), (2 : ℤ)⟩ = -(-(P.p * (2 : + ℤ)) / (↑P.q : ℤ))) → (g ⟨2, 1⟩ = P.p)) := by + classical + intro P g hqq hv + have hh := hv.2.2.1 + rw [hqq, show -(P.p * 2) = (-P.p) * 2 by ring, + Int.mul_ediv_cancel _ (by norm_num : (2 : Int) ≠ 0), neg_neg] at hh + exact hh + +private theorem hvU : + ∀ (P : FordFareyParameter), + let g := FordOdometer P + ((P.q : Int) = 2) → ((g ⟨(2 : ℤ), (0 : ℤ)⟩ = (0 : ℤ) ∧ g ⟨(0 : ℤ), (2 : ℤ)⟩ = (0 : ℤ) ∧ g ⟨(2 + : ℤ), (1 : ℤ)⟩ = -(-(P.p * (2 : ℤ)) / (↑P.q : ℤ)) ∧ g ⟨(1 : ℤ), (2 : ℤ)⟩ = -(-(P.p * (2 : + ℤ)) / (↑P.q : ℤ))) → (g ⟨1, 2⟩ = P.p)) := by + classical + intro P g hqq hv + have hh := hv.2.2.2 + rw [hqq, show -(P.p * 2) = (-P.p) * 2 by ring, + Int.mul_ediv_cancel _ (by norm_num : (2 : Int) ≠ 0), neg_neg] at hh + exact hh + +end FordLaplacianDetails + +namespace FordInteriorCase + +private theorem interiorLaplacian : + ∀ (P : FordFareyParameter), let g := FordOdometer P + (∀ (P : FordFareyParameter), ∀ x ∈ FordDoubledBoundary P.q, Classical.choose + FordOdometerFamilyExistsUnique P x = IntegerCeilDiv (P.p * x.re * x.im) (↑P.q : ℤ) (by + exact_mod_cast P.q_pos.ne')) → ((∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), + ∀ (P₂ : FordFareyParameter), (1 : ℕ) < P.q → P₁.p = P.p₁ → P₁.q = P.q₁ → P₂.p = P.p₂ → + P₂.q = P.q₂ → (∀ x ∈ FordRecursiveVertexDomains P (0 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique P₁ + x) ∧ (∀ x ∈ FordRecursiveVertexDomains P (1 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique P₁ + (x - ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (↑P.q₂ : ℤ) + (1 : + ℤ)) ∧ (∀ x ∈ FordRecursiveVertexDomains P (2 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique P₂ + (x - ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩) + P.p₁ * x.im) ∧ ∀ x ∈ FordRecursiveVertexDomains P (3 : Fin + (4 : ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = Classical.choose + FordOdometerFamilyExistsUnique P₂ (x - ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩) + P.p₁ * x.re) → (((P.q₁ : + Int) < P.q) → ((∀ (n : Int), ∀ (k : Int), -((-(k * (P.q : Int) - n)) / (P.q : Int)) = k - + n / (P.q : Int)) → ((∀ (r : Int), ∀ (s : Int), (0 ≤ r) → ((r ≤ P.q) → ((0 ≤ s) → ((s ≤ + P.q) → ((r ≤ 1 ∨ (P.q : Int) - 1 ≤ r ∨ s ≤ 1 ∨ (P.q : Int) - + 1 ≤ s) → (g ⟨r, s⟩ = -((-(P.p * r * s)) / (P.q : Int)))))))) → ((∀ (t : Int), (0 ≤ t) → + ((t ≤ P.q) → (g ⟨t, 0⟩ = 0 ∧ g ⟨0, t⟩ = 0 ∧ g ⟨t, 1⟩ = -((- (P.p * t)) / (P.q : Int)) + ∧ g ⟨1, t⟩ = -((- (P.p * t)) / (P.q : Int))))) → ((∀ (r : Int), ∀ (s : Int), + FourNeighborLaplacian g ⟨r, s⟩ = g ⟨r + 1, s⟩ + g ⟨r - 1, s⟩ + g ⟨r, s + 1⟩ + g ⟨r, s - + 1⟩ - 4 * g ⟨r, s⟩) → ((1 < P.q) → (∀ (x : GaussianInt), (1 ≤ x.re) → ((x.re + ≤ (P.q : Int) - 1) → ((1 ≤ x.im) → ((x.im ≤ (P.q : Int) - 1) → ( + let n := FordBoundaryMultiplicity P x; + (n = 2 → FourNeighborLaplacian g x = 1) ∧ + (n = 3 → FourNeighborLaplacian g x = 0) ∧ + (n = 4 → FourNeighborLaplacian g x = -2))))))))))))) := by + classical + intro P g hbdy hrec ha ceilShift boundaryValue axes lapCoord hbig x hr hr' hs hs' + dsimp + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + let cdiv (n d : Int) := -((-n) / d) + have hsum : (P.q : Int) = a + b := FordLaplacianDetails.hsumAt824 P + have hp : P.p = A + B := P.sum_p + have hdet : A * b - B * a = 1 := FordLaplacianDetails.hdetAt828 P hsum hp + have hb : 0 < b := by dsimp [b]; exact_mod_cast P.q₂_pos + have ha0 : 0 < a := FordLaplacianProof.ha0 P hbig x hsum + have hcop : Nat.Coprime P.q₁ A.natAbs ∧ Nat.Coprime P.q₂ B.natAbs := + FordLaplacianDetails.hcop P hdet + obtain ⟨P₁, ⟨hp₁, hq₁⟩, _⟩ := FordFareyParentsExist A P.q₁ (by omega) hcop.1 + obtain ⟨P₂, ⟨hp₂, hq₂⟩, _⟩ := FordFareyParentsExist B P.q₂ P.q₂_pos hcop.2 + obtain ⟨rec0, rec1, rec2, rec3⟩ := hrec P P₁ P₂ hbig hp₁ hq₁ hp₂ hq₂ + have parentValue (R : FordFareyParameter) (r s : Int) + (hrect : 0 ≤ r ∧ r ≤ R.q ∧ 0 ≤ s ∧ s ≤ R.q) + (hedge : r ≤ 1 ∨ (R.q : Int) - 1 ≤ r ∨ + s ≤ 1 ∨ (R.q : Int) - 1 ≤ s) : + Classical.choose FordOdometerFamilyExistsUnique R ⟨r, s⟩ = + cdiv (R.p * r * s) R.q := FordLaplacianProof.parentValue P hbdy x P₁ P₂ R r s hrect hedge + -- Use the literal restrictions on the four parent doubled boundaries. + have v0 (r s : Int) (hrect : 0 ≤ r ∧ r ≤ a ∧ 0 ≤ s ∧ s ≤ a) + (hedge : r ≤ 1 ∨ a - 1 ≤ r ∨ s ≤ 1 ∨ a - 1 ≤ s) : + g ⟨r, s⟩ = cdiv (A * r * s) a := FordLaplacianDetails.v0 P P₁ hp₁ hq₁ rec0 parentValue r + s hrect hedge + have v2 (r s : Int) (hrect : a ≤ r ∧ r ≤ P.q ∧ 0 ≤ s ∧ s ≤ b) + (hedge : r - a ≤ 1 ∨ b - 1 ≤ r - a ∨ s ≤ 1 ∨ b - 1 ≤ s) : + g ⟨r, s⟩ = cdiv (B * (r - a) * s) b + A * s := FordLaplacianProof.v2 P x hsum P₁ hq₁ P₂ + hp₂ hq₂ rec2 parentValue r s hrect hedge + have v3 (r s : Int) (hrect : 0 ≤ r ∧ r ≤ b ∧ a ≤ s ∧ s ≤ P.q) + (hedge : r ≤ 1 ∨ b - 1 ≤ r ∨ s - a ≤ 1 ∨ b - 1 ≤ s - a) : + g ⟨r, s⟩ = cdiv (B * r * (s - a)) b + A * r := FordLaplacianProof.v3 P x hsum P₁ hq₁ P₂ + hp₂ hq₂ rec3 parentValue r s hrect hedge + have cminus (d n k : Int) (hd : d ≠ 0) : cdiv (k * d - n) d = k - n / d := + FordLaplacianDetails.cminus d n k hd + have cmul (d k : Int) (hd : d ≠ 0) : cdiv (k * d) d = k := by + simpa using cminus d 0 k hd + have edge0 (t : Int) (ht : 0 ≤ t) (ht' : t ≤ a) : + g ⟨a, t⟩ = A * t ∧ g ⟨t, a⟩ = A * t := FordLaplacianDetails.edge0 P x ha0 P₁ hq₁ P₂ v0 + cmul t ht ht' + have near0 (t : Int) (ht : 0 ≤ t) (ht' : t ≤ a) : + g ⟨a - 1, t⟩ = A * t - A * t / a ∧ + g ⟨t, a - 1⟩ = A * t - A * t / a := FordLaplacianProof.near0 P x ha0 P₁ hq₁ P₂ v0 cminus + t ht ht' + have outward (t : Int) (ht : 0 ≤ t) (ht' : t ≤ b) : + g ⟨a + 1, t⟩ = cdiv (B * t) b + A * t ∧ + g ⟨t, a + 1⟩ = cdiv (B * t) b + A * t := FordLaplacianDetails.outward P ha x hsum P₁ P₂ + hq₂ v2 v3 t ht ht' + have lowFormula (t : Int) (ht : 0 < t) (hta : t < a) (htb : t ≤ b) : + FourNeighborLaplacian g ⟨a, t⟩ = cdiv (B * t) b - A * t / a ∧ + FourNeighborLaplacian g ⟨t, a⟩ = cdiv (B * t) b - A * t / a := + FordLaplacianProof.lowFormula P lapCoord x P₁ hq₁ P₂ edge0 near0 outward t ht hta htb + have highFormula (t : Int) (ht : 0 < t) (hta : t ≤ a) (htb : t < b) : + FourNeighborLaplacian g ⟨(P.q : Int) - t, b⟩ = cdiv (B * t) b - A * t / a ∧ + FourNeighborLaplacian g ⟨b, (P.q : Int) - t⟩ = cdiv (B * t) b - A * t / a := + FordLaplacianProof.highFormula P lapCoord x hsum hdet hb ha0 P₁ hq₁ P₂ hq₂ cminus + (FordLaplacianDetails.cplus) (FordLaplacianProof.edge2 P ha x hsum hdet hb P₁ hq₁ P₂ + hq₂ v2 v3 cmul) (FordLaplacianDetails.near1 P x hsum ha0 P₁ hq₁ P₂ hq₂ + (FordLaplacianProof.v1 P x hsum P₁ hp₁ hq₁ P₂ hq₂ rec1 parentValue)) + (FordLaplacianDetails.near2 P ha x hsum P₁ hq₁ P₂ hq₂ v2 v3) t ht hta htb + have roundArm (t : Int) (ht : 0 < t) (hta : t < a) (htb : t < b) : + cdiv (B * t) b - A * t / a = 1 := FordLaplacianProof.roundArm P hdet hb ha0 t ht hta htb + have rectBoundary (l r d u : Int) (z : GaussianInt) : + z ∈ LatticeVertexBoundary {w : GaussianInt | + l ≤ w.re ∧ w.re ≤ r ∧ d ≤ w.im ∧ w.im ≤ u} ↔ + (l ≤ z.re ∧ z.re ≤ r ∧ d ≤ z.im ∧ z.im ≤ u) ∧ + (z.re = l ∨ z.re = r ∨ z.im = d ∨ z.im = u) := FordLaplacianProof.rectBoundary l r d u z + have count : FordBoundaryMultiplicity P x = + (if x.re ≤ a ∧ x.im ≤ a ∧ (x.re = a ∨ x.im = a) then 1 else 0) + + (if b ≤ x.re ∧ b ≤ x.im ∧ (x.re = b ∨ x.im = b) then 1 else 0) + + (if a ≤ x.re ∧ x.im ≤ b ∧ (x.re = a ∨ x.im = b) then 1 else 0) + + (if x.re ≤ b ∧ a ≤ x.im ∧ (x.re = b ∨ x.im = a) then 1 else 0) := + FordLaplacianProof.count P x P₁ P₂ (FordLaplacianDetails.b0 P x hr hs ha0 P₁ hq₁ P₂ + rectBoundary) (FordLaplacianDetails.b1 P x hr' hs' hsum P₁ hq₁ P₂ hq₂ rectBoundary) + (FordLaplacianDetails.b2 P ha x hr' hs hsum P₁ hq₁ P₂ hq₂ rectBoundary) + (FordLaplacianDetails.b3 P ha x hr hs' hsum P₁ hq₁ P₂ hq₂ rectBoundary) + refine ⟨?_, ?_, ?_⟩ + · intro hn + have hcase : (x.re = a ∧ x.im < a ∧ x.im < b) ∨ + (x.im = a ∧ x.re < a ∧ x.re < b) ∨ + (x.im = b ∧ a < x.re ∧ b < x.re) ∨ + (x.re = b ∧ a < x.im ∧ b < x.im) := FordLaplacianDetails.hcaseAt964 P x count hn + rcases hcase with h | h | h | h + · have hx : x = ⟨a, x.im⟩ := by ext <;> simp [h.1] + rw [hx] + exact (lowFormula x.im (by omega) h.2.1 (by omega)).1.trans + (roundArm x.im (by omega) h.2.1 h.2.2) + · have hx : x = ⟨x.re, a⟩ := by ext <;> simp [h.1] + rw [hx] + exact (lowFormula x.re (by omega) h.2.1 (by omega)).2.trans + (roundArm x.re (by omega) h.2.1 h.2.2) + · have hx : x = ⟨(P.q : Int) - ((P.q : Int) - x.re), b⟩ := by ext <;> simp [h.1] + rw [hx] + exact (highFormula ((P.q : Int) - x.re) (by omega) (by omega) (by omega)).1.trans + (roundArm ((P.q : Int) - x.re) (by omega) (by omega) (by omega)) + · have hx : x = ⟨b, (P.q : Int) - ((P.q : Int) - x.im)⟩ := by ext <;> simp [h.1] + rw [hx] + exact (highFormula ((P.q : Int) - x.im) (by omega) (by omega) (by omega)).2.trans + (roundArm ((P.q : Int) - x.im) (by omega) (by omega) (by omega)) + · intro hn + have hcase : (b < a ∧ ((x.re = a ∧ x.im = b) ∨ (x.re = b ∧ x.im = a))) ∨ + (a < b ∧ ((x.re = a ∧ x.im = a) ∨ (x.re = b ∧ x.im = b))) := + FordLaplacianDetails.hcaseAt988 P x count hn + rcases hcase with ⟨hab, hcase⟩ | ⟨hab, hcase⟩ + · have hf : A * b / a = B := FordLaplacianDetails.hfAt993 P ha x hsum hdet ha0 P₁ hq₁ P₂ + hq₂ hab + have hc : cdiv (B * b) b = B := cmul b B (ne_of_gt hb) + rcases hcase with h | h + · have hx : x = ⟨a, b⟩ := by ext <;> simp [h.1, h.2] + rw [hx, (lowFormula b hb hab le_rfl).1, hc, hf] + ring + · have hx : x = ⟨b, a⟩ := by ext <;> simp [h.1, h.2] + rw [hx, (lowFormula b hb hab le_rfl).2, hc, hf] + ring + · have hc : cdiv (B * a) b = A := FordLaplacianDetails.hcAt1006 P ha hbig x hsum hdet hb P₁ + hq₁ P₂ hq₂ cminus hab + have hf : A * a / a = A := Int.mul_ediv_cancel _ (ne_of_gt ha0) + rcases hcase with h | h + · have hx : x = ⟨a, a⟩ := by ext <;> simp [h.1, h.2] + have hv0 := edge0 a ha0.le le_rfl + have hvm := near0 a ha0.le le_rfl + have hvp := outward a ha0.le (by omega) + rw [hc] at hvp + rw [hf] at hvm + rw [hx, lapCoord, hvp.1, hvm.1, hvp.2, hvm.2, hv0.1] + ring + · have hx : x = ⟨b, b⟩ := by ext <;> simp [h.1, h.2] + have he : (P.q : Int) - a = b := by omega + have hh := (highFormula a ha0 le_rfl hab).1 + rw [he, hc, hf] at hh + rw [hx] + simpa using hh + · intro hn + clear * - P g hn hr hr' hs hs' ceilShift boundaryValue axes lapCoord + have hall : ∀ i, x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P i) := + FordLaplacianDetails.hall P x hn + have h0 := (hall 0).1 + have h1 := (hall 1).1 + have h2 := (hall 2).1 + have h3 := (hall 3).1 + change 0 ≤ x.re ∧ x.re ≤ P.q₁ ∧ 0 ≤ x.im ∧ x.im ≤ P.q₁ at h0 + change (P.q₂ : Int) ≤ x.re ∧ x.re ≤ P.q ∧ + (P.q₂ : Int) ≤ x.im ∧ x.im ≤ P.q at h1 + change (P.q₁ : Int) ≤ x.re ∧ x.re ≤ P.q ∧ + 0 ≤ x.im ∧ x.im ≤ P.q₂ at h2 + change 0 ≤ x.re ∧ x.re ≤ P.q₂ ∧ + (P.q₁ : Int) ≤ x.im ∧ x.im ≤ P.q at h3 + have he : (P.q₁ : Int) = P.q₂ := by omega + have hsum : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q + have hdet := P.det₁ + have hp := P.sum_p + have hd : (P.q₁ : Int) ∣ 1 := FordLaplacianDetails.hdAt1050 P he hsum hdet hp + have ha1 := Int.le_of_dvd (by norm_num : (0 : Int) < 1) hd + have hqa : (P.q₁ : Int) = 1 := by omega + have hqb : (P.q₂ : Int) = 1 := by omega + have hqq : (P.q : Int) = 2 := by omega + have hx : x = ⟨1, 1⟩ := by ext <;> dsimp <;> omega + have hnum : P.p = P.p₁ * 2 - 1 := FordLaplacianDetails.hnum P hdet hqa hqq + have hc := boundaryValue 1 1 (by omega) (by omega) + (by omega) (by omega) (by omega) + norm_num only [mul_one] at hc + rw [hnum, hqq] at hc + rw [neg_sub] at hc + have hround := ceilShift 1 P.p₁ + rw [hqq] at hround + norm_num at hround + rw [hround] at hc + have hv := axes 2 (by omega) (by omega) + have hv0 := axes 1 (by omega) (by omega) + have hvR : g ⟨2, 1⟩ = P.p := FordLaplacianDetails.hvR P hqq hv + have hvU : g ⟨1, 2⟩ = P.p := FordLaplacianDetails.hvU P hqq hv + rw [hx, lapCoord] + norm_num only + rw [hvR, hv0.2.1, hvU, hv0.1, hc] + nlinarith only [hnum] + +end FordInteriorCase + +theorem FordLaplacianTable (P : FordFareyParameter) : + (∀ x, FourNeighborLaplacian (FordOdometer P) x = + FourNeighborLaplacian (FordOdometer P) (x + ⟨0, (P.q : Int)⟩) ∧ + FourNeighborLaplacian (FordOdometer P) x = + FourNeighborLaplacian (FordOdometer P) + (x + ⟨(P.q : Int), (P.q₁ : Int)⟩)) ∧ + (∀ x, x ∈ LatticeVertexBoundary (FordVertexDomain P.q) -> + FourNeighborLaplacian (FordOdometer P) x = 1) ∧ + (1 < P.q -> ∀ x, + 1 <= x.re -> x.re <= (P.q : Int) - 1 -> + 1 <= x.im -> x.im <= (P.q : Int) - 1 -> + let n := FordBoundaryMultiplicity P x; + (n = 2 -> FourNeighborLaplacian (FordOdometer P) x = 1) ∧ + (n = 3 -> FourNeighborLaplacian (FordOdometer P) x = 0) ∧ + (n = 4 -> FourNeighborLaplacian (FordOdometer P) x = -2)) := by +-- BODY + classical + let g := FordOdometer P + obtain ⟨hbase, hbdy, hneg, hpos, hneg₂, hrec⟩ := + (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + have hq : 0 < (P.q : Int) := by exact_mod_cast P.q_pos + have hqne : (P.q : Int) ≠ 0 := ne_of_gt hq + have ha : (P.q₁ : Int) < P.q := by exact_mod_cast P.q₁_lt + have periodic (v : GaussianInt) (a b c : Int) + (h : ∀ x, g (x + v) = g x + a * x.re + b * x.im + c) : + ∀ x, FourNeighborLaplacian g (x + v) = FourNeighborLaplacian g x := + FordLaplacianProof.periodic P v a b c h + have periodNeg := periodic ⟨0, -(P.q : Int)⟩ (-P.p) 0 0 + (by intro x; have h := hneg P x; change g _ = g _ - _ at h; nlinarith only [h]) + have periodPos := periodic ⟨(P.q : Int), (P.q₁ : Int)⟩ + P.p₁ P.p ((P.q₁ : Int) * P.p) (hpos P) + have periodUp (x : GaussianInt) : + FourNeighborLaplacian g (x + ⟨0, (P.q : Int)⟩) = + FourNeighborLaplacian g x := FordLaplacianDetails.periodUp P periodNeg x + have ceilShift (n k : Int) : + -((-(k * (P.q : Int) - n)) / (P.q : Int)) = k - n / (P.q : Int) := + FordLaplacianDetails.ceilShift P hqne n k + have boundaryValue (r s : Int) + (hr : 0 ≤ r) (hr' : r ≤ P.q) (hs : 0 ≤ s) (hs' : s ≤ P.q) + (hedge : r ≤ 1 ∨ (P.q : Int) - 1 ≤ r ∨ + s ≤ 1 ∨ (P.q : Int) - 1 ≤ s) : + g ⟨r, s⟩ = -((-(P.p * r * s)) / (P.q : Int)) := FordLaplacianProof.boundaryValue P hbdy r s + hr hr' hs hs' hedge + have axes (t : Int) (ht : 0 ≤ t) (ht' : t ≤ P.q) : + g ⟨t, 0⟩ = 0 ∧ g ⟨0, t⟩ = 0 ∧ + g ⟨t, 1⟩ = -((- (P.p * t)) / (P.q : Int)) ∧ + g ⟨1, t⟩ = -((- (P.p * t)) / (P.q : Int)) := FordLaplacianDetails.axes P hq boundaryValue t + ht ht' + -- The left neighbor has numerator p*t - 1, unlike the lower neighbor. + have left (t : Int) (ht : 0 ≤ t) (ht' : t ≤ P.q) : + g ⟨-1, t⟩ = -((P.p * t - 1) / (P.q : Int)) := FordLaplacianProof.left P hpos hneg₂ hq hqne + ha ceilShift boundaryValue t ht ht' + have lapCoord (r s : Int) : FourNeighborLaplacian g ⟨r, s⟩ = + g ⟨r + 1, s⟩ + g ⟨r - 1, s⟩ + + g ⟨r, s + 1⟩ + g ⟨r, s - 1⟩ - 4 * g ⟨r, s⟩ := FordLaplacianDetails.lapCoord P r s + have roundInterior (t : Int) (ht : 0 < t) (ht' : t < P.q) : + -((- (P.p * t)) / (P.q : Int)) - P.p * t / (P.q : Int) = 1 ∧ + (P.p * t - 1) / (P.q : Int) = P.p * t / (P.q : Int) := FordLaplacianProof.roundInterior P + hq hqne (FordLaplacianProof.nondiv P) t ht ht' + have bottomLap (t : Int) (ht : 0 ≤ t) (ht' : t < P.q) : + FourNeighborLaplacian g ⟨t, 0⟩ = 1 := FordLaplacianProof.bottomLap P hq axes + (FordLaplacianProof.below P hneg hq ceilShift boundaryValue) left + lapCoord roundInterior t ht ht' + have leftLap (t : Int) (ht : 0 ≤ t) (ht' : t ≤ P.q) : + FourNeighborLaplacian g ⟨0, t⟩ = 1 := FordLaplacianProof.leftLap P hq periodUp axes left + lapCoord roundInterior bottomLap t ht ht' + have rightLap (t : Int) (ht : 0 ≤ t) (ht' : t ≤ P.q) : + FourNeighborLaplacian g ⟨(P.q : Int), t⟩ = 1 := FordLaplacianProof.rightLap P ha periodNeg + periodPos leftLap t ht ht' + have bottomClosed (t : Int) (ht : 0 ≤ t) (ht' : t ≤ P.q) : + FourNeighborLaplacian g ⟨t, 0⟩ = 1 := FordLaplacianDetails.bottomClosed P hq bottomLap + rightLap t ht ht' + have interiorLaplacian (hbig : 1 < P.q) (x : GaussianInt) + (hr : 1 ≤ x.re) (hr' : x.re ≤ (P.q : Int) - 1) + (hs : 1 ≤ x.im) (hs' : x.im ≤ (P.q : Int) - 1) : + let n := FordBoundaryMultiplicity P x; + (n = 2 → FourNeighborLaplacian g x = 1) ∧ + (n = 3 → FourNeighborLaplacian g x = 0) ∧ + (n = 4 → FourNeighborLaplacian g x = -2) := FordInteriorCase.interiorLaplacian P hbdy hrec + ha ceilShift boundaryValue axes lapCoord hbig x hr hr' hs hs' + refine ⟨?_, ?_, ?_⟩ + · intro x + exact ⟨(periodUp x).symm, (periodPos x).symm⟩ + · intro x hx + have hxrect := hx.1 + change 0 ≤ x.re ∧ x.re ≤ P.q ∧ 0 ≤ x.im ∧ x.im ≤ P.q at hxrect + have hedge : x.re = 0 ∨ x.re = P.q ∨ x.im = 0 ∨ x.im = P.q := FordLaplacianDetails.hedge P x + hx hxrect + have hxcoord : x = ⟨x.re, x.im⟩ := by rfl + rw [hxcoord] + rcases hedge with hl | hr | hb | ht + · rw [hl] + exact leftLap x.im hxrect.2.2.1 hxrect.2.2.2 + · rw [hr] + exact rightLap x.im hxrect.2.2.1 hxrect.2.2.2 + · rw [hb] + exact bottomClosed x.re hxrect.1 hxrect.2.1 + · rw [ht] + have he : (⟨x.re, 0⟩ : GaussianInt) + + ⟨0, (P.q : Int)⟩ = ⟨x.re, (P.q : Int)⟩ := by ext <;> simp + rw [← he, periodUp] + exact bottomClosed x.re hxrect.1 hxrect.2.1 + · exact interiorLaplacian + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean new file mode 100644 index 0000000000..adbd006a86 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean @@ -0,0 +1,968 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordOdometerFamilyExistsUnique +public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse +public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: FordLeftBoundaryCompatibility] + +/-! +# FordLeftBoundaryCompatibility + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FordBoundaryCompatibilityGeometry + +private theorem hcurv : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (r0 : Fin (3 : ℕ)), ∀ (g0 : BandPackingSymmetry), ∀ + (P0 : FordFareyParameter), ((1 : ℕ) < P0.q) → ((BandPackingSymmetryQuadrupleAction g0 + ![q (0 : Fin (4 : ℕ)), q r0.succ, q (r0 + (1 : Fin (3 : ℕ))).succ, q (r0 + (2 : Fin + (3 : ℕ))).succ] = FordRecursiveQuadruple P0) → (1 < (q 0).1)) ) := by + classical + intro q r0 g0 P0 hP0 heq0 + have hc := (BandPackingSymmetryCovariance g0).1 (q 0) + have he := congrFun heq0 0 + have hecurv := congrArg Prod.fst he + simp? [BandPackingSymmetryQuadrupleAction] at hecurv + rw [hc] at hecurv + have hqp : (1 : ℝ) < P0.q := by exact_mod_cast hP0 + simp [FordRecursiveQuadruple, FordCircleCoordinate] at hecurv + nlinarith + +private theorem iline0 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (1 < (q 0).1) → (∀ (iline : Fin (4 : ℕ)), ((q + iline).1 = (0 : ℤ)) → (iline ≠ 0)) ) := by + classical + intro q hcurv iline hiline hz + subst iline + linarith [hcurv, hiline] + +private theorem wline : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (w : Fin (4 : ℕ) → CircleCoordinates), ∀ (r1 : Fin + (3 : ℕ)), (∀ (j : Fin (3 : ℕ)), w j.succ = q (j + r1).succ) → ((∀ (y : Fin (3 : ℕ)), + (fun (r : Fin (3 : ℕ)) => ∀ (j : Fin (3 : ℕ)), w j.succ = q (j + r).succ) y → y = r1) + → (∀ (iline : Fin (4 : ℕ)), ((q iline).1 = (0 : ℤ)) → ((iline ≠ 0) → (∃ j : Fin 4, (w + j).1 = 0)))) ) := by + classical + intro q w r1 hr1 hruniq iline hiline iline0 + refine ⟨(iline.pred iline0 - r1).succ, ?_⟩ + simpa only [hr1, sub_add_cancel, Fin.succ_pred] using hiline + +private theorem hbar : + (by + classical + exact + ∀ (w : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple w) → (∀ (r2 : Fin (3 : ℕ)), + ∀ (g2 : BandPackingSymmetry), ∀ (P2 : FordFareyParameter), ((w (r2 + (2 : Fin (3 : + ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g2 ![w (0 : Fin (4 : + ℕ)), w r2.succ, w (r2 + (1 : Fin (3 : ℕ))).succ, w (r2 + (2 : Fin (3 : ℕ))).succ] = + FordRecursiveQuadruple P2) → ( + let barq : Fin 4 → CircleCoordinates := + ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] + ProperBandQuadruple barq))) ) := by + classical + intro w hwproper r2 g2 P2 hz2 heq2 barq + fin_cases r2 + · exact ⟨by + convert hwproper.1 using 1; funext j; fin_cases j <;> rfl, by + intro j + fin_cases j + · change (w 1).1 < (w 0).1; exact hwproper.2 0 + · change (w 2).1 < (w 0).1; exact hwproper.2 1 + · change (w 3).1 < (w 0).1; exact hwproper.2 2⟩ + · exact ⟨SemiProperQuadruple.rotate hwproper.1, by + intro j + fin_cases j + · simpa [barq] using hwproper.2 1 + · simpa [barq] using hwproper.2 2 + · simpa [barq] using hwproper.2 0⟩ + · exact ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hwproper.1), by + intro j + fin_cases j + · simpa [barq] using hwproper.2 2 + · simpa [barq] using hwproper.2 0 + · simpa [barq] using hwproper.2 1⟩ + +private theorem hpoint : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (q : Fin 4 -> CircleCoordinates), ∀ (p : ℝ × ℝ), + ∀ (p' : ℝ × ℝ), ∀ (w : Fin (4 : ℕ) → CircleCoordinates), ∀ (iw : Fin (3 : ℕ)), ∀ (ew + : Bool), (TileCentroid T' - TileCentroid T = (if ew = true then (1 : ℝ) else (-1 : + ℝ)) • GaussianRealPoint (BandVectors.1 (w iw.succ) (w (0 : Fin (4 : ℕ))))) → ((p'.1 - + p.1 = (if ew = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (w iw.succ) (w (0 + : Fin (4 : ℕ)))).re : ℝ)) → ((p'.2 - p.2 = (if ew = true then (1 : ℝ) else (-1 : ℝ)) + * (↑(BandVectors.2 (w iw.succ) (w (0 : Fin (4 : ℕ)))).im : ℝ)) → (∀ (r2 : Fin (3 : + ℕ)), ∀ (g2 : BandPackingSymmetry), ∀ (P2 : FordFareyParameter), ((w (r2 + (2 : Fin (3 + : ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g2 ![w (0 : Fin (4 : + ℕ)), w r2.succ, w (r2 + (1 : Fin (3 : ℕ))).succ, w (r2 + (2 : Fin (3 : ℕ))).succ] = + FordRecursiveQuadruple P2) → ( + let barq : Fin 4 → CircleCoordinates := + ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] + (ProperBandQuadruple barq) → ((barq 0 = q 0) → (∀ (t : Fin (3 : ℕ)), (t + r2 = iw) → + (barq t.succ = w iw.succ)))))))) ) := by + classical + intro T T' q p p' w iw ew hwcent hwslope hwslope' r2 g2 P2 hz2 heq2 barq hbar hbar0 t ht + revert ht + fin_cases r2 <;> fin_cases t <;> fin_cases iw <;> simp [barq] + +private theorem hcentbar : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (q : Fin 4 -> + CircleCoordinates), (q (0 : Fin (4 : ℕ)) = C.1.1) → (∀ (w : Fin (4 : ℕ) → + CircleCoordinates), ∀ (iw : Fin (3 : ℕ)), ∀ (ew : Bool), (w (0 : Fin (4 : ℕ)) = + C.1.1) → ((TileCentroid T' - TileCentroid T = (if ew = true then (1 : ℝ) else (-1 : + ℝ)) • GaussianRealPoint (BandVectors.1 (w iw.succ) (w (0 : Fin (4 : ℕ))))) → (∀ (r2 : + Fin (3 : ℕ)), + let barq : Fin 4 → CircleCoordinates := + ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] + (barq 0 = q 0) → (∀ (t : Fin (3 : ℕ)), (barq t.succ = w iw.succ) → (TileCentroid T' - + TileCentroid T = (if ew = true then (1 : ℝ) else -1) • GaussianRealPoint + (BandVectors.1 (barq t.succ) (barq 0))))))) ) := by + classical + intro C T T' q hC w iw ew hwchild hwcent r2 barq hbar0 t hpoint + rw [hpoint, hbar0, hC] + simpa [hwchild] using hwcent + +private theorem hslopebar : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 -> CircleCoordinates), (q (0 : Fin (4 : ℕ)) = C.1.1) → + (∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), ∀ (w : Fin (4 : ℕ) → CircleCoordinates), ∀ (iw : Fin + (3 : ℕ)), ∀ (ew : Bool), (w (0 : Fin (4 : ℕ)) = C.1.1) → ((p'.1 - p.1 = (if ew = true + then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (w iw.succ) (w (0 : Fin (4 : ℕ)))).re + : ℝ)) → (∀ (r2 : Fin (3 : ℕ)), + let barq : Fin 4 → CircleCoordinates := + ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] + (barq 0 = q 0) → (∀ (t : Fin (3 : ℕ)), (barq t.succ = w iw.succ) → (p'.1 - p.1 = (if ew = + true then (1 : ℝ) else -1) * (BandVectors.2 (barq t.succ) (barq 0)).re))))) ) := by + classical + intro C q hC p p' w iw ew hwchild hwslope r2 barq hbar0 t hpoint + rw [hpoint, hbar0, hC] + simpa [hwchild] using hwslope + +private theorem hslopebar' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 -> CircleCoordinates), (q (0 : Fin (4 : ℕ)) = C.1.1) → + (∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), ∀ (w : Fin (4 : ℕ) → CircleCoordinates), ∀ (iw : Fin + (3 : ℕ)), ∀ (ew : Bool), (w (0 : Fin (4 : ℕ)) = C.1.1) → ((p'.2 - p.2 = (if ew = true + then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (w iw.succ) (w (0 : Fin (4 : ℕ)))).im + : ℝ)) → (∀ (r2 : Fin (3 : ℕ)), + let barq : Fin 4 → CircleCoordinates := + ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] + (barq 0 = q 0) → (∀ (t : Fin (3 : ℕ)), (barq t.succ = w iw.succ) → (p'.2 - p.2 = (if ew = + true then (1 : ℝ) else -1) * (BandVectors.2 (barq t.succ) (barq 0)).im))))) ) := by + classical + intro C q hC p p' w iw ew hwchild hwslope' r2 barq hbar0 t hpoint + rw [hpoint, hbar0, hC] + simpa [hwchild] using hwslope' + +private theorem hCpos : + (by + classical + exact + ∀ (w : Fin (4 : ℕ) → CircleCoordinates), ∀ (r2 : Fin (3 : ℕ)), ∀ (g2 : + BandPackingSymmetry), ∀ (P2 : FordFareyParameter), ((1 : ℕ) < P2.q) → ( + let barq : Fin 4 → CircleCoordinates := + ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] + (BandPackingSymmetryQuadrupleAction g2 ![w (0 : Fin (4 : ℕ)), w r2.succ, w (r2 + (1 : Fin + (3 : ℕ))).succ, w (r2 + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ)) = + FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) → (0 < + (BandPackingSymmetryQuadrupleAction g2 barq 0).1)) ) := by + classical + intro w r2 g2 P2 hP2 barq heq0' + have hqpos : (0 : ℝ) < P2.q := by exact_mod_cast P2.q_pos + have hh := congrArg Prod.fst heq0' + simp [FordRecursiveQuadruple, FordCircleCoordinate] at hh + nlinarith + +private theorem hkO' : + (by + classical + exact + ∀ (w : Fin (4 : ℕ) → CircleCoordinates), ∀ (r2 : Fin (3 : ℕ)), ∀ (g2 : + BandPackingSymmetry), ∀ (P2 : FordFareyParameter), + let barq : Fin 4 → CircleCoordinates := + ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] + (BandPackingSymmetryQuadrupleAction g2 ![w (0 : Fin (4 : ℕ)), w r2.succ, w (r2 + (1 : Fin + (3 : ℕ))).succ, w (r2 + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ)) = + FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) → (∀ (k : PartialOdometer), + (TileOdometer (FordCircleCoordinate P2.p P2.q) (FordTile P2.q) k) → (TileOdometer + (BandPackingSymmetryQuadrupleAction g2 barq 0) (FordTile P2.q) k)) ) := by + classical + intro w r2 g2 P2 barq heq0' k hkO + rw [heq0'] + exact hkO + +private theorem hcentT : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (g2 : BandPackingSymmetry), ∀ (P2 : FordFareyParameter), ∀ (u : + GaussianInt), ((BandPackingSymmetryTileAction g2 T).cells = (TileTranslation + (FordTile P2.q) u).cells) → (((BandPackingSymmetryTileAction g2 T).cells = ∅ → + (BandPackingSymmetryTileAction g2 T).anchor = (TileTranslation (FordTile P2.q) + u).anchor) → (TileCentroid (BandPackingSymmetryTileAction g2 T) = TileCentroid + (TileTranslation (FordTile P2.q) u))) ) := by + classical + intro T g2 P2 u hu huempty + rw [TileCentroid, TileCentroid] + by_cases hn : (BandPackingSymmetryTileAction g2 T).cells.Nonempty + · have hn' : (TileTranslation (FordTile P2.q) u).cells.Nonempty := by + rw [← hu] + exact hn + simp [hu, hn'] + · have he : (BandPackingSymmetryTileAction g2 T).cells = ∅ := + Finset.not_nonempty_iff_eq_empty.mp hn + have ha := huempty he + rw [(TileTranslationFormulas (FordTile P2.q) u).2.1] at ha + have ht : ¬ (TileTranslation (FordTile P2.q) u).cells.Nonempty := by + simpa [hu] using hn + simp only [hn, ht, ite_false] + rw [(TileTranslationFormulas (FordTile P2.q) u).2.1] + apply Prod.ext + · change ((BandPackingSymmetryTileAction g2 T).anchor.re : ℝ) = + ((GaussianTranslation u (FordTile P2.q).anchor).re : ℝ) + exact_mod_cast congrArg (fun z => z.re) ha + · change ((BandPackingSymmetryTileAction g2 T).anchor.im : ℝ) = + ((GaussianTranslation u (FordTile P2.q).anchor).im : ℝ) + exact_mod_cast congrArg (fun z => z.im) ha + +private theorem hcentT' : + (by + classical + exact + ∀ (T' : ProtoTile), ∀ (g2 : BandPackingSymmetry), ∀ (P2 : FordFareyParameter), ∀ (u' : + GaussianInt), ((BandPackingSymmetryTileAction g2 T').cells = (TileTranslation + (FordTile P2.q) u').cells) → (((BandPackingSymmetryTileAction g2 T').cells = ∅ → + (BandPackingSymmetryTileAction g2 T').anchor = (TileTranslation (FordTile P2.q) + u').anchor) → (TileCentroid (BandPackingSymmetryTileAction g2 T') = TileCentroid + (TileTranslation (FordTile P2.q) u'))) ) := by + classical + intro T' g2 P2 u' hu' huempty' + rw [TileCentroid, TileCentroid] + by_cases hn : (BandPackingSymmetryTileAction g2 T').cells.Nonempty + · have hn' : (TileTranslation (FordTile P2.q) u').cells.Nonempty := by + rw [← hu'] + exact hn + simp [hu', hn'] + · have he : (BandPackingSymmetryTileAction g2 T').cells = ∅ := + Finset.not_nonempty_iff_eq_empty.mp hn + have ha := huempty' he + rw [(TileTranslationFormulas (FordTile P2.q) u').2.1] at ha + have ht : ¬ (TileTranslation (FordTile P2.q) u').cells.Nonempty := by + simpa [hu'] using hn + simp only [hn, ht, ite_false] + rw [(TileTranslationFormulas (FordTile P2.q) u').2.1] + apply Prod.ext + · change ((BandPackingSymmetryTileAction g2 T').anchor.re : ℝ) = + ((GaussianTranslation u' (FordTile P2.q).anchor).re : ℝ) + exact_mod_cast congrArg (fun z => z.re) ha + · change ((BandPackingSymmetryTileAction g2 T').anchor.im : ℝ) = + ((GaussianTranslation u' (FordTile P2.q).anchor).im : ℝ) + exact_mod_cast congrArg (fun z => z.im) ha + +private theorem hshift : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (w : Fin (4 : ℕ) → CircleCoordinates), ∀ (ew : + Bool), ∀ (r2 : Fin (3 : ℕ)), ∀ (g2 : BandPackingSymmetry), ∀ (P2 : + FordFareyParameter), (BandPackingSymmetryReversesOrientation g2 = false) → ( + let barq : Fin 4 → CircleCoordinates := + ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] + ∀ (t : Fin (3 : ℕ)), ∀ (negative : Bool), (TileCentroid (BandPackingSymmetryTileAction g2 + T') - TileCentroid (BandPackingSymmetryTileAction g2 T) = (if (ew ^^ negative) = true + then (1 : ℝ) else (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 + (BandPackingSymmetryQuadrupleAction g2 barq ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g2 = true then -j else j) t).succ) + (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : ℕ))))) → (∀ (u : + GaussianInt), ∀ (u' : GaussianInt), (TileCentroid (BandPackingSymmetryTileAction g2 + T) = TileCentroid (TileTranslation (FordTile P2.q) u)) → ((TileCentroid + (BandPackingSymmetryTileAction g2 T') = TileCentroid (TileTranslation (FordTile P2.q) + u')) → (u' - u = (if ew ^^ negative then 1 else -1) • BandVectors.1 + (BandPackingSymmetryQuadrupleAction g2 barq t.succ) + (BandPackingSymmetryQuadrupleAction g2 barq 0))))) ) := by + classical + intro T T' w ew r2 g2 P2 hg2 barq t negative hcent' u u' hcentT hcentT' + have hc := congrArg Prod.fst hcent' + rw [hcentT, hcentT'] at hc + rw [(TileTranslationFormulas (FordTile P2.q) u).2.2.2.2.1, + (TileTranslationFormulas (FordTile P2.q) u').2.2.2.2.1] at hc + have hc2 := congrArg Prod.snd hcent' + rw [hcentT, hcentT'] at hc2 + rw [(TileTranslationFormulas (FordTile P2.q) u).2.2.2.2.1, + (TileTranslationFormulas (FordTile P2.q) u').2.2.2.2.1] at hc2 + simp? [hg2] at hc hc2 + by_cases hs : ew = negative + · simp? [hs] at hc hc2 ⊢ + unfold GaussianRealPoint at hc hc2 + simp only [GaussianInt.toComplex, Zsqrtd.lift_apply_apply, Complex.add_re, + Complex.add_im, Complex.mul_re, Complex.mul_im, Complex.intCast_re, + Complex.intCast_im, Complex.I_re, Complex.I_im, zero_mul, add_zero, + zero_add, mul_one] at hc hc2 + ring_nf at hc hc2 + apply Zsqrtd.ext + · dsimp at hc ⊢ + exact_mod_cast hc + · dsimp at hc2 ⊢ + exact_mod_cast hc2 + · simp? [hs] at hc hc2 ⊢ + unfold GaussianRealPoint at hc hc2 + simp only [GaussianInt.toComplex, Zsqrtd.lift_apply_apply, Complex.add_re, + Complex.add_im, Complex.mul_re, Complex.mul_im, Complex.intCast_re, + Complex.intCast_im, Complex.I_re, Complex.I_im, zero_mul, add_zero, + zero_add, mul_one] at hc hc2 + ring_nf at hc hc2 + apply Zsqrtd.ext + · dsimp at hc ⊢ + exact_mod_cast hc + · dsimp at hc2 ⊢ + exact_mod_cast hc2 + +private theorem heqH : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (g2 : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ (u : + GaussianInt), ∀ (a : GaussianInt), ∀ (b : ℤ), (∀ (x : GaussianInt), x ∈ + (BandPackingSymmetryPartialOdometerAction g2 h).domain ↔ x - u ∈ k.domain) → ((∀ x ∈ + (BandPackingSymmetryPartialOdometerAction g2 h).domain, + (BandPackingSymmetryPartialOdometerAction g2 h).value x = k.value (x - u) + a.re * + x.re + a.im * x.im + b) → (BandPackingSymmetryPartialOdometerAction g2 h = + PartialOdometerAffineTranslate k u a b)) ) := by + classical + intro h g2 k u a b hud huv + apply (PartialOdometer.mk.injEq _ _ _ _ _ _).mpr + constructor + · apply Finset.ext + intro x + exact (hud x).trans ((PartialOdometerAffineTranslateFormulas k u a b).2.1 x).symm + · apply funext + intro x + change (BandPackingSymmetryPartialOdometerAction g2 h).value x = + (PartialOdometerAffineTranslate k u a b).value x + by_cases hx : x ∈ (BandPackingSymmetryPartialOdometerAction g2 h).domain + · rw [(PartialOdometerAffineTranslateFormulas k u a b).2.2.1 x + (by + have hxa := (PartialOdometerAffineTranslateFormulas k u a b).2.1 x + exact hxa.mpr ((hud x).mp hx))] + exact huv x hx + · have hxa := (PartialOdometerAffineTranslateFormulas k u a b).2.1 x + have hnot : x ∉ (PartialOdometerAffineTranslate k u a b).domain := by + intro ha + exact hx ((hud x).mpr (hxa.mp ha)) + rw [(BandPackingSymmetryPartialOdometerAction g2 h).value_outside x hx, + (PartialOdometerAffineTranslate k u a b).value_outside x hnot] + +private theorem heqH' : + (by + classical + exact + ∀ (h' : PartialOdometer), ∀ (g2 : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ (u' : + GaussianInt), ∀ (a' : GaussianInt), ∀ (b' : ℤ), (∀ (x : GaussianInt), x ∈ + (BandPackingSymmetryPartialOdometerAction g2 h').domain ↔ x - u' ∈ k.domain) → ((∀ x + ∈ (BandPackingSymmetryPartialOdometerAction g2 h').domain, + (BandPackingSymmetryPartialOdometerAction g2 h').value x = k.value (x - u') + a'.re * + x.re + a'.im * x.im + b') → (BandPackingSymmetryPartialOdometerAction g2 h' = + PartialOdometerAffineTranslate k u' a' b')) ) := by + classical + intro h' g2 k u' a' b' hud' huv' + apply (PartialOdometer.mk.injEq _ _ _ _ _ _).mpr + constructor + · apply Finset.ext + intro x + exact (hud' x).trans ((PartialOdometerAffineTranslateFormulas k u' a' b').2.1 x).symm + · apply funext + intro x + change (BandPackingSymmetryPartialOdometerAction g2 h').value x = + (PartialOdometerAffineTranslate k u' a' b').value x + by_cases hx : x ∈ (BandPackingSymmetryPartialOdometerAction g2 h').domain + · rw [(PartialOdometerAffineTranslateFormulas k u' a' b').2.2.1 x + (by + have hxa := (PartialOdometerAffineTranslateFormulas k u' a' b').2.1 x + exact hxa.mpr ((hud' x).mp hx))] + exact huv' x hx + · have hxa := (PartialOdometerAffineTranslateFormulas k u' a' b').2.1 x + have hnot : x ∉ (PartialOdometerAffineTranslate k u' a' b').domain := by + intro ha + exact hx ((hud' x).mpr (hxa.mp ha)) + rw [(BandPackingSymmetryPartialOdometerAction g2 h').value_outside x hx, + (PartialOdometerAffineTranslate k u' a' b').value_outside x hnot] + +private theorem hvec : + (by + classical + exact + ∀ (w : Fin (4 : ℕ) → CircleCoordinates), ∀ (ew : Bool), ∀ (r2 : Fin (3 : ℕ)), ∀ (g2 : + BandPackingSymmetry), ∀ (P2 : FordFareyParameter), + (BandPackingSymmetryQuadrupleAction g2 ![w (0 : Fin (4 : ℕ)), w r2.succ, w (r2 + (1 : + Fin (3 : ℕ))).succ, w (r2 + (2 : Fin (3 : ℕ))).succ] = FordRecursiveQuadruple P2) → ( + let barq : Fin 4 → CircleCoordinates := + ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] + ∀ (t : Fin (3 : ℕ)), ∀ (negative : Bool), ∀ (u : GaussianInt), ∀ (u' : GaussianInt), (u' + - u = (if ew ^^ negative then 1 else -1) • BandVectors.1 + (BandPackingSymmetryQuadrupleAction g2 barq t.succ) + (BandPackingSymmetryQuadrupleAction g2 barq 0)) → (u' - u = (if (ew ^^ negative) = + true then 1 else -1) • BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0))) ) := by + classical + intro w ew r2 g2 P2 heq2 barq t negative u u' hshift + rw [heq2] at hshift + simpa using hshift + +private theorem haRe : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), ∀ (w : Fin (4 : ℕ) + → CircleCoordinates), ∀ (iw : Fin (3 : ℕ)), ∀ (ew : Bool), (TileCentroid T' - + TileCentroid T = (if ew = true then (1 : ℝ) else (-1 : ℝ)) • GaussianRealPoint + (BandVectors.1 (w iw.succ) (w (0 : Fin (4 : ℕ))))) → ((p'.1 - p.1 = (if ew = true + then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (w iw.succ) (w (0 : Fin (4 : ℕ)))).re + : ℝ)) → ((p'.2 - p.2 = (if ew = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 + (w iw.succ) (w (0 : Fin (4 : ℕ)))).im : ℝ)) → (∀ (r2 : Fin (3 : ℕ)), ∀ (g2 : + BandPackingSymmetry), ∀ (P2 : FordFareyParameter), + let barq : Fin 4 → CircleCoordinates := + ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] + ∀ (t : Fin (3 : ℕ)), (t + r2 = iw) → ((barq t.succ = w iw.succ) → ((TileCentroid T' - + TileCentroid T = (if ew = true then (1 : ℝ) else -1) • GaussianRealPoint + (BandVectors.1 (barq t.succ) (barq 0))) → ((p'.1 - p.1 = (if ew = true then (1 : ℝ) + else -1) * (BandVectors.2 (barq t.succ) (barq 0)).re) → ((p'.2 - p.2 = (if ew = true + then (1 : ℝ) else -1) * (BandVectors.2 (barq t.succ) (barq 0)).im) → (∀ (negative : + Bool), ∀ (r : ℝ × ℝ), ∀ (r' : ℝ × ℝ), (BandPackingSymmetryScopedPhase g2 barq + negative) → ((TileCentroid (BandPackingSymmetryTileAction g2 T') - TileCentroid + (BandPackingSymmetryTileAction g2 T) = (if (ew ^^ negative) = true then (1 : ℝ) else + (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction g2 + barq ((fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g2 = true + then -j else j) t).succ) (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : + ℕ))))) → ((r'.1 - r.1 = (if (ew ^^ negative) = true then (1 : ℝ) else (-1 : ℝ)) * + (↑(BandVectors.2 (BandPackingSymmetryQuadrupleAction g2 barq ((fun (j : Fin (3 : ℕ)) + => if BandPackingSymmetryReversesOrientation g2 = true then -j else j) t).succ) + (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : ℕ)))).re : ℝ)) → ((r'.2 - + r.2 = (if (ew ^^ negative) = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 + (BandPackingSymmetryQuadrupleAction g2 barq ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g2 = true then -j else j) t).succ) + (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : ℕ)))).im : ℝ)) → (∀ (u : + GaussianInt), ∀ (a : GaussianInt), ∀ (u' : GaussianInt), ∀ (a' : GaussianInt), (u' - + u = (if ew ^^ negative then 1 else -1) • BandVectors.1 + (BandPackingSymmetryQuadrupleAction g2 barq t.succ) + (BandPackingSymmetryQuadrupleAction g2 barq 0)) → ((u' - u = (if (ew ^^ negative) = + true then 1 else -1) • BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0)) → (∀ (z : ℝ × ℝ), (r'.1 - r.1 = if ew = negative then + -((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : + Fin (4 : ℕ)))).re : ℝ) + ((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) * (0 : ℝ) - (0 : ℝ))) else + (↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : + Fin (4 : ℕ)))).re : ℝ) + ((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) * (0 : ℝ) - (0 : ℝ))) → ((r'.2 + - r.2 = if ew = negative then -(↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) else (↑(BandVectors.2 + (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im + : ℝ)) → ((r.1 = z.1 + ((↑a.re : ℝ) + ((↑a.im : ℝ) * (0 : ℝ) - (0 : ℝ)))) → ((r'.1 = + z.1 + ((↑a'.re : ℝ) + ((↑a'.im : ℝ) * (0 : ℝ) - (0 : ℝ)))) → (a'.re - a.re = (if (ew + ^^ negative) = true then 1 else -1) * (BandVectors.2 (FordRecursiveQuadruple P2 + t.succ) (FordRecursiveQuadruple P2 0)).re)))))))))))))))))) ) := by + classical + intro T T' p p' w iw ew hwcent hwslope hwslope' r2 g2 P2 barq t ht hpoint hcentbar hslopebar + hslopebar' negative r r' hphase hcent' hsre' hsim' u a u' a' hshift hvec z hsreFord + hsimFord sr sr' + fin_cases t <;> cases ew <;> cases negative + all_goals + simp only [Bool.xor_true, Bool.xor_false, + ite_true] at sr sr' hsreFord ⊢ + have slopeDifference : r'.1 - r.1 = (a'.re : ℝ) - a.re := by + linarith [sr, sr'] + have transformedDifference := hsreFord + rw [slopeDifference] at transformedDifference + try + norm_num at transformedDifference ⊢ + try simp only [← GaussianInt.intCast_re] at transformedDifference + exact_mod_cast transformedDifference + +private theorem haIm : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), ∀ (w : Fin (4 : ℕ) + → CircleCoordinates), ∀ (iw : Fin (3 : ℕ)), ∀ (ew : Bool), (TileCentroid T' - + TileCentroid T = (if ew = true then (1 : ℝ) else (-1 : ℝ)) • GaussianRealPoint + (BandVectors.1 (w iw.succ) (w (0 : Fin (4 : ℕ))))) → ((p'.1 - p.1 = (if ew = true + then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (w iw.succ) (w (0 : Fin (4 : ℕ)))).re + : ℝ)) → ((p'.2 - p.2 = (if ew = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 + (w iw.succ) (w (0 : Fin (4 : ℕ)))).im : ℝ)) → (∀ (r2 : Fin (3 : ℕ)), ∀ (g2 : + BandPackingSymmetry), ∀ (P2 : FordFareyParameter), + let barq : Fin 4 → CircleCoordinates := + ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] + ∀ (t : Fin (3 : ℕ)), (t + r2 = iw) → ((barq t.succ = w iw.succ) → ((TileCentroid T' - + TileCentroid T = (if ew = true then (1 : ℝ) else -1) • GaussianRealPoint + (BandVectors.1 (barq t.succ) (barq 0))) → ((p'.1 - p.1 = (if ew = true then (1 : ℝ) + else -1) * (BandVectors.2 (barq t.succ) (barq 0)).re) → ((p'.2 - p.2 = (if ew = true + then (1 : ℝ) else -1) * (BandVectors.2 (barq t.succ) (barq 0)).im) → (∀ (negative : + Bool), ∀ (r : ℝ × ℝ), ∀ (r' : ℝ × ℝ), (BandPackingSymmetryScopedPhase g2 barq + negative) → ((TileCentroid (BandPackingSymmetryTileAction g2 T') - TileCentroid + (BandPackingSymmetryTileAction g2 T) = (if (ew ^^ negative) = true then (1 : ℝ) else + (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction g2 + barq ((fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g2 = true + then -j else j) t).succ) (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : + ℕ))))) → ((r'.1 - r.1 = (if (ew ^^ negative) = true then (1 : ℝ) else (-1 : ℝ)) * + (↑(BandVectors.2 (BandPackingSymmetryQuadrupleAction g2 barq ((fun (j : Fin (3 : ℕ)) + => if BandPackingSymmetryReversesOrientation g2 = true then -j else j) t).succ) + (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : ℕ)))).re : ℝ)) → ((r'.2 - + r.2 = (if (ew ^^ negative) = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 + (BandPackingSymmetryQuadrupleAction g2 barq ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g2 = true then -j else j) t).succ) + (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : ℕ)))).im : ℝ)) → (∀ (u : + GaussianInt), ∀ (a : GaussianInt), ∀ (u' : GaussianInt), ∀ (a' : GaussianInt), (u' - + u = (if ew ^^ negative then 1 else -1) • BandVectors.1 + (BandPackingSymmetryQuadrupleAction g2 barq t.succ) + (BandPackingSymmetryQuadrupleAction g2 barq 0)) → ((u' - u = (if (ew ^^ negative) = + true then 1 else -1) • BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0)) → (∀ (z : ℝ × ℝ), (r'.1 - r.1 = if ew = negative then + -((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : + Fin (4 : ℕ)))).re : ℝ) + ((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) * (0 : ℝ) - (0 : ℝ))) else + (↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : + Fin (4 : ℕ)))).re : ℝ) + ((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) * (0 : ℝ) - (0 : ℝ))) → ((r'.2 + - r.2 = if ew = negative then -(↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) else (↑(BandVectors.2 + (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im + : ℝ)) → ((r.2 = z.2 + (↑a.im : ℝ)) → ((r'.2 = z.2 + (↑a'.im : ℝ)) → ((a'.re - a.re = + (if (ew ^^ negative) = true then 1 else -1) * (BandVectors.2 (FordRecursiveQuadruple + P2 t.succ) (FordRecursiveQuadruple P2 0)).re) → (a'.im - a.im = (if (ew ^^ negative) + = true then 1 else -1) * (BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0)).im))))))))))))))))))) ) := by + classical + intro T T' p p' w iw ew hwcent hwslope hwslope' r2 g2 P2 barq t ht hpoint hcentbar hslopebar + hslopebar' negative r r' hphase hcent' hsre' hsim' u a u' a' hshift hvec z hsreFord + hsimFord si si' haRe + fin_cases t <;> cases ew <;> cases negative + all_goals + simp only [Bool.xor_true, Bool.xor_false, + ite_true] at si si' hsimFord ⊢ + have slopeDifference : r'.2 - r.2 = (a'.im : ℝ) - a.im := by + linarith [si, si'] + have transformedDifference := hsimFord + rw [slopeDifference] at transformedDifference + try + norm_num at transformedDifference ⊢ + try simp only [← GaussianInt.intCast_im] at transformedDifference + exact_mod_cast transformedDifference + +private theorem hcoc : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), ∀ (w : Fin (4 : ℕ) + → CircleCoordinates), ∀ (iw : Fin (3 : ℕ)), ∀ (ew : Bool), ∀ (r2 : Fin (3 : ℕ)), ∀ + (g2 : BandPackingSymmetry), ∀ (P2 : FordFareyParameter), + let barq : Fin 4 → CircleCoordinates := + ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] + ∀ (t : Fin (3 : ℕ)), (t + r2 = iw) → ((barq t.succ = w iw.succ) → ((TileCentroid T' - + TileCentroid T = (if ew = true then (1 : ℝ) else -1) • GaussianRealPoint + (BandVectors.1 (barq t.succ) (barq 0))) → ((p'.1 - p.1 = (if ew = true then (1 : ℝ) + else -1) * (BandVectors.2 (barq t.succ) (barq 0)).re) → ((p'.2 - p.2 = (if ew = true + then (1 : ℝ) else -1) * (BandVectors.2 (barq t.succ) (barq 0)).im) → (∀ (negative : + Bool), ∀ (r : ℝ × ℝ), ∀ (r' : ℝ × ℝ), (TileCentroid (BandPackingSymmetryTileAction g2 + T') - TileCentroid (BandPackingSymmetryTileAction g2 T) = (if (ew ^^ negative) = true + then (1 : ℝ) else (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 + (BandPackingSymmetryQuadrupleAction g2 barq ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g2 = true then -j else j) t).succ) + (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : ℕ))))) → ((r'.1 - r.1 = (if + (ew ^^ negative) = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 + (BandPackingSymmetryQuadrupleAction g2 barq ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g2 = true then -j else j) t).succ) + (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : ℕ)))).re : ℝ)) → ((r'.2 - + r.2 = (if (ew ^^ negative) = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 + (BandPackingSymmetryQuadrupleAction g2 barq ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g2 = true then -j else j) t).succ) + (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : ℕ)))).im : ℝ)) → (∀ (u : + GaussianInt), ∀ (a : GaussianInt), ∀ (u' : GaussianInt), ∀ (a' : GaussianInt), (u' - + u = (if ew ^^ negative then 1 else -1) • BandVectors.1 + (BandPackingSymmetryQuadrupleAction g2 barq t.succ) + (BandPackingSymmetryQuadrupleAction g2 barq 0)) → ((u' - u = (if (ew ^^ negative) = + true then 1 else -1) • BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0)) → ((BandVectors.1 (FordRecursiveQuadruple P2 (1 : Fin + (4 : ℕ))) (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) = (⟨(↑P2.q : ℤ), (↑P2.q₁ : + ℤ)⟩ : GaussianInt)) → ((BandVectors.1 (FordRecursiveQuadruple P2 (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) = (⟨-(↑P2.q : ℤ), (↑P2.q₂ : ℤ)⟩ : + GaussianInt)) → ((BandVectors.1 (FordRecursiveQuadruple P2 (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) = (⟨(0 : ℤ), -(↑P2.q : ℤ)⟩ : + GaussianInt)) → ((BandVectors.2 (FordRecursiveQuadruple P2 (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) = (⟨P2.p₁, P2.p⟩ : GaussianInt)) → + ((BandVectors.2 (FordRecursiveQuadruple P2 (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple + P2 (0 : Fin (4 : ℕ))) = (⟨P2.p₂, -P2.p⟩ : GaussianInt)) → ((BandVectors.2 + (FordRecursiveQuadruple P2 (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple P2 (0 : Fin (4 + : ℕ))) = (⟨-P2.p, (0 : ℤ)⟩ : GaussianInt)) → ((r'.1 - r.1 = if ew = negative then + -((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : + Fin (4 : ℕ)))).re : ℝ) + ((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) * (0 : ℝ) - (0 : ℝ))) else + (↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : + Fin (4 : ℕ)))).re : ℝ) + ((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) * (0 : ℝ) - (0 : ℝ))) → ((r'.2 + - r.2 = if ew = negative then -(↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) else (↑(BandVectors.2 + (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im + : ℝ)) → ((a'.re - a.re = (if (ew ^^ negative) = true then 1 else -1) * (BandVectors.2 + (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 0)).re) → ((a'.im - + a.im = (if (ew ^^ negative) = true then 1 else -1) * (BandVectors.2 + (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 0)).im) → (∀ y : + GaussianInt, FordOdometer P2 (y + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0)) - FordOdometer P2 y = (BandVectors.2 + (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 0)).re * y.re + + (BandVectors.2 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 0)).im * + y.im + (if t = 0 then P2.q₁ * P2.p else if t = 1 then -(P2.q * P2.p₂) else + 0))))))))))))))))))))) ) := by + classical + intro T T' p p' w iw ew r2 g2 P2 barq t ht hpoint hcentbar hslopebar hslopebar' negative r r' + hcent' hsre' hsim' u a u' a' hshift hvec hv2 hv3 ha1 ha2 ha3 ha4 hsreFord hsimFord haRe haIm y + fin_cases t + · change FordOdometer P2 (y + BandVectors.1 (FordRecursiveQuadruple P2 1) + (FordRecursiveQuadruple P2 0)) - FordOdometer P2 y = _ + rw [hv2] + have identity := sub_eq_iff_eq_add.mpr ((Classical.choose_spec + FordOdometerFamilyExistsUnique).1.2.2.2.1 P2 y) + simp [FordOdometer, ha2] at identity ⊢ + linarith [identity] + · change FordOdometer P2 (y + BandVectors.1 (FordRecursiveQuadruple P2 2) + (FordRecursiveQuadruple P2 0)) - FordOdometer P2 y = _ + rw [hv3] + have identity := sub_eq_iff_eq_add.mpr ((Classical.choose_spec + FordOdometerFamilyExistsUnique).1.2.2.2.2.1 P2 y) + simp [FordOdometer, ha3] at identity ⊢ + linarith [identity] + · change FordOdometer P2 (y + BandVectors.1 (FordRecursiveQuadruple P2 3) + (FordRecursiveQuadruple P2 0)) - FordOdometer P2 y = _ + rw [ha1] + have identity := sub_eq_iff_eq_add.mpr ((Classical.choose_spec + FordOdometerFamilyExistsUnique).1.2.2.1 P2 y) + simp [FordOdometer, ha4] at identity ⊢ + linarith [identity] + +private theorem hzero : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (h' : PartialOdometer), ∀ (g2 : BandPackingSymmetry), ∀ (P2 : + FordFareyParameter), ∀ (k : PartialOdometer), (∀ x ∈ k.domain, k.value x = + FordOdometer P2 x) → (∀ (u : GaussianInt), ∀ (a : GaussianInt), ∀ (b : ℤ), (∀ (x : + GaussianInt), x ∈ (BandPackingSymmetryPartialOdometerAction g2 h).domain ↔ x - u ∈ + k.domain) → ((∀ x ∈ (BandPackingSymmetryPartialOdometerAction g2 h).domain, + (BandPackingSymmetryPartialOdometerAction g2 h).value x = k.value (x - u) + a.re * + x.re + a.im * x.im + b) → (∀ (u' : GaussianInt), ∀ (a' : GaussianInt), ∀ (b' : ℤ), (∀ + (x : GaussianInt), x ∈ (BandPackingSymmetryPartialOdometerAction g2 h').domain ↔ x - + u' ∈ k.domain) → ((∀ x ∈ (BandPackingSymmetryPartialOdometerAction g2 h').domain, + (BandPackingSymmetryPartialOdometerAction g2 h').value x = k.value (x - u') + a'.re * + x.re + a'.im * x.im + b') → (∀ (x0 : GaussianInt), (x0 ∈ + (↑(BandPackingSymmetryPartialOdometerAction g2 h).domain : Set GaussianInt)) → ((x0 ∈ + (↑(BandPackingSymmetryPartialOdometerAction g2 h').domain : Set GaussianInt)) → + ((BandPackingSymmetryPartialOdometerAction g2 h').value x0 - + (BandPackingSymmetryPartialOdometerAction g2 h).value x0 = FordOdometer P2 (x0 - u') + + a'.re * x0.re + a'.im * x0.im + b' - (FordOdometer P2 (x0 - u) + a.re * x0.re + + a.im * x0.im + b)))))))) ) := by + classical + intro h h' g2 P2 k hkV u a b hud huv u' a' b' hud' huv' x0 hx0 hx0' + rw [huv' x0 hx0', huv x0 hx0, + hkV (x0 - u') ((hud' x0).mp hx0'), + hkV (x0 - u) ((hud x0).mp hx0)] + +private theorem hvxAt524 : + (by + classical + exact + ∀ (P2 : FordFareyParameter), ∀ (t : Fin (3 : ℕ)), ∀ (u : GaussianInt), ∀ (u' : + GaussianInt), (u' - u = (1 : ℤ) • BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))) → (∀ (x : GaussianInt), x - u = (x - + u') + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 0)) + ) := by + classical + intro P2 t u u' hvec x + calc + x - u = x - u' + (u' - u) := by ring + _ = _ := by rw [hvec]; ring + +private theorem hvx0At530 : + (by + classical + exact + ∀ (P2 : FordFareyParameter), ∀ (t : Fin (3 : ℕ)), ∀ (u : GaussianInt), ∀ (u' : + GaussianInt), (u' - u = (1 : ℤ) • BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))) → (∀ (x0 : GaussianInt), x0 - u = (x0 + - u') + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 + 0)) ) := by + classical + intro P2 t u u' hvec x0 + calc + x0 - u = x0 - u' + (u' - u) := by ring + _ = _ := by rw [hvec]; ring + +private theorem hvxAt546 : + (by + classical + exact + ∀ (P2 : FordFareyParameter), ∀ (t : Fin (3 : ℕ)), ∀ (u : GaussianInt), ∀ (u' : + GaussianInt), (u' - u = (-1 : ℤ) • BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))) → (∀ (x : GaussianInt), x - u' = (x - + u) + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 0)) + ) := by + classical + intro P2 t u u' hvec x + calc + x - u' = x - u - (u' - u) := by ring + _ = _ := by rw [hvec]; ring + +private theorem hvx0At552 : + (by + classical + exact + ∀ (P2 : FordFareyParameter), ∀ (t : Fin (3 : ℕ)), ∀ (u : GaussianInt), ∀ (u' : + GaussianInt), (u' - u = (-1 : ℤ) • BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))) → (∀ (x0 : GaussianInt), x0 - u' = (x0 + - u) + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 + 0)) ) := by + classical + intro P2 t u u' hvec x0 + calc + x0 - u' = x0 - u - (u' - u) := by ring + _ = _ := by rw [hvec]; ring + +end FordBoundaryCompatibilityGeometry + +theorem FordLeftBoundaryCompatibility + (C : BandCircle) (T T' : ProtoTile) (h h' : PartialOdometer) + (hadj : LeftLatticeAdjacent C T T' h h') + (q : Fin 4 -> CircleCoordinates) (hq : ProperBandQuadruple q) + (hC : q 0 = C.1.1) (hline : exists i : Fin 4, (q i).1 = 0) : + OdometerCompatibility h h' := by +-- BODY + classical + obtain ⟨hqT, hqT', hpdata⟩ := hadj + obtain ⟨r0, g0, P0, hP0, hg0, hw0, hz0, heq0⟩ := + FordRegimeConverse q hq hline + have hcurv := FordBoundaryCompatibilityGeometry.hcurv q r0 g0 P0 hP0 heq0 + obtain ⟨p, p', hp, hp', hcase⟩ := hpdata + rcases hcase with hunit | hproper + · rcases hunit with ⟨hone, orientation, v, hv, hcent, hslope, hslope'⟩ + exfalso + have hone' : (q 0).1 = 1 := by rw [hC]; exact hone + linarith [hcurv, hone'] + · rcases hproper with ⟨w, iw, ew, hwproper, hwchild, hwcent, hwslope, hwslope'⟩ + obtain ⟨r1, hr1, hruniq⟩ := + BandPredecessorNoCollision q w hq hwproper (hC.trans hwchild.symm) + obtain ⟨iline, hiline⟩ := hline + have wline := FordBoundaryCompatibilityGeometry.wline q w r1 hr1 + hruniq iline hiline (FordBoundaryCompatibilityGeometry.iline0 q hcurv iline hiline) + obtain ⟨r2, g2, P2, hP2, hg2, hw2, hz2, heq2⟩ := + FordRegimeConverse w hwproper wline + let barq : Fin 4 → CircleCoordinates := + ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] + have hbar := FordBoundaryCompatibilityGeometry.hbar w hwproper r2 + g2 P2 hz2 heq2 + have hbar0 : barq 0 = q 0 := by + simp [barq, hwchild, hC] + have hidx : ∃ t : Fin 3, (t + r2 : Fin 3) = iw := by + fin_cases r2 <;> fin_cases iw <;> decide + obtain ⟨t, ht⟩ := hidx + have hpoint := FordBoundaryCompatibilityGeometry.hpoint T T' q p p' + w iw ew hwcent hwslope hwslope' r2 g2 P2 hz2 heq2 hbar hbar0 t ht + have hcentbar := FordBoundaryCompatibilityGeometry.hcentbar C T T' q hC w iw ew hwchild + hwcent r2 + hbar0 t hpoint + have hslopebar := FordBoundaryCompatibilityGeometry.hslopebar C q hC p p' w iw ew hwchild + hwslope r2 + hbar0 t hpoint + have hslopebar' := FordBoundaryCompatibilityGeometry.hslopebar' C q hC p p' w iw ew hwchild + hwslope' + r2 hbar0 t hpoint + obtain ⟨negative, r, r', hphase, hth, hth', hsr, hsr', hcent', hsre', hsim', hcompat⟩ := + LeftLatticeAdjacentPackingSymmetryTransport g2 barq hbar t ew T T' h h' p p' + (by simpa [hbar0, hC] using hqT) (by simpa [hbar0, hC] using hqT') hp hp' + hcentbar hslopebar hslopebar' + apply hcompat.mp + have heq0' := congrFun heq2 0 + have hCpos := FordBoundaryCompatibilityGeometry.hCpos w r2 g2 P2 hP2 heq0' + obtain ⟨k, hkO, hkD, hkV⟩ := FordTileOdometerRestriction P2 + have hkO' := FordBoundaryCompatibilityGeometry.hkO' w r2 g2 P2 heq0' k hkO + obtain ⟨u, huall, huunique⟩ := + TileOdometerTranslationUniqueness + (BandPackingSymmetryQuadrupleAction g2 barq 0) + (BandPackingSymmetryTileAction g2 T) (FordTile P2.q) + (BandPackingSymmetryPartialOdometerAction g2 h) k hCpos hth hkO' + obtain ⟨hu, huempty, a, b, hud, huv⟩ := huall + obtain ⟨u', huall', huunique'⟩ := + TileOdometerTranslationUniqueness + (BandPackingSymmetryQuadrupleAction g2 barq 0) + (BandPackingSymmetryTileAction g2 T') (FordTile P2.q) + (BandPackingSymmetryPartialOdometerAction g2 h') k hCpos hth' hkO' + obtain ⟨hu', huempty', a', b', hud', huv'⟩ := huall' + have hshift := FordBoundaryCompatibilityGeometry.hshift T T' w ew r2 g2 P2 hg2 t negative hcent' + u u' (FordBoundaryCompatibilityGeometry.hcentT T g2 P2 u hu huempty) + (FordBoundaryCompatibilityGeometry.hcentT' T' g2 P2 u' hu' huempty') + have hslopeH := congrArg PartialOdometerSlope (FordBoundaryCompatibilityGeometry.heqH h g2 k + u a b hud huv) + have hslopeH' := congrArg PartialOdometerSlope (FordBoundaryCompatibilityGeometry.heqH' h' g2 + k u' a' b' hud' huv') + rw [hsr] at hslopeH + rw [hsr'] at hslopeH' + rw [PartialOdometerAffineTranslateFormulas k u a b |>.2.2.2.2.2] at hslopeH + rw [PartialOdometerAffineTranslateFormulas k u' a' b' |>.2.2.2.2.2] at hslopeH' + have hvec : u' - u = + (if (ew ^^ negative) = true then 1 else -1) • + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0) := FordBoundaryCompatibilityGeometry.hvec w ew r2 g2 P2 + heq2 t negative u u' hshift + obtain ⟨_, hcfg⟩ := FordCoordinateConfiguration P2 + have hcfg := hcfg hP2 + rcases hcfg with ⟨hv1, hv2, hv3, ha1, ha2, ha3, ha4, ha5⟩ + cases hkS : PartialOdometerSlope k with + | none => simp [hkS] at hslopeH + | some z => + simp? [hkS] at hslopeH hslopeH' + have hsreFord := hsre' + have hsimFord := hsim' + have heq2bar : BandPackingSymmetryQuadrupleAction g2 barq = + FordRecursiveQuadruple P2 := by simpa [barq] using heq2 + rw [heq2bar] at hsreFord hsimFord + simp? [hg2] at hsreFord hsimFord + simp only [GaussianInt.toComplex, Zsqrtd.lift_apply_apply, Complex.add_re, + Complex.add_im, Complex.mul_re, Complex.mul_im, Complex.intCast_re, + Complex.intCast_im, Complex.I_re, Complex.I_im, zero_mul, add_zero, + zero_add, mul_one] at hsreFord hsimFord + have sr := congrArg Prod.fst hslopeH + have sr' := congrArg Prod.fst hslopeH' + have si := congrArg Prod.snd hslopeH + have si' := congrArg Prod.snd hslopeH' + dsimp at sr sr' si si' + simp only [GaussianInt.toComplex, Zsqrtd.lift_apply_apply, Complex.add_re, + Complex.add_im, Complex.mul_re, Complex.mul_im, Complex.intCast_re, + Complex.intCast_im, Complex.I_re, Complex.I_im, zero_mul, add_zero, + zero_add, mul_one] at sr sr' si si' + have hreal (v : GaussianInt) : (GaussianInt.toComplex v).re = v.re := by + exact (GaussianInt.intCast_re v).symm + have himag (v : GaussianInt) : (GaussianInt.toComplex v).im = v.im := by + exact (GaussianInt.intCast_im v).symm + have haRe : a'.re - a.re = + (if (ew ^^ negative) = true then 1 else -1) * + (BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0)).re := FordBoundaryCompatibilityGeometry.haRe T T' p + p' w iw ew hwcent hwslope hwslope' r2 g2 P2 t ht hpoint hcentbar hslopebar + hslopebar' negative r r' hphase hcent' hsre' hsim' u a u' a' hshift hvec z + hsreFord hsimFord sr sr' + have haIm : a'.im - a.im = + (if (ew ^^ negative) = true then 1 else -1) * + (BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0)).im := FordBoundaryCompatibilityGeometry.haIm T T' p + p' w iw ew hwcent hwslope hwslope' r2 g2 P2 t ht hpoint hcentbar hslopebar + hslopebar' negative r r' hphase hcent' hsre' hsim' u a u' a' hshift hvec z + hsreFord hsimFord si si' haRe + have hcoc : ∀ y : GaussianInt, + FordOdometer P2 (y + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0)) - FordOdometer P2 y = + (BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0)).re * y.re + + (BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0)).im * y.im + + (if t = 0 then P2.q₁ * P2.p else + if t = 1 then -(P2.q * P2.p₂) else 0) := FordBoundaryCompatibilityGeometry.hcoc T + T' p p' w iw ew r2 g2 P2 t ht hpoint hcentbar hslopebar hslopebar' negative r + r' hcent' hsre' hsim' u a u' a' hshift hvec hv2 hv3 ha1 ha2 ha3 ha4 hsreFord + hsimFord haRe haIm + by_cases hdj : Disjoint + ((BandPackingSymmetryPartialOdometerAction g2 h).domain : Set GaussianInt) + ((BandPackingSymmetryPartialOdometerAction g2 h').domain : Set GaussianInt) + · exact Or.inl hdj + · right + obtain ⟨x0, hx0, hx0'⟩ := Set.not_disjoint_iff.mp hdj + refine ⟨(BandPackingSymmetryPartialOdometerAction g2 h').value x0 - + (BandPackingSymmetryPartialOdometerAction g2 h).value x0, ?_⟩ + intro x hx hx' + rw [huv' x hx', huv x hx] + have hy := (hud x).mp hx + have hy' := (hud' x).mp hx' + rw [hkV (x - u) hy, hkV (x - u') hy'] + have hzero : + (BandPackingSymmetryPartialOdometerAction g2 h').value x0 - + (BandPackingSymmetryPartialOdometerAction g2 h).value x0 = + FordOdometer P2 (x0 - u') + a'.re * x0.re + a'.im * x0.im + b' - + (FordOdometer P2 (x0 - u) + a.re * x0.re + a.im * x0.im + b) := + FordBoundaryCompatibilityGeometry.hzero h h' g2 P2 k hkV u a b hud huv u' a' b' + hud' huv' x0 hx0 hx0' + rw [hzero] + have hdiff := hcoc (x - u') + have hdiff0 := hcoc (x0 - u') + by_cases hs : (ew ^^ negative) = true + · rw [ite_eq_left hs] at hvec haRe haIm + have hvx : x - u = (x - u') + + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0) := FordBoundaryCompatibilityGeometry.hvxAt524 P2 t + u u' hvec x + have hvx0 : x0 - u = (x0 - u') + + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0) := FordBoundaryCompatibilityGeometry.hvx0At530 P2 t + u u' hvec x0 + rw [← hvx] at hdiff + rw [← hvx0] at hdiff0 + dsimp at hdiff hdiff0 + ring_nf at hdiff hdiff0 ⊢ + linear_combination -hdiff + hdiff0 + + x.re * haRe + x.im * haIm - x0.re * haRe - x0.im * haIm + · rw [ite_eq_right hs] at hvec haRe haIm + ring_nf at haRe haIm + have hdiff1 := hcoc (x - u) + have hdiff01 := hcoc (x0 - u) + have hvx : x - u' = (x - u) + + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0) := FordBoundaryCompatibilityGeometry.hvxAt546 P2 t + u u' hvec x + have hvx0 : x0 - u' = (x0 - u) + + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0) := FordBoundaryCompatibilityGeometry.hvx0At552 P2 t + u u' hvec x0 + rw [hvx, hvx0] at ⊢ + dsimp at hdiff1 hdiff01 + ring_nf at hdiff1 hdiff01 ⊢ + linear_combination hdiff1 - hdiff01 + + (x.re - x0.re) * haRe + (x.im - x0.im) * haIm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordOdometer.lean b/LeanPool/ApollonianSuperharmonic/FordOdometer.lean new file mode 100644 index 0000000000..6333dad3bd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordOdometer.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordOdometerFamilyExistsUnique + +-- [TABLET NODE: FordOdometer] + +/-! +# FordOdometer + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The Ford odometer $g_{p,q}:\mathbb Z^2\to\mathbb Z$ is the component at +the Ford--Farey parameter $(p,q)$ of the unique family constructed in +`FordOdometerFamilyExistsUnique`. +-/ +noncomputable def FordOdometer (P : FordFareyParameter) : IntegerLatticeFunction := +-- BODY + Classical.choose FordOdometerFamilyExistsUnique P + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordOdometerFamilyExistsUnique.lean b/LeanPool/ApollonianSuperharmonic/FordOdometerFamilyExistsUnique.lean new file mode 100644 index 0000000000..e8c15e1fbc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordOdometerFamilyExistsUnique.lean @@ -0,0 +1,222 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist +public import LeanPool.ApollonianSuperharmonic.P5130T5DomainCover +public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic +public import LeanPool.ApollonianSuperharmonic.P5130T5MixedOverlaps +public import LeanPool.ApollonianSuperharmonic.P5130T5SameParentOverlaps +public import LeanPool.ApollonianSuperharmonic.P5130T5BoundaryConsistency +public import LeanPool.ApollonianSuperharmonic.P5130T5PeriodicExtension +public import LeanPool.ApollonianSuperharmonic.P5130T5UnitCase + +-- [TABLET NODE: FordOdometerFamilyExistsUnique] + +/-! +# FordOdometerFamilyExistsUnique + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FordOdometerFamilyExistsUnique : + ∃! G : FordFareyParameter -> IntegerLatticeFunction, + (∀ P x, P.q = 1 -> + G P x = x.re * (x.re - 1) / 2 + P.p * x.re * x.im) ∧ + (∀ P x, x ∈ FordDoubledBoundary P.q -> + G P x = IntegerCeilDiv (P.p * x.re * x.im) P.q + (by exact_mod_cast P.q_pos.ne')) ∧ + (∀ P x, G P (x + ⟨0, -(P.q : Int)⟩) = + G P x - P.p * x.re) ∧ + (∀ P x, G P (x + ⟨(P.q : Int), (P.q₁ : Int)⟩) = + G P x + P.p₁ * x.re + P.p * x.im + (P.q₁ : Int) * P.p) ∧ + (∀ P x, G P (x + ⟨-(P.q : Int), (P.q₂ : Int)⟩) = + G P x + P.p₂ * x.re - P.p * x.im - (P.q : Int) * P.p₂) ∧ + (∀ P P₁ P₂, 1 < P.q -> + P₁.p = P.p₁ -> P₁.q = P.q₁ -> P₂.p = P.p₂ -> P₂.q = P.q₂ -> + (∀ x, x ∈ FordRecursiveVertexDomains P 0 -> G P x = G P₁ x) ∧ + (∀ x, x ∈ FordRecursiveVertexDomains P 1 -> + G P x = G P₁ (x - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩) + + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (P.q₂ : Int) + 1) ∧ + (∀ x, x ∈ FordRecursiveVertexDomains P 2 -> + G P x = G P₂ (x - ⟨(P.q₁ : Int), 0⟩) + P.p₁ * x.im) ∧ + (∀ x, x ∈ FordRecursiveVertexDomains P 3 -> + G P x = G P₂ (x - ⟨0, (P.q₁ : Int)⟩) + P.p₁ * x.re)) := by +-- BODY + classical + let S (P : FordFareyParameter) (K : FordFareyParameter → IntegerLatticeFunction) + (g : IntegerLatticeFunction) : Prop := + (∀ x, P.q = 1 → g x = x.re * (x.re - 1) / 2 + P.p * x.re * x.im) ∧ + (∀ x ∈ FordDoubledBoundary P.q, + g x = IntegerCeilDiv (P.p * x.re * x.im) P.q (by exact_mod_cast P.q_pos.ne')) ∧ + (∀ x, g (x + ⟨0, -(P.q : Int)⟩) = g x - P.p * x.re) ∧ + (∀ x, g (x + ⟨(P.q : Int), (P.q₁ : Int)⟩) = + g x + P.p₁ * x.re + P.p * x.im + (P.q₁ : Int) * P.p) ∧ + (∀ x, g (x + ⟨-(P.q : Int), (P.q₂ : Int)⟩) = + g x + P.p₂ * x.re - P.p * x.im - (P.q : Int) * P.p₂) ∧ + (∀ A B, 1 < P.q → A.p = P.p₁ → A.q = P.q₁ → B.p = P.p₂ → B.q = P.q₂ → + ∀ i x, x ∈ FordRecursiveVertexDomains P i → + g x = P5130T5Prescription P (K A) (K B) i x) + have param_eq (A B : FordFareyParameter) (hp : A.p = B.p) (hq : A.q = B.q) : A = B := by + obtain ⟨R, _, hu⟩ := FordFareyParentsExist A.p A.q A.q_pos A.reduced + exact (hu A ⟨rfl, rfl⟩).trans (hu B ⟨hp.symm, hq.symm⟩).symm + have congrS (P : FordFareyParameter) (K H : FordFareyParameter → IntegerLatticeFunction) + (g : IntegerLatticeFunction) (heq : ∀ Q, Q.q < P.q → K Q = H Q) + (h : S P K g) : S P H g := by + rcases h with ⟨hu, hb, ha, hbb, hc, hr⟩ + refine ⟨hu, hb, ha, hbb, hc, ?_⟩ + intro A B hq hpA hqA hpB hqB i x hx + have hbds := P5130T5ParentArithmetic P hq + rw [← heq A (by omega), ← heq B (by omega)] + exact hr A B hq hpA hqA hpB hqB i x hx + have make (P : FordFareyParameter) (K : FordFareyParameter → IntegerLatticeFunction) + (ih : ∀ Q, Q.q < P.q → S Q K (K Q)) : ∃ g, S P K g := by + by_cases hunit : P.q = 1 + · obtain ⟨hb, ha, hbb, hc⟩ := P5130T5UnitCase P hunit + refine ⟨(fun x => x.re * (x.re - 1) / 2 + P.p * x.re * x.im), + (by intros; rfl), hb, ha, hbb, hc, ?_⟩ + intro A B hq + omega + have hq : 1 < P.q := by have := P.q_pos; omega + obtain ⟨haPos, haLt, hbPos, hbLt, haRed, hbRed, _⟩ := P5130T5ParentArithmetic P hq + obtain ⟨A, hA, _⟩ := FordFareyParentsExist P.p₁ P.q₁ haPos haRed + obtain ⟨B, hB, _⟩ := FordFareyParentsExist P.p₂ P.q₂ hbPos hbRed + have haLt' : A.q < P.q := by omega + have hbLt' : B.q < P.q := by omega + have hAB := (ih A haLt').2.1 + have hBB := (ih B hbLt').2.1 + have hm := P5130T5MixedOverlaps P A B hq hA.1 hA.2 hB.1 hB.2 (K A) (K B) hAB hBB + have hs := P5130T5SameParentOverlaps P A B hq hA.1 hA.2 hB.1 hB.2 K + (fun Q hQ => (ih Q hQ).2.1) + (fun Q C D hQ => (ih Q hQ).2.2.2.2.2 C D) + have hbc := P5130T5BoundaryConsistency P A B hq hA.1 hA.2 hB.1 hB.2 + (K A) (K B) hAB hBB + let F := P5130T5Prescription P (K A) (K B) + have pair : ∀ i j x, x ∈ FordRecursiveVertexDomains P i → + x ∈ FordRecursiveVertexDomains P j → F i x = F j x := by + intro i j x hi hj + fin_cases i <;> fin_cases j + · rfl + · exact hs.1 x hi hj + · exact hm.1 x hi hj + · exact hm.2.1 x hi hj + · exact (hs.1 x hj hi).symm + · rfl + · exact hm.2.2.1 x hi hj + · exact hm.2.2.2 x hi hj + · exact (hm.1 x hj hi).symm + · exact (hm.2.2.1 x hj hi).symm + · rfl + · exact hs.2 x hi hj + · exact (hm.2.1 x hj hi).symm + · exact (hm.2.2.2 x hj hi).symm + · exact (hs.2 x hj hi).symm + · rfl + let pick (x : GaussianInt) (hx : x ∈ FordVertexDomain P.q) : Fin 4 := + Classical.choose ((P5130T5DomainCover P).1 x hx) + have hpick (x : GaussianInt) (hx : x ∈ FordVertexDomain P.q) : + x ∈ FordRecursiveVertexDomains P (pick x hx) := + Classical.choose_spec ((P5130T5DomainCover P).1 x hx) + let f : IntegerLatticeFunction := fun x => + if hx : x ∈ FordVertexDomain P.q then F (pick x hx) x else 0 + have hf (i : Fin 4) (x : GaussianInt) (hx : x ∈ FordRecursiveVertexDomains P i) : + f x = F i x := by + have hsq := (P5130T5DomainCover P).2 i x hx + dsimp only [f] + rw [dite_eq_left hsq] + exact pair _ i x (hpick x hsq) hx + have hfB : ∀ x ∈ FordDoubledBoundary P.q, + f x = IntegerCeilDiv (P.p * x.re * x.im) P.q (by exact_mod_cast P.q_pos.ne') := by + intro x hx + dsimp only [f] + rw [dite_eq_left hx.1] + exact hbc _ x (hpick x hx.1) hx + obtain ⟨g, hg, _⟩ := P5130T5PeriodicExtension P f hfB + refine ⟨g, ?_, ?_, hg.2.1, hg.2.2.1, hg.2.2.2, ?_⟩ + · intro x hx + exact (hunit hx).elim + · intro x hx + exact (hg.1 x hx.1).trans (hfB x hx) + · intro A' B' _ hpA hqA hpB hqB i x hx + have eA : A' = A := param_eq A' A (hpA.trans hA.1.symm) (hqA.trans hA.2.symm) + have eB : B' = B := param_eq B' B (hpB.trans hB.1.symm) (hqB.trans hB.2.symm) + subst A' + subst B' + exact (hg.1 x ((P5130T5DomainCover P).2 i x hx)).trans (hf i x hx) + have unique (P : FordFareyParameter) (K : FordFareyParameter → IntegerLatticeFunction) + (g h : IntegerLatticeFunction) (hg : S P K g) (hh : S P K h) : g = h := by + by_cases hunit : P.q = 1 + · funext x + exact (hg.1 x hunit).trans (hh.1 x hunit).symm + have hq : 1 < P.q := by have := P.q_pos; omega + obtain ⟨haPos, _, hbPos, _, haRed, hbRed, _⟩ := P5130T5ParentArithmetic P hq + obtain ⟨A, hA, _⟩ := FordFareyParentsExist P.p₁ P.q₁ haPos haRed + obtain ⟨B, hB, _⟩ := FordFareyParentsExist P.p₂ P.q₂ hbPos hbRed + have agree : ∀ x ∈ FordVertexDomain P.q, g x = h x := by + intro x hx + obtain ⟨i, hi⟩ := (P5130T5DomainCover P).1 x hx + exact (hg.2.2.2.2.2 A B hq hA.1 hA.2 hB.1 hB.2 i x hi).trans + (hh.2.2.2.2.2 A B hq hA.1 hA.2 hB.1 hB.2 i x hi).symm + obtain ⟨e, _, he⟩ := P5130T5PeriodicExtension P h hh.2.1 + exact (he g ⟨agree, hg.2.2.1, hg.2.2.2.1, hg.2.2.2.2.1⟩).trans + (he h ⟨(by intros; rfl), hh.2.2.1, hh.2.2.2.1, hh.2.2.2.2.1⟩).symm + let wf := (measure (fun P : FordFareyParameter => P.q)).wf + let step (P : FordFareyParameter) + (rec : ∀ Q : FordFareyParameter, Q.q < P.q → IntegerLatticeFunction) : + IntegerLatticeFunction := + Classical.epsilon (S P (fun Q => if h : Q.q < P.q then rec Q h else fun _ => 0)) + let G : FordFareyParameter → IntegerLatticeFunction := wf.fix step + have hG : ∀ P, S P G (G P) := by + intro P₀ + apply wf.induction P₀ + intro P ih + let H : FordFareyParameter → IntegerLatticeFunction := + fun Q => if h : Q.q < P.q then G Q else fun _ => 0 + have eqH (Q : FordFareyParameter) (hQ : Q.q < P.q) : H Q = G Q := by + simp only [H, dite_eq_left hQ] + have small : ∀ Q, Q.q < P.q → S Q H (H Q) := by + intro Q hQ + rw [eqH Q hQ] + exact congrS Q G H (G Q) (fun R hR => (eqH R (lt_trans hR hQ)).symm) (ih Q hQ) + have hex := make P H small + have heps := congrS P H G (Classical.epsilon (S P H)) eqH (Classical.epsilon_spec hex) + have hfix : G P = Classical.epsilon (S P H) := wf.fix_eq step P + rw [hfix] + exact heps + refine ⟨G, ?_, ?_⟩ + · refine ⟨(fun P x h => (hG P).1 x h), (fun P => (hG P).2.1), + (fun P => (hG P).2.2.1), (fun P => (hG P).2.2.2.1), + (fun P => (hG P).2.2.2.2.1), ?_⟩ + intro P A B hq hpA hqA hpB hqB + have hr := (hG P).2.2.2.2.2 A B hq hpA hqA hpB hqB + exact ⟨hr 0, hr 1, hr 2, hr 3⟩ + · intro K hK + have HK : ∀ P, S P K (K P) := by + intro P + refine ⟨(fun x h => hK.1 P x h), hK.2.1 P, hK.2.2.1 P, + hK.2.2.2.1 P, hK.2.2.2.2.1 P, ?_⟩ + intro A B hq hpA hqA hpB hqB i x hx + have hr := hK.2.2.2.2.2 P A B hq hpA hqA hpB hqB + fin_cases i + · exact hr.1 x hx + · exact hr.2.1 x hx + · exact hr.2.2.1 x hx + · exact hr.2.2.2 x hx + have eq : ∀ P, K P = G P := by + intro P₀ + apply wf.induction P₀ + intro P ih + exact unique P G (K P) (G P) (congrS P K G (K P) ih (HK P)) (hG P) + exact funext eq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean new file mode 100644 index 0000000000..cc0b8cd05a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean @@ -0,0 +1,501 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4158T1MatchedFordPair +public import LeanPool.ApollonianSuperharmonic.P4158T1LargeFirstRestrictions +public import LeanPool.ApollonianSuperharmonic.P4158T1LargeSecondRestrictions +public import LeanPool.ApollonianSuperharmonic.P4158T1AncestorCells +public import LeanPool.ApollonianSuperharmonic.P4158T1SmallerStringEdges +public import LeanPool.ApollonianSuperharmonic.P4158T1EdgeSectorSelection +public import LeanPool.ApollonianSuperharmonic.P4158T1StringSlopeTelescoping +public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryOdometerStrings +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: FordOpposingBoundaryStarLocalization] + +/-! +# FordOpposingBoundaryStarLocalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FordStarGeometry + +private theorem hxfoot : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (h0 : PartialOdometer), ∀ (h0' : + PartialOdometer), ∀ (x : GaussianInt), (x ∈ h0.domain) → ((x ∈ h0'.domain) → + (((↑h0.domain : Set GaussianInt) = FootprintVertices T0) → (((↑h0'.domain : Set + GaussianInt) = FootprintVertices T0') → (x ∈ FootprintVertices T0 ∩ FootprintVertices + T0')))) ) := by + classical + intro T0 T0' h0 h0' x hx0 hx0' hdom0 hdom0' + constructor + · rw [← hdom0]; exact hx0 + · rw [← hdom0']; exact hx0' + +private theorem squareCell : + (by + classical + exact + (FordFareyParameter) → ((BandCircle) → ((Fin 3) → ((GaussianInt) → ((GaussianInt) → (∀ (n + : Nat), ∀ (v : GaussianInt), ∀ (z : GaussianInt), z ∈ (TileTranslation (FordTile n) + v).cells ↔ 0 ≤ (z - v).re ∧ (z - v).re < (n : Int) ∧ 0 ≤ (z - v).im ∧ (z - v).im < (n + : Int)))))) ) := by + classical + intro P Ci i x u n v z + change z ∈ (FordCellDomain n).image (GaussianTranslation v) ↔ _ + constructor + · rintro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + obtain ⟨a, ha, rfl⟩ := Finset.mem_image.mp hw + have hrange := Finset.mem_product.mp ha + have hm := Finset.mem_range.mp hrange.1 + have hn := Finset.mem_range.mp hrange.2 + simp only [GaussianTranslation, add_sub_cancel_right] + change 0 ≤ (a.1 : Int) ∧ (a.1 : Int) < n ∧ + 0 ≤ (a.2 : Int) ∧ (a.2 : Int) < n + exact ⟨by omega, by omega, by omega, by omega⟩ + · rintro ⟨h0r, hnr, h0i, hni⟩ + apply Finset.mem_image.mpr + refine ⟨z - v, ?_, by simp [GaussianTranslation]⟩ + apply Finset.mem_image.mpr + refine ⟨((z - v).re.toNat, (z - v).im.toNat), ?_, ?_⟩ + · apply Finset.mem_product.mpr + constructor <;> apply Finset.mem_range.mpr <;> omega + · apply Zsqrtd.ext + · exact Int.toNat_of_nonneg h0r + · exact Int.toNat_of_nonneg h0i + +private theorem smaller : + (by + classical + exact + ∀ (P : FordFareyParameter), (ProperBandQuadruple (FordRecursiveQuadruple P)) → (∀ (C0 : + BandCircle), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ)) = C0.1.1) → ((FordRecursiveQuadruple P i.succ = Ci.1.1) → (∀ (T0 : + ProtoTile), ∀ (T0' : ProtoTile), ∀ (h0 : PartialOdometer), ∀ (h0' : PartialOdometer), + (TileOdometer C0.1.1 T0 h0) → ((TileOdometer C0.1.1 T0' h0') → (((1 : ℤ) < Ci.1.1.1) + → (∀ (p0 : Real × Real), ∀ (p0' : Real × Real), (PartialOdometerSlope h0 = some p0) → + ((PartialOdometerSlope h0' = some p0') → ((TileCentroid T0' - TileCentroid T0 = + GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))))) → ((p0' - p0 = GaussianRealPoint + (BandVectors.2 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ))))) → (∀ (x : GaussianInt), ((0 : ℕ) < P.q₁) → (∀ (u : GaussianInt), + (T0.cells = (TileTranslation (FordTile P.q) u).cells) → ((T0'.cells = + (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), + (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) + → ((Disjoint T0.cells T0'.cells) → ((∀ (x : GaussianInt), x ∈ FootprintVertices T0 ∩ + FootprintVertices T0' ↔ ((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else + (0 : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im + ∧ (x - u).im ≤ (↑P.q : ℤ)) → (((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) + else (0 : ℤ)) → (((if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - + u).im) → (((x - u).im ≤ (↑P.q : ℤ)) → (((i = 0 ∧ P.q₁ < P.q₂) ∨ (i = 1 ∧ P.q₂ < + P.q₁)) → (∃ (U V : ProtoTile) (g k : PartialOdometer), AncestorOdometer Ci.1.1 C0.1.1 + U T0 g h0 ∧ AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0' ∧ LeftLatticeAdjacent Ci U V g + k ∧ ((x ∈ U.cells ∧ x - 1 - ⟨0, 1⟩ ∈ V.cells) ∨ (x - 1 ∈ U.cells ∧ x - ⟨0, 1⟩ ∈ + V.cells) ∨ (x - 1 - ⟨0, 1⟩ ∈ U.cells ∧ x ∈ V.cells) ∨ (x - ⟨0, 1⟩ ∈ U.cells ∧ x - 1 ∈ + V.cells))))))))))))))))))))) ) := by + classical + intro P hq C0 Ci i hC0 hCi T0 T0' h0 h0' hO0 hO0' hlarge p0 p0' hs0 hs0' hcentroid hslope x + hrpos u hc hc' hdis hsegment hxr hxl hxu hsmall + obtain ⟨orientation, centerShift, base, Rminus, Rplus, tiles, reverseTiles, + hs, reverseHs, hminus, hplus, pminus, pplus, a, b, bm, bp, + hboundary, _, _, _, _, hf, hr, hh, _, _, hh', hOm, hOp, + _, _, _, _, _, _, _, hanc, hanc'⟩ := + OpposingBoundaryOdometerStrings (FordRecursiveQuadruple P) hq C0 Ci i + hC0 hCi T0 T0' h0 h0' hO0 hO0' Ci.2 p0 p0' hs0 hs0' + hcentroid hslope + obtain ⟨q', _, hq'0, hq'i, _, _, _, hcm, hcp⟩ := hboundary + have hcm' : TileCentroid Rminus - TileCentroid T0 = (1 / 2 : Real) • + GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P 0) - BandVectors.1 (FordRecursiveQuadruple P 0) + (FordRecursiveQuadruple P i.succ)) := by + simpa only [hq'0, hq'i, hC0, hCi] using hcm + have hcp' : TileCentroid Rplus - TileCentroid T0 = (1 / 2 : Real) • + GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P 0) + BandVectors.1 (FordRecursiveQuadruple P 0) + (FordRecursiveQuadruple P i.succ)) := by + simpa only [hq'0, hq'i, hC0, hCi] using hcp + obtain ⟨hRm, hRp, hedges⟩ := P4158T1SmallerStringEdges P hq C0 Ci i hC0 hCi + hlarge hsmall T0 T0' h0 h0' u hc hc' hsegment orientation base Rminus Rplus + tiles reverseTiles hs reverseHs hf hr hminus hplus hOm hOp hcm' hcp' hanc hanc' + obtain hunit | ⟨r, hrsemi, hr0, hrless, _⟩ := BandGenealogy Ci + · omega + have hrproper : ProperBandQuadruple r := + ⟨hrsemi, by simpa only [hr0] using hrless⟩ + obtain ⟨PP, _, htiles, hadj, _, _, _, _, ⟨chart⟩⟩ := + BandRegularTranslatePeriodicComplex Ci r hrproper hr0 base + (by simpa only [hr0] using hf.1.1) + obtain ⟨a, b, g, k, hab, hUg, hVk, hAg, hAk, hedge, hdiag⟩ := + P4158T1EdgeSectorSelection P C0 Ci i hsmall hrpos hlarge T0 T0' h0 h0' u + hc hc' hdis orientation base Rminus Rplus tiles reverseTiles hs reverseHs + hf.1 hr.1 hRm hRp + (fun U g _ hA => P4158T1AncestorCells _ _ U T0 hA.2.1) + (fun V k _ hA => P4158T1AncestorCells _ _ V T0' hA.2.1) + hedges PP htiles _ chart x hxr hxl hxu + have hUgO := List.forall₂_zip hf.2.1 hUg + have hVkO := List.forall₂_zip hr.2.1 hVk + obtain ⟨s, t, hsg, htk, hslr, hsli⟩ := P4158T1StringSlopeTelescoping + Ci hlarge orientation base Rminus Rplus tiles reverseTiles hs reverseHs + hf hr hminus hh hh' (PP.tile a) (PP.tile b) g k hUg hVk + obtain ⟨z, _, heU, heV⟩ := hedge + have hadjacent := ((PeriodicTileIntersectionClassification PP).1 a b hab).1.mp + ⟨{z, z + ⟨0, 1⟩}, heU, heV⟩ + obtain ⟨j, hdisp⟩ := (hadj a b).mp hadjacent + have hcent : TileCentroid (PP.tile b) - TileCentroid (PP.tile a) = + GaussianRealPoint ((b : GaussianInt) - (a : GaussianInt)) := by + rw [htiles a, htiles b, (TileTranslationFormulas base _).2.2.2.2.1, + (TileTranslationFormulas base _).2.2.2.2.1] + ext <;> simp [GaussianRealPoint] + have hin := CircleMatrixIncomingVector Ci r hrsemi hr0 j + have hin0 := congrFun hin 0 + have hin1 := congrFun hin 1 + simp only [Matrix.mulVec, dotProduct, Fin.sum_univ_two, + Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val_fin_one] at hin0 hin1 + have hleft : LeftLatticeAdjacent Ci (PP.tile a) (PP.tile b) g k := by + refine ⟨hUgO, hVkO, s, t, hsg, htk, Or.inr ?_⟩ + rcases hdisp with hdisp | hdisp + · refine ⟨r, j, true, hrproper, hr0, ?_, ?_, ?_⟩ + · simpa [hdisp] using hcent + · have hcr := congrArg Prod.fst (hcent.trans (congrArg GaussianRealPoint hdisp)) + have hci := congrArg Prod.snd (hcent.trans (congrArg GaussianRealPoint hdisp)) + change (TileCentroid (PP.tile b)).1 - (TileCentroid (PP.tile a)).1 = + ((BandVectors.1 (r j.succ) (r 0)).re : Real) at hcr + change (TileCentroid (PP.tile b)).2 - (TileCentroid (PP.tile a)).2 = + ((BandVectors.1 (r j.succ) (r 0)).im : Real) at hci + change t.1 - s.1 = 1 * _ + rw [one_mul, hslr, hcr, hci] + exact hin0 + · have hcr := congrArg Prod.fst (hcent.trans (congrArg GaussianRealPoint hdisp)) + have hci := congrArg Prod.snd (hcent.trans (congrArg GaussianRealPoint hdisp)) + change (TileCentroid (PP.tile b)).1 - (TileCentroid (PP.tile a)).1 = + ((BandVectors.1 (r j.succ) (r 0)).re : Real) at hcr + change (TileCentroid (PP.tile b)).2 - (TileCentroid (PP.tile a)).2 = + ((BandVectors.1 (r j.succ) (r 0)).im : Real) at hci + change t.2 - s.2 = 1 * _ + rw [one_mul, hsli, hcr, hci] + exact hin1 + · refine ⟨r, j, false, hrproper, hr0, ?_, ?_, ?_⟩ + · rw [hcent, hdisp] + ext <;> simp [GaussianRealPoint] + · have hcr := congrArg Prod.fst (hcent.trans (congrArg GaussianRealPoint hdisp)) + have hci := congrArg Prod.snd (hcent.trans (congrArg GaussianRealPoint hdisp)) + change (TileCentroid (PP.tile b)).1 - (TileCentroid (PP.tile a)).1 = + ((-BandVectors.1 (r j.succ) (r 0)).re : Real) at hcr + change (TileCentroid (PP.tile b)).2 - (TileCentroid (PP.tile a)).2 = + ((-BandVectors.1 (r j.succ) (r 0)).im : Real) at hci + change t.1 - s.1 = -1 * _ + rw [hslr, hcr, hci] + simp only [Zsqrtd.re_neg, Zsqrtd.im_neg, Int.cast_neg] + linear_combination -hin0 + · have hcr := congrArg Prod.fst (hcent.trans (congrArg GaussianRealPoint hdisp)) + have hci := congrArg Prod.snd (hcent.trans (congrArg GaussianRealPoint hdisp)) + change (TileCentroid (PP.tile b)).1 - (TileCentroid (PP.tile a)).1 = + ((-BandVectors.1 (r j.succ) (r 0)).re : Real) at hcr + change (TileCentroid (PP.tile b)).2 - (TileCentroid (PP.tile a)).2 = + ((-BandVectors.1 (r j.succ) (r 0)).im : Real) at hci + change t.2 - s.2 = -1 * _ + rw [hsli, hcr, hci] + simp only [Zsqrtd.re_neg, Zsqrtd.im_neg, Int.cast_neg] + linear_combination -hin1 + exact ⟨PP.tile a, PP.tile b, g, k, hAg, hAk, hleft, hdiag⟩ + +private theorem hleftAt319 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), (P.q₂ < P.q₁) → (∀ (U : ProtoTile), ∀ (V + : ProtoTile), ∀ (g : PartialOdometer), ∀ (k : PartialOdometer), ∀ (s : ℝ × ℝ), ∀ (t : + ℝ × ℝ), ∀ (Q : FordFareyParameter), (TileOdometer Ci.1.1 U g) → ((TileOdometer Ci.1.1 + V k) → ((PartialOdometerSlope g = some s) → ((PartialOdometerSlope k = some t) → + ((TileCentroid V - TileCentroid U = GaussianRealPoint (⟨(↑P.q₁ : ℤ), (↑P.q₁ : ℤ) - + (↑P.q₂ : ℤ)⟩ : GaussianInt)) → ((t - s = GaussianRealPoint (⟨P.p₁ - P.p₂, P.p₁⟩ : + GaussianInt)) → ((Q.q = P.q₁) → ((Q.q₁ = P.q₁ - P.q₂) → ((Q.p = P.p₁) → ((Q.p₁ = P.p₁ + - P.p₂) → ((FordRecursiveQuadruple Q (0 : Fin (4 : ℕ)) = Ci.1.1) → + ((ProperBandQuadruple (FordRecursiveQuadruple Q) ∧ BandVectors.1 + (FordRecursiveQuadruple Q (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple Q (0 : Fin (4 : + ℕ))) = (⟨(↑Q.q : ℤ), (↑Q.q₁ : ℤ)⟩ : GaussianInt) ∧ BandVectors.1 + (FordRecursiveQuadruple Q (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple Q (0 : Fin (4 : + ℕ))) = (⟨-(↑Q.q : ℤ), (↑Q.q₂ : ℤ)⟩ : GaussianInt) ∧ BandVectors.1 + (FordRecursiveQuadruple Q (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple Q (0 : Fin (4 : + ℕ))) = (⟨(0 : ℤ), -(↑Q.q : ℤ)⟩ : GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple + Q (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple Q (0 : Fin (4 : ℕ))) = (⟨Q.p₁, Q.p⟩ : + GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple Q (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple Q (0 : Fin (4 : ℕ))) = (⟨Q.p₂, -Q.p⟩ : GaussianInt) ∧ + BandVectors.2 (FordRecursiveQuadruple Q (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple Q + (0 : Fin (4 : ℕ))) = (⟨-Q.p, (0 : ℤ)⟩ : GaussianInt) ∧ BandVectors.2 + (FordRecursiveQuadruple Q (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple Q (2 : Fin (4 : + ℕ))) = (⟨-Q.p₂, (0 : ℤ)⟩ : GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple Q (1 + : Fin (4 : ℕ))) (FordRecursiveQuadruple Q (3 : Fin (4 : ℕ))) = (⟨(0 : ℤ), Q.p₁⟩ : + GaussianInt)) → (LeftLatticeAdjacent Ci U V g k))))))))))))) ) := by + classical + intro P Ci horder U V g k s t Q hUg hVk hsg htk hUV hst hQq hQr hQp hQp1 hQ0 cfg + refine ⟨hUg, hVk, s, t, hsg, htk, Or.inr + ⟨FordRecursiveQuadruple Q, 0, true, cfg.1, hQ0, ?_, ?_, ?_⟩⟩ + · simpa [cfg.2.1, hQq, hQr, Nat.cast_sub horder.le] using hUV + · have hh := congrArg Prod.fst hst + simpa [cfg.2.2.2.2.1, hQp1, hQp, GaussianRealPoint] using hh + · have hh := congrArg Prod.snd hst + simpa [cfg.2.2.2.2.1, hQp1, hQp, GaussianRealPoint] using hh + +private theorem hleftAt345 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), (P.q₁ < P.q₂) → (∀ (U : ProtoTile), ∀ (V + : ProtoTile), ∀ (g : PartialOdometer), ∀ (k : PartialOdometer), ∀ (s : ℝ × ℝ), ∀ (t : + ℝ × ℝ), ∀ (Q : FordFareyParameter), (TileOdometer Ci.1.1 U g) → ((TileOdometer Ci.1.1 + V k) → ((PartialOdometerSlope g = some s) → ((PartialOdometerSlope k = some t) → + ((TileCentroid V - TileCentroid U = GaussianRealPoint (⟨-(↑P.q₂ : ℤ), (↑P.q₂ : ℤ) - + (↑P.q₁ : ℤ)⟩ : GaussianInt)) → ((t - s = GaussianRealPoint (⟨P.p₂ - P.p₁, -P.p₂⟩ : + GaussianInt)) → ((Q.q = P.q₂) → ((Q.q₂ = P.q₂ - P.q₁) → ((Q.p = P.p₂) → ((Q.p₂ = P.p₂ + - P.p₁) → ((FordRecursiveQuadruple Q (0 : Fin (4 : ℕ)) = Ci.1.1) → + ((ProperBandQuadruple (FordRecursiveQuadruple Q) ∧ BandVectors.1 + (FordRecursiveQuadruple Q (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple Q (0 : Fin (4 : + ℕ))) = (⟨(↑Q.q : ℤ), (↑Q.q₁ : ℤ)⟩ : GaussianInt) ∧ BandVectors.1 + (FordRecursiveQuadruple Q (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple Q (0 : Fin (4 : + ℕ))) = (⟨-(↑Q.q : ℤ), (↑Q.q₂ : ℤ)⟩ : GaussianInt) ∧ BandVectors.1 + (FordRecursiveQuadruple Q (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple Q (0 : Fin (4 : + ℕ))) = (⟨(0 : ℤ), -(↑Q.q : ℤ)⟩ : GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple + Q (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple Q (0 : Fin (4 : ℕ))) = (⟨Q.p₁, Q.p⟩ : + GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple Q (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple Q (0 : Fin (4 : ℕ))) = (⟨Q.p₂, -Q.p⟩ : GaussianInt) ∧ + BandVectors.2 (FordRecursiveQuadruple Q (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple Q + (0 : Fin (4 : ℕ))) = (⟨-Q.p, (0 : ℤ)⟩ : GaussianInt) ∧ BandVectors.2 + (FordRecursiveQuadruple Q (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple Q (2 : Fin (4 : + ℕ))) = (⟨-Q.p₂, (0 : ℤ)⟩ : GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple Q (1 + : Fin (4 : ℕ))) (FordRecursiveQuadruple Q (3 : Fin (4 : ℕ))) = (⟨(0 : ℤ), Q.p₁⟩ : + GaussianInt)) → (LeftLatticeAdjacent Ci U V g k))))))))))))) ) := by + classical + intro P Ci horder U V g k s t Q hUg hVk hsg htk hUV hst hQq hQs hQp hQp2 hQ0 cfg + refine ⟨hUg, hVk, s, t, hsg, htk, Or.inr + ⟨FordRecursiveQuadruple Q, 1, true, cfg.1, hQ0, ?_, ?_, ?_⟩⟩ + · simpa [cfg.2.2.1, hQq, hQs, Nat.cast_sub horder.le] using hUV + · have hh := congrArg Prod.fst hst + simpa [cfg.2.2.2.2.2.1, hQp2, hQp, GaussianRealPoint] using hh + · have hh := congrArg Prod.snd hst + simpa [cfg.2.2.2.2.2.1, hQp2, hQp, GaussianRealPoint] using hh + +private theorem corner : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (z : GaussianInt), (z ∈ T.cells) → (∀ (y : GaussianInt), (y = z ∨ y + = z + 1 ∨ y = z + ⟨0, 1⟩ ∨ + y = z + 1 + ⟨0, 1⟩) → (y ∈ FootprintVertices T)) ) := by + classical + intro T z hz y hy + rw [FootprintVertices, ite_eq_left ⟨z, hz⟩] + exact ⟨z, hz, hy⟩ + +private theorem diagonalCover : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin 3), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (h0 + : PartialOdometer), ∀ (h0' : PartialOdometer), ∀ (x : GaussianInt), (x ∈ h0.domain) → + ((x ∈ h0'.domain) → ((∀ (y : GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x + - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt) → y ∈ h0.domain ∨ y ∈ h0'.domain) → (∀ (u : GaussianInt), (x + ∈ FootprintVertices T0 ∩ FootprintVertices T0') → (((x - u).re = if i = (0 : Fin (3 : + ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) → (((if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else + (↑P.q₂ : ℤ)) ≤ (x - u).im) → (((x - u).im ≤ (↑P.q : ℤ)) → (∀ (U : ProtoTile), ∀ (V : + ProtoTile), (x ∈ U.cells ∧ x - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ∈ V.cells ∨ x - (1 : GaussianInt) ∈ U.cells ∧ x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ∈ V.cells ∨ x - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ U.cells ∧ x + ∈ V.cells ∨ x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ U.cells ∧ x - (1 : GaussianInt) + ∈ V.cells) → ((∀ (T : ProtoTile), ∀ (z : GaussianInt), (z ∈ T.cells) → (∀ (y : + GaussianInt), (y = z ∨ y = z + 1 ∨ y = z + ⟨0, 1⟩ ∨ y = z + 1 + ⟨0, 1⟩) → (y ∈ + FootprintVertices T))) → (∀ (A : ProtoTile), ∀ (B : ProtoTile), ((x ∈ A.cells ∧ x - 1 + - ⟨0, 1⟩ ∈ B.cells) ∨ (x - 1 ∈ A.cells ∧ x - ⟨0, 1⟩ ∈ B.cells)) → x ∈ + FootprintVertices A ∧ x ∈ FootprintVertices B ∧ ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ FootprintVertices A ∨ y ∈ FootprintVertices + B))))))))) ) := by + classical + intro P i T0 T0' h0 h0' x hx0 hx0' hstar u hxfoot hxr hxl hxu U V hdiag corner A B + rintro (⟨hA, hB⟩ | ⟨hA, hB⟩) + · refine ⟨corner A x hA x (Or.inl rfl), + corner B _ hB x (Or.inr (Or.inr (Or.inr (by abel)))), ?_⟩ + intro y hy + rcases hy with rfl | rfl | rfl | rfl | rfl + · exact Or.inl (corner A _ hA _ (Or.inl rfl)) + · exact Or.inl (corner A _ hA _ (Or.inr (Or.inl rfl))) + · exact Or.inr (corner B _ hB _ (Or.inr (Or.inr (Or.inl (by abel))))) + · exact Or.inl (corner A _ hA _ (Or.inr (Or.inr (Or.inl rfl)))) + · exact Or.inr (corner B _ hB _ (Or.inr (Or.inl (by abel)))) + · refine ⟨corner A _ hA x (Or.inr (Or.inl (by abel))), + corner B _ hB x (Or.inr (Or.inr (Or.inl (by abel)))), ?_⟩ + intro y hy + rcases hy with rfl | rfl | rfl | rfl | rfl + · exact Or.inl (corner A _ hA _ (Or.inr (Or.inl (by abel)))) + · exact Or.inr (corner B _ hB _ (Or.inr (Or.inr (Or.inr (by abel))))) + · exact Or.inl (corner A _ hA _ (Or.inl rfl)) + · exact Or.inl (corner A _ hA _ (Or.inr (Or.inr (Or.inr (by abel))))) + · exact Or.inr (corner B _ hB _ (Or.inl rfl)) + +private theorem hfootcover : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (U : ProtoTile), ∀ (V : ProtoTile), (x ∈ U.cells ∧ x - (1 : + GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ V.cells ∨ x - (1 : GaussianInt) ∈ + U.cells ∧ x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ V.cells ∨ x - (1 : GaussianInt) - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ U.cells ∧ x ∈ V.cells ∨ x - (⟨(0 : ℤ), (1 : ℤ)⟩ + : GaussianInt) ∈ U.cells ∧ x - (1 : GaussianInt) ∈ V.cells) → ((∀ (A : ProtoTile), ∀ + (B : ProtoTile), ((x ∈ A.cells ∧ x - 1 - ⟨0, 1⟩ ∈ B.cells) ∨ (x - 1 ∈ A.cells ∧ x - + ⟨0, 1⟩ ∈ B.cells)) → x ∈ FootprintVertices A ∧ x ∈ FootprintVertices B ∧ ∀ y, y = x ∨ + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ FootprintVertices A ∨ y + ∈ FootprintVertices B) → (x ∈ FootprintVertices U ∧ x ∈ FootprintVertices V ∧ ∀ y, y + = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ FootprintVertices + U ∨ y ∈ FootprintVertices V)) ) := by + classical + intro x U V hdiag diagonalCover + rcases hdiag with hd | hd | hd | hd + · exact diagonalCover U V (Or.inl hd) + · exact diagonalCover U V (Or.inr hd) + · obtain ⟨hV, hU, hcov⟩ := diagonalCover V U (Or.inl ⟨hd.2, hd.1⟩) + exact ⟨hU, hV, fun y hy => (hcov y hy).symm⟩ + · obtain ⟨hV, hU, hcov⟩ := diagonalCover V U (Or.inr ⟨hd.2, hd.1⟩) + exact ⟨hU, hV, fun y hy => (hcov y hy).symm⟩ + +end FordStarGeometry + +theorem FordOpposingBoundaryStarLocalization + (P : FordFareyParameter) + (hq : ProperBandQuadruple (FordRecursiveQuadruple P)) + (C0 Ci : BandCircle) (i : Fin 3) + (hC0 : (FordRecursiveQuadruple P) 0 = C0.1.1) + (hCi : (FordRecursiveQuadruple P) i.succ = Ci.1.1) + (T0 T0' : ProtoTile) (h0 h0' : PartialOdometer) + (hO0 : TileOdometer C0.1.1 T0 h0) + (hO0' : TileOdometer C0.1.1 T0' h0') + (hlarge : 1 < Ci.1.1.1) + (p0 p0' : Real × Real) + (hs0 : PartialOdometerSlope h0 = some p0) + (hs0' : PartialOdometerSlope h0' = some p0') + (hcentroid : TileCentroid T0' - TileCentroid T0 = + GaussianRealPoint + (BandVectors.1 ((FordRecursiveQuadruple P) i.succ) + ((FordRecursiveQuadruple P) 0))) + (hslope : p0' - p0 = + GaussianRealPoint + (BandVectors.2 ((FordRecursiveQuadruple P) i.succ) + ((FordRecursiveQuadruple P) 0))) + (x : GaussianInt) (hx0 : x ∈ h0.domain) (hx0' : x ∈ h0'.domain) + (hstar : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h0.domain ∨ y ∈ h0'.domain) : + ∃ (U V : ProtoTile) (g k : PartialOdometer), + AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0 ∧ + AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0' ∧ + LeftLatticeAdjacent Ci U V g k ∧ + x ∈ g.domain ∧ x ∈ k.domain ∧ + ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ g.domain ∨ y ∈ k.domain := by +-- BODY + classical + obtain ⟨hi2, hroot, hrpos, hne, u, hc, hc', hdis, hsegment⟩ := + P4158T1MatchedFordPair P C0 Ci i hC0 hCi T0 T0' h0 h0' hO0 hO0' + hlarge hcentroid + have hdom0 := PositiveCurvatureTileOdometerDomain C0.1.1 T0 h0 C0.2 hO0 + have hdom0' := PositiveCurvatureTileOdometerDomain C0.1.1 T0' h0' C0.2 hO0' + have hxfoot := FordStarGeometry.hxfoot T0 T0' h0 h0' x hx0 hx0' hdom0 hdom0' + obtain ⟨hxr, hxl, hxu⟩ := (hsegment x).mp hxfoot + have squareCell (n : Nat) (v z : GaussianInt) : + z ∈ (TileTranslation (FordTile n) v).cells ↔ + 0 ≤ (z - v).re ∧ (z - v).re < (n : Int) ∧ + 0 ≤ (z - v).im ∧ (z - v).im < (n : Int) := FordStarGeometry.squareCell P Ci i x u n v z + have hsum : (P.q : Int) = (P.q₁ : Int) + P.q₂ := by exact_mod_cast P.sum_q + have hchosen : ∃ (U V : ProtoTile) (g k : PartialOdometer), + AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0 ∧ + AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0' ∧ + LeftLatticeAdjacent Ci U V g k ∧ + ((x ∈ U.cells ∧ x - 1 - ⟨0, 1⟩ ∈ V.cells) ∨ + (x - 1 ∈ U.cells ∧ x - ⟨0, 1⟩ ∈ V.cells) ∨ + (x - 1 - ⟨0, 1⟩ ∈ U.cells ∧ x ∈ V.cells) ∨ + (x - ⟨0, 1⟩ ∈ U.cells ∧ x - 1 ∈ V.cells)) := by + have smaller := FordStarGeometry.smaller P hq C0 Ci i hC0 hCi T0 T0' h0 h0' hO0 hO0' hlarge + p0 p0' hs0 hs0' hcentroid hslope x hrpos u hc hc' hdis hsegment hxr hxl hxu + fin_cases i + · by_cases horder : P.q₂ < P.q₁ + · obtain ⟨U, V, g, k, s, t, Q, hAg, hAk, hUg, hVk, hsg, htk, + hUc, hVc, hUV, hst, hQq, hQr, hQp, hQp1, hQ0, hQlarge⟩ := + P4158T1LargeFirstRestrictions P hq C0 Ci hC0 hCi hlarge horder + T0 T0' h0 h0' hO0 hO0' p0 p0' hs0 hs0' hslope u hc (by simpa using hc') + have cfg := (FordCoordinateConfiguration Q).2 hQlarge + have hleft := FordStarGeometry.hleftAt319 P Ci horder U V g k s t Q hUg hVk hsg htk hUV + hst hQq hQr hQp hQp1 hQ0 cfg + refine ⟨U, V, g, k, hAg, hAk, hleft, Or.inr (Or.inr (Or.inl ⟨?_, ?_⟩))⟩ + · rw [hUc, squareCell] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one] at hxr hxl hxu ⊢ + have hspos := P.q₂_pos + norm_num at hxr hxl hxu ⊢ + omega + · rw [hVc, squareCell] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] at hxr hxl hxu ⊢ + norm_num at hxr hxl hxu ⊢ + omega + · exact smaller (Or.inl ⟨rfl, by omega⟩) + · by_cases horder : P.q₁ < P.q₂ + · obtain ⟨U, V, g, k, s, t, Q, hAg, hAk, hUg, hVk, hsg, htk, + hUc, hVc, hUV, hst, hQq, hQs, hQp, hQp2, hQ0, hQlarge⟩ := + P4158T1LargeSecondRestrictions P hq C0 Ci hC0 hCi hlarge horder + T0 T0' h0 h0' hO0 hO0' p0 p0' hs0 hs0' hslope u hc (by simpa using hc') + have cfg := (FordCoordinateConfiguration Q).2 hQlarge + have hleft := FordStarGeometry.hleftAt345 P Ci horder U V g k s t Q hUg hVk hsg htk hUV + hst hQq hQs hQp hQp2 hQ0 cfg + refine ⟨U, V, g, k, hAg, hAk, hleft, Or.inr (Or.inr (Or.inr ⟨?_, ?_⟩))⟩ + · rw [hUc, squareCell] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] at hxr hxl hxu ⊢ + norm_num at hxr hxl hxu ⊢ + omega + · rw [hVc, squareCell] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one] at hxr hxl hxu ⊢ + norm_num at hxr hxl hxu ⊢ + omega + · exact smaller (Or.inr ⟨rfl, by omega⟩) + · exact (hi2 rfl).elim + obtain ⟨U, V, g, k, hAg, hAk, hleft, hdiag⟩ := hchosen + have hdomU := PositiveCurvatureTileOdometerDomain Ci.1.1 U g Ci.2 hleft.1 + have hdomV := PositiveCurvatureTileOdometerDomain Ci.1.1 V k Ci.2 hleft.2.1 + have hfootcover : x ∈ FootprintVertices U ∧ x ∈ FootprintVertices V ∧ + ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ + y = x - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V := + FordStarGeometry.hfootcover x U V hdiag (FordStarGeometry.diagonalCover P i T0 T0' h0 + h0' x hx0 hx0' hstar u hxfoot hxr hxl hxu U V hdiag (FordStarGeometry.corner)) + refine ⟨U, V, g, k, hAg, hAk, hleft, ?_, ?_, ?_⟩ + · change x ∈ (g.domain : Set GaussianInt) + rw [hdomU] + exact hfootcover.1 + · change x ∈ (k.domain : Set GaussianInt) + rw [hdomV] + exact hfootcover.2.1 + · intro y hy + rcases hfootcover.2.2 y hy with hU | hV + · left; change y ∈ (g.domain : Set GaussianInt); rwa [hdomU] + · right; change y ∈ (k.domain : Set GaussianInt); rwa [hdomV] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean new file mode 100644 index 0000000000..76cb0ecd62 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean @@ -0,0 +1,2221 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleSwapLast +public import Mathlib.Data.List.Chain +public import LeanPool.ApollonianSuperharmonic.P5269T1FordSquareNormalForm +public import LeanPool.ApollonianSuperharmonic.P5269T1CenteredSquareTripleTransport + +-- [TABLET NODE: FordOrientedChildParentEndpoints] + +/-! +# FordOrientedChildParentEndpoints + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FordEndpointProof + +private theorem obs : + (by + classical + exact + (FordFareyParameter) → ( + let rect : Int → Int → Int → Set GaussianInt := fun a b n => + {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} + ∀ (T : ProtoTile), ∀ (a : Int), ∀ (b : Int), ∀ (n : Int), (0 < n) → ((∀ z : GaussianInt, + z ∈ T.cells ↔ + a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + n) → (FootprintVertices T = rect a b + n ∧ FootprintEdges T = edges (rect a b n)))) ) := by + classical + intro P rect adj edges T a b n hn hc + have hne : T.cells.Nonempty := ⟨⟨a,b⟩, (hc _).mpr (by dsimp; omega)⟩ + have hv (z : GaussianInt) : z ∈ FootprintVertices T ↔ z ∈ rect a b n := by + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + constructor + · rintro ⟨x, hx, hz⟩ + have hx := (hc x).mp hx + rcases hz with rfl | rfl | rfl | rfl <;> + dsimp [rect] <;> omega + · intro hz + change a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n at hz + let x : GaussianInt := ⟨min z.re (a+n-1), min z.im (b+n-1)⟩ + refine ⟨x, (hc x).mpr ?_, ?_⟩ + · dsimp [x]; omega + · simp only [Zsqrtd.ext_iff, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one] + dsimp [x] + omega + refine ⟨Set.ext hv, ?_⟩ + have he (z : GaussianInt) (hz : z ∈ rect a b n) + (hw : z + 1 ∈ rect a b n) : {z, z+1} ∈ FootprintEdges T := by + change a ≤ z.re ∧ z.re ≤ a+n ∧ b ≤ z.im ∧ z.im ≤ b+n at hz + change a ≤ (z+1).re ∧ (z+1).re ≤ a+n ∧ + b ≤ (z+1).im ∧ (z+1).im ≤ b+n at hw + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one] at hw + by_cases ht : z.im < b+n + · exact ⟨z, (hc z).mpr (by omega), Or.inl rfl⟩ + · refine ⟨z-⟨0,1⟩, (hc _).mpr ?_, Or.inr (Or.inr (Or.inr ?_))⟩ + · simp only [Zsqrtd.re_sub, Zsqrtd.im_sub]; omega + · congr 1 <;> abel + have ve (z : GaussianInt) (hz : z ∈ rect a b n) + (hw : z + ⟨0,1⟩ ∈ rect a b n) : + {z, z+⟨0,1⟩} ∈ FootprintEdges T := by + change a ≤ z.re ∧ z.re ≤ a+n ∧ b ≤ z.im ∧ z.im ≤ b+n at hz + change a ≤ (z+⟨0,1⟩).re ∧ (z+⟨0,1⟩).re ≤ a+n ∧ + b ≤ (z+⟨0,1⟩).im ∧ (z+⟨0,1⟩).im ≤ b+n at hw + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at hw + by_cases ht : z.re < a+n + · exact ⟨z, (hc z).mpr (by omega), Or.inr (Or.inl rfl)⟩ + · refine ⟨z-1, (hc _).mpr ?_, Or.inr (Or.inr (Or.inl ?_))⟩ + · simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one]; omega + · congr 1 <;> abel + ext e + constructor + · rintro ⟨z, hz, heq⟩ + have hz' := (hc z).mp hz + rcases heq with rfl | rfl | rfl | rfl + all_goals + refine ⟨_, ?_, _, ?_, ?_, rfl⟩ + · dsimp [rect]; omega + · dsimp [rect]; omega + · simp [adj, add_assoc, add_comm, add_left_comm] + · rintro ⟨x, hx, y, hy, hxy, rfl⟩ + rcases hxy with rfl | rfl | rfl | rfl + · exact he x hx hy + · have h := he (x-1) hy (by simpa using hx) + simpa [Finset.pair_comm] using h + · exact ve x hx hy + · have h := ve (x-⟨0,1⟩) hy (by simpa using hx) + simpa [Finset.pair_comm] using h + +private theorem edge_inter : + (by + classical + exact + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} + ∀ (V : Set GaussianInt), ∀ (W : Set GaussianInt), edges V ∩ edges W = edges (V ∩ W) ) := by + classical + intro adj edges V W + ext e + constructor + · rintro ⟨⟨x,hx,y,hy,hxy,rfl⟩, ⟨u,hu,v,hv,huv,he⟩⟩ + have hall : ∀ z ∈ ({x,y} : Finset GaussianInt), z ∈ W := by + intro z hz + rw [he] at hz + have hz' : z = u ∨ z = v := by simpa only [Finset.mem_insert, Finset.mem_singleton] using hz + rcases hz' with rfl | rfl + · exact hu + · exact hv + exact ⟨x,⟨hx,hall x (by simp)⟩,y,⟨hy,hall y (by simp)⟩,hxy,rfl⟩ + · rintro ⟨x,hx,y,hy,hxy,rfl⟩ + exact ⟨⟨x,hx.1,y,hy.1,hxy,rfl⟩, ⟨x,hx.2,y,hy.2,hxy,rfl⟩⟩ + +private theorem linepath : + (by + classical + exact + (FordFareyParameter) → ( + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} + ∀ (f : Nat → GaussianInt), ∀ (n : Nat), (0 < n) → ((Function.Injective f) → ((∀ k, adj (f + k) (f (k+1))) → ((∀ j, ∀ k, adj (f j) (f k) → k = j+1 ∨ j = k+1) → + (SimpleGridPathBetween (f '' Set.Icc 0 n) (edges (f '' Set.Icc 0 n)) (f 0) (f n)))))) + ) := by + classical + intro P adj edges f n hn hf hs ha + let p := (List.range (n+1)).map f + have hm (z : GaussianInt) : z ∈ p ↔ z ∈ f '' Set.Icc 0 n := by + simp [p] + have chain : p.IsChain adj := by + apply (List.isChain_map f).mpr + exact (List.isChain_range_succ _ n).mpr (fun k hk => hs k) + have step : ∀ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ → adj a b := by + exact List.isChain_iff_forall_rel_of_append_cons_cons.mp chain + have occurs (k : Nat) (hk : k < n) : + ∃ l₁ l₂, p = l₁ ++ f k :: f (k+1) :: l₂ := by + have hk' : k < p.length := by simp [p]; omega + have hk'' : k+1 < p.length := by simp [p]; omega + refine ⟨p.take k, p.drop (k+2), ?_⟩ + conv_lhs => rw [← List.take_append_drop k p] + rw [List.drop_eq_getElem_cons hk', List.drop_eq_getElem_cons hk''] + simp [p] + refine ⟨p, List.nodup_range.map hf, by simp [p]; omega, + ?_, ?_, ?_, step, ?_⟩ + · simp [p, List.range_succ_eq_map] + · simp [p, List.range_succ] + · ext z; simpa using (hm z).symm + · intro e + constructor + · rintro ⟨x,hx,y,hy,hxy,rfl⟩ + rcases hx with ⟨j,hj,rfl⟩ + rcases hy with ⟨k,hk,rfl⟩ + rcases ha j k hxy with rfl | rfl + · rcases occurs j (by have := hk.2; omega) with ⟨l₁,l₂,hp⟩ + exact ⟨f j,f (j+1),l₁,l₂,hp,rfl⟩ + · rcases occurs k (by have := hj.2; omega) with ⟨l₁,l₂,hp⟩ + exact ⟨f k,f (k+1),l₁,l₂,hp,Finset.pair_comm _ _⟩ + · rintro ⟨x,y,l₁,l₂,hp,rfl⟩ + exact ⟨x, (hm x).mp (by rw [hp]; simp), + y, (hm y).mp (by rw [hp]; simp), step x y l₁ l₂ hp, rfl⟩ + +private theorem horizontal : + (by + classical + exact + (FordFareyParameter) → ( + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} + (∀ (f : Nat → GaussianInt), ∀ (n : Nat), (0 < n) → ((Function.Injective f) → ((∀ k, adj + (f k) (f (k+1))) → ((∀ j, ∀ k, adj (f j) (f k) → k = j+1 ∨ j = k+1) → + (SimpleGridPathBetween (f '' Set.Icc 0 n) (edges (f '' Set.Icc 0 n)) (f 0) (f n)))))) + → (∀ (l : Int), ∀ (h : Int), ∀ (b : Int), (l < h) → (SimpleGridPathBetween {z : + GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = b} (edges {z : GaussianInt | l ≤ z.re ∧ + z.re ≤ h ∧ z.im = b}) ⟨l,b⟩ ⟨h,b⟩))) ) := by + classical + intro P adj edges linepath l h b hlh + let f := fun k : Nat => (⟨l+k,b⟩ : GaussianInt) + let n := (h-l).toNat + have hn : (n : Int) = h-l := by dsimp [n]; omega + have hV : f '' Set.Icc 0 n = + {z : GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = b} := by + ext z + constructor + · rintro ⟨k,⟨_,hk⟩,rfl⟩; dsimp [f]; omega + · rintro ⟨hzl,hzh,hzb⟩ + refine ⟨(z.re-l).toNat, ?_, ?_⟩ + · constructor <;> omega + · apply Zsqrtd.ext <;> dsimp [f] <;> omega + have hp := linepath f n (by omega) + (by intro j k he; have := congrArg Zsqrtd.re he; dsimp [f] at this; omega) + (by intro k; left; ext <;> simp [f, add_assoc]) + (by intro j k ha; simp [adj, f, Zsqrtd.ext_iff] at ha; omega) + simpa [hV, f, hn] using hp + +private theorem vertical : + (by + classical + exact + (FordFareyParameter) → ( + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} + (∀ (f : Nat → GaussianInt), ∀ (n : Nat), (0 < n) → ((Function.Injective f) → ((∀ k, adj + (f k) (f (k+1))) → ((∀ j, ∀ k, adj (f j) (f k) → k = j+1 ∨ j = k+1) → + (SimpleGridPathBetween (f '' Set.Icc 0 n) (edges (f '' Set.Icc 0 n)) (f 0) (f n)))))) + → (∀ (l : Int), ∀ (h : Int), ∀ (a : Int), (l < h) → (SimpleGridPathBetween {z : + GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = a} (edges {z : GaussianInt | l ≤ z.im ∧ + z.im ≤ h ∧ z.re = a}) ⟨a,l⟩ ⟨a,h⟩))) ) := by + classical + intro P adj edges linepath l h a hlh + let f := fun k : Nat => (⟨a,l+k⟩ : GaussianInt) + let n := (h-l).toNat + have hn : (n : Int) = h-l := by dsimp [n]; omega + have hV : f '' Set.Icc 0 n = + {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = a} := by + ext z + constructor + · rintro ⟨k,⟨_,hk⟩,rfl⟩; dsimp [f]; omega + · rintro ⟨hzl,hzh,hza⟩ + refine ⟨(z.im-l).toNat, ?_, ?_⟩ + · constructor <;> omega + · apply Zsqrtd.ext <;> dsimp [f] <;> omega + have hp := linepath f n (by omega) + (by intro j k he; have := congrArg Zsqrtd.im he; dsimp [f] at this; omega) + (by intro k; right; right; left; ext <;> simp [f, add_assoc]) + (by intro j k ha; simp [adj, f, Zsqrtd.ext_iff] at ha; omega) + simpa [hV, f, hn] using hp + +private theorem reverse_path : + (by + classical + exact + ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween V E y x) + ) := by + classical + intro V E x y hp + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + rcases hp with ⟨p,hn,hl,hh,ht,hV,hs,he⟩ + have revstep : ∀ a b l₁ l₂, p.reverse = l₁ ++ a :: b :: l₂ → adj a b := by + intro a b l₁ l₂ h + have h' : p = l₂.reverse ++ b :: a :: l₁.reverse := by + have := congrArg List.reverse h + simpa [List.reverse_append, List.append_assoc] using this + rcases hs b a _ _ h' with h | h | h | h + · exact Or.inr (Or.inl (by rw [h]; simp)) + · exact Or.inl (by rw [h]; simp) + · exact Or.inr (Or.inr (Or.inr (by rw [h]; simp))) + · exact Or.inr (Or.inr (Or.inl (by rw [h]; simp))) + have revocc (p : List GaussianInt) (e : Finset GaussianInt) : + (∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = {a,b}) → + ∃ a b l₁ l₂, p.reverse = l₁ ++ a :: b :: l₂ ∧ e = {a,b} := by + rintro ⟨a,b,l₁,l₂,rfl,rfl⟩ + exact ⟨b,a,l₂.reverse,l₁.reverse,by simp [List.reverse_append,List.append_assoc], + Finset.pair_comm _ _⟩ + refine ⟨p.reverse, List.nodup_reverse.mpr hn, by simpa using hl, + by simpa using ht, by simpa using hh, by simpa using hV, revstep, ?_⟩ + intro e + exact ⟨fun h => revocc p e ((he e).mp h), + fun h => (he e).mpr (by simpa using revocc p.reverse e h)⟩ + +private theorem fordcell : + (by + classical + exact + (FordFareyParameter) → (∀ (n : Nat), ∀ (z : GaussianInt), z ∈ (FordTile n).cells ↔ 0 ≤ + z.re ∧ z.re < n ∧ 0 ≤ z.im ∧ z.im < n) ) := by + classical + intro P n z + change z ∈ ((Finset.range n).product (Finset.range n)).image + (fun a => (⟨(a.1:Int),(a.2:Int)⟩ : GaussianInt)) ↔ _ + rw [Finset.mem_image] + constructor + · rintro ⟨⟨j,k⟩,hjk,rfl⟩ + have hjk := Finset.mem_product.mp hjk + simp only [Finset.mem_range] at hjk + dsimp; omega + · rintro ⟨h0,h1,h2,h3⟩ + exact ⟨(z.re.toNat,z.im.toNat), + Finset.mem_product.mpr ⟨Finset.mem_range.mpr (by omega), + Finset.mem_range.mpr (by omega)⟩, + by ext <;> dsimp <;> omega⟩ + +private theorem sqcell : + (by + classical + exact + (FordFareyParameter) → ((∀ (n : Nat), ∀ (z : GaussianInt), z ∈ (FordTile n).cells ↔ 0 ≤ + z.re ∧ z.re < n ∧ 0 ≤ z.im ∧ z.im < n) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + ∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (z : GaussianInt), z ∈ (sq n a b).cells ↔ a ≤ + z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n)) ) := by + classical + intro P fordcell sq n a b z + change z ∈ (FordTile n).cells.image (GaussianTranslation ⟨a,b⟩) ↔ _ + constructor + · rintro hz + rcases Finset.mem_image.mp hz with ⟨x,hx,rfl⟩ + have hx := (fordcell n x).mp hx + dsimp [GaussianTranslation]; omega + · intro hz + exact Finset.mem_image.mpr ⟨z-⟨a,b⟩, (fordcell n _).mpr (by dsimp; omega), by simp + [GaussianTranslation]⟩ + +private theorem fordcent : + (by + classical + exact + (FordFareyParameter) → ((∀ (n : Nat), ∀ (z : GaussianInt), z ∈ (FordTile n).cells ↔ 0 ≤ + z.re ∧ z.re < n ∧ 0 ≤ z.im ∧ z.im < n) → (∀ (n : Nat), (0 < n) → (TileCentroid + (FordTile n) = ((n:Real)/2,(n:Real)/2)))) ) := by + classical + intro P fordcell n hn + let R := TileTranslation (TileQuarterTurn (FordTile n)) ⟨n,0⟩ + have hc : R.cells = (FordTile n).cells := by + ext z + change z ∈ ((FordTile n).cells.image (fun x => GaussianQuarterTurn x - 1)).image + (GaussianTranslation ⟨n,0⟩) ↔ _ + rw [Finset.image_image, fordcell] + constructor + · rintro hz + rcases Finset.mem_image.mp hz with ⟨x,hx,hz⟩ + have hx := (fordcell n x).mp hx + have hr := congrArg Zsqrtd.re hz + have hi := congrArg Zsqrtd.im hz + dsimp [GaussianTranslation, GaussianQuarterTurn, Function.comp_def] at hr hi + omega + · intro hz + refine Finset.mem_image.mpr ⟨⟨z.im,(n:Int)-1-z.re⟩, (fordcell n _).mpr ?_, ?_⟩ + · dsimp; omega + · ext <;> simp [GaussianTranslation,GaussianQuarterTurn]; omega + have hne : (FordTile n).cells.Nonempty := + ⟨0,(fordcell n 0).mpr (by simp; omega)⟩ + have he : TileCentroid R = TileCentroid (FordTile n) := + (ProtoTileObservableExtensionality R (FordTile n) hc + (by intro h; rw [hc] at h; exact (hne.ne_empty h).elim)).2.2.2.2 + rw [(TileTranslationFormulas _ _).2.2.2.2.1, + (TileQuarterTurnFormulas _).2.2.2.2.1] at he + apply Prod.ext + · have h1 := congrArg Prod.fst he + have h2 := congrArg Prod.snd he + norm_num at h1 h2 ⊢; linarith + · have h1 := congrArg Prod.fst he + have h2 := congrArg Prod.snd he + norm_num at h1 h2 ⊢; linarith + +private theorem sqcent : + (by + classical + exact + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + (∀ (n : Nat), (0 < n) → (TileCentroid (FordTile n) = ((n:Real)/2,(n:Real)/2))) → (∀ (n : + Nat), ∀ (a : Int), ∀ (b : Int), (0 < n) → (TileCentroid (sq n a b) = + ((a:Real)+(n:Real)/2,(b:Real)+(n:Real)/2))) ) := by + classical + intro sq fordcent n a b hn + rw [(TileTranslationFormulas _ _).2.2.2.2.1,fordcent n hn] + dsimp + congr 1 <;> ring + +private theorem hpH : + (by + classical + exact + let rect : Int → Int → Int → Set GaussianInt := fun a b n => + {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} + (∀ (V : Set GaussianInt), ∀ (W : Set GaussianInt), edges V ∩ edges W = edges (V ∩ W)) → + ((∀ (l : Int), ∀ (h : Int), ∀ (b : Int), (l < h) → (SimpleGridPathBetween {z : + GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = b} (edges {z : GaussianInt | l ≤ z.re ∧ + z.re ≤ h ∧ z.im = b}) ⟨l,b⟩ ⟨h,b⟩)) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), (0 < n) → (FootprintVertices (sq n a b) = rect a + b n ∧ FootprintEdges (sq n a b) = edges (rect a b n))) → (∀ (n : Nat), ∀ (m : Nat), ∀ + (a : Int), ∀ (b : Int), ∀ (c : Int), ∀ (d : Int), ∀ (l : Int), ∀ (h : Int), ∀ (y : + Int), (0 < n) → ((0 < m) → ((l < h) → ((rect a b n ∩ rect c d m = {z : GaussianInt | + l ≤ z.re ∧ z.re ≤ h ∧ z.im = y}) → (SimpleGridPathBetween (FootprintVertices (sq n a + b) ∩ FootprintVertices (sq m c d)) (FootprintEdges (sq n a b) ∩ FootprintEdges (sq m + c d)) ⟨l,y⟩ ⟨h,y⟩))))))) ) := by + classical + intro rect adj edges edge_inter horizontal sq sqobs n m a b c d l h y hn hm hlh hv + rw [(sqobs n a b hn).1,(sqobs m c d hm).1, + (sqobs n a b hn).2,(sqobs m c d hm).2,edge_inter,hv] + exact horizontal l h y hlh + +private theorem hpV : + (by + classical + exact + let rect : Int → Int → Int → Set GaussianInt := fun a b n => + {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} + (∀ (V : Set GaussianInt), ∀ (W : Set GaussianInt), edges V ∩ edges W = edges (V ∩ W)) → + ((∀ (l : Int), ∀ (h : Int), ∀ (a : Int), (l < h) → (SimpleGridPathBetween {z : + GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = a} (edges {z : GaussianInt | l ≤ z.im ∧ + z.im ≤ h ∧ z.re = a}) ⟨a,l⟩ ⟨a,h⟩)) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), (0 < n) → (FootprintVertices (sq n a b) = rect a + b n ∧ FootprintEdges (sq n a b) = edges (rect a b n))) → (∀ (n : Nat), ∀ (m : Nat), ∀ + (a : Int), ∀ (b : Int), ∀ (c : Int), ∀ (d : Int), ∀ (l : Int), ∀ (h : Int), ∀ (x : + Int), (0 < n) → ((0 < m) → ((l < h) → ((rect a b n ∩ rect c d m = {z : GaussianInt | + l ≤ z.im ∧ z.im ≤ h ∧ z.re = x}) → (SimpleGridPathBetween (FootprintVertices (sq n a + b) ∩ FootprintVertices (sq m c d)) (FootprintEdges (sq n a b) ∩ FootprintEdges (sq m + c d)) ⟨x,l⟩ ⟨x,h⟩))))))) ) := by + classical + intro rect adj edges edge_inter vertical sq sqobs n m a b c d l h x hn hm hlh hv + rw [(sqobs n a b hn).1,(sqobs m c d hm).1, + (sqobs n a b hn).2,(sqobs m c d hm).2,edge_inter,hv] + exact vertical l h x hlh + +private theorem ledger0 : + (by + classical + exact + (FordFareyParameter) → ( + let rect : Int → Int → Int → Set GaussianInt := fun a b n => + {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} + (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween V E y x)) + → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), (0 < n) → (FootprintVertices (sq n a b) = rect a + b n ∧ FootprintEdges (sq n a b) = edges (rect a b n))) → ((∀ (n : Nat), ∀ (m : Nat), + ∀ (a : Int), ∀ (b : Int), ∀ (c : Int), ∀ (d : Int), ∀ (l : Int), ∀ (h : Int), ∀ (y : + Int), (0 < n) → ((0 < m) → ((l < h) → ((rect a b n ∩ rect c d m = {z : GaussianInt | + l ≤ z.re ∧ z.re ≤ h ∧ z.im = y}) → (SimpleGridPathBetween (FootprintVertices (sq n a + b) ∩ FootprintVertices (sq m c d)) (FootprintEdges (sq n a b) ∩ FootprintEdges (sq m + c d)) ⟨l,y⟩ ⟨h,y⟩))))) → ((∀ (n : Nat), ∀ (m : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (c : + Int), ∀ (d : Int), ∀ (l : Int), ∀ (h : Int), ∀ (x : Int), (0 < n) → ((0 < m) → ((l < + h) → ((rect a b n ∩ rect c d m = {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = x}) + → (SimpleGridPathBetween (FootprintVertices (sq n a b) ∩ FootprintVertices (sq m c + d)) (FootprintEdges (sq n a b) ∩ FootprintEdges (sq m c d)) ⟨x,l⟩ ⟨x,h⟩))))) → (∀ (r + : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∃ R : ExactTileInterfaceTriple (sq (r+s) 0 + 0) (sq (r+s) (-(s:Int)) (-(r+s:Int))) (sq s (-(s:Int)) 0), ∃ I : + ExactTileInterfaceTriple (sq (r+s) 0 0) (sq (r+s) (-(r+s:Int)) s) (sq s (-(s:Int)) + 0), ∃ A : ExactTileInterfaceTriple (sq (r+s) 0 0) (sq s (-(s:Int)) 0) (sq r + (-(r:Int)) s), R.point = ⟨0,0⟩ ∧ I.point = ⟨0,s⟩ ∧ A.point = ⟨0,s⟩ ∧ R.otherCA = + ⟨0,s⟩ ∧ I.otherCA = ⟨0,0⟩ ∧ A.otherAB = ⟨0,0⟩ ∧ A.otherCA = ⟨0,r+s⟩))))))) ) := by + classical + intro P rect adj edges reverse_path sq sqobs hpH hpV r s hr hs + have hq : 0 < r+s := by omega + have ca := hpV s (r+s) (-(s:Int)) 0 0 0 0 s 0 hs hq (by omega) + (by ext z; simp only [rect, Set.mem_inter_iff, Set.mem_ofPred_eq, Nat.cast_add]; omega) + have az := hpV r (r+s) (-(r:Int)) s 0 0 s (r+s) 0 hr hq (by omega) + (by ext z; simp only [rect, Set.mem_inter_iff, Set.mem_ofPred_eq, Nat.cast_add]; omega) + let R : ExactTileInterfaceTriple (sq (r+s) 0 0) + (sq (r+s) (-(s:Int)) (-(r+s:Int))) (sq s (-(s:Int)) 0) := + { point := ⟨0,0⟩ + otherAB := ⟨r,0⟩ + otherBC := ⟨-(s:Int),0⟩ + otherCA := ⟨0,s⟩ + pathAB := hpH _ _ _ _ _ _ 0 r 0 hq hq (by omega) + (by ext z; simp only [rect, Set.mem_inter_iff, Set.mem_ofPred_eq, Nat.cast_add]; omega) + pathBC := reverse_path (hpH _ _ _ _ _ _ (-(s:Int)) 0 0 hq hs (by omega) + (by ext z; simp only [rect, Set.mem_inter_iff, Set.mem_ofPred_eq, Nat.cast_add]; omega)) + pathCA := ca + unique_common := by + intro z + rw [(sqobs _ _ _ hq).1,(sqobs _ _ _ hq).1,(sqobs _ _ _ hs).1] + simp only [Set.mem_inter_iff, Zsqrtd.ext_iff] + dsimp [rect] + omega } + let I : ExactTileInterfaceTriple (sq (r+s) 0 0) + (sq (r+s) (-(r+s:Int)) s) (sq s (-(s:Int)) 0) := + { point := ⟨0,s⟩ + otherAB := ⟨0,r+s⟩ + otherBC := ⟨-(s:Int),s⟩ + otherCA := ⟨0,0⟩ + pathAB := hpV _ _ _ _ _ _ s (r+s) 0 hq hq (by omega) + (by ext z; simp only [rect, Set.mem_inter_iff, Set.mem_ofPred_eq, Nat.cast_add]; omega) + pathBC := reverse_path (hpH _ _ _ _ _ _ (-(s:Int)) 0 s hq hs (by omega) + (by ext z; simp only [rect, Set.mem_inter_iff, Set.mem_ofPred_eq, Nat.cast_add]; omega)) + pathCA := reverse_path ca + unique_common := by + intro z + rw [(sqobs _ _ _ hq).1,(sqobs _ _ _ hq).1,(sqobs _ _ _ hs).1] + simp only [Set.mem_inter_iff, Zsqrtd.ext_iff] + dsimp [rect] + omega } + let A : ExactTileInterfaceTriple (sq (r+s) 0 0) + (sq s (-(s:Int)) 0) (sq r (-(r:Int)) s) := + { point := ⟨0,s⟩ + otherAB := ⟨0,0⟩ + otherBC := ⟨-min (r:Int) s,s⟩ + otherCA := ⟨0,r+s⟩ + pathAB := by simpa only [Set.inter_comm] using reverse_path ca + pathBC := reverse_path (hpH _ _ _ _ _ _ (-min (r:Int) s) 0 s hs hr (by omega) + (by ext z; simp only [rect, Set.mem_inter_iff, Set.mem_ofPred_eq]; omega)) + pathCA := az + unique_common := by + intro z + rw [(sqobs _ _ _ hq).1,(sqobs _ _ _ hs).1,(sqobs _ _ _ hr).1] + simp only [Set.mem_inter_iff, Zsqrtd.ext_iff] + dsimp [rect] + omega } + exact ⟨R,I,A,rfl,rfl,rfl,rfl,rfl,rfl,rfl⟩ + +private theorem ledger1 : + (by + classical + exact + (FordFareyParameter) → ( + let rect : Int → Int → Int → Set GaussianInt := fun a b n => + {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} + (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween V E y x)) + → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), (0 < n) → (FootprintVertices (sq n a b) = rect a + b n ∧ FootprintEdges (sq n a b) = edges (rect a b n))) → ((∀ (n : Nat), ∀ (m : Nat), + ∀ (a : Int), ∀ (b : Int), ∀ (c : Int), ∀ (d : Int), ∀ (l : Int), ∀ (h : Int), ∀ (y : + Int), (0 < n) → ((0 < m) → ((l < h) → ((rect a b n ∩ rect c d m = {z : GaussianInt | + l ≤ z.re ∧ z.re ≤ h ∧ z.im = y}) → (SimpleGridPathBetween (FootprintVertices (sq n a + b) ∩ FootprintVertices (sq m c d)) (FootprintEdges (sq n a b) ∩ FootprintEdges (sq m + c d)) ⟨l,y⟩ ⟨h,y⟩))))) → ((∀ (n : Nat), ∀ (m : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (c : + Int), ∀ (d : Int), ∀ (l : Int), ∀ (h : Int), ∀ (x : Int), (0 < n) → ((0 < m) → ((l < + h) → ((rect a b n ∩ rect c d m = {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = x}) + → (SimpleGridPathBetween (FootprintVertices (sq n a b) ∩ FootprintVertices (sq m c + d)) (FootprintEdges (sq n a b) ∩ FootprintEdges (sq m c d)) ⟨x,l⟩ ⟨x,h⟩))))) → ((∀ (r + : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∃ R : ExactTileInterfaceTriple (sq (r+s) 0 + 0) (sq (r+s) (-(s:Int)) (-(r+s:Int))) (sq s (-(s:Int)) 0), ∃ I : + ExactTileInterfaceTriple (sq (r+s) 0 0) (sq (r+s) (-(r+s:Int)) s) (sq s (-(s:Int)) + 0), ∃ A : ExactTileInterfaceTriple (sq (r+s) 0 0) (sq s (-(s:Int)) 0) (sq r + (-(r:Int)) s), R.point = ⟨0,0⟩ ∧ I.point = ⟨0,s⟩ ∧ A.point = ⟨0,s⟩ ∧ R.otherCA = + ⟨0,s⟩ ∧ I.otherCA = ⟨0,0⟩ ∧ A.otherAB = ⟨0,0⟩ ∧ A.otherCA = ⟨0,r+s⟩))) → (∀ (r : + Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∃ R : ExactTileInterfaceTriple (sq (r+s) 0 + 0) (sq (r+s) (-(r:Int)) (r+s)) (sq r (-(r:Int)) s), ∃ I : ExactTileInterfaceTriple + (sq (r+s) 0 0) (sq (r+s) (-(r+s:Int)) (-(r:Int))) (sq r (-(r:Int)) s), ∃ A : + ExactTileInterfaceTriple (sq (r+s) 0 0) (sq r (-(r:Int)) s) (sq s (-(s:Int)) 0), + R.point = ⟨0,r+s⟩ ∧ I.point = ⟨0,s⟩ ∧ A.point = ⟨0,s⟩ ∧ R.otherCA = ⟨0,s⟩ ∧ I.otherCA + = ⟨0,r+s⟩ ∧ A.otherAB = ⟨0,r+s⟩)))))))) ) := by + classical + intro P rect adj edges reverse_path sq sqobs hpH hpV ledger0 r s hr hs + have hq : 0 < r+s := by omega + have ca := hpV r (r+s) (-(r:Int)) s 0 0 s (r+s) 0 hr hq (by omega) + (by ext z; simp only [rect, Set.mem_inter_iff, Set.mem_ofPred_eq, Nat.cast_add]; omega) + let R : ExactTileInterfaceTriple (sq (r+s) 0 0) + (sq (r+s) (-(r:Int)) (r+s)) (sq r (-(r:Int)) s) := + { point := ⟨0,r+s⟩ + otherAB := ⟨s,r+s⟩ + otherBC := ⟨-(r:Int),r+s⟩ + otherCA := ⟨0,s⟩ + pathAB := hpH _ _ _ _ _ _ 0 s (r+s) hq hq (by omega) + (by ext z; simp only [rect, Set.mem_inter_iff, Set.mem_ofPred_eq, Nat.cast_add]; omega) + pathBC := reverse_path (hpH _ _ _ _ _ _ (-(r:Int)) 0 (r+s) hq hr (by omega) + (by ext z; simp only [rect, Set.mem_inter_iff, Set.mem_ofPred_eq, Nat.cast_add]; omega)) + pathCA := reverse_path ca + unique_common := by + intro z + rw [(sqobs _ _ _ hq).1,(sqobs _ _ _ hq).1,(sqobs _ _ _ hr).1] + simp only [Set.mem_inter_iff, Zsqrtd.ext_iff] + dsimp [rect] + omega } + let I : ExactTileInterfaceTriple (sq (r+s) 0 0) + (sq (r+s) (-(r+s:Int)) (-(r:Int))) (sq r (-(r:Int)) s) := + { point := ⟨0,s⟩ + otherAB := ⟨0,0⟩ + otherBC := ⟨-(r:Int),s⟩ + otherCA := ⟨0,r+s⟩ + pathAB := reverse_path (hpV _ _ _ _ _ _ 0 s 0 hq hq (by omega) + (by ext z; simp only [rect, Set.mem_inter_iff, Set.mem_ofPred_eq, Nat.cast_add]; omega)) + pathBC := reverse_path (hpH _ _ _ _ _ _ (-(r:Int)) 0 s hq hr (by omega) + (by ext z; simp only [rect, Set.mem_inter_iff, Set.mem_ofPred_eq, Nat.cast_add]; omega)) + pathCA := ca + unique_common := by + intro z + rw [(sqobs _ _ _ hq).1,(sqobs _ _ _ hq).1,(sqobs _ _ _ hr).1] + simp only [Set.mem_inter_iff, Zsqrtd.ext_iff] + dsimp [rect] + omega } + obtain ⟨_,_,A,_,_,ha,_,_,hab,hac⟩ := ledger0 r s hr hs + obtain ⟨A',hap,hab',hbc',hca'⟩ := ExactTileInterfaceTripleSwapLast _ _ _ A + refine ⟨R,I,A',rfl,rfl,hap.trans ha,rfl,rfl,?_⟩ + exact hab'.trans hac + +private theorem base0 : + (by + classical + exact + (FordFareyParameter) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + (∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∃ R : ExactTileInterfaceTriple (sq (r+s) + 0 0) (sq (r+s) (-(s:Int)) (-(r+s:Int))) (sq s (-(s:Int)) 0), ∃ I : + ExactTileInterfaceTriple (sq (r+s) 0 0) (sq (r+s) (-(r+s:Int)) s) (sq s (-(s:Int)) + 0), ∃ A : ExactTileInterfaceTriple (sq (r+s) 0 0) (sq s (-(s:Int)) 0) (sq r + (-(r:Int)) s), R.point = ⟨0,0⟩ ∧ I.point = ⟨0,s⟩ ∧ A.point = ⟨0,s⟩ ∧ R.otherCA = + ⟨0,s⟩ ∧ I.otherCA = ⟨0,0⟩ ∧ A.otherAB = ⟨0,0⟩ ∧ A.otherCA = ⟨0,r+s⟩))) → ( + let package := fun U UR UL W Z : ProtoTile => + ∃ R : ExactTileInterfaceTriple U UR W, + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ + I.otherCA = R.point ∧ A.otherAB = R.point + ∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (package (sq (r+s) 0 0) (sq (r+s) + (-(s:Int)) (-(r+s:Int))) (sq (r+s) (-(r+s:Int)) s) (sq s (-(s:Int)) 0) (sq r + (-(r:Int)) s))))) ) := by + classical + intro P sq ledger0 package r s hr hs + obtain ⟨R,I,A,hR,hI,hA,hRC,hIC,hAB,_⟩ := ledger0 r s hr hs + refine ⟨R,I,A,?_,hA.trans hI.symm,hRC.trans hI.symm, + hIC.trans hR.symm,hAB.trans hR.symm⟩ + intro he + rw [hR,hI] at he + have := congrArg Zsqrtd.im he + dsimp at this + omega + +private theorem base1 : + (by + classical + exact + (FordFareyParameter) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + (∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∃ R : ExactTileInterfaceTriple (sq (r+s) + 0 0) (sq (r+s) (-(r:Int)) (r+s)) (sq r (-(r:Int)) s), ∃ I : ExactTileInterfaceTriple + (sq (r+s) 0 0) (sq (r+s) (-(r+s:Int)) (-(r:Int))) (sq r (-(r:Int)) s), ∃ A : + ExactTileInterfaceTriple (sq (r+s) 0 0) (sq r (-(r:Int)) s) (sq s (-(s:Int)) 0), + R.point = ⟨0,r+s⟩ ∧ I.point = ⟨0,s⟩ ∧ A.point = ⟨0,s⟩ ∧ R.otherCA = ⟨0,s⟩ ∧ I.otherCA + = ⟨0,r+s⟩ ∧ A.otherAB = ⟨0,r+s⟩))) → ( + let package := fun U UR UL W Z : ProtoTile => + ∃ R : ExactTileInterfaceTriple U UR W, + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ + I.otherCA = R.point ∧ A.otherAB = R.point + ∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (package (sq (r+s) 0 0) (sq (r+s) + (-(r:Int)) (r+s)) (sq (r+s) (-(r+s:Int)) (-(r:Int))) (sq r (-(r:Int)) s) (sq s + (-(s:Int)) 0))))) ) := by + classical + intro P sq ledger1 package r s hr hs + obtain ⟨R,I,A,hR,hI,hA,hRC,hIC,hAB⟩ := ledger1 r s hr hs + refine ⟨R,I,A,?_,hA.trans hI.symm,hRC.trans hI.symm, + hIC.trans hR.symm,hAB.trans hR.symm⟩ + intro he + rw [hR,hI] at he + have := congrArg Zsqrtd.im he + dsimp at this + omega + +private theorem sameobs : + (by + classical + exact + (FordFareyParameter) → ( + let rect : Int → Int → Int → Set GaussianInt := fun a b n => + {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} + (∀ (T : ProtoTile), ∀ (a : Int), ∀ (b : Int), ∀ (n : Int), (0 < n) → ((∀ z : GaussianInt, + z ∈ T.cells ↔ a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + n) → (FootprintVertices + T = rect a b n ∧ FootprintEdges T = edges (rect a b n)))) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (z : GaussianInt), z ∈ (sq n a b).cells ↔ a ≤ + z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n) → ((∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), + (0 < n) → ((sq n a b).cells.Nonempty)) → ((∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), (0 + < n) → (TileCentroid (sq n a b) = ((a:Real)+(n:Real)/2,(b:Real)+(n:Real)/2))) → (∀ (T + : ProtoTile), ∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), (0 < n) → ((T.cells = (sq n a + b).cells) → (FootprintVertices T = rect a b n ∧ FootprintEdges T = edges (rect a b n) + ∧ TileCentroid T = ((a:Real)+(n:Real)/2,(b:Real)+(n:Real)/2)))))))) ) := by + classical + intro P rect adj edges obs sq sqcell sqne sqcent T n a b hn hc + have h := obs T a b n (by omega) (by intro z; rw [hc]; exact sqcell n a b z) + have ht : T.cells.Nonempty := hc ▸ sqne n a b hn + refine ⟨h.1,h.2,?_⟩ + have he : TileCentroid T = TileCentroid (sq n a b) := + (ProtoTileObservableExtensionality _ _ hc (by intro he; exact (ht.ne_empty he).elim)).2.2.2.2 + exact he.trans (sqcent n a b hn) + +private theorem carry_squares : + (by + classical + exact + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + let package := fun U UR UL W Z : ProtoTile => + ∃ R : ExactTileInterfaceTriple U UR W, + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ + I.otherCA = R.point ∧ A.otherAB = R.point + let ax := fun (q : Int) (flip : Bool) (t a n : Int) => + (if flip then q-a-n else a)+t + ∀ (q : Int), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin 5 → Nat), ∀ (X : Fin 5 → + Int), ∀ (Y : Fin 5 → Int), (∀ k, 0 < N k) → (∀ (T : Fin 5 → ProtoTile), (∀ k, (T + k).cells = + (sq (N k) (ax q flip t.re (X k) (N k)) + (ax q flip t.im (Y k) (N k))).cells) → ((package (sq (N 0) (X 0) (Y 0)) (sq (N 1) + (X 1) (Y 1)) + (sq (N 2) (X 2) (Y 2)) (sq (N 3) (X 3) (Y 3)) (sq (N 4) (X 4) (Y 4))) → (package (T + 0) (T 1) (T 2) (T 3) (T 4)))) ) := by + classical + intro sq package ax q flip t N X Y hN T hc hp + let affine := fun (q : Int) (flip : Bool) (t : GaussianInt) (z : GaussianInt) => + (if flip then (⟨q,q⟩ : GaussianInt) - z else z) + t + have image (a b c : Fin 5) + (E : ExactTileInterfaceTriple (sq (N a) (X a) (Y a)) + (sq (N b) (X b) (Y b)) (sq (N c) (X c) (Y c))) : + ∃ E' : ExactTileInterfaceTriple (T a) (T b) (T c), + E'.point = affine q flip t E.point ∧ + E'.otherAB = affine q flip t E.otherAB ∧ + E'.otherBC = affine q flip t E.otherBC ∧ + E'.otherCA = affine q flip t E.otherCA := by + apply P5269T1CenteredSquareTripleTransport q flip t + ![N a,N b,N c] ![⟨X a,Y a⟩,⟨X b,Y b⟩,⟨X c,Y c⟩] + (by intro k; fin_cases k <;> simp only [ + ] <;> exact hN _) ![T a,T b,T c] _ E + intro k + fin_cases k + · cases flip <;> exact hc a + · cases flip <;> exact hc b + · cases flip <;> exact hc c + obtain ⟨R,I,A,hne,hAI,hRI,hIR,hAR⟩ := hp + obtain ⟨R',hR,hRab,hRbc,hRca⟩ := image 0 1 3 R + obtain ⟨I',hI,hIab,hIbc,hIca⟩ := image 0 2 3 I + obtain ⟨A',hA,hAab,hAbc,hAca⟩ := image 0 3 4 A + refine ⟨R',I',A',?_,?_,?_,?_,?_⟩ + · rw [hR,hI] + intro h + apply hne + cases flip <;> simpa [affine] using h + · rw [hA,hI,hAI] + · rw [hRca,hI,hRI] + · rw [hIca,hR,hIR] + · rw [hAab,hR,hAR] + +private theorem translate_cells : + (by + classical + exact + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + ∀ (T : ProtoTile), ∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (u : GaussianInt), (T.cells = + (sq n a b).cells) → ((TileTranslation T u).cells = (sq n (a+u.re) (b+u.im)).cells) ) + := by + classical + intro sq T n a b u hc + change T.cells.image (GaussianTranslation u) = _ + rw [hc] + simp only [sq,TileTranslation,Finset.image_image] + apply Finset.image_congr + intro z hz + ext <;> simp [GaussianTranslation,add_assoc] + +private theorem finish0 : + (by + classical + exact + (FordFareyParameter) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + let package := fun U UR UL W Z : ProtoTile => + ∃ R : ExactTileInterfaceTriple U UR W, + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ + I.otherCA = R.point ∧ A.otherAB = R.point + (∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (package (sq (r+s) 0 0) (sq (r+s) + (-(s:Int)) (-(r+s:Int))) (sq (r+s) (-(r+s:Int)) s) (sq s (-(s:Int)) 0) (sq r + (-(r:Int)) s)))) → ( + let ax := fun (q : Int) (flip : Bool) (t a n : Int) => + (if flip then q-a-n else a)+t + (∀ (q : Int), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin 5 → Nat), ∀ (X : Fin 5 → + Int), ∀ (Y : Fin 5 → Int), (∀ k, 0 < N k) → (∀ (T : Fin 5 → ProtoTile), (∀ k, (T + k).cells = (sq (N k) (ax q flip t.re (X k) (N k)) (ax q flip t.im (Y k) (N + k))).cells) → ((package (sq (N 0) (X 0) (Y 0)) (sq (N 1) (X 1) (Y 1)) (sq (N 2) (X 2) + (Y 2)) (sq (N 3) (X 3) (Y 3)) (sq (N 4) (X 4) (Y 4))) → (package (T 0) (T 1) (T 2) (T + 3) (T 4))))) → ((∀ (T : ProtoTile), ∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (u : + GaussianInt), (T.cells = (sq n a b).cells) → ((TileTranslation T u).cells = (sq n + (a+u.re) (b+u.im)).cells)) → (∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∀ (a : + Int), ∀ (b : Int), ∀ (flip : Bool), ∀ (U : ProtoTile), ∀ (W : ProtoTile), ∀ (Z : + ProtoTile), (U.cells = (sq (r+s) a b).cells) → ((W.cells = (sq s (if flip then + a+(r+s:Int) else a-s) + (if flip then b+r else b)).cells) → ((Z.cells = (sq r (if flip then a+(r+s:Int) else + a-r) + (if flip then b else b+s)).cells) → (package U (TileTranslation U (if flip then + ⟨s,r+s⟩ else ⟨-(s:Int),-(r+s:Int)⟩)) (TileTranslation U (if flip then + ⟨r+s,-(s:Int)⟩ else ⟨-(r+s:Int),s⟩)) W Z))))))))) ) := by + classical + intro P sq package base0 ax carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ + refine carry_squares (r+s) flip ⟨a,b⟩ ![r+s,r+s,r+s,s,r] + ![0,-(s:Int),-(r+s:Int),-(s:Int),-(r:Int)] + ![0,-(r+s:Int),s,0,s] ?_ + ![U,TileTranslation U (if flip then ⟨s,r+s⟩ else ⟨-(s:Int),-(r+s:Int)⟩), + TileTranslation U (if flip then ⟨r+s,-(s:Int)⟩ else ⟨-(r+s:Int),s⟩),W,Z] ?_ + (base0 r s hr hs) + · intro k; fin_cases k <;> simp <;> omega + · intro k + fin_cases k + · cases flip <;> simpa [ax] using hU + · have h := translate_cells U (r+s) a b + (if flip then ⟨s,r+s⟩ else ⟨-(s:Int),-(r+s:Int)⟩) hU + cases flip <;> simpa [ax,sub_eq_add_neg,add_comm,add_left_comm,add_assoc] using h + · have h := translate_cells U (r+s) a b + (if flip then ⟨r+s,-(s:Int)⟩ else ⟨-(r+s:Int),s⟩) hU + cases flip <;> convert h using 1 <;> congr 2 <;> dsimp [ax] <;> omega + · cases flip <;> simpa [ax,sub_eq_add_neg,add_comm,add_left_comm,add_assoc] using hW + · cases flip <;> simpa [ax,sub_eq_add_neg,add_comm,add_left_comm,add_assoc] using hZ + +private theorem finish1 : + (by + classical + exact + (FordFareyParameter) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + let package := fun U UR UL W Z : ProtoTile => + ∃ R : ExactTileInterfaceTriple U UR W, + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ + I.otherCA = R.point ∧ A.otherAB = R.point + (∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (package (sq (r+s) 0 0) (sq (r+s) + (-(r:Int)) (r+s)) (sq (r+s) (-(r+s:Int)) (-(r:Int))) (sq r (-(r:Int)) s) (sq s + (-(s:Int)) 0)))) → ( + let ax := fun (q : Int) (flip : Bool) (t a n : Int) => + (if flip then q-a-n else a)+t + (∀ (q : Int), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin 5 → Nat), ∀ (X : Fin 5 → + Int), ∀ (Y : Fin 5 → Int), (∀ k, 0 < N k) → (∀ (T : Fin 5 → ProtoTile), (∀ k, (T + k).cells = (sq (N k) (ax q flip t.re (X k) (N k)) (ax q flip t.im (Y k) (N + k))).cells) → ((package (sq (N 0) (X 0) (Y 0)) (sq (N 1) (X 1) (Y 1)) (sq (N 2) (X 2) + (Y 2)) (sq (N 3) (X 3) (Y 3)) (sq (N 4) (X 4) (Y 4))) → (package (T 0) (T 1) (T 2) (T + 3) (T 4))))) → ((∀ (T : ProtoTile), ∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (u : + GaussianInt), (T.cells = (sq n a b).cells) → ((TileTranslation T u).cells = (sq n + (a+u.re) (b+u.im)).cells)) → (∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∀ (a : + Int), ∀ (b : Int), ∀ (flip : Bool), ∀ (U : ProtoTile), ∀ (W : ProtoTile), ∀ (Z : + ProtoTile), (U.cells = (sq (r+s) a b).cells) → ((W.cells = (sq r (if flip then + a+(r+s:Int) else a-r) + (if flip then b else b+s)).cells) → ((Z.cells = (sq s (if flip then a+(r+s:Int) else + a-s) + (if flip then b+r else b)).cells) → (package U (TileTranslation U (if flip then + ⟨r,-(r+s:Int)⟩ else ⟨-(r:Int),r+s⟩)) (TileTranslation U (if flip then ⟨r+s,r⟩ + else ⟨-(r+s:Int),-(r:Int)⟩)) W Z))))))))) ) := by + classical + intro P sq package base1 ax carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ + refine carry_squares (r+s) flip ⟨a,b⟩ ![r+s,r+s,r+s,r,s] + ![0,-(r:Int),-(r+s:Int),-(r:Int),-(s:Int)] + ![0,r+s,-(r:Int),s,0] ?_ + ![U,TileTranslation U (if flip then ⟨r,-(r+s:Int)⟩ else ⟨-(r:Int),r+s⟩), + TileTranslation U (if flip then ⟨r+s,r⟩ else ⟨-(r+s:Int),-(r:Int)⟩),W,Z] ?_ + (base1 r s hr hs) + · intro k; fin_cases k <;> simp <;> omega + · intro k + fin_cases k + · cases flip <;> simpa [ax] using hU + · have h := translate_cells U (r+s) a b + (if flip then ⟨r,-(r+s:Int)⟩ else ⟨-(r:Int),r+s⟩) hU + cases flip <;> convert h using 1 <;> congr 2 <;> dsimp [ax] <;> omega + · have h := translate_cells U (r+s) a b + (if flip then ⟨r+s,r⟩ else ⟨-(r+s:Int),-(r:Int)⟩) hU + cases flip <;> simpa [ax,sub_eq_add_neg,add_comm,add_left_comm,add_assoc] using h + · cases flip <;> simpa [ax,sub_eq_add_neg,add_comm,add_left_comm,add_assoc] using hW + · cases flip <;> simpa [ax,sub_eq_add_neg,add_comm,add_left_comm,add_assoc] using hZ + +private theorem hrAt727 : + (by + classical + exact + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((Fin (3 : ℕ)) → ((Fin (4 : ℕ)) → (0 < + P.q₁))) ) := by + classical + intro P hq i s + by_contra h + have hz : P.q₁ = 0 := by omega + have hd := P.det₁ + simp [hz] at hd + have hdv : (P.q : Int) ∣ 1 := ⟨P.p₁, by simpa [mul_comm] using hd.symm⟩ + have hone := Int.eq_one_of_dvd_one (by omega : 0 ≤ (P.q:Int)) hdv + omega + +private theorem h01 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : + GaussianInt)) → ((∀ (j : Fin (3 : ℕ)), BandVectors.1 (FordRecursiveQuadruple P (0 : + Fin (4 : ℕ))) (FordRecursiveQuadruple P j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + * BandVectors.1 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin (4 + : ℕ)))) → (BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) + 1) = ⟨-(P.q₁:Int),P.q⟩)) ) := by + classical + intro P h10 hf + have h := (hf 0).1 + change BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) 1) = (⟨0,1⟩ : GaussianInt) * + BandVectors.1 ((FordRecursiveQuadruple P) 1) ((FordRecursiveQuadruple P) 0) at h + rw [h10] at h + exact h.trans (by ext <;> simp) + +private theorem h02 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : + GaussianInt)) → ((∀ (j : Fin (3 : ℕ)), BandVectors.1 (FordRecursiveQuadruple P (0 : + Fin (4 : ℕ))) (FordRecursiveQuadruple P j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + * BandVectors.1 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin (4 + : ℕ)))) → (BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) + 2) = ⟨-(P.q₂:Int),-(P.q:Int)⟩)) ) := by + classical + intro P h20 hf + have h := (hf 1).1 + change BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) 2) = (⟨0,1⟩ : GaussianInt) * + BandVectors.1 ((FordRecursiveQuadruple P) 2) ((FordRecursiveQuadruple P) 0) at h + rw [h20] at h + exact h.trans (by ext <;> simp) + +private theorem norm1 : + (by + classical + exact + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + (P.q₁ ≠ 0) → (∀ (T : ProtoTile), (BandPrototile ((FordRecursiveQuadruple P) 1) T) → (∃ a + b : Int, T.cells = (sq P.q₁ a b).cells))) ) := by + classical + intro P hq sq hr0 T hT + obtain ⟨w, hw⟩ := P5269T1FordSquareNormalForm P hq 1 T hT + (by simp [FordRecursiveQuadruple, FordCircleCoordinate, hr0] ) + exact ⟨w.re, w.im, hw⟩ + +private theorem norm2 : + (by + classical + exact + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + (0 < P.q₂) → (∀ (T : ProtoTile), (BandPrototile ((FordRecursiveQuadruple P) 2) T) → (∃ a + b : Int, T.cells = (sq P.q₂ a b).cells))) ) := by + classical + intro P hq sq hs T hT + obtain ⟨w, hw⟩ := P5269T1FordSquareNormalForm P hq 2 T hT + (by simp? [FordRecursiveQuadruple, FordCircleCoordinate]; positivity) + exact ⟨w.re, w.im, hw⟩ + +private theorem indices : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : ProtoTile), + ∀ (W : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (FordRecursiveQuadruple P + i.succ) W) → ((BandPrototile (FordRecursiveQuadruple P (if Even (↑s : ℕ) then i - (1 + : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < + (FordRecursiveQuadruple P i.succ).1) → (((0 : ℤ) < (FordRecursiveQuadruple P (if Even + (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → + ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ)))) → ((TileCentroid Z - + TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ))) (FordRecursiveQuadruple P (i - (1 : Fin (3 : ℕ))).succ) - BandVectors.1 + (FordRecursiveQuadruple P (i - (1 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (0 + : Fin (4 : ℕ))) else BandVectors.1 (FordRecursiveQuadruple P (i + (1 : Fin (3 : + ℕ))).succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - BandVectors.1 + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (i + (1 : Fin + (3 : ℕ))).succ))) → ((Even s.val ∧ i = 1) ∨ (¬Even s.val ∧ i = 0))))))) ) := by + classical + intro P i s U W Z hW hZ hWpos hZpos hcw hcz + by_cases hE : Even s.val + · left + refine ⟨hE,?_⟩ + fin_cases i + · have hh := hZpos + rw [ite_eq_left hE] at hh + have hi : ((0:Fin 3)-1).succ = 3 := by decide + change 0 < (FordRecursiveQuadruple P ((0:Fin 3)-1).succ).1 at hh + rw [hi] at hh + exact (lt_irrefl 0 hh).elim + · rfl + · have hh := hWpos + norm_num [FordRecursiveQuadruple] at hh + · right + refine ⟨hE,?_⟩ + fin_cases i + · rfl + · have hh := hZpos + rw [ite_eq_right hE] at hh + have hi : ((1:Fin 3)+1).succ = 3 := by decide + change 0 < (FordRecursiveQuadruple P ((1:Fin 3)+1).succ).1 at hh + rw [hi] at hh + exact (lt_irrefl 0 hh).elim + · have hh := hWpos + norm_num [FordRecursiveQuadruple] at hh + +private theorem hwaAt806 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (wa : ℤ), ∀ (wb : ℤ), ((↑wa : ℝ) + + (↑P.q₂ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * (-(↑P.q : + ℝ) + -(↑P.q₂ : ℝ)) ∧ (↑wb : ℝ) + (↑P.q₂ : ℝ) / (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 + : ℝ)) = (1 / 2 : ℝ) * ((↑P.q₂ : ℝ) + -(↑P.q : ℝ))) → (wa = a-(P.q₂:Int)) ) := by + classical + intro P a b wa wb hcw + apply Int.cast_injective (α := Real) + push_cast + linarith [hcw.1] + +private theorem hwbAt810 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (wa : ℤ), ∀ (wb : ℤ), ((↑wa : ℝ) + + (↑P.q₂ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * (-(↑P.q : + ℝ) + -(↑P.q₂ : ℝ)) ∧ (↑wb : ℝ) + (↑P.q₂ : ℝ) / (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 + : ℝ)) = (1 / 2 : ℝ) * ((↑P.q₂ : ℝ) + -(↑P.q : ℝ))) → (wb = b) ) := by + classical + intro P a b wa wb hcw + apply Int.cast_injective (α := Real) + linarith [hcw.2] + +private theorem hzaAt813 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (za : ℤ), ∀ (zb : ℤ), ((↑za : ℝ) + + (↑P.q₁ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * (-(↑P.q₁ : + ℝ) - (↑P.q : ℝ)) ∧ (↑zb : ℝ) + (↑P.q₁ : ℝ) / (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 : + ℝ)) = (1 / 2 : ℝ) * ((↑P.q : ℝ) - (↑P.q₁ : ℝ))) → (za = a-(P.q₁:Int)) ) := by + classical + intro P a b za zb hcz + apply Int.cast_injective (α := Real) + push_cast + linarith [hcz.1] + +private theorem hzbAt817 : + (by + classical + exact + ∀ (P : FordFareyParameter), ((P.q:Real) = (P.q₁:Real)+(P.q₂:Real)) → (∀ (a : ℤ), ∀ (b : + ℤ), ∀ (za : ℤ), ∀ (zb : ℤ), ((↑za : ℝ) + (↑P.q₁ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : + ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * (-(↑P.q₁ : ℝ) - (↑P.q : ℝ)) ∧ (↑zb : ℝ) + (↑P.q₁ : ℝ) / + (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * ((↑P.q : ℝ) - (↑P.q₁ : + ℝ))) → (zb = b+(P.q₂:Int))) ) := by + classical + intro P hqsR a b za zb hcz + apply Int.cast_injective (α := Real) + push_cast + linarith [hcz.2] + +private theorem hwaAt838 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (wa : ℤ), ∀ (wb : ℤ), ((↑wa : ℝ) + + (↑P.q₂ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * ((↑P.q₂ : + ℝ) + (↑P.q : ℝ)) ∧ (↑wb : ℝ) + (↑P.q₂ : ℝ) / (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 : + ℝ)) = (1 / 2 : ℝ) * ((↑P.q : ℝ) + -(↑P.q₂ : ℝ))) → (wa = a+(P.q:Int)) ) := by + classical + intro P a b wa wb hcw + apply Int.cast_injective (α := Real) + push_cast + linarith [hcw.1] + +private theorem hwbAt842 : + (by + classical + exact + ∀ (P : FordFareyParameter), ((P.q:Real) = (P.q₁:Real)+(P.q₂:Real)) → (∀ (a : ℤ), ∀ (b : + ℤ), ∀ (wa : ℤ), ∀ (wb : ℤ), ((↑wa : ℝ) + (↑P.q₂ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : + ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * ((↑P.q₂ : ℝ) + (↑P.q : ℝ)) ∧ (↑wb : ℝ) + (↑P.q₂ : ℝ) / + (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * ((↑P.q : ℝ) + -(↑P.q₂ : + ℝ))) → (wb = b+(P.q₁:Int))) ) := by + classical + intro P hqsR a b wa wb hcw + apply Int.cast_injective (α := Real) + push_cast + linarith [hcw.2] + +private theorem hzaAt846 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (za : ℤ), ∀ (zb : ℤ), ((↑za : ℝ) + + (↑P.q₁ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * ((↑P.q : ℝ) + + (↑P.q₁ : ℝ)) ∧ (↑zb : ℝ) + (↑P.q₁ : ℝ) / (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 : + ℝ)) = (1 / 2 : ℝ) * ((↑P.q₁ : ℝ) - (↑P.q : ℝ))) → (za = a+(P.q:Int)) ) := by + classical + intro P a b za zb hcz + apply Int.cast_injective (α := Real) + push_cast + linarith [hcz.1] + +private theorem hzbAt850 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (za : ℤ), ∀ (zb : ℤ), ((↑za : ℝ) + + (↑P.q₁ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * ((↑P.q : ℝ) + + (↑P.q₁ : ℝ)) ∧ (↑zb : ℝ) + (↑P.q₁ : ℝ) / (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 : + ℝ)) = (1 / 2 : ℝ) * ((↑P.q₁ : ℝ) - (↑P.q : ℝ))) → (zb = b) ) := by + classical + intro P a b za zb hcz + apply Int.cast_injective (α := Real) + linarith [hcz.2] + +private theorem hwaAt881 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (wa : ℤ), ∀ (wb : ℤ), ((↑wa : ℝ) + + (↑P.q₁ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * (-(↑P.q : + ℝ) + -(↑P.q₁ : ℝ)) ∧ (↑wb : ℝ) + (↑P.q₁ : ℝ) / (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 + : ℝ)) = (1 / 2 : ℝ) * ((↑P.q : ℝ) + -(↑P.q₁ : ℝ))) → (wa = a-(P.q₁:Int)) ) := by + classical + intro P a b wa wb hcw + apply Int.cast_injective (α := Real) + push_cast + linarith [hcw.1] + +private theorem hwbAt885 : + (by + classical + exact + ∀ (P : FordFareyParameter), ((P.q:Real) = (P.q₁:Real)+(P.q₂:Real)) → (∀ (a : ℤ), ∀ (b : + ℤ), ∀ (wa : ℤ), ∀ (wb : ℤ), ((↑wa : ℝ) + (↑P.q₁ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : + ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * (-(↑P.q : ℝ) + -(↑P.q₁ : ℝ)) ∧ (↑wb : ℝ) + (↑P.q₁ : ℝ) + / (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * ((↑P.q : ℝ) + -(↑P.q₁ : + ℝ))) → (wb = b+(P.q₂:Int))) ) := by + classical + intro P hqsR a b wa wb hcw + apply Int.cast_injective (α := Real) + push_cast + linarith [hcw.2] + +private theorem hzaAt889 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (za : ℤ), ∀ (zb : ℤ), ((↑za : ℝ) + + (↑P.q₂ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * (-(↑P.q : + ℝ) + -(↑P.q₂ : ℝ)) ∧ (↑zb : ℝ) + (↑P.q₂ : ℝ) / (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 + : ℝ)) = (1 / 2 : ℝ) * (-(↑P.q : ℝ) + (↑P.q₂ : ℝ))) → (za = a-(P.q₂:Int)) ) := by + classical + intro P a b za zb hcz + apply Int.cast_injective (α := Real) + push_cast + linarith [hcz.1] + +private theorem hzbAt893 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (za : ℤ), ∀ (zb : ℤ), ((↑za : ℝ) + + (↑P.q₂ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * (-(↑P.q : + ℝ) + -(↑P.q₂ : ℝ)) ∧ (↑zb : ℝ) + (↑P.q₂ : ℝ) / (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 + : ℝ)) = (1 / 2 : ℝ) * (-(↑P.q : ℝ) + (↑P.q₂ : ℝ))) → (zb = b) ) := by + classical + intro P a b za zb hcz + apply Int.cast_injective (α := Real) + linarith [hcz.2] + +private theorem hwaAt917 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (wa : ℤ), ∀ (wb : ℤ), ((↑wa : ℝ) + + (↑P.q₁ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * ((↑P.q₁ : + ℝ) + (↑P.q : ℝ)) ∧ (↑wb : ℝ) + (↑P.q₁ : ℝ) / (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 : + ℝ)) = (1 / 2 : ℝ) * ((↑P.q₁ : ℝ) + -(↑P.q : ℝ))) → (wa = a+(P.q:Int)) ) := by + classical + intro P a b wa wb hcw + apply Int.cast_injective (α := Real) + push_cast + linarith [hcw.1] + +private theorem hwbAt921 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (wa : ℤ), ∀ (wb : ℤ), ((↑wa : ℝ) + + (↑P.q₁ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * ((↑P.q₁ : + ℝ) + (↑P.q : ℝ)) ∧ (↑wb : ℝ) + (↑P.q₁ : ℝ) / (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 : + ℝ)) = (1 / 2 : ℝ) * ((↑P.q₁ : ℝ) + -(↑P.q : ℝ))) → (wb = b) ) := by + classical + intro P a b wa wb hcw + apply Int.cast_injective (α := Real) + linarith [hcw.2] + +private theorem hzaAt924 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (za : ℤ), ∀ (zb : ℤ), ((↑za : ℝ) + + (↑P.q₂ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * ((↑P.q₂ : + ℝ) + (↑P.q : ℝ)) ∧ (↑zb : ℝ) + (↑P.q₂ : ℝ) / (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 : + ℝ)) = (1 / 2 : ℝ) * (-(↑P.q₂ : ℝ) + (↑P.q : ℝ))) → (za = a+(P.q:Int)) ) := by + classical + intro P a b za zb hcz + apply Int.cast_injective (α := Real) + push_cast + linarith [hcz.1] + +private theorem hzbAt928 : + (by + classical + exact + ∀ (P : FordFareyParameter), ((P.q:Real) = (P.q₁:Real)+(P.q₂:Real)) → (∀ (a : ℤ), ∀ (b : + ℤ), ∀ (za : ℤ), ∀ (zb : ℤ), ((↑za : ℝ) + (↑P.q₂ : ℝ) / (2 : ℝ) - ((↑a : ℝ) + (↑P.q : + ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * ((↑P.q₂ : ℝ) + (↑P.q : ℝ)) ∧ (↑zb : ℝ) + (↑P.q₂ : ℝ) / + (2 : ℝ) - ((↑b : ℝ) + (↑P.q : ℝ) / (2 : ℝ)) = (1 / 2 : ℝ) * (-(↑P.q₂ : ℝ) + (↑P.q : + ℝ))) → (zb = b+(P.q₁:Int))) ) := by + classical + intro P hqsR a b za zb hcz + apply Int.cast_injective (α := Real) + push_cast + linarith [hcz.2] + +end FordEndpointProof + +namespace FordEndpointAssembly + +private theorem obs : + (by + classical + exact + (FordFareyParameter) → (∀ (T : ProtoTile), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (n : ℤ), (0 : ℤ) < n → + (∀ (z : GaussianInt), z ∈ T.cells ↔ a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + + n) → FootprintVertices T = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b n ∧ FootprintEdges T = (fun (V : Set GaussianInt) + => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 + : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) ((fun + (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) + a b n)) ) := by + classical + intro P T a b n hn hc + exact FordEndpointProof.obs P T a b n hn hc + +private theorem linepath : + (by + classical + exact + (FordFareyParameter) → ( + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + ∀ (f : ℕ → GaussianInt), ∀ (n : ℕ), (0 : ℕ) < n → Function.Injective f → (∀ (k : ℕ), adj + (f k) (f (k + (1 : ℕ)))) → (∀ (j : ℕ), ∀ (k : ℕ), adj (f j) (f k) → k = j + (1 : ℕ) ∨ + j = k + (1 : ℕ)) → SimpleGridPathBetween (f '' Set.Icc (0 : ℕ) n) ((fun (V : Set + GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) + => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) + (f '' Set.Icc (0 : ℕ) n)) (f (0 : ℕ)) (f n)) ) := by + classical + intro P adj f n hn hf hs ha + exact FordEndpointProof.linepath P f n hn hf + hs ha + +private theorem reverse_path : + (by + classical + exact + ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, SimpleGridPathBetween V E x y → SimpleGridPathBetween V E y x ) := by + classical + intro V E x y hp + exact FordEndpointProof.reverse_path (V := V) (E := E) (x + := x) (y := y) hp + +private theorem sqcell : + (by + classical + exact + (FordFareyParameter) → ((∀ (n : ℕ), ∀ (z : GaussianInt), z ∈ (FordTile n).cells ↔ (0 : ℤ) + ≤ z.re ∧ z.re < (↑n : ℤ) ∧ (0 : ℤ) ≤ z.im ∧ z.im < (↑n : ℤ)) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + ∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (z : GaussianInt), z ∈ (sq n a b).cells ↔ a ≤ + z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n)) ) := by + classical + intro P fordcell sq n a b z + exact FordEndpointProof.sqcell P fordcell n a b z + +private theorem sqobs : + (by + classical + exact + (FordFareyParameter) → ( + let rect : Int → Int → Int → Set GaussianInt := fun a b n => + {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} + (∀ (T : ProtoTile), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (n : ℤ), (0 : ℤ) < n → (∀ (z : GaussianInt), + z ∈ T.cells ↔ a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + n) → FootprintVertices + T = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im + ≤ b + n}) a b n ∧ FootprintEdges T = (fun (V : Set GaussianInt) => {e : Finset + GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 : GaussianInt) + ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) ((fun (a b n : ℤ) => {z : + GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b n)) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (z : GaussianInt), z ∈ (sq n a b).cells ↔ a ≤ + z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n) → (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), + (0 < n) → (FootprintVertices (sq n a b) = rect a b n ∧ FootprintEdges (sq n a b) = + edges (rect a b n))))) ) := by + classical + intro P rect adj edges obs sq sqcell n a b hn + exact obs _ a b n (by omega) (sqcell n a b) + +private theorem hpH : + (by + classical + exact + let rect : Int → Int → Int → Set GaussianInt := fun a b n => + {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} + (∀ (V : Set GaussianInt), ∀ (W : Set GaussianInt), (fun (V : Set GaussianInt) => {e : + Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 : + GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) V ∩ (fun (V : Set + GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) + => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) W + = (fun (V : Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y + : GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y + ∧ e = {x, y}}) (V ∩ W)) → ((∀ (l : ℤ), ∀ (h : ℤ), ∀ (b : ℤ), l < h → + SimpleGridPathBetween {z : GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = b} ((fun (V : + Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : + GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 + : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = + {x, y}}) {z : GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = b}) (⟨l, b⟩ : GaussianInt) + (⟨h, b⟩ : GaussianInt)) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), (0 < n) → (FootprintVertices (sq n a b) = rect a + b n ∧ FootprintEdges (sq n a b) = edges (rect a b n))) → (∀ (n : ℕ), ∀ (m : ℕ), ∀ (a + : ℤ), ∀ (b : ℤ), ∀ (c : ℤ), ∀ (d : ℤ), ∀ (l : ℤ), ∀ (h : ℤ), ∀ (y : ℤ), (0 : ℕ) < n → + (0 : ℕ) < m → l < h → rect a b (↑n : ℤ) ∩ rect c d (↑m : ℤ) = {z : GaussianInt | l ≤ + z.re ∧ z.re ≤ h ∧ z.im = y} → SimpleGridPathBetween (FootprintVertices ((fun (n : ℕ) + (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) ∩ + FootprintVertices ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : + GaussianInt)) m c d)) (FootprintEdges ((fun (n : ℕ) (a b : ℤ) => TileTranslation + (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) ∩ FootprintEdges ((fun (n : ℕ) (a b : ℤ) + => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) m c d)) (⟨l, y⟩ : + GaussianInt) (⟨h, y⟩ : GaussianInt)))) ) := by + classical + intro rect adj edges edge_inter horizontal sq sqobs n m a b c d l h y hn hm hlh hv + exact FordEndpointProof.hpH edge_inter horizontal sqobs n m a b c d l h y hn hm hlh hv + +private theorem hpV : + (by + classical + exact + let rect : Int → Int → Int → Set GaussianInt := fun a b n => + {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} + (∀ (V : Set GaussianInt), ∀ (W : Set GaussianInt), (fun (V : Set GaussianInt) => {e : + Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 : + GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) V ∩ (fun (V : Set + GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) + => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) W + = (fun (V : Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y + : GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y + ∧ e = {x, y}}) (V ∩ W)) → ((∀ (l : ℤ), ∀ (h : ℤ), ∀ (a : ℤ), l < h → + SimpleGridPathBetween {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = a} ((fun (V : + Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : + GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 + : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = + {x, y}}) {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = a}) (⟨a, l⟩ : GaussianInt) + (⟨a, h⟩ : GaussianInt)) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), (0 < n) → (FootprintVertices (sq n a b) = rect a + b n ∧ FootprintEdges (sq n a b) = edges (rect a b n))) → (∀ (n : ℕ), ∀ (m : ℕ), ∀ (a + : ℤ), ∀ (b : ℤ), ∀ (c : ℤ), ∀ (d : ℤ), ∀ (l : ℤ), ∀ (h : ℤ), ∀ (x : ℤ), (0 : ℕ) < n → + (0 : ℕ) < m → l < h → rect a b (↑n : ℤ) ∩ rect c d (↑m : ℤ) = {z : GaussianInt | l ≤ + z.im ∧ z.im ≤ h ∧ z.re = x} → SimpleGridPathBetween (FootprintVertices ((fun (n : ℕ) + (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) ∩ + FootprintVertices ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : + GaussianInt)) m c d)) (FootprintEdges ((fun (n : ℕ) (a b : ℤ) => TileTranslation + (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) ∩ FootprintEdges ((fun (n : ℕ) (a b : ℤ) + => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) m c d)) (⟨x, l⟩ : + GaussianInt) (⟨x, h⟩ : GaussianInt)))) ) := by + classical + intro rect adj edges edge_inter vertical sq sqobs n m a b c d l h x hn hm hlh hv + exact FordEndpointProof.hpV edge_inter vertical sqobs n m a b c d l h x hn hm hlh hv + +private theorem sameobs : + (by + classical + exact + (FordFareyParameter) → ((∀ (T : ProtoTile), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (n : ℤ), (0 : ℤ) < n + → (∀ (z : GaussianInt), z ∈ T.cells ↔ a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + + n) → FootprintVertices T = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b n ∧ FootprintEdges T = (fun (V : Set GaussianInt) + => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 + : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) ((fun + (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) + a b n)) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (z : GaussianInt), z ∈ (sq n a b).cells ↔ a ≤ + z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n) → ((∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), + (0 < n) → ((sq n a b).cells.Nonempty)) → ((∀ (n : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℕ) < + n → TileCentroid ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : + GaussianInt)) n a b) = ((↑a : ℝ) + (↑n : ℝ) / (2 : ℝ), (↑b : ℝ) + (↑n : ℝ) / (2 : + ℝ))) → (∀ (T : ProtoTile), ∀ (n : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℕ) < n → T.cells = + (sq n a b).cells → FootprintVertices T = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ + z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b (↑n : ℤ) ∧ FootprintEdges T = + (fun (V : Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : + GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 + : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = + {x, y}}) ((fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ + z.im ≤ b + n}) a b (↑n : ℤ)) ∧ TileCentroid T = ((↑a : ℝ) + (↑n : ℝ) / (2 : ℝ), (↑b : + ℝ) + (↑n : ℝ) / (2 : ℝ))))))) ) := by + classical + intro P obs sq sqcell sqne sqcent T n a b hn hc + exact FordEndpointProof.sameobs P obs sqcell sqne sqcent T n + a b hn hc + +private theorem carry_squares : + (by + classical + exact + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + let package := fun U UR UL W Z : ProtoTile => + ∃ R : ExactTileInterfaceTriple U UR W, + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ + I.otherCA = R.point ∧ A.otherAB = R.point + let ax := fun (q : Int) (flip : Bool) (t a n : Int) => + (if flip then q-a-n else a)+t + ∀ (q : ℤ), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin (5 : ℕ) → ℕ), ∀ (X : Fin (5 : + ℕ) → ℤ), ∀ (Y : Fin (5 : ℕ) → ℤ), (∀ (k : Fin (5 : ℕ)), (0 : ℕ) < N k) → ∀ (T : Fin + (5 : ℕ) → ProtoTile), (∀ (k : Fin (5 : ℕ)), (T k).cells = (sq (N k) (ax q flip t.re + (X k) (↑(N k) : ℤ)) (ax q flip t.im (Y k) (↑(N k) : ℤ))).cells) → package (sq (N (0 : + Fin (5 : ℕ))) (X (0 : Fin (5 : ℕ))) (Y (0 : Fin (5 : ℕ)))) (sq (N (1 : Fin (5 : ℕ))) + (X (1 : Fin (5 : ℕ))) (Y (1 : Fin (5 : ℕ)))) (sq (N (2 : Fin (5 : ℕ))) (X (2 : Fin (5 + : ℕ))) (Y (2 : Fin (5 : ℕ)))) (sq (N (3 : Fin (5 : ℕ))) (X (3 : Fin (5 : ℕ))) (Y (3 : + Fin (5 : ℕ)))) (sq (N (4 : Fin (5 : ℕ))) (X (4 : Fin (5 : ℕ))) (Y (4 : Fin (5 : ℕ)))) + → (fun (U UR UL W Z : ProtoTile) => ∃ (R : ExactTileInterfaceTriple U UR W) (I : + ExactTileInterfaceTriple U UL W) (A : ExactTileInterfaceTriple U W Z), R.point ≠ + I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = + R.point) (T (0 : Fin (5 : ℕ))) (T (1 : Fin (5 : ℕ))) (T (2 : Fin (5 : ℕ))) (T (3 : + Fin (5 : ℕ))) (T (4 : Fin (5 : ℕ))) ) := by + classical + intro sq package ax q flip t N X Y hN T hc hp + exact FordEndpointProof.carry_squares q flip t N X Y hN T hc hp + +private theorem finish0 : + (by + classical + exact + (FordFareyParameter) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + let package := fun U UR UL W Z : ProtoTile => + ∃ R : ExactTileInterfaceTriple U UR W, + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ + I.otherCA = R.point ∧ A.otherAB = R.point + (∀ (r : ℕ), ∀ (s : ℕ), (0 : ℕ) < r → (0 : ℕ) < s → (fun (U UR UL W Z : ProtoTile) => ∃ (R + : ExactTileInterfaceTriple U UR W) (I : ExactTileInterfaceTriple U UL W) (A : + ExactTileInterfaceTriple U W Z), R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = + I.point ∧ I.otherCA = R.point ∧ A.otherAB = R.point) ((fun (n : ℕ) (a b : ℤ) => + TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (0 : ℤ) (0 : ℤ)) ((fun + (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) + (-(↑s : ℤ)) (-((↑r : ℤ) + (↑s : ℤ)))) ((fun (n : ℕ) (a b : ℤ) => TileTranslation + (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (-((↑r : ℤ) + (↑s : ℤ))) (↑s : ℤ)) ((fun + (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) s (-(↑s : + ℤ)) (0 : ℤ)) ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : + GaussianInt)) r (-(↑r : ℤ)) (↑s : ℤ))) → ( + let ax := fun (q : Int) (flip : Bool) (t a n : Int) => + (if flip then q-a-n else a)+t + (∀ (q : ℤ), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin (5 : ℕ) → ℕ), ∀ (X : Fin (5 + : ℕ) → ℤ), ∀ (Y : Fin (5 : ℕ) → ℤ), (∀ (k : Fin (5 : ℕ)), (0 : ℕ) < N k) → ∀ (T : Fin + (5 : ℕ) → ProtoTile), (∀ (k : Fin (5 : ℕ)), (T k).cells = (sq (N k) (ax q flip t.re + (X k) (↑(N k) : ℤ)) (ax q flip t.im (Y k) (↑(N k) : ℤ))).cells) → package (sq (N (0 : + Fin (5 : ℕ))) (X (0 : Fin (5 : ℕ))) (Y (0 : Fin (5 : ℕ)))) (sq (N (1 : Fin (5 : ℕ))) + (X (1 : Fin (5 : ℕ))) (Y (1 : Fin (5 : ℕ)))) (sq (N (2 : Fin (5 : ℕ))) (X (2 : Fin (5 + : ℕ))) (Y (2 : Fin (5 : ℕ)))) (sq (N (3 : Fin (5 : ℕ))) (X (3 : Fin (5 : ℕ))) (Y (3 : + Fin (5 : ℕ)))) (sq (N (4 : Fin (5 : ℕ))) (X (4 : Fin (5 : ℕ))) (Y (4 : Fin (5 : ℕ)))) + → (fun (U UR UL W Z : ProtoTile) => ∃ (R : ExactTileInterfaceTriple U UR W) (I : + ExactTileInterfaceTriple U UL W) (A : ExactTileInterfaceTriple U W Z), R.point ≠ + I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = + R.point) (T (0 : Fin (5 : ℕ))) (T (1 : Fin (5 : ℕ))) (T (2 : Fin (5 : ℕ))) (T (3 : + Fin (5 : ℕ))) (T (4 : Fin (5 : ℕ)))) → ((∀ (T : ProtoTile), ∀ (n : ℕ), ∀ (a : ℤ), ∀ + (b : ℤ), ∀ (u : GaussianInt), T.cells = (sq n a b).cells → (TileTranslation T + u).cells = ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : + GaussianInt)) n (a + u.re) (b + u.im)).cells) → (∀ (r : Nat), ∀ (s : Nat), (0 < r) → + ((0 < s) → (∀ (a : Int), ∀ (b : Int), ∀ (flip : Bool), ∀ (U : ProtoTile), ∀ (W : + ProtoTile), ∀ (Z : ProtoTile), (U.cells = (sq (r+s) a b).cells) → ((W.cells = (sq s + (if flip then a+(r+s:Int) else a-s) + (if flip then b+r else b)).cells) → ((Z.cells = (sq r (if flip then a+(r+s:Int) else + a-r) + (if flip then b else b+s)).cells) → (package U (TileTranslation U (if flip then + ⟨s,r+s⟩ else ⟨-(s:Int),-(r+s:Int)⟩)) (TileTranslation U (if flip then + ⟨r+s,-(s:Int)⟩ else ⟨-(r+s:Int),s⟩)) W Z))))))))) ) := by + classical + intro P sq package base0 ax carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ + exact FordEndpointProof.finish0 P base0 carry_squares translate_cells r s hr hs a b flip U + W Z hU hW hZ + +private theorem finish1 : + (by + classical + exact + (FordFareyParameter) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + let package := fun U UR UL W Z : ProtoTile => + ∃ R : ExactTileInterfaceTriple U UR W, + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ + I.otherCA = R.point ∧ A.otherAB = R.point + (∀ (r : ℕ), ∀ (s : ℕ), (0 : ℕ) < r → (0 : ℕ) < s → (fun (U UR UL W Z : ProtoTile) => ∃ (R + : ExactTileInterfaceTriple U UR W) (I : ExactTileInterfaceTriple U UL W) (A : + ExactTileInterfaceTriple U W Z), R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = + I.point ∧ I.otherCA = R.point ∧ A.otherAB = R.point) ((fun (n : ℕ) (a b : ℤ) => + TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (0 : ℤ) (0 : ℤ)) ((fun + (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) + (-(↑r : ℤ)) ((↑r : ℤ) + (↑s : ℤ))) ((fun (n : ℕ) (a b : ℤ) => TileTranslation + (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (-((↑r : ℤ) + (↑s : ℤ))) (-(↑r : ℤ))) + ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) r + (-(↑r : ℤ)) (↑s : ℤ)) ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ + : GaussianInt)) s (-(↑s : ℤ)) (0 : ℤ))) → ( + let ax := fun (q : Int) (flip : Bool) (t a n : Int) => + (if flip then q-a-n else a)+t + (∀ (q : ℤ), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin (5 : ℕ) → ℕ), ∀ (X : Fin (5 + : ℕ) → ℤ), ∀ (Y : Fin (5 : ℕ) → ℤ), (∀ (k : Fin (5 : ℕ)), (0 : ℕ) < N k) → ∀ (T : Fin + (5 : ℕ) → ProtoTile), (∀ (k : Fin (5 : ℕ)), (T k).cells = (sq (N k) (ax q flip t.re + (X k) (↑(N k) : ℤ)) (ax q flip t.im (Y k) (↑(N k) : ℤ))).cells) → package (sq (N (0 : + Fin (5 : ℕ))) (X (0 : Fin (5 : ℕ))) (Y (0 : Fin (5 : ℕ)))) (sq (N (1 : Fin (5 : ℕ))) + (X (1 : Fin (5 : ℕ))) (Y (1 : Fin (5 : ℕ)))) (sq (N (2 : Fin (5 : ℕ))) (X (2 : Fin (5 + : ℕ))) (Y (2 : Fin (5 : ℕ)))) (sq (N (3 : Fin (5 : ℕ))) (X (3 : Fin (5 : ℕ))) (Y (3 : + Fin (5 : ℕ)))) (sq (N (4 : Fin (5 : ℕ))) (X (4 : Fin (5 : ℕ))) (Y (4 : Fin (5 : ℕ)))) + → (fun (U UR UL W Z : ProtoTile) => ∃ (R : ExactTileInterfaceTriple U UR W) (I : + ExactTileInterfaceTriple U UL W) (A : ExactTileInterfaceTriple U W Z), R.point ≠ + I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = + R.point) (T (0 : Fin (5 : ℕ))) (T (1 : Fin (5 : ℕ))) (T (2 : Fin (5 : ℕ))) (T (3 : + Fin (5 : ℕ))) (T (4 : Fin (5 : ℕ)))) → ((∀ (T : ProtoTile), ∀ (n : ℕ), ∀ (a : ℤ), ∀ + (b : ℤ), ∀ (u : GaussianInt), T.cells = (sq n a b).cells → (TileTranslation T + u).cells = ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : + GaussianInt)) n (a + u.re) (b + u.im)).cells) → (∀ (r : Nat), ∀ (s : Nat), (0 < r) → + ((0 < s) → (∀ (a : Int), ∀ (b : Int), ∀ (flip : Bool), ∀ (U : ProtoTile), ∀ (W : + ProtoTile), ∀ (Z : ProtoTile), (U.cells = (sq (r+s) a b).cells) → ((W.cells = (sq r + (if flip then a+(r+s:Int) else a-r) + (if flip then b else b+s)).cells) → ((Z.cells = (sq s (if flip then a+(r+s:Int) else + a-s) + (if flip then b+r else b)).cells) → (package U (TileTranslation U (if flip then + ⟨r,-(r+s:Int)⟩ else ⟨-(r:Int),r+s⟩)) (TileTranslation U (if flip then ⟨r+s,r⟩ + else ⟨-(r+s:Int),-(r:Int)⟩)) W Z))))))))) ) := by + classical + intro P sq package base1 ax carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ + exact FordEndpointProof.finish1 P base1 carry_squares translate_cells r s hr hs a b flip U + W Z hU hW hZ + +end FordEndpointAssembly + +namespace FordEndpointConclusion + +private theorem obs : + (by + classical + exact + (FordFareyParameter) → (∀ (T : ProtoTile), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (n : ℤ), (0 : ℤ) < n → + (∀ (z : GaussianInt), z ∈ T.cells ↔ a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + + n) → FootprintVertices T = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b n ∧ FootprintEdges T = (fun (V : Set GaussianInt) + => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 + : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) ((fun + (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) + a b n)) ) := by + classical + intro P T a b n hn hc + exact FordEndpointAssembly.obs P T a b n + hn hc + +private theorem linepath : + (by + classical + exact + (FordFareyParameter) → ( + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + ∀ (f : ℕ → GaussianInt), ∀ (n : ℕ), (0 : ℕ) < n → Function.Injective f → (∀ (k : ℕ), adj + (f k) (f (k + (1 : ℕ)))) → (∀ (j : ℕ), ∀ (k : ℕ), adj (f j) (f k) → k = j + (1 : ℕ) ∨ + j = k + (1 : ℕ)) → SimpleGridPathBetween (f '' Set.Icc (0 : ℕ) n) ((fun (V : Set + GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) + => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) + (f '' Set.Icc (0 : ℕ) n)) (f (0 : ℕ)) (f n)) ) := by + classical + intro P adj f n hn hf hs ha + exact FordEndpointAssembly.linepath P f n hn + hf hs ha + +private theorem reverse_path : + (by + classical + exact + ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, SimpleGridPathBetween V E x y → SimpleGridPathBetween V E y x ) := by + classical + intro V E x y hp + exact FordEndpointAssembly.reverse_path (V := V) (E := E) + (x := x) (y := y) hp + +private theorem sqcell : + (by + classical + exact + (FordFareyParameter) → ((∀ (n : ℕ), ∀ (z : GaussianInt), z ∈ (FordTile n).cells ↔ (0 : ℤ) + ≤ z.re ∧ z.re < (↑n : ℤ) ∧ (0 : ℤ) ≤ z.im ∧ z.im < (↑n : ℤ)) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + ∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (z : GaussianInt), z ∈ (sq n a b).cells ↔ a ≤ + z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n)) ) := by + classical + intro P fordcell sq n a b z + exact FordEndpointAssembly.sqcell P fordcell n + a b z + +private theorem hpH : + (by + classical + exact + let rect : Int → Int → Int → Set GaussianInt := fun a b n => + {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} + (∀ (V : Set GaussianInt), ∀ (W : Set GaussianInt), (fun (V : Set GaussianInt) => {e : + Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 : + GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) V ∩ (fun (V : Set + GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) + => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) W + = (fun (V : Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y + : GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y + ∧ e = {x, y}}) (V ∩ W)) → ((∀ (l : ℤ), ∀ (h : ℤ), ∀ (b : ℤ), l < h → + SimpleGridPathBetween {z : GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = b} ((fun (V : + Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : + GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 + : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = + {x, y}}) {z : GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = b}) (⟨l, b⟩ : GaussianInt) + (⟨h, b⟩ : GaussianInt)) → ((∀ (n : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℕ) < n → + FootprintVertices ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : + GaussianInt)) n a b) = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n + ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b (↑n : ℤ) ∧ FootprintEdges ((fun (n : ℕ) (a b : ℤ) => + TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) = (fun (V : Set + GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) + => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) + ((fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + + n}) a b (↑n : ℤ))) → (∀ (n : ℕ), ∀ (m : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (c : ℤ), ∀ (d : + ℤ), ∀ (l : ℤ), ∀ (h : ℤ), ∀ (y : ℤ), (0 : ℕ) < n → (0 : ℕ) < m → l < h → rect a b (↑n + : ℤ) ∩ rect c d (↑m : ℤ) = {z : GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = y} → + SimpleGridPathBetween (FootprintVertices ((fun (n : ℕ) (a b : ℤ) => TileTranslation + (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) ∩ FootprintVertices ((fun (n : ℕ) (a b : + ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) m c d)) (FootprintEdges + ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) n a + b) ∩ FootprintEdges ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : + GaussianInt)) m c d)) (⟨l, y⟩ : GaussianInt) (⟨h, y⟩ : GaussianInt)))) ) := by + classical + intro rect edge_inter horizontal sqobs n m a b c d l h y hn hm hlh hv + exact FordEndpointAssembly.hpH edge_inter horizontal sqobs n m a b c d l h y hn hm hlh hv + +private theorem hpV : + (by + classical + exact + let rect : Int → Int → Int → Set GaussianInt := fun a b n => + {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} + (∀ (V : Set GaussianInt), ∀ (W : Set GaussianInt), (fun (V : Set GaussianInt) => {e : + Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 : + GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) V ∩ (fun (V : Set + GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) + => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) W + = (fun (V : Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y + : GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y + ∧ e = {x, y}}) (V ∩ W)) → ((∀ (l : ℤ), ∀ (h : ℤ), ∀ (a : ℤ), l < h → + SimpleGridPathBetween {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = a} ((fun (V : + Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : + GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 + : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = + {x, y}}) {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = a}) (⟨a, l⟩ : GaussianInt) + (⟨a, h⟩ : GaussianInt)) → ((∀ (n : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℕ) < n → + FootprintVertices ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : + GaussianInt)) n a b) = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n + ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b (↑n : ℤ) ∧ FootprintEdges ((fun (n : ℕ) (a b : ℤ) => + TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) = (fun (V : Set + GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) + => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) + ((fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + + n}) a b (↑n : ℤ))) → (∀ (n : ℕ), ∀ (m : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (c : ℤ), ∀ (d : + ℤ), ∀ (l : ℤ), ∀ (h : ℤ), ∀ (x : ℤ), (0 : ℕ) < n → (0 : ℕ) < m → l < h → rect a b (↑n + : ℤ) ∩ rect c d (↑m : ℤ) = {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = x} → + SimpleGridPathBetween (FootprintVertices ((fun (n : ℕ) (a b : ℤ) => TileTranslation + (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) ∩ FootprintVertices ((fun (n : ℕ) (a b : + ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) m c d)) (FootprintEdges + ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) n a + b) ∩ FootprintEdges ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : + GaussianInt)) m c d)) (⟨x, l⟩ : GaussianInt) (⟨x, h⟩ : GaussianInt)))) ) := by + classical + intro rect edge_inter vertical sqobs n m a b c d l h x hn hm hlh hv + exact FordEndpointAssembly.hpV edge_inter vertical sqobs n m a b c d l h x hn hm hlh hv + +private theorem sameobs : + (by + classical + exact + (FordFareyParameter) → ((∀ (T : ProtoTile), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (n : ℤ), (0 : ℤ) < n + → (∀ (z : GaussianInt), z ∈ T.cells ↔ a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + + n) → FootprintVertices T = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b n ∧ FootprintEdges T = (fun (V : Set GaussianInt) + => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 + : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) ((fun + (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) + a b n)) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (z : GaussianInt), z ∈ (sq n a b).cells ↔ a ≤ + z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n) → ((∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), + (0 < n) → ((sq n a b).cells.Nonempty)) → ((∀ (n : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℕ) < + n → TileCentroid ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : + GaussianInt)) n a b) = ((↑a : ℝ) + (↑n : ℝ) / (2 : ℝ), (↑b : ℝ) + (↑n : ℝ) / (2 : + ℝ))) → (∀ (T : ProtoTile), ∀ (n : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℕ) < n → T.cells = + (sq n a b).cells → FootprintVertices T = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ + z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b (↑n : ℤ) ∧ FootprintEdges T = + (fun (V : Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : + GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 + : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = + {x, y}}) ((fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ + z.im ≤ b + n}) a b (↑n : ℤ)) ∧ TileCentroid T = ((↑a : ℝ) + (↑n : ℝ) / (2 : ℝ), (↑b : + ℝ) + (↑n : ℝ) / (2 : ℝ))))))) ) := by + classical + intro P obs sq sqcell sqne sqcent T n a b hn hc + exact FordEndpointAssembly.sameobs P obs sqcell sqne sqcent + T n a b hn hc + +private theorem carry_squares : + (by + classical + exact + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + let package := fun U UR UL W Z : ProtoTile => + ∃ R : ExactTileInterfaceTriple U UR W, + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ + I.otherCA = R.point ∧ A.otherAB = R.point + let ax := fun (q : Int) (flip : Bool) (t a n : Int) => + (if flip then q-a-n else a)+t + ∀ (q : ℤ), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin (5 : ℕ) → ℕ), ∀ (X : Fin (5 : + ℕ) → ℤ), ∀ (Y : Fin (5 : ℕ) → ℤ), (∀ (k : Fin (5 : ℕ)), (0 : ℕ) < N k) → ∀ (T : Fin + (5 : ℕ) → ProtoTile), (∀ (k : Fin (5 : ℕ)), (T k).cells = (sq (N k) (ax q flip t.re + (X k) (↑(N k) : ℤ)) (ax q flip t.im (Y k) (↑(N k) : ℤ))).cells) → package (sq (N (0 : + Fin (5 : ℕ))) (X (0 : Fin (5 : ℕ))) (Y (0 : Fin (5 : ℕ)))) (sq (N (1 : Fin (5 : ℕ))) + (X (1 : Fin (5 : ℕ))) (Y (1 : Fin (5 : ℕ)))) (sq (N (2 : Fin (5 : ℕ))) (X (2 : Fin (5 + : ℕ))) (Y (2 : Fin (5 : ℕ)))) (sq (N (3 : Fin (5 : ℕ))) (X (3 : Fin (5 : ℕ))) (Y (3 : + Fin (5 : ℕ)))) (sq (N (4 : Fin (5 : ℕ))) (X (4 : Fin (5 : ℕ))) (Y (4 : Fin (5 : ℕ)))) + → (fun (U UR UL W Z : ProtoTile) => ∃ (R : ExactTileInterfaceTriple U UR W) (I : + ExactTileInterfaceTriple U UL W) (A : ExactTileInterfaceTriple U W Z), R.point ≠ + I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = + R.point) (T (0 : Fin (5 : ℕ))) (T (1 : Fin (5 : ℕ))) (T (2 : Fin (5 : ℕ))) (T (3 : + Fin (5 : ℕ))) (T (4 : Fin (5 : ℕ))) ) := by + classical + intro sq package ax q flip t N X Y hN T hc hp + exact FordEndpointAssembly.carry_squares q flip t N X Y hN T hc hp + +private theorem finish0 : + (by + classical + exact + (FordFareyParameter) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + let package := fun U UR UL W Z : ProtoTile => + ∃ R : ExactTileInterfaceTriple U UR W, + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ + I.otherCA = R.point ∧ A.otherAB = R.point + (∀ (r : ℕ), ∀ (s : ℕ), (0 : ℕ) < r → (0 : ℕ) < s → (fun (U UR UL W Z : ProtoTile) => ∃ (R + : ExactTileInterfaceTriple U UR W) (I : ExactTileInterfaceTriple U UL W) (A : + ExactTileInterfaceTriple U W Z), R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = + I.point ∧ I.otherCA = R.point ∧ A.otherAB = R.point) ((fun (n : ℕ) (a b : ℤ) => + TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (0 : ℤ) (0 : ℤ)) ((fun + (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) + (-(↑s : ℤ)) (-((↑r : ℤ) + (↑s : ℤ)))) ((fun (n : ℕ) (a b : ℤ) => TileTranslation + (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (-((↑r : ℤ) + (↑s : ℤ))) (↑s : ℤ)) ((fun + (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) s (-(↑s : + ℤ)) (0 : ℤ)) ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : + GaussianInt)) r (-(↑r : ℤ)) (↑s : ℤ))) → ( + let ax := fun (q : Int) (flip : Bool) (t a n : Int) => + (if flip then q-a-n else a)+t + (∀ (q : ℤ), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin (5 : ℕ) → ℕ), ∀ (X : Fin (5 + : ℕ) → ℤ), ∀ (Y : Fin (5 : ℕ) → ℤ), (∀ (k : Fin (5 : ℕ)), (0 : ℕ) < N k) → ∀ (T : Fin + (5 : ℕ) → ProtoTile), (∀ (k : Fin (5 : ℕ)), (T k).cells = (sq (N k) (ax q flip t.re + (X k) (↑(N k) : ℤ)) (ax q flip t.im (Y k) (↑(N k) : ℤ))).cells) → package (sq (N (0 : + Fin (5 : ℕ))) (X (0 : Fin (5 : ℕ))) (Y (0 : Fin (5 : ℕ)))) (sq (N (1 : Fin (5 : ℕ))) + (X (1 : Fin (5 : ℕ))) (Y (1 : Fin (5 : ℕ)))) (sq (N (2 : Fin (5 : ℕ))) (X (2 : Fin (5 + : ℕ))) (Y (2 : Fin (5 : ℕ)))) (sq (N (3 : Fin (5 : ℕ))) (X (3 : Fin (5 : ℕ))) (Y (3 : + Fin (5 : ℕ)))) (sq (N (4 : Fin (5 : ℕ))) (X (4 : Fin (5 : ℕ))) (Y (4 : Fin (5 : ℕ)))) + → (fun (U UR UL W Z : ProtoTile) => ∃ (R : ExactTileInterfaceTriple U UR W) (I : + ExactTileInterfaceTriple U UL W) (A : ExactTileInterfaceTriple U W Z), R.point ≠ + I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = + R.point) (T (0 : Fin (5 : ℕ))) (T (1 : Fin (5 : ℕ))) (T (2 : Fin (5 : ℕ))) (T (3 : + Fin (5 : ℕ))) (T (4 : Fin (5 : ℕ)))) → ((∀ (T : ProtoTile), ∀ (n : ℕ), ∀ (a : ℤ), ∀ + (b : ℤ), ∀ (u : GaussianInt), T.cells = (sq n a b).cells → (TileTranslation T + u).cells = ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : + GaussianInt)) n (a + u.re) (b + u.im)).cells) → (∀ (r : Nat), ∀ (s : Nat), (0 < r) → + ((0 < s) → (∀ (a : Int), ∀ (b : Int), ∀ (flip : Bool), ∀ (U : ProtoTile), ∀ (W : + ProtoTile), ∀ (Z : ProtoTile), (U.cells = (sq (r+s) a b).cells) → ((W.cells = (sq s + (if flip then a+(r+s:Int) else a-s) + (if flip then b+r else b)).cells) → ((Z.cells = (sq r (if flip then a+(r+s:Int) else + a-r) + (if flip then b else b+s)).cells) → (package U (TileTranslation U (if flip then + ⟨s,r+s⟩ else ⟨-(s:Int),-(r+s:Int)⟩)) (TileTranslation U (if flip then + ⟨r+s,-(s:Int)⟩ else ⟨-(r+s:Int),s⟩)) W Z))))))))) ) := by + classical + intro P sq package base0 ax carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ + exact FordEndpointAssembly.finish0 P base0 carry_squares translate_cells r s hr hs a b flip + U W Z hU hW hZ + +private theorem finish1 : + (by + classical + exact + (FordFareyParameter) → ( + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + let package := fun U UR UL W Z : ProtoTile => + ∃ R : ExactTileInterfaceTriple U UR W, + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ + I.otherCA = R.point ∧ A.otherAB = R.point + (∀ (r : ℕ), ∀ (s : ℕ), (0 : ℕ) < r → (0 : ℕ) < s → (fun (U UR UL W Z : ProtoTile) => ∃ (R + : ExactTileInterfaceTriple U UR W) (I : ExactTileInterfaceTriple U UL W) (A : + ExactTileInterfaceTriple U W Z), R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = + I.point ∧ I.otherCA = R.point ∧ A.otherAB = R.point) ((fun (n : ℕ) (a b : ℤ) => + TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (0 : ℤ) (0 : ℤ)) ((fun + (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) + (-(↑r : ℤ)) ((↑r : ℤ) + (↑s : ℤ))) ((fun (n : ℕ) (a b : ℤ) => TileTranslation + (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (-((↑r : ℤ) + (↑s : ℤ))) (-(↑r : ℤ))) + ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) r + (-(↑r : ℤ)) (↑s : ℤ)) ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ + : GaussianInt)) s (-(↑s : ℤ)) (0 : ℤ))) → ( + let ax := fun (q : Int) (flip : Bool) (t a n : Int) => + (if flip then q-a-n else a)+t + (∀ (q : ℤ), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin (5 : ℕ) → ℕ), ∀ (X : Fin (5 + : ℕ) → ℤ), ∀ (Y : Fin (5 : ℕ) → ℤ), (∀ (k : Fin (5 : ℕ)), (0 : ℕ) < N k) → ∀ (T : Fin + (5 : ℕ) → ProtoTile), (∀ (k : Fin (5 : ℕ)), (T k).cells = (sq (N k) (ax q flip t.re + (X k) (↑(N k) : ℤ)) (ax q flip t.im (Y k) (↑(N k) : ℤ))).cells) → package (sq (N (0 : + Fin (5 : ℕ))) (X (0 : Fin (5 : ℕ))) (Y (0 : Fin (5 : ℕ)))) (sq (N (1 : Fin (5 : ℕ))) + (X (1 : Fin (5 : ℕ))) (Y (1 : Fin (5 : ℕ)))) (sq (N (2 : Fin (5 : ℕ))) (X (2 : Fin (5 + : ℕ))) (Y (2 : Fin (5 : ℕ)))) (sq (N (3 : Fin (5 : ℕ))) (X (3 : Fin (5 : ℕ))) (Y (3 : + Fin (5 : ℕ)))) (sq (N (4 : Fin (5 : ℕ))) (X (4 : Fin (5 : ℕ))) (Y (4 : Fin (5 : ℕ)))) + → (fun (U UR UL W Z : ProtoTile) => ∃ (R : ExactTileInterfaceTriple U UR W) (I : + ExactTileInterfaceTriple U UL W) (A : ExactTileInterfaceTriple U W Z), R.point ≠ + I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = + R.point) (T (0 : Fin (5 : ℕ))) (T (1 : Fin (5 : ℕ))) (T (2 : Fin (5 : ℕ))) (T (3 : + Fin (5 : ℕ))) (T (4 : Fin (5 : ℕ)))) → ((∀ (T : ProtoTile), ∀ (n : ℕ), ∀ (a : ℤ), ∀ + (b : ℤ), ∀ (u : GaussianInt), T.cells = (sq n a b).cells → (TileTranslation T + u).cells = ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : + GaussianInt)) n (a + u.re) (b + u.im)).cells) → (∀ (r : Nat), ∀ (s : Nat), (0 < r) → + ((0 < s) → (∀ (a : Int), ∀ (b : Int), ∀ (flip : Bool), ∀ (U : ProtoTile), ∀ (W : + ProtoTile), ∀ (Z : ProtoTile), (U.cells = (sq (r+s) a b).cells) → ((W.cells = (sq r + (if flip then a+(r+s:Int) else a-r) + (if flip then b else b+s)).cells) → ((Z.cells = (sq s (if flip then a+(r+s:Int) else + a-s) + (if flip then b+r else b)).cells) → (package U (TileTranslation U (if flip then + ⟨r,-(r+s:Int)⟩ else ⟨-(r:Int),r+s⟩)) (TileTranslation U (if flip then ⟨r+s,r⟩ + else ⟨-(r+s:Int),-(r:Int)⟩)) W Z))))))))) ) := by + classical + intro P sq package base1 ax carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ + exact FordEndpointAssembly.finish1 P base1 carry_squares translate_cells r s hr hs a b flip + U W Z hU hW hZ + +end FordEndpointConclusion + +theorem FordOrientedChildParentEndpoints + (P : FordFareyParameter) (hq : 1 < P.q) : + let q := FordRecursiveQuadruple P + ∀ (i : Fin 3) (s : Fin 4) (U W Z : ProtoTile), + BandPrototile (q 0) U → + BandPrototile (q i.succ) W → + BandPrototile + (q ((if Even s.val then i - 1 else i + 1).succ)) Z → + 0 < (q 0).1 → 0 < (q i.succ).1 → + 0 < (q ((if Even s.val then i - 1 else i + 1).succ)).1 → + TileCentroid W - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) → + TileCentroid Z - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (q 0) (q ((i - 1).succ)) - + BandVectors.1 (q ((i - 1).succ)) (q 0) + else + BandVectors.1 (q ((i + 1).succ)) (q 0) - + BandVectors.1 (q 0) (q ((i + 1).succ)))) → + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) + let uL := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q i.succ) (q 0) + else BandVectors.1 (q 0) (q i.succ)) + ∃ rightData : ExactTileInterfaceTriple U (TileTranslation U uR) W, + ∃ incomingData : ExactTileInterfaceTriple U (TileTranslation U uL) W, + ∃ adjacentData : ExactTileInterfaceTriple U W Z, + rightData.point ≠ incomingData.point ∧ + adjacentData.point = incomingData.point ∧ + rightData.otherCA = incomingData.point ∧ + incomingData.otherCA = rightData.point ∧ + adjacentData.otherAB = rightData.point := by +-- BODY + classical + -- A positive rectangle has the full induced grid graph on its vertices. + let rect : Int → Int → Int → Set GaussianInt := fun a b n => + {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} + let adj := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} + have obs := FordEndpointConclusion.obs P + have edge_inter := FordEndpointProof.edge_inter + -- Enumerate every vertex and every edge of a straight segment. + have linepath := FordEndpointConclusion.linepath P + have reverse_path {V : Set GaussianInt} {E : Set (Finset GaussianInt)} {x y : GaussianInt} + (hp : SimpleGridPathBetween V E x y) := FordEndpointConclusion.reverse_path (V := V) (E := + E) (x := x) (y := y) hp + have fordcell := FordEndpointProof.fordcell P + let sq := fun n : Nat => fun a b : Int => + TileTranslation (FordTile n) ⟨a,b⟩ + have sqcell (n : Nat) (a b : Int) (z : GaussianInt) : + z ∈ (sq n a b).cells ↔ + a ≤ z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n := FordEndpointConclusion.sqcell P fordcell + n a b z + have sqobs := FordEndpointAssembly.sqobs P obs sqcell + have sqne (n : Nat) (a b : Int) (hn : 0 < n) : (sq n a b).cells.Nonempty := + ⟨⟨a,b⟩, (sqcell n a b _).mpr (by dsimp; omega)⟩ + -- A centered quarter-turn determines the square's centroid without sums. + have hpH := FordEndpointConclusion.hpH edge_inter (FordEndpointProof.horizontal P linepath) sqobs + have hpV := FordEndpointConclusion.hpV edge_inter (FordEndpointProof.vertical P linepath) sqobs + -- The complete path ledger for rotation zero. + have ledger0 := FordEndpointProof.ledger0 P reverse_path sqobs hpH hpV + -- The second ledger uses the same child-parent junction with parents swapped. + let package := fun U UR UL W Z : ProtoTile => + ∃ R : ExactTileInterfaceTriple U UR W, + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ + I.otherCA = R.point ∧ A.otherAB = R.point + let affine := fun (q : Int) (flip : Bool) (t : GaussianInt) (z : GaussianInt) => + (if flip then (⟨q,q⟩ : GaussianInt) - z else z) + t + let ax := fun (q : Int) (flip : Bool) (t a n : Int) => + (if flip then q-a-n else a)+t + have sameobs := FordEndpointConclusion.sameobs P obs sqcell sqne (FordEndpointProof.sqcent + (FordEndpointProof.fordcent P fordcell)) + have carry_squares := FordEndpointConclusion.carry_squares + have translate_cells := FordEndpointProof.translate_cells + have finish0 (r s : Nat) (hr : 0 < r) (hs : 0 < s) (a b : Int) + (flip : Bool) (U W Z : ProtoTile) + (hU : U.cells = (sq (r+s) a b).cells) + (hW : W.cells = (sq s (if flip then a+(r+s:Int) else a-s) + (if flip then b+r else b)).cells) + (hZ : Z.cells = (sq r (if flip then a+(r+s:Int) else a-r) + (if flip then b else b+s)).cells) : + package U + (TileTranslation U (if flip then ⟨s,r+s⟩ else ⟨-(s:Int),-(r+s:Int)⟩)) + (TileTranslation U (if flip then ⟨r+s,-(s:Int)⟩ else ⟨-(r+s:Int),s⟩)) W Z := + FordEndpointConclusion.finish0 P (FordEndpointProof.base0 P ledger0) carry_squares + translate_cells r s hr hs a b + flip U W Z hU hW hZ + have finish1 (r s : Nat) (hr : 0 < r) (hs : 0 < s) (a b : Int) + (flip : Bool) (U W Z : ProtoTile) + (hU : U.cells = (sq (r+s) a b).cells) + (hW : W.cells = (sq r (if flip then a+(r+s:Int) else a-r) + (if flip then b else b+s)).cells) + (hZ : Z.cells = (sq s (if flip then a+(r+s:Int) else a-s) + (if flip then b+r else b)).cells) : + package U + (TileTranslation U (if flip then ⟨r,-(r+s:Int)⟩ else ⟨-(r:Int),r+s⟩)) + (TileTranslation U (if flip then ⟨r+s,r⟩ else ⟨-(r+s:Int),-(r:Int)⟩)) W Z := + FordEndpointConclusion.finish1 P (FordEndpointProof.base1 P + (FordEndpointProof.ledger1 P reverse_path sqobs hpH hpV ledger0)) carry_squares + translate_cells r s hr hs a b + flip U W Z hU hW hZ + dsimp only + intro i s U W Z hU hW hZ hUpos hWpos hZpos hcw hcz + have hr : 0 < P.q₁ := FordEndpointProof.hrAt727 P hq i s + have hs : 0 < P.q₂ := P.q₂_pos + have hr0 : P.q₁ ≠ 0 := by omega + have hqs : P.q = P.q₁ + P.q₂ := P.sum_q + have hqsR : (P.q:Real) = (P.q₁:Real)+(P.q₂:Real) := by exact_mod_cast hqs + obtain ⟨hproper,h10,h20,h30,_⟩ := (FordCoordinateConfiguration P).2 hq + have hf := (VectorRecursionLaws _ hproper.1).2.2.2.2 hproper + have h01 : BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) 1) = ⟨-(P.q₁:Int),P.q⟩ := FordEndpointProof.h01 P h10 hf + have h02 : BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) 2) = ⟨-(P.q₂:Int),-(P.q:Int)⟩ := FordEndpointProof.h02 P h20 hf + have norm1 (T : ProtoTile) (hT : BandPrototile ((FordRecursiveQuadruple P) 1) T) : + ∃ a b : Int, T.cells = (sq P.q₁ a b).cells := FordEndpointProof.norm1 P hq hr0 T hT + have norm2 (T : ProtoTile) (hT : BandPrototile ((FordRecursiveQuadruple P) 2) T) : + ∃ a b : Int, T.cells = (sq P.q₂ a b).cells := FordEndpointProof.norm2 P hq hs T hT + obtain ⟨u, hu⟩ := P5269T1FordSquareNormalForm P hq 0 U hU hUpos + obtain ⟨a,b,hUc⟩ : ∃ a b : Int, U.cells = (sq P.q a b).cells := + ⟨u.re, u.im, hu⟩ + have hcu := (sameobs U P.q a b P.q_pos hUc).2.2 + have indices := FordEndpointProof.indices P i s U W Z hW hZ hWpos hZpos hcw hcz + rcases indices with ⟨heven,rfl⟩ | ⟨hodd,rfl⟩ + · obtain ⟨wa,wb,hWc⟩ := norm2 W hW + obtain ⟨za,zb,hZc⟩ := norm1 Z (by simpa [heven] using hZ) + have hccw := (sameobs W P.q₂ wa wb hs hWc).2.2 + have hccz := (sameobs Z P.q₁ za zb hr hZc).2.2 + rw [hccw,hcu] at hcw + rw [hccz,hcu] at hcz + fin_cases s + · norm_num [heven,h10,h20,h01,h02,GaussianRealPoint,pow_succ] at hcw hcz + have hwa := FordEndpointProof.hwaAt806 P a b wa wb hcw + have hwb := FordEndpointProof.hwbAt810 P a b wa wb hcw + have hza := FordEndpointProof.hzaAt813 P a b za zb hcz + have hzb := FordEndpointProof.hzbAt817 P hqsR a b za zb hcz + subst wa wb za zb + change package U + (TileTranslation U ((⟨0,1⟩ : GaussianInt)^0 * + (if Even (0:Nat) then BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) 2) + else BandVectors.1 ((FordRecursiveQuadruple P) 2) ((FordRecursiveQuadruple P) 0)))) + (TileTranslation U ((⟨0,1⟩ : GaussianInt)^0 * + (if Even (0:Nat) then BandVectors.1 ((FordRecursiveQuadruple P) 2) + ((FordRecursiveQuadruple P) 0) + else BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 2)))) W Z + simp only [show Even (0:Nat) from by decide,ite_true,pow_zero,one_mul] + rw [h02,h20] + simpa only [hqs,Nat.cast_add,Bool.false_eq_true,ite_false] using finish0 P.q₁ P.q₂ hr hs a + b false U W Z + (by simpa [hqs] using hUc) hWc hZc + · exact ((by decide : ¬Even (1:Nat)) heven).elim + · norm_num [heven,h10,h20,h01,h02,GaussianRealPoint,pow_succ] at hcw hcz + have hwa := FordEndpointProof.hwaAt838 P a b wa wb hcw + have hwb := FordEndpointProof.hwbAt842 P hqsR a b wa wb hcw + have hza := FordEndpointProof.hzaAt846 P a b za zb hcz + have hzb := FordEndpointProof.hzbAt850 P a b za zb hcz + subst wa wb za zb + change package U + (TileTranslation U ((⟨0,1⟩ : GaussianInt)^2 * + (if Even (2:Nat) then BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) 2) + else BandVectors.1 ((FordRecursiveQuadruple P) 2) ((FordRecursiveQuadruple P) 0)))) + (TileTranslation U ((⟨0,1⟩ : GaussianInt)^2 * + (if Even (2:Nat) then BandVectors.1 ((FordRecursiveQuadruple P) 2) + ((FordRecursiveQuadruple P) 0) + else BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 2)))) W Z + simp only [show Even (2:Nat) from by decide,ite_true,h02,h20] + have dR : (⟨0,1⟩ : GaussianInt)^2 * ⟨-(P.q₂:Int),-(P.q:Int)⟩ = ⟨P.q₂,P.q⟩ := by + ext <;> norm_num [pow_succ] + have dL : (⟨0,1⟩ : GaussianInt)^2 * ⟨-(P.q:Int),P.q₂⟩ = ⟨P.q,-(P.q₂:Int)⟩ := by + ext <;> norm_num [pow_succ] + rw [dR,dL] + simpa only [hqs,Nat.cast_add,eq_self,ite_true] using finish0 P.q₁ P.q₂ hr hs a b true U W Z + (by simpa [hqs] using hUc) (by simpa [hqs] using hWc) (by simpa [hqs] using hZc) + · exact ((by decide : ¬Even (3:Nat)) heven).elim + · obtain ⟨wa,wb,hWc⟩ := norm1 W hW + obtain ⟨za,zb,hZc⟩ := norm2 Z (by simpa [hodd] using hZ) + have hccw := (sameobs W P.q₁ wa wb hr hWc).2.2 + have hccz := (sameobs Z P.q₂ za zb hs hZc).2.2 + rw [hccw,hcu] at hcw + rw [hccz,hcu] at hcz + fin_cases s + · exact (hodd (by decide)).elim + · norm_num [hodd,h10,h20,h01,h02,GaussianRealPoint,pow_succ] at hcw hcz + have hwa := FordEndpointProof.hwaAt881 P a b wa wb hcw + have hwb := FordEndpointProof.hwbAt885 P hqsR a b wa wb hcw + have hza := FordEndpointProof.hzaAt889 P a b za zb hcz + have hzb := FordEndpointProof.hzbAt893 P a b za zb hcz + subst wa wb za zb + change package U + (TileTranslation U ((⟨0,1⟩ : GaussianInt)^1 * + (if Even (1:Nat) then BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) 1) + else BandVectors.1 ((FordRecursiveQuadruple P) 1) ((FordRecursiveQuadruple P) 0)))) + (TileTranslation U ((⟨0,1⟩ : GaussianInt)^1 * + (if Even (1:Nat) then BandVectors.1 ((FordRecursiveQuadruple P) 1) + ((FordRecursiveQuadruple P) 0) + else BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 1)))) W Z + simp only [show ¬Even (1:Nat) from by decide,ite_false,h10,h01] + have dR : (⟨0,1⟩ : GaussianInt)^1 * ⟨P.q,P.q₁⟩ = ⟨-(P.q₁:Int),P.q⟩ := by + ext <;> norm_num [pow_succ] + have dL : (⟨0,1⟩ : GaussianInt)^1 * ⟨-(P.q₁:Int),P.q⟩ = ⟨-(P.q:Int),-(P.q₁:Int)⟩ := by + ext <;> norm_num [pow_succ] + rw [dR,dL] + simpa only [hqs,Nat.cast_add,Bool.false_eq_true,ite_false] using finish1 P.q₁ P.q₂ hr hs a + b false U W Z + (by simpa [hqs] using hUc) hWc hZc + · exact (hodd (by decide)).elim + · norm_num [hodd,h10,h20,h01,h02,GaussianRealPoint,pow_succ] at hcw hcz + have hwa := FordEndpointProof.hwaAt917 P a b wa wb hcw + have hwb := FordEndpointProof.hwbAt921 P a b wa wb hcw + have hza := FordEndpointProof.hzaAt924 P a b za zb hcz + have hzb := FordEndpointProof.hzbAt928 P hqsR a b za zb hcz + subst wa wb za zb + change package U + (TileTranslation U ((⟨0,1⟩ : GaussianInt)^3 * + (if Even (3:Nat) then BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) 1) + else BandVectors.1 ((FordRecursiveQuadruple P) 1) ((FordRecursiveQuadruple P) 0)))) + (TileTranslation U ((⟨0,1⟩ : GaussianInt)^3 * + (if Even (3:Nat) then BandVectors.1 ((FordRecursiveQuadruple P) 1) + ((FordRecursiveQuadruple P) 0) + else BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 1)))) W Z + simp only [show ¬Even (3:Nat) from by decide,ite_false,h10,h01] + have dR : (⟨0,1⟩ : GaussianInt)^3 * ⟨P.q,P.q₁⟩ = ⟨P.q₁,-(P.q:Int)⟩ := by + ext <;> norm_num [pow_succ] + have dL : (⟨0,1⟩ : GaussianInt)^3 * ⟨-(P.q₁:Int),P.q⟩ = ⟨P.q,P.q₁⟩ := by + ext <;> norm_num [pow_succ] + rw [dR,dL] + simpa only [hqs,Nat.cast_add,eq_self,ite_true] using finish1 P.q₁ P.q₂ hr hs a b true U W Z + (by simpa [hqs] using hUc) (by simpa [hqs] using hWc) (by simpa [hqs] using hZc) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean new file mode 100644 index 0000000000..f5f2720929 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean @@ -0,0 +1,367 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P5269T1FordSquareNormalForm +public import LeanPool.ApollonianSuperharmonic.P5269T1IncomingSquareJunctions +public import LeanPool.ApollonianSuperharmonic.P5269T1CenteredSquareTripleTransport +public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleLatticeTouching +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality + +-- [TABLET NODE: FordOrientedChildParentIncomingEndpoint] + +/-! +# FordOrientedChildParentIncomingEndpoint + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace IncomingEndpointGeometry + +private theorem cell : + (by + classical + exact + (FordFareyParameter) → ( + let sq := fun (n : Nat) (a : GaussianInt) => TileTranslation (FordTile n) a + ∀ (n : Nat), ∀ (a : GaussianInt), ∀ (z : GaussianInt), z ∈ (sq n a).cells ↔ a.re ≤ z.re ∧ + z.re < a.re+n ∧ a.im ≤ z.im ∧ z.im < a.im+n) ) := by + classical + intro P sq n a z + change z ∈ (FordTile n).cells.image (GaussianTranslation a) ↔ _ + constructor + · rintro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + have hw := (P4210T1FordCellRectangles n w).1.mp hw + dsimp [GaussianTranslation] + omega + · intro hz + exact Finset.mem_image.mpr ⟨z-a, + (P4210T1FordCellRectangles n _).1.mpr (by dsimp; omega), + by simp [GaussianTranslation]⟩ + +private theorem cent : + (by + classical + exact + (FordFareyParameter) → ( + let sq := fun (n : Nat) (a : GaussianInt) => TileTranslation (FordTile n) a + (∀ (n : Nat), ∀ (a : GaussianInt), ∀ (z : GaussianInt), z ∈ (sq n a).cells ↔ a.re ≤ z.re + ∧ z.re < a.re+n ∧ a.im ≤ z.im ∧ z.im < a.im+n) → (∀ (T : ProtoTile), ∀ (n : Nat), (0 + < n) → (∀ (a : GaussianInt), (T.cells = (sq n a).cells) → (TileCentroid T = + ((a.re:Real)+(n:Real)/2,(a.im:Real)+(n:Real)/2))))) ) := by + classical + intro P sq cell T n hn a hc + have hne : (sq n a).cells.Nonempty := ⟨a,(cell n a a).mpr (by omega)⟩ + have ho := ProtoTileObservableExtensionality T (sq n a) hc + (by intro h; rw [h] at hc; exact (hne.ne_empty hc.symm).elim) + rw [ho.2.2.2.2,(TileTranslationFormulas _ _).2.2.2.2.1, + P4210T1FordSquareCentroid n hn] + dsimp + congr 1 <;> ring + +private theorem translate : + (by + classical + exact + let sq := fun (n : Nat) (a : GaussianInt) => TileTranslation (FordTile n) a + ∀ (T : ProtoTile), ∀ (n : Nat), ∀ (a : GaussianInt), ∀ (u : GaussianInt), (T.cells = (sq + n a).cells) → ((TileTranslation T u).cells = (sq n (a+u)).cells) ) := by + classical + intro sq T n a u hc + change T.cells.image (GaussianTranslation u) = _ + rw [hc] + simp only [sq,TileTranslation,Finset.image_image] + apply Finset.image_congr + intro z hz + simp [GaussianTranslation,add_assoc] + +private theorem disk : + (by + classical + exact + let sq := fun (n : Nat) (a : GaussianInt) => TileTranslation (FordTile n) a + ∀ (T : ProtoTile), ∀ (n : Nat), (0 < n) → (∀ (a : GaussianInt), (T.cells = (sq n + a).cells) → (LatticeTile T)) ) := by + classical + intro sq T n hn a hc + have h := (TileDiskAreaCovariance (FordTile n) a).1.mp (FordTileGeometry n hn).1 + simpa only [LatticeTile,TileRealization,hc] using h + +private theorem finish : + (by + classical + exact + (FordFareyParameter) → ( + let sq := fun (n : Nat) (a : GaussianInt) => TileTranslation (FordTile n) a + (∀ (n : Nat), ∀ (a : GaussianInt), ∀ (z : GaussianInt), z ∈ (sq n a).cells ↔ a.re ≤ z.re + ∧ z.re < a.re+n ∧ a.im ≤ z.im ∧ z.im < a.im+n) → ((∀ (T : ProtoTile), ∀ (n : Nat), ∀ + (a : GaussianInt), ∀ (u : GaussianInt), (T.cells = (sq n a).cells) → + ((TileTranslation T u).cells = (sq n (a+u)).cells)) → ((∀ (T : ProtoTile), ∀ (n : + Nat), (0 < n) → (∀ (a : GaussianInt), (T.cells = (sq n a).cells) → (LatticeTile T))) + → (∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∀ (j : Fin 4), ∀ (flip : Bool), ∀ + (t : GaussianInt), ∀ (U : ProtoTile), ∀ (W : ProtoTile), (U.cells = (sq (r+s) + t).cells) → ((W.cells = (sq (![r,s,r,s] j) + ((if flip then (⟨r+s,r+s⟩ : GaussianInt) - + (![⟨s,r+s⟩,⟨-(s:Int),0⟩,⟨-(r:Int),s⟩,⟨r,-(s:Int)⟩] j) - + ⟨![r,s,r,s] j,![r,s,r,s] j⟩ + else (![⟨s,r+s⟩,⟨-(s:Int),0⟩,⟨-(r:Int),s⟩,⟨r,-(s:Int)⟩] j))+t)).cells) → (∀ (D : + GaussianInt), (D = if flip then + -(![⟨r+s,r⟩,⟨-(r+s:Int),s⟩,⟨-(r+s:Int),-(r:Int)⟩,⟨r+s,-(s:Int)⟩] j) + else (![⟨r+s,r⟩,⟨-(r+s:Int),s⟩,⟨-(r+s:Int),-(r:Int)⟩,⟨r+s,-(s:Int)⟩] j)) → (∃ _ : + ExactTileInterfaceTriple U (TileTranslation U D) W, TouchingTriple U + (TileTranslation U D) W))))))))) ) := by + classical + intro P sq cell translate disk r s hr hs j flip t U W hU hW D hD + let b : GaussianInt := ![⟨r+s,r⟩,⟨-(r+s:Int),s⟩,⟨-(r+s:Int),-(r:Int)⟩,⟨r+s,-(s:Int)⟩] j + let c : GaussianInt := ![⟨s,r+s⟩,⟨-(s:Int),0⟩,⟨-(r:Int),s⟩,⟨r,-(s:Int)⟩] j + let n : Nat := ![r,s,r,s] j + let d : GaussianInt := if flip then -b else b + change D = d at hD + subst D + let w : GaussianInt := (if flip then (⟨r+s,r+s⟩ : GaussianInt)-c-⟨n,n⟩ else c)+t + have hn : 0 < n := by fin_cases j <;> simp [n] <;> omega + have hq : 0 < r+s := by omega + have hV := translate U (r+s) t d hU + obtain ⟨E, _, _⟩ := P5269T1IncomingSquareJunctions r s hr hs j + obtain ⟨E', _, _, _, _⟩ := P5269T1CenteredSquareTripleTransport (r+s) flip t + ![r+s,r+s,n] ![0,b,c] + (by intro k; fin_cases k <;> simp <;> omega) + ![U,TileTranslation U d,W] (by + intro k + fin_cases k + · cases flip <;> simpa using hU + · change (TileTranslation U d).cells = + (sq (r+s) ((if flip then (⟨r+s,r+s⟩ : GaussianInt)-b-⟨r+s,r+s⟩ else b)+t)).cells + have he : ((if flip then (⟨r+s,r+s⟩ : GaussianInt)-b-⟨r+s,r+s⟩ else b)+t) = t+d := by + cases flip <;> simp [d] <;> abel + rw [he] + exact hV + · exact hW) E + have hab : Disjoint U.cells (TileTranslation U d).cells := by + apply Finset.disjoint_left.mpr + intro z hz hz' + rw [hU,cell] at hz + rw [hV,cell] at hz' + fin_cases j <;> cases flip <;> dsimp [d,b] at hz hz' <;> omega + have hbc : Disjoint (TileTranslation U d).cells W.cells := by + apply Finset.disjoint_left.mpr + intro z hz hz' + rw [hV,cell] at hz + rw [hW,cell] at hz' + fin_cases j <;> cases flip <;> dsimp [d,b] at hz hz' <;> omega + have hca : Disjoint W.cells U.cells := by + apply Finset.disjoint_left.mpr + intro z hz hz' + rw [hW,cell] at hz + rw [hU,cell] at hz' + fin_cases j <;> cases flip <;> dsimp at hz hz' <;> omega + exact ⟨E',ExactTileInterfaceTripleLatticeTouching _ _ _ E' + (disk U _ hq t hU) (disk _ _ hq (t+d) hV) (disk W n hn w hW) hab hbc hca⟩ + +private theorem hr : + (by + classical + exact + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((Fin (3 : ℕ)) → (0 < P.q₁)) ) := by + classical + intro P hq i + by_contra h + have hz : P.q₁ = 0 := by omega + have hd := P.det₁ + simp [hz] at hd + have hdv : (P.q:Int) ∣ 1 := ⟨P.p₁,by simpa [mul_comm] using hd.symm⟩ + have hone := Int.eq_one_of_dvd_one (by omega : 0 ≤ (P.q:Int)) hdv + omega + +private theorem h01 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : + GaussianInt)) → ((∀ (j : Fin (3 : ℕ)), BandVectors.1 (FordRecursiveQuadruple P (0 : + Fin (4 : ℕ))) (FordRecursiveQuadruple P j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + * BandVectors.1 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin (4 + : ℕ)))) → (BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) + 1) = ⟨-(P.q₁:Int),P.q⟩)) ) := by + classical + intro P h10 hf + have h := (hf 0).1 + change BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 1) = + (⟨0,1⟩ : GaussianInt) * BandVectors.1 ((FordRecursiveQuadruple P) 1) + ((FordRecursiveQuadruple P) 0) at h + rw [h10] at h + exact h.trans (by ext <;> simp) + +private theorem h02 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : + GaussianInt)) → ((∀ (j : Fin (3 : ℕ)), BandVectors.1 (FordRecursiveQuadruple P (0 : + Fin (4 : ℕ))) (FordRecursiveQuadruple P j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + * BandVectors.1 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin (4 + : ℕ)))) → (BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) + 2) = ⟨-(P.q₂:Int),-(P.q:Int)⟩)) ) := by + classical + intro P h20 hf + have h := (hf 1).1 + change BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 2) = + (⟨0,1⟩ : GaussianInt) * BandVectors.1 ((FordRecursiveQuadruple P) 2) + ((FordRecursiveQuadruple P) 0) at h + rw [h20] at h + exact h.trans (by ext <;> simp) + +end IncomingEndpointGeometry + +theorem FordOrientedChildParentIncomingEndpoint + (P : FordFareyParameter) (hq : 1 < P.q) : + let q := FordRecursiveQuadruple P + ∀ (i : Fin 3) (s : Fin 4) (U W : ProtoTile), + BandPrototile (q 0) U → + BandPrototile (q i.succ) W → + 0 < (q 0).1 → 0 < (q i.succ).1 → + TileCentroid W - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) → + let uL := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q i.succ) (q 0) + else BandVectors.1 (q 0) (q i.succ)) + ∃ _ : ExactTileInterfaceTriple U (TileTranslation U uL) W, + TouchingTriple U (TileTranslation U uL) W := by +-- BODY + classical + let sq := fun (n : Nat) (a : GaussianInt) => TileTranslation (FordTile n) a + have cell (n : Nat) (a z : GaussianInt) := IncomingEndpointGeometry.cell P n a z + have cent (T : ProtoTile) (n : Nat) (hn : 0 < n) (a : GaussianInt) + (hc : T.cells = (sq n a).cells) := IncomingEndpointGeometry.cent P cell T n hn a hc + have translate (T : ProtoTile) (n : Nat) (a u : GaussianInt) + (hc : T.cells = (sq n a).cells) := IncomingEndpointGeometry.translate T n a u hc + have disk (T : ProtoTile) (n : Nat) (hn : 0 < n) (a : GaussianInt) + (hc : T.cells = (sq n a).cells) := IncomingEndpointGeometry.disk T n hn a hc + have finish (r s : Nat) (hr : 0 < r) (hs : 0 < s) (j : Fin 4) + (flip : Bool) (t : GaussianInt) (U W : ProtoTile) + (hU : U.cells = (sq (r+s) t).cells) + (hW : W.cells = (sq (![r,s,r,s] j) + ((if flip then (⟨r+s,r+s⟩ : GaussianInt) - + (![⟨s,r+s⟩,⟨-(s:Int),0⟩,⟨-(r:Int),s⟩,⟨r,-(s:Int)⟩] j) - + ⟨![r,s,r,s] j,![r,s,r,s] j⟩ + else (![⟨s,r+s⟩,⟨-(s:Int),0⟩,⟨-(r:Int),s⟩,⟨r,-(s:Int)⟩] j))+t)).cells) + (D : GaussianInt) + (hD : D = if flip then + -(![⟨r+s,r⟩,⟨-(r+s:Int),s⟩,⟨-(r+s:Int),-(r:Int)⟩,⟨r+s,-(s:Int)⟩] j) + else (![⟨r+s,r⟩,⟨-(r+s:Int),s⟩,⟨-(r+s:Int),-(r:Int)⟩,⟨r+s,-(s:Int)⟩] j)) := + IncomingEndpointGeometry.finish P cell translate disk r s hr hs j flip t U W hU hW D hD + dsimp only + intro i s U W hU hW hUpos hWpos hcw + have hr := IncomingEndpointGeometry.hr P hq i + have hs := P.q₂_pos + have hqs := P.sum_q + obtain ⟨hp,h10,h20,_,_⟩ := (FordCoordinateConfiguration P).2 hq + have hf := (VectorRecursionLaws _ hp.1).2.2.2.2 hp + have h01 : BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 1) = + ⟨-(P.q₁:Int),P.q⟩ := IncomingEndpointGeometry.h01 P h10 hf + have h02 : BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 2) = + ⟨-(P.q₂:Int),-(P.q:Int)⟩ := IncomingEndpointGeometry.h02 P h20 hf + obtain ⟨⟨a,b⟩,hUc⟩ := P5269T1FordSquareNormalForm P hq 0 U hU hUpos + have hcu := cent U P.q P.q_pos ⟨a,b⟩ hUc + have he0 : Even (0 : Nat) := by decide + have he1 : ¬ Even (1 : Nat) := by decide + have he2 : Even (2 : Nat) := by decide + have he3 : ¬ Even (3 : Nat) := by decide + fin_cases i + · obtain ⟨⟨wa,wb⟩,hWc⟩ := P5269T1FordSquareNormalForm P hq 1 W hW hWpos + have hcw' := cent W P.q₁ hr ⟨wa,wb⟩ hWc + rw [hcw',hcu] at hcw + fin_cases s + all_goals norm_num [h10,h20,h01,h02,GaussianRealPoint,pow_succ,hqs] at hcw + · refine finish P.q₁ P.q₂ hr hs 0 false ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₁ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · refine finish P.q₁ P.q₂ hr hs 2 false ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₁ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · refine finish P.q₁ P.q₂ hr hs 0 true ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₁ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · refine finish P.q₁ P.q₂ hr hs 2 true ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₁ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · obtain ⟨⟨wa,wb⟩,hWc⟩ := P5269T1FordSquareNormalForm P hq 2 W hW hWpos + have hcw' := cent W P.q₂ hs ⟨wa,wb⟩ hWc + rw [hcw',hcu] at hcw + fin_cases s + all_goals norm_num [h10,h20,h01,h02,GaussianRealPoint,pow_succ,hqs] at hcw + · refine finish P.q₁ P.q₂ hr hs 1 false ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₂ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · refine finish P.q₁ P.q₂ hr hs 3 false ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₂ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · refine finish P.q₁ P.q₂ hr hs 1 true ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₂ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · refine finish P.q₁ P.q₂ hr hs 3 true ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₂ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · norm_num [FordRecursiveQuadruple] at hWpos + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentRightEndpoint.lean b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentRightEndpoint.lean new file mode 100644 index 0000000000..a4405f12ae --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentRightEndpoint.lean @@ -0,0 +1,227 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P5269T1FordSquareNormalForm +public import LeanPool.ApollonianSuperharmonic.P5327T1RightSquareJunctions +public import LeanPool.ApollonianSuperharmonic.P5269T1CenteredSquareTripleTransport +public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality + +-- [TABLET NODE: FordOrientedChildParentRightEndpoint] + +/-! +# FordOrientedChildParentRightEndpoint + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FordOrientedChildParentRightEndpoint + (P : FordFareyParameter) (hq : 1 < P.q) : + let q := FordRecursiveQuadruple P + ∀ (i : Fin 3) (s : Fin 4) (U W : ProtoTile), + BandPrototile (q 0) U → + BandPrototile (q i.succ) W → + 0 < (q 0).1 → 0 < (q i.succ).1 → + TileCentroid W - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) → + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) + Nonempty (ExactTileInterfaceTriple U (TileTranslation U uR) W) := by +-- BODY + classical + let sq := fun (n : Nat) (a : GaussianInt) => TileTranslation (FordTile n) a + have cell (n : Nat) (a z : GaussianInt) : z ∈ (sq n a).cells ↔ + a.re ≤ z.re ∧ z.re < a.re+n ∧ a.im ≤ z.im ∧ z.im < a.im+n := by + change z ∈ (FordTile n).cells.image (GaussianTranslation a) ↔ _ + constructor + · rintro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + have hw := (P4210T1FordCellRectangles n w).1.mp hw + dsimp [GaussianTranslation] + omega + · intro hz + exact Finset.mem_image.mpr ⟨z-a, + (P4210T1FordCellRectangles n _).1.mpr (by dsimp; omega), + by simp [GaussianTranslation]⟩ + have cent (T : ProtoTile) (n : Nat) (hn : 0 < n) (a : GaussianInt) + (hc : T.cells = (sq n a).cells) : + TileCentroid T = ((a.re:Real)+(n:Real)/2,(a.im:Real)+(n:Real)/2) := by + have hne : (sq n a).cells.Nonempty := ⟨a,(cell n a a).mpr (by omega)⟩ + have ho := ProtoTileObservableExtensionality T (sq n a) hc + (by intro h; rw [h] at hc; exact (hne.ne_empty hc.symm).elim) + rw [ho.2.2.2.2,(TileTranslationFormulas _ _).2.2.2.2.1, + P4210T1FordSquareCentroid n hn] + dsimp + congr 1 <;> ring + have translate (T : ProtoTile) (n : Nat) (a u : GaussianInt) + (hc : T.cells = (sq n a).cells) : + (TileTranslation T u).cells = (sq n (a+u)).cells := by + change T.cells.image (GaussianTranslation u) = _ + rw [hc] + simp only [sq,TileTranslation,Finset.image_image] + apply Finset.image_congr + intro z hz + simp [GaussianTranslation,add_assoc] + have finish (r s : Nat) (hr : 0 < r) (hs : 0 < s) (j : Fin 4) + (flip : Bool) (t : GaussianInt) (U W : ProtoTile) + (hU : U.cells = (sq (r+s) t).cells) + (hW : W.cells = (sq (![r,r,s,s] j) + ((if flip then (⟨r+s,r+s⟩ : GaussianInt) - + (![⟨s,r+s⟩,⟨-(r:Int),s⟩,⟨-(s:Int),0⟩,⟨r,-(s:Int)⟩] j) - + ⟨![r,r,s,s] j,![r,r,s,s] j⟩ + else (![⟨s,r+s⟩,⟨-(r:Int),s⟩,⟨-(s:Int),0⟩,⟨r,-(s:Int)⟩] j))+t)).cells) + (D : GaussianInt) + (hD : D = if flip then + -(![⟨-(r:Int),r+s⟩,⟨-(r:Int),r+s⟩,⟨-(s:Int),-(r+s:Int)⟩,⟨-(s:Int),-(r+s:Int)⟩] j) + else (![⟨-(r:Int),r+s⟩,⟨-(r:Int),r+s⟩,⟨-(s:Int),-(r+s:Int)⟩,⟨-(s:Int),-(r+s:Int)⟩] j)) : + Nonempty (ExactTileInterfaceTriple U (TileTranslation U D) W) := by + let b : GaussianInt := + ![⟨-(r:Int),r+s⟩,⟨-(r:Int),r+s⟩,⟨-(s:Int),-(r+s:Int)⟩,⟨-(s:Int),-(r+s:Int)⟩] j + let c : GaussianInt := ![⟨s,r+s⟩,⟨-(r:Int),s⟩,⟨-(s:Int),0⟩,⟨r,-(s:Int)⟩] j + let n : Nat := ![r,r,s,s] j + let d : GaussianInt := if flip then -b else b + change D = d at hD + subst D + have hn : 0 < n := by fin_cases j <;> simp [n] <;> omega + have hq : 0 < r+s := by omega + have hV := translate U (r+s) t d hU + obtain ⟨E, _, _, _, _⟩ := P5327T1RightSquareJunctions r s hr hs j + obtain ⟨E', _, _, _, _⟩ := P5269T1CenteredSquareTripleTransport (r+s) flip t + ![r+s,r+s,n] ![0,b,c] + (by intro k; fin_cases k <;> simp <;> omega) + ![U,TileTranslation U d,W] (by + intro k + fin_cases k + · cases flip <;> simpa using hU + · change (TileTranslation U d).cells = + (sq (r+s) ((if flip then (⟨r+s,r+s⟩ : GaussianInt)-b-⟨r+s,r+s⟩ else b)+t)).cells + have he : ((if flip then (⟨r+s,r+s⟩ : GaussianInt)-b-⟨r+s,r+s⟩ else b)+t) = t+d := by + cases flip <;> simp [d] <;> abel + rw [he] + exact hV + · exact hW) E + exact ⟨E'⟩ + dsimp only + intro i s U W hU hW hUpos hWpos hcw + have hr : 0 < P.q₁ := by + by_contra h + have hz : P.q₁ = 0 := by omega + have hd := P.det₁ + simp [hz] at hd + have hdv : (P.q:Int) ∣ 1 := ⟨P.p₁,by simpa [mul_comm] using hd.symm⟩ + have hone := Int.eq_one_of_dvd_one (by omega : 0 ≤ (P.q:Int)) hdv + omega + have hs := P.q₂_pos + have hqs := P.sum_q + obtain ⟨hp,h10,h20,_,_⟩ := (FordCoordinateConfiguration P).2 hq + have hf := (VectorRecursionLaws _ hp.1).2.2.2.2 hp + have h01 : BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 1) = + ⟨-(P.q₁:Int),P.q⟩ := by + have h := (hf 0).1 + change BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 1) = + (⟨0,1⟩ : GaussianInt) * BandVectors.1 ((FordRecursiveQuadruple P) 1) + ((FordRecursiveQuadruple P) 0) at h + rw [h10] at h + exact h.trans (by ext <;> simp) + have h02 : BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 2) = + ⟨-(P.q₂:Int),-(P.q:Int)⟩ := by + have h := (hf 1).1 + change BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 2) = + (⟨0,1⟩ : GaussianInt) * BandVectors.1 ((FordRecursiveQuadruple P) 2) + ((FordRecursiveQuadruple P) 0) at h + rw [h20] at h + exact h.trans (by ext <;> simp) + obtain ⟨⟨a,b⟩,hUc⟩ := P5269T1FordSquareNormalForm P hq 0 U hU hUpos + have hcu := cent U P.q P.q_pos ⟨a,b⟩ hUc + have he0 : Even (0 : Nat) := by decide + have he1 : ¬ Even (1 : Nat) := by decide + have he2 : Even (2 : Nat) := by decide + have he3 : ¬ Even (3 : Nat) := by decide + fin_cases i + · obtain ⟨⟨wa,wb⟩,hWc⟩ := P5269T1FordSquareNormalForm P hq 1 W hW hWpos + have hcw' := cent W P.q₁ hr ⟨wa,wb⟩ hWc + rw [hcw',hcu] at hcw + fin_cases s + all_goals norm_num [h10,h20,h01,h02,GaussianRealPoint,pow_succ,hqs] at hcw + · refine finish P.q₁ P.q₂ hr hs 0 false ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₁ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · refine finish P.q₁ P.q₂ hr hs 1 false ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₁ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · refine finish P.q₁ P.q₂ hr hs 0 true ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₁ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · refine finish P.q₁ P.q₂ hr hs 1 true ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₁ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · obtain ⟨⟨wa,wb⟩,hWc⟩ := P5269T1FordSquareNormalForm P hq 2 W hW hWpos + have hcw' := cent W P.q₂ hs ⟨wa,wb⟩ hWc + rw [hcw',hcu] at hcw + fin_cases s + all_goals norm_num [h10,h20,h01,h02,GaussianRealPoint,pow_succ,hqs] at hcw + · refine finish P.q₁ P.q₂ hr hs 2 false ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₂ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · refine finish P.q₁ P.q₂ hr hs 3 false ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₂ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · refine finish P.q₁ P.q₂ hr hs 2 true ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₂ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · refine finish P.q₁ P.q₂ hr hs 3 true ⟨a,b⟩ U W + (by simpa [hqs] using hUc) ?_ _ ?_ + · apply hWc.trans + apply congrArg (fun z : GaussianInt => (sq P.q₂ z).cells) + ext <;> apply Int.cast_injective (α := Real) <;> dsimp <;> + push_cast <;> linarith [hcw.1,hcw.2] + · ext <;> norm_num [he0,he1,he2,he3,h10,h20,h01,h02,pow_succ,hqs] + · norm_num [FordRecursiveQuadruple] at hWpos + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordPeakMatrix.lean b/LeanPool/ApollonianSuperharmonic/FordPeakMatrix.lean new file mode 100644 index 0000000000..6a3b83b8c0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordPeakMatrix.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: FordPeakMatrix] + +/-! +# FordPeakMatrix + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For relatively prime $q$ and $|p|$, with $q>0$, the exceptional peak +matrix of the Ford circle $C_{p,q}$ is +$$ + A_{p,q}=\frac1{q^2}\begin{pmatrix}1&pq\\pq&0\end{pmatrix}. +$$ +This definition is made only for $q>0$ Ford circles; it assigns no matrix +to the curvature-zero line parent. +-/ +noncomputable def FordPeakMatrix (p : Int) (q : Nat) (_q_pos : 0 < q) + (_reduced : Nat.Coprime q p.natAbs) : Matrix (Fin 2) (Fin 2) Real := +-- BODY + (1 / ((q : Real) ^ 2)) • ![![(1 : Real), (p : Real) * (q : Real)], + ![(p : Real) * (q : Real), (0 : Real)]] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordRecursiveQuadruple.lean b/LeanPool/ApollonianSuperharmonic/FordRecursiveQuadruple.lean new file mode 100644 index 0000000000..d8bb62a5b4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordRecursiveQuadruple.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter + +-- [TABLET NODE: FordRecursiveQuadruple] + +/-! +# FordRecursiveQuadruple + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a Ford--Farey parameter $P$, its ordered recursive quadruple is +$$ + (C_{p,q},C^1_{p,q},C^2_{p,q},(0,-1)), +$$ +where $C^2_{p,q}=C_{p_2,q_2}$ and +$C^1_{p,q}=C_{p_1,q_1}$ if $q_1>0$, while for $q_1=0$ its coordinate is +the oriented line $(0,1)$. Thus the $q=1$ convention produces the two +oppositely oriented line parents $(0,1)$ and $(0,-1)$ and one unit-circle +parent; it never treats $C_{1,0}$ as a positive-curvature circle. +-/ +def FordRecursiveQuadruple (P : FordFareyParameter) : + Fin 4 → CircleCoordinates := +-- BODY + ![FordCircleCoordinate P.p P.q, + if P.q₁ = 0 then (0, 1) else FordCircleCoordinate P.p₁ P.q₁, + FordCircleCoordinate P.p₂ P.q₂, + (0, -1)] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordRecursiveVertexDomains.lean b/LeanPool/ApollonianSuperharmonic/FordRecursiveVertexDomains.lean new file mode 100644 index 0000000000..a6888defe7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordRecursiveVertexDomains.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction + +-- [TABLET NODE: FordRecursiveVertexDomains] + +/-! +# FordRecursiveVertexDomains + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a Ford--Farey parameter, the four closed recursive vertex domains are +$$ + E_1=[0,q_1]^2,\quad E_2=[q_2,q]^2,\quad + E_3=[q_1,q]\times[0,q_2],\quad + E_4=[0,q_2]\times[q_1,q]. +$$ +Their half-open cell interiors are precisely the four nonempty recursive +pieces identified in `FordTileRecursiveIdentification`. +-/ +def FordRecursiveVertexDomains (P : FordFareyParameter) : Fin 4 -> Set GaussianInt := +-- BODY + ![{x | 0 <= x.re ∧ x.re <= (P.q₁ : Int) ∧ + 0 <= x.im ∧ x.im <= (P.q₁ : Int)}, + {x | (P.q₂ : Int) <= x.re ∧ x.re <= (P.q : Int) ∧ + (P.q₂ : Int) <= x.im ∧ x.im <= (P.q : Int)}, + {x | (P.q₁ : Int) <= x.re ∧ x.re <= (P.q : Int) ∧ + 0 <= x.im ∧ x.im <= (P.q₂ : Int)}, + {x | 0 <= x.re ∧ x.re <= (P.q₂ : Int) ∧ + (P.q₁ : Int) <= x.im ∧ x.im <= (P.q : Int)}] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordRegimeConverse.lean b/LeanPool/ApollonianSuperharmonic/FordRegimeConverse.lean new file mode 100644 index 0000000000..1d03116e31 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordRegimeConverse.lean @@ -0,0 +1,507 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification +public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification + +-- [TABLET NODE: FordRegimeConverse] + +/-! +# FordRegimeConverse + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FordRegimeProof + +private theorem predecessorProper : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 + : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))]) → (ProperBandQuadruple q) := by + classical + intro q hq + have restored := SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1) + have restored' : SemiProperQuadruple q := by + convert restored using 1; funext x; fin_cases x <;> rfl + refine ⟨restored', ?_⟩ + intro j + fin_cases j + · simpa using hq.2 (2 : Fin 3) + · simpa using hq.2 (0 : Fin 3) + · simpa using hq.2 (1 : Fin 3) + +private theorem retainedLine : + ∀ (predecessor : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple ![((2 : ℤ) * + (predecessor (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (predecessor (2 : Fin (4 : ℕ))).1 + (2 : ℤ) + * (predecessor (3 : Fin (4 : ℕ))).1 - (predecessor (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (predecessor (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (predecessor (2 : + Fin (4 : ℕ))).2 + (2 : GaussianInt) * (predecessor (3 : Fin (4 : ℕ))).2 - (predecessor (1 + : Fin (4 : ℕ))).2), predecessor (0 : Fin (4 : ℕ)), predecessor (2 : Fin (4 : ℕ)), + predecessor (3 : Fin (4 : ℕ))]) → ((∀ (k : Fin (4 : ℕ)), (0 : ℤ) ≤ (predecessor k).1) → + (∀ (i : Fin (4 : ℕ)), ((![((2 : ℤ) * (predecessor (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * + (predecessor (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (predecessor (3 : Fin (4 : ℕ))).1 - + (predecessor (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (predecessor (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (predecessor (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * + (predecessor (3 : Fin (4 : ℕ))).2 - (predecessor (1 : Fin (4 : ℕ))).2), predecessor (0 : + Fin (4 : ℕ)), predecessor (2 : Fin (4 : ℕ)), predecessor (3 : Fin (4 : ℕ))] i).1 = (0 : + ℤ)) → ((predecessor 0).1 = 0 ∨ (predecessor 2).1 = 0 ∨ + (predecessor 3).1 = 0))) := by + classical + intro predecessor hq nonnegative i hi + fin_cases i + · have strict := hq.2 0 + have nonnegativeChild := nonnegative 0 + simp at hi strict nonnegativeChild + omega + · exact Or.inl (by simpa using hi) + · exact Or.inr (Or.inl (by simpa using hi)) + · exact Or.inr (Or.inr (by simpa using hi)) + +private theorem successorAction : + ∀ (g : BandPackingSymmetry), (∃ (w : GaussianInt), g = BandPackingSymmetry.shift w ∨ g = + (BandPackingSymmetry.shift w).comp BandPackingSymmetry.negate) → (∀ (x : Fin 4 → + CircleCoordinates), BandPackingSymmetryQuadrupleAction g + ![(2 * (x 0).1 + 2 * (x 2).1 + 2 * (x 3).1 - (x 1).1, + 2 * (x 0).2 + 2 * (x 2).2 + 2 * (x 3).2 - (x 1).2), + x 0, x 2, x 3] = + ![(2 * ((BandPackingSymmetryQuadrupleAction g x) 0).1 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 2).1 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 3).1 - + ((BandPackingSymmetryQuadrupleAction g x) 1).1, + 2 * ((BandPackingSymmetryQuadrupleAction g x) 0).2 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 2).2 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 3).2 - + ((BandPackingSymmetryQuadrupleAction g x) 1).2), + (BandPackingSymmetryQuadrupleAction g x) 0, + (BandPackingSymmetryQuadrupleAction g x) 2, + (BandPackingSymmetryQuadrupleAction g x) 3]) := by + classical + intro g hw x + rcases hw with ⟨w, relation⟩ + rcases relation with relation | relation + · rw [relation] + funext j + fin_cases j <;> + simp [BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, + BandPackingSymmetryReversesOrientation]; ring + · rw [relation] + funext j + fin_cases j <;> + simp [BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, + BandPackingSymmetryReversesOrientation]; ring + +private theorem rotateAction : + ∀ (g : BandPackingSymmetry), (∃ (w : GaussianInt), g = BandPackingSymmetry.shift w ∨ g = + (BandPackingSymmetry.shift w).comp BandPackingSymmetry.negate) → (∀ (x : Fin 4 → + CircleCoordinates), BandPackingSymmetryQuadrupleAction g ![x 0, x 2, x 3, x 1] = + ![(BandPackingSymmetryQuadrupleAction g x) 0, + (BandPackingSymmetryQuadrupleAction g x) 2, + (BandPackingSymmetryQuadrupleAction g x) 3, + (BandPackingSymmetryQuadrupleAction g x) 1]) := by + classical + intro g hw x + rcases hw with ⟨w, relation⟩ + rcases relation with relation | relation + · rw [relation] + funext j + fin_cases j <;> + simp [BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, + BandPackingSymmetryReversesOrientation] + · rw [relation] + funext j + fin_cases j <;> + simp [BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, + BandPackingSymmetryReversesOrientation] + +private theorem determinantCoprime : + ∀ (a : Int), ∀ (b : Nat), ∀ (d : Nat), ∀ (c : Int), a * (d : Int) - (b : Int) * c = 1 → + Nat.Coprime b a.natAbs := by + classical + intro a b d c relation + rw [Nat.coprime_iff_gcd_eq_one] + apply Nat.dvd_one.mp + let divisor := Nat.gcd b a.natAbs + have leftDivides : divisor ∣ b := Nat.gcd_dvd_left _ _ + have rightDivides : divisor ∣ a.natAbs := Nat.gcd_dvd_right _ _ + have leftInteger : (divisor : Int) ∣ (b : Int) := by + exact_mod_cast leftDivides + have rightInteger : (divisor : Int) ∣ a := + (Int.dvd_natAbs).mp (by exact_mod_cast rightDivides) + have relationDivides : (divisor : Int) ∣ + a * (d : Int) - (b : Int) * c := by + exact dvd_sub (dvd_mul_of_dvd_left rightInteger _) + (dvd_mul_of_dvd_left leftInteger _) + rw [relation] at relationDivides + exact (Int.natCast_dvd_natCast).mp relationDivides + +private theorem desiredAt325 : + ∀ (predecessor : Fin (4 : ℕ) → CircleCoordinates), (Fin (4 : ℕ)) → (∀ (predecessorLine : ∃ i + : Fin 4, (predecessor i).1 = 0), ∀ (g : BandPackingSymmetry), ∀ (P : FordFareyParameter), + ∀ (hP : (1 : ℕ) < P.q), (∀ (x : Fin 4 → + CircleCoordinates), BandPackingSymmetryQuadrupleAction g ![(2 * (x 0).1 + 2 * (x 2).1 + 2 + * (x 3).1 - (x 1).1, 2 * (x 0).2 + 2 * (x 2).2 + 2 * (x 3).2 - (x 1).2), x 0, x 2, x 3] = + ![(2 * ((BandPackingSymmetryQuadrupleAction g x) 0).1 + 2 * + ((BandPackingSymmetryQuadrupleAction g x) 2).1 + 2 * ((BandPackingSymmetryQuadrupleAction + g x) 3).1 - ((BandPackingSymmetryQuadrupleAction g x) 1).1, 2 * + ((BandPackingSymmetryQuadrupleAction g x) 0).2 + 2 * ((BandPackingSymmetryQuadrupleAction + g x) 2).2 + 2 * ((BandPackingSymmetryQuadrupleAction g x) 3).2 - + ((BandPackingSymmetryQuadrupleAction g x) 1).2), (BandPackingSymmetryQuadrupleAction g x) + 0, (BandPackingSymmetryQuadrupleAction g x) 2, (BandPackingSymmetryQuadrupleAction g x) + 3]) → (∀ (determinantCoprime : ∀ (a : Int), ∀ (b : Nat), ∀ (d : Nat), ∀ (c : Int), a * (d : + Int) - (b : Int) * c = 1 → Nat.Coprime b a.natAbs), let next0 : FordFareyParameter := + { p := P.p + P.p₂, q := P.q + P.q₂, + q_pos := by omega, + reduced := by + apply determinantCoprime (P.p + P.p₂) (P.q + P.q₂) P.q₂ P.p₂ + norm_num [Nat.cast_add] + nlinarith [P.det₂], + p₁ := P.p, q₁ := P.q, p₂ := P.p₂, q₂ := P.q₂, + sum_p := by ring, + sum_q := by ring, + det₁ := by norm_num [Nat.cast_add]; nlinarith [P.det₂], + det₂ := by norm_num [Nat.cast_add]; nlinarith [P.det₂], + q₁_lt := by have := P.q₂_pos; omega, q₂_pos := P.q₂_pos, + unit_case := by intro h; omega } + (BandPackingSymmetryQuadrupleAction g predecessor = FordRecursiveQuadruple P) → + (BandPackingSymmetryQuadrupleAction g + ![(2 * (predecessor 0).1 + 2 * (predecessor 2).1 + + 2 * (predecessor 3).1 - (predecessor 1).1, + 2 * (predecessor 0).2 + 2 * (predecessor 2).2 + + 2 * (predecessor 3).2 - (predecessor 1).2), + predecessor 0, predecessor 2, predecessor 3] = + FordRecursiveQuadruple next0))) := by + classical + intro predecessor i predecessorLine g P hP successorAction determinantCoprime next0 + actionPredecessor + rw [successorAction predecessor, actionPredecessor] + simp? [next0, FordRecursiveQuadruple, FordCircleCoordinate] + split_ifs <;> simp_all? [P.sum_q, P.sum_p] <;> ring + repeat' first | constructor | (ext <;> simp; ring) + all_goals try (intro hp; have := P.q₂_pos; omega) + + +private theorem actionPredecessorAt357 : + ∀ (predecessor : Fin (4 : ℕ) → CircleCoordinates), ∀ (g : BandPackingSymmetry), ∀ (P : + FordFareyParameter), (BandPackingSymmetryReversesOrientation g = false) → ((∀ (x : Fin 4 + → CircleCoordinates), BandPackingSymmetryQuadrupleAction g ![x 0, x 2, x 3, x 1] = + ![(BandPackingSymmetryQuadrupleAction g x) 0, (BandPackingSymmetryQuadrupleAction g x) 2, + (BandPackingSymmetryQuadrupleAction g x) 3, (BandPackingSymmetryQuadrupleAction g x) 1]) + → ((BandPackingSymmetryQuadrupleAction g ![predecessor (0 : Fin (4 : ℕ)), predecessor + ((fun (i : Fin (3 : ℕ)) => i) ⟨nat_lit 2, by norm_num⟩).succ, predecessor ((fun (i : Fin + (3 : ℕ)) + => i) ⟨nat_lit 2, by norm_num⟩ + (1 : Fin (3 : ℕ))).succ, predecessor ((fun (i : Fin (3 : + ℕ)) => i) + ⟨nat_lit 2, by norm_num⟩ + (2 : Fin (3 : ℕ))).succ] = FordRecursiveQuadruple P) → + (BandPackingSymmetryQuadrupleAction g predecessor = + ![(FordRecursiveQuadruple P) 0, + (FordRecursiveQuadruple P) 2, + (FordRecursiveQuadruple P) 3, + (FordRecursiveQuadruple P) 1]))) := by + classical + intro predecessor g P hg rotateAction heq + let rotatedInput : Fin 4 → CircleCoordinates := + ![predecessor 0, predecessor 2, predecessor 3, predecessor 1] + have ordered := rotateAction rotatedInput + have heq' : BandPackingSymmetryQuadrupleAction g + ![rotatedInput 0, rotatedInput 2, rotatedInput 3, + rotatedInput 1] = FordRecursiveQuadruple P := by + simpa [rotatedInput] using heq + rw [heq'] at ordered + funext j + fin_cases j + · simpa [rotatedInput, hg, BandPackingSymmetryQuadrupleAction] using + (congrFun ordered (0 : Fin 4)).symm + · simpa [rotatedInput, hg, BandPackingSymmetryQuadrupleAction] using + (congrFun ordered (2 : Fin 4)).symm + · simpa [rotatedInput, hg, BandPackingSymmetryQuadrupleAction] using + (congrFun ordered (3 : Fin 4)).symm + · simpa [rotatedInput, hg, BandPackingSymmetryQuadrupleAction] using + (congrFun ordered (1 : Fin 4)).symm + +private theorem desiredAt381 : + ∀ (predecessor : Fin (4 : ℕ) → CircleCoordinates), (Fin (4 : ℕ)) → (∀ (predecessorLine : ∃ i + : Fin 4, (predecessor i).1 = 0), ∀ (g : BandPackingSymmetry), ∀ (P : FordFareyParameter), + ∀ (hP : (1 : ℕ) < P.q), (BandPackingSymmetryReversesOrientation g = false) → ((∀ (x : Fin + 4 → + CircleCoordinates), BandPackingSymmetryQuadrupleAction g ![(2 * (x 0).1 + 2 * (x 2).1 + 2 + * (x 3).1 - (x 1).1, 2 * (x 0).2 + 2 * (x 2).2 + 2 * (x 3).2 - (x 1).2), x 0, x 2, x 3] = + ![(2 * ((BandPackingSymmetryQuadrupleAction g x) 0).1 + 2 * + ((BandPackingSymmetryQuadrupleAction g x) 2).1 + 2 * ((BandPackingSymmetryQuadrupleAction + g x) 3).1 - ((BandPackingSymmetryQuadrupleAction g x) 1).1, 2 * + ((BandPackingSymmetryQuadrupleAction g x) 0).2 + 2 * ((BandPackingSymmetryQuadrupleAction + g x) 2).2 + 2 * ((BandPackingSymmetryQuadrupleAction g x) 3).2 - + ((BandPackingSymmetryQuadrupleAction g x) 1).2), (BandPackingSymmetryQuadrupleAction g x) + 0, (BandPackingSymmetryQuadrupleAction g x) 2, (BandPackingSymmetryQuadrupleAction g x) + 3]) → (∀ (determinantCoprime : ∀ (a : Int), ∀ (b : Nat), ∀ (d : Nat), ∀ (c : Int), a * (d : + Int) - (b : Int) * c = 1 → Nat.Coprime b a.natAbs), let next2 : FordFareyParameter := + { p := P.p + P.p₁, q := P.q + P.q₁, + q_pos := by omega, + reduced := by + apply determinantCoprime (P.p + P.p₁) (P.q + P.q₁) P.q P.p + norm_num [Nat.cast_add] + nlinarith [P.det₁], + p₁ := P.p₁, q₁ := P.q₁, p₂ := P.p, q₂ := P.q, + sum_p := by ring, + sum_q := by ring, + det₁ := by norm_num [Nat.cast_add]; nlinarith [P.det₁], + det₂ := by norm_num [Nat.cast_add]; nlinarith [P.det₁], + q₁_lt := by have := P.q_pos; omega, q₂_pos := P.q_pos, + unit_case := by intro h; omega } + (BandPackingSymmetryQuadrupleAction g predecessor = ![(FordRecursiveQuadruple P) 0, + (FordRecursiveQuadruple P) 2, (FordRecursiveQuadruple P) 3, (FordRecursiveQuadruple P) + 1]) → (BandPackingSymmetryQuadrupleAction g + ![(2 * (predecessor 0).1 + 2 * (predecessor 2).1 + + 2 * (predecessor 3).1 - (predecessor 1).1, + 2 * (predecessor 0).2 + 2 * (predecessor 2).2 + + 2 * (predecessor 3).2 - (predecessor 1).2), + predecessor 3, predecessor 0, predecessor 2] = + FordRecursiveQuadruple next2)))) := by + classical + intro predecessor i predecessorLine g P hP hg successorAction determinantCoprime next2 + actionPredecessor + let y : Fin 4 → CircleCoordinates := + ![predecessor 3, predecessor 1, predecessor 0, predecessor 2] + have actionY : + BandPackingSymmetryQuadrupleAction g + y = + ![(BandPackingSymmetryQuadrupleAction g predecessor) 3, + (BandPackingSymmetryQuadrupleAction g predecessor) 1, + (BandPackingSymmetryQuadrupleAction g predecessor) 0, + (BandPackingSymmetryQuadrupleAction g predecessor) 2] := by + funext j + fin_cases j <;> simp [y, hg, BandPackingSymmetryQuadrupleAction] + have successorY := successorAction y + rw [actionY, actionPredecessor] at successorY + convert successorY using 1 <;> + simp? [y, next2, FordRecursiveQuadruple, + FordCircleCoordinate, P.sum_q, P.sum_p] <;> + ring + all_goals split_ifs <;> + simp_all? [] <;> + try constructor + all_goals try ring + all_goals ext <;> simp_all; ring + +end FordRegimeProof + +theorem FordRegimeConverse (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) + (hline : ∃ i : Fin 4, (q i).1 = 0) : + ∃ (r : Fin 3) (g : BandPackingSymmetry) (P : FordFareyParameter), + 1 < P.q ∧ + BandPackingSymmetryReversesOrientation g = false ∧ + (∃ w : GaussianInt, + g = .shift w ∨ g = .comp (.shift w) .negate) ∧ + (q ((r + 2).succ)).1 = 0 ∧ + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] = + FordRecursiveQuadruple P := by +-- BODY + induction hq.1 with + | base z => + have bad := hq.2 0 + simp at bad + | @rotate q hq ih => + have predecessorProper : ProperBandQuadruple q := FordRegimeProof.predecessorProper q hq + obtain ⟨i, hi⟩ := hline + have predecessorLine : ∃ i : Fin 4, (q i).1 = 0 := by + fin_cases i <;> simp_all <;> aesop + obtain ⟨r, g, P, hP, hg, hw, hz, heq⟩ := ih predecessorProper predecessorLine + fin_cases r + · refine ⟨2, g, P, hP, hg, hw, ?_, ?_⟩ + · simpa using hz + · simpa using heq + · refine ⟨0, g, P, hP, hg, hw, ?_, ?_⟩ + · simpa using hz + · simpa using heq + · refine ⟨1, g, P, hP, hg, hw, ?_, ?_⟩ + · simpa using hz + · simpa using heq + | @successor predecessor predecessorSemi ih => + obtain ⟨nonnegative, cases⟩ := SemiProperForestClassification predecessor predecessorSemi + rcases cases with root | root | root | ⟨predecessorTuple, predecessorProof⟩ + · rcases root with ⟨z, hz⟩ + have bad := hq.2 0 + rw [hz] at bad + simp at bad + · rcases root with ⟨z, hz⟩ + let standard : FordFareyParameter := + { p := 1, q := 2, q_pos := by norm_num, reduced := by norm_num, + p₁ := 1, q₁ := 1, p₂ := 0, q₂ := 1, + sum_p := by norm_num, sum_q := by norm_num, + det₁ := by norm_num, det₂ := by norm_num, + q₁_lt := by norm_num, q₂_pos := by norm_num, + unit_case := by omega } + refine ⟨2, .shift (-z), standard, by norm_num, by rfl, ?_, ?_, ?_⟩ + · exact ⟨-z, Or.inl rfl⟩ + · simp [hz] + · simp? [standard, hz, FordRecursiveQuadruple, FordCircleCoordinate, + BandPackingSymmetryQuadrupleAction, BandPackingSymmetryCircleAction, + BandPackingSymmetryReversesOrientation] + repeat' first | constructor | (ext <;> simp <;> ring) + · rcases root with ⟨z, hz⟩ + let standard : FordFareyParameter := + { p := 1, q := 2, q_pos := by norm_num, reduced := by norm_num, + p₁ := 1, q₁ := 1, p₂ := 0, q₂ := 1, + sum_p := by norm_num, sum_q := by norm_num, + det₁ := by norm_num, det₂ := by norm_num, + q₁_lt := by norm_num, q₂_pos := by norm_num, + unit_case := by omega } + refine ⟨0, .comp (.shift (z + 1 + ⟨0, 1⟩)) .negate, standard, + by norm_num, by rfl, ?_, ?_, ?_⟩ + · exact ⟨z + 1 + ⟨0, 1⟩, Or.inr rfl⟩ + · simp [hz] + · simp? [standard, hz, FordRecursiveQuadruple, FordCircleCoordinate, + BandPackingSymmetryQuadrupleAction, BandPackingSymmetryCircleAction, + BandPackingSymmetryReversesOrientation] + repeat' first | constructor | (ext <;> simp <;> ring) + · obtain ⟨i, hi⟩ := hline + have retainedLine : + (predecessor 0).1 = 0 ∨ (predecessor 2).1 = 0 ∨ + (predecessor 3).1 = 0 := FordRegimeProof.retainedLine predecessor hq nonnegative i hi + have predecessorLine : ∃ i : Fin 4, (predecessor i).1 = 0 := by + fin_cases i + · have strict := hq.2 0 + have nonnegativeChild := nonnegative 0 + simp at hi strict nonnegativeChild ⊢ + omega + · exact ⟨0, by simpa using hi⟩ + · exact ⟨2, by simpa using hi⟩ + · exact ⟨3, by simpa using hi⟩ + obtain ⟨r, g, P, hP, hg, hw, hz, heq⟩ := + ih ⟨predecessorTuple, predecessorProof⟩ predecessorLine + have unique := ProperBandCurvatureStructure predecessor + ⟨predecessorTuple, predecessorProof⟩ + have successorAction (x : Fin 4 → CircleCoordinates) : + BandPackingSymmetryQuadrupleAction g + ![(2 * (x 0).1 + 2 * (x 2).1 + 2 * (x 3).1 - (x 1).1, + 2 * (x 0).2 + 2 * (x 2).2 + 2 * (x 3).2 - (x 1).2), + x 0, x 2, x 3] = + ![(2 * ((BandPackingSymmetryQuadrupleAction g x) 0).1 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 2).1 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 3).1 - + ((BandPackingSymmetryQuadrupleAction g x) 1).1, + 2 * ((BandPackingSymmetryQuadrupleAction g x) 0).2 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 2).2 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 3).2 - + ((BandPackingSymmetryQuadrupleAction g x) 1).2), + (BandPackingSymmetryQuadrupleAction g x) 0, + (BandPackingSymmetryQuadrupleAction g x) 2, + (BandPackingSymmetryQuadrupleAction g x) 3] := FordRegimeProof.successorAction g + hw x + have rotateAction (x : Fin 4 → CircleCoordinates) : + BandPackingSymmetryQuadrupleAction g ![x 0, x 2, x 3, x 1] = + ![(BandPackingSymmetryQuadrupleAction g x) 0, + (BandPackingSymmetryQuadrupleAction g x) 2, + (BandPackingSymmetryQuadrupleAction g x) 3, + (BandPackingSymmetryQuadrupleAction g x) 1] := FordRegimeProof.rotateAction g hw x + have determinantCoprime : ∀ (a : Int) (b d : Nat) (c : Int), + a * (d : Int) - (b : Int) * c = 1 → Nat.Coprime b a.natAbs := + FordRegimeProof.determinantCoprime + let next0 : FordFareyParameter := + { p := P.p + P.p₂, q := P.q + P.q₂, + q_pos := by omega, + reduced := by + apply determinantCoprime (P.p + P.p₂) (P.q + P.q₂) P.q₂ P.p₂ + norm_num [Nat.cast_add] + nlinarith [P.det₂], + p₁ := P.p, q₁ := P.q, p₂ := P.p₂, q₂ := P.q₂, + sum_p := by ring, + sum_q := by ring, + det₁ := by norm_num [Nat.cast_add]; nlinarith [P.det₂], + det₂ := by norm_num [Nat.cast_add]; nlinarith [P.det₂], + q₁_lt := by have := P.q₂_pos; omega, q₂_pos := P.q₂_pos, + unit_case := by intro h; omega } + let next2 : FordFareyParameter := + { p := P.p + P.p₁, q := P.q + P.q₁, + q_pos := by omega, + reduced := by + apply determinantCoprime (P.p + P.p₁) (P.q + P.q₁) P.q P.p + norm_num [Nat.cast_add] + nlinarith [P.det₁], + p₁ := P.p₁, q₁ := P.q₁, p₂ := P.p, q₂ := P.q, + sum_p := by ring, + sum_q := by ring, + det₁ := by norm_num [Nat.cast_add]; nlinarith [P.det₁], + det₂ := by norm_num [Nat.cast_add]; nlinarith [P.det₁], + q₁_lt := by have := P.q_pos; omega, q₂_pos := P.q_pos, + unit_case := by intro h; omega } + fin_cases r + · refine ⟨0, g, next0, ?_, hg, hw, ?_, ?_⟩ + · dsimp [next0] + have := P.q₂_pos + omega + · simpa using hz + · have actionPredecessor : + BandPackingSymmetryQuadrupleAction g predecessor = + FordRecursiveQuadruple P := by + have shape : ![predecessor 0, predecessor 1, + predecessor 2, predecessor 3] = predecessor := by + funext j + fin_cases j <;> rfl + rw [← shape] + exact heq + have desired : BandPackingSymmetryQuadrupleAction g + ![(2 * (predecessor 0).1 + 2 * (predecessor 2).1 + + 2 * (predecessor 3).1 - (predecessor 1).1, + 2 * (predecessor 0).2 + 2 * (predecessor 2).2 + + 2 * (predecessor 3).2 - (predecessor 1).2), + predecessor 0, predecessor 2, predecessor 3] = + FordRecursiveQuadruple next0 := FordRegimeProof.desiredAt325 predecessor i + predecessorLine g P hP successorAction determinantCoprime actionPredecessor + simpa using desired + · exfalso + have removed : (predecessor 1).1 = 0 := by simpa using hz + rcases retainedLine with h0 | retainedLine + · have strict := predecessorProof (0 : Fin 3) + have nonnegativeChild := nonnegative 1 + omega + rcases retainedLine with h2 | h3 + · have different := unique.2.2 (0 : Fin 3) (1 : Fin 3) + removed h2 + omega + · have different := unique.2.2 (0 : Fin 3) (2 : Fin 3) + removed h3 + omega + · refine ⟨2, g, next2, ?_, hg, hw, ?_, ?_⟩ + · dsimp [next2] + have := P.q₂_pos + omega + · simpa using hz + · have actionPredecessor : + BandPackingSymmetryQuadrupleAction g predecessor = + ![(FordRecursiveQuadruple P) 0, + (FordRecursiveQuadruple P) 2, + (FordRecursiveQuadruple P) 3, + (FordRecursiveQuadruple P) 1] := FordRegimeProof.actionPredecessorAt357 + predecessor g P hg rotateAction heq + have desired : BandPackingSymmetryQuadrupleAction g + ![(2 * (predecessor 0).1 + 2 * (predecessor 2).1 + + 2 * (predecessor 3).1 - (predecessor 1).1, + 2 * (predecessor 0).2 + 2 * (predecessor 2).2 + + 2 * (predecessor 3).2 - (predecessor 1).2), + predecessor 3, predecessor 0, predecessor 2] = + FordRecursiveQuadruple next2 := FordRegimeProof.desiredAt381 predecessor i + predecessorLine g P hP hg successorAction determinantCoprime actionPredecessor + simpa using desired + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean b/LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean new file mode 100644 index 0000000000..08e09f8b43 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean @@ -0,0 +1,701 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1LiteralNormalization +public import LeanPool.ApollonianSuperharmonic.P5332T1VectorPlacements +public import LeanPool.ApollonianSuperharmonic.P5332T1RightFirstValues +public import LeanPool.ApollonianSuperharmonic.P5332T1RightSecondValues +public import LeanPool.ApollonianSuperharmonic.P5332T1RightHorizontalValues +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent1Rotation0Values +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent1Rotation1Values +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent1Rotation2Values +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent1Rotation3Values +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent2Rotation0Values +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent2Rotation1Values +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent2Rotation2Values +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent2Rotation3Values +public import LeanPool.ApollonianSuperharmonic.P5332T1RightRounding +public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRounding + +-- [TABLET NODE: FordTerminalWebStencilLedger] + +/-! +# FordTerminalWebStencilLedger + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FordTerminalStencilGeometry + +private theorem lapValues : + (by + classical + exact + ∀ (f : IntegerLatticeFunction), ∀ (z : GaussianInt), ∀ (V : Fin 5 → Int), (∀ k : Fin 5, + f (z + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] k)) = V k) → + (FourNeighborLaplacian f z = V 1 + V 2 + V 3 + V 4 - 4 * V 0) ) := by + classical + intro f z V hV + unfold FourNeighborLaplacian + rw [show f (z + 1) = V 1 by simpa using hV 1, + show f (z - 1) = V 2 by simpa [sub_eq_add_neg] using hV 2, + show f (z + ⟨0, 1⟩) = V 3 by simpa using hV 3, + show f (z - ⟨0, 1⟩) = V 4 by simpa [sub_eq_add_neg] using hV 4, + show f z = V 0 by simpa using hV 0] + +private theorem positive : + (by + classical + exact + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → (( + let q := FordRecursiveQuadruple P + (∀ j : Fin 3, + BandVectors.1 (q 0) (q j.succ) = (P5332T1RightRows P j 0).displacement ∧ + BandVectors.2 (q 0) (q j.succ) = (P5332T1RightRows P j 0).linear) ∧ + ∀ (j : Fin 2), ∀ (k : Fin 4), + let i : Fin 3 := ⟨j.val, by omega⟩ + let R := P5332T1ParentRows P j k 0 + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ k.val * + (BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ))) = + (((((![P.q₁, P.q₂] j : Nat) : ℝ) - P.q) / 2 + R.displacement.re), + ((((![P.q₁, P.q₂] j : Nat) : ℝ) - P.q) / 2 + R.displacement.im)) ∧ + (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ k.val * + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ))) = + (((((![P.p₁, P.p₂] j : Int) : ℝ) - P.p) / 2 + R.linear.re), + ((((![P.p₁, P.p₂] j : Int) : ℝ) - P.p) / 2 + R.linear.im)) ∧ + (⟨0, 1⟩ : GaussianInt) ^ k.val * + (if Even k.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) = R.companion) → ((∀ (f : + IntegerLatticeFunction), ∀ (z : GaussianInt), ∀ (V : Fin 5 → Int), (∀ k : Fin + 5, f (z + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] k)) = V k) → + (FourNeighborLaplacian f z = V 1 + V 2 + V 3 + V 4 - 4 * V 0)) → (∀ (i : Fin + 3), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : + PartialOdometer), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), ∀ (g : + IntegerLatticeFunction), ∀ (x : GaussianInt), TileOdometer + (FordRecursiveQuadruple P 0) T h → TileOdometer (FordRecursiveQuadruple P 0) T' + h' → PartialOdometerSlope h = some p → PartialOdometerSlope h' = some p' → + TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P i.succ)) → p'.1 - p.1 = + (BandVectors.2 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P + i.succ)).re → p'.2 - p.2 = (BandVectors.2 (FordRecursiveQuadruple P 0) + (FordRecursiveQuadruple P i.succ)).im → GlobalOdometerExtends g h → + GlobalOdometerExtends g h' → x ∈ h.domain → x ∈ h'.domain → (∀ y, y = x ∨ y = x + + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ h.domain ∨ y ∈ + h'.domain) → ((∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ z = x - 1 - ⟨0, 1⟩ → z + ∈ T.cells ∨ z ∈ T'.cells) → FourNeighborLaplacian g x = 1) ∧ (¬ (∀ z, z = x ∨ z + = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ z = x - 1 - ⟨0, 1⟩ → z ∈ T.cells ∨ z ∈ T'.cells) → + FourNeighborLaplacian g x = 0))))) := by + classical + intro P hq vectors lapValues i T U h k p p' g x hT hU hp hp' hc ha hb he he' hx hx' hstar + obtain ⟨u, d, a, B, f, hdom, hdom', hcell, hcell', hfoot, + hcent, hslope, hslope', hbase, hother, hlap⟩ := + P5332T1LiteralNormalization P P T U h k p p' g hT hU hp hp' he he' + rw [(vectors.1 i).1] at hc + rw [(vectors.1 i).2] at ha hb + simp only [sub_self, zero_div, zero_add] at hcent hslope hslope' + have hd : d = (P5332T1RightRows P i 0).displacement := by + apply Zsqrtd.ext + · have hh := congrArg Prod.fst (hcent.symm.trans hc) + dsimp only [GaussianRealPoint] at hh + exact_mod_cast hh + · have hh := congrArg Prod.snd (hcent.symm.trans hc) + dsimp only [GaussianRealPoint] at hh + exact_mod_cast hh + have ha' : a = (P5332T1RightRows P i 0).linear := by + apply Zsqrtd.ext + · exact_mod_cast hslope.symm.trans ha + · exact_mod_cast hslope'.symm.trans hb + subst d + subst a + have hstar' : ∀ l : Fin 5, + x-u + (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] l) ∈ FordVertexDomain P.q ∨ + x-u + (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] l) - + (P5332T1RightRows P i 0).displacement ∈ FordVertexDomain P.q := by + intro l + have hh := hstar (x + (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] l)) + (by fin_cases l <;> simp [sub_eq_add_neg]) + simpa [hdom, hdom', sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hh + have source : ∃ t : Int, 0 ≤ t ∧ + t ≤ ((![P.q₂,P.q₁,P.q] i : Nat) : Int) ∧ + (∀ l : Fin 5, f (x-u + (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] l)) = + (P5332T1RightRows P i t).values l) ∧ + ((∀ z, z = x-u ∨ z = x-u-1 ∨ z = x-u-⟨0,1⟩ ∨ z = x-u-1-⟨0,1⟩ → + z ∈ (FordTile P.q).cells ∨ + z - (P5332T1RightRows P i 0).displacement ∈ (FordTile P.q).cells) ↔ + 0 < t ∧ t < ((![P.q₂,P.q₁,P.q] i : Nat) : Int)) := by + fin_cases i + · obtain ⟨t, ht, ht', _, _, hv, hh⟩ := P5332T1RightFirstValues P hq f B + (x-u) hbase hother ((hdom x).mp hx) ((hdom' x).mp hx') hstar' + exact ⟨t, ht, ht', hv, hh⟩ + · obtain ⟨t, ht, ht', _, _, hv, hh⟩ := P5332T1RightSecondValues P hq f B + (x-u) hbase hother ((hdom x).mp hx) ((hdom' x).mp hx') hstar' + exact ⟨t, ht, ht', hv, hh⟩ + · obtain ⟨t, ht, ht', _, _, hv, hh⟩ := P5332T1RightHorizontalValues P hq f B + (x-u) hbase hother ((hdom x).mp hx) ((hdom' x).mp hx') hstar' + exact ⟨t, ht, ht', hv, hh⟩ + obtain ⟨t, ht, ht', hv, hh⟩ := source + have celltest : (∀ z, z = x ∨ z = x-1 ∨ z = x-⟨0,1⟩ ∨ z = x-1-⟨0,1⟩ → + z ∈ T.cells ∨ z ∈ U.cells) ↔ + (∀ z, z = x-u ∨ z = x-u-1 ∨ z = x-u-⟨0,1⟩ ∨ z = x-u-1-⟨0,1⟩ → + z ∈ (FordTile P.q).cells ∨ + z - (P5332T1RightRows P i 0).displacement ∈ (FordTile P.q).cells) := by + constructor + · intro H z hz + have hz' : z+u = x ∨ z+u = x-1 ∨ z+u = x-⟨0,1⟩ ∨ z+u = x-1-⟨0,1⟩ := by + rcases hz with rfl | rfl | rfl | rfl <;> + simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + simpa [hcell, hcell', sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + using H (z+u) hz' + · intro H z hz + have hz' : z-u = x-u ∨ z-u = x-u-1 ∨ z-u = x-u-⟨0,1⟩ ∨ z-u = x-u-1-⟨0,1⟩ := by + rcases hz with rfl | rfl | rfl | rfl <;> + simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + simpa [hcell, hcell'] using H (z-u) hz' + have hg : FourNeighborLaplacian g x = + if 0 < t ∧ t < ((![P.q₂,P.q₁,P.q] i : Nat) : Int) then 1 else 0 := by + rw [hlap x, lapValues f (x-u) _ hv] + exact P5332T1RightRounding P hq i t ht ht' + constructor + · intro H + rw [hg, ite_eq_left (hh.mp (celltest.mp H))] + · intro H + rw [hg, ite_eq_right (fun h => H (celltest.mpr (hh.mpr h)))] + +private theorem hc' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (T : ProtoTile), ∀ (U : ProtoTile), + (TileCentroid U - TileCentroid T = (if false = true then (1 : ℝ) else (-1 : ℝ)) • + GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ))) → (TileCentroid T - TileCentroid U = + GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple + P i.succ))) ) := by + classical + intro P i T U hc + simpa using congrArg Neg.neg hc + +private theorem ha'At320 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), (p'.1 - + p.1 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ)).re : + ℝ)) → (p.1 - p'.1 = (BandVectors.2 (FordRecursiveQuadruple P 0) + (FordRecursiveQuadruple P i.succ)).re) ) := by + classical + intro P i p p' ha + change p'.1 - p.1 = -1 * _ at ha + linarith + +private theorem hb' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), (p'.2 - + p.2 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ)).im : + ℝ)) → (p.2 - p'.2 = (BandVectors.2 (FordRecursiveQuadruple P 0) + (FordRecursiveQuadruple P i.succ)).im) ) := by + classical + intro P i p p' hb + change p'.2 - p.2 = -1 * _ at hb + linarith + +private theorem hs : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), (∀ (y : + GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ + h.domain ∨ y ∈ k.domain) → (∀ y, y = x ∨ y = x+1 ∨ y = x-1 ∨ y = x+⟨0,1⟩ ∨ y = + x-⟨0,1⟩ → y ∈ k.domain ∨ y ∈ h.domain) ) := by + classical + intro h k x hstar y hy + exact (hstar y hy).symm + +private theorem hiAt337 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T : ProtoTile), + ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), ((0 : ℤ) < + (FordRecursiveQuadruple P i.succ).1) → ((TileOdometer (FordRecursiveQuadruple P + i.succ) U k) → ((TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 + (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + + BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + i.succ)))) → ((p'.1 - p.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.2 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ)))).1) → ((p'.2 - p.2 = ((1 / 2 + : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * + (BandVectors.2 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ))) + BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ)))).2) → (i.val < 2))))) ) := by + classical + intro P i s T U k p p' hpos hU hc ha hb + by_contra hn + have hi : i = 2 := Fin.ext (by omega) + subst i + change (0 : Int) < 0 at hpos + omega + +private theorem hdAt363 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T : ProtoTile), + ∀ (U : ProtoTile), (TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 + (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + + BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + i.succ)))) → (∀ (hi : i.val < 2), + let j : Fin 2 := ⟨i.val, hi⟩ + ∀ (A : FordFareyParameter), (A.q = ![P.q₁, P.q₂] j) → (∀ (d : GaussianInt), (TileCentroid + U - TileCentroid T = (((↑A.q : ℝ) - (↑P.q : ℝ)) / (2 : ℝ) + (↑d.re : ℝ), ((↑A.q : ℝ) + - (↑P.q : ℝ)) / (2 : ℝ) + (↑d.im : ℝ))) → (((1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (FordRecursiveQuadruple P + i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) = + (((↑(![P.q₁, P.q₂] j) : ℝ) - (↑P.q : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 + : ℤ)).displacement.re : ℝ), ((↑(![P.q₁, P.q₂] j) : ℝ) - (↑P.q : ℝ)) / (2 : ℝ) + + (↑(P5332T1ParentRows P j s (0 : ℤ)).displacement.im : ℝ)) ∧ (1 / 2 : ℝ) • + GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 + (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + + BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + i.succ))) = (((↑(![P.p₁, P.p₂] j) : ℝ) - (↑P.p : ℝ)) / (2 : ℝ) + + (↑(P5332T1ParentRows P j s (0 : ℤ)).linear.re : ℝ), ((↑(![P.p₁, P.p₂] j) : ℝ) - + (↑P.p : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : ℤ)).linear.im : ℝ)) ∧ ((⟨(0 + : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ) else + BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 + : ℕ)))) = (P5332T1ParentRows P j s (0 : ℤ)).companion) → (d = (P5332T1ParentRows + P j s 0).displacement)))) ) := by + classical + intro P i s T U hc hi j A hAq d hcent vv + apply Zsqrtd.ext + · have hn := congrArg Prod.fst hcent + have hv := congrArg Prod.fst (hc.trans vv.1) + rw [hAq] at hn + dsimp at hn hv + exact_mod_cast (show (d.re : ℝ) = (P5332T1ParentRows P j s 0).displacement.re by linarith) + · have hn := congrArg Prod.snd hcent + have hv := congrArg Prod.snd (hc.trans vv.1) + rw [hAq] at hn + dsimp at hn hv + exact_mod_cast (show (d.im : ℝ) = (P5332T1ParentRows P j s 0).displacement.im by linarith) + +private theorem ha'At375 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (p : ℝ × ℝ), ∀ + (p' : ℝ × ℝ), (p'.1 - p.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.2 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ)))).1) → ((p'.2 - p.2 = ((1 / 2 + : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * + (BandVectors.2 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ))) + BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ)))).2) → (∀ (hi : i.val < 2), + let j : Fin 2 := ⟨i.val, hi⟩ + ∀ (A : FordFareyParameter), (A.p = ![P.p₁, P.p₂] j) → (∀ (a : GaussianInt), (p'.1 - p.1 = + ((↑A.p : ℝ) - (↑P.p : ℝ)) / (2 : ℝ) + (↑a.re : ℝ)) → ((p'.2 - p.2 = ((↑A.p : ℝ) - + (↑P.p : ℝ)) / (2 : ℝ) + (↑a.im : ℝ)) → (((1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) = (((↑(![P.q₁, P.q₂] j) : ℝ) + - (↑P.q : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : ℤ)).displacement.re : ℝ), + ((↑(![P.q₁, P.q₂] j) : ℝ) - (↑P.q : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : + ℤ)).displacement.im : ℝ)) ∧ (1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.2 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) = (((↑(![P.p₁, P.p₂] j) : ℝ) + - (↑P.p : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : ℤ)).linear.re : ℝ), + ((↑(![P.p₁, P.p₂] j) : ℝ) - (↑P.p : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : + ℤ)).linear.im : ℝ)) ∧ ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : + ℕ) then BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ) else BandVectors.1 (FordRecursiveQuadruple P + i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) = (P5332T1ParentRows P j s (0 + : ℤ)).companion) → (a = (P5332T1ParentRows P j s 0).linear)))))) ) := by + classical + intro P i s p p' ha hb hi j A hAp a hslope hslope' vv + have hvr := congrArg Prod.fst vv.2.1 + have hvi := congrArg Prod.snd vv.2.1 + rw [hAp] at hslope hslope' + dsimp at hvr hvi ha hb + apply Zsqrtd.ext + · exact_mod_cast (show (a.re : ℝ) = (P5332T1ParentRows P j s 0).linear.re by linarith) + · exact_mod_cast (show (a.im : ℝ) = (P5332T1ParentRows P j s 0).linear.im by linarith) + +private theorem hstar'At385 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), (∀ (y : GaussianInt), + y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ h.domain ∨ y + ∈ k.domain) → (∀ (hi : i.val < 2), + let j : Fin 2 := ⟨i.val, hi⟩ + ∀ (A : FordFareyParameter), ∀ (u : GaussianInt), (∀ (x : GaussianInt), x ∈ h.domain ↔ x - + u ∈ FordVertexDomain P.q) → ((∀ (x : GaussianInt), x ∈ k.domain ↔ x - u - + (P5332T1ParentRows P j s (0 : ℤ)).displacement ∈ FordVertexDomain A.q) → (∀ l : Fin + 5, x-u + (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] l) ∈ FordVertexDomain P.q ∨ x-u + + (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] l) - (P5332T1ParentRows P j s + 0).displacement ∈ FordVertexDomain A.q))) ) := by + classical + intro P i s h k x hstar hi j A u hdom hdom' l + have hh := hstar (x + (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] l)) + (by fin_cases l <;> simp [sub_eq_add_neg]) + simpa [hdom, hdom', sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hh + +private theorem sourceAt395 : + (by + classical + exact + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), ∀ (x : GaussianInt), (TileCentroid U + - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ)))) → ((p'.1 - p.1 = ((1 / 2 : + ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * + (BandVectors.2 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ))) + BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ)))).1) → ((p'.2 - p.2 = ((1 / 2 : ℝ) • + GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 + (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + + BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + i.succ)))).2) → ((x ∈ h.domain) → ((x ∈ k.domain) → (∀ (j : Fin (2 : ℕ)), ∀ (A : + FordFareyParameter), (A.p = ![P.p₁, P.p₂] j) → ((A.q = ![P.q₁, P.q₂] j) → (∀ (u : + GaussianInt), ∀ (B : ℤ), ∀ (f : IntegerLatticeFunction), (∀ (x : GaussianInt), x ∈ + h.domain ↔ x - u ∈ FordVertexDomain P.q) → ((∀ y ∈ FordVertexDomain P.q, f y = + FordOdometer P y) → (((1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) = (((↑(![P.q₁, P.q₂] j) : ℝ) + - (↑P.q : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : ℤ)).displacement.re : ℝ), + ((↑(![P.q₁, P.q₂] j) : ℝ) - (↑P.q : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : + ℤ)).displacement.im : ℝ)) ∧ (1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.2 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) = (((↑(![P.p₁, P.p₂] j) : ℝ) + - (↑P.p : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : ℤ)).linear.re : ℝ), + ((↑(![P.p₁, P.p₂] j) : ℝ) - (↑P.p : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : + ℤ)).linear.im : ℝ)) ∧ ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : + ℕ) then BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ) else BandVectors.1 (FordRecursiveQuadruple P + i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) = (P5332T1ParentRows P j s (0 + : ℤ)).companion) → ((∀ (x : GaussianInt), x ∈ k.domain ↔ x - u - (P5332T1ParentRows + P j s (0 : ℤ)).displacement ∈ FordVertexDomain A.q) → ((∀ (x : LatticeCell), x ∈ + U.cells ↔ x - u - (P5332T1ParentRows P j s (0 : ℤ)).displacement ∈ (FordTile + A.q).cells) → ((TileCentroid U - TileCentroid T = (((↑A.q : ℝ) - (↑P.q : ℝ)) / (2 : + ℝ) + (↑(P5332T1ParentRows P j s (0 : ℤ)).displacement.re : ℝ), ((↑A.q : ℝ) - (↑P.q + : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : ℤ)).displacement.im : ℝ))) → + ((p'.1 - p.1 = ((↑A.p : ℝ) - (↑P.p : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 + : ℤ)).linear.re : ℝ)) → ((p'.2 - p.2 = ((↑A.p : ℝ) - (↑P.p : ℝ)) / (2 : ℝ) + + (↑(P5332T1ParentRows P j s (0 : ℤ)).linear.im : ℝ)) → ((∀ (y : GaussianInt), y - + (P5332T1ParentRows P j s (0 : ℤ)).displacement ∈ FordVertexDomain A.q → f y = + FordOdometer A (y - (P5332T1ParentRows P j s (0 : ℤ)).displacement) + + (P5332T1ParentRows P j s (0 : ℤ)).linear.re * y.re + (P5332T1ParentRows P j s (0 + : ℤ)).linear.im * y.im + B) → ((∀ (l : Fin (5 : ℕ)), x - u + ![(0 : ℤ√(-1 : ℤ)), (1 : + ℤ√(-1 : ℤ)), (-1 : ℤ√(-1 : ℤ)), (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), -(⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt)] l ∈ FordVertexDomain P.q ∨ x - u + ![(0 : ℤ√(-1 : ℤ)), (1 : ℤ√(-1 + : ℤ)), (-1 : ℤ√(-1 : ℤ)), (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)] l - (P5332T1ParentRows P j s (0 : ℤ)).displacement ∈ FordVertexDomain + A.q) → (∃ t : Int, 0 ≤ t ∧ t < ((![P.q₁,P.q₂] j : Nat) : Int) ∧ (∀ l : Fin 5, f (x-u + + (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] l)) = (P5332T1ParentRows P j s t).values + l) ∧ (x-u - (P5332T1ParentRows P j s 0).companion ∈ FordVertexDomain P.q ↔ t = 0 ∧ + Even (s.val+j.val)))))))))))))))))))) ) := by + classical + intro P hq i s T U h k p p' x hc ha hb hx hx' j A hAp hAq u B f hdom hbase vv hdom' hcell' + hcent hslope hslope' hother hstar' + fin_cases j <;> fin_cases s + · obtain ⟨t, ht, ht', _, _, hv, hh⟩ := P5332T1Parent1Rotation0Values P A hq hAp hAq + f B (x-u) hbase hother ((hdom x).mp hx) ((hdom' x).mp hx') hstar' + exact ⟨t, ht, ht', hv, hh⟩ + · obtain ⟨t, ht, ht', _, _, hv, hh⟩ := P5332T1Parent1Rotation1Values P A hq hAp hAq + f B (x-u) hbase hother ((hdom x).mp hx) ((hdom' x).mp hx') hstar' + exact ⟨t, ht, ht', hv, hh⟩ + · obtain ⟨t, ht, ht', _, _, hv, hh⟩ := P5332T1Parent1Rotation2Values P A hq hAp hAq + f B (x-u) hbase hother ((hdom x).mp hx) ((hdom' x).mp hx') hstar' + exact ⟨t, ht, ht', hv, hh⟩ + · obtain ⟨t, ht, ht', _, _, hv, hh⟩ := P5332T1Parent1Rotation3Values P A hq hAp hAq + f B (x-u) hbase hother ((hdom x).mp hx) ((hdom' x).mp hx') hstar' + exact ⟨t, ht, ht', hv, hh⟩ + · obtain ⟨t, ht, ht', _, _, hv, hh⟩ := P5332T1Parent2Rotation0Values P A hq hAp hAq + f B (x-u) hbase hother ((hdom x).mp hx) ((hdom' x).mp hx') hstar' + exact ⟨t, ht, ht', hv, hh⟩ + · obtain ⟨t, ht, ht', _, _, hv, hh⟩ := P5332T1Parent2Rotation1Values P A hq hAp hAq + f B (x-u) hbase hother ((hdom x).mp hx) ((hdom' x).mp hx') hstar' + exact ⟨t, ht, ht', hv, hh⟩ + · obtain ⟨t, ht, ht', _, _, hv, hh⟩ := P5332T1Parent2Rotation2Values P A hq hAp hAq + f B (x-u) hbase hother ((hdom x).mp hx) ((hdom' x).mp hx') hstar' + exact ⟨t, ht, ht', hv, hh⟩ + · obtain ⟨t, ht, ht', _, _, hv, hh⟩ := P5332T1Parent2Rotation3Values P A hq hAp hAq + f B (x-u) hbase hother ((hdom x).mp hx) ((hdom' x).mp hx') hstar' + exact ⟨t, ht, ht', hv, hh⟩ + +private theorem hgAt426 : + (by + classical + exact + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((∀ (f : IntegerLatticeFunction), ∀ (z : + GaussianInt), ∀ (V : Fin 5 → Int), (∀ k : Fin 5, f (z + (![0, 1, -1, (⟨0, 1⟩ : + GaussianInt), -⟨0, 1⟩] k)) = V k) → (FourNeighborLaplacian f z = V 1 + V 2 + V 3 + V + 4 - 4 * V 0)) → (∀ (s : Fin (4 : ℕ)), ∀ (g : IntegerLatticeFunction), ∀ (x : + GaussianInt), ∀ (j : Fin (2 : ℕ)), ∀ (u : GaussianInt), ∀ (f : + IntegerLatticeFunction), (∀ (x : GaussianInt), FourNeighborLaplacian g x = + FourNeighborLaplacian f (x - u)) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((t < (↑(![P.q₁, P.q₂] + j) : ℤ)) → ((∀ (l : Fin (5 : ℕ)), f (x - u + ![(0 : ℤ√(-1 : ℤ)), (1 : ℤ√(-1 : ℤ)), + (-1 : ℤ√(-1 : ℤ)), (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)] l) = (P5332T1ParentRows P j s t).values l) → (FourNeighborLaplacian g + x = if t = 0 ∧ Even (s.val+j.val) then 0 else 1)))))) ) := by + classical + intro P hq lapValues s g x j u f hlap t ht ht' hv + rw [hlap x, lapValues f (x-u) _ hv] + exact P5332T1ParentRounding P hq j s t ht ht' + +private theorem mark : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T : ProtoTile), + ∀ (x : GaussianInt), ∀ (j : Fin (2 : ℕ)), ∀ (u : GaussianInt), (∀ (x : GaussianInt), + ∀ (w : GaussianInt), x ∈ FootprintVertices (TileTranslation T w) ↔ x - u - w ∈ + FordVertexDomain P.q) → (((1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) = (((↑(![P.q₁, P.q₂] j) : ℝ) + - (↑P.q : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : ℤ)).displacement.re : ℝ), + ((↑(![P.q₁, P.q₂] j) : ℝ) - (↑P.q : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : + ℤ)).displacement.im : ℝ)) ∧ (1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.2 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) = (((↑(![P.p₁, P.p₂] j) : ℝ) + - (↑P.p : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : ℤ)).linear.re : ℝ), + ((↑(![P.p₁, P.p₂] j) : ℝ) - (↑P.p : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : + ℤ)).linear.im : ℝ)) ∧ ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : + ℕ) then BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ) else BandVectors.1 (FordRecursiveQuadruple P + i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) = (P5332T1ParentRows P j s (0 + : ℤ)).companion) → (∀ (t : ℤ), (x - u - (P5332T1ParentRows P j s (0 : ℤ)).companion + ∈ FordVertexDomain P.q ↔ t = (0 : ℤ) ∧ Even ((↑s : ℕ) + (↑j : ℕ))) → (x ∈ + FootprintVertices (TileTranslation T ((⟨0,1⟩ : GaussianInt)^s.val * (if Even s.val + then BandVectors.1 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P i.succ) + else BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P 0)))) + ↔ t = 0 ∧ Even (s.val+j.val)))) ) := by + classical + intro P i s T x j u hfoot vv t hh + rw [hfoot, vv.2.2] + exact hh + +end FordTerminalStencilGeometry + +theorem FordTerminalWebStencilLedger (P : FordFareyParameter) (hq : 1 < P.q) : + let q := FordRecursiveQuadruple P + (∀ (i : Fin 3) (e : Bool) (T T' : ProtoTile) + (h h' : PartialOdometer) (p p' : ℝ × ℝ) + (g : IntegerLatticeFunction) (x : GaussianInt), + TileOdometer (q 0) T h → TileOdometer (q 0) T' h' → + PartialOdometerSlope h = some p → + PartialOdometerSlope h' = some p' → + TileCentroid T' - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) → + p'.1 - p.1 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q 0) (q i.succ)).re → + p'.2 - p.2 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q 0) (q i.succ)).im → + OdometerCompatibility h h' → + GlobalOdometerExtends g h → GlobalOdometerExtends g h' → + x ∈ h.domain → x ∈ h'.domain → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h.domain ∨ y ∈ h'.domain) → + ((∀ s, s = x ∨ s = x - 1 ∨ s = x - ⟨0, 1⟩ ∨ + s = x - 1 - ⟨0, 1⟩ → s ∈ T.cells ∨ s ∈ T'.cells) → + FourNeighborLaplacian g x = 1) ∧ + (¬ (∀ s, s = x ∨ s = x - 1 ∨ s = x - ⟨0, 1⟩ ∨ + s = x - 1 - ⟨0, 1⟩ → s ∈ T.cells ∨ s ∈ T'.cells) → + FourNeighborLaplacian g x = 0)) ∧ + ∀ (i : Fin 3) (s : Fin 4) (T₀ Tᵢ : ProtoTile) + (h₀ hᵢ : PartialOdometer) (p₀ pᵢ : ℝ × ℝ) + (g : IntegerLatticeFunction) (x : GaussianInt), + 0 < (q i.succ).1 → + TileOdometer (q 0) T₀ h₀ → TileOdometer (q i.succ) Tᵢ hᵢ → + PartialOdometerSlope h₀ = some p₀ → + PartialOdometerSlope hᵢ = some pᵢ → + TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) → + pᵢ.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).1 → + pᵢ.2 - p₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).2 → + OdometerCompatibility h₀ hᵢ → + GlobalOdometerExtends g h₀ → GlobalOdometerExtends g hᵢ → + x ∈ h₀.domain → x ∈ hᵢ.domain → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h₀.domain ∨ y ∈ hᵢ.domain) → + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) + let UR := TileTranslation T₀ uR + (x ∈ FootprintVertices UR → FourNeighborLaplacian g x = 0) ∧ + (x ∉ FootprintVertices UR → FourNeighborLaplacian g x = 1) := by +-- BODY + classical + dsimp only + have vectors : + let q := FordRecursiveQuadruple P + (∀ j : Fin 3, + BandVectors.1 (q 0) (q j.succ) = (P5332T1RightRows P j 0).displacement ∧ + BandVectors.2 (q 0) (q j.succ) = (P5332T1RightRows P j 0).linear) ∧ + ∀ (j : Fin 2) (k : Fin 4), + let i : Fin 3 := ⟨j.val, by omega⟩ + let R := P5332T1ParentRows P j k 0 + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ k.val * + (BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ))) = + (((((![P.q₁, P.q₂] j : Nat) : ℝ) - P.q) / 2 + R.displacement.re), + ((((![P.q₁, P.q₂] j : Nat) : ℝ) - P.q) / 2 + R.displacement.im)) ∧ + (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ k.val * + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ))) = + (((((![P.p₁, P.p₂] j : Int) : ℝ) - P.p) / 2 + R.linear.re), + ((((![P.p₁, P.p₂] j : Int) : ℝ) - P.p) / 2 + R.linear.im)) ∧ + (⟨0, 1⟩ : GaussianInt) ^ k.val * + (if Even k.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) = R.companion := P5332T1VectorPlacements P hq + have lapValues (f : IntegerLatticeFunction) (z : GaussianInt) (V : Fin 5 → Int) + (hV : ∀ k : Fin 5, + f (z + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] k)) = V k) : + FourNeighborLaplacian f z = V 1 + V 2 + V 3 + V 4 - 4 * V 0 := + FordTerminalStencilGeometry.lapValues f z V hV + have positive : ∀ (i : Fin 3) (T T' : ProtoTile) + (h h' : PartialOdometer) (p p' : ℝ × ℝ) + (g : IntegerLatticeFunction) (x : GaussianInt), + TileOdometer (FordRecursiveQuadruple P 0) T h → + TileOdometer (FordRecursiveQuadruple P 0) T' h' → + PartialOdometerSlope h = some p → PartialOdometerSlope h' = some p' → + TileCentroid T' - TileCentroid T = + GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P 0) + (FordRecursiveQuadruple P i.succ)) → + p'.1 - p.1 = (BandVectors.2 (FordRecursiveQuadruple P 0) + (FordRecursiveQuadruple P i.succ)).re → + p'.2 - p.2 = (BandVectors.2 (FordRecursiveQuadruple P 0) + (FordRecursiveQuadruple P i.succ)).im → + GlobalOdometerExtends g h → GlobalOdometerExtends g h' → + x ∈ h.domain → x ∈ h'.domain → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h.domain ∨ y ∈ h'.domain) → + ((∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩ → z ∈ T.cells ∨ z ∈ T'.cells) → + FourNeighborLaplacian g x = 1) ∧ + (¬ (∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩ → z ∈ T.cells ∨ z ∈ T'.cells) → + FourNeighborLaplacian g x = 0) := FordTerminalStencilGeometry.positive P hq vectors + lapValues + constructor + · intro i e T U h k p p' g x hT hU hp hp' hc ha hb _ he he' hx hx' hstar + cases e + · have hc' : TileCentroid T - TileCentroid U = + GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P 0) + (FordRecursiveQuadruple P i.succ)) := FordTerminalStencilGeometry.hc' P i T U hc + have ha' : p.1 - p'.1 = (BandVectors.2 (FordRecursiveQuadruple P 0) + (FordRecursiveQuadruple P i.succ)).re := FordTerminalStencilGeometry.ha'At320 P i p p' ha + have hb' : p.2 - p'.2 = (BandVectors.2 (FordRecursiveQuadruple P 0) + (FordRecursiveQuadruple P i.succ)).im := FordTerminalStencilGeometry.hb' P i p p' hb + have hs : ∀ y, y = x ∨ y = x+1 ∨ y = x-1 ∨ y = x+⟨0,1⟩ ∨ y = x-⟨0,1⟩ → + y ∈ k.domain ∨ y ∈ h.domain := FordTerminalStencilGeometry.hs h k x hstar + simpa only [or_comm] using positive i U T k h p' p g x hU hT hp' hp + hc' ha' hb' he' he hx' hx hs + · exact positive i T U h k p p' g x hT hU hp hp' + (by simpa using hc) (by simpa using ha) (by simpa using hb) he he' hx hx' hstar + · intro i s T U h k p p' g x hpos hT hU hp hp' hc ha hb _ he he' hx hx' hstar + have hi : i.val < 2 := FordTerminalStencilGeometry.hiAt337 P i s T U k p p' hpos hU hc ha hb + let j : Fin 2 := ⟨i.val, hi⟩ + have hij : (⟨j.val, by omega⟩ : Fin 3) = i := rfl + obtain ⟨hqr, _, hqs, _, hredr, hreds, _⟩ := P5130T5ParentArithmetic P hq + obtain ⟨A, hAp, hAq, hAc⟩ : ∃ A : FordFareyParameter, + A.p = (![P.p₁,P.p₂] j : Int) ∧ A.q = (![P.q₁,P.q₂] j : Nat) ∧ + FordCircleCoordinate A.p A.q = FordRecursiveQuadruple P i.succ := by + fin_cases i + · obtain ⟨A, hA, _⟩ := FordFareyParentsExist P.p₁ P.q₁ hqr hredr + exact ⟨A, hA.1, hA.2, by simp [FordRecursiveQuadruple, hA.1, hA.2, hqr.ne']⟩ + · obtain ⟨A, hA, _⟩ := FordFareyParentsExist P.p₂ P.q₂ hqs hreds + exact ⟨A, hA.1, hA.2, by simp [FordRecursiveQuadruple, hA.1, hA.2]⟩ + · change 2 < 2 at hi + omega + obtain ⟨u, d, a, B, f, hdom, hdom', hcell, hcell', hfoot, + hcent, hslope, hslope', hbase, hother, hlap⟩ := + P5332T1LiteralNormalization P A T U h k p p' g hT (by rw [hAc]; exact hU) + hp hp' he he' + have vv := vectors.2 j s + dsimp only at vv + rw [hij] at vv + have hd : d = (P5332T1ParentRows P j s 0).displacement := + FordTerminalStencilGeometry.hdAt363 P i s T U hc hi A hAq d hcent vv + have ha' : a = (P5332T1ParentRows P j s 0).linear := FordTerminalStencilGeometry.ha'At375 P + i s p p' ha hb hi A hAp a hslope hslope' vv + subst d + subst a + have hstar' : ∀ l : Fin 5, + x-u + (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] l) ∈ FordVertexDomain P.q ∨ + x-u + (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] l) - + (P5332T1ParentRows P j s 0).displacement ∈ FordVertexDomain A.q := + FordTerminalStencilGeometry.hstar'At385 P i s h k x hstar hi A u hdom hdom' + clear hij + clear_value j + have source : ∃ t : Int, 0 ≤ t ∧ t < ((![P.q₁,P.q₂] j : Nat) : Int) ∧ + (∀ l : Fin 5, f (x-u + (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] l)) = + (P5332T1ParentRows P j s t).values l) ∧ + (x-u - (P5332T1ParentRows P j s 0).companion ∈ FordVertexDomain P.q ↔ + t = 0 ∧ Even (s.val+j.val)) := FordTerminalStencilGeometry.sourceAt395 P hq i s T U h k + p p' x hc ha hb hx hx' j A hAp hAq u B f hdom hbase vv hdom' hcell' hcent hslope + hslope' hother hstar' + obtain ⟨t, ht, ht', hv, hh⟩ := source + have hg : FourNeighborLaplacian g x = + if t = 0 ∧ Even (s.val+j.val) then 0 else 1 := FordTerminalStencilGeometry.hgAt426 P hq + lapValues s g x j u f hlap t ht ht' hv + have mark : x ∈ FootprintVertices (TileTranslation T + ((⟨0,1⟩ : GaussianInt)^s.val * + (if Even s.val then BandVectors.1 (FordRecursiveQuadruple P 0) + (FordRecursiveQuadruple P i.succ) + else BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P 0)))) ↔ t = 0 ∧ Even (s.val+j.val) := + FordTerminalStencilGeometry.mark P i s T x j u hfoot vv t hh + constructor + · intro hm + rw [hg, ite_eq_left (mark.mp hm)] + · intro hm + rw [hg, ite_eq_right (fun h => hm (mark.mpr h))] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordTile.lean b/LeanPool/ApollonianSuperharmonic/FordTile.lean new file mode 100644 index 0000000000..3d5c7776de --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordTile.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: FordTile] + +/-! +# FordTile + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The explicit Ford prototile of denominator $q$ is the prototile whose cells +are $D^{\mathrm F}_q$ and whose auxiliary anchor is $0$. For $q>0$ the +cell set is nonempty, so the anchor has no geometric role. +-/ +def FordTile (q : Nat) : ProtoTile := +-- BODY + ⟨FordCellDomain q, 0⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordTileAcyclicIndegree.lean b/LeanPool/ApollonianSuperharmonic/FordTileAcyclicIndegree.lean new file mode 100644 index 0000000000..9737c796b1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordTileAcyclicIndegree.lean @@ -0,0 +1,234 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4062T1LiteralReduction +public import LeanPool.ApollonianSuperharmonic.P4062T1OrientationTransport +public import LeanPool.ApollonianSuperharmonic.P4062T1ParentalRestriction +public import LeanPool.ApollonianSuperharmonic.P4062T1OverlapDescent +public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorGeometry +public import LeanPool.ApollonianSuperharmonic.P4062T1ParentGluing +public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderGeometry +public import LeanPool.ApollonianSuperharmonic.P4062T1RankedAttachment +public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable + +-- [TABLET NODE: FordTileAcyclicIndegree] + +/-! +# FordTileAcyclicIndegree + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FordTileAcyclicIndegree (P : FordFareyParameter) + (T : ProtoTile) (h : PartialOdometer) (g : IntegerLatticeFunction) + (hT : BandPrototile (FordCircleCoordinate P.p P.q) T) + (hodo : TileOdometer (FordCircleCoordinate P.p P.q) T h) + (hdom : (h.domain : Set GaussianInt) = FootprintVertices T) + (hext : GlobalOdometerExtends g h) : + let D := h.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _) + Nonempty (AcyclicIndegreeOrientation D + (fun x => 2 + FourNeighborLaplacian g x)) := by +-- BODY + classical + have squareCoordinates (q : Nat) (x : GaussianInt) : + x ∈ P4062T1InteriorSquare q ↔ + 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ + 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 := by + unfold P4062T1InteriorSquare + constructor + · intro hx + obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hx + obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab + exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, + (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ + · intro h + exact Finset.mem_image.mpr ⟨(x.re, x.im), + Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨h.1, h.2.1⟩, + Finset.mem_Icc.mpr h.2.2⟩, by cases x; rfl⟩ + have main : ∀ n, ∀ P : FordFareyParameter, P.q = n → + Nonempty (AcyclicIndegreeOrientation (P4062T1InteriorSquare P.q) + (fun x => 2 + FourNeighborLaplacian (FordOdometer P) x)) := by + intro n + induction n using Nat.strong_induction_on with + | h n ih => + intro P hn + let σ : GaussianInt → Int := fun x => 2 + FourNeighborLaplacian (FordOdometer P) x + have empty (D : Finset GaussianInt) (hD : D = ∅) : + Nonempty (AcyclicIndegreeOrientation D σ) := by + subst D + exact ⟨{ + edge := fun _ _ => False + edge_decidable := fun _ _ => Classical.propDecidable _ + rank := fun _ => 0 + supported := by intro x y he; cases he + oriented := by intro x hx; simp at hx + increasing := by intro x y he; cases he + indegree := by intro x hx; simp at hx }⟩ + by_cases h1 : P.q = 1 + · apply empty + ext x + simp only [squareCoordinates, h1, Finset.notMem_empty, iff_false] + omega + by_cases h2 : P.q = 2 + · have htwo_data : P.q₁ = 1 ∧ P.q₂ = 1 := by + have hs := P.sum_q + have ht := P.q₁_lt + have hp := P.q₂_pos + have hd := P.det₁ + rw [h2] at hs ht hd + by_cases hz : P.q₁ = 0 + · rw [hz] at hd + norm_num at hd + omega + · constructor <;> omega + let x₀ : GaussianInt := ⟨1, 1⟩ + have hunit : P4062T1InteriorSquare P.q = {x₀} := by + ext x + rw [squareCoordinates, Finset.mem_singleton] + constructor + · intro hx + ext <;> dsimp [x₀] <;> omega + · rintro rfl + norm_num [x₀, h2] + have hmult : FordBoundaryMultiplicity P x₀ = 4 := by + obtain ⟨hqa, hqb⟩ := htwo_data + unfold FordBoundaryMultiplicity + have hmem : ∀ i : Fin 4, + x₀ ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P i) := by + intro i + fin_cases i + · refine ⟨?_, ⟨⟨2, 1⟩, ?_, ?_, ?_⟩⟩ + · simp [FordRecursiveVertexDomains, hqa, hqb, h2, x₀] + · simp [FordRecursiveVertexDomains, hqa, hqb, h2] + · norm_num [x₀] + · norm_num [x₀] + · refine ⟨?_, ⟨⟨0, 1⟩, ?_, ?_, ?_⟩⟩ + · simp [FordRecursiveVertexDomains, hqa, hqb, h2, x₀] + · simp [FordRecursiveVertexDomains, hqa, hqb, h2] + · norm_num [x₀] + · norm_num [x₀] + · refine ⟨?_, ⟨⟨1, 2⟩, ?_, ?_, ?_⟩⟩ + · simp [FordRecursiveVertexDomains, hqa, hqb, h2, x₀] + · simp [FordRecursiveVertexDomains, hqa, hqb, h2] + · norm_num [x₀] + · norm_num [x₀] + · refine ⟨?_, ⟨⟨1, 0⟩, ?_, ?_, ?_⟩⟩ + · simp [FordRecursiveVertexDomains, hqa, hqb, h2, x₀] + · simp [FordRecursiveVertexDomains, hqa, hqb, h2] + · norm_num [x₀] + · norm_num [x₀] + have hfilter : (Finset.univ.filter fun i : Fin 4 => + x₀ ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P i)) = + Finset.univ := by + ext i + simp [hmem i] + rw [hfilter] + simp + have htable := (FordLaplacianTable P).2.2 (by omega) x₀ + (by norm_num [x₀]) (by rw [h2]; norm_num [x₀]) + (by norm_num [x₀]) (by rw [h2]; norm_num [x₀]) + have hlap : FourNeighborLaplacian (FordOdometer P) x₀ = -2 := by + exact htable.2.2 (by rw [hmult]) + have hsigma : σ x₀ = 0 := by simp [σ, hlap] + let o₀ : AcyclicIndegreeOrientation {x₀} σ := { + edge := fun _ _ => False + edge_decidable := fun _ _ => Classical.propDecidable _ + rank := fun _ => 0 + supported := by intro x y he; cases he + oriented := by + intro x hx y hy hadj + have hx' : x = x₀ := Finset.mem_singleton.mp hx + have hy' : y = x₀ := Finset.mem_singleton.mp hy + subst x + subst y + rcases hadj with he | he | he | he + · have hr := congrArg Zsqrtd.re he + norm_num [x₀] at hr + · have hr := congrArg Zsqrtd.re he + norm_num [x₀] at hr + · have hi := congrArg Zsqrtd.im he + norm_num [x₀] at hi + · have hi := congrArg Zsqrtd.im he + norm_num [x₀] at hi + increasing := by intro x y he; cases he + indegree := by + intro x hx + have hx' : x = x₀ := Finset.mem_singleton.mp hx + subst x + simp [hsigma] + } + rw [hunit] + exact ⟨o₀⟩ + have hbig : 2 < P.q := by have hp := P.q_pos; omega + let A := P4062T1RecursiveInteriors P + obtain ⟨P₁, P₂, hp₁, hq₁, hp₂, hq₂, hsmall₁, hsmall₂, hne, hrest⟩ := + P4062T1ParentalRestriction P hbig + have kids : ∀ i, Nonempty (AcyclicIndegreeOrientation (A i) σ) := by + intro i + let R := if i.val < 2 then P₁ else P₂ + let u : GaussianInt := + ![0, ⟨(P.q₂ : Int), (P.q₂ : Int)⟩, + ⟨(P.q₁ : Int), 0⟩, ⟨0, (P.q₁ : Int)⟩] i + have hR : R.q < n := by + dsimp only [R] + split <;> omega + obtain ⟨o⟩ := ih R.q hR R rfl + have hr := hrest i + obtain ⟨t, _, _⟩ := P4062T1OrientationTransport + (P4062T1InteriorSquare R.q) (A i) + (fun x => 2 + FourNeighborLaplacian (FordOdometer R) x) σ u hr.1 + (by intro x hx; change 2 + _ = 2 + _; rw [hr.2 x hx]) o + exact ⟨t⟩ + obtain ⟨hsub, hcross, hdis, hsep, hempty₂, hempty₀⟩ := + P4062T1InteriorGeometry P hbig + have desc := P4062T1OverlapDescent P P₁ P₂ hbig hp₁ hq₁ hp₂ hq₂ + have overlaps : + Nonempty (AcyclicIndegreeOrientation (A 0 ∩ A 1) σ) ∧ + Nonempty (AcyclicIndegreeOrientation (A 2 ∩ A 3) σ) := by + rcases lt_or_gt_of_ne hne with hlt | hgt + · obtain ⟨H, hHp, hHq, hHsmall, hPp₁, hPq₁, hPp₂, hPq₂, hset, hlap⟩ := + desc.2 hlt + obtain ⟨oH⟩ := ih H.q (by omega) H rfl + obtain ⟨t, _, _⟩ := P4062T1OrientationTransport _ (A 2 ∩ A 3) + (fun x => 2 + FourNeighborLaplacian (FordOdometer H) x) σ + ⟨(P.q₁ : Int), (P.q₁ : Int)⟩ hset + (by intro x hx; change 2 + _ = 2 + _; rw [hlap x hx]) oH + exact ⟨empty _ (hempty₀ hlt), ⟨t⟩⟩ + · obtain ⟨H, hHp, hHq, hHsmall, hPp₁, hPq₁, hPp₂, hPq₂, hset, hlap⟩ := + desc.1 hgt + obtain ⟨oH⟩ := ih H.q (by omega) H rfl + obtain ⟨t, _, _⟩ := P4062T1OrientationTransport _ (A 0 ∩ A 1) + (fun x => 2 + FourNeighborLaplacian (FordOdometer H) x) σ + ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ hset + (by intro x hx; change 2 + _ = 2 + _; rw [hlap x hx]) oH + exact ⟨⟨t⟩, empty _ (hempty₂ hgt)⟩ + obtain ⟨oE, hpreserve⟩ := P4062T1ParentGluing P hbig σ + (fun i => Classical.choice (kids i)) + (Classical.choice overlaps.1) (Classical.choice overlaps.2) + obtain ⟨hE, hW, hdisW, hsepW, hedges, hcounts, hres, hstrict⟩ := + P4062T1RemainderGeometry P hbig + obtain ⟨t, _⟩ := P4062T1RankedAttachment + (P4062T1InteriorSquare P.q) _ σ _ hE oE + (by intro x hx; simpa only [σ] using hres x hx) hstrict + exact ⟨t⟩ + obtain ⟨u, hD, hlap⟩ := P4062T1LiteralReduction P T h g hT hodo hdom hext + obtain ⟨o⟩ := main P.q P rfl + obtain ⟨t, _, _⟩ := P4062T1OrientationTransport _ _ + (fun x => 2 + FourNeighborLaplacian (FordOdometer P) x) + (fun x => 2 + FourNeighborLaplacian g x) u hD + (by intro x hx; rw [hlap x hx]) o + exact ⟨t⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordTileGeometry.lean b/LeanPool/ApollonianSuperharmonic/FordTileGeometry.lean new file mode 100644 index 0000000000..1d068b1f03 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordTileGeometry.lean @@ -0,0 +1,287 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.TileArea + +-- [TABLET NODE: FordTileGeometry] + +/-! +# FordTileGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +private theorem squareRealization (q : ℕ) (hq : 0 < q) : TileRealization (FordTile q) = + Set.Icc (0, 0) ((q : Real), (q : Real)) := by + ext p + constructor + · intro hp + simp? [TileRealization, FordTile, FordCellDomain, ClosedSquareRealization] at hp + rcases hp with ⟨x, y, hxy, hlt, hup⟩ + rcases hxy with ⟨hxl, hyl⟩ + rcases hup with ⟨hxu, hyu⟩ + norm_num at hxl hyl hxu hyu + constructor + · constructor + · linarith + · linarith + · constructor + · have hxq : x + 1 ≤ q := by omega + have hxq' : (x : Real) + 1 ≤ q := by exact_mod_cast hxq + linarith + · have hyq : y + 1 ≤ q := by omega + have hyq' : (y : Real) + 1 ≤ q := by exact_mod_cast hyq + linarith + · intro hp + simp only [Set.mem_Icc, Prod.le_def] at hp + let x : Nat := if p.1 = q then q - 1 else ⌊p.1⌋₊ + let y : Nat := if p.2 = q then q - 1 else ⌊p.2⌋₊ + have xlt : x < q := by + dsimp [x] + split + · omega + · apply (Nat.floor_lt hp.1.1).2 + exact lt_of_le_of_ne hp.2.1 ‹p.1 ≠ q› + have ylt : y < q := by + dsimp [y] + split + · omega + · apply (Nat.floor_lt hp.1.2).2 + exact lt_of_le_of_ne hp.2.2 ‹p.2 ≠ q› + refine ?_ + simp only [TileRealization, FordTile, FordCellDomain] + refine Set.mem_iUnion.2 ⟨(⟨(x : Int), (y : Int)⟩ : GaussianInt), ?_⟩ + refine Set.mem_iUnion.2 ⟨?_, ?_⟩ + · simp [xlt, ylt] + · simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor + · constructor + · dsimp [x] + split + · have hqcast : (q : Real) ≤ ((q - 1 : Nat) : Real) + 1 := by + have hqn : q ≤ q - 1 + 1 := by omega + exact_mod_cast hqn + norm_num [‹p.1 = q›, hqcast] + · exact Nat.floor_le hp.1.1 + · dsimp [y] + split + · have hqcast : (q : Real) ≤ ((q - 1 : Nat) : Real) + 1 := by + have hqn : q ≤ q - 1 + 1 := by omega + exact_mod_cast hqn + norm_num [‹p.2 = q›, hqcast] + · exact Nat.floor_le hp.1.2 + · constructor + · dsimp [x] + split + · have hqcast : (q : Real) ≤ ((q - 1 : Nat) : Real) + 1 := by + have hqn : q ≤ q - 1 + 1 := by omega + exact_mod_cast hqn + norm_num [‹p.1 = q›] at hqcast ⊢ + exact hqcast + · have hf := Nat.lt_floor_add_one p.1 + have hfi : p.1 ≤ (((⌊p.1⌋₊ : Nat) : Int) : Real) + 1 := by + norm_num + linarith + exact hfi + · dsimp [y] + split + · have hqcast : (q : Real) ≤ ((q - 1 : Nat) : Real) + 1 := by + have hqn : q ≤ q - 1 + 1 := by omega + exact_mod_cast hqn + norm_num [‹p.2 = q›] at hqcast ⊢ + exact hqcast + · have hf := Nat.lt_floor_add_one p.2 + have hfi : p.2 ≤ (((⌊p.2⌋₊ : Nat) : Int) : Real) + 1 := by + norm_num + linarith + exact hfi + +theorem FordTileGeometry (q : Nat) (hq : 0 < q) : + LatticeTile (FordTile q) ∧ + TileArea (FordTile q) = q * q := by +-- BODY + constructor + · unfold LatticeTile TopologicalDisk + have realization_eq := squareRealization q hq + let forward : (Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) → + Set.Icc (0, 0) ((q : Real), (q : Real)) := fun p => + ⟨((q : Real) * (p.1.1 / 2 + 1 / 2), + (q : Real) * (p.1.2 / 2 + 1 / 2)), by + have hp := Metric.mem_closedBall.mp p.2 + simp? [Prod.dist_eq, Real.dist_eq] at hp + rcases abs_le.mp hp.1 with ⟨hx1, hx2⟩ + rcases abs_le.mp hp.2 with ⟨hy1, hy2⟩ + have hqreal : (0 : Real) < q := by exact_mod_cast hq + change (0, 0) ≤ + ((q : Real) * (p.1.1 / 2 + 1 / 2), + (q : Real) * (p.1.2 / 2 + 1 / 2)) ∧ + ((q : Real) * (p.1.1 / 2 + 1 / 2), + (q : Real) * (p.1.2 / 2 + 1 / 2)) ≤ ((q : Real), (q : Real)) + constructor <;> constructor <;> nlinarith⟩ + let backward : Set.Icc (0, 0) ((q : Real), (q : Real)) → + (Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) := fun p => + ⟨(2 * (p.1.1 / q - 1 / 2), 2 * (p.1.2 / q - 1 / 2)), by + simp? [Metric.mem_closedBall, Prod.dist_eq, Real.dist_eq] + have hqreal : (0 : Real) < q := by exact_mod_cast hq + rcases p.2 with ⟨⟨hx1, hy1⟩, ⟨hx2, hy2⟩⟩ + have hx : -(1 / 2 : Real) ≤ (p.1.1 / q - 1 / 2) ∧ + p.1.1 / q - 1 / 2 ≤ 1 / 2 := by + constructor + · apply (le_sub_iff_add_le).2 + apply (le_div_iff₀ hqreal).2 + nlinarith + · apply (sub_le_iff_le_add).2 + apply (div_le_iff₀ hqreal).2 + nlinarith + have hy : -(1 / 2 : Real) ≤ (p.1.2 / q - 1 / 2) ∧ + p.1.2 / q - 1 / 2 ≤ 1 / 2 := by + constructor + · apply (le_sub_iff_add_le).2 + apply (le_div_iff₀ hqreal).2 + nlinarith + · apply (sub_le_iff_le_add).2 + apply (div_le_iff₀ hqreal).2 + nlinarith + constructor + · have ha := abs_le.mpr hx + calc + 2 * |p.1.1 / q - 2⁻¹| ≤ 2 * (1 / 2) := by + apply mul_le_mul_of_nonneg_left + · simpa only [one_div] using ha + · norm_num + _ = 1 := by norm_num + · have ha := abs_le.mpr hy + calc + 2 * |p.1.2 / q - 2⁻¹| ≤ 2 * (1 / 2) := by + apply mul_le_mul_of_nonneg_left + · simpa only [one_div] using ha + · norm_num + _ = 1 := by norm_num⟩ + have inverse_forward : Function.LeftInverse backward forward := by + intro p + apply Subtype.ext + apply Prod.ext + all_goals dsimp [forward, backward] + all_goals field_simp + all_goals ring + have forward_inverse : Function.RightInverse backward forward := by + intro p + apply Subtype.ext + apply Prod.ext + all_goals dsimp [forward, backward] + all_goals field_simp + all_goals ring + let bridge : (Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) ≃ + Set.Icc (0, 0) ((q : Real), (q : Real)) := + { toFun := forward, invFun := backward, left_inv := inverse_forward, + right_inv := forward_inverse } + have rectangle_disk : Nonempty + ((Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) ≃ₜ + Set.Icc (0, 0) ((q : Real), (q : Real))) := by + refine ⟨Homeomorph.mk bridge ?_ ?_⟩ + · change Continuous forward + dsimp [forward] + apply Continuous.subtype_mk + rw [Metric.continuous_iff] + intro b e he + have hqreal : (0 : Real) < q := by exact_mod_cast hq + refine ⟨2 * e / q, by positivity, ?_⟩ + intro a hab + change dist (a : Real × Real) (b : Real × Real) < 2 * e / q at hab + simp? [Prod.dist_eq, Real.dist_eq] at hab ⊢ + constructor + · rw [show (q : Real) * (((a : Real × Real).1) / 2 + 2⁻¹) - + (q : Real) * (((b : Real × Real).1) / 2 + 2⁻¹) = + (q : Real) * (((a : Real × Real).1 - (b : Real × Real).1) / 2) by ring, + abs_mul, + abs_of_pos hqreal] + calc + (q : Real) * |((a : Real × Real).1 - (b : Real × Real).1) / 2| < q * (e / q) := by + refine mul_lt_mul_of_pos_left ?_ hqreal + have hh := hab.1 + rw [abs_div] at ⊢ + norm_num at ⊢ + have hs := div_lt_div_of_pos_right hh (by norm_num : (0 : Real) < 2) + convert hs using 1; ring + _ = e := by field_simp + · rw [show (q : Real) * (((a : Real × Real).2) / 2 + 2⁻¹) - + (q : Real) * (((b : Real × Real).2) / 2 + 2⁻¹) = + (q : Real) * (((a : Real × Real).2 - (b : Real × Real).2) / 2) by ring, + abs_mul, + abs_of_pos hqreal] + calc + (q : Real) * |((a : Real × Real).2 - (b : Real × Real).2) / 2| < q * (e / q) := by + refine mul_lt_mul_of_pos_left ?_ hqreal + have hh := hab.2 + rw [abs_div] at ⊢ + norm_num at ⊢ + have hs := div_lt_div_of_pos_right hh (by norm_num : (0 : Real) < 2) + convert hs using 1; ring + _ = e := by field_simp + · change Continuous backward + dsimp [backward] + apply Continuous.subtype_mk + rw [Metric.continuous_iff] + intro b e he + refine ⟨e * q / 2, by positivity, ?_⟩ + intro a hab + change dist (a : Real × Real) (b : Real × Real) < e * q / 2 at hab + simp? [Prod.dist_eq, Real.dist_eq] at hab ⊢ + constructor + · rw [show 2 * (((a : Real × Real).1) / q - 2⁻¹) - + 2 * (((b : Real × Real).1) / q - 2⁻¹) = + 2 * (((a : Real × Real).1 - (b : Real × Real).1) / q) by ring, abs_mul, abs_div, + abs_of_pos (show (0 : Real) < 2 by norm_num), + abs_of_pos (show (0 : Real) < q by exact_mod_cast hq)] + calc + 2 * (|(a : Real × Real).1 - (b : Real × Real).1| / q) < + 2 * (e * q / 2) / q := by + rw [← mul_div_assoc] + refine div_lt_div_of_pos_right ?_ (by exact_mod_cast hq) + exact mul_lt_mul_of_pos_left hab.1 (by norm_num) + _ = e := by field_simp + · rw [show 2 * (((a : Real × Real).2) / q - 2⁻¹) - + 2 * (((b : Real × Real).2) / q - 2⁻¹) = + 2 * (((a : Real × Real).2 - (b : Real × Real).2) / q) by ring, abs_mul, abs_div, + abs_of_pos (show (0 : Real) < 2 by norm_num), + abs_of_pos (show (0 : Real) < q by exact_mod_cast hq)] + calc + 2 * (|(a : Real × Real).2 - (b : Real × Real).2| / q) < + 2 * (e * q / 2) / q := by + rw [← mul_div_assoc] + refine div_lt_div_of_pos_right ?_ (by exact_mod_cast hq) + exact mul_lt_mul_of_pos_left hab.2 (by norm_num) + _ = e := by field_simp + exact realization_eq ▸ rectangle_disk + · let cells : Finset (Nat × Nat) := Finset.range q ×ˢ Finset.range q + have injective_coordinates : Function.Injective + (fun a : Nat × Nat => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) := by + intro a b hab + apply Prod.ext + · have h := congrArg (fun z : GaussianInt => z.re) hab + change (a.1 : Int) = b.1 at h + exact_mod_cast h + · have h := congrArg (fun z : GaussianInt => z.im) hab + change (a.2 : Int) = b.2 at h + exact_mod_cast h + calc + (Finset.image (fun a : Nat × Nat => + (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) cells).card = cells.card := + Finset.card_image_of_injective cells injective_coordinates + _ = q * q := by simp [cells] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean b/LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean new file mode 100644 index 0000000000..b32786b639 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean @@ -0,0 +1,689 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordOdometerFamilyExistsUnique +public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist +public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.OdometerTranslation +public import LeanPool.ApollonianSuperharmonic.PartialOdometer +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.P4217T2SquareGeometry +public import LeanPool.ApollonianSuperharmonic.P4217T2RectangularBoundarySlope +public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport + +-- [TABLET NODE: FordTileOdometerRestriction] + +/-! +# FordTileOdometerRestriction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FordOdometerRestriction + +private theorem mem : + (by + classical + exact + let H (R : FordFareyParameter) := P4217T2SquareRestriction R.q (FordOdometer R) + (∀ (R : FordFareyParameter), (↑(P4217T2SquareRestriction R.q (FordOdometer R)).domain : + Set GaussianInt) = FordVertexDomain R.q ∧ (∀ x ∈ (P4217T2SquareRestriction R.q + (FordOdometer R)).domain, (P4217T2SquareRestriction R.q (FordOdometer R)).value x = + FordOdometer R x) ∧ PartialOdometerSquares (P4217T2SquareRestriction R.q + (FordOdometer R)) = (FordTile R.q).cells ∧ (PartialOdometerSquares + (P4217T2SquareRestriction R.q (FordOdometer R))).card = R.q * R.q ∧ + (PartialOdometerSquares (P4217T2SquareRestriction R.q (FordOdometer R))).Nonempty) + → (∀ (R : FordFareyParameter), ∀ (x : GaussianInt), x ∈ (H R).domain ↔ x ∈ + FordVertexDomain R.q) ) := by + classical + intro H geom R x + exact Set.ext_iff.mp (geom R).1 x + +private theorem slope : + (by + classical + exact + let H (R : FordFareyParameter) := P4217T2SquareRestriction R.q (FordOdometer R) + (∀ (R : FordFareyParameter), (↑(P4217T2SquareRestriction R.q (FordOdometer R)).domain : + Set GaussianInt) = FordVertexDomain R.q ∧ (∀ x ∈ (P4217T2SquareRestriction R.q + (FordOdometer R)).domain, (P4217T2SquareRestriction R.q (FordOdometer R)).value x = + FordOdometer R x) ∧ PartialOdometerSquares (P4217T2SquareRestriction R.q + (FordOdometer R)) = (FordTile R.q).cells ∧ (PartialOdometerSquares + (P4217T2SquareRestriction R.q (FordOdometer R))).card = R.q * R.q ∧ + (PartialOdometerSquares (P4217T2SquareRestriction R.q (FordOdometer R))).Nonempty) + → ((∀ (R : FordFareyParameter), ∀ (x : GaussianInt), x ∈ (H R).domain ↔ x ∈ + FordVertexDomain R.q) → ((∀ (R : FordFareyParameter), ∀ (x : GaussianInt), (x ∈ (H + R).domain) → ((H R).value x = FordOdometer R x)) → (((∀ (R : FordFareyParameter), ∀ + (x : GaussianInt), R.q = (1 : ℕ) → FordOdometer R x = x.re * (x.re - (1 : ℤ)) / (2 : + ℤ) + R.p * x.re * x.im) ∧ (∀ (P : FordFareyParameter), ∀ x ∈ FordDoubledBoundary P.q, + Classical.choose FordOdometerFamilyExistsUnique P x = IntegerCeilDiv (P.p * x.re * + x.im) (↑P.q : ℤ) (by exact_mod_cast P.q_pos.ne')) ∧ (∀ (P : FordFareyParameter), ∀ (x + : GaussianInt), + Classical.choose FordOdometerFamilyExistsUnique P (x + ⟨(0 : ℤ), -(↑P.q : ℤ)⟩) = + Classical.choose FordOdometerFamilyExistsUnique P x - P.p * x.re) ∧ (∀ (P : + FordFareyParameter), ∀ (x : GaussianInt), Classical.choose + FordOdometerFamilyExistsUnique P (x + ⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩) = Classical.choose + FordOdometerFamilyExistsUnique P x + P.p₁ * x.re + P.p * x.im + (↑P.q₁ : ℤ) * P.p) ∧ + (∀ (P : FordFareyParameter), ∀ (x : GaussianInt), Classical.choose + FordOdometerFamilyExistsUnique P (x + ⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩) = Classical.choose + FordOdometerFamilyExistsUnique P x + P.p₂ * x.re - P.p * x.im - (↑P.q : ℤ) * P.p₂) ∧ + ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), ∀ (P₂ : FordFareyParameter), + (1 : ℕ) < P.q → P₁.p = P.p₁ → P₁.q = P.q₁ → P₂.p = P.p₂ → P₂.q = P.q₂ → (∀ x ∈ + FordRecursiveVertexDomains P (0 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique + P₁ x) ∧ (∀ x ∈ FordRecursiveVertexDomains P (1 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique + P₁ (x - ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (↑P.q₂ : ℤ) + + (1 : ℤ)) ∧ (∀ x ∈ FordRecursiveVertexDomains P (2 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique + P₂ (x - ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩) + P.p₁ * x.im) ∧ ∀ x ∈ FordRecursiveVertexDomains P + (3 : Fin (4 : ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = + Classical.choose FordOdometerFamilyExistsUnique P₂ (x - ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩) + + P.p₁ * x.re) → (∀ (R : FordFareyParameter), PartialOdometerSlope (H R) = some ((↑R.p + : ℝ) / (2 : ℝ), (↑R.p : ℝ) / (2 : ℝ)))))) ) := by + classical + intro H geom mem val laws R + have boundary (x : GaussianInt) (hx : x ∈ FordVertexDomain R.q) + (hs : x.re = 0 ∨ x.re = R.q ∨ x.im = 0 ∨ x.im = R.q) : + (H R).value x = IntegerCeilDiv (R.p * x.re * x.im) R.q + (by exact_mod_cast R.q_pos.ne') := by + rw [val R x ((mem R x).mpr hx)] + apply laws.2.1 + refine ⟨hx, ?_⟩ + rcases hs with hs | hs | hs | hs <;> simp only [hs] <;> omega + have left (y : Int) (hy : 0 ≤ y) (hyq : y ≤ R.q) : + (H R).value ⟨0, y⟩ = 0 := by + rw [boundary _ (by exact ⟨le_rfl, by dsimp; omega, hy, hyq⟩) (Or.inl rfl)] + simp [IntegerCeilDiv] + have right (y : Int) (hy : 0 ≤ y) (hyq : y ≤ R.q) : + (H R).value ⟨(R.q : Int), y⟩ = R.p * y := by + rw [boundary _ (by exact ⟨by dsimp; omega, le_rfl, hy, hyq⟩) (Or.inr (Or.inl rfl))] + simp only [IntegerCeilDiv] + have he : -(R.p * (R.q : Int) * y) = -(R.p * y) * (R.q : Int) := by ring + rw [he, Int.mul_ediv_cancel _ (by exact_mod_cast R.q_pos.ne')] + simp + have bottom (x : Int) (hx : 0 ≤ x) (hxq : x ≤ R.q) : + (H R).value ⟨x, 0⟩ = 0 := by + rw [boundary _ (by exact ⟨hx, hxq, le_rfl, by dsimp; omega⟩) (Or.inr (Or.inr (Or.inl rfl)))] + simp [IntegerCeilDiv] + have top (x : Int) (hx : 0 ≤ x) (hxq : x ≤ R.q) : + (H R).value ⟨x, (R.q : Int)⟩ = R.p * x := by + rw [boundary _ (by exact ⟨hx, hxq, by dsimp; omega, le_rfl⟩) (Or.inr (Or.inr (Or.inr rfl)))] + change -(-(R.p * x * (R.q : Int)) / (R.q : Int)) = R.p * x + rw [← neg_mul] + rw [Int.mul_ediv_cancel _ (by exact_mod_cast R.q_pos.ne')] + simp + have hs := P4217T2RectangularBoundarySlope (H R) R.q R.q + R.q_pos R.q_pos R.p R.p (geom R).1 left right bottom top + have hn : (R.q : Real) ≠ 0 := by exact_mod_cast R.q_pos.ne' + convert hs using 1; congr 2 <;> field_simp + +private theorem hdomain : + (by + classical + exact + let H (R : FordFareyParameter) := P4217T2SquareRestriction R.q (FordOdometer R) + ∀ (R : FordFareyParameter), (R.q = (1 : ℕ)) → ((H R).domain = (CurvatureOneOdometer ⟨0, + R.p⟩).domain) ) := by + classical + intro H R hu + dsimp [H, P4217T2SquareRestriction, CurvatureOneOdometer] + rw [hu] + decide +kernel + +private theorem ht : + (by + classical + exact + let H (R : FordFareyParameter) := P4217T2SquareRestriction R.q (FordOdometer R) + (∀ (R : FordFareyParameter), ∀ (x : GaussianInt), (x ∈ (H R).domain) → ((H R).value x = + FordOdometer R x)) → (((∀ (R : FordFareyParameter), ∀ (x : GaussianInt), R.q = (1 : + ℕ) → FordOdometer R x = x.re * (x.re - (1 : ℤ)) / (2 : ℤ) + R.p * x.re * x.im) ∧ (∀ + (P : FordFareyParameter), ∀ x ∈ FordDoubledBoundary P.q, Classical.choose + FordOdometerFamilyExistsUnique P x = IntegerCeilDiv (P.p * x.re * x.im) (↑P.q : ℤ) + (by exact_mod_cast P.q_pos.ne')) + ∧ (∀ (P : FordFareyParameter), ∀ (x : GaussianInt), Classical.choose + FordOdometerFamilyExistsUnique P (x + ⟨(0 : ℤ), -(↑P.q : ℤ)⟩) = Classical.choose + FordOdometerFamilyExistsUnique P x - P.p * x.re) ∧ (∀ (P : FordFareyParameter), ∀ (x + : GaussianInt), Classical.choose FordOdometerFamilyExistsUnique P (x + ⟨(↑P.q : ℤ), + (↑P.q₁ : ℤ)⟩) = Classical.choose FordOdometerFamilyExistsUnique P x + P.p₁ * x.re + + P.p * x.im + (↑P.q₁ : ℤ) * P.p) ∧ (∀ (P : FordFareyParameter), ∀ (x : GaussianInt), + Classical.choose FordOdometerFamilyExistsUnique P (x + ⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩) = + Classical.choose FordOdometerFamilyExistsUnique P x + P.p₂ * x.re - P.p * x.im - + (↑P.q : ℤ) * P.p₂) ∧ ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), ∀ (P₂ : + FordFareyParameter), (1 : ℕ) < P.q → P₁.p = P.p₁ → P₁.q = P.q₁ → P₂.p = P.p₂ → P₂.q = + P.q₂ → (∀ x ∈ FordRecursiveVertexDomains P (0 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique + P₁ x) ∧ (∀ x ∈ FordRecursiveVertexDomains P (1 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique + P₁ (x - ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (↑P.q₂ : ℤ) + + (1 : ℤ)) ∧ (∀ x ∈ FordRecursiveVertexDomains P (2 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique + P₂ (x - ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩) + P.p₁ * x.im) ∧ ∀ x ∈ FordRecursiveVertexDomains P + (3 : Fin (4 : ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = + Classical.choose FordOdometerFamilyExistsUnique P₂ (x - ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩) + + P.p₁ * x.re) → (∀ (R : FordFareyParameter), (R.q = (1 : ℕ)) → (((H R).domain = + (CurvatureOneOdometer ⟨0, R.p⟩).domain) → (OdometerTranslation (H R) + (CurvatureOneOdometer ⟨0, R.p⟩))))) ) := by + classical + intro H val laws R hu hdomain + refine ⟨0, 0, 0, ?_, ?_⟩ + · intro x + simp [hdomain] + · intro x hx + rw [val R x hx, laws.1 R x hu] + rw [hdomain] at hx + simp only [CurvatureOneOdometer, Finset.mem_insert, Finset.mem_singleton] at hx + rcases hx with rfl | rfl | rfl | rfl <;> + norm_num [CurvatureOneOdometer, Zsqrtd.ext_iff] + +private theorem q1pos : + (by + classical + exact + ∀ (R : FordFareyParameter), (1 < R.q) → (0 < R.q₁) ) := by + classical + intro R hgt + by_contra h + have hz : R.q₁ = 0 := by omega + have hd := R.det₁ + simp [hz] at hd + have hdv : (R.q : Int) ∣ 1 := ⟨R.p₁, by simpa [mul_comm] using hd.symm⟩ + have := Int.eq_one_of_dvd_one (by omega : 0 ≤ (R.q : Int)) hdv + omega + +private theorem cross : + (by + classical + exact + ∀ (R : FordFareyParameter), R.p₁ * (R.q₂ : Int) - (R.q₁ : Int) * R.p₂ = 1 ) := by + classical + intro R + have hd := R.det₁ + rw [R.sum_q, R.sum_p, Nat.cast_add] at hd + nlinarith [hd] + +private theorem red : + (by + classical + exact + (FordFareyParameter) → (∀ (a : ℤ), ∀ (b : ℕ), ∀ (d : ℕ), ∀ (c : ℤ), a * (↑d : ℤ) - (↑b : + ℤ) * c = (1 : ℤ) → b.Coprime a.natAbs) ) := by + classical + intro R a b d c hd + rw [Nat.coprime_iff_gcd_eq_one] + apply Nat.dvd_one.mp + let g := Nat.gcd b a.natAbs + have gb : (g : Int) ∣ (b : Int) := by exact_mod_cast Nat.gcd_dvd_left b a.natAbs + have ga : (g : Int) ∣ a := (Int.dvd_natAbs).mp (by + exact_mod_cast Nat.gcd_dvd_right b a.natAbs) + have gd := dvd_sub (dvd_mul_of_dvd_left ga (d : Int)) (dvd_mul_of_dvd_left gb c) + rw [hd] at gd + have he := Int.eq_one_of_dvd_one (by omega : 0 ≤ (g : Int)) gd + have : g = 1 := by exact_mod_cast he + simp? [g] at this ⊢ + exact this + +private theorem kcert : + (by + classical + exact + let H (R : FordFareyParameter) := P4217T2SquareRestriction R.q (FordOdometer R) + ∀ (R : FordFareyParameter), ∀ (q1pos : 0 < R.q₁), ∀ (R1 : FordFareyParameter), ∀ (R2 : + FordFareyParameter), ∀ (ho1 : TileOdometer (FordCircleCoordinate R.p₁ R.q₁) (FordTile + R.q₁) (H R1)), ∀ (ho2 : TileOdometer (FordCircleCoordinate R.p₂ R.q₂) (FordTile R.q₂) + (H R2)), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hS : ∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), BandSubtileOccurrence (FordRecursiveQuadruple R) (FordTile R.q) i s (S i s)), + ∀ (c0t : (S (0 : Fin (3 : ℕ)) true).cells = (FordTile R.q₁).cells), ∀ (c0f : (S (0 : + Fin (3 : ℕ)) false).cells = (TileTranslation (FordTile R.q₁) ⟨(↑R.q₂ : ℤ), (↑R.q₂ : + ℤ)⟩).cells), ∀ (c1t : (S (1 : Fin (3 : ℕ)) true).cells = (TileTranslation (FordTile + R.q₂) ⟨(↑R.q₁ : ℤ), (0 : ℤ)⟩).cells), ∀ (c1f : (S (1 : Fin (3 : ℕ)) false).cells = + (TileTranslation (FordTile R.q₂) ⟨(0 : ℤ), (↑R.q₁ : ℤ)⟩).cells), ∀ (c2t : (S (2 : Fin + (3 : ℕ)) true).cells = ∅), ∀ (a2t : (S (2 : Fin (3 : ℕ)) true).anchor = ⟨(↑R.q₂ : ℤ), + (↑R.q : ℤ)⟩), ∀ (c2f : (S (2 : Fin (3 : ℕ)) false).cells = ∅), ∀ (a2f : (S (2 : Fin + (3 : ℕ)) false).anchor = ⟨(↑R.q₁ : ℤ), (0 : ℤ)⟩), + let line (x : GaussianInt) : PartialOdometer := + { domain := {x} + value := fun y => if y = x then FordOdometer R y else 0 + value_outside := by intro y hy; exact ite_eq_right (by simpa using hy) } + let K : Fin 3 → Bool → PartialOdometer := + ![fun s => if s then H R1 else + PartialOdometerAffineTranslate (H R1) ⟨(R.q₂ : Int), (R.q₂ : Int)⟩ + ⟨R.p₂, R.p₂⟩ (-R.p₂ * R.q₂ + 1), + fun s => if s then + PartialOdometerAffineTranslate (H R2) ⟨(R.q₁ : Int), 0⟩ ⟨0, R.p₁⟩ 0 else + PartialOdometerAffineTranslate (H R2) ⟨0, (R.q₁ : Int)⟩ ⟨R.p₁, 0⟩ 0, + fun s => if s then line ⟨(R.q₂ : Int), (R.q : Int)⟩ else line ⟨(R.q₁ : Int), 0⟩] + ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (FordRecursiveQuadruple R i.succ) (S i s) + (K i s) ) := by + classical + intro H R q1pos R1 R2 ho1 ho2 S hS c0t c0f c1t c1f c2t a2t c2f a2f line K i s + have pos (p : Int) (q : Nat) (h : 0 < q) : 0 < (FordCircleCoordinate p q).1 := by + change (0 : Int) < ((q * q : Nat) : Int) + exact_mod_cast Nat.mul_pos h h + fin_cases i <;> cases s <;> + simp only [Fin.succ, Fin.reduceFinMk, FordRecursiveQuadruple, + ite_eq_right q1pos.ne'] + · apply PositiveCurvatureTileOdometerSupportTransport + (FordCircleCoordinate R.p₁ R.q₁) + (TileTranslation (FordTile R.q₁) ⟨(R.q₂ : Int), (R.q₂ : Int)⟩) + _ _ (pos _ _ q1pos) + · exact TileOdometerAffineTranslation _ _ _ _ _ _ ho1 + · simpa [FordRecursiveQuadruple, q1pos.ne'] using (hS 0 false).1 + · exact c0f.symm + · apply PositiveCurvatureTileOdometerSupportTransport + (FordCircleCoordinate R.p₁ R.q₁) (FordTile R.q₁) _ _ (pos _ _ q1pos) ho1 + · simpa [FordRecursiveQuadruple, q1pos.ne'] using (hS 0 true).1 + · exact c0t.symm + · apply PositiveCurvatureTileOdometerSupportTransport + (FordCircleCoordinate R.p₂ R.q₂) + (TileTranslation (FordTile R.q₂) ⟨0, (R.q₁ : Int)⟩) + _ _ (pos _ _ R.q₂_pos) + · exact TileOdometerAffineTranslation _ _ _ _ _ _ ho2 + · simpa [FordRecursiveQuadruple] using (hS 1 false).1 + · exact c1f.symm + · apply PositiveCurvatureTileOdometerSupportTransport + (FordCircleCoordinate R.p₂ R.q₂) + (TileTranslation (FordTile R.q₂) ⟨(R.q₁ : Int), 0⟩) + _ _ (pos _ _ R.q₂_pos) + · exact TileOdometerAffineTranslation _ _ _ _ _ _ ho2 + · simpa [FordRecursiveQuadruple] using (hS 1 true).1 + · exact c1t.symm + · have he : S 2 false = ⟨∅, ⟨(R.q₁ : Int), 0⟩⟩ := by + cases ht : S 2 false + simpa only [ht, ProtoTile.mk.injEq] using And.intro c2f a2f + rw [he] + exact TileOdometer.line (-1) _ (Or.inr rfl) _ rfl + · have he : S 2 true = ⟨∅, ⟨(R.q₂ : Int), (R.q : Int)⟩⟩ := by + cases ht : S 2 true + simpa only [ht, ProtoTile.mk.injEq] using And.intro c2t a2t + rw [he] + exact TileOdometer.line (-1) _ (Or.inr rfl) _ rfl + +private theorem kd : + (by + classical + exact + let H (R : FordFareyParameter) := P4217T2SquareRestriction R.q (FordOdometer R) + ∀ (mem : ∀ (R : FordFareyParameter), ∀ (x : GaussianInt), x ∈ (H R).domain ↔ x ∈ + FordVertexDomain R.q), ∀ (R : FordFareyParameter), ∀ (R1 : FordFareyParameter), ∀ + (hq1 : R1.q = R.q₁), ∀ (R2 : FordFareyParameter), ∀ (hq2 : R2.q = R.q₂), + let line (x : GaussianInt) : PartialOdometer := + { domain := {x} + value := fun y => if y = x then FordOdometer R y else 0 + value_outside := by intro y hy; exact ite_eq_right (by simpa using hy) } + let K : Fin 3 → Bool → PartialOdometer := + ![fun s => if s then H R1 else + PartialOdometerAffineTranslate (H R1) ⟨(R.q₂ : Int), (R.q₂ : Int)⟩ + ⟨R.p₂, R.p₂⟩ (-R.p₂ * R.q₂ + 1), + fun s => if s then + PartialOdometerAffineTranslate (H R2) ⟨(R.q₁ : Int), 0⟩ ⟨0, R.p₁⟩ 0 else + PartialOdometerAffineTranslate (H R2) ⟨0, (R.q₁ : Int)⟩ ⟨R.p₁, 0⟩ 0, + fun s => if s then line ⟨(R.q₂ : Int), (R.q : Int)⟩ else line ⟨(R.q₁ : Int), 0⟩] + ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (x : GaussianInt), x ∈ (K i s).domain ↔ if i = (0 : + Fin (3 : ℕ)) then x ∈ FordRecursiveVertexDomains R (if s = true then (0 : Fin (4 : + ℕ)) else (1 : Fin (4 : ℕ))) else if i = (1 : Fin (3 : ℕ)) then x ∈ + FordRecursiveVertexDomains R (if s = true then (2 : Fin (4 : ℕ)) else (3 : Fin (4 : + ℕ))) else x = if s = true then ⟨(↑R.q₂ : ℤ), (↑R.q : ℤ)⟩ else ⟨(↑R.q₁ : ℤ), (0 : ℤ)⟩ + ) := by + classical + intro H mem R R1 hq1 R2 hq2 line K i s x + have hsum : (R.q : Int) = (R.q₁ : Int) + (R.q₂ : Int) := by exact_mod_cast R.sum_q + fin_cases i <;> cases s <;> + simp [K, line, (PartialOdometerAffineTranslateFormulas _ _ _ _).2.1, + mem, FordRecursiveVertexDomains, FordVertexDomain, hq1, hq2] <;> omega + +private theorem dom : + (by + classical + exact + let H (R : FordFareyParameter) := P4217T2SquareRestriction R.q (FordOdometer R) + ∀ (mem : ∀ (R : FordFareyParameter), ∀ (x : GaussianInt), x ∈ (H R).domain ↔ x ∈ + FordVertexDomain R.q), ∀ (R : FordFareyParameter), ∀ (hgt : 1 < R.q), ∀ (q1pos : 0 < + R.q₁), ∀ (q2lt : R.q₂ < R.q), ∀ (R1 : FordFareyParameter), ∀ (hq1 : R1.q = R.q₁), ∀ + (R2 : FordFareyParameter), ∀ (hq2 : R2.q = R.q₂), + let line (x : GaussianInt) : PartialOdometer := + { domain := {x} + value := fun y => if y = x then FordOdometer R y else 0 + value_outside := by intro y hy; exact ite_eq_right (by simpa using hy) } + let K : Fin 3 → Bool → PartialOdometer := + ![fun s => if s then H R1 else + PartialOdometerAffineTranslate (H R1) ⟨(R.q₂ : Int), (R.q₂ : Int)⟩ + ⟨R.p₂, R.p₂⟩ (-R.p₂ * R.q₂ + 1), + fun s => if s then + PartialOdometerAffineTranslate (H R2) ⟨(R.q₁ : Int), 0⟩ ⟨0, R.p₁⟩ 0 else + PartialOdometerAffineTranslate (H R2) ⟨0, (R.q₁ : Int)⟩ ⟨R.p₁, 0⟩ 0, + fun s => if s then line ⟨(R.q₂ : Int), (R.q : Int)⟩ else line ⟨(R.q₁ : Int), 0⟩] + (∀ (i : Fin 3), ∀ (s : Bool), ∀ (x : GaussianInt), x ∈ (K i s).domain ↔ if i = 0 then x ∈ + FordRecursiveVertexDomains R (if s then 0 else 1) else if i = 1 then x ∈ + FordRecursiveVertexDomains R (if s then 2 else 3) else x = if s then ⟨(R.q₂ : Int), + (R.q : Int)⟩ else ⟨(R.q₁ : Int), 0⟩) → (∀ (x : GaussianInt), x ∈ (H R).domain ↔ ∃ (i + : Fin (3 : ℕ)) (s : Bool), x ∈ (K i s).domain) ) := by + classical + intro H mem R hgt q1pos q2lt R1 hq1 R2 hq2 line K kd x + rw [mem] + constructor + · intro hx + have he : x ∈ FordRecursiveVertexDomains R 0 ∨ + x ∈ FordRecursiveVertexDomains R 1 ∨ + x ∈ FordRecursiveVertexDomains R 2 ∨ + x ∈ FordRecursiveVertexDomains R 3 := by + have hs := R.sum_q + simp [FordRecursiveVertexDomains, FordVertexDomain] at hx ⊢ + omega + rcases he with he | he | he | he + · exact ⟨0, true, (kd 0 true x).mpr he⟩ + · exact ⟨0, false, (kd 0 false x).mpr he⟩ + · exact ⟨1, true, (kd 1 true x).mpr he⟩ + · exact ⟨1, false, (kd 1 false x).mpr he⟩ + · rintro ⟨i, s, hx⟩ + have hx := (kd i s x).mp hx + have hs := R.sum_q + fin_cases i <;> cases s <;> + simp? [FordRecursiveVertexDomains, FordVertexDomain] at hx ⊢ <;> + (try subst x) <;> dsimp at * <;> omega + +private theorem values : + (by + classical + exact + let H (R : FordFareyParameter) := P4217T2SquareRestriction R.q (FordOdometer R) + ∀ (val : ∀ (R : FordFareyParameter), ∀ (x : GaussianInt), (x ∈ (H R).domain) → ((H + R).value x = FordOdometer R x)), ∀ (laws : (∀ (R : FordFareyParameter), ∀ (x : + GaussianInt), R.q = (1 : ℕ) → FordOdometer R x = x.re * (x.re - (1 : ℤ)) / (2 : ℤ) + + R.p * x.re * x.im) ∧ (∀ (P : FordFareyParameter), ∀ x ∈ FordDoubledBoundary P.q, + Classical.choose FordOdometerFamilyExistsUnique P x = IntegerCeilDiv (P.p * x.re * + x.im) (↑P.q : ℤ) (by exact_mod_cast P.q_pos.ne')) ∧ (∀ (P : FordFareyParameter), ∀ (x + : GaussianInt), + Classical.choose FordOdometerFamilyExistsUnique P (x + ⟨(0 : ℤ), -(↑P.q : ℤ)⟩) = + Classical.choose FordOdometerFamilyExistsUnique P x - P.p * x.re) ∧ (∀ (P : + FordFareyParameter), ∀ (x : GaussianInt), Classical.choose + FordOdometerFamilyExistsUnique P (x + ⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩) = Classical.choose + FordOdometerFamilyExistsUnique P x + P.p₁ * x.re + P.p * x.im + (↑P.q₁ : ℤ) * P.p) ∧ + (∀ (P : FordFareyParameter), ∀ (x : GaussianInt), Classical.choose + FordOdometerFamilyExistsUnique P (x + ⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩) = Classical.choose + FordOdometerFamilyExistsUnique P x + P.p₂ * x.re - P.p * x.im - (↑P.q : ℤ) * P.p₂) ∧ + ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), ∀ (P₂ : FordFareyParameter), + (1 : ℕ) < P.q → P₁.p = P.p₁ → P₁.q = P.q₁ → P₂.p = P.p₂ → P₂.q = P.q₂ → (∀ x ∈ + FordRecursiveVertexDomains P (0 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique + P₁ x) ∧ (∀ x ∈ FordRecursiveVertexDomains P (1 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique + P₁ (x - ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (↑P.q₂ : ℤ) + + (1 : ℤ)) ∧ (∀ x ∈ FordRecursiveVertexDomains P (2 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique + P₂ (x - ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩) + P.p₁ * x.im) ∧ ∀ x ∈ FordRecursiveVertexDomains P + (3 : Fin (4 : ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = + Classical.choose FordOdometerFamilyExistsUnique P₂ (x - ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩) + + P.p₁ * x.re), ∀ (R : FordFareyParameter), ∀ (hgt : 1 < R.q), ∀ (R1 : + FordFareyParameter), ∀ (hp1 : R1.p = R.p₁), ∀ (hq1 : R1.q = R.q₁), ∀ (R2 : + FordFareyParameter), ∀ (hp2 : R2.p = R.p₂), ∀ (hq2 : R2.q = R.q₂), + let line (x : GaussianInt) : PartialOdometer := + { domain := {x} + value := fun y => if y = x then FordOdometer R y else 0 + value_outside := by intro y hy; exact ite_eq_right (by simpa using hy) } + let K : Fin 3 → Bool → PartialOdometer := + ![fun s => if s then H R1 else + PartialOdometerAffineTranslate (H R1) ⟨(R.q₂ : Int), (R.q₂ : Int)⟩ + ⟨R.p₂, R.p₂⟩ (-R.p₂ * R.q₂ + 1), + fun s => if s then + PartialOdometerAffineTranslate (H R2) ⟨(R.q₁ : Int), 0⟩ ⟨0, R.p₁⟩ 0 else + PartialOdometerAffineTranslate (H R2) ⟨0, (R.q₁ : Int)⟩ ⟨R.p₁, 0⟩ 0, + fun s => if s then line ⟨(R.q₂ : Int), (R.q : Int)⟩ else line ⟨(R.q₁ : Int), 0⟩] + (∀ (i : Fin 3), ∀ (s : Bool), ∀ (x : GaussianInt), x ∈ (K i s).domain ↔ if i = 0 then x ∈ + FordRecursiveVertexDomains R (if s then 0 else 1) else if i = 1 then x ∈ + FordRecursiveVertexDomains R (if s then 2 else 3) else x = if s then ⟨(R.q₂ : Int), + (R.q : Int)⟩ else ⟨(R.q₁ : Int), 0⟩) → ((∀ (x : GaussianInt), x ∈ (H R).domain ↔ ∃ i + s, x ∈ (K i s).domain) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (K i s).domain, (H + R).value x = (K i s).value x)) ) := by + classical + intro H val laws R hgt R1 hp1 hq1 R2 hp2 hq2 line K kd dom i s x hx + rw [val R x ((dom x).mpr ⟨i, s, hx⟩)] + have recs := laws.2.2.2.2.2 R R1 R2 hgt hp1 hq1 hp2 hq2 + change + (∀ x, x ∈ FordRecursiveVertexDomains R 0 → FordOdometer R x = FordOdometer R1 x) ∧ + (∀ x, x ∈ FordRecursiveVertexDomains R 1 → + FordOdometer R x = FordOdometer R1 (x - ⟨(R.q₂ : Int), (R.q₂ : Int)⟩) + + R.p₂ * x.re + R.p₂ * x.im - R.p₂ * (R.q₂ : Int) + 1) ∧ + (∀ x, x ∈ FordRecursiveVertexDomains R 2 → + FordOdometer R x = FordOdometer R2 (x - ⟨(R.q₁ : Int), 0⟩) + R.p₁ * x.im) ∧ + (∀ x, x ∈ FordRecursiveVertexDomains R 3 → + FordOdometer R x = FordOdometer R2 (x - ⟨0, (R.q₁ : Int)⟩) + R.p₁ * x.re) at recs + have he := (kd i s x).mp hx + fin_cases i <;> cases s <;> norm_num at he + · rw [recs.2.1 x he] + change _ = (PartialOdometerAffineTranslate (H R1) + ⟨(R.q₂ : Int), (R.q₂ : Int)⟩ ⟨R.p₂, R.p₂⟩ (-R.p₂ * R.q₂ + 1)).value x + have hf := (PartialOdometerAffineTranslateFormulas (H R1) _ _ _).2.2.1 x hx + rw [hf, val R1 _ ((PartialOdometerAffineTranslateFormulas (H R1) _ _ _).2.1 x |>.mp hx)] + dsimp + ring + · exact (recs.1 x he).trans (val R1 x hx).symm + · rw [recs.2.2.2 x he] + change _ = (PartialOdometerAffineTranslate (H R2) + ⟨0, (R.q₁ : Int)⟩ ⟨R.p₁, 0⟩ 0).value x + have hf := (PartialOdometerAffineTranslateFormulas (H R2) _ _ _).2.2.1 x hx + rw [hf, val R2 _ ((PartialOdometerAffineTranslateFormulas (H R2) _ _ _).2.1 x |>.mp hx)] + dsimp + ring + · rw [recs.2.2.1 x he] + change _ = (PartialOdometerAffineTranslate (H R2) + ⟨(R.q₁ : Int), 0⟩ ⟨0, R.p₁⟩ 0).value x + have hf := (PartialOdometerAffineTranslateFormulas (H R2) _ _ _).2.2.1 x hx + rw [hf, val R2 _ ((PartialOdometerAffineTranslateFormulas (H R2) _ _ _).2.1 x |>.mp hx)] + dsimp + ring + · simp [K, line, he] + · simp [K, line, he] + +private theorem compat : + (by + classical + exact + let H (R : FordFareyParameter) := P4217T2SquareRestriction R.q (FordOdometer R) + ∀ (R : FordFareyParameter), ∀ (R1 : FordFareyParameter), ∀ (R2 : FordFareyParameter), + let line (x : GaussianInt) : PartialOdometer := + { domain := {x} + value := fun y => if y = x then FordOdometer R y else 0 + value_outside := by intro y hy; exact ite_eq_right (by simpa using hy) } + let K : Fin 3 → Bool → PartialOdometer := + ![fun s => if s then H R1 else + PartialOdometerAffineTranslate (H R1) ⟨(R.q₂ : Int), (R.q₂ : Int)⟩ + ⟨R.p₂, R.p₂⟩ (-R.p₂ * R.q₂ + 1), + fun s => if s then + PartialOdometerAffineTranslate (H R2) ⟨(R.q₁ : Int), 0⟩ ⟨0, R.p₁⟩ 0 else + PartialOdometerAffineTranslate (H R2) ⟨0, (R.q₁ : Int)⟩ ⟨R.p₁, 0⟩ 0, + fun s => if s then line ⟨(R.q₂ : Int), (R.q : Int)⟩ else line ⟨(R.q₁ : Int), 0⟩] + (∀ (i : Fin 3), ∀ (s : Bool), ∀ (x : GaussianInt), (x ∈ (K i s).domain) → ((H R).value x + = (K i s).value x)) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin (3 : ℕ)), ∀ (t : + Bool), OdometerCompatibility (K i s) (K j t)) ) := by + classical + intro H R R1 R2 line K values i s j t + right + refine ⟨0, ?_⟩ + intro x hx hy + rw [← values i s x hx, ← values j t x hy, sub_self] + +private theorem slopes : + (by + classical + exact + let H (R : FordFareyParameter) := P4217T2SquareRestriction R.q (FordOdometer R) + ∀ (slope : ∀ (R : FordFareyParameter), PartialOdometerSlope (H R) = some ((R.p : Real) / + 2, (R.p : Real) / 2)), ∀ (R : FordFareyParameter), ∀ (hgt : 1 < R.q), ∀ (R1 : + FordFareyParameter), ∀ (hp1 : R1.p = R.p₁), ∀ (R2 : FordFareyParameter), ∀ (hp2 : + R2.p = R.p₂), + let line (x : GaussianInt) : PartialOdometer := + { domain := {x} + value := fun y => if y = x then FordOdometer R y else 0 + value_outside := by intro y hy; exact ite_eq_right (by simpa using hy) } + let K : Fin 3 → Bool → PartialOdometer := + ![fun s => if s then H R1 else + PartialOdometerAffineTranslate (H R1) ⟨(R.q₂ : Int), (R.q₂ : Int)⟩ + ⟨R.p₂, R.p₂⟩ (-R.p₂ * R.q₂ + 1), + fun s => if s then + PartialOdometerAffineTranslate (H R2) ⟨(R.q₁ : Int), 0⟩ ⟨0, R.p₁⟩ 0 else + PartialOdometerAffineTranslate (H R2) ⟨0, (R.q₁ : Int)⟩ ⟨R.p₁, 0⟩ 0, + fun s => if s then line ⟨(R.q₂ : Int), (R.q : Int)⟩ else line ⟨(R.q₁ : Int), 0⟩] + ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (FordRecursiveQuadruple R i.succ).1 = (0 : ℤ) ∨ ∃ (p : + ℝ × ℝ) (pi : ℝ × ℝ), PartialOdometerSlope (H R) = some p ∧ PartialOdometerSlope (K i + s) = some pi ∧ pi.1 - p.1 = (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (FordRecursiveQuadruple R (i + (2 : Fin (3 : ℕ))).succ) + (FordRecursiveQuadruple R (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 + (FordRecursiveQuadruple R (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple R (i + + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ pi.2 - p.2 = (if s = true then (1 : ℝ) else + (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (FordRecursiveQuadruple R (i + (2 : Fin + (3 : ℕ))).succ) (FordRecursiveQuadruple R (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + + (↑(BandVectors.2 (FordRecursiveQuadruple R (i + (2 : Fin (3 : ℕ))).succ) + (FordRecursiveQuadruple R (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ)) ) := by + classical + intro H slope R hgt R1 hp1 R2 hp2 line K i s + have cfg := (FordCoordinateConfiguration R).2 hgt + have a32 := cfg.2.2.2.2.2.2.2.1 + have a13 := cfg.2.2.2.2.2.2.2.2 + have sp : (R.p : Real) = (R.p₁ : Real) + (R.p₂ : Real) := by exact_mod_cast R.sum_p + have sl1 := slope R1 + have sl2 := slope R2 + rw [hp1] at sl1 + rw [hp2] at sl2 + fin_cases i + · right + cases s + · refine ⟨_, ((R.p₁ : Real) / 2 + R.p₂, (R.p₁ : Real) / 2 + R.p₂), + slope R, ?_, ?_, ?_⟩ + · simpa [K, sl1] using (PartialOdometerAffineTranslateFormulas (H R1) + ⟨(R.q₂ : Int), (R.q₂ : Int)⟩ ⟨R.p₂, R.p₂⟩ (-R.p₂ * R.q₂ + 1)).2.2.2.2.2 + · simp [a32]; linarith only [sp] + · simp [a32]; linarith only [sp] + · exact ⟨_, _, slope R, sl1, by simp [a32]; linarith only [sp], + by simp [a32]; linarith only [sp]⟩ + · right + cases s + · refine ⟨_, ((R.p₂ : Real) / 2 + R.p₁, (R.p₂ : Real) / 2), + slope R, ?_, ?_, ?_⟩ + · simpa [K, sl2] using (PartialOdometerAffineTranslateFormulas (H R2) + ⟨0, (R.q₁ : Int)⟩ ⟨R.p₁, 0⟩ 0).2.2.2.2.2 + · simp [a13]; linarith only [sp] + · simp [a13]; linarith only [sp] + · refine ⟨_, ((R.p₂ : Real) / 2, (R.p₂ : Real) / 2 + R.p₁), + slope R, ?_, ?_, ?_⟩ + · simpa [K, sl2] using (PartialOdometerAffineTranslateFormulas (H R2) + ⟨(R.q₁ : Int), 0⟩ ⟨0, R.p₁⟩ 0).2.2.2.2.2 + · simp [a13]; linarith only [sp] + · simp [a13]; linarith only [sp] + · left + rfl + +end FordOdometerRestriction + +theorem FordTileOdometerRestriction (P : FordFareyParameter) : + exists h : PartialOdometer, + TileOdometer (FordCircleCoordinate P.p P.q) (FordTile P.q) h /\ + (h.domain : Set GaussianInt) = FordVertexDomain P.q /\ + forall x, x ∈ h.domain -> h.value x = FordOdometer P x := by +-- BODY + classical + let H (R : FordFareyParameter) := P4217T2SquareRestriction R.q (FordOdometer R) + have geom (R : FordFareyParameter) := + P4217T2SquareGeometry R.q (FordOdometer R) R.q_pos + have mem (R : FordFareyParameter) (x : GaussianInt) := FordOdometerRestriction.mem geom R x + have val (R : FordFareyParameter) (x : GaussianInt) (hx : x ∈ (H R).domain) : + (H R).value x = FordOdometer R x := (geom R).2.1 x hx + have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + change (∀ R x, R.q = 1 → FordOdometer R x = _) ∧ _ at laws + have slope (R : FordFareyParameter) := FordOdometerRestriction.slope geom mem val laws R + have main (n : Nat) : ∀ R : FordFareyParameter, R.q = n → + TileOdometer (FordCircleCoordinate R.p R.q) (FordTile R.q) (H R) := by + induction n using Nat.strong_induction_on with + | h n ih => + intro R hn + subst n + by_cases hu : R.q = 1 + · have htile := (FordTileRecursiveIdentification R).2.1 hu + have hdomain := FordOdometerRestriction.hdomain R hu + have ht := FordOdometerRestriction.ht val laws R hu hdomain + have hc : FordCircleCoordinate R.p R.q = (1, 1 + 2 * (⟨0, R.p⟩ : GaussianInt)) := by + ext <;> simp [FordCircleCoordinate, hu] + rw [hc] + apply TileOdometer.unit ⟨0, R.p⟩ 0 _ _ + · rw [htile] + · exact (geom R).1.trans (by + simpa [hu] using (P4062T1CanonicalSupport R.q R.q_pos).1.symm) + · exact ht + have hgt : 1 < R.q := by have := R.q_pos; omega + have q1pos := FordOdometerRestriction.q1pos R hgt + have q2lt : R.q₂ < R.q := by have := R.sum_q; omega + have cross : R.p₁ * (R.q₂ : Int) - (R.q₁ : Int) * R.p₂ = 1 := FordOdometerRestriction.cross R + have red (a : Int) (b d : Nat) (c : Int) + (hd : a * (d : Int) - (b : Int) * c = 1) : Nat.Coprime b a.natAbs := + FordOdometerRestriction.red R a b d c hd + obtain ⟨R1, ⟨hp1, hq1⟩, _⟩ := FordFareyParentsExist R.p₁ R.q₁ q1pos + (red R.p₁ R.q₁ R.q₂ R.p₂ cross) + obtain ⟨R2, ⟨hp2, hq2⟩, _⟩ := FordFareyParentsExist R.p₂ R.q₂ R.q₂_pos + (by simpa using red (-R.p₂) R.q₂ R.q₁ (-R.p₁) (by nlinarith [cross])) + have ho1 : TileOdometer (FordCircleCoordinate R.p₁ R.q₁) (FordTile R.q₁) (H R1) := by + simpa [hp1, hq1] using ih R.q₁ R.q₁_lt R1 hq1 + have ho2 : TileOdometer (FordCircleCoordinate R.p₂ R.q₂) (FordTile R.q₂) (H R2) := by + simpa [hp2, hq2] using ih R.q₂ q2lt R2 hq2 + obtain ⟨hq, S, hS, hcells, c0t, c0f, c1t, c1f, c2t, a2t, c2f, a2f⟩ := + (FordTileRecursiveIdentification R).2.2 hgt + let line (x : GaussianInt) : PartialOdometer := + { domain := {x} + value := fun y => if y = x then FordOdometer R y else 0 + value_outside := by intro y hy; exact ite_eq_right (by simpa using hy) } + let K : Fin 3 → Bool → PartialOdometer := + ![fun s => if s then H R1 else + PartialOdometerAffineTranslate (H R1) ⟨(R.q₂ : Int), (R.q₂ : Int)⟩ + ⟨R.p₂, R.p₂⟩ (-R.p₂ * R.q₂ + 1), + fun s => if s then + PartialOdometerAffineTranslate (H R2) ⟨(R.q₁ : Int), 0⟩ ⟨0, R.p₁⟩ 0 else + PartialOdometerAffineTranslate (H R2) ⟨0, (R.q₁ : Int)⟩ ⟨R.p₁, 0⟩ 0, + fun s => if s then line ⟨(R.q₂ : Int), (R.q : Int)⟩ else line ⟨(R.q₁ : Int), 0⟩] + have kcert (i : Fin 3) (s : Bool) := FordOdometerRestriction.kcert R q1pos R1 R2 ho1 ho2 S + hS c0t c0f c1t c1f c2t a2t c2f a2f i s + have kd (i : Fin 3) (s : Bool) (x : GaussianInt) := FordOdometerRestriction.kd mem R R1 hq1 + R2 hq2 i s x + have dom (x : GaussianInt) := FordOdometerRestriction.dom mem R hgt q1pos q2lt R1 hq1 R2 + hq2 kd x + have values (i : Fin 3) (s : Bool) (x : GaussianInt) (hx : x ∈ (K i s).domain) := + FordOdometerRestriction.values val laws R hgt R1 hp1 hq1 R2 hp2 hq2 kd dom i s x hx + have compat (i : Fin 3) (s : Bool) (j : Fin 3) (t : Bool) := FordOdometerRestriction.compat + R R1 R2 values i s j t + have slopes (i : Fin 3) (s : Bool) := FordOdometerRestriction.slopes slope R hgt R1 hp1 R2 + hp2 i s + exact TileOdometer.decompose hq (FordTileRecursiveIdentification R).1 kcert + hcells (fun i s => (hS i s).2.1) (fun i s => (hS i s).2.2) + dom values compat slopes + exact ⟨H P, main P.q P rfl, (geom P).1, val P⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordTileRecursiveIdentification.lean b/LeanPool/ApollonianSuperharmonic/FordTileRecursiveIdentification.lean new file mode 100644 index 0000000000..8a54d50a85 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordTileRecursiveIdentification.lean @@ -0,0 +1,258 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist +public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid +public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport + +-- [TABLET NODE: FordTileRecursiveIdentification] + +/-! +# FordTileRecursiveIdentification + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem FordTileRecursiveIdentification (P : FordFareyParameter) : + BandPrototile (FordCircleCoordinate P.p P.q) (FordTile P.q) ∧ + (P.q = 1 → FordTile P.q = ⟨{0}, 0⟩) ∧ + (1 < P.q → + ProperBandQuadruple (FordRecursiveQuadruple P) ∧ + ∃ S : Fin 3 → Bool → ProtoTile, + (∀ i s, BandSubtileOccurrence (FordRecursiveQuadruple P) + (FordTile P.q) i s (S i s)) ∧ + (∀ x, x ∈ (FordTile P.q).cells ↔ ∃ i s, x ∈ (S i s).cells) ∧ + (S 0 true).cells = (FordTile P.q₁).cells ∧ + (S 0 false).cells = + (TileTranslation (FordTile P.q₁) + ⟨(P.q₂ : Int), (P.q₂ : Int)⟩).cells ∧ + (S 1 true).cells = + (TileTranslation (FordTile P.q₂) ⟨(P.q₁ : Int), 0⟩).cells ∧ + (S 1 false).cells = + (TileTranslation (FordTile P.q₂) ⟨0, (P.q₁ : Int)⟩).cells ∧ + (S 2 true).cells = ∅ ∧ + (S 2 true).anchor = ⟨(P.q₂ : Int), (P.q : Int)⟩ ∧ + (S 2 false).cells = ∅ ∧ + (S 2 false).anchor = ⟨(P.q₁ : Int), 0⟩) := by +-- BODY + classical + generalize hn : P.q = n + induction n using Nat.strong_induction_on generalizing P with + | h n ih => + subst n + by_cases hu : P.q = 1 + · have htile : FordTile P.q = ⟨{0}, 0⟩ := by + simp [hu, FordTile, FordCellDomain, Finset.range_one] + rfl + refine ⟨?_, fun _ => htile, ?_⟩ + · rw [htile] + convert BandPrototile.unit ⟨0, P.p⟩ 0 0 using 1; + simp? [FordCircleCoordinate, hu] + ext <;> simp + · intro hgt + omega + have hgt : 1 < P.q := by have := P.q_pos; omega + have q1pos : 0 < P.q₁ := by + by_contra h + have hz : P.q₁ = 0 := by omega + have hd := P.det₁ + simp [hz] at hd + have hdv : (P.q : Int) ∣ 1 := ⟨P.p₁, by simpa [mul_comm] using hd.symm⟩ + have hqone : (P.q : Int) = 1 := Int.eq_one_of_dvd_one (by omega) hdv + omega + have q2lt : P.q₂ < P.q := by have := P.sum_q; omega + have cross : P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 := by + have h1 : P.p₁ * ((P.q₁ + P.q₂ : Nat) : Int) - + (P.q₁ : Int) * (P.p₁ + P.p₂) = 1 := by + simpa [P.sum_q, P.sum_p] using P.det₁ + norm_num [Nat.cast_add] at h1 + nlinarith [h1] + have determinantCoprime : ∀ (a : Int) (b d : Nat) (c : Int), + a * (d : Int) - (b : Int) * c = 1 → Nat.Coprime b a.natAbs := by + intro a b d c hd + rw [Nat.coprime_iff_gcd_eq_one] + apply Nat.dvd_one.mp + let g := Nat.gcd b a.natAbs + have gb : g ∣ b := Nat.gcd_dvd_left _ _ + have ga : g ∣ a.natAbs := Nat.gcd_dvd_right _ _ + have gb' : (g : Int) ∣ (b : Int) := by exact_mod_cast gb + have ga' : (g : Int) ∣ a := (Int.dvd_natAbs).mp (by exact_mod_cast ga) + have gd : (g : Int) ∣ a * (d : Int) - (b : Int) * c := + dvd_sub (dvd_mul_of_dvd_left ga' _) (dvd_mul_of_dvd_left gb' _) + have gd1 : (g : Int) ∣ 1 := by simpa [hd] using gd + have ge : (g : Int) = 1 := + Int.eq_one_of_dvd_one (by exact_mod_cast (Nat.zero_le g)) gd1 + have gn : g = 1 := by exact_mod_cast ge + simp [g, gn] + have red1 := determinantCoprime P.p₁ P.q₁ P.q₂ P.p₂ cross + have red2 : Nat.Coprime P.q₂ P.p₂.natAbs := by + have h := determinantCoprime (-P.p₂) P.q₂ P.q₁ (-P.p₁) (by nlinarith [cross]) + simpa using h + obtain ⟨P1, ⟨hp1, hq1⟩, _⟩ := FordFareyParentsExist P.p₁ P.q₁ q1pos red1 + obtain ⟨P2, ⟨hp2, hq2⟩, _⟩ := FordFareyParentsExist P.p₂ P.q₂ P.q₂_pos red2 + have parent1 : BandPrototile (FordCircleCoordinate P.p₁ P.q₁) (FordTile P.q₁) := by + have h := (ih P.q₁ P.q₁_lt P1 hq1).1 + simpa [hp1, hq1] using h + have parent2 : BandPrototile (FordCircleCoordinate P.p₂ P.q₂) (FordTile P.q₂) := by + have h := (ih P.q₂ q2lt P2 hq2).1 + simpa [hp2, hq2] using h + let q := FordRecursiveQuadruple P + obtain ⟨hq, h10, h20, h30, _⟩ := (FordCoordinateConfiguration P).2 hgt + change ProperBandQuadruple q at hq + have hs := (VectorRecursionLaws q hq.1).1 + have h1 := (VectorRecursionLaws q hq.1).2.2.1 + have h3 : BandVectors.1 (q 3) (q 0) = + BandVectors.1 (q 3) (q 2) - + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 1) (q 3) := by + simpa using (VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1))).2.2.1 + change BandVectors.1 (q 1) (q 0) = _ at h10 + change BandVectors.1 (q 3) (q 0) = _ at h30 + rw [h10] at h1 + rw [h30] at h3 + simp only [Zsqrtd.ext_iff, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_mul, Zsqrtd.im_mul, + Zsqrtd.re_zero, Zsqrtd.im_zero] at hs h1 h3 + norm_num at hs h1 h3 + have hsum : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by + exact_mod_cast P.sum_q + have h32 : BandVectors.1 (q 3) (q 2) = ⟨0, -(P.q₂ : Int)⟩ := by + apply Zsqrtd.ext <;> dsimp <;> omega + have h13 : BandVectors.1 (q 1) (q 3) = ⟨(P.q₁ : Int), 0⟩ := by + apply Zsqrtd.ext <;> dsimp <;> omega + have h21 : BandVectors.1 (q 2) (q 1) = ⟨-(P.q₁ : Int), (P.q₂ : Int)⟩ := by + apply Zsqrtd.ext <;> dsimp <;> omega + let S : Fin 3 → Bool → ProtoTile := + ![fun s => if s then FordTile P.q₁ else + TileTranslation (FordTile P.q₁) ⟨(P.q₂ : Int), (P.q₂ : Int)⟩, + fun s => if s then + TileTranslation (FordTile P.q₂) ⟨(P.q₁ : Int), 0⟩ else + TileTranslation (FordTile P.q₂) ⟨0, (P.q₁ : Int)⟩, + fun s => if s then ⟨∅, ⟨(P.q₂ : Int), (P.q : Int)⟩⟩ else + ⟨∅, ⟨(P.q₁ : Int), 0⟩⟩] + have hS (i : Fin 3) (s : Bool) : BandPrototile (q i.succ) (S i s) := by + have hne : P.q₁ ≠ 0 := by omega + fin_cases i <;> cases s + · simpa [S, q, FordRecursiveQuadruple, hne] using + BandPrototileTranslation _ _ ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ parent1 + · simpa [S, q, FordRecursiveQuadruple, hne] using parent1 + · simpa [S, q, FordRecursiveQuadruple] using + BandPrototileTranslation _ _ ⟨0, (P.q₁ : Int)⟩ parent2 + · simpa [S, q, FordRecursiveQuadruple] using + BandPrototileTranslation _ _ ⟨(P.q₁ : Int), 0⟩ parent2 + · exact BandPrototile.line (-1) _ (Or.inr rfl) + · exact BandPrototile.line (-1) _ (Or.inr rfl) + have row_union (x : GaussianInt) : x ∈ (FordTile P.q).cells ↔ + x ∈ (FordTile P.q₁).cells ∨ + x ∈ (TileTranslation (FordTile P.q₁) ⟨(P.q₂ : Int), (P.q₂ : Int)⟩).cells ∨ + x ∈ (TileTranslation (FordTile P.q₂) ⟨(P.q₁ : Int), 0⟩).cells ∨ + x ∈ (TileTranslation (FordTile P.q₂) ⟨0, (P.q₁ : Int)⟩).cells := by + exact (P4210T1FordCellRectangles P.q x).2 P.q₁ P.q₂ P.sum_q + have hcells (x : GaussianInt) : + x ∈ (FordTile P.q).cells ↔ ∃ i s, x ∈ (S i s).cells := by + rw [row_union] + constructor + · rintro (hx | hx | hx | hx) + · exact ⟨0, true, hx⟩ + · exact ⟨0, false, hx⟩ + · exact ⟨1, true, hx⟩ + · exact ⟨1, false, hx⟩ + · rintro ⟨i, s, hx⟩ + fin_cases i <;> cases s + · exact Or.inr (Or.inl hx) + · exact Or.inl hx + · exact Or.inr (Or.inr (Or.inr hx)) + · exact Or.inr (Or.inr (Or.inl hx)) + · simp [S] at hx + · simp [S] at hx + have hsubset (i : Fin 3) (s : Bool) : (S i s).cells ⊆ (FordTile P.q).cells := by + intro x hx + exact (hcells x).mpr ⟨i, s, hx⟩ + have hfoot (i : Fin 3) (s : Bool) : + FootprintVertices (S i s) ⊆ FootprintVertices (FordTile P.q) := by + intro v hv + have hroot : (FordTile P.q).cells.Nonempty := by + refine ⟨0, (P4210T1FordCellRectangles _ _).1.mpr ?_⟩ + simpa using P.q_pos + by_cases hne : (S i s).cells.Nonempty + · simp only [FootprintVertices, ite_eq_left hne, ite_eq_left hroot, + Set.mem_ofPred_eq] at hv ⊢ + obtain ⟨x, hx, hv⟩ := hv + exact ⟨x, hsubset i s hx, hv⟩ + · simp only [FootprintVertices, ite_eq_right hne, Set.mem_singleton_iff] at hv + subst v + have ne1 : (FordTile P.q₁).cells.Nonempty := by + refine ⟨0, (P4210T1FordCellRectangles _ _).1.mpr ?_⟩ + simpa using q1pos + have ne2 : (FordTile P.q₂).cells.Nonempty := by + refine ⟨0, (P4210T1FordCellRectangles _ _).1.mpr ?_⟩ + simpa using P.q₂_pos + fin_cases i <;> cases s + · exact False.elim (hne (ne1.image _)) + · exact False.elim (hne ne1) + · exact False.elim (hne (ne2.image _)) + · exact False.elim (hne (ne2.image _)) + · rw [(P4062T1CanonicalSupport _ P.q_pos).1] + change 0 ≤ (P.q₁ : Int) ∧ (P.q₁ : Int) ≤ (P.q : Int) ∧ 0 ≤ 0 ∧ 0 ≤ (P.q : Int) + omega + · rw [(P4062T1CanonicalSupport _ P.q_pos).1] + change 0 ≤ (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ (P.q : Int) ∧ + 0 ≤ (P.q : Int) ∧ (P.q : Int) ≤ (P.q : Int) + omega + have hcentroid (i : Fin 3) (s : Bool) : + TileCentroid (S i s) - TileCentroid (FordTile P.q) = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-(GaussianRealPoint (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2, + (GaussianRealPoint (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1))) := by + have cr := P4210T1FordSquareCentroid _ P.q_pos + have c1 := P4210T1FordSquareCentroid _ q1pos + have c2 := P4210T1FordSquareCentroid _ P.q₂_pos + have cs : (P.q : Real) = (P.q₁ : Real) + (P.q₂ : Real) := by + exact_mod_cast P.sum_q + have ctrans (r : Nat) (u : GaussianInt) := + (TileTranslationFormulas (FordTile r) u).2.2.2.2.1 + have cempty (a : GaussianInt) : TileCentroid (⟨∅, a⟩ : ProtoTile) = + ((a.re : Real), (a.im : Real)) := by simp [TileCentroid] + fin_cases i <;> cases s <;> + simp? [S, h32, h13, h21, ctrans, cr, c1, c2, cempty, + GaussianRealPoint, Prod.ext_iff] <;> + (try constructor) <;> linarith only [cs] + refine ⟨?_, ?_, ?_⟩ + · exact BandPrototile.decompose hq hS hcells hfoot hcentroid + · intro h + omega + · intro _ + exact ⟨hq, S, (fun i s => ⟨hS i s, hfoot i s, hcentroid i s⟩), + hcells, rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordVertexDomain.lean b/LeanPool/ApollonianSuperharmonic/FordVertexDomain.lean new file mode 100644 index 0000000000..772a481ecd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordVertexDomain.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction + +-- [TABLET NODE: FordVertexDomain] + +/-! +# FordVertexDomain + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The closed Ford vertex domain of denominator $q$ is +$$ + V_q^{\mathrm F}=[0,q]^2\cap\mathbb Z^2. +$$ +It is a vertex set and is distinct from the half-open cell-basepoint set +`FordCellDomain`. +-/ +def FordVertexDomain (q : Nat) : Set GaussianInt := +-- BODY + {x | 0 <= x.re ∧ x.re <= (q : Int) ∧ 0 <= x.im ∧ x.im <= (q : Int)} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean b/LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean new file mode 100644 index 0000000000..4ca3b9436c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean @@ -0,0 +1,361 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy +public import LeanPool.ApollonianSuperharmonic.BandTangency +public import LeanPool.ApollonianSuperharmonic.BoundaryString +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.RegularTileFamily +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileStringExists +public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile + +-- [TABLET NODE: ForwardBoundaryStringData] + +/-! +# ForwardBoundaryStringData + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ForwardBoundaryGeometry + +private theorem hroot : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (ProperBandQuadruple q) → ((BandCircle) → (∀ (i : Fin + 3), (0 < (q i.succ).1) → (1 < (q 0).1))) ) := by + classical + intro q hq Cᵢ i hparent + have hlt := hq.2 i + omega + +private theorem hcyclic : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (ProperBandQuadruple q) → (∀ (Cᵢ : BandCircle), ∀ (i + : Fin 3), (q i.succ = Cᵢ.1.1) → (∀ (orientation : Bool), (Cᵢ.1.1.1 = (1 : ℤ) → + UnitOccurrenceOrientation q i orientation) → ((0 < (q i.succ).1) → (∀ (S : Fin (3 : + ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), + let B := S i false + let g := hs i false + (TileOdometer Cᵢ.1.1 B g) → ((BandPrototile Cᵢ.1.1 B) → (∀ (pouter : ℝ × ℝ), ∀ (pseed : ℝ + × ℝ), (PartialOdometerSlope (hs i false) = some pseed) → ((pseed.1 - pouter.1 = (if + false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 + : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((pseed.2 + - pouter.2 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : + ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).re : ℝ))) → (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + + BandVectors.1 (q i.succ) (q ((i + 2).succ)) + BandVectors.1 (q ((i + 1).succ)) (q + i.succ) = 0 ∧ BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + BandVectors.2 (q + i.succ) (q ((i + 2).succ)) + BandVectors.2 (q ((i + 1).succ)) (q i.succ) = 0 ∧ + BandVectors.1 (q i.succ) (q 0) = BandVectors.1 (q i.succ) (q ((i + 2).succ)) - (⟨0, + 1⟩ : GaussianInt) * BandVectors.1 (q ((i + 1).succ)) (q i.succ) ∧ BandVectors.2 (q + i.succ) (q 0) = BandVectors.2 (q i.succ) (q ((i + 2).succ)) + (⟨0, 1⟩ : GaussianInt) + * BandVectors.2 (q ((i + 1).succ)) (q i.succ)))))))))) ) := by + classical + intro q hq Cᵢ i hCᵢ orientation horientation hparent S hs B g hBodometer hB pouter pseed hpseed + hpre hpim + fin_cases i + · have h := VectorRecursionLaws q hq.1 + simpa using And.intro h.1 (And.intro h.2.1 (And.intro h.2.2.1 h.2.2.2.1)) + · have h := VectorRecursionLaws ![q 0, q 2, q 3, q 1] + (SemiProperQuadruple.rotate hq.1) + simpa using And.intro h.1 (And.intro h.2.1 (And.intro h.2.2.1 h.2.2.2.1)) + · have hr : SemiProperQuadruple ![q 0, q 3, q 1, q 2] := by + simpa using SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1) + have h := VectorRecursionLaws ![q 0, q 3, q 1, q 2] hr + simpa using And.intro h.1 (And.intro h.2.1 (And.intro h.2.2.1 h.2.2.2.1)) + +private theorem hseedIdentity : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (pouter : ℝ × ℝ), ∀ (pseed : ℝ × ℝ), + (pseed.1 - pouter.1 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : + ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ))) → ((pseed.2 - pouter.2 = (if false = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q + (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((BandVectors.2 (q (i + (2 : + Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ) + BandVectors.2 (q i.succ) (q (i + + (2 : Fin (3 : ℕ))).succ) + BandVectors.2 (q (i + (1 : Fin (3 : ℕ))).succ) (q + i.succ) = (0 : GaussianInt)) → ((BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))) = + BandVectors.2 (q i.succ) (q (i + (2 : Fin (3 : ℕ))).succ) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (i + (1 : Fin (3 : ℕ))).succ) (q i.succ)) → + ((BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))) → (pseed + + GaussianRealPoint (-BandVectors.2 (q ((i + 1).succ)) (q i.succ)) = pouter + (1 / 2 : + Real) • GaussianRealPoint (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q + i.succ))))))) ) := by + classical + intro q i pouter pseed hpre hpim hasum hachild haflip + have sumre := congrArg (fun z : GaussianInt => (z.re : Real)) hasum + have sumim := congrArg (fun z : GaussianInt => (z.im : Real)) hasum + have childre := congrArg (fun z : GaussianInt => (z.re : Real)) hachild + have childim := congrArg (fun z : GaussianInt => (z.im : Real)) hachild + have flipre := congrArg (fun z : GaussianInt => (z.re : Real)) haflip + have flipim := congrArg (fun z : GaussianInt => (z.im : Real)) haflip + norm_num [Zsqrtd.re_mul, Zsqrtd.im_mul, -GaussianInt.intCast_re, + -GaussianInt.intCast_im, -Int.cast_inj] at sumre sumim childre childim flipre flipim hpre hpim + apply Prod.ext <;> + simp [GaussianRealPoint, -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> + linarith only [sumre, sumim, childre, childim, flipre, flipim, hpre, hpim] + +private theorem htangent : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (ProperBandQuadruple q) → (∀ (Cᵢ : BandCircle), ∀ (i + : Fin 3), (q i.succ = Cᵢ.1.1) → (∀ (orientation : Bool), (Cᵢ.1.1.1 = (1 : ℤ) → + UnitOccurrenceOrientation q i orientation) → ((0 < (q i.succ).1) → (∀ (S : Fin (3 : + ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), + let B := S i false + let g := hs i false + (TileOdometer Cᵢ.1.1 B g) → ((BandPrototile Cᵢ.1.1 B) → (∀ (pouter : ℝ × ℝ), ∀ (pseed : ℝ + × ℝ), (PartialOdometerSlope (hs i false) = some pseed) → ((pseed.1 - pouter.1 = (if + false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 + : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((pseed.2 + - pouter.2 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : + ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).re : ℝ))) → ((BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q + (i + (1 : Fin (3 : ℕ))).succ) + BandVectors.1 (q i.succ) (q (i + (2 : Fin (3 : + ℕ))).succ) + BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q i.succ) = (0 : + GaussianInt)) → ((BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 + : ℕ))).succ) + BandVectors.2 (q i.succ) (q (i + (2 : Fin (3 : ℕ))).succ) + + BandVectors.2 (q (i + (1 : Fin (3 : ℕ))).succ) (q i.succ) = (0 : GaussianInt)) → + ((BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q i.succ) (q (i + + (2 : Fin (3 : ℕ))).succ) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (i + + (1 : Fin (3 : ℕ))).succ) (q i.succ)) → ((BandVectors.2 (q i.succ) (q (0 : Fin (4 : + ℕ))) = BandVectors.2 (q i.succ) (q (i + (2 : Fin (3 : ℕ))).succ) + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.2 (q (i + (1 : Fin (3 : ℕ))).succ) (q i.succ)) → + ((BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + * BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) → ((BandVectors.2 (q (0 : Fin (4 : + ℕ))) (q i.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (q i.succ) (q + (0 : Fin (4 : ℕ)))) → ((pseed + GaussianRealPoint (-BandVectors.2 (q ((i + 1).succ)) + (q i.succ)) = pouter + (1 / 2 : Real) • GaussianRealPoint (BandVectors.2 (q i.succ) + (q 0) - BandVectors.2 (q 0) (q i.succ))) → ( + let uminus := -BandVectors.1 (q ((i + 1).succ)) (q i.succ) + (BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q i.succ) ∈ TilingLattice Cᵢ) → + ((BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q i.succ) ∈ TilingLattice Cᵢ) → + ((uminus ∈ TilingLattice Cᵢ) → (BandTangency (q i.succ) (q ((i + + 2).succ))))))))))))))))))))) ) := by + classical + intro q hq Cᵢ i hCᵢ orientation horientation hparent S hs B g hBodometer hB pouter pseed hpseed + hpre hpim hvsum hasum hvchild hachild hvflip haflip hseedIdentity uminus hvji hvki huminus + refine ⟨q, hq.1, i.succ, (i + 2).succ, ?_, rfl, rfl⟩ + fin_cases i <;> decide + +private theorem huplus : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (Cᵢ : BandCircle), ∀ (i : Fin 3), + let uplus := (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q i.succ) (q ((i + 2).succ)) + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q i.succ) ∈ TilingLattice Cᵢ) → + ((BandTangency (q i.succ) (q ((i + 2).succ))) → (uplus ∈ TilingLattice Cᵢ)) ) := by + classical + intro q Cᵢ i uplus hvki htangent + rcases BandVectorOrientationDichotomy _ _ htangent with h | h + · simpa only [uplus, h.1] using hvki + · simpa only [uplus, h.1] using (TilingLattice Cᵢ).neg_mem hvki + +private theorem hseedSlope : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (hs : Fin (3 : ℕ) → Bool → + PartialOdometer), + let g := hs i false + ∀ (pseed : ℝ × ℝ), (PartialOdometerSlope (hs i false) = some pseed) → ( + let uminus := -BandVectors.1 (q ((i + 1).succ)) (q i.succ) + let hseed := PartialOdometerAffineTranslate g uminus 0 0 + PartialOdometerSlope hseed = some pseed) ) := by + classical + intro q i hs g pseed hpseed uminus hseed + have h := (PartialOdometerAffineTranslateFormulas g uminus 0 0).2.2.2.2.2 + simpa [hseed, g, hpseed] using h + +private theorem hendpoints : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (T₀ : ProtoTile), ∀ (S : Fin (3 : ℕ) + → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S i s) - + TileCentroid T₀ = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ( + let B := S i false + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ) + + BandVectors.1 (q i.succ) (q (i + (2 : Fin (3 : ℕ))).succ) + BandVectors.1 (q (i + (1 + : Fin (3 : ℕ))).succ) (q i.succ) = (0 : GaussianInt)) → ((BandVectors.1 (q i.succ) (q + (0 : Fin (4 : ℕ))) = BandVectors.1 (q i.succ) (q (i + (2 : Fin (3 : ℕ))).succ) - (⟨(0 + : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q + i.succ)) → ((BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) → ( + let uminus := -BandVectors.1 (q ((i + 1).succ)) (q i.succ) + let uplus := (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q i.succ) (q ((i + 2).succ)) + let Rminus := TileTranslation B uminus + let Rplus := TileTranslation B uplus + TileCentroid Rminus - TileCentroid T₀ = (1 / 2 : Real) • GaussianRealPoint (BandVectors.1 + (q i.succ) (q 0) - BandVectors.1 (q 0) (q i.succ)) ∧ TileCentroid Rplus - + TileCentroid T₀ = (1 / 2 : Real) • GaussianRealPoint (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ)))))) ) := by + classical + intro q i T₀ S hcentroid B hvsum hvchild hvflip uminus uplus Rminus Rplus + have sumre := congrArg (fun z : GaussianInt => (z.re : Real)) hvsum + have sumim := congrArg (fun z : GaussianInt => (z.im : Real)) hvsum + have childre := congrArg (fun z : GaussianInt => (z.re : Real)) hvchild + have childim := congrArg (fun z : GaussianInt => (z.im : Real)) hvchild + have flipre := congrArg (fun z : GaussianInt => (z.re : Real)) hvflip + have flipim := congrArg (fun z : GaussianInt => (z.im : Real)) hvflip + have hbcentroid := hcentroid i false + change TileCentroid B - TileCentroid T₀ = _ at hbcentroid + have centre := congrArg Prod.fst hbcentroid + have centim := congrArg Prod.snd hbcentroid + norm_num [GaussianRealPoint, Zsqrtd.re_mul, Zsqrtd.im_mul, + -GaussianInt.intCast_re, -GaussianInt.intCast_im, + -Int.cast_inj] at sumre sumim childre childim + norm_num [GaussianRealPoint, Zsqrtd.re_mul, Zsqrtd.im_mul, + -GaussianInt.intCast_re, -GaussianInt.intCast_im, + -Int.cast_inj] at flipre flipim centre centim + constructor + · change TileCentroid (TileTranslation B uminus) - TileCentroid T₀ = _ + rw [(TileTranslationFormulas B uminus).2.2.2.2.1] + apply Prod.ext <;> + simp [uminus, GaussianRealPoint, -GaussianInt.intCast_re, + -GaussianInt.intCast_im] <;> + linarith only [sumre, sumim, childre, childim, flipre, flipim, centre, centim] + · change TileCentroid (TileTranslation B uplus) - TileCentroid T₀ = _ + rw [(TileTranslationFormulas B uplus).2.2.2.2.1] + apply Prod.ext <;> + simp [uplus, GaussianRealPoint, Zsqrtd.re_mul, Zsqrtd.im_mul, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> + linarith only [sumre, sumim, childre, childim, flipre, flipim, centre, centim] + +end ForwardBoundaryGeometry + +theorem ForwardBoundaryStringData + (q : Fin 4 -> CircleCoordinates) (hq : ProperBandQuadruple q) + (C₀ Cᵢ : BandCircle) (i : Fin 3) + (hC₀ : q 0 = C₀.1.1) (hCᵢ : q i.succ = Cᵢ.1.1) + (orientation : Bool) + (T₀ : ProtoTile) (h₀ : PartialOdometer) + (hO₀ : TileOdometer C₀.1.1 T₀ h₀) + (hpositive : 0 < Cᵢ.1.1.1) + (horientation : Cᵢ.1.1.1 = 1 -> UnitOccurrenceOrientation q i orientation) : + exists base Rminus Rplus : ProtoTile, + exists tiles : List ProtoTile, exists hseed : PartialOdometer, + exists pseed pouter : Real × Real, + BandPrototile Cᵢ.1.1 base /\ + Rminus ∈ RegularTileFamily base (TilingLattice Cᵢ) /\ + Rplus ∈ RegularTileFamily base (TilingLattice Cᵢ) /\ + TileOdometer Cᵢ.1.1 Rminus hseed /\ + PartialOdometerSlope hseed = some pseed /\ + PartialOdometerSlope h₀ = some pouter /\ + pseed + GaussianRealPoint + (-BandVectors.2 (q ((i + 1).succ)) (q i.succ)) = + pouter + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) - + BandVectors.2 (q 0) (q i.succ)) /\ + BoundaryString C₀ Cᵢ i orientation T₀ base Rminus Rplus tiles := by +-- BODY + have hparent : 0 < (q i.succ).1 := by + simpa only [hCᵢ] using hpositive + have hroot : 1 < (q 0).1 := ForwardBoundaryGeometry.hroot q hq Cᵢ i hparent + have houter : TileOdometer (q 0) T₀ h₀ := by + simpa only [hC₀] using hO₀ + obtain ⟨S, hs, hT₀, hsub, _, _, hcentroid, _, _, _, hslope⟩ := + TileOdometerReindexedDecomposition q hq T₀ h₀ hroot houter + let B := S i false + let g := hs i false + have hBodometer : TileOdometer Cᵢ.1.1 B g := by + simpa only [B, g, hCᵢ] using hsub i false + have hB : BandPrototile Cᵢ.1.1 B := + TileOdometerBandPrototile Cᵢ.1.1 B g hBodometer + obtain ⟨pouter, pseed, hpouter, hpseed, hpre, hpim⟩ := + (hslope i false).resolve_left (ne_of_gt hparent) + -- Rotate the recursion laws to the displayed parent occurrence. + have hcyclic : + BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + + BandVectors.1 (q i.succ) (q ((i + 2).succ)) + + BandVectors.1 (q ((i + 1).succ)) (q i.succ) = 0 ∧ + BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + + BandVectors.2 (q i.succ) (q ((i + 2).succ)) + + BandVectors.2 (q ((i + 1).succ)) (q i.succ) = 0 ∧ + BandVectors.1 (q i.succ) (q 0) = + BandVectors.1 (q i.succ) (q ((i + 2).succ)) - + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q ((i + 1).succ)) (q i.succ) ∧ + BandVectors.2 (q i.succ) (q 0) = + BandVectors.2 (q i.succ) (q ((i + 2).succ)) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q ((i + 1).succ)) (q i.succ) := + ForwardBoundaryGeometry.hcyclic q hq Cᵢ i hCᵢ orientation horientation hparent S + hs hBodometer hB pouter pseed hpseed hpre hpim + obtain ⟨hvsum, hasum, hvchild, hachild⟩ := hcyclic + obtain ⟨hvflip, haflip⟩ := (VectorRecursionLaws q hq.1).2.2.2.2 hq i + have hseedIdentity : + pseed + GaussianRealPoint (-BandVectors.2 (q ((i + 1).succ)) (q i.succ)) = + pouter + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ)) := + ForwardBoundaryGeometry.hseedIdentity q i pouter pseed hpre hpim hasum hachild haflip + let uminus := -BandVectors.1 (q ((i + 1).succ)) (q i.succ) + let uplus := (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q i.succ) (q ((i + 2).succ)) + let Rminus := TileTranslation B uminus + let Rplus := TileTranslation B uplus + obtain ⟨hvji, hvki⟩ := ParentVectorsInTilingLattice q hq i Cᵢ hCᵢ + have huminus : uminus ∈ TilingLattice Cᵢ := + (TilingLattice Cᵢ).neg_mem hvji + have htangent : BandTangency (q i.succ) (q ((i + 2).succ)) := ForwardBoundaryGeometry.htangent + q hq Cᵢ i hCᵢ orientation horientation hparent S hs hBodometer hB pouter pseed hpseed hpre + hpim hvsum hasum hvchild hachild hvflip haflip hseedIdentity hvji hvki huminus + have huplus : uplus ∈ TilingLattice Cᵢ := ForwardBoundaryGeometry.huplus q Cᵢ i hvki htangent + have hRminus : Rminus ∈ RegularTileFamily B (TilingLattice Cᵢ) := + ⟨uminus, huminus, rfl⟩ + have hRplus : Rplus ∈ RegularTileFamily B (TilingLattice Cᵢ) := + ⟨uplus, huplus, rfl⟩ + let hseed := PartialOdometerAffineTranslate g uminus 0 0 + have hseedO : TileOdometer Cᵢ.1.1 Rminus hseed := + TileOdometerAffineTranslation Cᵢ.1.1 B g uminus 0 0 hBodometer + have hseedSlope : PartialOdometerSlope hseed = some pseed := ForwardBoundaryGeometry.hseedSlope + q i hs pseed hpseed + -- Apply the centroid formula to the two literal translated records. + have hendpoints : + TileCentroid Rminus - TileCentroid T₀ = + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.1 (q i.succ) (q 0) - BandVectors.1 (q 0) (q i.succ)) ∧ + TileCentroid Rplus - TileCentroid T₀ = + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ)) := + ForwardBoundaryGeometry.hendpoints q i T₀ S hcentroid hvsum hvchild hvflip + obtain ⟨tiles, hstring⟩ := TileStringExists Cᵢ orientation B Rminus Rplus hB hRminus hRplus + refine ⟨B, Rminus, Rplus, tiles, hseed, pseed, pouter, + hB, hRminus, hRplus, hseedO, hseedSlope, hpouter, hseedIdentity, ?_⟩ + refine ⟨q, hq, hC₀, hCᵢ, ?_, horientation, hstring, hendpoints.1, hendpoints.2⟩ + simpa only [hC₀] using hT₀ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FourNeighborAdjacent.lean b/LeanPool/ApollonianSuperharmonic/FourNeighborAdjacent.lean new file mode 100644 index 0000000000..842be4409a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FourNeighborAdjacent.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeCell + +-- [TABLET NODE: FourNeighborAdjacent] + +/-! +# FourNeighborAdjacent + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Two lattice cells are *four-neighbor adjacent* when their lower-left +corners differ by one of $\pm1,\pm i$. Equivalently, their closed unit +squares share a complete unit side. +-/ +def FourNeighborAdjacent (x y : LatticeCell) : Prop := +-- BODY + y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FourNeighborConnected.lean b/LeanPool/ApollonianSuperharmonic/FourNeighborConnected.lean new file mode 100644 index 0000000000..cf820a495d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FourNeighborConnected.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent + +-- [TABLET NODE: FourNeighborConnected] + +/-! +# FourNeighborConnected + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A set of lattice cells is *four-neighbor connected* when it is +nonempty and every two of its cells can be joined by a finite list of cells +in the set, each consecutive pair sharing a complete unit side in the sense +of `FourNeighborAdjacent`. +-/ +def FourNeighborConnected (S : Set LatticeCell) : Prop := +-- BODY + S.Nonempty ∧ ∀ x ∈ S, ∀ y ∈ S, ∃ p : List LatticeCell, + p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ S) ∧ + ∀ a b : LatticeCell, ∀ l₁ l₂ : List LatticeCell, + p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FourNeighborLaplacian.lean b/LeanPool/ApollonianSuperharmonic/FourNeighborLaplacian.lean new file mode 100644 index 0000000000..c736addaca --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FourNeighborLaplacian.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction + +-- [TABLET NODE: FourNeighborLaplacian] + +/-! +# FourNeighborLaplacian + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For an integer lattice function $f$ and $x\in\mathbb Z[i]$, its +four-neighbor discrete Laplacian is +$$ + \Delta f(x)=f(x+1)+f(x-1)+f(x+i)+f(x-i)-4f(x) + =\sum_{y\sim x}(f(y)-f(x)). +$$ +-/ +def FourNeighborLaplacian (f : IntegerLatticeFunction) + (x : GaussianInt) : ℤ := +-- BODY + f (x + 1) + f (x - 1) + f (x + ⟨0, 1⟩) + f (x - ⟨0, 1⟩) - 4 * f x + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GaussianQuarterTurn.lean b/LeanPool/ApollonianSuperharmonic/GaussianQuarterTurn.lean new file mode 100644 index 0000000000..62c29a7120 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GaussianQuarterTurn.lean @@ -0,0 +1,33 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: GaussianQuarterTurn] + +/-! +# GaussianQuarterTurn + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The counterclockwise quarter-turn of the Gaussian-integer grid about the +origin is $q(a+bi)=-b+ai=iz$. +-/ +def GaussianQuarterTurn (z : GaussianInt) : GaussianInt := +-- BODY + ⟨-z.im, z.re⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GaussianRealPoint.lean b/LeanPool/ApollonianSuperharmonic/GaussianRealPoint.lean new file mode 100644 index 0000000000..80bae2a064 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GaussianRealPoint.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: GaussianRealPoint] + +/-! +# GaussianRealPoint + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The real point associated with $z=a+bi\in\mathbb Z[i]$ is +$[z]=(a,b)\in\mathbb R^2$. Multiplication by $i$ therefore acts as the +quarter-turn $(a,b)\mapsto(-b,a)$. +-/ +def GaussianRealPoint (z : GaussianInt) : Real × Real := +-- BODY + ((((z.re : Int) : Real)), (((z.im : Int) : Real))) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GaussianReflection.lean b/LeanPool/ApollonianSuperharmonic/GaussianReflection.lean new file mode 100644 index 0000000000..64ce8d0fc8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GaussianReflection.lean @@ -0,0 +1,33 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: GaussianReflection] + +/-! +# GaussianReflection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Reflection of the Gaussian-integer grid in the real axis is +$r(a+bi)=a-bi=\overline z$. +-/ +def GaussianReflection (z : GaussianInt) : GaussianInt := +-- BODY + ⟨z.re, -z.im⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GaussianTranslation.lean b/LeanPool/ApollonianSuperharmonic/GaussianTranslation.lean new file mode 100644 index 0000000000..99d7eae345 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GaussianTranslation.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: GaussianTranslation] + +/-! +# GaussianTranslation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a Gaussian integer $u$, translation by $u$ is the grid map +$\tau_u(z)=z+u$. It acts on cell basepoints, footprint vertices, and the +assigned anchor of an empty prototile by the same formula. +-/ +def GaussianTranslation (u z : GaussianInt) : GaussianInt := +-- BODY + z + u + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GlobalOdometerExtends.lean b/LeanPool/ApollonianSuperharmonic/GlobalOdometerExtends.lean new file mode 100644 index 0000000000..9ec1092cef --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GlobalOdometerExtends.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PartialOdometer + +-- [TABLET NODE: GlobalOdometerExtends] + +/-! +# GlobalOdometerExtends + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +An integer function $g$ on $\mathbb Z[i]$ *extends* a partial +odometer $h$, up to its irrelevant additive normalization, when there is +an integer $c$ such that $g(x)=h(x)+c$ at every point of the domain of +$h$. +-/ +def GlobalOdometerExtends (g : IntegerLatticeFunction) (h : PartialOdometer) : Prop := +-- BODY + ∃ c : ℤ, ∀ x, x ∈ h.domain → g x = h.value x + c + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GridCellCenter.lean b/LeanPool/ApollonianSuperharmonic/GridCellCenter.lean new file mode 100644 index 0000000000..4037cedb72 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GridCellCenter.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeCell + +-- [TABLET NODE: GridCellCenter] + +/-! +# GridCellCenter + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a lattice cell $q=(q_1,q_2)$, its center, viewed as a complex point, +is +$$ +q^*=q_1+\frac12+i\left(q_2+\frac12\right). +$$ +-/ +noncomputable def GridCellCenter (q : LatticeCell) : ℂ := +-- BODY + (((q.re : Int) : Real) + (1 / 2 : Real) : ℂ) + + (((q.im : Int) : Real) + (1 / 2 : Real) : ℂ) * Complex.I + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GridEdgeCarrier.lean b/LeanPool/ApollonianSuperharmonic/GridEdgeCarrier.lean new file mode 100644 index 0000000000..f7c49952ad --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GridEdgeCarrier.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint + +-- [TABLET NODE: GridEdgeCarrier] + +/-! +# GridEdgeCarrier + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a finite set $e$ of Gaussian lattice points, its +*grid-edge carrier* $\operatorname{GridEdgeCarrier}(e)$ is +$$ + \bigcup_{a\in e}\ \bigcup_{b\in e} + [\operatorname{GaussianRealPoint}(a),\operatorname{GaussianRealPoint}(b)]_{\rm ord}, +$$ +where $[r,s]_{\rm ord}$ is the unordered coordinate interval between two +points of $\mathbb R^2$. For the endpoints of a horizontal or vertical unit +grid edge, this is precisely the corresponding closed unit segment. +-/ +def GridEdgeCarrier (e : Finset GaussianInt) : Set (Real × Real) := +-- BODY + ⋃ x ∈ e, ⋃ y ∈ e, Set.uIcc (GaussianRealPoint x) (GaussianRealPoint y) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GridHorizontalLogLiftDelta.lean b/LeanPool/ApollonianSuperharmonic/GridHorizontalLogLiftDelta.lean new file mode 100644 index 0000000000..ec25d9153e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GridHorizontalLogLiftDelta.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GridCellCenter +public import LeanPool.ApollonianSuperharmonic.GridSegmentLogLiftDelta + +/-! +# GridHorizontalLogLiftDelta + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open Set + +noncomputable section + +-- [TABLET NODE: GridHorizontalLogLiftDelta] +theorem GridHorizontalLogLiftDelta (q a b : GaussianInt) + (him : a.im = b.im) + (L : Set.Icc (0 : Real) 1 → ℂ) (hL : Continuous L) + (hexp : ∀ t, Complex.exp (L t) = + (1 - (t : Real)) * ((a : ℂ) - GridCellCenter q) + + (t : Real) * ((b : ℂ) - GridCellCenter q)) : + L ⟨1, by norm_num⟩ - L ⟨0, by norm_num⟩ = + Complex.log ((b : ℂ) - GridCellCenter q) - + Complex.log ((a : ℂ) - GridCellCenter q) := by +-- BODY + apply GridSegmentLogLiftDelta _ _ _ L hL hexp + intro t + rw [Complex.mem_slitPlane_iff] + right + norm_num [GridCellCenter, Complex.mul_im] + intro hz + have hcast : ((a.im : Int) : Real) = (b.im : Int) := by exact_mod_cast him + have hcastC : (a : ℂ).im = (b : ℂ).im := by simpa using hcast + rw [← hcastC] at hz + have haC : (a : ℂ).im = ((a.im : Int) : Real) := by simp + have hqC : (q : ℂ).im = ((q.im : Int) : Real) := by simp + rw [haC, hqC] at hz + have heq : ((a.im : Int) : Real) - (q.im : Int) = 1 / 2 := by + linarith + have heq2 : (((2 * (a.im - q.im) : Int) : Real)) = 1 := by + push_cast + linarith + have : (2 * (a.im - q.im) : Int) = 1 := by exact_mod_cast heq2 + omega + +end + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndex.lean b/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndex.lean new file mode 100644 index 0000000000..3f825654f5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndex.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: GridRayCrossingIndex] + +/-! +# GridRayCrossingIndex + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $q$ be a lattice cell and let $p=[z_0,\ldots,z_{n-1}]$ be a list of +lattice vertices. For an ordered pair $(a,b)$ of lattice vertices, set +$$ + c_q(a,b)= + \begin{cases} + 1,&b=a+i,\quad \operatorname{Im}(a)=\operatorname{Im}(q), + \quad \operatorname{Re}(a)\leq \operatorname{Re}(q),\\ + -1,&b=a-i,\quad \operatorname{Im}(b)=\operatorname{Im}(q), + \quad \operatorname{Re}(a)\leq \operatorname{Re}(q),\\ + 0,&\text{otherwise.} + \end{cases} +$$ +If $p$ is nonempty, close it cyclically by the ordered pair +$(z_{n-1},z_0)$ and define the *signed grid-ray crossing index* by +$$ + \operatorname{gind}_q(p) + =\sum_{0\leq j step a b + | _, _ => 0 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexAdjacentCell.lean b/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexAdjacentCell.lean new file mode 100644 index 0000000000..92bf64ca6c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexAdjacentCell.lean @@ -0,0 +1,459 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndex + + +-- [TABLET NODE: GridRayCrossingIndexAdjacentCell] + +/-! +# GridRayCrossingIndexAdjacentCell + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace AdjacentCellCrossings + +private theorem open_edges_no_reverse {α : Type} + {p : List α} (hp : p.Nodup) {u v : α} + (huv : (u, v) ∈ p.zip p.tail) (hvu : (v, u) ∈ p.zip p.tail) : False := by + rw [List.mem_iff_getElem] at huv hvu + rcases huv with ⟨i, hi, huv⟩ + rcases hvu with ⟨j, hj, hvu⟩ + have hi' : i < p.tail.length := by + simpa [List.length_zip] using hi + have hj' : j < p.tail.length := by + simpa [List.length_zip] using hj + have hip : i + 1 < p.length := by + simp only [List.length_tail] at hi' + omega + have hjp : j + 1 < p.length := by + simp only [List.length_tail] at hj' + omega + rw [List.getElem_zip, List.getElem_tail] at huv hvu + injection huv with huv₁ huv₂ + injection hvu with hvu₁ hvu₂ + have hij : i + 1 = j := + (hp.getElem_inj_iff).mp (huv₂.trans hvu₁.symm) + have hji : j + 1 = i := + (hp.getElem_inj_iff).mp (hvu₂.trans huv₁.symm) + omega +private theorem open_head_last_not_edge {α : Type} + {p : List α} (hp : p.Nodup) (hlen : 3 ≤ p.length) {x y : α} + (hhead : p.head? = some x) (hlast : p.getLast? = some y) : + (x, y) ∉ p.zip p.tail := by + intro hxy + rw [List.mem_iff_getElem] at hxy + rcases hxy with ⟨i, hi, hxy⟩ + have hi' : i < p.tail.length := by + simpa [List.length_zip] using hi + have hip : i + 1 < p.length := by + simp only [List.length_tail] at hi' + omega + rw [List.getElem_zip, List.getElem_tail] at hxy + injection hxy with hix hiy + have hpne : p ≠ [] := by + intro hp0 + simp [hp0] at hlen + have hzero : 0 < p.length := by omega + have hx0 : p[0] = x := by + rw [← List.head_eq_getElem hpne] + simpa [List.head?_eq_some_head hpne] using hhead + have hyLast : p[p.length - 1] = y := by + rw [← List.getLast_eq_getElem hpne] + rw [List.getLast?_eq_getLast_of_ne_nil hpne] at hlast + exact Option.some.inj hlast + have hi0 : i = 0 := (hp.getElem_inj_iff).mp (hix.trans hx0.symm) + have hiLast : i + 1 = p.length - 1 := + (hp.getElem_inj_iff).mp (hiy.trans hyLast.symm) + omega +private theorem cyclic_edges_no_reverse {α : Type} + {p : List α} (hp : p.Nodup) (hlen : 3 ≤ p.length) {x y u v : α} + (hhead : p.head? = some x) (hlast : p.getLast? = some y) + (huv : (u, v) ∈ p.zip p.tail ∨ (u = y ∧ v = x)) + (hvu : (v, u) ∈ p.zip p.tail ∨ (v = y ∧ u = x)) : False := by + have hpne : p ≠ [] := by + intro hp0 + simp [hp0] at hlen + have hxy : x ≠ y := by + have hxhead : p.head hpne = x := by + rcases (List.head?_eq_some_iff.mp hhead) with ⟨ys, rfl⟩ + rfl + have hylast : p.getLast hpne = y := by + rw [List.getLast?_eq_getLast_of_ne_nil hpne] at hlast + exact Option.some.inj hlast + intro h + have heq : p.head hpne = p.getLast hpne := by + rw [hxhead, hylast, h] + rcases (List.Nodup.head_eq_getLast_iff hpne hp).mp heq with ⟨z, rfl⟩ + simp at hlen + rcases huv with huv | ⟨rfl, rfl⟩ + · rcases hvu with hvu | ⟨rfl, rfl⟩ + · exact open_edges_no_reverse hp huv hvu + · exact open_head_last_not_edge hp hlen hhead hlast huv + · rcases hvu with hvu | h + · exact open_head_last_not_edge hp hlen hhead hlast hvu + · exact hxy h.1 +private theorem open_last_head_not_edge {α : Type} + {p : List α} (hp : p.Nodup) (hlen : 2 ≤ p.length) {x y : α} + (hhead : p.head? = some x) (hlast : p.getLast? = some y) : + (y, x) ∉ p.zip p.tail := by + intro hyx + rw [List.mem_iff_getElem] at hyx + rcases hyx with ⟨i, hi, hyx⟩ + have hi' : i < p.tail.length := by + simpa [List.length_zip] using hi + have hip : i + 1 < p.length := by + simp only [List.length_tail] at hi' + omega + rw [List.getElem_zip, List.getElem_tail] at hyx + injection hyx with hiy hix + have hpne : p ≠ [] := by + intro hp0 + simp [hp0] at hlen + have hzero : 0 < p.length := by omega + have hx0 : p[0] = x := by + rw [← List.head_eq_getElem hpne] + simpa [List.head?_eq_some_head hpne] using hhead + have hyLast : p[p.length - 1] = y := by + rw [← List.getLast_eq_getElem hpne] + rw [List.getLast?_eq_getLast_of_ne_nil hpne] at hlast + exact Option.some.inj hlast + have hiLast : i = p.length - 1 := + (hp.getElem_inj_iff).mp (hiy.trans hyLast.symm) + omega +private theorem open_edges_nodup {α : Type} + {p : List α} (hp : p.Nodup) : (p.zip p.tail).Nodup := by + rw [List.nodup_iff_injective_getElem] + intro i j hij + have hfirst := congrArg Prod.fst hij + simp only [List.getElem_zip] at hfirst + apply Fin.ext + exact (hp.getElem_inj_iff).mp hfirst +private theorem cyclic_edge_list_nodup {α : Type} + {p : List α} (hp : p.Nodup) (hlen : 3 ≤ p.length) {x y : α} + (hhead : p.head? = some x) (hlast : p.getLast? = some y) : + ((p.zip p.tail) ++ [(y, x)]).Nodup := by + rw [List.nodup_append] + refine ⟨open_edges_nodup hp, by simp, ?_⟩ + intro a ha b hb hab + have hbEq : b = (y, x) := by simpa using hb + apply open_last_head_not_edge hp (by omega) hhead hlast + rw [← hbEq, ← hab] + exact ha +private theorem signed_target_sum_formula {α : Type} [DecidableEq α] + (edges : List (α × α)) (he : edges.Nodup) (u v : α) (huv : u ≠ v) : + (edges.map (fun e => if e = (u, v) then (1 : Int) + else if e = (v, u) then -1 else 0)).sum = + (if (u, v) ∈ edges then 1 else 0) + + (if (v, u) ∈ edges then -1 else 0) := by + induction edges with + | nil => simp + | cons e edges ih => + simp only [List.nodup_cons] at he + rw [List.map_cons, List.sum_cons, ih he.2] + by_cases heu : e = (u, v) + · subst e + simp [he.1, huv] + · by_cases hev : e = (v, u) + · subst e + simp [he.1, heu, huv, add_comm] + · have heu' : (u, v) ≠ e := Ne.symm heu + have hev' : (v, u) ≠ e := Ne.symm hev + simp [heu, hev, heu', hev'] +private theorem gaussian_eq_iff (a b : GaussianInt) : a = b ↔ a.re = b.re ∧ a.im = b.im := by + constructor + · rintro rfl + simp + · rintro ⟨hr, hi⟩ + apply Zsqrtd.ext <;> assumption +private theorem east_step_delta (q a b : GaussianInt) (hab : FourNeighborAdjacent a b) : + (if b = a + ⟨0, 1⟩ ∧ a.im = (q + 1).im ∧ a.re ≤ (q + 1).re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = (q + 1).im ∧ a.re ≤ (q + 1).re then -1 + else 0) - + (if b = a + ⟨0, 1⟩ ∧ a.im = q.im ∧ a.re ≤ q.re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = q.im ∧ a.re ≤ q.re then -1 + else 0) = + (if (a, b) = (q + 1, q + 1 + ⟨0, 1⟩) then 1 + else if (a, b) = (q + 1 + ⟨0, 1⟩, q + 1) then -1 else 0) := by + rcases hab with (rfl | rfl | rfl | rfl) <;> + simp [gaussian_eq_iff] <;> omega +private def NorthStepDelta (q a b : GaussianInt) : Prop := + (if b = a + ⟨0, 1⟩ ∧ a.im = (q + ⟨0, 1⟩).im ∧ + a.re ≤ (q + ⟨0, 1⟩).re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = (q + ⟨0, 1⟩).im ∧ + a.re ≤ (q + ⟨0, 1⟩).re then -1 + else 0) - + (if b = a + ⟨0, 1⟩ ∧ a.im = q.im ∧ a.re ≤ q.re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = q.im ∧ a.re ≤ q.re then -1 + else 0) = + (if (a, b) = (q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) then 1 + else if (a, b) = (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) then -1 else 0) + + (if a.im = q.im + 1 ∧ a.re ≤ q.re then 1 else 0) - + (if b.im = q.im + 1 ∧ b.re ≤ q.re then 1 else 0) + +private theorem northDeltaEast (q a : GaussianInt) : + NorthStepDelta q a (a + 1) := by + simp [NorthStepDelta, gaussian_eq_iff]; omega + +private theorem northDeltaWest (q a : GaussianInt) : + NorthStepDelta q a (a - 1) := by + simp [NorthStepDelta, gaussian_eq_iff]; omega + +private theorem northDeltaNorth (q a : GaussianInt) : + NorthStepDelta q a (a + ⟨0, 1⟩) := by + simp [NorthStepDelta, gaussian_eq_iff]; omega + +private theorem northDeltaSouth (q a : GaussianInt) : + NorthStepDelta q a (a - ⟨0, 1⟩) := by + simp [NorthStepDelta, gaussian_eq_iff]; omega + +private theorem north_step_delta (q a b : GaussianInt) (hab : FourNeighborAdjacent a b) : + (if b = a + ⟨0, 1⟩ ∧ a.im = (q + ⟨0, 1⟩).im ∧ + a.re ≤ (q + ⟨0, 1⟩).re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = (q + ⟨0, 1⟩).im ∧ + a.re ≤ (q + ⟨0, 1⟩).re then -1 + else 0) - + (if b = a + ⟨0, 1⟩ ∧ a.im = q.im ∧ a.re ≤ q.re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = q.im ∧ a.re ≤ q.re then -1 + else 0) = + (if (a, b) = (q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) then 1 + else if (a, b) = (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) then -1 else 0) + + (if a.im = q.im + 1 ∧ a.re ≤ q.re then 1 else 0) - + (if b.im = q.im + 1 ∧ b.re ≤ q.re then 1 else 0) := by + rcases hab with rfl | rfl | rfl | rfl + · exact northDeltaEast q a + · exact northDeltaWest q a + · exact northDeltaNorth q a + · exact northDeltaSouth q a +private theorem zipWith_eq_map_zip {α β γ : Type} (f : α → β → γ) + (l : List α) (r : List β) : + List.zipWith f l r = (l.zip r).map (fun e => f e.1 e.2) := by + induction l generalizing r with + | nil => simp + | cons a l ih => + cases r <;> simp [ih] +private theorem map_sub_sum (edges : List (GaussianInt × GaussianInt)) + (f g : GaussianInt → GaussianInt → Int) : + (edges.map (fun e => f e.1 e.2 - g e.1 e.2)).sum = + (edges.map (fun e => f e.1 e.2)).sum - + (edges.map (fun e => g e.1 e.2)).sum := by + induction edges with + | nil => simp + | cons e edges ih => + simp only [List.map_cons, List.sum_cons, ih] + omega +private theorem cyclic_sum_sub + (p : List GaussianInt) (x y : GaussianInt) + (f g h : GaussianInt → GaussianInt → Int) + (hedge : ∀ a b, (a, b) ∈ p.zip p.tail ∨ (a = y ∧ b = x) → + f a b - g a b = h a b) : + ((List.zipWith f p p.tail).sum + f y x) - + ((List.zipWith g p p.tail).sum + g y x) = + (((p.zip p.tail) ++ [(y, x)]).map (fun e => h e.1 e.2)).sum := by + rw [zipWith_eq_map_zip, zipWith_eq_map_zip, List.map_append, + List.sum_append] + simp only [List.map_singleton, List.sum_singleton] + have hsub := map_sub_sum (p.zip p.tail) f g + have hopen : (p.zip p.tail).map (fun e => f e.1 e.2 - g e.1 e.2) = + (p.zip p.tail).map (fun e => h e.1 e.2) := by + apply List.map_congr_left + intro e he + exact hedge e.1 e.2 (Or.inl he) + have hclose := hedge y x (Or.inr ⟨rfl, rfl⟩) + rw [hopen] at hsub + omega +private theorem zip_potential_sum (p : List GaussianInt) (x y : GaussianInt) + (hhead : p.head? = some x) (hlast : p.getLast? = some y) + (potential : GaussianInt → Int) : + (List.zipWith (fun a b => potential a - potential b) p p.tail).sum = + potential x - potential y := by + induction p generalizing x y with + | nil => simp at hhead + | cons a p ih => + cases p with + | nil => + simp at hhead hlast + subst x + subst y + simp + | cons b p => + simp only [List.head?_cons, Option.some.injEq] at hhead + subst x + have htailLast : (b :: p).getLast? = some y := by + simpa using hlast + have hih := ih b y rfl htailLast + simp only [List.tail_cons] at hih + simp only [List.tail_cons, List.zipWith_cons_cons, List.sum_cons] + rw [hih] + omega +private theorem map_augmented_sum (edges : List (GaussianInt × GaussianInt)) + (sign : GaussianInt → GaussianInt → Int) + (potential : GaussianInt → Int) : + (edges.map (fun e => sign e.1 e.2 + potential e.1 - potential e.2)).sum = + (edges.map (fun e => sign e.1 e.2)).sum + + (edges.map (fun e => potential e.1 - potential e.2)).sum := by + induction edges with + | nil => simp + | cons e edges ih => + simp only [List.map_cons, List.sum_cons, ih] + omega + +end AdjacentCellCrossings + +open AdjacentCellCrossings + +theorem GridRayCrossingIndexAdjacentCell + (p : List GaussianInt) (x y : GaussianInt) + (hhead : p.head? = some x) (hlast : p.getLast? = some y) + (hnodup : p.Nodup) (hlen : 3 ≤ p.length) + (hadj : ∀ a b, (a, b) ∈ p.zip p.tail → FourNeighborAdjacent a b) + (hclose : FourNeighborAdjacent y x) : + let cyclicEdges := (p.zip p.tail) ++ [(y, x)] + ∀ q : LatticeCell, + (((q + 1, q + 1 + ⟨0, 1⟩) ∉ cyclicEdges ∧ + (q + 1 + ⟨0, 1⟩, q + 1) ∉ cyclicEdges) → + GridRayCrossingIndex (q + 1) p = GridRayCrossingIndex q p) ∧ + (((q + 1, q + 1 + ⟨0, 1⟩) ∈ cyclicEdges ∨ + (q + 1 + ⟨0, 1⟩, q + 1) ∈ cyclicEdges) → + Int.natAbs (GridRayCrossingIndex (q + 1) p - + GridRayCrossingIndex q p) = 1) ∧ + (((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∉ cyclicEdges ∧ + (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) ∉ cyclicEdges) → + GridRayCrossingIndex (q + ⟨0, 1⟩) p = + GridRayCrossingIndex q p) ∧ + (((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∈ cyclicEdges ∨ + (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) ∈ cyclicEdges) → + Int.natAbs (GridRayCrossingIndex (q + ⟨0, 1⟩) p - + GridRayCrossingIndex q p) = 1) := by +-- BODY + dsimp only + intro q + let edges := (p.zip p.tail) ++ [(y, x)] + have hedges : edges.Nodup := cyclic_edge_list_nodup hnodup hlen hhead hlast + have edge_adj : ∀ a b, (a, b) ∈ p.zip p.tail ∨ (a = y ∧ b = x) → + FourNeighborAdjacent a b := by + intro a b hab + rcases hab with hab | ⟨rfl, rfl⟩ + · exact hadj a b hab + · exact hclose + let eastU : GaussianInt := q + 1 + let eastV : GaussianInt := q + 1 + ⟨0, 1⟩ + let northU : GaussianInt := q + 1 + ⟨0, 1⟩ + let northV : GaussianInt := q + ⟨0, 1⟩ + have east_ne : eastU ≠ eastV := by + intro h + apply_fun Zsqrtd.im at h + simp [eastU, eastV] at h + have north_ne : northU ≠ northV := by + intro h + apply_fun Zsqrtd.re at h + simp [northU, northV] at h + let eastSign : GaussianInt → GaussianInt → Int := fun a b => + if (a, b) = (eastU, eastV) then 1 + else if (a, b) = (eastV, eastU) then -1 else 0 + let northSign : GaussianInt → GaussianInt → Int := fun a b => + if (a, b) = (northU, northV) then 1 + else if (a, b) = (northV, northU) then -1 else 0 + have east_delta : GridRayCrossingIndex (q + 1) p - + GridRayCrossingIndex q p = + (edges.map (fun e => eastSign e.1 e.2)).sum := by + rw [GridRayCrossingIndex, GridRayCrossingIndex] + dsimp only + rw [hlast, hhead] + apply cyclic_sum_sub + intro a b hab + simpa [eastSign, eastU, eastV] using east_step_delta q a b (edge_adj a b hab) + have north_delta : GridRayCrossingIndex (q + ⟨0, 1⟩) p - + GridRayCrossingIndex q p = + (edges.map (fun e => northSign e.1 e.2)).sum := by + rw [GridRayCrossingIndex, GridRayCrossingIndex] + dsimp only + rw [hlast, hhead] + let potential : GaussianInt → Int := fun a => + if a.im = q.im + 1 ∧ a.re ≤ q.re then 1 else 0 + let augmented : GaussianInt → GaussianInt → Int := fun a b => + northSign a b + potential a - potential b + calc + _ = (edges.map (fun e => augmented e.1 e.2)).sum := by + apply cyclic_sum_sub + intro a b hab + simpa [augmented, northSign, northU, northV, potential] using + north_step_delta q a b (edge_adj a b hab) + _ = (edges.map (fun e => northSign e.1 e.2)).sum := by + rw [show (edges.map (fun e => augmented e.1 e.2)).sum = + (edges.map (fun e => northSign e.1 e.2)).sum + + (edges.map (fun e => potential e.1 - potential e.2)).sum by + simpa [augmented] using map_augmented_sum edges northSign potential] + have hpotOpen := zip_potential_sum p x y hhead hlast potential + rw [zipWith_eq_map_zip] at hpotOpen + have hpot : (edges.map (fun e => potential e.1 - potential e.2)).sum = 0 := by + simp only [edges, List.map_append, List.sum_append, List.map_singleton, + List.sum_singleton] + rw [hpotOpen] + omega + rw [hpot, add_zero] + have east_formula := signed_target_sum_formula edges hedges eastU eastV east_ne + have north_formula := signed_target_sum_formula edges hedges northU northV north_ne + have east_exclusive : ¬((eastU, eastV) ∈ edges ∧ (eastV, eastU) ∈ edges) := by + rintro ⟨huv, hvu⟩ + simp only [edges, List.mem_append, List.mem_singleton] at huv hvu + apply cyclic_edges_no_reverse hnodup hlen hhead hlast + · rcases huv with huv | huv + · exact Or.inl huv + · exact Or.inr (Prod.mk.inj huv) + · rcases hvu with hvu | hvu + · exact Or.inl hvu + · exact Or.inr (Prod.mk.inj hvu) + have north_exclusive : ¬((northU, northV) ∈ edges ∧ (northV, northU) ∈ edges) := by + rintro ⟨huv, hvu⟩ + simp only [edges, List.mem_append, List.mem_singleton] at huv hvu + apply cyclic_edges_no_reverse hnodup hlen hhead hlast + · rcases huv with huv | huv + · exact Or.inl huv + · exact Or.inr (Prod.mk.inj huv) + · rcases hvu with hvu | hvu + · exact Or.inl hvu + · exact Or.inr (Prod.mk.inj hvu) + constructor + · rintro ⟨huv, hvu⟩ + have hz : GridRayCrossingIndex (q + 1) p - GridRayCrossingIndex q p = 0 := by + rw [east_delta, east_formula] + simp [edges, eastU, eastV, huv, hvu] + omega + constructor + · intro hoccur + rw [east_delta, east_formula] + rcases hoccur with huv | hvu + · have : (eastV, eastU) ∉ edges := fun h => east_exclusive ⟨huv, h⟩ + simp [edges, eastU, eastV, huv, this] + · have : (eastU, eastV) ∉ edges := fun h => east_exclusive ⟨h, hvu⟩ + simp [edges, eastU, eastV, hvu, this] + constructor + · rintro ⟨huv, hvu⟩ + have hz : GridRayCrossingIndex (q + ⟨0, 1⟩) p - + GridRayCrossingIndex q p = 0 := by + rw [north_delta, north_formula] + simp [edges, northU, northV, huv, hvu] + omega + · intro hoccur + rw [north_delta, north_formula] + rcases hoccur with huv | hvu + · have : (northV, northU) ∉ edges := fun h => north_exclusive ⟨huv, h⟩ + simp [edges, northU, northV, huv, this] + · have : (northU, northV) ∉ edges := fun h => north_exclusive ⟨h, hvu⟩ + simp [edges, northU, northV, hvu, this] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexZeroOfEdgeLifts.lean b/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexZeroOfEdgeLifts.lean new file mode 100644 index 0000000000..30778fab9b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexZeroOfEdgeLifts.lean @@ -0,0 +1,149 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndex +public import LeanPool.ApollonianSuperharmonic.GridStepLogLiftDelta + +/-! +# GridRayCrossingIndexZeroOfEdgeLifts + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open Set + +noncomputable section + +-- [TABLET NODE: GridRayCrossingIndexZeroOfEdgeLifts] +theorem GridRayCrossingIndexZeroOfEdgeLifts + (q : LatticeCell) (p : List GaussianInt) (x y : GaussianInt) + (F : GaussianInt → ℂ) + (hhead : p.head? = some x) (hlast : p.getLast? = some y) + (hadj : ∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) + (hclose : FourNeighborAdjacent y x) + (hlift : ∀ a b : GaussianInt, + ((∃ l₁ l₂ : List GaussianInt, p = l₁ ++ a :: b :: l₂) ∨ + (a = y ∧ b = x)) → + ∃ L : Set.Icc (0 : Real) 1 → ℂ, + Continuous L ∧ L ⟨0, by norm_num⟩ = F a ∧ L ⟨1, by norm_num⟩ = F b ∧ + ∀ t, Complex.exp (L t) = + (1 - (t : Real)) * ((a : ℂ) - GridCellCenter q) + + (t : Real) * ((b : ℂ) - GridCellCenter q)) : + GridRayCrossingIndex q p = 0 := by +-- BODY + let step : GaussianInt → GaussianInt → Int := fun a b ↦ + if b = a + ⟨0, 1⟩ ∧ a.im = q.im ∧ a.re ≤ q.re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = q.im ∧ a.re ≤ q.re then -1 + else 0 + let C : ℂ := 2 * Real.pi * Complex.I + have hstep (a b : GaussianInt) + (hoccur : (∃ l₁ l₂ : List GaussianInt, p = l₁ ++ a :: b :: l₂) ∨ + (a = y ∧ b = x)) + (hab : FourNeighborAdjacent a b) : + F b - F a = + Complex.log ((b : ℂ) - GridCellCenter q) - + Complex.log ((a : ℂ) - GridCellCenter q) - C * step a b := by + rcases hlift a b hoccur with ⟨L, hL, hL0, hL1, hexp⟩ + have h := GridStepLogLiftDelta q a b hab L hL hexp + rw [hL0, hL1] at h + exact h + have chain : ∀ (l : List GaussianInt), + (∃ pre, p = pre ++ l) → + ∀ a b, l.head? = some a → l.getLast? = some b → + F b - F a = + Complex.log ((b : ℂ) - GridCellCenter q) - + Complex.log ((a : ℂ) - GridCellCenter q) - + C * (List.zipWith step l l.tail).sum := by + intro l hsuffix + induction l with + | nil => simp + | cons a l ih => + cases l with + | nil => + intro u v hu hv + simp at hu hv + subst u + subst v + simp + | cons b l => + intro u v hu hv + simp only [List.head?_cons, Option.some.injEq] at hu + subst u + have hbhead : (b :: l).head? = some b := rfl + have hsuffix' : ∃ pre, p = pre ++ (b :: l) := by + rcases hsuffix with ⟨pre, hpre⟩ + refine ⟨pre ++ [a], ?_⟩ + rw [hpre] + simp [List.append_assoc] + have hchain := ih hsuffix' b v hbhead hv + have hoccur : ∃ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ := by + rcases hsuffix with ⟨pre, hpre⟩ + exact ⟨pre, l, hpre⟩ + have hab := hadj a b hoccur.choose hoccur.choose_spec.choose + hoccur.choose_spec.choose_spec + have habstep := hstep a b (Or.inl hoccur) hab + simp only [List.tail_cons, List.zipWith_cons_cons, List.sum_cons] + simp only [List.tail_cons] at hchain + rw [Int.cast_add] + linear_combination hchain + habstep + have hpsuffix : ∃ pre, p = pre ++ p := ⟨[], by simp⟩ + have hchain := chain p hpsuffix x y hhead hlast + have hcloseStep := hstep y x (Or.inr ⟨rfl, rfl⟩) hclose + have htel : (F y - F x) + (F x - F y) = + (Complex.log ((y : ℂ) - GridCellCenter q) - + Complex.log ((x : ℂ) - GridCellCenter q) - + C * ((List.zipWith step p p.tail).sum : ℂ)) + + (Complex.log ((x : ℂ) - GridCellCenter q) - + Complex.log ((y : ℂ) - GridCellCenter q) - + C * (step y x : ℂ)) := + congrArg₂ (fun u v : ℂ ↦ u + v) hchain hcloseStep + have hsum : C * ((List.zipWith step p p.tail).sum + step y x) = 0 := by + have hz : C * ((List.zipWith step p p.tail).sum : ℂ) + + C * (step y x : ℂ) = 0 := by + have hl : (F y - F x) + (F x - F y) = 0 := by ring + have hr : + (Complex.log ((y : ℂ) - GridCellCenter q) - + Complex.log ((x : ℂ) - GridCellCenter q) - + C * ((List.zipWith step p p.tail).sum : ℂ)) + + (Complex.log ((x : ℂ) - GridCellCenter q) - + Complex.log ((y : ℂ) - GridCellCenter q) - + C * (step y x : ℂ)) = + -(C * ((List.zipWith step p p.tail).sum : ℂ) + + C * (step y x : ℂ)) := by ring + rw [hl, hr] at htel + exact neg_eq_zero.mp htel.symm + rw [mul_add] + exact hz + have hC : C ≠ 0 := by + dsimp [C] + exact mul_ne_zero + (mul_ne_zero (by norm_num) (Complex.ofReal_ne_zero.mpr Real.pi_ne_zero)) + Complex.I_ne_zero + have hcast' : ((List.zipWith step p p.tail).sum : ℂ) + + (step y x : ℂ) = 0 := by + exact (mul_eq_zero.mp hsum).resolve_left hC + have hcast : (((List.zipWith step p p.tail).sum + step y x : Int) : ℂ) = 0 := by + simpa only [Int.cast_add, Int.cast_zero] using hcast' + have hint : (List.zipWith step p p.tail).sum + step y x = 0 := by + exact_mod_cast hcast + rw [GridRayCrossingIndex] + dsimp only + rw [hlast, hhead] + exact hint + +end + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GridSegmentLogLiftDelta.lean b/LeanPool/ApollonianSuperharmonic/GridSegmentLogLiftDelta.lean new file mode 100644 index 0000000000..f2ccbe5bb5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GridSegmentLogLiftDelta.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Complex.CoveringMap +public import Mathlib.Analysis.SpecialFunctions.Complex.Arg +public import Mathlib.Analysis.Convex.Contractible +public import Mathlib.Topology.Algebra.Order.Support +public import Mathlib.Topology.Algebra.Module.LocallyConvex +public import Mathlib.Topology.Homotopy.Lifting + +/-! +# GridSegmentLogLiftDelta + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open Set + +noncomputable section + +-- [TABLET NODE: GridSegmentLogLiftDelta] +theorem GridSegmentLogLiftDelta + (z0 z1 : ℂ) + (hz : ∀ t : Set.Icc (0 : Real) 1, + (1 - (t : Real)) * z0 + (t : Real) * z1 ∈ Complex.slitPlane) + (L : Set.Icc (0 : Real) 1 → ℂ) (hL : Continuous L) + (hexp : ∀ t, Complex.exp (L t) = + (1 - (t : Real)) * z0 + (t : Real) * z1) : + L ⟨1, by norm_num⟩ - L ⟨0, by norm_num⟩ = + Complex.log z1 - Complex.log z0 := by +-- BODY + let : ContractibleSpace (Set.Icc (0 : Real) 1) := + (convex_Icc 0 1).contractibleSpace ⟨0, by norm_num⟩ + let : LocallyPathConnectedSpace (Set.Icc (0 : Real) 1) := + (convex_Icc 0 1).locallyPathConnectedSpace + let z : Set.Icc (0 : Real) 1 → ℂ := fun t ↦ + (1 - (t : Real)) * z0 + (t : Real) * z1 + have hzcont : Continuous z := by + dsimp [z] + fun_prop + have hz0 : z0 ≠ 0 := + Complex.slitPlane_ne_zero (by simpa [z] using hz ⟨0, by norm_num⟩) + let c : ℂ := L ⟨0, by norm_num⟩ - Complex.log z0 + have hexpc : Complex.exp c = 1 := by + rw [Complex.exp_sub, hexp ⟨0, by norm_num⟩] + rw [show (1 - ((⟨0, by norm_num⟩ : Set.Icc (0 : Real) 1) : Real)) * z0 + + ((⟨0, by norm_num⟩ : Set.Icc (0 : Real) 1) : Real) * z1 = z0 by norm_num, + Complex.exp_log hz0] + exact div_self hz0 + let K : Set.Icc (0 : Real) 1 → ℂ := fun t ↦ Complex.log (z t) + c + have hK : Continuous K := by + dsimp [K] + have hlog : Continuous (fun t ↦ Complex.log (z t)) := hzcont.clog hz + exact hlog.add continuous_const + have hK0 : K ⟨0, by norm_num⟩ = L ⟨0, by norm_num⟩ := by + simp [K, c, z] + have hKexp : ∀ t, Complex.exp (K t) = z t := by + intro t + rw [show K t = Complex.log (z t) + c by rfl, Complex.exp_add, + Complex.exp_log (Complex.slitPlane_ne_zero (hz t)), hexpc, mul_one] + have hLK : L = K := by + rcases Complex.isCoveringMapOn_exp.existsUnique_continuousMap_lifts + ⟨z, hzcont⟩ (a₀ := ⟨0, by norm_num⟩) + (e₀ := L ⟨0, by norm_num⟩) (by simp [hexp, z]) + (fun t ↦ by simpa using Complex.slitPlane_ne_zero (hz t)) with + ⟨_, _, hunique⟩ + have hLu := hunique ⟨L, hL⟩ ⟨rfl, by ext t; exact hexp t⟩ + have hKu := hunique ⟨K, hK⟩ ⟨hK0, by ext t; exact hKexp t⟩ + exact congrArg DFunLike.coe (hLu.trans hKu.symm) + rw [hLK] + simp [K, c, z] + ring + +end + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GridStepLogLiftDelta.lean b/LeanPool/ApollonianSuperharmonic/GridStepLogLiftDelta.lean new file mode 100644 index 0000000000..0f91408b19 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GridStepLogLiftDelta.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.GridHorizontalLogLiftDelta +public import LeanPool.ApollonianSuperharmonic.GridVerticalDownLogLiftDelta +public import LeanPool.ApollonianSuperharmonic.GridVerticalUpLogLiftDelta + +/-! +# GridStepLogLiftDelta + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open Set + +noncomputable section + +-- [TABLET NODE: GridStepLogLiftDelta] +theorem GridStepLogLiftDelta (q a b : GaussianInt) + (hab : FourNeighborAdjacent a b) + (L : Set.Icc (0 : Real) 1 → ℂ) (hL : Continuous L) + (hexp : ∀ t, Complex.exp (L t) = + (1 - (t : Real)) * ((a : ℂ) - GridCellCenter q) + + (t : Real) * ((b : ℂ) - GridCellCenter q)) : + L ⟨1, by norm_num⟩ - L ⟨0, by norm_num⟩ = + Complex.log ((b : ℂ) - GridCellCenter q) - + Complex.log ((a : ℂ) - GridCellCenter q) - + (2 * Real.pi * Complex.I) * + (if b = a + ⟨0, 1⟩ ∧ a.im = q.im ∧ a.re ≤ q.re then (1 : Int) + else if b = a - ⟨0, 1⟩ ∧ b.im = q.im ∧ a.re ≤ q.re then (-1 : Int) + else 0) := by +-- BODY + rcases hab with rfl | rfl | rfl | rfl + · have h := GridHorizontalLogLiftDelta q a (a + 1) (by simp) L hL hexp + have hneU : a + 1 ≠ a + ⟨0, 1⟩ := by + intro he + have hh := congrArg Zsqrtd.im he + norm_num at hh + have hneD : a + 1 ≠ a - ⟨0, 1⟩ := by + intro he + have hh := congrArg Zsqrtd.im he + simp at hh + omega + simpa [hneU, hneD] using h + · have h := GridHorizontalLogLiftDelta q a (a - 1) (by simp) L hL hexp + have hneU : a - 1 ≠ a + ⟨0, 1⟩ := by + intro he + have hh := congrArg Zsqrtd.im he + norm_num at hh + have hneD : a - 1 ≠ a - ⟨0, 1⟩ := by + intro he + have hh := congrArg Zsqrtd.im he + simp at hh + omega + simpa [hneU, hneD] using h + · have h := GridVerticalUpLogLiftDelta q a L hL hexp + have hneD : a + ⟨0, 1⟩ ≠ a - ⟨0, 1⟩ := by + intro he + have hh := congrArg Zsqrtd.im he + simp at hh + omega + by_cases hc : a.im = q.im ∧ a.re ≤ q.re + · simpa [hc, hneD] using h + · simpa [hc, hneD] using h + · have h := GridVerticalDownLogLiftDelta q a L hL hexp + have hneU : a - ⟨0, 1⟩ ≠ a + ⟨0, 1⟩ := by + intro he + have hh := congrArg Zsqrtd.im he + simp at hh + omega + rw [ite_eq_right (by intro hc; exact hneU hc.1)] + simp only [true_and] + by_cases hc : a.im - 1 = q.im ∧ a.re ≤ q.re + · simp? [hc] at h ⊢ + convert h using 1 + · simpa [hc] using h + +end + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GridVerticalDownLogLiftDelta.lean b/LeanPool/ApollonianSuperharmonic/GridVerticalDownLogLiftDelta.lean new file mode 100644 index 0000000000..44d11a94f7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GridVerticalDownLogLiftDelta.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.GridCellCenter +public import LeanPool.ApollonianSuperharmonic.GridSegmentLogLiftDelta +public import Mathlib.Analysis.SpecialFunctions.Complex.Arg + +/-! +# GridVerticalDownLogLiftDelta + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open Set + +noncomputable section + +-- [TABLET NODE: GridVerticalDownLogLiftDelta] +theorem GridVerticalDownLogLiftDelta (q a : GaussianInt) + (L : Set.Icc (0 : Real) 1 → ℂ) (hL : Continuous L) + (hexp : ∀ t, Complex.exp (L t) = + (1 - (t : Real)) * ((a : ℂ) - GridCellCenter q) + + (t : Real) * ((a - ⟨0, 1⟩ : GaussianInt) - GridCellCenter q)) : + L ⟨1, by norm_num⟩ - L ⟨0, by norm_num⟩ = + Complex.log ((a - ⟨0, 1⟩ : GaussianInt) - GridCellCenter q) - + Complex.log ((a : ℂ) - GridCellCenter q) + + (if (a - ⟨0, 1⟩).im = q.im ∧ a.re ≤ q.re then + 2 * Real.pi * Complex.I else 0) := by +-- BODY + have neg_log_delta_down (z0 z1 : ℂ) + (hre0 : z0.re < 0) (him0 : 0 < z0.im) + (hre1 : z1.re < 0) (him1 : z1.im < 0) + (hnorm : ‖z1‖ = ‖z0‖) : + Complex.log (-z1) - Complex.log (-z0) = + Complex.log z1 - Complex.log z0 + 2 * Real.pi * Complex.I := by + apply Complex.ext + · simp [Complex.log_re, hnorm] + · simp only [Complex.log_im, Complex.sub_im, + ] + rw [Complex.arg_neg_eq_arg_add_pi_of_im_neg him1, + Complex.arg_neg_eq_arg_sub_pi_of_im_pos him0] + norm_num [Complex.log_im] + ring + by_cases hcross : (a - ⟨0, 1⟩).im = q.im ∧ a.re ≤ q.re + · rw [ite_eq_left hcross] + let z0 := (a : ℂ) - GridCellCenter q + let z1 := (a - ⟨0, 1⟩ : GaussianInt) - GridCellCenter q + let M : Set.Icc (0 : Real) 1 → ℂ := fun t ↦ L t - Real.pi * Complex.I + have hM : Continuous M := hL.sub continuous_const + have hMexp : ∀ t, Complex.exp (M t) = + (1 - (t : Real)) * (-z0) + (t : Real) * (-z1) := by + intro t + rw [show M t = L t - Real.pi * Complex.I by rfl, + Complex.exp_sub_pi_mul_I, hexp] + dsimp [z0, z1] + ring + have hslit : ∀ t : Set.Icc (0 : Real) 1, + (1 - (t : Real)) * (-z0) + (t : Real) * (-z1) ∈ Complex.slitPlane := by + intro t + rw [Complex.mem_slitPlane_iff] + left + dsimp [z0, z1, GridCellCenter] + simp + have ha : ((a.re : Int) : Real) ≤ (q.re : Int) := by + exact_mod_cast hcross.2 + have haC : (a : ℂ).re ≤ (q : ℂ).re := by simpa using ha + linarith [t.2.1, t.2.2] + have hd := GridSegmentLogLiftDelta (-z0) (-z1) hslit M hM hMexp + have hre0 : z0.re < 0 := by + dsimp [z0, GridCellCenter] + simp + have ha : ((a.re : Int) : Real) ≤ (q.re : Int) := by + exact_mod_cast hcross.2 + have haC : (a : ℂ).re ≤ (q : ℂ).re := by simpa using ha + linarith + have hi : a.im - 1 = q.im := by simpa using hcross.1 + have hiR : ((a.im : Int) : Real) - 1 = (q.im : Int) := by exact_mod_cast hi + have hiC : (a : ℂ).im - 1 = (q : ℂ).im := by simpa using hiR + have him0 : 0 < z0.im := by + dsimp [z0, GridCellCenter] + norm_num + linarith + have hre1 : z1.re < 0 := by + dsimp [z1, GridCellCenter] + simp + have ha : ((a.re : Int) : Real) ≤ (q.re : Int) := by + exact_mod_cast hcross.2 + have haC : (a : ℂ).re ≤ (q : ℂ).re := by simpa using ha + linarith + have him1 : z1.im < 0 := by + dsimp [z1, GridCellCenter] + norm_num + linarith + have hnorm : ‖z1‖ = ‖z0‖ := by + rw [← sq_eq_sq₀ (norm_nonneg _) (norm_nonneg _), + Complex.sq_norm, Complex.sq_norm] + dsimp [z0, z1, GridCellCenter] + simp? [Complex.normSq_apply] + rw [← hiC] + ring + rw [show M ⟨1, by norm_num⟩ - M ⟨0, by norm_num⟩ = + L ⟨1, by norm_num⟩ - L ⟨0, by norm_num⟩ by simp [M]] at hd + rw [neg_log_delta_down z0 z1 hre0 him0 hre1 him1 hnorm] at hd + simpa [z0, z1] using hd + · rw [ite_eq_right hcross, add_zero] + apply GridSegmentLogLiftDelta _ _ _ L hL hexp + intro t + rw [Complex.mem_slitPlane_iff] + by_cases hre : 0 < + ((1 - (t : Real)) * ((a : ℂ) - GridCellCenter q) + + (t : Real) * ((a - ⟨0, 1⟩ : GaussianInt) - GridCellCenter q)).re + · exact Or.inl hre + · right + intro him + apply hcross + constructor + · dsimp [GridCellCenter] at him + simp only [Complex.add_im, Complex.mul_im, Complex.ofReal_re, + Complex.I_im, Complex.ofReal_im, Complex.I_re, mul_one, mul_zero, + add_zero, Complex.sub_im] at him + norm_num at him + rw [← GaussianInt.intCast_im, ← GaussianInt.intCast_im] at him + have hloR : (-1 : Real) < ((a.im : Int) : Real) - (q.im : Int) - 1 := by + linarith [t.2.1, t.2.2] + have hhiR : ((a.im : Int) : Real) - (q.im : Int) - 1 < 1 := by + linarith [t.2.1, t.2.2] + have hlo : (-1 : Int) < a.im - q.im - 1 := by exact_mod_cast hloR + have hhi : a.im - q.im - 1 < (1 : Int) := by exact_mod_cast hhiR + have heq : a.im - q.im - 1 = 0 := by omega + change a.im - 1 = q.im + omega + · dsimp [GridCellCenter] at hre + simp only [Complex.mul_re, Complex.ofReal_re, + Complex.ofReal_im, + ] at hre + norm_num at hre + rw [← GaussianInt.intCast_re, ← GaussianInt.intCast_re] at hre + have hltR : ((a.re : Int) : Real) - (q.re : Int) < 1 := by linarith + have hlt : a.re - q.re < (1 : Int) := by exact_mod_cast hltR + omega + +end + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GridVerticalUpLogLiftDelta.lean b/LeanPool/ApollonianSuperharmonic/GridVerticalUpLogLiftDelta.lean new file mode 100644 index 0000000000..9eea584be8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GridVerticalUpLogLiftDelta.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.GridCellCenter +public import LeanPool.ApollonianSuperharmonic.GridSegmentLogLiftDelta +public import Mathlib.Analysis.SpecialFunctions.Complex.Arg + +/-! +# GridVerticalUpLogLiftDelta + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open Set + +noncomputable section + +-- [TABLET NODE: GridVerticalUpLogLiftDelta] +theorem GridVerticalUpLogLiftDelta (q a : GaussianInt) + (L : Set.Icc (0 : Real) 1 → ℂ) (hL : Continuous L) + (hexp : ∀ t, Complex.exp (L t) = + (1 - (t : Real)) * ((a : ℂ) - GridCellCenter q) + + (t : Real) * ((a + ⟨0, 1⟩ : GaussianInt) - GridCellCenter q)) : + L ⟨1, by norm_num⟩ - L ⟨0, by norm_num⟩ = + Complex.log ((a + ⟨0, 1⟩ : GaussianInt) - GridCellCenter q) - + Complex.log ((a : ℂ) - GridCellCenter q) - + (if a.im = q.im ∧ a.re ≤ q.re then 2 * Real.pi * Complex.I else 0) := by +-- BODY + have neg_log_delta_up (z0 z1 : ℂ) + (hre0 : z0.re < 0) (him0 : z0.im < 0) + (hre1 : z1.re < 0) (him1 : 0 < z1.im) + (hnorm : ‖z1‖ = ‖z0‖) : + Complex.log (-z1) - Complex.log (-z0) = + Complex.log z1 - Complex.log z0 - 2 * Real.pi * Complex.I := by + apply Complex.ext + · simp [Complex.log_re, hnorm] + · simp only [Complex.log_im, Complex.sub_im, Complex.mul_im, + Complex.ofReal_re, Complex.I_im, Complex.ofReal_im, Complex.I_re, + mul_one, mul_zero] + rw [Complex.arg_neg_eq_arg_sub_pi_of_im_pos him1, + Complex.arg_neg_eq_arg_add_pi_of_im_neg him0] + norm_num + ring + by_cases hcross : a.im = q.im ∧ a.re ≤ q.re + · rw [ite_eq_left hcross] + let z0 := (a : ℂ) - GridCellCenter q + let z1 := (a + ⟨0, 1⟩ : GaussianInt) - GridCellCenter q + let M : Set.Icc (0 : Real) 1 → ℂ := fun t ↦ L t - Real.pi * Complex.I + have hM : Continuous M := hL.sub continuous_const + have hMexp : ∀ t, Complex.exp (M t) = + (1 - (t : Real)) * (-z0) + (t : Real) * (-z1) := by + intro t + rw [show M t = L t - Real.pi * Complex.I by rfl, + Complex.exp_sub_pi_mul_I, hexp] + dsimp [z0, z1] + ring + have hslit : ∀ t : Set.Icc (0 : Real) 1, + (1 - (t : Real)) * (-z0) + (t : Real) * (-z1) ∈ Complex.slitPlane := by + intro t + rw [Complex.mem_slitPlane_iff] + left + dsimp [z0, z1, GridCellCenter] + simp only [Complex.mul_re, + Complex.ofReal_re, Complex.ofReal_im, + ] + norm_num + have ha : ((a.re : Int) : Real) ≤ (q.re : Int) := by + exact_mod_cast hcross.2 + have haC : (a : ℂ).re ≤ (q : ℂ).re := by simpa using ha + have ht0 : 0 ≤ (t : Real) := t.2.1 + have ht1 : (t : Real) ≤ 1 := t.2.2 + linarith + have hd := GridSegmentLogLiftDelta (-z0) (-z1) hslit M hM hMexp + have hre0 : z0.re < 0 := by + dsimp [z0, GridCellCenter] + simp + have ha : ((a.re : Int) : Real) ≤ (q.re : Int) := by + exact_mod_cast hcross.2 + have haC : (a : ℂ).re ≤ (q : ℂ).re := by simpa using ha + linarith + have him0 : z0.im < 0 := by + dsimp [z0, GridCellCenter] + have hi : ((a.im : Int) : Real) = (q.im : Int) := by + exact_mod_cast hcross.1 + have hiC : (a : ℂ).im = (q : ℂ).im := by simpa using hi + rw [hiC] + norm_num + have hre1 : z1.re < 0 := by + dsimp [z1, GridCellCenter] + simp + have ha : ((a.re : Int) : Real) ≤ (q.re : Int) := by + exact_mod_cast hcross.2 + have haC : (a : ℂ).re ≤ (q : ℂ).re := by simpa using ha + linarith + have him1 : 0 < z1.im := by + dsimp [z1, GridCellCenter] + have hi : ((a.im : Int) : Real) = (q.im : Int) := by + exact_mod_cast hcross.1 + have hiC : (a : ℂ).im = (q : ℂ).im := by simpa using hi + norm_num + rw [hiC] + norm_num + have hnorm : ‖z1‖ = ‖z0‖ := by + rw [← sq_eq_sq₀ (norm_nonneg _) (norm_nonneg _)] + rw [Complex.sq_norm, Complex.sq_norm] + dsimp [z0, z1, GridCellCenter] + simp? [Complex.normSq_apply] + have hi : ((a.im : Int) : Real) = (q.im : Int) := by + exact_mod_cast hcross.1 + have hiC : (a : ℂ).im = (q : ℂ).im := by simpa using hi + rw [hiC] + ring + rw [show M ⟨1, by norm_num⟩ - M ⟨0, by norm_num⟩ = + L ⟨1, by norm_num⟩ - L ⟨0, by norm_num⟩ by simp [M]] at hd + rw [neg_log_delta_up z0 z1 hre0 him0 hre1 him1 hnorm] at hd + simpa [z0, z1] using hd + · rw [ite_eq_right hcross, sub_zero] + apply GridSegmentLogLiftDelta _ _ _ L hL hexp + intro t + rw [Complex.mem_slitPlane_iff] + by_cases hre : 0 < + ((1 - (t : Real)) * ((a : ℂ) - GridCellCenter q) + + (t : Real) * ((a + ⟨0, 1⟩ : GaussianInt) - GridCellCenter q)).re + · exact Or.inl hre + · right + intro him + apply hcross + constructor + · dsimp [GridCellCenter] at him + simp only [Complex.add_im, Complex.mul_im, Complex.ofReal_re, + Complex.I_im, Complex.ofReal_im, Complex.I_re, mul_one, mul_zero, + add_zero, Complex.sub_im] at him + norm_num at him + rw [← GaussianInt.intCast_im, ← GaussianInt.intCast_im] at him + have hloR : (-1 : Real) < ((a.im : Int) : Real) - (q.im : Int) := by + linarith [t.2.1, t.2.2] + have hhiR : ((a.im : Int) : Real) - (q.im : Int) < 1 := by + linarith [t.2.1, t.2.2] + have hlo : (-1 : Int) < a.im - q.im := by exact_mod_cast hloR + have hhi : a.im - q.im < (1 : Int) := by exact_mod_cast hhiR + omega + · dsimp [GridCellCenter] at hre + simp only [Complex.mul_re, Complex.ofReal_re, + Complex.ofReal_im, + ] at hre + norm_num at hre + rw [← GaussianInt.intCast_re, ← GaussianInt.intCast_re] at hre + have hltR : ((a.re : Int) : Real) - (q.re : Int) < 1 := by linarith + have hlt : a.re - q.re < (1 : Int) := by exact_mod_cast hltR + omega + +end + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/Imports.lean b/LeanPool/ApollonianSuperharmonic/Imports.lean new file mode 100644 index 0000000000..420c4c07ff --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/Imports.lean @@ -0,0 +1,1242 @@ +/- +Copyright (c) 2026 Lean Pool contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Lean Pool contributors +-/ +module -- shake: keep-all --deprecated_module: ignore + +-- Generated project imports; run `lake exe mk_all`. +public import LeanPool.ApollonianSuperharmonic +public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation +public import LeanPool.ApollonianSuperharmonic.AffineOpposingStripCorridor +public import LeanPool.ApollonianSuperharmonic.AffineTriangularComplexChart +public import LeanPool.ApollonianSuperharmonic.AffineTriangularCorridorStep +public import LeanPool.ApollonianSuperharmonic.AffineTriangularFace +public import LeanPool.ApollonianSuperharmonic.AffineTriangularFaceCoordinateSwap +public import LeanPool.ApollonianSuperharmonic.AffineTriangularFaceVertices +public import LeanPool.ApollonianSuperharmonic.AffineTriangularNoFourfoldCellOwners +public import LeanPool.ApollonianSuperharmonic.AffineTriangularPlaneTriangulation +public import LeanPool.ApollonianSuperharmonic.AffineTriangularStrip +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidenceZeroOppositeChord +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerCentralCovariance +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerOuterSupportNormalization +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerTrans +public import LeanPool.ApollonianSuperharmonic.AncestorTile +public import LeanPool.ApollonianSuperharmonic.AncestorTileCentralCovariance +public import LeanPool.ApollonianSuperharmonic.BandCanonicalPeriodicExtension +public import LeanPool.ApollonianSuperharmonic.BandCircle +public import LeanPool.ApollonianSuperharmonic.BandCircleEnclosureDichotomy +public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData +public import LeanPool.ApollonianSuperharmonic.BandDescartesGapSubdivision +public import LeanPool.ApollonianSuperharmonic.BandDiskExteriorDensity +public import LeanPool.ApollonianSuperharmonic.BandDoubleDecomposition +public import LeanPool.ApollonianSuperharmonic.BandExceptionalRestorationSectorOrder +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle +public import LeanPool.ApollonianSuperharmonic.BandInterfaceRootedForest +public import LeanPool.ApollonianSuperharmonic.BandLatticeEquality +public import LeanPool.ApollonianSuperharmonic.BandModifiedCellPartition +public import LeanPool.ApollonianSuperharmonic.BandModifiedCoverage +public import LeanPool.ApollonianSuperharmonic.BandModifiedOrbitArea +public import LeanPool.ApollonianSuperharmonic.BandModifiedPeriodicComplex +public import LeanPool.ApollonianSuperharmonic.BandModifiedUnionEquality +public import LeanPool.ApollonianSuperharmonic.BandOdometerInteriorTable +public import LeanPool.ApollonianSuperharmonic.BandOdometerMaximality +public import LeanPool.ApollonianSuperharmonic.BandOdometerTheorem +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralAggregatePatches +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralGeometricSectors +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorStarClassification +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorWebRow +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLargestParentOdometerRows +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMarkedSectorTransport +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMixedAggregatePatches +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNestedRightOdometerRows +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOuterMixedOdometerRows +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPositiveCutGeometry +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPositiveCutOdometerRows +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRawSupport +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightInterfaceCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightInterfaceCertificateExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizationCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizationCertificateExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizedBundleExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightOuterMarkingCriterion +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightPlacement +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightRoutingCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightRoutingCertificateExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightSelectedAdjacency +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightSelectedRowGeometry +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRoutedSelectedContact +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRowExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedSCompanionGeometry +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralShiftedRoutedBoundaryLocalization +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileCanonicalRows +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileCanonicalSeparation +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileInterfaceCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileInterfaceCertificateExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileNormalizationCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileNormalizationCertificateExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileNormalizedBundleExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtilePlacement +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileRoutingCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileRoutingCertificateExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileSelectedRowGeometry +public import LeanPool.ApollonianSuperharmonic.BandOrientedBoundaryOccurrenceGenealogy +public import LeanPool.ApollonianSuperharmonic.BandOrientedBoundaryParentChain +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentIncomingEndpoint +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentRightEndpoint +public import LeanPool.ApollonianSuperharmonic.BandOrientedGapRefinement +public import LeanPool.ApollonianSuperharmonic.BandOrientedGapRefinementExists +public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.BandPackingExterior +public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryGlobalOdometerTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryMarkedDataCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryT3T5Covariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.BandParentBoundaryGenealogy +public import LeanPool.ApollonianSuperharmonic.BandParentRotationOccurrenceCovariance +public import LeanPool.ApollonianSuperharmonic.BandPeriodicOdometer +public import LeanPool.ApollonianSuperharmonic.BandPeriodicSuperharmonicity +public import LeanPool.ApollonianSuperharmonic.BandPositiveCutBranchCompanionExclusion +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileCompleteSquareCentroid +public import LeanPool.ApollonianSuperharmonic.BandPrototileExists +public import LeanPool.ApollonianSuperharmonic.BandPrototileFootprintSlopeCovariance +public import LeanPool.ApollonianSuperharmonic.BandPrototileReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification +public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import LeanPool.ApollonianSuperharmonic.BandRetainedBoundaryGenealogy +public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation +public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification +public import LeanPool.ApollonianSuperharmonic.BandTangency +public import LeanPool.ApollonianSuperharmonic.BandTangencyDensity +public import LeanPool.ApollonianSuperharmonic.BandTileAcyclicIndegree +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.BandTileTopologyApplication +public import LeanPool.ApollonianSuperharmonic.BandTwelveParentSurround +public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoreCertificate +public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoverage +public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedPeriodicCore +public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertexDegreeTwo +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.BoundaryJoinChamberCertificate +public import LeanPool.ApollonianSuperharmonic.BoundaryString +public import LeanPool.ApollonianSuperharmonic.BoundaryStringConcatenation +public import LeanPool.ApollonianSuperharmonic.BoundaryStringOdometerRespect +public import LeanPool.ApollonianSuperharmonic.BoundedDifference +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonFootprintIncidence +public import LeanPool.ApollonianSuperharmonic.CellSupportedFootprintVertices +public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.CircleMatrixEnclosureCriterion +public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices +public import LeanPool.ApollonianSuperharmonic.ConnectedCommonBoundaryPath +public import LeanPool.ApollonianSuperharmonic.ConnectedGridEdgeCarrierGraph +public import LeanPool.ApollonianSuperharmonic.ConnectedGridEdgeCarrierUnion +public import LeanPool.ApollonianSuperharmonic.ConsecutivePatchInterface +public import LeanPool.ApollonianSuperharmonic.CoveredInterfaceOppositeIncidentCells +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton +public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer +public import LeanPool.ApollonianSuperharmonic.CurvatureOnePeriodicOdometer +public import LeanPool.ApollonianSuperharmonic.CurvatureOneTileBase +public import LeanPool.ApollonianSuperharmonic.DiamondBaseT1 +public import LeanPool.ApollonianSuperharmonic.DiamondBaseT2 +public import LeanPool.ApollonianSuperharmonic.DiamondBaseTouching +public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain +public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalLattice +public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalMatrixLatticeIdentification +public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalMaximality +public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable +public import LeanPool.ApollonianSuperharmonic.DiamondOdometer +public import LeanPool.ApollonianSuperharmonic.DiamondOdometerExistsUnique +public import LeanPool.ApollonianSuperharmonic.DiamondOpposingBoundaryStarLocalization +public import LeanPool.ApollonianSuperharmonic.DiamondOrientedChildParentEndpoints +public import LeanPool.ApollonianSuperharmonic.DiamondParameter +public import LeanPool.ApollonianSuperharmonic.DiamondPeakMatrix +public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.DiamondRegimeConverse +public import LeanPool.ApollonianSuperharmonic.DiamondTerminalWebStencilLedger +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.DiamondTileAcyclicIndegree +public import LeanPool.ApollonianSuperharmonic.DiamondTileGeometry +public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains +public import LeanPool.ApollonianSuperharmonic.DisjointBoundaryCommonEdgeGraphAcyclic +public import LeanPool.ApollonianSuperharmonic.DisjointSquareUnionCommonEdgeCarrier +public import LeanPool.ApollonianSuperharmonic.EuclideanCircleData +public import LeanPool.ApollonianSuperharmonic.ExactPatchBoundaryInterface +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceDisjointCompanionEndpoints +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleLatticeTouching +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriplePackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleRetargetMiddle +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleSwapLast +public import LeanPool.ApollonianSuperharmonic.ExactTileTiling +public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments +public import LeanPool.ApollonianSuperharmonic.ExceptionalModifiedABPath +public import LeanPool.ApollonianSuperharmonic.ExceptionalRestorationSectorData +public import LeanPool.ApollonianSuperharmonic.FiniteAcyclicGraphCardConnected +public import LeanPool.ApollonianSuperharmonic.FiniteAcyclicOrientationObstruction +public import LeanPool.ApollonianSuperharmonic.FiniteBiconnectedHorizontalRunTree +public import LeanPool.ApollonianSuperharmonic.FiniteConnectedAcyclicDegreeTwoGridPath +public import LeanPool.ApollonianSuperharmonic.FiniteConnectedCellSetNoCheckerboard +public import LeanPool.ApollonianSuperharmonic.FiniteCycleComponentList +public import LeanPool.ApollonianSuperharmonic.FiniteGridEdgeGraphEncoding +public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch +public import LeanPool.ApollonianSuperharmonic.FinitePatchTopology +public import LeanPool.ApollonianSuperharmonic.FinitePolyominoDiskCriterion +public import LeanPool.ApollonianSuperharmonic.FiniteSquareIncidenceIdentities +public import LeanPool.ApollonianSuperharmonic.FiniteTile +public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FordBaseT1 +public import LeanPool.ApollonianSuperharmonic.FordBaseT2 +public import LeanPool.ApollonianSuperharmonic.FordBaseT6 +public import LeanPool.ApollonianSuperharmonic.FordBaseTouching +public import LeanPool.ApollonianSuperharmonic.FordBoundaryMultiplicity +public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import LeanPool.ApollonianSuperharmonic.FordCenteredInteriorOdometerStencil +public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.FordExceptionalLattice +public import LeanPool.ApollonianSuperharmonic.FordExceptionalMatrixLatticeIdentification +public import LeanPool.ApollonianSuperharmonic.FordExceptionalMaximality +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist +public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable +public import LeanPool.ApollonianSuperharmonic.FordLeftBoundaryCompatibility +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordOdometerFamilyExistsUnique +public import LeanPool.ApollonianSuperharmonic.FordOpposingBoundaryStarLocalization +public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentEndpoints +public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentIncomingEndpoint +public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentRightEndpoint +public import LeanPool.ApollonianSuperharmonic.FordPeakMatrix +public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains +public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse +public import LeanPool.ApollonianSuperharmonic.FordTerminalWebStencilLedger +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.FordTileAcyclicIndegree +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.ForwardBoundaryStringData +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.GaussianReflection +public import LeanPool.ApollonianSuperharmonic.GaussianTranslation +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.GridCellCenter +public import LeanPool.ApollonianSuperharmonic.GridEdgeCarrier +public import LeanPool.ApollonianSuperharmonic.GridHorizontalLogLiftDelta +public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndex +public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell +public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexZeroOfEdgeLifts +public import LeanPool.ApollonianSuperharmonic.GridSegmentLogLiftDelta +public import LeanPool.ApollonianSuperharmonic.GridStepLogLiftDelta +public import LeanPool.ApollonianSuperharmonic.GridVerticalDownLogLiftDelta +public import LeanPool.ApollonianSuperharmonic.GridVerticalUpLogLiftDelta +public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import LeanPool.ApollonianSuperharmonic.IntegerLaplacianCastBridge +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction +public import LeanPool.ApollonianSuperharmonic.IntegerPreservingNormalization +public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicCharacterization +public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicClosedness +public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicRepresentative +public import LeanPool.ApollonianSuperharmonic.IntegralityLattice +public import LeanPool.ApollonianSuperharmonic.IntegralityLatticeIndex +public import LeanPool.ApollonianSuperharmonic.IntegralityTiling +public import LeanPool.ApollonianSuperharmonic.IsolatedPrecursorCoverage +public import LeanPool.ApollonianSuperharmonic.LambdaTiling +public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentInterfacePath +public import LeanPool.ApollonianSuperharmonic.LatticeCell +public import LeanPool.ApollonianSuperharmonic.LatticeDiskUnionIntersectionConnected +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.LatticeFundamentalSet +public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileBoundarySimpleGridCycle +public import LeanPool.ApollonianSuperharmonic.LatticeTileComplementGridConnected +public import LeanPool.ApollonianSuperharmonic.LatticeTileDiskUnionInterface +public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridEulerCount +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.LatticeTileNoCheckerboard +public import LeanPool.ApollonianSuperharmonic.LatticeTileThreeDiskJunction +public import LeanPool.ApollonianSuperharmonic.LatticeVertexBoundary +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.LeftAdjacentOdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.LocalExponentialEstimate +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.MarkedOdometerAdjacencyReduction +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex +public import LeanPool.ApollonianSuperharmonic.OdometerAdjacencyInduction +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.OdometerGluing +public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect +public import LeanPool.ApollonianSuperharmonic.OdometerStringRespectCentralCovariance +public import LeanPool.ApollonianSuperharmonic.OdometerStringRespectRegularFamilyCentralCovariance +public import LeanPool.ApollonianSuperharmonic.OdometerTranslation +public import LeanPool.ApollonianSuperharmonic.OdometerWeb +public import LeanPool.ApollonianSuperharmonic.OpenLatticeEdge +public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryInterfaceExhaustion +public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryOdometerStrings +public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryStarLocalization +public import LeanPool.ApollonianSuperharmonic.OpposingStringInterfacePath +public import LeanPool.ApollonianSuperharmonic.OppositeRoutedCommonEdgeOutsideCellUnique +public import LeanPool.ApollonianSuperharmonic.OrderedGeneralOdometerAdjacencyClassification +public import LeanPool.ApollonianSuperharmonic.OrientedTouchingCovariance +public import LeanPool.ApollonianSuperharmonic.OrientedUnimodularStripConcatenation +public import LeanPool.ApollonianSuperharmonic.OuterLayoutTouching +public import LeanPool.ApollonianSuperharmonic.OuterTouchingAlternative +public import LeanPool.ApollonianSuperharmonic.P1BandOrderedGeneralMixedAggregateJunctionData +public import LeanPool.ApollonianSuperharmonic.P1BandOrderedGeneralMixedAggregatePairedEndpoints +public import LeanPool.ApollonianSuperharmonic.P2999T1CompleteSquareTransport +public import LeanPool.ApollonianSuperharmonic.P2999T1OrthogonalSlopeTransport +public import LeanPool.ApollonianSuperharmonic.P2999T1ShiftSlopeTransport +public import LeanPool.ApollonianSuperharmonic.P3019T1ChamberSegmentOrder +public import LeanPool.ApollonianSuperharmonic.P3019T1ChamberStripGeometry +public import LeanPool.ApollonianSuperharmonic.P3019T1UnimodularStripWindow +public import LeanPool.ApollonianSuperharmonic.P3045T1RightBoundaryDisplacementAlgebra +public import LeanPool.ApollonianSuperharmonic.P3055T1ExteriorCentralIncidence +public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms +public import LeanPool.ApollonianSuperharmonic.P3055T1SignedCentroidNormalForms +public import LeanPool.ApollonianSuperharmonic.P3092T1CenteredRectangleDisk +public import LeanPool.ApollonianSuperharmonic.P3092T1DiamondCenteredRectangles +public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition +public import LeanPool.ApollonianSuperharmonic.P3102T2IsolatedRoutedCellSurvival +public import LeanPool.ApollonianSuperharmonic.P3102T2OppositeOwnersCommonEdge +public import LeanPool.ApollonianSuperharmonic.P3102T2PeriodicFourSectorObstruction +public import LeanPool.ApollonianSuperharmonic.P3161T1AggregateComplementConnectivity +public import LeanPool.ApollonianSuperharmonic.P3161T1AggregateInducedConnectivity +public import LeanPool.ApollonianSuperharmonic.P3161T1BlockTreeReachability +public import LeanPool.ApollonianSuperharmonic.P3161T1SquareTriangleComplement +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.P3161T2PathExhaustion +public import LeanPool.ApollonianSuperharmonic.P3161T2PathSubwalk +public import LeanPool.ApollonianSuperharmonic.P3192T1FourOwnerTriangleExclusion +public import LeanPool.ApollonianSuperharmonic.P3192T1PeriodicIndicesInfinite +public import LeanPool.ApollonianSuperharmonic.P3192T1SimplePathOrientation +public import LeanPool.ApollonianSuperharmonic.P3221T2ClosedWalkCirculation +public import LeanPool.ApollonianSuperharmonic.P3221T2ConnectedPathIntegration +public import LeanPool.ApollonianSuperharmonic.P3221T2IntegralSquareFilling +public import LeanPool.ApollonianSuperharmonic.P3221T2TileFillingSupport +public import LeanPool.ApollonianSuperharmonic.P3350T1GraphCellUnionConnected +public import LeanPool.ApollonianSuperharmonic.P3381T1AffineTriangleMap +public import LeanPool.ApollonianSuperharmonic.P3381T1PairedTriangulation +public import LeanPool.ApollonianSuperharmonic.P3381T1PiecewiseAffinePolygonModel +public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangulationBoundary +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundaryReduction +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundaryRestoration +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundarySubdivision +public import LeanPool.ApollonianSuperharmonic.P3475T1GridBoundary +public import LeanPool.ApollonianSuperharmonic.P3475T1PolygonTriangleConstruction +public import LeanPool.ApollonianSuperharmonic.P3475T1PolygonalSeparation +public import LeanPool.ApollonianSuperharmonic.P3475T1SquareUnionIdentification +public import LeanPool.ApollonianSuperharmonic.P3475T1TriangleTree +public import LeanPool.ApollonianSuperharmonic.P3475T1UnitSegmentIntersection +public import LeanPool.ApollonianSuperharmonic.P3497T1SingleStraightDeletion +public import LeanPool.ApollonianSuperharmonic.P3497T1StrictCornerSplice +public import LeanPool.ApollonianSuperharmonic.P3497T1SubdivisionComposition +public import LeanPool.ApollonianSuperharmonic.P3497T1TriangleCornerNonzero +public import LeanPool.ApollonianSuperharmonic.P3511T1AttachmentIntersection +public import LeanPool.ApollonianSuperharmonic.P3511T1ConvexComparison +public import LeanPool.ApollonianSuperharmonic.P3511T1ConvexRealization +public import LeanPool.ApollonianSuperharmonic.P3511T1CyclicDissection +public import LeanPool.ApollonianSuperharmonic.P3511T1LeafOrder +public import LeanPool.ApollonianSuperharmonic.P3511T1SourceConstruction +public import LeanPool.ApollonianSuperharmonic.P3511T1SourceDissection +public import LeanPool.ApollonianSuperharmonic.P3523T1BoundaryFaceSplit +public import LeanPool.ApollonianSuperharmonic.P3523T1FaceEnumeration +public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionConstruction +public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionData +public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionGeometry +public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionIncidence +public import LeanPool.ApollonianSuperharmonic.P3523T1InterpolatedTarget +public import LeanPool.ApollonianSuperharmonic.P3523T1OrderedInsertion +public import LeanPool.ApollonianSuperharmonic.P3523T1SplitDeterminants +public import LeanPool.ApollonianSuperharmonic.P3523T1SubdivisionExit +public import LeanPool.ApollonianSuperharmonic.P3523T1TargetBoundary +public import LeanPool.ApollonianSuperharmonic.P3523T1TargetHull +public import LeanPool.ApollonianSuperharmonic.P3523T1TwoTriangleSplit +public import LeanPool.ApollonianSuperharmonic.P3544T1BoundaryCarrier +public import LeanPool.ApollonianSuperharmonic.P3544T1DiagonalSelection +public import LeanPool.ApollonianSuperharmonic.P3544T1DiagonalSplit +public import LeanPool.ApollonianSuperharmonic.P3544T1IndexedGluing +public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity +public import LeanPool.ApollonianSuperharmonic.P3544T1RayParity +public import LeanPool.ApollonianSuperharmonic.P3544T1TriangleRayGeometry +public import LeanPool.ApollonianSuperharmonic.P3555T2ParabolaChordCuts +public import LeanPool.ApollonianSuperharmonic.P3555T2ParabolaHullFrontier +public import LeanPool.ApollonianSuperharmonic.P3555T2ParabolaSupporting +public import LeanPool.ApollonianSuperharmonic.P3555T2SavedDissectionGeometry +public import LeanPool.ApollonianSuperharmonic.P3597T1DirectionParity +public import LeanPool.ApollonianSuperharmonic.P3597T1GenericRayStability +public import LeanPool.ApollonianSuperharmonic.P3597T1SideCrossing +public import LeanPool.ApollonianSuperharmonic.P3597T1VertexSectors +public import LeanPool.ApollonianSuperharmonic.P3650T1CyclicChildren +public import LeanPool.ApollonianSuperharmonic.P3650T1CyclicChildrenExists +public import LeanPool.ApollonianSuperharmonic.P3650T1EmptyTriangleDiagonal +public import LeanPool.ApollonianSuperharmonic.P3650T1ExposedCorner +public import LeanPool.ApollonianSuperharmonic.P3650T1ExposedCornerExists +public import LeanPool.ApollonianSuperharmonic.P3650T1LocalCoherence +public import LeanPool.ApollonianSuperharmonic.P3650T1MaximalHeightDiagonal +public import LeanPool.ApollonianSuperharmonic.P3650T1OldArcEven +public import LeanPool.ApollonianSuperharmonic.P3650T1ParitySum +public import LeanPool.ApollonianSuperharmonic.P3650T1TriangleEntry +public import LeanPool.ApollonianSuperharmonic.P3650T1VisibleDiagonal +public import LeanPool.ApollonianSuperharmonic.P3652T1ChildFillSeparation +public import LeanPool.ApollonianSuperharmonic.P3652T1DiagonalFaceIntersections +public import LeanPool.ApollonianSuperharmonic.P3652T1IndexedFaceLedger +public import LeanPool.ApollonianSuperharmonic.P3652T1ParentOddGluing +public import LeanPool.ApollonianSuperharmonic.P3652T1TriangleFaceRestriction +public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactDrawingExists +public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting +public import LeanPool.ApollonianSuperharmonic.P3723T1ContactPorts +public import LeanPool.ApollonianSuperharmonic.P3723T1ContactPortsExist +public import LeanPool.ApollonianSuperharmonic.P3723T1ContactStabilizer +public import LeanPool.ApollonianSuperharmonic.P3723T1ConvexRadialIntersection +public import LeanPool.ApollonianSuperharmonic.P3723T1ConvexRadialParameterization +public import LeanPool.ApollonianSuperharmonic.P3723T1EdgeContact +public import LeanPool.ApollonianSuperharmonic.P3723T1GridDiskBoundaryStars +public import LeanPool.ApollonianSuperharmonic.P3723T1GridDiskPairedModel +public import LeanPool.ApollonianSuperharmonic.P3723T1PairedModelSegmentPullback +public import LeanPool.ApollonianSuperharmonic.P3723T1PolygonalParameterization +public import LeanPool.ApollonianSuperharmonic.P3767T1BarrierRegionMaximal +public import LeanPool.ApollonianSuperharmonic.P3767T1FixedFaceComponents +public import LeanPool.ApollonianSuperharmonic.P3767T1FixedTrace +public import LeanPool.ApollonianSuperharmonic.P3767T1VertexEdgeIncidence +public import LeanPool.ApollonianSuperharmonic.P3776T1BoundedDisplacementSurjective +public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership +public import LeanPool.ApollonianSuperharmonic.P3776T1DiskMapExponentialLift +public import LeanPool.ApollonianSuperharmonic.P3776T1DualEdges +public import LeanPool.ApollonianSuperharmonic.P3776T1DualEdgesExist +public import LeanPool.ApollonianSuperharmonic.P3776T1EquivariantDisplacementBound +public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry +public import LeanPool.ApollonianSuperharmonic.P3776T1OpenStar +public import LeanPool.ApollonianSuperharmonic.P3776T1PlaneMapExists +public import LeanPool.ApollonianSuperharmonic.P3776T1SectorMaps +public import LeanPool.ApollonianSuperharmonic.P3776T1SectorMapsExist +public import LeanPool.ApollonianSuperharmonic.P3776T1StarWeights +public import LeanPool.ApollonianSuperharmonic.P3776T1StarWeightsExist +public import LeanPool.ApollonianSuperharmonic.P3776T1TileContractions +public import LeanPool.ApollonianSuperharmonic.P3776T1TileContractionsExist +public import LeanPool.ApollonianSuperharmonic.P3776T1WalkMap +public import LeanPool.ApollonianSuperharmonic.P3776T1WalkMapProperties +public import LeanPool.ApollonianSuperharmonic.P3821T1AngularIncrement +public import LeanPool.ApollonianSuperharmonic.P3821T1AngularIncrementLaws +public import LeanPool.ApollonianSuperharmonic.P3821T1CircleComponentBound +public import LeanPool.ApollonianSuperharmonic.P3821T1ComponentContours +public import LeanPool.ApollonianSuperharmonic.P3821T1ControlledNeighborhood +public import LeanPool.ApollonianSuperharmonic.P3821T1LoopIndex +public import LeanPool.ApollonianSuperharmonic.P3821T1LoopIndexLaws +public import LeanPool.ApollonianSuperharmonic.P3821T1ThreeArcCircle +public import LeanPool.ApollonianSuperharmonic.P3832T1ChamberOverlap +public import LeanPool.ApollonianSuperharmonic.P3832T1CollapsedConeDescent +public import LeanPool.ApollonianSuperharmonic.P3832T1ConeCollapse +public import LeanPool.ApollonianSuperharmonic.P3832T1FiniteClosedCoverPasting +public import LeanPool.ApollonianSuperharmonic.P3861T1ExtraArcLocalization +public import LeanPool.ApollonianSuperharmonic.P3861T1FacialDomains +public import LeanPool.ApollonianSuperharmonic.P3861T1FixedFacialDeletion +public import LeanPool.ApollonianSuperharmonic.P3861T1RealPolygonDomains +public import LeanPool.ApollonianSuperharmonic.P3861T1RoutedFaceOrientation +public import LeanPool.ApollonianSuperharmonic.P3861T1RoutedFacialDomains +public import LeanPool.ApollonianSuperharmonic.P3889T1ExactRadialStar +public import LeanPool.ApollonianSuperharmonic.P3889T1FaceGapCoverage +public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectorDecomposition +public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectors +public import LeanPool.ApollonianSuperharmonic.P3913T1OffFaceExterior +public import LeanPool.ApollonianSuperharmonic.P3913T1PeriodicPositionUnbounded +public import LeanPool.ApollonianSuperharmonic.P3913T1RoutedArcExterior +public import LeanPool.ApollonianSuperharmonic.P3913T1RoutedFaceSubdivision +public import LeanPool.ApollonianSuperharmonic.P3913T1RoutedTraceClosed +public import LeanPool.ApollonianSuperharmonic.P3934T1ArcSide +public import LeanPool.ApollonianSuperharmonic.P3934T1ArcSideComparison +public import LeanPool.ApollonianSuperharmonic.P3934T1LocalSide +public import LeanPool.ApollonianSuperharmonic.P3934T1PolygonalSide +public import LeanPool.ApollonianSuperharmonic.P3934T1PolygonalSidePropagation +public import LeanPool.ApollonianSuperharmonic.P3934T1SectorContinuation +public import LeanPool.ApollonianSuperharmonic.P3934T1SectorSelection +public import LeanPool.ApollonianSuperharmonic.P3963T1DeletedPairExteriorConnected +public import LeanPool.ApollonianSuperharmonic.P3963T1EdgeFreeDiskCorners +public import LeanPool.ApollonianSuperharmonic.P3963T1ExteriorMixedCycleObstruction +public import LeanPool.ApollonianSuperharmonic.P3963T1MixedBoundaryCycle +public import LeanPool.ApollonianSuperharmonic.P3996T1AdjacentParentPlacement +public import LeanPool.ApollonianSuperharmonic.P3996T1CenteredQuarterTurnInclusion +public import LeanPool.ApollonianSuperharmonic.P3996T1PlacementCompanionBlocks +public import LeanPool.ApollonianSuperharmonic.P3996T1SRowAlignment +public import LeanPool.ApollonianSuperharmonic.P3996T1SRowParameters +public import LeanPool.ApollonianSuperharmonic.P3996T1SRowTable +public import LeanPool.ApollonianSuperharmonic.P4055T1BandQuarterTurn +public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage +public import LeanPool.ApollonianSuperharmonic.P4055T1GridPathImage +public import LeanPool.ApollonianSuperharmonic.P4055T1OrderedGeneralOppositeEndpoints +public import LeanPool.ApollonianSuperharmonic.P4055T1PackingGridEquivalence +public import LeanPool.ApollonianSuperharmonic.P4055T1PlacementNormalization +public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport +public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorGeometry +public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorSquare +public import LeanPool.ApollonianSuperharmonic.P4062T1LiteralReduction +public import LeanPool.ApollonianSuperharmonic.P4062T1OrientationTransport +public import LeanPool.ApollonianSuperharmonic.P4062T1OverlapDescent +public import LeanPool.ApollonianSuperharmonic.P4062T1ParentGluing +public import LeanPool.ApollonianSuperharmonic.P4062T1ParentalRestriction +public import LeanPool.ApollonianSuperharmonic.P4062T1RankedAttachment +public import LeanPool.ApollonianSuperharmonic.P4062T1RecursiveInteriors +public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderGeometry +public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderPaths +public import LeanPool.ApollonianSuperharmonic.P4062T1ZeroIncoming +public import LeanPool.ApollonianSuperharmonic.P4085T1FordIncomingNormalization +public import LeanPool.ApollonianSuperharmonic.P4085T1MinusTouching +public import LeanPool.ApollonianSuperharmonic.P4085T1RestrictedAdaptedActions +public import LeanPool.ApollonianSuperharmonic.P4112T1BoundaryMultiplicity +public import LeanPool.ApollonianSuperharmonic.P4112T1LowerNeighbors +public import LeanPool.ApollonianSuperharmonic.P4112T1ParentalNeighbors +public import LeanPool.ApollonianSuperharmonic.P4112T1PathGeometry +public import LeanPool.ApollonianSuperharmonic.P4120T1AffineComparison +public import LeanPool.ApollonianSuperharmonic.P4120T1DiamondGeometry +public import LeanPool.ApollonianSuperharmonic.P4120T1FordGeometry +public import LeanPool.ApollonianSuperharmonic.P4120T1GeneralDescent +public import LeanPool.ApollonianSuperharmonic.P4120T1GeneralRowData +public import LeanPool.ApollonianSuperharmonic.P4120T1RootNormalization +public import LeanPool.ApollonianSuperharmonic.P4158T1AncestorCells +public import LeanPool.ApollonianSuperharmonic.P4158T1EdgeSectorSelection +public import LeanPool.ApollonianSuperharmonic.P4158T1LargeFirstRestrictions +public import LeanPool.ApollonianSuperharmonic.P4158T1LargeSecondRestrictions +public import LeanPool.ApollonianSuperharmonic.P4158T1MatchedFordPair +public import LeanPool.ApollonianSuperharmonic.P4158T1SmallerStringEdges +public import LeanPool.ApollonianSuperharmonic.P4158T1StringSlopeTelescoping +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondBoundaryLedger +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCentroid +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence +public import LeanPool.ApollonianSuperharmonic.P4207T1DiamondFormula +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic +public import LeanPool.ApollonianSuperharmonic.P4207T1FormulaRestriction +public import LeanPool.ApollonianSuperharmonic.P4207T1ShiftedPredecessor +public import LeanPool.ApollonianSuperharmonic.P4207T1UnitRestrictions +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid +public import LeanPool.ApollonianSuperharmonic.P4217T2RectangularBoundarySlope +public import LeanPool.ApollonianSuperharmonic.P4217T2SquareGeometry +public import LeanPool.ApollonianSuperharmonic.P4217T2SquareRestriction +public import LeanPool.ApollonianSuperharmonic.P4223T1DiamondRowNumerators +public import LeanPool.ApollonianSuperharmonic.P4250T1DefinedHalfIntegralSlope +public import LeanPool.ApollonianSuperharmonic.P4250T1IntegralAffinePlacement +public import LeanPool.ApollonianSuperharmonic.P4250T1NestedCompatibility +public import LeanPool.ApollonianSuperharmonic.P4250T1OrdinaryCompatibility +public import LeanPool.ApollonianSuperharmonic.P4250T1ParentSlopePhase +public import LeanPool.ApollonianSuperharmonic.P4250T1ReflectedGluingSlope +public import LeanPool.ApollonianSuperharmonic.P4250T1SlopeOffset +public import LeanPool.ApollonianSuperharmonic.P4250T2FiniteForestCompletion +public import LeanPool.ApollonianSuperharmonic.P4250T2IndegreeSubtraction +public import LeanPool.ApollonianSuperharmonic.P4250T2InterfaceCycleExclusion +public import LeanPool.ApollonianSuperharmonic.P4250T2InterfaceNeighborCount +public import LeanPool.ApollonianSuperharmonic.P4250T2PrecursorRootSeparation +public import LeanPool.ApollonianSuperharmonic.P4261T1CentralCoordinates +public import LeanPool.ApollonianSuperharmonic.P4261T1ContactAdjacency +public import LeanPool.ApollonianSuperharmonic.P4261T1EdgeExterior +public import LeanPool.ApollonianSuperharmonic.P4261T1ExteriorAdjacency +public import LeanPool.ApollonianSuperharmonic.P4261T1ExteriorIndices +public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer +public import LeanPool.ApollonianSuperharmonic.P4261T1RightCoordinates +public import LeanPool.ApollonianSuperharmonic.P4261T1SubtileCoordinates +public import LeanPool.ApollonianSuperharmonic.P4261T2AdjacentMatrixSlope +public import LeanPool.ApollonianSuperharmonic.P4261T2AncestorSymmetry +public import LeanPool.ApollonianSuperharmonic.P4261T2DiamondBoundary +public import LeanPool.ApollonianSuperharmonic.P4261T2InterfacePropagation +public import LeanPool.ApollonianSuperharmonic.P4261T2LiteralInterface +public import LeanPool.ApollonianSuperharmonic.P4261T2PairNormalization +public import LeanPool.ApollonianSuperharmonic.P4261T2RegularEdgeReduction +public import LeanPool.ApollonianSuperharmonic.P4261T2UnitBoundary +public import LeanPool.ApollonianSuperharmonic.P4261T2UnitInterface +public import LeanPool.ApollonianSuperharmonic.P4261T2UnitStringTelescoping +public import LeanPool.ApollonianSuperharmonic.P4339T1EmptyPrecursorRoots +public import LeanPool.ApollonianSuperharmonic.P4339T1PositivePrecursorRoots +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorArcSeparation +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import LeanPool.ApollonianSuperharmonic.P4366T1AttachedRemainderIndexZero +public import LeanPool.ApollonianSuperharmonic.P4366T1PrecursorPathLoop +public import LeanPool.ApollonianSuperharmonic.P4366T1PrecursorRemainderFamily +public import LeanPool.ApollonianSuperharmonic.P4366T1RemainderOuterAttachments +public import LeanPool.ApollonianSuperharmonic.P4366T2LocalSectors +public import LeanPool.ApollonianSuperharmonic.P4366T2OuterGeometry +public import LeanPool.ApollonianSuperharmonic.P4366T2WalkExhaustion +public import LeanPool.ApollonianSuperharmonic.P4387T1ParentSlopeNormalForms +public import LeanPool.ApollonianSuperharmonic.P4387T1PlacedCoordinates +public import LeanPool.ApollonianSuperharmonic.P4397T1PathAvoidsPrecursorEdges +public import LeanPool.ApollonianSuperharmonic.P4397T1ReflectedEdgeNotBoundary +public import LeanPool.ApollonianSuperharmonic.P4397T1SimplePathSplicing +public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells +public import LeanPool.ApollonianSuperharmonic.P4418T3EndpointOwnerIndices +public import LeanPool.ApollonianSuperharmonic.P4418T3NestedCompanionEndpoint +public import LeanPool.ApollonianSuperharmonic.P4418T3NestedCompanionGeometry +public import LeanPool.ApollonianSuperharmonic.P4418T3OuterCompanionAlignment +public import LeanPool.ApollonianSuperharmonic.P4418T3PresentedRowAdjacency +public import LeanPool.ApollonianSuperharmonic.P4418T3RoutedBlockCriterion +public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceData +public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceExists +public import LeanPool.ApollonianSuperharmonic.P4431T1OwnerTransitionSelector +public import LeanPool.ApollonianSuperharmonic.P4456T2BandGraphTriangle +public import LeanPool.ApollonianSuperharmonic.P4456T2CrosscutIndex +public import LeanPool.ApollonianSuperharmonic.P4456T2DiamondNoChord +public import LeanPool.ApollonianSuperharmonic.P4456T2EdgeInterior +public import LeanPool.ApollonianSuperharmonic.P4456T2MissingEdge +public import LeanPool.ApollonianSuperharmonic.P4456T2OrderedNoChord +public import LeanPool.ApollonianSuperharmonic.P4456T2PackingNoChord +public import LeanPool.ApollonianSuperharmonic.P4456T2ParentSide +public import LeanPool.ApollonianSuperharmonic.P4456T2SquareEdges +public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryFrame +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryPlacement +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundarySide +public import LeanPool.ApollonianSuperharmonic.P4458T1FirstProperRows +public import LeanPool.ApollonianSuperharmonic.P4458T1LargestParentRows +public import LeanPool.ApollonianSuperharmonic.P4458T1RespectAppend +public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily +public import LeanPool.ApollonianSuperharmonic.P4458T1SecondNewerRows +public import LeanPool.ApollonianSuperharmonic.P4458T1SmallPairRows +public import LeanPool.ApollonianSuperharmonic.P4458T1ThirdNewerRows +public import LeanPool.ApollonianSuperharmonic.P4536T1AFrameB +public import LeanPool.ApollonianSuperharmonic.P4536T1AFrameD +public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointAlgebra +public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointDifferences +public import LeanPool.ApollonianSuperharmonic.P4536T1HalfOffsetBridge +public import LeanPool.ApollonianSuperharmonic.P4536T1RegularJoin +public import LeanPool.ApollonianSuperharmonic.P4536T1SmallUnitSides +public import LeanPool.ApollonianSuperharmonic.P4536T1TangentPairMatrix +public import LeanPool.ApollonianSuperharmonic.P4549T1DeeperFrameB +public import LeanPool.ApollonianSuperharmonic.P4549T1NegativeIncomingSide +public import LeanPool.ApollonianSuperharmonic.P4564T2DiamondGeometry +public import LeanPool.ApollonianSuperharmonic.P4564T2DiamondOrderExclusion +public import LeanPool.ApollonianSuperharmonic.P4564T2ElementaryQuarterTurn +public import LeanPool.ApollonianSuperharmonic.P4564T2FordGeometry +public import LeanPool.ApollonianSuperharmonic.P4564T2FordT6Transport +public import LeanPool.ApollonianSuperharmonic.P4564T2GeneralT6Transport +public import LeanPool.ApollonianSuperharmonic.P4564T2GeometryPullback +public import LeanPool.ApollonianSuperharmonic.P4566T1LiteralSuccessorCharts +public import LeanPool.ApollonianSuperharmonic.P4566T1SmallPairCoordinates +public import LeanPool.ApollonianSuperharmonic.P4566T1SmallRetainedSides +public import LeanPool.ApollonianSuperharmonic.P4566T1StrictRetainedGenealogy +public import LeanPool.ApollonianSuperharmonic.P4566T1UnitPairCharts +public import LeanPool.ApollonianSuperharmonic.P4590T1CentralDiskSectors +public import LeanPool.ApollonianSuperharmonic.P4590T1JunctionRefinement +public import LeanPool.ApollonianSuperharmonic.P4590T1JunctionRouting +public import LeanPool.ApollonianSuperharmonic.P4590T1MixedCompanionMarks +public import LeanPool.ApollonianSuperharmonic.P4590T1MixedInteriorGeometry +public import LeanPool.ApollonianSuperharmonic.P4590T1OppositeCellsStar +public import LeanPool.ApollonianSuperharmonic.P4590T1OriginalNonedges +public import LeanPool.ApollonianSuperharmonic.P4590T1PositivePrototileDisk +public import LeanPool.ApollonianSuperharmonic.P4590T1ReflectedCenterBoundary +public import LeanPool.ApollonianSuperharmonic.P4590T1RestoredBoundaryGeometry +public import LeanPool.ApollonianSuperharmonic.P4590T1RightInteriorGeometry +public import LeanPool.ApollonianSuperharmonic.P4590T1RotationalDiskCenter +public import LeanPool.ApollonianSuperharmonic.P4590T1SixLabelBoundaryCount +public import LeanPool.ApollonianSuperharmonic.P4616T1FirstPredecessorCentroids +public import LeanPool.ApollonianSuperharmonic.P4616T1MixedCoarseSectors +public import LeanPool.ApollonianSuperharmonic.P4616T1NestedCompanionFootprints +public import LeanPool.ApollonianSuperharmonic.P4616T1OriginalMixedPaths +public import LeanPool.ApollonianSuperharmonic.P4616T1PeriodicEndpointExclusion +public import LeanPool.ApollonianSuperharmonic.P4616T1ThirdOwnerPathEndpoint +public import LeanPool.ApollonianSuperharmonic.P4623T1ZeroBlockExterior +public import LeanPool.ApollonianSuperharmonic.P4623T1ZeroBlockLinks +public import LeanPool.ApollonianSuperharmonic.P4623T1ZeroBlockPaths +public import LeanPool.ApollonianSuperharmonic.P4630T1AffineCellSymmetry +public import LeanPool.ApollonianSuperharmonic.P4630T1CellRouteLift +public import LeanPool.ApollonianSuperharmonic.P4630T1ExteriorNeighbors +public import LeanPool.ApollonianSuperharmonic.P4630T1ExteriorWalks +public import LeanPool.ApollonianSuperharmonic.P4630T1GridComplementCriterion +public import LeanPool.ApollonianSuperharmonic.P4630T1ParentRotation +public import LeanPool.ApollonianSuperharmonic.P4630T1RingIndex +public import LeanPool.ApollonianSuperharmonic.P4638T1AntipodalContactArcs +public import LeanPool.ApollonianSuperharmonic.P4638T1ContactStarCoverage +public import LeanPool.ApollonianSuperharmonic.P4638T1EmptyCurvature +public import LeanPool.ApollonianSuperharmonic.P4638T1EmptyFordLocalization +public import LeanPool.ApollonianSuperharmonic.P4638T1FordIncidentCells +public import LeanPool.ApollonianSuperharmonic.P4638T1MidpointReflection +public import LeanPool.ApollonianSuperharmonic.P4651T1ContactEdgeSeparation +public import LeanPool.ApollonianSuperharmonic.P4651T1CycleComplementaryArcs +public import LeanPool.ApollonianSuperharmonic.P4651T1FreeBoundaryHalfTurn +public import LeanPool.ApollonianSuperharmonic.P4651T1GridHalfTurnTransport +public import LeanPool.ApollonianSuperharmonic.P4670T1ComplementReflection +public import LeanPool.ApollonianSuperharmonic.P4670T1OrdinaryEdges +public import LeanPool.ApollonianSuperharmonic.P4670T1SmallerGeometry +public import LeanPool.ApollonianSuperharmonic.P4677T2DrawingData +public import LeanPool.ApollonianSuperharmonic.P4677T2DrawingExists +public import LeanPool.ApollonianSuperharmonic.P4677T2FacePoints +public import LeanPool.ApollonianSuperharmonic.P4677T2IncidenceLedger +public import LeanPool.ApollonianSuperharmonic.P4677T2PeriodicWalkAssembly +public import LeanPool.ApollonianSuperharmonic.P4677T2PrecursorWalk +public import LeanPool.ApollonianSuperharmonic.P4677T2ThreeConnected +public import LeanPool.ApollonianSuperharmonic.P4677T2TouchingWalk +public import LeanPool.ApollonianSuperharmonic.P4715T1Arc +public import LeanPool.ApollonianSuperharmonic.P4715T1BoundaryCycle +public import LeanPool.ApollonianSuperharmonic.P4715T1CoefficientEdges +public import LeanPool.ApollonianSuperharmonic.P4715T1CoefficientFaces +public import LeanPool.ApollonianSuperharmonic.P4715T1CoefficientTranslation +public import LeanPool.ApollonianSuperharmonic.P4715T1FaceShift +public import LeanPool.ApollonianSuperharmonic.P4715T1Hexagon +public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonSubdivision +public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonTessellation +public import LeanPool.ApollonianSuperharmonic.P4715T1IndexAction +public import LeanPool.ApollonianSuperharmonic.P4715T1LatticeCoordinates +public import LeanPool.ApollonianSuperharmonic.P4715T1Offsets +public import LeanPool.ApollonianSuperharmonic.P4715T1OrbitRepresentatives +public import LeanPool.ApollonianSuperharmonic.P4715T1PatchEnumeration +public import LeanPool.ApollonianSuperharmonic.P4715T1PatchFaces +public import LeanPool.ApollonianSuperharmonic.P4715T1PlaneMap +public import LeanPool.ApollonianSuperharmonic.P4715T1Position +public import LeanPool.ApollonianSuperharmonic.P4715T1PositionInjective +public import LeanPool.ApollonianSuperharmonic.P4715T1Region +public import LeanPool.ApollonianSuperharmonic.P4715T1VertexShift +public import LeanPool.ApollonianSuperharmonic.P4733T1ContainedWalk +public import LeanPool.ApollonianSuperharmonic.P4733T1Coordinates +public import LeanPool.ApollonianSuperharmonic.P4733T1EdgeOrbit +public import LeanPool.ApollonianSuperharmonic.P4733T1EdgeRow +public import LeanPool.ApollonianSuperharmonic.P4733T1FacePairNormalForm +public import LeanPool.ApollonianSuperharmonic.P4733T1FacePairOrbit +public import LeanPool.ApollonianSuperharmonic.P4733T1OccurrenceTranslation +public import LeanPool.ApollonianSuperharmonic.P4733T1RepresentativeWalks +public import LeanPool.ApollonianSuperharmonic.P4733T1RowIncidence +public import LeanPool.ApollonianSuperharmonic.P4733T1RowLabelRigidity +public import LeanPool.ApollonianSuperharmonic.P4733T1WalkExtension +public import LeanPool.ApollonianSuperharmonic.P4733T1WalkTransport +public import LeanPool.ApollonianSuperharmonic.P4780T1ActiveFacets +public import LeanPool.ApollonianSuperharmonic.P4780T1HullHalfspaces +public import LeanPool.ApollonianSuperharmonic.P4780T1IntegerCoverage +public import LeanPool.ApollonianSuperharmonic.P4780T1InteriorSeparation +public import LeanPool.ApollonianSuperharmonic.P4780T1NeighborCorners +public import LeanPool.ApollonianSuperharmonic.P4780T1NeighborFacets +public import LeanPool.ApollonianSuperharmonic.P4780T1OverlapBound +public import LeanPool.ApollonianSuperharmonic.P4780T1StrictInterior +public import LeanPool.ApollonianSuperharmonic.P4783T1ParallelogramFan +public import LeanPool.ApollonianSuperharmonic.P4783T1PatchCoordinates +public import LeanPool.ApollonianSuperharmonic.P4783T1PatchCoverage +public import LeanPool.ApollonianSuperharmonic.P4783T1PatchDeterminants +public import LeanPool.ApollonianSuperharmonic.P4793T1FacetForms +public import LeanPool.ApollonianSuperharmonic.P4793T1PatchBoundaryTraces +public import LeanPool.ApollonianSuperharmonic.P4793T1PatchFacetLedger +public import LeanPool.ApollonianSuperharmonic.P4793T1PatchIntersections +public import LeanPool.ApollonianSuperharmonic.P4793T1PatchSeparators +public import LeanPool.ApollonianSuperharmonic.P4793T1SeparatorIntersection +public import LeanPool.ApollonianSuperharmonic.P4793T1SupportingFace +public import LeanPool.ApollonianSuperharmonic.P4802T1CrossPatchFaces +public import LeanPool.ApollonianSuperharmonic.P4802T1HexagonOverlapSide +public import LeanPool.ApollonianSuperharmonic.P4802T1PatchFaceRestriction +public import LeanPool.ApollonianSuperharmonic.P4802T1SideRestriction +public import LeanPool.ApollonianSuperharmonic.P4802T1SimplexFaces +public import LeanPool.ApollonianSuperharmonic.P4802T1TriangleIndependent +public import LeanPool.ApollonianSuperharmonic.P4812T1AffineDrawing +public import LeanPool.ApollonianSuperharmonic.P4812T1AffineTransport +public import LeanPool.ApollonianSuperharmonic.P4812T1LatticeCoordinates +public import LeanPool.ApollonianSuperharmonic.P4812T1ReflectedTouching +public import LeanPool.ApollonianSuperharmonic.P4812T1RegularFaceWalks +public import LeanPool.ApollonianSuperharmonic.P4818T1AffineTransversalExtension +public import LeanPool.ApollonianSuperharmonic.P4818T1BoundaryRecovery +public import LeanPool.ApollonianSuperharmonic.P4818T1ClosedOverlaps +public import LeanPool.ApollonianSuperharmonic.P4818T1HalfOpen +public import LeanPool.ApollonianSuperharmonic.P4818T1OverlapDifferences +public import LeanPool.ApollonianSuperharmonic.P4818T1Representatives +public import LeanPool.ApollonianSuperharmonic.P4828T1CircularPlacement +public import LeanPool.ApollonianSuperharmonic.P4828T1ConstructorSupport +public import LeanPool.ApollonianSuperharmonic.P4828T1Disk +public import LeanPool.ApollonianSuperharmonic.P4828T1Evaluate +public import LeanPool.ApollonianSuperharmonic.P4828T1FiniteWordSeparation +public import LeanPool.ApollonianSuperharmonic.P4828T1Gap +public import LeanPool.ApollonianSuperharmonic.P4828T1HistoryNormalForm +public import LeanPool.ApollonianSuperharmonic.P4828T1HistoryRealization +public import LeanPool.ApollonianSuperharmonic.P4828T1LeftRootGeometry +public import LeanPool.ApollonianSuperharmonic.P4828T1LinePlacement +public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport +public import LeanPool.ApollonianSuperharmonic.P4828T1ParentsDistinct +public import LeanPool.ApollonianSuperharmonic.P4828T1ResidualPatches +public import LeanPool.ApollonianSuperharmonic.P4828T1RightRootGeometry +public import LeanPool.ApollonianSuperharmonic.P4828T1Root +public import LeanPool.ApollonianSuperharmonic.P4828T1RootSeparation +public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate +public import LeanPool.ApollonianSuperharmonic.P4828T1RotationLaws +public import LeanPool.ApollonianSuperharmonic.P4828T1Step +public import LeanPool.ApollonianSuperharmonic.P4840T6ConstructorCovariance +public import LeanPool.ApollonianSuperharmonic.P4840T6DiamondRecurrence +public import LeanPool.ApollonianSuperharmonic.P4840T6NegatedRoot +public import LeanPool.ApollonianSuperharmonic.P4840T6ProperGrowth +public import LeanPool.ApollonianSuperharmonic.P4840T6ShiftRoot +public import LeanPool.ApollonianSuperharmonic.P4849T1Component +public import LeanPool.ApollonianSuperharmonic.P4849T1ComponentRestriction +public import LeanPool.ApollonianSuperharmonic.P4849T1InfiniteLimitComponent +public import LeanPool.ApollonianSuperharmonic.P4849T1LargePositiveComponents +public import LeanPool.ApollonianSuperharmonic.P4849T1LocalLimitAdmissibility +public import LeanPool.ApollonianSuperharmonic.P4849T1MinimumTruncation +public import LeanPool.ApollonianSuperharmonic.P4849T1PeriodAnchoring +public import LeanPool.ApollonianSuperharmonic.P4849T1PeriodResidues +public import LeanPool.ApollonianSuperharmonic.P4849T1SetDiagonalSubsequence +public import LeanPool.ApollonianSuperharmonic.P4903T1ScalarTangencies +public import LeanPool.ApollonianSuperharmonic.P4903T1SignedDiskHull +public import LeanPool.ApollonianSuperharmonic.P4909T1LineFan +public import LeanPool.ApollonianSuperharmonic.P4909T1OmittedDiskBarrier +public import LeanPool.ApollonianSuperharmonic.P4909T1ParentEdges +public import LeanPool.ApollonianSuperharmonic.P4909T1ParentPolygon +public import LeanPool.ApollonianSuperharmonic.P4909T1TangentSegments +public import LeanPool.ApollonianSuperharmonic.P4909T1TriangleFan +public import LeanPool.ApollonianSuperharmonic.P4953T1HullHeight +public import LeanPool.ApollonianSuperharmonic.P4953T1LiteralHulls +public import LeanPool.ApollonianSuperharmonic.P4953T1QuadrilateralSections +public import LeanPool.ApollonianSuperharmonic.P4953T1TriangleSections +public import LeanPool.ApollonianSuperharmonic.P4981T1EdgePrescription +public import LeanPool.ApollonianSuperharmonic.P4981T1EdgeRank +public import LeanPool.ApollonianSuperharmonic.P4981T1PrescriptionCoherence +public import LeanPool.ApollonianSuperharmonic.P4981T1PrescriptionLocality +public import LeanPool.ApollonianSuperharmonic.P4981T1PrescriptionValue +public import LeanPool.ApollonianSuperharmonic.P4981T1ProperEquations +public import LeanPool.ApollonianSuperharmonic.P4981T1Recursion +public import LeanPool.ApollonianSuperharmonic.P4981T1RootEquations +public import LeanPool.ApollonianSuperharmonic.P4984T1BranchDecay +public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap +public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedSubdivision +public import LeanPool.ApollonianSuperharmonic.P4984T1ContactDiameter +public import LeanPool.ApollonianSuperharmonic.P4984T1IncidentArcs +public import LeanPool.ApollonianSuperharmonic.P4984T1RootGaps +public import LeanPool.ApollonianSuperharmonic.P4984T1UnitIncidence +public import LeanPool.ApollonianSuperharmonic.P4994T6Chamber +public import LeanPool.ApollonianSuperharmonic.P4994T6ChamberAdditions +public import LeanPool.ApollonianSuperharmonic.P4994T6ChartCovolume +public import LeanPool.ApollonianSuperharmonic.P4994T6NonunitBirth +public import LeanPool.ApollonianSuperharmonic.P4994T6NonunitChamber +public import LeanPool.ApollonianSuperharmonic.P4994T6Rotation +public import LeanPool.ApollonianSuperharmonic.P4994T6RotationLaws +public import LeanPool.ApollonianSuperharmonic.P4994T6StepChamber +public import LeanPool.ApollonianSuperharmonic.P4994T6UnitChartRotation +public import LeanPool.ApollonianSuperharmonic.P4994T6UnitCoordinates +public import LeanPool.ApollonianSuperharmonic.P4994T6UnitOccurrenceChamber +public import LeanPool.ApollonianSuperharmonic.P4994T6UnitRootTable +public import LeanPool.ApollonianSuperharmonic.P5023T1CircularEstimate +public import LeanPool.ApollonianSuperharmonic.P5023T1CircularSide +public import LeanPool.ApollonianSuperharmonic.P5023T1ContactHull +public import LeanPool.ApollonianSuperharmonic.P5023T1ContactVertices +public import LeanPool.ApollonianSuperharmonic.P5023T1ConvexDiameter +public import LeanPool.ApollonianSuperharmonic.P5023T1LineEstimate +public import LeanPool.ApollonianSuperharmonic.P5023T1LineSideGeometry +public import LeanPool.ApollonianSuperharmonic.P5050T1OmittedHullSeparation +public import LeanPool.ApollonianSuperharmonic.P5050T1ParentSphereSection +public import LeanPool.ApollonianSuperharmonic.P5050T1RadialSection +public import LeanPool.ApollonianSuperharmonic.P5050T1TangentLineSection +public import LeanPool.ApollonianSuperharmonic.P5050T1TangentTriangleSection +public import LeanPool.ApollonianSuperharmonic.P5064T3CrossParentSupport +public import LeanPool.ApollonianSuperharmonic.P5064T3LiteralLocalization +public import LeanPool.ApollonianSuperharmonic.P5064T3OrderedPredecessor +public import LeanPool.ApollonianSuperharmonic.P5064T3PrecursorSupport +public import LeanPool.ApollonianSuperharmonic.P5064T3RectangleContacts +public import LeanPool.ApollonianSuperharmonic.P5064T3Rectangles +public import LeanPool.ApollonianSuperharmonic.P5090T1TangentCircleMetric +public import LeanPool.ApollonianSuperharmonic.P5090T1ThreeDiskContactTriangle +public import LeanPool.ApollonianSuperharmonic.P5090T1TwoDiskLineTriangle +public import LeanPool.ApollonianSuperharmonic.P5098T1ABIntervals +public import LeanPool.ApollonianSuperharmonic.P5098T1ACIntervals +public import LeanPool.ApollonianSuperharmonic.P5098T1ADIntervals +public import LeanPool.ApollonianSuperharmonic.P5098T1BCIntervals +public import LeanPool.ApollonianSuperharmonic.P5098T1BDIntervals +public import LeanPool.ApollonianSuperharmonic.P5098T1CDIntervals +public import LeanPool.ApollonianSuperharmonic.P5098T1EqualIntervals +public import LeanPool.ApollonianSuperharmonic.P5098T1OccurrenceSquares +public import LeanPool.ApollonianSuperharmonic.P5098T1PeriodWindow +public import LeanPool.ApollonianSuperharmonic.P5098T1SquareIntersection +public import LeanPool.ApollonianSuperharmonic.P5104T1CornerDeletionDisk +public import LeanPool.ApollonianSuperharmonic.P5110T1AnchoredTriples +public import LeanPool.ApollonianSuperharmonic.P5110T1ParentLocalization +public import LeanPool.ApollonianSuperharmonic.P5110T1ParentModel +public import LeanPool.ApollonianSuperharmonic.P5110T1PositiveParentTriples +public import LeanPool.ApollonianSuperharmonic.P5110T1SquareInterface +public import LeanPool.ApollonianSuperharmonic.P5110T1TranslationTriples +public import LeanPool.ApollonianSuperharmonic.P5116T1PredecessorDeletionDisk +public import LeanPool.ApollonianSuperharmonic.P5116T1UnitDeletionDisk +public import LeanPool.ApollonianSuperharmonic.P5124T1BoundaryGeometry +public import LeanPool.ApollonianSuperharmonic.P5124T1EmptyParents +public import LeanPool.ApollonianSuperharmonic.P5124T1ParentModel +public import LeanPool.ApollonianSuperharmonic.P5124T1ParentPlacement +public import LeanPool.ApollonianSuperharmonic.P5124T1SmallerParents +public import LeanPool.ApollonianSuperharmonic.P5124T1TranslatedDiamonds +public import LeanPool.ApollonianSuperharmonic.P5124T1UnitParents +public import LeanPool.ApollonianSuperharmonic.P5130T5BoundaryConsistency +public import LeanPool.ApollonianSuperharmonic.P5130T5DomainCover +public import LeanPool.ApollonianSuperharmonic.P5130T5MixedOverlaps +public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic +public import LeanPool.ApollonianSuperharmonic.P5130T5PeriodicExtension +public import LeanPool.ApollonianSuperharmonic.P5130T5Prescription +public import LeanPool.ApollonianSuperharmonic.P5130T5SameParentOverlaps +public import LeanPool.ApollonianSuperharmonic.P5130T5UnitCase +public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase +public import LeanPool.ApollonianSuperharmonic.P5157T1DiamondSingletonIntersections +public import LeanPool.ApollonianSuperharmonic.P5157T1DiamondStaircaseIntersections +public import LeanPool.ApollonianSuperharmonic.P5157T1StaircasePoint +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingBelow +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingStability +public import LeanPool.ApollonianSuperharmonic.P5188T1E1Boundary +public import LeanPool.ApollonianSuperharmonic.P5188T1E2Boundary +public import LeanPool.ApollonianSuperharmonic.P5188T1E3E4Boundary +public import LeanPool.ApollonianSuperharmonic.P5203T1CapInterface +public import LeanPool.ApollonianSuperharmonic.P5203T1DecreasingInterface +public import LeanPool.ApollonianSuperharmonic.P5203T1IncreasingInterface +public import LeanPool.ApollonianSuperharmonic.P5250T1CommonVertices +public import LeanPool.ApollonianSuperharmonic.P5250T1ConsecutiveEdges +public import LeanPool.ApollonianSuperharmonic.P5250T1RankedCommonEdges +public import LeanPool.ApollonianSuperharmonic.P5250T1SeparatedCells +public import LeanPool.ApollonianSuperharmonic.P5253T1BottomSquareContact +public import LeanPool.ApollonianSuperharmonic.P5253T1LeftSquareContacts +public import LeanPool.ApollonianSuperharmonic.P5253T1OneEdgeInterface +public import LeanPool.ApollonianSuperharmonic.P5253T1SingletonBoundary +public import LeanPool.ApollonianSuperharmonic.P5253T1TopSquareContacts +public import LeanPool.ApollonianSuperharmonic.P5260T1LiteralPlacement +public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger +public import LeanPool.ApollonianSuperharmonic.P5260T1PredecessorInterfaces +public import LeanPool.ApollonianSuperharmonic.P5260T1UnitInterfaces +public import LeanPool.ApollonianSuperharmonic.P5269T1CenteredSquareTripleTransport +public import LeanPool.ApollonianSuperharmonic.P5269T1FordSquareNormalForm +public import LeanPool.ApollonianSuperharmonic.P5269T1IncomingSquareJunctions +public import LeanPool.ApollonianSuperharmonic.P5290T1ColumnReflection +public import LeanPool.ApollonianSuperharmonic.P5290T1EqualDiamondPaths +public import LeanPool.ApollonianSuperharmonic.P5290T1PredecessorPath +public import LeanPool.ApollonianSuperharmonic.P5290T1RawBoundaryInterfaces +public import LeanPool.ApollonianSuperharmonic.P5290T1UnitContactPaths +public import LeanPool.ApollonianSuperharmonic.P5300T1AffineCellObservables +public import LeanPool.ApollonianSuperharmonic.P5300T1CanonicalRowArithmetic +public import LeanPool.ApollonianSuperharmonic.P5300T1CenteredCellGeometry +public import LeanPool.ApollonianSuperharmonic.P5327T1RightSquareJunctions +public import LeanPool.ApollonianSuperharmonic.P5332T1LiteralNormalization +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent1Rotation0Values +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent1Rotation1Values +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent1Rotation2Values +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent1Rotation3Values +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent2Rotation0Values +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent2Rotation1Values +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent2Rotation2Values +public import LeanPool.ApollonianSuperharmonic.P5332T1Parent2Rotation3Values +public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRounding +public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows +public import LeanPool.ApollonianSuperharmonic.P5332T1RightFirstValues +public import LeanPool.ApollonianSuperharmonic.P5332T1RightHorizontalValues +public import LeanPool.ApollonianSuperharmonic.P5332T1RightRounding +public import LeanPool.ApollonianSuperharmonic.P5332T1RightRows +public import LeanPool.ApollonianSuperharmonic.P5332T1RightSecondValues +public import LeanPool.ApollonianSuperharmonic.P5332T1SignedParentIntervals +public import LeanPool.ApollonianSuperharmonic.P5332T1Stencil +public import LeanPool.ApollonianSuperharmonic.P5332T1VectorPlacements +public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows +public import LeanPool.ApollonianSuperharmonic.P5352T2FirstUnit +public import LeanPool.ApollonianSuperharmonic.P5352T2LiteralNormalization +public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData +public import LeanPool.ApollonianSuperharmonic.P5352T2Predecessor0 +public import LeanPool.ApollonianSuperharmonic.P5352T2Predecessor1 +public import LeanPool.ApollonianSuperharmonic.P5352T2Predecessor2 +public import LeanPool.ApollonianSuperharmonic.P5352T2Predecessor3 +public import LeanPool.ApollonianSuperharmonic.P5352T2RightFirst +public import LeanPool.ApollonianSuperharmonic.P5352T2RightHorizontal +public import LeanPool.ApollonianSuperharmonic.P5352T2RightSecond +public import LeanPool.ApollonianSuperharmonic.P5352T2SecondUnit +public import LeanPool.ApollonianSuperharmonic.P5352T2SourceCertificates +public import LeanPool.ApollonianSuperharmonic.P5352T2Sources +public import LeanPool.ApollonianSuperharmonic.P5352T2VectorPlacements +public import LeanPool.ApollonianSuperharmonic.P5416T1DiamondAxialDifferences +public import LeanPool.ApollonianSuperharmonic.P5416T1SecondUnitGeometry +public import LeanPool.ApollonianSuperharmonic.P5432T1EdgeLedger +public import LeanPool.ApollonianSuperharmonic.P5432T1Interior +public import LeanPool.ApollonianSuperharmonic.P5432T1Normalization +public import LeanPool.ApollonianSuperharmonic.P5435T1Cocycle +public import LeanPool.ApollonianSuperharmonic.P5435T1PeriodGap +public import LeanPool.ApollonianSuperharmonic.P5435T1ShellPaths +public import LeanPool.ApollonianSuperharmonic.P5435T1WebGeometry +public import LeanPool.ApollonianSuperharmonic.P5442T1Cocycle +public import LeanPool.ApollonianSuperharmonic.P5442T1LaplacianBound +public import LeanPool.ApollonianSuperharmonic.P5442T1WebGeometry +public import LeanPool.ApollonianSuperharmonic.P5448T1CanonicalFordBoundary +public import LeanPool.ApollonianSuperharmonic.P5448T1CenteredFordGeometry +public import LeanPool.ApollonianSuperharmonic.P5448T1CommonAffineFordPair +public import LeanPool.ApollonianSuperharmonic.P5455T2AlignedPredecessor +public import LeanPool.ApollonianSuperharmonic.P5455T2CurvatureGrowth +public import LeanPool.ApollonianSuperharmonic.P5455T2LeftRegressions +public import LeanPool.ApollonianSuperharmonic.P5455T2OccurrenceDeterministic +public import LeanPool.ApollonianSuperharmonic.P5455T2OccurrenceExists +public import LeanPool.ApollonianSuperharmonic.P5455T2OccurrenceRotation +public import LeanPool.ApollonianSuperharmonic.P5455T2RightRegressions +public import LeanPool.ApollonianSuperharmonic.P5455T2RootAlignment +public import LeanPool.ApollonianSuperharmonic.P5455T2WholeJoin +public import LeanPool.ApollonianSuperharmonic.P5472T1AffineDifferenceTransport +public import LeanPool.ApollonianSuperharmonic.P5472T1CyclicAffineCommutation +public import LeanPool.ApollonianSuperharmonic.P5472T1CyclicPhaseCovariance +public import LeanPool.ApollonianSuperharmonic.P5472T1FordNormalization +public import LeanPool.ApollonianSuperharmonic.P5472T1FordSlopeDifference +public import LeanPool.ApollonianSuperharmonic.P5472T1LiteralFordPlacement +public import LeanPool.ApollonianSuperharmonic.P5478T1ExteriorPlacementIndex +public import LeanPool.ApollonianSuperharmonic.P5485T1FullInterfaceMarking +public import LeanPool.ApollonianSuperharmonic.P5485T1OtherCompanionCoordinates +public import LeanPool.ApollonianSuperharmonic.P5485T1RoutedInterfaceAvoidance +public import LeanPool.ApollonianSuperharmonic.P5491T1AffinePairReduction +public import LeanPool.ApollonianSuperharmonic.P5491T1DiamondParentBoundary +public import LeanPool.ApollonianSuperharmonic.P5491T1DiamondRightBoundary +public import LeanPool.ApollonianSuperharmonic.P5491T1ExceptionalPresentation +public import LeanPool.ApollonianSuperharmonic.P5491T1FordBoundarySlope +public import LeanPool.ApollonianSuperharmonic.P5491T1FordParentBoundary +public import LeanPool.ApollonianSuperharmonic.P5491T1FordRightBoundary +public import LeanPool.ApollonianSuperharmonic.P5532T1FiniteOrientationGluing +public import LeanPool.ApollonianSuperharmonic.P5532T1ForestAttachment +public import LeanPool.ApollonianSuperharmonic.P5532T1OrientationPullback +public import LeanPool.ApollonianSuperharmonic.P5532T1OverlapNoEntry +public import LeanPool.ApollonianSuperharmonic.P5532T1ParentInteriorGeometry +public import LeanPool.ApollonianSuperharmonic.P5532T1RestrictionMassBalance +public import LeanPool.ApollonianSuperharmonic.P5532T1SymmetryOrientationTransport +public import LeanPool.ApollonianSuperharmonic.P5537T1PredecessorCoordinates +public import LeanPool.ApollonianSuperharmonic.P5537T1PredecessorValues +public import LeanPool.ApollonianSuperharmonic.P5537T1ScaledDiamondFormula +public import LeanPool.ApollonianSuperharmonic.P5537T1UnitParentBoundary +public import LeanPool.ApollonianSuperharmonic.P5570T1UnitNormalForm +public import LeanPool.ApollonianSuperharmonic.P5570T1UnitQuadratic +public import LeanPool.ApollonianSuperharmonic.P5589T1EndpointCompatibility +public import LeanPool.ApollonianSuperharmonic.P5589T1LinkedUnitValues +public import LeanPool.ApollonianSuperharmonic.P5589T1UnitInterfaceSelection +public import LeanPool.ApollonianSuperharmonic.P5596T1CommonExtensionTransport +public import LeanPool.ApollonianSuperharmonic.P5596T1LeftWeb +public import LeanPool.ApollonianSuperharmonic.P5596T1LineParent +public import LeanPool.ApollonianSuperharmonic.P5606T1RightTerminalTransport +public import LeanPool.ApollonianSuperharmonic.P5606T1SubtileTerminalTransport +public import LeanPool.ApollonianSuperharmonic.P5617T1RectangleReachabilityAndBasepointConnectivity +public import LeanPool.ApollonianSuperharmonic.P5620T1BoundaryComponentCycle +public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance +public import LeanPool.ApollonianSuperharmonic.P5630T1MarkedRightOdometerAdjacencyReduction +public import LeanPool.ApollonianSuperharmonic.P5630T1SymmetricMatrixPositivityCriterion +public import LeanPool.ApollonianSuperharmonic.P5635T1EndpointDiagonalOwnership +public import LeanPool.ApollonianSuperharmonic.P5635T1RightBoundaryInterfaceRecords +public import LeanPool.ApollonianSuperharmonic.P5640T1NonpairedOccurrenceIntersections +public import LeanPool.ApollonianSuperharmonic.P5658T1FivePointDomainCoverSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.P5662T1TriangulationBarycentricCoordinates +public import LeanPool.ApollonianSuperharmonic.P5667T1CyclicChildrenOldArcsPreconnected +public import LeanPool.ApollonianSuperharmonic.P5667T1RoundedSupportingSlope +public import LeanPool.ApollonianSuperharmonic.P5667T1StraightFrontierLocalSides +public import LeanPool.ApollonianSuperharmonic.P5682T1AlignedSquareRawInterfaces +public import LeanPool.ApollonianSuperharmonic.P5686T1UniformGlobalOdometerTransport +public import LeanPool.ApollonianSuperharmonic.P5691T1DiamondReflectionFootprints +public import LeanPool.ApollonianSuperharmonic.P5691T1PosDefQuadraticLowerBound +public import LeanPool.ApollonianSuperharmonic.PSDQuadraticIntegerApproximation +public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice +public import LeanPool.ApollonianSuperharmonic.ParentalOrientationGluing +public import LeanPool.ApollonianSuperharmonic.PartialOdometer +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslate +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurn +public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares +public import LeanPool.ApollonianSuperharmonic.PeriodicBoundaryWebConnected +public import LeanPool.ApollonianSuperharmonic.PeriodicBoundaryWebLaplacian +public import LeanPool.ApollonianSuperharmonic.PeriodicOdometerIndicatorRigidity +public import LeanPool.ApollonianSuperharmonic.PeriodicQuadraticRemainder +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileFaceIndex +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileAdjacentContactRegularity +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileContactRouting +public import LeanPool.ApollonianSuperharmonic.PeriodicTileContactRoutingRigidity +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCoverage +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileTotalIndegree +public import LeanPool.ApollonianSuperharmonic.PlaneEmbeddingAgreement +public import LeanPool.ApollonianSuperharmonic.PlaneFaceOrientation +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation +public import LeanPool.ApollonianSuperharmonic.PointwiseDiagonalCompactness +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureGeneratorCocycles +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTranslatedOdometers +public import LeanPool.ApollonianSuperharmonic.PositiveCutCompanionRow +public import LeanPool.ApollonianSuperharmonic.PositiveDefiniteRepresentativeGap +public import LeanPool.ApollonianSuperharmonic.PositiveTracePackingDichotomy +public import LeanPool.ApollonianSuperharmonic.Preamble +public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.QuadraticAffineLaplacian +public import LeanPool.ApollonianSuperharmonic.QuadraticGrowthAtInfinity +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricExactInterfaceTransport +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricOccurrence +public import LeanPool.ApollonianSuperharmonic.RealFourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.RealLaplacianContactComparison +public import LeanPool.ApollonianSuperharmonic.RealLaplacianLinearity +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorsExistUnique +public import LeanPool.ApollonianSuperharmonic.RegularTileFamily +public import LeanPool.ApollonianSuperharmonic.RegularTileFamilyTranslationUnique +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.RightSubtileOdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.RootedFourNeighborForest +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycleSubgraphDegreeTwo +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEndpointPairUnique +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceLabel +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.SixSubtileLabel +public import LeanPool.ApollonianSuperharmonic.StandardSimplex +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretationCovariance +public import LeanPool.ApollonianSuperharmonic.SufficientBoundedMaximality +public import LeanPool.ApollonianSuperharmonic.SuperharmonicDownwardClosure +public import LeanPool.ApollonianSuperharmonic.SwappedAffineTriangularChartAlignment +public import LeanPool.ApollonianSuperharmonic.SymmetricMatrixCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.SymmetricMatrixCoordinates +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateBaseTables +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateNormLaw +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinatePolarizationLaw +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateRotation +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateSuccessorNorm +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateSuccessorPolarization +public import LeanPool.ApollonianSuperharmonic.ThreeOwnerDesignatedOppositePair +public import LeanPool.ApollonianSuperharmonic.TileArea +public import LeanPool.ApollonianSuperharmonic.TileBordering +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileHalfTurn +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.TileOdometerExists +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurn +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileReflection +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.TileString +public import LeanPool.ApollonianSuperharmonic.TileStringCentralCovariance +public import LeanPool.ApollonianSuperharmonic.TileStringCoordinateTransport +public import LeanPool.ApollonianSuperharmonic.TileStringExists +public import LeanPool.ApollonianSuperharmonic.TileStringRegularFamilyCentralCovariance +public import LeanPool.ApollonianSuperharmonic.TileStringUnique +public import LeanPool.ApollonianSuperharmonic.TileSubodometer +public import LeanPool.ApollonianSuperharmonic.TileSubodometerLiteralDecompositionPiece +public import LeanPool.ApollonianSuperharmonic.TileT1DiskArea +public import LeanPool.ApollonianSuperharmonic.TileT2QuarterTurn +public import LeanPool.ApollonianSuperharmonic.TileT3TranslateTouching +public import LeanPool.ApollonianSuperharmonic.TileT4ParentTranslateTouching +public import LeanPool.ApollonianSuperharmonic.TileT5ParentTouching +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TilingLattice +public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis +public import LeanPool.ApollonianSuperharmonic.TilingLatticeCocycleExtension +public import LeanPool.ApollonianSuperharmonic.TilingLatticeInclusion +public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk +public import LeanPool.ApollonianSuperharmonic.TopologicalDiskExponentialLift +public import LeanPool.ApollonianSuperharmonic.TopologicalDiskGridRayCrossingIndexZero +public import LeanPool.ApollonianSuperharmonic.TopologicalDiskLocallyPuncturedPreconnected +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations +public import LeanPool.ApollonianSuperharmonic.TraceNonpositivePackingApproximation +public import LeanPool.ApollonianSuperharmonic.TranslatedMinimumEnvelope +public import LeanPool.ApollonianSuperharmonic.TriangularBoundaryStrip +public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TriangularMaxIncrement +public import LeanPool.ApollonianSuperharmonic.TriangularSignedHeight +public import LeanPool.ApollonianSuperharmonic.TriangularStripSegment +public import LeanPool.ApollonianSuperharmonic.TriangularStripSegmentOrderInterval +public import LeanPool.ApollonianSuperharmonic.UniqueBoundedGridComplementComponent +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique +public import LeanPool.ApollonianSuperharmonic.UnitSquareOpposingStripInterfacePath +public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep +public import LeanPool.ApollonianSuperharmonic.VectorDeterminant +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct diff --git a/LeanPool/ApollonianSuperharmonic/IncomingSuperbasisRelation.lean b/LeanPool/ApollonianSuperharmonic/IncomingSuperbasisRelation.lean new file mode 100644 index 0000000000..7a93975b8d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/IncomingSuperbasisRelation.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: IncomingSuperbasisRelation] + +/-! +# IncomingSuperbasisRelation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem IncomingSuperbasisRelation (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) : + (∑ j : Fin 3, BandVectors.1 (q j.succ) (q 0)) = 0 ∧ + (∑ j : Fin 3, BandVectors.2 (q j.succ) (q 0)) = 0 := by +-- BODY + have firstLaw := VectorRecursionLaws q hq.1 + have rotated : ProperBandQuadruple (![q 0, q 2, q 3, q 1]) := by + refine ⟨SemiProperQuadruple.rotate hq.1, ?_⟩ + intro j + fin_cases j + · simpa using hq.2 1 + · simpa using hq.2 2 + · simpa using hq.2 0 + have secondLaw := VectorRecursionLaws (![q 0, q 2, q 3, q 1]) rotated.1 + have rotatedAgain : ProperBandQuadruple (![q 0, q 3, q 1, q 2]) := by + refine ⟨SemiProperQuadruple.rotate rotated.1, ?_⟩ + intro j + fin_cases j + · simpa using hq.2 2 + · simpa using hq.2 0 + · simpa using hq.2 1 + have thirdLaw := VectorRecursionLaws (![q 0, q 3, q 1, q 2]) rotatedAgain.1 + rcases firstLaw with ⟨sumFirst, sumSecond, incomingFirst, incomingSecond, _⟩ + rcases secondLaw with ⟨_, _, rotatedFirst, rotatedSecond, _⟩ + rcases thirdLaw with ⟨_, _, rotatedAgainFirst, rotatedAgainSecond, _⟩ + simp? at rotatedFirst rotatedSecond rotatedAgainFirst rotatedAgainSecond + simp? [Fin.sum_univ_succ] + constructor + · rw [incomingFirst, rotatedFirst, rotatedAgainFirst] + calc + _ = (1 - (⟨0, 1⟩ : GaussianInt)) * + (BandVectors.1 (q 1) (q 3) + + BandVectors.1 (q 2) (q 1) + BandVectors.1 (q 3) (q 2)) := by ring + _ = 0 := by + rw [show BandVectors.1 (q 1) (q 3) + + BandVectors.1 (q 2) (q 1) + BandVectors.1 (q 3) (q 2) = 0 by + calc + _ = BandVectors.1 (q 3) (q 2) + + BandVectors.1 (q 1) (q 3) + BandVectors.1 (q 2) (q 1) := by ring + _ = 0 := sumFirst] + simp + · rw [incomingSecond, rotatedSecond, rotatedAgainSecond] + calc + _ = (1 + (⟨0, 1⟩ : GaussianInt)) * + (BandVectors.2 (q 1) (q 3) + + BandVectors.2 (q 2) (q 1) + BandVectors.2 (q 3) (q 2)) := by ring + _ = 0 := by + rw [show BandVectors.2 (q 1) (q 3) + + BandVectors.2 (q 2) (q 1) + BandVectors.2 (q 3) (q 2) = 0 by + calc + _ = BandVectors.2 (q 3) (q 2) + + BandVectors.2 (q 1) (q 3) + BandVectors.2 (q 2) (q 1) := by ring + _ = 0 := sumSecond] + simp + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/IntegerCeilDiv.lean b/LeanPool/ApollonianSuperharmonic/IntegerCeilDiv.lean new file mode 100644 index 0000000000..5ce9f455b3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/IntegerCeilDiv.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: IntegerCeilDiv] + +/-! +# IntegerCeilDiv + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For integers $a$ and nonzero $b$, write +$$ + \operatorname{cdiv}(a,b)=-\bigl((-a)\mathbin{\mathrm{div}}b\bigr). +$$ +When $b>0$, this is the integer ceiling $\lceil a/b\rceil$. +-/ +def IntegerCeilDiv (a b : Int) (_hb : b ≠ 0) : Int := +-- BODY + -((-a) / b) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/IntegerLaplacianCastBridge.lean b/LeanPool/ApollonianSuperharmonic/IntegerLaplacianCastBridge.lean new file mode 100644 index 0000000000..972edb87a4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/IntegerLaplacianCastBridge.lean @@ -0,0 +1,33 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.RealFourNeighborLaplacian + +-- [TABLET NODE: IntegerLaplacianCastBridge] + +/-! +# IntegerLaplacianCastBridge + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem IntegerLaplacianCastBridge (f : IntegerLatticeFunction) + (x : GaussianInt) : + RealFourNeighborLaplacian (fun y => (f y : Real)) x = + (FourNeighborLaplacian f x : Real) := by +-- BODY + simp [RealFourNeighborLaplacian, FourNeighborLaplacian] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/IntegerLatticeFunction.lean b/LeanPool/ApollonianSuperharmonic/IntegerLatticeFunction.lean new file mode 100644 index 0000000000..4b58149944 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/IntegerLatticeFunction.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: IntegerLatticeFunction] + +/-! +# IntegerLatticeFunction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +An integer lattice function is a function $f:\mathbb Z[i]\to\mathbb Z$. +We identify $\mathbb Z[i]$ with the square lattice $\mathbb Z^2$ by real and +imaginary coordinates. +-/ +abbrev IntegerLatticeFunction := +-- BODY + GaussianInt → ℤ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/IntegerPreservingNormalization.lean b/LeanPool/ApollonianSuperharmonic/IntegerPreservingNormalization.lean new file mode 100644 index 0000000000..f0eec727c9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/IntegerPreservingNormalization.lean @@ -0,0 +1,204 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicRepresentative +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm +public import LeanPool.ApollonianSuperharmonic.QuadraticGrowthAtInfinity + +-- [TABLET NODE: IntegerPreservingNormalization] + +/-! +# IntegerPreservingNormalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem IntegerPreservingNormalization + (A B : Matrix (Fin 2) (Fin 2) Real) + (f : IntegerLatticeFunction) + (hrep : IntegerSuperharmonicRepresentative A f) + (delta : Real) (hdelta : 0 < delta) + (hB : B = A - delta • (1 : Matrix (Fin 2) (Fin 2) Real)) : + exists z : GaussianInt, exists n : Fin 2 -> Int, + exists b : Fin 2 -> Real, exists u : IntegerLatticeFunction, + (forall i, b i = + (Matrix.mulVec B ![(z.re : Real), (z.im : Real)]) i - n i) /\ + (forall i, abs (b i) <= 1) /\ + (forall x, u x = f (x + z) - f z - n 0 * x.re - n 1 * x.im) /\ + u 0 = 0 /\ + (forall x, FourNeighborLaplacian u x <= 1) /\ + (forall x, LatticeQuadraticForm B x + + dotProduct b ![(x.re : Real), (x.im : Real)] <= (u x : Real)) := by +-- BODY + rcases hrep with ⟨hAs, hQg, hflap⟩ + have hBs : B.IsSymm := by + rw [hB] + exact hAs.sub (Matrix.isSymm_one.smul delta) + have hqdiff (x : GaussianInt) : + LatticeQuadraticForm A x - LatticeQuadraticForm B x = + (delta / 2) * ((x.re : Real)^2 + (x.im : Real)^2) := by + rw [hB] + simp [LatticeQuadraticForm, Matrix.mulVec, + dotProduct, Fin.sum_univ_two] + ring_nf + have hdiv : ∀ M : Real, ∃ R : Real, ∀ x : GaussianInt, + R ≤ (x.re : Real)^2 + (x.im : Real)^2 → + M ≤ (f x : Real) - LatticeQuadraticForm B x := by + intro M + obtain ⟨R0, hR0⟩ := hQg (delta / 8) (by linarith) + refine ⟨max R0 (max (4 * M / delta) 0), ?_⟩ + intro x hx + have hfx := hR0 x (le_trans (le_max_left _ _) hx) + have hpos : 0 ≤ (x.re : Real)^2 + (x.im : Real)^2 := by positivity + have hmain : + (delta / 4) * ((x.re : Real)^2 + (x.im : Real)^2) ≤ + (f x : Real) - LatticeQuadraticForm B x := by + have he : -(delta / 8 * ((x.re : Real)^2 + (x.im : Real)^2)) ≤ + (f x : Real) - LatticeQuadraticForm A x := neg_le_of_abs_le hfx + rw [show (f x : Real) - LatticeQuadraticForm B x = + (LatticeQuadraticForm A x - LatticeQuadraticForm B x) + + ((f x : Real) - LatticeQuadraticForm A x) by ring] + rw [hqdiff] + have hnon : 0 ≤ delta * ((x.re : Real)^2 + (x.im : Real)^2) := + mul_nonneg (le_of_lt hdelta) hpos + linarith + have hR : 4 * M / delta ≤ + (x.re : Real)^2 + (x.im : Real)^2 := + le_trans (le_trans (le_max_left (4 * M / delta) 0) + (le_max_right R0 (max (4 * M / delta) 0))) hx + have hR' : 4 * M ≤ delta * + ((x.re : Real)^2 + (x.im : Real)^2) := by + simpa [mul_comm] using (div_le_iff₀ hdelta).mp hR + nlinarith + obtain ⟨R0, hR0⟩ := hdiv ((f 0 : Real) - LatticeQuadraticForm B 0) + let radius : Real := max R0 1 + let S : Set GaussianInt := {x | (x.re : Real)^2 + (x.im : Real)^2 < radius} + obtain ⟨N, hN⟩ := exists_nat_ge radius + have hR : radius ≤ (N : Real) := hN + have hNo : (1 : Real) ≤ (N : Real) := le_trans (le_max_right R0 1) hN + have hS : S.Finite := by + have hx_of_mem (x : GaussianInt) (hx : x ∈ S) : + -(N : Int) ≤ x.re ∧ x.re ≤ N ∧ -(N : Int) ≤ x.im ∧ x.im ≤ N := by + dsimp [S, radius] at hx + have hr : -(N : Real) ≤ (x.re : Real) := by + nlinarith [sq_nonneg (x.im : Real), sq_nonneg ((x.re : Real) + N), hR, hNo] + have hr' : (x.re : Real) ≤ (N : Real) := by + nlinarith [sq_nonneg (x.im : Real), sq_nonneg ((x.re : Real) - N), hR, hNo] + have hi : -(N : Real) ≤ (x.im : Real) := by + nlinarith [sq_nonneg (x.re : Real), sq_nonneg ((x.im : Real) + N), hR, hNo] + have hi' : (x.im : Real) ≤ (N : Real) := by + nlinarith [sq_nonneg (x.re : Real), sq_nonneg ((x.im : Real) - N), hR, hNo] + exact ⟨by exact_mod_cast hr, by exact_mod_cast hr', + by exact_mod_cast hi, by exact_mod_cast hi'⟩ + let encode (x : S) : Fin (2 * N + 1) × Fin (2 * N + 1) := + ⟨⟨(x.1.re + N).toNat, by + have hxs := hx_of_mem x.1 x.2 + omega⟩, ⟨(x.1.im + N).toNat, by + have hxs := hx_of_mem x.1 x.2 + omega⟩⟩ + let : Finite S := Finite.of_injective encode (by + intro x y hxy + apply Subtype.ext + apply Zsqrtd.ext + · have he := congrArg (fun z => z.1) (congrArg Prod.fst hxy) + have hxn := (hx_of_mem x.1 x.2).1 + have hxp := (hx_of_mem x.1 x.2).2.1 + have hyn := (hx_of_mem y.1 y.2).1 + have hyp := (hx_of_mem y.1 y.2).2.1 + have hxn0 : 0 ≤ x.1.re + N := by omega + have hyn0 : 0 ≤ y.1.re + N := by omega + dsimp [encode] at he + have hxn1 := Int.toNat_of_nonneg hxn0 + have hyn1 := Int.toNat_of_nonneg hyn0 + omega + · have he := congrArg (fun z => z.val) (congrArg Prod.snd hxy) + have hxn := (hx_of_mem x.1 x.2).2.2.1 + have hxp := (hx_of_mem x.1 x.2).2.2.2 + have hyn := (hx_of_mem y.1 y.2).2.2.1 + have hyp := (hx_of_mem y.1 y.2).2.2.2 + have hxn0 : 0 ≤ x.1.im + N := by omega + have hyn0 : 0 ≤ y.1.im + N := by omega + dsimp [encode] at he + have hxn1 := Int.toNat_of_nonneg hxn0 + have hyn1 := Int.toNat_of_nonneg hyn0 + omega) + exact Set.finite_coe_iff.mp (by infer_instance : Finite S) + have hSne : S.Nonempty := by + refine ⟨0, ?_⟩ + dsimp [S, radius] + norm_num + let energy : GaussianInt → Real := fun y => (f y : Real) - LatticeQuadraticForm B y + obtain ⟨z, hzS, hzmin⟩ := Set.exists_min_image S energy hS hSne + let n : Fin 2 → Int := fun i => + Int.floor ((Matrix.mulVec B ![(z.re : Real), (z.im : Real)]) i) + let b : Fin 2 → Real := fun i => + (Matrix.mulVec B ![(z.re : Real), (z.im : Real)]) i - n i + let u : IntegerLatticeFunction := fun x => + f (x + z) - f z - n 0 * x.re - n 1 * x.im + refine ⟨z, n, b, u, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro i + rfl + · intro i + dsimp [b, n] + have hf := Int.floor_le ((Matrix.mulVec B ![(z.re : Real), (z.im : Real)]) i) + have hg := Int.lt_floor_add_one ((Matrix.mulVec B ![(z.re : Real), (z.im : Real)]) i) + have habs : abs ((Matrix.mulVec B ![(z.re : Real), (z.im : Real)]) i - + (↑⌊(Matrix.mulVec B ![(z.re : Real), (z.im : Real)]) i⌋ : Real)) < 1 := by + rw [abs_lt] + constructor <;> linarith + exact le_of_lt habs + · intro x + rfl + · dsimp [u] + norm_num + · intro x + have hh := hflap (x + z) + dsimp [u, FourNeighborLaplacian] at hh ⊢ + ring_nf at hh ⊢ + exact hh + · intro x + have hglobal : energy z ≤ energy (x + z) := by + by_cases hxin : x + z ∈ S + · exact hzmin (x + z) hxin + · have hlarge : R0 ≤ ((x + z).re : Real)^2 + ((x + z).im : Real)^2 := by + change ¬(((x + z).re : Real)^2 + ((x + z).im : Real)^2) < radius at hxin + exact le_trans (le_max_left R0 1) (le_of_not_gt hxin) + have houtside := hR0 (x + z) hlarge + have hzero : energy z ≤ energy 0 := hzmin 0 (by + dsimp [S, radius] + norm_num) + exact le_trans hzero houtside + have hquadadd (x : GaussianInt) : + LatticeQuadraticForm B (x + z) = + LatticeQuadraticForm B x + LatticeQuadraticForm B z + + dotProduct (Matrix.mulVec B ![(z.re : Real), (z.im : Real)]) + ![(x.re : Real), (x.im : Real)] := by + simp [LatticeQuadraticForm, Matrix.mulVec, dotProduct, Fin.sum_univ_two, + hBs.apply 0 1] + ring + have hineq : LatticeQuadraticForm B x + + dotProduct b ![(x.re : Real), (x.im : Real)] ≤ + (f (x + z) : Real) - f z - n 0 * x.re - n 1 * x.im := by + dsimp [energy] at hglobal + rw [hquadadd x] at hglobal + dsimp [b] + simp [dotProduct, Fin.sum_univ_two] at hglobal ⊢ + linarith + change LatticeQuadraticForm B x + + dotProduct b ![(x.re : Real), (x.im : Real)] ≤ + ((u x : Int) : Real) + simpa [u, Int.cast_sub, Int.cast_mul] using hineq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicCharacterization.lean b/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicCharacterization.lean new file mode 100644 index 0000000000..0ec80dbd74 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicCharacterization.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOdometerTheorem +public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicClosedness +public import LeanPool.ApollonianSuperharmonic.PositiveDefiniteRepresentativeGap +public import LeanPool.ApollonianSuperharmonic.PositiveTracePackingDichotomy +public import LeanPool.ApollonianSuperharmonic.SuperharmonicDownwardClosure +public import LeanPool.ApollonianSuperharmonic.TraceNonpositivePackingApproximation + +-- [TABLET NODE: IntegerSuperharmonicCharacterization] + +/-! +# IntegerSuperharmonicCharacterization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem IntegerSuperharmonicCharacterization + (A : Matrix (Fin 2) (Fin 2) Real) (hA : A.IsSymm) : + (Exists fun g : IntegerLatticeFunction => + IntegerSuperharmonicRepresentative A g) <-> + Or (Exists fun C : BandCircle => + (CircleMatrix C - A).PosSemidef) + (Matrix.trace A <= 0) := by +-- BODY + constructor + · rintro ⟨g, hg⟩ + by_cases htrace : Matrix.trace A <= 0 + · exact Or.inr htrace + · have htrace_pos : 0 < Matrix.trace A := lt_of_not_ge htrace + rcases PositiveTracePackingDichotomy A hA htrace_pos with hpsd | hpd + · exact Or.inl hpsd + · exfalso + rcases hpd with ⟨C, hgap⟩ + rcases BandOdometerTheorem C with ⟨h, hh, hcocycle, hmax⟩ + rcases PositiveDefiniteRepresentativeGap A C g h hg hh hgap with + ⟨hdiv, c, hdom⟩ + let f : IntegerLatticeFunction := fun x => g x + c + have hfdom : forall x, h x <= f x := hdom + have hflap : forall x, FourNeighborLaplacian f x <= 1 := by + intro x + have hgx := hg.2.2 x + dsimp [f, FourNeighborLaplacian] at hgx ⊢ + omega + rcases hmax f hfdom hflap with ⟨B, hB⟩ + rcases hdiv ((B : Real) - (c : Real) + 1) with ⟨R, hR⟩ + obtain ⟨N, hN⟩ := exists_nat_ge (max R 1) + let x : GaussianInt := ⟨N, 0⟩ + have hxlarge : R <= (x.re : Real) ^ 2 + (x.im : Real) ^ 2 := by + have hRN : R <= (N : Real) := le_trans (le_max_left _ _) hN + have hN1 : (1 : Real) <= N := le_trans (le_max_right _ _) hN + have hNsq : (N : Real) <= (N : Real) ^ 2 := by nlinarith + simpa [x] using le_trans hRN hNsq + have hgrowth := hR x hxlarge + have hnonneg : 0 <= f x - h x := by + exact sub_nonneg.mpr (hfdom x) + have hbound := hB x + have hbound_int : ((f x - h x).natAbs : Int) <= B := by + exact_mod_cast hbound + rw [Int.natAbs_of_nonneg hnonneg] at hbound_int + have hbound' : (f x : Real) - (h x : Real) <= B := by + exact_mod_cast hbound_int + simp only [f, Int.cast_add] at hbound' + linarith + · rintro (⟨C, hgap⟩ | htrace) + · rcases BandOdometerTheorem C with ⟨g, hg, hcocycle, hmax⟩ + exact SuperharmonicDownwardClosure A (CircleMatrix C) hA ⟨g, hg⟩ hgap + · rcases TraceNonpositivePackingApproximation A hA htrace with + ⟨Aseq, hconv, Cseq, hgap⟩ + apply IntegerSuperharmonicClosedness Aseq A hconv + intro n + rcases BandOdometerTheorem (Cseq n) with ⟨g, hg, hcocycle, hmax⟩ + have hDsymm : (CircleMatrix (Cseq n) - Aseq n).IsSymm := by + change (CircleMatrix (Cseq n) - Aseq n).transpose = + CircleMatrix (Cseq n) - Aseq n + simpa [Matrix.IsHermitian] using (hgap n).1 + have hAn : (Aseq n).IsSymm := by + change (Aseq n).transpose = Aseq n + change (CircleMatrix (Cseq n)).transpose - (Aseq n).transpose = + CircleMatrix (Cseq n) - Aseq n at hDsymm + rw [hg.1] at hDsymm + ext i j + have hij := congrFun (congrFun hDsymm i) j + simp only [Matrix.sub_apply] at hij + linarith + exact SuperharmonicDownwardClosure + (Aseq n) (CircleMatrix (Cseq n)) hAn ⟨g, hg⟩ (hgap n) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicClosedness.lean b/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicClosedness.lean new file mode 100644 index 0000000000..c7962f52ba --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicClosedness.lean @@ -0,0 +1,160 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Topology.Instances.Matrix +public import LeanPool.ApollonianSuperharmonic.IntegerPreservingNormalization +public import LeanPool.ApollonianSuperharmonic.PointwiseDiagonalCompactness +public import LeanPool.ApollonianSuperharmonic.TranslatedMinimumEnvelope + +-- [TABLET NODE: IntegerSuperharmonicClosedness] + +/-! +# IntegerSuperharmonicClosedness + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem IntegerSuperharmonicClosedness + (Aseq : Nat -> Matrix (Fin 2) (Fin 2) Real) + (A : Matrix (Fin 2) (Fin 2) Real) + (hconv : forall i j, + Filter.Tendsto (fun k => Aseq k i j) Filter.atTop (nhds (A i j))) + (hreps : forall k, exists g : IntegerLatticeFunction, + IntegerSuperharmonicRepresentative (Aseq k) g) : + exists g : IntegerLatticeFunction, + IntegerSuperharmonicRepresentative A g := by +-- BODY + classical + let B : Nat → Matrix (Fin 2) (Fin 2) Real := fun k => + Aseq k - (1 / (k + 1 : Real)) • (1 : Matrix (Fin 2) (Fin 2) Real) + have hBconv : ∀ i j, Filter.Tendsto (fun k => B k i j) Filter.atTop (nhds (A i j)) := by + intro i j + let : ContinuousSub ℝ := by + constructor + rw [Metric.continuous_iff] + intro c e he + refine ⟨e / 2, by positivity, ?_⟩ + intro d hd + rw [Real.dist_eq] + simp only [Prod.dist_eq, Real.dist_eq, max_lt_iff] at hd + have h1 : |d.1 - c.1| < e / 2 := by simpa [abs_sub_comm] using hd.1 + have h2 : |d.2 - c.2| < e / 2 := by simpa [abs_sub_comm] using hd.2 + calc + |(d.1 - d.2) - (c.1 - c.2)| = |(d.1 - c.1) - (d.2 - c.2)| := by ring_nf + _ ≤ |d.1 - c.1| + |d.2 - c.2| := by + simpa [abs_sub_comm] using (abs_sub_le (d.1 - c.1) (0 : ℝ) (d.2 - c.2)) + _ < e := by linarith + have hc : Filter.Tendsto (fun k : Nat => (1 / (k + 1 : Real))) Filter.atTop (nhds 0) := by + rw [Filter.tendsto_def] + intro s hs + rcases (mem_nhds_iff.mp hs) with ⟨t, hts, hto, hzero⟩ + obtain ⟨e, he, hsub⟩ := Metric.isOpen_iff.mp hto 0 hzero + obtain ⟨N, hN⟩ := exists_nat_gt (1 / e) + apply Filter.eventually_atTop.mpr + refine ⟨N, ?_⟩ + intro k hk + apply hts + apply hsub + apply Metric.mem_ball.mpr + rw [Real.dist_eq] + dsimp + simp only [sub_zero] + rw [abs_of_pos (by positivity : (0 : Real) < 1 / (k + 1 : Real))] + rw [div_lt_iff₀ (by positivity : (0 : Real) < k + 1)] + have hkreal : (N : Real) ≤ k := by exact_mod_cast hk + have hk' : (1 / e : Real) < k + 1 := by linarith + have hrec : e * (1 / e : Real) = 1 := by field_simp + nlinarith + by_cases hij : i = j + · subst j + have hs : Filter.Tendsto (fun k : Nat => + Aseq k i i - (1 / (k + 1 : Real))) Filter.atTop (nhds (A i i - 0)) := by + exact (hconv i i).sub hc + simpa [B, Matrix.sub_apply, smul_eq_mul, Matrix.one_apply] using hs + · simpa [B, Matrix.sub_apply, smul_eq_mul, Matrix.one_apply, hij] using hconv i j + have hsymm : ∀ k, (Aseq k).IsSymm := by + intro k + obtain ⟨f, hf⟩ := hreps k + exact hf.1 + have hBsymm : ∀ k, (B k).IsSymm := by + intro k + apply Matrix.IsSymm.sub + · exact hsymm k + · exact (Matrix.isSymm_one).smul _ + have hM : ∃ M : Real, 0 ≤ M ∧ ∀ k, 1 - Matrix.trace (B k) ≤ M := by + let : ContinuousAdd ℝ := by + constructor + rw [Metric.continuous_iff] + intro c e he + refine ⟨e / 2, by positivity, ?_⟩ + intro d hd + rw [Real.dist_eq] + simp only [Prod.dist_eq, Real.dist_eq, max_lt_iff] at hd + calc + |(d.1 + d.2) - (c.1 + c.2)| = |(d.1 - c.1) + (d.2 - c.2)| := by ring_nf + _ ≤ |d.1 - c.1| + |d.2 - c.2| := abs_add_le _ _ + _ < e := by linarith [hd.1, hd.2] + have ht : Filter.Tendsto (fun k => Matrix.trace (B k)) Filter.atTop + (nhds (Matrix.trace A)) := by + simpa only [Matrix.trace_fin_two] using (hBconv 0 0).add (hBconv 1 1) + obtain ⟨N, hN⟩ := Filter.eventually_atTop.mp + (ht (Ioi_mem_nhds (by linarith : Matrix.trace A - 1 < Matrix.trace A))) + let values := (Finset.range (N + 1)).image (fun k => 1 - Matrix.trace (B k)) + have values_ne : values.Nonempty := by + refine ⟨1 - Matrix.trace (B 0), ?_⟩ + exact Finset.mem_image.mpr ⟨0, by simp, rfl⟩ + let M := max 0 (max (values.max' values_ne) (1 - (Matrix.trace A - 1))) + refine ⟨M, le_max_left _ _, ?_⟩ + intro k + by_cases hk : k ≤ N + · have hm : 1 - Matrix.trace (B k) ∈ values := + Finset.mem_image.mpr ⟨k, by simp [hk], rfl⟩ + exact le_trans (Finset.le_max' values _ hm) + (le_trans (le_max_left _ _) (le_max_right _ _)) + · have hlarge : N ≤ k := Nat.le_of_not_ge hk + have hbound : 1 - Matrix.trace (B k) ≤ 1 - (Matrix.trace A - 1) := by + have hkbound := hN k hlarge + change Matrix.trace A - 1 < Matrix.trace (B k) at hkbound + linarith + exact le_trans hbound (le_trans (le_max_right _ _) (le_max_right _ _)) + obtain ⟨M, hM0, htrace⟩ := hM + have hnorm : ∀ k, ∃ b : Fin 2 → Real, ∃ u : IntegerLatticeFunction, + (∀ i, abs (b i) ≤ 1) ∧ u 0 = 0 ∧ + (∀ x, FourNeighborLaplacian u x ≤ 1) ∧ + (∀ x, LatticeQuadraticForm (B k) x + + dotProduct (b) ![(x.re : Real), (x.im : Real)] ≤ (u x : Real)) := by + intro k + obtain ⟨f, hf⟩ := hreps k + obtain ⟨z, n, b, u, hbi, hb, hu, hu0, hlap, hlower⟩ := + IntegerPreservingNormalization (Aseq k) (B k) f hf + (1 / (k + 1 : Real)) (by positivity) (by + ext i j + simp [B, Matrix.sub_apply, smul_eq_mul]) + exact ⟨b, u, hb, hu0, hlap, hlower⟩ + choose b u hb hu0 hulap hulower using hnorm + obtain ⟨phi, hphi, bInf, v, hbconv, hv, hvlap, hvlower⟩ := + PointwiseDiagonalCompactness A B b u M hM0 hBconv hBsymm hb hu0 hulap hulower htrace + obtain ⟨F, g, hF, hFlap, hmin, hgrowth, hg⟩ := TranslatedMinimumEnvelope A (by + apply Matrix.IsSymm.eq + ext i j + have hji := hconv j i + have hij : Filter.Tendsto (fun k => Aseq k j i) Filter.atTop (nhds (A i j)) := by + convert hconv i j using 1 + funext k + have hh := congrArg (fun z => z j) (congrFun (hsymm k).eq i) + simpa using hh + exact tendsto_nhds_unique hji hij) bInf v hvlap hvlower + exact ⟨g, hg⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicRepresentative.lean b/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicRepresentative.lean new file mode 100644 index 0000000000..de41aaaa14 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicRepresentative.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.LinearAlgebra.Matrix.Symmetric +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.QuadraticGrowthAtInfinity + +-- [TABLET NODE: IntegerSuperharmonicRepresentative] + +/-! +# IntegerSuperharmonicRepresentative + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $A$ be a real $2\times2$ matrix and let +$g:\mathbb Z[i]\to\mathbb Z$. We call $g$ an integer superharmonic +representative for $A$ when $A$ is symmetric, $g$ has quadratic growth $A$ +at infinity in the sense of `QuadraticGrowthAtInfinity`, and +$$ + \Delta g(x)\leq1 +$$ +for every lattice point $x$, with $\Delta$ as in +`FourNeighborLaplacian`. +-/ +def IntegerSuperharmonicRepresentative + (A : Matrix (Fin 2) (Fin 2) ℝ) (g : IntegerLatticeFunction) : Prop := +-- BODY + A.IsSymm ∧ QuadraticGrowthAtInfinity A g ∧ + ∀ x, FourNeighborLaplacian g x ≤ 1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/IntegralityLattice.lean b/LeanPool/ApollonianSuperharmonic/IntegralityLattice.lean new file mode 100644 index 0000000000..fc28862268 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/IntegralityLattice.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleMatrix + +-- [TABLET NODE: IntegralityLattice] + +/-! +# IntegralityLattice + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a band circle $C$, identify $u=u_1+iu_2\in\mathbb Z[i]$ with +$(u_1,u_2)\in\mathbb Z^2$ and define +$$ + L_C=\{u\in\mathbb Z[i]:A_C(u_1,u_2)^t\in\mathbb Z^2\}. +$$ +Matrix linearity shows directly that this set contains zero and is closed +under addition and negation, so $L_C$ is regarded as an additive subgroup of +$\mathbb Z[i]$. This is the matrix-integrality lattice from equation (1.5) +of the paper. +-/ +def IntegralityLattice (C : BandCircle) : AddSubgroup GaussianInt where +-- BODY + carrier := {u | ∀ i : Fin 2, ∃ n : ℤ, + Matrix.mulVec (CircleMatrix C) + ![((u.re : ℤ) : ℝ), ((u.im : ℤ) : ℝ)] i = (n : ℝ)} + zero_mem' := by + intro i + refine ⟨0, ?_⟩ + simp [Matrix.mulVec] + add_mem' := by + intro x y hx hy i + obtain ⟨mx, hmx⟩ := hx i + obtain ⟨my, hmy⟩ := hy i + refine ⟨mx + my, ?_⟩ + rw [show ![(((x + y).re : ℤ) : ℝ), (((x + y).im : ℤ) : ℝ)] = + ![((x.re : ℤ) : ℝ), ((x.im : ℤ) : ℝ)] + + ![((y.re : ℤ) : ℝ), ((y.im : ℤ) : ℝ)] by + ext j + fin_cases j <;> simp] + rw [Matrix.mulVec_add, Pi.add_apply, hmx, hmy] + norm_num + neg_mem' := by + intro x hx i + obtain ⟨m, hm⟩ := hx i + refine ⟨-m, ?_⟩ + rw [show ![(((-x).re : ℤ) : ℝ), (((-x).im : ℤ) : ℝ)] = + -![((x.re : ℤ) : ℝ), ((x.im : ℤ) : ℝ)] by + ext j + fin_cases j <;> simp] + rw [Matrix.mulVec_neg, Pi.neg_apply, hm] + norm_num + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/IntegralityLatticeIndex.lean b/LeanPool/ApollonianSuperharmonic/IntegralityLatticeIndex.lean new file mode 100644 index 0000000000..696d5914f1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/IntegralityLatticeIndex.lean @@ -0,0 +1,148 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex +public import LeanPool.ApollonianSuperharmonic.TilingLatticeInclusion +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: IntegralityLatticeIndex] + +/-! +# IntegralityLatticeIndex + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem IntegralityLatticeIndex (C : BandCircle) : + ∃ R : Finset GaussianInt, + LatticeFundamentalSet (IntegralityLattice C) R ∧ + R.card = C.1.1.1.natAbs := by +-- BODY + classical + obtain ⟨S, hS, hScard⟩ := TilingLatticeIndex C + have contain : TilingLattice C ≤ IntegralityLattice C := TilingLatticeInclusion C + let quotientMap : GaussianInt → GaussianInt ⧸ IntegralityLattice C := + QuotientAddGroup.mk' (IntegralityLattice C) + have quotient_surjective : Function.Surjective quotientMap := by + intro x + obtain ⟨y, rfl⟩ := QuotientAddGroup.mk'_surjective (IntegralityLattice C) x + exact ⟨y, rfl⟩ + let representativeMap : S → GaussianInt ⧸ IntegralityLattice C := + fun r => quotientMap r.1 + have representativeMap_surjective : Function.Surjective representativeMap := by + intro x + obtain ⟨y, rfl⟩ := quotient_surjective x + obtain ⟨r, hr, hyr⟩ := (hS y).exists + refine ⟨⟨r, hr⟩, ?_⟩ + apply QuotientAddGroup.eq_iff_sub_mem.mpr + have hneg := (TilingLattice C).neg_mem hyr + exact contain (by simpa [sub_eq_add_neg, add_comm] using hneg) + let : Finite (GaussianInt ⧸ IntegralityLattice C) := + Finite.of_surjective representativeMap representativeMap_surjective + let : Fintype (GaussianInt ⧸ IntegralityLattice C) := Fintype.ofFinite _ + let index : ℕ := Fintype.card (GaussianInt ⧸ IntegralityLattice C) + have index_le : index ≤ C.1.1.1.natAbs := by + dsimp [index] + calc + Fintype.card (GaussianInt ⧸ IntegralityLattice C) ≤ Fintype.card S := + Fintype.card_le_of_surjective representativeMap representativeMap_surjective + _ = S.card := by simp + _ = C.1.1.1.natAbs := hScard + have index_pos : 0 < index := by + dsimp [index] + exact Fintype.card_pos + have card_multiple (z : GaussianInt ⧸ IntegralityLattice C) : + index • z = 0 := by + have hs := Fintype.sum_equiv (Equiv.addLeft z) (fun x => z + x) + (fun x => x) (fun x => rfl) + have hs' : (∑ x : GaussianInt ⧸ IntegralityLattice C, (z + x)) = + ∑ x : GaussianInt ⧸ IntegralityLattice C, x := by + simpa using hs + rw [Finset.sum_add_distrib, Finset.sum_const] at hs' + have hz : index • z + (∑ x : GaussianInt ⧸ IntegralityLattice C, x) = + 0 + (∑ x : GaussianInt ⧸ IntegralityLattice C, x) := by + simp [index] + exact add_right_cancel hz + have multiple (z : GaussianInt) : index • z ∈ IntegralityLattice C := by + have hzero : quotientMap (index • z) = 0 := by + simp [quotientMap, index] + have hmem := QuotientAddGroup.eq_iff_sub_mem.mp hzero + simpa using hmem + have hreal := multiple (1 : GaussianInt) + have himag := multiple (⟨0, 1⟩ : GaussianInt) + have hreal0 := hreal 0 + have himag1 := himag 1 + obtain ⟨n0, hn0⟩ := hreal0 + obtain ⟨n1, hn1⟩ := himag1 + have trace_integral : + index * ((1 + C.1.1.2.re) / (2 * C.1.1.1) : ℝ) + + index * ((1 - C.1.1.2.re) / (2 * C.1.1.1) : ℝ) ∈ Set.range (fun n : ℤ => (n : ℝ)) := by + refine ⟨n0 + n1, ?_⟩ + have hs := congrArg₂ (fun a b : ℝ => a + b) hn0 hn1 + convert hs.symm using 1 <;> + simp [CircleMatrix, BandCircleEuclideanData, Matrix.mulVec]; ring + have index_lower : C.1.1.1.natAbs ≤ index := by + obtain ⟨n, hn⟩ := trace_integral + have hcpos : (0 : ℝ) < C.1.1.1 := by exact_mod_cast C.2 + have hratio : (n : ℝ) = (index : ℝ) / C.1.1.1 := by + calc + (n : ℝ) = (index : ℝ) * ((1 + C.1.1.2.re) / (2 * C.1.1.1)) + + (index : ℝ) * ((1 - C.1.1.2.re) / (2 * C.1.1.1)) := hn + _ = (index : ℝ) / C.1.1.1 := by field_simp; ring + have hnpos : 0 < n := by + have hi : (0 : ℝ) < index := by exact_mod_cast index_pos + have : (0 : ℝ) < (index : ℝ) / C.1.1.1 := div_pos hi hcpos + exact_mod_cast (hratio ▸ this) + have hprod : (n : ℝ) * C.1.1.1 = index := by + rw [hratio] + field_simp + have hprod_int : n * C.1.1.1 = (index : ℤ) := by + exact_mod_cast hprod + have hc_nonneg : (0 : ℤ) ≤ C.1.1.1 := le_of_lt C.2 + have hc_nat : (C.1.1.1.natAbs : ℤ) = C.1.1.1 := Int.natAbs_of_nonneg hc_nonneg + have hnat : (C.1.1.1.natAbs : ℤ) ≤ (index : ℤ) := by + rw [hc_nat, ← hprod_int] + have hn_one : (1 : ℤ) ≤ n := by omega + have hfactor : 0 ≤ (n - 1) * C.1.1.1 := + mul_nonneg (by omega) hc_nonneg + nlinarith + exact_mod_cast hnat + have index_eq : index = C.1.1.1.natAbs := Nat.le_antisymm index_le index_lower + have map_injective : Function.Injective representativeMap := by + intro a b hab + by_contra different + have not_injective : ¬ Function.Injective representativeMap := by + intro injective + exact different (injective hab) + have contradiction := Fintype.card_lt_of_surjective_not_injective + representativeMap representativeMap_surjective not_injective + have same : Fintype.card S = C.1.1.1.natAbs := by simp [hScard] + rw [same, ← index_eq] at contradiction + exact (Nat.lt_irrefl _ contradiction) + refine ⟨S, ?_, ?_⟩ + · intro x + obtain ⟨r, hr, hxr⟩ := (hS x).exists + refine ⟨r, ⟨hr, contain hxr⟩, ?_⟩ + intro s hs + have equal_subtypes : (⟨s, hs.1⟩ : S) = ⟨r, hr⟩ := by + apply map_injective + apply QuotientAddGroup.eq_iff_sub_mem.mpr + have difference := (IntegralityLattice C).sub_mem (contain hxr) hs.2 + convert difference using 1; abel + exact congrArg Subtype.val equal_subtypes + · calc + S.card = C.1.1.1.natAbs := hScard + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/IntegralityTiling.lean b/LeanPool/ApollonianSuperharmonic/IntegralityTiling.lean new file mode 100644 index 0000000000..879f22d28e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/IntegralityTiling.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandLatticeEquality +public import LeanPool.ApollonianSuperharmonic.LambdaTiling + +-- [TABLET NODE: IntegralityTiling] + +/-! +# IntegralityTiling + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem IntegralityTiling : ∀ C : BandCircle, ∃ T : ProtoTile, + LatticeTile T ∧ QuarterTurnSymmetric T ∧ + ExactTileTiling (RegularTileFamily T (IntegralityLattice C)) ∧ + (C.1.1.1 ≠ 1 → + Nat.card {U : ProtoTile // + U ∈ RegularTileFamily T (IntegralityLattice C) ∧ U ≠ T ∧ + TileBordering T U} = 6) := by +-- BODY + intro C + obtain ⟨T, hT, hS, hE, hN⟩ := LambdaTiling C + refine ⟨T, hT, hS, ?_, ?_⟩ + · simpa [BandLatticeEquality C] using hE + · intro hC + simpa [BandLatticeEquality C] using hN hC + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/IsolatedPrecursorCoverage.lean b/LeanPool/ApollonianSuperharmonic/IsolatedPrecursorCoverage.lean new file mode 100644 index 0000000000..71ed1b9aeb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/IsolatedPrecursorCoverage.lean @@ -0,0 +1,298 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileArea +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import LeanPool.ApollonianSuperharmonic.P4638T1AntipodalContactArcs +public import LeanPool.ApollonianSuperharmonic.P4638T1ContactStarCoverage +public import LeanPool.ApollonianSuperharmonic.P4638T1EmptyCurvature +public import LeanPool.ApollonianSuperharmonic.P4638T1EmptyFordLocalization +public import LeanPool.ApollonianSuperharmonic.P4638T1FordIncidentCells +public import LeanPool.ApollonianSuperharmonic.P4638T1MidpointReflection + +-- [TABLET NODE: IsolatedPrecursorCoverage] + +/-! +# IsolatedPrecursorCoverage + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem IsolatedPrecursorCoverage : + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (r : Fin 4 -> CircleCoordinates), (ProperBandQuadruple + q) → ((ProperBandQuadruple r) → ((r 0 = q 1) → ((r 2 = q 2) → ((r 3 = q 3) → (∀ (x : Real + × Real), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : + Fin 3 -> Bool -> ProtoTile), (forall i s, BandPrototile (q i.succ) (P i s)) → ((forall i + s, BandPrototile (r i.succ) (Q i s)) → ((forall i s, BandPrototile (r i.succ) (S i s)) → + ((forall i s, + TileCentroid (P i s) - x = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1)))) → ((forall i s, + TileCentroid (Q i s) - TileCentroid (P 0 true) = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) (r ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) + (r ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) + (r ((i + 1).succ)))).1)))) → ((forall i s, + TileCentroid (S i s) - TileCentroid (P 0 false) = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) (r ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) + (r ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (r ((i + 2).succ)) + (r ((i + 1).succ)))).1)))) → ((forall i s, (Q i s).cells ⊆ (P 0 true).cells) + → ((forall i s, (S i s).cells ⊆ (P 0 false).cells) → ((forall i s, + FootprintVertices (Q i s) ⊆ FootprintVertices (P 0 true)) → ((forall i s, + FootprintVertices (S i s) ⊆ FootprintVertices (P 0 false)) → (((Q 0 false).cells = (S 0 + true).cells) → (((Q 0 false).cells = ∅ -> + (Q 0 false).anchor = (S 0 true).anchor) → ((LatticeTile (TileCellComplement (P 0 true) (Q 0 + false)) ∧ + TileTouching (TileCellComplement (P 0 true) (Q 0 false)) (Q 0 false)) → ((LatticeTile + (TileCellComplement (P 0 false) (S 0 true)) ∧ + TileTouching (TileCellComplement (P 0 false) (S 0 true)) (S 0 true)) → + ((CentrallyReflectedAt (TileCentroid (Q 0 false)) + (TileCellComplement (P 0 true) (Q 0 false)) + (TileCellComplement (P 0 false) (S 0 true))) → ((QuarterTurnSymmetric (Q 0 false)) → (((Q 0 + false).cells ≠ ∅ -> LatticeTile (Q 0 false)) → (((Q 1 true).cells ≠ ∅) → (((S 2 + false).cells ≠ ∅) → (((Q 2 true).cells ≠ ∅) → (((S 1 false).cells ≠ ∅) → + ((TouchingTriple (Q 1 true) (S 2 false) (Q 0 false)) → ((TouchingTriple (Q 2 true) (S 1 + false) (Q 0 false)) → ((TouchingTriple (Q 1 true) (S 2 false) (P 1 true)) → + ((TouchingTriple (Q 1 true) (P 1 true) (P 2 false)) → ((¬ (TileArea (P 2 false) = 1 ∧ + TileArea (P 1 true) = 1)) → ((Disjoint + (TileCellComplement (P 0 true) (Q 0 false)).cells + (TileCellComplement (P 0 false) (S 0 true)).cells) → ((∀ y ∈ FootprintVertices (Q 0 false), + ∀ a : GaussianInt, + y ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) -> + a ∈ (P 0 true).cells ∨ a ∈ (P 0 false).cells) ∧ + Nonempty (PrecursorBoundaryArcData + (TileCellComplement (P 0 true) (Q 0 false)) + (TileCellComplement (P 0 false) (S 0 true)) + (Q 0 false) (S 0 true) (Q 1 true) (S 2 false) + (Q 2 true) (S 1 false)) ∧ + ((Q 0 false).cells = ∅ -> (r 1).1 = 0))))))))))))))))))))))))))))))))) := by + intro q r hq hr hr0 hr2 hr3 x P Q S hP hQ hS hPcent hQcent hScent hQcells hScells hQfoot hSfoot + hcommon hcommonAnchor hcomplementPlus hcomplementMinus hcentral hOsym hOlattice hQnonempty + hSnonempty hQnonemptySecond hSnonemptySecond hcross hcrossSecond houterCross houterChain + hnotExceptional hcomplementDisjoint +-- BODY + classical + have commonCent : TileCentroid (Q 0 false) = TileCentroid (S 0 true) := by + by_cases hn : (Q 0 false).cells.Nonempty + · have hs : (S 0 true).cells.Nonempty := hcommon ▸ hn + simp only [TileCentroid, ite_eq_left hn, ← hcommon] + · have he : (Q 0 false).cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hn + have hs : (S 0 true).cells = ∅ := hcommon.symm.trans he + simp [TileCentroid, he, hs, hcommonAnchor he] + have childComplement (A O U : ProtoTile) (hn : U.cells ≠ ∅) + (hsub : U.cells ⊆ A.cells) + (ht : TileTouching U O ∨ TileTouching O U) : + U.cells ⊆ (TileCellComplement A O).cells := by + by_cases he : O.cells = ∅ + · simpa [TileCellComplement, he] using hsub + have hd : Disjoint U.cells O.cells := by + rcases ht with ht | ht + · rcases ht with ht | ht | ht + · exact ht.2.2.1 + · exact (hn ht.1).elim + · exact (he ht.1).elim + · rcases ht with ht | ht | ht + · exact ht.2.2.1.symm + · exact (he ht.1).elim + · exact (hn ht.1).elim + intro a ha + exact Finset.mem_sdiff.mpr ⟨hsub ha, Finset.disjoint_left.mp hd ha⟩ + have subX := childComplement (P 0 true) (Q 0 false) (Q 1 true) + hQnonempty (hQcells 1 true) (Or.inr hcross.2.2.1) + have sameBoundary : BoundaryFootprintVertices (Q 0 false) = + BoundaryFootprintVertices (S 0 true) := by + by_cases he : (Q 0 false).cells = ∅ + · simp [BoundaryFootprintVertices, he, ← hcommon, hcommonAnchor he] + · have hn := Finset.nonempty_iff_ne_empty.mpr he + have hs : (S 0 true).cells.Nonempty := hcommon ▸ hn + simp only [BoundaryFootprintVertices, ite_eq_left hn, + BoundaryFootprintEdges, ← hcommon] + have sameTouching (T : ProtoTile) : + TileTouching T (Q 0 false) ↔ TileTouching T (S 0 true) := by + have sameEdges : BoundaryFootprintEdges (Q 0 false) = + BoundaryFootprintEdges (S 0 true) := by + simp only [BoundaryFootprintEdges, ← hcommon] + unfold TileTouching + rw [← hcommon, ← sameBoundary, ← sameEdges] + by_cases he : (Q 0 false).cells = ∅ + · rw [hcommonAnchor he] + · simp [he] + have subY' : (S 2 false).cells ⊆ + (TileCellComplement (P 0 false) (S 0 true)).cells := + childComplement _ _ _ hSnonempty (hScells 2 false) + (Or.inl ((sameTouching (S 2 false)).mp hcross.2.1)) + have subU := childComplement (P 0 true) (Q 0 false) (Q 2 true) + hQnonemptySecond (hQcells 2 true) (Or.inr hcrossSecond.2.2.1) + have subV := childComplement (P 0 false) (S 0 true) (S 1 false) + hSnonemptySecond (hScells 1 false) + (Or.inl ((sameTouching (S 1 false)).mp hcrossSecond.2.1)) + have zero := fun he => P4638T1EmptyCurvature (r 1) (Q 0 false) + (hQ 0 false) he + by_cases he : (Q 0 false).cells = ∅ + · have se : (S 0 true).cells = ∅ := hcommon.symm.trans he + have ha : BandPrototile (r 0) (P 0 true) := by + simpa [hr0] using hP 0 true + have hb : BandPrototile (r 0) (P 0 false) := by + simpa [hr0] using hP 0 false + have hAc : TileCentroid (Q 0 false) - TileCentroid (P 0 true) = + -((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (r 3) (r 2)) - + (-(GaussianRealPoint (BandVectors.1 (r 3) (r 2))).2, + (GaussianRealPoint (BandVectors.1 (r 3) (r 2))).1))) := by + simpa using hQcent 0 false + have hBc : TileCentroid (Q 0 false) - TileCentroid (P 0 false) = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (r 3) (r 2)) - + (-(GaussianRealPoint (BandVectors.1 (r 3) (r 2))).2, + (GaussianRealPoint (BandVectors.1 (r 3) (r 2))).1)) := by + have hc := hScent 0 true + rw [← commonCent] at hc + simpa using hc + obtain ⟨F, g, e, h1, h2, hgrid, hincident, hupper, hlower⟩ := + P4638T1EmptyFordLocalization r hr (P 0 true) (P 0 false) (Q 0 false) + ha hb he (zero he) hAc hBc + have cover : ∀ y ∈ FootprintVertices (Q 0 false), ∀ a : GaussianInt, + y ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) → + a ∈ (P 0 true).cells ∨ a ∈ (P 0 false).cells := by + intro y hy a hya + have hy' : y = (Q 0 false).anchor := by + simpa [FootprintVertices, he] using hy + subst y + have hrect := P4638T1FordIncidentCells F.q₁ F.q₂ h1 h2 + (e a - (BandPackingSymmetryTileAction g (Q 0 false)).anchor) + (hincident a hya) + have pull (T : ProtoTile) + (ht : e a ∈ (BandPackingSymmetryTileAction g T).cells) : a ∈ T.cells := by + rw [hgrid T] at ht + obtain ⟨b, hb, hba⟩ := Finset.mem_image.mp ht + exact e.injective hba ▸ hb + rcases hrect with hu | hl + · exact Or.inl (pull _ ((hupper (e a)).mpr hu)) + · exact Or.inr (pull _ ((hlower (e a)).mpr hl)) + have transition (X Y : ProtoTile) (ht : TouchingTriple X Y (Q 0 false)) : + ∀ z : GaussianInt, + z ∈ BoundaryFootprintVertices X ∧ z ∈ BoundaryFootprintVertices Y ∧ + z ∈ BoundaryFootprintVertices (Q 0 false) ↔ z = (Q 0 false).anchor := by + obtain ⟨a, ha, _⟩ := ht.2.2.2 + have hae : a = (Q 0 false).anchor := by + simpa [BoundaryFootprintVertices, he] using ha.2.2 + intro z + constructor + · intro hz + simpa [BoundaryFootprintVertices, he] using hz.2.2 + · intro hz + simpa only [hz, ← hae] using ha + refine ⟨cover, ⟨?_⟩, zero⟩ + exact { + precursor_cells := hcommon + precursor_anchor := hcommonAnchor + first_touching := hcross + second_touching := hcrossSecond + first_plus_child := subX + first_minus_child := subY' + second_plus_child := subU + second_minus_child := subV + a := (Q 0 false).anchor + b := (Q 0 false).anchor + first_transition := transition _ _ hcross + second_transition := transition _ _ hcrossSecond + branch := Or.inr ⟨he, rfl, rfl, hcommonAnchor he, + by simp [BoundaryFootprintVertices, he], + by simp [BoundaryFootprintVertices, se, hcommonAnchor he]⟩ } + · have hn := Finset.nonempty_iff_ne_empty.mpr he + have pairedCent (i : Fin 3) : + (TileCentroid (Q i true)).1 + (TileCentroid (S i false)).1 = + 2 * (TileCentroid (Q 0 false)).1 ∧ + (TileCentroid (Q i true)).2 + (TileCentroid (S i false)).2 = + 2 * (TileCentroid (Q 0 false)).2 := by + have ho := hQcent 0 false + have ho' := hScent 0 true + rw [← commonCent] at ho' + have hp := hQcent i true + have hm := hScent i false + have ho1 := congrArg Prod.fst ho + have ho2 := congrArg Prod.snd ho + have ho1' := congrArg Prod.fst ho' + have ho2' := congrArg Prod.snd ho' + have hp1 := congrArg Prod.fst hp + have hp2 := congrArg Prod.snd hp + have hm1 := congrArg Prod.fst hm + have hm2 := congrArg Prod.snd hm + dsimp at ho1 ho2 ho1' ho2' hp1 hp2 hm1 hm2 + constructor <;> linarith + have hXV := P4638T1MidpointReflection (r 2) (Q 1 true) (S 1 false) + (hQ 1 true) (hS 1 false) (Finset.nonempty_iff_ne_empty.mpr hQnonempty) + (TileCentroid (Q 0 false)) (by + apply Prod.ext + · dsimp; linarith [(pairedCent 1).1] + · dsimp; linarith [(pairedCent 1).2]) + have hYU := P4638T1MidpointReflection (r 3) (S 2 false) (Q 2 true) + (hS 2 false) (hQ 2 true) (Finset.nonempty_iff_ne_empty.mpr hSnonempty) + (TileCentroid (Q 0 false)) (by + apply Prod.ext + · dsimp; linarith [(pairedCent 2).1] + · dsimp; linarith [(pairedCent 2).2]) + obtain ⟨⟨data⟩, hedges⟩ := P4638T1AntipodalContactArcs + (TileCellComplement (P 0 true) (Q 0 false)) + (TileCellComplement (P 0 false) (S 0 true)) + (Q 0 false) (S 0 true) (Q 1 true) (S 2 false) (Q 2 true) (S 1 false) + hn (hOlattice he) hcomplementPlus.1 hcomplementMinus.1 + hcomplementPlus.2 ((sameTouching _).mpr hcomplementMinus.2) + hcomplementDisjoint hcentral hOsym hcommon hcommonAnchor + (Finset.nonempty_iff_ne_empty.mpr hQnonempty) + (Finset.nonempty_iff_ne_empty.mpr hSnonempty) + (Finset.nonempty_iff_ne_empty.mpr hQnonemptySecond) + (Finset.nonempty_iff_ne_empty.mpr hSnonemptySecond) + hcross hcrossSecond subX subY' subU subV hXV hYU + have cover := P4638T1ContactStarCoverage + (TileCellComplement (P 0 true) (Q 0 false)) + (TileCellComplement (P 0 false) (S 0 true)) + (Q 0 false) (S 0 true) (Q 1 true) (S 2 false) (Q 2 true) (S 1 false) + hn (hOlattice he) hcomplementPlus.1 hcomplementMinus.1 + hcomplementPlus.2 ((sameTouching _).mpr hcomplementMinus.2) + hcomplementDisjoint + (Finset.nonempty_iff_ne_empty.mpr hQnonempty) + (Finset.nonempty_iff_ne_empty.mpr hSnonempty) + (Finset.nonempty_iff_ne_empty.mpr hQnonemptySecond) + (Finset.nonempty_iff_ne_empty.mpr hSnonemptySecond) data hedges + refine ⟨?_, ⟨data⟩, zero⟩ + intro y hy a hya + rcases cover y hy a hya with ha | ha | ha + · exact Or.inl (hQcells 0 false ha) + · exact Or.inl (Finset.mem_sdiff.mp ha).1 + · exact Or.inr (Finset.mem_sdiff.mp ha).1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LambdaTiling.lean b/LeanPool/ApollonianSuperharmonic/LambdaTiling.lean new file mode 100644 index 0000000000..f86593e500 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LambdaTiling.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileExists +public import LeanPool.ApollonianSuperharmonic.BandTileTopologyApplication +public import LeanPool.ApollonianSuperharmonic.CurvatureOneTileBase +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.BandGenealogy + +-- [TABLET NODE: LambdaTiling] + +/-! +# LambdaTiling + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem LambdaTiling : ∀ C : BandCircle, ∃ T : ProtoTile, + LatticeTile T ∧ QuarterTurnSymmetric T ∧ + ExactTileTiling (RegularTileFamily T (TilingLattice C)) ∧ + (C.1.1.1 ≠ 1 → + Nat.card {U : ProtoTile // + U ∈ RegularTileFamily T (TilingLattice C) ∧ U ≠ T ∧ + TileBordering T U} = 6) := by +-- BODY + intro C + by_cases hcurv : C.1.1.1 = 1 + · obtain ⟨T, hlat, harea, hsym, htile⟩ := CurvatureOneTileBase C hcurv + exact ⟨T, hlat, hsym, htile, fun hne => False.elim (hne hcurv)⟩ + · obtain ⟨q, hsemi, hqC, hlt, huniq⟩ := Or.resolve_left (BandGenealogy C) hcurv + have hproper : ProperBandQuadruple q := by + refine ⟨hsemi, ?_⟩ + intro j + simpa [hqC] using hlt j + obtain ⟨T, hT⟩ := BandPrototileExists C.1 + obtain ⟨hlat, harea, hcomplements, hsym, hT3, hT4, hT5, hT6⟩ := + BandTileSimultaneousInduction q hproper T (by simpa [hqC] using hT) + obtain ⟨htile, hcard⟩ := + BandTileTopologyApplication C q hproper hqC T (by simpa [hqC] using hT) + exact ⟨T, hlat, hsym, htile, fun _ => hcard⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean new file mode 100644 index 0000000000..aa0cd65273 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean @@ -0,0 +1,1032 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.OrientedTouchingCovariance +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: LatticeAdjacentInterfacePath] + +/-! +# LatticeAdjacentInterfacePath + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace LatticeInterfacePathGeometry + +private theorem band_of_odometer : + (by + classical + exact + ∀ (C : CircleCoordinates), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), (TileOdometer C T + h) → (BandPrototile C T) ) := by + classical + intro C T h ho + induction ho with + | line w x hw => exact BandPrototile.line w x hw + | unit z x T h hT hdom htrans => + cases T with + | mk cells anchor => + simp only [] at hT + subst cells + exact BandPrototile.unit z x anchor + | decompose hq hT hsub hcells hfoot hcent hdom hvalue hcompat hslope => exact hT + +private theorem positive_nonempty : + (by + classical + exact + ∀ (C : CircleCoordinates), ∀ (T : ProtoTile), (BandPrototile C T) → (0 < C.1 → + T.cells.Nonempty) ) := by + classical + intro C T hT + induction hT with + | line w x hw => + intro hpos + simp at hpos + | unit z x a => + intro hpos + exact ⟨x, by simp⟩ + | @decompose q hq S T hS hcells hfoot hcent ih => + intro hpos + have hs := ProperBandCurvatureStructure q hq + have hsome : ∃ i : Fin 3, 0 < (q i.succ).1 := by + by_contra hn + have hz : ∀ i : Fin 3, (q i.succ).1 = 0 := by + intro i + have hn' : ¬ 0 < (q i.succ).1 := by + intro hp + exact hn ⟨i, hp⟩ + exact le_antisymm (by linarith [hs.2.1 i]) (hs.2.1 i) + have h01 := hs.2.2 0 1 (hz 0) (hz 1) + exact (by decide : (0 : Fin 3) ≠ 1) h01 + obtain ⟨i, hi⟩ := hsome + have hchild := ih i true hi + obtain ⟨x, hx⟩ := hchild + exact ⟨x, (hcells x).2 ⟨i, true, hx⟩⟩ + +private theorem incident_boundary : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), (Disjoint U.cells V.cells) → + ((∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells) → ((∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ V.cells) → (x ∈ BoundaryFootprintVertices U ∧ x ∈ + BoundaryFootprintVertices V))) ) := by + classical + intro U V x hd hu hv + have hd' := Finset.disjoint_left.mp hd + constructor + · apply P3161T2IncidentBoundary U x hu + obtain ⟨j, hj⟩ := hv + exact ⟨j, fun h => hd' h hj⟩ + · apply P3161T2IncidentBoundary V x hv + obtain ⟨j, hj⟩ := hu + exact ⟨j, fun h => hd' hj h⟩ + +private theorem boundary_subset_footprint : + (by + classical + exact + ∀ (T : ProtoTile), BoundaryFootprintVertices T ⊆ FootprintVertices T ) := by + classical + intro T x hx + by_cases hne : T.cells.Nonempty + · have hx' : ∃ e ∈ BoundaryFootprintEdges T, x ∈ e := by + simpa [BoundaryFootprintVertices, hne] using hx + obtain ⟨e, he, hxe⟩ := hx' + rcases he with ⟨z, ⟨rfl, hcross⟩ | ⟨rfl, hcross⟩⟩ + · rcases hcross with ⟨hz, _⟩ | ⟨_, hz⟩ + · change x ∈ FootprintVertices T + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + refine ⟨z, hz, ?_⟩ + rcases Finset.mem_insert.mp hxe with h | h + · subst x; exact Or.inl rfl + · have hxz : x = z + 1 := by simpa using h + subst x; exact Or.inr (Or.inl rfl) + · have hz' : z - ⟨0, 1⟩ ∈ T.cells := hz + change x ∈ FootprintVertices T + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + refine ⟨z - ⟨0, 1⟩, hz', ?_⟩ + rcases (Finset.mem_insert.mp hxe) with hxz | hxz + · subst x + exact Or.inr (Or.inr (Or.inl (by simp))) + · have : x = z + 1 := by simpa using hxz + subst x + exact Or.inr (Or.inr (Or.inr (by simp [sub_eq_add_neg, add_comm, add_left_comm]))) + · rcases hcross with ⟨hz, _⟩ | ⟨_, hz⟩ + · change x ∈ FootprintVertices T + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + refine ⟨z, hz, ?_⟩ + rcases (Finset.mem_insert.mp hxe) with hxz | hxz + · subst x + exact Or.inl rfl + · have : x = z + ⟨0, 1⟩ := by simpa using hxz + subst x + exact Or.inr (Or.inr (Or.inl rfl)) + · have hz' : z - 1 ∈ T.cells := hz + change x ∈ FootprintVertices T + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + refine ⟨z - 1, hz', ?_⟩ + rcases (Finset.mem_insert.mp hxe) with hxz | hxz + · subst x + exact Or.inr (Or.inl (by simp)) + · have : x = z + ⟨0, 1⟩ := by simpa using hxz + subst x + exact Or.inr (Or.inr (Or.inr (by simp [sub_eq_add_neg, add_comm, add_left_comm]))) + · simp? [BoundaryFootprintVertices, FootprintVertices, hne] at hx ⊢ + exact hx + +private theorem touching_path : + (by + classical + exact + (∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), (Disjoint U.cells V.cells) → + ((∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells) → ((∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ V.cells) → (x ∈ BoundaryFootprintVertices U ∧ x ∈ + BoundaryFootprintVertices V)))) → ((∀ (T : ProtoTile), BoundaryFootprintVertices T ⊆ + FootprintVertices T) → (∀ (U : ProtoTile), ∀ (V : ProtoTile), (U.cells.Nonempty) → + ((V.cells.Nonempty) → ((TileTouching U V) → (∃ x y, SimpleGridPathBetween + (FootprintVertices U ∩ FootprintVertices V) (FootprintEdges U ∩ FootprintEdges V) x + y))))) ) := by + classical + intro incident_boundary boundary_subset_footprint U V hU hV ht + have ht' := ht + unfold TileTouching at ht' + have hdata : Disjoint U.cells V.cells ∧ + SimpleGridPath (BoundaryFootprintVertices U ∩ BoundaryFootprintVertices V) + (BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V) := by + rcases ht' with hgood | hbad + · rcases hgood with ⟨_, _, hd, hp⟩ + exact ⟨hd, hp⟩ + · rcases hbad with hleft | hright + · exact (Finset.nonempty_iff_ne_empty.mp hU hleft.1).elim + · exact (Finset.nonempty_iff_ne_empty.mp hV hright.1).elim + rcases hdata with ⟨hd, hp⟩ + have hv_eq : FootprintVertices U ∩ FootprintVertices V = + BoundaryFootprintVertices U ∩ BoundaryFootprintVertices V := by + ext x + constructor + · intro hx + have hu : x ∈ FootprintVertices U := hx.1 + have hv : x ∈ FootprintVertices V := hx.2 + simp only [FootprintVertices, ite_eq_left hU, Set.mem_ofPred_eq] at hu + simp only [FootprintVertices, ite_eq_left hV, Set.mem_ofPred_eq] at hv + have hincU : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells := by + obtain ⟨z, hz, hc⟩ := hu + rcases hc with rfl | rfl | rfl | rfl + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using hz⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hz⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hz⟩ + · exact ⟨2, by simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hz⟩ + have hincV : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ V.cells := by + obtain ⟨z, hz, hc⟩ := hv + rcases hc with rfl | rfl | rfl | rfl + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using hz⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hz⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hz⟩ + · exact ⟨2, by simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hz⟩ + obtain ⟨j, hj⟩ := hincU + obtain ⟨k, hk⟩ := hincV + exact incident_boundary U V x hd ⟨j, hj⟩ ⟨k, hk⟩ + · intro hx + exact ⟨boundary_subset_footprint U hx.1, boundary_subset_footprint V hx.2⟩ + rw [hv_eq, CellDisjointCommonEdgesBoundary U V hd] + have hendpoints : ∃ x y, SimpleGridPathBetween + (BoundaryFootprintVertices U ∩ BoundaryFootprintVertices V) + (BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V) x y := by + rcases hp with ⟨p, hn, hl, hv, ha, he⟩ + cases p with + | nil => simp at hl + | cons x p => + cases p with + | nil => simp at hl + | cons z p => + have hne : z :: p ≠ [] := by simp + refine ⟨x, (z :: p).getLast hne, x :: z :: p, hn, hl, rfl, ?_, hv, ha, he⟩ + simpa using List.getLast?_eq_getLast_of_ne_nil hne + exact hendpoints + +private theorem touching_symm : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), TileTouching A B → TileTouching B A ) := by + classical + intro A B h + unfold TileTouching at h ⊢ + rcases h with h | h | h + · rcases h with ⟨ha, hb, hd, hp⟩ + exact Or.inl ⟨hb, ha, hd.symm, by simpa [Set.inter_comm] using hp⟩ + · exact Or.inr (Or.inr h) + · exact Or.inr (Or.inl h) + +private theorem touching_cells_congr : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (A' : ProtoTile), ∀ (B' : ProtoTile), + (A.cells.Nonempty) → ((B.cells.Nonempty) → ((A'.cells.Nonempty) → + ((B'.cells.Nonempty) → ((A.cells = A'.cells) → ((B.cells = B'.cells) → (TileTouching + A B ↔ TileTouching A' B')))))) ) := by + classical + intro A B A' B' hA hB hA' hB' ha hb + have edges (X Y : ProtoTile) (hxy : X.cells = Y.cells) : + BoundaryFootprintEdges X = BoundaryFootprintEdges Y := by + ext e + simp [BoundaryFootprintEdges, hxy] + have verts (X Y : ProtoTile) (hx : X.cells.Nonempty) (hy : Y.cells.Nonempty) + (hxy : X.cells = Y.cells) : + BoundaryFootprintVertices X = BoundaryFootprintVertices Y := by + simp [BoundaryFootprintVertices, hx, hy, edges X Y hxy] + constructor + · intro h + unfold TileTouching at h ⊢ + rcases h with h | h | h + · rcases h with ⟨_, _, hd, hp⟩ + apply Or.inl + refine ⟨hA', hB', ?_, ?_⟩ + · simpa [ha, hb] using hd + · simpa [verts A A' hA hA' ha, verts B B' hB hB' hb, + edges A A' ha, edges B B' hb] using hp + · have he : A'.cells = ∅ := by simpa [← ha] using h.1 + exact (Finset.not_nonempty_iff_eq_empty.mpr he hA').elim + · have he : B'.cells = ∅ := by simpa [← hb] using h.1 + exact (Finset.not_nonempty_iff_eq_empty.mpr he hB').elim + · intro h + unfold TileTouching at h ⊢ + rcases h with h | h | h + · rcases h with ⟨_, _, hd, hp⟩ + apply Or.inl + refine ⟨hA, hB, ?_, ?_⟩ + · simpa [← ha, ← hb] using hd + · simpa [← verts A A' hA hA' ha, ← verts B B' hB hB' hb, + ← edges A A' ha, ← edges B B' hb] using hp + · have : A.cells = ∅ := by simpa [ha] using h.1 + exact (Finset.not_nonempty_iff_eq_empty.mpr this hA).elim + · have h' : B.cells = ∅ := by simpa [hb] using h.1 + exact (Finset.not_nonempty_iff_eq_empty.mpr h' hB).elim + +private theorem quarter_translate : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), TileQuarterTurn (TileTranslation T x) = + TileTranslation (TileQuarterTurn T) (GaussianQuarterTurn x) ) := by + classical + intro T x + cases T with + | mk cells anchor => + apply congrArg₂ (fun c : Finset GaussianInt => fun a : GaussianInt => + (⟨c, a⟩ : ProtoTile)) + · simp? [TileQuarterTurn, TileTranslation, GaussianTranslation, + Finset.image_image, Function.comp_def] + congr 1 + funext z + ext <;> simp [GaussianQuarterTurn]; ring + · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, + GaussianQuarterTurn, add_comm] + +private theorem translation_comm : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), TileTranslation + (TileTranslation T x) y = TileTranslation (TileTranslation T y) x ) := by + classical + intro T x y + cases T with + | mk cells anchor => + apply congrArg₂ (fun c : Finset GaussianInt => fun a : GaussianInt => + (⟨c, a⟩ : ProtoTile)) + · simp [TileTranslation, GaussianTranslation, Finset.image_image, + Function.comp_def, add_comm, add_left_comm] + · simp [TileTranslation, GaussianTranslation, add_comm, add_left_comm] + +private theorem rotate_touch : + (by + classical + exact + (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (A' : ProtoTile), ∀ (B' : ProtoTile), + (A.cells.Nonempty) → ((B.cells.Nonempty) → ((A'.cells.Nonempty) → + ((B'.cells.Nonempty) → ((A.cells = A'.cells) → ((B.cells = B'.cells) → (TileTouching + A B ↔ TileTouching A' B'))))))) → ((∀ (T : ProtoTile), ∀ (x : GaussianInt), + TileQuarterTurn (TileTranslation T x) = TileTranslation (TileQuarterTurn T) + (GaussianQuarterTurn x)) → ((∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), TileTranslation (TileTranslation T x) y = TileTranslation + (TileTranslation T y) x) → (∀ (T : ProtoTile), ∀ (v : GaussianInt), + (T.cells.Nonempty) → ((QuarterTurnSymmetric T) → ((TileTouching T (TileTranslation T + v)) → (TileTouching T (TileTranslation T (GaussianQuarterTurn v)))))))) ) := by + classical + intro touching_cells_congr quarter_translate translation_comm T v hT hSym ht + obtain ⟨u, hu, hcell, _, _, _⟩ := + QuarterTurnSymmetricCenteredTransport T hSym + let V := TileTranslation T v + have hrot := ((TileTouchingCovariance T V 0).2.1).mp (by simpa [V] using ht) + have htrans := ((TileTouchingCovariance (TileQuarterTurn T) + (TileQuarterTurn V) u).1).mp hrot + have hright : (TileTranslation (TileQuarterTurn V) u).cells = + (TileTranslation T (GaussianQuarterTurn v)).cells := by + calc + (TileTranslation (TileQuarterTurn V) u).cells = + (TileTranslation (TileTranslation (TileQuarterTurn T) + (GaussianQuarterTurn v)) u).cells := by + rw [show TileQuarterTurn V = + TileTranslation (TileQuarterTurn T) (GaussianQuarterTurn v) from + quarter_translate T v] + _ = (TileTranslation (TileTranslation (TileQuarterTurn T) u) + (GaussianQuarterTurn v)).cells := by + rw [translation_comm (TileQuarterTurn T) (GaussianQuarterTurn v) u] + _ = (TileTranslation T (GaussianQuarterTurn v)).cells := by + rw [(TileTranslationFormulas (TileTranslation (TileQuarterTurn T) u) + (GaussianQuarterTurn v)).1, + (TileTranslationFormulas T (GaussianQuarterTurn v)).1, hcell] + have hcenterNonempty : (TileTranslation (TileQuarterTurn T) u).cells.Nonempty := by + rw [hcell] + exact hT + have hrightNonempty : (TileTranslation (TileQuarterTurn V) u).cells.Nonempty := by + rw [hright] + rw [(TileTranslationFormulas T (GaussianQuarterTurn v)).1] + exact Finset.image_nonempty.mpr hT + exact (touching_cells_congr (TileTranslation (TileQuarterTurn T) u) + (TileTranslation (TileQuarterTurn V) u) T + (TileTranslation T (GaussianQuarterTurn v)) hcenterNonempty hrightNonempty hT + (by + rw [(TileTranslationFormulas T (GaussianQuarterTurn v)).1] + exact Finset.image_nonempty.mpr hT) + hcell hright).mp htrans + +private theorem hgtAt439 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → (((0 : ℤ) < (q (0 : + Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin (3 : + ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) → + (1 < (q 0).1)) ) := by + classical + intro q hq hs + by_contra hn + have hzero : ∀ j : Fin 3, (q j.succ).1 = 0 := by + intro j + have hlt := hq.2 j + have hn' : (q j.succ).1 ≤ 0 := by omega + exact le_antisymm hn' (hs.2.1 j) + have h01 := hs.2.2 0 1 (hzero 0) (hzero 1) + exact (by decide : (0 : Fin 3) ≠ 1) h01 + +private theorem hminus : + (by + classical + exact + (∀ (A : ProtoTile), ∀ (B : ProtoTile), TileTouching A B → TileTouching B A) → (∀ (T : + ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (∀ (i : Fin + (3 : ℕ)), TouchingTriple T (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin + (4 : ℕ))))) (TileTranslation T (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 + : Fin (4 : ℕ)))))) → (TileTouching T (TileTranslation T (-BandVectors.1 (q i.succ) (q + 0))))) ) := by + classical + intro touching_symm T q i hT3 + have hprev : ∀ j : Fin 3, TileTouching T + (TileTranslation T (-BandVectors.1 (q j.succ) (q 0))) := by + intro j + fin_cases j + · simpa using touching_symm _ T (hT3 2).2.2.1 + · simpa using touching_symm _ T (hT3 0).2.2.1 + · simpa using touching_symm _ T (hT3 1).2.2.1 + exact hprev i + +private theorem hQ : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (∀ (j : Fin (3 : ℕ)), + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) + (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (q j.succ) (q (0 : + Fin (4 : ℕ)))) → (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)) = + BandVectors.1 (q 0) (q i.succ)) ) := by + classical + intro q i hflip + have hf := (hflip i).1 + calc + GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q i.succ) (q 0) := by + ext <;> simp [GaussianQuarterTurn] + _ = BandVectors.1 (q 0) (q i.succ) := hf.symm + +private theorem hQneg : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (GaussianQuarterTurn + (BandVectors.1 (q i.succ) (q 0)) = BandVectors.1 (q 0) (q i.succ)) → + (GaussianQuarterTurn (-BandVectors.1 (q i.succ) (q 0)) = -BandVectors.1 (q 0) (q + i.succ)) ) := by + classical + intro q i hQ + have hneg : GaussianQuarterTurn (-BandVectors.1 (q i.succ) (q 0)) = + -GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)) := by + ext <;> simp [GaussianQuarterTurn] + rw [hneg, hQ] + +private theorem hrotplus : + (by + classical + exact + (∀ (T : ProtoTile), ∀ (v : GaussianInt), (T.cells.Nonempty) → ((QuarterTurnSymmetric T) → + ((TileTouching T (TileTranslation T v)) → (TileTouching T (TileTranslation T + (GaussianQuarterTurn v)))))) → (∀ (T : ProtoTile), ∀ (q : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (Finset.Nonempty T.cells) → ((LatticeTile T + ∧ TileArea T = (q (0 : Fin (4 : ℕ))).1.toNat ∧ (∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i + s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i + s).cells) → ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), LatticeTile (TileCellComplement T (S i + s)) ∧ TileTouching (TileCellComplement T (S i s)) (S i s)) ∧ QuarterTurnSymmetric T ∧ + ((1 : ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation + T (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) ∧ ((1 : + ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile + (q i.succ) U → TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 + (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple T (TileTranslation T + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (U : + ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → BandPrototile (q (i + (1 + : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V + - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin + (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin + (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple T U V) ∧ ∀ (r : Fin (4 + : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin + (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : + Fin (4 : ℕ)) → (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → (q (3 : Fin (4 : + ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → ∀ (P : Fin (3 + : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) + → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i + s (P i s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ + (P i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : + Fin (3 : ℕ)) true) i s (Q i s)) → (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) + true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (Q i s).cells) → (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : Fin (3 : ℕ)) false) i s (S i s)) → + (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s + : Bool), x ∈ (S i s).cells) → + let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); (∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty → AllowedSubtileIncidence a b) ∧ + (¬AllowedSubtileIncidence a b → FootprintVertices (SubtileOccurrenceInterpretation P + u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ FootprintVertices (P (0 : + Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ⊆ FootprintVertices + (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ + FootprintVertices (P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (0 : Fin (3 : ℕ)) + false) ⊆ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin + (3 : ℕ)) false) ∪ FootprintVertices (Q (0 : Fin (3 : ℕ)) false) ∪ FootprintVertices + (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → + ((TileTouching T (TileTranslation T (BandVectors.1 (q i.succ) (q 0)))) → + ((GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)) = BandVectors.1 (q 0) (q + i.succ)) → (TileTouching T (TileTranslation T (BandVectors.1 (q 0) (q i.succ)))))))) + ) := by + classical + intro rotate_touch T q i hnonempty hsim hplus hQ + have ht := rotate_touch T _ hnonempty hsim.2.2.2.1 hplus + simpa [hQ] using ht + +private theorem hrotminus : + (by + classical + exact + (∀ (T : ProtoTile), ∀ (v : GaussianInt), (T.cells.Nonempty) → ((QuarterTurnSymmetric T) → + ((TileTouching T (TileTranslation T v)) → (TileTouching T (TileTranslation T + (GaussianQuarterTurn v)))))) → (∀ (T : ProtoTile), ∀ (q : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (Finset.Nonempty T.cells) → ((LatticeTile T + ∧ TileArea T = (q (0 : Fin (4 : ℕ))).1.toNat ∧ (∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i + s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i + s).cells) → ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), LatticeTile (TileCellComplement T (S i + s)) ∧ TileTouching (TileCellComplement T (S i s)) (S i s)) ∧ QuarterTurnSymmetric T ∧ + ((1 : ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation + T (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) ∧ ((1 : + ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile + (q i.succ) U → TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 + (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple T (TileTranslation T + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (U : + ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → BandPrototile (q (i + (1 + : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V + - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin + (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin + (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple T U V) ∧ ∀ (r : Fin (4 + : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin + (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : + Fin (4 : ℕ)) → (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → (q (3 : Fin (4 : + ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → ∀ (P : Fin (3 + : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) + → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i + s (P i s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ + (P i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : + Fin (3 : ℕ)) true) i s (Q i s)) → (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) + true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (Q i s).cells) → (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : Fin (3 : ℕ)) false) i s (S i s)) → + (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s + : Bool), x ∈ (S i s).cells) → + let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); (∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty → AllowedSubtileIncidence a b) ∧ + (¬AllowedSubtileIncidence a b → FootprintVertices (SubtileOccurrenceInterpretation P + u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ FootprintVertices (P (0 : + Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ⊆ FootprintVertices + (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ + FootprintVertices (P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (0 : Fin (3 : ℕ)) + false) ⊆ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin + (3 : ℕ)) false) ∪ FootprintVertices (Q (0 : Fin (3 : ℕ)) false) ∪ FootprintVertices + (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → + ((TileTouching T (TileTranslation T (-BandVectors.1 (q i.succ) (q 0)))) → + ((GaussianQuarterTurn (-BandVectors.1 (q i.succ) (q 0)) = -BandVectors.1 (q 0) (q + i.succ)) → (TileTouching T (TileTranslation T (-BandVectors.1 (q 0) (q i.succ)))))))) + ) := by + classical + intro rotate_touch T q i hnonempty hsim hminus hQneg + have ht := rotate_touch T _ hnonempty hsim.2.2.2.1 hminus + simpa [hQneg] using ht + +private theorem htouch : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (e : + Bool), (TileTouching T (TileTranslation T (BandVectors.1 (q 0) (q i.succ)))) → + ((TileTouching T (TileTranslation T (-BandVectors.1 (q 0) (q i.succ)))) → ( + let v := (if e = true then (BandVectors.1 (q 0) (q i.succ)) + else -BandVectors.1 (q 0) (q i.succ)) + TileTouching T (TileTranslation T v))) ) := by + classical + intro T q i e hrotplus hrotminus v + by_cases he : e = true + · simpa [v, he] using hrotplus + · simpa [v, he] using hrotminus + +private theorem hcentU : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (T' : ProtoTile), (ℝ × ℝ) → ((ℝ × ℝ) → (∀ (q : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (e : Bool), (TileCentroid T' - + TileCentroid T = (if e = true then (1 : ℝ) else (-1 : ℝ)) • GaussianRealPoint + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ( + let v := (if e = true then (BandVectors.1 (q 0) (q i.succ)) + else -BandVectors.1 (q 0) (q i.succ)) + (TileTouching T (TileTranslation T v)) → ( + let U := TileTranslation T v + (BandPrototile (q 0) U) → (TileCentroid U = TileCentroid T'))))) ) := by + classical + intro T T' p p' q i e hcent v htouch U hU + have hc1 := congrArg Prod.fst hcent + have hc2 := congrArg Prod.snd hcent + change (TileCentroid T').1 - (TileCentroid T).1 = + (if e = true then 1 else -1) * + ((BandVectors.1 (q 0) (q i.succ)).re : ℝ) at hc1 + change (TileCentroid T').2 - (TileCentroid T).2 = + (if e = true then 1 else -1) * + ((BandVectors.1 (q 0) (q i.succ)).im : ℝ) at hc2 + cases e + · norm_num at hc1 hc2 + rw [← GaussianInt.intCast_re] at hc1 + rw [← GaussianInt.intCast_im] at hc2 + rw [(TileTranslationFormulas T v).2.2.2.2.1] + have hre : (-BandVectors.1 (q 0) (q i.succ)).re = + -(BandVectors.1 (q 0) (q i.succ)).re := by simp + apply Prod.ext + · change (TileCentroid T).1 + + ((-BandVectors.1 (q 0) (q i.succ)).re : ℝ) = (TileCentroid T').1 + rw [hre] + simp only [Int.cast_neg] + linarith + · change (TileCentroid T).2 + + ((-BandVectors.1 (q 0) (q i.succ)).im : ℝ) = (TileCentroid T').2 + have him : (-BandVectors.1 (q 0) (q i.succ)).im = + -(BandVectors.1 (q 0) (q i.succ)).im := by simp + rw [him] + simp only [Int.cast_neg] + linarith + · norm_num at hc1 hc2 + rw [← GaussianInt.intCast_re] at hc1 + rw [← GaussianInt.intCast_im] at hc2 + rw [(TileTranslationFormulas T v).2.2.2.2.1] + apply Prod.ext + · change (TileCentroid T).1 + + (BandVectors.1 (q 0) (q i.succ)).re = (TileCentroid T').1 + linarith + · change (TileCentroid T).2 + + (BandVectors.1 (q 0) (q i.succ)).im = (TileCentroid T').2 + linarith + +private theorem hUn : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (e : + Bool), (Finset.Nonempty T.cells) → ( + let v := (if e = true then (BandVectors.1 (q 0) (q i.succ)) + else -BandVectors.1 (q 0) (q i.succ)) + let U := TileTranslation T v + U.cells.Nonempty) ) := by + classical + intro T q i e hnonempty v U + change (TileTranslation T v).cells.Nonempty + rw [(TileTranslationFormulas T v).1] + exact Finset.image_nonempty.mpr hnonempty + +private theorem hT2 : + (by + classical + exact + ∀ (D : CircleCoordinates), ∀ (X : ProtoTile), BandPrototile D X → QuarterTurnSymmetric X + ) := by + classical + intro D X cert + induction cert with + | line w x hw => + intro p + simp [TileRealization, TileCentroid] + | unit z x anchor => + intro p + rcases p with ⟨r, t⟩ + have hcent : TileCentroid ⟨{x}, anchor⟩ = + (((x.re : Int) : Real) + 1 / 2, + ((x.im : Int) : Real) + 1 / 2) := by + simp [TileCentroid] + rw [hcent] + simp? [TileRealization] + rw [← GaussianInt.intCast_re x, ← GaussianInt.intCast_im x] + change (r, t) ∈ ClosedSquareRealization x ↔ + ((((x.re : Int) : Real) + (2 : Real)⁻¹) - + (t - (((x.im : Int) : Real) + (2 : Real)⁻¹)), + (((x.im : Int) : Real) + (2 : Real)⁻¹) + + (r - (((x.re : Int) : Real) + (2 : Real)⁻¹))) ∈ + ClosedSquareRealization x + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor + · rintro ⟨⟨hrl, htl⟩, ⟨hru, htu⟩⟩ + constructor <;> constructor <;> linarith + · rintro ⟨⟨hrl, htl⟩, ⟨hru, htu⟩⟩ + constructor <;> constructor <;> linarith + | @decompose r hr S X hS hcells hfoot hcent ih => + have hcert : BandPrototile (r 0) X := + BandPrototile.decompose hr hS hcells hfoot hcent + exact (BandTileSimultaneousInduction r hr X hcert).2.2.2.1 + +private theorem hT4 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (Fin (3 : ℕ)) → ((ProperBandQuadruple q) → + (((0 : ℤ) < (q (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ + ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 + : ℤ) → i = j) → (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (j : Fin 3), BandPrototile + (q 0) A → BandPrototile (q j.succ) B → TileCentroid B - TileCentroid A = (1 / 2 : + Real) • (GaussianRealPoint (BandVectors.1 (q j.succ) (q 0)) + GaussianRealPoint + (BandVectors.1 (q 0) (q j.succ))) → TouchingTriple A (TileTranslation A + (BandVectors.1 (q j.succ) (q 0))) B)))) := by + classical + intro q i hq hrootPos A B j hA hB hcentAB + have hgt : 1 < (q 0).1 := by + by_contra hn + have hzero : ∀ k : Fin 3, (q k.succ).1 = 0 := by + intro k + have hlt := hq.2 k + have hn' : (q k.succ).1 ≤ 0 := by omega + exact le_antisymm hn' ((ProperBandCurvatureStructure q hq).2.1 k) + have h01 := (ProperBandCurvatureStructure q hq).2.2 0 1 (hzero 0) (hzero 1) + exact (by decide : (0 : Fin 3) ≠ 1) h01 + exact (BandTileSimultaneousInduction q hq A hA).2.2.2.2.2.1 hgt + j B hB hcentAB + +private theorem hT5 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (ProperBandQuadruple q) → + (((0 : ℤ) < (q (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ + ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 + : ℤ) → i = j) → (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (D : ProtoTile), ∀ (j : Fin + 3), BandPrototile (q 0) A → BandPrototile (q j.succ) B → BandPrototile (q ((j + + 1).succ)) D → TileCentroid B - TileCentroid A = (1 / 2 : Real) • (GaussianRealPoint + (BandVectors.1 (q j.succ) (q 0)) + GaussianRealPoint (BandVectors.1 (q 0) (q + j.succ))) → TileCentroid D - TileCentroid A = (1 / 2 : Real) • (GaussianRealPoint + (BandVectors.1 (q ((j + 1).succ)) (q 0)) - GaussianRealPoint (BandVectors.1 (q 0) (q + ((j + 1).succ)))) → TouchingTriple A B D)) ) := by + classical + intro q i hq hrootPos A B D j hA hB hD hcentB hcentD + have hgt : 1 < (q 0).1 := by + by_contra hn + have hzero : ∀ k : Fin 3, (q k.succ).1 = 0 := by + intro k + have hlt := hq.2 k + have hn' : (q k.succ).1 ≤ 0 := by omega + exact le_antisymm hn' ((ProperBandCurvatureStructure q hq).2.1 k) + have h01 := (ProperBandCurvatureStructure q hq).2.2 0 1 (hzero 0) (hzero 1) + exact (by decide : (0 : Fin 3) ≠ 1) h01 + exact (BandTileSimultaneousInduction q hq A hA).2.2.2.2.2.2.1 + j B D hB hD hcentB hcentD + +private theorem qturn_iter : + (by + classical + exact + let unitI : GaussianInt := ⟨0, 1⟩ + (∀ (z : GaussianInt), GaussianQuarterTurn z = unitI * z) → (∀ (n : ℕ), ∀ (z : + GaussianInt), (GaussianQuarterTurn^[n]) z = unitI ^ n * z) ) := by + classical + intro unitI qturn_mul n z + induction n with + | zero => simp [unitI] + | succ n ih => + calc + (GaussianQuarterTurn^[n + 1]) z = + GaussianQuarterTurn ((GaussianQuarterTurn^[n]) z) := by + rw [Function.iterate_succ_apply'] + _ = unitI * (unitI ^ n * z) := by rw [qturn_mul, ih] + _ = unitI ^ (n + 1) * z := by rw [pow_succ]; ring + +private theorem gaussianRealPoint_add : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint (x + y) = GaussianRealPoint x + + GaussianRealPoint y ) := by + classical + intro x y + ext <;> simp [GaussianRealPoint] + +private theorem rotcenter : + (by + classical + exact + ∀ (s : Fin (4 : ℕ)), + let unitI : GaussianInt := ⟨0, 1⟩ + (∀ (n : ℕ), ∀ (z : GaussianInt), (GaussianQuarterTurn^[n]) z = unitI ^ n * z) → ((∀ (x : + GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint (x + y) = GaussianRealPoint x + + GaussianRealPoint y) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * (x + y)) = GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) x) + GaussianRealPoint ((GaussianQuarterTurn^[s.val]) + y))) ) := by + classical + intro s unitI qturn_iter gaussianRealPoint_add x y + rw [show (⟨0, 1⟩ : GaussianInt) = unitI by rfl, + qturn_iter, qturn_iter] + calc + GaussianRealPoint (unitI ^ s.val * (x + y)) = + GaussianRealPoint (unitI ^ s.val * x + unitI ^ s.val * y) := by + rw [mul_add] + _ = GaussianRealPoint (unitI ^ s.val * x) + + GaussianRealPoint (unitI ^ s.val * y) := gaussianRealPoint_add _ _ + +private theorem hcentRot : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (Ti : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), (TileCentroid Ti - TileCentroid T0 = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)))) → + ((∀ (x : GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) + ^ s.val * (x + y)) = GaussianRealPoint ((GaussianQuarterTurn^[s.val]) x) + + GaussianRealPoint ((GaussianQuarterTurn^[s.val]) y)) → (TileCentroid Ti - + TileCentroid T0 = (1 / 2 : Real) • (GaussianRealPoint ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (q i.succ) (q 0))) + GaussianRealPoint ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (q 0) (q i.succ)))))) ) := by + classical + intro T0 Ti q i s hcent rotcenter + rw [← rotcenter] + exact hcent + +private theorem hT2' : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (∀ (D : CircleCoordinates), ∀ (X : ProtoTile), + BandPrototile D X → QuarterTurnSymmetric X) → (∀ (a : Fin 4), ∀ (X : ProtoTile), + BandPrototile (q a) X → QuarterTurnSymmetric X) ) := by + classical + intro q hT2 a X hx + exact hT2 (q a) X hx + +end LatticeInterfacePathGeometry + +theorem LatticeAdjacentInterfacePath : + (forall (C : BandCircle) (T T' : ProtoTile) (h h' : PartialOdometer), + RightLatticeAdjacent C T T' h h' -> + exists x y : GaussianInt, + SimpleGridPathBetween + (FootprintVertices T ∩ FootprintVertices T') + (FootprintEdges T ∩ FootprintEdges T') x y) /\ + forall (C0 Ci : BandCircle) (T0 Ti : ProtoTile) + (h0 hi : PartialOdometer), + SubtileLatticeAdjacent C0 Ci T0 Ti h0 hi -> + exists x y : GaussianInt, + SimpleGridPathBetween + (FootprintVertices T0 ∩ FootprintVertices Ti) + (FootprintEdges T0 ∩ FootprintEdges Ti) x y := by +-- BODY + classical + have band_of_odometer (C : CircleCoordinates) (T : ProtoTile) (h : PartialOdometer) + (ho : TileOdometer C T h) : BandPrototile C T := + LatticeInterfacePathGeometry.band_of_odometer C T h ho + have positive_nonempty : ∀ (C : CircleCoordinates) (T : ProtoTile) + (hT : BandPrototile C T), 0 < C.1 → T.cells.Nonempty := + LatticeInterfacePathGeometry.positive_nonempty + have incident_boundary (U V : ProtoTile) (x : GaussianInt) + (hd : Disjoint U.cells V.cells) + (hu : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells) + (hv : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ V.cells) : + x ∈ BoundaryFootprintVertices U ∧ x ∈ BoundaryFootprintVertices V := + LatticeInterfacePathGeometry.incident_boundary U V x hd hu hv + have boundary_subset_footprint (T : ProtoTile) : + BoundaryFootprintVertices T ⊆ FootprintVertices T := + LatticeInterfacePathGeometry.boundary_subset_footprint T + have touching_path (U V : ProtoTile) (hU : U.cells.Nonempty) (hV : V.cells.Nonempty) + (ht : TileTouching U V) : + ∃ x y, SimpleGridPathBetween + (FootprintVertices U ∩ FootprintVertices V) + (FootprintEdges U ∩ FootprintEdges V) x y := LatticeInterfacePathGeometry.touching_path + incident_boundary boundary_subset_footprint U V hU hV ht + have touching_symm (A B : ProtoTile) : TileTouching A B → TileTouching B A := + LatticeInterfacePathGeometry.touching_symm A B + have touching_cells_congr (A B A' B' : ProtoTile) + (hA : A.cells.Nonempty) (hB : B.cells.Nonempty) + (hA' : A'.cells.Nonempty) (hB' : B'.cells.Nonempty) + (ha : A.cells = A'.cells) (hb : B.cells = B'.cells) : + TileTouching A B ↔ TileTouching A' B' := LatticeInterfacePathGeometry.touching_cells_congr + A B A' B' hA hB hA' hB' ha hb + have quarter_translate (T : ProtoTile) (x : GaussianInt) : + TileQuarterTurn (TileTranslation T x) = + TileTranslation (TileQuarterTurn T) (GaussianQuarterTurn x) := + LatticeInterfacePathGeometry.quarter_translate T x + have translation_comm (T : ProtoTile) (x y : GaussianInt) : + TileTranslation (TileTranslation T x) y = + TileTranslation (TileTranslation T y) x := LatticeInterfacePathGeometry.translation_comm + T x y + have rotate_touch (T : ProtoTile) (v : GaussianInt) + (hT : T.cells.Nonempty) + (hSym : QuarterTurnSymmetric T) + (ht : TileTouching T (TileTranslation T v)) : + TileTouching T (TileTranslation T (GaussianQuarterTurn v)) := + LatticeInterfacePathGeometry.rotate_touch touching_cells_congr quarter_translate + translation_comm T v hT hSym ht + constructor + · intro C T T' h h' hadj + rcases hadj with ⟨ho, ho', ⟨p, p', hp, hp', q, i, e, hq, hq0, + hcent, _, _⟩⟩ + have hT := band_of_odometer (C.1.1) T h ho + have hT' := band_of_odometer (C.1.1) T' h' ho' + have hTq : BandPrototile (q 0) T := by simpa [hq0] using hT + have hT'q : BandPrototile (q 0) T' := by simpa [hq0] using hT' + have hs := ProperBandCurvatureStructure q hq + have hnonempty := positive_nonempty (q 0) T hTq hs.1 + have hgt : 1 < (q 0).1 := LatticeInterfacePathGeometry.hgtAt439 q hq hs + have hsim := BandTileSimultaneousInduction q hq T hTq + have hT3 := hsim.2.2.2.2.1 hgt + have hplus : TileTouching T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) := (hT3 i).1 + have hminus : TileTouching T + (TileTranslation T (-BandVectors.1 (q i.succ) (q 0))) := + LatticeInterfacePathGeometry.hminus touching_symm T q i hT3 + have hflip := (VectorRecursionLaws q hq.1).2.2.2.2 hq + have hQ : GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)) = + BandVectors.1 (q 0) (q i.succ) := LatticeInterfacePathGeometry.hQ q i hflip + have hQneg : GaussianQuarterTurn (-BandVectors.1 (q i.succ) (q 0)) = + -BandVectors.1 (q 0) (q i.succ) := LatticeInterfacePathGeometry.hQneg q i hQ + have hrotplus : TileTouching T + (TileTranslation T (BandVectors.1 (q 0) (q i.succ))) := + LatticeInterfacePathGeometry.hrotplus rotate_touch T q i hnonempty hsim hplus hQ + have hrotminus : TileTouching T + (TileTranslation T (-BandVectors.1 (q 0) (q i.succ))) := + LatticeInterfacePathGeometry.hrotminus rotate_touch T q i hnonempty hsim hminus hQneg + let v := (if e = true then (BandVectors.1 (q 0) (q i.succ)) + else -BandVectors.1 (q 0) (q i.succ)) + have htouch : TileTouching T (TileTranslation T v) := LatticeInterfacePathGeometry.htouch T q + i e hrotplus hrotminus + let U := TileTranslation T v + have hU : BandPrototile (q 0) U := BandPrototileTranslation _ T v hTq + have hcentU : TileCentroid U = TileCentroid T' := LatticeInterfacePathGeometry.hcentU T T' p + p' q i e hcent htouch hU + have hcells := (BandPrototileCentroidUnique (q 0) U T' hU hT'q hcentU).1 + have hUn : U.cells.Nonempty := LatticeInterfacePathGeometry.hUn T q i e hnonempty + have hT'nonempty : T'.cells.Nonempty := by rw [← hcells]; exact hUn + have htouch' := (touching_cells_congr T U T T' hnonempty hUn hnonempty hT'nonempty + rfl hcells).mp htouch + exact touching_path T T' hnonempty hT'nonempty htouch' + · intro C0 Ci T0 Ti h0 hi hadj + rcases hadj with ⟨ho0, hoi, ⟨p0, pi, hp0, hpi, q, i, s, hq, + hq0, hqi, hcent, _, _⟩⟩ + have hT0 := band_of_odometer (C0.1.1) T0 h0 ho0 + have hTi := band_of_odometer (Ci.1.1) Ti hi hoi + have hT0q : BandPrototile (q 0) T0 := by simpa [hq0] using hT0 + have hTiq : BandPrototile (q i.succ) Ti := by simpa [hqi] using hTi + have hrootPos := ProperBandCurvatureStructure q hq + have hnonempty0 := positive_nonempty (q 0) T0 hT0q hrootPos.1 + have hchildPos : 0 < (q i.succ).1 := by rw [hqi]; exact Ci.2 + have hnonemptyi := positive_nonempty (q i.succ) Ti hTiq hchildPos + have hT2 : ∀ (D : CircleCoordinates) (X : ProtoTile), + BandPrototile D X → QuarterTurnSymmetric X := LatticeInterfacePathGeometry.hT2 + have hT4 : ∀ (A B : ProtoTile) (j : Fin 3), + BandPrototile (q 0) A → BandPrototile (q j.succ) B → + TileCentroid B - TileCentroid A = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q j.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q j.succ))) → + TouchingTriple A (TileTranslation A (BandVectors.1 (q j.succ) (q 0))) B := + LatticeInterfacePathGeometry.hT4 q i hq hrootPos + have hT5 : ∀ (A B D : ProtoTile) (j : Fin 3), + BandPrototile (q 0) A → BandPrototile (q j.succ) B → + BandPrototile (q ((j + 1).succ)) D → + TileCentroid B - TileCentroid A = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q j.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q j.succ))) → + TileCentroid D - TileCentroid A = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((j + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((j + 1).succ)))) → + TouchingTriple A B D := LatticeInterfacePathGeometry.hT5 q i hq hrootPos + let unitI : GaussianInt := ⟨0, 1⟩ + have qturn_mul (z : GaussianInt) : GaussianQuarterTurn z = unitI * z := by + ext <;> simp [GaussianQuarterTurn, unitI] + have qturn_iter (n : ℕ) (z : GaussianInt) : + (GaussianQuarterTurn^[n]) z = unitI ^ n * z := LatticeInterfacePathGeometry.qturn_iter + qturn_mul n z + have gaussianRealPoint_add (x y : GaussianInt) : + GaussianRealPoint (x + y) = GaussianRealPoint x + GaussianRealPoint y := + LatticeInterfacePathGeometry.gaussianRealPoint_add x y + have rotcenter (x y : GaussianInt) : + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * (x + y)) = + GaussianRealPoint ((GaussianQuarterTurn^[s.val]) x) + + GaussianRealPoint ((GaussianQuarterTurn^[s.val]) y) := + LatticeInterfacePathGeometry.rotcenter s qturn_iter gaussianRealPoint_add x y + have hcentRot : TileCentroid Ti - TileCentroid T0 = + (1 / 2 : Real) • + (GaussianRealPoint ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (q i.succ) (q 0))) + + GaussianRealPoint ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (q 0) (q i.succ)))) := LatticeInterfacePathGeometry.hcentRot T0 Ti q + i s hcent rotcenter + have hT2' : ∀ (a : Fin 4) (X : ProtoTile), + BandPrototile (q a) X → QuarterTurnSymmetric X := LatticeInterfacePathGeometry.hT2' q hT2 + have hcov := OrientedTouchingCovariance q hq hT2' hT4 hT5 + have htriple := hcov.1 T0 Ti i s hT0q hTiq hcentRot + exact touching_path T0 Ti hnonempty0 hnonemptyi + (touching_symm Ti T0 htriple.2.2.1) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeCell.lean b/LeanPool/ApollonianSuperharmonic/LatticeCell.lean new file mode 100644 index 0000000000..49cc01eacc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeCell.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: LatticeCell] + +/-! +# LatticeCell + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A lattice cell is indexed by its lower-left corner $x\in\mathbb Z[i]$ and +is denoted $s_x$. Thus the collection of lattice cells is identified with +$\mathbb Z[i]$; the four vertices of $s_x$ are $x,x+1,x+i,x+1+i$. +-/ +abbrev LatticeCell : Type := +-- BODY + GaussianInt + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeDiskUnionIntersectionConnected.lean b/LeanPool/ApollonianSuperharmonic/LatticeDiskUnionIntersectionConnected.lean new file mode 100644 index 0000000000..9b75d1e020 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeDiskUnionIntersectionConnected.lean @@ -0,0 +1,204 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices +public import LeanPool.ApollonianSuperharmonic.ConnectedGridEdgeCarrierUnion +public import LeanPool.ApollonianSuperharmonic.DisjointBoundaryCommonEdgeGraphAcyclic +public import LeanPool.ApollonianSuperharmonic.DisjointSquareUnionCommonEdgeCarrier +public import LeanPool.ApollonianSuperharmonic.FiniteAcyclicGraphCardConnected +public import LeanPool.ApollonianSuperharmonic.FiniteGridEdgeGraphEncoding +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridEulerCount +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: LatticeDiskUnionIntersectionConnected] + +/-! +# LatticeDiskUnionIntersectionConnected + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem LatticeDiskUnionIntersectionConnected (U V W : ProtoTile) + (hU : LatticeTile U) (hV : LatticeTile V) (hW : LatticeTile W) + (hdisjoint : Disjoint U.cells V.cells) + (hunion : ∀ z : LatticeCell, + z ∈ W.cells ↔ z ∈ U.cells ∨ z ∈ V.cells) + (hcommon : + (FootprintEdges U ∩ FootprintEdges V).Nonempty) : + IsConnected (TileRealization U ∩ TileRealization V) := by +-- BODY + classical + let X : Set GaussianInt := FootprintVertices U ∩ FootprintVertices V + let E : Set (Finset GaussianInt) := FootprintEdges U ∩ FootprintEdges V + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + have hUne : U.cells.Nonempty := (LatticeTileGridStructure U hU).1.1 + have hVne : V.cells.Nonempty := (LatticeTileGridStructure V hV).1.1 + have hWne : W.cells.Nonempty := (LatticeTileGridStructure W hW).1.1 + have hvertices : FootprintVertices W = + FootprintVertices U ∪ FootprintVertices V := by + simp only [FootprintVertices, hUne, hVne, hWne, ite_true] + ext z + simp only [Set.mem_ofPred_eq, Set.mem_union] + constructor + · rintro ⟨x, hx, hz⟩ + rw [hunion x] at hx + rcases hx with hx | hx + · exact Or.inl ⟨x, hx, hz⟩ + · exact Or.inr ⟨x, hx, hz⟩ + · rintro (⟨x, hx, hz⟩ | ⟨x, hx, hz⟩) + · exact ⟨x, (hunion x).2 (Or.inl hx), hz⟩ + · exact ⟨x, (hunion x).2 (Or.inr hx), hz⟩ + have hedges : FootprintEdges W = FootprintEdges U ∪ FootprintEdges V := by + ext e + simp only [FootprintEdges, Set.mem_ofPred_eq, Set.mem_union] + constructor + · rintro ⟨x, hx, he⟩ + rw [hunion x] at hx + exact hx.elim (fun h => Or.inl ⟨x, h, he⟩) + (fun h => Or.inr ⟨x, h, he⟩) + · rintro (⟨x, hx, he⟩ | ⟨x, hx, he⟩) + · exact ⟨x, (hunion x).2 (Or.inl hx), he⟩ + · exact ⟨x, (hunion x).2 (Or.inr hx), he⟩ + have vertex_finite (T : ProtoTile) : (FootprintVertices T).Finite := by + simp only [FootprintVertices] + split_ifs + · let corner : T.cells × (Bool × Bool) → GaussianInt := fun q => + match q.2 with + | (false, false) => q.1.1 + | (false, true) => q.1.1 + 1 + | (true, false) => q.1.1 + ⟨0, 1⟩ + | (true, true) => q.1.1 + 1 + ⟨0, 1⟩ + apply (Set.finite_range corner).subset + rintro z ⟨x, hx, hz⟩ + rcases hz with hz | hz | hz | hz + · exact ⟨(⟨x, hx⟩, false, false), by simpa [corner] using hz.symm⟩ + · exact ⟨(⟨x, hx⟩, false, true), by simpa [corner] using hz.symm⟩ + · exact ⟨(⟨x, hx⟩, true, false), by simpa [corner] using hz.symm⟩ + · exact ⟨(⟨x, hx⟩, true, true), by simpa [corner] using hz.symm⟩ + · exact Set.finite_singleton T.anchor + have edge_finite (T : ProtoTile) : (FootprintEdges T).Finite := by + let edge : T.cells × (Bool × Bool) → Finset GaussianInt := fun q => + match q.2 with + | (false, false) => {q.1.1, q.1.1 + 1} + | (false, true) => {q.1.1, q.1.1 + ⟨0, 1⟩} + | (true, false) => {q.1.1 + 1, q.1.1 + 1 + ⟨0, 1⟩} + | (true, true) => {q.1.1 + ⟨0, 1⟩, q.1.1 + 1 + ⟨0, 1⟩} + apply (Set.finite_range edge).subset + rintro e ⟨c, hc, h | h | h | h⟩ + · exact ⟨(⟨c, hc⟩, false, false), by simpa [edge] using h.symm⟩ + · exact ⟨(⟨c, hc⟩, false, true), by simpa [edge] using h.symm⟩ + · exact ⟨(⟨c, hc⟩, true, false), by simpa [edge] using h.symm⟩ + · exact ⟨(⟨c, hc⟩, true, true), by simpa [edge] using h.symm⟩ + have hvertexIE := Set.ncard_union_add_ncard_inter + (FootprintVertices U) (FootprintVertices V) (vertex_finite U) (vertex_finite V) + have hedgeIE := Set.ncard_union_add_ncard_inter + (FootprintEdges U) (FootprintEdges V) (edge_finite U) (edge_finite V) + have hcellcard : W.cells.card = U.cells.card + V.cells.card := by + have hfin : W.cells = U.cells ∪ V.cells := by + ext z + simpa using hunion z + rw [hfin, Finset.card_union_of_disjoint hdisjoint] + have hEulerU := LatticeTileGridEulerCount U hU + have hEulerV := LatticeTileGridEulerCount V hV + have hEulerW := LatticeTileGridEulerCount W hW + have hcount : X.ncard = E.ncard + 1 := by + dsimp [X, E] + rw [← hvertices] at hvertexIE + rw [← hedges] at hedgeIE + omega + have hEfinite : E.Finite := (edge_finite U).inter_of_left (FootprintEdges V) + have hXfinite : X.Finite := (vertex_finite U).inter_of_left (FootprintVertices V) + have hgrid : ∀ e ∈ E, ∃ a b : GaussianInt, + e = {a, b} ∧ FourNeighborAdjacent a b := by + intro e he + rcases he.1 with ⟨x, hx, rfl | rfl | rfl | rfl⟩ + · exact ⟨x, x + 1, rfl, Or.inl rfl⟩ + · exact ⟨x, x + ⟨0, 1⟩, rfl, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨x + 1, x + 1 + ⟨0, 1⟩, rfl, + Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩, rfl, Or.inl (by ring)⟩ + have hendpoint : {x | ∃ e ∈ E, x ∈ e} ⊆ X := by + rintro x ⟨e, he, hxe⟩ + have endpoint_mem (T : ProtoTile) (hne : T.cells.Nonempty) + (heT : e ∈ FootprintEdges T) : x ∈ FootprintVertices T := by + simp only [FootprintVertices, hne, ite_true] + rcases heT with ⟨c, hc, hec⟩ + refine ⟨c, hc, ?_⟩ + rcases hec with hec | hec | hec | hec + all_goals rw [hec] at hxe + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + · exact hxe.elim Or.inl (fun h => Or.inr (Or.inl h)) + · exact hxe.elim Or.inl (fun h => Or.inr (Or.inr (Or.inl h))) + · exact hxe.elim (fun h => Or.inr (Or.inl h)) + (fun h => Or.inr (Or.inr (Or.inr h))) + · exact hxe.elim (fun h => Or.inr (Or.inr (Or.inl h))) + (fun h => Or.inr (Or.inr (Or.inr h))) + exact ⟨endpoint_mem U hUne he.1, endpoint_mem V hVne he.2⟩ + have hboundary := CellDisjointCommonEdgesBoundary U V hdisjoint + have hacyclicSmall := DisjointBoundaryCommonEdgeGraphAcyclic U V hdisjoint + (LatticeTileGridStructure U hU).2.2 + (LatticeTileGridStructure V hV).2.2 hcommon hboundary + have hencoding := FiniteGridEdgeGraphEncoding X E + hgrid hendpoint hacyclicSmall + have hXnonempty : X.Nonempty := by + rcases hcommon with ⟨e, he⟩ + rcases hgrid e he with ⟨a, b, rfl, hab⟩ + exact ⟨a, hendpoint ⟨{a, b}, by simpa, by simp⟩⟩ + let : Nonempty X := Set.nonempty_coe_sort.mpr hXnonempty + let : Fintype X := hXfinite.fintype + have hGconnected : G.Connected := by + apply FiniteAcyclicGraphCardConnected G hencoding.1 + rw [hencoding.2] + simpa [X] using hcount + have hsupport : X = {x | ∃ e ∈ E, x ∈ e} := by + apply Set.Subset.antisymm + · intro x hx + rcases hcommon with ⟨e, he⟩ + rcases hgrid e he with ⟨a, b, hab, hadj⟩ + have habE : ({a, b} : Finset GaussianInt) ∈ E := hab ▸ he + have haX : a ∈ X := hendpoint ⟨{a, b}, habE, by simp⟩ + by_cases hxa : x = a + · subst x + exact ⟨{a, b}, habE, by simp⟩ + · have hreach : G.Reachable ⟨x, hx⟩ ⟨a, haX⟩ := + hGconnected.preconnected _ _ + rcases hreach.nonempty_neighborSet_left (Subtype.ext_iff.not.mpr hxa) with + ⟨y, hxy⟩ + have hxy' : ({x, y.1} : Finset GaussianInt) ∈ E := by + change (⟨x, hx⟩ : X) ≠ y ∧ + (({x, y.1} : Finset GaussianInt) ∈ E ∨ + ({y.1, x} : Finset GaussianInt) ∈ E) at hxy + exact hxy.2.elim id (by simp [Finset.pair_comm]) + exact ⟨{x, y.1}, hxy', by simp⟩ + · exact hendpoint + have hcarrier := DisjointSquareUnionCommonEdgeCarrier U V hdisjoint (by + change X = CommonFootprintEdgeVertices U V + simpa only [CommonFootprintEdgeVertices, E] using hsupport) + rw [hcarrier.2] + exact ConnectedGridEdgeCarrierUnion X E hcommon hgrid + hsupport hGconnected + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeEdgeRegularity.lean b/LeanPool/ApollonianSuperharmonic/LatticeEdgeRegularity.lean new file mode 100644 index 0000000000..dc4574e682 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeEdgeRegularity.lean @@ -0,0 +1,198 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandCircle +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport +public import LeanPool.ApollonianSuperharmonic.BandParentRotationOccurrenceCovariance +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton +public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.OpenLatticeEdge +public import LeanPool.ApollonianSuperharmonic.P4456T2DiamondNoChord +public import LeanPool.ApollonianSuperharmonic.P4456T2MissingEdge +public import LeanPool.ApollonianSuperharmonic.P4456T2OrderedNoChord +public import LeanPool.ApollonianSuperharmonic.P4456T2PackingNoChord +public import LeanPool.ApollonianSuperharmonic.P4456T2SquareEdges +public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance + +-- [TABLET NODE: LatticeEdgeRegularity] + +/-! +# LatticeEdgeRegularity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem LatticeEdgeRegularity (C : BandCircle) (T : ProtoTile) + (hT : BandPrototile C.1.1 T) (hlat : LatticeTile T) : + (∀ x y, FourNeighborAdjacent x y → + x ∈ BoundaryFootprintVertices T → y ∈ BoundaryFootprintVertices T → + ¬ OpenLatticeEdge x y ⊆ interior (TileRealization T)) ∧ + (∀ x, x ∈ FootprintVertices T → ∀ y, y ∈ FootprintVertices T → + FourNeighborAdjacent x y → ({x, y} : Finset GaussianInt) ∈ FootprintEdges T) ∧ + ∀ x, x ∈ FootprintVertices T → + (GaussianRealPoint x ∈ interior (TileRealization T) ↔ + x ∉ BoundaryFootprintVertices T) := by +-- BODY + classical + have uniform : ∀ n : Nat, ∀ (D : CircleCoordinates) (U : ProtoTile), + Int.toNat D.1 = n → 0 < D.1 → BandPrototile D U → LatticeTile U → + ∀ x y, FourNeighborAdjacent x y → + x ∈ BoundaryFootprintVertices U → y ∈ BoundaryFootprintVertices U → + ¬ OpenLatticeEdge x y ⊆ interior (TileRealization U) := by + intro n + induction n using Nat.strong_induction_on with + | h n ih => + intro D U hn hpositive hproto hdisk + cases hproto with + | line w a hw => simp at hpositive + | unit z a anchor => + exact (P4456T2SquareEdges 1 (by omega) a ⟨{a}, anchor⟩ + (by simp [FordTile, FordCellDomain, TileTranslation, GaussianTranslation, + Zsqrtd.ext_iff])).1 + | @decompose q hq S U hS hunion hfoot hcent => + have hchild : BandPrototile (q 0) U := + BandPrototile.decompose hq hS hunion hfoot hcent + obtain ⟨r, g, hregime⟩ := BandRegimeClassification q hq + let qr : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let q' := BandPackingSymmetryQuadrupleAction g qr + let U' := BandPackingSymmetryTileAction g U + have hrot : ProperBandQuadruple qr := + (BandParentRotationOccurrenceCovariance q hq r U hchild S + (fun i s => ⟨hS i s, hfoot i s, hcent i s⟩) hunion).1 + have hproper : ProperBandQuadruple q' := + BandPackingSymmetryProperCovariance g qr hrot + have hzero : q' 0 = BandPackingSymmetryCircleAction g (q 0) := by + simp [q', qr, BandPackingSymmetryQuadrupleAction] + have hcurv : (q' 0).1 = (q 0).1 := by + rw [hzero] + exact (BandPackingSymmetryCovariance g).1 _ + have hproto' : BandPrototile (q' 0) U' := by + rw [hzero] + exact ((BandPackingSymmetryCovariance g).2.1 _ _).mp hchild + have hdisk' : LatticeTile U' := + ((BandPackingSymmetryTilingTransport g).1 U).mp hdisk + apply (P4456T2PackingNoChord g U).mpr + change (∀ x y, FourNeighborAdjacent x y → + x ∈ BoundaryFootprintVertices U' → y ∈ BoundaryFootprintVertices U' → + ¬ OpenLatticeEdge x y ⊆ interior (TileRealization U')) + change Xor (∃ P : FordFareyParameter, 1 < P.q ∧ q' = FordRecursiveQuadruple P) + (Xor (∃ K : DiamondParameter, 1 < K.1 ∧ q' = DiamondRecursiveQuadruple K) + (Nonempty (BandOrderedGeneralConfiguration q'))) at hregime + rcases hregime with ⟨⟨P, hP, heq⟩, _⟩ | ⟨hrest, _⟩ + · have hcanonical : BandPrototile (q' 0) (FordTile P.q) := by + simpa [heq, FordRecursiveQuadruple] using + (FordTileRecursiveIdentification P).1 + obtain ⟨w, hw, _⟩ := BandPrototileTranslationNormalForm _ U' + (FordTile P.q) hproto' hcanonical + exact (P4456T2SquareEdges P.q (by omega) w U' hw).1 + · rcases hrest with ⟨⟨K, hK, heq⟩, _⟩ | ⟨⟨cfg⟩, _⟩ + · have hcanonical : BandPrototile (q' 0) (DiamondTile K.1) := by + simpa [heq] using (DiamondTileRecursiveIdentification K).1 + obtain ⟨w, hw, _⟩ := BandPrototileTranslationNormalForm _ U' + (DiamondTile K.1) hproto' hcanonical + exact P4456T2DiamondNoChord K.1 (by omega) w U' hw + · have hpos' : 0 < (q' 0).1 := (ProperBandCurvatureStructure q' hproper).1 + let C' : BandCircle := + ⟨⟨q' 0, Or.inl hpos', ⟨q', hproper.1, 0, rfl⟩⟩, hpos'⟩ + obtain ⟨layout⟩ := BandOrderedGeneralLayout q' cfg C' rfl U' hproto' + (by + intro p V W hp hV hW hcover _ + have h := BandTileSimultaneousInduction p hp V hV + exact ⟨h.1, h.2.1, h.2.2.1 W hW hcover⟩) + (by + intro E V hV _ + cases hV with + | line w a hw => simp [QuarterTurnSymmetric, TileRealization] + | unit z a anchor => + intro p + simp only [TileRealization, Finset.mem_singleton, + Set.iUnion_iUnion_eq_left] + have hc : TileCentroid (⟨{a}, anchor⟩ : ProtoTile) = + ((a.re : Real) + 1 / 2, (a.im : Real) + 1 / 2) := by + simp [TileCentroid] + simp only [hc, ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor <;> rintro ⟨⟨h1, h2⟩, h3, h4⟩ <;> + constructor <;> constructor <;> dsimp at * <;> linarith + | @decompose p hp W V hW hu hf hc => + exact (BandTileSimultaneousInduction p hp V + (BandPrototile.decompose hp hW hu hf hc)).2.2.2.1) + (by + intro p V W hp hV _ hlarge i hW hc + exact (BandTileSimultaneousInduction p hp V hV).2.2.2.2.2.1 + hlarge i W hW hc) + (by + intro p V W Z hp hV _ i hW hZ hc hd + exact (BandTileSimultaneousInduction p hp V hV).2.2.2.2.2.2.1 + i W Z hW hZ hc hd) + apply P4456T2OrderedNoChord q' cfg C' U' hdisk' layout + intro i s + have hnonneg := (ProperBandCurvatureStructure q' hproper).2.1 i + have hnonzero := cfg.noLine i.succ + have hparentpos : 0 < (q' i.succ).1 := by omega + have hless : Int.toNat (q' i.succ).1 < n := by + have hh := hproper.2 i + rw [hcurv] at hh + omega + exact ih _ hless _ _ rfl hparentpos + (layout.outer_occurrence i s).1 (layout.parent_lattice i s) + have hno := uniform _ C.1.1 T rfl C.2 hT hlat + refine ⟨hno, ?_, ?_⟩ + · by_cases hunit : C.1.1.1 = 1 + · obtain ⟨a, ha⟩ := CurvatureOneBandPrototileSingleton C T hunit hT + have hz : (⟨0, 0⟩ : GaussianInt) = 0 := by ext <;> rfl + exact (P4456T2SquareEdges 1 (by omega) a T + (by simpa [FordTile, FordCellDomain, TileTranslation, GaussianTranslation, + hz] + using ha)).2 + · rcases BandGenealogy C with hc | ⟨q, hq, hqC, hsmall, _⟩ + · exact (hunit hc).elim + have hp : ProperBandQuadruple q := ⟨hq, by simpa [hqC] using hsmall⟩ + have hproto : BandPrototile (q 0) T := by simpa [hqC] using hT + have hlarge : 1 < (q 0).1 := by rw [hqC]; have := C.2; omega + apply P4456T2MissingEdge C q hp hqC T hproto hlarge + intro u + exact uniform _ C.1.1 (TileTranslation T (u : GaussianInt)) rfl C.2 + (BandPrototileTranslation _ T _ hT) ((TileDiskAreaCovariance T u).1.mp hlat) + · intro x hx + have hne := (LatticeTileFourNeighborConnected T hlat).1 + have hlocal := P4456T2VertexInterior T hne x hx + exact hlocal.1.trans hlocal.2.symm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeFundamentalSet.lean b/LeanPool/ApollonianSuperharmonic/LatticeFundamentalSet.lean new file mode 100644 index 0000000000..5b23bf4050 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeFundamentalSet.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: LatticeFundamentalSet] + +/-! +# LatticeFundamentalSet + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a sublattice $L\subseteq\mathbb Z[i]$, a finite set $R$ is a complete +set of coset representatives if every $x\in\mathbb Z[i]$ has a unique +$r\in R$ with $x-r\in L$. +-/ +def LatticeFundamentalSet (L : AddSubgroup GaussianInt) + (R : Finset GaussianInt) : Prop := +-- BODY + ∀ x : GaussianInt, ∃! r : GaussianInt, r ∈ R ∧ x - r ∈ L + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeQuadraticForm.lean b/LeanPool/ApollonianSuperharmonic/LatticeQuadraticForm.lean new file mode 100644 index 0000000000..025617dc6e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeQuadraticForm.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint + +-- [TABLET NODE: LatticeQuadraticForm] + +/-! +# LatticeQuadraticForm + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a real $2\times2$ matrix $A$ and a lattice point +$x=(x_1,x_2)\in\mathbb Z^2$, define the lattice quadratic function +$$ + q_A(x)=\frac12 x^{\mathsf T}Ax. +$$ +This function is denoted by $\operatorname{LatticeQuadraticForm}(A,x)$ in +the formalization. +-/ +noncomputable def LatticeQuadraticForm + (A : Matrix (Fin 2) (Fin 2) ℝ) (x : GaussianInt) : ℝ := +-- BODY + let v : Fin 2 → ℝ := ![(x.re : ℝ), (x.im : ℝ)] + (1 / 2 : ℝ) * dotProduct v (Matrix.mulVec A v) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTile.lean b/LeanPool/ApollonianSuperharmonic/LatticeTile.lean new file mode 100644 index 0000000000..43edf3a9f9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeTile.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: LatticeTile] + +/-! +# LatticeTile + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A lattice tile is a prototile $T$ whose closed-square realization $I(T)$ is +a topological disk in the sense of `TopologicalDisk`. Consequently, +the assigned anchor of an empty prototile does not turn its empty real +realization into a lattice tile. +-/ +def LatticeTile (T : ProtoTile) : Prop := +-- BODY + TopologicalDisk (TileRealization T) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean new file mode 100644 index 0000000000..39a7f46711 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean @@ -0,0 +1,840 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertexDegreeTwo +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.P5620T1BoundaryComponentCycle +public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.LatticeTileNoCheckerboard +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TopologicalDiskGridRayCrossingIndexZero + +-- [TABLET NODE: LatticeTileBoundarySimpleGridCycle] + +/-! +# LatticeTileBoundarySimpleGridCycle + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace BoundaryCycleProof + +private theorem closed_grid_index_zero : + (by + classical + exact + ∀ (T : ProtoTile), (LatticeTile T) → (∀ (q : LatticeCell), ∀ (p : List GaussianInt), ∀ (x + : GaussianInt), ∀ (y : GaussianInt), ((((q.re : Int) : Real) + (1 / 2 : Real)), + (((q.im : Int) : Real) + (1 / 2 : Real))) ∉ TileRealization T → p.head? = some x → + p.getLast? = some y → (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, p = l₁ ++ a + :: b :: l₂ → FourNeighborAdjacent a b) → FourNeighborAdjacent y x → (∀ a b : + GaussianInt, ((∃ l₁ l₂ : List GaussianInt, p = l₁ ++ a :: b :: l₂) ∨ (a = y ∧ b = x)) + → ∀ t : Set.Icc (0 : Real) 1, ((1 - (t : Real)) * ((a.re : Int) : Real) + (t : Real) + * ((b.re : Int) : Real), (1 - (t : Real)) * ((a.im : Int) : Real) + (t : Real) * + ((b.im : Int) : Real)) ∈ TileRealization T) → GridRayCrossingIndex q p = 0) + ) := by + classical + intro T hT q p x y hq hhead hlast hadj hclose hedge + exact TopologicalDiskGridRayCrossingIndexZero + (TileRealization T) hT q hq p x y hhead hlast hadj hclose hedge + +private theorem adjacent_grid_index_control : + (by + classical + exact + ∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), p.head? = some x → + p.getLast? = some y → p.Nodup → 3 ≤ p.length → + (∀ a, ∀ b, (a, b) ∈ p.zip p.tail → FourNeighborAdjacent a b) → + FourNeighborAdjacent y x → + let cyclicEdges := (p.zip p.tail) ++ [(y, x)] + ∀ q : LatticeCell, + (((q + 1, q + 1 + ⟨0, 1⟩) ∉ cyclicEdges ∧ + (q + 1 + ⟨0, 1⟩, q + 1) ∉ cyclicEdges) → + GridRayCrossingIndex (q + 1) p = GridRayCrossingIndex q p) ∧ + (((q + 1, q + 1 + ⟨0, 1⟩) ∈ cyclicEdges ∨ + (q + 1 + ⟨0, 1⟩, q + 1) ∈ cyclicEdges) → + Int.natAbs (GridRayCrossingIndex (q + 1) p - + GridRayCrossingIndex q p) = 1) ∧ + (((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∉ cyclicEdges ∧ + (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) ∉ cyclicEdges) → + GridRayCrossingIndex (q + ⟨0, 1⟩) p = + GridRayCrossingIndex q p) ∧ + (((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∈ cyclicEdges ∨ + (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) ∈ cyclicEdges) → + Int.natAbs (GridRayCrossingIndex (q + ⟨0, 1⟩) p - + GridRayCrossingIndex q p) = 1) + ) := by + classical + intro p x y hhead hlast hnodup hlen hadj hclose + exact GridRayCrossingIndexAdjacentCell p x y hhead hlast hnodup hlen hadj hclose + +private theorem boundary_edge_segment : + (by + classical + exact + ∀ (T : ProtoTile), (∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges T) → (e.card + = 2)) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), {a, b} ∈ BoundaryFootprintEdges T + → ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (((1 : ℝ) - (↑t : ℝ)) * (↑a.re : ℝ) + + (↑t : ℝ) * (↑b.re : ℝ), ((1 : ℝ) - (↑t : ℝ)) * (↑a.im : ℝ) + (↑t : ℝ) * (↑b.im : ℝ)) + ∈ TileRealization T) + ) := by + classical + intro T boundary_edge_card_two a b hab + have habne : a ≠ b := by + intro heq + subst b + have hc := boundary_edge_card_two {a, a} hab + simp at hc + intro t + rcases hab with ⟨q, (⟨heq, hocc⟩ | ⟨heq, hocc⟩)⟩ + · have ha : a = q ∨ a = q + 1 := by + have : a ∈ ({q, q + 1} : Finset GaussianInt) := by rw [← heq]; simp + simpa using this + have hb : b = q ∨ b = q + 1 := by + have : b ∈ ({q, q + 1} : Finset GaussianInt) := by rw [← heq]; simp + simpa using this + rcases hocc with ⟨hq, _⟩ | ⟨_, hq⟩ + · rw [TileRealization] + refine Set.mem_iUnion.2 ⟨q, Set.mem_iUnion.2 ⟨hq, ?_⟩⟩ + rcases ha with rfl | rfl + · rcases hb with rfl | rfl + · exact (habne rfl).elim + · simp [ClosedSquareRealization] + constructor <;> constructor <;> linarith [t.property.1, t.property.2] + · rcases hb with rfl | rfl + · simp [ClosedSquareRealization] + constructor <;> constructor <;> linarith [t.property.1, t.property.2] + · exact (habne rfl).elim + · rw [TileRealization] + refine Set.mem_iUnion.2 ⟨q - ⟨0, 1⟩, Set.mem_iUnion.2 ⟨hq, ?_⟩⟩ + rcases ha with rfl | rfl + · rcases hb with rfl | rfl + · exact (habne rfl).elim + · simp [ClosedSquareRealization] + constructor <;> constructor <;> linarith [t.property.1, t.property.2] + · rcases hb with rfl | rfl + · simp [ClosedSquareRealization] + constructor <;> constructor <;> linarith [t.property.1, t.property.2] + · exact (habne rfl).elim + · have ha : a = q ∨ a = q + ⟨0, 1⟩ := by + have : a ∈ ({q, q + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← heq]; simp + simpa using this + have hb : b = q ∨ b = q + ⟨0, 1⟩ := by + have : b ∈ ({q, q + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← heq]; simp + simpa using this + rcases hocc with ⟨hq, _⟩ | ⟨_, hq⟩ + · rw [TileRealization] + refine Set.mem_iUnion.2 ⟨q, Set.mem_iUnion.2 ⟨hq, ?_⟩⟩ + rcases ha with rfl | rfl + · rcases hb with rfl | rfl + · exact (habne rfl).elim + · simp [ClosedSquareRealization] + constructor <;> constructor <;> linarith [t.property.1, t.property.2] + · rcases hb with rfl | rfl + · simp [ClosedSquareRealization] + constructor <;> constructor <;> linarith [t.property.1, t.property.2] + · exact (habne rfl).elim + · rw [TileRealization] + refine Set.mem_iUnion.2 ⟨q - 1, Set.mem_iUnion.2 ⟨hq, ?_⟩⟩ + rcases ha with rfl | rfl + · rcases hb with rfl | rfl + · exact (habne rfl).elim + · simp [ClosedSquareRealization] + constructor <;> constructor <;> linarith [t.property.1, t.property.2] + · rcases hb with rfl | rfl + · simp [ClosedSquareRealization] + constructor <;> constructor <;> linarith [t.property.1, t.property.2] + · exact (habne rfl).elim + +private theorem unoccupied_center_outside : + (by + classical + exact + ∀ (T : ProtoTile), (List GaussianInt) → (∀ q ∉ T.cells, ((↑q.re : ℝ) + (1 / 2 : ℝ), + (↑q.im : ℝ) + (1 / 2 : ℝ)) ∉ TileRealization T) + ) := by + classical + intro T gridPath q hq hcenter + rw [TileRealization] at hcenter + simp only [Set.mem_iUnion] at hcenter + rcases hcenter with ⟨w, hw, hqw⟩ + simp only [ClosedSquareRealization, Set.mem_Icc] at hqw + have hre_lt : (w.re : Int) < q.re + 1 := by + exact_mod_cast (show ((w.re : Int) : Real) < ((q.re : Int) : Real) + 1 by + linarith [hqw.1.1]) + have hre_gt : (q.re : Int) < w.re + 1 := by + exact_mod_cast (show ((q.re : Int) : Real) < ((w.re : Int) : Real) + 1 by + linarith [hqw.2.1]) + have him_lt : (w.im : Int) < q.im + 1 := by + exact_mod_cast (show ((w.im : Int) : Real) < ((q.im : Int) : Real) + 1 by + linarith [hqw.1.2]) + have him_gt : (q.im : Int) < w.im + 1 := by + exact_mod_cast (show ((q.im : Int) : Real) < ((w.im : Int) : Real) + 1 by + linarith [hqw.2.2]) + have hwq : w = q := by + apply Zsqrtd.ext <;> omega + exact hq (hwq ▸ hw) + +private theorem unoccupied_index_zero : + (by + classical + exact + ∀ (T : ProtoTile), (∀ (q : LatticeCell), ∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ + (y : GaussianInt), ((((q.re : Int) : Real) + (1 / 2 : Real)), (((q.im : Int) : Real) + + (1 / 2 : Real))) ∉ TileRealization T → p.head? = some x → p.getLast? = some y → (∀ + a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, p = l₁ ++ a :: b :: l₂ → + FourNeighborAdjacent a b) → FourNeighborAdjacent y x → (∀ a b : GaussianInt, ((∃ l₁ + l₂ : List GaussianInt, p = l₁ ++ a :: b :: l₂) ∨ (a = y ∧ b = x)) → ∀ t : Set.Icc (0 + : Real) 1, ((1 - (t : Real)) * ((a.re : Int) : Real) + (t : Real) * ((b.re : Int) : + Real), (1 - (t : Real)) * ((a.im : Int) : Real) + (t : Real) * ((b.im : Int) : Real)) + ∈ TileRealization T) → GridRayCrossingIndex q p = 0) → (∀ (gridPath : List + GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), + (gridPath.head? = some x) → ((gridPath.getLast? = some y) → ((List.IsChain (fun (a b + : GaussianInt) => {a, b} ∈ BoundaryFootprintEdges T) gridPath) → (({y, x} ∈ + BoundaryFootprintEdges T) → ((List.IsChain FourNeighborAdjacent gridPath) → + ((FourNeighborAdjacent y x) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), (a, b) ∈ + gridPath.zip gridPath.tail ++ [(y, x)] → {a, b} ∈ BoundaryFootprintEdges T) → ((∀ (a + : GaussianInt), ∀ (b : GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail ++ [(y, x)] + → FourNeighborAdjacent a b) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), a ∈ + gridPath → {a, b} ∈ BoundaryFootprintEdges T → (a, b) ∈ gridPath.zip gridPath.tail ++ + [(y, x)] ∨ (b, a) ∈ gridPath.zip gridPath.tail ++ [(y, x)]) → (((z + (1 : + GaussianInt), z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ gridPath.zip + gridPath.tail ++ [(y, x)] ∨ (z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩, z + (1 : + GaussianInt)) ∈ gridPath.zip gridPath.tail ++ [(y, x)]) → ( + let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] + ( + let cyclicEdges := gridPath.zip gridPath.tail ++ [(y, x)]; + ∀ (q : LatticeCell), ((q + (1 : LatticeCell), q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ + cyclicEdges ∧ + (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell)) ∉ cyclicEdges → + GridRayCrossingIndex (q + (1 : LatticeCell)) gridPath = GridRayCrossingIndex q gridPath) ∧ + ((q + (1 : LatticeCell), q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ + (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell)) ∈ cyclicEdges → + (GridRayCrossingIndex (q + (1 : LatticeCell)) gridPath - GridRayCrossingIndex q + gridPath).natAbs = (1 : ℕ)) ∧ + ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges ∧ + (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ + cyclicEdges → + GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) gridPath = GridRayCrossingIndex q + gridPath) ∧ + ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ + cyclicEdges ∨ + (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ + cyclicEdges → + (GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) gridPath - + GridRayCrossingIndex q gridPath).natAbs = + (1 : ℕ))) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, b} : Finset + GaussianInt) ∈ BoundaryFootprintEdges T) → (∀ t : Set.Icc (0 : Real) 1, ((1 - + (t : Real)) * ((a.re : Int) : Real) + (t : Real) * ((b.re : Int) : Real), (1 + - (t : Real)) * ((a.im : Int) : Real) + (t : Real) * ((b.im : Int) : Real)) ∈ + TileRealization T)) → ((∀ a b : GaussianInt, (a, b) ∈ cyclicEdges → ∀ t : + Set.Icc (0 : Real) 1, ((1 - (t : Real)) * ((a.re : Int) : Real) + (t : Real) + * ((b.re : Int) : Real), (1 - (t : Real)) * ((a.im : Int) : Real) + (t : + Real) * ((b.im : Int) : Real)) ∈ TileRealization T) → ((∀ (q : LatticeCell), + (q ∉ T.cells) → (((((q.re : Int) : Real) + (1 / 2 : Real)), (((q.im : Int) : + Real) + (1 / 2 : Real))) ∉ TileRealization T)) → (∀ q ∉ T.cells, + GridRayCrossingIndex q gridPath = (0 : ℤ)))))))))))))))) + ) := by + classical + intro T closed_grid_index_zero gridPath x y z gridPath_head gridPath_last gridPath_chain + gridPath_close gridPath_fourNeighbor gridPath_close_fourNeighbor cyclic_edge_boundary + cyclic_edge_fourNeighbor component_edge_cyclic hrightCyclic cyclicEdges + component_index_control boundary_edge_segment cyclic_edge_segment unoccupied_center_outside + q hq + apply closed_grid_index_zero q gridPath x y + (unoccupied_center_outside q hq) gridPath_head gridPath_last + · intro a b l₁ l₂ hab + rw [hab] at gridPath_fourNeighbor + exact (List.isChain_append_cons_cons.mp gridPath_fourNeighbor).2.1 + · exact gridPath_close_fourNeighbor + · intro a b hab + apply boundary_edge_segment a b + rcases hab with ⟨l₁, l₂, hab⟩ | ⟨rfl, rfl⟩ + · rw [hab] at gridPath_chain + exact (List.isChain_append_cons_cons.mp gridPath_chain).2.1 + · exact gridPath_close + +private theorem occupied_vertical_not_boundary : + (by + classical + exact + ∀ (T : ProtoTile), (List GaussianInt) → ((GaussianInt) → (∀ q ∈ T.cells, q - (1 : + LatticeCell) ∈ T.cells → {q, q + ⟨(0 : ℤ), (1 : ℤ)⟩} ∉ BoundaryFootprintEdges T)) + ) := by + classical + intro T gridPath z q hq hleft + rintro ⟨w, (⟨heq, hxor⟩ | ⟨heq, hxor⟩)⟩ + · have hw : w = q ∨ w = q + ⟨0, 1⟩ := by + have : w ∈ ({q, q + ⟨0, 1⟩} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + have hw1 : w + 1 = q ∨ w + 1 = q + ⟨0, 1⟩ := by + have : w + 1 ∈ ({q, q + ⟨0, 1⟩} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + rcases hw with rfl | rfl <;> simp [Zsqrtd.ext_iff] at hw1 + · have hw : w = q ∨ w = q + ⟨0, 1⟩ := by + have : w ∈ ({q, q + ⟨0, 1⟩} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + rcases hw with rfl | hw + · simp [hq, hleft] at hxor + · subst w + have hw2 : q + ⟨0, 1⟩ + ⟨0, 1⟩ = q ∨ + q + ⟨0, 1⟩ + ⟨0, 1⟩ = q + ⟨0, 1⟩ := by + have : q + ⟨0, 1⟩ + ⟨0, 1⟩ ∈ + ({q, q + ⟨0, 1⟩} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + rcases hw2 with hw2 | hw2 <;> + have hbad := congrArg Zsqrtd.im hw2 <;> simp at hbad; omega + +private theorem occupied_horizontal_not_boundary : + (by + classical + exact + ∀ (T : ProtoTile), (List GaussianInt) → ((GaussianInt) → (∀ q ∈ T.cells, q - ⟨(0 : ℤ), (1 + : ℤ)⟩ ∈ T.cells → {q, q + (1 : LatticeCell)} ∉ BoundaryFootprintEdges T)) + ) := by + classical + intro T gridPath z q hq hbelow + rintro ⟨w, (⟨heq, hxor⟩ | ⟨heq, hxor⟩)⟩ + · have hw : w = q ∨ w = q + 1 := by + have : w ∈ ({q, q + 1} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + rcases hw with rfl | hw + · simp [hq, hbelow] at hxor + · subst w + have hw2 : q + 1 + 1 = q ∨ q + 1 + 1 = q + 1 := by + have : q + 1 + 1 ∈ ({q, q + 1} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + rcases hw2 with hw2 | hw2 <;> + have hbad := congrArg Zsqrtd.re hw2 <;> simp at hbad; omega + · have hw : w = q ∨ w = q + 1 := by + have : w ∈ ({q, q + 1} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + have hwi : w + ⟨0, 1⟩ = q ∨ w + ⟨0, 1⟩ = q + 1 := by + have : w + ⟨0, 1⟩ ∈ ({q, q + 1} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + rcases hw with rfl | rfl <;> simp [Zsqrtd.ext_iff] at hwi + +private theorem occupied_adjacent_index_eq : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (gridPath : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), (∀ (a : GaussianInt), ∀ (b : GaussianInt), (a, b) ∈ gridPath.zip + gridPath.tail ++ [(y, x)] → {a, b} ∈ BoundaryFootprintEdges T) → ( + ( + let cyclicEdges := gridPath.zip gridPath.tail ++ [(y, x)]; + ∀ (q : LatticeCell), ((q + (1 : LatticeCell), q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ + cyclicEdges ∧ + (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell)) ∉ cyclicEdges → + GridRayCrossingIndex (q + (1 : LatticeCell)) gridPath = GridRayCrossingIndex q gridPath) ∧ + ((q + (1 : LatticeCell), q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ + (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell)) ∈ cyclicEdges → + (GridRayCrossingIndex (q + (1 : LatticeCell)) gridPath - GridRayCrossingIndex q + gridPath).natAbs = (1 : ℕ)) ∧ + ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges ∧ + (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ + cyclicEdges → + GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) gridPath = GridRayCrossingIndex q + gridPath) ∧ + ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ + cyclicEdges ∨ + (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ + cyclicEdges → + (GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) gridPath - + GridRayCrossingIndex q gridPath).natAbs = + (1 : ℕ))) → ((∀ (q : LatticeCell), (q ∈ T.cells) → ((q - 1 ∈ T.cells) → (({q, + q + ⟨0, 1⟩} : Finset GaussianInt) ∉ BoundaryFootprintEdges T))) → ((∀ (q : + LatticeCell), (q ∈ T.cells) → ((q - ⟨0, 1⟩ ∈ T.cells) → (({q, q + 1} : Finset + GaussianInt) ∉ BoundaryFootprintEdges T))) → (∀ (a : LatticeCell), ∀ (b : + LatticeCell), a ∈ T.cells → b ∈ T.cells → FourNeighborAdjacent a b → + GridRayCrossingIndex a gridPath = GridRayCrossingIndex b gridPath)))) + ) := by + classical + intro T gridPath x y cyclic_edge_boundary component_index_control + occupied_vertical_not_boundary occupied_horizontal_not_boundary a b ha hb hab + rcases hab with rfl | rfl | rfl | rfl + · symm + apply (component_index_control a).1 + constructor <;> intro hc + · have hE := cyclic_edge_boundary _ _ hc + exact occupied_vertical_not_boundary (a + 1) hb + (by simpa [Zsqrtd.ext_iff] using ha) + (by simpa [Zsqrtd.ext_iff] using hE) + · have hE := cyclic_edge_boundary _ _ hc + exact occupied_vertical_not_boundary (a + 1) hb + (by simpa [Zsqrtd.ext_iff] using ha) + (by simpa [Finset.pair_comm, Zsqrtd.ext_iff] using hE) + · have h := (component_index_control (a - 1)).1 + have hleft : a - 1 ∈ T.cells := hb + have hright : a - 1 + 1 ∈ T.cells := by + simpa [Zsqrtd.ext_iff] using ha + have heq := h ⟨ + (fun hc => occupied_vertical_not_boundary (a - 1 + 1) hright + (by simpa [Zsqrtd.ext_iff] using hleft) + (by have hE := cyclic_edge_boundary _ _ hc + simpa [Zsqrtd.ext_iff] using hE)), + (fun hc => occupied_vertical_not_boundary (a - 1 + 1) hright + (by simpa [Zsqrtd.ext_iff] using hleft) + (by have hE := cyclic_edge_boundary _ _ hc + simpa [Finset.pair_comm, Zsqrtd.ext_iff] using hE))⟩ + simpa [Zsqrtd.ext_iff] using heq + · symm + apply (component_index_control a).2.2.1 + constructor <;> intro hc + · have hE := cyclic_edge_boundary _ _ hc + exact occupied_horizontal_not_boundary (a + ⟨0, 1⟩) hb + (by simpa [Zsqrtd.ext_iff] using ha) + (by simpa [Finset.pair_comm, Zsqrtd.ext_iff, add_assoc, add_comm, + add_left_comm] using hE) + · have hE := cyclic_edge_boundary _ _ hc + exact occupied_horizontal_not_boundary (a + ⟨0, 1⟩) hb + (by simpa [Zsqrtd.ext_iff] using ha) + (by simpa [Zsqrtd.ext_iff, add_assoc, add_comm, add_left_comm] using hE) + · have h := (component_index_control (a - ⟨0, 1⟩)).2.2.1 + have hbelow : a - ⟨0, 1⟩ ∈ T.cells := hb + have htop : a - ⟨0, 1⟩ + ⟨0, 1⟩ ∈ T.cells := by + simpa [Zsqrtd.ext_iff] using ha + have heq := h ⟨ + (fun hc => occupied_horizontal_not_boundary + (a - ⟨0, 1⟩ + ⟨0, 1⟩) htop + (by simpa [Zsqrtd.ext_iff] using hbelow) + (by have hE := cyclic_edge_boundary _ _ hc + simpa [Finset.pair_comm, Zsqrtd.ext_iff, add_assoc, add_comm, + add_left_comm] using hE)), + (fun hc => occupied_horizontal_not_boundary + (a - ⟨0, 1⟩ + ⟨0, 1⟩) htop + (by simpa [Zsqrtd.ext_iff] using hbelow) + (by have hE := cyclic_edge_boundary _ _ hc + simpa [Zsqrtd.ext_iff, add_assoc, add_comm, add_left_comm] using hE))⟩ + simpa [Zsqrtd.ext_iff] using heq + +private theorem occupied_index_eq_z : + (by + classical + exact + ∀ (T : ProtoTile), (LatticeTile T) → (∀ (gridPath : List GaussianInt), ∀ (z : + GaussianInt), (z ∈ T.cells) → ((∀ (a : LatticeCell), ∀ (b : LatticeCell), (a ∈ + T.cells) → ((b ∈ T.cells) → ((FourNeighborAdjacent a b) → (GridRayCrossingIndex a + gridPath = GridRayCrossingIndex b gridPath)))) → (∀ q ∈ T.cells, GridRayCrossingIndex + q gridPath = GridRayCrossingIndex z gridPath))) + ) := by + classical + intro T hT gridPath z hz occupied_adjacent_index_eq q hq + obtain ⟨r, hrHead, hrLast, hrMem, hrAdj⟩ := + (LatticeTileFourNeighborConnected T hT).2 q hq z hz + have hrChain : List.IsChain FourNeighborAdjacent r := by + rw [List.isChain_iff_forall_rel_of_append_cons_cons] + exact hrAdj + have hrIndexChain : List.IsChain + (fun a b : LatticeCell => + GridRayCrossingIndex a gridPath = GridRayCrossingIndex b gridPath) r := by + exact hrChain.imp_of_mem_imp (fun a b ha hb hab => + occupied_adjacent_index_eq a b (hrMem a ha) (hrMem b hb) hab) + cases r with + | nil => simp at hrHead + | cons a r => + have haq : a = q := by simpa using Option.some.inj hrHead + subst a + have hzmem : z ∈ q :: r := by + rcases List.getLast?_eq_some_iff.mp hrLast with ⟨l, hl⟩ + rw [hl] + simp + simp only [List.mem_cons] at hzmem + rcases hzmem with hzq | hzmem + · exact congrArg (fun w => GridRayCrossingIndex w gridPath) hzq.symm + · exact hrIndexChain.rel_cons hzmem + +private theorem boundary_edge_cyclic : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (gridPath : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), + let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] + ( + let cyclicEdges := gridPath.zip gridPath.tail ++ [(y, x)]; + ∀ (q : LatticeCell), ((q + (1 : LatticeCell), q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ + cyclicEdges ∧ + (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell)) ∉ cyclicEdges → + GridRayCrossingIndex (q + (1 : LatticeCell)) gridPath = GridRayCrossingIndex q gridPath) ∧ + ((q + (1 : LatticeCell), q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ + (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell)) ∈ cyclicEdges → + (GridRayCrossingIndex (q + (1 : LatticeCell)) gridPath - GridRayCrossingIndex q + gridPath).natAbs = (1 : ℕ)) ∧ + ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges ∧ + (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ + cyclicEdges → + GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) gridPath = GridRayCrossingIndex q + gridPath) ∧ + ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ + cyclicEdges ∨ + (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ + cyclicEdges → + (GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) gridPath - + GridRayCrossingIndex q gridPath).natAbs = + (1 : ℕ))) → ((∀ (q : LatticeCell), (q ∉ T.cells) → (GridRayCrossingIndex q + gridPath = 0)) → ((∀ (q : LatticeCell), (q ∈ T.cells) → (GridRayCrossingIndex + q gridPath ≠ 0)) → (∀ e ∈ BoundaryFootprintEdges T, ∃ (a : GaussianInt) (b : + GaussianInt), e = {a, b} ∧ ((a, b) ∈ cyclicEdges ∨ (b, a) ∈ cyclicEdges)))) + ) := by + classical + intro T gridPath x y cyclicEdges component_index_control unoccupied_index_zero + occupied_index_nonzero e he + rcases he with ⟨q, (⟨rfl, hxor⟩ | ⟨rfl, hxor⟩)⟩ + · refine ⟨q, q + 1, rfl, ?_⟩ + by_contra hnone + rw [not_or] at hnone + have hcontrol := (component_index_control (q - ⟨0, 1⟩)).2.2.1 + have heq : GridRayCrossingIndex q gridPath = + GridRayCrossingIndex (q - ⟨0, 1⟩) gridPath := by + have hraw := hcontrol (by + constructor + · simpa [cyclicEdges, Zsqrtd.ext_iff, add_assoc, add_comm, + add_left_comm] using hnone.2 + · simpa [cyclicEdges, Zsqrtd.ext_iff, add_assoc, add_comm, + add_left_comm] using hnone.1) + simpa [Zsqrtd.ext_iff] using hraw + rcases hxor with ⟨hq, hbelow⟩ | ⟨hq, hbelow⟩ + · rw [unoccupied_index_zero (q - ⟨0, 1⟩) hbelow] at heq + exact occupied_index_nonzero q hq heq + · rw [unoccupied_index_zero q hq] at heq + exact occupied_index_nonzero (q - ⟨0, 1⟩) hbelow heq.symm + · refine ⟨q, q + ⟨0, 1⟩, rfl, ?_⟩ + by_contra hnone + rw [not_or] at hnone + have hcontrol := (component_index_control (q - 1)).1 + have heq : GridRayCrossingIndex q gridPath = + GridRayCrossingIndex (q - 1) gridPath := by + have hraw := hcontrol (by + constructor + · simpa [cyclicEdges, Zsqrtd.ext_iff] using hnone.1 + · simpa [cyclicEdges, Zsqrtd.ext_iff] using hnone.2) + simpa [Zsqrtd.ext_iff] using hraw + rcases hxor with ⟨hq, hleft⟩ | ⟨hq, hleft⟩ + · rw [unoccupied_index_zero (q - 1) hleft] at heq + exact occupied_index_nonzero q hq heq + · rw [unoccupied_index_zero q hq] at heq + exact occupied_index_nonzero (q - 1) hleft heq.symm + +private theorem zip_mem_decompose : + (by + classical + exact + ∀ (gridPath : List GaussianInt), (GaussianInt) → (((4 : ℕ) ≤ gridPath.length) → (∀ (a : + GaussianInt), ∀ (b : GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail → ∃ (l₁ : List + GaussianInt) (l₂ : List GaussianInt), gridPath = l₁ ++ a :: b :: l₂)) + ) := by + classical + intro gridPath z gridPath_length_four a b hab + rw [List.mem_iff_getElem] at hab + rcases hab with ⟨i, hi, hab⟩ + have hi' : i < gridPath.tail.length := by + simpa [List.length_zip] using hi + have hi0 : i < gridPath.length := by + simp only [List.length_tail] at hi' + omega + have hi1 : i + 1 < gridPath.length := by + simp only [List.length_tail] at hi' + omega + rw [List.getElem_zip, List.getElem_tail] at hab + injection hab with ha hb + refine ⟨gridPath.take i, gridPath.drop (i + 2), ?_⟩ + calc + gridPath = gridPath.take i ++ gridPath.drop i := + (List.take_append_drop i gridPath).symm + _ = gridPath.take i ++ gridPath[i] :: gridPath.drop (i + 1) := by + rw [List.drop_eq_getElem_cons hi0] + _ = gridPath.take i ++ gridPath[i] :: gridPath[i + 1] :: + gridPath.drop (i + 2) := by + rw [List.drop_eq_getElem_cons hi1] + _ = gridPath.take i ++ a :: b :: gridPath.drop (i + 2) := by + rw [ha, hb] + +private theorem cyclic_endpoints_mem : + (by + classical + exact + ∀ (gridPath : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), + (gridPath.head? = some x) → ((gridPath.getLast? = some y) → ( + let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] + (∀ (a : GaussianInt), ∀ (b : GaussianInt), ((a, b) ∈ gridPath.zip gridPath.tail) → (∃ l₁ + l₂ : List GaussianInt, gridPath = l₁ ++ a :: b :: l₂)) → (∀ (a : GaussianInt), ∀ (b : + GaussianInt), (a, b) ∈ cyclicEdges → a ∈ gridPath ∧ b ∈ gridPath))) + ) := by + classical + intro gridPath x y gridPath_head gridPath_last cyclicEdges zip_mem_decompose a b hab + simp only [cyclicEdges, List.mem_append, List.mem_singleton] at hab + rcases hab with hab | hab + · rcases zip_mem_decompose a b hab with ⟨l₁, l₂, hpath⟩ + rw [hpath] + simp + · have hab' : a = y ∧ b = x := Prod.mk.inj hab + constructor + · rw [hab'.1] + exact List.getLast?_eq_some_iff.mp gridPath_last |>.choose_spec ▸ + (by simp) + · rw [hab'.2] + rcases List.head?_eq_some_iff.mp gridPath_head with ⟨l, hl⟩ + rw [hl] + simp + +private theorem boundary_vertices_eq : + (by + classical + exact + ∀ (T : ProtoTile), (T.cells.Nonempty) → (∀ (gridPath : List GaussianInt), ∀ (x : + GaussianInt), ∀ (y : GaussianInt), (∀ a ∈ gridPath, a ∈ BoundaryFootprintVertices T) → ( + let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] + (∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges T) → (∃ a b : GaussianInt, e = + {a, b} ∧ ((a, b) ∈ cyclicEdges ∨ (b, a) ∈ cyclicEdges))) → ((∀ (a : GaussianInt), ∀ + (b : GaussianInt), ((a, b) ∈ cyclicEdges) → (a ∈ gridPath ∧ b ∈ gridPath)) → + (BoundaryFootprintVertices T = (gridPath.toFinset : Set GaussianInt))))) + ) := by + classical + intro T cells_nonempty gridPath x y gridPath_mem_boundary cyclicEdges boundary_edge_cyclic + cyclic_endpoints_mem + ext v + constructor + · intro hv + rw [BoundaryFootprintVertices, ite_eq_left cells_nonempty] at hv + rcases hv with ⟨e, he, hve⟩ + rcases boundary_edge_cyclic e he with ⟨a, b, rfl, hab⟩ + simp only [Finset.mem_insert, Finset.mem_singleton] at hve + rw [Finset.mem_coe, List.mem_toFinset] + rcases hab with hab | hab + · rcases cyclic_endpoints_mem a b hab with ⟨ha, hb⟩ + exact hve.elim (fun h => h ▸ ha) (fun h => h ▸ hb) + · rcases cyclic_endpoints_mem b a hab with ⟨hb, ha⟩ + exact hve.elim (fun h => h ▸ ha) (fun h => h ▸ hb) + · intro hv + rw [Finset.mem_coe, List.mem_toFinset] at hv + exact gridPath_mem_boundary v hv + +private theorem boundary_edges_iff : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (gridPath : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), (List.IsChain (fun (a b : GaussianInt) => {a, b} ∈ + BoundaryFootprintEdges T) gridPath) → (({y, x} ∈ BoundaryFootprintEdges T) → ( + let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] + (∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges T) → (∃ a b : GaussianInt, e = + {a, b} ∧ ((a, b) ∈ cyclicEdges ∨ (b, a) ∈ cyclicEdges))) → ((∀ (a : GaussianInt), ∀ + (b : GaussianInt), ((a, b) ∈ gridPath.zip gridPath.tail) → (∃ l₁ l₂ : List + GaussianInt, gridPath = l₁ ++ a :: b :: l₂)) → (∀ (e : Finset GaussianInt), e ∈ + BoundaryFootprintEdges T ↔ e = {y, x} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : + List GaussianInt) (l₂ : List GaussianInt), gridPath = l₁ ++ a :: b :: l₂ ∧ e = {a, + b})))) + ) := by + classical + intro T gridPath x y gridPath_chain gridPath_close cyclicEdges boundary_edge_cyclic + zip_mem_decompose e + constructor + · intro he + rcases boundary_edge_cyclic e he with ⟨a, b, heq, hab⟩ + rcases hab with hab | hab + · simp only [cyclicEdges, List.mem_append, List.mem_singleton] at hab + rcases hab with hab | hab + · right + rcases zip_mem_decompose a b hab with ⟨l₁, l₂, hp⟩ + exact ⟨a, b, l₁, l₂, hp, heq⟩ + · left + have hab' : a = y ∧ b = x := Prod.mk.inj hab + simpa [hab'.1, hab'.2] using heq + · simp only [cyclicEdges, List.mem_append, List.mem_singleton] at hab + rcases hab with hab | hab + · right + rcases zip_mem_decompose b a hab with ⟨l₁, l₂, hp⟩ + refine ⟨b, a, l₁, l₂, hp, ?_⟩ + simpa [Finset.pair_comm] using heq + · left + have hab' : b = y ∧ a = x := Prod.mk.inj hab + simpa [hab'.1, hab'.2, Finset.pair_comm] using heq + · rintro (rfl | ⟨a, b, l₁, l₂, hp, rfl⟩) + · exact gridPath_close + · rw [hp] at gridPath_chain + exact (List.isChain_append_cons_cons.mp gridPath_chain).2.1 + +end BoundaryCycleProof + +theorem LatticeTileBoundarySimpleGridCycle (T : ProtoTile) (hT : LatticeTile T) : + SimpleGridCycle (BoundaryFootprintVertices T) + (BoundaryFootprintEdges T) := by +-- BODY + classical + have closed_grid_index_zero : + ∀ (q : LatticeCell) (p : List GaussianInt) (x y : GaussianInt), + ((((q.re : Int) : Real) + (1 / 2 : Real)), + (((q.im : Int) : Real) + (1 / 2 : Real))) ∉ TileRealization T → + p.head? = some x → p.getLast? = some y → + (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → + FourNeighborAdjacent y x → + (∀ a b : GaussianInt, + ((∃ l₁ l₂ : List GaussianInt, p = l₁ ++ a :: b :: l₂) ∨ + (a = y ∧ b = x)) → + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * ((a.re : Int) : Real) + + (t : Real) * ((b.re : Int) : Real), + (1 - (t : Real)) * ((a.im : Int) : Real) + + (t : Real) * ((b.im : Int) : Real)) ∈ TileRealization T) → + GridRayCrossingIndex q p = 0 := BoundaryCycleProof.closed_grid_index_zero T hT + have cells_nonempty : T.cells.Nonempty := by + have realization_nonempty : (TileRealization T).Nonempty := by + rcases hT with ⟨e⟩ + let x : Metric.closedBall (0 : Real × Real) 1 := ⟨0, by simp⟩ + exact ⟨e x, (e x).property⟩ + rcases realization_nonempty with ⟨p, hp⟩ + simp only [TileRealization, Set.mem_iUnion] at hp + rcases hp with ⟨x, hx, _⟩ + exact ⟨x, hx⟩ + have boundary_degree_two : + ∀ v ∈ BoundaryFootprintVertices T, + Set.ncard {e : Finset GaussianInt | + e ∈ BoundaryFootprintEdges T ∧ v ∈ e} = 2 := by + intro v hv + exact BoundaryFootprintVertexDegreeTwo T cells_nonempty + (LatticeTileNoCheckerboard T hT) v hv + have adjacent_grid_index_control : + ∀ (p : List GaussianInt) (x y : GaussianInt), + p.head? = some x → p.getLast? = some y → p.Nodup → 3 ≤ p.length → + (∀ a b, (a, b) ∈ p.zip p.tail → FourNeighborAdjacent a b) → + FourNeighborAdjacent y x → + let cyclicEdges := (p.zip p.tail) ++ [(y, x)] + ∀ q : LatticeCell, + (((q + 1, q + 1 + ⟨0, 1⟩) ∉ cyclicEdges ∧ + (q + 1 + ⟨0, 1⟩, q + 1) ∉ cyclicEdges) → + GridRayCrossingIndex (q + 1) p = GridRayCrossingIndex q p) ∧ + (((q + 1, q + 1 + ⟨0, 1⟩) ∈ cyclicEdges ∨ + (q + 1 + ⟨0, 1⟩, q + 1) ∈ cyclicEdges) → + Int.natAbs (GridRayCrossingIndex (q + 1) p - + GridRayCrossingIndex q p) = 1) ∧ + (((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∉ cyclicEdges ∧ + (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) ∉ cyclicEdges) → + GridRayCrossingIndex (q + ⟨0, 1⟩) p = + GridRayCrossingIndex q p) ∧ + (((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∈ cyclicEdges ∨ + (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) ∈ cyclicEdges) → + Int.natAbs (GridRayCrossingIndex (q + ⟨0, 1⟩) p - + GridRayCrossingIndex q p) = 1) := BoundaryCycleProof.adjacent_grid_index_control + obtain ⟨gridPath, x, y, z, gridPath_nodup, gridPath_length_four, + gridPath_head, gridPath_last, gridPath_chain, gridPath_close, + gridPath_fourNeighbor, gridPath_close_fourNeighbor, gridPath_zip_fourNeighbor, + gridPath_mem_boundary, hz, hmax, hzout, cyclic_edge_boundary, + cyclic_edge_fourNeighbor, component_edge_cyclic, hrightCyclic⟩ := + P5620T1BoundaryComponentCycle T cells_nonempty boundary_degree_two + have gridPath_length : 3 ≤ gridPath.length := by omega + have component_index_control := adjacent_grid_index_control gridPath x y + gridPath_head gridPath_last gridPath_nodup gridPath_length + gridPath_zip_fourNeighbor gridPath_close_fourNeighbor + let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] + have boundary_edge_card_two (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) : e.card = 2 := by + rcases he with ⟨z, (⟨rfl, hz⟩ | ⟨rfl, hz⟩)⟩ + · simp [] + · simp [Zsqrtd.ext_iff] + have boundary_edge_segment (a b : GaussianInt) + (hab : ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) : + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * ((a.re : Int) : Real) + + (t : Real) * ((b.re : Int) : Real), + (1 - (t : Real)) * ((a.im : Int) : Real) + + (t : Real) * ((b.im : Int) : Real)) ∈ TileRealization T := + BoundaryCycleProof.boundary_edge_segment T boundary_edge_card_two a b hab + have cyclic_edge_segment : + ∀ a b : GaussianInt, (a, b) ∈ cyclicEdges → + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * ((a.re : Int) : Real) + + (t : Real) * ((b.re : Int) : Real), + (1 - (t : Real)) * ((a.im : Int) : Real) + + (t : Real) * ((b.im : Int) : Real)) ∈ TileRealization T := by + intro a b hab + exact boundary_edge_segment a b (cyclic_edge_boundary a b hab) + have unoccupied_center_outside (q : LatticeCell) (hq : q ∉ T.cells) : + ((((q.re : Int) : Real) + (1 / 2 : Real)), + (((q.im : Int) : Real) + (1 / 2 : Real))) ∉ TileRealization T := + BoundaryCycleProof.unoccupied_center_outside T gridPath q hq + have unoccupied_index_zero (q : LatticeCell) (hq : q ∉ T.cells) : + GridRayCrossingIndex q gridPath = 0 := BoundaryCycleProof.unoccupied_index_zero T + closed_grid_index_zero gridPath x y z gridPath_head gridPath_last gridPath_chain + gridPath_close gridPath_fourNeighbor gridPath_close_fourNeighbor cyclic_edge_boundary + cyclic_edge_fourNeighbor component_edge_cyclic hrightCyclic component_index_control + boundary_edge_segment cyclic_edge_segment unoccupied_center_outside q hq + have hrightJump : + Int.natAbs (GridRayCrossingIndex (z + 1) gridPath - + GridRayCrossingIndex z gridPath) = 1 := by + exact (component_index_control z).2.1 hrightCyclic + have hzIndexNonzero : GridRayCrossingIndex z gridPath ≠ 0 := by + intro hz0 + rw [unoccupied_index_zero (z + 1) hzout, hz0] at hrightJump + simp at hrightJump + have occupied_vertical_not_boundary (q : LatticeCell) + (hq : q ∈ T.cells) (hleft : q - 1 ∈ T.cells) : + ({q, q + ⟨0, 1⟩} : Finset GaussianInt) ∉ BoundaryFootprintEdges T := + BoundaryCycleProof.occupied_vertical_not_boundary T gridPath z q hq hleft + have occupied_horizontal_not_boundary (q : LatticeCell) + (hq : q ∈ T.cells) (hbelow : q - ⟨0, 1⟩ ∈ T.cells) : + ({q, q + 1} : Finset GaussianInt) ∉ BoundaryFootprintEdges T := + BoundaryCycleProof.occupied_horizontal_not_boundary T gridPath z q hq hbelow + have occupied_adjacent_index_eq (a b : LatticeCell) + (ha : a ∈ T.cells) (hb : b ∈ T.cells) + (hab : FourNeighborAdjacent a b) : + GridRayCrossingIndex a gridPath = GridRayCrossingIndex b gridPath := + BoundaryCycleProof.occupied_adjacent_index_eq T gridPath x y cyclic_edge_boundary + component_index_control occupied_vertical_not_boundary occupied_horizontal_not_boundary + a b ha hb hab + have occupied_index_eq_z (q : LatticeCell) (hq : q ∈ T.cells) : + GridRayCrossingIndex q gridPath = GridRayCrossingIndex z gridPath := + BoundaryCycleProof.occupied_index_eq_z T hT gridPath z hz occupied_adjacent_index_eq q hq + have occupied_index_nonzero (q : LatticeCell) (hq : q ∈ T.cells) : + GridRayCrossingIndex q gridPath ≠ 0 := by + rw [occupied_index_eq_z q hq] + exact hzIndexNonzero + have boundary_edge_cyclic (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) : + ∃ a b : GaussianInt, e = {a, b} ∧ + ((a, b) ∈ cyclicEdges ∨ (b, a) ∈ cyclicEdges) := BoundaryCycleProof.boundary_edge_cyclic + T gridPath x y component_index_control unoccupied_index_zero occupied_index_nonzero e he + have zip_mem_decompose (a b : GaussianInt) + (hab : (a, b) ∈ gridPath.zip gridPath.tail) : + ∃ l₁ l₂ : List GaussianInt, gridPath = l₁ ++ a :: b :: l₂ := + BoundaryCycleProof.zip_mem_decompose gridPath z gridPath_length_four a b hab + have cyclic_endpoints_mem (a b : GaussianInt) (hab : (a, b) ∈ cyclicEdges) : + a ∈ gridPath ∧ b ∈ gridPath := BoundaryCycleProof.cyclic_endpoints_mem gridPath x y + gridPath_head gridPath_last zip_mem_decompose a b hab + have boundary_vertices_eq : + BoundaryFootprintVertices T = (gridPath.toFinset : Set GaussianInt) := + BoundaryCycleProof.boundary_vertices_eq T cells_nonempty gridPath x y + gridPath_mem_boundary boundary_edge_cyclic cyclic_endpoints_mem + have boundary_edges_iff (e : Finset GaussianInt) : + e ∈ BoundaryFootprintEdges T ↔ + e = {y, x} ∨ + ∃ a b : GaussianInt, ∃ l₁ l₂ : List GaussianInt, + gridPath = l₁ ++ a :: b :: l₂ ∧ e = {a, b} := BoundaryCycleProof.boundary_edges_iff T + gridPath x y gridPath_chain gridPath_close boundary_edge_cyclic zip_mem_decompose e + refine ⟨gridPath, x, y, gridPath_nodup, gridPath_length_four, + gridPath_head, gridPath_last, boundary_vertices_eq, gridPath_close_fourNeighbor, ?_, ?_⟩ + · intro a b l₁ l₂ hab + rw [hab] at gridPath_fourNeighbor + exact (List.isChain_append_cons_cons.mp gridPath_fourNeighbor).2.1 + · exact boundary_edges_iff + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean new file mode 100644 index 0000000000..f7593bbe96 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean @@ -0,0 +1,723 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle + +-- [TABLET NODE: LatticeTileComplementGridConnected] + +/-! +# LatticeTileComplementGridConnected + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ComplementGridPaths + +private theorem adjacent_symm : + (by + classical + exact + ∀ {a : LatticeCell}, ∀ {b : LatticeCell}, FourNeighborAdjacent a b → FourNeighborAdjacent + b a ) := by + classical + intro a b h + rcases h with h | h | h | h <;> subst b + all_goals simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + +private theorem reach_symm : + (by + classical + exact + ∀ (T : ProtoTile), + let S : Set LatticeCell := T.cells + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S + let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step + (∀ {a : LatticeCell}, ∀ {b : LatticeCell}, (step a b) → (step b a)) → (∀ + {a : LatticeCell}, ∀ {b : LatticeCell}, reach a b → reach b a) ) := by + classical + intro T S step reach step_symm a b h + induction h with + | refl => exact Relation.ReflTransGen.refl + | tail h hstep ih => + exact Relation.ReflTransGen.trans + (Relation.ReflTransGen.single (step_symm hstep)) ih + +private theorem reach_target_out : + (by + classical + exact + ∀ (T : ProtoTile), + let S : Set LatticeCell := T.cells + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S + let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step + ∀ {a : LatticeCell}, ∀ {b : LatticeCell}, a ∉ S → reach a b → b ∉ S ) := by + classical + intro T S step reach a b ha h + induction h with + | refl => exact ha + | tail h hstep ih => exact hstep.2.2 + +private theorem local_outside_reach : + (by + classical + exact + ∀ (T : ProtoTile), + let S : Set LatticeCell := T.cells + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S + let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step + (∀ {a : LatticeCell}, ∀ {b : LatticeCell}, (reach a b) → (reach b a)) → ((∀ + {a : LatticeCell}, ∀ {b : LatticeCell}, (a ∉ S) → ((b ∉ S) → ((FourNeighborAdjacent a + b) → (reach a b)))) → ((NoCheckerboardCellVertex S) → ( + let around (v q : LatticeCell) : Prop := + q = v ∨ q = v - 1 ∨ q = v - ⟨0, 1⟩ ∨ q = v - 1 - ⟨0, 1⟩ + ∀ {v : LatticeCell}, ∀ {q : LatticeCell}, ∀ {r : LatticeCell}, around v q → around v r → + q ∉ S → r ∉ S → reach q r))) ) := by + classical + intro T S step reach reach_symm one_step hchecker around v q r hq hr hqS hrS + have diagA (hv : v ∉ S) (hsw : v - 1 - ⟨0, 1⟩ ∉ S) : + reach v (v - 1 - ⟨0, 1⟩) := by + by_cases hnw : v - 1 ∈ S + · have hse : v - ⟨0, 1⟩ ∉ S := by + intro hse + exact hchecker v (Or.inr ⟨hnw, hse, hv, hsw⟩) + exact Relation.ReflTransGen.trans + (one_step hv hse (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff])) + (one_step hse hsw (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff])) + · exact Relation.ReflTransGen.trans + (one_step hv hnw (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff])) + (one_step hnw hsw (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff])) + have diagB (hnw : v - 1 ∉ S) (hse : v - ⟨0, 1⟩ ∉ S) : + reach (v - 1) (v - ⟨0, 1⟩) := by + by_cases hne : v ∈ S + · have hsw : v - 1 - ⟨0, 1⟩ ∉ S := by + intro hsw + exact hchecker v (Or.inl ⟨hne, hsw, hnw, hse⟩) + exact Relation.ReflTransGen.trans + (one_step hnw hsw (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff])) + (one_step hsw hse (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff])) + · exact Relation.ReflTransGen.trans + (one_step hnw hne (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff])) + (one_step hne hse (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff])) + rcases hq with hq | hq | hq | hq <;> + rcases hr with hr | hr | hr | hr <;> + rw [hq] at hqS ⊢ <;> + rw [hr] at hrS ⊢ + all_goals first + | exact diagA hqS hrS + | exact reach_symm (diagA hrS hqS) + | exact diagB hqS hrS + | exact reach_symm (diagB hrS hqS) + | exact one_step hqS hrS (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) + +private theorem boundary_outside_local : + (by + classical + exact + ∀ (T : ProtoTile), + let S : Set LatticeCell := T.cells + let around (v q : LatticeCell) : Prop := + q = v ∨ q = v - 1 ∨ q = v - ⟨0, 1⟩ ∨ q = v - 1 - ⟨0, 1⟩ + ∀ {a : LatticeCell}, ∀ {b : LatticeCell}, FourNeighborAdjacent a b → {a, b} ∈ + BoundaryFootprintEdges T → ∃ q ∉ S, around a q ∧ around b q ) := by + classical + intro T S around a b hab he + have habne : a ≠ b := by + intro h + subst b + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] at hab + omega + rcases he with ⟨z, (⟨hez, hz⟩ | ⟨hez, hz⟩)⟩ + · have ha : a = z ∨ a = z + 1 := by + have : a ∈ ({z, z + 1} : Finset GaussianInt) := by rw [← hez]; simp + simpa using this + have hb : b = z ∨ b = z + 1 := by + have : b ∈ ({z, z + 1} : Finset GaussianInt) := by rw [← hez]; simp + simpa using this + rcases hz with ⟨hzS, hzout⟩ | ⟨hzout, hzS⟩ + · refine ⟨z - ⟨0, 1⟩, ?_, ?_, ?_⟩ + · simpa [S] using hzout + · rcases ha with rfl | rfl + · exact Or.inr (Or.inr (Or.inl rfl)) + · exact Or.inr (Or.inr (Or.inr (by + simp [sub_eq_add_neg, add_assoc]))) + · rcases hb with rfl | rfl + · exact Or.inr (Or.inr (Or.inl rfl)) + · exact Or.inr (Or.inr (Or.inr (by + simp [sub_eq_add_neg, add_assoc]))) + · refine ⟨z, ?_, ?_, ?_⟩ + · simpa [S] using hzout + · rcases ha with rfl | rfl + · exact Or.inl rfl + · exact Or.inr (Or.inl (by simp)) + · rcases hb with rfl | rfl + · exact Or.inl rfl + · exact Or.inr (Or.inl (by simp)) + · have ha : a = z ∨ a = z + ⟨0, 1⟩ := by + have : a ∈ ({z, z + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← hez]; simp + simpa using this + have hb : b = z ∨ b = z + ⟨0, 1⟩ := by + have : b ∈ ({z, z + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← hez]; simp + simpa using this + rcases hz with ⟨hzS, hzout⟩ | ⟨hzout, hzS⟩ + · refine ⟨z - 1, ?_, ?_, ?_⟩ + · simpa [S] using hzout + · rcases ha with rfl | rfl + · exact Or.inr (Or.inl rfl) + · exact Or.inr (Or.inr (Or.inr (by + simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm]))) + · rcases hb with rfl | rfl + · exact Or.inr (Or.inl rfl) + · exact Or.inr (Or.inr (Or.inr (by + simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm]))) + · refine ⟨z, ?_, ?_, ?_⟩ + · simpa [S] using hzout + · rcases ha with rfl | rfl + · exact Or.inl rfl + · exact Or.inr (Or.inr (Or.inl (by simp))) + · rcases hb with rfl | rfl + · exact Or.inl rfl + · exact Or.inr (Or.inr (Or.inl (by simp))) + +private theorem hpEdgeRel : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (∀ + (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List + GaussianInt), p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → ((∀ (e : Finset + GaussianInt), e ∈ BoundaryFootprintEdges T ↔ e = {y, x} ∨ ∃ (a : GaussianInt) (b : + GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ + ∧ e = {a, b}) → ( + let edgeRel (a b : LatticeCell) : Prop := + FourNeighborAdjacent a b ∧ + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T + List.IsChain edgeRel p)) ) := by + classical + intro T p x y hpAdjacent hpEdges edgeRel + rw [List.isChain_iff_forall_rel_of_append_cons_cons] + intro a b l₁ l₂ hp + refine ⟨hpAdjacent a b l₁ l₂ hp, ?_⟩ + exact (hpEdges {a, b}).2 (Or.inr ⟨a, b, l₁, l₂, hp, rfl⟩) + +private theorem good_step : + (by + classical + exact + ∀ (T : ProtoTile), + let S : Set LatticeCell := T.cells + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S + let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step + let around (v q : LatticeCell) : Prop := + q = v ∨ q = v - 1 ∨ q = v - ⟨0, 1⟩ ∨ q = v - 1 - ⟨0, 1⟩ + (∀ {v : LatticeCell}, ∀ {q : LatticeCell}, ∀ {r : LatticeCell}, (around v q) → ((around v + r) → ((q ∉ S) → ((r ∉ S) → (reach q r))))) → ((∀ {a : LatticeCell}, ∀ + {b : LatticeCell}, (FourNeighborAdjacent a b) → ((({a, b} : Finset GaussianInt) ∈ + BoundaryFootprintEdges T) → (∃ q, q ∉ S ∧ around a q ∧ around b q))) → (∀ (base : + LatticeCell), + let good (v : LatticeCell) : Prop := + ∃ q, q ∉ S ∧ around v q ∧ reach q base + let edgeRel (a b : LatticeCell) : Prop := + FourNeighborAdjacent a b ∧ + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T + ∀ {a : LatticeCell}, ∀ {b : LatticeCell}, good a → edgeRel a b → good b)) ) := by + classical + intro T S step reach around local_outside_reach boundary_outside_local base good edgeRel a b ha + hab + rcases ha with ⟨q, hqOut, hqa, hqbase⟩ + rcases boundary_outside_local hab.1 hab.2 with ⟨r, hrOut, hra, hrb⟩ + exact ⟨r, hrOut, hrb, + Relation.ReflTransGen.trans (local_outside_reach hra hqa hrOut hqOut) hqbase⟩ + +private theorem chain_good : + (by + classical + exact + ∀ (T : ProtoTile), + let S : Set LatticeCell := T.cells + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S + let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step + let around (v q : LatticeCell) : Prop := + q = v ∨ q = v - 1 ∨ q = v - ⟨0, 1⟩ ∨ q = v - 1 - ⟨0, 1⟩ + ∀ (base : LatticeCell), + let good (v : LatticeCell) : Prop := + ∃ q, q ∉ S ∧ around v q ∧ reach q base + let edgeRel (a b : LatticeCell) : Prop := + FourNeighborAdjacent a b ∧ + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T + (∀ {a : LatticeCell}, ∀ {b : LatticeCell}, (good a) → ((edgeRel a b) → (good b))) → (∀ (a + : LatticeCell), ∀ (l : List LatticeCell), good a → List.IsChain edgeRel (a :: l) → ∀ + v ∈ a :: l, good v) ) := by + classical + intro T S step reach around base good edgeRel good_step a l + induction l generalizing a with + | nil => + intro ha _ v hv + simp only [List.mem_singleton] at hv + subst v + exact ha + | cons b l ih => + intro ha hchain v hv + rw [List.isChain_cons] at hchain + have hab : edgeRel a b := hchain.1 b (by simp) + have hb : good b := good_step ha hab + rcases List.mem_cons.mp hv with rfl | hv + · exact ha + · exact ih b hb hchain.2 v hv + +private theorem hpNonempty : + (by + classical + exact + ∀ (p : List GaussianInt), ∀ (x : GaussianInt), (p.head? = some x) → (p ≠ []) ) := by + classical + intro p x hpHead hp + simp [hp] at hpHead + +private theorem all_good : + (by + classical + exact + ∀ (T : ProtoTile), + let S : Set LatticeCell := T.cells + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S + let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step + let around (v q : LatticeCell) : Prop := + q = v ∨ q = v - 1 ∨ q = v - ⟨0, 1⟩ ∨ q = v - 1 - ⟨0, 1⟩ + ∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (p.Nodup) → (((4 : ℕ) + ≤ p.length) → ((p.head? = some x) → ((p.getLast? = some y) → + ((BoundaryFootprintVertices T = (↑p.toFinset : Set GaussianInt)) → ((∀ (a : + GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List + GaussianInt), p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → ((∀ (e : Finset + GaussianInt), e ∈ BoundaryFootprintEdges T ↔ e = {y, x} ∨ ∃ (a : GaussianInt) (b : + GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ + ∧ e = {a, b}) → (∀ (base : LatticeCell), + let good (v : LatticeCell) : Prop := + ∃ q, q ∉ S ∧ around v q ∧ reach q base + (good x) → ( + let edgeRel (a b : LatticeCell) : Prop := + FourNeighborAdjacent a b ∧ + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T + (List.IsChain edgeRel p) → ((∀ (a : LatticeCell), ∀ (l : List LatticeCell), good a → + List.IsChain edgeRel (a :: l) → ∀ v ∈ a :: l, good v) → ((p ≠ []) → (∀ v ∈ p, good + v))))))))))) ) := by + classical + intro T S step reach around p x y hpNodup hpLength hpHead hpLast hpVerts hpAdjacent hpEdges + base good hgoodX edgeRel hpEdgeRel chain_good hpNonempty + cases p with + | nil => exact (hpNonempty rfl).elim + | cons a l => + simp only [List.head?_cons, Option.some.injEq] at hpHead + subst a + exact chain_good x l hgoodX hpEdgeRel + +private theorem boundary_outside_reaches : + (by + classical + exact + ∀ (T : ProtoTile), + let S : Set LatticeCell := T.cells + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S + let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step + let around (v q : LatticeCell) : Prop := + q = v ∨ q = v - 1 ∨ q = v - ⟨0, 1⟩ ∨ q = v - 1 - ⟨0, 1⟩ + (∀ {v : LatticeCell}, ∀ {q : LatticeCell}, ∀ {r : LatticeCell}, (around v q) → ((around v + r) → ((q ∉ S) → ((r ∉ S) → (reach q r))))) → (∀ (p : List GaussianInt), ∀ (x : + GaussianInt), ∀ (y : GaussianInt), (∀ (e : Finset GaussianInt), e ∈ + BoundaryFootprintEdges T ↔ e = {y, x} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : + List GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (∀ + (base : LatticeCell), + let good (v : LatticeCell) : Prop := + ∃ q, q ∉ S ∧ around v q ∧ reach q base + (∀ v ∈ p, good v) → ((x ∈ p) → ((y ∈ p) → (∀ {e : Finset GaussianInt}, ∀ + {v : LatticeCell}, ∀ {q : LatticeCell}, e ∈ BoundaryFootprintEdges T → v ∈ e → q ∉ S + → around v q → reach q base))))) ) := by + classical + intro T S step reach around local_outside_reach p x y hpEdges base good all_good hxmem hymem e + v q he hv hqOut hqv + have hvGood : good v := by + rcases (hpEdges e).1 he with heclose | hepath + · rw [heclose] at hv + simp only [Finset.mem_insert, Finset.mem_singleton] at hv + rcases hv with hv | hv + · subst v + exact all_good y hymem + · subst v + exact all_good x hxmem + · rcases hepath with ⟨a, b, l₁, l₂, hp, rfl⟩ + simp only [Finset.mem_insert, Finset.mem_singleton] at hv + rcases hv with hv | hv + · subst v + exact all_good a (by rw [hp]; simp) + · subst v + exact all_good b (by rw [hp]; simp) + rcases hvGood with ⟨r, hrOut, hrv, hrbase⟩ + exact Relation.ReflTransGen.trans + (local_outside_reach hqv hrv hqOut hrOut) hrbase + +private theorem hexteriorOut : + (by + classical + exact + ∀ (T : ProtoTile), + let S : Set LatticeCell := T.cells + (List GaussianInt) → (∀ (z : LatticeCell), (∀ x' ∈ T.cells, x'.re ≤ z.re) → ( + let exterior : LatticeCell := z + 1 + exterior ∉ S)) ) := by + classical + intro T S p z hzmax exterior he + have hle := hzmax exterior he + dsimp [exterior] at hle + omega + +private theorem hrightEdge : + (by + classical + exact + ∀ (T : ProtoTile), + let S : Set LatticeCell := T.cells + ∀ (z : LatticeCell), (z ∈ S) → ( + let exterior : LatticeCell := z + 1 + (exterior ∉ S) → ( + let rightEdge : Finset GaussianInt := {z + 1, z + 1 + ⟨0, 1⟩} + rightEdge ∈ BoundaryFootprintEdges T)) ) := by + classical + intro T S z hzS exterior hexteriorOut rightEdge + refine ⟨z + 1, Or.inr ⟨rfl, Or.inr ⟨?_, ?_⟩⟩⟩ + · exact hexteriorOut + · simpa [S, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hzS + +private theorem hexteriorBase : + (by + classical + exact + ∀ (T : ProtoTile), + let S : Set LatticeCell := T.cells + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S + let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step + let around (v q : LatticeCell) : Prop := + q = v ∨ q = v - 1 ∨ q = v - ⟨0, 1⟩ ∨ q = v - 1 - ⟨0, 1⟩ + ∀ (base : LatticeCell), (∀ {e : Finset GaussianInt}, ∀ {v : LatticeCell}, ∀ + {q : LatticeCell}, (e ∈ BoundaryFootprintEdges T) → ((v ∈ e) → ((q ∉ S) → ((around v + q) → (reach q base))))) → (∀ (z : LatticeCell), + let exterior : LatticeCell := z + 1 + (exterior ∉ S) → ( + let rightEdge : Finset GaussianInt := {z + 1, z + 1 + ⟨0, 1⟩} + (rightEdge ∈ BoundaryFootprintEdges T) → (reach exterior base))) ) := by + classical + intro T S step reach around base boundary_outside_reaches z exterior hexteriorOut rightEdge + hrightEdge + apply boundary_outside_reaches (v := z + 1) (q := exterior) hrightEdge + · change z + 1 ∈ ({z + 1, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) + simp + · exact hexteriorOut + · exact Or.inl rfl + +private theorem right_halfplane : + (by + classical + exact + ∀ (T : ProtoTile), + let S : Set LatticeCell := T.cells + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S + let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step + (∀ {a : LatticeCell}, ∀ {b : LatticeCell}, (a ∉ S) → ((b ∉ S) → ((FourNeighborAdjacent a + b) → (reach a b)))) → ((List GaussianInt) → (∀ (z : LatticeCell), (∀ x' ∈ T.cells, + x'.re ≤ z.re) → ( + let exterior : LatticeCell := z + 1 + ∀ (q : LatticeCell), z.re < q.re → reach q exterior))) ) := by + classical + intro T S step reach one_step p z hzmax exterior q hq + let column (k : Int) : LatticeCell := ⟨q.re, k⟩ + have column_out (k : Int) : column k ∉ S := by + intro hkS + have := hzmax (column k) hkS + simp [column] at this + omega + have vertical : reach q (column z.im) := by + have hqcol : q = column q.im := by + apply Zsqrtd.ext <;> simp [column] + rw [hqcol] + exact Int.inductionOn' q.im z.im Relation.ReflTransGen.refl + (fun k _ ih => Relation.ReflTransGen.trans + (one_step (column_out (k + 1)) (column_out k) + (by simp [column, FourNeighborAdjacent, Zsqrtd.ext_iff])) ih) + (fun k _ ih => Relation.ReflTransGen.trans + (one_step (column_out (k - 1)) (column_out k) + (by simp [column, FourNeighborAdjacent, Zsqrtd.ext_iff])) ih) + let row (n : Nat) : LatticeCell := ⟨z.re + 1 + n, z.im⟩ + have row_out (n : Nat) : row n ∉ S := by + intro hnS + have := hzmax (row n) hnS + simp [row] at this + omega + have row_reach : ∀ n : Nat, reach (row n) exterior := by + intro n + induction n with + | zero => + have : row 0 = exterior := by + apply Zsqrtd.ext <;> simp [row, exterior] + rw [this] + | succ n ih => + exact Relation.ReflTransGen.trans + (one_step (row_out (n + 1)) (row_out n) + (by + simp [row, FourNeighborAdjacent, Zsqrtd.ext_iff] + omega)) ih + let n : Nat := Int.natAbs (q.re - (z.re + 1)) + have hncast : (n : Int) = q.re - (z.re + 1) := by + exact Int.natAbs_of_nonneg (by omega) + have hcolrow : column z.im = row n := by + apply Zsqrtd.ext + · simp [column, row, hncast] + · simp [column, row] + rw [hcolrow] at vertical + exact Relation.ReflTransGen.trans vertical (row_reach n) + +private theorem every_outside_reaches : + (by + classical + exact + ∀ (T : ProtoTile), + let S : Set LatticeCell := T.cells + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S + let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step + (∀ {a : LatticeCell}, ∀ {b : LatticeCell}, (a ∉ S) → ((reach a b) → (b ∉ S))) → ( + let around (v q : LatticeCell) : Prop := + q = v ∨ q = v - 1 ∨ q = v - ⟨0, 1⟩ ∨ q = v - 1 - ⟨0, 1⟩ + (List GaussianInt) → (∀ (base : LatticeCell), (∀ {e : Finset GaussianInt}, ∀ + {v : LatticeCell}, ∀ {q : LatticeCell}, (e ∈ BoundaryFootprintEdges T) → ((v ∈ e) → + ((q ∉ S) → ((around v q) → (reach q base))))) → (∀ (z : LatticeCell), + let exterior : LatticeCell := z + 1 + (reach exterior base) → ((∀ (q : LatticeCell), (z.re < q.re) → (reach q exterior)) → (∀ q + ∉ S, reach q base))))) ) := by + classical + intro T S step reach reach_target_out around p base boundary_outside_reaches z exterior + hexteriorBase right_halfplane q hqOut + by_contra hqbase + have hqle : q.re ≤ z.re := by + by_contra hnot + exact hqbase (Relation.ReflTransGen.trans + (right_halfplane q (by omega)) hexteriorBase) + let distance (r : LatticeCell) : Nat := Int.natAbs (z.re - r.re) + have hfind : ∃ n, ∃ r : LatticeCell, reach q r ∧ n = distance r := + ⟨distance q, q, Relation.ReflTransGen.refl, rfl⟩ + let n := Nat.find hfind + rcases Nat.find_spec hfind with ⟨r, hqr, hn⟩ + have hrOut : r ∉ S := reach_target_out hqOut hqr + have hrbase : ¬ reach r base := by + intro hrbase + exact hqbase (Relation.ReflTransGen.trans hqr hrbase) + have hrle : r.re ≤ z.re := by + by_contra hnot + exact hrbase (Relation.ReflTransGen.trans + (right_halfplane r (by omega)) hexteriorBase) + have hmax : ∀ s : LatticeCell, reach q s → s.re ≤ r.re := by + intro s hqs + have hsbase : ¬ reach s base := by + intro hsbase + exact hqbase (Relation.ReflTransGen.trans hqs hsbase) + have hsle : s.re ≤ z.re := by + by_contra hnot + exact hsbase (Relation.ReflTransGen.trans + (right_halfplane s (by omega)) hexteriorBase) + have hmin := Nat.find_min' hfind ⟨s, hqs, rfl⟩ + rw [hn] at hmin + simp only [distance, + ] at hmin + omega + have hrRightNotReach : ¬ reach q (r + 1) := by + intro hreach + have := hmax (r + 1) hreach + simp at this + have hrRightS : r + 1 ∈ S := by + by_contra hout + apply hrRightNotReach + exact Relation.ReflTransGen.tail hqr + ⟨by simp [FourNeighborAdjacent, Zsqrtd.ext_iff], hrOut, hout⟩ + let e : Finset GaussianInt := {r + 1, r + 1 + ⟨0, 1⟩} + have he : e ∈ BoundaryFootprintEdges T := by + refine ⟨r + 1, Or.inr ⟨rfl, Or.inl ⟨hrRightS, ?_⟩⟩⟩ + simpa [S, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hrOut + have hrbase' : reach r base := by + apply boundary_outside_reaches (v := r + 1) (q := r) he + · dsimp [e] + simp + · exact hrOut + · exact Or.inr (Or.inl (by simp)) + exact hrbase hrbase' + +private theorem walk_of_reach : + (by + classical + exact + ∀ (T : ProtoTile), + let S : Set LatticeCell := T.cells + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S + let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step + ∀ {u : LatticeCell}, ∀ {v : LatticeCell}, u ∉ S → reach u v → ∃ p : List LatticeCell, + p.head? = some u ∧ p.getLast? = some v ∧ (∀ w ∈ p, w ∉ S) ∧ ∀ c d : LatticeCell, ∀ l₁ + l₂ : List LatticeCell, p = l₁ ++ c :: d :: l₂ → FourNeighborAdjacent c d ) := by + classical + intro T S step reach u v huOut huv + induction huv using Relation.ReflTransGen.head_induction_on with + | refl => + refine ⟨[v], by simp, by simp, ?_, ?_⟩ + · intro w hw + rcases List.mem_singleton.mp hw with rfl + exact huOut + · exact (List.isChain_iff_forall_rel_of_append_cons_cons).1 + (List.isChain_singleton v) + | @head u c huv hcv ih => + rcases huv with ⟨huv, huOut, hcOut⟩ + rcases ih hcOut with ⟨p, hpHead, hpLast, hpOut, hpAdjacent⟩ + have hpne : p ≠ [] := by + intro hp + simp [hp] at hpHead + have hpchain : List.IsChain FourNeighborAdjacent p := + (List.isChain_iff_forall_rel_of_append_cons_cons).2 hpAdjacent + have hchain : List.IsChain FourNeighborAdjacent (u :: p) := by + rw [List.isChain_cons] + exact ⟨by simpa [hpHead] using huv, hpchain⟩ + refine ⟨u :: p, by simp, ?_, ?_, + (List.isChain_iff_forall_rel_of_append_cons_cons).1 hchain⟩ + · cases p with + | nil => exact (hpne rfl).elim + | cons c p => simpa using hpLast + · intro w hw + simp only [List.mem_cons] at hw + rcases hw with rfl | hw + · exact huOut + · exact hpOut w hw + +end ComplementGridPaths + +theorem LatticeTileComplementGridConnected (T : ProtoTile) + (hT : LatticeTile T) : + FourNeighborConnected ((T.cells : Set LatticeCell)ᶜ) := by +-- BODY + classical + let S : Set LatticeCell := T.cells + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S + let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step + have adjacent_symm {a b : LatticeCell} (h : FourNeighborAdjacent a b) := + ComplementGridPaths.adjacent_symm (a := a) (b := b) h + have step_symm {a b : LatticeCell} (h : step a b) : step b a := + ⟨adjacent_symm h.1, h.2.2, h.2.1⟩ + have reach_symm {a b : LatticeCell} (h : reach a b) := ComplementGridPaths.reach_symm T + step_symm (a := a) (b := b) h + have reach_target_out {a b : LatticeCell} (ha : a ∉ S) (h : reach a b) := + ComplementGridPaths.reach_target_out T (a := a) (b := b) ha h + have one_step {a b : LatticeCell} (ha : a ∉ S) (hb : b ∉ S) + (hab : FourNeighborAdjacent a b) : reach a b := + Relation.ReflTransGen.single ⟨hab, ha, hb⟩ + have hgrid := LatticeTileGridStructure T hT + have hoccupied : FourNeighborConnected S := hgrid.1 + have hchecker : NoCheckerboardCellVertex S := hgrid.2.1 + have hcycle : SimpleGridCycle (BoundaryFootprintVertices T) + (BoundaryFootprintEdges T) := hgrid.2.2 + let around (v q : LatticeCell) : Prop := + q = v ∨ q = v - 1 ∨ q = v - ⟨0, 1⟩ ∨ q = v - 1 - ⟨0, 1⟩ + have local_outside_reach {v q r : LatticeCell} + (hq : around v q) (hr : around v r) (hqS : q ∉ S) (hrS : r ∉ S) := + ComplementGridPaths.local_outside_reach T reach_symm one_step hchecker (v := v) (q := + q) (r := r) hq hr hqS hrS + have boundary_outside_local {a b : LatticeCell} + (hab : FourNeighborAdjacent a b) + (he : ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) := + ComplementGridPaths.boundary_outside_local T (a := a) (b := b) hab he + rcases hcycle with ⟨p, x, y, hpNodup, hpLength, hpHead, hpLast, hpVerts, + hyx, hpAdjacent, hpEdges⟩ + have hclosingEdge : ({y, x} : Finset GaussianInt) ∈ BoundaryFootprintEdges T := + (hpEdges {y, x}).2 (Or.inl rfl) + rcases boundary_outside_local hyx hclosingEdge with + ⟨base, hbaseOut, hbaseY, hbaseX⟩ + let good (v : LatticeCell) : Prop := + ∃ q, q ∉ S ∧ around v q ∧ reach q base + have hgoodX : good x := + ⟨base, hbaseOut, hbaseX, Relation.ReflTransGen.refl⟩ + let edgeRel (a b : LatticeCell) : Prop := + FourNeighborAdjacent a b ∧ + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T + have hpEdgeRel := ComplementGridPaths.hpEdgeRel T p x y hpAdjacent hpEdges + have good_step {a b : LatticeCell} (ha : good a) (hab : edgeRel a b) := + ComplementGridPaths.good_step T local_outside_reach boundary_outside_local base (a := a) (b + := b) ha hab + have chain_good := ComplementGridPaths.chain_good T base good_step + have hpNonempty := ComplementGridPaths.hpNonempty p x hpHead + have all_good := ComplementGridPaths.all_good T p x y hpNodup hpLength hpHead hpLast hpVerts + hpAdjacent hpEdges base hgoodX hpEdgeRel chain_good hpNonempty + have hxmem : x ∈ p := by + exact List.mem_of_mem_head? (by simp [hpHead]) + have hymem : y ∈ p := by + exact List.mem_of_mem_getLast? (by simp [hpLast]) + have boundary_outside_reaches {e : Finset GaussianInt} {v q : LatticeCell} + (he : e ∈ BoundaryFootprintEdges T) (hv : v ∈ e) + (hqOut : q ∉ S) (hqv : around v q) := ComplementGridPaths.boundary_outside_reaches T + local_outside_reach p x y hpEdges base all_good hxmem hymem (e := e) (v := v) (q := q) + he hv hqOut hqv + rcases hoccupied.1 with ⟨z₀, hz₀⟩ + rcases Finset.exists_max_image T.cells (fun z : LatticeCell => z.re) + ⟨z₀, hz₀⟩ with ⟨z, hz, hzmax⟩ + have hzS : z ∈ S := hz + let exterior : LatticeCell := z + 1 + have hexteriorOut : exterior ∉ S := ComplementGridPaths.hexteriorOut T p z hzmax + let rightEdge : Finset GaussianInt := {z + 1, z + 1 + ⟨0, 1⟩} + have hrightEdge := ComplementGridPaths.hrightEdge T z hzS hexteriorOut + have hexteriorBase := ComplementGridPaths.hexteriorBase T base boundary_outside_reaches z + hexteriorOut hrightEdge + have right_halfplane (q : LatticeCell) (hq : z.re < q.re) := + ComplementGridPaths.right_halfplane T one_step p z hzmax q hq + have every_outside_reaches (q : LatticeCell) (hqOut : q ∉ S) := + ComplementGridPaths.every_outside_reaches T reach_target_out p base + boundary_outside_reaches z hexteriorBase right_halfplane q hqOut + constructor + · exact ⟨exterior, by simpa [S] using hexteriorOut⟩ + · intro a ha b hb + have haOut : a ∉ S := by simpa [S] using ha + have hbOut : b ∉ S := by simpa [S] using hb + have habReach : reach a b := Relation.ReflTransGen.trans + (every_outside_reaches a haOut) + (reach_symm (every_outside_reaches b hbOut)) + have walk_of_reach : ∀ {u v : LatticeCell}, u ∉ S → reach u v → + ∃ p : List LatticeCell, + p.head? = some u ∧ p.getLast? = some v ∧ + (∀ w ∈ p, w ∉ S) ∧ + ∀ c d : LatticeCell, ∀ l₁ l₂ : List LatticeCell, + p = l₁ ++ c :: d :: l₂ → FourNeighborAdjacent c d := + ComplementGridPaths.walk_of_reach T + rcases walk_of_reach haOut habReach with ⟨p, hpHead, hpLast, hpOut, hpAdjacent⟩ + exact ⟨p, hpHead, hpLast, by + intro w hw + simpa [S] using hpOut w hw, hpAdjacent⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileDiskUnionInterface.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileDiskUnionInterface.lean new file mode 100644 index 0000000000..32b5d3207a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileDiskUnionInterface.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonFootprintIncidence +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices +public import LeanPool.ApollonianSuperharmonic.ConnectedCommonBoundaryPath +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeDiskUnionIntersectionConnected +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: LatticeTileDiskUnionInterface] + +/-! +# LatticeTileDiskUnionInterface + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem LatticeTileDiskUnionInterface (U V W : ProtoTile) + (hU : LatticeTile U) (hV : LatticeTile V) (hW : LatticeTile W) + (hdisjoint : Disjoint U.cells V.cells) + (hunion : ∀ z : LatticeCell, + z ∈ W.cells ↔ z ∈ U.cells ∨ z ∈ V.cells) + (hcommon : + (FootprintEdges U ∩ FootprintEdges V).Nonempty) : + FootprintVertices U ∩ FootprintVertices V = + CommonFootprintEdgeVertices U V ∧ + (∃ x y : GaussianInt, + SimpleGridPathBetween + (CommonFootprintEdgeVertices U V) + (FootprintEdges U ∩ FootprintEdges V) x y) ∧ + FootprintEdges U ∩ FootprintEdges V = + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V ∧ + BoundaryFootprintVertices U ∩ BoundaryFootprintVertices V = + CommonFootprintEdgeVertices U V := by +-- BODY + have hUstructure := LatticeTileGridStructure U hU + have hVstructure := LatticeTileGridStructure V hV + have hUne : U.cells.Nonempty := hUstructure.1.1 + have hVne : V.cells.Nonempty := hVstructure.1.1 + have hconnected : IsConnected + (TileRealization U ∩ TileRealization V) := + LatticeDiskUnionIntersectionConnected U V W hU hV hW hdisjoint hunion hcommon + obtain ⟨hedges, hvertices, hboundaryVertices⟩ := + CellDisjointCommonFootprintIncidence U V hUne hVne hdisjoint + hconnected hcommon + have hpath : ∃ x y : GaussianInt, + SimpleGridPathBetween + (CommonFootprintEdgeVertices U V) + (FootprintEdges U ∩ FootprintEdges V) x y := + ConnectedCommonBoundaryPath U V hUne hVne hdisjoint hconnected + hUstructure.2.2 hVstructure.2.2 hcommon + exact ⟨hvertices, hpath, hedges, hboundaryVertices⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileFourNeighborConnected.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileFourNeighborConnected.lean new file mode 100644 index 0000000000..79196d1837 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileFourNeighborConnected.lean @@ -0,0 +1,402 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileNoCheckerboard +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: LatticeTileFourNeighborConnected] + +/-! +# LatticeTileFourNeighborConnected + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FourNeighborProof + +private theorem diskConnected : + IsConnected (Metric.closedBall (0 : Real × Real) 1) := by + classical + have box : Metric.closedBall (0 : Real × Real) 1 = + Set.Icc (-1 : Real) 1 ×ˢ Set.Icc (-1 : Real) 1 := by + ext p + simp only [Metric.mem_closedBall, Prod.dist_eq, Set.mem_prod, Set.mem_Icc] + constructor + · intro h + have parts := max_le_iff.mp h + norm_num at parts + constructor + · constructor + · simp only [Real.dist_eq] at parts + have q := abs_le.mp parts.1 + linarith + · simp only [Real.dist_eq] at parts + have q := abs_le.mp parts.1 + linarith + · constructor + · simp only [Real.dist_eq] at parts + have q := abs_le.mp parts.2 + linarith + · simp only [Real.dist_eq] at parts + have q := abs_le.mp parts.2 + linarith + · intro h + apply max_le + · rw [Real.dist_eq] + norm_num + exact abs_le.mpr ⟨by linarith [h.1.1], by linarith [h.1.2]⟩ + · rw [Real.dist_eq] + norm_num + exact abs_le.mpr ⟨by linarith [h.2.1], by linarith [h.2.2]⟩ + rw [box] + exact (isConnected_Icc (by norm_num)).prod (isConnected_Icc (by norm_num)) + +private theorem realizationConnected : + ∀ (T : ProtoTile), ∀ [ConnectedSpace (↑(TileRealization T) : Type)], IsConnected + (TileRealization T) := by + classical + intro T this + have imageConnected := + isConnected_univ.image (fun z : (TileRealization T) => (z : Real × Real)) + continuous_subtype_val.continuousOn + have imageIsRange : IsConnected + (Set.range (fun z : (TileRealization T) => (z : Real × Real))) := by + convert imageConnected using 1; ext p; simp + have rangeEq : Set.range (fun z : (TileRealization T) => (z : Real × Real)) = + TileRealization T := by + ext p + constructor + · rintro ⟨z, rfl⟩ + exact z.property + · intro hp + exact ⟨⟨p, hp⟩, rfl⟩ + rw [← rangeEq] + exact imageIsRange + +private theorem overlap : + ∀ (a : LatticeCell), ∀ (b : LatticeCell), ∀ (p : Real × Real), p ∈ ClosedSquareRealization a + → p ∈ ClosedSquareRealization b → a = b ∨ FourNeighborAdjacent a b ∨ (b = a + 1 + ⟨0, 1⟩ + ∨ b = a + 1 - ⟨0, 1⟩ ∨ b = a - 1 + ⟨0, 1⟩ ∨ b = a - 1 - ⟨0, 1⟩) := by + classical + intro a b p hp hq + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hp hq + have hrlo : (-1 : ℝ) ≤ (a.re : ℝ) - b.re := by + linarith [hp.1.1, hq.1.2] + have hrhi : (a.re : ℝ) - b.re ≤ 1 := by + linarith [hp.1.2, hq.1.1] + have hilo : (-1 : ℝ) ≤ (a.im : ℝ) - b.im := by + linarith [hp.2.1, hq.2.2] + have hihi : (a.im : ℝ) - b.im ≤ 1 := by + linarith [hp.2.2, hq.2.1] + have rlo : (-1 : ℤ) ≤ a.re - b.re := by exact_mod_cast hrlo + have rhi : a.re - b.re ≤ (1 : ℤ) := by exact_mod_cast hrhi + have ilo : (-1 : ℤ) ≤ a.im - b.im := by exact_mod_cast hilo + have ihi : a.im - b.im ≤ (1 : ℤ) := by exact_mod_cast hihi + have rd : a.re - b.re = -1 ∨ a.re - b.re = 0 ∨ a.re - b.re = 1 := by omega + have id : a.im - b.im = -1 ∨ a.im - b.im = 0 ∨ a.im - b.im = 1 := by omega + rcases rd with hr | hr | hr <;> rcases id with hi | hi | hi + all_goals + simp_all [FourNeighborAdjacent, Zsqrtd.ext_iff] + omega + +private theorem reachXY : + ∀ (T : ProtoTile), (IsConnected (TileRealization T)) → ((∀ (a : LatticeCell), ∀ (b : + LatticeCell), ∀ (p : Real × Real), p ∈ ClosedSquareRealization a → p ∈ + ClosedSquareRealization b → a = b ∨ FourNeighborAdjacent a b ∨ (b = a + 1 + ⟨0, 1⟩ ∨ b = + a + 1 - ⟨0, 1⟩ ∨ b = a - 1 + ⟨0, 1⟩ ∨ b = a - 1 - ⟨0, 1⟩)) → (∀ (x : LatticeCell), (x ∈ + (↑T.cells : Set LatticeCell)) → (∀ (y : LatticeCell), (y ∈ (↑T.cells : Set LatticeCell)) → ( + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∈ (T.cells : Set LatticeCell) ∧ + b ∈ (T.cells : Set LatticeCell) + let reachable : LatticeCell → LatticeCell → Prop := + Relation.ReflTransGen step + (∀ z : LatticeCell, (ClosedSquareRealization z).Nonempty) → ((∀ (a : LatticeCell), ∀ (b : + LatticeCell), a ∈ (T.cells : Set LatticeCell) → b ∈ (T.cells : Set LatticeCell) → ¬ + reachable a b → (b = a + 1 + ⟨0, 1⟩ ∨ b = a + 1 - ⟨0, 1⟩ ∨ b = a - 1 + ⟨0, 1⟩ ∨ b = a - 1 + - ⟨0, 1⟩) → False) → (reachable x y)))))) := by + classical + intro T realizationConnected overlap x hx y hy step reachable squareNonempty diagonalBridge + by_contra notReach + let component : Finset LatticeCell := + T.cells.filter (fun z => reachable x z) + let remainder : Finset LatticeCell := T.cells \ component + let firstUnion : Set (Real × Real) := + ⋃ z ∈ component, ClosedSquareRealization z + let secondUnion : Set (Real × Real) := + ⋃ z ∈ remainder, ClosedSquareRealization z + have hxComponent : x ∈ component := by + exact Finset.mem_filter.2 ⟨hx, Relation.ReflTransGen.refl⟩ + have hyRemainder : y ∈ remainder := by + refine Finset.mem_sdiff.2 ⟨hy, ?_⟩ + intro hyComponent + exact notReach (Finset.mem_filter.1 hyComponent).2 + have firstClosed : IsClosed firstUnion := by + dsimp [firstUnion] + apply isClosed_biUnion_finset + intro z hz + exact isClosed_Icc + have secondClosed : IsClosed secondUnion := by + dsimp [secondUnion] + apply isClosed_biUnion_finset + intro z hz + exact isClosed_Icc + have unionCovers : TileRealization T ⊆ firstUnion ∪ secondUnion := by + intro p hp + rw [TileRealization] at hp + simp only [Set.mem_iUnion] at hp + obtain ⟨z, hz, hpz⟩ := hp + by_cases hzC : z ∈ component + · left + exact Set.mem_iUnion.2 ⟨z, Set.mem_iUnion.2 ⟨hzC, hpz⟩⟩ + · right + have hzR : z ∈ remainder := by + exact Finset.mem_sdiff.2 ⟨hz, hzC⟩ + exact Set.mem_iUnion.2 ⟨z, Set.mem_iUnion.2 ⟨hzR, hpz⟩⟩ + have separated : firstUnion ∩ secondUnion = ∅ := by + rw [Set.eq_empty_iff_forall_notMem] + intro p hp + change p ∈ (⋃ z ∈ component, ClosedSquareRealization z) ∩ + (⋃ z ∈ remainder, ClosedSquareRealization z) at hp + have hfirstMem := hp.1 + have hsecondMem := hp.2 + rcases Set.mem_iUnion.1 hfirstMem with ⟨a, hfirstMem⟩ + rcases Set.mem_iUnion.1 hfirstMem with ⟨haC, hpa⟩ + rcases Set.mem_iUnion.1 hsecondMem with ⟨b, hsecondMem⟩ + rcases Set.mem_iUnion.1 hsecondMem with ⟨hbR, hpb⟩ + have haS : a ∈ (T.cells : Set LatticeCell) := + (Finset.mem_filter.1 haC).1 + have haReach : reachable x a := (Finset.mem_filter.1 haC).2 + have hbS : b ∈ (T.cells : Set LatticeCell) := + (Finset.mem_sdiff.1 hbR).1 + have hbNot : ¬ reachable x b := by + intro hbReach + exact (Finset.mem_sdiff.1 hbR).2 (Finset.mem_filter.2 ⟨hbS, hbReach⟩) + rcases overlap a b p hpa hpb with hab | hab | hab + · exact (Finset.mem_sdiff.1 hbR).2 (by simpa [hab] using haC) + · exact hbNot (Relation.ReflTransGen.trans haReach + (Relation.ReflTransGen.single ⟨hab, haS, hbS⟩)) + · exact diagonalBridge a b haS hbS (by + intro habReach + exact hbNot (Relation.ReflTransGen.trans haReach habReach)) hab + have firstPoint : ∃ p, p ∈ TileRealization T ∧ p ∈ firstUnion := by + rcases squareNonempty x with ⟨p, hp⟩ + refine ⟨p, ?_, ?_⟩ + · rw [TileRealization] + exact Set.mem_iUnion.2 ⟨x, Set.mem_iUnion.2 ⟨hx, hp⟩⟩ + · exact Set.mem_iUnion.2 ⟨x, Set.mem_iUnion.2 ⟨hxComponent, hp⟩⟩ + have secondPoint : ∃ p, p ∈ TileRealization T ∧ p ∈ secondUnion := by + rcases squareNonempty y with ⟨p, hp⟩ + refine ⟨p, ?_, ?_⟩ + · rw [TileRealization] + exact Set.mem_iUnion.2 ⟨y, Set.mem_iUnion.2 ⟨hy, hp⟩⟩ + · exact Set.mem_iUnion.2 ⟨y, Set.mem_iUnion.2 ⟨hyRemainder, hp⟩⟩ + have separatedRelative : TileRealization T ∩ (firstUnion ∩ secondUnion) = ∅ := by + rw [separated] + simp + rcases (isPreconnected_iff_subset_of_disjoint_closed.mp + realizationConnected.isPreconnected firstUnion secondUnion firstClosed secondClosed + unionCovers separatedRelative) with hfirst | hsecond + · obtain ⟨p, hpT, hpA⟩ := secondPoint + have hpAB : p ∈ firstUnion ∩ secondUnion := ⟨hfirst hpT, hpA⟩ + rw [separated] at hpAB + exact hpAB + · obtain ⟨p, hpT, hpB⟩ := firstPoint + have hpAB : p ∈ firstUnion ∩ secondUnion := ⟨hpB, hsecond hpT⟩ + rw [separated] at hpAB + exact hpAB + +private theorem walk : + ∀ (T : ProtoTile), + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∈ (T.cells : Set LatticeCell) ∧ + b ∈ (T.cells : Set LatticeCell) + let reachable : LatticeCell → LatticeCell → Prop := + Relation.ReflTransGen step + ∀ {a : LatticeCell}, ∀ {b : LatticeCell}, a ∈ (T.cells : Set LatticeCell) → b ∈ (T.cells : + Set LatticeCell) → reachable a b → ∃ p : List LatticeCell, p.head? = some a ∧ p.getLast? + = some b ∧ (∀ z ∈ p, z ∈ (T.cells : Set LatticeCell)) ∧ ∀ u v : LatticeCell, ∀ l₁ l₂ : + List LatticeCell, p = l₁ ++ u :: v :: l₂ → FourNeighborAdjacent u v := by + classical + intro T step reachable a b ha hb hab + induction hab using Relation.ReflTransGen.head_induction_on with + | refl => + exact ⟨[b], by simp, by simp, by + intro z hz + rcases List.mem_singleton.mp hz with rfl + exact hb, + (List.isChain_iff_forall_rel_of_append_cons_cons).1 + (List.isChain_singleton b)⟩ + | @head a₀ c hstep hrest ih => + rcases hstep with ⟨huv, ha', hc⟩ + rcases ih hc with ⟨p, hphead, hplast, hpinside, hpedge⟩ + have pne : p ≠ [] := by + intro hnil + simp [hnil] at hphead + have chainp : List.IsChain FourNeighborAdjacent p := + (List.isChain_iff_forall_rel_of_append_cons_cons).2 hpedge + have chainnew : List.IsChain FourNeighborAdjacent ([a₀] ++ p) := by + apply List.IsChain.append (by simp) chainp + intro u hu' v hv' + have huEq : u = a₀ := by simpa using hu'.symm + have hvEq : v = c := by simpa [hphead] using hv'.symm + simpa [huEq, hvEq] using huv + refine ⟨[a₀] ++ p, ?_, ?_, ?_, + (List.isChain_iff_forall_rel_of_append_cons_cons).1 chainnew⟩ + · simp + · cases p with + | nil => exact (pne rfl).elim + | cons q r => simpa using hplast + · intro z hz + simp only [List.mem_append, List.mem_singleton] at hz + rcases hz with rfl | hz + · exact ha' + · exact hpinside z hz + +end FourNeighborProof + +theorem LatticeTileFourNeighborConnected (T : ProtoTile) (hT : LatticeTile T) : + FourNeighborConnected (T.cells : Set LatticeCell) := by +-- BODY + classical + have diskConnected : IsConnected (Metric.closedBall (0 : Real × Real) 1) := + FourNeighborProof.diskConnected + rcases hT with ⟨home⟩ + have targetConnected : ConnectedSpace (TileRealization T) := by + rw [← home.connectedSpace_iff] + exact isConnected_iff_connectedSpace.mp diskConnected + let := targetConnected + have realizationConnected : IsConnected (TileRealization T) := + FourNeighborProof.realizationConnected T + have noChecker := LatticeTileNoCheckerboard T ⟨home⟩ + have overlap : ∀ (a b : LatticeCell) (p : Real × Real), + p ∈ ClosedSquareRealization a → p ∈ ClosedSquareRealization b → + a = b ∨ FourNeighborAdjacent a b ∨ + (b = a + 1 + ⟨0, 1⟩ ∨ b = a + 1 - ⟨0, 1⟩ ∨ + b = a - 1 + ⟨0, 1⟩ ∨ b = a - 1 - ⟨0, 1⟩) := FourNeighborProof.overlap + constructor + · have cellsNonempty : T.cells.Nonempty := by + by_contra empty + have realizationEmpty : TileRealization T = ∅ := by + rw [TileRealization] + simp [Finset.not_nonempty_iff_eq_empty.mp empty] + rw [realizationEmpty] at realizationConnected + exact realizationConnected.nonempty.ne_empty rfl + rcases cellsNonempty with ⟨x, hx⟩ + exact ⟨x, hx⟩ + · intro x hx y hy + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∈ (T.cells : Set LatticeCell) ∧ + b ∈ (T.cells : Set LatticeCell) + let reachable : LatticeCell → LatticeCell → Prop := + Relation.ReflTransGen step + have squareNonempty : ∀ z : LatticeCell, + (ClosedSquareRealization z).Nonempty := by + intro z + refine ⟨(((z.re : Int) : Real), ((z.im : Int) : Real)), ?_⟩ + simp [ClosedSquareRealization] + have diagonalBridge : ∀ (a b : LatticeCell), + a ∈ (T.cells : Set LatticeCell) → b ∈ (T.cells : Set LatticeCell) → + ¬ reachable a b → + (b = a + 1 + ⟨0, 1⟩ ∨ b = a + 1 - ⟨0, 1⟩ ∨ + b = a - 1 + ⟨0, 1⟩ ∨ b = a - 1 - ⟨0, 1⟩) → False := by + intro a b ha hb hab hdiag + have sideForward : ∀ (u v : LatticeCell), + FourNeighborAdjacent u v → u ∈ (T.cells : Set LatticeCell) → + v ∈ (T.cells : Set LatticeCell) → reachable u v := by + intro u v huv hu hv + exact Relation.ReflTransGen.single ⟨huv, hu, hv⟩ + rcases hdiag with hdiag | hdiag | hdiag | hdiag + · subst b + by_cases hu : a + 1 ∈ (T.cells : Set LatticeCell) + · exact hab (Relation.ReflTransGen.trans + (sideForward a (a + 1) (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) ha hu) + (sideForward (a + 1) (a + 1 + ⟨0, 1⟩) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) hu hb)) + by_cases hv : a + ⟨0, 1⟩ ∈ (T.cells : Set LatticeCell) + · exact hab (Relation.ReflTransGen.trans + (sideForward a (a + ⟨0, 1⟩) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) ha hv) + (sideForward (a + ⟨0, 1⟩) (a + 1 + ⟨0, 1⟩) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) hv hb)) + simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using + noChecker (a + 1 + ⟨0, 1⟩) (Or.inl ⟨hb, + by simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using ha, + by simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using hv, + by simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using hu⟩) + · subst b + by_cases hu : a + 1 ∈ (T.cells : Set LatticeCell) + · exact hab (Relation.ReflTransGen.trans + (sideForward a (a + 1) (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) ha hu) + (sideForward (a + 1) (a + 1 - ⟨0, 1⟩) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) hu hb)) + by_cases hv : a - ⟨0, 1⟩ ∈ (T.cells : Set LatticeCell) + · exact hab (Relation.ReflTransGen.trans + (sideForward a (a - ⟨0, 1⟩) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) ha hv) + (sideForward (a - ⟨0, 1⟩) (a + 1 - ⟨0, 1⟩) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) hv hb)) + simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using + noChecker (a + 1) (Or.inr ⟨ + by simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using ha, + hb, hu, + by simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using hv⟩) + · subst b + by_cases hu : a - 1 ∈ (T.cells : Set LatticeCell) + · exact hab (Relation.ReflTransGen.trans + (sideForward a (a - 1) (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) ha hu) + (sideForward (a - 1) (a - 1 + ⟨0, 1⟩) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) hu hb)) + by_cases hv : a + ⟨0, 1⟩ ∈ (T.cells : Set LatticeCell) + · exact hab (Relation.ReflTransGen.trans + (sideForward a (a + ⟨0, 1⟩) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) ha hv) + (sideForward (a + ⟨0, 1⟩) (a - 1 + ⟨0, 1⟩) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) hv hb)) + simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using + noChecker (a + ⟨0, 1⟩) (Or.inr ⟨ + by simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using hb, + by simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using ha, hv, + by simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using hu⟩) + · subst b + by_cases hu : a - 1 ∈ (T.cells : Set LatticeCell) + · exact hab (Relation.ReflTransGen.trans + (sideForward a (a - 1) (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) ha hu) + (sideForward (a - 1) (a - 1 - ⟨0, 1⟩) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) hu hb)) + by_cases hv : a - ⟨0, 1⟩ ∈ (T.cells : Set LatticeCell) + · exact hab (Relation.ReflTransGen.trans + (sideForward a (a - ⟨0, 1⟩) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) ha hv) + (sideForward (a - ⟨0, 1⟩) (a - 1 - ⟨0, 1⟩) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff]) hv hb)) + simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using + noChecker a (Or.inl ⟨ha, hb, hu, + by simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using hv⟩) + have reachXY : reachable x y := FourNeighborProof.reachXY T realizationConnected overlap x hx + y hy squareNonempty diagonalBridge + have walk : ∀ {a b : LatticeCell}, a ∈ (T.cells : Set LatticeCell) → + b ∈ (T.cells : Set LatticeCell) → reachable a b → + ∃ p : List LatticeCell, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ z ∈ p, z ∈ (T.cells : Set LatticeCell)) ∧ + ∀ u v : LatticeCell, ∀ l₁ l₂ : List LatticeCell, + p = l₁ ++ u :: v :: l₂ → FourNeighborAdjacent u v := FourNeighborProof.walk T + rcases walk hx hy reachXY with ⟨p, hphead, hplast, hpinside, hpedge⟩ + exact ⟨p, hphead, hplast, hpinside, hpedge⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean new file mode 100644 index 0000000000..989d5b390a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean @@ -0,0 +1,466 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Data.Set.Card +public import LeanPool.ApollonianSuperharmonic.FiniteBiconnectedHorizontalRunTree +public import LeanPool.ApollonianSuperharmonic.FiniteSquareIncidenceIdentities +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileComplementGridConnected +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +/-! +# LatticeTileGridEulerCount + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open scoped BigOperators + +-- [TABLET NODE: LatticeTileGridEulerCount] +namespace GridEulerGeometry + +private theorem hrun : + (by + classical + exact + ∀ (T : ProtoTile), (LatticeTile T) → ((FourNeighborConnected (↑T.cells : Set LatticeCell) + ∧ NoCheckerboardCellVertex (↑T.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices T) (BoundaryFootprintEdges T)) → ( + let I : GaussianInt := ⟨0, 1⟩ + let R := (T.cells.filter fun z => z - 1 ∉ T.cells).card + let J := ((T.cells.filter fun z => z + I ∈ T.cells).filter fun z => + ¬ (z - 1 ∈ T.cells ∧ z - 1 + I ∈ T.cells)).card + R = J + 1)) ) := by + classical + intro T hT hgrid I R J + simpa [R, J, I] using + FiniteBiconnectedHorizontalRunTree T.cells hgrid.1 + (LatticeTileComplementGridConnected T hT) + +private theorem hparts : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let H := (T.cells.filter fun z => z - 1 ∈ T.cells).card + let V := (T.cells.filter fun z => z + I ∈ T.cells).card + let Q := (T.cells.filter fun z => + z + 1 ∈ T.cells ∧ z + I ∈ T.cells ∧ z + 1 + I ∈ T.cells).card + let R := (T.cells.filter fun z => z - 1 ∉ T.cells).card + let J := ((T.cells.filter fun z => z + I ∈ T.cells).filter fun z => + ¬ (z - 1 ∈ T.cells ∧ z - 1 + I ∈ T.cells)).card + T.cells.card = H + R ∧ V = Q + J ) := by + classical + intro T I H V Q R J + let vertical := T.cells.filter fun z => z + I ∈ T.cells + have hcell := Finset.card_filter_add_card_filter_not + (s := T.cells) (fun z => z - 1 ∈ T.cells) + have hsplit := Finset.card_filter_add_card_filter_not + (s := vertical) (fun z => z - 1 ∈ T.cells ∧ z - 1 + I ∈ T.cells) + have hQ : + (vertical.filter fun z => + z - 1 ∈ T.cells ∧ z - 1 + I ∈ T.cells).card = Q := by + change (vertical.filter fun z => + z - 1 ∈ T.cells ∧ z - 1 + I ∈ T.cells).card = + (T.cells.filter fun z => + z + 1 ∈ T.cells ∧ z + I ∈ T.cells ∧ + z + 1 + I ∈ T.cells).card + apply Finset.card_bij (fun z _ => z - 1) + · intro z hz + rw [Finset.mem_filter] at hz ⊢ + rcases hz with ⟨hzv, hzleft, hzleftI⟩ + rw [Finset.mem_filter] at hzv + refine ⟨hzleft, ?_, ?_, ?_⟩ + · simpa using hzv.1 + · simpa [I, Zsqrtd.ext_iff] using hzleftI + · simpa [I, Zsqrtd.ext_iff] using hzv.2 + · intro a ha b hb hab + apply_fun (fun z : GaussianInt => z + 1) at hab + simpa using hab + · intro q hq + rw [Finset.mem_filter] at hq + rcases hq with ⟨hqS, hq1, hqI, hq1I⟩ + refine ⟨q + 1, ?_, by simp⟩ + rw [Finset.mem_filter, Finset.mem_filter] + refine ⟨⟨hq1, hq1I⟩, ?_, ?_⟩ + · simpa using hqS + · simpa [I, Zsqrtd.ext_iff] using hqI + constructor + · change T.cells.card = + (T.cells.filter fun z => z - 1 ∈ T.cells).card + + (T.cells.filter fun z => z - 1 ∉ T.cells).card + exact hcell.symm + · change vertical.card = Q + + (vertical.filter fun z => + ¬ (z - 1 ∈ T.cells ∧ z - 1 + I ∈ T.cells)).card + rw [← hQ] + exact hsplit.symm + +private theorem hcornerMem : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + ∀ {z : GaussianInt}, (z ∈ T.cells) → (z ∈ cornerBag.toFinset) ) := by + classical + intro T I cornerBag z hz + rw [Multiset.mem_toFinset, Multiset.mem_bind] + exact ⟨z, hz, by simp⟩ + +private theorem hcornerCount : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + ∀ (z : GaussianInt), cornerBag.count z = (if z ∈ T.cells then 1 else 0) + (if z - 1 ∈ + T.cells then 1 else 0) + (if z - I ∈ T.cells then 1 else 0) + (if z - 1 - I ∈ T.cells + then 1 else 0) ) := by + classical + intro T I cornerBag z + dsimp only [cornerBag] + rw [Multiset.count_bind, ← Finset.sum_eq_multiset_sum] + simp only [Multiset.coe_count, List.count_cons, beq_iff_eq, + List.count_nil] + have h11 : ∀ c : GaussianInt, (c + 1 + I = z) ↔ + (c = z - 1 - I) := by + intro c + constructor <;> intro h + · rw [← h]; ring + · rw [h]; ring + have hI : ∀ c : GaussianInt, (c + I = z) ↔ (c = z - I) := by + intro c + constructor <;> intro h + · rw [← h]; ring + · rw [h]; ring + have h1 : ∀ c : GaussianInt, (c + 1 = z) ↔ (c = z - 1) := by + intro c + constructor <;> intro h + · rw [← h]; ring + · rw [h]; ring + simp_rw [h11, hI, h1] + simp only [Finset.sum_add_distrib, zero_add] + rw [Finset.sum_ite_eq', Finset.sum_ite_eq', Finset.sum_ite_eq', + Finset.sum_ite_eq'] + omega + +private theorem hpoint : + (by + classical + exact + ∀ (T : ProtoTile), (NoCheckerboardCellVertex (T.cells : Set LatticeCell)) → ( + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + (∀ (z : GaussianInt), cornerBag.count z = (if z ∈ T.cells then 1 else 0) + (if z - 1 ∈ + T.cells then 1 else 0) + (if z - I ∈ T.cells then 1 else 0) + (if z - 1 - I ∈ T.cells + then 1 else 0)) → (∀ (z : GaussianInt), (if cornerBag.count z = 1 then 1 else 0) + 2 + * ((if z ∈ T.cells ∧ z - 1 ∈ T.cells then 1 else 0) + (if z - 1 ∈ T.cells ∧ z - 1 - I + ∈ T.cells then 1 else 0) + (if z - 1 - I ∈ T.cells ∧ z - I ∈ T.cells then 1 else 0) + + (if z - I ∈ T.cells ∧ z ∈ T.cells then 1 else 0)) = (if cornerBag.count z = 3 then 1 + else 0) + cornerBag.count z + 4 * (if z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - I ∈ T.cells + ∧ z - 1 - I ∈ T.cells then 1 else 0))) ) := by + classical + intro T hcheck I cornerBag hcornerCount z + have hc := hcheck z + change ¬ ((z ∈ T.cells ∧ z - 1 - I ∈ T.cells ∧ + z - 1 ∉ T.cells ∧ z - I ∉ T.cells) ∨ + (z - 1 ∈ T.cells ∧ z - I ∈ T.cells ∧ + z ∉ T.cells ∧ z - 1 - I ∉ T.cells)) at hc + rw [hcornerCount] + by_cases ha : z ∈ T.cells <;> + by_cases hb : z - 1 ∈ T.cells <;> + by_cases hc' : z - I ∈ T.cells <;> + by_cases hd : z - 1 - I ∈ T.cells <;> simp_all + +private theorem hAB : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let H := (T.cells.filter fun z => z - 1 ∈ T.cells).card + (∀ {z : GaussianInt}, (z ∈ T.cells) → (z ∈ cornerBag.toFinset)) → + ((cornerBag.toFinset.filter fun z => z ∈ T.cells ∧ z - 1 ∈ T.cells).card = H) ) := by + classical + intro T I cornerBag H hcornerMem + change (cornerBag.toFinset.filter fun z => + z ∈ T.cells ∧ z - 1 ∈ T.cells).card = + (T.cells.filter fun z => z - 1 ∈ T.cells).card + congr 1 + ext z + simp only [Finset.mem_filter] + constructor + · rintro ⟨_, hz, hz1⟩ + exact ⟨hz, hz1⟩ + · rintro ⟨hz, hz1⟩ + exact ⟨hcornerMem hz, hz, hz1⟩ + +private theorem hDC : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let H := (T.cells.filter fun z => z - 1 ∈ T.cells).card + (cornerBag.toFinset.filter fun z => z - 1 - I ∈ T.cells ∧ z - I ∈ T.cells).card = H ) := by + classical + intro T I cornerBag H + change (cornerBag.toFinset.filter fun z => + z - 1 - I ∈ T.cells ∧ z - I ∈ T.cells).card = + (T.cells.filter fun z => z - 1 ∈ T.cells).card + apply Finset.card_bij (fun z _ => z - I) + · intro z hz + rw [Finset.mem_filter] at hz ⊢ + refine ⟨hz.2.2, ?_⟩ + convert hz.2.1 using 1; ring + · intro a ha b hb hab + apply_fun (fun z : GaussianInt => z + I) at hab + simpa using hab + · intro q hq + rw [Finset.mem_filter] at hq + refine ⟨q + I, ?_, by simp⟩ + rw [Finset.mem_filter] + refine ⟨?_, ?_, ?_⟩ + · rw [Multiset.mem_toFinset, Multiset.mem_bind] + exact ⟨q, hq.1, by simp⟩ + · convert hq.2 using 1; ring + · convert hq.1 using 1; ring + +private theorem hCA : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let V := (T.cells.filter fun z => z + I ∈ T.cells).card + (cornerBag.toFinset.filter fun z => z - I ∈ T.cells ∧ z ∈ T.cells).card = V ) := by + classical + intro T I cornerBag V + change (cornerBag.toFinset.filter fun z => + z - I ∈ T.cells ∧ z ∈ T.cells).card = + (T.cells.filter fun z => z + I ∈ T.cells).card + apply Finset.card_bij (fun z _ => z - I) + · intro z hz + rw [Finset.mem_filter] at hz ⊢ + exact ⟨hz.2.1, by simpa using hz.2.2⟩ + · intro a ha b hb hab + apply_fun (fun z : GaussianInt => z + I) at hab + simpa using hab + · intro q hq + rw [Finset.mem_filter] at hq + refine ⟨q + I, ?_, by simp⟩ + rw [Finset.mem_filter] + refine ⟨?_, ?_, ?_⟩ + · rw [Multiset.mem_toFinset, Multiset.mem_bind] + exact ⟨q, hq.1, by simp⟩ + · convert hq.1 using 1; ring + · simpa using hq.2 + +private theorem hBD : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let V := (T.cells.filter fun z => z + I ∈ T.cells).card + (cornerBag.toFinset.filter fun z => z - 1 ∈ T.cells ∧ z - 1 - I ∈ T.cells).card = V ) := by + classical + intro T I cornerBag V + change (cornerBag.toFinset.filter fun z => + z - 1 ∈ T.cells ∧ z - 1 - I ∈ T.cells).card = + (T.cells.filter fun z => z + I ∈ T.cells).card + apply Finset.card_bij (fun z _ => z - 1 - I) + · intro z hz + rw [Finset.mem_filter] at hz ⊢ + exact ⟨hz.2.2, by simpa [I, Zsqrtd.ext_iff] using hz.2.1⟩ + · intro a ha b hb hab + apply_fun (fun z : GaussianInt => z + 1 + I) at hab + simpa using hab + · intro q hq + rw [Finset.mem_filter] at hq + refine ⟨q + 1 + I, ?_, by ring⟩ + rw [Finset.mem_filter] + refine ⟨?_, ?_, ?_⟩ + · rw [Multiset.mem_toFinset, Multiset.mem_bind] + exact ⟨q, hq.1, by simp⟩ + · convert hq.2 using 1; ring + · convert hq.1 using 1; ring + +private theorem hfull : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let Q := (T.cells.filter fun z => + z + 1 ∈ T.cells ∧ z + I ∈ T.cells ∧ z + 1 + I ∈ T.cells).card + (cornerBag.toFinset.filter fun z => z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - I ∈ T.cells ∧ z - + 1 - I ∈ T.cells).card = Q ) := by + classical + intro T I cornerBag Q + change (cornerBag.toFinset.filter fun z => + z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - I ∈ T.cells ∧ + z - 1 - I ∈ T.cells).card = + (T.cells.filter fun z => z + 1 ∈ T.cells ∧ + z + I ∈ T.cells ∧ z + 1 + I ∈ T.cells).card + apply Finset.card_bij (fun z _ => z - 1 - I) + · intro z hz + rw [Finset.mem_filter] at hz ⊢ + rcases hz with ⟨_, hz, hz1, hzI, hz1I⟩ + refine ⟨hz1I, ?_, ?_, ?_⟩ + · convert hzI using 1; ring + · convert hz1 using 1; ring + · convert hz using 1; ring + · intro a ha b hb hab + apply_fun (fun z : GaussianInt => z + 1 + I) at hab + simpa using hab + · intro q hq + rw [Finset.mem_filter] at hq + rcases hq with ⟨hq, hq1, hqI, hq1I⟩ + refine ⟨q + 1 + I, ?_, by ring⟩ + rw [Finset.mem_filter] + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · rw [Multiset.mem_toFinset, Multiset.mem_bind] + exact ⟨q, hq, by simp⟩ + · simpa [I, Zsqrtd.ext_iff] using hq1I + · convert hqI using 1; ring + · convert hq1 using 1; ring + · convert hq using 1; ring + +private theorem hsum : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let N : Nat → Nat := fun k => + (cornerBag.toFinset.filter fun z => cornerBag.count z = k).card + let H := (T.cells.filter fun z => z - 1 ∈ T.cells).card + let V := (T.cells.filter fun z => z + I ∈ T.cells).card + let Q := (T.cells.filter fun z => + z + 1 ∈ T.cells ∧ z + I ∈ T.cells ∧ z + 1 + I ∈ T.cells).card + let R := (T.cells.filter fun z => z - 1 ∉ T.cells).card + let J := ((T.cells.filter fun z => z + I ∈ T.cells).filter fun z => + ¬ (z - 1 ∈ T.cells ∧ z - 1 + I ∈ T.cells)).card + (R = J + 1) → ((T.cells.card = H + R ∧ V = Q + J) → ((∀ (z : GaussianInt), (if + cornerBag.count z = 1 then 1 else 0) + 2 * ((if z ∈ T.cells ∧ z - 1 ∈ T.cells then 1 + else 0) + (if z - 1 ∈ T.cells ∧ z - 1 - I ∈ T.cells then 1 else 0) + (if z - 1 - I ∈ + T.cells ∧ z - I ∈ T.cells then 1 else 0) + (if z - I ∈ T.cells ∧ z ∈ T.cells then 1 + else 0)) = (if cornerBag.count z = 3 then 1 else 0) + cornerBag.count z + 4 * (if z ∈ + T.cells ∧ z - 1 ∈ T.cells ∧ z - I ∈ T.cells ∧ z - 1 - I ∈ T.cells then 1 else 0)) → + (((cornerBag.toFinset.filter fun z => z ∈ T.cells ∧ z - 1 ∈ T.cells).card = H) → + (((cornerBag.toFinset.filter fun z => z - 1 - I ∈ T.cells ∧ z - I ∈ T.cells).card = + H) → (((cornerBag.toFinset.filter fun z => z - I ∈ T.cells ∧ z ∈ T.cells).card = V) → + (((cornerBag.toFinset.filter fun z => z - 1 ∈ T.cells ∧ z - 1 - I ∈ T.cells).card = + V) → (((cornerBag.toFinset.filter fun z => z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - I ∈ + T.cells ∧ z - 1 - I ∈ T.cells).card = Q) → (N 1 + 4 * (H + V) = N 3 + 4 * + T.cells.card + 4 * Q)))))))) ) := by + classical + intro T I cornerBag N H V Q R J hrun hparts hpoint hAB hDC hCA hBD hfull + have hp : (∑ z ∈ cornerBag.toFinset, + ((if cornerBag.count z = 1 then 1 else 0) + + 2 * ((if z ∈ T.cells ∧ z - 1 ∈ T.cells then 1 else 0) + + (if z - 1 ∈ T.cells ∧ z - 1 - I ∈ T.cells then 1 else 0) + + (if z - 1 - I ∈ T.cells ∧ z - I ∈ T.cells then 1 else 0) + + (if z - I ∈ T.cells ∧ z ∈ T.cells then 1 else 0)))) = + ∑ z ∈ cornerBag.toFinset, + ((if cornerBag.count z = 3 then 1 else 0) + + cornerBag.count z + + 4 * (if z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ + z - I ∈ T.cells ∧ z - 1 - I ∈ T.cells then 1 else 0)) := by + apply Finset.sum_congr rfl + intro z _ + exact hpoint z + simp only [Finset.sum_add_distrib] at hp + simp_rw [← Finset.mul_sum] at hp + simp only [Finset.sum_add_distrib] at hp + simp? [hAB, hBD, hDC, hCA, hfull] at hp + have hbag : cornerBag.card = 4 * T.cells.card := by + simp [cornerBag, Nat.mul_comm] + dsimp only [N] + omega + +end GridEulerGeometry + +theorem LatticeTileGridEulerCount (T : ProtoTile) (hT : LatticeTile T) : + (FootprintVertices T).ncard + T.cells.card = + (FootprintEdges T).ncard + 1 := by +-- BODY + classical + have hgrid := LatticeTileGridStructure T hT + have hne : T.cells.Nonempty := hgrid.1.1 + have hcheck : NoCheckerboardCellVertex (T.cells : Set LatticeCell) := + hgrid.2.1 + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let N : Nat → Nat := fun k => + (cornerBag.toFinset.filter fun z => cornerBag.count z = k).card + have hincidence := FiniteSquareIncidenceIdentities T hne hcheck + change 4 * T.cells.card = N 1 + 2 * N 2 + 3 * N 3 + 4 * N 4 ∧ + (FootprintVertices T).ncard = N 1 + N 2 + N 3 + N 4 ∧ + 2 * (FootprintEdges T).ncard = 4 * T.cells.card + + (BoundaryFootprintEdges T).ncard ∧ + (BoundaryFootprintEdges T).ncard = N 1 + N 2 + N 3 at hincidence + rcases hincidence with ⟨hcorner, hvertex, hedge, hboundary⟩ + have hturn : N 1 = N 3 + 4 := by + let H := (T.cells.filter fun z => z - 1 ∈ T.cells).card + let V := (T.cells.filter fun z => z + I ∈ T.cells).card + let Q := (T.cells.filter fun z => + z + 1 ∈ T.cells ∧ z + I ∈ T.cells ∧ z + 1 + I ∈ T.cells).card + let R := (T.cells.filter fun z => z - 1 ∉ T.cells).card + let J := ((T.cells.filter fun z => z + I ∈ T.cells).filter fun z => + ¬ (z - 1 ∈ T.cells ∧ z - 1 + I ∈ T.cells)).card + have hrun : R = J + 1 := GridEulerGeometry.hrun T hT hgrid + have hparts : T.cells.card = H + R ∧ V = Q + J := GridEulerGeometry.hparts T + have hEuler : T.cells.card + Q = H + V + 1 := by + omega + have hcornerMem {z : GaussianInt} (hz : z ∈ T.cells) := GridEulerGeometry.hcornerMem T (z := + z) hz + have hcornerCount (z : GaussianInt) := GridEulerGeometry.hcornerCount T z + have hpoint (z : GaussianInt) := GridEulerGeometry.hpoint T hcheck hcornerCount z + have hAB := GridEulerGeometry.hAB T hcornerMem + have hDC := GridEulerGeometry.hDC T + have hCA := GridEulerGeometry.hCA T + have hBD := GridEulerGeometry.hBD T + have hfull := GridEulerGeometry.hfull T + have hsum : N 1 + 4 * (H + V) = + N 3 + 4 * T.cells.card + 4 * Q := GridEulerGeometry.hsum T hrun hparts hpoint hAB hDC + hCA hBD hfull + omega + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileGridStructure.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileGridStructure.lean new file mode 100644 index 0000000000..bb389fa2bb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileGridStructure.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileBoundarySimpleGridCycle +public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.LatticeTileNoCheckerboard +public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: LatticeTileGridStructure] + +/-! +# LatticeTileGridStructure + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem LatticeTileGridStructure (T : ProtoTile) (hT : LatticeTile T) : + FourNeighborConnected (T.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (T.cells : Set LatticeCell) ∧ + SimpleGridCycle (BoundaryFootprintVertices T) + (BoundaryFootprintEdges T) := by +-- BODY + exact ⟨LatticeTileFourNeighborConnected T hT, + LatticeTileNoCheckerboard T hT, + LatticeTileBoundarySimpleGridCycle T hT⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileNoCheckerboard.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileNoCheckerboard.lean new file mode 100644 index 0000000000..8e30d0b2ee --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileNoCheckerboard.lean @@ -0,0 +1,463 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TopologicalDiskLocallyPuncturedPreconnected + +/-! +# LatticeTileNoCheckerboard + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open scoped Topology + +-- [TABLET NODE: LatticeTileNoCheckerboard] +namespace NoCheckerboardProof + +private theorem square_mem_realization : + ∀ (T : ProtoTile), ∀ {x : GaussianInt}, (x ∈ T.cells) → (∀ {p : Real × Real}, (p ∈ + ClosedSquareRealization x) → (p ∈ TileRealization T)) := by + classical + intro T x hx p hp + simp only [TileRealization, Set.mem_iUnion] + exact ⟨x, ⟨hx, hp⟩⟩ + +private theorem local_cell : + ∀ (z : GaussianInt), + let zR : Real × Real := (((z.re : Int) : Real), ((z.im : Int) : Real)) + ∀ {x : GaussianInt}, ∀ {p : Real × Real}, (dist p zR < (1 / 2 : Real)) → ((p ∈ + ClosedSquareRealization x) → (x = z ∨ x = z - 1 ∨ x = z - ⟨0, 1⟩ ∨ x = z - 1 - ⟨0, 1⟩)) + := by + classical + intro z zR x p hpnear hpsq + have hdist1 : |p.1 - zR.1| < (1 / 2 : Real) := by + have := lt_of_le_of_lt (le_max_left (dist p.1 zR.1) (dist p.2 zR.2)) hpnear + simpa [Prod.dist_eq, Real.dist_eq] using this + have hdist2 : |p.2 - zR.2| < (1 / 2 : Real) := by + have := lt_of_le_of_lt (le_max_right (dist p.1 zR.1) (dist p.2 zR.2)) hpnear + simpa [Prod.dist_eq, Real.dist_eq] using this + have hsquare := hpsq + change (((x.re : Int) : Real), ((x.im : Int) : Real)) ≤ p ∧ + p ≤ ((((x.re : Int) : Real) + 1), (((x.im : Int) : Real) + 1)) at hsquare + have hrele : x.re ≤ z.re := by + by_contra hn + have hstep : ((z.re : Int) : Real) + 1 ≤ ((x.re : Int) : Real) := by + exact_mod_cast (show z.re + 1 ≤ x.re by omega) + have habs := (abs_lt.mp hdist1).2 + dsimp [zR] at habs + linarith [hsquare.1.1] + have hrige : z.re - 1 ≤ x.re := by + by_contra hn + have hstep : ((x.re : Int) : Real) + 1 ≤ ((z.re : Int) : Real) - 1 := by + exact_mod_cast (show x.re + 1 ≤ z.re - 1 by omega) + have habs := (abs_lt.mp hdist1).1 + dsimp [zR] at habs + linarith [hsquare.2.1] + have himle : x.im ≤ z.im := by + by_contra hn + have hstep : ((z.im : Int) : Real) + 1 ≤ ((x.im : Int) : Real) := by + exact_mod_cast (show z.im + 1 ≤ x.im by omega) + have habs := (abs_lt.mp hdist2).2 + dsimp [zR] at habs + linarith [hsquare.1.2] + have himge : z.im - 1 ≤ x.im := by + by_contra hn + have hstep : ((x.im : Int) : Real) + 1 ≤ ((z.im : Int) : Real) - 1 := by + exact_mod_cast (show x.im + 1 ≤ z.im - 1 by omega) + have habs := (abs_lt.mp hdist2).1 + dsimp [zR] at habs + linarith [hsquare.2.2] + have hre : x.re = z.re ∨ x.re = z.re - 1 := by omega + have him : x.im = z.im ∨ x.im = z.im - 1 := by omega + rcases hre with hre | hre <;> rcases him with him | him + · left + apply Zsqrtd.ext <;> simp_all + · right; right; left + apply Zsqrtd.ext <;> simp_all + · right; left + apply Zsqrtd.ext <;> simp_all + · right; right; right + apply Zsqrtd.ext <;> simp_all + +end NoCheckerboardProof + +namespace NoCheckerboardGeometry + +private theorem hpminusSq : + ∀ (z : GaussianInt), + let zR : Real × Real := (((z.re : Int) : Real), ((z.im : Int) : Real)) + ∀ (e : ℝ), + let η : Real := min (e / 2) (1 / 4) + (0 < η) → ((η ≤ 1) → ( + let pminus : Real × Real := (zR.1 - η, zR.2 - η) + pminus ∈ ClosedSquareRealization (z - 1 - ⟨0, 1⟩))) := by + classical + intro z zR e η hη hη1 pminus + change (((((z - 1 - ⟨0, 1⟩).re : Int) : Real)), + (((z - 1 - ⟨0, 1⟩).im : Int) : Real)) ≤ pminus ∧ + pminus ≤ (((((z - 1 - ⟨0, 1⟩).re : Int) : Real)) + 1, + (((z - 1 - ⟨0, 1⟩).im : Int) : Real) + 1) + dsimp [pminus, zR] + simp only [Int.reduceNeg, sub_zero, Int.cast_sub, + GaussianInt.intCast_re, Int.cast_one, + GaussianInt.intCast_im, Prod.mk_le_mk] + constructor <;> constructor <;> linarith + +private theorem hfnzAt271 : + ∀ (T : ProtoTile), ∀ (z : GaussianInt), + let zR : Real × Real := (((z.re : Int) : Real), ((z.im : Int) : Real)) + (∀ {x : GaussianInt}, ∀ {p : Real × Real}, (dist p zR < (1 / 2 : Real)) → ((p ∈ + ClosedSquareRealization x) → (x = z ∨ x = z - 1 ∨ x = z - ⟨0, 1⟩ ∨ x = z - 1 - ⟨0, 1⟩))) + → ((z ∈ (↑T.cells : Set LatticeCell) ∧ z - (1 : GaussianInt) - ⟨(0 : ℤ), (1 : ℤ)⟩ ∈ + (↑T.cells : Set LatticeCell) ∧ z - (1 : GaussianInt) ∉ (↑T.cells : Set LatticeCell) ∧ z - + ⟨(0 : ℤ), (1 : ℤ)⟩ ∉ (↑T.cells : Set LatticeCell)) → ( + let S : Set (Real × Real) := TileRealization T + ∀ (hzRmem : zR ∈ S), + let zS : S := ⟨zR, hzRmem⟩ + let U : Set S := {p | dist (p : Real × Real) zR < (1 / 2 : Real)} + ∀ (W : Set (↑S : Type)), (W ⊆ U) → ( + let f : S → Real := fun q => + ((q : Real × Real).1 - zR.1) + ((q : Real × Real).2 - zR.2) + ∀ y ∈ W \ {zS}, f y ≠ 0))) := by + classical + intro T z zR local_cell hdiag S hzRmem zS U W hWU f y hy hyzero + have hyU := hWU hy.1 + have hynear : dist (y : Real × Real) zR < (1 / 2 : Real) := hyU + have hymem : (y : Real × Real) ∈ TileRealization T := y.property + simp only [TileRealization, Set.mem_iUnion] at hymem + rcases hymem with ⟨x, hxcell, hysq⟩ + rcases local_cell hynear hysq with hx | hx | hx | hx + · subst x + have hsquare := hysq + change (((z.re : Int) : Real), ((z.im : Int) : Real)) ≤ (y : Real × Real) ∧ + (y : Real × Real) ≤ + ((((z.re : Int) : Real) + 1), (((z.im : Int) : Real) + 1)) at hsquare + have hy1 : (y : Real × Real).1 = zR.1 := by + dsimp [f, zR] at hyzero + dsimp [zR] + linarith [hsquare.1.1, hsquare.1.2] + have hy2 : (y : Real × Real).2 = zR.2 := by + dsimp [f, zR] at hyzero + dsimp [zR] + linarith [hsquare.1.1, hsquare.1.2] + apply hy.2 + simp only [Set.mem_singleton_iff] + apply Subtype.ext + exact Prod.ext hy1 hy2 + · rw [hx] at hxcell + exact hdiag.2.2.1 hxcell + · rw [hx] at hxcell + exact hdiag.2.2.2 hxcell + · rw [hx] at hysq + have hsquare := hysq + change (((((z - 1 - ⟨0, 1⟩).re : Int) : Real)), + (((z - 1 - ⟨0, 1⟩).im : Int) : Real)) ≤ (y : Real × Real) ∧ + (y : Real × Real) ≤ + (((((z - 1 - ⟨0, 1⟩).re : Int) : Real)) + 1, + (((z - 1 - ⟨0, 1⟩).im : Int) : Real) + 1) at hsquare + have hupper1 : (y : Real × Real).1 ≤ zR.1 := by + dsimp [zR] + have := hsquare.2.1 + norm_num [Zsqrtd.re_sub, Zsqrtd.im_sub] at this ⊢ + linarith + have hupper2 : (y : Real × Real).2 ≤ zR.2 := by + dsimp [zR] + have := hsquare.2.2 + norm_num [Zsqrtd.re_sub, Zsqrtd.im_sub] at this ⊢ + linarith + have hy1 : (y : Real × Real).1 = zR.1 := by + dsimp [f] at hyzero + linarith + have hy2 : (y : Real × Real).2 = zR.2 := by + dsimp [f] at hyzero + linarith + apply hy.2 + simp only [Set.mem_singleton_iff] + apply Subtype.ext + exact Prod.ext hy1 hy2 + +private theorem hfnzAt414 : + ∀ (T : ProtoTile), ∀ (z : GaussianInt), + let zR : Real × Real := (((z.re : Int) : Real), ((z.im : Int) : Real)) + (∀ {x : GaussianInt}, ∀ {p : Real × Real}, (dist p zR < (1 / 2 : Real)) → ((p ∈ + ClosedSquareRealization x) → (x = z ∨ x = z - 1 ∨ x = z - ⟨0, 1⟩ ∨ x = z - 1 - ⟨0, 1⟩))) + → ((z - (1 : GaussianInt) ∈ (↑T.cells : Set LatticeCell) ∧ z - ⟨(0 : ℤ), (1 : ℤ)⟩ ∈ + (↑T.cells : Set LatticeCell) ∧ z ∉ (↑T.cells : Set LatticeCell) ∧ z - (1 : GaussianInt) - + ⟨(0 : ℤ), (1 : ℤ)⟩ ∉ (↑T.cells : Set LatticeCell)) → ( + let S : Set (Real × Real) := TileRealization T + ∀ (hzRmem : zR ∈ S), + let zS : S := ⟨zR, hzRmem⟩ + let U : Set S := {p | dist (p : Real × Real) zR < (1 / 2 : Real)} + ∀ (W : Set (↑S : Type)), (W ⊆ U) → ( + let f : S → Real := fun q => + ((q : Real × Real).1 - zR.1) - ((q : Real × Real).2 - zR.2) + ∀ y ∈ W \ {zS}, f y ≠ 0))) := by + classical + intro T z zR local_cell hdiag S hzRmem zS U W hWU f y hy hyzero + have hyU := hWU hy.1 + have hynear : dist (y : Real × Real) zR < (1 / 2 : Real) := hyU + have hymem : (y : Real × Real) ∈ TileRealization T := y.property + simp only [TileRealization, Set.mem_iUnion] at hymem + rcases hymem with ⟨x, hxcell, hysq⟩ + rcases local_cell hynear hysq with hx | hx | hx | hx + · rw [hx] at hxcell + exact hdiag.2.2.1 hxcell + · rw [hx] at hysq + have hsquare := hysq + change (((((z - 1).re : Int) : Real)), (((z - 1).im : Int) : Real)) ≤ + (y : Real × Real) ∧ + (y : Real × Real) ≤ (((((z - 1).re : Int) : Real)) + 1, + (((z - 1).im : Int) : Real) + 1) at hsquare + have hupper1 : (y : Real × Real).1 ≤ zR.1 := by + dsimp [zR] + have := hsquare.2.1 + norm_num [Zsqrtd.re_sub, Zsqrtd.im_sub] at this ⊢ + linarith + have hlower2 : zR.2 ≤ (y : Real × Real).2 := by + dsimp [zR] + have := hsquare.1.2 + norm_num [Zsqrtd.re_sub, Zsqrtd.im_sub] at this ⊢ + exact this + have hy1 : (y : Real × Real).1 = zR.1 := by + dsimp [f] at hyzero + linarith + have hy2 : (y : Real × Real).2 = zR.2 := by + dsimp [f] at hyzero + linarith + apply hy.2 + simp only [Set.mem_singleton_iff] + apply Subtype.ext + exact Prod.ext hy1 hy2 + · rw [hx] at hysq + have hsquare := hysq + change (((((z - ⟨0, 1⟩).re : Int) : Real)), + (((z - ⟨0, 1⟩).im : Int) : Real)) ≤ (y : Real × Real) ∧ + (y : Real × Real) ≤ (((((z - ⟨0, 1⟩).re : Int) : Real)) + 1, + (((z - ⟨0, 1⟩).im : Int) : Real) + 1) at hsquare + have hlower1 : zR.1 ≤ (y : Real × Real).1 := by + dsimp [zR] + have := hsquare.1.1 + norm_num [Zsqrtd.re_sub, Zsqrtd.im_sub] at this ⊢ + exact this + have hupper2 : (y : Real × Real).2 ≤ zR.2 := by + dsimp [zR] + have := hsquare.2.2 + norm_num [Zsqrtd.re_sub, Zsqrtd.im_sub] at this ⊢ + linarith + have hy1 : (y : Real × Real).1 = zR.1 := by + dsimp [f] at hyzero + linarith + have hy2 : (y : Real × Real).2 = zR.2 := by + dsimp [f] at hyzero + linarith + apply hy.2 + simp only [Set.mem_singleton_iff] + apply Subtype.ext + exact Prod.ext hy1 hy2 + · rw [hx] at hxcell + exact hdiag.2.2.2 hxcell + +end NoCheckerboardGeometry + +theorem LatticeTileNoCheckerboard (T : ProtoTile) (hT : LatticeTile T) : + NoCheckerboardCellVertex (T.cells : Set LatticeCell) := by +-- BODY + unfold NoCheckerboardCellVertex + intro z hz + let zR : Real × Real := (((z.re : Int) : Real), ((z.im : Int) : Real)) + have square_mem_realization {x : GaussianInt} (hx : x ∈ T.cells) + {p : Real × Real} (hp : p ∈ ClosedSquareRealization x) : + p ∈ TileRealization T := NoCheckerboardProof.square_mem_realization T (x := x) hx (p := p) hp + have local_cell {x : GaussianInt} {p : Real × Real} + (hpnear : dist p zR < (1 / 2 : Real)) + (hpsq : p ∈ ClosedSquareRealization x) : + x = z ∨ x = z - 1 ∨ x = z - ⟨0, 1⟩ ∨ x = z - 1 - ⟨0, 1⟩ := NoCheckerboardProof.local_cell z + (x := x) (p := p) hpnear hpsq + rcases hz with hdiag | hdiag + · let S : Set (Real × Real) := TileRealization T + have hzRSq : zR ∈ ClosedSquareRealization z := by + change (((z.re : Int) : Real), ((z.im : Int) : Real)) ≤ zR ∧ + zR ≤ ((((z.re : Int) : Real) + 1), (((z.im : Int) : Real) + 1)) + dsimp [zR] + constructor <;> constructor <;> norm_num + have hzRmem : zR ∈ S := square_mem_realization hdiag.1 hzRSq + let zS : S := ⟨zR, hzRmem⟩ + let U : Set S := {p | dist (p : Real × Real) zR < (1 / 2 : Real)} + have hUnhds : U ∈ nhds zS := by + change (fun p : S => (p : Real × Real)) ⁻¹' Metric.ball zR (1 / 2) ∈ nhds zS + exact continuous_subtype_val.continuousAt + (Metric.ball_mem_nhds zR (by norm_num)) + have hdisk : TopologicalDisk S := hT + rcases TopologicalDiskLocallyPuncturedPreconnected S hdisk zS U hUnhds with + ⟨W, hWnhds, hWU, hWconn⟩ + have hWpre := hWconn.isPreconnected + rcases Metric.mem_nhds_iff.mp hWnhds with ⟨e, he, heW⟩ + let η : Real := min (e / 2) (1 / 4) + have hη : 0 < η := by dsimp [η]; positivity + have hηe : η < e := lt_of_le_of_lt (min_le_left _ _) (by linarith) + have hη1 : η ≤ 1 := le_trans (min_le_right _ _) (by norm_num) + let pplus : Real × Real := (zR.1 + η, zR.2 + η) + let pminus : Real × Real := (zR.1 - η, zR.2 - η) + have hpplusSq : pplus ∈ ClosedSquareRealization z := by + change (((z.re : Int) : Real), ((z.im : Int) : Real)) ≤ pplus ∧ + pplus ≤ ((((z.re : Int) : Real) + 1), (((z.im : Int) : Real) + 1)) + dsimp [pplus, zR] + constructor <;> constructor <;> linarith + have hpplusS : pplus ∈ S := square_mem_realization hdiag.1 hpplusSq + have hpminusSq : pminus ∈ ClosedSquareRealization (z - 1 - ⟨0, 1⟩) := + NoCheckerboardGeometry.hpminusSq z e hη hη1 + have hpminusS : pminus ∈ S := square_mem_realization hdiag.2.1 hpminusSq + let P : S := ⟨pplus, hpplusS⟩ + let M : S := ⟨pminus, hpminusS⟩ + have hdistP : dist P zS = η := by + change dist pplus zR = η + rw [Prod.dist_eq] + dsimp [pplus] + rw [Real.dist_eq, Real.dist_eq] + simp [abs_of_pos hη] + have hdistM : dist M zS = η := by + change dist pminus zR = η + rw [Prod.dist_eq] + dsimp [pminus] + rw [Real.dist_eq, Real.dist_eq] + simp [abs_of_pos hη] + have hPW : P ∈ W := heW (by simpa [hdistP] using hηe) + have hMW : M ∈ W := heW (by simpa [hdistM] using hηe) + have hPne : P ≠ zS := by + intro heq + have := congrArg (fun q : S => (q : Real × Real).1) heq + dsimp [P, zS, pplus, zR] at this + linarith + have hMne : M ≠ zS := by + intro heq + have := congrArg (fun q : S => (q : Real × Real).1) heq + dsimp [M, zS, pminus, zR] at this + linarith + have hPdiff : P ∈ W \ {zS} := ⟨hPW, by simpa using hPne⟩ + have hMdiff : M ∈ W \ {zS} := ⟨hMW, by simpa using hMne⟩ + let f : S → Real := fun q => + ((q : Real × Real).1 - zR.1) + ((q : Real × Real).2 - zR.2) + have hfcont : Continuous f := by + dsimp [f] + fun_prop + have hfP : f P = 2 * η := by + dsimp [f, P, pplus, zR] + ring + have hfM : f M = -(2 * η) := by + dsimp [f, M, pminus, zR] + ring + have hfnz : ∀ y ∈ W \ {zS}, f y ≠ 0 := NoCheckerboardGeometry.hfnzAt271 T z local_cell hdiag + hzRmem W hWU + have hzeroIcc : (0 : Real) ∈ Set.Icc (f M) (f P) := by + rw [hfM, hfP] + constructor <;> linarith + rcases hWpre.intermediate_value hMdiff hPdiff hfcont.continuousOn hzeroIcc with + ⟨y, hy, hyzero⟩ + exact hfnz y hy hyzero + · let S : Set (Real × Real) := TileRealization T + have hzRSq : zR ∈ ClosedSquareRealization (z - 1) := by + change (((((z - 1).re : Int) : Real)), (((z - 1).im : Int) : Real)) ≤ zR ∧ + zR ≤ (((((z - 1).re : Int) : Real)) + 1, + (((z - 1).im : Int) : Real) + 1) + dsimp [zR] + norm_num [Zsqrtd.re_sub, Zsqrtd.im_sub] + have hzRmem : zR ∈ S := square_mem_realization hdiag.1 hzRSq + let zS : S := ⟨zR, hzRmem⟩ + let U : Set S := {p | dist (p : Real × Real) zR < (1 / 2 : Real)} + have hUnhds : U ∈ nhds zS := by + change (fun p : S => (p : Real × Real)) ⁻¹' Metric.ball zR (1 / 2) ∈ nhds zS + exact continuous_subtype_val.continuousAt + (Metric.ball_mem_nhds zR (by norm_num)) + have hdisk : TopologicalDisk S := hT + rcases TopologicalDiskLocallyPuncturedPreconnected S hdisk zS U hUnhds with + ⟨W, hWnhds, hWU, hWconn⟩ + have hWpre := hWconn.isPreconnected + rcases Metric.mem_nhds_iff.mp hWnhds with ⟨e, he, heW⟩ + let η : Real := min (e / 2) (1 / 4) + have hη : 0 < η := by dsimp [η]; positivity + have hηe : η < e := lt_of_le_of_lt (min_le_left _ _) (by linarith) + have hη1 : η ≤ 1 := le_trans (min_le_right _ _) (by norm_num) + let pNW : Real × Real := (zR.1 - η, zR.2 + η) + let pSE : Real × Real := (zR.1 + η, zR.2 - η) + have hpNWSq : pNW ∈ ClosedSquareRealization (z - 1) := by + change (((((z - 1).re : Int) : Real)), (((z - 1).im : Int) : Real)) ≤ pNW ∧ + pNW ≤ (((((z - 1).re : Int) : Real)) + 1, + (((z - 1).im : Int) : Real) + 1) + dsimp [pNW, zR] + norm_num [Zsqrtd.re_sub, Zsqrtd.im_sub] + constructor <;> constructor <;> linarith + have hpNWS : pNW ∈ S := square_mem_realization hdiag.1 hpNWSq + have hpSESq : pSE ∈ ClosedSquareRealization (z - ⟨0, 1⟩) := by + change (((((z - ⟨0, 1⟩).re : Int) : Real)), + (((z - ⟨0, 1⟩).im : Int) : Real)) ≤ pSE ∧ + pSE ≤ (((((z - ⟨0, 1⟩).re : Int) : Real)) + 1, + (((z - ⟨0, 1⟩).im : Int) : Real) + 1) + dsimp [pSE, zR] + norm_num [Zsqrtd.re_sub, Zsqrtd.im_sub] + constructor <;> constructor <;> linarith + have hpSES : pSE ∈ S := square_mem_realization hdiag.2.1 hpSESq + let NW : S := ⟨pNW, hpNWS⟩ + let SE : S := ⟨pSE, hpSES⟩ + have hdistNW : dist NW zS = η := by + change dist pNW zR = η + rw [Prod.dist_eq] + dsimp [pNW] + rw [Real.dist_eq, Real.dist_eq] + simp [abs_of_pos hη] + have hdistSE : dist SE zS = η := by + change dist pSE zR = η + rw [Prod.dist_eq] + dsimp [pSE] + rw [Real.dist_eq, Real.dist_eq] + simp [abs_of_pos hη] + have hNWW : NW ∈ W := heW (by simpa [hdistNW] using hηe) + have hSEW : SE ∈ W := heW (by simpa [hdistSE] using hηe) + have hNWne : NW ≠ zS := by + intro heq + have := congrArg (fun q : S => (q : Real × Real).1) heq + dsimp [NW, zS, pNW, zR] at this + linarith + have hSEne : SE ≠ zS := by + intro heq + have := congrArg (fun q : S => (q : Real × Real).1) heq + dsimp [SE, zS, pSE, zR] at this + linarith + have hNWdiff : NW ∈ W \ {zS} := ⟨hNWW, by simpa using hNWne⟩ + have hSEdiff : SE ∈ W \ {zS} := ⟨hSEW, by simpa using hSEne⟩ + let f : S → Real := fun q => + ((q : Real × Real).1 - zR.1) - ((q : Real × Real).2 - zR.2) + have hfcont : Continuous f := by + dsimp [f] + fun_prop + have hfNW : f NW = -(2 * η) := by + dsimp [f, NW, pNW, zR] + ring + have hfSE : f SE = 2 * η := by + dsimp [f, SE, pSE, zR] + ring + have hfnz : ∀ y ∈ W \ {zS}, f y ≠ 0 := NoCheckerboardGeometry.hfnzAt414 T z local_cell hdiag + hzRmem W hWU + have hzeroIcc : (0 : Real) ∈ Set.Icc (f NW) (f SE) := by + rw [hfNW, hfSE] + constructor <;> linarith + rcases hWpre.intermediate_value hNWdiff hSEdiff hfcont.continuousOn hzeroIcc with + ⟨y, hy, hyzero⟩ + exact hfnz y hy hyzero + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean new file mode 100644 index 0000000000..69b669dbd1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean @@ -0,0 +1,1108 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileDiskUnionInterface +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridEulerCount +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: LatticeTileThreeDiskJunction] + +/-! +# LatticeTileThreeDiskJunction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ThreeDiskJunctionGeometry + +private theorem vertex_union : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (W : ProtoTile), (U.cells.Nonempty) → + ((V.cells.Nonempty) → ((W.cells.Nonempty) → ((forall z : LatticeCell, + z ∈ W.cells ↔ z ∈ U.cells ∨ z ∈ V.cells) → (FootprintVertices W = FootprintVertices U + ∪ FootprintVertices V)))) ) := by + classical + intro U V W hUne hVne hWne hunion + simp only [FootprintVertices, hUne, hVne, hWne, ite_true] + ext z + simp only [Set.mem_ofPred_eq, Set.mem_union] + constructor + · rintro ⟨x, hx, hz⟩ + rw [hunion x] at hx + exact hx.elim (fun h => Or.inl ⟨x, h, hz⟩) + (fun h => Or.inr ⟨x, h, hz⟩) + · rintro (⟨x, hx, hz⟩ | ⟨x, hx, hz⟩) + · exact ⟨x, (hunion x).2 (Or.inl hx), hz⟩ + · exact ⟨x, (hunion x).2 (Or.inr hx), hz⟩ + +private theorem edge_union : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (W : ProtoTile), (forall z : LatticeCell, + z ∈ W.cells ↔ z ∈ U.cells ∨ z ∈ V.cells) → (FootprintEdges W = FootprintEdges U ∪ + FootprintEdges V) ) := by + classical + intro U V W hunion + ext e + simp only [FootprintEdges, Set.mem_ofPred_eq, Set.mem_union] + constructor + · rintro ⟨x, hx, he⟩ + rw [hunion x] at hx + exact hx.elim (fun h => Or.inl ⟨x, h, he⟩) + (fun h => Or.inr ⟨x, h, he⟩) + · rintro (⟨x, hx, he⟩ | ⟨x, hx, he⟩) + · exact ⟨x, (hunion x).2 (Or.inl hx), he⟩ + · exact ⟨x, (hunion x).2 (Or.inr hx), he⟩ + +private theorem vertex_finite : + (by + classical + exact + ∀ (T : ProtoTile), (FootprintVertices T).Finite ) := by + classical + intro T + by_cases hne : T.cells.Nonempty + · let K : Finset GaussianInt := T.cells.biUnion (fun x => + {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) + have hK : (K : Set GaussianInt) = FootprintVertices T := by + ext z + simp [K, FootprintVertices, hne] + rw [← hK] + exact K.finite_toSet + · simp [FootprintVertices, hne] + +private theorem edge_finite : + (by + classical + exact + ∀ (T : ProtoTile), (FootprintEdges T).Finite ) := by + classical + intro T + let I : GaussianInt := ⟨0, 1⟩ + let edge : T.cells × (Bool × Bool) → Finset GaussianInt := fun q => + match q.2 with + | (false, false) => {q.1.1, q.1.1 + 1} + | (false, true) => {q.1.1, q.1.1 + I} + | (true, false) => {q.1.1 + 1, q.1.1 + 1 + I} + | (true, true) => {q.1.1 + I, q.1.1 + 1 + I} + apply (Set.finite_range edge).subset + rintro e ⟨c, hc, h | h | h | h⟩ + · exact ⟨(⟨c, hc⟩, false, false), by simpa [edge] using h.symm⟩ + · exact ⟨(⟨c, hc⟩, false, true), by simpa [edge, I] using h.symm⟩ + · exact ⟨(⟨c, hc⟩, true, false), by simpa [edge, I] using h.symm⟩ + · exact ⟨(⟨c, hc⟩, true, true), by simpa [edge, I] using h.symm⟩ + +private theorem hunionAB_C : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (AB : ProtoTile), ∀ (BC : + ProtoTile), ∀ (CA : ProtoTile), ∀ (ABC : ProtoTile), (∀ (z : LatticeCell), z ∈ + AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) → ((∀ (z : LatticeCell), z ∈ ABC.cells ↔ z ∈ + A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) → ((FourNeighborConnected (↑A.cells : Set + LatticeCell) ∧ NoCheckerboardCellVertex (↑A.cells : Set LatticeCell) ∧ + SimpleGridCycle (BoundaryFootprintVertices A) (BoundaryFootprintEdges A)) → + ((FourNeighborConnected (↑B.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex + (↑B.cells : Set LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices B) + (BoundaryFootprintEdges B)) → ((FourNeighborConnected (↑C.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑C.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices C) (BoundaryFootprintEdges C)) → ((FourNeighborConnected + (↑AB.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑AB.cells : Set + LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices AB) (BoundaryFootprintEdges + AB)) → ((FourNeighborConnected (↑BC.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑BC.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices BC) (BoundaryFootprintEdges BC)) → ((FourNeighborConnected + (↑CA.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑CA.cells : Set + LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices CA) (BoundaryFootprintEdges + CA)) → ((FourNeighborConnected (↑ABC.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑ABC.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices ABC) (BoundaryFootprintEdges ABC)) → (forall z : + LatticeCell, z ∈ ABC.cells ↔ z ∈ AB.cells ∨ z ∈ C.cells))))))))) ) := by + classical + intro A B C AB BC CA ABC hunionAB hunionABC hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid + hABCgrid z + rw [hunionABC z, hunionAB z] + tauto + +private theorem hpathAB : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), (FootprintVertices A ∩ FootprintVertices B = + CommonFootprintEdgeVertices A B) → (∀ (xAB : GaussianInt), ∀ (yAB : GaussianInt), + (SimpleGridPathBetween (CommonFootprintEdgeVertices A B) (FootprintEdges A ∩ + FootprintEdges B) xAB yAB) → (SimpleGridPathBetween (FootprintVertices A ∩ + FootprintVertices B) (FootprintEdges A ∩ FootprintEdges B) xAB yAB)) ) := by + classical + intro A B hVrawAB xAB yAB hpathAB0 + rw [hVrawAB] + exact hpathAB0 + +private theorem hpathBC : + (by + classical + exact + ∀ (B : ProtoTile), ∀ (C : ProtoTile), (FootprintVertices B ∩ FootprintVertices C = + CommonFootprintEdgeVertices B C) → (∀ (xBC : GaussianInt), ∀ (yBC : GaussianInt), + (SimpleGridPathBetween (CommonFootprintEdgeVertices B C) (FootprintEdges B ∩ + FootprintEdges C) xBC yBC) → (SimpleGridPathBetween (FootprintVertices B ∩ + FootprintVertices C) (FootprintEdges B ∩ FootprintEdges C) xBC yBC)) ) := by + classical + intro B C hVrawBC xBC yBC hpathBC0 + rw [hVrawBC] + exact hpathBC0 + +private theorem hpathCA : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (C : ProtoTile), (FootprintVertices C ∩ FootprintVertices A = + CommonFootprintEdgeVertices C A) → (∀ (xCA : GaussianInt), ∀ (yCA : GaussianInt), + (SimpleGridPathBetween (CommonFootprintEdgeVertices C A) (FootprintEdges C ∩ + FootprintEdges A) xCA yCA) → (SimpleGridPathBetween (FootprintVertices C ∩ + FootprintVertices A) (FootprintEdges C ∩ FootprintEdges A) xCA yCA)) ) := by + classical + intro A C hVrawCA xCA yCA hpathCA0 + rw [hVrawCA] + exact hpathCA0 + +private theorem hcellsAB : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (AB : ProtoTile), (Disjoint A.cells B.cells) → + ((∀ (z : LatticeCell), z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) → (AB.cells.card = + A.cells.card + B.cells.card)) ) := by + classical + intro A B AB hdisjointAB hunionAB + have h : AB.cells = A.cells ∪ B.cells := by ext z; simpa using hunionAB z + rw [h, Finset.card_union_of_disjoint hdisjointAB] + +private theorem hcellsBC : + (by + classical + exact + ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (BC : ProtoTile), (Disjoint B.cells C.cells) → + ((∀ (z : LatticeCell), z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) → (BC.cells.card = + B.cells.card + C.cells.card)) ) := by + classical + intro B C BC hdisjointBC hunionBC + have h : BC.cells = B.cells ∪ C.cells := by ext z; simpa using hunionBC z + rw [h, Finset.card_union_of_disjoint hdisjointBC] + +private theorem hcellsCA : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (C : ProtoTile), ∀ (CA : ProtoTile), (Disjoint C.cells A.cells) → + ((∀ (z : LatticeCell), z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) → (CA.cells.card = + C.cells.card + A.cells.card)) ) := by + classical + intro A C CA hdisjointCA hunionCA + have h : CA.cells = C.cells ∪ A.cells := by ext z; simpa using hunionCA z + rw [h, Finset.card_union_of_disjoint hdisjointCA] + +private theorem hdisjointAB_C : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (AB : ProtoTile), (Disjoint + B.cells C.cells) → ((Disjoint C.cells A.cells) → ((∀ (z : LatticeCell), z ∈ AB.cells + ↔ z ∈ A.cells ∨ z ∈ B.cells) → (Disjoint AB.cells C.cells))) ) := by + classical + intro A B C AB hdisjointBC hdisjointCA hunionAB + rw [Finset.disjoint_left] + intro z hzAB hzC + rw [hunionAB z] at hzAB + rcases hzAB with hzA | hzB + · exact (Finset.disjoint_left.mp hdisjointCA) hzC hzA + · exact (Finset.disjoint_left.mp hdisjointBC) hzB hzC + +private theorem hcellsABC : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (AB : ProtoTile), ∀ (ABC : + ProtoTile), (forall z : LatticeCell, z ∈ ABC.cells ↔ z ∈ AB.cells ∨ z ∈ C.cells) → + ((AB.cells.card = A.cells.card + B.cells.card) → ((Disjoint AB.cells C.cells) → + (ABC.cells.card = A.cells.card + B.cells.card + C.cells.card))) ) := by + classical + intro A B C AB ABC hunionAB_C hcellsAB hdisjointAB_C + have h : ABC.cells = AB.cells ∪ C.cells := by + ext z + simpa using hunionAB_C z + rw [h, Finset.card_union_of_disjoint hdisjointAB_C, hcellsAB] + +private theorem horiz_unique : + (by + classical + exact + (ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → + ((ProtoTile) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), (({x, x + 1} : Finset + GaussianInt) = {y, y + 1}) → (x = y)))))))) ) := by + classical + intro A B C AB BC CA ABC x y h + have hx : x = y ∨ x = y + 1 := by + have : x ∈ ({y, y + 1} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hy : y = x ∨ y = x + 1 := by + have : y ∈ ({x, x + 1} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hx with hxy | hxy + · exact hxy + rcases hy with hyx | hyx + · exact hyx.symm + · have hre := congrArg Zsqrtd.re hxy + have hre' := congrArg Zsqrtd.re hyx + norm_num at hre hre' + omega + +private theorem vert_unique : + (by + classical + exact + (ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → + ((ProtoTile) → ( + let I : GaussianInt := ⟨0, 1⟩ + ∀ (x : GaussianInt), ∀ (y : GaussianInt), (({x, x + I} : Finset GaussianInt) = {y, + y + I}) → (x = y)))))))) ) := by + classical + intro A B C AB BC CA ABC I x y h + have hx : x = y ∨ x = y + I := by + have : x ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hy : y = x ∨ y = x + I := by + have : y ∈ ({x, x + I} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hx with hxy | hxy + · exact hxy + rcases hy with hyx | hyx + · exact hyx.symm + · have him := congrArg Zsqrtd.im hxy + have him' := congrArg Zsqrtd.im hyx + simp [I] at him him' + omega + +private theorem horiz_ne_vert : + (by + classical + exact + (ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → + ((ProtoTile) → ( + let I : GaussianInt := ⟨0, 1⟩ + ∀ (x : GaussianInt), ∀ (y : GaussianInt), ({x, x + 1} : Finset GaussianInt) ≠ {y, + y + I}))))))) ) := by + classical + intro A B C AB BC CA ABC I x y h + have hx : x = y ∨ x = y + I := by + have : x ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hx1 : x + 1 = y ∨ x + 1 = y + I := by + have : x + 1 ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + rcases hx with hx | hx <;> rcases hx1 with hx1 | hx1 + all_goals + have hre := congrArg Zsqrtd.re hx + have him := congrArg Zsqrtd.im hx + have hre1 := congrArg Zsqrtd.re hx1 + have him1 := congrArg Zsqrtd.im hx1 + simp [I] at hre him hre1 him1 + omega + +private theorem footprint_normalize : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + ∀ (T : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges T) → ((∃ z, e = {z, + z + 1} ∧ (z ∈ T.cells ∨ z - I ∈ T.cells)) ∨ (∃ z, e = {z, z + I} ∧ (z ∈ T.cells ∨ z - + 1 ∈ T.cells))) ) := by + classical + intro I T e he + rcases he with ⟨x, hx, h | h | h | h⟩ + · exact Or.inl ⟨x, h, Or.inl hx⟩ + · exact Or.inr ⟨x, h, Or.inl hx⟩ + · refine Or.inr ⟨x + 1, h, Or.inr ?_⟩ + simpa [add_sub_cancel_right] using hx + · refine Or.inl ⟨x + I, ?_, Or.inr ?_⟩ + · simpa [I, Zsqrtd.ext_iff, add_comm, add_left_comm, add_assoc] using h + · simpa [I, Zsqrtd.ext_iff] using hx + +private theorem htripleEdges : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (Disjoint A.cells B.cells) → + ((Disjoint B.cells C.cells) → ((Disjoint C.cells A.cells) → ( + let I : GaussianInt := ⟨0, 1⟩ + (∀ (x : GaussianInt), ∀ (y : GaussianInt), (({x, x + 1} : Finset GaussianInt) = {y, + y + 1}) → (x = y)) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (({x, x + I} : + Finset GaussianInt) = {y, y + I}) → (x = y)) → ((∀ (x : GaussianInt), ∀ (y : + GaussianInt), ({x, x + 1} : Finset GaussianInt) ≠ {y, y + I}) → ((∀ (T : ProtoTile), + ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges T) → ((∃ z, e = {z, z + 1} ∧ (z ∈ + T.cells ∨ z - I ∈ T.cells)) ∨ (∃ z, e = {z, z + I} ∧ (z ∈ T.cells ∨ z - 1 ∈ + T.cells)))) → (FootprintEdges A ∩ FootprintEdges B ∩ FootprintEdges C = ∅))))))) ) := by + classical + intro A B C hdisjointAB hdisjointBC hdisjointCA I horiz_unique vert_unique horiz_ne_vert + footprint_normalize + rw [Set.eq_empty_iff_forall_notMem] + intro e he + rcases he with ⟨⟨heA, heB⟩, heC⟩ + have hdAB := Finset.disjoint_left.mp hdisjointAB + have hdBC := Finset.disjoint_left.mp hdisjointBC + have hdCA := Finset.disjoint_left.mp hdisjointCA + rcases footprint_normalize A e heA with + ⟨a, hea, ha⟩ | ⟨a, hea, ha⟩ <;> + rcases footprint_normalize B e heB with + ⟨b, heb, hb⟩ | ⟨b, heb, hb⟩ <;> + rcases footprint_normalize C e heC with + ⟨c, hec, hc⟩ | ⟨c, hec, hc⟩ + · have hab : a = b := horiz_unique a b (hea.symm.trans heb) + have hac : a = c := horiz_unique a c (hea.symm.trans hec) + subst b; subst c + rcases ha with ha | ha <;> rcases hb with hb | hb <;> + rcases hc with hc | hc + all_goals first + | exact hdAB ha hb + | exact hdBC hb hc + | exact hdCA hc ha + · exact horiz_ne_vert a c (hea.symm.trans hec) + · exact horiz_ne_vert a b (hea.symm.trans heb) + · exact horiz_ne_vert a b (hea.symm.trans heb) + · exact horiz_ne_vert b a (heb.symm.trans hea) + · exact horiz_ne_vert b a (heb.symm.trans hea) + · exact horiz_ne_vert c a (hec.symm.trans hea) + · have hab : a = b := vert_unique a b (hea.symm.trans heb) + have hac : a = c := vert_unique a c (hea.symm.trans hec) + subst b; subst c + rcases ha with ha | ha <;> rcases hb with hb | hb <;> + rcases hc with hc | hc + all_goals first + | exact hdAB ha hb + | exact hdBC hb hc + | exact hdCA hc ha + +private theorem hIEvABC : + (by + classical + exact + ∀ (C : ProtoTile), ∀ (AB : ProtoTile), (∀ (T : ProtoTile), (FootprintVertices T).Finite) + → ((FootprintVertices AB ∪ FootprintVertices C).ncard + (FootprintVertices AB ∩ + FootprintVertices C).ncard = (FootprintVertices AB).ncard + (FootprintVertices + C).ncard) ) := by + classical + intro C AB vertex_finite + exact Set.ncard_union_add_ncard_inter + (FootprintVertices AB) (FootprintVertices C) + (vertex_finite AB) (vertex_finite C) + +private theorem hIEeABC : + (by + classical + exact + ∀ (C : ProtoTile), ∀ (AB : ProtoTile), (∀ (T : ProtoTile), (FootprintEdges T).Finite) → + ((FootprintEdges AB ∪ FootprintEdges C).ncard + (FootprintEdges AB ∩ FootprintEdges + C).ncard = (FootprintEdges AB).ncard + (FootprintEdges C).ncard) ) := by + classical + intro C AB edge_finite + exact Set.ncard_union_add_ncard_inter + (FootprintEdges AB) (FootprintEdges C) + (edge_finite AB) (edge_finite C) + +private theorem hcrossV : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (AB : ProtoTile), ∀ (BC : + ProtoTile), ∀ (CA : ProtoTile), ∀ (ABC : ProtoTile), (FourNeighborConnected (↑A.cells + : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑A.cells : Set LatticeCell) ∧ + SimpleGridCycle (BoundaryFootprintVertices A) (BoundaryFootprintEdges A)) → + ((FourNeighborConnected (↑B.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex + (↑B.cells : Set LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices B) + (BoundaryFootprintEdges B)) → ((FourNeighborConnected (↑C.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑C.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices C) (BoundaryFootprintEdges C)) → ((FourNeighborConnected + (↑AB.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑AB.cells : Set + LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices AB) (BoundaryFootprintEdges + AB)) → ((FourNeighborConnected (↑BC.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑BC.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices BC) (BoundaryFootprintEdges BC)) → ((FourNeighborConnected + (↑CA.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑CA.cells : Set + LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices CA) (BoundaryFootprintEdges + CA)) → ((FourNeighborConnected (↑ABC.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑ABC.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices ABC) (BoundaryFootprintEdges ABC)) → ((FootprintVertices + AB = FootprintVertices A ∪ FootprintVertices B) → (FootprintVertices AB ∩ + FootprintVertices C = (FootprintVertices A ∩ FootprintVertices C) ∪ + (FootprintVertices B ∩ FootprintVertices C))))))))) ) := by + classical + intro A B C AB BC CA ABC hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid hABCgrid hVAB + rw [hVAB] + ext z + simp only [Set.mem_inter_iff, Set.mem_union] + tauto + +private theorem hcrossE : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (AB : ProtoTile), ∀ (BC : + ProtoTile), ∀ (CA : ProtoTile), ∀ (ABC : ProtoTile), (FourNeighborConnected (↑A.cells + : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑A.cells : Set LatticeCell) ∧ + SimpleGridCycle (BoundaryFootprintVertices A) (BoundaryFootprintEdges A)) → + ((FourNeighborConnected (↑B.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex + (↑B.cells : Set LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices B) + (BoundaryFootprintEdges B)) → ((FourNeighborConnected (↑C.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑C.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices C) (BoundaryFootprintEdges C)) → ((FourNeighborConnected + (↑AB.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑AB.cells : Set + LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices AB) (BoundaryFootprintEdges + AB)) → ((FourNeighborConnected (↑BC.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑BC.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices BC) (BoundaryFootprintEdges BC)) → ((FourNeighborConnected + (↑CA.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑CA.cells : Set + LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices CA) (BoundaryFootprintEdges + CA)) → ((FourNeighborConnected (↑ABC.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑ABC.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices ABC) (BoundaryFootprintEdges ABC)) → ((FootprintEdges AB = + FootprintEdges A ∪ FootprintEdges B) → (FootprintEdges AB ∩ FootprintEdges C = + (FootprintEdges A ∩ FootprintEdges C) ∪ (FootprintEdges B ∩ FootprintEdges C))))))))) + ) := by + classical + intro A B C AB BC CA ABC hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid hABCgrid hEAB + rw [hEAB] + ext e + simp only [Set.mem_inter_iff, Set.mem_union] + tauto + +private theorem hIEvCross : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (∀ (T : ProtoTile), + (FootprintVertices T).Finite) → ((FootprintVertices A ∩ FootprintVertices C ∪ + FootprintVertices B ∩ FootprintVertices C).ncard + (FootprintVertices A ∩ + FootprintVertices C ∩ (FootprintVertices B ∩ FootprintVertices C)).ncard = + (FootprintVertices A ∩ FootprintVertices C).ncard + (FootprintVertices B ∩ + FootprintVertices C).ncard) ) := by + classical + intro A B C vertex_finite + exact Set.ncard_union_add_ncard_inter + (FootprintVertices A ∩ FootprintVertices C) + (FootprintVertices B ∩ FootprintVertices C) + ((vertex_finite A).inter_of_left (FootprintVertices C)) + ((vertex_finite B).inter_of_left (FootprintVertices C)) + +private theorem hIEeCross : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (∀ (T : ProtoTile), + (FootprintEdges T).Finite) → ((FootprintEdges A ∩ FootprintEdges C ∪ FootprintEdges B + ∩ FootprintEdges C).ncard + (FootprintEdges A ∩ FootprintEdges C ∩ (FootprintEdges B + ∩ FootprintEdges C)).ncard = (FootprintEdges A ∩ FootprintEdges C).ncard + + (FootprintEdges B ∩ FootprintEdges C).ncard) ) := by + classical + intro A B C edge_finite + exact Set.ncard_union_add_ncard_inter + (FootprintEdges A ∩ FootprintEdges C) + (FootprintEdges B ∩ FootprintEdges C) + ((edge_finite A).inter_of_left (FootprintEdges C)) + ((edge_finite B).inter_of_left (FootprintEdges C)) + +private theorem htripleVset : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (AB : ProtoTile), ∀ (BC : + ProtoTile), ∀ (CA : ProtoTile), ∀ (ABC : ProtoTile), (FourNeighborConnected (↑A.cells + : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑A.cells : Set LatticeCell) ∧ + SimpleGridCycle (BoundaryFootprintVertices A) (BoundaryFootprintEdges A)) → + ((FourNeighborConnected (↑B.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex + (↑B.cells : Set LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices B) + (BoundaryFootprintEdges B)) → ((FourNeighborConnected (↑C.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑C.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices C) (BoundaryFootprintEdges C)) → ((FourNeighborConnected + (↑AB.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑AB.cells : Set + LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices AB) (BoundaryFootprintEdges + AB)) → ((FourNeighborConnected (↑BC.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑BC.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices BC) (BoundaryFootprintEdges BC)) → ((FourNeighborConnected + (↑CA.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑CA.cells : Set + LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices CA) (BoundaryFootprintEdges + CA)) → ((FourNeighborConnected (↑ABC.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑ABC.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices ABC) (BoundaryFootprintEdges ABC)) → ((FootprintVertices A + ∩ FootprintVertices C) ∩ (FootprintVertices B ∩ FootprintVertices C) = + FootprintVertices A ∩ FootprintVertices B ∩ FootprintVertices C))))))) ) := by + classical + intro A B C AB BC CA ABC hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid hABCgrid + ext z + simp only [Set.mem_inter_iff] + tauto + +private theorem htripleEset : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (AB : ProtoTile), ∀ (BC : + ProtoTile), ∀ (CA : ProtoTile), ∀ (ABC : ProtoTile), (FourNeighborConnected (↑A.cells + : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑A.cells : Set LatticeCell) ∧ + SimpleGridCycle (BoundaryFootprintVertices A) (BoundaryFootprintEdges A)) → + ((FourNeighborConnected (↑B.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex + (↑B.cells : Set LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices B) + (BoundaryFootprintEdges B)) → ((FourNeighborConnected (↑C.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑C.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices C) (BoundaryFootprintEdges C)) → ((FourNeighborConnected + (↑AB.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑AB.cells : Set + LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices AB) (BoundaryFootprintEdges + AB)) → ((FourNeighborConnected (↑BC.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑BC.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices BC) (BoundaryFootprintEdges BC)) → ((FourNeighborConnected + (↑CA.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑CA.cells : Set + LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices CA) (BoundaryFootprintEdges + CA)) → ((FourNeighborConnected (↑ABC.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑ABC.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices ABC) (BoundaryFootprintEdges ABC)) → ((FootprintEdges A ∩ + FootprintEdges C) ∩ (FootprintEdges B ∩ FootprintEdges C) = FootprintEdges A ∩ + FootprintEdges B ∩ FootprintEdges C))))))) ) := by + classical + intro A B C AB BC CA ABC hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid hABCgrid + ext e + simp only [Set.mem_inter_iff] + tauto + +private theorem htripleVcard : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (AB : ProtoTile), ∀ (BC : + ProtoTile), ∀ (CA : ProtoTile), ∀ (ABC : ProtoTile), (AB.cells.card = A.cells.card + + B.cells.card) → ((BC.cells.card = B.cells.card + C.cells.card) → ((CA.cells.card = + C.cells.card + A.cells.card) → ((ABC.cells.card = A.cells.card + B.cells.card + + C.cells.card) → (((FootprintVertices AB).ncard + (FootprintVertices A ∩ + FootprintVertices B).ncard = (FootprintVertices A).ncard + (FootprintVertices + B).ncard) → (((FootprintVertices BC).ncard + (FootprintVertices B ∩ FootprintVertices + C).ncard = (FootprintVertices B).ncard + (FootprintVertices C).ncard) → + (((FootprintVertices CA).ncard + (FootprintVertices C ∩ FootprintVertices A).ncard = + (FootprintVertices C).ncard + (FootprintVertices A).ncard) → (((FootprintEdges + AB).ncard + (FootprintEdges A ∩ FootprintEdges B).ncard = (FootprintEdges A).ncard + + (FootprintEdges B).ncard) → (((FootprintEdges BC).ncard + (FootprintEdges B ∩ + FootprintEdges C).ncard = (FootprintEdges B).ncard + (FootprintEdges C).ncard) → + (((FootprintEdges CA).ncard + (FootprintEdges C ∩ FootprintEdges A).ncard = + (FootprintEdges C).ncard + (FootprintEdges A).ncard) → (((FootprintVertices + ABC).ncard + (FootprintVertices A ∩ FootprintVertices C ∪ FootprintVertices B ∩ + FootprintVertices C).ncard = (FootprintVertices AB).ncard + (FootprintVertices + C).ncard) → (((FootprintEdges ABC).ncard + (FootprintEdges A ∩ FootprintEdges C ∪ + FootprintEdges B ∩ FootprintEdges C).ncard = (FootprintEdges AB).ncard + + (FootprintEdges C).ncard) → (((FootprintVertices A ∩ FootprintVertices C ∪ + FootprintVertices B ∩ FootprintVertices C).ncard + (FootprintVertices A ∩ + FootprintVertices B ∩ FootprintVertices C).ncard = (FootprintVertices A ∩ + FootprintVertices C).ncard + (FootprintVertices B ∩ FootprintVertices C).ncard) → + (((FootprintEdges A ∩ FootprintEdges C ∪ FootprintEdges B ∩ FootprintEdges C).ncard = + (FootprintEdges A ∩ FootprintEdges C).ncard + (FootprintEdges B ∩ FootprintEdges + C).ncard) → (((FootprintVertices A).ncard + Finset.card A.cells = (FootprintEdges + A).ncard + (1 : ℕ)) → (((FootprintVertices B).ncard + Finset.card B.cells = + (FootprintEdges B).ncard + (1 : ℕ)) → (((FootprintVertices C).ncard + Finset.card + C.cells = (FootprintEdges C).ncard + (1 : ℕ)) → (((FootprintVertices AB).ncard + + Finset.card AB.cells = (FootprintEdges AB).ncard + (1 : ℕ)) → (((FootprintVertices + BC).ncard + Finset.card BC.cells = (FootprintEdges BC).ncard + (1 : ℕ)) → + (((FootprintVertices CA).ncard + Finset.card CA.cells = (FootprintEdges CA).ncard + + (1 : ℕ)) → (((FootprintVertices ABC).ncard + Finset.card ABC.cells = (FootprintEdges + ABC).ncard + (1 : ℕ)) → ((FootprintVertices A ∩ FootprintVertices B ∩ + FootprintVertices C).ncard = 1))))))))))))))))))))) ) := by + classical + intro A B C AB BC CA ABC hcellsAB hcellsBC hcellsCA hcellsABC hIEvAB hIEvBC hIEvCA hIEeAB + hIEeBC hIEeCA hIEvABC hIEeABC hIEvCross hIEeCross hEulerA hEulerB hEulerC hEulerAB hEulerBC + hEulerCA hEulerABC + rw [Set.inter_comm (FootprintVertices C) (FootprintVertices A)] at hIEvCA + rw [Set.inter_comm (FootprintEdges C) (FootprintEdges A)] at hIEeCA + omega + +private theorem htripleVfinite : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (∀ (T : ProtoTile), + (FootprintVertices T).Finite) → ((FootprintVertices A ∩ FootprintVertices B ∩ + FootprintVertices C).Finite) ) := by + classical + intro A B C vertex_finite + exact ((vertex_finite A).inter_of_left (FootprintVertices B)).inter_of_left + (FootprintVertices C) + +private theorem htripleVnonempty : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (ProtoTile) → ((ProtoTile) → + ((ProtoTile) → ((ProtoTile) → (((FootprintVertices A ∩ FootprintVertices B ∩ + FootprintVertices C).ncard = 1) → ((FootprintVertices A ∩ FootprintVertices B ∩ + FootprintVertices C).Nonempty))))) ) := by + classical + intro A B C AB BC CA ABC htripleVcard + by_contra hempty + rw [Set.not_nonempty_iff_eq_empty] at hempty + rw [hempty, Set.ncard_empty] at htripleVcard + omega + +private theorem huniqueRho : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ((FootprintVertices A ∩ + FootprintVertices B ∩ FootprintVertices C).ncard = 1) → (((FootprintVertices A ∩ + FootprintVertices B ∩ FootprintVertices C).Finite) → (∀ (rho : GaussianInt), (rho ∈ + FootprintVertices A ∩ FootprintVertices B ∩ FootprintVertices C) → (∀ (z : + GaussianInt), z ∈ FootprintVertices A ∩ FootprintVertices B ∩ FootprintVertices C ↔ z + = rho))) ) := by + classical + intro A B C htripleVcard htripleVfinite rho hrho z + constructor + · intro hz + have hsubset : (↑({z, rho} : Finset GaussianInt) : Set GaussianInt) ⊆ + FootprintVertices A ∩ FootprintVertices B ∩ FootprintVertices C := by + intro w hw + simp only [Finset.coe_insert, Finset.coe_singleton, Set.mem_insert_iff, + Set.mem_singleton_iff] at hw + rcases hw with rfl | rfl + · exact hz + · exact hrho + have hge := Set.ncard_le_ncard hsubset htripleVfinite + rw [htripleVcard] at hge + exact (Set.ncard_le_one ({z, rho} : Finset GaussianInt).finite_toSet).mp + hge z (by simp) rho (by simp) + · rintro rfl + exact hrho + +private theorem footprint_incident : + (by + classical + exact + ∀ (T : ProtoTile), (T.cells.Nonempty) → (∀ (z : GaussianInt), (z ∈ FootprintVertices T) → + (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ T.cells)) ) := by + classical + intro T hne z hz + let I : GaussianInt := ⟨0, 1⟩ + unfold FootprintVertices at hz + rw [ite_eq_left hne] at hz + rcases hz with ⟨c, hc, h | h | h | h⟩ + · subst z + exact ⟨0, by simpa [LatticeVertexIncidentCell] using hc⟩ + · subst z + refine ⟨1, ?_⟩ + simpa [LatticeVertexIncidentCell] using hc + · subst z + refine ⟨3, ?_⟩ + simpa [LatticeVertexIncidentCell, I, Zsqrtd.ext_iff] using hc + · subst z + refine ⟨2, ?_⟩ + change c + 1 + I - 1 - I ∈ T.cells + convert hc using 1; ring + +private theorem endpoint_of_third : + (by + classical + exact + ∀ (rho : GaussianInt), (∀ (T : ProtoTile), (T.cells.Nonempty) → (∀ (z : GaussianInt), (z + ∈ FootprintVertices T) → (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ T.cells))) → + (∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), (LatticeTile X) → + ((LatticeTile Y) → ((Z.cells.Nonempty) → ((Disjoint X.cells Y.cells) → ((Disjoint + X.cells Z.cells) → ((Disjoint Y.cells Z.cells) → ((FootprintVertices X ∩ + FootprintVertices Y = + CommonFootprintEdgeVertices X Y) → ((rho ∈ FootprintVertices X ∩ FootprintVertices Y) + → ((rho ∈ FootprintVertices Z) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), + (SimpleGridPathBetween + (FootprintVertices X ∩ FootprintVertices Y) + (FootprintEdges X ∩ FootprintEdges Y) a b) → (rho = a ∨ rho = b))))))))))) ) := by + classical + intro rho footprint_incident X Y Z hX hY hZne hdXY hdXZ hdYZ hraw hrhoXY hrhoZ a b hpath + have hcommonVertex : rho ∈ CommonFootprintEdgeVertices X Y := by + rw [← hraw] + exact hrhoXY + rcases hcommonVertex with ⟨e, he, hrhoe⟩ + rcases SimpleGridPathPointTrichotomy + (FootprintVertices X ∩ FootprintVertices Y) + (FootprintEdges X ∩ FootprintEdges Y) a b rho hpath + ⟨e, hrhoe, he⟩ with h | h | h + · exact Or.inl h + · exact Or.inr h + · rcases h with ⟨e, f, hef, hrhoe, hrhof, he, hf⟩ + have hsectors := (LocalLatticeInterfaceSectors).2 X Y rho + hX hY hdXY ⟨e, f, hef, hrhoe, hrhof, he, hf⟩ + obtain ⟨j, hjZ⟩ := footprint_incident Z hZne rho hrhoZ + rcases hsectors.1 j with hjX | hjY + · exact ((Finset.disjoint_left.mp hdXZ) hjX hjZ).elim + · exact ((Finset.disjoint_left.mp hdYZ) hjY hjZ).elim + +private theorem hendAB : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (LatticeTile A) → ((LatticeTile + B) → ((Disjoint A.cells B.cells) → ((Disjoint B.cells C.cells) → ((Disjoint C.cells + A.cells) → ((C.cells.Nonempty) → ((FootprintVertices A ∩ FootprintVertices B = + CommonFootprintEdgeVertices A B) → (∀ (xAB : GaussianInt), ∀ (yAB : GaussianInt), + (SimpleGridPathBetween (FootprintVertices A ∩ FootprintVertices B) (FootprintEdges A + ∩ FootprintEdges B) xAB yAB) → (∀ (rho : GaussianInt), (rho ∈ FootprintVertices A ∩ + FootprintVertices B ∩ FootprintVertices C) → ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), + ∀ (Z : ProtoTile), (LatticeTile X) → ((LatticeTile Y) → ((Z.cells.Nonempty) → + ((Disjoint X.cells Y.cells) → ((Disjoint X.cells Z.cells) → ((Disjoint Y.cells + Z.cells) → ((FootprintVertices X ∩ FootprintVertices Y = CommonFootprintEdgeVertices + X Y) → ((rho ∈ FootprintVertices X ∩ FootprintVertices Y) → ((rho ∈ FootprintVertices + Z) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), (SimpleGridPathBetween + (FootprintVertices X ∩ FootprintVertices Y) (FootprintEdges X ∩ FootprintEdges Y) a + b) → (rho = a ∨ rho = b))))))))))) → (rho = xAB ∨ rho = yAB)))))))))) ) := by + classical + intro A B C hA hB hdisjointAB hdisjointBC hdisjointCA hCne hVrawAB xAB yAB hpathAB rho hrho + endpoint_of_third + exact endpoint_of_third A B C hA hB hCne hdisjointAB hdisjointCA.symm + hdisjointBC hVrawAB ⟨hrho.1.1, hrho.1.2⟩ hrho.2 xAB yAB hpathAB + +private theorem hendBC : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (LatticeTile B) → ((LatticeTile + C) → ((Disjoint A.cells B.cells) → ((Disjoint B.cells C.cells) → ((Disjoint C.cells + A.cells) → ((A.cells.Nonempty) → ((FootprintVertices B ∩ FootprintVertices C = + CommonFootprintEdgeVertices B C) → (∀ (xBC : GaussianInt), ∀ (yBC : GaussianInt), + (SimpleGridPathBetween (FootprintVertices B ∩ FootprintVertices C) (FootprintEdges B + ∩ FootprintEdges C) xBC yBC) → (∀ (rho : GaussianInt), (rho ∈ FootprintVertices A ∩ + FootprintVertices B ∩ FootprintVertices C) → ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), + ∀ (Z : ProtoTile), (LatticeTile X) → ((LatticeTile Y) → ((Z.cells.Nonempty) → + ((Disjoint X.cells Y.cells) → ((Disjoint X.cells Z.cells) → ((Disjoint Y.cells + Z.cells) → ((FootprintVertices X ∩ FootprintVertices Y = CommonFootprintEdgeVertices + X Y) → ((rho ∈ FootprintVertices X ∩ FootprintVertices Y) → ((rho ∈ FootprintVertices + Z) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), (SimpleGridPathBetween + (FootprintVertices X ∩ FootprintVertices Y) (FootprintEdges X ∩ FootprintEdges Y) a + b) → (rho = a ∨ rho = b))))))))))) → (rho = xBC ∨ rho = yBC)))))))))) ) := by + classical + intro A B C hB hC hdisjointAB hdisjointBC hdisjointCA hAne hVrawBC xBC yBC hpathBC rho hrho + endpoint_of_third + exact endpoint_of_third B C A hB hC hAne hdisjointBC hdisjointAB.symm + hdisjointCA hVrawBC ⟨hrho.1.2, hrho.2⟩ hrho.1.1 xBC yBC hpathBC + +private theorem hendCA : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (LatticeTile A) → ((LatticeTile + C) → ((Disjoint A.cells B.cells) → ((Disjoint B.cells C.cells) → ((Disjoint C.cells + A.cells) → ((B.cells.Nonempty) → ((FootprintVertices C ∩ FootprintVertices A = + CommonFootprintEdgeVertices C A) → (∀ (xCA : GaussianInt), ∀ (yCA : GaussianInt), + (SimpleGridPathBetween (FootprintVertices C ∩ FootprintVertices A) (FootprintEdges C + ∩ FootprintEdges A) xCA yCA) → (∀ (rho : GaussianInt), (rho ∈ FootprintVertices A ∩ + FootprintVertices B ∩ FootprintVertices C) → ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), + ∀ (Z : ProtoTile), (LatticeTile X) → ((LatticeTile Y) → ((Z.cells.Nonempty) → + ((Disjoint X.cells Y.cells) → ((Disjoint X.cells Z.cells) → ((Disjoint Y.cells + Z.cells) → ((FootprintVertices X ∩ FootprintVertices Y = CommonFootprintEdgeVertices + X Y) → ((rho ∈ FootprintVertices X ∩ FootprintVertices Y) → ((rho ∈ FootprintVertices + Z) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), (SimpleGridPathBetween + (FootprintVertices X ∩ FootprintVertices Y) (FootprintEdges X ∩ FootprintEdges Y) a + b) → (rho = a ∨ rho = b))))))))))) → (rho = xCA ∨ rho = yCA)))))))))) ) := by + classical + intro A B C hA hC hdisjointAB hdisjointBC hdisjointCA hBne hVrawCA xCA yCA hpathCA rho hrho + endpoint_of_third + exact endpoint_of_third C A B hC hA hBne hdisjointCA hdisjointBC.symm + hdisjointAB hVrawCA ⟨hrho.2, hrho.1.1⟩ hrho.1.2 xCA yCA hpathCA + +private theorem reverse_path : + (by + classical + exact + ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {a : GaussianInt}, ∀ + {b : GaussianInt}, (SimpleGridPathBetween V E a b) → (SimpleGridPathBetween V E b a) + ) := by + classical + intro V E a b hpath + rcases hpath with ⟨p, hnodup, hlen, hhead, hlast, hvertices, + hstep, hedges⟩ + refine ⟨p.reverse, List.nodup_reverse.mpr hnodup, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simpa using hlen + · simpa using hlast + · simpa using hhead + · rw [hvertices] + ext z + simp + · intro x y l₁ l₂ hrev + have hforward : p = l₂.reverse ++ y :: x :: l₁.reverse := by + have := congrArg List.reverse hrev + simpa [List.reverse_append, List.append_assoc] using this + rcases hstep y x l₂.reverse l₁.reverse hforward with h | h | h | h + · right; left + rw [h] + ring + · left + rw [h] + ring + · right; right; right + rw [h] + ring + · right; right; left + rw [h] + ring + · intro e + constructor + · intro he + rcases (hedges e).1 he with ⟨x, y, l₁, l₂, hp, rfl⟩ + refine ⟨y, x, l₂.reverse, l₁.reverse, ?_, ?_⟩ + · rw [hp] + simp [List.reverse_append, List.append_assoc] + · simp [Finset.pair_comm] + · rintro ⟨x, y, l₁, l₂, hrev, rfl⟩ + apply (hedges {x, y}).2 + refine ⟨y, x, l₂.reverse, l₁.reverse, ?_, ?_⟩ + · have := congrArg List.reverse hrev + simpa [List.reverse_append, List.append_assoc] using this + · simp [Finset.pair_comm] + +private theorem orient_path : + (by + classical + exact + ∀ (rho : GaussianInt), (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ + {a : GaussianInt}, ∀ {b : GaussianInt}, (SimpleGridPathBetween V E a b) → + (SimpleGridPathBetween V E b a)) → (∀ {V : Set GaussianInt}, ∀ + {E : Set (Finset GaussianInt)}, ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, + (SimpleGridPathBetween V E a b) → ((rho = a ∨ rho = b) → (∃ other : GaussianInt, + SimpleGridPathBetween V E rho other))) ) := by + classical + intro rho reverse_path V E a b hpath hend + rcases hend with h | h + · subst a + exact ⟨b, hpath⟩ + · subst b + exact ⟨a, reverse_path hpath⟩ + +end ThreeDiskJunctionGeometry + +theorem LatticeTileThreeDiskJunction + (A B C AB BC CA ABC : ProtoTile) + (hA : LatticeTile A) (hB : LatticeTile B) (hC : LatticeTile C) + (hAB : LatticeTile AB) (hBC : LatticeTile BC) + (hCA : LatticeTile CA) (hABC : LatticeTile ABC) + (hdisjointAB : Disjoint A.cells B.cells) + (hdisjointBC : Disjoint B.cells C.cells) + (hdisjointCA : Disjoint C.cells A.cells) + (hunionAB : ∀ z : LatticeCell, + z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) + (hunionBC : ∀ z : LatticeCell, + z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) + (hunionCA : ∀ z : LatticeCell, + z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) + (hunionABC : ∀ z : LatticeCell, + z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) + (hcommonAB : (FootprintEdges A ∩ FootprintEdges B).Nonempty) + (hcommonBC : (FootprintEdges B ∩ FootprintEdges C).Nonempty) + (hcommonCA : (FootprintEdges C ∩ FootprintEdges A).Nonempty) : + Nonempty (ExactTileInterfaceTriple A B C) := by +-- BODY + classical + have hAgrid := LatticeTileGridStructure A hA + have hBgrid := LatticeTileGridStructure B hB + have hCgrid := LatticeTileGridStructure C hC + have hABgrid := LatticeTileGridStructure AB hAB + have hBCgrid := LatticeTileGridStructure BC hBC + have hCAgrid := LatticeTileGridStructure CA hCA + have hABCgrid := LatticeTileGridStructure ABC hABC + have hAne : A.cells.Nonempty := hAgrid.1.1 + have hBne : B.cells.Nonempty := hBgrid.1.1 + have hCne : C.cells.Nonempty := hCgrid.1.1 + have hABne : AB.cells.Nonempty := hABgrid.1.1 + have hBCne : BC.cells.Nonempty := hBCgrid.1.1 + have hCAne : CA.cells.Nonempty := hCAgrid.1.1 + have hABCne : ABC.cells.Nonempty := hABCgrid.1.1 + have vertex_union (U V W : ProtoTile) + (hUne : U.cells.Nonempty) (hVne : V.cells.Nonempty) + (hWne : W.cells.Nonempty) + (hunion : forall z : LatticeCell, + z ∈ W.cells ↔ z ∈ U.cells ∨ z ∈ V.cells) := ThreeDiskJunctionGeometry.vertex_union U V W + hUne hVne hWne hunion + have edge_union (U V W : ProtoTile) + (hunion : forall z : LatticeCell, + z ∈ W.cells ↔ z ∈ U.cells ∨ z ∈ V.cells) := ThreeDiskJunctionGeometry.edge_union U V W + hunion + have vertex_finite (T : ProtoTile) := ThreeDiskJunctionGeometry.vertex_finite T + have edge_finite (T : ProtoTile) := ThreeDiskJunctionGeometry.edge_finite T + have hVAB := vertex_union A B AB hAne hBne hABne hunionAB + have hVBC := vertex_union B C BC hBne hCne hBCne hunionBC + have hVCA := vertex_union C A CA hCne hAne hCAne hunionCA + have hEAB := edge_union A B AB hunionAB + have hEBC := edge_union B C BC hunionBC + have hECA := edge_union C A CA hunionCA + have hunionAB_C := ThreeDiskJunctionGeometry.hunionAB_C A B C AB BC CA ABC hunionAB hunionABC + hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid hABCgrid + have hVABC := vertex_union AB C ABC hABne hCne hABCne hunionAB_C + have hEABC := edge_union AB C ABC hunionAB_C + obtain ⟨hVrawAB, ⟨xAB, yAB, hpathAB0⟩, -, -⟩ := + LatticeTileDiskUnionInterface A B AB hA hB hAB hdisjointAB + hunionAB hcommonAB + obtain ⟨hVrawBC, ⟨xBC, yBC, hpathBC0⟩, -, -⟩ := + LatticeTileDiskUnionInterface B C BC hB hC hBC hdisjointBC + hunionBC hcommonBC + obtain ⟨hVrawCA, ⟨xCA, yCA, hpathCA0⟩, -, -⟩ := + LatticeTileDiskUnionInterface C A CA hC hA hCA hdisjointCA + hunionCA hcommonCA + have hpathAB := ThreeDiskJunctionGeometry.hpathAB A B hVrawAB xAB yAB hpathAB0 + have hpathBC := ThreeDiskJunctionGeometry.hpathBC B C hVrawBC xBC yBC hpathBC0 + have hpathCA := ThreeDiskJunctionGeometry.hpathCA A C hVrawCA xCA yCA hpathCA0 + have hcellsAB := ThreeDiskJunctionGeometry.hcellsAB A B AB hdisjointAB hunionAB + have hcellsBC := ThreeDiskJunctionGeometry.hcellsBC B C BC hdisjointBC hunionBC + have hcellsCA := ThreeDiskJunctionGeometry.hcellsCA A C CA hdisjointCA hunionCA + have hdisjointAB_C := ThreeDiskJunctionGeometry.hdisjointAB_C A B C AB hdisjointBC hdisjointCA + hunionAB + have hcellsABC := ThreeDiskJunctionGeometry.hcellsABC A B C AB ABC hunionAB_C hcellsAB + hdisjointAB_C + have hIEvAB := Set.ncard_union_add_ncard_inter + (FootprintVertices A) (FootprintVertices B) (vertex_finite A) (vertex_finite B) + have hIEvBC := Set.ncard_union_add_ncard_inter + (FootprintVertices B) (FootprintVertices C) (vertex_finite B) (vertex_finite C) + have hIEvCA := Set.ncard_union_add_ncard_inter + (FootprintVertices C) (FootprintVertices A) (vertex_finite C) (vertex_finite A) + have hIEeAB := Set.ncard_union_add_ncard_inter + (FootprintEdges A) (FootprintEdges B) (edge_finite A) (edge_finite B) + have hIEeBC := Set.ncard_union_add_ncard_inter + (FootprintEdges B) (FootprintEdges C) (edge_finite B) (edge_finite C) + have hIEeCA := Set.ncard_union_add_ncard_inter + (FootprintEdges C) (FootprintEdges A) (edge_finite C) (edge_finite A) + rw [← hVAB] at hIEvAB + rw [← hVBC] at hIEvBC + rw [← hVCA] at hIEvCA + rw [← hEAB] at hIEeAB + rw [← hEBC] at hIEeBC + rw [← hECA] at hIEeCA + let I : GaussianInt := ⟨0, 1⟩ + have horiz_unique (x y : GaussianInt) + (h : ({x, x + 1} : Finset GaussianInt) = {y, y + 1}) := + ThreeDiskJunctionGeometry.horiz_unique A B C AB BC CA ABC x y h + have vert_unique (x y : GaussianInt) + (h : ({x, x + I} : Finset GaussianInt) = {y, y + I}) := + ThreeDiskJunctionGeometry.vert_unique A B C AB BC CA ABC x y h + have horiz_ne_vert (x y : GaussianInt) := ThreeDiskJunctionGeometry.horiz_ne_vert A B C AB BC + CA ABC x y + have footprint_normalize (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges T) := ThreeDiskJunctionGeometry.footprint_normalize T e he + have htripleEdges : + FootprintEdges A ∩ FootprintEdges B ∩ FootprintEdges C = ∅ := + ThreeDiskJunctionGeometry.htripleEdges A B C hdisjointAB hdisjointBC hdisjointCA + horiz_unique vert_unique horiz_ne_vert footprint_normalize + have hIEvABC := ThreeDiskJunctionGeometry.hIEvABC C AB vertex_finite + have hIEeABC := ThreeDiskJunctionGeometry.hIEeABC C AB edge_finite + rw [← hVABC] at hIEvABC + rw [← hEABC] at hIEeABC + have hcrossV : FootprintVertices AB ∩ FootprintVertices C = + (FootprintVertices A ∩ FootprintVertices C) ∪ + (FootprintVertices B ∩ FootprintVertices C) := ThreeDiskJunctionGeometry.hcrossV A B C AB + BC CA ABC hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid hABCgrid hVAB + have hcrossE : FootprintEdges AB ∩ FootprintEdges C = + (FootprintEdges A ∩ FootprintEdges C) ∪ + (FootprintEdges B ∩ FootprintEdges C) := ThreeDiskJunctionGeometry.hcrossE A B C AB BC CA + ABC hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid hABCgrid hEAB + rw [hcrossV] at hIEvABC + rw [hcrossE] at hIEeABC + have hIEvCross := ThreeDiskJunctionGeometry.hIEvCross A B C vertex_finite + have hIEeCross := ThreeDiskJunctionGeometry.hIEeCross A B C edge_finite + have htripleVset : + (FootprintVertices A ∩ FootprintVertices C) ∩ + (FootprintVertices B ∩ FootprintVertices C) = + FootprintVertices A ∩ FootprintVertices B ∩ FootprintVertices C := + ThreeDiskJunctionGeometry.htripleVset A B C AB BC CA ABC hAgrid hBgrid hCgrid hABgrid + hBCgrid hCAgrid hABCgrid + have htripleEset : + (FootprintEdges A ∩ FootprintEdges C) ∩ + (FootprintEdges B ∩ FootprintEdges C) = + FootprintEdges A ∩ FootprintEdges B ∩ FootprintEdges C := + ThreeDiskJunctionGeometry.htripleEset A B C AB BC CA ABC hAgrid hBgrid hCgrid hABgrid + hBCgrid hCAgrid hABCgrid + rw [htripleVset] at hIEvCross + rw [htripleEset, htripleEdges] at hIEeCross + simp only [Set.ncard_empty, add_zero] at hIEeCross + have hEulerA := LatticeTileGridEulerCount A hA + have hEulerB := LatticeTileGridEulerCount B hB + have hEulerC := LatticeTileGridEulerCount C hC + have hEulerAB := LatticeTileGridEulerCount AB hAB + have hEulerBC := LatticeTileGridEulerCount BC hBC + have hEulerCA := LatticeTileGridEulerCount CA hCA + have hEulerABC := LatticeTileGridEulerCount ABC hABC + have htripleVcard := ThreeDiskJunctionGeometry.htripleVcard A B C AB BC CA ABC hcellsAB + hcellsBC hcellsCA hcellsABC hIEvAB hIEvBC hIEvCA hIEeAB hIEeBC hIEeCA hIEvABC hIEeABC + hIEvCross hIEeCross hEulerA hEulerB hEulerC hEulerAB hEulerBC hEulerCA hEulerABC + have htripleVfinite := ThreeDiskJunctionGeometry.htripleVfinite A B C vertex_finite + have htripleVnonempty := ThreeDiskJunctionGeometry.htripleVnonempty A B C AB BC CA ABC + htripleVcard + obtain ⟨rho, hrho⟩ := htripleVnonempty + have huniqueRho (z : GaussianInt) := ThreeDiskJunctionGeometry.huniqueRho A B C htripleVcard + htripleVfinite rho hrho z + have footprint_incident (T : ProtoTile) (hne : T.cells.Nonempty) + (z : GaussianInt) (hz : z ∈ FootprintVertices T) := + ThreeDiskJunctionGeometry.footprint_incident T hne z hz + have endpoint_of_third (X Y Z : ProtoTile) + (hX : LatticeTile X) (hY : LatticeTile Y) + (hZne : Z.cells.Nonempty) + (hdXY : Disjoint X.cells Y.cells) + (hdXZ : Disjoint X.cells Z.cells) + (hdYZ : Disjoint Y.cells Z.cells) + (hraw : FootprintVertices X ∩ FootprintVertices Y = + CommonFootprintEdgeVertices X Y) + (hrhoXY : rho ∈ FootprintVertices X ∩ FootprintVertices Y) + (hrhoZ : rho ∈ FootprintVertices Z) + (a b : GaussianInt) + (hpath : SimpleGridPathBetween + (FootprintVertices X ∩ FootprintVertices Y) + (FootprintEdges X ∩ FootprintEdges Y) a b) := ThreeDiskJunctionGeometry.endpoint_of_third + rho footprint_incident X Y Z hX hY hZne hdXY hdXZ hdYZ hraw hrhoXY hrhoZ a b hpath + have hendAB := ThreeDiskJunctionGeometry.hendAB A B C hA hB hdisjointAB hdisjointBC hdisjointCA + hCne hVrawAB xAB yAB hpathAB rho hrho endpoint_of_third + have hendBC := ThreeDiskJunctionGeometry.hendBC A B C hB hC hdisjointAB hdisjointBC hdisjointCA + hAne hVrawBC xBC yBC hpathBC rho hrho endpoint_of_third + have hendCA := ThreeDiskJunctionGeometry.hendCA A B C hA hC hdisjointAB hdisjointBC hdisjointCA + hBne hVrawCA xCA yCA hpathCA rho hrho endpoint_of_third + have reverse_path {V : Set GaussianInt} {E : Set (Finset GaussianInt)} + {a b : GaussianInt} (hpath : SimpleGridPathBetween V E a b) := + ThreeDiskJunctionGeometry.reverse_path (V := V) (E := E) (a := a) (b := b) hpath + have orient_path {V : Set GaussianInt} {E : Set (Finset GaussianInt)} + {a b : GaussianInt} (hpath : SimpleGridPathBetween V E a b) + (hend : rho = a ∨ rho = b) := ThreeDiskJunctionGeometry.orient_path rho reverse_path (V := + V) (E := E) (a := a) (b := b) hpath hend + obtain ⟨otherAB, pathAB⟩ := orient_path hpathAB hendAB + obtain ⟨otherBC, pathBC⟩ := orient_path hpathBC hendBC + obtain ⟨otherCA, pathCA⟩ := orient_path hpathCA hendCA + exact ⟨{ + point := rho + otherAB := otherAB + otherBC := otherBC + otherCA := otherCA + pathAB := pathAB + pathBC := pathBC + pathCA := pathCA + unique_common := huniqueRho + }⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeVertexBoundary.lean b/LeanPool/ApollonianSuperharmonic/LatticeVertexBoundary.lean new file mode 100644 index 0000000000..80a558f256 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeVertexBoundary.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction + +-- [TABLET NODE: LatticeVertexBoundary] + +/-! +# LatticeVertexBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a lattice-vertex set $S\subseteq\mathbb Z^2$, its vertex boundary is +$$ + \partial S=\{x\in S:\text{ some }y\notin S\text{ differs from }x + \text{ by at most one in each coordinate}\}. +$$ +Equivalently, this is the paper's condition that some exterior lattice +vertex lies at Euclidean distance less than $2$ from $x$. +-/ +def LatticeVertexBoundary (S : Set GaussianInt) : Set GaussianInt := +-- BODY + {x | x ∈ S ∧ ∃ y : GaussianInt, y ∉ S ∧ + Int.natAbs (x.re - y.re) <= 1 ∧ Int.natAbs (x.im - y.im) <= 1} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeVertexIncidentCell.lean b/LeanPool/ApollonianSuperharmonic/LatticeVertexIncidentCell.lean new file mode 100644 index 0000000000..88b50206d4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeVertexIncidentCell.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeCell + +-- [TABLET NODE: LatticeVertexIncidentCell] + +/-! +# LatticeVertexIncidentCell + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a lattice vertex $x$, number its four incident unit cells cyclically by +their lower-left corners +$$ + \operatorname{inc}(x,0)=x,\quad + \operatorname{inc}(x,1)=x-1,\quad + \operatorname{inc}(x,2)=x-1-\mathrm{i},\quad + \operatorname{inc}(x,3)=x-\mathrm{i}. +$$ +Indices are read modulo four. In particular, sectors $j$ and $j+2$ are +opposite at $x$. +-/ +def LatticeVertexIncidentCell (x : GaussianInt) : Fin 4 -> LatticeCell := +-- BODY + ![x, x - 1, x - 1 - ⟨0, 1⟩, x - ⟨0, 1⟩] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LeftAdjacentOdometerCompatibility.lean b/LeanPool/ApollonianSuperharmonic/LeftAdjacentOdometerCompatibility.lean new file mode 100644 index 0000000000..90c700675f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LeftAdjacentOdometerCompatibility.lean @@ -0,0 +1,562 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4261T2LiteralInterface +public import LeanPool.ApollonianSuperharmonic.P4261T2AdjacentMatrixSlope +public import LeanPool.ApollonianSuperharmonic.P4261T2UnitBoundary +public import LeanPool.ApollonianSuperharmonic.P4261T2UnitStringTelescoping +public import LeanPool.ApollonianSuperharmonic.P4261T2DiamondBoundary +public import LeanPool.ApollonianSuperharmonic.P4261T2RegularEdgeReduction +public import LeanPool.ApollonianSuperharmonic.P4261T2InterfacePropagation +public import LeanPool.ApollonianSuperharmonic.P4261T2UnitInterface +public import LeanPool.ApollonianSuperharmonic.P4261T2PairNormalization +public import LeanPool.ApollonianSuperharmonic.P4261T2AncestorSymmetry +public import LeanPool.ApollonianSuperharmonic.P4158T1StringSlopeTelescoping +public import LeanPool.ApollonianSuperharmonic.P4055T1PackingGridEquivalence +public import LeanPool.ApollonianSuperharmonic.FordLeftBoundaryCompatibility +public import LeanPool.ApollonianSuperharmonic.FordOpposingBoundaryStarLocalization +public import LeanPool.ApollonianSuperharmonic.DiamondOpposingBoundaryStarLocalization +public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryStarLocalization +public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryInterfaceExhaustion +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure + +-- [TABLET NODE: LeftAdjacentOdometerCompatibility] + +/-! +# LeftAdjacentOdometerCompatibility + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace LeftCompatibilityGeometry + +private theorem compatibility_symm : + (by + classical + exact + ∀ (a : PartialOdometer), ∀ (b : PartialOdometer), (OdometerCompatibility a b) → + (OdometerCompatibility b a) ) := by + classical + intro a b hc + rcases hc with hd | ⟨c, hc⟩ + · exact Or.inl hd.symm + · exact Or.inr ⟨-c, by intro x hb ha; have := hc x ha hb; omega⟩ + +private theorem adjacency_symm : + (by + classical + exact + ∀ (D : BandCircle), ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (a : PartialOdometer), ∀ (b : + PartialOdometer), (1 < D.1.1.1) → ((LeftLatticeAdjacent D A B a b) → + (LeftLatticeAdjacent D B A b a)) ) := by + classical + intro D A B a b hl ha + obtain ⟨hA, hB, p, r, hp, hr, hu | ⟨q, j, e, hq, hD, hc, hs, ht⟩⟩ := ha + · omega + · refine ⟨hB, hA, r, p, hr, hp, Or.inr ⟨q, j, !e, hq, hD, ?_, ?_, ?_⟩⟩ + · cases e <;> simpa using congrArg Neg.neg hc + · cases e <;> simp_all only [Bool.not_false, Bool.not_true, Bool.false_eq_true, + ↓reduceIte, one_mul, neg_one_mul] <;> linarith + · cases e <;> simp_all only [Bool.not_false, Bool.not_true, Bool.false_eq_true, + ↓reduceIte, one_mul, neg_one_mul] <;> linarith + +private theorem adjacency_action : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (D : BandCircle), ∀ (E : BandCircle), (E.1.1 = + BandPackingSymmetryCircleAction g D.1.1) → ((1 < D.1.1.1) → (∀ (A : ProtoTile), ∀ (B + : ProtoTile), ∀ (a : PartialOdometer), ∀ (b : PartialOdometer), (LeftLatticeAdjacent + D A B a b) → (LeftLatticeAdjacent E (BandPackingSymmetryTileAction g A) + (BandPackingSymmetryTileAction g B) (BandPackingSymmetryPartialOdometerAction g a) + (BandPackingSymmetryPartialOdometerAction g b)))) ) := by + classical + intro g D E hE hl A B a b ha + obtain ⟨hA, hB, p, r, hp, hr, hu | ⟨q, j, e, hq, hD, hc, hs, ht⟩⟩ := ha + · omega + · obtain ⟨negative, s, t, _, hAn, hBn, hpn, hrn, hcn, hsn, htn, _⟩ := + LeftLatticeAdjacentPackingSymmetryTransport g q hq j e A B a b p r + (by simpa [hD] using hA) (by simpa [hD] using hB) hp hr hc hs ht + have hEn : BandPackingSymmetryQuadrupleAction g q 0 = E.1.1 := by + simpa [BandPackingSymmetryQuadrupleAction, hD] using hE.symm + refine ⟨by simpa only [hEn] using hAn, by simpa only [hEn] using hBn, + s, t, hpn, hrn, Or.inr ⟨BandPackingSymmetryQuadrupleAction g q, + (if BandPackingSymmetryReversesOrientation g then -j else j), + xor e negative, BandPackingSymmetryProperCovariance g q hq, + hEn, hcn, hsn, htn⟩⟩ + +private theorem membership_action : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (a : PartialOdometer), ∀ (x : GaussianInt), + BandPackingSymmetryVectorAction g x ∈ (BandPackingSymmetryPartialOdometerAction g + a).domain ↔ x ∈ a.domain ) := by + classical + intro g a x + obtain ⟨f, hf, _, _⟩ := P4055T1PackingGridEquivalence g + have hi : Function.Injective (BandPackingSymmetryVectorAction g) := by + intro u v huv + apply f.injective + simpa only [hf] using huv + change _ ∈ ((BandPackingSymmetryPartialOdometerAction g a).domain : + Set GaussianInt) ↔ _ + rw [(BandPackingSymmetryPartialOdometerActionFormulas g a a).1] + constructor + · rintro ⟨z, hz, he⟩ + exact hi he ▸ hz + · intro hx + exact ⟨x, hx, rfl⟩ + +private theorem star_action : + (by + classical + exact + (∀ (g : BandPackingSymmetry), ∀ (a : PartialOdometer), ∀ (x : GaussianInt), + BandPackingSymmetryVectorAction g x ∈ (BandPackingSymmetryPartialOdometerAction g + a).domain ↔ x ∈ a.domain) → (∀ (g : BandPackingSymmetry), ∀ (a : PartialOdometer), ∀ + (b : PartialOdometer), ∀ (x : GaussianInt), (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ a.domain ∨ y ∈ b.domain) → (∀ y, y = + BandPackingSymmetryVectorAction g x ∨ y = BandPackingSymmetryVectorAction g x + + 1 ∨ y = BandPackingSymmetryVectorAction g x - 1 ∨ y = + BandPackingSymmetryVectorAction g x + ⟨0, 1⟩ ∨ y = + BandPackingSymmetryVectorAction g x - ⟨0, 1⟩ → y ∈ + (BandPackingSymmetryPartialOdometerAction g a).domain ∨ y ∈ + (BandPackingSymmetryPartialOdometerAction g b).domain)) ) := by + classical + intro membership_action g a b x hs y hy + obtain ⟨f, hf, _, hback⟩ := P4055T1PackingGridEquivalence g + have hy' : f.symm y = x ∨ f.symm y = x + 1 ∨ f.symm y = x - 1 ∨ + f.symm y = x + ⟨0, 1⟩ ∨ f.symm y = x - ⟨0, 1⟩ := by + rcases hy with he | hn + · left + rw [← hf x] at he + simp [he] + · right + have hn' : y = f x + 1 ∨ y = f x - 1 ∨ + y = f x + ⟨0, 1⟩ ∨ y = f x - ⟨0, 1⟩ := by simpa only [hf] using hn + simpa using hback (f x) y hn' + rcases hs (f.symm y) hy' with ha | hb + · left + have hm := (membership_action g a (f.symm y)).mpr ha + simpa only [← hf, Equiv.apply_symm_apply] using hm + · right + have hm := (membership_action g b (f.symm y)).mpr hb + simpa only [← hf, Equiv.apply_symm_apply] using hm + +private theorem layout : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (D : + BandCircle), (q 0 = D.1.1) → (∀ (A : ProtoTile), (BandPrototile (q 0) A) → (Nonempty + (BandOrderedGeneralLayoutCertificate q cfg D A) ∧ QuarterTurnSymmetric A)) ) := by + classical + intro q cfg D hD A hA + refine ⟨?_, (BandTileSimultaneousInduction q cfg.proper A hA).2.2.2.1⟩ + apply BandOrderedGeneralLayout q cfg D hD A hA + · intro q' T' S' hq' hT' hocc hcells _ + have hI := BandTileSimultaneousInduction q' hq' T' hT' + exact ⟨hI.1, hI.2.1, hI.2.2.1 S' hocc hcells⟩ + · intro E U hU _ + cases hU with + | line w z hw => + intro p + simp [TileRealization, TileCentroid] + | unit z a anchor => + intro p + have hc : TileCentroid (⟨{a}, anchor⟩ : ProtoTile) = + (((a.re : Int) : Real) + (1 / 2 : Real), + ((a.im : Int) : Real) + (1 / 2 : Real)) := by simp [TileCentroid] + rw [hc] + rcases p with ⟨px, py⟩ + simp only [TileRealization, Finset.mem_singleton, Set.mem_iUnion] + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor + · rintro ⟨b, rfl, hlo, hhi⟩ + refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> + linarith [hlo.1, hlo.2, hhi.1, hhi.2] + · rintro ⟨b, rfl, hlo, hhi⟩ + refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> + linarith [hlo.1, hlo.2, hhi.1, hhi.2] + | @decompose q' hq' S' U' hS hcells hfoot hcent => + exact (BandTileSimultaneousInduction q' hq' U + (.decompose hq' hS hcells hfoot hcent)).2.2.2.1 + · intro q' T' U hq' hT' _ hlarge i hU hcentU + exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.1 + hlarge i U hU hcentU + · intro q' T' U V hq' hT' _ i hU hV hcentU hcentV + exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.2.1 + i U V hU hV hcentU hcentV + +private theorem make_adj : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (D : BandCircle), (q 0 = + D.1.1) → (∀ (j : Fin 3), ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (a : + PartialOdometer), ∀ (b : PartialOdometer), ∀ (p : Real × Real), ∀ (r : Real × Real), + (TileOdometer D.1.1 A a) → ((TileOdometer D.1.1 B b) → ((PartialOdometerSlope a = + some p) → ((PartialOdometerSlope b = some r) → ((TileCentroid B - TileCentroid A = + GaussianRealPoint (BandVectors.1 (q j.succ) (q 0))) → ((r - p = GaussianRealPoint + (BandVectors.2 (q j.succ) (q 0))) → (LeftLatticeAdjacent D A B a b)))))))) ) := by + classical + intro q hq D hD j A B a b p r hA hB hp hr hc hs + refine ⟨hA, hB, p, r, hp, hr, Or.inr ⟨q, j, true, hq, hD, ?_, ?_, ?_⟩⟩ + · simpa using hc + · simpa [GaussianRealPoint] using congrArg Prod.fst hs + · simpa [GaussianRealPoint] using congrArg Prod.snd hs + +private theorem compatibility : + (by + classical + exact + (∀ (a : PartialOdometer), ∀ (b : PartialOdometer), (OdometerCompatibility a b) → + (OdometerCompatibility b a)) → ((∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (D : BandCircle), (q 0 = D.1.1) → (∀ (A : + ProtoTile), (BandPrototile (q 0) A) → (Nonempty (BandOrderedGeneralLayoutCertificate + q cfg D A) ∧ QuarterTurnSymmetric A))) → ((∀ (q : Fin 4 → CircleCoordinates), + (ProperBandQuadruple q) → (∀ (D : BandCircle), (q 0 = D.1.1) → (∀ (j : Fin 3), ∀ (A : + ProtoTile), ∀ (B : ProtoTile), ∀ (a : PartialOdometer), ∀ (b : PartialOdometer), ∀ (p + : Real × Real), ∀ (r : Real × Real), (TileOdometer D.1.1 A a) → ((TileOdometer D.1.1 + B b) → ((PartialOdometerSlope a = some p) → ((PartialOdometerSlope b = some r) → + ((TileCentroid B - TileCentroid A = GaussianRealPoint (BandVectors.1 (q j.succ) (q + 0))) → ((r - p = GaussianRealPoint (BandVectors.2 (q j.succ) (q 0))) → + (LeftLatticeAdjacent D A B a b))))))))) → (∀ n : Nat, ∀ (D : BandCircle), ∀ (A : + ProtoTile), ∀ (B : ProtoTile), ∀ (a : PartialOdometer), ∀ (b : PartialOdometer), + D.1.1.1.toNat = n → LeftLatticeAdjacent D A B a b → OdometerCompatibility a b))) ) := by + classical + intro compatibility_symm layout make_adj n + induction n using Nat.strong_induction_on with + | h n ih => + intro D A B a b hn ha + by_cases hu : D.1.1.1 = 1 + · obtain ⟨p, r, hp, hr, h0, h1⟩ := P4261T2AdjacentMatrixSlope D A B a b ha + exact P4261T2UnitBoundary D hu A B a b ha.1 ha.2.1 p r hp hr h0 h1 + have ha_original := ha + obtain ⟨hA, hB, p, r, hp, hr, hunit | ⟨q, j, e, hq, hD, hc, hs, ht⟩⟩ := ha + · exact (hu hunit.1).elim + by_cases hline : ∃ j : Fin 4, (q j).1 = 0 + · exact FordLeftBoundaryCompatibility D A B a b ha_original q hq hD hline + have hj : 0 < (q j.succ).1 := by + have hn := (ProperBandCurvatureStructure q hq).2.1 j + have hz : (q j.succ).1 ≠ 0 := by intro hz; exact hline ⟨j.succ, hz⟩ + omega + let E : BandCircle := ⟨⟨q j.succ, + ⟨Or.inl hj, ⟨q, hq.1, j.succ, rfl⟩⟩⟩, hj⟩ + have hsr : r - p = (if e = true then (1 : Real) else -1) • + GaussianRealPoint (BandVectors.2 (q j.succ) (q 0)) := by + exact Prod.ext hs ht + obtain ⟨g, qn, Dn, En, jn, en, pn, rn, hqn, hDn, hEn, hDact, hEact, + hDcurv, hEcurv, hAn, hBn, hpn, hrn, hcn, hsn, hreg⟩ := + P4261T2PairNormalization q hq D E j e hD rfl A B a b hA hB p r hp hr hc hsr + have smaller : ∀ (F : BandCircle) (U V : ProtoTile) (f k : PartialOdometer), + F.1.1.1 < Dn.1.1.1 → LeftLatticeAdjacent F U V f k → + OdometerCompatibility f k := by + intro F U V f k hless hadj + have hpos := F.2 + have hlt : F.1.1.1.toNat < n := by omega + exact ih F.1.1.1.toNat hlt F U V f k rfl hadj + have positive : ∀ (U V : ProtoTile) (f k : PartialOdometer) (s t : Real × Real), + TileOdometer Dn.1.1 U f → TileOdometer Dn.1.1 V k → + PartialOdometerSlope f = some s → PartialOdometerSlope k = some t → + TileCentroid V - TileCentroid U = + GaussianRealPoint (BandVectors.1 (qn jn.succ) (qn 0)) → + t - s = GaussianRealPoint (BandVectors.2 (qn jn.succ) (qn 0)) → + OdometerCompatibility f k := by + intro U V f k s t hU hV hsf htk hcent hslope + rcases hreg with ⟨P, hP, hFord⟩ | ⟨K, hK, hDiamond⟩ | ⟨cfg⟩ + · apply FordLeftBoundaryCompatibility Dn U V f k + (make_adj qn hqn Dn hDn jn U V f k s t hU hV hsf htk hcent hslope) qn hqn hDn + exact ⟨3, by simp [hFord, FordRecursiveQuadruple]⟩ + · exact P4261T2DiamondBoundary K Dn (by simpa [hDiamond] using hDn) + jn U V f k hU hV s t hsf htk + (by simpa [hDiamond] using hcent) (by simpa [hDiamond] using hslope) + · obtain ⟨cfg⟩ := cfg + have hproto : BandPrototile (qn 0) U := by + simpa only [hDn] using TileOdometerBandPrototile Dn.1.1 U f hU + obtain ⟨⟨cert⟩, hsym⟩ := layout qn cfg Dn hDn U hproto + have hpkg : Nonempty (P4261T2LiteralInterface En Dn U V f k) := by + by_cases hunit : En.1.1.1 = 1 + · exact P4261T2UnitInterface qn cfg Dn En jn hDn hEn U V f k cert hsym + hU hV hunit s t hsf htk hcent hslope + · have hlarge : 1 < En.1.1.1 := by have hpos := En.2; omega + obtain ⟨o, base, Rm, Rp, tiles, reverseTiles, fs, ks, hm, hp, + pm, pp, path, hboundary, hreverse, hforward, hbackward, + hhead, hlast, hhead', hlast', hOm, hOp, hpm, hpp, + hminusSlope, hplusSlope, htriplem, htriplep, hnodup, hlen, + hfirst, hfinal, hvertices, hedges, hvertexRestrictions, + hedgeRestrictions⟩ := + OpposingBoundaryInterfaceExhaustion qn cfg Dn En jn hDn hEn + U V f k cert hsym hU hV hlarge s t hsf htk hcent hslope + refine ⟨⟨o, base, Rm, Rp, tiles, reverseTiles, fs, ks, hm, hp, path, + hforward, hbackward, hhead, hlast, hhead', hlast', hnodup, + hlen, hvertices, hedges, ?_⟩⟩ + intro x y pre post he + obtain ⟨⟨W, a, _, hWa, heW, ha⟩, ⟨X, b, _, hXb, heX, hb⟩, _⟩ := + hedgeRestrictions x y pre post he + exact ⟨W, X, a, b, hWa, hXb, ⟨heW, heX⟩, ha, hb⟩ + obtain ⟨pkg⟩ := hpkg + apply P4261T2InterfacePropagation En Dn U V f k hU hV pkg + intro W X a b hWa hXb he + have htelescope : ∃ s t : Real × Real, + PartialOdometerSlope a = some s ∧ PartialOdometerSlope b = some t ∧ + t.1 - s.1 = CircleMatrix En 0 0 * ((TileCentroid X).1 - (TileCentroid W).1) + + CircleMatrix En 0 1 * ((TileCentroid X).2 - (TileCentroid W).2) ∧ + t.2 - s.2 = CircleMatrix En 1 0 * ((TileCentroid X).1 - (TileCentroid W).1) + + CircleMatrix En 1 1 * ((TileCentroid X).2 - (TileCentroid W).2) := by + by_cases hunit : En.1.1.1 = 1 + · exact P4261T2UnitStringTelescoping En hunit pkg.orientation pkg.base + pkg.minus pkg.plus pkg.tiles pkg.reverseTiles pkg.functions pkg.reverseFunctions + pkg.forward pkg.backward pkg.hminus pkg.head_forward pkg.last_backward W X a b + hWa hXb + · exact P4158T1StringSlopeTelescoping En (by have hp := En.2; omega) + pkg.orientation pkg.base pkg.minus pkg.plus pkg.tiles pkg.reverseTiles + pkg.functions pkg.reverseFunctions pkg.forward pkg.backward pkg.hminus + pkg.head_forward pkg.last_backward W X a b hWa hXb + obtain ⟨s, t, hs, ht, h0, h1⟩ := htelescope + have hOW := List.forall₂_zip pkg.forward.2.1 hWa + have hOX := List.forall₂_zip pkg.backward.2.1 hXb + have hWmem : W ∈ pkg.tiles := (List.of_mem_zip hWa).1 + have hXmem : X ∈ pkg.reverseTiles := (List.of_mem_zip hXb).1 + rcases P4261T2RegularEdgeReduction En pkg.base W X pkg.forward.1.1 + (pkg.forward.1.2.2.2.2.1 W hWmem) (pkg.backward.1.2.2.2.2.1 X hXmem) + a b hOW hOX s t hs ht h0 h1 he with hc | ha + · exact hc + · apply smaller En W X a b _ ha + simpa only [hEn, hDn] using hqn.2 jn + have hncompat : OdometerCompatibility + (BandPackingSymmetryPartialOdometerAction g a) + (BandPackingSymmetryPartialOdometerAction g b) := by + cases en with + | false => + apply compatibility_symm + apply positive _ _ _ _ rn pn hBn hAn hrn hpn + · simpa using congrArg Neg.neg hcn + · simpa using congrArg Neg.neg hsn + | true => + exact positive _ _ _ _ pn rn hAn hBn hpn hrn (by simpa using hcn) (by simpa using hsn) + exact (BandPackingSymmetryPartialOdometerActionFormulas g a b).2.2.2.2.2.2.1.mp hncompat + +private theorem hslope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (q : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (e : Bool), ∀ (p : ℝ × ℝ), ∀ (r : ℝ × ℝ), + (r.1 - p.1 = CircleMatrix C (0 : Fin (2 : ℕ)) (0 : Fin (2 : ℕ)) * ((TileCentroid + T').1 - (TileCentroid T).1) + CircleMatrix C (0 : Fin (2 : ℕ)) (1 : Fin (2 : ℕ)) * + ((TileCentroid T').2 - (TileCentroid T).2)) → ((r.2 - p.2 = CircleMatrix C (1 : Fin + (2 : ℕ)) (0 : Fin (2 : ℕ)) * ((TileCentroid T').1 - (TileCentroid T).1) + + CircleMatrix C (1 : Fin (2 : ℕ)) (1 : Fin (2 : ℕ)) * ((TileCentroid T').2 - + (TileCentroid T).2)) → ((CircleMatrix C (0 : Fin (2 : ℕ)) (0 : Fin (2 : ℕ)) * + (↑(BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))).re : ℝ) + CircleMatrix C (0 : Fin + (2 : ℕ)) (1 : Fin (2 : ℕ)) * (↑(BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))).im : + ℝ) = (↑(BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))).re : ℝ)) → ((CircleMatrix C + (1 : Fin (2 : ℕ)) (0 : Fin (2 : ℕ)) * (↑(BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ)))).re : ℝ) + CircleMatrix C (1 : Fin (2 : ℕ)) (1 : Fin (2 : ℕ)) * (↑(BandVectors.1 + (q i.succ) (q (0 : Fin (4 : ℕ)))).im : ℝ) = (↑(BandVectors.2 (q i.succ) (q (0 : Fin + (4 : ℕ)))).im : ℝ)) → (((TileCentroid T').1 - (TileCentroid T).1 = (if e = true then + (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))).re : ℝ)) + → (((TileCentroid T').2 - (TileCentroid T).2 = (if e = true then (1 : ℝ) else (-1 : + ℝ)) * (↑(BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))).im : ℝ)) → (r - p = (if e = + true then (1 : Real) else -1) • GaussianRealPoint (BandVectors.2 (q i.succ) (q + 0)))))))) ) := by + classical + intro C T T' q i e p r h0 h1 hin0 hin1 hc0 hc1 + apply Prod.ext + · change r.1 - p.1 = (if e = true then (1 : Real) else -1) * + ((BandVectors.2 (q i.succ) (q 0)).re : Real) + rw [hc0, hc1] at h0 + linear_combination h0 + (if e = true then (1 : Real) else -1) * hin0 + · change r.2 - p.2 = (if e = true then (1 : Real) else -1) * + ((BandVectors.2 (q i.succ) (q 0)).im : Real) + rw [hc0, hc1] at h1 + linear_combination h1 + (if e = true then (1 : Real) else -1) * hin1 + +private theorem positive_star : + (by + classical + exact + (∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (D : + BandCircle), (q 0 = D.1.1) → (∀ (A : ProtoTile), (BandPrototile (q 0) A) → (Nonempty + (BandOrderedGeneralLayoutCertificate q cfg D A) ∧ QuarterTurnSymmetric A))) → (∀ (qn + : Fin (4 : ℕ) → CircleCoordinates), ∀ (Cn : BandCircle), ∀ (Din : BandCircle), ∀ (j : + Fin (3 : ℕ)), (ProperBandQuadruple qn) → ((qn (0 : Fin (4 : ℕ)) = Cn.1.1) → ((qn + j.succ = Din.1.1) → (((∃ (P : FordFareyParameter), (1 : ℕ) < P.q ∧ qn = + FordRecursiveQuadruple P) ∨ (∃ (K : DiamondParameter), (1 : ℕ) < K.1 ∧ qn = + DiamondRecursiveQuadruple K) ∨ Nonempty (BandOrderedGeneralConfiguration qn)) → ((1 < + Din.1.1.1) → (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (a : PartialOdometer), ∀ (b : + PartialOdometer), ∀ (s : Real × Real), ∀ (t : Real × Real), TileOdometer Cn.1.1 A a → + TileOdometer Cn.1.1 B b → PartialOdometerSlope a = some s → PartialOdometerSlope b = + some t → TileCentroid B - TileCentroid A = GaussianRealPoint (BandVectors.1 (qn + j.succ) (qn 0)) → t - s = GaussianRealPoint (BandVectors.2 (qn j.succ) (qn 0)) → ∀ z, + z ∈ a.domain → z ∈ b.domain → (∀ y, y = z ∨ y = z + 1 ∨ y = z - 1 ∨ y = z + ⟨0, 1⟩ ∨ + y = z - ⟨0, 1⟩ → y ∈ a.domain ∨ y ∈ b.domain) → ∃ (U V : ProtoTile) (f k : + PartialOdometer), AncestorOdometer Din.1.1 Cn.1.1 U A f a ∧ AncestorOdometer Din.1.1 + Cn.1.1 V B k b ∧ LeftLatticeAdjacent Din U V f k ∧ z ∈ f.domain ∧ z ∈ k.domain ∧ ∀ y, + y = z ∨ y = z + 1 ∨ y = z - 1 ∨ y = z + ⟨0, 1⟩ ∨ y = z - ⟨0, 1⟩ → y ∈ f.domain ∨ y ∈ + k.domain)))))) ) := by + classical + intro layout qn Cn Din j hqn hCn hDin hreg hlargeN A B a b s t hA hB hsa htb hc hs z hza hzb hzs + rcases hreg with ⟨P, hP, heq⟩ | ⟨K, hK, heq⟩ | ⟨cfg⟩ + · apply FordOpposingBoundaryStarLocalization P (by simpa [← heq] using hqn) + Cn Din j (by simpa [← heq] using hCn) (by simpa [← heq] using hDin) + A B a b hA hB hlargeN s t hsa htb + (by simpa [← heq] using hc) (by simpa [← heq] using hs) z hza hzb hzs + · exact DiamondOpposingBoundaryStarLocalization K (by simpa [← heq] using hqn) + Cn Din j (by simpa [← heq] using hCn) (by simpa [← heq] using hDin) + A B a b hA hB hlargeN s t hsa htb + (by simpa [← heq] using hc) (by simpa [← heq] using hs) z hza hzb hzs + · obtain ⟨cfg⟩ := cfg + have hproto : BandPrototile (qn 0) A := by + simpa only [hCn] using TileOdometerBandPrototile Cn.1.1 A a hA + obtain ⟨⟨cert⟩, hsym⟩ := layout qn cfg Cn hCn A hproto + obtain ⟨o, base, Rm, Rp, tiles, reverseTiles, fs, ks, hm, hp, path, + U, V, f, k, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, + ha, hb, hadj, hz, hz', hcover, _⟩ := + OpposingBoundaryStarLocalization qn cfg Cn Din j hCn hDin + A B a b cert hsym hA hB hlargeN s t hsa htb hc hs z hza hzb hzs + exact ⟨U, V, f, k, ha, hb, hadj, hz, hz', hcover⟩ + +end LeftCompatibilityGeometry + +theorem LeftAdjacentOdometerCompatibility + (C : BandCircle) (T T' : ProtoTile) (h h' : PartialOdometer) + (hadj : LeftLatticeAdjacent C T T' h h') : + OdometerCompatibility h h' ∧ + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (i : Fin 3), ∀ (e : Bool), ∀ + (Cᵢ : BandCircle), q 0 = C.1.1 → q i.succ = Cᵢ.1.1 → 1 < Cᵢ.1.1.1 → + TileCentroid T' - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) → + ∀ x, x ∈ h.domain → x ∈ h'.domain → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h.domain ∨ y ∈ h'.domain) → + ∃ (U U' : ProtoTile) (g g' : PartialOdometer), + AncestorOdometer Cᵢ.1.1 C.1.1 U T g h ∧ + AncestorOdometer Cᵢ.1.1 C.1.1 U' T' g' h' ∧ + LeftLatticeAdjacent Cᵢ U U' g g' ∧ + x ∈ g.domain ∧ x ∈ g'.domain ∧ + ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ g.domain ∨ y ∈ g'.domain) := by +-- BODY + classical + have adjacency_symm := LeftCompatibilityGeometry.adjacency_symm + have adjacency_action := LeftCompatibilityGeometry.adjacency_action + have membership_action (g : BandPackingSymmetry) (a : PartialOdometer) + (x : GaussianInt) : + BandPackingSymmetryVectorAction g x ∈ + (BandPackingSymmetryPartialOdometerAction g a).domain ↔ x ∈ a.domain := + LeftCompatibilityGeometry.membership_action g a x + have star_action (g : BandPackingSymmetry) (a b : PartialOdometer) + (x : GaussianInt) + (hs : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ a.domain ∨ y ∈ b.domain) : + ∀ y, y = BandPackingSymmetryVectorAction g x ∨ + y = BandPackingSymmetryVectorAction g x + 1 ∨ + y = BandPackingSymmetryVectorAction g x - 1 ∨ + y = BandPackingSymmetryVectorAction g x + ⟨0, 1⟩ ∨ + y = BandPackingSymmetryVectorAction g x - ⟨0, 1⟩ → + y ∈ (BandPackingSymmetryPartialOdometerAction g a).domain ∨ + y ∈ (BandPackingSymmetryPartialOdometerAction g b).domain := + LeftCompatibilityGeometry.star_action membership_action g a b x hs + have layout := LeftCompatibilityGeometry.layout + refine ⟨(LeftCompatibilityGeometry.compatibility (LeftCompatibilityGeometry.compatibility_symm) + layout (LeftCompatibilityGeometry.make_adj)) C.1.1.1.toNat C T T' h h' rfl hadj, ?_⟩ + intro q hq i e Ci hC hCi hlarge hcent x hx hx' hstar + -- The moreover presentation is independent of the presentation inside hadj. + obtain ⟨p, r, hp, hr, h0, h1⟩ := P4261T2AdjacentMatrixSlope C T T' h h' hadj + have hin := CircleMatrixIncomingVector C q hq.1 hC i + have hin0 := congrFun hin 0 + have hin1 := congrFun hin 1 + simp only [Matrix.mulVec, dotProduct, Fin.sum_univ_two, + Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val_fin_one] at hin0 hin1 + have hc0 := congrArg Prod.fst hcent + have hc1 := congrArg Prod.snd hcent + change (TileCentroid T').1 - (TileCentroid T).1 = + (if e = true then (1 : Real) else -1) * + ((BandVectors.1 (q i.succ) (q 0)).re : Real) at hc0 + change (TileCentroid T').2 - (TileCentroid T).2 = + (if e = true then (1 : Real) else -1) * + ((BandVectors.1 (q i.succ) (q 0)).im : Real) at hc1 + have hslope := LeftCompatibilityGeometry.hslope C T T' q i e p r h0 h1 hin0 hin1 hc0 hc1 + obtain ⟨g, qn, Cn, Din, j, en, pn, rn, hqn, hCn, hDin, hCact, hDiact, + hCcurv, hDicurv, hTn, hTn', hpn, hrn, hcn, hsn, hreg⟩ := + P4261T2PairNormalization q hq C Ci i e hC hCi T T' h h' hadj.1 hadj.2.1 + p r hp hr hcent hslope + have hlargeN : 1 < Din.1.1.1 := by omega + have positive_star := LeftCompatibilityGeometry.positive_star layout qn Cn Din j hqn hCn hDin + hreg hlargeN + have hxn := (membership_action g h x).mpr hx + have hxn' := (membership_action g h' x).mpr hx' + have hstarn := star_action g h h' x hstar + obtain ⟨U, V, f, k, ha, hb, hinner, hxf, hxk, hcover⟩ : + ∃ (U V : ProtoTile) (f k : PartialOdometer), + AncestorOdometer Din.1.1 Cn.1.1 U (BandPackingSymmetryTileAction g T) + f (BandPackingSymmetryPartialOdometerAction g h) ∧ + AncestorOdometer Din.1.1 Cn.1.1 V (BandPackingSymmetryTileAction g T') + k (BandPackingSymmetryPartialOdometerAction g h') ∧ + LeftLatticeAdjacent Din U V f k ∧ + BandPackingSymmetryVectorAction g x ∈ f.domain ∧ + BandPackingSymmetryVectorAction g x ∈ k.domain ∧ + ∀ y, y = BandPackingSymmetryVectorAction g x ∨ + y = BandPackingSymmetryVectorAction g x + 1 ∨ + y = BandPackingSymmetryVectorAction g x - 1 ∨ + y = BandPackingSymmetryVectorAction g x + ⟨0, 1⟩ ∨ + y = BandPackingSymmetryVectorAction g x - ⟨0, 1⟩ → + y ∈ f.domain ∨ y ∈ k.domain := by + cases en with + | true => + exact positive_star _ _ _ _ pn rn hTn hTn' hpn hrn + (by simpa using hcn) (by simpa using hsn) _ hxn hxn' hstarn + | false => + obtain ⟨V, U, k, f, hb, ha, hadj', hxk, hxf, hcov⟩ := + positive_star _ _ _ _ rn pn hTn' hTn hrn hpn + (by simpa using congrArg Neg.neg hcn) + (by simpa using congrArg Neg.neg hsn) _ hxn' hxn + (by intro y hy; exact (hstarn y hy).symm) + exact ⟨U, V, f, k, ha, hb, adjacency_symm Din V U k f hlargeN hadj', + hxf, hxk, by intro y hy; exact (hcov y hy).symm⟩ + obtain ⟨inverse, hcircle, _, _, _, htile, _, hvector, _, hfunction, _, _⟩ := + BandPackingSymmetryInversePhaseCancellation.2 g + have hCcancel : BandPackingSymmetryCircleAction inverse Cn.1.1 = C.1.1 := by + rw [hCact, hcircle] + have hDicancel : BandPackingSymmetryCircleAction inverse Din.1.1 = Ci.1.1 := by + rw [hDiact, hcircle] + refine ⟨BandPackingSymmetryTileAction inverse U, BandPackingSymmetryTileAction inverse V, + BandPackingSymmetryPartialOdometerAction inverse f, + BandPackingSymmetryPartialOdometerAction inverse k, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · have ht := P4261T2AncestorSymmetry inverse Din.1.1 Cn.1.1 U + (BandPackingSymmetryTileAction g T) f (BandPackingSymmetryPartialOdometerAction g h) ha + simpa only [hCcancel, hDicancel, htile, hfunction] using ht + · have ht := P4261T2AncestorSymmetry inverse Din.1.1 Cn.1.1 V + (BandPackingSymmetryTileAction g T') k (BandPackingSymmetryPartialOdometerAction g h') hb + simpa only [hCcancel, hDicancel, htile, hfunction] using ht + · exact adjacency_action inverse Din Ci hDicancel.symm hlargeN U V f k hinner + · simpa only [hvector] using (membership_action inverse f _).mpr hxf + · simpa only [hvector] using (membership_action inverse k _).mpr hxk + · simpa only [hvector] using star_action inverse f k _ hcover + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacent.lean b/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacent.lean new file mode 100644 index 0000000000..8d525641ec --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacent.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep + +-- [TABLET NODE: LeftLatticeAdjacent] + +/-! +# LeftLatticeAdjacent + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Two nondegenerate tile odometers $h,h'$ for the same positive-curvature +circle $C_0$ are left-lattice adjacent when both slopes are defined and, +for some parent $C_i$ in a proper quadruple with child $C_0$, one has with +matching signs +$$ + \operatorname{cent}(T(h'))-\operatorname{cent}(T(h))=\pm v_{i0}, + \qquad + \operatorname{slope}(h')-\operatorname{slope}(h)=\pm a_{i0}. +$$ +For a unit circle $C=(1,1+2z)$ there is the additional base convention: +there is an orientation $\epsilon$ for which the centroid step satisfies +$\operatorname{UnitStep}_{\epsilon}(v)$ in +`UnitTriangularStep`, and the slope step is $A_Cv$, where $A_C$ +is `CircleMatrix`. Thus left adjacency admits the union of the +two oriented six-step sets existentially, while each individual tile +string remains in one selected six-step graph. This convention is part +of left adjacency only. +-/ +def LeftLatticeAdjacent (C : BandCircle) (T T' : ProtoTile) + (h h' : PartialOdometer) : Prop := +-- BODY + TileOdometer C.1.1 T h ∧ TileOdometer C.1.1 T' h' ∧ + ∃ p p' : ℝ × ℝ, + PartialOdometerSlope h = some p ∧ + PartialOdometerSlope h' = some p' ∧ + ((C.1.1.1 = 1 ∧ + ∃ orientation : Bool, ∃ v : GaussianInt, + UnitTriangularStep orientation v ∧ + TileCentroid T' - TileCentroid T = GaussianRealPoint v ∧ + p'.1 - p.1 = + CircleMatrix C 0 0 * v.re + CircleMatrix C 0 1 * v.im ∧ + p'.2 - p.2 = + CircleMatrix C 1 0 * v.re + CircleMatrix C 1 1 * v.im) ∨ + ∃ q : Fin 4 → CircleCoordinates, ∃ i : Fin 3, ∃ e : Bool, + ProperBandQuadruple q ∧ q 0 = C.1.1 ∧ + TileCentroid T' - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) ∧ + p'.1 - p.1 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q i.succ) (q 0)).re ∧ + p'.2 - p.2 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q i.succ) (q 0)).im) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean new file mode 100644 index 0000000000..8cbd22904d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean @@ -0,0 +1,638 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain + +-- [TABLET NODE: LeftLatticeAdjacentPackingSymmetryTransport] + +/-! +# LeftLatticeAdjacentPackingSymmetryTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace LeftLatticeTransportGeometry + +private theorem hTne : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (T : ProtoTile), ∀ (h : + PartialOdometer), ∀ (p : ℝ × ℝ), (TileOdometer (q (0 : Fin (4 : ℕ))) T h) → + ((PartialOdometerSlope h = some p) → (T.cells.Nonempty))) ) := by + classical + intro q hq T h p hO hp + have hd := PositiveCurvatureTileOdometerDomain (q 0) T h + (ProperBandCurvatureStructure q hq).1 hO + by_contra hn + have hde : (h.domain : Set GaussianInt) = {T.anchor} := by + rw [hd] + simp [FootprintVertices, hn] + have hs : (PartialOdometerSquares h).Nonempty := by + by_contra hs + simp [PartialOdometerSlope, hs] at hp + rcases hs with ⟨x, hx⟩ + simp only [PartialOdometerSquares, Finset.mem_filter] at hx + have hz : x + 1 = T.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.2.1 + have hz0 : x = T.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.1 + have hzbad : x + 1 = x := hz.trans hz0.symm + have hzbad' := congrArg (fun z : GaussianInt => z.re) hzbad + norm_num at hzbad' + +private theorem hT'ne : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (T' : ProtoTile), ∀ (h' : + PartialOdometer), ∀ (p' : ℝ × ℝ), (TileOdometer (q (0 : Fin (4 : ℕ))) T' h') → + ((PartialOdometerSlope h' = some p') → (T'.cells.Nonempty))) ) := by + classical + intro q hq T' h' p' hO' hp' + have hd := PositiveCurvatureTileOdometerDomain (q 0) T' h' + (ProperBandCurvatureStructure q hq).1 hO' + by_contra hn + have hde : (h'.domain : Set GaussianInt) = {T'.anchor} := by + rw [hd] + simp [FootprintVertices, hn] + have hs : (PartialOdometerSquares h').Nonempty := by + by_contra hs + simp [PartialOdometerSlope, hs] at hp' + rcases hs with ⟨x, hx⟩ + simp only [PartialOdometerSquares, Finset.mem_filter] at hx + have hz : x + 1 = T'.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.2.1 + have hz0 : x = T'.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.1 + have hzbad : x + 1 = x := hz.trans hz0.symm + have hzbad' := congrArg (fun z : GaussianInt => z.re) hzbad + norm_num at hzbad' + +private theorem hsr : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (p : ℝ × ℝ), + (PartialOdometerSlope h = some p) → ((T.cells.Nonempty) → ((Finset.Nonempty T.cells → + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = Option.map + (BandPackingSymmetrySlopeAction g T) (PartialOdometerSlope h)) → + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = some + (BandPackingSymmetrySlopeAction g T p)))) ) := by + classical + intro g T h p hp hTne hST + simpa [Option.map] using (hST hTne).trans (congrArg (Option.map + (BandPackingSymmetrySlopeAction g T)) hp) + +private theorem hsr' : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), ∀ (p' : ℝ × + ℝ), (PartialOdometerSlope h' = some p') → ((T'.cells.Nonempty) → ((Finset.Nonempty + T'.cells → PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h') = + Option.map (BandPackingSymmetrySlopeAction g T') (PartialOdometerSlope h')) → + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h') = some + (BandPackingSymmetrySlopeAction g T' p')))) ) := by + classical + intro g T' h' p' hp' hT'ne hST' + simpa [Option.map] using (hST' hT'ne).trans (congrArg (Option.map + (BandPackingSymmetrySlopeAction g T')) hp') + +private theorem centroid_transport : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (v : GaussianInt), + TileCentroid V - TileCentroid U = GaussianRealPoint v → TileCentroid + (BandPackingSymmetryTileAction a V) - TileCentroid (BandPackingSymmetryTileAction a + U) = GaussianRealPoint (BandPackingSymmetryVectorAction a v) ) := by + classical + intro a U V v hv + have hc := (P5625T1CentroidSlopeDifferenceCovariance.2 + a U V (0, 0) (0, 0) v 0 1 + (by simpa using hv) (by ext <;> simp [GaussianRealPoint])).1 + simpa only [one_smul, P5625T1CentroidSlopeDifferenceCovariance.1] using hc + +private theorem vector_sign : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), + (BandPackingSymmetryScopedPhase g q negative) → (∀ (j : Fin 3), GaussianRealPoint + (BandPackingSymmetryVectorAction g (BandVectors.1 (q j.succ) (q 0))) = (if negative + then (-1 : ℝ) else 1) • GaussianRealPoint (BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + then -j else j).succ) (BandPackingSymmetryQuadrupleAction g q 0))) ) := by + classical + intro g q negative hphase j + have hp := hphase j + dsimp [BandPackingSymmetryScopedPhase] at hp + have hv := hp.1 + by_cases hn : negative + · have hh := congrArg Neg.neg (congrArg GaussianRealPoint hv) + simpa [hn, GaussianRealPoint] using hh.symm + · have hh := (congrArg GaussianRealPoint hv).symm + simpa [hn, GaussianRealPoint] using hh + +private theorem vector_neg : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (v : GaussianInt), BandPackingSymmetryVectorAction a (-v) + = -BandPackingSymmetryVectorAction a v ) := by + classical + intro a + induction a with + | identity => intro v; rfl + | negate => + intro v + rcases v with ⟨a, b⟩ + rfl + | conjugate => + intro v + rcases v with ⟨a, b⟩ + rfl + | shift w => intro v; rfl + | comp a b iha ihb => + intro v + change BandPackingSymmetryVectorAction a + (BandPackingSymmetryVectorAction b (-v)) = + -BandPackingSymmetryVectorAction a + (BandPackingSymmetryVectorAction b v) + rw [ihb, iha] + +private theorem affine_neg : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (v : GaussianInt), ∀ (u : GaussianInt), + BandPackingSymmetryAffineVectorAction a (-v, -u) = + -BandPackingSymmetryAffineVectorAction a (v, u) ) := by + classical + intro a + induction a with + | identity => intro v u; rfl + | shift w => + intro v u + rcases v with ⟨va, vb⟩ + rcases u with ⟨ua, ub⟩ + rcases w with ⟨wa, wb⟩ + apply Prod.ext + · simp [BandPackingSymmetryAffineVectorAction, GaussianReflection] + · simp? [BandPackingSymmetryAffineVectorAction, GaussianReflection] + have hrel : ({re := -va, im := vb} : GaussianInt) = + -({re := va, im := -vb} : GaussianInt) := by + ext <;> simp + rw [hrel] + ring + | negate => + intro v u + rcases v with ⟨va, vb⟩ + rcases u with ⟨ua, ub⟩ + rfl + | conjugate => + intro v u + rcases v with ⟨va, vb⟩ + rcases u with ⟨ua, ub⟩ + rfl + | comp a b iha ihb => + intro v u + change BandPackingSymmetryAffineVectorAction a + (BandPackingSymmetryAffineVectorAction b (-v, -u)) = _ + rw [ihb] + apply iha + +private theorem slope_transport : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : ℝ × ℝ), ∀ (y : + ℝ × ℝ), ∀ (v : GaussianInt), ∀ (u : GaussianInt), TileCentroid V - TileCentroid U = + GaussianRealPoint v → x.1 - y.1 = (u.re : ℝ) → x.2 - y.2 = (u.im : ℝ) → + (BandPackingSymmetrySlopeAction a V x).1 - (BandPackingSymmetrySlopeAction a U y).1 = + (BandPackingSymmetryAffineVectorAction a (v, u)).2.re ∧ + (BandPackingSymmetrySlopeAction a V x).2 - (BandPackingSymmetrySlopeAction a U y).2 = + (BandPackingSymmetryAffineVectorAction a (v, u)).2.im ) := by + classical + intro a U V x y v u hc hx hy + have hp : x - y = (1 : ℝ) • GaussianRealPoint u := by + apply Prod.ext + · simpa [GaussianRealPoint] using hx + · simpa [GaussianRealPoint] using hy + have hs := (P5625T1CentroidSlopeDifferenceCovariance.2 + a U V x y v u 1 (by simpa using hc) hp).2 + constructor + · simpa [GaussianRealPoint] using congrArg Prod.fst hs + · simpa [GaussianRealPoint] using congrArg Prod.snd hs + +private theorem hcAt337 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' + : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 + : ℝ)) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) → ((e = + true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 (q + i.succ) (q 0)))) ) := by + classical + intro q i e T T' hcent he + simpa [he] using hcent + +private theorem hcAt345 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' + : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 + : ℝ)) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) → ((¬e = + true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (-(BandVectors.1 (q + i.succ) (q 0))))) ) := by + classical + intro q i e T T' hcent he + simpa [he, GaussianRealPoint] using hcent + +private theorem hcAt356 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' + : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 + : ℝ)) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) → ((e = + true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 (q + i.succ) (q 0)))) ) := by + classical + intro q i e T T' hcent he + simpa [he] using hcent + +private theorem hcAt377 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' + : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 + : ℝ)) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) → ((¬e = + true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (-(BandVectors.1 (q + i.succ) (q 0))))) ) := by + classical + intro q i e T T' hcent he + simpa [he, GaussianRealPoint] using hcent + +private theorem hscoordAt393 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T : + ProtoTile), ∀ (T' : ProtoTile), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), + ((BandPackingSymmetrySlopeAction g T' p').1 - (BandPackingSymmetrySlopeAction g T + p).1 = (↑(-BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.re : ℝ) ∧ + (BandPackingSymmetrySlopeAction g T' p').2 - (BandPackingSymmetrySlopeAction g T p).2 + = (↑(-BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin + (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.im : ℝ)) → + ((BandPackingSymmetrySlopeAction g T' p').1 - (BandPackingSymmetrySlopeAction g T + p).1 = -((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q 0), + BandVectors.2 (q i.succ) (q 0))).2.re : ℝ)) ) := by + classical + intro g q i T T' p p' hs + simpa using hs.1 + +private theorem hscoordAt405 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T : + ProtoTile), ∀ (T' : ProtoTile), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), + ((BandPackingSymmetrySlopeAction g T' p').1 - (BandPackingSymmetrySlopeAction g T + p).1 = (↑(-BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.re : ℝ) ∧ + (BandPackingSymmetrySlopeAction g T' p').2 - (BandPackingSymmetrySlopeAction g T p).2 + = (↑(-BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin + (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.im : ℝ)) → + ((BandPackingSymmetrySlopeAction g T' p').1 - (BandPackingSymmetrySlopeAction g T + p).1 = -((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q 0), + BandVectors.2 (q i.succ) (q 0))).2.re : ℝ)) ) := by + classical + intro g q i T T' p p' hs + simpa using hs.1 + +private theorem hcAt414 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' + : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 + : ℝ)) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) → ((e = + true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 (q + i.succ) (q 0)))) ) := by + classical + intro q i e T T' hcent he + simpa [he] using hcent + +private theorem hcAt435 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' + : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 + : ℝ)) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) → ((¬e = + true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (-(BandVectors.1 (q + i.succ) (q 0))))) ) := by + classical + intro q i e T T' hcent he + simpa [he, GaussianRealPoint] using hcent + +private theorem hscoordAt451 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T : + ProtoTile), ∀ (T' : ProtoTile), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), + ((BandPackingSymmetrySlopeAction g T' p').1 - (BandPackingSymmetrySlopeAction g T + p).1 = (↑(-BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.re : ℝ) ∧ + (BandPackingSymmetrySlopeAction g T' p').2 - (BandPackingSymmetrySlopeAction g T p).2 + = (↑(-BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin + (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.im : ℝ)) → + ((BandPackingSymmetrySlopeAction g T' p').2 - (BandPackingSymmetrySlopeAction g T + p).2 = -((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q 0), + BandVectors.2 (q i.succ) (q 0))).2.im : ℝ)) ) := by + classical + intro g q i T T' p p' hs + simpa using hs.2 + +private theorem hscoordAt463 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T : + ProtoTile), ∀ (T' : ProtoTile), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), + ((BandPackingSymmetrySlopeAction g T' p').1 - (BandPackingSymmetrySlopeAction g T + p).1 = (↑(-BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.re : ℝ) ∧ + (BandPackingSymmetrySlopeAction g T' p').2 - (BandPackingSymmetrySlopeAction g T p).2 + = (↑(-BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin + (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.im : ℝ)) → + ((BandPackingSymmetrySlopeAction g T' p').2 - (BandPackingSymmetrySlopeAction g T + p).2 = -((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q 0), + BandVectors.2 (q i.succ) (q 0))).2.im : ℝ)) ) := by + classical + intro g q i T T' p p' hs + simpa using hs.2 + +end LeftLatticeTransportGeometry + +theorem LeftLatticeAdjacentPackingSymmetryTransport + (g : BandPackingSymmetry) (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) (i : Fin 3) (e : Bool) + (T T' : ProtoTile) (h h' : PartialOdometer) (p p' : ℝ × ℝ) + (hO : TileOdometer (q 0) T h) (hO' : TileOdometer (q 0) T' h') + (hp : PartialOdometerSlope h = some p) + (hp' : PartialOdometerSlope h' = some p') + (hcent : TileCentroid T' - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) + (hslopeRe : p'.1 - p.1 = + (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q i.succ) (q 0)).re) + (hslopeIm : p'.2 - p.2 = + (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q i.succ) (q 0)).im) : + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + ∃ negative : Bool, ∃ r r' : ℝ × ℝ, + BandPackingSymmetryScopedPhase g q negative ∧ + TileOdometer (q' 0) (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryPartialOdometerAction g h) ∧ + TileOdometer (q' 0) (BandPackingSymmetryTileAction g T') + (BandPackingSymmetryPartialOdometerAction g h') ∧ + PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction g h) = some r ∧ + PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction g h') = some r' ∧ + TileCentroid (BandPackingSymmetryTileAction g T') - + TileCentroid (BandPackingSymmetryTileAction g T) = + (if xor e negative = true then (1 : ℝ) else -1) • + GaussianRealPoint + (BandVectors.1 (q' (sigma i).succ) (q' 0)) ∧ + r'.1 - r.1 = + (if xor e negative = true then (1 : ℝ) else -1) * + (BandVectors.2 (q' (sigma i).succ) (q' 0)).re ∧ + r'.2 - r.2 = + (if xor e negative = true then (1 : ℝ) else -1) * + (BandVectors.2 (q' (sigma i).succ) (q' 0)).im ∧ + (OdometerCompatibility + (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g h') ↔ + OdometerCompatibility h h') := by +-- BODY + classical + dsimp + obtain ⟨negative, hphase, hvec⟩ := + BandPackingSymmetryAffineVectorCovariance g q hq + have hTne := LeftLatticeTransportGeometry.hTne q hq T h p hO hp + have hT'ne := LeftLatticeTransportGeometry.hT'ne q hq T' h' p' hO' hp' + obtain ⟨hOT, _, hST⟩ := BandPackingSymmetryTileOdometerCovariance g (q 0) T h hO + obtain ⟨hOT', _, hST'⟩ := BandPackingSymmetryTileOdometerCovariance g (q 0) T' h' hO' + have hsr := LeftLatticeTransportGeometry.hsr g T h p hp hTne hST + have hsr' := LeftLatticeTransportGeometry.hsr' g T' h' p' hp' hT'ne hST' + have centroid_transport : ∀ (a : BandPackingSymmetry) (U V : ProtoTile) + (v : GaussianInt), + TileCentroid V - TileCentroid U = GaussianRealPoint v → + TileCentroid (BandPackingSymmetryTileAction a V) - + TileCentroid (BandPackingSymmetryTileAction a U) = + GaussianRealPoint (BandPackingSymmetryVectorAction a v) := + LeftLatticeTransportGeometry.centroid_transport + have vector_sign (j : Fin 3) : + GaussianRealPoint (BandPackingSymmetryVectorAction g + (BandVectors.1 (q j.succ) (q 0))) = + (if negative then (-1 : ℝ) else 1) • + GaussianRealPoint + (BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q + (if BandPackingSymmetryReversesOrientation g then -j else j).succ) + (BandPackingSymmetryQuadrupleAction g q 0)) := + LeftLatticeTransportGeometry.vector_sign g q negative hphase j + have vector_neg : ∀ (a : BandPackingSymmetry) (v : GaussianInt), + BandPackingSymmetryVectorAction a (-v) = + -BandPackingSymmetryVectorAction a v := LeftLatticeTransportGeometry.vector_neg + have affine_neg : ∀ (a : BandPackingSymmetry) (v u : GaussianInt), + BandPackingSymmetryAffineVectorAction a (-v, -u) = + -BandPackingSymmetryAffineVectorAction a (v, u) := LeftLatticeTransportGeometry.affine_neg + have real_coord (z : GaussianInt) : + (GaussianInt.toComplex z).re = (z.re : ℝ) := + (GaussianInt.intCast_re z).symm + have imag_coord (z : GaussianInt) : + (GaussianInt.toComplex z).im = (z.im : ℝ) := + (GaussianInt.intCast_im z).symm + have slope_transport := LeftLatticeTransportGeometry.slope_transport + refine ⟨negative, BandPackingSymmetrySlopeAction g T p, + BandPackingSymmetrySlopeAction g T' p', ?_⟩ + refine ⟨hphase, ?_, ?_, hsr, hsr', ?_, ?_, ?_, ?_⟩ + · simpa [BandPackingSymmetryQuadrupleAction] using hOT + · simpa [BandPackingSymmetryQuadrupleAction] using hOT' + · by_cases he : e = true + · have hc : TileCentroid T' - TileCentroid T = + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) := + LeftLatticeTransportGeometry.hcAt337 q i e T T' hcent he + rw [centroid_transport g T T' + (BandVectors.1 (q i.succ) (q 0)) hc] + by_cases hn : negative + · simpa [he, hn, GaussianRealPoint] using vector_sign i + · simpa [he, hn, GaussianRealPoint] using vector_sign i + · have hc : TileCentroid T' - TileCentroid T = + GaussianRealPoint (-(BandVectors.1 (q i.succ) (q 0))) := + LeftLatticeTransportGeometry.hcAt345 q i e T T' hcent he + rw [centroid_transport g T T' + (-(BandVectors.1 (q i.succ) (q 0))) hc] + have hs := vector_sign i + rw [vector_neg] + by_cases hn : negative + · simpa [he, hn, GaussianRealPoint] using congrArg Neg.neg hs + · simpa [he, hn, GaussianRealPoint] using congrArg Neg.neg hs + · by_cases he : e = true + · have hc : TileCentroid T' - TileCentroid T = + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) := + LeftLatticeTransportGeometry.hcAt356 q i e T T' hcent he + have hs := slope_transport g T T' p' p + (BandVectors.1 (q i.succ) (q 0)) + (BandVectors.2 (q i.succ) (q 0)) hc + (by simpa [he] using hslopeRe) + (by simpa [he] using hslopeIm) + have hv := (hvec i).1 + have hvr := congrArg (fun z : GaussianInt => (z.re : ℝ)) hv + by_cases hn : negative + · simp? [he, hn] at hvr ⊢ + rw [← GaussianInt.intCast_re] at ⊢ + have hcoord := hvr + try simp only [real_coord] at hcoord + linarith [hs.1, hcoord] + · simp? [he, hn] at hvr ⊢ + rw [← GaussianInt.intCast_re] at ⊢ + have hcoord := hvr + try simp only [real_coord] at hcoord + linarith [hs.1, hcoord] + · have hc : TileCentroid T' - TileCentroid T = + GaussianRealPoint (-(BandVectors.1 (q i.succ) (q 0))) := + LeftLatticeTransportGeometry.hcAt377 q i e T T' hcent he + have hs := slope_transport g T T' p' p + (-(BandVectors.1 (q i.succ) (q 0))) + (-(BandVectors.2 (q i.succ) (q 0))) hc + (by simpa [he, GaussianRealPoint] using hslopeRe) + (by simpa [he, GaussianRealPoint] using hslopeIm) + rw [affine_neg] at hs + have hv := (hvec i).1 + have hvr := congrArg (fun z : GaussianInt => (z.re : ℝ)) hv + by_cases hn : negative + · simp? [he, hn] at hvr ⊢ + try rw [← GaussianInt.intCast_re] at ⊢ + have hcoord := hvr + try simp only [real_coord] at hcoord + have hscoord : + (BandPackingSymmetrySlopeAction g T' p').1 - + (BandPackingSymmetrySlopeAction g T p).1 = + -((BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q i.succ) (q 0), + BandVectors.2 (q i.succ) (q 0))).2.re : ℝ) := + LeftLatticeTransportGeometry.hscoordAt393 g q i T T' p p' hs + linarith [hscoord, hcoord] + · simp? [he, hn] at hvr ⊢ + try rw [← GaussianInt.intCast_re] at ⊢ + have hcoord := hvr + try simp only [real_coord] at hcoord + have hscoord : + (BandPackingSymmetrySlopeAction g T' p').1 - + (BandPackingSymmetrySlopeAction g T p).1 = + -((BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q i.succ) (q 0), + BandVectors.2 (q i.succ) (q 0))).2.re : ℝ) := + LeftLatticeTransportGeometry.hscoordAt405 g q i T T' p p' hs + linarith [hscoord, hcoord] + · by_cases he : e = true + · have hc : TileCentroid T' - TileCentroid T = + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) := + LeftLatticeTransportGeometry.hcAt414 q i e T T' hcent he + have hs := slope_transport g T T' p' p + (BandVectors.1 (q i.succ) (q 0)) + (BandVectors.2 (q i.succ) (q 0)) hc + (by simpa [he] using hslopeRe) + (by simpa [he] using hslopeIm) + have hv := (hvec i).1 + have hvi := congrArg (fun z : GaussianInt => (z.im : ℝ)) hv + by_cases hn : negative + · simp? [he, hn] at hvi ⊢ + rw [← GaussianInt.intCast_im] at ⊢ + have hcoord := hvi + try simp only [imag_coord] at hcoord + linarith [hs.2, hcoord] + · simp? [he, hn] at hvi ⊢ + rw [← GaussianInt.intCast_im] at ⊢ + have hcoord := hvi + try simp only [imag_coord] at hcoord + linarith [hs.2, hcoord] + · have hc : TileCentroid T' - TileCentroid T = + GaussianRealPoint (-(BandVectors.1 (q i.succ) (q 0))) := + LeftLatticeTransportGeometry.hcAt435 q i e T T' hcent he + have hs := slope_transport g T T' p' p + (-(BandVectors.1 (q i.succ) (q 0))) + (-(BandVectors.2 (q i.succ) (q 0))) hc + (by simpa [he, GaussianRealPoint] using hslopeRe) + (by simpa [he, GaussianRealPoint] using hslopeIm) + rw [affine_neg] at hs + have hv := (hvec i).1 + have hvi := congrArg (fun z : GaussianInt => (z.im : ℝ)) hv + by_cases hn : negative + · simp? [he, hn] at hvi ⊢ + try rw [← GaussianInt.intCast_im] at ⊢ + have hcoord := hvi + try simp only [imag_coord] at hcoord + have hscoord : + (BandPackingSymmetrySlopeAction g T' p').2 - + (BandPackingSymmetrySlopeAction g T p).2 = + -((BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q i.succ) (q 0), + BandVectors.2 (q i.succ) (q 0))).2.im : ℝ) := + LeftLatticeTransportGeometry.hscoordAt451 g q i T T' p p' hs + linarith [hscoord, hcoord] + · simp? [he, hn] at hvi ⊢ + try rw [← GaussianInt.intCast_im] at ⊢ + have hcoord := hvi + try simp only [imag_coord] at hcoord + have hscoord : + (BandPackingSymmetrySlopeAction g T' p').2 - + (BandPackingSymmetrySlopeAction g T p).2 = + -((BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q i.succ) (q 0), + BandVectors.2 (q i.succ) (q 0))).2.im : ℝ) := + LeftLatticeTransportGeometry.hscoordAt463 g q i T T' p p' hs + linarith [hscoord, hcoord] + · exact (BandPackingSymmetryPartialOdometerActionFormulas g h h').2.2.2.2.2.2.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LocalExponentialEstimate.lean b/LeanPool/ApollonianSuperharmonic/LocalExponentialEstimate.lean new file mode 100644 index 0000000000..e575f99359 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LocalExponentialEstimate.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.RealFourNeighborLaplacian + +-- [TABLET NODE: LocalExponentialEstimate] + +/-! +# LocalExponentialEstimate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem LocalExponentialEstimate + (w : GaussianInt -> Real) (M : Real) + (hw : forall x, 0 <= w x) + (hlap : forall x, RealFourNeighborLaplacian w x <= M) : + forall x : GaussianInt, + w x <= (4 : Real) ^ (x.re.natAbs + x.im.natAbs) * w 0 + + M * (((4 : Real) ^ (x.re.natAbs + x.im.natAbs) - 1) / 3) := by +-- BODY + intro x + have hright (z : GaussianInt) : w (z + 1) <= 4 * w z + M := by + have h := hlap z + simp [RealFourNeighborLaplacian] at h + linarith [hw (z - 1), hw (z + ⟨0, 1⟩), hw (z - ⟨0, 1⟩)] + have hleft (z : GaussianInt) : w (z - 1) <= 4 * w z + M := by + have h := hlap z + simp [RealFourNeighborLaplacian] at h + linarith [hw (z + 1), hw (z + ⟨0, 1⟩), hw (z - ⟨0, 1⟩)] + have hup (z : GaussianInt) : w (z + ⟨0, 1⟩) <= 4 * w z + M := by + have h := hlap z + simp [RealFourNeighborLaplacian] at h + linarith [hw (z + 1), hw (z - 1), hw (z - ⟨0, 1⟩)] + have hdown (z : GaussianInt) : w (z - ⟨0, 1⟩) <= 4 * w z + M := by + have h := hlap z + simp [RealFourNeighborLaplacian] at h + linarith [hw (z + 1), hw (z - 1), hw (z + ⟨0, 1⟩)] + have growth (k : ℕ) : + 4 * ((4 : Real) ^ k * w 0 + M * (((4 : Real) ^ k - 1) / 3)) + M = + (4 : Real) ^ (k + 1) * w 0 + M * (((4 : Real) ^ (k + 1) - 1) / 3) := by + rw [pow_succ] + ring + have decrementPositive (a : ℤ) (ha : 0 < a.natAbs) (haeq : a = (a.natAbs : ℤ)) : + (a - 1).natAbs = a.natAbs - 1 := by + have hnon : 0 ≤ a - 1 := by omega + have hc := Int.natAbs_of_nonneg hnon + have hc' := Int.natAbs_of_nonneg (a := (a.natAbs : ℤ) - 1) (by omega) + omega + have incrementNegative (a : ℤ) (ha : 0 < a.natAbs) (haeq : a = -(a.natAbs : ℤ)) : + (a + 1).natAbs = a.natAbs - 1 := by + have hc' := Int.natAbs_of_nonneg (a := (a.natAbs : ℤ) - 1) (by omega) + have hrel : (- (a.natAbs : ℤ) + 1).natAbs = a.natAbs - 1 := by + rw [show - (a.natAbs : ℤ) + 1 = -((a.natAbs : ℤ) - 1) by ring, + Int.natAbs_neg] + omega + rw [haeq, Int.natAbs_neg] + exact hrel + have main : ∀ n : ℕ, ∀ z : GaussianInt, + z.re.natAbs + z.im.natAbs = n → + w z <= (4 : Real) ^ n * w 0 + M * (((4 : Real) ^ n - 1) / 3) := by + intro n + induction n using Nat.strong_induction_on with + | h n ih => + intro z hz + by_cases hn : n = 0 + · have hz0 : z.re = 0 := by omega + have hz1 : z.im = 0 := by omega + have ze : z = 0 := by ext <;> simp [hz0, hz1] + subst z + subst n + simp + · have hnpos : 0 < n := Nat.pos_of_ne_zero hn + by_cases hr : z.re = 0 + · have hi : 0 < z.im.natAbs := by omega + rcases Int.natAbs_eq z.im with hi' | hi' + · have hprev : (z - ⟨0, 1⟩).re.natAbs + (z - ⟨0, 1⟩).im.natAbs = n - 1 := by + have hre : (z - ⟨0, 1⟩).re = z.re := by simp + have him : (z - ⟨0, 1⟩).im = z.im - 1 := by simp + rw [hre, him] + have hdec := decrementPositive z.im hi hi' + rw [hdec] + rw [hr, hi'] + omega + have hh := ih (n - 1) (by omega) (z - ⟨0, 1⟩) hprev + have hstep := hup (z - ⟨0, 1⟩) + have zeq : (z - ⟨0, 1⟩) + ⟨0, 1⟩ = z := by abel + rw [zeq] at hstep + have hg := growth (n - 1) + rw [Nat.sub_add_cancel (Nat.one_le_iff_ne_zero.mpr hn)] at hg + nlinarith [hh, hstep, hg] + · have hprev : (z + ⟨0, 1⟩).re.natAbs + (z + ⟨0, 1⟩).im.natAbs = n - 1 := by + have hre : (z + ⟨0, 1⟩).re = z.re := by simp + have him : (z + ⟨0, 1⟩).im = z.im + 1 := by simp + rw [hre, him] + have hinc := incrementNegative z.im hi hi' + rw [hinc] + rw [hr, hi'] + omega + have hh := ih (n - 1) (by omega) (z + ⟨0, 1⟩) hprev + have hstep := hdown (z + ⟨0, 1⟩) + have zeq : (z + ⟨0, 1⟩) - ⟨0, 1⟩ = z := by abel + rw [zeq] at hstep + have hg := growth (n - 1) + rw [Nat.sub_add_cancel (Nat.one_le_iff_ne_zero.mpr hn)] at hg + nlinarith [hh, hstep, hg] + · have hrpos : 0 < z.re.natAbs := by omega + rcases Int.natAbs_eq z.re with hr' | hr' + · have hprev : (z - 1).re.natAbs + (z - 1).im.natAbs = n - 1 := by + have hre : (z - 1).re = z.re - 1 := by simp + have him : (z - 1).im = z.im := by simp + rw [hre, him] + have hdec := decrementPositive z.re hrpos hr' + rw [hdec] + rw [hr'] + omega + have hh := ih (n - 1) (by omega) (z - 1) hprev + have hstep := hright (z - 1) + have zeq : (z - 1) + 1 = z := by abel + rw [zeq] at hstep + have hg := growth (n - 1) + rw [Nat.sub_add_cancel (Nat.one_le_iff_ne_zero.mpr hn)] at hg + nlinarith [hh, hstep, hg] + · have hprev : (z + 1).re.natAbs + (z + 1).im.natAbs = n - 1 := by + have hre : (z + 1).re = z.re + 1 := by simp + have him : (z + 1).im = z.im := by simp + rw [hre, him] + have hinc := incrementNegative z.re hrpos hr' + rw [hinc] + rw [hr'] + omega + have hh := ih (n - 1) (by omega) (z + 1) hprev + have hstep := hleft (z + 1) + have zeq : (z + 1) - 1 = z := by abel + rw [zeq] at hstep + have hg := growth (n - 1) + rw [Nat.sub_add_cancel (Nat.one_le_iff_ne_zero.mpr hn)] at hg + nlinarith [hh, hstep, hg] + apply main (x.re.natAbs + x.im.natAbs) x rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean b/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean new file mode 100644 index 0000000000..254b96ce6b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean @@ -0,0 +1,649 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: LocalLatticeInterfaceSectors] + +/-! +# LocalLatticeInterfaceSectors + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace InterfaceSectorGeometry + +private theorem raw_incident : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), Finset.Nonempty T.cells → x ∈ FootprintVertices T + → ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ T.cells ) := by + classical + intro T x hne hx + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hx + rcases hx with ⟨c, hc, h | h | h | h⟩ + · refine ⟨0, ?_⟩ + simpa [LatticeVertexIncidentCell] using h ▸ hc + · refine ⟨1, ?_⟩ + subst x + convert hc using 1; simp [LatticeVertexIncidentCell] + · refine ⟨3, ?_⟩ + subst x + convert hc using 1; simp [LatticeVertexIncidentCell] + · refine ⟨2, ?_⟩ + change x - 1 - ⟨0, 1⟩ ∈ T.cells + rw [h] + convert hc using 1 + ext <;> simp + +private theorem nonempty_touching : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (V : ProtoTile), Finset.Nonempty U.cells → Finset.Nonempty V.cells → + TileTouching U V → Disjoint U.cells V.cells ∧ SimpleGridPath + (BoundaryFootprintVertices U ∩ BoundaryFootprintVertices V) (BoundaryFootprintEdges U + ∩ BoundaryFootprintEdges V) ) := by + classical + intro U V hUne hVne ht + rcases ht with ht | ht | ht + · exact ⟨ht.2.2.1, ht.2.2.2⟩ + · rw [ht.1] at hUne + simp at hUne + · rw [ht.1] at hVne + simp at hVne + +private theorem incident_boundary : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), Finset.Nonempty T.cells → (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ T.cells) → (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∉ T.cells) → x ∈ BoundaryFootprintVertices T ) := by + classical + intro T x hne hsome hmissing + exact P3161T2IncidentBoundary T x hsome hmissing + +private theorem common_edge_transition : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), ∀ (e : Finset GaussianInt), + Disjoint U.cells V.cells → x ∈ e → e ∈ BoundaryFootprintEdges U ∩ + BoundaryFootprintEdges V → ∃ (j : Fin (4 : ℕ)), e = edgeAt x j ∧ + (LatticeVertexIncidentCell x j ∈ U.cells ∧ LatticeVertexIncidentCell x (j + (1 : Fin + (4 : ℕ))) ∈ V.cells ∨ LatticeVertexIncidentCell x j ∈ V.cells ∧ + LatticeVertexIncidentCell x (j + (1 : Fin (4 : ℕ))) ∈ U.cells) ) := by + classical + intro I edgeAt U V x e hdisjoint hxe he + rw [← CellDisjointCommonEdgesBoundary U V hdisjoint] at he + simpa only [edgeAt, I] using + P3102T2CommonEdgeSectorTransition U V x e hdisjoint hxe he + +private theorem two_transition_sectors : + (by + classical + exact + ∀ (P : Fin (4 : ℕ) → Prop), ∀ (Q : Fin (4 : ℕ) → Prop), (∀ (j : Fin (4 : ℕ)), ¬(P j ∧ Q + j)) → ¬(P (0 : Fin (4 : ℕ)) ∧ P (2 : Fin (4 : ℕ)) ∧ ¬P (1 : Fin (4 : ℕ)) ∧ ¬P (3 : + Fin (4 : ℕ)) ∨ P (1 : Fin (4 : ℕ)) ∧ P (3 : Fin (4 : ℕ)) ∧ ¬P (0 : Fin (4 : ℕ)) ∧ ¬P + (2 : Fin (4 : ℕ))) → ¬(Q (0 : Fin (4 : ℕ)) ∧ Q (2 : Fin (4 : ℕ)) ∧ ¬Q (1 : Fin (4 : + ℕ)) ∧ ¬Q (3 : Fin (4 : ℕ)) ∨ Q (1 : Fin (4 : ℕ)) ∧ Q (3 : Fin (4 : ℕ)) ∧ ¬Q (0 : Fin + (4 : ℕ)) ∧ ¬Q (2 : Fin (4 : ℕ))) → ∀ (a : Fin (4 : ℕ)), ∀ (b : Fin (4 : ℕ)), a ≠ b → + P a ∧ Q (a + (1 : Fin (4 : ℕ))) ∨ Q a ∧ P (a + (1 : Fin (4 : ℕ))) → P b ∧ Q (b + (1 : + Fin (4 : ℕ))) ∨ Q b ∧ P (b + (1 : Fin (4 : ℕ))) → (∀ (j : Fin (4 : ℕ)), P j ∨ Q j) ∧ + ∃ (j : Fin (4 : ℕ)), P j ∧ Q (j + (2 : Fin (4 : ℕ))) ) := by + classical + intro P Q hd hP hQ a b hab ha hb + have cover4 (r j : Fin 4) : + j = r ∨ j = r + 1 ∨ j = r + 2 ∨ j = r + 3 := by + fin_cases r <;> fin_cases j <;> simp + have add_three_two (r : Fin 4) : r + 3 + 2 = r + 1 := by + fin_cases r <;> rfl + have add_one_one (r : Fin 4) : r + 1 + 1 = r + 2 := by + fin_cases r <;> rfl + have add_two_one (r : Fin 4) : r + 2 + 1 = r + 3 := by + fin_cases r <;> rfl + have add_one_two (r : Fin 4) : r + 1 + 2 = r + 3 := by + fin_cases r <;> rfl + have fillP (r : Fin 4) (hr : P r) (hr2 : P (r + 2)) + (hq1 : Q (r + 1)) : P (r + 3) := by + by_contra hmissing + apply hP + fin_cases r + · exact Or.inl ⟨hr, hr2, fun hp => hd 1 ⟨hp, hq1⟩, hmissing⟩ + · exact Or.inr ⟨hr, hr2, hmissing, fun hp => hd 2 ⟨hp, hq1⟩⟩ + · exact Or.inl ⟨hr2, hr, hmissing, fun hp => hd 3 ⟨hp, hq1⟩⟩ + · exact Or.inr ⟨hr2, hr, fun hp => hd 0 ⟨hp, hq1⟩, hmissing⟩ + have fillQ (r : Fin 4) (hr : Q r) (hr2 : Q (r + 2)) + (hp1 : P (r + 1)) : Q (r + 3) := by + by_contra hmissing + apply hQ + fin_cases r + · exact Or.inl ⟨hr, hr2, fun hq => hd 1 ⟨hp1, hq⟩, hmissing⟩ + · exact Or.inr ⟨hr, hr2, hmissing, fun hq => hd 2 ⟨hp1, hq⟩⟩ + · exact Or.inl ⟨hr2, hr, hmissing, fun hq => hd 3 ⟨hp1, hq⟩⟩ + · exact Or.inr ⟨hr2, hr, fun hq => hd 0 ⟨hp1, hq⟩, hmissing⟩ + have adjacent (r : Fin 4) + (hr : (P r ∧ Q (r + 1)) ∨ (Q r ∧ P (r + 1))) + (hs : (P (r + 1) ∧ Q (r + 2)) ∨ + (Q (r + 1) ∧ P (r + 2))) : + (∀ j, P j ∨ Q j) ∧ ∃ j, P j ∧ Q (j + 2) := by + rcases hr with hr | hr <;> rcases hs with hs | hs + · exact (hd (r + 1) ⟨hs.1, hr.2⟩).elim + · have hp3 := fillP r hr.1 hs.2 hr.2 + constructor + · intro j + rcases cover4 r j with rfl | rfl | rfl | rfl + · exact Or.inl hr.1 + · exact Or.inr hr.2 + · exact Or.inl hs.2 + · exact Or.inl hp3 + · refine ⟨r + 3, hp3, ?_⟩ + rw [add_three_two] + exact hr.2 + · have hq3 := fillQ r hr.1 hs.2 hr.2 + constructor + · intro j + rcases cover4 r j with rfl | rfl | rfl | rfl + · exact Or.inr hr.1 + · exact Or.inl hr.2 + · exact Or.inr hs.2 + · exact Or.inr hq3 + · refine ⟨r + 1, hr.2, ?_⟩ + rw [add_one_two] + exact hq3 + · exact (hd (r + 1) ⟨hr.2, hs.1⟩).elim + have opposite (r : Fin 4) + (hr : (P r ∧ Q (r + 1)) ∨ (Q r ∧ P (r + 1))) + (hs : (P (r + 2) ∧ Q (r + 3)) ∨ + (Q (r + 2) ∧ P (r + 3))) : + (∀ j, P j ∨ Q j) ∧ ∃ j, P j ∧ Q (j + 2) := by + rcases hr with hr | hr <;> rcases hs with hs | hs + · exact (hd (r + 3) ⟨fillP r hr.1 hs.1 hr.2, hs.2⟩).elim + · constructor + · intro j + rcases cover4 r j with rfl | rfl | rfl | rfl + · exact Or.inl hr.1 + · exact Or.inr hr.2 + · exact Or.inr hs.1 + · exact Or.inl hs.2 + · exact ⟨r, hr.1, hs.1⟩ + · constructor + · intro j + rcases cover4 r j with rfl | rfl | rfl | rfl + · exact Or.inr hr.1 + · exact Or.inl hr.2 + · exact Or.inl hs.1 + · exact Or.inr hs.2 + · refine ⟨r + 1, hr.2, ?_⟩ + rw [add_one_two] + exact hs.2 + · exact (hd (r + 3) ⟨hs.2, fillQ r hr.1 hs.1 hr.2⟩).elim + have hpos : b = a + 1 ∨ b = a + 2 ∨ a = b + 1 := by + fin_cases a <;> fin_cases b <;> simp at hab ⊢ + rcases hpos with h | h | h + · subst b + apply adjacent a ha + simpa only [add_one_one] using hb + · subst b + apply opposite a ha + simpa only [add_two_one] using hb + · subst a + apply adjacent b hb + simpa only [add_one_one] using ha + +private theorem hxBoundary : + (by + classical + exact + (∀ (T : ProtoTile), ∀ (x : GaussianInt), (T.cells.Nonempty) → ((∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T.cells) → ((∃ j : Fin 4, LatticeVertexIncidentCell x + j ∉ T.cells) → (x ∈ BoundaryFootprintVertices T)))) → (∀ (X : ProtoTile), ∀ (Y : + ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), (X.cells.Nonempty) → + ((Y.cells.Nonempty) → ((Z.cells.Nonempty) → ((Disjoint X.cells Y.cells) → ((Disjoint + Y.cells Z.cells) → ((Disjoint Z.cells X.cells) → (∀ (jX : Fin (4 : ℕ)), + (LatticeVertexIncidentCell x jX ∈ X.cells) → (∀ (jY : Fin (4 : ℕ)), + (LatticeVertexIncidentCell x jY ∈ Y.cells) → (∀ (jZ : Fin (4 : ℕ)), + (LatticeVertexIncidentCell x jZ ∈ Z.cells) → (x ∈ BoundaryFootprintVertices X ∩ + BoundaryFootprintVertices Y ∧ x ∈ BoundaryFootprintVertices Y ∩ + BoundaryFootprintVertices Z ∧ x ∈ BoundaryFootprintVertices Z ∩ + BoundaryFootprintVertices X)))))))))) ) := by + classical + intro incident_boundary X Y Z x hXne hYne hZne hXYdisjoint hYZdisjoint hZXdisjoint jX hjX jY + hjY jZ hjZ + have hXY := Finset.disjoint_left.mp hXYdisjoint + have hYZ := Finset.disjoint_left.mp hYZdisjoint + have hZX := Finset.disjoint_left.mp hZXdisjoint + have hxXB : x ∈ BoundaryFootprintVertices X := + incident_boundary X x hXne ⟨jX, hjX⟩ ⟨jY, fun h => hXY h hjY⟩ + have hxYB : x ∈ BoundaryFootprintVertices Y := + incident_boundary Y x hYne ⟨jY, hjY⟩ ⟨jX, fun h => hXY hjX h⟩ + have hxZB : x ∈ BoundaryFootprintVertices Z := + incident_boundary Z x hZne ⟨jZ, hjZ⟩ ⟨jY, fun h => hYZ hjY h⟩ + exact ⟨⟨hxXB, hxYB⟩, ⟨⟨hxYB, hxZB⟩, ⟨hxZB, hxXB⟩⟩⟩ + +private theorem hXY_YZ : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), ∀ (eYZ : + Finset GaussianInt), ∀ (jXY : Fin (4 : ℕ)), (LatticeVertexIncidentCell x jXY ∈ + X.cells ∧ LatticeVertexIncidentCell x (jXY + (1 : Fin (4 : ℕ))) ∈ Y.cells ∨ + LatticeVertexIncidentCell x jXY ∈ Y.cells ∧ LatticeVertexIncidentCell x (jXY + (1 : + Fin (4 : ℕ))) ∈ X.cells) → (∀ (jYZ : Fin (4 : ℕ)), (eYZ = edgeAt x jYZ) → + ((LatticeVertexIncidentCell x jYZ ∈ Y.cells ∧ LatticeVertexIncidentCell x (jYZ + (1 : + Fin (4 : ℕ))) ∈ Z.cells ∨ LatticeVertexIncidentCell x jYZ ∈ Z.cells ∧ + LatticeVertexIncidentCell x (jYZ + (1 : Fin (4 : ℕ))) ∈ Y.cells) → ((∀ ⦃a : + LatticeCell⦄, a ∈ Y.cells → a ∉ Z.cells) → ((∀ ⦃a : LatticeCell⦄, a ∈ Z.cells → a ∉ + X.cells) → (jXY ≠ jYZ))))) ) := by + classical + intro I edgeAt X Y Z x eYZ jXY htXY jYZ heYZat htYZ hYZd hZXd h + subst jYZ + rcases htXY with htXY | htXY <;> rcases htYZ with htYZ | htYZ + · exact hYZd htXY.2 htYZ.2 + · exact hZXd htYZ.1 htXY.1 + · exact hZXd htYZ.2 htXY.2 + · exact hYZd htXY.1 htYZ.1 + +private theorem hYZ_ZX : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), ∀ (eZX : + Finset GaussianInt), ∀ (jYZ : Fin (4 : ℕ)), (LatticeVertexIncidentCell x jYZ ∈ + Y.cells ∧ LatticeVertexIncidentCell x (jYZ + (1 : Fin (4 : ℕ))) ∈ Z.cells ∨ + LatticeVertexIncidentCell x jYZ ∈ Z.cells ∧ LatticeVertexIncidentCell x (jYZ + (1 : + Fin (4 : ℕ))) ∈ Y.cells) → (∀ (jZX : Fin (4 : ℕ)), (eZX = edgeAt x jZX) → + ((LatticeVertexIncidentCell x jZX ∈ Z.cells ∧ LatticeVertexIncidentCell x (jZX + (1 : + Fin (4 : ℕ))) ∈ X.cells ∨ LatticeVertexIncidentCell x jZX ∈ X.cells ∧ + LatticeVertexIncidentCell x (jZX + (1 : Fin (4 : ℕ))) ∈ Z.cells) → ((∀ ⦃a : + LatticeCell⦄, a ∈ X.cells → a ∉ Y.cells) → ((∀ ⦃a : LatticeCell⦄, a ∈ Y.cells → a ∉ + Z.cells) → ((∀ ⦃a : LatticeCell⦄, a ∈ Z.cells → a ∉ X.cells) → (jYZ ≠ jZX)))))) ) := by + classical + intro I edgeAt X Y Z x eZX jYZ htYZ jZX heZXat htZX hXYd hYZd hZXd h + subst jZX + rcases htYZ with htYZ | htYZ <;> rcases htZX with htZX | htZX + · exact hYZd htYZ.1 htZX.1 + · exact hXYd htZX.1 htYZ.1 + · exact hXYd htZX.2 htYZ.2 + · exact hZXd htYZ.1 htZX.1 + +private theorem hZX_XY : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), ∀ (eXY : + Finset GaussianInt), ∀ (jXY : Fin (4 : ℕ)), (eXY = edgeAt x jXY) → + ((LatticeVertexIncidentCell x jXY ∈ X.cells ∧ LatticeVertexIncidentCell x (jXY + (1 : + Fin (4 : ℕ))) ∈ Y.cells ∨ LatticeVertexIncidentCell x jXY ∈ Y.cells ∧ + LatticeVertexIncidentCell x (jXY + (1 : Fin (4 : ℕ))) ∈ X.cells) → (∀ (jYZ : Fin (4 : + ℕ)), ∀ (jZX : Fin (4 : ℕ)), (LatticeVertexIncidentCell x jZX ∈ Z.cells ∧ + LatticeVertexIncidentCell x (jZX + (1 : Fin (4 : ℕ))) ∈ X.cells ∨ + LatticeVertexIncidentCell x jZX ∈ X.cells ∧ LatticeVertexIncidentCell x (jZX + (1 : + Fin (4 : ℕ))) ∈ Z.cells) → ((∀ ⦃a : LatticeCell⦄, a ∈ X.cells → a ∉ Y.cells) → ((∀ ⦃a + : LatticeCell⦄, a ∈ Y.cells → a ∉ Z.cells) → ((∀ ⦃a : LatticeCell⦄, a ∈ Z.cells → a ∉ + X.cells) → ((jXY ≠ jYZ) → (jZX ≠ jXY))))))) ) := by + classical + intro I edgeAt X Y Z x eXY jXY heXYat htXY jYZ jZX htZX hXYd hYZd hZXd hXY_YZ h + subst jXY + rcases htZX with htZX | htZX <;> rcases htXY with htXY | htXY + · exact hZXd htZX.1 htXY.1 + · exact hYZd htXY.1 htZX.1 + · exact hYZd htXY.2 htZX.2 + · exact hXYd htZX.1 htXY.1 + +private theorem hexhaust : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), ∀ (eXY : + Finset GaussianInt), ∀ (eYZ : Finset GaussianInt), ∀ (eZX : Finset GaussianInt), ∀ + (jXY : Fin (4 : ℕ)), (eXY = edgeAt x jXY) → ((LatticeVertexIncidentCell x jXY ∈ + X.cells ∧ LatticeVertexIncidentCell x (jXY + (1 : Fin (4 : ℕ))) ∈ Y.cells ∨ + LatticeVertexIncidentCell x jXY ∈ Y.cells ∧ LatticeVertexIncidentCell x (jXY + (1 : + Fin (4 : ℕ))) ∈ X.cells) → (∀ (jYZ : Fin (4 : ℕ)), (eYZ = edgeAt x jYZ) → + ((LatticeVertexIncidentCell x jYZ ∈ Y.cells ∧ LatticeVertexIncidentCell x (jYZ + (1 : + Fin (4 : ℕ))) ∈ Z.cells ∨ LatticeVertexIncidentCell x jYZ ∈ Z.cells ∧ + LatticeVertexIncidentCell x (jYZ + (1 : Fin (4 : ℕ))) ∈ Y.cells) → (∀ (jZX : Fin (4 : + ℕ)), (eZX = edgeAt x jZX) → ((LatticeVertexIncidentCell x jZX ∈ Z.cells ∧ + LatticeVertexIncidentCell x (jZX + (1 : Fin (4 : ℕ))) ∈ X.cells ∨ + LatticeVertexIncidentCell x jZX ∈ X.cells ∧ LatticeVertexIncidentCell x (jZX + (1 : + Fin (4 : ℕ))) ∈ Z.cells) → ((jXY ≠ jYZ) → ((jYZ ≠ jZX) → ((jZX ≠ jXY) → (forall j : + Fin 4, LatticeVertexIncidentCell x j ∈ X.cells ∨ LatticeVertexIncidentCell x j ∈ + Y.cells ∨ LatticeVertexIncidentCell x j ∈ Z.cells))))))))) ) := by + classical + intro I edgeAt X Y Z x eXY eYZ eZX jXY heXYat htXY jYZ heYZat htYZ jZX heZXat htZX hXY_YZ + hYZ_ZX hZX_XY j + have hendpoint : + (j = jXY ∨ j = jXY + 1) ∨ + (j = jYZ ∨ j = jYZ + 1) ∨ + (j = jZX ∨ j = jZX + 1) := by + fin_cases j <;> fin_cases jXY <;> fin_cases jYZ <;> fin_cases jZX <;> + simp at hXY_YZ hYZ_ZX hZX_XY ⊢ + rcases hendpoint with h | h | h + · rcases h with rfl | rfl + · rcases htXY with htXY | htXY + · exact Or.inl htXY.1 + · exact Or.inr (Or.inl htXY.1) + · rcases htXY with htXY | htXY + · exact Or.inr (Or.inl htXY.2) + · exact Or.inl htXY.2 + · rcases h with rfl | rfl + · rcases htYZ with htYZ | htYZ + · exact Or.inr (Or.inl htYZ.1) + · exact Or.inr (Or.inr htYZ.1) + · rcases htYZ with htYZ | htYZ + · exact Or.inr (Or.inr htYZ.2) + · exact Or.inr (Or.inl htYZ.2) + · rcases h with rfl | rfl + · rcases htZX with htZX | htZX + · exact Or.inr (Or.inr htZX.1) + · exact Or.inl htZX.1 + · rcases htZX with htZX | htZX + · exact Or.inl htZX.2 + · exact Or.inr (Or.inr htZX.2) + +private theorem hopposite : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), ∀ (jX : Fin + (4 : ℕ)), (LatticeVertexIncidentCell x jX ∈ X.cells) → (∀ (jY : Fin (4 : ℕ)), + (LatticeVertexIncidentCell x jY ∈ Y.cells) → (∀ (jZ : Fin (4 : ℕ)), + (LatticeVertexIncidentCell x jZ ∈ Z.cells) → ((∀ ⦃a : LatticeCell⦄, a ∈ X.cells → a ∉ + Y.cells) → ((∀ ⦃a : LatticeCell⦄, a ∈ Y.cells → a ∉ Z.cells) → ((∀ ⦃a : LatticeCell⦄, + a ∈ Z.cells → a ∉ X.cells) → (((∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ X.cells + ∧ LatticeVertexIncidentCell x (j + 2) ∈ Y.cells) ∨ (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ X.cells ∧ LatticeVertexIncidentCell x (j + 2) ∈ + Z.cells) ∨ (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ Y.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ Z.cells)))))))) ) := by + classical + intro X Y Z x jX hjX jY hjY jZ hjZ hXYd hYZd hZXd + have hX_Y : jX ≠ jY := by + intro h + subst jY + exact hXYd hjX hjY + have hY_Z : jY ≠ jZ := by + intro h + subst jZ + exact hYZd hjY hjZ + have hZ_X : jZ ≠ jX := by + intro h + subst jX + exact hZXd hjZ hjX + have hindices : + jY = jX + 2 ∨ jX = jY + 2 ∨ + jZ = jX + 2 ∨ jX = jZ + 2 ∨ + jZ = jY + 2 ∨ jY = jZ + 2 := by + fin_cases jX <;> fin_cases jY <;> fin_cases jZ <;> + simp at hX_Y hY_Z hZ_X ⊢ + have add_two_twice (j : Fin 4) : j + 2 + 2 = j := by + fin_cases j <;> rfl + rcases hindices with h | h | h | h | h | h + · exact Or.inl ⟨jX, hjX, by simpa [h, add_two_twice] using hjY⟩ + · exact Or.inl ⟨jX, hjX, by simpa [h, add_two_twice] using hjY⟩ + · exact Or.inr (Or.inl ⟨jX, hjX, by simpa [h, add_two_twice] using hjZ⟩) + · exact Or.inr (Or.inl ⟨jX, hjX, by simpa [h, add_two_twice] using hjZ⟩) + · exact Or.inr (Or.inr ⟨jY, hjY, by simpa [h, add_two_twice] using hjZ⟩) + · exact Or.inr (Or.inr ⟨jY, hjY, by simpa [h, add_two_twice] using hjZ⟩) + +private theorem he' : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (FootprintEdges X ∩ FootprintEdges Y = + BoundaryFootprintEdges X ∩ BoundaryFootprintEdges Y) → (∀ (e : Finset GaussianInt), + (e ∈ FootprintEdges X ∩ FootprintEdges Y) → (e ∈ BoundaryFootprintEdges X ∩ + BoundaryFootprintEdges Y)) ) := by + classical + intro X Y hboundary e he + rw [← hboundary] + exact he + +private theorem hf' : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (FootprintEdges X ∩ FootprintEdges Y = + BoundaryFootprintEdges X ∩ BoundaryFootprintEdges Y) → (∀ (f : Finset GaussianInt), + (f ∈ FootprintEdges X ∩ FootprintEdges Y) → (f ∈ BoundaryFootprintEdges X ∩ + BoundaryFootprintEdges Y)) ) := by + classical + intro X Y hboundary f hf + rw [← hboundary] + exact hf + +private theorem hjne : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (x : GaussianInt), ∀ (e : Finset GaussianInt), ∀ + (f : Finset GaussianInt), (e ≠ f) → (∀ (je : Fin (4 : ℕ)), (e = edgeAt x je) → (∀ (jf + : Fin (4 : ℕ)), (f = edgeAt x jf) → ((LatticeVertexIncidentCell x jf ∈ X.cells ∧ + LatticeVertexIncidentCell x (jf + (1 : Fin (4 : ℕ))) ∈ Y.cells ∨ + LatticeVertexIncidentCell x jf ∈ Y.cells ∧ LatticeVertexIncidentCell x (jf + (1 : Fin + (4 : ℕ))) ∈ X.cells) → (je ≠ jf)))) ) := by + classical + intro I edgeAt X Y x e f hef je heAt jf hfAt htf h + subst jf + exact hef (heAt.trans hfAt.symm) + +private theorem hdPQ : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (x : GaussianInt), (∀ ⦃a : LatticeCell⦄, a ∈ + X.cells → a ∉ Y.cells) → ( + let P : Fin 4 → Prop := fun j => LatticeVertexIncidentCell x j ∈ X.cells + let Q : Fin 4 → Prop := fun j => LatticeVertexIncidentCell x j ∈ Y.cells + ∀ j, ¬ (P j ∧ Q j)) ) := by + classical + intro X Y x hd P Q j h + exact hd h.1 h.2 + +private theorem hcheckP : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (x : GaussianInt), (¬(x ∈ (↑X.cells : Set LatticeCell) ∧ x - (1 : + GaussianInt) - ⟨(0 : ℤ), (1 : ℤ)⟩ ∈ (↑X.cells : Set LatticeCell) ∧ x - (1 : + GaussianInt) ∉ (↑X.cells : Set LatticeCell) ∧ x - ⟨(0 : ℤ), (1 : ℤ)⟩ ∉ (↑X.cells : + Set LatticeCell) ∨ x - (1 : GaussianInt) ∈ (↑X.cells : Set LatticeCell) ∧ x - ⟨(0 : + ℤ), (1 : ℤ)⟩ ∈ (↑X.cells : Set LatticeCell) ∧ x ∉ (↑X.cells : Set LatticeCell) ∧ x - + (1 : GaussianInt) - ⟨(0 : ℤ), (1 : ℤ)⟩ ∉ (↑X.cells : Set LatticeCell))) → ( + let P : Fin 4 → Prop := fun j => LatticeVertexIncidentCell x j ∈ X.cells + ¬ ((P 0 ∧ P 2 ∧ ¬ P 1 ∧ ¬ P 3) ∨ (P 1 ∧ P 3 ∧ ¬ P 0 ∧ ¬ P 2))) ) := by + classical + intro X x hcheckX P + simpa [P, LatticeVertexIncidentCell] using hcheckX + +private theorem hcheckQ : + (by + classical + exact + ∀ (Y : ProtoTile), ∀ (x : GaussianInt), (¬(x ∈ (↑Y.cells : Set LatticeCell) ∧ x - (1 : + GaussianInt) - ⟨(0 : ℤ), (1 : ℤ)⟩ ∈ (↑Y.cells : Set LatticeCell) ∧ x - (1 : + GaussianInt) ∉ (↑Y.cells : Set LatticeCell) ∧ x - ⟨(0 : ℤ), (1 : ℤ)⟩ ∉ (↑Y.cells : + Set LatticeCell) ∨ x - (1 : GaussianInt) ∈ (↑Y.cells : Set LatticeCell) ∧ x - ⟨(0 : + ℤ), (1 : ℤ)⟩ ∈ (↑Y.cells : Set LatticeCell) ∧ x ∉ (↑Y.cells : Set LatticeCell) ∧ x - + (1 : GaussianInt) - ⟨(0 : ℤ), (1 : ℤ)⟩ ∉ (↑Y.cells : Set LatticeCell))) → ( + let Q : Fin 4 → Prop := fun j => LatticeVertexIncidentCell x j ∈ Y.cells + ¬ ((Q 0 ∧ Q 2 ∧ ¬ Q 1 ∧ ¬ Q 3) ∨ (Q 1 ∧ Q 3 ∧ ¬ Q 0 ∧ ¬ Q 2))) ) := by + classical + intro Y x hcheckY Q + simpa [Q, LatticeVertexIncidentCell] using hcheckY + +end InterfaceSectorGeometry + +theorem LocalLatticeInterfaceSectors : + (forall (X Y Z : ProtoTile) (x : GaussianInt), + LatticeTile X -> LatticeTile Y -> LatticeTile Z -> + TouchingTriple X Y Z -> + x ∈ FootprintVertices X ∩ FootprintVertices Y ∩ FootprintVertices Z -> + (forall j : Fin 4, + LatticeVertexIncidentCell x j ∈ X.cells ∨ + LatticeVertexIncidentCell x j ∈ Y.cells ∨ + LatticeVertexIncidentCell x j ∈ Z.cells) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ X.cells) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ Y.cells) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ Z.cells) ∧ + ((∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ X.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ Y.cells) ∨ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ X.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ Z.cells) ∨ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ Y.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ Z.cells))) ∧ + (forall (X Y : ProtoTile) (x : GaussianInt), + LatticeTile X -> LatticeTile Y -> Disjoint X.cells Y.cells -> + (∃ e f : Finset GaussianInt, + e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ + e ∈ FootprintEdges X ∩ FootprintEdges Y ∧ + f ∈ FootprintEdges X ∩ FootprintEdges Y) -> + (forall j : Fin 4, + LatticeVertexIncidentCell x j ∈ X.cells ∨ + LatticeVertexIncidentCell x j ∈ Y.cells) ∧ + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ X.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ Y.cells) := by +-- BODY + classical + have raw_incident (T : ProtoTile) (x : GaussianInt) + (hne : T.cells.Nonempty) (hx : x ∈ FootprintVertices T) := + InterfaceSectorGeometry.raw_incident T x hne hx + have nonempty_touching (U V : ProtoTile) + (hUne : U.cells.Nonempty) (hVne : V.cells.Nonempty) + (ht : TileTouching U V) := InterfaceSectorGeometry.nonempty_touching U V hUne hVne ht + have incident_boundary (T : ProtoTile) (x : GaussianInt) + (hne : T.cells.Nonempty) + (hsome : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) + (hmissing : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ T.cells) := + InterfaceSectorGeometry.incident_boundary T x hne hsome hmissing + let I : GaussianInt := ⟨0, 1⟩ + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] + have common_edge_transition (U V : ProtoTile) (x : GaussianInt) + (e : Finset GaussianInt) (hdisjoint : Disjoint U.cells V.cells) + (hxe : x ∈ e) + (he : e ∈ BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V) := + InterfaceSectorGeometry.common_edge_transition U V x e hdisjoint hxe he + have two_transition_sectors (P Q : Fin 4 → Prop) + (hd : ∀ j, ¬ (P j ∧ Q j)) + (hP : ¬ ((P 0 ∧ P 2 ∧ ¬ P 1 ∧ ¬ P 3) ∨ + (P 1 ∧ P 3 ∧ ¬ P 0 ∧ ¬ P 2))) + (hQ : ¬ ((Q 0 ∧ Q 2 ∧ ¬ Q 1 ∧ ¬ Q 3) ∨ + (Q 1 ∧ Q 3 ∧ ¬ Q 0 ∧ ¬ Q 2))) + (a b : Fin 4) (hab : a ≠ b) + (ha : (P a ∧ Q (a + 1)) ∨ (Q a ∧ P (a + 1))) + (hb : (P b ∧ Q (b + 1)) ∨ (Q b ∧ P (b + 1))) : + (∀ j, P j ∨ Q j) ∧ ∃ j, P j ∧ Q (j + 2) := InterfaceSectorGeometry.two_transition_sectors P + Q hd hP hQ a b hab ha hb + constructor + · intro X Y Z x hX hY hZ htriple hx + have hXne : X.cells.Nonempty := (LatticeTileGridStructure X hX).1.1 + have hYne : Y.cells.Nonempty := (LatticeTileGridStructure Y hY).1.1 + have hZne : Z.cells.Nonempty := (LatticeTileGridStructure Z hZ).1.1 + rcases htriple with ⟨hXYtouch, hYZtouch, hZXtouch, hunique⟩ + obtain ⟨hXYdisjoint, hXYpath⟩ := + nonempty_touching X Y hXne hYne hXYtouch + obtain ⟨hYZdisjoint, hYZpath⟩ := + nonempty_touching Y Z hYne hZne hYZtouch + obtain ⟨hZXdisjoint, hZXpath⟩ := + nonempty_touching Z X hZne hXne hZXtouch + have hxX : x ∈ FootprintVertices X := hx.1.1 + have hxY : x ∈ FootprintVertices Y := hx.1.2 + have hxZ : x ∈ FootprintVertices Z := hx.2 + obtain ⟨jX, hjX⟩ := raw_incident X x hXne hxX + obtain ⟨jY, hjY⟩ := raw_incident Y x hYne hxY + obtain ⟨jZ, hjZ⟩ := raw_incident Z x hZne hxZ + have hxBoundary := InterfaceSectorGeometry.hxBoundary incident_boundary X Y Z x hXne hYne + hZne hXYdisjoint hYZdisjoint hZXdisjoint jX hjX jY hjY jZ hjZ + obtain ⟨eXY, hxeXY, heXY⟩ := + SimpleGridPathVertexIncidentEdge _ _ hXYpath x hxBoundary.1 + obtain ⟨eYZ, hxeYZ, heYZ⟩ := + SimpleGridPathVertexIncidentEdge _ _ hYZpath x hxBoundary.2.1 + obtain ⟨eZX, hxeZX, heZX⟩ := + SimpleGridPathVertexIncidentEdge _ _ hZXpath x hxBoundary.2.2 + obtain ⟨jXY, heXYat, htXY⟩ := + common_edge_transition X Y x eXY hXYdisjoint hxeXY heXY + obtain ⟨jYZ, heYZat, htYZ⟩ := + common_edge_transition Y Z x eYZ hYZdisjoint hxeYZ heYZ + obtain ⟨jZX, heZXat, htZX⟩ := + common_edge_transition Z X x eZX hZXdisjoint hxeZX heZX + have hXYd := Finset.disjoint_left.mp hXYdisjoint + have hYZd := Finset.disjoint_left.mp hYZdisjoint + have hZXd := Finset.disjoint_left.mp hZXdisjoint + have hXY_YZ := InterfaceSectorGeometry.hXY_YZ X Y Z x eYZ jXY htXY jYZ heYZat htYZ hYZd hZXd + have hYZ_ZX := InterfaceSectorGeometry.hYZ_ZX X Y Z x eZX jYZ htYZ jZX heZXat htZX hXYd hYZd + hZXd + have hZX_XY := InterfaceSectorGeometry.hZX_XY X Y Z x eXY jXY heXYat htXY jYZ jZX htZX hXYd + hYZd hZXd hXY_YZ + have hexhaust := InterfaceSectorGeometry.hexhaust X Y Z x eXY eYZ eZX jXY heXYat htXY jYZ + heYZat htYZ jZX heZXat htZX hXY_YZ hYZ_ZX hZX_XY + have hopposite := InterfaceSectorGeometry.hopposite X Y Z x jX hjX jY hjY jZ hjZ hXYd hYZd hZXd + exact ⟨hexhaust, ⟨jX, hjX⟩, ⟨jY, hjY⟩, ⟨jZ, hjZ⟩, hopposite⟩ + · intro X Y x hX hY hdisjoint hedges + have hboundary := CellDisjointCommonEdgesBoundary X Y hdisjoint + rcases hedges with ⟨e, f, hef, hxe, hxf, he, hf⟩ + have he' := InterfaceSectorGeometry.he' X Y hboundary e he + have hf' := InterfaceSectorGeometry.hf' X Y hboundary f hf + obtain ⟨je, heAt, hte⟩ := + common_edge_transition X Y x e hdisjoint hxe he' + obtain ⟨jf, hfAt, htf⟩ := + common_edge_transition X Y x f hdisjoint hxf hf' + have hjne : je ≠ jf := InterfaceSectorGeometry.hjne X Y x e f hef je heAt jf hfAt htf + have hd := Finset.disjoint_left.mp hdisjoint + have hcheckX := (LatticeTileGridStructure X hX).2.1 x + have hcheckY := (LatticeTileGridStructure Y hY).2.1 x + let P : Fin 4 → Prop := fun j => LatticeVertexIncidentCell x j ∈ X.cells + let Q : Fin 4 → Prop := fun j => LatticeVertexIncidentCell x j ∈ Y.cells + have hdPQ : ∀ j, ¬ (P j ∧ Q j) := InterfaceSectorGeometry.hdPQ X Y x hd + have hcheckP : ¬ ((P 0 ∧ P 2 ∧ ¬ P 1 ∧ ¬ P 3) ∨ + (P 1 ∧ P 3 ∧ ¬ P 0 ∧ ¬ P 2)) := InterfaceSectorGeometry.hcheckP X x hcheckX + have hcheckQ : ¬ ((Q 0 ∧ Q 2 ∧ ¬ Q 1 ∧ ¬ Q 3) ∨ + (Q 1 ∧ Q 3 ∧ ¬ Q 0 ∧ ¬ Q 2)) := InterfaceSectorGeometry.hcheckQ Y x hcheckY + simpa [P, Q] using + two_transition_sectors P Q hdPQ hcheckP hcheckQ je jf hjne hte htf + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean new file mode 100644 index 0000000000..1031f3ef3a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean @@ -0,0 +1,3732 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5630T1MarkedRightOdometerAdjacencyReduction +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMarkedSectorTransport +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRoutedSelectedContact +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightOuterMarkingCriterion +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightSelectedAdjacency +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightSelectedRowGeometry +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizedBundleExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRowExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileSelectedRowGeometry +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileNormalizedBundleExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMixedAggregatePatches +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryMarkedDataCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.CoveredInterfaceOppositeIncidentCells +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentInterfacePath +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.LatticeTileThreeDiskJunction +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileSubodometer +public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween + +-- [TABLET NODE: MarkedOdometerAdjacencyReduction] + +/-! +# MarkedOdometerAdjacencyReduction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace MarkedAdjacencyGeometry + +private theorem hparentPositiveAt344 : + (by + classical + exact + ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (q + i.succ = Cᵢ.1.1) → (0 < (q i.succ).1) ) := by + classical + intro Cᵢ q i hqᵢ + rw [hqᵢ] + exact Cᵢ.property + +private theorem hO₀q : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (T₀ : ProtoTile), ∀ (h₀ : + PartialOdometer), (q (0 : Fin (4 : ℕ)) = C₀.1.1) → ((TileOdometer C₀.1.1 T₀ h₀) → + (TileOdometer (q 0) T₀ h₀)) ) := by + classical + intro C₀ q T₀ h₀ hq₀ hO₀ + rw [hq₀] + exact hO₀ + +private theorem hOᵢq : + (by + classical + exact + ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (Tᵢ + : ProtoTile), ∀ (hᵢ : PartialOdometer), (q i.succ = Cᵢ.1.1) → ((TileOdometer Cᵢ.1.1 + Tᵢ hᵢ) → (TileOdometer (q i.succ) Tᵢ hᵢ)) ) := by + classical + intro Cᵢ q i Tᵢ hᵢ hqᵢ hOᵢ + rw [hqᵢ] + exact hOᵢ + +private theorem hnormAt360 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + bundle.normalizedCircle.1.1 = BandPackingSymmetryCircleAction g C₀.1.1 ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle g + calc + bundle.normalizedCircle.1.1 = bundle.normalizedPresentation 0 := + bundle.normalized_circle_eq.symm + _ = BandPackingSymmetryCircleAction g C₀.1.1 := by + rw [bundle.normalized_presentation_eq, bundle.rotated_presentation_eq] + simp [g, BandPackingSymmetryQuadrupleAction, + bundle.presentation_child] + +private theorem hr₀ : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (T₀ + : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : PartialOdometer), + ∀ (x : GaussianInt), (q (0 : Fin (4 : ℕ)) = C₀.1.1) → (∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + (bundle.normalizedCircle.1.1 = BandPackingSymmetryCircleAction g C₀.1.1) → + (normalizationPresentation 0 = bundle.normalizedCircle.1.1)) ) := by + classical + intro C₀ Cᵢ q T₀ Tᵢ h₀ hᵢ x hq₀ bundle g normalizationPresentation hnorm + calc + normalizationPresentation 0 = BandPackingSymmetryCircleAction g C₀.1.1 := by + simp [normalizationPresentation, BandPackingSymmetryQuadrupleAction, hq₀] + _ = bundle.normalizedCircle.1.1 := by simpa [g] using hnorm.symm + +private theorem hrᵢ : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (p₀ : ℝ × ℝ), ∀ + (pᵢ : ℝ × ℝ), (q i.succ = Cᵢ.1.1) → ((TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) + • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 + (q i.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)))) + → ((pᵢ.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i.succ)))).1) → ((pᵢ.2 - p₀.2 = ((1 / 2 : ℝ) • + GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 + (q i.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q + i.succ)))).2) → (∀ (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ + h₀ hᵢ x), + let g := bundle.symmetry + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + (0 < (q i.succ).1) → ((TileOdometer (q i.succ) Tᵢ hᵢ) → (∀ (transportedRootSlope : ℝ × + ℝ), ∀ (transportedFixedSlope : ℝ × ℝ), ∀ (transportedRotation : Fin (4 : ℕ)), + (TileOdometer (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) + (BandPackingSymmetryTileAction g Tᵢ) (BandPackingSymmetryPartialOdometerAction g hᵢ)) + → ((TileCentroid (BandPackingSymmetryTileAction g Tᵢ) - TileCentroid + (BandPackingSymmetryTileAction g T₀) = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ^ (↑transportedRotation : ℕ) * (BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))) → + ((transportedFixedSlope.1 - transportedRootSlope.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑transportedRotation : ℕ) * (BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))).1) → + ((transportedFixedSlope.2 - transportedRootSlope.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑transportedRotation : ℕ) * (BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))).2) → + (normalizationPresentation (sigma i).succ = + bundle.normalizedFixedCircle.1.1)))))))))) ) := by + classical + intro C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x p₀ pᵢ hqᵢ hcentroid hslopex hslopey bundle g + normalizationPresentation sigma hparentPositive hOᵢq transportedRootSlope + transportedFixedSlope transportedRotation hfixedOdometer hcentroidForward hslopeXForward + hslopeYForward + have hact := congrArg (BandPackingSymmetryCircleAction g) hqᵢ + have hcoord : + (BandPackingSymmetryQuadrupleAction g q) (sigma i).succ = + BandPackingSymmetryCircleAction g (q i.succ) := by + cases hrev : BandPackingSymmetryReversesOrientation g <;> + fin_cases i <;> + simp [sigma, BandPackingSymmetryQuadrupleAction, + hrev, Fin.neg_def, + ] + calc + normalizationPresentation (sigma i).succ = BandPackingSymmetryCircleAction g (q i.succ) + := by + simpa [normalizationPresentation] using hcoord + _ = BandPackingSymmetryCircleAction g Cᵢ.1.1 := hact + _ = bundle.normalizedFixedCircle.1.1 := by + simpa [g] using bundle.normalized_fixed_circle_eq.symm + +private theorem htransportRootSlopeEq : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + ∀ (transportedRootSlope : ℝ × ℝ), (PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction g h₀) = some transportedRootSlope) → + (transportedRootSlope = bundle.normalizedRootSlope) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle g transportedRootSlope hrootSlope + apply Option.some.inj + rw [← hrootSlope, ← bundle.normalized_root_slope, + bundle.normalized_root_function_eq] + +private theorem htransportFixedSlopeEq : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + ∀ (transportedFixedSlope : ℝ × ℝ), (PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction g hᵢ) = some transportedFixedSlope) → + (transportedFixedSlope = bundle.normalizedFixedSlope) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle g transportedFixedSlope hfixedSlope + apply Option.some.inj + rw [← hfixedSlope, ← bundle.normalized_fixed_slope, + bundle.normalized_fixed_function_eq] + +private theorem hnormalizedCentroid : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + ∀ (transportedRotation : Fin (4 : ℕ)), (TileCentroid (BandPackingSymmetryTileAction g Tᵢ) + - TileCentroid (BandPackingSymmetryTileAction g T₀) = (1 / 2 : ℝ) • GaussianRealPoint + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑transportedRotation : ℕ) * (BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))) → + (TileCentroid bundle.normalizedFixed - TileCentroid bundle.normalizedRoot = (1 / 2 : + ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ transportedRotation.val * + (BandVectors.1 (normalizationPresentation (sigma i).succ) (normalizationPresentation + 0) + BandVectors.1 (normalizationPresentation 0) (normalizationPresentation (sigma + i).succ)))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma transportedRotation + hcentroidForward + simpa [bundle.normalized_root_eq, bundle.normalized_fixed_eq] using hcentroidForward + +private theorem hnormalizedSlopeX : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + ∀ (transportedRootSlope : ℝ × ℝ), ∀ (transportedFixedSlope : ℝ × ℝ), ∀ + (transportedRotation : Fin (4 : ℕ)), (transportedFixedSlope.1 - + transportedRootSlope.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑transportedRotation : ℕ) * (BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))).1) → + ((transportedRootSlope = bundle.normalizedRootSlope) → ((transportedFixedSlope = + bundle.normalizedFixedSlope) → (bundle.normalizedFixedSlope.1 - + bundle.normalizedRootSlope.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : + GaussianInt) ^ transportedRotation.val * (BandVectors.2 (normalizationPresentation + (sigma i).succ) (normalizationPresentation 0) + BandVectors.2 + (normalizationPresentation 0) (normalizationPresentation (sigma i).succ)))).1))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma transportedRootSlope + transportedFixedSlope transportedRotation hslopeXForward htransportRootSlopeEq + htransportFixedSlopeEq + simpa [htransportRootSlopeEq, htransportFixedSlopeEq] using hslopeXForward + +private theorem hnormalizedSlopeY : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + ∀ (transportedRootSlope : ℝ × ℝ), ∀ (transportedFixedSlope : ℝ × ℝ), ∀ + (transportedRotation : Fin (4 : ℕ)), (transportedFixedSlope.2 - + transportedRootSlope.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑transportedRotation : ℕ) * (BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))).2) → + ((transportedRootSlope = bundle.normalizedRootSlope) → ((transportedFixedSlope = + bundle.normalizedFixedSlope) → (bundle.normalizedFixedSlope.2 - + bundle.normalizedRootSlope.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : + GaussianInt) ^ transportedRotation.val * (BandVectors.2 (normalizationPresentation + (sigma i).succ) (normalizationPresentation 0) + BandVectors.2 + (normalizationPresentation 0) (normalizationPresentation (sigma i).succ)))).2))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma transportedRootSlope + transportedFixedSlope transportedRotation hslopeYForward htransportRootSlopeEq + htransportFixedSlopeEq + simpa [htransportRootSlopeEq, htransportFixedSlopeEq] using hslopeYForward + +private theorem hrowUR : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + ∀ (delta : Bool), ∀ (transportedRotation : Fin (4 : ℕ)), (transportedRotation = if + BandPackingSymmetryReversesOrientation g = true then -s - (1 : Fin (4 : ℕ)) + if + delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else s + if delta = true + then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ))) → ( + let rowUR := TileTranslation bundle.normalizedRoot + ((⟨0, 1⟩ : GaussianInt) ^ transportedRotation.val * + (if Even transportedRotation.val then + BandVectors.1 (normalizationPresentation 0) (normalizationPresentation (sigma i).succ) + else BandVectors.1 (normalizationPresentation (sigma i).succ) (normalizationPresentation + 0))) + rowUR = TileTranslation (BandPackingSymmetryTileAction g T₀) ((⟨0, 1⟩ : GaussianInt) ^ + (if BandPackingSymmetryReversesOrientation g then -s - 1 + (if delta then (2 : Fin 4) + else 0) else s + (if delta then (2 : Fin 4) else 0)).val * (if Even (if + BandPackingSymmetryReversesOrientation g then -s - 1 + (if delta then (2 : Fin 4) + else 0) else s + (if delta then (2 : Fin 4) else 0)).val then BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q 0) (BandPackingSymmetryQuadrupleAction g q + (sigma i).succ) else BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (sigma + i).succ) (BandPackingSymmetryQuadrupleAction g q 0)))) ) := by + classical + intro C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma delta + transportedRotation hrotationForward rowUR + dsimp [rowUR] + rw [bundle.normalized_root_eq, hrotationForward] + +private theorem hmarkedOld : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + ∀ (delta : Bool), ∀ (transportedRotation : Fin (4 : ℕ)), + let oldUR := TileTranslation T₀ + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0))) + let rowUR := TileTranslation bundle.normalizedRoot + ((⟨0, 1⟩ : GaussianInt) ^ transportedRotation.val * + (if Even transportedRotation.val then + BandVectors.1 (normalizationPresentation 0) (normalizationPresentation (sigma i).succ) + else BandVectors.1 (normalizationPresentation (sigma i).succ) (normalizationPresentation + 0))) + ( + let q' := BandPackingSymmetryQuadrupleAction g q; + let sigma := fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true + then -j else j; + let s' := if BandPackingSymmetryReversesOrientation g = true then -s - (1 : Fin (4 : ℕ)) + + if delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else s + if delta = + true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)); + let oldRight := TileTranslation T₀ ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if + Even (↑s : ℕ) then BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) else BandVectors.1 + (q i.succ) (q (0 : Fin (4 : ℕ)))); + let newRight := TileTranslation (BandPackingSymmetryTileAction g T₀) ((⟨(0 : ℤ), (1 : ℤ)⟩ + : GaussianInt) ^ (↑s' : ℕ) * if Even (↑s' : ℕ) then BandVectors.1 (q' (0 : Fin (4 : + ℕ))) (q' (sigma i).succ) else BandVectors.1 (q' (sigma i).succ) (q' (0 : Fin (4 : + ℕ)))); BandPackingSymmetryTileAction g oldRight = newRight ∧ (x ∈ FootprintVertices + oldRight ↔ BandPackingSymmetryVectorAction g x ∈ FootprintVertices newRight)) → + ((rowUR = TileTranslation (BandPackingSymmetryTileAction g T₀) ((⟨0, 1⟩ : + GaussianInt) ^ (if BandPackingSymmetryReversesOrientation g then -s - 1 + (if delta + then (2 : Fin 4) else 0) else s + (if delta then (2 : Fin 4) else 0)).val * (if Even + (if BandPackingSymmetryReversesOrientation g then -s - 1 + (if delta then (2 : Fin 4) + else 0) else s + (if delta then (2 : Fin 4) else 0)).val then BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q 0) (BandPackingSymmetryQuadrupleAction g q + (sigma i).succ) else BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (sigma + i).succ) (BandPackingSymmetryQuadrupleAction g q 0)))) → (x ∈ FootprintVertices oldUR + ↔ bundle.normalizedPoint ∈ FootprintVertices rowUR)) ) := by + classical + intro C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma delta + transportedRotation oldUR rowUR hmarkedTransport hrowUR + calc + x ∈ FootprintVertices oldUR ↔ + BandPackingSymmetryVectorAction g x ∈ + FootprintVertices + (TileTranslation (BandPackingSymmetryTileAction g T₀) + ((⟨0, 1⟩ : GaussianInt) ^ + (if BandPackingSymmetryReversesOrientation g then + -s - 1 + (if delta then (2 : Fin 4) else 0) + else s + (if delta then (2 : Fin 4) else 0)).val * + (if Even + (if BandPackingSymmetryReversesOrientation g then + -s - 1 + (if delta then (2 : Fin 4) else 0) + else s + (if delta then (2 : Fin 4) else 0)).val then + BandVectors.1 (BandPackingSymmetryQuadrupleAction g q 0) + (BandPackingSymmetryQuadrupleAction g q (sigma i).succ) + else BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (sigma i).succ) + (BandPackingSymmetryQuadrupleAction g q 0)))) := + by simpa [oldUR] using hmarkedTransport.2 + _ ↔ bundle.normalizedPoint ∈ FootprintVertices rowUR := by + rw [← bundle.normalized_point_eq, ← hrowUR] + +private theorem hnormalizedOrbit : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), (¬((∃ (g : + BandPackingSymmetry) (P : FordFareyParameter), BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = C₀.1.1) ∨ ∃ (g : BandPackingSymmetry) (K : + DiamondParameter), BandPackingSymmetryCircleAction g (DiamondRecursiveQuadruple K (0 + : Fin (4 : ℕ))) = C₀.1.1)) → (∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ¬ ((∃ (g : + BandPackingSymmetry) (P : FordFareyParameter), BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = bundle.normalizedCircle.1.1) ∨ (∃ (g : + BandPackingSymmetry) (K : DiamondParameter), BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K 0) = bundle.normalizedCircle.1.1))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x horbit bundle + have hnorm : bundle.normalizedCircle.1.1 = + BandPackingSymmetryCircleAction bundle.symmetry C₀.1.1 := by + calc + bundle.normalizedCircle.1.1 = bundle.normalizedPresentation 0 := + bundle.normalized_circle_eq.symm + _ = BandPackingSymmetryCircleAction bundle.symmetry C₀.1.1 := by + rw [bundle.normalized_presentation_eq, bundle.rotated_presentation_eq] + simp [BandPackingSymmetryQuadrupleAction, + bundle.presentation_child] + obtain ⟨ginv, hcircleL, hcircleR, hquadL, hquadR, htileL, + htileR, hvecL, hvecR, hfunL, hfunR, hphase⟩ := + (BandPackingSymmetryInversePhaseCancellation.2 bundle.symmetry) + intro horbit' + rcases horbit' with ⟨g, P, hP⟩ | ⟨g, K, hK⟩ + · apply horbit + left + refine ⟨.comp ginv g, P, ?_⟩ + rw [hnorm] at hP + change BandPackingSymmetryCircleAction ginv + (BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q)) = C₀.1.1 + rw [hP] + exact hcircleL C₀.1.1 + · apply horbit + right + refine ⟨.comp ginv g, K, ?_⟩ + rw [hnorm] at hK + change BandPackingSymmetryCircleAction ginv + (BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K 0)) = C₀.1.1 + rw [hK] + exact hcircleL C₀.1.1 + +private theorem hnormAt536 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + bundle.normalizedCircle.1.1 = BandPackingSymmetryCircleAction bundle.symmetry C₀.1.1 + ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle + calc + bundle.normalizedCircle.1.1 = bundle.normalizedPresentation 0 := + bundle.normalized_circle_eq.symm + _ = BandPackingSymmetryCircleAction bundle.symmetry C₀.1.1 := by + rw [bundle.normalized_presentation_eq, bundle.rotated_presentation_eq] + simp [BandPackingSymmetryQuadrupleAction, + bundle.presentation_child] + +private theorem actionCurvature : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (c : CircleCoordinates), (BandPackingSymmetryCircleAction + g c).1 = c.1 ) := by + classical + intro g + induction g with + | identity => intro c; rfl + | negate => intro c; rfl + | conjugate => intro c; rfl + | shift w => intro c; rfl + | comp a b iha ihb => intro c; simp [BandPackingSymmetryCircleAction, iha, ihb] + +private theorem hinverseCoordinate : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (C' : + BandCircle), (C'.1.1 = bundle.normalizedPresentation bundle.selectedSlot.succ) → (∀ + (ginv : BandPackingSymmetry), + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + inversePresentation inverseSlot.succ = BandPackingSymmetryCircleAction ginv C'.1.1) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle C' hC' ginv inversePresentation inverseSlot + unfold inversePresentation inverseSlot + rw [hC'] + generalize hidx : bundle.selectedSlot = j + have neg1 : -(1 : Fin 3) = 2 := rfl + have neg2 : -(2 : Fin 3) = 1 := rfl + by_cases hrev : BandPackingSymmetryReversesOrientation ginv <;> + fin_cases j <;> + simp [BandPackingSymmetryQuadrupleAction, + hrev, neg1, neg2]; + +private theorem hinversePositive : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (C' : + BandCircle), ∀ (ginv : BandPackingSymmetry), (∀ (g : BandPackingSymmetry), ∀ (c : + CircleCoordinates), (BandPackingSymmetryCircleAction g c).1 = c.1) → ( + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + (inversePresentation inverseSlot.succ = BandPackingSymmetryCircleAction ginv C'.1.1) → (0 + < (inversePresentation inverseSlot.succ).1)) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle C' ginv actionCurvature inversePresentation inverseSlot + hinverseCoordinate + rw [hinverseCoordinate, actionCurvature] + exact C'.property + +private theorem hsubNormalized : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + (bundle.normalizedCircle.1.1 = BandPackingSymmetryCircleAction bundle.symmetry + C₀.1.1) → (∀ (C' : BandCircle), (TileSubodometer bundle.normalizedCircle.1.1 C'.1.1 + bundle.normalizedRoot (bundle.pieces + bundle.selectedSlot bundle.selectedSign) bundle.normalizedRootFunction + (bundle.functions bundle.selectedSlot bundle.selectedSign)) → (TileSubodometer + (BandPackingSymmetryCircleAction bundle.symmetry C₀.1.1) C'.1.1 + (BandPackingSymmetryTileAction bundle.symmetry T₀) (bundle.pieces bundle.selectedSlot + bundle.selectedSign) (BandPackingSymmetryPartialOdometerAction bundle.symmetry h₀) + (bundle.functions bundle.selectedSlot bundle.selectedSign))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hnorm C' hsub' + simpa [hnorm, bundle.normalized_root_eq, + bundle.normalized_root_function_eq] using hsub' + +private theorem hsubInverse : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + ((∀ (g : BandPackingSymmetry), ∀ (C : CircleCoordinates), ∀ (C' : CircleCoordinates), ∀ + (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : + PartialOdometer), TileSubodometer C C' T T' h h' ↔ TileSubodometer + (BandPackingSymmetryCircleAction g C) (BandPackingSymmetryCircleAction g C') + (BandPackingSymmetryTileAction g T) (BandPackingSymmetryTileAction g T') + (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g h')) ∧ (∀ (g : BandPackingSymmetry), ∀ (x + : GaussianInt), ∀ (T : ProtoTile), ∀ (U : ProtoTile), (∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ T.cells ∨ LatticeVertexIncidentCell x j ∈ U.cells) ↔ + ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell (BandPackingSymmetryVectorAction g x) + j ∈ (BandPackingSymmetryTileAction g T).cells ∨ LatticeVertexIncidentCell + (BandPackingSymmetryVectorAction g x) j ∈ (BandPackingSymmetryTileAction g U).cells) + ∧ ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q → ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (delta : Bool), + BandPackingSymmetryScopedPhase g q delta → ∀ (T : ProtoTile), ∀ (x : GaussianInt), + let q' := BandPackingSymmetryQuadrupleAction g q; + let sigma := fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true + then -j else j; + let s' := if BandPackingSymmetryReversesOrientation g = true then -s - (1 : Fin (4 : ℕ)) + + if delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else s + if delta = + true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)); + let oldRight := TileTranslation T ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if + Even (↑s : ℕ) then BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) else BandVectors.1 + (q i.succ) (q (0 : Fin (4 : ℕ)))); + let newRight := TileTranslation (BandPackingSymmetryTileAction g T) ((⟨(0 : ℤ), (1 : ℤ)⟩ + : GaussianInt) ^ (↑s' : ℕ) * if Even (↑s' : ℕ) then BandVectors.1 (q' (0 : Fin (4 : + ℕ))) (q' (sigma i).succ) else BandVectors.1 (q' (sigma i).succ) (q' (0 : Fin (4 : + ℕ)))); BandPackingSymmetryTileAction g oldRight = newRight ∧ (x ∈ FootprintVertices + oldRight ↔ BandPackingSymmetryVectorAction g x ∈ FootprintVertices newRight)) → (∀ + (C' : BandCircle), ∀ (ginv : BandPackingSymmetry), (∀ (C : CircleCoordinates), + BandPackingSymmetryCircleAction ginv (BandPackingSymmetryCircleAction bundle.symmetry + C) = C) → ((∀ (T : ProtoTile), BandPackingSymmetryTileAction ginv + (BandPackingSymmetryTileAction bundle.symmetry T) = T) → ((∀ (h : PartialOdometer), + BandPackingSymmetryPartialOdometerAction ginv + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h) = h) → ( + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + ∀ (hinverseProper : ProperBandQuadruple inversePresentation), ∀ (hinversePositive : 0 < + (inversePresentation inverseSlot.succ).1), + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + (inverseCircle.1.1 = BandPackingSymmetryCircleAction ginv C'.1.1) → ((TileSubodometer + (BandPackingSymmetryCircleAction bundle.symmetry C₀.1.1) C'.1.1 + (BandPackingSymmetryTileAction bundle.symmetry T₀) (bundle.pieces bundle.selectedSlot + bundle.selectedSign) (BandPackingSymmetryPartialOdometerAction bundle.symmetry h₀) + (bundle.functions bundle.selectedSlot bundle.selectedSign)) → (TileSubodometer C₀.1.1 + inverseCircle.1.1 T₀ (BandPackingSymmetryTileAction ginv (bundle.pieces + bundle.selectedSlot bundle.selectedSign)) h₀ + (BandPackingSymmetryPartialOdometerAction ginv (bundle.functions bundle.selectedSlot + bundle.selectedSign)))))))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle markedData C' ginv hcircleL htileL hfunL inversePresentation + inverseSlot hinverseProper hinversePositive inverseCircle hinverseCircle hsubNormalized + let g := bundle.symmetry + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + have htransport := + (markedData.1 ginv + (BandPackingSymmetryCircleAction bundle.symmetry C₀.1.1) C'.1.1 + (BandPackingSymmetryTileAction bundle.symmetry T₀) + (bundle.pieces bundle.selectedSlot bundle.selectedSign) + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h₀) + (bundle.functions bundle.selectedSlot bundle.selectedSign)).mp + hsubNormalized + simpa [hcircleL, htileL, hfunL, hinverseCircle] using htransport + +private theorem inverseDomain : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), (∀ (v : GaussianInt), BandPackingSymmetryVectorAction ginv + (BandPackingSymmetryVectorAction bundle.symmetry v) = v) → (∀ (f : PartialOdometer), + ∀ (y : GaussianInt), (BandPackingSymmetryVectorAction bundle.symmetry y ∈ f.domain) → + (y ∈ (BandPackingSymmetryPartialOdometerAction ginv f).domain)) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv hvecL f y hy + change y ∈ ((BandPackingSymmetryPartialOdometerAction ginv f).domain : Set GaussianInt) + rw [(BandPackingSymmetryPartialOdometerActionFormulas ginv f f).1] + exact ⟨BandPackingSymmetryVectorAction bundle.symmetry y, hy, hvecL y⟩ + +private theorem hxFixedOriginal : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + (bundle.normalizedPoint ∈ bundle.normalizedFixedFunction.domain) → (∀ (ginv : + BandPackingSymmetry), (∀ (h : PartialOdometer), + BandPackingSymmetryPartialOdometerAction ginv + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h) = h) → ((∀ (f : + PartialOdometer), ∀ (y : GaussianInt), (BandPackingSymmetryVectorAction + bundle.symmetry y ∈ f.domain) → (y ∈ (BandPackingSymmetryPartialOdometerAction ginv + f).domain)) → ((BandPackingSymmetryVectorAction bundle.symmetry x = + bundle.normalizedPoint) → (x ∈ hᵢ.domain)))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hxFixed' ginv hfunL inverseDomain hpoint + have hmem : bundle.normalizedPoint ∈ + (BandPackingSymmetryPartialOdometerAction bundle.symmetry hᵢ).domain := by + simpa [hpoint, bundle.normalized_fixed_function_eq] using hxFixed' + have hback := inverseDomain + (BandPackingSymmetryPartialOdometerAction bundle.symmetry hᵢ) x + (by simpa [hpoint] using hmem) + simpa [hfunL] using hback + +private theorem hxSelectedOriginal : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + (bundle.normalizedPoint ∈ (bundle.functions bundle.selectedSlot + bundle.selectedSign).domain) → (∀ (ginv : BandPackingSymmetry), + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + (∀ (f : PartialOdometer), ∀ (y : GaussianInt), (BandPackingSymmetryVectorAction + bundle.symmetry y ∈ f.domain) → (y ∈ (BandPackingSymmetryPartialOdometerAction ginv + f).domain)) → ((BandPackingSymmetryVectorAction bundle.symmetry x = + bundle.normalizedPoint) → (x ∈ h'.domain))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hxSelected' ginv selectedFunction h' inverseDomain hpoint + have hmem : bundle.normalizedPoint ∈ selectedFunction.domain := hxSelected' + have hback := inverseDomain selectedFunction x (by simpa [hpoint] using hmem) + simpa [h'] using hback + +private theorem mapStar : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (b = a ∨ b = a + 1 + ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → (BandPackingSymmetryVectorAction g b + = BandPackingSymmetryVectorAction g a ∨ BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a + 1 ∨ BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a - 1 ∨ BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a + ⟨0, 1⟩ ∨ BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a - ⟨0, 1⟩) ) := by + classical + intro g + induction g with + | identity => intro a b hb; simpa [BandPackingSymmetryVectorAction] using hb + | shift w => intro a b hb; simpa [BandPackingSymmetryVectorAction] using hb + | negate => + intro a b hb + rcases hb with hb | hb | hb | hb | hb + · subst b + simp [BandPackingSymmetryVectorAction] + · subst b + right; right; right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] + · subst b + right; right; right; right + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] + · subst b + right; right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn]; try ring + · subst b + right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn]; try ring + | conjugate => + intro a b hb + rcases hb with hb | hb | hb | hb | hb + · subst b + simp [BandPackingSymmetryVectorAction] + · subst b + right; right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection]; try ring + · subst b + right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection]; try ring + · subst b + right; right; right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] + · subst b + right; right; right; right + ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] + | comp g₁ g₂ ih₁ ih₂ => + intro a b hb + exact ih₁ _ _ (ih₂ _ _ hb) + +private theorem hstarOriginal : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), (∀ (y : + GaussianInt), y = bundle.normalizedPoint ∨ y = bundle.normalizedPoint + (1 : + GaussianInt) ∨ y = bundle.normalizedPoint - (1 : GaussianInt) ∨ y = + bundle.normalizedPoint + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = + bundle.normalizedPoint - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ + bundle.normalizedFixedFunction.domain ∨ y ∈ (bundle.functions bundle.selectedSlot + bundle.selectedSign).domain) → (∀ (ginv : BandPackingSymmetry), (∀ (h : + PartialOdometer), BandPackingSymmetryPartialOdometerAction ginv + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h) = h) → ( + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + (∀ (f : PartialOdometer), ∀ (y : GaussianInt), (BandPackingSymmetryVectorAction + bundle.symmetry y ∈ f.domain) → (y ∈ (BandPackingSymmetryPartialOdometerAction ginv + f).domain)) → ((BandPackingSymmetryVectorAction bundle.symmetry x = + bundle.normalizedPoint) → ((∀ (g : BandPackingSymmetry), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), (b = a ∨ b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (BandPackingSymmetryVectorAction g b = BandPackingSymmetryVectorAction g a ∨ + BandPackingSymmetryVectorAction g b = BandPackingSymmetryVectorAction g a + 1 ∨ + BandPackingSymmetryVectorAction g b = BandPackingSymmetryVectorAction g a - 1 ∨ + BandPackingSymmetryVectorAction g b = BandPackingSymmetryVectorAction g a + ⟨0, 1⟩ ∨ + BandPackingSymmetryVectorAction g b = BandPackingSymmetryVectorAction g a - ⟨0, 1⟩)) + → (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ + hᵢ.domain ∨ y ∈ h'.domain))))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hstar' ginv hfunL selectedFunction h' inverseDomain hpoint + mapStar y hy + have hnormalizedStar := mapStar bundle.symmetry x y hy + rw [hpoint] at hnormalizedStar + have hmem := hstar' (BandPackingSymmetryVectorAction bundle.symmetry y) + hnormalizedStar + rcases hmem with hfixed | hselected + · left + have hback := inverseDomain + (BandPackingSymmetryPartialOdometerAction bundle.symmetry hᵢ) y (by + simpa [bundle.normalized_fixed_function_eq] using hfixed) + simpa [hfunL] using hback + · right + have hback := inverseDomain selectedFunction y hselected + simpa [h'] using hback + +private theorem hsizeOriginal : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + (bundle.normalizedCircle.1.1 = BandPackingSymmetryCircleAction bundle.symmetry + C₀.1.1) → (∀ (C' : BandCircle), (bundle.normalizedFixedCircle.1.1.1.toNat + + C'.1.1.1.toNat < + bundle.normalizedCircle.1.1.1.toNat + + bundle.normalizedFixedCircle.1.1.1.toNat) → + (∀ (ginv : BandPackingSymmetry), (∀ (g : BandPackingSymmetry), ∀ (c : + CircleCoordinates), (BandPackingSymmetryCircleAction g c).1 = c.1) → ( + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + ∀ (hinverseProper : ProperBandQuadruple inversePresentation), ∀ (hinversePositive : 0 < + (inversePresentation inverseSlot.succ).1), + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + (inverseCircle.1.1 = BandPackingSymmetryCircleAction ginv C'.1.1) → (Int.toNat Cᵢ.1.1.1 + + Int.toNat inverseCircle.1.1.1 < Int.toNat C₀.1.1.1 + Int.toNat Cᵢ.1.1.1)))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hnorm C' hsize' ginv actionCurvature inversePresentation + inverseSlot hinverseProper hinversePositive inverseCircle hinverseCircle + have hleft : Cᵢ.1.1.1 = bundle.normalizedFixedCircle.1.1.1 := by + rw [bundle.normalized_fixed_circle_eq] + exact (actionCurvature bundle.symmetry Cᵢ.1.1).symm + have hroot : C₀.1.1.1 = bundle.normalizedCircle.1.1.1 := by + rw [hnorm] + exact (actionCurvature bundle.symmetry C₀.1.1).symm + have hchild : inverseCircle.1.1.1 = C'.1.1.1 := by + rw [hinverseCircle] + exact actionCurvature ginv C'.1.1 + rw [hleft, hroot, hchild] + exact hsize' + +private theorem hinverseCircleFixed : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (C' : + BandCircle), ∀ (ginv : BandPackingSymmetry), (∀ (C : CircleCoordinates), + BandPackingSymmetryCircleAction ginv (BandPackingSymmetryCircleAction bundle.symmetry + C) = C) → ( + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + ∀ (hinverseProper : ProperBandQuadruple inversePresentation), ∀ (hinversePositive : 0 < + (inversePresentation inverseSlot.succ).1), + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + (inverseCircle.1.1 = BandPackingSymmetryCircleAction ginv C'.1.1) → ((C' = + bundle.normalizedFixedCircle) → (inverseCircle = Cᵢ))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle C' ginv hcircleL inversePresentation inverseSlot + hinverseProper hinversePositive inverseCircle hinverseCircle hCfixed + apply Subtype.ext + apply Subtype.ext + calc + inverseCircle.1.1 = BandPackingSymmetryCircleAction ginv + bundle.normalizedFixedCircle.1.1 := by + have htmp := hinverseCircle + rw [hCfixed] at htmp + exact htmp + _ = BandPackingSymmetryCircleAction ginv + (BandPackingSymmetryCircleAction bundle.symmetry Cᵢ.1.1) := by + rw [bundle.normalized_fixed_circle_eq] + _ = Cᵢ.1.1 := hcircleL Cᵢ.1.1 + +private theorem hnotOriginal : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + ∀ (transportedRotation : Fin (4 : ℕ)), + let oldUR := TileTranslation T₀ + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0))) + let rowUR := TileTranslation bundle.normalizedRoot + ((⟨0, 1⟩ : GaussianInt) ^ transportedRotation.val * + (if Even transportedRotation.val then + BandVectors.1 (normalizationPresentation 0) (normalizationPresentation (sigma i).succ) + else BandVectors.1 (normalizationPresentation (sigma i).succ) (normalizationPresentation + 0))) + (x ∈ FootprintVertices oldUR ↔ bundle.normalizedPoint ∈ FootprintVertices rowUR) → + ((bundle.normalizedPoint ∉ FootprintVertices (TileTranslation bundle.normalizedRoot + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑transportedRotation : ℕ) * if Even + (↑transportedRotation : ℕ) then BandVectors.1 (normalizationPresentation (0 : Fin (4 + : ℕ))) (normalizationPresentation (sigma i).succ) else BandVectors.1 + (normalizationPresentation (sigma i).succ) (normalizationPresentation (0 : Fin (4 : + ℕ)))))) → (x ∉ FootprintVertices oldUR)) ) := by + classical + intro C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma transportedRotation + oldUR rowUR hmarkedOld hnotMarked hx + exact hnotMarked (hmarkedOld.mp hx) + +private theorem hpFixedEq : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (pFixed : ℝ × + ℝ), (PartialOdometerSlope bundle.normalizedFixedFunction = some pFixed) → (pFixed = + bundle.normalizedFixedSlope) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle pFixed hslopeFixed + apply Option.some.inj + rw [← hslopeFixed, ← bundle.normalized_fixed_slope] + +private theorem hpSelectedEq : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (selectedSlope : + ℝ × ℝ), (PartialOdometerSlope (bundle.functions bundle.selectedSlot + bundle.selectedSign) = some selectedSlope) → (∀ (pSelected : ℝ × ℝ), + (PartialOdometerSlope (bundle.functions bundle.selectedSlot bundle.selectedSign) = + some pSelected) → (pSelected = selectedSlope)) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle selectedSlope hslope' pSelected hslopeSelected + apply Option.some.inj + rw [← hslopeSelected, ← hslope'] + +private theorem centroidCov : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (w : GaussianInt), + TileCentroid V - TileCentroid U = GaussianRealPoint w → TileCentroid + (BandPackingSymmetryTileAction a V) - TileCentroid (BandPackingSymmetryTileAction a + U) = GaussianRealPoint (BandPackingSymmetryVectorAction a w) ) := by + classical + intro a + induction a with + | identity => intro U V w hc; exact hc + | shift z => intro U V w hc; exact hc + | negate => + intro U V w hc + change TileCentroid (TileQuarterTurn V) - + TileCentroid (TileQuarterTurn U) = _ + rw [(TileQuarterTurnFormulas V).2.2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.2.1] + rcases w with ⟨wr, wi⟩ + have hc1 : (TileCentroid V).1 - (TileCentroid U).1 = wr := by + simpa [GaussianRealPoint] using congrArg Prod.fst hc + have hc2 : (TileCentroid V).2 - (TileCentroid U).2 = wi := by + simpa [GaussianRealPoint] using congrArg Prod.snd hc + apply Prod.ext + · simp [GaussianRealPoint, BandPackingSymmetryVectorAction, + GaussianQuarterTurn] at hc2 ⊢ + linarith + · simp [GaussianRealPoint, BandPackingSymmetryVectorAction, + GaussianQuarterTurn] at hc1 ⊢ + linarith + | conjugate => + intro U V w hc + change TileCentroid + (TileQuarterTurn (TileQuarterTurn (TileReflection V))) - + TileCentroid + (TileQuarterTurn (TileQuarterTurn (TileReflection U))) = _ + rw [(TileQuarterTurnFormulas (TileQuarterTurn (TileReflection V))).2.2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn (TileReflection U))).2.2.2.2.1, + (TileQuarterTurnFormulas (TileReflection V)).2.2.2.2.1, + (TileQuarterTurnFormulas (TileReflection U)).2.2.2.2.1, + (TileReflectionFormulas V).2.2.2.2.1, + (TileReflectionFormulas U).2.2.2.2.1] + rcases w with ⟨wr, wi⟩ + have hc1 : (TileCentroid V).1 - (TileCentroid U).1 = wr := by + simpa [GaussianRealPoint] using congrArg Prod.fst hc + have hc2 : (TileCentroid V).2 - (TileCentroid U).2 = wi := by + simpa [GaussianRealPoint] using congrArg Prod.snd hc + apply Prod.ext + · simp [GaussianRealPoint, BandPackingSymmetryVectorAction, + GaussianReflection] at hc2 ⊢ + linarith + · simp [GaussianRealPoint, BandPackingSymmetryVectorAction, + GaussianReflection] at hc1 ⊢ + linarith + | comp a b iha ihb => + intro U V w hc + exact iha _ _ _ (ihb U V w hc) + +private theorem hinverseUnitCurv : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), (∀ (g : + BandPackingSymmetry), ∀ (c : CircleCoordinates), (BandPackingSymmetryCircleAction g + c).1 = c.1) → ((bundle.normalizedFixedCircle.1.1.1 = (1 : ℤ)) → (Cᵢ.1.1.1 = 1)) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle actionCurvature hcurvUnit + calc + Cᵢ.1.1.1 = + (BandPackingSymmetryCircleAction bundle.symmetry Cᵢ.1.1).1 := + (actionCurvature bundle.symmetry Cᵢ.1.1).symm + _ = bundle.normalizedFixedCircle.1.1.1 := by + rw [bundle.normalized_fixed_circle_eq] + _ = 1 := hcurvUnit + +private theorem hcentUnitInv : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), (∀ (T : ProtoTile), BandPackingSymmetryTileAction ginv + (BandPackingSymmetryTileAction bundle.symmetry T) = T) → ( + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + ∀ (v : GaussianInt), (TileCentroid (bundle.pieces bundle.selectedSlot + bundle.selectedSign) - TileCentroid bundle.normalizedFixed = GaussianRealPoint v) → + ((∀ (a : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (w : + GaussianInt), TileCentroid V - TileCentroid U = GaussianRealPoint w → TileCentroid + (BandPackingSymmetryTileAction a V) - TileCentroid (BandPackingSymmetryTileAction a + U) = GaussianRealPoint (BandPackingSymmetryVectorAction a w)) → (TileCentroid T' - + TileCentroid Tᵢ = GaussianRealPoint (BandPackingSymmetryVectorAction ginv v)))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv htileL selectedSupport T' v hcentUnit centroidCov + have hc := centroidCov ginv bundle.normalizedFixed selectedSupport v hcentUnit + simpa [T', bundle.normalized_fixed_eq, htileL] using hc + +private theorem unitStepCov : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (o : Bool), ∀ (w : GaussianInt), UnitTriangularStep o w → + ∃ o', UnitTriangularStep o' (BandPackingSymmetryVectorAction a w) ) := by + classical + intro a + let unitPositive := + ({1, -1, ⟨0, 1⟩, -⟨0, 1⟩, 1 + ⟨0, 1⟩, + -(1 + ⟨0, 1⟩)} : Finset GaussianInt) + let unitNegative := + ({1, -1, ⟨0, 1⟩, -⟨0, 1⟩, -1 + ⟨0, 1⟩, + -(-1 + ⟨0, 1⟩)} : Finset GaussianInt) + induction a with + | identity => intro o w hw; exact ⟨o, by simpa [BandPackingSymmetryVectorAction] using hw⟩ + | shift z => intro o w hw; exact ⟨o, by simpa [BandPackingSymmetryVectorAction] using hw⟩ + | negate => + intro o w hw + cases o with + | false => + refine ⟨true, ?_⟩ + have hmap : unitNegative.image GaussianQuarterTurn = unitPositive := by + decide + change w ∈ unitNegative at hw + have hm : GaussianQuarterTurn w ∈ unitNegative.image GaussianQuarterTurn := + Finset.mem_image.mpr ⟨w, hw, rfl⟩ + rw [hmap] at hm + change GaussianQuarterTurn w ∈ unitPositive + exact hm + | true => + refine ⟨false, ?_⟩ + have hmap : unitPositive.image GaussianQuarterTurn = unitNegative := by + decide + change w ∈ unitPositive at hw + have hm : GaussianQuarterTurn w ∈ unitPositive.image GaussianQuarterTurn := + Finset.mem_image.mpr ⟨w, hw, rfl⟩ + rw [hmap] at hm + change GaussianQuarterTurn w ∈ unitNegative + exact hm + | conjugate => + intro o w hw + cases o with + | false => + refine ⟨true, ?_⟩ + have hmap : unitNegative.image (fun z => -GaussianReflection z) = + unitPositive := by + decide + change w ∈ unitNegative at hw + have hm : -GaussianReflection w ∈ + unitNegative.image (fun z => -GaussianReflection z) := + Finset.mem_image.mpr ⟨w, hw, rfl⟩ + rw [hmap] at hm + change -GaussianReflection w ∈ unitPositive + exact hm + | true => + refine ⟨false, ?_⟩ + have hmap : unitPositive.image (fun z => -GaussianReflection z) = + unitNegative := by + decide + change w ∈ unitPositive at hw + have hm : -GaussianReflection w ∈ + unitPositive.image (fun z => -GaussianReflection z) := + Finset.mem_image.mpr ⟨w, hw, rfl⟩ + rw [hmap] at hm + change -GaussianReflection w ∈ unitNegative + exact hm + | comp a b iha ihb => + intro o w hw + obtain ⟨o', hw'⟩ := ihb o w hw + exact iha o' _ hw' + +private theorem matrixCov : + (by + classical + exact + (∀ (g : BandPackingSymmetry), ∀ (c : CircleCoordinates), (BandPackingSymmetryCircleAction + g c).1 = c.1) → ( + let matrixVector (c : CircleCoordinates) (w : GaussianInt) : ℝ × ℝ := + (((1 + (c.2.re : ℝ)) * (w.re : ℝ) + + (c.2.im : ℝ) * (w.im : ℝ)) / 2, + ((c.2.im : ℝ) * (w.re : ℝ) + + (1 - (c.2.re : ℝ)) * (w.im : ℝ)) / 2) + let slopeDifferenceAction : BandPackingSymmetry → GaussianInt → + (ℝ × ℝ) → ℝ × ℝ := + BandPackingSymmetry.rec + (fun _ d => d) + (fun _ d => (-d.2, d.1)) + (fun _ d => (-d.1, d.2)) + (fun z w d => + (d.1 + (z.re : ℝ) * (w.re : ℝ) + (z.im : ℝ) * (w.im : ℝ), + d.2 + (z.im : ℝ) * (w.re : ℝ) - (z.re : ℝ) * (w.im : ℝ))) + (fun _ b iha ihb w d => + iha (BandPackingSymmetryVectorAction b w) (ihb w d)) + ∀ (a : BandPackingSymmetry), ∀ (c : CircleCoordinates), ∀ (w : GaussianInt), c.1 = 1 → + matrixVector (BandPackingSymmetryCircleAction a c) (BandPackingSymmetryVectorAction a + w) = slopeDifferenceAction a w (matrixVector c w)) ) := by + classical + intro actionCurvature matrixVector slopeDifferenceAction a + induction a with + | identity => intro c w hc; rfl + | shift z => + intro c w hc + rcases c with ⟨k, ⟨cx, cy⟩⟩ + rcases z with ⟨zx, zy⟩ + rcases w with ⟨wx, wy⟩ + have hk : k = 1 := by exact_mod_cast hc + subst k + simp [matrixVector, slopeDifferenceAction, + BandPackingSymmetryCircleAction, BandPackingSymmetryVectorAction, + GaussianInt.intCast_re, + GaussianInt.intCast_im]; + norm_num [GaussianInt.toComplex_def]; ring; simp + | negate => + intro c w hc + rcases c with ⟨k, ⟨cx, cy⟩⟩ + rcases w with ⟨wx, wy⟩ + have hk : k = 1 := by exact_mod_cast hc + subst k + simp [matrixVector, slopeDifferenceAction, + BandPackingSymmetryCircleAction, BandPackingSymmetryVectorAction, + GaussianQuarterTurn, GaussianInt.intCast_re, + GaussianInt.intCast_im]; + ring; simp + | conjugate => + intro c w hc + rcases c with ⟨k, ⟨cx, cy⟩⟩ + rcases w with ⟨wx, wy⟩ + have hk : k = 1 := by exact_mod_cast hc + subst k + simp [matrixVector, slopeDifferenceAction, + BandPackingSymmetryCircleAction, BandPackingSymmetryVectorAction, + GaussianReflection, GaussianInt.intCast_re, + GaussianInt.intCast_im]; + ring + | comp a b iha ihb => + intro c w hc + have hcurv : (BandPackingSymmetryCircleAction b c).1 = 1 := by + rw [actionCurvature] + exact hc + change matrixVector + (BandPackingSymmetryCircleAction a + (BandPackingSymmetryCircleAction b c)) + (BandPackingSymmetryVectorAction a + (BandPackingSymmetryVectorAction b w)) = + slopeDifferenceAction a (BandPackingSymmetryVectorAction b w) + (slopeDifferenceAction b w (matrixVector c w)) + rw [iha _ _ hcurv, ihb _ _ hc] + +private theorem slopeDiffCov : + (by + classical + exact + (∀ (g : BandPackingSymmetry), ∀ (c : CircleCoordinates), (BandPackingSymmetryCircleAction + g c).1 = c.1) → ((∀ (a : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (V : ProtoTile), + ∀ (w : GaussianInt), TileCentroid V - TileCentroid U = GaussianRealPoint w → + TileCentroid (BandPackingSymmetryTileAction a V) - TileCentroid + (BandPackingSymmetryTileAction a U) = GaussianRealPoint + (BandPackingSymmetryVectorAction a w)) → ( + let matrixVector (c : CircleCoordinates) (w : GaussianInt) : ℝ × ℝ := + (((1 + (c.2.re : ℝ)) * (w.re : ℝ) + + (c.2.im : ℝ) * (w.im : ℝ)) / 2, + ((c.2.im : ℝ) * (w.re : ℝ) + + (1 - (c.2.re : ℝ)) * (w.im : ℝ)) / 2) + let slopeDifferenceAction : BandPackingSymmetry → GaussianInt → + (ℝ × ℝ) → ℝ × ℝ := + BandPackingSymmetry.rec + (fun _ d => d) + (fun _ d => (-d.2, d.1)) + (fun _ d => (-d.1, d.2)) + (fun z w d => + (d.1 + (z.re : ℝ) * (w.re : ℝ) + (z.im : ℝ) * (w.im : ℝ), + d.2 + (z.im : ℝ) * (w.re : ℝ) - (z.re : ℝ) * (w.im : ℝ))) + (fun _ b iha ihb w d => + iha (BandPackingSymmetryVectorAction b w) (ihb w d)) + (∀ (a : BandPackingSymmetry), ∀ (c : CircleCoordinates), ∀ (w : GaussianInt), c.1 = 1 → + matrixVector (BandPackingSymmetryCircleAction a c) (BandPackingSymmetryVectorAction a + w) = slopeDifferenceAction a w (matrixVector c w)) → (∀ (a : BandPackingSymmetry), ∀ + (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (p : ℝ × ℝ), ∀ (p' : + ℝ × ℝ), ∀ (w : GaussianInt), c.1 = 1 → TileCentroid V - TileCentroid U = + GaussianRealPoint w → p' - p = matrixVector c w → BandPackingSymmetrySlopeAction a V + p' - BandPackingSymmetrySlopeAction a U p = slopeDifferenceAction a w (matrixVector c + w)))) ) := by + classical + intro actionCurvature centroidCov matrixVector slopeDifferenceAction matrixCov a + induction a with + | identity => intro c U V p p' w hc hcent hdiff; exact hdiff + | shift z => + intro c U V p p' w hc hcent hdiff + rcases z with ⟨zx, zy⟩ + rcases w with ⟨wx, wy⟩ + have hcent1 : (TileCentroid V).1 - (TileCentroid U).1 = wx := by + simpa [GaussianRealPoint] using congrArg Prod.fst hcent + have hcent2 : (TileCentroid V).2 - (TileCentroid U).2 = wy := by + simpa [GaussianRealPoint] using congrArg Prod.snd hcent + rcases p with ⟨px, py⟩ + rcases p' with ⟨p'x, p'y⟩ + have hdiff1 : p'x - px = (matrixVector c ⟨wx, wy⟩).1 := by + simpa using congrArg Prod.fst hdiff + have hdiff2 : p'y - py = (matrixVector c ⟨wx, wy⟩).2 := by + simpa using congrArg Prod.snd hdiff + simp [matrixVector] at hdiff1 hdiff2 + apply Prod.ext + · simp [BandPackingSymmetrySlopeAction, + slopeDifferenceAction, matrixVector] + linear_combination hdiff1 + (zx : ℝ) * hcent1 + (zy : ℝ) * hcent2 + · simp [BandPackingSymmetrySlopeAction, + slopeDifferenceAction, matrixVector] + linear_combination hdiff2 + (zy : ℝ) * hcent1 - (zx : ℝ) * hcent2 + | negate => + intro c U V p p' w hc hcent hdiff + rcases p with ⟨px, py⟩ + rcases p' with ⟨p'x, p'y⟩ + have h1 := congrArg Prod.fst hdiff + have h2 := congrArg Prod.snd hdiff + simp? [BandPackingSymmetrySlopeAction, + slopeDifferenceAction] at h1 h2 ⊢ + exact ⟨by linarith [h2], by linarith [h1]⟩ + | conjugate => + intro c U V p p' w hc hcent hdiff + rcases p with ⟨px, py⟩ + rcases p' with ⟨p'x, p'y⟩ + have h1 := congrArg Prod.fst hdiff + have h2 := congrArg Prod.snd hdiff + simp? [BandPackingSymmetrySlopeAction, + slopeDifferenceAction] at h1 h2 ⊢ + exact ⟨by linarith [h1], by linarith [h2]⟩ + | comp a b iha ihb => + intro c U V p p' w hc hcent hdiff + have hcentB := centroidCov b U V w hcent + have hdiffB := ihb c U V p p' w hc hcent hdiff + have hcurvB : (BandPackingSymmetryCircleAction b c).1 = 1 := by + rw [actionCurvature] + exact hc + have hdiffB' : + BandPackingSymmetrySlopeAction b V p' - + BandPackingSymmetrySlopeAction b U p = + matrixVector (BandPackingSymmetryCircleAction b c) + (BandPackingSymmetryVectorAction b w) := + hdiffB.trans (matrixCov b c w hc).symm + have hdiffA := iha (BandPackingSymmetryCircleAction b c) + (BandPackingSymmetryTileAction b U) + (BandPackingSymmetryTileAction b V) + (BandPackingSymmetrySlopeAction b U p) + (BandPackingSymmetrySlopeAction b V p') + (BandPackingSymmetryVectorAction b w) hcurvB hcentB hdiffB' + rw [matrixCov b c w hc] at hdiffA + simpa [BandPackingSymmetrySlopeAction, + BandPackingSymmetryVectorAction, slopeDifferenceAction] using hdiffA + +private theorem hinverseFixedCircleCoord : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), (∀ (C : CircleCoordinates), BandPackingSymmetryCircleAction + ginv (BandPackingSymmetryCircleAction bundle.symmetry C) = C) → + (BandPackingSymmetryCircleAction ginv bundle.normalizedFixedCircle.1.1 = Cᵢ.1.1) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv hcircleL + rw [bundle.normalized_fixed_circle_eq] + exact hcircleL Cᵢ.1.1 + +private theorem hmatrix00 : + (by + classical + exact + ∀ (D : BandCircle), D.1.1.1 = 1 → CircleMatrix D 0 0 = (1 + ((D.1.1.2).re : ℝ)) / 2 ) := by + classical + intro D hD + simp [CircleMatrix, BandCircleEuclideanData, hD]; ring + +private theorem hmatrix01 : + (by + classical + exact + ∀ (D : BandCircle), D.1.1.1 = 1 → CircleMatrix D 0 1 = ((D.1.1.2).im : ℝ) / 2 ) := by + classical + intro D hD + simp [CircleMatrix, BandCircleEuclideanData, hD]; ring + +private theorem hmatrix10 : + (by + classical + exact + ∀ (D : BandCircle), D.1.1.1 = 1 → CircleMatrix D 1 0 = ((D.1.1.2).im : ℝ) / 2 ) := by + classical + intro D hD + simp [CircleMatrix, BandCircleEuclideanData, hD]; ring + +private theorem hmatrix11 : + (by + classical + exact + ∀ (D : BandCircle), D.1.1.1 = 1 → CircleMatrix D 1 1 = (1 - ((D.1.1.2).re : ℝ)) / 2 ) := by + classical + intro D hD + simp [CircleMatrix, BandCircleEuclideanData, hD]; ring + +private theorem hdiffUnit : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (pFixed : ℝ × + ℝ), ∀ (pSelected : ℝ × ℝ), (bundle.normalizedFixedCircle.1.1.1 = (1 : ℤ)) → (∀ (v : + GaussianInt), (pSelected.1 - pFixed.1 = + CircleMatrix bundle.normalizedFixedCircle (0 : Fin (2 : ℕ)) (0 : Fin (2 : ℕ)) * + (↑v.re : ℝ) + CircleMatrix bundle.normalizedFixedCircle (0 : Fin (2 : ℕ)) (1 : Fin (2 + : ℕ)) * (↑v.im : ℝ)) → ((pSelected.2 - pFixed.2 = CircleMatrix + bundle.normalizedFixedCircle (1 : Fin (2 : ℕ)) (0 : Fin (2 : ℕ)) * (↑v.re : ℝ) + + CircleMatrix bundle.normalizedFixedCircle (1 : Fin (2 : ℕ)) (1 : Fin (2 : ℕ)) * + (↑v.im : ℝ)) → ( + let matrixVector (c : CircleCoordinates) (w : GaussianInt) : ℝ × ℝ := + (((1 + (c.2.re : ℝ)) * (w.re : ℝ) + + (c.2.im : ℝ) * (w.im : ℝ)) / 2, + ((c.2.im : ℝ) * (w.re : ℝ) + + (1 - (c.2.re : ℝ)) * (w.im : ℝ)) / 2) + (∀ (D : BandCircle), D.1.1.1 = 1 → CircleMatrix D 0 0 = (1 + ((D.1.1.2).re : ℝ)) / 2) → + ((∀ (D : BandCircle), D.1.1.1 = 1 → CircleMatrix D 0 1 = ((D.1.1.2).im : ℝ) / 2) → + ((∀ (D : BandCircle), D.1.1.1 = 1 → CircleMatrix D 1 0 = ((D.1.1.2).im : ℝ) / 2) → + ((∀ (D : BandCircle), D.1.1.1 = 1 → CircleMatrix D 1 1 = (1 - ((D.1.1.2).re : ℝ)) / + 2) → (pSelected - pFixed = matrixVector bundle.normalizedFixedCircle.1.1 v))))))) ) + := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle pFixed pSelected hcurvUnit v hslopeUnitRe hslopeUnitIm + matrixVector hmatrix00 hmatrix01 hmatrix10 hmatrix11 + apply Prod.ext + · have hh := hslopeUnitRe + rw [hmatrix00 bundle.normalizedFixedCircle hcurvUnit, + hmatrix01 bundle.normalizedFixedCircle hcurvUnit] at hh + calc + pSelected.1 - pFixed.1 = _ := hh + _ = (matrixVector bundle.normalizedFixedCircle.1.1 v).1 := by + simp [matrixVector] + ring + · have hh := hslopeUnitIm + rw [hmatrix10 bundle.normalizedFixedCircle hcurvUnit, + hmatrix11 bundle.normalizedFixedCircle hcurvUnit] at hh + calc + pSelected.2 - pFixed.2 = _ := hh + _ = (matrixVector bundle.normalizedFixedCircle.1.1 v).2 := by + simp [matrixVector] + ring + +private theorem hdiffUnitInv' : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + ∀ (pFixed : ℝ × ℝ), ∀ (pSelected : ℝ × ℝ), (bundle.normalizedFixedCircle.1.1.1 = (1 : ℤ)) + → (∀ (v : GaussianInt), + let matrixVector (c : CircleCoordinates) (w : GaussianInt) : ℝ × ℝ := + (((1 + (c.2.re : ℝ)) * (w.re : ℝ) + + (c.2.im : ℝ) * (w.im : ℝ)) / 2, + ((c.2.im : ℝ) * (w.re : ℝ) + + (1 - (c.2.re : ℝ)) * (w.im : ℝ)) / 2) + let slopeDifferenceAction : BandPackingSymmetry → GaussianInt → + (ℝ × ℝ) → ℝ × ℝ := + BandPackingSymmetry.rec + (fun _ d => d) + (fun _ d => (-d.2, d.1)) + (fun _ d => (-d.1, d.2)) + (fun z w d => + (d.1 + (z.re : ℝ) * (w.re : ℝ) + (z.im : ℝ) * (w.im : ℝ), + d.2 + (z.im : ℝ) * (w.re : ℝ) - (z.re : ℝ) * (w.im : ℝ))) + (fun _ b iha ihb w d => + iha (BandPackingSymmetryVectorAction b w) (ihb w d)) + (∀ (a : BandPackingSymmetry), ∀ (c : CircleCoordinates), ∀ (w : GaussianInt), c.1 = 1 → + matrixVector (BandPackingSymmetryCircleAction a c) (BandPackingSymmetryVectorAction a + w) = slopeDifferenceAction a w (matrixVector c w)) → ((BandPackingSymmetrySlopeAction + ginv selectedSupport pSelected - BandPackingSymmetrySlopeAction ginv + bundle.normalizedFixed pFixed = slopeDifferenceAction ginv v (matrixVector + bundle.normalizedFixedCircle.1.1 v)) → + (BandPackingSymmetrySlopeAction ginv selectedSupport pSelected - + BandPackingSymmetrySlopeAction ginv bundle.normalizedFixed pFixed = matrixVector + (BandPackingSymmetryCircleAction ginv bundle.normalizedFixedCircle.1.1) + (BandPackingSymmetryVectorAction ginv v)))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv selectedSupport pFixed pSelected hcurvUnit v matrixVector + slopeDifferenceAction matrixCov hdiffUnitInv + exact hdiffUnitInv.trans (matrixCov ginv + bundle.normalizedFixedCircle.1.1 v hcurvUnit).symm + +private theorem htargetMatrix : + (by + classical + exact + ∀ (Cᵢ : BandCircle), ∀ (ginv : BandPackingSymmetry), ∀ (v : GaussianInt), + let matrixVector (c : CircleCoordinates) (w : GaussianInt) : ℝ × ℝ := + (((1 + (c.2.re : ℝ)) * (w.re : ℝ) + + (c.2.im : ℝ) * (w.im : ℝ)) / 2, + ((c.2.im : ℝ) * (w.re : ℝ) + + (1 - (c.2.re : ℝ)) * (w.im : ℝ)) / 2) + (CircleMatrix Cᵢ 0 0 = (1 + ((Cᵢ.1.1.2).re : ℝ)) / 2) → ((CircleMatrix Cᵢ 0 1 = + ((Cᵢ.1.1.2).im : ℝ) / 2) → ((CircleMatrix Cᵢ 1 0 = ((Cᵢ.1.1.2).im : ℝ) / 2) → + ((CircleMatrix Cᵢ 1 1 = (1 - ((Cᵢ.1.1.2).re : ℝ)) / 2) → (matrixVector Cᵢ.1.1 + (BandPackingSymmetryVectorAction ginv v) = (CircleMatrix Cᵢ 0 0 * + (BandPackingSymmetryVectorAction ginv v).re + CircleMatrix Cᵢ 0 1 * + (BandPackingSymmetryVectorAction ginv v).im, CircleMatrix Cᵢ 1 0 * + (BandPackingSymmetryVectorAction ginv v).re + CircleMatrix Cᵢ 1 1 * + (BandPackingSymmetryVectorAction ginv v).im))))) ) := by + classical + intro Cᵢ ginv v matrixVector hmatrixInv0 hmatrixInv1 hmatrixInv2 hmatrixInv3 + apply Prod.ext + · simp [matrixVector, hmatrixInv0, hmatrixInv1] + ring + · simp [matrixVector, hmatrixInv2, hmatrixInv3] + ring + +private theorem hdiffUnitInvFinal : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + ∀ (pFixed : ℝ × ℝ), ∀ (pSelected : ℝ × ℝ), ∀ (v : GaussianInt), + let matrixVector (c : CircleCoordinates) (w : GaussianInt) : ℝ × ℝ := + (((1 + (c.2.re : ℝ)) * (w.re : ℝ) + + (c.2.im : ℝ) * (w.im : ℝ)) / 2, + ((c.2.im : ℝ) * (w.re : ℝ) + + (1 - (c.2.re : ℝ)) * (w.im : ℝ)) / 2) + (BandPackingSymmetryCircleAction ginv bundle.normalizedFixedCircle.1.1 = Cᵢ.1.1) → + ((BandPackingSymmetrySlopeAction ginv selectedSupport pSelected - + BandPackingSymmetrySlopeAction ginv bundle.normalizedFixed pFixed = matrixVector + (BandPackingSymmetryCircleAction ginv bundle.normalizedFixedCircle.1.1) + (BandPackingSymmetryVectorAction ginv v)) → ((matrixVector Cᵢ.1.1 + (BandPackingSymmetryVectorAction ginv v) = (CircleMatrix Cᵢ 0 0 * + (BandPackingSymmetryVectorAction ginv v).re + CircleMatrix Cᵢ 0 1 * + (BandPackingSymmetryVectorAction ginv v).im, CircleMatrix Cᵢ 1 0 * + (BandPackingSymmetryVectorAction ginv v).re + CircleMatrix Cᵢ 1 1 * + (BandPackingSymmetryVectorAction ginv v).im)) → (BandPackingSymmetrySlopeAction ginv + selectedSupport pSelected - BandPackingSymmetrySlopeAction ginv + bundle.normalizedFixed pFixed = (CircleMatrix Cᵢ 0 0 * + (BandPackingSymmetryVectorAction ginv v).re + CircleMatrix Cᵢ 0 1 * + (BandPackingSymmetryVectorAction ginv v).im, CircleMatrix Cᵢ 1 0 * + (BandPackingSymmetryVectorAction ginv v).re + CircleMatrix Cᵢ 1 1 * + (BandPackingSymmetryVectorAction ginv v).im)))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv selectedSupport pFixed pSelected v matrixVector + hinverseFixedCircleCoord hdiffUnitInv' htargetMatrix + rw [hinverseFixedCircleCoord] at hdiffUnitInv' + exact hdiffUnitInv'.trans htargetMatrix + +private theorem fixedCells : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), (TileOdometer + bundle.normalizedFixedCircle.1.1 + bundle.normalizedFixed bundle.normalizedFixedFunction) → (∀ (pFixed : ℝ × ℝ), + (PartialOdometerSlope bundle.normalizedFixedFunction = some pFixed) → + (bundle.normalizedFixed.cells.Nonempty)) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hOFixed pFixed hslopeFixed + have hdom := PositiveCurvatureTileOdometerDomain + bundle.normalizedFixedCircle.1.1 bundle.normalizedFixed + bundle.normalizedFixedFunction bundle.normalizedFixedCircle.property hOFixed + by_contra hne + have hsingleton : (bundle.normalizedFixedFunction.domain : Set GaussianInt) = + {bundle.normalizedFixed.anchor} := by + rw [hdom] + simp [FootprintVertices, hne] + have hsquares : (PartialOdometerSquares bundle.normalizedFixedFunction).Nonempty := by + by_contra hsq + have hnone : PartialOdometerSlope bundle.normalizedFixedFunction = none := by + simp [PartialOdometerSlope, hsq] + rw [hnone] at hslopeFixed + cases hslopeFixed + rcases hsquares with ⟨y, hy⟩ + simp only [PartialOdometerSquares, Finset.mem_filter] at hy + have hy0 : y = bundle.normalizedFixed.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hsingleton] + exact hy.1 + have hy1 : y + 1 = bundle.normalizedFixed.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hsingleton] + exact hy.2.1 + have hbad : y + 1 = y := hy1.trans hy0.symm + have hbad' := congrArg (fun z : GaussianInt => z.re) hbad + norm_num at hbad' + +private theorem selectedCells : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + (TileOdometer bundle.normalizedFixedCircle.1.1 + (bundle.pieces bundle.selectedSlot bundle.selectedSign) (bundle.functions + bundle.selectedSlot bundle.selectedSign)) → (∀ (pSelected : ℝ × ℝ), + (PartialOdometerSlope (bundle.functions bundle.selectedSlot bundle.selectedSign) = + some pSelected) → (selectedSupport.cells.Nonempty)) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle selectedSupport hOSelected pSelected hslopeSelected + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + have hdom := PositiveCurvatureTileOdometerDomain + bundle.normalizedFixedCircle.1.1 selectedSupport selectedFunction + bundle.normalizedFixedCircle.property hOSelected + by_contra hne + have hsingleton : (selectedFunction.domain : Set GaussianInt) = + {selectedSupport.anchor} := by + rw [hdom] + simp [FootprintVertices, hne] + have hsquares : (PartialOdometerSquares selectedFunction).Nonempty := by + by_contra hsq + have hnone : PartialOdometerSlope selectedFunction = none := by + simp [PartialOdometerSlope, hsq] + rw [hnone] at hslopeSelected + cases hslopeSelected + rcases hsquares with ⟨y, hy⟩ + simp only [PartialOdometerSquares, Finset.mem_filter] at hy + have hy0 : y = selectedSupport.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hsingleton] + exact hy.1 + have hy1 : y + 1 = selectedSupport.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hsingleton] + exact hy.2.1 + have hbad : y + 1 = y := hy1.trans hy0.symm + have hbad' := congrArg (fun z : GaussianInt => z.re) hbad + norm_num at hbad' + +private theorem hslopeFixedInv : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), ∀ (pFixed : ℝ × ℝ), (PartialOdometerSlope + bundle.normalizedFixedFunction = some pFixed) → + ((bundle.normalizedFixed.cells.Nonempty) → ((TileOdometer + (BandPackingSymmetryCircleAction ginv bundle.normalizedFixedCircle.1.1) + (BandPackingSymmetryTileAction ginv + bundle.normalizedFixed) (BandPackingSymmetryPartialOdometerAction ginv + bundle.normalizedFixedFunction) ∧ (↑(BandPackingSymmetryPartialOdometerAction ginv + bundle.normalizedFixedFunction).domain : Set GaussianInt) = + BandPackingSymmetryVectorAction ginv '' (↑bundle.normalizedFixedFunction.domain : Set + GaussianInt) ∧ (Finset.Nonempty bundle.normalizedFixed.cells → PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction ginv bundle.normalizedFixedFunction) = + Option.map (BandPackingSymmetrySlopeAction ginv bundle.normalizedFixed) + (PartialOdometerSlope bundle.normalizedFixedFunction))) → ( + let pFixedInv := BandPackingSymmetrySlopeAction ginv + bundle.normalizedFixed pFixed + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction ginv + bundle.normalizedFixedFunction) = some pFixedInv))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv pFixed hslopeFixed fixedCells hcovFixed pFixedInv + rw [hcovFixed.2.2 fixedCells, hslopeFixed] + rfl + +private theorem hslopeSelectedInv : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + ∀ (pSelected : ℝ × ℝ), (PartialOdometerSlope (bundle.functions bundle.selectedSlot + bundle.selectedSign) = some pSelected) → ((selectedSupport.cells.Nonempty) → + ((TileOdometer (BandPackingSymmetryCircleAction ginv + bundle.normalizedFixedCircle.1.1) (BandPackingSymmetryTileAction ginv + selectedSupport) (BandPackingSymmetryPartialOdometerAction ginv selectedFunction) ∧ + (↑(BandPackingSymmetryPartialOdometerAction ginv selectedFunction).domain : Set + GaussianInt) = BandPackingSymmetryVectorAction ginv '' (↑selectedFunction.domain : + Set GaussianInt) ∧ (Finset.Nonempty selectedSupport.cells → PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction ginv selectedFunction) = Option.map + (BandPackingSymmetrySlopeAction ginv selectedSupport) (PartialOdometerSlope + selectedFunction))) → ( + let pSelectedInv := BandPackingSymmetrySlopeAction ginv + selectedSupport pSelected + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction ginv selectedFunction) = + some pSelectedInv))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv selectedSupport selectedFunction pSelected hslopeSelected + selectedCells hcovSelected pSelectedInv + rw [hcovSelected.2.2 selectedCells, hslopeSelected] + rfl + +private theorem hOFixedOriginalAt1198 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), (∀ (T : ProtoTile), BandPackingSymmetryTileAction ginv + (BandPackingSymmetryTileAction bundle.symmetry T) = T) → ((∀ (h : PartialOdometer), + BandPackingSymmetryPartialOdometerAction ginv + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h) = h) → + ((BandPackingSymmetryCircleAction ginv bundle.normalizedFixedCircle.1.1 = Cᵢ.1.1) → + ((TileOdometer (BandPackingSymmetryCircleAction ginv + bundle.normalizedFixedCircle.1.1) (BandPackingSymmetryTileAction ginv + bundle.normalizedFixed) (BandPackingSymmetryPartialOdometerAction ginv + bundle.normalizedFixedFunction) ∧ (↑(BandPackingSymmetryPartialOdometerAction ginv + bundle.normalizedFixedFunction).domain : Set GaussianInt) = + BandPackingSymmetryVectorAction ginv '' (↑bundle.normalizedFixedFunction.domain : Set + GaussianInt) ∧ (Finset.Nonempty bundle.normalizedFixed.cells → PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction ginv bundle.normalizedFixedFunction) = + Option.map (BandPackingSymmetrySlopeAction ginv bundle.normalizedFixed) + (PartialOdometerSlope bundle.normalizedFixedFunction))) → (TileOdometer Cᵢ.1.1 Tᵢ + hᵢ)))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv htileL hfunL hinverseFixedCircleCoord hcovFixed + have h := hcovFixed.1 + change TileOdometer + (BandPackingSymmetryCircleAction ginv + bundle.normalizedFixedCircle.1.1) + (BandPackingSymmetryTileAction ginv bundle.normalizedFixed) + (BandPackingSymmetryPartialOdometerAction ginv + bundle.normalizedFixedFunction) at h + rw [hinverseFixedCircleCoord, bundle.normalized_fixed_eq, htileL, + bundle.normalized_fixed_function_eq, hfunL] at h + exact h + +private theorem hOSelectedOriginalAt1209 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + (BandPackingSymmetryCircleAction ginv bundle.normalizedFixedCircle.1.1 = Cᵢ.1.1) → + ((TileOdometer (BandPackingSymmetryCircleAction ginv + bundle.normalizedFixedCircle.1.1) (BandPackingSymmetryTileAction ginv + selectedSupport) (BandPackingSymmetryPartialOdometerAction ginv selectedFunction) ∧ + (↑(BandPackingSymmetryPartialOdometerAction ginv selectedFunction).domain : Set + GaussianInt) = BandPackingSymmetryVectorAction ginv '' (↑selectedFunction.domain : + Set GaussianInt) ∧ (Finset.Nonempty selectedSupport.cells → PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction ginv selectedFunction) = Option.map + (BandPackingSymmetrySlopeAction ginv selectedSupport) (PartialOdometerSlope + selectedFunction))) → (TileOdometer Cᵢ.1.1 T' h')) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv selectedSupport selectedFunction T' h' + hinverseFixedCircleCoord hcovSelected + have h := hcovSelected.1 + change TileOdometer + (BandPackingSymmetryCircleAction ginv + bundle.normalizedFixedCircle.1.1) + (BandPackingSymmetryTileAction ginv selectedSupport) + (BandPackingSymmetryPartialOdometerAction ginv selectedFunction) at h + simpa [hinverseFixedCircleCoord, T', h', bundle.normalized_fixed_eq] using h + +private theorem hleftInvAt1222 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + ∀ (pFixed : ℝ × ℝ), ∀ (pSelected : ℝ × ℝ), ∀ (v : GaussianInt), (Cᵢ.1.1.1 = 1) → + ((TileCentroid T' - TileCentroid Tᵢ = GaussianRealPoint + (BandPackingSymmetryVectorAction ginv v)) → (∀ (orientationInv : Bool), + (UnitTriangularStep orientationInv (BandPackingSymmetryVectorAction ginv v)) → + ((BandPackingSymmetrySlopeAction ginv selectedSupport pSelected - + BandPackingSymmetrySlopeAction ginv bundle.normalizedFixed pFixed = (CircleMatrix Cᵢ + 0 0 * (BandPackingSymmetryVectorAction ginv v).re + CircleMatrix Cᵢ 0 1 * + (BandPackingSymmetryVectorAction ginv v).im, CircleMatrix Cᵢ 1 0 * + (BandPackingSymmetryVectorAction ginv v).re + CircleMatrix Cᵢ 1 1 * + (BandPackingSymmetryVectorAction ginv v).im)) → ( + let pFixedInv := BandPackingSymmetrySlopeAction ginv + bundle.normalizedFixed pFixed + let pSelectedInv := BandPackingSymmetrySlopeAction ginv + selectedSupport pSelected + (TileOdometer Cᵢ.1.1 Tᵢ hᵢ) → ((TileOdometer Cᵢ.1.1 T' h') → ((PartialOdometerSlope hᵢ = + some pFixedInv) → ((PartialOdometerSlope h' = some pSelectedInv) → + (LeftLatticeAdjacent Cᵢ Tᵢ T' hᵢ h')))))))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv selectedSupport selectedFunction T' h' pFixed pSelected v + hinverseUnitCurv hcentUnitInv orientationInv hunitStepInv hdiffUnitInvFinal pFixedInv + pSelectedInv hOFixedOriginal hOSelectedOriginal hslopeFixedOriginal hslopeSelectedOriginal + refine ⟨hOFixedOriginal, hOSelectedOriginal, pFixedInv, pSelectedInv, + hslopeFixedOriginal, hslopeSelectedOriginal, ?_⟩ + left + refine ⟨hinverseUnitCurv, orientationInv, + BandPackingSymmetryVectorAction ginv v, hunitStepInv, + hcentUnitInv, ?_⟩ + have hdiff := hdiffUnitInvFinal + exact ⟨by simpa [pFixedInv, pSelectedInv] using congrArg Prod.fst hdiff, + by simpa [pFixedInv, pSelectedInv] using congrArg Prod.snd hdiff⟩ + +private theorem hOFixedq : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), (TileOdometer + bundle.normalizedFixedCircle.1.1 + bundle.normalizedFixed bundle.normalizedFixedFunction) → (∀ (qLeft : Fin (4 : ℕ) → + CircleCoordinates), (qLeft (0 : Fin (4 : ℕ)) = bundle.normalizedFixedCircle.1.1) → + (TileOdometer (qLeft 0) + bundle.normalizedFixed bundle.normalizedFixedFunction)) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hOFixed qLeft hqLeft0 + rw [hqLeft0] + exact hOFixed + +private theorem hOSelectedq : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + (TileOdometer bundle.normalizedFixedCircle.1.1 + (bundle.pieces bundle.selectedSlot bundle.selectedSign) (bundle.functions + bundle.selectedSlot bundle.selectedSign)) → (∀ (qLeft : Fin (4 : ℕ) → + CircleCoordinates), (qLeft (0 : Fin (4 : ℕ)) = bundle.normalizedFixedCircle.1.1) → + (TileOdometer (qLeft 0) selectedSupport + selectedFunction)) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle selectedSupport selectedFunction hOSelected qLeft hqLeft0 + rw [hqLeft0] + exact hOSelected + +private theorem hleftRootCoord : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), (∀ (C : CircleCoordinates), BandPackingSymmetryCircleAction + ginv (BandPackingSymmetryCircleAction bundle.symmetry C) = C) → (∀ (qLeft : Fin (4 : + ℕ) → CircleCoordinates), (qLeft (0 : Fin (4 : ℕ)) = bundle.normalizedFixedCircle.1.1) + → ((BandPackingSymmetryQuadrupleAction + ginv qLeft) 0 = Cᵢ.1.1)) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv hcircleL qLeft hqLeft0 + calc + (BandPackingSymmetryQuadrupleAction ginv qLeft) 0 = + BandPackingSymmetryCircleAction ginv (qLeft 0) := by + simp [BandPackingSymmetryQuadrupleAction] + _ = Cᵢ.1.1 := by + rw [hqLeft0, bundle.normalized_fixed_circle_eq] + exact hcircleL Cᵢ.1.1 + +private theorem hOFixedOriginalAt1264 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), (∀ (T : ProtoTile), BandPackingSymmetryTileAction ginv + (BandPackingSymmetryTileAction bundle.symmetry T) = T) → ((∀ (h : PartialOdometer), + BandPackingSymmetryPartialOdometerAction ginv + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h) = h) → (∀ (qLeft : Fin + (4 : ℕ) → CircleCoordinates), (TileOdometer (BandPackingSymmetryQuadrupleAction ginv + qLeft (0 : Fin (4 : ℕ))) (BandPackingSymmetryTileAction ginv bundle.normalizedFixed) + (BandPackingSymmetryPartialOdometerAction ginv bundle.normalizedFixedFunction)) → + (((BandPackingSymmetryQuadrupleAction ginv qLeft) 0 = Cᵢ.1.1) → (TileOdometer Cᵢ.1.1 + Tᵢ hᵢ)))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv htileL hfunL qLeft hOFixedInv hleftRootCoord + have h := hOFixedInv + change TileOdometer + ((BandPackingSymmetryQuadrupleAction ginv qLeft) 0) + (BandPackingSymmetryTileAction ginv bundle.normalizedFixed) + (BandPackingSymmetryPartialOdometerAction ginv + bundle.normalizedFixedFunction) at h + rw [hleftRootCoord, bundle.normalized_fixed_eq, htileL, + bundle.normalized_fixed_function_eq, hfunL] at h + exact h + +private theorem hOSelectedOriginalAt1274 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + ∀ (qLeft : Fin (4 : ℕ) → CircleCoordinates), (TileOdometer + (BandPackingSymmetryQuadrupleAction ginv qLeft (0 : Fin (4 : ℕ))) + (BandPackingSymmetryTileAction ginv selectedSupport) + (BandPackingSymmetryPartialOdometerAction ginv selectedFunction)) → + (((BandPackingSymmetryQuadrupleAction ginv qLeft) 0 = Cᵢ.1.1) → (TileOdometer Cᵢ.1.1 + T' h')) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv selectedSupport selectedFunction T' h' qLeft + hOSelectedInv hleftRootCoord + change TileOdometer + ((BandPackingSymmetryQuadrupleAction ginv qLeft) 0) + (BandPackingSymmetryTileAction ginv selectedSupport) + (BandPackingSymmetryPartialOdometerAction ginv selectedFunction) + at hOSelectedInv + simpa [hleftRootCoord, T', h'] using hOSelectedInv + +private theorem hleftInvAt1283 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), (∀ (T : ProtoTile), BandPackingSymmetryTileAction ginv + (BandPackingSymmetryTileAction bundle.symmetry T) = T) → ( + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + ∀ (qLeft : Fin (4 : ℕ) → CircleCoordinates), ∀ (jLeft : Fin (3 : ℕ)), ∀ (eLeft : Bool), + (ProperBandQuadruple qLeft) → (∀ (negative : Bool), ∀ (pFixedInv : ℝ × ℝ), ∀ + (pSelectedInv : ℝ × ℝ), (PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction ginv selectedFunction) = some pSelectedInv) + → ((TileCentroid (BandPackingSymmetryTileAction ginv selectedSupport) - TileCentroid + (BandPackingSymmetryTileAction ginv bundle.normalizedFixed) = (if (eLeft ^^ negative) + = true then (1 : ℝ) else (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 + (BandPackingSymmetryQuadrupleAction ginv qLeft (if + BandPackingSymmetryReversesOrientation ginv = true then -jLeft else jLeft).succ) + (BandPackingSymmetryQuadrupleAction ginv qLeft (0 : Fin (4 : ℕ))))) → + ((pSelectedInv.1 - pFixedInv.1 = (if (eLeft ^^ negative) = true then (1 : ℝ) else (-1 + : ℝ)) * (↑(BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv qLeft (if + BandPackingSymmetryReversesOrientation ginv = true then -jLeft else jLeft).succ) + (BandPackingSymmetryQuadrupleAction ginv qLeft (0 : Fin (4 : ℕ)))).re : ℝ)) → + ((pSelectedInv.2 - pFixedInv.2 = (if (eLeft ^^ negative) = true then (1 : ℝ) else (-1 + : ℝ)) * (↑(BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv qLeft (if + BandPackingSymmetryReversesOrientation ginv = true then -jLeft else jLeft).succ) + (BandPackingSymmetryQuadrupleAction ginv qLeft (0 : Fin (4 : ℕ)))).im : ℝ)) → + (((BandPackingSymmetryQuadrupleAction ginv qLeft) 0 = Cᵢ.1.1) → ((TileOdometer Cᵢ.1.1 + Tᵢ hᵢ) → ((TileOdometer Cᵢ.1.1 T' h') → ((PartialOdometerSlope hᵢ = some pFixedInv) → + (LeftLatticeAdjacent Cᵢ Tᵢ T' hᵢ h')))))))))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv htileL selectedSupport selectedFunction T' h' qLeft jLeft + eLeft hqLeft negative pFixedInv pSelectedInv hslopeSelectedInv hcentLeftInv hslopeLeftReInv + hslopeLeftImInv hleftRootCoord hOFixedOriginal hOSelectedOriginal hslopeFixedOriginal + refine ⟨hOFixedOriginal, hOSelectedOriginal, pFixedInv, pSelectedInv, + hslopeFixedOriginal, hslopeSelectedInv, ?_⟩ + · right + refine ⟨BandPackingSymmetryQuadrupleAction ginv qLeft, + (if BandPackingSymmetryReversesOrientation ginv then -jLeft else jLeft), + (eLeft ^^ negative), + BandPackingSymmetryProperCovariance ginv qLeft hqLeft, + hleftRootCoord, + (by simpa [T', bundle.normalized_fixed_eq, htileL] using hcentLeftInv), + hslopeLeftReInv, hslopeLeftImInv⟩ + +private theorem hparentPositiveAt1298 : + (by + classical + exact + ∀ (C' : BandCircle), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), (r + j.succ = C'.1.1) → (0 < (r j.succ).1) ) := by + classical + intro C' r j hrj + rw [hrj] + exact C'.property + +private theorem hOfixedAt1301 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (r : Fin (4 : ℕ) + → CircleCoordinates), (r (0 : Fin (4 : ℕ)) = bundle.normalizedFixedCircle.1.1) → + (TileOdometer (r 0) bundle.normalizedFixed + bundle.normalizedFixedFunction) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle r hr0 + rw [hr0] + exact bundle.normalized_fixed_odometer + +private theorem hOselectedAt1305 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (C' : + BandCircle), (C'.1.1 = bundle.normalizedPresentation bundle.selectedSlot.succ) → ( + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), (r j.succ = C'.1.1) → + (TileOdometer (r j.succ) selectedSupport selectedFunction)) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle C' hC' selectedSupport selectedFunction r j hrj + rw [hrj, hC'] + exact bundle.piece_odometer bundle.selectedSlot bundle.selectedSign + +private theorem hOFixedOriginalAt1322 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), (∀ (C : CircleCoordinates), BandPackingSymmetryCircleAction + ginv (BandPackingSymmetryCircleAction bundle.symmetry C) = C) → ((∀ (T : ProtoTile), + BandPackingSymmetryTileAction ginv (BandPackingSymmetryTileAction bundle.symmetry T) + = T) → ((∀ (h : PartialOdometer), BandPackingSymmetryPartialOdometerAction ginv + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h) = h) → (∀ (r : Fin (4 : + ℕ) → CircleCoordinates), (r (0 : Fin (4 : ℕ)) = bundle.normalizedFixedCircle.1.1) → + ((TileOdometer + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + (BandPackingSymmetryTileAction ginv bundle.normalizedFixed) + (BandPackingSymmetryPartialOdometerAction ginv bundle.normalizedFixedFunction)) → + (TileOdometer Cᵢ.1.1 Tᵢ hᵢ))))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv hcircleL htileL hfunL r hr0 hOFixedInv + simpa [BandPackingSymmetryQuadrupleAction, hr0, + bundle.normalized_fixed_circle_eq, bundle.normalized_fixed_eq, + bundle.normalized_fixed_function_eq, hcircleL, htileL, hfunL] + using hOFixedInv + +private theorem hselectedCoordAt1327 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), (0 < (r j.succ).1) → (∀ + (transportedRotation : Fin (4 : ℕ)), ∀ (C' : BandCircle), ∀ (selectedSlope : ℝ × ℝ), + ∀ (ginv : BandPackingSymmetry), + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + ∀ (hinverseProper : ProperBandQuadruple inversePresentation), ∀ (hinversePositive : 0 < + (inversePresentation inverseSlot.succ).1), + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + (inverseCircle.1.1 = BandPackingSymmetryCircleAction ginv C'.1.1) → ( + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + ∀ (t : Fin (4 : ℕ)), (r j.succ = C'.1.1) → ((TileCentroid (bundle.pieces + bundle.selectedSlot bundle.selectedSign) - TileCentroid bundle.normalizedFixed = (1 / + 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t : ℕ) * + (BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r j.succ)))) → ((selectedSlope.1 - bundle.normalizedFixedSlope.1 = (1 / 2 : ℝ) * + (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t : ℕ) * (BandVectors.2 + (r j.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r + j.succ)))).1) → ((selectedSlope.2 - bundle.normalizedFixedSlope.2 = (1 / 2 : ℝ) * + (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t : ℕ) * (BandVectors.2 + (r j.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r + j.succ)))).2) → ((bundle.normalizedPoint ∈ FootprintVertices (TileTranslation + bundle.normalizedRoot ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑transportedRotation : + ℕ) * if Even (↑transportedRotation : ℕ) then BandVectors.1 (normalizationPresentation + (0 : Fin (4 : ℕ))) (normalizationPresentation (sigma i).succ) else BandVectors.1 + (normalizationPresentation (sigma i).succ) (normalizationPresentation (0 : Fin (4 : + ℕ))))) ↔ bundle.normalizedPoint ∈ FootprintVertices (TileTranslation + bundle.normalizedFixed ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t : ℕ) * if Even (↑t : + ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r j.succ) else BandVectors.1 (r j.succ) + (r (0 : Fin (4 : ℕ)))))) → ((TileOdometer (r j.succ) selectedSupport + selectedFunction) → (∀ (pFixed : ℝ × ℝ), ∀ (pSelected : ℝ × ℝ), ∀ (t' : Fin (4 : ℕ)), + (TileOdometer (BandPackingSymmetryQuadrupleAction ginv r (if + BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) + (BandPackingSymmetryTileAction ginv selectedSupport) + (BandPackingSymmetryPartialOdometerAction ginv selectedFunction)) → ((TileCentroid + (BandPackingSymmetryTileAction ginv selectedSupport) - TileCentroid + (BandPackingSymmetryTileAction ginv bundle.normalizedFixed) = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t' : ℕ) * (BandVectors.1 + (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation + ginv = true then -j else j).succ) (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin + (4 : ℕ))) + BandVectors.1 (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : + ℕ))) (BandPackingSymmetryQuadrupleAction ginv r (if + BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ)))) → + ((pSelected.1 - pFixed.1 = (1 / 2 : ℝ) * (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑t' : ℕ) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv r + (if BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation + ginv = true then -j else j).succ)))).1) → ((pSelected.2 - pFixed.2 = (1 / 2 : ℝ) * + (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t' : ℕ) * + (BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv r (if + BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation + ginv = true then -j else j).succ)))).2) → ((BandPackingSymmetryQuadrupleAction ginv + r) (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ = + inverseCircle.1.1)))))))))))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma r j hparentPositive + transportedRotation C' selectedSlope ginv inversePresentation inverseSlot hinverseProper + hinversePositive inverseCircle hinverseCircle selectedSupport selectedFunction t hrj hcent + hslopeRe hslopeIm hmarked hOselected pFixed pSelected t' hOSelectedInv hcentInv hslopeReInv + hslopeImInv + have neg1 : -(1 : Fin 3) = 2 := rfl + have neg2 : -(2 : Fin 3) = 1 := rfl + calc + (BandPackingSymmetryQuadrupleAction ginv r) + (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ = + BandPackingSymmetryCircleAction ginv (r j.succ) := by + by_cases hrev : BandPackingSymmetryReversesOrientation ginv <;> + fin_cases j <;> + simp [BandPackingSymmetryQuadrupleAction, + hrev, neg1, neg2] + _ = BandPackingSymmetryCircleAction ginv C'.1.1 := + congrArg (BandPackingSymmetryCircleAction ginv) hrj + _ = inverseCircle.1.1 := hinverseCircle.symm + +private theorem hcentOriginalAt1348 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), (∀ (T : ProtoTile), BandPackingSymmetryTileAction ginv + (BandPackingSymmetryTileAction bundle.symmetry T) = T) → ( + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), ∀ (t' : Fin (4 : ℕ)), + (TileCentroid (BandPackingSymmetryTileAction ginv selectedSupport) - TileCentroid + (BandPackingSymmetryTileAction ginv bundle.normalizedFixed) = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t' : ℕ) * (BandVectors.1 + (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation + ginv = true then -j else j).succ) (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin + (4 : ℕ))) + BandVectors.1 (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : + ℕ))) (BandPackingSymmetryQuadrupleAction ginv r (if + BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ)))) → + (TileCentroid T' - TileCentroid Tᵢ = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : + GaussianInt) ^ t'.val * (BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv r) + (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ) + ((BandPackingSymmetryQuadrupleAction ginv r) 0) + BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv r) 0) ((BandPackingSymmetryQuadrupleAction + ginv r) (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ))))) ) + := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv htileL selectedSupport T' r j t' hcentInv + simpa [T', bundle.normalized_fixed_eq, htileL] using hcentInv + +private theorem hrootCoord : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), (∀ (C : CircleCoordinates), BandPackingSymmetryCircleAction + ginv (BandPackingSymmetryCircleAction bundle.symmetry C) = C) → (∀ (r : Fin (4 : ℕ) → + CircleCoordinates), (r (0 : Fin (4 : ℕ)) = bundle.normalizedFixedCircle.1.1) → + ((BandPackingSymmetryQuadrupleAction ginv + r) 0 = Cᵢ.1.1)) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv hcircleL r hr0 + calc + (BandPackingSymmetryQuadrupleAction ginv r) 0 = + BandPackingSymmetryCircleAction ginv (r 0) := by + simp [BandPackingSymmetryQuadrupleAction] + _ = BandPackingSymmetryCircleAction ginv + bundle.normalizedFixedCircle.1.1 := + congrArg (BandPackingSymmetryCircleAction ginv) hr0 + _ = Cᵢ.1.1 := by + rw [bundle.normalized_fixed_circle_eq] + exact hcircleL Cᵢ.1.1 + +private theorem hnewAdjAt1371 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + ∀ (hinverseProper : ProperBandQuadruple inversePresentation), ∀ (hinversePositive : 0 < + (inversePresentation inverseSlot.succ).1), + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), (ProperBandQuadruple r) → + (∀ (pFixed : ℝ × ℝ), ∀ (pSelected : ℝ × ℝ), ∀ (t' : Fin (4 : ℕ)), + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction ginv + selectedFunction) = some pSelected) → ((pSelected.1 - pFixed.1 = (1 / 2 : ℝ) * + (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t' : ℕ) * + (BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv r (if + BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation + ginv = true then -j else j).succ)))).1) → ((pSelected.2 - pFixed.2 = (1 / 2 : ℝ) * + (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t' : ℕ) * + (BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv r (if + BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation + ginv = true then -j else j).succ)))).2) → ((TileOdometer Cᵢ.1.1 Tᵢ hᵢ) → + (((BandPackingSymmetryQuadrupleAction ginv r) (if + BandPackingSymmetryReversesOrientation ginv then -j else j).succ = inverseCircle.1.1) + → ((TileOdometer inverseCircle.1.1 T' h') → ((PartialOdometerSlope hᵢ = some pFixed) + → ((TileCentroid T' - TileCentroid Tᵢ = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : + GaussianInt) ^ t'.val * (BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv r) + (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ) + ((BandPackingSymmetryQuadrupleAction ginv r) 0) + BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv r) 0) ((BandPackingSymmetryQuadrupleAction + ginv r) (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ)))) → + (((BandPackingSymmetryQuadrupleAction ginv r) 0 = Cᵢ.1.1) → (SubtileLatticeAdjacent + Cᵢ inverseCircle Tᵢ T' hᵢ h')))))))))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv inversePresentation inverseSlot hinverseProper + hinversePositive inverseCircle selectedSupport selectedFunction T' h' r j hr pFixed + pSelected t' hslopeSelectedInv hslopeReInv hslopeImInv hOFixedOriginal hselectedCoord + hOSelectedOriginal hslopeFixedOriginal hcentOriginal hrootCoord + refine ⟨hOFixedOriginal, hOSelectedOriginal, pFixed, pSelected, + hslopeFixedOriginal, hslopeSelectedInv, ?_⟩ + exact ⟨BandPackingSymmetryQuadrupleAction ginv r, + (if BandPackingSymmetryReversesOrientation ginv then -j else j), + t', BandPackingSymmetryProperCovariance ginv r hr, hrootCoord, + hselectedCoord, hcentOriginal, hslopeReInv, hslopeImInv⟩ + +private theorem hpointInvAt1389 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), (∀ (v : GaussianInt), BandPackingSymmetryVectorAction ginv + (BandPackingSymmetryVectorAction bundle.symmetry v) = v) → + ((BandPackingSymmetryVectorAction bundle.symmetry x = bundle.normalizedPoint) → + (BandPackingSymmetryVectorAction ginv bundle.normalizedPoint = x)) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv hvecL hpoint + rw [← hpoint] + exact hvecL x + +private theorem hmarkedOriginalAt1396 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + ∀ (delta : Bool), ∀ (transportedRotation : Fin (4 : ℕ)), + let oldUR := TileTranslation T₀ + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0))) + let rowUR := TileTranslation bundle.normalizedRoot + ((⟨0, 1⟩ : GaussianInt) ^ transportedRotation.val * + (if Even transportedRotation.val then + BandVectors.1 (normalizationPresentation 0) (normalizationPresentation (sigma i).succ) + else BandVectors.1 (normalizationPresentation (sigma i).succ) (normalizationPresentation + 0))) + (x ∈ FootprintVertices oldUR ↔ bundle.normalizedPoint ∈ FootprintVertices rowUR) → (∀ + (ginv : BandPackingSymmetry), (∀ (T : ProtoTile), BandPackingSymmetryTileAction ginv + (BandPackingSymmetryTileAction bundle.symmetry T) = T) → (∀ (r : Fin (4 : ℕ) → + CircleCoordinates), ∀ (j : Fin (3 : ℕ)), ∀ (t : Fin (4 : ℕ)), (bundle.normalizedPoint + ∈ FootprintVertices (TileTranslation bundle.normalizedRoot ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑transportedRotation : ℕ) * if Even (↑transportedRotation : ℕ) then + BandVectors.1 (normalizationPresentation (0 : Fin (4 : ℕ))) + (normalizationPresentation (sigma i).succ) else BandVectors.1 + (normalizationPresentation (sigma i).succ) (normalizationPresentation (0 : Fin (4 : + ℕ))))) ↔ bundle.normalizedPoint ∈ FootprintVertices (TileTranslation + bundle.normalizedFixed ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t : ℕ) * if Even (↑t : + ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r j.succ) else BandVectors.1 (r j.succ) + (r (0 : Fin (4 : ℕ)))))) → (∀ (t' : Fin (4 : ℕ)), (t' = if + BandPackingSymmetryReversesOrientation ginv = true then -t - (1 : Fin (4 : ℕ)) + if + delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else t + if delta = true + then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ))) → ( + (BandPackingSymmetryVectorAction ginv bundle.normalizedPoint = x) → + ((bundle.normalizedPoint ∈ FootprintVertices (TileTranslation bundle.normalizedFixed + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t : ℕ) * if Even (↑t : ℕ) then BandVectors.1 + (r (0 : Fin (4 : ℕ))) (r j.succ) else BandVectors.1 (r j.succ) (r (0 : Fin (4 : + ℕ))))) ↔ BandPackingSymmetryVectorAction ginv bundle.normalizedPoint ∈ + FootprintVertices (TileTranslation (BandPackingSymmetryTileAction ginv + bundle.normalizedFixed) ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑(if + BandPackingSymmetryReversesOrientation ginv = true then -t - (1 : Fin (4 : ℕ)) + if + delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else t + if delta = true + then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ))) : ℕ) * if Even (↑(if + BandPackingSymmetryReversesOrientation ginv = true then -t - (1 : Fin (4 : ℕ)) + if + delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else t + if delta = true + then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ))) : ℕ) then BandVectors.1 + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction ginv r ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation ginv = true then -j else j) j).succ) else + BandVectors.1 (BandPackingSymmetryQuadrupleAction ginv r ((fun (j : Fin (3 : ℕ)) => + if BandPackingSymmetryReversesOrientation ginv = true then -j else j) j).succ) + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ)))))) → (x ∈ + FootprintVertices oldUR ↔ x ∈ FootprintVertices (TileTranslation Tᵢ ((⟨0, 1⟩ : + GaussianInt) ^ t'.val * (if Even t'.val then BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv r) 0) ((BandPackingSymmetryQuadrupleAction + ginv r) (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ) else + BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv r) (if + BandPackingSymmetryReversesOrientation ginv then -j else j).succ) + ((BandPackingSymmetryQuadrupleAction ginv r) 0)))))))))) ) := by + classical + intro C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma delta + transportedRotation oldUR rowUR hmarkedOld ginv htileL r j t hmarked t' ht' hpointInv hmarkCov + let companionForward := TileTranslation bundle.normalizedFixed + ((⟨0, 1⟩ : GaussianInt) ^ t.val * + (if Even t.val then BandVectors.1 (r 0) (r j.succ) + else BandVectors.1 (r j.succ) (r 0))) + calc + x ∈ FootprintVertices oldUR ↔ + bundle.normalizedPoint ∈ FootprintVertices rowUR := hmarkedOld + _ ↔ bundle.normalizedPoint ∈ FootprintVertices companionForward := by + simpa [rowUR, companionForward] using hmarked + _ ↔ BandPackingSymmetryVectorAction ginv bundle.normalizedPoint ∈ + FootprintVertices + (TileTranslation (BandPackingSymmetryTileAction ginv + bundle.normalizedFixed) + ((⟨0, 1⟩ : GaussianInt) ^ t'.val * + (if Even t'.val then + BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv r) 0) + ((BandPackingSymmetryQuadrupleAction ginv r) + (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ) + else BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv r) + (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ) + ((BandPackingSymmetryQuadrupleAction ginv r) 0)))) := by + simpa [companionForward, ht'] using hmarkCov + _ ↔ x ∈ FootprintVertices + (TileTranslation Tᵢ + ((⟨0, 1⟩ : GaussianInt) ^ t'.val * + (if Even t'.val then + BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv r) 0) + ((BandPackingSymmetryQuadrupleAction ginv r) + (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ) + else BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv r) + (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ) + ((BandPackingSymmetryQuadrupleAction ginv r) 0)))) := by + rw [hpointInv, bundle.normalized_fixed_eq, htileL] + +private theorem hparentPositiveAt1447 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (r : Fin (4 : ℕ) + → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), (r j.succ = + bundle.normalizedFixedCircle.1.1) → (0 < (r + j.succ).1) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle r j hrj + rw [hrj] + exact bundle.normalizedFixedCircle.property + +private theorem hOselectedAt1450 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (C' : + BandCircle), (C'.1.1 = bundle.normalizedPresentation bundle.selectedSlot.succ) → ( + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), (r (0 : Fin (4 : ℕ)) = C'.1.1) → (TileOdometer + (r 0) selectedSupport selectedFunction)) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle C' hC' selectedSupport selectedFunction r hr0 + rw [hr0, hC'] + exact bundle.piece_odometer bundle.selectedSlot bundle.selectedSign + +private theorem hOfixedAt1453 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (r : Fin (4 : ℕ) + → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), (r j.succ = + bundle.normalizedFixedCircle.1.1) → + (TileOdometer (r j.succ) bundle.normalizedFixed bundle.normalizedFixedFunction) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle r j hrj + rw [hrj] + exact bundle.normalized_fixed_odometer + +private theorem hselectedCoordAt1468 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (C' : + BandCircle), ∀ (ginv : BandPackingSymmetry), + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + ∀ (hinverseProper : ProperBandQuadruple inversePresentation), ∀ (hinversePositive : 0 < + (inversePresentation inverseSlot.succ).1), + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + (inverseCircle.1.1 = BandPackingSymmetryCircleAction ginv C'.1.1) → (∀ (r : Fin (4 : ℕ) → + CircleCoordinates), (r (0 : Fin (4 : ℕ)) = C'.1.1) → + ((BandPackingSymmetryQuadrupleAction ginv r) 0 = inverseCircle.1.1)) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle C' ginv inversePresentation inverseSlot hinverseProper + hinversePositive inverseCircle hinverseCircle r hr0 + calc + (BandPackingSymmetryQuadrupleAction ginv r) 0 = + BandPackingSymmetryCircleAction ginv (r 0) := by + simp [BandPackingSymmetryQuadrupleAction] + _ = BandPackingSymmetryCircleAction ginv C'.1.1 := + congrArg (BandPackingSymmetryCircleAction ginv) hr0 + _ = inverseCircle.1.1 := hinverseCircle.symm + +private theorem hfixedCoord : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), (0 < (r j.succ).1) → (∀ + (transportedRotation : Fin (4 : ℕ)), ∀ (selectedSlope : ℝ × ℝ), ∀ (ginv : + BandPackingSymmetry), (∀ (C : CircleCoordinates), BandPackingSymmetryCircleAction + ginv (BandPackingSymmetryCircleAction bundle.symmetry C) = C) → ( + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + ∀ (t : Fin (4 : ℕ)), (r j.succ = bundle.normalizedFixedCircle.1.1) → ((TileCentroid + bundle.normalizedFixed - TileCentroid + (bundle.pieces bundle.selectedSlot bundle.selectedSign) = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t : ℕ) * (BandVectors.1 (r + j.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r j.succ)))) → + ((bundle.normalizedFixedSlope.1 - selectedSlope.1 = (1 / 2 : ℝ) * (GaussianRealPoint + ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t : ℕ) * (BandVectors.2 (r j.succ) (r (0 : + Fin (4 : ℕ))) + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ)))).1) → + ((bundle.normalizedFixedSlope.2 - selectedSlope.2 = (1 / 2 : ℝ) * (GaussianRealPoint + ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t : ℕ) * (BandVectors.2 (r j.succ) (r (0 : + Fin (4 : ℕ))) + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ)))).2) → + ((bundle.normalizedPoint ∈ FootprintVertices (TileTranslation bundle.normalizedRoot + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑transportedRotation : ℕ) * if Even + (↑transportedRotation : ℕ) then BandVectors.1 (normalizationPresentation (0 : Fin (4 + : ℕ))) (normalizationPresentation (sigma i).succ) else BandVectors.1 + (normalizationPresentation (sigma i).succ) (normalizationPresentation (0 : Fin (4 : + ℕ))))) ↔ bundle.normalizedPoint ∈ FootprintVertices (TileTranslation (bundle.pieces + bundle.selectedSlot bundle.selectedSign) ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t : + ℕ) * if Even (↑t : ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r j.succ) else + BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ)))))) → ((TileOdometer (r j.succ) + bundle.normalizedFixed bundle.normalizedFixedFunction) → (∀ (pSelected : ℝ × ℝ), ∀ + (pFixed : ℝ × ℝ), ∀ (t' : Fin (4 : ℕ)), (TileOdometer + (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation + ginv = true then -j else j).succ) (BandPackingSymmetryTileAction ginv + bundle.normalizedFixed) (BandPackingSymmetryPartialOdometerAction ginv + bundle.normalizedFixedFunction)) → ((TileCentroid (BandPackingSymmetryTileAction ginv + bundle.normalizedFixed) - TileCentroid (BandPackingSymmetryTileAction ginv + selectedSupport) = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑t' : ℕ) * (BandVectors.1 (BandPackingSymmetryQuadrupleAction ginv r + (if BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + BandVectors.1 + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation + ginv = true then -j else j).succ)))) → ((pFixed.1 - pSelected.1 = (1 / 2 : ℝ) * + (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t' : ℕ) * + (BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv r (if + BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation + ginv = true then -j else j).succ)))).1) → ((pFixed.2 - pSelected.2 = (1 / 2 : ℝ) * + (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t' : ℕ) * + (BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv r (if + BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation + ginv = true then -j else j).succ)))).2) → ((BandPackingSymmetryQuadrupleAction ginv + r) (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ = + Cᵢ.1.1)))))))))))) ) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma r j hparentPositive + transportedRotation selectedSlope ginv hcircleL selectedSupport t hrj hcent hslopeRe + hslopeIm hmarked hOfixed pSelected pFixed t' hOFixedInv hcentInv hslopeReInv hslopeImInv + have neg1 : -(1 : Fin 3) = 2 := rfl + have neg2 : -(2 : Fin 3) = 1 := rfl + calc + (BandPackingSymmetryQuadrupleAction ginv r) + (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ = + BandPackingSymmetryCircleAction ginv (r j.succ) := by + by_cases hrev : BandPackingSymmetryReversesOrientation ginv <;> + fin_cases j <;> + simp [BandPackingSymmetryQuadrupleAction, + hrev, neg1, neg2] + _ = BandPackingSymmetryCircleAction ginv bundle.normalizedFixedCircle.1.1 := + congrArg (BandPackingSymmetryCircleAction ginv) hrj + _ = Cᵢ.1.1 := by + rw [bundle.normalized_fixed_circle_eq] + exact hcircleL Cᵢ.1.1 + +private theorem hOFixedOriginalAt1498 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), (∀ (T : ProtoTile), BandPackingSymmetryTileAction ginv + (BandPackingSymmetryTileAction bundle.symmetry T) = T) → ((∀ (h : PartialOdometer), + BandPackingSymmetryPartialOdometerAction ginv + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h) = h) → (∀ (r : Fin (4 : + ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), (TileOdometer + (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation + ginv = true then -j else j).succ) (BandPackingSymmetryTileAction ginv + bundle.normalizedFixed) (BandPackingSymmetryPartialOdometerAction ginv + bundle.normalizedFixedFunction)) → (((BandPackingSymmetryQuadrupleAction ginv r) (if + BandPackingSymmetryReversesOrientation ginv then -j else j).succ = Cᵢ.1.1) → + (TileOdometer Cᵢ.1.1 Tᵢ hᵢ)))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv htileL hfunL r j hOFixedInv hfixedCoord + have h := hOFixedInv + change TileOdometer + ((BandPackingSymmetryQuadrupleAction ginv r) + (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ) + (BandPackingSymmetryTileAction ginv bundle.normalizedFixed) + (BandPackingSymmetryPartialOdometerAction ginv bundle.normalizedFixedFunction) at h + rw [hfixedCoord, bundle.normalized_fixed_eq, htileL, + bundle.normalized_fixed_function_eq, hfunL] at h + exact h + +private theorem hcentOriginalAt1510 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), (∀ (T : ProtoTile), BandPackingSymmetryTileAction ginv + (BandPackingSymmetryTileAction bundle.symmetry T) = T) → ( + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), ∀ (t' : Fin (4 : ℕ)), + (TileCentroid (BandPackingSymmetryTileAction ginv bundle.normalizedFixed) - + TileCentroid (BandPackingSymmetryTileAction ginv selectedSupport) = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t' : ℕ) * (BandVectors.1 + (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation + ginv = true then -j else j).succ) (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin + (4 : ℕ))) + BandVectors.1 (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : + ℕ))) (BandPackingSymmetryQuadrupleAction ginv r (if + BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ)))) → + (TileCentroid Tᵢ - TileCentroid T' = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : + GaussianInt) ^ t'.val * (BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv r) + (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ) + ((BandPackingSymmetryQuadrupleAction ginv r) 0) + BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv r) 0) ((BandPackingSymmetryQuadrupleAction + ginv r) (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ))))) ) + := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv htileL selectedSupport T' r j t' hcentInv + simpa [T', bundle.normalized_fixed_eq, htileL] using hcentInv + +private theorem hnewAdjAt1521 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + ∀ (hinverseProper : ProperBandQuadruple inversePresentation), ∀ (hinversePositive : 0 < + (inversePresentation inverseSlot.succ).1), + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), (ProperBandQuadruple r) → + (∀ (pSelected : ℝ × ℝ), ∀ (pFixed : ℝ × ℝ), ∀ (t' : Fin (4 : ℕ)), + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction ginv + selectedFunction) = some pSelected) → ((pFixed.1 - pSelected.1 = (1 / 2 : ℝ) * + (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t' : ℕ) * + (BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv r (if + BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation + ginv = true then -j else j).succ)))).1) → ((pFixed.2 - pSelected.2 = (1 / 2 : ℝ) * + (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t' : ℕ) * + (BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv r (if + BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation + ginv = true then -j else j).succ)))).2) → (((BandPackingSymmetryQuadrupleAction ginv + r) 0 = inverseCircle.1.1) → (((BandPackingSymmetryQuadrupleAction ginv r) (if + BandPackingSymmetryReversesOrientation ginv then -j else j).succ = Cᵢ.1.1) → + ((TileOdometer inverseCircle.1.1 T' h') → ((TileOdometer Cᵢ.1.1 Tᵢ hᵢ) → + ((PartialOdometerSlope hᵢ = some pFixed) → ((TileCentroid Tᵢ - TileCentroid T' = (1 / + 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ t'.val * (BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv r) (if + BandPackingSymmetryReversesOrientation ginv then -j else j).succ) + ((BandPackingSymmetryQuadrupleAction ginv r) 0) + BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv r) 0) ((BandPackingSymmetryQuadrupleAction + ginv r) (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ)))) → + (SubtileLatticeAdjacent inverseCircle Cᵢ T' Tᵢ h' hᵢ)))))))))) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv inversePresentation inverseSlot hinverseProper + hinversePositive inverseCircle selectedSupport selectedFunction T' h' r j hr pSelected + pFixed t' hslopeSelectedInv hslopeReInv hslopeImInv hselectedCoord hfixedCoord + hOSelectedOriginal hOFixedOriginal hslopeFixedOriginal hcentOriginal + refine ⟨hOSelectedOriginal, hOFixedOriginal, pSelected, pFixed, + hslopeSelectedInv, hslopeFixedOriginal, ?_⟩ + exact ⟨BandPackingSymmetryQuadrupleAction ginv r, + (if BandPackingSymmetryReversesOrientation ginv then -j else j), + t', BandPackingSymmetryProperCovariance ginv r hr, + hselectedCoord, hfixedCoord, hcentOriginal, hslopeReInv, hslopeImInv⟩ + +private theorem hpointInvAt1538 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : + BandPackingSymmetry), (∀ (v : GaussianInt), BandPackingSymmetryVectorAction ginv + (BandPackingSymmetryVectorAction bundle.symmetry v) = v) → + ((BandPackingSymmetryVectorAction bundle.symmetry x = bundle.normalizedPoint) → + (BandPackingSymmetryVectorAction ginv bundle.normalizedPoint = x)) ) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv hvecL hpoint + rw [← hpoint] + exact hvecL x + +private theorem hmarkedOriginalAt1545 : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + ∀ (delta : Bool), ∀ (transportedRotation : Fin (4 : ℕ)), + let oldUR := TileTranslation T₀ + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0))) + let rowUR := TileTranslation bundle.normalizedRoot + ((⟨0, 1⟩ : GaussianInt) ^ transportedRotation.val * + (if Even transportedRotation.val then + BandVectors.1 (normalizationPresentation 0) (normalizationPresentation (sigma i).succ) + else BandVectors.1 (normalizationPresentation (sigma i).succ) (normalizationPresentation + 0))) + (x ∈ FootprintVertices oldUR ↔ bundle.normalizedPoint ∈ FootprintVertices rowUR) → (∀ + (ginv : BandPackingSymmetry), + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), ∀ (t : Fin (4 : ℕ)), + (bundle.normalizedPoint ∈ FootprintVertices (TileTranslation bundle.normalizedRoot + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑transportedRotation : ℕ) * if Even + (↑transportedRotation : ℕ) then BandVectors.1 (normalizationPresentation (0 : Fin (4 + : ℕ))) (normalizationPresentation (sigma i).succ) else BandVectors.1 + (normalizationPresentation (sigma i).succ) (normalizationPresentation (0 : Fin (4 : + ℕ))))) ↔ bundle.normalizedPoint ∈ FootprintVertices (TileTranslation (bundle.pieces + bundle.selectedSlot bundle.selectedSign) ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t : + ℕ) * if Even (↑t : ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r j.succ) else + BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ)))))) → (∀ (t' : Fin (4 : ℕ)), (t' = if + BandPackingSymmetryReversesOrientation ginv = true then -t - (1 : Fin (4 : ℕ)) + if + delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else t + if delta = true + then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ))) → ( + (BandPackingSymmetryVectorAction ginv bundle.normalizedPoint = x) → + ((bundle.normalizedPoint ∈ FootprintVertices (TileTranslation selectedSupport ((⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t : ℕ) * if Even (↑t : ℕ) then BandVectors.1 (r (0 : + Fin (4 : ℕ))) (r j.succ) else BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))))) ↔ + BandPackingSymmetryVectorAction ginv bundle.normalizedPoint ∈ FootprintVertices + (TileTranslation (BandPackingSymmetryTileAction ginv selectedSupport) ((⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ^ (↑(if BandPackingSymmetryReversesOrientation ginv = true then + -t - (1 : Fin (4 : ℕ)) + if delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : + ℕ)) else t + if delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ))) : ℕ) * if + Even (↑(if BandPackingSymmetryReversesOrientation ginv = true then -t - (1 : Fin (4 : + ℕ)) + if delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else t + if delta + = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ))) : ℕ) then BandVectors.1 + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction ginv r ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation ginv = true then -j else j) j).succ) else + BandVectors.1 (BandPackingSymmetryQuadrupleAction ginv r ((fun (j : Fin (3 : ℕ)) => + if BandPackingSymmetryReversesOrientation ginv = true then -j else j) j).succ) + (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ)))))) → (x ∈ + FootprintVertices oldUR ↔ x ∈ FootprintVertices (TileTranslation T' ((⟨0, 1⟩ : + GaussianInt) ^ t'.val * (if Even t'.val then BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv r) 0) ((BandPackingSymmetryQuadrupleAction + ginv r) (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ) else + BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv r) (if + BandPackingSymmetryReversesOrientation ginv then -j else j).succ) + ((BandPackingSymmetryQuadrupleAction ginv r) 0))))))))) ) := by + classical + intro C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma delta + transportedRotation oldUR rowUR hmarkedOld ginv selectedSupport T' r j t hmarked t' ht' + hpointInv hmarkCov + let companionReverse := TileTranslation selectedSupport + ((⟨0, 1⟩ : GaussianInt) ^ t.val * + (if Even t.val then BandVectors.1 (r 0) (r j.succ) + else BandVectors.1 (r j.succ) (r 0))) + calc + x ∈ FootprintVertices oldUR ↔ + bundle.normalizedPoint ∈ FootprintVertices rowUR := hmarkedOld + _ ↔ bundle.normalizedPoint ∈ FootprintVertices companionReverse := by + simpa [rowUR, companionReverse] using hmarked + _ ↔ BandPackingSymmetryVectorAction ginv bundle.normalizedPoint ∈ + FootprintVertices + (TileTranslation (BandPackingSymmetryTileAction ginv selectedSupport) + ((⟨0, 1⟩ : GaussianInt) ^ t'.val * + (if Even t'.val then + BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv r) 0) + ((BandPackingSymmetryQuadrupleAction ginv r) + (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ) + else BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv r) + (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ) + ((BandPackingSymmetryQuadrupleAction ginv r) 0)))) := by + simpa [companionReverse, ht'] using hmarkCov + _ ↔ x ∈ FootprintVertices + (TileTranslation T' + ((⟨0, 1⟩ : GaussianInt) ^ t'.val * + (if Even t'.val then + BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv r) 0) + ((BandPackingSymmetryQuadrupleAction ginv r) + (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ) + else BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv r) + (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ) + ((BandPackingSymmetryQuadrupleAction ginv r) 0)))) := by + rw [hpointInv] + +end MarkedAdjacencyGeometry + +namespace MarkedAdjacencyConclusions + +private theorem leftAdjacencyCase : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + ∀ (transportedRotation : Fin (4 : ℕ)), + let oldUR := TileTranslation T₀ + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0))) + (x ∈ FootprintVertices (TileTranslation T₀ ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) + * if Even (↑s : ℕ) then BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) else + BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) ↔ bundle.normalizedPoint ∈ + FootprintVertices (TileTranslation bundle.normalizedRoot ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑transportedRotation : ℕ) * if Even (↑transportedRotation : ℕ) then + BandVectors.1 (BandPackingSymmetryQuadrupleAction bundle.symmetry q (0 : Fin (4 : + ℕ))) (BandPackingSymmetryQuadrupleAction bundle.symmetry q ((fun (j : Fin (3 : ℕ)) => + if BandPackingSymmetryReversesOrientation bundle.symmetry = true then -j else j) + i).succ) else BandVectors.1 (BandPackingSymmetryQuadrupleAction bundle.symmetry q + ((fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation bundle.symmetry + = true then -j else j) i).succ) (BandPackingSymmetryQuadrupleAction bundle.symmetry q + (0 : Fin (4 : ℕ)))))) → (∀ (C' : BandCircle), ∀ (selectedSlope : ℝ × ℝ), + (PartialOdometerSlope (bundle.functions bundle.selectedSlot bundle.selectedSign) = + some selectedSlope) → (∀ (ginv : BandPackingSymmetry), (∀ (C : CircleCoordinates), + BandPackingSymmetryCircleAction ginv (BandPackingSymmetryCircleAction bundle.symmetry + C) = C) → ((∀ (T : ProtoTile), BandPackingSymmetryTileAction ginv + (BandPackingSymmetryTileAction bundle.symmetry T) = T) → ((∀ (h : PartialOdometer), + BandPackingSymmetryPartialOdometerAction ginv + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h) = h) → ((∀ (g : + BandPackingSymmetry), ∀ (c : CircleCoordinates), (BandPackingSymmetryCircleAction g + c).1 = c.1) → ( + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + ∀ (hinverseProper : ProperBandQuadruple inversePresentation), ∀ (hinversePositive : (0 : + ℤ) < (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation (if + BandPackingSymmetryReversesOrientation ginv = true then -bundle.selectedSlot else + bundle.selectedSlot).succ).1), + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + (inverseCircle.1.1 = BandPackingSymmetryCircleAction ginv C'.1.1) → ( + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + (C' = bundle.normalizedFixedCircle ∧ LeftLatticeAdjacent bundle.normalizedFixedCircle + bundle.normalizedFixed (bundle.pieces bundle.selectedSlot bundle.selectedSign) + bundle.normalizedFixedFunction (bundle.functions bundle.selectedSlot + bundle.selectedSign) ∧ bundle.normalizedPoint ∉ FootprintVertices (TileTranslation + bundle.normalizedRoot ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑transportedRotation : + ℕ) * if Even (↑transportedRotation : ℕ) then BandVectors.1 (normalizationPresentation + (0 : Fin (4 : ℕ))) (normalizationPresentation (sigma i).succ) else BandVectors.1 + (normalizationPresentation (sigma i).succ) (normalizationPresentation (0 : Fin (4 : + ℕ)))))) → (((inverseCircle = Cᵢ ∧ LeftLatticeAdjacent Cᵢ Tᵢ T' hᵢ h' ∧ x ∉ + FootprintVertices oldUR) ∨ (∃ (a₀ a' : ℝ × ℝ) (r : Fin 4 → CircleCoordinates) (j : + Fin 3) (t : Fin 4), PartialOdometerSlope hᵢ = some a₀ ∧ PartialOdometerSlope h' = + some a' ∧ ProperBandQuadruple r ∧ r 0 = Cᵢ.1.1 ∧ r j.succ = inverseCircle.1.1 ∧ + TileCentroid T' - TileCentroid Tᵢ = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : + GaussianInt) ^ t.val * (BandVectors.1 (r j.succ) (r 0) + BandVectors.1 (r 0) (r + j.succ))) ∧ a'.1 - a₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : GaussianInt) ^ + t.val * (BandVectors.2 (r j.succ) (r 0) + BandVectors.2 (r 0) (r j.succ)))).1 ∧ a'.2 + - a₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : GaussianInt) ^ t.val * + (BandVectors.2 (r j.succ) (r 0) + BandVectors.2 (r 0) (r j.succ)))).2 ∧ + SubtileLatticeAdjacent Cᵢ inverseCircle Tᵢ T' hᵢ h' ∧ (x ∈ FootprintVertices oldUR ↔ + x ∈ FootprintVertices (TileTranslation Tᵢ ((⟨0, 1⟩ : GaussianInt) ^ t.val * (if Even + t.val then BandVectors.1 (r 0) (r j.succ) else BandVectors.1 (r j.succ) (r 0)))))) ∨ + (∃ (a₀ aᵢ : ℝ × ℝ) (r : Fin 4 → CircleCoordinates) (j : Fin 3) (t : Fin 4), + PartialOdometerSlope h' = some a₀ ∧ PartialOdometerSlope hᵢ = some aᵢ ∧ + ProperBandQuadruple r ∧ r 0 = inverseCircle.1.1 ∧ r j.succ = Cᵢ.1.1 ∧ TileCentroid Tᵢ + - TileCentroid T' = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ t.val * + (BandVectors.1 (r j.succ) (r 0) + BandVectors.1 (r 0) (r j.succ))) ∧ aᵢ.1 - a₀.1 = + ((1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : GaussianInt) ^ t.val * (BandVectors.2 (r + j.succ) (r 0) + BandVectors.2 (r 0) (r j.succ)))).1 ∧ aᵢ.2 - a₀.2 = ((1 / 2 : ℝ) • + GaussianRealPoint ((-⟨0, 1⟩ : GaussianInt) ^ t.val * (BandVectors.2 (r j.succ) (r 0) + + BandVectors.2 (r 0) (r j.succ)))).2 ∧ SubtileLatticeAdjacent inverseCircle Cᵢ T' Tᵢ + h' hᵢ ∧ (x ∈ FootprintVertices oldUR ↔ x ∈ FootprintVertices (TileTranslation T' + ((⟨0, 1⟩ : GaussianInt) ^ t.val * (if Even t.val then BandVectors.1 (r 0) (r j.succ) + else BandVectors.1 (r j.succ) (r 0))))))))))))))) ) := by + classical + intro C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma transportedRotation + oldUR hmarkedOld C' selectedSlope hslope' ginv hcircleL htileL hfunL actionCurvature + inversePresentation inverseSlot hinverseProper hinversePositive inverseCircle + hinverseCircle selectedSupport selectedFunction T' h' hleft + rcases hleft with ⟨hCfixed, hleftAdj, hnotMarked⟩ + have hinverseCircleFixed := MarkedAdjacencyGeometry.hinverseCircleFixed C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x + bundle C' ginv hcircleL hinverseProper hinversePositive hinverseCircle hCfixed + have hnotOriginal := MarkedAdjacencyGeometry.hnotOriginal C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x bundle + transportedRotation hmarkedOld hnotMarked + rcases hleftAdj with ⟨hOFixed, hOSelected, pFixed, pSelected, + hslopeFixed, hslopeSelected, hleftGeometry⟩ + have hpFixedEq := MarkedAdjacencyGeometry.hpFixedEq C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle pFixed + hslopeFixed + have hpSelectedEq := MarkedAdjacencyGeometry.hpSelectedEq C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle + selectedSlope hslope' pSelected hslopeSelected + rcases hleftGeometry with hunit | hpresented + · rcases hunit with ⟨hcurvUnit, orientation, v, hunitStep, + hcentUnit, hslopeUnitRe, hslopeUnitIm⟩ + have centroidCov := MarkedAdjacencyGeometry.centroidCov + have hinverseUnitCurv := MarkedAdjacencyGeometry.hinverseUnitCurv C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x + bundle actionCurvature hcurvUnit + have hcentUnitInv := MarkedAdjacencyGeometry.hcentUnitInv C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv + htileL v hcentUnit centroidCov + let unitPositive := + ({1, -1, ⟨0, 1⟩, -⟨0, 1⟩, 1 + ⟨0, 1⟩, + -(1 + ⟨0, 1⟩)} : Finset GaussianInt) + let unitNegative := + ({1, -1, ⟨0, 1⟩, -⟨0, 1⟩, -1 + ⟨0, 1⟩, + -(-1 + ⟨0, 1⟩)} : Finset GaussianInt) + let matrixVector (c : CircleCoordinates) (w : GaussianInt) : ℝ × ℝ := + (((1 + (c.2.re : ℝ)) * (w.re : ℝ) + + (c.2.im : ℝ) * (w.im : ℝ)) / 2, + ((c.2.im : ℝ) * (w.re : ℝ) + + (1 - (c.2.re : ℝ)) * (w.im : ℝ)) / 2) + let slopeDifferenceAction : BandPackingSymmetry → GaussianInt → + (ℝ × ℝ) → ℝ × ℝ := + BandPackingSymmetry.rec + (fun _ d => d) + (fun _ d => (-d.2, d.1)) + (fun _ d => (-d.1, d.2)) + (fun z w d => + (d.1 + (z.re : ℝ) * (w.re : ℝ) + (z.im : ℝ) * (w.im : ℝ), + d.2 + (z.im : ℝ) * (w.re : ℝ) - (z.re : ℝ) * (w.im : ℝ))) + (fun a b iha ihb w d => + iha (BandPackingSymmetryVectorAction b w) (ihb w d)) + have matrixCov := MarkedAdjacencyGeometry.matrixCov actionCurvature + have slopeDiffCov := MarkedAdjacencyGeometry.slopeDiffCov actionCurvature centroidCov + matrixCov + have hinverseFixedCircleCoord := MarkedAdjacencyGeometry.hinverseFixedCircleCoord C₀ Cᵢ + T₀ Tᵢ h₀ hᵢ x bundle ginv hcircleL + have hmatrix00 := MarkedAdjacencyGeometry.hmatrix00 + have hmatrix01 := MarkedAdjacencyGeometry.hmatrix01 + have hmatrix10 := MarkedAdjacencyGeometry.hmatrix10 + have hmatrix11 := MarkedAdjacencyGeometry.hmatrix11 + have hdiffUnit := MarkedAdjacencyGeometry.hdiffUnit C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle pFixed + pSelected hcurvUnit v hslopeUnitRe hslopeUnitIm hmatrix00 hmatrix01 hmatrix10 + hmatrix11 + have hinverseUnitStep := (MarkedAdjacencyGeometry.unitStepCov) ginv orientation v + hunitStep + rcases hinverseUnitStep with ⟨orientationInv, hunitStepInv⟩ + have hdiffUnitInv := slopeDiffCov ginv + bundle.normalizedFixedCircle.1.1 bundle.normalizedFixed selectedSupport + pFixed pSelected v hcurvUnit hcentUnit hdiffUnit + have hmatrixInv0 : + CircleMatrix Cᵢ 0 0 = + (1 + ((Cᵢ.1.1.2).re : ℝ)) / 2 := + hmatrix00 Cᵢ hinverseUnitCurv + have hmatrixInv1 : + CircleMatrix Cᵢ 0 1 = ((Cᵢ.1.1.2).im : ℝ) / 2 := + hmatrix01 Cᵢ hinverseUnitCurv + have hmatrixInv2 : + CircleMatrix Cᵢ 1 0 = ((Cᵢ.1.1.2).im : ℝ) / 2 := + hmatrix10 Cᵢ hinverseUnitCurv + have hmatrixInv3 : + CircleMatrix Cᵢ 1 1 = + (1 - ((Cᵢ.1.1.2).re : ℝ)) / 2 := + hmatrix11 Cᵢ hinverseUnitCurv + have hcovFixed := BandPackingSymmetryTileOdometerCovariance ginv + bundle.normalizedFixedCircle.1.1 bundle.normalizedFixed + bundle.normalizedFixedFunction hOFixed + have hcovSelected := BandPackingSymmetryTileOdometerCovariance ginv + bundle.normalizedFixedCircle.1.1 selectedSupport selectedFunction hOSelected + let pFixedInv := BandPackingSymmetrySlopeAction ginv + bundle.normalizedFixed pFixed + let pSelectedInv := BandPackingSymmetrySlopeAction ginv + selectedSupport pSelected + have hslopeFixedInv : + PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction ginv + bundle.normalizedFixedFunction) = some pFixedInv := + MarkedAdjacencyGeometry.hslopeFixedInv C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv pFixed + hslopeFixed (MarkedAdjacencyGeometry.fixedCells C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle + hOFixed pFixed hslopeFixed) hcovFixed + have hslopeSelectedInv : + PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction ginv selectedFunction) = + some pSelectedInv := MarkedAdjacencyGeometry.hslopeSelectedInv C₀ Cᵢ T₀ Tᵢ h₀ hᵢ + x bundle ginv pSelected hslopeSelected (MarkedAdjacencyGeometry.selectedCells + C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hOSelected pSelected hslopeSelected) hcovSelected + have hOFixedOriginal := MarkedAdjacencyGeometry.hOFixedOriginalAt1198 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x + bundle ginv htileL hfunL hinverseFixedCircleCoord hcovFixed + have hOSelectedOriginal := MarkedAdjacencyGeometry.hOSelectedOriginalAt1209 C₀ Cᵢ T₀ Tᵢ + h₀ hᵢ x bundle ginv hinverseFixedCircleCoord hcovSelected + have hslopeFixedOriginal : PartialOdometerSlope hᵢ = some pFixedInv := by + simpa [bundle.normalized_fixed_function_eq, hfunL] using hslopeFixedInv + have hslopeSelectedOriginal : PartialOdometerSlope h' = some pSelectedInv := by + simpa [h', hfunL] using hslopeSelectedInv + have hleftInv := MarkedAdjacencyGeometry.hleftInvAt1222 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv + pFixed pSelected v hinverseUnitCurv hcentUnitInv orientationInv hunitStepInv + (MarkedAdjacencyGeometry.hdiffUnitInvFinal C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv pFixed + pSelected v hinverseFixedCircleCoord (MarkedAdjacencyGeometry.hdiffUnitInv' C₀ Cᵢ T₀ + Tᵢ h₀ hᵢ x bundle ginv pFixed pSelected hcurvUnit v matrixCov hdiffUnitInv) + (MarkedAdjacencyGeometry.htargetMatrix Cᵢ ginv v hmatrixInv0 hmatrixInv1 hmatrixInv2 + hmatrixInv3)) hOFixedOriginal hOSelectedOriginal hslopeFixedOriginal + hslopeSelectedOriginal + exact Or.inl ⟨hinverseCircleFixed, hleftInv, hnotOriginal⟩ + · rcases hpresented with + ⟨qLeft, jLeft, eLeft, hqLeft, hqLeft0, + hcentLeft, hslopeLeftRe, hslopeLeftIm⟩ + have hleftTransport := + LeftLatticeAdjacentPackingSymmetryTransport ginv qLeft hqLeft + jLeft eLeft bundle.normalizedFixed selectedSupport + bundle.normalizedFixedFunction selectedFunction pFixed pSelected + (MarkedAdjacencyGeometry.hOFixedq C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hOFixed qLeft hqLeft0) + (MarkedAdjacencyGeometry.hOSelectedq C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hOSelected qLeft + hqLeft0) hslopeFixed hslopeSelected hcentLeft + hslopeLeftRe hslopeLeftIm + dsimp at hleftTransport + rcases hleftTransport with + ⟨negative, pFixedInv, pSelectedInv, hphaseLeft, + hOFixedInv, hOSelectedInv, hslopeFixedInv, hslopeSelectedInv, + hcentLeftInv, hslopeLeftReInv, hslopeLeftImInv, hcompatLeft⟩ + have hleftRootCoord := MarkedAdjacencyGeometry.hleftRootCoord C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle + ginv hcircleL qLeft hqLeft0 + have hOFixedOriginal := MarkedAdjacencyGeometry.hOFixedOriginalAt1264 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x + bundle ginv htileL hfunL qLeft hOFixedInv hleftRootCoord + have hOSelectedOriginal := MarkedAdjacencyGeometry.hOSelectedOriginalAt1274 C₀ Cᵢ T₀ Tᵢ + h₀ hᵢ x bundle ginv qLeft hOSelectedInv hleftRootCoord + have hslopeFixedOriginal : PartialOdometerSlope hᵢ = some pFixedInv := by + simpa [bundle.normalized_fixed_function_eq, hfunL] using hslopeFixedInv + have hleftInv := MarkedAdjacencyGeometry.hleftInvAt1283 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv + htileL qLeft jLeft eLeft hqLeft negative pFixedInv pSelectedInv hslopeSelectedInv + hcentLeftInv hslopeLeftReInv hslopeLeftImInv hleftRootCoord hOFixedOriginal + hOSelectedOriginal hslopeFixedOriginal + exact Or.inl ⟨hinverseCircleFixed, hleftInv, hnotOriginal⟩ + +private theorem forwardAdjacencyCase : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + ((∀ (g : BandPackingSymmetry), ∀ (C : CircleCoordinates), ∀ (C' : CircleCoordinates), ∀ + (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : + PartialOdometer), TileSubodometer C C' T T' h h' ↔ TileSubodometer + (BandPackingSymmetryCircleAction g C) (BandPackingSymmetryCircleAction g C') + (BandPackingSymmetryTileAction g T) (BandPackingSymmetryTileAction g T') + (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g h')) ∧ (∀ (g : BandPackingSymmetry), ∀ (x + : GaussianInt), ∀ (T : ProtoTile), ∀ (U : ProtoTile), (∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ T.cells ∨ LatticeVertexIncidentCell x j ∈ U.cells) ↔ + ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell (BandPackingSymmetryVectorAction g x) + j ∈ (BandPackingSymmetryTileAction g T).cells ∨ LatticeVertexIncidentCell + (BandPackingSymmetryVectorAction g x) j ∈ (BandPackingSymmetryTileAction g U).cells) + ∧ ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q → ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (delta : Bool), + BandPackingSymmetryScopedPhase g q delta → ∀ (T : ProtoTile), ∀ (x : GaussianInt), + let q' := BandPackingSymmetryQuadrupleAction g q; + let sigma := fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true + then -j else j; + let s' := if BandPackingSymmetryReversesOrientation g = true then -s - (1 : Fin (4 : ℕ)) + + if delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else s + if delta = + true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)); + let oldRight := TileTranslation T ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if + Even (↑s : ℕ) then BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) else BandVectors.1 + (q i.succ) (q (0 : Fin (4 : ℕ)))); + let newRight := TileTranslation (BandPackingSymmetryTileAction g T) ((⟨(0 : ℤ), (1 : ℤ)⟩ + : GaussianInt) ^ (↑s' : ℕ) * if Even (↑s' : ℕ) then BandVectors.1 (q' (0 : Fin (4 : + ℕ))) (q' (sigma i).succ) else BandVectors.1 (q' (sigma i).succ) (q' (0 : Fin (4 : + ℕ)))); BandPackingSymmetryTileAction g oldRight = newRight ∧ (x ∈ FootprintVertices + oldRight ↔ BandPackingSymmetryVectorAction g x ∈ FootprintVertices newRight)) → ( + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + ∀ (transportedRotation : Fin (4 : ℕ)), + let oldUR := TileTranslation T₀ + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0))) + (x ∈ FootprintVertices (TileTranslation T₀ ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) + * if Even (↑s : ℕ) then BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) else + BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) ↔ bundle.normalizedPoint ∈ + FootprintVertices (TileTranslation bundle.normalizedRoot ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑transportedRotation : ℕ) * if Even (↑transportedRotation : ℕ) then + BandVectors.1 (BandPackingSymmetryQuadrupleAction bundle.symmetry q (0 : Fin (4 : + ℕ))) (BandPackingSymmetryQuadrupleAction bundle.symmetry q ((fun (j : Fin (3 : ℕ)) => + if BandPackingSymmetryReversesOrientation bundle.symmetry = true then -j else j) + i).succ) else BandVectors.1 (BandPackingSymmetryQuadrupleAction bundle.symmetry q + ((fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation bundle.symmetry + = true then -j else j) i).succ) (BandPackingSymmetryQuadrupleAction bundle.symmetry q + (0 : Fin (4 : ℕ)))))) → (∀ (C' : BandCircle), ∀ (selectedSlope : ℝ × ℝ), (C'.1.1 = + bundle.normalizedPresentation bundle.selectedSlot.succ) → ((PartialOdometerSlope + (bundle.functions bundle.selectedSlot bundle.selectedSign) = some selectedSlope) → (∀ + (ginv : BandPackingSymmetry), (∀ (C : CircleCoordinates), + BandPackingSymmetryCircleAction ginv (BandPackingSymmetryCircleAction bundle.symmetry + C) = C) → ((∀ (T : ProtoTile), BandPackingSymmetryTileAction ginv + (BandPackingSymmetryTileAction bundle.symmetry T) = T) → ((∀ (v : GaussianInt), + BandPackingSymmetryVectorAction ginv (BandPackingSymmetryVectorAction bundle.symmetry + v) = v) → ((∀ (h : PartialOdometer), BandPackingSymmetryPartialOdometerAction ginv + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h) = h) → ( + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + ∀ (hinverseProper : ProperBandQuadruple inversePresentation), ∀ (hinversePositive : (0 : + ℤ) < (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation (if + BandPackingSymmetryReversesOrientation ginv = true then -bundle.selectedSlot else + bundle.selectedSlot).succ).1), + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + (inverseCircle.1.1 = BandPackingSymmetryCircleAction ginv C'.1.1) → ( + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + (BandPackingSymmetryVectorAction bundle.symmetry x = bundle.normalizedPoint) → ((∃ (q : + Fin (4 : ℕ) → CircleCoordinates) (j : Fin (3 : ℕ)) (t : Fin (4 : ℕ)), + ProperBandQuadruple q ∧ q (0 : Fin (4 : ℕ)) = bundle.normalizedFixedCircle.1.1 ∧ q + j.succ = C'.1.1 ∧ TileCentroid + (bundle.pieces bundle.selectedSlot bundle.selectedSign) - TileCentroid + bundle.normalizedFixed = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑t : ℕ) * (BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q j.succ))) ∧ selectedSlope.1 - + bundle.normalizedFixedSlope.1 = (1 / 2 : ℝ) * (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt)) ^ (↑t : ℕ) * (BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ)))).1 ∧ selectedSlope.2 - + bundle.normalizedFixedSlope.2 = (1 / 2 : ℝ) * (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt)) ^ (↑t : ℕ) * (BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ)))).2 ∧ SubtileLatticeAdjacent + bundle.normalizedFixedCircle C' bundle.normalizedFixed (bundle.pieces + bundle.selectedSlot bundle.selectedSign) bundle.normalizedFixedFunction + (bundle.functions bundle.selectedSlot bundle.selectedSign) ∧ (bundle.normalizedPoint + ∈ FootprintVertices (TileTranslation bundle.normalizedRoot ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑transportedRotation : ℕ) * if Even (↑transportedRotation : ℕ) then + BandVectors.1 (normalizationPresentation (0 : Fin (4 : ℕ))) + (normalizationPresentation (sigma i).succ) else BandVectors.1 + (normalizationPresentation (sigma i).succ) (normalizationPresentation (0 : Fin (4 : + ℕ))))) ↔ bundle.normalizedPoint ∈ FootprintVertices (TileTranslation + bundle.normalizedFixed ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t : ℕ) * if Even (↑t : + ℕ) then BandVectors.1 (q (0 : Fin (4 : ℕ))) (q j.succ) else BandVectors.1 (q j.succ) + (q (0 : Fin (4 : ℕ))))))) → (((inverseCircle = Cᵢ ∧ LeftLatticeAdjacent Cᵢ Tᵢ T' hᵢ + h' ∧ x ∉ FootprintVertices oldUR) ∨ (∃ (a₀ a' : ℝ × ℝ) (r : Fin 4 → + CircleCoordinates) (j : Fin 3) (t : Fin 4), PartialOdometerSlope hᵢ = some a₀ ∧ + PartialOdometerSlope h' = some a' ∧ ProperBandQuadruple r ∧ r 0 = Cᵢ.1.1 ∧ r j.succ = + inverseCircle.1.1 ∧ TileCentroid T' - TileCentroid Tᵢ = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ t.val * (BandVectors.1 (r j.succ) (r 0) + + BandVectors.1 (r 0) (r j.succ))) ∧ a'.1 - a₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ t.val * (BandVectors.2 (r j.succ) (r 0) + BandVectors.2 (r + 0) (r j.succ)))).1 ∧ a'.2 - a₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : + GaussianInt) ^ t.val * (BandVectors.2 (r j.succ) (r 0) + BandVectors.2 (r 0) (r + j.succ)))).2 ∧ SubtileLatticeAdjacent Cᵢ inverseCircle Tᵢ T' hᵢ h' ∧ (x ∈ + FootprintVertices oldUR ↔ x ∈ FootprintVertices (TileTranslation Tᵢ ((⟨0, 1⟩ : + GaussianInt) ^ t.val * (if Even t.val then BandVectors.1 (r 0) (r j.succ) else + BandVectors.1 (r j.succ) (r 0)))))) ∨ (∃ (a₀ aᵢ : ℝ × ℝ) (r : Fin 4 → + CircleCoordinates) (j : Fin 3) (t : Fin 4), PartialOdometerSlope h' = some a₀ ∧ + PartialOdometerSlope hᵢ = some aᵢ ∧ ProperBandQuadruple r ∧ r 0 = inverseCircle.1.1 ∧ + r j.succ = Cᵢ.1.1 ∧ TileCentroid Tᵢ - TileCentroid T' = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ t.val * (BandVectors.1 (r j.succ) (r 0) + + BandVectors.1 (r 0) (r j.succ))) ∧ aᵢ.1 - a₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ t.val * (BandVectors.2 (r j.succ) (r 0) + BandVectors.2 (r + 0) (r j.succ)))).1 ∧ aᵢ.2 - a₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : + GaussianInt) ^ t.val * (BandVectors.2 (r j.succ) (r 0) + BandVectors.2 (r 0) (r + j.succ)))).2 ∧ SubtileLatticeAdjacent inverseCircle Cᵢ T' Tᵢ h' hᵢ ∧ (x ∈ + FootprintVertices oldUR ↔ x ∈ FootprintVertices (TileTranslation T' ((⟨0, 1⟩ : + GaussianInt) ^ t.val * (if Even t.val then BandVectors.1 (r 0) (r j.succ) else + BandVectors.1 (r j.succ) (r 0)))))))))))))))))) ) := by + classical + intro C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x bundle g sigma markedData normalizationPresentation + transportedRotation oldUR hmarkedOld C' selectedSlope hC' hslope' ginv hcircleL htileL + hvecL hfunL inversePresentation inverseSlot hinverseProper hinversePositive inverseCircle + hinverseCircle selectedSupport selectedFunction T' h' hpoint hforward + rcases hforward with + ⟨r, j, t, hr, hr0, hrj, hcent, hslopeRe, hslopeIm, + hadj, hmarked⟩ + have hparentPositive := MarkedAdjacencyGeometry.hparentPositiveAt1298 C' r j hrj + have hOfixed := MarkedAdjacencyGeometry.hOfixedAt1301 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle r hr0 + have hOselected := MarkedAdjacencyGeometry.hOselectedAt1305 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle C' + hC' r j hrj + have inverseAdjacency := + SubtileLatticeAdjacentPackingSymmetryTransport ginv r hr j t + hparentPositive bundle.normalizedFixed selectedSupport + bundle.normalizedFixedFunction selectedFunction + bundle.normalizedFixedSlope selectedSlope + hOfixed hOselected + bundle.normalized_fixed_slope hslope' + hcent hslopeRe hslopeIm + dsimp at inverseAdjacency + rcases inverseAdjacency with + ⟨delta, pFixed, pSelected, t', hphaseInv, ht', + hOFixedInv, hOSelectedInv, hslopeFixedInv, hslopeSelectedInv, + hcentInv, hslopeReInv, hslopeImInv, hcompat⟩ + have hOFixedOriginal := MarkedAdjacencyGeometry.hOFixedOriginalAt1322 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x + bundle ginv hcircleL htileL hfunL r hr0 hOFixedInv + have hselectedCoord : + (BandPackingSymmetryQuadrupleAction ginv r) + (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ = + inverseCircle.1.1 := MarkedAdjacencyGeometry.hselectedCoordAt1327 C₀ Cᵢ q i T₀ Tᵢ + h₀ hᵢ x bundle r j hparentPositive transportedRotation C' selectedSlope ginv + hinverseProper hinversePositive hinverseCircle t hrj hcent hslopeRe hslopeIm + hmarked hOselected pFixed pSelected t' hOSelectedInv hcentInv hslopeReInv + hslopeImInv + have hOSelectedOriginal : TileOdometer inverseCircle.1.1 T' h' := by + simpa [hselectedCoord, h', T'] using hOSelectedInv + have hslopeFixedOriginal : PartialOdometerSlope hᵢ = some pFixed := by + simpa [bundle.normalized_fixed_function_eq, hfunL] using hslopeFixedInv + have hcentOriginal := MarkedAdjacencyGeometry.hcentOriginalAt1348 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x + bundle ginv htileL r j t' hcentInv + have hrootCoord := MarkedAdjacencyGeometry.hrootCoord C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv + hcircleL r hr0 + have hnewAdj := MarkedAdjacencyGeometry.hnewAdjAt1371 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv + hinverseProper hinversePositive r j hr pFixed pSelected t' hslopeSelectedInv + hslopeReInv hslopeImInv hOFixedOriginal hselectedCoord hOSelectedOriginal + hslopeFixedOriginal hcentOriginal hrootCoord + refine Or.inr (Or.inl ⟨pFixed, pSelected, + BandPackingSymmetryQuadrupleAction ginv r, + (if BandPackingSymmetryReversesOrientation ginv then -j else j), + t', hslopeFixedOriginal, hslopeSelectedInv, + BandPackingSymmetryProperCovariance ginv r hr, hrootCoord, + hselectedCoord, hcentOriginal, hslopeReInv, hslopeImInv, + hnewAdj, ?_⟩) + let companionForward := TileTranslation bundle.normalizedFixed + ((⟨0, 1⟩ : GaussianInt) ^ t.val * + (if Even t.val then BandVectors.1 (r 0) (r j.succ) + else BandVectors.1 (r j.succ) (r 0))) + have hpointInv := MarkedAdjacencyGeometry.hpointInvAt1389 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv + hvecL hpoint + have hmarkCov := + (markedData.2.2 ginv r hr j t delta hphaseInv + bundle.normalizedFixed bundle.normalizedPoint).2 + have hmarkedOriginal := MarkedAdjacencyGeometry.hmarkedOriginalAt1396 C₀ Cᵢ q i s T₀ Tᵢ h₀ + hᵢ x bundle delta transportedRotation hmarkedOld ginv htileL r j t hmarked t' ht' + hpointInv hmarkCov + exact hmarkedOriginal + +private theorem reverseAdjacencyCase : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : + Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : + PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + ((∀ (g : BandPackingSymmetry), ∀ (C : CircleCoordinates), ∀ (C' : CircleCoordinates), ∀ + (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : + PartialOdometer), TileSubodometer C C' T T' h h' ↔ TileSubodometer + (BandPackingSymmetryCircleAction g C) (BandPackingSymmetryCircleAction g C') + (BandPackingSymmetryTileAction g T) (BandPackingSymmetryTileAction g T') + (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g h')) ∧ (∀ (g : BandPackingSymmetry), ∀ (x + : GaussianInt), ∀ (T : ProtoTile), ∀ (U : ProtoTile), (∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ T.cells ∨ LatticeVertexIncidentCell x j ∈ U.cells) ↔ + ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell (BandPackingSymmetryVectorAction g x) + j ∈ (BandPackingSymmetryTileAction g T).cells ∨ LatticeVertexIncidentCell + (BandPackingSymmetryVectorAction g x) j ∈ (BandPackingSymmetryTileAction g U).cells) + ∧ ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q → ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (delta : Bool), + BandPackingSymmetryScopedPhase g q delta → ∀ (T : ProtoTile), ∀ (x : GaussianInt), + let q' := BandPackingSymmetryQuadrupleAction g q; + let sigma := fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true + then -j else j; + let s' := if BandPackingSymmetryReversesOrientation g = true then -s - (1 : Fin (4 : ℕ)) + + if delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else s + if delta = + true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)); + let oldRight := TileTranslation T ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if + Even (↑s : ℕ) then BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) else BandVectors.1 + (q i.succ) (q (0 : Fin (4 : ℕ)))); + let newRight := TileTranslation (BandPackingSymmetryTileAction g T) ((⟨(0 : ℤ), (1 : ℤ)⟩ + : GaussianInt) ^ (↑s' : ℕ) * if Even (↑s' : ℕ) then BandVectors.1 (q' (0 : Fin (4 : + ℕ))) (q' (sigma i).succ) else BandVectors.1 (q' (sigma i).succ) (q' (0 : Fin (4 : + ℕ)))); BandPackingSymmetryTileAction g oldRight = newRight ∧ (x ∈ FootprintVertices + oldRight ↔ BandPackingSymmetryVectorAction g x ∈ FootprintVertices newRight)) → ( + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + ∀ (transportedRotation : Fin (4 : ℕ)), + let oldUR := TileTranslation T₀ + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0))) + (x ∈ FootprintVertices (TileTranslation T₀ ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) + * if Even (↑s : ℕ) then BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) else + BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) ↔ bundle.normalizedPoint ∈ + FootprintVertices (TileTranslation bundle.normalizedRoot ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑transportedRotation : ℕ) * if Even (↑transportedRotation : ℕ) then + BandVectors.1 (BandPackingSymmetryQuadrupleAction bundle.symmetry q (0 : Fin (4 : + ℕ))) (BandPackingSymmetryQuadrupleAction bundle.symmetry q ((fun (j : Fin (3 : ℕ)) => + if BandPackingSymmetryReversesOrientation bundle.symmetry = true then -j else j) + i).succ) else BandVectors.1 (BandPackingSymmetryQuadrupleAction bundle.symmetry q + ((fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation bundle.symmetry + = true then -j else j) i).succ) (BandPackingSymmetryQuadrupleAction bundle.symmetry q + (0 : Fin (4 : ℕ)))))) → (∀ (C' : BandCircle), ∀ (selectedSlope : ℝ × ℝ), (C'.1.1 = + bundle.normalizedPresentation bundle.selectedSlot.succ) → ((PartialOdometerSlope + (bundle.functions bundle.selectedSlot bundle.selectedSign) = some selectedSlope) → (∀ + (ginv : BandPackingSymmetry), (∀ (C : CircleCoordinates), + BandPackingSymmetryCircleAction ginv (BandPackingSymmetryCircleAction bundle.symmetry + C) = C) → ((∀ (T : ProtoTile), BandPackingSymmetryTileAction ginv + (BandPackingSymmetryTileAction bundle.symmetry T) = T) → ((∀ (v : GaussianInt), + BandPackingSymmetryVectorAction ginv (BandPackingSymmetryVectorAction bundle.symmetry + v) = v) → ((∀ (h : PartialOdometer), BandPackingSymmetryPartialOdometerAction ginv + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h) = h) → ( + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + ∀ (hinverseProper : ProperBandQuadruple inversePresentation), ∀ (hinversePositive : (0 : + ℤ) < (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation (if + BandPackingSymmetryReversesOrientation ginv = true then -bundle.selectedSlot else + bundle.selectedSlot).succ).1), + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + (inverseCircle.1.1 = BandPackingSymmetryCircleAction ginv C'.1.1) → ( + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + (BandPackingSymmetryVectorAction bundle.symmetry x = bundle.normalizedPoint) → ((∃ (q : + Fin (4 : ℕ) → CircleCoordinates) (j : Fin (3 : ℕ)) (t : Fin (4 : ℕ)), + ProperBandQuadruple q ∧ q (0 : Fin (4 : ℕ)) = C'.1.1 ∧ q j.succ = + bundle.normalizedFixedCircle.1.1 ∧ + TileCentroid bundle.normalizedFixed - TileCentroid (bundle.pieces bundle.selectedSlot + bundle.selectedSign) = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑t : ℕ) * (BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q j.succ))) ∧ bundle.normalizedFixedSlope.1 - + selectedSlope.1 = (1 / 2 : ℝ) * (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑t : ℕ) * (BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ)))).1 ∧ bundle.normalizedFixedSlope.2 - + selectedSlope.2 = (1 / 2 : ℝ) * (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑t : ℕ) * (BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ)))).2 ∧ SubtileLatticeAdjacent C' + bundle.normalizedFixedCircle (bundle.pieces bundle.selectedSlot bundle.selectedSign) + bundle.normalizedFixed (bundle.functions bundle.selectedSlot bundle.selectedSign) + bundle.normalizedFixedFunction ∧ (bundle.normalizedPoint ∈ FootprintVertices + (TileTranslation bundle.normalizedRoot ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ + (↑transportedRotation : ℕ) * if Even (↑transportedRotation : ℕ) then BandVectors.1 + (normalizationPresentation (0 : Fin (4 : ℕ))) (normalizationPresentation (sigma + i).succ) else BandVectors.1 (normalizationPresentation (sigma i).succ) + (normalizationPresentation (0 : Fin (4 : ℕ))))) ↔ bundle.normalizedPoint ∈ + FootprintVertices (TileTranslation (bundle.pieces bundle.selectedSlot + bundle.selectedSign) ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t : ℕ) * if Even (↑t : + ℕ) then BandVectors.1 (q (0 : Fin (4 : ℕ))) (q j.succ) else BandVectors.1 (q j.succ) + (q (0 : Fin (4 : ℕ))))))) → (((inverseCircle = Cᵢ ∧ LeftLatticeAdjacent Cᵢ Tᵢ T' hᵢ + h' ∧ x ∉ FootprintVertices oldUR) ∨ (∃ (a₀ a' : ℝ × ℝ) (r : Fin 4 → + CircleCoordinates) (j : Fin 3) (t : Fin 4), PartialOdometerSlope hᵢ = some a₀ ∧ + PartialOdometerSlope h' = some a' ∧ ProperBandQuadruple r ∧ r 0 = Cᵢ.1.1 ∧ r j.succ = + inverseCircle.1.1 ∧ TileCentroid T' - TileCentroid Tᵢ = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ t.val * (BandVectors.1 (r j.succ) (r 0) + + BandVectors.1 (r 0) (r j.succ))) ∧ a'.1 - a₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ t.val * (BandVectors.2 (r j.succ) (r 0) + BandVectors.2 (r + 0) (r j.succ)))).1 ∧ a'.2 - a₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : + GaussianInt) ^ t.val * (BandVectors.2 (r j.succ) (r 0) + BandVectors.2 (r 0) (r + j.succ)))).2 ∧ SubtileLatticeAdjacent Cᵢ inverseCircle Tᵢ T' hᵢ h' ∧ (x ∈ + FootprintVertices oldUR ↔ x ∈ FootprintVertices (TileTranslation Tᵢ ((⟨0, 1⟩ : + GaussianInt) ^ t.val * (if Even t.val then BandVectors.1 (r 0) (r j.succ) else + BandVectors.1 (r j.succ) (r 0)))))) ∨ (∃ (a₀ aᵢ : ℝ × ℝ) (r : Fin 4 → + CircleCoordinates) (j : Fin 3) (t : Fin 4), PartialOdometerSlope h' = some a₀ ∧ + PartialOdometerSlope hᵢ = some aᵢ ∧ ProperBandQuadruple r ∧ r 0 = inverseCircle.1.1 ∧ + r j.succ = Cᵢ.1.1 ∧ TileCentroid Tᵢ - TileCentroid T' = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ t.val * (BandVectors.1 (r j.succ) (r 0) + + BandVectors.1 (r 0) (r j.succ))) ∧ aᵢ.1 - a₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ t.val * (BandVectors.2 (r j.succ) (r 0) + BandVectors.2 (r + 0) (r j.succ)))).1 ∧ aᵢ.2 - a₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : + GaussianInt) ^ t.val * (BandVectors.2 (r j.succ) (r 0) + BandVectors.2 (r 0) (r + j.succ)))).2 ∧ SubtileLatticeAdjacent inverseCircle Cᵢ T' Tᵢ h' hᵢ ∧ (x ∈ + FootprintVertices oldUR ↔ x ∈ FootprintVertices (TileTranslation T' ((⟨0, 1⟩ : + GaussianInt) ^ t.val * (if Even t.val then BandVectors.1 (r 0) (r j.succ) else + BandVectors.1 (r j.succ) (r 0)))))))))))))))))) ) := by + classical + intro C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x bundle g sigma markedData normalizationPresentation + transportedRotation oldUR hmarkedOld C' selectedSlope hC' hslope' ginv hcircleL htileL + hvecL hfunL inversePresentation inverseSlot hinverseProper hinversePositive inverseCircle + hinverseCircle selectedSupport selectedFunction T' h' hpoint hreverse + rcases hreverse with + ⟨r, j, t, hr, hr0, hrj, hcent, hslopeRe, hslopeIm, + hadj, hmarked⟩ + have hparentPositive := MarkedAdjacencyGeometry.hparentPositiveAt1447 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x + bundle r j hrj + have hOselected := MarkedAdjacencyGeometry.hOselectedAt1450 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle C' + hC' r hr0 + have hOfixed := MarkedAdjacencyGeometry.hOfixedAt1453 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle r j hrj + have inverseAdjacency := + SubtileLatticeAdjacentPackingSymmetryTransport ginv r hr j t + hparentPositive selectedSupport bundle.normalizedFixed + selectedFunction bundle.normalizedFixedFunction selectedSlope + bundle.normalizedFixedSlope hOselected hOfixed hslope' + bundle.normalized_fixed_slope hcent hslopeRe hslopeIm + dsimp at inverseAdjacency + rcases inverseAdjacency with + ⟨delta, pSelected, pFixed, t', hphaseInv, ht', + hOSelectedInv, hOFixedInv, hslopeSelectedInv, hslopeFixedInv, + hcentInv, hslopeReInv, hslopeImInv, hcompat⟩ + have hselectedCoord : + (BandPackingSymmetryQuadrupleAction ginv r) 0 = inverseCircle.1.1 := + MarkedAdjacencyGeometry.hselectedCoordAt1468 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle C' ginv + hinverseProper hinversePositive hinverseCircle r hr0 + have hfixedCoord := MarkedAdjacencyGeometry.hfixedCoord C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle r j + hparentPositive transportedRotation selectedSlope ginv hcircleL t hrj hcent hslopeRe + hslopeIm hmarked hOfixed pSelected pFixed t' hOFixedInv hcentInv hslopeReInv hslopeImInv + have hOSelectedOriginal : TileOdometer inverseCircle.1.1 T' h' := by + simpa [hselectedCoord, T', h'] using hOSelectedInv + have hOFixedOriginal := MarkedAdjacencyGeometry.hOFixedOriginalAt1498 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x + bundle ginv htileL hfunL r j hOFixedInv hfixedCoord + have hslopeFixedOriginal : PartialOdometerSlope hᵢ = some pFixed := by + simpa [bundle.normalized_fixed_function_eq, hfunL] using hslopeFixedInv + have hcentOriginal := MarkedAdjacencyGeometry.hcentOriginalAt1510 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x + bundle ginv htileL r j t' hcentInv + have hnewAdj := MarkedAdjacencyGeometry.hnewAdjAt1521 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv + hinverseProper hinversePositive r j hr pSelected pFixed t' hslopeSelectedInv + hslopeReInv hslopeImInv hselectedCoord hfixedCoord hOSelectedOriginal hOFixedOriginal + hslopeFixedOriginal hcentOriginal + refine Or.inr (Or.inr ⟨pSelected, pFixed, + BandPackingSymmetryQuadrupleAction ginv r, + (if BandPackingSymmetryReversesOrientation ginv then -j else j), + t', hslopeSelectedInv, hslopeFixedOriginal, + BandPackingSymmetryProperCovariance ginv r hr, hselectedCoord, + hfixedCoord, hcentOriginal, hslopeReInv, hslopeImInv, hnewAdj, ?_⟩) + let companionReverse := TileTranslation selectedSupport + ((⟨0, 1⟩ : GaussianInt) ^ t.val * + (if Even t.val then BandVectors.1 (r 0) (r j.succ) + else BandVectors.1 (r j.succ) (r 0))) + have hpointInv := MarkedAdjacencyGeometry.hpointInvAt1538 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv + hvecL hpoint + have hmarkCov := + (markedData.2.2 ginv r hr j t delta hphaseInv + selectedSupport bundle.normalizedPoint).2 + have hmarkedOriginal := MarkedAdjacencyGeometry.hmarkedOriginalAt1545 C₀ Cᵢ q i s T₀ Tᵢ h₀ + hᵢ x bundle delta transportedRotation hmarkedOld ginv r j t hmarked t' ht' hpointInv + hmarkCov + exact hmarkedOriginal + +end MarkedAdjacencyConclusions + +theorem MarkedOdometerAdjacencyReduction : + (∀ (C : BandCircle) (T T₀ : ProtoTile) (h h₀ : PartialOdometer) + (x : GaussianInt), + ¬ ((∃ (g : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = C.1.1) ∨ + (∃ (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K 0) = C.1.1)) → + RightLatticeAdjacent C T T₀ h h₀ → + x ∈ h.domain → x ∈ h₀.domain → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h.domain ∨ y ∈ h₀.domain) → + ∃ (C' : BandCircle) (T' : ProtoTile) (h' : PartialOdometer) + (p₀ p' : ℝ × ℝ) (q : Fin 4 → CircleCoordinates) + (i : Fin 3) (s : Fin 4), + TileSubodometer C.1.1 C'.1.1 T T' h h' ∧ + PartialOdometerSlope h₀ = some p₀ ∧ + PartialOdometerSlope h' = some p' ∧ + ProperBandQuadruple q ∧ q 0 = C.1.1 ∧ q i.succ = C'.1.1 ∧ + TileCentroid T' - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) ∧ + p'.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).1 ∧ + p'.2 - p₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).2 ∧ + SubtileLatticeAdjacent C C' T₀ T' h₀ h' ∧ + x ∈ h₀.domain ∧ x ∈ h'.domain ∧ + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h₀.domain ∨ y ∈ h'.domain) ∧ + Int.toNat C.1.1.1 + Int.toNat C'.1.1.1 < + Int.toNat C.1.1.1 + Int.toNat C.1.1.1 ∧ + (¬ (∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩ → z ∈ T.cells ∨ z ∈ T₀.cells) ↔ + x ∈ FootprintVertices + (TileTranslation T₀ + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)))))) ∧ + ∀ (C₀ Cᵢ : BandCircle) (q : Fin 4 → CircleCoordinates) + (i : Fin 3) (s : Fin 4) (T₀ Tᵢ : ProtoTile) + (h₀ hᵢ : PartialOdometer) (x : GaussianInt) (p₀ pᵢ : ℝ × ℝ), + ¬ ((∃ (g : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = C₀.1.1) ∨ + (∃ (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K 0) = C₀.1.1)) → + ProperBandQuadruple q → q 0 = C₀.1.1 → q i.succ = Cᵢ.1.1 → + PartialOdometerSlope h₀ = some p₀ → + PartialOdometerSlope hᵢ = some pᵢ → + TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) → + pᵢ.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).1 → + pᵢ.2 - p₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).2 → + SubtileLatticeAdjacent C₀ Cᵢ T₀ Tᵢ h₀ hᵢ → + x ∈ h₀.domain → x ∈ hᵢ.domain → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h₀.domain ∨ y ∈ hᵢ.domain) → + let oldUR := TileTranslation T₀ + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0))) + ∃ (C' : BandCircle) (T' : ProtoTile) (h' : PartialOdometer), + TileSubodometer C₀.1.1 C'.1.1 T₀ T' h₀ h' ∧ + x ∈ hᵢ.domain ∧ x ∈ h'.domain ∧ + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ hᵢ.domain ∨ y ∈ h'.domain) ∧ + Int.toNat Cᵢ.1.1.1 + Int.toNat C'.1.1.1 < + Int.toNat C₀.1.1.1 + Int.toNat Cᵢ.1.1.1 ∧ + ((C' = Cᵢ ∧ LeftLatticeAdjacent Cᵢ Tᵢ T' hᵢ h' ∧ + x ∉ FootprintVertices oldUR) ∨ + (∃ (a₀ a' : ℝ × ℝ) (r : Fin 4 → CircleCoordinates) + (j : Fin 3) (t : Fin 4), + PartialOdometerSlope hᵢ = some a₀ ∧ + PartialOdometerSlope h' = some a' ∧ + ProperBandQuadruple r ∧ r 0 = Cᵢ.1.1 ∧ + r j.succ = C'.1.1 ∧ + TileCentroid T' - TileCentroid Tᵢ = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ t.val * + (BandVectors.1 (r j.succ) (r 0) + + BandVectors.1 (r 0) (r j.succ))) ∧ + a'.1 - a₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ t.val * + (BandVectors.2 (r j.succ) (r 0) + + BandVectors.2 (r 0) (r j.succ)))).1 ∧ + a'.2 - a₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ t.val * + (BandVectors.2 (r j.succ) (r 0) + + BandVectors.2 (r 0) (r j.succ)))).2 ∧ + SubtileLatticeAdjacent Cᵢ C' Tᵢ T' hᵢ h' ∧ + (x ∈ FootprintVertices oldUR ↔ + x ∈ FootprintVertices + (TileTranslation Tᵢ + ((⟨0, 1⟩ : GaussianInt) ^ t.val * + (if Even t.val then BandVectors.1 (r 0) (r j.succ) + else BandVectors.1 (r j.succ) (r 0)))))) ∨ + (∃ (a₀ aᵢ : ℝ × ℝ) (r : Fin 4 → CircleCoordinates) + (j : Fin 3) (t : Fin 4), + PartialOdometerSlope h' = some a₀ ∧ + PartialOdometerSlope hᵢ = some aᵢ ∧ + ProperBandQuadruple r ∧ r 0 = C'.1.1 ∧ + r j.succ = Cᵢ.1.1 ∧ + TileCentroid Tᵢ - TileCentroid T' = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ t.val * + (BandVectors.1 (r j.succ) (r 0) + + BandVectors.1 (r 0) (r j.succ))) ∧ + aᵢ.1 - a₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ t.val * + (BandVectors.2 (r j.succ) (r 0) + + BandVectors.2 (r 0) (r j.succ)))).1 ∧ + aᵢ.2 - a₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ t.val * + (BandVectors.2 (r j.succ) (r 0) + + BandVectors.2 (r 0) (r j.succ)))).2 ∧ + SubtileLatticeAdjacent C' Cᵢ T' Tᵢ h' hᵢ ∧ + (x ∈ FootprintVertices oldUR ↔ + x ∈ FootprintVertices + (TileTranslation T' + ((⟨0, 1⟩ : GaussianInt) ^ t.val * + (if Even t.val then BandVectors.1 (r 0) (r j.succ) + else BandVectors.1 (r j.succ) (r 0))))))) := by +-- BODY + constructor + · exact P5630T1MarkedRightOdometerAdjacencyReduction + · intro C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x p₀ pᵢ horbit hq hq₀ hqᵢ + hslope₀ hslopeᵢ hcentroid hslopex hslopey hadj hx₀ hxᵢ hstar + have inversePhase := BandPackingSymmetryInversePhaseCancellation + have markedData := BandPackingSymmetryMarkedDataCovariance + dsimp + obtain ⟨bundle, subtilePlacement, hsubtilePlacement⟩ := + BandOrderedGeneralSubtileNormalizedBundleExists + C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x p₀ pᵢ horbit hq hq₀ hqᵢ + hslope₀ hslopeᵢ hcentroid hslopex hslopey hadj hx₀ hxᵢ hstar + obtain ⟨selectedEdge, hxSelectedEdge, hselectedEdge, selectedRow⟩ := + BandOrderedGeneralRoutedSelectedContact + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot subtilePlacement.layout + subtilePlacement.exteriorIndex subtilePlacement.centralIndex + bundle.normalizedPoint (bundle.routedDirection + 2) + subtilePlacement.exterior_index subtilePlacement.central_index + subtilePlacement.exterior_routed_cell + (by + have hdir : bundle.routedDirection + 2 + 2 = + bundle.routedDirection := by omega + simpa [hdir] using subtilePlacement.central_routed_cell) + subtilePlacement.selected_star + obtain ⟨row⟩ := selectedRow + have hO₀ : TileOdometer C₀.1.1 T₀ h₀ := hadj.1 + have hOᵢ : TileOdometer Cᵢ.1.1 Tᵢ hᵢ := hadj.2.1 + let g := bundle.symmetry + let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + have hparentPositive := MarkedAdjacencyGeometry.hparentPositiveAt344 Cᵢ q i hqᵢ + have hO₀q := MarkedAdjacencyGeometry.hO₀q C₀ q T₀ h₀ hq₀ hO₀ + have hOᵢq := MarkedAdjacencyGeometry.hOᵢq Cᵢ q i Tᵢ hᵢ hqᵢ hOᵢ + obtain ⟨delta, transportedRootSlope, transportedFixedSlope, transportedRotation, + hphaseForward, hrotationForward, hrootOdometer, hfixedOdometer, + hrootSlope, hfixedSlope, hcentroidForward, hslopeXForward, + hslopeYForward, hcompatForward⟩ := + SubtileLatticeAdjacentPackingSymmetryTransport g q hq i s hparentPositive + T₀ Tᵢ h₀ hᵢ p₀ pᵢ hO₀q hOᵢq hslope₀ hslopeᵢ + hcentroid hslopex hslopey + have hnorm := MarkedAdjacencyGeometry.hnormAt360 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle + have htransportRootSlopeEq := MarkedAdjacencyGeometry.htransportRootSlopeEq C₀ Cᵢ T₀ Tᵢ h₀ hᵢ + x bundle transportedRootSlope hrootSlope + have htransportFixedSlopeEq := MarkedAdjacencyGeometry.htransportFixedSlopeEq C₀ Cᵢ T₀ Tᵢ h₀ + hᵢ x bundle transportedFixedSlope hfixedSlope + have hnormalizedProper : ProperBandQuadruple normalizationPresentation := + BandPackingSymmetryProperCovariance g q hq + let oldUR := TileTranslation T₀ + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0))) + let rowUR := TileTranslation bundle.normalizedRoot + ((⟨0, 1⟩ : GaussianInt) ^ transportedRotation.val * + (if Even transportedRotation.val then + BandVectors.1 (normalizationPresentation 0) (normalizationPresentation (sigma i).succ) + else BandVectors.1 (normalizationPresentation (sigma i).succ) (normalizationPresentation + 0))) + have hmarkedTransport := + markedData.2.2 g q hq i s delta hphaseForward T₀ x + have hmarkedOld := MarkedAdjacencyGeometry.hmarkedOld C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x bundle delta + transportedRotation hmarkedTransport (MarkedAdjacencyGeometry.hrowUR C₀ Cᵢ q i s T₀ Tᵢ h₀ + hᵢ x bundle delta transportedRotation hrotationForward) + have subtileGeometry := BandOrderedGeneralSubtileSelectedRowGeometry + C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle subtilePlacement selectedEdge + hxSelectedEdge hselectedEdge row (MarkedAdjacencyGeometry.hnormalizedOrbit C₀ Cᵢ T₀ Tᵢ h₀ + hᵢ x horbit bundle) + normalizationPresentation (sigma i) transportedRotation + hnormalizedProper (MarkedAdjacencyGeometry.hr₀ C₀ Cᵢ q T₀ Tᵢ h₀ hᵢ x hq₀ bundle hnorm) + (MarkedAdjacencyGeometry.hrᵢ C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x p₀ pᵢ hqᵢ hcentroid hslopex + hslopey bundle hparentPositive hOᵢq transportedRootSlope transportedFixedSlope + transportedRotation hfixedOdometer hcentroidForward hslopeXForward hslopeYForward) + (MarkedAdjacencyGeometry.hnormalizedCentroid C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle + transportedRotation hcentroidForward) + (MarkedAdjacencyGeometry.hnormalizedSlopeX C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle + transportedRootSlope transportedFixedSlope transportedRotation hslopeXForward + htransportRootSlopeEq htransportFixedSlopeEq) + (MarkedAdjacencyGeometry.hnormalizedSlopeY C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle + transportedRootSlope transportedFixedSlope transportedRotation hslopeYForward + htransportRootSlopeEq htransportFixedSlopeEq) + dsimp at subtileGeometry + rcases subtileGeometry with + ⟨C', selectedSlope, hC', hsub', hslope', hxFixed', hxSelected', + hstar', hsize', hrowOutput⟩ + obtain ⟨ginv, hcircleL, hcircleR, hquadL, hquadR, htileL, + htileR, hvecL, hvecR, hfunL, hfunR, hphase⟩ := + (BandPackingSymmetryInversePhaseCancellation.2 bundle.symmetry) + have hnorm := MarkedAdjacencyGeometry.hnormAt536 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle + have actionCurvature := MarkedAdjacencyGeometry.actionCurvature + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + have hinverseProper : ProperBandQuadruple inversePresentation := + BandPackingSymmetryProperCovariance ginv bundle.normalizedPresentation + bundle.configuration.proper + have hinverseCoordinate := MarkedAdjacencyGeometry.hinverseCoordinate C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x + bundle C' hC' ginv + have hinversePositive := MarkedAdjacencyGeometry.hinversePositive C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle + C' ginv actionCurvature hinverseCoordinate + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + have hinverseCircle : inverseCircle.1.1 = + BandPackingSymmetryCircleAction ginv C'.1.1 := hinverseCoordinate + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + have inverseDomain := MarkedAdjacencyGeometry.inverseDomain C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv + hvecL + have hpoint : BandPackingSymmetryVectorAction bundle.symmetry x = + bundle.normalizedPoint := bundle.normalized_point_eq.symm + refine ⟨inverseCircle, T', h', (MarkedAdjacencyGeometry.hsubInverse C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x + bundle markedData C' ginv hcircleL htileL hfunL hinverseProper hinversePositive + hinverseCircle (MarkedAdjacencyGeometry.hsubNormalized C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hnorm + C' hsub')), (MarkedAdjacencyGeometry.hxFixedOriginal C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hxFixed' + ginv hfunL inverseDomain hpoint), + (MarkedAdjacencyGeometry.hxSelectedOriginal C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hxSelected' ginv + inverseDomain hpoint), (MarkedAdjacencyGeometry.hstarOriginal C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x + bundle hstar' ginv hfunL inverseDomain hpoint (MarkedAdjacencyGeometry.mapStar)), + (MarkedAdjacencyGeometry.hsizeOriginal C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hnorm C' hsize' ginv + actionCurvature hinverseProper hinversePositive hinverseCircle), ?_⟩ + rcases hrowOutput with hleft | hforward | hreverse + · have leftAdjacencyCase := MarkedAdjacencyConclusions.leftAdjacencyCase C₀ Cᵢ q i s T₀ Tᵢ h₀ + hᵢ x bundle transportedRotation hmarkedOld C' selectedSlope hslope' ginv hcircleL htileL + hfunL actionCurvature hinverseProper hinversePositive hinverseCircle hleft + exact leftAdjacencyCase + · have forwardAdjacencyCase := MarkedAdjacencyConclusions.forwardAdjacencyCase C₀ Cᵢ q i s T₀ + Tᵢ h₀ hᵢ x bundle markedData transportedRotation hmarkedOld C' selectedSlope hC' hslope' + ginv hcircleL htileL hvecL hfunL hinverseProper hinversePositive hinverseCircle hpoint + hforward + exact forwardAdjacencyCase + · have reverseAdjacencyCase := MarkedAdjacencyConclusions.reverseAdjacencyCase C₀ Cᵢ q i s T₀ + Tᵢ h₀ hᵢ x bundle markedData transportedRotation hmarkedOld C' selectedSlope hC' hslope' + ginv hcircleL htileL hvecL hfunL hinverseProper hinversePositive hinverseCircle hpoint + hreverse + exact reverseAdjacencyCase + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ModifiedSubtileOccurrenceInterpretation.lean b/LeanPool/ApollonianSuperharmonic/ModifiedSubtileOccurrenceInterpretation.lean new file mode 100644 index 0000000000..77b5742e20 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ModifiedSubtileOccurrenceInterpretation.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileCellComplement + +-- [TABLET NODE: ModifiedSubtileOccurrenceInterpretation] + +/-! +# ModifiedSubtileOccurrenceInterpretation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For six signed occurrences $S_i^\pm$, a common precursor $O$, and periods +$u,v$, the modified interpretation of a periodic subtile index agrees with +`SubtileOccurrenceInterpretation` except at label $A$: it assigns +$$ + (A\setminus O)_{m,n} +$$ +to $(A,m,n)$. The labels $B,C,D,E,F$ retain their unmodified occurrences. +Cell difference is the operation of `TileCellComplement`, and the +whole result is translated by $mu+nv$. +-/ +def ModifiedSubtileOccurrenceInterpretation + (S : Fin 3 -> Bool -> ProtoTile) (O : ProtoTile) + (u v : GaussianInt) (o : PeriodicSubtileIndex) : ProtoTile := +-- BODY + let T := match o.label with + | .A => TileCellComplement (S 0 true) O + | .B => S 0 false + | .C => S 1 true + | .D => S 1 false + | .E => S 2 true + | .F => S 2 false + TileTranslation T + ((o.first : GaussianInt) * u + (o.second : GaussianInt) * v) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/NoCheckerboardCellVertex.lean b/LeanPool/ApollonianSuperharmonic/NoCheckerboardCellVertex.lean new file mode 100644 index 0000000000..859c38f73e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/NoCheckerboardCellVertex.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeCell + +-- [TABLET NODE: NoCheckerboardCellVertex] + +/-! +# NoCheckerboardCellVertex + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A cell set has *no checkerboard lattice vertex* when, among the four +unit cells incident with any lattice vertex, the occupied cells are never +exactly one diagonally opposite pair. In lower-left-corner coordinates the +four incident cells at $z$ are +$z,z-1,z-i,z-1-i$; the forbidden patterns are +$\{z,z-1-i\}$ and $\{z-1,z-i\}$. +-/ +def NoCheckerboardCellVertex (S : Set LatticeCell) : Prop := +-- BODY + ∀ z : GaussianInt, + ¬ ((z ∈ S ∧ z - 1 - ⟨0, 1⟩ ∈ S ∧ + z - 1 ∉ S ∧ z - ⟨0, 1⟩ ∉ S) ∨ + (z - 1 ∈ S ∧ z - ⟨0, 1⟩ ∈ S ∧ + z ∉ S ∧ z - 1 - ⟨0, 1⟩ ∉ S)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OdometerAdjacencyInduction.lean b/LeanPool/ApollonianSuperharmonic/OdometerAdjacencyInduction.lean new file mode 100644 index 0000000000..abfd769adc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OdometerAdjacencyInduction.lean @@ -0,0 +1,561 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.OrderedGeneralOdometerAdjacencyClassification +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist +public import LeanPool.ApollonianSuperharmonic.P5491T1ExceptionalPresentation +public import LeanPool.ApollonianSuperharmonic.P5491T1AffinePairReduction +public import LeanPool.ApollonianSuperharmonic.P5491T1FordBoundarySlope +public import LeanPool.ApollonianSuperharmonic.P5491T1FordRightBoundary +public import LeanPool.ApollonianSuperharmonic.P5491T1FordParentBoundary +public import LeanPool.ApollonianSuperharmonic.P5491T1DiamondRightBoundary +public import LeanPool.ApollonianSuperharmonic.P5491T1DiamondParentBoundary +public import LeanPool.ApollonianSuperharmonic.P5332T1VectorPlacements +public import LeanPool.ApollonianSuperharmonic.P5352T2VectorPlacements +public import LeanPool.ApollonianSuperharmonic.P5352T2SourceCertificates +public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid +public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic + +-- [TABLET NODE: OdometerAdjacencyInduction] + +/-! +# OdometerAdjacencyInduction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace AdjacencyInductionGeometry + +private theorem compare : + (by + classical + exact + ∀ (C : CircleCoordinates), ∀ (D : CircleCoordinates), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), ∀ (T : ProtoTile), ∀ (S : ProtoTile), ∀ (f : PartialOdometer), ∀ (g : + PartialOdometer), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), ∀ (p : ℝ × ℝ), ∀ + (q : ℝ × ℝ), ∀ (r : ℝ × ℝ), ∀ (t : ℝ × ℝ), ∀ (d : GaussianInt), ∀ (a : GaussianInt), + (0 < C.1) → ((0 < D.1) → ((TileOdometer C U f) → ((TileOdometer D V g) → + ((TileOdometer C T h) → ((TileOdometer D S k) → ((PartialOdometerSlope f = some p) → + ((PartialOdometerSlope g = some q) → ((PartialOdometerSlope h = some r) → + ((PartialOdometerSlope k = some t) → ((TileCentroid S - TileCentroid T = + TileCentroid V - TileCentroid U + GaussianRealPoint d) → ((t.1-r.1 = q.1-p.1+(a.re : + ℝ)) → ((t.2-r.2 = q.2-p.2+(a.im : ℝ)) → ((∃ b : ℤ, ∀ x : GaussianInt, x ∈ + f.domain → x-d ∈ g.domain → + g.value (x-d)+a.re*x.re+a.im*x.im-f.value x=b) → (OdometerCompatibility h + k)))))))))))))) ) := by + classical + intro C D U V T S f g h k p q r t d a hC hD hf hg hh hk hpf hqg hrh htk hc ha hb hraw + obtain ⟨u,b,hd,hv⟩ := P5491T1AffinePairReduction C D U V T S f g h k + p q r t d a hC hD hf hg hh hk hpf hqg hrh htk hc ha hb + obtain ⟨c,hc⟩ := hraw + right + refine ⟨c+b, ?_⟩ + intro x hx hy + obtain ⟨hx',hy'⟩ := (hd x).mp ⟨hx,hy⟩ + rw [hv x hx hy, hc (x-u) hx' hy'] + +private theorem fordRight : + (by + classical + exact + (∀ (C : CircleCoordinates), ∀ (D : CircleCoordinates), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), ∀ (T : ProtoTile), ∀ (S : ProtoTile), ∀ (f : PartialOdometer), ∀ (g : + PartialOdometer), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), ∀ (p : ℝ × ℝ), ∀ + (q : ℝ × ℝ), ∀ (r : ℝ × ℝ), ∀ (t : ℝ × ℝ), ∀ (d : GaussianInt), ∀ (a : GaussianInt), + (0 < C.1) → ((0 < D.1) → ((TileOdometer C U f) → ((TileOdometer D V g) → + ((TileOdometer C T h) → ((TileOdometer D S k) → ((PartialOdometerSlope f = some p) → + ((PartialOdometerSlope g = some q) → ((PartialOdometerSlope h = some r) → + ((PartialOdometerSlope k = some t) → ((TileCentroid S - TileCentroid T = TileCentroid + V - TileCentroid U + GaussianRealPoint d) → ((t.1-r.1 = q.1-p.1+(a.re : ℝ)) → + ((t.2-r.2 = q.2-p.2+(a.im : ℝ)) → ((∃ b : ℤ, ∀ x : GaussianInt, x ∈ f.domain → x-d ∈ + g.domain → g.value (x-d)+a.re*x.re+a.im*x.im-f.value x=b) → (OdometerCompatibility h + k))))))))))))))) → (∀ (P : FordFareyParameter), (1 < P.q) → (∀ (i : Fin 3), ∀ (e : + Bool), ∀ (T : ProtoTile), ∀ (S : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (p : ℝ × ℝ), ∀ (q : ℝ × ℝ), (TileOdometer (FordRecursiveQuadruple + P 0) T h) → ((TileOdometer (FordRecursiveQuadruple P 0) S k) → ((PartialOdometerSlope + h = some p) → ((PartialOdometerSlope k = some q) → ((TileCentroid S - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • GaussianRealPoint + (BandVectors.1 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P i.succ))) → + ((q.1-p.1 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P i.succ)).re) → + ((q.2-p.2 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P i.succ)).im) → + (OdometerCompatibility h k))))))))) ) := by + classical + intro compare P hP i e T S h k p q hh hk hp hq hc ha hb + obtain ⟨f,hf,hd,hv⟩ := FordTileOdometerRestriction P + have hs := P5491T1FordBoundarySlope P f hd hv + let R := P5332T1RightRows P i 0 + let d := if e then R.displacement else -R.displacement + let a := if e then R.linear else -R.linear + have vec := (P5332T1VectorPlacements P hP).1 i + have hc' : TileCentroid S - TileCentroid T = + TileCentroid (FordTile P.q) - TileCentroid (FordTile P.q) + GaussianRealPoint d := by + rw [hc, vec.1, sub_self, zero_add] + cases e <;> simp [d, R, GaussianRealPoint] + have ha' : q.1-p.1 = (P.p : ℝ)/2-(P.p : ℝ)/2+(a.re : ℝ) := by + rw [ha, vec.2] + cases e <;> simp [a, R] + have hb' : q.2-p.2 = (P.p : ℝ)/2-(P.p : ℝ)/2+(a.im : ℝ) := by + rw [hb, vec.2] + cases e <;> simp [a, R] + apply compare _ _ _ _ _ _ f f h k _ _ p q d a + (by change (0 : ℤ) < ↑(P.q*P.q); exact_mod_cast Nat.mul_pos P.q_pos P.q_pos) + (by change (0 : ℤ) < ↑(P.q*P.q); exact_mod_cast Nat.mul_pos P.q_pos P.q_pos) + hf hf hh hk hs hs hp hq hc' ha' hb' + obtain ⟨b,hb⟩ := P5491T1FordRightBoundary P hP i e + refine ⟨b, ?_⟩ + intro x hx hy + rw [hv x hx, hv (x-d) hy] + exact hb x (by change x ∈ (f.domain : Set GaussianInt) at hx; rwa [hd] at hx) + (by change x-d ∈ (f.domain : Set GaussianInt) at hy; rwa [hd] at hy) + +private theorem fordParent : + (by + classical + exact + (∀ (C : CircleCoordinates), ∀ (D : CircleCoordinates), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), ∀ (T : ProtoTile), ∀ (S : ProtoTile), ∀ (f : PartialOdometer), ∀ (g : + PartialOdometer), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), ∀ (p : ℝ × ℝ), ∀ + (q : ℝ × ℝ), ∀ (r : ℝ × ℝ), ∀ (t : ℝ × ℝ), ∀ (d : GaussianInt), ∀ (a : GaussianInt), + (0 < C.1) → ((0 < D.1) → ((TileOdometer C U f) → ((TileOdometer D V g) → + ((TileOdometer C T h) → ((TileOdometer D S k) → ((PartialOdometerSlope f = some p) → + ((PartialOdometerSlope g = some q) → ((PartialOdometerSlope h = some r) → + ((PartialOdometerSlope k = some t) → ((TileCentroid S - TileCentroid T = TileCentroid + V - TileCentroid U + GaussianRealPoint d) → ((t.1-r.1 = q.1-p.1+(a.re : ℝ)) → + ((t.2-r.2 = q.2-p.2+(a.im : ℝ)) → ((∃ b : ℤ, ∀ x : GaussianInt, x ∈ f.domain → x-d ∈ + g.domain → g.value (x-d)+a.re*x.re+a.im*x.im-f.value x=b) → (OdometerCompatibility h + k))))))))))))))) → (∀ (P : FordFareyParameter), (1 < P.q) → (∀ (i : Fin 3), ∀ (s : + Fin 4), ∀ (T : ProtoTile), ∀ (S : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (p : ℝ × ℝ), ∀ (q : ℝ × ℝ), (0 < (FordRecursiveQuadruple P + i.succ).1) → ((TileOdometer (FordRecursiveQuadruple P 0) T h) → ((TileOdometer + (FordRecursiveQuadruple P i.succ) S k) → ((PartialOdometerSlope h = some p) → + ((PartialOdometerSlope k = some q) → ((TileCentroid S - TileCentroid T = (1/2 : ℝ) • + GaussianRealPoint + ((⟨0,1⟩ : GaussianInt)^s.val * + (BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P 0) + + BandVectors.1 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P i.succ)))) → + ((q.1-p.1 = ((1/2 : ℝ) • GaussianRealPoint + ((-⟨0,1⟩ : GaussianInt)^s.val * + (BandVectors.2 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P 0) + + BandVectors.2 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P i.succ)))).1) + → ((q.2-p.2 = ((1/2 : ℝ) • GaussianRealPoint + ((-⟨0,1⟩ : GaussianInt)^s.val * + (BandVectors.2 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P 0) + + BandVectors.2 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P i.succ)))).2) + → (OdometerCompatibility h k)))))))))) ) := by + classical + intro compare P hP i s T S h k p q hpos hh hk hp hq hc ha hb + have hi : i.val < 2 := by + fin_cases i + · decide + · decide + · norm_num [FordRecursiveQuadruple] at hpos + let j : Fin 2 := ⟨i.val,hi⟩ + have ij : (⟨j.val, by omega⟩ : Fin 3) = i := rfl + have ar := P5130T5ParentArithmetic P hP + have hden : 0 < ![P.q₁,P.q₂] j := by + by_cases hj : j = 0 + · rw [hj]; exact ar.1 + · have hj' : j = 1 := by omega + rw [hj']; exact ar.2.2.1 + have hred : Nat.Coprime (![P.q₁,P.q₂] j) (![P.p₁,P.p₂] j).natAbs := by + by_cases hj : j = 0 + · rw [hj]; exact ar.2.2.2.2.1 + · have hj' : j = 1 := by omega + rw [hj']; exact ar.2.2.2.2.2.1 + obtain ⟨A,⟨hAp,hAq⟩,_⟩ := FordFareyParentsExist _ _ hden hred + have parent : FordRecursiveQuadruple P i.succ = FordCircleCoordinate A.p A.q := by + rw [hAp,hAq] + fin_cases i + · simp [j,FordRecursiveQuadruple, Nat.ne_of_gt ar.1] + · simp [j,FordRecursiveQuadruple] + · norm_num [FordRecursiveQuadruple] at hpos + obtain ⟨f,hf,hdf,hvf⟩ := FordTileOdometerRestriction P + obtain ⟨g,hg,hdg,hvg⟩ := FordTileOdometerRestriction A + have hsf := P5491T1FordBoundarySlope P f hdf hvf + have hsg := P5491T1FordBoundarySlope A g hdg hvg + let R := P5332T1ParentRows P j s 0 + obtain ⟨vc,va,_⟩ := (P5332T1VectorPlacements P hP).2 j s + rw [ij] at vc va + have hc' : TileCentroid S - TileCentroid T = + TileCentroid (FordTile A.q) - TileCentroid (FordTile P.q) + + GaussianRealPoint R.displacement := by + rw [hc,vc,P4210T1FordSquareCentroid A.q A.q_pos, + P4210T1FordSquareCentroid P.q P.q_pos,hAq] + ext <;> simp [GaussianRealPoint,R] <;> ring + have ha' : q.1-p.1 = (A.p : ℝ)/2-(P.p : ℝ)/2+(R.linear.re : ℝ) := by + rw [ha,va,hAp] + dsimp + ring + have hb' : q.2-p.2 = (A.p : ℝ)/2-(P.p : ℝ)/2+(R.linear.im : ℝ) := by + rw [hb,va,hAp] + dsimp + ring + apply compare _ _ _ _ _ _ f g h k _ _ p q R.displacement R.linear + (by change (0 : ℤ) < ↑(P.q*P.q); exact_mod_cast Nat.mul_pos P.q_pos P.q_pos) + (by change (0 : ℤ) < ↑(A.q*A.q); exact_mod_cast Nat.mul_pos A.q_pos A.q_pos) + hf hg hh (parent ▸ hk) hsf hsg hp hq hc' ha' hb' + obtain ⟨b,hb⟩ := P5491T1FordParentBoundary P A hP j s hAp hAq + refine ⟨b, ?_⟩ + intro x hx hy + rw [hvg (x-R.displacement) hy,hvf x hx] + exact hb x (by change x ∈ (f.domain : Set GaussianInt) at hx; rwa [hdf] at hx) + (by change x-R.displacement ∈ (g.domain : Set GaussianInt) at hy; rwa [hdg] at hy) + +private theorem diamondRight : + (by + classical + exact + (∀ (C : CircleCoordinates), ∀ (D : CircleCoordinates), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), ∀ (T : ProtoTile), ∀ (S : ProtoTile), ∀ (f : PartialOdometer), ∀ (g : + PartialOdometer), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), ∀ (p : ℝ × ℝ), ∀ + (q : ℝ × ℝ), ∀ (r : ℝ × ℝ), ∀ (t : ℝ × ℝ), ∀ (d : GaussianInt), ∀ (a : GaussianInt), + (0 < C.1) → ((0 < D.1) → ((TileOdometer C U f) → ((TileOdometer D V g) → + ((TileOdometer C T h) → ((TileOdometer D S k) → ((PartialOdometerSlope f = some p) → + ((PartialOdometerSlope g = some q) → ((PartialOdometerSlope h = some r) → + ((PartialOdometerSlope k = some t) → ((TileCentroid S - TileCentroid T = TileCentroid + V - TileCentroid U + GaussianRealPoint d) → ((t.1-r.1 = q.1-p.1+(a.re : ℝ)) → + ((t.2-r.2 = q.2-p.2+(a.im : ℝ)) → ((∃ b : ℤ, ∀ x : GaussianInt, x ∈ f.domain → x-d ∈ + g.domain → g.value (x-d)+a.re*x.re+a.im*x.im-f.value x=b) → (OdometerCompatibility h + k))))))))))))))) → (∀ (K : DiamondParameter), (1 < K.1) → (∀ (i : Fin 3), ∀ (e : + Bool), ∀ (T : ProtoTile), ∀ (S : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (p : ℝ × ℝ), ∀ (q : ℝ × ℝ), (TileOdometer + (DiamondRecursiveQuadruple K 0) T h) → ((TileOdometer (DiamondRecursiveQuadruple K 0) + S k) → ((PartialOdometerSlope h = some p) → ((PartialOdometerSlope k = some q) → + ((TileCentroid S - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • GaussianRealPoint + (BandVectors.1 (DiamondRecursiveQuadruple K 0) (DiamondRecursiveQuadruple K + i.succ))) → ((q.1-p.1 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (DiamondRecursiveQuadruple K 0) (DiamondRecursiveQuadruple K + i.succ)).re) → ((q.2-p.2 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (DiamondRecursiveQuadruple K 0) (DiamondRecursiveQuadruple K + i.succ)).im) → (OdometerCompatibility h k))))))))) ) := by + classical + intro compare K hK i e T S h k p q hh hk hp hq hc ha hb + let A := P5352T2Sources K hK 0 + let M := (P5352T2PlacementData K.1 i).1 + let d := if e then M.1 else -M.1 + let a := if e then M.2 else -M.2 + obtain ⟨hpos,hcent,f,hf,hd,hv,hs⟩ := P5352T2SourceCertificates K hK 0 + obtain ⟨vc,va,_⟩ := P5352T2VectorPlacements K hK i 0 + have hc' : TileCentroid S - TileCentroid T = + TileCentroid A.1 - TileCentroid A.1 + GaussianRealPoint d := by + rw [hc,vc,sub_self,zero_add] + cases e <;> simp [d,M,GaussianRealPoint] + have ha' : q.1-p.1 = A.2.2.2.1-A.2.2.2.1+(a.re : ℝ) := by + rw [ha,va] + cases e <;> simp [a,M] + have hb' : q.2-p.2 = A.2.2.2.2-A.2.2.2.2+(a.im : ℝ) := by + rw [hb,va] + cases e <;> simp [a,M] + apply compare _ _ A.1 A.1 _ _ f f h k _ _ p q d a + hpos hpos hf hf hh hk hs hs hp hq hc' ha' hb' + obtain ⟨b,hb⟩ := P5491T1DiamondRightBoundary K hK i e + refine ⟨b, ?_⟩ + intro x hx hy + rw [hv x hx,hv (x-d) hy] + exact hb x (by change x ∈ (f.domain : Set GaussianInt) at hx; rwa [hd] at hx) + (by change x-d ∈ (f.domain : Set GaussianInt) at hy; rwa [hd] at hy) + +private theorem diamondParent : + (by + classical + exact + (∀ (C : CircleCoordinates), ∀ (D : CircleCoordinates), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), ∀ (T : ProtoTile), ∀ (S : ProtoTile), ∀ (f : PartialOdometer), ∀ (g : + PartialOdometer), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), ∀ (p : ℝ × ℝ), ∀ + (q : ℝ × ℝ), ∀ (r : ℝ × ℝ), ∀ (t : ℝ × ℝ), ∀ (d : GaussianInt), ∀ (a : GaussianInt), + (0 < C.1) → ((0 < D.1) → ((TileOdometer C U f) → ((TileOdometer D V g) → + ((TileOdometer C T h) → ((TileOdometer D S k) → ((PartialOdometerSlope f = some p) → + ((PartialOdometerSlope g = some q) → ((PartialOdometerSlope h = some r) → + ((PartialOdometerSlope k = some t) → ((TileCentroid S - TileCentroid T = TileCentroid + V - TileCentroid U + GaussianRealPoint d) → ((t.1-r.1 = q.1-p.1+(a.re : ℝ)) → + ((t.2-r.2 = q.2-p.2+(a.im : ℝ)) → ((∃ b : ℤ, ∀ x : GaussianInt, x ∈ f.domain → x-d ∈ + g.domain → g.value (x-d)+a.re*x.re+a.im*x.im-f.value x=b) → (OdometerCompatibility h + k))))))))))))))) → (∀ (K : DiamondParameter), (1 < K.1) → (∀ (i : Fin 3), ∀ (s : Fin + 4), ∀ (T : ProtoTile), ∀ (S : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (p : ℝ × ℝ), ∀ (q : ℝ × ℝ), (TileOdometer + (DiamondRecursiveQuadruple K 0) T h) → ((TileOdometer (DiamondRecursiveQuadruple K + i.succ) S k) → ((PartialOdometerSlope h = some p) → ((PartialOdometerSlope k = some + q) → ((TileCentroid S - TileCentroid T = (1/2 : ℝ) • GaussianRealPoint + ((⟨0,1⟩ : GaussianInt)^s.val * + (BandVectors.1 (DiamondRecursiveQuadruple K i.succ) (DiamondRecursiveQuadruple K 0) + + BandVectors.1 (DiamondRecursiveQuadruple K 0) (DiamondRecursiveQuadruple K + i.succ)))) → ((q.1-p.1 = ((1/2 : ℝ) • GaussianRealPoint + ((-⟨0,1⟩ : GaussianInt)^s.val * + (BandVectors.2 (DiamondRecursiveQuadruple K i.succ) (DiamondRecursiveQuadruple K 0) + + BandVectors.2 (DiamondRecursiveQuadruple K 0) (DiamondRecursiveQuadruple K + i.succ)))).1) → ((q.2-p.2 = ((1/2 : ℝ) • GaussianRealPoint + ((-⟨0,1⟩ : GaussianInt)^s.val * + (BandVectors.2 (DiamondRecursiveQuadruple K i.succ) (DiamondRecursiveQuadruple K 0) + + BandVectors.2 (DiamondRecursiveQuadruple K 0) (DiamondRecursiveQuadruple K + i.succ)))).2) → (OdometerCompatibility h k))))))))) ) := by + classical + intro compare K hK i s T S h k p q hh hk hp hq hc ha hb + let A := P5352T2Sources K hK 0 + let D := P5352T2Sources K hK i.succ + let M := (P5352T2PlacementData K.1 i).2 s + obtain ⟨hpos,hcent,f,hf,hd,hv,hs⟩ := P5352T2SourceCertificates K hK 0 + obtain ⟨hpos',hcent',g,hg,hd',hv',hs'⟩ := P5352T2SourceCertificates K hK i.succ + obtain ⟨_,_,vc,va,_⟩ := P5352T2VectorPlacements K hK i s + have hc' : TileCentroid S - TileCentroid T = + TileCentroid D.1 - TileCentroid A.1 + GaussianRealPoint M.1 := by + rw [hc,vc,hcent,hcent'] + rfl + have ha' : q.1-p.1 = D.2.2.2.1-A.2.2.2.1+(M.2.1.re : ℝ) := by rw [ha,va] + have hb' : q.2-p.2 = D.2.2.2.2-A.2.2.2.2+(M.2.1.im : ℝ) := by rw [hb,va] + apply compare _ _ A.1 D.1 _ _ f g h k _ _ p q M.1 M.2.1 + hpos hpos' hf hg hh hk hs hs' hp hq hc' ha' hb' + obtain ⟨b,hb⟩ := P5491T1DiamondParentBoundary K hK i s + refine ⟨b, ?_⟩ + intro x hx hy + rw [hv x hx,hv' (x-M.1) hy] + exact hb x (by change x ∈ (f.domain : Set GaussianInt) at hx; rwa [hd] at hx) + (by change x-M.1 ∈ (g.domain : Set GaussianInt) at hy; rwa [hd'] at hy) + +private theorem hpos' : + (by + classical + exact + ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (S : ProtoTile), ∀ (k : PartialOdometer), ∀ (p : + ℝ × ℝ), ∀ (q : ℝ × ℝ), ∀ (Q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + (TileOdometer (Q i.succ) S k) → (∀ (s : Fin (4 : ℕ)), (Q i.succ = D.1.1) → + ((TileCentroid S - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (Q i.succ) (Q (0 : Fin (4 : ℕ))) + + BandVectors.1 (Q (0 : Fin (4 : ℕ))) (Q i.succ)))) → ((q.1 - p.1 = ((1 / 2 : ℝ) • + GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 + (Q i.succ) (Q (0 : Fin (4 : ℕ))) + BandVectors.2 (Q (0 : Fin (4 : ℕ))) (Q + i.succ)))).1) → ((q.2 - p.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ + : GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (Q i.succ) (Q (0 : Fin (4 : ℕ))) + + BandVectors.2 (Q (0 : Fin (4 : ℕ))) (Q i.succ)))).2) → (((0 : ℤ) < (Q i.succ).1) → (∀ + (g : BandPackingSymmetry), ∀ (r : ℝ × ℝ), ∀ (t : ℝ × ℝ), ∀ (s' : Fin (4 : ℕ)), + (TileOdometer (BandPackingSymmetryQuadrupleAction g Q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) + (BandPackingSymmetryTileAction g S) (BandPackingSymmetryPartialOdometerAction g k)) → + ((TileCentroid (BandPackingSymmetryTileAction g S) - TileCentroid + (BandPackingSymmetryTileAction g T) = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ^ (↑s' : ℕ) * (BandVectors.1 (BandPackingSymmetryQuadrupleAction + g Q ((fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true + then -j else j) i).succ) (BandPackingSymmetryQuadrupleAction g Q (0 : Fin (4 : ℕ))) + + BandVectors.1 (BandPackingSymmetryQuadrupleAction g Q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g Q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))) → ((t.1 - + r.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s' + : ℕ) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction g Q ((fun (j : Fin (3 : ℕ)) + => if BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) + (BandPackingSymmetryQuadrupleAction g Q (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction g Q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g Q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))).1) → + ((t.2 - r.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) + ^ (↑s' : ℕ) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction g Q ((fun (j : Fin + (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true then -j else j) + i).succ) (BandPackingSymmetryQuadrupleAction g Q (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction g Q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g Q ((fun (j : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))).2) → (0 < + ((BandPackingSymmetryQuadrupleAction g Q) (if BandPackingSymmetryReversesOrientation + g then -i else i).succ).1)))))))))) ) := by + classical + intro D T S k p q Q i hk s hparent hc ha hb hpos g r t s' hk' hc' ha' hb' + have hp' := (BandPackingSymmetryCovariance g).1 (Q i.succ) + cases hg : BandPackingSymmetryReversesOrientation g <;> fin_cases i <;> + simpa [BandPackingSymmetryQuadrupleAction,hg] using hp'.symm ▸ hpos + +end AdjacencyInductionGeometry + +theorem OdometerAdjacencyInduction : + (∀ (C : BandCircle), + (¬ ((∃ (g : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = C.1.1) ∨ + (∃ (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K 0) = C.1.1))) → + (∀ (T T₀ : ProtoTile) (h h₀ : PartialOdometer), + RightLatticeAdjacent C T T₀ h h₀ → + ∀ (C' : BandCircle) (T' : ProtoTile) (h' : PartialOdometer), + TileSubodometer C.1.1 C'.1.1 T T' h h' → + (FootprintEdges T' ∩ FootprintEdges T₀).Nonempty → + SubtileLatticeAdjacent C C' T₀ T' h₀ h') ∧ + (∀ (Cᵢ : BandCircle) (T T₀ : ProtoTile) + (h h₀ : PartialOdometer), + SubtileLatticeAdjacent C Cᵢ T₀ T h₀ h → + ∀ (C' : BandCircle) (T' : ProtoTile) (h' : PartialOdometer), + TileSubodometer C.1.1 C'.1.1 T₀ T' h₀ h' → + (∃ x, x ∈ h'.domain ∧ x ∈ h.domain) → + (((h'.domain : Set GaussianInt) ∩ + (h.domain : Set GaussianInt)).Subsingleton ∨ + (C' = Cᵢ ∧ LeftLatticeAdjacent Cᵢ T T' h h') ∨ + SubtileLatticeAdjacent Cᵢ C' T T' h h' ∨ + SubtileLatticeAdjacent C' Cᵢ T' T h' h))) ∧ + (∀ (C : BandCircle), + ((∃ (g : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = C.1.1) ∨ + (∃ (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K 0) = C.1.1)) → + (∀ (T T' : ProtoTile) (h h' : PartialOdometer), + RightLatticeAdjacent C T T' h h' → + OdometerCompatibility h h') ∧ + ∀ (Cᵢ : BandCircle) (T Tᵢ : ProtoTile) + (h hᵢ : PartialOdometer), + SubtileLatticeAdjacent C Cᵢ T Tᵢ h hᵢ → + OdometerCompatibility h hᵢ) := by +-- BODY + have compare (C D : CircleCoordinates) (U V T S : ProtoTile) + (f g h k : PartialOdometer) (p q r t : ℝ × ℝ) (d a : GaussianInt) + (hC : 0 < C.1) (hD : 0 < D.1) + (hf : TileOdometer C U f) (hg : TileOdometer D V g) + (hh : TileOdometer C T h) (hk : TileOdometer D S k) + (hpf : PartialOdometerSlope f = some p) + (hqg : PartialOdometerSlope g = some q) + (hrh : PartialOdometerSlope h = some r) + (htk : PartialOdometerSlope k = some t) + (hc : TileCentroid S - TileCentroid T = + TileCentroid V - TileCentroid U + GaussianRealPoint d) + (ha : t.1-r.1 = q.1-p.1+(a.re : ℝ)) + (hb : t.2-r.2 = q.2-p.2+(a.im : ℝ)) + (hraw : ∃ b : ℤ, ∀ x : GaussianInt, x ∈ f.domain → x-d ∈ g.domain → + g.value (x-d)+a.re*x.re+a.im*x.im-f.value x=b) : + OdometerCompatibility h k := AdjacencyInductionGeometry.compare C D U V T S f g h k p q r t + d a hC hD hf hg hh hk hpf hqg hrh htk hc ha hb hraw + have fordRight (P : FordFareyParameter) (hP : 1 < P.q) + (i : Fin 3) (e : Bool) (T S : ProtoTile) (h k : PartialOdometer) + (p q : ℝ × ℝ) + (hh : TileOdometer (FordRecursiveQuadruple P 0) T h) + (hk : TileOdometer (FordRecursiveQuadruple P 0) S k) + (hp : PartialOdometerSlope h = some p) + (hq : PartialOdometerSlope k = some q) + (hc : TileCentroid S - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • GaussianRealPoint + (BandVectors.1 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P i.succ))) + (ha : q.1-p.1 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P i.succ)).re) + (hb : q.2-p.2 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P i.succ)).im) : + OdometerCompatibility h k := AdjacencyInductionGeometry.fordRight compare P hP i e T S h k + p q hh hk hp hq hc ha hb + have fordParent (P : FordFareyParameter) (hP : 1 < P.q) + (i : Fin 3) (s : Fin 4) (T S : ProtoTile) (h k : PartialOdometer) + (p q : ℝ × ℝ) (hpos : 0 < (FordRecursiveQuadruple P i.succ).1) + (hh : TileOdometer (FordRecursiveQuadruple P 0) T h) + (hk : TileOdometer (FordRecursiveQuadruple P i.succ) S k) + (hp : PartialOdometerSlope h = some p) + (hq : PartialOdometerSlope k = some q) + (hc : TileCentroid S - TileCentroid T = (1/2 : ℝ) • GaussianRealPoint + ((⟨0,1⟩ : GaussianInt)^s.val * + (BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P 0) + + BandVectors.1 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P i.succ)))) + (ha : q.1-p.1 = ((1/2 : ℝ) • GaussianRealPoint + ((-⟨0,1⟩ : GaussianInt)^s.val * + (BandVectors.2 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P 0) + + BandVectors.2 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P i.succ)))).1) + (hb : q.2-p.2 = ((1/2 : ℝ) • GaussianRealPoint + ((-⟨0,1⟩ : GaussianInt)^s.val * + (BandVectors.2 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P 0) + + BandVectors.2 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P i.succ)))).2) : + OdometerCompatibility h k := AdjacencyInductionGeometry.fordParent compare P hP i s T S h k + p q hpos hh hk hp hq hc ha hb + have diamondRight (K : DiamondParameter) (hK : 1 < K.1) + (i : Fin 3) (e : Bool) (T S : ProtoTile) (h k : PartialOdometer) + (p q : ℝ × ℝ) + (hh : TileOdometer (DiamondRecursiveQuadruple K 0) T h) + (hk : TileOdometer (DiamondRecursiveQuadruple K 0) S k) + (hp : PartialOdometerSlope h = some p) + (hq : PartialOdometerSlope k = some q) + (hc : TileCentroid S - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • GaussianRealPoint + (BandVectors.1 (DiamondRecursiveQuadruple K 0) (DiamondRecursiveQuadruple K i.succ))) + (ha : q.1-p.1 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (DiamondRecursiveQuadruple K 0) (DiamondRecursiveQuadruple K i.succ)).re) + (hb : q.2-p.2 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (DiamondRecursiveQuadruple K 0) (DiamondRecursiveQuadruple K i.succ)).im) : + OdometerCompatibility h k := AdjacencyInductionGeometry.diamondRight compare K hK i e T S h + k p q hh hk hp hq hc ha hb + have diamondParent (K : DiamondParameter) (hK : 1 < K.1) + (i : Fin 3) (s : Fin 4) (T S : ProtoTile) (h k : PartialOdometer) + (p q : ℝ × ℝ) + (hh : TileOdometer (DiamondRecursiveQuadruple K 0) T h) + (hk : TileOdometer (DiamondRecursiveQuadruple K i.succ) S k) + (hp : PartialOdometerSlope h = some p) + (hq : PartialOdometerSlope k = some q) + (hc : TileCentroid S - TileCentroid T = (1/2 : ℝ) • GaussianRealPoint + ((⟨0,1⟩ : GaussianInt)^s.val * + (BandVectors.1 (DiamondRecursiveQuadruple K i.succ) (DiamondRecursiveQuadruple K 0) + + BandVectors.1 (DiamondRecursiveQuadruple K 0) (DiamondRecursiveQuadruple K i.succ)))) + (ha : q.1-p.1 = ((1/2 : ℝ) • GaussianRealPoint + ((-⟨0,1⟩ : GaussianInt)^s.val * + (BandVectors.2 (DiamondRecursiveQuadruple K i.succ) (DiamondRecursiveQuadruple K 0) + + BandVectors.2 (DiamondRecursiveQuadruple K 0) (DiamondRecursiveQuadruple K i.succ)))).1) + (hb : q.2-p.2 = ((1/2 : ℝ) • GaussianRealPoint + ((-⟨0,1⟩ : GaussianInt)^s.val * + (BandVectors.2 (DiamondRecursiveQuadruple K i.succ) (DiamondRecursiveQuadruple K 0) + + BandVectors.2 (DiamondRecursiveQuadruple K 0) (DiamondRecursiveQuadruple K + i.succ)))).2) : + OdometerCompatibility h k := AdjacencyInductionGeometry.diamondParent compare K hK i s T S + h k p q hh hk hp hq hc ha hb + refine ⟨OrderedGeneralOdometerAdjacencyClassification, ?_⟩ + intro C he + constructor + · intro T S h k hadj + obtain ⟨hh,hk,p,q,hp,hq,Q,i,e,hQ,hchild,hc,ha,hb⟩ := hadj + rw [← hchild] at hh hk he + obtain ⟨g,hcanon⟩ := P5491T1ExceptionalPresentation Q hQ he + obtain ⟨neg,r,t,_,hh',hk',hr,ht,hc',ha',hb',hcompat⟩ := + RightLatticeAdjacentPackingSymmetryTransport g Q hQ i e T S h k p q + hh hk hp hq hc ha hb + apply hcompat.mp + rcases hcanon with ⟨P,hP,h0,hparents⟩ | ⟨K,hK,h0,hparents⟩ + · obtain ⟨j,hj⟩ := hparents (if BandPackingSymmetryReversesOrientation g then -i else i) + rw [h0] at hh' hk' + rw [h0,hj] at hc' ha' hb' + exact fordRight P hP j _ _ _ _ _ r t hh' hk' hr ht hc' ha' hb' + · obtain ⟨j,hj⟩ := hparents (if BandPackingSymmetryReversesOrientation g then -i else i) + rw [h0] at hh' hk' + rw [h0,hj] at hc' ha' hb' + exact diamondRight K hK j _ _ _ _ _ r t hh' hk' hr ht hc' ha' hb' + · intro D T S h k hadj + obtain ⟨hh,hk,p,q,hp,hq,Q,i,s,hQ,hchild,hparent,hc,ha,hb⟩ := hadj + have hpos : 0 < (Q i.succ).1 := by rw [hparent]; exact D.2 + rw [← hchild] at hh he + rw [← hparent] at hk + obtain ⟨g,hcanon⟩ := P5491T1ExceptionalPresentation Q hQ he + obtain ⟨neg,r,t,s',_,_,hh',hk',hr,ht,hc',ha',hb',hcompat⟩ := + SubtileLatticeAdjacentPackingSymmetryTransport g Q hQ i s hpos + T S h k p q hh hk hp hq hc ha hb + apply hcompat.mp + have hpos' : 0 < ((BandPackingSymmetryQuadrupleAction g Q) + (if BandPackingSymmetryReversesOrientation g then -i else i).succ).1 := + AdjacencyInductionGeometry.hpos' D T S k p q Q i hk s hparent hc ha hb hpos g r t s' + hk' hc' ha' hb' + rcases hcanon with ⟨P,hP,h0,hparents⟩ | ⟨K,hK,h0,hparents⟩ + · obtain ⟨j,hj⟩ := hparents (if BandPackingSymmetryReversesOrientation g then -i else i) + rw [h0] at hh' + rw [hj] at hk' hpos' + rw [h0,hj] at hc' ha' hb' + exact fordParent P hP j s' _ _ _ _ r t hpos' hh' hk' hr ht hc' ha' hb' + · obtain ⟨j,hj⟩ := hparents (if BandPackingSymmetryReversesOrientation g then -i else i) + rw [h0] at hh' + rw [hj] at hk' + rw [h0,hj] at hc' ha' hb' + exact diamondParent K hK j s' _ _ _ _ r t hh' hk' hr ht hc' ha' hb' + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OdometerCompatibility.lean b/LeanPool/ApollonianSuperharmonic/OdometerCompatibility.lean new file mode 100644 index 0000000000..87dd1ceab0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OdometerCompatibility.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PartialOdometer + +-- [TABLET NODE: OdometerCompatibility] + +/-! +# OdometerCompatibility + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Two partial odometers $h_1,h_2$ are compatible if their domains are +disjoint, or if there is an integer $c$ such that +$$ + h_2(x)-h_1(x)=c +$$ +for every $x\in T(h_1)\cap T(h_2)$. When the intersection is nonempty, +$c$ is the offset constant of the ordered pair $(h_1,h_2)$. +-/ +def OdometerCompatibility (h₁ h₂ : PartialOdometer) : Prop := +-- BODY + Disjoint (h₁.domain : Set GaussianInt) (h₂.domain : Set GaussianInt) ∨ + ∃ c : ℤ, ∀ x, x ∈ h₁.domain → x ∈ h₂.domain → + h₂.value x - h₁.value x = c + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OdometerGluing.lean b/LeanPool/ApollonianSuperharmonic/OdometerGluing.lean new file mode 100644 index 0000000000..cfa0f4b9fd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OdometerGluing.lean @@ -0,0 +1,984 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.P3221T2ClosedWalkCirculation +public import LeanPool.ApollonianSuperharmonic.P3221T2ConnectedPathIntegration + +-- [TABLET NODE: OdometerGluing] + +/-! +# OdometerGluing + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OdometerGluingProof + +private theorem increment_eq : + (by + classical + exact + ∀ {ι : Type}, ∀ (h : ι → PartialOdometer), (∀ i, ∀ j, OdometerCompatibility (h i) (h j)) + → (∀ (i : ι), ∀ (j : ι), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (h i).domain) + → ((b ∈ (h i).domain) → ((a ∈ (h j).domain) → ((b ∈ (h j).domain) → ((h i).value b - + (h i).value a = (h j).value b - (h j).value a))))) ) := by + classical + intro ι h hcompat i j a b hai hbi haj hbj + rcases hcompat i j with hdis | ⟨c, hc⟩ + · exact (Set.disjoint_left.mp hdis hai haj).elim + · have ha := hc a hai haj + have hb := hc b hbi hbj + omega + +private theorem adjacent_symm : + (by + classical + exact + ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → + (FourNeighborAdjacent b a) ) := by + classical + intro a b hab + rcases hab with rfl | rfl | rfl | rfl + all_goals simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + +private theorem adjacent_irrefl : + (by + classical + exact + ∀ (a : GaussianInt), ¬ FourNeighborAdjacent a a ) := by + classical + intro a hab + rcases hab with hab | hab | hab | hab + all_goals + have hr := congrArg Zsqrtd.re hab + have hi := congrArg Zsqrtd.im hab + simp at hr hi + all_goals omega + +private theorem corner : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ T.cells) → (∀ (a : GaussianInt), (a = x ∨ a + = x + 1 ∨ a = x + ⟨0, 1⟩ ∨ + a = x + 1 + ⟨0, 1⟩) → (a ∈ FootprintVertices T)) ) := by + classical + intro T x hx a ha + simp only [FootprintVertices, ite_eq_left (show T.cells.Nonempty from ⟨x, hx⟩)] + exact ⟨x, hx, ha⟩ + +private theorem edge_vertices : + (by + classical + exact + (∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ T.cells) → (∀ (a : GaussianInt), (a = x ∨ a + = x + 1 ∨ a = x + ⟨0, 1⟩ ∨ a = x + 1 + ⟨0, 1⟩) → (a ∈ FootprintVertices T))) → (∀ (T + : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, b} : Finset + GaussianInt) ∈ FootprintEdges T) → (a ∈ FootprintVertices T ∧ b ∈ FootprintVertices + T)) ) := by + classical + intro corner T a b he + obtain ⟨s, hs, he⟩ := he + have endpoint (v : GaussianInt) (hv : v ∈ ({a, b} : Finset GaussianInt)) : + v ∈ FootprintVertices T := by + apply corner T s hs v + rcases he with he | he | he | he <;> rw [he] at hv + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hv + all_goals tauto + exact ⟨endpoint a (by simp), endpoint b (by simp)⟩ + +private theorem footprint_reachable : + (by + classical + exact + (∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → + (FourNeighborAdjacent b a)) → (∀ (W : ProtoTile), (LatticeTile W) → (∀ (a : + GaussianInt), ∀ (b : GaussianInt), (a ∈ FootprintVertices W) → ((b ∈ + FootprintVertices W) → (Relation.ReflTransGen (fun u v => FourNeighborAdjacent u v ∧ + ({u, v} : Finset GaussianInt) ∈ FootprintEdges W) a b)))) ) := by + classical + intro adjacent_symm W hW a b ha hb + let R (u v : GaussianInt) : Prop := FourNeighborAdjacent u v ∧ + ({u, v} : Finset GaussianInt) ∈ FootprintEdges W + let reach := Relation.ReflTransGen R + have reverse {u v : GaussianInt} (h : reach u v) : reach v u := by + induction h with + | refl => exact Relation.ReflTransGen.refl + | tail h he ih => + exact (Relation.ReflTransGen.single + ⟨adjacent_symm _ _ he.1, by simpa [Finset.pair_comm] using he.2⟩).trans ih + have bottom (s : GaussianInt) (hs : s ∈ W.cells) : reach s (s + 1) := + Relation.ReflTransGen.single ⟨Or.inl rfl, ⟨s, hs, Or.inl rfl⟩⟩ + have left (s : GaussianInt) (hs : s ∈ W.cells) : reach s (s + ⟨0, 1⟩) := + Relation.ReflTransGen.single ⟨Or.inr (Or.inr (Or.inl rfl)), + ⟨s, hs, Or.inr (Or.inl rfl)⟩⟩ + have right (s : GaussianInt) (hs : s ∈ W.cells) : + reach (s + 1) (s + 1 + ⟨0, 1⟩) := + Relation.ReflTransGen.single ⟨Or.inr (Or.inr (Or.inl rfl)), + ⟨s, hs, Or.inr (Or.inr (Or.inl rfl))⟩⟩ + have to_corner (s : GaussianInt) (hs : s ∈ W.cells) (v : GaussianInt) + (hv : v = s ∨ v = s + 1 ∨ v = s + ⟨0, 1⟩ ∨ v = s + 1 + ⟨0, 1⟩) : + reach s v := by + rcases hv with rfl | rfl | rfl | rfl + · exact Relation.ReflTransGen.refl + · exact bottom s hs + · exact left s hs + · exact (bottom s hs).trans (right s hs) + have cell_step (u v : GaussianInt) (hu : u ∈ W.cells) (hv : v ∈ W.cells) + (huv : FourNeighborAdjacent u v) : reach u v := by + rcases huv with rfl | rfl | rfl | rfl + · exact bottom u hu + · simpa using reverse (bottom (u - 1) hv) + · exact left u hu + · simpa using reverse (left (u - ⟨0, 1⟩) hv) + have chain_reach : ∀ (s : GaussianInt) (l : List GaussianInt), + (∀ v ∈ s :: l, v ∈ W.cells) → List.IsChain FourNeighborAdjacent (s :: l) → + ∀ t ∈ s :: l, reach s t := by + intro s l + induction l generalizing s with + | nil => + intro hcells hchain t ht + rcases List.mem_singleton.mp ht with rfl + exact Relation.ReflTransGen.refl + | cons t l ih => + intro hcells hchain v hv + have hst := (List.isChain_cons.mp hchain).1 t (by simp) + rcases List.mem_cons.mp hv with rfl | hv + · exact Relation.ReflTransGen.refl + · exact (cell_step s t (hcells s (by simp)) (hcells t (by simp)) hst).trans + (ih t (fun w hw => hcells w (by simp [hw])) + (List.isChain_cons.mp hchain).2 v hv) + have hcells := (LatticeTileGridStructure W hW).1 + have hnonempty : W.cells.Nonempty := hcells.1 + simp only [FootprintVertices, ite_eq_left hnonempty] at ha hb + obtain ⟨s, hs, has⟩ := ha + obtain ⟨t, ht, hbt⟩ := hb + obtain ⟨p, hhead, hlast, hp, hsteps⟩ := hcells.2 s hs t ht + have hst : reach s t := by + have hchain := List.isChain_iff_forall_rel_of_append_cons_cons.mpr hsteps + cases p with + | nil => simp at hhead + | cons v l => + simp only [List.head?_cons, Option.some.injEq] at hhead + subst v + exact chain_reach s l hp hchain t + (List.mem_of_mem_getLast? (by simp [hlast])) + exact (reverse (to_corner s hs a has)).trans (hst.trans (to_corner t ht b hbt)) + +private theorem footprint_constant : + (by + classical + exact + (∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ T.cells) → (∀ (a : GaussianInt), (a = x ∨ a + = x + 1 ∨ a = x + ⟨0, 1⟩ ∨ a = x + 1 + ⟨0, 1⟩) → (a ∈ FootprintVertices T))) → ((∀ (T + : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, b} : Finset + GaussianInt) ∈ FootprintEdges T) → (a ∈ FootprintVertices T ∧ b ∈ FootprintVertices + T)) → ((∀ (W : ProtoTile), (LatticeTile W) → (∀ (a : GaussianInt), ∀ (b : + GaussianInt), (a ∈ FootprintVertices W) → ((b ∈ FootprintVertices W) → + (Relation.ReflTransGen (fun u v => FourNeighborAdjacent u v ∧ ({u, v} : Finset + GaussianInt) ∈ FootprintEdges W) a b)))) → (∀ (W : ProtoTile), (LatticeTile W) → (∀ + (F : GaussianInt → ℤ), (∀ a, ∀ b, FourNeighborAdjacent a b → + ({a, b} : Finset GaussianInt) ∈ FootprintEdges W → F a = F b) → (∃ c : ℤ, ∀ x, x ∈ + FootprintVertices W → F x = c))))) ) := by + classical + intro corner edge_vertices footprint_reachable W hW F hF + obtain ⟨s, hs⟩ := (LatticeTileGridStructure W hW).1.1 + have hsf : s ∈ FootprintVertices W := corner W s hs s (by simp) + refine ⟨F s, ?_⟩ + intro x hx + have hr := footprint_reachable W hW s x hsf hx + have heq : F s = F x := by + induction hr with + | refl => rfl + | tail hr hstep ih => + exact (ih (edge_vertices W _ _ hstep.2).1).trans + (hF _ _ hstep.1 hstep.2) + exact heq.symm + +private theorem walk_sum : + (by + classical + exact + ∀ {α : Type}, ∀ (G : SimpleGraph α), ∀ (f : α → GaussianInt), ∀ (D : GaussianInt → + GaussianInt → ℤ), ∀ {a : α}, ∀ {b : α}, ∀ (p : G.Walk a b), (p.darts.map (fun d => D + (f d.fst) (f d.snd))).sum = (List.zipWith D (p.support.map f) (p.support.map + f).tail).sum ) := by + classical + intro α G f D a b p + induction p with + | nil => simp + | @cons a b c hab p ih => + cases p with + | nil => simp + | cons hbc q => + simpa only [SimpleGraph.Walk.darts_cons, List.map_cons, List.sum_cons, + SimpleGraph.Walk.support_cons, List.tail_cons, List.zipWith_cons_cons] + using congrArg (fun z => D (f a) (f b) + z) ih + +private theorem dmemberAt297 : + (by + classical + exact + (∀ {ι : Type}, ∀ (h : ι → PartialOdometer), (∀ i, ∀ j, OdometerCompatibility (h i) (h j)) + → (∀ (i : ι), ∀ (j : ι), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (h i).domain) + → ((b ∈ (h i).domain) → ((a ∈ (h j).domain) → ((b ∈ (h j).domain) → ((h i).value b - + (h i).value a = (h j).value b - (h j).value a)))))) → (∀ (n : ℕ), ∀ (h : Fin n → + PartialOdometer), (∀ (i : Fin n), ∀ (j : Fin n), OdometerCompatibility (h i) (h j)) → ( + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + let D (a b : GaussianInt) : ℤ := + if hc : covered a b then + (h (Classical.choose hc)).value b - (h (Classical.choose hc)).value a + else 0 + ∀ (i : Fin n), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (h i).domain) → ((b ∈ (h + i).domain) → (D a b = (h i).value b - (h i).value a)))) ) := by + classical + intro increment_eq n h hcompat covered D i a b ha hb + have hc : covered a b := ⟨i, ha, hb⟩ + simp only [D, dite_eq_left hc] + exact increment_eq h hcompat (Classical.choose hc) i a b + (Classical.choose_spec hc).1 (Classical.choose_spec hc).2 ha hb + +private theorem edge_coverAt304 : + (by + classical + exact + (∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ T.cells) → (∀ (a : GaussianInt), (a = x ∨ a + = x + 1 ∨ a = x + ⟨0, 1⟩ ∨ a = x + 1 + ⟨0, 1⟩) → (a ∈ FootprintVertices T))) → (∀ (n + : ℕ), ∀ (T : ProtoTile), ∀ (U : Fin n → ProtoTile), ∀ (h : Fin n → PartialOdometer), + (∀ (i : Fin n), (↑(h i).domain : Set GaussianInt) = FootprintVertices (U i)) → ((∀ (x + : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin n), x ∈ (U i).cells) → ( + let E (a b : GaussianInt) : Prop := FourNeighborAdjacent a b ∧ + ({a, b} : Finset GaussianInt) ∈ FootprintEdges T + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + ∀ (a : GaussianInt), ∀ (b : GaussianInt), (E a b) → (covered a b)))) ) := by + classical + intro corner n T U h hdom hcells E covered a b hab + obtain ⟨s, hs, he⟩ := hab.2 + obtain ⟨i, hsi⟩ := (hcells s).1 hs + have hav : a = s ∨ a = s + 1 ∨ a = s + ⟨0, 1⟩ ∨ a = s + 1 + ⟨0, 1⟩ := by + have hamem : a ∈ ({a, b} : Finset GaussianInt) := by simp + rcases he with he | he | he | he <;> rw [he] at hamem + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hamem + all_goals tauto + have hbv : b = s ∨ b = s + 1 ∨ b = s + ⟨0, 1⟩ ∨ b = s + 1 + ⟨0, 1⟩ := by + have hbmem : b ∈ ({a, b} : Finset GaussianInt) := by simp + rcases he with he | he | he | he <;> rw [he] at hbmem + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hbmem + all_goals tauto + refine ⟨i, ?_, ?_⟩ + · change a ∈ ((h i).domain : Set GaussianInt) + rw [hdom i] + exact corner (U i) s hsi a hav + · change b ∈ ((h i).domain : Set GaussianInt) + rw [hdom i] + exact corner (U i) s hsi b hbv + +private theorem hantiAt324 : + (by + classical + exact + ∀ (n : ℕ), ∀ (T : ProtoTile), ∀ (h : Fin n → PartialOdometer), + let E (a b : GaussianInt) : Prop := FourNeighborAdjacent a b ∧ + ({a, b} : Finset GaussianInt) ∈ FootprintEdges T + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + let D (a b : GaussianInt) : ℤ := + if hc : covered a b then + (h (Classical.choose hc)).value b - (h (Classical.choose hc)).value a + else 0 + (∀ (i : Fin n), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (h i).domain) → ((b ∈ (h + i).domain) → (D a b = (h i).value b - (h i).value a))) → ((∀ (a : GaussianInt), ∀ (b + : GaussianInt), (E a b) → (covered a b)) → (∀ a, ∀ b, E a b → D b a = -D a b)) ) := by + classical + intro n T h E covered D dmember edge_cover a b hab + obtain ⟨i, ha, hb⟩ := edge_cover a b hab + rw [dmember i b a hb ha, dmember i a b ha hb] + omega + +private theorem hflatAt329 : + (by + classical + exact + (∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ T.cells) → (∀ (a : GaussianInt), (a = x ∨ a + = x + 1 ∨ a = x + ⟨0, 1⟩ ∨ a = x + 1 + ⟨0, 1⟩) → (a ∈ FootprintVertices T))) → (∀ (n + : ℕ), ∀ (T : ProtoTile), ∀ (U : Fin n → ProtoTile), ∀ (h : Fin n → PartialOdometer), + (∀ (i : Fin n), (↑(h i).domain : Set GaussianInt) = FootprintVertices (U i)) → ((∀ (x + : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin n), x ∈ (U i).cells) → ( + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + let D (a b : GaussianInt) : ℤ := + if hc : covered a b then + (h (Classical.choose hc)).value b - (h (Classical.choose hc)).value a + else 0 + (∀ (i : Fin n), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (h i).domain) → ((b ∈ (h + i).domain) → (D a b = (h i).value b - (h i).value a))) → (∀ x ∈ T.cells, D x (x + 1) + + D (x + 1) (x + 1 + ⟨0, 1⟩) + D (x + 1 + ⟨0, 1⟩) (x + ⟨0, 1⟩) + D (x + ⟨0, 1⟩) x = + 0)))) ) := by + classical + intro corner n T U h hdom hcells covered D dmember x hx + obtain ⟨i, hxi⟩ := (hcells x).1 hx + have hc (a : GaussianInt) (ha : a = x ∨ a = x + 1 ∨ + a = x + ⟨0, 1⟩ ∨ a = x + 1 + ⟨0, 1⟩) : a ∈ (h i).domain := by + change a ∈ ((h i).domain : Set GaussianInt) + rw [hdom i] + exact corner (U i) x hxi a ha + rw [dmember i x (x + 1) (hc x (by simp)) (hc (x + 1) (by simp)), + dmember i (x + 1) (x + 1 + ⟨0, 1⟩) + (hc (x + 1) (by simp)) (hc (x + 1 + ⟨0, 1⟩) (by simp)), + dmember i (x + 1 + ⟨0, 1⟩) (x + ⟨0, 1⟩) + (hc (x + 1 + ⟨0, 1⟩) (by simp)) (hc (x + ⟨0, 1⟩) (by simp)), + dmember i (x + ⟨0, 1⟩) x (hc (x + ⟨0, 1⟩) (by simp)) (hc x (by simp))] + omega + +private theorem hconnAt356 : + (by + classical + exact + ∀ (adjacent_symm : ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → + (FourNeighborAdjacent b a)), ∀ (adjacent_irrefl : ∀ (a : GaussianInt), ¬ + FourNeighborAdjacent a a), ∀ (corner : ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ + T.cells) → (∀ (a : GaussianInt), (a = x ∨ a = x + 1 ∨ a = x + ⟨0, 1⟩ ∨ a = x + 1 + + ⟨0, 1⟩) → (a ∈ FootprintVertices T))), (∀ (T : ProtoTile), ∀ (a : GaussianInt), ∀ (b + : GaussianInt), (({a, b} : Finset GaussianInt) ∈ FootprintEdges T) + → (a ∈ FootprintVertices T ∧ b ∈ FootprintVertices T)) → ((∀ (W : ProtoTile), + (LatticeTile W) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ + FootprintVertices W) → ((b ∈ FootprintVertices W) → (Relation.ReflTransGen (fun u v + => FourNeighborAdjacent u v ∧ ({u, v} : Finset GaussianInt) ∈ FootprintEdges W) a + b)))) → (∀ (T : ProtoTile), (LatticeTile T) → ( + let E (a b : GaussianInt) : Prop := FourNeighborAdjacent a b ∧ + ({a, b} : Finset GaussianInt) ∈ FootprintEdges T + let G : SimpleGraph {x // x ∈ FootprintVertices T} := { + Adj := fun a b => E a.val b.val + symm := ⟨by + intro a b hab + exact ⟨adjacent_symm a b hab.1, by simpa [Finset.pair_comm] using hab.2⟩⟩ + loopless := ⟨by intro a ha; exact adjacent_irrefl a ha.1⟩ } + ∀ (z : LatticeCell), ∀ (hz : z ∈ (↑T.cells : Set LatticeCell)), + let base : {x // x ∈ FootprintVertices T} := ⟨z, corner T z hz z (by simp)⟩ + ∀ x, Nonempty (G.Walk base x))))) := by + classical + intro adjacent_symm adjacent_irrefl corner edge_vertices footprint_reachable T hT E G z hz base + have lift : ∀ {a b}, Relation.ReflTransGen E a b → + ∀ (ha : a ∈ FootprintVertices T) (hb : b ∈ FootprintVertices T), + Nonempty (G.Walk ⟨a, ha⟩ ⟨b, hb⟩) := by + intro a b hr + induction hr with + | refl => intro ha hb; exact ⟨SimpleGraph.Walk.nil⟩ + | @tail b c hr he ih => + intro ha hc + have hb := (edge_vertices T b c he.2).1 + obtain ⟨p⟩ := ih ha hb + exact ⟨p.concat he⟩ + intro x + exact lift (footprint_reachable T hT base x base.property x.property) + base.property x.property + +private theorem hclosedAt371 : + (by + classical + exact + ∀ (adjacent_symm : ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → + (FourNeighborAdjacent b a)), ∀ (adjacent_irrefl : ∀ (a : GaussianInt), ¬ + FourNeighborAdjacent a a), (∀ {α : Type}, ∀ (G : SimpleGraph α), ∀ (f : α → + GaussianInt), ∀ (D : GaussianInt → GaussianInt → ℤ), ∀ {a : α}, ∀ {b : α}, ∀ (p : + G.Walk a b), (p.darts.map (fun d => D (f d.fst) (f d.snd))).sum = (List.zipWith D + (p.support.map f) (p.support.map f).tail).sum) → (∀ (n : ℕ), ∀ (T : ProtoTile), ∀ (h + : Fin n → PartialOdometer), + let E (a b : GaussianInt) : Prop := FourNeighborAdjacent a b ∧ + ({a, b} : Finset GaussianInt) ∈ FootprintEdges T + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + let D (a b : GaussianInt) : ℤ := + if hc : covered a b then + (h (Classical.choose hc)).value b - (h (Classical.choose hc)).value a + else 0 + (∀ (p : List GaussianInt), ∀ (x : GaussianInt), p.head? = some x → + p.getLast? = some x → List.IsChain (fun (a b : LatticeCell) => FourNeighborAdjacent a + b ∧ {a, b} ∈ FootprintEdges T) p → (List.zipWith D p p.tail).sum = (0 : ℤ)) → ( + let G : SimpleGraph {x // x ∈ FootprintVertices T} := { + Adj := fun a b => E a.val b.val + symm := ⟨by + intro a b hab + exact ⟨adjacent_symm a b hab.1, by simpa [Finset.pair_comm] using hab.2⟩⟩ + loopless := ⟨by intro a ha; exact adjacent_irrefl a ha.1⟩ } + ∀ x, ∀ (p : G.Walk x x), (p.darts.map (fun d => D d.fst.val d.snd.val)).sum = 0))) := by + classical + intro adjacent_symm adjacent_irrefl walk_sum n T h E covered D hcirculation G x p + rw [walk_sum G Subtype.val D p] + apply hcirculation (p.support.map Subtype.val) x.val + · rw [List.head?_map, List.head?_eq_some_head p.support_ne_nil] + simp + · rw [List.getLast?_map, List.getLast?_eq_some_getLast p.support_ne_nil] + simp + · exact List.isChain_map_of_isChain Subtype.val + (fun a b hab => hab) p.isChain_adj_support + +private theorem hdomain : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (z : LatticeCell), (z ∈ (↑T.cells : Set LatticeCell)) → ( + let dom : Finset GaussianInt := T.cells.biUnion (fun x => + {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) + (dom : Set GaussianInt) = FootprintVertices T) ) := by + classical + intro T z hz dom + ext x + simp only [dom, Finset.mem_coe, Finset.mem_biUnion, Finset.mem_insert, + Finset.mem_singleton, FootprintVertices, ite_eq_left (show T.cells.Nonempty from ⟨z, hz⟩)] + rfl + +private theorem hx' : + (by + classical + exact + ∀ (T : ProtoTile), + let dom : Finset GaussianInt := T.cells.biUnion (fun x => + {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) + ((dom : Set GaussianInt) = FootprintVertices T) → (∀ (x : GaussianInt), (x ∉ dom) → (x ∉ + FootprintVertices T)) ) := by + classical + intro T dom hdomain x hx + rw [← hdomain] + exact hx + +private theorem hgcompat : + (by + classical + exact + ∀ (adjacent_symm : ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → + (FourNeighborAdjacent b a)), ∀ (adjacent_irrefl : ∀ (a : GaussianInt), ¬ + FourNeighborAdjacent a a), ∀ (corner : ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ + T.cells) → (∀ (a : GaussianInt), (a = x ∨ a = x + 1 ∨ a = x + ⟨0, 1⟩ ∨ a = x + 1 + + ⟨0, 1⟩) → (a ∈ FootprintVertices T))), ∀ (edge_vertices : ∀ (T : ProtoTile), ∀ (a : + GaussianInt), ∀ (b : GaussianInt), (({a, b} : Finset GaussianInt) ∈ FootprintEdges T) + → (a ∈ FootprintVertices T ∧ b ∈ FootprintVertices T)), ∀ (footprint_constant : ∀ (W + : ProtoTile), (LatticeTile W) → (∀ (F : GaussianInt → ℤ), (∀ a, ∀ b, + FourNeighborAdjacent a b → ({a, b} : Finset GaussianInt) ∈ FootprintEdges W → F a = F + b) → (∃ c : ℤ, ∀ x, x ∈ FootprintVertices W → F x = c))), ∀ (n : ℕ), ∀ (T : + ProtoTile), ∀ (U : Fin n → ProtoTile), ∀ (h : Fin n → PartialOdometer), ∀ (hU : ∀ (i + : Fin n), LatticeTile (U i)), ∀ (hdom : ∀ (i : Fin n), (↑(h i).domain : Set + GaussianInt) = FootprintVertices (U i)), ∀ (hcells : ∀ (x : LatticeCell), x ∈ T.cells + ↔ ∃ (i : Fin n), x ∈ (U i).cells), ∀ (hverts : ∀ (x : GaussianInt), x ∈ + FootprintVertices T ↔ ∃ (i : Fin n), x ∈ (h i).domain), + let E (a b : GaussianInt) : Prop := FourNeighborAdjacent a b ∧ + ({a, b} : Finset GaussianInt) ∈ FootprintEdges T + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + let D (a b : GaussianInt) : ℤ := + if hc : covered a b then + (h (Classical.choose hc)).value b - (h (Classical.choose hc)).value a + else 0 + ∀ (dmember : ∀ (i : Fin n), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (h i).domain) + → ((b ∈ (h i).domain) → (D a b = (h i).value b - (h i).value a))), + let G : SimpleGraph {x // x ∈ FootprintVertices T} := { + Adj := fun a b => E a.val b.val + symm := ⟨by + intro a b hab + exact ⟨adjacent_symm a b hab.1, by simpa [Finset.pair_comm] using hab.2⟩⟩ + loopless := ⟨by intro a ha; exact adjacent_irrefl a ha.1⟩ } + ∀ (z : LatticeCell), ∀ (hz : z ∈ (↑T.cells : Set LatticeCell)), ∀ (f : + { x : GaussianInt // x ∈ FootprintVertices T } → ℤ), ∀ (hfedge : ∀ (a : + { x : GaussianInt // x ∈ FootprintVertices T }), ∀ (b : + { x : GaussianInt // x ∈ FootprintVertices T }), G.Adj a b → f b - f a = D (↑a : + GaussianInt) (↑b : GaussianInt)), + let dom : Finset GaussianInt := T.cells.biUnion (fun x => + {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) + ∀ (hdomain : (dom : Set GaussianInt) = FootprintVertices T), + let g : PartialOdometer := { + domain := dom + value := fun x => if hx : x ∈ FootprintVertices T then f ⟨x, hx⟩ else 0 + value_outside := by + intro x hx + have hx' : x ∉ FootprintVertices T := by + rw [← hdomain] + exact hx + simp [hx'] } + (∀ (x : {x // x ∈ FootprintVertices T}), g.value x = f x) → (∀ i, OdometerCompatibility g + (h i)) ) := by + classical + intro adjacent_symm adjacent_irrefl corner edge_vertices footprint_constant n T U h hU hdom + hcells hverts E covered D dmember G z hz f hfedge dom hdomain g hgvalue i + obtain ⟨c, hc⟩ := footprint_constant (U i) (hU i) + (fun x => g.value x - (h i).value x) (by + intro a b hadj he + have hends := edge_vertices (U i) a b he + have hai : a ∈ (h i).domain := by + change a ∈ ((h i).domain : Set GaussianInt) + rw [hdom i] + exact hends.1 + have hbi : b ∈ (h i).domain := by + change b ∈ ((h i).domain : Set GaussianInt) + rw [hdom i] + exact hends.2 + have haT := (hverts a).2 ⟨i, hai⟩ + have hbT := (hverts b).2 ⟨i, hbi⟩ + have heT : ({a, b} : Finset GaussianInt) ∈ FootprintEdges T := by + obtain ⟨s, hs, hes⟩ := he + exact ⟨s, (hcells s).2 ⟨i, hs⟩, hes⟩ + have hed := hfedge ⟨a, haT⟩ ⟨b, hbT⟩ ⟨hadj, heT⟩ + have hga := hgvalue ⟨a, haT⟩ + have hgb := hgvalue ⟨b, hbT⟩ + rw [dmember i a b hai hbi] at hed + dsimp only at hed hga hgb ⊢ + omega) + apply Or.inr + refine ⟨-c, ?_⟩ + intro x hxg hxi + have hxfoot : x ∈ FootprintVertices (U i) := by + rw [← hdom i] + exact hxi + have hxc := hc x hxfoot + change g.value x - (h i).value x = c at hxc + omega + +private theorem hg'edge : + (by + classical + exact + ∀ (adjacent_symm : ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → + (FourNeighborAdjacent b a)), ∀ (adjacent_irrefl : ∀ (a : GaussianInt), ¬ + FourNeighborAdjacent a a), (∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ + T.cells) → (∀ (a : GaussianInt), (a = x ∨ a = x + 1 ∨ a = x + ⟨0, 1⟩ ∨ a = x + 1 + + ⟨0, 1⟩) → (a ∈ FootprintVertices T))) → (∀ (n : ℕ), ∀ (T : ProtoTile), ∀ (h : Fin n → + PartialOdometer), + let E (a b : GaussianInt) : Prop := FourNeighborAdjacent a b ∧ + ({a, b} : Finset GaussianInt) ∈ FootprintEdges T + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + let D (a b : GaussianInt) : ℤ := + if hc : covered a b then + (h (Classical.choose hc)).value b - (h (Classical.choose hc)).value a + else 0 + (∀ (i : Fin n), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (h i).domain) + → ((b ∈ (h i).domain) → (D a b = (h i).value b - (h i).value a))) → ((∀ (a : + GaussianInt), ∀ (b : GaussianInt), (E a b) → (covered a b)) → ( + let G : SimpleGraph {x // x ∈ FootprintVertices T} := { + Adj := fun a b => E a.val b.val + symm := ⟨by + intro a b hab + exact ⟨adjacent_symm a b hab.1, by simpa [Finset.pair_comm] using hab.2⟩⟩ + loopless := ⟨by intro a ha; exact adjacent_irrefl a ha.1⟩ } + ∀ (z : LatticeCell), (z ∈ (↑T.cells : Set LatticeCell)) → + (({ x : GaussianInt // x ∈ FootprintVertices T } → ℤ) → (∀ (g' : PartialOdometer), + ((↑g'.domain : Set GaussianInt) = FootprintVertices T) → ((∀ (i : Fin n), + OdometerCompatibility g' (h i)) → (∀ a, ∀ b, G.Adj a b → g'.value b - g'.value a = D + a b)))))))) := by + classical + intro adjacent_symm adjacent_irrefl corner n T h E covered D dmember edge_cover G z hz f g' + hg'dom hg'compat a b hab + obtain ⟨i, hai, hbi⟩ := edge_cover a b hab + have hga : a.val ∈ g'.domain := by + change a.val ∈ (g'.domain : Set GaussianInt) + rw [hg'dom] + exact a.property + have hgb : b.val ∈ g'.domain := by + change b.val ∈ (g'.domain : Set GaussianInt) + rw [hg'dom] + exact b.property + rcases hg'compat i with hd | ⟨c, hc⟩ + · exact (Set.disjoint_left.mp hd hga hai).elim + · have hca := hc a hga hai + have hcb := hc b hgb hbi + rw [dmember i a b hai hbi] + omega + +private theorem dmemberAt470 : + (by + classical + exact + (∀ {ι : Type}, ∀ (h : ι → PartialOdometer), (∀ i, ∀ j, OdometerCompatibility (h i) (h j)) + → (∀ (i : ι), ∀ (j : ι), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (h i).domain) + → ((b ∈ (h i).domain) → ((a ∈ (h j).domain) → ((b ∈ (h j).domain) → ((h i).value b - + (h i).value a = (h j).value b - (h j).value a)))))) → (∀ (ι : Type), ∀ (h : ι → + PartialOdometer), (∀ (i : ι), ∀ (j : ι), OdometerCompatibility (h i) (h j)) → ( + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + let D (a b : GaussianInt) : ℤ := + if hc : covered a b then + (h (Classical.choose hc)).value b - (h (Classical.choose hc)).value a + else 0 + ∀ (i : ι), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (h i).domain) → ((b ∈ (h + i).domain) → (D a b = (h i).value b - (h i).value a)))) ) := by + classical + intro increment_eq ι h hcompat covered D i a b ha hb + have hc : covered a b := ⟨i, ha, hb⟩ + simp only [D, dite_eq_left hc] + exact increment_eq h hcompat (Classical.choose hc) i a b + (Classical.choose_spec hc).1 (Classical.choose_spec hc).2 ha hb + +private theorem edge_coverAt477 : + (by + classical + exact + ∀ (ι : Type), ∀ (h : ι → PartialOdometer), (∀ (x : GaussianInt), ∃ (i : ι), x ∈ (h + i).domain ∧ x + (1 : GaussianInt) ∈ (h i).domain ∧ x + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∈ (h i).domain ∧ x + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∈ (h i).domain) → ( + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → (covered a b)) ) + := by + classical + intro ι h hcover covered a b hab + rcases hab with rfl | rfl | rfl | rfl + · obtain ⟨i, h0, h1, hi, h1i⟩ := hcover a + exact ⟨i, h0, h1⟩ + · obtain ⟨i, h0, h1, hi, h1i⟩ := hcover (a - 1) + exact ⟨i, by simpa using h1, h0⟩ + · obtain ⟨i, h0, h1, hi, h1i⟩ := hcover a + exact ⟨i, h0, hi⟩ + · obtain ⟨i, h0, h1, hi, h1i⟩ := hcover (a - ⟨0, 1⟩) + exact ⟨i, by simpa using hi, h0⟩ + +private theorem hantiAt488 : + (by + classical + exact + ∀ (ι : Type), ∀ (h : ι → PartialOdometer), + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + let D (a b : GaussianInt) : ℤ := + if hc : covered a b then + (h (Classical.choose hc)).value b - (h (Classical.choose hc)).value a + else 0 + (∀ (i : ι), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (h i).domain) → ((b ∈ (h + i).domain) → (D a b = (h i).value b - (h i).value a))) → ((∀ (a : GaussianInt), ∀ (b + : GaussianInt), (FourNeighborAdjacent a b) → (covered a b)) → (∀ a, ∀ b, + FourNeighborAdjacent a b → D b a = -D a b)) ) := by + classical + intro ι h covered D dmember edge_cover a b hab + obtain ⟨i, ha, hb⟩ := edge_cover a b hab + rw [dmember i b a hb ha, dmember i a b ha hb] + omega + +private theorem hflatAt493 : + (by + classical + exact + ∀ (ι : Type), ∀ (h : ι → PartialOdometer), (∀ (x : GaussianInt), ∃ (i : ι), x ∈ (h + i).domain ∧ x + (1 : GaussianInt) ∈ (h i).domain ∧ x + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∈ (h i).domain ∧ x + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∈ (h i).domain) → ( + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + let D (a b : GaussianInt) : ℤ := + if hc : covered a b then + (h (Classical.choose hc)).value b - (h (Classical.choose hc)).value a + else 0 + (∀ (i : ι), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (h i).domain) → ((b ∈ (h + i).domain) → (D a b = (h i).value b - (h i).value a))) → (∀ x, D x (x + 1) + D (x + + 1) (x + 1 + ⟨0, 1⟩) + D (x + 1 + ⟨0, 1⟩) (x + ⟨0, 1⟩) + D (x + ⟨0, 1⟩) x = 0)) ) := by + classical + intro ι h hcover covered D dmember x + obtain ⟨i, h0, h1, hi, h1i⟩ := hcover x + rw [dmember i x (x + 1) h0 h1, + dmember i (x + 1) (x + 1 + ⟨0, 1⟩) h1 h1i, + dmember i (x + 1 + ⟨0, 1⟩) (x + ⟨0, 1⟩) h1i hi, + dmember i (x + ⟨0, 1⟩) x hi h0] + omega + +private theorem hconnAt508 : + (by + classical + exact + ∀ (adjacent_symm : ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → + (FourNeighborAdjacent b a)), ∀ (adjacent_irrefl : ∀ (a : GaussianInt), ¬ + FourNeighborAdjacent a a), + let G : SimpleGraph GaussianInt := { + Adj := FourNeighborAdjacent + symm := ⟨fun {a b} => adjacent_symm a b⟩ + loopless := ⟨fun {a} => adjacent_irrefl a⟩ } + ∀ x, Nonempty (G.Walk 0 x) ) := by + classical + intro adjacent_symm adjacent_irrefl G + have horizontal (m : ℤ) : G.Reachable 0 ⟨m, 0⟩ := by + refine Int.inductionOn' m 0 ?_ ?_ ?_ + · exact SimpleGraph.Reachable.refl 0 + · intro k hk ih + refine ih.trans (SimpleGraph.Adj.reachable ?_) + exact Or.inl (by apply Zsqrtd.ext <;> simp) + · intro k hk ih + refine ih.trans (SimpleGraph.Adj.reachable ?_) + exact Or.inr (Or.inl (by apply Zsqrtd.ext <;> simp)) + intro x + change G.Reachable 0 ⟨x.re, x.im⟩ + refine Int.inductionOn' x.im 0 (horizontal x.re) ?_ ?_ + · intro k hk ih + refine ih.trans (SimpleGraph.Adj.reachable ?_) + exact Or.inr (Or.inr (Or.inl (by apply Zsqrtd.ext <;> simp))) + · intro k hk ih + refine ih.trans (SimpleGraph.Adj.reachable ?_) + exact Or.inr (Or.inr (Or.inr (by apply Zsqrtd.ext <;> simp))) + +private theorem hclosedAt527 : + (by + classical + exact + ∀ (adjacent_symm : ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → + (FourNeighborAdjacent b a)), ∀ (adjacent_irrefl : ∀ (a : GaussianInt), ¬ + FourNeighborAdjacent a a), (∀ {α : Type}, ∀ (G : SimpleGraph α), ∀ (f : α → + GaussianInt), ∀ (D : GaussianInt → GaussianInt → ℤ), ∀ {a : α}, ∀ {b : α}, ∀ (p : + G.Walk a b), (p.darts.map (fun d => D (f d.fst) (f d.snd))).sum = (List.zipWith D + (p.support.map f) (p.support.map f).tail).sum) → (∀ (ι : Type), ∀ (h : ι → + PartialOdometer), + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + let D (a b : GaussianInt) : ℤ := + if hc : covered a b then + (h (Classical.choose hc)).value b - (h (Classical.choose hc)).value a + else 0 + (∀ (p : List GaussianInt), ∀ (x : GaussianInt), p.head? = some x → p.getLast? = some x → + List.IsChain FourNeighborAdjacent p → (List.zipWith D p p.tail).sum = (0 : ℤ)) → ( + let G : SimpleGraph GaussianInt := { + Adj := FourNeighborAdjacent + symm := ⟨fun {a b} => adjacent_symm a b⟩ + loopless := ⟨fun {a} => adjacent_irrefl a⟩ } + ∀ x, ∀ (p : G.Walk x x), (p.darts.map (fun d => D d.fst d.snd)).sum = 0)) ) := by + classical + intro adjacent_symm adjacent_irrefl walk_sum ι h covered D hcirculation G x p + have hi := walk_sum G id D p + simp only [id_eq, List.map_id] at hi + rw [hi] + apply hcirculation p.support x + · rw [List.head?_eq_some_head p.support_ne_nil] + simp + · rw [List.getLast?_eq_some_getLast p.support_ne_nil] + simp + · exact p.isChain_adj_support + +private theorem hgmember : + (by + classical + exact + ∀ (adjacent_symm : ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → + (FourNeighborAdjacent b a)), ∀ (adjacent_irrefl : ∀ (a : GaussianInt), ¬ + FourNeighborAdjacent a a), (∀ (T : ProtoTile), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), (({a, b} : Finset GaussianInt) ∈ FootprintEdges T) → (a ∈ + FootprintVertices T ∧ b ∈ FootprintVertices T)) → ((∀ (W : ProtoTile), (LatticeTile + W) → (∀ (F : GaussianInt → ℤ), (∀ a, ∀ b, FourNeighborAdjacent a b → ({a, b} : Finset + GaussianInt) ∈ FootprintEdges W → F a = F b) → (∃ c : ℤ, ∀ x, x ∈ FootprintVertices W + → F x = c))) → (∀ (ι : Type), ∀ (T : ι → ProtoTile), ∀ (h : ι → PartialOdometer), (∀ + (i : ι), LatticeTile (T i)) → ((∀ (i : ι), (↑(h i).domain : Set GaussianInt) = + FootprintVertices (T i)) → ( + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + let D (a b : GaussianInt) : ℤ := + if hc : covered a b then + (h (Classical.choose hc)).value b - (h (Classical.choose hc)).value a + else 0 + (∀ (i : ι), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (h i).domain) → ((b ∈ (h + i).domain) → (D a b = (h i).value b - (h i).value a))) → ( + let G : SimpleGraph GaussianInt := { + Adj := FourNeighborAdjacent + symm := ⟨fun {a b} => adjacent_symm a b⟩ + loopless := ⟨fun {a} => adjacent_irrefl a⟩ } + ∀ (g : GaussianInt → ℤ), (∀ (a : GaussianInt), ∀ (b : GaussianInt), G.Adj a b → g b - g a + = D a b) → (∀ i, ∃ c : ℤ, ∀ x, x ∈ (h i).domain → g x - (h i).value x = c)))))) ) := by + classical + intro adjacent_symm adjacent_irrefl edge_vertices footprint_constant ι T h hT hdom covered D + dmember G g hgedge i + obtain ⟨c, hc⟩ := footprint_constant (T i) (hT i) + (fun x => g x - (h i).value x) (by + intro a b hadj he + have hends := edge_vertices (T i) a b he + have hai : a ∈ (h i).domain := by + change a ∈ ((h i).domain : Set GaussianInt) + rw [hdom i] + exact hends.1 + have hbi : b ∈ (h i).domain := by + change b ∈ ((h i).domain : Set GaussianInt) + rw [hdom i] + exact hends.2 + have hed := hgedge a b hadj + rw [dmember i a b hai hbi] at hed + change g a - (h i).value a = g b - (h i).value b + omega) + refine ⟨c, ?_⟩ + intro x hx + apply hc x + rw [← hdom i] + exact hx + +end OdometerGluingProof + +theorem OdometerGluing : + (∀ {n : ℕ} {T : ProtoTile} {U : Fin n → ProtoTile} + {h : Fin n → PartialOdometer}, + LatticeTile T → + (∀ i, LatticeTile (U i)) → + (∀ i, ((h i).domain : Set GaussianInt) = FootprintVertices (U i)) → + (∀ i j, OdometerCompatibility (h i) (h j)) → + (∀ x, x ∈ T.cells ↔ ∃ i, x ∈ (U i).cells) → + (∀ x, x ∈ FootprintVertices T ↔ ∃ i, x ∈ (h i).domain) → + ∃ g : PartialOdometer, + (g.domain : Set GaussianInt) = FootprintVertices T ∧ + (∀ i, OdometerCompatibility g (h i)) ∧ + ∀ g' : PartialOdometer, + (g'.domain : Set GaussianInt) = FootprintVertices T → + (∀ i, OdometerCompatibility g' (h i)) → + ∃ c : ℤ, ∀ x, x ∈ g.domain → g'.value x - g.value x = c) ∧ + (∀ {ι : Type} [Nonempty ι] {T : ι → ProtoTile} + {h : ι → PartialOdometer}, + (∀ i, LatticeTile (T i)) → + (∀ i, ((h i).domain : Set GaussianInt) = FootprintVertices (T i)) → + (∀ i j, OdometerCompatibility (h i) (h j)) → + (∀ x : GaussianInt, ∃ i, + x ∈ (h i).domain ∧ x + 1 ∈ (h i).domain ∧ + x + ⟨0, 1⟩ ∈ (h i).domain ∧ + x + 1 + ⟨0, 1⟩ ∈ (h i).domain) → + ∃ g : IntegerLatticeFunction, + (∀ i, ∃ c : ℤ, ∀ x, x ∈ (h i).domain → + g x - (h i).value x = c) ∧ + ∀ g' : IntegerLatticeFunction, + (∀ i, ∃ c : ℤ, ∀ x, x ∈ (h i).domain → + g' x - (h i).value x = c) → + ∃ c : ℤ, ∀ x, g' x - g x = c) := by +-- BODY + classical + have increment_eq {ι : Type} (h : ι → PartialOdometer) + (hcompat : ∀ i j, OdometerCompatibility (h i) (h j)) + (i j : ι) (a b : GaussianInt) + (hai : a ∈ (h i).domain) (hbi : b ∈ (h i).domain) + (haj : a ∈ (h j).domain) (hbj : b ∈ (h j).domain) := OdometerGluingProof.increment_eq (ι := + ι) h hcompat i j a b hai hbi haj hbj + have adjacent_symm (a b : GaussianInt) (hab : FourNeighborAdjacent a b) : + FourNeighborAdjacent b a := OdometerGluingProof.adjacent_symm a b hab + have adjacent_irrefl (a : GaussianInt) := OdometerGluingProof.adjacent_irrefl a + have corner (T : ProtoTile) (x : GaussianInt) (hx : x ∈ T.cells) + (a : GaussianInt) + (ha : a = x ∨ a = x + 1 ∨ a = x + ⟨0, 1⟩ ∨ + a = x + 1 + ⟨0, 1⟩) : a ∈ FootprintVertices T := OdometerGluingProof.corner T x hx a ha + have edge_vertices (T : ProtoTile) (a b : GaussianInt) + (he : ({a, b} : Finset GaussianInt) ∈ FootprintEdges T) := + OdometerGluingProof.edge_vertices corner T a b he + have footprint_reachable (W : ProtoTile) (hW : LatticeTile W) + (a b : GaussianInt) (ha : a ∈ FootprintVertices W) (hb : b ∈ FootprintVertices W) := + OdometerGluingProof.footprint_reachable adjacent_symm W hW a b ha hb + have footprint_constant (W : ProtoTile) (hW : LatticeTile W) + (F : GaussianInt → ℤ) + (hF : ∀ a b, FourNeighborAdjacent a b → + ({a, b} : Finset GaussianInt) ∈ FootprintEdges W → F a = F b) := + OdometerGluingProof.footprint_constant corner edge_vertices footprint_reachable W hW + F hF + have walk_sum {α : Type} (G : SimpleGraph α) + (f : α → GaussianInt) (D : GaussianInt → GaussianInt → ℤ) + {a b : α} (p : G.Walk a b) := OdometerGluingProof.walk_sum (α := α) G f D (a := a) (b := b) p + constructor + · intro n T U h hT hU hdom hcompat hcells hverts + let E (a b : GaussianInt) : Prop := FourNeighborAdjacent a b ∧ + ({a, b} : Finset GaussianInt) ∈ FootprintEdges T + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + let D (a b : GaussianInt) : ℤ := + if hc : covered a b then + (h (Classical.choose hc)).value b - (h (Classical.choose hc)).value a + else 0 + have dmember (i : Fin n) (a b : GaussianInt) + (ha : a ∈ (h i).domain) (hb : b ∈ (h i).domain) : + D a b = (h i).value b - (h i).value a := OdometerGluingProof.dmemberAt297 increment_eq n + h hcompat i a b ha hb + have edge_cover (a b : GaussianInt) (hab : E a b) := OdometerGluingProof.edge_coverAt304 + corner n T U h hdom hcells a b hab + have hanti := OdometerGluingProof.hantiAt324 n T h dmember edge_cover + have hflat := OdometerGluingProof.hflatAt329 corner n T U h hdom hcells dmember + have hcirculation := P3221T2ClosedWalkCirculation.1 T hT D + (fun a b ha he => hanti a b ⟨ha, he⟩) hflat + let G : SimpleGraph {x // x ∈ FootprintVertices T} := { + Adj := fun a b => E a.val b.val + symm := ⟨by + intro a b hab + exact ⟨adjacent_symm a b hab.1, by simpa [Finset.pair_comm] using hab.2⟩⟩ + loopless := ⟨by intro a ha; exact adjacent_irrefl a ha.1⟩ } + obtain ⟨z, hz⟩ := (LatticeTileGridStructure T hT).1.1 + let base : {x // x ∈ FootprintVertices T} := ⟨z, corner T z hz z (by simp)⟩ + have hconn := OdometerGluingProof.hconnAt356 adjacent_symm adjacent_irrefl corner + edge_vertices footprint_reachable T hT z hz + have hclosed := OdometerGluingProof.hclosedAt371 adjacent_symm adjacent_irrefl walk_sum n T h + hcirculation + obtain ⟨f, hfbase, hfedge, hfunique⟩ := + P3221T2ConnectedPathIntegration G base hconn + (fun a b => D a.val b.val) (fun a b hab => hanti a b hab) hclosed + let dom : Finset GaussianInt := T.cells.biUnion (fun x => + {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) + have hdomain : (dom : Set GaussianInt) = FootprintVertices T := OdometerGluingProof.hdomain T + z hz + let g : PartialOdometer := { + domain := dom + value := fun x => if hx : x ∈ FootprintVertices T then f ⟨x, hx⟩ else 0 + value_outside := by + intro x hx + have hx' : x ∉ FootprintVertices T := OdometerGluingProof.hx' T hdomain x hx + simp [hx'] } + have hgvalue (x : {x // x ∈ FootprintVertices T}) : g.value x = f x := by + simp [g, x.property] + have hgcompat := OdometerGluingProof.hgcompat adjacent_symm adjacent_irrefl corner + edge_vertices footprint_constant n T U h hU hdom hcells hverts dmember z hz f hfedge + hdomain hgvalue + refine ⟨g, hdomain, hgcompat, ?_⟩ + intro g' hg'dom hg'compat + have hg'edge := OdometerGluingProof.hg'edge adjacent_symm adjacent_irrefl corner n T h + dmember edge_cover z hz f g' hg'dom hg'compat + obtain ⟨c, hc⟩ := hfunique (fun x => g'.value x) hg'edge + refine ⟨c, ?_⟩ + intro x hx + have hxT : x ∈ FootprintVertices T := by + rw [← hdomain] + exact hx + simpa [g, hxT] using hc ⟨x, hxT⟩ + · intro ι hι T h hT hdom hcompat hcover + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + let D (a b : GaussianInt) : ℤ := + if hc : covered a b then + (h (Classical.choose hc)).value b - (h (Classical.choose hc)).value a + else 0 + have dmember (i : ι) (a b : GaussianInt) + (ha : a ∈ (h i).domain) (hb : b ∈ (h i).domain) : + D a b = (h i).value b - (h i).value a := OdometerGluingProof.dmemberAt470 increment_eq ι + h hcompat i a b ha hb + have edge_cover (a b : GaussianInt) (hab : FourNeighborAdjacent a b) := + OdometerGluingProof.edge_coverAt477 ι h hcover a b hab + have hanti := OdometerGluingProof.hantiAt488 ι h dmember edge_cover + have hflat := OdometerGluingProof.hflatAt493 ι h hcover dmember + have hcirculation := P3221T2ClosedWalkCirculation.2 D hanti hflat + let G : SimpleGraph GaussianInt := { + Adj := FourNeighborAdjacent + symm := ⟨fun {a b} => adjacent_symm a b⟩ + loopless := ⟨fun {a} => adjacent_irrefl a⟩ } + have hconn := OdometerGluingProof.hconnAt508 adjacent_symm adjacent_irrefl + have hclosed := OdometerGluingProof.hclosedAt527 adjacent_symm adjacent_irrefl walk_sum ι h + hcirculation + obtain ⟨g, hgzero, hgedge, hgunique⟩ := + P3221T2ConnectedPathIntegration G 0 hconn D hanti hclosed + have hgmember := OdometerGluingProof.hgmember adjacent_symm adjacent_irrefl edge_vertices + footprint_constant ι T h hT hdom dmember g hgedge + refine ⟨g, hgmember, ?_⟩ + intro g' hg' + apply hgunique g' + intro a b hab + obtain ⟨i, ha, hb⟩ := edge_cover a b hab + obtain ⟨c, hc⟩ := hg' i + have hca := hc a ha + have hcb := hc b hb + rw [dmember i a b ha hb] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OdometerStringRespect.lean b/LeanPool/ApollonianSuperharmonic/OdometerStringRespect.lean new file mode 100644 index 0000000000..2fb1a5adf2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OdometerStringRespect.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TileString + +-- [TABLET NODE: OdometerStringRespect] + +/-! +# OdometerStringRespect + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a fixed unit orientation, an ordered family of tile odometers respects +an oriented tile string when it assigns +one tile odometer for $C$ to every tile of the string, in the same order, +and consecutive assigned odometers are `LeftLatticeAdjacent`. +This assertion concerns the domains, centroids, and slopes of the ordered +family. It does not choose additive constants and does not assert that the +family has already been glued to a common extension. +-/ +def OdometerStringRespect (C : BandCircle) (orientation : Bool) (base R S : ProtoTile) + (tiles : List ProtoTile) (hs : List PartialOdometer) : Prop := +-- BODY + TileString C orientation base R S tiles ∧ + List.Forall₂ (fun T h => TileOdometer C.1.1 T h) tiles hs ∧ + (tiles.zip hs).IsChain (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OdometerStringRespectCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/OdometerStringRespectCentralCovariance.lean new file mode 100644 index 0000000000..1d7c8df6b0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OdometerStringRespectCentralCovariance.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.TileStringCentralCovariance + +-- [TABLET NODE: OdometerStringRespectCentralCovariance] + +/-! +# OdometerStringRespectCentralCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem OdometerStringRespectCentralCovariance + (C : BandCircle) (orientation : Bool) + (base R S : ProtoTile) (tiles : List ProtoTile) + (hs gs : List PartialOdometer) (u a : GaussianInt) + (hrespect : OdometerStringRespect C orientation base R S tiles hs) + (htransform : List.Forall₂ (fun h g => exists b : Int, + g = PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) u a b) + hs gs) : + OdometerStringRespect C orientation + (TileTranslation (TileHalfTurn base) u) + (TileTranslation (TileHalfTurn R) u) + (TileTranslation (TileHalfTurn S) u) + (tiles.map (fun T => TileTranslation (TileHalfTurn T) u)) gs := by +-- BODY + classical + have transportAdjacent (T T' : ProtoTile) (h h' : PartialOdometer) + (hadj : LeftLatticeAdjacent C T T' h h') (b b' : Int) : + LeftLatticeAdjacent C + (TileTranslation (TileHalfTurn T) u) + (TileTranslation (TileHalfTurn T') u) + (PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) u a b) + (PartialOdometerAffineTranslate (PartialOdometerHalfTurn h') u a b') := by + rcases hadj with ⟨hO, hO', ⟨p, p', hp, hp', hshape⟩⟩ + have hnew : TileOdometer C.1.1 + (TileTranslation (TileHalfTurn T) u) + (PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) u a b) := + TileOdometerAffineTranslation C.1.1 (TileHalfTurn T) + (PartialOdometerHalfTurn h) u a b + (TileOdometerCentralSymmetry C.1.1 T h hO).1 + have hnew' : TileOdometer C.1.1 + (TileTranslation (TileHalfTurn T') u) + (PartialOdometerAffineTranslate (PartialOdometerHalfTurn h') u a b') := + TileOdometerAffineTranslation C.1.1 (TileHalfTurn T') + (PartialOdometerHalfTurn h') u a b' + (TileOdometerCentralSymmetry C.1.1 T' h' hO').1 + have hs : PartialOdometerSlope + (PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) u a b) = + some (-p.1 + (a.re : ℝ), -p.2 + (a.im : ℝ)) := by + have ha := (PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn h) u a b).2.2.2.2.2 + have hh := (PartialOdometerHalfTurnFormulas h).2.2.2.2.2.2 + rw [ha, hh, hp] + rfl + have hs' : PartialOdometerSlope + (PartialOdometerAffineTranslate (PartialOdometerHalfTurn h') u a b') = + some (-p'.1 + (a.re : ℝ), -p'.2 + (a.im : ℝ)) := by + have ha := (PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn h') u a b').2.2.2.2.2 + have hh := (PartialOdometerHalfTurnFormulas h').2.2.2.2.2.2 + rw [ha, hh, hp'] + rfl + have hcent : TileCentroid (TileTranslation (TileHalfTurn T') u) - + TileCentroid (TileTranslation (TileHalfTurn T) u) = + -(TileCentroid T' - TileCentroid T) := by + rw [(TileTranslationFormulas (TileHalfTurn T') u).2.2.2.2.1, + (TileTranslationFormulas (TileHalfTurn T) u).2.2.2.2.1] + rw [(TileHalfTurnFormulas T').2.2.2.2.2.2.2.1, + (TileHalfTurnFormulas T).2.2.2.2.2.2.2.1] + ext <;> dsimp <;> ring + refine ⟨hnew, hnew', ?_⟩ + refine ⟨(-p.1 + (a.re : ℝ), -p.2 + (a.im : ℝ)), + (-p'.1 + (a.re : ℝ), -p'.2 + (a.im : ℝ)), hs, hs', ?_⟩ + rcases hshape with hunit | hnon + · left + rcases hunit with ⟨hor, orig, v, hv, hct, hx, hy⟩ + refine ⟨hor, orig, -v, ?_, ?_, ?_, ?_⟩ + · cases orig <;> simp? [UnitTriangularStep] at hv + all_goals rcases hv with rfl | rfl | rfl | rfl | rfl | rfl <;> + simp [UnitTriangularStep] + · rw [hcent] + rw [hct] + ext <;> simp [GaussianRealPoint] + · dsimp + have hre : (GaussianInt.toComplex v).re = (v.re : ℝ) := + (GaussianInt.intCast_re v).symm + have him : (GaussianInt.toComplex v).im = (v.im : ℝ) := + (GaussianInt.intCast_im v).symm + simp only [Int.cast_neg] + ring_nf + linear_combination -hx + · dsimp + have hre : (GaussianInt.toComplex v).re = (v.re : ℝ) := + (GaussianInt.intCast_re v).symm + have him : (GaussianInt.toComplex v).im = (v.im : ℝ) := + (GaussianInt.intCast_im v).symm + simp only [Int.cast_neg] + ring_nf + linear_combination -hy + · right + rcases hnon with ⟨q, i, e, hq, hq0, hct, hx, hy⟩ + refine ⟨q, i, !e, hq, hq0, ?_, ?_, ?_⟩ + · rw [hcent, hct] + by_cases he : e = true <;> simp [he] + · dsimp + by_cases he : e = true <;> simp [he] at hx ⊢ <;> linarith + · dsimp + by_cases he : e = true <;> simp [he] at hy ⊢ <;> linarith + rcases hrespect with ⟨hstring, htiles, hchain⟩ + have savedString := hstring + clear hstring + revert hchain savedString htiles + have tileTransport : ∀ {ts : List ProtoTile}, + List.Forall₂ (fun T h => TileOdometer C.1.1 T h) ts hs → + List.Forall₂ (fun T h => TileOdometer C.1.1 T h) (ts.map + (fun T => TileTranslation (TileHalfTurn T) u)) gs := by + intro ts ho + revert ho + induction htransform generalizing ts with + | nil => intro ho; cases ho; exact .nil + | @cons h g hs gs hex rest ih => + intro ho + cases ho with + | cons hto hor => + rcases hex with ⟨b, rfl⟩ + exact .cons (TileOdometerAffineTranslation C.1.1 + (TileHalfTurn _) (PartialOdometerHalfTurn h) u a b + (TileOdometerCentralSymmetry C.1.1 _ h hto).1) (ih hor) + /- induction ho generalizing gs with + | nil => cases htransform; exact .nil + | cons hto hor ih => + cases htransform with + | cons hex rest => + rcases hex with ⟨b, rfl⟩ + exact .cons (TileOdometerAffineTranslation C.1.1 + (TileHalfTurn _) (PartialOdometerHalfTurn _) u a b + (TileOdometerCentralSymmetry C.1.1 _ _ hto).1) (ih (gs := _) rest hor) -/ + intro htiles hchain savedString + refine ⟨TileStringCentralCovariance C orientation base R S tiles u savedString, tileTransport + htiles, ?_⟩ + have chainTransport : ∀ {hs gs : List PartialOdometer} {ts : List ProtoTile}, + List.Forall₂ (fun h g => ∃ b : Int, + g = PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) u a b) hs gs → + List.Forall₂ (fun T h => TileOdometer C.1.1 T h) ts hs → + List.IsChain (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) (ts.zip hs) → + List.IsChain (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) + ((ts.map (fun T => TileTranslation (TileHalfTurn T) u)).zip gs) := by + intro hs gs ts ht + revert ts + induction ht with + | nil => + intro ts ho hc + cases ho + exact .nil + | @cons h g hs gs hex rest ih => + intro ts ho hc + cases ts with + | nil => cases ho + | cons t ts => + cases ho with + | cons hto hor => + cases ts with + | nil => exact .singleton _ + | cons t' ts' => + cases rest with + | nil => cases hor + | cons hrest rest => + cases hor with + | cons hto' hor => + cases hc with + | cons_cons hadj htail => + rcases hex with ⟨b, rfl⟩ + rcases hrest with ⟨b', rfl⟩ + exact .cons_cons (transportAdjacent _ _ _ _ hadj b b') + (ih (List.Forall₂.cons hto' hor) htail) + exact chainTransport htransform htiles hchain + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean new file mode 100644 index 0000000000..0f9d91dcb0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean @@ -0,0 +1,192 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.OdometerStringRespectCentralCovariance +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure + +-- [TABLET NODE: OdometerStringRespectRegularFamilyCentralCovariance] + +/-! +# OdometerStringRespectRegularFamilyCentralCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem OdometerStringRespectRegularFamilyCentralCovariance + (C : BandCircle) (orientation : Bool) + (base R S : ProtoTile) (tiles reverseTiles : List ProtoTile) + (hs gs : List PartialOdometer) (u a : GaussianInt) + (hrespect : OdometerStringRespect C orientation base R S tiles hs) + (hreverse : TileString C orientation base S R reverseTiles) + (hcells : List.Forall₂ + (fun T U => (TileTranslation (TileHalfTurn T) u).cells = U.cells) + tiles reverseTiles) + (htransform : List.Forall₂ (fun h g => exists b : Int, + g = PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) u a b) + hs gs) : + OdometerStringRespect C orientation base S R reverseTiles gs := by +-- BODY + classical + have desiredString := hreverse + rcases hreverse with ⟨hbase, hhead, hlast, hpair, hmem, hchain, hheight⟩ + have positive_cells : ∀ (D : CircleCoordinates) (W : ProtoTile), + 0 < D.1 → BandPrototile D W → W.cells.Nonempty := by + intro D W hD hW + induction hW with + | line w x hw => simp at hD + | unit z x => simp + | @decompose q hq S W hS hcells' hfoot hcentroid ih => + have facts := ProperBandCurvatureStructure q hq + have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by + by_cases h0 : 0 < (q (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (q (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + by_cases h2 : 0 < (q (2 : Fin 3).succ).1 + · exact ⟨2, h2⟩ + have n0 := facts.2.1 (0 : Fin 3) + have n1 := facts.2.1 (1 : Fin 3) + have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim + rcases hp with ⟨i, hi⟩ + rcases ih i false hi with ⟨x, hx⟩ + exact ⟨x, (hcells' x).mpr ⟨i, false, hx⟩⟩ + have band_of_member : ∀ {W : ProtoTile}, + W ∈ RegularTileFamily base (TilingLattice C) → BandPrototile C.1.1 W := by + intro W hW + rcases hW with ⟨v, hv, rfl⟩ + exact BandPrototileTranslation C.1.1 base v hbase + have centroid_cells : ∀ {V W : ProtoTile}, + V.cells.Nonempty → BandPrototile C.1.1 W → + V.cells = W.cells → TileCentroid V = TileCentroid W := by + intro V W hpV hW heq + have hpW := positive_cells C.1.1 W (by exact C.property) hW + simp only [TileCentroid, ite_eq_left hpV, ite_eq_left hpW] + rw [heq] + have raw := OdometerStringRespectCentralCovariance C orientation base R S + tiles hs gs u a hrespect htransform + rcases raw with ⟨rawString, rawTiles, rawChain⟩ + rcases hrespect with ⟨originalString, originalTiles, originalChain⟩ + rcases originalString with ⟨hbase0, hhead0, hlast0, hpair0, hmem0, hchain0, hheight0⟩ + have source_band : ∀ {T : ProtoTile}, T ∈ tiles → BandPrototile C.1.1 T := by + intro T hT + exact band_of_member (hmem0 T hT) + have transportAdjacent : ∀ {T T' U U' : ProtoTile} {g g' : PartialOdometer}, + (TileTranslation (TileHalfTurn T) u).cells = U.cells → + (TileTranslation (TileHalfTurn T') u).cells = U'.cells → + T ∈ tiles → T' ∈ tiles → + U ∈ reverseTiles → U' ∈ reverseTiles → + LeftLatticeAdjacent C + (TileTranslation (TileHalfTurn T) u) + (TileTranslation (TileHalfTurn T') u) g g' → + LeftLatticeAdjacent C U U' g g' := by + intro T T' U U' g g' heq heq' hT hT' hUmem hU'mem hadj + rcases hadj with ⟨hodo, hodo', ⟨p, p', hp, hp', hshape⟩⟩ + have hU := band_of_member (hmem U hUmem) + have hU' := band_of_member (hmem U' hU'mem) + have hnew := PositiveCurvatureTileOdometerSupportTransport C.1.1 _ U _ + C.property hodo hU heq + have hnew' := PositiveCurvatureTileOdometerSupportTransport C.1.1 _ U' _ + C.property hodo' hU' heq' + have hc := centroid_cells (V := TileTranslation (TileHalfTurn T) u) + (by rw [heq]; exact positive_cells C.1.1 U C.property hU) hU heq + have hc' := centroid_cells (V := TileTranslation (TileHalfTurn T') u) + (by rw [heq']; exact positive_cells C.1.1 U' C.property hU') hU' heq' + refine ⟨hnew, hnew', ⟨p, p', hp, hp', ?_⟩⟩ + rcases hshape with hunit | hnon + · left + rcases hunit with ⟨hor, orig, v, hv, hct, hx, hy⟩ + refine ⟨hor, orig, v, hv, ?_, hx, hy⟩ + simpa [hc, hc'] using hct + · right + rcases hnon with ⟨q, i, e, hq, hq0, hct, hx, hy⟩ + refine ⟨q, i, e, hq, hq0, ?_, hx, hy⟩ + simpa [hc, hc'] using hct + have tileTransport : ∀ {ts us : List ProtoTile} {fs : List PartialOdometer}, + List.Forall₂ (fun T U => + (TileTranslation (TileHalfTurn T) u).cells = U.cells) ts us → + List.Forall₂ (fun T h => TileOdometer C.1.1 T h) + (ts.map (fun T => TileTranslation (TileHalfTurn T) u)) fs → + (∀ U, U ∈ us → U ∈ RegularTileFamily base (TilingLattice C)) → + List.Forall₂ (fun T h => TileOdometer C.1.1 T h) us fs := by + intro ts us fs hc ho hm + induction hc generalizing fs with + | nil => cases ho; exact .nil + | @cons T U ts us heq rest ih => + cases ho with + | cons hodo hrest => + exact .cons + (PositiveCurvatureTileOdometerSupportTransport C.1.1 _ U _ + C.property hodo (band_of_member (hm U (by simp))) heq) + (ih hrest (fun V hV => hm V (by simp [hV]))) + have targetTiles := tileTransport hcells rawTiles (by + intro U hU + exact hmem U hU) + have chainTransport : ∀ {ts us : List ProtoTile} {fs : List PartialOdometer}, + List.Forall₂ (fun T U => + (TileTranslation (TileHalfTurn T) u).cells = U.cells) ts us → + (∀ T ∈ ts, T ∈ tiles) → + (∀ U ∈ us, U ∈ reverseTiles) → + List.Forall₂ (fun T h => TileOdometer C.1.1 T h) + (ts.map (fun T => TileTranslation (TileHalfTurn T) u)) fs → + List.Forall₂ (fun T h => TileOdometer C.1.1 T h) us fs → + List.IsChain (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) + ((ts.map (fun T => TileTranslation (TileHalfTurn T) u)).zip fs) → + List.IsChain (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) + (us.zip fs) := by + intro ts us fs hc hms hmu hraw htar hchain + induction hc generalizing fs with + | nil => cases hraw; cases htar; exact .nil + | @cons T U ts us heq rest ih => + cases hraw with + | cons hrawT hrawRest => + cases htar with + | cons htarU htarRest => + cases ts with + | nil => + cases hrawRest + cases htarRest + cases hchain + exact .singleton _ + | cons T' ts' => + cases us with + | nil => cases rest + | cons U' us' => + cases rest with + | cons heq' rest' => + cases hrawRest with + | cons hrawNext hrawTail => + cases htarRest with + | cons htarNext htarTail => + cases hchain with + | cons_cons hadj htail => + exact .cons_cons + (transportAdjacent heq heq' + (hms T (by simp)) (hms T' (by simp)) + (hmu U (by simp)) (hmu U' (by simp)) hadj) + (ih (fs := _) + (fun V hV => hms V (by simp [hV])) + (fun V hV => hmu V (by simp [hV])) + (List.Forall₂.cons hrawNext hrawTail) + (List.Forall₂.cons htarNext htarTail) htail) + have finalChain := chainTransport hcells + (by intro T hT; exact hT) (by intro U hU; exact hU) + rawTiles targetTiles rawChain + exact ⟨desiredString, targetTiles, finalChain⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OdometerTranslation.lean b/LeanPool/ApollonianSuperharmonic/OdometerTranslation.lean new file mode 100644 index 0000000000..69a9d69a1b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OdometerTranslation.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PartialOdometer + +-- [TABLET NODE: OdometerTranslation] + +/-! +# OdometerTranslation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Two partial odometers $h_1,h_2$ are odometer translations of one another +if there are $v,a\in\mathbb Z[i]$ and $b\in\mathbb Z$ such that +$$ + T(h_1)=T(h_2)+v + \quad\text{and}\quad + h_1(x)=h_2(x-v)+a\mathbin{\cdot}x+b +$$ +for every $x\in T(h_1)$, where +$a\mathbin{\cdot}x=\operatorname{Re}(a)\operatorname{Re}(x) ++\operatorname{Im}(a)\operatorname{Im}(x)$. +-/ +def OdometerTranslation (h₁ h₂ : PartialOdometer) : Prop := +-- BODY + ∃ v a : GaussianInt, ∃ b : ℤ, + (∀ x, x ∈ h₁.domain ↔ x - v ∈ h₂.domain) ∧ + ∀ x, x ∈ h₁.domain → + h₁.value x = h₂.value (x - v) + + a.re * x.re + a.im * x.im + b + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OdometerWeb.lean b/LeanPool/ApollonianSuperharmonic/OdometerWeb.lean new file mode 100644 index 0000000000..daba94fb8d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OdometerWeb.lean @@ -0,0 +1,365 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentIncomingEndpoint +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryMarkedDataCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import LeanPool.ApollonianSuperharmonic.BoundaryStringOdometerRespect +public import LeanPool.ApollonianSuperharmonic.BoundaryString +public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector +public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton +public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain +public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable +public import LeanPool.ApollonianSuperharmonic.DiamondOdometerExistsUnique +public import LeanPool.ApollonianSuperharmonic.DiamondOrientedChildParentEndpoints +public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.DiamondTerminalWebStencilLedger +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceDisjointCompanionEndpoints +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordOdometerFamilyExistsUnique +public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentEndpoints +public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentRightEndpoint +public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse +public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import LeanPool.ApollonianSuperharmonic.FordTerminalWebStencilLedger +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.LeftAdjacentOdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.MarkedOdometerAdjacencyReduction +public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryOdometerStrings +public import LeanPool.ApollonianSuperharmonic.OpposingStringInterfacePath +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.RightSubtileOdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileHalfTurn +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations +public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation +public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification +public import LeanPool.ApollonianSuperharmonic.P5570T1UnitNormalForm +public import LeanPool.ApollonianSuperharmonic.P5570T1UnitQuadratic +public import LeanPool.ApollonianSuperharmonic.CurvatureOnePeriodicOdometer +public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryGlobalOdometerTransport +public import LeanPool.ApollonianSuperharmonic.P3996T1AdjacentParentPlacement +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleRetargetMiddle +public import LeanPool.ApollonianSuperharmonic.P5589T1EndpointCompatibility +public import LeanPool.ApollonianSuperharmonic.P5589T1UnitInterfaceSelection +public import LeanPool.ApollonianSuperharmonic.P5589T1LinkedUnitValues +public import LeanPool.ApollonianSuperharmonic.P5596T1LeftWeb +public import LeanPool.ApollonianSuperharmonic.P5491T1ExceptionalPresentation +public import LeanPool.ApollonianSuperharmonic.P5606T1RightTerminalTransport +public import LeanPool.ApollonianSuperharmonic.P5606T1SubtileTerminalTransport + +-- [TABLET NODE: OdometerWeb] + +/-! +# OdometerWeb + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem OdometerWeb : + (∀ (C : BandCircle) (T₁ T₂ : ProtoTile) (h₁ h₂ : PartialOdometer) + (g : IntegerLatticeFunction) (x : GaussianInt), + OdometerCompatibility h₁ h₂ → + GlobalOdometerExtends g h₁ → GlobalOdometerExtends g h₂ → + x ∈ h₁.domain → x ∈ h₂.domain → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h₁.domain ∨ y ∈ h₂.domain) → + (LeftLatticeAdjacent C T₁ T₂ h₁ h₂ → + FourNeighborLaplacian g x = 1) ∧ + (RightLatticeAdjacent C T₁ T₂ h₁ h₂ → + ((∀ s, s = x ∨ s = x - 1 ∨ s = x - ⟨0, 1⟩ ∨ + s = x - 1 - ⟨0, 1⟩ → s ∈ T₁.cells ∨ s ∈ T₂.cells) → + FourNeighborLaplacian g x = 1) ∧ + (¬ (∀ s, s = x ∨ s = x - 1 ∨ s = x - ⟨0, 1⟩ ∨ + s = x - 1 - ⟨0, 1⟩ → s ∈ T₁.cells ∨ s ∈ T₂.cells) → + FourNeighborLaplacian g x = 0))) ∧ + ∀ (C₀ Cᵢ : BandCircle) (q : Fin 4 → CircleCoordinates) + (i : Fin 3) (s : Fin 4) (T₀ Tᵢ : ProtoTile) + (h₀ hᵢ : PartialOdometer) (g : IntegerLatticeFunction) + (x : GaussianInt) (p₀ pᵢ : ℝ × ℝ), + ProperBandQuadruple q → q 0 = C₀.1.1 → q i.succ = Cᵢ.1.1 → + PartialOdometerSlope h₀ = some p₀ → + PartialOdometerSlope hᵢ = some pᵢ → + TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) → + pᵢ.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).1 → + pᵢ.2 - p₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).2 → + SubtileLatticeAdjacent C₀ Cᵢ T₀ Tᵢ h₀ hᵢ → + OdometerCompatibility h₀ hᵢ → + GlobalOdometerExtends g h₀ → GlobalOdometerExtends g hᵢ → + x ∈ h₀.domain → x ∈ hᵢ.domain → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h₀.domain ∨ y ∈ hᵢ.domain) → + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) + let UR := TileTranslation T₀ uR + (x ∈ FootprintVertices UR → FourNeighborLaplacian g x = 0) ∧ + (x ∉ FootprintVertices UR → FourNeighborLaplacian g x = 1) := by +-- BODY + classical + have nonexceptional (q : Fin 4 → CircleCoordinates) + (a : Fin 3) (w : BandPackingSymmetry) + (cfg : BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction w + ![q 0, q a.succ, q (a+1).succ, q (a+2).succ])) : + ¬ ((∃ (v : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction v (FordCircleCoordinate P.p P.q) = q 0) ∨ + (∃ (v : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction v (DiamondRecursiveQuadruple K 0) = q 0)) := by + have generalNotExceptional (R : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration R) : + ¬ ((∃ (v : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction v (FordCircleCoordinate P.p P.q) = R 0) ∨ + (∃ (v : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction v (DiamondRecursiveQuadruple K 0) = R 0)) := by + intro he + obtain ⟨v, hn⟩ := P5491T1ExceptionalPresentation R cfg.proper he + let A := BandPackingSymmetryQuadrupleAction v R + have hA := BandPackingSymmetryProperCovariance v R cfg.proper + have parent (l : Fin 3) : (A l.succ).1 = + (R (if BandPackingSymmetryReversesOrientation v then -l else l).succ).1 := by + cases hv : BandPackingSymmetryReversesOrientation v <;> fin_cases l <;> + simp [A, BandPackingSymmetryQuadrupleAction, hv, + (BandPackingSymmetryCovariance v).1, + show -(1 : Fin 3) = 2 from rfl, show -(2 : Fin 3) = 1 from rfl] + rcases hn with ⟨P,hP,h0,_⟩ | ⟨K,hK,h0,_⟩ + · obtain ⟨b,hb,_⟩ := BandPredecessorNoCollision A (FordRecursiveQuadruple P) + hA ((FordCoordinateConfiguration P).2 hP).1 h0 + have hz : (A ((2 : Fin 3)+b).succ).1 = 0 := by + rw [← hb 2] + simp [FordRecursiveQuadruple] + rw [parent] at hz + exact cfg.noLine _ hz + · obtain ⟨b,hb,_⟩ := BandPredecessorNoCollision A (DiamondRecursiveQuadruple K) + hA (DiamondCoordinateConfiguration K).2.1 h0 + have hunit (l : Fin 3) (hl : l = 0 ∨ l = 1) : (A (l+b).succ).1 = 1 := by + rw [← hb l] + rcases hl with rfl | rfl <;> simp [DiamondRecursiveQuadruple] + have hu0 := hunit 0 (Or.inl rfl) + have hu1 := hunit 1 (Or.inr rfl) + rw [parent] at hu0 hu1 + have heq := cfg.atMostOneUnit _ _ hu0 hu1 + have heq' := Fin.succ_inj.mp heq + cases hv : BandPackingSymmetryReversesOrientation v <;> simp [hv] at heq' + intro he + apply generalNotExceptional _ cfg + rcases he with ⟨v,P,hv⟩ | ⟨v,K,hv⟩ + · exact Or.inl ⟨.comp w v,P,by + change BandPackingSymmetryCircleAction w (BandPackingSymmetryCircleAction v _) = + BandPackingSymmetryCircleAction w (q 0) + rw [hv]⟩ + · exact Or.inr ⟨.comp w v,K,by + change BandPackingSymmetryCircleAction w (BandPackingSymmetryCircleAction v _) = + BandPackingSymmetryCircleAction w (q 0) + rw [hv]⟩ + have restriction (C D : CircleCoordinates) (T U : ProtoTile) + (h k : PartialOdometer) (g : IntegerLatticeFunction) + (hsub : TileSubodometer C D T U h k) (hg : GlobalOdometerExtends g h) : + GlobalOdometerExtends g k := by + obtain ⟨c,hc⟩ := hg + refine ⟨c, fun y hy => ?_⟩ + rw [hc y (hsub.2.2.2.1 hy), hsub.2.2.2.2.1 y hy] + have compatible (g : IntegerLatticeFunction) (h k : PartialOdometer) + (hg : GlobalOdometerExtends g h) (kg : GlobalOdometerExtends g k) : + OdometerCompatibility h k := by + obtain ⟨c,hc⟩ := hg + obtain ⟨d,hd⟩ := kg + right + refine ⟨c-d, fun y hy ky => ?_⟩ + have hh := hc y hy + have hk := hd y ky + omega + let R : ℕ → Prop := fun n => + ∀ (C : BandCircle) (T U : ProtoTile) (h k : PartialOdometer) + (g : IntegerLatticeFunction) (x : GaussianInt), + C.1.1.1.toNat + C.1.1.1.toNat = n → + OdometerCompatibility h k → + GlobalOdometerExtends g h → GlobalOdometerExtends g k → + x ∈ h.domain → x ∈ k.domain → + (∀ y, y = x ∨ y = x+1 ∨ y = x-1 ∨ y = x+⟨0,1⟩ ∨ y = x-⟨0,1⟩ → + y ∈ h.domain ∨ y ∈ k.domain) → + RightLatticeAdjacent C T U h k → + ((∀ z, z = x ∨ z = x-1 ∨ z = x-⟨0,1⟩ ∨ z = x-1-⟨0,1⟩ → + z ∈ T.cells ∨ z ∈ U.cells) → FourNeighborLaplacian g x = 1) ∧ + (¬ (∀ z, z = x ∨ z = x-1 ∨ z = x-⟨0,1⟩ ∨ z = x-1-⟨0,1⟩ → + z ∈ T.cells ∨ z ∈ U.cells) → FourNeighborLaplacian g x = 0) + let S : ℕ → Prop := fun n => + ∀ (C D : BandCircle) (q : Fin 4 → CircleCoordinates) (i : Fin 3) (s : Fin 4) + (T U : ProtoTile) (h k : PartialOdometer) (g : IntegerLatticeFunction) + (x : GaussianInt) (p p' : ℝ × ℝ), + C.1.1.1.toNat + D.1.1.1.toNat = n → + ProperBandQuadruple q → q 0 = C.1.1 → q i.succ = D.1.1 → + PartialOdometerSlope h = some p → PartialOdometerSlope k = some p' → + TileCentroid U - TileCentroid T = (1/2 : ℝ) • GaussianRealPoint + ((⟨0,1⟩ : GaussianInt)^s.val * + (BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ))) → + p'.1-p.1 = ((1/2 : ℝ) • GaussianRealPoint + ((-⟨0,1⟩ : GaussianInt)^s.val * + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)))).1 → + p'.2-p.2 = ((1/2 : ℝ) • GaussianRealPoint + ((-⟨0,1⟩ : GaussianInt)^s.val * + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)))).2 → + SubtileLatticeAdjacent C D T U h k → OdometerCompatibility h k → + GlobalOdometerExtends g h → GlobalOdometerExtends g k → + x ∈ h.domain → x ∈ k.domain → + (∀ y, y = x ∨ y = x+1 ∨ y = x-1 ∨ y = x+⟨0,1⟩ ∨ y = x-⟨0,1⟩ → + y ∈ h.domain ∨ y ∈ k.domain) → + let UR := TileTranslation T ((⟨0,1⟩ : GaussianInt)^s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0))) + (x ∈ FootprintVertices UR → FourNeighborLaplacian g x = 0) ∧ + (x ∉ FootprintVertices UR → FourNeighborLaplacian g x = 1) + have main : ∀ n, R n ∧ S n := by + intro n + induction n using Nat.strong_induction_on with + | h n ih => + constructor + · intro C T U h k g x hn hcompat hg kg hx kx hstar hright + have horiginal := hright + obtain ⟨hT,hU,p,p',hp,hp',q,i,e,hq,hq0,hc,hr,hi⟩ := hright + obtain ⟨a,w,hregime⟩ := BandRegimeClassification q hq + rcases hregime with ⟨hford,_⟩ | ⟨hrest,_⟩ + · exact P5606T1RightTerminalTransport q hq i e a w (Or.inl hford) + T U h k p p' g x (by simpa only [hq0] using hT) + (by simpa only [hq0] using hU) hp hp' hc hr hi hcompat hg kg hx kx hstar + · rcases hrest with ⟨hdiamond,_⟩ | ⟨⟨cfg⟩,_⟩ + · exact P5606T1RightTerminalTransport q hq i e a w (Or.inr hdiamond) + T U h k p p' g x (by simpa only [hq0] using hT) + (by simpa only [hq0] using hU) hp hp' hc hr hi hcompat hg kg hx kx hstar + · have hnot := nonexceptional q a w cfg + rw [hq0] at hnot + obtain ⟨D,V,f,b,b',r,j,t,hsub,hb,hb',hrproper,hr0,hrj, + hcent,hsre,hsim,hadj,kx',fx,hcover,hdec,hmark⟩ := + MarkedOdometerAdjacencyReduction.1 C T U h k x hnot horiginal hx kx hstar + have gf := restriction _ _ _ _ _ _ g hsub hg + have hstep := (ih _ (by omega)).2 C D r j t U V k f g x b b' rfl + hrproper hr0 hrj hb hb' hcent hsre hsim hadj + (compatible g k f kg gf) kg gf kx' fx hcover + exact ⟨fun H => hstep.2 (fun hm => (hmark.mpr hm) H), + fun H => hstep.1 (hmark.mp H)⟩ + · intro C D q i s T U h k g x p p' hn hq hq0 hqi hp hp' hc hr hi + hadj hcompat hg kg hx kx hstar + obtain ⟨a,w,hregime⟩ := BandRegimeClassification q hq + have hT : TileOdometer (q 0) T h := by simpa only [hq0] using hadj.1 + have hU : TileOdometer (q i.succ) U k := by simpa only [hqi] using hadj.2.1 + have hpos : 0 < (q i.succ).1 := by rw [hqi]; exact D.2 + rcases hregime with ⟨hford,_⟩ | ⟨hrest,_⟩ + · exact P5606T1SubtileTerminalTransport q hq i s hpos a w (Or.inl hford) + T U h k p p' g x hT hU hp hp' hc hr hi hcompat hg kg hx kx hstar + · rcases hrest with ⟨hdiamond,_⟩ | ⟨⟨cfg⟩,_⟩ + · exact P5606T1SubtileTerminalTransport q hq i s hpos a w (Or.inr hdiamond) + T U h k p p' g x hT hU hp hp' hc hr hi hcompat hg kg hx kx hstar + · have hnot := nonexceptional q a w cfg + rw [hq0] at hnot + obtain ⟨E,V,f,hsub,kx',fx,hcover,hdec,hcases⟩ := + MarkedOdometerAdjacencyReduction.2 C D q i s T U h k x p p' + hnot hq hq0 hqi hp hp' hc hr hi hadj hx kx hstar + have gf := restriction _ _ _ _ _ _ g hsub hg + rcases hcases with ⟨_,hleft,hunmarked⟩ | hforward | hreverse + · have hlap := P5596T1LeftWeb D U V k f g x + (compatible g k f kg gf) kg gf kx' fx hcover hleft + exact ⟨fun hm => (hunmarked hm).elim, fun _ => hlap⟩ + · obtain ⟨b,b',r,j,t,hb,hb',hrproper,hr0,hrj,hcent,hsre,hsim, + hnew,hmark⟩ := hforward + have hstep := (ih _ (by omega)).2 D E r j t U V k f g x b b' rfl + hrproper hr0 hrj hb hb' hcent hsre hsim hnew + (compatible g k f kg gf) kg gf kx' fx hcover + exact ⟨fun hm => hstep.1 (hmark.mp hm), + fun hm => hstep.2 (fun hnewmark => hm (hmark.mpr hnewmark))⟩ + · obtain ⟨b,b',r,j,t,hb,hb',hrproper,hr0,hrj,hcent,hsre,hsim, + hnew,hmark⟩ := hreverse + have hcover' : ∀ y, y = x ∨ y = x+1 ∨ y = x-1 ∨ + y = x+⟨0,1⟩ ∨ y = x-⟨0,1⟩ → y ∈ f.domain ∨ y ∈ k.domain := + fun y hy => (hcover y hy).symm + have hstep := (ih _ (by omega)).2 E D r j t V U f k g x b b' rfl + hrproper hr0 hrj hb hb' hcent hsre hsim hnew + (compatible g f k gf kg) gf kg fx kx' hcover' + exact ⟨fun hm => hstep.1 (hmark.mp hm), + fun hm => hstep.2 (fun hnewmark => hm (hmark.mpr hnewmark))⟩ + constructor + · intro C T₁ T₂ h₁ h₂ g x hcompat hg₁ hg₂ hx₁ hx₂ hstar + constructor + · exact P5596T1LeftWeb C T₁ T₂ h₁ h₂ g x + hcompat hg₁ hg₂ hx₁ hx₂ hstar + · intro hright + exact (main _).1 C T₁ T₂ h₁ h₂ g x rfl hcompat hg₁ hg₂ hx₁ hx₂ hstar hright + · intro C D q i s T U h k g x p p' hq hq0 hqi hp hp' hc hr hi hadj hcompat + hg kg hx kx hstar + exact (main _).2 C D q i s T U h k g x p p' rfl hq hq0 hqi hp hp' + hc hr hi hadj hcompat hg kg hx kx hstar + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OpenLatticeEdge.lean b/LeanPool/ApollonianSuperharmonic/OpenLatticeEdge.lean new file mode 100644 index 0000000000..28851fc0e9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OpenLatticeEdge.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint + +-- [TABLET NODE: OpenLatticeEdge] + +/-! +# OpenLatticeEdge + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For lattice vertices $x,y\in\mathbb Z[i]$, the open lattice edge +$(x,y)^\circ$ is the set of strict convex combinations +$(1-t)x+ty$ with $0 CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C0 Ci : BandCircle) (i : Fin 3) + (hC0 : q 0 = C0.1.1) (hCi : q i.succ = Ci.1.1) + (T0 T0' : ProtoTile) (h0 h0' : PartialOdometer) + (cert : BandOrderedGeneralLayoutCertificate q cfg C0 T0) + (hsym : QuarterTurnSymmetric T0) + (hO0 : TileOdometer C0.1.1 T0 h0) + (hO0' : TileOdometer C0.1.1 T0' h0') + (hlarge : 1 < Ci.1.1.1) + (p0 p0' : Real × Real) + (hs0 : PartialOdometerSlope h0 = some p0) + (hs0' : PartialOdometerSlope h0' = some p0') + (hcentroid : TileCentroid T0' - TileCentroid T0 = + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) + (hslope : p0' - p0 = + GaussianRealPoint (BandVectors.2 (q i.succ) (q 0))) : + exists orientation : Bool, exists base Rminus Rplus : ProtoTile, + exists tiles reverseTiles : List ProtoTile, + exists hs reverseHs : List PartialOdometer, + exists hminus hplus : PartialOdometer, + exists pminus pplus : Real × Real, + exists path : List GaussianInt, + BoundaryString C0 Ci i orientation T0 base Rminus Rplus tiles /\ + TileString Ci orientation base Rplus Rminus reverseTiles /\ + OdometerStringRespect Ci orientation base Rminus Rplus tiles hs /\ + OdometerStringRespect Ci orientation base Rplus Rminus + reverseTiles reverseHs /\ + hs.head? = some hminus /\ hs.getLast? = some hplus /\ + reverseHs.head? = some hplus /\ reverseHs.getLast? = some hminus /\ + TileOdometer Ci.1.1 Rminus hminus /\ + TileOdometer Ci.1.1 Rplus hplus /\ + PartialOdometerSlope hminus = some pminus /\ + PartialOdometerSlope hplus = some pplus /\ + pminus - p0 = (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ)) /\ + pplus - p0 = (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)) /\ + Nonempty (ExactTileInterfaceTriple T0 T0' Rminus) /\ + Nonempty (ExactTileInterfaceTriple T0 T0' Rplus) /\ + path.Nodup /\ 2 <= path.length /\ + (exists xminus, + path.head? = some xminus /\ xminus ∈ FootprintVertices Rminus) /\ + (exists xplus, + path.getLast? = some xplus /\ xplus ∈ FootprintVertices Rplus) /\ + FootprintVertices T0 ∩ FootprintVertices T0' = + (path.toFinset : Set GaussianInt) /\ + (forall e, e ∈ FootprintEdges T0 ∩ FootprintEdges T0' <-> + exists x y : GaussianInt, exists l1 l2 : List GaussianInt, + path = l1 ++ x :: y :: l2 /\ e = {x, y}) /\ + (forall x, x ∈ path -> + (exists U g, U ∈ (tiles.drop 1).dropLast /\ + (U, g) ∈ tiles.zip hs /\ + x ∈ FootprintVertices U /\ + AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0) /\ + (exists V k, V ∈ (reverseTiles.drop 1).dropLast /\ + (V, k) ∈ reverseTiles.zip reverseHs /\ + x ∈ FootprintVertices V /\ + AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0')) /\ + forall x y : GaussianInt, forall l1 l2 : List GaussianInt, + path = l1 ++ x :: y :: l2 -> + (exists U g, U ∈ (tiles.drop 1).dropLast /\ + (U, g) ∈ tiles.zip hs /\ + {x, y} ∈ FootprintEdges U /\ + AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0) /\ + (exists V k, V ∈ (reverseTiles.drop 1).dropLast /\ + (V, k) ∈ reverseTiles.zip reverseHs /\ + {x, y} ∈ FootprintEdges V /\ + AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0') /\ + forall x, x ∈ path -> + (forall y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ -> + y ∈ h0.domain ∨ y ∈ h0'.domain) -> + exists y : GaussianInt, exists U V : ProtoTile, + exists g k : PartialOdometer, + ((exists l1 l2 : List GaussianInt, + path = l1 ++ x :: y :: l2) ∨ + (exists l1 l2 : List GaussianInt, + path = l1 ++ y :: x :: l2)) /\ + U ≠ V /\ + {x, y} ∈ FootprintEdges U ∩ FootprintEdges V /\ + U ∈ (tiles.drop 1).dropLast /\ + (U, g) ∈ tiles.zip hs /\ + AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0 /\ + V ∈ (reverseTiles.drop 1).dropLast /\ + (V, k) ∈ reverseTiles.zip reverseHs /\ + AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0' /\ + ((x ∈ U.cells ∧ x - 1 - ⟨0, 1⟩ ∈ V.cells) ∨ + (x ∈ V.cells ∧ x - 1 - ⟨0, 1⟩ ∈ U.cells) ∨ + (x - 1 ∈ U.cells ∧ x - ⟨0, 1⟩ ∈ V.cells) ∨ + (x - 1 ∈ V.cells ∧ x - ⟨0, 1⟩ ∈ U.cells)) := by +-- BODY + classical + have hpositive : 0 < Ci.1.1.1 := by omega + have hCpositive : 0 < C0.1.1.1 := by + have hlt := cfg.proper.2 i + rw [hC0, hCi] at hlt + omega + obtain ⟨orientation, centerShift, base, Rminus, Rplus, tiles, reverseTiles, + hs, reverseHs, hminus, hplus, pminus, pplus, a, b, bminus, bplus, + hboundary, hmc, hpc, hpairs, hreverse, hrespect, hreverseRespect, + hheadHs, hlastHs, hheadReverseHs, hlastReverseHs, hOm, hOp, + hsm, hsp, hpm, hpp, houterTransform, hplusTransform, hminusTransform, + hforwardAnc, hreverseAnc⟩ := + OpposingBoundaryOdometerStrings q cfg.proper C0 Ci i hC0 hCi + T0 T0' h0 h0' hO0 hO0' hpositive p0 p0' hs0 hs0' hcentroid hslope + have hforward : TileString Ci orientation base Rminus Rplus tiles := by + obtain ⟨q', hq', hq0', hqi', hband, ho, hf, hm, hp⟩ := hboundary + exact hf + obtain ⟨EM, EP, hbetween, hT, hT', hRm, hRp, hdis, hTm, hT'm, + hTp, hT'p, hreg, hreg', hne, hnadj⟩ := + P4366T2OuterGeometry q cfg C0 Ci i hC0 hCi T0 T0' h0 h0' + cert hsym hO0 hO0' hlarge hcentroid orientation base Rminus Rplus + tiles centerShift hboundary hminus hplus hOm hOp hmc hpc + have hnadj' : ¬ (if Ci.1.1.1 = 1 then + ∃ v : GaussianInt, UnitTriangularStep orientation v ∧ + TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint v + else TileTouching Rminus Rplus) := by + simpa only [ite_eq_right (show Ci.1.1.1 ≠ 1 by omega)] using hnadj + obtain ⟨walk, ⟨wm, hwm, hwmR⟩, ⟨wp, hwp, hwpR⟩, + hwalkSteps, hwalkVertices, hwalkEdges⟩ := + OpposingStringInterfacePath Ci orientation base Rminus Rplus hne hnadj' + tiles reverseTiles hforward hreverse + have vertexWitnesses : ∀ x, x ∈ walk → + (∃ U g, U ∈ (tiles.drop 1).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ + x ∈ FootprintVertices U ∧ AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0) ∧ + (∃ V k, V ∈ (reverseTiles.drop 1).dropLast ∧ + (V, k) ∈ reverseTiles.zip reverseHs ∧ x ∈ FootprintVertices V ∧ + AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0') := by + intro x hx + obtain ⟨⟨U, hU, hxU⟩, ⟨V, hV, hxV⟩⟩ := hwalkVertices x hx + obtain ⟨g, hUg, hAg⟩ := hforwardAnc U hU + obtain ⟨k, hVk, hAk⟩ := hreverseAnc V hV + exact ⟨⟨U, g, hU, hUg, hxU, hAg⟩, ⟨V, k, hV, hVk, hxV, hAk⟩⟩ + have edgeWitnesses : ∀ x y : GaussianInt, ∀ l r : List GaussianInt, + walk = l ++ x :: y :: r → + (∃ U g, U ∈ (tiles.drop 1).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ + {x, y} ∈ FootprintEdges U ∧ AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0) ∧ + (∃ V k, V ∈ (reverseTiles.drop 1).dropLast ∧ + (V, k) ∈ reverseTiles.zip reverseHs ∧ {x, y} ∈ FootprintEdges V ∧ + AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0') := by + intro x y l r heq + obtain ⟨⟨U, hU, heU⟩, ⟨V, hV, heV⟩⟩ := hwalkEdges x y l r heq + obtain ⟨g, hUg, hAg⟩ := hforwardAnc U hU + obtain ⟨k, hVk, hAk⟩ := hreverseAnc V hV + exact ⟨⟨U, g, hU, hUg, heU, hAg⟩, ⟨V, k, hV, hVk, heV, hAk⟩⟩ + have ancestorVertex (U T : ProtoTile) (g h : PartialOdometer) + (hA : AncestorOdometer Ci.1.1 C0.1.1 U T g h) + (x : GaussianInt) (hx : x ∈ FootprintVertices U) : + x ∈ FootprintVertices T := by + have hg : x ∈ g.domain := by + change x ∈ (g.domain : Set GaussianInt) + rw [hA.2.2.1] + exact hx + have hh : x ∈ h.domain := hA.2.2.2.1 hg + change x ∈ (h.domain : Set GaussianInt) at hh + rwa [PositiveCurvatureTileOdometerDomain C0.1.1 T h hCpositive hA.1] at hh + have ancestorEdge (U T : ProtoTile) (g h : PartialOdometer) + (hA : AncestorOdometer Ci.1.1 C0.1.1 U T g h) + (e : Finset GaussianInt) (he : e ∈ FootprintEdges U) : + e ∈ FootprintEdges T := by + obtain ⟨z, hz, hshape⟩ := he + exact ⟨z, P4158T1AncestorCells Ci.1.1 C0.1.1 U T hA.2.1 hz, hshape⟩ + have walkContained : ∀ x, x ∈ walk → + x ∈ FootprintVertices T0 ∩ FootprintVertices T0' := by + intro x hx + obtain ⟨⟨U, g, hU, hUg, hxU, hAg⟩, ⟨V, k, hV, hVk, hxV, hAk⟩⟩ := + vertexWitnesses x hx + exact ⟨ancestorVertex U T0 g h0 hAg x hxU, + ancestorVertex V T0' k h0' hAk x hxV⟩ + have wmEq : wm = EM.point := + (EM.unique_common wm).mp ⟨walkContained wm + (List.mem_of_mem_head? (by simp [hwm])), hwmR⟩ + have wpEq : wp = EP.point := + (EP.unique_common wp).mp ⟨walkContained wp + (List.mem_of_mem_getLast? (by simp [hwp])), hwpR⟩ + have walkEdgesContained : ∀ x y : GaussianInt, ∀ l r : List GaussianInt, + walk = l ++ x :: y :: r → + {x, y} ∈ FootprintEdges T0 ∩ FootprintEdges T0' := by + intro x y l r heq + obtain ⟨⟨U, g, hU, hUg, heU, hAg⟩, ⟨V, k, hV, hVk, heV, hAk⟩⟩ := + edgeWitnesses x y l r heq + exact ⟨ancestorEdge U T0 g h0 hAg _ heU, + ancestorEdge V T0' k h0' hAk _ heV⟩ + have exhausted := P4366T2WalkExhaustion hbetween walk + (by simpa only [wmEq] using hwm) (by simpa only [wpEq] using hwp) + walkEdgesContained + obtain ⟨path, hp, hlen, hhead, hlast, hvertices, hsteps, hedges⟩ := hbetween + have pathVertexWitnesses : ∀ x, x ∈ path → + (∃ U g, U ∈ (tiles.drop 1).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ + x ∈ FootprintVertices U ∧ AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0) ∧ + (∃ V k, V ∈ (reverseTiles.drop 1).dropLast ∧ + (V, k) ∈ reverseTiles.zip reverseHs ∧ x ∈ FootprintVertices V ∧ + AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0') := by + intro x hx + apply vertexWitnesses x + apply exhausted.1 x + rw [hvertices] + simpa using hx + have pathEdgeWitnesses : ∀ x y : GaussianInt, ∀ l r : List GaussianInt, + path = l ++ x :: y :: r → + (∃ U g, U ∈ (tiles.drop 1).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ + {x, y} ∈ FootprintEdges U ∧ AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0) ∧ + (∃ V k, V ∈ (reverseTiles.drop 1).dropLast ∧ + (V, k) ∈ reverseTiles.zip reverseHs ∧ {x, y} ∈ FootprintEdges V ∧ + AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0') := by + intro x y l r heq + have he := (hedges {x, y}).mpr ⟨x, y, l, r, heq, rfl⟩ + obtain ⟨a, b, pre, post, hw, hedgeEq⟩ := exhausted.2 {x, y} he + simpa only [← hedgeEq] using edgeWitnesses a b pre post hw + have localSectors := P4366T2LocalSectors C0 Ci hlarge T0 T0' h0 h0' + orientation base Rminus Rplus tiles reverseTiles hs reverseHs + hforward hreverse EM EP hT hT' hRm hRp hdis hTm hT'm hTp hT'p + hreg hreg' path ⟨hp, hlen, hhead, hlast, hvertices, hsteps, hedges⟩ + pathEdgeWitnesses + refine ⟨orientation, base, Rminus, Rplus, tiles, reverseTiles, hs, reverseHs, + hminus, hplus, pminus, pplus, path, hboundary, hreverse, hrespect, + hreverseRespect, hheadHs, hlastHs, hheadReverseHs, hlastReverseHs, + hOm, hOp, hsm, hsp, hpm, hpp, ⟨EM⟩, ⟨EP⟩, hp, hlen, + ⟨EM.point, hhead, ((EM.unique_common EM.point).mpr rfl).2⟩, + ⟨EP.point, hlast, ((EP.unique_common EP.point).mpr rfl).2⟩, + hvertices, hedges, pathVertexWitnesses, ?_⟩ + intro x y l r heq + refine ⟨(pathEdgeWitnesses x y l r heq).1, + (pathEdgeWitnesses x y l r heq).2, ?_⟩ + intro z hz hstar + apply localSectors z hz + intro w hw + have hcovered := hstar w hw + change w ∈ (h0.domain : Set GaussianInt) ∨ w ∈ (h0'.domain : Set GaussianInt) + at hcovered + rwa [PositiveCurvatureTileOdometerDomain C0.1.1 T0 h0 hCpositive hO0, + PositiveCurvatureTileOdometerDomain C0.1.1 T0' h0' hCpositive hO0'] at hcovered + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean new file mode 100644 index 0000000000..b6802056e7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean @@ -0,0 +1,2569 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerCentralCovariance +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerOuterSupportNormalization +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BoundaryStringOdometerRespect +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BoundaryString +public import LeanPool.ApollonianSuperharmonic.ForwardBoundaryStringData +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.OdometerStringRespectCentralCovariance +public import LeanPool.ApollonianSuperharmonic.OdometerStringRespectRegularFamilyCentralCovariance +public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.PartialOdometer +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.RegularTileFamily +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.TileString +public import LeanPool.ApollonianSuperharmonic.TileStringCentralCovariance +public import LeanPool.ApollonianSuperharmonic.TileStringRegularFamilyCentralCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing + +-- [TABLET NODE: OpposingBoundaryOdometerStrings] + +/-! +# OpposingBoundaryOdometerStrings + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OpposingBoundaryGeometry + +private theorem horientationExists : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (ProperBandQuadruple q) → (∀ (Cᵢ : BandCircle), ∀ (i + : Fin 3), (q i.succ = Cᵢ.1.1) → (∃ o : Bool, Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation + q i o)) ) := by + classical + intro q hq Cᵢ i hCᵢ + by_cases hc : Cᵢ.1.1.1 = 1 + · obtain ⟨o, ho⟩ := (UnitOccurrenceOrientationUnique.1 q hq i + (by simpa only [hCᵢ] using hc)).exists + exact ⟨o, fun _ => ho⟩ + · exact ⟨false, fun h => (hc h).elim⟩ + +private theorem hpouter_eq : + (by + classical + exact + ∀ (h₀ : PartialOdometer), ∀ (p₀ : Real × Real), (PartialOdometerSlope h₀ = some p₀) → (∀ + (pouter : ℝ × ℝ), (PartialOdometerSlope h₀ = some pouter) → (pouter = p₀)) ) := by + classical + intro h₀ p₀ hs₀ pouter hpouter + have heq := hpouter.symm.trans hs₀ + exact Option.some.inj heq + +private theorem htranslateZero : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → + UnitOccurrenceOrientation q i o), + let orientation := Classical.choose horientationExists + ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), ∀ (hseed : PartialOdometer), (Rminus ∈ RegularTileFamily base + (TilingLattice Cᵢ)) → ((TileOdometer Cᵢ.1.1 Rminus hseed) → ((BoundaryString C₀ Cᵢ i + orientation T₀ base Rminus Rplus tiles) → (∀ (q' : Fin (4 : ℕ) → CircleCoordinates), + (TileString Cᵢ orientation base Rminus Rplus tiles) → ((TileCentroid Rminus - + TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q' i.succ) (q' (0 : + Fin (4 : ℕ))) - BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' i.succ))) → (∀ (centerShift + : GaussianInt), ∀ (reverseTiles : List ProtoTile), (GaussianRealPoint centerShift = + TileCentroid Rminus + TileCentroid Rplus) → ((TileString Cᵢ orientation base Rplus + Rminus reverseTiles) → (((TileTranslation (TileHalfTurn Rminus) centerShift).cells = + Rplus.cells) → (((TileTranslation (TileHalfTurn Rplus) centerShift).cells = + Rminus.cells) → (TileTranslation Rminus (0 : GaussianInt) = Rminus))))))))) ) := by + classical + intro q C₀ Cᵢ i T₀ horientationExists orientation base Rminus Rplus tiles hseed hRminus hseedO + hboundaryOriginal q' hstring hcentroidMinus centerShift reverseTiles hcenters hreverse + hminusCells hplusCells + cases Rminus with + | mk cs anchor => + have hfun : GaussianTranslation (0 : GaussianInt) = id := by + funext z + simp [GaussianTranslation] + simp [TileTranslation, hfun] + +private theorem hOminus : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (Cᵢ : BandCircle), ∀ (i : Fin 3), ∀ (Rminus : + ProtoTile), ∀ (hseed : PartialOdometer), (TileOdometer Cᵢ.1.1 Rminus hseed) → ( + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + (TileTranslation Rminus (0 : GaussianInt) = Rminus) → (TileOdometer Cᵢ.1.1 Rminus + hminus)) ) := by + classical + intro q Cᵢ i Rminus hseed hseedO d hminus htranslateZero + rw [← htranslateZero] + exact TileOdometerAffineTranslation Cᵢ.1.1 Rminus hseed 0 d 0 hseedO + +private theorem hsminus : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (p₀ : Real × Real), ∀ (hseed : + PartialOdometer), ∀ (pseed : ℝ × ℝ), (PartialOdometerSlope hseed = some pseed) → ( + let pminus := p₀ + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ)) + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + (pseed + GaussianRealPoint d = pminus) → (PartialOdometerSlope hminus = some pminus)) ) + := by + classical + intro q i p₀ hseed pseed hseedSlope pminus d hminus hminusSlopeCalc + have hs := (PartialOdometerAffineTranslateFormulas hseed 0 d 0).2.2.2.2.2 + rw [hs, hseedSlope] + apply congrArg some + apply Prod.ext + · simpa [GaussianRealPoint, d] using congrArg Prod.fst hminusSlopeCalc + · simpa [GaussianRealPoint, d] using congrArg Prod.snd hminusSlopeCalc + +private theorem hC₀positive : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (ProperBandQuadruple q) → (∀ (C₀ : BandCircle), ∀ (Cᵢ + : BandCircle), ∀ (i : Fin 3), (q (0 : Fin (4 : ℕ)) = C₀.1.1) → ((q i.succ = Cᵢ.1.1) → + (((0 : ℤ) < Cᵢ.1.1.1) → (0 < C₀.1.1.1)))) ) := by + classical + intro q hq C₀ Cᵢ i hC₀ hCᵢ hpositive + have hlt := hq.2 i + have hpos : 0 < (q i.succ).1 := by simpa only [hCᵢ] using hpositive + rw [hC₀] at hlt + omega + +private theorem positive_cells : + (by + classical + exact + (BandCircle) → ((BandCircle) → (∀ (D : CircleCoordinates), ∀ (V : ProtoTile), 0 < D.1 → + BandPrototile D V → V.cells.Nonempty)) ) := by + classical + intro C₀ Cᵢ D V hD hV + induction hV with + | line w x hw => simp at hD + | unit z x anchor => simp + | @decompose qd hqd S V hS hcells hfoot hcentroid ih => + have facts := ProperBandCurvatureStructure qd hqd + have hp : ∃ j : Fin 3, 0 < (qd j.succ).1 := by + by_cases h0 : 0 < (qd (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (qd (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + by_cases h2 : 0 < (qd (2 : Fin 3).succ).1 + · exact ⟨2, h2⟩ + have n0 := facts.2.1 (0 : Fin 3) + have n1 := facts.2.1 (1 : Fin 3) + have z0 : (qd (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (qd (1 : Fin 3).succ).1 = 0 := by omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim + rcases hp with ⟨j, hj⟩ + rcases ih j false hj with ⟨x, hx⟩ + exact ⟨x, (hcells x).mpr ⟨j, false, hx⟩⟩ + +private theorem hbarO : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (h₀ : PartialOdometer), (TileOdometer C₀.1.1 + T₀ h₀) → (∀ (centerShift : GaussianInt), + let hbar := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift 0 0 + let Tbar := TileTranslation (TileHalfTurn T₀) centerShift + TileOdometer C₀.1.1 Tbar hbar) ) := by + classical + intro C₀ T₀ h₀ hO₀ centerShift hbar Tbar + exact TileOdometerAffineTranslation C₀.1.1 (TileHalfTurn T₀) + (PartialOdometerHalfTurn h₀) centerShift 0 0 + (TileOdometerCentralSymmetry C₀.1.1 T₀ h₀ hO₀).1 + +private theorem hsumCentroid : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin + 3), (q (0 : Fin (4 : ℕ)) = C₀.1.1) → ((q i.succ = Cᵢ.1.1) → (∀ (T₀ : ProtoTile), ∀ + (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (q' : Fin (4 : ℕ) → + CircleCoordinates), (q' (0 : Fin (4 : ℕ)) = C₀.1.1) → ((q' i.succ = Cᵢ.1.1) → + ((TileCentroid Rminus - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (q' i.succ) (q' (0 : Fin (4 : ℕ))) - BandVectors.1 (q' (0 : Fin (4 : + ℕ))) (q' i.succ))) → ((TileCentroid Rplus - TileCentroid T₀ = (1 / 2 : ℝ) • + GaussianRealPoint (BandVectors.1 (q' i.succ) (q' (0 : Fin (4 : ℕ))) + BandVectors.1 + (q' (0 : Fin (4 : ℕ))) (q' i.succ))) → (TileCentroid Rminus + TileCentroid Rplus = + TileCentroid T₀ + TileCentroid T₀ + GaussianRealPoint (BandVectors.1 (q i.succ) (q + 0)))))))) ) := by + classical + intro q C₀ Cᵢ i hC₀ hCᵢ T₀ Rminus Rplus q' hq0 hqi hcentroidMinus hcentroidPlus + have hcm := hcentroidMinus + have hcp := hcentroidPlus + rw [hqi, hq0, ← hCᵢ, ← hC₀] at hcm hcp + have hcmr := congrArg Prod.fst hcm + have hcpr := congrArg Prod.fst hcp + have hcmi := congrArg Prod.snd hcm + have hcpi := congrArg Prod.snd hcp + simp only [Prod.fst_sub, GaussianRealPoint, + Prod.snd_sub] at hcmr hcpr hcmi hcpi + norm_num [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, + Int.cast_sub, Int.cast_add] at hcmr hcpr hcmi hcpi + apply Prod.ext + · simp only [Prod.fst_add, GaussianRealPoint, + GaussianInt.intCast_re] at ⊢ + linarith + · simp only [Prod.snd_add, GaussianRealPoint, + GaussianInt.intCast_im] at ⊢ + linarith + +private theorem hcentbar : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (T₀ : ProtoTile), ∀ (T₀' : + ProtoTile), (TileCentroid T₀' - TileCentroid T₀ = GaussianRealPoint (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))))) → (∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ + (centerShift : GaussianInt), (GaussianRealPoint centerShift = TileCentroid Rminus + + TileCentroid Rplus) → ( + let Tbar := TileTranslation (TileHalfTurn T₀) centerShift + (TileCentroid Rminus + TileCentroid Rplus = TileCentroid T₀ + TileCentroid T₀ + + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) → (TileCentroid Tbar = + TileCentroid T₀'))) ) := by + classical + intro q i T₀ T₀' hcentroid Rminus Rplus centerShift hcenters Tbar hsumCentroid + have hcentformula := (TileTranslationFormulas (TileHalfTurn T₀) centerShift).2.2.2.2.1 + have hhalfcent := (TileHalfTurnFormulas T₀).2.2.2.2.2.2.2.1 + rw [hcentformula, hhalfcent] + have hcentin := congrArg Prod.fst hcentroid + have hcentout := congrArg Prod.snd hcentroid + have hshiftr : (centerShift.re : Real) = + (TileCentroid Rminus + TileCentroid Rplus).1 := by + simpa only [GaussianRealPoint] using congrArg Prod.fst hcenters + have hshifti : (centerShift.im : Real) = + (TileCentroid Rminus + TileCentroid Rplus).2 := by + simpa only [GaussianRealPoint] using congrArg Prod.snd hcenters + have hsumr : (TileCentroid Rminus).1 + (TileCentroid Rplus).1 = + (TileCentroid T₀).1 + (TileCentroid T₀).1 + + (BandVectors.1 (q i.succ) (q 0)).re := by + simpa only [Prod.fst_add, GaussianRealPoint] using congrArg Prod.fst hsumCentroid + have hsumi : (TileCentroid Rminus).2 + (TileCentroid Rplus).2 = + (TileCentroid T₀).2 + (TileCentroid T₀).2 + + (BandVectors.1 (q i.succ) (q 0)).im := by + simpa only [Prod.snd_add, GaussianRealPoint] using congrArg Prod.snd hsumCentroid + have hcentin' : (TileCentroid T₀').1 - (TileCentroid T₀).1 = + (BandVectors.1 (q i.succ) (q 0)).re := by + simpa only [Prod.fst_sub, GaussianRealPoint] using hcentin + have hcentout' : (TileCentroid T₀').2 - (TileCentroid T₀).2 = + (BandVectors.1 (q i.succ) (q 0)).im := by + simpa only [Prod.snd_sub, GaussianRealPoint] using hcentout + apply Prod.ext + · change -(TileCentroid T₀).1 + (centerShift.re : Real) = (TileCentroid T₀').1 + calc + -(TileCentroid T₀).1 + (centerShift.re : Real) = + -(TileCentroid T₀).1 + ((TileCentroid Rminus).1 + + (TileCentroid Rplus).1) := by rw [hshiftr]; rfl + _ = -(TileCentroid T₀).1 + ((TileCentroid T₀).1 + + (TileCentroid T₀).1 + (BandVectors.1 (q i.succ) (q 0)).re) := by rw [hsumr] + _ = (TileCentroid T₀').1 := by linarith [hcentin'] + · change -(TileCentroid T₀).2 + (centerShift.im : Real) = (TileCentroid T₀').2 + calc + -(TileCentroid T₀).2 + (centerShift.im : Real) = + -(TileCentroid T₀).2 + ((TileCentroid Rminus).2 + + (TileCentroid Rplus).2) := by rw [hshifti]; rfl + _ = -(TileCentroid T₀).2 + ((TileCentroid T₀).2 + + (TileCentroid T₀).2 + (BandVectors.1 (q i.succ) (q 0)).im) := by rw [hsumi] + _ = (TileCentroid T₀').2 := by linarith [hcentout'] + +private theorem htranslateInjective : + (by + classical + exact + ∀ (touter : GaussianInt), Function.Injective (GaussianTranslation touter) ) := by + classical + intro touter x y hxy + dsimp [GaussianTranslation] at hxy + exact add_right_cancel hxy + +private theorem hbarDomains : + (by + classical + exact + ∀ (h₀ : PartialOdometer), ∀ (h₀' : PartialOdometer), ∀ (centerShift : GaussianInt), + let hbar := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift 0 0 + ∀ (touter : GaussianInt), (∀ (x : GaussianInt), x ∈ hbar.domain ↔ x - touter ∈ + h₀'.domain) → ((touter = 0) → (∀ x, x ∈ hbar.domain ↔ x ∈ h₀'.domain)) ) := by + classical + intro h₀ h₀' centerShift hbar touter hdomainShift htouterZero x + simpa [htouterZero] using hdomainShift x + +private theorem hbarOuterDomain : + (by + classical + exact + ∀ (h₀ : PartialOdometer), ∀ (centerShift : GaussianInt), + let hbar := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift 0 0 + ∀ (couter : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + let houterAffine := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift a b + hbar.domain = houterAffine.domain ) := by + classical + intro h₀ centerShift hbar couter eouter a b houterAffine + simp only [hbar, houterAffine, + (PartialOdometerAffineTranslateFormulas (PartialOdometerHalfTurn h₀) + centerShift 0 0).1, + (PartialOdometerAffineTranslateFormulas (PartialOdometerHalfTurn h₀) + centerShift a b).1] + +private theorem houterAffineDomain : + (by + classical + exact + ∀ (h₀ : PartialOdometer), ∀ (h₀' : PartialOdometer), ∀ (centerShift : GaussianInt), + let hbar := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift 0 0 + ∀ (couter : GaussianInt), ∀ (eouter : ℤ), (∀ x, x ∈ hbar.domain ↔ x ∈ h₀'.domain) → ( + let a : GaussianInt := -couter + let b : Int := -eouter + let houterAffine := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift a b + (hbar.domain = houterAffine.domain) → (h₀'.domain = houterAffine.domain)) ) := by + classical + intro h₀ h₀' centerShift hbar couter eouter hbarDomains a b houterAffine hbarOuterDomain + ext x + have hx := hbarDomains x + rw [hbarOuterDomain] at hx + exact hx.symm + +private theorem houterAffineEq : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (T₀' : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (h₀' : + PartialOdometer), (TileOdometer C₀.1.1 T₀' h₀') → (∀ (p₀' : Real × Real), + (PartialOdometerSlope h₀' = some p₀') → (∀ (centerShift : GaussianInt), + let hbar := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift 0 0 + (∃! u : GaussianInt, T₀'.cells = (TileTranslation T₀' u).cells ∧ (T₀'.cells = ∅ → + T₀'.anchor = (TileTranslation T₀' u).anchor) ∧ ∃ (a : GaussianInt) (b : ℤ), (∀ (x : + GaussianInt), x ∈ hbar.domain ↔ x - u ∈ h₀'.domain) ∧ ∀ x ∈ hbar.domain, hbar.value x + = h₀'.value (x - u) + a.re * x.re + a.im * x.im + b) → (∀ (touter : GaussianInt), ∀ + (couter : GaussianInt), ∀ (eouter : ℤ), (∀ (x : GaussianInt), x ∈ hbar.domain ↔ x - + touter ∈ h₀'.domain) → ((∀ x ∈ hbar.domain, hbar.value x = h₀'.value (x - touter) + + couter.re * x.re + couter.im * x.im + eouter) → ((touter = 0) → ((∀ x, x ∈ + hbar.domain ↔ x ∈ h₀'.domain) → ( + let a : GaussianInt := -couter + let b : Int := -eouter + let houterAffine := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift a b + (hbar.domain = houterAffine.domain) → ((h₀'.domain = houterAffine.domain) → (h₀' = + houterAffine))))))))) ) := by + classical + intro C₀ T₀' h₀ h₀' hO₀' p₀' hs₀' centerShift hbar houterUnique touter couter eouter + hdomainShift hvalueShift htouterZero hbarDomains a b houterAffine hbarOuterDomain + houterAffineDomain + cases h₀' with + | mk dom val hout => + have hdom : dom = houterAffine.domain := houterAffineDomain + subst dom + congr 1 + funext x + by_cases hx : x ∈ houterAffine.domain + · have hxbar : x ∈ hbar.domain := by rw [hbarOuterDomain]; exact hx + have hv := by simpa [htouterZero] using hvalueShift x hxbar + have hvbar := (PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn h₀) centerShift 0 0).2.2.1 x hxbar + have hvaff := (PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn h₀) centerShift a b).2.2.1 x hx + rw [hvbar] at hv + change val x = (PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift a b).value x + rw [hvaff] + norm_num [a, b, Zsqrtd.re_neg, Zsqrtd.im_neg] at hv ⊢ + linarith + · have hxbar : x ∉ hbar.domain := by + intro hm + apply hx + rw [← hbarOuterDomain] + exact hm + rw [hout x hx] + change 0 = (PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift a b).value x + exact (houterAffine.value_outside x hx).symm + +private theorem hhalfSlope : + (by + classical + exact + ∀ (h₀ : PartialOdometer), ∀ (p₀ : Real × Real), (PartialOdometerSlope h₀ = some p₀) → + (PartialOdometerSlope (PartialOdometerHalfTurn h₀) = some (-p₀.1, -p₀.2)) ) := by + classical + intro h₀ p₀ hs₀ + have hs := (PartialOdometerHalfTurnFormulas h₀).2.2.2.2.2.2 + rw [hs₀] at hs + simpa using hs + +private theorem houterSlope : + (by + classical + exact + ∀ (h₀ : PartialOdometer), ∀ (p₀ : Real × Real), ∀ (centerShift : GaussianInt), ∀ (couter + : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + let houterAffine := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift a b + (PartialOdometerSlope (PartialOdometerHalfTurn h₀) = some (-p₀.1, -p₀.2)) → + (PartialOdometerSlope houterAffine = some (-p₀.1 + (a.re : Real), -p₀.2 + (a.im : + Real))) ) := by + classical + intro h₀ p₀ centerShift couter eouter a b houterAffine hhalfSlope + have hs := (PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn h₀) centerShift a b).2.2.2.2.2 + rw [hhalfSlope] at hs + simpa [houterAffine] using hs + +private theorem haSlope : + (by + classical + exact + ∀ (p₀ : Real × Real), ∀ (p₀' : Real × Real), ∀ (couter : GaussianInt), + let a : GaussianInt := -couter + ((-p₀.1 + (↑a.re : ℝ), -p₀.2 + (↑a.im : ℝ)) = p₀') → (p₀ + p₀' = GaussianRealPoint a) ) + := by + classical + intro p₀ p₀' couter a houterSlopeEq + apply Prod.ext + · have h := congrArg Prod.fst houterSlopeEq + change -p₀.1 + (a.re : Real) = p₀'.1 at h + change p₀.1 + p₀'.1 = (a.re : Real) + linarith + · have h := congrArg Prod.snd houterSlopeEq + change -p₀.2 + (a.im : Real) = p₀'.2 at h + change p₀.2 + p₀'.2 = (a.im : Real) + linarith + +private theorem hRplusBand : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → + UnitOccurrenceOrientation q i o), + let orientation := Classical.choose horientationExists + ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), (BandPrototile Cᵢ.1.1 base) → ((Rplus ∈ RegularTileFamily base + (TilingLattice Cᵢ)) → ((BoundaryString C₀ Cᵢ i orientation T₀ base Rminus Rplus + tiles) → (∀ (q' : Fin (4 : ℕ) → CircleCoordinates), (TileString Cᵢ orientation base + Rminus Rplus tiles) → ((TileCentroid Rplus - TileCentroid T₀ = (1 / 2 : ℝ) • + GaussianRealPoint (BandVectors.1 (q' i.succ) (q' (0 : Fin (4 : ℕ))) + BandVectors.1 + (q' (0 : Fin (4 : ℕ))) (q' i.succ))) → (∀ (centerShift : GaussianInt), ∀ + (reverseTiles : List ProtoTile), (GaussianRealPoint centerShift = TileCentroid Rminus + + TileCentroid Rplus) → ((TileString Cᵢ orientation base Rplus Rminus reverseTiles) → + (((TileTranslation (TileHalfTurn Rminus) centerShift).cells = Rplus.cells) → + (((TileTranslation (TileHalfTurn Rplus) centerShift).cells = Rminus.cells) → + ((TileCentroid Rminus + TileCentroid Rplus = TileCentroid T₀ + TileCentroid T₀ + + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) → (BandPrototile Cᵢ.1.1 + Rplus)))))))))) ) := by + classical + intro q C₀ Cᵢ i T₀ horientationExists orientation base Rminus Rplus tiles hbase hRplus + hboundaryOriginal q' hstring hcentroidPlus centerShift reverseTiles hcenters hreverse + hminusCells hplusCells hsumCentroid + rcases hRplus with ⟨w, hw, rfl⟩ + exact BandPrototileTranslation Cᵢ.1.1 base w hbase + +private theorem hplusRawO : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (Cᵢ : BandCircle), ∀ (i : Fin 3), ∀ (Rminus : + ProtoTile), ∀ (hseed : PartialOdometer), ∀ (centerShift : GaussianInt), + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + (TileOdometer Cᵢ.1.1 Rminus hminus) → (∀ (couter : GaussianInt), + let a : GaussianInt := -couter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + TileOdometer Cᵢ.1.1 (TileTranslation (TileHalfTurn Rminus) centerShift) hplus) ) := by + classical + intro q Cᵢ i Rminus hseed centerShift d hminus hOminus couter a hplus + exact TileOdometerAffineTranslation Cᵢ.1.1 (TileHalfTurn Rminus) + (PartialOdometerHalfTurn hminus) centerShift a 0 + (TileOdometerCentralSymmetry Cᵢ.1.1 Rminus hminus hOminus).1 + +private theorem hslopeDifferenceRe : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (p₀ : Real × Real), ∀ (p₀' : Real × + Real), (p₀' - p₀ = GaussianRealPoint (BandVectors.2 (q i.succ) (q (0 : Fin (4 : + ℕ))))) → (p₀'.1 - p₀.1 = (BandVectors.2 (q i.succ) (q 0)).re) ) := by + classical + intro q i p₀ p₀' hslope + simpa only [Prod.fst_sub, GaussianRealPoint] using congrArg Prod.fst hslope + +private theorem hslopeDifferenceIm : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (p₀ : Real × Real), ∀ (p₀' : Real × + Real), (p₀' - p₀ = GaussianRealPoint (BandVectors.2 (q i.succ) (q (0 : Fin (4 : + ℕ))))) → (p₀'.2 - p₀.2 = (BandVectors.2 (q i.succ) (q 0)).im) ) := by + classical + intro q i p₀ p₀' hslope + simpa only [Prod.snd_sub, GaussianRealPoint] using congrArg Prod.snd hslope + +private theorem hplusSlopeCalc : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (p₀ : Real × Real), ∀ (p₀' : Real × + Real), + let pminus := p₀ + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ)) + let pplus := p₀ + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)) + ∀ (couter : GaussianInt), + let a : GaussianInt := -couter + (p₀'.1 - p₀.1 = (BandVectors.2 (q i.succ) (q 0)).re) → ((p₀'.2 - p₀.2 = (BandVectors.2 (q + i.succ) (q 0)).im) → ((p₀.1 + p₀'.1 = (a.re : Real)) → ((p₀.2 + p₀'.2 = (a.im : + Real)) → ((-pminus.1 + (a.re : Real), -pminus.2 + (a.im : Real)) = pplus)))) ) := by + classical + intro q i p₀ p₀' pminus pplus couter a hslopeDifferenceRe hslopeDifferenceIm haRe haIm + apply Prod.ext + · simp [pminus, pplus, GaussianRealPoint, Prod.smul_mk, + Zsqrtd.re_sub, Zsqrtd.re_add, Int.cast_sub, Int.cast_add, + GaussianInt.intCast_re] at hslopeDifferenceRe haRe ⊢ + linarith + · simp [pminus, pplus, GaussianRealPoint, Prod.smul_mk, + Zsqrtd.im_sub, Zsqrtd.im_add, Int.cast_sub, Int.cast_add, + GaussianInt.intCast_im] at hslopeDifferenceIm haIm ⊢ + linarith + +private theorem hsplus : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (p₀ : Real × Real), ∀ (hseed : + PartialOdometer), ∀ (centerShift : GaussianInt), + let pminus := p₀ + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ)) + let pplus := p₀ + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)) + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + (PartialOdometerSlope hminus = some pminus) → (∀ (couter : GaussianInt), + let a : GaussianInt := -couter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + ((-pminus.1 + (a.re : Real), -pminus.2 + (a.im : Real)) = pplus) → (PartialOdometerSlope + hplus = some pplus)) ) := by + classical + intro q i p₀ hseed centerShift pminus pplus d hminus hsminus couter a hplus hplusSlopeCalc + have hsHalf := (PartialOdometerHalfTurnFormulas hminus).2.2.2.2.2.2 + rw [hsminus] at hsHalf + have hsAff := (PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn hminus) centerShift a 0).2.2.2.2.2 + rw [hsHalf] at hsAff + simpa [hplus] using hsAff.trans (by + simp only [Option.map_some] + exact congrArg (fun p : Real × Real => some p) hplusSlopeCalc) + +private theorem finiteTranslationFix : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), T.cells.Nonempty → T.cells = (TileTranslation T + u).cells → u = 0 ) := by + classical + intro T u hne hcells + have hinj : Function.Injective (GaussianTranslation u) := by + intro x y hxy + dsimp [GaussianTranslation] at hxy + exact add_right_cancel hxy + have hsumRe := congrArg (fun s : Finset GaussianInt => ∑ z ∈ s, z.re) hcells + rw [(TileTranslationFormulas T u).1, Finset.sum_image hinj.injOn] at hsumRe + simp only [GaussianTranslation, Zsqrtd.re_add] at hsumRe + rw [Finset.sum_add_distrib, Finset.sum_const] at hsumRe + simp only [nsmul_eq_mul] at hsumRe + have hcardNe : (T.cells.card : Int) ≠ 0 := by + exact_mod_cast hne.card_pos.ne' + have hmulRe : (T.cells.card : Int) * u.re = 0 := by linarith + have huRe : u.re = 0 := (mul_eq_zero.mp hmulRe).resolve_left hcardNe + have hsumIm := congrArg (fun s : Finset GaussianInt => ∑ z ∈ s, z.im) hcells + rw [(TileTranslationFormulas T u).1, Finset.sum_image hinj.injOn] at hsumIm + simp only [GaussianTranslation, Zsqrtd.im_add] at hsumIm + rw [Finset.sum_add_distrib, Finset.sum_const] at hsumIm + simp only [nsmul_eq_mul] at hsumIm + have hmulIm : (T.cells.card : Int) * u.im = 0 := by linarith + have huIm : u.im = 0 := (mul_eq_zero.mp hmulIm).resolve_left hcardNe + apply Zsqrtd.ext <;> assumption + +private theorem hRminusBand : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → + UnitOccurrenceOrientation q i o), + let orientation := Classical.choose horientationExists + ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), ∀ (hseed : PartialOdometer), (BandPrototile Cᵢ.1.1 base) → ((Rminus ∈ + RegularTileFamily base (TilingLattice Cᵢ)) → ((TileOdometer Cᵢ.1.1 Rminus hseed) → + ((BoundaryString C₀ Cᵢ i orientation T₀ base Rminus Rplus tiles) → (∀ (q' : Fin (4 : + ℕ) → CircleCoordinates), (TileString Cᵢ orientation base Rminus Rplus tiles) → + ((TileCentroid Rminus - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (q' i.succ) (q' (0 : Fin (4 : ℕ))) - BandVectors.1 (q' (0 : Fin (4 : + ℕ))) (q' i.succ))) → (∀ (centerShift : GaussianInt), ∀ (reverseTiles : List + ProtoTile), (GaussianRealPoint centerShift = TileCentroid Rminus + TileCentroid + Rplus) → ((TileString Cᵢ orientation base Rplus Rminus reverseTiles) → + (((TileTranslation (TileHalfTurn Rminus) centerShift).cells = Rplus.cells) → + (((TileTranslation (TileHalfTurn Rplus) centerShift).cells = Rminus.cells) → ( + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + (TileTranslation Rminus (0 : GaussianInt) = Rminus) → ((TileOdometer Cᵢ.1.1 Rminus + hminus) → ((TileCentroid Rminus + TileCentroid Rplus = TileCentroid T₀ + TileCentroid + T₀ + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) → (∀ (couter : GaussianInt), + let a : GaussianInt := -couter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + (TileOdometer Cᵢ.1.1 (TileTranslation (TileHalfTurn Rminus) centerShift) hplus) → + (BandPrototile Cᵢ.1.1 Rminus)))))))))))))) ) := by + classical + intro q C₀ Cᵢ i T₀ horientationExists orientation base Rminus Rplus tiles hseed hbase hRminus + hseedO hboundaryOriginal q' hstring hcentroidMinus centerShift reverseTiles hcenters + hreverse hminusCells hplusCells d hminus htranslateZero hOminus hsumCentroid couter a hplus + hplusRawO + rcases hRminus with ⟨w, hw, rfl⟩ + exact BandPrototileTranslation Cᵢ.1.1 base w hbase + +private theorem hbackRawO : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (Cᵢ : BandCircle), ∀ (i : Fin 3), ∀ (Rplus : + ProtoTile), ∀ (hseed : PartialOdometer), ∀ (centerShift : GaussianInt), + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + ∀ (couter : GaussianInt), + let a : GaussianInt := -couter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + (TileOdometer Cᵢ.1.1 Rplus hplus) → ( + let hback := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a 0 + TileOdometer Cᵢ.1.1 (TileTranslation (TileHalfTurn Rplus) centerShift) hback) ) := by + classical + intro q Cᵢ i Rplus hseed centerShift d hminus couter a hplus hOplus hback + change TileOdometer Cᵢ.1.1 (TileTranslation (TileHalfTurn Rplus) centerShift) + (PartialOdometerAffineTranslate (PartialOdometerHalfTurn hplus) centerShift a 0) + exact TileOdometerAffineTranslation Cᵢ.1.1 (TileHalfTurn Rplus) + (PartialOdometerHalfTurn hplus) centerShift a 0 + (TileOdometerCentralSymmetry Cᵢ.1.1 Rplus hplus hOplus).1 + +private theorem haEndpoint : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (p₀ : Real × Real), + let pminus := p₀ + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ)) + let pplus := p₀ + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)) + ∀ (couter : GaussianInt), + let a : GaussianInt := -couter + ((-pminus.1 + (a.re : Real), -pminus.2 + (a.im : Real)) = pplus) → (pminus + pplus = + GaussianRealPoint a) ) := by + classical + intro q i p₀ pminus pplus couter a hplusSlopeCalc + apply Prod.ext + · have he := congrArg Prod.fst hplusSlopeCalc + change -pminus.1 + (a.re : Real) = pplus.1 at he + change pminus.1 + pplus.1 = (a.re : Real) + linarith + · have he := congrArg Prod.snd hplusSlopeCalc + change -pminus.2 + (a.im : Real) = pplus.2 at he + change pminus.2 + pplus.2 = (a.im : Real) + linarith + +private theorem hhalfSlopePlus : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (p₀ : Real × Real), ∀ (hseed : + PartialOdometer), ∀ (centerShift : GaussianInt), + let pplus := p₀ + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)) + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + ∀ (couter : GaussianInt), + let a : GaussianInt := -couter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + (PartialOdometerSlope hplus = some pplus) → (PartialOdometerSlope + (PartialOdometerHalfTurn hplus) = some (-pplus.1, -pplus.2)) ) := by + classical + intro q i p₀ hseed centerShift pplus d hminus couter a hplus hsplus + have hs := (PartialOdometerHalfTurnFormulas hplus).2.2.2.2.2.2 + rw [hsplus] at hs + simpa using hs + +private theorem hsback : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (p₀ : Real × Real), ∀ (hseed : + PartialOdometer), ∀ (centerShift : GaussianInt), + let pminus := p₀ + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ)) + let pplus := p₀ + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)) + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + ∀ (couter : GaussianInt), + let a : GaussianInt := -couter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + let hback := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a 0 + (pminus + pplus = GaussianRealPoint a) → ((PartialOdometerSlope (PartialOdometerHalfTurn + hplus) = some (-pplus.1, -pplus.2)) → (PartialOdometerSlope hback = some pminus)) ) + := by + classical + intro q i p₀ hseed centerShift pminus pplus d hminus couter a hplus hback haEndpoint + hhalfSlopePlus + have hs := (PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn hplus) centerShift a 0).2.2.2.2.2 + rw [hhalfSlopePlus] at hs + have hpair : (-pplus.1 + (a.re : Real), -pplus.2 + (a.im : Real)) = pminus := by + apply Prod.ext + · have ha := congrArg Prod.fst haEndpoint + change pminus.1 + pplus.1 = (a.re : Real) at ha + linarith + · have ha := congrArg Prod.snd haEndpoint + change pminus.2 + pplus.2 = (a.im : Real) at ha + linarith + simpa [hback] using hs.trans (congrArg (fun p : Real × Real => some p) hpair) + +private theorem hbackSameDomain : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (hseed : PartialOdometer), ∀ + (centerShift : GaussianInt), + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + ∀ (couter : GaussianInt), + let a : GaussianInt := -couter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + let hback := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a 0 + ∀ (tback : GaussianInt), (∀ (x : GaussianInt), x ∈ hback.domain ↔ x - tback ∈ + hminus.domain) → ((tback = (0 : GaussianInt)) → (∀ x, x ∈ hback.domain ↔ x ∈ + hminus.domain)) ) := by + classical + intro q i hseed centerShift d hminus couter a hplus hback tback hbackDomains htbackZero x + simpa [htbackZero] using hbackDomains x + +private theorem hbackAffineDomain : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (hseed : PartialOdometer), ∀ + (centerShift : GaussianInt), + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + ∀ (couter : GaussianInt), + let a : GaussianInt := -couter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + let hback := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a 0 + ∀ (cback : GaussianInt), ∀ (eback : ℤ), (∀ x, x ∈ hback.domain ↔ x ∈ hminus.domain) → ( + let hminusAffine := PartialOdometerAffineTranslate hminus 0 cback eback + hback.domain = hminusAffine.domain) ) := by + classical + intro q i hseed centerShift d hminus couter a hplus hback cback eback hbackSameDomain hminusAffine + ext x + simp only [hminusAffine, + (PartialOdometerAffineTranslateFormulas hminus 0 cback eback).2.1] + simp [hbackSameDomain] + +private theorem hbackAffineEq : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (hseed : PartialOdometer), ∀ + (centerShift : GaussianInt), + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + ∀ (couter : GaussianInt), + let a : GaussianInt := -couter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + let hback := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a 0 + ∀ (tback : GaussianInt), ∀ (cback : GaussianInt), ∀ (eback : ℤ), (∀ x ∈ hback.domain, + hback.value x = hminus.value (x - tback) + cback.re * x.re + cback.im * x.im + eback) + → ((tback = (0 : GaussianInt)) → ((∀ x, x ∈ hback.domain ↔ x ∈ hminus.domain) → ( + let hminusAffine := PartialOdometerAffineTranslate hminus 0 cback eback + (hback.domain = hminusAffine.domain) → (hback = hminusAffine)))) ) := by + classical + intro q i hseed centerShift d hminus couter a hplus hback tback cback eback hbackValues + htbackZero hbackSameDomain hminusAffine hbackAffineDomain + have partial_ext (h k : PartialOdometer) (hd : h.domain = k.domain) + (hv : ∀ x, h.value x = k.value x) : h = k := by + cases h + cases k + dsimp at hd hv + subst hd + have he := funext hv + subst he + rfl + apply partial_ext + · exact hbackAffineDomain + · intro x + by_cases hx : x ∈ hminusAffine.domain + · have hxback : x ∈ hback.domain := by rw [hbackAffineDomain]; exact hx + have hv := by simpa [htbackZero, sub_zero] using hbackValues x hxback + have hvaff := (PartialOdometerAffineTranslateFormulas + hminus 0 cback eback).2.2.1 x hx + rw [hvaff] + simpa [sub_zero] using hv + · have hxₘ : x ∉ hminus.domain := by + intro hm + apply hx + exact (hbackAffineDomain ▸ (hbackSameDomain x).mpr hm) + rw [hback.value_outside x (by + intro hxback + apply hx + exact (hbackAffineDomain ▸ hxback))] + exact (hminusAffine.value_outside x hx).symm + +private theorem hbackLinearZero : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (p₀ : Real × Real), ∀ (hseed : + PartialOdometer), ∀ (centerShift : GaussianInt), + let pminus := p₀ + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ)) + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + (PartialOdometerSlope hminus = some pminus) → (∀ (couter : GaussianInt), + let a : GaussianInt := -couter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + let hback := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a 0 + ∀ (cback : GaussianInt), ∀ (eback : ℤ), (PartialOdometerSlope hback = some pminus) → ( + let hminusAffine := PartialOdometerAffineTranslate hminus 0 cback eback + (hback = hminusAffine) → (cback = 0))) ) := by + classical + intro q i p₀ hseed centerShift pminus d hminus hsminus couter a hplus hback cback eback hsback + hminusAffine hbackAffineEq + have hbackSlopeFormula := (PartialOdometerAffineTranslateFormulas + hminus 0 cback eback).2.2.2.2.2 + have hcomparisonSlope := hsback + rw [hbackAffineEq] at hcomparisonSlope + rw [hbackSlopeFormula, hsminus] at hcomparisonSlope + have hp := Option.some.inj hcomparisonSlope + apply Zsqrtd.ext + · have he := congrArg Prod.fst hp + change pminus.1 + (cback.re : Real) = pminus.1 at he + have hre : (cback.re : Real) = 0 := by linarith + exact_mod_cast hre + · have he := congrArg Prod.snd hp + change pminus.2 + (cback.im : Real) = pminus.2 at he + have him : (cback.im : Real) = 0 := by linarith + exact_mod_cast him + +private theorem hbackBackDomain : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (hseed : PartialOdometer), ∀ + (centerShift : GaussianInt), + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + ∀ (couter : GaussianInt), + let a : GaussianInt := -couter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + let hback := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a 0 + ∀ (eback : ℤ), + let bplus : Int := -eback + let hminusBack := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a bplus + hback.domain = hminusBack.domain ) := by + classical + intro q i hseed centerShift d hminus couter a hplus hback eback bplus hminusBack + ext x + simp only [hback, hminusBack, + (PartialOdometerAffineTranslateFormulas (PartialOdometerHalfTurn hplus) + centerShift a 0).2.1, + (PartialOdometerAffineTranslateFormulas (PartialOdometerHalfTurn hplus) + centerShift a bplus).2.1] + +private theorem hminusBackDomain : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (hseed : PartialOdometer), ∀ + (centerShift : GaussianInt), + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + ∀ (couter : GaussianInt), + let a : GaussianInt := -couter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + let hback := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a 0 + ∀ (eback : ℤ), (∀ x, x ∈ hback.domain ↔ x ∈ hminus.domain) → ( + let bplus : Int := -eback + let hminusBack := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a bplus + (hback.domain = hminusBack.domain) → (hminus.domain = hminusBack.domain)) ) := by + classical + intro q i hseed centerShift d hminus couter a hplus hback eback hbackSameDomain bplus + hminusBack hbackBackDomain + ext x + have hx := hbackSameDomain x + rw [hbackBackDomain] at hx + exact hx.symm + +private theorem hminusBackEq : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (hseed : PartialOdometer), ∀ + (centerShift : GaussianInt), + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + ∀ (couter : GaussianInt), + let a : GaussianInt := -couter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + let hback := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a 0 + ∀ (tback : GaussianInt), ∀ (cback : GaussianInt), ∀ (eback : ℤ), (∀ x ∈ hback.domain, + hback.value x = hminus.value (x - tback) + cback.re * x.re + cback.im * x.im + eback) + → ((tback = (0 : GaussianInt)) → ((∀ x, x ∈ hback.domain ↔ x ∈ hminus.domain) → + ((cback = 0) → ( + let bplus : Int := -eback + let hminusBack := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a bplus + (hback.domain = hminusBack.domain) → ((hminus.domain = hminusBack.domain) → (hminus = + hminusBack)))))) ) := by + classical + intro q i hseed centerShift d hminus couter a hplus hback tback cback eback hbackValues + htbackZero hbackSameDomain hbackLinearZero bplus hminusBack hbackBackDomain hminusBackDomain + have partial_ext (h k : PartialOdometer) (hd : h.domain = k.domain) + (hv : ∀ x, h.value x = k.value x) : h = k := by + cases h + cases k + dsimp at hd hv + subst hd + have he := funext hv + subst he + rfl + apply partial_ext + · exact hminusBackDomain + · intro x + by_cases hx : x ∈ hminusBack.domain + · have hxback : x ∈ hback.domain := by rw [hbackBackDomain]; exact hx + have hv := by simpa [htbackZero, sub_zero] using hbackValues x hxback + have hvalBack := (PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn hplus) centerShift a 0).2.2.1 x hxback + have hvalTarget := (PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn hplus) centerShift a bplus).2.2.1 x hx + rw [hvalBack] at hv + rw [hvalTarget] + simp [hbackLinearZero, bplus] at hv ⊢ + linarith + · have hxminus : x ∉ hminus.domain := by + intro hm + apply hx + exact (hminusBackDomain ▸ (hbackSameDomain x).mpr hm) + rw [hminus.value_outside x hxminus] + exact (hminusBack.value_outside x hx).symm + +private theorem hcentroidEndpoints : + (by + classical + exact + ∀ (i : Fin 3), ∀ (T₀ : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (q' : + Fin (4 : ℕ) → CircleCoordinates), (TileCentroid Rminus - TileCentroid T₀ = (1 / 2 : + ℝ) • GaussianRealPoint (BandVectors.1 (q' i.succ) (q' (0 : Fin (4 : ℕ))) - + BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' i.succ))) → ((TileCentroid Rplus - + TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q' i.succ) (q' (0 : + Fin (4 : ℕ))) + BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' i.succ))) → (TileCentroid + Rplus - TileCentroid Rminus = GaussianRealPoint (BandVectors.1 (q' 0) (q' i.succ)))) + ) := by + classical + intro i T₀ Rminus Rplus q' hcentroidMinus hcentroidPlus + have hcm := hcentroidMinus + have hcp := hcentroidPlus + calc + TileCentroid Rplus - TileCentroid Rminus = + (TileCentroid Rplus - TileCentroid T₀) - + (TileCentroid Rminus - TileCentroid T₀) := by + apply Prod.ext <;> simp only [Prod.fst_sub, Prod.snd_sub] <;> ring + _ = (1 / 2 : Real) • GaussianRealPoint + (BandVectors.1 (q' i.succ) (q' 0) + BandVectors.1 (q' 0) (q' i.succ)) - + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.1 (q' i.succ) (q' 0) - BandVectors.1 (q' 0) (q' i.succ)) := by + rw [hcp, hcm] + _ = GaussianRealPoint (BandVectors.1 (q' 0) (q' i.succ)) := by + apply Prod.ext <;> + simp [GaussianRealPoint, Prod.smul_mk, Zsqrtd.re_add, + Zsqrtd.re_sub, Zsqrtd.im_add, Zsqrtd.im_sub, + Int.cast_add, Int.cast_sub] <;> ring + +private theorem hpositive' : + (by + classical + exact + ∀ (Cᵢ : BandCircle), ∀ (i : Fin 3), ((0 : ℤ) < Cᵢ.1.1.1) → (∀ (q' : Fin (4 : ℕ) → + CircleCoordinates), (q' i.succ = Cᵢ.1.1) → (0 < (q' i.succ).1)) ) := by + classical + intro Cᵢ i hpositive q' hqi + rw [hqi] + exact hpositive + +private theorem hgaussianPointZero : + (by + classical + exact + ∀ z : GaussianInt, GaussianRealPoint z = (0, 0) → z = 0 ) := by + classical + intro z hz + apply Zsqrtd.ext + · have h := congrArg Prod.fst hz + simp only [GaussianRealPoint] at h + exact_mod_cast h + · have h := congrArg Prod.snd hz + simp only [GaussianRealPoint] at h + exact_mod_cast h + +private theorem hRminusNeRplus : + (by + classical + exact + ∀ (i : Fin 3), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (q' : Fin (4 : ℕ) → + CircleCoordinates), (TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint + (BandVectors.1 (q' 0) (q' i.succ))) → ((BandVectors.1 (q' 0) (q' i.succ) ≠ 0) → ((∀ z + : GaussianInt, GaussianRealPoint z = (0, 0) → z = 0) → (Rminus ≠ Rplus))) ) := by + classical + intro i Rminus Rplus q' hcentroidEndpoints hvectorNe hgaussianPointZero heq + have hcentEq := congrArg TileCentroid heq.symm + have hzero : GaussianRealPoint (BandVectors.1 (q' 0) (q' i.succ)) = (0, 0) := by + calc + GaussianRealPoint (BandVectors.1 (q' 0) (q' i.succ)) = + TileCentroid Rplus - TileCentroid Rminus := hcentroidEndpoints.symm + _ = (0, 0) := by + calc + TileCentroid Rplus - TileCentroid Rminus = + TileCentroid Rminus - TileCentroid Rminus := by rw [hcentEq] + _ = 0 := sub_self _ + _ = (0, 0) := rfl + exact hvectorNe (hgaussianPointZero _ hzero) + +private theorem htilesHead : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (Cᵢ : BandCircle), ∀ (i : Fin 3), ∀ + (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), + let orientation := Classical.choose horientationExists + ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), (TileString Cᵢ orientation base Rminus Rplus tiles) → (tiles.head? = some + Rminus) ) := by + classical + intro q Cᵢ i horientationExists orientation base Rminus Rplus tiles hstring + have hh := hstring + unfold TileString at hh + exact hh.2.1 + +private theorem htilesLast : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (Cᵢ : BandCircle), ∀ (i : Fin 3), ∀ + (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), + let orientation := Classical.choose horientationExists + ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), (TileString Cᵢ orientation base Rminus Rplus tiles) → (tiles.getLast? = + some Rplus) ) := by + classical + intro q Cᵢ i horientationExists orientation base Rminus Rplus tiles hstring + have hh := hstring + unfold TileString at hh + exact hh.2.2.1 + +private theorem htilesLength : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → + UnitOccurrenceOrientation q i o), + let orientation := Classical.choose horientationExists + ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), (BoundaryString C₀ Cᵢ i orientation T₀ base Rminus Rplus tiles) → + ((TileString Cᵢ orientation base Rminus Rplus tiles) → (∀ (centerShift : + GaussianInt), ∀ (reverseTiles : List ProtoTile), (List.Forall₂ (fun (T U : ProtoTile) + => (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells) tiles + reverseTiles) → ((Rminus ≠ Rplus) → ((tiles.head? = some Rminus) → ((tiles.getLast? = + some Rplus) → (2 ≤ tiles.length)))))) ) := by + classical + intro q C₀ Cᵢ i T₀ horientationExists orientation base Rminus Rplus tiles hboundaryOriginal + hstring centerShift reverseTiles hcellPairs hRminusNeRplus htilesHead htilesLast + cases tiles with + | nil => simp at htilesHead + | cons first rest => + cases rest with + | nil => + have hfirst : first = Rminus := by simpa using htilesHead + have hlast : first = Rplus := by simpa using htilesLast + exact (hRminusNeRplus (hfirst.symm.trans hlast)).elim + | cons second rest => simp + +private theorem transformForall : + (by + classical + exact + ∀ (centerShift : GaussianInt), ∀ (couter : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + ∀ (eback : ℤ), + let bplus : Int := -eback + ∀ (hs : List PartialOdometer), + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + ∀ n, ∀ l, List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a c) l (l.mapIdx (fun j h => transformAt (n + + j) h)) ) := by + classical + intro centerShift couter eouter a b eback bplus hs constAt transformAt n l + induction l generalizing n with + | nil => simp + | cons h tl ih => + simp only [List.mapIdx_cons] + constructor + · exact ⟨constAt n, by simp [transformAt]⟩ + · simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using ih (n + 1) + +private theorem htransform : + (by + classical + exact + ∀ (centerShift : GaussianInt), ∀ (couter : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + ∀ (eback : ℤ), + let bplus : Int := -eback + ∀ (hs : List PartialOdometer), + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + (∀ n, ∀ l, List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a c) l (l.mapIdx (fun j h => transformAt (n + + j) h))) → (List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a c) hs gs) ) := by + classical + intro centerShift couter eouter a b eback bplus hs constAt transformAt gs transformForall + simpa [gs, transformAt, Nat.zero_add] using transformForall 0 hs + +private theorem hgsHead : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (hseed : PartialOdometer), ∀ + (centerShift : GaussianInt), + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + ∀ (couter : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + ∀ (eback : ℤ), + let bplus : Int := -eback + ∀ (hs : List PartialOdometer), (hs.head? = some hminus) → ( + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + gs.head? = some hplus) ) := by + classical + intro q i hseed centerShift d hminus couter eouter a b hplus eback bplus hs hhsHead constAt + transformAt gs + rw [List.head?_mapIdx, hhsHead] + simp [transformAt, constAt, hplus] + +private theorem hgsLast : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (BandCircle) → ((BandCircle) → (∀ (i : Fin 3), + (ProtoTile) → (∀ (tiles : List ProtoTile), ∀ (hseed : PartialOdometer), (Fin (4 : ℕ) + → CircleCoordinates) → (∀ (centerShift : GaussianInt), + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + (GaussianInt) → (∀ (couter : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + ∀ (eback : ℤ), + let bplus : Int := -eback + let hminusBack := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a bplus + (hminus = hminusBack) → ((2 ≤ tiles.length) → (∀ (hs : List PartialOdometer), + (hs.getLast? = some hplus) → ((hs.length = tiles.length) → ( + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + gs.getLast? = some hminus))))))))) ) := by + classical + intro q C₀ Cᵢ i T₀' tiles hseed q' centerShift d hminus touter couter eouter a b hplus eback + bplus hminusBack hminusBackEq htilesLength hs hhsLast hlengthEq constAt transformAt gs + rw [List.getLast?_mapIdx, hhsLast] + have hlastIndex : hs.length - 1 + 1 = hs.length := by omega + have hlastNotZero : hs.length - 1 ≠ 0 := by omega + simp only [Option.map_some] + apply congrArg some + dsimp [transformAt, constAt] + rw [ite_eq_right hlastNotZero, ite_eq_left hlastIndex] + exact hminusBackEq.symm + +private theorem forall2_dropLast : + (by + classical + exact + ∀ {α : Type}, ∀ {β : Type}, ∀ (r : α → β → Prop), ∀ {xs : List α}, ∀ {ys : List β}, + List.Forall₂ r xs ys → List.Forall₂ r xs.dropLast ys.dropLast ) := by + classical + intro α β r xs ys hxy + induction hxy with + | nil => simp + | @cons x y xs ys hxy hrest ih => + cases xs with + | nil => + cases ys with + | nil => simp + | cons y' ys' => cases hrest + | cons x' xs' => + cases ys with + | nil => cases hrest + | cons y' ys' => + simpa only [List.dropLast_cons_cons] using List.Forall₂.cons hxy ih + +private theorem hinteriorCells : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (horientationExists : ∃ o : Bool, + Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), + let orientation := Classical.choose horientationExists + ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), (BoundaryString C₀ Cᵢ i orientation T₀ base Rminus Rplus tiles) → + ((TileString Cᵢ orientation base Rminus Rplus tiles) → (∀ (centerShift : + GaussianInt), ∀ (reverseTiles : List ProtoTile), (TileString Cᵢ orientation base + Rplus Rminus reverseTiles) → ((List.Forall₂ (fun (T U : ProtoTile) => + (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells) tiles reverseTiles) → + ((tiles.head? = some Rminus) → ((tiles.getLast? = some Rplus) → ((2 ≤ tiles.length) → + (∀ (hs : List PartialOdometer), (OdometerStringRespect Cᵢ orientation base Rminus + Rplus tiles hs) → ((∀ T ∈ (List.drop (1 : ℕ) tiles).dropLast, ∃ (h : + PartialOdometer), (T, h) ∈ tiles.zip hs ∧ AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀ h h₀) → + ((hs.length = tiles.length) → ((∀ {α : Type}, ∀ {β : Type}, ∀ (r : α → β → Prop), ∀ + {xs : List α}, ∀ {ys : List β}, List.Forall₂ r xs ys → List.Forall₂ r xs.dropLast + ys.dropLast) → ( + let cellRelation : ProtoTile → ProtoTile → Prop := fun T U => + (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells + List.Forall₂ cellRelation ((tiles.drop 1).dropLast) ((reverseTiles.drop + 1).dropLast)))))))))))) ) := by + classical + intro q C₀ Cᵢ i T₀ h₀ horientationExists orientation base Rminus Rplus tiles hboundaryOriginal + hstring centerShift reverseTiles hreverse hcellPairs htilesHead htilesLast htilesLength hs + hrespect hancestorForward hlengthEq forall2_dropLast cellRelation + cases hcellPairs with + | nil => simp at htilesLength + | cons hfirst htail => + simpa using forall2_dropLast cellRelation htail + +private theorem interiorTransforms : + (by + classical + exact + (BandCircle) → ((BandCircle) → ((Fin 3) → ((ProtoTile) → ((List ProtoTile) → ((Fin (4 : + ℕ) → CircleCoordinates) → (∀ (centerShift : GaussianInt), (GaussianInt) → (∀ (couter + : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + ∀ (eback : ℤ), + let bplus : Int := -eback + ∀ (hs : List PartialOdometer), + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + ∀ n, ∀ (l : List PartialOdometer), 0 < n → hs.length = n + l.length → List.Forall₂ (fun h + g => g = PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a b) + l.dropLast ((l.mapIdx (fun j h => transformAt (n + j) h)).dropLast)))))))) ) := by + classical + intro C₀ Cᵢ i T₀' tiles q' centerShift touter couter eouter a b eback bplus hs constAt + transformAt n l + induction l generalizing n with + | nil => intro hn hlen; simp + | cons x xs ih => + intro hn hlen + cases xs with + | nil => simp + | cons y ys => + simp only [List.length_cons] at hlen + simp only [List.dropLast_cons_cons, List.mapIdx_cons] + constructor + · dsimp [transformAt, constAt] + have hn0 : n ≠ 0 := by omega + have hnlast : n + 1 ≠ hs.length := by omega + simp [hn0, hnlast] + · have hlen' : hs.length = (n + 1) + (y :: ys).length := by + simp only [List.length_cons] at hlen ⊢ + omega + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using + ih (n + 1) (by omega) hlen' + +private theorem hgsTail : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (horientationExists : ∃ o : Bool, + Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), + let orientation := Classical.choose horientationExists + ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), ∀ (hseed : PartialOdometer), ∀ (centerShift : GaussianInt), + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + ∀ (couter : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + ∀ (eback : ℤ), + let bplus : Int := -eback + ∀ (hs : List PartialOdometer), (hs.head? = some hminus) → ((hs.getLast? = some hplus) → + ((OdometerStringRespect Cᵢ orientation base Rminus Rplus tiles hs) → ((∀ T ∈ + (List.drop (1 : ℕ) tiles).dropLast, ∃ (h : PartialOdometer), (T, h) ∈ tiles.zip hs ∧ + AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀ h h₀) → ((hs.length = tiles.length) → ((2 ≤ + hs.length) → ( + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + (∀ n, ∀ l, List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a c) l (l.mapIdx (fun j h => transformAt (n + + j) h))) → ((List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a c) hs gs) → ((gs.head? = some hplus) → + ((gs.getLast? = some hminus) → ((∀ n, ∀ (l : List PartialOdometer), 0 < n → hs.length + = n + l.length → List.Forall₂ (fun h g => g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a b) l.dropLast ((l.mapIdx (fun j h => + transformAt (n + j) h)).dropLast)) → (gs.drop 1 = hs.tail.mapIdx (fun j h => + transformAt (1 + j) h)))))))))))) ) := by + classical + intro q C₀ Cᵢ i T₀ h₀ horientationExists orientation base Rminus Rplus tiles hseed centerShift + d hminus couter eouter a b hplus eback bplus hs hhsHead hhsLast hrespect hancestorForward + hlengthEq hlengthHs constAt transformAt gs transformForall htransform hgsHead hgsLast + interiorTransforms + change (List.mapIdx transformAt hs).drop 1 = _ + cases hs with + | nil => simp at hhsHead + | cons x xs => simp [List.mapIdx_cons, List.drop, Nat.add_comm] + +private theorem htailLength : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), (ProtoTile) → (∀ (h₀ : PartialOdometer), ∀ + (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), + let orientation := Classical.choose horientationExists + ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), ∀ (hseed : PartialOdometer), (Fin (4 : ℕ) → CircleCoordinates) → (∀ + (centerShift : GaussianInt), + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + (GaussianInt) → (∀ (couter : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + ∀ (eback : ℤ), + let bplus : Int := -eback + ∀ (hs : List PartialOdometer), (hs.head? = some hminus) → ((hs.getLast? = some hplus) → + ((OdometerStringRespect Cᵢ orientation base Rminus Rplus tiles hs) → ((∀ T ∈ + (List.drop (1 : ℕ) tiles).dropLast, ∃ (h : PartialOdometer), (T, h) ∈ tiles.zip hs ∧ + AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀ h h₀) → ((hs.length = tiles.length) → ((2 ≤ + hs.length) → ( + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + (∀ n, ∀ l, List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a c) l (l.mapIdx (fun j h => transformAt (n + + j) h))) → ((List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a c) hs gs) → ((gs.head? = some hplus) → + ((gs.getLast? = some hminus) → ((∀ n, ∀ (l : List PartialOdometer), 0 < n → hs.length + = n + l.length → List.Forall₂ (fun h g => g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a b) l.dropLast ((l.mapIdx (fun j h => + transformAt (n + j) h)).dropLast)) → ((gs.drop 1 = hs.tail.mapIdx (fun j h => + transformAt (1 + j) h)) → (hs.length = 1 + hs.tail.length))))))))))))))) ) := by + classical + intro q C₀ Cᵢ i T₀ T₀' h₀ horientationExists orientation base Rminus Rplus tiles hseed q' + centerShift d hminus touter couter eouter a b hplus eback bplus hs hhsHead hhsLast hrespect + hancestorForward hlengthEq hlengthHs constAt transformAt gs transformForall htransform + hgsHead hgsLast interiorTransforms hgsTail + cases hs with + | nil => simp at hhsHead + | cons x xs => simp [List.length_cons, List.tail]; omega + +private theorem hinteriorTransforms : + (by + classical + exact + (BandCircle) → ((BandCircle) → ((Fin 3) → ((ProtoTile) → ((List ProtoTile) → ((Fin (4 : + ℕ) → CircleCoordinates) → (∀ (centerShift : GaussianInt), (GaussianInt) → (∀ (couter + : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + ∀ (eback : ℤ), + let bplus : Int := -eback + ∀ (hs : List PartialOdometer), + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + (∀ n, ∀ (l : List PartialOdometer), 0 < n → hs.length = n + l.length → List.Forall₂ (fun + h g => g = PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a + b) l.dropLast ((l.mapIdx (fun j h => transformAt (n + j) h)).dropLast)) → ((gs.drop 1 + = hs.tail.mapIdx (fun j h => transformAt (1 + j) h)) → ((hs.length = 1 + + hs.tail.length) → (List.Forall₂ (fun h g => g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a b) ((hs.drop 1).dropLast) ((gs.drop + 1).dropLast))))))))))) ) := by + classical + intro C₀ Cᵢ i T₀' tiles q' centerShift touter couter eouter a b eback bplus hs constAt + transformAt gs interiorTransforms hgsTail htailLength + simpa [hgsTail] using interiorTransforms 1 hs.tail (by omega) htailLength + +private theorem zipForall₂ : + (by + classical + exact + ∀ {α : Type}, ∀ {β : Type}, ∀ {γ : Type}, ∀ {δ : Type}, ∀ {r : α → γ → Prop}, ∀ + {s : β → δ → Prop}, ∀ {xs : List α}, ∀ {ys : List β}, ∀ {us : List γ}, ∀ + {vs : List δ}, List.Forall₂ r xs us → List.Forall₂ s ys vs → List.Forall₂ (fun x y => + r x.1 y.1 ∧ s x.2 y.2) (xs.zip ys) (us.zip vs) ) := by + classical + intro α β γ δ r s xs ys us vs hxs + induction hxs generalizing ys vs with + | nil => intro hys; cases hys <;> simp + | @cons x u xs us hxu hrest ih => + intro hys + cases hys with + | nil => simp + | cons hyv hys => + simp only [List.zip_cons_cons] + exact List.Forall₂.cons ⟨hxu, hyv⟩ (ih hys) + +private theorem zip_dropLast_eq : + (by + classical + exact + (BandCircle) → ((BandCircle) → ((Fin 3) → ((ProtoTile) → ((List ProtoTile) → ((Fin (4 : + ℕ) → CircleCoordinates) → ((GaussianInt) → ((List PartialOdometer) → (∀ {α : Type}, ∀ + {β : Type}, ∀ (xs : List α), ∀ (ys : List β), xs.length = ys.length → xs.dropLast.zip + ys.dropLast = (xs.zip ys).dropLast)))))))) ) := by + classical + intro C₀ Cᵢ i T₀' tiles q' touter hs α β xs + induction xs with + | nil => intro ys h; cases ys <;> simp at h ⊢ + | cons x xs ih => + intro ys h + cases ys with + | nil => simp at h + | cons y ys => + simp only [List.length_cons] at h + cases xs with + | nil => cases ys <;> simp at h ⊢ + | cons x' xs' => + cases ys with + | nil => simp at h + | cons y' ys' => + have hlen : xs'.length = ys'.length := by + simp only [List.length_cons] at h + omega + simp only [List.dropLast_cons_cons, List.zip_cons_cons] + rw [ih (y' :: ys') (by simpa using hlen)] + simp only [List.zip_cons_cons] + +private theorem hzipDropOne : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (horientationExists : ∃ o : Bool, + Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), + let orientation := Classical.choose horientationExists + ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), ∀ (hseed : PartialOdometer), (BoundaryString C₀ Cᵢ i orientation T₀ base + Rminus Rplus tiles) → ((TileString Cᵢ orientation base Rminus Rplus tiles) → (∀ + (centerShift : GaussianInt), ∀ (reverseTiles : List ProtoTile), (List.Forall₂ (fun (T + U : ProtoTile) => (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells) + tiles reverseTiles) → ( + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + ∀ (couter : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + ∀ (eback : ℤ), + let bplus : Int := -eback + (tiles.head? = some Rminus) → ((tiles.getLast? = some Rplus) → ((2 ≤ tiles.length) → (∀ + (hs : List PartialOdometer), (hs.head? = some hminus) → ((hs.getLast? = some hplus) → + ((OdometerStringRespect Cᵢ orientation base Rminus Rplus tiles hs) → ((∀ T ∈ + (List.drop (1 : ℕ) tiles).dropLast, ∃ (h : PartialOdometer), (T, h) ∈ tiles.zip hs ∧ + AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀ h h₀) → ((hs.length = tiles.length) → ((2 ≤ + hs.length) → ( + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + (∀ n, ∀ l, List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a c) l (l.mapIdx (fun j h => transformAt (n + + j) h))) → ((List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a c) hs gs) → ((gs.head? = some hplus) → + ((gs.getLast? = some hminus) → ( + let cellRelation : ProtoTile → ProtoTile → Prop := fun T U => + (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells + (List.Forall₂ cellRelation ((tiles.drop 1).dropLast) ((reverseTiles.drop 1).dropLast)) → + ((∀ n, ∀ (l : List PartialOdometer), 0 < n → hs.length = n + l.length → List.Forall₂ + (fun h g => g = PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) + centerShift a b) l.dropLast ((l.mapIdx (fun j h => transformAt (n + j) h)).dropLast)) + → ((gs.drop 1 = hs.tail.mapIdx (fun j h => transformAt (1 + j) h)) → ((hs.length = 1 + + hs.tail.length) → ((List.Forall₂ (fun h g => g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a b) ((hs.drop 1).dropLast) ((gs.drop + 1).dropLast)) → ((List.Forall₂ (fun X Y => cellRelation X.1 Y.1 ∧ Y.2 = + PartialOdometerAffineTranslate (PartialOdometerHalfTurn X.2) centerShift a b) + (((tiles.drop 1).dropLast).zip ((hs.drop 1).dropLast)) (((reverseTiles.drop + 1).dropLast).zip ((gs.drop 1).dropLast))) → ((tiles.drop 1).zip (hs.drop 1) = + (tiles.zip hs).drop 1)))))))))))))))))))))) ) := by + classical + intro q C₀ Cᵢ i T₀ h₀ horientationExists orientation base Rminus Rplus tiles hseed + hboundaryOriginal hstring centerShift reverseTiles hcellPairs d hminus couter eouter a b + hplus eback bplus htilesHead htilesLast htilesLength hs hhsHead hhsLast hrespect + hancestorForward hlengthEq hlengthHs constAt transformAt gs transformForall htransform + hgsHead hgsLast cellRelation hinteriorCells interiorTransforms hgsTail htailLength + hinteriorTransforms hinteriorZip + cases tiles with + | nil => simp at htilesHead + | cons T ts => + cases hs with + | nil => simp at hhsHead + | cons h ht => rfl + +private theorem htailOdoLength : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin + 3), ∀ (T₀ : ProtoTile), (ProtoTile) → (∀ (h₀ : PartialOdometer), ∀ + (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), + let orientation := Classical.choose horientationExists + ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), ∀ (hseed : PartialOdometer), (BoundaryString C₀ Cᵢ i orientation T₀ base + Rminus Rplus tiles) → ((Fin (4 : ℕ) → CircleCoordinates) → ((TileString Cᵢ + orientation base Rminus Rplus tiles) → (∀ (centerShift : GaussianInt), ∀ + (reverseTiles : List ProtoTile), (List.Forall₂ (fun (T U : ProtoTile) => + (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells) tiles reverseTiles) → ( + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + (GaussianInt) → (∀ (couter : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + ∀ (eback : ℤ), + let bplus : Int := -eback + (tiles.head? = some Rminus) → ((tiles.getLast? = some Rplus) → ((2 ≤ tiles.length) → (∀ + (hs : List PartialOdometer), (hs.head? = some hminus) → ((hs.getLast? = some hplus) → + ((OdometerStringRespect Cᵢ orientation base Rminus Rplus tiles hs) → ((∀ T ∈ + (List.drop (1 : ℕ) tiles).dropLast, ∃ (h : PartialOdometer), (T, h) ∈ tiles.zip hs ∧ + AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀ h h₀) → ((hs.length = tiles.length) → ((2 ≤ + hs.length) → ( + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + (∀ n, ∀ l, List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a c) l (l.mapIdx (fun j h => transformAt (n + + j) h))) → ((List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a c) hs gs) → ((gs.head? = some hplus) → + ((gs.getLast? = some hminus) → ( + let cellRelation : ProtoTile → ProtoTile → Prop := fun T U => + (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells + (List.Forall₂ cellRelation ((tiles.drop 1).dropLast) ((reverseTiles.drop 1).dropLast)) → + ((∀ n, ∀ (l : List PartialOdometer), 0 < n → hs.length = n + l.length → List.Forall₂ + (fun h g => g = PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) + centerShift a b) l.dropLast ((l.mapIdx (fun j h => transformAt (n + j) h)).dropLast)) + → ((gs.drop 1 = hs.tail.mapIdx (fun j h => transformAt (1 + j) h)) → ((hs.length = 1 + + hs.tail.length) → ((List.Forall₂ (fun h g => g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a b) ((hs.drop 1).dropLast) ((gs.drop + 1).dropLast)) → ((List.Forall₂ (fun X Y => cellRelation X.1 Y.1 ∧ Y.2 = + PartialOdometerAffineTranslate (PartialOdometerHalfTurn X.2) centerShift a b) + (((tiles.drop 1).dropLast).zip ((hs.drop 1).dropLast)) (((reverseTiles.drop + 1).dropLast).zip ((gs.drop 1).dropLast))) → (((tiles.drop 1).zip (hs.drop 1) = + (tiles.zip hs).drop 1) → ((tiles.drop 1).length = (hs.drop + 1).length)))))))))))))))))))))))))) ) := by + classical + intro q C₀ Cᵢ i T₀ T₀' h₀ horientationExists orientation base Rminus Rplus tiles hseed + hboundaryOriginal q' hstring centerShift reverseTiles hcellPairs d hminus touter couter + eouter a b hplus eback bplus htilesHead htilesLast htilesLength hs hhsHead hhsLast hrespect + hancestorForward hlengthEq hlengthHs constAt transformAt gs transformForall htransform + hgsHead hgsLast cellRelation hinteriorCells interiorTransforms hgsTail htailLength + hinteriorTransforms hinteriorZip hzipDropOne + cases tiles with + | nil => simp at htilesHead + | cons T ts => + cases hs with + | nil => simp at hhsHead + | cons h ht => + simp only [List.length_cons, List.drop] at hlengthEq ⊢ + omega + +private theorem hzipInteriorEq : + (by + classical + exact + ∀ (tiles : List ProtoTile), ∀ (hs : List PartialOdometer), (∀ {α : Type}, ∀ {β : Type}, ∀ + (xs : List α), ∀ (ys : List β), xs.length = ys.length → xs.dropLast.zip ys.dropLast = + (xs.zip ys).dropLast) → (((tiles.drop 1).zip (hs.drop 1) = (tiles.zip hs).drop 1) → + (((tiles.drop 1).length = (hs.drop 1).length) → ((((tiles.drop 1).dropLast).zip + ((hs.drop 1).dropLast)) = ((tiles.zip hs).drop 1).dropLast))) ) := by + classical + intro tiles hs zip_dropLast_eq hzipDropOne htailOdoLength + rw [← hzipDropOne] + exact zip_dropLast_eq (tiles.drop 1) (hs.drop 1) htailOdoLength + +private theorem zip_mem_left : + (by + classical + exact + (BandCircle) → ((BandCircle) → ((Fin 3) → ((ProtoTile) → ((List ProtoTile) → ((Fin (4 : + ℕ) → CircleCoordinates) → ((GaussianInt) → ((List PartialOdometer) → (∀ {α : Type}, ∀ + {β : Type}, ∀ (xs : List α), ∀ (ys : List β), xs.length = ys.length → ∀ x, x ∈ xs → ∃ + y, (x, y) ∈ xs.zip ys)))))))) ) := by + classical + intro C₀ Cᵢ i T₀' tiles q' touter hs α β xs + induction xs with + | nil => intro ys h x hx; simp at hx + | cons a xs ih => + intro ys h x hx + cases ys with + | nil => simp at h + | cons b ys => + simp only [List.length_cons] at h + simp only [List.mem_cons] at hx + rcases hx with rfl | hx + · exact ⟨b, by simp⟩ + · obtain ⟨y, hy⟩ := ih ys (by omega) x hx + exact ⟨y, by + simp only [List.zip_cons_cons, List.mem_cons] + right + exact hy⟩ + +private theorem zip_fst_mem : + (by + classical + exact + ∀ {α : Type}, ∀ {β : Type}, ∀ {xs : List α}, ∀ {ys : List β}, ∀ {x : α}, ∀ {y : β}, (x, + y) ∈ xs.zip ys → x ∈ xs ) := by + classical + intro α β xs + induction xs with + | nil => intro ys x y h; simp at h + | cons a xs ih => + intro ys x y h + cases ys with + | nil => simp at h + | cons b ys => + simp only [List.zip_cons_cons, List.mem_cons] at h + simp only [List.mem_cons] + rcases h with h | h + · left; exact congrArg Prod.fst h + · right; exact ih h + +private theorem zip_pair_unique : + (by + classical + exact + (∀ {α : Type}, ∀ {β : Type}, ∀ {xs : List α}, ∀ {ys : List β}, ∀ {x : α}, ∀ {y : β}, (x, + y) ∈ xs.zip ys → x ∈ xs) → (∀ {α : Type}, ∀ {β : Type}, ∀ {xs : List α}, ∀ + {ys : List β}, (xs.Pairwise (fun x y => x ≠ y)) → (∀ {x : α}, ∀ {y : β}, ∀ {z : β}, + (x, y) ∈ xs.zip ys → (x, z) ∈ xs.zip ys → y = z)) ) := by + classical + intro zip_fst_mem α β xs + induction xs with + | nil => intro ys hp x y z hy hz; simp at hy + | cons a xs ih => + intro ys hp x y z hy hz + cases ys with + | nil => simp at hy + | cons b ys => + cases hp with + | cons hhead htail => + simp only [List.zip_cons_cons, List.mem_cons] at hy hz + rcases hy with hy | hy + · rcases hz with hz | hz + · have hY : y = b := congrArg Prod.snd hy + have hZ : z = b := congrArg Prod.snd hz + exact hY.trans hZ.symm + · have hx := zip_fst_mem hz + have hxeq : x = a := congrArg Prod.fst hy + exact False.elim ((hhead x hx) hxeq.symm) + · rcases hz with hz | hz + · have hx := zip_fst_mem hy + have hxeq : x = a := congrArg Prod.fst hz + exact False.elim ((hhead x hx) hxeq.symm) + · exact ih htail hy hz + +private theorem hreverseTilesNonempty : + (by + classical + exact + ∀ (Rplus : ProtoTile), ∀ (reverseTiles : List ProtoTile), (reverseTiles.head? = some + Rplus) → (reverseTiles ≠ []) ) := by + classical + intro Rplus reverseTiles hreverseHead h + rw [h] at hreverseHead + simp at hreverseHead + +private theorem hgsNonempty : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (hseed : PartialOdometer), ∀ + (centerShift : GaussianInt), + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + ∀ (couter : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + ∀ (eback : ℤ), + let bplus : Int := -eback + ∀ (hs : List PartialOdometer), + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + (gs.head? = some hplus) → (gs ≠ []) ) := by + classical + intro q i hseed centerShift d hminus couter eouter a b hplus eback bplus hs constAt transformAt + gs hgsHead h + rw [h] at hgsHead + simp at hgsHead + +private theorem forall2_length : + (by + classical + exact + ∀ {α : Type}, ∀ {β : Type}, ∀ {r : α → β → Prop}, ∀ {xs : List α}, ∀ {ys : List β}, + List.Forall₂ r xs ys → xs.length = ys.length ) := by + classical + intro α β r xs ys hxy + induction hxy with + | nil => rfl + | cons hxy htail ih => simp only [List.length_cons, ih] + +private theorem forall2_mem_right : + (by + classical + exact + ∀ {α : Type}, ∀ {β : Type}, ∀ {r : α → β → Prop}, ∀ {xs : List α}, ∀ {ys : List β}, + List.Forall₂ r xs ys → ∀ {y}, y ∈ ys → ∃ x, x ∈ xs ∧ r x y ) := by + classical + intro α β r xs ys hxy + induction hxy with + | nil => intro y hy; simp at hy + | @cons x y xs ys hxy htail ih => + intro z hz + simp only [List.mem_cons] at hz + rcases hz with rfl | hz + · exact ⟨x, by simp, hxy⟩ + · obtain ⟨x', hx', hrel⟩ := ih hz + exact ⟨x', by simp [hx'], hrel⟩ + +private theorem trimSublist : + (by + classical + exact + ∀ (xs : List ProtoTile), ((xs.drop 1).dropLast).Sublist xs ) := by + classical + intro xs + exact (List.dropLast_sublist (xs.drop 1)).trans (List.drop_sublist 1 xs) + +private theorem hreverseZipDropOne : + (by + classical + exact + ∀ (centerShift : GaussianInt), ∀ (reverseTiles : List ProtoTile), ∀ (couter : + GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + ∀ (eback : ℤ), + let bplus : Int := -eback + ∀ (hs : List PartialOdometer), + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + (reverseTiles.drop 1).zip (gs.drop 1) = (reverseTiles.zip gs).drop 1 ) := by + classical + intro centerShift reverseTiles couter eouter a b eback bplus hs constAt transformAt gs + rw [List.zip_eq_zipWith, List.zip_eq_zipWith, List.drop_zipWith] + +private theorem hreverseDropLength : + (by + classical + exact + (BandCircle) → ((BandCircle) → ((Fin 3) → ((ProtoTile) → ((List ProtoTile) → ((Fin (4 : + ℕ) → CircleCoordinates) → (∀ (centerShift : GaussianInt), ∀ (reverseTiles : List + ProtoTile), (GaussianInt) → (∀ (couter : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + ∀ (eback : ℤ), + let bplus : Int := -eback + ∀ (hs : List PartialOdometer), + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + (reverseTiles.length = gs.length) → ((reverseTiles.drop 1).length = (gs.drop + 1).length)))))))) ) := by + classical + intro C₀ Cᵢ i T₀' tiles q' centerShift reverseTiles touter couter eouter a b eback bplus hs + constAt transformAt gs hreverseFullLength + simp only [List.length_drop] at hreverseFullLength ⊢ + omega + +private theorem hreverseInteriorLength : + (by + classical + exact + (BandCircle) → ((BandCircle) → ((Fin 3) → ((ProtoTile) → ((List ProtoTile) → ((Fin (4 : + ℕ) → CircleCoordinates) → (∀ (centerShift : GaussianInt), ∀ (reverseTiles : List + ProtoTile), (GaussianInt) → (∀ (couter : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + ∀ (eback : ℤ), + let bplus : Int := -eback + ∀ (hs : List PartialOdometer), + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + ((reverseTiles.drop 1).length = (gs.drop 1).length) → (((reverseTiles.drop + 1).dropLast).length = ((gs.drop 1).dropLast).length)))))))) ) := by + classical + intro C₀ Cᵢ i T₀' tiles q' centerShift reverseTiles touter couter eouter a b eback bplus hs + constAt transformAt gs hreverseDropLength + simp only [List.length_dropLast] at hreverseDropLength ⊢ + omega + +private theorem hreverseZipInteriorEq : + (by + classical + exact + ∀ (centerShift : GaussianInt), ∀ (reverseTiles : List ProtoTile), ∀ (couter : + GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + ∀ (eback : ℤ), + let bplus : Int := -eback + ∀ (hs : List PartialOdometer), + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + (∀ {α : Type}, ∀ {β : Type}, ∀ (xs : List α), ∀ (ys : List β), xs.length = ys.length → + xs.dropLast.zip ys.dropLast = (xs.zip ys).dropLast) → (((reverseTiles.drop 1).zip + (gs.drop 1) = (reverseTiles.zip gs).drop 1) → (((reverseTiles.drop 1).length = + (gs.drop 1).length) → ((((reverseTiles.drop 1).dropLast).zip ((gs.drop 1).dropLast)) + = ((reverseTiles.zip gs).drop 1).dropLast))) ) := by + classical + intro centerShift reverseTiles couter eouter a b eback bplus hs constAt transformAt gs + zip_dropLast_eq hreverseZipDropOne hreverseDropLength + rw [← hreverseZipDropOne] + exact zip_dropLast_eq (reverseTiles.drop 1) (gs.drop 1) hreverseDropLength + +private theorem htilesPairwise : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (Cᵢ : BandCircle), ∀ (i : Fin 3), ∀ + (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), + let orientation := Classical.choose horientationExists + ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), (TileString Cᵢ orientation base Rminus Rplus tiles) → (tiles.Pairwise + (fun T U => T ≠ U)) ) := by + classical + intro q Cᵢ i horientationExists orientation base Rminus Rplus tiles hstring + rcases hstring with ⟨_, _, _, hpairwise, _, _, _⟩ + exact hpairwise + +private theorem hTgTrim : + (by + classical + exact + ∀ (centerShift : GaussianInt), ∀ (reverseTiles : List ProtoTile), ∀ (couter : + GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + ∀ (eback : ℤ), + let bplus : Int := -eback + ∀ (hs : List PartialOdometer), + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + ((((reverseTiles.drop 1).dropLast).zip ((gs.drop 1).dropLast)) = ((reverseTiles.zip + gs).drop 1).dropLast) → (∀ (T : ProtoTile), ∀ (g : PartialOdometer), ((T, g) ∈ + (List.drop (1 : ℕ) reverseTiles).dropLast.zip (List.drop (1 : ℕ) gs).dropLast) → ((T, + g) ∈ ((reverseTiles.zip gs).drop 1).dropLast)) ) := by + classical + intro centerShift reverseTiles couter eouter a b eback bplus hs constAt transformAt gs + hreverseZipInteriorEq T g hTgInterior + rw [← hreverseZipInteriorEq] + exact hTgInterior + +private theorem hUhTrim : + (by + classical + exact + ∀ (tiles : List ProtoTile), ∀ (hs : List PartialOdometer), ((((tiles.drop + 1).dropLast).zip ((hs.drop 1).dropLast)) = ((tiles.zip hs).drop 1).dropLast) → (∀ (U + : ProtoTile), ∀ (h : PartialOdometer), ((U, h) ∈ (List.drop (1 : ℕ) + tiles).dropLast.zip (List.drop (1 : ℕ) hs).dropLast) → ((U, h) ∈ ((tiles.zip hs).drop + 1).dropLast)) ) := by + classical + intro tiles hs hzipInteriorEq U h hUhInterior + rw [← hzipInteriorEq] + exact hUhInterior + +private theorem hTband : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (Cᵢ : BandCircle), ∀ (i : Fin 3), ∀ + (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), + let orientation := Classical.choose horientationExists + ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (centerShift : + GaussianInt), ∀ (reverseTiles : List ProtoTile), (TileString Cᵢ orientation base + Rplus Rminus reverseTiles) → (∀ (couter : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + ∀ (eback : ℤ), + let bplus : Int := -eback + ∀ (hs : List PartialOdometer), + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + let cellRelation : ProtoTile → ProtoTile → Prop := fun T U => + (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells + (∀ (xs : List ProtoTile), ((xs.drop 1).dropLast).Sublist xs) → (∀ (T : ProtoTile), (T ∈ + (List.drop (1 : ℕ) reverseTiles).dropLast) → (∀ (g : PartialOdometer), ((T, g) ∈ + (List.drop (1 : ℕ) reverseTiles).dropLast.zip (List.drop (1 : ℕ) gs).dropLast) → + (((T, g) ∈ ((reverseTiles.zip gs).drop 1).dropLast) → (∀ (U : ProtoTile), ∀ (h : + PartialOdometer), (cellRelation (U, h).1 (T, g).1 ∧ (T, g).2 = + PartialOdometerAffineTranslate (PartialOdometerHalfTurn (U, h).2) centerShift a b) → + (BandPrototile Cᵢ.1.1 T)))))) ) := by + classical + intro q Cᵢ i horientationExists orientation base Rminus Rplus centerShift reverseTiles hreverse + couter eouter a b eback bplus hs constAt transformAt gs cellRelation trimSublist T hT g + hTgInterior hTgTrim U h hpairedData + rcases hreverse with ⟨hbaseR, _, _, _, hmemR, _, _⟩ + have hTmem : T ∈ reverseTiles := (trimSublist reverseTiles).subset hT + rcases hmemR T hTmem with ⟨v, hv, rfl⟩ + exact BandPrototileTranslation Cᵢ.1.1 base v hbaseR + +private theorem hcentralTarget : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ + (centerShift : GaussianInt), ∀ (couter : GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + let houterAffine := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift a b + let cellRelation : ProtoTile → ProtoTile → Prop := fun T U => + (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells + ∀ (T : ProtoTile), ∀ (g : PartialOdometer), ∀ (U : ProtoTile), ∀ (h : PartialOdometer), + (cellRelation (U, h).1 (T, g).1 ∧ (T, g).2 = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn (U, h).2) centerShift a b) → ((AncestorOdometer Cᵢ.1.1 + C₀.1.1 (TileTranslation (TileHalfTurn U) centerShift) (TileTranslation (TileHalfTurn + T₀) centerShift) (PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) + centerShift a b) (PartialOdometerAffineTranslate (PartialOdometerHalfTurn h₀) + centerShift a b)) → (AncestorOdometer Cᵢ.1.1 C₀.1.1 (TileTranslation (TileHalfTurn U) + centerShift) (TileTranslation (TileHalfTurn T₀) centerShift) g houterAffine)) ) := by + classical + intro C₀ Cᵢ T₀ h₀ centerShift couter eouter a b houterAffine cellRelation T g U h hpairedData + hcentral + have hfunc : g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a b := by + simpa using hpairedData.2 + rw [hfunc] + simpa [houterAffine] using hcentral + +end OpposingBoundaryGeometry + +namespace OpposingBoundaryConclusion + +private theorem opposingBoundaryConclusion : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (ProperBandQuadruple q) → (∀ (C₀ : BandCircle), ∀ (Cᵢ + : BandCircle), ∀ (i : Fin 3), (q (0 : Fin (4 : ℕ)) = C₀.1.1) → ((q i.succ = Cᵢ.1.1) → + (∀ (T₀ : ProtoTile), ∀ (T₀' : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (h₀' : + PartialOdometer), ((0 : ℤ) < Cᵢ.1.1.1) → (∀ (p₀ : Real × Real), ∀ (horientationExists + : ∃ o : Bool, Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), + let orientation := Classical.choose horientationExists + ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), ∀ (hseed : PartialOdometer), (BoundaryString C₀ Cᵢ i orientation T₀ base + Rminus Rplus tiles) → ((Fin (4 : ℕ) → CircleCoordinates) → ((TileString Cᵢ + orientation base Rminus Rplus tiles) → (∀ (centerShift : GaussianInt), ∀ + (reverseTiles : List ProtoTile), (TileString Cᵢ orientation base Rplus Rminus + reverseTiles) → (((TileTranslation (TileHalfTurn Rminus) centerShift).cells = + Rplus.cells) → (((TileTranslation (TileHalfTurn Rplus) centerShift).cells = + Rminus.cells) → ((List.Forall₂ (fun (T U : ProtoTile) => (TileTranslation + (TileHalfTurn T) centerShift).cells = U.cells) tiles reverseTiles) → ( + let pminus := p₀ + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ)) + let pplus := p₀ + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)) + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + (TileOdometer Cᵢ.1.1 Rminus hminus) → ((PartialOdometerSlope hminus = some pminus) → ((0 + < C₀.1.1.1) → ( + let Tbar := TileTranslation (TileHalfTurn T₀) centerShift + (BandPrototile C₀.1.1 T₀') → ((Tbar.cells = T₀'.cells) → ((GaussianInt) → (∀ (couter : + GaussianInt), ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + let houterAffine := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift a b + (h₀' = houterAffine) → ( + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + (TileOdometer Cᵢ.1.1 Rplus hplus) → ((PartialOdometerSlope hplus = some pplus) → (∀ + (eback : ℤ), + let bplus : Int := -eback + let hminusBack := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a bplus + (hminus = hminusBack) → ((tiles.head? = some Rminus) → ((tiles.getLast? = some Rplus) → + ((2 ≤ tiles.length) → (∀ (hs : List PartialOdometer), (hs.head? = some hminus) → + ((hs.getLast? = some hplus) → ((OdometerStringRespect Cᵢ orientation base Rminus + Rplus tiles hs) → ((∀ T ∈ (List.drop (1 : ℕ) tiles).dropLast, ∃ (h : + PartialOdometer), (T, h) ∈ tiles.zip hs ∧ AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀ h h₀) → + ((hs.length = tiles.length) → ((2 ≤ hs.length) → ( + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + (∀ n, ∀ l, List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a c) l (l.mapIdx (fun j h => transformAt (n + + j) h))) → ((List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a c) hs gs) → (exists orientation : Bool, + exists centerShift : GaussianInt, exists base Rminus Rplus : ProtoTile, exists tiles + reverseTiles : List ProtoTile, exists hs reverseHs : List PartialOdometer, exists + hminus hplus : PartialOdometer, exists pminus pplus : Real × Real, exists a : + GaussianInt, exists b bminus bplus : Int, BoundaryString C₀ Cᵢ i orientation T₀ base + Rminus Rplus tiles /\ (TileTranslation (TileHalfTurn Rminus) centerShift).cells = + Rplus.cells /\ (TileTranslation (TileHalfTurn Rplus) centerShift).cells = + Rminus.cells /\ List.Forall₂ (fun T U => (TileTranslation (TileHalfTurn T) + centerShift).cells = U.cells) tiles reverseTiles /\ TileString Cᵢ orientation base + Rplus Rminus reverseTiles /\ OdometerStringRespect Cᵢ orientation base Rminus Rplus + tiles hs /\ OdometerStringRespect Cᵢ orientation base Rplus Rminus reverseTiles + reverseHs /\ hs.head? = some hminus /\ hs.getLast? = some hplus /\ reverseHs.head? = + some hplus /\ reverseHs.getLast? = some hminus /\ TileOdometer Cᵢ.1.1 Rminus hminus + /\ TileOdometer Cᵢ.1.1 Rplus hplus /\ PartialOdometerSlope hminus = some pminus /\ + PartialOdometerSlope hplus = some pplus /\ pminus - p₀ = (1 / 2 : Real) • + GaussianRealPoint (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ)) + /\ pplus - p₀ = (1 / 2 : Real) • GaussianRealPoint (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)) /\ h₀' = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift a b /\ hplus = + PartialOdometerAffineTranslate (PartialOdometerHalfTurn hminus) centerShift a bminus + /\ hminus = PartialOdometerAffineTranslate (PartialOdometerHalfTurn hplus) + centerShift a bplus /\ (forall T, T ∈ (tiles.drop 1).dropLast -> exists h, (T, h) ∈ + tiles.zip hs /\ AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀ h h₀) /\ forall T, T ∈ + (reverseTiles.drop 1).dropLast -> exists h, (T, h) ∈ reverseTiles.zip reverseHs /\ + AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀' h h₀')))))))))))))))))))))))))))))))) ) := by + classical + intro q hq C₀ Cᵢ i hC₀ hCᵢ T₀ T₀' h₀ h₀' hpositive p₀ horientationExists orientation base + Rminus Rplus tiles hseed hboundaryOriginal q' hstring centerShift reverseTiles hreverse + hminusCells hplusCells hcellPairs pminus pplus d hminus hOminus hsminus hC₀positive Tbar + hT₀'band houterCells touter couter eouter a b houterAffine houterAffineEq hplus hOplus + hsplus eback bplus hminusBack hminusBackEq htilesHead htilesLast htilesLength hs hhsHead + hhsLast hrespect hancestorForward hlengthEq hlengthHs constAt transformAt gs + transformForall htransform + have hgsHead := OpposingBoundaryGeometry.hgsHead q i hseed centerShift couter eouter eback hs + hhsHead + have hgsLast := OpposingBoundaryGeometry.hgsLast q C₀ Cᵢ i T₀' tiles hseed q' centerShift + touter couter eouter eback hminusBackEq htilesLength hs hhsLast hlengthEq + let cellRelation : ProtoTile → ProtoTile → Prop := fun T U => + (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells + have hinteriorCells := OpposingBoundaryGeometry.hinteriorCells q C₀ Cᵢ i T₀ h₀ + horientationExists base Rminus Rplus tiles hboundaryOriginal hstring centerShift + reverseTiles hreverse hcellPairs htilesHead htilesLast htilesLength hs hrespect + hancestorForward hlengthEq (OpposingBoundaryGeometry.forall2_dropLast) + have interiorTransforms := OpposingBoundaryGeometry.interiorTransforms C₀ Cᵢ i T₀' tiles q' + centerShift touter couter eouter eback hs + have hgsTail := OpposingBoundaryGeometry.hgsTail q C₀ Cᵢ i T₀ h₀ horientationExists base Rminus + Rplus tiles hseed centerShift couter eouter eback hs hhsHead hhsLast hrespect + hancestorForward hlengthEq hlengthHs transformForall htransform hgsHead hgsLast + interiorTransforms + have htailLength := OpposingBoundaryGeometry.htailLength q C₀ Cᵢ i T₀ T₀' h₀ horientationExists + base Rminus Rplus tiles hseed q' centerShift touter couter eouter eback hs hhsHead hhsLast + hrespect hancestorForward hlengthEq hlengthHs transformForall htransform hgsHead hgsLast + interiorTransforms hgsTail + have hinteriorTransforms := OpposingBoundaryGeometry.hinteriorTransforms C₀ Cᵢ i T₀' tiles q' + centerShift touter couter eouter eback hs interiorTransforms hgsTail htailLength + have hinteriorZip : List.Forall₂ + (fun X Y => cellRelation X.1 Y.1 ∧ + Y.2 = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn X.2) centerShift a b) + (((tiles.drop 1).dropLast).zip ((hs.drop 1).dropLast)) + (((reverseTiles.drop 1).dropLast).zip ((gs.drop 1).dropLast)) := + (OpposingBoundaryGeometry.zipForall₂) hinteriorCells hinteriorTransforms + have zip_dropLast_eq : + ∀ {α β : Type} (xs : List α) (ys : List β), + xs.length = ys.length → + xs.dropLast.zip ys.dropLast = (xs.zip ys).dropLast := + @OpposingBoundaryGeometry.zip_dropLast_eq C₀ Cᵢ i T₀' tiles q' touter hs + have hzipDropOne := OpposingBoundaryGeometry.hzipDropOne q C₀ Cᵢ i T₀ h₀ horientationExists + base Rminus Rplus tiles hseed hboundaryOriginal hstring centerShift reverseTiles hcellPairs + couter eouter eback htilesHead htilesLast htilesLength hs hhsHead hhsLast hrespect + hancestorForward hlengthEq hlengthHs transformForall htransform hgsHead hgsLast + hinteriorCells interiorTransforms hgsTail htailLength hinteriorTransforms hinteriorZip + have hzipInteriorEq := OpposingBoundaryGeometry.hzipInteriorEq tiles hs zip_dropLast_eq + hzipDropOne (OpposingBoundaryGeometry.htailOdoLength q C₀ Cᵢ i T₀ T₀' h₀ horientationExists + base Rminus Rplus tiles hseed hboundaryOriginal q' hstring centerShift reverseTiles + hcellPairs touter couter eouter eback htilesHead htilesLast htilesLength hs hhsHead hhsLast + hrespect hancestorForward hlengthEq hlengthHs transformForall htransform hgsHead hgsLast + hinteriorCells interiorTransforms hgsTail htailLength hinteriorTransforms hinteriorZip + hzipDropOne) + have zip_mem_left : + ∀ {α β : Type} (xs : List α) (ys : List β), + xs.length = ys.length → ∀ x, x ∈ xs → ∃ y, (x, y) ∈ xs.zip ys := + @OpposingBoundaryGeometry.zip_mem_left C₀ Cᵢ i T₀' tiles q' touter hs + have zip_fst_mem : + ∀ {α β : Type} {xs : List α} {ys : List β} + {x : α} {y : β}, (x, y) ∈ xs.zip ys → x ∈ xs := @OpposingBoundaryGeometry.zip_fst_mem + have zip_pair_unique : + ∀ {α β : Type} {xs : List α} {ys : List β} + (hp : xs.Pairwise (fun x y => x ≠ y)) {x : α} {y z : β}, + (x, y) ∈ xs.zip ys → (x, z) ∈ xs.zip ys → y = z := + @OpposingBoundaryGeometry.zip_pair_unique zip_fst_mem + have hreverseRespect := OdometerStringRespectRegularFamilyCentralCovariance + Cᵢ orientation base Rminus Rplus tiles reverseTiles hs gs centerShift a + hrespect hreverse hcellPairs htransform + have hreverseHead : reverseTiles.head? = some Rplus := hreverse.2.1 + have hreverseTilesNonempty := OpposingBoundaryGeometry.hreverseTilesNonempty Rplus reverseTiles + hreverseHead + have hgsNonempty := OpposingBoundaryGeometry.hgsNonempty q i hseed centerShift couter eouter + eback hs hgsHead + have forall2_mem_right : + ∀ {α β : Type} {r : α → β → Prop} + {xs : List α} {ys : List β}, List.Forall₂ r xs ys → + ∀ {y}, y ∈ ys → ∃ x, x ∈ xs ∧ r x y := @OpposingBoundaryGeometry.forall2_mem_right + have trimSublist := OpposingBoundaryGeometry.trimSublist + have hreverseFullLength := (OpposingBoundaryGeometry.forall2_length) hreverseRespect.2.1 + have hreverseDropLength := OpposingBoundaryGeometry.hreverseDropLength C₀ Cᵢ i T₀' tiles q' + centerShift reverseTiles touter couter eouter eback hs hreverseFullLength + have hreverseInteriorLength := OpposingBoundaryGeometry.hreverseInteriorLength C₀ Cᵢ i T₀' + tiles q' centerShift reverseTiles touter couter eouter eback hs hreverseDropLength + have hreverseZipInteriorEq := OpposingBoundaryGeometry.hreverseZipInteriorEq centerShift + reverseTiles couter eouter eback hs zip_dropLast_eq + (OpposingBoundaryGeometry.hreverseZipDropOne centerShift reverseTiles couter eouter eback + hs) hreverseDropLength + have hreverseZipTrim : ((reverseTiles.zip gs).drop 1).dropLast.Sublist + (reverseTiles.zip gs) := + (List.dropLast_sublist ((reverseTiles.zip gs).drop 1)).trans + (List.drop_sublist 1 (reverseTiles.zip gs)) + have hsourceZipTrim : ((tiles.zip hs).drop 1).dropLast.Sublist + (tiles.zip hs) := + (List.dropLast_sublist ((tiles.zip hs).drop 1)).trans + (List.drop_sublist 1 (tiles.zip hs)) + have htilesPairwise := OpposingBoundaryGeometry.htilesPairwise q Cᵢ i horientationExists base + Rminus Rplus tiles hstring + have hstrict : Cᵢ.1.1.1 < C₀.1.1.1 := by + simpa only [hCᵢ, hC₀] using hq.2 i + refine ⟨orientation, centerShift, base, Rminus, Rplus, tiles, reverseTiles, + hs, gs, hminus, hplus, pminus, pplus, a, b, (0 : Int), bplus, ?_⟩ + refine ⟨hboundaryOriginal, hminusCells, hplusCells, hcellPairs, hreverse, + hrespect, hreverseRespect, hhsHead, hhsLast, hgsHead, hgsLast, + hOminus, hOplus, hsminus, hsplus, ?_⟩ + refine ⟨(by dsimp [pminus]; abel), ?_⟩ + refine ⟨(by dsimp [pplus]; abel), ?_⟩ + refine ⟨(by simpa [houterAffine] using houterAffineEq), ?_⟩ + refine ⟨rfl, ?_⟩ + refine ⟨hminusBackEq, ?_⟩ + refine ⟨hancestorForward, ?_⟩ + intro T hT + obtain ⟨g, hTgInterior⟩ := zip_mem_left + ((reverseTiles.drop 1).dropLast) ((gs.drop 1).dropLast) + hreverseInteriorLength T hT + have hTgTrim := OpposingBoundaryGeometry.hTgTrim centerShift reverseTiles couter eouter eback + hs hreverseZipInteriorEq T g hTgInterior + rcases forall2_mem_right hinteriorZip hTgInterior with + ⟨⟨U, h⟩, hUhInterior, hpairedData⟩ + have hUinterior : U ∈ (tiles.drop 1).dropLast := + zip_fst_mem hUhInterior + rcases hancestorForward U hUinterior with ⟨h', hUhFull, hancestor⟩ + have hUhFull' : (U, h) ∈ tiles.zip hs := hsourceZipTrim.subset + (OpposingBoundaryGeometry.hUhTrim tiles hs hzipInteriorEq U h hUhInterior) + have hhh' : h = h' := zip_pair_unique htilesPairwise hUhFull' hUhFull + subst h' + have hcentral := AncestorOdometerCentralCovariance + Cᵢ.1.1 C₀.1.1 U T₀ h h₀ centerShift a b hancestor + have hinner := AncestorOdometerInnerSupportNormalization + Cᵢ.1.1 C₀.1.1 (TileTranslation (TileHalfTurn U) centerShift) + T (TileTranslation (TileHalfTurn T₀) centerShift) g houterAffine + hpositive hstrict (OpposingBoundaryGeometry.hcentralTarget C₀ Cᵢ T₀ h₀ centerShift couter + eouter T g U h hpairedData hcentral) (OpposingBoundaryGeometry.hTband q Cᵢ i + horientationExists base Rminus Rplus centerShift reverseTiles hreverse couter eouter + eback hs trimSublist T hT g hTgInterior hTgTrim U h hpairedData) hpairedData.1 + have houter := AncestorOdometerOuterSupportNormalization + Cᵢ.1.1 C₀.1.1 T (TileTranslation (TileHalfTurn T₀) centerShift) + T₀' g houterAffine hC₀positive hstrict hinner hT₀'band houterCells + refine ⟨g, hreverseZipTrim.subset hTgTrim, ?_⟩ + simpa [houterAffineEq] using houter + +end OpposingBoundaryConclusion + +theorem OpposingBoundaryOdometerStrings + (q : Fin 4 -> CircleCoordinates) (hq : ProperBandQuadruple q) + (C₀ Cᵢ : BandCircle) (i : Fin 3) + (hC₀ : q 0 = C₀.1.1) (hCᵢ : q i.succ = Cᵢ.1.1) + (T₀ T₀' : ProtoTile) (h₀ h₀' : PartialOdometer) + (hO₀ : TileOdometer C₀.1.1 T₀ h₀) + (hO₀' : TileOdometer C₀.1.1 T₀' h₀') + (hpositive : 0 < Cᵢ.1.1.1) + (p₀ p₀' : Real × Real) + (hs₀ : PartialOdometerSlope h₀ = some p₀) + (hs₀' : PartialOdometerSlope h₀' = some p₀') + (hcentroid : TileCentroid T₀' - TileCentroid T₀ = + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) + (hslope : p₀' - p₀ = + GaussianRealPoint (BandVectors.2 (q i.succ) (q 0))) : + exists orientation : Bool, exists centerShift : GaussianInt, + exists base Rminus Rplus : ProtoTile, + exists tiles reverseTiles : List ProtoTile, + exists hs reverseHs : List PartialOdometer, + exists hminus hplus : PartialOdometer, + exists pminus pplus : Real × Real, + exists a : GaussianInt, exists b bminus bplus : Int, + BoundaryString C₀ Cᵢ i orientation T₀ base Rminus Rplus tiles /\ + (TileTranslation (TileHalfTurn Rminus) centerShift).cells = + Rplus.cells /\ + (TileTranslation (TileHalfTurn Rplus) centerShift).cells = + Rminus.cells /\ + List.Forall₂ (fun T U => + (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells) + tiles reverseTiles /\ + TileString Cᵢ orientation base Rplus Rminus reverseTiles /\ + OdometerStringRespect Cᵢ orientation base Rminus Rplus tiles hs /\ + OdometerStringRespect Cᵢ orientation base Rplus Rminus + reverseTiles reverseHs /\ + hs.head? = some hminus /\ hs.getLast? = some hplus /\ + reverseHs.head? = some hplus /\ reverseHs.getLast? = some hminus /\ + TileOdometer Cᵢ.1.1 Rminus hminus /\ + TileOdometer Cᵢ.1.1 Rplus hplus /\ + PartialOdometerSlope hminus = some pminus /\ + PartialOdometerSlope hplus = some pplus /\ + pminus - p₀ = (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ)) /\ + pplus - p₀ = (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)) /\ + h₀' = PartialOdometerAffineTranslate (PartialOdometerHalfTurn h₀) + centerShift a b /\ + hplus = PartialOdometerAffineTranslate (PartialOdometerHalfTurn hminus) + centerShift a bminus /\ + hminus = PartialOdometerAffineTranslate (PartialOdometerHalfTurn hplus) + centerShift a bplus /\ + (forall T, T ∈ (tiles.drop 1).dropLast -> + exists h, (T, h) ∈ tiles.zip hs /\ + AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀ h h₀) /\ + forall T, T ∈ (reverseTiles.drop 1).dropLast -> + exists h, (T, h) ∈ reverseTiles.zip reverseHs /\ + AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀' h h₀' := by +-- BODY + classical + have horientationExists := OpposingBoundaryGeometry.horientationExists q hq Cᵢ i hCᵢ + let orientation := Classical.choose horientationExists + have hforward := ForwardBoundaryStringData q hq C₀ Cᵢ i hC₀ hCᵢ + orientation T₀ h₀ hO₀ hpositive (Classical.choose_spec horientationExists) + obtain ⟨base, Rminus, Rplus, tiles, hseed, pseed, pouter, + hbase, hRminus, hRplus, hseedO, hseedSlope, hpouter, + hseedSlopeData, hboundary⟩ := hforward + have hboundaryOriginal := hboundary + rcases hboundary with ⟨q', hq', hq0, hqi, hT₀band, hunitOrientation, + hstring, hcentroidMinus, hcentroidPlus⟩ + obtain ⟨centerShift, reverseTiles, hcenters, hreverse, hminusCells, + hplusCells, hcellPairs⟩ := + TileStringRegularFamilyCentralCovariance Cᵢ orientation base Rminus Rplus + tiles hstring + have tile_string_normalization := + @TileStringRegularFamilyCentralCovariance + have odometer_string_normalization := + @OdometerStringRespectRegularFamilyCentralCovariance + have ancestor_inner_normalization := + @AncestorOdometerInnerSupportNormalization + have hpouter_eq : pouter = p₀ := OpposingBoundaryGeometry.hpouter_eq h₀ p₀ hs₀ pouter hpouter + let pminus := p₀ + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ)) + let pplus := p₀ + (1 / 2 : Real) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)) + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) + let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + have htranslateZero := OpposingBoundaryGeometry.htranslateZero q C₀ Cᵢ i T₀ horientationExists + base Rminus Rplus tiles hseed hRminus hseedO hboundaryOriginal q' hstring hcentroidMinus + centerShift reverseTiles hcenters hreverse hminusCells hplusCells + have hOminus := OpposingBoundaryGeometry.hOminus q Cᵢ i Rminus hseed hseedO htranslateZero + have hminusSlopeCalc : pseed + GaussianRealPoint d = pminus := by + simpa [pminus, d, hpouter_eq] using hseedSlopeData + have hsminus := OpposingBoundaryGeometry.hsminus q i p₀ hseed pseed hseedSlope hminusSlopeCalc + have hC₀positive := OpposingBoundaryGeometry.hC₀positive q hq C₀ Cᵢ i hC₀ hCᵢ hpositive + have positive_cells := OpposingBoundaryGeometry.positive_cells C₀ Cᵢ + let hbar := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift 0 0 + let Tbar := TileTranslation (TileHalfTurn T₀) centerShift + have hbarO := OpposingBoundaryGeometry.hbarO C₀ T₀ h₀ hO₀ centerShift + have hbarBand : BandPrototile C₀.1.1 Tbar := + TileOdometerBandPrototile C₀.1.1 Tbar hbar hbarO + have hT₀'band : BandPrototile C₀.1.1 T₀' := + TileOdometerBandPrototile C₀.1.1 T₀' h₀' hO₀' + have hsumCentroid := OpposingBoundaryGeometry.hsumCentroid q C₀ Cᵢ i hC₀ hCᵢ T₀ Rminus Rplus q' + hq0 hqi hcentroidMinus hcentroidPlus + have houterCells := (BandPrototileCentroidUnique C₀.1.1 Tbar T₀' + hbarBand hT₀'band (OpposingBoundaryGeometry.hcentbar q i T₀ T₀' hcentroid Rminus Rplus + centerShift hcenters hsumCentroid)).1 + have hbarO' : TileOdometer C₀.1.1 T₀' hbar := + PositiveCurvatureTileOdometerSupportTransport C₀.1.1 Tbar T₀' hbar + hC₀positive hbarO hT₀'band houterCells + have houterUnique := TileOdometerTranslationUniqueness C₀.1.1 T₀' T₀' + hbar h₀' hC₀positive hbarO' hO₀' + obtain ⟨touter, htouter⟩ := houterUnique.exists + rcases htouter with ⟨hcellShift, hanchorShift, houterData⟩ + rcases houterData with ⟨couter, eouter, hdomainShift, hvalueShift⟩ + have hT₀'cells : T₀'.cells.Nonempty := + positive_cells C₀.1.1 T₀' hC₀positive hT₀'band + have htranslateInjective : Function.Injective (GaussianTranslation touter) := + OpposingBoundaryGeometry.htranslateInjective touter + have hsumReShift := congrArg (fun s : Finset GaussianInt => ∑ z ∈ s, z.re) hcellShift + rw [(TileTranslationFormulas T₀' touter).1, + Finset.sum_image htranslateInjective.injOn] at hsumReShift + simp only [GaussianTranslation, Zsqrtd.re_add] at hsumReShift + rw [Finset.sum_add_distrib, Finset.sum_const] at hsumReShift + simp only [nsmul_eq_mul] at hsumReShift + have hcardCastNe : (T₀'.cells.card : Int) ≠ 0 := by + exact_mod_cast hT₀'cells.card_pos.ne' + have hmulRe : (T₀'.cells.card : Int) * touter.re = 0 := by + linarith + have htRe : touter.re = 0 := (mul_eq_zero.mp hmulRe).resolve_left hcardCastNe + have hsumImShift := congrArg (fun s : Finset GaussianInt => ∑ z ∈ s, z.im) hcellShift + rw [(TileTranslationFormulas T₀' touter).1, + Finset.sum_image htranslateInjective.injOn] at hsumImShift + simp only [GaussianTranslation, Zsqrtd.im_add] at hsumImShift + rw [Finset.sum_add_distrib, Finset.sum_const] at hsumImShift + simp only [nsmul_eq_mul] at hsumImShift + have hmulIm : (T₀'.cells.card : Int) * touter.im = 0 := by + linarith + have htIm : touter.im = 0 := (mul_eq_zero.mp hmulIm).resolve_left hcardCastNe + have htouterZero : touter = 0 := by + apply Zsqrtd.ext <;> assumption + have hbarDomains := OpposingBoundaryGeometry.hbarDomains h₀ h₀' centerShift touter hdomainShift + htouterZero + let a : GaussianInt := -couter + let b : Int := -eouter + let houterAffine := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift a b + have hbarOuterDomain := OpposingBoundaryGeometry.hbarOuterDomain h₀ centerShift couter eouter + have houterAffineEq : h₀' = houterAffine := OpposingBoundaryGeometry.houterAffineEq C₀ T₀' h₀ + h₀' hO₀' p₀' hs₀' centerShift houterUnique touter couter eouter hdomainShift hvalueShift + htouterZero hbarDomains hbarOuterDomain (OpposingBoundaryGeometry.houterAffineDomain h₀ h₀' + centerShift couter eouter hbarDomains hbarOuterDomain) + have haSlope : p₀ + p₀' = GaussianRealPoint a := OpposingBoundaryGeometry.haSlope p₀ p₀' couter + (Option.some.inj ((OpposingBoundaryGeometry.houterSlope h₀ p₀ centerShift couter eouter + (OpposingBoundaryGeometry.hhalfSlope h₀ p₀ hs₀)).symm.trans (by + change PartialOdometerSlope houterAffine = some p₀' + rw [← houterAffineEq] + exact hs₀'))) + let hplus := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0 + have hplusRawO := OpposingBoundaryGeometry.hplusRawO q Cᵢ i Rminus hseed centerShift hOminus + couter + have hOplus : TileOdometer Cᵢ.1.1 Rplus hplus := + PositiveCurvatureTileOdometerSupportTransport Cᵢ.1.1 + (TileTranslation (TileHalfTurn Rminus) centerShift) Rplus hplus + hpositive hplusRawO (OpposingBoundaryGeometry.hRplusBand q C₀ Cᵢ i T₀ horientationExists + base Rminus Rplus tiles hbase hRplus hboundaryOriginal q' hstring hcentroidPlus + centerShift reverseTiles hcenters hreverse hminusCells hplusCells hsumCentroid) + hminusCells + have haRe : p₀.1 + p₀'.1 = (a.re : Real) := by + simpa only [Prod.fst_add, GaussianRealPoint] using congrArg Prod.fst haSlope + have haIm : p₀.2 + p₀'.2 = (a.im : Real) := by + simpa only [Prod.snd_add, GaussianRealPoint] using congrArg Prod.snd haSlope + have hplusSlopeCalc := OpposingBoundaryGeometry.hplusSlopeCalc q i p₀ p₀' couter + (OpposingBoundaryGeometry.hslopeDifferenceRe q i p₀ p₀' hslope) + (OpposingBoundaryGeometry.hslopeDifferenceIm q i p₀ p₀' hslope) haRe haIm + have hsplus := OpposingBoundaryGeometry.hsplus q i p₀ hseed centerShift hsminus couter + hplusSlopeCalc + have finiteTranslationFix := OpposingBoundaryGeometry.finiteTranslationFix + have hRminusBand := OpposingBoundaryGeometry.hRminusBand q C₀ Cᵢ i T₀ horientationExists base + Rminus Rplus tiles hseed hbase hRminus hseedO hboundaryOriginal q' hstring hcentroidMinus + centerShift reverseTiles hcenters hreverse hminusCells hplusCells htranslateZero hOminus + hsumCentroid couter hplusRawO + let hback := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a 0 + have hbackO : TileOdometer Cᵢ.1.1 Rminus hback := + PositiveCurvatureTileOdometerSupportTransport Cᵢ.1.1 + (TileTranslation (TileHalfTurn Rplus) centerShift) Rminus hback + hpositive (OpposingBoundaryGeometry.hbackRawO q Cᵢ i Rplus hseed centerShift couter hOplus) + hRminusBand hplusCells + have hbackUnique := TileOdometerTranslationUniqueness Cᵢ.1.1 Rminus Rminus + hback hminus hpositive hbackO hOminus + obtain ⟨tback, htback⟩ := hbackUnique.exists + rcases htback with ⟨hbackCells, hbackAnchor, hbackData⟩ + rcases hbackData with ⟨cback, eback, hbackDomains, hbackValues⟩ + have hRminusCells : Rminus.cells.Nonempty := + positive_cells Cᵢ.1.1 Rminus hpositive hRminusBand + have htbackZero := finiteTranslationFix Rminus tback hRminusCells hbackCells + have hbackSameDomain := OpposingBoundaryGeometry.hbackSameDomain q i hseed centerShift couter + tback hbackDomains htbackZero + let hminusAffine := PartialOdometerAffineTranslate hminus 0 cback eback + let bplus : Int := -eback + let hminusBack := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a bplus + have hbackBackDomain := OpposingBoundaryGeometry.hbackBackDomain q i hseed centerShift couter + eback + have hminusBackEq := OpposingBoundaryGeometry.hminusBackEq q i hseed centerShift couter tback + cback eback hbackValues htbackZero hbackSameDomain + (OpposingBoundaryGeometry.hbackLinearZero q i p₀ hseed centerShift hsminus couter cback + eback (OpposingBoundaryGeometry.hsback q i p₀ hseed centerShift couter + (OpposingBoundaryGeometry.haEndpoint q i p₀ couter hplusSlopeCalc) + (OpposingBoundaryGeometry.hhalfSlopePlus q i p₀ hseed centerShift couter hsplus)) + (OpposingBoundaryGeometry.hbackAffineEq q i hseed centerShift couter tback cback eback + hbackValues htbackZero hbackSameDomain (OpposingBoundaryGeometry.hbackAffineDomain q i + hseed centerShift couter cback eback hbackSameDomain))) hbackBackDomain + (OpposingBoundaryGeometry.hminusBackDomain q i hseed centerShift couter eback + hbackSameDomain hbackBackDomain) + have hindexNe : (0 : Fin 4) ≠ i.succ := by + fin_cases i <;> decide + have hvectorNe : BandVectors.1 (q' 0) (q' i.succ) ≠ 0 := + VectorNonvanishing q' hq'.1 0 i.succ hindexNe (Or.inr (OpposingBoundaryGeometry.hpositive' Cᵢ + i hpositive q' hqi)) + have htilesHead := OpposingBoundaryGeometry.htilesHead q Cᵢ i horientationExists base Rminus + Rplus tiles hstring + have htilesLast := OpposingBoundaryGeometry.htilesLast q Cᵢ i horientationExists base Rminus + Rplus tiles hstring + have htilesLength := OpposingBoundaryGeometry.htilesLength q C₀ Cᵢ i T₀ horientationExists base + Rminus Rplus tiles hboundaryOriginal hstring centerShift reverseTiles hcellPairs + (OpposingBoundaryGeometry.hRminusNeRplus i Rminus Rplus q' + (OpposingBoundaryGeometry.hcentroidEndpoints i T₀ Rminus Rplus q' hcentroidMinus + hcentroidPlus) hvectorNe (OpposingBoundaryGeometry.hgaussianPointZero)) htilesHead htilesLast + have hrespectResult := BoundaryStringOdometerRespect q hq C₀ Cᵢ i + hC₀ hCᵢ orientation T₀ base Rminus Rplus tiles h₀ hminus hplus + hO₀ hboundaryOriginal hOminus hOplus p₀ pminus pplus hs₀ hsminus hsplus + (by dsimp [pminus]; abel) (by dsimp [pplus]; abel) + rcases hrespectResult with ⟨_, _, _, hs, hhsHead, hhsLast, hrespect, hancestorForward⟩ + have hlengthEq : hs.length = tiles.length := hrespect.2.1.length_eq.symm + have hlengthHs : 2 ≤ hs.length := by omega + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) + let gs := hs.mapIdx transformAt + have transformForall := OpposingBoundaryGeometry.transformForall centerShift couter eouter + eback hs + exact (OpposingBoundaryConclusion.opposingBoundaryConclusion q hq C₀ Cᵢ i hC₀ hCᵢ T₀ T₀' h₀ h₀' + hpositive p₀ horientationExists base Rminus Rplus tiles hseed hboundaryOriginal q' hstring + centerShift reverseTiles hreverse hminusCells hplusCells hcellPairs hOminus hsminus + hC₀positive hT₀'band houterCells touter couter eouter houterAffineEq hOplus hsplus eback + hminusBackEq htilesHead htilesLast htilesLength hs hhsHead hhsLast hrespect + hancestorForward hlengthEq hlengthHs transformForall (OpposingBoundaryGeometry.htransform + centerShift couter eouter eback hs transformForall)) + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean new file mode 100644 index 0000000000..5329bc0bdb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean @@ -0,0 +1,955 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AffineTriangularNoFourfoldCellOwners +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification +public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryInterfaceExhaustion +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: OpposingBoundaryStarLocalization] + +/-! +# OpposingBoundaryStarLocalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OpposingStarGeometry + +private theorem hxT0 : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (h0 : PartialOdometer), ∀ (x : GaussianInt), (x ∈ h0.domain) → + (((↑h0.domain : Set GaussianInt) = FootprintVertices T0) → (x ∈ FootprintVertices + T0)) ) := by + classical + intro T0 h0 x hx0 hdomain0 + rw [← hdomain0] + exact hx0 + +private theorem hxT0' : + (by + classical + exact + ∀ (T0' : ProtoTile), ∀ (h0' : PartialOdometer), ∀ (x : GaussianInt), (x ∈ h0'.domain) → + (((↑h0'.domain : Set GaussianInt) = FootprintVertices T0') → (x ∈ FootprintVertices + T0')) ) := by + classical + intro T0' h0' x hx0' hdomain0' + rw [← hdomain0'] + exact hx0' + +private theorem hxPath : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (x : GaussianInt), ∀ (path : List + GaussianInt), (FootprintVertices T0 ∩ FootprintVertices T0' = (↑path.toFinset : Set + GaussianInt)) → ((x ∈ FootprintVertices T0) → ((x ∈ FootprintVertices T0') → (x ∈ + path))) ) := by + classical + intro T0 T0' x path hvertices hxT0 hxT0' + have hxinter : x ∈ FootprintVertices T0 ∩ FootprintVertices T0' := ⟨hxT0, hxT0'⟩ + rw [hvertices] at hxinter + simpa using hxinter + +private theorem cellCorner : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (c : GaussianInt), (c ∈ T.cells) → (∀ (z : GaussianInt), (z = c ∨ z + = c + 1 ∨ z = c + ⟨0, 1⟩ ∨ + z = c + 1 + ⟨0, 1⟩) → (z ∈ FootprintVertices T)) ) := by + classical + intro T c hc z hz + rw [FootprintVertices, ite_eq_left ⟨c, hc⟩] + exact ⟨c, hc, hz⟩ + +private theorem hxU : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (U : ProtoTile), ∀ (V : ProtoTile), (x ∈ U.cells ∧ x - (1 : + GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ V.cells ∨ x ∈ V.cells ∧ x - (1 : + GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ U.cells ∨ x - (1 : GaussianInt) ∈ + U.cells ∧ x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ V.cells ∨ x - (1 : GaussianInt) ∈ + V.cells ∧ x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ U.cells) → ((∀ (T : ProtoTile), ∀ + (c : GaussianInt), (c ∈ T.cells) → (∀ (z : GaussianInt), (z = c ∨ z = c + 1 ∨ z = c + + ⟨0, 1⟩ ∨ z = c + 1 + ⟨0, 1⟩) → (z ∈ FootprintVertices T))) → (x ∈ FootprintVertices + U)) ) := by + classical + intro x U V hownedCells cellCorner + rcases hownedCells with hA | hB | hC | hD + · exact cellCorner U x hA.1 x (Or.inl rfl) + · exact cellCorner U (x - 1 - ⟨0, 1⟩) hB.2 x + (Or.inr (Or.inr (Or.inr (by abel))) ) + · exact cellCorner U (x - 1) hC.1 x + (Or.inr (Or.inl (by abel))) + · exact cellCorner U (x - ⟨0, 1⟩) hD.2 x + (Or.inr (Or.inr (Or.inl (by abel)))) + +private theorem hxV : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (U : ProtoTile), ∀ (V : ProtoTile), (x ∈ U.cells ∧ x - (1 : + GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ V.cells ∨ x ∈ V.cells ∧ x - (1 : + GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ U.cells ∨ x - (1 : GaussianInt) ∈ + U.cells ∧ x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ V.cells ∨ x - (1 : GaussianInt) ∈ + V.cells ∧ x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ U.cells) → ((∀ (T : ProtoTile), ∀ + (c : GaussianInt), (c ∈ T.cells) → (∀ (z : GaussianInt), (z = c ∨ z = c + 1 ∨ z = c + + ⟨0, 1⟩ ∨ z = c + 1 + ⟨0, 1⟩) → (z ∈ FootprintVertices T))) → (x ∈ FootprintVertices + V)) ) := by + classical + intro x U V hownedCells cellCorner + rcases hownedCells with hA | hB | hC | hD + · exact cellCorner V (x - 1 - ⟨0, 1⟩) hA.2 x + (Or.inr (Or.inr (Or.inr (by abel)))) + · exact cellCorner V x hB.1 x (Or.inl rfl) + · exact cellCorner V (x - ⟨0, 1⟩) hC.2 x + (Or.inr (Or.inr (Or.inl (by abel)))) + · exact cellCorner V (x - 1) hD.1 x + (Or.inr (Or.inl (by abel))) + +private theorem vertexToG : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (g : PartialOdometer), ((↑g.domain : Set GaussianInt) = + FootprintVertices U) → (∀ z, z ∈ FootprintVertices U → z ∈ g.domain) ) := by + classical + intro U g hdomU z hz + have hs : z ∈ (g.domain : Set GaussianInt) := by rw [hdomU]; exact hz + simpa using hs + +private theorem vertexToK : + (by + classical + exact + ∀ (V : ProtoTile), ∀ (k : PartialOdometer), ((↑k.domain : Set GaussianInt) = + FootprintVertices V) → (∀ z, z ∈ FootprintVertices V → z ∈ k.domain) ) := by + classical + intro V k hdomV z hz + have hs : z ∈ (k.domain : Set GaussianInt) := by rw [hdomV]; exact hz + simpa using hs + +private theorem hcover : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (g : PartialOdometer), ∀ (k + : PartialOdometer), (x ∈ U.cells ∧ x - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∈ V.cells ∨ x ∈ V.cells ∧ x - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∈ U.cells ∨ x - (1 : GaussianInt) ∈ U.cells ∧ x - (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∈ V.cells ∨ x - (1 : GaussianInt) ∈ V.cells ∧ x - (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∈ U.cells) → ((∀ (T : ProtoTile), ∀ (c : GaussianInt), (c ∈ T.cells) → + (∀ (z : GaussianInt), (z = c ∨ z = c + 1 ∨ z = c + ⟨0, 1⟩ ∨ z = c + 1 + ⟨0, 1⟩) → (z + ∈ FootprintVertices T))) → ((x ∈ g.domain) → ((x ∈ k.domain) → ((∀ z, z ∈ + FootprintVertices U → z ∈ g.domain) → ((∀ z, z ∈ FootprintVertices V → z ∈ k.domain) + → (∀ z, z = x ∨ z = x + 1 ∨ z = x - 1 ∨ z = x + ⟨0, 1⟩ ∨ z = x - ⟨0, 1⟩ → z ∈ + g.domain ∨ z ∈ k.domain)))))) ) := by + classical + intro x U V g k hownedCells cellCorner hxg hxk vertexToG vertexToK z hz + rcases hownedCells with hA | hB | hC | hD + · rcases hz with hzx | hzp | hzm | hzi | hzmi + · rw [hzx]; exact Or.inl hxg + · rw [hzp]; apply Or.inl; apply vertexToG; apply cellCorner U x hA.1 + exact Or.inr (Or.inl rfl) + · rw [hzm]; apply Or.inr; apply vertexToK + apply cellCorner V (x - 1 - ⟨0, 1⟩) hA.2 + exact Or.inr (Or.inr (Or.inl (by abel))) + · rw [hzi]; apply Or.inl; apply vertexToG; apply cellCorner U x hA.1 + exact Or.inr (Or.inr (Or.inl rfl)) + · rw [hzmi]; apply Or.inr; apply vertexToK + apply cellCorner V (x - 1 - ⟨0, 1⟩) hA.2 + exact Or.inr (Or.inl (by abel)) + · rcases hz with hzx | hzp | hzm | hzi | hzmi + · rw [hzx]; exact Or.inr hxk + · rw [hzp]; apply Or.inr; apply vertexToK; apply cellCorner V x hB.1 + exact Or.inr (Or.inl rfl) + · rw [hzm]; apply Or.inl; apply vertexToG + apply cellCorner U (x - 1 - ⟨0, 1⟩) hB.2 + exact Or.inr (Or.inr (Or.inl (by abel))) + · rw [hzi]; apply Or.inr; apply vertexToK; apply cellCorner V x hB.1 + exact Or.inr (Or.inr (Or.inl rfl)) + · rw [hzmi]; apply Or.inl; apply vertexToG + apply cellCorner U (x - 1 - ⟨0, 1⟩) hB.2 + exact Or.inr (Or.inl (by abel)) + · rcases hz with hzx | hzp | hzm | hzi | hzmi + · rw [hzx]; apply Or.inl; apply vertexToG; apply cellCorner U (x - 1) hC.1 + exact Or.inr (Or.inl (by abel)) + · rw [hzp]; apply Or.inr; apply vertexToK; apply cellCorner V (x - ⟨0, 1⟩) hC.2 + exact Or.inr (Or.inr (Or.inr (by abel))) + · rw [hzm]; apply Or.inl; apply vertexToG; apply cellCorner U (x - 1) hC.1 + exact Or.inl (by abel) + · rw [hzi]; apply Or.inl; apply vertexToG; apply cellCorner U (x - 1) hC.1 + exact Or.inr (Or.inr (Or.inr (by abel))) + · rw [hzmi]; apply Or.inr; apply vertexToK; apply cellCorner V (x - ⟨0, 1⟩) hC.2 + exact Or.inl rfl + · rcases hz with hzx | hzp | hzm | hzi | hzmi + · rw [hzx]; apply Or.inr; apply vertexToK; apply cellCorner V (x - 1) hD.1 + exact Or.inr (Or.inl (by abel)) + · rw [hzp]; apply Or.inl; apply vertexToG; apply cellCorner U (x - ⟨0, 1⟩) hD.2 + exact Or.inr (Or.inr (Or.inr (by abel))) + · rw [hzm]; apply Or.inr; apply vertexToK; apply cellCorner V (x - 1) hD.1 + exact Or.inl rfl + · rw [hzi]; apply Or.inr; apply vertexToK; apply cellCorner V (x - 1) hD.1 + exact Or.inr (Or.inr (Or.inr (by abel))) + · rw [hzmi]; apply Or.inl; apply vertexToG; apply cellCorner U (x - ⟨0, 1⟩) hD.2 + exact Or.inl rfl + +private theorem hcurvature : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (C0 : + BandCircle), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (q (0 : Fin (4 : ℕ)) = C0.1.1) → ((q + i.succ = Ci.1.1) → (Ci.1.1.1 < C0.1.1.1))) ) := by + classical + intro q cfg C0 Ci i hC0 hCi + have hlt := cfg.proper.2 i + rw [hCi, hC0] at hlt + exact hlt + +private theorem hPU : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (base : ProtoTile), ∀ (U : ProtoTile), ∀ (u : GaussianInt), ∀ (huL + : u ∈ TilingLattice Ci), (U = TileTranslation base u) → ( + let uIdx : TilingLattice Ci := ⟨u, huL⟩ + ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (u : ↥(TilingLattice Ci)), P.tile u = + TileTranslation base (↑u : GaussianInt)) → (P.tile uIdx = U)) ) := by + classical + intro Ci base U u huL hUeq uIdx P hPtile + rw [hPtile] + simpa [uIdx] using hUeq.symm + +private theorem hPV : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (base : ProtoTile), ∀ (V : ProtoTile), ∀ (v : GaussianInt), ∀ (hvL + : v ∈ TilingLattice Ci), (V = TileTranslation base v) → ( + let vIdx : TilingLattice Ci := ⟨v, hvL⟩ + ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (u : ↥(TilingLattice Ci)), P.tile u = + TileTranslation base (↑u : GaussianInt)) → (P.tile vIdx = V)) ) := by + classical + intro Ci base V v hvL hVeq vIdx P hPtile + rw [hPtile] + simpa [vIdx] using hVeq.symm + +private theorem hidxNe : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (U : ProtoTile), ∀ (V : ProtoTile), (U ≠ V) → (∀ (u : + GaussianInt), ∀ (huL : u ∈ TilingLattice Ci), ∀ (v : GaussianInt), ∀ (hvL : v ∈ + TilingLattice Ci), + let uIdx : TilingLattice Ci := ⟨u, huL⟩ + let vIdx : TilingLattice Ci := ⟨v, hvL⟩ + ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (P.tile uIdx = U) → ((P.tile vIdx = V) → + (uIdx ≠ vIdx))) ) := by + classical + intro Ci U V hUV u huL v hvL uIdx vIdx P hPU hPV heq + apply hUV + calc + U = P.tile uIdx := hPU.symm + _ = P.tile vIdx := congrArg P.tile heq + _ = V := hPV + +private theorem hedgeP : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), ({x, y} ∈ FootprintEdges U ∩ FootprintEdges V) → (∀ (u : GaussianInt), ∀ + (huL : u ∈ TilingLattice Ci), ∀ (v : GaussianInt), ∀ (hvL : v ∈ TilingLattice Ci), + let uIdx : TilingLattice Ci := ⟨u, huL⟩ + let vIdx : TilingLattice Ci := ⟨v, hvL⟩ + ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (P.tile uIdx = U) → ((P.tile vIdx = V) → + ((FootprintEdges (P.tile uIdx) ∩ FootprintEdges (P.tile vIdx)).Nonempty))) ) := by + classical + intro Ci x y U V hedge u huL v hvL uIdx vIdx P hPU hPV + refine ⟨{x, y}, ?_⟩ + rw [hPU, hPV] + exact hedge + +private theorem slope_defined : + (by + classical + exact + (BandCircle) → (∀ (Ci : BandCircle), (GaussianInt) → ((GaussianInt) → ((List GaussianInt) + → ((PeriodicTileComplex ↥(TilingLattice Ci)) → (∀ (c : CircleCoordinates), ∀ (T : + ProtoTile), ∀ (f : PartialOdometer), TileOdometer c T f → 1 < c.1 → ∃ p : ℝ × ℝ, + PartialOdometerSlope f = some p))))) ) := by + classical + intro C0 Ci a b rest P c T f ho hc + induction ho with + | line w z hw hdom => omega + | unit z w T f hT hdom htrans => omega + | @decompose qd hqd S T hs f hT hsub hcells hfoot hcentroid hdom + hvalue hcompat hslope ih => + have facts := ProperBandCurvatureStructure qd hqd + have hp : ∃ i : Fin 3, 0 < (qd i.succ).1 := by + by_cases h0 : 0 < (qd (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (qd (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + by_cases h2 : 0 < (qd (2 : Fin 3).succ).1 + · exact ⟨2, h2⟩ + have n0 := facts.2.1 (0 : Fin 3) + have n1 := facts.2.1 (1 : Fin 3) + have z0 : (qd (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (qd (1 : Fin 3).succ).1 = 0 := by omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim + rcases hp with ⟨i, hi⟩ + rcases hslope i false with hz | ⟨p, pi, hp, hpi, hpr, hpi'⟩ + · omega + · exact ⟨p, hp⟩ + +private theorem invStep : + (by + classical + exact + (BandCircle) → (∀ (Ci : BandCircle), ((1 : ℤ) < Ci.1.1.1) → ((GaussianInt) → + ((GaussianInt) → ((List GaussianInt) → ((PeriodicTileComplex ↥(TilingLattice Ci)) → ( + let slopeVec := fun f : PartialOdometer => + let p := (PartialOdometerSlope f).getD (0, 0) + ![p.1, p.2] + let centroidVec := fun T : ProtoTile => + ![(TileCentroid T).1, (TileCentroid T).2] + let invariant := fun X : ProtoTile × PartialOdometer => + slopeVec X.2 - Matrix.mulVec (CircleMatrix Ci) (centroidVec X.1) + let invRel := fun X Y : ProtoTile × PartialOdometer => invariant X = invariant Y + ∀ A B : ProtoTile × PartialOdometer, LeftLatticeAdjacent Ci A.1 B.1 A.2 B.2 → invRel A + B)))))) ) := by + classical + intro C0 Ci hlarge a b rest P slopeVec centroidVec invariant invRel A B hadj + rcases hadj with ⟨_, _, p, p', hp, hp', hcase⟩ + rcases hcase with hunit | ⟨q, j, e, hq, hq0, hcent, hpRe, hpIm⟩ + · omega + have hin := CircleMatrixIncomingVector Ci q hq.1 hq0 j + let s : ℝ := if e = true then 1 else -1 + have hc0 : (TileCentroid B.1).1 - (TileCentroid A.1).1 = + s * ((BandVectors.1 (q j.succ) (q 0)).re : ℝ) := by + have hh := congrArg Prod.fst hcent + change (TileCentroid B.1).1 - (TileCentroid A.1).1 = + (if e = true then (1 : ℝ) else -1) * + ((BandVectors.1 (q j.succ) (q 0)).re : ℝ) at hh + simpa [s] using hh + have hc1 : (TileCentroid B.1).2 - (TileCentroid A.1).2 = + s * ((BandVectors.1 (q j.succ) (q 0)).im : ℝ) := by + have hh := congrArg Prod.snd hcent + change (TileCentroid B.1).2 - (TileCentroid A.1).2 = + (if e = true then (1 : ℝ) else -1) * + ((BandVectors.1 (q j.succ) (q 0)).im : ℝ) at hh + simpa [s] using hh + have hcentVec : centroidVec B.1 - centroidVec A.1 = + s • ![((BandVectors.1 (q j.succ) (q 0)).re : ℝ), + ((BandVectors.1 (q j.succ) (q 0)).im : ℝ)] := by + ext n + fin_cases n + · simpa [centroidVec, s, smul_eq_mul] using hc0 + · simpa [centroidVec, s, smul_eq_mul] using hc1 + have hslopeVec : slopeVec B.2 - slopeVec A.2 = + s • ![((BandVectors.2 (q j.succ) (q 0)).re : ℝ), + ((BandVectors.2 (q j.succ) (q 0)).im : ℝ)] := by + ext n + fin_cases n <;> simp [slopeVec, hp, hp', hpRe, hpIm, s] + have hinVec : Matrix.mulVec (CircleMatrix Ci) + ![((BandVectors.1 (q j.succ) (q 0)).re : ℝ), + ((BandVectors.1 (q j.succ) (q 0)).im : ℝ)] = + ![((BandVectors.2 (q j.succ) (q 0)).re : ℝ), + ((BandVectors.2 (q j.succ) (q 0)).im : ℝ)] := by + simpa [Matrix.mulVec] using hin + have hmain : Matrix.mulVec (CircleMatrix Ci) + (centroidVec B.1 - centroidVec A.1) = + slopeVec B.2 - slopeVec A.2 := by + rw [hcentVec, Matrix.mulVec_smul, hinVec, hslopeVec] + change invariant A = invariant B + dsimp [invariant] + ext n + fin_cases n + · have heq := congrFun hmain 0 + simp [slopeVec, centroidVec, hp, hp', Matrix.mulVec, + dotProduct, Fin.sum_univ_two] at heq ⊢ + linear_combination heq + · have heq := congrFun hmain 1 + simp [slopeVec, centroidVec, hp, hp', Matrix.mulVec, + dotProduct, Fin.sum_univ_two] at heq ⊢ + linear_combination heq + +private theorem hlenPre : + (by + classical + exact + (BandCircle) → (∀ (Ci : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ + (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (hs : List + PartialOdometer), ∀ (hplus : PartialOdometer), (OdometerStringRespect Ci orientation + base Rminus Rplus tiles hs) → ((GaussianInt) → ((GaussianInt) → ((List GaussianInt) → + ((PeriodicTileComplex ↥(TilingLattice Ci)) → (∀ (preTiles : List ProtoTile), (tiles = + preTiles ++ [Rplus]) → (∀ (preHs : List PartialOdometer), (hs = preHs ++ [hplus]) → + (preTiles.length = preHs.length)))))))) ) := by + classical + intro C0 Ci orientation base Rminus Rplus tiles hs hplus hRespect a b rest P preTiles hpreTiles + preHs hpreHs + have hlen := (List.Forall₂.length_eq hRespect.2.1) + rw [hpreTiles, hpreHs, List.length_append, List.length_singleton, + List.length_append, List.length_singleton] at hlen + omega + +private theorem hzipLast : + (by + classical + exact + ∀ (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (hs : List PartialOdometer), ∀ + (hplus : PartialOdometer), ∀ (preTiles : List ProtoTile), (tiles = preTiles ++ + [Rplus]) → (∀ (preHs : List PartialOdometer), (hs = preHs ++ [hplus]) → + ((preTiles.length = preHs.length) → (tiles.zip hs = preTiles.zip preHs ++ [(Rplus, + hplus)]))) ) := by + classical + intro Rplus tiles hs hplus preTiles hpreTiles preHs hpreHs hlenPre + rw [hpreTiles, hpreHs, List.zip_append hlenPre] + simp + +private theorem hUzip' : + (by + classical + exact + ∀ (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (hs : List PartialOdometer), ∀ + (hplus : PartialOdometer), ∀ (U : ProtoTile), ∀ (g : PartialOdometer), ((U, g) ∈ + tiles.zip hs) → (∀ (preTiles : List ProtoTile), ∀ (preHs : List PartialOdometer), + (tiles.zip hs = preTiles.zip preHs ++ [(Rplus, hplus)]) → ((U, g) ∈ preTiles.zip + preHs ++ [(Rplus, hplus)])) ) := by + classical + intro Rplus tiles hs hplus U g hUzip preTiles preHs hzipLast + rw [← hzipLast] + exact hUzip + +private theorem hzipHead : + (by + classical + exact + ∀ (Rplus : ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ (reverseHs : List + PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (postTiles : List ProtoTile), + (reverseTiles = Rplus :: postTiles) → (∀ (postHs : List PartialOdometer), (reverseHs + = hplus :: postHs) → (reverseTiles.zip reverseHs = (Rplus, hplus) :: postTiles.zip + postHs)) ) := by + classical + intro Rplus reverseTiles reverseHs hplus postTiles hpostTiles postHs hpostHs + rw [hpostTiles, hpostHs] + rfl + +private theorem hVzip' : + (by + classical + exact + ∀ (Rplus : ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ (reverseHs : List + PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (V : ProtoTile), ∀ (k : + PartialOdometer), ((V, k) ∈ reverseTiles.zip reverseHs) → (∀ (postTiles : List + ProtoTile), ∀ (postHs : List PartialOdometer), (reverseTiles.zip reverseHs = (Rplus, + hplus) :: postTiles.zip postHs) → ((V, k) ∈ (Rplus, hplus) :: postTiles.zip postHs)) + ) := by + classical + intro Rplus reverseTiles reverseHs hplus V k hVzip postTiles postHs hzipHead + rw [← hzipHead] + exact hVzip + +private theorem hInvU : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (Rplus : ProtoTile), ∀ (hplus : PartialOdometer), ∀ (U : + ProtoTile), ∀ (g : PartialOdometer), + let slopeVec := fun f : PartialOdometer => + let p := (PartialOdometerSlope f).getD (0, 0) + ![p.1, p.2] + let centroidVec := fun T : ProtoTile => + ![(TileCentroid T).1, (TileCentroid T).2] + let invariant := fun X : ProtoTile × PartialOdometer => + slopeVec X.2 - Matrix.mulVec (CircleMatrix Ci) (centroidVec X.1) + let invRel := fun X Y : ProtoTile × PartialOdometer => invariant X = invariant Y + ∀ (preTiles : List ProtoTile), ∀ (preHs : List PartialOdometer), (List.Pairwise invRel + (preTiles.zip preHs ++ [(Rplus, hplus)])) → (((U, g) ∈ preTiles.zip preHs ++ [(Rplus, + hplus)]) → (invariant (Rplus, hplus) = invariant (U, g))) ) := by + classical + intro Ci Rplus hplus U g slopeVec centroidVec invariant invRel preTiles preHs hfirstPairwise + hUzip' + have h := hfirstPairwise.rel_getLast hUzip' + simpa using h.symm + +private theorem hInvV : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (Rplus : ProtoTile), ∀ (hplus : PartialOdometer), ∀ (V : + ProtoTile), ∀ (k : PartialOdometer), + let slopeVec := fun f : PartialOdometer => + let p := (PartialOdometerSlope f).getD (0, 0) + ![p.1, p.2] + let centroidVec := fun T : ProtoTile => + ![(TileCentroid T).1, (TileCentroid T).2] + let invariant := fun X : ProtoTile × PartialOdometer => + slopeVec X.2 - Matrix.mulVec (CircleMatrix Ci) (centroidVec X.1) + let invRel := fun X Y : ProtoTile × PartialOdometer => invariant X = invariant Y + ∀ (postTiles : List ProtoTile), ∀ (postHs : List PartialOdometer), (List.Pairwise invRel + ((Rplus, hplus) :: postTiles.zip postHs)) → (((V, k) ∈ (Rplus, hplus) :: + postTiles.zip postHs) → (invariant (Rplus, hplus) = invariant (V, k))) ) := by + classical + intro Ci Rplus hplus V k slopeVec centroidVec invariant invRel postTiles postHs + hreversePairwise hVzip' + have h := hreversePairwise.rel_head hVzip' + simpa using h + +private theorem hcentU : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (U : ProtoTile), ∀ (u : GaussianInt), (U = TileTranslation base + u) → (TileCentroid U = ((TileCentroid base).1 + (u.re : ℝ), (TileCentroid base).2 + + (u.im : ℝ))) ) := by + classical + intro base U u hUeq + rw [hUeq, (TileTranslationFormulas base u).2.2.2.2.1] + +private theorem hcentV : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (V : ProtoTile), ∀ (v : GaussianInt), (V = TileTranslation base + v) → (TileCentroid V = ((TileCentroid base).1 + (v.re : ℝ), (TileCentroid base).2 + + (v.im : ℝ))) ) := by + classical + intro base V v hVeq + rw [hVeq, (TileTranslationFormulas base v).2.2.2.2.1] + +private theorem hcentUV : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), (TileCentroid U = ((TileCentroid base).1 + (u.re : ℝ), (TileCentroid + base).2 + (u.im : ℝ))) → ((TileCentroid V = ((TileCentroid base).1 + (v.re : ℝ), + (TileCentroid base).2 + (v.im : ℝ))) → (TileCentroid V - TileCentroid U = + GaussianRealPoint (v - u))) ) := by + classical + intro base U V u v hcentU hcentV + rw [hcentV, hcentU] + ext <;> simp [GaussianRealPoint] + +private theorem hdispSigned : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (u : GaussianInt), ∀ (huL + : u ∈ TilingLattice Ci), ∀ (v : GaussianInt), ∀ (hvL : v ∈ TilingLattice Ci), + let uIdx : TilingLattice Ci := ⟨u, huL⟩ + let vIdx : TilingLattice Ci := ⟨v, hvL⟩ + ∀ (j : Fin (3 : ℕ)), ((↑vIdx : GaussianInt) - (↑uIdx : GaussianInt) = BandVectors.1 (r + j.succ) (r (0 : Fin (4 : ℕ))) ∨ (↑vIdx : GaussianInt) - (↑uIdx : GaussianInt) = + -BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ)))) → (∃ e : Bool, v - u = (if e = true + then BandVectors.1 (r j.succ) (r 0) else -BandVectors.1 (r j.succ) (r 0))) ) := by + classical + intro Ci r u huL v hvL uIdx vIdx j hdisp + rcases hdisp with hpos | hneg + · exact ⟨true, by simpa [uIdx, vIdx] using hpos⟩ + · exact ⟨false, by simpa [uIdx, vIdx] using hneg⟩ + +private theorem hcentSigned : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (u : + GaussianInt), ∀ (v : GaussianInt), ∀ (j : Fin (3 : ℕ)), (TileCentroid V - + TileCentroid U = GaussianRealPoint (v - u)) → (∀ (e : Bool), (v - u = if e = true + then BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) else -BandVectors.1 (r j.succ) (r + (0 : Fin (4 : ℕ)))) → (TileCentroid V - TileCentroid U = (if e = true then (1 : ℝ) + else -1) • GaussianRealPoint (BandVectors.1 (r j.succ) (r 0)))) ) := by + classical + intro U V r u v j hcentUV e hdisp' + rw [hcentUV, hdisp'] + cases e <;> simp [GaussianRealPoint] + +private theorem hIncoming : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), + ((CircleMatrix Ci).mulVec ![(↑(BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ)))).re : + ℝ), (↑(BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ)))).im : ℝ)] = ![(↑(BandVectors.2 + (r j.succ) (r (0 : Fin (4 : ℕ)))).re : ℝ), (↑(BandVectors.2 (r j.succ) (r (0 : Fin (4 + : ℕ)))).im : ℝ)]) → (Matrix.mulVec (CircleMatrix Ci) ![((BandVectors.1 (r j.succ) (r + 0)).re : ℝ), ((BandVectors.1 (r j.succ) (r 0)).im : ℝ)] = ![((BandVectors.2 (r + j.succ) (r 0)).re : ℝ), ((BandVectors.2 (r j.succ) (r 0)).im : ℝ)]) ) := by + classical + intro Ci r j hInRegular + simpa [Matrix.mulVec] using hInRegular + +private theorem hInvExpanded : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (g : PartialOdometer), ∀ (k + : PartialOdometer), ∀ (pU : ℝ × ℝ), (PartialOdometerSlope g = some pU) → (∀ (pV : ℝ × + ℝ), (PartialOdometerSlope k = some pV) → ( + let slopeVec := fun f : PartialOdometer => + let p := (PartialOdometerSlope f).getD (0, 0) + ![p.1, p.2] + let centroidVec := fun T : ProtoTile => + ![(TileCentroid T).1, (TileCentroid T).2] + let invariant := fun X : ProtoTile × PartialOdometer => + slopeVec X.2 - Matrix.mulVec (CircleMatrix Ci) (centroidVec X.1) + (invariant (U, g) = invariant (V, k)) → (slopeVec g - Matrix.mulVec (CircleMatrix Ci) + ![(TileCentroid U).1, (TileCentroid U).2] = slopeVec k - Matrix.mulVec (CircleMatrix + Ci) ![(TileCentroid V).1, (TileCentroid V).2]))) ) := by + classical + intro Ci U V g k pU hpU pV hpV slopeVec centroidVec invariant hInvUV + simpa [invariant, slopeVec, centroidVec, hpU, hpV] using hInvUV + +private theorem hmainUV : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (g : PartialOdometer), ∀ (k + : PartialOdometer), + let slopeVec := fun f : PartialOdometer => + let p := (PartialOdometerSlope f).getD (0, 0) + ![p.1, p.2] + (slopeVec g - Matrix.mulVec (CircleMatrix Ci) ![(TileCentroid U).1, (TileCentroid U).2] = + slopeVec k - Matrix.mulVec (CircleMatrix Ci) ![(TileCentroid V).1, (TileCentroid + V).2]) → (Matrix.mulVec (CircleMatrix Ci) (![(TileCentroid V).1, (TileCentroid V).2] + - ![(TileCentroid U).1, (TileCentroid U).2]) = slopeVec k - slopeVec g) ) := by + classical + intro Ci U V g k slopeVec hInvExpanded + ext n + fin_cases n + · have heq := congrFun hInvExpanded 0 + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] at heq ⊢ + linear_combination heq + · have heq := congrFun hInvExpanded 1 + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] at heq ⊢ + linear_combination heq + +private theorem hcentVector : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin + (3 : ℕ)), ∀ (e : Bool), (TileCentroid V - TileCentroid U = (if e = true then (1 : ℝ) + else -1) • GaussianRealPoint (BandVectors.1 (r j.succ) (r 0))) → (![(TileCentroid + V).1, (TileCentroid V).2] - ![(TileCentroid U).1, (TileCentroid U).2] = (if e = true + then (1 : ℝ) else -1) • ![((BandVectors.1 (r j.succ) (r 0)).re : ℝ), ((BandVectors.1 + (r j.succ) (r 0)).im : ℝ)]) ) := by + classical + intro U V r j e hcentSigned + have hh0 := congrArg Prod.fst hcentSigned + have hh1 := congrArg Prod.snd hcentSigned + change (TileCentroid V).1 - (TileCentroid U).1 = + (if e = true then (1 : ℝ) else -1) * + ((BandVectors.1 (r j.succ) (r 0)).re : ℝ) at hh0 + change (TileCentroid V).2 - (TileCentroid U).2 = + (if e = true then (1 : ℝ) else -1) * + ((BandVectors.1 (r j.succ) (r 0)).im : ℝ) at hh1 + ext n + fin_cases n + · simpa [Pi.smul_apply, smul_eq_mul] using hh0 + · simpa [Pi.smul_apply, smul_eq_mul] using hh1 + +private theorem hslopeVector : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (g : PartialOdometer), ∀ (k + : PartialOdometer), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), + let slopeVec := fun f : PartialOdometer => + let p := (PartialOdometerSlope f).getD (0, 0) + ![p.1, p.2] + ∀ (e : Bool), (Matrix.mulVec (CircleMatrix Ci) ![((BandVectors.1 (r j.succ) (r 0)).re : + ℝ), ((BandVectors.1 (r j.succ) (r 0)).im : ℝ)] = ![((BandVectors.2 (r j.succ) (r + 0)).re : ℝ), ((BandVectors.2 (r j.succ) (r 0)).im : ℝ)]) → ((Matrix.mulVec + (CircleMatrix Ci) (![(TileCentroid V).1, (TileCentroid V).2] - ![(TileCentroid U).1, + (TileCentroid U).2]) = slopeVec k - slopeVec g) → ((![(TileCentroid V).1, + (TileCentroid V).2] - ![(TileCentroid U).1, (TileCentroid U).2] = (if e = true then + (1 : ℝ) else -1) • ![((BandVectors.1 (r j.succ) (r 0)).re : ℝ), ((BandVectors.1 (r + j.succ) (r 0)).im : ℝ)]) → (slopeVec k - slopeVec g = (if e = true then (1 : ℝ) else + -1) • ![((BandVectors.2 (r j.succ) (r 0)).re : ℝ), ((BandVectors.2 (r j.succ) (r + 0)).im : ℝ)]))) ) := by + classical + intro Ci U V g k r j slopeVec e hIncoming hmainUV hcentVector + calc + slopeVec k - slopeVec g = Matrix.mulVec (CircleMatrix Ci) + (![(TileCentroid V).1, (TileCentroid V).2] - + ![(TileCentroid U).1, (TileCentroid U).2]) := hmainUV.symm + _ = Matrix.mulVec (CircleMatrix Ci) ((if e = true then (1 : ℝ) else -1) • + ![((BandVectors.1 (r j.succ) (r 0)).re : ℝ), + ((BandVectors.1 (r j.succ) (r 0)).im : ℝ)]) := by rw [hcentVector] + _ = (if e = true then (1 : ℝ) else -1) • + Matrix.mulVec (CircleMatrix Ci) + ![((BandVectors.1 (r j.succ) (r 0)).re : ℝ), + ((BandVectors.1 (r j.succ) (r 0)).im : ℝ)] := by + rw [Matrix.mulVec_smul] + _ = (if e = true then (1 : ℝ) else -1) • + ![((BandVectors.2 (r j.succ) (r 0)).re : ℝ), + ((BandVectors.2 (r j.succ) (r 0)).im : ℝ)] := by rw [hIncoming] + +private theorem hLeft : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (g : PartialOdometer), ∀ (k + : PartialOdometer), (TileOdometer Ci.1.1 U g) → ((TileOdometer Ci.1.1 V k) → (∀ (r : + Fin (4 : ℕ) → CircleCoordinates), (r (0 : Fin (4 : ℕ)) = Ci.1.1) → + ((ProperBandQuadruple r) → (∀ (j : Fin (3 : ℕ)), ∀ (pU : ℝ × ℝ), + (PartialOdometerSlope g = some pU) → (∀ (pV : ℝ × ℝ), (PartialOdometerSlope k = some + pV) → ( + let slopeVec := fun f : PartialOdometer => + let p := (PartialOdometerSlope f).getD (0, 0) + ![p.1, p.2] + ∀ (e : Bool), (TileCentroid V - TileCentroid U = (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.1 (r j.succ) (r 0))) → ((slopeVec k - slopeVec g = (if + e = true then (1 : ℝ) else -1) • ![((BandVectors.2 (r j.succ) (r 0)).re : ℝ), + ((BandVectors.2 (r j.succ) (r 0)).im : ℝ)]) → (LeftLatticeAdjacent Ci U V g k)))))))) + ) := by + classical + intro Ci U V g k hUchildOdo hVchildOdo r hr0 hrproper j pU hpU pV hpV slopeVec e hcentSigned + hslopeVector + refine ⟨hUchildOdo, hVchildOdo, pU, pV, hpU, hpV, + Or.inr ⟨r, j, e, hrproper, hr0, hcentSigned, ?_, ?_⟩⟩ + · have hh := congrFun hslopeVector 0 + simpa [slopeVec, hpU, hpV] using hh + · have hh := congrFun hslopeVector 1 + simpa [slopeVec, hpU, hpV] using hh + +end OpposingStarGeometry + +theorem OpposingBoundaryStarLocalization + (q : Fin 4 -> CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C0 Ci : BandCircle) (i : Fin 3) + (hC0 : q 0 = C0.1.1) (hCi : q i.succ = Ci.1.1) + (T0 T0' : ProtoTile) (h0 h0' : PartialOdometer) + (cert : BandOrderedGeneralLayoutCertificate q cfg C0 T0) + (hsym : QuarterTurnSymmetric T0) + (hO0 : TileOdometer C0.1.1 T0 h0) + (hO0' : TileOdometer C0.1.1 T0' h0') + (hlarge : 1 < Ci.1.1.1) + (p0 p0' : Real × Real) + (hs0 : PartialOdometerSlope h0 = some p0) + (hs0' : PartialOdometerSlope h0' = some p0') + (hcentroid : TileCentroid T0' - TileCentroid T0 = + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) + (hslope : p0' - p0 = + GaussianRealPoint (BandVectors.2 (q i.succ) (q 0))) + (x : GaussianInt) (hx0 : x ∈ h0.domain) (hx0' : x ∈ h0'.domain) + (hstar : forall y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ -> + y ∈ h0.domain ∨ y ∈ h0'.domain) : + exists orientation : Bool, exists base Rminus Rplus : ProtoTile, + exists tiles reverseTiles : List ProtoTile, + exists hs reverseHs : List PartialOdometer, + exists hminus hplus : PartialOdometer, + exists path : List GaussianInt, + exists U V : ProtoTile, exists g k : PartialOdometer, + BoundaryString C0 Ci i orientation T0 base Rminus Rplus tiles /\ + TileString Ci orientation base Rplus Rminus reverseTiles /\ + OdometerStringRespect Ci orientation base Rminus Rplus tiles hs /\ + OdometerStringRespect Ci orientation base Rplus Rminus + reverseTiles reverseHs /\ + hs.head? = some hminus /\ hs.getLast? = some hplus /\ + reverseHs.head? = some hplus /\ reverseHs.getLast? = some hminus /\ + path.Nodup /\ 2 <= path.length /\ + FootprintVertices T0 ∩ FootprintVertices T0' = + (path.toFinset : Set GaussianInt) /\ + (forall e, e ∈ FootprintEdges T0 ∩ FootprintEdges T0' <-> + exists z w : GaussianInt, exists l1 l2 : List GaussianInt, + path = l1 ++ z :: w :: l2 /\ e = {z, w}) /\ + x ∈ path /\ + U ∈ (tiles.drop 1).dropLast /\ (U, g) ∈ tiles.zip hs /\ + V ∈ (reverseTiles.drop 1).dropLast /\ + (V, k) ∈ reverseTiles.zip reverseHs /\ + TileOdometer Ci.1.1 U g /\ TileOdometer Ci.1.1 V k /\ + AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0 /\ + AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0' /\ + LeftLatticeAdjacent Ci U V g k /\ + x ∈ g.domain /\ x ∈ k.domain /\ + (forall y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ -> + y ∈ g.domain ∨ y ∈ k.domain) /\ + Ci.1.1.1 < C0.1.1.1 := by +-- BODY + classical + have hex := OpposingBoundaryInterfaceExhaustion q cfg C0 Ci i hC0 hCi + T0 T0' h0 h0' cert hsym hO0 hO0' hlarge p0 p0' hs0 hs0' + hcentroid hslope + rcases hex with ⟨orientation, base, Rminus, Rplus, tiles, reverseTiles, + hs, reverseHs, hminus, hplus, pminus, pplus, path, hRest⟩ + rcases hRest with ⟨hBoundary, hRest⟩ + rcases hRest with ⟨hTileString, hRest⟩ + rcases hRest with ⟨hRespect, hRest⟩ + rcases hRest with ⟨hReverseRespect, hRest⟩ + rcases hRest with ⟨hhead, hRest⟩ + rcases hRest with ⟨hlast, hRest⟩ + rcases hRest with ⟨hreverseHead, hRest⟩ + rcases hRest with ⟨hreverseLast, hRest⟩ + rcases hRest with ⟨hOminus, hRest⟩ + rcases hRest with ⟨hOplus, hRest⟩ + rcases hRest with ⟨hsminus, hRest⟩ + rcases hRest with ⟨hsplus, hRest⟩ + rcases hRest with ⟨hminusSlope, hRest⟩ + rcases hRest with ⟨hplusSlope, hRest⟩ + rcases hRest with ⟨hTripleMinus, hRest⟩ + rcases hRest with ⟨hTriplePlus, hRest⟩ + rcases hRest with ⟨hpathNodup, hRest⟩ + rcases hRest with ⟨hpathLength, hRest⟩ + rcases hRest with ⟨hpathEnds, hRest⟩ + rcases hRest with ⟨hpathEndPlus, hRest⟩ + rcases hRest with ⟨hvertices, hRest⟩ + rcases hRest with ⟨hedges, hRest⟩ + rcases hRest with ⟨hboundaryOwners, hRest⟩ + have hcommonEdges := hRest + have hdomain0 := PositiveCurvatureTileOdometerDomain C0.1.1 T0 h0 C0.2 hO0 + have hdomain0' := PositiveCurvatureTileOdometerDomain C0.1.1 T0' h0' C0.2 hO0' + have hxPath := OpposingStarGeometry.hxPath T0 T0' x path hvertices (OpposingStarGeometry.hxT0 + T0 h0 x hx0 hdomain0) (OpposingStarGeometry.hxT0' T0' h0' x hx0' hdomain0') + cases path with + | nil => simp at hpathLength + | cons a tail => + cases tail with + | nil => simp at hpathLength + | cons b rest => + obtain ⟨_, _, hstarClause⟩ := hcommonEdges a b [] rest rfl + obtain ⟨y, U, V, g, k, hconsecutive, hUV, hedge, hUint, hUzip, + hUancestor, hVint, hVzip, hVancestor, hownedCells⟩ := + hstarClause x hxPath hstar + dsimp [AncestorOdometer] at hUancestor hVancestor + have hUancestorKeep := hUancestor + have hVancestorKeep := hVancestor + rcases hUancestorKeep with ⟨hUodo, hUtile, hUdomEq, hUsubset, hUvalue⟩ + rcases hVancestorKeep with ⟨hVodo, hVtile, hVdomEq, hVsubset, hVvalue⟩ + have hUchildOdo : TileOdometer Ci.1.1 U g := + (List.forall₂_iff_zip.mp hRespect.2.1).2 hUzip + have hVchildOdo : TileOdometer Ci.1.1 V k := + (List.forall₂_iff_zip.mp hReverseRespect.2.1).2 hVzip + have hdomU := PositiveCurvatureTileOdometerDomain Ci.1.1 U g Ci.2 hUchildOdo + have hdomV := PositiveCurvatureTileOdometerDomain Ci.1.1 V k Ci.2 hVchildOdo + have cellCorner := OpposingStarGeometry.cellCorner + have hxU : x ∈ FootprintVertices U := OpposingStarGeometry.hxU x U V hownedCells cellCorner + have hxV : x ∈ FootprintVertices V := OpposingStarGeometry.hxV x U V hownedCells cellCorner + have hxgSet : x ∈ (g.domain : Set GaussianInt) := by rw [hdomU]; exact hxU + have hxkSet : x ∈ (k.domain : Set GaussianInt) := by rw [hdomV]; exact hxV + have hxg : x ∈ g.domain := by simpa using hxgSet + have hxk : x ∈ k.domain := by simpa using hxkSet + have hcover := OpposingStarGeometry.hcover x U V g k hownedCells cellCorner hxg hxk + (OpposingStarGeometry.vertexToG U g hdomU) (OpposingStarGeometry.vertexToK V k hdomV) + have hcurvature := OpposingStarGeometry.hcurvature q cfg C0 Ci i hC0 hCi + have hgenealogy := BandGenealogy Ci + obtain hunit | ⟨r, hrsemi, hr0, hrless, _⟩ := hgenealogy + · omega + have hrproper : ProperBandQuadruple r := + ⟨hrsemi, by simpa [hr0] using hrless⟩ + have hUfamily : U ∈ RegularTileFamily base (TilingLattice Ci) := + hRespect.1.2.2.2.2.1 U (List.mem_of_mem_drop (List.mem_of_mem_dropLast hUint)) + have hVfamily : V ∈ RegularTileFamily base (TilingLattice Ci) := + hTileString.2.2.2.2.1 V (List.mem_of_mem_drop (List.mem_of_mem_dropLast hVint)) + obtain ⟨u, huL, hUeq⟩ := hUfamily + obtain ⟨v, hvL, hVeq⟩ := hVfamily + let uIdx : TilingLattice Ci := ⟨u, huL⟩ + let vIdx : TilingLattice Ci := ⟨v, hvL⟩ + obtain ⟨P, hPlattice, hPtile, hPadj, hPposition, _, _, _, _⟩ := + BandRegularTranslatePeriodicComplex Ci r hrproper hr0 base + (by simpa [hr0] using hRespect.1.1) + have hPU := OpposingStarGeometry.hPU Ci base U u huL hUeq P hPtile + have hPV := OpposingStarGeometry.hPV Ci base V v hvL hVeq P hPtile + have hadjP := (PeriodicTileIntersectionClassification P).1 uIdx vIdx + (OpposingStarGeometry.hidxNe Ci U V hUV u huL v hvL P hPU hPV) + have hadjIndex : P.plane.adjacent uIdx vIdx := hadjP.1.mp (OpposingStarGeometry.hedgeP Ci x + y U V hedge u huL v hvL P hPU hPV) + obtain ⟨j, hdisp⟩ := (hPadj uIdx vIdx).mp hadjIndex + have slope_defined := OpposingStarGeometry.slope_defined C0 Ci a b rest P + obtain ⟨pU, hpU⟩ := slope_defined Ci.1.1 U g hUchildOdo (by omega) + obtain ⟨pV, hpV⟩ := slope_defined Ci.1.1 V k hVchildOdo (by omega) + let slopeVec := fun f : PartialOdometer => + let p := (PartialOdometerSlope f).getD (0, 0) + ![p.1, p.2] + let centroidVec := fun T : ProtoTile => + ![(TileCentroid T).1, (TileCentroid T).2] + let invariant := fun X : ProtoTile × PartialOdometer => + slopeVec X.2 - Matrix.mulVec (CircleMatrix Ci) (centroidVec X.1) + let invRel := fun X Y : ProtoTile × PartialOdometer => invariant X = invariant Y + have invStep := OpposingStarGeometry.invStep C0 Ci hlarge a b rest P + have hfirstInvChain : List.IsChain invRel (tiles.zip hs) := + hRespect.2.2.imp (fun A B hadj => invStep A B hadj) + have hreverseInvChain : List.IsChain invRel (reverseTiles.zip reverseHs) := + hReverseRespect.2.2.imp (fun A B hadj => invStep A B hadj) + let : Trans invRel invRel invRel := ⟨by + intro a b c hab hbc + exact hab.trans hbc⟩ + have hfirstPairwise : (tiles.zip hs).Pairwise invRel := + (List.isChain_iff_pairwise).mp hfirstInvChain + have hreversePairwise : (reverseTiles.zip reverseHs).Pairwise invRel := + (List.isChain_iff_pairwise).mp hreverseInvChain + obtain ⟨preTiles, hpreTiles⟩ := + List.getLast?_eq_some_iff.mp hRespect.1.2.2.1 + obtain ⟨preHs, hpreHs⟩ := List.getLast?_eq_some_iff.mp hlast + have hzipLast : tiles.zip hs = preTiles.zip preHs ++ [(Rplus, hplus)] := + OpposingStarGeometry.hzipLast Rplus tiles hs hplus preTiles hpreTiles preHs hpreHs + (OpposingStarGeometry.hlenPre C0 Ci orientation base Rminus Rplus tiles hs hplus + hRespect a b rest P preTiles hpreTiles preHs hpreHs) + have hUzip' := OpposingStarGeometry.hUzip' Rplus tiles hs hplus U g hUzip preTiles preHs + hzipLast + obtain ⟨postTiles, hpostTiles⟩ := + List.head?_eq_some_iff.mp hTileString.2.1 + obtain ⟨postHs, hpostHs⟩ := List.head?_eq_some_iff.mp hreverseHead + have hzipHead : reverseTiles.zip reverseHs = + (Rplus, hplus) :: postTiles.zip postHs := OpposingStarGeometry.hzipHead Rplus + reverseTiles reverseHs hplus postTiles hpostTiles postHs hpostHs + rw [hzipLast] at hfirstPairwise + rw [hzipHead] at hreversePairwise + have hInvUV : invariant (U, g) = invariant (V, k) := (OpposingStarGeometry.hInvU Ci Rplus + hplus U g preTiles preHs hfirstPairwise hUzip').symm.trans (OpposingStarGeometry.hInvV + Ci Rplus hplus V k postTiles postHs hreversePairwise (OpposingStarGeometry.hVzip' Rplus + reverseTiles reverseHs hplus V k hVzip postTiles postHs hzipHead)) + have hcentUV := OpposingStarGeometry.hcentUV base U V u v (OpposingStarGeometry.hcentU base + U u hUeq) (OpposingStarGeometry.hcentV base V v hVeq) + have hdispSigned := OpposingStarGeometry.hdispSigned Ci r u huL v hvL j hdisp + obtain ⟨e, hdisp'⟩ := hdispSigned + have hcentSigned := OpposingStarGeometry.hcentSigned U V r u v j hcentUV e hdisp' + have hInRegular := CircleMatrixIncomingVector Ci r hrsemi hr0 j + refine ⟨orientation, base, Rminus, Rplus, tiles, reverseTiles, hs, + reverseHs, hminus, hplus, a :: b :: rest, U, V, g, k, ?_⟩ + refine ⟨hBoundary, hTileString, hRespect, hReverseRespect, hhead, + hlast, hreverseHead, hreverseLast, hpathNodup, hpathLength, + hvertices, hedges, hxPath, hUint, hUzip, hVint, hVzip, + hUchildOdo, hVchildOdo, hUancestor, hVancestor, (OpposingStarGeometry.hLeft Ci U V g k + hUchildOdo hVchildOdo r hr0 hrproper j pU hpU pV hpV e hcentSigned + (OpposingStarGeometry.hslopeVector Ci U V g k r j e (OpposingStarGeometry.hIncoming + Ci r j hInRegular) (OpposingStarGeometry.hmainUV Ci U V g k + (OpposingStarGeometry.hInvExpanded Ci U V g k pU hpU pV hpV hInvUV)) + (OpposingStarGeometry.hcentVector U V r j e hcentSigned))), hxg, hxk, + hcover, hcurvature⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean new file mode 100644 index 0000000000..946d244f77 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean @@ -0,0 +1,1544 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AffineOpposingStripCorridor +public import LeanPool.ApollonianSuperharmonic.AffineTriangularComplexChart +public import LeanPool.ApollonianSuperharmonic.AffineTriangularCorridorStep +public import LeanPool.ApollonianSuperharmonic.AffineTriangularFaceCoordinateSwap +public import LeanPool.ApollonianSuperharmonic.AffineTriangularFaceVertices +public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.SwappedAffineTriangularChartAlignment +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileString +public import LeanPool.ApollonianSuperharmonic.TileStringCoordinateTransport +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TriangularStripSegment +public import LeanPool.ApollonianSuperharmonic.UnitSquareOpposingStripInterfacePath +public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep + +-- [TABLET NODE: OpposingStringInterfacePath] + +/-! +# OpposingStringInterfacePath + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OpposingInterfaceGeometry + +private theorem hRmem : + (by + classical + exact + ∀ (R : ProtoTile), ∀ (forward : List ProtoTile), (forward.head? = some R) → (R ∈ forward) + ) := by + classical + intro R forward hfhead + have hopt : R ∈ forward.head? := by simp [hfhead] + rw [List.eq_cons_of_mem_head? hopt] + simp + +private theorem hSmem : + (by + classical + exact + ∀ (S : ProtoTile), ∀ (forward : List ProtoTile), (forward.getLast? = some S) → (S ∈ + forward) ) := by + classical + intro S forward hflast + have hopt : S ∈ forward.getLast? := by simp [hflast] + obtain ⟨hne, hget⟩ := List.mem_getLast?_eq_getLast hopt + rw [hget] + exact List.getLast_mem hne + +private theorem hrs : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (R : ProtoTile), ∀ (S : ProtoTile), (R ≠ S) → (∀ (a : + GaussianInt), ∀ (b : GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + ∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), (R = tileAt r) → ((S = tileAt s) → (r ≠ s))) ) := by + classical + intro base R S hRS a b tileAt r s hR hS hrs + apply hRS + rw [hR, hS, hrs] + +private theorem hnadjCoord : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (R : ProtoTile), ∀ (S + : ProtoTile), (¬if C.1.1.1 = (1 : ℤ) then ∃ (v : GaussianInt), UnitTriangularStep + orientation v ∧ TileCentroid S - TileCentroid R = GaussianRealPoint v else + TileTouching R S) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), (∀ (x : ℤ × ℤ), ∀ (y : + ℤ × ℤ), (fun (T U : ProtoTile) => if C.1.1.1 = (1 : ℤ) then ∃ (v : GaussianInt), + UnitTriangularStep orientation v ∧ TileCentroid U - TileCentroid T = + GaussianRealPoint v else TileTouching T U) ((fun (z : ℤ × ℤ) => TileTranslation base + ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) x) ((fun (z : ℤ × ℤ) => + TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) y) ↔ + TriangularLatticeAdjacent x y) → ( + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + ∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), (R = tileAt r) → ((S = tileAt s) → (¬ + TriangularLatticeAdjacent r s)))) ) := by + classical + intro C orientation base R S hnadj a b hadj tileAt r s hR hS hadjrs + apply hnadj + rw [hR, hS] + exact (hadj r s).2 hadjrs + +private theorem forall₂_dropLast : + (by + classical + exact + ∀ {α : Type}, ∀ {β : Type}, ∀ {Rel : α → β → Prop}, ∀ {xs : List α}, ∀ {ys : List β}, + (List.Forall₂ Rel xs ys) → (List.Forall₂ Rel xs.dropLast ys.dropLast) ) := by + classical + intro α β Rel xs ys hall + induction hall with + | nil => simp + | @cons x y xs ys hxy htail ih => + cases xs with + | nil => + have hy : ys = [] := (List.forall₂_nil_left_iff).mp htail + subst ys + simp + | cons x' xs' => + cases ys with + | nil => simp at htail + | cons y' ys' => + rw [List.dropLast_cons_cons, List.dropLast_cons_cons] + exact List.Forall₂.cons hxy ih + +private theorem forall₂_mem : + (by + classical + exact + ∀ {α : Type}, ∀ {β : Type}, ∀ {Rel : α → β → Prop}, ∀ {xs : List α}, ∀ {ys : List β}, + (List.Forall₂ Rel xs ys) → (∀ z ∈ ys, ∃ x ∈ xs, Rel x z) ) := by + classical + intro α β Rel xs ys hall + induction hall with + | nil => intro z hz; simp at hz + | @cons x z xs ys hxy htail ih => + intro w hw + simp only [List.mem_cons] at hw + rcases hw with rfl | hw + · exact ⟨x, by simp, hxy⟩ + · obtain ⟨x', hx', hx'z⟩ := ih w hw + exact ⟨x', by simp [hx'], hx'z⟩ + +private theorem forwardInterior : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (forward : List ProtoTile), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + ∀ (F : List (ℤ × ℤ)), (List.Forall₂ (fun (T : ProtoTile) (z : ℤ × ℤ) => T = (fun (z : ℤ × + ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) z) + (List.drop (1 : ℕ) forward).dropLast (List.drop (1 : ℕ) F).dropLast) → ((∀ + {α : Type}, ∀ {β : Type}, ∀ {Rel : α → β → Prop}, ∀ {xs : List α}, ∀ {ys : List β}, + (List.Forall₂ Rel xs ys) → (∀ z ∈ ys, ∃ x ∈ xs, Rel x z)) → (∀ (z : Int × Int), (z ∈ + (F.drop 1).dropLast) → (∃ T ∈ (forward.drop 1).dropLast, T = tileAt z))) ) := by + classical + intro base forward a b tileAt F forall₂_interior forall₂_mem z hz + exact forall₂_mem forall₂_interior z hz + +private theorem reverseInterior : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (reverse : List ProtoTile), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + ∀ (G : List (ℤ × ℤ)), (List.Forall₂ (fun (T : ProtoTile) (z : ℤ × ℤ) => T = (fun (z : ℤ × + ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) z) + (List.drop (1 : ℕ) reverse).dropLast (List.drop (1 : ℕ) G).dropLast) → ((∀ + {α : Type}, ∀ {β : Type}, ∀ {Rel : α → β → Prop}, ∀ {xs : List α}, ∀ {ys : List β}, + (List.Forall₂ Rel xs ys) → (∀ z ∈ ys, ∃ x ∈ xs, Rel x z)) → (∀ (z : Int × Int), (z ∈ + (G.drop 1).dropLast) → (∃ T ∈ (reverse.drop 1).dropLast, T = tileAt z))) ) := by + classical + intro base reverse a b tileAt G rfor₂_interior forall₂_mem z hz + exact forall₂_mem rfor₂_interior z hz + +private theorem hshift : + (by + classical + exact + ∀ (z : Int × Int), (z.1 : GaussianInt) * 1 + (z.2 : GaussianInt) * ⟨0, 1⟩ = (⟨z.1, z.2⟩ : + GaussianInt) ) := by + classical + intro z + ext <;> simp + +private theorem hshift' : + (by + classical + exact + ∀ (z : Int × Int), (z.1 : GaussianInt) + ⟨0, z.2⟩ = (⟨z.1, z.2⟩ : GaussianInt) ) := by + classical + intro z + ext <;> simp + +private theorem hcellsEq : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (x : GaussianInt), (base.cells = {x}) → ( + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * 1 + (z.2 : GaussianInt) * (⟨0, 1⟩ : + GaussianInt)) + let unitAt : Int × Int → ProtoTile := fun z => + TileTranslation (⟨{x}, x⟩ : ProtoTile) + (⟨z.1, z.2⟩ : GaussianInt) + (∀ (z : Int × Int), (z.1 : GaussianInt) + ⟨0, z.2⟩ = (⟨z.1, z.2⟩ : GaussianInt)) → (∀ (z + : Int × Int), (tileAt z).cells = (unitAt z).cells)) ) := by + classical + intro base x hcells tileAt unitAt hshift' z + simp [tileAt, unitAt, TileTranslation, GaussianTranslation, hcells, hshift'] + +private theorem hvertsEqAt258 : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (x : GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * 1 + (z.2 : GaussianInt) * (⟨0, 1⟩ : + GaussianInt)) + let unitAt : Int × Int → ProtoTile := fun z => + TileTranslation (⟨{x}, x⟩ : ProtoTile) + (⟨z.1, z.2⟩ : GaussianInt) + (∀ (z : Int × Int), (tileAt z).cells = (unitAt z).cells) → (∀ (z : Int × Int), + FootprintVertices (tileAt z) = FootprintVertices (unitAt z)) ) := by + classical + intro base x tileAt unitAt hcellsEq z + have hunitne : (unitAt z).cells.Nonempty := by + simp [unitAt, TileTranslation] + have htilene : (tileAt z).cells.Nonempty := by + rw [hcellsEq] + exact hunitne + simp [FootprintVertices, hunitne, hcellsEq] + +private theorem hedgesEqAt266 : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (x : GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * 1 + (z.2 : GaussianInt) * (⟨0, 1⟩ : + GaussianInt)) + let unitAt : Int × Int → ProtoTile := fun z => + TileTranslation (⟨{x}, x⟩ : ProtoTile) + (⟨z.1, z.2⟩ : GaussianInt) + (∀ (z : Int × Int), (tileAt z).cells = (unitAt z).cells) → (∀ (z : Int × Int), + FootprintEdges (tileAt z) = FootprintEdges (unitAt z)) ) := by + classical + intro base x tileAt unitAt hcellsEq z + rw [FootprintEdges, FootprintEdges, hcellsEq] + +private theorem hcellCalc : + (by + classical + exact + (BandCircle) → (∀ (base : ProtoTile), ∀ (x : GaussianInt), (base.cells = {x}) → ( + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * (⟨0, 1⟩ : GaussianInt) + (z.2 : + GaussianInt) * (-1)) + let x0 : GaussianInt := ⟨x.im, -x.re - 1⟩ + let unitAt : Int × Int → ProtoTile := fun z => + TileTranslation (⟨{x0}, x0⟩ : ProtoTile) + (⟨z.1, z.2⟩ : GaussianInt) + let turnedAt : Int × Int → ProtoTile := fun z => TileQuarterTurn (unitAt z) + ∀ (z : Int × Int), (tileAt z).cells = (turnedAt z).cells)) ) := by + classical + intro C base x hcells tileAt x0 unitAt turnedAt z + simp? [tileAt, turnedAt, unitAt, TileTranslation, TileQuarterTurn, + GaussianTranslation, hcells, x0, GaussianQuarterTurn] + ext <;> simp []; omega + +private theorem hvertsEqAt314 : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (x : GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * (⟨0, 1⟩ : GaussianInt) + (z.2 : + GaussianInt) * (-1)) + let x0 : GaussianInt := ⟨x.im, -x.re - 1⟩ + let unitAt : Int × Int → ProtoTile := fun z => + TileTranslation (⟨{x0}, x0⟩ : ProtoTile) + (⟨z.1, z.2⟩ : GaussianInt) + let turnedAt : Int × Int → ProtoTile := fun z => TileQuarterTurn (unitAt z) + (∀ (z : Int × Int), (tileAt z).cells = (turnedAt z).cells) → (∀ (z : Int × Int), + FootprintVertices (tileAt z) = FootprintVertices (turnedAt z)) ) := by + classical + intro base x tileAt x0 unitAt turnedAt hcellCalc z + have hturnedne : (turnedAt z).cells.Nonempty := by + simp [turnedAt, unitAt, TileQuarterTurn, TileTranslation] + have htilene : (tileAt z).cells.Nonempty := by + rw [hcellCalc] + exact hturnedne + simp [FootprintVertices, hturnedne, hcellCalc] + +private theorem hedgesEqAt322 : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (x : GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * (⟨0, 1⟩ : GaussianInt) + (z.2 : + GaussianInt) * (-1)) + let x0 : GaussianInt := ⟨x.im, -x.re - 1⟩ + let unitAt : Int × Int → ProtoTile := fun z => + TileTranslation (⟨{x0}, x0⟩ : ProtoTile) + (⟨z.1, z.2⟩ : GaussianInt) + let turnedAt : Int × Int → ProtoTile := fun z => TileQuarterTurn (unitAt z) + (∀ (z : Int × Int), (tileAt z).cells = (turnedAt z).cells) → (∀ (z : Int × Int), + FootprintEdges (tileAt z) = FootprintEdges (turnedAt z)) ) := by + classical + intro base x tileAt x0 unitAt turnedAt hcellCalc z + rw [FootprintEdges, FootprintEdges, hcellCalc] + +private theorem qstep : + (by + classical + exact + (BandCircle) → ( + let q := GaussianQuarterTurn + ∀ (u : GaussianInt), ∀ (v : GaussianInt), (v = u + 1 ∨ v = u - 1 ∨ + v = u + ⟨0, 1⟩ ∨ v = u - ⟨0, 1⟩) → (q v = q u + 1 ∨ q v = q u - 1 ∨ q v = q u + ⟨0, + 1⟩ ∨ q v = q u - ⟨0, 1⟩)) ) := by + classical + intro C q u v huv + rcases huv with h | h | h | h + · subst v + right; right; left + ext <;> simp [q, GaussianQuarterTurn] + · subst v + right; right; right + ext <;> simp [q, GaussianQuarterTurn] + · subst v + right; left + ext <;> simp [q, GaussianQuarterTurn]; omega + · subst v + left + ext <;> simp [q, GaussianQuarterTurn]; omega + +private theorem hqchain : + (by + classical + exact + ∀ (p : List GaussianInt), (List.IsChain (fun (x y : GaussianInt) => y = x + (1 : + GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p) → ( + let q := GaussianQuarterTurn + (∀ (u : GaussianInt), ∀ (v : GaussianInt), (v = u + 1 ∨ v = u - 1 ∨ v = u + ⟨0, 1⟩ ∨ v = + u - ⟨0, 1⟩) → (q v = q u + 1 ∨ q v = q u - 1 ∨ q v = q u + ⟨0, 1⟩ ∨ q v = q u - ⟨0, + 1⟩)) → ((p.map q).IsChain (fun u v : GaussianInt => v = u + 1 ∨ v = u - 1 ∨ v = u + + ⟨0, 1⟩ ∨ v = u - ⟨0, 1⟩))) ) := by + classical + intro p hpchain q qstep + exact List.isChain_map_of_isChain q qstep hpchain + +private theorem hqverts : + (by + classical + exact + ∀ (x : GaussianInt), + let x0 : GaussianInt := ⟨x.im, -x.re - 1⟩ + let unitAt : Int × Int → ProtoTile := fun z => + TileTranslation (⟨{x0}, x0⟩ : ProtoTile) + (⟨z.1, z.2⟩ : GaussianInt) + let turnedAt : Int × Int → ProtoTile := fun z => TileQuarterTurn (unitAt z) + let q := GaussianQuarterTurn + ∀ (z : Int × Int), FootprintVertices (turnedAt z) = q '' FootprintVertices (unitAt z) ) + := by + classical + intro x x0 unitAt turnedAt q z + change FootprintVertices (TileQuarterTurn (unitAt z)) = _ + exact (TileQuarterTurnFormulas (unitAt z)).2.2.2.2.2.1 + +private theorem hqedges : + (by + classical + exact + ∀ (x : GaussianInt), + let x0 : GaussianInt := ⟨x.im, -x.re - 1⟩ + let unitAt : Int × Int → ProtoTile := fun z => + TileTranslation (⟨{x0}, x0⟩ : ProtoTile) + (⟨z.1, z.2⟩ : GaussianInt) + let turnedAt : Int × Int → ProtoTile := fun z => TileQuarterTurn (unitAt z) + let q := GaussianQuarterTurn + ∀ (z : Int × Int), FootprintEdges (turnedAt z) = (fun e : Finset GaussianInt => e.image + q) '' FootprintEdges (unitAt z) ) := by + classical + intro x x0 unitAt turnedAt q z + change FootprintEdges (TileQuarterTurn (unitAt z)) = _ + exact (TileQuarterTurnFormulas (unitAt z)).2.2.2.2.2.2.1 + +private theorem hpOrig : + (by + classical + exact + ∀ (p : List GaussianInt), + let q := GaussianQuarterTurn + let qInv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + (∀ (z : GaussianInt), qInv (q z) = z) → (∀ (v : GaussianInt), ∀ (w : GaussianInt), ∀ (l₁ + : List GaussianInt), ∀ (l₂ : List GaussianInt), (List.map q p = l₁ ++ v :: w :: l₂) → + (p = l₁.map qInv ++ qInv v :: qInv w :: l₂.map qInv)) ) := by + classical + intro p q qInv hqInv v w l₁ l₂ hp + have h := congrArg (List.map qInv) hp + simpa [List.map_append, List.map_map, Function.comp_def, qInv, q, + hqInv] using h + +private theorem hEdgeA'At404 : + (by + classical + exact + ∀ (x : GaussianInt), + let x0 : GaussianInt := ⟨x.im, -x.re - 1⟩ + let unitAt : Int × Int → ProtoTile := fun z => + TileTranslation (⟨{x0}, x0⟩ : ProtoTile) + (⟨z.1, z.2⟩ : GaussianInt) + let turnedAt : Int × Int → ProtoTile := fun z => TileQuarterTurn (unitAt z) + let q := GaussianQuarterTurn + let qInv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + (∀ (z : GaussianInt), q (qInv z) = z) → ((∀ (z : Int × Int), FootprintEdges (turnedAt z) + = (fun e : Finset GaussianInt => e.image q) '' FootprintEdges (unitAt z)) → (∀ (v : + GaussianInt), ∀ (w : GaussianInt), ∀ (a' : ℤ × ℤ), ({qInv v, qInv w} ∈ FootprintEdges + ((fun (z : ℤ × ℤ) => TileTranslation (⟨{x0}, x0⟩ : ProtoTile) (⟨z.1, z.2⟩ : + GaussianInt)) a')) → ({v, w} ∈ FootprintEdges (turnedAt a')))) ) := by + classical + intro x x0 unitAt turnedAt q qInv hqInv' hqedges v w a' hEdgeA + rw [hqedges] + have hmem := Set.mem_image_of_mem + (fun e : Finset GaussianInt => e.image q) hEdgeA + simpa [unitAt, Finset.image_insert, q, qInv, hqInv'] using hmem + +private theorem hEdgeB'At409 : + (by + classical + exact + ∀ (x : GaussianInt), + let x0 : GaussianInt := ⟨x.im, -x.re - 1⟩ + let unitAt : Int × Int → ProtoTile := fun z => + TileTranslation (⟨{x0}, x0⟩ : ProtoTile) + (⟨z.1, z.2⟩ : GaussianInt) + let turnedAt : Int × Int → ProtoTile := fun z => TileQuarterTurn (unitAt z) + let q := GaussianQuarterTurn + let qInv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + (∀ (z : GaussianInt), q (qInv z) = z) → ((∀ (z : Int × Int), FootprintEdges (turnedAt z) + = (fun e : Finset GaussianInt => e.image q) '' FootprintEdges (unitAt z)) → (∀ (v : + GaussianInt), ∀ (w : GaussianInt), ∀ (b' : ℤ × ℤ), ({qInv v, qInv w} ∈ FootprintEdges + ((fun (z : ℤ × ℤ) => TileTranslation (⟨{x0}, x0⟩ : ProtoTile) (⟨z.1, z.2⟩ : + GaussianInt)) b')) → ({v, w} ∈ FootprintEdges (turnedAt b')))) ) := by + classical + intro x x0 unitAt turnedAt q qInv hqInv' hqedges v w b' hEdgeB + rw [hqedges] + have hmem := Set.mem_image_of_mem + (fun e : Finset GaussianInt => e.image q) hEdgeB + simpa [unitAt, Finset.image_insert, q, qInv, hqInv'] using hmem + +private theorem incident : + (by + classical + exact + ∀ (ι : Type), ∀ [DecidableEq ι], ∀ (PP : PeriodicTileComplex ι), ∀ (xi : ℤ × ℤ → ι), ∀ + (faceAt : + AffineTriangularFace → PP.plane.Face), (∀ (f : AffineTriangularFace), Finset.image xi + (AffineTriangularFaceVertices f) = {PP.plane.faceVertex (faceAt f) (0 : Fin (3 : ℕ)), + PP.plane.faceVertex (faceAt f) (1 : Fin (3 : ℕ)), PP.plane.faceVertex (faceAt f) (2 : + Fin (3 : ℕ))}) → (∀ (f : AffineTriangularFace), ∀ (z : Int × Int), (z ∈ + AffineTriangularFaceVertices f) → (∃ i, PP.plane.faceVertex (faceAt f) i = xi z)) ) + := by + classical + intro ι equality PP xi faceAt hinc f z hz + have hm : xi z ∈ (AffineTriangularFaceVertices f).image xi := + Finset.mem_image.mpr ⟨z, hz, rfl⟩ + rw [hinc f] at hm + simp only [Finset.mem_insert, Finset.mem_singleton] at hm + rcases hm with hm | hm | hm + · exact ⟨0, hm.symm⟩ + · exact ⟨1, hm.symm⟩ + · exact ⟨2, hm.symm⟩ + +private theorem faceStepData : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + ∀ (F : List (ℤ × ℤ)), ∀ (G : List (ℤ × ℤ)), ∀ (ι : Type), ∀ (PP : PeriodicTileComplex ι), + ∀ (xi : ℤ × ℤ → ι), ∀ (faceAt : AffineTriangularFace → PP.plane.Face), (∀ (u : ℤ × + ℤ), ∀ (v : ℤ × ℤ), TriangularLatticeAdjacent u v ↔ PP.plane.adjacent (xi u) (xi v)) → + ((∀ (z : ℤ × ℤ), PP.tile (xi z) = tileAt z) → ((Function.Injective faceAt) → ( + let goodV : GaussianInt → Prop := fun x => + (∃ a ∈ (F.drop 1).dropLast, x ∈ FootprintVertices (tileAt a)) ∧ + (∃ b ∈ (G.drop 1).dropLast, x ∈ FootprintVertices (tileAt b)) + let goodE : GaussianInt → GaussianInt → Prop := fun x y => + (∃ a ∈ (F.drop 1).dropLast, {x, y} ∈ FootprintEdges (tileAt a)) ∧ + (∃ b ∈ (G.drop 1).dropLast, {x, y} ∈ FootprintEdges (tileAt b)) + (∀ (f : AffineTriangularFace), ∀ (z : Int × Int), (z ∈ AffineTriangularFaceVertices f) → + (∃ i, PP.plane.faceVertex (faceAt f) i = xi z)) → (∀ (f : AffineTriangularFace), ∀ (g + : AffineTriangularFace), (AffineTriangularCorridorStep F G f g) → ( + let W := PP.facePath (faceAt f) (faceAt g); + W.head? = some (PP.rho (faceAt f)) ∧ + W.getLast? = some (PP.rho (faceAt g)) ∧ + (∀ w ∈ W, goodV w) ∧ + ∀ x y : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + W = l₁ ++ x :: y :: l₂ → goodE x y))))) ) := by + classical + intro base a b tileAt F G ι PP xi faceAt hadjXi htileXi hinjFace goodV goodE incident f g hfg + rcases hfg with ⟨hfg, u, v, huv, hadjuv, huf, hvf, hug, hvg, howners⟩ + have hplane : PP.plane.adjacent (xi u) (xi v) := + (hadjXi u v).mp hadjuv + have hfaceNe : faceAt f ≠ faceAt g := fun h => hfg (hinjFace h) + have hspec := PP.facePath_spec (xi u) (xi v) hplane + (faceAt f) (faceAt g) hfaceNe + (incident f u huf) (incident f v hvf) + (incident g u hug) (incident g v hvg) + refine ⟨hspec.1, hspec.2.1, ?_, ?_⟩ + · intro w hw + have hwu : w ∈ FootprintVertices (tileAt u) := by + rw [← htileXi u] + exact hspec.2.2.1 w hw |>.1 + have hwv : w ∈ FootprintVertices (tileAt v) := by + rw [← htileXi v] + exact hspec.2.2.1 w hw |>.2 + rcases howners with ⟨hau, hbv⟩ | ⟨hau, hbau⟩ + · exact ⟨⟨u, hau, hwu⟩, ⟨v, hbv, hwv⟩⟩ + · exact ⟨⟨u, hau, hwu⟩, ⟨u, hbau, hwu⟩⟩ + · intro x y l₁ l₂ heq + have hEdge := hspec.2.2.2 x y l₁ l₂ heq + have hEu : {x, y} ∈ FootprintEdges (tileAt u) := by + rw [← htileXi u] + exact hEdge.1 + have hEv : {x, y} ∈ FootprintEdges (tileAt v) := by + rw [← htileXi v] + exact hEdge.2 + rcases howners with ⟨hau, hbv⟩ | ⟨hau, hbau⟩ + · exact ⟨⟨u, hau, hEu⟩, ⟨v, hbv, hEv⟩⟩ + · exact ⟨⟨u, hau, hEu⟩, ⟨u, hbau, hEu⟩⟩ + +private theorem chainAppendDrop : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + ∀ (F : List (ℤ × ℤ)), ∀ (G : List (ℤ × ℤ)), + let goodE : GaussianInt → GaussianInt → Prop := fun x y => + (∃ a ∈ (F.drop 1).dropLast, {x, y} ∈ FootprintEdges (tileAt a)) ∧ + (∃ b ∈ (G.drop 1).dropLast, {x, y} ∈ FootprintEdges (tileAt b)) + ∀ {A : List GaussianInt}, ∀ {B : List GaussianInt}, (A ≠ []) → ((A.getLast? = B.head?) → + ((A.IsChain goodE) → ((B.IsChain goodE) → ((A ++ B.drop 1).IsChain goodE)))) ) := by + classical + intro base a b tileAt F G goodE A B hAn hjoin hA hB + rw [List.isChain_append] + refine ⟨hA, ?_, ?_⟩ + · simpa using hB.tail + · intro x hx y hy + cases B with + | nil => + cases A with + | nil => simp at hAn + | cons a as => + rw [List.getLast?_eq_getLast_of_ne_nil hAn] at hjoin + simp at hjoin + | cons b bs => + change List.IsChain goodE (b :: bs) at hB + have hxval : b = x := by simpa [hjoin] using hx + have hy' : y ∈ bs.head? := by simpa using hy + rw [← hxval] + exact hB.rel_head? hy' + +private theorem hfaceLen : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (R : ProtoTile), ∀ (S : ProtoTile), (List ProtoTile) → ((List + ProtoTile) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + ∀ (r : ℤ × ℤ), (R = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + + (↑z.2 : GaussianInt) * b)) r) → ((∀ (y : ℤ × ℤ), (fun (z : ℤ × ℤ) => R = (fun (z : ℤ + × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) + z) y → y = r) → (∀ (s : ℤ × ℤ), (S = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 + : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) s) → ((∀ (y : ℤ × ℤ), (fun (z : ℤ × + ℤ) => S = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 + : GaussianInt) * b)) z) y → y = s) → ((R = tileAt r) → ((S = tileAt s) → (∀ (F : List + (ℤ × ℤ)), ∀ (G : List (ℤ × ℤ)), (TriangularStripSegment r s F) → + ((TriangularStripSegment s r G) → ((r ≠ s) → ((¬ TriangularLatticeAdjacent r s) → (∀ + (faces : List AffineTriangularFace), (faces ≠ []) → ((∃ (f : AffineTriangularFace), + faces.head? = some f ∧ r ∈ AffineTriangularFaceVertices f) → ((∃ (f : + AffineTriangularFace), faces.getLast? = some f ∧ s ∈ AffineTriangularFaceVertices f) + → ((∀ f ∈ faces, (∃ a ∈ (List.drop (1 : ℕ) F).dropLast, a ∈ + AffineTriangularFaceVertices f) ∧ ∃ b ∈ (List.drop (1 : ℕ) G).dropLast, b ∈ + AffineTriangularFaceVertices f) → ((List.IsChain (AffineTriangularCorridorStep F G) + faces) → (2 ≤ faces.length))))))))))))))))) ) := by + classical + intro base R S forward reverse a b tileAt r hrcoord hruniq s hscoord hsuniq hR hS F G hFstrip + hGstrip hrs hnadjCoord faces hfacesNe hfirst hlast hfaceVertices hfaceChain + rcases hfirst with ⟨f, hf, hfr⟩ + rcases hlast with ⟨g, hg, hgs⟩ + cases faces with + | nil => simp at hfacesNe + | cons f' tail => + cases tail with + | nil => + have hfg : f' = f := by simpa using hf + have hgg : f' = g := by simpa using hg + subst f + subst g + have hAdj : TriangularLatticeAdjacent r s := by + cases f' <;> + simp only [AffineTriangularFaceVertices, Finset.mem_insert, + Finset.mem_singleton] at hfr hgs <;> + rcases hfr with rfl | rfl | rfl <;> + rcases hgs with rfl | rfl | rfl <;> + try contradiction + all_goals simp [TriangularLatticeAdjacent, Prod.ext_iff, + ] + exact (hnadjCoord hAdj).elim + | cons g' rest => simp + +private theorem walkFacts : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + ∀ (F : List (ℤ × ℤ)), ∀ (G : List (ℤ × ℤ)), ∀ (ι : Type), ∀ (PP : PeriodicTileComplex ι), + ∀ (faceAt : AffineTriangularFace → PP.plane.Face), + let goodV : GaussianInt → Prop := fun x => + (∃ a ∈ (F.drop 1).dropLast, x ∈ FootprintVertices (tileAt a)) ∧ + (∃ b ∈ (G.drop 1).dropLast, x ∈ FootprintVertices (tileAt b)) + let goodE : GaussianInt → GaussianInt → Prop := fun x y => + (∃ a ∈ (F.drop 1).dropLast, {x, y} ∈ FootprintEdges (tileAt a)) ∧ + (∃ b ∈ (G.drop 1).dropLast, {x, y} ∈ FootprintEdges (tileAt b)) + (∀ (f : AffineTriangularFace), ∀ (g : AffineTriangularFace), + (AffineTriangularCorridorStep F G f g) → ( + let W := PP.facePath (faceAt f) (faceAt g); + W.head? = some (PP.rho (faceAt f)) ∧ + W.getLast? = some (PP.rho (faceAt g)) ∧ + (∀ w ∈ W, goodV w) ∧ + ∀ x y : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + W = l₁ ++ x :: y :: l₂ → goodE x y)) → ((∀ (W : List GaussianInt), (∀ x y : + GaussianInt, ∀ l₁, ∀ l₂, W = l₁ ++ x :: y :: l₂ → goodE x y) → (W.IsChain goodE)) + → ((∀ {A : List GaussianInt}, ∀ {B : List GaussianInt}, (A ≠ []) → ((A.getLast? = + B.head?) → ((A.IsChain goodE) → ((B.IsChain goodE) → ((A ++ B.drop 1).IsChain + goodE))))) → ( + let joinWalk : List AffineTriangularFace → List GaussianInt := fun L => + (L.zip L.tail).foldr + (fun fg acc => PP.facePath (faceAt fg.1) (faceAt fg.2) ++ acc.drop 1) [] + ∀ L : List AffineTriangularFace, L.IsChain (AffineTriangularCorridorStep F G) → 2 ≤ + L.length → (∃ f, L.head? = some f ∧ (joinWalk L).head? = some (PP.rho (faceAt f))) ∧ + (∃ g, L.getLast? = some g ∧ (joinWalk L).getLast? = some (PP.rho (faceAt g))) ∧ (∀ w + ∈ joinWalk L, goodV w) ∧ (joinWalk L).IsChain goodE))) ) := by + classical + intro base a b tileAt F G ι PP faceAt goodV goodE faceStepData chainOfEdges chainAppendDrop + joinWalk L + induction L using List.twoStepInduction with + | nil => intro _ hlen; simp at hlen + | singleton f => intro _ hlen; simp at hlen + | cons_cons f g rest ih ih' => + intro hchain hlen + have hfg := (List.isChain_cons_cons.mp hchain).1 + have htail := (List.isChain_cons_cons.mp hchain).2 + have hdata := faceStepData f g hfg + let W := PP.facePath (faceAt f) (faceAt g) + have hwalkEq : joinWalk (f :: g :: rest) = + W ++ (joinWalk (g :: rest)).drop 1 := by + simp [joinWalk, W] + have hWhead : W.head? = some (PP.rho (faceAt f)) := hdata.1 + have hWlast : W.getLast? = some (PP.rho (faceAt g)) := hdata.2.1 + have hWnonempty : W ≠ [] := by + intro hnil + simp [W, hnil] at hWhead + have hWchain : W.IsChain goodE := chainOfEdges W (by + intro x y l₁ l₂ heq + exact hdata.2.2.2 x y l₁ l₂ heq) + cases rest with + | nil => + have hsingle : joinWalk [g] = [] := by simp [joinWalk] + refine ⟨⟨f, rfl, ?_⟩, ⟨g, ?_, ?_⟩, ?_, ?_⟩ + · rw [hwalkEq, hsingle] + simpa using hWhead + · simp + · rw [hwalkEq, hsingle] + simpa using hWlast + · intro w hw + rw [hwalkEq, hsingle] at hw + have hw' : w ∈ W := by simpa using hw + exact hdata.2.2.1 w hw' + · rw [hwalkEq, hsingle] + simpa using hWchain + | cons h rest' => + have htailLen : 2 ≤ (g :: h :: rest').length := by simp + have hrec := ih' g htail htailLen + obtain ⟨⟨g0, hg0, hrecHead⟩, ⟨gend, hgend, hrecLast⟩, + hrecVerts, hrecChain⟩ := hrec + have hg0eq : g = g0 := by simpa using hg0 + subst g0 + have hjoin : W.getLast? = (joinWalk (g :: h :: rest')).head? := by + rw [hrecHead] + exact hWlast + have hjoinedChain := chainAppendDrop hWnonempty hjoin hWchain hrecChain + have hjoinedHead : + (W ++ (joinWalk (g :: h :: rest')).drop 1).head? = + some (PP.rho (faceAt f)) := by + rw [List.head?_append_of_ne_nil _ hWnonempty] + exact hWhead + have hjoinedLast : + (W ++ (joinWalk (g :: h :: rest')).drop 1).getLast? = + some (PP.rho (faceAt gend)) := by + by_cases hdrop : (joinWalk (g :: h :: rest')).drop 1 = [] + · have hsingle : joinWalk (g :: h :: rest') = + [PP.rho (faceAt g)] := by + cases hp : joinWalk (g :: h :: rest') with + | nil => simp [hp] at hrecHead + | cons x xs => + cases xs with + | nil => + have hx : x = PP.rho (faceAt g) := by + simpa [hp] using hrecHead + subst x + simp [] + | cons y ys => simp [hp] at hdrop + have hends : PP.rho (faceAt g) = PP.rho (faceAt gend) := by + simpa [hsingle] using hrecLast + simp [hdrop, hWlast, hends] + · have hlastdrop : + ((joinWalk (g :: h :: rest')).drop 1).getLast? = + (joinWalk (g :: h :: rest')).getLast? := by + cases hpath : joinWalk (g :: h :: rest') with + | nil => simp [hpath] at hdrop + | cons x xs => + cases hxs : xs with + | nil => simp [hpath, hxs] at hdrop + | cons y ys => rfl + rw [List.getLast?_append_of_ne_nil _ hdrop, hlastdrop, hrecLast] + refine ⟨⟨f, rfl, ?_⟩, ⟨gend, ?_, ?_⟩, ?_, ?_⟩ + · rw [hwalkEq] + exact hjoinedHead + · simpa using hgend + · rw [hwalkEq] + exact hjoinedLast + · intro w hw + rw [hwalkEq] at hw + rcases List.mem_append.mp hw with hw | hw + · exact hdata.2.2.1 w hw + · exact hrecVerts w (List.mem_of_mem_drop hw) + · rw [hwalkEq] + exact hjoinedChain + +private theorem pairStep : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (({x, + y} : Finset GaussianInt) = {a, b}) → ((b = a + 1 ∨ b = a + ⟨0, 1⟩) → (y = x + 1 ∨ y = + x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩)) ) := by + classical + intro x y a b hp hab + have hxm : x = a ∨ x = b := by + have hx : x ∈ ({a, b} : Finset GaussianInt) := by rw [← hp]; simp + simpa using hx + have hym : y = a ∨ y = b := by + have hy : y ∈ ({a, b} : Finset GaussianInt) := by rw [← hp]; simp + simpa using hy + have ham : a = x ∨ a = y := by + have ha : a ∈ ({x, y} : Finset GaussianInt) := by rw [hp]; simp + simpa using ha + have hbm : b = x ∨ b = y := by + have hb : b ∈ ({x, y} : Finset GaussianInt) := by rw [hp]; simp + simpa using hb + have habne : a ≠ b := by + intro he + subst b + rcases hab with hab | hab + · have h := congrArg (fun z : GaussianInt => z.re) hab + simp at h + · have h := congrArg (fun z : GaussianInt => z.im) hab + simp at h + have hxy : x ≠ y := by + intro he + subst y + rcases ham with hax | hax <;> rcases hbm with hbx | hbx + all_goals exact habne (hax.trans hbx.symm) + rcases hxm with hxa | hxb + · rcases hym with hya | hyb + · exact (hxy (hxa.trans hya.symm)).elim + · subst x + subst y + rcases hab with hab | hab + · exact Or.inl (by simp [hab]) + · exact Or.inr (Or.inr (Or.inl (by simp [hab]))) + · rcases hym with hya | hyb + · subst x + subst y + rcases hab with hab | hab + · exact Or.inr (Or.inl (by rw [hab]; simp)) + · exact Or.inr (Or.inr (Or.inr (by rw [hab]; simp))) + · exact (hxy (hxb.trans hyb.symm)).elim + +private theorem actualEdgeStep : + (by + classical + exact + (∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + (({x, y} : Finset GaussianInt) = {a, b}) → ((b = a + 1 ∨ b = a + ⟨0, 1⟩) → (y = x + 1 + ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩))) → (∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, ∀ {T : ProtoTile}, ({x, y} ∈ FootprintEdges T) → (y = x + 1 ∨ y = + x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩)) ) := by + classical + intro pairStep x y T he + simp only [FootprintEdges, Set.mem_ofPred_eq] at he + rcases he with ⟨z, hz, hshape⟩ + rcases hshape with hshape | hshape | hshape | hshape + · exact pairStep x y z (z + 1) hshape (Or.inl rfl) + · exact pairStep x y z (z + ⟨0, 1⟩) hshape (Or.inr rfl) + · exact pairStep x y (z + 1) (z + 1 + ⟨0, 1⟩) hshape (Or.inr (by abel)) + · exact pairStep x y (z + ⟨0, 1⟩) (z + 1 + ⟨0, 1⟩) hshape + (Or.inl (by abel)) + +private theorem hRrho : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + ∀ (r : ℤ × ℤ), ∀ (ι : Type), ∀ (PP : PeriodicTileComplex ι), ∀ (xi : ℤ × ℤ → ι), ∀ + (faceAt : AffineTriangularFace → PP.plane.Face), (∀ (z : ℤ × ℤ), PP.tile (xi z) = + tileAt z) → (∀ (f0 : AffineTriangularFace), ∀ (ir : Fin (3 : ℕ)), + (PP.plane.faceVertex (faceAt f0) ir = xi r) → (PP.rho (faceAt f0) ∈ FootprintVertices + (tileAt r))) ) := by + classical + intro base a b tileAt r ι PP xi faceAt htileXi f0 ir hir + rw [← htileXi r, ← hir] + exact PP.rho_common (faceAt f0) ir + +private theorem hSrho : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + ∀ (s : ℤ × ℤ), ∀ (ι : Type), ∀ (PP : PeriodicTileComplex ι), ∀ (xi : ℤ × ℤ → ι), ∀ + (faceAt : AffineTriangularFace → PP.plane.Face), (∀ (z : ℤ × ℤ), PP.tile (xi z) = + tileAt z) → (∀ (g0 : AffineTriangularFace), ∀ (is : Fin (3 : ℕ)), + (PP.plane.faceVertex (faceAt g0) is = xi s) → (PP.rho (faceAt g0) ∈ FootprintVertices + (tileAt s))) ) := by + classical + intro base a b tileAt s ι PP xi faceAt htileXi g0 is his + rw [← htileXi s, ← his] + exact PP.rho_common (faceAt g0) is + +private theorem htileAlign : + (by + classical + exact + ∀ (C : BandCircle), ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + ∀ (chart : AffineTriangularComplexChart P fun (mn : ℤ × ℤ) => TileTranslation base + ((↑mn.1 : GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + + (↑mn.2 : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))))), + (a = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))) → ((b = BandVectors.1 + (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))) → (∀ (z : Int × Int), P.tile + (chart.vertexEquiv z) = tileAt z)) ) := by + classical + intro C base a b tileAt q P chart haV hbV z + rw [chart.tile_eq] + simp [tileAt, haV, hbV] + +private theorem hinjFaceAt766 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (base : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (P : + PeriodicTileComplex ↥(TilingLattice C)), ∀ (chart : AffineTriangularComplexChart P + fun (mn : ℤ × ℤ) => TileTranslation base ((↑mn.1 : GaussianInt) * BandVectors.1 (q (1 + : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑mn.2 : GaussianInt) * BandVectors.1 (q (2 : + Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))))), + let faceAt : AffineTriangularFace → P.plane.Face := fun f => + match f with + | .up z => chart.up z + | .down z => chart.down z + Function.Injective faceAt ) := by + classical + intro C base q P chart faceAt f g h + cases f with + | up u => + cases g with + | up v => exact congrArg AffineTriangularFace.up (chart.up_injective h) + | down v => exact False.elim (chart.up_ne_down u v h) + | down u => + cases g with + | up v => exact False.elim ((chart.up_ne_down v u) h.symm) + | down v => exact congrArg AffineTriangularFace.down (chart.down_injective h) + +private theorem hincAt777 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (base : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (P : + PeriodicTileComplex ↥(TilingLattice C)), ∀ (chart : AffineTriangularComplexChart P + fun (mn : ℤ × ℤ) => TileTranslation base ((↑mn.1 : GaussianInt) * BandVectors.1 (q (1 + : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑mn.2 : GaussianInt) * BandVectors.1 (q (2 : + Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))))), + let faceAt : AffineTriangularFace → P.plane.Face := fun f => + match f with + | .up z => chart.up z + | .down z => chart.down z + ∀ (f : AffineTriangularFace), (AffineTriangularFaceVertices f).image chart.vertexEquiv = + {P.plane.faceVertex (faceAt f) 0, P.plane.faceVertex (faceAt f) 1, + P.plane.faceVertex (faceAt f) 2} ) := by + classical + intro C base q P chart faceAt f + cases f <;> simp [AffineTriangularFaceVertices, faceAt, + chart.up_vertices, chart.down_vertices, Finset.image_insert, + Finset.image_singleton] + +private theorem hadjXiAt795 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (base : ProtoTile), (List (ℤ × ℤ)) → (∀ (q : Fin (4 : ℕ) → + CircleCoordinates), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (chart : + AffineTriangularComplexChart P fun (mn : ℤ × ℤ) => TileTranslation base ((↑mn.1 : + GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑mn.2 : + GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))))), ((∀ (x : + ℤ × ℤ), ∀ (y : ℤ × ℤ), TriangularLatticeAdjacent x.swap y.swap ↔ + TriangularLatticeAdjacent x y) ∧ (∀ (f : AffineTriangularFace), Finset.image + Prod.swap (AffineTriangularFaceVertices f) = AffineTriangularFaceVertices + (AffineTriangularFaceCoordinateSwap f)) ∧ (∀ (z : ℤ × ℤ), TileTranslation base ((↑z.1 + : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑z.2 : + GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))) = P.tile + ((chart.vertexEquiv : ℤ × ℤ → ↥(TilingLattice C)) z.swap)) ∧ ∀ (f : + AffineTriangularFace), + let F := (match AffineTriangularFaceCoordinateSwap f with + | AffineTriangularFace.up z => chart.up z + | AffineTriangularFace.down z => chart.down z); Finset.image (fun (z : ℤ × + ℤ) => (chart.vertexEquiv : ℤ × ℤ → ↥(TilingLattice C)) z.swap) + (AffineTriangularFaceVertices f) = {P.plane.faceVertex F (0 : Fin (3 : ℕ)), + P.plane.faceVertex F (1 : Fin (3 : ℕ)), P.plane.faceVertex F (2 : Fin (3 : ℕ))}) → ( + let xi := fun z : Int × Int => + chart.vertexEquiv (Prod.swap z) + ∀ (u : Int × Int), ∀ (v : Int × Int), TriangularLatticeAdjacent u v ↔ P.plane.adjacent + (xi u) (xi v)))) := by + classical + intro C base F q P chart halign xi u v + change TriangularLatticeAdjacent u v ↔ + P.plane.adjacent (chart.vertexEquiv (Prod.swap u)) + (chart.vertexEquiv (Prod.swap v)) + exact (halign.1 u v).symm.trans + (chart.adjacent_iff (Prod.swap u) (Prod.swap v)).symm + +private theorem htileXi : + (by + classical + exact + ∀ (C : BandCircle), ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + (List (ℤ × ℤ)) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (P : PeriodicTileComplex + ↥(TilingLattice C)), ∀ (chart : AffineTriangularComplexChart P fun (mn : ℤ × ℤ) => + TileTranslation base ((↑mn.1 : GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q + (0 : Fin (4 : ℕ))) + (↑mn.2 : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q + (0 : Fin (4 : ℕ))))), (a = BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))) + → ((b = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))) → (((∀ (x : ℤ × + ℤ), ∀ (y : ℤ × ℤ), TriangularLatticeAdjacent x.swap y.swap ↔ + TriangularLatticeAdjacent x y) ∧ (∀ (f : AffineTriangularFace), Finset.image + Prod.swap (AffineTriangularFaceVertices f) = AffineTriangularFaceVertices + (AffineTriangularFaceCoordinateSwap f)) ∧ (∀ (z : ℤ × ℤ), TileTranslation base ((↑z.1 + : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑z.2 : + GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))) = P.tile + ((chart.vertexEquiv : ℤ × ℤ → ↥(TilingLattice C)) z.swap)) ∧ ∀ (f : + AffineTriangularFace), + let F := (match AffineTriangularFaceCoordinateSwap f with + | AffineTriangularFace.up z => chart.up z + | AffineTriangularFace.down z => chart.down z); Finset.image (fun (z : ℤ × + ℤ) => (chart.vertexEquiv : ℤ × ℤ → ↥(TilingLattice C)) z.swap) + (AffineTriangularFaceVertices f) = {P.plane.faceVertex F (0 : Fin (3 : ℕ)), + P.plane.faceVertex F (1 : Fin (3 : ℕ)), P.plane.faceVertex F (2 : Fin (3 : ℕ))}) → ( + let xi := fun z : Int × Int => + chart.vertexEquiv (Prod.swap z) + ∀ (z : Int × Int), P.tile (xi z) = tileAt z))))) := by + classical + intro C base a b tileAt F q P chart haV hbV halign xi z + change P.tile (chart.vertexEquiv (Prod.swap z)) = tileAt z + simpa [tileAt, haV, hbV, add_comm] using (halign.2.2.1 z).symm + +private theorem hinjFaceAt805 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (base : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (P : + PeriodicTileComplex ↥(TilingLattice C)), ∀ (chart : AffineTriangularComplexChart P + fun (mn : ℤ × ℤ) => TileTranslation base ((↑mn.1 : GaussianInt) * BandVectors.1 (q (1 + : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑mn.2 : GaussianInt) * BandVectors.1 (q (2 : + Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))))), + let faceAt : AffineTriangularFace → P.plane.Face := fun f => + match AffineTriangularFaceCoordinateSwap f with + | .up z => chart.up z + | .down z => chart.down z + Function.Injective faceAt ) := by + classical + intro C base q P chart faceAt f g h + cases f with + | up u => + cases g with + | up v => + change chart.down (Prod.swap u) = chart.down (Prod.swap v) at h + have hv := chart.down_injective h + exact congrArg AffineTriangularFace.up (Prod.swap_injective hv) + | down v => + change chart.down (Prod.swap u) = chart.up (Prod.swap v) at h + exact False.elim ((chart.up_ne_down (Prod.swap v) (Prod.swap u)) h.symm) + | down u => + cases g with + | up v => + change chart.up (Prod.swap u) = chart.down (Prod.swap v) at h + exact False.elim ((chart.up_ne_down (Prod.swap u) (Prod.swap v)) h) + | down v => + change chart.up (Prod.swap u) = chart.up (Prod.swap v) at h + have hv := chart.up_injective h + exact congrArg AffineTriangularFace.down (Prod.swap_injective hv) + +private theorem hincAt826 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (base : ProtoTile), (List (ℤ × ℤ)) → (∀ (q : Fin (4 : ℕ) → + CircleCoordinates), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (chart : + AffineTriangularComplexChart P fun (mn : ℤ × ℤ) => TileTranslation base ((↑mn.1 : + GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑mn.2 : + GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))))), ((∀ (x : + ℤ × ℤ), ∀ (y : ℤ × ℤ), TriangularLatticeAdjacent x.swap y.swap ↔ + TriangularLatticeAdjacent x y) ∧ (∀ (f : AffineTriangularFace), Finset.image + Prod.swap (AffineTriangularFaceVertices f) = AffineTriangularFaceVertices + (AffineTriangularFaceCoordinateSwap f)) ∧ (∀ (z : ℤ × ℤ), TileTranslation base ((↑z.1 + : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑z.2 : + GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))) = P.tile + ((chart.vertexEquiv : ℤ × ℤ → ↥(TilingLattice C)) z.swap)) ∧ ∀ (f : + AffineTriangularFace), + let F := (match AffineTriangularFaceCoordinateSwap f with + | AffineTriangularFace.up z => chart.up z + | AffineTriangularFace.down z => chart.down z); Finset.image (fun (z : ℤ × + ℤ) => (chart.vertexEquiv : ℤ × ℤ → ↥(TilingLattice C)) z.swap) + (AffineTriangularFaceVertices f) = {P.plane.faceVertex F (0 : Fin (3 : ℕ)), + P.plane.faceVertex F (1 : Fin (3 : ℕ)), P.plane.faceVertex F (2 : Fin (3 : ℕ))}) → ( + let xi := fun z : Int × Int => + chart.vertexEquiv (Prod.swap z) + let faceAt : AffineTriangularFace → P.plane.Face := fun f => + match AffineTriangularFaceCoordinateSwap f with + | .up z => chart.up z + | .down z => chart.down z + ∀ (f : AffineTriangularFace), (AffineTriangularFaceVertices f).image xi = + {P.plane.faceVertex (faceAt f) 0, P.plane.faceVertex (faceAt f) 1, + P.plane.faceVertex (faceAt f) 2}))) := by + classical + intro C base F q P chart halign xi faceAt f + change (AffineTriangularFaceVertices f).image + (fun z => chart.vertexEquiv (Prod.swap z)) = _ + exact halign.2.2.2 f + +end OpposingInterfaceGeometry + +namespace OpposingInterfaceConclusion + +private theorem finish : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (R : ProtoTile), ∀ (S : ProtoTile), ∀ (forward : List ProtoTile), + ∀ (reverse : List ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + ∀ (r : ℤ × ℤ), (R = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + + (↑z.2 : GaussianInt) * b)) r) → ((∀ (y : ℤ × ℤ), (fun (z : ℤ × ℤ) => R = (fun (z : ℤ + × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) + z) y → y = r) → (∀ (s : ℤ × ℤ), (S = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 + : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) s) → ((∀ (y : ℤ × ℤ), (fun (z : ℤ × + ℤ) => S = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 + : GaussianInt) * b)) z) y → y = s) → ((R = tileAt r) → ((S = tileAt s) → (∀ (F : List + (ℤ × ℤ)), ∀ (G : List (ℤ × ℤ)), (TriangularStripSegment r s F) → + ((TriangularStripSegment s r G) → ((r ≠ s) → ((¬TriangularLatticeAdjacent r s) → ((∀ + z ∈ (List.drop (1 : ℕ) F).dropLast, ∃ T ∈ (List.drop (1 : ℕ) forward).dropLast, T = + (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : + GaussianInt) * b)) z) → ((∀ z ∈ (List.drop (1 : ℕ) G).dropLast, ∃ T ∈ (List.drop (1 : + ℕ) reverse).dropLast, T = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : + GaussianInt) * a + (↑z.2 : GaussianInt) * b)) z) → (∀ (faces : List + AffineTriangularFace), (faces ≠ []) → ((∃ (f : AffineTriangularFace), faces.head? = + some f ∧ r ∈ AffineTriangularFaceVertices f) → ((∃ (f : AffineTriangularFace), + faces.getLast? = some f ∧ s ∈ AffineTriangularFaceVertices f) → ((∀ f ∈ faces, (∃ a ∈ + (List.drop (1 : ℕ) F).dropLast, a ∈ AffineTriangularFaceVertices f) ∧ ∃ b ∈ + (List.drop (1 : ℕ) G).dropLast, b ∈ AffineTriangularFaceVertices f) → ((List.IsChain + (AffineTriangularCorridorStep F G) faces) → (∀ {ι : Type}, ∀ [DecidableEq ι], ∀ (PP : + PeriodicTileComplex ι), ∀ (xi : Int × Int → ι), ∀ (faceAt : AffineTriangularFace → + PP.plane.Face), (∀ u, ∀ v, TriangularLatticeAdjacent u v ↔ + PP.plane.adjacent (xi u) (xi v)) → ((∀ z, PP.tile (xi z) = tileAt z) → + ((Function.Injective faceAt) → ((∀ f, (AffineTriangularFaceVertices f).image xi = + {PP.plane.faceVertex (faceAt f) 0, + PP.plane.faceVertex (faceAt f) 1, + PP.plane.faceVertex (faceAt f) 2}) → (∃ p : List GaussianInt, (∃ x, p.head? = some + x ∧ x ∈ FootprintVertices R) ∧ (∃ y, p.getLast? = some y ∧ y ∈ + FootprintVertices S) ∧ p.IsChain (fun x y => y = x + 1 ∨ y = x - 1 ∨ y = x + + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) ∧ (∀ x, x ∈ p → (∃ a ∈ (forward.drop 1).dropLast, x ∈ + FootprintVertices a) ∧ (∃ b ∈ (reverse.drop 1).dropLast, x ∈ FootprintVertices + b)) ∧ ∀ x y : GaussianInt, ∀ l₁ l₂ : List GaussianInt, p = l₁ ++ x :: y :: l₂ → + (∃ a ∈ (forward.drop 1).dropLast, {x, y} ∈ FootprintEdges a) ∧ (∃ b ∈ + (reverse.drop 1).dropLast, {x, y} ∈ FootprintEdges b)))))))))))))))))))))) ) := by + classical + intro base R S forward reverse a b tileAt r hrcoord hruniq s hscoord hsuniq hR hS F G hFstrip + hGstrip hrs hnadjCoord forwardInterior reverseInterior faces hfacesNe hfirst hlast + hfaceVertices hfaceChain ι typeclassInstance0 PP xi faceAt hadjXi htileXi hinjFace hinc + let goodV : GaussianInt → Prop := fun x => + (∃ a ∈ (F.drop 1).dropLast, x ∈ FootprintVertices (tileAt a)) ∧ + (∃ b ∈ (G.drop 1).dropLast, x ∈ FootprintVertices (tileAt b)) + let goodE : GaussianInt → GaussianInt → Prop := fun x y => + (∃ a ∈ (F.drop 1).dropLast, {x, y} ∈ FootprintEdges (tileAt a)) ∧ + (∃ b ∈ (G.drop 1).dropLast, {x, y} ∈ FootprintEdges (tileAt b)) + have incident := OpposingInterfaceGeometry.incident ι PP xi faceAt hinc + have chainOfEdges (W : List GaussianInt) + (hedge : ∀ x y : GaussianInt, ∀ l₁ l₂, + W = l₁ ++ x :: y :: l₂ → goodE x y) : W.IsChain goodE := + (List.isChain_iff_forall_rel_of_append_cons_cons).2 hedge + let joinWalk : List AffineTriangularFace → List GaussianInt := fun L => + (L.zip L.tail).foldr + (fun fg acc => PP.facePath (faceAt fg.1) (faceAt fg.2) ++ acc.drop 1) [] + have hfaceLen := OpposingInterfaceGeometry.hfaceLen base R S forward reverse a b r hrcoord + hruniq s hscoord hsuniq hR hS F G hFstrip hGstrip hrs hnadjCoord faces hfacesNe hfirst + hlast hfaceVertices hfaceChain + have walkFacts := OpposingInterfaceGeometry.walkFacts base a b F G ι PP faceAt + (OpposingInterfaceGeometry.faceStepData base a b F G ι PP xi faceAt hadjXi htileXi + hinjFace incident) chainOfEdges (OpposingInterfaceGeometry.chainAppendDrop base a b F G) + have actualEdgeStep {x y : GaussianInt} {T : ProtoTile} + (he : {x, y} ∈ FootprintEdges T) := OpposingInterfaceGeometry.actualEdgeStep + (OpposingInterfaceGeometry.pairStep) (x := x) (y := y) (T := T) he + obtain ⟨hWalkHead, hWalkLast, hWalkVertices, hWalkChain⟩ := + walkFacts faces hfaceChain hfaceLen + obtain ⟨f0, hf0, hpHead⟩ := hWalkHead + obtain ⟨g0, hg0, hpLast⟩ := hWalkLast + obtain ⟨fFirst, hfFirst, hfr⟩ := hfirst + obtain ⟨fLast, hfLast, hgs⟩ := hlast + have hFirstEq : fFirst = f0 := Option.some.inj (hfFirst.symm.trans hf0) + have hLastEq : fLast = g0 := Option.some.inj (hfLast.symm.trans hg0) + subst fFirst + subst fLast + obtain ⟨ir, hir⟩ := incident f0 r hfr + obtain ⟨is, his⟩ := incident g0 s hgs + have hRrho : PP.rho (faceAt f0) ∈ FootprintVertices (tileAt r) := + OpposingInterfaceGeometry.hRrho base a b r ι PP xi faceAt htileXi f0 ir hir + have hSrho : PP.rho (faceAt g0) ∈ FootprintVertices (tileAt s) := + OpposingInterfaceGeometry.hSrho base a b s ι PP xi faceAt htileXi g0 is his + refine ⟨joinWalk faces, ?_, ?_, ?_, ?_, ?_⟩ + · exact ⟨PP.rho (faceAt f0), hpHead, by rw [hR]; exact hRrho⟩ + · exact ⟨PP.rho (faceAt g0), hpLast, by rw [hS]; exact hSrho⟩ + · apply hWalkChain.imp + intro x y hxy + rcases hxy.1 with ⟨a, ha, hedge⟩ + exact actualEdgeStep hedge + · intro x hx + obtain ⟨⟨a, ha, hxa⟩, ⟨b, hb, hxb⟩⟩ := hWalkVertices x hx + obtain ⟨A, hA, hAeq⟩ := forwardInterior a ha + obtain ⟨B, hB, hBeq⟩ := reverseInterior b hb + exact ⟨⟨A, hA, by rw [hAeq]; exact hxa⟩, + ⟨B, hB, by rw [hBeq]; exact hxb⟩⟩ + · intro x y l₁ l₂ heq + have hgood : goodE x y := + (List.isChain_iff_forall_rel_of_append_cons_cons.mp hWalkChain) heq + rcases hgood with ⟨⟨a, ha, hxa⟩, ⟨b, hb, hxb⟩⟩ + obtain ⟨A, hA, hAeq⟩ := forwardInterior a ha + obtain ⟨B, hB, hBeq⟩ := reverseInterior b hb + exact ⟨⟨A, hA, by rw [hAeq]; exact hxa⟩, + ⟨B, hB, by rw [hBeq]; exact hxb⟩⟩ + +end OpposingInterfaceConclusion + +namespace OpposingUnitInterface + +private theorem unrotatedInterface : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (R : ProtoTile), ∀ (S + : ProtoTile), ∀ (forward : List ProtoTile), ∀ (reverse : List ProtoTile), ∀ (a : + GaussianInt), ∀ (b : GaussianInt), ((0 : ℤ) < a.re * b.im - a.im * b.re) → ((a ∈ + TilingLattice C) → ((b ∈ TilingLattice C) → ((∀ (w : ↥(TilingLattice C)), ∃! z : ℤ × + ℤ, (↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b = (↑w : GaussianInt)) → ((∀ (U + : ProtoTile), U ∈ RegularTileFamily base (TilingLattice C) ↔ ∃! z : ℤ × ℤ, U = (fun + (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) + * b)) z) → ((∀ (x : ℤ × ℤ), ∀ (y : ℤ × ℤ), (fun (T U : ProtoTile) => if C.1.1.1 = (1 + : ℤ) then ∃ (v : GaussianInt), UnitTriangularStep orientation v ∧ TileCentroid U - + TileCentroid T = GaussianRealPoint v else TileTouching T U) ((fun (z : ℤ × ℤ) => + TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) x) ((fun + (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) + * b)) y) ↔ TriangularLatticeAdjacent x y) → ((∀ (x : ℤ × ℤ), ∀ (y : ℤ × ℤ), ∀ (z : ℤ + × ℤ), ((TileCentroid ((fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) + * a + (↑z.2 : GaussianInt) * b)) z)).2 - (TileCentroid ((fun (z : ℤ × ℤ) => + TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) x)).2) * + ((TileCentroid ((fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + + (↑z.2 : GaussianInt) * b)) y)).1 - (TileCentroid ((fun (z : ℤ × ℤ) => TileTranslation + base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) x)).1) - ((TileCentroid + ((fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : + GaussianInt) * b)) z)).1 - (TileCentroid ((fun (z : ℤ × ℤ) => TileTranslation base + ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) x)).1) * ((TileCentroid ((fun + (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) + * b)) y)).2 - (TileCentroid ((fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : + GaussianInt) * a + (↑z.2 : GaussianInt) * b)) x)).2) = (↑(a.re * b.im - a.im * b.re) + : ℝ) * (↑(TriangularSignedHeight x y z) : ℝ)) → ((∀ (R : ProtoTile), ∀ (S : + ProtoTile), ∀ (tiles : List ProtoTile), ∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), R = (fun (z : ℤ + × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) r + → S = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : + GaussianInt) * b)) s → (TileString C orientation base R S tiles ↔ ∃! coordinates : + List (ℤ × ℤ), List.Forall₂ (fun (T : ProtoTile) (z : ℤ × ℤ) => T = (fun (z : ℤ × ℤ) + => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) z) + tiles coordinates ∧ TriangularStripSegment r s coordinates)) → ( + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + ∀ (r : ℤ × ℤ), (R = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + + (↑z.2 : GaussianInt) * b)) r) → ((∀ (y : ℤ × ℤ), (fun (z : ℤ × ℤ) => R = (fun (z : ℤ + × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) + z) y → y = r) → (∀ (s : ℤ × ℤ), (S = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 + : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) s) → ((∀ (y : ℤ × ℤ), (fun (z : ℤ × + ℤ) => S = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 + : GaussianInt) * b)) z) y → y = s) → ((R = tileAt r) → ((S = tileAt s) → (∀ (F : List + (ℤ × ℤ)), ∀ (G : List (ℤ × ℤ)), (List.Forall₂ (fun (T : ProtoTile) (z : ℤ × ℤ) => T = + (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : + GaussianInt) * b)) z) forward F) → ((TriangularStripSegment r s F) → ((List.Forall₂ + (fun (T : ProtoTile) (z : ℤ × ℤ) => T = (fun (z : ℤ × ℤ) => TileTranslation base + ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) z) reverse G) → + ((TriangularStripSegment s r G) → ((r ≠ s) → ((¬TriangularLatticeAdjacent r s) → + ((List.Forall₂ (fun (T : ProtoTile) (z : ℤ × ℤ) => T = (fun (z : ℤ × ℤ) => + TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) z) + (List.drop (1 : ℕ) forward).dropLast (List.drop (1 : ℕ) F).dropLast) → ((List.Forall₂ + (fun (T : ProtoTile) (z : ℤ × ℤ) => T = (fun (z : ℤ × ℤ) => TileTranslation base + ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) z) (List.drop (1 : ℕ) + reverse).dropLast (List.drop (1 : ℕ) G).dropLast) → ((∀ z ∈ (List.drop (1 : ℕ) + F).dropLast, ∃ T ∈ (List.drop (1 : ℕ) forward).dropLast, T = (fun (z : ℤ × ℤ) => + TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) z) → ((∀ + z ∈ (List.drop (1 : ℕ) G).dropLast, ∃ T ∈ (List.drop (1 : ℕ) reverse).dropLast, T = + (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : + GaussianInt) * b)) z) → (∀ (x : GaussianInt), (base.cells = {x}) → ((a = (1 : + GaussianInt)) → ((b = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → (∃ p : List GaussianInt, + (∃ x, p.head? = some x ∧ x ∈ FootprintVertices R) ∧ (∃ y, p.getLast? = some y ∧ y ∈ + FootprintVertices S) ∧ p.IsChain (fun x y => y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ + y = x - ⟨0, 1⟩) ∧ (∀ x, x ∈ p → (∃ a ∈ (forward.drop 1).dropLast, x ∈ + FootprintVertices a) ∧ (∃ b ∈ (reverse.drop 1).dropLast, x ∈ FootprintVertices b)) ∧ + ∀ x y : GaussianInt, ∀ l₁ l₂ : List GaussianInt, p = l₁ ++ x :: y :: l₂ → (∃ a ∈ + (forward.drop 1).dropLast, {x, y} ∈ FootprintEdges a) ∧ (∃ b ∈ (reverse.drop + 1).dropLast, {x, y} ∈ FootprintEdges b)))))))))))))))))))))))))))) ) := by + classical + intro C orientation base R S forward reverse a b hdet ha hb hcoords hfamily hadj hheight + htransport tileAt r hrcoord hruniq s hscoord hsuniq hR hS F G hFtiles hFstrip hGtiles + hGstrip hrs hnadjCoord forall₂_interior rfor₂_interior forwardInterior reverseInterior x + hcells ha1 hb1 + subst a + subst b + obtain ⟨p, hphead, hplast, hpchain, hpvertices, hpedges⟩ := + UnitSquareOpposingStripInterfacePath x r s hrs hnadjCoord F G + hFstrip hGstrip + let unitAt : Int × Int → ProtoTile := fun z => + TileTranslation (⟨{x}, x⟩ : ProtoTile) + (⟨z.1, z.2⟩ : GaussianInt) + have hshift := OpposingInterfaceGeometry.hshift + have hcellsEq := OpposingInterfaceGeometry.hcellsEq base x hcells + (OpposingInterfaceGeometry.hshift') + have hvertsEq (z : Int × Int) : + FootprintVertices (tileAt z) = FootprintVertices (unitAt z) := + OpposingInterfaceGeometry.hvertsEqAt258 base x hcellsEq z + have hedgesEq (z : Int × Int) : + FootprintEdges (tileAt z) = FootprintEdges (unitAt z) := + OpposingInterfaceGeometry.hedgesEqAt266 base x hcellsEq z + refine ⟨p, ?_, ?_, hpchain, ?_, ?_⟩ + · rcases hphead with ⟨v, hv, hvU⟩ + have hvU' : v ∈ FootprintVertices (unitAt r) := by simpa [unitAt] using hvU + exact ⟨v, hv, by rw [hR, hvertsEq]; exact hvU'⟩ + · rcases hplast with ⟨v, hv, hvU⟩ + have hvU' : v ∈ FootprintVertices (unitAt s) := by simpa [unitAt] using hvU + exact ⟨v, hv, by rw [hS, hvertsEq]; exact hvU'⟩ + · intro v hv + obtain ⟨a', ha', hav⟩ := (hpvertices v hv).1 + obtain ⟨b', hb', hbv⟩ := (hpvertices v hv).2 + have hav' : v ∈ FootprintVertices (unitAt a') := by simpa [unitAt] using hav + have hbv' : v ∈ FootprintVertices (unitAt b') := by simpa [unitAt] using hbv + obtain ⟨A, hA, hAeq⟩ := forwardInterior a' ha' + obtain ⟨B, hB, hBeq⟩ := reverseInterior b' hb' + refine ⟨⟨A, hA, ?_⟩, ⟨B, hB, ?_⟩⟩ + · rw [hAeq, hvertsEq] + exact hav' + · rw [hBeq, hvertsEq] + exact hbv' + · intro v w l₁ l₂ hp + obtain ⟨a', ha', hEdgeA⟩ := (hpedges v w l₁ l₂ hp).1 + obtain ⟨b', hb', hEdgeB⟩ := (hpedges v w l₁ l₂ hp).2 + have hEdgeA' : {v, w} ∈ FootprintEdges (unitAt a') := by simpa [unitAt] using hEdgeA + have hEdgeB' : {v, w} ∈ FootprintEdges (unitAt b') := by simpa [unitAt] using hEdgeB + obtain ⟨A, hA, hAeq⟩ := forwardInterior a' ha' + obtain ⟨B, hB, hBeq⟩ := reverseInterior b' hb' + refine ⟨⟨A, hA, ?_⟩, ⟨B, hB, ?_⟩⟩ + · rw [hAeq, hedgesEq] + exact hEdgeA' + · rw [hBeq, hedgesEq] + exact hEdgeB' + +end OpposingUnitInterface + +theorem OpposingStringInterfacePath + (C : BandCircle) (orientation : Bool) (base R S : ProtoTile) + (hRS : R ≠ S) + (hnadj : ¬ (if C.1.1.1 = 1 then + ∃ v : GaussianInt, + UnitTriangularStep orientation v ∧ + TileCentroid S - TileCentroid R = GaussianRealPoint v + else TileTouching R S)) + (forward reverse : List ProtoTile) + (hf : TileString C orientation base R S forward) + (hr : TileString C orientation base S R reverse) : + ∃ p : List GaussianInt, + (∃ x, p.head? = some x ∧ x ∈ FootprintVertices R) ∧ + (∃ y, p.getLast? = some y ∧ y ∈ FootprintVertices S) ∧ + p.IsChain (fun x y => + y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) ∧ + (∀ x, x ∈ p → + (∃ a ∈ (forward.drop 1).dropLast, + x ∈ FootprintVertices a) ∧ + (∃ b ∈ (reverse.drop 1).dropLast, + x ∈ FootprintVertices b)) ∧ + ∀ x y : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ x :: y :: l₂ → + (∃ a ∈ (forward.drop 1).dropLast, + {x, y} ∈ FootprintEdges a) ∧ + (∃ b ∈ (reverse.drop 1).dropLast, + {x, y} ∈ FootprintEdges b) := by +-- BODY + have hforward := hf + have hreverse := hr + rcases hf with ⟨hbase, hfhead, hflast, _, hfin, _, _⟩ + rcases hr with ⟨_, hrhead, hrlast, _, hrin, _, _⟩ + obtain ⟨a, b, hdet, ha, hb, hcoords, hcertificate, hfamily, hadj, + hheight, htransport⟩ := + TileStringCoordinateTransport C orientation base hbase + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + have hRfam : R ∈ RegularTileFamily base (TilingLattice C) := hfin R + (OpposingInterfaceGeometry.hRmem R forward hfhead) + have hSfam : S ∈ RegularTileFamily base (TilingLattice C) := by + exact hfin S (OpposingInterfaceGeometry.hSmem S forward hflast) + obtain ⟨r, hrcoord, hruniq⟩ := (hfamily R).mp hRfam + obtain ⟨s, hscoord, hsuniq⟩ := (hfamily S).mp hSfam + have hR : R = tileAt r := hrcoord + have hS : S = tileAt s := hscoord + obtain ⟨F, hF, _⟩ := (htransport R S forward r s hR hS).mp hforward + obtain ⟨G, hG, _⟩ := (htransport S R reverse s r hS hR).mp hreverse + rcases hF with ⟨hFtiles, hFstrip⟩ + rcases hG with ⟨hGtiles, hGstrip⟩ + have hrs := OpposingInterfaceGeometry.hrs base R S hRS a b r s hR hS + have hnadjCoord := OpposingInterfaceGeometry.hnadjCoord C orientation base R S hnadj a b hadj r + s hR hS + have forall₂_dropLast {α β : Type} {Rel : α → β → Prop} + {xs : List α} {ys : List β} (hall : List.Forall₂ Rel xs ys) := + OpposingInterfaceGeometry.forall₂_dropLast (α := α) (β := β) (Rel := Rel) (xs := xs) + (ys := ys) hall + have forall₂_interior := + forall₂_dropLast (List.forall₂_drop 1 hFtiles) + have rfor₂_interior := + forall₂_dropLast (List.forall₂_drop 1 hGtiles) + have forall₂_mem {α β : Type} {Rel : α → β → Prop} + {xs : List α} {ys : List β} (hall : List.Forall₂ Rel xs ys) := + OpposingInterfaceGeometry.forall₂_mem (α := α) (β := β) (Rel := Rel) (xs := xs) (ys := + ys) hall + have forwardInterior := OpposingInterfaceGeometry.forwardInterior base forward a b F + forall₂_interior forall₂_mem + have reverseInterior := OpposingInterfaceGeometry.reverseInterior base reverse a b G + rfor₂_interior forall₂_mem + rcases hcertificate with hunit | hnonunit + · rcases hunit with ⟨hcurv, horient⟩ + obtain ⟨x, hcells⟩ := + CurvatureOneBandPrototileSingleton C base hcurv hbase + rcases horient with ⟨horient, ha1, hb1⟩ | ⟨horient, haI, hbM⟩ + · have unrotatedInterface : + ∃ p : List GaussianInt, + (∃ x, p.head? = some x ∧ x ∈ FootprintVertices R) ∧ + (∃ y, p.getLast? = some y ∧ y ∈ FootprintVertices S) ∧ + p.IsChain (fun x y => + y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) ∧ + (∀ x, x ∈ p → + (∃ a ∈ (forward.drop 1).dropLast, + x ∈ FootprintVertices a) ∧ + (∃ b ∈ (reverse.drop 1).dropLast, + x ∈ FootprintVertices b)) ∧ + ∀ x y : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ x :: y :: l₂ → + (∃ a ∈ (forward.drop 1).dropLast, + {x, y} ∈ FootprintEdges a) ∧ + (∃ b ∈ (reverse.drop 1).dropLast, + {x, y} ∈ FootprintEdges b) := OpposingUnitInterface.unrotatedInterface C + orientation base R S forward reverse a b hdet ha hb hcoords hfamily hadj + hheight htransport r hrcoord hruniq s hscoord hsuniq hR hS F G hFtiles + hFstrip hGtiles hGstrip hrs hnadjCoord forall₂_interior rfor₂_interior + forwardInterior reverseInterior x hcells ha1 hb1 + exact unrotatedInterface + · subst a + subst b + let x0 : GaussianInt := ⟨x.im, -x.re - 1⟩ + have hx0 : GaussianQuarterTurn x0 - 1 = x := by + ext <;> simp [x0, GaussianQuarterTurn] + let unitAt : Int × Int → ProtoTile := fun z => + TileTranslation (⟨{x0}, x0⟩ : ProtoTile) + (⟨z.1, z.2⟩ : GaussianInt) + let turnedAt : Int × Int → ProtoTile := fun z => TileQuarterTurn (unitAt z) + have hcellCalc := OpposingInterfaceGeometry.hcellCalc C base x hcells + have hvertsEq (z : Int × Int) : + FootprintVertices (tileAt z) = FootprintVertices (turnedAt z) := + OpposingInterfaceGeometry.hvertsEqAt314 base x hcellCalc z + have hedgesEq (z : Int × Int) : + FootprintEdges (tileAt z) = FootprintEdges (turnedAt z) := + OpposingInterfaceGeometry.hedgesEqAt322 base x hcellCalc z + obtain ⟨p, hphead, hplast, hpchain, hpvertices, hpedges⟩ := + UnitSquareOpposingStripInterfacePath x0 r s hrs hnadjCoord F G + hFstrip hGstrip + let q := GaussianQuarterTurn + let qInv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + have hqInv (z : GaussianInt) : qInv (q z) = z := by + ext <;> simp [qInv, q, GaussianQuarterTurn] + have hqInv' (z : GaussianInt) : q (qInv z) = z := by + ext <;> simp [qInv, q, GaussianQuarterTurn] + have hqverts (z : Int × Int) : + FootprintVertices (turnedAt z) = q '' FootprintVertices (unitAt z) := + OpposingInterfaceGeometry.hqverts x z + have hqedges := OpposingInterfaceGeometry.hqedges x + refine ⟨p.map q, ?_, ?_, (OpposingInterfaceGeometry.hqchain p hpchain + (OpposingInterfaceGeometry.qstep C)), ?_, ?_⟩ + · rcases hphead with ⟨v, hv, hvU⟩ + have hvU' : v ∈ FootprintVertices (unitAt r) := by + simpa [unitAt] using hvU + refine ⟨q v, ?_, ?_⟩ + · simp [List.head?_map, hv] + · rw [hR, hvertsEq, hqverts] + exact Set.mem_image_of_mem q hvU' + · rcases hplast with ⟨v, hv, hvU⟩ + have hvU' : v ∈ FootprintVertices (unitAt s) := by + simpa [unitAt] using hvU + refine ⟨q v, ?_, ?_⟩ + · simp [List.getLast?_map, hv] + · rw [hS, hvertsEq, hqverts] + exact Set.mem_image_of_mem q hvU' + · intro v hv + have hvp : ∃ u ∈ p, q u = v := by + simpa [q] using (List.mem_map.mp hv) + obtain ⟨u, hup, rfl⟩ := hvp + obtain ⟨a', ha', hav⟩ := (hpvertices u hup).1 + obtain ⟨b', hb', hbv⟩ := (hpvertices u hup).2 + have hav' : u ∈ FootprintVertices (unitAt a') := by simpa [unitAt] using hav + have hbv' : u ∈ FootprintVertices (unitAt b') := by simpa [unitAt] using hbv + obtain ⟨A, hA, hAeq⟩ := forwardInterior a' ha' + obtain ⟨B, hB, hBeq⟩ := reverseInterior b' hb' + refine ⟨⟨A, hA, ?_⟩, ⟨B, hB, ?_⟩⟩ + · rw [hAeq, hvertsEq, hqverts] + exact Set.mem_image_of_mem q hav' + · rw [hBeq, hvertsEq, hqverts] + exact Set.mem_image_of_mem q hbv' + · intro v w l₁ l₂ hp + have hpOrig := OpposingInterfaceGeometry.hpOrig p hqInv v w l₁ l₂ hp + obtain ⟨a', ha', hEdgeA⟩ := hpedges (qInv v) (qInv w) + (l₁.map qInv) (l₂.map qInv) hpOrig |>.1 + obtain ⟨b', hb', hEdgeB⟩ := hpedges (qInv v) (qInv w) + (l₁.map qInv) (l₂.map qInv) hpOrig |>.2 + have hEdgeA' : {v, w} ∈ FootprintEdges (turnedAt a') := + OpposingInterfaceGeometry.hEdgeA'At404 x hqInv' hqedges v w a' hEdgeA + have hEdgeB' : {v, w} ∈ FootprintEdges (turnedAt b') := + OpposingInterfaceGeometry.hEdgeB'At409 x hqInv' hqedges v w b' hEdgeB + obtain ⟨A, hA, hAeq⟩ := forwardInterior a' ha' + obtain ⟨B, hB, hBeq⟩ := reverseInterior b' hb' + refine ⟨⟨A, hA, ?_⟩, ⟨B, hB, ?_⟩⟩ + · rw [hAeq, hedgesEq] + exact hEdgeA' + · rw [hBeq, hedgesEq] + exact hEdgeB' + · rcases hnonunit with ⟨hcurv, q, hq, hqC, hbasis⟩ + have hbaseQ : BandPrototile (q 0) base := by + simpa [hqC] using hbase + obtain ⟨faces, hfacesNe, hfirst, hlast, hfaceVertices, hfaceChain⟩ := + AffineOpposingStripCorridor r s hrs hnadjCoord F G hFstrip hGstrip + obtain ⟨P, hPlattice, hPtiles, hPadj, hPposition, hPvertexReps, + hPedgeReps, hPfaceReps, hchart⟩ := + BandRegularTranslatePeriodicComplex C q hq hqC base hbaseQ + rcases hchart with ⟨chart⟩ + have finish {ι : Type} [DecidableEq ι] (PP : PeriodicTileComplex ι) + (xi : Int × Int → ι) (faceAt : AffineTriangularFace → PP.plane.Face) + (hadjXi : ∀ u v, TriangularLatticeAdjacent u v ↔ + PP.plane.adjacent (xi u) (xi v)) + (htileXi : ∀ z, PP.tile (xi z) = tileAt z) + (hinjFace : Function.Injective faceAt) + (hinc : ∀ f, (AffineTriangularFaceVertices f).image xi = + {PP.plane.faceVertex (faceAt f) 0, + PP.plane.faceVertex (faceAt f) 1, + PP.plane.faceVertex (faceAt f) 2}) := OpposingInterfaceConclusion.finish base R S + forward reverse a b r hrcoord hruniq s hscoord hsuniq hR hS F G hFstrip hGstrip + hrs hnadjCoord forwardInterior reverseInterior faces hfacesNe hfirst hlast + hfaceVertices hfaceChain (ι := ι) PP xi faceAt hadjXi htileXi hinjFace hinc + rcases hbasis with hordered | hswapped + · rcases hordered with ⟨haV, hbV⟩ + let faceAt : AffineTriangularFace → P.plane.Face := fun f => + match f with + | .up z => chart.up z + | .down z => chart.down z + have hadjXi (u v : Int × Int) : TriangularLatticeAdjacent u v ↔ + P.plane.adjacent (chart.vertexEquiv u) (chart.vertexEquiv v) := + (chart.adjacent_iff u v).symm + have hinjFace := OpposingInterfaceGeometry.hinjFaceAt766 C base q P chart + have hinc := OpposingInterfaceGeometry.hincAt777 C base q P chart + exact finish P chart.vertexEquiv faceAt hadjXi (OpposingInterfaceGeometry.htileAlign C base + a b q P chart haV hbV) hinjFace hinc + · rcases hswapped with ⟨haV, hbV⟩ + have halign := SwappedAffineTriangularChartAlignment P base + (BandVectors.1 (q 1) (q 0)) (BandVectors.1 (q 2) (q 0)) chart + let xi := fun z : Int × Int => + chart.vertexEquiv (Prod.swap z) + let faceAt : AffineTriangularFace → P.plane.Face := fun f => + match AffineTriangularFaceCoordinateSwap f with + | .up z => chart.up z + | .down z => chart.down z + have hadjXi := OpposingInterfaceGeometry.hadjXiAt795 C base F q P chart halign + have htileXi := OpposingInterfaceGeometry.htileXi C base a b F q P chart haV hbV halign + have hinjFace := OpposingInterfaceGeometry.hinjFaceAt805 C base q P chart + have hinc := OpposingInterfaceGeometry.hincAt826 C base F q P chart halign + exact finish P xi faceAt hadjXi htileXi hinjFace hinc + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean b/LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean new file mode 100644 index 0000000000..2b992c3c86 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean @@ -0,0 +1,195 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary + +-- [TABLET NODE: OppositeRoutedCommonEdgeOutsideCellUnique] + +/-! +# OppositeRoutedCommonEdgeOutsideCellUnique + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem OppositeRoutedCommonEdgeOutsideCellUnique + (E F : ProtoTile) (x : GaussianInt) (j : Fin 4) + (edge : Finset GaussianInt) + (hdisjoint : Disjoint E.cells F.cells) + (hx : x ∈ edge) + (hedge : edge ∈ FootprintEdges E ∩ FootprintEdges F) + (hE : LatticeVertexIncidentCell x j ∈ E.cells) + (hF : LatticeVertexIncidentCell x (j + 2) ∈ F.cells) : + ∀ r s : Fin 4, + LatticeVertexIncidentCell x r ∉ E.cells → + LatticeVertexIncidentCell x r ∉ F.cells → + LatticeVertexIncidentCell x s ∉ E.cells → + LatticeVertexIncidentCell x s ∉ F.cells → + LatticeVertexIncidentCell x r = LatticeVertexIncidentCell x s := by +-- BODY + let I : GaussianInt := ⟨0, 1⟩ + have horiz_unique (u v : GaussianInt) + (h : ({u, u + 1} : Finset GaussianInt) = {v, v + 1}) : u = v := by + have hu : u = v ∨ u = v + 1 := by + have : u ∈ ({v, v + 1} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hv : v = u ∨ v = u + 1 := by + have : v ∈ ({u, u + 1} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hu with huv | huv + · exact huv + rcases hv with hvu | hvu + · exact hvu.symm + · have hre := congrArg Zsqrtd.re huv + have hre' := congrArg Zsqrtd.re hvu + norm_num at hre hre' + omega + have vert_unique (u v : GaussianInt) + (h : ({u, u + I} : Finset GaussianInt) = {v, v + I}) : u = v := by + have hu : u = v ∨ u = v + I := by + have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hv : v = u ∨ v = u + I := by + have : v ∈ ({u, u + I} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hu with huv | huv + · exact huv + rcases hv with hvu | hvu + · exact hvu.symm + · have him := congrArg Zsqrtd.im huv + have him' := congrArg Zsqrtd.im hvu + simp [I] at him him' + omega + have horiz_ne_vert (u v : GaussianInt) : + ({u, u + 1} : Finset GaussianInt) ≠ {v, v + I} := by + intro h + have hu : u = v ∨ u = v + I := by + have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hu1 : u + 1 = v ∨ u + 1 = v + I := by + have : u + 1 ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + rcases hu with hu | hu <;> rcases hu1 with hu1 | hu1 + all_goals + have hre := congrArg Zsqrtd.re hu + have him := congrArg Zsqrtd.im hu + have hre1 := congrArg Zsqrtd.re hu1 + have him1 := congrArg Zsqrtd.im hu1 + simp [I] at hre him hre1 him1 + omega + -- A common boundary edge separates a consecutive pair of occupied cells. + have common_edge_transition (U V : ProtoTile) (y : GaussianInt) + (e : Finset GaussianInt) (hdUV : Disjoint U.cells V.cells) + (hye : y ∈ e) + (he : e ∈ BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V) : + ∃ a : Fin 4, + ((LatticeVertexIncidentCell y a ∈ U.cells ∧ + LatticeVertexIncidentCell y (a + 1) ∈ V.cells) ∨ + (LatticeVertexIncidentCell y a ∈ V.cells ∧ + LatticeVertexIncidentCell y (a + 1) ∈ U.cells)) := by + have hd := Finset.disjoint_left.mp hdUV + rcases he.1 with ⟨u, ⟨heu, hu⟩ | ⟨heu, hu⟩⟩ + · rcases he.2 with ⟨v, ⟨hev, hv⟩ | ⟨hev, hv⟩⟩ + · have huv : u = v := horiz_unique u v (heu.symm.trans hev) + subst v + have hyuv : y = u ∨ y = u + 1 := by + rw [heu] at hye + simpa using hye + rcases hyuv with rfl | rfl + · rcases hu with hu | hu <;> rcases hv with hv | hv + · exact (hd hu.1 hv.1).elim + · refine ⟨3, Or.inr ⟨?_, ?_⟩⟩ + · simpa [LatticeVertexIncidentCell, I] using hv.2 + · simpa [LatticeVertexIncidentCell, I] using hu.1 + · refine ⟨3, Or.inl ⟨?_, ?_⟩⟩ + · simpa [LatticeVertexIncidentCell, I] using hu.2 + · simpa [LatticeVertexIncidentCell, I] using hv.1 + · exact (hd hu.2 hv.2).elim + · rcases hu with hu | hu <;> rcases hv with hv | hv + · exact (hd hu.1 hv.1).elim + · refine ⟨1, Or.inl ⟨?_, ?_⟩⟩ + · simpa [LatticeVertexIncidentCell, I] using hu.1 + · simpa [LatticeVertexIncidentCell, I] using hv.2 + · refine ⟨1, Or.inr ⟨?_, ?_⟩⟩ + · simpa [LatticeVertexIncidentCell, I] using hv.1 + · simpa [LatticeVertexIncidentCell, I] using hu.2 + · exact (hd hu.2 hv.2).elim + · exact (horiz_ne_vert u v (heu.symm.trans hev)).elim + · rcases he.2 with ⟨v, ⟨hev, hv⟩ | ⟨hev, hv⟩⟩ + · exact (horiz_ne_vert v u (hev.symm.trans heu)).elim + · have huv : u = v := vert_unique u v (heu.symm.trans hev) + subst v + have hyuv : y = u ∨ y = u + I := by + rw [heu] at hye + simpa using hye + rcases hyuv with rfl | rfl + · rcases hu with hu | hu <;> rcases hv with hv | hv + · exact (hd hu.1 hv.1).elim + · refine ⟨0, Or.inl ⟨?_, ?_⟩⟩ + · simpa [LatticeVertexIncidentCell, I] using hu.1 + · simpa [LatticeVertexIncidentCell, I] using hv.2 + · refine ⟨0, Or.inr ⟨?_, ?_⟩⟩ + · simpa [LatticeVertexIncidentCell, I] using hv.1 + · simpa [LatticeVertexIncidentCell, I] using hu.2 + · exact (hd hu.2 hv.2).elim + · have hcell2 : LatticeVertexIncidentCell (u + I) 2 = u - 1 := by + ext <;> simp [LatticeVertexIncidentCell, I] + have hcell3 : LatticeVertexIncidentCell (u + I) 3 = u := by + simp [LatticeVertexIncidentCell, I] + rcases hu with hu | hu <;> rcases hv with hv | hv + · exact (hd hu.1 hv.1).elim + · refine ⟨2, Or.inr ⟨?_, ?_⟩⟩ + · simpa only [hcell2] using hv.2 + · simpa only [show (2 : Fin 4) + 1 = 3 from rfl, hcell3] using hu.1 + · refine ⟨2, Or.inl ⟨?_, ?_⟩⟩ + · simpa only [hcell2] using hu.2 + · simpa only [show (2 : Fin 4) + 1 = 3 from rfl, hcell3] using hv.1 + · exact (hd hu.2 hv.2).elim + have hboundary : edge ∈ BoundaryFootprintEdges E ∩ BoundaryFootprintEdges F := by + rw [← CellDisjointCommonEdgesBoundary E F hdisjoint] + exact hedge + obtain ⟨a, ha⟩ := common_edge_transition E F x edge hdisjoint hx hboundary + have ha0 : LatticeVertexIncidentCell x a ∈ E.cells ∨ + LatticeVertexIncidentCell x a ∈ F.cells := by + rcases ha with ha | ha + · exact Or.inl ha.1 + · exact Or.inr ha.1 + have ha1 : LatticeVertexIncidentCell x (a + 1) ∈ E.cells ∨ + LatticeVertexIncidentCell x (a + 1) ∈ F.cells := by + rcases ha with ha | ha + · exact Or.inr ha.2 + · exact Or.inl ha.2 + have remaining_unique : ∀ a j r s : Fin 4, + (r ≠ a ∧ r ≠ a + 1 ∧ r ≠ j ∧ r ≠ j + 2) → + (s ≠ a ∧ s ≠ a + 1 ∧ s ≠ j ∧ s ≠ j + 2) → r = s := by + decide +kernel + intro r s hrE hrF hsE hsF + have absent (t : Fin 4) + (htE : LatticeVertexIncidentCell x t ∉ E.cells) + (htF : LatticeVertexIncidentCell x t ∉ F.cells) : + t ≠ a ∧ t ≠ a + 1 ∧ t ≠ j ∧ t ≠ j + 2 := by + refine ⟨?_, ?_, ?_, ?_⟩ + · rintro rfl + exact ha0.elim htE htF + · rintro rfl + exact ha1.elim htE htF + · rintro rfl + exact htE hE + · rintro rfl + exact htF hF + exact congrArg (LatticeVertexIncidentCell x) + (remaining_unique a j r s (absent r hrE hrF) (absent s hsE hsF)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean b/LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean new file mode 100644 index 0000000000..5d4bf4e47f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean @@ -0,0 +1,543 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout +public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryMarkedDataCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.P4261T1CentralCoordinates +public import LeanPool.ApollonianSuperharmonic.P4261T1RightCoordinates +public import LeanPool.ApollonianSuperharmonic.P4261T1EdgeExterior +public import LeanPool.ApollonianSuperharmonic.P4261T1SubtileCoordinates +public import LeanPool.ApollonianSuperharmonic.P4261T1ExteriorAdjacency +public import LeanPool.ApollonianSuperharmonic.P4261T1ContactAdjacency + +-- [TABLET NODE: OrderedGeneralOdometerAdjacencyClassification] + +/-! +# OrderedGeneralOdometerAdjacencyClassification + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OdometerAdjacencyGeometry + +private theorem normalize : + (by + classical + exact + ∀ (C : BandCircle), (¬((∃ (g : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction g (FordCircleCoordinate P.p P.q) = C.1.1) ∨ ∃ (g : + BandPackingSymmetry) (K : DiamondParameter), BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ))) = C.1.1)) → (∀ (q : Fin 4 → + CircleCoordinates), (ProperBandQuadruple q) → ((q 0 = C.1.1) → (∃ (g : + BandPackingSymmetry) (qbar : Fin 4 → CircleCoordinates), Nonempty + (BandOrderedGeneralConfiguration qbar) ∧ qbar 0 = BandPackingSymmetryCircleAction g + C.1.1))) ) := by + classical + intro C horbit q hq hqC + obtain ⟨r, g, hregime⟩ := BandRegimeClassification q hq + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + let qbar := BandPackingSymmetryQuadrupleAction g qrot + have hchild : qbar 0 = BandPackingSymmetryCircleAction g C.1.1 := by + simp [qbar, qrot, BandPackingSymmetryQuadrupleAction, hqC] + obtain ⟨ginv, hcancel, _⟩ := BandPackingSymmetryInversePhaseCancellation.2 g + have hgeneral : Nonempty (BandOrderedGeneralConfiguration qbar) := by + change Xor (∃ P : FordFareyParameter, 1 < P.q ∧ + qbar = FordRecursiveQuadruple P) + (Xor (∃ K : DiamondParameter, 1 < K.1 ∧ qbar = DiamondRecursiveQuadruple K) + (Nonempty (BandOrderedGeneralConfiguration qbar))) at hregime + rcases hregime with ⟨⟨P, _, heq⟩, _⟩ | ⟨hrest, _⟩ + · exfalso + apply horbit + left + refine ⟨ginv, P, ?_⟩ + have he : FordCircleCoordinate P.p P.q = + BandPackingSymmetryCircleAction g C.1.1 := by + simpa [heq, FordRecursiveQuadruple] using hchild + rw [he, hcancel] + · rcases hrest with ⟨⟨K, _, heq⟩, _⟩ | ⟨hgeneral, _⟩ + · exfalso + apply horbit + right + refine ⟨ginv, K, ?_⟩ + have he : DiamondRecursiveQuadruple K 0 = + BandPackingSymmetryCircleAction g C.1.1 := by + simpa [heq] using hchild + rw [he, hcancel] + · exact hgeneral + exact ⟨g, qbar, hgeneral, hchild⟩ + +private theorem imageCircle : + (by + classical + exact + (-(1 : Fin 3) = 2) → ((-(2 : Fin 3) = 1) → (∀ (g : BandPackingSymmetry), ∀ (D : + BandCircle), ∀ (p : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → (∀ (j : Fin + 4), (p j = D.1.1) → (∃ Dg : BandCircle, Dg.1.1 = BandPackingSymmetryCircleAction g + D.1.1)))) ) := by + classical + intro neg1 neg2 g D p hp j hj + let pg := BandPackingSymmetryQuadrupleAction g p + have hpg := BandPackingSymmetryProperCovariance g p hp + have hpos : 0 < (BandPackingSymmetryCircleAction g D.1.1).1 := by + rw [(BandPackingSymmetryCovariance g).1] + exact D.2 + have hoccurs : ∃ k : Fin 4, pg k = BandPackingSymmetryCircleAction g D.1.1 := by + cases hrev : BandPackingSymmetryReversesOrientation g <;> fin_cases j + all_goals + first + | exact ⟨0, by simpa [pg, BandPackingSymmetryQuadrupleAction, hrev, neg1, neg2] using + (congrArg (BandPackingSymmetryCircleAction g) hj)⟩ + | exact ⟨1, by simpa [pg, BandPackingSymmetryQuadrupleAction, hrev, neg1, neg2] using + (congrArg (BandPackingSymmetryCircleAction g) hj)⟩ + | exact ⟨2, by simpa [pg, BandPackingSymmetryQuadrupleAction, hrev, neg1, neg2] using + (congrArg (BandPackingSymmetryCircleAction g) hj)⟩ + | exact ⟨3, by simpa [pg, BandPackingSymmetryQuadrupleAction, hrev, neg1, neg2] using + (congrArg (BandPackingSymmetryCircleAction g) hj)⟩ + obtain ⟨k, hk⟩ := hoccurs + exact ⟨⟨⟨BandPackingSymmetryCircleAction g D.1.1, + Or.inl hpos, pg, hpg.1, k, hk⟩, hpos⟩, rfl⟩ + +private theorem transportS : + (by + classical + exact + (-(1 : Fin 3) = 2) → ((-(2 : Fin 3) = 1) → (∀ (g : BandPackingSymmetry), ∀ (A : + BandCircle), ∀ (B : BandCircle), ∀ (Ag : BandCircle), ∀ (Bg : BandCircle), (Ag.1.1 = + BandPackingSymmetryCircleAction g A.1.1) → ((Bg.1.1 = BandPackingSymmetryCircleAction + g B.1.1) → (∀ (V : ProtoTile), ∀ (W : ProtoTile), ∀ (f : PartialOdometer), ∀ (k : + PartialOdometer), (SubtileLatticeAdjacent A B V W f k) → (SubtileLatticeAdjacent Ag + Bg (BandPackingSymmetryTileAction g V) (BandPackingSymmetryTileAction g W) + (BandPackingSymmetryPartialOdometerAction g f) + (BandPackingSymmetryPartialOdometerAction g k)))))) ) := by + classical + intro neg1 neg2 g A B Ag Bg hA hB V W f k hadj + rcases hadj with ⟨hf, hk, p, p', hp, hp', q, i, s, hq, hqA, hqiB, hc, hx, hy⟩ + have hfq : TileOdometer (q 0) V f := by simpa [hqA] using hf + have hkq : TileOdometer (q i.succ) W k := by simpa [hqiB] using hk + have hpos : 0 < (q i.succ).1 := by simpa [hqiB] using B.2 + obtain ⟨d, r, r', s', _, _, hfg, hkg, hpr, hpr', hcg, hxg, hyg, _⟩ := + SubtileLatticeAdjacentPackingSymmetryTransport g q hq i s hpos + V W f k p p' hfq hkq hp hp' hc hx hy + let qg := BandPackingSymmetryQuadrupleAction g q + let ig : Fin 3 := if BandPackingSymmetryReversesOrientation g then -i else i + have hqgA : qg 0 = Ag.1.1 := by + simp [qg, BandPackingSymmetryQuadrupleAction, hqA, hA] + have hqgB : qg ig.succ = Bg.1.1 := by + calc + qg ig.succ = BandPackingSymmetryCircleAction g (q i.succ) := by + cases hrev : BandPackingSymmetryReversesOrientation g <;> fin_cases i <;> + simp [qg, ig, BandPackingSymmetryQuadrupleAction, hrev, neg1, neg2] + _ = Bg.1.1 := (congrArg (BandPackingSymmetryCircleAction g) hqiB).trans hB.symm + refine ⟨by simpa only [← hqgA] using hfg, + by simpa only [← hqgB] using hkg, r, r', hpr, hpr', qg, ig, s', + BandPackingSymmetryProperCovariance g q hq, hqgA, hqgB, hcg, hxg, hyg⟩ + +private theorem transportL : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (A : BandCircle), ∀ (Ag : BandCircle), (Ag.1.1 = + BandPackingSymmetryCircleAction g A.1.1) → (∀ (V : ProtoTile), ∀ (W : ProtoTile), ∀ + (f : PartialOdometer), ∀ (k : PartialOdometer), (1 < A.1.1.1) → ((LeftLatticeAdjacent + A V W f k) → (LeftLatticeAdjacent Ag (BandPackingSymmetryTileAction g V) + (BandPackingSymmetryTileAction g W) (BandPackingSymmetryPartialOdometerAction g f) + (BandPackingSymmetryPartialOdometerAction g k)))) ) := by + classical + intro g A Ag hA V W f k hlarge hadj + rcases hadj with ⟨hf, hk, p, p', hp, hp', hunit | hproper⟩ + · omega + rcases hproper with ⟨q, i, e, hq, hqA, hc, hx, hy⟩ + have hfq : TileOdometer (q 0) V f := by simpa [hqA] using hf + have hkq : TileOdometer (q 0) W k := by simpa [hqA] using hk + obtain ⟨d, r, r', _, hfg, hkg, hpr, hpr', hcg, hxg, hyg, _⟩ := + LeftLatticeAdjacentPackingSymmetryTransport g q hq i e V W f k + p p' hfq hkq hp hp' hc hx hy + have hqgA : BandPackingSymmetryQuadrupleAction g q 0 = Ag.1.1 := by + simp [BandPackingSymmetryQuadrupleAction, hqA, hA] + refine ⟨by simpa only [← hqgA] using hfg, + by simpa only [← hqgA] using hkg, r, r', hpr, hpr', + Or.inr ⟨BandPackingSymmetryQuadrupleAction g q, + (if BandPackingSymmetryReversesOrientation g then -i else i), xor e d, + BandPackingSymmetryProperCovariance g q hq, hqgA, hcg, hxg, hyg⟩⟩ + +private theorem layout : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (D : + BandCircle), (q 0 = D.1.1) → (∀ (V : ProtoTile), (BandPrototile (q 0) V) → (Nonempty + (BandOrderedGeneralLayoutCertificate q cfg D V))) ) := by + classical + intro q cfg D hD V hV + apply BandOrderedGeneralLayout q cfg D hD V hV + · intro p W S hp hW hS hcover _ + have facts := BandTileSimultaneousInduction p hp W hW + exact ⟨facts.1, facts.2.1, facts.2.2.1 S hS hcover⟩ + · intro E W hW _ + cases hW with + | line w x hw => simp [QuarterTurnSymmetric, TileRealization] + | unit z x anchor => + intro p + norm_num [TileRealization, TileCentroid, ClosedSquareRealization] + constructor <;> rintro ⟨⟨h1, h2⟩, h3, h4⟩ + all_goals constructor <;> constructor <;> linarith + | decompose hp hS hcells hfoot hcent => + exact (BandTileSimultaneousInduction _ hp _ + (.decompose hp hS hcells hfoot hcent)).2.2.2.1 + · intro p W U hp hW _ hlarge i hU hc + exact (BandTileSimultaneousInduction p hp W hW).2.2.2.2.2.1 hlarge i U hU hc + · intro p W U Z hp hW _ i hU hZ hcU hcZ + exact (BandTileSimultaneousInduction p hp W hW).2.2.2.2.2.2.1 i U Z hU hZ hcU hcZ + +private theorem hgsubAt296 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (C' : BandCircle), ∀ + (T' : ProtoTile), ∀ (h' : PartialOdometer), (TileSubodometer C.1.1 C'.1.1 T T' h h') + → (∀ (g : BandPackingSymmetry), ∀ + (Cg : BandCircle), (Cg.1.1 = BandPackingSymmetryCircleAction g C.1.1) → (∀ (Dg : + BandCircle), (Dg.1.1 = BandPackingSymmetryCircleAction g C'.1.1) → (TileSubodometer + Cg.1.1 Dg.1.1 (BandPackingSymmetryTileAction + g T) (BandPackingSymmetryTileAction g T') (BandPackingSymmetryPartialOdometerAction g + h) (BandPackingSymmetryPartialOdometerAction g h')))) ) := by + classical + intro C T h C' T' h' hsub g Cg hCg Dg hDg + rw [hCg, hDg] + exact (BandPackingSymmetryMarkedDataCovariance.1 g _ _ _ _ _ _).mp hsub + +private theorem hedgeg : + (by + classical + exact + ∀ (T₀ : ProtoTile), ∀ (T' : ProtoTile), ((FootprintEdges T' ∩ FootprintEdges + T₀).Nonempty) → (∀ (g : BandPackingSymmetry), (FootprintEdges + (BandPackingSymmetryTileAction g T') ∩ FootprintEdges (BandPackingSymmetryTileAction + g T₀)).Nonempty) ) := by + classical + intro T₀ T' hedge g + obtain ⟨edge, hleft, hright⟩ := hedge + have edges := (BandPackingSymmetryTilingTransport g).2.2.2.2.2.2.2.2.1 + refine ⟨edge.image (BandPackingSymmetryVectorAction g), ?_, ?_⟩ + · rw [edges]; exact ⟨edge, hleft, rfl⟩ + · rw [edges]; exact ⟨edge, hright, rfl⟩ + +private theorem hgsubAt347 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T₀ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (C' : BandCircle), ∀ + (T' : ProtoTile), ∀ (h' : PartialOdometer), (TileSubodometer C.1.1 C'.1.1 T₀ T' h₀ + h') → (∀ (g : BandPackingSymmetry), + ∀ (Cg : BandCircle), (Cg.1.1 = BandPackingSymmetryCircleAction g C.1.1) → (∀ (Dg : + BandCircle), (Dg.1.1 = BandPackingSymmetryCircleAction g C'.1.1) → (TileSubodometer + Cg.1.1 Dg.1.1 (BandPackingSymmetryTileAction + g T₀) (BandPackingSymmetryTileAction g T') (BandPackingSymmetryPartialOdometerAction + g h₀) (BandPackingSymmetryPartialOdometerAction g h')))) ) := by + classical + intro C T₀ h₀ C' T' h' hsub g Cg hCg Dg hDg + rw [hCg, hDg] + exact (BandPackingSymmetryMarkedDataCovariance.1 g _ _ _ _ _ _).mp hsub + +private theorem heqOrig : + (by + classical + exact + ∀ (Cᵢ : BandCircle), ∀ (C' : BandCircle), ∀ (g : BandPackingSymmetry), ∀ (Ig : + BandCircle), (Ig.1.1 = BandPackingSymmetryCircleAction g Cᵢ.1.1) → (∀ (Dg : + BandCircle), (Dg.1.1 = BandPackingSymmetryCircleAction g C'.1.1) → (∀ (ginv : + BandPackingSymmetry), (∀ (C : CircleCoordinates), + BandPackingSymmetryCircleAction ginv (BandPackingSymmetryCircleAction g C) = C) → + ((Dg = Ig) → (C' = Cᵢ)))) ) := by + classical + intro Cᵢ C' g Ig hIg Dg hDg ginv hcancel heq + apply Subtype.ext + apply Subtype.ext + have he := congrArg (fun D : BandCircle => D.1.1) heq + rw [hDg, hIg] at he + simpa only [hcancel] using congrArg (BandPackingSymmetryCircleAction ginv) he + +private theorem hab : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ : PartialOdometer), + ∀ (g : BandPackingSymmetry), ∀ (qbar : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration qbar), ∀ (Cg : BandCircle), ∀ (Ig : BandCircle), ∀ + (cert : BandOrderedGeneralLayoutCertificate qbar cfg Cg + (BandPackingSymmetryTileAction g T₀)), ∀ (a : PeriodicSubtileIndex), (a ∈ + P4261T1ExteriorIndices) → ((P4261T1PlacedOdometer cert + (BandPackingSymmetryPartialOdometerAction g h₀) Ig (BandPackingSymmetryTileAction g + T) (BandPackingSymmetryPartialOdometerAction g h) a) → (∀ (b : PeriodicSubtileIndex), + (b.first = (0 : ℤ)) → ((b.second = (0 : ℤ)) → ((¬AllowedSubtileIncidence a b) → (a ≠ + b))))) ) := by + classical + intro T T₀ h h₀ g qbar cfg Cg Ig cert a ha pa b hb₁ hb₂ hinc heq + have hzero : a.first = 0 ∧ a.second = 0 := by simpa [heq] using And.intro hb₁ hb₂ + have ha' := ha + simp only [P4261T1ExteriorIndices, Finset.mem_insert, Finset.mem_singleton] at ha' + rcases ha' with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> + norm_num at hzero + +private theorem hsmall : + (by + classical + exact + ∀ (T₀ : ProtoTile), ∀ (g : BandPackingSymmetry), ∀ (qbar : Fin (4 : ℕ) → + CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration qbar), ∀ (Cg : + BandCircle), ∀ (cert : BandOrderedGeneralLayoutCertificate qbar cfg Cg + (BandPackingSymmetryTileAction g T₀)), ∀ (a : PeriodicSubtileIndex), ∀ (b : + PeriodicSubtileIndex), (FootprintVertices (SubtileOccurrenceInterpretation cert.P + cert.u cert.v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u + cert.v b) = ∅ ∨ (FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u + cert.v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b)).Subsingleton) → (((FootprintVertices (SubtileOccurrenceInterpretation cert.P + cert.u cert.v a)) ∩ FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u + cert.v b)).Subsingleton) ) := by + classical + intro T₀ g qbar cfg Cg cert a b hraw + rcases hraw with hempty | hsmall + · rw [hempty]; exact Set.subsingleton_empty + · exact hsmall + +private theorem hsmallg : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ : PartialOdometer), + ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), ∀ (g : BandPackingSymmetry), ∀ (qbar : + Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration qbar), ∀ + (Cg : BandCircle), ∀ (Ig : BandCircle), ∀ (Dg : BandCircle), ∀ (cert : + BandOrderedGeneralLayoutCertificate qbar cfg Cg (BandPackingSymmetryTileAction g + T₀)), ∀ (a : PeriodicSubtileIndex), (P4261T1PlacedOdometer cert + (BandPackingSymmetryPartialOdometerAction g h₀) Ig (BandPackingSymmetryTileAction g + T) (BandPackingSymmetryPartialOdometerAction g h) a) → (∀ (b : PeriodicSubtileIndex), + (P4261T1PlacedOdometer cert (BandPackingSymmetryPartialOdometerAction g h₀) Dg + (BandPackingSymmetryTileAction g T') (BandPackingSymmetryPartialOdometerAction g h') + b) → ((((FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v a)) + ∩ FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b)).Subsingleton) → ((((BandPackingSymmetryPartialOdometerAction g h').domain : Set + GaussianInt) ∩ (BandPackingSymmetryPartialOdometerAction g h).domain).Subsingleton))) + ) := by + classical + intro T T₀ h h₀ T' h' g qbar cfg Cg Ig Dg cert a pa b pb hsmall + rw [pb.domain, pa.domain, Set.inter_comm] + exact hsmall + +private theorem forward : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (f : PartialOdometer), ∀ (z : GaussianInt), (z ∈ f.domain) + → (BandPackingSymmetryVectorAction g z ∈ (BandPackingSymmetryPartialOdometerAction g + f).domain) ) := by + classical + intro g f z hz + change _ ∈ ((BandPackingSymmetryPartialOdometerAction g f).domain : Set GaussianInt) + rw [(BandPackingSymmetryPartialOdometerActionFormulas g f f).1] + exact ⟨z, hz, rfl⟩ + +end OdometerAdjacencyGeometry + +theorem OrderedGeneralOdometerAdjacencyClassification : + ∀ (C : BandCircle), + (¬ ((∃ (g : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = C.1.1) ∨ + (∃ (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K 0) = C.1.1))) → + (∀ (T T₀ : ProtoTile) (h h₀ : PartialOdometer), + RightLatticeAdjacent C T T₀ h h₀ → + ∀ (C' : BandCircle) (T' : ProtoTile) (h' : PartialOdometer), + TileSubodometer C.1.1 C'.1.1 T T' h h' → + (FootprintEdges T' ∩ FootprintEdges T₀).Nonempty → + SubtileLatticeAdjacent C C' T₀ T' h₀ h') ∧ + (∀ (Cᵢ : BandCircle) (T T₀ : ProtoTile) + (h h₀ : PartialOdometer), + SubtileLatticeAdjacent C Cᵢ T₀ T h₀ h → + ∀ (C' : BandCircle) (T' : ProtoTile) (h' : PartialOdometer), + TileSubodometer C.1.1 C'.1.1 T₀ T' h₀ h' → + (∃ x, x ∈ h'.domain ∧ x ∈ h.domain) → + (((h'.domain : Set GaussianInt) ∩ + (h.domain : Set GaussianInt)).Subsingleton ∨ + (C' = Cᵢ ∧ LeftLatticeAdjacent Cᵢ T T' h h') ∨ + SubtileLatticeAdjacent Cᵢ C' T T' h h' ∨ + SubtileLatticeAdjacent C' Cᵢ T' T h' h)) := by +-- BODY + classical + intro C horbit + have neg1 : -(1 : Fin 3) = 2 := rfl + have neg2 : -(2 : Fin 3) = 1 := rfl + -- Normalize the presentation belonging to the actual adjacency witness. + have normalize (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) (hqC : q 0 = C.1.1) : + ∃ (g : BandPackingSymmetry) (qbar : Fin 4 → CircleCoordinates), + Nonempty (BandOrderedGeneralConfiguration qbar) ∧ + qbar 0 = BandPackingSymmetryCircleAction g C.1.1 := OdometerAdjacencyGeometry.normalize C + horbit q hq hqC + have imageCircle (g : BandPackingSymmetry) (D : BandCircle) + (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (j : Fin 4) (hj : p j = D.1.1) : + ∃ Dg : BandCircle, Dg.1.1 = BandPackingSymmetryCircleAction g D.1.1 := + OdometerAdjacencyGeometry.imageCircle neg1 neg2 g D p hp j hj + have transportS (g : BandPackingSymmetry) (A B Ag Bg : BandCircle) + (hA : Ag.1.1 = BandPackingSymmetryCircleAction g A.1.1) + (hB : Bg.1.1 = BandPackingSymmetryCircleAction g B.1.1) + (V W : ProtoTile) (f k : PartialOdometer) + (hadj : SubtileLatticeAdjacent A B V W f k) : + SubtileLatticeAdjacent Ag Bg + (BandPackingSymmetryTileAction g V) (BandPackingSymmetryTileAction g W) + (BandPackingSymmetryPartialOdometerAction g f) + (BandPackingSymmetryPartialOdometerAction g k) := OdometerAdjacencyGeometry.transportS + neg1 neg2 g A B Ag Bg hA hB V W f k hadj + have transportL (g : BandPackingSymmetry) (A Ag : BandCircle) + (hA : Ag.1.1 = BandPackingSymmetryCircleAction g A.1.1) + (V W : ProtoTile) (f k : PartialOdometer) + (hlarge : 1 < A.1.1.1) + (hadj : LeftLatticeAdjacent A V W f k) : + LeftLatticeAdjacent Ag + (BandPackingSymmetryTileAction g V) (BandPackingSymmetryTileAction g W) + (BandPackingSymmetryPartialOdometerAction g f) + (BandPackingSymmetryPartialOdometerAction g k) := OdometerAdjacencyGeometry.transportL g + A Ag hA V W f k hlarge hadj + -- Construct the layout from its existing smaller-tile premises. + have layout (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (D : BandCircle) (hD : q 0 = D.1.1) (V : ProtoTile) + (hV : BandPrototile (q 0) V) : + Nonempty (BandOrderedGeneralLayoutCertificate q cfg D V) := + OdometerAdjacencyGeometry.layout q cfg D hD V hV + constructor + · intro T T₀ h h₀ hadj C' T' h' hsub hedge + obtain ⟨hO, hO₀, p, p₀, hp, hp₀, q, i, e, hq, hqC, hc, hx, hy⟩ := hadj + obtain ⟨g, qbar, ⟨cfg⟩, hchild⟩ := normalize q hq hqC + obtain ⟨Cg, hCg⟩ := imageCircle g C q hq 0 hqC + rcases hsub.2.2.2.2.2 with ⟨pdec, j, hpdec, hpdecC, hpdecD, _⟩ + obtain ⟨Dg, hDg⟩ := imageCircle g C' pdec hpdec j.succ hpdecD + have hgsub : TileSubodometer Cg.1.1 Dg.1.1 + (BandPackingSymmetryTileAction g T) (BandPackingSymmetryTileAction g T') + (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g h') := OdometerAdjacencyGeometry.hgsubAt296 C + T h C' T' h' hsub g Cg hCg Dg hDg + obtain ⟨d, r, r₀, _, hOg, hO₀g, hrg, hr₀g, hcg, hxg, hyg, _⟩ := + RightLatticeAdjacentPackingSymmetryTransport g q hq i e T T₀ h h₀ p p₀ + (by simpa [hqC] using hO) (by simpa [hqC] using hO₀) hp hp₀ hc hx hy + have hqgC : BandPackingSymmetryQuadrupleAction g q 0 = Cg.1.1 := by + simp [BandPackingSymmetryQuadrupleAction, hqC, hCg] + have hOg' : TileOdometer Cg.1.1 (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryPartialOdometerAction g h) := by simpa only [hqgC] using hOg + have hO₀g' : TileOdometer Cg.1.1 (BandPackingSymmetryTileAction g T₀) + (BandPackingSymmetryPartialOdometerAction g h₀) := by simpa only [hqgC] using hO₀g + have hadjg : RightLatticeAdjacent Cg + (BandPackingSymmetryTileAction g T) (BandPackingSymmetryTileAction g T₀) + (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g h₀) := + ⟨hOg', hO₀g', r, r₀, hrg, hr₀g, BandPackingSymmetryQuadrupleAction g q, + (if BandPackingSymmetryReversesOrientation g then -i else i), + xor (xor e d) (BandPackingSymmetryReversesOrientation g), + BandPackingSymmetryProperCovariance g q hq, hqgC, hcg, hxg, hyg⟩ + have hbarC : qbar 0 = Cg.1.1 := hchild.trans hCg.symm + obtain ⟨cert⟩ := layout qbar cfg Cg hbarC (BandPackingSymmetryTileAction g T₀) + (by simpa only [hbarC] using TileOdometerBandPrototile _ _ _ hO₀g') + obtain ⟨a, ha, ⟨placed⟩⟩ := P4261T1RightCoordinates cert _ _ _ hadjg _ _ _ hgsub + have hedgeg : (FootprintEdges (BandPackingSymmetryTileAction g T') ∩ + FootprintEdges (BandPackingSymmetryTileAction g T₀)).Nonempty := + OdometerAdjacencyGeometry.hedgeg T₀ T' hedge g + have haext := P4261T1EdgeExterior cert _ a placed.cells ha hedgeg + have result := P4261T1ExteriorAdjacency cert _ hO₀g' _ _ _ a haext placed + obtain ⟨ginv, hcancel, _, _, _, htile, _, _, _, hfun, _⟩ := + BandPackingSymmetryInversePhaseCancellation.2 g + have hbackC : C.1.1 = BandPackingSymmetryCircleAction ginv Cg.1.1 := by + rw [hCg, hcancel] + have hbackD : C'.1.1 = BandPackingSymmetryCircleAction ginv Dg.1.1 := by + rw [hDg, hcancel] + have back := transportS ginv Cg Dg C C' hbackC hbackD _ _ _ _ result + simpa only [htile, hfun] using back + · intro Cᵢ T T₀ h h₀ hadj C' T' h' hsub _hmeet + obtain ⟨hO₀, hO, p₀, p, hp₀, hp, q, i, s, hq, hqC, hqi, hc, hx, hy⟩ := hadj + obtain ⟨g, qbar, ⟨cfg⟩, hchild⟩ := normalize q hq hqC + obtain ⟨Cg, hCg⟩ := imageCircle g C q hq 0 hqC + obtain ⟨Ig, hIg⟩ := imageCircle g Cᵢ q hq i.succ hqi + rcases hsub.2.2.2.2.2 with ⟨pdec, j, hpdec, hpdecC, hpdecD, _⟩ + obtain ⟨Dg, hDg⟩ := imageCircle g C' pdec hpdec j.succ hpdecD + have hgsub : TileSubodometer Cg.1.1 Dg.1.1 + (BandPackingSymmetryTileAction g T₀) (BandPackingSymmetryTileAction g T') + (BandPackingSymmetryPartialOdometerAction g h₀) + (BandPackingSymmetryPartialOdometerAction g h') := OdometerAdjacencyGeometry.hgsubAt347 C + T₀ h₀ C' T' h' hsub g Cg hCg Dg hDg + have hadj' : SubtileLatticeAdjacent C Cᵢ T₀ T h₀ h := + ⟨hO₀, hO, p₀, p, hp₀, hp, q, i, s, hq, hqC, hqi, hc, hx, hy⟩ + have hadjg := transportS g C Cᵢ Cg Ig hCg hIg _ _ _ _ hadj' + have hO₀g := hadjg.1 + have hbarC : qbar 0 = Cg.1.1 := hchild.trans hCg.symm + obtain ⟨cert⟩ := layout qbar cfg Cg hbarC (BandPackingSymmetryTileAction g T₀) + (by simpa only [hbarC] using TileOdometerBandPrototile _ _ _ hO₀g) + obtain ⟨a, ha, ⟨pa⟩⟩ := P4261T1SubtileCoordinates cert _ _ _ _ hadjg + obtain ⟨b, hb₁, hb₂, ⟨pb⟩⟩ := P4261T1CentralCoordinates cert _ _ _ _ hgsub + obtain ⟨ginv, hcancel, _, _, _, htile, _, hvec, _, hfun, _⟩ := + BandPackingSymmetryInversePhaseCancellation.2 g + have hbackI : Cᵢ.1.1 = BandPackingSymmetryCircleAction ginv Ig.1.1 := by + rw [hIg, hcancel] + have hbackD : C'.1.1 = BandPackingSymmetryCircleAction ginv Dg.1.1 := by + rw [hDg, hcancel] + by_cases hinc : AllowedSubtileIncidence a b + · rcases P4261T1ContactAdjacency cert _ _ _ _ _ _ _ a b ha hb₁ hb₂ pa pb hinc with + ⟨heq, hlarge, hleft⟩ | hforward | hreverse + · have heqOrig : C' = Cᵢ := OdometerAdjacencyGeometry.heqOrig Cᵢ C' g Ig hIg Dg hDg ginv + hcancel heq + right; left + refine ⟨heqOrig, ?_⟩ + have back := transportL ginv Ig Cᵢ hbackI _ _ _ _ hlarge hleft + simpa only [htile, hfun] using back + · right; right; left + have back := transportS ginv Ig Dg Cᵢ C' hbackI hbackD _ _ _ _ hforward + simpa only [htile, hfun] using back + · right; right; right + have back := transportS ginv Dg Ig C' Cᵢ hbackD hbackI _ _ _ _ hreverse + simpa only [htile, hfun] using back + · -- A nonledger contact stays a raw subsingleton, not a reversed adjacency. + have hab : a ≠ b := OdometerAdjacencyGeometry.hab T T₀ h h₀ g qbar cfg Cg Ig cert a ha pa b + hb₁ hb₂ hinc + have hraw := (BandOriginalOccurrenceIntersectionClassification qbar cfg Cg + (BandPackingSymmetryTileAction g T₀) cert a b hab).2 hinc + have hsmall : ((FootprintVertices + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a)) ∩ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b)).Subsingleton := OdometerAdjacencyGeometry.hsmall T₀ g qbar cfg Cg cert a b hraw + have hsmallg : (((BandPackingSymmetryPartialOdometerAction g h').domain : Set GaussianInt) ∩ + (BandPackingSymmetryPartialOdometerAction g h).domain).Subsingleton := + OdometerAdjacencyGeometry.hsmallg T T₀ h h₀ T' h' g qbar cfg Cg Ig Dg cert a pa b + pb hsmall + left + intro x hx y hy + have forward (f : PartialOdometer) (z : GaussianInt) (hz : z ∈ f.domain) : + BandPackingSymmetryVectorAction g z ∈ + (BandPackingSymmetryPartialOdometerAction g f).domain := + OdometerAdjacencyGeometry.forward g f z hz + have he := hsmallg + ⟨forward h' x hx.1, forward h x hx.2⟩ + ⟨forward h' y hy.1, forward h y hy.2⟩ + simpa only [hvec] using congrArg (BandPackingSymmetryVectorAction ginv) he + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean b/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean new file mode 100644 index 0000000000..7ba6b4afc1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean @@ -0,0 +1,833 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations + +-- [TABLET NODE: OrientedTouchingCovariance] + +/-! +# OrientedTouchingCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TouchingCovarianceProof + +private theorem quarter_translate : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), TileQuarterTurn (TileTranslation T x) = + TileTranslation (TileQuarterTurn T) (GaussianQuarterTurn x) + ) := by + classical + intro T x + cases T with + | mk cells anchor => + have map : (fun z : GaussianInt => GaussianQuarterTurn (z + x) - 1) = + (fun z : GaussianInt => (GaussianQuarterTurn z - 1) + + GaussianQuarterTurn x) := by + funext z + ext <;> simp [GaussianQuarterTurn, add_comm]; ring + apply congrArg₂ (fun c : FiniteTile => fun d : GaussianInt => + ProtoTile.mk c d) + · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, + Finset.image_image, Function.comp_def, map] + · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, + GaussianQuarterTurn, add_comm] + +private theorem same_touch : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (A' : ProtoTile), ∀ (B' : + ProtoTile), ∀ (C' : ProtoTile), A.cells = A'.cells → B.cells = B'.cells → C.cells = + C'.cells → (A.cells = ∅ → A.anchor = A'.anchor) → (B.cells = ∅ → B.anchor = + B'.anchor) → (C.cells = ∅ → C.anchor = C'.anchor) → (TouchingTriple A B C ↔ + TouchingTriple A' B' C') + ) := by + classical + intro A B C A' B' C' ha hb hc haa hbb hcc + have boundary : ∀ (X X' : ProtoTile), X.cells = X'.cells → + (X.cells = ∅ → X.anchor = X'.anchor) → + BoundaryFootprintVertices X = BoundaryFootprintVertices X' := by + intro X X' hx hxa + unfold BoundaryFootprintVertices + have hn : X.cells.Nonempty ↔ X'.cells.Nonempty := by rw [hx] + simp only [hn] + split + · congr 1 + unfold BoundaryFootprintEdges + rw [hx] + · have hn' : ¬ X.cells.Nonempty := by + intro h + exact ‹¬X'.cells.Nonempty› (hn.mp h) + have he : X.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hn' + simp [hxa he] + have edges : ∀ (X X' : ProtoTile), X.cells = X'.cells → + BoundaryFootprintEdges X = BoundaryFootprintEdges X' := by + intro X X' hx + ext e + simp [BoundaryFootprintEdges, hx] + have ba := boundary A A' ha haa + have bb := boundary B B' hb hbb + have bc := boundary C C' hc hcc + have ea := edges A A' ha + have eb := edges B B' hb + have ec := edges C C' hc + unfold TouchingTriple TileTouching + rw [ea, eb, ec] + by_cases ha0 : A.cells = ∅ <;> by_cases hb0 : B.cells = ∅ <;> + by_cases hc0 : C.cells = ∅ <;> + first + | simp? [ha0, hb0, hc0, ba, bb, bc, + haa ha0, hbb hb0, hcc hc0] + | simp? [ha0, hb0, hc0, ha, hb, hc, ba, bb, bc] + all_goals first + | simp [ha0, hb0, hc0, ← haa ha0, ← hbb hb0, ← hcc hc0, ← ha, ← hb, ← hc, ← ba, ← bb, ← bc, + ← ea, ← eb, ← ec] + | simp [ha0, hb0, hc0, ← haa ha0, ← hbb hb0, ← ha, ← hb, ← hc, ← ba, ← bb, ← bc, ← ea, ← + eb, ← ec] + | simp [ha0, hb0, hc0, ← haa ha0, ← hcc hc0, ← ha, ← hb, ← hc, ← ba, ← bb, ← bc, ← ea, ← + eb, ← ec] + | simp [ha0, hb0, hc0, ← hbb hb0, ← hcc hc0, ← ha, ← hb, ← hc, ← ba, ← bb, ← bc, ← ea, ← + eb, ← ec] + | simp [ha0, hb0, hc0, ← haa ha0, ← ha, ← hb, ← hc, ← ba, ← bb, ← bc, ← ea, ← eb, ← ec] + | simp [ha0, hb0, hc0, ← hbb hb0, ← ha, ← hb, ← hc, ← ba, ← bb, ← bc, ← ea, ← eb, ← ec] + | simp [ha0, hb0, hc0, ← hcc hc0, ← ha, ← hb, ← hc, ← ba, ← bb, ← bc, ← ea, ← eb, ← ec] + | simp [ha0, hb0, hc0, ← ha, ← hb, ← hc, ← ba, ← bb, ← bc, ← ea, ← eb, ← ec] + +private theorem shift_centroid : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (uT : GaussianInt), ∀ (uU : GaussianInt), ∀ (x : + GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint uT = ((TileCentroid T).1 + + (TileCentroid T).2, (TileCentroid T).2 - (TileCentroid T).1) → GaussianRealPoint uU = + ((TileCentroid U).1 + (TileCentroid U).2, (TileCentroid U).2 - (TileCentroid U).1) → + TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint + (GaussianQuarterTurn x) + GaussianRealPoint (GaussianQuarterTurn y)) → TileCentroid + (TileTranslation U ⟨uU.im, -uU.re⟩) - TileCentroid (TileTranslation T ⟨uT.im, + -uT.re⟩) = (1 / 2 : ℝ) • (GaussianRealPoint x + GaussianRealPoint y) + ) := by + classical + intro T U uT uU x y huT huU hcent + rw [(TileTranslationFormulas U _).2.2.2.2.1, + (TileTranslationFormulas T _).2.2.2.2.1] + have huT' := congrArg Prod.fst huT + have huT'' := congrArg Prod.snd huT + have huU' := congrArg Prod.fst huU + have huU'' := congrArg Prod.snd huU + change (uT.re : Real) = _ at huT' + change (uT.im : Real) = _ at huT'' + change (uU.re : Real) = _ at huU' + change (uU.im : Real) = _ at huU'' + have h₁ := congrArg Prod.fst hcent + have h₂ := congrArg Prod.snd hcent + simp only [GaussianRealPoint, GaussianQuarterTurn] at h₁ h₂ ⊢ + apply Prod.ext <;> dsimp at * <;> norm_num at * <;> linarith + +private theorem turn4 : + (by + classical + exact + (∀ (T : ProtoTile), ∀ (x : GaussianInt), TileQuarterTurn (TileTranslation T x) = + TileTranslation (TileQuarterTurn T) (GaussianQuarterTurn x)) → ((∀ (A : ProtoTile), ∀ + (B : ProtoTile), ∀ (C : ProtoTile), ∀ (A' : ProtoTile), ∀ (B' : ProtoTile), ∀ (C' : + ProtoTile), (A.cells = A'.cells) → ((B.cells = B'.cells) → ((C.cells = C'.cells) → + ((A.cells = ∅ → A.anchor = A'.anchor) → ((B.cells = ∅ → B.anchor = B'.anchor) → + ((C.cells = ∅ → C.anchor = C'.anchor) → (TouchingTriple A B C ↔ TouchingTriple A' B' + C'))))))) → (∀ (C : CircleCoordinates), ∀ (D : CircleCoordinates), ∀ (T : ProtoTile), + ∀ (U : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), BandPrototile C T → + BandPrototile D U → QuarterTurnSymmetric T → QuarterTurnSymmetric U → (∀ (X : + ProtoTile), ∀ (Y : ProtoTile), BandPrototile C X → BandPrototile D Y → TileCentroid Y + - TileCentroid X = (1 / 2 : Real) • (GaussianRealPoint x + GaussianRealPoint y) → + TouchingTriple X (TileTranslation X x) Y) → (TileCentroid U - TileCentroid T = (1 / 2 + : Real) • (GaussianRealPoint (GaussianQuarterTurn x) + GaussianRealPoint + (GaussianQuarterTurn y))) → TouchingTriple T (TileTranslation T (GaussianQuarterTurn + x)) U)) + ) := by + classical + intro quarter_translate same_touch C D T U x y hT hU hTs hUs hbase hcent + obtain ⟨uT, huT, hcellT, hanchorT, hfootT, hcenterT⟩ := + QuarterTurnSymmetricCenteredTransport T hTs + obtain ⟨uU, huU, hcellU, hanchorU, hfootU, hcenterU⟩ := + QuarterTurnSymmetricCenteredTransport U hUs + let vT : GaussianInt := ⟨uT.im, -uT.re⟩ + let vU : GaussianInt := ⟨uU.im, -uU.re⟩ + have hvT : GaussianQuarterTurn vT = uT := by + dsimp [vT] + ext <;> simp [GaussianQuarterTurn] + have hvU : GaussianQuarterTurn vU = uU := by + dsimp [vU] + ext <;> simp [GaussianQuarterTurn] + let T' := TileTranslation T vT + let U' := TileTranslation U vU + have hT' : BandPrototile C T' := by + exact BandPrototileTranslation C T vT hT + have hU' : BandPrototile D U' := by + exact BandPrototileTranslation D U vU hU + have hcent' : TileCentroid U' - TileCentroid T' = + (1 / 2 : Real) • + (GaussianRealPoint x + GaussianRealPoint y) := by + rw [(TileTranslationFormulas U vU).2.2.2.2.1, + (TileTranslationFormulas T vT).2.2.2.2.1] + have huT' := congrArg Prod.fst huT + have huT'' := congrArg Prod.snd huT + have huU' := congrArg Prod.fst huU + have huU'' := congrArg Prod.snd huU + have huT_re : (uT.re : Real) = (TileCentroid T).1 + (TileCentroid T).2 := by + change (uT.re : Real) = (TileCentroid T).1 + (TileCentroid T).2 at huT' + exact huT' + have huT_im : (uT.im : Real) = (TileCentroid T).2 - (TileCentroid T).1 := by + change (uT.im : Real) = (TileCentroid T).2 - (TileCentroid T).1 at huT'' + exact huT'' + have huU_re : (uU.re : Real) = (TileCentroid U).1 + (TileCentroid U).2 := by + change (uU.re : Real) = (TileCentroid U).1 + (TileCentroid U).2 at huU' + exact huU' + have huU_im : (uU.im : Real) = (TileCentroid U).2 - (TileCentroid U).1 := by + change (uU.im : Real) = (TileCentroid U).2 - (TileCentroid U).1 at huU'' + exact huU'' + dsimp [vT, vU] + have h₁ := congrArg Prod.fst hcent + have h₂ := congrArg Prod.snd hcent + simp only [GaussianRealPoint, GaussianQuarterTurn] at h₁ h₂ ⊢ + apply Prod.ext <;> dsimp at * <;> norm_num at * <;> linarith + have hrot : TouchingTriple (TileQuarterTurn T') + (TileQuarterTurn (TileTranslation T' x)) + (TileQuarterTurn U') := by + have h := hbase T' U' hT' hU' hcent' + exact (TouchingTripleCovariance T' (TileTranslation T' x) U' 0).2.1.mp h + have eT : (TileQuarterTurn T').cells = T.cells := by + dsimp [T'] + rw [quarter_translate, hvT] + exact hcellT + have eU : (TileQuarterTurn U').cells = U.cells := by + dsimp [U'] + rw [quarter_translate, hvU] + exact hcellU + have eM : (TileQuarterTurn (TileTranslation T' x)).cells = + (TileTranslation T (GaussianQuarterTurn x)).cells := by + dsimp [T'] + rw [quarter_translate, quarter_translate, hvT] + change Finset.image (GaussianTranslation (GaussianQuarterTurn x)) + (Finset.image (GaussianTranslation uT) (TileQuarterTurn T).cells) = + Finset.image (GaussianTranslation (GaussianQuarterTurn x)) T.cells + have ht : Finset.image (GaussianTranslation uT) (TileQuarterTurn T).cells = T.cells := + by + change (TileTranslation (TileQuarterTurn T) uT).cells = T.cells + exact hcellT + rw [ht] + have aT : (TileQuarterTurn T').cells = ∅ → + (TileQuarterTurn T').anchor = T.anchor := by + intro he + simpa [T', quarter_translate, hvT] using + hanchorT (by rwa [eT] at he) + have aU : (TileQuarterTurn U').cells = ∅ → + (TileQuarterTurn U').anchor = U.anchor := by + intro he + simpa [U', quarter_translate, hvU] using + hanchorU (by rwa [eU] at he) + have aM : (TileQuarterTurn (TileTranslation T' x)).cells = ∅ → + (TileQuarterTurn (TileTranslation T' x)).anchor = + (TileTranslation T (GaussianQuarterTurn x)).anchor := by + intro he + dsimp [T'] at he ⊢ + rw [quarter_translate, quarter_translate, hvT] + have ht : T.cells = ∅ := by + have htarget : (TileTranslation T (GaussianQuarterTurn x)).cells = ∅ := by + rw [← eM] + exact he + exact (TileTranslationFormulas T (GaussianQuarterTurn x)).2.2.1.mp htarget + change GaussianTranslation (GaussianQuarterTurn x) + (GaussianTranslation uT (TileQuarterTurn T).anchor) = + GaussianTranslation (GaussianQuarterTurn x) T.anchor + have ha : GaussianTranslation uT (TileQuarterTurn T).anchor = T.anchor := by + simpa [TileTranslation, GaussianTranslation] using hanchorT ht + rw [ha] + have hs := same_touch (TileQuarterTurn T') + (TileQuarterTurn (TileTranslation T' x)) + (TileQuarterTurn U') T + (TileTranslation T (GaussianQuarterTurn x)) U + eT eM eU aT aM aU + exact hs.mp hrot + +private theorem turn5 : + (by + classical + exact + (∀ (T : ProtoTile), ∀ (x : GaussianInt), TileQuarterTurn (TileTranslation T x) = + TileTranslation (TileQuarterTurn T) (GaussianQuarterTurn x)) → ((∀ (A : ProtoTile), ∀ + (B : ProtoTile), ∀ (C : ProtoTile), ∀ (A' : ProtoTile), ∀ (B' : ProtoTile), ∀ (C' : + ProtoTile), (A.cells = A'.cells) → ((B.cells = B'.cells) → ((C.cells = C'.cells) → + ((A.cells = ∅ → A.anchor = A'.anchor) → ((B.cells = ∅ → B.anchor = B'.anchor) → + ((C.cells = ∅ → C.anchor = C'.anchor) → (TouchingTriple A B C ↔ TouchingTriple A' B' + C'))))))) → ((∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (uT : GaussianInt), ∀ (uU : + GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (GaussianRealPoint uT = + ((TileCentroid T).1 + (TileCentroid T).2, (TileCentroid T).2 - (TileCentroid T).1)) → + ((GaussianRealPoint uU = ((TileCentroid U).1 + (TileCentroid U).2, (TileCentroid U).2 + - (TileCentroid U).1)) → ((TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn x) + GaussianRealPoint (GaussianQuarterTurn + y))) → (TileCentroid (TileTranslation U ⟨uU.im, -uU.re⟩) - TileCentroid + (TileTranslation T ⟨uT.im, -uT.re⟩) = (1 / 2 : Real) • (GaussianRealPoint x + + GaussianRealPoint y))))) → (∀ (C : CircleCoordinates), ∀ (D : CircleCoordinates), ∀ + (E : CircleCoordinates), ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ + (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), ∀ (w : GaussianInt), + BandPrototile C T → BandPrototile D U → BandPrototile E V → QuarterTurnSymmetric T → + QuarterTurnSymmetric U → QuarterTurnSymmetric V → (∀ (X : ProtoTile), ∀ (Y : + ProtoTile), ∀ (Z : ProtoTile), BandPrototile C X → BandPrototile D Y → BandPrototile + E Z → TileCentroid Y - TileCentroid X = (1 / 2 : Real) • (GaussianRealPoint x + + GaussianRealPoint y) → TileCentroid Z - TileCentroid X = (1 / 2 : Real) • + (GaussianRealPoint z - GaussianRealPoint w) → TouchingTriple X Y Z) → TileCentroid U + - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint (GaussianQuarterTurn x) + + GaussianRealPoint (GaussianQuarterTurn y)) → TileCentroid V - TileCentroid T = (1 / 2 + : Real) • (GaussianRealPoint (GaussianQuarterTurn z) - GaussianRealPoint + (GaussianQuarterTurn w)) → TouchingTriple T U V))) + ) := by + classical + intro quarter_translate same_touch shift_centroid C D E T U V x y z w hT hU hV hTs hUs hVs + hbase hcu hcv + obtain ⟨uT, huT, hcellT, hanchorT, hfootT, hcenterT⟩ := + QuarterTurnSymmetricCenteredTransport T hTs + obtain ⟨uU, huU, hcellU, hanchorU, hfootU, hcenterU⟩ := + QuarterTurnSymmetricCenteredTransport U hUs + obtain ⟨uV, huV, hcellV, hanchorV, hfootV, hcenterV⟩ := + QuarterTurnSymmetricCenteredTransport V hVs + let vT : GaussianInt := ⟨uT.im, -uT.re⟩ + let vU : GaussianInt := ⟨uU.im, -uU.re⟩ + let vV : GaussianInt := ⟨uV.im, -uV.re⟩ + have hvT : GaussianQuarterTurn vT = uT := by dsimp [vT]; ext <;> simp [GaussianQuarterTurn] + have hvU : GaussianQuarterTurn vU = uU := by dsimp [vU]; ext <;> simp [GaussianQuarterTurn] + have hvV : GaussianQuarterTurn vV = uV := by dsimp [vV]; ext <;> simp [GaussianQuarterTurn] + let T' := TileTranslation T vT + let U' := TileTranslation U vU + let V' := TileTranslation V vV + have hT' := BandPrototileTranslation C T vT hT + have hU' := BandPrototileTranslation D U vU hU + have hV' := BandPrototileTranslation E V vV hV + have hcu' := shift_centroid T U uT uU x y huT huU hcu + have hcvMinus : TileCentroid V - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn z) + + GaussianRealPoint (GaussianQuarterTurn (-w))) := by + simpa [GaussianRealPoint, GaussianQuarterTurn, sub_eq_add_neg] using hcv + have hcv' : TileCentroid (TileTranslation V vV) - + TileCentroid (TileTranslation T vT) = (1 / 2 : Real) • + (GaussianRealPoint z - GaussianRealPoint w) := by + have hh := shift_centroid T V uT uV z (-w) huT huV hcvMinus + simpa [GaussianRealPoint, GaussianQuarterTurn, sub_eq_add_neg] using hh + have hrot : TouchingTriple (TileQuarterTurn T') + (TileQuarterTurn U') (TileQuarterTurn V') := by + exact (TouchingTripleCovariance T' U' V' 0).2.1.mp + (hbase T' U' V' hT' hU' hV' hcu' hcv') + have eT : (TileQuarterTurn T').cells = T.cells := by + dsimp [T']; rw [quarter_translate, hvT]; exact hcellT + have eU : (TileQuarterTurn U').cells = U.cells := by + dsimp [U']; rw [quarter_translate, hvU]; exact hcellU + have eV : (TileQuarterTurn V').cells = V.cells := by + dsimp [V']; rw [quarter_translate, hvV]; exact hcellV + have aT : (TileQuarterTurn T').cells = ∅ → + (TileQuarterTurn T').anchor = T.anchor := by + intro he; simpa [T', quarter_translate, hvT] using hanchorT (by rwa [eT] at he) + have aU : (TileQuarterTurn U').cells = ∅ → + (TileQuarterTurn U').anchor = U.anchor := by + intro he; simpa [U', quarter_translate, hvU] using hanchorU (by rwa [eU] at he) + have aV : (TileQuarterTurn V').cells = ∅ → + (TileQuarterTurn V').anchor = V.anchor := by + intro he; simpa [V', quarter_translate, hvV] using hanchorV (by rwa [eV] at he) + exact (same_touch (TileQuarterTurn T') (TileQuarterTurn U') (TileQuarterTurn V') + T U V eT eU eV aT aU aV).mp hrot + +private theorem firstAt463 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (∀ (a : Fin (4 : ℕ)), ∀ (T : ProtoTile), + BandPrototile (q a) T → QuarterTurnSymmetric T) → ((∀ (T₀ : ProtoTile), ∀ (Tᵢ : + ProtoTile), ∀ (i : Fin (3 : ℕ)), BandPrototile (q (0 : Fin (4 : ℕ))) T₀ → + BandPrototile (q i.succ) Tᵢ → TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple + T₀ (TileTranslation T₀ (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) Tᵢ) → ((∀ (C + : CircleCoordinates), ∀ (D : CircleCoordinates), ∀ (T : ProtoTile), ∀ (U : + ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), BandPrototile C T → + BandPrototile D U → QuarterTurnSymmetric T → QuarterTurnSymmetric U → (∀ (X : + ProtoTile), ∀ (Y : ProtoTile), BandPrototile C X → BandPrototile D Y → TileCentroid Y + - TileCentroid X = (1 / 2 : Real) • (GaussianRealPoint x + GaussianRealPoint y) → + TouchingTriple X (TileTranslation X x) Y) → (TileCentroid U - TileCentroid T = (1 / 2 + : Real) • (GaussianRealPoint (GaussianQuarterTurn x) + GaussianRealPoint + (GaussianQuarterTurn y))) → TouchingTriple T (TileTranslation T (GaussianQuarterTurn + x)) U) → (∀ (i : Fin (3 : ℕ)), ∀ (X : ProtoTile), ∀ (Y : ProtoTile), BandPrototile (q + 0) X → BandPrototile (q i.succ) Y → TileCentroid Y - TileCentroid X = (1 / 2 : Real) + • (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0))) + + GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ)))) → + TouchingTriple X (TileTranslation X (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q + 0)))) Y))) + ) := by + classical + intro q hT2 hT4 turn4 i X Y hX hY hcent + exact turn4 (q 0) (q i.succ) X Y + (BandVectors.1 (q i.succ) (q 0)) + (BandVectors.1 (q 0) (q i.succ)) hX hY + (hT2 0 X hX) (hT2 i.succ Y hY) + (fun A B hA hB hz => hT4 A B i hA hB hz) hcent + +private theorem firstAt482 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (∀ (a : Fin (4 : ℕ)), ∀ (T : ProtoTile), + BandPrototile (q a) T → QuarterTurnSymmetric T) → ((∀ (T₀ : ProtoTile), ∀ (Tᵢ : + ProtoTile), ∀ (i : Fin (3 : ℕ)), BandPrototile (q (0 : Fin (4 : ℕ))) T₀ → + BandPrototile (q i.succ) Tᵢ → TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple + T₀ (TileTranslation T₀ (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) Tᵢ) → ((∀ (C + : CircleCoordinates), ∀ (D : CircleCoordinates), ∀ (T : ProtoTile), ∀ (U : + ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), BandPrototile C T → + BandPrototile D U → QuarterTurnSymmetric T → QuarterTurnSymmetric U → (∀ (X : + ProtoTile), ∀ (Y : ProtoTile), BandPrototile C X → BandPrototile D Y → TileCentroid Y + - TileCentroid X = (1 / 2 : Real) • (GaussianRealPoint x + GaussianRealPoint y) → + TouchingTriple X (TileTranslation X x) Y) → (TileCentroid U - TileCentroid T = (1 / 2 + : Real) • (GaussianRealPoint (GaussianQuarterTurn x) + GaussianRealPoint + (GaussianQuarterTurn y))) → TouchingTriple T (TileTranslation T (GaussianQuarterTurn + x)) U) → (∀ (i : Fin (3 : ℕ)), ∀ (X : ProtoTile), ∀ (Y : ProtoTile), BandPrototile (q + 0) X → BandPrototile (q i.succ) Y → TileCentroid Y - TileCentroid X = (1 / 2 : Real) + • (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0))) + + GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ)))) → + TouchingTriple X (TileTranslation X (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q + 0)))) Y))) + ) := by + classical + intro q hT2 hT4 turn4 i X Y hX hY hcent + exact turn4 (q 0) (q i.succ) X Y + (BandVectors.1 (q i.succ) (q 0)) + (BandVectors.1 (q 0) (q i.succ)) hX hY + (hT2 0 X hX) (hT2 i.succ Y hY) + (fun A B hA hB hz => hT4 A B i hA hB hz) hcent + +private theorem base : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (∀ (a : Fin (4 : ℕ)), ∀ (T : ProtoTile), + BandPrototile (q a) T → QuarterTurnSymmetric T) → ((∀ (T₀ : ProtoTile), ∀ (Tᵢ : + ProtoTile), ∀ (Tⱼ : ProtoTile), ∀ (i : Fin (3 : ℕ)), BandPrototile (q (0 : Fin (4 : + ℕ))) T₀ → BandPrototile (q i.succ) Tᵢ → BandPrototile (q (i + (1 : Fin (3 : + ℕ))).succ) Tⱼ → TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 + (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid Tⱼ - TileCentroid T₀ = (1 / 2 : ℝ) + • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : + ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + (1 : Fin (3 : + ℕ))).succ))) → TouchingTriple T₀ Tᵢ Tⱼ) → ((∀ (C : CircleCoordinates), ∀ (D : + CircleCoordinates), ∀ (E : CircleCoordinates), ∀ (T : ProtoTile), ∀ (U : ProtoTile), + ∀ (V : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), ∀ + (w : GaussianInt), BandPrototile C T → BandPrototile D U → BandPrototile E V → + QuarterTurnSymmetric T → QuarterTurnSymmetric U → QuarterTurnSymmetric V → (∀ (X : + ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), BandPrototile C X → BandPrototile D + Y → BandPrototile E Z → TileCentroid Y - TileCentroid X = (1 / 2 : Real) • + (GaussianRealPoint x + GaussianRealPoint y) → TileCentroid Z - TileCentroid X = (1 / + 2 : Real) • (GaussianRealPoint z - GaussianRealPoint w) → TouchingTriple X Y Z) → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint + (GaussianQuarterTurn x) + GaussianRealPoint (GaussianQuarterTurn y)) → TileCentroid V + - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint (GaussianQuarterTurn z) - + GaussianRealPoint (GaussianQuarterTurn w)) → TouchingTriple T U V) → (∀ (i : Fin (3 : + ℕ)), ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), BandPrototile (q 0) X → + BandPrototile (q i.succ) Y → BandPrototile (q ((i + 1).succ)) Z → TileCentroid Y - + TileCentroid X = (1 / 2 : Real) • (GaussianRealPoint (GaussianQuarterTurn + (BandVectors.1 (q i.succ) (q 0))) + GaussianRealPoint (GaussianQuarterTurn + (BandVectors.1 (q 0) (q i.succ)))) → TileCentroid Z - TileCentroid X = (1 / 2 : Real) + • (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q ((i + 1).succ)) (q 0))) - + GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q ((i + 1).succ))))) → + TouchingTriple X Y Z))) + ) := by + classical + intro q hT2 hT5 turn5 i X Y Z hX hY hZ ha hb + exact turn5 (q 0) (q i.succ) (q ((i + 1).succ)) X Y Z + (BandVectors.1 (q i.succ) (q 0)) (BandVectors.1 (q 0) (q i.succ)) + (BandVectors.1 (q ((i + 1).succ)) (q 0)) (BandVectors.1 (q 0) (q ((i + 1).succ))) + hX hY hZ (hT2 0 X hX) (hT2 i.succ Y hY) (hT2 (i + 1).succ Z hZ) + (fun A B C hA hB hC ha' hb' => hT5 A B C i hA hB hC ha' hb') ha hb + +private theorem firstAt532 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (∀ (a : Fin (4 : ℕ)), ∀ (T : ProtoTile), + BandPrototile (q a) T → QuarterTurnSymmetric T) → ((∀ (T₀ : ProtoTile), ∀ (Tᵢ : + ProtoTile), ∀ (Tⱼ : ProtoTile), ∀ (i : Fin (3 : ℕ)), BandPrototile (q (0 : Fin (4 : + ℕ))) T₀ → BandPrototile (q i.succ) Tᵢ → BandPrototile (q (i + (1 : Fin (3 : + ℕ))).succ) Tⱼ → TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 + (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid Tⱼ - TileCentroid T₀ = (1 / 2 : ℝ) + • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : + ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + (1 : Fin (3 : + ℕ))).succ))) → TouchingTriple T₀ Tᵢ Tⱼ) → ((∀ (C : CircleCoordinates), ∀ (D : + CircleCoordinates), ∀ (E : CircleCoordinates), ∀ (T : ProtoTile), ∀ (U : ProtoTile), + ∀ (V : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), ∀ + (w : GaussianInt), BandPrototile C T → BandPrototile D U → BandPrototile E V → + QuarterTurnSymmetric T → QuarterTurnSymmetric U → QuarterTurnSymmetric V → (∀ (X : + ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), BandPrototile C X → BandPrototile D + Y → BandPrototile E Z → TileCentroid Y - TileCentroid X = (1 / 2 : Real) • + (GaussianRealPoint x + GaussianRealPoint y) → TileCentroid Z - TileCentroid X = (1 / + 2 : Real) • (GaussianRealPoint z - GaussianRealPoint w) → TouchingTriple X Y Z) → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint + (GaussianQuarterTurn x) + GaussianRealPoint (GaussianQuarterTurn y)) → TileCentroid V + - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint (GaussianQuarterTurn z) - + GaussianRealPoint (GaussianQuarterTurn w)) → TouchingTriple T U V) → (∀ (i : Fin (3 : + ℕ)), ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), BandPrototile (q 0) X → + BandPrototile (q i.succ) Y → BandPrototile (q ((i + 1).succ)) Z → TileCentroid Y - + TileCentroid X = (1 / 2 : Real) • (GaussianRealPoint (GaussianQuarterTurn + (BandVectors.1 (q i.succ) (q 0))) + GaussianRealPoint (GaussianQuarterTurn + (BandVectors.1 (q 0) (q i.succ)))) → TileCentroid Z - TileCentroid X = (1 / 2 : Real) + • (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q ((i + 1).succ)) (q 0))) - + GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q ((i + 1).succ))))) → + TouchingTriple X Y Z))) + ) := by + classical + intro q hT2 hT5 turn5 i X Y Z hX hY hZ ha hb + exact turn5 (q 0) (q i.succ) (q ((i + 1).succ)) X Y Z + (BandVectors.1 (q i.succ) (q 0)) (BandVectors.1 (q 0) (q i.succ)) + (BandVectors.1 (q ((i + 1).succ)) (q 0)) + (BandVectors.1 (q 0) (q ((i + 1).succ))) hX hY hZ + (hT2 0 X hX) (hT2 i.succ Y hY) (hT2 (i + 1).succ Z hZ) + (fun A B C hA hB hC ha' hb' => hT5 A B C i hA hB hC ha' hb') ha hb + +private theorem base3 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (∀ (a : Fin (4 : ℕ)), ∀ (T : ProtoTile), + BandPrototile (q a) T → QuarterTurnSymmetric T) → ((∀ (T₀ : ProtoTile), ∀ (Tᵢ : + ProtoTile), ∀ (Tⱼ : ProtoTile), ∀ (i : Fin (3 : ℕ)), BandPrototile (q (0 : Fin (4 : + ℕ))) T₀ → BandPrototile (q i.succ) Tᵢ → BandPrototile (q (i + (1 : Fin (3 : + ℕ))).succ) Tⱼ → TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 + (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid Tⱼ - TileCentroid T₀ = (1 / 2 : ℝ) + • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : + ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + (1 : Fin (3 : + ℕ))).succ))) → TouchingTriple T₀ Tᵢ Tⱼ) → ((∀ (C : CircleCoordinates), ∀ (D : + CircleCoordinates), ∀ (E : CircleCoordinates), ∀ (T : ProtoTile), ∀ (U : ProtoTile), + ∀ (V : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), ∀ + (w : GaussianInt), BandPrototile C T → BandPrototile D U → BandPrototile E V → + QuarterTurnSymmetric T → QuarterTurnSymmetric U → QuarterTurnSymmetric V → (∀ (X : + ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), BandPrototile C X → BandPrototile D + Y → BandPrototile E Z → TileCentroid Y - TileCentroid X = (1 / 2 : Real) • + (GaussianRealPoint x + GaussianRealPoint y) → TileCentroid Z - TileCentroid X = (1 / + 2 : Real) • (GaussianRealPoint z - GaussianRealPoint w) → TouchingTriple X Y Z) → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint + (GaussianQuarterTurn x) + GaussianRealPoint (GaussianQuarterTurn y)) → TileCentroid V + - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint (GaussianQuarterTurn z) - + GaussianRealPoint (GaussianQuarterTurn w)) → TouchingTriple T U V) → (∀ (i : Fin (3 : + ℕ)), ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), BandPrototile (q 0) X → + BandPrototile (q i.succ) Y → BandPrototile (q ((i + 1).succ)) Z → TileCentroid Y - + TileCentroid X = (1 / 2 : Real) • (GaussianRealPoint (GaussianQuarterTurn + (BandVectors.1 (q i.succ) (q 0))) + GaussianRealPoint (GaussianQuarterTurn + (BandVectors.1 (q 0) (q i.succ)))) → TileCentroid Z - TileCentroid X = (1 / 2 : Real) + • (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q ((i + 1).succ)) (q 0))) - + GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q ((i + 1).succ))))) → + TouchingTriple X Y Z))) + ) := by + classical + intro q hT2 hT5 turn5 i X Y Z hX hY hZ ha hb + exact turn5 (q 0) (q i.succ) (q ((i + 1).succ)) X Y Z + (BandVectors.1 (q i.succ) (q 0)) (BandVectors.1 (q 0) (q i.succ)) + (BandVectors.1 (q ((i + 1).succ)) (q 0)) (BandVectors.1 (q 0) (q ((i + 1).succ))) + hX hY hZ (hT2 0 X hX) (hT2 i.succ Y hY) (hT2 (i + 1).succ Z hZ) + (fun A B C hA hB hC ha' hb' => hT5 A B C i hA hB hC ha' hb') ha hb + +private theorem firstAt570 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (∀ (a : Fin (4 : ℕ)), ∀ (T : ProtoTile), + BandPrototile (q a) T → QuarterTurnSymmetric T) → ((∀ (C : CircleCoordinates), ∀ (D : + CircleCoordinates), ∀ (E : CircleCoordinates), ∀ (T : ProtoTile), ∀ (U : ProtoTile), + ∀ (V : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), ∀ + (w : GaussianInt), BandPrototile C T → BandPrototile D U → BandPrototile E V → + QuarterTurnSymmetric T → QuarterTurnSymmetric U → QuarterTurnSymmetric V → (∀ (X : + ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), BandPrototile C X → BandPrototile D + Y → BandPrototile E Z → TileCentroid Y - TileCentroid X = (1 / 2 : Real) • + (GaussianRealPoint x + GaussianRealPoint y) → TileCentroid Z - TileCentroid X = (1 / + 2 : Real) • (GaussianRealPoint z - GaussianRealPoint w) → TouchingTriple X Y Z) → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint + (GaussianQuarterTurn x) + GaussianRealPoint (GaussianQuarterTurn y)) → TileCentroid V + - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint (GaussianQuarterTurn z) - + GaussianRealPoint (GaussianQuarterTurn w)) → TouchingTriple T U V) → (∀ (i : Fin (3 : + ℕ)), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), BandPrototile (q 0) X + → BandPrototile (q i.succ) Y → BandPrototile (q ((i + 1).succ)) Z → TileCentroid Y - + TileCentroid X = (1 / 2 : Real) • (GaussianRealPoint (GaussianQuarterTurn + (BandVectors.1 (q i.succ) (q 0))) + GaussianRealPoint (GaussianQuarterTurn + (BandVectors.1 (q 0) (q i.succ)))) → TileCentroid Z - TileCentroid X = (1 / 2 : Real) + • (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q ((i + 1).succ)) (q 0))) - + GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q ((i + 1).succ))))) → + TouchingTriple X Y Z) → (∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), + BandPrototile (q 0) X → BandPrototile (q i.succ) Y → BandPrototile (q ((i + 1).succ)) + Z → TileCentroid Y - TileCentroid X = (1 / 2 : Real) • (GaussianRealPoint + (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)))) + + GaussianRealPoint (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q 0) (q + i.succ))))) → TileCentroid Z - TileCentroid X = (1 / 2 : Real) • (GaussianRealPoint + (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q ((i + 1).succ)) (q 0)))) + - GaussianRealPoint (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q 0) (q + ((i + 1).succ)))))) → TouchingTriple X Y Z))) + ) := by + classical + intro q hT2 turn5 i base3 X Y Z hX hY hZ ha hb + exact turn5 (q 0) (q i.succ) (q ((i + 1).succ)) X Y Z + (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0))) + (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ))) + (GaussianQuarterTurn (BandVectors.1 (q ((i + 1).succ)) (q 0))) + (GaussianQuarterTurn (BandVectors.1 (q 0) (q ((i + 1).succ)))) hX hY hZ + (hT2 0 X hX) (hT2 i.succ Y hY) (hT2 (i + 1).succ Z hZ) + base3 ha hb + +end TouchingCovarianceProof + +theorem OrientedTouchingCovariance : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ((∀ (a : Fin 4), ∀ (T : + ProtoTile), BandPrototile (q a) T → QuarterTurnSymmetric T) → ((∀ (T₀ : ProtoTile), ∀ (Tᵢ + : ProtoTile), ∀ (i : Fin 3), BandPrototile (q 0) T₀ → BandPrototile (q i.succ) Tᵢ → + TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TouchingTriple T₀ + (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) Tᵢ) → ((∀ (T₀ : ProtoTile), ∀ (Tᵢ : + ProtoTile), ∀ (Tⱼ : ProtoTile), ∀ (i : Fin 3), BandPrototile (q 0) T₀ → BandPrototile + (q i.succ) Tᵢ → + BandPrototile (q ((i + 1).succ)) Tⱼ → + TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TileCentroid Tⱼ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ)))) → + TouchingTriple T₀ Tᵢ Tⱼ) → ((∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (i : Fin 3), ∀ (s : + Fin 4), BandPrototile (q 0) T₀ → BandPrototile (q i.succ) Tᵢ → + TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (q i.succ) (q 0))) + + GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (q 0) (q i.succ)))) → + TouchingTriple T₀ + (TileTranslation T₀ + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (q i.succ) (q 0)))) Tᵢ) ∧ + (∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (Tⱼ : ProtoTile), ∀ (i : Fin 3), ∀ (s : Fin 4), + BandPrototile (q 0) T₀ → BandPrototile (q i.succ) Tᵢ → + BandPrototile (q ((i + 1).succ)) Tⱼ → + TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (q i.succ) (q 0))) + + GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (q 0) (q i.succ)))) → + TileCentroid Tⱼ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (q ((i + 1).succ)) (q 0))) - + GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (q 0) (q ((i + 1).succ))))) → + TouchingTriple T₀ Tᵢ Tⱼ))))) := by + intro q hq hT2 hT4 hT5 +-- BODY + have quarter_translate (T : ProtoTile) (x : GaussianInt) : + TileQuarterTurn (TileTranslation T x) = + TileTranslation (TileQuarterTurn T) (GaussianQuarterTurn x) := + TouchingCovarianceProof.quarter_translate T x + have same_touch (A B C A' B' C' : ProtoTile) + (ha : A.cells = A'.cells) (hb : B.cells = B'.cells) + (hc : C.cells = C'.cells) + (haa : A.cells = ∅ → A.anchor = A'.anchor) + (hbb : B.cells = ∅ → B.anchor = B'.anchor) + (hcc : C.cells = ∅ → C.anchor = C'.anchor) : + TouchingTriple A B C ↔ TouchingTriple A' B' C' := TouchingCovarianceProof.same_touch A B C + A' B' C' ha hb hc haa hbb hcc + have shift_centroid (T U : ProtoTile) (uT uU : GaussianInt) + (x y : GaussianInt) + (huT : GaussianRealPoint uT = + ((TileCentroid T).1 + (TileCentroid T).2, + (TileCentroid T).2 - (TileCentroid T).1)) + (huU : GaussianRealPoint uU = + ((TileCentroid U).1 + (TileCentroid U).2, + (TileCentroid U).2 - (TileCentroid U).1)) + (hcent : TileCentroid U - TileCentroid T = + (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn x) + + GaussianRealPoint (GaussianQuarterTurn y))) : + TileCentroid (TileTranslation U ⟨uU.im, -uU.re⟩) - + TileCentroid (TileTranslation T ⟨uT.im, -uT.re⟩) = + (1 / 2 : Real) • (GaussianRealPoint x + GaussianRealPoint y) := + TouchingCovarianceProof.shift_centroid T U uT uU x y huT huU hcent + have turn4 : ∀ (C D : CircleCoordinates) (T U : ProtoTile) + (x y : GaussianInt), + BandPrototile C T → BandPrototile D U → + QuarterTurnSymmetric T → QuarterTurnSymmetric U → + (∀ (X Y : ProtoTile), BandPrototile C X → BandPrototile D Y → + TileCentroid Y - TileCentroid X = + (1 / 2 : Real) • + (GaussianRealPoint x + GaussianRealPoint y) → + TouchingTriple X (TileTranslation X x) Y) → + (TileCentroid U - TileCentroid T = + (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn x) + + GaussianRealPoint (GaussianQuarterTurn y))) → + TouchingTriple T + (TileTranslation T (GaussianQuarterTurn x)) U := TouchingCovarianceProof.turn4 + quarter_translate same_touch + have turn5 : ∀ (C D E : CircleCoordinates) (T U V : ProtoTile) + (x y z w : GaussianInt), + BandPrototile C T → BandPrototile D U → BandPrototile E V → + QuarterTurnSymmetric T → QuarterTurnSymmetric U → QuarterTurnSymmetric V → + (∀ (X Y Z : ProtoTile), BandPrototile C X → BandPrototile D Y → + BandPrototile E Z → + TileCentroid Y - TileCentroid X = (1 / 2 : Real) • + (GaussianRealPoint x + GaussianRealPoint y) → + TileCentroid Z - TileCentroid X = (1 / 2 : Real) • + (GaussianRealPoint z - GaussianRealPoint w) → + TouchingTriple X Y Z) → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn x) + GaussianRealPoint (GaussianQuarterTurn y)) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn z) - GaussianRealPoint (GaussianQuarterTurn w)) → + TouchingTriple T U V := TouchingCovarianceProof.turn5 quarter_translate same_touch + shift_centroid + have inverse_turn (x : GaussianInt) : + GaussianQuarterTurn ⟨x.im, -x.re⟩ = x := by + ext <;> simp [GaussianQuarterTurn] + constructor + · intro T₀ Tᵢ i s h₀ hᵢ hc + fin_cases s + · simpa using hT4 T₀ Tᵢ i h₀ hᵢ hc + · exact turn4 (q 0) (q i.succ) T₀ Tᵢ + (BandVectors.1 (q i.succ) (q 0)) + (BandVectors.1 (q 0) (q i.succ)) h₀ hᵢ + (hT2 0 T₀ h₀) (hT2 i.succ Tᵢ hᵢ) + (fun X Y hX hY hcent => hT4 X Y i hX hY hcent) hc + · have first : ∀ (X Y : ProtoTile), BandPrototile (q 0) X → + BandPrototile (q i.succ) Y → + TileCentroid Y - TileCentroid X = + (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0))) + + GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ)))) → + TouchingTriple X (TileTranslation X + (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)))) Y := + TouchingCovarianceProof.firstAt463 q hT2 hT4 turn4 i + exact turn4 (q 0) (q i.succ) T₀ Tᵢ + (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0))) + (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ))) h₀ hᵢ + (hT2 0 T₀ h₀) (hT2 i.succ Tᵢ hᵢ) first + (by simpa [Function.iterate_succ_apply] using hc) + · have first : ∀ (X Y : ProtoTile), BandPrototile (q 0) X → + BandPrototile (q i.succ) Y → + TileCentroid Y - TileCentroid X = + (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0))) + + GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ)))) → + TouchingTriple X (TileTranslation X + (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)))) Y := + TouchingCovarianceProof.firstAt482 q hT2 hT4 turn4 i + exact turn4 (q 0) (q i.succ) T₀ Tᵢ + (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)))) + (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ)))) h₀ hᵢ + (hT2 0 T₀ h₀) (hT2 i.succ Tᵢ hᵢ) + (fun X Y hX hY hz => + turn4 (q 0) (q i.succ) X Y + (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0))) + (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ))) hX hY + (hT2 0 X hX) (hT2 i.succ Y hY) first hz) + (by simpa [Function.iterate_succ_apply] using hc) + · intro T₀ Tᵢ Tⱼ i s h₀ hᵢ hⱼ hcᵢ hcⱼ + fin_cases s + · simpa using hT5 T₀ Tᵢ Tⱼ i h₀ hᵢ hⱼ hcᵢ hcⱼ + · exact turn5 (q 0) (q i.succ) (q ((i + 1).succ)) T₀ Tᵢ Tⱼ + (BandVectors.1 (q i.succ) (q 0)) + (BandVectors.1 (q 0) (q i.succ)) + (BandVectors.1 (q ((i + 1).succ)) (q 0)) + (BandVectors.1 (q 0) (q ((i + 1).succ))) h₀ hᵢ hⱼ + (hT2 0 T₀ h₀) (hT2 i.succ Tᵢ hᵢ) + (hT2 (i + 1).succ Tⱼ hⱼ) + (fun X Y Z hX hY hZ ha hb => hT5 X Y Z i hX hY hZ ha hb) hcᵢ hcⱼ + · have base : ∀ (X Y Z : ProtoTile), BandPrototile (q 0) X → + BandPrototile (q i.succ) Y → BandPrototile (q ((i + 1).succ)) Z → + TileCentroid Y - TileCentroid X = (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0))) + + GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ)))) → + TileCentroid Z - TileCentroid X = (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q ((i + 1).succ)) (q 0))) - + GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q ((i + 1).succ))))) → + TouchingTriple X Y Z := TouchingCovarianceProof.base q hT2 hT5 turn5 i + have first : ∀ (X Y Z : ProtoTile), BandPrototile (q 0) X → + BandPrototile (q i.succ) Y → BandPrototile (q ((i + 1).succ)) Z → + TileCentroid Y - TileCentroid X = (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0))) + + GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ)))) → + TileCentroid Z - TileCentroid X = (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q ((i + 1).succ)) (q 0))) - + GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q ((i + 1).succ))))) → + TouchingTriple X Y Z := TouchingCovarianceProof.firstAt532 q hT2 hT5 turn5 i + exact turn5 (q 0) (q i.succ) (q ((i + 1).succ)) T₀ Tᵢ Tⱼ + (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0))) + (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ))) + (GaussianQuarterTurn (BandVectors.1 (q ((i + 1).succ)) (q 0))) + (GaussianQuarterTurn (BandVectors.1 (q 0) (q ((i + 1).succ)))) h₀ hᵢ hⱼ + (hT2 0 T₀ h₀) (hT2 i.succ Tᵢ hᵢ) (hT2 (i + 1).succ Tⱼ hⱼ) + first hcᵢ hcⱼ + · have base3 : ∀ (X Y Z : ProtoTile), BandPrototile (q 0) X → + BandPrototile (q i.succ) Y → BandPrototile (q ((i + 1).succ)) Z → + TileCentroid Y - TileCentroid X = (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0))) + + GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ)))) → + TileCentroid Z - TileCentroid X = (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q ((i + 1).succ)) (q 0))) - + GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q ((i + 1).succ))))) → + TouchingTriple X Y Z := TouchingCovarianceProof.base3 q hT2 hT5 turn5 i + have first : ∀ (X Y Z : ProtoTile), BandPrototile (q 0) X → + BandPrototile (q i.succ) Y → BandPrototile (q ((i + 1).succ)) Z → + TileCentroid Y - TileCentroid X = (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q + i.succ) (q 0)))) + + GaussianRealPoint (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q 0) (q + i.succ))))) → + TileCentroid Z - TileCentroid X = (1 / 2 : Real) • + (GaussianRealPoint (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q ((i + + 1).succ)) (q 0)))) - + GaussianRealPoint (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q 0) (q + ((i + 1).succ)))))) → + TouchingTriple X Y Z := TouchingCovarianceProof.firstAt570 q hT2 turn5 i base3 + exact turn5 (q 0) (q i.succ) (q ((i + 1).succ)) T₀ Tᵢ Tⱼ + (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)))) + (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ)))) + (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q ((i + 1).succ)) (q 0)))) + (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q 0) (q ((i + 1).succ))))) h₀ + hᵢ hⱼ + (hT2 0 T₀ h₀) (hT2 i.succ Tᵢ hᵢ) (hT2 (i + 1).succ Tⱼ hⱼ) + first hcᵢ hcⱼ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OrientedUnimodularStripConcatenation.lean b/LeanPool/ApollonianSuperharmonic/OrientedUnimodularStripConcatenation.lean new file mode 100644 index 0000000000..7e7e9079a0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OrientedUnimodularStripConcatenation.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3019T1ChamberSegmentOrder +public import LeanPool.ApollonianSuperharmonic.P3019T1UnimodularStripWindow + +-- [TABLET NODE: OrientedUnimodularStripConcatenation] + +/-! +# OrientedUnimodularStripConcatenation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem OrientedUnimodularStripConcatenation + (x : Int × Int) (a b c d : Int) + (hab : 0 ≤ b ∧ b ≤ a) (hcd : 0 ≤ d ∧ d ≤ c) + (horient : a * d - b * c = -1) + (left right : List (Int × Int)) + (hleft : TriangularStripSegment x (x + (a, b)) left) + (hright : TriangularStripSegment (x + (a, b)) + (x + (a, b) + (c, d)) right) : + TriangularStripSegment x (x + (a, b) + (c, d)) + (left.dropLast ++ right) := by +-- BODY + obtain ⟨ha, hc, hwindowLeft, hwindowRight⟩ := + P3019T1UnimodularStripWindow x a b c d hab hcd horient + have hleftNe : x ≠ x + (a, b) := by + intro he + have hh := congrArg Prod.fst he + simp only [Prod.fst_add] at hh + omega + have hrightNe : x + (a, b) ≠ x + (a, b) + (c, d) := by + intro he + have hh := congrArg Prod.fst he + simp only [Prod.fst_add] at hh + omega + have htotalNe : x ≠ x + (a, b) + (c, d) := by + intro he + have hh := congrArg Prod.fst he + simp only [Prod.fst_add] at hh + omega + have hl : left.head? = some x ∧ left.getLast? = some (x + (a, b)) ∧ + left.Nodup ∧ (∀ z ∈ left, TriangularBoundaryStrip x (x + (a, b)) z) ∧ + left.IsChain TriangularLatticeAdjacent := by + simpa [TriangularStripSegment, hleftNe, List.IsChain] using hleft + have hr : right.head? = some (x + (a, b)) ∧ + right.getLast? = some (x + (a, b) + (c, d)) ∧ + right.Nodup ∧ (∀ z ∈ right, + TriangularBoundaryStrip (x + (a, b)) (x + (a, b) + (c, d)) z) ∧ + right.IsChain TriangularLatticeAdjacent := by + simpa [TriangularStripSegment, hrightNe, List.IsChain] using hright + have horderLeft := P3019T1ChamberSegmentOrder x a b ha hab left hleft + have horderRight := P3019T1ChamberSegmentOrder (x + (a, b)) c d hc hcd right hright + have hgeomLeft := P3019T1ChamberStripGeometry x a b ha hab + have hgeomRight := P3019T1ChamberStripGeometry (x + (a, b)) c d hc hcd + have hstrip : ∀ z ∈ left.dropLast ++ right, + TriangularBoundaryStrip x (x + (a, b) + (c, d)) z := by + intro z hz + rcases List.mem_append.mp hz with hz | hz + · have hzLeft := List.mem_of_mem_dropLast hz + have hbounds := horderLeft.2.2.1 z hzLeft + have hheight := (hgeomLeft.2.1 z).mp (hl.2.2.2.1 z hzLeft) + have hrep : x + (z.1 - x.1, z.2 - x.2) = z := by + ext <;> simp + have hh := hwindowLeft (z.1 - x.1) (z.2 - x.2) (by constructor <;> omega) hheight + simpa only [hrep] using hh + · have hbounds := horderRight.2.2.1 z hz + have hheight := (hgeomRight.2.1 z).mp (hr.2.2.2.1 z hz) + simp only [Prod.fst_add, Prod.snd_add] at hbounds hheight + have hrep : x + (a, b) + (z.1 - (x.1 + a), z.2 - (x.2 + b)) = z := by + ext <;> simp + have hh := hwindowRight (z.1 - (x.1 + a)) (z.2 - (x.2 + b)) + (by constructor <;> omega) hheight + simpa only [hrep] using hh + have hleftConcat : left.dropLast ++ [x + (a, b)] = left := + List.dropLast_append_getLast? _ (by simp only [hl.2.1, Option.mem_def]) + have hrightCons : (x + (a, b)) :: right.tail = right := + List.cons_head?_tail (by simp only [hr.1, Option.mem_def]) + have hxmem : x ∈ left := List.mem_of_mem_head? (by simp [hl.1]) + have hxdrop : x ∈ left.dropLast := + List.mem_dropLast_of_mem_of_ne_getLast? hxmem (by + rw [hl.2.1] + simpa using hleftNe) + have hdropNe : left.dropLast ≠ [] := List.ne_nil_of_mem hxdrop + have hdropHead : left.dropLast.head? = some x := by + have hh := congrArg List.head? hleftConcat + rw [List.head?_append_of_ne_nil _ hdropNe] at hh + exact hh.trans hl.1 + have hrightNonempty : right ≠ [] := by + intro he + simp [he] at hr + have hnodup : (left.dropLast ++ right).Nodup := by + apply List.nodup_append.mpr + refine ⟨hl.2.2.1.sublist (List.dropLast_sublist left), hr.2.2.1, ?_⟩ + intro z hz y hy he + have hzbound := horderLeft.2.2.2 z hz + have hybound := (horderRight.2.2.1 y hy).1 + simp only [Prod.fst_add] at hybound + have hh := congrArg Prod.fst he + omega + have hchain : (left.dropLast ++ right).IsChain TriangularLatticeAdjacent := by + have hchainLeft : (left.dropLast ++ [x + (a, b)]).IsChain + TriangularLatticeAdjacent := by + rw [hleftConcat] + exact hl.2.2.2.2 + have hchainRight : ([x + (a, b)] ++ right.tail).IsChain + TriangularLatticeAdjacent := by + simpa only [List.singleton_append, hrightCons] using hr.2.2.2.2 + have hh := hchainLeft.append_overlap hchainRight (by simp) + simpa only [List.append_assoc, List.singleton_append, hrightCons] using hh + rw [TriangularStripSegment, ite_eq_right htotalNe] + refine ⟨?_, ?_, hnodup, hstrip, hchain⟩ + · rw [List.head?_append_of_ne_nil _ hdropNe] + exact hdropHead + · rw [List.getLast?_append_of_ne_nil _ hrightNonempty] + exact hr.2.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OuterLayoutTouching.lean b/LeanPool/ApollonianSuperharmonic/OuterLayoutTouching.lean new file mode 100644 index 0000000000..374f1345f7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OuterLayoutTouching.lean @@ -0,0 +1,831 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.OuterTouchingAlternative +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: OuterLayoutTouching] + +/-! +# OuterLayoutTouching + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OuterTouchingProof + +private theorem retarget : + (by + classical + exact + ∀ (K : CircleCoordinates), ∀ (X : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (Y + : ProtoTile), BandPrototile K U → BandPrototile K V → TileCentroid U = TileCentroid V + → TouchingTriple X U Y → TouchingTriple X V Y + ) := by + classical + intro K X U V Y hU hV hUV h + obtain ⟨he, ha⟩ := BandPrototileCentroidUnique K U V hU hV hUV + have obs := ProtoTileObservableExtensionality U V he ha + have left : TileTouching X U ↔ TileTouching X V := by + by_cases hz : U.cells = ∅ + · simp only [TileTouching, he, obs.2.1, obs.2.2.1, ha hz] + · have hz' : V.cells ≠ ∅ := by rwa [← he] + simp only [TileTouching, hz', false_and, or_false, he, + obs.2.1, obs.2.2.1] + have right : TileTouching U Y ↔ TileTouching V Y := by + by_cases hz : U.cells = ∅ + · simp only [TileTouching, he, obs.2.1, obs.2.2.1, ha hz] + · have hz' : V.cells ≠ ∅ := by rwa [← he] + simp only [TileTouching, hz', false_and, he, + obs.2.1, obs.2.2.1] + simpa only [TouchingTriple, left, right, obs.2.1] using h + +private theorem row1 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), (∀ (T₀ + : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), + BandPrototile (r (0 : Fin (4 : ℕ))) T₀ → BandPrototile (r i.succ) Tᵢ → TileCentroid + Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[(↑s : + ℕ)] (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))))) + GaussianRealPoint + (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → + TouchingTriple T₀ (TileTranslation T₀ (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 + (r i.succ) (r (0 : Fin (4 : ℕ)))))) Tᵢ) → (∀ (x : ℝ × ℝ), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), + let A := S 0 true + let B := S 0 false + let E := S 2 true + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + let c := BandVectors.1 (q 2) (q 1) + let v := BandVectors.1 (q 0) (q 2) + (c = -a - b) → ((v = I * c + a) → ((BandVectors.1 (r 0) (r 3) = b) → ((BandVectors.1 (r + 3) (r 0) = -I * b) → ((BandPrototile (r 0) A) → ((BandPrototile (r 0) B) → + ((BandPrototile (r 3) E) → ((∀ (T : ProtoTile), ∀ (z : GaussianInt), TileCentroid + (TileTranslation T z) = TileCentroid T + GaussianRealPoint z) → (((TileCentroid A).1 + - x.1 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)) → (((TileCentroid A).2 - x.2 = (2 + : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex + : GaussianInt → ℂ) a).re)) → (((TileCentroid B).1 - x.1 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + ((GaussianInt.toComplex : + GaussianInt → ℂ) a).im))) → (((TileCentroid B).2 - x.2 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) a).re))) → (((TileCentroid E).1 - x.1 = (2 : ℝ)⁻¹ * + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : + GaussianInt → ℂ) b).re - (((GaussianInt.toComplex : GaussianInt → ℂ) b).im + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → (((TileCentroid E).2 - x.2 = (2 + : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex + : GaussianInt → ℂ) b).im - (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re))) → ((∀ (K : CircleCoordinates), ∀ + (X : ProtoTile), ∀ (X' : ProtoTile), ∀ (Y : ProtoTile), ∀ (z : GaussianInt), + (BandPrototile K X) → ((BandPrototile K X') → ((TileCentroid X' - TileCentroid X = + GaussianRealPoint z) → ((TouchingTriple X (TileTranslation X z) Y) → (TouchingTriple + X X' Y))))) → (TouchingTriple A (TileTranslation B v) (TileTranslation E + v))))))))))))))))) + ) := by + classical + intro q r hT4r x S A B E I a b c v hc hv hr03 hr30 hA hB hE shift hAx hAy hBx hBy hEx hEy literal + have h : TouchingTriple (TileTranslation B v) A (TileTranslation E v) := by + refine literal (r 0) (TileTranslation B v) A (TileTranslation E v) + ((GaussianQuarterTurn^[2]) (BandVectors.1 (r 3) (r 0))) + (BandPrototileTranslation _ _ _ hB) hA ?_ + (hT4r (TileTranslation B v) (TileTranslation E v) 2 2 + (BandPrototileTranslation _ _ _ hB) + (BandPrototileTranslation _ _ _ hE) ?_) + · apply Prod.ext <;> + simp [shift, hv, hc, hr30, GaussianRealPoint, GaussianQuarterTurn, I, + Function.iterate_succ_apply] <;> + linarith only [hAx, hAy, hBx, hBy] + · change TileCentroid (TileTranslation E v) - TileCentroid (TileTranslation B v) = + (1 / 2 : Real) • + (GaussianRealPoint ((GaussianQuarterTurn^[2]) (BandVectors.1 (r 3) (r 0))) + + GaussianRealPoint ((GaussianQuarterTurn^[2]) (BandVectors.1 (r 0) (r 3)))) + apply Prod.ext <;> + simp [shift, hv, hc, hr30, hr03, GaussianRealPoint, GaussianQuarterTurn, I, + Function.iterate_succ_apply] <;> + linarith only [hBx, hBy, hEx, hEy] + exact ((TouchingTriplePermutations _ _ _).mp h).2.1 + +private theorem row2 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), (∀ (T₀ + : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), + BandPrototile (r (0 : Fin (4 : ℕ))) T₀ → BandPrototile (r i.succ) Tᵢ → TileCentroid + Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[(↑s : + ℕ)] (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))))) + GaussianRealPoint + (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → + TouchingTriple T₀ (TileTranslation T₀ (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 + (r i.succ) (r (0 : Fin (4 : ℕ)))))) Tᵢ) → (∀ (x : ℝ × ℝ), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), + let A := S 0 true + let B := S 0 false + let F := S 2 false + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + let c := BandVectors.1 (q 2) (q 1) + let v := BandVectors.1 (q 0) (q 2) + (c = -a - b) → ((v = I * c + a) → ((BandVectors.1 (r 0) (r 3) = b) → ((BandVectors.1 (r + 3) (r 0) = -I * b) → ((BandPrototile (r 0) A) → ((BandPrototile (r 0) B) → + ((BandPrototile (r 3) F) → ((∀ (T : ProtoTile), ∀ (z : GaussianInt), TileCentroid + (TileTranslation T z) = TileCentroid T + GaussianRealPoint z) → (((TileCentroid A).1 + - x.1 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)) → (((TileCentroid A).2 - x.2 = (2 + : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex + : GaussianInt → ℂ) a).re)) → (((TileCentroid B).1 - x.1 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + ((GaussianInt.toComplex : + GaussianInt → ℂ) a).im))) → (((TileCentroid B).2 - x.2 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) a).re))) → (((TileCentroid F).1 - x.1 = -((2 : ℝ)⁻¹ * + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : + GaussianInt → ℂ) b).re - (((GaussianInt.toComplex : GaussianInt → ℂ) b).im + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)))) → (((TileCentroid F).2 - x.2 = + -((2 : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im - (-((GaussianInt.toComplex : + GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : GaussianInt → ℂ) b).re)))) → ((∀ + (K : CircleCoordinates), ∀ (X : ProtoTile), ∀ (X' : ProtoTile), ∀ (Y : ProtoTile), ∀ + (z : GaussianInt), (BandPrototile K X) → ((BandPrototile K X') → ((TileCentroid X' - + TileCentroid X = GaussianRealPoint z) → ((TouchingTriple X (TileTranslation X z) Y) → + (TouchingTriple X X' Y))))) → (TouchingTriple A (TileTranslation B v) F)))))))))))))))) + ) := by + classical + intro q r hT4r x S A B F I a b c v hc hv hr03 hr30 hA hB hF shift hAx hAy hBx hBy hFx hFy literal + refine literal (r 0) A (TileTranslation B v) F + (BandVectors.1 (r 3) (r 0)) hA + (BandPrototileTranslation _ _ _ hB) ?_ (hT4r A F 2 0 hA hF ?_) + · apply Prod.ext <;> + simp [shift, hv, hc, hr30, GaussianRealPoint, I] <;> + linarith only [hAx, hAy, hBx, hBy] + · change TileCentroid F - TileCentroid A = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (r 3) (r 0)) + + GaussianRealPoint (BandVectors.1 (r 0) (r 3))) + apply Prod.ext <;> + simp [hr30, hr03, GaussianRealPoint, I] <;> + linarith only [hAx, hAy, hFx, hFy] + +private theorem row3 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), (∀ (T₀ + : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), + BandPrototile (r (0 : Fin (4 : ℕ))) T₀ → BandPrototile (r i.succ) Tᵢ → TileCentroid + Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[(↑s : + ℕ)] (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))))) + GaussianRealPoint + (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → + TouchingTriple T₀ (TileTranslation T₀ (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 + (r i.succ) (r (0 : Fin (4 : ℕ)))))) Tᵢ) → (∀ (x : ℝ × ℝ), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), + let A := S 0 true + let B := S 0 false + let C := S 1 true + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + let c := BandVectors.1 (q 2) (q 1) + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + (c = -a - b) → ((u = I * b + c) → ((v = I * c + a) → ((BandVectors.1 (r 2) (r 0) = c) → + ((BandVectors.1 (r 0) (r 2) = I * c) → ((BandPrototile (r 0) A) → ((BandPrototile (r + 0) B) → ((BandPrototile (r 2) C) → ((∀ (T : ProtoTile), ∀ (z : GaussianInt), + TileCentroid (TileTranslation T z) = TileCentroid T + GaussianRealPoint z) → + (((TileCentroid A).1 - x.1 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) + a).re + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)) → (((TileCentroid A).2 - + x.2 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re)) → (((TileCentroid B).1 - x.1 = + -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → (((TileCentroid B).2 - x.2 = + -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re))) → (((TileCentroid C).1 - x.1 = (2 + : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + ((GaussianInt.toComplex + : GaussianInt → ℂ) b).im)) → (((TileCentroid C).2 - x.2 = (2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) b).re)) → ((∀ (K : CircleCoordinates), ∀ (X : ProtoTile), ∀ (X' : + ProtoTile), ∀ (Y : ProtoTile), ∀ (z : GaussianInt), (BandPrototile K X) → + ((BandPrototile K X') → ((TileCentroid X' - TileCentroid X = GaussianRealPoint z) → + ((TouchingTriple X (TileTranslation X z) Y) → (TouchingTriple X X' Y))))) → + (TouchingTriple A (TileTranslation B (u + v)) (TileTranslation C (u + + v))))))))))))))))))) + ) := by + classical + intro q r hT4r x S A B C I a b c u v hc hu hv hr20 hr02 hA hB hC shift hAx hAy hBx hBy hCx hCy + literal + refine literal (r 0) A (TileTranslation B (u + v)) (TileTranslation C (u + v)) + (BandVectors.1 (r 2) (r 0)) hA + (BandPrototileTranslation _ _ _ hB) ?_ + (hT4r A (TileTranslation C (u + v)) 1 0 hA + (BandPrototileTranslation _ _ _ hC) ?_) + · apply Prod.ext <;> + simp [shift, hu, hv, hc, hr20, GaussianRealPoint, I] <;> + linarith only [hAx, hAy, hBx, hBy] + · change TileCentroid (TileTranslation C (u + v)) - TileCentroid A = + (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (r 2) (r 0)) + + GaussianRealPoint (BandVectors.1 (r 0) (r 2))) + apply Prod.ext <;> + simp [shift, hu, hv, hc, hr20, hr02, GaussianRealPoint, I] <;> + linarith only [hAx, hAy, hCx, hCy] + +private theorem row4 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), (∀ (T₀ + : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), + BandPrototile (r (0 : Fin (4 : ℕ))) T₀ → BandPrototile (r i.succ) Tᵢ → TileCentroid + Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[(↑s : + ℕ)] (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))))) + GaussianRealPoint + (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → + TouchingTriple T₀ (TileTranslation T₀ (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 + (r i.succ) (r (0 : Fin (4 : ℕ)))))) Tᵢ) → (∀ (x : ℝ × ℝ), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), + let A := S 0 true + let B := S 0 false + let D := S 1 false + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + let c := BandVectors.1 (q 2) (q 1) + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + (c = -a - b) → ((u = I * b + c) → ((v = I * c + a) → ((BandVectors.1 (r 2) (r 0) = c) → + ((BandVectors.1 (r 0) (r 2) = I * c) → ((BandPrototile (r 0) A) → ((BandPrototile (r + 0) B) → ((BandPrototile (r 2) D) → ((∀ (T : ProtoTile), ∀ (z : GaussianInt), + TileCentroid (TileTranslation T z) = TileCentroid T + GaussianRealPoint z) → + (((TileCentroid A).1 - x.1 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) + a).re + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)) → (((TileCentroid A).2 - + x.2 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re)) → (((TileCentroid B).1 - x.1 = + -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → (((TileCentroid B).2 - x.2 = + -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re))) → (((TileCentroid D).1 - x.1 = + -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im))) → (((TileCentroid D).2 - x.2 = + -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re))) → ((∀ (K : CircleCoordinates), ∀ + (X : ProtoTile), ∀ (X' : ProtoTile), ∀ (Y : ProtoTile), ∀ (z : GaussianInt), + (BandPrototile K X) → ((BandPrototile K X') → ((TileCentroid X' - TileCentroid X = + GaussianRealPoint z) → ((TouchingTriple X (TileTranslation X z) Y) → (TouchingTriple + X X' Y))))) → (TouchingTriple A (TileTranslation B (u + v)) D))))))))))))))))) + ) := by + classical + intro q r hT4r x S A B D I a b c u v hc hu hv hr20 hr02 hA hB hD shift hAx hAy hBx hBy hDx hDy + literal + have h : TouchingTriple (TileTranslation B (u + v)) A D := by + refine literal (r 0) (TileTranslation B (u + v)) A D + ((GaussianQuarterTurn^[2]) (BandVectors.1 (r 2) (r 0))) + (BandPrototileTranslation _ _ _ hB) hA ?_ + (hT4r (TileTranslation B (u + v)) D 1 2 + (BandPrototileTranslation _ _ _ hB) hD ?_) + · apply Prod.ext <;> + simp [shift, hu, hv, hc, hr20, GaussianRealPoint, GaussianQuarterTurn, I, + Function.iterate_succ_apply] <;> + linarith only [hAx, hAy, hBx, hBy] + · change TileCentroid D - TileCentroid (TileTranslation B (u + v)) = + (1 / 2 : Real) • + (GaussianRealPoint ((GaussianQuarterTurn^[2]) (BandVectors.1 (r 2) (r 0))) + + GaussianRealPoint ((GaussianQuarterTurn^[2]) (BandVectors.1 (r 0) (r 2)))) + apply Prod.ext <;> + simp [shift, hu, hv, hc, hr20, hr02, GaussianRealPoint, GaussianQuarterTurn, I, + Function.iterate_succ_apply] <;> + linarith only [hBx, hBy, hDx, hDy] + exact ((TouchingTriplePermutations _ _ _).mp h).2.1 + +private theorem row5 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), (∀ (T₀ + : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (Tⱼ : ProtoTile), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin + (4 : ℕ)), BandPrototile (r (0 : Fin (4 : ℕ))) T₀ → BandPrototile (r i.succ) Tᵢ → + BandPrototile (r (i + (1 : Fin (3 : ℕ))).succ) Tⱼ → TileCentroid Tᵢ - TileCentroid T₀ + = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (r + i.succ) (r (0 : Fin (4 : ℕ))))) + GaussianRealPoint (GaussianQuarterTurn^[(↑s : ℕ)] + (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → TileCentroid Tⱼ - TileCentroid + T₀ = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 + (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))))) - GaussianRealPoint + (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin + (3 : ℕ))).succ)))) → TouchingTriple T₀ Tᵢ Tⱼ) → (∀ (x : ℝ × ℝ), ∀ (S : Fin (3 : ℕ) → + Bool → ProtoTile), + let A := S 0 true + let C := S 1 true + let E := S 2 true + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + let c := BandVectors.1 (q 2) (q 1) + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + (c = -a - b) → ((u = I * b + c) → ((v = I * c + a) → ((BandVectors.1 (r 2) (r 0) = c) → + ((BandVectors.1 (r 0) (r 2) = I * c) → ((BandVectors.1 (r 0) (r 3) = b) → + ((BandVectors.1 (r 3) (r 0) = -I * b) → ((BandPrototile (r 0) A) → ((BandPrototile (r + 2) C) → ((BandPrototile (r 3) E) → ((∀ (T : ProtoTile), ∀ (z : GaussianInt), + TileCentroid (TileTranslation T z) = TileCentroid T + GaussianRealPoint z) → + (((TileCentroid A).1 - x.1 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) + a).re + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)) → (((TileCentroid A).2 - + x.2 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re)) → (((TileCentroid C).1 - x.1 = (2 + : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + ((GaussianInt.toComplex + : GaussianInt → ℂ) b).im)) → (((TileCentroid C).2 - x.2 = (2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) b).re)) → (((TileCentroid E).1 - x.1 = (2 : ℝ)⁻¹ * + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : + GaussianInt → ℂ) b).re - (((GaussianInt.toComplex : GaussianInt → ℂ) b).im + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → (((TileCentroid E).2 - x.2 = (2 + : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex + : GaussianInt → ℂ) b).im - (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re))) → (TouchingTriple A + (TileTranslation C (u + v)) (TileTranslation E v))))))))))))))))))) + ) := by + classical + intro q r hT5r x S A C E I a b c u v hc hu hv hr20 hr02 hr03 hr30 hA hC hE shift hAx hAy hCx + hCy hEx hEy + apply hT5r A (TileTranslation C (u + v)) (TileTranslation E v) 1 0 hA + (BandPrototileTranslation _ _ _ hC) (BandPrototileTranslation _ _ _ hE) + · change TileCentroid (TileTranslation C (u + v)) - TileCentroid A = + (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (r 2) (r 0)) + + GaussianRealPoint (BandVectors.1 (r 0) (r 2))) + apply Prod.ext <;> + simp [shift, hu, hv, hc, hr20, hr02, GaussianRealPoint, I] <;> + linarith only [hAx, hAy, hCx, hCy] + · change TileCentroid (TileTranslation E v) - TileCentroid A = + (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (r 3) (r 0)) - + GaussianRealPoint (BandVectors.1 (r 0) (r 3))) + apply Prod.ext <;> + simp [shift, hv, hc, hr30, hr03, GaussianRealPoint, I] <;> + linarith only [hAx, hAy, hEx, hEy] + +private theorem row6 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), (∀ (T₀ + : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (Tⱼ : ProtoTile), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin + (4 : ℕ)), BandPrototile (r (0 : Fin (4 : ℕ))) T₀ → BandPrototile (r i.succ) Tᵢ → + BandPrototile (r (i + (1 : Fin (3 : ℕ))).succ) Tⱼ → TileCentroid Tᵢ - TileCentroid T₀ + = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (r + i.succ) (r (0 : Fin (4 : ℕ))))) + GaussianRealPoint (GaussianQuarterTurn^[(↑s : ℕ)] + (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → TileCentroid Tⱼ - TileCentroid + T₀ = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 + (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))))) - GaussianRealPoint + (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin + (3 : ℕ))).succ)))) → TouchingTriple T₀ Tᵢ Tⱼ) → (∀ (x : ℝ × ℝ), ∀ (S : Fin (3 : ℕ) → + Bool → ProtoTile), + let B := S 0 false + let D := S 1 false + let F := S 2 false + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + let c := BandVectors.1 (q 2) (q 1) + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + (c = -a - b) → ((u = I * b + c) → ((v = I * c + a) → ((BandVectors.1 (r 2) (r 0) = c) → + ((BandVectors.1 (r 0) (r 2) = I * c) → ((BandVectors.1 (r 0) (r 3) = b) → + ((BandVectors.1 (r 3) (r 0) = -I * b) → ((BandPrototile (r 0) B) → ((BandPrototile (r + 2) D) → ((BandPrototile (r 3) F) → ((∀ (T : ProtoTile), ∀ (z : GaussianInt), + TileCentroid (TileTranslation T z) = TileCentroid T + GaussianRealPoint z) → + (((TileCentroid B).1 - x.1 = -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → + ℂ) a).re + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → (((TileCentroid B).2 + - x.2 = -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re))) → (((TileCentroid D).1 - x.1 = + -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im))) → (((TileCentroid D).2 - x.2 = + -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re))) → (((TileCentroid F).1 - x.1 = + -((2 : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re - (((GaussianInt.toComplex : + GaussianInt → ℂ) b).im + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)))) → + (((TileCentroid F).2 - x.2 = -((2 : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → + ℂ) a).im - ((GaussianInt.toComplex : GaussianInt → ℂ) b).im - + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : + GaussianInt → ℂ) b).re)))) → (TouchingTriple B (TileTranslation D (-u - v)) + (TileTranslation F (-v)))))))))))))))))))) + ) := by + classical + intro q r hT5r x S B D F I a b c u v hc hu hv hr20 hr02 hr03 hr30 hB hD hF shift hBx hBy hDx + hDy hFx hFy + apply hT5r B (TileTranslation D (-u - v)) (TileTranslation F (-v)) 1 2 hB + (BandPrototileTranslation _ _ _ hD) (BandPrototileTranslation _ _ _ hF) + · change TileCentroid (TileTranslation D (-u - v)) - TileCentroid B = + (1 / 2 : Real) • + (GaussianRealPoint ((GaussianQuarterTurn^[2]) (BandVectors.1 (r 2) (r 0))) + + GaussianRealPoint ((GaussianQuarterTurn^[2]) (BandVectors.1 (r 0) (r 2)))) + apply Prod.ext <;> + simp [shift, hu, hv, hc, hr20, hr02, GaussianRealPoint, GaussianQuarterTurn, I, + Function.iterate_succ_apply] <;> + linarith only [hBx, hBy, hDx, hDy] + · change TileCentroid (TileTranslation F (-v)) - TileCentroid B = + (1 / 2 : Real) • + (GaussianRealPoint ((GaussianQuarterTurn^[2]) (BandVectors.1 (r 3) (r 0))) - + GaussianRealPoint ((GaussianQuarterTurn^[2]) (BandVectors.1 (r 0) (r 3)))) + apply Prod.ext <;> + simp [shift, hv, hc, hr30, hr03, GaussianRealPoint, GaussianQuarterTurn, I, + Function.iterate_succ_apply] <;> + linarith only [hBx, hBy, hFx, hFy] + +private theorem row7 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (t : Fin (4 : ℕ) → CircleCoordinates), (∀ (T₀ + : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), + BandPrototile (t (0 : Fin (4 : ℕ))) T₀ → BandPrototile (t i.succ) Tᵢ → TileCentroid + Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[(↑s : + ℕ)] (BandVectors.1 (t i.succ) (t (0 : Fin (4 : ℕ))))) + GaussianRealPoint + (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (t (0 : Fin (4 : ℕ))) (t i.succ)))) → + TouchingTriple T₀ (TileTranslation T₀ (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 + (t i.succ) (t (0 : Fin (4 : ℕ)))))) Tᵢ) → (∀ (x : ℝ × ℝ), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), + let C := S 1 true + let D := S 1 false + let E := S 2 true + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + let c := BandVectors.1 (q 2) (q 1) + let u := BandVectors.1 (q 0) (q 1) + (c = -a - b) → ((u = I * b + c) → ((BandVectors.1 (t 1) (t 0) = a) → ((BandVectors.1 (t + 0) (t 1) = I * a) → ((BandPrototile (t 0) C) → ((BandPrototile (t 0) D) → + ((BandPrototile (t 1) E) → ((∀ (T : ProtoTile), ∀ (z : GaussianInt), TileCentroid + (TileTranslation T z) = TileCentroid T + GaussianRealPoint z) → (((TileCentroid C).1 + - x.1 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im)) → (((TileCentroid C).2 - x.2 = (2 + : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - ((GaussianInt.toComplex + : GaussianInt → ℂ) b).re)) → (((TileCentroid D).1 - x.1 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + ((GaussianInt.toComplex : + GaussianInt → ℂ) b).im))) → (((TileCentroid D).2 - x.2 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) b).re))) → (((TileCentroid E).1 - x.1 = (2 : ℝ)⁻¹ * + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : + GaussianInt → ℂ) b).re - (((GaussianInt.toComplex : GaussianInt → ℂ) b).im + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → (((TileCentroid E).2 - x.2 = (2 + : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex + : GaussianInt → ℂ) b).im - (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re))) → ((∀ (K : CircleCoordinates), ∀ + (X : ProtoTile), ∀ (X' : ProtoTile), ∀ (Y : ProtoTile), ∀ (z : GaussianInt), + (BandPrototile K X) → ((BandPrototile K X') → ((TileCentroid X' - TileCentroid X = + GaussianRealPoint z) → ((TouchingTriple X (TileTranslation X z) Y) → (TouchingTriple + X X' Y))))) → (TouchingTriple C (TileTranslation D (-u)) (TileTranslation E + (-u)))))))))))))))))) + ) := by + classical + intro q t hT4t x S C D E I a b c u hc hu ht10 ht01 hCt hDt hEt shift hCx hCy hDx hDy hEx hEy + literal + refine literal (t 0) C (TileTranslation D (-u)) (TileTranslation E (-u)) + (BandVectors.1 (t 1) (t 0)) hCt + (BandPrototileTranslation _ _ _ hDt) ?_ + (hT4t C (TileTranslation E (-u)) 0 0 hCt + (BandPrototileTranslation _ _ _ hEt) ?_) + · apply Prod.ext <;> + simp [shift, hu, hc, ht10, GaussianRealPoint, I] <;> + linarith only [hCx, hCy, hDx, hDy] + · change TileCentroid (TileTranslation E (-u)) - TileCentroid C = + (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (t 1) (t 0)) + + GaussianRealPoint (BandVectors.1 (t 0) (t 1))) + apply Prod.ext <;> + simp [shift, hu, hc, ht10, ht01, GaussianRealPoint, I] <;> + linarith only [hCx, hCy, hEx, hEy] + +private theorem row8 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (t : Fin (4 : ℕ) → CircleCoordinates), (∀ (T₀ + : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), + BandPrototile (t (0 : Fin (4 : ℕ))) T₀ → BandPrototile (t i.succ) Tᵢ → TileCentroid + Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[(↑s : + ℕ)] (BandVectors.1 (t i.succ) (t (0 : Fin (4 : ℕ))))) + GaussianRealPoint + (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 (t (0 : Fin (4 : ℕ))) (t i.succ)))) → + TouchingTriple T₀ (TileTranslation T₀ (GaussianQuarterTurn^[(↑s : ℕ)] (BandVectors.1 + (t i.succ) (t (0 : Fin (4 : ℕ)))))) Tᵢ) → (∀ (x : ℝ × ℝ), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), + let C := S 1 true + let D := S 1 false + let F := S 2 false + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + let c := BandVectors.1 (q 2) (q 1) + let u := BandVectors.1 (q 0) (q 1) + (c = -a - b) → ((u = I * b + c) → ((BandVectors.1 (t 1) (t 0) = a) → ((BandVectors.1 (t + 0) (t 1) = I * a) → ((BandPrototile (t 0) C) → ((BandPrototile (t 0) D) → + ((BandPrototile (t 1) F) → ((∀ (T : ProtoTile), ∀ (z : GaussianInt), TileCentroid + (TileTranslation T z) = TileCentroid T + GaussianRealPoint z) → (((TileCentroid C).1 + - x.1 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im)) → (((TileCentroid C).2 - x.2 = (2 + : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - ((GaussianInt.toComplex + : GaussianInt → ℂ) b).re)) → (((TileCentroid D).1 - x.1 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + ((GaussianInt.toComplex : + GaussianInt → ℂ) b).im))) → (((TileCentroid D).2 - x.2 = -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - ((GaussianInt.toComplex : + GaussianInt → ℂ) b).re))) → (((TileCentroid F).1 - x.1 = -((2 : ℝ)⁻¹ * + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : + GaussianInt → ℂ) b).re - (((GaussianInt.toComplex : GaussianInt → ℂ) b).im + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)))) → (((TileCentroid F).2 - x.2 = + -((2 : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im - (-((GaussianInt.toComplex : + GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : GaussianInt → ℂ) b).re)))) → ((∀ + (K : CircleCoordinates), ∀ (X : ProtoTile), ∀ (X' : ProtoTile), ∀ (Y : ProtoTile), ∀ + (z : GaussianInt), (BandPrototile K X) → ((BandPrototile K X') → ((TileCentroid X' - + TileCentroid X = GaussianRealPoint z) → ((TouchingTriple X (TileTranslation X z) Y) → + (TouchingTriple X X' Y))))) → (TouchingTriple C (TileTranslation D (-u)) + F)))))))))))))))) + ) := by + classical + intro q t hT4t x S C D F I a b c u hc hu ht10 ht01 hCt hDt hFt shift hCx hCy hDx hDy hFx hFy + literal + have h : TouchingTriple (TileTranslation D (-u)) C F := by + refine literal (t 0) (TileTranslation D (-u)) C F + ((GaussianQuarterTurn^[2]) (BandVectors.1 (t 1) (t 0))) + (BandPrototileTranslation _ _ _ hDt) hCt ?_ + (hT4t (TileTranslation D (-u)) F 0 2 + (BandPrototileTranslation _ _ _ hDt) hFt ?_) + · apply Prod.ext <;> + simp [shift, hu, hc, ht10, GaussianRealPoint, GaussianQuarterTurn, I, + Function.iterate_succ_apply] <;> + linarith only [hCx, hCy, hDx, hDy] + · change TileCentroid F - TileCentroid (TileTranslation D (-u)) = + (1 / 2 : Real) • + (GaussianRealPoint ((GaussianQuarterTurn^[2]) (BandVectors.1 (t 1) (t 0))) + + GaussianRealPoint ((GaussianQuarterTurn^[2]) (BandVectors.1 (t 0) (t 1)))) + apply Prod.ext <;> + simp [shift, hu, hc, ht10, ht01, GaussianRealPoint, GaussianQuarterTurn, I, + Function.iterate_succ_apply] <;> + linarith only [hDx, hDy, hFx, hFy] + exact ((TouchingTriplePermutations _ _ _).mp h).2.1 + +end OuterTouchingProof + +theorem OuterLayoutTouching : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin 4 → CircleCoordinates), ∀ (t : Fin 4 → + CircleCoordinates), (ProperBandQuadruple q) → ((ProperBandQuadruple r) → + ((ProperBandQuadruple t) → ((r 0 = q 1) → ((r 2 = q 2) → ((r 3 = q 3) → ((t 0 = q 2) → + ((t 1 = q 3) → (((r 0).1 < (q 0).1) → (((t 0).1 < (q 0).1) → ((∀ (T₀ : ProtoTile), ∀ (Tᵢ + : ProtoTile), ∀ (i : Fin 3), ∀ (s : Fin 4), BandPrototile (r 0) T₀ → BandPrototile (r + i.succ) Tᵢ → + TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (r i.succ) (r 0))) + + GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (r 0) (r i.succ)))) → + TouchingTriple T₀ + (TileTranslation T₀ + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (r i.succ) (r 0)))) Tᵢ) → ((∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ + (Tⱼ : ProtoTile), ∀ (i : Fin 3), ∀ (s : Fin 4), BandPrototile (r 0) T₀ → + BandPrototile (r i.succ) Tᵢ → + BandPrototile (r ((i + 1).succ)) Tⱼ → + TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (r i.succ) (r 0))) + + GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (r 0) (r i.succ)))) → + TileCentroid Tⱼ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (r ((i + 1).succ)) (r 0))) - + GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (r 0) (r ((i + 1).succ))))) → + TouchingTriple T₀ Tᵢ Tⱼ) → ((∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (i : Fin 3), ∀ (s : + Fin 4), BandPrototile (t 0) T₀ → BandPrototile (t i.succ) Tᵢ → + TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (t i.succ) (t 0))) + + GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (t 0) (t i.succ)))) → + TouchingTriple T₀ + (TileTranslation T₀ + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (t i.succ) (t 0)))) Tᵢ) → ((∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ + (Tⱼ : ProtoTile), ∀ (i : Fin 3), ∀ (s : Fin 4), BandPrototile (t 0) T₀ → + BandPrototile (t i.succ) Tᵢ → + BandPrototile (t ((i + 1).succ)) Tⱼ → + TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (t i.succ) (t 0))) + + GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (t 0) (t i.succ)))) → + TileCentroid Tⱼ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (t ((i + 1).succ)) (t 0))) - + GaussianRealPoint + ((GaussianQuarterTurn^[s.val]) + (BandVectors.1 (t 0) (t ((i + 1).succ))))) → + TouchingTriple T₀ Tᵢ Tⱼ) → (∀ (x : Real × Real), ∀ (S : Fin 3 → Bool → ProtoTile), (∀ i, ∀ + s, BandPrototile (q i.succ) (S i s)) → ((∀ i, ∀ s, TileCentroid (S i s) - x = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1)))) → (let A := S 0 true + let B := S 0 false + let C := S 1 true + let D := S 1 false + let E := S 2 true + let F := S 2 false + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + OuterTouchingAlternative A (TileTranslation B v) (TileTranslation E v) ∧ + OuterTouchingAlternative A (TileTranslation B v) F ∧ + OuterTouchingAlternative A (TileTranslation B (u + v)) + (TileTranslation C (u + v)) ∧ + OuterTouchingAlternative A (TileTranslation B (u + v)) D ∧ + OuterTouchingAlternative A (TileTranslation C (u + v)) + (TileTranslation E v) ∧ + OuterTouchingAlternative B (TileTranslation D (-u - v)) + (TileTranslation F (-v)) ∧ + OuterTouchingAlternative C (TileTranslation D (-u)) + (TileTranslation E (-u)) ∧ + OuterTouchingAlternative C (TileTranslation D (-u)) F)))))))))))))))) := by + intro q r t hq hr ht hr0 hr2 hr3 ht0 ht1 hrlt htlt hT4r hT5r hT4t hT5t x S hS hcent +-- BODY + let A := S 0 true + let B := S 0 false + let C := S 1 true + let D := S 1 false + let E := S 2 true + let F := S 2 false + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + let c := BandVectors.1 (q 2) (q 1) + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + change OuterTouchingAlternative A (TileTranslation B v) (TileTranslation E v) ∧ + OuterTouchingAlternative A (TileTranslation B v) F ∧ + OuterTouchingAlternative A (TileTranslation B (u + v)) (TileTranslation C (u + v)) ∧ + OuterTouchingAlternative A (TileTranslation B (u + v)) D ∧ + OuterTouchingAlternative A (TileTranslation C (u + v)) (TileTranslation E v) ∧ + OuterTouchingAlternative B (TileTranslation D (-u - v)) (TileTranslation F (-v)) ∧ + OuterTouchingAlternative C (TileTranslation D (-u)) (TileTranslation E (-u)) ∧ + OuterTouchingAlternative C (TileTranslation D (-u)) F + obtain ⟨hsum, _, hin1, _, flipq⟩ := VectorRecursionLaws q hq.1 + have hin2 : BandVectors.1 (q 2) (q 0) = c - I * a := by + simpa [a, c, I] using + (VectorRecursionLaws _ (SemiProperQuadruple.rotate hq.1)).2.2.1 + have hc : c = -a - b := by + change a + b + c = 0 at hsum + calc + c = (a + b + c) - a - b := by ring + _ = -a - b := by rw [hsum]; ring + have hu : u = I * b + c := by + change BandVectors.1 (q 1) (q 0) = b - I * c at hin1 + have h := (flipq hq 0).1 + change u = I * BandVectors.1 (q 1) (q 0) at h + rw [h, hin1] + ext <;> simp [I]; ring + have hv : v = I * c + a := by + have h := (flipq hq 1).1 + change v = I * BandVectors.1 (q 2) (q 0) at h + rw [h, hin2] + ext <;> simp [I]; ring + have flipr := (VectorRecursionLaws r hr.1).2.2.2.2 hr + have flipt := (VectorRecursionLaws t ht.1).2.2.2.2 ht + have hr20 : BandVectors.1 (r 2) (r 0) = c := by rw [hr2, hr0] + have hr02 : BandVectors.1 (r 0) (r 2) = I * c := by + have h := (flipr 1).1 + change BandVectors.1 (r 0) (r 2) = I * BandVectors.1 (r 2) (r 0) at h + simpa [hr20] using h + have hr03 : BandVectors.1 (r 0) (r 3) = b := by rw [hr0, hr3] + have hr30 : BandVectors.1 (r 3) (r 0) = -I * b := by + have h := (flipr 2).1 + change BandVectors.1 (r 0) (r 3) = I * BandVectors.1 (r 3) (r 0) at h + rw [hr03] at h + calc + _ = -I * (I * BandVectors.1 (r 3) (r 0)) := by + ext <;> simp [I] + _ = -I * b := by rw [← h] + have ht10 : BandVectors.1 (t 1) (t 0) = a := by rw [ht1, ht0] + have ht01 : BandVectors.1 (t 0) (t 1) = I * a := by + have h := (flipt 0).1 + change BandVectors.1 (t 0) (t 1) = I * BandVectors.1 (t 1) (t 0) at h + simpa [ht10] using h + have hA : BandPrototile (r 0) A := by rw [hr0]; exact hS 0 true + have hB : BandPrototile (r 0) B := by rw [hr0]; exact hS 0 false + have hC : BandPrototile (r 2) C := by rw [hr2]; exact hS 1 true + have hD : BandPrototile (r 2) D := by rw [hr2]; exact hS 1 false + have hE : BandPrototile (r 3) E := by rw [hr3]; exact hS 2 true + have hF : BandPrototile (r 3) F := by rw [hr3]; exact hS 2 false + have hCt : BandPrototile (t 0) C := by rw [ht0]; exact hS 1 true + have hDt : BandPrototile (t 0) D := by rw [ht0]; exact hS 1 false + have hEt : BandPrototile (t 1) E := by rw [ht1]; exact hS 2 true + have hFt : BandPrototile (t 1) F := by rw [ht1]; exact hS 2 false + have shift (T : ProtoTile) (z : GaussianInt) : + TileCentroid (TileTranslation T z) = TileCentroid T + GaussianRealPoint z := + (TileTranslationFormulas T z).2.2.2.2.1 + have retarget (K : CircleCoordinates) (X U V Y : ProtoTile) + (hU : BandPrototile K U) (hV : BandPrototile K V) + (hUV : TileCentroid U = TileCentroid V) + (h : TouchingTriple X U Y) : TouchingTriple X V Y := OuterTouchingProof.retarget K X U V Y + hU hV hUV h + have centerA := hcent 0 true + have centerB := hcent 0 false + have centerC := hcent 1 true + have centerD := hcent 1 false + have centerE := hcent 2 true + have centerF := hcent 2 false + change TileCentroid A - x = (1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint a - (-(GaussianRealPoint a).2, (GaussianRealPoint a).1))) at centerA + change TileCentroid B - x = (-1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint a - (-(GaussianRealPoint a).2, (GaussianRealPoint a).1))) at centerB + change TileCentroid C - x = (1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint b - (-(GaussianRealPoint b).2, (GaussianRealPoint b).1))) at centerC + change TileCentroid D - x = (-1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint b - (-(GaussianRealPoint b).2, (GaussianRealPoint b).1))) at centerD + change TileCentroid E - x = (1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint c - (-(GaussianRealPoint c).2, (GaussianRealPoint c).1))) at centerE + change TileCentroid F - x = (-1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint c - (-(GaussianRealPoint c).2, (GaussianRealPoint c).1))) at centerF + rw [hc] at centerE centerF + have hAx := congrArg Prod.fst centerA + have hAy := congrArg Prod.snd centerA + have hBx := congrArg Prod.fst centerB + have hBy := congrArg Prod.snd centerB + have hCx := congrArg Prod.fst centerC + have hCy := congrArg Prod.snd centerC + have hDx := congrArg Prod.fst centerD + have hDy := congrArg Prod.snd centerD + have hEx := congrArg Prod.fst centerE + have hEy := congrArg Prod.snd centerE + have hFx := congrArg Prod.fst centerF + have hFy := congrArg Prod.snd centerF + simp? [GaussianRealPoint] at hAx hAy hBx hBy hCx hCy hDx hDy hEx hEy hFx hFy + have literal (K : CircleCoordinates) (X X' Y : ProtoTile) (z : GaussianInt) + (hX : BandPrototile K X) (hX' : BandPrototile K X') + (hoff : TileCentroid X' - TileCentroid X = GaussianRealPoint z) + (h : TouchingTriple X (TileTranslation X z) Y) : TouchingTriple X X' Y := by + apply retarget K X (TileTranslation X z) X' Y + (BandPrototileTranslation K X z hX) hX' _ h + rw [shift, ← hoff] + abel + -- The T4 rows identify the literal second child by its centroid. + have row1 : TouchingTriple A (TileTranslation B v) (TileTranslation E v) := + OuterTouchingProof.row1 q r hT4r x S hc hv hr03 hr30 hA hB hE shift hAx hAy hBx hBy hEx hEy + literal + have row2 : TouchingTriple A (TileTranslation B v) F := OuterTouchingProof.row2 q r hT4r x S hc + hv hr03 hr30 hA hB hF shift hAx hAy hBx hBy hFx hFy literal + have row3 : TouchingTriple A (TileTranslation B (u + v)) + (TileTranslation C (u + v)) := OuterTouchingProof.row3 q r hT4r x S hc hu hv hr20 hr02 hA + hB hC shift hAx hAy hBx hBy hCx hCy literal + have row4 : TouchingTriple A (TileTranslation B (u + v)) D := OuterTouchingProof.row4 q r hT4r + x S hc hu hv hr20 hr02 hA hB hD shift hAx hAy hBx hBy hDx hDy literal + have row5 : TouchingTriple A (TileTranslation C (u + v)) (TileTranslation E v) := + OuterTouchingProof.row5 q r hT5r x S hc hu hv hr20 hr02 hr03 hr30 hA hC hE shift hAx hAy + hCx hCy hEx hEy + have row6 : TouchingTriple B (TileTranslation D (-u - v)) + (TileTranslation F (-v)) := OuterTouchingProof.row6 q r hT5r x S hc hu hv hr20 hr02 hr03 + hr30 hB hD hF shift hBx hBy hDx hDy hFx hFy + have row7 : TouchingTriple C (TileTranslation D (-u)) (TileTranslation E (-u)) := + OuterTouchingProof.row7 q t hT4t x S hc hu ht10 ht01 hCt hDt hEt shift hCx hCy hDx hDy hEx + hEy literal + have row8 : TouchingTriple C (TileTranslation D (-u)) F := OuterTouchingProof.row8 q t hT4t x S + hc hu ht10 ht01 hCt hDt hFt shift hCx hCy hDx hDy hFx hFy literal + exact ⟨Or.inl row1, Or.inl row2, Or.inl row3, Or.inl row4, + Or.inl row5, Or.inl row6, Or.inl row7, Or.inl row8⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OuterTouchingAlternative.lean b/LeanPool/ApollonianSuperharmonic/OuterTouchingAlternative.lean new file mode 100644 index 0000000000..b52b99a20e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OuterTouchingAlternative.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileArea +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: OuterTouchingAlternative] + +/-! +# OuterTouchingAlternative + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Three prototiles satisfy the *outer-touching alternative* if they form +a touching triple, or if all three have area one and every pair of their +footprints intersects. The second possibility is the exceptional +three-unit-square conclusion in Claim `c.outtouch` of the paper; it +does not assert that the three squares have disjoint interiors. +-/ +def OuterTouchingAlternative (T U V : ProtoTile) : Prop := +-- BODY + TouchingTriple T U V ∨ + (TileArea T = 1 ∧ TileArea U = 1 ∧ TileArea V = 1 ∧ + (FootprintVertices T ∩ FootprintVertices U).Nonempty ∧ + (FootprintVertices U ∩ FootprintVertices V).Nonempty ∧ + (FootprintVertices V ∩ FootprintVertices T).Nonempty) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean new file mode 100644 index 0000000000..ddaff55e3e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean @@ -0,0 +1,2818 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.FiniteConnectedCellSetNoCheckerboard +public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch +public import LeanPool.ApollonianSuperharmonic.FinitePatchTopology +public import LeanPool.ApollonianSuperharmonic.FinitePolyominoDiskCriterion +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileComplementGridConnected +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P1BandOrderedGeneralMixedAggregateJunctionData] + +/-! +# P1BandOrderedGeneralMixedAggregateJunctionData + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace MixedAggregateGeometry + +private def incomingCertificateTrees : List (List (Nat × Nat)) := + [ + [(145, 144), (146, 144), (147, 144), (149, 144), (148, 145)], + [(187, 186), (188, 186), (189, 186), (191, 186), (190, 187)], + [(145, 144), (146, 144), (147, 144), (149, 144), (148, 145), (188, 147), (191, 147), + (186, 188), (187, 188), (189, 186), (190, 187)], + [], + [(145, 144), (193, 144), (146, 144), (147, 144), (149, 144), (148, 145)], + [(187, 186), (193, 186), (188, 186), (189, 186), (191, 186), (190, 187)], + [(145, 144), (193, 144), (146, 144), (147, 144), (149, 144), (148, 145), (186, 193), + (191, 193), (188, 147), (187, 186), (189, 186), (190, 187)], + [(145, 144), (146, 144), (147, 144), (149, 144), (148, 145)], + [(151, 150), (152, 150), (153, 150), (155, 150), (154, 151)], + [(145, 144), (151, 144), (146, 144), (147, 144), (154, 144), (149, 144), (148, 145), + (150, 151), (152, 151), (153, 151), (155, 150)], + [], + [(145, 144), (146, 144), (147, 144), (149, 144), (148, 145), (105, 146)], + [(151, 150), (152, 150), (153, 150), (155, 150), (105, 151), (154, 151)], + [(145, 144), (151, 144), (146, 144), (147, 144), (154, 144), (149, 144), (148, 145), + (150, 151), (152, 151), (105, 151), (153, 151), (155, 150)], + [(145, 144), (146, 144), (147, 144), (149, 144), (148, 145)], + [(97, 96), (98, 96), (99, 96), (101, 96), (100, 97)], + [(145, 144), (146, 144), (147, 144), (149, 144), (96, 145), (99, 145), (148, 145), + (97, 96), (98, 96), (101, 96), (100, 99)], + [], + [(145, 144), (146, 144), (147, 144), (149, 144), (148, 145), (143, 145)], + [(97, 96), (98, 96), (99, 96), (101, 96), (100, 97), (143, 99)], + [(145, 144), (146, 144), (147, 144), (149, 144), (96, 145), (99, 145), (148, 145), + (143, 145), (97, 96), (98, 96), (101, 96), (100, 99)], + [(145, 144), (146, 144), (147, 144), (149, 144), (148, 145)], + [], + [(145, 144), (146, 144), (147, 144), (149, 144), (138, 145), (148, 145)], + [], + [(145, 144), (146, 144), (147, 144), (149, 144), (148, 145), (188, 147)], + [(188, 138)], + [(145, 144), (146, 144), (147, 144), (149, 144), (138, 145), (148, 145), (188, 147)], + [(145, 144), (146, 144), (147, 144), (149, 144), (148, 145)], + [], + [(145, 144), (146, 144), (194, 144), (147, 144), (149, 144), (148, 145)], + [], + [(145, 144), (146, 144), (147, 144), (154, 144), (149, 144), (148, 145)], + [(154, 194)], + [(145, 144), (146, 144), (194, 144), (147, 144), (154, 144), (149, 144), (148, 145)], + [(145, 144), (146, 144), (147, 144), (149, 144), (148, 145)], + [], + [(145, 144), (146, 144), (147, 144), (149, 144), (148, 145), (106, 146)], + [], + [(145, 144), (146, 144), (147, 144), (149, 144), (96, 145), (148, 145)], + [(96, 106)], + [(145, 144), (146, 144), (147, 144), (149, 144), (96, 145), (148, 145), (106, 146)] + ] + +private def outgoingCertificateTrees : List (List (Nat × Nat)) := + [ + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (153, 151), (154, 151), + (99, 96), (194, 153), (140, 99), (143, 99), (193, 194), (138, 140), (191, 193), + (188, 138)], + [(103, 102), (151, 102), (96, 103), (144, 151), (145, 96), (193, 144), (147, 144), + (138, 145), (148, 145), (195, 193), (196, 193), (141, 138), (236, 195), (182, 141), + (185, 141), (235, 236), (180, 182), (233, 235), (230, 180)], + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (150, 151), (153, 151), + (154, 151), (97, 96), (99, 96), (199, 150), (194, 153), (90, 97), (140, 99), (143, 99), + (192, 199), (193, 194), (139, 90), (138, 140), (241, 192), (195, 192), (196, 193), + (132, 139), (141, 139), (234, 241), (236, 195), (181, 132), (185, 141), (235, 234), + (180, 181), (233, 235), (230, 180)], + [(151, 102), (150, 151), (144, 151), (199, 150), (194, 144), (147, 144), (192, 199), + (188, 147), (191, 147), (195, 192), (186, 188), (196, 195)], + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (150, 151), (153, 151), + (154, 151), (99, 96), (199, 150), (194, 153), (140, 99), (143, 99), (192, 199), + (138, 140), (195, 192), (187, 138), (188, 138), (196, 195), (186, 187), (191, 188)], + [(103, 102), (151, 102), (96, 103), (150, 151), (144, 151), (145, 96), (199, 150), + (194, 144), (147, 144), (138, 145), (148, 145), (192, 199), (141, 138), (241, 192), + (195, 192), (182, 141), (185, 141), (234, 241), (236, 195), (196, 195), (180, 182), + (235, 234), (230, 180), (233, 235)], + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (150, 151), (153, 151), + (154, 151), (97, 96), (99, 96), (199, 150), (194, 153), (90, 97), (140, 99), (143, 99), + (192, 199), (139, 90), (138, 140), (241, 192), (195, 192), (132, 139), (141, 139), + (234, 241), (236, 195), (196, 195), (181, 132), (185, 141), (235, 234), (180, 181), + (233, 235), (230, 180)], + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (153, 151), (154, 151), + (99, 96), (194, 153), (140, 99), (143, 99), (193, 194), (138, 140), (191, 193), + (188, 138)], + [(109, 102), (105, 102), (112, 102), (108, 109), (111, 109), (146, 105), (149, 105), + (157, 108), (144, 146), (159, 157), (160, 157), (194, 144), (200, 159), (197, 194), + (199, 200)], + [(103, 102), (109, 102), (105, 102), (112, 102), (96, 103), (106, 103), (108, 109), + (111, 109), (99, 96), (157, 108), (140, 99), (143, 99), (159, 157), (160, 157), + (138, 140), (200, 159), (187, 138), (188, 138), (199, 200), (186, 187), (191, 188), + (192, 199), (197, 199), (193, 186), (194, 192)], + [(103, 102), (151, 102), (96, 103), (106, 103), (149, 151), (146, 96)], + [(103, 102), (151, 102), (96, 103), (106, 103), (153, 151), (154, 151), (99, 96), + (194, 153), (140, 99), (143, 99), (193, 194), (138, 140), (191, 193), (188, 138)], + [(103, 102), (109, 102), (112, 102), (96, 103), (106, 103), (108, 109), (111, 109), + (145, 96), (146, 96), (157, 108), (144, 145), (149, 146), (159, 157), (160, 157), + (194, 144), (200, 159), (197, 194), (199, 200)], + [(103, 102), (109, 102), (112, 102), (96, 103), (106, 103), (108, 109), (111, 109), + (99, 96), (157, 108), (140, 99), (143, 99), (159, 157), (160, 157), (138, 140), + (200, 159), (187, 138), (188, 138), (199, 200), (186, 187), (191, 188), (192, 199), + (197, 199), (193, 186), (194, 192)], + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (153, 151), (154, 151), + (99, 96), (194, 153), (140, 99), (143, 99), (193, 194), (138, 140), (191, 193), + (188, 138)], + [(103, 102), (151, 102), (105, 102), (54, 103), (57, 103), (106, 103), (144, 151), + (146, 105), (55, 54), (58, 57), (145, 144), (48, 55), (138, 145), (143, 145), (51, 48), + (139, 138), (140, 138), (95, 51), (90, 139)], + [(103, 102), (151, 102), (105, 102), (54, 103), (57, 103), (106, 103), (153, 151), + (154, 151), (55, 54), (58, 57), (194, 153), (48, 55), (193, 194), (51, 48), (186, 193), + (191, 193), (92, 51), (95, 51), (187, 186), (188, 186), (90, 92), (138, 187), + (140, 90), (143, 138)], + [(103, 102), (96, 103), (145, 96), (99, 96), (138, 145), (140, 99)], + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (153, 151), (154, 151), + (99, 96), (194, 153), (140, 99), (193, 194), (138, 140), (191, 193), (188, 138)], + [(103, 102), (151, 102), (105, 102), (54, 103), (57, 103), (106, 103), (144, 151), + (146, 105), (55, 54), (58, 57), (145, 144), (48, 55), (138, 145), (51, 48), (139, 138), + (140, 138), (95, 51), (90, 139)], + [(103, 102), (151, 102), (105, 102), (54, 103), (57, 103), (106, 103), (153, 151), + (154, 151), (55, 54), (58, 57), (194, 153), (48, 55), (193, 194), (51, 48), (186, 193), + (191, 193), (92, 51), (95, 51), (187, 186), (188, 186), (90, 92), (138, 187), (140, 90)], + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (153, 151), (154, 151), + (99, 96), (194, 153), (140, 99), (143, 99), (193, 194), (138, 140), (191, 193), + (188, 138)], + [(103, 102), (151, 102), (96, 103), (144, 151), (97, 96), (145, 96), (99, 96), + (193, 144), (147, 144), (90, 97), (148, 145), (143, 145), (140, 99), (186, 193), + (188, 147), (139, 90), (187, 186), (141, 139)], + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (153, 151), (154, 151), + (97, 96), (99, 96), (194, 153), (90, 97), (140, 99), (143, 99), (193, 194), (139, 90), + (186, 193), (191, 193), (141, 139), (187, 186), (188, 186)], + [(103, 102), (151, 102), (96, 103), (144, 151), (145, 96), (193, 144), (147, 144), + (138, 145), (148, 145), (186, 193), (191, 193), (187, 138)], + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (153, 151), (154, 151), + (99, 96), (194, 153), (140, 99), (143, 99), (193, 194), (138, 140), (186, 193), + (191, 193), (187, 138)], + [(103, 102), (151, 102), (96, 103), (144, 151), (97, 96), (145, 96), (99, 96), + (193, 144), (147, 144), (90, 97), (148, 145), (143, 145), (140, 99), (186, 193), + (191, 193), (139, 90), (187, 186), (141, 139)], + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (153, 151), (154, 151), + (97, 96), (99, 96), (194, 153), (90, 97), (140, 99), (143, 99), (193, 194), (139, 90), + (186, 193), (191, 193), (141, 139), (187, 186)], + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (153, 151), (154, 151), + (99, 96), (194, 153), (140, 99), (143, 99), (193, 194), (138, 140), (191, 193), + (188, 138)], + [(151, 102), (150, 151), (144, 151), (153, 151), (154, 151), (199, 150), (193, 144), + (197, 153), (192, 199)], + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (150, 151), (153, 151), + (154, 151), (99, 96), (199, 150), (197, 153), (140, 99), (143, 99), (192, 199), + (138, 140), (193, 192), (188, 138), (191, 193)], + [(151, 102), (144, 151), (153, 151), (194, 144)], + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (153, 151), (99, 96), + (194, 153), (140, 99), (143, 99), (193, 194), (138, 140), (191, 193), (188, 138)], + [(151, 102), (150, 151), (144, 151), (153, 151), (199, 150), (193, 144), (197, 153), + (192, 199)], + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (150, 151), (153, 151), + (99, 96), (199, 150), (197, 153), (140, 99), (143, 99), (192, 199), (138, 140), + (193, 192), (188, 138), (191, 193)], + [(103, 102), (151, 102), (105, 102), (96, 103), (106, 103), (153, 151), (154, 151), + (99, 96), (194, 153), (140, 99), (143, 99), (193, 194), (138, 140), (191, 193), + (188, 138)], + [(103, 102), (105, 102), (96, 103), (146, 105)], + [(103, 102), (151, 102), (105, 102), (96, 103), (153, 151), (154, 151), (99, 96), + (194, 153), (140, 99), (143, 99), (193, 194), (138, 140), (191, 193), (188, 138)], + [(103, 102), (151, 102), (105, 102), (57, 103), (106, 103), (101, 103), (144, 151), + (146, 105), (98, 57), (145, 144), (97, 98), (99, 145)], + [(103, 102), (151, 102), (105, 102), (57, 103), (106, 103), (101, 103), (153, 151), + (154, 151), (98, 57), (194, 153), (97, 98), (193, 194), (90, 97), (99, 97), (186, 193), + (191, 193), (139, 90), (143, 99), (188, 186), (138, 139)], + [(103, 102), (151, 102), (105, 102), (57, 103), (101, 103), (144, 151), (146, 105), + (98, 57), (145, 144), (97, 98), (99, 145)], + [(103, 102), (151, 102), (105, 102), (57, 103), (101, 103), (153, 151), (154, 151), + (98, 57), (194, 153), (97, 98), (193, 194), (90, 97), (99, 97), (186, 193), (191, 193), + (139, 90), (143, 99), (188, 186), (138, 139)] + ] + + +private theorem mixedNeighbors_symmetric : + (by + classical + exact + let mixedNeighbors (a : PeriodicSubtileIndex) : Finset PeriodicSubtileIndex := + let m := a.first + let n := a.second + match a.label with + | .A => {⟨.B,m,n⟩, ⟨.B,m,n+1⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m,n⟩, + ⟨.C,m+1,n+1⟩, ⟨.D,m,n⟩, ⟨.E,m,n+1⟩, ⟨.F,m,n⟩} + | .B => {⟨.A,m,n⟩, ⟨.A,m,n-1⟩, ⟨.A,m-1,n-1⟩, ⟨.C,m,n⟩, + ⟨.D,m-1,n-1⟩, ⟨.D,m,n⟩, ⟨.E,m,n⟩, ⟨.F,m,n-1⟩} + | .C => {⟨.A,m,n⟩, ⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.D,m-1,n⟩, + ⟨.E,m-1,n⟩, ⟨.F,m,n⟩} + | .D => {⟨.A,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, + ⟨.E,m,n⟩, ⟨.F,m+1,n⟩} + | .E => {⟨.A,m,n-1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩} + | .F => {⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.C,m,n⟩, ⟨.D,m-1,n⟩} + ∀ {a : PeriodicSubtileIndex}, ∀ {b : PeriodicSubtileIndex}, (b ∈ mixedNeighbors a) → (a ∈ + mixedNeighbors b) ) := by + classical + intro mixedNeighbors a b h + rcases a with ⟨l,m,n⟩ + cases l + all_goals simp only [mixedNeighbors, Finset.mem_insert, Finset.mem_singleton] at h + case A => + rcases h with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inl (by simp only []) + · simp only [mixedNeighbors, add_sub_cancel_right, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inl (by simp only [])) + · simp only [mixedNeighbors, add_sub_cancel_right, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inl (by simp only []))) + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inl (by simp only []) + · simp only [mixedNeighbors, add_sub_cancel_right, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inl (by simp only [])) + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inl (by simp only []) + · simp only [mixedNeighbors, add_sub_cancel_right, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inl (by simp only []) + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inl (by simp only []) + case B => + rcases h with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inl (by simp only []) + · simp only [mixedNeighbors, sub_add_cancel, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inl (by simp only [])) + · simp only [mixedNeighbors, sub_add_cancel, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inl (by simp only []))) + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inl (by simp only []))) + · simp only [mixedNeighbors, sub_add_cancel, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inl (by simp only [])) + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inl (by simp only []))) + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inl (by simp only [])) + · simp only [mixedNeighbors, sub_add_cancel, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inl (by simp only [])) + case C => + rcases h with rfl | rfl | rfl | rfl | rfl | rfl + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inl (by simp only [])))) + · simp only [mixedNeighbors, sub_add_cancel, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (by simp only []))))) + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inl (by simp only [])))) + · simp only [mixedNeighbors, sub_add_cancel, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inl (by simp only [])))) + · simp only [mixedNeighbors, sub_add_cancel, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inl (by simp only []))) + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inl (by simp only []))) + case D => + rcases h with rfl | rfl | rfl | rfl | rfl | rfl + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (by simp only [])))))) + · simp only [mixedNeighbors, add_sub_cancel_right, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (by simp only []))))) + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (by simp only [])))))) + · simp only [mixedNeighbors, add_sub_cancel_right, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inl (by simp only [])))) + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr ((by simp only [])))) + · simp only [mixedNeighbors, add_sub_cancel_right, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr ((by simp only [])))) + case E => + rcases h with rfl | rfl | rfl | rfl + · simp only [mixedNeighbors, sub_add_cancel, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (by simp only + []))))))) + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (by simp only + []))))))) + · simp only [mixedNeighbors, add_sub_cancel_right, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (by simp only + []))))) + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (by simp only + []))))) + case F => + rcases h with rfl | rfl | rfl | rfl + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr ((by simp only + [])))))))) + · simp only [mixedNeighbors, add_sub_cancel_right, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr ((by simp only + [])))))))) + · simp only [mixedNeighbors, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr ((by simp only + [])))))) + · simp only [mixedNeighbors, sub_add_cancel, + Finset.mem_insert, Finset.mem_singleton] + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr ((by simp only + [])))))) + +private theorem mixedNeighbors_iff : + (by + classical + exact + let mixedNeighbors (a : PeriodicSubtileIndex) : Finset PeriodicSubtileIndex := + let m := a.first + let n := a.second + match a.label with + | .A => {⟨.B,m,n⟩, ⟨.B,m,n+1⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m,n⟩, + ⟨.C,m+1,n+1⟩, ⟨.D,m,n⟩, ⟨.E,m,n+1⟩, ⟨.F,m,n⟩} + | .B => {⟨.A,m,n⟩, ⟨.A,m,n-1⟩, ⟨.A,m-1,n-1⟩, ⟨.C,m,n⟩, + ⟨.D,m-1,n-1⟩, ⟨.D,m,n⟩, ⟨.E,m,n⟩, ⟨.F,m,n-1⟩} + | .C => {⟨.A,m,n⟩, ⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.D,m-1,n⟩, + ⟨.E,m-1,n⟩, ⟨.F,m,n⟩} + | .D => {⟨.A,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, + ⟨.E,m,n⟩, ⟨.F,m+1,n⟩} + | .E => {⟨.A,m,n-1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩} + | .F => {⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.C,m,n⟩, ⟨.D,m-1,n⟩} + (∀ {a : PeriodicSubtileIndex}, ∀ {b : PeriodicSubtileIndex}, (b ∈ mixedNeighbors a) → (a + ∈ mixedNeighbors b)) → (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), + AllowedSubtileIncidence a b ↔ b ∈ mixedNeighbors a) ) := by + classical + intro mixedNeighbors mixedNeighbors_symmetric a b + constructor + · intro h + induction h with + | symm h ih => exact mixedNeighbors_symmetric ih + | _ => simp only [mixedNeighbors,Finset.mem_insert,Finset.mem_singleton, + ]; tauto + · rcases a with ⟨l,m,n⟩ + cases l + all_goals simp only [mixedNeighbors, Finset.mem_insert, Finset.mem_singleton]; intro h + case A => + rcases h with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.AB m n + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.AB01 m n + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.AB11 m n + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.AC m n + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.AC11 m n + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.AD m n + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.AE01 m n + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.AF m n + case B => + rcases h with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.AB m + n).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.AB01 m + (n-1)).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.AB11 + (m-1) (n-1)).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.BC m n + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.BDm1m1 m n + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.BD m n + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.BE m n + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.BF0m1 m n + case C => + rcases h with rfl | rfl | rfl | rfl | rfl | rfl + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.AC m + n).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.AC11 + (m-1) (n-1)).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.BC m + n).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.CDm10 m n + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.CEm10 m n + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.CF m n + case D => + rcases h with rfl | rfl | rfl | rfl | rfl | rfl + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.AD m + n).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.BDm1m1 + (m+1) (n+1)).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.BD m + n).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.CDm10 + (m+1) n).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.DE m n + · simpa only [sub_add_cancel,add_sub_cancel_right] using AllowedSubtileIncidence.DF10 m n + case E => + rcases h with rfl | rfl | rfl | rfl + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.AE01 m + (n-1)).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.BE m + n).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.CEm10 + (m+1) n).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.DE m + n).symm + case F => + rcases h with rfl | rfl | rfl | rfl + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.AF m + n).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.BF0m1 m + (n+1)).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.CF m + n).symm + · simpa only [sub_add_cancel,add_sub_cancel_right] using (AllowedSubtileIncidence.DF10 + (m-1) n).symm + +private theorem mixed_walk_reach : + (by + classical + exact + ∀ {α : Type}, ∀ (r : α → α → Prop), ∀ (S : α → Prop), ∀ (p : List α), ∀ (a : α), ∀ (b : + α), (p.head? = some a) → ((p.getLast? = some b) → ((∀ x ∈ p, S x) → ((p.IsChain r) → + (Relation.ReflTransGen (fun x y => r x y ∧ S x ∧ S y) a b)))) ) := by + classical + intro α r S p a b ha hb hm hc + have hn : p ≠ [] := by intro h; subst p; simp at ha + have hc' : p.IsChain (fun x y => r x y ∧ S x ∧ S y) := + hc.imp_of_mem_imp (fun x y hx hy hxy => ⟨hxy, hm x hx, hm y hy⟩) + have h := List.relationReflTransGen_of_exists_isChain p hc' hn + have heada : p.head hn = a := by simpa [List.head?_eq_some_head hn] using ha + have lastb : p.getLast hn = b := by simpa [List.getLast?_eq_some_getLast hn] using hb + simpa [heada, lastb] using h + +private theorem mixed_reach_walk : + (by + classical + exact + ∀ {α : Type}, ∀ (r : α → α → Prop), ∀ (S : α → Prop), ∀ (a : α), ∀ (b : α), (S a) → + ((Relation.ReflTransGen (fun x y => r x y ∧ S x ∧ S y) a b) → (∃ p : List α, p.head? + = some a ∧ p.getLast? = some b ∧ (∀ x ∈ p, S x) ∧ p.IsChain r)) ) := by + classical + intro α r S a b ha h + obtain ⟨l,hc,hl⟩ := List.exists_isChain_cons_of_relationReflTransGen h + refine ⟨a::l, rfl, ?_, ?_, hc.imp (fun _ _ h => h.1)⟩ + · simpa [List.getLast?_eq_some_getLast (List.cons_ne_nil a l)] using congrArg some hl + · have go : ∀ (u : α) (p : List α), S u → + (u::p).IsChain (fun x y => r x y ∧ S x ∧ S y) → + ∀ x ∈ u::p, S x := by + intro u p + induction p generalizing u with + | nil => simp_all + | cons v p ih => + intro hu hc x hx + simp only [List.mem_cons] at hx + rcases hx with hx | hx + · exact hx.symm ▸ hu + · exact ih v hc.rel.2.2 hc.tail x (by simpa only [List.mem_cons] using hx) + exact go a l ha hc + +private theorem mixed_boundary_detour : + (by + classical + exact + let mixedNeighbors (a : PeriodicSubtileIndex) : Finset PeriodicSubtileIndex := + let m := a.first + let n := a.second + match a.label with + | .A => {⟨.B,m,n⟩, ⟨.B,m,n+1⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m,n⟩, + ⟨.C,m+1,n+1⟩, ⟨.D,m,n⟩, ⟨.E,m,n+1⟩, ⟨.F,m,n⟩} + | .B => {⟨.A,m,n⟩, ⟨.A,m,n-1⟩, ⟨.A,m-1,n-1⟩, ⟨.C,m,n⟩, + ⟨.D,m-1,n-1⟩, ⟨.D,m,n⟩, ⟨.E,m,n⟩, ⟨.F,m,n-1⟩} + | .C => {⟨.A,m,n⟩, ⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.D,m-1,n⟩, + ⟨.E,m-1,n⟩, ⟨.F,m,n⟩} + | .D => {⟨.A,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, + ⟨.E,m,n⟩, ⟨.F,m+1,n⟩} + | .E => {⟨.A,m,n-1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩} + | .F => {⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.C,m,n⟩, ⟨.D,m-1,n⟩} + (∀ {α : Type}, ∀ (r : α → α → Prop), ∀ (S : α → Prop), ∀ (p : List α), ∀ (a : α), ∀ (b : + α), (p.head? = some a) → ((p.getLast? = some b) → ((∀ x ∈ p, S x) → ((p.IsChain r) → + (Relation.ReflTransGen (fun x y => r x y ∧ S x ∧ S y) a b))))) → (∀ (G : + PlaneTriangulation PeriodicSubtileIndex), (∀ a, ∀ b, G.adjacent a b ↔ b ∈ + mixedNeighbors a) → (∀ (D : Finset PeriodicSubtileIndex), ∀ (hub : + PeriodicSubtileIndex), (∀ a ∈ D, ∀ b ∈ mixedNeighbors a, b ∉ D → + Relation.ReflTransGen (fun x y => G.adjacent x y ∧ x ∉ D ∧ y ∉ D) b hub) → (∀ a ∉ D, + ∀ b ∉ D, Relation.ReflTransGen (fun x y => G.adjacent x y ∧ x ∉ D ∧ y ∉ D) a b))) + ) := by + classical + intro mixedNeighbors mixed_walk_reach G hadj D hub hboundary + classical + intro a ha b hb + obtain ⟨p,hp,hq,hm,hc⟩ := G.three_connected ∅ (by simp) a (by simp) b (by simp) + have hpath := mixed_walk_reach G.adjacent (fun _ => True) p a b hp hq + (by simp) ((List.isChain_iff_forall_rel_of_append_cons_cons).2 hc) + let f : PeriodicSubtileIndex → PeriodicSubtileIndex := fun x => if x ∈ D then hub else x + have liftStep : ∀ x y, (G.adjacent x y ∧ True ∧ True) → + Relation.ReflTransGen (fun x y => G.adjacent x y ∧ x ∉ D ∧ y ∉ D) (f x) (f y) := by + intro x y h + by_cases hx : x ∈ D <;> by_cases hy : y ∈ D + · simp only [f, ite_eq_left hx, ite_eq_left hy] + exact .refl + · simp only [f, ite_eq_left hx, ite_eq_right hy] + have hs : ∀ {u v}, + Relation.ReflTransGen (fun x y => G.adjacent x y ∧ x ∉ D ∧ y ∉ D) u v → + Relation.ReflTransGen (fun x y => G.adjacent x y ∧ x ∉ D ∧ y ∉ D) v u := by + intro u v hh + induction hh with + | refl => exact .refl + | tail hh hs ih => + exact (Relation.ReflTransGen.single + ⟨(G.adjacent_symmetric _ _).1 hs.1, hs.2.2, hs.2.1⟩).trans ih + exact hs (hboundary x hx y ((hadj x y).1 h.1) hy) + · simp only [f, ite_eq_right hx, ite_eq_left hy] + exact hboundary y hy x ((hadj y x).1 ((G.adjacent_symmetric x y).1 h.1)) hx + · simp only [f, ite_eq_right hx, ite_eq_right hy] + exact .single ⟨h.1,hx,hy⟩ + simpa [Function.onFun,f,ha,hb] using hpath.lift' f liftStep + +private theorem mixedTree_sound : + (by + classical + exact + let mixedNeighbors (a : PeriodicSubtileIndex) : Finset PeriodicSubtileIndex := + let m := a.first + let n := a.second + match a.label with + | .A => {⟨.B,m,n⟩, ⟨.B,m,n+1⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m,n⟩, + ⟨.C,m+1,n+1⟩, ⟨.D,m,n⟩, ⟨.E,m,n+1⟩, ⟨.F,m,n⟩} + | .B => {⟨.A,m,n⟩, ⟨.A,m,n-1⟩, ⟨.A,m-1,n-1⟩, ⟨.C,m,n⟩, + ⟨.D,m-1,n-1⟩, ⟨.D,m,n⟩, ⟨.E,m,n⟩, ⟨.F,m,n-1⟩} + | .C => {⟨.A,m,n⟩, ⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.D,m-1,n⟩, + ⟨.E,m-1,n⟩, ⟨.F,m,n⟩} + | .D => {⟨.A,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, + ⟨.E,m,n⟩, ⟨.F,m+1,n⟩} + | .E => {⟨.A,m,n-1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩} + | .F => {⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.C,m,n⟩, ⟨.D,m-1,n⟩} + let mixedDecode (k : Nat) : PeriodicSubtileIndex := + ⟨match k % 6 with | 0 => .A | 1 => .B | 2 => .C | 3 => .D | 4 => .E | _ => .F, + (k / 6 / 7 : Int) - 3, (k / 6 % 7 : Int) - 3⟩ + let mixedTreeVertices (tree : List (Nat × Nat)) (S : Finset PeriodicSubtileIndex) : + Finset PeriodicSubtileIndex := + tree.foldl (fun S e => insert (mixedDecode e.1) S) S + let mixedTreeCheck (D : Finset PeriodicSubtileIndex) (inside : Bool) + (es : List (Nat × Nat)) (S : Finset PeriodicSubtileIndex) : Bool := + es.foldr (fun (a,b) next S => + decide ((if inside then mixedDecode a ∈ D else mixedDecode a ∉ D) ∧ + mixedDecode b ∈ S ∧ mixedDecode b ∈ mixedNeighbors (mixedDecode a)) && + next (insert (mixedDecode a) S)) (fun _ => true) S + ∀ (G : PlaneTriangulation PeriodicSubtileIndex), (∀ a, ∀ b, G.adjacent a b ↔ b ∈ + mixedNeighbors a) → (∀ (D : Finset PeriodicSubtileIndex), ∀ (inside : Bool), ∀ (hub : + PeriodicSubtileIndex), ∀ (es : List (Nat × Nat)), ∀ (S : Finset + PeriodicSubtileIndex), (∀ a ∈ S, Relation.ReflTransGen (fun x y => G.adjacent x y ∧ + (if inside then x ∈ D else x ∉ D) ∧ + (if inside then y ∈ D else y ∉ D)) a hub) → ((∀ a ∈ S, if inside then a ∈ D else a ∉ + D) → ((mixedTreeCheck D inside es S = true) → (∀ a ∈ mixedTreeVertices es S, + Relation.ReflTransGen (fun x y => G.adjacent x y ∧ (if inside then x ∈ D else x ∉ + D) ∧ (if inside then y ∈ D else y ∉ D)) a hub)))) ) := by + classical + intro mixedNeighbors mixedDecode mixedTreeVertices mixedTreeCheck G hadj D inside hub es S hS + hmem h + induction es generalizing S with + | nil => exact hS + | cons e es ih => + rcases e with ⟨a,b⟩ + simp only [mixedTreeCheck, List.foldr, Bool.and_eq_true, decide_eq_true_eq] at h + apply ih (insert (mixedDecode a) S) _ _ h.2 + · intro x hx + simp only [Finset.mem_insert] at hx + rcases hx with rfl | hx + · exact (Relation.ReflTransGen.single + ⟨(hadj _ _).2 h.1.2.2, h.1.1, hmem _ h.1.2.1⟩).trans + (hS _ h.1.2.1) + · exact hS x hx + · intro x hx + simp only [Finset.mem_insert] at hx + rcases hx with rfl | hx + · exact h.1.1 + · exact hmem x hx + +private theorem mixed_certificates : + (by + classical + exact + let mixedNeighbors (a : PeriodicSubtileIndex) : Finset PeriodicSubtileIndex := + let m := a.first + let n := a.second + match a.label with + | .A => {⟨.B,m,n⟩, ⟨.B,m,n+1⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m,n⟩, + ⟨.C,m+1,n+1⟩, ⟨.D,m,n⟩, ⟨.E,m,n+1⟩, ⟨.F,m,n⟩} + | .B => {⟨.A,m,n⟩, ⟨.A,m,n-1⟩, ⟨.A,m-1,n-1⟩, ⟨.C,m,n⟩, + ⟨.D,m-1,n-1⟩, ⟨.D,m,n⟩, ⟨.E,m,n⟩, ⟨.F,m,n-1⟩} + | .C => {⟨.A,m,n⟩, ⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.D,m-1,n⟩, + ⟨.E,m-1,n⟩, ⟨.F,m,n⟩} + | .D => {⟨.A,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, + ⟨.E,m,n⟩, ⟨.F,m+1,n⟩} + | .E => {⟨.A,m,n-1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩} + | .F => {⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.C,m,n⟩, ⟨.D,m-1,n⟩} + let mixedDecode (k : Nat) : PeriodicSubtileIndex := + ⟨match k % 6 with | 0 => .A | 1 => .B | 2 => .C | 3 => .D | 4 => .E | _ => .F, + (k / 6 / 7 : Int) - 3, (k / 6 % 7 : Int) - 3⟩ + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let mixedComponents (r : Nat) : Finset PeriodicSubtileIndex × + Finset PeriodicSubtileIndex × Finset PeriodicSubtileIndex := + (mixedBlock 0 0, match r with + | 0 => (mixedBlock 1 0, {⟨.B,1,1⟩}) + | 1 => (mixedBlock 0 1, {⟨.D,-1,0⟩}) + | 2 => (mixedBlock (-1) (-1), {⟨.F,0,-1⟩}) + | 3 => ({⟨.A,0,-1⟩}, {⟨.C,1,0⟩}) + | 4 => ({⟨.C,1,1⟩}, {⟨.E,0,1⟩}) + | _ => ({⟨.E,-1,0⟩}, {⟨.A,-1,-1⟩})) + let mixedSelection (j : Fin 42) : Finset PeriodicSubtileIndex := + let c := mixedComponents (j.val / 7) + let k := j.val % 7 + 1 + (if k % 2 = 1 then c.1 else ∅) ∪ + (if k / 2 % 2 = 1 then c.2.1 else ∅) ∪ + (if k / 4 % 2 = 1 then c.2.2 else ∅) + let mixedTreeVertices (tree : List (Nat × Nat)) (S : Finset PeriodicSubtileIndex) : + Finset PeriodicSubtileIndex := + tree.foldl (fun S e => insert (mixedDecode e.1) S) S + let mixedTreeCheck (D : Finset PeriodicSubtileIndex) (inside : Bool) + (es : List (Nat × Nat)) (S : Finset PeriodicSubtileIndex) : Bool := + es.foldr (fun (a,b) next S => + decide ((if inside then mixedDecode a ∈ D else mixedDecode a ∉ D) ∧ + mixedDecode b ∈ S ∧ mixedDecode b ∈ mixedNeighbors (mixedDecode a)) && + next (insert (mixedDecode a) S)) (fun _ => true) S + let mixedInTrees : List (List (Nat × Nat)) := + MixedAggregateGeometry.incomingCertificateTrees + let mixedOutTrees : List (List (Nat × Nat)) := + MixedAggregateGeometry.outgoingCertificateTrees + let mixedInHubs : List Nat := + [144, 186, 144, 193, 144, 186, 144, 144, 150, 144, 105, 144, 150, 144, 144, 96, + 144, 143, 144, 96, 144, 144, 138, 144, 188, 144, 138, 144, 144, 194, 144, 154, + 144, 194, 144, 144, 106, 144, 96, 144, 106, 144] + ∀ (j : Fin 42), + let D := mixedSelection j + let it := mixedInTrees.getD j.val [] + let ih := mixedDecode (mixedInHubs.getD j.val 0) + let ot := mixedOutTrees.getD j.val [] + let oh := mixedDecode 102 + ih ∈ D ∧ oh ∉ D ∧ + mixedTreeCheck D true it {ih} = true ∧ + D ⊆ mixedTreeVertices it {ih} ∧ + mixedTreeCheck D false ot {oh} = true ∧ + D.biUnion mixedNeighbors \ D ⊆ mixedTreeVertices ot {oh} ) := by + classical + intro mixedNeighbors mixedDecode mixedBlock mixedComponents mixedSelection mixedTreeVertices + mixedTreeCheck mixedInTrees mixedOutTrees mixedInHubs j + revert j + decide +kernel + +private theorem mixed_patches : + (by + classical + exact + let mixedNeighbors (a : PeriodicSubtileIndex) : Finset PeriodicSubtileIndex := + let m := a.first + let n := a.second + match a.label with + | .A => {⟨.B,m,n⟩, ⟨.B,m,n+1⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m,n⟩, + ⟨.C,m+1,n+1⟩, ⟨.D,m,n⟩, ⟨.E,m,n+1⟩, ⟨.F,m,n⟩} + | .B => {⟨.A,m,n⟩, ⟨.A,m,n-1⟩, ⟨.A,m-1,n-1⟩, ⟨.C,m,n⟩, + ⟨.D,m-1,n-1⟩, ⟨.D,m,n⟩, ⟨.E,m,n⟩, ⟨.F,m,n-1⟩} + | .C => {⟨.A,m,n⟩, ⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.D,m-1,n⟩, + ⟨.E,m-1,n⟩, ⟨.F,m,n⟩} + | .D => {⟨.A,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, + ⟨.E,m,n⟩, ⟨.F,m+1,n⟩} + | .E => {⟨.A,m,n-1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩} + | .F => {⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.C,m,n⟩, ⟨.D,m-1,n⟩} + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), AllowedSubtileIncidence a b + ↔ b ∈ mixedNeighbors a) → ((∀ {α : Type}, ∀ (r : α → α → Prop), ∀ (S : α → Prop), ∀ + (a : α), ∀ (b : α), (S a) → ((Relation.ReflTransGen (fun x y => r x y ∧ S x ∧ S y) a + b) → (∃ p : List α, p.head? = some a ∧ p.getLast? = some b ∧ (∀ x ∈ p, S x) ∧ + p.IsChain r))) → ((∀ (G : PlaneTriangulation PeriodicSubtileIndex), (∀ a, ∀ b, + G.adjacent a b ↔ b ∈ mixedNeighbors a) → (∀ (D : Finset PeriodicSubtileIndex), ∀ (hub + : PeriodicSubtileIndex), (∀ a ∈ D, ∀ b ∈ mixedNeighbors a, b ∉ D → + Relation.ReflTransGen (fun x y => G.adjacent x y ∧ x ∉ D ∧ y ∉ D) b hub) → (∀ a ∉ D, + ∀ b ∉ D, Relation.ReflTransGen (fun x y => G.adjacent x y ∧ x ∉ D ∧ y ∉ D) a b))) → ( + let mixedDecode (k : Nat) : PeriodicSubtileIndex := + ⟨match k % 6 with | 0 => .A | 1 => .B | 2 => .C | 3 => .D | 4 => .E | _ => .F, + (k / 6 / 7 : Int) - 3, (k / 6 % 7 : Int) - 3⟩ + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let mixedComponents (r : Nat) : Finset PeriodicSubtileIndex × + Finset PeriodicSubtileIndex × Finset PeriodicSubtileIndex := + (mixedBlock 0 0, match r with + | 0 => (mixedBlock 1 0, {⟨.B,1,1⟩}) + | 1 => (mixedBlock 0 1, {⟨.D,-1,0⟩}) + | 2 => (mixedBlock (-1) (-1), {⟨.F,0,-1⟩}) + | 3 => ({⟨.A,0,-1⟩}, {⟨.C,1,0⟩}) + | 4 => ({⟨.C,1,1⟩}, {⟨.E,0,1⟩}) + | _ => ({⟨.E,-1,0⟩}, {⟨.A,-1,-1⟩})) + let mixedSelection (j : Fin 42) : Finset PeriodicSubtileIndex := + let c := mixedComponents (j.val / 7) + let k := j.val % 7 + 1 + (if k % 2 = 1 then c.1 else ∅) ∪ + (if k / 2 % 2 = 1 then c.2.1 else ∅) ∪ + (if k / 4 % 2 = 1 then c.2.2 else ∅) + let mixedTreeVertices (tree : List (Nat × Nat)) (S : Finset PeriodicSubtileIndex) : + Finset PeriodicSubtileIndex := + tree.foldl (fun S e => insert (mixedDecode e.1) S) S + let mixedTreeCheck (D : Finset PeriodicSubtileIndex) (inside : Bool) + (es : List (Nat × Nat)) (S : Finset PeriodicSubtileIndex) : Bool := + es.foldr (fun (a,b) next S => + decide ((if inside then mixedDecode a ∈ D else mixedDecode a ∉ D) ∧ + mixedDecode b ∈ S ∧ mixedDecode b ∈ mixedNeighbors (mixedDecode a)) && + next (insert (mixedDecode a) S)) (fun _ => true) S + (∀ (G : PlaneTriangulation PeriodicSubtileIndex), (∀ a, ∀ b, G.adjacent a b ↔ b ∈ + mixedNeighbors a) → (∀ (D : Finset PeriodicSubtileIndex), ∀ (inside : Bool), ∀ (hub : + PeriodicSubtileIndex), ∀ (es : List (Nat × Nat)), ∀ (S : Finset + PeriodicSubtileIndex), (∀ a ∈ S, Relation.ReflTransGen (fun x y => G.adjacent x y ∧ + (if inside then x ∈ D else x ∉ D) ∧ (if inside then y ∈ D else y ∉ D)) a hub) → ((∀ a + ∈ S, if inside then a ∈ D else a ∉ D) → ((mixedTreeCheck D inside es S = true) → (∀ a + ∈ mixedTreeVertices es S, Relation.ReflTransGen (fun x y => G.adjacent x y ∧ (if + inside then x ∈ D else x ∉ D) ∧ (if inside then y ∈ D else y ∉ D)) a hub))))) → ( + let mixedInTrees : List (List (Nat × Nat)) := + MixedAggregateGeometry.incomingCertificateTrees + let mixedOutTrees : List (List (Nat × Nat)) := + MixedAggregateGeometry.outgoingCertificateTrees + let mixedInHubs : List Nat := + [144, 186, 144, 193, 144, 186, 144, 144, 150, 144, 105, 144, 150, 144, 144, 96, + 144, 143, 144, 96, 144, 144, 138, 144, 188, 144, 138, 144, 144, 194, 144, 154, + 144, 194, 144, 144, 106, 144, 96, 144, 106, 144] + (∀ (j : Fin 42), + let D := mixedSelection j + let it := mixedInTrees.getD j.val [] + let ih := mixedDecode (mixedInHubs.getD j.val 0) + let ot := mixedOutTrees.getD j.val [] + let oh := mixedDecode 102 + ih ∈ D ∧ oh ∉ D ∧ + mixedTreeCheck D true it {ih} = true ∧ + D ⊆ mixedTreeVertices it {ih} ∧ + mixedTreeCheck D false ot {oh} = true ∧ + D.biUnion mixedNeighbors \ D ⊆ mixedTreeVertices ot {oh}) → (∀ (q : Fin 4 → + CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ j : Fin 42, ∃ patch : FiniteInducedTilePatch cert.modified.plane + cert.modified.tile, patch.indices = mixedSelection j ∧ LatticeTile + patch.unionTile))))) ) := by + classical + intro mixedNeighbors mixedNeighbors_iff mixed_reach_walk mixed_boundary_detour mixedDecode + mixedBlock mixedComponents mixedSelection mixedTreeVertices mixedTreeCheck mixedTree_sound + mixedInTrees mixedOutTrees mixedInHubs mixed_certificates q cfg C₀ T cert j + let D := mixedSelection j + let it := mixedInTrees.getD j.val [] + let ih := mixedDecode (mixedInHubs.getD j.val 0) + let ot := mixedOutTrees.getD j.val [] + let oh := mixedDecode 102 + obtain ⟨hi,ho,hit,his,hot,hos⟩ := mixed_certificates j + have hadj : ∀ a b, cert.modified.plane.adjacent a b ↔ b ∈ mixedNeighbors a := by + intro a b + exact (cert.modified_adjacency a b).trans (mixedNeighbors_iff a b) + have symreach (S : PeriodicSubtileIndex → Prop) {a b : PeriodicSubtileIndex} + (h : Relation.ReflTransGen (fun x y => cert.modified.plane.adjacent x y ∧ S x ∧ S y) a b) : + Relation.ReflTransGen (fun x y => cert.modified.plane.adjacent x y ∧ S x ∧ S y) b a := by + induction h with + | refl => exact .refl + | tail h hs ih => exact (Relation.ReflTransGen.single + ⟨(cert.modified.plane.adjacent_symmetric _ _).1 hs.1, hs.2.2, hs.2.1⟩).trans ih + have ir : ∀ a ∈ D, + Relation.ReflTransGen (fun x y => cert.modified.plane.adjacent x y ∧ x ∈ D ∧ y ∈ D) a ih + := by + intro a ha + exact mixedTree_sound cert.modified.plane hadj D true ih it {ih} + (by intro b hb; simp only [Finset.mem_singleton] at hb; subst b; exact .refl) + (by intro b hb; simp only [Finset.mem_singleton] at hb; subst b; exact hi) hit a (his ha) + have obr : ∀ a ∈ D, ∀ b ∈ mixedNeighbors a, b ∉ D → + Relation.ReflTransGen (fun x y => cert.modified.plane.adjacent x y ∧ x ∉ D ∧ y ∉ D) b oh + := by + intro a ha b hb hbd + have hbin : b ∈ D.biUnion mixedNeighbors \ D := by + simp only [Finset.mem_sdiff, Finset.mem_biUnion] + exact ⟨⟨a,ha,hb⟩,hbd⟩ + exact mixedTree_sound cert.modified.plane hadj D false oh ot {oh} + (by intro b hb; simp only [Finset.mem_singleton] at hb; subst b; exact .refl) + (by intro b hb; simp only [Finset.mem_singleton] at hb; subst b; exact ho) hot b (hos hbin) + have oconn := mixed_boundary_detour cert.modified.plane hadj D oh obr + let W : ProtoTile := ⟨D.biUnion (fun a => (cert.modified.tile a).cells), 0⟩ + let patch : FiniteInducedTilePatch cert.modified.plane cert.modified.tile := { + indices := D + unionTile := W + nonempty := ⟨ih,hi⟩ + tile_injective := by + intro a ha b hb heq + obtain ⟨x,hx⟩ := (LatticeTileGridStructure _ (cert.modified.tiles_are_disks a)).1.1 + have hx' : x ∈ (cert.modified.tile a).cells := hx + have hbx : x ∈ (cert.modified.tile b).cells := by rw [← heq]; exact hx' + obtain ⟨c,hc,hunique⟩ := PeriodicTileIndexedMultiplicityOne cert.modified x + exact (hunique a hx').trans (hunique b hbx).symm + exact_union := by intro x; simp [W] + induced_connected := by + intro a ha b hb + obtain ⟨p,hp,hq,hm,hc⟩ := mixed_reach_walk cert.modified.plane.adjacent + (fun x => x ∈ D) a b ha ((ir a ha).trans (symreach _ (ir b hb))) + exact ⟨p,hp,hq,hm,(List.isChain_iff_forall_rel_of_append_cons_cons).1 hc⟩ + complement_connected := by + intro a ha b hb + obtain ⟨p,hp,hq,hm,hc⟩ := mixed_reach_walk cert.modified.plane.adjacent + (fun x => x ∉ D) a b ha (oconn a ha b hb) + exact ⟨p,hp,hq,hm,(List.isChain_iff_forall_rel_of_append_cons_cons).1 hc⟩ } + refine ⟨patch,rfl,?_⟩ + exact FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) + (PeriodicTileIndexedMultiplicityOne cert.modified) + (fun a b _ h => cert.modified.adjacent_has_common_edge a b h) patch + +private theorem restore_mixed : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (O : ProtoTile), ∀ (W : ProtoTile), ∀ (R : + ProtoTile), (LatticeTile A) → ((LatticeTile (TileCellComplement A O)) → ((LatticeTile + (TileCellComplement B O)) → ((LatticeTile W) → ((O.cells ⊆ A.cells) → + (((TileCellComplement A O).cells ⊆ W.cells) → ((Disjoint B.cells W.cells) → ((R.cells + = W.cells ∪ O.cells) → ((∀ x ∈ O.cells, ∀ y, FourNeighborAdjacent x y → + y ∈ A.cells ∨ y ∈ B.cells) → (LatticeTile R))))))))) ) := by + classical + intro A B O W R hA hAm hBm hW hOA hAmW hBW hR hiso + classical + let reach (S : Set LatticeCell) := Relation.ReflTransGen + (fun x y => FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S) + have symadj {a b : LatticeCell} (h : FourNeighborAdjacent a b) : + FourNeighborAdjacent b a := by + rcases h with h | h | h | h <;> subst b <;> + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + have symreach (S : Set LatticeCell) {a b : LatticeCell} (h : reach S a b) : reach S b a := by + induction h with + | refl => exact .refl + | tail h hs ih => exact (Relation.ReflTransGen.single ⟨symadj hs.1,hs.2.2,hs.2.1⟩).trans ih + have walk_reach : ∀ (S : Set LatticeCell) (p : List LatticeCell) (a b : LatticeCell), + p.head? = some a → p.getLast? = some b → + (∀ x ∈ p, x ∈ S) → p.IsChain FourNeighborAdjacent → reach S a b := by + intro S p a b ha hb hm hc + have hn : p ≠ [] := by intro h; subst p; simp at ha + have hc' : p.IsChain (fun x y => FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S) := + hc.imp_of_mem_imp (fun x y hx hy hxy => ⟨hxy, hm x hx, hm y hy⟩) + have h := List.relationReflTransGen_of_exists_isChain p hc' hn + have heada : p.head hn = a := by simpa [List.head?_eq_some_head hn] using ha + have lastb : p.getLast hn = b := by simpa [List.getLast?_eq_some_getLast hn] using hb + simpa [heada,lastb] using h + have connected_reach : ∀ (S : Set LatticeCell), FourNeighborConnected S → + ∀ a ∈ S, ∀ b ∈ S, reach S a b := by + intro S hc a ha b hb + obtain ⟨p,hp,hq,hm,hchain⟩ := hc.2 a ha b hb + exact walk_reach S p a b hp hq hm + ((List.isChain_iff_forall_rel_of_append_cons_cons).2 hchain) + have reach_walk : ∀ (S : Set LatticeCell) (a b : LatticeCell), a ∈ S → reach S a b → + ∃ p : List LatticeCell, p.head? = some a ∧ p.getLast? = some b ∧ + (∀ x ∈ p, x ∈ S) ∧ p.IsChain FourNeighborAdjacent := by + intro S a b ha h + obtain ⟨l,hc,hl⟩ := List.exists_isChain_cons_of_relationReflTransGen h + refine ⟨a::l,rfl,?_,?_,hc.imp (fun _ _ h => h.1)⟩ + · simpa [List.getLast?_eq_some_getLast (List.cons_ne_nil a l)] using congrArg some hl + · have go : ∀ (u : LatticeCell) (p : List LatticeCell), u ∈ S → + (u::p).IsChain (fun x y => FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S) → + ∀ x ∈ u::p, x ∈ S := by + intro u p + induction p generalizing u with + | nil => + intro hu hc x hx + have hxu : x = u := List.mem_singleton.mp hx + exact hxu ▸ hu + | cons v p ih => + intro hu hc x hx + simp only [List.mem_cons] at hx + rcases hx with rfl | hx + · exact hu + · exact ih v hc.rel.2.2 hc.tail x (by simpa only [List.mem_cons] using hx) + exact go a l ha hc + have hAR : A.cells ⊆ R.cells := by + intro x hx + rw [hR] + by_cases ho : x ∈ O.cells + · exact Finset.mem_union_right _ ho + · exact Finset.mem_union_left _ (hAmW (Finset.mem_sdiff.mpr ⟨hx,ho⟩)) + have hWR : W.cells ⊆ R.cells := by rw [hR]; exact Finset.subset_union_left + have hBmR : ∀ x ∈ (TileCellComplement B O).cells, x ∉ R.cells := by + intro x hx + simp only [TileCellComplement, Finset.mem_sdiff] at hx + rw [hR] + simp only [Finset.mem_union, not_or] + exact ⟨fun hw => Finset.disjoint_left.mp hBW hx.1 hw,hx.2⟩ + have mono_reach : ∀ (S U : Set LatticeCell), S ⊆ U → + ∀ {a b}, reach S a b → reach U a b := by + intro S U hsub a b h + exact Relation.ReflTransGen.mono + (fun x y hxy => ⟨hxy.1,hsub hxy.2.1,hsub hxy.2.2⟩) _ _ h + have cw := (LatticeTileGridStructure W hW).1 + have ca := (LatticeTileGridStructure A hA).1 + have cm := (LatticeTileGridStructure (TileCellComplement A O) hAm).1 + have cb := (LatticeTileGridStructure (TileCellComplement B O) hBm).1 + obtain ⟨base,hbase⟩ := cm.1 + have hbaseA : base ∈ A.cells := (Finset.mem_sdiff.mp hbase).1 + have hbaseW : base ∈ W.cells := hAmW hbase + have inbase : ∀ x ∈ R.cells, reach (R.cells : Set LatticeCell) x base := by + intro x hx + rw [hR, Finset.mem_union] at hx + rcases hx with hx | hx + · exact mono_reach _ _ hWR (connected_reach _ cw x hx base hbaseW) + · exact mono_reach _ _ hAR (connected_reach _ ca x (hOA hx) base hbaseA) + have inside : FourNeighborConnected (R.cells : Set LatticeCell) := by + refine ⟨⟨base,hWR hbaseW⟩,?_⟩ + intro x hx y hy + obtain ⟨p,hp,hq,hm,hc⟩ := reach_walk _ x y hx + ((inbase x hx).trans (symreach _ (inbase y hy))) + exact ⟨p,hp,hq,hm,(List.isChain_iff_forall_rel_of_append_cons_cons).1 hc⟩ + obtain ⟨outbase,houtbase⟩ := cb.1 + have cout := LatticeTileComplementGridConnected W hW + have bconnect : ∀ x ∈ (TileCellComplement B O).cells, + reach ((R.cells : Set LatticeCell)ᶜ) x outbase := by + intro x hx + exact mono_reach _ _ hBmR (connected_reach _ cb x hx outbase houtbase) + have outside : FourNeighborConnected ((R.cells : Set LatticeCell)ᶜ) := by + refine ⟨⟨outbase,hBmR outbase houtbase⟩,?_⟩ + intro x hx y hy + have hxW : x ∉ W.cells := fun h => hx (hWR h) + have hyW : y ∉ W.cells := fun h => hy (hWR h) + have hxO : x ∉ O.cells := fun h => hx (hAR (hOA h)) + have hyO : y ∉ O.cells := fun h => hy (hAR (hOA h)) + let f : LatticeCell → LatticeCell := fun z => if z ∈ O.cells then outbase else z + have cross : ∀ a ∈ O.cells, ∀ b, b ∉ W.cells → b ∉ O.cells → + FourNeighborAdjacent a b → b ∈ (TileCellComplement B O).cells := by + intro a ha b hb ho hab + rcases hiso a ha b hab with hba | hbb + · exact False.elim (hb (hAmW (Finset.mem_sdiff.mpr ⟨hba,ho⟩))) + · exact Finset.mem_sdiff.mpr ⟨hbb,ho⟩ + have liftStep : ∀ a b, + (FourNeighborAdjacent a b ∧ a ∉ W.cells ∧ b ∉ W.cells) → + reach ((R.cells : Set LatticeCell)ᶜ) (f a) (f b) := by + intro a b hab + by_cases ha : a ∈ O.cells <;> by_cases hb : b ∈ O.cells + · simp only [f,ite_eq_left ha,ite_eq_left hb]; exact .refl + · simp only [f,ite_eq_left ha,ite_eq_right hb] + exact symreach _ (bconnect b (cross a ha b hab.2.2 hb hab.1)) + · simp only [f,ite_eq_right ha,ite_eq_left hb] + exact bconnect a (cross b hb a hab.2.1 ha (symadj hab.1)) + · simp only [f,ite_eq_right ha,ite_eq_right hb] + exact .single ⟨hab.1,by simpa [hR] using And.intro hab.2.1 ha, + by simpa [hR] using And.intro hab.2.2 hb⟩ + have hxy := (connected_reach _ cout x hxW y hyW).lift' f liftStep + have hxy' : reach ((R.cells : Set LatticeCell)ᶜ) x y := by + simpa [reach,Function.onFun,f,hxO,hyO] using hxy + obtain ⟨p,hp,hq,hm,hc⟩ := reach_walk _ x y hx hxy' + exact ⟨p,hp,hq,hm,(List.isChain_iff_forall_rel_of_append_cons_cons).1 hc⟩ + exact FinitePolyominoDiskCriterion R inside outside + (FiniteConnectedCellSetNoCheckerboard R.cells inside outside) + +private theorem cellDisk : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells = Y.cells) → (LatticeTile X ↔ LatticeTile + Y) ) := by + classical + intro X Y hc + unfold LatticeTile TileRealization + rw [hc] + +private theorem translation_complement : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), TileTranslation + (TileCellComplement X O) u = TileCellComplement (TileTranslation X u) + (TileTranslation O u) ) := by + classical + intro X O u + unfold TileTranslation TileCellComplement + rw [Finset.image_sdiff X.cells O.cells + (show Function.Injective (GaussianTranslation u) from + fun _ _ h => add_right_cancel h)] + +private theorem hOA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), cert.O.cells ⊆ (cert.P 0 true).cells ) := by + classical + intro q cfg C₀ T cert x hx + rw [cert.precursor_eq] at hx + exact (cert.plus_union x).2 ⟨0,false,hx⟩ + +private theorem hOB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), cert.O.cells ⊆ (cert.P 0 false).cells ) := by + classical + intro q cfg C₀ T cert x hx + rw [cert.precursor_cells] at hx + exact (cert.minus_union x).2 ⟨0,true,hx⟩ + +private theorem original_lattice : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + ∀ (a : PeriodicSubtileIndex), LatticeTile (original a) ) := by + classical + intro q cfg C₀ T cert original a + rcases a with ⟨l,m,n⟩ + cases l <;> exact (TileDiskAreaCovariance _ _).1.mp (cert.parent_lattice _ _) + +private theorem mod_nonA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + ∀ (a : PeriodicSubtileIndex), (a.label ≠ .A) → (cert.modified.tile a = original a) ) := by + classical + intro q cfg C₀ T cert original a h + rw [cert.modified_tile] + rcases a with ⟨l,m,n⟩ + cases l + · exact False.elim (h rfl) + all_goals rfl + +private theorem mod_A : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let offset (a : PeriodicSubtileIndex) : GaussianInt := + (a.first : GaussianInt) * cert.u + (a.second : GaussianInt) * cert.v + let precursor (a : PeriodicSubtileIndex) := TileTranslation cert.O (offset a) + (∀ (X : ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), TileTranslation + (TileCellComplement X O) u = TileCellComplement (TileTranslation X u) + (TileTranslation O u)) → (∀ (a : PeriodicSubtileIndex), (a.label = .A) → + (cert.modified.tile a = TileCellComplement (original a) (precursor a))) ) := by + classical + intro q cfg C₀ T cert original offset precursor translation_complement a h + rw [cert.modified_tile] + rcases a with ⟨l,m,n⟩ + cases h + exact translation_complement _ _ _ + +private theorem precursor_subset_A : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let offset (a : PeriodicSubtileIndex) : GaussianInt := + (a.first : GaussianInt) * cert.u + (a.second : GaussianInt) * cert.v + let precursor (a : PeriodicSubtileIndex) := TileTranslation cert.O (offset a) + (cert.O.cells ⊆ (cert.P 0 true).cells) → (∀ (a : PeriodicSubtileIndex), (a.label = .A) → + ((precursor a).cells ⊆ (original a).cells)) ) := by + classical + intro q cfg C₀ T cert original offset precursor hOA a h + rcases a with ⟨l,m,n⟩ + cases h + exact Finset.image_mono _ hOA + +private theorem precursor_subset_B : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let offset (a : PeriodicSubtileIndex) : GaussianInt := + (a.first : GaussianInt) * cert.u + (a.second : GaussianInt) * cert.v + let precursor (a : PeriodicSubtileIndex) := TileTranslation cert.O (offset a) + let paired (a : PeriodicSubtileIndex) : PeriodicSubtileIndex := ⟨.B,a.first,a.second⟩ + (cert.O.cells ⊆ (cert.P 0 false).cells) → (∀ (a : PeriodicSubtileIndex), (precursor + a).cells ⊆ (original (paired a)).cells) ) := by + classical + intro q cfg C₀ T cert original offset precursor paired hOB a + exact Finset.image_mono _ hOB + +private theorem mod_subset : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let offset (a : PeriodicSubtileIndex) : GaussianInt := + (a.first : GaussianInt) * cert.u + (a.second : GaussianInt) * cert.v + let precursor (a : PeriodicSubtileIndex) := TileTranslation cert.O (offset a) + (∀ (a : PeriodicSubtileIndex), (a.label ≠ .A) → (cert.modified.tile a = original a)) → + ((∀ (a : PeriodicSubtileIndex), (a.label = .A) → (cert.modified.tile a = + TileCellComplement (original a) (precursor a))) → (∀ (a : PeriodicSubtileIndex), + (cert.modified.tile a).cells ⊆ (original a).cells)) ) := by + classical + intro q cfg C₀ T cert original offset precursor mod_nonA mod_A a + by_cases h : a.label = .A + · rw [mod_A a h] + exact Finset.sdiff_subset + · rw [mod_nonA a h] + +private theorem exception_certificate : + (by + classical + exact + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let mixedComponents (r : Nat) : Finset PeriodicSubtileIndex × + Finset PeriodicSubtileIndex × Finset PeriodicSubtileIndex := + (mixedBlock 0 0, match r with + | 0 => (mixedBlock 1 0, {⟨.B,1,1⟩}) + | 1 => (mixedBlock 0 1, {⟨.D,-1,0⟩}) + | 2 => (mixedBlock (-1) (-1), {⟨.F,0,-1⟩}) + | 3 => ({⟨.A,0,-1⟩}, {⟨.C,1,0⟩}) + | 4 => ({⟨.C,1,1⟩}, {⟨.E,0,1⟩}) + | _ => ({⟨.E,-1,0⟩}, {⟨.A,-1,-1⟩})) + let mixedSelection (j : Fin 42) : Finset PeriodicSubtileIndex := + let c := mixedComponents (j.val / 7) + let k := j.val % 7 + 1 + (if k % 2 = 1 then c.1 else ∅) ∪ + (if k / 2 % 2 = 1 then c.2.1 else ∅) ∪ + (if k / 4 % 2 = 1 then c.2.2 else ∅) + let paired (a : PeriodicSubtileIndex) : PeriodicSubtileIndex := ⟨.B,a.first,a.second⟩ + let exception (j : Fin 42) : Option PeriodicSubtileIndex := + if j.val / 7 = 3 ∧ (j.val % 7 + 1) / 2 % 2 = 1 then some ⟨.A,0,-1⟩ else + if j.val / 7 = 5 ∧ (j.val % 7 + 1) / 4 % 2 = 1 then some ⟨.A,-1,-1⟩ else none + ∀ (j : Fin 42), (∀ a ∈ mixedSelection j, a.label = .A → paired a ∈ mixedSelection j ∨ + exception j = some a) ∧ (match exception j with + | none => True + | some a => a ∈ mixedSelection j ∧ a.label = .A ∧ + paired a ∉ mixedSelection j) ) := by + classical + intro mixedBlock mixedComponents mixedSelection paired exception j + let validException (j : Fin 42) : Bool := match exception j with + | none => true + | some a => decide (a ∈ mixedSelection j ∧ a.label = .A ∧ paired a ∉ mixedSelection j) + have finiteCheck : ∀ j : Fin 42, + (mixedSelection j).filter (fun a => ¬ (a.label = .A → + paired a ∈ mixedSelection j ∨ exception j = some a)) = ∅ ∧ + validException j = true := by + decide +kernel + obtain ⟨h₁,h₂⟩ := finiteCheck j + constructor + · simpa only [Finset.filter_eq_empty_iff, not_not] using h₁ + · cases he : exception j with + | none => trivial + | some a => + apply of_decide_eq_true + simpa only [validException, he] using h₂ + +private theorem shared_vertex : + (by + classical + exact + ∀ (O : ProtoTile), ∀ (x : LatticeCell), (x ∈ O.cells) → (∀ (y : LatticeCell), + (FourNeighborAdjacent x y) → (∃ v, v ∈ FootprintVertices O ∧ v ∈ FootprintVertices + (⟨{y},y⟩ : ProtoTile))) ) := by + classical + intro O x hx y hxy + have hn : O.cells.Nonempty := ⟨x,hx⟩ + rcases hxy with rfl | rfl | rfl | rfl + · refine ⟨x+1, ?_, ?_⟩ + · simp only [FootprintVertices,ite_eq_left hn,Set.mem_ofPred_eq] + exact ⟨x,hx,Or.inr (Or.inl rfl)⟩ + · simp [FootprintVertices] + · refine ⟨x, ?_, ?_⟩ + · simp only [FootprintVertices,ite_eq_left hn,Set.mem_ofPred_eq] + exact ⟨x,hx,Or.inl rfl⟩ + · simp [FootprintVertices] + · refine ⟨x+⟨0,1⟩, ?_, ?_⟩ + · simp only [FootprintVertices,ite_eq_left hn,Set.mem_ofPred_eq] + exact ⟨x,hx,Or.inr (Or.inr (Or.inl rfl))⟩ + · simp [FootprintVertices] + · refine ⟨x, ?_, ?_⟩ + · simp only [FootprintVertices,ite_eq_left hn,Set.mem_ofPred_eq] + exact ⟨x,hx,Or.inl rfl⟩ + · simp [FootprintVertices] + +private theorem original_patches : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let mixedComponents (r : Nat) : Finset PeriodicSubtileIndex × + Finset PeriodicSubtileIndex × Finset PeriodicSubtileIndex := + (mixedBlock 0 0, match r with + | 0 => (mixedBlock 1 0, {⟨.B,1,1⟩}) + | 1 => (mixedBlock 0 1, {⟨.D,-1,0⟩}) + | 2 => (mixedBlock (-1) (-1), {⟨.F,0,-1⟩}) + | 3 => ({⟨.A,0,-1⟩}, {⟨.C,1,0⟩}) + | 4 => ({⟨.C,1,1⟩}, {⟨.E,0,1⟩}) + | _ => ({⟨.E,-1,0⟩}, {⟨.A,-1,-1⟩})) + let mixedSelection (j : Fin 42) : Finset PeriodicSubtileIndex := + let c := mixedComponents (j.val / 7) + let k := j.val % 7 + 1 + (if k % 2 = 1 then c.1 else ∅) ∪ + (if k / 2 % 2 = 1 then c.2.1 else ∅) ∪ + (if k / 4 % 2 = 1 then c.2.2 else ∅) + (∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ j : Fin 42, ∃ patch : FiniteInducedTilePatch cert.modified.plane + cert.modified.tile, patch.indices = mixedSelection j ∧ LatticeTile patch.unionTile) → + ((∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (O : ProtoTile), ∀ (W : ProtoTile), ∀ (R : + ProtoTile), (LatticeTile A) → ((LatticeTile (TileCellComplement A O)) → ((LatticeTile + (TileCellComplement B O)) → ((LatticeTile W) → ((O.cells ⊆ A.cells) → + (((TileCellComplement A O).cells ⊆ W.cells) → ((Disjoint B.cells W.cells) → ((R.cells + = W.cells ∪ O.cells) → ((∀ x ∈ O.cells, ∀ y, FourNeighborAdjacent x y → y ∈ A.cells ∨ + y ∈ B.cells) → (LatticeTile R)))))))))) → ( + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let offset (a : PeriodicSubtileIndex) : GaussianInt := + (a.first : GaussianInt) * cert.u + (a.second : GaussianInt) * cert.v + let precursor (a : PeriodicSubtileIndex) := TileTranslation cert.O (offset a) + let paired (a : PeriodicSubtileIndex) : PeriodicSubtileIndex := ⟨.B,a.first,a.second⟩ + (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells = Y.cells) → (LatticeTile X ↔ LatticeTile + Y)) → ((∀ (X : ProtoTile), ∀ (O : ProtoTile), ∀ (u : GaussianInt), TileTranslation + (TileCellComplement X O) u = TileCellComplement (TileTranslation X u) + (TileTranslation O u)) → ((∀ (a : PeriodicSubtileIndex), LatticeTile (original a)) → + ((∀ (a : PeriodicSubtileIndex), (a.label ≠ .A) → (cert.modified.tile a = original a)) + → ((∀ (a : PeriodicSubtileIndex), (a.label = .A) → (cert.modified.tile a = + TileCellComplement (original a) (precursor a))) → ((∀ (a : PeriodicSubtileIndex), + (a.label = .A) → ((precursor a).cells ⊆ (original a).cells)) → ((∀ (a : + PeriodicSubtileIndex), (precursor a).cells ⊆ (original (paired a)).cells) → ((∀ (a : + PeriodicSubtileIndex), (cert.modified.tile a).cells ⊆ (original a).cells) → ( + let exception (j : Fin 42) : Option PeriodicSubtileIndex := + if j.val / 7 = 3 ∧ (j.val % 7 + 1) / 2 % 2 = 1 then some ⟨.A,0,-1⟩ else + if j.val / 7 = 5 ∧ (j.val % 7 + 1) / 4 % 2 = 1 then some ⟨.A,-1,-1⟩ else none + (∀ (j : Fin 42), (∀ a ∈ mixedSelection j, a.label = .A → paired a ∈ mixedSelection j ∨ + exception j = some a) ∧ (match exception j with + | none => True + | some a => a ∈ mixedSelection j ∧ a.label = .A ∧ + paired a ∉ mixedSelection j)) → ((∀ (O : + ProtoTile), ∀ (x : LatticeCell), (x ∈ O.cells) → (∀ (y : LatticeCell), + (FourNeighborAdjacent x y) → (∃ v, v ∈ FootprintVertices O ∧ v ∈ FootprintVertices + (⟨{y},y⟩ : ProtoTile)))) → (∀ j : Fin 42, LatticeTile (⟨(mixedSelection j).biUnion + (fun a => (original a).cells),0⟩ : ProtoTile))))))))))))) ) := by + classical + intro q cfg C₀ T cert mixedBlock mixedComponents mixedSelection mixed_patches restore_mixed + original offset precursor paired cellDisk translation_complement original_lattice mod_nonA + mod_A precursor_subset_A precursor_subset_B mod_subset exception exception_certificate + shared_vertex j + let D := mixedSelection j + let R : ProtoTile := ⟨D.biUnion (fun a => (original a).cells),0⟩ + obtain ⟨W,hWD,hW⟩ := mixed_patches q cfg C₀ T cert j + have exactW (x : LatticeCell) : x ∈ W.unionTile.cells ↔ + ∃ a ∈ D, x ∈ (cert.modified.tile a).cells := by + simpa [hWD] using W.exact_union x + have exactR (x : LatticeCell) : x ∈ R.cells ↔ + ∃ a ∈ D, x ∈ (original a).cells := by simp [R] + obtain ⟨hpaired,hexc⟩ := exception_certificate j + have hWR : W.unionTile.cells ⊆ R.cells := by + intro x hx + obtain ⟨a,ha,hx⟩ := (exactW x).1 hx + exact (exactR x).2 ⟨a,ha,mod_subset a hx⟩ + have split_cell (a : PeriodicSubtileIndex) (ha : a ∈ D) (x : LatticeCell) + (hx : x ∈ (original a).cells) : + x ∈ W.unionTile.cells ∨ + (exception j = some a ∧ x ∈ (precursor a).cells) := by + by_cases hl : a.label = .A + · by_cases ho : x ∈ (precursor a).cells + · rcases hpaired a ha hl with hb | he + · left + apply (exactW x).2 + refine ⟨paired a,hb,?_⟩ + rw [mod_nonA (paired a) (by simp [paired])] + exact precursor_subset_B a ho + · exact Or.inr ⟨he,ho⟩ + · left + apply (exactW x).2 + refine ⟨a,ha,?_⟩ + rw [mod_A a hl] + exact Finset.mem_sdiff.mpr ⟨hx,ho⟩ + · left + exact (exactW x).2 ⟨a,ha,by rw [mod_nonA a hl]; exact hx⟩ + cases he : exception j with + | none => + have hc : R.cells = W.unionTile.cells := by + apply Finset.Subset.antisymm _ hWR + intro x hx + obtain ⟨a,ha,hx⟩ := (exactR x).1 hx + rcases split_cell a ha x hx with hx | ⟨he',hx⟩ + · exact hx + · simp [he] at he' + exact (cellDisk R W.unionTile hc).2 hW + | some a => + rw [he] at hexc + obtain ⟨ha,hl,hbn⟩ := hexc + have hc : R.cells = W.unionTile.cells ∪ (precursor a).cells := by + ext x + constructor + · intro hx + obtain ⟨b,hb,hx⟩ := (exactR x).1 hx + rcases split_cell b hb x hx with hx | ⟨he',hx⟩ + · exact Finset.mem_union_left _ hx + · have hab : a = b := Option.some.inj (he.symm.trans he') + subst b + exact Finset.mem_union_right _ hx + · intro hx + rcases Finset.mem_union.mp hx with hx | hx + · exact hWR hx + · exact (exactR x).2 ⟨a,ha,precursor_subset_A a hl hx⟩ + have hBW : Disjoint (original (paired a)).cells W.unionTile.cells := by + apply Finset.disjoint_left.mpr + intro x hxB hxW + obtain ⟨b,hb,hxb⟩ := (exactW x).1 hxW + have hxBa : x ∈ (cert.modified.tile (paired a)).cells := by + rw [mod_nonA (paired a) (by simp [paired])] + exact hxB + obtain ⟨c,hc,hunique⟩ := PeriodicTileIndexedMultiplicityOne cert.modified x + have hba : b = paired a := (hunique b hxb).trans (hunique _ hxBa).symm + exact hbn (hba ▸ hb) + have hBm : LatticeTile (TileCellComplement (original (paired a)) (precursor a)) := by + have hb := (TileDiskAreaCovariance _ (offset a)).1.mp cert.precursor_complement_lattice.2 + rw [translation_complement] at hb + exact hb + refine restore_mixed (original a) (original (paired a)) (precursor a) W.unionTile R + (original_lattice a) + ((mod_A a hl) ▸ cert.modified.tiles_are_disks a) + hBm hW (precursor_subset_A a hl) ?_ hBW hc ?_ + · intro x hx + apply (exactW x).2 + exact ⟨a,ha,(mod_A a hl).symm ▸ hx⟩ + · intro x hx y hxy + obtain ⟨v,hv,hvy⟩ := shared_vertex (precursor a) x hx y hxy + have hi := cert.precursor_isolated a.first a.second v hv y hvy + rcases a with ⟨l,m,n⟩ + cases hl + exact hi + +private theorem selection_certificate : + (by + classical + exact + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let mixedComponents (r : Nat) : Finset PeriodicSubtileIndex × + Finset PeriodicSubtileIndex × Finset PeriodicSubtileIndex := + (mixedBlock 0 0, match r with + | 0 => (mixedBlock 1 0, {⟨.B,1,1⟩}) + | 1 => (mixedBlock 0 1, {⟨.D,-1,0⟩}) + | 2 => (mixedBlock (-1) (-1), {⟨.F,0,-1⟩}) + | 3 => ({⟨.A,0,-1⟩}, {⟨.C,1,0⟩}) + | 4 => ({⟨.C,1,1⟩}, {⟨.E,0,1⟩}) + | _ => ({⟨.E,-1,0⟩}, {⟨.A,-1,-1⟩})) + let mixedSelection (j : Fin 42) : Finset PeriodicSubtileIndex := + let c := mixedComponents (j.val / 7) + let k := j.val % 7 + 1 + (if k % 2 = 1 then c.1 else ∅) ∪ + (if k / 2 % 2 = 1 then c.2.1 else ∅) ∪ + (if k / 4 % 2 = 1 then c.2.2 else ∅) + let componentIndices (r : Fin 6) (s : Fin 3) := + let c := mixedComponents r.val + if s = 0 then c.1 else if s = 1 then c.2.1 else c.2.2 + let selectionIndex (r : Fin 6) (s : Fin 7) : Fin 42 := ⟨r.val * 7 + s.val,by omega⟩ + ∀ (r : Fin 6), mixedSelection (selectionIndex r 0) = componentIndices r 0 ∧ + mixedSelection (selectionIndex r 1) = componentIndices r 1 ∧ mixedSelection + (selectionIndex r 3) = componentIndices r 2 ∧ mixedSelection (selectionIndex r 2) = + componentIndices r 0 ∪ componentIndices r 1 ∧ mixedSelection (selectionIndex r 5) = + componentIndices r 1 ∪ componentIndices r 2 ∧ mixedSelection (selectionIndex r 4) = + componentIndices r 2 ∪ componentIndices r 0 ∧ mixedSelection (selectionIndex r 6) = + componentIndices r 0 ∪ componentIndices r 1 ∪ componentIndices r 2 ) := by + classical + intro mixedBlock mixedComponents mixedSelection componentIndices selectionIndex r + revert r + decide +kernel + +private theorem owner_certificate : + (by + classical + exact + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let mixedComponents (r : Nat) : Finset PeriodicSubtileIndex × + Finset PeriodicSubtileIndex × Finset PeriodicSubtileIndex := + (mixedBlock 0 0, match r with + | 0 => (mixedBlock 1 0, {⟨.B,1,1⟩}) + | 1 => (mixedBlock 0 1, {⟨.D,-1,0⟩}) + | 2 => (mixedBlock (-1) (-1), {⟨.F,0,-1⟩}) + | 3 => ({⟨.A,0,-1⟩}, {⟨.C,1,0⟩}) + | 4 => ({⟨.C,1,1⟩}, {⟨.E,0,1⟩}) + | _ => ({⟨.E,-1,0⟩}, {⟨.A,-1,-1⟩})) + let paired (a : PeriodicSubtileIndex) : PeriodicSubtileIndex := ⟨.B,a.first,a.second⟩ + let componentIndices (r : Fin 6) (s : Fin 3) := + let c := mixedComponents r.val + if s = 0 then c.1 else if s = 1 then c.2.1 else c.2.2 + let owners (D : Finset PeriodicSubtileIndex) := + D ∪ (D.filter (fun a => a.label = .A)).image paired + ∀ (r : Fin 6), ∀ (s : Fin 3), ∀ (t : Fin 3), (s ≠ t) → (Disjoint (owners + (componentIndices r s)) (owners (componentIndices r t))) ) := by + classical + intro mixedBlock mixedComponents paired componentIndices owners r s t hst + have hc : ∀ (r : Fin 6) (s t : Fin 3), s ≠ t → + Disjoint (owners (componentIndices r s)) (owners (componentIndices r t)) := by + decide +kernel + exact hc r s t hst + +private theorem edge_certificate : + (by + classical + exact + let mixedNeighbors (a : PeriodicSubtileIndex) : Finset PeriodicSubtileIndex := + let m := a.first + let n := a.second + match a.label with + | .A => {⟨.B,m,n⟩, ⟨.B,m,n+1⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m,n⟩, + ⟨.C,m+1,n+1⟩, ⟨.D,m,n⟩, ⟨.E,m,n+1⟩, ⟨.F,m,n⟩} + | .B => {⟨.A,m,n⟩, ⟨.A,m,n-1⟩, ⟨.A,m-1,n-1⟩, ⟨.C,m,n⟩, + ⟨.D,m-1,n-1⟩, ⟨.D,m,n⟩, ⟨.E,m,n⟩, ⟨.F,m,n-1⟩} + | .C => {⟨.A,m,n⟩, ⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.D,m-1,n⟩, + ⟨.E,m-1,n⟩, ⟨.F,m,n⟩} + | .D => {⟨.A,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, + ⟨.E,m,n⟩, ⟨.F,m+1,n⟩} + | .E => {⟨.A,m,n-1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩} + | .F => {⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.C,m,n⟩, ⟨.D,m-1,n⟩} + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let mixedComponents (r : Nat) : Finset PeriodicSubtileIndex × + Finset PeriodicSubtileIndex × Finset PeriodicSubtileIndex := + (mixedBlock 0 0, match r with + | 0 => (mixedBlock 1 0, {⟨.B,1,1⟩}) + | 1 => (mixedBlock 0 1, {⟨.D,-1,0⟩}) + | 2 => (mixedBlock (-1) (-1), {⟨.F,0,-1⟩}) + | 3 => ({⟨.A,0,-1⟩}, {⟨.C,1,0⟩}) + | 4 => ({⟨.C,1,1⟩}, {⟨.E,0,1⟩}) + | _ => ({⟨.E,-1,0⟩}, {⟨.A,-1,-1⟩})) + let componentIndices (r : Fin 6) (s : Fin 3) := + let c := mixedComponents r.val + if s = 0 then c.1 else if s = 1 then c.2.1 else c.2.2 + ∀ (r : Fin 6), ∀ (s : Fin 3), ∀ (t : Fin 3), (s ≠ t) → (((componentIndices r s).biUnion + mixedNeighbors ∩ componentIndices r t).Nonempty) ) := by + classical + intro mixedNeighbors mixedBlock mixedComponents componentIndices r s t hst + have hc : ∀ (r : Fin 6) (s t : Fin 3), s ≠ t → + ((componentIndices r s).biUnion mixedNeighbors ∩ componentIndices r t).Nonempty := by + decide +kernel + exact hc r s t hst + +private theorem original_owner : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let offset (a : PeriodicSubtileIndex) : GaussianInt := + (a.first : GaussianInt) * cert.u + (a.second : GaussianInt) * cert.v + let precursor (a : PeriodicSubtileIndex) := TileTranslation cert.O (offset a) + let paired (a : PeriodicSubtileIndex) : PeriodicSubtileIndex := ⟨.B,a.first,a.second⟩ + (∀ (a : PeriodicSubtileIndex), (a.label ≠ .A) → (cert.modified.tile a = original a)) → + ((∀ (a : PeriodicSubtileIndex), (a.label = .A) → (cert.modified.tile a = + TileCellComplement (original a) (precursor a))) → ((∀ (a : PeriodicSubtileIndex), + (precursor a).cells ⊆ (original (paired a)).cells) → ( + let owners (D : Finset PeriodicSubtileIndex) := + D ∪ (D.filter (fun a => a.label = .A)).image paired + ∀ (a : PeriodicSubtileIndex), ∀ (x : LatticeCell), (x ∈ (original a).cells) → (∃ b ∈ + owners {a}, x ∈ (cert.modified.tile b).cells)))) ) := by + classical + intro q cfg C₀ T cert original offset precursor paired mod_nonA mod_A precursor_subset_B owners + a x hx + by_cases hl : a.label = .A + · by_cases ho : x ∈ (precursor a).cells + · refine ⟨paired a, ?_, ?_⟩ + · simp [owners,hl] + · rw [mod_nonA (paired a) (by simp [paired])] + exact precursor_subset_B a ho + · refine ⟨a,by simp [owners],?_⟩ + rw [mod_A a hl] + exact Finset.mem_sdiff.mpr ⟨hx,ho⟩ + · exact ⟨a,by simp [owners],by rw [mod_nonA a hl]; exact hx⟩ + +private theorem component_disjoint : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let mixedComponents (r : Nat) : Finset PeriodicSubtileIndex × + Finset PeriodicSubtileIndex × Finset PeriodicSubtileIndex := + (mixedBlock 0 0, match r with + | 0 => (mixedBlock 1 0, {⟨.B,1,1⟩}) + | 1 => (mixedBlock 0 1, {⟨.D,-1,0⟩}) + | 2 => (mixedBlock (-1) (-1), {⟨.F,0,-1⟩}) + | 3 => ({⟨.A,0,-1⟩}, {⟨.C,1,0⟩}) + | 4 => ({⟨.C,1,1⟩}, {⟨.E,0,1⟩}) + | _ => ({⟨.E,-1,0⟩}, {⟨.A,-1,-1⟩})) + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let paired (a : PeriodicSubtileIndex) : PeriodicSubtileIndex := ⟨.B,a.first,a.second⟩ + let componentIndices (r : Fin 6) (s : Fin 3) := + let c := mixedComponents r.val + if s = 0 then c.1 else if s = 1 then c.2.1 else c.2.2 + let owners (D : Finset PeriodicSubtileIndex) := + D ∪ (D.filter (fun a => a.label = .A)).image paired + let unionOf (D : Finset PeriodicSubtileIndex) : ProtoTile := + ⟨D.biUnion (fun a => (original a).cells),0⟩ + let component (r : Fin 6) (s : Fin 3) := unionOf (componentIndices r s) + (∀ (r : Fin 6), ∀ (s : Fin 3), ∀ (t : Fin 3), (s ≠ t) → (Disjoint (owners + (componentIndices r s)) (owners (componentIndices r t)))) → ((∀ (a : + PeriodicSubtileIndex), ∀ (x : LatticeCell), (x ∈ (original a).cells) → (∃ b ∈ owners + {a}, x ∈ (cert.modified.tile b).cells)) → ((∀ {D : Finset PeriodicSubtileIndex}, ∀ + {E : Finset PeriodicSubtileIndex}, (D ⊆ E) → (owners D ⊆ owners E)) → (∀ (r : Fin 6), + ∀ (s : Fin 3), ∀ (t : Fin 3), (s ≠ t) → (Disjoint (component r s).cells (component r + t).cells)))) ) := by + classical + intro q cfg C₀ T cert mixedBlock mixedComponents original paired componentIndices owners + unionOf component owner_certificate original_owner owners_mono r s t hst + apply Finset.disjoint_left.mpr + intro x hs ht + obtain ⟨a,ha,hxa⟩ := Finset.mem_biUnion.mp hs + obtain ⟨b,hb,hxb⟩ := Finset.mem_biUnion.mp ht + obtain ⟨u,hu,hxu⟩ := original_owner a x hxa + obtain ⟨v,hv,hxv⟩ := original_owner b x hxb + have hu' := owners_mono (Finset.singleton_subset_iff.mpr ha) hu + have hv' := owners_mono (Finset.singleton_subset_iff.mpr hb) hv + obtain ⟨c,hc,hunique⟩ := PeriodicTileIndexedMultiplicityOne cert.modified x + have huv : u = v := (hunique u hxu).trans (hunique v hxv).symm + exact Finset.disjoint_left.mp (owner_certificate r s t hst) hu' (huv.symm ▸ hv') + +private theorem edges_mono : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells ⊆ Y.cells) → (FootprintEdges X ⊆ + FootprintEdges Y) ) := by + classical + intro X Y h e he + obtain ⟨x,hx,hshape⟩ := he + exact ⟨x,h hx,hshape⟩ + +private theorem component_edges : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let mixedNeighbors (a : PeriodicSubtileIndex) : Finset PeriodicSubtileIndex := + let m := a.first + let n := a.second + match a.label with + | .A => {⟨.B,m,n⟩, ⟨.B,m,n+1⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m,n⟩, + ⟨.C,m+1,n+1⟩, ⟨.D,m,n⟩, ⟨.E,m,n+1⟩, ⟨.F,m,n⟩} + | .B => {⟨.A,m,n⟩, ⟨.A,m,n-1⟩, ⟨.A,m-1,n-1⟩, ⟨.C,m,n⟩, + ⟨.D,m-1,n-1⟩, ⟨.D,m,n⟩, ⟨.E,m,n⟩, ⟨.F,m,n-1⟩} + | .C => {⟨.A,m,n⟩, ⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.D,m-1,n⟩, + ⟨.E,m-1,n⟩, ⟨.F,m,n⟩} + | .D => {⟨.A,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, + ⟨.E,m,n⟩, ⟨.F,m+1,n⟩} + | .E => {⟨.A,m,n-1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩} + | .F => {⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.C,m,n⟩, ⟨.D,m-1,n⟩} + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), AllowedSubtileIncidence a b + ↔ b ∈ mixedNeighbors a) → ( + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let mixedComponents (r : Nat) : Finset PeriodicSubtileIndex × + Finset PeriodicSubtileIndex × Finset PeriodicSubtileIndex := + (mixedBlock 0 0, match r with + | 0 => (mixedBlock 1 0, {⟨.B,1,1⟩}) + | 1 => (mixedBlock 0 1, {⟨.D,-1,0⟩}) + | 2 => (mixedBlock (-1) (-1), {⟨.F,0,-1⟩}) + | 3 => ({⟨.A,0,-1⟩}, {⟨.C,1,0⟩}) + | 4 => ({⟨.C,1,1⟩}, {⟨.E,0,1⟩}) + | _ => ({⟨.E,-1,0⟩}, {⟨.A,-1,-1⟩})) + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + (∀ (a : PeriodicSubtileIndex), (cert.modified.tile a).cells ⊆ (original a).cells) → ( + let componentIndices (r : Fin 6) (s : Fin 3) := + let c := mixedComponents r.val + if s = 0 then c.1 else if s = 1 then c.2.1 else c.2.2 + let unionOf (D : Finset PeriodicSubtileIndex) : ProtoTile := + ⟨D.biUnion (fun a => (original a).cells),0⟩ + let component (r : Fin 6) (s : Fin 3) := unionOf (componentIndices r s) + (∀ (r : Fin 6), ∀ (s : Fin 3), ∀ (t : Fin 3), (s ≠ t) → (((componentIndices r s).biUnion + mixedNeighbors ∩ componentIndices r t).Nonempty)) → ((∀ (X : ProtoTile), ∀ (Y : + ProtoTile), (X.cells ⊆ Y.cells) → (FootprintEdges X ⊆ FootprintEdges Y)) → (∀ (r : + Fin 6), ∀ (s : Fin 3), ∀ (t : Fin 3), (s ≠ t) → ((FootprintEdges (component r s) ∩ + FootprintEdges (component r t)).Nonempty))))) ) := by + classical + intro q cfg C₀ T cert mixedNeighbors mixedNeighbors_iff mixedBlock mixedComponents original + mod_subset componentIndices unionOf component edge_certificate edges_mono r s t hst + obtain ⟨b,hb⟩ := edge_certificate r s t hst + obtain ⟨hb,hbt⟩ := Finset.mem_inter.mp hb + obtain ⟨a,ha,hab⟩ := Finset.mem_biUnion.mp hb + have hadj := (cert.modified_adjacency a b).2 ((mixedNeighbors_iff a b).2 hab) + obtain ⟨e,hea,heb⟩ := cert.modified.adjacent_has_common_edge a b hadj + refine ⟨e,edges_mono _ _ ?_ hea,edges_mono _ _ ?_ heb⟩ + · intro x hx + exact Finset.mem_biUnion.mpr ⟨a,ha,mod_subset a hx⟩ + · intro x hx + exact Finset.mem_biUnion.mpr ⟨b,hbt,mod_subset b hx⟩ + +private theorem literal_junctions : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let mixedComponents (r : Nat) : Finset PeriodicSubtileIndex × + Finset PeriodicSubtileIndex × Finset PeriodicSubtileIndex := + (mixedBlock 0 0, match r with + | 0 => (mixedBlock 1 0, {⟨.B,1,1⟩}) + | 1 => (mixedBlock 0 1, {⟨.D,-1,0⟩}) + | 2 => (mixedBlock (-1) (-1), {⟨.F,0,-1⟩}) + | 3 => ({⟨.A,0,-1⟩}, {⟨.C,1,0⟩}) + | 4 => ({⟨.C,1,1⟩}, {⟨.E,0,1⟩}) + | _ => ({⟨.E,-1,0⟩}, {⟨.A,-1,-1⟩})) + let mixedSelection (j : Fin 42) : Finset PeriodicSubtileIndex := + let c := mixedComponents (j.val / 7) + let k := j.val % 7 + 1 + (if k % 2 = 1 then c.1 else ∅) ∪ + (if k / 2 % 2 = 1 then c.2.1 else ∅) ∪ + (if k / 4 % 2 = 1 then c.2.2 else ∅) + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + ∀ (original_patches : ∀ j : Fin 42, LatticeTile (⟨(mixedSelection j).biUnion (fun a => + (original a).cells),0⟩ : ProtoTile)), + let J : ProtoTile → ProtoTile → ProtoTile → Prop := fun A B C => + ∃ AB BC CA ABC : ProtoTile, + LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ + Disjoint A.cells B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ + (∀ z : LatticeCell, z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ + (∀ z : LatticeCell, z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (∀ z : LatticeCell, z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) ∧ + (∀ z : LatticeCell, z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ + (FootprintEdges B ∩ FootprintEdges C).Nonempty ∧ + (FootprintEdges C ∩ FootprintEdges A).Nonempty + let componentIndices (r : Fin 6) (s : Fin 3) := + let c := mixedComponents r.val + if s = 0 then c.1 else if s = 1 then c.2.1 else c.2.2 + let unionOf (D : Finset PeriodicSubtileIndex) : ProtoTile := + ⟨D.biUnion (fun a => (original a).cells),0⟩ + let component (r : Fin 6) (s : Fin 3) := unionOf (componentIndices r s) + let selectionIndex (r : Fin 6) (s : Fin 7) : Fin 42 := ⟨r.val * 7 + s.val,by omega⟩ + (∀ (r : Fin 6), mixedSelection (selectionIndex r 0) = componentIndices r 0 ∧ + mixedSelection (selectionIndex r 1) = componentIndices r 1 ∧ mixedSelection + (selectionIndex r 3) = componentIndices r 2 ∧ mixedSelection (selectionIndex r 2) = + componentIndices r 0 ∪ componentIndices r 1 ∧ mixedSelection (selectionIndex r 5) = + componentIndices r 1 ∪ componentIndices r 2 ∧ mixedSelection (selectionIndex r 4) = + componentIndices r 2 ∪ componentIndices r 0 ∧ mixedSelection (selectionIndex r 6) = + componentIndices r 0 ∪ componentIndices r 1 ∪ componentIndices r 2) → ((∀ (r : Fin + 6), ∀ (s : Fin 3), ∀ (t : Fin 3), (s ≠ t) → (Disjoint (component r s).cells + (component r t).cells)) → ((∀ (r : Fin 6), ∀ (s : Fin 3), ∀ (t : Fin 3), (s ≠ t) → + ((FootprintEdges (component r s) ∩ FootprintEdges (component r t)).Nonempty)) → (∀ (r + : Fin 6), J (component r 0) (component r 1) (component r 2)))) ) := by + classical + intro q cfg C₀ T cert mixedBlock mixedComponents mixedSelection original original_patches J + componentIndices unionOf component selectionIndex selection_certificate component_disjoint + component_edges r + obtain ⟨h₀,h₁,h₂,h₀₁,h₁₂,h₂₀,h₀₁₂⟩ := selection_certificate r + have diskOf (s : Fin 7) := original_patches (selectionIndex r s) + refine ⟨unionOf (componentIndices r 0 ∪ componentIndices r 1), + unionOf (componentIndices r 1 ∪ componentIndices r 2), + unionOf (componentIndices r 2 ∪ componentIndices r 0), + unionOf (componentIndices r 0 ∪ componentIndices r 1 ∪ componentIndices r 2), + ?_,?_,?_,?_,?_,?_,?_, + component_disjoint r 0 1 (by decide),component_disjoint r 1 2 (by decide), + component_disjoint r 2 0 (by decide),?_,?_,?_,?_, + component_edges r 0 1 (by decide),component_edges r 1 2 (by decide), + component_edges r 2 0 (by decide)⟩ + · simpa only [h₀] using diskOf 0 + · simpa only [h₁] using diskOf 1 + · simpa only [h₂] using diskOf 3 + · simpa only [h₀₁] using diskOf 2 + · simpa only [h₁₂] using diskOf 5 + · simpa only [h₂₀] using diskOf 4 + · simpa only [h₀₁₂] using diskOf 6 + all_goals + intro z + simp only [unionOf,component,Finset.union_biUnion,Finset.mem_union,or_assoc] + +private theorem retarget : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells = Y.cells) → (LatticeTile X ↔ LatticeTile + Y)) → ( + let J : ProtoTile → ProtoTile → ProtoTile → Prop := fun A B C => + ∃ AB BC CA ABC : ProtoTile, + LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ + Disjoint A.cells B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ + (∀ z : LatticeCell, z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ + (∀ z : LatticeCell, z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (∀ z : LatticeCell, z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) ∧ + (∀ z : LatticeCell, z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ + (FootprintEdges B ∩ FootprintEdges C).Nonempty ∧ + (FootprintEdges C ∩ FootprintEdges A).Nonempty + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (A' : ProtoTile), ∀ (B' : + ProtoTile), ∀ (C' : ProtoTile), (A.cells = A'.cells) → ((B.cells = B'.cells) → + ((C.cells = C'.cells) → ((J A B C) → (J A' B' C'))))) ) := by + classical + intro cellDisk J A B C A' B' C' hA hB hC h + have eA : FootprintEdges A = FootprintEdges A' := by simp only [FootprintEdges,hA] + have eB : FootprintEdges B = FootprintEdges B' := by simp only [FootprintEdges,hB] + have eC : FootprintEdges C = FootprintEdges C' := by simp only [FootprintEdges,hC] + simpa only [J,hA,hB,hC,eA,eB,eC,cellDisk A A' hA,cellDisk B B' hB,cellDisk C C' hC] using h + +private theorem imageJ : + (by + classical + exact + let J : ProtoTile → ProtoTile → ProtoTile → Prop := fun A B C => + ∃ AB BC CA ABC : ProtoTile, + LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ + Disjoint A.cells B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ + (∀ z : LatticeCell, z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ + (∀ z : LatticeCell, z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (∀ z : LatticeCell, z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) ∧ + (∀ z : LatticeCell, z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ + (FootprintEdges B ∩ FootprintEdges C).Nonempty ∧ + (FootprintEdges C ∩ FootprintEdges A).Nonempty + ∀ (F : ProtoTile → ProtoTile), ∀ (f : GaussianInt → GaussianInt), ∀ (g : GaussianInt → + GaussianInt), (Function.Injective f) → ((∀ S, (F S).cells = S.cells.image f) → ((∀ S, + LatticeTile S → LatticeTile (F S)) → ((∀ S, FootprintEdges (F S) = + (fun e : Finset GaussianInt => e.image g) '' FootprintEdges S) → (∀ (A : ProtoTile), + ∀ (B : ProtoTile), ∀ (C : ProtoTile), (J A B C) → (J (F A) (F B) (F C)))))) ) := by + classical + intro J F f g hf cells disk edges A B C h + rcases h with ⟨AB,BC,CA,ABC,hA,hB,hC,hAB,hBC,hCA,hABC,dAB,dBC,dCA,uAB,uBC,uCA,uABC,eAB,eBC,eCA⟩ + have dj (S R : ProtoTile) (hd : Disjoint S.cells R.cells) : + Disjoint (F S).cells (F R).cells := by + apply Finset.disjoint_left.mpr + intro z hz hr + rw [cells] at hz hr + obtain ⟨x,hx,hxz⟩ := Finset.mem_image.mp hz + obtain ⟨y,hy,hyz⟩ := Finset.mem_image.mp hr + have hxy := hf (hxz.trans hyz.symm) + exact Finset.disjoint_left.mp hd hx (hxy.symm ▸ hy) + have pair (S R D : ProtoTile) + (hu : ∀ z, z ∈ D.cells ↔ z ∈ S.cells ∨ z ∈ R.cells) : + ∀ z, z ∈ (F D).cells ↔ z ∈ (F S).cells ∨ z ∈ (F R).cells := by + have he : D.cells = S.cells ∪ R.cells := by + ext z + simpa only [Finset.mem_union] using hu z + intro z + rw [cells,cells,cells,he,Finset.image_union,Finset.mem_union] + have triple : ∀ z, z ∈ (F ABC).cells ↔ + z ∈ (F A).cells ∨ z ∈ (F B).cells ∨ z ∈ (F C).cells := by + have he : ABC.cells = A.cells ∪ (B.cells ∪ C.cells) := by + ext z + simpa only [Finset.mem_union] using uABC z + intro z + rw [cells,cells,cells,cells,he,Finset.image_union,Finset.image_union] + simp only [Finset.mem_union] + have ed (S R : ProtoTile) + (he : (FootprintEdges S ∩ FootprintEdges R).Nonempty) : + (FootprintEdges (F S) ∩ FootprintEdges (F R)).Nonempty := by + obtain ⟨e,heS,heR⟩ := he + refine ⟨e.image g,?_,?_⟩ + · rw [edges] + exact ⟨e,heS,rfl⟩ + · rw [edges] + exact ⟨e,heR,rfl⟩ + exact ⟨F AB,F BC,F CA,F ABC,disk A hA,disk B hB,disk C hC, + disk AB hAB,disk BC hBC,disk CA hCA,disk ABC hABC, + dj A B dAB,dj B C dBC,dj C A dCA, + pair A B AB uAB,pair B C BC uBC,pair C A CA uCA,triple, + ed A B eAB,ed B C eBC,ed C A eCA⟩ + +private theorem quarterJ : + (by + classical + exact + let J : ProtoTile → ProtoTile → ProtoTile → Prop := fun A B C => + ∃ AB BC CA ABC : ProtoTile, + LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ + Disjoint A.cells B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ + (∀ z : LatticeCell, z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ + (∀ z : LatticeCell, z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (∀ z : LatticeCell, z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) ∧ + (∀ z : LatticeCell, z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ + (FootprintEdges B ∩ FootprintEdges C).Nonempty ∧ + (FootprintEdges C ∩ FootprintEdges A).Nonempty + (∀ (F : ProtoTile → ProtoTile), ∀ (f : GaussianInt → GaussianInt), ∀ (g : GaussianInt → + GaussianInt), (Function.Injective f) → ((∀ S, (F S).cells = S.cells.image f) → ((∀ S, + LatticeTile S → LatticeTile (F S)) → ((∀ S, FootprintEdges (F S) = (fun e : Finset + GaussianInt => e.image g) '' FootprintEdges S) → (∀ (A : ProtoTile), ∀ (B : + ProtoTile), ∀ (C : ProtoTile), (J A B C) → (J (F A) (F B) (F C))))))) → (∀ (A : + ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (J A B C) → (J (TileQuarterTurn A) + (TileQuarterTurn B) (TileQuarterTurn C))) ) := by + classical + intro J imageJ A B C h + refine imageJ TileQuarterTurn (fun x => GaussianQuarterTurn x - 1) GaussianQuarterTurn ?_ + (fun S => (TileQuarterTurnFormulas S).1) + (fun S hs => (TileDiskAreaCovariance S 0).2.1.mp hs) ?_ A B C h + · intro x y hxy + apply Zsqrtd.ext + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.im) hxy + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.re) hxy + · intro S + exact (TileQuarterTurnFormulas S).2.2.2.2.2.2.1 + +private theorem translateJ : + (by + classical + exact + let J : ProtoTile → ProtoTile → ProtoTile → Prop := fun A B C => + ∃ AB BC CA ABC : ProtoTile, + LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ + Disjoint A.cells B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ + (∀ z : LatticeCell, z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ + (∀ z : LatticeCell, z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (∀ z : LatticeCell, z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) ∧ + (∀ z : LatticeCell, z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ + (FootprintEdges B ∩ FootprintEdges C).Nonempty ∧ + (FootprintEdges C ∩ FootprintEdges A).Nonempty + (∀ (F : ProtoTile → ProtoTile), ∀ (f : GaussianInt → GaussianInt), ∀ (g : GaussianInt → + GaussianInt), (Function.Injective f) → ((∀ S, (F S).cells = S.cells.image f) → ((∀ S, + LatticeTile S → LatticeTile (F S)) → ((∀ S, FootprintEdges (F S) = (fun e : Finset + GaussianInt => e.image g) '' FootprintEdges S) → (∀ (A : ProtoTile), ∀ (B : + ProtoTile), ∀ (C : ProtoTile), (J A B C) → (J (F A) (F B) (F C))))))) → (∀ (u : + GaussianInt), ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (J A B C) → (J + (TileTranslation A u) (TileTranslation B u) (TileTranslation C u))) ) := by + classical + intro J imageJ u A B C h + exact imageJ (fun S => TileTranslation S u) (GaussianTranslation u) (GaussianTranslation u) + (fun x y hxy => add_right_cancel hxy) + (fun S => (TileTranslationFormulas S u).1) + (fun S hs => (TileDiskAreaCovariance S u).1.mp hs) + (fun S => (TileTranslationFormulas S u).2.2.2.2.2.2.1) A B C h + +private theorem back_turn : + (by + classical + exact + let back (c : GaussianInt) (S : ProtoTile) : ProtoTile := + TileTranslation (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn S))) + (GaussianQuarterTurn c) + let turn (c : GaussianInt) (S : ProtoTile) : ProtoTile := + TileTranslation (TileQuarterTurn S) c + ∀ (c : GaussianInt), ∀ (S : ProtoTile), back c (turn c S) = S ) := by + classical + intro back turn c S + cases S with + | mk D a => + dsimp only [back,turn,TileTranslation,TileQuarterTurn] + apply congrArg₂ ProtoTile.mk + · simp only [Finset.image_image] + have h : (fun x : GaussianInt => + GaussianTranslation (GaussianQuarterTurn c) + (GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn + (GaussianTranslation c (GaussianQuarterTurn x - 1)) - 1) - 1) - 1)) = id := by + funext x + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn,GaussianTranslation]; ring + simp only [Function.comp_def, h, Finset.image_id] + · apply Zsqrtd.ext <;> simp [GaussianQuarterTurn,GaussianTranslation] + +private theorem back_shift : + (by + classical + exact + let back (c : GaussianInt) (S : ProtoTile) : ProtoTile := + TileTranslation (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn S))) + (GaussianQuarterTurn c) + ∀ (c : GaussianInt), ∀ (d : GaussianInt), ∀ (a : GaussianInt), ∀ (S : ProtoTile), back c + (TileTranslation S a) = TileTranslation (back d S) (GaussianQuarterTurn (c-d-a)) ) := by + classical + intro back c d a S + dsimp only [back,TileTranslation,TileQuarterTurn] + apply congrArg₂ ProtoTile.mk + · simp only [Finset.image_image] + congr 1 + funext x + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn,GaussianTranslation] <;> ring + · apply Zsqrtd.ext <;> simp [GaussianQuarterTurn,GaussianTranslation] <;> ring + +private theorem back_congr : + (by + classical + exact + let back (c : GaussianInt) (S : ProtoTile) : ProtoTile := + TileTranslation (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn S))) + (GaussianQuarterTurn c) + ∀ (c : GaussianInt), ∀ (S : ProtoTile), ∀ (R : ProtoTile), (S.cells = R.cells) → ((back c + S).cells = (back c R).cells) ) := by + classical + intro back c S R hc + simp only [back,TileTranslation,TileQuarterTurn,hc] + +private theorem backJ : + (by + classical + exact + let J : ProtoTile → ProtoTile → ProtoTile → Prop := fun A B C => + ∃ AB BC CA ABC : ProtoTile, + LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ + Disjoint A.cells B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ + (∀ z : LatticeCell, z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ + (∀ z : LatticeCell, z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (∀ z : LatticeCell, z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) ∧ + (∀ z : LatticeCell, z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ + (FootprintEdges B ∩ FootprintEdges C).Nonempty ∧ + (FootprintEdges C ∩ FootprintEdges A).Nonempty + (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (J A B C) → (J (TileQuarterTurn + A) (TileQuarterTurn B) (TileQuarterTurn C))) → ((∀ (u : GaussianInt), ∀ (A : + ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (J A B C) → (J (TileTranslation A + u) (TileTranslation B u) (TileTranslation C u))) → ( + let back (c : GaussianInt) (S : ProtoTile) : ProtoTile := + TileTranslation (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn S))) + (GaussianQuarterTurn c) + ∀ (c : GaussianInt), ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (J A B C) → + (J (back c A) (back c B) (back c C)))) ) := by + classical + intro J quarterJ translateJ back c A B C h + exact translateJ (GaussianQuarterTurn c) _ _ _ (quarterJ _ _ _ (quarterJ _ _ _ (quarterJ _ _ + _ h))) + +private theorem back_centroid : + (by + classical + exact + let back (c : GaussianInt) (S : ProtoTile) : ProtoTile := + TileTranslation (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn S))) + (GaussianQuarterTurn c) + ∀ (c : GaussianInt), ∀ (S : ProtoTile), TileCentroid (back c S) = ((TileCentroid S).2 - + (c.im : Real),-(TileCentroid S).1 + (c.re : Real)) ) := by + classical + intro back c S + simp only [back,(TileTranslationFormulas _ _).2.2.2.2.1, + (TileQuarterTurnFormulas _).2.2.2.2.1] + apply Prod.ext <;> simp [GaussianQuarterTurn]; ring + +private theorem back_symmetric : + (by + classical + exact + let back (c : GaussianInt) (S : ProtoTile) : ProtoTile := + TileTranslation (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn S))) + (GaussianQuarterTurn c) + let turn (c : GaussianInt) (S : ProtoTile) : ProtoTile := + TileTranslation (TileQuarterTurn S) c + (∀ (c : GaussianInt), ∀ (S : ProtoTile), back c (turn c S) = S) → ((∀ (c : GaussianInt), + ∀ (S : ProtoTile), ∀ (R : ProtoTile), (S.cells = R.cells) → ((back c S).cells = (back + c R).cells)) → (∀ (c : GaussianInt), ∀ (S : ProtoTile), ((turn c S).cells = S.cells) + → ((back c S).cells = S.cells))) ) := by + classical + intro back turn back_turn back_congr c S hc + calc + (back c S).cells = (back c (turn c S)).cells := back_congr _ _ _ hc.symm + _ = S.cells := congrArg ProtoTile.cells (back_turn c S) + +private theorem outer_cells : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (x : LatticeCell), x ∈ T.cells ↔ x ∈ (cert.P 0 true).cells ∨ x ∈ (cert.P 0 + false).cells ∨ x ∈ (cert.P 1 true).cells ∨ x ∈ (cert.P 1 false).cells ∨ x ∈ (cert.P 2 + true).cells ∨ x ∈ (cert.P 2 false).cells ) := by + classical + intro q cfg C₀ T cert x + rw [cert.outer_union x] + constructor + · rintro ⟨i,s,hx⟩ + fin_cases i <;> cases s + · exact Or.inr (Or.inl hx) + · exact Or.inl hx + · exact Or.inr (Or.inr (Or.inr (Or.inl hx))) + · exact Or.inr (Or.inr (Or.inl hx)) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr hx)))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl hx)))) + · rintro (h | h | h | h | h | h) + · exact ⟨0,true,h⟩ + · exact ⟨0,false,h⟩ + · exact ⟨1,true,h⟩ + · exact ⟨1,false,h⟩ + · exact ⟨2,true,h⟩ + · exact ⟨2,false,h⟩ + +private theorem core_cells : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let unionOf (D : Finset PeriodicSubtileIndex) : ProtoTile := + ⟨D.biUnion (fun a => (original a).cells),0⟩ + (∀ (x : LatticeCell), x ∈ T.cells ↔ x ∈ (cert.P 0 true).cells ∨ x ∈ (cert.P 0 + false).cells ∨ x ∈ (cert.P 1 true).cells ∨ x ∈ (cert.P 1 false).cells ∨ x ∈ (cert.P 2 + true).cells ∨ x ∈ (cert.P 2 false).cells) → ((unionOf (mixedBlock 0 0)).cells = + T.cells) ) := by + classical + intro q cfg C₀ T cert mixedBlock original unionOf outer_cells + ext x + rw [outer_cells x] + simp [unionOf,mixedBlock,original,SubtileOccurrenceInterpretation, + TileTranslation,GaussianTranslation] + +private theorem component_zero : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let mixedComponents (r : Nat) : Finset PeriodicSubtileIndex × + Finset PeriodicSubtileIndex × Finset PeriodicSubtileIndex := + (mixedBlock 0 0, match r with + | 0 => (mixedBlock 1 0, {⟨.B,1,1⟩}) + | 1 => (mixedBlock 0 1, {⟨.D,-1,0⟩}) + | 2 => (mixedBlock (-1) (-1), {⟨.F,0,-1⟩}) + | 3 => ({⟨.A,0,-1⟩}, {⟨.C,1,0⟩}) + | 4 => ({⟨.C,1,1⟩}, {⟨.E,0,1⟩}) + | _ => ({⟨.E,-1,0⟩}, {⟨.A,-1,-1⟩})) + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let componentIndices (r : Fin 6) (s : Fin 3) := + let c := mixedComponents r.val + if s = 0 then c.1 else if s = 1 then c.2.1 else c.2.2 + let unionOf (D : Finset PeriodicSubtileIndex) : ProtoTile := + ⟨D.biUnion (fun a => (original a).cells),0⟩ + let component (r : Fin 6) (s : Fin 3) := unionOf (componentIndices r s) + ((unionOf (mixedBlock 0 0)).cells = T.cells) → (∀ (r : Fin 6), (component r 0).cells = + T.cells) ) := by + classical + intro q cfg C₀ T cert mixedBlock mixedComponents original componentIndices unionOf component + core_cells r + change (unionOf (mixedBlock 0 0)).cells = T.cells + exact core_cells + +private theorem shifted_core : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let unionOf (D : Finset PeriodicSubtileIndex) : ProtoTile := + ⟨D.biUnion (fun a => (original a).cells),0⟩ + ((unionOf (mixedBlock 0 0)).cells = T.cells) → (∀ (m : Int), ∀ (n : Int), (unionOf + (mixedBlock m n)).cells = (TileTranslation T ((m : GaussianInt) * cert.u + (n : + GaussianInt) * cert.v)).cells) ) := by + classical + intro q cfg C₀ T cert mixedBlock original unionOf core_cells m n + change (unionOf (mixedBlock m n)).cells = + T.cells.image (GaussianTranslation ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)) + rw [← core_cells] + have t0 : GaussianTranslation 0 = id := by + funext x + simp [GaussianTranslation] + simp only [unionOf,mixedBlock,original,SubtileOccurrenceInterpretation, + TileTranslation,Finset.biUnion_insert,Finset.singleton_biUnion, + Int.cast_zero,zero_mul,zero_add,t0,Finset.image_id,Finset.image_union] + +private theorem first_canonical : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let mixedComponents (r : Nat) : Finset PeriodicSubtileIndex × + Finset PeriodicSubtileIndex × Finset PeriodicSubtileIndex := + (mixedBlock 0 0, match r with + | 0 => (mixedBlock 1 0, {⟨.B,1,1⟩}) + | 1 => (mixedBlock 0 1, {⟨.D,-1,0⟩}) + | 2 => (mixedBlock (-1) (-1), {⟨.F,0,-1⟩}) + | 3 => ({⟨.A,0,-1⟩}, {⟨.C,1,0⟩}) + | 4 => ({⟨.C,1,1⟩}, {⟨.E,0,1⟩}) + | _ => ({⟨.E,-1,0⟩}, {⟨.A,-1,-1⟩})) + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let J : ProtoTile → ProtoTile → ProtoTile → Prop := fun A B C => + ∃ AB BC CA ABC : ProtoTile, + LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ + Disjoint A.cells B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ + (∀ z : LatticeCell, z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ + (∀ z : LatticeCell, z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (∀ z : LatticeCell, z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) ∧ + (∀ z : LatticeCell, z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ + (FootprintEdges B ∩ FootprintEdges C).Nonempty ∧ + (FootprintEdges C ∩ FootprintEdges A).Nonempty + let componentIndices (r : Fin 6) (s : Fin 3) := + let c := mixedComponents r.val + if s = 0 then c.1 else if s = 1 then c.2.1 else c.2.2 + let unionOf (D : Finset PeriodicSubtileIndex) : ProtoTile := + ⟨D.biUnion (fun a => (original a).cells),0⟩ + let component (r : Fin 6) (s : Fin 3) := unionOf (componentIndices r s) + (∀ (r : Fin 6), J (component r 0) (component r 1) (component r 2)) → ((∀ (A : ProtoTile), + ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (A' : ProtoTile), ∀ (B' : ProtoTile), ∀ (C' : + ProtoTile), (A.cells = A'.cells) → ((B.cells = B'.cells) → ((C.cells = C'.cells) → + ((J A B C) → (J A' B' C'))))) → ((∀ (r : Fin 6), (component r 0).cells = T.cells) → + ((∀ (m : Int), ∀ (n : Int), (unionOf (mixedBlock m n)).cells = (TileTranslation T ((m + : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells) → ( + let firstPeriod (i : Fin 3) : GaussianInt := match i.val with + | 0 => cert.u + | 1 => cert.v + | _ => -cert.u-cert.v + let firstShift (i : Fin 3) : GaussianInt := match i.val with + | 0 => cert.u+cert.v + | 1 => -cert.u + | _ => -cert.v + let firstParent (i : Fin 3) := TileTranslation (cert.P i false) (firstShift i) + ∀ (i : Fin 3), J T (TileTranslation T (firstPeriod i)) (firstParent i))))) ) := by + classical + intro q cfg C₀ T cert mixedBlock mixedComponents original J componentIndices unionOf component + literal_junctions retarget component_zero shifted_core firstPeriod firstShift firstParent i + let r : Fin 6 := ⟨i.val,by omega⟩ + refine retarget (component r 0) (component r 1) (component r 2) + T (TileTranslation T (firstPeriod i)) (firstParent i) + (component_zero r) ?_ ?_ (literal_junctions r) + · fin_cases i + · change (unionOf (mixedBlock 1 0)).cells = (TileTranslation T cert.u).cells + simpa only [Int.cast_one,Int.cast_zero,one_mul,zero_mul,add_zero] using shifted_core 1 0 + · change (unionOf (mixedBlock 0 1)).cells = (TileTranslation T cert.v).cells + simpa only [Int.cast_one,Int.cast_zero,one_mul,zero_mul,zero_add] using shifted_core 0 1 + · change (unionOf (mixedBlock (-1) (-1))).cells = (TileTranslation T (-cert.u-cert.v)).cells + simpa only [Int.cast_neg,Int.cast_one,neg_one_mul,sub_eq_add_neg] using shifted_core (-1) + (-1) + · fin_cases i + · change (unionOf {⟨.B,1,1⟩}).cells = (TileTranslation (cert.P 0 false) (cert.u+cert.v)).cells + simp only [unionOf,Finset.singleton_biUnion,original,SubtileOccurrenceInterpretation, + TileTranslation,Int.cast_one,one_mul] + · change (unionOf {⟨.D,-1,0⟩}).cells = (TileTranslation (cert.P 1 false) (-cert.u)).cells + simp only [unionOf,Finset.singleton_biUnion,original,SubtileOccurrenceInterpretation, + TileTranslation,Int.cast_neg,Int.cast_one,neg_one_mul,Int.cast_zero,zero_mul,add_zero] + · change (unionOf {⟨.F,0,-1⟩}).cells = (TileTranslation (cert.P 2 false) (-cert.v)).cells + simp only [unionOf,Finset.singleton_biUnion,original,SubtileOccurrenceInterpretation, + TileTranslation,Int.cast_neg,Int.cast_one,neg_one_mul,Int.cast_zero,zero_mul,zero_add] + +private theorem all_centroids : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let firstPeriod (i : Fin 3) : GaussianInt := match i.val with + | 0 => cert.u + | 1 => cert.v + | _ => -cert.u-cert.v + let firstShift (i : Fin 3) : GaussianInt := match i.val with + | 0 => cert.u+cert.v + | 1 => -cert.u + | _ => -cert.v + let firstParent (i : Fin 3) := TileTranslation (cert.P i false) (firstShift i) + let plusRepresentative (i : Fin 3) : ProtoTile := match i.val with + | 0 => TileTranslation (cert.P 0 true) (-cert.v) + | 1 => TileTranslation (cert.P 1 true) (cert.u + cert.v) + | _ => TileTranslation (cert.P 2 true) (-cert.u) + let minusRepresentative (i : Fin 3) : ProtoTile := match i.val with + | 0 => TileTranslation (cert.P 1 true) cert.u + | 1 => TileTranslation (cert.P 2 true) cert.v + | _ => TileTranslation (cert.P 0 true) (-cert.u - cert.v) + (∀ i : Fin 3, TileCentroid (plusRepresentative i) - TileCentroid T = (1/2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + GaussianRealPoint + (BandVectors.1 (q 0) (q i.succ)))) ∧ (∀ i : Fin 3, TileCentroid (minusRepresentative + i) - TileCentroid T = (1/2 : Real) • (GaussianRealPoint (BandVectors.1 (q + ((i+1).succ)) (q 0)) - GaussianRealPoint (BandVectors.1 (q 0) (q ((i+1).succ))))) ∧ + (∀ i : Fin 3, TileCentroid (firstParent i) - TileCentroid T = (1/2 : Real) • + (GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) - GaussianRealPoint + (BandVectors.1 (q i.succ) (q 0)))) ∧ (∀ i : Fin 3, GaussianRealPoint (firstPeriod i) + = GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) ) := by + classical + intro q cfg C₀ T cert firstPeriod firstShift firstParent plusRepresentative minusRepresentative + have laws := VectorRecursionLaws q cfg.proper.1 + have laws₁ := VectorRecursionLaws ![q 0,q 2,q 3,q 1] (SemiProperQuadruple.rotate cfg.proper.1) + have laws₂ := VectorRecursionLaws ![q 0,q 3,q 1,q 2] + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate cfg.proper.1)) + have sumV := congrArg GaussianRealPoint laws.1 + have v₁ := congrArg GaussianRealPoint laws.2.2.1 + have v₂ := congrArg GaussianRealPoint laws₁.2.2.1 + have v₃ := congrArg GaussianRealPoint laws₂.2.2.1 + change GaussianRealPoint (BandVectors.1 (q 2) (q 0)) = + GaussianRealPoint (BandVectors.1 (q 2) (q 1) - + (⟨0,1⟩ : GaussianInt) * BandVectors.1 (q 3) (q 2)) at v₂ + change GaussianRealPoint (BandVectors.1 (q 3) (q 0)) = + GaussianRealPoint (BandVectors.1 (q 3) (q 2) - + (⟨0,1⟩ : GaussianInt) * BandVectors.1 (q 1) (q 3)) at v₃ + have u := congrArg GaussianRealPoint (cert.period_u.trans ((laws.2.2.2.2 cfg.proper 0).1)) + have v := congrArg GaussianRealPoint (cert.period_v.trans ((laws.2.2.2.2 cfg.proper 1).1)) + have f₁ := congrArg GaussianRealPoint ((laws.2.2.2.2 cfg.proper 0).1) + have f₂ := congrArg GaussianRealPoint ((laws.2.2.2.2 cfg.proper 1).1) + have f₃ := congrArg GaussianRealPoint ((laws.2.2.2.2 cfg.proper 2).1) + have c₁ := (cert.outer_occurrence 0 true).2.2 + have c₂ := (cert.outer_occurrence 1 true).2.2 + have c₃ := (cert.outer_occurrence 2 true).2.2 + have d₁ := (cert.outer_occurrence 0 false).2.2 + have d₂ := (cert.outer_occurrence 1 false).2.2 + have d₃ := (cert.outer_occurrence 2 false).2.2 + norm_num [Prod.ext_iff,GaussianRealPoint,Fin.succ,Fin.add,Fin.add_def,Fin.ofNat,Matrix.cons_val] + at sumV v₁ v₂ v₃ u v f₁ f₂ f₃ c₁ c₂ c₃ d₁ d₂ d₃ + have fin2 : (⟨2,by decide⟩ : Fin 4) = 2 := rfl + have fin3 : (⟨3,by decide⟩ : Fin 4) = 3 := rfl + have fin2_3 : (⟨2,by decide⟩ : Fin 3) = 2 := rfl + refine ⟨?_,?_,?_,?_⟩ + all_goals intro i; fin_cases i + all_goals dsimp only [plusRepresentative,minusRepresentative,firstPeriod,firstParent,firstShift] + all_goals try simp only [(TileTranslationFormulas _ _).2.2.2.2.1] + all_goals apply Prod.ext <;> + norm_num + [Prod.ext_iff,GaussianRealPoint,Fin.succ,Fin.add,Fin.add_def,Fin.ofNat,Matrix.cons_val] + · linear_combination (-1 / 2 : Real) * sumV.1 + (1 / 2 : Real) * sumV.2 + (-1 / 2 : Real) * + v₁.1 + (1 / 2 : Real) * v₁.2 + v₂.2 + (-1 : Real) * v.1 + (-1 / 2 : Real) * f₁.1 + c₁.1 + · linear_combination (-1 / 2 : Real) * sumV.1 + (-1 / 2 : Real) * sumV.2 + (-1 / 2 : Real) * + v₁.1 + (-1 / 2 : Real) * v₁.2 + (-1 : Real) * v₂.1 + (-1 : Real) * v.2 + (-1 / 2 : Real) + * f₁.2 + c₁.2 + · linear_combination (1 / 2 : Real) * sumV.1 + (-1 / 2 : Real) * sumV.2 + (-1 : Real) * v₁.2 + + (-1 / 2 : Real) * v₂.1 + (-1 / 2 : Real) * v₂.2 + u.1 + v.1 + (-1 / 2 : Real) * f₂.1 + + c₂.1 + · linear_combination (1 / 2 : Real) * sumV.1 + (1 / 2 : Real) * sumV.2 + v₁.1 + (1 / 2 : + Real) * v₂.1 + (-1 / 2 : Real) * v₂.2 + u.2 + v.2 + (-1 / 2 : Real) * f₂.2 + c₂.2 + · linear_combination (-1 / 2 : Real) * sumV.1 + (1 / 2 : Real) * sumV.2 + v₁.2 + (-1 / 2 : + Real) * v₃.1 + (1 / 2 : Real) * v₃.2 + (-1 : Real) * u.1 + (-1 / 2 : Real) * f₃.1 + c₃.1 + · linear_combination (-1 / 2 : Real) * sumV.1 + (-1 / 2 : Real) * sumV.2 + (-1 : Real) * v₁.1 + + (-1 / 2 : Real) * v₃.1 + (-1 / 2 : Real) * v₃.2 + (-1 : Real) * u.2 + (-1 / 2 : Real) * + f₃.2 + c₃.2 + · linear_combination (1 / 2 : Real) * sumV.1 + (-1 / 2 : Real) * sumV.2 + (-1 : Real) * v₁.2 + + (-1 / 2 : Real) * v₂.1 + (-1 / 2 : Real) * v₂.2 + u.1 + (1 / 2 : Real) * f₂.1 + c₂.1 + · linear_combination (1 / 2 : Real) * sumV.1 + (1 / 2 : Real) * sumV.2 + v₁.1 + (1 / 2 : + Real) * v₂.1 + (-1 / 2 : Real) * v₂.2 + u.2 + (1 / 2 : Real) * f₂.2 + c₂.2 + · linear_combination (1 / 2 : Real) * sumV.1 + (-1 / 2 : Real) * sumV.2 + (-1 : Real) * v₂.2 + + (-1 / 2 : Real) * v₃.1 + (-1 / 2 : Real) * v₃.2 + v.1 + (1 / 2 : Real) * f₃.1 + c₃.1 + · linear_combination (1 / 2 : Real) * sumV.1 + (1 / 2 : Real) * sumV.2 + v₂.1 + (1 / 2 : + Real) * v₃.1 + (-1 / 2 : Real) * v₃.2 + v.2 + (1 / 2 : Real) * f₃.2 + c₃.2 + · linear_combination (-1 / 2 : Real) * sumV.1 + (1 / 2 : Real) * sumV.2 + (-1 / 2 : Real) * + v₁.1 + (1 / 2 : Real) * v₁.2 + v₂.2 + (-1 : Real) * u.1 + (-1 : Real) * v.1 + (1 / 2 : + Real) * f₁.1 + c₁.1 + · linear_combination (-1 / 2 : Real) * sumV.1 + (-1 / 2 : Real) * sumV.2 + (-1 / 2 : Real) * + v₁.1 + (-1 / 2 : Real) * v₁.2 + (-1 : Real) * v₂.1 + (-1 : Real) * u.2 + (-1 : Real) * + v.2 + (1 / 2 : Real) * f₁.2 + c₁.2 + · linear_combination (1 / 2 : Real) * sumV.1 + (-1 / 2 : Real) * sumV.2 + (1 / 2 : Real) * + v₁.1 + (-1 / 2 : Real) * v₁.2 + (-1 : Real) * v₂.2 + u.1 + v.1 + (-1 / 2 : Real) * f₁.1 + + d₁.1 + · linear_combination (1 / 2 : Real) * sumV.1 + (1 / 2 : Real) * sumV.2 + (1 / 2 : Real) * + v₁.1 + (1 / 2 : Real) * v₁.2 + v₂.1 + u.2 + v.2 + (-1 / 2 : Real) * f₁.2 + d₁.2 + · linear_combination (-1 / 2 : Real) * sumV.1 + (1 / 2 : Real) * sumV.2 + v₁.2 + (1 / 2 : + Real) * v₂.1 + (1 / 2 : Real) * v₂.2 + (-1 : Real) * u.1 + (-1 / 2 : Real) * f₂.1 + d₂.1 + · linear_combination (-1 / 2 : Real) * sumV.1 + (-1 / 2 : Real) * sumV.2 + (-1 : Real) * v₁.1 + + (-1 / 2 : Real) * v₂.1 + (1 / 2 : Real) * v₂.2 + (-1 : Real) * u.2 + (-1 / 2 : Real) * + f₂.2 + d₂.2 + · linear_combination (-1 / 2 : Real) * sumV.1 + (1 / 2 : Real) * sumV.2 + v₂.2 + (1 / 2 : + Real) * v₃.1 + (1 / 2 : Real) * v₃.2 + (-1 : Real) * v.1 + (-1 / 2 : Real) * f₃.1 + d₃.1 + · linear_combination (-1 / 2 : Real) * sumV.1 + (-1 / 2 : Real) * sumV.2 + (-1 : Real) * v₂.1 + + (-1 / 2 : Real) * v₃.1 + (1 / 2 : Real) * v₃.2 + (-1 : Real) * v.2 + (-1 / 2 : Real) * + f₃.2 + d₃.2 + · linear_combination u.1 + (-1 : Real) * f₁.1 + · linear_combination u.2 + (-1 : Real) * f₁.2 + · linear_combination v.1 + (-1 : Real) * f₂.1 + · linear_combination v.2 + (-1 : Real) * f₂.2 + · linear_combination (-1 : Real) * sumV.1 + sumV.2 + v₁.2 + v₂.2 + v₃.2 + (-1 : Real) * u.1 + + (-1 : Real) * v.1 + (-1 : Real) * f₃.1 + · linear_combination (-1 : Real) * sumV.1 + (-1 : Real) * sumV.2 + (-1 : Real) * v₁.1 + (-1 : + Real) * v₂.1 + (-1 : Real) * v₃.1 + (-1 : Real) * u.2 + (-1 : Real) * v.2 + (-1 : Real) * + f₃.2 + +private theorem second_canonical : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let mixedComponents (r : Nat) : Finset PeriodicSubtileIndex × + Finset PeriodicSubtileIndex × Finset PeriodicSubtileIndex := + (mixedBlock 0 0, match r with + | 0 => (mixedBlock 1 0, {⟨.B,1,1⟩}) + | 1 => (mixedBlock 0 1, {⟨.D,-1,0⟩}) + | 2 => (mixedBlock (-1) (-1), {⟨.F,0,-1⟩}) + | 3 => ({⟨.A,0,-1⟩}, {⟨.C,1,0⟩}) + | 4 => ({⟨.C,1,1⟩}, {⟨.E,0,1⟩}) + | _ => ({⟨.E,-1,0⟩}, {⟨.A,-1,-1⟩})) + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let J : ProtoTile → ProtoTile → ProtoTile → Prop := fun A B C => + ∃ AB BC CA ABC : ProtoTile, + LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ + Disjoint A.cells B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ + (∀ z : LatticeCell, z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ + (∀ z : LatticeCell, z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (∀ z : LatticeCell, z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) ∧ + (∀ z : LatticeCell, z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ + (FootprintEdges B ∩ FootprintEdges C).Nonempty ∧ + (FootprintEdges C ∩ FootprintEdges A).Nonempty + let componentIndices (r : Fin 6) (s : Fin 3) := + let c := mixedComponents r.val + if s = 0 then c.1 else if s = 1 then c.2.1 else c.2.2 + let unionOf (D : Finset PeriodicSubtileIndex) : ProtoTile := + ⟨D.biUnion (fun a => (original a).cells),0⟩ + let component (r : Fin 6) (s : Fin 3) := unionOf (componentIndices r s) + (∀ (r : Fin 6), J (component r 0) (component r 1) (component r 2)) → ((∀ (A : ProtoTile), + ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (A' : ProtoTile), ∀ (B' : ProtoTile), ∀ (C' : + ProtoTile), (A.cells = A'.cells) → ((B.cells = B'.cells) → ((C.cells = C'.cells) → + ((J A B C) → (J A' B' C'))))) → ((∀ (r : Fin 6), (component r 0).cells = T.cells) → ( + let plusRepresentative (i : Fin 3) : ProtoTile := match i.val with + | 0 => TileTranslation (cert.P 0 true) (-cert.v) + | 1 => TileTranslation (cert.P 1 true) (cert.u + cert.v) + | _ => TileTranslation (cert.P 2 true) (-cert.u) + let minusRepresentative (i : Fin 3) : ProtoTile := match i.val with + | 0 => TileTranslation (cert.P 1 true) cert.u + | 1 => TileTranslation (cert.P 2 true) cert.v + | _ => TileTranslation (cert.P 0 true) (-cert.u - cert.v) + ∀ (i : Fin 3), J T (plusRepresentative i) (minusRepresentative i)))) ) := by + classical + intro q cfg C₀ T cert mixedBlock mixedComponents original J componentIndices unionOf component + literal_junctions retarget component_zero plusRepresentative minusRepresentative i + let r : Fin 6 := ⟨i.val+3,by omega⟩ + refine retarget (component r 0) (component r 1) (component r 2) + T (plusRepresentative i) (minusRepresentative i) (component_zero r) ?_ ?_ + (literal_junctions r) + · fin_cases i + · change (unionOf {⟨.A,0,-1⟩}).cells = (TileTranslation (cert.P 0 true) (-cert.v)).cells + simp only [unionOf,Finset.singleton_biUnion,original,SubtileOccurrenceInterpretation, + TileTranslation,Int.cast_neg,Int.cast_one,neg_one_mul,Int.cast_zero,zero_mul,zero_add] + · change (unionOf {⟨.C,1,1⟩}).cells = (TileTranslation (cert.P 1 true) (cert.u+cert.v)).cells + simp only [unionOf,Finset.singleton_biUnion,original,SubtileOccurrenceInterpretation, + TileTranslation,Int.cast_one,one_mul] + · change (unionOf {⟨.E,-1,0⟩}).cells = (TileTranslation (cert.P 2 true) (-cert.u)).cells + simp only [unionOf,Finset.singleton_biUnion,original,SubtileOccurrenceInterpretation, + TileTranslation,Int.cast_neg,Int.cast_one,neg_one_mul,Int.cast_zero,zero_mul,add_zero] + · fin_cases i + · change (unionOf {⟨.C,1,0⟩}).cells = (TileTranslation (cert.P 1 true) cert.u).cells + simp only [unionOf,Finset.singleton_biUnion,original,SubtileOccurrenceInterpretation, + TileTranslation,Int.cast_one,one_mul,Int.cast_zero,zero_mul,add_zero] + · change (unionOf {⟨.E,0,1⟩}).cells = (TileTranslation (cert.P 2 true) cert.v).cells + simp only [unionOf,Finset.singleton_biUnion,original,SubtileOccurrenceInterpretation, + TileTranslation,Int.cast_one,one_mul,Int.cast_zero,zero_mul,zero_add] + · change (unionOf {⟨.A,-1,-1⟩}).cells = (TileTranslation (cert.P 0 true) + (-cert.u-cert.v)).cells + simp only [unionOf,Finset.singleton_biUnion,original,SubtileOccurrenceInterpretation, + TileTranslation,Int.cast_neg,Int.cast_one,neg_one_mul,sub_eq_add_neg] + +private theorem symmetric_back_proxy : + (by + classical + exact + let back (c : GaussianInt) (S : ProtoTile) : ProtoTile := + TileTranslation (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn S))) + (GaussianQuarterTurn c) + let turn (c : GaussianInt) (S : ProtoTile) : ProtoTile := + TileTranslation (TileQuarterTurn S) c + (∀ (c : GaussianInt), ∀ (d : GaussianInt), ∀ (a : GaussianInt), ∀ (S : ProtoTile), back c + (TileTranslation S a) = TileTranslation (back d S) (GaussianQuarterTurn (c-d-a))) → + ((∀ (c : GaussianInt), ∀ (S : ProtoTile), ((turn c S).cells = S.cells) → ((back c + S).cells = S.cells)) → (∀ (C : CircleCoordinates), ∀ (S : ProtoTile), (BandPrototile + C S) → ((LatticeTile S) → ((QuarterTurnSymmetric S) → (∀ (c : GaussianInt), ∀ (a : + GaussianInt), ∃ R : ProtoTile, BandPrototile C R ∧ (back c (TileTranslation S + a)).cells = R.cells ∧ TileCentroid R = TileCentroid (back c (TileTranslation S + a))))))) ) := by + classical + intro back turn back_shift back_symmetric C S hB hS hQ c a + obtain ⟨d,hd,hcells,hanchor,hfoot,hcent⟩ := + QuarterTurnSymmetricCenteredTransport S hQ + let R := TileTranslation S (GaussianQuarterTurn (c-d-a)) + have hc : (back c (TileTranslation S a)).cells = R.cells := by + rw [back_shift c d a S] + simp only [R,TileTranslation,back_symmetric d S hcells] + have hn : R.cells.Nonempty := by + exact Finset.image_nonempty.mpr (LatticeTileGridStructure S hS).1.1 + have ha : (back c (TileTranslation S a)).cells = ∅ → + (back c (TileTranslation S a)).anchor = R.anchor := by + intro he + rw [← hc,he] at hn + exact False.elim (Finset.not_nonempty_empty hn) + exact ⟨R,BandPrototileTranslation C S _ hB,hc, + (ProtoTileObservableExtensionality _ _ hc ha).2.2.2.2.symm⟩ + +private theorem centered_back_displacement : + (by + classical + exact + let back (c : GaussianInt) (S : ProtoTile) : ProtoTile := + TileTranslation (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn S))) + (GaussianQuarterTurn c) + (∀ (c : GaussianInt), ∀ (S : ProtoTile), TileCentroid (back c S) = ((TileCentroid S).2 - + (c.im : Real),-(TileCentroid S).1 + (c.re : Real))) → (∀ (S : ProtoTile), ∀ (T : + ProtoTile), ∀ (c : GaussianInt), ∀ (w : GaussianInt), ∀ (v : GaussianInt), + (GaussianRealPoint c = + ((TileCentroid T).1+(TileCentroid T).2,(TileCentroid T).2-(TileCentroid T).1)) → ((v + = (⟨0,1⟩ : GaussianInt) * w) → ((TileCentroid S - TileCentroid T = + (1/2 : Real) • (GaussianRealPoint v - GaussianRealPoint w)) → (TileCentroid (back c + S) - TileCentroid T = (1/2 : Real) • (GaussianRealPoint w + GaussianRealPoint + v))))) ) := by + classical + intro back back_centroid S T c w v hc hv hd + have hvp : GaussianRealPoint v = + (-(GaussianRealPoint w).2,(GaussianRealPoint w).1) := by + rw [hv] + ext <;> simp [GaussianRealPoint] + change ((c.re : Real),(c.im : Real)) = + ((TileCentroid T).1+(TileCentroid T).2,(TileCentroid T).2-(TileCentroid T).1) at hc + norm_num [Prod.ext_iff,GaussianRealPoint] at hc hd hvp + rw [back_centroid] + apply Prod.ext <;> norm_num [GaussianRealPoint] <;> + linarith only [hc.1,hc.2,hd.1,hd.2,hvp.1,hvp.2] + +private theorem point_injective : + (by + classical + exact + Function.Injective GaussianRealPoint ) := by + classical + intro x y h + apply Zsqrtd.ext + · have hr := congrArg Prod.fst h + change (x.re : Real) = (y.re : Real) at hr + exact_mod_cast hr + · have hi := congrArg Prod.snd h + change (x.im : Real) = (y.im : Real) at hi + exact_mod_cast hi + +private theorem first_requested : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (QuarterTurnSymmetric T) → ( + let J : ProtoTile → ProtoTile → ProtoTile → Prop := fun A B C => + ∃ AB BC CA ABC : ProtoTile, + LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ + Disjoint A.cells B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ + (∀ z : LatticeCell, z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ + (∀ z : LatticeCell, z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (∀ z : LatticeCell, z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) ∧ + (∀ z : LatticeCell, z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ + (FootprintEdges B ∩ FootprintEdges C).Nonempty ∧ + (FootprintEdges C ∩ FootprintEdges A).Nonempty + (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (A' : ProtoTile), ∀ (B' : + ProtoTile), ∀ (C' : ProtoTile), (A.cells = A'.cells) → ((B.cells = B'.cells) → + ((C.cells = C'.cells) → ((J A B C) → (J A' B' C'))))) → ( + let back (c : GaussianInt) (S : ProtoTile) : ProtoTile := + TileTranslation (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn S))) + (GaussianQuarterTurn c) + let turn (c : GaussianInt) (S : ProtoTile) : ProtoTile := + TileTranslation (TileQuarterTurn S) c + (∀ (c : GaussianInt), ∀ (d : GaussianInt), ∀ (a : GaussianInt), ∀ (S : ProtoTile), back c + (TileTranslation S a) = TileTranslation (back d S) (GaussianQuarterTurn (c-d-a))) → + ((∀ (c : GaussianInt), ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (J A + B C) → (J (back c A) (back c B) (back c C))) → ((∀ (c : GaussianInt), ∀ (S : + ProtoTile), ((turn c S).cells = S.cells) → ((back c S).cells = S.cells)) → ( + let firstPeriod (i : Fin 3) : GaussianInt := match i.val with + | 0 => cert.u + | 1 => cert.v + | _ => -cert.u-cert.v + let firstShift (i : Fin 3) : GaussianInt := match i.val with + | 0 => cert.u+cert.v + | 1 => -cert.u + | _ => -cert.v + let firstParent (i : Fin 3) := TileTranslation (cert.P i false) (firstShift i) + (∀ (i : Fin 3), J T (TileTranslation T (firstPeriod i)) (firstParent i)) → ( + let plusRepresentative (i : Fin 3) : ProtoTile := match i.val with + | 0 => TileTranslation (cert.P 0 true) (-cert.v) + | 1 => TileTranslation (cert.P 1 true) (cert.u + cert.v) + | _ => TileTranslation (cert.P 2 true) (-cert.u) + let minusRepresentative (i : Fin 3) : ProtoTile := match i.val with + | 0 => TileTranslation (cert.P 1 true) cert.u + | 1 => TileTranslation (cert.P 2 true) cert.v + | _ => TileTranslation (cert.P 0 true) (-cert.u - cert.v) + (∀ (i : Fin 3), BandPrototile (q i.succ) (plusRepresentative i)) → (((∀ i : Fin 3, + TileCentroid (plusRepresentative i) - TileCentroid T = (1/2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + GaussianRealPoint + (BandVectors.1 (q 0) (q i.succ)))) ∧ (∀ i : Fin 3, TileCentroid (minusRepresentative + i) - TileCentroid T = (1/2 : Real) • (GaussianRealPoint (BandVectors.1 (q + ((i+1).succ)) (q 0)) - GaussianRealPoint (BandVectors.1 (q 0) (q ((i+1).succ))))) ∧ + (∀ i : Fin 3, TileCentroid (firstParent i) - TileCentroid T = (1/2 : Real) • + (GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) - GaussianRealPoint + (BandVectors.1 (q i.succ) (q 0)))) ∧ (∀ i : Fin 3, GaussianRealPoint (firstPeriod i) + = GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))) → ((∀ (C : CircleCoordinates), + ∀ (S : ProtoTile), (BandPrototile C S) → ((LatticeTile S) → ((QuarterTurnSymmetric S) + → (∀ (c : GaussianInt), ∀ (a : GaussianInt), ∃ R : ProtoTile, BandPrototile C R ∧ + (back c (TileTranslation S a)).cells = R.cells ∧ TileCentroid R = TileCentroid (back + c (TileTranslation S a)))))) → ((∀ (S : ProtoTile), ∀ (T : ProtoTile), ∀ (c : + GaussianInt), ∀ (w : GaussianInt), ∀ (v : GaussianInt), (GaussianRealPoint c = + ((TileCentroid T).1+(TileCentroid T).2,(TileCentroid T).2-(TileCentroid T).1)) → ((v + = (⟨0,1⟩ : GaussianInt) * w) → ((TileCentroid S - TileCentroid T = (1/2 : Real) • + (GaussianRealPoint v - GaussianRealPoint w)) → (TileCentroid (back c S) - + TileCentroid T = (1/2 : Real) • (GaussianRealPoint w + GaussianRealPoint v))))) → + ((Function.Injective GaussianRealPoint) → (∀ (i : Fin 3), J T (TileTranslation T + (BandVectors.1 (q i.succ) (q 0))) (plusRepresentative i)))))))))))) ) := by + classical + intro q cfg C₀ T cert hsym J retarget back turn back_shift backJ back_symmetric firstPeriod + firstShift firstParent first_canonical plusRepresentative minusRepresentative plus_band + all_centroids symmetric_back_proxy centered_back_displacement point_injective i + obtain ⟨c,hc,hcT,haT,hfT,htT⟩ := QuarterTurnSymmetricCenteredTransport T hsym + have hroot : (back c T).cells = T.cells := back_symmetric c T hcT + have hp : firstPeriod i = BandVectors.1 (q 0) (q i.succ) := + point_injective (all_centroids.2.2.2 i) + have hf := (VectorRecursionLaws q cfg.proper.1).2.2.2.2 cfg.proper i + have hr : GaussianQuarterTurn (-(firstPeriod i)) = + BandVectors.1 (q i.succ) (q 0) := by + rw [hp,hf.1] + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + have hn : (back c (TileTranslation T (firstPeriod i))).cells = + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))).cells := by + rw [back_shift c c (firstPeriod i) T] + simp only [sub_self,zero_sub,hr,TileTranslation,hroot] + obtain ⟨R,hR,hcells,hcent⟩ := symmetric_back_proxy (q i.succ) (cert.P i false) + (cert.outer_occurrence i false).1 (cert.parent_lattice i false) + (cert.parent_quarter_turn i false) c (firstShift i) + have hdisp : TileCentroid R - TileCentroid T = + (1/2 : Real) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) := by + rw [hcent] + exact centered_back_displacement (firstParent i) T c _ _ hc hf.1 + (all_centroids.2.2.1 i) + have hRP := BandPrototileCentroidUnique _ _ _ hR (plus_band i) + (sub_left_injective (hdisp.trans (all_centroids.1 i).symm)) + exact retarget _ _ _ T (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) + (plusRepresentative i) hroot hn (hcells.trans hRP.1) + (backJ c _ _ _ (first_canonical i)) + +end MixedAggregateGeometry + +theorem P1BandOrderedGeneralMixedAggregateJunctionData + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) + (hsym : QuarterTurnSymmetric T) : + let junctionData : ProtoTile → ProtoTile → ProtoTile → Prop := + fun A B C ↦ ∃ AB BC CA ABC : ProtoTile, + LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ + LatticeTile ABC ∧ + Disjoint A.cells B.cells ∧ Disjoint B.cells C.cells ∧ + Disjoint C.cells A.cells ∧ + (∀ z : LatticeCell, + z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ + (∀ z : LatticeCell, + z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (∀ z : LatticeCell, + z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) ∧ + (∀ z : LatticeCell, + z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ + (FootprintEdges B ∩ FootprintEdges C).Nonempty ∧ + (FootprintEdges C ∩ FootprintEdges A).Nonempty + (∀ (i : Fin 3) (U : ProtoTile), BandPrototile (q i.succ) U → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + junctionData T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U) ∧ + (∀ (i : Fin 3) (U V : ProtoTile), BandPrototile (q i.succ) U → + BandPrototile (q ((i + 1).succ)) V → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ)))) → + junctionData T U V) := by +-- BODY + let mixedNeighbors (a : PeriodicSubtileIndex) : Finset PeriodicSubtileIndex := + let m := a.first + let n := a.second + match a.label with + | .A => {⟨.B,m,n⟩, ⟨.B,m,n+1⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m,n⟩, + ⟨.C,m+1,n+1⟩, ⟨.D,m,n⟩, ⟨.E,m,n+1⟩, ⟨.F,m,n⟩} + | .B => {⟨.A,m,n⟩, ⟨.A,m,n-1⟩, ⟨.A,m-1,n-1⟩, ⟨.C,m,n⟩, + ⟨.D,m-1,n-1⟩, ⟨.D,m,n⟩, ⟨.E,m,n⟩, ⟨.F,m,n-1⟩} + | .C => {⟨.A,m,n⟩, ⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.D,m-1,n⟩, + ⟨.E,m-1,n⟩, ⟨.F,m,n⟩} + | .D => {⟨.A,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, + ⟨.E,m,n⟩, ⟨.F,m+1,n⟩} + | .E => {⟨.A,m,n-1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩} + | .F => {⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.C,m,n⟩, ⟨.D,m-1,n⟩} + have mixedNeighbors_iff := MixedAggregateGeometry.mixedNeighbors_iff + (MixedAggregateGeometry.mixedNeighbors_symmetric) + let mixedDecode (k : Nat) : PeriodicSubtileIndex := + ⟨match k % 6 with | 0 => .A | 1 => .B | 2 => .C | 3 => .D | 4 => .E | _ => .F, + (k / 6 / 7 : Int) - 3, (k / 6 % 7 : Int) - 3⟩ + let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := + {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} + let mixedComponents (r : Nat) : Finset PeriodicSubtileIndex × + Finset PeriodicSubtileIndex × Finset PeriodicSubtileIndex := + (mixedBlock 0 0, match r with + | 0 => (mixedBlock 1 0, {⟨.B,1,1⟩}) + | 1 => (mixedBlock 0 1, {⟨.D,-1,0⟩}) + | 2 => (mixedBlock (-1) (-1), {⟨.F,0,-1⟩}) + | 3 => ({⟨.A,0,-1⟩}, {⟨.C,1,0⟩}) + | 4 => ({⟨.C,1,1⟩}, {⟨.E,0,1⟩}) + | _ => ({⟨.E,-1,0⟩}, {⟨.A,-1,-1⟩})) + let mixedSelection (j : Fin 42) : Finset PeriodicSubtileIndex := + let c := mixedComponents (j.val / 7) + let k := j.val % 7 + 1 + (if k % 2 = 1 then c.1 else ∅) ∪ + (if k / 2 % 2 = 1 then c.2.1 else ∅) ∪ + (if k / 4 % 2 = 1 then c.2.2 else ∅) + let mixedTreeVertices (tree : List (Nat × Nat)) (S : Finset PeriodicSubtileIndex) : + Finset PeriodicSubtileIndex := + tree.foldl (fun S e => insert (mixedDecode e.1) S) S + let mixedTreeCheck (D : Finset PeriodicSubtileIndex) (inside : Bool) + (es : List (Nat × Nat)) (S : Finset PeriodicSubtileIndex) : Bool := + es.foldr (fun (a,b) next S => + decide ((if inside then mixedDecode a ∈ D else mixedDecode a ∉ D) ∧ + mixedDecode b ∈ S ∧ mixedDecode b ∈ mixedNeighbors (mixedDecode a)) && + next (insert (mixedDecode a) S)) (fun _ => true) S + let mixedInTrees : List (List (Nat × Nat)) := MixedAggregateGeometry.incomingCertificateTrees + let mixedOutTrees : List (List (Nat × Nat)) := MixedAggregateGeometry.outgoingCertificateTrees + let mixedInHubs : List Nat := + [144, 186, 144, 193, 144, 186, 144, 144, 150, 144, 105, 144, 150, 144, 144, 96, 144, + 143, 144, 96, 144, 144, 138, 144, 188, 144, 138, 144, 144, 194, 144, 154, 144, 194, + 144, 144, 106, 144, 96, 144, 106, 144] + let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let offset (a : PeriodicSubtileIndex) : GaussianInt := + (a.first : GaussianInt) * cert.u + (a.second : GaussianInt) * cert.v + let precursor (a : PeriodicSubtileIndex) := TileTranslation cert.O (offset a) + let paired (a : PeriodicSubtileIndex) : PeriodicSubtileIndex := ⟨.B,a.first,a.second⟩ + have cellDisk := MixedAggregateGeometry.cellDisk + have translation_complement := MixedAggregateGeometry.translation_complement + have mod_nonA := MixedAggregateGeometry.mod_nonA q cfg C₀ T cert + have mod_A := MixedAggregateGeometry.mod_A q cfg C₀ T cert translation_complement + have precursor_subset_B := MixedAggregateGeometry.precursor_subset_B q cfg C₀ T cert + (MixedAggregateGeometry.hOB q cfg C₀ T cert) + have mod_subset := MixedAggregateGeometry.mod_subset q cfg C₀ T cert mod_nonA mod_A + let exception (j : Fin 42) : Option PeriodicSubtileIndex := + if j.val / 7 = 3 ∧ (j.val % 7 + 1) / 2 % 2 = 1 then some ⟨.A,0,-1⟩ else + if j.val / 7 = 5 ∧ (j.val % 7 + 1) / 4 % 2 = 1 then some ⟨.A,-1,-1⟩ else none + let J : ProtoTile → ProtoTile → ProtoTile → Prop := fun A B C => + ∃ AB BC CA ABC : ProtoTile, + LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ + Disjoint A.cells B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ + (∀ z : LatticeCell, z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ + (∀ z : LatticeCell, z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (∀ z : LatticeCell, z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) ∧ + (∀ z : LatticeCell, z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) ∧ + (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ + (FootprintEdges B ∩ FootprintEdges C).Nonempty ∧ + (FootprintEdges C ∩ FootprintEdges A).Nonempty + let componentIndices (r : Fin 6) (s : Fin 3) := + let c := mixedComponents r.val + if s = 0 then c.1 else if s = 1 then c.2.1 else c.2.2 + let owners (D : Finset PeriodicSubtileIndex) := + D ∪ (D.filter (fun a => a.label = .A)).image paired + let unionOf (D : Finset PeriodicSubtileIndex) : ProtoTile := + ⟨D.biUnion (fun a => (original a).cells),0⟩ + let component (r : Fin 6) (s : Fin 3) := unionOf (componentIndices r s) + let selectionIndex (r : Fin 6) (s : Fin 7) : Fin 42 := ⟨r.val * 7 + s.val,by omega⟩ + have owners_mono {D E : Finset PeriodicSubtileIndex} (h : D ⊆ E) : owners D ⊆ owners E := by + exact Finset.union_subset_union h (Finset.image_mono _ (Finset.filter_subset_filter _ h)) + have literal_junctions := MixedAggregateGeometry.literal_junctions q cfg C₀ T cert + (MixedAggregateGeometry.original_patches q cfg C₀ T cert + (MixedAggregateGeometry.mixed_patches mixedNeighbors_iff + (MixedAggregateGeometry.mixed_reach_walk) (MixedAggregateGeometry.mixed_boundary_detour + (MixedAggregateGeometry.mixed_walk_reach)) (MixedAggregateGeometry.mixedTree_sound) + (MixedAggregateGeometry.mixed_certificates)) (MixedAggregateGeometry.restore_mixed) + cellDisk translation_complement (MixedAggregateGeometry.original_lattice q cfg C₀ T cert) + mod_nonA mod_A (MixedAggregateGeometry.precursor_subset_A q cfg C₀ T cert + (MixedAggregateGeometry.hOA q cfg C₀ T cert)) precursor_subset_B mod_subset + (MixedAggregateGeometry.exception_certificate) (MixedAggregateGeometry.shared_vertex)) + (MixedAggregateGeometry.selection_certificate) (MixedAggregateGeometry.component_disjoint q + cfg C₀ T cert (MixedAggregateGeometry.owner_certificate) + (MixedAggregateGeometry.original_owner q cfg C₀ T cert mod_nonA mod_A precursor_subset_B) + owners_mono) (MixedAggregateGeometry.component_edges q cfg C₀ T cert mixedNeighbors_iff + mod_subset (MixedAggregateGeometry.edge_certificate) (MixedAggregateGeometry.edges_mono)) + have retarget := MixedAggregateGeometry.retarget cellDisk + have imageJ := MixedAggregateGeometry.imageJ + let back (c : GaussianInt) (S : ProtoTile) : ProtoTile := + TileTranslation (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn S))) (GaussianQuarterTurn c) + let turn (c : GaussianInt) (S : ProtoTile) : ProtoTile := + TileTranslation (TileQuarterTurn S) c + have back_shift := MixedAggregateGeometry.back_shift + have back_symmetric := MixedAggregateGeometry.back_symmetric (MixedAggregateGeometry.back_turn) + (MixedAggregateGeometry.back_congr) + have core_cells := MixedAggregateGeometry.core_cells q cfg C₀ T cert + (MixedAggregateGeometry.outer_cells q cfg C₀ T cert) + have component_zero := MixedAggregateGeometry.component_zero q cfg C₀ T cert core_cells + let firstPeriod (i : Fin 3) : GaussianInt := match i.val with + | 0 => cert.u + | 1 => cert.v + | _ => -cert.u-cert.v + let firstShift (i : Fin 3) : GaussianInt := match i.val with + | 0 => cert.u+cert.v + | 1 => -cert.u + | _ => -cert.v + let firstParent (i : Fin 3) := TileTranslation (cert.P i false) (firstShift i) + let plusRepresentative (i : Fin 3) : ProtoTile := match i.val with + | 0 => TileTranslation (cert.P 0 true) (-cert.v) + | 1 => TileTranslation (cert.P 1 true) (cert.u + cert.v) + | _ => TileTranslation (cert.P 2 true) (-cert.u) + let minusRepresentative (i : Fin 3) : ProtoTile := match i.val with + | 0 => TileTranslation (cert.P 1 true) cert.u + | 1 => TileTranslation (cert.P 2 true) cert.v + | _ => TileTranslation (cert.P 0 true) (-cert.u - cert.v) + have plus_band (i : Fin 3) : BandPrototile (q i.succ) (plusRepresentative i) := by + fin_cases i <;> exact BandPrototileTranslation _ _ _ (cert.outer_occurrence _ true).1 + have minus_band (i : Fin 3) : BandPrototile (q ((i+1).succ)) (minusRepresentative i) := by + fin_cases i <;> exact BandPrototileTranslation _ _ _ (cert.outer_occurrence _ true).1 + have all_centroids := MixedAggregateGeometry.all_centroids q cfg C₀ T cert + constructor + · intro i U hU hUc + have hPU := BandPrototileCentroidUnique _ _ _ (plus_band i) hU + (sub_left_injective ((all_centroids.1 i).trans hUc.symm)) + exact retarget T (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) + (plusRepresentative i) T (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U + rfl rfl hPU.1 ((MixedAggregateGeometry.first_requested q cfg C₀ T cert hsym retarget + back_shift (MixedAggregateGeometry.backJ (MixedAggregateGeometry.quarterJ imageJ) + (MixedAggregateGeometry.translateJ imageJ)) back_symmetric + (MixedAggregateGeometry.first_canonical q cfg C₀ T cert literal_junctions retarget + component_zero (MixedAggregateGeometry.shifted_core q cfg C₀ T cert core_cells)) + plus_band all_centroids (MixedAggregateGeometry.symmetric_back_proxy back_shift + back_symmetric) (MixedAggregateGeometry.centered_back_displacement + (MixedAggregateGeometry.back_centroid)) (MixedAggregateGeometry.point_injective)) i) + · intro i U V hU hV hUc hVc + have hPU := BandPrototileCentroidUnique _ _ _ (plus_band i) hU + (sub_left_injective ((all_centroids.1 i).trans hUc.symm)) + have hPV := BandPrototileCentroidUnique _ _ _ (minus_band i) hV + (sub_left_injective ((all_centroids.2.1 i).trans hVc.symm)) + exact retarget T (plusRepresentative i) (minusRepresentative i) T U V rfl hPU.1 hPV.1 + ((MixedAggregateGeometry.second_canonical q cfg C₀ T cert literal_junctions retarget + component_zero) i) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean new file mode 100644 index 0000000000..be815b2c2a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean @@ -0,0 +1,2208 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.CellSupportedFootprintVertices +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleRetargetMiddle +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleSwapLast +public import LeanPool.ApollonianSuperharmonic.FiniteConnectedCellSetNoCheckerboard +public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch +public import LeanPool.ApollonianSuperharmonic.FinitePatchTopology +public import LeanPool.ApollonianSuperharmonic.FinitePolyominoDiskCriterion +public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileComplementGridConnected +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.LatticeTileThreeDiskJunction +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.P1BandOrderedGeneralMixedAggregateJunctionData +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEndpointPairUnique +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P1BandOrderedGeneralMixedAggregatePairedEndpoints] + +/-! +# P1BandOrderedGeneralMixedAggregatePairedEndpoints + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PairedEndpointGeometry + +private theorem incoming : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ( + let junctionData := fun (A B C : ProtoTile) => ∃ (AB : ProtoTile) (BC : ProtoTile) (CA : + ProtoTile) (ABC : ProtoTile), LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ Disjoint A.cells + B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ (∀ (z : LatticeCell), + z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ (∀ (z : LatticeCell), z ∈ BC.cells ↔ z ∈ + B.cells ∨ z ∈ C.cells) ∧ (∀ (z : LatticeCell), z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ + A.cells) ∧ (∀ (z : LatticeCell), z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ + C.cells) ∧ (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ (FootprintEdges B ∩ + FootprintEdges C).Nonempty ∧ (FootprintEdges C ∩ FootprintEdges A).Nonempty; (∀ (i : + Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile (q i.succ) U → TileCentroid U - + TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) + → junctionData T (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) + U) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q + i.succ) U → BandPrototile (q (i + (1 : Fin (3 : ℕ))).succ) V → TileCentroid U - + TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) + → TileCentroid V - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → + junctionData T U V) → (∀ (i : Fin 3), ∀ (U : ProtoTile), (BandPrototile (q i.succ) U) + → ((TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))) → (Nonempty + (ExactTileInterfaceTriple T (TileTranslation T (BandVectors.1 (q i.succ) (q + 0))) U)))) ) := by + classical + intro q T junctions i U hU hcent + obtain ⟨AB, BC, CA, ABC, hA, hB, hC, hAB, hBC, hCA, hABC, + hdAB, hdBC, hdCA, huAB, huBC, huCA, huABC, heAB, heBC, heCA⟩ := + junctions.1 i U hU hcent + exact LatticeTileThreeDiskJunction T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U AB BC CA ABC + hA hB hC hAB hBC hCA hABC hdAB hdBC hdCA + huAB huBC huCA huABC heAB heBC heCA + +private theorem evenT5 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ( + let junctionData := fun (A B C : ProtoTile) => ∃ (AB : ProtoTile) (BC : ProtoTile) (CA : + ProtoTile) (ABC : ProtoTile), LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ Disjoint A.cells + B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ (∀ (z : LatticeCell), + z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ (∀ (z : LatticeCell), z ∈ BC.cells ↔ z ∈ + B.cells ∨ z ∈ C.cells) ∧ (∀ (z : LatticeCell), z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ + A.cells) ∧ (∀ (z : LatticeCell), z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ + C.cells) ∧ (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ (FootprintEdges B ∩ + FootprintEdges C).Nonempty ∧ (FootprintEdges C ∩ FootprintEdges A).Nonempty; (∀ (i : + Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile (q i.succ) U → TileCentroid U - + TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) + → junctionData T (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) + U) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q + i.succ) U → BandPrototile (q (i + (1 : Fin (3 : ℕ))).succ) V → TileCentroid U - + TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) + → TileCentroid V - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → + junctionData T U V) → (∀ (i : Fin 3), ∀ (U : ProtoTile), ∀ (V : ProtoTile), + (BandPrototile (q i.succ) U) → ((BandPrototile (q ((i + 1).succ)) V) → ((TileCentroid + U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))) → ((TileCentroid V - + TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ))))) → (Nonempty + (ExactTileInterfaceTriple T U V)))))) ) := by + classical + intro q T junctions i U V hU hV hcentU hcentV + obtain ⟨AB, BC, CA, ABC, hA, hB, hC, hAB, hBC, hCA, hABC, + hdAB, hdBC, hdCA, huAB, huBC, huCA, huABC, heAB, heBC, heCA⟩ := + junctions.2 i U V hU hV hcentU hcentV + exact LatticeTileThreeDiskJunction T U V AB BC CA ABC + hA hB hC hAB hBC hCA hABC hdAB hdBC hdCA + huAB huBC huCA huABC heAB heBC heCA + +private theorem endpointRelations : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (R : ProtoTile), ∀ (L : + ProtoTile), ∀ (rightData : ExactTileInterfaceTriple T R U), ∀ (incomingData : + ExactTileInterfaceTriple T L U), ∀ (t5Data : ExactTileInterfaceTriple T U V), + (rightData.point = t5Data.point) → ((incomingData.point ≠ t5Data.point) → + (incomingData.otherCA = t5Data.point ∧ rightData.otherCA = incomingData.point ∧ + t5Data.otherAB = incomingData.point)) ) := by + classical + intro T U V R L rightData incomingData t5Data hpoint hne + have endpoint_ne {W : Set GaussianInt} {E : Set (Finset GaussianInt)} + {x y : GaussianInt} (h : SimpleGridPathBetween W E x y) : x ≠ y := by + rcases h with ⟨p, hn, hl, hh, ht, _⟩ + intro heq + have hp : p ≠ [] := by + intro hp + subst p + simp at hl + have hx : p.head hp = x := by + simpa [List.head?_eq_some_head hp] using hh + have hy : p.getLast hp = y := by + simpa [List.getLast?_eq_some_getLast hp] using ht + obtain ⟨z, hz⟩ := (List.Nodup.head_eq_getLast_iff hp hn).mp + (hx.trans (heq.trans hy.symm)) + subst p + simp at hl + have ht5 : SimpleGridPathBetween + (FootprintVertices U ∩ FootprintVertices T) + (FootprintEdges U ∩ FootprintEdges T) t5Data.point t5Data.otherAB := by + simpa [Set.inter_comm] using t5Data.pathAB + have hLI := SimpleGridPathEndpointPairUnique incomingData.pathCA ht5 + have hRI := SimpleGridPathEndpointPairUnique rightData.pathCA incomingData.pathCA + have hotherL : incomingData.otherCA = t5Data.point := by + have hm : t5Data.point ∈ + ({incomingData.point, incomingData.otherCA} : Finset GaussianInt) := by + rw [hLI] + simp + rcases (show t5Data.point = incomingData.point ∨ + t5Data.point = incomingData.otherCA from by simpa using hm) with h | h + · exact (hne h.symm).elim + · exact h.symm + have hotherR : rightData.otherCA = incomingData.point := by + have hm : incomingData.point ∈ + ({rightData.point, rightData.otherCA} : Finset GaussianInt) := by + rw [hRI] + simp + rcases (show incomingData.point = rightData.point ∨ + incomingData.point = rightData.otherCA from by simpa using hm) with h | h + · exact (hne (h.trans hpoint)).elim + · exact h.symm + have hother5 : t5Data.otherAB = incomingData.point := by + have hm : t5Data.otherAB ∈ + ({incomingData.point, incomingData.otherCA} : Finset GaussianInt) := by + rw [hLI] + simp + rcases (show t5Data.otherAB = incomingData.point ∨ + t5Data.otherAB = incomingData.otherCA from by simpa using hm) with h | h + · exact h + · exact (endpoint_ne ht5 (hotherL.symm.trans h.symm)).elim + exact ⟨hotherL, hotherR, hother5⟩ + +private theorem literalData : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let pLit (i : Fin 3) := TileTranslation (cert.P i true) + (if i = 0 then -cert.v else if i = 1 then cert.u + cert.v else -cert.u) + let qLit (i : Fin 3) := TileTranslation (cert.P (i + 1) true) + (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) + ∀ (i : Fin 3), BandPrototile (q i.succ) (pLit i) ∧ BandPrototile (q ((i + 1).succ)) (qLit + i) ∧ TileCentroid (pLit i) - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint + (BandVectors.1 (q i.succ) (q 0)) + GaussianRealPoint (BandVectors.1 (q 0) (q + i.succ))) ∧ TileCentroid (qLit i) - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - GaussianRealPoint + (BandVectors.1 (q 0) (q ((i + 1).succ)))) ) := by + classical + intro q cfg C₀ T cert pLit qLit i + have laws := VectorRecursionLaws q cfg.proper.1 + have laws1 := VectorRecursionLaws _ (SemiProperQuadruple.rotate cfg.proper.1) + have laws2 := VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate cfg.proper.1)) + have superbasis := laws.1 + have w1 := laws.2.2.1 + have w2 := laws1.2.2.1 + have w3 := laws2.2.2.1 + dsimp at w2 w3 + have flip := laws.2.2.2.2 cfg.proper + dsimp only [pLit, qLit] + refine ⟨BandPrototileTranslation _ _ _ (cert.outer_occurrence i true).1, + BandPrototileTranslation _ _ _ (cert.outer_occurrence (i + 1) true).1, ?_, ?_⟩ + all_goals + rw [(TileTranslationFormulas _ _).2.2.2.2.1] + have h0 := (cert.outer_occurrence 0 true).2.2 + have h1 := (cert.outer_occurrence 1 true).2.2 + have h2 := (cert.outer_occurrence 2 true).2.2 + have f0 := (flip 0).1 + have f1 := (flip 1).1 + have f2 := (flip 2).1 + fin_cases i + all_goals + simp only [Fin.reduceAdd, Fin.reduceSucc, ↓reduceIte, one_smul] at h0 h1 h2 + simp only [Fin.reduceSucc] at f0 f1 f2 + simp? [cert.period_u, cert.period_v, f0, f1, f2, w1, w2, w3] + have re := congrArg (fun z : GaussianInt => z.re) superbasis + have im := congrArg (fun z : GaussianInt => z.im) superbasis + have r0 := congrArg Prod.fst h0 + have s0 := congrArg Prod.snd h0 + have r1 := congrArg Prod.fst h1 + have s1 := congrArg Prod.snd h1 + have r2 := congrArg Prod.fst h2 + have s2 := congrArg Prod.snd h2 + simp? [GaussianRealPoint, Prod.smul_mk, smul_eq_mul] at r0 s0 r1 s1 r2 s2 ⊢ + simp? at re im + have rr : ((BandVectors.1 (q 3) (q 2)).re : Real) + + ((BandVectors.1 (q 1) (q 3)).re : Real) + + ((BandVectors.1 (q 2) (q 1)).re : Real) = 0 := by exact_mod_cast re + have ri : ((BandVectors.1 (q 3) (q 2)).im : Real) + + ((BandVectors.1 (q 1) (q 3)).im : Real) + + ((BandVectors.1 (q 2) (q 1)).im : Real) = 0 := by exact_mod_cast im + simp at r0 s0 r1 s1 r2 s2 rr ri + ext <;> simp <;> linarith only [r0, s0, r1, s1, r2, s2, rr, ri] + +private theorem translated_sym : + (by + classical + exact + ∀ (Y : ProtoTile), ∀ (a : GaussianInt), (QuarterTurnSymmetric Y) → (QuarterTurnSymmetric + (TileTranslation Y a)) ) := by + classical + intro Y a hY p + rw [(TileTranslationFormulas Y a).2.2.2.1, + (TileTranslationFormulas Y a).2.2.2.2.1] + constructor + · rintro ⟨z, hz, rfl⟩ + refine ⟨((TileCentroid Y).1 - (z.2 - (TileCentroid Y).2), + (TileCentroid Y).2 + (z.1 - (TileCentroid Y).1)), (hY z).mp hz, ?_⟩ + ext <;> dsimp <;> ring + · rintro ⟨z, hz, heq⟩ + let z' : Real × Real := (p.1 - (a.re : Int), p.2 - (a.im : Int)) + have hturn : ((TileCentroid Y).1 - (z'.2 - (TileCentroid Y).2), + (TileCentroid Y).2 + (z'.1 - (TileCentroid Y).1)) = z := by + have hre := congrArg Prod.fst heq + have him := congrArg Prod.snd heq + ext <;> dsimp [z'] at hre him ⊢ <;> linarith + refine ⟨z', (hY z').mpr ?_, ?_⟩ + · change ((TileCentroid Y).1 - (z'.2 - (TileCentroid Y).2), + (TileCentroid Y).2 + (z'.1 - (TileCentroid Y).1)) ∈ TileRealization Y + rw [hturn] + exact hz + · ext <;> dsimp [z'] <;> ring + +private theorem centeredProxy : + (by + classical + exact + (∀ (Y : ProtoTile), ∀ (a : GaussianInt), (QuarterTurnSymmetric Y) → (QuarterTurnSymmetric + (TileTranslation Y a))) → (∀ (C : CircleCoordinates), ∀ (Y : ProtoTile), ∀ (g : + GaussianInt), (BandPrototile C Y) → ((QuarterTurnSymmetric Y) → (∃ Ysharp : + ProtoTile, BandPrototile C Ysharp ∧ QuarterTurnSymmetric Ysharp ∧ (TileTranslation + (TileQuarterTurn Y) g).cells = Ysharp.cells ∧ ((TileTranslation (TileQuarterTurn Y) + g).cells = ∅ → (TileTranslation (TileQuarterTurn Y) g).anchor = Ysharp.anchor) ∧ + TileCentroid Ysharp = (-((TileCentroid Y).2) + (g.re : Int), (TileCentroid Y).1 + + (g.im : Int))))) ) := by + classical + intro translated_sym C Y g hY hYsym + obtain ⟨d, hd, hcells, hanchor, hvertices, hcent⟩ := + QuarterTurnSymmetricCenteredTransport Y hYsym + let Ysharp := TileTranslation Y (g - d) + have hcomp : TileTranslation (TileTranslation (TileQuarterTurn Y) d) (g - d) = + TileTranslation (TileQuarterTurn Y) g := by + simp only [TileTranslation, ProtoTile.mk.injEq] + constructor + · rw [Finset.image_image] + congr 1 + funext z + dsimp [Function.comp_def, GaussianTranslation] + abel + · dsimp [GaussianTranslation] + abel + have hc : (TileTranslation (TileQuarterTurn Y) g).cells = Ysharp.cells := by + rw [← hcomp] + change _ = Y.cells.image (GaussianTranslation (g - d)) + rw [(TileTranslationFormulas _ _).1, hcells] + have ha : (TileTranslation (TileQuarterTurn Y) g).cells = ∅ → + (TileTranslation (TileQuarterTurn Y) g).anchor = Ysharp.anchor := by + intro he + have heY : Y.cells = ∅ := by + rw [hc] at he + exact (TileTranslationFormulas Y (g - d)).2.2.1.mp he + rw [← hcomp] + change GaussianTranslation (g - d) + (TileTranslation (TileQuarterTurn Y) d).anchor = + GaussianTranslation (g - d) Y.anchor + rw [hanchor heY] + have hobs := ProtoTileObservableExtensionality _ Ysharp hc ha + refine ⟨Ysharp, BandPrototileTranslation C Y (g - d) hY, + translated_sym Y (g - d) hYsym, hc, ha, ?_⟩ + rw [← hobs.2.2.2.2, (TileTranslationFormulas _ g).2.2.2.2.1, + (TileQuarterTurnFormulas Y).2.2.2.2.1] + +private theorem halfTurnProxy : + (by + classical + exact + (∀ (C : CircleCoordinates), ∀ (Y : ProtoTile), ∀ (g : GaussianInt), (BandPrototile C Y) → + ((QuarterTurnSymmetric Y) → (∃ Ysharp : ProtoTile, BandPrototile C Ysharp ∧ + QuarterTurnSymmetric Ysharp ∧ (TileTranslation (TileQuarterTurn Y) g).cells = + Ysharp.cells ∧ ((TileTranslation (TileQuarterTurn Y) g).cells = ∅ → (TileTranslation + (TileQuarterTurn Y) g).anchor = Ysharp.anchor) ∧ TileCentroid Ysharp = + (-((TileCentroid Y).2) + (g.re : Int), (TileCentroid Y).1 + (g.im : Int))))) → (∀ (C + : CircleCoordinates), ∀ (Y : ProtoTile), ∀ (g : GaussianInt), (BandPrototile C Y) → + ((QuarterTurnSymmetric Y) → (∃ Zsharp : ProtoTile, BandPrototile C Zsharp ∧ + QuarterTurnSymmetric Zsharp ∧ (TileTranslation (TileQuarterTurn (TileTranslation + (TileQuarterTurn Y) g)) g).cells = Zsharp.cells ∧ ((TileTranslation (TileQuarterTurn + (TileTranslation (TileQuarterTurn Y) g)) g).cells = ∅ → (TileTranslation + (TileQuarterTurn (TileTranslation (TileQuarterTurn Y) g)) g).anchor = Zsharp.anchor) + ∧ TileCentroid Zsharp = (-((TileCentroid Y).1) + (g.re : Int) - (g.im : Int), + -((TileCentroid Y).2) + (g.re : Int) + (g.im : Int))))) ) := by + classical + intro centeredProxy C Y g hY hYsym + let R (W : ProtoTile) := TileTranslation (TileQuarterTurn W) g + obtain ⟨Ysharp, hband1, hsym1, hc1, ha1, hcent1⟩ := + centeredProxy C Y g hY hYsym + obtain ⟨Zsharp, hband2, hsym2, hc2, ha2, hcent2⟩ := + centeredProxy C Ysharp g hband1 hsym1 + have hcMap : (R (R Y)).cells = (R Ysharp).cells := by + change (TileTranslation (TileQuarterTurn (R Y)) g).cells = _ + rw [(TileTranslationFormulas _ _).1, (TileQuarterTurnFormulas _).1] + change ((R Y).cells.image _).image _ = _ + rw [hc1] + rfl + have haMap : (R (R Y)).cells = ∅ → (R (R Y)).anchor = (R Ysharp).anchor := by + intro he + have he' : (R Y).cells = ∅ := + (TileQuarterTurnFormulas (R Y)).2.2.1.mp + ((TileTranslationFormulas _ _).2.2.1.mp he) + change GaussianTranslation g (GaussianQuarterTurn (R Y).anchor) = + GaussianTranslation g (GaussianQuarterTurn Ysharp.anchor) + rw [ha1 he'] + have hc : (R (R Y)).cells = Zsharp.cells := hcMap.trans hc2 + have ha : (R (R Y)).cells = ∅ → (R (R Y)).anchor = Zsharp.anchor := by + intro he + exact (haMap he).trans (ha2 (hcMap ▸ he)) + refine ⟨Zsharp, hband2, hsym2, hc, ha, ?_⟩ + rw [hcent2, hcent1] + ext <;> dsimp; ring + +private theorem period3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), BandVectors.1 (q 0) (q 3) = -cert.u - cert.v ) := by + classical + intro q cfg C₀ T cert + have laws := VectorRecursionLaws q cfg.proper.1 + have laws1 := VectorRecursionLaws _ (SemiProperQuadruple.rotate cfg.proper.1) + have laws2 := VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate cfg.proper.1)) + have w1 := laws.2.2.1 + have w2 := laws1.2.2.1 + have w3 := laws2.2.2.1 + dsimp at w2 w3 + have f0 := (laws.2.2.2.2 cfg.proper 0).1 + have f1 := (laws.2.2.2.2 cfg.proper 1).1 + have f2 := (laws.2.2.2.2 cfg.proper 2).1 + simp only [Fin.reduceSucc] at f0 f1 f2 + rw [cert.period_u, cert.period_v, f0, f1, f2, w1, w2, w3] + have h := laws.1 + linear_combination ((⟨0, 1⟩ : GaussianInt) - (⟨0, 1⟩ : GaussianInt) ^ 2) * h + +private theorem markedMembership : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let pLit (i : Fin 3) := TileTranslation (cert.P i true) + (if i = 0 then -cert.v else if i = 1 then cert.u + cert.v else -cert.u) + let qLit (i : Fin 3) := TileTranslation (cert.P (i + 1) true) + (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) + let markedPoint (i : Fin 3) := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm + ⟨.J5, if i = 2 then -1 else 0, if i = 1 then 0 else -1⟩) + (BandVectors.1 (q 0) (q 3) = -cert.u - cert.v) → (∀ (i : Fin 3), markedPoint i ∈ + FootprintVertices T ∩ FootprintVertices (pLit i) ∩ FootprintVertices (qLit i) ∧ + markedPoint i ∈ FootprintVertices (TileTranslation T (BandVectors.1 (q 0) (q + i.succ)))) ) := by + classical + intro q cfg C₀ T cert pLit qLit markedPoint period3 i + have trzero (Y : ProtoTile) : TileTranslation Y 0 = Y := by + have hfun : GaussianTranslation 0 = id := by + funext z + simp [GaussianTranslation] + cases Y + simp [TileTranslation, hfun] + have trsubset (Y : ProtoTile) (a : GaussianInt) + (h : FootprintVertices Y ⊆ FootprintVertices T) : + FootprintVertices (TileTranslation Y a) ⊆ FootprintVertices (TileTranslation T a) := by + rw [(TileTranslationFormulas Y a).2.2.2.2.2.1, + (TileTranslationFormulas T a).2.2.2.2.2.1] + exact Set.image_mono h + have rho_mem (f : PeriodicSubtileFaceIndex) (k : Fin 3) : + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm f) ∈ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (SixSubtileFaceVertices f k)) := by + have h := cert.unmodified.core.rho_common (cert.unmodified.faceEquiv.symm f) k + rw [cert.unmodified.face_vertices, cert.unmodified.faceEquiv.apply_symm_apply, + cert.unmodified.tile_eq] at h + exact h + let f : PeriodicSubtileFaceIndex := + ⟨.J5, if i = 2 then -1 else 0, if i = 1 then 0 else -1⟩ + have h0 := rho_mem f 0 + have h1 := rho_mem f 1 + have h2 := rho_mem f 2 + fin_cases i + all_goals + simp? [pLit, qLit, markedPoint, f, SixSubtileFaceVertices, + SubtileOccurrenceInterpretation, trzero] at h0 h1 h2 ⊢ + · exact ⟨⟨⟨(cert.outer_occurrence 2 true).2.1 h2, h0⟩, h1⟩, + (by + rw [← cert.period_u] + exact trsubset _ cert.u (cert.outer_occurrence 1 true).2.1 h1)⟩ + · exact ⟨⟨⟨(cert.outer_occurrence 0 true).2.1 h0, h1⟩, h2⟩, + (by + rw [← cert.period_v] + exact trsubset _ cert.v (cert.outer_occurrence 2 true).2.1 h2)⟩ + · have h0' := h0 + simp only [← sub_eq_add_neg] at h0' + exact ⟨⟨⟨(cert.outer_occurrence 1 true).2.1 h1, h2⟩, h0'⟩, + (by + rw [period3] + exact trsubset _ (-cert.u - cert.v) (cert.outer_occurrence 0 true).2.1 h0')⟩ + +private theorem unrotated : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (i : Fin 3), ∀ (U : ProtoTile), (BandPrototile (q i.succ) U) → + ((TileCentroid U - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint + (BandVectors.1 (q i.succ) (q 0)) + GaussianRealPoint (BandVectors.1 (q 0) (q + i.succ)))) → (Nonempty (ExactTileInterfaceTriple T (TileTranslation T (BandVectors.1 + (q i.succ) (q 0))) U)))) → ((∀ (i : Fin 3), ∀ (U : ProtoTile), ∀ (V : ProtoTile), + (BandPrototile (q i.succ) U) → ((BandPrototile (q ((i + 1).succ)) V) → ((TileCentroid + U - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q + 0)) + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))) → ((TileCentroid V - + TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q ((i + + 1).succ)) (q 0)) - GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ))))) → + (Nonempty (ExactTileInterfaceTriple T U V)))))) → ( + let pLit (i : Fin 3) := TileTranslation (cert.P i true) + (if i = 0 then -cert.v else if i = 1 then cert.u + cert.v else -cert.u) + let qLit (i : Fin 3) := TileTranslation (cert.P (i + 1) true) + (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) + let markedPoint (i : Fin 3) := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm + ⟨.J5, if i = 2 then -1 else 0, if i = 1 then 0 else -1⟩) + (∀ (i : Fin 3), BandPrototile (q i.succ) (pLit i) ∧ BandPrototile (q ((i + 1).succ)) + (qLit i) ∧ TileCentroid (pLit i) - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + GaussianRealPoint + (BandVectors.1 (q 0) (q i.succ))) ∧ TileCentroid (qLit i) - TileCentroid T = (1 / 2 : + Real) • (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ))))) → ((∀ (i : Fin 3), + markedPoint i ∈ FootprintVertices T ∩ FootprintVertices (pLit i) ∩ FootprintVertices + (qLit i) ∧ markedPoint i ∈ FootprintVertices (TileTranslation T (BandVectors.1 (q 0) + (q i.succ)))) → (∀ (i : Fin 3), ∀ (U : ProtoTile), ∀ (V : ProtoTile), (BandPrototile + (q i.succ) U) → ((BandPrototile (q ((i + 1).succ)) V) → ((TileCentroid U - + TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))) → ((TileCentroid V - + TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ))))) → (∃ _ : + ExactTileInterfaceTriple T (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) + U, ∃ t5Data : ExactTileInterfaceTriple T U V, t5Data.point = markedPoint i ∧ (∀ + rightData : ExactTileInterfaceTriple T (TileTranslation T (BandVectors.1 (q 0) + (q i.succ))) U, rightData.point = t5Data.point))))))))) ) := by + classical + intro q cfg C₀ T cert incoming evenT5 pLit qLit markedPoint literalData markedMembership i U V + hU hV hcentU hcentV + have hcentP : TileCentroid (pLit i) = TileCentroid U := + sub_left_injective ((literalData i).2.2.1.trans hcentU.symm) + have hcentQ : TileCentroid (qLit i) = TileCentroid V := + sub_left_injective ((literalData i).2.2.2.trans hcentV.symm) + have obsP := BandPrototileCentroidUnique _ _ _ (literalData i).1 hU hcentP + have obsQ := BandPrototileCentroidUnique _ _ _ (literalData i).2.1 hV hcentQ + have footP := (ProtoTileObservableExtensionality _ _ obsP.1 obsP.2).1 + have footQ := (ProtoTileObservableExtensionality _ _ obsQ.1 obsQ.2).1 + obtain ⟨incomingData⟩ := incoming i U hU hcentU + obtain ⟨t5Data⟩ := evenT5 i U V hU hV hcentU hcentV + have hm := markedMembership i + have hmU : markedPoint i ∈ FootprintVertices U := footP ▸ hm.1.1.2 + have hmV : markedPoint i ∈ FootprintVertices V := footQ ▸ hm.1.2 + have hpoint : markedPoint i = t5Data.point := + (t5Data.unique_common _).mp ⟨⟨hm.1.1.1, hmU⟩, hmV⟩ + refine ⟨incomingData, t5Data, hpoint.symm, ?_⟩ + intro rightData + have hright : markedPoint i = rightData.point := + (rightData.unique_common _).mp ⟨⟨hm.1.1.1, hm.2⟩, hmU⟩ + exact hright.symm.trans hpoint + +private theorem signedNeg : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (i : Fin 3), ∀ (a : GaussianInt), TileCentroid (TileTranslation (cert.P i + false) (-a)) - TileCentroid T = -(TileCentroid (TileTranslation (cert.P i true) a) - + TileCentroid T) ) := by + classical + intro q cfg C₀ T cert i a + have hp := (cert.outer_occurrence i true).2.2 + have hm := (cert.outer_occurrence i false).2.2 + simp only [↓reduceIte, Bool.false_eq_true, one_smul, neg_smul] at hp hm + have hn : TileCentroid (cert.P i false) - TileCentroid T = + -(TileCentroid (cert.P i true) - TileCentroid T) := by + rw [hp, hm] + have ha : GaussianRealPoint (-a) = -GaussianRealPoint a := by + ext <;> simp [GaussianRealPoint] + rw [(TileTranslationFormulas _ _).2.2.2.2.1, + (TileTranslationFormulas _ _).2.2.2.2.1] + change TileCentroid (cert.P i false) + GaussianRealPoint (-a) - TileCentroid T = + -(TileCentroid (cert.P i true) + GaussianRealPoint a - TileCentroid T) + rw [ha] + calc + TileCentroid (cert.P i false) + -GaussianRealPoint a - TileCentroid T = + (TileCentroid (cert.P i false) - TileCentroid T) - GaussianRealPoint a := by abel + _ = -(TileCentroid (cert.P i true) - TileCentroid T) - GaussianRealPoint a := by rw [hn] + _ = -(TileCentroid (cert.P i true) + GaussianRealPoint a - TileCentroid T) := by abel + +private theorem oddFormulaU : + (by + classical + exact + ∀ (w : GaussianInt), -((1 / 2 : Real) • (GaussianRealPoint w - GaussianRealPoint ((⟨0, 1⟩ + : GaussianInt) * w))) = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * + (w + (⟨0, 1⟩ : GaussianInt) * w)) ) := by + classical + intro w + ext <;> simp [GaussianRealPoint, Prod.smul_mk, smul_eq_mul] <;> ring + +private theorem oddFormulaV : + (by + classical + exact + ∀ (w : GaussianInt), -((1 / 2 : Real) • (GaussianRealPoint w + GaussianRealPoint ((⟨0, 1⟩ + : GaussianInt) * w))) = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * + ((⟨0, 1⟩ : GaussianInt) * w - w)) ) := by + classical + intro w + ext <;> simp [GaussianRealPoint, Prod.smul_mk, smul_eq_mul] <;> ring + +private theorem oddLiteralData : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let pLit (i : Fin 3) := TileTranslation (cert.P i true) + (if i = 0 then -cert.v else if i = 1 then cert.u + cert.v else -cert.u) + let qLit (i : Fin 3) := TileTranslation (cert.P (i + 1) true) + (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) + (∀ (i : Fin 3), BandPrototile (q i.succ) (pLit i) ∧ BandPrototile (q ((i + 1).succ)) + (qLit i) ∧ TileCentroid (pLit i) - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + GaussianRealPoint + (BandVectors.1 (q 0) (q i.succ))) ∧ TileCentroid (qLit i) - TileCentroid T = (1 / 2 : + Real) • (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ))))) → ( + let pOdd (i : Fin 3) := TileTranslation (cert.P i false) + (if i = 0 then cert.u + cert.v else if i = 1 then -cert.u else -cert.v) + let qOdd (i : Fin 3) := TileTranslation (cert.P (i - 1) false) + (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) + (∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (i : Fin 3), ∀ (a : GaussianInt), TileCentroid (TileTranslation (cert.P i + false) (-a)) - TileCentroid T = -(TileCentroid (TileTranslation (cert.P i true) a) - + TileCentroid T)) → ((∀ (w : GaussianInt), -((1 / 2 : Real) • (GaussianRealPoint w - + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * w))) = (1 / 2 : Real) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) * (w + (⟨0, 1⟩ : GaussianInt) * w))) → ((∀ (w : GaussianInt), + -((1 / 2 : Real) • (GaussianRealPoint w + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * + w))) = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * ((⟨0, 1⟩ : + GaussianInt) * w - w))) → (∀ (i : Fin 3), BandPrototile (q i.succ) (pOdd i) ∧ + BandPrototile (q ((i - 1).succ)) (qOdd i) ∧ TileCentroid (pOdd i) - TileCentroid T = + (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * (BandVectors.1 (q + i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ))) ∧ TileCentroid (qOdd i) - + TileCentroid T = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * + (BandVectors.1 (q 0) (q ((i - 1).succ)) - BandVectors.1 (q ((i - 1).succ)) (q + 0))))))) ) := by + classical + intro q cfg C₀ T cert pLit qLit literalData pOdd qOdd signedNeg oddFormulaU oddFormulaV i + have hprev : ((i - 1) + 1 : Fin 3) = i := by fin_cases i <;> decide + have hP : TileCentroid (pOdd i) - TileCentroid T = + -(TileCentroid (qLit (i - 1)) - TileCentroid T) := by + fin_cases i + · simpa [pOdd, qLit, add_comm, show (-1 : Fin 3) = 2 by decide] using + signedNeg q cfg C₀ T cert 0 (-cert.u - cert.v) + · simpa [pOdd, qLit] using signedNeg q cfg C₀ T cert 1 cert.u + · simpa [pOdd, qLit] using signedNeg q cfg C₀ T cert 2 cert.v + have hQ : TileCentroid (qOdd i) - TileCentroid T = + -(TileCentroid (pLit (i - 1)) - TileCentroid T) := by + fin_cases i + · simpa [qOdd, pLit, show (-1 : Fin 3) = 2 by decide] using + signedNeg q cfg C₀ T cert 2 (-cert.u) + · simpa [qOdd, pLit] using signedNeg q cfg C₀ T cert 0 (-cert.v) + · simpa [qOdd, pLit, sub_eq_add_neg, add_comm, show (-1 : Fin 3) = 2 by decide] using + signedNeg q cfg C₀ T cert 1 (cert.u + cert.v) + have flip := (VectorRecursionLaws q cfg.proper.1).2.2.2.2 cfg.proper + refine ⟨BandPrototileTranslation _ _ _ (cert.outer_occurrence i false).1, + BandPrototileTranslation _ _ _ (cert.outer_occurrence (i - 1) false).1, ?_, ?_⟩ + · rw [hP, (literalData (i - 1)).2.2.2, hprev, (flip i).1] + exact oddFormulaU _ + · rw [hQ, (literalData (i - 1)).2.2.1, (flip (i - 1)).1] + exact oddFormulaV _ + +private theorem oddMembership : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (BandVectors.1 (q 0) (q 3) = -cert.u - cert.v) → ( + let pOdd (i : Fin 3) := TileTranslation (cert.P i false) + (if i = 0 then cert.u + cert.v else if i = 1 then -cert.u else -cert.v) + let qOdd (i : Fin 3) := TileTranslation (cert.P (i - 1) false) + (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) + let oddPoint (i : Fin 3) := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm + ⟨.J6, if i = 0 then 1 else 0, if i = 2 then 0 else 1⟩) + ∀ (i : Fin 3), oddPoint i ∈ FootprintVertices T ∩ FootprintVertices (pOdd i) ∩ + FootprintVertices (qOdd i) ∧ oddPoint i ∈ FootprintVertices (TileTranslation T + (BandVectors.1 (q 0) (q i.succ)))) ) := by + classical + intro q cfg C₀ T cert period3 pOdd qOdd oddPoint i + have trzero (Y : ProtoTile) : TileTranslation Y 0 = Y := by + have hfun : GaussianTranslation 0 = id := by + funext z + simp [GaussianTranslation] + cases Y + simp [TileTranslation, hfun] + have trsubset (Y : ProtoTile) (a : GaussianInt) + (h : FootprintVertices Y ⊆ FootprintVertices T) : + FootprintVertices (TileTranslation Y a) ⊆ FootprintVertices (TileTranslation T a) := by + rw [(TileTranslationFormulas Y a).2.2.2.2.2.1, + (TileTranslationFormulas T a).2.2.2.2.2.1] + exact Set.image_mono h + have rho_mem (f : PeriodicSubtileFaceIndex) (k : Fin 3) : + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm f) ∈ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (SixSubtileFaceVertices f k)) := by + have h := cert.unmodified.core.rho_common (cert.unmodified.faceEquiv.symm f) k + rw [cert.unmodified.face_vertices, cert.unmodified.faceEquiv.apply_symm_apply, + cert.unmodified.tile_eq] at h + exact h + let f : PeriodicSubtileFaceIndex := + ⟨.J6, if i = 0 then 1 else 0, if i = 2 then 0 else 1⟩ + have h0 := rho_mem f 0 + have h1 := rho_mem f 1 + have h2 := rho_mem f 2 + fin_cases i + all_goals + simp? [pOdd, qOdd, oddPoint, show (-1 : Fin 3) = 2 by decide, + f, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, trzero] at h0 h1 h2 ⊢ + · exact ⟨⟨⟨(cert.outer_occurrence 1 false).2.1 h1, h0⟩, h2⟩, + (by + rw [← cert.period_u] + exact trsubset _ cert.u (cert.outer_occurrence 2 false).2.1 h2)⟩ + · exact ⟨⟨⟨(cert.outer_occurrence 2 false).2.1 h2, h1⟩, h0⟩, + (by + rw [← cert.period_v] + exact trsubset _ cert.v (cert.outer_occurrence 0 false).2.1 h0)⟩ + · have h1' := h1 + simp only [← sub_eq_add_neg] at h1' + exact ⟨⟨⟨(cert.outer_occurrence 0 false).2.1 h0, h2⟩, h1'⟩, + (by + rw [period3] + exact trsubset _ (-cert.u - cert.v) (cert.outer_occurrence 1 false).2.1 h1')⟩ + +private theorem oddPoints : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let pOdd (i : Fin 3) := TileTranslation (cert.P i false) + (if i = 0 then cert.u + cert.v else if i = 1 then -cert.u else -cert.v) + let qOdd (i : Fin 3) := TileTranslation (cert.P (i - 1) false) + (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) + let oddPoint (i : Fin 3) := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm + ⟨.J6, if i = 0 then 1 else 0, if i = 2 then 0 else 1⟩) + (∀ (i : Fin 3), BandPrototile (q i.succ) (pOdd i) ∧ BandPrototile (q ((i - 1).succ)) + (qOdd i) ∧ TileCentroid (pOdd i) - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) ∧ TileCentroid (qOdd i) - TileCentroid T = (1 / 2 : + Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * (BandVectors.1 (q 0) (q ((i - + 1).succ)) - BandVectors.1 (q ((i - 1).succ)) (q 0)))) → ((∀ (i : Fin 3), oddPoint i ∈ + FootprintVertices T ∩ FootprintVertices (pOdd i) ∩ FootprintVertices (qOdd i) ∧ + oddPoint i ∈ FootprintVertices (TileTranslation T (BandVectors.1 (q 0) (q i.succ)))) + → (∀ (i : Fin 3), ∀ (U : ProtoTile), ∀ (V : ProtoTile), (BandPrototile (q i.succ) U) + → ((BandPrototile (q ((i - 1).succ)) V) → ((TileCentroid U - TileCentroid T = (1 / 2 + : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * + (BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ)))) → + ((TileCentroid V - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * + (BandVectors.1 (q 0) (q ((i - 1).succ)) - + BandVectors.1 (q ((i - 1).succ)) (q 0)))) → (∀ (rightData : + ExactTileInterfaceTriple T + (TileTranslation T (BandVectors.1 (q 0) (q i.succ))) U), ∀ (t5Data : + ExactTileInterfaceTriple T U V), rightData.point = oddPoint i ∧ t5Data.point = + oddPoint i)))))) ) := by + classical + intro q cfg C₀ T cert pOdd qOdd oddPoint oddLiteralData oddMembership i U V hU hV hcentU hcentV + rightData t5Data + have hcentP : TileCentroid (pOdd i) = TileCentroid U := + sub_left_injective ((oddLiteralData i).2.2.1.trans hcentU.symm) + have hcentQ : TileCentroid (qOdd i) = TileCentroid V := + sub_left_injective ((oddLiteralData i).2.2.2.trans hcentV.symm) + have obsP := BandPrototileCentroidUnique _ _ _ (oddLiteralData i).1 hU hcentP + have obsQ := BandPrototileCentroidUnique _ _ _ (oddLiteralData i).2.1 hV hcentQ + have footP := (ProtoTileObservableExtensionality _ _ obsP.1 obsP.2).1 + have footQ := (ProtoTileObservableExtensionality _ _ obsQ.1 obsQ.2).1 + have hm := oddMembership i + have hmU : oddPoint i ∈ FootprintVertices U := footP ▸ hm.1.1.2 + have hmV : oddPoint i ∈ FootprintVertices V := footQ ▸ hm.1.2 + exact ⟨((rightData.unique_common _).mp ⟨⟨hm.1.1.1, hm.2⟩, hmU⟩).symm, + ((t5Data.unique_common _).mp ⟨⟨hm.1.1.1, hmU⟩, hmV⟩).symm⟩ + +private theorem centeredComparison : + (by + classical + exact + ∀ (T : ProtoTile), (∀ (C : CircleCoordinates), ∀ (Y : ProtoTile), ∀ (g : GaussianInt), + (BandPrototile C Y) → ((QuarterTurnSymmetric Y) → (∃ Ysharp : ProtoTile, + BandPrototile C Ysharp ∧ QuarterTurnSymmetric Ysharp ∧ (TileTranslation + (TileQuarterTurn Y) g).cells = Ysharp.cells ∧ ((TileTranslation (TileQuarterTurn Y) + g).cells = ∅ → (TileTranslation (TileQuarterTurn Y) g).anchor = Ysharp.anchor) ∧ + TileCentroid Ysharp = (-((TileCentroid Y).2) + (g.re : Int), (TileCentroid Y).1 + + (g.im : Int))))) → (∀ (g : GaussianInt), (GaussianRealPoint g = ((TileCentroid T).1 + + (TileCentroid T).2, (TileCentroid T).2 - (TileCentroid T).1)) → (∀ (C : + CircleCoordinates), ∀ (Y : ProtoTile), ∀ (U : ProtoTile), (BandPrototile C Y) → + ((QuarterTurnSymmetric Y) → ((BandPrototile C U) → ((TileCentroid U - TileCentroid T = + (-((TileCentroid Y - TileCentroid T).2), + (TileCentroid Y - TileCentroid T).1)) → ((TileTranslation (TileQuarterTurn Y) + g).cells = U.cells ∧ ((TileTranslation (TileQuarterTurn Y) g).cells = ∅ → + (TileTranslation (TileQuarterTurn Y) g).anchor = U.anchor))))))) ) := by + classical + intro T centeredProxy g hg C Y U hY hYsym hU hcentU + obtain ⟨Ysharp, hband, hYsharpSym, hc, ha, hcent⟩ := + centeredProxy C Y g hY hYsym + have hcentEq : TileCentroid Ysharp = TileCentroid U := by + rw [hcent] + have hr := congrArg Prod.fst hg + have hi := congrArg Prod.snd hg + have ur := congrArg Prod.fst hcentU + have ui := congrArg Prod.snd hcentU + change (g.re : Real) = (TileCentroid T).1 + (TileCentroid T).2 at hr + change (g.im : Real) = (TileCentroid T).2 - (TileCentroid T).1 at hi + ext <;> dsimp at ur ui ⊢ <;> linarith + have obs := BandPrototileCentroidUnique C Ysharp U hband hU hcentEq + exact ⟨hc.trans obs.1, fun he => (ha he).trans (obs.2 (hc ▸ he))⟩ + +private theorem halfTurnComparison : + (by + classical + exact + ∀ (T : ProtoTile), (∀ (C : CircleCoordinates), ∀ (Y : ProtoTile), ∀ (g : GaussianInt), + (BandPrototile C Y) → ((QuarterTurnSymmetric Y) → (∃ Zsharp : ProtoTile, + BandPrototile C Zsharp ∧ QuarterTurnSymmetric Zsharp ∧ (TileTranslation + (TileQuarterTurn (TileTranslation (TileQuarterTurn Y) g)) g).cells = Zsharp.cells ∧ + ((TileTranslation (TileQuarterTurn (TileTranslation (TileQuarterTurn Y) g)) g).cells + = ∅ → (TileTranslation (TileQuarterTurn (TileTranslation (TileQuarterTurn Y) g)) + g).anchor = Zsharp.anchor) ∧ TileCentroid Zsharp = (-((TileCentroid Y).1) + (g.re : + Int) - (g.im : Int), -((TileCentroid Y).2) + (g.re : Int) + (g.im : Int))))) → (∀ (g + : GaussianInt), (GaussianRealPoint g = ((TileCentroid T).1 + (TileCentroid T).2, + (TileCentroid T).2 - (TileCentroid T).1)) → (∀ (C : CircleCoordinates), ∀ (Y : + ProtoTile), ∀ (U : ProtoTile), (BandPrototile C Y) → ((QuarterTurnSymmetric Y) → + ((BandPrototile C U) → ((TileCentroid U - TileCentroid T = + -(TileCentroid Y - TileCentroid T)) → ((TileTranslation (TileQuarterTurn + (TileTranslation (TileQuarterTurn Y) g)) g).cells = U.cells ∧ ((TileTranslation + (TileQuarterTurn (TileTranslation (TileQuarterTurn Y) g)) g).cells = ∅ → + (TileTranslation (TileQuarterTurn (TileTranslation (TileQuarterTurn Y) g)) + g).anchor = U.anchor))))))) ) := by + classical + intro T halfTurnProxy g hg C Y U hY hYsym hU hcentU + obtain ⟨Ysharp, hband, hYsharpSym, hc, ha, hcent⟩ := + halfTurnProxy C Y g hY hYsym + have hcentEq : TileCentroid Ysharp = TileCentroid U := by + rw [hcent] + have hr := congrArg Prod.fst hg + have hi := congrArg Prod.snd hg + have ur := congrArg Prod.fst hcentU + have ui := congrArg Prod.snd hcentU + change (g.re : Real) = (TileCentroid T).1 + (TileCentroid T).2 at hr + change (g.im : Real) = (TileCentroid T).2 - (TileCentroid T).1 at hi + ext <;> dsimp at ur ui ⊢ <;> linarith + have obs := BandPrototileCentroidUnique C Ysharp U hband hU hcentEq + exact ⟨hc.trans obs.1, fun he => (ha he).trans (obs.2 (hc ▸ he))⟩ + +private theorem pathMap : + (by + classical + exact + ∀ (f : GaussianInt → GaussianInt), (Function.Injective f) → ((∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (f b = f a + 1 ∨ f b = f a - 1 ∨ + f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → (∀ (V : Set GaussianInt), ∀ (E : Set + (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (y : GaussianInt), + (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween (f '' V) ((fun e : + Finset GaussianInt => e.image f) '' E) (f x) (f y)))) ) := by + classical + intro f hf hstep V E x y h + rcases h with ⟨p, hn, hl, hh, ht, hv, hs, he⟩ + refine ⟨p.map f, hn.map hf, by simpa using hl, ?_, ?_, ?_, ?_, ?_⟩ + · rw [List.head?_map, hh]; rfl + · rw [List.getLast?_map, ht]; rfl + · rw [hv]; ext z; simp + · exact List.isChain_iff_forall_rel_of_append_cons_cons.mp + (List.isChain_map_of_isChain f hstep + (List.isChain_iff_forall_rel_of_append_cons_cons.mpr hs)) + · intro e + constructor + · rintro ⟨d, hd, rfl⟩ + rcases (he d).mp hd with ⟨a, b, l₁, l₂, hp, rfl⟩ + refine ⟨f a, f b, l₁.map f, l₂.map f, ?_, ?_⟩ + · simpa using congrArg (List.map f) hp + · simp + · rintro ⟨a, b, l₁, l₂, hp, rfl⟩ + obtain ⟨k, r, hkr, hk, hr⟩ := List.map_eq_append_iff.mp hp + obtain ⟨a₀, r₁, hr₁, ha, hm₁⟩ := List.map_eq_cons_iff.mp hr + obtain ⟨b₀, r₂, hr₂, hb, hm₂⟩ := List.map_eq_cons_iff.mp hm₁ + refine ⟨{a₀, b₀}, (he _).mpr ⟨a₀, b₀, k, r₂, ?_, rfl⟩, ?_⟩ + · rw [hkr, hr₁, hr₂] + · simp [ha, hb] + +private theorem tripleMap : + (by + classical + exact + (∀ (f : GaussianInt → GaussianInt), (Function.Injective f) → ((∀ a b : GaussianInt, (b = + a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → (f b = f a + 1 ∨ f b = f a - 1 + ∨ f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → (∀ (V : Set GaussianInt), ∀ (E : Set + (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (y : GaussianInt), + (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween (f '' V) ((fun e : Finset + GaussianInt => e.image f) '' E) (f x) (f y))))) → (∀ (F : ProtoTile → ProtoTile), ∀ + (f : GaussianInt → GaussianInt), (Function.Injective f) → ((∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (f b = f a + 1 ∨ f b = f a - 1 ∨ + f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → ((∀ Y, FootprintVertices (F Y) = f '' + FootprintVertices Y) → ((∀ Y, FootprintEdges (F Y) = + (fun e : Finset GaussianInt => e.image f) '' FootprintEdges Y) → (∀ (A : ProtoTile), + ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (E : ExactTileInterfaceTriple A B C), ∃ + E' : ExactTileInterfaceTriple (F A) (F B) (F C), E'.point = f E.point ∧ + E'.otherAB = f E.otherAB ∧ E'.otherBC = f E.otherBC ∧ E'.otherCA = f + E.otherCA))))) ) := by + classical + intro pathMap F f hf hstep hv he A B C E + have hedge : Function.Injective (fun e : Finset GaussianInt => e.image f) := + Finset.image_injective hf + refine ⟨⟨f E.point, f E.otherAB, f E.otherBC, f E.otherCA, + ?_, ?_, ?_, ?_⟩, rfl, rfl, rfl, rfl⟩ + · simpa only [hv, he, ← Set.image_inter hf, ← Set.image_inter hedge] using + pathMap f hf hstep _ _ _ _ E.pathAB + · simpa only [hv, he, ← Set.image_inter hf, ← Set.image_inter hedge] using + pathMap f hf hstep _ _ _ _ E.pathBC + · simpa only [hv, he, ← Set.image_inter hf, ← Set.image_inter hedge] using + pathMap f hf hstep _ _ _ _ E.pathCA + · intro z + rw [hv, hv, hv, ← Set.image_inter hf, ← Set.image_inter hf] + constructor + · rintro ⟨x, hx, rfl⟩ + rw [(E.unique_common x).mp hx] + · rintro rfl + exact ⟨E.point, (E.unique_common _).mpr rfl, rfl⟩ + +private theorem tripleRetarget : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (C : + ProtoTile), ∀ (C' : ProtoTile), (A.cells = A'.cells ∧ (A.cells = ∅ → A.anchor = + A'.anchor)) → ((B.cells = B'.cells ∧ (B.cells = ∅ → B.anchor = B'.anchor)) → + ((C.cells = C'.cells ∧ (C.cells = ∅ → C.anchor = C'.anchor)) → (∀ (E : + ExactTileInterfaceTriple A B C), ∃ E' : ExactTileInterfaceTriple A' B' C', E'.point = + E.point ∧ E'.otherAB = E.otherAB ∧ E'.otherBC = E.otherBC ∧ E'.otherCA = E.otherCA))) + ) := by + classical + intro A A' B B' C C' hA hB hC E + have vA := (ProtoTileObservableExtensionality A A' hA.1 hA.2).1 + have vB := (ProtoTileObservableExtensionality B B' hB.1 hB.2).1 + have vC := (ProtoTileObservableExtensionality C C' hC.1 hC.2).1 + have eA : FootprintEdges A = FootprintEdges A' := by simp [FootprintEdges, hA.1] + have eB : FootprintEdges B = FootprintEdges B' := by simp [FootprintEdges, hB.1] + have eC : FootprintEdges C = FootprintEdges C' := by simp [FootprintEdges, hC.1] + refine ⟨⟨E.point, E.otherAB, E.otherBC, E.otherCA, ?_, ?_, ?_, ?_⟩, + rfl, rfl, rfl, rfl⟩ + · simpa only [← vA, ← vB, ← eA, ← eB] using E.pathAB + · simpa only [← vB, ← vC, ← eB, ← eC] using E.pathBC + · simpa only [← vC, ← vA, ← eC, ← eA] using E.pathCA + · intro z; simpa only [← vA, ← vB, ← vC] using E.unique_common z + +private theorem tripleTurn : + (by + classical + exact + (∀ (F : ProtoTile → ProtoTile), ∀ (f : GaussianInt → GaussianInt), (Function.Injective f) + → ((∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (f b = f a + 1 ∨ f b = f a - 1 ∨ f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → ((∀ Y, + FootprintVertices (F Y) = f '' FootprintVertices Y) → ((∀ Y, FootprintEdges (F Y) = + (fun e : Finset GaussianInt => e.image f) '' FootprintEdges Y) → (∀ (A : ProtoTile), + ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (E : ExactTileInterfaceTriple A B C), ∃ E' : + ExactTileInterfaceTriple (F A) (F B) (F C), E'.point = f E.point ∧ E'.otherAB = f + E.otherAB ∧ E'.otherBC = f E.otherBC ∧ E'.otherCA = f E.otherCA))))) → (∀ (a : + GaussianInt), ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (E : + ExactTileInterfaceTriple A B C), ∃ E' : ExactTileInterfaceTriple (TileTranslation + (TileQuarterTurn A) a) (TileTranslation (TileQuarterTurn B) a) (TileTranslation + (TileQuarterTurn C) a), E'.point = GaussianQuarterTurn E.point + a ∧ E'.otherAB = + GaussianQuarterTurn E.otherAB + a ∧ E'.otherBC = GaussianQuarterTurn E.otherBC + a ∧ + E'.otherCA = GaussianQuarterTurn E.otherCA + a) ) := by + classical + intro tripleMap a A B C E + apply tripleMap (fun Y => TileTranslation (TileQuarterTurn Y) a) + (fun z => GaussianQuarterTurn z + a) _ _ _ _ A B C E + · intro x y h + have hq := add_right_cancel h + apply Zsqrtd.ext + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.im) hq + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => -z.re) hq + · intro x y h + rcases h with h | h | h | h <;> subst y + · right; right; left; ext <;> simp [GaussianQuarterTurn]; omega + · right; right; right; ext <;> simp [GaussianQuarterTurn]; omega + · right; left; ext <;> simp [GaussianQuarterTurn]; omega + · left; ext <;> simp [GaussianQuarterTurn]; omega + · intro Y + rw [(TileTranslationFormulas _ _).2.2.2.2.2.1, + (TileQuarterTurnFormulas _).2.2.2.2.2.1, Set.image_image] + rfl + · intro Y + rw [(TileTranslationFormulas _ _).2.2.2.2.2.2.1, + (TileQuarterTurnFormulas _).2.2.2.2.2.2.1, Set.image_image] + congr 1 + funext e + rw [Finset.image_image] + rfl + +private theorem translateZero : + (by + classical + exact + ∀ (Y : ProtoTile), TileTranslation Y 0 = Y ) := by + classical + intro Y + have h : GaussianTranslation 0 = id := by funext z; simp [GaussianTranslation] + cases Y + simp [TileTranslation, h] + +private theorem turnTranslate : + (by + classical + exact + ∀ (Y : ProtoTile), ∀ (a : GaussianInt), ∀ (k : GaussianInt), ∀ (g : GaussianInt), + TileTranslation (TileQuarterTurn (TileTranslation Y a)) k = TileTranslation + (TileTranslation (TileQuarterTurn Y) g) (k - g + GaussianQuarterTurn a) ) := by + classical + intro Y a k g + simp only [TileTranslation, TileQuarterTurn, ProtoTile.mk.injEq] + constructor + · simp only [Finset.image_image] + congr 1 + funext z + ext <;> simp [Function.comp_def, GaussianTranslation, GaussianQuarterTurn] <;> ring + · ext <;> simp [GaussianTranslation, GaussianQuarterTurn] <;> ring + +private theorem obsTranslate : + (by + classical + exact + ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (a : GaussianInt), (Y.cells = Z.cells ∧ (Y.cells + = ∅ → Y.anchor = Z.anchor)) → ((TileTranslation Y a).cells = (TileTranslation Z + a).cells ∧ ((TileTranslation Y a).cells = ∅ → (TileTranslation Y a).anchor = + (TileTranslation Z a).anchor)) ) := by + classical + intro Y Z a h + constructor + · simp [TileTranslation, h.1] + · intro he + change GaussianTranslation a Y.anchor = GaussianTranslation a Z.anchor + rw [h.2 ((TileTranslationFormulas Y a).2.2.1.mp he)] + +private theorem swapFirst : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (E : ExactTileInterfaceTriple + A B C), ∃ E' : ExactTileInterfaceTriple B A C, E'.point = E.point ∧ E'.otherAB = + E.otherAB ∧ E'.otherBC = E.otherCA ∧ E'.otherCA = E.otherBC ) := by + classical + intro A B C E + refine ⟨⟨E.point, E.otherAB, E.otherCA, E.otherBC, ?_, ?_, ?_, ?_⟩, + rfl, rfl, rfl, rfl⟩ + · simpa [Set.inter_comm] using E.pathAB + · simpa [Set.inter_comm] using E.pathCA + · simpa [Set.inter_comm] using E.pathBC + · intro z + simpa [Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using E.unique_common z + +private theorem parentTurn : + (by + classical + exact + (∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (C : + ProtoTile), ∀ (C' : ProtoTile), (A.cells = A'.cells ∧ (A.cells = ∅ → A.anchor = + A'.anchor)) → ((B.cells = B'.cells ∧ (B.cells = ∅ → B.anchor = B'.anchor)) → + ((C.cells = C'.cells ∧ (C.cells = ∅ → C.anchor = C'.anchor)) → (∀ (E : + ExactTileInterfaceTriple A B C), ∃ E' : ExactTileInterfaceTriple A' B' C', E'.point = + E.point ∧ E'.otherAB = E.otherAB ∧ E'.otherBC = E.otherBC ∧ E'.otherCA = + E.otherCA)))) → ((∀ (a : GaussianInt), ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : + ProtoTile), ∀ (E : ExactTileInterfaceTriple A B C), ∃ E' : ExactTileInterfaceTriple + (TileTranslation (TileQuarterTurn A) a) (TileTranslation (TileQuarterTurn B) a) + (TileTranslation (TileQuarterTurn C) a), E'.point = GaussianQuarterTurn E.point + a ∧ + E'.otherAB = GaussianQuarterTurn E.otherAB + a ∧ E'.otherBC = GaussianQuarterTurn + E.otherBC + a ∧ E'.otherCA = GaussianQuarterTurn E.otherCA + a) → ((∀ (Y : + ProtoTile), ∀ (a : GaussianInt), ∀ (k : GaussianInt), ∀ (g : GaussianInt), + TileTranslation (TileQuarterTurn (TileTranslation Y a)) k = TileTranslation + (TileTranslation (TileQuarterTurn Y) g) (k - g + GaussianQuarterTurn a)) → ((∀ (Y : + ProtoTile), ∀ (Z : ProtoTile), ∀ (a : GaussianInt), (Y.cells = Z.cells ∧ (Y.cells = ∅ + → Y.anchor = Z.anchor)) → ((TileTranslation Y a).cells = (TileTranslation Z a).cells + ∧ ((TileTranslation Y a).cells = ∅ → (TileTranslation Y a).anchor = (TileTranslation + Z a).anchor))) → (∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (w : GaussianInt), ∀ (g : + GaussianInt), ∀ (k : GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + ((TileTranslation (TileQuarterTurn T) g).cells = T.cells ∧ + ((TileTranslation (TileQuarterTurn T) g).cells = ∅ → + (TileTranslation (TileQuarterTurn T) g).anchor = T.anchor)) → (((TileTranslation + (TileQuarterTurn U) k).cells = U.cells ∧ + ((TileTranslation (TileQuarterTurn U) k).cells = ∅ → + (TileTranslation (TileQuarterTurn U) k).anchor = U.anchor)) → ((k - g = w) → (∀ (E + : ExactTileInterfaceTriple (TileTranslation T a) (TileTranslation T b) U), ∃ E' + : ExactTileInterfaceTriple (TileTranslation T (w + GaussianQuarterTurn a)) + (TileTranslation T (w + GaussianQuarterTurn b)) U, E'.point = + GaussianQuarterTurn E.point + k))))))) ) := by + classical + intro tripleRetarget tripleTurn turnTranslate obsTranslate T U w g k a b hT hU hw E + subst w + obtain ⟨D, hp, _⟩ := tripleTurn k _ _ _ E + have hA := obsTranslate _ T (k - g + GaussianQuarterTurn a) hT + have hB := obsTranslate _ T (k - g + GaussianQuarterTurn b) hT + rw [← turnTranslate] at hA hB + obtain ⟨D', hp', _⟩ := tripleRetarget _ _ _ _ _ _ hA hB hU D + exact ⟨D', hp'.trans hp⟩ + +private theorem fixedPointNotCommon : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (k : GaussianInt), ∀ (x : GaussianInt), + (T.cells.Nonempty) → ((U.cells.Nonempty) → ((Disjoint T.cells U.cells) → + (((TileTranslation (TileQuarterTurn U) k).cells = U.cells) → ((GaussianQuarterTurn x + + k = x) → ((x ∈ FootprintVertices T) → ((x ∈ FootprintVertices U) → (False))))))) ) + := by + classical + intro T U k x hT hU hd hc hfixed hxT hxU + have incident (Y : ProtoTile) (hne : Y.cells.Nonempty) (hx : x ∈ FootprintVertices Y) : + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ Y.cells := by + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hx + rcases hx with ⟨c, hc, h | h | h | h⟩ + · refine ⟨0, ?_⟩; simpa [LatticeVertexIncidentCell] using h ▸ hc + · subst x; refine ⟨1, ?_⟩; simpa [LatticeVertexIncidentCell] using hc + · subst x; refine ⟨3, ?_⟩; simpa [LatticeVertexIncidentCell] using hc + · subst x; refine ⟨2, ?_⟩ + convert hc using 1 + ext <;> simp [LatticeVertexIncidentCell] + obtain ⟨j, hj⟩ := incident U hU hxU + obtain ⟨l, hl⟩ := incident T hT hxT + have rotate (j : Fin 4) (hj : LatticeVertexIncidentCell x j ∈ U.cells) : + LatticeVertexIncidentCell x (j + 1) ∈ U.cells := by + rw [← hc, (TileTranslationFormulas _ _).1, (TileQuarterTurnFormulas _).1] + apply Finset.mem_image.mpr + refine ⟨GaussianQuarterTurn (LatticeVertexIncidentCell x j) - 1, + Finset.mem_image.mpr ⟨_, hj, rfl⟩, ?_⟩ + have hr := congrArg Zsqrtd.re hfixed + have hi := congrArg Zsqrtd.im hfixed + fin_cases j <;> ext <;> + simp [GaussianTranslation, GaussianQuarterTurn, + LatticeVertexIncidentCell] at hr hi ⊢ <;> omega + have h1 := rotate j hj + have h2 := rotate (j + 1) h1 + have h3 := rotate ((j + 1) + 1) h2 + have hall : LatticeVertexIncidentCell x l ∈ U.cells := by + fin_cases j <;> fin_cases l <;> + simp only [] at hj h1 h2 h3 <;> assumption + exact Finset.disjoint_left.mp hd hl hall + +private theorem markedFromIncoming : + (by + classical + exact + (∀ (Y : ProtoTile), TileTranslation Y 0 = Y) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ + (C : ProtoTile), ∀ (E : ExactTileInterfaceTriple A B C), ∃ E' : + ExactTileInterfaceTriple B A C, E'.point = E.point ∧ E'.otherAB = E.otherAB ∧ + E'.otherBC = E.otherCA ∧ E'.otherCA = E.otherBC) → ((∀ (T : ProtoTile), ∀ (U : + ProtoTile), ∀ (w : GaussianInt), ∀ (g : GaussianInt), ∀ (k : GaussianInt), ∀ (a : + GaussianInt), ∀ (b : GaussianInt), ((TileTranslation (TileQuarterTurn T) g).cells = + T.cells ∧ ((TileTranslation (TileQuarterTurn T) g).cells = ∅ → (TileTranslation + (TileQuarterTurn T) g).anchor = T.anchor)) → (((TileTranslation (TileQuarterTurn U) + k).cells = U.cells ∧ ((TileTranslation (TileQuarterTurn U) k).cells = ∅ → + (TileTranslation (TileQuarterTurn U) k).anchor = U.anchor)) → ((k - g = w) → (∀ (E : + ExactTileInterfaceTriple (TileTranslation T a) (TileTranslation T b) U), ∃ E' : + ExactTileInterfaceTriple (TileTranslation T (w + GaussianQuarterTurn a)) + (TileTranslation T (w + GaussianQuarterTurn b)) U, E'.point = GaussianQuarterTurn + E.point + k)))) → ((∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (k : GaussianInt), ∀ (x : + GaussianInt), (T.cells.Nonempty) → ((U.cells.Nonempty) → ((Disjoint T.cells U.cells) + → (((TileTranslation (TileQuarterTurn U) k).cells = U.cells) → ((GaussianQuarterTurn + x + k = x) → ((x ∈ FootprintVertices T) → ((x ∈ FootprintVertices U) → (False)))))))) + → (∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (w : GaussianInt), (QuarterTurnSymmetric + T) → ((QuarterTurnSymmetric U) → ((T.cells.Nonempty) → ((U.cells.Nonempty) → + ((Disjoint T.cells U.cells) → ((TileCentroid U - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint (w + GaussianQuarterTurn w)) → (∀ (E : ExactTileInterfaceTriple T + (TileTranslation T w) U), ∃ R : ExactTileInterfaceTriple T (TileTranslation T + (GaussianQuarterTurn w)) U, E.point ≠ R.point)))))))))) ) := by + classical + intro translateZero swapFirst parentTurn fixedPointNotCommon T U w hsT hsU hT hU hd hcent E + obtain ⟨g, hg, hTc, hTa, _⟩ := QuarterTurnSymmetricCenteredTransport T hsT + obtain ⟨k, hk, hUc, hUa, _⟩ := QuarterTurnSymmetricCenteredTransport U hsU + have hw : k - g = w := by + have gr := congrArg Prod.fst hg + have gi := congrArg Prod.snd hg + have kr := congrArg Prod.fst hk + have ki := congrArg Prod.snd hk + have dr := congrArg Prod.fst hcent + have di := congrArg Prod.snd hcent + simp [GaussianRealPoint, GaussianQuarterTurn, Prod.smul_mk, smul_eq_mul] at gr gi kr ki dr di + simp only [← GaussianInt.intCast_re, ← GaussianInt.intCast_im] at gr gi kr ki dr di + ext + · have h : (k.re : Real) - (g.re : Real) = (w.re : Real) := by linarith + exact_mod_cast h + · have h : (k.im : Real) - (g.im : Real) = (w.im : Real) := by linarith + exact_mod_cast h + have ht : (TileTranslation (TileQuarterTurn T) g).cells = T.cells ∧ + ((TileTranslation (TileQuarterTurn T) g).cells = ∅ → + (TileTranslation (TileQuarterTurn T) g).anchor = T.anchor) := + ⟨hTc, fun he => hTa (hTc ▸ he)⟩ + have hu : (TileTranslation (TileQuarterTurn U) k).cells = U.cells ∧ + ((TileTranslation (TileQuarterTurn U) k).cells = ∅ → + (TileTranslation (TileQuarterTurn U) k).anchor = U.anchor) := + ⟨hUc, fun he => hUa (hUc ▸ he)⟩ + have ep0 : ∃ E0 : ExactTileInterfaceTriple (TileTranslation T 0) (TileTranslation T w) U, + E0.point = E.point := by + rw [translateZero T] + exact ⟨E, rfl⟩ + obtain ⟨E0, hp0⟩ := ep0 + have ep1 := parentTurn T U w g k 0 w ht hu hw E0 + have qzero : GaussianQuarterTurn 0 = 0 := by ext <;> simp [GaussianQuarterTurn] + rw [qzero, add_zero] at ep1 + obtain ⟨E1, hp1⟩ := ep1 + obtain ⟨E2, hp2⟩ := parentTurn T U w g k w + (w + GaussianQuarterTurn w) ht hu hw E1 + have ep3 := parentTurn T U w g k + (w + GaussianQuarterTurn w) (w + GaussianQuarterTurn (w + GaussianQuarterTurn w)) + ht hu hw E2 + have ha : w + GaussianQuarterTurn (w + GaussianQuarterTurn w) = GaussianQuarterTurn w := by + ext <;> simp [GaussianQuarterTurn] + have hb : w + GaussianQuarterTurn (w + GaussianQuarterTurn (w + GaussianQuarterTurn w)) = 0 := by + ext <;> simp [GaussianQuarterTurn] + generalize hx2 : E2.point = x2 at ep3 + rw [hb, ha, translateZero] at ep3 + obtain ⟨E3, hp3⟩ := ep3 + obtain ⟨R, hpR, _⟩ := swapFirst _ _ _ E3 + refine ⟨R, ?_⟩ + intro heq + have hfixed : GaussianQuarterTurn E.point + k = E.point := by + have h := hpR.trans hp3 + rw [← hx2, hp2, hp1, hp0] at h + rw [← heq] at h + have hr := congrArg Zsqrtd.re h + have hi := congrArg Zsqrtd.im h + ext <;> simp [GaussianQuarterTurn] at hr hi ⊢ <;> omega + have hx := (E.unique_common E.point).mpr rfl + exact fixedPointNotCommon T U k E.point hT hU hd hUc hfixed hx.1.1 hx.2 + +private theorem qinj : + (by + classical + exact + Function.Injective GaussianQuarterTurn ) := by + classical + intro x y h + apply Zsqrtd.ext + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.im) h + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => -z.re) h + +private theorem turnAtRoot : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (g : GaussianInt), (∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : + ProtoTile), ∀ (B' : ProtoTile), ∀ (C : ProtoTile), ∀ (C' : ProtoTile), (A.cells = + A'.cells ∧ (A.cells = ∅ → A.anchor = A'.anchor)) → ((B.cells = B'.cells ∧ (B.cells = + ∅ → B.anchor = B'.anchor)) → ((C.cells = C'.cells ∧ (C.cells = ∅ → C.anchor = + C'.anchor)) → (∀ (E : ExactTileInterfaceTriple A B C), ∃ E' : + ExactTileInterfaceTriple A' B' C', E'.point = E.point ∧ E'.otherAB = E.otherAB ∧ + E'.otherBC = E.otherBC ∧ E'.otherCA = E.otherCA)))) → ((∀ (a : GaussianInt), ∀ (A : + ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (E : ExactTileInterfaceTriple A B + C), ∃ E' : ExactTileInterfaceTriple (TileTranslation (TileQuarterTurn A) a) + (TileTranslation (TileQuarterTurn B) a) (TileTranslation (TileQuarterTurn C) a), + E'.point = GaussianQuarterTurn E.point + a ∧ E'.otherAB = GaussianQuarterTurn + E.otherAB + a ∧ E'.otherBC = GaussianQuarterTurn E.otherBC + a ∧ E'.otherCA = + GaussianQuarterTurn E.otherCA + a) → ( + let R (Y : ProtoTile) := TileTranslation (TileQuarterTurn Y) g + ((R T).cells = T.cells ∧ ((R T).cells = ∅ → (R T).anchor = T.anchor)) → (∀ (B : + ProtoTile), ∀ (C : ProtoTile), ∀ (B' : ProtoTile), ∀ (C' : ProtoTile), ((R B).cells = + B'.cells ∧ ((R B).cells = ∅ → (R B).anchor = B'.anchor)) → (((R C).cells = C'.cells ∧ + ((R C).cells = ∅ → (R C).anchor = C'.anchor)) → (∀ (E : ExactTileInterfaceTriple T B + C), ∃ E' : ExactTileInterfaceTriple T B' C', E'.point = GaussianQuarterTurn E.point + + g ∧ E'.otherAB = GaussianQuarterTurn E.otherAB + g ∧ E'.otherBC = GaussianQuarterTurn + E.otherBC + g ∧ E'.otherCA = GaussianQuarterTurn E.otherCA + g))))) ) := by + classical + intro T g tripleRetarget tripleTurn R rootObs B C B' C' hB hC E + obtain ⟨D, hp, hab, hbc, hca⟩ := tripleTurn g _ _ _ E + obtain ⟨D', hp', hab', hbc', hca'⟩ := tripleRetarget _ _ _ _ _ _ rootObs hB hC D + exact ⟨D', hp'.trans hp, hab'.trans hab, hbc'.trans hbc, hca'.trans hca⟩ + +private theorem companionObs : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (g : GaussianInt), (∀ (Y : ProtoTile), ∀ (a : GaussianInt), ∀ (k : + GaussianInt), ∀ (g : GaussianInt), TileTranslation (TileQuarterTurn (TileTranslation + Y a)) k = TileTranslation (TileTranslation (TileQuarterTurn Y) g) (k - g + + GaussianQuarterTurn a)) → ((∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (a : + GaussianInt), (Y.cells = Z.cells ∧ (Y.cells = ∅ → Y.anchor = Z.anchor)) → + ((TileTranslation Y a).cells = (TileTranslation Z a).cells ∧ ((TileTranslation Y + a).cells = ∅ → (TileTranslation Y a).anchor = (TileTranslation Z a).anchor))) → ( + let R (Y : ProtoTile) := TileTranslation (TileQuarterTurn Y) g + ((R T).cells = T.cells ∧ ((R T).cells = ∅ → (R T).anchor = T.anchor)) → (∀ (a : + GaussianInt), (R (TileTranslation T a)).cells = (TileTranslation T + (GaussianQuarterTurn a)).cells ∧ ((R (TileTranslation T a)).cells = ∅ → (R + (TileTranslation T a)).anchor = (TileTranslation T (GaussianQuarterTurn + a)).anchor)))) ) := by + classical + intro T g turnTranslate obsTranslate R rootObs a + have h := obsTranslate _ T (GaussianQuarterTurn a) rootObs + rw [show GaussianQuarterTurn a = g - g + GaussianQuarterTurn a by simp, + ← turnTranslate] at h + simpa only [R, sub_self, zero_add] using h + +private theorem obsTurn : + (by + classical + exact + ∀ (g : GaussianInt), + let R (Y : ProtoTile) := TileTranslation (TileQuarterTurn Y) g + ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), (Y.cells = Z.cells ∧ (Y.cells = ∅ → Y.anchor = + Z.anchor)) → ((R Y).cells = (R Z).cells ∧ ((R Y).cells = ∅ → (R Y).anchor = (R + Z).anchor)) ) := by + classical + intro g R Y Z h + constructor + · simp only [R, TileTranslation, TileQuarterTurn, h.1] + · intro he + have heY : Y.cells = ∅ := + (TileQuarterTurnFormulas Y).2.2.1.mp ((TileTranslationFormulas _ _).2.2.1.mp he) + change GaussianTranslation g (GaussianQuarterTurn Y.anchor) = + GaussianTranslation g (GaussianQuarterTurn Z.anchor) + rw [h.2 heY] + +private theorem halfCompanionObs : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (g : GaussianInt), (∀ (w : GaussianInt), GaussianQuarterTurn + (GaussianQuarterTurn w) = -w) → ( + let R (Y : ProtoTile) := TileTranslation (TileQuarterTurn Y) g + (∀ (a : GaussianInt), (R (TileTranslation T a)).cells = (TileTranslation T + (GaussianQuarterTurn a)).cells ∧ ((R (TileTranslation T a)).cells = ∅ → (R + (TileTranslation T a)).anchor = (TileTranslation T (GaussianQuarterTurn a)).anchor)) + → ((∀ (Y : ProtoTile), ∀ (Z : ProtoTile), (Y.cells = Z.cells ∧ (Y.cells = ∅ → + Y.anchor = Z.anchor)) → ((R Y).cells = (R Z).cells ∧ ((R Y).cells = ∅ → (R Y).anchor + = (R Z).anchor))) → ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), + (X.cells = Y.cells ∧ (X.cells = ∅ → X.anchor = Y.anchor)) → ((Y.cells = Z.cells ∧ + (Y.cells = ∅ → Y.anchor = Z.anchor)) → (X.cells = Z.cells ∧ (X.cells = ∅ → X.anchor = + Z.anchor)))) → (∀ (a : GaussianInt), (R (R (TileTranslation T a))).cells = + (TileTranslation T (-a)).cells ∧ ((R (R (TileTranslation T a))).cells = ∅ → (R (R + (TileTranslation T a))).anchor = (TileTranslation T (-a)).anchor))))) ) := by + classical + intro T g qneg R companionObs obsTurn obsTrans a + have h := obsTrans _ _ _ (obsTurn _ _ (companionObs a)) + (companionObs (GaussianQuarterTurn a)) + simpa only [qneg] using h + +private theorem halfAtRoot : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (g : GaussianInt), + let R (Y : ProtoTile) := TileTranslation (TileQuarterTurn Y) g + (∀ (Y : ProtoTile), Y.cells = Y.cells ∧ (Y.cells = ∅ → Y.anchor = Y.anchor)) → ((∀ (B : + ProtoTile), ∀ (C : ProtoTile), ∀ (B' : ProtoTile), ∀ (C' : ProtoTile), ((R B).cells = + B'.cells ∧ ((R B).cells = ∅ → (R B).anchor = B'.anchor)) → (((R C).cells = C'.cells ∧ + ((R C).cells = ∅ → (R C).anchor = C'.anchor)) → (∀ (E : ExactTileInterfaceTriple T B + C), ∃ E' : ExactTileInterfaceTriple T B' C', E'.point = GaussianQuarterTurn E.point + + g ∧ E'.otherAB = GaussianQuarterTurn E.otherAB + g ∧ E'.otherBC = GaussianQuarterTurn + E.otherBC + g ∧ E'.otherCA = GaussianQuarterTurn E.otherCA + g))) → (∀ (B : + ProtoTile), ∀ (C : ProtoTile), ∀ (B' : ProtoTile), ∀ (C' : ProtoTile), ((R (R + B)).cells = B'.cells ∧ ((R (R B)).cells = ∅ → (R (R B)).anchor = B'.anchor)) → (((R + (R C)).cells = C'.cells ∧ ((R (R C)).cells = ∅ → (R (R C)).anchor = C'.anchor)) → (∀ + (E : ExactTileInterfaceTriple T B C), ∃ E' : ExactTileInterfaceTriple T B' C', + E'.point = GaussianQuarterTurn (GaussianQuarterTurn E.point + g) + g)))) ) := by + classical + intro T g R obsId turnAtRoot B C B' C' hB hC E + obtain ⟨D, hp, _⟩ := turnAtRoot B C (R B) (R C) (obsId _) (obsId _) E + obtain ⟨D', hp', _⟩ := turnAtRoot (R B) (R C) B' C' hB hC D + exact ⟨D', by rw [hp', hp]⟩ + +private theorem evenPackage : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (QuarterTurnSymmetric T) → (( + let junctionData := fun (A B C : ProtoTile) => ∃ (AB : ProtoTile) (BC : ProtoTile) (CA : + ProtoTile) (ABC : ProtoTile), LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ Disjoint A.cells + B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ (∀ (z : LatticeCell), + z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ (∀ (z : LatticeCell), z ∈ BC.cells ↔ z ∈ + B.cells ∨ z ∈ C.cells) ∧ (∀ (z : LatticeCell), z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ + A.cells) ∧ (∀ (z : LatticeCell), z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ + C.cells) ∧ (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ (FootprintEdges B ∩ + FootprintEdges C).Nonempty ∧ (FootprintEdges C ∩ FootprintEdges A).Nonempty; (∀ (i : + Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile (q i.succ) U → TileCentroid U - + TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) + → junctionData T (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) + U) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q + i.succ) U → BandPrototile (q (i + (1 : Fin (3 : ℕ))).succ) V → TileCentroid U - + TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) + → TileCentroid V - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → + junctionData T U V) → ( + let pLit (i : Fin 3) := TileTranslation (cert.P i true) + (if i = 0 then -cert.v else if i = 1 then cert.u + cert.v else -cert.u) + let qLit (i : Fin 3) := TileTranslation (cert.P (i + 1) true) + (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) + let markedPoint (i : Fin 3) := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm + ⟨.J5, if i = 2 then -1 else 0, if i = 1 then 0 else -1⟩) + (∀ (i : Fin 3), BandPrototile (q i.succ) (pLit i) ∧ BandPrototile (q ((i + 1).succ)) + (qLit i) ∧ TileCentroid (pLit i) - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + GaussianRealPoint + (BandVectors.1 (q 0) (q i.succ))) ∧ TileCentroid (qLit i) - TileCentroid T = (1 / 2 : + Real) • (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ))))) → ((∀ (i : Fin 3), + QuarterTurnSymmetric (pLit i) ∧ QuarterTurnSymmetric (qLit i)) → ((∀ (i : Fin 3), ∀ + (U : ProtoTile), ∀ (V : ProtoTile), (BandPrototile (q i.succ) U) → ((BandPrototile (q + ((i + 1).succ)) V) → ((TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + GaussianRealPoint + (BandVectors.1 (q 0) (q i.succ)))) → ((TileCentroid V - TileCentroid T = (1 / 2 : + Real) • (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ))))) → (∃ _ : + ExactTileInterfaceTriple T (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U, ∃ + t5Data : ExactTileInterfaceTriple T U V, t5Data.point = markedPoint i ∧ (∀ rightData + : ExactTileInterfaceTriple T (TileTranslation T (BandVectors.1 (q 0) (q i.succ))) U, + rightData.point = t5Data.point)))))) → ((∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (w : + GaussianInt), (QuarterTurnSymmetric T) → ((QuarterTurnSymmetric U) → + ((T.cells.Nonempty) → ((U.cells.Nonempty) → ((Disjoint T.cells U.cells) → + ((TileCentroid U - TileCentroid T = (1 / 2 : Real) • GaussianRealPoint (w + + GaussianQuarterTurn w)) → (∀ (E : ExactTileInterfaceTriple T (TileTranslation T w) + U), ∃ R : ExactTileInterfaceTriple T (TileTranslation T (GaussianQuarterTurn w)) U, + E.point ≠ R.point))))))) → ((∀ (w : GaussianInt), GaussianQuarterTurn w = (⟨0, 1⟩ : + GaussianInt) * w) → (∀ (i : Fin 3), ∃ rightData : ExactTileInterfaceTriple T + (TileTranslation T (BandVectors.1 (q 0) (q i.succ))) (pLit i), ∃ incomingData : + ExactTileInterfaceTriple T (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) (pLit + i), ∃ t5Data : ExactTileInterfaceTriple T (pLit i) (qLit i), rightData.point = + t5Data.point ∧ incomingData.point ≠ t5Data.point))))))) ) := by + classical + intro q cfg C₀ T cert hsym junctions pLit qLit markedPoint literalData literalSym unrotated + markedFromIncoming qmul i + obtain ⟨L, E, hp, heq⟩ := unrotated i _ _ (literalData i).1 (literalData i).2.1 + (literalData i).2.2.1 (literalData i).2.2.2 + obtain ⟨AB, BC, CA, ABC, hA, hB, hC, hAB, hBC, hCA, hABC, + hdAB, hdBC, hdCA, _⟩ := junctions.1 i _ (literalData i).1 (literalData i).2.2.1 + have flip := (VectorRecursionLaws q cfg.proper.1).2.2.2.2 cfg.proper i |>.1 + have hc : TileCentroid (pLit i) - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0) + + GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0))) := by + rw [(literalData i).2.2.1, flip] + ext <;> simp [GaussianRealPoint, GaussianQuarterTurn, Prod.smul_mk, smul_eq_mul] + have p := markedFromIncoming T (pLit i) (BandVectors.1 (q i.succ) (q 0)) + hsym (literalSym i).1 (LatticeTileGridStructure T hA).1.1 + (LatticeTileGridStructure _ hC).1.1 hdCA.symm hc L + rw [qmul, ← flip] at p + obtain ⟨D, hne⟩ := p + exact ⟨D, L, E, heq D, by simpa only [← heq D] using hne⟩ + +private theorem turnDisjoint : + (by + classical + exact + ∀ (g : GaussianInt), (Function.Injective GaussianQuarterTurn) → ( + let R (Y : ProtoTile) := TileTranslation (TileQuarterTurn Y) g + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (Disjoint X.cells Y.cells) → (Disjoint (R X).cells + (R Y).cells)) ) := by + classical + intro g qinj R X Y h + apply Finset.disjoint_left.mpr + intro z hzX hzY + simp only [R, TileTranslation, TileQuarterTurn, Finset.mem_image] at hzX hzY + obtain ⟨a, ⟨a₀, ha₀, rfl⟩, ha⟩ := hzX + obtain ⟨b, ⟨b₀, hb₀, rfl⟩, hb⟩ := hzY + have hab : a₀ = b₀ := by + apply qinj + dsimp [GaussianTranslation] at ha hb + have hh := add_right_cancel (ha.trans hb.symm) + exact sub_left_injective hh + exact Finset.disjoint_left.mp h ha₀ (hab ▸ hb₀) + +private theorem oddPackage : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (QuarterTurnSymmetric T) → (( + let junctionData := fun (A B C : ProtoTile) => ∃ (AB : ProtoTile) (BC : ProtoTile) (CA : + ProtoTile) (ABC : ProtoTile), LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ + LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ Disjoint A.cells + B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ (∀ (z : LatticeCell), + z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ (∀ (z : LatticeCell), z ∈ BC.cells ↔ z ∈ + B.cells ∨ z ∈ C.cells) ∧ (∀ (z : LatticeCell), z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ + A.cells) ∧ (∀ (z : LatticeCell), z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ + C.cells) ∧ (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ (FootprintEdges B ∩ + FootprintEdges C).Nonempty ∧ (FootprintEdges C ∩ FootprintEdges A).Nonempty; (∀ (i : + Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile (q i.succ) U → TileCentroid U - + TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) + → junctionData T (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) + U) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q + i.succ) U → BandPrototile (q (i + (1 : Fin (3 : ℕ))).succ) V → TileCentroid U - + TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) + → TileCentroid V - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → + junctionData T U V) → ((∀ (i : Fin 3), ∀ (U : ProtoTile), (BandPrototile (q i.succ) + U) → ((TileCentroid U - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint + (BandVectors.1 (q i.succ) (q 0)) + GaussianRealPoint (BandVectors.1 (q 0) (q + i.succ)))) → (Nonempty (ExactTileInterfaceTriple T (TileTranslation T (BandVectors.1 + (q i.succ) (q 0))) U)))) → ((∀ (i : Fin 3), ∀ (U : ProtoTile), ∀ (V : ProtoTile), + (BandPrototile (q i.succ) U) → ((BandPrototile (q ((i + 1).succ)) V) → ((TileCentroid + U - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q + 0)) + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))) → ((TileCentroid V - + TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q ((i + + 1).succ)) (q 0)) - GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ))))) → + (Nonempty (ExactTileInterfaceTriple T U V)))))) → ( + let pLit (i : Fin 3) := TileTranslation (cert.P i true) + (if i = 0 then -cert.v else if i = 1 then cert.u + cert.v else -cert.u) + let qLit (i : Fin 3) := TileTranslation (cert.P (i + 1) true) + (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) + (∀ (i : Fin 3), BandPrototile (q i.succ) (pLit i) ∧ BandPrototile (q ((i + 1).succ)) + (qLit i) ∧ TileCentroid (pLit i) - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + GaussianRealPoint + (BandVectors.1 (q 0) (q i.succ))) ∧ TileCentroid (qLit i) - TileCentroid T = (1 / 2 : + Real) • (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ))))) → ((∀ (Y : ProtoTile), ∀ + (a : GaussianInt), (QuarterTurnSymmetric Y) → (QuarterTurnSymmetric (TileTranslation + Y a))) → ((∀ (i : Fin 3), QuarterTurnSymmetric (pLit i) ∧ QuarterTurnSymmetric (qLit + i)) → ( + let pOdd (i : Fin 3) := TileTranslation (cert.P i false) + (if i = 0 then cert.u + cert.v else if i = 1 then -cert.u else -cert.v) + let qOdd (i : Fin 3) := TileTranslation (cert.P (i - 1) false) + (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) + let oddPoint (i : Fin 3) := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm + ⟨.J6, if i = 0 then 1 else 0, if i = 2 then 0 else 1⟩) + (∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (i : Fin 3), ∀ (a : GaussianInt), TileCentroid (TileTranslation (cert.P i + false) (-a)) - TileCentroid T = -(TileCentroid (TileTranslation (cert.P i true) a) - + TileCentroid T)) → ((∀ (i : Fin 3), BandPrototile (q i.succ) (pOdd i) ∧ BandPrototile + (q ((i - 1).succ)) (qOdd i) ∧ TileCentroid (pOdd i) - TileCentroid T = (1 / 2 : Real) + • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) ∧ TileCentroid (qOdd i) - TileCentroid T = (1 / 2 : + Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * (BandVectors.1 (q 0) (q ((i - + 1).succ)) - BandVectors.1 (q ((i - 1).succ)) (q 0)))) → ((∀ (i : Fin 3), ∀ (U : + ProtoTile), ∀ (V : ProtoTile), (BandPrototile (q i.succ) U) → ((BandPrototile (q ((i + - 1).succ)) V) → ((TileCentroid U - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ)))) → ((TileCentroid V - TileCentroid T = (1 / 2 : + Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * (BandVectors.1 (q 0) (q ((i - + 1).succ)) - BandVectors.1 (q ((i - 1).succ)) (q 0)))) → (∀ (rightData : + ExactTileInterfaceTriple T (TileTranslation T (BandVectors.1 (q 0) (q i.succ))) U), ∀ + (t5Data : ExactTileInterfaceTriple T U V), rightData.point = oddPoint i ∧ + t5Data.point = oddPoint i))))) → (∀ (g : GaussianInt), (∀ (C : CircleCoordinates), ∀ + (Y : ProtoTile), ∀ (U : ProtoTile), (BandPrototile C Y) → ((QuarterTurnSymmetric Y) → + ((BandPrototile C U) → ((TileCentroid U - TileCentroid T = (-((TileCentroid Y - + TileCentroid T).2), (TileCentroid Y - TileCentroid T).1)) → ((TileTranslation + (TileQuarterTurn Y) g).cells = U.cells ∧ ((TileTranslation (TileQuarterTurn Y) + g).cells = ∅ → (TileTranslation (TileQuarterTurn Y) g).anchor = U.anchor)))))) → ((∀ + (C : CircleCoordinates), ∀ (Y : ProtoTile), ∀ (U : ProtoTile), (BandPrototile C Y) → + ((QuarterTurnSymmetric Y) → ((BandPrototile C U) → ((TileCentroid U - TileCentroid T + = -(TileCentroid Y - TileCentroid T)) → ((TileTranslation (TileQuarterTurn + (TileTranslation (TileQuarterTurn Y) g)) g).cells = U.cells ∧ ((TileTranslation + (TileQuarterTurn (TileTranslation (TileQuarterTurn Y) g)) g).cells = ∅ → + (TileTranslation (TileQuarterTurn (TileTranslation (TileQuarterTurn Y) g)) g).anchor + = U.anchor)))))) → ((∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (w : GaussianInt), + (QuarterTurnSymmetric T) → ((QuarterTurnSymmetric U) → ((T.cells.Nonempty) → + ((U.cells.Nonempty) → ((Disjoint T.cells U.cells) → ((TileCentroid U - TileCentroid T + = (1 / 2 : Real) • GaussianRealPoint (w + GaussianQuarterTurn w)) → (∀ (E : + ExactTileInterfaceTriple T (TileTranslation T w) U), ∃ R : ExactTileInterfaceTriple T + (TileTranslation T (GaussianQuarterTurn w)) U, E.point ≠ R.point))))))) → ((∀ (w : + GaussianInt), GaussianQuarterTurn w = (⟨0, 1⟩ : GaussianInt) * w) → ((∀ (w : + GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn w) = -w) → ( + let R (Y : ProtoTile) := TileTranslation (TileQuarterTurn Y) g + ((R T).cells = T.cells ∧ ((R T).cells = ∅ → (R T).anchor = T.anchor)) → ((∀ (B : + ProtoTile), ∀ (C : ProtoTile), ∀ (B' : ProtoTile), ∀ (C' : ProtoTile), ((R B).cells = + B'.cells ∧ ((R B).cells = ∅ → (R B).anchor = B'.anchor)) → (((R C).cells = C'.cells ∧ + ((R C).cells = ∅ → (R C).anchor = C'.anchor)) → (∀ (E : ExactTileInterfaceTriple T B + C), ∃ E' : ExactTileInterfaceTriple T B' C', E'.point = GaussianQuarterTurn E.point + + g ∧ E'.otherAB = GaussianQuarterTurn E.otherAB + g ∧ E'.otherBC = GaussianQuarterTurn + E.otherBC + g ∧ E'.otherCA = GaussianQuarterTurn E.otherCA + g))) → ((∀ (a : + GaussianInt), (R (TileTranslation T a)).cells = (TileTranslation T + (GaussianQuarterTurn a)).cells ∧ ((R (TileTranslation T a)).cells = ∅ → (R + (TileTranslation T a)).anchor = (TileTranslation T (GaussianQuarterTurn a)).anchor)) + → ((∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (B' : ProtoTile), ∀ (C' : ProtoTile), ((R + (R B)).cells = B'.cells ∧ ((R (R B)).cells = ∅ → (R (R B)).anchor = B'.anchor)) → + (((R (R C)).cells = C'.cells ∧ ((R (R C)).cells = ∅ → (R (R C)).anchor = C'.anchor)) + → (∀ (E : ExactTileInterfaceTriple T B C), ∃ E' : ExactTileInterfaceTriple T B' C', + E'.point = GaussianQuarterTurn (GaussianQuarterTurn E.point + g) + g))) → ((∀ (X : + ProtoTile), ∀ (Y : ProtoTile), (Disjoint X.cells Y.cells) → (Disjoint (R X).cells (R + Y).cells)) → (∀ (i : Fin 3), ∃ rightData : ExactTileInterfaceTriple T + (TileTranslation T (BandVectors.1 (q 0) (q i.succ))) (pOdd i), ∃ incomingData : + ExactTileInterfaceTriple T (TileTranslation T (-BandVectors.1 (q i.succ) (q 0))) + (pOdd i), ∃ t5Data : ExactTileInterfaceTriple T (pOdd i) (qOdd i), rightData.point = + t5Data.point ∧ incomingData.point ≠ t5Data.point)))))))))))))))))))) ) := by + classical + intro q cfg C₀ T cert hsym junctions incoming evenT5 pLit qLit literalData translated_sym + literalSym pOdd qOdd oddPoint signedNeg oddLiteralData oddPoints g centeredComparison + halfTurnComparison markedFromIncoming qmul qneg R rootObs turnAtRoot companionObs + halfAtRoot turnDisjoint i + have flip := (VectorRecursionLaws q cfg.proper.1).2.2.2.2 cfg.proper i |>.1 + have hprev : ((i - 1) + 1 : Fin 3) = i := by fin_cases i <;> decide + have hP : TileCentroid (pOdd i) - TileCentroid T = + -(TileCentroid (qLit (i - 1)) - TileCentroid T) := by + fin_cases i + · simpa [pOdd, qLit, add_comm, show (-1 : Fin 3) = 2 by decide] using + signedNeg q cfg C₀ T cert 0 (-cert.u - cert.v) + · simpa [pOdd, qLit] using signedNeg q cfg C₀ T cert 1 cert.u + · simpa [pOdd, qLit] using signedNeg q cfg C₀ T cert 2 cert.v + have hQ : TileCentroid (qOdd i) - TileCentroid T = + -(TileCentroid (pLit (i - 1)) - TileCentroid T) := by + fin_cases i + · simpa [qOdd, pLit, show (-1 : Fin 3) = 2 by decide] using + signedNeg q cfg C₀ T cert 2 (-cert.u) + · simpa [qOdd, pLit] using signedNeg q cfg C₀ T cert 0 (-cert.v) + · simpa [qOdd, pLit, sub_eq_add_neg, add_comm, show (-1 : Fin 3) = 2 by decide] using + signedNeg q cfg C₀ T cert 1 (cert.u + cert.v) + have hPband : BandPrototile (q i.succ) (qLit (i - 1)) := by + simpa only [hprev] using (literalData (i - 1)).2.1 + have obsP := halfTurnComparison _ _ _ hPband (literalSym (i - 1)).2 + (oddLiteralData i).1 hP + have obsQ := halfTurnComparison _ _ _ (literalData (i - 1)).1 (literalSym (i - 1)).1 + (oddLiteralData i).2.1 hQ + -- Half-turn the predecessor's even triple, then exchange its parents. + obtain ⟨E₀⟩ := evenT5 (i - 1) _ _ (literalData (i - 1)).1 (literalData (i - 1)).2.1 + (literalData (i - 1)).2.2.1 (literalData (i - 1)).2.2.2 + obtain ⟨EH, _⟩ := halfAtRoot _ _ _ _ obsQ obsP E₀ + obtain ⟨E5, _⟩ := ExactTileInterfaceTripleSwapLast _ _ _ EH + have obsU := centeredComparison _ _ _ (literalData i).1 (literalSym i).1 + (oddLiteralData i).1 (by + rw [(oddLiteralData i).2.2.1, (literalData i).2.2.1] + ext <;> simp [GaussianRealPoint, Prod.smul_mk, smul_eq_mul]; ring) + obtain ⟨L⟩ := incoming i _ (literalData i).1 (literalData i).2.2.1 + have hComp := companionObs (BandVectors.1 (q i.succ) (q 0)) + rw [qmul, ← flip] at hComp + obtain ⟨D, _⟩ := turnAtRoot _ _ _ _ hComp obsU L + obtain ⟨AB, BC, CA, ABC, hA, hB, hC, hAB, hBC, hCA, hABC, + hdAB, hdBC, hdCA, _⟩ := junctions.1 i _ (literalData i).1 (literalData i).2.2.1 + have hd : Disjoint T.cells (pOdd i).cells := by + rw [← rootObs.1, ← obsU.1] + exact turnDisjoint T (pLit i) hdCA.symm + have hOddLattice : LatticeTile (pOdd i) := + (TileDiskAreaCovariance _ _).1.mp (cert.parent_lattice i false) + have hc : TileCentroid (pOdd i) - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ) + + GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ))) := by + rw [(oddLiteralData i).2.2.1, flip] + ext <;> simp [GaussianRealPoint, GaussianQuarterTurn, Prod.smul_mk, smul_eq_mul]; ring + have p := markedFromIncoming T (pOdd i) (BandVectors.1 (q 0) (q i.succ)) + hsym (translated_sym _ _ (cert.parent_quarter_turn i false)) + (LatticeTileGridStructure T hA).1.1 (LatticeTileGridStructure _ hOddLattice).1.1 hd hc D + have hq : GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ)) = + -BandVectors.1 (q i.succ) (q 0) := by + rw [flip, ← qmul, qneg] + rw [hq] at p + obtain ⟨I, hne⟩ := p + have hpoints := oddPoints i _ _ (oddLiteralData i).1 (oddLiteralData i).2.1 + (oddLiteralData i).2.2.1 (oddLiteralData i).2.2.2 D E5 + have heq : D.point = E5.point := hpoints.1.trans hpoints.2.symm + exact ⟨D, I, E5, heq, fun h => hne (heq.trans h.symm)⟩ + +private theorem retargetPackage : + (by + classical + exact + ∀ (T : ProtoTile), (∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (R : ProtoTile), ∀ (L : + ProtoTile), ∀ (rightData : ExactTileInterfaceTriple T R U), ∀ (incomingData : + ExactTileInterfaceTriple T L U), ∀ (t5Data : ExactTileInterfaceTriple T U V), + (rightData.point = t5Data.point) → ((incomingData.point ≠ t5Data.point) → + (incomingData.otherCA = t5Data.point ∧ rightData.otherCA = incomingData.point ∧ + t5Data.otherAB = incomingData.point))) → ((∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ + (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (C : ProtoTile), ∀ (C' : ProtoTile), (A.cells + = A'.cells ∧ (A.cells = ∅ → A.anchor = A'.anchor)) → ((B.cells = B'.cells ∧ (B.cells + = ∅ → B.anchor = B'.anchor)) → ((C.cells = C'.cells ∧ (C.cells = ∅ → C.anchor = + C'.anchor)) → (∀ (E : ExactTileInterfaceTriple A B C), ∃ E' : + ExactTileInterfaceTriple A' B' C', E'.point = E.point ∧ E'.otherAB = E.otherAB ∧ + E'.otherBC = E.otherBC ∧ E'.otherCA = E.otherCA)))) → ((∀ (Y : ProtoTile), Y.cells = + Y.cells ∧ (Y.cells = ∅ → Y.anchor = Y.anchor)) → (∀ (a : GaussianInt), ∀ (b : + GaussianInt), ∀ (P : ProtoTile), ∀ (Q : ProtoTile), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), (P.cells = U.cells ∧ (P.cells = ∅ → P.anchor = U.anchor)) → ((Q.cells = + V.cells ∧ (Q.cells = ∅ → Q.anchor = V.anchor)) → (∀ (D : ExactTileInterfaceTriple T + (TileTranslation T a) P), ∀ (L : ExactTileInterfaceTriple T (TileTranslation T b) P), + ∀ (E : ExactTileInterfaceTriple T P Q), (D.point = E.point) → ((L.point ≠ E.point) → + (∃ D' : ExactTileInterfaceTriple T (TileTranslation T a) U, ∃ L' : + ExactTileInterfaceTriple T (TileTranslation T b) U, ∃ E' : ExactTileInterfaceTriple T + U V, D'.point = E'.point ∧ L'.point ≠ E'.point ∧ L'.otherCA = E'.point ∧ D'.otherCA = + L'.point ∧ E'.otherAB = L'.point))))))) ) := by + classical + intro T endpointRelations tripleRetarget obsId a b P Q U V hP hQ D L E hp hne + obtain ⟨D', hd, _⟩ := tripleRetarget _ _ _ _ _ _ (obsId T) (obsId _) hP D + obtain ⟨L', hl, _⟩ := tripleRetarget _ _ _ _ _ _ (obsId T) (obsId _) hP L + obtain ⟨E', he, _⟩ := tripleRetarget _ _ _ _ _ _ (obsId T) hP hQ E + have hp' : D'.point = E'.point := hd.trans (hp.trans he.symm) + have hn' : L'.point ≠ E'.point := by simpa only [hl, he] using hne + exact ⟨D', L', E', hp', hn', endpointRelations _ _ _ _ D' L' E' hp' hn'⟩ + +private theorem halfPackage : + (by + classical + exact + ∀ (T : ProtoTile), (∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (R : ProtoTile), ∀ (L : + ProtoTile), ∀ (rightData : ExactTileInterfaceTriple T R U), ∀ (incomingData : + ExactTileInterfaceTriple T L U), ∀ (t5Data : ExactTileInterfaceTriple T U V), + (rightData.point = t5Data.point) → ((incomingData.point ≠ t5Data.point) → + (incomingData.otherCA = t5Data.point ∧ rightData.otherCA = incomingData.point ∧ + t5Data.otherAB = incomingData.point))) → (∀ (g : GaussianInt), (Function.Injective + GaussianQuarterTurn) → ( + let R (Y : ProtoTile) := TileTranslation (TileQuarterTurn Y) g + (∀ (a : GaussianInt), (R (R (TileTranslation T a))).cells = (TileTranslation T + (-a)).cells ∧ ((R (R (TileTranslation T a))).cells = ∅ → (R (R (TileTranslation T + a))).anchor = (TileTranslation T (-a)).anchor)) → ((∀ (B : ProtoTile), ∀ (C : + ProtoTile), ∀ (B' : ProtoTile), ∀ (C' : ProtoTile), ((R (R B)).cells = B'.cells ∧ ((R + (R B)).cells = ∅ → (R (R B)).anchor = B'.anchor)) → (((R (R C)).cells = C'.cells ∧ + ((R (R C)).cells = ∅ → (R (R C)).anchor = C'.anchor)) → (∀ (E : + ExactTileInterfaceTriple T B C), ∃ E' : ExactTileInterfaceTriple T B' C', E'.point = + GaussianQuarterTurn (GaussianQuarterTurn E.point + g) + g))) → (∀ (a : GaussianInt), + ∀ (b : GaussianInt), ∀ (P : ProtoTile), ∀ (Q : ProtoTile), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), ((R (R P)).cells = U.cells ∧ ((R (R P)).cells = ∅ → (R (R P)).anchor = + U.anchor)) → (((R (R Q)).cells = V.cells ∧ ((R (R Q)).cells = ∅ → (R (R Q)).anchor = + V.anchor)) → (∀ (D : ExactTileInterfaceTriple T (TileTranslation T a) P), ∀ (L : + ExactTileInterfaceTriple T (TileTranslation T b) P), ∀ (E : ExactTileInterfaceTriple + T P Q), (D.point = E.point) → ((L.point ≠ E.point) → (∃ D' : ExactTileInterfaceTriple + T (TileTranslation T (-a)) U, ∃ L' : ExactTileInterfaceTriple T (TileTranslation T + (-b)) U, ∃ E' : ExactTileInterfaceTriple T U V, D'.point = E'.point ∧ L'.point ≠ + E'.point ∧ L'.otherCA = E'.point ∧ D'.otherCA = L'.point ∧ E'.otherAB = + L'.point)))))))) ) := by + classical + intro T endpointRelations g qinj R halfCompanionObs halfAtRoot a b P Q U V hP hQ D L E hp hne + obtain ⟨D', hd⟩ := halfAtRoot _ _ _ _ (halfCompanionObs a) hP D + obtain ⟨L', hl⟩ := halfAtRoot _ _ _ _ (halfCompanionObs b) hP L + obtain ⟨E', he⟩ := halfAtRoot _ _ _ _ hP hQ E + have hp' : D'.point = E'.point := by rw [hd, he, hp] + have hn' : L'.point ≠ E'.point := by + intro h + apply hne + apply qinj + apply add_right_cancel (b := g) + apply qinj + exact add_right_cancel (hl.symm.trans (h.trans he)) + exact ⟨D', L', E', hp', hn', endpointRelations _ _ _ _ D' L' E' hp' hn'⟩ + +private theorem realAdd : + (by + classical + exact + ∀ (a : GaussianInt), ∀ (b : GaussianInt), GaussianRealPoint (a + b) = GaussianRealPoint a + + GaussianRealPoint b ) := by + classical + intro a b + ext <;> simp [GaussianRealPoint] + +private theorem realSub : + (by + classical + exact + ∀ (a : GaussianInt), ∀ (b : GaussianInt), GaussianRealPoint (a - b) = GaussianRealPoint a + - GaussianRealPoint b ) := by + classical + intro a b + ext <;> simp [GaussianRealPoint] + +end PairedEndpointGeometry + +namespace PairedEndpointCertificate + +private theorem completePackages : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), (∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (R : ProtoTile), ∀ (L : ProtoTile), ∀ + (rightData : ExactTileInterfaceTriple T R U), ∀ (incomingData : + ExactTileInterfaceTriple T L U), ∀ (t5Data : ExactTileInterfaceTriple T U V), + (rightData.point = t5Data.point) → ((incomingData.point ≠ t5Data.point) → + (incomingData.otherCA = t5Data.point ∧ rightData.otherCA = incomingData.point ∧ + t5Data.otherAB = incomingData.point))) → ( + let pLit (i : Fin 3) := TileTranslation (cert.P i true) + (if i = 0 then -cert.v else if i = 1 then cert.u + cert.v else -cert.u) + let qLit (i : Fin 3) := TileTranslation (cert.P (i + 1) true) + (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) + (∀ (i : Fin 3), BandPrototile (q i.succ) (pLit i) ∧ BandPrototile (q ((i + 1).succ)) + (qLit i) ∧ TileCentroid (pLit i) - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + GaussianRealPoint + (BandVectors.1 (q 0) (q i.succ))) ∧ TileCentroid (qLit i) - TileCentroid T = (1 / 2 : + Real) • (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ))))) → ((∀ (Y : ProtoTile), ∀ + (a : GaussianInt), (QuarterTurnSymmetric Y) → (QuarterTurnSymmetric (TileTranslation + Y a))) → ((∀ (i : Fin 3), QuarterTurnSymmetric (pLit i) ∧ QuarterTurnSymmetric (qLit + i)) → ( + let pOdd (i : Fin 3) := TileTranslation (cert.P i false) + (if i = 0 then cert.u + cert.v else if i = 1 then -cert.u else -cert.v) + let qOdd (i : Fin 3) := TileTranslation (cert.P (i - 1) false) + (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) + (∀ (i : Fin 3), BandPrototile (q i.succ) (pOdd i) ∧ BandPrototile (q ((i - 1).succ)) + (qOdd i) ∧ TileCentroid (pOdd i) - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) ∧ TileCentroid (qOdd i) - TileCentroid T = (1 / 2 : + Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * (BandVectors.1 (q 0) (q ((i - + 1).succ)) - BandVectors.1 (q ((i - 1).succ)) (q 0)))) → (∀ (g : GaussianInt), (∀ (C : + CircleCoordinates), ∀ (Y : ProtoTile), ∀ (U : ProtoTile), (BandPrototile C Y) → + ((QuarterTurnSymmetric Y) → ((BandPrototile C U) → ((TileCentroid U - TileCentroid T + = -(TileCentroid Y - TileCentroid T)) → ((TileTranslation (TileQuarterTurn + (TileTranslation (TileQuarterTurn Y) g)) g).cells = U.cells ∧ ((TileTranslation + (TileQuarterTurn (TileTranslation (TileQuarterTurn Y) g)) g).cells = ∅ → + (TileTranslation (TileQuarterTurn (TileTranslation (TileQuarterTurn Y) g)) g).anchor + = U.anchor)))))) → ((∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' + : ProtoTile), ∀ (C : ProtoTile), ∀ (C' : ProtoTile), (A.cells = A'.cells ∧ (A.cells = + ∅ → A.anchor = A'.anchor)) → ((B.cells = B'.cells ∧ (B.cells = ∅ → B.anchor = + B'.anchor)) → ((C.cells = C'.cells ∧ (C.cells = ∅ → C.anchor = C'.anchor)) → (∀ (E : + ExactTileInterfaceTriple A B C), ∃ E' : ExactTileInterfaceTriple A' B' C', E'.point = + E.point ∧ E'.otherAB = E.otherAB ∧ E'.otherBC = E.otherBC ∧ E'.otherCA = + E.otherCA)))) → ((∀ (w : GaussianInt), GaussianQuarterTurn w = (⟨0, 1⟩ : GaussianInt) + * w) → ((∀ (w : GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn w) = -w) → + ((Function.Injective GaussianQuarterTurn) → ( + let R (Y : ProtoTile) := TileTranslation (TileQuarterTurn Y) g + (∀ (Y : ProtoTile), Y.cells = Y.cells ∧ (Y.cells = ∅ → Y.anchor = Y.anchor)) → ((∀ (a : + GaussianInt), (R (TileTranslation T a)).cells = (TileTranslation T + (GaussianQuarterTurn a)).cells ∧ ((R (TileTranslation T a)).cells = ∅ → (R + (TileTranslation T a)).anchor = (TileTranslation T (GaussianQuarterTurn a)).anchor)) + → ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), (X.cells = Y.cells ∧ + (X.cells = ∅ → X.anchor = Y.anchor)) → ((Y.cells = Z.cells ∧ (Y.cells = ∅ → Y.anchor + = Z.anchor)) → (X.cells = Z.cells ∧ (X.cells = ∅ → X.anchor = Z.anchor)))) → ((∀ (B : + ProtoTile), ∀ (C : ProtoTile), ∀ (B' : ProtoTile), ∀ (C' : ProtoTile), ((R (R + B)).cells = B'.cells ∧ ((R (R B)).cells = ∅ → (R (R B)).anchor = B'.anchor)) → (((R + (R C)).cells = C'.cells ∧ ((R (R C)).cells = ∅ → (R (R C)).anchor = C'.anchor)) → (∀ + (E : ExactTileInterfaceTriple T B C), ∃ E' : ExactTileInterfaceTriple T B' C', + E'.point = GaussianQuarterTurn (GaussianQuarterTurn E.point + g) + g))) → ((∀ (i : + Fin 3), ∃ rightData : ExactTileInterfaceTriple T (TileTranslation T (BandVectors.1 (q + 0) (q i.succ))) (pLit i), ∃ incomingData : ExactTileInterfaceTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) (pLit i), ∃ t5Data : + ExactTileInterfaceTriple T (pLit i) (qLit i), rightData.point = t5Data.point ∧ + incomingData.point ≠ t5Data.point) → ((∀ (i : Fin 3), ∃ rightData : + ExactTileInterfaceTriple T (TileTranslation T (BandVectors.1 (q 0) (q i.succ))) (pOdd + i), ∃ incomingData : ExactTileInterfaceTriple T (TileTranslation T (-BandVectors.1 (q + i.succ) (q 0))) (pOdd i), ∃ t5Data : ExactTileInterfaceTriple T (pOdd i) (qOdd i), + rightData.point = t5Data.point ∧ incomingData.point ≠ t5Data.point) → ( + let pairedEndpointData : Fin 3 → Fin 4 → ProtoTile → ProtoTile → Prop := + fun i s U V ↦ + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) + let uL := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q i.succ) (q 0) + else BandVectors.1 (q 0) (q i.succ)) + ∃ rightData : ExactTileInterfaceTriple T + (TileTranslation T uR) U, + ∃ incomingData : ExactTileInterfaceTriple T + (TileTranslation T uL) U, + ∃ t5Data : ExactTileInterfaceTriple T U V, + rightData.point = t5Data.point ∧ + incomingData.point ≠ t5Data.point ∧ + incomingData.otherCA = t5Data.point ∧ + rightData.otherCA = incomingData.point ∧ + t5Data.otherAB = incomingData.point + (∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q + i.succ) U → + BandPrototile + (q ((if Even s.val then i + 1 else i - 1).succ)) V → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (q ((i + 1).succ)) (q 0) - + BandVectors.1 (q 0) (q ((i + 1).succ)) + else + BandVectors.1 (q 0) (q ((i - 1).succ)) - + BandVectors.1 (q ((i - 1).succ)) (q 0))) → + pairedEndpointData i s U V))))))))))))))))) ) := by + classical + intro q cfg C₀ T cert endpointRelations pLit qLit literalData translated_sym literalSym pOdd + qOdd oddLiteralData g halfTurnComparison tripleRetarget qmul qneg qinj R obsId companionObs + obsTrans halfAtRoot evenPackage oddPackage + have retargetPackage (a b : GaussianInt) (P Q U V : ProtoTile) + (hP : P.cells = U.cells ∧ (P.cells = ∅ → P.anchor = U.anchor)) + (hQ : Q.cells = V.cells ∧ (Q.cells = ∅ → Q.anchor = V.anchor)) + (D : ExactTileInterfaceTriple T (TileTranslation T a) P) + (L : ExactTileInterfaceTriple T (TileTranslation T b) P) + (E : ExactTileInterfaceTriple T P Q) + (hp : D.point = E.point) (hne : L.point ≠ E.point) : + ∃ D' : ExactTileInterfaceTriple T (TileTranslation T a) U, + ∃ L' : ExactTileInterfaceTriple T (TileTranslation T b) U, + ∃ E' : ExactTileInterfaceTriple T U V, + D'.point = E'.point ∧ L'.point ≠ E'.point ∧ + L'.otherCA = E'.point ∧ D'.otherCA = L'.point ∧ E'.otherAB = L'.point := + PairedEndpointGeometry.retargetPackage T endpointRelations tripleRetarget obsId a + b P Q U V hP hQ D L E hp hne + have halfPackage (a b : GaussianInt) (P Q U V : ProtoTile) + (hP : (R (R P)).cells = U.cells ∧ ((R (R P)).cells = ∅ → (R (R P)).anchor = U.anchor)) + (hQ : (R (R Q)).cells = V.cells ∧ ((R (R Q)).cells = ∅ → (R (R Q)).anchor = V.anchor)) + (D : ExactTileInterfaceTriple T (TileTranslation T a) P) + (L : ExactTileInterfaceTriple T (TileTranslation T b) P) + (E : ExactTileInterfaceTriple T P Q) + (hp : D.point = E.point) (hne : L.point ≠ E.point) : + ∃ D' : ExactTileInterfaceTriple T (TileTranslation T (-a)) U, + ∃ L' : ExactTileInterfaceTriple T (TileTranslation T (-b)) U, + ∃ E' : ExactTileInterfaceTriple T U V, + D'.point = E'.point ∧ L'.point ≠ E'.point ∧ + L'.otherCA = E'.point ∧ D'.otherCA = L'.point ∧ E'.otherAB = L'.point := + PairedEndpointGeometry.halfPackage T endpointRelations g qinj + (PairedEndpointGeometry.halfCompanionObs T g qneg companionObs + (PairedEndpointGeometry.obsTurn g) obsTrans) + halfAtRoot a b P Q U V hP hQ D L E hp hne + have realAdd (a b : GaussianInt) : + GaussianRealPoint (a + b) = GaussianRealPoint a + GaussianRealPoint b := + PairedEndpointGeometry.realAdd a b + have realSub (a b : GaussianInt) : + GaussianRealPoint (a - b) = GaussianRealPoint a - GaussianRealPoint b := + PairedEndpointGeometry.realSub a b + have realNeg (a : GaussianInt) : GaussianRealPoint (-a) = -GaussianRealPoint a := by + ext <;> simp [GaussianRealPoint] + have compare (C : CircleCoordinates) (Y U : ProtoTile) + (hY : BandPrototile C Y) (hU : BandPrototile C U) + (hc : TileCentroid U - TileCentroid T = TileCentroid Y - TileCentroid T) : + Y.cells = U.cells ∧ (Y.cells = ∅ → Y.anchor = U.anchor) := + BandPrototileCentroidUnique C Y U hY hU (sub_left_injective hc.symm) + have flipAll (i : Fin 3) : BandVectors.1 (q 0) (q i.succ) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q i.succ) (q 0) := + (VectorRecursionLaws q cfg.proper.1).2.2.2.2 cfg.proper i |>.1 + have doubleFlip (i : Fin 3) : (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 0) (q i.succ) = + -BandVectors.1 (q i.succ) (q 0) := by rw [flipAll, ← qmul, ← qmul, qneg] + have ii2 : (⟨0, 1⟩ : GaussianInt) ^ 2 = -1 := by decide + have ii3 : (⟨0, 1⟩ : GaussianInt) ^ 3 = -(⟨0, 1⟩ : GaussianInt) := by decide + dsimp only + intro i s U V hU hV hcU hcV + fin_cases s + · simp only [show Even (0 : Nat) by decide, ite_true, pow_zero, one_mul] at hV hcU hcV + dsimp only + rw [ite_eq_left (show Even (0 : Nat) by decide), ite_eq_left (show Even (0 : Nat) by decide), + pow_zero, one_mul, one_mul] + obtain ⟨D, L, E, hp, hn⟩ := evenPackage i + have hP := compare _ _ _ (literalData i).1 hU (by + rw [(literalData i).2.2.1]; simpa only [realAdd] using hcU) + have hQ := compare _ _ _ (literalData i).2.1 hV (by + rw [(literalData i).2.2.2]; simpa only [realSub] using hcV) + exact retargetPackage _ _ _ _ _ _ hP hQ D L E hp hn + · simp only [show ¬ Even (1 : Nat) by decide, ite_false, pow_one] at hV hcU hcV + dsimp only + rw [ite_eq_right (show ¬ Even (1 : Nat) by decide), ite_eq_right (show ¬ Even (1 : Nat) + by decide), + pow_one, ← flipAll i, doubleFlip i] + obtain ⟨D, L, E, hp, hn⟩ := oddPackage i + have hP := compare _ _ _ (oddLiteralData i).1 hU (by + rw [(oddLiteralData i).2.2.1]; exact hcU) + have hQ := compare _ _ _ (oddLiteralData i).2.1 hV (by + rw [(oddLiteralData i).2.2.2]; exact hcV) + simpa only [← flipAll i, doubleFlip i] using + retargetPackage _ _ _ _ _ _ hP hQ D L E hp hn + · simp only [show Even (2 : Nat) by decide, ite_true, ii2, neg_one_mul] at hV hcU hcV + dsimp only + rw [ite_eq_left (show Even (2 : Nat) by decide), ite_eq_left (show Even (2 : Nat) by decide), + ii2, neg_one_mul, neg_one_mul] + obtain ⟨D, L, E, hp, hn⟩ := evenPackage i + have hP := halfTurnComparison _ _ _ (literalData i).1 (literalSym i).1 hU (by + rw [(literalData i).2.2.1] + simpa only [realNeg, realAdd, smul_neg] using hcU) + have hQ := halfTurnComparison _ _ _ (literalData i).2.1 (literalSym i).2 hV (by + rw [(literalData i).2.2.2] + simpa only [realNeg, realSub, smul_neg] using hcV) + exact halfPackage _ _ _ _ _ _ hP hQ D L E hp hn + · simp only [show ¬ Even (3 : Nat) by decide, ite_false, ii3] at hV hcU hcV + dsimp only + rw [ite_eq_right (show ¬ Even (3 : Nat) by decide), ite_eq_right (show ¬ Even (3 : Nat) + by decide), + ii3, neg_mul, neg_mul, ← flipAll i, doubleFlip i, neg_neg] + obtain ⟨D, L, E, hp, hn⟩ := oddPackage i + have hP := halfTurnComparison _ _ _ (oddLiteralData i).1 + (translated_sym _ _ (cert.parent_quarter_turn i false)) hU (by + rw [(oddLiteralData i).2.2.1] + simpa only [neg_mul, realNeg, smul_neg] using hcU) + have hQ := halfTurnComparison _ _ _ (oddLiteralData i).2.1 + (translated_sym _ _ (cert.parent_quarter_turn (i - 1) false)) hV (by + rw [(oddLiteralData i).2.2.2] + simpa only [neg_mul, realNeg, smul_neg] using hcV) + have H := halfPackage _ _ _ _ _ _ hP hQ D L E hp hn + rw [neg_neg] at H + exact H + +end PairedEndpointCertificate + +theorem P1BandOrderedGeneralMixedAggregatePairedEndpoints + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) + (hsym : QuarterTurnSymmetric T) : + let pairedEndpointData : Fin 3 → Fin 4 → ProtoTile → ProtoTile → Prop := + fun i s U V ↦ + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) + let uL := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q i.succ) (q 0) + else BandVectors.1 (q 0) (q i.succ)) + ∃ rightData : ExactTileInterfaceTriple T + (TileTranslation T uR) U, + ∃ incomingData : ExactTileInterfaceTriple T + (TileTranslation T uL) U, + ∃ t5Data : ExactTileInterfaceTriple T U V, + rightData.point = t5Data.point ∧ + incomingData.point ≠ t5Data.point ∧ + incomingData.otherCA = t5Data.point ∧ + rightData.otherCA = incomingData.point ∧ + t5Data.otherAB = incomingData.point + (∀ (i : Fin 3) (s : Fin 4) (U V : ProtoTile), + BandPrototile (q i.succ) U → + BandPrototile + (q ((if Even s.val then i + 1 else i - 1).succ)) V → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (q ((i + 1).succ)) (q 0) - + BandVectors.1 (q 0) (q ((i + 1).succ)) + else + BandVectors.1 (q 0) (q ((i - 1).succ)) - + BandVectors.1 (q ((i - 1).succ)) (q 0))) → + pairedEndpointData i s U V) := by +-- BODY + have junctions := P1BandOrderedGeneralMixedAggregateJunctionData q cfg C₀ T cert hsym + have incoming := PairedEndpointGeometry.incoming q T junctions + have evenT5 := PairedEndpointGeometry.evenT5 q T junctions + have endpointRelations := PairedEndpointGeometry.endpointRelations T + let pLit (i : Fin 3) := TileTranslation (cert.P i true) + (if i = 0 then -cert.v else if i = 1 then cert.u + cert.v else -cert.u) + let qLit (i : Fin 3) := TileTranslation (cert.P (i + 1) true) + (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) + let markedPoint (i : Fin 3) := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm + ⟨.J5, if i = 2 then -1 else 0, if i = 1 then 0 else -1⟩) + have literalData (i : Fin 3) : + BandPrototile (q i.succ) (pLit i) ∧ + BandPrototile (q ((i + 1).succ)) (qLit i) ∧ + TileCentroid (pLit i) - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) ∧ + TileCentroid (qLit i) - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ)))) := + PairedEndpointGeometry.literalData q cfg C₀ T cert i + have translated_sym (Y : ProtoTile) (a : GaussianInt) + (hY : QuarterTurnSymmetric Y) : QuarterTurnSymmetric (TileTranslation Y a) := + PairedEndpointGeometry.translated_sym Y a hY + have literalSym (i : Fin 3) : QuarterTurnSymmetric (pLit i) ∧ + QuarterTurnSymmetric (qLit i) := + ⟨translated_sym _ _ (cert.parent_quarter_turn i true), + translated_sym _ _ (cert.parent_quarter_turn (i + 1) true)⟩ + -- Keep a translated band-prototile proxy for each geometric centered turn. + have centeredProxy := PairedEndpointGeometry.centeredProxy translated_sym + have halfTurnProxy := PairedEndpointGeometry.halfTurnProxy centeredProxy + have period3 := PairedEndpointGeometry.period3 q + cfg C₀ T cert + have unrotated := PairedEndpointGeometry.unrotated q cfg C₀ T cert incoming evenT5 literalData + (PairedEndpointGeometry.markedMembership q cfg C₀ T cert period3) + let pOdd (i : Fin 3) := TileTranslation (cert.P i false) + (if i = 0 then cert.u + cert.v else if i = 1 then -cert.u else -cert.v) + let qOdd (i : Fin 3) := TileTranslation (cert.P (i - 1) false) + (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) + let oddPoint (i : Fin 3) := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm + ⟨.J6, if i = 0 then 1 else 0, if i = 2 then 0 else 1⟩) + have signedNeg := PairedEndpointGeometry.signedNeg + have oddLiteralData (i : Fin 3) : + BandPrototile (q i.succ) (pOdd i) ∧ + BandPrototile (q ((i - 1).succ)) (qOdd i) ∧ + TileCentroid (pOdd i) - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * + (BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ))) ∧ + TileCentroid (qOdd i) - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * + (BandVectors.1 (q 0) (q ((i - 1).succ)) - + BandVectors.1 (q ((i - 1).succ)) (q 0))) := PairedEndpointGeometry.oddLiteralData q + cfg C₀ T cert literalData signedNeg (PairedEndpointGeometry.oddFormulaU) + (PairedEndpointGeometry.oddFormulaV) i + have oddPoints := PairedEndpointGeometry.oddPoints q cfg C₀ T cert oddLiteralData + (PairedEndpointGeometry.oddMembership q cfg C₀ T cert period3) + obtain ⟨g, hg, hTcells, hTanchor, hTfoot, hTcent⟩ := + QuarterTurnSymmetricCenteredTransport T hsym + have halfTurnComparison (C : CircleCoordinates) (Y U : ProtoTile) + (hY : BandPrototile C Y) (hYsym : QuarterTurnSymmetric Y) + (hU : BandPrototile C U) + (hcentU : TileCentroid U - TileCentroid T = + -(TileCentroid Y - TileCentroid T)) : + (TileTranslation (TileQuarterTurn + (TileTranslation (TileQuarterTurn Y) g)) g).cells = U.cells ∧ + ((TileTranslation (TileQuarterTurn + (TileTranslation (TileQuarterTurn Y) g)) g).cells = ∅ → + (TileTranslation (TileQuarterTurn + (TileTranslation (TileQuarterTurn Y) g)) g).anchor = U.anchor) := + PairedEndpointGeometry.halfTurnComparison T halfTurnProxy g hg C Y U hY hYsym hU + hcentU + have tripleRetarget := PairedEndpointGeometry.tripleRetarget + have tripleTurn := PairedEndpointGeometry.tripleTurn (PairedEndpointGeometry.tripleMap + (PairedEndpointGeometry.pathMap)) + have turnTranslate := PairedEndpointGeometry.turnTranslate + have obsTranslate := PairedEndpointGeometry.obsTranslate + -- A fixed common vertex would force all four incident cells into the parent. + -- Three centered turns about the parent exchange the two child supports. + have markedFromIncoming := PairedEndpointGeometry.markedFromIncoming + (PairedEndpointGeometry.translateZero) (PairedEndpointGeometry.swapFirst) + (PairedEndpointGeometry.parentTurn tripleRetarget tripleTurn turnTranslate obsTranslate) + (PairedEndpointGeometry.fixedPointNotCommon) + have qmul (w : GaussianInt) : GaussianQuarterTurn w = (⟨0, 1⟩ : GaussianInt) * w := by + ext <;> simp [GaussianQuarterTurn] + have qneg (w : GaussianInt) : GaussianQuarterTurn (GaussianQuarterTurn w) = -w := by + ext <;> simp [GaussianQuarterTurn] + have qinj := PairedEndpointGeometry.qinj + let R (Y : ProtoTile) := TileTranslation (TileQuarterTurn Y) g + have rootObs : (R T).cells = T.cells ∧ ((R T).cells = ∅ → (R T).anchor = T.anchor) := + ⟨hTcells, fun he => hTanchor (hTcells ▸ he)⟩ + have obsId (Y : ProtoTile) : Y.cells = Y.cells ∧ (Y.cells = ∅ → Y.anchor = Y.anchor) := + ⟨rfl, fun _ => rfl⟩ + have turnAtRoot := PairedEndpointGeometry.turnAtRoot T g tripleRetarget tripleTurn rootObs + have companionObs := PairedEndpointGeometry.companionObs T g turnTranslate obsTranslate rootObs + have obsTrans (X Y Z : ProtoTile) + (h : X.cells = Y.cells ∧ (X.cells = ∅ → X.anchor = Y.anchor)) + (k : Y.cells = Z.cells ∧ (Y.cells = ∅ → Y.anchor = Z.anchor)) : + X.cells = Z.cells ∧ (X.cells = ∅ → X.anchor = Z.anchor) := + ⟨h.1.trans k.1, fun he => (h.2 he).trans (k.2 (h.1 ▸ he))⟩ + have halfAtRoot := PairedEndpointGeometry.halfAtRoot T g obsId turnAtRoot + have evenPackage (i : Fin 3) : + ∃ rightData : ExactTileInterfaceTriple T + (TileTranslation T (BandVectors.1 (q 0) (q i.succ))) (pLit i), + ∃ incomingData : ExactTileInterfaceTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) (pLit i), + ∃ t5Data : ExactTileInterfaceTriple T (pLit i) (qLit i), + rightData.point = t5Data.point ∧ incomingData.point ≠ t5Data.point := + PairedEndpointGeometry.evenPackage q cfg C₀ T cert hsym junctions literalData + literalSym unrotated markedFromIncoming qmul i + have oddPackage (i : Fin 3) : + ∃ rightData : ExactTileInterfaceTriple T + (TileTranslation T (BandVectors.1 (q 0) (q i.succ))) (pOdd i), + ∃ incomingData : ExactTileInterfaceTriple T + (TileTranslation T (-BandVectors.1 (q i.succ) (q 0))) (pOdd i), + ∃ t5Data : ExactTileInterfaceTriple T (pOdd i) (qOdd i), + rightData.point = t5Data.point ∧ incomingData.point ≠ t5Data.point := + PairedEndpointGeometry.oddPackage q cfg C₀ T cert hsym junctions incoming evenT5 + literalData translated_sym literalSym signedNeg oddLiteralData oddPoints g + (PairedEndpointGeometry.centeredComparison T centeredProxy g hg) + halfTurnComparison markedFromIncoming qmul qneg rootObs + turnAtRoot companionObs halfAtRoot (PairedEndpointGeometry.turnDisjoint g qinj) i + have completePackages : + let pairedEndpointData : Fin 3 → Fin 4 → ProtoTile → ProtoTile → Prop := + fun i s U V ↦ + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) + let uL := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q i.succ) (q 0) + else BandVectors.1 (q 0) (q i.succ)) + ∃ rightData : ExactTileInterfaceTriple T + (TileTranslation T uR) U, + ∃ incomingData : ExactTileInterfaceTriple T + (TileTranslation T uL) U, + ∃ t5Data : ExactTileInterfaceTriple T U V, + rightData.point = t5Data.point ∧ + incomingData.point ≠ t5Data.point ∧ + incomingData.otherCA = t5Data.point ∧ + rightData.otherCA = incomingData.point ∧ + t5Data.otherAB = incomingData.point + (∀ (i : Fin 3) (s : Fin 4) (U V : ProtoTile), + BandPrototile (q i.succ) U → + BandPrototile + (q ((if Even s.val then i + 1 else i - 1).succ)) V → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (q ((i + 1).succ)) (q 0) - + BandVectors.1 (q 0) (q ((i + 1).succ)) + else + BandVectors.1 (q 0) (q ((i - 1).succ)) - + BandVectors.1 (q ((i - 1).succ)) (q 0))) → + pairedEndpointData i s U V) := PairedEndpointCertificate.completePackages q cfg C₀ T cert + endpointRelations literalData translated_sym literalSym oddLiteralData g + halfTurnComparison tripleRetarget qmul qneg qinj obsId companionObs obsTrans halfAtRoot + evenPackage oddPackage + exact completePackages + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P2999T1CompleteSquareTransport.lean b/LeanPool/ApollonianSuperharmonic/P2999T1CompleteSquareTransport.lean new file mode 100644 index 0000000000..9ef3a808f9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P2999T1CompleteSquareTransport.lean @@ -0,0 +1,124 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares + +-- [TABLET NODE: P2999T1CompleteSquareTransport] + +/-! +# P2999T1CompleteSquareTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P2999T1CompleteSquareTransport (g : BandPackingSymmetry) (h : PartialOdometer) (T : + ProtoTile) + (hT : PartialOdometerSquares h = T.cells) : + PartialOdometerSquares (BandPackingSymmetryPartialOdometerAction g h) = + (BandPackingSymmetryTileAction g T).cells := by +-- BODY + classical + have invN (x : GaussianInt) : -GaussianQuarterTurn (GaussianQuarterTurn x) = x := by + ext <;> simp [GaussianQuarterTurn] + have invK (x : GaussianInt) : -GaussianReflection (-GaussianReflection x) = x := by + ext <;> simp [GaussianReflection] + have memN (h : PartialOdometer) (x : GaussianInt) : + x ∈ (BandPackingSymmetryPartialOdometerAction .negate h).domain ↔ + -GaussianQuarterTurn x ∈ h.domain := by + change x ∈ h.domain.image GaussianQuarterTurn ↔ _ + constructor + · rintro hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx + simpa [invN] using hy + · intro hx + refine Finset.mem_image.mpr ⟨-GaussianQuarterTurn x, hx, ?_⟩ + ext <;> simp [GaussianQuarterTurn] + have memK (h : PartialOdometer) (x : GaussianInt) : + x ∈ (BandPackingSymmetryPartialOdometerAction .conjugate h).domain ↔ + -GaussianReflection x ∈ h.domain := by + change x ∈ h.domain.image (fun y => -GaussianReflection y) ↔ _ + constructor + · rintro hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx + simpa [invK] using hy + · intro hx + exact Finset.mem_image.mpr ⟨-GaussianReflection x, hx, invK x⟩ + have sqN (h : PartialOdometer) : + PartialOdometerSquares (BandPackingSymmetryPartialOdometerAction .negate h) = + (PartialOdometerSquares h).image (fun x => GaussianQuarterTurn x - 1) := by + have corner (x : GaussianInt) : + -GaussianQuarterTurn (GaussianQuarterTurn x - 1) = x + ⟨0, 1⟩ ∧ + -GaussianQuarterTurn (GaussianQuarterTurn x - 1 + 1) = x ∧ + -GaussianQuarterTurn (GaussianQuarterTurn x - 1 + ⟨0, 1⟩) = x + 1 + ⟨0, 1⟩ ∧ + -GaussianQuarterTurn (GaussianQuarterTurn x - 1 + 1 + ⟨0, 1⟩) = x + 1 := by + refine ⟨?_, ?_, ?_, ?_⟩ <;> ext <;> simp [GaussianQuarterTurn, add_comm] + have sm (x : GaussianInt) : + GaussianQuarterTurn x - 1 ∈ + PartialOdometerSquares (BandPackingSymmetryPartialOdometerAction .negate h) ↔ + x ∈ PartialOdometerSquares h := by + simp only [PartialOdometerSquares, Finset.mem_filter, memN, + (corner x).1, (corner x).2.1, (corner x).2.2.1, (corner x).2.2.2] + tauto + ext y + constructor + · intro hy + have eq : GaussianQuarterTurn (-GaussianQuarterTurn (y + 1)) - 1 = y := by + ext <;> simp [GaussianQuarterTurn] + exact Finset.mem_image.mpr ⟨-GaussianQuarterTurn (y + 1), + (sm _).mp (by simpa only [eq] using hy), eq⟩ + · intro hy + obtain ⟨x, hx, rfl⟩ := Finset.mem_image.mp hy + exact (sm x).mpr hx + have sqK (h : PartialOdometer) : + PartialOdometerSquares (BandPackingSymmetryPartialOdometerAction .conjugate h) = + (PartialOdometerSquares h).image (fun x => -GaussianReflection x - 1) := by + have corner (x : GaussianInt) : + -GaussianReflection (-GaussianReflection x - 1) = x + 1 ∧ + -GaussianReflection (-GaussianReflection x - 1 + 1) = x ∧ + -GaussianReflection (-GaussianReflection x - 1 + ⟨0, 1⟩) = x + 1 + ⟨0, 1⟩ ∧ + -GaussianReflection (-GaussianReflection x - 1 + 1 + ⟨0, 1⟩) = x + ⟨0, 1⟩ := by + refine ⟨?_, ?_, ?_, ?_⟩ <;> ext <;> simp [GaussianReflection, add_comm] + have sm (x : GaussianInt) : + -GaussianReflection x - 1 ∈ + PartialOdometerSquares (BandPackingSymmetryPartialOdometerAction .conjugate h) ↔ + x ∈ PartialOdometerSquares h := by + simp only [PartialOdometerSquares, Finset.mem_filter, memK, + (corner x).1, (corner x).2.1, (corner x).2.2.1, (corner x).2.2.2] + tauto + ext y + constructor + · intro hy + have eq : -GaussianReflection (-GaussianReflection y - 1) - 1 = y := by + ext <;> simp [GaussianReflection] + exact Finset.mem_image.mpr ⟨-GaussianReflection y - 1, + (sm _).mp (by simpa only [eq] using hy), eq⟩ + · intro hy + obtain ⟨x, hx, rfl⟩ := Finset.mem_image.mp hy + exact (sm x).mpr hx + induction g generalizing h T with + | identity => exact hT + | shift w => exact hT + | negate => simpa only [hT, BandPackingSymmetryTileAction, TileQuarterTurn] using sqN h + | conjugate => + rw [sqK, hT] + simp only [BandPackingSymmetryTileAction, TileQuarterTurn, TileReflection, + Finset.image_image] + congr 1 + funext x + ext <;> simp [GaussianQuarterTurn, GaussianReflection] + | comp a b ia ib => exact ia _ _ (ib h T hT) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P2999T1OrthogonalSlopeTransport.lean b/LeanPool/ApollonianSuperharmonic/P2999T1OrthogonalSlopeTransport.lean new file mode 100644 index 0000000000..e345db5386 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P2999T1OrthogonalSlopeTransport.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P2999T1CompleteSquareTransport +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope + +-- [TABLET NODE: P2999T1OrthogonalSlopeTransport] + +/-! +# P2999T1OrthogonalSlopeTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P2999T1OrthogonalSlopeTransport (h : PartialOdometer) : + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction .negate h) = + (PartialOdometerSlope h).map (fun p => (-p.2, p.1)) ∧ + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction .conjugate h) = + (PartialOdometerSlope h).map (fun p => (-p.1, p.2)) := by +-- BODY + classical + let H (h : PartialOdometer) (x : GaussianInt) : ℝ := + (h.value (x + 1) - h.value x + h.value (x + 1 + ⟨0, 1⟩) - + h.value (x + ⟨0, 1⟩) : ℤ) + let V (h : PartialOdometer) (x : GaussianInt) : ℝ := + (h.value (x + ⟨0, 1⟩) - h.value x + h.value (x + 1 + ⟨0, 1⟩) - + h.value (x + 1) : ℤ) + have average (h' : PartialOdometer) (f : GaussianInt → GaussianInt) (b : Bool) + (sq : PartialOdometerSquares h' = (PartialOdometerSquares h).image f) + (inj : Function.Injective f) + (grad : ∀ x ∈ PartialOdometerSquares h, + H h' (f x) = -(if b then V h x else H h x) ∧ + V h' (f x) = (if b then H h x else V h x)) : + PartialOdometerSlope h' = (PartialOdometerSlope h).map + (fun p => if b then (-p.2, p.1) else (-p.1, p.2)) := by + change (if (PartialOdometerSquares h').Nonempty then + some ((∑ x ∈ PartialOdometerSquares h', H h' x) / + (2 * ((PartialOdometerSquares h').card : ℝ)), + (∑ x ∈ PartialOdometerSquares h', V h' x) / + (2 * ((PartialOdometerSquares h').card : ℝ))) else none) = _ + rw [sq] + by_cases hs : (PartialOdometerSquares h).Nonempty + · have hs' := hs.image f + simp only [hs', ↓reduceIte, PartialOdometerSlope, hs, Option.map_some] + rw [Finset.card_image_of_injective _ inj, + Finset.sum_image inj.injOn, Finset.sum_image inj.injOn] + have hh : (∑ x ∈ PartialOdometerSquares h, H h' (f x)) = + ∑ x ∈ PartialOdometerSquares h, -(if b then V h x else H h x) := + Finset.sum_congr rfl (fun x hx => (grad x hx).1) + have hv : (∑ x ∈ PartialOdometerSquares h, V h' (f x)) = + ∑ x ∈ PartialOdometerSquares h, (if b then H h x else V h x) := + Finset.sum_congr rfl (fun x hx => (grad x hx).2) + rw [hh, hv] + cases b <;> simp only [Bool.false_eq_true, ↓reduceIte, + Finset.sum_neg_distrib, neg_div, H, V] + · simp [hs, PartialOdometerSlope] + have valN (x : GaussianInt) : + (BandPackingSymmetryPartialOdometerAction .negate h).value x = + h.value (-GaussianQuarterTurn x) := by + change (if x ∈ h.domain.image GaussianQuarterTurn then _ else 0) = _ + split + · rfl + · rename_i hx + symm + apply h.value_outside + intro hm + apply hx + refine Finset.mem_image.mpr ⟨-GaussianQuarterTurn x, hm, ?_⟩ + ext <;> simp [GaussianQuarterTurn] + have valK (x : GaussianInt) : + (BandPackingSymmetryPartialOdometerAction .conjugate h).value x = + h.value (-GaussianReflection x) := by + change (if x ∈ h.domain.image (fun y => -GaussianReflection y) then _ else 0) = _ + split + · rfl + · rename_i hx + symm + apply h.value_outside + intro hm + apply hx + refine Finset.mem_image.mpr ⟨-GaussianReflection x, hm, ?_⟩ + ext <;> simp [GaussianReflection] + constructor + · apply average _ (fun x => GaussianQuarterTurn x - 1) true + · exact P2999T1CompleteSquareTransport .negate h ⟨PartialOdometerSquares h, 0⟩ rfl + · intro x y he + have he' := congrArg (fun z => -GaussianQuarterTurn (z + 1)) he + ext + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.re) he' + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.im) he' + · intro x hx + have corners : + -GaussianQuarterTurn (GaussianQuarterTurn x - 1) = x + ⟨0, 1⟩ ∧ + -GaussianQuarterTurn (GaussianQuarterTurn x - 1 + 1) = x ∧ + -GaussianQuarterTurn (GaussianQuarterTurn x - 1 + ⟨0, 1⟩) = x + 1 + ⟨0, 1⟩ ∧ + -GaussianQuarterTurn (GaussianQuarterTurn x - 1 + 1 + ⟨0, 1⟩) = x + 1 := by + refine ⟨?_, ?_, ?_, ?_⟩ <;> ext <;> simp [GaussianQuarterTurn, add_comm] + simp only [H, V, valN, corners.1, corners.2.1, corners.2.2.1, + corners.2.2.2, ↓reduceIte] + constructor <;> push_cast <;> ring + · apply average _ (fun x => -GaussianReflection x - 1) false + · have sq := P2999T1CompleteSquareTransport .conjugate h + ⟨PartialOdometerSquares h, 0⟩ rfl + simp only [BandPackingSymmetryTileAction, TileQuarterTurn, TileReflection, + Finset.image_image] at sq + convert sq using 1 + congr 1 + funext x + ext <;> simp [GaussianQuarterTurn, GaussianReflection] + · intro x y he + have he' := congrArg (fun z => -GaussianReflection z - 1) he + ext + · simpa [GaussianReflection] using congrArg (fun z : GaussianInt => z.re) he' + · simpa [GaussianReflection] using congrArg (fun z : GaussianInt => z.im) he' + · intro x hx + have corners : + -GaussianReflection (-GaussianReflection x - 1) = x + 1 ∧ + -GaussianReflection (-GaussianReflection x - 1 + 1) = x ∧ + -GaussianReflection (-GaussianReflection x - 1 + ⟨0, 1⟩) = x + 1 + ⟨0, 1⟩ ∧ + -GaussianReflection (-GaussianReflection x - 1 + 1 + ⟨0, 1⟩) = x + ⟨0, 1⟩ := by + refine ⟨?_, ?_, ?_, ?_⟩ <;> ext <;> simp [GaussianReflection, add_comm] + simp only [H, V, valK, corners.1, corners.2.1, corners.2.2.1, + corners.2.2.2, Bool.false_eq_true, ↓reduceIte] + constructor <;> push_cast <;> ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P2999T1ShiftSlopeTransport.lean b/LeanPool/ApollonianSuperharmonic/P2999T1ShiftSlopeTransport.lean new file mode 100644 index 0000000000..8cefeb706b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P2999T1ShiftSlopeTransport.lean @@ -0,0 +1,141 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction +public import Mathlib.Tactic.LinearCombination + +-- [TABLET NODE: P2999T1ShiftSlopeTransport] + +/-! +# P2999T1ShiftSlopeTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P2999T1ShiftSlopeTransport (h : PartialOdometer) (w : GaussianInt) (T : ProtoTile) + (hne : T.cells.Nonempty) (hT : PartialOdometerSquares h = T.cells) : + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction (.shift w) h) = + (PartialOdometerSlope h).map (BandPackingSymmetrySlopeAction (.shift w) T) := by +-- BODY + classical + have triangular (n : ℤ) : (n + 1) * (n + 1 - 1) / 2 = n * (n - 1) / 2 + n := by + rw [show (n + 1) * (n + 1 - 1) = n * (n - 1) + n * 2 by ring] + exact Int.add_mul_ediv_right _ _ (by norm_num) + have dx (x : GaussianInt) : + BandPackingShiftPotential w (x + 1) - BandPackingShiftPotential w x = + w.re * x.re + w.im * x.im := by + simp only [BandPackingShiftPotential, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, add_zero] + rw [triangular] + ring + have dy (x : GaussianInt) : + BandPackingShiftPotential w (x + ⟨0, 1⟩) - BandPackingShiftPotential w x = + -w.re * x.im + w.im * x.re := by + simp only [BandPackingShiftPotential, Zsqrtd.re_add, Zsqrtd.im_add, add_zero] + rw [triangular] + ring + have value (x : GaussianInt) (hx : x ∈ h.domain) : + (BandPackingSymmetryPartialOdometerAction (.shift w) h).value x = + h.value x + BandPackingShiftPotential w x := by + simp [BandPackingSymmetryPartialOdometerAction, hx] + let H (h : PartialOdometer) (x : GaussianInt) : ℝ := + (h.value (x + 1) - h.value x + h.value (x + 1 + ⟨0, 1⟩) - + h.value (x + ⟨0, 1⟩) : ℤ) + let V (h : PartialOdometer) (x : GaussianInt) : ℝ := + (h.value (x + ⟨0, 1⟩) - h.value x + h.value (x + 1 + ⟨0, 1⟩) - + h.value (x + 1) : ℤ) + have horizontal (x : GaussianInt) (hx : x ∈ PartialOdometerSquares h) : + H (BandPackingSymmetryPartialOdometerAction (.shift w) h) x = + H h x + 2 * (w.re : ℝ) * x.re + (w.im : ℝ) * (2 * x.im + 1) := by + obtain ⟨hx0, hx1, hxi, hx1i⟩ := Finset.mem_filter.mp hx + dsimp only [H] + rw [value _ hx1, value _ hx0, value _ hx1i, value _ hxi] + have e : + BandPackingShiftPotential w (x + 1) - BandPackingShiftPotential w x + + BandPackingShiftPotential w (x + 1 + ⟨0, 1⟩) - + BandPackingShiftPotential w (x + ⟨0, 1⟩) = + 2 * w.re * x.re + w.im * (2 * x.im + 1) := by + rw [show x + 1 + ⟨0, 1⟩ = (x + ⟨0, 1⟩) + 1 by abel] + calc + _ = (BandPackingShiftPotential w (x + 1) - BandPackingShiftPotential w x) + + (BandPackingShiftPotential w ((x + ⟨0, 1⟩) + 1) - + BandPackingShiftPotential w (x + ⟨0, 1⟩)) := by ring + _ = _ := by rw [dx, dx]; simp; ring + have intEq : + h.value (x + 1) + BandPackingShiftPotential w (x + 1) - + (h.value x + BandPackingShiftPotential w x) + + (h.value (x + 1 + ⟨0, 1⟩) + BandPackingShiftPotential w (x + 1 + ⟨0, 1⟩)) - + (h.value (x + ⟨0, 1⟩) + BandPackingShiftPotential w (x + ⟨0, 1⟩)) = + (h.value (x + 1) - h.value x + h.value (x + 1 + ⟨0, 1⟩) - + h.value (x + ⟨0, 1⟩)) + (2 * w.re * x.re + w.im * (2 * x.im + 1)) := by + linear_combination e + rw [intEq] + push_cast + ring + have vertical (x : GaussianInt) (hx : x ∈ PartialOdometerSquares h) : + V (BandPackingSymmetryPartialOdometerAction (.shift w) h) x = + V h x - 2 * (w.re : ℝ) * x.im + (w.im : ℝ) * (2 * x.re + 1) := by + obtain ⟨hx0, hx1, hxi, hx1i⟩ := Finset.mem_filter.mp hx + dsimp only [V] + rw [value _ hxi, value _ hx0, value _ hx1i, value _ hx1] + have e : + BandPackingShiftPotential w (x + ⟨0, 1⟩) - BandPackingShiftPotential w x + + BandPackingShiftPotential w (x + 1 + ⟨0, 1⟩) - + BandPackingShiftPotential w (x + 1) = + -2 * w.re * x.im + w.im * (2 * x.re + 1) := by + calc + _ = (BandPackingShiftPotential w (x + ⟨0, 1⟩) - BandPackingShiftPotential w x) + + (BandPackingShiftPotential w ((x + 1) + ⟨0, 1⟩) - + BandPackingShiftPotential w (x + 1)) := by ring + _ = _ := by rw [dy, dy]; simp; ring + have intEq : + h.value (x + ⟨0, 1⟩) + BandPackingShiftPotential w (x + ⟨0, 1⟩) - + (h.value x + BandPackingShiftPotential w x) + + (h.value (x + 1 + ⟨0, 1⟩) + BandPackingShiftPotential w (x + 1 + ⟨0, 1⟩)) - + (h.value (x + 1) + BandPackingShiftPotential w (x + 1)) = + (h.value (x + ⟨0, 1⟩) - h.value x + h.value (x + 1 + ⟨0, 1⟩) - + h.value (x + 1)) + (-2 * w.re * x.im + w.im * (2 * x.re + 1)) := by + linear_combination e + rw [intEq] + push_cast + ring + have hs : (PartialOdometerSquares h).Nonempty := hT.symm ▸ hne + have sq : PartialOdometerSquares (BandPackingSymmetryPartialOdometerAction (.shift w) h) = + PartialOdometerSquares h := rfl + have hc : ((PartialOdometerSquares h).card : ℝ) ≠ 0 := by + exact_mod_cast (Nat.ne_of_gt hs.card_pos) + simp only [PartialOdometerSlope, sq, hs, ↓reduceIte, Option.map_some, + BandPackingSymmetrySlopeAction, TileCentroid, hne] + change some ((∑ x ∈ PartialOdometerSquares h, + H (BandPackingSymmetryPartialOdometerAction (.shift w) h) x) / + (2 * ((PartialOdometerSquares h).card : ℝ)), + (∑ x ∈ PartialOdometerSquares h, + V (BandPackingSymmetryPartialOdometerAction (.shift w) h) x) / + (2 * ((PartialOdometerSquares h).card : ℝ))) = _ + have sh := Finset.sum_congr rfl horizontal + have sv := Finset.sum_congr rfl vertical + rw [sh, sv, ← hT] + congr 1 + ext + all_goals + dsimp only [H, V] + push_cast + simp only [mul_add, Finset.sum_add_distrib, Finset.sum_sub_distrib, + ← Finset.mul_sum, Finset.sum_const, nsmul_eq_mul] + field_simp [hc] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3019T1ChamberSegmentOrder.lean b/LeanPool/ApollonianSuperharmonic/P3019T1ChamberSegmentOrder.lean new file mode 100644 index 0000000000..0036989d69 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3019T1ChamberSegmentOrder.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3019T1ChamberStripGeometry +public import Mathlib.Data.List.Chain +public import Mathlib.Data.List.Pairwise + +-- [TABLET NODE: P3019T1ChamberSegmentOrder] + +/-! +# P3019T1ChamberSegmentOrder + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3019T1ChamberSegmentOrder + (x : Int × Int) (r s : Int) (hr : 0 < r) (hs : 0 ≤ s ∧ s ≤ r) + (path : List (Int × Int)) + (hpath : TriangularStripSegment x (x + (r, s)) path) : + path.IsChain (fun z y => y.1 = z.1 + 1) ∧ + path.Pairwise (fun z y => z.1 < y.1) ∧ + (∀ z ∈ path, x.1 ≤ z.1 ∧ z.1 ≤ x.1 + r) ∧ + (∀ z ∈ path.dropLast, z.1 < x.1 + r) := by +-- BODY + have hxy : x ≠ x + (r, s) := by + intro he + have := congrArg Prod.fst he + simp only [Prod.fst_add] at this + omega + have hdata : path.head? = some x ∧ path.getLast? = some (x + (r, s)) ∧ + path.Nodup ∧ (∀ z ∈ path, TriangularBoundaryStrip x (x + (r, s)) z) ∧ + path.IsChain TriangularLatticeAdjacent := by + simpa [TriangularStripSegment, hxy, List.IsChain] using hpath + have hgeom := P3019T1ChamberStripGeometry x r s hr hs + have hinj : ∀ z ∈ path, ∀ y ∈ path, z.1 = y.1 → z = y := by + intro z hz y hy he + exact hgeom.2.2.1 z y (hdata.2.2.2.1 z hz) (hdata.2.2.2.1 y hy) he + have hsteps : path.IsChain (fun z y => y.1 = z.1 + 1 ∨ z.1 = y.1 + 1) := by + apply hdata.2.2.2.2.imp_of_mem_imp + intro z y hz hy hadj + have hn := (hgeom.2.2.2 z (hdata.2.2.2.1 z hz) y).mp + ⟨hadj, hdata.2.2.2.1 y hy⟩ + rcases hn with ⟨he, _⟩ | ⟨he, _⟩ | ⟨he, _⟩ | ⟨he, _⟩ + all_goals simp [he, add_assoc] + have walk : ∀ p : List Int, p.Nodup → + p.IsChain (fun u v => v = u + 1 ∨ u = v + 1) → + p.IsChain (fun u v => v = u + 1) ∨ + p.IsChain (fun u v => u = v + 1) := by + intro p + induction p with + | nil => intro _ _; exact Or.inl List.IsChain.nil + | cons a l ih => + intro hn hc + cases l with + | nil => exact Or.inl (List.IsChain.singleton a) + | cons b t => + have hnot := (List.nodup_cons.mp hn).1 + have hstep := hc.rel + rcases ih (List.nodup_cons.mp hn).2 hc.tail with hi | hd + · rcases hstep with hp | hm + · exact Or.inl (hi.cons_cons hp) + · cases t with + | nil => exact Or.inr ((List.IsChain.singleton b).cons_cons hm) + | cons c rest => + have hbc := hi.rel + have he : a = c := by omega + exact False.elim (hnot (by simp [he])) + · rcases hstep with hp | hm + · cases t with + | nil => exact Or.inl ((List.IsChain.singleton b).cons_cons hp) + | cons c rest => + have hbc := hd.rel + have he : a = c := by omega + exact False.elim (hnot (by simp [he])) + · exact Or.inr (hd.cons_cons hm) + have hindnodup : (path.map Prod.fst).Nodup := hdata.2.2.1.map_on hinj + have hindchain : (path.map Prod.fst).IsChain + (fun u v : Int => v = u + 1 ∨ u = v + 1) := + (List.isChain_map _).mpr hsteps + have hxmem : x ∈ path := List.mem_of_mem_head? (by simp [hdata.1]) + have hymem : x + (r, s) ∈ path := List.mem_of_getLast? hdata.2.1 + have hne : path ≠ [] := List.ne_nil_of_mem hxmem + have hhead : path.head hne = x := + Option.some.inj ((List.head?_eq_some_head hne).symm.trans hdata.1) + have hlast : path.getLast hne = x + (r, s) := + Option.some.inj ((List.getLast?_eq_some_getLast hne).symm.trans hdata.2.1) + have hforward : path.IsChain (fun z y => y.1 = z.1 + 1) := by + rcases walk _ hindnodup hindchain with hi | hd + · exact (List.isChain_map _).mp hi + · have hback : path.IsChain (fun z y => y.1 ≤ z.1) := + ((List.isChain_map _).mp hd).imp (by intro z y he; omega) + have : Trans (fun z y : Int × Int => y.1 ≤ z.1) + (fun z y : Int × Int => y.1 ≤ z.1) + (fun z y : Int × Int => y.1 ≤ z.1) := + ⟨fun h₁ h₂ => le_trans h₂ h₁⟩ + have hh := hback.pairwise.rel_head_of_rel_head_head hymem (le_refl _) + rw [hhead] at hh + simp only [Prod.fst_add] at hh + omega + have : Trans (fun z y : Int × Int => z.1 < y.1) + (fun z y : Int × Int => z.1 < y.1) + (fun z y : Int × Int => z.1 < y.1) := + ⟨fun h₁ h₂ => lt_trans h₁ h₂⟩ + have horder : path.Pairwise (fun z y => z.1 < y.1) := + (hforward.imp (by intro z y he; omega)).pairwise + have hweak : path.Pairwise (fun z y => z.1 ≤ y.1) := + horder.imp (by intro z y hh; exact le_of_lt hh) + refine ⟨hforward, horder, ?_, ?_⟩ + · intro z hz + have hlo := hweak.rel_head_of_rel_head_head hz (le_refl _) + have hhi := hweak.rel_getLast_of_rel_getLast_getLast hz (le_refl _) + rw [hhead] at hlo + rw [hlast] at hhi + exact ⟨hlo, by simpa only [Prod.fst_add] using hhi⟩ + · intro z hz + have hh := horder.rel_dropLast_getLast hz + rw [hlast] at hh + simpa only [Prod.fst_add] using hh + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3019T1ChamberStripGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3019T1ChamberStripGeometry.lean new file mode 100644 index 0000000000..8df68bb985 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3019T1ChamberStripGeometry.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TriangularStripSegment +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P3019T1ChamberStripGeometry] + +/-! +# P3019T1ChamberStripGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3019T1ChamberStripGeometry + (x : Int × Int) (r s : Int) (hr : 0 < r) (hs : 0 ≤ s ∧ s ≤ r) : + TriangularMaxIncrement x (x + (r, s)) = r ∧ + (∀ z : Int × Int, TriangularBoundaryStrip x (x + (r, s)) z ↔ + 0 ≤ r * (z.2 - x.2) - s * (z.1 - x.1) ∧ + r * (z.2 - x.2) - s * (z.1 - x.1) < r) ∧ + (∀ z y : Int × Int, + TriangularBoundaryStrip x (x + (r, s)) z → + TriangularBoundaryStrip x (x + (r, s)) y → + z.1 = y.1 → z = y) ∧ + (∀ z : Int × Int, TriangularBoundaryStrip x (x + (r, s)) z → + ∀ y : Int × Int, + (TriangularLatticeAdjacent z y ∧ + TriangularBoundaryStrip x (x + (r, s)) y) ↔ + (y = z + (1, 0) ∧ s ≤ r * (z.2 - x.2) - s * (z.1 - x.1)) ∨ + (y = z + (1, 1) ∧ r * (z.2 - x.2) - s * (z.1 - x.1) < s) ∨ + (y = z + (-1, 0) ∧ r * (z.2 - x.2) - s * (z.1 - x.1) < r - s) ∨ + (y = z + (-1, -1) ∧ r - s ≤ r * (z.2 - x.2) - s * (z.1 - x.1))) := by +-- BODY + have hmax : TriangularMaxIncrement x (x + (r, s)) = r := by + simp only [TriangularMaxIncrement, Prod.fst_add, Prod.snd_add] + simp only [add_sub_cancel_left, abs_of_nonneg (le_of_lt hr), + abs_of_nonneg hs.1, abs_of_nonneg (sub_nonneg.mpr hs.2)] + omega + have hwindow : ∀ z : Int × Int, + TriangularBoundaryStrip x (x + (r, s)) z ↔ + 0 ≤ r * (z.2 - x.2) - s * (z.1 - x.1) ∧ + r * (z.2 - x.2) - s * (z.1 - x.1) < r := by + intro z + simp [TriangularBoundaryStrip, TriangularSignedHeight, hmax] + refine ⟨hmax, hwindow, ?_, ?_⟩ + · intro z y hz hy he + have hz' := (hwindow z).mp hz + have hy' := (hwindow y).mp hy + apply Prod.ext he + rw [he] at hz' + nlinarith + · intro z hz y + have hz' := (hwindow z).mp hz + constructor + · rintro ⟨hadj, hy⟩ + have hy' := (hwindow y).mp hy + rcases hadj with he | he | he | he | he | he + all_goals + have he' := eq_add_of_sub_eq he + rw [add_comm] at he' + rw [he'] at hy' + simp only [Prod.fst_add, Prod.snd_add] at hy' + · exact Or.inl ⟨he', by nlinarith⟩ + · exfalso + nlinarith + · exact Or.inr (Or.inr (Or.inr ⟨he', by nlinarith⟩)) + · exact Or.inr (Or.inr (Or.inl ⟨he', by nlinarith⟩)) + · exfalso + nlinarith + · exact Or.inr (Or.inl ⟨he', by nlinarith⟩) + · intro hy + rcases hy with ⟨he, hh⟩ | ⟨he, hh⟩ | ⟨he, hh⟩ | ⟨he, hh⟩ + all_goals + subst y + constructor + · simp [TriangularLatticeAdjacent] + · apply (hwindow _).mpr + simp only [Prod.fst_add, Prod.snd_add] + constructor <;> nlinarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3019T1UnimodularStripWindow.lean b/LeanPool/ApollonianSuperharmonic/P3019T1UnimodularStripWindow.lean new file mode 100644 index 0000000000..94d17f9760 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3019T1UnimodularStripWindow.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3019T1ChamberStripGeometry +public import Mathlib.Tactic.LinearCombination + +-- [TABLET NODE: P3019T1UnimodularStripWindow] + +/-! +# P3019T1UnimodularStripWindow + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3019T1UnimodularStripWindow + (x : Int × Int) (a b c d : Int) + (hab : 0 ≤ b ∧ b ≤ a) (hcd : 0 ≤ d ∧ d ≤ c) + (horient : a * d - b * c = -1) : + 0 < a ∧ 0 < c ∧ + (∀ k j : Int, 0 ≤ k ∧ k ≤ a → 0 ≤ a * j - b * k ∧ a * j - b * k < a → + TriangularBoundaryStrip x (x + (a, b) + (c, d)) (x + (k, j))) ∧ + (∀ k j : Int, 0 ≤ k ∧ k ≤ c → 0 ≤ c * j - d * k ∧ c * j - d * k < c → + TriangularBoundaryStrip x (x + (a, b) + (c, d)) + (x + (a, b) + (k, j))) := by +-- BODY + have ha : 0 < a := by + by_contra hh + have ha0 : a = 0 := by omega + have hb0 : b = 0 := by omega + simp [ha0, hb0] at horient + have hc : 0 < c := by + by_contra hh + have hc0 : c = 0 := by omega + have hd0 : d = 0 := by omega + simp [hc0, hd0] at horient + have hw := (P3019T1ChamberStripGeometry x (a + c) (b + d) + (by omega) (by omega)).2.1 + have hsum : x + (a, b) + (c, d) = x + (a + c, b + d) := by + simp [add_assoc] + refine ⟨ha, hc, ?_, ?_⟩ + · intro k j hk hh + have hid : a * (c * j - d * k) = c * (a * j - b * k) + k := by + linear_combination -k * horient + have hell0 : 0 ≤ c * j - d * k := by + nlinarith [mul_nonneg (le_of_lt hc) hh.1] + have hell1 : c * j - d * k < c + 1 := by + nlinarith [mul_pos hc (sub_pos.mpr hh.2)] + rw [hsum, hw] + simp only [Prod.fst_add, Prod.snd_add, add_sub_cancel_left] + constructor <;> nlinarith + · intro k j hk hh + have hid : c * (a * j - b * k) = a * (c * j - d * k) - k := by + linear_combination k * horient + have hq0 : -1 ≤ a * j - b * k := by + nlinarith [mul_nonneg (le_of_lt ha) hh.1] + have hq1 : a * j - b * k < a := by + nlinarith [mul_pos ha (sub_pos.mpr hh.2)] + have height : (a + c) * (b + j) - (b + d) * (a + k) = + 1 + (a * j - b * k) + (c * j - d * k) := by + linear_combination -horient + rw [hsum, hw] + simp only [Prod.fst_add, Prod.snd_add] + have hx1 : x.1 + a + k - x.1 = a + k := by omega + have hx2 : x.2 + b + j - x.2 = b + j := by omega + rw [hx1, hx2, height] + constructor <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3045T1RightBoundaryDisplacementAlgebra.lean b/LeanPool/ApollonianSuperharmonic/P3045T1RightBoundaryDisplacementAlgebra.lean new file mode 100644 index 0000000000..236b30d553 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3045T1RightBoundaryDisplacementAlgebra.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P3045T1RightBoundaryDisplacementAlgebra] + +/-! +# P3045T1RightBoundaryDisplacementAlgebra + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3045T1RightBoundaryDisplacementAlgebra (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) (r t k : Fin 3) + (hcyc : (r = 0 ∧ t = 1 ∧ k = 2) ∨ + (r = 1 ∧ t = 2 ∧ k = 0) ∨ (r = 2 ∧ t = 0 ∧ k = 1)) : + let v := BandVectors.1 + let a := BandVectors.2 + let I : GaussianInt := ⟨0, 1⟩ + ((1 - I) * v (q k.succ) (q t.succ) + 2 * v (q 0) (q k.succ) = + -I * (v (q r.succ) (q 0) + v (q 0) (q r.succ))) ∧ + (-(1 - I) * v (q r.succ) (q k.succ) + 2 * v (q 0) (q k.succ) = + -(v (q t.succ) (q 0) + v (q 0) (q t.succ))) ∧ + (-(1 - I) * v (q k.succ) (q t.succ) - 2 * v (q 0) (q k.succ) = + I * (v (q r.succ) (q 0) + v (q 0) (q r.succ))) ∧ + ((1 - I) * v (q r.succ) (q k.succ) - 2 * v (q 0) (q k.succ) = + v (q t.succ) (q 0) + v (q 0) (q t.succ)) ∧ + ((1 + I) * a (q k.succ) (q t.succ) + 2 * a (q 0) (q k.succ) = + I * (a (q r.succ) (q 0) + a (q 0) (q r.succ))) ∧ + (-(1 + I) * a (q r.succ) (q k.succ) + 2 * a (q 0) (q k.succ) = + -(a (q t.succ) (q 0) + a (q 0) (q t.succ))) ∧ + (-(1 + I) * a (q k.succ) (q t.succ) - 2 * a (q 0) (q k.succ) = + -I * (a (q r.succ) (q 0) + a (q 0) (q r.succ))) ∧ + ((1 + I) * a (q r.succ) (q k.succ) - 2 * a (q 0) (q k.succ) = + a (q t.succ) (q 0) + a (q 0) (q t.succ)) ∧ + (∀ j : Fin 3, v (q 0) (q j.succ) = I * v (q j.succ) (q 0) ∧ + a (q 0) (q j.succ) = -I * a (q j.succ) (q 0)) := by +-- BODY + dsimp only + obtain ⟨vsum, asum, v1, a1, flip⟩ := VectorRecursionLaws q hq.1 + have laws2 := VectorRecursionLaws _ (SemiProperQuadruple.rotate hq.1) + have laws3 := VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1)) + have v2 : BandVectors.1 (q 2) (q 0) = BandVectors.1 (q 2) (q 1) - + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 3) (q 2) := by + simpa using laws2.2.2.1 + have a2 : BandVectors.2 (q 2) (q 0) = BandVectors.2 (q 2) (q 1) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 3) (q 2) := by + simpa using laws2.2.2.2.1 + have v3 : BandVectors.1 (q 3) (q 0) = BandVectors.1 (q 3) (q 2) - + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 1) (q 3) := by + simpa using laws3.2.2.1 + have a3 : BandVectors.2 (q 3) (q 0) = BandVectors.2 (q 3) (q 2) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 1) (q 3) := by + simpa using laws3.2.2.2.1 + have vf1 := (flip hq 0).1 + have vf2 := (flip hq 1).1 + have vf3 := (flip hq 2).1 + have af1 := (flip hq 0).2 + have af2 := (flip hq 1).2 + have af3 := (flip hq 2).2 + have s0 : (0 : Fin 3).succ = (1 : Fin 4) := rfl + have s1 : (1 : Fin 3).succ = (2 : Fin 4) := rfl + have s2 : (2 : Fin 3).succ = (3 : Fin 4) := rfl + simp only [s0, s1, s2] at vf1 vf2 vf3 af1 af2 af3 + have vc : BandVectors.1 (q 2) (q 1) = + -BandVectors.1 (q 3) (q 2) - BandVectors.1 (q 1) (q 3) := by + apply eq_of_sub_eq_zero + calc + _ = BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 1) (q 3) + + BandVectors.1 (q 2) (q 1) := by ring + _ = 0 := vsum + have ac : BandVectors.2 (q 2) (q 1) = + -BandVectors.2 (q 3) (q 2) - BandVectors.2 (q 1) (q 3) := by + apply eq_of_sub_eq_zero + calc + _ = BandVectors.2 (q 3) (q 2) + BandVectors.2 (q 1) (q 3) + + BandVectors.2 (q 2) (q 1) := by ring + _ = 0 := asum + rcases hcyc with ⟨rfl, rfl, rfl⟩ | ⟨rfl, rfl, rfl⟩ | ⟨rfl, rfl, rfl⟩ + all_goals + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, flip hq⟩ + all_goals + simp only [s0, s1, s2] + simp only [vf1, vf2, vf3, af1, af2, af3, v1, v2, v3, a1, a2, a3, vc, ac] + ext <;> simp <;> ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3055T1ExteriorCentralIncidence.lean b/LeanPool/ApollonianSuperharmonic/P3055T1ExteriorCentralIncidence.lean new file mode 100644 index 0000000000..73011cbb76 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3055T1ExteriorCentralIncidence.lean @@ -0,0 +1,359 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence + +-- [TABLET NODE: P3055T1ExteriorCentralIncidence] + +/-! +# P3055T1ExteriorCentralIncidence + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ExteriorCentralProof + +private theorem ledger : + let R : PeriodicSubtileIndex → PeriodicSubtileIndex → Prop := fun a b => + ((a.label = .A ∧ b.label = .B ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .A ∧ a.label = .B ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .A ∧ b.label = .B ∧ + b.first = a.first + (0) ∧ b.second = a.second + (1)) ∨ + (b.label = .A ∧ a.label = .B ∧ + a.first = b.first + (0) ∧ a.second = b.second + (1))) ∨ + ((a.label = .A ∧ b.label = .B ∧ + b.first = a.first + (1) ∧ b.second = a.second + (1)) ∨ + (b.label = .A ∧ a.label = .B ∧ + a.first = b.first + (1) ∧ a.second = b.second + (1))) ∨ + ((a.label = .A ∧ b.label = .C ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .A ∧ a.label = .C ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .A ∧ b.label = .C ∧ + b.first = a.first + (1) ∧ b.second = a.second + (1)) ∨ + (b.label = .A ∧ a.label = .C ∧ + a.first = b.first + (1) ∧ a.second = b.second + (1))) ∨ + ((a.label = .A ∧ b.label = .D ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .A ∧ a.label = .D ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .A ∧ b.label = .E ∧ + b.first = a.first + (0) ∧ b.second = a.second + (1)) ∨ + (b.label = .A ∧ a.label = .E ∧ + a.first = b.first + (0) ∧ a.second = b.second + (1))) ∨ + ((a.label = .A ∧ b.label = .F ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .A ∧ a.label = .F ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .B ∧ b.label = .C ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .B ∧ a.label = .C ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .B ∧ b.label = .D ∧ + b.first = a.first + (-1) ∧ b.second = a.second + (-1)) ∨ + (b.label = .B ∧ a.label = .D ∧ + a.first = b.first + (-1) ∧ a.second = b.second + (-1))) ∨ + ((a.label = .B ∧ b.label = .D ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .B ∧ a.label = .D ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .B ∧ b.label = .E ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .B ∧ a.label = .E ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .B ∧ b.label = .F ∧ + b.first = a.first + (0) ∧ b.second = a.second + (-1)) ∨ + (b.label = .B ∧ a.label = .F ∧ + a.first = b.first + (0) ∧ a.second = b.second + (-1))) ∨ + ((a.label = .C ∧ b.label = .D ∧ + b.first = a.first + (-1) ∧ b.second = a.second + (0)) ∨ + (b.label = .C ∧ a.label = .D ∧ + a.first = b.first + (-1) ∧ a.second = b.second + (0))) ∨ + ((a.label = .C ∧ b.label = .E ∧ + b.first = a.first + (-1) ∧ b.second = a.second + (0)) ∨ + (b.label = .C ∧ a.label = .E ∧ + a.first = b.first + (-1) ∧ a.second = b.second + (0))) ∨ + ((a.label = .C ∧ b.label = .F ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .C ∧ a.label = .F ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .D ∧ b.label = .E ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .D ∧ a.label = .E ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .D ∧ b.label = .F ∧ + b.first = a.first + (1) ∧ b.second = a.second + (0)) ∨ + (b.label = .D ∧ a.label = .F ∧ + a.first = b.first + (1) ∧ a.second = b.second + (0))) + ∀ a, ∀ b, AllowedSubtileIncidence a b → R a b := by + classical + intro R a b h + induction h with + | AB m n => + exact Or.inl (Or.inl ⟨rfl, rfl, by simp [], by simp []⟩) + | AB01 m n => + exact Or.inr (Or.inl (Or.inl ⟨rfl, rfl, by simp [], by simp []⟩)) + | AB11 m n => + exact Or.inr (Or.inr (Or.inl (Or.inl ⟨rfl, rfl, by simp [], by simp []⟩))) + | AC m n => + exact Or.inr (Or.inr (Or.inr (Or.inl (Or.inl ⟨rfl, rfl, by simp [], by simp []⟩)))) + | AC11 m n => + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl ⟨rfl, rfl, by simp [], by simp []⟩))))) + | AD m n => + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl ⟨rfl, rfl, by simp [], by simp + []⟩)))))) + | AE01 m n => + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl ⟨rfl, rfl, by simp [], + by simp []⟩))))))) + | AF m n => + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl ⟨rfl, rfl, + by simp [], by simp []⟩)))))))) + | BC m n => + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl ⟨rfl, + rfl, by simp [], by simp []⟩))))))))) + | BDm1m1 m n => + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + (Or.inl ⟨rfl, rfl, by simp [sub_eq_add_neg], by simp [sub_eq_add_neg]⟩)))))))))) + | BD m n => + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl (Or.inl ⟨rfl, rfl, by simp [], by simp []⟩))))))))))) + | BE m n => + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inl (Or.inl ⟨rfl, rfl, by simp [], by simp []⟩)))))))))))) + | BF0m1 m n => + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inl (Or.inl ⟨rfl, rfl, by simp [], by simp + [sub_eq_add_neg]⟩))))))))))))) + | CDm10 m n => + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl ⟨rfl, rfl, by simp [sub_eq_add_neg], by simp + []⟩)))))))))))))) + | CEm10 m n => + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl ⟨rfl, rfl, by simp [sub_eq_add_neg], + by simp []⟩))))))))))))))) + | CF m n => + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl ⟨rfl, rfl, by simp [], by simp + []⟩)))))))))))))))) + | DE m n => + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl ⟨rfl, rfl, by simp [], + by simp []⟩))))))))))))))))) + | DF10 m n => + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨rfl, rfl, by simp [], + by simp []⟩))))))))))))))))) + | symm _ ih => + dsimp only [R] at ih ⊢ + rcases ih with h | h | h | h | h | h | h | h | h | h | h | h | h | h | h | h | h | h + · rcases h with h | h + · exact Or.inl (Or.inr h) + · exact Or.inl (Or.inl h) + · rcases h with h | h + · exact Or.inr (Or.inl (Or.inr h)) + · exact Or.inr (Or.inl (Or.inl h)) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inl (Or.inr h))) + · exact Or.inr (Or.inr (Or.inl (Or.inl h))) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inr (Or.inl (Or.inr h)))) + · exact Or.inr (Or.inr (Or.inr (Or.inl (Or.inl h)))) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inr h))))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl h))))) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inr h)))))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl h)))))) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inr h))))))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl h))))))) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inr h)))))))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl h)))))))) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inr + h))))))))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl + h))))))))) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + (Or.inr h)))))))))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + (Or.inl h)))))))))) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl (Or.inr h))))))))))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl (Or.inl h))))))))))) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inl (Or.inr h)))))))))))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inl (Or.inl h)))))))))))) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inl (Or.inr h))))))))))))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inl (Or.inl h))))))))))))) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inl (Or.inr h)))))))))))))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl h)))))))))))))) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inr h))))))))))))))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl h))))))))))))))) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inr h)))))))))))))))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl h)))))))))))))))) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inr h))))))))))))))))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (Or.inl h))))))))))))))))) + · rcases h with h | h + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr h))))))))))))))))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl h))))))))))))))))) + +end ExteriorCentralProof + +theorem P3055T1ExteriorCentralIncidence (a b : PeriodicSubtileIndex) + (ha : a = ⟨.A, -1, -1⟩ ∨ + a = ⟨.A, 0, -1⟩ ∨ + a = ⟨.C, 1, 0⟩ ∨ + a = ⟨.C, 1, 1⟩ ∨ + a = ⟨.E, 0, 1⟩ ∨ + a = ⟨.E, -1, 0⟩ ∨ + a = ⟨.B, 1, 1⟩ ∨ + a = ⟨.B, 0, 1⟩ ∨ + a = ⟨.D, -1, 0⟩ ∨ + a = ⟨.D, -1, -1⟩ ∨ + a = ⟨.F, 0, -1⟩ ∨ + a = ⟨.F, 1, 0⟩) + (hb : b = ⟨.A, 0, 0⟩ ∨ + b = ⟨.B, 0, 0⟩ ∨ + b = ⟨.C, 0, 0⟩ ∨ + b = ⟨.D, 0, 0⟩ ∨ + b = ⟨.E, 0, 0⟩ ∨ + b = ⟨.F, 0, 0⟩) + (hinc : AllowedSubtileIncidence a b) : + (a = ⟨.A, -1, -1⟩ ∧ b = ⟨.B, 0, 0⟩) ∨ + (a = ⟨.A, -1, -1⟩ ∧ b = ⟨.C, 0, 0⟩) ∨ + (a = ⟨.A, 0, -1⟩ ∧ b = ⟨.B, 0, 0⟩) ∨ + (a = ⟨.A, 0, -1⟩ ∧ b = ⟨.E, 0, 0⟩) ∨ + (a = ⟨.C, 1, 0⟩ ∧ b = ⟨.D, 0, 0⟩) ∨ + (a = ⟨.C, 1, 0⟩ ∧ b = ⟨.E, 0, 0⟩) ∨ + (a = ⟨.C, 1, 1⟩ ∧ b = ⟨.A, 0, 0⟩) ∨ + (a = ⟨.E, 0, 1⟩ ∧ b = ⟨.A, 0, 0⟩) ∨ + (a = ⟨.E, -1, 0⟩ ∧ b = ⟨.C, 0, 0⟩) ∨ + (a = ⟨.B, 1, 1⟩ ∧ b = ⟨.A, 0, 0⟩) ∨ + (a = ⟨.B, 1, 1⟩ ∧ b = ⟨.D, 0, 0⟩) ∨ + (a = ⟨.B, 0, 1⟩ ∧ b = ⟨.A, 0, 0⟩) ∨ + (a = ⟨.B, 0, 1⟩ ∧ b = ⟨.F, 0, 0⟩) ∨ + (a = ⟨.D, -1, 0⟩ ∧ b = ⟨.C, 0, 0⟩) ∨ + (a = ⟨.D, -1, 0⟩ ∧ b = ⟨.F, 0, 0⟩) ∨ + (a = ⟨.D, -1, -1⟩ ∧ b = ⟨.B, 0, 0⟩) ∨ + (a = ⟨.F, 0, -1⟩ ∧ b = ⟨.B, 0, 0⟩) ∨ + (a = ⟨.F, 1, 0⟩ ∧ b = ⟨.D, 0, 0⟩) := by +-- BODY + let R : PeriodicSubtileIndex → PeriodicSubtileIndex → Prop := fun a b => + ((a.label = .A ∧ b.label = .B ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .A ∧ a.label = .B ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .A ∧ b.label = .B ∧ + b.first = a.first + (0) ∧ b.second = a.second + (1)) ∨ + (b.label = .A ∧ a.label = .B ∧ + a.first = b.first + (0) ∧ a.second = b.second + (1))) ∨ + ((a.label = .A ∧ b.label = .B ∧ + b.first = a.first + (1) ∧ b.second = a.second + (1)) ∨ + (b.label = .A ∧ a.label = .B ∧ + a.first = b.first + (1) ∧ a.second = b.second + (1))) ∨ + ((a.label = .A ∧ b.label = .C ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .A ∧ a.label = .C ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .A ∧ b.label = .C ∧ + b.first = a.first + (1) ∧ b.second = a.second + (1)) ∨ + (b.label = .A ∧ a.label = .C ∧ + a.first = b.first + (1) ∧ a.second = b.second + (1))) ∨ + ((a.label = .A ∧ b.label = .D ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .A ∧ a.label = .D ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .A ∧ b.label = .E ∧ + b.first = a.first + (0) ∧ b.second = a.second + (1)) ∨ + (b.label = .A ∧ a.label = .E ∧ + a.first = b.first + (0) ∧ a.second = b.second + (1))) ∨ + ((a.label = .A ∧ b.label = .F ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .A ∧ a.label = .F ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .B ∧ b.label = .C ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .B ∧ a.label = .C ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .B ∧ b.label = .D ∧ + b.first = a.first + (-1) ∧ b.second = a.second + (-1)) ∨ + (b.label = .B ∧ a.label = .D ∧ + a.first = b.first + (-1) ∧ a.second = b.second + (-1))) ∨ + ((a.label = .B ∧ b.label = .D ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .B ∧ a.label = .D ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .B ∧ b.label = .E ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .B ∧ a.label = .E ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .B ∧ b.label = .F ∧ + b.first = a.first + (0) ∧ b.second = a.second + (-1)) ∨ + (b.label = .B ∧ a.label = .F ∧ + a.first = b.first + (0) ∧ a.second = b.second + (-1))) ∨ + ((a.label = .C ∧ b.label = .D ∧ + b.first = a.first + (-1) ∧ b.second = a.second + (0)) ∨ + (b.label = .C ∧ a.label = .D ∧ + a.first = b.first + (-1) ∧ a.second = b.second + (0))) ∨ + ((a.label = .C ∧ b.label = .E ∧ + b.first = a.first + (-1) ∧ b.second = a.second + (0)) ∨ + (b.label = .C ∧ a.label = .E ∧ + a.first = b.first + (-1) ∧ a.second = b.second + (0))) ∨ + ((a.label = .C ∧ b.label = .F ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .C ∧ a.label = .F ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .D ∧ b.label = .E ∧ + b.first = a.first + (0) ∧ b.second = a.second + (0)) ∨ + (b.label = .D ∧ a.label = .E ∧ + a.first = b.first + (0) ∧ a.second = b.second + (0))) ∨ + ((a.label = .D ∧ b.label = .F ∧ + b.first = a.first + (1) ∧ b.second = a.second + (0)) ∨ + (b.label = .D ∧ a.label = .F ∧ + a.first = b.first + (1) ∧ a.second = b.second + (0))) + have ledger : ∀ a b, AllowedSubtileIncidence a b → R a b := ExteriorCentralProof.ledger + have hr := ledger a b hinc + dsimp [R] at hr + rcases ha with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;> + rcases hb with rfl | rfl | rfl | rfl | rfl | rfl <;> + simp_all + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3055T1ParentVectorNormalForms.lean b/LeanPool/ApollonianSuperharmonic/P3055T1ParentVectorNormalForms.lean new file mode 100644 index 0000000000..b6210b74e0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3055T1ParentVectorNormalForms.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P3055T1ParentVectorNormalForms] + +/-! +# P3055T1ParentVectorNormalForms + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3055T1ParentVectorNormalForms + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) : + let V := BandVectors.1 + let I : GaussianInt := ⟨0, 1⟩ + let U := V (q 2) (q 1) + let W := V (q 3) (q 2) + V (q 1) (q 3) = -U - W ∧ + V (q 1) (q 2) = I * U ∧ + V (q 3) (q 1) = I * (U + W) ∧ + V (q 2) (q 3) = I * W ∧ + V (q 0) (q 1) = U - I * (U + W) ∧ + V (q 0) (q 2) = W + I * U ∧ + V (q 0) (q 3) = -U - W + I * W ∧ + V (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + + V (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = (1 + I) * U ∧ + V (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + + V (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = (I - 1) * (U + W) ∧ + V (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + + V (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) = (1 + I) * W := by +-- BODY + dsimp only + obtain ⟨hsum, _, hin1, _, flip⟩ := VectorRecursionLaws q cfg.proper.1 + have laws2 := VectorRecursionLaws _ (SemiProperQuadruple.rotate cfg.proper.1) + have laws3 := VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate cfg.proper.1)) + have hin2 : BandVectors.1 (q 2) (q 0) = BandVectors.1 (q 2) (q 1) - + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 3) (q 2) := by + simpa using laws2.2.2.1 + have hin3 : BandVectors.1 (q 3) (q 0) = BandVectors.1 (q 3) (q 2) - + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 1) (q 3) := by + simpa using laws3.2.2.1 + have h13 : BandVectors.1 (q 1) (q 3) = + -BandVectors.1 (q 2) (q 1) - BandVectors.1 (q 3) (q 2) := by + apply eq_of_sub_eq_zero + calc + _ = BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 1) (q 3) + + BandVectors.1 (q 2) (q 1) := by ring + _ = 0 := hsum + have firstFlip := (VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).2.2.2.2 + cfg.firstProper + have secondFlip := (VectorRecursionLaws cfg.secondPredecessor cfg.secondProper.1).2.2.2.2 + cfg.secondProper + have h12 := (firstFlip 1).1 + have hf13 := (firstFlip 2).1 + have h23 := (secondFlip 0).1 + change BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = + (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) at h12 + change BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = + (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) at hf13 + change BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) = + (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) at h23 + rw [cfg.firstChild, cfg.firstParentTwo] at h12 + rw [cfg.firstChild, cfg.firstParentThree] at hf13 + rw [cfg.secondChild, cfg.secondParentOne] at h23 + have h31 : BandVectors.1 (q 3) (q 1) = + (⟨0, 1⟩ : GaussianInt) * + (BandVectors.1 (q 2) (q 1) + BandVectors.1 (q 3) (q 2)) := by + calc + _ = -(⟨0, 1⟩ : GaussianInt) * + ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 3) (q 1)) := by + ext <;> simp + _ = -(⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 1) (q 3) := by rw [← hf13] + _ = _ := by rw [h13]; ring + have fout1 := (flip cfg.proper 0).1 + have fout2 := (flip cfg.proper 1).1 + have fout3 := (flip cfg.proper 2).1 + simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl] at fout1 + simp only [show (1 : Fin 3).succ = (2 : Fin 4) from rfl] at fout2 + simp only [show (2 : Fin 3).succ = (3 : Fin 4) from rfl] at fout3 + refine ⟨h13, h12, h31, h23, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [fout1, hin1, h13] + ext <;> simp <;> ring + · rw [fout2, hin2] + ext <;> simp <;> ring + · rw [fout3, hin3, h13] + ext <;> simp <;> ring + · rw [cfg.firstChild, cfg.firstParentTwo, h12] + ring + · rw [cfg.firstChild, cfg.firstParentThree, h13, h31] + ring + · rw [cfg.secondChild, cfg.secondParentOne, h23] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3055T1SignedCentroidNormalForms.lean b/LeanPool/ApollonianSuperharmonic/P3055T1SignedCentroidNormalForms.lean new file mode 100644 index 0000000000..5bdd370bca --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3055T1SignedCentroidNormalForms.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms + +-- [TABLET NODE: P3055T1SignedCentroidNormalForms] + +/-! +# P3055T1SignedCentroidNormalForms + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3055T1SignedCentroidNormalForms + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + let I : GaussianInt := ⟨0, 1⟩ + let U := BandVectors.1 (q 2) (q 1) + let W := BandVectors.1 (q 3) (q 2) + ∀ (j : Fin 3) (s : Bool), + TileCentroid (cert.P j s) = TileCentroid T + + (if s = true then (1 : ℝ) else -1) • + ((1 / 2 : ℝ) • GaussianRealPoint + (if j = 0 then (1 - I) * W + else if j = 1 then -(1 - I) * (U + W) + else (1 - I) * U)) := by +-- BODY + dsimp only + intro j s + have hp := (cert.outer_occurrence j s).2.2 + have h13 := (P3055T1ParentVectorNormalForms q cfg).1 + fin_cases j <;> cases s + all_goals + norm_num [h13] at hp ⊢ + have hx := congrArg Prod.fst hp + have hy := congrArg Prod.snd hp + apply Prod.ext + all_goals + simp [GaussianRealPoint] at hx hy ⊢ + linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean b/LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean new file mode 100644 index 0000000000..766e71da5e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean @@ -0,0 +1,743 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk +public import Mathlib.Analysis.Normed.Group.Constructions +public import Mathlib.Analysis.Normed.Module.Basic +public import Mathlib.Topology.Order.Lattice +public import Mathlib.Topology.Homeomorph.Lemmas +public import Mathlib.Tactic.FieldSimp +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P3092T1CenteredRectangleDisk] + +/-! +# P3092T1CenteredRectangleDisk + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CenteredRectangleDiskConstruction + +private noncomputable abbrev q (a : Nat → ℝ) (b : Nat → ℝ) : Nat → (ℝ × ℝ) → ℝ := by + classical + exact fun j x => max (|x.1| / a j) (|x.2| / b j) + +private noncomputable abbrev g (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) : + (ℝ × ℝ) → ℝ := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + exact fun x => J.inf' hJ (fun j => q j x) + +private noncomputable abbrev R (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) : + (ℝ × ℝ) → ℝ := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + exact fun x => J.sup' hJ (fun j => (q j x)⁻¹) + +private theorem hq_nonneg (J : Finset Nat) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j ∈ J, 0 < a j) (j + : Nat) (hj : j ∈ J) (x : ℝ × ℝ) : 0 ≤ (q a b) j x := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + change (0 ≤ q j x) + exact le_trans (div_nonneg (abs_nonneg _) (ha j hj).le) (le_max_left _ _) + +private theorem hq_pos (J : Finset Nat) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j ∈ J, 0 < a j) (hb : + ∀ j ∈ J, 0 < b j) (j : Nat) (hj : j ∈ J) (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < (q a b) j x := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + change (0 < q j x) + by_contra hn + have hh := max_le_iff.mp (le_of_not_gt hn) + have h1 : x.1 = 0 := abs_eq_zero.mp (le_antisymm + (by have := (div_le_iff₀ (ha j hj)).mp hh.1; linarith) (abs_nonneg _)) + have h2 : x.2 = 0 := abs_eq_zero.mp (le_antisymm + (by have := (div_le_iff₀ (hb j hj)).mp hh.2; linarith) (abs_nonneg _)) + exact hx (Prod.ext h1 h2) + +private theorem hg_nonneg (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ + j ∈ J, 0 < a j) (x : ℝ × ℝ) : 0 ≤ (g J hJ a b) x := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + have hq_nonneg (j : Nat) (hj : j ∈ J) (x : ℝ × ℝ) : 0 ≤ q j x := hq_nonneg J a b ha j hj x + change (0 ≤ g x) + exact Finset.le_inf' hJ _ (fun j hj => hq_nonneg j hj x) + +private theorem hg_pos (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j ∈ + J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < (g J hJ a b) x := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + have hq_pos (j : Nat) (hj : j ∈ J) (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < q j x := hq_pos J a b ha hb j + hj x hx + change (0 < g x) + exact (Finset.lt_inf'_iff hJ).mpr (fun j hj => hq_pos j hj x hx) + +private theorem hg_zero (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) : (g J hJ + a b) 0 = 0 := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + change (g 0 = 0) + exact Finset.inf'_eq_of_forall hJ (fun j => q j 0) (by simp [q]) + +private theorem hq_smul (a : Nat → ℝ) (b : Nat → ℝ) (t : ℝ) (ht : 0 ≤ t) (j : Nat) (x : ℝ × ℝ) : + (q a b) j (t • x) = t * (q a b) j x := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + change (q j (t • x) = t * q j x) + simp only [q, Prod.smul_fst, Prod.smul_snd, smul_eq_mul, abs_mul, + abs_of_nonneg ht, mul_div_assoc, mul_max_of_nonneg _ _ ht] + +private theorem hg_smul (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (t : ℝ) + (ht : 0 ≤ t) (x : ℝ × ℝ) : (g J hJ a b) (t • x) = t * (g J hJ a b) x := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + have hq_smul (t : ℝ) (ht : 0 ≤ t) (j : Nat) (x : ℝ × ℝ) : + q j (t • x) = t * q j x := hq_smul a b t ht j x + change (g (t • x) = t * g x) + simp only [g, hq_smul t ht] + exact (Finset.apply_inf'_eq_inf'_comp hJ (fun y : ℝ => t * y) + (fun y z => mul_min_of_nonneg y z ht)).symm + +private theorem hg_cont (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) : + Continuous (g J hJ a b) := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + change (Continuous g) + apply Continuous.finset_inf'_apply hJ + intro j hj + exact (continuous_fst.abs.div_const _).max (continuous_snd.abs.div_const _) + +private theorem hR_eq (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j ∈ + J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) (hx : x ≠ 0) : (R J hJ a b) x = ((g J hJ a b) + x)⁻¹ := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hq_pos (j : Nat) (hj : j ∈ J) (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < q j x := hq_pos J a b ha hb j + hj x hx + have hg_pos (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < g x := hg_pos J hJ a b ha hb x hx + change (R x = (g x)⁻¹) + apply le_antisymm + · apply Finset.sup'_le + intro j hj + exact (inv_le_inv₀ (hq_pos j hj x hx) (hg_pos x hx)).mpr + (Finset.inf'_le _ hj) + · obtain ⟨j, hj, heq⟩ := Finset.exists_mem_eq_inf' hJ (fun j => q j x) + change (J.inf' hJ (fun j => q j x))⁻¹ ≤ R x + rw [heq] + exact Finset.le_sup' (fun j => (q j x)⁻¹) hj + +private theorem hR_attained (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (x : ℝ + × ℝ) : ∃ j ∈ J, (R J hJ a b) x = ((q a b) j x)⁻¹ := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + change (∃ j ∈ J, R x = (q j x)⁻¹) + exact Finset.exists_mem_eq_sup' hJ _ + +private theorem hR_pos (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j ∈ + J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < (R J hJ a b) x := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hg_pos (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < g x := hg_pos J hJ a b ha hb x hx + have hR_eq (x : ℝ × ℝ) (hx : x ≠ 0) : R x = (g x)⁻¹ := hR_eq J hJ a b ha hb x hx + change (0 < R x) + rw [hR_eq x hx] + exact inv_pos.mpr (hg_pos x hx) + +private theorem hR_cont (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j + ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) (hx : x ≠ 0) : ContinuousAt (R J hJ a b) x + := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hq_pos (j : Nat) (hj : j ∈ J) (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < q j x := hq_pos J a b ha hb j + hj x hx + change (ContinuousAt R x) + apply ContinuousAt.finset_sup'_apply hJ + intro j hj + exact ((continuous_fst.abs.div_const _).max + (continuous_snd.abs.div_const _)).continuousAt.inv₀ (hq_pos j hj x hx).ne' + +private theorem hmem (J : Finset Nat) (hJ : J.Nonempty) (c : ℝ × ℝ) (a : Nat → ℝ) (b : Nat → ℝ) + (ha : ∀ j ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) : + c + x ∈ (⋃ j ∈ J, Set.Icc (c.1 - a j, c.2 - b j) + (c.1 + a j, c.2 + b j)) ↔ (g J hJ a b) x ≤ 1 := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + change (c + x ∈ (⋃ j ∈ J, Set.Icc (c.1 - a j, c.2 - b j) + (c.1 + a j, c.2 + b j)) ↔ g x ≤ 1) + simp only [Set.mem_iUnion, exists_prop, Set.mem_Icc, Prod.le_def, + Prod.fst_add, Prod.snd_add] + change (∃ j ∈ J, (c.1 - a j ≤ c.1 + x.1 ∧ c.2 - b j ≤ c.2 + x.2) ∧ + c.1 + x.1 ≤ c.1 + a j ∧ c.2 + x.2 ≤ c.2 + b j) ↔ _ + change _ ↔ J.inf' hJ (fun j => q j x) ≤ 1 + rw [Finset.inf'_le_iff] + apply exists_congr + intro j + apply and_congr_right + intro hj + change _ ↔ max (|x.1| / a j) (|x.2| / b j) ≤ 1 + rw [max_le_iff, div_le_iff₀ (ha j hj), div_le_iff₀ (hb j hj)] + simp only [one_mul, abs_le] + constructor + · rintro ⟨⟨h1, h2⟩, h3, h4⟩ + exact ⟨⟨by linarith, by linarith⟩, by linarith, by linarith⟩ + · rintro ⟨⟨h1, h2⟩, h3, h4⟩ + exact ⟨⟨by linarith, by linarith⟩, by linarith, by linarith⟩ + +private theorem hray (J : Finset Nat) (hJ : J.Nonempty) (c : ℝ × ℝ) (a : Nat → ℝ) (b : Nat → ℝ) + (ha : ∀ j ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (u : ℝ × ℝ) (hu : ‖u‖ = 1) (t : ℝ) (ht : 0 ≤ + t) : + c + t • u ∈ (⋃ j ∈ J, Set.Icc (c.1 - a j, c.2 - b j) + (c.1 + a j, c.2 + b j)) ↔ t ≤ (R J hJ a b) u := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hg_pos (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < g x := hg_pos J hJ a b ha hb x hx + have hg_smul (t : ℝ) (ht : 0 ≤ t) (x : ℝ × ℝ) : g (t • x) = t * g x := hg_smul J hJ a b t ht x + have hR_eq (x : ℝ × ℝ) (hx : x ≠ 0) : R x = (g x)⁻¹ := hR_eq J hJ a b ha hb x hx + have hmem (x : ℝ × ℝ) : + c + x ∈ (⋃ j ∈ J, Set.Icc (c.1 - a j, c.2 - b j) + (c.1 + a j, c.2 + b j)) ↔ g x ≤ 1 := hmem J hJ c a b ha hb x + change (c + t • u ∈ (⋃ j ∈ J, Set.Icc (c.1 - a j, c.2 - b j) + (c.1 + a j, c.2 + b j)) ↔ t ≤ R u) + have hu0 : u ≠ 0 := by intro h; simp [h] at hu + rw [hmem, hg_smul t ht, hR_eq u hu0, ← one_div, + le_div_iff₀ (hg_pos u hu0)] + +private noncomputable abbrev j₀ (J : Finset Nat) (hJ : J.Nonempty) := hJ.choose + +private theorem hj₀ (J : Finset Nat) (hJ : J.Nonempty) : (j₀ J hJ) ∈ J := by + classical + let j₀ := hJ.choose + change (j₀ ∈ J) + exact hJ.choose_spec + +private noncomputable abbrev M (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) := + J.sup' hJ (fun j => max (a j) (b j)) + +private noncomputable abbrev C (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) := + max (a (j₀ J hJ))⁻¹ (b (j₀ J hJ))⁻¹ + +private theorem hM_pos (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j ∈ + J, 0 < a j) : 0 < (M J hJ a b) := by + classical + let j₀ := hJ.choose + have hj₀ : j₀ ∈ J := hj₀ J hJ + let M := J.sup' hJ (fun j => max (a j) (b j)) + dsimp only [CenteredRectangleDiskConstruction.M] at * + change (0 < M) + exact (ha j₀ hj₀).trans_le ((le_max_left _ _).trans + (Finset.le_sup' (fun j => max (a j) (b j)) hj₀)) + +private theorem hC_pos (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j ∈ + J, 0 < a j) : 0 < (C J hJ a b) := by + classical + let j₀ := hJ.choose + have hj₀ : j₀ ∈ J := hj₀ J hJ + let C := max (a j₀)⁻¹ (b j₀)⁻¹ + change (0 < C) + exact (inv_pos.mpr (ha j₀ hj₀)).trans_le (le_max_left _ _) + +private theorem hq_bound (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j + ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (j : Nat) (hj : j ∈ J) (x : ℝ × ℝ) : ‖x‖ ≤ (M J hJ a b) + * (q a b) j x := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + have hq_nonneg (j : Nat) (hj : j ∈ J) (x : ℝ × ℝ) : 0 ≤ q j x := hq_nonneg J a b ha j hj x + let M := J.sup' hJ (fun j => max (a j) (b j)) + dsimp only [CenteredRectangleDiskConstruction.M] at * + change (‖x‖ ≤ M * q j x) + have h1 : |x.1| ≤ q j x * a j := + (div_le_iff₀ (ha j hj)).mp (le_max_left _ _) + have h2 : |x.2| ≤ q j x * b j := + (div_le_iff₀ (hb j hj)).mp (le_max_right _ _) + have hMa : a j ≤ M := (le_max_left _ _).trans + (Finset.le_sup' (fun j => max (a j) (b j)) hj) + have hMb : b j ≤ M := (le_max_right _ _).trans + (Finset.le_sup' (fun j => max (a j) (b j)) hj) + rw [Prod.norm_def, Real.norm_eq_abs, Real.norm_eq_abs] + apply max_le + · nlinarith [mul_le_mul_of_nonneg_left hMa (hq_nonneg j hj x)] + · nlinarith [mul_le_mul_of_nonneg_left hMb (hq_nonneg j hj x)] + +private theorem hg_lower (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j + ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) : ‖x‖ ≤ (M J hJ a b) * (g J hJ a b) x := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let M := J.sup' hJ (fun j => max (a j) (b j)) + have hq_bound (j : Nat) (hj : j ∈ J) (x : ℝ × ℝ) : ‖x‖ ≤ M * q j x := hq_bound J hJ a b ha hb j + hj x + dsimp only [CenteredRectangleDiskConstruction.M] at * + change (‖x‖ ≤ M * g x) + obtain ⟨j, hj, heq⟩ := Finset.exists_mem_eq_inf' hJ (fun j => q j x) + change ‖x‖ ≤ M * J.inf' hJ (fun j => q j x) + rw [heq] + exact hq_bound j hj x + +private theorem hg_upper (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j + ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) : (g J hJ a b) x ≤ (C J hJ a b) * ‖x‖ := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let j₀ := hJ.choose + have hj₀ : j₀ ∈ J := hj₀ J hJ + let C := max (a j₀)⁻¹ (b j₀)⁻¹ + change (g x ≤ C * ‖x‖) + apply (Finset.inf'_le (fun j => q j x) hj₀).trans + change max (|x.1| / a j₀) (|x.2| / b j₀) ≤ C * ‖x‖ + apply max_le + · rw [div_eq_mul_inv, mul_comm C] + exact mul_le_mul (by simpa using norm_fst_le x) (le_max_left _ _) + (inv_nonneg.mpr (ha j₀ hj₀).le) (norm_nonneg x) + · rw [div_eq_mul_inv, mul_comm C] + exact mul_le_mul (by simpa using norm_snd_le x) (le_max_right _ _) + (inv_nonneg.mpr (hb j₀ hj₀).le) (norm_nonneg x) + +private theorem hunit (x : ℝ × ℝ) (hx : x ≠ 0) : ‖‖x‖⁻¹ • x‖ = 1 := by + classical + rw [norm_smul, Real.norm_eq_abs, abs_of_nonneg (inv_nonneg.mpr (norm_nonneg x)), + inv_mul_cancel₀ (norm_ne_zero_iff.mpr hx)] + +private theorem hR_normalized (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha + : ∀ j ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) (hx : x ≠ 0) : (R J hJ a b) (‖x‖⁻¹ • + x) = ‖x‖ / (g J hJ a b) x := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hg_smul (t : ℝ) (ht : 0 ≤ t) (x : ℝ × ℝ) : g (t • x) = t * g x := hg_smul J hJ a b t ht x + have hR_eq (x : ℝ × ℝ) (hx : x ≠ 0) : R x = (g x)⁻¹ := hR_eq J hJ a b ha hb x hx + have hunit (x : ℝ × ℝ) (hx : x ≠ 0) : ‖‖x‖⁻¹ • x‖ = 1 := hunit x hx + change (R (‖x‖⁻¹ • x) = ‖x‖ / g x) + have hu0 : ‖x‖⁻¹ • x ≠ 0 := by + intro h + have hh := hunit x hx + simp [h] at hh + rw [hR_eq _ hu0, hg_smul _ (inv_nonneg.mpr (norm_nonneg x)), mul_inv_rev, inv_inv] + simp only [div_eq_mul_inv, mul_comm] + +private noncomputable abbrev F (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) : + (ℝ × ℝ) → (ℝ × ℝ) := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + exact fun x => R (‖x‖⁻¹ • x) • x + +private noncomputable abbrev G (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) : + (ℝ × ℝ) → (ℝ × ℝ) := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + exact fun x => (R (‖x‖⁻¹ • x))⁻¹ • x + +private theorem hF_zero (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) : (F J hJ + a b) 0 = 0 := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + let F : (ℝ × ℝ) → (ℝ × ℝ) := fun x => R (‖x‖⁻¹ • x) • x + change (F 0 = 0) + simp [F] + +private theorem hG_zero (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) : (G J hJ + a b) 0 = 0 := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + let G : (ℝ × ℝ) → (ℝ × ℝ) := fun x => (R (‖x‖⁻¹ • x))⁻¹ • x + change (G 0 = 0) + simp [G] + +private theorem hF_formula (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ + j ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) : (F J hJ a b) x = (‖x‖ / (g J hJ a b) x) + • x := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hR_normalized (x : ℝ × ℝ) (hx : x ≠ 0) : R (‖x‖⁻¹ • x) = ‖x‖ / g x := hR_normalized J hJ a + b ha hb x hx + let F : (ℝ × ℝ) → (ℝ × ℝ) := fun x => R (‖x‖⁻¹ • x) • x + have hF_zero : F 0 = 0 := hF_zero J hJ a b + change (F x = (‖x‖ / g x) • x) + by_cases hx : x = 0 + · simp [hx, hF_zero] + · change R (‖x‖⁻¹ • x) • x = _ + rw [hR_normalized x hx] + +private theorem hG_formula (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ + j ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) : (G J hJ a b) x = ((g J hJ a b) x / ‖x‖) + • x := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hR_normalized (x : ℝ × ℝ) (hx : x ≠ 0) : R (‖x‖⁻¹ • x) = ‖x‖ / g x := hR_normalized J hJ a + b ha hb x hx + let G : (ℝ × ℝ) → (ℝ × ℝ) := fun x => (R (‖x‖⁻¹ • x))⁻¹ • x + have hG_zero : G 0 = 0 := hG_zero J hJ a b + change (G x = (g x / ‖x‖) • x) + by_cases hx : x = 0 + · simp [hx, hG_zero] + · change (R (‖x‖⁻¹ • x))⁻¹ • x = _ + rw [hR_normalized x hx, inv_div] + +private theorem hF_norm (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j + ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) : ‖(F J hJ a b) x‖ = (‖x‖ / (g J hJ a b) x) + * ‖x‖ := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hg_nonneg (x : ℝ × ℝ) : 0 ≤ g x := hg_nonneg J hJ a b ha x + let F : (ℝ × ℝ) → (ℝ × ℝ) := fun x => R (‖x‖⁻¹ • x) • x + have hF_formula (x : ℝ × ℝ) : F x = (‖x‖ / g x) • x := hF_formula J hJ a b ha hb x + change (‖F x‖ = (‖x‖ / g x) * ‖x‖) + rw [hF_formula, norm_smul, Real.norm_eq_abs, + abs_of_nonneg (div_nonneg (norm_nonneg x) (hg_nonneg x))] + +private theorem hG_norm (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j + ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) : ‖(G J hJ a b) x‖ = (g J hJ a b) x := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hg_nonneg (x : ℝ × ℝ) : 0 ≤ g x := hg_nonneg J hJ a b ha x + have hg_zero : g 0 = 0 := hg_zero J hJ a b + let G : (ℝ × ℝ) → (ℝ × ℝ) := fun x => (R (‖x‖⁻¹ • x))⁻¹ • x + have hG_zero : G 0 = 0 := hG_zero J hJ a b + have hG_formula (x : ℝ × ℝ) : G x = (g x / ‖x‖) • x := hG_formula J hJ a b ha hb x + change (‖G x‖ = g x) + by_cases hx : x = 0 + · simp [hx, hG_zero, hg_zero] + · rw [hG_formula, norm_smul, Real.norm_eq_abs, + abs_of_nonneg (div_nonneg (hg_nonneg x) (norm_nonneg x)), + div_mul_cancel₀ _ (norm_ne_zero_iff.mpr hx)] + +private theorem hgF (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j ∈ J, + 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) : (g J hJ a b) ((F J hJ a b) x) = ‖x‖ := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hg_nonneg (x : ℝ × ℝ) : 0 ≤ g x := hg_nonneg J hJ a b ha x + have hg_pos (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < g x := hg_pos J hJ a b ha hb x hx + have hg_zero : g 0 = 0 := hg_zero J hJ a b + have hg_smul (t : ℝ) (ht : 0 ≤ t) (x : ℝ × ℝ) : g (t • x) = t * g x := hg_smul J hJ a b t ht x + let F : (ℝ × ℝ) → (ℝ × ℝ) := fun x => R (‖x‖⁻¹ • x) • x + have hF_zero : F 0 = 0 := hF_zero J hJ a b + have hF_formula (x : ℝ × ℝ) : F x = (‖x‖ / g x) • x := hF_formula J hJ a b ha hb x + change (g (F x) = ‖x‖) + by_cases hx : x = 0 + · simp [hx, hF_zero, hg_zero] + · rw [hF_formula, hg_smul _ (div_nonneg (norm_nonneg x) (hg_nonneg x)), + div_mul_cancel₀ _ (hg_pos x hx).ne'] + +private theorem hGF (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j ∈ J, + 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) : (G J hJ a b) ((F J hJ a b) x) = x := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hg_pos (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < g x := hg_pos J hJ a b ha hb x hx + let F : (ℝ × ℝ) → (ℝ × ℝ) := fun x => R (‖x‖⁻¹ • x) • x + let G : (ℝ × ℝ) → (ℝ × ℝ) := fun x => (R (‖x‖⁻¹ • x))⁻¹ • x + have hF_zero : F 0 = 0 := hF_zero J hJ a b + have hG_zero : G 0 = 0 := hG_zero J hJ a b + have hF_formula (x : ℝ × ℝ) : F x = (‖x‖ / g x) • x := hF_formula J hJ a b ha hb x + have hG_formula (x : ℝ × ℝ) : G x = (g x / ‖x‖) • x := hG_formula J hJ a b ha hb x + have hF_norm (x : ℝ × ℝ) : ‖F x‖ = (‖x‖ / g x) * ‖x‖ := hF_norm J hJ a b ha hb x + have hgF (x : ℝ × ℝ) : g (F x) = ‖x‖ := hgF J hJ a b ha hb x + change (G (F x) = x) + by_cases hx : x = 0 + · simp [hx, hF_zero, hG_zero] + · have hn := norm_ne_zero_iff.mpr hx + have hg := (hg_pos x hx).ne' + rw [hG_formula, hgF, hF_norm, hF_formula, smul_smul] + have he : ‖x‖ / (‖x‖ / g x * ‖x‖) * (‖x‖ / g x) = 1 := by + field_simp + rw [he, one_smul] + +private theorem hFG (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j ∈ J, + 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) : (F J hJ a b) ((G J hJ a b) x) = x := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hg_nonneg (x : ℝ × ℝ) : 0 ≤ g x := hg_nonneg J hJ a b ha x + have hg_pos (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < g x := hg_pos J hJ a b ha hb x hx + have hg_smul (t : ℝ) (ht : 0 ≤ t) (x : ℝ × ℝ) : g (t • x) = t * g x := hg_smul J hJ a b t ht x + let F : (ℝ × ℝ) → (ℝ × ℝ) := fun x => R (‖x‖⁻¹ • x) • x + let G : (ℝ × ℝ) → (ℝ × ℝ) := fun x => (R (‖x‖⁻¹ • x))⁻¹ • x + have hF_zero : F 0 = 0 := hF_zero J hJ a b + have hG_zero : G 0 = 0 := hG_zero J hJ a b + have hF_formula (x : ℝ × ℝ) : F x = (‖x‖ / g x) • x := hF_formula J hJ a b ha hb x + have hG_formula (x : ℝ × ℝ) : G x = (g x / ‖x‖) • x := hG_formula J hJ a b ha hb x + have hG_norm (x : ℝ × ℝ) : ‖G x‖ = g x := hG_norm J hJ a b ha hb x + change (F (G x) = x) + by_cases hx : x = 0 + · simp [hx, hF_zero, hG_zero] + · have hn := norm_ne_zero_iff.mpr hx + have hg := (hg_pos x hx).ne' + rw [hF_formula, hG_norm] + rw [show g (G x) = (g x / ‖x‖) * g x from + by rw [hG_formula, hg_smul _ (div_nonneg (hg_nonneg x) (norm_nonneg x))], + hG_formula, smul_smul] + have he : g x / (g x / ‖x‖ * g x) * (g x / ‖x‖) = 1 := by + field_simp + rw [he, one_smul] + +private theorem hF_bound (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j + ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) : ‖(F J hJ a b) x‖ ≤ (M J hJ a b) * ‖x‖ := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hg_pos (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < g x := hg_pos J hJ a b ha hb x hx + let M := J.sup' hJ (fun j => max (a j) (b j)) + have hg_lower (x : ℝ × ℝ) : ‖x‖ ≤ M * g x := hg_lower J hJ a b ha hb x + let F : (ℝ × ℝ) → (ℝ × ℝ) := fun x => R (‖x‖⁻¹ • x) • x + have hF_zero : F 0 = 0 := hF_zero J hJ a b + have hF_norm (x : ℝ × ℝ) : ‖F x‖ = (‖x‖ / g x) * ‖x‖ := hF_norm J hJ a b ha hb x + dsimp only [CenteredRectangleDiskConstruction.M] at * + change (‖F x‖ ≤ M * ‖x‖) + by_cases hx : x = 0 + · simp [hx, hF_zero] + · rw [hF_norm] + exact mul_le_mul_of_nonneg_right + ((div_le_iff₀ (hg_pos x hx)).mpr (hg_lower x)) (norm_nonneg x) + +private theorem hG_bound (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j + ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) : ‖(G J hJ a b) x‖ ≤ (C J hJ a b) * ‖x‖ := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + let j₀ := hJ.choose + let C := max (a j₀)⁻¹ (b j₀)⁻¹ + have hg_upper (x : ℝ × ℝ) : g x ≤ C * ‖x‖ := hg_upper J hJ a b ha hb x + let G : (ℝ × ℝ) → (ℝ × ℝ) := fun x => (R (‖x‖⁻¹ • x))⁻¹ • x + have hG_norm (x : ℝ × ℝ) : ‖G x‖ = g x := hG_norm J hJ a b ha hb x + change (‖G x‖ ≤ C * ‖x‖) + rw [hG_norm] + exact hg_upper x + +private theorem hradial_cont (f : (ℝ × ℝ) → (ℝ × ℝ)) (K : ℝ) (hK : 0 ≤ K) + (hf0 : f 0 = 0) (hf_bound : ∀ x, ‖f x‖ ≤ K * ‖x‖) + (hf_off : ∀ x, x ≠ 0 → ContinuousAt f x) : Continuous f := by + classical + apply continuous_iff_continuousAt.mpr + intro x + by_cases hx : x = 0 + · subst x + apply Metric.continuousAt_iff.mpr + intro ε hε + refine ⟨ε / (K + 1), div_pos hε (by linarith), ?_⟩ + intro x hx + rw [dist_zero_right] at hx + rw [hf0, dist_zero_right] + apply lt_of_le_of_lt (hf_bound x) + have hh := (lt_div_iff₀ (by linarith : 0 < K + 1)).mp hx + nlinarith [norm_nonneg x] + · exact hf_off x hx + +private theorem hF_cont (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j + ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) : Continuous (F J hJ a b) := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hg_pos (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < g x := hg_pos J hJ a b ha hb x hx + have hg_cont : Continuous g := hg_cont J hJ a b + let M := J.sup' hJ (fun j => max (a j) (b j)) + have hM_pos : 0 < M := hM_pos J hJ a b ha + let F : (ℝ × ℝ) → (ℝ × ℝ) := fun x => R (‖x‖⁻¹ • x) • x + have hF_zero : F 0 = 0 := hF_zero J hJ a b + have hF_formula (x : ℝ × ℝ) : F x = (‖x‖ / g x) • x := hF_formula J hJ a b ha hb x + have hF_bound (x : ℝ × ℝ) : ‖F x‖ ≤ M * ‖x‖ := hF_bound J hJ a b ha hb x + have hradial_cont (f : (ℝ × ℝ) → (ℝ × ℝ)) (K : ℝ) (hK : 0 ≤ K) + (hf0 : f 0 = 0) (hf_bound : ∀ x, ‖f x‖ ≤ K * ‖x‖) + (hf_off : ∀ x, x ≠ 0 → ContinuousAt f x) : Continuous f := hradial_cont f K hK hf0 hf_bound + hf_off + change (Continuous F) + have he : F = fun x => (‖x‖ / g x) • x := funext hF_formula + apply hradial_cont F M hM_pos.le hF_zero hF_bound + intro x hx + rw [he] + exact (continuous_norm.continuousAt.div hg_cont.continuousAt + (hg_pos x hx).ne').smul continuousAt_id + +private theorem hG_cont (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j + ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) : Continuous (G J hJ a b) := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hg_cont : Continuous g := hg_cont J hJ a b + let j₀ := hJ.choose + let C := max (a j₀)⁻¹ (b j₀)⁻¹ + have hC_pos : 0 < C := hC_pos J hJ a b ha + let G : (ℝ × ℝ) → (ℝ × ℝ) := fun x => (R (‖x‖⁻¹ • x))⁻¹ • x + have hG_zero : G 0 = 0 := hG_zero J hJ a b + have hG_formula (x : ℝ × ℝ) : G x = (g x / ‖x‖) • x := hG_formula J hJ a b ha hb x + have hG_bound (x : ℝ × ℝ) : ‖G x‖ ≤ C * ‖x‖ := hG_bound J hJ a b ha hb x + have hradial_cont (f : (ℝ × ℝ) → (ℝ × ℝ)) (K : ℝ) (hK : 0 ≤ K) + (hf0 : f 0 = 0) (hf_bound : ∀ x, ‖f x‖ ≤ K * ‖x‖) + (hf_off : ∀ x, x ≠ 0 → ContinuousAt f x) : Continuous f := hradial_cont f K hK hf0 hf_bound + hf_off + change (Continuous G) + have he : G = fun x => (g x / ‖x‖) • x := funext hG_formula + apply hradial_cont G C hC_pos.le hG_zero hG_bound + intro x hx + rw [he] + exact (hg_cont.continuousAt.div continuous_norm.continuousAt + (norm_ne_zero_iff.mpr hx)).smul continuousAt_id + +private noncomputable abbrev H (J : Finset Nat) (hJ : J.Nonempty) (c : ℝ × ℝ) (a : Nat → ℝ) (b : + Nat → ℝ) (ha : ∀ j ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) : (ℝ × ℝ) ≃ₜ (ℝ × ℝ) := by + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + let F : (ℝ × ℝ) → (ℝ × ℝ) := fun x => R (‖x‖⁻¹ • x) • x + let G : (ℝ × ℝ) → (ℝ × ℝ) := fun x => (R (‖x‖⁻¹ • x))⁻¹ • x + have hGF (x : ℝ × ℝ) : G (F x) = x := hGF J hJ a b ha hb x + have hFG (x : ℝ × ℝ) : F (G x) = x := hFG J hJ a b ha hb x + have hF_cont : Continuous F := hF_cont J hJ a b ha hb + have hG_cont : Continuous G := hG_cont J hJ a b ha hb + exact { + toFun := fun x => c + F x + invFun := fun x => G (x - c) + left_inv := fun x => by simpa using hGF x + right_inv := fun x => by + change c + F (G (x - c)) = x + rw [hFG] + simp + continuous_toFun := continuous_const.add hF_cont + continuous_invFun := hG_cont.comp (continuous_id.sub continuous_const) } + +end CenteredRectangleDiskConstruction + +theorem P3092T1CenteredRectangleDisk + (J : Finset Nat) (hJ : J.Nonempty) (c : Real × Real) + (a b : Nat → Real) + (ha : ∀ j ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) : + TopologicalDisk + (⋃ j ∈ J, + Set.Icc (c.1 - a j, c.2 - b j) (c.1 + a j, c.2 + b j)) := by +-- BODY + classical + let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) + let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) + let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) + have hq_nonneg (j : Nat) (hj : j ∈ J) (x : ℝ × ℝ) : 0 ≤ q j x := + CenteredRectangleDiskConstruction.hq_nonneg J a b ha j hj x + have hq_pos (j : Nat) (hj : j ∈ J) (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < q j x := + CenteredRectangleDiskConstruction.hq_pos J a b ha hb j hj x hx + have hg_nonneg (x : ℝ × ℝ) : 0 ≤ g x := CenteredRectangleDiskConstruction.hg_nonneg J hJ a b ha x + have hg_pos (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < g x := CenteredRectangleDiskConstruction.hg_pos J hJ + a b ha hb x hx + have hg_zero : g 0 = 0 := CenteredRectangleDiskConstruction.hg_zero J hJ a b + have hq_smul (t : ℝ) (ht : 0 ≤ t) (j : Nat) (x : ℝ × ℝ) : + q j (t • x) = t * q j x := CenteredRectangleDiskConstruction.hq_smul a b t ht j x + have hg_smul (t : ℝ) (ht : 0 ≤ t) (x : ℝ × ℝ) : g (t • x) = t * g x := + CenteredRectangleDiskConstruction.hg_smul J hJ a b t ht x + have hg_cont : Continuous g := CenteredRectangleDiskConstruction.hg_cont J hJ a b + -- The reciprocal of the minimum gauge is the attained outer ray radius. + have hR_eq (x : ℝ × ℝ) (hx : x ≠ 0) : R x = (g x)⁻¹ := CenteredRectangleDiskConstruction.hR_eq + J hJ a b ha hb x hx + have hR_attained (x : ℝ × ℝ) : ∃ j ∈ J, R x = (q j x)⁻¹ := + CenteredRectangleDiskConstruction.hR_attained J hJ a b x + have hR_pos (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < R x := CenteredRectangleDiskConstruction.hR_pos J hJ + a b ha hb x hx + have hR_cont (x : ℝ × ℝ) (hx : x ≠ 0) : ContinuousAt R x := + CenteredRectangleDiskConstruction.hR_cont J hJ a b ha hb x hx + have hmem (x : ℝ × ℝ) : + c + x ∈ (⋃ j ∈ J, Set.Icc (c.1 - a j, c.2 - b j) + (c.1 + a j, c.2 + b j)) ↔ g x ≤ 1 := CenteredRectangleDiskConstruction.hmem J hJ c a b + ha hb x + have hray (u : ℝ × ℝ) (hu : ‖u‖ = 1) (t : ℝ) (ht : 0 ≤ t) : + c + t • u ∈ (⋃ j ∈ J, Set.Icc (c.1 - a j, c.2 - b j) + (c.1 + a j, c.2 + b j)) ↔ t ≤ R u := CenteredRectangleDiskConstruction.hray J hJ c a b + ha hb u hu t ht + -- Uniform bounds suffice for continuity at the center in both directions. + let j₀ := hJ.choose + have hj₀ : j₀ ∈ J := CenteredRectangleDiskConstruction.hj₀ J hJ + let M := J.sup' hJ (fun j => max (a j) (b j)) + let C := max (a j₀)⁻¹ (b j₀)⁻¹ + have hM_pos : 0 < M := CenteredRectangleDiskConstruction.hM_pos J hJ a b ha + have hC_pos : 0 < C := CenteredRectangleDiskConstruction.hC_pos J hJ a b ha + have hq_bound (j : Nat) (hj : j ∈ J) (x : ℝ × ℝ) : ‖x‖ ≤ M * q j x := + CenteredRectangleDiskConstruction.hq_bound J hJ a b ha hb j hj x + have hg_lower (x : ℝ × ℝ) : ‖x‖ ≤ M * g x := CenteredRectangleDiskConstruction.hg_lower J hJ a + b ha hb x + have hg_upper (x : ℝ × ℝ) : g x ≤ C * ‖x‖ := CenteredRectangleDiskConstruction.hg_upper J hJ a + b ha hb x + have hunit (x : ℝ × ℝ) (hx : x ≠ 0) : ‖‖x‖⁻¹ • x‖ = 1 := + CenteredRectangleDiskConstruction.hunit x hx + have hR_normalized (x : ℝ × ℝ) (hx : x ≠ 0) : R (‖x‖⁻¹ • x) = ‖x‖ / g x := + CenteredRectangleDiskConstruction.hR_normalized J hJ a b ha hb x hx + let F : (ℝ × ℝ) → (ℝ × ℝ) := fun x => R (‖x‖⁻¹ • x) • x + let G : (ℝ × ℝ) → (ℝ × ℝ) := fun x => (R (‖x‖⁻¹ • x))⁻¹ • x + have hF_zero : F 0 = 0 := CenteredRectangleDiskConstruction.hF_zero J hJ a b + have hG_zero : G 0 = 0 := CenteredRectangleDiskConstruction.hG_zero J hJ a b + have hF_formula (x : ℝ × ℝ) : F x = (‖x‖ / g x) • x := + CenteredRectangleDiskConstruction.hF_formula J hJ a b ha hb x + have hG_formula (x : ℝ × ℝ) : G x = (g x / ‖x‖) • x := + CenteredRectangleDiskConstruction.hG_formula J hJ a b ha hb x + have hF_norm (x : ℝ × ℝ) : ‖F x‖ = (‖x‖ / g x) * ‖x‖ := + CenteredRectangleDiskConstruction.hF_norm J hJ a b ha hb x + have hG_norm (x : ℝ × ℝ) : ‖G x‖ = g x := CenteredRectangleDiskConstruction.hG_norm J hJ a b ha + hb x + have hgF (x : ℝ × ℝ) : g (F x) = ‖x‖ := CenteredRectangleDiskConstruction.hgF J hJ a b ha hb x + have hGF (x : ℝ × ℝ) : G (F x) = x := CenteredRectangleDiskConstruction.hGF J hJ a b ha hb x + have hFG (x : ℝ × ℝ) : F (G x) = x := CenteredRectangleDiskConstruction.hFG J hJ a b ha hb x + have hF_bound (x : ℝ × ℝ) : ‖F x‖ ≤ M * ‖x‖ := CenteredRectangleDiskConstruction.hF_bound J hJ + a b ha hb x + have hG_bound (x : ℝ × ℝ) : ‖G x‖ ≤ C * ‖x‖ := CenteredRectangleDiskConstruction.hG_bound J hJ + a b ha hb x + have hradial_cont (f : (ℝ × ℝ) → (ℝ × ℝ)) (K : ℝ) (hK : 0 ≤ K) + (hf0 : f 0 = 0) (hf_bound : ∀ x, ‖f x‖ ≤ K * ‖x‖) + (hf_off : ∀ x, x ≠ 0 → ContinuousAt f x) : Continuous f := + CenteredRectangleDiskConstruction.hradial_cont f K hK hf0 hf_bound hf_off + have hF_cont : Continuous F := CenteredRectangleDiskConstruction.hF_cont J hJ a b ha hb + have hG_cont : Continuous G := CenteredRectangleDiskConstruction.hG_cont J hJ a b ha hb + let H : (ℝ × ℝ) ≃ₜ (ℝ × ℝ) := + { toFun := fun x => c + F x + invFun := fun x => G (x - c) + left_inv := fun x => by simpa using hGF x + right_inv := fun x => by + change c + F (G (x - c)) = x + rw [hFG] + simp + continuous_toFun := continuous_const.add hF_cont + continuous_invFun := hG_cont.comp (continuous_id.sub continuous_const) } + refine ⟨H.subtype ?_⟩ + intro x + change x ∈ Metric.closedBall (0 : ℝ × ℝ) 1 ↔ c + F x ∈ _ + rw [hmem, hgF, Metric.mem_closedBall, dist_zero_right] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3092T1DiamondCenteredRectangles.lean b/LeanPool/ApollonianSuperharmonic/P3092T1DiamondCenteredRectangles.lean new file mode 100644 index 0000000000..52870be7e4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3092T1DiamondCenteredRectangles.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import Mathlib.Order.Interval.Finset.Nat +public import Mathlib.Algebra.Order.Floor.Semiring +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P3092T1DiamondCenteredRectangles] + +/-! +# P3092T1DiamondCenteredRectangles + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3092T1DiamondCenteredRectangles (k : Nat) (hk : 0 < k) : + TileRealization (DiamondTile k) = + ⋃ j ∈ Finset.Icc 1 k, + Set.Icc (-(j : Real), (j : Real) - 1) + ((j : Real), 2 * (k : Real) - (j : Real) + 1) := by +-- BODY + classical + have hsegment (L U : Nat) (hLU : L ≤ U) (Y : Real) + (hL : (L : Real) ≤ Y) (hU : Y ≤ (U : Real) + 1) : + ∃ y : Nat, L ≤ y ∧ y ≤ U ∧ (y : Real) ≤ Y ∧ Y ≤ (y : Real) + 1 := by + have hfloor : L ≤ ⌊Y⌋₊ := Nat.le_floor hL + refine ⟨min ⌊Y⌋₊ U, Nat.le_min.mpr ⟨hfloor, hLU⟩, Nat.min_le_right _ _, ?_⟩ + by_cases h : ⌊Y⌋₊ ≤ U + · rw [Nat.min_eq_left h] + exact ⟨Nat.floor_le (le_trans (Nat.cast_nonneg L) hL), + (Nat.lt_floor_add_one Y).le⟩ + · rw [Nat.min_eq_right (by omega)] + have hUF : (U : Real) ≤ (⌊Y⌋₊ : Real) := by exact_mod_cast (by omega : U ≤ ⌊Y⌋₊) + exact ⟨hUF.trans (Nat.floor_le (le_trans (Nat.cast_nonneg L) hL)), hU⟩ + ext p + constructor + · intro hp + rcases Set.mem_iUnion.mp hp with ⟨x, hp⟩ + rcases Set.mem_iUnion.mp hp with ⟨hx, hp⟩ + change x ∈ DiamondCellDomain k at hx + rcases Finset.mem_biUnion.mp hx with ⟨y, hy, hx⟩ + rcases Finset.mem_image.mp hx with ⟨i, hi, rfl⟩ + have hyk := Finset.mem_range.mp hy + have hik := Finset.mem_range.mp hi + let r := min (y + 1) (2 * k - y) + have hrpos : 1 ≤ r := by dsimp [r]; omega + have hrk : r ≤ k := by dsimp [r]; omega + have hry : r ≤ y + 1 := Nat.min_le_left _ _ + have hry' : r + y ≤ 2 * k := by dsimp [r]; omega + have hreal_i : (i : Real) + 1 ≤ 2 * (r : Real) := by exact_mod_cast hik + have hreal_y : (r : Real) ≤ (y : Real) + 1 := by exact_mod_cast hry + have hreal_y' : (r : Real) + (y : Real) ≤ 2 * (k : Real) := by + exact_mod_cast hry' + have hreal_i0 : 0 ≤ (i : Real) := Nat.cast_nonneg _ + have hp' : + ((i : Real) - (r : Real) ≤ p.1 ∧ (y : Real) ≤ p.2) ∧ + (p.1 ≤ (i : Real) - (r : Real) + 1 ∧ p.2 ≤ (y : Real) + 1) := by + simpa only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, + Int.cast_sub, Int.cast_natCast] using hp + refine Set.mem_iUnion.mpr ⟨r, Set.mem_iUnion.mpr + ⟨Finset.mem_Icc.mpr ⟨hrpos, hrk⟩, ?_⟩⟩ + simp only [Set.mem_Icc, Prod.le_def] + constructor <;> constructor <;> linarith [hp'.1.1, hp'.1.2, hp'.2.1, hp'.2.2] + · intro hp + rcases Set.mem_iUnion.mp hp with ⟨j, hp⟩ + rcases Set.mem_iUnion.mp hp with ⟨hj, hp⟩ + rcases Finset.mem_Icc.mp hj with ⟨hj1, hjk⟩ + have hj2k : j ≤ 2 * k := by omega + have hp' := hp + simp only [Set.mem_Icc, Prod.le_def] at hp' + have hL : ((j - 1 : Nat) : Real) ≤ p.2 := by + simpa only [Nat.cast_sub hj1, Nat.cast_one] using hp'.1.2 + have hU : p.2 ≤ ((2 * k - j : Nat) : Real) + 1 := by + simpa only [Nat.cast_sub hj2k, Nat.cast_mul, Nat.cast_ofNat] using hp'.2.2 + obtain ⟨y, hyl, hyu, hyp, hpy⟩ := + hsegment (j - 1) (2 * k - j) (by omega) p.2 hL hU + have hyk : y < 2 * k := by omega + let r := min (y + 1) (2 * k - y) + have hjr : j ≤ r := by dsimp [r]; omega + have hrpos : 0 < r := by omega + have hjr' : (j : Real) ≤ (r : Real) := by exact_mod_cast hjr + have hX0 : 0 ≤ p.1 + (r : Real) := by linarith [hp'.1.1] + have hXU : p.1 + (r : Real) ≤ ((2 * r - 1 : Nat) : Real) + 1 := by + rw [Nat.cast_sub (by omega : 1 ≤ 2 * r)] + push_cast + linarith [hp'.2.1] + obtain ⟨i, hi0, hiu, hip, hpi⟩ := + hsegment 0 (2 * r - 1) (Nat.zero_le _) (p.1 + (r : Real)) (by simpa using hX0) hXU + have hir : i < 2 * r := by omega + let x : GaussianInt := ⟨(i : Int) - (r : Int), (y : Int)⟩ + have hx : x ∈ (DiamondTile k).cells := by + change x ∈ DiamondCellDomain k + apply Finset.mem_biUnion.mpr + refine ⟨y, Finset.mem_range.mpr hyk, ?_⟩ + exact Finset.mem_image.mpr ⟨i, Finset.mem_range.mpr hir, rfl⟩ + refine Set.mem_iUnion.mpr ⟨x, Set.mem_iUnion.mpr ⟨hx, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, x, + Int.cast_sub, Int.cast_natCast] + constructor <;> constructor <;> linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3102T2CommonEdgeSectorTransition.lean b/LeanPool/ApollonianSuperharmonic/P3102T2CommonEdgeSectorTransition.lean new file mode 100644 index 0000000000..3361664c04 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3102T2CommonEdgeSectorTransition.lean @@ -0,0 +1,149 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell + +-- [TABLET NODE: P3102T2CommonEdgeSectorTransition] + +/-! +# P3102T2CommonEdgeSectorTransition + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3102T2CommonEdgeSectorTransition + (U V : ProtoTile) (x : GaussianInt) (e : Finset GaussianInt) + (hdisjoint : Disjoint U.cells V.cells) (hxe : x ∈ e) + (he : e ∈ FootprintEdges U ∩ FootprintEdges V) : + ∃ j : Fin 4, + e = ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] j ∧ + ((LatticeVertexIncidentCell x j ∈ U.cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ V.cells) ∨ + (LatticeVertexIncidentCell x j ∈ V.cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ U.cells)) := by +-- BODY + classical + let I : GaussianInt := ⟨0, 1⟩ + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] + have horiz_unique (u v : GaussianInt) + (h : ({u, u + 1} : Finset GaussianInt) = {v, v + 1}) : u = v := by + have hu : u = v ∨ u = v + 1 := by + have : u ∈ ({v, v + 1} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hv : v = u ∨ v = u + 1 := by + have : v ∈ ({u, u + 1} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hu with huv | huv + · exact huv + rcases hv with hvu | hvu + · exact hvu.symm + · have hre := congrArg Zsqrtd.re huv + have hre' := congrArg Zsqrtd.re hvu + norm_num at hre hre' + omega + have vert_unique (u v : GaussianInt) + (h : ({u, u + I} : Finset GaussianInt) = {v, v + I}) : u = v := by + have hu : u = v ∨ u = v + I := by + have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hv : v = u ∨ v = u + I := by + have : v ∈ ({u, u + I} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hu with huv | huv + · exact huv + rcases hv with hvu | hvu + · exact hvu.symm + · have him := congrArg Zsqrtd.im huv + have him' := congrArg Zsqrtd.im hvu + simp [I] at him him' + omega + have horiz_ne_vert (u v : GaussianInt) : + ({u, u + 1} : Finset GaussianInt) ≠ {v, v + I} := by + intro h + have hu : u = v ∨ u = v + I := by + have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hu1 : u + 1 = v ∨ u + 1 = v + I := by + have : u + 1 ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + rcases hu with hu | hu <;> rcases hu1 with hu1 | hu1 + all_goals + have hre := congrArg Zsqrtd.re hu + have him := congrArg Zsqrtd.im hu + have hre1 := congrArg Zsqrtd.re hu1 + have him1 := congrArg Zsqrtd.im hu1 + simp [I] at hre him hre1 him1 + omega + have hd := Finset.disjoint_left.mp hdisjoint + rw [CellDisjointCommonEdgesBoundary U V hdisjoint] at he + rcases he.1 with ⟨u, ⟨heu, hu⟩ | ⟨heu, hu⟩⟩ + · rcases he.2 with ⟨v, ⟨hev, hv⟩ | ⟨hev, hv⟩⟩ + · have huv : u = v := horiz_unique u v (heu.symm.trans hev) + subst v + have hxuv : x = u ∨ x = u + 1 := by + rw [heu] at hxe + simpa using hxe + rcases hxuv with rfl | rfl + · rcases hu with hu | hu <;> rcases hv with hv | hv + · exact (hd hu.1 hv.1).elim + · refine ⟨3, by simpa [edgeAt], Or.inr ⟨?_, ?_⟩⟩ + · simpa [LatticeVertexIncidentCell, I] using hv.2 + · simpa [LatticeVertexIncidentCell, I] using hu.1 + · refine ⟨3, by simpa [edgeAt], Or.inl ⟨?_, ?_⟩⟩ + · simpa [LatticeVertexIncidentCell, I] using hu.2 + · simpa [LatticeVertexIncidentCell, I] using hv.1 + · exact (hd hu.2 hv.2).elim + · rcases hu with hu | hu <;> rcases hv with hv | hv + · exact (hd hu.1 hv.1).elim + · refine ⟨1, by simpa [edgeAt, I, Zsqrtd.ext_iff], Or.inl ⟨?_, ?_⟩⟩ + · simpa [LatticeVertexIncidentCell, I] using hu.1 + · simpa [LatticeVertexIncidentCell, I] using hv.2 + · refine ⟨1, by simpa [edgeAt, I, Zsqrtd.ext_iff], Or.inr ⟨?_, ?_⟩⟩ + · simpa [LatticeVertexIncidentCell, I] using hv.1 + · simpa [LatticeVertexIncidentCell, I] using hu.2 + · exact (hd hu.2 hv.2).elim + · exact (horiz_ne_vert u v (heu.symm.trans hev)).elim + · rcases he.2 with ⟨v, ⟨hev, hv⟩ | ⟨hev, hv⟩⟩ + · exact (horiz_ne_vert v u (hev.symm.trans heu)).elim + · have huv : u = v := vert_unique u v (heu.symm.trans hev) + subst v + have hxuv : x = u ∨ x = u + I := by + rw [heu] at hxe + simpa using hxe + rcases hxuv with rfl | rfl + · rcases hu with hu | hu <;> rcases hv with hv | hv + · exact (hd hu.1 hv.1).elim + · refine ⟨0, by simpa [edgeAt], Or.inl ⟨?_, ?_⟩⟩ + · simpa [LatticeVertexIncidentCell, I] using hu.1 + · simpa [LatticeVertexIncidentCell, I] using hv.2 + · refine ⟨0, by simpa [edgeAt], Or.inr ⟨?_, ?_⟩⟩ + · simpa [LatticeVertexIncidentCell, I] using hv.1 + · simpa [LatticeVertexIncidentCell, I] using hu.2 + · exact (hd hu.2 hv.2).elim + · rcases hu with hu | hu <;> rcases hv with hv | hv + · exact (hd hu.1 hv.1).elim + · refine ⟨2, by simpa [edgeAt, I, Zsqrtd.ext_iff], Or.inr ⟨?_, ?_⟩⟩ + · simpa [LatticeVertexIncidentCell, I, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] using hv.2 + · simpa [LatticeVertexIncidentCell, I] using hu.1 + · refine ⟨2, by simpa [edgeAt, I, Zsqrtd.ext_iff], Or.inl ⟨?_, ?_⟩⟩ + · simpa [LatticeVertexIncidentCell, I, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] using hu.2 + · simpa [LatticeVertexIncidentCell, I] using hv.1 + · exact (hd hu.2 hv.2).elim + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3102T2IsolatedRoutedCellSurvival.lean b/LeanPool/ApollonianSuperharmonic/P3102T2IsolatedRoutedCellSurvival.lean new file mode 100644 index 0000000000..09723cc80f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3102T2IsolatedRoutedCellSurvival.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.FootprintVertices + +-- [TABLET NODE: P3102T2IsolatedRoutedCellSurvival] + +/-! +# P3102T2IsolatedRoutedCellSurvival + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3102T2IsolatedRoutedCellSurvival + (P : Fin 3 → Bool → ProtoTile) (O : ProtoTile) (u v : GaussianInt) + (hOA : O.cells ⊆ (P 0 true).cells) + (hOB : O.cells ⊆ (P 0 false).cells) + (hpartition : ∀ z : LatticeCell, ∃! o : PeriodicSubtileIndex, + z ∈ (ModifiedSubtileOccurrenceInterpretation P O u v o).cells) + (hisolated : ∀ m n : Int, + ∀ x ∈ FootprintVertices + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)), + ∀ d : GaussianInt, x ∈ FootprintVertices (⟨{d}, d⟩ : ProtoTile) → + d ∈ (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells ∨ + d ∈ (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) + (a b : PeriodicSubtileIndex) (hab : a ≠ b) + (hpair : ¬ ((a.label = .A ∧ b.label = .B ∨ + a.label = .B ∧ b.label = .A) ∧ + a.first = b.first ∧ a.second = b.second)) + (x c d : GaussianInt) + (hc : c ∈ (SubtileOccurrenceInterpretation P u v a).cells) + (hd : d ∈ (SubtileOccurrenceInterpretation P u v b).cells) + (hxc : x ∈ FootprintVertices (⟨{c}, c⟩ : ProtoTile)) + (hxd : x ∈ FootprintVertices (⟨{d}, d⟩ : ProtoTile)) : + c ∈ (ModifiedSubtileOccurrenceInterpretation P O u v a).cells := by +-- BODY + classical + obtain ⟨_, hseparate⟩ := BandOriginalPairSeparation P O u v hOA hOB hpartition + cases a with + | mk label m n => + cases label with + | B | C | D | E | F => exact hc + | A => + change c ∈ (P 0 true).cells.image + (GaussianTranslation ((m : GaussianInt) * u + (n : GaussianInt) * v)) at hc + obtain ⟨z, hz, heq⟩ := Finset.mem_image.mp hc + change c ∈ ((P 0 true).cells \ O.cells).image + (GaussianTranslation ((m : GaussianInt) * u + (n : GaussianInt) * v)) + refine Finset.mem_image.mpr ⟨z, Finset.mem_sdiff.mpr ⟨hz, ?_⟩, heq⟩ + intro hzO + have hcO : c ∈ + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)).cells := + Finset.mem_image.mpr ⟨z, hzO, heq⟩ + have hxO : x ∈ FootprintVertices + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)) := by + simp only [FootprintVertices, Finset.singleton_nonempty, ite_true, + Finset.mem_singleton, exists_eq_left, Set.mem_ofPred_eq] at hxc + have hne : (TileTranslation O + ((m : GaussianInt) * u + (n : GaussianInt) * v)).cells.Nonempty := ⟨c, hcO⟩ + simp only [FootprintVertices, hne, ite_true, + Set.mem_ofPred_eq] + exact ⟨c, hcO, hxc⟩ + have hbA : b ≠ (⟨.A, m, n⟩ : PeriodicSubtileIndex) := Ne.symm hab + have hbB : b ≠ (⟨.B, m, n⟩ : PeriodicSubtileIndex) := by + intro h + subst b + exact hpair ⟨Or.inl ⟨rfl, rfl⟩, rfl, rfl⟩ + have hdisA := hseparate ⟨.A, m, n⟩ b hab hpair + have hdisB : Disjoint + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells + (SubtileOccurrenceInterpretation P u v b).cells := by + apply hseparate _ _ (Ne.symm hbB) + intro h + rcases h with ⟨hlabels, hm, hn⟩ + have hlabel : b.label = .A := by simpa using hlabels + apply hbA + cases b with + | mk lb mb nb => simp_all + rcases hisolated m n x hxO d hxd with hdA | hdB + · exact Finset.disjoint_left.mp hdisA hdA hd + · exact Finset.disjoint_left.mp hdisB hdB hd + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3102T2OppositeOwnersCommonEdge.lean b/LeanPool/ApollonianSuperharmonic/P3102T2OppositeOwnersCommonEdge.lean new file mode 100644 index 0000000000..92540bfd9d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3102T2OppositeOwnersCommonEdge.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3102T2PeriodicFourSectorObstruction +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths + +-- [TABLET NODE: P3102T2OppositeOwnersCommonEdge] + +/-! +# P3102T2OppositeOwnersCommonEdge + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3102T2OppositeOwnersCommonEdge + {ι : Type} (P : PeriodicTileComplex ι) + (hpartition : ∀ c : LatticeCell, ∃! o : ι, c ∈ (P.tile o).cells) + (a b : ι) (hab : a ≠ b) (x : GaussianInt) (j : Fin 4) + (hma : LatticeVertexIncidentCell x j ∈ (P.tile a).cells) + (hmb : LatticeVertexIncidentCell x (j + 2) ∈ (P.tile b).cells) : + ∃ e : Finset GaussianInt, x ∈ e ∧ + e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b) := by +-- BODY + classical + let owner : Fin 4 → ι := fun k => + (hpartition (LatticeVertexIncidentCell x k)).choose + have howner (k : Fin 4) : + LatticeVertexIncidentCell x k ∈ (P.tile (owner k)).cells := + (hpartition _).choose_spec.1 + have own_a : owner j = a := (hpartition _).unique (howner j) hma + have own_b : owner (j + 2) = b := (hpartition _).unique (howner (j + 2)) hmb + let edgeAt : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, {x - ⟨0, 1⟩, x}, {x, x + 1}] + have radial (k : Fin 4) : x ∈ edgeAt k ∧ + edgeAt k ∈ FootprintEdges (P.tile (owner k)) ∩ + FootprintEdges (P.tile (owner (k + 1))) := by + refine ⟨?_, ?_, ?_⟩ + · fin_cases k <;> simp [edgeAt] + · refine ⟨LatticeVertexIncidentCell x k, howner k, ?_⟩ + fin_cases k <;> simp [LatticeVertexIncidentCell, edgeAt, + sub_eq_add_neg, add_comm, add_left_comm, add_assoc, Finset.pair_comm] + · refine ⟨LatticeVertexIncidentCell x (k + 1), howner (k + 1), ?_⟩ + fin_cases k <;> simp [LatticeVertexIncidentCell, edgeAt, + sub_eq_add_neg, add_comm, add_left_comm, add_assoc, Finset.pair_comm] + by_contra hnone + have prohibit (k : Fin 4) + (hk : (owner k = a ∧ owner (k + 1) = b) ∨ + (owner k = b ∧ owner (k + 1) = a)) : False := by + obtain ⟨hxe, he⟩ := radial k + apply hnone + refine ⟨edgeAt k, hxe, ?_⟩ + rcases hk with h | h + · simpa only [h.1, h.2] using he + · exact ⟨by simpa only [h.2] using he.2, by simpa only [h.1] using he.1⟩ + have hadd : j + 1 + 1 = j + 2 ∧ j + 2 + 1 = j + 3 ∧ j + 3 + 1 = j := by + fin_cases j <;> decide +kernel + have hc_a : owner (j + 1) ≠ a := by + intro h + exact prohibit (j + 1) (Or.inl ⟨h, by rw [hadd.1, own_b]⟩) + have hc_b : owner (j + 1) ≠ b := by + intro h + exact prohibit j (Or.inl ⟨own_a, h⟩) + have hd_a : owner (j + 3) ≠ a := by + intro h + exact prohibit (j + 2) (Or.inr ⟨own_b, by rw [hadd.2.1]; exact h⟩) + have hd_b : owner (j + 3) ≠ b := by + intro h + exact prohibit (j + 3) (Or.inr ⟨h, by rw [hadd.2.2, own_a]⟩) + have hcd : owner (j + 1) ≠ owner (j + 3) := by + intro h + have hm1 := howner (j + 1) + have hm3 : LatticeVertexIncidentCell x (j + 3) ∈ + (P.tile (owner (j + 1))).cells := by + simpa only [h] using howner (j + 3) + have hn0 : LatticeVertexIncidentCell x j ∉ (P.tile (owner (j + 1))).cells := by + intro hc + exact hc_a ((hpartition _).unique hc (by simpa only [own_a] using howner j)) + have hn2 : LatticeVertexIncidentCell x (j + 2) ∉ + (P.tile (owner (j + 1))).cells := by + intro hc + exact hc_b ((hpartition _).unique hc + (by simpa only [own_b] using howner (j + 2))) + have hcheck := (LatticeTileGridStructure _ (P.tiles_are_disks (owner (j + 1)))).2.1 x + fin_cases j <;> + simp [LatticeVertexIncidentCell] at hm1 hm3 hn0 hn2 hcheck <;> + tauto + have hinjective : Function.Injective owner := by + have h02 : owner j ≠ owner (j + 2) := by simpa only [own_a, own_b] using hab + have h10 : owner (j + 1) ≠ owner j := by simpa only [own_a] using hc_a + have h12 : owner (j + 1) ≠ owner (j + 2) := by simpa only [own_b] using hc_b + have h30 : owner (j + 3) ≠ owner j := by simpa only [own_a] using hd_a + have h32 : owner (j + 3) ≠ owner (j + 2) := by simpa only [own_b] using hd_b + intro r s hrs + have positions (k : Fin 4) : k = j ∨ k = j + 1 ∨ k = j + 2 ∨ k = j + 3 := by + fin_cases j <;> fin_cases k <;> decide +kernel + rcases positions r with rfl | rfl | rfl | rfl <;> + rcases positions s with rfl | rfl | rfl | rfl + all_goals first + | rfl + | exact (h02 hrs).elim + | exact (h02 hrs.symm).elim + | exact (h10 hrs).elim + | exact (h10 hrs.symm).elim + | exact (h12 hrs).elim + | exact (h12 hrs.symm).elim + | exact (h30 hrs).elim + | exact (h30 hrs.symm).elim + | exact (h32 hrs).elim + | exact (h32 hrs.symm).elim + | exact (hcd hrs).elim + | exact (hcd hrs.symm).elim + have hregular := (PeriodicTileIntersectionClassification P).2 + obtain ⟨_, f, g, _, hf, hg, _, hpath⟩ := + (PeriodicTileIntersectionPaths P hregular (owner 0) (owner 1) + (hinjective.ne (by decide +kernel))).1.mpr ⟨edgeAt 0, (radial 0).2⟩ + exact P3102T2PeriodicFourSectorObstruction P hregular hpartition x owner + howner hinjective f g hf hg hpath + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3102T2PeriodicFourSectorObstruction.lean b/LeanPool/ApollonianSuperharmonic/P3102T2PeriodicFourSectorObstruction.lean new file mode 100644 index 0000000000..86687a4e8c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3102T2PeriodicFourSectorObstruction.lean @@ -0,0 +1,160 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition +public import LeanPool.ApollonianSuperharmonic.PeriodicTileAdjacentContactRegularity +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy + +-- [TABLET NODE: P3102T2PeriodicFourSectorObstruction] + +/-! +# P3102T2PeriodicFourSectorObstruction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3102T2PeriodicFourSectorObstruction + {ι : Type} (P : PeriodicTileComplex ι) + (hregular : PeriodicTileAdjacentContactRegularity P) + (hpartition : ∀ c : LatticeCell, ∃! a : ι, c ∈ (P.tile a).cells) + (x : GaussianInt) (owner : Fin 4 → ι) + (howner : ∀ j, LatticeVertexIncidentCell x j ∈ (P.tile (owner j)).cells) + (hinjective : Function.Injective owner) + (f g : P.plane.Face) + (hf : (∃ i, P.plane.faceVertex f i = owner 0) ∧ + (∃ i, P.plane.faceVertex f i = owner 1)) + (hg : (∃ i, P.plane.faceVertex g i = owner 0) ∧ + (∃ i, P.plane.faceVertex g i = owner 1)) + (hpath : SimpleGridPathBetween + (CommonFootprintEdgeVertices (P.tile (owner 0)) (P.tile (owner 1))) + (FootprintEdges (P.tile (owner 0)) ∩ FootprintEdges (P.tile (owner 1))) + (P.rho f) (P.rho g)) : False := by +-- BODY + classical + have hdisjoint (a b : ι) (hab : a ≠ b) : + Disjoint (P.tile a).cells (P.tile b).cells := by + rw [Finset.disjoint_left] + intro c ha hb + exact hab ((hpartition c).unique ha hb) + have hraw (j : Fin 4) : x ∈ FootprintVertices (P.tile (owner j)) := by + have hne : (P.tile (owner j)).cells.Nonempty := ⟨_, howner j⟩ + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] + refine ⟨LatticeVertexIncidentCell x j, howner j, ?_⟩ + fin_cases j <;> simp [LatticeVertexIncidentCell, Zsqrtd.ext_iff] + let edgeAt : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, {x - ⟨0, 1⟩, x}, {x, x + 1}] + have transition (r s : Fin 4) (hrs : r ≠ s) (e : Finset GaussianInt) + (hxe : x ∈ e) + (he : e ∈ FootprintEdges (P.tile (owner r)) ∩ + FootprintEdges (P.tile (owner s))) : + ∃ k : Fin 4, e = edgeAt k ∧ + ((k = r ∧ k + 1 = s) ∨ (k = s ∧ k + 1 = r)) := by + obtain ⟨k, hek, h | h⟩ := P3102T2CommonEdgeSectorTransition + _ _ x e (hdisjoint _ _ (hinjective.ne hrs)) hxe he + · exact ⟨k, hek, Or.inl + ⟨hinjective ((hpartition _).unique (howner k) h.1), + hinjective ((hpartition _).unique (howner (k + 1)) h.2)⟩⟩ + · exact ⟨k, hek, Or.inr + ⟨hinjective ((hpartition _).unique (howner k) h.1), + hinjective ((hpartition _).unique (howner (k + 1)) h.2)⟩⟩ + have he0 : edgeAt 0 ∈ FootprintEdges (P.tile (owner 0)) ∩ + FootprintEdges (P.tile (owner 1)) := by + constructor + · refine ⟨x, howner 0, Or.inr (Or.inl rfl)⟩ + · refine ⟨x - 1, howner 1, Or.inr (Or.inr (Or.inl ?_))⟩ + simp [edgeAt] + have unique_edge (e : Finset GaussianInt) (hxe : x ∈ e) + (he : e ∈ FootprintEdges (P.tile (owner 0)) ∩ + FootprintEdges (P.tile (owner 1))) : e = edgeAt 0 := by + obtain ⟨k, hek, h | h⟩ := transition 0 1 (by decide +kernel) e hxe he + · simpa [h.1] using hek + · have hk : k = 1 := h.1 + have hbad := h.2 + simp [hk] at hbad + have hincident : ∃ e : Finset GaussianInt, x ∈ e ∧ + e ∈ FootprintEdges (P.tile (owner 0)) ∩ FootprintEdges (P.tile (owner 1)) := + ⟨edgeAt 0, by simp [edgeAt], he0⟩ + have hendpoint : x = P.rho f ∨ x = P.rho g := by + rcases SimpleGridPathPointTrichotomy _ _ _ _ x hpath hincident with + h | h | ⟨e, e', hne, hxe, hxe', he, he'⟩ + · exact Or.inl h + · exact Or.inr h + · exact (hne ((unique_edge e hxe he).trans (unique_edge e' hxe' he').symm)).elim + obtain ⟨F, hF, hxF⟩ : ∃ F : P.plane.Face, + ((∃ i, P.plane.faceVertex F i = owner 0) ∧ + (∃ i, P.plane.faceVertex F i = owner 1)) ∧ x = P.rho F := by + rcases hendpoint with h | h + · exact ⟨f, hf, h⟩ + · exact ⟨g, hg, h⟩ + obtain ⟨i, hi⟩ := hF.1 + obtain ⟨j, hj⟩ := hF.2 + have hij : i ≠ j := by + intro h + subst j + exact (hinjective.ne (by decide +kernel : (0 : Fin 4) ≠ 1)) (hi.symm.trans hj) + obtain ⟨k, hki, hkj⟩ : ∃ k : Fin 3, k ≠ i ∧ k ≠ j := by + fin_cases i <;> fin_cases j <;> first | contradiction | decide +kernel + let t := P.plane.faceVertex F k + have ht0 : t ≠ owner 0 := by + intro h + exact hki (P.plane.face_vertices_distinct F (h.trans hi.symm)) + have ht1 : t ≠ owner 1 := by + intro h + exact hkj (P.plane.face_vertices_distinct F (h.trans hj.symm)) + have hxt : x ∈ FootprintVertices (P.tile t) := by + rw [hxF] + exact P.rho_common F k + have htne : (P.tile t).cells.Nonempty := + (LatticeTileGridStructure _ (P.tiles_are_disks t)).1.1 + have htincident : ∃ r : Fin 4, LatticeVertexIncidentCell x r ∈ (P.tile t).cells := by + simp only [FootprintVertices, htne, ite_true, Set.mem_ofPred_eq] at hxt + obtain ⟨c, hc, h | h | h | h⟩ := hxt + · exact ⟨0, by simpa [LatticeVertexIncidentCell, h] using hc⟩ + · refine ⟨1, ?_⟩ + simpa [LatticeVertexIncidentCell, h] using hc + · refine ⟨3, ?_⟩ + simpa [LatticeVertexIncidentCell, h] using hc + · refine ⟨2, ?_⟩ + simpa [LatticeVertexIncidentCell, h, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] using hc + obtain ⟨r, hr⟩ := htincident + have htr : t = owner r := (hpartition _).unique hr (howner r) + have hadj0 : P.plane.adjacent (owner 0) t := by + rw [← hi] + exact P.plane.face_edges F i k (Ne.symm hki) + have hadj1 : P.plane.adjacent (owner 1) t := by + rw [← hj] + exact P.plane.face_edges F j k (Ne.symm hkj) + have opposite_not_adjacent (s : Fin 4) (hrs : s ≠ r) + (hnotconsecutive : ∀ z : Fin 4, + ¬ ((z = s ∧ z + 1 = r) ∨ (z = r ∧ z + 1 = s))) : + ¬ P.plane.adjacent (owner s) t := by + intro hadj + have hxcommon : x ∈ CommonFootprintEdgeVertices (P.tile (owner s)) (P.tile t) := by + rw [← hregular.adjacent_raw_eq_edge_vertices _ _ hadj] + exact ⟨hraw s, hxt⟩ + obtain ⟨e, he, hxe⟩ := hxcommon + rw [htr] at he + obtain ⟨z, _, hz⟩ := transition s r hrs e hxe he + exact hnotconsecutive z hz + fin_cases r + · exact ht0 htr + · exact ht1 htr + · exact opposite_not_adjacent 0 (by decide +kernel) + (by intro z; fin_cases z <;> decide +kernel) hadj0 + · exact opposite_not_adjacent 1 (by decide +kernel) + (by intro z; fin_cases z <;> decide +kernel) hadj1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3161T1AggregateComplementConnectivity.lean b/LeanPool/ApollonianSuperharmonic/P3161T1AggregateComplementConnectivity.lean new file mode 100644 index 0000000000..840c456df5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3161T1AggregateComplementConnectivity.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3161T1BlockTreeReachability +public import LeanPool.ApollonianSuperharmonic.P3161T1SquareTriangleComplement + +-- [TABLET NODE: P3161T1AggregateComplementConnectivity] + +/-! +# P3161T1AggregateComplementConnectivity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3161T1AggregateComplementConnectivity + (τ σ : Finset (Int × Int)) + (hτ : τ ∈ ({ + {(0, 0), (1, 0), (0, -1)}, + {(0, 0), (0, 1), (1, 1)}, + {(0, 0), (-1, -1), (-1, 0)} + } : Finset (Finset (Int × Int)))) + (hσ : σ ⊆ τ) + (a b : PeriodicSubtileIndex) + (ha : (a.first, a.second) ∉ σ) (hb : (b.first, b.second) ∉ σ) : + Relation.ReflTransGen + (fun x y : PeriodicSubtileIndex ↦ + AllowedSubtileIncidence x y ∧ (x.first, x.second) ∉ σ ∧ + (y.first, y.second) ∉ σ) a b := by +-- BODY + obtain ⟨d, hd⟩ : ∃ d : Int × Int, ∀ z ∈ τ, + (z.1 - d.1, z.2 - z.1 - d.2) ∈ + ({(0, 0), (1, 0), (0, 1)} : Finset (Int × Int)) := by + simp only [Finset.mem_insert, Finset.mem_singleton] at hτ + rcases hτ with rfl | rfl | rfl + · refine ⟨(0, -1), ?_⟩ + intro z hz + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl | rfl <;> norm_num + · refine ⟨(0, 0), ?_⟩ + intro z hz + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl | rfl <;> norm_num + · refine ⟨(-1, 0), ?_⟩ + intro z hz + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl | rfl <;> norm_num + let f := fun z : Int × Int ↦ (z.1 - d.1, z.2 - z.1 - d.2) + let g := fun z : Int × Int ↦ (z.1 + d.1, z.2 + z.1 + d.1 + d.2) + have gf (z) : g (f z) = z := by + apply Prod.ext <;> dsimp [f, g] <;> omega + have fg (z) : f (g z) = z := by + apply Prod.ext <;> dsimp [f, g] <;> omega + let D := σ.image f + have hD : D ⊆ {(0, 0), (1, 0), (0, 1)} := by + intro z hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + exact hd w (hσ hw) + have absent (z) : z ∉ D → g z ∉ σ := by + intro hz hw + exact hz (Finset.mem_image.mpr ⟨g z, hw, fg z⟩) + have absent' (z) (hz : z ∉ σ) : f z ∉ D := by + intro h + obtain ⟨w, hw, he⟩ := Finset.mem_image.mp h + have hwz : w = z := by simpa only [gf] using congrArg g he + exact hz (hwz ▸ hw) + let R := fun x y : PeriodicSubtileIndex ↦ + AllowedSubtileIncidence x y ∧ (x.first, x.second) ∉ σ ∧ + (y.first, y.second) ∉ σ + let A := fun z : Int × Int ↦ (⟨.A, z.1, z.2⟩ : PeriodicSubtileIndex) + have rev {x y} (hxy : Relation.ReflTransGen R x y) : + Relation.ReflTransGen R y x := by + induction hxy with + | refl => exact .refl + | tail _ e ih => exact (Relation.ReflTransGen.single + ⟨e.1.symm, e.2.2, e.2.1⟩).trans ih + have up (m n : Int) (hm : (m, n) ∉ σ) (hn : (m, n + 1) ∉ σ) : + Relation.ReflTransGen R (A (m, n)) (A (m, n + 1)) := + (Relation.ReflTransGen.single + ⟨AllowedSubtileIncidence.AB01 m n, hm, hn⟩).trans + (.single ⟨(AllowedSubtileIncidence.AB m (n + 1)).symm, hn, hn⟩) + have right (m n : Int) (hm : (m, n) ∉ σ) (hn : (m + 1, n + 1) ∉ σ) : + Relation.ReflTransGen R (A (m, n)) (A (m + 1, n + 1)) := + (Relation.ReflTransGen.single + ⟨AllowedSubtileIncidence.AB11 m n, hm, hn⟩).trans + (.single ⟨(AllowedSubtileIncidence.AB (m + 1) (n + 1)).symm, hn, hn⟩) + have step (z w : Int × Int) + (e : ((z.1 = w.1 ∧ (z.2 + 1 = w.2 ∨ w.2 + 1 = z.2)) ∨ + (z.2 = w.2 ∧ (z.1 + 1 = w.1 ∨ w.1 + 1 = z.1))) ∧ + z ∉ D ∧ w ∉ D) : + Relation.ReflTransGen R (A (g z)) (A (g w)) := by + have hz := absent z e.2.1 + have hw := absent w e.2.2 + rcases e.1 with ⟨hx, hy | hy⟩ | ⟨hy, hx | hx⟩ + · have he : g w = ((g z).1, (g z).2 + 1) := by + apply Prod.ext <;> dsimp [g] <;> omega + rw [he] at hw ⊢ + exact up _ _ hz hw + · have he : g z = ((g w).1, (g w).2 + 1) := by + apply Prod.ext <;> dsimp [g] <;> omega + rw [he] at hz ⊢ + exact rev (up _ _ hw hz) + · have he : g w = ((g z).1 + 1, (g z).2 + 1) := by + apply Prod.ext <;> dsimp [g] <;> omega + rw [he] at hw ⊢ + exact right _ _ hz hw + · have he : g z = ((g w).1 + 1, (g w).2 + 1) := by + apply Prod.ext <;> dsimp [g] <;> omega + rw [he] at hz ⊢ + exact rev (right _ _ hw hz) + have between : Relation.ReflTransGen R + (A (a.first, a.second)) (A (b.first, b.second)) := by + have h := P3161T1SquareTriangleComplement D hD + (f (a.first, a.second)) (f (b.first, b.second)) + (absent' _ ha) (absent' _ hb) + have lift : ∀ z w : Int × Int, + Relation.ReflTransGen + (fun x y : Int × Int ↦ + ((x.1 = y.1 ∧ (x.2 + 1 = y.2 ∨ y.2 + 1 = x.2)) ∨ + (x.2 = y.2 ∧ (x.1 + 1 = y.1 ∨ y.1 + 1 = x.1))) ∧ + x ∉ D ∧ y ∉ D) z w → + Relation.ReflTransGen R (A (g z)) (A (g w)) := by + intro z w hzw + induction hzw with + | refl => exact .refl + | tail _ e ih => exact ih.trans (step _ _ e) + simpa only [gf] using lift _ _ h + cases a with | mk ca ma na => + cases b with | mk cb mb nb => + exact (P3161T1BlockTreeReachability (fun z ↦ z ∉ σ) ma na ha ca .A).trans + (between.trans (P3161T1BlockTreeReachability (fun z ↦ z ∉ σ) mb nb hb .A cb)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3161T1AggregateInducedConnectivity.lean b/LeanPool/ApollonianSuperharmonic/P3161T1AggregateInducedConnectivity.lean new file mode 100644 index 0000000000..4d2958cb8a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3161T1AggregateInducedConnectivity.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3161T1BlockTreeReachability + +-- [TABLET NODE: P3161T1AggregateInducedConnectivity] + +/-! +# P3161T1AggregateInducedConnectivity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3161T1AggregateInducedConnectivity + (τ σ : Finset (Int × Int)) + (hτ : τ ∈ ({ + {(0, 0), (1, 0), (0, -1)}, + {(0, 0), (0, 1), (1, 1)}, + {(0, 0), (-1, -1), (-1, 0)} + } : Finset (Finset (Int × Int)))) + (hσ : σ ⊆ τ) + (a b : PeriodicSubtileIndex) + (ha : (a.first, a.second) ∈ σ) (hb : (b.first, b.second) ∈ σ) : + Relation.ReflTransGen + (fun x y : PeriodicSubtileIndex ↦ + AllowedSubtileIncidence x y ∧ (x.first, x.second) ∈ σ ∧ + (y.first, y.second) ∈ σ) a b := by +-- BODY + let r := fun x y : PeriodicSubtileIndex ↦ + AllowedSubtileIncidence x y ∧ (x.first, x.second) ∈ σ ∧ + (y.first, y.second) ∈ σ + have rev {x y} (hxy : Relation.ReflTransGen r x y) : + Relation.ReflTransGen r y x := by + induction hxy with + | refl => exact .refl + | tail h e ih => exact (Relation.ReflTransGen.single + ⟨e.1.symm, e.2.2, e.2.1⟩).trans ih + have block (z : Int × Int) (hz : z ∈ σ) (c d : SixSubtileLabel) : + Relation.ReflTransGen r ⟨c, z.1, z.2⟩ ⟨d, z.1, z.2⟩ := + P3161T1BlockTreeReachability (fun z ↦ z ∈ σ) z.1 z.2 hz c d + have cross (z w : Int × Int) (hz : z ∈ σ) (hw : w ∈ σ) + (c d : SixSubtileLabel) + (e : AllowedSubtileIncidence ⟨c, z.1, z.2⟩ ⟨d, w.1, w.2⟩) : + Relation.ReflTransGen r ⟨.A, z.1, z.2⟩ ⟨.A, w.1, w.2⟩ := + (block z hz .A c).trans ((Relation.ReflTransGen.single ⟨e, hz, hw⟩).trans + (block w hw d .A)) + have bridge (z w : Int × Int) (hz : z ∈ σ) (hw : w ∈ σ) : + Relation.ReflTransGen r ⟨.A, z.1, z.2⟩ ⟨.A, w.1, w.2⟩ := by + have zτ := hσ hz + have wτ := hσ hw + simp only [Finset.mem_insert, Finset.mem_singleton] at hτ + rcases hτ with rfl | rfl | rfl + all_goals + simp only [Finset.mem_insert, Finset.mem_singleton] at zτ wτ + rcases zτ with rfl | rfl | rfl + all_goals rcases wτ with rfl | rfl | rfl + all_goals first + | exact .refl + | exact cross _ _ hz hw _ _ (AllowedSubtileIncidence.AE01 0 (-1)) + | exact rev (cross _ _ hw hz _ _ (AllowedSubtileIncidence.AE01 0 (-1))) + | exact cross _ _ hz hw _ _ (AllowedSubtileIncidence.AC11 0 (-1)) + | exact rev (cross _ _ hw hz _ _ (AllowedSubtileIncidence.AC11 0 (-1))) + | exact cross _ _ hz hw _ _ (AllowedSubtileIncidence.CEm10 1 0) + | exact rev (cross _ _ hw hz _ _ (AllowedSubtileIncidence.CEm10 1 0)) + | exact cross _ _ hz hw _ _ (AllowedSubtileIncidence.AE01 0 0) + | exact rev (cross _ _ hw hz _ _ (AllowedSubtileIncidence.AE01 0 0)) + | exact cross _ _ hz hw _ _ (AllowedSubtileIncidence.AC11 0 0) + | exact rev (cross _ _ hw hz _ _ (AllowedSubtileIncidence.AC11 0 0)) + | exact cross _ _ hz hw _ _ (AllowedSubtileIncidence.CEm10 1 1) + | exact rev (cross _ _ hw hz _ _ (AllowedSubtileIncidence.CEm10 1 1)) + | exact cross _ _ hz hw _ _ (AllowedSubtileIncidence.AE01 (-1) (-1)) + | exact rev (cross _ _ hw hz _ _ (AllowedSubtileIncidence.AE01 (-1) (-1))) + | exact cross _ _ hz hw _ _ (AllowedSubtileIncidence.AC11 (-1) (-1)) + | exact rev (cross _ _ hw hz _ _ (AllowedSubtileIncidence.AC11 (-1) (-1))) + | exact cross _ _ hz hw _ _ (AllowedSubtileIncidence.CEm10 0 0) + | exact rev (cross _ _ hw hz _ _ (AllowedSubtileIncidence.CEm10 0 0)) + cases a with | mk ca ma na => + cases b with | mk cb mb nb => + exact (block (ma, na) ha ca .A).trans + ((bridge (ma, na) (mb, nb) ha hb).trans (block (mb, nb) hb .A cb)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3161T1BlockTreeReachability.lean b/LeanPool/ApollonianSuperharmonic/P3161T1BlockTreeReachability.lean new file mode 100644 index 0000000000..83b3f9a526 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3161T1BlockTreeReachability.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import Mathlib.Logic.Relation + +-- [TABLET NODE: P3161T1BlockTreeReachability] + +/-! +# P3161T1BlockTreeReachability + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3161T1BlockTreeReachability + (S : Int × Int → Prop) (m n : Int) (h : S (m, n)) + (a b : SixSubtileLabel) : + Relation.ReflTransGen + (fun x y : PeriodicSubtileIndex ↦ + AllowedSubtileIncidence x y ∧ S (x.first, x.second) ∧ + S (y.first, y.second)) ⟨a, m, n⟩ ⟨b, m, n⟩ := by +-- BODY + let r := fun x y : PeriodicSubtileIndex ↦ + AllowedSubtileIncidence x y ∧ S (x.first, x.second) ∧ S (y.first, y.second) + have rev {x y} (hxy : Relation.ReflTransGen r x y) : + Relation.ReflTransGen r y x := by + induction hxy with + | refl => exact .refl + | tail h e ih => exact (Relation.ReflTransGen.single + ⟨e.1.symm, e.2.2, e.2.1⟩).trans ih + have toA (c : SixSubtileLabel) : + Relation.ReflTransGen r ⟨c, m, n⟩ ⟨.A, m, n⟩ := by + cases c with + | A => exact .refl + | B => exact .single ⟨(AllowedSubtileIncidence.AB m n).symm, h, h⟩ + | C => exact .single ⟨(AllowedSubtileIncidence.AC m n).symm, h, h⟩ + | D => exact .single ⟨(AllowedSubtileIncidence.AD m n).symm, h, h⟩ + | E => + exact (Relation.ReflTransGen.single + ⟨(AllowedSubtileIncidence.BE m n).symm, h, h⟩).trans + (.single ⟨(AllowedSubtileIncidence.AB m n).symm, h, h⟩) + | F => exact .single ⟨(AllowedSubtileIncidence.AF m n).symm, h, h⟩ + exact (toA a).trans (rev (toA b)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3161T1SquareTriangleComplement.lean b/LeanPool/ApollonianSuperharmonic/P3161T1SquareTriangleComplement.lean new file mode 100644 index 0000000000..6ddd0a080a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3161T1SquareTriangleComplement.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Order.SuccPred.Int +public import Mathlib.Order.SuccPred.Relation + +-- [TABLET NODE: P3161T1SquareTriangleComplement] + +/-! +# P3161T1SquareTriangleComplement + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3161T1SquareTriangleComplement + (S : Finset (Int × Int)) + (hS : S ⊆ {(0, 0), (1, 0), (0, 1)}) + (a b : Int × Int) (ha : a ∉ S) (hb : b ∉ S) : + Relation.ReflTransGen + (fun x y : Int × Int ↦ + ((x.1 = y.1 ∧ (x.2 + 1 = y.2 ∨ y.2 + 1 = x.2)) ∨ + (x.2 = y.2 ∧ (x.1 + 1 = y.1 ∨ y.1 + 1 = x.1))) ∧ + x ∉ S ∧ y ∉ S) a b := by +-- BODY + let L : Finset (Int × Int) := {(0, 0), (1, 0), (0, 1)} + let adj := fun x y : Int × Int ↦ + (x.1 = y.1 ∧ (x.2 + 1 = y.2 ∨ y.2 + 1 = x.2)) ∨ + (x.2 = y.2 ∧ (x.1 + 1 = y.1 ∨ y.1 + 1 = x.1)) + let R := fun x y : Int × Int ↦ adj x y ∧ x ∉ L ∧ y ∉ L + have adjrev {x y} (h : adj x y) : adj y x := by + rcases h with ⟨h, e | e⟩ | ⟨h, e | e⟩ + · exact Or.inl ⟨h.symm, Or.inr e⟩ + · exact Or.inl ⟨h.symm, Or.inl e⟩ + · exact Or.inr ⟨h.symm, Or.inr e⟩ + · exact Or.inr ⟨h.symm, Or.inl e⟩ + have rev {x y} (hxy : Relation.ReflTransGen R x y) : + Relation.ReflTransGen R y x := by + induction hxy with + | refl => exact .refl + | tail _ e ih => exact (Relation.ReflTransGen.single + ⟨adjrev e.1, e.2.2, e.2.1⟩).trans ih + have outside (x y : Int) + (h : x ≤ -1 ∨ 2 ≤ x ∨ y ≤ -1 ∨ 2 ≤ y) : (x, y) ∉ L := by + simp only [L, Finset.mem_insert, Finset.mem_singleton, Prod.mk.injEq] + omega + have segment (f : Int → Int × Int) (i j : Int) (hij : i ≤ j) + (hf : ∀ k, i ≤ k → k ≤ j → f k ∉ L) + (he : ∀ k, adj (f k) (f (k + 1))) : + Relation.ReflTransGen R (f i) (f j) := by + have h := reflTransGen_of_succ_of_le (fun k l : Int ↦ R (f k) (f l)) + (n := i) (m := j) (by + intro k hk + change i ≤ k ∧ k < j at hk + change R (f k) (f (k + 1)) + exact ⟨he k, hf k hk.1 (by omega), hf (k + 1) (by omega) (by omega)⟩) hij + clear hij hf + induction h with + | refl => exact .refl + | tail _ e ih => exact ih.tail e + have axis (f : Int → Int × Int) (i j : Int) + (hf : ∀ k, min i j ≤ k → k ≤ max i j → f k ∉ L) + (he : ∀ k, adj (f k) (f (k + 1))) : + Relation.ReflTransGen R (f i) (f j) := by + by_cases h : i ≤ j + · exact segment f i j h (by simpa only [min_eq_left h, max_eq_right h] using hf) he + · have h' : j ≤ i := by omega + exact rev (segment f j i h' + (by simpa only [min_eq_right h', max_eq_left h'] using hf) he) + have horizontal (x x' y : Int) + (h : ∀ k, min x x' ≤ k → k ≤ max x x' → (k, y) ∉ L) : + Relation.ReflTransGen R (x, y) (x', y) := + axis (fun k ↦ (k, y)) x x' h (fun k ↦ Or.inr ⟨rfl, Or.inl rfl⟩) + have vertical (x y y' : Int) + (h : ∀ k, min y y' ≤ k → k ≤ max y y' → (x, k) ∉ L) : + Relation.ReflTransGen R (x, y) (x, y') := + axis (fun k ↦ (x, k)) y y' h (fun k ↦ Or.inl ⟨rfl, Or.inl rfl⟩) + have row (x x' y : Int) (hy : y ≤ -1 ∨ 2 ≤ y) : + Relation.ReflTransGen R (x, y) (x', y) := + horizontal x x' y (fun k _ _ ↦ outside k y (Or.inr (Or.inr hy))) + have col (x y y' : Int) (hx : x ≤ -1 ∨ 2 ≤ x) : + Relation.ReflTransGen R (x, y) (x, y') := + vertical x y y' (fun k _ _ ↦ outside x k (by omega)) + have toHub (z : Int × Int) (hz : z ∉ L) : + Relation.ReflTransGen R z (-1, -1) := by + rcases z with ⟨x, y⟩ + by_cases hx : x ≤ -1 + · exact (horizontal x (-1) y (by + intro k hk hk' + exact outside k y (Or.inl (by omega)))).trans + (col (-1) y (-1) (Or.inl (by omega))) + by_cases hx' : 2 ≤ x + · exact (horizontal x 2 y (by + intro k hk hk' + exact outside k y (Or.inr (Or.inl (by omega))))).trans + ((col 2 y (-1) (Or.inr (by omega))).trans + (row 2 (-1) (-1) (Or.inl (by omega)))) + by_cases hy : y ≤ -1 + · exact (vertical x y (-1) (by + intro k hk hk' + exact outside x k (Or.inr (Or.inr (Or.inl (by omega)))))).trans + (row x (-1) (-1) (Or.inl (by omega))) + by_cases hy' : 2 ≤ y + · exact (vertical x y 2 (by + intro k hk hk' + exact outside x k (Or.inr (Or.inr (Or.inr (by omega)))))).trans + ((row x (-1) 2 (Or.inr (by omega))).trans + (col (-1) 2 (-1) (Or.inl (by omega)))) + have hxy : x = 1 ∧ y = 1 := by + simp only [L, Finset.mem_insert, Finset.mem_singleton, Prod.mk.injEq] at hz + omega + rcases hxy with ⟨rfl, rfl⟩ + exact (Relation.ReflTransGen.single (r := R) (a := (1, 1)) (b := (1, 2)) + ⟨Or.inl ⟨rfl, Or.inl (by norm_num)⟩, hz, outside 1 2 (by omega)⟩).trans + ((row 1 (-1) 2 (Or.inr (by omega))).trans + (col (-1) 2 (-1) (Or.inl (by omega)))) + let R' := fun x y : Int × Int ↦ adj x y ∧ x ∉ S ∧ y ∉ S + have mono {x y} (h : Relation.ReflTransGen R x y) : + Relation.ReflTransGen R' x y := by + induction h with + | refl => exact .refl + | tail _ e ih => + exact ih.tail ⟨e.1, fun hx ↦ e.2.1 (hS hx), fun hy ↦ e.2.2 (hS hy)⟩ + have rev' {x y} (hxy : Relation.ReflTransGen R' x y) : + Relation.ReflTransGen R' y x := by + induction hxy with + | refl => exact .refl + | tail _ e ih => exact (Relation.ReflTransGen.single + ⟨adjrev e.1, e.2.2, e.2.1⟩).trans ih + have restored (z : Int × Int) (hz : z ∉ S) : + Relation.ReflTransGen R' z (-1, -1) := by + by_cases h : z ∈ L + · simp only [L, Finset.mem_insert, Finset.mem_singleton] at h + rcases h with rfl | rfl | rfl + · exact (Relation.ReflTransGen.single (r := R') (a := (0, 0)) (b := (-1, 0)) + ⟨Or.inr ⟨rfl, Or.inr (by norm_num)⟩, hz, + fun h ↦ outside (-1) 0 (by omega) (hS h)⟩).trans + (mono (toHub (-1, 0) (outside (-1) 0 (by omega)))) + · exact (Relation.ReflTransGen.single (r := R') (a := (1, 0)) (b := (2, 0)) + ⟨Or.inr ⟨rfl, Or.inl (by norm_num)⟩, hz, + fun h ↦ outside 2 0 (by omega) (hS h)⟩).trans + (mono (toHub (2, 0) (outside 2 0 (by omega)))) + · exact (Relation.ReflTransGen.single (r := R') (a := (0, 1)) (b := (0, 2)) + ⟨Or.inl ⟨rfl, Or.inl (by norm_num)⟩, hz, + fun h ↦ outside 0 2 (by omega) (hS h)⟩).trans + (mono (toHub (0, 2) (outside 0 2 (by omega)))) + · exact mono (toHub z h) + exact (restored a ha).trans (rev' (restored b hb)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3161T2IncidentBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3161T2IncidentBoundary.lean new file mode 100644 index 0000000000..73d33e658b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3161T2IncidentBoundary.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import Mathlib.Tactic.FinCases + +-- [TABLET NODE: P3161T2IncidentBoundary] + +/-! +# P3161T2IncidentBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3161T2IncidentBoundary (T : ProtoTile) (x : GaussianInt) + (hsome : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) + (hmissing : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ T.cells) : + x ∈ BoundaryFootprintVertices T := by +-- BODY + classical + have hne : T.cells.Nonempty := by + obtain ⟨j, hj⟩ := hsome + exact ⟨_, hj⟩ + let I : GaussianInt := ⟨0, 1⟩ + have edge01 (h : (x ∈ T.cells ∧ x - 1 ∉ T.cells) ∨ + (x ∉ T.cells ∧ x - 1 ∈ T.cells)) : + x ∈ BoundaryFootprintVertices T := by + simp only [BoundaryFootprintVertices, hne, ite_true, Set.mem_ofPred_eq] + refine ⟨{x, x + I}, ?_, by simp⟩ + exact ⟨x, Or.inr ⟨rfl, h⟩⟩ + have edge12 (h : (x - 1 ∈ T.cells ∧ x - 1 - I ∉ T.cells) ∨ + (x - 1 ∉ T.cells ∧ x - 1 - I ∈ T.cells)) : + x ∈ BoundaryFootprintVertices T := by + simp only [BoundaryFootprintVertices, hne, ite_true, Set.mem_ofPred_eq] + refine ⟨{x - 1, x - 1 + 1}, ?_, ?_⟩ + · exact ⟨x - 1, Or.inl ⟨rfl, h⟩⟩ + simp [Zsqrtd.ext_iff] + have edge23 (h : (x - I ∈ T.cells ∧ x - I - 1 ∉ T.cells) ∨ + (x - I ∉ T.cells ∧ x - I - 1 ∈ T.cells)) : + x ∈ BoundaryFootprintVertices T := by + simp only [BoundaryFootprintVertices, hne, ite_true, Set.mem_ofPred_eq] + refine ⟨{x - I, x - I + I}, ?_, ?_⟩ + · exact ⟨x - I, Or.inr ⟨rfl, h⟩⟩ + simp [I, Zsqrtd.ext_iff] + have hs : x ∈ T.cells ∨ x - 1 ∈ T.cells ∨ x - 1 - I ∈ T.cells ∨ + x - I ∈ T.cells := by + rcases hsome with ⟨j, hj⟩ + fin_cases j + · exact Or.inl (by simpa [LatticeVertexIncidentCell] using hj) + · exact Or.inr (Or.inl (by simpa [LatticeVertexIncidentCell] using hj)) + · exact Or.inr (Or.inr (Or.inl (by + simpa [LatticeVertexIncidentCell, I] using hj))) + · exact Or.inr (Or.inr (Or.inr (by + simpa [LatticeVertexIncidentCell] using hj))) + have hm : x ∉ T.cells ∨ x - 1 ∉ T.cells ∨ x - 1 - I ∉ T.cells ∨ + x - I ∉ T.cells := by + rcases hmissing with ⟨j, hj⟩ + fin_cases j + · exact Or.inl (by simpa [LatticeVertexIncidentCell] using hj) + · exact Or.inr (Or.inl (by simpa [LatticeVertexIncidentCell] using hj)) + · exact Or.inr (Or.inr (Or.inl (by + simpa [LatticeVertexIncidentCell, I] using hj))) + · exact Or.inr (Or.inr (Or.inr (by + simpa [LatticeVertexIncidentCell] using hj))) + by_cases h0 : x ∈ T.cells + · by_cases h1 : x - 1 ∈ T.cells + · by_cases h2 : x - 1 - I ∈ T.cells + · by_cases h3 : x - I ∈ T.cells + · exact (hm.elim (fun hn => hn h0) + (fun h => h.elim (fun hn => hn h1) + (fun h => h.elim (fun hn => hn h2) (fun hn => hn h3)))).elim + · exact edge23 (Or.inr ⟨h3, by + simpa [sub_eq_add_neg, add_comm, add_left_comm, add_assoc] using h2⟩) + · exact edge12 (Or.inl ⟨h1, h2⟩) + · exact edge01 (Or.inl ⟨h0, h1⟩) + · by_cases h1 : x - 1 ∈ T.cells + · exact edge01 (Or.inr ⟨h0, h1⟩) + · by_cases h2 : x - 1 - I ∈ T.cells + · exact edge12 (Or.inr ⟨h1, h2⟩) + · by_cases h3 : x - I ∈ T.cells + · exact edge23 (Or.inl ⟨h3, by + simpa [sub_eq_add_neg, add_comm, add_left_comm, add_assoc] using h2⟩) + · exact (hs.elim h0 + (fun h => h.elim h1 (fun h => h.elim h2 h3))).elim + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3161T2PathExhaustion.lean b/LeanPool/ApollonianSuperharmonic/P3161T2PathExhaustion.lean new file mode 100644 index 0000000000..0dd0ea03d6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3161T2PathExhaustion.lean @@ -0,0 +1,135 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import Mathlib.Data.List.Basic + +-- [TABLET NODE: P3161T2PathExhaustion] + +/-! +# P3161T2PathExhaustion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3161T2PathExhaustion + {V : Set GaussianInt} {E : Set (Finset GaussianInt)} + {x y : GaussianInt} (hpath : SimpleGridPathBetween V E x y) + (walk : List GaussianInt) + (hhead : walk.head? = some x) (hlast : walk.getLast? = some y) + (hedges : ∀ a b : GaussianInt, ∀ l r : List GaussianInt, + walk = l ++ a :: b :: r → {a, b} ∈ E) : + ∀ z ∈ V, z ∈ walk := by +-- BODY + classical + rcases hpath with ⟨p, hp, hlen, hx, hy, hV, _, hE⟩ + have hindex : ∀ a b, {a, b} ∈ E → + p.idxOf a + 1 = p.idxOf b ∨ p.idxOf b + 1 = p.idxOf a := by + intro a b hab + rcases (hE {a, b}).mp hab with ⟨c, d, l, r, heq, hedge⟩ + have hnd := hp + rw [heq, List.nodup_append] at hnd + have hc : c ∉ l := by + intro hc + exact hnd.2.2 c hc c (by simp) rfl + have hd : d ∉ l := by + intro hd + exact hnd.2.2 d hd d (by simp) rfl + have hcd : c ≠ d := by + have hcnot := (List.nodup_cons.mp hnd.2.1).1 + intro h + exact hcnot (by simp [h]) + have hic : p.idxOf c = l.length := by + simp [heq, List.idxOf_append, hc] + have hid : p.idxOf d = l.length + 1 := by + simp [heq, List.idxOf_append, hd, hcd, Nat.add_comm] + have ha : a = c ∨ a = d := by + have : a ∈ ({c, d} : Finset GaussianInt) := by rw [← hedge]; simp + simpa using this + have hb : b = c ∨ b = d := by + have : b ∈ ({c, d} : Finset GaussianInt) := by rw [← hedge]; simp + simpa using this + have habne : a ≠ b := by + intro h + have hcmem : c ∈ ({a, b} : Finset GaussianInt) := by rw [hedge]; simp + have hdmem : d ∈ ({a, b} : Finset GaussianInt) := by rw [hedge]; simp + simp [h] at hcmem hdmem + exact hcd (hcmem.trans hdmem.symm) + rcases ha with rfl | rfl <;> rcases hb with rfl | rfl + · exact False.elim (habne rfl) + · exact Or.inl (by omega) + · exact Or.inr (by omega) + · exact False.elim (habne rfl) + have hix : p.idxOf x = 0 := by + cases p with + | nil => simp at hlen + | cons a r => + simp only [List.head?_cons, Option.some.injEq] at hx + simp [hx] + have hpform : p.dropLast ++ [y] = p := + List.dropLast_append_getLast? y (by simp [hy]) + have hyabsent : y ∉ p.dropLast := by + have hnd := hp + rw [← hpform, List.nodup_append] at hnd + intro h + exact hnd.2.2 y h y (by simp) rfl + have hiy : p.idxOf y = p.length - 1 := by + rw [← hpform, List.idxOf_append] + simp [hyabsent] + intro z hz + have hzmem : z ∈ p := by simpa [hV] using hz + have hiz : p.idxOf z < p.length := List.idxOf_lt_length_of_mem hzmem + by_cases hzx : z = x + · subst z + exact List.mem_of_mem_head? (by simp [hhead]) + have hizpos : 0 < p.idxOf z := by + have hne : p.idxOf z ≠ p.idxOf x := by + intro h + exact hzx ((List.idxOf_inj hzmem).mp h) + omega + by_contra hzw + have propagate : ∀ (w : List GaussianInt), + (∀ a b : GaussianInt, ∀ l r : List GaussianInt, + w = l ++ a :: b :: r → {a, b} ∈ E) → + z ∉ w → + (∀ a ∈ w.head?, p.idxOf a < p.idxOf z) → + ∀ b ∈ w.getLast?, p.idxOf b < p.idxOf z := by + intro w + induction w with + | nil => simp + | cons a w ih => + intro hw hznot ha + cases w with + | nil => simpa using ha + | cons b w => + have hab := hindex a b (hw a b [] w rfl) + have hia : p.idxOf a < p.idxOf z := ha a (by simp) + have hbz : p.idxOf b ≠ p.idxOf z := by + intro h + have hb : b = z := ((List.idxOf_inj hzmem).mp h.symm).symm + exact hznot (by simp [hb]) + have hib : p.idxOf b < p.idxOf z := by omega + have hw' : ∀ c d : GaussianInt, ∀ l r : List GaussianInt, + b :: w = l ++ c :: d :: r → {c, d} ∈ E := by + intro c d l r h + exact hw c d (a :: l) r (by simp [h, List.cons_append]) + have hznot' : z ∉ b :: w := by + intro h + exact hznot (List.mem_cons_of_mem a h) + simpa using ih hw' hznot' (by simpa using hib) + have hylt := propagate walk hedges hzw (by simpa [hhead, hix] using hizpos) + have : p.idxOf y < p.idxOf z := hylt y (by simp [hlast]) + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3161T2PathSubwalk.lean b/LeanPool/ApollonianSuperharmonic/P3161T2PathSubwalk.lean new file mode 100644 index 0000000000..21c684d31e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3161T2PathSubwalk.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath +public import Mathlib.Data.List.Basic + +-- [TABLET NODE: P3161T2PathSubwalk] + +/-! +# P3161T2PathSubwalk + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3161T2PathSubwalk + {V : Set GaussianInt} {E : Set (Finset GaussianInt)} + (hpath : SimpleGridPath V E) (x y : GaussianInt) + (hx : x ∈ V) (hy : y ∈ V) : + ∃ w : List GaussianInt, + w.head? = some x ∧ w.getLast? = some y ∧ + (∀ z ∈ w, z ∈ V) ∧ + ∀ a b : GaussianInt, ∀ l r : List GaussianInt, + w = l ++ a :: b :: r → {a, b} ∈ E := by +-- BODY + classical + rcases hpath with ⟨p, _, _, hV, _, hE⟩ + have prefix_to (a : GaussianInt) (r : List GaussianInt) + (b : GaussianInt) (hb : b ∈ a :: r) : + ∃ w t : List GaussianInt, a :: r = w ++ t ∧ + w.head? = some a ∧ w.getLast? = some b := by + rcases List.mem_cons.mp hb with hba | hb + · subst b + exact ⟨[a], r, rfl, rfl, rfl⟩ + · obtain ⟨l, t, h⟩ := List.append_of_mem hb + refine ⟨a :: (l ++ [b]), t, ?_, rfl, ?_⟩ + · simp [h, List.append_assoc] + · change ((a :: l) ++ [b]).getLast? = some b + rw [List.getLast?_append_of_ne_nil (a :: l) (by simp)] + rfl + have segment : ∀ p : List GaussianInt, ∀ x y : GaussianInt, + x ∈ p → y ∈ p → + ∃ w : List GaussianInt, w.head? = some x ∧ w.getLast? = some y ∧ + ∃ l r : List GaussianInt, + p = l ++ w ++ r ∨ p = l ++ w.reverse ++ r := by + intro p + induction p with + | nil => simp + | cons a p ih => + intro x y hx hy + by_cases hxa : x = a + · subst x + obtain ⟨w, t, hp, hh, ht⟩ := prefix_to a p y hy + exact ⟨w, hh, ht, [], t, Or.inl (by simpa using hp)⟩ + by_cases hya : y = a + · subst y + obtain ⟨w, t, hp, hh, ht⟩ := prefix_to a p x hx + refine ⟨w.reverse, ?_, ?_, [], t, Or.inr ?_⟩ + · simpa using ht + · simpa using hh + · simpa using hp + obtain ⟨w, hh, ht, l, r, h | h⟩ := + ih x y (List.mem_of_ne_of_mem hxa hx) (List.mem_of_ne_of_mem hya hy) + · exact ⟨w, hh, ht, a :: l, r, Or.inl (by simp [h])⟩ + · exact ⟨w, hh, ht, a :: l, r, Or.inr (by simp [h])⟩ + obtain ⟨w, hh, ht, l, r, hs⟩ := segment p x y + (by simpa [hV] using hx) (by simpa [hV] using hy) + refine ⟨w, hh, ht, ?_, ?_⟩ + · intro z hz + have hzp : z ∈ p := by + rcases hs with hs | hs <;> rw [hs] + · simp [hz] + · simp [hz] + simpa [hV] using hzp + · intro a b k s h + apply (hE {a, b}).mpr + rcases hs with hs | hs + · exact ⟨a, b, l ++ k, s ++ r, by simp [hs, h, List.append_assoc], rfl⟩ + · refine ⟨b, a, l ++ s.reverse, k.reverse ++ r, ?_, ?_⟩ + · simp [hs, h, List.reverse_append, List.append_assoc] + · exact Finset.pair_comm a b + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3192T1FourOwnerTriangleExclusion.lean b/LeanPool/ApollonianSuperharmonic/P3192T1FourOwnerTriangleExclusion.lean new file mode 100644 index 0000000000..f9599599af --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3192T1FourOwnerTriangleExclusion.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition +public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices +public import LeanPool.ApollonianSuperharmonic.FootprintVertices + +-- [TABLET NODE: P3192T1FourOwnerTriangleExclusion] + +/-! +# P3192T1FourOwnerTriangleExclusion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3192T1FourOwnerTriangleExclusion + (T : Fin 4 → ProtoTile) (x : GaussianInt) + (hne : ∀ i, (T i).cells.Nonempty) + (hd : ∀ i j, i ≠ j → Disjoint (T i).cells (T j).cells) + (hx : ∀ i, x ∈ FootprintVertices (T i)) : + ¬ (x ∈ CommonFootprintEdgeVertices (T 0) (T 1) ∧ + x ∈ CommonFootprintEdgeVertices (T 1) (T 2) ∧ + x ∈ CommonFootprintEdgeVertices (T 2) (T 0)) := by +-- BODY + classical + have incident (i : Fin 4) : + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (T i).cells := by + have h := hx i + simp only [FootprintVertices, hne i, ite_true, Set.mem_ofPred_eq] at h + rcases h with ⟨c, hc, h | h | h | h⟩ + · refine ⟨0, ?_⟩ + simpa [LatticeVertexIncidentCell] using h ▸ hc + · refine ⟨1, ?_⟩ + subst x + convert hc using 1; simp [LatticeVertexIncidentCell] + · refine ⟨3, ?_⟩ + subst x + convert hc using 1; simp [LatticeVertexIncidentCell] + · refine ⟨2, ?_⟩ + change x - 1 - ⟨0, 1⟩ ∈ (T i).cells + rw [h] + convert hc using 1 + ext <;> simp + choose sector hsector using incident + have hinj : Function.Injective sector := by + intro i j hij + by_contra hneij + exact Finset.disjoint_left.mp (hd i j hneij) (hsector i) + (by simpa [hij] using hsector j) + have hsurj : Function.Surjective sector := Finite.surjective_of_injective hinj + have unique_sector (i j : Fin 4) + (hc : LatticeVertexIncidentCell x j ∈ (T i).cells) : j = sector i := by + obtain ⟨k, hk⟩ := hsurj j + have hik : i = k := by + by_contra hik + exact Finset.disjoint_left.mp (hd i k hik) hc (by rw [← hk]; exact hsector k) + simpa [← hik] using hk.symm + have edge_sectors (i j : Fin 4) (hij : i ≠ j) + (hxij : x ∈ CommonFootprintEdgeVertices (T i) (T j)) : + sector j = sector i + 1 ∨ sector i = sector j + 1 := by + obtain ⟨e, he, hxe⟩ := hxij + obtain ⟨k, _, hk | hk⟩ := P3102T2CommonEdgeSectorTransition + (T i) (T j) x e (hd i j hij) hxe he + · left + rw [← unique_sector i k hk.1, ← unique_sector j (k + 1) hk.2] + · right + rw [← unique_sector j k hk.1, ← unique_sector i (k + 1) hk.2] + have no_triangle : ∀ a b c : Fin 4, + (b = a + 1 ∨ a = b + 1) → + (c = b + 1 ∨ b = c + 1) → + (a = c + 1 ∨ c = a + 1) → False := by + decide + rintro ⟨h01, h12, h20⟩ + exact no_triangle (sector 0) (sector 1) (sector 2) + (edge_sectors 0 1 (by decide) h01) + (edge_sectors 1 2 (by decide) h12) + (edge_sectors 2 0 (by decide) h20) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3192T1PeriodicIndicesInfinite.lean b/LeanPool/ApollonianSuperharmonic/P3192T1PeriodicIndicesInfinite.lean new file mode 100644 index 0000000000..d1dd945da5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3192T1PeriodicIndicesInfinite.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import Mathlib.Data.Set.Finite.Lattice + +-- [TABLET NODE: P3192T1PeriodicIndicesInfinite] + +/-! +# P3192T1PeriodicIndicesInfinite + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3192T1PeriodicIndicesInfinite {ι : Type} + (P : PeriodicTileComplex ι) : Infinite ι := by +-- BODY + classical + have : Infinite GaussianInt := Infinite.of_injective + (fun z : Int => (⟨z, 0⟩ : GaussianInt)) (by + intro a b hab + exact congrArg Zsqrtd.re hab) + by_contra h + have : Finite ι := not_infinite_iff_finite.mp h + have hfinite : Set.Finite (⋃ a : ι, ((P.tile a).cells : Set GaussianInt)) := + Set.finite_iUnion fun a => (P.tile a).cells.finite_toSet + have hcover : (⋃ a : ι, ((P.tile a).cells : Set GaussianInt)) = Set.univ := by + apply Set.eq_univ_of_forall + intro x + obtain ⟨a, ha, _⟩ := PeriodicTileIndexedMultiplicityOne P x + exact Set.mem_iUnion.mpr ⟨a, ha⟩ + rw [hcover] at hfinite + exact Set.infinite_univ hfinite + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3192T1SimplePathOrientation.lean b/LeanPool/ApollonianSuperharmonic/P3192T1SimplePathOrientation.lean new file mode 100644 index 0000000000..0bb9e1d747 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3192T1SimplePathOrientation.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge + +-- [TABLET NODE: P3192T1SimplePathOrientation] + +/-! +# P3192T1SimplePathOrientation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3192T1SimplePathOrientation + (V : Set GaussianInt) (E : Set (Finset GaussianInt)) + (x y : GaussianInt) (hpath : SimpleGridPath V E) + (hx : x ∈ V) (hy : y ∈ V) (hxy : x ≠ y) + (hxone : ∀ e f : Finset GaussianInt, x ∈ e → x ∈ f → + e ∈ E → f ∈ E → e = f) + (hyone : ∀ e f : Finset GaussianInt, y ∈ e → y ∈ f → + e ∈ E → f ∈ E → e = f) : + SimpleGridPathBetween V E x y := by +-- BODY + classical + obtain ⟨p, hp, hlen, hV, hstep, hE⟩ := hpath + have hpne : p ≠ [] := by + intro h + simp [h] at hlen + let a := p.head hpne + let b := p.getLast hpne + have hhead : p.head? = some a := List.head?_eq_some_head hpne + have hlast : p.getLast? = some b := List.getLast?_eq_some_getLast hpne + have hbetween : SimpleGridPathBetween V E a b := + ⟨p, hp, hlen, hhead, hlast, hV, hstep, hE⟩ + have classify (z : GaussianInt) (hz : z ∈ V) + (hone : ∀ e f : Finset GaussianInt, z ∈ e → z ∈ f → + e ∈ E → f ∈ E → e = f) : z = a ∨ z = b := by + obtain ⟨e, hze, he⟩ := SimpleGridPathVertexIncidentEdge V E + ⟨p, hp, hlen, hV, hstep, hE⟩ z hz + rcases SimpleGridPathPointTrichotomy V E a b z hbetween ⟨e, hze, he⟩ with + h | h | ⟨e, f, hne, hze, hzf, he, hf⟩ + · exact Or.inl h + · exact Or.inr h + · exact (hne (hone e f hze hzf he hf)).elim + have hxend := classify x hx hxone + have hyend := classify y hy hyone + have reverse_raw (r : List GaussianInt) (e : Finset GaussianInt) : + (∃ u v l₁ l₂, r = l₁ ++ u :: v :: l₂ ∧ e = {u, v}) → + ∃ u v l₁ l₂, r.reverse = l₁ ++ u :: v :: l₂ ∧ e = {u, v} := by + rintro ⟨u, v, l₁, l₂, hr, he⟩ + refine ⟨v, u, l₂.reverse, l₁.reverse, ?_, ?_⟩ + · rw [hr] + simp [List.reverse_append, List.append_assoc] + · simpa [Finset.pair_comm] using he + have hreverse : SimpleGridPathBetween V E b a := by + refine ⟨p.reverse, List.nodup_reverse.mpr hp, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simpa using hlen + · simpa using hlast + · simpa using hhead + · simpa using hV + · intro u v l₁ l₂ hr + have hpform : p = l₂.reverse ++ v :: u :: l₁.reverse := by + have hh := congrArg List.reverse hr + simpa [List.reverse_append, List.append_assoc] using hh + rcases hstep v u l₂.reverse l₁.reverse hpform with h | h | h | h + · exact Or.inr (Or.inl (by rw [h]; simp)) + · exact Or.inl (by rw [h]; simp) + · exact Or.inr (Or.inr (Or.inr (by rw [h]; simp))) + · exact Or.inr (Or.inr (Or.inl (by rw [h]; simp))) + · intro e + constructor + · intro he + exact reverse_raw p e ((hE e).mp he) + · intro he + apply (hE e).mpr + simpa using reverse_raw p.reverse e he + rcases hxend with rfl | rfl <;> rcases hyend with rfl | rfl + · exact (hxy rfl).elim + · exact hbetween + · exact hreverse + · exact (hxy rfl).elim + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3221T2ClosedWalkCirculation.lean b/LeanPool/ApollonianSuperharmonic/P3221T2ClosedWalkCirculation.lean new file mode 100644 index 0000000000..6cc74cdf73 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3221T2ClosedWalkCirculation.lean @@ -0,0 +1,615 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3221T2IntegralSquareFilling +public import LeanPool.ApollonianSuperharmonic.P3221T2TileFillingSupport +public import Mathlib.Algebra.BigOperators.Group.List.Basic +public import Mathlib.Data.List.Chain + +-- [TABLET NODE: P3221T2ClosedWalkCirculation] + +/-! +# P3221T2ClosedWalkCirculation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ClosedWalkCirculationProof + +private theorem east : + (by + classical + exact + let S (u a b : GaussianInt) : GaussianInt →₀ ℤ := + if b = a + u then Finsupp.single a 1 + else if a = b + u then Finsupp.single b (-1) else 0 + ∀ (a : GaussianInt), S 1 a (a + 1) = Finsupp.single a 1 ∧ S ⟨0, 1⟩ a (a + 1) = 0 ) := by + classical + intro S a + simp [S, Zsqrtd.ext_iff] + +private theorem west : + (by + classical + exact + let S (u a b : GaussianInt) : GaussianInt →₀ ℤ := + if b = a + u then Finsupp.single a 1 + else if a = b + u then Finsupp.single b (-1) else 0 + ∀ (a : GaussianInt), S 1 a (a - 1) = Finsupp.single (a - 1) (-1) ∧ S ⟨0, 1⟩ a (a - 1) = 0 + ) := by + classical + intro S a + simp [S, Zsqrtd.ext_iff, sub_eq_add_neg, add_assoc] + +private theorem north : + (by + classical + exact + let S (u a b : GaussianInt) : GaussianInt →₀ ℤ := + if b = a + u then Finsupp.single a 1 + else if a = b + u then Finsupp.single b (-1) else 0 + ∀ (a : GaussianInt), S 1 a (a + ⟨0, 1⟩) = 0 ∧ S ⟨0, 1⟩ a (a + ⟨0, 1⟩) = Finsupp.single a + 1 ) := by + classical + intro S a + simp [S, Zsqrtd.ext_iff] + +private theorem south : + (by + classical + exact + let S (u a b : GaussianInt) : GaussianInt →₀ ℤ := + if b = a + u then Finsupp.single a 1 + else if a = b + u then Finsupp.single b (-1) else 0 + ∀ (a : GaussianInt), S 1 a (a - ⟨0, 1⟩) = 0 ∧ S ⟨0, 1⟩ a (a - ⟨0, 1⟩) = Finsupp.single (a + - ⟨0, 1⟩) (-1) ) := by + classical + intro S a + simp [S, Zsqrtd.ext_iff, sub_eq_add_neg, add_assoc] + +private theorem stepdiv : + (by + classical + exact + let S (u a b : GaussianInt) : GaussianInt →₀ ℤ := + if b = a + u then Finsupp.single a 1 + else if a = b + u then Finsupp.single b (-1) else 0 + (∀ (a : GaussianInt), S 1 a (a + 1) = Finsupp.single a 1 ∧ S ⟨0, 1⟩ a (a + 1) = 0) → ((∀ + (a : GaussianInt), S 1 a (a - 1) = Finsupp.single (a - 1) (-1) ∧ S ⟨0, 1⟩ a (a - 1) = + 0) → ((∀ (a : GaussianInt), S 1 a (a + ⟨0, 1⟩) = 0 ∧ S ⟨0, 1⟩ a (a + ⟨0, 1⟩) = + Finsupp.single a 1) → ((∀ (a : GaussianInt), S 1 a (a - ⟨0, 1⟩) = 0 ∧ S ⟨0, 1⟩ a (a - + ⟨0, 1⟩) = Finsupp.single (a - ⟨0, 1⟩) (-1)) → (∀ (a : GaussianInt), ∀ (b : + GaussianInt), (FourNeighborAdjacent a b) → (S 1 a b - (S 1 a b).mapDomain (fun z => z + + 1) + S ⟨0, 1⟩ a b - (S ⟨0, 1⟩ a b).mapDomain (fun z => z + ⟨0, 1⟩) = Finsupp.single + a 1 - Finsupp.single b 1))))) ) := by + classical + intro S east west north south a b hab + rcases hab with rfl | rfl | rfl | rfl + · rw [(east a).1, (east a).2] + simp + · rw [(west a).1, (west a).2, Finsupp.mapDomain_single] + simp only [Finsupp.mapDomain_zero, sub_add_cancel, add_zero, sub_zero, + Finsupp.single_neg] + abel + · rw [(north a).1, (north a).2] + simp + · rw [(south a).1, (south a).2, Finsupp.mapDomain_single] + simp only [Finsupp.mapDomain_zero, sub_add_cancel, zero_sub, + Finsupp.single_neg] + abel + +private theorem Hcons : + (by + classical + exact + let S (u a b : GaussianInt) : GaussianInt →₀ ℤ := + if b = a + u then Finsupp.single a 1 + else if a = b + u then Finsupp.single b (-1) else 0 + let H (p : List GaussianInt) : GaussianInt →₀ ℤ := + ((p.zip p.tail).map (fun e => S 1 e.1 e.2)).sum + ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l : List GaussianInt), H (a :: b :: l) = S 1 + a b + H (b :: l) ) := by + classical + intro S H a b l + simp [H] + +private theorem Vcons : + (by + classical + exact + let S (u a b : GaussianInt) : GaussianInt →₀ ℤ := + if b = a + u then Finsupp.single a 1 + else if a = b + u then Finsupp.single b (-1) else 0 + let V (p : List GaussianInt) : GaussianInt →₀ ℤ := + ((p.zip p.tail).map (fun e => S ⟨0, 1⟩ e.1 e.2)).sum + ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l : List GaussianInt), V (a :: b :: l) = S + ⟨0, 1⟩ a b + V (b :: l) ) := by + classical + intro S V a b l + simp [V] + +private theorem translation : + (by + classical + exact + ∀ (f : GaussianInt →₀ ℤ), ∀ (u : GaussianInt), ∀ (z : GaussianInt), f.mapDomain (fun y => + y + u) z = f (z - u) ) := by + classical + intro f u z + have hinj : Function.Injective (fun y : GaussianInt => y + u) := + fun _ _ h => add_right_cancel h + simpa only [sub_add_cancel] using Finsupp.mapDomain_apply_of_injective hinj f (z - u) + +private theorem telescope : + (by + classical + exact + let S (u a b : GaussianInt) : GaussianInt →₀ ℤ := + if b = a + u then Finsupp.single a 1 + else if a = b + u then Finsupp.single b (-1) else 0 + (∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → (S 1 a b - (S 1 a + b).mapDomain (fun z => z + 1) + S ⟨0, 1⟩ a b - (S ⟨0, 1⟩ a b).mapDomain (fun z => z + + ⟨0, 1⟩) = Finsupp.single a 1 - Finsupp.single b 1)) → ( + let H (p : List GaussianInt) : GaussianInt →₀ ℤ := + ((p.zip p.tail).map (fun e => S 1 e.1 e.2)).sum + let V (p : List GaussianInt) : GaussianInt →₀ ℤ := + ((p.zip p.tail).map (fun e => S ⟨0, 1⟩ e.1 e.2)).sum + (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l : List GaussianInt), H (a :: b :: l) = S + 1 a b + H (b :: l)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l : List + GaussianInt), V (a :: b :: l) = S ⟨0, 1⟩ a b + V (b :: l)) → (∀ (a : GaussianInt), ∀ + (b : GaussianInt), ∀ (l : List GaussianInt), ((a :: l).getLast? = some b) → + ((List.IsChain FourNeighborAdjacent (a :: l)) → (H (a :: l) - (H (a :: l)).mapDomain + (fun z => z + 1) + V (a :: l) - (V (a :: l)).mapDomain (fun z => z + ⟨0, 1⟩) = + Finsupp.single a 1 - Finsupp.single b 1))))) ) := by + classical + intro S stepdiv H V Hcons Vcons a b l hlast hchain + induction l generalizing a with + | nil => + simp only [List.getLast?_singleton, Option.some.injEq] at hlast + subst b + simp [H, V] + | cons d l ih => + have hd := (List.isChain_cons_cons.mp hchain).1 + have ht := ih d (by simpa only [List.getLast?_cons_cons] using hlast) + (List.isChain_cons_cons.mp hchain).2 + rw [Hcons, Vcons, Finsupp.mapDomain_add, Finsupp.mapDomain_add] + calc + _ = (S 1 a d - (S 1 a d).mapDomain (fun z => z + 1) + + S ⟨0, 1⟩ a d - (S ⟨0, 1⟩ a d).mapDomain (fun z => z + ⟨0, 1⟩)) + + (H (d :: l) - (H (d :: l)).mapDomain (fun z => z + 1) + + V (d :: l) - (V (d :: l)).mapDomain (fun z => z + ⟨0, 1⟩)) := by abel + _ = (Finsupp.single a 1 - Finsupp.single d 1) + + (Finsupp.single d 1 - Finsupp.single b 1) := by rw [stepdiv a d hd, ht] + _ = _ := by abel + +private theorem divergence : + (by + classical + exact + let S (u a b : GaussianInt) : GaussianInt →₀ ℤ := + if b = a + u then Finsupp.single a 1 + else if a = b + u then Finsupp.single b (-1) else 0 + let H (p : List GaussianInt) : GaussianInt →₀ ℤ := + ((p.zip p.tail).map (fun e => S 1 e.1 e.2)).sum + let V (p : List GaussianInt) : GaussianInt →₀ ℤ := + ((p.zip p.tail).map (fun e => S ⟨0, 1⟩ e.1 e.2)).sum + (∀ (f : GaussianInt →₀ ℤ), ∀ (u : GaussianInt), ∀ (z : GaussianInt), f.mapDomain (fun y + => y + u) z = f (z - u)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l : List + GaussianInt), ((a :: l).getLast? = some b) → ((List.IsChain FourNeighborAdjacent (a + :: l)) → (H (a :: l) - (H (a :: l)).mapDomain (fun z => z + 1) + V (a :: l) - (V (a + :: l)).mapDomain (fun z => z + ⟨0, 1⟩) = Finsupp.single a 1 - Finsupp.single b 1))) → + (∀ (p : List GaussianInt), ∀ (x : GaussianInt), (p.head? = some x) → ((p.getLast? = + some x) → ((List.IsChain FourNeighborAdjacent p) → (∀ z, H p z - H p (z - 1) + V p z + - V p (z - ⟨0, 1⟩) = 0))))) ) := by + classical + intro S H V translation telescope p x hfirst hlast hchain + cases p with + | nil => simp at hfirst + | cons a l => + simp only [List.head?_cons, Option.some.injEq] at hfirst + subst a + have ht := telescope x x l hlast hchain + rw [sub_self] at ht + intro z + have hv := congrArg (fun f : GaussianInt →₀ ℤ => f z) ht + simpa only [Finsupp.sub_apply, Finsupp.add_apply, Finsupp.zero_apply, + translation] using hv + +private theorem Qadd : + (by + classical + exact + let Q (f : GaussianInt →₀ ℤ) (d : GaussianInt → ℤ) : ℤ := + f.sum (fun z n => n * d z) + ∀ (f : GaussianInt →₀ ℤ), ∀ (g : GaussianInt →₀ ℤ), ∀ (d : GaussianInt → ℤ), Q (f + g) d + = Q f d + Q g d ) := by + classical + intro Q f g d + exact Finsupp.sum_add_index' (fun _ => zero_mul _) (fun _ _ _ => add_mul _ _ _) + +private theorem Qsub : + (by + classical + exact + let Q (f : GaussianInt →₀ ℤ) (d : GaussianInt → ℤ) : ℤ := + f.sum (fun z n => n * d z) + ∀ (f : GaussianInt →₀ ℤ), ∀ (g : GaussianInt →₀ ℤ), ∀ (d : GaussianInt → ℤ), Q (f - g) d + = Q f d - Q g d ) := by + classical + intro Q f g d + exact Finsupp.sum_sub_index (fun _ _ _ => sub_mul _ _ _) + +private theorem Qsingle : + (by + classical + exact + let Q (f : GaussianInt →₀ ℤ) (d : GaussianInt → ℤ) : ℤ := + f.sum (fun z n => n * d z) + ∀ (z : GaussianInt), ∀ (n : ℤ), ∀ (d : GaussianInt → ℤ), Q (Finsupp.single z n) d = n * d + z ) := by + classical + intro Q z n d + exact Finsupp.sum_single_index (zero_mul _) + +private theorem Qtranslation : + (by + classical + exact + let Q (f : GaussianInt →₀ ℤ) (d : GaussianInt → ℤ) : ℤ := + f.sum (fun z n => n * d z) + ∀ (f : GaussianInt →₀ ℤ), ∀ (u : GaussianInt), ∀ (d : GaussianInt → ℤ), Q (f.mapDomain + (fun z => z + u)) d = Q f (fun z => d (z + u)) ) := by + classical + intro Q f u d + exact Finsupp.sum_mapDomain_index (fun _ => zero_mul _) (fun _ _ _ => add_mul _ _ _) + +private theorem pairwalk : + (by + classical + exact + let S (u a b : GaussianInt) : GaussianInt →₀ ℤ := + if b = a + u then Finsupp.single a 1 + else if a = b + u then Finsupp.single b (-1) else 0 + (∀ (a : GaussianInt), S 1 a (a + 1) = Finsupp.single a 1 ∧ S ⟨0, 1⟩ a (a + 1) = 0) → ((∀ + (a : GaussianInt), S 1 a (a - 1) = Finsupp.single (a - 1) (-1) ∧ S ⟨0, 1⟩ a (a - 1) = + 0) → ((∀ (a : GaussianInt), S 1 a (a + ⟨0, 1⟩) = 0 ∧ S ⟨0, 1⟩ a (a + ⟨0, 1⟩) = + Finsupp.single a 1) → ((∀ (a : GaussianInt), S 1 a (a - ⟨0, 1⟩) = 0 ∧ S ⟨0, 1⟩ a (a - + ⟨0, 1⟩) = Finsupp.single (a - ⟨0, 1⟩) (-1)) → ( + let H (p : List GaussianInt) : GaussianInt →₀ ℤ := + ((p.zip p.tail).map (fun e => S 1 e.1 e.2)).sum + let V (p : List GaussianInt) : GaussianInt →₀ ℤ := + ((p.zip p.tail).map (fun e => S ⟨0, 1⟩ e.1 e.2)).sum + (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l : List GaussianInt), H (a :: b :: l) = S + 1 a b + H (b :: l)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l : List + GaussianInt), V (a :: b :: l) = S ⟨0, 1⟩ a b + V (b :: l)) → ( + let Q (f : GaussianInt →₀ ℤ) (d : GaussianInt → ℤ) : ℤ := + f.sum (fun z n => n * d z) + (∀ (d : GaussianInt → ℤ), Q 0 d = 0) → ((∀ (f : GaussianInt →₀ ℤ), ∀ (g : GaussianInt →₀ + ℤ), ∀ (d : GaussianInt → ℤ), Q (f + g) d = Q f d + Q g d) → ((∀ (z : GaussianInt), ∀ + (n : ℤ), ∀ (d : GaussianInt → ℤ), Q (Finsupp.single z n) d = n * d z) → (∀ (R : + GaussianInt → GaussianInt → Prop), ∀ (D : GaussianInt → GaussianInt → ℤ), (∀ a, ∀ b, + FourNeighborAdjacent a b → R a b → D b a = -D a b) → (∀ (p : List GaussianInt), + (List.IsChain (fun a b => FourNeighborAdjacent a b ∧ R a b) p) → ((List.zipWith D p + p.tail).sum = Q (H p) (fun z => D z (z + 1)) + Q (V p) (fun z => D z (z + ⟨0, + 1⟩))))))))))))) ) := by + classical + intro S east west north south H V Hcons Vcons Q Qzero Qadd Qsingle R D hanti p hchain + have stepPair (a b : GaussianInt) (hab : FourNeighborAdjacent a b) (hr : R a b) : + D a b = Q (S 1 a b) (fun z => D z (z + 1)) + + Q (S ⟨0, 1⟩ a b) (fun z => D z (z + ⟨0, 1⟩)) := by + have hs : D a b = -D b a := by have := hanti a b hab hr; omega + rcases hab with rfl | rfl | rfl | rfl + · rw [(east a).1, (east a).2, Qsingle, Qzero] + simp + · rw [(west a).1, (west a).2, Qsingle, Qzero] + simpa using hs + · rw [(north a).1, (north a).2, Qzero, Qsingle] + simp + · rw [(south a).1, (south a).2, Qzero, Qsingle] + simpa using hs + induction p with + | nil => simp [H, V, Q] + | cons a l ih => + cases l with + | nil => simp [H, V, Q] + | cons b l => + obtain ⟨⟨hab, hr⟩, ht⟩ := List.isChain_cons_cons.mp hchain + have hi := ih ht + simp only [List.tail_cons] at hi + simp only [List.tail_cons, List.zipWith_cons_cons, List.sum_cons] at ⊢ + rw [Hcons, Vcons, Qadd, Qadd, hi, stepPair a b hab hr] + abel + +private theorem absent : + (by + classical + exact + let S (u a b : GaussianInt) : GaussianInt →₀ ℤ := + if b = a + u then Finsupp.single a 1 + else if a = b + u then Finsupp.single b (-1) else 0 + ∀ (E : Set (Finset GaussianInt)), ∀ (u : GaussianInt), ∀ (z : GaussianInt), ∀ (p : List + GaussianInt), (List.IsChain (fun a b => ({a, b} : Finset GaussianInt) ∈ E) p) → + ((({z, z + u} : Finset GaussianInt) ∉ E) → ((((p.zip p.tail).map (fun e => S u e.1 + e.2)).sum) z = 0)) ) := by + classical + intro S E u z p hchain hmissing + have stepzero (a b : GaussianInt) (he : ({a, b} : Finset GaussianInt) ∈ E) : + S u a b z = 0 := by + dsimp only [S] + split_ifs with hb ha + · subst b + by_cases haz : a = z + · subst a + exact False.elim (hmissing he) + · simp [haz] + · subst a + by_cases hbz : b = z + · subst b + apply False.elim + exact hmissing (by simpa only [Finset.pair_comm] using he) + · simp [hbz] + · rfl + induction p with + | nil => simp + | cons a l ih => + cases l with + | nil => simp + | cons b l => + obtain ⟨he, ht⟩ := List.isChain_cons_cons.mp hchain + simpa only [List.tail_cons, List.zip_cons_cons, List.map_cons, + List.sum_cons, Finsupp.add_apply, stepzero a b he, zero_add] using ih ht + +private theorem boundary : + (by + classical + exact + let S (u a b : GaussianInt) : GaussianInt →₀ ℤ := + if b = a + u then Finsupp.single a 1 + else if a = b + u then Finsupp.single b (-1) else 0 + let H (p : List GaussianInt) : GaussianInt →₀ ℤ := + ((p.zip p.tail).map (fun e => S 1 e.1 e.2)).sum + let V (p : List GaussianInt) : GaussianInt →₀ ℤ := + ((p.zip p.tail).map (fun e => S ⟨0, 1⟩ e.1 e.2)).sum + (∀ (f : GaussianInt →₀ ℤ), ∀ (u : GaussianInt), ∀ (z : GaussianInt), f.mapDomain (fun y + => y + u) z = f (z - u)) → ( + let Q (f : GaussianInt →₀ ℤ) (d : GaussianInt → ℤ) : ℤ := + f.sum (fun z n => n * d z) + (∀ (f : GaussianInt →₀ ℤ), ∀ (g : GaussianInt →₀ ℤ), ∀ (d : GaussianInt → ℤ), Q (f - g) d + = Q f d - Q g d) → ((∀ (f : GaussianInt →₀ ℤ), ∀ (u : GaussianInt), ∀ (d : + GaussianInt → ℤ), Q (f.mapDomain (fun z => z + u)) d = Q f (fun z => d (z + u))) → (∀ + (c : GaussianInt →₀ ℤ), ∀ (D : GaussianInt → GaussianInt → ℤ), ∀ (p : List + GaussianInt), (∀ z, H p z = c z - c (z - ⟨0, 1⟩)) → ((∀ z, V p z = c (z - 1) - c z) → + (Q (H p) (fun z => D z (z + 1)) + Q (V p) (fun z => D z (z + ⟨0, 1⟩)) = ∑ z ∈ + c.support, c z * (D z (z + 1) + D (z + 1) (z + 1 + ⟨0, 1⟩) - D (z + ⟨0, 1⟩) (z + ⟨0, + 1⟩ + 1) - D z (z + ⟨0, 1⟩))))))) ) := by + classical + intro S H V translation Q Qsub Qtranslation c D p hH hV + have hHf : H p = c - c.mapDomain (fun z => z + ⟨0, 1⟩) := by + ext z + simp only [Finsupp.sub_apply, translation, hH] + have hVf : V p = c.mapDomain (fun z => z + 1) - c := by + ext z + simp only [Finsupp.sub_apply, translation, hV] + rw [hHf, hVf, Qsub, Qsub, Qtranslation, Qtranslation] + simp only [Q, Finsupp.sum, ← Finset.sum_sub_distrib, ← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro z hz + ring + +private theorem square_zero : + (by + classical + exact + ∀ (D : GaussianInt → GaussianInt → ℤ), ∀ (z : GaussianInt), (D (z + 1 + ⟨0, 1⟩) (z + ⟨0, + 1⟩) = + -D (z + ⟨0, 1⟩) (z + 1 + ⟨0, 1⟩)) → ((D (z + ⟨0, 1⟩) z = -D z (z + ⟨0, 1⟩)) → ((D z + (z + 1) + D (z + 1) (z + 1 + ⟨0, 1⟩) + + D (z + 1 + ⟨0, 1⟩) (z + ⟨0, 1⟩) + D (z + ⟨0, 1⟩) z = 0) → (D z (z + 1) + D (z + 1) (z + + 1 + ⟨0, 1⟩) - D (z + ⟨0, 1⟩) (z + ⟨0, 1⟩ + 1) - D z (z + ⟨0, 1⟩) = 0))) ) := by + classical + intro D z htop hleft hflat + have he : z + ⟨0, 1⟩ + 1 = z + 1 + ⟨0, 1⟩ := by abel + rw [he] + omega + +private theorem top_adjacent : + (by + classical + exact + (∀ (z : GaussianInt), FourNeighborAdjacent z (z + 1)) → (∀ (z : GaussianInt), + FourNeighborAdjacent (z + ⟨0, 1⟩) (z + 1 + ⟨0, 1⟩)) ) := by + classical + intro horizontal z + have he : z + 1 + ⟨0, 1⟩ = z + ⟨0, 1⟩ + 1 := by abel + rw [he] + exact horizontal _ + +private theorem hsupport : + (by + classical + exact + let S (u a b : GaussianInt) : GaussianInt →₀ ℤ := + if b = a + u then Finsupp.single a 1 + else if a = b + u then Finsupp.single b (-1) else 0 + let H (p : List GaussianInt) : GaussianInt →₀ ℤ := + ((p.zip p.tail).map (fun e => S 1 e.1 e.2)).sum + let V (p : List GaussianInt) : GaussianInt →₀ ℤ := + ((p.zip p.tail).map (fun e => S ⟨0, 1⟩ e.1 e.2)).sum + (∀ (E : Set (Finset GaussianInt)), ∀ (u : GaussianInt), ∀ (z : GaussianInt), ∀ (p : List + GaussianInt), (List.IsChain (fun a b => ({a, b} : Finset GaussianInt) ∈ E) p) → + ((({z, z + u} : Finset GaussianInt) ∉ E) → ((((p.zip p.tail).map (fun e => S u e.1 + e.2)).sum) z = 0))) → (∀ (T : ProtoTile), (LatticeTile T) → (∀ (p : List + GaussianInt), ∀ (c : GaussianInt →₀ ℤ), (∀ (x : GaussianInt), (H p : GaussianInt → ℤ) + x = (c : GaussianInt → ℤ) x - (c : GaussianInt → ℤ) (x - (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt))) → ((∀ (x : GaussianInt), (V p : GaussianInt → ℤ) x = (c : GaussianInt + → ℤ) (x - (1 : GaussianInt)) - (c : GaussianInt → ℤ) x) → ((List.IsChain (fun (x x_1 + : LatticeCell) => {x, x_1} ∈ FootprintEdges T) p) → (∀ z, z ∉ T.cells → c z = 0))))) + ) := by + classical + intro S H V absent T hT p c hH hV hedge + apply P3221T2TileFillingSupport T hT c + · intro z hmissing + rw [← hH z] + exact absent (FootprintEdges T) 1 z p hedge hmissing + · intro z hmissing + rw [← hV z] + exact absent (FootprintEdges T) ⟨0, 1⟩ z p hedge hmissing + +private theorem hzT : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (c : GaussianInt →₀ ℤ), (∀ z, z ∉ T.cells → c z = 0) → (∀ (z : + GaussianInt), (z ∈ c.support) → (z ∈ T.cells)) ) := by + classical + intro T c hsupport z hz + by_contra hnot + exact (Finsupp.mem_support_iff.mp hz) (hsupport z hnot) + +end ClosedWalkCirculationProof + +theorem P3221T2ClosedWalkCirculation : + (∀ (T : ProtoTile), LatticeTile T → + ∀ (D : GaussianInt → GaussianInt → ℤ), + (∀ a b, FourNeighborAdjacent a b → + ({a, b} : Finset GaussianInt) ∈ FootprintEdges T → D b a = -D a b) → + (∀ x ∈ T.cells, + D x (x + 1) + D (x + 1) (x + 1 + ⟨0, 1⟩) + + D (x + 1 + ⟨0, 1⟩) (x + ⟨0, 1⟩) + D (x + ⟨0, 1⟩) x = 0) → + ∀ (p : List GaussianInt) (x : GaussianInt), + p.head? = some x → p.getLast? = some x → + List.IsChain (fun a b => FourNeighborAdjacent a b ∧ + ({a, b} : Finset GaussianInt) ∈ FootprintEdges T) p → + (List.zipWith D p p.tail).sum = 0) ∧ + (∀ (D : GaussianInt → GaussianInt → ℤ), + (∀ a b, FourNeighborAdjacent a b → D b a = -D a b) → + (∀ x, + D x (x + 1) + D (x + 1) (x + 1 + ⟨0, 1⟩) + + D (x + 1 + ⟨0, 1⟩) (x + ⟨0, 1⟩) + D (x + ⟨0, 1⟩) x = 0) → + ∀ (p : List GaussianInt) (x : GaussianInt), + p.head? = some x → p.getLast? = some x → + List.IsChain FourNeighborAdjacent p → + (List.zipWith D p p.tail).sum = 0) := by +-- BODY + classical + -- Signed step coefficients retain traversal multiplicities. + let S (u a b : GaussianInt) : GaussianInt →₀ ℤ := + if b = a + u then Finsupp.single a 1 + else if a = b + u then Finsupp.single b (-1) else 0 + have east (a : GaussianInt) := ClosedWalkCirculationProof.east a + have west (a : GaussianInt) := ClosedWalkCirculationProof.west a + have north (a : GaussianInt) := ClosedWalkCirculationProof.north a + have south (a : GaussianInt) := ClosedWalkCirculationProof.south a + -- The boundary of each signed step is departure minus arrival. + have stepdiv (a b : GaussianInt) (hab : FourNeighborAdjacent a b) := + ClosedWalkCirculationProof.stepdiv east west north south a b hab + let H (p : List GaussianInt) : GaussianInt →₀ ℤ := + ((p.zip p.tail).map (fun e => S 1 e.1 e.2)).sum + let V (p : List GaussianInt) : GaussianInt →₀ ℤ := + ((p.zip p.tail).map (fun e => S ⟨0, 1⟩ e.1 e.2)).sum + have Hcons (a b : GaussianInt) (l : List GaussianInt) := ClosedWalkCirculationProof.Hcons a b l + have Vcons (a b : GaussianInt) (l : List GaussianInt) := ClosedWalkCirculationProof.Vcons a b l + have translation (f : GaussianInt →₀ ℤ) (u z : GaussianInt) := + ClosedWalkCirculationProof.translation f u z + have telescope (a b : GaussianInt) (l : List GaussianInt) + (hlast : (a :: l).getLast? = some b) + (hchain : List.IsChain FourNeighborAdjacent (a :: l)) := + ClosedWalkCirculationProof.telescope stepdiv Hcons Vcons a b l hlast hchain + have divergence (p : List GaussianInt) (x : GaussianInt) + (hfirst : p.head? = some x) (hlast : p.getLast? = some x) + (hchain : List.IsChain FourNeighborAdjacent p) := ClosedWalkCirculationProof.divergence + translation telescope p x hfirst hlast hchain + -- Pairing is additive and commutes with translation of the finite support. + let Q (f : GaussianInt →₀ ℤ) (d : GaussianInt → ℤ) : ℤ := + f.sum (fun z n => n * d z) + have Qzero (d : GaussianInt → ℤ) : Q 0 d = 0 := by simp [Q] + have Qadd (f g : GaussianInt →₀ ℤ) (d : GaussianInt → ℤ) := ClosedWalkCirculationProof.Qadd f g d + have Qsub (f g : GaussianInt →₀ ℤ) (d : GaussianInt → ℤ) := ClosedWalkCirculationProof.Qsub f g d + have Qsingle (z : GaussianInt) (n : ℤ) (d : GaussianInt → ℤ) := + ClosedWalkCirculationProof.Qsingle z n d + have Qtranslation (f : GaussianInt →₀ ℤ) (u : GaussianInt) (d : GaussianInt → ℤ) := + ClosedWalkCirculationProof.Qtranslation f u d + have pairwalk (R : GaussianInt → GaussianInt → Prop) + (D : GaussianInt → GaussianInt → ℤ) + (hanti : ∀ a b, FourNeighborAdjacent a b → R a b → D b a = -D a b) + (p : List GaussianInt) + (hchain : List.IsChain (fun a b => FourNeighborAdjacent a b ∧ R a b) p) : + (List.zipWith D p p.tail).sum = + Q (H p) (fun z => D z (z + 1)) + Q (V p) (fun z => D z (z + ⟨0, 1⟩)) := + ClosedWalkCirculationProof.pairwalk east west north south Hcons Vcons Qzero Qadd + Qsingle R D hanti p hchain + have absent (E : Set (Finset GaussianInt)) (u z : GaussianInt) + (p : List GaussianInt) + (hchain : List.IsChain (fun a b => ({a, b} : Finset GaussianInt) ∈ E) p) + (hmissing : ({z, z + u} : Finset GaussianInt) ∉ E) := ClosedWalkCirculationProof.absent E u + z p hchain hmissing + have boundary (c : GaussianInt →₀ ℤ) (D : GaussianInt → GaussianInt → ℤ) + (p : List GaussianInt) + (hH : ∀ z, H p z = c z - c (z - ⟨0, 1⟩)) + (hV : ∀ z, V p z = c (z - 1) - c z) : + Q (H p) (fun z => D z (z + 1)) + Q (V p) (fun z => D z (z + ⟨0, 1⟩)) = + ∑ z ∈ c.support, c z * (D z (z + 1) + D (z + 1) (z + 1 + ⟨0, 1⟩) - + D (z + ⟨0, 1⟩) (z + ⟨0, 1⟩ + 1) - D z (z + ⟨0, 1⟩)) := + ClosedWalkCirculationProof.boundary translation Qsub Qtranslation c D p hH hV + have square_zero (D : GaussianInt → GaussianInt → ℤ) (z : GaussianInt) + (htop : D (z + 1 + ⟨0, 1⟩) (z + ⟨0, 1⟩) = + -D (z + ⟨0, 1⟩) (z + 1 + ⟨0, 1⟩)) + (hleft : D (z + ⟨0, 1⟩) z = -D z (z + ⟨0, 1⟩)) + (hflat : D z (z + 1) + D (z + 1) (z + 1 + ⟨0, 1⟩) + + D (z + 1 + ⟨0, 1⟩) (z + ⟨0, 1⟩) + D (z + ⟨0, 1⟩) z = 0) : + D z (z + 1) + D (z + 1) (z + 1 + ⟨0, 1⟩) - + D (z + ⟨0, 1⟩) (z + ⟨0, 1⟩ + 1) - D z (z + ⟨0, 1⟩) = 0 := + ClosedWalkCirculationProof.square_zero D z htop hleft hflat + have horizontal (z : GaussianInt) : FourNeighborAdjacent z (z + 1) := Or.inl rfl + have vertical (z : GaussianInt) : FourNeighborAdjacent z (z + ⟨0, 1⟩) := + Or.inr (Or.inr (Or.inl rfl)) + have top_adjacent (z : GaussianInt) : + FourNeighborAdjacent (z + ⟨0, 1⟩) (z + 1 + ⟨0, 1⟩) := + ClosedWalkCirculationProof.top_adjacent horizontal z + constructor + · intro T hT D hanti hflat p x hfirst hlast hchain + have hadj : List.IsChain FourNeighborAdjacent p := + hchain.imp (fun _ _ h => h.1) + obtain ⟨hcolumns, c, hformula, hH, hV⟩ := + P3221T2IntegralSquareFilling (H p) (V p) + (divergence p x hfirst hlast hadj) + have hedge := hchain.imp (fun _ _ h => h.2) + have hsupport := ClosedWalkCirculationProof.hsupport absent T hT p c hH hV hedge + rw [pairwalk (fun a b => ({a, b} : Finset GaussianInt) ∈ FootprintEdges T) + D hanti p hchain, boundary c D p hH hV] + apply Finset.sum_eq_zero + intro z hz + -- The support theorem permits antisymmetry on actual cell sides only. + have hzT : z ∈ T.cells := ClosedWalkCirculationProof.hzT T c hsupport z hz + have htop : ({z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + FootprintEdges T := ⟨z, hzT, Or.inr (Or.inr (Or.inr rfl))⟩ + have hleft : ({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges T := + ⟨z, hzT, Or.inr (Or.inl rfl)⟩ + rw [square_zero D z + (hanti _ _ (top_adjacent z) htop) (hanti _ _ (vertical z) hleft) (hflat z hzT), + mul_zero] + · intro D hanti hflat p x hfirst hlast hchain + obtain ⟨hcolumns, c, hformula, hH, hV⟩ := + P3221T2IntegralSquareFilling (H p) (V p) + (divergence p x hfirst hlast hchain) + have hchain' : List.IsChain (fun a b => FourNeighborAdjacent a b ∧ True) p := + hchain.imp (fun _ _ h => ⟨h, trivial⟩) + rw [pairwalk (fun _ _ => True) D (fun a b h _ => hanti a b h) p hchain', + boundary c D p hH hV] + apply Finset.sum_eq_zero + intro z hz + rw [square_zero D z (hanti _ _ (top_adjacent z)) + (hanti _ _ (vertical z)) (hflat z), mul_zero] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3221T2ConnectedPathIntegration.lean b/LeanPool/ApollonianSuperharmonic/P3221T2ConnectedPathIntegration.lean new file mode 100644 index 0000000000..479a085348 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3221T2ConnectedPathIntegration.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Combinatorics.SimpleGraph.Connectivity.Connected +public import Mathlib.Algebra.BigOperators.Group.List.Basic + +-- [TABLET NODE: P3221T2ConnectedPathIntegration] + +/-! +# P3221T2ConnectedPathIntegration + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3221T2ConnectedPathIntegration {α : Type*} + (G : SimpleGraph α) (x₀ : α) + (hconn : ∀ x, Nonempty (G.Walk x₀ x)) + (D : α → α → ℤ) + (hanti : ∀ a b, G.Adj a b → D b a = -D a b) + (hclosed : ∀ x (p : G.Walk x x), + (p.darts.map (fun d => D d.fst d.snd)).sum = 0) : + ∃ g : α → ℤ, g x₀ = 0 ∧ + (∀ a b, G.Adj a b → g b - g a = D a b) ∧ + ∀ g' : α → ℤ, + (∀ a b, G.Adj a b → g' b - g' a = D a b) → + ∃ c : ℤ, ∀ x, g' x - g x = c := by +-- BODY + classical + let I {u v : α} (p : G.Walk u v) : ℤ := + (p.darts.map (fun d => D d.fst d.snd)).sum + have iappend {u v w : α} (p : G.Walk u v) (q : G.Walk v w) : + I (p.append q) = I p + I q := by + simp [I, SimpleGraph.Walk.darts_append] + have ireverse {u v : α} (p : G.Walk u v) : I p.reverse = -I p := by + have hneg (l : List G.Dart) : + (l.map (fun d => D d.snd d.fst)).sum = + -(l.map (fun d => D d.fst d.snd)).sum := by + induction l with + | nil => simp + | cons d l ih => + simp only [List.map_cons, List.sum_cons] + rw [hanti d.fst d.snd d.adj, ih] + omega + simpa [I, SimpleGraph.Walk.darts_reverse, List.map_map, + Function.comp_def, SimpleGraph.Dart.symm] using hneg p.darts + let P (x : α) : G.Walk x₀ x := Classical.choice (hconn x) + let g (x : α) : ℤ := I (P x) + have ipath (x : α) (q : G.Walk x₀ x) : I q = g x := by + have hz := hclosed x₀ (q.append (P x).reverse) + change I (q.append (P x).reverse) = 0 at hz + rw [iappend, ireverse] at hz + dsimp [g] + omega + have hgzero : g x₀ = 0 := by + have hz := ipath x₀ SimpleGraph.Walk.nil + simpa [I] using hz.symm + have hgedge : ∀ a b, G.Adj a b → g b - g a = D a b := by + intro a b hab + have hp := ipath b ((P a).append hab.toWalk) + rw [iappend] at hp + have he : I hab.toWalk = D a b := by simp [I] + rw [he] at hp + change g a + D a b = g b at hp + omega + refine ⟨g, hgzero, hgedge, ?_⟩ + intro g' hg' + have telescope {u v : α} (p : G.Walk u v) : g' v - g' u = I p := by + induction p with + | nil => simp [I] + | @cons u v w hab p ih => + have he := hg' u v hab + have hi : I (SimpleGraph.Walk.cons hab p) = D u v + I p := by + simp [I] + rw [hi] + omega + refine ⟨g' x₀, ?_⟩ + intro x + have ht := telescope (P x) + change g' x - g' x₀ = g x at ht + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3221T2IntegralSquareFilling.lean b/LeanPool/ApollonianSuperharmonic/P3221T2IntegralSquareFilling.lean new file mode 100644 index 0000000000..8b30d2d9c2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3221T2IntegralSquareFilling.lean @@ -0,0 +1,195 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Data.Finsupp.Basic +public import Mathlib.Algebra.BigOperators.Group.Finset.Basic +public import Mathlib.Data.Set.Finite.Lattice +public import Mathlib.Data.Int.Interval + +-- [TABLET NODE: P3221T2IntegralSquareFilling] + +/-! +# P3221T2IntegralSquareFilling + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3221T2IntegralSquareFilling + (H V : GaussianInt →₀ ℤ) + (hdiv : ∀ x, H x - H (x - 1) + V x - V (x - ⟨0, 1⟩) = 0) : + (∀ m : ℤ, ∑ x ∈ H.support.filter (fun x => x.re = m), H x = 0) ∧ + ∃ c : GaussianInt →₀ ℤ, + (∀ x, c x = ∑ y ∈ H.support.filter + (fun y => y.re = x.re ∧ y.im ≤ x.im), H y) ∧ + (∀ x, H x = c x - c (x - ⟨0, 1⟩)) ∧ + (∀ x, V x = c (x - 1) - c x) := by +-- BODY + classical + let C : GaussianInt → ℤ := fun x => + ∑ y ∈ H.support.filter (fun y => y.re = x.re ∧ y.im ≤ x.im), H y + let A : ℤ → ℤ := fun m => ∑ y ∈ H.support.filter (fun y => y.re = m), H y + have hCdiff (x : GaussianInt) : C x - C (x - ⟨0, 1⟩) = H x := by + have hsum : C x = C (x - ⟨0, 1⟩) + + ∑ y ∈ H.support, if y = x then H y else 0 := by + simp only [C, Finset.sum_filter, ← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro y hy + by_cases he : y = x + · subst y + simp [sub_eq_add_neg] + · have hcoord : ¬(y.re = x.re ∧ y.im = x.im) := by + intro h + exact he (Zsqrtd.ext h.1 h.2) + have hpred : (y.re = x.re ∧ y.im ≤ x.im) ↔ + (y.re = (x - ⟨0, 1⟩).re ∧ y.im ≤ (x - ⟨0, 1⟩).im) := by + simp only [sub_eq_add_neg, Zsqrtd.re_add, Zsqrtd.re_neg, + Zsqrtd.im_add, Zsqrtd.im_neg] + omega + simp only [ite_eq_right he, add_zero, hpred] + have hsingle : (∑ y ∈ H.support, if y = x then H y else 0) = H x := by + by_cases hx : x ∈ H.support + · simp [hx] + · simp [hx, Finsupp.notMem_support_iff.mp hx] + rw [hsingle] at hsum + omega + let S := H.support ∪ V.support + obtain ⟨r, hr⟩ := (S.finite_toSet.image (fun x : GaussianInt => x.im)).bddBelow + obtain ⟨s, hs⟩ := (S.finite_toSet.image (fun x : GaussianInt => x.im)).bddAbove + have hHbounds (x : GaussianInt) (hx : x ∈ H.support) : r ≤ x.im ∧ x.im ≤ s := by + have hmem : x.im ∈ (fun x : GaussianInt => x.im) '' (S : Set GaussianInt) := + ⟨x, Finset.mem_union_left _ hx, rfl⟩ + exact ⟨hr hmem, hs hmem⟩ + have hVbounds (x : GaussianInt) (hx : x ∈ V.support) : r ≤ x.im ∧ x.im ≤ s := by + have hmem : x.im ∈ (fun x : GaussianInt => x.im) '' (S : Set GaussianInt) := + ⟨x, Finset.mem_union_right _ hx, rfl⟩ + exact ⟨hr hmem, hs hmem⟩ + have hClower (x : GaussianInt) (hx : x.im < r) : C x = 0 := by + apply Finset.sum_eq_zero + intro y hy + obtain ⟨hyH, hyre, hyim⟩ := Finset.mem_filter.mp hy + have := (hHbounds y hyH).1 + omega + have hCupper (x : GaussianInt) (hx : s ≤ x.im) : C x = A x.re := by + apply Finset.sum_congr + · apply Finset.filter_congr + intro y hy + have := (hHbounds y hy).2 + omega + · intro y hy + rfl + have hVoutside (x : GaussianInt) (hx : x.im < r ∨ s < x.im) : V x = 0 := by + apply Finsupp.notMem_support_iff.mp + intro hmem + have := hVbounds x hmem + omega + have hshiftI (m n : ℤ) : (⟨m, n⟩ : GaussianInt) - ⟨0, 1⟩ = ⟨m, n - 1⟩ := by + ext <;> simp [sub_eq_add_neg] + have hshiftR (m n : ℤ) : (⟨m, n⟩ : GaussianInt) - 1 = ⟨m - 1, n⟩ := by + ext <;> simp [sub_eq_add_neg] + have hCstep (m n : ℤ) : C ⟨m, n + 1⟩ - C ⟨m, n⟩ = H ⟨m, n + 1⟩ := by + simpa only [hshiftI, add_sub_cancel_right] using hCdiff ⟨m, n + 1⟩ + -- The divergence equation is the vertical difference of E; sum it from r to n. + let E : ℤ → ℤ → ℤ := fun m n => C ⟨m, n⟩ - C ⟨m - 1, n⟩ + V ⟨m, n⟩ + have hEstep (m n : ℤ) : E m (n + 1) - E m n = 0 := by + have hd := hdiv ⟨m, n + 1⟩ + rw [hshiftR, hshiftI, add_sub_cancel_right] at hd + have hc := hCstep m n + have hc' := hCstep (m - 1) n + dsimp only [E] + omega + have hElower (m n : ℤ) (hn : n < r) : E m n = 0 := by + dsimp only [E] + rw [hClower _ hn, hClower _ hn, hVoutside _ (Or.inl hn)] + omega + have hEzero (m n : ℤ) : E m n = 0 := by + by_cases hn : n < r + · exact hElower m n hn + · let N := (n - (r - 1)).toNat + have hN : r - 1 + (N : ℤ) = n := by omega + have htel := Finset.sum_range_sub (fun k : ℕ => E m (r - 1 + (k : ℤ))) N + have hzero : (∑ k ∈ Finset.range N, + (E m (r - 1 + ((k + 1 : ℕ) : ℤ)) - E m (r - 1 + (k : ℤ)))) = 0 := by + apply Finset.sum_eq_zero + intro k hk + simpa only [Nat.cast_add, Nat.cast_one, add_assoc] using + hEstep m (r - 1 + (k : ℤ)) + rw [hzero] at htel + have hbase := hElower m (r - 1) (by omega) + simpa only [hN, Nat.cast_zero, add_zero, hbase, sub_zero] using htel.symm + -- At height s + 1 the same telescoping sum gives equality of column totals. + have hAstep (m : ℤ) : A m = A (m - 1) := by + have he := hEzero m (s + 1) + dsimp only [E] at he + rw [hCupper _ (by change s ≤ s + 1; omega), + hCupper _ (by change s ≤ s + 1; omega), + hVoutside _ (Or.inr (by change s < s + 1; omega))] at he + change A m - A (m - 1) + 0 = 0 at he + omega + obtain ⟨a, ha⟩ := (H.support.finite_toSet.image (fun x : GaussianInt => x.re)).bddBelow + have hAbase : A (a - 1) = 0 := by + apply Finset.sum_eq_zero + intro y hy + obtain ⟨hyH, hyre⟩ := Finset.mem_filter.mp hy + change y.re = a - 1 at hyre + have hle : a ≤ y.re := ha ⟨y, hyH, rfl⟩ + omega + have hAzero (m : ℤ) : A m = 0 := by + refine Int.inductionOn' m (a - 1) hAbase ?_ ?_ + · intro k hk ih + have := hAstep (k + 1) + rw [add_sub_cancel_right] at this + exact this.trans ih + · intro k hk ih + exact (hAstep k).symm.trans ih + -- Only supported columns and rows r through s - 1 can support C. + let T : Finset GaussianInt := + ((H.support.image (fun x => x.re)).product (Finset.Icc r (s - 1))).image + (fun p : ℤ × ℤ => (⟨p.1, p.2⟩ : GaussianInt)) + have hCfinite (x : GaussianInt) (hx : C x ≠ 0) : x ∈ T := by + have hre : x.re ∈ H.support.image (fun y => y.re) := by + by_contra hn + apply hx + apply Finset.sum_eq_zero + intro y hy + obtain ⟨hyH, hyre, hyim⟩ := Finset.mem_filter.mp hy + exact False.elim (hn (Finset.mem_image.mpr ⟨y, hyH, hyre⟩)) + have hlo : r ≤ x.im := by + by_contra hn + exact hx (hClower x (by omega)) + have hhi : x.im ≤ s - 1 := by + by_contra hn + have hcx := hCupper x (by omega) + rw [hAzero] at hcx + exact hx hcx + apply Finset.mem_image.mpr + refine ⟨(x.re, x.im), Finset.mem_product.mpr ⟨hre, ?_⟩, ?_⟩ + · exact Finset.mem_Icc.mpr ⟨hlo, hhi⟩ + · cases x + rfl + let c : GaussianInt →₀ ℤ := Finsupp.onFinset T C hCfinite + have hc (x : GaussianInt) : c x = C x := Finsupp.onFinset_apply + refine ⟨hAzero, c, hc, ?_, ?_⟩ + · intro x + rw [hc, hc] + exact (hCdiff x).symm + · intro x + rw [hc, hc] + rcases x with ⟨m, n⟩ + rw [hshiftR] + have he := hEzero m n + dsimp only [E] at he + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3221T2TileFillingSupport.lean b/LeanPool/ApollonianSuperharmonic/P3221T2TileFillingSupport.lean new file mode 100644 index 0000000000..444ba84fee --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3221T2TileFillingSupport.lean @@ -0,0 +1,174 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.LatticeTileComplementGridConnected +public import Mathlib.Data.Finsupp.Basic + +-- [TABLET NODE: P3221T2TileFillingSupport] + +/-! +# P3221T2TileFillingSupport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3221T2TileFillingSupport (T : ProtoTile) (hT : LatticeTile T) + (c : GaussianInt →₀ ℤ) + (hH : ∀ x, ({x, x + 1} : Finset GaussianInt) ∉ FootprintEdges T → + c x - c (x - ⟨0, 1⟩) = 0) + (hV : ∀ x, ({x, x + ⟨0, 1⟩} : Finset GaussianInt) ∉ FootprintEdges T → + c (x - 1) - c x = 0) : + ∀ x, x ∉ T.cells → c x = 0 := by +-- BODY + classical + have horizontal_unique (a b : GaussianInt) + (h : ({a, a + 1} : Finset GaussianInt) = {b, b + 1}) : a = b := by + have ha : a = b ∨ a = b + 1 := by + have : a ∈ ({b, b + 1} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have ha1 : a + 1 = b ∨ a + 1 = b + 1 := by + have : a + 1 ∈ ({b, b + 1} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + rcases ha with hab | hab + · exact hab + · have hr := congrArg Zsqrtd.re hab + rcases ha1 with ha1 | ha1 + all_goals + have hr1 := congrArg Zsqrtd.re ha1 + simp at hr hr1 + exfalso + omega + have vertical_unique (a b : GaussianInt) + (h : ({a, a + ⟨0, 1⟩} : Finset GaussianInt) = {b, b + ⟨0, 1⟩}) : a = b := by + have ha : a = b ∨ a = b + ⟨0, 1⟩ := by + have : a ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hai : a + ⟨0, 1⟩ = b ∨ a + ⟨0, 1⟩ = b + ⟨0, 1⟩ := by + have : a + ⟨0, 1⟩ ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← h]; simp + simpa using this + rcases ha with hab | hab + · exact hab + · have hi := congrArg Zsqrtd.im hab + rcases hai with hai | hai + all_goals + have hi1 := congrArg Zsqrtd.im hai + simp at hi hi1 + exfalso + omega + have horizontal_vertical_ne (a b : GaussianInt) : + ({a, a + 1} : Finset GaussianInt) ≠ {b, b + ⟨0, 1⟩} := by + intro h + have ha : a = b ∨ a = b + ⟨0, 1⟩ := by + have : a ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have ha1 : a + 1 = b ∨ a + 1 = b + ⟨0, 1⟩ := by + have : a + 1 ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + rcases ha with ha | ha <;> rcases ha1 with ha1 | ha1 + all_goals + have hr := congrArg Zsqrtd.re ha + have hr1 := congrArg Zsqrtd.re ha1 + simp at hr hr1 + omega + have horizontal_missing (z : GaussianInt) + (hz : z ∉ T.cells) (hzi : z - ⟨0, 1⟩ ∉ T.cells) : + ({z, z + 1} : Finset GaussianInt) ∉ FootprintEdges T := by + rintro ⟨w, hw, he | he | he | he⟩ + · exact hz (horizontal_unique z w he ▸ hw) + · exact horizontal_vertical_ne z w he + · exact horizontal_vertical_ne z (w + 1) he + · have he' : ({z, z + 1} : Finset GaussianInt) = {w + ⟨0, 1⟩, w + ⟨0, 1⟩ + 1} := by + simpa [add_assoc, add_comm, add_left_comm] using he + have hzw := horizontal_unique z (w + ⟨0, 1⟩) he' + apply hzi + simpa [hzw] using hw + have vertical_missing (z : GaussianInt) + (hz : z ∉ T.cells) (hz1 : z - 1 ∉ T.cells) : + ({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∉ FootprintEdges T := by + rintro ⟨w, hw, he | he | he | he⟩ + · exact horizontal_vertical_ne w z he.symm + · exact hz (vertical_unique z w he ▸ hw) + · have hzw := vertical_unique z (w + 1) he + apply hz1 + simpa [hzw] using hw + · have he' : ({w + ⟨0, 1⟩, w + ⟨0, 1⟩ + 1} : Finset GaussianInt) = {z, z + ⟨0, 1⟩} := by + simpa [add_assoc, add_comm, add_left_comm] using he.symm + exact horizontal_vertical_ne (w + ⟨0, 1⟩) z he' + have adjacent_equal (a b : GaussianInt) (ha : a ∉ T.cells) + (hb : b ∉ T.cells) (hab : FourNeighborAdjacent a b) : c a = c b := by + rcases hab with rfl | rfl | rfl | rfl + · have hh := hV (a + 1) + (vertical_missing (a + 1) hb (by simpa using ha)) + have hh' : c a - c (a + 1) = 0 := by simpa using hh + omega + · have hh := hV a (vertical_missing a ha hb) + omega + · have hh := hH (a + ⟨0, 1⟩) + (horizontal_missing (a + ⟨0, 1⟩) hb (by simpa using ha)) + have hh' : c (a + ⟨0, 1⟩) - c a = 0 := by simpa using hh + omega + · have hh := hH a (horizontal_missing a ha hb) + omega + let s : Finset GaussianInt := insert 0 (T.cells ∪ c.support) + obtain ⟨a, ha, hmax⟩ := Finset.exists_max_image s (fun z => z.re) + (by simp [s]) + let b : GaussianInt := a + 1 + have hb : b ∉ s := by + intro hb + have hm := hmax b hb + simp [b] at hm + have hbT : b ∉ T.cells := by + intro h + apply hb + simp [s, h] + have hbc : c b = 0 := by + by_contra h + have hmem : b ∈ c.support := Finsupp.mem_support_iff.mpr h + apply hb + simp [s, hmem] + have chain_const : ∀ (a : GaussianInt) (l : List GaussianInt), + (∀ z ∈ a :: l, z ∉ T.cells) → List.IsChain FourNeighborAdjacent (a :: l) → + ∀ z ∈ a :: l, c z = c a := by + intro a l + induction l generalizing a with + | nil => + intro hout hchain z hz + rcases List.mem_singleton.mp hz with rfl + rfl + | cons d l ih => + intro hout hchain z hz + have had : FourNeighborAdjacent a d := + (List.isChain_cons.mp hchain).1 d (by simp) + have heq := adjacent_equal a d (hout a (by simp)) (hout d (by simp)) had + rcases List.mem_cons.mp hz with rfl | hz + · rfl + · exact (ih d (fun z hz => hout z (by simp [hz])) + (List.isChain_cons.mp hchain).2 z hz).trans heq.symm + intro x hx + obtain ⟨p, hhead, hlast, hout, hadj⟩ := + (LatticeTileComplementGridConnected T hT).2 x hx b hbT + have hchain : List.IsChain FourNeighborAdjacent p := + List.isChain_iff_forall_rel_of_append_cons_cons.mpr hadj + cases p with + | nil => simp at hhead + | cons a l => + simp only [List.head?_cons, Option.some.injEq] at hhead + subst a + have heq := chain_const x l hout hchain b + (List.mem_of_mem_getLast? (by simp [hlast])) + exact heq.symm.trans hbc + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3350T1GraphCellUnionConnected.lean b/LeanPool/ApollonianSuperharmonic/P3350T1GraphCellUnionConnected.lean new file mode 100644 index 0000000000..fbc116c9e2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3350T1GraphCellUnionConnected.lean @@ -0,0 +1,207 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition + +-- [TABLET NODE: P3350T1GraphCellUnionConnected] + +/-! +# P3350T1GraphCellUnionConnected + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3350T1GraphCellUnionConnected {ι : Type*} + (adjacent : ι → ι → Prop) (hirrefl : ∀ a, ¬ adjacent a a) + (tile : ι → ProtoTile) (S : Set ι) (hnonempty : S.Nonempty) + (htile : ∀ a ∈ S, FourNeighborConnected ((tile a).cells : Set LatticeCell)) + (hdisjoint : ∀ a ∈ S, ∀ b ∈ S, a ≠ b → + Disjoint (tile a).cells (tile b).cells) + (hedge : ∀ a ∈ S, ∀ b ∈ S, a ≠ b → adjacent a b → + (FootprintEdges (tile a) ∩ FootprintEdges (tile b)).Nonempty) + (hconnected : ∀ a ∈ S, ∀ b ∈ S, + ∃ p : List ι, p.head? = some a ∧ p.getLast? = some b ∧ + (∀ c ∈ p, c ∈ S) ∧ + ∀ c d : ι, ∀ l₁ l₂ : List ι, + p = l₁ ++ c :: d :: l₂ → adjacent c d) : + FourNeighborConnected {x : LatticeCell | ∃ a ∈ S, x ∈ (tile a).cells} := by +-- BODY + classical + let U : Set LatticeCell := {x | ∃ a ∈ S, x ∈ (tile a).cells} + have edgeStep : ∀ a ∈ S, ∀ b ∈ S, adjacent a b → + ∃ u ∈ (tile a).cells, ∃ v ∈ (tile b).cells, FourNeighborAdjacent u v := by + intro a ha b hb hab + have hne : a ≠ b := by + intro heq + subst b + exact hirrefl a hab + obtain ⟨e, hU, hV⟩ := hedge a ha b hb hne hab + have hene : e.Nonempty := by + obtain ⟨u, hu, h | h | h | h⟩ := hU + all_goals rw [h]; simp + obtain ⟨x, hx⟩ := hene + obtain ⟨j, _, hsector⟩ := P3102T2CommonEdgeSectorTransition + (tile a) (tile b) x e (hdisjoint a ha b hb hne) hx ⟨hU, hV⟩ + have hstep : ∀ j : Fin 4, + FourNeighborAdjacent (LatticeVertexIncidentCell x j) + (LatticeVertexIncidentCell x (j + 1)) := by + intro j + fin_cases j <;> + simp [FourNeighborAdjacent, LatticeVertexIncidentCell, Zsqrtd.ext_iff] + have hsymm : ∀ u v : LatticeCell, + FourNeighborAdjacent u v → FourNeighborAdjacent v u := by + intro u v h + rcases h with h | h | h | h + all_goals subst v + all_goals simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + rcases hsector with hsector | hsector + · exact ⟨_, hsector.1, _, hsector.2, hstep j⟩ + · exact ⟨_, hsector.2, _, hsector.1, hsymm _ _ (hstep j)⟩ + have walkJoin : ∀ (x y z : LatticeCell) (p q : List LatticeCell), + p.head? = some x → p.getLast? = some y → + q.head? = some y → q.getLast? = some z → + (∀ w ∈ p, w ∈ U) → (∀ w ∈ q, w ∈ U) → + (∀ a b : LatticeCell, ∀ l₁ l₂ : List LatticeCell, + p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → + (∀ a b : LatticeCell, ∀ l₁ l₂ : List LatticeCell, + q = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → + ∃ r : List LatticeCell, + r.head? = some x ∧ r.getLast? = some z ∧ + (∀ w ∈ r, w ∈ U) ∧ + (∀ a b : LatticeCell, ∀ l₁ l₂ : List LatticeCell, + r = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) := by + intro x y z p q hp hy hq hz hps hqs hpp hqq + have hcp : List.IsChain FourNeighborAdjacent p := + (List.isChain_iff_forall_rel_of_append_cons_cons).2 hpp + have hcq : List.IsChain FourNeighborAdjacent q := + (List.isChain_iff_forall_rel_of_append_cons_cons).2 hqq + have hcross : ∀ u ∈ p.getLast?, ∀ v ∈ q.tail.head?, + FourNeighborAdjacent u v := by + intro u hu v hv + have hu' : u = y := by simpa [hy] using hu.symm + cases q with + | nil => simp at hq + | cons qhead qrest => + cases qrest with + | nil => simp at hv + | cons qnext qmore => + have hv' := hcq.rel_head? hv + have hqhead : qhead = y := by simpa using hq + rw [hqhead] at hv' + rw [hu'] + exact hv' + refine ⟨p ++ q.tail, ?_, ?_, ?_, ?_⟩ + · have hpne : p ≠ [] := by + intro h + subst p + simp at hp + simpa [List.head?_append_of_ne_nil _ hpne] using hp + · have hlast : (p ++ q.tail).getLast? = q.getLast? := by + cases q with + | nil => simp at hq + | cons qhead qrest => + have hqhead : qhead = y := by simpa using hq + cases qrest with + | nil => simpa [hqhead] using hy + | cons qtail qmore => + rw [List.getLast?_append_of_ne_nil _ (by simp)] + exact (List.getLast?_append_of_ne_nil [qhead] (by simp)).symm + exact hlast.trans hz + · intro w hw + simp only [List.mem_append] at hw + rcases hw with hw | hw + · exact hps w hw + · exact hqs w (List.mem_of_mem_tail hw) + · exact (List.isChain_iff_forall_rel_of_append_cons_cons).1 + (hcp.append hcq.tail hcross) + have tileWalk : ∀ a ∈ S, ∀ x ∈ (tile a).cells, ∀ y ∈ (tile a).cells, + ∃ p : List LatticeCell, + p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ U) ∧ + (∀ u v : LatticeCell, ∀ l₁ l₂ : List LatticeCell, + p = l₁ ++ u :: v :: l₂ → FourNeighborAdjacent u v) := by + intro a ha x hx y hy + obtain ⟨p, hp, hlast, hmem, hchain⟩ := (htile a ha).2 x hx y hy + exact ⟨p, hp, hlast, fun z hz => ⟨a, ha, hmem z hz⟩, hchain⟩ + have assemble : ∀ (c d : ι) (r : List ι), + r.head? = some c → r.getLast? = some d → + (∀ a ∈ r, a ∈ S) → + (∀ a b : ι, ∀ l₁ l₂ : List ι, + r = l₁ ++ a :: b :: l₂ → adjacent a b) → + ∀ x ∈ (tile c).cells, ∀ y ∈ (tile d).cells, + ∃ p : List LatticeCell, + p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ U) ∧ + (∀ u v : LatticeCell, ∀ l₁ l₂ : List LatticeCell, + p = l₁ ++ u :: v :: l₂ → FourNeighborAdjacent u v) := by + intro c d r + induction r generalizing c d with + | nil => simp + | cons e r ih => + cases r with + | nil => + intro hhead hlast hmem hchain x hx y hy + have hec : e = c := by simpa using hhead + have hed : e = d := by simpa using hlast + subst c + subst d + exact tileWalk e (hmem e (by simp)) x hx y hy + | cons f r => + intro hhead hlast hmem hchain x hx y hy + have hec : e = c := by simpa using hhead + have hfirst : adjacent e f := by + apply hchain e f [] r + simp + have heS : e ∈ S := hmem e (by simp) + have hfS : f ∈ S := hmem f (by simp) + obtain ⟨u, hu, v, hv, huv⟩ := edgeStep e heS f hfS hfirst + subst c + obtain ⟨q₁, hq₁, hq₂, hq₃, hq₄⟩ := tileWalk e heS x hx u hu + have huvU : ∀ w ∈ [u, v], w ∈ U := by + intro w hw + have hw' : w = u ∨ w = v := by simpa using hw + rcases hw' with rfl | rfl + · exact ⟨e, heS, hu⟩ + · exact ⟨f, hfS, hv⟩ + have huvEdges : ∀ (a b : LatticeCell) (l₁ l₂ : List LatticeCell), + [u, v] = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b := by + exact (List.isChain_iff_forall_rel_of_append_cons_cons).1 + ((List.isChain_pair).2 huv) + have hmemRest : ∀ w ∈ f :: r, w ∈ S := by + intro w hw + exact hmem w (by simp [hw]) + have hchainRest : ∀ a b : ι, ∀ l₁ l₂ : List ι, + f :: r = l₁ ++ a :: b :: l₂ → adjacent a b := by + intro a b l₁ l₂ h + apply hchain a b (e :: l₁) l₂ + simpa [List.cons_append, List.append_assoc] using h + obtain ⟨q₂, hq₂₁, hq₂₂, hq₂₃, hq₂₄⟩ := + ih (c := f) (d := d) (by simp) hlast hmemRest hchainRest v hv y hy + obtain ⟨qmid, hmid₁, hmid₂, hmid₃, hmid₄⟩ := + walkJoin x u v q₁ [u, v] + hq₁ hq₂ (by simp) (by simp) hq₃ huvU hq₄ huvEdges + exact walkJoin x v y qmid q₂ + hmid₁ hmid₂ hq₂₁ hq₂₂ hmid₃ hq₂₃ hmid₄ hq₂₄ + constructor + · obtain ⟨a, ha⟩ := hnonempty + obtain ⟨x, hx⟩ := (htile a ha).1 + exact ⟨x, a, ha, hx⟩ + · intro x hx y hy + obtain ⟨a, ha, hxa⟩ := hx + obtain ⟨b, hb, hyb⟩ := hy + obtain ⟨p, hphead, hplast, hpS, hpchain⟩ := hconnected a ha b hb + exact assemble a b p hphead hplast hpS hpchain x hxa y hyb + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3381T1AffineTriangleMap.lean b/LeanPool/ApollonianSuperharmonic/P3381T1AffineTriangleMap.lean new file mode 100644 index 0000000000..afe9a620f6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3381T1AffineTriangleMap.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Topology.Homeomorph.Lemmas +public import Mathlib.Topology.Instances.Real.Lemmas +public import Mathlib.Tactic.FunProp +public import Mathlib.Tactic.FieldSimp +public import Mathlib.Tactic.Ring +public import Mathlib.Tactic.Linarith +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant + +-- [TABLET NODE: P3381T1AffineTriangleMap] + +/-! +# P3381T1AffineTriangleMap + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3381T1AffineTriangleMap (p q : Fin 3 → Real × Real) + (hp : P3381T1TriangleDeterminant p ≠ 0) + (hq : P3381T1TriangleDeterminant q ≠ 0) : + ∃ h : (Real × Real) ≃ₜ (Real × Real), + ∀ w : Fin 3 → Real, (∑ i, w i) = 1 → + h (∑ i, w i • p i) = ∑ i, w i • q i := by +-- BODY + let place (v : Fin 3 → Real × Real) (x : Real × Real) : Real × Real := + ((v 0).1 + x.1 * ((v 1).1 - (v 0).1) + x.2 * ((v 2).1 - (v 0).1), + (v 0).2 + x.1 * ((v 1).2 - (v 0).2) + x.2 * ((v 2).2 - (v 0).2)) + let coord (v : Fin 3 → Real × Real) (x : Real × Real) : Real × Real := + (((x.1 - (v 0).1) * ((v 2).2 - (v 0).2) - + ((v 2).1 - (v 0).1) * (x.2 - (v 0).2)) / P3381T1TriangleDeterminant v, + (((v 1).1 - (v 0).1) * (x.2 - (v 0).2) - + (x.1 - (v 0).1) * ((v 1).2 - (v 0).2)) / P3381T1TriangleDeterminant v) + have hplace (v : Fin 3 → Real × Real) + (hv : P3381T1TriangleDeterminant v ≠ 0) (x : Real × Real) : + place v (coord v x) = x := by + apply Prod.ext <;> + dsimp [place, coord] <;> + field_simp <;> + simp only [P3381T1TriangleDeterminant, Prod.fst_sub, Prod.snd_sub] <;> ring + have hcoord (v : Fin 3 → Real × Real) + (hv : P3381T1TriangleDeterminant v ≠ 0) (x : Real × Real) : + coord v (place v x) = x := by + apply Prod.ext <;> + dsimp [place, coord] <;> + field_simp <;> + simp only [P3381T1TriangleDeterminant, Prod.fst_sub, Prod.snd_sub] <;> ring + let h : (Real × Real) ≃ₜ (Real × Real) := + { toFun := fun x => place q (coord p x) + invFun := fun x => place p (coord q x) + left_inv := fun x => by + change place p (coord q (place q (coord p x))) = x + rw [hcoord q hq, hplace p hp] + right_inv := fun x => by + change place q (coord p (place p (coord q x))) = x + rw [hcoord p hp, hplace q hq] + continuous_toFun := by dsimp [place, coord]; fun_prop + continuous_invFun := by dsimp [place, coord]; fun_prop } + refine ⟨h, ?_⟩ + intro w hw + have hw0 : w 0 = 1 - w 1 - w 2 := by + simp only [Fin.sum_univ_three] at hw + linarith + apply Prod.ext <;> + simp only [h, Fin.sum_univ_three, + Prod.fst_add, Prod.snd_add, Prod.smul_fst, Prod.smul_snd, smul_eq_mul] <;> + dsimp [place, coord] <;> + rw [hw0] <;> + field_simp <;> + simp only [P3381T1TriangleDeterminant, Prod.fst_sub, Prod.snd_sub] <;> ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3381T1PairedTriangulation.lean b/LeanPool/ApollonianSuperharmonic/P3381T1PairedTriangulation.lean new file mode 100644 index 0000000000..59e69b31c8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3381T1PairedTriangulation.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant + +-- [TABLET NODE: P3381T1PairedTriangulation] + +/-! +# P3381T1PairedTriangulation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $p$ be a `P3381T1PolygonBoundary`, and let $X,K\subseteq +\mathbb R^2$. A paired triangulation consists of distinct target points +$q_i$, a finite indexed family of triples $f_k$ of distinct vertex +indices, and the following certificates. The target boundary segments +have exactly the same simplicity condition as the source boundary. +Distinct triples have distinct sets of indices, and every vertex index +occurs in a triple. Both source and target triangles are nondegenerate +in the sense of `P3381T1TriangleDeterminant`. +Put +$$ + \Delta_k=\operatorname{conv}\{p_{f_k(0)},p_{f_k(1)},p_{f_k(2)}\}, + \qquad + \Delta'_k=\operatorname{conv}\{q_{f_k(0)},q_{f_k(1)},q_{f_k(2)}\}. +$$ +The coverage certificates are $X=\bigcup_k\Delta_k$ and +$K=\bigcup_k\Delta'_k$. If $J_{kl}$ is the intersection of the two +sets of indices, the exact face-intersection certificates are +$$ + \Delta_k\cap\Delta_l=\operatorname{conv}\{p_i:i\in J_{kl}\}, + \qquad + \Delta'_k\cap\Delta'_l=\operatorname{conv}\{q_i:i\in J_{kl}\}. +$$ +The convex hull of the empty set is empty. For any two distinct indices +$i,j$, precisely one triangle contains them both if they are cyclic +neighbors. Otherwise precisely two triangles contain them both if any +does, and none do if none does. These are counts of indexed triangles, +not an assertion about a drawing supplied elsewhere. + +Finally, $K$ equals the convex hull of all $q_i$, is convex, closed and +bounded, has nonempty ambient interior, and its actual ambient frontier +is $\bigcup_i[q_i,q_{i+1}]$. Every source boundary vertex, including a +straight vertex or an inserted rational port, remains an index in both +realizations. No source diskness, source frontier formula, +homeomorphism, or separation conclusion is assumed. +-/ +structure P3381T1PairedTriangulation {n : Nat} + (p : P3381T1PolygonBoundary n) (X K : Set (Real × Real)) where +-- BODY + /-- The target positions of the unchanged boundary labels. -/ + target : Fin (n + 3) → Real × Real + target_injective : Function.Injective target + target_edge_intersection : ∀ i j : Fin (n + 3), i ≠ j → + segment Real (target i) (target (i + 1)) ∩ + segment Real (target j) (target (j + 1)) = + {x | (x = target i ∨ x = target (i + 1)) ∧ + (x = target j ∨ x = target (j + 1))} + /-- The number of indexed triangles in the common face family. -/ + count : Nat + /-- The three boundary labels of each indexed triangle. -/ + face : Fin count → Fin 3 → Fin (n + 3) + face_injective : ∀ k, Function.Injective (face k) + face_distinct : Function.Injective (fun k => Set.range (face k)) + vertex_used : ∀ i, ∃ k j, face k j = i + source_nondegenerate : ∀ k, + P3381T1TriangleDeterminant (p.vertex ∘ face k) ≠ 0 + target_nondegenerate : ∀ k, + P3381T1TriangleDeterminant (target ∘ face k) ≠ 0 + source_cover : X = ⋃ k, convexHull Real (Set.range (p.vertex ∘ face k)) + target_cover : K = ⋃ k, convexHull Real (Set.range (target ∘ face k)) + source_intersection : ∀ k l, + convexHull Real (Set.range (p.vertex ∘ face k)) ∩ + convexHull Real (Set.range (p.vertex ∘ face l)) = + convexHull Real (p.vertex '' (Set.range (face k) ∩ Set.range (face l))) + target_intersection : ∀ k l, + convexHull Real (Set.range (target ∘ face k)) ∩ + convexHull Real (Set.range (target ∘ face l)) = + convexHull Real (target '' (Set.range (face k) ∩ Set.range (face l))) + edge_count : ∀ i j : Fin (n + 3), i ≠ j → + Set.ncard {k : Fin count | + i ∈ Set.range (face k) ∧ j ∈ Set.range (face k)} = + if j = i + 1 ∨ i = j + 1 then 1 + else if ∃ k, i ∈ Set.range (face k) ∧ j ∈ Set.range (face k) then 2 else 0 + target_hull : K = convexHull Real (Set.range target) + target_convex : Convex Real K + target_closed : IsClosed K + target_bounded : Bornology.IsBounded K + target_interior : (interior K).Nonempty + target_frontier : frontier K = ⋃ i, segment Real (target i) (target (i + 1)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3381T1PiecewiseAffinePolygonModel.lean b/LeanPool/ApollonianSuperharmonic/P3381T1PiecewiseAffinePolygonModel.lean new file mode 100644 index 0000000000..1f1cb88cc5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3381T1PiecewiseAffinePolygonModel.lean @@ -0,0 +1,335 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3381T1AffineTriangleMap +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangulationBoundary +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Data.Set.Card + +-- [TABLET NODE: P3381T1PiecewiseAffinePolygonModel] + +/-! +# P3381T1PiecewiseAffinePolygonModel + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PiecewiseAffineProof + +private theorem hull_formula : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (u : Fin (n + 3) → Real × Real), + ∀ (v : Fin (n + 3) → Real × Real), ∀ (A : Fin t.count → (Real × Real) ≃ₜ (Real × + Real)), (∀ k, ∀ (w : Fin 3 → Real), (∑ i, w i) = 1 → A k (∑ i, w i • u (t.face k i)) + = ∑ i, w i • + v (t.face k i)) → ∀ (S : Set (Fin (n + 3))), ∀ (x : Real × Real), x ∈ convexHull Real (u + '' S) → ∃ y ∈ convexHull Real (v '' S), ∀ k, S ⊆ Set.range (t.face k) → A k x = y := by + classical + intro n p X K t u v A hA S x hx + obtain ⟨ι, inst, w, z, hw₀, hw₁, hz, hx⟩ := + mem_convexHull_iff_exists_fintype.mp hx + let _ := inst + choose j hj hz using hz + refine ⟨∑ r, w r • v (j r), ?_, ?_⟩ + · exact mem_convexHull_of_exists_fintype w (fun r => v (j r)) hw₀ hw₁ + (fun r => Set.mem_image_of_mem v (hj r)) rfl + · intro k hk + have hjk : ∀ r, ∃ i, t.face k i = j r := fun r => hk (hj r) + choose c hc using hjk + let W : Fin 3 → Real := fun i => ∑ r, if c r = i then w r else 0 + have hW : (∑ i, W i) = 1 := by + simpa [W, Finset.sum_comm] using hw₁ + have sum_eq : ∀ f : Fin (n + 3) → Real × Real, + (∑ i, W i • f (t.face k i)) = ∑ r, w r • f (j r) := by + intro f + simp [W, Finset.sum_smul, Finset.sum_comm, ite_smul, hc] + rw [← hx] + simp_rw [← hz] + calc + A k (∑ r, w r • u (j r)) = A k (∑ i, W i • u (t.face k i)) := + congrArg (A k) (sum_eq u).symm + _ = ∑ i, W i • v (t.face k i) := hA k W hW + _ = ∑ r, w r • v (j r) := sum_eq v + +private theorem paste : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (a : Fin t.count → ℝ × ℝ ≃ₜ ℝ × + ℝ), (∀ (k : Fin t.count), ∀ (w : Fin (3 : ℕ) → ℝ), ∑ i : Fin (3 : ℕ), w i = (1 : ℝ) → (a + k : ℝ × ℝ → ℝ × ℝ) (∑ i : Fin (3 : ℕ), w i • p.vertex (t.face k i)) = ∑ i : Fin (3 : ℕ), + w i • t.target (t.face k i)) → ((∀ (u : Fin (n + 3) → Real × Real), ∀ (v : Fin (n + 3) → + Real × Real), ∀ (A : Fin t.count → (Real × Real) ≃ₜ (Real × Real)), (∀ k, ∀ (w : Fin 3 → + Real), (∑ i, w i) = 1 → A k (∑ i, w i • u (t.face k i)) = ∑ i, w i • v (t.face k i)) → ∀ + (S : Set (Fin (n + 3))), ∀ (x : Real × Real), x ∈ convexHull Real (u '' S) → ∃ y ∈ + convexHull Real (v '' S), ∀ k, S ⊆ Set.range (t.face k) → A k x = y) → ((∀ k, ∀ (w : Fin + 3 → Real), (∑ i, w i) = 1 → (a k).symm (∑ i, w i • t.target (t.face k i)) = ∑ i, w i • + p.vertex (t.face k i)) → (∃ h : X ≃ₜ K, ∀ k, ∀ (x : X), (x : Real × Real) ∈ convexHull + Real (Set.range (p.vertex ∘ t.face k)) → (h x : Real × Real) = a k x))) := by + classical + intro n p X K t a ha hull_formula hai + let D := fun k => convexHull Real (Set.range (p.vertex ∘ t.face k)) + let E := fun k => convexHull Real (Set.range (t.target ∘ t.face k)) + have map_hull : ∀ (u v : Fin (n + 3) → Real × Real) + (A : Fin t.count → (Real × Real) ≃ₜ (Real × Real)), + (∀ k (w : Fin 3 → Real), (∑ i, w i) = 1 → + A k (∑ i, w i • u (t.face k i)) = ∑ i, w i • v (t.face k i)) → + ∀ k x, x ∈ convexHull Real (Set.range (u ∘ t.face k)) → + A k x ∈ convexHull Real (Set.range (v ∘ t.face k)) := by + intro u v A hA k x hx + rw [Set.range_comp] at hx ⊢ + obtain ⟨y, hy, heq⟩ := hull_formula u v A hA (Set.range (t.face k)) x hx + rwa [heq k (Set.Subset.refl _)] + have forward : ∀ k x, x ∈ D k → a k x ∈ E k := + map_hull p.vertex t.target a ha + have backward : ∀ k y, y ∈ E k → (a k).symm y ∈ D k := + map_hull t.target p.vertex (fun k => (a k).symm) hai + have agree : ∀ k l x, x ∈ D k → x ∈ D l → a k x = a l x := by + intro k l x hxk hxl + have hx : x ∈ convexHull Real + (p.vertex '' (Set.range (t.face k) ∩ Set.range (t.face l))) := by + rw [← t.source_intersection] + exact ⟨hxk, hxl⟩ + obtain ⟨y, _, heq⟩ := hull_formula p.vertex t.target a ha _ x hx + exact (heq k Set.inter_subset_left).trans (heq l Set.inter_subset_right).symm + have agree_inv : ∀ k l y, y ∈ E k → y ∈ E l → + (a k).symm y = (a l).symm y := by + intro k l y hyk hyl + have hy : y ∈ convexHull Real + (t.target '' (Set.range (t.face k) ∩ Set.range (t.face l))) := by + rw [← t.target_intersection] + exact ⟨hyk, hyl⟩ + obtain ⟨x, _, heq⟩ := hull_formula t.target p.vertex + (fun k => (a k).symm) hai _ y hy + exact (heq k Set.inter_subset_left).trans (heq l Set.inter_subset_right).symm + have pick_source : ∀ x : X, ∃ k, (x : Real × Real) ∈ D k := by + intro x + exact Set.mem_iUnion.mp (t.source_cover ▸ x.property) + have pick_target : ∀ y : K, ∃ k, (y : Real × Real) ∈ E k := by + intro y + exact Set.mem_iUnion.mp (t.target_cover ▸ y.property) + choose ks hks using pick_source + choose kt hkt using pick_target + let f : X → K := fun x => ⟨a (ks x) x, by + rw [t.target_cover] + exact Set.mem_iUnion.mpr ⟨ks x, forward (ks x) x (hks x)⟩⟩ + let g : K → X := fun y => ⟨(a (kt y)).symm y, by + rw [t.source_cover] + exact Set.mem_iUnion.mpr ⟨kt y, backward (kt y) y (hkt y)⟩⟩ + have hf : ∀ k (x : X), (x : Real × Real) ∈ D k → + (f x : Real × Real) = a k x := by + intro k x hx + exact agree (ks x) k x (hks x) hx + have hg : ∀ k (y : K), (y : Real × Real) ∈ E k → + (g y : Real × Real) = (a k).symm y := by + intro k y hy + exact agree_inv (kt y) k y (hkt y) hy + have hgf : ∀ x, g (f x) = x := by + intro x + apply Subtype.ext + rw [hg (ks x) (f x) (forward (ks x) x (hks x))] + exact (a (ks x)).symm_apply_apply x + have hfg : ∀ y, f (g y) = y := by + intro y + apply Subtype.ext + rw [hf (kt y) (g y) (backward (kt y) y (hkt y))] + exact (a (kt y)).apply_symm_apply y + -- Closed preimages are finite unions of the local closed preimages. + have continuous_glue : ∀ (Y : Set (Real × Real)) + (C : Fin t.count → Set (Real × Real)) + (A : Fin t.count → (Real × Real) ≃ₜ (Real × Real)), + Y = ⋃ k, C k → (∀ k, IsClosed (C k)) → + ∀ F : Y → Real × Real, + (∀ k (x : Y), (x : Real × Real) ∈ C k → F x = A k x) → + Continuous F := by + intro Y C A hcover hclosed F hF + apply continuous_iff_isClosed.mpr + intro B hB + have heq : F ⁻¹' B = ⋃ k, + (Subtype.val ⁻¹' C k) ∩ ((A k) ∘ Subtype.val) ⁻¹' B := by + ext x + constructor + · intro hx + have hxY : (x : Real × Real) ∈ ⋃ k, C k := + (Set.ext_iff.mp hcover x).mp x.property + obtain ⟨k, hk⟩ := Set.mem_iUnion.mp hxY + refine Set.mem_iUnion.mpr ⟨k, hk, ?_⟩ + change A k x ∈ B + change F x ∈ B at hx + rwa [← hF k x hk] + · intro hx + obtain ⟨k, hk, hx⟩ := Set.mem_iUnion.mp hx + change A k x ∈ B at hx + change F x ∈ B + rwa [hF k x hk] + rw [heq] + exact isClosed_iUnion_of_finite fun k => + ((hclosed k).preimage continuous_subtype_val).inter + (hB.preimage ((A k).continuous.comp continuous_subtype_val)) + have hfcont : Continuous f := by + apply Continuous.subtype_mk + exact continuous_glue X D a t.source_cover + (fun k => ((Set.finite_range (p.vertex ∘ t.face k)).isCompact_convexHull + Real).isClosed) (fun x => (f x : Real × Real)) hf + have hgcont : Continuous g := by + apply Continuous.subtype_mk + exact continuous_glue K E (fun k => (a k).symm) t.target_cover + (fun k => ((Set.finite_range (t.target ∘ t.face k)).isCompact_convexHull + Real).isClosed) (fun y => (g y : Real × Real)) hg + exact ⟨{ toFun := f + invFun := g + left_inv := hgf + right_inv := hfg + continuous_toFun := hfcont + continuous_invFun := hgcont }, hf⟩ + +private theorem edge_used : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ i : Fin (n + 3), ∃ k, i ∈ + Set.range (t.face k) ∧ i + 1 ∈ Set.range (t.face k) := by + classical + intro n p X K t i + have hne : i ≠ i + 1 := by + intro hi + have hzero : (0 : Fin (n + 3)) = 1 := + add_left_cancel (show i + 0 = i + 1 by simp at hi) + exact Fin.zero_ne_one hzero + have he := t.edge_count i (i + 1) hne + simp only [true_or, ite_true] at he + have hn : 0 < Set.ncard {k : Fin t.count | + i ∈ Set.range (t.face k) ∧ i + 1 ∈ Set.range (t.face k)} := by + rw [he] + exact Nat.zero_lt_one + exact (Set.ncard_pos (Set.toFinite _)).mp hn + +private theorem edge_transport : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (a : Fin t.count → ℝ × ℝ ≃ₜ ℝ × + ℝ), (∀ (k : Fin t.count), ∀ (w : Fin (3 : ℕ) → ℝ), ∑ i : Fin (3 : ℕ), w i = (1 : ℝ) → (a + k : ℝ × ℝ → ℝ × ℝ) (∑ i : Fin (3 : ℕ), w i • p.vertex (t.face k i)) = ∑ i : Fin (3 : ℕ), + w i • t.target (t.face k i)) → ((∀ (u : Fin (n + 3) → Real × Real), ∀ (v : Fin (n + 3) → + Real × Real), ∀ (A : Fin t.count → (Real × Real) ≃ₜ (Real × Real)), (∀ k, ∀ (w : Fin 3 → + Real), (∑ i, w i) = 1 → A k (∑ i, w i • u (t.face k i)) = ∑ i, w i • v (t.face k i)) → ∀ + (S : Set (Fin (n + 3))), ∀ (x : Real × Real), x ∈ convexHull Real (u '' S) → ∃ y ∈ + convexHull Real (v '' S), ∀ k, S ⊆ Set.range (t.face k) → A k x = y) → ((∀ k, ∀ (w : Fin + 3 → Real), (∑ i, w i) = 1 → (a k).symm (∑ i, w i • t.target (t.face k i)) = ∑ i, w i • + p.vertex (t.face k i)) → (∀ (h : (↑X : Type) ≃ₜ (↑K : Type)), (∀ (k : Fin t.count), ∀ (x + : (↑X : Type)), (↑x : ℝ × ℝ) ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (Set.range + (p.vertex ∘ t.face k)) → (↑((h : (↑X : Type) → (↑K : Type)) x) : ℝ × ℝ) = (a k : ℝ × ℝ → + ℝ × ℝ) (↑x : ℝ × ℝ)) → ((∀ i : Fin (n + 3), ∃ k, i ∈ Set.range (t.face k) ∧ i + 1 ∈ + Set.range (t.face k)) → ((∀ (u : Fin (n + 3) → Real × Real), ∀ i, convexHull Real (u '' + {i, i + 1}) = segment Real (u i) (u (i + 1))) → (∀ i, ∀ (x : X), (x : Real × Real) ∈ + segment Real (p.vertex i) (p.vertex (i + 1)) ↔ (h x : Real × Real) ∈ segment Real + (t.target i) (t.target (i + 1)))))))) := by + classical + intro n p X K t a ha hull_formula hai h hh edge_used pair_hull i x + obtain ⟨k, hki, hkj⟩ := edge_used i + have hs : ({i, i + 1} : Set (Fin (n + 3))) ⊆ Set.range (t.face k) := + Set.pair_subset hki hkj + have source_subset : segment Real (p.vertex i) (p.vertex (i + 1)) ⊆ + convexHull Real (Set.range (p.vertex ∘ t.face k)) := by + rw [← pair_hull p.vertex i, Set.range_comp] + exact convexHull_mono (Set.image_mono hs) + constructor + · intro hx + have hx' : (x : Real × Real) ∈ convexHull Real (p.vertex '' {i, i + 1}) := by + rwa [pair_hull] + obtain ⟨y, hy, heq⟩ := hull_formula p.vertex t.target a ha _ x hx' + rw [hh k x (source_subset hx), heq k hs] + rwa [pair_hull] at hy + · intro hy + have hy' : (h x : Real × Real) ∈ convexHull Real + (t.target '' {i, i + 1}) := by + rwa [pair_hull] + obtain ⟨z, hz, heq⟩ := hull_formula t.target p.vertex + (fun k => (a k).symm) hai _ (h x) hy' + have hzseg : z ∈ segment Real (p.vertex i) (p.vertex (i + 1)) := by + rwa [pair_hull] at hz + have hztriangle := source_subset hzseg + have hzX : z ∈ X := by + rw [t.source_cover] + exact Set.mem_iUnion.mpr ⟨k, hztriangle⟩ + let zX : X := ⟨z, hzX⟩ + have hzx : h zX = h x := by + apply Subtype.ext + rw [hh k zX hztriangle] + change a k z = (h x : Real × Real) + rw [← heq k hs] + exact (a k).apply_symm_apply (h x) + have hz_eq : z = (x : Real × Real) := + congrArg Subtype.val (h.injective hzx) + rwa [← hz_eq] + +end PiecewiseAffineProof + +theorem P3381T1PiecewiseAffinePolygonModel {n : Nat} + (p : P3381T1PolygonBoundary n) (X K : Set (Real × Real)) + (t : P3381T1PairedTriangulation p X K) : + ∃ h : X ≃ₜ K, + (∀ x : X, (x : Real × Real) ∈ frontier X ↔ + (h x : Real × Real) ∈ frontier K) ∧ + ∀ k (x : X), + (x : Real × Real) ∈ convexHull Real (Set.range (p.vertex ∘ t.face k)) → + ∀ w : Fin 3 → Real, (∑ i, w i) = 1 → + (x : Real × Real) = ∑ i, w i • p.vertex (t.face k i) → + (h x : Real × Real) = ∑ i, w i • t.target (t.face k i) := by +-- BODY + classical + have local_maps : ∀ k, ∃ a : (Real × Real) ≃ₜ (Real × Real), + ∀ w : Fin 3 → Real, (∑ i, w i) = 1 → + a (∑ i, w i • p.vertex (t.face k i)) = + ∑ i, w i • t.target (t.face k i) := by + intro k + exact P3381T1AffineTriangleMap (p.vertex ∘ t.face k) + (t.target ∘ t.face k) (t.source_nondegenerate k) (t.target_nondegenerate k) + choose a ha using local_maps + -- Aggregate any finite convex combination into the three triangle weights. + have hull_formula : ∀ (u v : Fin (n + 3) → Real × Real) + (A : Fin t.count → (Real × Real) ≃ₜ (Real × Real)), + (∀ k (w : Fin 3 → Real), (∑ i, w i) = 1 → + A k (∑ i, w i • u (t.face k i)) = ∑ i, w i • v (t.face k i)) → + ∀ (S : Set (Fin (n + 3))) (x : Real × Real), + x ∈ convexHull Real (u '' S) → + ∃ y ∈ convexHull Real (v '' S), + ∀ k, S ⊆ Set.range (t.face k) → A k x = y := PiecewiseAffineProof.hull_formula n p X K t + have hai : ∀ k (w : Fin 3 → Real), (∑ i, w i) = 1 → + (a k).symm (∑ i, w i • t.target (t.face k i)) = + ∑ i, w i • p.vertex (t.face k i) := by + intro k w hw + rw [← ha k w hw, (a k).symm_apply_apply] + have paste : ∃ h : X ≃ₜ K, ∀ k (x : X), + (x : Real × Real) ∈ convexHull Real (Set.range (p.vertex ∘ t.face k)) → + (h x : Real × Real) = a k x := PiecewiseAffineProof.paste n p X K t a ha hull_formula hai + obtain ⟨h, hh⟩ := paste + refine ⟨h, ?_, ?_⟩ + · have hb := (P3381T1TriangulationBoundary p X K t).2.2.1 + have edge_used : ∀ i : Fin (n + 3), + ∃ k, i ∈ Set.range (t.face k) ∧ i + 1 ∈ Set.range (t.face k) := + PiecewiseAffineProof.edge_used n p X K t + have pair_hull : ∀ (u : Fin (n + 3) → Real × Real) i, + convexHull Real (u '' {i, i + 1}) = segment Real (u i) (u (i + 1)) := by + intro u i + rw [Set.image_pair, convexHull_pair] + have edge_transport : ∀ i (x : X), + (x : Real × Real) ∈ segment Real (p.vertex i) (p.vertex (i + 1)) ↔ + (h x : Real × Real) ∈ segment Real (t.target i) (t.target (i + 1)) := + PiecewiseAffineProof.edge_transport n p X K t a ha hull_formula hai h hh edge_used + pair_hull + intro x + rw [hb, t.target_frontier] + simp only [Set.mem_iUnion] + exact exists_congr fun i => edge_transport i x + · intro k x hx w hw hxw + rw [hh k x hx, hxw] + exact ha k w hw + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3381T1PolygonBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3381T1PolygonBoundary.lean new file mode 100644 index 0000000000..cf6a09a4bf --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3381T1PolygonBoundary.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Analysis.Convex.Hull +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: P3381T1PolygonBoundary] + +/-! +# P3381T1PolygonBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $n\ge0$, a polygonal boundary consists of $n+3$ rational plane +points $p_i$, indexed cyclically, with the following geometric conditions. +The points are distinct. For different indices $i,j$, the closed +segments $[p_i,p_{i+1}]$ and $[p_j,p_{j+1}]$ intersect exactly in their +common endpoints. In particular nonneighboring segments are disjoint, +and neighboring segments intersect only in their shared endpoint. +Straight vertices are allowed and are retained as indexed vertices; +inserting finitely many distinct rational points in the relative +interiors of the boundary segments is permitted when these conditions +continue to hold. No interior region or disk model is part of this data. +-/ +structure P3381T1PolygonBoundary (n : Nat) where +-- BODY + /-- The distinct rational plane vertices in cyclic boundary order. -/ + vertex : Fin (n + 3) → Real × Real + rational : ∀ i, ∃ r s : Rat, vertex i = ((r : Real), (s : Real)) + injective : Function.Injective vertex + edge_intersection : ∀ i j : Fin (n + 3), i ≠ j → + segment Real (vertex i) (vertex (i + 1)) ∩ + segment Real (vertex j) (vertex (j + 1)) = + {x | (x = vertex i ∨ x = vertex (i + 1)) ∧ + (x = vertex j ∨ x = vertex (j + 1))} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3381T1TriangleDeterminant.lean b/LeanPool/ApollonianSuperharmonic/P3381T1TriangleDeterminant.lean new file mode 100644 index 0000000000..c83ecd224e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3381T1TriangleDeterminant.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: P3381T1TriangleDeterminant] + +/-! +# P3381T1TriangleDeterminant + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For three plane points $p_0,p_1,p_2$, put +$$ + d(p)= (p_1-p_0)_1(p_2-p_0)_2-(p_2-p_0)_1(p_1-p_0)_2. +$$ +Thus $d(p)\ne0$ means that the triangle is nondegenerate; its unsigned +area is $|d(p)|/2$. +-/ +def P3381T1TriangleDeterminant (p : Fin 3 → Real × Real) : Real := +-- BODY + (p 1 - p 0).1 * (p 2 - p 0).2 - + (p 2 - p 0).1 * (p 1 - p 0).2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean new file mode 100644 index 0000000000..b0645b88be --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean @@ -0,0 +1,1477 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3381T1PairedTriangulation +public import LeanPool.ApollonianSuperharmonic.P3381T1AffineTriangleMap +public import LeanPool.ApollonianSuperharmonic.P5662T1TriangulationBarycentricCoordinates +public import Mathlib.Topology.Connected.PathConnected +public import Mathlib.Analysis.Convex.Topology +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.NormNum +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Analysis.Convex.PathConnected +public import Mathlib.Data.Set.Card +public import Mathlib.Analysis.Normed.Module.Convex +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Tactic.LinearCombination + +-- [TABLET NODE: P3381T1TriangulationBoundary] + +/-! +# P3381T1TriangulationBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TriangulationBoundaryProof + +private theorem hsubAt142 : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (k : Fin t.count), + let standard : Fin 3 → Real × Real := ![(0, 0), (1, 0), (0, 1)] + ∀ (A : ℝ × ℝ ≃ₜ ℝ × ℝ), (∀ (w : Fin (3 : ℕ) → ℝ), ∑ i : Fin (3 : ℕ), w i = (1 : ℝ) → (A : ℝ × + ℝ → ℝ × ℝ) (∑ i : Fin (3 : ℕ), w i • standard i) = ∑ i : Fin (3 : ℕ), w i • (p.vertex ∘ + t.face k) i) → ( + let U : Set (Real × Real) := + Set.Ioo (0 : Real) (1 / 4) ×ˢ Set.Ioo (0 : Real) (1 / 4) + A '' U ⊆ X) := by + classical + intro n p X K t k standard A hA U + rintro _ ⟨x, hx, rfl⟩ + have hx' : (0 < x.1 ∧ x.1 < 1 / 4) ∧ (0 < x.2 ∧ x.2 < 1 / 4) := hx + let w : Fin 3 → Real := ![1 - x.1 - x.2, x.1, x.2] + have hw : (∑ i, w i) = 1 := by + rw [Fin.sum_univ_three] + change (1 - x.1 - x.2) + x.1 + x.2 = 1 + ring + have hwx : (∑ i, w i • standard i) = x := by + apply Prod.ext <;> simp [Fin.sum_univ_three, standard, w] + have hAx : A x = ∑ i, w i • p.vertex (t.face k i) := by + rw [← hwx] + exact hA w hw + rw [t.source_cover] + refine Set.mem_iUnion.2 ⟨k, ?_⟩ + rw [hAx] + apply mem_convexHull_of_exists_fintype w (p.vertex ∘ t.face k) + · intro i + fin_cases i <;> dsimp [w] + all_goals linarith [hx'.1.1, hx'.1.2, hx'.2.1, hx'.2.2] + · exact hw + · intro i + exact Set.mem_range_self i + · rfl + +private theorem local_cones : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), (∃ (b : Fin t.count → ℝ × ℝ → Fin + (3 : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), ∑ j : Fin (3 : ℕ), b k z j = (1 : ℝ)) + ∧ (∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), ∑ j : Fin (3 : ℕ), b k z j • p.vertex (t.face k j) + = z) ∧ (∀ (k : Fin t.count), ∀ (w : Fin (3 : ℕ) → ℝ), ∑ j : Fin (3 : ℕ), w j = (1 : ℝ) → + b k (∑ j : Fin (3 : ℕ), w j • p.vertex (t.face k j)) = w) ∧ (∀ (k : Fin t.count), ∀ (j : + Fin (3 : ℕ)), Continuous fun (z : ℝ × ℝ) => b k z j) ∧ (∀ (k : Fin t.count), ∀ (z : ℝ × + ℝ), z ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (Set.range (p.vertex ∘ t.face k)) ↔ ∀ + (j : Fin (3 : ℕ)), (0 : ℝ) ≤ b k z j) ∧ (∀ (k : Fin t.count), ∀ (i : Fin (3 : ℕ)), b k + (p.vertex (t.face k i)) = Pi.single i (1 : ℝ)) ∧ ∀ (k : Fin t.count), ∀ (l : Fin + t.count), ∀ z ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (p.vertex '' (Set.range + (t.face k) ∩ Set.range (t.face l))), ∀ (j : Fin (3 : ℕ)), t.face k j ∉ Set.range (t.face + l) → b k z j = (0 : ℝ)) → ((∀ (i : Fin (n + (3 : ℕ))), ∀ (k : Fin t.count), p.vertex i ∈ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (Set.range (p.vertex ∘ t.face k)) ↔ i ∈ + Set.range (t.face k)) → (∀ i, ∃ r : Real, 0 < r ∧ + ∀ z ∈ Metric.ball (p.vertex i) r, + z ∈ X ↔ ∃ k, i ∈ Set.range (t.face k) ∧ + ∃ w : Fin 3 → Real, (∀ j, 0 ≤ w j) ∧ + z = p.vertex i + ∑ j, w j • (p.vertex (t.face k j) - p.vertex i))) := by + classical + intro n p X K t coordinates vertex_incidence + classical + obtain ⟨b, bsum, breconstruct, bunique, bcontinuous, bhull, bvertex, bcommon⟩ := + coordinates + let D k := convexHull Real (Set.range (p.vertex ∘ t.face k)) + have closed_D k : IsClosed (D k) := + ((Set.finite_range (p.vertex ∘ t.face k)).isCompact_convexHull Real).isClosed + intro i + let N : Set (Real × Real) := ⋂ k, + (if i ∈ Set.range (t.face k) then Set.univ else (D k)ᶜ) ∩ + ⋂ j, (if t.face k j = i then {z | 0 < b k z j} else Set.univ) + have open_N : IsOpen N := by + apply isOpen_iInter_of_finite + intro k + apply IsOpen.inter + · split_ifs + · exact isOpen_univ + · exact (closed_D k).isOpen_compl + · apply isOpen_iInter_of_finite + intro j + split_ifs + · exact isOpen_lt continuous_const (bcontinuous k j) + · exact isOpen_univ + have mem_N : p.vertex i ∈ N := by + apply Set.mem_iInter.mpr + intro k + constructor + · split_ifs with hki + · trivial + · exact fun h => hki ((vertex_incidence i k).mp h) + · apply Set.mem_iInter.mpr + intro j + split_ifs with hji + · change 0 < b k (p.vertex i) j + rw [← hji, bvertex] + simp + · trivial + obtain ⟨r, hr, hball⟩ := Metric.isOpen_iff.mp open_N _ mem_N + refine ⟨r, hr, ?_⟩ + intro z hz + have hzN := Set.mem_iInter.mp (hball hz) + constructor + · intro hzX + rw [t.source_cover] at hzX + obtain ⟨k, hzk⟩ := Set.mem_iUnion.mp hzX + have hki : i ∈ Set.range (t.face k) := by + by_contra h + have hnot := (hzN k).1 + simp only [h, ite_false] at hnot + exact hnot hzk + refine ⟨k, hki, b k z, (bhull k z).mp hzk, ?_⟩ + simp_rw [smul_sub] + rw [Finset.sum_sub_distrib, ← Finset.sum_smul, bsum, one_smul, breconstruct] + abel + · rintro ⟨k, ⟨a, ha⟩, w, hw, heq⟩ + let d : Fin 3 → Real := Pi.single a 1 + let q : Fin 3 → Real := fun j => w j + (1 - ∑ s, w s) * d j + have hqsum : (∑ j, q j) = 1 := by + simp only [q, Finset.sum_add_distrib, ← Finset.mul_sum] + simp [d] + have hqz : (∑ j, q j • p.vertex (t.face k j)) = z := by + simp only [q, add_smul, mul_smul, Finset.sum_add_distrib, ← Finset.smul_sum] + simp only [d, Pi.single_apply, ite_smul, one_smul, zero_smul, + Finset.sum_ite_eq', Finset.mem_univ, ite_true, ha] + rw [heq] + simp_rw [smul_sub] + rw [Finset.sum_sub_distrib, ← Finset.sum_smul] + rw [sub_smul, one_smul] + abel + have hbq : b k z = q := hqz ▸ bunique k q hqsum + have hqnonneg : ∀ j, 0 ≤ q j := by + intro j + by_cases hja : j = a + · have hpos := Set.mem_iInter.mp (hzN k).2 j + simp only [hja, ha, ite_true, Set.mem_ofPred_eq] at hpos + rw [hbq] at hpos + simpa [hja] using hpos.le + · simpa [q, d, Pi.single_apply, hja] using hw j + rw [t.source_cover] + exact Set.mem_iUnion.mpr ⟨k, (bhull k z).mpr (hbq ▸ hqnonneg)⟩ + +private theorem bcombo : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (b : Fin t.count → ℝ × ℝ → Fin (3 + : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), ∑ j : Fin (3 : ℕ), b k z j = (1 : ℝ)) → + ((∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), ∑ j : Fin (3 : ℕ), b k z j • p.vertex (t.face k j) + = z) → ((∀ (k : Fin t.count), ∀ (w : Fin (3 : ℕ) → ℝ), ∑ j : Fin (3 : ℕ), w j = (1 : ℝ) → + b k (∑ j : Fin (3 : ℕ), w j • p.vertex (t.face k j)) = w) → (∀ {ι : Type}, ∀ [Fintype ι], + ∀ (k : Fin t.count), ∀ (a : ι → ℝ), ∀ (f : ι → ℝ × ℝ), ∑ r : ι, a r = (1 + : ℝ) + → ∀ (j : Fin (3 : ℕ)), b k (∑ r : ι, a r • f r) j = ∑ r : ι, a r * b k (f r) j))) := by + classical + intro n p X K t b bsum breconstruct bunique ι typeclassInstance0 k a f ha j + let W : Fin 3 → Real := fun j => ∑ r, a r * b k (f r) j + have hW : (∑ j, W j) = 1 := by + simp only [W] + rw [Finset.sum_comm] + simp_rw [← Finset.mul_sum, bsum, mul_one] + exact ha + have hWz : (∑ j, W j • p.vertex (t.face k j)) = ∑ r, a r • f r := by + simp only [W, Finset.sum_smul] + rw [Finset.sum_comm] + simp_rw [mul_smul, ← Finset.smul_sum, breconstruct] + have h := bunique k W hW + rw [hWz] at h + exact congrFun h j + +private theorem hdisjoint : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (b : Fin t.count → ℝ × ℝ → Fin (3 + : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), z ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ + × ℝ)) (Set.range (p.vertex ∘ t.face k)) ↔ ∀ (j : Fin (3 : ℕ)), (0 : ℝ) ≤ b k z j) → ((∀ + (k : Fin t.count), ∀ (l : Fin t.count), ∀ z ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (p.vertex '' (Set.range (t.face k) ∩ Set.range (t.face l))), ∀ (j : Fin (3 : ℕ)), t.face + k j ∉ Set.range (t.face l) → b k z j = (0 : ℝ)) → ( + let D k := convexHull Real (Set.range (p.vertex ∘ t.face k)) + (∀ k, ∀ l, (Set.range (t.face k) ⊆ Set.range (t.face l)) → (k = l)) → (∀ (k : Fin t.count), ∀ + (l : Fin t.count), k ≠ l → ∀ (z : ℝ × ℝ), (∀ (j : Fin (3 : ℕ)), (0 : ℝ) < b k z j) → z ∈ D l + → False))) := by + classical + intro n p X K t b bhull bcommon D hfaces_subset k l hkl z hz hzl + have hzk : z ∈ D k := (bhull k z).mpr fun j => (hz j).le + have hzc : z ∈ convexHull Real + (p.vertex '' (Set.range (t.face k) ∩ Set.range (t.face l))) := by + rw [← t.source_intersection] + exact ⟨hzk, hzl⟩ + apply hkl + apply hfaces_subset k l + rintro i ⟨j, rfl⟩ + by_contra hj + exact (ne_of_gt (hz j)) (bcommon k l z hzc j hj) + +private theorem edge_coords : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (b : Fin t.count → ℝ × ℝ → Fin (3 + : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (i : Fin (3 : ℕ)), b k (p.vertex (t.face k i)) = + Pi.single i (1 : ℝ)) → ((∀ (a : Fin 3), ∀ (b : Fin 3), (a ≠ b) → (∃ c, a ≠ c ∧ b ≠ c)) → + ((∀ k, ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (a : Real), ∀ (c : Real), (a + c = 1) + → (∀ j, b k (a • x + c • y) j = a * b + k x j + c * b k y j)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → + (∀ (u : ℝ), + let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex j + let I : Set (Fin t.count) := {k | i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k)} + ∀ k ∈ I, + ∃ (a : Fin (3 : ℕ)) (d : Fin (3 : ℕ)) (c : Fin (3 : ℕ)), + t.face k a = i ∧ t.face k d = j ∧ a ≠ d ∧ a ≠ c ∧ d ≠ c ∧ b k z a = (1 : ℝ) - u ∧ b k z d = u + ∧ b k z c = (0 : ℝ))))) := by + classical + intro n p X K t b bvertex third blinear i j hij u z I k hk + obtain ⟨a, ha⟩ := hk.1 + obtain ⟨d, hd⟩ := hk.2 + have had : a ≠ d := by intro h; exact hij (ha.symm.trans (h ▸ hd)) + obtain ⟨c, hac, hdc⟩ := third a d had + refine ⟨a, d, c, ha, hd, had, hac, hdc, ?_, ?_, ?_⟩ + all_goals dsimp [z]; rw [blinear k _ _ _ _ (by ring), ← ha, ← hd, bvertex, bvertex] + · simp [had] + · simp [Ne.symm had] + · simp [Ne.symm hac, Ne.symm hdc] + +private theorem mem_D : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), + let D k := convexHull Real (Set.range (p.vertex ∘ t.face k)) + ∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ∀ (u : ℝ), (u ∈ Set.Ioo (0 : ℝ) (1 : + ℝ)) → ( + let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex j + let I : Set (Fin t.count) := {k | i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k)} + ∀ k ∈ I, z ∈ D k) := by + classical + intro n p X K t D i j u hu z I k hk + apply (convex_convexHull Real _).segment_subset + (subset_convexHull Real _ ?_) (subset_convexHull Real _ ?_) + (show z ∈ segment Real (p.vertex i) (p.vertex j) from ?_) + · obtain ⟨a, ha⟩ := hk.1 + exact ⟨a, congrArg p.vertex ha⟩ + · obtain ⟨d, hd⟩ := hk.2 + exact ⟨d, congrArg p.vertex hd⟩ + · rw [segment_eq_image] + exact ⟨u, ⟨hu.1.le, hu.2.le⟩, rfl⟩ + +private theorem containing : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (b : Fin t.count → ℝ × ℝ → Fin (3 + : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (l : Fin t.count), ∀ z ∈ (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (p.vertex '' (Set.range (t.face k) ∩ Set.range (t.face l))), ∀ (j : Fin (3 : + ℕ)), t.face k j ∉ Set.range (t.face l) → b k z j = (0 : ℝ)) → ( + let D k := convexHull Real (Set.range (p.vertex ∘ t.face k)) + ∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (∃ (k : Fin t.count), i ∈ Set.range + (t.face k) ∧ j ∈ Set.range (t.face k)) → (∀ (u : ℝ), (u ∈ Set.Ioo (0 : ℝ) (1 : ℝ)) → ( + let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex j + let I : Set (Fin t.count) := {k | i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k)} + (∀ k, (k ∈ I) → (∃ a d c : Fin 3, t.face k a = i ∧ t.face k d = j ∧ a ≠ d ∧ a ≠ c ∧ d ≠ c ∧ + b k z a = 1 - u ∧ b k z d = u ∧ b k z c = 0)) → ((∀ k, (k ∈ I) → (z ∈ D k)) → (∀ (k : Fin + t.count), z ∈ D k → k ∈ I))))) := by + classical + intro n p X K t b bcommon D i j hused u hu z I edge_coords mem_D k hk + obtain ⟨l, hl⟩ := hused + obtain ⟨a, d, c, ha, hd, had, hac, hdc, hza, hzd, hzc⟩ := edge_coords l hl + have hcommon : z ∈ convexHull Real + (p.vertex '' (Set.range (t.face l) ∩ Set.range (t.face k))) := by + rw [← t.source_intersection] + exact ⟨mem_D l hl, hk⟩ + constructor + · by_contra hi + have hzero := bcommon l k z hcommon a (ha ▸ hi) + rw [hza] at hzero + linarith [hu.2] + · by_contra hj + have hzero := bcommon l k z hcommon d (hd ▸ hj) + rw [hzd] at hzero + linarith [hu.1] + +private theorem opposite : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (b : Fin t.count → ℝ × ℝ → Fin (3 + : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (j : Fin (3 : ℕ)), Continuous fun (z : ℝ × ℝ) => b k z + j) → ((∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), z ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (Set.range (p.vertex ∘ t.face k)) ↔ ∀ (j : Fin (3 : ℕ)), (0 : ℝ) ≤ b k z j) → ((∀ (k : + Fin t.count), ∀ (i : Fin (3 : ℕ)), b k (p.vertex (t.face k i)) = Pi.single i (1 : ℝ)) + → ( + let D k := convexHull Real (Set.range (p.vertex ∘ t.face k)) + (∀ (a : Fin 3), ∀ (b : Fin 3), ∀ (c : Fin 3), (a ≠ b) → ((a ≠ c) → ((b ≠ c) → (∀ j, j = a ∨ j + = b ∨ j = c)))) → ((∀ k, ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (a : Real), ∀ (c : + Real), (a + c = 1) → (∀ j, b k (a • x + c • y) j = a * b k x + j + c * b k y j)) → ((∀ k, ∀ l, (k ≠ l) → (∀ z, (∀ j, 0 < b k z j) → ((z ∈ D l) → + (False)))) → ((∀ (O : Set (Real × Real)), (IsOpen O) → (∀ z, (z ∈ O) → (∀ v, ∃ u : + Real, 0 < u + ∧ u < 1 ∧ (1 - u) • z + u • v ∈ O))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : + ℕ))), ∀ (u : ℝ), (u ∈ Set.Ioo (0 : ℝ) (1 : ℝ)) → ( + let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex j + let I : Set (Fin t.count) := {k | i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k)} + ∀ (k : Fin t.count), ∀ (l : Fin t.count), k ≠ l → + k ∈ I → + l ∈ I → + ∀ (a : Fin (3 : ℕ)), ∀ (d : Fin (3 : ℕ)), ∀ (c : Fin (3 : ℕ)), ∀ (e : Fin (3 : ℕ)), ∀ (f + : Fin (3 : ℕ)), ∀ (g : Fin (3 : ℕ)), t.face k a = i → + t.face k d = j → + a ≠ d → + a ≠ c → + d ≠ c → + t.face l e = i → + t.face l f = j → + e ≠ f → + e ≠ g → + f ≠ g → + b k z a = (1 : ℝ) - u → + b k z d = u → + b k z c = (0 : ℝ) → + b l z e = (1 : ℝ) - u → + b l z f = u → b l z g = (0 : ℝ) → b k (p.vertex (t.face l + g)) c < (0 : ℝ))))))))) := by + classical + intro n p X K t b bcontinuous bhull bvertex D indices blinear hdisjoint perturb i j u hu z I k + l hkl hk hl a d c e f g hka hkd had hac hdc hle hlf hef heg hfg hza hzd hzc hze hzf hzg + by_contra hnot + have hnonneg := le_of_not_gt hnot + let O : Set (Real × Real) := {y | 0 < b k y a ∧ 0 < b k y d} + have hO : IsOpen O := + (isOpen_lt continuous_const (bcontinuous k a)).inter + (isOpen_lt continuous_const (bcontinuous k d)) + have hzO : z ∈ O := by + dsimp [O] + rw [hza, hzd] + exact ⟨sub_pos.mpr hu.2, hu.1⟩ + obtain ⟨s, hs0, hs1, hys⟩ := perturb O hO z hzO (p.vertex (t.face l g)) + let y := (1 - s) • z + s • p.vertex (t.face l g) + have hky : y ∈ D k := by + apply (bhull k y).mpr + intro r + rcases indices a d c had hac hdc r with rfl | rfl | rfl + · exact hys.1.le + · exact hys.2.le + · dsimp [y] + rw [blinear k _ _ _ _ (by ring), hzc, mul_zero, zero_add] + exact mul_nonneg hs0.le hnonneg + apply hdisjoint l k hkl.symm y _ hky + intro r + dsimp [y] + rw [blinear l _ _ _ _ (by ring), bvertex] + rcases indices e f g hef heg hfg r with rfl | rfl | rfl + · simp only [Pi.single_apply, heg, ite_false, mul_zero, add_zero, hze] + exact mul_pos (sub_pos.mpr hs1) (sub_pos.mpr hu.2) + · simp only [Pi.single_apply, hfg, ite_false, mul_zero, add_zero, hzf] + exact mul_pos (sub_pos.mpr hs1) hu.1 + · simp only [Pi.single_apply, ite_true, mul_one, hzg, mul_zero, zero_add] + exact hs0 + +private theorem hnotAt427 : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (k : Fin t.count), ∀ (b : Fin + t.count → ℝ × ℝ → Fin (3 : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), z ∈ (convexHull + ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (Set.range (p.vertex ∘ t.face k)) ↔ ∀ (j : Fin (3 : ℕ)), + (0 : ℝ) ≤ b k z j) → ((∀ (k : Fin t.count), ∀ (i : Fin (3 : ℕ)), b k (p.vertex (t.face k + i)) = Pi.single i (1 : ℝ)) → ( + let D k := convexHull Real (Set.range (p.vertex ∘ t.face k)) + (∀ k, IsClosed (D k)) → (∀ k, ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (a : Real), ∀ (c : + Real), (a + c = 1) → (∀ j, b k (a • x + c • y) j = a * b k x j + c * b k y + j)) → ((∀ (O : Set (Real × Real)), (IsOpen O) → (∀ z, (z ∈ O) → (∀ v, ∃ u : Real, 0 < u ∧ + u < 1 ∧ (1 - u) • z + u • v ∈ O))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : + ℕ))), ∀ (u : ℝ), + let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex j + let I : Set (Fin t.count) := {k | i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k)} + (∀ k, (z ∈ D k) → (k ∈ I)) → ((I = {k}) → ((k ∈ I) → (∀ (a : Fin (3 : ℕ)), ∀ (c : Fin (3 : + ℕ)), (a ≠ c) → ((b k z c = (0 : ℝ)) → (z ∉ interior X))))))))) := by + classical + intro n p X K t k b bhull bvertex D closed_D blinear perturb i j u z I containing hI hk a c hac + hzc hzint + let N : Set (Real × Real) := ⋂ l, if l = k then Set.univ else (D l)ᶜ + have hN : IsOpen N := by + apply isOpen_iInter_of_finite + intro l + split_ifs + · exact isOpen_univ + · exact (closed_D l).isOpen_compl + have hzN : z ∈ N := by + apply Set.mem_iInter.mpr + intro l + split_ifs with hl + · trivial + · intro hzl + have hlI := containing l hzl + rw [hI] at hlI + exact hl hlI + let v : Real × Real := (2 : Real) • z + (-1 : Real) • p.vertex (t.face k c) + have hvc : b k v c = -1 := by + dsimp [v] + rw [blinear k _ _ _ _ (by norm_num), hzc, bvertex] + simp + obtain ⟨s, hs0, hs1, hys⟩ := perturb (N ∩ interior X) + (hN.inter isOpen_interior) z ⟨hzN, hzint⟩ v + let y : Real × Real := (1 - s) • z + s • v + have hyX : y ∈ X := interior_subset hys.2 + rw [t.source_cover] at hyX + obtain ⟨l, hyl⟩ := Set.mem_iUnion.mp hyX + have hlk : l = k := by + by_contra hl + have hnot := Set.mem_iInter.mp hys.1 l + simp only [hl, ite_false] at hnot + exact hnot hyl + have hyc := (bhull k y).mp (hlk ▸ hyl) c + dsimp [y] at hyc + rw [blinear k _ _ _ _ (by ring), hzc, hvc] at hyc + linarith + +private theorem hNX : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (k : Fin t.count), ∀ (b : Fin + t.count → ℝ × ℝ → Fin (3 : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), z ∈ (convexHull + ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (Set.range (p.vertex ∘ t.face k)) ↔ ∀ (j : Fin (3 : ℕ)), + (0 : ℝ) ≤ b k z j) → ((∀ (a : Fin 3), ∀ (b : Fin 3), ∀ (c : Fin 3), (a ≠ b) → ((a ≠ + c) → ((b ≠ c) → (∀ j, j = + a ∨ j = b ∨ j = c)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ∀ (u : ℝ), + let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex j + ∀ (l : Fin t.count), ∀ (a : Fin (3 : ℕ)), ∀ (d : Fin (3 : ℕ)), ∀ (c : Fin (3 : ℕ)), (t.face k + a = i) → ((t.face k d = j) → ((a ≠ d) → ((a ≠ c) → ((d ≠ c) → ((b k z a = (1 : ℝ) - u) → + ((b k z d = u) → ((b k z c = (0 : ℝ)) → (∀ (e : Fin (3 : ℕ)), ∀ (f : Fin (3 : ℕ)), ∀ (g : + Fin (3 : ℕ)), (t.face l e = i) → ((t.face l f = j) → ((e ≠ f) → ((e ≠ g) → ((f ≠ g) → + ((b + l z e = (1 : ℝ) - u) → ((b l z f = u) → ((b l z g = (0 : ℝ)) → ((b l (p.vertex (t.face k + c)) g < (0 : ℝ)) → ((b l (p.vertex (t.face k a)) g = 0) → ((b l (p.vertex (t.face k d)) g + = 0) → ((∀ y, b l y g = b k y c * b l (p.vertex (t.face k c)) g) → ( + let N : Set (Real × Real) := + {y | 0 < b k y a ∧ 0 < b k y d} ∩ {y | 0 < b l y e ∧ 0 < b l y f} + (IsOpen N) → ((z ∈ N) → (N ⊆ X)))))))))))))))))))))))) := by + classical + intro n p X K t k b bhull indices i j u z l a d c hka hkd had hac hdc hza hzd hzc e f g hle hlf + hef heg hfg hze hzf hzg hnegative hlga hlgd relation N hN hzN y hy + rw [t.source_cover] + by_cases hc : 0 ≤ b k y c + · refine Set.mem_iUnion.mpr ⟨k, (bhull k y).mpr ?_⟩ + intro r + rcases indices a d c had hac hdc r with rfl | rfl | rfl + · exact hy.1.1.le + · exact hy.1.2.le + · exact hc + · refine Set.mem_iUnion.mpr ⟨l, (bhull l y).mpr ?_⟩ + intro r + rcases indices e f g hef heg hfg r with rfl | rfl | rfl + · exact hy.2.1.le + · exact hy.2.2.le + · rw [relation] + exact (mul_pos_of_neg_of_neg (lt_of_not_ge hc) hnegative).le + +private theorem hfrontier : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), (IsCompact X) → ((∃ (b : Fin + t.count → ℝ × ℝ → Fin (3 : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), ∑ j : Fin (3 : + ℕ), b k z j = (1 : ℝ)) ∧ (∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), ∑ j : Fin (3 : ℕ), b k z j + • p.vertex (t.face k j) = z) ∧ (∀ (k : Fin t.count), ∀ (w : Fin (3 : ℕ) → ℝ), ∑ j : Fin + (3 : ℕ), w j = (1 : ℝ) → b k (∑ j : Fin (3 : ℕ), w j • p.vertex (t.face k j)) = w) ∧ (∀ + (k : Fin t.count), ∀ (j : Fin (3 : ℕ)), Continuous fun (z : ℝ × ℝ) => b k z j) ∧ (∀ + (k : Fin t.count), ∀ (z : ℝ × ℝ), z ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (Set.range + (p.vertex ∘ t.face k)) ↔ ∀ (j : Fin (3 : ℕ)), (0 : ℝ) ≤ b k z j) ∧ (∀ (k : Fin t.count), + ∀ (i : Fin (3 : ℕ)), b k (p.vertex (t.face k i)) = Pi.single i (1 : ℝ)) ∧ ∀ (k : Fin + t.count), ∀ (l : Fin t.count), ∀ z ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (p.vertex + '' (Set.range (t.face k) ∩ Set.range (t.face l))), ∀ (j : Fin (3 : ℕ)), t.face k j ∉ + Set.range (t.face l) → b k z j = (0 : ℝ)) → ((∀ i, ∀ j, i ≠ j → (∃ k, i ∈ Set.range (t.face + k) ∧ j ∈ Set.range (t.face k)) → ∀ z ∈ openSegment Real (p.vertex i) (p.vertex j), (z ∈ + interior X ↔ ¬ (j = i + 1 ∨ i = j + 1))) → (frontier X = ⋃ i, segment Real (p.vertex i) + (p.vertex (i + 1))))) := by + classical + intro n p X K t hcompact coordinates edge_interior + classical + obtain ⟨b, bsum, breconstruct, bunique, bcontinuous, bhull, bvertex, bcommon⟩ := + coordinates + have third (c : Fin 3) : ∃ a d, a ≠ d ∧ a ≠ c ∧ d ≠ c := by + fin_cases c <;> decide + have sum_three {E : Type} [AddCommMonoid E] (f : Fin 3 → E) + (a d c : Fin 3) (had : a ≠ d) (hac : a ≠ c) (hdc : d ≠ c) : + (∑ j, f j) = f a + f d + f c := by + fin_cases a <;> fin_cases d <;> fin_cases c + all_goals first + | exact (had rfl).elim + | exact (hac rfl).elim + | exact (hdc rfl).elim + | (rw [Fin.sum_univ_three]; ac_rfl) + have edge_used : ∀ i : Fin (n + 3), + ∃ k, i ∈ Set.range (t.face k) ∧ i + 1 ∈ Set.range (t.face k) := by + intro i + have hne : i ≠ i + 1 := by + intro hi + have hzero : (0 : Fin (n + 3)) = 1 := + add_left_cancel (show i + 0 = i + 1 by simpa only [add_zero] using hi) + exact Fin.zero_ne_one hzero + have he := t.edge_count i (i + 1) hne + simp only [true_or, ite_true] at he + have hn : 0 < Set.ncard {k : Fin t.count | + i ∈ Set.range (t.face k) ∧ i + 1 ∈ Set.range (t.face k)} := by + rw [he] + exact Nat.zero_lt_one + exact (Set.ncard_pos (Set.toFinite _)).mp hn + have edge_subset i j (hused : ∃ k, i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k)) : + segment Real (p.vertex i) (p.vertex j) ⊆ X := by + obtain ⟨k, ⟨a, ha⟩, ⟨d, hd⟩⟩ := hused + have hs : segment Real (p.vertex i) (p.vertex j) ⊆ + convexHull Real (Set.range (p.vertex ∘ t.face k)) := by + apply (convex_convexHull Real _).segment_subset + · exact subset_convexHull Real _ ⟨a, congrArg p.vertex ha⟩ + · exact subset_convexHull Real _ ⟨d, congrArg p.vertex hd⟩ + intro z hz + rw [t.source_cover] + exact Set.mem_iUnion.mpr ⟨k, hs hz⟩ + have polygon_frontier i : segment Real (p.vertex i) (p.vertex (i + 1)) ⊆ frontier X := by + have hne : i ≠ i + 1 := by + intro hi + have hzero : (0 : Fin (n + 3)) = 1 := + add_left_cancel (show i + 0 = i + 1 by simpa only [add_zero] using hi) + exact Fin.zero_ne_one hzero + have hs : openSegment Real (p.vertex i) (p.vertex (i + 1)) ⊆ frontier X := by + intro z hz + have hzX := edge_subset i (i + 1) (edge_used i) + (openSegment_subset_segment Real _ _ hz) + apply (mem_frontier_iff_notMem_interior hzX).mpr + have h := edge_interior i (i + 1) hne (edge_used i) z hz + simpa using h + exact (segment_subset_closure_openSegment (𝕜 := Real)).trans + ((closure_mono hs).trans isClosed_frontier.closure_eq.subset) + apply Set.Subset.antisymm + · intro z hzfront + have hzX : z ∈ X := hcompact.isClosed.frontier_subset hzfront + rw [t.source_cover] at hzX + obtain ⟨k, hzk⟩ := Set.mem_iUnion.mp hzX + have hnonneg := (bhull k z).mp hzk + have hnotpos : ¬ ∀ j, 0 < b k z j := by + intro hpos + have hopen : IsOpen {y : Real × Real | ∀ j, 0 < b k y j} := by + have heq : {y : Real × Real | ∀ j, 0 < b k y j} = + ⋂ j, {y : Real × Real | 0 < b k y j} := by ext; simp + rw [heq] + exact isOpen_iInter_of_finite fun j => isOpen_lt continuous_const (bcontinuous k j) + have hsub : {y : Real × Real | ∀ j, 0 < b k y j} ⊆ X := by + intro y hy + rw [t.source_cover] + exact Set.mem_iUnion.mpr ⟨k, (bhull k y).mpr (fun j => (hy j).le)⟩ + exact hzfront.2 ((hopen.subset_interior_iff.mpr hsub) hpos) + obtain ⟨c, hc⟩ := not_forall.mp hnotpos + have hzc : b k z c = 0 := le_antisymm (le_of_not_gt hc) (hnonneg c) + obtain ⟨a, d, had, hac, hdc⟩ := third c + have hsum : b k z a + b k z d = 1 := by + have h := bsum k z + rw [sum_three _ a d c had hac hdc, hzc, add_zero] at h + exact h + have hzrepr : b k z a • p.vertex (t.face k a) + + b k z d • p.vertex (t.face k d) = z := by + have h := breconstruct k z + rw [sum_three _ a d c had hac hdc, hzc, zero_smul, add_zero] at h + exact h + have hzseg : z ∈ segment Real (p.vertex (t.face k a)) (p.vertex (t.face k d)) := + ⟨b k z a, b k z d, hnonneg a, hnonneg d, hsum, hzrepr⟩ + by_cases hza : z = p.vertex (t.face k a) + · exact Set.mem_iUnion.mpr ⟨t.face k a, hza ▸ left_mem_segment Real _ _⟩ + by_cases hzd : z = p.vertex (t.face k d) + · exact Set.mem_iUnion.mpr ⟨t.face k d, hzd ▸ left_mem_segment Real _ _⟩ + have hzopen := mem_openSegment_of_ne_left_right (Ne.symm hza) (Ne.symm hzd) hzseg + have hij : t.face k a ≠ t.face k d := fun h => had (t.face_injective k h) + have hused : ∃ l, t.face k a ∈ Set.range (t.face l) ∧ + t.face k d ∈ Set.range (t.face l) := ⟨k, ⟨a, rfl⟩, ⟨d, rfl⟩⟩ + have hneighbor : t.face k d = t.face k a + 1 ∨ t.face k a = t.face k d + 1 := by + by_contra h + exact hzfront.2 ((edge_interior _ _ hij hused z hzopen).mpr h) + rcases hneighbor with h | h + · exact Set.mem_iUnion.mpr ⟨t.face k a, h ▸ hzseg⟩ + · refine Set.mem_iUnion.mpr ⟨t.face k d, ?_⟩ + rw [← h, segment_symm] + exact hzseg + · exact Set.iUnion_subset polygon_frontier + +private theorem affine_chart : + ∀ (q : Fin (3 : ℕ) → ℝ × ℝ), P3381T1TriangleDeterminant q ≠ (0 : ℝ) → + ∃ (h : ℝ × ℝ ≃ₜ ℝ × ℝ), + (h : ℝ × ℝ → ℝ × ℝ) (0 : ℝ × ℝ) = q (0 : Fin (3 : ℕ)) ∧ + (h : ℝ × ℝ → ℝ × ℝ) ((1 : ℝ), (0 : ℝ)) = q (1 : Fin (3 : ℕ)) ∧ + (h : ℝ × ℝ → ℝ × ℝ) ((0 : ℝ), (1 : ℝ)) = q (2 : Fin (3 : ℕ)) ∧ + (∀ (z : ℝ × ℝ), (h : ℝ × ℝ → ℝ × ℝ) z = + q (0 : Fin (3 : ℕ)) + z.1 • (q (1 : Fin (3 : ℕ)) - q (0 : Fin (3 : ℕ))) + + z.2 • (q (2 : Fin (3 : ℕ)) - q (0 : Fin (3 : ℕ)))) ∧ + ∀ (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), ∀ (a : ℝ), ∀ (b : ℝ), a + b = (1 : ℝ) → + (h : ℝ × ℝ → ℝ × ℝ) (a • x + b • y) = a • (h : ℝ × ℝ → ℝ × ℝ) x + b • (h : ℝ × + ℝ → ℝ × ℝ) y := by + classical + intro q hq + let standard : Fin 3 → Real × Real := ![(0, 0), (1, 0), (0, 1)] + have hstandard : P3381T1TriangleDeterminant standard ≠ 0 := by + change ((1 : Real) - 0) * (1 - 0) - (0 - 0) * (0 - 0) ≠ 0 + norm_num + obtain ⟨h, hh⟩ := P3381T1AffineTriangleMap standard q hstandard hq + have hplace z : h z = q 0 + z.1 • (q 1 - q 0) + z.2 • (q 2 - q 0) := by + let w : Fin 3 → Real := ![1 - z.1 - z.2, z.1, z.2] + have hsum : (∑ j, w j) = 1 := by + rw [Fin.sum_univ_three] + change (1 - z.1 - z.2) + z.1 + z.2 = 1 + ring + have hwz : (∑ j, w j • standard j) = z := by + apply Prod.ext <;> simp [Fin.sum_univ_three, standard, w] + rw [← hwz, hh w hsum, hwz] + apply Prod.ext <;> simp [Fin.sum_univ_three, w] <;> ring + refine ⟨h, ?_, ?_, ?_, hplace, ?_⟩ + · simp [hplace] + · simp [hplace] + · simp [hplace] + · intro x y a b hab + have hb : b = 1 - a := by linarith + rw [hplace, hplace, hplace, hb] + apply Prod.ext <;> simp <;> ring + +private theorem polygon_chart : + (∀ (q : Fin 3 → Real × Real), (P3381T1TriangleDeterminant q ≠ 0) → (∃ h : (Real × Real) ≃ₜ + (Real × Real), h 0 = q 0 ∧ h (1, 0) = q 1 ∧ h (0, 1) = q 2 ∧ (∀ z : Real × Real, h z = q + 0 + z.1 • (q 1 - q 0) + z.2 • (q 2 - q 0)) ∧ (∀ (x : Real × Real), ∀ (y : Real × Real), ∀ + (a : Real), ∀ (b : Real), a + b = 1 → h (a • x + b • y) = a • h x + b • h y))) → (∀ + {n : ℕ}, ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + (3 : ℕ))), ∃ (h : ℝ × ℝ + ≃ₜ ℝ + × ℝ), + (h : ℝ × ℝ → ℝ × ℝ) (0 : ℝ × ℝ) = p.vertex i ∧ + (h : ℝ × ℝ → ℝ × ℝ) ((1 : ℝ), (0 : ℝ)) = p.vertex (i + (1 : Fin (n + (3 : ℕ)))) ∧ + (∀ (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), ∀ (a : ℝ), ∀ (b : ℝ), a + b = (1 : ℝ) → + (h : ℝ × ℝ → ℝ × ℝ) (a • x + b • y) = a • (h : ℝ × ℝ → ℝ × ℝ) x + b • (h : ℝ × ℝ → + ℝ × ℝ) y) ∧ + ((h : ℝ × ℝ → ℝ × ℝ) ((0 : ℝ), (1 : ℝ)) = p.vertex (i - (1 : Fin (n + (3 : ℕ)))) ∨ + ∃ c < (0 : ℝ), (h : ℝ × ℝ → ℝ × ℝ) (c, (0 : ℝ)) = p.vertex (i - (1 : Fin (n + (3 : + ℕ)))))) := by + classical + intro affine_chart n p i + classical + have hnext : i ≠ i + 1 := by + intro hi + have hzero : (0 : Fin (n + 3)) = 1 := + add_left_cancel (show i + 0 = i + 1 by simpa only [add_zero] using hi) + exact Fin.zero_ne_one hzero + have hprev : (i - 1 : Fin (n + 3)) ≠ i := by + intro hi + have h : i = i + 1 := by + simpa only [sub_add_cancel] using congrArg (fun j : Fin (n + 3) => j + 1) hi + exact hnext h + have hvnext : p.vertex (i + 1) ≠ p.vertex i := fun h => hnext (p.injective h).symm + have hvprev : p.vertex (i - 1) ≠ p.vertex i := fun h => hprev (p.injective h) + let q : Fin 3 → Real × Real := ![p.vertex i, p.vertex (i + 1), p.vertex (i - 1)] + by_cases hq : P3381T1TriangleDeterminant q ≠ 0 + · obtain ⟨h, h0, h1, h2, hplace, haffine⟩ := affine_chart q hq + exact ⟨h, h0, h1, haffine, Or.inl h2⟩ + · have hdet : P3381T1TriangleDeterminant q = 0 := not_ne_iff.mp hq + let a : Real × Real := p.vertex (i + 1) - p.vertex i + have ha : a ≠ 0 := sub_ne_zero.mpr hvnext + let v : Real × Real := p.vertex i + (-a.2, a.1) + let q' : Fin 3 → Real × Real := ![p.vertex i, p.vertex (i + 1), v] + have hdet' : P3381T1TriangleDeterminant q' = a.1 ^ 2 + a.2 ^ 2 := by + simp [P3381T1TriangleDeterminant, q', v, a] + ring + have hq' : P3381T1TriangleDeterminant q' ≠ 0 := by + rw [hdet'] + intro h + have ha1 : a.1 = 0 := by nlinarith [sq_nonneg a.1, sq_nonneg a.2] + have ha2 : a.2 = 0 := by nlinarith [sq_nonneg a.1, sq_nonneg a.2] + exact ha (Prod.ext ha1 ha2) + obtain ⟨h, h0, h1, h2, hplace, haffine⟩ := affine_chart q' hq' + change h 0 = p.vertex i at h0 + change h (1, 0) = p.vertex (i + 1) at h1 + let x : Real × Real := h.symm (p.vertex (i - 1)) + have hx : p.vertex (i - 1) = p.vertex i + x.1 • a + x.2 • (-a.2, a.1) := by + have hp := hplace x + rw [h.apply_symm_apply] at hp + simpa [q', v, a] using hp + have hx2 : x.2 = 0 := by + have hx1' := congrArg Prod.fst hx + have hx2' := congrArg Prod.snd hx + simp only [Prod.fst_add, Prod.snd_add, Prod.smul_fst, Prod.smul_snd, + smul_eq_mul] at hx1' hx2' + have hcross : x.2 * (a.1 ^ 2 + a.2 ^ 2) = 0 := by + have hd : a.1 * ((p.vertex (i - 1)).2 - (p.vertex i).2) - + ((p.vertex (i - 1)).1 - (p.vertex i).1) * a.2 = 0 := by + simpa [P3381T1TriangleDeterminant, q, a] using hdet + linear_combination hd - a.1 * hx2' + a.2 * hx1' + exact (mul_eq_zero.mp hcross).resolve_right (hdet' ▸ hq') + have hxc : h (x.1, 0) = p.vertex (i - 1) := by + have heq : (x.1, 0) = x := Prod.ext rfl hx2.symm + rw [heq] + exact h.apply_symm_apply _ + have hcx : x.1 ≠ 0 := by + intro hc + apply hvprev + rw [← hxc, hc] + exact h0 + have hcnegative : x.1 < 0 := by + by_contra hnot + have hcpos : 0 < x.1 := lt_of_le_of_ne (le_of_not_gt hnot) (Ne.symm hcx) + let s : Real := min x.1 1 / 2 + have hspos : 0 < s := by dsimp [s]; exact div_pos (lt_min hcpos zero_lt_one) (by norm_num) + have hs1 : s < 1 := by dsimp [s]; linarith [min_le_right x.1 (1 : Real)] + have hsc : s < x.1 := by dsimp [s]; linarith [min_le_left x.1 (1 : Real)] + have hratio : 0 ≤ s / x.1 ∧ s / x.1 ≤ 1 := + ⟨(div_pos hspos hcpos).le, (div_le_one hcpos).mpr hsc.le⟩ + have next_segment : h (s, 0) ∈ segment Real (p.vertex i) (p.vertex (i + 1)) := by + rw [segment_eq_image] + refine ⟨s, ⟨hspos.le, hs1.le⟩, ?_⟩ + change (1 - s) • p.vertex i + s • p.vertex (i + 1) = h (s, 0) + rw [← h0, ← h1, ← haffine 0 (1, 0) (1 - s) s (by ring)] + congr 1 + apply Prod.ext <;> simp + have prev_segment : h (s, 0) ∈ segment Real (p.vertex (i - 1)) (p.vertex ((i - 1) + 1)) := by + rw [sub_add_cancel, segment_symm, segment_eq_image] + refine ⟨s / x.1, hratio, ?_⟩ + change (1 - s / x.1) • p.vertex i + (s / x.1) • p.vertex (i - 1) = h (s, 0) + rw [← h0, ← hxc, ← haffine 0 (x.1, 0) (1 - s / x.1) (s / x.1) (by ring)] + congr 1 + apply Prod.ext <;> simp [div_mul_cancel₀ s hcx] + have hmeet := p.edge_intersection i (i - 1) (Ne.symm hprev) + have hmem : h (s, 0) ∈ segment Real (p.vertex i) (p.vertex (i + 1)) ∩ + segment Real (p.vertex (i - 1)) (p.vertex ((i - 1) + 1)) := + ⟨next_segment, prev_segment⟩ + rw [hmeet] at hmem + rcases hmem.1 with hzero | hone + · have heq : (s, (0 : Real)) = 0 := h.injective (hzero.trans h0.symm) + have heq1 := congrArg Prod.fst heq + change s = 0 at heq1 + linarith + · have heq : (s, (0 : Real)) = (1, 0) := h.injective (hone.trans h1.symm) + have heq1 := congrArg Prod.fst heq + change s = 1 at heq1 + linarith + exact ⟨h, h0, h1, haffine, Or.inr ⟨x.1, hcnegative, hxc⟩⟩ + +private theorem local_boundary_chart : + (∀ {n : Nat}, ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∃ h : (Real × Real) ≃ₜ + (Real × Real), h 0 = p.vertex i ∧ h (1, 0) = p.vertex (i + 1) ∧ (∀ (x : Real × Real), ∀ + (y : Real × Real), ∀ (a : Real), ∀ (b : Real), a + b = 1 → h (a • x + b • y) = a • h x + + b • h y) ∧ (h (0, 1) = p.vertex (i - 1) ∨ ∃ c : Real, c < 0 ∧ h (c, 0) = p.vertex (i - + 1))) → (∀ {n : ℕ}, ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (ℝ × ℝ)), frontier X = + ⋃ (i : Fin (n + (3 : ℕ))), segment ℝ (p.vertex i) (p.vertex (i + (1 : Fin (n + (3 : ℕ))))) → + ∀ (i : Fin (n + (3 : ℕ))), ∀ (eps : ℝ), (0 : ℝ) < eps → + ∃ (r : ℝ) (h : ℝ × ℝ ≃ₜ ℝ × ℝ) (straight : Bool), + (0 : ℝ) < r ∧ + r ≤ eps ∧ + (h : ℝ × ℝ → ℝ × ℝ) (0 : ℝ × ℝ) = p.vertex i ∧ + (∀ (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), ∀ (a : ℝ), ∀ (b : ℝ), a + b = (1 : ℝ) → + (h : ℝ × ℝ → ℝ × ℝ) (a • x + b • y) = a • (h : ℝ × ℝ → ℝ × ℝ) x + b • (h : + ℝ × ℝ → ℝ × ℝ) y) ∧ + ∀ z ∈ Metric.ball (p.vertex i) r, + z ∈ frontier X ↔ + z ∈ + (⇑h : ℝ × ℝ → ℝ × ℝ) '' + if straight = true then {x : ℝ × ℝ | x.2 = (0 : ℝ)} + else {x : ℝ × ℝ | (0 : ℝ) ≤ x.1 ∧ x.2 = (0 : ℝ) ∨ x.1 = (0 : ℝ) ∧ (0 : + ℝ) ≤ x.2}) := by + classical + intro polygon_chart n p X hb i eps heps + classical + obtain ⟨h, h0, h1, haffine, hprev⟩ := polygon_chart p i + let F j := segment Real (p.vertex j) (p.vertex (j + 1)) + let N : Set (Real × Real) := ⋂ j, + if j = i ∨ j + 1 = i then Set.univ else (F j)ᶜ + have closed_F j : IsClosed (F j) := by + dsimp [F] + rw [← convexHull_pair] + exact (((Set.finite_singleton (p.vertex (j + 1))).insert (p.vertex j)).isCompact_convexHull + Real).isClosed + have open_N : IsOpen N := by + apply isOpen_iInter_of_finite + intro j + split_ifs + · exact isOpen_univ + · exact (closed_F j).isOpen_compl + have mem_N : p.vertex i ∈ N := by + apply Set.mem_iInter.mpr + intro j + split_ifs with hj + · trivial + · intro hvj + have hji : j ≠ i := fun heq => hj (Or.inl heq) + have hmeet := p.edge_intersection j i hji + have hvmeet : p.vertex i ∈ F j ∩ F i := + ⟨hvj, left_mem_segment Real _ _⟩ + rw [hmeet] at hvmeet + rcases hvmeet.1 with hv | hv + · exact hj (Or.inl (p.injective hv).symm) + · exact hj (Or.inr (p.injective hv).symm) + have boundary_local z (hz : z ∈ N) : + z ∈ frontier X ↔ z ∈ segment Real (p.vertex i) (p.vertex (i + 1)) ∨ + z ∈ segment Real (p.vertex i) (p.vertex (i - 1)) := by + constructor + · intro hzb + rw [hb] at hzb + obtain ⟨j, hzj⟩ := Set.mem_iUnion.mp hzb + by_cases hj : j = i ∨ j + 1 = i + · rcases hj with rfl | hj + · exact Or.inl hzj + · have hj' : j = i - 1 := (eq_sub_iff_add_eq).mpr hj + right + subst j + simpa only [sub_add_cancel, segment_symm] using hzj + · have hnot := Set.mem_iInter.mp hz j + simp only [hj, ite_false] at hnot + exact (hnot hzj).elim + · rintro (hz | hz) + · rw [hb] + exact Set.mem_iUnion.mpr ⟨i, hz⟩ + · rw [hb] + refine Set.mem_iUnion.mpr ⟨i - 1, ?_⟩ + simpa only [sub_add_cancel, segment_symm] using hz + have image_segment (x y : Real × Real) : + h '' segment Real x y = segment Real (h x) (h y) := by + calc + h '' segment Real x y = + (fun u : Real => h ((1 - u) • x + u • y)) '' Set.Icc 0 1 := by + rw [segment_eq_image, Set.image_image] + _ = (fun u : Real => (1 - u) • h x + u • h y) '' Set.Icc 0 1 := by + congr 1 + funext u + exact haffine x y (1 - u) u (by ring) + _ = segment Real (h x) (h y) := (segment_eq_image Real _ _).symm + have axis1 (x : Real × Real) : x ∈ segment Real 0 (1, 0) ↔ + 0 ≤ x.1 ∧ x.1 ≤ 1 ∧ x.2 = 0 := by + rw [segment_eq_image] + constructor + · rintro ⟨u, hu, rfl⟩ + simpa using And.intro hu.1 (And.intro hu.2 (rfl : (0 : Real) = 0)) + · rintro ⟨hx0, hx1, hx2⟩ + refine ⟨x.1, ⟨hx0, hx1⟩, ?_⟩ + apply Prod.ext <;> simp [hx2] + have radius (O : Set (Real × Real)) (hO : IsOpen O) (hv : p.vertex i ∈ O) : + ∃ r : Real, 0 < r ∧ r ≤ eps ∧ Metric.ball (p.vertex i) r ⊆ O := by + obtain ⟨rho, hrho, hball⟩ := Metric.isOpen_iff.mp hO _ hv + refine ⟨min rho eps, lt_min hrho heps, min_le_right _ _, ?_⟩ + intro z hz + exact hball (Metric.mem_ball.mpr (lt_of_lt_of_le (Metric.mem_ball.mp hz) (min_le_left _ _))) + rcases hprev with h2 | ⟨c, hc, h2⟩ + · let O : Set (Real × Real) := N ∩ + {z | (h.symm z).1 < 1 ∧ (h.symm z).2 < 1} + have hO : IsOpen O := open_N.inter + ((isOpen_lt (continuous_fst.comp h.symm.continuous) continuous_const).inter + (isOpen_lt (continuous_snd.comp h.symm.continuous) continuous_const)) + have hvO : p.vertex i ∈ O := by + refine ⟨mem_N, ?_⟩ + change (h.symm (p.vertex i)).1 < 1 ∧ (h.symm (p.vertex i)).2 < 1 + rw [← h0, h.symm_apply_apply] + norm_num + obtain ⟨r, hr, hreps, hball⟩ := radius O hO hvO + refine ⟨r, h, false, hr, hreps, h0, haffine, ?_⟩ + intro z hz + have hzO := hball hz + let x : Real × Real := h.symm z + have hzx : z = h x := (h.apply_symm_apply z).symm + have hx1 : x.1 < 1 := hzO.2.1 + have hx2 : x.2 < 1 := hzO.2.2 + have axis2 : x ∈ segment Real 0 (0, 1) ↔ + 0 ≤ x.2 ∧ x.2 ≤ 1 ∧ x.1 = 0 := by + rw [segment_eq_image] + constructor + · rintro ⟨u, hu, heq⟩ + rw [← heq] + simpa using And.intro hu.1 (And.intro hu.2 (rfl : (0 : Real) = 0)) + · rintro ⟨hx0, hx1, hx2⟩ + refine ⟨x.2, ⟨hx0, hx1⟩, ?_⟩ + apply Prod.ext <;> simp [hx2] + rw [boundary_local z hzO.1, hzx, ← h0, ← h1, ← h2, + ← image_segment, ← image_segment] + simp only [Bool.false_eq_true, ite_false, h.injective.mem_set_image, + Set.mem_ofPred_eq, axis1, axis2] + constructor + · rintro (⟨hxa, hxb, hxc⟩ | ⟨hxa, hxb, hxc⟩) + · exact Or.inl ⟨hxa, hxc⟩ + · exact Or.inr ⟨hxc, hxa⟩ + · rintro (⟨hxa, hxb⟩ | ⟨hxa, hxb⟩) + · exact Or.inl ⟨hxa, hx1.le, hxb⟩ + · exact Or.inr ⟨hxb, hx2.le, hxa⟩ + · let O : Set (Real × Real) := N ∩ {z | c < (h.symm z).1 ∧ (h.symm z).1 < 1} + have hO : IsOpen O := open_N.inter + ((isOpen_lt continuous_const (continuous_fst.comp h.symm.continuous)).inter + (isOpen_lt (continuous_fst.comp h.symm.continuous) continuous_const)) + have hvO : p.vertex i ∈ O := by + refine ⟨mem_N, ?_⟩ + change c < (h.symm (p.vertex i)).1 ∧ (h.symm (p.vertex i)).1 < 1 + rw [← h0, h.symm_apply_apply] + exact ⟨hc, by norm_num⟩ + obtain ⟨r, hr, hreps, hball⟩ := radius O hO hvO + refine ⟨r, h, true, hr, hreps, h0, haffine, ?_⟩ + intro z hz + have hzO := hball hz + let x : Real × Real := h.symm z + have hzx : z = h x := (h.apply_symm_apply z).symm + have hcx : c < x.1 := hzO.2.1 + have hx1 : x.1 < 1 := hzO.2.2 + have axisc : x ∈ segment Real 0 (c, 0) ↔ c ≤ x.1 ∧ x.1 ≤ 0 ∧ x.2 = 0 := by + rw [segment_eq_image] + constructor + · rintro ⟨u, hu, heq⟩ + rw [← heq] + simp only [smul_zero, zero_add, Prod.smul_fst, Prod.smul_snd, smul_eq_mul, mul_zero] + exact ⟨by nlinarith [hu.2], mul_nonpos_of_nonneg_of_nonpos hu.1 hc.le, trivial⟩ + · rintro ⟨hcx, hx0, hx2⟩ + refine ⟨x.1 / c, ⟨div_nonneg_of_nonpos hx0 hc.le, + (div_le_one_of_neg hc).mpr hcx⟩, ?_⟩ + apply Prod.ext <;> simp [hx2, div_mul_cancel₀ _ hc.ne] + rw [boundary_local z hzO.1, hzx, ← h0, ← h1, ← h2, + ← image_segment, ← image_segment] + simp only [ite_true, h.injective.mem_set_image, Set.mem_ofPred_eq, axis1, axisc] + constructor + · rintro (⟨hxa, hxb, hxc⟩ | ⟨hxa, hxb, hxc⟩) <;> exact hxc + · intro hxzero + by_cases hx0 : 0 ≤ x.1 + · exact Or.inl ⟨hx0, hx1.le, hxzero⟩ + · exact Or.inr ⟨hcx.le, (lt_of_not_ge hx0).le, hxzero⟩ + +private theorem split_sets : + ∀ {A : Set (ℝ × ℝ)}, ∀ {B : Set (ℝ × ℝ)}, ∀ {S : Set (ℝ × ℝ)}, ∀ {T : Set (ℝ × ℝ)}, IsOpen A → + IsOpen B → + Disjoint A B → + IsPathConnected S → + IsPathConnected T → S ∪ T = A ∪ B → A.Nonempty → B.Nonempty → IsPathConnected A ∧ + IsPathConnected B := by + classical + intro A B S T hA hB hAB hS hT hcover hneA hneB + have hscover : S ⊆ A ∪ B := by rw [← hcover]; exact Set.subset_union_left + have htcover : T ⊆ A ∪ B := by rw [← hcover]; exact Set.subset_union_right + have hs := hS.isConnected.isPreconnected.subset_or_subset hA hB hAB hscover + have ht := hT.isConnected.isPreconnected.subset_or_subset hA hB hAB htcover + have eqs (hSA : S ⊆ A) (hTB : T ⊆ B) : S = A ∧ T = B := by + constructor + · apply Set.Subset.antisymm hSA + intro x hx + have hx' : x ∈ S ∪ T := by rw [hcover]; exact Or.inl hx + rcases hx' with hxS | hxT + · exact hxS + · exact (Set.disjoint_left.mp hAB hx (hTB hxT)).elim + · apply Set.Subset.antisymm hTB + intro x hx + have hx' : x ∈ S ∪ T := by rw [hcover]; exact Or.inr hx + rcases hx' with hxS | hxT + · exact (Set.disjoint_left.mp hAB (hSA hxS) hx).elim + · exact hxT + rcases hs with hs | hs <;> rcases ht with ht | ht + · obtain ⟨x, hx⟩ := hneB + have hx' : x ∈ S ∪ T := by rw [hcover]; exact Or.inr hx + rcases hx' with hxS | hxT + · exact (Set.disjoint_left.mp hAB (hs hxS) hx).elim + · exact (Set.disjoint_left.mp hAB (ht hxT) hx).elim + · obtain ⟨rfl, rfl⟩ := eqs hs ht + exact ⟨hS, hT⟩ + · have hSA : T ⊆ A := ht + have hTB : S ⊆ B := hs + have hcover' : T ∪ S = A ∪ B := by rw [Set.union_comm]; exact hcover + have eqA : T = A := by + apply Set.Subset.antisymm hSA + intro x hx + have hx' : x ∈ T ∪ S := by rw [hcover']; exact Or.inl hx + rcases hx' with hxT | hxS + · exact hxT + · exact (Set.disjoint_left.mp hAB hx (hTB hxS)).elim + have eqB : S = B := by + apply Set.Subset.antisymm hTB + intro x hx + have hx' : x ∈ T ∪ S := by rw [hcover']; exact Or.inr hx + rcases hx' with hxT | hxS + · exact (Set.disjoint_left.mp hAB (hSA hxT) hx).elim + · exact hxS + exact ⟨eqA ▸ hT, eqB ▸ hS⟩ + · obtain ⟨x, hx⟩ := hneA + have hx' : x ∈ S ∪ T := by rw [hcover]; exact Or.inl hx + rcases hx' with hxS | hxT + · exact (Set.disjoint_left.mp hAB hx (hs hxS)).elim + · exact (Set.disjoint_left.mp hAB hx (ht hxT)).elim + +private theorem affine_sectors : + ∀ (h : (Real × Real) ≃ₜ (Real × Real)), (∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (a : + Real), ∀ (b : Real), a + b = 1 → + h (a • x + b • y) = a • h x + b • h y) → (∀ (r : Real), (0 < r) → (∀ (straight : Bool), + let R : Set (Real × Real) := if straight then {x | x.2 = 0} + else {x | (0 ≤ x.1 ∧ x.2 = 0) ∨ (x.1 = 0 ∧ 0 ≤ x.2)} + ∃ S T : Set (Real × Real), IsPathConnected S ∧ IsPathConnected T ∧ + Disjoint S T ∧ S ∪ T = Metric.ball (h 0) r \ h '' R)) := by + classical + intro h haffine r hr straight + classical + intro R + let C : Set (Real × Real) := h ⁻¹' Metric.ball (h 0) r + have hCconvex : Convex Real C := by + intro x hx y hy a b ha hb hab + change h (a • x + b • y) ∈ Metric.ball (h 0) r + rw [haffine x y a b hab] + exact (convex_ball (h 0) r) hx hy ha hb hab + have hCopen : IsOpen C := Metric.isOpen_ball.preimage h.continuous + have hCzero : (0 : Real × Real) ∈ C := by + change h 0 ∈ Metric.ball (h 0) r + exact Metric.mem_ball_self hr + obtain ⟨d, hd, hdC⟩ := Metric.isOpen_iff.mp hCopen 0 hCzero + have hpC : (d / 2, d / 2) ∈ C := by + apply hdC + simp only [Metric.mem_ball, Prod.dist_eq, Prod.fst_zero, Prod.snd_zero, + Real.dist_eq, sub_zero, max_self] + rw [abs_of_pos (by linarith : 0 < d / 2)] + linarith + have hnC : (-d / 2, -d / 2) ∈ C := by + apply hdC + simp only [Metric.mem_ball, Prod.dist_eq, Prod.fst_zero, Prod.snd_zero, + Real.dist_eq, sub_zero, max_self] + rw [abs_of_neg (by linarith : -d / 2 < 0)] + linarith + let Q : Set (Real × Real) := if straight then Set.univ ×ˢ Set.Ioi (0 : Real) + else Set.Ioi (0 : Real) ×ˢ Set.Ioi (0 : Real) + let E : Set (Real × Real) := if straight then Set.univ ×ˢ Set.Iio (0 : Real) + else (Set.Iio (0 : Real) ×ˢ Set.univ) ∪ (Set.univ ×ˢ Set.Iio (0 : Real)) + have hCQ : IsPathConnected (C ∩ Q) := by + apply Convex.isPathConnected + · apply hCconvex.inter + cases straight + · exact (convex_Ioi (0 : Real)).prod (convex_Ioi (0 : Real)) + · exact convex_univ.prod (convex_Ioi (0 : Real)) + · refine ⟨(d / 2, d / 2), hpC, ?_⟩ + cases straight <;> simp [Q, show 0 < d / 2 by linarith] + have hCE : IsPathConnected (C ∩ E) := by + cases straight + · have h1 : IsPathConnected (C ∩ (Set.Iio (0 : Real) ×ˢ Set.univ)) := by + apply (hCconvex.inter ((convex_Iio (0 : Real)).prod convex_univ)).isPathConnected + exact ⟨(-d / 2, -d / 2), hnC, by simp; linarith⟩ + have h2 : IsPathConnected (C ∩ (Set.univ ×ˢ Set.Iio (0 : Real))) := by + apply (hCconvex.inter (convex_univ.prod (convex_Iio (0 : Real)))).isPathConnected + exact ⟨(-d / 2, -d / 2), hnC, by simp; linarith⟩ + have heq : C ∩ E = (C ∩ (Set.Iio (0 : Real) ×ˢ Set.univ)) ∪ + (C ∩ (Set.univ ×ˢ Set.Iio (0 : Real))) := by + dsimp [E] + exact Set.inter_union_distrib_left _ _ _ + rw [heq] + exact h1.union h2 ⟨(-d / 2, -d / 2), ⟨hnC, by simp; linarith⟩, + ⟨hnC, by simp; linarith⟩⟩ + · apply (hCconvex.inter (convex_univ.prod (convex_Iio (0 : Real)))).isPathConnected + exact ⟨(-d / 2, -d / 2), hnC, by simp []; linarith⟩ + have hcomplement x : x ∉ R ↔ x ∈ Q ∨ x ∈ E := by + cases straight <;> + simp only [R, Q, E, Bool.false_eq_true, ite_false, ite_true, Set.mem_ofPred_eq, + Set.mem_prod, Set.mem_univ, Set.mem_Iio, Set.mem_Ioi, Set.mem_union, + true_and, and_true] + · change ¬ ((0 ≤ x.1 ∧ x.2 = 0) ∨ (x.1 = 0 ∧ 0 ≤ x.2)) ↔ + (0 < x.1 ∧ 0 < x.2) ∨ (x.1 < 0 ∨ x.2 < 0) + constructor + · intro hx + by_cases h1 : x.1 < 0 + · exact Or.inr (Or.inl h1) + by_cases h2 : x.2 < 0 + · exact Or.inr (Or.inr h2) + left + constructor + · have hne : x.1 ≠ 0 := by intro h; exact hx (Or.inr ⟨h, le_of_not_gt h2⟩) + exact lt_of_le_of_ne (le_of_not_gt h1) (Ne.symm hne) + · have hne : x.2 ≠ 0 := by intro h; exact hx (Or.inl ⟨le_of_not_gt h1, h⟩) + exact lt_of_le_of_ne (le_of_not_gt h2) (Ne.symm hne) + · intro hx hR + rcases hx with hx | hx + · rcases hR with hR | hR <;> linarith + · rcases hx with hx | hx <;> rcases hR with hR | hR <;> linarith + · change x.2 ≠ 0 ↔ 0 < x.2 ∨ x.2 < 0 + exact ne_iff_lt_or_gt.trans or_comm + have hQE : Disjoint Q E := by + apply Set.disjoint_left.mpr + intro x hxQ hxE + cases straight <;> + simp only [Q, E, Bool.false_eq_true, ite_false, ite_true, Set.mem_prod, + Set.mem_univ, Set.mem_Iio, Set.mem_Ioi, Set.mem_union, true_and, and_true] at hxQ hxE + · change 0 < x.1 ∧ 0 < x.2 at hxQ + change x.1 < 0 ∨ x.2 < 0 at hxE + rcases hxE with hxE | hxE <;> linarith [hxQ.1, hxQ.2] + · change 0 < x.2 at hxQ + change x.2 < 0 at hxE + linarith + refine ⟨h '' (C ∩ Q), h '' (C ∩ E), hCQ.image h.continuous, + hCE.image h.continuous, ?_, ?_⟩ + · apply Set.disjoint_left.mpr + rintro y ⟨x, hx, rfl⟩ ⟨z, hz, hzx⟩ + have hzx' : z = x := h.injective hzx + subst z + exact Set.disjoint_left.mp hQE hx.2 hz.2 + · ext y + constructor + · rintro (⟨x, hx, rfl⟩ | ⟨x, hx, rfl⟩) + all_goals refine ⟨hx.1, ?_⟩ + all_goals rintro ⟨z, hz, heq⟩ + all_goals have hzx : z = x := h.injective heq + all_goals subst z + · exact (hcomplement x).mpr (Or.inl hx.2) hz + · exact (hcomplement x).mpr (Or.inr hx.2) hz + · rintro ⟨hyB, hyR⟩ + have hxC : h.symm y ∈ C := by + change h (h.symm y) ∈ Metric.ball (h 0) r + simpa using hyB + have hxR : h.symm y ∉ R := by + intro hx + exact hyR ⟨h.symm y, hx, h.apply_symm_apply y⟩ + rcases (hcomplement _).mp hxR with hxQ | hxE + · exact Or.inl ⟨h.symm y, ⟨hxC, hxQ⟩, h.apply_symm_apply y⟩ + · exact Or.inr ⟨h.symm y, ⟨hxC, hxE⟩, h.apply_symm_apply y⟩ + +private theorem vertex_in_closure : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3381T1PairedTriangulation p X K), (∃ (b : Fin t.count → ℝ × ℝ → Fin + (3 : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), ∑ j : Fin (3 : ℕ), b k z j = (1 : ℝ)) + ∧ (∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), ∑ j : Fin (3 : ℕ), b k z j • p.vertex (t.face k j) + = z) ∧ (∀ (k : Fin t.count), ∀ (w : Fin (3 : ℕ) → ℝ), ∑ j : Fin (3 : ℕ), w j = (1 : ℝ) → + b k (∑ j : Fin (3 : ℕ), w j • p.vertex (t.face k j)) = w) ∧ (∀ (k : Fin t.count), ∀ (j : + Fin (3 : ℕ)), Continuous fun (z : ℝ × ℝ) => b k z j) ∧ (∀ (k : Fin t.count), ∀ (z : ℝ × + ℝ), z ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (Set.range (p.vertex ∘ t.face k)) ↔ ∀ + (j : Fin (3 : ℕ)), (0 : ℝ) ≤ b k z j) ∧ (∀ (k : Fin t.count), ∀ (i : Fin (3 : ℕ)), b k + (p.vertex (t.face k i)) = Pi.single i (1 : ℝ)) ∧ ∀ (k : Fin t.count), ∀ (l : Fin + t.count), ∀ z ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (p.vertex '' (Set.range + (t.face k) ∩ Set.range (t.face l))), ∀ (j : Fin (3 : ℕ)), t.face k j ∉ Set.range (t.face + l) → b k z j = (0 : ℝ)) → (∀ i, p.vertex i ∈ closure (interior X)) := by + classical + intro n p X K t coordinates + obtain ⟨b, bsum, breconstruct, bunique, bcontinuous, bhull, bvertex, bcommon⟩ := + coordinates + let D k := convexHull Real (Set.range (p.vertex ∘ t.face k)) + have closed_D k : IsClosed (D k) := + ((Set.finite_range (p.vertex ∘ t.face k)).isCompact_convexHull Real).isClosed + have interior_D k : (interior (D k)).Nonempty := by + let w : Fin 3 → Real := fun _ => 1 / 3 + have hw : (∑ j, w j) = 1 := by norm_num [Fin.sum_univ_three, w] + let z := ∑ j, w j • p.vertex (t.face k j) + have hz : ∀ j, 0 < b k z j := by + intro j + change 0 < b k (∑ j, w j • p.vertex (t.face k j)) j + rw [bunique k w hw] + norm_num [w] + have hopen : IsOpen {y : Real × Real | ∀ j, 0 < b k y j} := by + have heq : {y : Real × Real | ∀ j, 0 < b k y j} = + ⋂ j, {y : Real × Real | 0 < b k y j} := by ext; simp + rw [heq] + exact isOpen_iInter_of_finite fun j => isOpen_lt continuous_const (bcontinuous k j) + have hsub : {y : Real × Real | ∀ j, 0 < b k y j} ⊆ D k := by + intro y hy + exact (bhull k y).mpr (fun j => (hy j).le) + exact ⟨z, (hopen.subset_interior_iff.mpr hsub) hz⟩ + have D_subset k : D k ⊆ X := by + intro z hz + rw [t.source_cover] + exact Set.mem_iUnion.mpr ⟨k, hz⟩ + intro i + obtain ⟨k, j, hkj⟩ := t.vertex_used i + have hvD : p.vertex i ∈ D k := by + exact subset_convexHull Real _ ⟨j, congrArg p.vertex hkj⟩ + have hvclosure : p.vertex i ∈ closure (interior (D k)) := by + rw [(convex_convexHull Real _).closure_interior_eq_closure_of_nonempty_interior + (interior_D k), (closed_D k).closure_eq] + exact hvD + exact closure_mono (interior_mono (D_subset k)) hvclosure + +private theorem hcoverUV : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), (IsCompact X) → ( + ∀ (i : Fin (n + (3 : ℕ))), ∀ (r : ℝ), + let U := Metric.ball (p.vertex i) r ∩ interior X + ∀ (h : ℝ × ℝ ≃ₜ ℝ × ℝ), ∀ (straight : Bool), (∀ z ∈ Metric.ball (p.vertex i) r, z ∈ frontier + X ↔ z ∈ (⇑h : ℝ × ℝ → ℝ × ℝ) '' if straight = true then {x : ℝ × ℝ | x.2 = (0 : ℝ)} else + {x : ℝ × ℝ | (0 : ℝ) ≤ x.1 ∧ x.2 = (0 : ℝ) ∨ x.1 = (0 : ℝ) ∧ (0 : ℝ) ≤ x.2}) → ( + let R : Set (Real × Real) := if straight then {x | x.2 = 0} + else {x | (0 ≤ x.1 ∧ x.2 = 0) ∨ (x.1 = 0 ∧ 0 ≤ x.2)} + ∀ (S : Set (ℝ × ℝ)), ∀ (T : Set (ℝ × ℝ)), (S ∪ T = Metric.ball (p.vertex i) r \ (⇑h : ℝ × ℝ → + ℝ × ℝ) '' R) → ( + let V := Metric.ball (p.vertex i) r \ X + S ∪ T = U ∪ V))) := by + classical + intro n p X hcompact i r U h straight hboundary R S T hcover V + rw [hcover] + ext z + constructor + · rintro ⟨hzball, hzR⟩ + have hznot : z ∉ frontier X := by + intro hz + exact hzR ((hboundary z hzball).mp hz) + by_cases hzX : z ∈ X + · exact Or.inl ⟨hzball, (mem_interior_iff_notMem_frontier hzX).mpr hznot⟩ + · exact Or.inr ⟨hzball, hzX⟩ + · rintro (⟨hzball, hzint⟩ | ⟨hzball, hznotX⟩) + · refine ⟨hzball, ?_⟩ + intro hzR + have hzfront := (hboundary z hzball).mpr hzR + exact hzfront.2 hzint + · refine ⟨hzball, ?_⟩ + intro hzR + have hzfront := (hboundary z hzball).mpr hzR + exact hznotX (hcompact.isClosed.frontier_subset hzfront) + +end TriangulationBoundaryProof + +namespace TriangulationInteriorSides + +private theorem hUne : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (i : Fin (n + + (3 : ℕ))), ∀ (r : ℝ), + let U := Metric.ball (p.vertex i) r ∩ interior X + (∀ (i : Fin (n + (3 : ℕ))), p.vertex i ∈ closure (interior X)) → (((0 : ℝ) < r) → + (U.Nonempty)) := by + classical + intro n p X i r U vertex_in_closure hr + exact mem_closure_iff.mp (vertex_in_closure i) + (Metric.ball (p.vertex i) r) Metric.isOpen_ball (Metric.mem_ball_self hr) + +private theorem hVne : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (i : Fin (n + + (3 : ℕ))), ∀ (r : ℝ), ((0 : ℝ) < r) → ( + let V := Metric.ball (p.vertex i) r \ X + (p.vertex i ∈ frontier X) → (V.Nonempty)) := by + classical + intro n p X i r hr V hvfrontier + rw [frontier_eq_closure_inter_closure] at hvfrontier + exact mem_closure_iff.mp hvfrontier.2 (Metric.ball (p.vertex i) r) + Metric.isOpen_ball (Metric.mem_ball_self hr) + +end TriangulationInteriorSides + +namespace TriangulationInteriorChart + +private theorem hinterior : + ∀ (X : Set (Real × Real)), ∀ (A : ℝ × ℝ ≃ₜ ℝ × ℝ), + let U : Set (Real × Real) := + Set.Ioo (0 : Real) (1 / 4) ×ˢ Set.Ioo (0 : Real) (1 / 4) + (have U := Set.Ioo (0 : ℝ) (1 / 4 : ℝ) ×ˢ Set.Ioo (0 : ℝ) (1 / 4 : ℝ); (⇑A : ℝ × ℝ → ℝ × ℝ) + '' U ⊆ X) → ((IsOpen (A '' U)) → ((interior X).Nonempty)) := by + classical + intro X A U hsub hAU + refine ⟨A (1 / 8, 1 / 8), (hAU.subset_interior_iff.mpr hsub) ?_⟩ + exact Set.mem_image_of_mem A (by norm_num [U]) + +end TriangulationInteriorChart + +theorem P3381T1TriangulationBoundary {n : Nat} + (p : P3381T1PolygonBoundary n) (X K : Set (Real × Real)) + (t : P3381T1PairedTriangulation p X K) : + IsCompact X ∧ (interior X).Nonempty ∧ + (frontier X = ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1))) ∧ + ∀ i, ∃ r : Real, 0 < r ∧ + (∀ z ∈ Metric.ball (p.vertex i) r, + z ∈ X ↔ ∃ k, i ∈ Set.range (t.face k) ∧ + ∃ w : Fin 3 → Real, (∀ j, 0 ≤ w j) ∧ + z = p.vertex i + ∑ j, w j • (p.vertex (t.face k j) - p.vertex i)) ∧ + IsPathConnected (Metric.ball (p.vertex i) r ∩ interior X) ∧ + IsPathConnected (Metric.ball (p.vertex i) r \ X) := by +-- BODY + have hcompact : IsCompact X := by + rw [t.source_cover] + exact isCompact_iUnion fun k => + (Set.finite_range (p.vertex ∘ t.face k)).isCompact_convexHull Real + obtain ⟨k, _j, _hkj⟩ := t.vertex_used (0 : Fin (n + 3)) + let standard : Fin 3 → Real × Real := ![(0, 0), (1, 0), (0, 1)] + have hstandard : P3381T1TriangleDeterminant standard ≠ 0 := by + change ((1 : Real) - 0) * (1 - 0) - (0 - 0) * (0 - 0) ≠ 0 + norm_num + obtain ⟨A, hA⟩ := P3381T1AffineTriangleMap standard (p.vertex ∘ t.face k) + hstandard (t.source_nondegenerate k) + let U : Set (Real × Real) := + Set.Ioo (0 : Real) (1 / 4) ×ˢ Set.Ioo (0 : Real) (1 / 4) + have hU : IsOpen U := isOpen_Ioo.prod isOpen_Ioo + have hsub := TriangulationBoundaryProof.hsubAt142 n p X K t k A hA + have hAU : IsOpen (A '' U) := A.isOpenMap U hU + have hinterior : (interior X).Nonempty := TriangulationInteriorChart.hinterior X A hsub hAU + -- Barycentric coordinates record both triangle inequalities and exact face support. + obtain ⟨coordinates, vertex_incidence⟩ := + P5662T1TriangulationBarycentricCoordinates p X K t + -- Avoid nonincident triangles and keep the opposite-face coordinate positive. + have local_cones := TriangulationBoundaryProof.local_cones n p X K t coordinates vertex_incidence + -- The edge ledger selects one triangle or two triangles on opposite sides. + have edge_interior : + ∀ i j, i ≠ j → (∃ k, i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k)) → + ∀ z ∈ openSegment Real (p.vertex i) (p.vertex j), + (z ∈ interior X ↔ ¬ (j = i + 1 ∨ i = j + 1)) := by + classical + obtain ⟨b, bsum, breconstruct, bunique, bcontinuous, bhull, bvertex, bcommon⟩ := + coordinates + let D k := convexHull Real (Set.range (p.vertex ∘ t.face k)) + have closed_D k : IsClosed (D k) := + ((Set.finite_range (p.vertex ∘ t.face k)).isCompact_convexHull Real).isClosed + have third (a b : Fin 3) (hab : a ≠ b) : ∃ c, a ≠ c ∧ b ≠ c := by + fin_cases a <;> fin_cases b + all_goals first | exact (hab rfl).elim | decide + have sum_three {E : Type} [AddCommMonoid E] (f : Fin 3 → E) + (a b c : Fin 3) (hab : a ≠ b) (hac : a ≠ c) (hbc : b ≠ c) : + (∑ j, f j) = f a + f b + f c := by + fin_cases a <;> fin_cases b <;> fin_cases c + all_goals first + | exact (hab rfl).elim + | exact (hac rfl).elim + | exact (hbc rfl).elim + | (rw [Fin.sum_univ_three]; ac_rfl) + have indices (a b c : Fin 3) (hab : a ≠ b) (hac : a ≠ c) (hbc : b ≠ c) j : + j = a ∨ j = b ∨ j = c := by + fin_cases a <;> fin_cases b <;> fin_cases c <;> fin_cases j + all_goals first + | exact (hab rfl).elim + | exact (hac rfl).elim + | exact (hbc rfl).elim + | decide + have bcombo {ι : Type} [Fintype ι] k (a : ι → Real) (f : ι → Real × Real) + (ha : (∑ r, a r) = 1) j := TriangulationBoundaryProof.bcombo n p + X K t b bsum breconstruct bunique (ι := ι) k a f ha j + have blinear k (x y : Real × Real) (a c : Real) (hac : a + c = 1) j : + b k (a • x + c • y) j = a * b k x j + c * b k y j := by + let w : Fin 2 → Real := ![a, c] + let f : Fin 2 → Real × Real := ![x, y] + have hw : (∑ r, w r) = 1 := by simpa [Fin.sum_univ_two, w] using hac + simpa [Fin.sum_univ_two, w, f] using bcombo k w f hw j + have hfaces_subset k l (h : Set.range (t.face k) ⊆ Set.range (t.face l)) : k = l := by + apply t.face_distinct + apply Set.eq_of_subset_of_ncard_le h + rw [Set.ncard_range_of_injective (t.face_injective k), + Set.ncard_range_of_injective (t.face_injective l)] + have hdisjoint k l (hkl : k ≠ l) z + (hz : ∀ j, 0 < b k z j) (hzl : z ∈ D l) := TriangulationBoundaryProof.hdisjoint n + p X K t b bhull bcommon hfaces_subset k l hkl z hz hzl + have perturb (O : Set (Real × Real)) (hO : IsOpen O) z (hz : z ∈ O) v : + ∃ u : Real, 0 < u ∧ u < 1 ∧ (1 - u) • z + u • v ∈ O := by + have hzc : z ∈ closure (openSegment Real z v) := + segment_subset_closure_openSegment (left_mem_segment Real z v) + obtain ⟨y, hyO, hyseg⟩ := mem_closure_iff.mp hzc O hO hz + rw [openSegment_eq_image] at hyseg + obtain ⟨u, hu, rfl⟩ := hyseg + exact ⟨u, hu.1, hu.2, hyO⟩ + intro i j hij hused z hz + rw [openSegment_eq_image] at hz + obtain ⟨u, hu, rfl⟩ := hz + let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex j + let I : Set (Fin t.count) := {k | i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k)} + have edge_coords k (hk : k ∈ I) := TriangulationBoundaryProof.edge_coords n p + X K t b bvertex third blinear i j hij u k hk + have mem_D k (hk : k ∈ I) := TriangulationBoundaryProof.mem_D n p X K t i j u hu k hk + have containing k (hk : z ∈ D k) := TriangulationBoundaryProof.containing n p X K t b + bcommon i j hused u hu edge_coords mem_D k hk + have opposite k l (hkl : k ≠ l) (hk : k ∈ I) (hl : l ∈ I) + a d c e f g (hka : t.face k a = i) (hkd : t.face k d = j) + (had : a ≠ d) (hac : a ≠ c) (hdc : d ≠ c) + (hle : t.face l e = i) (hlf : t.face l f = j) + (hef : e ≠ f) (heg : e ≠ g) (hfg : f ≠ g) + (hza : b k z a = 1 - u) (hzd : b k z d = u) (hzc : b k z c = 0) + (hze : b l z e = 1 - u) (hzf : b l z f = u) (hzg : b l z g = 0) := + TriangulationBoundaryProof.opposite n p X K t b + bcontinuous bhull bvertex indices blinear hdisjoint perturb i j u hu k l hkl hk hl a + d c e f g hka hkd had hac hdc hle hlf hef heg hfg hza hzd hzc hze hzf hzg + have hcard := t.edge_count i j hij + change I.ncard = _ at hcard + by_cases hneighbor : j = i + 1 ∨ i = j + 1 + · simp only [hneighbor, ite_true] at hcard + obtain ⟨k, hI⟩ := Set.ncard_eq_one.mp hcard + have hk : k ∈ I := by rw [hI]; simp + obtain ⟨a, d, c, hka, hkd, had, hac, hdc, hza, hzd, hzc⟩ := edge_coords k hk + have hnot := TriangulationBoundaryProof.hnotAt427 n p X K t k b bhull + bvertex closed_D blinear perturb i j u containing hI hk a c hac hzc + simp only [hneighbor, not_true_eq_false, iff_false] + exact hnot + · simp only [hneighbor, ite_false, hused, ite_true] at hcard + obtain ⟨k, l, hkl, hI⟩ := Set.ncard_eq_two.mp hcard + have hk : k ∈ I := by rw [hI]; simp + have hl : l ∈ I := by rw [hI]; simp + obtain ⟨a, d, c, hka, hkd, had, hac, hdc, hza, hzd, hzc⟩ := edge_coords k hk + obtain ⟨e, f, g, hle, hlf, hef, heg, hfg, hze, hzf, hzg⟩ := edge_coords l hl + have hnegative := opposite l k hkl.symm hl hk e f g a d c + hle hlf hef heg hfg hka hkd had hac hdc hze hzf hzg hza hzd hzc + have hlga : b l (p.vertex (t.face k a)) g = 0 := by + rw [hka, ← hle, bvertex] + simp [Ne.symm heg] + have hlgd : b l (p.vertex (t.face k d)) g = 0 := by + rw [hkd, ← hlf, bvertex] + simp [Ne.symm hfg] + have relation y : b l y g = b k y c * b l (p.vertex (t.face k c)) g := by + calc + b l y g = b l (∑ r, b k y r • p.vertex (t.face k r)) g := + congrArg (fun x => b l x g) (breconstruct k y).symm + _ = ∑ r, b k y r * b l (p.vertex (t.face k r)) g := + bcombo l _ _ (bsum k y) g + _ = b k y c * b l (p.vertex (t.face k c)) g := by + rw [sum_three _ a d c had hac hdc, hlga, hlgd] + simp + let N : Set (Real × Real) := + {y | 0 < b k y a ∧ 0 < b k y d} ∩ {y | 0 < b l y e ∧ 0 < b l y f} + have hN : IsOpen N := + ((isOpen_lt continuous_const (bcontinuous k a)).inter + (isOpen_lt continuous_const (bcontinuous k d))).inter + ((isOpen_lt continuous_const (bcontinuous l e)).inter + (isOpen_lt continuous_const (bcontinuous l f))) + have hzN : z ∈ N := by + change (0 < b k z a ∧ 0 < b k z d) ∧ (0 < b l z e ∧ 0 < b l z f) + rw [hza, hzd, hze, hzf] + exact ⟨⟨sub_pos.mpr hu.2, hu.1⟩, ⟨sub_pos.mpr hu.2, hu.1⟩⟩ + have hNX := TriangulationBoundaryProof.hNX n p X K t k b bhull indices i j u l a d + c hka hkd had hac hdc hza hzd hzc e f g hle hlf hef heg hfg hze hzf hzg hnegative hlga + hlgd relation hN hzN + have hzint : z ∈ interior X := (hN.subset_interior_iff.mpr hNX) hzN + simp only [hneighbor, not_false_eq_true, iff_true] + exact hzint + -- Classify triangle points, then include vertices by closure of the open edges. + have hfrontier := TriangulationBoundaryProof.hfrontier n p X K t hcompact coordinates + edge_interior + have affine_chart (q : Fin 3 → Real × Real) + (hq : P3381T1TriangleDeterminant q ≠ 0) := TriangulationBoundaryProof.affine_chart q hq + -- Straight vertices give opposite rays; a same-direction pair would overlap edges. + have polygon_chart {n : Nat} (p : P3381T1PolygonBoundary n) (i : Fin (n + 3)) := + TriangulationBoundaryProof.polygon_chart affine_chart (n := n) p i + have local_boundary_chart {n : Nat} (p : P3381T1PolygonBoundary n) + (X : Set (Real × Real)) + (hb : frontier X = ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1))) + (i : Fin (n + 3)) (eps : Real) (heps : 0 < eps) := + TriangulationBoundaryProof.local_boundary_chart polygon_chart (n := n) p X hb i + eps heps + have split_sets {A B S T : Set (Real × Real)} + (hA : IsOpen A) (hB : IsOpen B) (hAB : Disjoint A B) + (hS : IsPathConnected S) (hT : IsPathConnected T) + (hcover : S ∪ T = A ∪ B) (hneA : A.Nonempty) (hneB : B.Nonempty) := + TriangulationBoundaryProof.split_sets (A := A) (B + := B) (S := S) (T := T) hA hB hAB hS hT hcover hneA hneB + -- The large sector is a union of two intersecting half-planes in a convex ball preimage. + have affine_sectors (h : (Real × Real) ≃ₜ (Real × Real)) + (haffine : ∀ (x y : Real × Real) (a b : Real), a + b = 1 → + h (a • x + b • y) = a • h x + b • h y) + (r : Real) (hr : 0 < r) (straight : Bool) := TriangulationBoundaryProof.affine_sectors h + haffine r hr straight + -- Nondegenerate closed triangles are closures of their ambient interiors. + have vertex_in_closure := TriangulationBoundaryProof.vertex_in_closure n p X K t coordinates + refine ⟨hcompact, hinterior, hfrontier, ?_⟩ + intro i + obtain ⟨eps, heps, hcone⟩ := local_cones i + obtain ⟨r, h, straight, hr, hreps, h0, haffine, hboundary⟩ := + local_boundary_chart p X hfrontier i eps heps + let R : Set (Real × Real) := if straight then {x | x.2 = 0} + else {x | (0 ≤ x.1 ∧ x.2 = 0) ∨ (x.1 = 0 ∧ 0 ≤ x.2)} + obtain ⟨S, T, hS, hT, hST, hcover⟩ := affine_sectors h haffine r hr straight + change S ∪ T = Metric.ball (h 0) r \ h '' R at hcover + rw [h0] at hcover + let U := Metric.ball (p.vertex i) r ∩ interior X + let V := Metric.ball (p.vertex i) r \ X + have hUopen : IsOpen U := Metric.isOpen_ball.inter isOpen_interior + have hVopen : IsOpen V := Metric.isOpen_ball.sdiff hcompact.isClosed + have hUV : Disjoint U V := by + apply Set.disjoint_left.mpr + intro z hzU hzV + exact hzV.2 (interior_subset hzU.2) + have hUne := TriangulationInteriorSides.hUne n p X i r vertex_in_closure hr + have hvfrontier : p.vertex i ∈ frontier X := by + rw [hfrontier] + exact Set.mem_iUnion.mpr ⟨i, left_mem_segment Real _ _⟩ + have hVne := TriangulationInteriorSides.hVne n p X i r hr hvfrontier + have hcoverUV := TriangulationBoundaryProof.hcoverUV n p X hcompact i r h + straight hboundary S T hcover + obtain ⟨hU, hV⟩ := split_sets hUopen hVopen hUV hS hT hcoverUV hUne hVne + refine ⟨r, hr, ?_, hU, hV⟩ + intro z hz + exact hcone z (Metric.mem_ball.mpr (lt_of_lt_of_le (Metric.mem_ball.mp hz) hreps)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1BoundaryReduction.lean b/LeanPool/ApollonianSuperharmonic/P3475T1BoundaryReduction.lean new file mode 100644 index 0000000000..6f48ab6ba1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3475T1BoundaryReduction.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundarySubdivision +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public import LeanPool.ApollonianSuperharmonic.P3497T1SingleStraightDeletion +public import LeanPool.ApollonianSuperharmonic.P3497T1SubdivisionComposition +public import LeanPool.ApollonianSuperharmonic.P3497T1TriangleCornerNonzero + +-- [TABLET NODE: P3475T1BoundaryReduction] + +/-! +# P3475T1BoundaryReduction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3475T1BoundaryReduction {n : Nat} + (p : P3381T1PolygonBoundary n) : + ∃ (r : Nat) (q : P3381T1PolygonBoundary r), + Nonempty (P3475T1BoundarySubdivision q p) ∧ + ∀ i : Fin (r + 3), + P3381T1TriangleDeterminant (fun j : Fin 3 => + q.vertex (i + ⟨j.val, Nat.lt_of_lt_of_le j.isLt (Nat.le_add_left 3 r)⟩)) ≠ 0 := by +-- BODY + classical + induction n using Nat.strong_induction_on with + | h n ih => + by_cases hcorner : ∀ i : Fin (n + 3), + P3381T1TriangleDeterminant (fun j : Fin 3 => + p.vertex (i + ⟨j.val, Nat.lt_of_lt_of_le j.isLt (Nat.le_add_left 3 n)⟩)) ≠ 0 + · refine ⟨n, p, ?_, hcorner⟩ + refine ⟨{ start := id + start_injective := fun _ _ h => h + edge := id + parameter := fun _ => 0 + parameter_nonneg := fun _ => le_rfl + parameter_lt_one := fun _ => by norm_num + edge_start := fun _ => rfl + parameter_start := fun _ => rfl + vertex_formula := ?_ + successor := ?_ + carrier_eq := rfl }⟩ + · intro j + simp + · intro j + exact Or.inr ⟨rfl, rfl⟩ + · push Not at hcorner + obtain ⟨i, hdet⟩ := hcorner + cases n with + | zero => exact False.elim (P3497T1TriangleCornerNonzero p i hdet) + | succ n => + obtain ⟨v, _, ⟨B⟩⟩ := P3497T1SingleStraightDeletion p i hdet + obtain ⟨r, q, ⟨A⟩, hq⟩ := ih n (Nat.lt_succ_self n) v + exact ⟨r, q, P3497T1SubdivisionComposition A B, hq⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1BoundaryRestoration.lean b/LeanPool/ApollonianSuperharmonic/P3475T1BoundaryRestoration.lean new file mode 100644 index 0000000000..5e31664da6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3475T1BoundaryRestoration.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundarySubdivision +public import LeanPool.ApollonianSuperharmonic.P3475T1TriangleTree +public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionGeometry + +-- [TABLET NODE: P3475T1BoundaryRestoration] + +/-! +# P3475T1BoundaryRestoration + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3475T1BoundaryRestoration {r n : Nat} + (q : P3381T1PolygonBoundary r) (p : P3381T1PolygonBoundary n) + (s : P3475T1BoundarySubdivision q p) + (X K : Set (Real × Real)) (t : P3475T1TriangleTree q X K) : + Nonempty (P3381T1PairedTriangulation p X K) := by +-- BODY + classical + let c := P3523T1InsertionConstruction s t + let fs := c.faces c.steps.length + let f := P3523T1FaceEnumeration fs + let Q := P3523T1InterpolatedTarget s t + obtain ⟨_, _, hf, hdistinct, hused, hcount, _⟩ := + P3523T1InsertionIncidence q p s X K t + obtain ⟨hsn, htn, hsc, htc, hsi, hti⟩ := + P3523T1InsertionGeometry q p s X K t + obtain ⟨hinj, hedge, hfront⟩ := P3523T1TargetBoundary q p s X K t + refine ⟨{ + target := Q + target_injective := hinj + target_edge_intersection := hedge + count := fs.card + face := f + face_injective := hf + face_distinct := hdistinct + vertex_used := hused + source_nondegenerate := hsn + target_nondegenerate := htn + source_cover := hsc + target_cover := htc + source_intersection := hsi + target_intersection := hti + edge_count := hcount + target_hull := (P3523T1TargetHull s t).2 + target_convex := t.target_convex + target_closed := t.target_closed + target_bounded := t.target_bounded + target_interior := t.target_interior + target_frontier := hfront }⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1BoundarySubdivision.lean b/LeanPool/ApollonianSuperharmonic/P3475T1BoundarySubdivision.lean new file mode 100644 index 0000000000..4dba76cf2b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3475T1BoundarySubdivision.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary + +-- [TABLET NODE: P3475T1BoundarySubdivision] + +/-! +# P3475T1BoundarySubdivision + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $q$ and $p$ be boundaries as in +`P3381T1PolygonBoundary`, with $r+3$ and $n+3$ vertices. +An ordered subdivision of $q$ by $p$ records an injective map $s$ of +coarse vertices to original indices, an edge index $e(j)$ and a real +parameter $t_j$ for each original index, satisfying +$$ +0\le t_j<1,\qquad e(s(i))=i,\quad t_{s(i)}=0,\qquad +p_j=(1-t_j)q_{e(j)}+t_jq_{e(j)+1}. +$$ +At each cyclic successor either the edge index stays the same and the +parameter strictly increases, or the edge index advances by one and the +new parameter is zero. The carriers agree exactly: +$\bigcup_j[p_j,p_{j+1}]=\bigcup_i[q_i,q_{i+1}]$. +Thus the coarse endpoints are present, and each coarse edge is replaced +in its original direction by consecutive subsegments. No region or +topological conclusion is part of this data. +-/ +structure P3475T1BoundarySubdivision {r n : Nat} + (q : P3381T1PolygonBoundary r) (p : P3381T1PolygonBoundary n) where +-- BODY + /-- The original fine label at each coarse boundary vertex. -/ + start : Fin (r + 3) → Fin (n + 3) + start_injective : Function.Injective start + /-- The coarse edge containing each fine boundary vertex. -/ + edge : Fin (n + 3) → Fin (r + 3) + /-- The parameter in [0,1) locating a fine vertex along its directed coarse edge. -/ + parameter : Fin (n + 3) → Real + parameter_nonneg : ∀ j, 0 ≤ parameter j + parameter_lt_one : ∀ j, parameter j < 1 + edge_start : ∀ i, edge (start i) = i + parameter_start : ∀ i, parameter (start i) = 0 + vertex_formula : ∀ j, + p.vertex j = (1 - parameter j) • q.vertex (edge j) + + parameter j • q.vertex (edge j + 1) + successor : ∀ j, + (edge (j + 1) = edge j ∧ parameter j < parameter (j + 1)) ∨ + (edge (j + 1) = edge j + 1 ∧ parameter (j + 1) = 0) + carrier_eq : + (⋃ j, segment Real (p.vertex j) (p.vertex (j + 1))) = + ⋃ i, segment Real (q.vertex i) (q.vertex (i + 1)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean new file mode 100644 index 0000000000..19843736dd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean @@ -0,0 +1,974 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertexDegreeTwo +public import LeanPool.ApollonianSuperharmonic.P5620T1BoundaryComponentCycle +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell +public import LeanPool.ApollonianSuperharmonic.P3475T1UnitSegmentIntersection +public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary + +-- [TABLET NODE: P3475T1GridBoundary] + +/-! +# P3475T1GridBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace GridBoundaryConstruction + +private theorem cells_nonempty (T : ProtoTile) (hinside : FourNeighborConnected (T.cells : Set + LatticeCell)) : T.cells.Nonempty := by + classical + exact hinside.1 + +private theorem boundary_degree_two (T : ProtoTile) (hinside : FourNeighborConnected (T.cells : + Set LatticeCell)) (hchecker : NoCheckerboardCellVertex (T.cells : Set LatticeCell)) : ∀ v ∈ + BoundaryFootprintVertices T, Set.ncard {e : Finset GaussianInt | e ∈ BoundaryFootprintEdges T + ∧ v ∈ e} = 2 := by + classical + have cells_nonempty : T.cells.Nonempty := cells_nonempty T hinside + intro v hv + exact BoundaryFootprintVertexDegreeTwo T cells_nonempty hchecker v hv + +private theorem gridPath_length (gridPath : List GaussianInt) (gridPath_length_four : 4 ≤ + gridPath.length) : 3 ≤ gridPath.length := by + classical + omega + +private noncomputable abbrev cyclicEdges (gridPath : List GaussianInt) (y : GaussianInt) (x : + GaussianInt) := (gridPath.zip gridPath.tail) ++ [(y, x)] + +private theorem same_vertical_not_boundary (T : ProtoTile) (q : LatticeCell) (hstatus : q ∈ + T.cells ↔ q - 1 ∈ + T.cells) : ({q, q + ⟨0, 1⟩} : Finset GaussianInt) ∉ BoundaryFootprintEdges T := by + classical + rintro ⟨w, (⟨heq, hxor⟩ | ⟨heq, hxor⟩)⟩ + · have hw : w = q ∨ w = q + ⟨0, 1⟩ := by + have : w ∈ ({q, q + ⟨0, 1⟩} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + have hw1 : w + 1 = q ∨ w + 1 = q + ⟨0, 1⟩ := by + have : w + 1 ∈ ({q, q + ⟨0, 1⟩} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + rcases hw with rfl | rfl <;> simp [Zsqrtd.ext_iff] at hw1 + · have hw : w = q ∨ w = q + ⟨0, 1⟩ := by + have : w ∈ ({q, q + ⟨0, 1⟩} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + rcases hw with rfl | hw + · rcases hxor with ⟨hq, hl⟩ | ⟨hq, hl⟩ + · exact hl (hstatus.mp hq) + · exact hq (hstatus.mpr hl) + · subst w + have hw2 : q + ⟨0, 1⟩ + ⟨0, 1⟩ = q ∨ + q + ⟨0, 1⟩ + ⟨0, 1⟩ = q + ⟨0, 1⟩ := by + have : q + ⟨0, 1⟩ + ⟨0, 1⟩ ∈ + ({q, q + ⟨0, 1⟩} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + rcases hw2 with hw2 | hw2 <;> + have hbad := congrArg Zsqrtd.im hw2 <;> simp at hbad; omega + +private theorem same_horizontal_not_boundary (T : ProtoTile) (q : LatticeCell) (hstatus : q ∈ + T.cells ↔ q - ⟨0, 1⟩ ∈ T.cells) : ({q, q + 1} : Finset GaussianInt) ∉ BoundaryFootprintEdges + T := by + classical + rintro ⟨w, (⟨heq, hxor⟩ | ⟨heq, hxor⟩)⟩ + · have hw : w = q ∨ w = q + 1 := by + have : w ∈ ({q, q + 1} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + rcases hw with rfl | hw + · rcases hxor with ⟨hq, hl⟩ | ⟨hq, hl⟩ + · exact hl (hstatus.mp hq) + · exact hq (hstatus.mpr hl) + · subst w + have hw2 : q + 1 + 1 = q ∨ q + 1 + 1 = q + 1 := by + have : q + 1 + 1 ∈ ({q, q + 1} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + rcases hw2 with hw2 | hw2 <;> + have hbad := congrArg Zsqrtd.re hw2 <;> simp at hbad; omega + · have hw : w = q ∨ w = q + 1 := by + have : w ∈ ({q, q + 1} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + have hwi : w + ⟨0, 1⟩ = q ∨ w + ⟨0, 1⟩ = q + 1 := by + have : w + ⟨0, 1⟩ ∈ ({q, q + 1} : Finset GaussianInt) := by rw [heq]; simp + simpa using this + rcases hw with rfl | rfl <;> simp [Zsqrtd.ext_iff] at hwi + +private theorem adjacent_index_same_status (T : ProtoTile) (gridPath : List GaussianInt) (y : + GaussianInt) (x : GaussianInt) (cyclic_edge_boundary : ∀ (a b : GaussianInt), (a, b) ∈ + gridPath.zip gridPath.tail ++ [(y, x)] → {a, b} ∈ + ApollonianSuperharmonic.BoundaryFootprintEdges T) (gridPath_head : gridPath.head? = some x) + (gridPath_last : gridPath.getLast? = some y) (gridPath_nodup : gridPath.Nodup) + (gridPath_zip_fourNeighbor : ∀ (a b : GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail → + ApollonianSuperharmonic.FourNeighborAdjacent a b) (gridPath_close_fourNeighbor : + ApollonianSuperharmonic.FourNeighborAdjacent y x) (gridPath_length_four : 4 ≤ + gridPath.length) (a b : LatticeCell) (hs : a ∈ T.cells ↔ b ∈ T.cells) (hab : + FourNeighborAdjacent a b) : GridRayCrossingIndex a gridPath = GridRayCrossingIndex b gridPath + := by + classical + have gridPath_length : 3 ≤ gridPath.length := gridPath_length gridPath gridPath_length_four + have component_index_control := GridRayCrossingIndexAdjacentCell gridPath x y + gridPath_head gridPath_last gridPath_nodup gridPath_length + gridPath_zip_fourNeighbor gridPath_close_fourNeighbor + have same_vertical_not_boundary (q : LatticeCell) + (hstatus : q ∈ T.cells ↔ q - 1 ∈ T.cells) : + ({q, q + ⟨0, 1⟩} : Finset GaussianInt) ∉ BoundaryFootprintEdges T := + same_vertical_not_boundary T q hstatus + have same_horizontal_not_boundary (q : LatticeCell) + (hstatus : q ∈ T.cells ↔ q - ⟨0, 1⟩ ∈ T.cells) : + ({q, q + 1} : Finset GaussianInt) ∉ BoundaryFootprintEdges T := + same_horizontal_not_boundary T q hstatus + rcases hab with rfl | rfl | rfl | rfl + · symm + apply (component_index_control a).1 + constructor <;> intro hc + · apply same_vertical_not_boundary (a + 1) + (by simpa using hs.symm) + exact cyclic_edge_boundary _ _ hc + · apply same_vertical_not_boundary (a + 1) + (by simpa using hs.symm) + simpa [Finset.pair_comm] using cyclic_edge_boundary _ _ hc + · have heq := (component_index_control (a - 1)).1 + ⟨(fun hc => same_vertical_not_boundary a hs + (by simpa using cyclic_edge_boundary _ _ hc)), + (fun hc => same_vertical_not_boundary a hs + (by simpa [Finset.pair_comm] using cyclic_edge_boundary _ _ hc))⟩ + simpa using heq + · symm + apply (component_index_control a).2.2.1 + constructor <;> intro hc + · apply same_horizontal_not_boundary (a + ⟨0, 1⟩) + (by simpa using hs.symm) + simpa [Finset.pair_comm, add_comm, add_left_comm, add_assoc] + using cyclic_edge_boundary _ _ hc + · apply same_horizontal_not_boundary (a + ⟨0, 1⟩) + (by simpa using hs.symm) + simpa [add_comm, add_left_comm, add_assoc] + using cyclic_edge_boundary _ _ hc + · have heq := (component_index_control (a - ⟨0, 1⟩)).2.2.1 + ⟨(fun hc => same_horizontal_not_boundary a hs + (by simpa [Finset.pair_comm, add_comm, add_left_comm, add_assoc] + using cyclic_edge_boundary _ _ hc)), + (fun hc => same_horizontal_not_boundary a hs + (by simpa [add_comm, add_left_comm, add_assoc] + using cyclic_edge_boundary _ _ hc))⟩ + simpa using heq + +private theorem index_constant (S : Set LatticeCell) (hS : FourNeighborConnected S) (I : + LatticeCell → Int) (hstep : ∀ a, a ∈ S → ∀ b, b ∈ S → FourNeighborAdjacent a b → I a = I b) + (x : LatticeCell) (hx : x ∈ S) (y : LatticeCell) (hy : y ∈ S) : I x = I y := by + classical + obtain ⟨p, hhead, hlast, hmem, hadj⟩ := hS.2 x hx y hy + have hchain : List.IsChain FourNeighborAdjacent p := by + rw [List.isChain_iff_forall_rel_of_append_cons_cons] + exact hadj + have hindices : List.IsChain (fun a b => I a = I b) p := + hchain.imp_of_mem_imp (fun a b ha hb hab => + hstep a (hmem a ha) b (hmem b hb) hab) + cases p with + | nil => simp at hhead + | cons a p => + have hax : a = x := by simpa using Option.some.inj hhead + subst a + have hymem : y ∈ x :: p := by + rcases List.getLast?_eq_some_iff.mp hlast with ⟨l, hl⟩ + rw [hl] + simp + simp only [List.mem_cons] at hymem + rcases hymem with hyx | hymem + · exact congrArg I hyx.symm + · exact hindices.rel_cons hymem + +private noncomputable abbrev q0 (w : ApollonianSuperharmonic.LatticeCell) : LatticeCell := by + classical + exact ⟨w.re - 1, 0⟩ + +private theorem q0_outside (T : ProtoTile) (gridPath : List GaussianInt) (w : + ApollonianSuperharmonic.LatticeCell) (hmin : ∀ x' ∈ T.cells ∪ gridPath.toFinset, w.re ≤ + x'.re) : (q0 w) ∉ T.cells := by + classical + let q0 : LatticeCell := ⟨w.re - 1, 0⟩ + change (q0 ∉ T.cells) + intro hq + have h := hmin q0 (Finset.mem_union_left _ hq) + simp only [q0] at h + omega + +private theorem path_left (T : ProtoTile) (gridPath : List GaussianInt) (w : + ApollonianSuperharmonic.LatticeCell) (hmin : ∀ x' ∈ T.cells ∪ gridPath.toFinset, w.re ≤ + x'.re) (a : GaussianInt) (ha : a ∈ gridPath) : (q0 w).re < a.re := by + classical + let q0 : LatticeCell := ⟨w.re - 1, 0⟩ + change (q0.re < a.re) + have h := hmin a (Finset.mem_union_right _ (List.mem_toFinset.mpr ha)) + dsimp only [q0] + omega + +private noncomputable abbrev step (w : ApollonianSuperharmonic.LatticeCell) : GaussianInt → + GaussianInt → Int := by + classical + let q0 : LatticeCell := ⟨w.re - 1, 0⟩ + exact fun a b => + if b = a + ⟨0, 1⟩ ∧ a.im = q0.im ∧ a.re ≤ q0.re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = q0.im ∧ a.re ≤ q0.re then -1 else 0 + +private theorem step_zero (T : ProtoTile) (gridPath : List GaussianInt) (w : + ApollonianSuperharmonic.LatticeCell) (hmin : ∀ x' ∈ T.cells ∪ gridPath.toFinset, w.re ≤ + x'.re) (a : GaussianInt) (ha : a ∈ gridPath) (b : GaussianInt) : (step w) a b = 0 := by + classical + let q0 : LatticeCell := ⟨w.re - 1, 0⟩ + have path_left (a : GaussianInt) (ha : a ∈ gridPath) : q0.re < a.re := path_left T gridPath w + hmin a ha + let step : GaussianInt → GaussianInt → Int := fun a b => + if b = a + ⟨0, 1⟩ ∧ a.im = q0.im ∧ a.re ≤ q0.re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = q0.im ∧ a.re ≤ q0.re then -1 else 0 + change (step a b = 0) + have hn : ¬ a.re ≤ q0.re := not_le.mpr (path_left a ha) + simp only [step, hn, and_false, ite_false] + +private theorem zip_zero (T : ProtoTile) (gridPath : List GaussianInt) (w : + ApollonianSuperharmonic.LatticeCell) (hmin : ∀ x' ∈ T.cells ∪ gridPath.toFinset, w.re ≤ + x'.re) (r s : List GaussianInt) (hr : ∀ a ∈ r, a ∈ gridPath) : (List.zipWith (step w) r + s).sum = 0 := by + classical + let q0 : LatticeCell := ⟨w.re - 1, 0⟩ + let step : GaussianInt → GaussianInt → Int := fun a b => + if b = a + ⟨0, 1⟩ ∧ a.im = q0.im ∧ a.re ≤ q0.re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = q0.im ∧ a.re ≤ q0.re then -1 else 0 + have step_zero (a : GaussianInt) (ha : a ∈ gridPath) (b : GaussianInt) : + step a b = 0 := step_zero T gridPath w hmin a ha b + change ((List.zipWith step r s).sum = 0) + induction r generalizing s with + | nil => simp + | cons a r ih => + cases s with + | nil => simp + | cons b s => + rw [List.zipWith_cons_cons, List.sum_cons, + step_zero a (hr a (by simp)), ih s (fun c hc => hr c (by simp [hc]))] + simp + +private theorem q0_index_zero (T : ProtoTile) (gridPath : List GaussianInt) (y : GaussianInt) (x + : GaussianInt) (gridPath_head : gridPath.head? = some x) (gridPath_last : gridPath.getLast? = + some y) (w : ApollonianSuperharmonic.LatticeCell) (hmin : ∀ x' ∈ T.cells ∪ gridPath.toFinset, + w.re ≤ x'.re) : GridRayCrossingIndex (q0 w) gridPath = 0 := by + classical + let q0 : LatticeCell := ⟨w.re - 1, 0⟩ + let step : GaussianInt → GaussianInt → Int := fun a b => + if b = a + ⟨0, 1⟩ ∧ a.im = q0.im ∧ a.re ≤ q0.re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = q0.im ∧ a.re ≤ q0.re then -1 else 0 + have step_zero (a : GaussianInt) (ha : a ∈ gridPath) (b : GaussianInt) : + step a b = 0 := step_zero T gridPath w hmin a ha b + have zip_zero (r s : List GaussianInt) (hr : ∀ a ∈ r, a ∈ gridPath) : + (List.zipWith step r s).sum = 0 := zip_zero T gridPath w hmin r s hr + change (GridRayCrossingIndex q0 gridPath = 0) + have hsum := zip_zero gridPath gridPath.tail (fun a ha => ha) + have hy : y ∈ gridPath := by + rcases List.getLast?_eq_some_iff.mp gridPath_last with ⟨l, hl⟩ + rw [hl] + simp + change (List.zipWith step gridPath gridPath.tail).sum + + (match gridPath.getLast?, gridPath.head? with + | some a, some b => step a b + | _, _ => 0) = 0 + rw [hsum, gridPath_last, gridPath_head] + simp only [step_zero y hy x, add_zero] + +private theorem unoccupied_index_zero (T : ProtoTile) (houtside : FourNeighborConnected ((T.cells + : Set LatticeCell)ᶜ)) (gridPath : List GaussianInt) (y : GaussianInt) (x : GaussianInt) + (cyclic_edge_boundary : ∀ (a b : GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail ++ [(y, + x)] → {a, b} ∈ ApollonianSuperharmonic.BoundaryFootprintEdges T) (gridPath_head : + gridPath.head? = some x) (gridPath_last : gridPath.getLast? = some y) (gridPath_nodup : + gridPath.Nodup) (gridPath_zip_fourNeighbor : ∀ (a b : GaussianInt), (a, b) ∈ gridPath.zip + gridPath.tail → ApollonianSuperharmonic.FourNeighborAdjacent a b) + (gridPath_close_fourNeighbor : ApollonianSuperharmonic.FourNeighborAdjacent y x) (w : + ApollonianSuperharmonic.LatticeCell) (gridPath_length_four : 4 ≤ gridPath.length) (hmin : ∀ + x' ∈ T.cells ∪ gridPath.toFinset, w.re ≤ x'.re) (q : LatticeCell) (hq : q ∉ T.cells) : + GridRayCrossingIndex q gridPath = 0 := by + classical + have adjacent_index_same_status (a b : LatticeCell) + (hs : a ∈ T.cells ↔ b ∈ T.cells) (hab : FourNeighborAdjacent a b) : + GridRayCrossingIndex a gridPath = GridRayCrossingIndex b gridPath := + adjacent_index_same_status T gridPath y x cyclic_edge_boundary gridPath_head + gridPath_last gridPath_nodup gridPath_zip_fourNeighbor gridPath_close_fourNeighbor + gridPath_length_four a b hs hab + have index_constant (S : Set LatticeCell) (hS : FourNeighborConnected S) + (I : LatticeCell → Int) + (hstep : ∀ a, a ∈ S → ∀ b, b ∈ S → + FourNeighborAdjacent a b → I a = I b) + (x : LatticeCell) (hx : x ∈ S) (y : LatticeCell) (hy : y ∈ S) : + I x = I y := index_constant S hS I hstep x hx y hy + let q0 : LatticeCell := ⟨w.re - 1, 0⟩ + have q0_outside : q0 ∉ T.cells := q0_outside T gridPath w hmin + have q0_index_zero : GridRayCrossingIndex q0 gridPath = 0 := q0_index_zero T gridPath y x + gridPath_head gridPath_last w hmin + have hconst := index_constant ((T.cells : Set LatticeCell)ᶜ) houtside + (fun a => GridRayCrossingIndex a gridPath) + (fun a ha b hb hab => adjacent_index_same_status a b + (by simp only [Finset.mem_coe, Set.mem_compl_iff] at ha hb; simp [ha, hb]) hab) + q hq q0 q0_outside + exact hconst.trans q0_index_zero + +private theorem hrightJump (gridPath : List GaussianInt) (y : GaussianInt) (x : GaussianInt) + (gridPath_head : gridPath.head? = some x) (gridPath_last : gridPath.getLast? = some y) + (gridPath_nodup : gridPath.Nodup) (gridPath_zip_fourNeighbor : ∀ (a b : GaussianInt), (a, b) + ∈ gridPath.zip gridPath.tail → ApollonianSuperharmonic.FourNeighborAdjacent a b) + (gridPath_close_fourNeighbor : ApollonianSuperharmonic.FourNeighborAdjacent y x) (z : + GaussianInt) (gridPath_length_four : 4 ≤ gridPath.length) (hrightCyclic : (z + 1, z + 1 + { + re := 0, im := 1 }) ∈ gridPath.zip gridPath.tail ++ [(y, x)] ∨ (z + 1 + { re := 0, im := 1 }, + z + 1) ∈ gridPath.zip gridPath.tail ++ [(y, x)]) : Int.natAbs (GridRayCrossingIndex (z + 1) + gridPath - GridRayCrossingIndex z gridPath) = 1 := by + classical + have gridPath_length : 3 ≤ gridPath.length := gridPath_length gridPath gridPath_length_four + have component_index_control := GridRayCrossingIndexAdjacentCell gridPath x y + gridPath_head gridPath_last gridPath_nodup gridPath_length + gridPath_zip_fourNeighbor gridPath_close_fourNeighbor + exact (component_index_control z).2.1 hrightCyclic + +private theorem hzIndexNonzero (T : ProtoTile) (houtside : FourNeighborConnected ((T.cells : Set + LatticeCell)ᶜ)) (gridPath : List GaussianInt) (y : GaussianInt) (x : GaussianInt) + (cyclic_edge_boundary : ∀ (a b : GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail ++ [(y, + x)] → {a, b} ∈ ApollonianSuperharmonic.BoundaryFootprintEdges T) (gridPath_head : + gridPath.head? = some x) (gridPath_last : gridPath.getLast? = some y) (gridPath_nodup : + gridPath.Nodup) (gridPath_zip_fourNeighbor : ∀ (a b : GaussianInt), (a, b) ∈ gridPath.zip + gridPath.tail → ApollonianSuperharmonic.FourNeighborAdjacent a b) + (gridPath_close_fourNeighbor : ApollonianSuperharmonic.FourNeighborAdjacent y x) (z : + GaussianInt) (w : ApollonianSuperharmonic.LatticeCell) (gridPath_length_four : 4 ≤ + gridPath.length) (hrightCyclic : (z + 1, z + 1 + { re := 0, im := 1 }) ∈ gridPath.zip + gridPath.tail ++ [(y, x)] ∨ (z + 1 + { re := 0, im := 1 }, z + 1) ∈ gridPath.zip + gridPath.tail ++ [(y, x)]) (hzout : z + 1 ∉ T.cells) (hmin : ∀ x' ∈ T.cells ∪ + gridPath.toFinset, w.re ≤ x'.re) : GridRayCrossingIndex z gridPath ≠ 0 := by + classical + have unoccupied_index_zero (q : LatticeCell) (hq : q ∉ T.cells) : + GridRayCrossingIndex q gridPath = 0 := unoccupied_index_zero T houtside gridPath y x + cyclic_edge_boundary gridPath_head gridPath_last gridPath_nodup + gridPath_zip_fourNeighbor gridPath_close_fourNeighbor w gridPath_length_four hmin q hq + have hrightJump : + Int.natAbs (GridRayCrossingIndex (z + 1) gridPath - + GridRayCrossingIndex z gridPath) = 1 := hrightJump gridPath y x gridPath_head + gridPath_last gridPath_nodup gridPath_zip_fourNeighbor gridPath_close_fourNeighbor z + gridPath_length_four hrightCyclic + intro hz0 + rw [unoccupied_index_zero (z + 1) hzout, hz0] at hrightJump + simp at hrightJump + +private theorem occupied_index_nonzero (T : ProtoTile) (hinside : FourNeighborConnected (T.cells + : Set LatticeCell)) (houtside : FourNeighborConnected ((T.cells : Set LatticeCell)ᶜ)) + (gridPath : List GaussianInt) (y : GaussianInt) (x : GaussianInt) (cyclic_edge_boundary : ∀ + (a b : GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail ++ [(y, x)] → {a, b} ∈ + ApollonianSuperharmonic.BoundaryFootprintEdges T) (gridPath_head : gridPath.head? = some x) + (gridPath_last : gridPath.getLast? = some y) (gridPath_nodup : gridPath.Nodup) + (gridPath_zip_fourNeighbor : ∀ (a b : GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail → + ApollonianSuperharmonic.FourNeighborAdjacent a b) (gridPath_close_fourNeighbor : + ApollonianSuperharmonic.FourNeighborAdjacent y x) (z : GaussianInt) (w : + ApollonianSuperharmonic.LatticeCell) (gridPath_length_four : 4 ≤ gridPath.length) + (hrightCyclic : (z + 1, z + 1 + { re := 0, im := 1 }) ∈ gridPath.zip gridPath.tail ++ [(y, + x)] ∨ (z + 1 + { re := 0, im := 1 }, z + 1) ∈ gridPath.zip gridPath.tail ++ [(y, x)]) (hzout + : z + 1 ∉ T.cells) (hz : z ∈ T.cells) (hmin : ∀ x' ∈ T.cells ∪ gridPath.toFinset, w.re ≤ + x'.re) (q : LatticeCell) (hq : q ∈ T.cells) : GridRayCrossingIndex q gridPath ≠ 0 := by + classical + have adjacent_index_same_status (a b : LatticeCell) + (hs : a ∈ T.cells ↔ b ∈ T.cells) (hab : FourNeighborAdjacent a b) : + GridRayCrossingIndex a gridPath = GridRayCrossingIndex b gridPath := + adjacent_index_same_status T gridPath y x cyclic_edge_boundary gridPath_head + gridPath_last gridPath_nodup gridPath_zip_fourNeighbor gridPath_close_fourNeighbor + gridPath_length_four a b hs hab + have index_constant (S : Set LatticeCell) (hS : FourNeighborConnected S) + (I : LatticeCell → Int) + (hstep : ∀ a, a ∈ S → ∀ b, b ∈ S → + FourNeighborAdjacent a b → I a = I b) + (x : LatticeCell) (hx : x ∈ S) (y : LatticeCell) (hy : y ∈ S) : + I x = I y := index_constant S hS I hstep x hx y hy + have hzIndexNonzero : GridRayCrossingIndex z gridPath ≠ 0 := hzIndexNonzero T houtside gridPath + y x cyclic_edge_boundary gridPath_head gridPath_last gridPath_nodup + gridPath_zip_fourNeighbor gridPath_close_fourNeighbor z w gridPath_length_four hrightCyclic + hzout hmin + have hconst := index_constant (T.cells : Set LatticeCell) hinside + (fun a => GridRayCrossingIndex a gridPath) + (fun a ha b hb hab => adjacent_index_same_status a b + (by simp only [Finset.mem_coe] at ha hb; simp [ha, hb]) hab) q hq z hz + rw [hconst] + exact hzIndexNonzero + +private theorem boundary_edge_cyclic (T : ProtoTile) (hinside : FourNeighborConnected (T.cells : + Set LatticeCell)) (houtside : FourNeighborConnected ((T.cells : Set LatticeCell)ᶜ)) (gridPath + : List GaussianInt) (y : GaussianInt) (x : GaussianInt) (cyclic_edge_boundary : ∀ (a b : + GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail ++ [(y, x)] → {a, b} ∈ + ApollonianSuperharmonic.BoundaryFootprintEdges T) (gridPath_head : gridPath.head? = some x) + (gridPath_last : gridPath.getLast? = some y) (gridPath_nodup : gridPath.Nodup) + (gridPath_zip_fourNeighbor : ∀ (a b : GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail → + ApollonianSuperharmonic.FourNeighborAdjacent a b) (gridPath_close_fourNeighbor : + ApollonianSuperharmonic.FourNeighborAdjacent y x) (z : GaussianInt) (w : + ApollonianSuperharmonic.LatticeCell) (gridPath_length_four : 4 ≤ gridPath.length) + (hrightCyclic : (z + 1, z + 1 + { re := 0, im := 1 }) ∈ gridPath.zip gridPath.tail ++ [(y, + x)] ∨ (z + 1 + { re := 0, im := 1 }, z + 1) ∈ gridPath.zip gridPath.tail ++ [(y, x)]) (hzout + : z + 1 ∉ T.cells) (hz : z ∈ T.cells) (hmin : ∀ x' ∈ T.cells ∪ gridPath.toFinset, w.re ≤ + x'.re) (e : Finset GaussianInt) (he : e ∈ BoundaryFootprintEdges T) : ∃ a b : GaussianInt, e + = {a, b} ∧ ((a, b) ∈ (cyclicEdges gridPath y x) ∨ (b, a) ∈ (cyclicEdges gridPath y x)) := by + classical + have gridPath_length : 3 ≤ gridPath.length := gridPath_length gridPath gridPath_length_four + have component_index_control := GridRayCrossingIndexAdjacentCell gridPath x y + gridPath_head gridPath_last gridPath_nodup gridPath_length + gridPath_zip_fourNeighbor gridPath_close_fourNeighbor + let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] + have unoccupied_index_zero (q : LatticeCell) (hq : q ∉ T.cells) : + GridRayCrossingIndex q gridPath = 0 := unoccupied_index_zero T houtside gridPath y x + cyclic_edge_boundary gridPath_head gridPath_last gridPath_nodup + gridPath_zip_fourNeighbor gridPath_close_fourNeighbor w gridPath_length_four hmin q hq + have occupied_index_nonzero (q : LatticeCell) (hq : q ∈ T.cells) : + GridRayCrossingIndex q gridPath ≠ 0 := occupied_index_nonzero T hinside houtside gridPath y + x cyclic_edge_boundary gridPath_head gridPath_last gridPath_nodup + gridPath_zip_fourNeighbor gridPath_close_fourNeighbor z w gridPath_length_four + hrightCyclic hzout hz hmin q hq + change (∃ a b : GaussianInt, e = {a, b} ∧ + ((a, b) ∈ cyclicEdges ∨ (b, a) ∈ cyclicEdges)) + rcases he with ⟨q, (⟨rfl, hxor⟩ | ⟨rfl, hxor⟩)⟩ + · refine ⟨q, q + 1, rfl, ?_⟩ + by_contra hnone + rw [not_or] at hnone + have hcontrol := (component_index_control (q - ⟨0, 1⟩)).2.2.1 + have heq : GridRayCrossingIndex q gridPath = + GridRayCrossingIndex (q - ⟨0, 1⟩) gridPath := by + have hraw := hcontrol (by + constructor + · simpa [cyclicEdges, Zsqrtd.ext_iff, add_assoc, add_comm, + add_left_comm] using hnone.2 + · simpa [cyclicEdges, Zsqrtd.ext_iff, add_assoc, add_comm, + add_left_comm] using hnone.1) + simpa [Zsqrtd.ext_iff] using hraw + rcases hxor with ⟨hq, hbelow⟩ | ⟨hq, hbelow⟩ + · rw [unoccupied_index_zero (q - ⟨0, 1⟩) hbelow] at heq + exact occupied_index_nonzero q hq heq + · rw [unoccupied_index_zero q hq] at heq + exact occupied_index_nonzero (q - ⟨0, 1⟩) hbelow heq.symm + · refine ⟨q, q + ⟨0, 1⟩, rfl, ?_⟩ + by_contra hnone + rw [not_or] at hnone + have hcontrol := (component_index_control (q - 1)).1 + have heq : GridRayCrossingIndex q gridPath = + GridRayCrossingIndex (q - 1) gridPath := by + have hraw := hcontrol (by + constructor + · simpa [cyclicEdges, Zsqrtd.ext_iff] using hnone.1 + · simpa [cyclicEdges, Zsqrtd.ext_iff] using hnone.2) + simpa [Zsqrtd.ext_iff] using hraw + rcases hxor with ⟨hq, hleft⟩ | ⟨hq, hleft⟩ + · rw [unoccupied_index_zero (q - 1) hleft] at heq + exact occupied_index_nonzero q hq heq + · rw [unoccupied_index_zero q hq] at heq + exact occupied_index_nonzero (q - 1) hleft heq.symm + +private theorem zip_mem_decompose (gridPath : List GaussianInt) (gridPath_length_four : 4 ≤ + gridPath.length) (a b : GaussianInt) (hab : (a, b) ∈ gridPath.zip gridPath.tail) : ∃ l₁ l₂ : + List GaussianInt, gridPath = l₁ ++ a :: b :: l₂ := by + classical + rw [List.mem_iff_getElem] at hab + rcases hab with ⟨i, hi, hab⟩ + have hi' : i < gridPath.tail.length := by + simpa [List.length_zip] using hi + have hi0 : i < gridPath.length := by + simp only [List.length_tail] at hi' + omega + have hi1 : i + 1 < gridPath.length := by + simp only [List.length_tail] at hi' + omega + rw [List.getElem_zip, List.getElem_tail] at hab + injection hab with ha hb + refine ⟨gridPath.take i, gridPath.drop (i + 2), ?_⟩ + calc + gridPath = gridPath.take i ++ gridPath.drop i := + (List.take_append_drop i gridPath).symm + _ = gridPath.take i ++ gridPath[i] :: gridPath.drop (i + 1) := by + rw [List.drop_eq_getElem_cons hi0] + _ = gridPath.take i ++ gridPath[i] :: gridPath[i + 1] :: + gridPath.drop (i + 2) := by + rw [List.drop_eq_getElem_cons hi1] + _ = gridPath.take i ++ a :: b :: gridPath.drop (i + 2) := by + rw [ha, hb] + +private theorem cyclic_endpoints_mem (gridPath : List GaussianInt) (y : GaussianInt) (x : + GaussianInt) (gridPath_head : gridPath.head? = some x) (gridPath_last : gridPath.getLast? = + some y) (gridPath_length_four : 4 ≤ gridPath.length) (a b : GaussianInt) (hab : (a, b) ∈ + (cyclicEdges gridPath y x)) : a ∈ gridPath ∧ b ∈ gridPath := by + classical + let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] + have zip_mem_decompose (a b : GaussianInt) + (hab : (a, b) ∈ gridPath.zip gridPath.tail) : + ∃ l₁ l₂ : List GaussianInt, gridPath = l₁ ++ a :: b :: l₂ := zip_mem_decompose gridPath + gridPath_length_four a b hab + simp only [List.mem_append, List.mem_singleton] at hab + rcases hab with hab | hab + · rcases zip_mem_decompose a b hab with ⟨l₁, l₂, hpath⟩ + rw [hpath] + simp + · have hab' : a = y ∧ b = x := Prod.mk.inj hab + constructor + · rw [hab'.1] + exact List.getLast?_eq_some_iff.mp gridPath_last |>.choose_spec ▸ + (by simp) + · rw [hab'.2] + rcases List.head?_eq_some_iff.mp gridPath_head with ⟨l, hl⟩ + rw [hl] + simp + +private theorem boundary_vertices_eq (T : ProtoTile) (hinside : FourNeighborConnected (T.cells : + Set LatticeCell)) (houtside : FourNeighborConnected ((T.cells : Set LatticeCell)ᶜ)) (gridPath + : List GaussianInt) (y : GaussianInt) (x : GaussianInt) (cyclic_edge_boundary : ∀ (a b : + GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail ++ [(y, x)] → {a, b} ∈ + ApollonianSuperharmonic.BoundaryFootprintEdges T) (gridPath_mem_boundary : ∀ a ∈ gridPath, a + ∈ ApollonianSuperharmonic.BoundaryFootprintVertices T) (gridPath_head : gridPath.head? = some + x) (gridPath_last : gridPath.getLast? = some y) (gridPath_nodup : gridPath.Nodup) + (gridPath_zip_fourNeighbor : ∀ (a b : GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail → + ApollonianSuperharmonic.FourNeighborAdjacent a b) (gridPath_close_fourNeighbor : + ApollonianSuperharmonic.FourNeighborAdjacent y x) (z : GaussianInt) (w : + ApollonianSuperharmonic.LatticeCell) (gridPath_length_four : 4 ≤ gridPath.length) + (hrightCyclic : (z + 1, z + 1 + { re := 0, im := 1 }) ∈ gridPath.zip gridPath.tail ++ [(y, + x)] ∨ (z + 1 + { re := 0, im := 1 }, z + 1) ∈ gridPath.zip gridPath.tail ++ [(y, x)]) (hzout + : z + 1 ∉ T.cells) (hz : z ∈ T.cells) (hmin : ∀ x' ∈ T.cells ∪ gridPath.toFinset, w.re ≤ + x'.re) : BoundaryFootprintVertices T = (gridPath.toFinset : Set GaussianInt) := by + classical + have cells_nonempty : T.cells.Nonempty := cells_nonempty T hinside + let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] + have boundary_edge_cyclic (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) : + ∃ a b : GaussianInt, e = {a, b} ∧ + ((a, b) ∈ cyclicEdges ∨ (b, a) ∈ cyclicEdges) := boundary_edge_cyclic T hinside houtside + gridPath y x cyclic_edge_boundary gridPath_head gridPath_last gridPath_nodup + gridPath_zip_fourNeighbor gridPath_close_fourNeighbor z w gridPath_length_four + hrightCyclic hzout hz hmin e he + have cyclic_endpoints_mem (a b : GaussianInt) (hab : (a, b) ∈ cyclicEdges) : + a ∈ gridPath ∧ b ∈ gridPath := cyclic_endpoints_mem gridPath y x gridPath_head + gridPath_last gridPath_length_four a b hab + ext v + constructor + · intro hv + rw [BoundaryFootprintVertices, ite_eq_left cells_nonempty] at hv + rcases hv with ⟨e, he, hve⟩ + rcases boundary_edge_cyclic e he with ⟨a, b, rfl, hab⟩ + simp only [Finset.mem_insert, Finset.mem_singleton] at hve + rw [Finset.mem_coe, List.mem_toFinset] + rcases hab with hab | hab + · rcases cyclic_endpoints_mem a b hab with ⟨ha, hb⟩ + exact hve.elim (fun h => h ▸ ha) (fun h => h ▸ hb) + · rcases cyclic_endpoints_mem b a hab with ⟨hb, ha⟩ + exact hve.elim (fun h => h ▸ ha) (fun h => h ▸ hb) + · intro hv + rw [Finset.mem_coe, List.mem_toFinset] at hv + exact gridPath_mem_boundary v hv + +private noncomputable abbrev n (gridPath : List GaussianInt) := gridPath.length - 3 + +private theorem hn (gridPath : List GaussianInt) (gridPath_length_four : 4 ≤ gridPath.length) : (n + gridPath) + 3 = gridPath.length := by + classical + let n := gridPath.length - 3 + change (n + 3 = gridPath.length) + dsimp only [n]; omega + +private noncomputable abbrev v (gridPath : List GaussianInt) (gridPath_length_four : 4 ≤ + gridPath.length) : Fin ((n gridPath) + 3) → GaussianInt := by + classical + let n := gridPath.length - 3 + have hn : n + 3 = gridPath.length := hn gridPath gridPath_length_four + change (Fin (n + 3) → GaussianInt) + exact fun i => gridPath[i.val]'(by rw [← hn]; exact i.isLt) + +private theorem v_injective (gridPath : List GaussianInt) (gridPath_nodup : gridPath.Nodup) + (gridPath_length_four : 4 ≤ gridPath.length) : Function.Injective (v gridPath + gridPath_length_four) := by + classical + let n := gridPath.length - 3 + have hn : n + 3 = gridPath.length := hn gridPath gridPath_length_four + let v : Fin (n + 3) → GaussianInt := + fun i => gridPath[i.val]'(by rw [← hn]; exact i.isLt) + change (Function.Injective v) + intro i j hij + apply Fin.ext + exact (gridPath_nodup.getElem_inj_iff).mp hij + +private theorem successor_val {n : Nat} (i : Fin (n + 3)) : (i + 1).val = if i.val + 1 < n + 3 + then i.val + 1 else 0 := by + by_cases hi : i.val + 1 < n + 3 + · simp [Fin.val_add, Nat.mod_eq_of_lt (show 1 < n + 3 by omega), + Nat.mod_eq_of_lt hi, hi] + · have he : i.val + 1 = n + 3 := by omega + simp [Fin.val_add, Nat.mod_eq_of_lt (show 1 < n + 3 by omega), he] + +private theorem v_head (gridPath : List GaussianInt) (x : GaussianInt) (gridPath_head : + gridPath.head? = some x) (gridPath_length_four : 4 ≤ gridPath.length) : (v gridPath + gridPath_length_four) 0 = x := by + classical + have gridPath_length : 3 ≤ gridPath.length := gridPath_length gridPath gridPath_length_four + let n := gridPath.length - 3 + have hn : n + 3 = gridPath.length := hn gridPath gridPath_length_four + let v : Fin (n + 3) → GaussianInt := + fun i => gridPath[i.val]'(by rw [← hn]; exact i.isLt) + change (v 0 = x) + have hne : gridPath ≠ [] := by intro h; simp [h] at gridPath_length + change gridPath[0] = x + rw [← List.head_eq_getElem hne] + simpa [List.head?_eq_some_head hne] using gridPath_head + +private theorem v_last (gridPath : List GaussianInt) (y : GaussianInt) (gridPath_last : + gridPath.getLast? = some y) (gridPath_length_four : 4 ≤ gridPath.length) : (v gridPath + gridPath_length_four) ⟨(n gridPath) + 2, by omega⟩ = y := by + classical + have gridPath_length : 3 ≤ gridPath.length := gridPath_length gridPath gridPath_length_four + let n := gridPath.length - 3 + have hn : n + 3 = gridPath.length := hn gridPath gridPath_length_four + let v : Fin (n + 3) → GaussianInt := + fun i => gridPath[i.val]'(by rw [← hn]; exact i.isLt) + change (v ⟨n + 2, by omega⟩ = y) + have hne : gridPath ≠ [] := by intro h; simp [h] at gridPath_length + change gridPath[n + 2] = y + have he : n + 2 = gridPath.length - 1 := by omega + simp only [he] + rw [← List.getLast_eq_getElem hne] + rw [List.getLast?_eq_getLast_of_ne_nil hne] at gridPath_last + exact Option.some.inj gridPath_last + +private theorem cyclic_index (gridPath : List GaussianInt) (y : GaussianInt) (x : GaussianInt) + (gridPath_head : gridPath.head? = some x) (gridPath_last : gridPath.getLast? = some y) + (gridPath_length_four : 4 ≤ gridPath.length) (i : Fin ((n gridPath) + 3)) : ((v gridPath + gridPath_length_four) i, (v gridPath gridPath_length_four) (i + 1)) ∈ (cyclicEdges gridPath y + x) := by + classical + let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] + let n := gridPath.length - 3 + have hn : n + 3 = gridPath.length := hn gridPath gridPath_length_four + let v : Fin (n + 3) → GaussianInt := + fun i => gridPath[i.val]'(by rw [← hn]; exact i.isLt) + have successor_val (i : Fin (n + 3)) : + (i + 1).val = if i.val + 1 < n + 3 then i.val + 1 else 0 := successor_val i + have v_head : v 0 = x := v_head gridPath x gridPath_head gridPath_length_four + have v_last : v ⟨n + 2, by omega⟩ = y := v_last gridPath y gridPath_last gridPath_length_four + change ((v i, v (i + 1)) ∈ cyclicEdges) + have hi_bound : i.val < n + 3 := i.isLt + by_cases hi : i.val + 1 < n + 3 + · have hvnext : v (i + 1) = gridPath[i.val + 1]'(by omega) := by + simp only [v, successor_val, ite_eq_left hi] + have hpair : (v i, v (i + 1)) ∈ gridPath.zip gridPath.tail := by + rw [List.mem_iff_getElem] + refine ⟨i.val, ?_, ?_⟩ + · simp only [List.length_zip, List.length_tail]; omega + · rw [List.getElem_zip, List.getElem_tail, hvnext] + exact List.mem_append_left _ hpair + · have hiLast : i = ⟨n + 2, by omega⟩ := by + apply Fin.ext + change i.val = n + 2 + omega + have hnext : i + 1 = 0 := by + apply Fin.ext + simp only [successor_val, ite_eq_right hi, Fin.val_zero] + rw [hnext, hiLast, v_last, v_head] + simp [cyclicEdges] + +private theorem cyclic_rep (gridPath : List GaussianInt) (y : GaussianInt) (x : GaussianInt) + (gridPath_head : gridPath.head? = some x) (gridPath_last : gridPath.getLast? = some y) + (gridPath_length_four : 4 ≤ gridPath.length) (a b : GaussianInt) (hab : (a, b) ∈ (cyclicEdges + gridPath y x)) : ∃ i : Fin ((n gridPath) + 3), a = (v gridPath gridPath_length_four) i ∧ b = + (v gridPath gridPath_length_four) (i + 1) := by + classical + let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] + let n := gridPath.length - 3 + have hn : n + 3 = gridPath.length := hn gridPath gridPath_length_four + let v : Fin (n + 3) → GaussianInt := + fun i => gridPath[i.val]'(by rw [← hn]; exact i.isLt) + have successor_val (i : Fin (n + 3)) : + (i + 1).val = if i.val + 1 < n + 3 then i.val + 1 else 0 := successor_val i + have v_head : v 0 = x := v_head gridPath x gridPath_head gridPath_length_four + have v_last : v ⟨n + 2, by omega⟩ = y := v_last gridPath y gridPath_last gridPath_length_four + change (∃ i : Fin (n + 3), a = v i ∧ b = v (i + 1)) + simp only [List.mem_append, List.mem_singleton] at hab + rcases hab with hab | hab + · rw [List.mem_iff_getElem] at hab + rcases hab with ⟨j, hj, hab⟩ + have hj1 : j + 1 < gridPath.length := by + simp only [List.length_zip, List.length_tail] at hj; omega + rw [List.getElem_zip, List.getElem_tail] at hab + have ha : gridPath[j] = a := congrArg Prod.fst hab + have hb : gridPath[j + 1] = b := congrArg Prod.snd hab + let i : Fin (n + 3) := ⟨j, by omega⟩ + refine ⟨i, ha.symm, ?_⟩ + have hi : i.val + 1 < n + 3 := by dsimp only [i]; omega + simpa only [v, successor_val, ite_eq_left hi, i] using hb.symm + · have hab' : a = y ∧ b = x := Prod.mk.inj hab + refine ⟨⟨n + 2, by omega⟩, hab'.1.trans v_last.symm, ?_⟩ + have hnext : (⟨n + 2, by omega⟩ : Fin (n + 3)) + 1 = 0 := by + apply Fin.ext + simp [successor_val] + rw [hnext, v_head] + exact hab'.2 + +private theorem edge_distinct {n : Nat} (v : Fin (n + 3) → GaussianInt) (v_injective : + Function.Injective v) (i j : Fin (n + 3)) (hij : i ≠ j) : ({v i, v (i + 1)} : Finset + GaussianInt) ≠ {v j, v (j + 1)} := by + classical + intro he + have hi : v i ∈ ({v j, v (j + 1)} : Finset GaussianInt) := by rw [← he]; simp + have hi1 : v (i + 1) ∈ ({v j, v (j + 1)} : Finset GaussianInt) := by + rw [← he]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at hi hi1 + rcases hi with hi | hi + · exact hij (v_injective hi) + · have he1 : i = j + 1 := v_injective hi + rcases hi1 with hi1 | hi1 + · have he2 : i + 1 = j := v_injective hi1 + have hv1 := congrArg Fin.val he1 + have hv2 := congrArg Fin.val he2 + simp only [successor_val] at hv1 hv2 + split_ifs at hv1 hv2 <;> omega + · have he2 : i + 1 = j + 1 := v_injective hi1 + exact hij (add_right_cancel he2) + +private theorem vertex_rational (gridPath : List GaussianInt) (gridPath_length_four : 4 ≤ + gridPath.length) (i : Fin ((n gridPath) + 3)) : ∃ r s : Rat, GaussianRealPoint ((v gridPath + gridPath_length_four) i) = ((r : Real), (s : Real)) := by + classical + let n := gridPath.length - 3 + have hn : n + 3 = gridPath.length := hn gridPath gridPath_length_four + let v : Fin (n + 3) → GaussianInt := + fun i => gridPath[i.val]'(by rw [← hn]; exact i.isLt) + change (∃ r s : Rat, GaussianRealPoint (v i) = ((r : Real), (s : Real))) + refine ⟨((v i).re : Rat), ((v i).im : Rat), ?_⟩ + simp only [GaussianRealPoint, Rat.cast_intCast] + +private theorem point_injective : Function.Injective GaussianRealPoint := by + classical + intro a b hab + apply Zsqrtd.ext + · have h := congrArg Prod.fst hab + change (a.re : Real) = (b.re : Real) at h + exact_mod_cast h + · have h := congrArg Prod.snd hab + change (a.im : Real) = (b.im : Real) at h + exact_mod_cast h + +private theorem v_adj (gridPath : List GaussianInt) (y : GaussianInt) (x : GaussianInt) + (gridPath_head : gridPath.head? = some x) (gridPath_last : gridPath.getLast? = some y) + (gridPath_length_four : 4 ≤ gridPath.length) (cyclic_edge_fourNeighbor : ∀ (a b : + GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail ++ [(y, x)] → + ApollonianSuperharmonic.FourNeighborAdjacent a b) (i : Fin ((n gridPath) + 3)) : + FourNeighborAdjacent ((v gridPath gridPath_length_four) i) ((v gridPath gridPath_length_four) + (i + 1)) := by + classical + let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] + let n := gridPath.length - 3 + have hn : n + 3 = gridPath.length := hn gridPath gridPath_length_four + let v : Fin (n + 3) → GaussianInt := + fun i => gridPath[i.val]'(by rw [← hn]; exact i.isLt) + have cyclic_index (i : Fin (n + 3)) : (v i, v (i + 1)) ∈ cyclicEdges := cyclic_index gridPath y + x gridPath_head gridPath_last gridPath_length_four i + change (FourNeighborAdjacent (v i) (v (i + 1))) + exact cyclic_edge_fourNeighbor _ _ (cyclic_index i) + +private noncomputable abbrev polygon (gridPath : List GaussianInt) (y : GaussianInt) (x : + GaussianInt) (gridPath_head : gridPath.head? = some x) (gridPath_last : gridPath.getLast? = + some y) (gridPath_nodup : gridPath.Nodup) (gridPath_length_four : 4 ≤ gridPath.length) + (cyclic_edge_fourNeighbor : ∀ (a b : GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail ++ + [(y, x)] → ApollonianSuperharmonic.FourNeighborAdjacent a b) : P3381T1PolygonBoundary (n + gridPath) := by + classical + let n := gridPath.length - 3 + have hn : n + 3 = gridPath.length := hn gridPath gridPath_length_four + let v : Fin (n + 3) → GaussianInt := + fun i => gridPath[i.val]'(by rw [← hn]; exact i.isLt) + have v_injective : Function.Injective v := v_injective gridPath gridPath_nodup + gridPath_length_four + have edge_distinct (i j : Fin (n + 3)) (hij : i ≠ j) : + ({v i, v (i + 1)} : Finset GaussianInt) ≠ {v j, v (j + 1)} := edge_distinct v v_injective i + j hij + have vertex_rational (i : Fin (n + 3)) : + ∃ r s : Rat, GaussianRealPoint (v i) = ((r : Real), (s : Real)) := vertex_rational gridPath + gridPath_length_four i + have point_injective : Function.Injective GaussianRealPoint := point_injective + have v_adj (i : Fin (n + 3)) : FourNeighborAdjacent (v i) (v (i + 1)) := v_adj gridPath y x + gridPath_head gridPath_last gridPath_length_four cyclic_edge_fourNeighbor i + change (P3381T1PolygonBoundary n) + exact { + vertex := GaussianRealPoint ∘ v + rational := vertex_rational + injective := point_injective.comp v_injective + edge_intersection := fun i j hij => + P3475T1UnitSegmentIntersection _ _ _ _ (v_adj i) (v_adj j) + (edge_distinct i j hij) } + +end GridBoundaryConstruction + +theorem P3475T1GridBoundary (T : ProtoTile) + (hinside : FourNeighborConnected (T.cells : Set LatticeCell)) + (houtside : FourNeighborConnected ((T.cells : Set LatticeCell)ᶜ)) + (hchecker : NoCheckerboardCellVertex (T.cells : Set LatticeCell)) : + ∃ (n : Nat) (p : P3381T1PolygonBoundary n) + (v : Fin (n + 3) → GaussianInt), + (∀ i, p.vertex i = GaussianRealPoint (v i)) ∧ + (∀ i, FourNeighborAdjacent (v i) (v (i + 1))) ∧ + BoundaryFootprintVertices T = Set.range v ∧ + BoundaryFootprintEdges T = {e | ∃ i, e = {v i, v (i + 1)}} := by +-- BODY + classical + have cells_nonempty : T.cells.Nonempty := GridBoundaryConstruction.cells_nonempty T hinside + have boundary_degree_two : + ∀ v ∈ BoundaryFootprintVertices T, + Set.ncard {e : Finset GaussianInt | + e ∈ BoundaryFootprintEdges T ∧ v ∈ e} = 2 := + GridBoundaryConstruction.boundary_degree_two T hinside hchecker + obtain ⟨gridPath, x, y, z, gridPath_nodup, gridPath_length_four, + gridPath_head, gridPath_last, gridPath_chain, gridPath_close, + gridPath_fourNeighbor, gridPath_close_fourNeighbor, gridPath_zip_fourNeighbor, + gridPath_mem_boundary, hz, hmax, hzout, cyclic_edge_boundary, + cyclic_edge_fourNeighbor, component_edge_cyclic, hrightCyclic⟩ := + P5620T1BoundaryComponentCycle T cells_nonempty boundary_degree_two + have gridPath_length : 3 ≤ gridPath.length := GridBoundaryConstruction.gridPath_length gridPath + gridPath_length_four + have component_index_control := GridRayCrossingIndexAdjacentCell gridPath x y + gridPath_head gridPath_last gridPath_nodup gridPath_length + gridPath_zip_fourNeighbor gridPath_close_fourNeighbor + let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] + have same_vertical_not_boundary (q : LatticeCell) + (hstatus : q ∈ T.cells ↔ q - 1 ∈ T.cells) : + ({q, q + ⟨0, 1⟩} : Finset GaussianInt) ∉ BoundaryFootprintEdges T := + GridBoundaryConstruction.same_vertical_not_boundary T q hstatus + have same_horizontal_not_boundary (q : LatticeCell) + (hstatus : q ∈ T.cells ↔ q - ⟨0, 1⟩ ∈ T.cells) : + ({q, q + 1} : Finset GaussianInt) ∉ BoundaryFootprintEdges T := + GridBoundaryConstruction.same_horizontal_not_boundary T q hstatus + have adjacent_index_same_status (a b : LatticeCell) + (hs : a ∈ T.cells ↔ b ∈ T.cells) (hab : FourNeighborAdjacent a b) : + GridRayCrossingIndex a gridPath = GridRayCrossingIndex b gridPath := + GridBoundaryConstruction.adjacent_index_same_status T gridPath y x cyclic_edge_boundary + gridPath_head gridPath_last gridPath_nodup gridPath_zip_fourNeighbor + gridPath_close_fourNeighbor gridPath_length_four a b hs hab + have index_constant (S : Set LatticeCell) (hS : FourNeighborConnected S) + (I : LatticeCell → Int) + (hstep : ∀ a, a ∈ S → ∀ b, b ∈ S → + FourNeighborAdjacent a b → I a = I b) + (x : LatticeCell) (hx : x ∈ S) (y : LatticeCell) (hy : y ∈ S) : + I x = I y := GridBoundaryConstruction.index_constant S hS I hstep x hx y hy + obtain ⟨w, hw, hmin⟩ := (T.cells ∪ gridPath.toFinset).exists_min_image + (fun q => q.re) (by + obtain ⟨a, ha⟩ := cells_nonempty + exact ⟨a, Finset.mem_union_left _ ha⟩) + let q0 : LatticeCell := ⟨w.re - 1, 0⟩ + have q0_outside : q0 ∉ T.cells := GridBoundaryConstruction.q0_outside T gridPath w hmin + have path_left (a : GaussianInt) (ha : a ∈ gridPath) : q0.re < a.re := + GridBoundaryConstruction.path_left T gridPath w hmin a ha + let step : GaussianInt → GaussianInt → Int := fun a b => + if b = a + ⟨0, 1⟩ ∧ a.im = q0.im ∧ a.re ≤ q0.re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = q0.im ∧ a.re ≤ q0.re then -1 else 0 + have step_zero (a : GaussianInt) (ha : a ∈ gridPath) (b : GaussianInt) : + step a b = 0 := GridBoundaryConstruction.step_zero T gridPath w hmin a ha b + have zip_zero (r s : List GaussianInt) (hr : ∀ a ∈ r, a ∈ gridPath) : + (List.zipWith step r s).sum = 0 := GridBoundaryConstruction.zip_zero T gridPath w hmin r s hr + have q0_index_zero : GridRayCrossingIndex q0 gridPath = 0 := + GridBoundaryConstruction.q0_index_zero T gridPath y x gridPath_head gridPath_last w hmin + have unoccupied_index_zero (q : LatticeCell) (hq : q ∉ T.cells) : + GridRayCrossingIndex q gridPath = 0 := GridBoundaryConstruction.unoccupied_index_zero T + houtside gridPath y x cyclic_edge_boundary gridPath_head gridPath_last gridPath_nodup + gridPath_zip_fourNeighbor gridPath_close_fourNeighbor w gridPath_length_four hmin q hq + have hrightJump : + Int.natAbs (GridRayCrossingIndex (z + 1) gridPath - + GridRayCrossingIndex z gridPath) = 1 := GridBoundaryConstruction.hrightJump gridPath y x + gridPath_head gridPath_last gridPath_nodup gridPath_zip_fourNeighbor + gridPath_close_fourNeighbor z gridPath_length_four hrightCyclic + have hzIndexNonzero : GridRayCrossingIndex z gridPath ≠ 0 := + GridBoundaryConstruction.hzIndexNonzero T houtside gridPath y x cyclic_edge_boundary + gridPath_head gridPath_last gridPath_nodup gridPath_zip_fourNeighbor + gridPath_close_fourNeighbor z w gridPath_length_four hrightCyclic hzout hmin + have occupied_index_nonzero (q : LatticeCell) (hq : q ∈ T.cells) : + GridRayCrossingIndex q gridPath ≠ 0 := GridBoundaryConstruction.occupied_index_nonzero T + hinside houtside gridPath y x cyclic_edge_boundary gridPath_head gridPath_last + gridPath_nodup gridPath_zip_fourNeighbor gridPath_close_fourNeighbor z w + gridPath_length_four hrightCyclic hzout hz hmin q hq + have boundary_edge_cyclic (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) : + ∃ a b : GaussianInt, e = {a, b} ∧ + ((a, b) ∈ cyclicEdges ∨ (b, a) ∈ cyclicEdges) := + GridBoundaryConstruction.boundary_edge_cyclic T hinside houtside gridPath y x + cyclic_edge_boundary gridPath_head gridPath_last gridPath_nodup + gridPath_zip_fourNeighbor gridPath_close_fourNeighbor z w gridPath_length_four + hrightCyclic hzout hz hmin e he + have zip_mem_decompose (a b : GaussianInt) + (hab : (a, b) ∈ gridPath.zip gridPath.tail) : + ∃ l₁ l₂ : List GaussianInt, gridPath = l₁ ++ a :: b :: l₂ := + GridBoundaryConstruction.zip_mem_decompose gridPath gridPath_length_four a b hab + have cyclic_endpoints_mem (a b : GaussianInt) (hab : (a, b) ∈ cyclicEdges) : + a ∈ gridPath ∧ b ∈ gridPath := GridBoundaryConstruction.cyclic_endpoints_mem gridPath y x + gridPath_head gridPath_last gridPath_length_four a b hab + have boundary_vertices_eq : + BoundaryFootprintVertices T = (gridPath.toFinset : Set GaussianInt) := + GridBoundaryConstruction.boundary_vertices_eq T hinside houtside gridPath y x + cyclic_edge_boundary gridPath_mem_boundary gridPath_head gridPath_last gridPath_nodup + gridPath_zip_fourNeighbor gridPath_close_fourNeighbor z w gridPath_length_four + hrightCyclic hzout hz hmin + let n := gridPath.length - 3 + have hn : n + 3 = gridPath.length := GridBoundaryConstruction.hn gridPath gridPath_length_four + let v : Fin (n + 3) → GaussianInt := + fun i => gridPath[i.val]'(by rw [← hn]; exact i.isLt) + have v_injective : Function.Injective v := GridBoundaryConstruction.v_injective gridPath + gridPath_nodup gridPath_length_four + have successor_val (i : Fin (n + 3)) : + (i + 1).val = if i.val + 1 < n + 3 then i.val + 1 else 0 := + GridBoundaryConstruction.successor_val i + have v_head : v 0 = x := GridBoundaryConstruction.v_head gridPath x gridPath_head + gridPath_length_four + have v_last : v ⟨n + 2, by omega⟩ = y := GridBoundaryConstruction.v_last gridPath y + gridPath_last gridPath_length_four + have cyclic_index (i : Fin (n + 3)) : (v i, v (i + 1)) ∈ cyclicEdges := + GridBoundaryConstruction.cyclic_index gridPath y x gridPath_head gridPath_last + gridPath_length_four i + have cyclic_rep (a b : GaussianInt) (hab : (a, b) ∈ cyclicEdges) : + ∃ i : Fin (n + 3), a = v i ∧ b = v (i + 1) := GridBoundaryConstruction.cyclic_rep gridPath + y x gridPath_head gridPath_last gridPath_length_four a b hab + have edge_distinct (i j : Fin (n + 3)) (hij : i ≠ j) : + ({v i, v (i + 1)} : Finset GaussianInt) ≠ {v j, v (j + 1)} := + GridBoundaryConstruction.edge_distinct v v_injective + i j hij + have vertex_rational (i : Fin (n + 3)) : + ∃ r s : Rat, GaussianRealPoint (v i) = ((r : Real), (s : Real)) := + GridBoundaryConstruction.vertex_rational gridPath gridPath_length_four i + have point_injective : Function.Injective GaussianRealPoint := + GridBoundaryConstruction.point_injective + have v_adj (i : Fin (n + 3)) : FourNeighborAdjacent (v i) (v (i + 1)) := + GridBoundaryConstruction.v_adj gridPath y x gridPath_head gridPath_last + gridPath_length_four cyclic_edge_fourNeighbor i + let polygon : P3381T1PolygonBoundary n := + { vertex := GaussianRealPoint ∘ v + rational := vertex_rational + injective := point_injective.comp v_injective + edge_intersection := fun i j hij => + P3475T1UnitSegmentIntersection _ _ _ _ (v_adj i) (v_adj j) + (edge_distinct i j hij) } + refine ⟨n, polygon, v, fun _ => rfl, v_adj, ?_, ?_⟩ + · rw [boundary_vertices_eq] + ext a + simp only [Finset.mem_coe, List.mem_toFinset, Set.mem_range] + constructor + · intro ha + rcases List.mem_iff_getElem.mp ha with ⟨i, hi, hia⟩ + exact ⟨⟨i, by omega⟩, hia⟩ + · rintro ⟨i, rfl⟩ + exact List.getElem_mem (by rw [← hn]; exact i.isLt) + · ext e + constructor + · intro he + rcases boundary_edge_cyclic e he with ⟨a, b, he, hab | hab⟩ + · obtain ⟨i, rfl, rfl⟩ := cyclic_rep a b hab + exact ⟨i, he⟩ + · obtain ⟨i, rfl, rfl⟩ := cyclic_rep b a hab + exact ⟨i, he.trans (Finset.pair_comm _ _)⟩ + · rintro ⟨i, rfl⟩ + exact cyclic_edge_boundary _ _ (cyclic_index i) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1PolygonTriangleConstruction.lean b/LeanPool/ApollonianSuperharmonic/P3475T1PolygonTriangleConstruction.lean new file mode 100644 index 0000000000..a991b9c662 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3475T1PolygonTriangleConstruction.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3475T1TriangleTree +public import LeanPool.ApollonianSuperharmonic.P3511T1SourceConstruction +public import LeanPool.ApollonianSuperharmonic.P3511T1ConvexComparison +public import LeanPool.ApollonianSuperharmonic.P3511T1LeafOrder +public import LeanPool.ApollonianSuperharmonic.P3511T1AttachmentIntersection + +-- [TABLET NODE: P3475T1PolygonTriangleConstruction] + +/-! +# P3475T1PolygonTriangleConstruction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3475T1PolygonTriangleConstruction {n : Nat} + (p : P3381T1PolygonBoundary n) + (hcorner : ∀ i : Fin (n + 3), + P3381T1TriangleDeterminant (fun j : Fin 3 => + p.vertex (i + ⟨j.val, Nat.lt_of_lt_of_le j.isLt (Nat.le_add_left 3 n)⟩)) ≠ 0) : + ∃ X K : Set (Real × Real), Nonempty (P3475T1TriangleTree p X K) := by +-- BODY + obtain ⟨X, ⟨s⟩⟩ := P3511T1SourceConstruction p hcorner + obtain ⟨K, ⟨t⟩⟩ := P3511T1ConvexComparison s + obtain ⟨order, horder⟩ := P3511T1LeafOrder s + refine ⟨X, K, ⟨{ + target := t.target + target_injective := t.target_injective + target_edge_intersection := t.target_edge_intersection + count := s.count + face := s.face + face_injective := s.face_injective + face_distinct := s.face_distinct + vertex_used := s.vertex_used + source_nondegenerate := s.nondegenerate + target_nondegenerate := t.target_nondegenerate + source_cover := s.cover + target_cover := t.target_cover + source_intersection := s.intersection + target_intersection := t.target_intersection + edge_count := s.edge_count + target_hull := t.target_hull + target_convex := t.target_convex + target_closed := t.target_closed + target_bounded := t.target_bounded + target_interior := t.target_interior + target_frontier := t.target_frontier + count_pos := s.count_pos + order := order + attachment := ?_ + }⟩⟩ + intro k hk + obtain ⟨a, b, c, hab, hac, hbc, hf, hn, he⟩ := horder k hk + refine ⟨a, b, c, hab, hac, hbc, hf, hn, he, ?_, ?_⟩ + · exact P3511T1AttachmentIntersection p.vertex s.face s.intersection + order k a b c hf hn he + · exact P3511T1AttachmentIntersection t.target s.face t.target_intersection + order k a b c hf hn he + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1PolygonalSeparation.lean b/LeanPool/ApollonianSuperharmonic/P3475T1PolygonalSeparation.lean new file mode 100644 index 0000000000..4a656e85c4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3475T1PolygonalSeparation.lean @@ -0,0 +1,792 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3475T1TriangleTree +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangulationBoundary +public import LeanPool.ApollonianSuperharmonic.P5662T1TriangulationBarycentricCoordinates +public import LeanPool.ApollonianSuperharmonic.P3381T1PiecewiseAffinePolygonModel +public import LeanPool.ApollonianSuperharmonic.P3381T1AffineTriangleMap +public import Mathlib.Analysis.Convex.PathConnected +public import Mathlib.Analysis.Convex.Topology +public import Mathlib.Topology.Connected.Clopen + +-- [TABLET NODE: P3475T1PolygonalSeparation] + +/-! +# P3475T1PolygonalSeparation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PolygonalSeparationProof + +private theorem hintpath : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set + (Real × Real)), (P3475T1TriangleTree p X K) → (∀ (h : (↑X : Type) ≃ₜ (↑K : Type)), + (∀ x : X, ((x : Real × Real) ∈ interior X) ↔ ((h x : Real × Real) ∈ interior K)) → + (IsPathConnected (interior X))) + ) := by + classical + intro n p X K t h hiff + let S : Set X := {x | (x : Real × Real) ∈ interior X} + let T : Set K := {y | (y : Real × Real) ∈ interior K} + let H : S ≃ₜ T := h.subtype hiff + have hKconv : Convex Real (interior K) := t.target_convex.interior + have hKne : (interior K).Nonempty := t.target_interior + have himageT : (Subtype.val '' T) = interior K := by + ext y + constructor + · rintro ⟨z, hz, rfl⟩ + exact hz + · intro hy + exact ⟨⟨y, interior_subset hy⟩, hy, rfl⟩ + have hTp : IsPathConnected T := by + apply (Topology.IsInducing.isPathConnected_iff (f := Subtype.val) + (hf := Topology.IsInducing.subtypeVal) (F := T)).mpr + rw [himageT] + exact hKconv.isPathConnected hKne + have hSp : IsPathConnected S := by + have hTspace : PathConnectedSpace T := isPathConnected_iff_pathConnectedSpace.mp hTp + have hunivT : IsPathConnected (Set.univ : Set T) := pathConnectedSpace_iff_univ.mp hTspace + have hunivS : IsPathConnected (Set.univ : Set S) := by + simpa [Set.image_univ, H.symm.surjective.range_eq] using + H.symm.isPathConnected_image.mpr hunivT + have hSspace : PathConnectedSpace S := pathConnectedSpace_iff_univ.mpr hunivS + exact isPathConnected_iff_pathConnectedSpace.mpr hSspace + have himg : (Subtype.val '' S) = interior X := by + ext x + constructor + · rintro ⟨y, hy, rfl⟩ + exact hy + · intro hx + exact ⟨⟨x, interior_subset hx⟩, hx, rfl⟩ + rw [← himg] + exact (Topology.IsInducing.isPathConnected_iff (f := Subtype.val) + (hf := Topology.IsInducing.subtypeVal) (F := S)).mp hSp + +private theorem bcombo : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set + (Real × Real)), ∀ (t : P3475T1TriangleTree p X K), ∀ (b : Fin t.count → ℝ × ℝ → Fin + (3 : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), ∑ j : Fin (3 : ℕ), b k z j = (1 : + ℝ)) → ((∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), ∑ j : Fin (3 : ℕ), b k z j • p.vertex + (t.face k j) = z) → ((∀ (k : Fin t.count), ∀ (w : Fin (3 : ℕ) → ℝ), ∑ j : Fin (3 : + ℕ), w j = (1 : ℝ) → b k (∑ j : Fin (3 : ℕ), w j • p.vertex (t.face k j)) = w) → (∀ + {ι : Type}, ∀ [inst : Fintype ι], ∀ (k : Fin t.count), ∀ (w : ι → ℝ), ∀ (f : ι → ℝ × + ℝ), ∑ r : ι, w r = (1 : ℝ) → ∀ (j : Fin (3 : ℕ)), b k (∑ r : ι, w r • f r) j = ∑ r : + ι, w r * b k (f r) j))) + ) := by + classical + intro n p X K t b bsum breconstruct bunique ι typeclassInstance0 k w f hw j + let W : Fin 3 → Real := fun j => ∑ r, w r * b k (f r) j + have hW : (∑ j, W j) = 1 := by + simp only [W] + rw [Finset.sum_comm] + simp_rw [← Finset.mul_sum, bsum, mul_one] + exact hw + have hWz : (∑ j, W j • p.vertex (t.face k j)) = ∑ r, w r • f r := by + simp only [W, Finset.sum_smul] + rw [Finset.sum_comm] + simp_rw [mul_smul, ← Finset.smul_sum, breconstruct] + have h := bunique k W hW + rw [hWz] at h + exact congrFun h j + +private theorem contains : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set + (Real × Real)), ∀ (t : P3475T1TriangleTree p X K), ∀ (i : Fin (n + (3 : ℕ))), ∀ (u + : ℝ), (0 < u) → ((u < 1) → (∀ (b : Fin t.count → ℝ × ℝ → Fin (3 : ℕ) → ℝ), (∀ (k : + Fin t.count), ∀ (l : Fin t.count), ∀ z ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (p.vertex '' (Set.range (t.face k) ∩ Set.range (t.face l))), ∀ (j : Fin (3 : ℕ)), + t.face k j ∉ Set.range (t.face l) → b k z j = (0 : ℝ)) → ( + let D (k : Fin t.count) := + convexHull Real (Set.range (p.vertex ∘ t.face k)) + let I : Set (Fin t.count) := {k | i ∈ Set.range (t.face k) ∧ + i + 1 ∈ Set.range (t.face k)} + ∀ (k : Fin t.count), ∀ (a : Fin (3 : ℕ)), (t.face k a = i) → (∀ (d : Fin (3 : ℕ)), + (t.face k d = i + (1 : Fin (n + (3 : ℕ)))) → ( + let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex (i + 1) + (b k z a = 1 - u) → ((b k z d = u) → ((z ∈ D k) → (∀ (l : Fin t.count), z ∈ D l → l ∈ + I)))))))) + ) := by + classical + intro n p X K t i u hu0' hu1' b bcommon D I k a ha d hd z hza hzd hzDk l hzl + have hcommon : z ∈ convexHull Real + (p.vertex '' (Set.range (t.face k) ∩ Set.range (t.face l))) := by + rw [← t.source_intersection] + exact ⟨hzDk, hzl⟩ + constructor + · by_contra hi + have hz0 := bcommon k l z hcommon a (by + intro hface + obtain ⟨m, hm⟩ := hface + exact hi ⟨m, hm.trans ha⟩) + rw [hza] at hz0 + linarith + · by_contra hj + have hz0 := bcommon k l z hcommon d (by + intro hface + obtain ⟨m, hm⟩ := hface + exact hj ⟨m, hm.trans hd⟩) + rw [hzd] at hz0 + linarith + +private theorem hlocalchar : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set + (Real × Real)), ∀ (t : P3475T1TriangleTree p X K), ∀ (i : Fin (n + (3 : ℕ))), ∀ (u + : ℝ), ∀ (b : Fin t.count → ℝ × ℝ → Fin (3 : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (z : ℝ × + ℝ), z ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (Set.range (p.vertex ∘ t.face k)) + ↔ ∀ (j : Fin (3 : ℕ)), (0 : ℝ) ≤ b k z j) → ( + let D (k : Fin t.count) := + convexHull Real (Set.range (p.vertex ∘ t.face k)) + (∀ (a : Fin 3), ∀ (d : Fin 3), ∀ (c : Fin 3), (a ≠ d) → ((a ≠ c) → ((d ≠ c) → (∀ (j : Fin + 3), j = a ∨ j = d ∨ j = c)))) → (∀ (k : Fin t.count), ∀ (a : Fin (3 : ℕ)), (t.face k + a = i) → (∀ (d : Fin (3 : ℕ)), (t.face k d = i + (1 : Fin (n + (3 : ℕ)))) → ((a ≠ d) + → (∀ (c : Fin (3 : ℕ)), (a ≠ c) → ((d ≠ c) → ((p.vertex i = p.vertex (t.face k a)) → + ((p.vertex (i + 1) = p.vertex (t.face k d)) → (((1 - u) • p.vertex i + u • p.vertex + (i + 1) = (1 - u) • p.vertex (t.face k a) + u • p.vertex (t.face k d)) → ((b k ((1 - + u) • p.vertex i + u • p.vertex (i + 1)) a = 1 - u) → ((b k ((1 - u) • p.vertex i + u + • p.vertex (i + 1)) d = u) → ((b k ((1 - u) • p.vertex i + u • p.vertex (i + 1)) c = + 0) → ( + let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex (i + 1) + (b k z a = 1 - u) → ((b k z d = u) → ((b k z c = 0) → ( + let N : Set (Real × Real) := ⋂ l, + if l = k then Set.univ else (D l)ᶜ + let Q : Set (Real × Real) := N ∩ {y | 0 < b k y a ∧ 0 < b k y d} + (IsOpen Q) → ((z ∈ Q) → (∀ (r : ℝ), (Metric.ball z r ⊆ Q) → (∀ y ∈ Metric.ball z r, y ∈ X + ↔ (0 : ℝ) ≤ b k y c))))))))))))))))))) + ) := by + classical + intro n p X K t i u b bhull D indices k a ha d hd had c hac hdc hvA hvD hpoint hzcoordA + hzcoordD hzcoordC z hza hzd hzc N Q hQopen hzQ r hball y hy + have hyQ := hball hy + constructor + · intro hyX + rw [t.source_cover] at hyX + obtain ⟨l, hyl⟩ := Set.mem_iUnion.mp hyX + have hlk : l = k := by + by_contra hl + have hnot := (Set.mem_iInter.mp hyQ.1) l + simp only [hl, ite_false] at hnot + exact hnot hyl + have hyk : y ∈ D k := by simpa [D, hlk] using hyl + exact (bhull k y).mp hyk c + · intro hyc + rw [t.source_cover] + refine Set.mem_iUnion.mpr ⟨k, ?_⟩ + apply (bhull k y).mpr + intro j + have hpos := hyQ.2 + rcases indices a d c had hac hdc j with rfl | rfl | rfl + · exact hpos.1.le + · exact hpos.2.le + · exact hyc + +private theorem hhalf : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set + (Real × Real)), ∀ (t : P3475T1TriangleTree p X K), ∀ (u : ℝ), (0 < u) → ((u < 1) → + (∀ (b : Fin t.count → ℝ × ℝ → Fin (3 : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (x : Real × + Real), ∀ (y : Real × Real), ∀ (a : Real), ∀ (d : Real), (a + d = 1) → (∀ (j : Fin 3), + b k (a • x + d • y) j = a * b k x j + d * b k y j)) → (∀ (k : Fin t.count), ∀ (c : + Fin (3 : ℕ)), Convex Real {y : Real × Real | b k y c < 0}))) + ) := by + classical + intro n p X K t u hu0' hu1' b blinear k c x hx y hy a' d' ha' hd' had' + change b k (a' • x + d' • y) c < 0 + rw [blinear k x y a' d' had' c] + by_contra hnot + have hnonneg : 0 ≤ a' * b k x c + d' * b k y c := le_of_not_gt hnot + by_cases ha0 : a' = 0 + · have hdpos : 0 < d' := by rw [ha0, zero_add] at had'; linarith + have hterm : d' * b k y c < 0 := mul_neg_of_pos_of_neg hdpos hy + simp [ha0] at hnonneg + linarith + · have hapos : 0 < a' := lt_of_le_of_ne ha' (Ne.symm ha0) + have hterm : a' * b k x c < 0 := mul_neg_of_pos_of_neg hapos hx + have hother : d' * b k y c ≤ 0 := mul_nonpos_of_nonneg_of_nonpos hd' hy.le + linarith + +private theorem hCpre : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) + IsPreconnected C + ) := by + classical + intro n p C + let edge : Fin (n + 3) → Set (Real × Real) := fun i => + segment Real (p.vertex i) (p.vertex (i + 1)) + have hedges : (⋃ i, edge i) = C := by rfl + have hpre : ∀ i, IsPreconnected (edge i) := by + intro i + exact (convex_segment (p.vertex i) (p.vertex (i + 1))).isPreconnected + let R : Fin (n + 3) → Fin (n + 3) → Prop := fun i j => (edge i ∩ edge j).Nonempty + have hstep : ∀ i, R i (i + 1) := by + intro i + refine ⟨p.vertex (i + 1), ?_, ?_⟩ + · change p.vertex (i + 1) ∈ segment Real (p.vertex i) (p.vertex (i + 1)) + exact right_mem_segment Real (p.vertex i) (p.vertex (i + 1)) + · change p.vertex (i + 1) ∈ segment Real (p.vertex (i + 1)) (p.vertex ((i + 1) + 1)) + exact left_mem_segment Real (p.vertex (i + 1)) (p.vertex ((i + 1) + 1)) + have hRsymm : ∀ i j, R i j → R j i := by + intro i j h + obtain ⟨x, hxi, hxj⟩ := h + exact ⟨x, hxj, hxi⟩ + have hreachSymm : ∀ i j, Relation.ReflTransGen R i j → + Relation.ReflTransGen R j i := by + intro i j hij + induction hij with + | refl => exact Relation.ReflTransGen.refl + | @tail k l hkl hstep ih => + exact (Relation.ReflTransGen.single (hRsymm k l hstep)).trans ih + have hreach : ∀ k : Nat, ∀ hk : k < n + 3, + Relation.ReflTransGen R (0 : Fin (n + 3)) ⟨k, hk⟩ := by + intro k + induction k with + | zero => + intro hk + exact Relation.ReflTransGen.refl + | succ k ih => + intro hk + have hk' : k < n + 3 := Nat.lt_trans (Nat.lt_succ_self k) hk + let i : Fin (n + 3) := ⟨k, hk'⟩ + let j : Fin (n + 3) := ⟨k + 1, hk⟩ + have hij : i + 1 = j := by + apply Fin.ext + change (k + 1) % (n + 3) = k + 1 + exact Nat.mod_eq_of_lt hk + have hr := ih hk' + have hrel : R i j := hij ▸ hstep i + simpa [i, j] using hr.tail hrel + have hconn : ∀ i j : Fin (n + 3), Relation.ReflTransGen R i j := by + intro i j + have hi := hreach i.val i.isLt + have hj := hreach j.val j.isLt + have hi' : Relation.ReflTransGen R (0 : Fin (n + 3)) i := by simpa using hi + have hj' : Relation.ReflTransGen R (0 : Fin (n + 3)) j := by simpa using hj + exact (hreachSymm _ _ hi').trans hj' + rw [← hedges] + exact IsPreconnected.iUnion_of_reflTransGen hpre hconn + +private theorem hVpre : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) + (frontier X = C) → ((IsOpen Xᶜ) → ((∀ x, x ∈ frontier X → ∃ N : Set (Real × Real), IsOpen + N ∧ x ∈ N ∧ IsPreconnected (N \ X)) → ((IsPreconnected C) → (IsPreconnected Xᶜ)))) + ) := by + classical + intro n p X C hfrontierC hopenV hlocalAll hCpre + apply isPreconnected_iff_subset_of_disjoint.mpr + intro u v hu hv hcoverUV hdisjUV + by_contra hnot + simp only [not_or, Set.not_subset] at hnot + obtain ⟨⟨x, hx, hxnot⟩, ⟨y, hy, hynot⟩⟩ := hnot + have hxv : x ∈ v := (hcoverUV hx).resolve_left hxnot + have hyu : y ∈ u := (hcoverUV hy).resolve_right hynot + let U := Xᶜ ∩ u + let V := Xᶜ ∩ v + have hcov : U ∪ V = Xᶜ := by + apply Set.Subset.antisymm + · rintro z (hz | hz) <;> exact hz.1 + · intro z hz + rcases hcoverUV hz with hzu | hzv + · exact Or.inl ⟨hz, hzu⟩ + · exact Or.inr ⟨hz, hzv⟩ + have hd : Disjoint U V := by + apply Set.disjoint_left.mpr + rintro z ⟨hz, hzu⟩ ⟨_, hzv⟩ + have hmem : z ∈ Xᶜ ∩ (u ∩ v) := ⟨hz, hzu, hzv⟩ + rw [hdisjUV] at hmem + exact hmem + have hU : IsOpen U := hopenV.inter hu + have hV : IsOpen V := hopenV.inter hv + have hneU : U.Nonempty := ⟨y, hy, hyu⟩ + have hneV : V.Nonempty := ⟨x, hx, hxv⟩ + have hsubU : U ⊆ Xᶜ := fun _ hz => hz.1 + have hsubV : V ⊆ Xᶜ := fun _ hz => hz.1 + have hclU : closure U ⊆ Vᶜ := + closure_minimal (Set.disjoint_left.mp hd) hV.isClosed_compl + have hclV : closure V ⊆ Uᶜ := + closure_minimal (Set.disjoint_left.mp hd.symm) hU.isClosed_compl + have hseparate : frontier X ∩ (closure U ∩ closure V) = ∅ := by + apply Set.eq_empty_iff_forall_notMem.mpr + rintro z ⟨hz, hzU, hzV⟩ + obtain ⟨N, hN, hzN, hcN⟩ := hlocalAll z hz + have hNc : N \ X ⊆ U ∪ V := by + intro q hq + rw [hcov] + exact hq.2 + have hNd : (N \ X) ∩ (U ∩ V) = ∅ := by + apply Set.eq_empty_iff_forall_notMem.mpr + rintro q ⟨_, hqU, hqV⟩ + exact (Set.disjoint_left.mp hd) hqU hqV + rcases isPreconnected_iff_subset_of_disjoint.mp hcN U V hU hV hNc hNd with h | h + · obtain ⟨q, hqN, hqV⟩ := mem_closure_iff.mp hzV N hN hzN + exact (Set.disjoint_left.mp hd) (h ⟨hqN, hsubV hqV⟩) hqV + · obtain ⟨q, hqN, hqU⟩ := mem_closure_iff.mp hzU N hN hzN + exact (Set.disjoint_left.mp hd) hqU (h ⟨hqN, hsubU hqU⟩) + have hfrontcover : frontier X ⊆ closure U ∪ closure V := by + rw [← closure_union, hcov, ← frontier_compl] + exact frontier_subset_closure + have hfrontUsub : frontier U ⊆ frontier X := by + intro z hz + have hzcl : z ∈ closure Xᶜ := closure_mono hsubU (frontier_subset_closure hz) + have hznot : z ∉ Xᶜ := by + intro he + have he' : z ∈ U ∪ V := by rw [hcov]; exact he + rcases he' with hzu | hzv + · exact hz.2 (hU.interior_eq.symm ▸ hzu) + · exact hclU (frontier_subset_closure hz) hzv + rw [← frontier_compl, frontier, hopenV.interior_eq] + exact ⟨hzcl, hznot⟩ + have hfrontVsub : frontier V ⊆ frontier X := by + intro z hz + have hzcl : z ∈ closure Xᶜ := closure_mono hsubV (frontier_subset_closure hz) + have hznot : z ∉ Xᶜ := by + intro he + have he' : z ∈ U ∪ V := by rw [hcov]; exact he + rcases he' with hzu | hzv + · exact hclV (frontier_subset_closure hz) hzu + · exact hz.2 (hV.interior_eq.symm ▸ hzv) + rw [← frontier_compl, frontier, hopenV.interior_eq] + exact ⟨hzcl, hznot⟩ + have hnotU : U ≠ Set.univ := by + intro he + obtain ⟨z, hz⟩ := hneV + exact (Set.disjoint_left.mp hd) (he.symm ▸ Set.mem_univ z) hz + have hnotV : V ≠ Set.univ := by + intro he + obtain ⟨z, hz⟩ := hneU + exact (Set.disjoint_left.mp hd) hz (he.symm ▸ Set.mem_univ z) + have hfrontcoverC : C ⊆ closure U ∪ closure V := by + simpa only [hfrontierC] using hfrontcover + have hseparateC : C ∩ (closure U ∩ closure V) = ∅ := by + simpa only [hfrontierC] using hseparate + rcases isPreconnected_iff_subset_of_disjoint_closed.mp hCpre + (closure U) (closure V) isClosed_closure isClosed_closure + hfrontcoverC hseparateC with h | h + · obtain ⟨z, hz⟩ := nonempty_frontier_iff.mpr ⟨hneV, hnotV⟩ + have hzX := hfrontVsub hz + have hzC : z ∈ C := by rw [← hfrontierC]; exact hzX + have hbad : z ∈ C ∩ (closure U ∩ closure V) := + ⟨hzC, h hzC, frontier_subset_closure hz⟩ + rw [hseparateC] at hbad + exact hbad + · obtain ⟨z, hz⟩ := nonempty_frontier_iff.mpr ⟨hneU, hnotU⟩ + have hzX := hfrontUsub hz + have hzC : z ∈ C := by rw [← hfrontierC]; exact hzX + have hbad : z ∈ C ∩ (closure U ∩ closure V) := + ⟨hzC, frontier_subset_closure hz, h hzC⟩ + rw [hseparateC] at hbad + exact hbad + +private theorem hfrontU : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set + (Real × Real)), (P3475T1TriangleTree p X K) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) + (frontier X = C) → (∀ [IsClosed X], ∀ (h : (↑X : Type) ≃ₜ (↑K : Type)), (∀ x : + X, ((x : Real × Real) ∈ interior X) ↔ ((h x : Real × Real) ∈ interior K)) → (frontier + (interior X) = C))) + ) := by + classical + intro n p X K t C hfrontierC hclosed h hiff + have himageS : + (h '' {x : X | (x : Real × Real) ∈ interior X}) = + {y : K | (y : Real × Real) ∈ interior K} := by + ext y + constructor + · rintro ⟨x, hx, rfl⟩ + exact (hiff x).mp hx + · intro hy + refine ⟨h.symm y, ?_, h.apply_symm_apply y⟩ + exact (hiff (h.symm y)).mpr (by simpa using hy) + let S : Set X := {x | (x : Real × Real) ∈ interior X} + let T : Set K := {y | (y : Real × Real) ∈ interior K} + have himageT : (Subtype.val '' T) = interior K := by + ext y + constructor + · rintro ⟨z, hz, rfl⟩ + exact hz + · intro hy + exact ⟨⟨y, interior_subset hy⟩, hy, rfl⟩ + have hKreg : closure (interior K) = K := by + rw [t.target_convex.closure_interior_eq_closure_of_nonempty_interior t.target_interior, + t.target_closed.closure_eq] + have hTdense : closure T = Set.univ := by + ext y + rw [closure_subtype, himageT, hKreg] + constructor + · intro _ + exact Set.mem_univ _ + · intro _ + exact y.property + have hSdense : closure S = Set.univ := by + apply Set.eq_univ_iff_forall.mpr + intro x + have hx : h x ∈ h '' closure S := by + rw [h.image_closure S, himageS, hTdense] + exact Set.mem_univ _ + obtain ⟨y, hy, hyx⟩ := hx + have : y = x := h.injective hyx + simpa [this] using hy + have himageSval : (Subtype.val '' S) = interior X := by + ext x + constructor + · rintro ⟨y, hy, rfl⟩ + exact hy + · intro hx + exact ⟨⟨x, interior_subset hx⟩, hx, rfl⟩ + have hXdense : X ⊆ closure (interior X) := by + intro x hx + have hxS : (⟨x, hx⟩ : X) ∈ closure S := by rw [hSdense]; exact Set.mem_univ _ + rw [closure_subtype, himageSval] at hxS + exact hxS + have hreg : closure (interior X) = X := by + apply Set.Subset.antisymm + · exact closure_minimal interior_subset hclosed + · exact hXdense + simpa [frontier, hreg, interior_interior, hclosed.closure_eq] using hfrontierC + +private theorem hX : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) + (frontier X = C) → (∀ [IsClosed X], X = interior X ∪ C) + ) := by + classical + intro n p X C hfrontierC hclosed + ext z + rw [← hfrontierC] + constructor + · intro hzX + by_cases hzI : z ∈ interior X + · exact Or.inl hzI + · exact Or.inr ⟨by rw [hclosed.closure_eq]; exact hzX, hzI⟩ + · rintro (hzI | hzF) + · exact interior_subset hzI + · exact hclosed.frontier_subset hzF + +end PolygonalSeparationProof + +namespace PolygonalSeparationDetails + +private theorem hiff : + (by + classical + exact + ∀ (X : Set (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (h : (↑X : Type) ≃ₜ (↑K : Type)), + (∀ (x : (↑X : Type)), (↑x : ℝ × ℝ) ∈ frontier X ↔ (↑((h : (↑X : Type) → (↑K : Type)) + x) : ℝ × ℝ) ∈ frontier K) → (∀ x : X, ((x : Real × Real) ∈ interior X) ↔ ((h x : Real + × Real) ∈ interior K)) ) := by + classical + intro X K h hboundary x + rw [mem_interior_iff_notMem_frontier x.property, + mem_interior_iff_notMem_frontier (h x).property] + exact not_congr (hboundary x) + +private theorem hlocalAll : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set + (Real × Real)), ∀ (t : P3475T1TriangleTree p X K), + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) + (∀ (i : Fin (n + (3 : ℕ))), ∃ (r : ℝ), (0 : ℝ) < r ∧ (∀ z ∈ Metric.ball (p.vertex i) r, z + ∈ X ↔ ∃ (k : Fin t.count), i ∈ Set.range (t.face k) ∧ ∃ (w : Fin (3 : ℕ) → ℝ), (∀ (j + : Fin (3 : ℕ)), (0 : ℝ) ≤ w j) ∧ z = p.vertex i + ∑ j : Fin (3 : ℕ), w j • (p.vertex + (t.face k j) - p.vertex i)) ∧ IsPathConnected (Metric.ball (p.vertex i) r ∩ interior + X) ∧ IsPathConnected (Metric.ball (p.vertex i) r \ X)) → ((frontier X = C) → (∀ x, x + ∈ frontier X → ∃ N : Set (Real × Real), IsOpen N ∧ x ∈ N ∧ IsPreconnected (N \ X))) ) + := by + classical + intro n p X K t C hlocal hfrontierC + obtain ⟨coordinates, vertex_incidence⟩ := + P5662T1TriangulationBarycentricCoordinates p X K t.toP3381T1PairedTriangulation + intro z hz + rw [hfrontierC] at hz + obtain ⟨i, hzi⟩ := Set.mem_iUnion.mp hz + rw [segment_eq_image] at hzi + obtain ⟨u, hu, rfl⟩ := hzi + by_cases hu0 : u = 0 + · subst u + simp only [zero_smul, one_smul, sub_zero, add_zero] + obtain ⟨r, hr, _, _, hexterior⟩ := hlocal i + refine ⟨Metric.ball (p.vertex i) r, Metric.isOpen_ball, + (by simpa only [zero_add] using Metric.mem_ball_self (x := p.vertex i) hr), ?_⟩ + exact hexterior.isConnected.isPreconnected + · by_cases hu1 : u = 1 + · subst u + simp only [one_smul, sub_self, zero_smul, zero_add] + obtain ⟨r, hr, _, _, hexterior⟩ := hlocal (i + 1) + refine ⟨Metric.ball (p.vertex (i + 1)) r, Metric.isOpen_ball, + (by simpa only [zero_add] using + Metric.mem_ball_self (x := p.vertex (i + 1)) hr), ?_⟩ + exact hexterior.isConnected.isPreconnected + · have hu0' : 0 < u := lt_of_le_of_ne hu.1 (Ne.symm hu0) + have hu1' : u < 1 := lt_of_le_of_ne hu.2 hu1 + have hij : i ≠ i + 1 := by + intro hi + have hzero : (0 : Fin (n + 3)) = 1 := + add_left_cancel (show i + 0 = i + 1 by simp at hi) + exact Fin.zero_ne_one hzero + obtain ⟨b, bsum, breconstruct, bunique, bcontinuous, bhull, bvertex, bcommon⟩ := + coordinates + let D (k : Fin t.count) := + convexHull Real (Set.range (p.vertex ∘ t.face k)) + have closedD (k : Fin t.count) : IsClosed (D k) := + ((Set.finite_range (p.vertex ∘ t.face k)).isCompact_convexHull Real).isClosed + have third (a d : Fin 3) (had : a ≠ d) : ∃ c : Fin 3, a ≠ c ∧ d ≠ c := by + fin_cases a <;> fin_cases d + all_goals first | exact (had rfl).elim | decide + have indices (a d c : Fin 3) (had : a ≠ d) (hac : a ≠ c) (hdc : d ≠ c) + (j : Fin 3) : j = a ∨ j = d ∨ j = c := by + fin_cases a <;> fin_cases d <;> fin_cases c <;> fin_cases j + all_goals first + | exact (had rfl).elim + | exact (hac rfl).elim + | exact (hdc rfl).elim + | decide + have bcombo {ι : Type} [Fintype ι] (k : Fin t.count) + (w : ι → Real) (f : ι → Real × Real) (hw : (∑ r, w r) = 1) + (j : Fin 3) : + b k (∑ r, w r • f r) j = ∑ r, w r * b k (f r) j := PolygonalSeparationProof.bcombo n + p X K t b bsum breconstruct bunique (ι := ι) k w f hw j + have blinear (k : Fin t.count) (x y : Real × Real) (a d : Real) + (had : a + d = 1) (j : Fin 3) : + b k (a • x + d • y) j = a * b k x j + d * b k y j := by + let w : Fin 2 → Real := ![a, d] + let f : Fin 2 → Real × Real := ![x, y] + have hw : (∑ r, w r) = 1 := by simpa [Fin.sum_univ_two, w] using had + simpa [Fin.sum_univ_two, w, f] using bcombo (ι := Fin 2) k w f hw j + let I : Set (Fin t.count) := {k | i ∈ Set.range (t.face k) ∧ + i + 1 ∈ Set.range (t.face k)} + have hcount := t.edge_count i (i + 1) hij + have hcount1 : I.ncard = 1 := by + dsimp [I] + simpa using hcount + obtain ⟨k, hIeq⟩ := Set.ncard_eq_one.mp hcount1 + have hkI : k ∈ I := by rw [hIeq]; simp + obtain ⟨a, ha⟩ := hkI.1 + obtain ⟨d, hd⟩ := hkI.2 + have had : a ≠ d := by + intro he + apply hij + calc + i = t.face k a := ha.symm + _ = t.face k d := congrArg (t.face k) he + _ = i + 1 := hd + obtain ⟨c, hac, hdc⟩ := third a d had + have hIuniq (l : Fin t.count) (hl : l ∈ I) : l = k := by + rw [hIeq] at hl + simpa using hl + have hvA : p.vertex i = p.vertex (t.face k a) := congrArg p.vertex ha.symm + have hvD : p.vertex (i + 1) = p.vertex (t.face k d) := congrArg p.vertex hd.symm + have hpoint : + (1 - u) • p.vertex i + u • p.vertex (i + 1) = + (1 - u) • p.vertex (t.face k a) + u • p.vertex (t.face k d) := by + calc + _ = (1 - u) • p.vertex (t.face k a) + u • p.vertex (i + 1) := + congrArg (fun q => (1 - u) • q + u • p.vertex (i + 1)) hvA + _ = _ := congrArg (fun q => (1 - u) • p.vertex (t.face k a) + u • q) hvD + have hzcoordA : b k ((1 - u) • p.vertex i + u • p.vertex (i + 1)) a = 1 - u := by + rw [hpoint, blinear k _ _ _ _ (by ring), bvertex, bvertex] + simp [had] + have hzcoordD : b k ((1 - u) • p.vertex i + u • p.vertex (i + 1)) d = u := by + rw [hpoint, blinear k _ _ _ _ (by ring), bvertex, bvertex] + simp [Ne.symm had] + have hzcoordC : b k ((1 - u) • p.vertex i + u • p.vertex (i + 1)) c = 0 := by + rw [hpoint, blinear k _ _ _ _ (by ring), bvertex, bvertex] + simp [Ne.symm hac, Ne.symm hdc] + let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex (i + 1) + have hza : b k z a = 1 - u := hzcoordA + have hzd : b k z d = u := hzcoordD + have hzc : b k z c = 0 := hzcoordC + have hzDk : z ∈ D k := by + apply (bhull k z).mpr + intro j + rcases indices a d c had hac hdc j with rfl | rfl | rfl + · rw [hza] + exact sub_nonneg.mpr hu1'.le + · rw [hzd] + exact hu0'.le + · rw [hzc] + have contains (l : Fin t.count) (hzl : z ∈ D l) : l ∈ I := + PolygonalSeparationProof.contains n p X K t i u hu0' hu1' b bcommon k a ha d hd hza + hzd hzDk l hzl + let N : Set (Real × Real) := ⋂ l, + if l = k then Set.univ else (D l)ᶜ + have hNopen : IsOpen N := by + apply isOpen_iInter_of_finite + intro l + split_ifs + · exact isOpen_univ + · exact (closedD l).isOpen_compl + have hzN : z ∈ N := by + apply Set.mem_iInter.mpr + intro l + split_ifs with hl + · trivial + · intro hzl + have hlI := contains l hzl + rw [hIeq] at hlI + exact hl hlI + let Q : Set (Real × Real) := N ∩ {y | 0 < b k y a ∧ 0 < b k y d} + have hQopen : IsOpen Q := hNopen.inter + ((isOpen_lt continuous_const (bcontinuous k a)).inter + (isOpen_lt continuous_const (bcontinuous k d))) + have hzQ : z ∈ Q := by + refine ⟨hzN, ?_⟩ + change 0 < b k z a ∧ 0 < b k z d + rw [hza, hzd] + exact ⟨sub_pos.mpr hu1', hu0'⟩ + obtain ⟨r, hr, hball⟩ := Metric.isOpen_iff.mp hQopen z hzQ + have hlocalchar (y : Real × Real) (hy : y ∈ Metric.ball z r) : + y ∈ X ↔ 0 ≤ b k y c := PolygonalSeparationProof.hlocalchar n p X K t i u b bhull + indices k a ha d hd had c hac hdc hvA hvD hpoint hzcoordA hzcoordD hzcoordC hza + hzd hzc hQopen hzQ r hball y hy + have hhalf : Convex Real {y : Real × Real | b k y c < 0} := + PolygonalSeparationProof.hhalf n p X K t u hu0' hu1' b blinear k c + have hlocalEq : Metric.ball z r \ X = + Metric.ball z r ∩ {y : Real × Real | b k y c < 0} := by + ext y + by_cases hy : y ∈ Metric.ball z r + · have hchar := hlocalchar y hy + simp [hy, hchar, not_le] + · simp [hy] + refine ⟨Metric.ball z r, Metric.isOpen_ball, + Metric.mem_ball_self (x := z) hr, ?_⟩ + rw [hlocalEq] + exact (convex_ball z r).inter hhalf |>.isPreconnected + +private theorem hnonemptyV : + (by + classical + exact + ∀ (X : Set (Real × Real)), (IsCompact X) → ((Xᶜ).Nonempty) ) := by + classical + intro X hcompact + by_contra hn + have hce : Xᶜ = ∅ := Set.not_nonempty_iff_eq_empty.mp hn + have hXeq : X = Set.univ := by simpa using congrArg (fun A : Set (Real × Real) => Aᶜ) hce + rw [hXeq] at hcompact + exact (NormedSpace.unbounded_univ Real (Real × Real)) hcompact.isBounded + +private theorem hboundedV : + (by + classical + exact + ∀ (X : Set (Real × Real)), (IsCompact X) → (¬ Bornology.IsBounded (Xᶜ)) ) := by + classical + intro X hcompact hVb + have hU : Bornology.IsBounded (X ∪ Xᶜ) := hcompact.isBounded.union hVb + have hUniv : Bornology.IsBounded (Set.univ : Set (Real × Real)) := by + simpa using hU + exact (NormedSpace.unbounded_univ Real (Real × Real)) hUniv + +private theorem hdisj : + (by + classical + exact + ∀ (X : Set (Real × Real)), Disjoint (interior X) Xᶜ ) := by + classical + intro X + apply Set.disjoint_left.mpr + intro x hxI hxC + exact hxC (interior_subset hxI) + +private theorem hcover : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) + (frontier X = C) → (∀ [IsClosed X], interior X ∪ Xᶜ = Cᶜ) ) := by + classical + intro n p X C hfrontierC hclosed + ext z + rw [← hfrontierC] + simp [frontier]; tauto + +end PolygonalSeparationDetails + +theorem P3475T1PolygonalSeparation {n : Nat} + (p : P3381T1PolygonBoundary n) (X K : Set (Real × Real)) + (t : P3475T1TriangleTree p X K) : + let C := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) + ∃ U V : Set (Real × Real), + IsOpen U ∧ IsConnected U ∧ Bornology.IsBounded U ∧ + IsOpen V ∧ IsConnected V ∧ ¬ Bornology.IsBounded V ∧ + Disjoint U V ∧ U ∪ V = Cᶜ ∧ + frontier U = C ∧ frontier V = C ∧ X = U ∪ C := by +-- BODY + classical + dsimp + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) + obtain ⟨hcompact, hinterior, hfrontier, hlocal⟩ := + P3381T1TriangulationBoundary p X K t.toP3381T1PairedTriangulation + have hfrontierC : frontier X = C := by simpa [C] using hfrontier + have hclosed : IsClosed X := hcompact.isClosed + have hopenV : IsOpen Xᶜ := hclosed.isOpen_compl + let M := P3381T1PiecewiseAffinePolygonModel p X K t.toP3381T1PairedTriangulation + obtain ⟨h, hboundary, _⟩ := M + have hiff : ∀ x : X, ((x : Real × Real) ∈ interior X) ↔ + ((h x : Real × Real) ∈ interior K) := PolygonalSeparationDetails.hiff X K h hboundary + have hintpath : IsPathConnected (interior X) := PolygonalSeparationProof.hintpath n p X K t h hiff + have hlocalAll : ∀ x, x ∈ frontier X → + ∃ N : Set (Real × Real), IsOpen N ∧ x ∈ N ∧ IsPreconnected (N \ X) := + PolygonalSeparationDetails.hlocalAll n p X K t hlocal hfrontierC + have hCpre : IsPreconnected C := PolygonalSeparationProof.hCpre n p + have hVpre : IsPreconnected Xᶜ := PolygonalSeparationProof.hVpre n p X hfrontierC hopenV + hlocalAll hCpre + have hnonemptyV : (Xᶜ).Nonempty := PolygonalSeparationDetails.hnonemptyV X hcompact + have hboundedU : Bornology.IsBounded (interior X) := hcompact.isBounded.subset interior_subset + have hboundedV : ¬ Bornology.IsBounded (Xᶜ) := PolygonalSeparationDetails.hboundedV X hcompact + have hdisj : Disjoint (interior X) Xᶜ := PolygonalSeparationDetails.hdisj X + have hcover : interior X ∪ Xᶜ = Cᶜ := PolygonalSeparationDetails.hcover n p X hfrontierC + have hfrontU : frontier (interior X) = C := PolygonalSeparationProof.hfrontU n p X K t + hfrontierC h hiff + have hfrontV : frontier Xᶜ = C := by + rw [frontier_compl, hfrontierC] + have hX : X = interior X ∪ C := PolygonalSeparationProof.hX n p X hfrontierC + refine ⟨interior X, Xᶜ, isOpen_interior, ?_, hboundedU, hopenV, ?_, hboundedV, + hdisj, hcover, hfrontU, hfrontV, hX⟩ + · let : PathConnectedSpace (interior X) := isPathConnected_iff_pathConnectedSpace.mp hintpath + exact ⟨hinterior, isPreconnected_iff_preconnectedSpace.mpr inferInstance⟩ + · exact ⟨hnonemptyV, hVpre⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1SquareUnionIdentification.lean b/LeanPool/ApollonianSuperharmonic/P3475T1SquareUnionIdentification.lean new file mode 100644 index 0000000000..312dffb083 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3475T1SquareUnionIdentification.lean @@ -0,0 +1,1725 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary +public import LeanPool.ApollonianSuperharmonic.P3475T1UnitSegmentIntersection +public import Mathlib.Analysis.Convex.Basic +public import Mathlib.Analysis.Convex.Segment +public import Mathlib.Analysis.Convex.PathConnected +public import Mathlib.Topology.EMetricSpace.Lipschitz +public import Mathlib.Topology.MetricSpace.Lipschitz +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: P3475T1SquareUnionIdentification] + +/-! +# P3475T1SquareUnionIdentification + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SquareUnionProof + +private theorem edge_support : + ∀ (T : ProtoTile), ∀ e ∈ BoundaryFootprintEdges T, ∃ z ∈ T.cells, e = {z, + z + (1 : GaussianInt)} ∨ e = {z, z + ⟨(0 : ℤ), (1 : ℤ)⟩} ∨ e = {z + ⟨(0 : ℤ), (1 : ℤ)⟩, + z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} ∨ e = {z + (1 : GaussianInt), + z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} := by + classical + intro T e he + rcases he with ⟨z, h | h⟩ + · rcases h.2 with hstatus | hstatus + · exact ⟨z, hstatus.1, Or.inl h.1⟩ + · refine ⟨z - ⟨0, 1⟩, hstatus.2, Or.inr (Or.inr (Or.inl ?_))⟩ + rw [show z - ⟨0, 1⟩ + ⟨0, 1⟩ = z by abel, + show z - ⟨0, 1⟩ + 1 + ⟨0, 1⟩ = z + 1 by abel] + exact h.1 + · rcases h.2 with hstatus | hstatus + · exact ⟨z, hstatus.1, Or.inr (Or.inl h.1)⟩ + · refine ⟨z - 1, hstatus.2, Or.inr (Or.inr (Or.inr ?_))⟩ + rw [show z - 1 + 1 = z by abel] + exact h.1 + +private theorem edge_endpoint_square : + ∀ (z : GaussianInt), ∀ (e : Finset GaussianInt), e = {z, z + (1 : GaussianInt)} ∨ e = {z, + z + ⟨(0 : ℤ), (1 : ℤ)⟩} ∨ e = {z + ⟨(0 : ℤ), (1 : ℤ)⟩, z + (1 : GaussianInt) + ⟨(0 : ℤ), + (1 : ℤ)⟩} ∨ e = {z + (1 : GaussianInt), z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} → ∀ w + ∈ e, GaussianRealPoint w ∈ ClosedSquareRealization z := by + classical + intro z e he w hw + rcases he with h | h | h | h <;> rw [h] at hw + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hw + all_goals rcases hw with rfl | rfl + all_goals simp [GaussianRealPoint, ClosedSquareRealization, Prod.le_def] + +private theorem boundary_carrier_in_tile : + ∀ (T : ProtoTile), ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (v : Fin (n + 3) → + GaussianInt), (∀ (i : Fin (n + (3 : ℕ))), p.vertex i = GaussianRealPoint (v i)) → + ((BoundaryFootprintEdges T = {e : Finset GaussianInt | ∃ (i : Fin (n + (3 : ℕ))), e = + {v i, v (i + (1 : Fin (n + (3 : ℕ))))}}) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + (∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges T) → (∃ z : GaussianInt, z ∈ T.cells + ∧ (e = {z, z + 1} ∨ e = {z, z + ⟨0, 1⟩} ∨ e = {z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} ∨ e = {z + 1, + z + 1 + ⟨0, 1⟩}))) → ((∀ (z : GaussianInt), ∀ (e : Finset GaussianInt), (e = {z, z + 1} ∨ + e = {z, z + ⟨0, 1⟩} ∨ e = {z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} ∨ e = {z + 1, z + 1 + ⟨0, 1⟩}) → + (∀ (w : GaussianInt), (w ∈ e) → (GaussianRealPoint w ∈ ClosedSquareRealization z))) → (C + ⊆ TileRealization T)))) := by + classical + intro T n p v hvertex hedges C edge_support edge_endpoint_square q hq + change q ∈ ⋃ i, segment ℝ (p.vertex i) (p.vertex (i + 1)) at hq + obtain ⟨i, hq⟩ := Set.mem_iUnion.mp hq + have he : ({v i, v (i + 1)} : Finset GaussianInt) ∈ BoundaryFootprintEdges T := by + rw [hedges] + exact ⟨i, rfl⟩ + obtain ⟨z, hz, hside⟩ := edge_support _ he + have hvi : v i ∈ ({v i, v (i + 1)} : Finset GaussianInt) := by simp + have hvi1 : v (i + 1) ∈ ({v i, v (i + 1)} : Finset GaussianInt) := by simp + have hpvi : p.vertex i ∈ ClosedSquareRealization z := by + rw [hvertex] + exact edge_endpoint_square z _ hside (v i) hvi + have hpvi1 : p.vertex (i + 1) ∈ ClosedSquareRealization z := by + rw [hvertex] + exact edge_endpoint_square z _ hside (v (i + 1)) hvi1 + have hseg : segment ℝ (p.vertex i) (p.vertex (i + 1)) ⊆ + ClosedSquareRealization z := by + rw [segment_eq_image] + rintro q ⟨t, ht, rfl⟩ + simp only [Set.mem_Icc] at ht + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpvi hpvi1 ⊢ + simp only [Prod.smul_fst, Prod.smul_snd, Prod.fst_add, Prod.snd_add, + smul_eq_mul] + constructor <;> constructor <;> nlinarith [ht.1, ht.2] + rw [TileRealization] + exact Set.mem_iUnion.2 ⟨z, Set.mem_iUnion.2 ⟨hz, hseg hq⟩⟩ + +private theorem segment_stays_on_one_side : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (U : Set (Real × Real)), ∀ (V : Set (Real + × Real)), (IsOpen U) → ((IsOpen V) → ((Disjoint U V) → ((U ∪ V = (⋃ (i : Fin (n + (3 : + ℕ))), segment ℝ (p.vertex i) (p.vertex (i + (1 : Fin (n + (3 : ℕ))))))ᶜ) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + ∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), segment ℝ a b ⊆ Cᶜ → segment ℝ a b ⊆ U ∨ segment ℝ a b ⊆ V)))) + := by + classical + intro n p U V hUopen hVopen hdisjoint hcover C a b havoid + have hpre : IsPreconnected (segment ℝ a b) := by + exact (convex_segment (𝕜 := ℝ) a b).isPreconnected + apply hpre.subset_or_subset hUopen hVopen hdisjoint + intro q hq + have hq' : q ∈ Cᶜ := havoid hq + rw [← hcover] at hq' + exact hq' + +private theorem east_center_segment_outside : + ∀ (T : ProtoTile), + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + ∀ a ∉ T.cells, a + (1 : GaussianInt) ∉ T.cells → segment ℝ (cellCenter a) (cellCenter (a + (1 + : GaussianInt))) ⊆ (TileRealization T)ᶜ := by + classical + intro T cellCenter a ha hb q hq htile + rw [segment_eq_image] at hq + rcases hq with ⟨t, ht, rfl⟩ + simp only [Set.mem_Icc] at ht + simp only [TileRealization, Set.mem_iUnion] at htile + rcases htile with ⟨c, hc, hq⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hq + simp? [cellCenter, + add_zero, + smul_eq_mul] at hq + simp only [GaussianInt.toComplex_def] at hq + norm_num [Complex.mul_re, Complex.mul_im] at hq + have hreC : (GaussianInt.toComplex c).re = (c.re : Real) := by + exact (GaussianInt.intCast_re c).symm + have himC : (GaussianInt.toComplex c).im = (c.im : Real) := by + exact (GaussianInt.intCast_im c).symm + have hreA : (GaussianInt.toComplex a).re = (a.re : Real) := by + exact (GaussianInt.intCast_re a).symm + have himA : (GaussianInt.toComplex a).im = (a.im : Real) := by + exact (GaussianInt.intCast_im a).symm + rw [hreC, himC, hreA, himA] at hq + rcases hq with ⟨⟨hxr, hxi⟩, ⟨hxr', hxi'⟩⟩ + have hrlo : a.re ≤ c.re := by + have hlt : (a.re : Real) < (c.re : Real) + 1 := by linarith + have hlt' : a.re < c.re + 1 := by exact_mod_cast hlt + omega + have hrhi : c.re ≤ a.re + 1 := by + have hlt : (c.re : Real) < (a.re : Real) + 2 := by linarith + have hlt' : c.re < a.re + 2 := by exact_mod_cast hlt + omega + have himlo : c.im ≤ a.im := by + have hlt : (c.im : Real) < (a.im : Real) + 1 := by linarith + have hlt' : c.im < a.im + 1 := by exact_mod_cast hlt + omega + have himhi : a.im ≤ c.im := by + have hlt : (a.im : Real) < (c.im : Real) + 1 := by linarith + have hlt' : a.im < c.im + 1 := by exact_mod_cast hlt + omega + have hIm : c.im = a.im := by omega + have hRe : c.re = a.re ∨ c.re = a.re + 1 := by omega + rcases hRe with hRe | hRe + · have hcEq : c = a := by + apply Zsqrtd.ext <;> simp [hRe, hIm] + exact ha (hcEq ▸ hc) + · have hcEq : c = a + 1 := by + apply Zsqrtd.ext <;> simp [hRe, hIm] + exact hb (hcEq ▸ hc) + +private theorem north_center_segment_outside : + ∀ (T : ProtoTile), + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + ∀ a ∉ T.cells, a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∉ T.cells → segment ℝ (cellCenter a) (cellCenter (a + + ⟨(0 : ℤ), (1 : ℤ)⟩)) ⊆ (TileRealization T)ᶜ := by + classical + intro T cellCenter a ha hb q hq htile + rw [segment_eq_image] at hq + rcases hq with ⟨t, ht, rfl⟩ + simp only [Set.mem_Icc] at ht + simp only [TileRealization, Set.mem_iUnion] at htile + rcases htile with ⟨c, hc, hq⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hq + simp? [cellCenter, + Int.cast_zero, Int.cast_one, add_zero, + smul_eq_mul] at hq + simp only [GaussianInt.toComplex_def] at hq + norm_num [Complex.mul_re, Complex.mul_im] at hq + have hreC : (GaussianInt.toComplex c).re = (c.re : Real) := + (GaussianInt.intCast_re c).symm + have himC : (GaussianInt.toComplex c).im = (c.im : Real) := + (GaussianInt.intCast_im c).symm + have hreA : (GaussianInt.toComplex a).re = (a.re : Real) := + (GaussianInt.intCast_re a).symm + have himA : (GaussianInt.toComplex a).im = (a.im : Real) := + (GaussianInt.intCast_im a).symm + rw [hreC, himC, hreA, himA] at hq + rcases hq with ⟨⟨hxr, hxi⟩, ⟨hxr', hxi'⟩⟩ + have hrlo : a.re ≤ c.re := by + have hlt : (a.re : Real) < (c.re : Real) + 1 := by linarith + have hlt' : a.re < c.re + 1 := by exact_mod_cast hlt + omega + have hrhi : c.re ≤ a.re := by + have hlt : (c.re : Real) < (a.re : Real) + 1 := by linarith + have hlt' : c.re < a.re + 1 := by exact_mod_cast hlt + omega + have himlo : a.im ≤ c.im := by + have hlt : (a.im : Real) < (c.im : Real) + 1 := by linarith + have hlt' : a.im < c.im + 1 := by exact_mod_cast hlt + omega + have himhi : c.im ≤ a.im + 1 := by + have hlt : (c.im : Real) < (a.im : Real) + 2 := by linarith + have hlt' : c.im < a.im + 2 := by exact_mod_cast hlt + omega + have hRe : c.re = a.re := by omega + have hIm : c.im = a.im ∨ c.im = a.im + 1 := by omega + rcases hIm with hIm | hIm + · have hcEq : c = a := by + apply Zsqrtd.ext <;> simp [hRe, hIm] + exact ha (hcEq ▸ hc) + · have hcEq : c = a + ⟨0, 1⟩ := by + apply Zsqrtd.ext <;> simp [hRe, hIm] + exact hb (hcEq ▸ hc) + +private theorem complement_adjacent_segment_avoid : + ∀ (T : ProtoTile), ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + (C ⊆ TileRealization T) → ( + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + (∀ (a : GaussianInt), (a ∉ T.cells) → ((a + 1 ∉ T.cells) → (segment ℝ (cellCenter a) + (cellCenter (a + 1)) ⊆ (TileRealization T)ᶜ))) → ((∀ (a : GaussianInt), (a ∉ T.cells) → + ((a + ⟨0, 1⟩ ∉ T.cells) → (segment ℝ (cellCenter a) (cellCenter (a + ⟨0, 1⟩)) ⊆ + (TileRealization T)ᶜ))) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), FourNeighborAdjacent + a b → a ∉ T.cells → b ∉ T.cells → segment ℝ (cellCenter a) (cellCenter b) ⊆ Cᶜ))) := by + classical + intro T n p C boundary_carrier_in_tile cellCenter east_center_segment_outside + north_center_segment_outside a b hab ha hb + have houtTile : segment ℝ (cellCenter a) (cellCenter b) ⊆ + (TileRealization T)ᶜ := by + rcases hab with h | h | h | h + · simpa [h] using east_center_segment_outside a ha (by simpa [h] using hb) + · have he : b + 1 = a := by rw [h]; simp + have hrev := east_center_segment_outside b hb (by simpa [he] using ha) + simpa [segment_symm, he] using hrev + · simpa [h] using north_center_segment_outside a ha (by simpa [h] using hb) + · have he : b + ⟨0, 1⟩ = a := by rw [h]; simp + have hrev := north_center_segment_outside b hb (by simpa [he] using ha) + simpa [segment_symm, he] using hrev + intro q hq hqC + exact houtTile hq (boundary_carrier_in_tile hqC) + +private theorem center_not_tile : + ∀ (T : ProtoTile), + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + ∀ a ∉ T.cells, cellCenter a ∉ TileRealization T := by + classical + intro T cellCenter a ha htile + simp only [TileRealization, Set.mem_iUnion] at htile + obtain ⟨c, hc, hq⟩ := htile + simp? [ClosedSquareRealization, cellCenter, Prod.le_def] at hq + have hreC : (GaussianInt.toComplex c).re = (c.re : Real) := + (GaussianInt.intCast_re c).symm + have himC : (GaussianInt.toComplex c).im = (c.im : Real) := + (GaussianInt.intCast_im c).symm + have hreA : (GaussianInt.toComplex a).re = (a.re : Real) := + (GaussianInt.intCast_re a).symm + have himA : (GaussianInt.toComplex a).im = (a.im : Real) := + (GaussianInt.intCast_im a).symm + rw [hreC, himC, hreA, himA] at hq + rcases hq with ⟨⟨hxr, hxi⟩, ⟨hxr', hxi'⟩⟩ + have hrlo : a.re ≤ c.re := by + have hlt : (a.re : Real) < (c.re : Real) + 1 := by linarith + have hlt' : a.re < c.re + 1 := by exact_mod_cast hlt + omega + have hrhi : c.re ≤ a.re := by + have hlt : (c.re : Real) < (a.re : Real) + 1 := by linarith + have hlt' : c.re < a.re + 1 := by exact_mod_cast hlt + omega + have himlo : a.im ≤ c.im := by + have hlt : (a.im : Real) < (c.im : Real) + 1 := by linarith + have hlt' : a.im < c.im + 1 := by exact_mod_cast hlt + omega + have himhi : c.im ≤ a.im := by + have hlt : (c.im : Real) < (a.im : Real) + 1 := by linarith + have hlt' : c.im < a.im + 1 := by exact_mod_cast hlt + omega + have hcEq : c = a := by + apply Zsqrtd.ext <;> omega + exact ha (hcEq ▸ hc) + +private theorem center_in_domain : + ∀ (T : ProtoTile), ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (U : Set (Real × + Real)), ∀ (V : Set (Real × Real)), (U ∪ V = (⋃ (i : Fin (n + (3 : ℕ))), segment ℝ + (p.vertex i) (p.vertex (i + (1 : Fin (n + (3 : ℕ))))))ᶜ) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + (C ⊆ TileRealization T) → ( + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + (∀ (a : GaussianInt), (a ∉ T.cells) → (cellCenter a ∉ TileRealization T)) → (∀ a ∉ T.cells, + cellCenter a ∈ U ∨ cellCenter a ∈ V))) := by + classical + intro T n p U V hcover C boundary_carrier_in_tile cellCenter center_not_tile a ha + have hnotTile := center_not_tile a ha + have hnotC : cellCenter a ∉ C := by + intro hC + exact hnotTile (boundary_carrier_in_tile hC) + have hCcompl : cellCenter a ∈ Cᶜ := hnotC + have hUV : cellCenter a ∈ U ∪ V := by + rw [← hcover] at hCcompl + exact hCcompl + exact hUV + +private theorem complement_adjacent_same_domain : + ∀ (T : ProtoTile), ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (U : Set (Real × + Real)), ∀ (V : Set (Real × Real)), (Disjoint U V) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + (∀ (a : Real × Real), ∀ (b : Real × Real), (segment ℝ a b ⊆ Cᶜ) → (segment ℝ a b ⊆ U ∨ + segment ℝ a b ⊆ V)) → ( + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + (∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → ((a ∉ T.cells) → ((b + ∉ T.cells) → (segment ℝ (cellCenter a) (cellCenter b) ⊆ Cᶜ)))) → (∀ (a : GaussianInt), ∀ + (b : GaussianInt), FourNeighborAdjacent a b → a ∉ T.cells → b ∉ T.cells → (cellCenter a ∈ + U ↔ cellCenter b ∈ U)))) := by + classical + intro T n p U V hdisjoint C segment_stays_on_one_side cellCenter + complement_adjacent_segment_avoid a b hab ha hb + have havoid := complement_adjacent_segment_avoid a b hab ha hb + rcases segment_stays_on_one_side _ _ havoid with hU | hV + · constructor <;> intro _ + · exact hU (right_mem_segment ℝ _ _) + · exact hU (left_mem_segment ℝ _ _) + · constructor + · intro haU + have haV : cellCenter a ∈ V := hV (left_mem_segment ℝ _ _) + have hbV : cellCenter b ∈ V := hV (right_mem_segment ℝ _ _) + exact False.elim ((Set.disjoint_left.mp hdisjoint) haU haV) + · intro hbU + have hbV : cellCenter b ∈ V := hV (right_mem_segment ℝ _ _) + have haV : cellCenter a ∈ V := hV (left_mem_segment ℝ _ _) + exact False.elim ((Set.disjoint_left.mp hdisjoint) hbU hbV) + +private theorem list_center_transport : + ∀ (T : ProtoTile), ∀ (U : Set (Real × Real)), + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + (∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → ((a ∉ T.cells) → ((b + ∉ T.cells) → ((cellCenter a ∈ U ↔ cellCenter b ∈ U))))) → (∀ (l : List GaussianInt), ∀ (x + : GaussianInt), ∀ (y : GaussianInt), l.head? = some x → l.getLast? = some y → (∀ z ∈ l, z + ∉ T.cells) → (∀ a, ∀ b, ∀ l₁, ∀ l₂, l = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → + (cellCenter x ∈ U ↔ cellCenter y ∈ U)) := by + classical + intro T U cellCenter complement_adjacent_same_domain l x y + induction l using List.twoStepInduction generalizing x y with + | nil => + intro hx hy _ _ + simp at hx + | singleton a => + intro hx hy _ _ + simp? at hx hy + subst x + subst y + exact Iff.rfl + | cons_cons a b tail ihTail ihCons => + intro hx hy hnodes hsteps + have hxA : x = a := by simpa using hx.symm + subst x + have hy' : (b :: tail).getLast? = some y := by simpa using hy + have hab : FourNeighborAdjacent a b := by + apply hsteps a b [] tail + simp + have ha : a ∉ T.cells := hnodes a (by simp) + have hb : b ∉ T.cells := hnodes b (by simp) + have hfirst := complement_adjacent_same_domain a b hab ha hb + have hnodes' : ∀ z ∈ b :: tail, z ∉ T.cells := by + intro z hz + exact hnodes z (by simp [hz]) + have hsteps' : ∀ a' b' l₁ l₂, + b :: tail = l₁ ++ a' :: b' :: l₂ → FourNeighborAdjacent a' b' := by + intro a' b' l₁ l₂ hEq + apply hsteps a' b' (a :: l₁) l₂ + simpa using congrArg (fun q => a :: q) hEq + have htail := ihCons b b y (by simp) hy' hnodes' hsteps' + exact hfirst.trans htail + +private theorem farComplementCell : + ∀ (T : ProtoTile), (FourNeighborConnected (↑T.cells : Set LatticeCell)) → (∀ (U : Set (Real × + Real)), (Bornology.IsBounded U) → ( + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + ∃ z : GaussianInt, z ∉ T.cells ∧ cellCenter z ∉ U)) := by + classical + intro T hinside U hUbounded cellCenter + obtain ⟨z₀, hz₀, hmax⟩ := T.cells.exists_max_image (fun z => z.re) hinside.1 + obtain ⟨R, hR⟩ := (LipschitzWith.prod_fst.isBounded_image hUbounded).subset_closedBall + (0 : Real) + let k : Int := max z₀.re (Int.floor R) + 2 + let z : GaussianInt := ⟨k, 0⟩ + have hzk : z.re > z₀.re := by + have hm : z₀.re ≤ max z₀.re (Int.floor R) := le_max_left _ _ + simp [z, k] + omega + have hnot : z ∉ T.cells := by + intro hz + have hle := hmax z hz + exact (not_lt_of_ge hle) hzk + have hfloor : Int.floor R < k := by + have hm : Int.floor R ≤ max z₀.re (Int.floor R) := le_max_right _ _ + simp [k] + omega + have hcoord : R < (cellCenter z).1 := by + dsimp [cellCenter, z] + have hfloorK : ((Int.floor R + 1 : Int) : Real) ≤ (k : Real) := by + have : Int.floor R + 1 ≤ k := by omega + exact_mod_cast this + calc + R < (Int.floor R : Real) + 1 := Int.lt_floor_add_one R + _ ≤ (k : Real) := by + simpa only [Int.cast_add, Int.cast_one] using hfloorK + _ < (k : Real) + (1 / 2 : Real) := by norm_num + have hnotU : cellCenter z ∉ U := by + intro hzU + have hmem : (cellCenter z).1 ∈ Prod.fst '' U := + ⟨cellCenter z, hzU, rfl⟩ + have hball := hR hmem + have hdist : dist ((cellCenter z).1) 0 ≤ R := by + simpa [Metric.mem_closedBall] using hball + have hle : (cellCenter z).1 ≤ R := by + have habs : |(cellCenter z).1| ≤ R := by simpa [Real.dist_eq] using hdist + exact (abs_le.mp habs).2 + exact (not_lt_of_ge hle) hcoord + exact ⟨z, hnot, hnotU⟩ + +private theorem pair_eq_cases : + ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : GaussianInt), c ≠ d → + ({a, b} : Finset GaussianInt) = {c, d} → a = c ∧ b = d ∨ a = d ∧ b = c := by + classical + intro a b c d hcd hpair + have ha : a = c ∨ a = d := by + have hm : a ∈ ({c, d} : Finset GaussianInt) := by + rw [← hpair] + simp + simpa only [Finset.mem_insert, Finset.mem_singleton] using hm + rcases ha with hac | had + · have hd : d ∈ ({a, b} : Finset GaussianInt) := by + rw [hpair] + simp + simp only [Finset.mem_insert, Finset.mem_singleton] at hd + rcases hd with hda | hdb + · exact False.elim (hcd (hac ▸ hda).symm) + · exact Or.inl ⟨hac, hdb.symm⟩ + · have hc : c ∈ ({a, b} : Finset GaussianInt) := by + rw [hpair] + simp + simp only [Finset.mem_insert, Finset.mem_singleton] at hc + rcases hc with hca | hcb + · exact False.elim (hcd (hca.trans had)) + · exact Or.inr ⟨had, hcb.symm⟩ + +private theorem boundary_side_segment_in_C : + ∀ (T : ProtoTile), ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (v : Fin (n + 3) → + GaussianInt), (∀ (i : Fin (n + (3 : ℕ))), p.vertex i = GaussianRealPoint (v i)) → + ((BoundaryFootprintEdges T = {e : Finset GaussianInt | ∃ (i : Fin (n + (3 : ℕ))), e = + {v i, v (i + (1 : Fin (n + (3 : ℕ))))}}) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : GaussianInt), (c ≠ d) + → ((({a, b} : Finset GaussianInt) = {c, d}) → ((a = c ∧ b = d) ∨ (a = d ∧ b = c)))) → (∀ + e ∈ BoundaryFootprintEdges T, ∀ (a : GaussianInt), ∀ (b : GaussianInt), e = {a, b} → a ≠ + b → ∀ q ∈ segment ℝ (GaussianRealPoint a) (GaussianRealPoint b), q ∈ C))) := by + classical + intro T n p v hvertex hedges C pair_eq_cases e he a b hab habne q hq + rw [hedges] at he + obtain ⟨i, hi⟩ := he + have hneq : v i ≠ v (i + 1) := by + intro h + have heq : ({v i, v (i + 1)} : Finset GaussianInt) = {a, b} := hi.symm.trans hab + rw [h] at heq + have hcard : ({a, b} : Finset GaussianInt).card = 2 := by simp [habne] + rw [← heq] at hcard + simp at hcard + have hp := pair_eq_cases (v i) (v (i + 1)) a b habne (hi.symm.trans hab) + rcases hp with ⟨ha, hb⟩ | ⟨ha, hb⟩ + · subst a; subst b + exact Set.mem_iUnion.mpr ⟨i, by simpa [hvertex] using hq⟩ + · subst a; subst b + rw [segment_symm] at hq + exact Set.mem_iUnion.mpr ⟨i, by simpa [hvertex] using hq⟩ + +private theorem east_side_not_boundary : + ∀ (T : ProtoTile), (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : + GaussianInt), (c ≠ d) → ((({a, b} : Finset GaussianInt) = {c, d}) → ((a = c ∧ b = d) ∨ (a + = d ∧ b = c)))) → (∀ (a : GaussianInt), (a ∈ T.cells ↔ a + (1 : GaussianInt) ∈ T.cells) → + {a + (1 : GaussianInt), a + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} ∉ + BoundaryFootprintEdges T) := by + classical + intro T pair_eq_cases a hsame he + rcases he with ⟨z, hside | hside⟩ + · have hp := pair_eq_cases z (z + 1) (a + 1) (a + 1 + ⟨0, 1⟩) + (by intro h; have := congrArg (fun x : GaussianInt => x.im) h; simp at this) + hside.1.symm + rcases hp with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ + · have hr₁ := congrArg (fun x : GaussianInt => x.re) h₁ + have hr₂ := congrArg (fun x : GaussianInt => x.re) h₂ + simp at hr₁ hr₂ + omega + · have hr₁ := congrArg (fun x : GaussianInt => x.re) h₁ + have hr₂ := congrArg (fun x : GaussianInt => x.re) h₂ + simp at hr₁ hr₂ + omega + · have hp := pair_eq_cases z (z + ⟨0, 1⟩) (a + 1) (a + 1 + ⟨0, 1⟩) + (by intro h; have := congrArg (fun x : GaussianInt => x.im) h; simp at this) + hside.1.symm + rcases hp with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ + · have hz : z = a + 1 := by + exact h₁ + subst z + rcases hside.2 with hstatus | hstatus + · have ha : a ∈ T.cells := hsame.mpr hstatus.1 + have hna : a ∉ T.cells := by simpa using hstatus.2 + exact hna ha + · have ha : a ∈ T.cells := by simpa using hstatus.2 + exact hstatus.1 (hsame.mp ha) + · have hi₁ := congrArg (fun x : GaussianInt => x.im) h₁ + have hi₂ := congrArg (fun x : GaussianInt => x.im) h₂ + simp at hi₁ hi₂ + omega + +private theorem north_side_not_boundary : + ∀ (T : ProtoTile), (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : + GaussianInt), (c ≠ d) → ((({a, b} : Finset GaussianInt) = {c, d}) → ((a = c ∧ b = d) ∨ (a + = d ∧ b = c)))) → (∀ (a : GaussianInt), (a ∈ T.cells ↔ a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∈ T.cells) + → {a + ⟨(0 : ℤ), (1 : ℤ)⟩, a + ⟨(0 : ℤ), (1 : ℤ)⟩ + (1 : GaussianInt)} ∉ + BoundaryFootprintEdges T) := by + classical + intro T pair_eq_cases a hsame he + rcases he with ⟨z, hside | hside⟩ + · have hp := pair_eq_cases z (z + 1) (a + ⟨0, 1⟩) (a + ⟨0, 1⟩ + 1) + (by intro h; have := congrArg (fun x : GaussianInt => x.re) h; simp at this) + hside.1.symm + rcases hp with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ + · have hz : z = a + ⟨0, 1⟩ := h₁ + subst z + rcases hside.2 with hstatus | hstatus + · have ha : a ∈ T.cells := hsame.mpr hstatus.1 + have hna : a ∉ T.cells := by simpa using hstatus.2 + exact hna ha + · have ha : a ∈ T.cells := by simpa using hstatus.2 + exact hstatus.1 (hsame.mp ha) + · have hr₁ := congrArg (fun x : GaussianInt => x.re) h₁ + have hr₂ := congrArg (fun x : GaussianInt => x.re) h₂ + simp at hr₁ hr₂ + omega + · have hp := pair_eq_cases z (z + ⟨0, 1⟩) (a + ⟨0, 1⟩) (a + ⟨0, 1⟩ + 1) + (by intro h; have := congrArg (fun x : GaussianInt => x.re) h; simp at this) + hside.1.symm + rcases hp with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ + · have hi₁ := congrArg (fun x : GaussianInt => x.im) h₁ + have hi₂ := congrArg (fun x : GaussianInt => x.im) h₂ + simp at hi₁ hi₂ + omega + · have hr₁ := congrArg (fun x : GaussianInt => x.re) h₁ + have hr₂ := congrArg (fun x : GaussianInt => x.re) h₂ + simp at hr₁ hr₂ + omega + +private theorem boundary_edge_adjacent : + ∀ (T : ProtoTile), ∀ (n : Nat), ∀ (v : Fin (n + 3) → GaussianInt), (∀ (e : Finset + GaussianInt), (e ∈ BoundaryFootprintEdges T) → (∃ z : GaussianInt, z ∈ T.cells ∧ (e = {z, + z + 1} ∨ e = {z, z + ⟨0, 1⟩} ∨ e = {z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} ∨ e = {z + 1, z + 1 + ⟨0, + 1⟩}))) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : + GaussianInt), (c ≠ d) → ((({a, b} : Finset GaussianInt) = {c, d}) → ((a = c ∧ b = d) ∨ (a + = d ∧ b = c)))) → (∀ (i : Fin (n + (3 : ℕ))), {v i, v (i + (1 : Fin (n + (3 : ℕ))))} ∈ + BoundaryFootprintEdges T → FourNeighborAdjacent (v i) (v (i + (1 : Fin (n + (3 : ℕ))))))) + := by + classical + intro T n v edge_support pair_eq_cases i he + obtain ⟨z, _, hside⟩ := edge_support _ he + rcases hside with hside | hside | hside | hside + · have hp := pair_eq_cases (v i) (v (i + 1)) z (z + 1) + (by intro h; have := congrArg (fun x : GaussianInt => x.re) h; simp at this) + hside + rcases hp with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ <;> + simp [FourNeighborAdjacent, h₁, h₂] + · have hp := pair_eq_cases (v i) (v (i + 1)) z (z + ⟨0, 1⟩) + (by intro h; have := congrArg (fun x : GaussianInt => x.im) h; simp at this) + hside + rcases hp with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ <;> + simp [FourNeighborAdjacent, h₁, h₂] + · let w := z + ⟨0, 1⟩ + have hp := pair_eq_cases (v i) (v (i + 1)) w (w + 1) + (by intro h; have := congrArg (fun x : GaussianInt => x.re) h; simp at this) + (by simpa [w, add_assoc, add_comm, add_left_comm] using hside) + rcases hp with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ <;> + simp [FourNeighborAdjacent, h₁, h₂] + · let w := z + 1 + have hp := pair_eq_cases (v i) (v (i + 1)) w (w + ⟨0, 1⟩) + (by intro h; have := congrArg (fun x : GaussianInt => x.im) h; simp at this) + (by simpa [w, add_assoc, add_comm, add_left_comm] using hside) + rcases hp with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ <;> + simp [FourNeighborAdjacent, h₁, h₂] + +private theorem boundary_carrier_has_integer_coordinate : + ∀ (T : ProtoTile), ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (v : Fin (n + 3) → + GaussianInt), (∀ (i : Fin (n + (3 : ℕ))), p.vertex i = GaussianRealPoint (v i)) → + ((BoundaryFootprintEdges T = {e : Finset GaussianInt | ∃ (i : Fin (n + (3 : ℕ))), e = + {v i, v (i + (1 : Fin (n + (3 : ℕ))))}}) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + (∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges T) → (∃ z : GaussianInt, z ∈ T.cells + ∧ (e = {z, z + 1} ∨ e = {z, z + ⟨0, 1⟩} ∨ e = {z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} ∨ e = {z + 1, + z + 1 + ⟨0, 1⟩}))) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ + (d : GaussianInt), (c ≠ d) → ((({a, b} : Finset GaussianInt) = {c, d}) → ((a = c ∧ b = d) + ∨ (a = d ∧ b = c)))) → ((∀ (z : GaussianInt), ∀ (q : Real × Real), (q ∈ segment ℝ + (GaussianRealPoint z) (GaussianRealPoint (z + 1))) → (q.2 = (z.im : Real))) → ((∀ (z : + GaussianInt), ∀ (q : Real × Real), (q ∈ segment ℝ (GaussianRealPoint z) + (GaussianRealPoint (z + ⟨0, 1⟩))) → (q.1 = (z.re : Real))) → (∀ q ∈ C, (∃ (m : ℤ), q.1 = + (↑m : ℝ)) ∨ ∃ (m : ℤ), q.2 = (↑m : ℝ))))))) := by + classical + intro T n p v hvertex hedges C edge_support pair_eq_cases horizontal_segment_y + vertical_segment_x q hq + change q ∈ ⋃ i, segment ℝ (p.vertex i) (p.vertex (i + 1)) at hq + obtain ⟨i, hq⟩ := Set.mem_iUnion.mp hq + have he : ({v i, v (i + 1)} : Finset GaussianInt) ∈ BoundaryFootprintEdges T := by + rw [hedges] + exact ⟨i, rfl⟩ + obtain ⟨z, _, hside⟩ := edge_support _ he + rw [hvertex i, hvertex (i + 1)] at hq + rcases hside with hside | hside | hside | hside + · have hpair := pair_eq_cases (v i) (v (i + 1)) z (z + 1) + (by intro h; have := congrArg (fun x : GaussianInt => x.re) h; simp at this) + hside + rcases hpair with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ + · rw [h₁, h₂] at hq + exact Or.inr ⟨z.im, horizontal_segment_y z q hq⟩ + · rw [h₁, h₂] at hq + rw [segment_symm] at hq + exact Or.inr ⟨z.im, horizontal_segment_y z q hq⟩ + · have hpair := pair_eq_cases (v i) (v (i + 1)) z (z + ⟨0, 1⟩) + (by intro h; have := congrArg (fun x : GaussianInt => x.im) h; simp at this) + hside + rcases hpair with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ + · rw [h₁, h₂] at hq + exact Or.inl ⟨z.re, vertical_segment_x z q hq⟩ + · rw [h₁, h₂] at hq + rw [segment_symm] at hq + exact Or.inl ⟨z.re, vertical_segment_x z q hq⟩ + · let w : GaussianInt := z + ⟨0, 1⟩ + have hpair := pair_eq_cases (v i) (v (i + 1)) w (w + 1) + (by intro h; have := congrArg (fun x : GaussianInt => x.re) h; simp at this) + (by simpa [w, add_assoc, add_comm, add_left_comm] using hside) + rcases hpair with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ + · rw [h₁, h₂] at hq + exact Or.inr ⟨z.im + 1, by + simpa [w, Zsqrtd.im_add, Zsqrtd.im_one, add_zero] using + (horizontal_segment_y w q hq)⟩ + · rw [h₁, h₂] at hq + rw [segment_symm] at hq + exact Or.inr ⟨z.im + 1, by + simpa [w, Zsqrtd.im_add, Zsqrtd.im_one, add_zero] using + (horizontal_segment_y w q hq)⟩ + · let w : GaussianInt := z + 1 + have hpair := pair_eq_cases (v i) (v (i + 1)) w (w + ⟨0, 1⟩) + (by intro h; have := congrArg (fun x : GaussianInt => x.im) h; simp at this) + (by simpa [w, add_assoc, add_comm, add_left_comm] using hside) + rcases hpair with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ + · rw [h₁, h₂] at hq + exact Or.inl ⟨z.re + 1, by simpa [w, Zsqrtd.re_add, Zsqrtd.re_one, Int.cast_add, + Int.cast_one] using vertical_segment_x w q hq⟩ + · rw [h₁, h₂] at hq + rw [segment_symm] at hq + exact Or.inl ⟨z.re + 1, by simpa [w, Zsqrtd.re_add, Zsqrtd.re_one, Int.cast_add, + Int.cast_one] using vertical_segment_x w q hq⟩ + +private theorem east_same_center_segment_avoids : + ∀ (T : ProtoTile), ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (v : Fin (n + 3) → + GaussianInt), (∀ (i : Fin (n + (3 : ℕ))), p.vertex i = GaussianRealPoint (v i)) → + ((BoundaryFootprintEdges T = {e : Finset GaussianInt | ∃ (i : Fin (n + (3 : ℕ))), e = + {v i, v (i + (1 : Fin (n + (3 : ℕ))))}}) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + (∀ (a : GaussianInt), ((a ∈ T.cells ↔ a + 1 ∈ T.cells)) → (({a + 1, a + 1 + ⟨0, 1⟩} : Finset + GaussianInt) ∉ BoundaryFootprintEdges T)) → ((∀ (i : Fin (n + 3)), (({v i, v (i + 1)} : + Finset GaussianInt) ∈ BoundaryFootprintEdges T) → (FourNeighborAdjacent (v i) (v (i + + 1)))) → ((∀ (q : Real × Real), (q ∈ C) → ((∃ m : Int, q.1 = (m : Real)) ∨ (∃ m : Int, q.2 + = (m : Real)))) → (∀ (a : GaussianInt), (a ∈ T.cells ↔ a + (1 : GaussianInt) ∈ T.cells) → + segment ℝ (cellCenter a) (cellCenter (a + (1 : GaussianInt))) ⊆ Cᶜ))))) := by + classical + intro T n p v hvertex hedges C cellCenter east_side_not_boundary boundary_edge_adjacent + boundary_carrier_has_integer_coordinate a hsame q hq hC + rw [segment_eq_image] at hq + rcases hq with ⟨t, ht, hqt⟩ + have hqx : q.1 = (a.re : Real) + 1 / 2 + t := by + rw [← hqt] + simp [cellCenter, + smul_eq_mul] + ring + have hqy : q.2 = (a.im : Real) + 1 / 2 := by + rw [← hqt] + simp [cellCenter, add_zero, + smul_eq_mul] + ring + have hxlo : (a.re : Real) + 1 / 2 ≤ q.1 := by rw [hqx]; linarith [ht.1] + have hxhi : q.1 ≤ (a.re : Real) + 3 / 2 := by rw [hqx]; linarith [ht.2] + have hylo : (a.im : Real) ≤ q.2 := by rw [hqy]; norm_num + have hyhi : q.2 ≤ (a.im : Real) + 1 := by rw [hqy]; norm_num + rcases boundary_carrier_has_integer_coordinate q hC with ⟨m, hm⟩ | ⟨m, hm⟩ + · have hlow2R : 2 * (a.re : Real) + 1 ≤ 2 * (m : Real) := by + rw [← hm] + linarith [hxlo] + have hlow2 : 2 * a.re + 1 ≤ 2 * m := by exact_mod_cast hlow2R + have hlow : a.re + 1 ≤ m := by omega + have hhighR : (m : Real) < (a.re : Real) + 2 := by rw [← hm]; linarith + have hhigh : m < a.re + 2 := by exact_mod_cast hhighR + have hmEq : m = a.re + 1 := by omega + have hqxMid : q.1 = (a.re : Real) + 1 := by rw [hm, hmEq]; norm_num + have hcommon : q ∈ segment ℝ (GaussianRealPoint (a + 1)) + (GaussianRealPoint (a + 1 + ⟨0, 1⟩)) := by + rw [segment_eq_image] + refine ⟨q.2 - (a.im : Real), ⟨by linarith [hylo], by linarith [hyhi]⟩, ?_⟩ + apply Prod.ext + · simp? [GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.re_one, + Int.cast_add, Int.cast_one, smul_eq_mul] + rw [(GaussianInt.intCast_re a).symm, hqxMid] + ring + · simp [GaussianRealPoint, Zsqrtd.im_add, Zsqrtd.im_one, + Int.cast_add, Int.cast_one, smul_eq_mul] + ring + change q ∈ ⋃ i, segment ℝ (p.vertex i) (p.vertex (i + 1)) at hC + obtain ⟨i, hpoly⟩ := Set.mem_iUnion.mp hC + have he : ({v i, v (i + 1)} : Finset GaussianInt) ∈ BoundaryFootprintEdges T := by + rw [hedges] + exact ⟨i, rfl⟩ + have hboundary : q ∈ segment ℝ (GaussianRealPoint (v i)) + (GaussianRealPoint (v (i + 1))) := by + simpa [hvertex] using hpoly + have hpair : ({v i, v (i + 1)} : Finset GaussianInt) = + {a + 1, a + 1 + ⟨0, 1⟩} := by + by_contra hne + have hinter := P3475T1UnitSegmentIntersection (v i) (v (i + 1)) + (a + 1) (a + 1 + ⟨0, 1⟩) (boundary_edge_adjacent i he) + (by simp [FourNeighborAdjacent]) hne + have hmem : q ∈ segment ℝ (GaussianRealPoint (v i)) + (GaussianRealPoint (v (i + 1))) ∩ + segment ℝ (GaussianRealPoint (a + 1)) + (GaussianRealPoint (a + 1 + ⟨0, 1⟩)) := ⟨hboundary, hcommon⟩ + rw [hinter] at hmem + simp only [Set.mem_ofPred_eq] at hmem + rcases hmem.2 with hqend | hqend + · have him := congrArg Prod.snd hqend + have hpoint : (GaussianRealPoint (a + 1)).2 = (a.im : Real) := by + simp [GaussianRealPoint, Zsqrtd.im_add, Zsqrtd.im_one, + GaussianInt.intCast_im] + rw [hpoint] at him + linarith [hqy] + · have him := congrArg Prod.snd hqend + have hpoint : (GaussianRealPoint (a + 1 + ⟨0, 1⟩)).2 = (a.im : Real) + 1 := by + simp [GaussianRealPoint, Zsqrtd.im_add, Zsqrtd.im_one, + GaussianInt.intCast_im, add_assoc] + rw [hpoint] at him + linarith [hqy] + rw [hpair] at he + exact east_side_not_boundary a hsame he + · have hEq : (m : Real) = (a.im : Real) + 1 / 2 := by + calc + (m : Real) = q.2 := hm.symm + _ = (a.im : Real) + 1 / 2 := hqy + have hcast : (2 * m : Int) = 2 * a.im + 1 := by + have hcastR : (2 : Real) * (m : Real) = + (2 : Real) * (a.im : Real) + 1 := by rw [hEq]; ring + exact_mod_cast hcastR + omega + +private theorem north_same_center_segment_avoids : + ∀ (T : ProtoTile), ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (v : Fin (n + 3) → + GaussianInt), (∀ (i : Fin (n + (3 : ℕ))), p.vertex i = GaussianRealPoint (v i)) → + ((BoundaryFootprintEdges T = {e : Finset GaussianInt | ∃ (i : Fin (n + (3 : ℕ))), e = + {v i, v (i + (1 : Fin (n + (3 : ℕ))))}}) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + (∀ (a : GaussianInt), ((a ∈ T.cells ↔ a + ⟨0, 1⟩ ∈ T.cells)) → (({a + ⟨0, 1⟩, a + ⟨0, 1⟩ + 1} + : Finset GaussianInt) ∉ BoundaryFootprintEdges T)) → ((∀ (i : Fin (n + 3)), (({v i, + v (i + 1)} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) → (FourNeighborAdjacent (v + i) (v (i + 1)))) → ((∀ (q : Real × Real), (q ∈ C) → ((∃ m : Int, q.1 = (m : Real)) ∨ (∃ m + : Int, q.2 = (m : Real)))) → (∀ (a : GaussianInt), (a ∈ T.cells ↔ a + ⟨(0 : ℤ), (1 : ℤ)⟩ + ∈ T.cells) → segment ℝ (cellCenter a) (cellCenter (a + ⟨(0 : ℤ), (1 : ℤ)⟩)) ⊆ Cᶜ))))) := by + classical + intro T n p v hvertex hedges C cellCenter north_side_not_boundary boundary_edge_adjacent + boundary_carrier_has_integer_coordinate a hsame q hq hC + rw [segment_eq_image] at hq + rcases hq with ⟨t, ht, hqt⟩ + have hqx : q.1 = (a.re : Real) + 1 / 2 := by + rw [← hqt] + simp [cellCenter, Int.cast_zero, + add_zero, smul_eq_mul] + ring + have hqy : q.2 = (a.im : Real) + 1 / 2 + t := by + rw [← hqt] + simp [cellCenter, + Int.cast_one, smul_eq_mul] + ring + have hylo : (a.im : Real) + 1 / 2 ≤ q.2 := by rw [hqy]; linarith [ht.1] + have hyhi : q.2 ≤ (a.im : Real) + 3 / 2 := by rw [hqy]; linarith [ht.2] + have hxlo : (a.re : Real) ≤ q.1 := by rw [hqx]; norm_num + have hxhi : q.1 ≤ (a.re : Real) + 1 := by rw [hqx]; norm_num + rcases boundary_carrier_has_integer_coordinate q hC with ⟨m, hm⟩ | ⟨m, hm⟩ + · have hEq : (m : Real) = (a.re : Real) + 1 / 2 := by + calc + (m : Real) = q.1 := hm.symm + _ = (a.re : Real) + 1 / 2 := hqx + have hcastR : (2 : Real) * (m : Real) = + (2 : Real) * (a.re : Real) + 1 := by rw [hEq]; ring + have hcast : (2 * m : Int) = 2 * a.re + 1 := by exact_mod_cast hcastR + omega + · have hlow2R : 2 * (a.im : Real) + 1 ≤ 2 * (m : Real) := by + rw [← hm] + linarith [hylo] + have hlow2 : 2 * a.im + 1 ≤ 2 * m := by exact_mod_cast hlow2R + have hlow : a.im + 1 ≤ m := by omega + have hhighR : (m : Real) < (a.im : Real) + 2 := by rw [← hm]; linarith [hyhi] + have hhigh : m < a.im + 2 := by exact_mod_cast hhighR + have hmEq : m = a.im + 1 := by omega + have hqyMid : q.2 = (a.im : Real) + 1 := by rw [hm, hmEq]; norm_num + have hcommon : q ∈ segment ℝ (GaussianRealPoint (a + ⟨0, 1⟩)) + (GaussianRealPoint (a + ⟨0, 1⟩ + 1)) := by + rw [segment_eq_image] + refine ⟨q.1 - (a.re : Real), ⟨by linarith [hxlo], by linarith [hxhi]⟩, ?_⟩ + apply Prod.ext + · simp? [GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.re_one, + Int.cast_add, Int.cast_one, smul_eq_mul] + ring + · simp? [GaussianRealPoint, Zsqrtd.im_add, Zsqrtd.im_one, + Int.cast_add, Int.cast_one, smul_eq_mul] + rw [(GaussianInt.intCast_im a).symm, hqyMid] + ring + change q ∈ ⋃ i, segment ℝ (p.vertex i) (p.vertex (i + 1)) at hC + obtain ⟨i, hpoly⟩ := Set.mem_iUnion.mp hC + have he : ({v i, v (i + 1)} : Finset GaussianInt) ∈ BoundaryFootprintEdges T := by + rw [hedges] + exact ⟨i, rfl⟩ + have hboundary : q ∈ segment ℝ (GaussianRealPoint (v i)) + (GaussianRealPoint (v (i + 1))) := by simpa [hvertex] using hpoly + have hpair : ({v i, v (i + 1)} : Finset GaussianInt) = + {a + ⟨0, 1⟩, a + ⟨0, 1⟩ + 1} := by + by_contra hne + have hinter := P3475T1UnitSegmentIntersection (v i) (v (i + 1)) + (a + ⟨0, 1⟩) (a + ⟨0, 1⟩ + 1) (boundary_edge_adjacent i he) + (by simp [FourNeighborAdjacent]) hne + have hmem : q ∈ segment ℝ (GaussianRealPoint (v i)) + (GaussianRealPoint (v (i + 1))) ∩ + segment ℝ (GaussianRealPoint (a + ⟨0, 1⟩)) + (GaussianRealPoint (a + ⟨0, 1⟩ + 1)) := ⟨hboundary, hcommon⟩ + rw [hinter] at hmem + simp only [Set.mem_ofPred_eq] at hmem + rcases hmem.2 with hqend | hqend + · have hpoint : (GaussianRealPoint (a + ⟨0, 1⟩)).1 = (a.re : Real) := by + simp [GaussianRealPoint, Zsqrtd.re_add, Int.cast_add, + GaussianInt.intCast_re] + have hx := congrArg Prod.fst hqend + rw [hpoint] at hx + linarith [hqx] + · have hpoint : (GaussianRealPoint (a + ⟨0, 1⟩ + 1)).1 = (a.re : Real) + 1 := by + simp? [GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.re_one, + Int.cast_add, Int.cast_one, GaussianInt.intCast_re, add_assoc] + have hx := congrArg Prod.fst hqend + rw [hpoint] at hx + linarith [hqx] + rw [hpair] at he + exact north_side_not_boundary a hsame he + +private theorem occupied_same_adjacent_avoid : + ∀ (T : ProtoTile), ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + (∀ (a : GaussianInt), ((a ∈ T.cells ↔ a + 1 ∈ T.cells)) → (segment ℝ (cellCenter a) + (cellCenter (a + 1)) ⊆ Cᶜ)) → ((∀ (a : GaussianInt), ((a ∈ T.cells ↔ a + ⟨0, 1⟩ ∈ + T.cells)) → (segment ℝ (cellCenter a) (cellCenter (a + ⟨0, 1⟩)) ⊆ Cᶜ)) → (∀ (a : + GaussianInt), ∀ (b : GaussianInt), FourNeighborAdjacent a b → a ∈ T.cells → b ∈ T.cells → + segment ℝ (cellCenter a) (cellCenter b) ⊆ Cᶜ)) := by + classical + intro T n p C cellCenter east_same_center_segment_avoids north_same_center_segment_avoids a b + hab ha hb + rcases hab with h | h | h | h + · subst b + exact east_same_center_segment_avoids a ⟨fun _ => hb, fun _ => ha⟩ + · have he : b + 1 = a := by rw [h]; simp + have hs : (b ∈ T.cells ↔ b + 1 ∈ T.cells) := by + constructor + · intro _ + rw [he] + exact ha + · intro _ + exact hb + have havoid := east_same_center_segment_avoids b hs + simpa [segment_symm, he] using havoid + · subst b + exact north_same_center_segment_avoids a ⟨fun _ => hb, fun _ => ha⟩ + · have he : b + ⟨0, 1⟩ = a := by rw [h]; simp + have hs : (b ∈ T.cells ↔ b + ⟨0, 1⟩ ∈ T.cells) := by + constructor + · intro _ + rw [he] + exact ha + · intro _ + exact hb + have havoid := north_same_center_segment_avoids b hs + simpa [segment_symm, he] using havoid + +private theorem occupied_adjacent_same_domain : + ∀ (T : ProtoTile), ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (U : Set (Real × + Real)), ∀ (V : Set (Real × Real)), (Disjoint U V) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + (∀ (a : Real × Real), ∀ (b : Real × Real), (segment ℝ a b ⊆ Cᶜ) → (segment ℝ a b ⊆ U ∨ + segment ℝ a b ⊆ V)) → ( + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + (∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → ((a ∈ T.cells) → ((b + ∈ T.cells) → (segment ℝ (cellCenter a) (cellCenter b) ⊆ Cᶜ)))) → (∀ (a : GaussianInt), ∀ + (b : GaussianInt), FourNeighborAdjacent a b → a ∈ T.cells → b ∈ T.cells → (cellCenter a ∈ + U ↔ cellCenter b ∈ U)))) := by + classical + intro T n p U V hdisjoint C segment_stays_on_one_side cellCenter occupied_same_adjacent_avoid a + b hab ha hb + have havoid := occupied_same_adjacent_avoid a b hab ha hb + rcases segment_stays_on_one_side _ _ havoid with hU | hV + · constructor <;> intro _ + · exact hU (right_mem_segment ℝ _ _) + · exact hU (left_mem_segment ℝ _ _) + · constructor + · intro haU + have haV := hV (left_mem_segment ℝ _ _) + exact False.elim ((Set.disjoint_left.mp hdisjoint) haU haV) + · intro hbU + have hbV := hV (right_mem_segment ℝ _ _) + exact False.elim ((Set.disjoint_left.mp hdisjoint) hbU hbV) + +private theorem list_occupied_center_transport : + ∀ (T : ProtoTile), ∀ (U : Set (Real × Real)), + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + (∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → ((a ∈ T.cells) → ((b + ∈ T.cells) → ((cellCenter a ∈ U ↔ cellCenter b ∈ U))))) → (∀ (l : List GaussianInt), ∀ (x + : GaussianInt), ∀ (y : GaussianInt), l.head? = some x → l.getLast? = some y → (∀ z ∈ l, z + ∈ T.cells) → (∀ a, ∀ b, ∀ l₁, ∀ l₂, l = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → + (cellCenter x ∈ U ↔ cellCenter y ∈ U)) := by + classical + intro T U cellCenter occupied_adjacent_same_domain l x y + induction l using List.twoStepInduction generalizing x y with + | nil => + intro hx hy _ _ + simp at hx + | singleton a => + intro hx hy _ _ + simp? at hx hy + subst x + subst y + exact Iff.rfl + | cons_cons a b tail ihTail ihCons => + intro hx hy hnodes hsteps + have hxA : x = a := by simpa using hx.symm + subst x + have hy' : (b :: tail).getLast? = some y := by simpa using hy + have hab : FourNeighborAdjacent a b := by + apply hsteps a b [] tail + simp + have ha : a ∈ T.cells := hnodes a (by simp) + have hb : b ∈ T.cells := hnodes b (by simp) + have hfirst := occupied_adjacent_same_domain a b hab ha hb + have hnodes' : ∀ z ∈ b :: tail, z ∈ T.cells := by + intro z hz + exact hnodes z (by simp [hz]) + have hsteps' : ∀ a' b' l₁ l₂, + b :: tail = l₁ ++ a' :: b' :: l₂ → FourNeighborAdjacent a' b' := by + intro a' b' l₁ l₂ hEq + apply hsteps a' b' (a :: l₁) l₂ + simpa using congrArg (fun q => a :: q) hEq + have htail := ihCons b b y (by simp) hy' hnodes' hsteps' + exact hfirst.trans htail + +private theorem boundary_disjoint_open_cell : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + (∀ (q : Real × Real), (q ∈ C) → ((∃ m : Int, q.1 = (m : Real)) ∨ (∃ m : Int, q.2 = (m : + Real)))) → ( + let inOpenCell : GaussianInt → (Real × Real) → Prop := fun c q => + (c.re : Real) < q.1 ∧ q.1 < (c.re : Real) + 1 ∧ + (c.im : Real) < q.2 ∧ q.2 < (c.im : Real) + 1 + ∀ (c : GaussianInt), ∀ q ∈ C, inOpenCell c q → False) := by + classical + intro n p C boundary_carrier_has_integer_coordinate inOpenCell c q hq hcell + change (c.re : Real) < q.1 ∧ q.1 < (c.re : Real) + 1 ∧ + (c.im : Real) < q.2 ∧ q.2 < (c.im : Real) + 1 at hcell + rcases boundary_carrier_has_integer_coordinate q hq with ⟨m, hm⟩ | ⟨m, hm⟩ + · rw [hm] at hcell + have hlo : c.re < m := by exact_mod_cast hcell.1 + have hhi : m < c.re + 1 := by exact_mod_cast hcell.2.1 + omega + · rw [hm] at hcell + have hlo : c.im < m := by exact_mod_cast hcell.2.2.1 + have hhi : m < c.im + 1 := by exact_mod_cast hcell.2.2.2 + omega + +private theorem open_cell_segment_subset : + let inOpenCell : GaussianInt → (Real × Real) → Prop := fun c q => + (c.re : Real) < q.1 ∧ q.1 < (c.re : Real) + 1 ∧ + (c.im : Real) < q.2 ∧ q.2 < (c.im : Real) + 1 + ∀ (c : GaussianInt), ∀ (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), inOpenCell c x → inOpenCell c y → segment + ℝ x y ⊆ {q : ℝ × ℝ | inOpenCell c q} := by + classical + intro inOpenCell c x y hx hy + change (c.re : Real) < x.1 ∧ x.1 < (c.re : Real) + 1 ∧ + (c.im : Real) < x.2 ∧ x.2 < (c.im : Real) + 1 at hx + change (c.re : Real) < y.1 ∧ y.1 < (c.re : Real) + 1 ∧ + (c.im : Real) < y.2 ∧ y.2 < (c.im : Real) + 1 at hy + have weighted_lower (a x y t : Real) (hx : a < x) (hy : a < y) + (ht : 0 ≤ t) (ht' : t ≤ 1) : a < (1 - t) * x + t * y := by + by_cases ht0 : t = 0 + · simpa [ht0] using hx + by_cases ht1 : t = 1 + · simpa [ht1] using hy + have htp : 0 < t := lt_of_le_of_ne ht (Ne.symm ht0) + have htlt : t < 1 := lt_of_le_of_ne ht' ht1 + have htq : 0 < 1 - t := sub_pos.mpr htlt + have h1 : 0 < (1 - t) * (x - a) := mul_pos htq (sub_pos.mpr hx) + have h2 : 0 < t * (y - a) := mul_pos htp (sub_pos.mpr hy) + nlinarith + have weighted_upper (b x y t : Real) (hx : x < b) (hy : y < b) + (ht : 0 ≤ t) (ht' : t ≤ 1) : (1 - t) * x + t * y < b := by + by_cases ht0 : t = 0 + · simpa [ht0] using hx + by_cases ht1 : t = 1 + · simpa [ht1] using hy + have htp : 0 < t := lt_of_le_of_ne ht (Ne.symm ht0) + have htlt : t < 1 := lt_of_le_of_ne ht' ht1 + have htq : 0 < 1 - t := sub_pos.mpr htlt + have h1 : 0 < (1 - t) * (b - x) := mul_pos htq (sub_pos.mpr hx) + have h2 : 0 < t * (b - y) := mul_pos htp (sub_pos.mpr hy) + nlinarith + rw [segment_eq_image] + rintro q ⟨t, ht, rfl⟩ + change (c.re : Real) < ((1 - t) • x + t • y).1 ∧ + ((1 - t) • x + t • y).1 < (c.re : Real) + 1 ∧ + (c.im : Real) < ((1 - t) • x + t • y).2 ∧ + ((1 - t) • x + t • y).2 < (c.im : Real) + 1 + simp only [Prod.smul_fst, Prod.smul_snd, Prod.fst_add, Prod.snd_add, + smul_eq_mul] + rcases hx with ⟨hxl, hxu, hyl, hyu⟩ + rcases hy with ⟨hxl', hxu', hyl', hyu'⟩ + exact ⟨weighted_lower _ _ _ _ hxl hxl' ht.1 ht.2, + weighted_upper _ _ _ _ hxu hxu' ht.1 ht.2, + weighted_lower _ _ _ _ hyl hyl' ht.1 ht.2, + weighted_upper _ _ _ _ hyu hyu' ht.1 ht.2⟩ + +private theorem center_to_square_point_avoid : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + let inOpenCell : GaussianInt → (Real × Real) → Prop := fun c q => + (c.re : Real) < q.1 ∧ q.1 < (c.re : Real) + 1 ∧ + (c.im : Real) < q.2 ∧ q.2 < (c.im : Real) + 1 + (∀ (c : GaussianInt), ∀ (q : Real × Real), (q ∈ C) → ((inOpenCell c q) → (False))) → (∀ (c : + GaussianInt), ∀ q ∈ ClosedSquareRealization c, q ∉ C → segment ℝ (cellCenter c) q ⊆ Cᶜ) + := by + classical + intro n p C cellCenter inOpenCell boundary_disjoint_open_cell c q hq hqC x hx hxC + rw [segment_eq_image] at hx + rcases hx with ⟨t, ht, rfl⟩ + by_cases ht1 : t = 1 + · apply hqC + simpa [ht1] using hxC + · have htlt : t < 1 := lt_of_le_of_ne ht.2 ht1 + have hq' : q ∈ ClosedSquareRealization c := hq + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hq' + rcases hq' with ⟨⟨hxl, hyl⟩, ⟨hxu, hyu⟩⟩ + have hcenter : inOpenCell c (cellCenter c) := by + change (c.re : Real) < (cellCenter c).1 ∧ + (cellCenter c).1 < (c.re : Real) + 1 ∧ + (c.im : Real) < (cellCenter c).2 ∧ + (cellCenter c).2 < (c.im : Real) + 1 + simp [cellCenter] + norm_num + change (c.re : Real) < (cellCenter c).1 ∧ + (cellCenter c).1 < (c.re : Real) + 1 ∧ + (c.im : Real) < (cellCenter c).2 ∧ + (cellCenter c).2 < (c.im : Real) + 1 at hcenter + have hleft : 0 < 1 - t := sub_pos.mpr htlt + have hxlo : (c.re : Real) < ((1 - t) • cellCenter c + t • q).1 := by + simp only [Prod.smul_fst, Prod.fst_add, smul_eq_mul] + have h1 : 0 < (1 - t) * ((cellCenter c).1 - (c.re : Real)) := + mul_pos hleft (sub_pos.mpr hcenter.1) + have h2 : 0 ≤ t * (q.1 - (c.re : Real)) := + mul_nonneg ht.1 (sub_nonneg.mpr (by linarith)) + nlinarith + have hxhi : ((1 - t) • cellCenter c + t • q).1 < (c.re : Real) + 1 := by + simp only [Prod.smul_fst, Prod.fst_add, smul_eq_mul] + have h1 : 0 < (1 - t) * ((c.re : Real) + 1 - (cellCenter c).1) := + mul_pos hleft (sub_pos.mpr hcenter.2.1) + have h2 : 0 ≤ t * ((c.re : Real) + 1 - q.1) := + mul_nonneg ht.1 (sub_nonneg.mpr (by linarith)) + nlinarith + have hylo : (c.im : Real) < ((1 - t) • cellCenter c + t • q).2 := by + simp only [Prod.smul_snd, Prod.snd_add, smul_eq_mul] + have h1 : 0 < (1 - t) * ((cellCenter c).2 - (c.im : Real)) := + mul_pos hleft (sub_pos.mpr hcenter.2.2.1) + have h2 : 0 ≤ t * (q.2 - (c.im : Real)) := + mul_nonneg ht.1 (sub_nonneg.mpr (by linarith)) + nlinarith + have hyhi : ((1 - t) • cellCenter c + t • q).2 < (c.im : Real) + 1 := by + simp only [Prod.smul_snd, Prod.snd_add, smul_eq_mul] + have h1 : 0 < (1 - t) * ((c.im : Real) + 1 - (cellCenter c).2) := + mul_pos hleft (sub_pos.mpr hcenter.2.2.2) + have h2 : 0 ≤ t * ((c.im : Real) + 1 - q.2) := + mul_nonneg ht.1 (sub_nonneg.mpr (by linarith)) + nlinarith + exact boundary_disjoint_open_cell c _ hxC ⟨hxlo, hxhi, hylo, hyhi⟩ + +private theorem square_point_same_domain : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (U : Set (Real × Real)), ∀ (V : Set (Real + × Real)), (Disjoint U V) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + (∀ (a : Real × Real), ∀ (b : Real × Real), (segment ℝ a b ⊆ Cᶜ) → (segment ℝ a b ⊆ U ∨ + segment ℝ a b ⊆ V)) → ( + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + (∀ (c : GaussianInt), ∀ (q : Real × Real), (q ∈ ClosedSquareRealization c) → ((q ∉ C) → + (segment ℝ (cellCenter c) q ⊆ Cᶜ))) → (∀ (c : GaussianInt), ∀ q ∈ ClosedSquareRealization + c, q ∉ C → (q ∈ U ↔ cellCenter c ∈ U)))) := by + classical + intro n p U V hdisjoint C segment_stays_on_one_side cellCenter center_to_square_point_avoid c q + hq hqC + have havoid := center_to_square_point_avoid c q hq hqC + rcases segment_stays_on_one_side _ _ havoid with hU | hV + · constructor + · intro _ + exact hU (left_mem_segment ℝ _ _) + · intro _ + exact hU (right_mem_segment ℝ _ _) + · constructor + · intro hqU + have hqV := hV (right_mem_segment ℝ _ _) + exact False.elim ((Set.disjoint_left.mp hdisjoint) hqU hqV) + · intro hcU + have hcV := hV (left_mem_segment ℝ _ _) + exact False.elim ((Set.disjoint_left.mp hdisjoint) hcU hcV) + +private theorem open_complement_cell_in_V : + ∀ (T : ProtoTile), ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (U : Set (Real × + Real)), ∀ (V : Set (Real × Real)), (Disjoint U V) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + (∀ (a : Real × Real), ∀ (b : Real × Real), (segment ℝ a b ⊆ Cᶜ) → (segment ℝ a b ⊆ U ∨ + segment ℝ a b ⊆ V)) → ( + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + (∀ (z : GaussianInt), (z ∉ T.cells) → (cellCenter z ∈ V)) → ( + let inOpenCell : GaussianInt → (Real × Real) → Prop := fun c q => + (c.re : Real) < q.1 ∧ q.1 < (c.re : Real) + 1 ∧ + (c.im : Real) < q.2 ∧ q.2 < (c.im : Real) + 1 + (∀ (c : GaussianInt), ∀ (q : Real × Real), (q ∈ C) → ((inOpenCell c q) → (False))) → ((∀ (c : + GaussianInt), ∀ (x : Real × Real), ∀ (y : Real × Real), (inOpenCell c x) → ((inOpenCell c + y) → (segment ℝ x y ⊆ {q | inOpenCell c q}))) → ((∀ (c : GaussianInt), inOpenCell c + (cellCenter c)) → (∀ c ∉ T.cells, ∀ (q : ℝ × ℝ), inOpenCell c q → q ∈ V)))))) := by + classical + intro T n p U V hdisjoint C segment_stays_on_one_side cellCenter every_complement_center_in_V + inOpenCell boundary_disjoint_open_cell open_cell_segment_subset center_in_open_cell c hc q hq + have hseg : segment ℝ (cellCenter c) q ⊆ Cᶜ := by + intro x hx hC + exact boundary_disjoint_open_cell c x hC + (open_cell_segment_subset c (cellCenter c) q (center_in_open_cell c) hq hx) + rcases segment_stays_on_one_side _ _ hseg with hU | hV + · have hcU : cellCenter c ∈ U := hU (left_mem_segment ℝ _ _) + have hcV := every_complement_center_in_V c hc + exact False.elim ((Set.disjoint_left.mp hdisjoint) hcU hcV) + · exact hV (right_mem_segment ℝ _ _) + +private theorem qSeedSide : + ∀ (seed : LatticeCell), + let qSeed : Real × Real := ((seed.re : Real) + 1, (seed.im : Real) + 1 / 2) + qSeed ∈ segment ℝ (GaussianRealPoint (seed + 1)) (GaussianRealPoint (seed + 1 + ⟨0, 1⟩)) := by + classical + intro seed qSeed + rw [segment_eq_image] + refine ⟨1 / 2, by norm_num, ?_⟩ + apply Prod.ext + · simp? [qSeed, GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, Int.cast_add, Int.cast_one, + add_zero, + smul_eq_mul] + rw [(GaussianInt.intCast_re seed).symm] + ring + · simp? [qSeed, GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, Int.cast_add, Int.cast_one, + add_zero, smul_eq_mul] + rw [(GaussianInt.intCast_im seed).symm] + ring + +end SquareUnionProof + +namespace SquareUnionDetails + +private theorem every_complement_center_in_V : + ∀ (T : ProtoTile), (FourNeighborConnected (↑T.cells : Set LatticeCell)ᶜ) → (∀ (U : Set (ℝ × + ℝ)), ∀ (V : Set (ℝ × ℝ)), + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + (∀ (a : GaussianInt), (a ∉ T.cells) → (cellCenter a ∈ U ∨ cellCenter a ∈ V)) → ((∀ (l : List + GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), l.head? = some x → l.getLast? = + some y → (∀ z ∈ l, z ∉ T.cells) → (∀ a, ∀ b, ∀ l₁, ∀ l₂, l = l₁ ++ a :: b :: l₂ → + FourNeighborAdjacent a b) → (cellCenter x ∈ U ↔ cellCenter y ∈ U)) → (∀ (farCell : + GaussianInt), (farCell ∉ T.cells) → ((cellCenter farCell ∉ U) → (∀ z ∉ T.cells, + cellCenter z ∈ V))))) := by + classical + intro T houtside U V cellCenter center_in_domain list_center_transport farCell hfarCell + hfarNotU z hz + obtain ⟨l, hlhead, hllast, hlnodes, hlsteps⟩ := + houtside.2 z hz farCell hfarCell + have htransport := list_center_transport l z farCell hlhead hllast hlnodes hlsteps + rcases center_in_domain z hz with hzU | hzV + · exact False.elim (hfarNotU (htransport.mp hzU)) + · exact hzV + +private theorem horizontal_segment_y : + ∀ (z : GaussianInt), ∀ q ∈ segment ℝ (GaussianRealPoint z) (GaussianRealPoint (z + (1 : + GaussianInt))), q.2 = (↑z.im : ℝ) := by + classical + intro z q hq + rw [segment_eq_image] at hq + rcases hq with ⟨t, ht, rfl⟩ + simp [GaussianRealPoint, Zsqrtd.im_add, Zsqrtd.im_one, add_zero, + smul_eq_mul] + ring + +private theorem vertical_segment_x : + ∀ (z : GaussianInt), ∀ q ∈ segment ℝ (GaussianRealPoint z) (GaussianRealPoint (z + ⟨(0 : ℤ), + (1 : ℤ)⟩)), q.1 = (↑z.re : ℝ) := by + classical + intro z q hq + rw [segment_eq_image] at hq + rcases hq with ⟨t, ht, rfl⟩ + simp [GaussianRealPoint, Zsqrtd.re_add, Int.cast_add, + add_zero, smul_eq_mul] + ring + +private theorem center_in_open_cell : + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + let inOpenCell : GaussianInt → (Real × Real) → Prop := fun c q => + (c.re : Real) < q.1 ∧ q.1 < (c.re : Real) + 1 ∧ + (c.im : Real) < q.2 ∧ q.2 < (c.im : Real) + 1 + ∀ (c : GaussianInt), inOpenCell c (cellCenter c) := by + classical + intro cellCenter inOpenCell c + change (c.re : Real) < (cellCenter c).1 ∧ + (cellCenter c).1 < (c.re : Real) + 1 ∧ + (c.im : Real) < (cellCenter c).2 ∧ + (cellCenter c).2 < (c.im : Real) + 1 + simp [cellCenter] + norm_num + +private theorem eastSeedEmpty : + ∀ (T : ProtoTile), ∀ (seed : LatticeCell), (∀ x' ∈ T.cells, x'.re ≤ seed.re) → (seed + 1 ∉ + T.cells) := by + classical + intro T seed hseedMax h + have hle := hseedMax (seed + 1) h + have hlt : seed.re < (seed + 1).re := by simp + omega + +private theorem eastSeedEdge : + ∀ (T : ProtoTile), ∀ (seed : LatticeCell), (seed ∈ T.cells) → ((seed + 1 ∉ T.cells) → + (({seed + 1, seed + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges T)) := by + classical + intro T seed hseed eastSeedEmpty + refine ⟨seed + 1, Or.inr ⟨rfl, Or.inr ?_⟩⟩ + constructor + · simpa using eastSeedEmpty + · simpa using hseed + +private theorem qSeedFront : + ∀ (n : ℕ), ∀ (p : P3381T1PolygonBoundary n), ∀ (U : Set (ℝ × ℝ)), (frontier U = ⋃ (i : Fin + (n + (3 : ℕ))), segment ℝ (p.vertex i) (p.vertex (i + (1 : Fin (n + (3 : ℕ)))))) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + ∀ (seed : LatticeCell), + let qSeed : Real × Real := ((seed.re : Real) + 1, (seed.im : Real) + + 1 / 2) + (qSeed ∈ C) → (qSeed ∈ frontier U)) := by + classical + intro n p U hfrontU C seed qSeed qSeedC + rw [hfrontU] + exact qSeedC + +private theorem hrxLower : + ∀ (seed : LatticeCell), + let qSeed : Real × Real := ((seed.re : Real) + 1, (seed.im : Real) + + 1 / 2) + ∀ (r : ℝ × ℝ), (|qSeed.1 - r.1| < (1 / 4 : Real)) → ((seed.re : Real) + (3 / 4 : Real) < r.1) + := by + classical + intro seed qSeed r hdx + have := abs_lt.mp hdx + dsimp [qSeed] at this + linarith + +private theorem hrxUpper : + ∀ (seed : LatticeCell), + let qSeed : Real × Real := ((seed.re : Real) + 1, (seed.im : Real) + + 1 / 2) + ∀ (r : ℝ × ℝ), (|qSeed.1 - r.1| < (1 / 4 : Real)) → (r.1 < (seed.re : Real) + (5 / 4 : Real)) + := by + classical + intro seed qSeed r hdx + have := abs_lt.mp hdx + dsimp [qSeed] at this + linarith + +private theorem hryLower : + ∀ (seed : LatticeCell), + let qSeed : Real × Real := ((seed.re : Real) + 1, (seed.im : Real) + + 1 / 2) + ∀ (r : ℝ × ℝ), (|qSeed.2 - r.2| < (1 / 4 : Real)) → ((seed.im : Real) < r.2) := by + classical + intro seed qSeed r hdy + have := abs_lt.mp hdy + dsimp [qSeed] at this + linarith + +private theorem hryUpper : + ∀ (seed : LatticeCell), + let qSeed : Real × Real := ((seed.re : Real) + 1, (seed.im : Real) + + 1 / 2) + ∀ (r : ℝ × ℝ), (|qSeed.2 - r.2| < (1 / 4 : Real)) → (((seed.im : Real) < r.2) → (r.2 < + (seed.im : Real) + 1)) := by + classical + intro seed qSeed r hdy hryLower + have := abs_lt.mp hdy + dsimp [qSeed] at this + linarith + +private theorem rnotC : + ∀ (n : ℕ), ∀ (p : P3381T1PolygonBoundary n), ∀ (U : Set (ℝ × ℝ)), ∀ (V : Set (ℝ × ℝ)), (U ∪ + V = (⋃ (i : Fin (n + (3 : ℕ))), segment ℝ (p.vertex i) (p.vertex (i + (1 : Fin (n + (3 : + ℕ))))))ᶜ) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + ∀ (r : ℝ × ℝ), (r ∈ U) → (r ∉ C)) := by + classical + intro n p U V hcover C r hrU + have : r ∈ Cᶜ := by rw [← hcover]; exact Or.inl hrU + exact this + +private theorem hrNotSide : + ∀ (T : ProtoTile), ∀ (n : ℕ), ∀ (p : P3381T1PolygonBoundary n), + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + (∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges T) → (∀ (a : GaussianInt), ∀ (b : + GaussianInt), (e = {a, b}) → ((a ≠ b) → (∀ (q : Real × Real), (q ∈ segment ℝ + (GaussianRealPoint a) (GaussianRealPoint b)) → (q ∈ C))))) → (∀ (seed : LatticeCell), + (({seed + 1, seed + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) → (∀ (r + : ℝ × ℝ), ((seed.im : Real) < r.2) → ((r.2 < (seed.im : Real) + 1) → ((r ∉ C) → (r.1 ≠ + (seed.re : Real) + 1))))) := by + classical + intro T n p C boundary_side_segment_in_C seed eastSeedEdge r hryLower hryUpper rnotC hr + have hside : r ∈ segment ℝ (GaussianRealPoint (seed + 1)) + (GaussianRealPoint (seed + 1 + ⟨0, 1⟩)) := by + rw [segment_eq_image] + refine ⟨r.2 - (seed.im : Real), ⟨by linarith [hryLower], by linarith [hryUpper]⟩, ?_⟩ + apply Prod.ext + · simp? [GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.re_one, + Int.cast_add, Int.cast_one, smul_eq_mul] + rw [hr, (GaussianInt.intCast_re seed).symm] + ring + · simp [GaussianRealPoint, Zsqrtd.im_add, Zsqrtd.im_one, + Int.cast_add, Int.cast_one, smul_eq_mul] + ring + exact rnotC (boundary_side_segment_in_C _ eastSeedEdge _ _ rfl + (by intro h; have hi := congrArg (fun z : GaussianInt => z.im) h; simp at hi) r hside) + +private theorem seedCenterU : + ∀ (T : ProtoTile), ∀ (n : ℕ), ∀ (p : P3381T1PolygonBoundary n), ∀ (U : Set (ℝ × ℝ)), ∀ (V : + Set (ℝ × ℝ)), (Disjoint U V) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex + i) (p.vertex (i + 1)) + (∀ (a : Real × Real), ∀ (b : Real × Real), (segment ℝ a b ⊆ Cᶜ) → (segment ℝ a b ⊆ U ∨ + segment ℝ a b ⊆ V)) → ( + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + let inOpenCell : GaussianInt → (Real × Real) → Prop := fun c q => + (c.re : Real) < q.1 ∧ q.1 < (c.re : Real) + 1 ∧ + (c.im : Real) < q.2 ∧ q.2 < (c.im : Real) + 1 + (∀ (c : GaussianInt), ∀ (q : Real × Real), (q ∈ C) → ((inOpenCell c q) → (False))) → ((∀ (c : + GaussianInt), ∀ (x : Real × Real), ∀ (y : Real × Real), (inOpenCell c x) → ((inOpenCell c + y) → (segment ℝ x y ⊆ {q | inOpenCell c q}))) → ((∀ (c : GaussianInt), inOpenCell c + (cellCenter c)) → ((∀ (c : GaussianInt), (c ∉ T.cells) → (∀ (q : Real × Real), + (inOpenCell c q) → (q ∈ V))) → (∀ (seed : LatticeCell), (seed + 1 ∉ T.cells) → (∀ (r : ℝ + × ℝ), (r ∈ U) → (((seed.re : Real) + (3 / 4 : Real) < r.1) → ((r.1 < (seed.re : Real) + + (5 / 4 : Real)) → (((seed.im : Real) < r.2) → ((r.2 < (seed.im : Real) + 1) → ((r.1 ≠ + (seed.re : Real) + 1) → (cellCenter seed ∈ U))))))))))))) := by + classical + intro T n p U V hdisjoint C segment_stays_on_one_side cellCenter inOpenCell + boundary_disjoint_open_cell open_cell_segment_subset center_in_open_cell + open_complement_cell_in_V seed eastSeedEmpty r hrU hrxLower hrxUpper hryLower hryUpper + hrNotSide + have hcases : r.1 < (seed.re : Real) + 1 ∨ + (seed.re : Real) + 1 < r.1 := lt_or_gt_of_ne hrNotSide + rcases hcases with hleft | hright + · have hrOpen : inOpenCell seed r := by + change (seed.re : Real) < r.1 ∧ r.1 < (seed.re : Real) + 1 ∧ + (seed.im : Real) < r.2 ∧ r.2 < (seed.im : Real) + 1 + exact ⟨by linarith [hrxLower], hleft, hryLower, hryUpper⟩ + have havoid : segment ℝ (cellCenter seed) r ⊆ Cᶜ := by + intro x hx hxC + exact boundary_disjoint_open_cell seed x hxC + (open_cell_segment_subset seed (cellCenter seed) r (center_in_open_cell seed) hrOpen hx) + rcases segment_stays_on_one_side _ _ havoid with hU | hV + · exact hU (left_mem_segment ℝ _ _) + · have hrV : r ∈ V := hV (right_mem_segment ℝ _ _) + exact False.elim ((Set.disjoint_left.mp hdisjoint) hrU hrV) + · have hcomp : seed + 1 ∉ T.cells := eastSeedEmpty + have hrOpen : inOpenCell (seed + 1) r := by + change ((seed + 1).re : Real) < r.1 ∧ r.1 < ((seed + 1).re : Real) + 1 ∧ + ((seed + 1).im : Real) < r.2 ∧ r.2 < ((seed + 1).im : Real) + 1 + simp only [Zsqrtd.re_add, Zsqrtd.re_one, Int.cast_add, Int.cast_one, + Zsqrtd.im_add, Zsqrtd.im_one, add_zero] + exact ⟨hright, by linarith [hrxUpper], hryLower, hryUpper⟩ + have hrV := open_complement_cell_in_V (seed + 1) hcomp r hrOpen + exact False.elim ((Set.disjoint_left.mp hdisjoint) hrU hrV) + +private theorem every_occupied_center_in_U : + ∀ (T : ProtoTile), (FourNeighborConnected (↑T.cells : Set LatticeCell)) → (∀ (U : Set (ℝ × + ℝ)), + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + (∀ (l : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), l.head? = some x → + l.getLast? = some y → (∀ z ∈ l, z ∈ T.cells) → (∀ a, ∀ b, ∀ l₁, ∀ l₂, l = l₁ ++ a :: b :: + l₂ → FourNeighborAdjacent a b) → (cellCenter x ∈ U ↔ cellCenter y ∈ U)) → (∀ (seed : + LatticeCell), (seed ∈ T.cells) → ((cellCenter seed ∈ U) → (∀ z ∈ T.cells, cellCenter z ∈ + U)))) := by + classical + intro T hinside U cellCenter list_occupied_center_transport seed hseed seedCenterU z hz + obtain ⟨l, hlhead, hllast, hlnodes, hlsteps⟩ := hinside.2 seed hseed z hz + have htransport := list_occupied_center_transport l seed z hlhead hllast hlnodes hlsteps + exact htransport.mp seedCenterU + +private theorem tile_cover : + ∀ (T : ProtoTile), ∀ (n : ℕ), ∀ (p : P3381T1PolygonBoundary n), ∀ (U : Set (ℝ × ℝ)), ∀ (V : + Set (ℝ × ℝ)), (Disjoint U V) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex + i) (p.vertex (i + 1)) + (C ⊆ TileRealization T) → ( + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + (∀ (z : GaussianInt), (z ∉ T.cells) → (cellCenter z ∈ V)) → ((∀ (c : GaussianInt), ∀ (q : + Real × Real), (q ∈ ClosedSquareRealization c) → ((q ∉ C) → ((q ∈ U ↔ cellCenter c ∈ U)))) + → ((∀ (z : GaussianInt), (z ∈ T.cells) → (cellCenter z ∈ U)) → (TileRealization T = U ∪ + C))))) := by + classical + intro T n p U V hdisjoint C boundary_carrier_in_tile cellCenter every_complement_center_in_V + square_point_same_domain every_occupied_center_in_U + ext q + constructor + · intro hq + simp only [TileRealization, Set.mem_iUnion] at hq + obtain ⟨c, hc, hqSquare⟩ := hq + by_cases hqC : q ∈ C + · exact Or.inr hqC + · apply Or.inl + exact (square_point_same_domain c q hqSquare hqC).mpr + (every_occupied_center_in_U c hc) + · intro hq + rcases hq with hqU | hqC + · by_cases hqBoundary : q ∈ C + · exact boundary_carrier_in_tile hqBoundary + · let c : GaussianInt := ⟨Int.floor q.1, Int.floor q.2⟩ + have hqSquare : q ∈ ClosedSquareRealization c := by + simp? [ClosedSquareRealization, c, Set.mem_Icc, Prod.le_def] + constructor + · constructor + · exact_mod_cast Int.floor_le q.1 + · exact_mod_cast Int.floor_le q.2 + · constructor + · exact_mod_cast (Int.lt_floor_add_one q.1).le + · exact_mod_cast (Int.lt_floor_add_one q.2).le + by_cases hc : c ∈ T.cells + · simp only [TileRealization, Set.mem_iUnion] + exact ⟨c, hc, hqSquare⟩ + · have hcV := every_complement_center_in_V c hc + have hcU := (square_point_same_domain c q hqSquare hqBoundary).mp hqU + exact False.elim ((Set.disjoint_left.mp hdisjoint) hcU hcV) + · exact boundary_carrier_in_tile hqC + +end SquareUnionDetails + +namespace SquareDomainBlocks + +private theorem every_complement_center_in_V : + ∀ (T : ProtoTile), (FourNeighborConnected (↑T.cells : Set LatticeCell)) → + ((FourNeighborConnected (↑T.cells : Set LatticeCell)ᶜ) → (∀ (n : ℕ), ∀ (p : + P3381T1PolygonBoundary n), ∀ (U : Set (ℝ × ℝ)), ∀ (V : Set (ℝ × ℝ)), + (Bornology.IsBounded U) → ((Disjoint U V) → ((U ∪ V = (⋃ (i : Fin (n + (3 : ℕ))), segment + ℝ (p.vertex i) (p.vertex (i + (1 : Fin (n + (3 : ℕ))))))ᶜ) → ( + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + (⋃ (i : Fin (n + (3 : ℕ))), segment ℝ (p.vertex i) (p.vertex (i + (1 : Fin (n + (3 : ℕ))))) ⊆ + TileRealization T) → ((∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), segment ℝ a b ⊆ Cᶜ → segment ℝ a b ⊆ + U ∨ segment ℝ a b ⊆ V) → ( + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + ∀ z ∉ T.cells, cellCenter z ∈ V))))))) := by + classical + intro T hinside houtside n p U V hUbounded hdisjoint hcover C boundary_carrier_in_tile + segment_stays_on_one_side cellCenter z hz + have east_center_segment_outside (a : GaussianInt) + (ha : a ∉ T.cells) (hb : a + 1 ∉ T.cells) := SquareUnionProof.east_center_segment_outside T + a ha hb + have north_center_segment_outside (a : GaussianInt) + (ha : a ∉ T.cells) (hb : a + ⟨0, 1⟩ ∉ T.cells) := + SquareUnionProof.north_center_segment_outside T a ha hb + have complement_adjacent_segment_avoid (a b : GaussianInt) + (hab : FourNeighborAdjacent a b) (ha : a ∉ T.cells) (hb : b ∉ T.cells) := + SquareUnionProof.complement_adjacent_segment_avoid T n p boundary_carrier_in_tile + east_center_segment_outside north_center_segment_outside a b hab ha hb + have center_not_tile (a : GaussianInt) (ha : a ∉ T.cells) := SquareUnionProof.center_not_tile T + a ha + have center_in_domain (a : GaussianInt) (ha : a ∉ T.cells) := SquareUnionProof.center_in_domain + T n p U V hcover + boundary_carrier_in_tile center_not_tile a ha + have complement_adjacent_same_domain (a b : GaussianInt) + (hab : FourNeighborAdjacent a b) (ha : a ∉ T.cells) (hb : b ∉ T.cells) := + SquareUnionProof.complement_adjacent_same_domain T + n p U V hdisjoint segment_stays_on_one_side complement_adjacent_segment_avoid a b hab + ha hb + have list_center_transport := SquareUnionProof.list_center_transport T U + complement_adjacent_same_domain + have farComplementCell := SquareUnionProof.farComplementCell T hinside U hUbounded + obtain ⟨farCell, hfarCell, hfarNotU⟩ := farComplementCell + exact SquareUnionDetails.every_complement_center_in_V T houtside U V center_in_domain + list_center_transport farCell hfarCell hfarNotU z hz + +end SquareDomainBlocks + +private theorem identificationFromExteriorCenters + (T : ProtoTile) (hinside : FourNeighborConnected (T.cells : Set LatticeCell)) + {n : Nat} (p : P3381T1PolygonBoundary n) (v : Fin (n + 3) → GaussianInt) + (hvertex : ∀ i, p.vertex i = GaussianRealPoint (v i)) + (hedges : BoundaryFootprintEdges T = {e | ∃ i, e = {v i, v (i + 1)}}) + (U V : Set (Real × Real)) (hUopen : IsOpen U) (hVopen : IsOpen V) + (hdisjoint : Disjoint U V) + (hcover : U ∪ V = (⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)))ᶜ) + (hfrontU : frontier U = ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1))) : + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + (∀ z, z ∉ T.cells → cellCenter z ∈ V) → TileRealization T = U ∪ C := by + classical + intro C cellCenter every_complement_center_in_V + have edge_support (e : Finset GaussianInt) (he : e ∈ BoundaryFootprintEdges T) := + SquareUnionProof.edge_support T e he + have edge_endpoint_square (z : GaussianInt) (e : Finset GaussianInt) + (he : e = {z, z + 1} ∨ e = {z, z + ⟨0, 1⟩} ∨ + e = {z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} ∨ + e = {z + 1, z + 1 + ⟨0, 1⟩}) + (w : GaussianInt) (hw : w ∈ e) := SquareUnionProof.edge_endpoint_square z + e he w hw + have boundary_carrier_in_tile := SquareUnionProof.boundary_carrier_in_tile T n p v hvertex + hedges edge_support + edge_endpoint_square + have segment_stays_on_one_side (a b : Real × Real) + (havoid : segment ℝ a b ⊆ Cᶜ) := SquareUnionProof.segment_stays_on_one_side n p U V + hUopen hVopen hdisjoint hcover a b havoid + have pair_eq_cases (a b c d : GaussianInt) + (hcd : c ≠ d) (hpair : ({a, b} : Finset GaussianInt) = {c, d}) := + SquareUnionProof.pair_eq_cases a b c d hcd hpair + have boundary_side_segment_in_C (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) (a b : GaussianInt) + (hab : e = {a, b}) (habne : a ≠ b) (q : Real × Real) + (hq : q ∈ segment ℝ (GaussianRealPoint a) (GaussianRealPoint b)) := + SquareUnionProof.boundary_side_segment_in_C T n p v hvertex hedges pair_eq_cases e he a + b hab habne q hq + have east_side_not_boundary (a : GaussianInt) + (hsame : (a ∈ T.cells ↔ a + 1 ∈ T.cells)) := SquareUnionProof.east_side_not_boundary T + pair_eq_cases a hsame + have north_side_not_boundary (a : GaussianInt) + (hsame : (a ∈ T.cells ↔ a + ⟨0, 1⟩ ∈ T.cells)) := SquareUnionProof.north_side_not_boundary + T pair_eq_cases a hsame + have boundary_edge_adjacent (i : Fin (n + 3)) + (he : ({v i, v (i + 1)} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) := + SquareUnionProof.boundary_edge_adjacent T n v + edge_support pair_eq_cases i he + have boundary_carrier_has_integer_coordinate (q : Real × Real) (hq : q ∈ C) := + SquareUnionProof.boundary_carrier_has_integer_coordinate T n p v hvertex hedges + edge_support pair_eq_cases SquareUnionDetails.horizontal_segment_y + SquareUnionDetails.vertical_segment_x q hq + have east_same_center_segment_avoids (a : GaussianInt) + (hsame : (a ∈ T.cells ↔ a + 1 ∈ T.cells)) := + SquareUnionProof.east_same_center_segment_avoids T n p v hvertex hedges + east_side_not_boundary boundary_edge_adjacent boundary_carrier_has_integer_coordinate a + hsame + have north_same_center_segment_avoids (a : GaussianInt) + (hsame : (a ∈ T.cells ↔ a + ⟨0, 1⟩ ∈ T.cells)) := + SquareUnionProof.north_same_center_segment_avoids T n p v hvertex hedges + north_side_not_boundary boundary_edge_adjacent boundary_carrier_has_integer_coordinate + a hsame + have occupied_same_adjacent_avoid (a b : GaussianInt) + (hab : FourNeighborAdjacent a b) + (ha : a ∈ T.cells) (hb : b ∈ T.cells) := SquareUnionProof.occupied_same_adjacent_avoid T n + p east_same_center_segment_avoids + north_same_center_segment_avoids a b hab ha hb + have occupied_adjacent_same_domain (a b : GaussianInt) + (hab : FourNeighborAdjacent a b) (ha : a ∈ T.cells) (hb : b ∈ T.cells) := + SquareUnionProof.occupied_adjacent_same_domain T n + p U V hdisjoint segment_stays_on_one_side occupied_same_adjacent_avoid a b hab ha hb + have list_occupied_center_transport := SquareUnionProof.list_occupied_center_transport T + U occupied_adjacent_same_domain + let inOpenCell : GaussianInt → (Real × Real) → Prop := fun c q => + (c.re : Real) < q.1 ∧ q.1 < (c.re : Real) + 1 ∧ + (c.im : Real) < q.2 ∧ q.2 < (c.im : Real) + 1 + have boundary_disjoint_open_cell (c : GaussianInt) (q : Real × Real) + (hq : q ∈ C) (hcell : inOpenCell c q) := SquareUnionProof.boundary_disjoint_open_cell n p + boundary_carrier_has_integer_coordinate c q hq hcell + have open_cell_segment_subset (c : GaussianInt) (x y : Real × Real) + (hx : inOpenCell c x) (hy : inOpenCell c y) := SquareUnionProof.open_cell_segment_subset c + x y hx hy + have center_to_square_point_avoid (c : GaussianInt) (q : Real × Real) + (hq : q ∈ ClosedSquareRealization c) (hqC : q ∉ C) := + SquareUnionProof.center_to_square_point_avoid n p + boundary_disjoint_open_cell c q hq hqC + have square_point_same_domain (c : GaussianInt) (q : Real × Real) + (hq : q ∈ ClosedSquareRealization c) (hqC : q ∉ C) := + SquareUnionProof.square_point_same_domain n p U V hdisjoint + segment_stays_on_one_side center_to_square_point_avoid c q hq hqC + have center_in_open_cell (c : GaussianInt) := SquareUnionDetails.center_in_open_cell c + have open_complement_cell_in_V (c : GaussianInt) (hc : c ∉ T.cells) + (q : Real × Real) (hq : inOpenCell c q) := SquareUnionProof.open_complement_cell_in_V T n p + U V hdisjoint + segment_stays_on_one_side every_complement_center_in_V boundary_disjoint_open_cell + open_cell_segment_subset center_in_open_cell c hc q hq + obtain ⟨seed, hseed, hseedMax⟩ := T.cells.exists_max_image (fun z => z.re) hinside.1 + have eastSeedEmpty := SquareUnionDetails.eastSeedEmpty T seed hseedMax + have eastSeedEdge := SquareUnionDetails.eastSeedEdge T seed hseed eastSeedEmpty + let qSeed : Real × Real := ((seed.re : Real) + 1, (seed.im : Real) + 1 / 2) + have qSeedSide := SquareUnionProof.qSeedSide seed + have qSeedC : qSeed ∈ C := + boundary_side_segment_in_C _ eastSeedEdge _ _ rfl (by + intro h + have hi := congrArg (fun z : GaussianInt => z.im) h + simp at hi) qSeed qSeedSide + have qSeedFront := SquareUnionDetails.qSeedFront n p U hfrontU seed qSeedC + have qSeedClosure : qSeed ∈ closure U := frontier_subset_closure qSeedFront + obtain ⟨r, hrU, hrdist⟩ := + (Metric.mem_closure_iff.mp qSeedClosure) (1 / 4) (by norm_num) + have hdist : max |qSeed.1 - r.1| |qSeed.2 - r.2| < (1 / 4 : Real) := by + simpa [Prod.dist_eq, Real.dist_eq, qSeed] using hrdist + have hdx : |qSeed.1 - r.1| < (1 / 4 : Real) := (max_lt_iff.mp hdist).1 + have hdy : |qSeed.2 - r.2| < (1 / 4 : Real) := (max_lt_iff.mp hdist).2 + have hrxLower := SquareUnionDetails.hrxLower seed r hdx + have hrxUpper := SquareUnionDetails.hrxUpper seed r hdx + have hryLower := SquareUnionDetails.hryLower seed r hdy + have hryUpper := SquareUnionDetails.hryUpper seed r hdy hryLower + have rnotC := SquareUnionDetails.rnotC n p U V hcover r hrU + have hrNotSide := SquareUnionDetails.hrNotSide T n p boundary_side_segment_in_C seed + eastSeedEdge r hryLower hryUpper rnotC + have seedCenterU := SquareUnionDetails.seedCenterU T n p U V hdisjoint + segment_stays_on_one_side boundary_disjoint_open_cell open_cell_segment_subset + center_in_open_cell open_complement_cell_in_V seed eastSeedEmpty r hrU hrxLower hrxUpper + hryLower hryUpper hrNotSide + have every_occupied_center_in_U (z : GaussianInt) (hz : z ∈ T.cells) := + SquareUnionDetails.every_occupied_center_in_U T hinside U list_occupied_center_transport + seed hseed seedCenterU z hz + have tile_cover := SquareUnionDetails.tile_cover T n p U V hdisjoint boundary_carrier_in_tile + every_complement_center_in_V square_point_same_domain every_occupied_center_in_U + exact tile_cover + + +theorem P3475T1SquareUnionIdentification : + ∀ (T : ProtoTile), (FourNeighborConnected (T.cells : Set LatticeCell)) → + ((FourNeighborConnected ((T.cells : Set LatticeCell)ᶜ)) → (∀ {n : Nat}, ∀ (p : + P3381T1PolygonBoundary n), ∀ (v : Fin (n + 3) → GaussianInt), (∀ i, p.vertex i = + GaussianRealPoint (v i)) → ((BoundaryFootprintEdges T = {e | ∃ i, e = {v i, v (i + 1)}}) + → (∀ (U : Set (Real × Real)), ∀ (V : Set (Real × Real)), (IsOpen U) → ((IsConnected U) → + ((Bornology.IsBounded U) → ((IsOpen V) → ((IsConnected V) → ((¬ Bornology.IsBounded V) → + ((Disjoint U V) → ((U ∪ V = (⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)))ᶜ) → + ((frontier U = ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1))) → ((frontier V = ⋃ i, + segment Real (p.vertex i) (p.vertex (i + 1))) → (TileRealization T = U ∪ ⋃ i, segment + Real (p.vertex i) (p.vertex (i + 1)))))))))))))))) := by + intro T hinside houtside n p v hvertex hedges U V hUopen hUconn hUbounded hVopen hVconn + hVunbounded hdisjoint hcover hfrontU hfrontV +-- BODY + classical + let C : Set (Real × Real) := ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)); + have edge_support (e : Finset GaussianInt) (he : e ∈ BoundaryFootprintEdges T) := + SquareUnionProof.edge_support T e he + have edge_endpoint_square (z : GaussianInt) (e : Finset GaussianInt) + (he : e = {z, z + 1} ∨ e = {z, z + ⟨0, 1⟩} ∨ + e = {z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} ∨ + e = {z + 1, z + 1 + ⟨0, 1⟩}) + (w : GaussianInt) (hw : w ∈ e) := SquareUnionProof.edge_endpoint_square z + e he w hw + have boundary_carrier_in_tile := SquareUnionProof.boundary_carrier_in_tile T n p v hvertex + hedges edge_support + edge_endpoint_square + have segment_stays_on_one_side (a b : Real × Real) + (havoid : segment ℝ a b ⊆ Cᶜ) := SquareUnionProof.segment_stays_on_one_side n p U V + hUopen hVopen hdisjoint hcover a b havoid + let cellCenter : GaussianInt → Real × Real := fun z => + ((z.re : Real) + (1 / 2 : Real), (z.im : Real) + (1 / 2 : Real)) + have every_complement_center_in_V (z : GaussianInt) (hz : z ∉ T.cells) : + cellCenter z ∈ V := SquareDomainBlocks.every_complement_center_in_V T hinside houtside n p + U V hUbounded hdisjoint hcover boundary_carrier_in_tile segment_stays_on_one_side z hz + exact identificationFromExteriorCenters T hinside p v hvertex hedges U V + hUopen hVopen hdisjoint hcover hfrontU every_complement_center_in_V + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1TriangleTree.lean b/LeanPool/ApollonianSuperharmonic/P3475T1TriangleTree.lean new file mode 100644 index 0000000000..8a458c9147 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3475T1TriangleTree.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3381T1PairedTriangulation + +-- [TABLET NODE: P3475T1TriangleTree] + +/-! +# P3475T1TriangleTree + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a boundary $p$ and plane sets $X,K$, an exact triangle attachment tree +contains all the data and certificates of +`P3381T1PairedTriangulation` for $(p,X,K)$, together with a +positive triangle count and a permutation $o$ of the triangle indices. +For every $k>0$ there are distinct indices $a,b,c$ such that the $k$th +triangle in this order has vertex set $\{a,b,c\}$, $c$ occurs in no +earlier triangle, and precisely one earlier triangle contains both +$a,b$. In both the source and target realizations, the intersection of +this triangle with the union of all earlier closed triangles is exactly +the entire segment joining the vertices $a,b$. +In particular the new triangle is attached along one old boundary edge; +it has no additional contact with the old union. This records finite +attachment geometry, not connected complementary domains. +-/ +structure P3475T1TriangleTree {n : Nat} + (p : P3381T1PolygonBoundary n) (X K : Set (Real × Real)) + extends P3381T1PairedTriangulation p X K where +-- BODY + count_pos : 0 < count + /-- The triangle attachment order, with each later triangle attached along one old edge. -/ + order : Fin count ≃ Fin count + attachment : ∀ k : Fin count, 0 < k.val → + ∃ a b c : Fin (n + 3), a ≠ b ∧ a ≠ c ∧ b ≠ c ∧ + Set.range (face (order k)) = {a, b, c} ∧ + (∀ l : Fin count, l.val < k.val → c ∉ Set.range (face (order l))) ∧ + Set.ncard {l : Fin count | l.val < k.val ∧ + a ∈ Set.range (face (order l)) ∧ b ∈ Set.range (face (order l))} = 1 ∧ + (convexHull Real (Set.range (p.vertex ∘ face (order k))) ∩ + (⋃ l : {l : Fin count // l.val < k.val}, + convexHull Real (Set.range (p.vertex ∘ face (order l.val))))) = + segment Real (p.vertex a) (p.vertex b) ∧ + (convexHull Real (Set.range (target ∘ face (order k))) ∩ + (⋃ l : {l : Fin count // l.val < k.val}, + convexHull Real (Set.range (target ∘ face (order l.val))))) = + segment Real (target a) (target b) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1UnitSegmentIntersection.lean b/LeanPool/ApollonianSuperharmonic/P3475T1UnitSegmentIntersection.lean new file mode 100644 index 0000000000..07b73d377c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3475T1UnitSegmentIntersection.lean @@ -0,0 +1,233 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import Mathlib.Analysis.Convex.Segment +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P3475T1UnitSegmentIntersection] + +/-! +# P3475T1UnitSegmentIntersection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3475T1UnitSegmentIntersection (a b c d : GaussianInt) + (hab : FourNeighborAdjacent a b) (hcd : FourNeighborAdjacent c d) + (hne : ({a, b} : Finset GaussianInt) ≠ {c, d}) : + segment Real (GaussianRealPoint a) (GaussianRealPoint b) ∩ + segment Real (GaussianRealPoint c) (GaussianRealPoint d) = + {z | (z = GaussianRealPoint a ∨ z = GaussianRealPoint b) ∧ + (z = GaussianRealPoint c ∨ z = GaussianRealPoint d)} := by +-- BODY + have horizontal (a : GaussianInt) (z : Real × Real) : + z ∈ segment Real (GaussianRealPoint a) (GaussianRealPoint (a + 1)) ↔ + z.2 = (a.im : Real) ∧ (a.re : Real) ≤ z.1 ∧ z.1 ≤ (a.re : Real) + 1 := by + rw [segment_eq_image] + constructor + · rintro ⟨t, ht, rfl⟩ + simp only [Set.mem_Icc] at ht + simp only [GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, + Zsqrtd.im_one, Int.cast_add, Int.cast_one, add_zero, Prod.smul_fst, + Prod.smul_snd, Prod.fst_add, Prod.snd_add, smul_eq_mul] + exact ⟨by ring, by nlinarith [ht.1], by nlinarith [ht.2]⟩ + · rintro ⟨hy, hx0, hx1⟩ + refine ⟨z.1 - (a.re : Real), ⟨by linarith, by linarith⟩, ?_⟩ + apply Prod.ext + · simp only [GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.re_one, Int.cast_add, + Int.cast_one, Prod.smul_fst, Prod.fst_add, smul_eq_mul] + ring + · simp only [GaussianRealPoint, Zsqrtd.im_add, Zsqrtd.im_one, add_zero, + Prod.smul_snd, Prod.snd_add, smul_eq_mul] + nlinarith + have vertical (a : GaussianInt) (z : Real × Real) : + z ∈ segment Real (GaussianRealPoint a) (GaussianRealPoint (a + ⟨0, 1⟩)) ↔ + z.1 = (a.re : Real) ∧ (a.im : Real) ≤ z.2 ∧ z.2 ≤ (a.im : Real) + 1 := by + rw [segment_eq_image] + constructor + · rintro ⟨t, ht, rfl⟩ + simp only [Set.mem_Icc] at ht + simp only [GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.im_add, + Int.cast_add, Int.cast_one, add_zero, Prod.smul_fst, + Prod.smul_snd, Prod.fst_add, Prod.snd_add, smul_eq_mul] + exact ⟨by ring, by nlinarith [ht.1], by nlinarith [ht.2]⟩ + · rintro ⟨hx, hy0, hy1⟩ + refine ⟨z.2 - (a.im : Real), ⟨by linarith, by linarith⟩, ?_⟩ + apply Prod.ext + · simp only [GaussianRealPoint, Zsqrtd.re_add, + add_zero, Prod.smul_fst, Prod.fst_add, smul_eq_mul] + nlinarith + · simp only [GaussianRealPoint, Zsqrtd.im_add, Int.cast_add, Int.cast_one, + Prod.smul_snd, Prod.snd_add, smul_eq_mul] + ring + have integer_interval (u v : Int) (x : Real) (hu : (u : Real) ≤ x) + (hu' : x ≤ (u : Real) + 1) (hv : (v : Real) ≤ x) + (hv' : x ≤ (v : Real) + 1) (hne : u ≠ v) : + (x = (u : Real) ∨ x = (u : Real) + 1) ∧ + (x = (v : Real) ∨ x = (v : Real) + 1) := by + by_cases hlt : u < v + · have hgap : (u : Real) + 1 ≤ (v : Real) := by + exact_mod_cast (show u + 1 ≤ v by omega) + exact ⟨Or.inr (by linarith), Or.inl (by linarith)⟩ + · have hgap : (v : Real) + 1 ≤ (u : Real) := by + exact_mod_cast (show v + 1 ≤ u by omega) + exact ⟨Or.inl (by linarith), Or.inr (by linarith)⟩ + have cross (a c : GaussianInt) (z : Real × Real) + (ha : z ∈ segment Real (GaussianRealPoint a) (GaussianRealPoint (a + 1))) + (hc : z ∈ segment Real (GaussianRealPoint c) + (GaussianRealPoint (c + ⟨0, 1⟩))) : + (z = GaussianRealPoint a ∨ z = GaussianRealPoint (a + 1)) ∧ + (z = GaussianRealPoint c ∨ z = GaussianRealPoint (c + ⟨0, 1⟩)) := by + rcases (horizontal a z).mp ha with ⟨hy, hx0, hx1⟩ + rcases (vertical c z).mp hc with ⟨hx, hy0, hy1⟩ + have hx0' : a.re ≤ c.re := by exact_mod_cast (hx ▸ hx0) + have hx1' : c.re ≤ a.re + 1 := by exact_mod_cast (hx ▸ hx1) + have hy0' : c.im ≤ a.im := by exact_mod_cast (hy ▸ hy0) + have hy1' : a.im ≤ c.im + 1 := by exact_mod_cast (hy ▸ hy1) + constructor + · have h : c.re = a.re ∨ c.re = a.re + 1 := by omega + rcases h with h | h + · left + apply Prod.ext <;> simp only [GaussianRealPoint] + · rw [hx, h] + · exact hy + · right + apply Prod.ext + · simpa only [GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.re_one, + Int.cast_add, Int.cast_one] using hx.trans (congrArg (fun t : Int => (t : Real)) h) + · simpa only [GaussianRealPoint, Zsqrtd.im_add, Zsqrtd.im_one, add_zero] using hy + · have h : a.im = c.im ∨ a.im = c.im + 1 := by omega + rcases h with h | h + · left + apply Prod.ext <;> simp only [GaussianRealPoint] + · exact hx + · rw [hy, h] + · right + apply Prod.ext + · simpa only [GaussianRealPoint, Zsqrtd.re_add, Int.cast_add, Int.cast_zero, + add_zero] using hx + · simpa only [GaussianRealPoint, Zsqrtd.im_add, Int.cast_add, Int.cast_one] + using hy.trans (congrArg (fun t : Int => (t : Real)) h) + have canonical (a c u v : GaussianInt) (hu : u = 1 ∨ u = ⟨0, 1⟩) + (hv : v = 1 ∨ v = ⟨0, 1⟩) + (hne : ({a, a + u} : Finset GaussianInt) ≠ {c, c + v}) + (z : Real × Real) + (ha : z ∈ segment Real (GaussianRealPoint a) (GaussianRealPoint (a + u))) + (hc : z ∈ segment Real (GaussianRealPoint c) (GaussianRealPoint (c + v))) : + (z = GaussianRealPoint a ∨ z = GaussianRealPoint (a + u)) ∧ + (z = GaussianRealPoint c ∨ z = GaussianRealPoint (c + v)) := by + rcases hu with rfl | rfl <;> rcases hv with rfl | rfl + · rcases (horizontal a z).mp ha with ⟨hyA, hA0, hA1⟩ + rcases (horizontal c z).mp hc with ⟨hyC, hC0, hC1⟩ + have him : a.im = c.im := by exact_mod_cast hyA.symm.trans hyC + have hre : a.re ≠ c.re := by + intro h + have heq : a = c := Zsqrtd.ext h him + exact hne (by rw [heq]) + rcases integer_interval a.re c.re z.1 hA0 hA1 hC0 hC1 hre with ⟨hA, hC⟩ + constructor + · rcases hA with h | h + · left; exact Prod.ext h hyA + · right + apply Prod.ext + · simpa only [GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.re_one, + Int.cast_add, Int.cast_one] using h + · simpa only [GaussianRealPoint, Zsqrtd.im_add, Zsqrtd.im_one, add_zero] using hyA + · rcases hC with h | h + · left; exact Prod.ext h hyC + · right + apply Prod.ext + · simpa only [GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.re_one, + Int.cast_add, Int.cast_one] using h + · simpa only [GaussianRealPoint, Zsqrtd.im_add, Zsqrtd.im_one, add_zero] using hyC + · exact cross a c z ha hc + · exact (cross c a z hc ha).symm + · rcases (vertical a z).mp ha with ⟨hxA, hA0, hA1⟩ + rcases (vertical c z).mp hc with ⟨hxC, hC0, hC1⟩ + have hre : a.re = c.re := by exact_mod_cast hxA.symm.trans hxC + have him : a.im ≠ c.im := by + intro h + have heq : a = c := Zsqrtd.ext hre h + exact hne (by rw [heq]) + rcases integer_interval a.im c.im z.2 hA0 hA1 hC0 hC1 him with ⟨hA, hC⟩ + constructor + · rcases hA with h | h + · left; exact Prod.ext hxA h + · right + apply Prod.ext + · simpa only [GaussianRealPoint, Zsqrtd.re_add, Int.cast_add, + Int.cast_zero, add_zero] using hxA + · simpa only [GaussianRealPoint, Zsqrtd.im_add, Int.cast_add, Int.cast_one] using h + · rcases hC with h | h + · left; exact Prod.ext hxC h + · right + apply Prod.ext + · simpa only [GaussianRealPoint, Zsqrtd.re_add, Int.cast_add, + Int.cast_zero, add_zero] using hxC + · simpa only [GaussianRealPoint, Zsqrtd.im_add, Int.cast_add, Int.cast_one] using h + have normalize (a b : GaussianInt) (hab : FourNeighborAdjacent a b) : + ∃ a0 u : GaussianInt, (u = 1 ∨ u = ⟨0, 1⟩) ∧ + ({a, b} : Finset GaussianInt) = {a0, a0 + u} ∧ + segment Real (GaussianRealPoint a) (GaussianRealPoint b) = + segment Real (GaussianRealPoint a0) (GaussianRealPoint (a0 + u)) := by + rcases hab with rfl | rfl | rfl | rfl + · exact ⟨a, 1, Or.inl rfl, rfl, rfl⟩ + · refine ⟨a - 1, 1, Or.inl rfl, ?_, ?_⟩ + · simp [Finset.pair_comm] + · simpa using segment_symm Real (GaussianRealPoint a) (GaussianRealPoint (a - 1)) + · exact ⟨a, ⟨0, 1⟩, Or.inr rfl, rfl, rfl⟩ + · refine ⟨a - ⟨0, 1⟩, ⟨0, 1⟩, Or.inr rfl, ?_, ?_⟩ + · simp [Finset.pair_comm] + · simpa using segment_symm Real (GaussianRealPoint a) + (GaussianRealPoint (a - ⟨0, 1⟩)) + obtain ⟨a0, u, hu, hpairA, hsegA⟩ := normalize a b hab + obtain ⟨c0, v, hv, hpairC, hsegC⟩ := normalize c d hcd + ext z + constructor + · rintro ⟨ha, hc⟩ + rw [hsegA] at ha + rw [hsegC] at hc + have hne' : ({a0, a0 + u} : Finset GaussianInt) ≠ {c0, c0 + v} := by + rwa [← hpairA, ← hpairC] + obtain ⟨hA, hC⟩ := canonical a0 c0 u v hu hv hne' z ha hc + have endpoints (a b a0 u : GaussianInt) + (hpair : ({a, b} : Finset GaussianInt) = {a0, a0 + u}) + (h : z = GaussianRealPoint a0 ∨ z = GaussianRealPoint (a0 + u)) : + z = GaussianRealPoint a ∨ z = GaussianRealPoint b := by + rcases h with h | h + · have hm : a0 ∈ ({a, b} : Finset GaussianInt) := by rw [hpair]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at hm + rcases hm with hm | hm + · exact Or.inl (h.trans (congrArg GaussianRealPoint hm)) + · exact Or.inr (h.trans (congrArg GaussianRealPoint hm)) + · have hm : a0 + u ∈ ({a, b} : Finset GaussianInt) := by rw [hpair]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at hm + rcases hm with hm | hm + · exact Or.inl (h.trans (congrArg GaussianRealPoint hm)) + · exact Or.inr (h.trans (congrArg GaussianRealPoint hm)) + exact ⟨endpoints a b a0 u hpairA hA, endpoints c d c0 v hpairC hC⟩ + · rintro ⟨ha, hc⟩ + constructor + · rcases ha with rfl | rfl + · exact left_mem_segment Real _ _ + · exact right_mem_segment Real _ _ + · rcases hc with rfl | rfl + · exact left_mem_segment Real _ _ + · exact right_mem_segment Real _ _ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean b/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean new file mode 100644 index 0000000000..b1aa68197f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean @@ -0,0 +1,1079 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundarySubdivision +public import LeanPool.ApollonianSuperharmonic.P3497T1StrictCornerSplice + +-- [TABLET NODE: P3497T1SingleStraightDeletion] + +/-! +# P3497T1SingleStraightDeletion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace StraightDeletionConstruction + +private noncomputable abbrev M (n : Nat) := n + 4 + +private noncomputable abbrev L (n : Nat) := n + 3 + +private noncomputable abbrev rot (n : Nat) (i : Fin ((n + 1) + 3)) : Fin (M n) → Fin (M n) := by + classical + let M := n + 4 + dsimp only [StraightDeletionConstruction.M] at * + change (Fin M → Fin M) + exact fun h => i + h + +private noncomputable abbrev sig (n : Nat) : Fin (L n) → Fin (M n) := by + classical + let M := n + 4 + let L := n + 3 + dsimp only [StraightDeletionConstruction.M, StraightDeletionConstruction.L] at * + change (Fin L → Fin M) + exact fun k => + ⟨if k.val = 0 then 0 else k.val + 1, by split_ifs <;> omega⟩ + +private theorem hM (n : Nat) : 4 ≤ (M n) := by + classical + let M := n + 4 + dsimp only [StraightDeletionConstruction.M] at * + change (4 ≤ M) + dsimp [M]; omega + +private theorem hM1 (n : Nat) : 1 < (M n) := by + classical + let M := n + 4 + have hM : 4 ≤ M := hM n + dsimp only [StraightDeletionConstruction.M] at * + change (1 < M) + omega + +private theorem hM2 (n : Nat) : 2 < (M n) := by + classical + let M := n + 4 + have hM : 4 ≤ M := hM n + dsimp only [StraightDeletionConstruction.M] at * + change (2 < M) + omega + +private theorem hM3 (n : Nat) : 3 < (M n) := by + classical + let M := n + 4 + have hM : 4 ≤ M := hM n + dsimp only [StraightDeletionConstruction.M] at * + change (3 < M) + omega + +private theorem hL1 (n : Nat) : 1 < (L n) := by + classical + let M := n + 4 + let L := n + 3 + have hM : 4 ≤ M := hM n + dsimp only [StraightDeletionConstruction.L] at * + change (1 < L) + dsimp [L]; omega + +private theorem hLM (n : Nat) : (L n) + 1 = (M n) := by + rfl + +private theorem hrot (n : Nat) (i : Fin ((n + 1) + 3)) : Function.Injective (rot n i) := by + classical + let M := n + 4 + let rot : Fin M → Fin M := fun h => i + h + change (Function.Injective rot) + intro a b hab + apply Fin.ext + have hv := congrArg Fin.val hab + simp only [rot, Fin.val_add_eq_ite] at hv + simp only [M] at hv + have hi := i.isLt + have hla := a.isLt + have hlb := b.isLt + simp only [M] at hi hla hlb + by_cases ha : n + 4 ≤ i.val + a.val <;> + by_cases hb : n + 4 ≤ i.val + b.val <;> simp_all <;> omega + +private theorem hsig (n : Nat) : Function.Injective (sig n) := by + classical + let M := n + 4 + let L := n + 3 + let sig : Fin L → Fin M := fun k => + ⟨if k.val = 0 then 0 else k.val + 1, by split_ifs <;> omega⟩ + change (Function.Injective sig) + intro a b hab + apply Fin.ext + have hv := congrArg Fin.val hab + simp only [sig] at hv + split_ifs at hv <;> omega + +private theorem hrotSucc (n : Nat) (i : Fin ((n + 1) + 3)) (h : Fin (M n)) : (rot n i) (h + 1) = + (rot n i) h + 1 := by + classical + let M := n + 4 + let rot : Fin M → Fin M := fun h => i + h + dsimp only [StraightDeletionConstruction.M] at * + change (rot (h + 1) = rot h + 1) + apply Fin.ext + change (i.val + (h.val + 1) % M) % M = + ((i.val + h.val) % M + 1) % M + calc + (i.val + (h.val + 1) % M) % M = + ((h.val + 1) % M + i.val) % M := by rw [Nat.add_comm] + _ = (h.val + 1 + i.val) % M := Nat.mod_add_mod (h.val + 1) M i.val + _ = (i.val + h.val + 1) % M := by congr 1; omega + _ = ((i.val + h.val) % M + 1) % M := (Nat.mod_add_mod (i.val + h.val) M 1).symm + +private theorem hsigSucc (n : Nat) (k : Fin (L n)) (hk : k.val ≠ 0) : + (sig n) (k + 1) = (sig n) k + 1 := by + classical + let M := n + 4 + let L := n + 3 + let sig : Fin L → Fin M := fun k => + ⟨if k.val = 0 then 0 else k.val + 1, by split_ifs <;> omega⟩ + have hM1 : 1 < M := hM1 n + have hL1 : 1 < L := hL1 n + have hLM : L + 1 = M := hLM n + dsimp only [StraightDeletionConstruction.L] at * + change (sig (k + 1) = sig k + 1) + apply Fin.ext + have hpos : 0 < k.val := Nat.pos_of_ne_zero hk + have hk0 : k ≠ 0 := by + intro h + apply hk + exact congrArg Fin.val h + by_cases hlast : k.val + 1 = L + · simp [sig, Fin.val_add_eq_ite, hlast, + hk0, hLM, Nat.mod_eq_of_lt hM1, Nat.mod_eq_of_lt hL1] + · have hklt : k.val < L := k.isLt + have hnext : k.val + 1 < L := by omega + have hbound : k.val + 2 < M := by omega + have hcond1 : ¬ L ≤ k.val + 1 := by omega + have hcond2 : ¬ M ≤ k.val + 1 + 1 := by omega + simp [sig, Fin.val_add_eq_ite, hk, + hk0, Nat.mod_eq_of_lt hM1, + Nat.mod_eq_of_lt hL1, hcond1, hcond2] + +private noncomputable abbrev r (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i : Fin ((n + 1) + + 3)) : Fin (M n) → Real × Real := by + classical + let M := n + 4 + let rot : Fin M → Fin M := fun h => i + h + dsimp only [StraightDeletionConstruction.M] at * + change (Fin M → Real × Real) + exact fun h => p.vertex (rot h) + +private theorem hr (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i : Fin ((n + 1) + 3)) : + Function.Injective (r n p i) := by + classical + let M := n + 4 + let rot : Fin M → Fin M := fun h => i + h + have hrot : Function.Injective rot := hrot n i + let r : Fin M → Real × Real := fun h => p.vertex (rot h) + change (Function.Injective r) + intro a b hab + exact hrot (p.injective hab) + +private theorem ha (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i : Fin ((n + 1) + 3)) : (r + n p i) 0 ≠ (r n p i) 1 := by + classical + let M := n + 4 + let rot : Fin M → Fin M := fun h => i + h + have hM1 : 1 < M := hM1 n + let r : Fin M → Real × Real := fun h => p.vertex (rot h) + have hr : Function.Injective r := hr n p i + change (r 0 ≠ r 1) + intro h + have h01 : (0 : Fin M) = 1 := hr h + have hv := congrArg Fin.val h01 + simp [Nat.mod_eq_of_lt hM1] at hv + +private theorem hbc (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i : Fin ((n + 1) + 3)) : (r + n p i) 1 ≠ (r n p i) 2 := by + classical + let M := n + 4 + let rot : Fin M → Fin M := fun h => i + h + have hM1 : 1 < M := hM1 n + have hM2 : 2 < M := hM2 n + let r : Fin M → Real × Real := fun h => p.vertex (rot h) + have hr : Function.Injective r := hr n p i + change (r 1 ≠ r 2) + intro h + have h12 : (1 : Fin M) = 2 := hr h + have hv := congrArg Fin.val h12 + simp [Nat.mod_eq_of_lt hM1, Nat.mod_eq_of_lt hM2] at hv + +private theorem hac (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i : Fin ((n + 1) + 3)) : (r + n p i) 0 ≠ (r n p i) 2 := by + classical + let M := n + 4 + let rot : Fin M → Fin M := fun h => i + h + have hM2 : 2 < M := hM2 n + let r : Fin M → Real × Real := fun h => p.vertex (rot h) + have hr : Function.Injective r := hr n p i + change (r 0 ≠ r 2) + intro h + have h02 : (0 : Fin M) = 2 := hr h + have hv := congrArg Fin.val h02 + simp [Nat.mod_eq_of_lt hM2] at hv + +private theorem hdet' (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i : Fin ((n + 1) + 3)) + (hdet : P3381T1TriangleDeterminant (fun j : Fin 3 => p.vertex (i + ⟨j.val, + Nat.lt_of_lt_of_le j.isLt (Nat.le_add_left 3 (n + 1))⟩)) = 0) : P3381T1TriangleDeterminant + ![(r n p i) 0, (r n p i) 1, (r n p i) 2] = 0 := by + classical + let M := n + 4 + let rot : Fin M → Fin M := fun h => i + h + have hM : 4 ≤ M := hM n + let r : Fin M → Real × Real := fun h => p.vertex (rot h) + change (P3381T1TriangleDeterminant ![r 0, r 1, r 2] = 0) + have heq : (fun j : Fin 3 => r ⟨j.val, by omega⟩) = + (fun j => p.vertex (i + ⟨j.val, Nat.lt_of_lt_of_le j.isLt + (Nat.le_add_left 3 (n + 1))⟩)) := by + funext j + fin_cases j <;> simp [r, rot] + have hvec : ![r 0, r 1, r 2] = (fun j : Fin 3 => r ⟨j.val, by omega⟩) := by + funext j + fin_cases j + · rfl + · rfl + · exact congrArg r (Fin.ext rfl) + rw [hvec, heq] + exact hdet + +private theorem hint (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i : Fin ((n + 1) + 3)) : + segment Real ((r n p i) 0) ((r n p i) 1) ∩ segment Real ((r n p i) 1) ((r n p i) 2) = + Set.singleton ((r n p i) 1) := by + classical + let M := n + 4 + let rot : Fin M → Fin M := fun h => i + h + have hM : 4 ≤ M := hM n + have hrot : Function.Injective rot := hrot n i + let r : Fin M → Real × Real := fun h => p.vertex (rot h) + have ha : r 0 ≠ r 1 := ha n p i + have hbc : r 1 ≠ r 2 := hbc n p i + have hac : r 0 ≠ r 2 := hac n p i + change (segment Real (r 0) (r 1) ∩ segment Real (r 1) (r 2) = {r 1}) + have hidx : rot (0 : Fin M) ≠ rot 1 := by + intro h + have hv := congrArg Fin.val (hrot h) + norm_num at hv + omega + have he := p.edge_intersection (rot 0) (rot 1) (by + exact hidx) + have hstep : rot 1 + 1 = rot 2 := by + apply Fin.ext + change ((i.val + 1) % M + 1) % M = (i.val + 2) % M + simp [] + have hp01 : p.vertex i ≠ p.vertex (i + 1) := by simpa [r, rot] using ha + have hp12 : p.vertex (i + 1) ≠ p.vertex (i + 2) := by + simpa [r, rot, hstep] using hbc + have hp02 : p.vertex i ≠ p.vertex (i + 2) := by + simpa [r, rot, hstep] using hac + have he' : segment Real (p.vertex i) (p.vertex (i + 1)) ∩ + segment Real (p.vertex (i + 1)) (p.vertex (i + 2)) = + {x | (x = p.vertex i ∨ x = p.vertex (i + 1)) ∧ + (x = p.vertex (i + 1) ∨ x = p.vertex (i + 2))} := by + simpa [r, rot, hstep] using he + have hfinal : segment Real (p.vertex i) (p.vertex (i + 1)) ∩ + segment Real (p.vertex (i + 1)) (p.vertex (i + 2)) = + {p.vertex (i + 1)} := by + rw [he'] + ext x + constructor + · rintro ⟨hleft, hright⟩ + rcases hleft with hleft | hleft + · rcases hright with hright | hright + · exact False.elim (hp01 (hleft.symm.trans hright)) + · exact False.elim (hp02 (hleft.symm.trans hright)) + · rcases hright with hright | hright + · exact hleft + · exact False.elim (hp12 (hleft.symm.trans hright)) + · intro hx + subst x + exact ⟨Or.inr rfl, Or.inl rfl⟩ + simpa [r, rot, hstep] using hfinal + +private theorem oldInt (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i : Fin ((n + 1) + 3)) + (a b : Fin (M n)) (hab : a ≠ b) : + segment Real ((r n p i) a) ((r n p i) (a + 1)) ∩ segment Real ((r n p i) b) ((r n p i) (b + + 1)) = + {x | (x = (r n p i) a ∨ x = (r n p i) (a + 1)) ∧ (x = (r n p i) b ∨ x = (r n p i) (b + + 1))} := by + classical + let M := n + 4 + let rot : Fin M → Fin M := fun h => i + h + have hrot : Function.Injective rot := hrot n i + have hrotSucc (h : Fin M) : rot (h + 1) = rot h + 1 := hrotSucc n i h + let r : Fin M → Real × Real := fun h => p.vertex (rot h) + change (segment Real (r a) (r (a + 1)) ∩ segment Real (r b) (r (b + 1)) = + {x | (x = r a ∨ x = r (a + 1)) ∧ (x = r b ∨ x = r (b + 1))}) + have he := p.edge_intersection (rot a) (rot b) (fun h => hab (hrot h)) + simpa [r, hrotSucc] using he + +private theorem rEq (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i : Fin ((n + 1) + 3)) (a b + : Fin (M n)) : (r n p i) a = (r n p i) b ↔ a = b := by + classical + let M := n + 4 + let rot : Fin M → Fin M := fun h => i + h + let r : Fin M → Real × Real := fun h => p.vertex (rot h) + have hr : Function.Injective r := hr n p i + change (r a = r b ↔ a = b) + exact ⟨fun h => hr h, fun h => congrArg r h⟩ + +private theorem sig0 (n : Nat) : (sig n) (0 : Fin (L n)) = 0 := by + classical + let M := n + 4 + let L := n + 3 + let sig : Fin L → Fin M := fun k => + ⟨if k.val = 0 then 0 else k.val + 1, by split_ifs <;> omega⟩ + change (sig (0 : Fin L) = 0) + apply Fin.ext; simp [sig] + +private theorem hval1L (n : Nat) : (1 : Fin (L n)).val = 1 := by + classical + let L := n + 3 + have hL1 : 1 < L := hL1 n + change ((1 : Fin L).val = 1) + simp [Nat.mod_eq_of_lt hL1] + +private theorem hval2M (n : Nat) : (2 : Fin (M n)).val = 2 := by + classical + let M := n + 4 + have hM2 : 2 < M := hM2 n + change ((2 : Fin M).val = 2) + simp [Nat.mod_eq_of_lt hM2] + +private theorem hmod1M (n : Nat) : 1 % (M n) = 1 := by + classical + let M := n + 4 + have hM1 : 1 < M := hM1 n + dsimp only [StraightDeletionConstruction.M] at * + change (1 % M = 1) + exact Nat.mod_eq_of_lt hM1 + +private theorem hmod2M (n : Nat) : 2 % (M n) = 2 := by + classical + let M := n + 4 + have hM2 : 2 < M := hM2 n + dsimp only [StraightDeletionConstruction.M] at * + change (2 % M = 2) + exact Nat.mod_eq_of_lt hM2 + +private theorem hmod3M (n : Nat) : 3 % (M n) = 3 := by + classical + let M := n + 4 + have hM3 : 3 < M := hM3 n + dsimp only [StraightDeletionConstruction.M] at * + change (3 % M = 3) + exact Nat.mod_eq_of_lt hM3 + +private theorem new01 (n : Nat) : (0 : Fin (L n)) + 1 = 1 := by + classical + let L := n + 3 + have hL1 : 1 < L := hL1 n + dsimp only [StraightDeletionConstruction.L] at * + change ((0 : Fin L) + 1 = 1) + apply Fin.ext + simp [Nat.mod_eq_of_lt hL1] + +private theorem sig1 (n : Nat) : (sig n) (1 : Fin (L n)) = 2 := by + classical + let M := n + 4 + let L := n + 3 + let sig : Fin L → Fin M := fun k => + ⟨if k.val = 0 then 0 else k.val + 1, by split_ifs <;> omega⟩ + have hval1L : (1 : Fin L).val = 1 := hval1L n + have hval2M : (2 : Fin M).val = 2 := hval2M n + change (sig (1 : Fin L) = 2) + apply Fin.ext + change (if (1 : Fin L).val = 0 then 0 else (1 : Fin L).val + 1) = + (2 : Fin M).val + rw [hval1L, hval2M] + norm_num + +private theorem old01 (n : Nat) : (0 : Fin (M n)) + 1 = 1 := by + classical + let M := n + 4 + have hmod1M : 1 % M = 1 := hmod1M n + dsimp only [StraightDeletionConstruction.M] at * + change ((0 : Fin M) + 1 = 1) + apply Fin.ext + simp [hmod1M] + +private theorem old12 (n : Nat) : (1 : Fin (M n)) + 1 = 2 := by + classical + let M := n + 4 + have hM : 4 ≤ M := hM n + have hmod1M : 1 % M = 1 := hmod1M n + have hmod2M : 2 % M = 2 := hmod2M n + dsimp only [StraightDeletionConstruction.M] at * + change ((1 : Fin M) + 1 = 2) + apply Fin.ext + simp [Fin.val_add_eq_ite, hmod1M, hmod2M] + omega + +private theorem old23 (n : Nat) : (2 : Fin (M n)) + 1 = 3 := by + classical + let M := n + 4 + have hM : 4 ≤ M := hM n + have hmod1M : 1 % M = 1 := hmod1M n + have hmod2M : 2 % M = 2 := hmod2M n + have hmod3M : 3 % M = 3 := hmod3M n + dsimp only [StraightDeletionConstruction.M] at * + change ((2 : Fin M) + 1 = 3) + apply Fin.ext + simp [Fin.val_add_eq_ite, hmod1M, hmod2M, hmod3M] + omega + +private theorem qedge0 (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i : Fin ((n + 1) + 3)) : + segment Real ((r n p i) ((sig n) 0)) ((r n p i) ((sig n) (0 + 1))) = + segment Real ((r n p i) 0) ((r n p i) 2) := by + classical + let M := n + 4 + let L := n + 3 + let rot : Fin M → Fin M := fun h => i + h + let sig : Fin L → Fin M := fun k => + ⟨if k.val = 0 then 0 else k.val + 1, by split_ifs <;> omega⟩ + let r : Fin M → Real × Real := fun h => p.vertex (rot h) + have sig0 : sig (0 : Fin L) = 0 := sig0 n + have sig1 : sig (1 : Fin L) = 2 := sig1 n + change (segment Real (r (sig 0)) (r (sig (0 + 1))) = + segment Real (r 0) (r 2)) + simp [sig0, sig1] + +private theorem qedgePos (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i : Fin ((n + 1) + 3)) + (k : Fin (L n)) (hk : k.val ≠ 0) : + segment Real ((r n p i) ((sig n) k)) ((r n p i) ((sig n) (k + 1))) = + segment Real ((r n p i) ((sig n) k)) ((r n p i) ((sig n) k + 1)) := by + classical + let M := n + 4 + let L := n + 3 + let rot : Fin M → Fin M := fun h => i + h + let sig : Fin L → Fin M := fun k => + ⟨if k.val = 0 then 0 else k.val + 1, by split_ifs <;> omega⟩ + have hsigSucc (k : Fin L) (hk : k.val ≠ 0) : + sig (k + 1) = sig k + 1 := hsigSucc n k hk + let r : Fin M → Real × Real := fun h => p.vertex (rot h) + dsimp only [StraightDeletionConstruction.L] at * + change (segment Real (r (sig k)) (r (sig (k + 1))) = + segment Real (r (sig k)) (r (sig k + 1))) + rw [hsigSucc k hk] + +private noncomputable abbrev invrot (n : Nat) (i : Fin ((n + 1) + 3)) : Fin (M n) → Fin (M n) := by + classical + let M := n + 4 + dsimp only [StraightDeletionConstruction.M] at * + change (Fin M → Fin M) + exact fun j => + if h : j.val < i.val then ⟨j.val + M - i.val, by omega⟩ + else ⟨j.val - i.val, by omega⟩ + +private theorem hinvrot (n : Nat) (i : Fin ((n + 1) + 3)) (j : Fin (M n)) : (rot n i) ((invrot n + i) j) = j := by + classical + let M := n + 4 + let rot : Fin M → Fin M := fun h => i + h + have hM : 4 ≤ M := hM n + let invrot : Fin M → Fin M := fun j => + if h : j.val < i.val then ⟨j.val + M - i.val, by omega⟩ + else ⟨j.val - i.val, by omega⟩ + dsimp only [StraightDeletionConstruction.M] at * + change (rot (invrot j) = j) + apply Fin.ext + unfold rot invrot + split_ifs with hji + · simp only [Fin.val_add_eq_ite] + split_ifs <;> omega + · simp only [Fin.val_add_eq_ite] + split_ifs <;> omega + +private theorem hinvrotRot (n : Nat) (i : Fin ((n + 1) + 3)) (j : Fin (M n)) : (invrot n i) ((rot + n i) j) = j := by + classical + let M := n + 4 + let rot : Fin M → Fin M := fun h => i + h + have hrot : Function.Injective rot := hrot n i + let invrot : Fin M → Fin M := fun j => + if h : j.val < i.val then ⟨j.val + M - i.val, by omega⟩ + else ⟨j.val - i.val, by omega⟩ + have hinvrot (j : Fin M) : rot (invrot j) = j := hinvrot n i j + dsimp only [StraightDeletionConstruction.M] at * + change (invrot (rot j) = j) + apply hrot + simpa using hinvrot (rot j) + +private noncomputable abbrev col (n : Nat) : Fin (M n) → Fin (L n) := by + classical + let M := n + 4 + let L := n + 3 + have hM : 4 ≤ M := hM n + dsimp only [StraightDeletionConstruction.M, StraightDeletionConstruction.L] at * + change (Fin M → Fin L) + exact fun j => + ⟨if j.val ≤ 1 then 0 else j.val - 1, by split_ifs <;> omega⟩ + +private theorem colSurv (n : Nat) (k : Fin (L n)) : (col n) ((sig n) k) = k := by + classical + let M := n + 4 + let L := n + 3 + let sig : Fin L → Fin M := fun k => + ⟨if k.val = 0 then 0 else k.val + 1, by split_ifs <;> omega⟩ + have hM : 4 ≤ M := hM n + let col : Fin M → Fin L := fun j => + ⟨if j.val ≤ 1 then 0 else j.val - 1, by split_ifs <;> omega⟩ + dsimp only [StraightDeletionConstruction.L] at * + change (col (sig k) = k) + apply Fin.ext + simp only [col, sig] + split_ifs at * <;> omega + +private theorem sigCol (n : Nat) (h : Fin (M n)) (hh : 2 ≤ h.val) : (sig n) ((col n) h) = h := by + classical + let M := n + 4 + let L := n + 3 + let sig : Fin L → Fin M := fun k => + ⟨if k.val = 0 then 0 else k.val + 1, by split_ifs <;> omega⟩ + have hM : 4 ≤ M := hM n + let col : Fin M → Fin L := fun j => + ⟨if j.val ≤ 1 then 0 else j.val - 1, by split_ifs <;> omega⟩ + dsimp only [StraightDeletionConstruction.M] at * + change (sig (col h) = h) + apply Fin.ext + simp only [sig, col] + split_ifs <;> omega + +private theorem colZero (n : Nat) : (col n) (0 : Fin (M n)) = 0 := by + classical + let M := n + 4 + let L := n + 3 + have hM : 4 ≤ M := hM n + let col : Fin M → Fin L := fun j => + ⟨if j.val ≤ 1 then 0 else j.val - 1, by split_ifs <;> omega⟩ + change (col (0 : Fin M) = 0) + apply Fin.ext; simp [col] + +private theorem colOne (n : Nat) : (col n) (1 : Fin (M n)) = 0 := by + classical + let M := n + 4 + let L := n + 3 + have hM : 4 ≤ M := hM n + have hM1 : 1 < M := hM1 n + let col : Fin M → Fin L := fun j => + ⟨if j.val ≤ 1 then 0 else j.val - 1, by split_ifs <;> omega⟩ + change (col (1 : Fin M) = 0) + apply Fin.ext + change (if 1 % M ≤ 1 then 0 else 1 % M - 1) = 0 + rw [Nat.mod_eq_of_lt hM1] + rfl + +private theorem colTwo (n : Nat) : (col n) (2 : Fin (M n)) = 1 := by + classical + let M := n + 4 + let L := n + 3 + have hM : 4 ≤ M := hM n + have hL1 : 1 < L := hL1 n + have hmod2M : 2 % M = 2 := hmod2M n + let col : Fin M → Fin L := fun j => + ⟨if j.val ≤ 1 then 0 else j.val - 1, by split_ifs <;> omega⟩ + change (col (2 : Fin M) = 1) + apply Fin.ext + simp [col, hmod2M, Nat.mod_eq_of_lt hL1] + +private theorem colSucc (n : Nat) (h : Fin (M n)) (hh : 2 ≤ h.val) : + (col n) (h + 1) = (col n) h + 1 := by + classical + let M := n + 4 + let L := n + 3 + have hM : 4 ≤ M := hM n + let col : Fin M → Fin L := fun j => + ⟨if j.val ≤ 1 then 0 else j.val - 1, by split_ifs <;> omega⟩ + dsimp only [StraightDeletionConstruction.M] at * + change (col (h + 1) = col h + 1) + apply Fin.ext + simp only [col, Fin.val_add_eq_ite, Fin.val_one, M, L] + split_ifs <;> simp_all only [ite_true, ite_false] <;> + split_ifs <;> omega + +private theorem invSucc (n : Nat) (i : Fin ((n + 1) + 3)) (j : Fin (M n)) : (invrot n i) (j + 1) + = (invrot n i) j + 1 := by + classical + let M := n + 4 + let rot : Fin M → Fin M := fun h => i + h + have hrot : Function.Injective rot := hrot n i + have hrotSucc (h : Fin M) : rot (h + 1) = rot h + 1 := hrotSucc n i h + let invrot : Fin M → Fin M := fun j => + if h : j.val < i.val then ⟨j.val + M - i.val, by omega⟩ + else ⟨j.val - i.val, by omega⟩ + have hinvrot (j : Fin M) : rot (invrot j) = j := hinvrot n i j + dsimp only [StraightDeletionConstruction.M] at * + change (invrot (j + 1) = invrot j + 1) + apply hrot + rw [hrotSucc, hinvrot, hinvrot] + +private theorem firstInt (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i : Fin ((n + 1) + 3)) + (hunion : segment Real ((r n p i) 0) ((r n p i) 1) ∪ segment Real ((r n p i) 1) ((r n p i) 2) + = segment Real ((r n p i) 0) ((r n p i) 2)) (c : Fin (L n)) (hc : c.val ≠ 0) : + segment Real ((r n p i) ((sig n) 0)) ((r n p i) ((sig n) (0 + 1))) ∩ + segment Real ((r n p i) ((sig n) c)) ((r n p i) ((sig n) (c + 1))) = + {x | (x = (r n p i) ((sig n) 0) ∨ x = (r n p i) ((sig n) (0 + 1))) ∧ + (x = (r n p i) ((sig n) c) ∨ x = (r n p i) ((sig n) (c + 1)))} := by + classical + let M := n + 4 + let L := n + 3 + let rot : Fin M → Fin M := fun h => i + h + let sig : Fin L → Fin M := fun k => + ⟨if k.val = 0 then 0 else k.val + 1, by split_ifs <;> omega⟩ + have hM : 4 ≤ M := hM n + have hM1 : 1 < M := hM1 n + have hsigSucc (k : Fin L) (hk : k.val ≠ 0) : + sig (k + 1) = sig k + 1 := hsigSucc n k hk + let r : Fin M → Real × Real := fun h => p.vertex (rot h) + have ha : r 0 ≠ r 1 := ha n p i + have hbc : r 1 ≠ r 2 := hbc n p i + have hac : r 0 ≠ r 2 := hac n p i + have oldInt (a b : Fin M) (hab : a ≠ b) : + segment Real (r a) (r (a + 1)) ∩ segment Real (r b) (r (b + 1)) = + {x | (x = r a ∨ x = r (a + 1)) ∧ (x = r b ∨ x = r (b + 1))} := oldInt n p i a b hab + have rEq (a b : Fin M) : r a = r b ↔ a = b := rEq n p i a b + have sig0 : sig (0 : Fin L) = 0 := sig0 n + have hval2M : (2 : Fin M).val = 2 := hval2M n + have hmod1M : 1 % M = 1 := hmod1M n + have hmod2M : 2 % M = 2 := hmod2M n + have hmod3M : 3 % M = 3 := hmod3M n + have new01 : (0 : Fin L) + 1 = 1 := new01 n + have sig1 : sig (1 : Fin L) = 2 := sig1 n + have old01 : (0 : Fin M) + 1 = 1 := old01 n + have old12 : (1 : Fin M) + 1 = 2 := old12 n + have old23 : (2 : Fin M) + 1 = 3 := old23 n + have qedge0 : segment Real (r (sig 0)) (r (sig (0 + 1))) = + segment Real (r 0) (r 2) := qedge0 n p i + have qedgePos (k : Fin L) (hk : k.val ≠ 0) : + segment Real (r (sig k)) (r (sig (k + 1))) = + segment Real (r (sig k)) (r (sig k + 1)) := qedgePos n p i k hk + dsimp only [StraightDeletionConstruction.L] at * + change segment Real (r 0) (r 1) ∪ segment Real (r 1) (r 2) = + segment Real (r 0) (r 2) at hunion + change (segment Real (r (sig 0)) (r (sig (0 + 1))) ∩ + segment Real (r (sig c)) (r (sig (c + 1))) = + {x | (x = r (sig 0) ∨ x = r (sig (0 + 1))) ∧ + (x = r (sig c) ∨ x = r (sig (c + 1)))}) + let h := sig c + have hhval : h.val = c.val + 1 := by simp [h, sig, hc] + have hlow : 2 ≤ h.val := by omega + have hneq0 : h ≠ 0 := by + intro he + have hv : h.val = 0 := by simpa using congrArg Fin.val he + omega + have hneq1 : h ≠ 1 := by + intro he + have hv : h.val = 1 := by + simpa [Nat.mod_eq_of_lt hM1] using congrArg Fin.val he + omega + have hnextne : h + 1 ≠ 1 := by + intro he + apply hneq0 + apply add_right_cancel (b := (1 : Fin M)) + simpa only [zero_add] using he + have hr1h : r 1 ≠ r h := fun he => hneq1 ((rEq h 1).mp he.symm) + have hr1next : r 1 ≠ r (h + 1) := fun he => hnextne ((rEq (h + 1) 1).mp he.symm) + have h0 := oldInt 0 h hneq0.symm + have h1 := oldInt 1 h hneq1.symm + simp only [old01] at h0 + simp only [old12] at h1 + rw [qedge0, qedgePos c hc] + simp only [new01, sig0, sig1, hsigSucc c hc] + change segment Real (r 0) (r 2) ∩ segment Real (r h) (r (h + 1)) = + {x | (x = r 0 ∨ x = r 2) ∧ (x = r h ∨ x = r (h + 1))} + rw [← hunion, Set.union_inter_distrib_right, h0, h1] + ext x + simp only [Set.mem_union, Set.mem_ofPred_eq] + by_cases hx : x = r 1 + · subst x + simp [ha.symm, hbc, hr1h, hr1next] + · simp only [hx, or_false, false_or, or_and_right] + +private noncomputable abbrev q (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i : Fin ((n + 1) + + 3)) (hunion : segment Real ((r n p i) 0) ((r n p i) 1) ∪ segment Real ((r n p i) 1) ((r n p + i) 2) = segment Real ((r n p i) 0) ((r n p i) 2)) : P3381T1PolygonBoundary n := by + classical + let M := n + 4 + let L := n + 3 + let rot : Fin M → Fin M := fun h => i + h + let sig : Fin L → Fin M := fun k => + ⟨if k.val = 0 then 0 else k.val + 1, by split_ifs <;> omega⟩ + have hrot : Function.Injective rot := hrot n i + have hsig : Function.Injective sig := hsig n + have hsigSucc (k : Fin L) (hk : k.val ≠ 0) : + sig (k + 1) = sig k + 1 := hsigSucc n k hk + let r : Fin M → Real × Real := fun h => p.vertex (rot h) + have ha : r 0 ≠ r 1 := ha n p i + have oldInt (a b : Fin M) (hab : a ≠ b) : + segment Real (r a) (r (a + 1)) ∩ segment Real (r b) (r (b + 1)) = + {x | (x = r a ∨ x = r (a + 1)) ∧ (x = r b ∨ x = r (b + 1))} := oldInt n p i a b hab + have firstInt (c : Fin L) (hc : c.val ≠ 0) : + segment Real (r (sig 0)) (r (sig (0 + 1))) ∩ + segment Real (r (sig c)) (r (sig (c + 1))) = + {x | (x = r (sig 0) ∨ x = r (sig (0 + 1))) ∧ + (x = r (sig c) ∨ x = r (sig (c + 1)))} := firstInt n p i hunion c hc + exact { + vertex := fun k => r (sig k) + rational := fun k => p.rational (rot (sig k)) + injective := fun a b h => hsig (hrot (p.injective h)) + edge_intersection := by + intro a b hab + by_cases ha0 : a.val = 0 + · have ha : a = 0 := Fin.ext ha0 + subst a + have hb : b.val ≠ 0 := by + intro h + apply hab + exact Fin.ext h.symm + exact firstInt b hb + · by_cases hb0 : b.val = 0 + · have hb : b = 0 := Fin.ext hb0 + subst b + have ha : a.val ≠ 0 := by + intro h + apply hab + exact Fin.ext h + have hf := firstInt a ha + rw [Set.inter_comm] + rw [hf] + ext x + constructor + · rintro ⟨hleft, hright⟩ + exact ⟨hright, hleft⟩ + · rintro ⟨hleft, hright⟩ + exact ⟨hright, hleft⟩ + · have ha : a.val ≠ 0 := ha0 + have hb : b.val ≠ 0 := hb0 + have hab' : sig a ≠ sig b := fun h => hab (hsig h) + simpa [hsigSucc a ha, hsigSucc b hb] using oldInt (sig a) (sig b) hab' + } + +private noncomputable def boundarySubdivision {n : Nat} (p : P3381T1PolygonBoundary (n + 1)) + (i : Fin ((n + 1) + 3)) + (hdet : P3381T1TriangleDeterminant (fun j : Fin 3 => + p.vertex (i + ⟨j.val, Nat.lt_of_lt_of_le j.isLt + (Nat.le_add_left 3 (n + 1))⟩)) = 0) + (t : Real) (ht0 : 0 < t) (ht1 : t < 1) + (hsplice : r n p i 1 = (1 - t) • r n p i 0 + t • r n p i 2) + (hunion : segment Real (r n p i 0) (r n p i 1) ∪ + segment Real (r n p i 1) (r n p i 2) = segment Real (r n p i 0) (r n p i 2)) : + P3475T1BoundarySubdivision (q n p i hunion) p := by +-- BODY + classical + let M := n + 4 + let L := n + 3 + let rot : Fin M → Fin M := fun h => i + h + let sig : Fin L → Fin M := fun k => + ⟨if k.val = 0 then 0 else k.val + 1, by split_ifs <;> omega⟩ + have hM : 4 ≤ M := StraightDeletionConstruction.hM n + have hM1 : 1 < M := StraightDeletionConstruction.hM1 n + have hM2 : 2 < M := StraightDeletionConstruction.hM2 n + have hM3 : 3 < M := StraightDeletionConstruction.hM3 n + have hL1 : 1 < L := StraightDeletionConstruction.hL1 n + have hLM : L + 1 = M := StraightDeletionConstruction.hLM n + have hrot : Function.Injective rot := StraightDeletionConstruction.hrot n i + have hsig : Function.Injective sig := StraightDeletionConstruction.hsig n + have hrotSucc (h : Fin M) : rot (h + 1) = rot h + 1 := StraightDeletionConstruction.hrotSucc n i h + have hsigSucc (k : Fin L) (hk : k.val ≠ 0) : + sig (k + 1) = sig k + 1 := StraightDeletionConstruction.hsigSucc n k hk + let r : Fin M → Real × Real := fun h => p.vertex (rot h) + have hr : Function.Injective r := StraightDeletionConstruction.hr n p i + have ha : r 0 ≠ r 1 := StraightDeletionConstruction.ha n p i + have hbc : r 1 ≠ r 2 := StraightDeletionConstruction.hbc n p i + have hac : r 0 ≠ r 2 := StraightDeletionConstruction.hac n p i + have hdet' : P3381T1TriangleDeterminant ![r 0, r 1, r 2] = 0 := + StraightDeletionConstruction.hdet' n p i hdet + have hint : segment Real (r 0) (r 1) ∩ segment Real (r 1) (r 2) = {r 1} := + StraightDeletionConstruction.hint n p i + have oldInt (a b : Fin M) (hab : a ≠ b) : + segment Real (r a) (r (a + 1)) ∩ segment Real (r b) (r (b + 1)) = + {x | (x = r a ∨ x = r (a + 1)) ∧ (x = r b ∨ x = r (b + 1))} := + StraightDeletionConstruction.oldInt n p i a b hab + have rEq (a b : Fin M) : r a = r b ↔ a = b := StraightDeletionConstruction.rEq n p i a b + have sig0 : sig (0 : Fin L) = 0 := StraightDeletionConstruction.sig0 n + have hval1L : (1 : Fin L).val = 1 := StraightDeletionConstruction.hval1L n + have hval2M : (2 : Fin M).val = 2 := StraightDeletionConstruction.hval2M n + have hmod1M : 1 % M = 1 := StraightDeletionConstruction.hmod1M n + have hmod2M : 2 % M = 2 := StraightDeletionConstruction.hmod2M n + have hmod3M : 3 % M = 3 := StraightDeletionConstruction.hmod3M n + have new01 : (0 : Fin L) + 1 = 1 := StraightDeletionConstruction.new01 n + have sig1 : sig (1 : Fin L) = 2 := StraightDeletionConstruction.sig1 n + have old01 : (0 : Fin M) + 1 = 1 := StraightDeletionConstruction.old01 n + have old12 : (1 : Fin M) + 1 = 2 := StraightDeletionConstruction.old12 n + have old23 : (2 : Fin M) + 1 = 3 := StraightDeletionConstruction.old23 n + have qedge0 : segment Real (r (sig 0)) (r (sig (0 + 1))) = + segment Real (r 0) (r 2) := StraightDeletionConstruction.qedge0 n p i + have qedgePos (k : Fin L) (hk : k.val ≠ 0) : + segment Real (r (sig k)) (r (sig (k + 1))) = + segment Real (r (sig k)) (r (sig k + 1)) := StraightDeletionConstruction.qedgePos n p i k hk + let invrot : Fin M → Fin M := fun j => + if h : j.val < i.val then ⟨j.val + M - i.val, by omega⟩ + else ⟨j.val - i.val, by omega⟩ + have hinvrot (j : Fin M) : rot (invrot j) = j := StraightDeletionConstruction.hinvrot n i j + have hinvrotRot (j : Fin M) : invrot (rot j) = j := StraightDeletionConstruction.hinvrotRot n i j + let col : Fin M → Fin L := fun j => + ⟨if j.val ≤ 1 then 0 else j.val - 1, by split_ifs <;> omega⟩ + have colSurv (k : Fin L) : col (sig k) = k := StraightDeletionConstruction.colSurv n k + have sigCol (h : Fin M) (hh : 2 ≤ h.val) : sig (col h) = h := + StraightDeletionConstruction.sigCol n h hh + have colZero : col (0 : Fin M) = 0 := StraightDeletionConstruction.colZero n + have colOne : col (1 : Fin M) = 0 := StraightDeletionConstruction.colOne n + have colTwo : col (2 : Fin M) = 1 := StraightDeletionConstruction.colTwo n + have colSucc (h : Fin M) (hh : 2 ≤ h.val) : + col (h + 1) = col h + 1 := StraightDeletionConstruction.colSucc n h hh + have invSucc (j : Fin M) : invrot (j + 1) = invrot j + 1 := + StraightDeletionConstruction.invSucc n i j + have firstInt (c : Fin L) (hc : c.val ≠ 0) : + segment Real (r (sig 0)) (r (sig (0 + 1))) ∩ + segment Real (r (sig c)) (r (sig (c + 1))) = + {x | (x = r (sig 0) ∨ x = r (sig (0 + 1))) ∧ + (x = r (sig c) ∨ x = r (sig (c + 1)))} := StraightDeletionConstruction.firstInt n p i + hunion c hc + let q : P3381T1PolygonBoundary n := StraightDeletionConstruction.q n p i hunion + change r 1 = (1 - t) • r 0 + t • r 2 at hsplice + change segment Real (r 0) (r 1) ∪ segment Real (r 1) (r 2) = + segment Real (r 0) (r 2) at hunion + have qvertex (k : Fin L) : q.vertex k = r (sig k) := by rfl + let start : Fin L → Fin M := fun k => rot (sig k) + let edge : Fin M → Fin L := fun j => col (invrot j) + let parameter : Fin M → Real := fun j => if invrot j = 1 then t else 0 + have hstart : Function.Injective start := by + intro a b hab + exact hsig (hrot hab) + have hsigne1 (k : Fin L) : sig k ≠ 1 := by + intro he + have hv := congrArg Fin.val he + have hk := k.isLt + have hv1 : (1 : Fin M).val = 1 := by simp [Nat.mod_eq_of_lt hM1] + rw [hv1] at hv + simp only [sig] at hv + split_ifs at hv; omega + refine ⟨start, hstart, edge, parameter, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro j + by_cases hj : invrot j = 1 <;> simp [parameter, hj, ht0.le] + · intro j + by_cases hj : invrot j = 1 <;> simp [parameter, hj, ht1] + · intro k + change col (invrot (rot (sig k))) = k + rw [hinvrotRot, colSurv] + · intro k + change (if invrot (rot (sig k)) = 1 then t else 0) = 0 + rw [hinvrotRot] + simp [hsigne1] + · intro j + let h := invrot j + have hj : rot h = j := hinvrot j + have hpj : p.vertex j = r h := by + simpa [r] using congrArg p.vertex hj.symm + change p.vertex j = + (1 - parameter j) • q.vertex (col h) + + parameter j • q.vertex (col h + 1) + by_cases hzero : h.val = 0 + · have heq : h = 0 := Fin.ext hzero + have hzero' : invrot j = 0 := by simpa [h] using heq + rw [hpj] + simp [parameter, hzero', colZero, qvertex, sig0, heq] + · by_cases hone : h.val = 1 + · have heq : h = 1 := Fin.ext hone + have hone' : invrot j = 1 := by simpa [h] using heq + rw [hpj, heq, hsplice] + simp [parameter, hone', colOne, qvertex, sig0, sig1] + · have hlarge : 2 ≤ h.val := by omega + have hnotone : h ≠ 1 := by + intro he + apply hone + exact congrArg Fin.val he + have hnotone' : invrot j ≠ 1 := by simpa [h] using hnotone + rw [hpj] + have hcoll := sigCol h hlarge + simp [parameter, hnotone', qvertex, hcoll] + · intro j + let h := invrot j + have hj : rot h = j := hinvrot j + have hnext : invrot (j + 1) = h + 1 := by + dsimp [h] + exact invSucc j + by_cases hzero : h.val = 0 + · have heq : h = 0 := Fin.ext hzero + have hzero' : invrot j = 0 := by simpa [h] using heq + have hnextval : h + 1 = 1 := by simp [heq] + have hparam0 : parameter j = 0 := by simp [parameter, hzero'] + have hnextparam : parameter (j + 1) = t := by + simp [parameter, hnext, hnextval] + left + constructor + · change col (invrot (j + 1)) = col (invrot j) + rw [hnext, heq, hzero'] + simp [old01, colOne, colZero] + · rw [hparam0, hnextparam] + exact ht0 + · by_cases hone : h.val = 1 + · have heq : h = 1 := Fin.ext hone + have hone' : invrot j = 1 := by simpa [h] using heq + have hnextval : h + 1 = 2 := by simpa [heq] using old12 + have hparamj : parameter j = t := by simp [parameter, hone'] + have hnextne : h + 1 ≠ 1 := by + intro he + have h21 : (2 : Fin M) = 1 := hnextval.symm.trans he + have hv := congrArg Fin.val h21 + norm_num [hmod1M, hmod2M] at hv + have hnextparam : parameter (j + 1) = 0 := by + simp [parameter, hnext, hnextne] + right + constructor + · change col (invrot (j + 1)) = col (invrot j) + 1 + rw [hnext, heq, hone'] + simp [old12, colTwo, colOne, new01] + · exact hnextparam + · have hlarge : 2 ≤ h.val := by omega + have hnotone' : invrot j ≠ 1 := by + intro he + apply hone + exact congrArg Fin.val (by simpa [h] using he) + have hnextne : h + 1 ≠ 1 := by + intro he + have hv := congrArg Fin.val he + have hv1 : (1 : Fin M).val = 1 := by + simp [Nat.mod_eq_of_lt hM1] + rw [hv1] at hv + simp only [Fin.val_add_eq_ite] at hv + split_ifs at hv <;> omega + have hparamj : parameter j = 0 := by simp [parameter, hnotone'] + have hnextparam : parameter (j + 1) = 0 := by + simp [parameter, hnext, hnextne] + right + constructor + · change col (invrot (j + 1)) = col (invrot j) + 1 + rw [hnext] + exact colSucc h hlarge + · exact hnextparam + · apply Set.ext + intro x + constructor + · intro hx + rcases Set.mem_iUnion.mp hx with ⟨j, hx⟩ + let h := invrot j + have hj : rot h = j := hinvrot j + have hseg : segment Real (p.vertex j) (p.vertex (j + 1)) = + segment Real (r h) (r (h + 1)) := by + rw [← hj, ← hrotSucc] + rw [hseg] at hx + by_cases hz : h.val = 0 + · have hh : h = 0 := Fin.ext hz + have hhseg : segment Real (r h) (r (h + 1)) = + segment Real (r 0) (r (0 + 1)) := by simp [hh] + rw [hhseg] at hx + apply Set.mem_iUnion.mpr + refine ⟨0, ?_⟩ + change x ∈ segment Real (r (sig 0)) (r (sig (0 + 1))) + rw [qedge0, ← hunion] + simpa [hh] using Or.inl hx + · by_cases hone : h.val = 1 + · have hh : h = 1 := Fin.ext hone + have hhseg : segment Real (r h) (r (h + 1)) = + segment Real (r 1) (r (1 + 1)) := by simp [hh] + rw [hhseg] at hx + apply Set.mem_iUnion.mpr + refine ⟨0, ?_⟩ + change x ∈ segment Real (r (sig 0)) (r (sig (0 + 1))) + rw [qedge0, ← hunion] + simpa [hh, old12] using Or.inr hx + · have hlarge : 2 ≤ h.val := by omega + let k := col h + have hk : sig k = h := sigCol h hlarge + have hk0 : k ≠ 0 := by + intro he + have hs0 : sig k = 0 := by simpa [he] using sig0 + have htmp := congrArg Fin.val (hk.symm.trans hs0) + have hzero : h.val = 0 := by simpa using htmp + omega + apply Set.mem_iUnion.mpr + refine ⟨k, ?_⟩ + change x ∈ segment Real (r (sig k)) (r (sig (k + 1))) + have hk0val : k.val ≠ 0 := by + intro hv + apply hk0 + exact Fin.ext hv + rw [qedgePos k hk0val, hk] + exact hx + · intro hx + rcases Set.mem_iUnion.mp hx with ⟨k, hx⟩ + by_cases hk0 : k.val = 0 + · have hk : k = 0 := Fin.ext hk0 + subst k + change x ∈ segment Real (r (sig 0)) (r (sig (0 + 1))) at hx + rw [qedge0, ← hunion] at hx + rcases hx with hx | hx + · apply Set.mem_iUnion.mpr + refine ⟨rot 0, ?_⟩ + have hseg : segment Real (p.vertex (rot 0)) (p.vertex (rot 0 + 1)) = + segment Real (r 0) (r (0 + 1)) := by + rw [← hrotSucc 0] + rw [hseg] + exact hx + · apply Set.mem_iUnion.mpr + refine ⟨rot 1, ?_⟩ + have hseg : segment Real (p.vertex (rot 1)) (p.vertex (rot 1 + 1)) = + segment Real (r 1) (r (1 + 1)) := by + rw [← hrotSucc 1] + rw [hseg] + exact hx + · have hlarge : 2 ≤ (sig k).val := by + have hkpos : k.val > 0 := Nat.pos_of_ne_zero hk0 + have hkpos' : k.val ≠ 0 := by omega + simp only [sig, ite_eq_right hkpos'] + omega + have hk : sig (col (sig k)) = sig k := sigCol (sig k) hlarge + apply Set.mem_iUnion.mpr + refine ⟨rot (sig k), ?_⟩ + have hseg : segment Real (p.vertex (rot (sig k))) + (p.vertex (rot (sig k) + 1)) = + segment Real (r (sig k)) (r (sig k + 1)) := by + rw [← hrotSucc (sig k)] + rw [hseg] + change x ∈ segment Real (r (sig k)) (r (sig (k + 1))) at hx + rw [qedgePos k hk0] at hx + exact hx + + +end StraightDeletionConstruction + +theorem P3497T1SingleStraightDeletion {n : Nat} + (p : P3381T1PolygonBoundary (n + 1)) + (i : Fin ((n + 1) + 3)) + (hdet : P3381T1TriangleDeterminant (fun j : Fin 3 => + p.vertex (i + ⟨j.val, Nat.lt_of_lt_of_le j.isLt + (Nat.le_add_left 3 (n + 1))⟩)) = 0) : + ∃ q : P3381T1PolygonBoundary n, + (∀ k : Fin (n + 3), q.vertex k = + p.vertex (i + ⟨if k.val = 0 then 0 else k.val + 1, by + split_ifs <;> omega⟩)) ∧ + Nonempty (P3475T1BoundarySubdivision q p) := by + classical + let r := StraightDeletionConstruction.r n p i + obtain ⟨t, ht0, ht1, hsplice, hunion⟩ := + P3497T1StrictCornerSplice (r 0) (r 1) (r 2) + (StraightDeletionConstruction.hac n p i) (StraightDeletionConstruction.ha n p i) + (StraightDeletionConstruction.hbc n p i) (StraightDeletionConstruction.hdet' n p i hdet) + (StraightDeletionConstruction.hint n p i) + refine ⟨StraightDeletionConstruction.q n p i hunion, ?_, + ⟨StraightDeletionConstruction.boundarySubdivision p i hdet t ht0 ht1 hsplice hunion⟩⟩ + intro k + rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3497T1StrictCornerSplice.lean b/LeanPool/ApollonianSuperharmonic/P3497T1StrictCornerSplice.lean new file mode 100644 index 0000000000..41f74b4770 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3497T1StrictCornerSplice.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Analysis.Convex.Basic +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public import Mathlib.Tactic.FieldSimp +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P3497T1StrictCornerSplice] + +/-! +# P3497T1StrictCornerSplice + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3497T1StrictCornerSplice (a b c : Real × Real) + (hac : a ≠ c) (hab : a ≠ b) (hbc : b ≠ c) + (hdet : P3381T1TriangleDeterminant ![a, b, c] = 0) + (hint : segment Real a b ∩ segment Real b c = {b}) : + ∃ t : Real, 0 < t ∧ t < 1 ∧ + b = (1 - t) • a + t • c ∧ + segment Real a b ∪ segment Real b c = segment Real a c := by +-- BODY + have hd : (b.1 - a.1) * (c.2 - a.2) - + (c.1 - a.1) * (b.2 - a.2) = 0 := by + simpa [P3381T1TriangleDeterminant] using hdet + have hp : ∃ t : Real, b = (1 - t) • a + t • c := by + by_cases hx : c.1 - a.1 = 0 + · have hy : c.2 - a.2 ≠ 0 := by + intro hy + apply hac + ext <;> linarith + refine ⟨(b.2 - a.2) / (c.2 - a.2), ?_⟩ + ext <;> simp only [Prod.fst_add, Prod.snd_add, Prod.smul_fst, Prod.smul_snd, + smul_eq_mul] + · field_simp + nlinarith + · field_simp + ring + · refine ⟨(b.1 - a.1) / (c.1 - a.1), ?_⟩ + ext <;> simp only [Prod.fst_add, Prod.snd_add, Prod.smul_fst, Prod.smul_snd, + smul_eq_mul] + · field_simp + ring + · field_simp + nlinarith + obtain ⟨t, ht⟩ := hp + have ht0 : 0 < t := by + by_contra hn + have hle : t ≤ 0 := le_of_not_gt hn + have hden : 0 < 1 - t := by linarith + have ha : a ∈ segment Real b c := by + rw [segment_eq_image] + refine ⟨-t / (1 - t), ?_, ?_⟩ + · constructor + · exact div_nonneg (neg_nonneg.mpr hle) (le_of_lt hden) + · apply (div_le_one hden).mpr + linarith + · rw [ht] + ext <;> simp only [Prod.fst_add, Prod.snd_add, Prod.smul_fst, + Prod.smul_snd, smul_eq_mul] + all_goals field_simp + all_goals ring + have ha' : a ∈ segment Real a b ∩ segment Real b c := + ⟨left_mem_segment Real a b, ha⟩ + rw [hint, Set.mem_singleton_iff] at ha' + exact hab ha' + have ht1 : t < 1 := by + by_contra hn + have hle : 1 ≤ t := le_of_not_gt hn + have hc : c ∈ segment Real a b := by + rw [segment_eq_image] + refine ⟨1 / t, ?_, ?_⟩ + · constructor + · exact div_nonneg (by norm_num) (le_of_lt ht0) + · exact (div_le_one ht0).mpr hle + · rw [ht] + ext <;> simp only [Prod.fst_add, Prod.snd_add, Prod.smul_fst, + Prod.smul_snd, smul_eq_mul] + all_goals field_simp + all_goals ring + have hc' : c ∈ segment Real a b ∩ segment Real b c := + ⟨hc, right_mem_segment Real b c⟩ + rw [hint, Set.mem_singleton_iff] at hc' + exact hbc hc'.symm + refine ⟨t, ht0, ht1, ht, ?_⟩ + have hb : b ∈ segment Real a c := by + rw [segment_eq_image] + exact ⟨t, ⟨le_of_lt ht0, le_of_lt ht1⟩, ht.symm⟩ + apply Set.Subset.antisymm + · apply Set.union_subset + · exact (convex_segment a c).segment_subset (left_mem_segment Real a c) hb + · exact (convex_segment a c).segment_subset hb (right_mem_segment Real a c) + · intro x hx + rw [segment_eq_image] at hx + obtain ⟨u, hu, rfl⟩ := hx + by_cases hut : u ≤ t + · apply Set.mem_union_left + rw [segment_eq_image] + refine ⟨u / t, ⟨div_nonneg hu.1 (le_of_lt ht0), (div_le_one ht0).mpr hut⟩, ?_⟩ + rw [ht] + ext <;> simp only [Prod.fst_add, Prod.snd_add, Prod.smul_fst, + Prod.smul_snd, smul_eq_mul] + all_goals field_simp + all_goals ring + · apply Set.mem_union_right + rw [segment_eq_image] + have hden : 0 < 1 - t := sub_pos.mpr ht1 + refine ⟨(u - t) / (1 - t), ?_, ?_⟩ + · constructor + · exact div_nonneg (by linarith) (le_of_lt hden) + · apply (div_le_one hden).mpr + linarith [hu.2] + · rw [ht] + ext <;> simp only [Prod.fst_add, Prod.snd_add, Prod.smul_fst, + Prod.smul_snd, smul_eq_mul] + all_goals field_simp + all_goals ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3497T1SubdivisionComposition.lean b/LeanPool/ApollonianSuperharmonic/P3497T1SubdivisionComposition.lean new file mode 100644 index 0000000000..2cce41c98c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3497T1SubdivisionComposition.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundarySubdivision +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P3497T1SubdivisionComposition] + +/-! +# P3497T1SubdivisionComposition + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3497T1SubdivisionComposition {r m n : Nat} + {q : P3381T1PolygonBoundary r} + {v : P3381T1PolygonBoundary m} + {p : P3381T1PolygonBoundary n} + (A : P3475T1BoundarySubdivision q v) + (B : P3475T1BoundarySubdivision v p) : + Nonempty (P3475T1BoundarySubdivision q p) := by +-- BODY + classical + let finish : Fin (m + 3) → Real := fun k => + if A.edge (k + 1) = A.edge k then A.parameter (k + 1) else 1 + have finish_gt (k : Fin (m + 3)) : A.parameter k < finish k := by + rcases A.successor k with h | h + · simp only [finish, ite_eq_left h.1] + exact h.2 + · have hne : A.edge (k + 1) ≠ A.edge k := by + rw [h.1] + intro heq + have hone : (1 : Fin (r + 3)) = 0 := add_left_cancel (heq.trans (add_zero _).symm) + have hval := congrArg Fin.val hone + simp at hval + simp only [finish, ite_eq_right hne] + exact A.parameter_lt_one k + have finish_le (k : Fin (m + 3)) : finish k ≤ 1 := by + dsimp [finish] + split_ifs + · exact le_of_lt (A.parameter_lt_one _) + · exact le_rfl + have endpoint (k : Fin (m + 3)) : + v.vertex (k + 1) = (1 - finish k) • q.vertex (A.edge k) + + finish k • q.vertex (A.edge k + 1) := by + rcases A.successor k with h | h + · simpa only [finish, ite_eq_left h.1, h.1] using A.vertex_formula (k + 1) + · have hne : A.edge (k + 1) ≠ A.edge k := by + rw [h.1] + intro heq + have hone : (1 : Fin (r + 3)) = 0 := add_left_cancel (heq.trans (add_zero _).symm) + have hval := congrArg Fin.val hone + simp at hval + simpa only [finish, ite_eq_right hne, h.1, h.2, sub_zero, zero_smul, + one_smul, add_zero, sub_self, zero_add] using A.vertex_formula (k + 1) + let t : Fin (n + 3) → Real := fun j => + A.parameter (B.edge j) + + (finish (B.edge j) - A.parameter (B.edge j)) * B.parameter j + have t_bounds (j : Fin (n + 3)) : 0 ≤ t j ∧ t j < 1 := by + have h0 := A.parameter_nonneg (B.edge j) + have h1 := finish_gt (B.edge j) + have h2 := finish_le (B.edge j) + have h3 := B.parameter_nonneg j + have h4 := B.parameter_lt_one j + dsimp [t] + constructor <;> nlinarith + refine ⟨{ start := B.start ∘ A.start + start_injective := B.start_injective.comp A.start_injective + edge := A.edge ∘ B.edge + parameter := t + parameter_nonneg := fun j => (t_bounds j).1 + parameter_lt_one := fun j => (t_bounds j).2 + edge_start := ?_ + parameter_start := ?_ + vertex_formula := ?_ + successor := ?_ + carrier_eq := B.carrier_eq.trans A.carrier_eq }⟩ + · intro i + simp only [Function.comp_apply, B.edge_start, A.edge_start] + · intro i + simp only [Function.comp_apply, t, B.edge_start, B.parameter_start, + A.parameter_start, mul_zero, add_zero] + · intro j + rw [B.vertex_formula j, A.vertex_formula (B.edge j), endpoint (B.edge j)] + dsimp [Function.comp_def, t] + ext <;> simp only [Prod.fst_add, Prod.snd_add, Prod.smul_fst, Prod.smul_snd, + smul_eq_mul] <;> ring + · intro j + rcases B.successor j with h | h + · left + constructor + · dsimp [Function.comp_def] + rw [h.1] + · dsimp [t] + rw [h.1] + have hgt := finish_gt (B.edge j) + nlinarith [h.2] + · rcases A.successor (B.edge j) with ha | ha + · left + constructor + · dsimp [Function.comp_def] + rw [h.1] + exact ha.1 + · have hb := B.parameter_lt_one j + have hgt := finish_gt (B.edge j) + dsimp [t] + rw [h.1, h.2, mul_zero, add_zero] + simp only [finish, ite_eq_left ha.1] at hgt ⊢ + nlinarith + · right + constructor + · dsimp [Function.comp_def] + rw [h.1] + exact ha.1 + · dsimp [t] + rw [h.1, h.2, ha.2, mul_zero, add_zero] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3497T1TriangleCornerNonzero.lean b/LeanPool/ApollonianSuperharmonic/P3497T1TriangleCornerNonzero.lean new file mode 100644 index 0000000000..171c48da5f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3497T1TriangleCornerNonzero.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3497T1StrictCornerSplice +public import Mathlib.Tactic.FinCases +public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary + +-- [TABLET NODE: P3497T1TriangleCornerNonzero] + +/-! +# P3497T1TriangleCornerNonzero + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3497T1TriangleCornerNonzero (p : P3381T1PolygonBoundary 0) : + ∀ i : Fin 3, + P3381T1TriangleDeterminant (fun j : Fin 3 => + p.vertex (i + ⟨j.val, Nat.lt_of_lt_of_le j.isLt (Nat.le_add_left 3 0)⟩)) ≠ 0 := by +-- BODY + intro i hd + have hi1 : i ≠ i + 1 := by fin_cases i <;> decide + have hi2 : i ≠ i + 2 := by fin_cases i <;> decide + have h12 : i + 1 ≠ i + 2 := by fin_cases i <;> decide + have hsucc : i + 1 + 1 = i + 2 := by fin_cases i <;> rfl + have hclose : i + 2 + 1 = i := by fin_cases i <;> rfl + let a := p.vertex i + let b := p.vertex (i + 1) + let c := p.vertex (i + 2) + have hab : a ≠ b := p.injective.ne hi1 + have hac : a ≠ c := p.injective.ne hi2 + have hbc : b ≠ c := p.injective.ne h12 + have hf : (fun j : Fin 3 => + p.vertex (i + ⟨j.val, Nat.lt_of_lt_of_le j.isLt (Nat.le_add_left 3 0)⟩)) = + ![a, b, c] := by + funext j + fin_cases j <;> simp [a, b, c] + rw [hf] at hd + have hint : segment Real a b ∩ segment Real b c = {b} := by + have he := p.edge_intersection i (i + 1) hi1 + rw [hsucc] at he + change segment Real a b ∩ segment Real b c = + {x | (x = a ∨ x = b) ∧ (x = b ∨ x = c)} at he + rw [he] + ext x + simp only [Set.mem_ofPred_eq, Set.mem_singleton_iff] + constructor + · rintro ⟨hx | hx, hy | hy⟩ + · exact False.elim (hab (hx.symm.trans hy)) + · exact False.elim (hac (hx.symm.trans hy)) + · exact hx + · exact hx + · intro hx + exact ⟨Or.inr hx, Or.inl hx⟩ + obtain ⟨t, ht0, ht1, hformula, hsplice⟩ := + P3497T1StrictCornerSplice a b c hac hab hbc hd hint + have hb : b ∈ segment Real a c := by + rw [segment_eq_image] + exact ⟨t, ⟨le_of_lt ht0, le_of_lt ht1⟩, hformula.symm⟩ + have he := p.edge_intersection i (i + 2) hi2 + rw [hclose] at he + change segment Real a b ∩ segment Real c a = + {x | (x = a ∨ x = b) ∧ (x = c ∨ x = a)} at he + have hmem : b ∈ segment Real a b ∩ segment Real c a := by + rw [segment_symm Real c a] + exact ⟨right_mem_segment Real a b, hb⟩ + rw [he] at hmem + rcases hmem.2 with h | h + · exact hbc h + · exact hab h.symm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3511T1AttachmentIntersection.lean b/LeanPool/ApollonianSuperharmonic/P3511T1AttachmentIntersection.lean new file mode 100644 index 0000000000..d524a1b464 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3511T1AttachmentIntersection.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Convex.Hull +public import Mathlib.Data.Set.Card + +-- [TABLET NODE: P3511T1AttachmentIntersection] + +/-! +# P3511T1AttachmentIntersection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3511T1AttachmentIntersection {n count : Nat} + (vertex : Fin (n + 3) → Real × Real) + (face : Fin count → Fin 3 → Fin (n + 3)) + (hexact : ∀ k l, + convexHull Real (Set.range (vertex ∘ face k)) ∩ + convexHull Real (Set.range (vertex ∘ face l)) = + convexHull Real (vertex '' (Set.range (face k) ∩ Set.range (face l)))) + (order : Fin count ≃ Fin count) (k : Fin count) + (a b c : Fin (n + 3)) + (hface : Set.range (face (order k)) = {a, b, c}) + (hnew : ∀ l : Fin count, l.val < k.val → c ∉ Set.range (face (order l))) + (hcount : Set.ncard {l : Fin count | l.val < k.val ∧ + a ∈ Set.range (face (order l)) ∧ b ∈ Set.range (face (order l))} = 1) : + convexHull Real (Set.range (vertex ∘ face (order k))) ∩ + (⋃ l : {l : Fin count // l.val < k.val}, + convexHull Real (Set.range (vertex ∘ face (order l.val)))) = + segment Real (vertex a) (vertex b) := by +-- BODY + classical + have hsub (l : Fin count) (hl : l.val < k.val) : + Set.range (face (order k)) ∩ Set.range (face (order l)) ⊆ {a, b} := by + intro i hi + rw [hface] at hi + rcases hi with ⟨hi, hil⟩ + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hi ⊢ + rcases hi with ha | hb | hc + · exact Or.inl ha + · exact Or.inr hb + · subst i + exact False.elim (hnew l hl hil) + have hone : ({l : Fin count | l.val < k.val ∧ + a ∈ Set.range (face (order l)) ∧ b ∈ Set.range (face (order l))}).Nonempty := by + apply Set.nonempty_of_ncard_ne_zero + rw [hcount] + exact one_ne_zero + obtain ⟨l, hl, ha, hb⟩ := hone + have hab : {a, b} ⊆ Set.range (face (order k)) ∩ Set.range (face (order l)) := by + intro i hi + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hi + rcases hi with rfl | rfl + · exact ⟨by rw [hface]; simp, ha⟩ + · exact ⟨by rw [hface]; simp, hb⟩ + have hpair : vertex '' ({a, b} : Set (Fin (n + 3))) = {vertex a, vertex b} := by + simp only [Set.image_insert_eq, Set.image_singleton] + apply Set.Subset.antisymm + · intro x hx + obtain ⟨hxk, hxu⟩ := hx + obtain ⟨j, hxj⟩ := Set.mem_iUnion.mp hxu + have hxint : x ∈ convexHull Real + (vertex '' (Set.range (face (order k)) ∩ Set.range (face (order j.val)))) := by + rw [← hexact] + exact ⟨hxk, hxj⟩ + have hm := convexHull_mono (𝕜 := Real) (Set.image_mono (hsub j.val j.property)) hxint + rw [hpair, convexHull_pair] at hm + exact hm + · intro x hx + have hm : x ∈ convexHull Real + (vertex '' (Set.range (face (order k)) ∩ Set.range (face (order l)))) := by + apply convexHull_mono (𝕜 := Real) (Set.image_mono hab) + rw [hpair, convexHull_pair] + exact hx + rw [← hexact] at hm + exact ⟨hm.1, Set.mem_iUnion.mpr ⟨⟨l, hl⟩, hm.2⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3511T1ConvexComparison.lean b/LeanPool/ApollonianSuperharmonic/P3511T1ConvexComparison.lean new file mode 100644 index 0000000000..8ebb18b3c6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3511T1ConvexComparison.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3511T1SourceDissection +public import LeanPool.ApollonianSuperharmonic.P3511T1ConvexRealization +public import LeanPool.ApollonianSuperharmonic.P3555T2ParabolaHullFrontier +public import LeanPool.ApollonianSuperharmonic.P3555T2SavedDissectionGeometry +public import Mathlib.Data.List.FinRange + +-- [TABLET NODE: P3511T1ConvexComparison] + +/-! +# P3511T1ConvexComparison + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3511T1ConvexComparison {n : Nat} + {p : P3381T1PolygonBoundary n} {X : Set (Real × Real)} + (s : P3511T1SourceDissection p X) : + ∃ K : Set (Real × Real), Nonempty (P3511T1ConvexRealization s.face K) := by +-- BODY + let q : Fin (n + 3) → Real × Real := fun i => ((i.val : Real), (i.val : Real) ^ 2) + have hq : ∀ i, q i = ((i.val : Real), (i.val : Real) ^ 2) := fun _ => rfl + obtain ⟨hinjective, _, _⟩ := P3555T2ParabolaSupporting q hq + obtain ⟨hedges, hconvex, hclosed, hbounded, hinterior, hfrontier⟩ := + P3555T2ParabolaHullFrontier q hq + have hboundary : (List.ofFn (fun i : Fin (n + 3) => i)).Nodup := + List.nodup_ofFn_ofInjective Function.injective_id + have hcyclic : ∃ k : Nat, (List.ofFn (fun i : Fin (n + 3) => i)).Sublist + ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k) := by + exact ⟨0, by simp⟩ + obtain ⟨hfaces, _, hcover, hintersection, _⟩ := + P3555T2SavedDissectionGeometry q hq _ _ hboundary hcyclic s.dissection + have hvertices : {i : Fin (n + 3) | i ∈ List.ofFn (fun j : Fin (n + 3) => j)} = + Set.univ := by + apply Set.eq_univ_of_forall + intro i + exact List.mem_ofFn.mpr ⟨i, rfl⟩ + rw [hvertices, Set.image_univ] at hcover + have hindexed : (⋃ (f : Fin 3 → Fin (n + 3)) (_ : f ∈ List.ofFn s.face), + convexHull Real (Set.range (q ∘ f))) = + ⋃ k, convexHull Real (Set.range (q ∘ s.face k)) := by + ext z + simp only [Set.mem_iUnion, List.mem_ofFn] + constructor + · rintro ⟨f, ⟨k, rfl⟩, hz⟩ + exact ⟨k, hz⟩ + · rintro ⟨k, hz⟩ + exact ⟨s.face k, ⟨k, rfl⟩, hz⟩ + refine ⟨convexHull Real (Set.range q), ⟨{ + target := q + parabola := hq + target_injective := hinjective + target_edge_intersection := hedges + target_nondegenerate := ?_ + target_cover := hcover.trans hindexed + target_intersection := ?_ + target_hull := rfl + target_convex := hconvex + target_closed := hclosed + target_bounded := hbounded + target_interior := hinterior + target_frontier := hfrontier }⟩⟩ + · intro k + exact (hfaces (s.face k) (by simp)).2.2 + · intro k l + exact hintersection (s.face k) (by simp) (s.face l) (by simp) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3511T1ConvexRealization.lean b/LeanPool/ApollonianSuperharmonic/P3511T1ConvexRealization.lean new file mode 100644 index 0000000000..88c23a6a2f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3511T1ConvexRealization.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant + +-- [TABLET NODE: P3511T1ConvexRealization] + +/-! +# P3511T1ConvexRealization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For triples $f_k$ on $m=n+3$ indices and a plane set $K$, a convex +realization consists of target points $q_i=(i,i^2)$ and the following +certificates. The target points are distinct, and different cyclic +boundary segments intersect exactly in their common endpoints, as in +`P3381T1PolygonBoundary`. Every target triangle has nonzero +`P3381T1TriangleDeterminant`. For +$\Delta'_k=\operatorname{conv}\{q_{f_k(j)}:0\le j<3\}$ one has +$$ + K=\bigcup_k\Delta'_k,\qquad + \Delta'_k\cap\Delta'_l= + \operatorname{conv}\{q_i:i\in\operatorname{range}f_k + \cap\operatorname{range}f_l\}. +$$ +Moreover $K=\operatorname{conv}\{q_i:0\le i simp + | cons c u ih => simpa using congrArg (fun l => (a, c) :: l) (ih c) + +private theorem edges_split {α : Type} (a b : α) (u v : List α) : + edges (a :: (u ++ b :: v)) = + List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ + List.zipWith Prod.mk (b :: v) (v ++ [a]) := by + classical + let edges {α : Type} (l : List α) : List (α × α) := + List.zipWith Prod.mk l (l.rotate 1) + have edges_cons {α : Type} (a : α) (l : List α) : + edges (a :: l) = List.zipWith Prod.mk (a :: l) (l ++ [a]) := edges_cons (α := α) a l + have path_split {α : Type} (a b z : α) (u v : List α) : + List.zipWith Prod.mk (a :: (u ++ b :: v)) ((u ++ b :: v) ++ [z]) = + List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ + List.zipWith Prod.mk (b :: v) (v ++ [z]) := path_split (α := α) a b z u v + change (edges (a :: (u ++ b :: v)) = + List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ + List.zipWith Prod.mk (b :: v) (v ++ [a])) + rw [edges_cons, path_split] + +private theorem edges_arc {α : Type} (a b : α) (u : List α) : + edges (a :: (u ++ [b])) = + List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ [(b, a)] := by + classical + let edges {α : Type} (l : List α) : List (α × α) := + List.zipWith Prod.mk l (l.rotate 1) + have edges_split {α : Type} (a b : α) (u v : List α) : + edges (a :: (u ++ b :: v)) = + List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ + List.zipWith Prod.mk (b :: v) (v ++ [a]) := edges_split (α := α) a b u v + change (edges (a :: (u ++ [b])) = + List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ [(b, a)]) + simpa using edges_split a b u [] + +private theorem edges_rotate {α : Type} (l : List α) (k : Nat) : + edges (l.rotate k) = (edges l).rotate k := by + classical + let edges {α : Type} (l : List α) : List (α × α) := + List.zipWith Prod.mk l (l.rotate 1) + change (edges (l.rotate k) = (edges l).rotate k) + simp only [edges] + rw [List.zipWith_rotate_distrib _ _ _ _ (List.length_rotate _ _).symm] + congr 1 + rw [List.rotate_rotate, List.rotate_rotate, Nat.add_comm] + +private theorem edges_members {α : Type} {l : List α} {a b : α} + (h : (a, b) ∈ edges l) : a ∈ l ∧ b ∈ l := by + classical + let edges {α : Type} (l : List α) : List (α × α) := + List.zipWith Prod.mk l (l.rotate 1) + obtain ⟨i, hi, he⟩ := List.mem_iff_getElem.mp h + have hil : i < l.length := lt_of_lt_of_le hi (by simp []) + have hir : i < (l.rotate 1).length := by simpa using hil + have hab : (l[i], (l.rotate 1)[i]) = (a, b) := by + simpa [edges] using he + have ha := congrArg Prod.fst hab + have hb := congrArg Prod.snd hab + change l[i] = a at ha + change (l.rotate 1)[i] = b at hb + exact ⟨ha ▸ List.getElem_mem hil, List.mem_rotate.mp (hb ▸ List.getElem_mem hir)⟩ + +private theorem supported {α : Type} {l : List α} {fs : List (Face α)} + (h : P3511T1CyclicDissection α l fs) : + ∀ f ∈ fs, ∀ x ∈ Set.range f, x ∈ l := by + classical + let Face (α : Type) := Fin 3 → α + induction h with + | triangle a b c => + intro f hf x hx + simp only [List.mem_singleton] at hf + subst f + obtain ⟨i, rfl⟩ := hx + fin_cases i <;> simp + | split a b u v left right hu hv hl hr ihl ihr => + intro f hf x hx + rcases List.mem_append.mp hf with hf | hf + · have := ihl f hf x hx + simp only [List.mem_cons, List.mem_append] at this ⊢ + tauto + · have := ihr f hf x hx + simp only [List.mem_cons, List.mem_append] at this ⊢ + tauto + | rotate l fs k h ih => + intro f hf x hx + exact List.mem_rotate.mp (ih f hf x hx) + +private noncomputable abbrev Shell {α : Type} (fs : List (Face α)) : Prop := by + classical + let Face (α : Type) := Fin 3 → α + exact ∀ pre f post, fs = pre ++ f :: post → pre ≠ [] → + ∃ a b c : α, a ≠ b ∧ a ≠ c ∧ b ≠ c ∧ Set.range f = {a, b, c} ∧ + (∀ g ∈ pre, c ∉ Set.range g) ∧ + ∃ g ∈ pre, a ∈ Set.range g ∧ b ∈ Set.range g + +private theorem triple_pair {α : Type} {f : Face α} (hf : Function.Injective f) + {a b : α} (hab : a ≠ b) (ha : a ∈ Set.range f) (hb : b ∈ Set.range f) : + ∃ c, a ≠ c ∧ b ≠ c ∧ Set.range f = {a, b, c} := by + classical + let Face (α : Type) := Fin 3 → α + obtain ⟨i, rfl⟩ := ha + obtain ⟨j, rfl⟩ := hb + have hij : i ≠ j := fun h => hab (congrArg f h) + have hrange : Set.range f = {f 0, f 1, f 2} := by + ext x + constructor + · rintro ⟨k, rfl⟩ + fin_cases k <;> simp + · simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + rintro (rfl | rfl | rfl) + · exact ⟨0, rfl⟩ + · exact ⟨1, rfl⟩ + · exact ⟨2, rfl⟩ + fin_cases i <;> fin_cases j <;> + simp_all only [Fin.zero_eta, Fin.isValue, ne_eq, Fin.mk_one, Fin.reduceFinMk, + not_true_eq_false] + · exact ⟨f 2, hf.ne (by decide), hf.ne (by decide), rfl⟩ + · refine ⟨f 1, hf.ne (by decide), hf.ne (by decide), ?_⟩ + ext x; simp only [Set.mem_insert_iff, Set.mem_singleton_iff]; tauto + · refine ⟨f 2, hf.ne (by decide), hf.ne (by decide), ?_⟩ + ext x; simp only [Set.mem_insert_iff, Set.mem_singleton_iff]; tauto + · refine ⟨f 0, hf.ne (by decide), hf.ne (by decide), ?_⟩ + ext x; simp only [Set.mem_insert_iff, Set.mem_singleton_iff]; tauto + · refine ⟨f 1, hf.ne (by decide), hf.ne (by decide), ?_⟩ + ext x; simp only [Set.mem_insert_iff, Set.mem_singleton_iff]; tauto + · refine ⟨f 0, hf.ne (by decide), hf.ne (by decide), ?_⟩ + ext x; simp only [Set.mem_insert_iff, Set.mem_singleton_iff]; tauto + +private theorem split_lists {α : Type} {a b : α} {u v : List α} + (hn : (a :: (u ++ b :: v)).Nodup) : + (a :: (u ++ [b])).Nodup ∧ (b :: (v ++ [a])).Nodup ∧ a ≠ b ∧ + (∀ x, x ∈ a :: (u ++ [b]) → x ∈ b :: (v ++ [a]) → x = a ∨ x = b) := by + classical + simp only [List.nodup_cons, List.nodup_append, List.mem_append, + List.mem_cons] at hn ⊢ + grind + +private theorem shell_join {α : Type} {left : List (Face α)} {r : Face α} + {tail : List (Face α)} {a b : α} + (hl : Shell left) (hr : Shell (r :: tail)) + (hab : a ≠ b) (hir : Function.Injective r) + (ha : a ∈ Set.range r) (hb : b ∈ Set.range r) + (hattach : ∃ g ∈ left, a ∈ Set.range g ∧ b ∈ Set.range g) + (hsep : ∀ g ∈ left, ∀ f ∈ r :: tail, ∀ x, + x ∈ Set.range g → x ∈ Set.range f → x = a ∨ x = b) : + Shell (left ++ r :: tail) := by + classical + let Face (α : Type) := Fin 3 → α + let Shell {α : Type} (fs : List (Face α)) : Prop := + ∀ pre f post, fs = pre ++ f :: post → pre ≠ [] → + ∃ a b c : α, a ≠ b ∧ a ≠ c ∧ b ≠ c ∧ Set.range f = {a, b, c} ∧ + (∀ g ∈ pre, c ∉ Set.range g) ∧ + ∃ g ∈ pre, a ∈ Set.range g ∧ b ∈ Set.range g + have triple_pair {α : Type} {f : Face α} (hf : Function.Injective f) + {a b : α} (hab : a ≠ b) (ha : a ∈ Set.range f) (hb : b ∈ Set.range f) : + ∃ c, a ≠ c ∧ b ≠ c ∧ Set.range f = {a, b, c} := triple_pair (α := α) (f := f) hf (a := a) + (b := b) hab ha hb + change (Shell (left ++ r :: tail)) + have hfirst (post : List (Face α)) (he : r :: tail = r :: post) : + ∃ a b c : α, a ≠ b ∧ a ≠ c ∧ b ≠ c ∧ Set.range r = {a, b, c} ∧ + (∀ g ∈ left, c ∉ Set.range g) ∧ + ∃ g ∈ left, a ∈ Set.range g ∧ b ∈ Set.range g := by + obtain ⟨c, hac, hbc, hset⟩ := triple_pair hir hab ha hb + refine ⟨a, b, c, hab, hac, hbc, hset, ?_, hattach⟩ + intro g hg hc + have hcr : c ∈ Set.range r := by rw [hset]; simp + rcases hsep g hg r (by simp) c hc hcr with h | h + · exact hac h.symm + · exact hbc h.symm + intro pre f post he hp + rcases List.append_eq_append_iff.mp he with ⟨mid, hpre, hright⟩ | ⟨mid, hleft, hrest⟩ + · cases mid with + | nil => + simp only [List.append_nil] at hpre + simp only [List.nil_append, List.cons.injEq] at hright + obtain ⟨rfl, htail⟩ := hright + subst pre + exact hfirst post (by simp [htail]) + | cons q mid => + obtain ⟨x, y, c, hxy, hxc, hyc, hfset, hnew, hg⟩ := + hr (q :: mid) f post hright (by simp) + have hq : q = r := by simpa using (List.cons.inj hright).1.symm + have hroot : r ∈ q :: mid := by simp [hq] + have hca : c ≠ a := by + intro h; subst c; exact hnew r hroot ha + have hcb : c ≠ b := by + intro h; subst c; exact hnew r hroot hb + refine ⟨x, y, c, hxy, hxc, hyc, hfset, ?_, ?_⟩ + · intro g hg hc + rw [hpre] at hg + rcases List.mem_append.mp hg with hg | hg + · have hcf : c ∈ Set.range f := by rw [hfset]; simp + have hfm : f ∈ r :: tail := by rw [hright]; simp + rcases hsep g hg f hfm c hc hcf with h | h + · exact hca h + · exact hcb h + · exact hnew g hg hc + · obtain ⟨g, hg, hx, hy⟩ := hg + exact ⟨g, by rw [hpre]; exact List.mem_append_right _ hg, hx, hy⟩ + · cases mid with + | nil => + simp only [List.append_nil] at hleft + simp only [List.nil_append, List.cons.injEq] at hrest + obtain ⟨rfl, htail⟩ := hrest + subst pre + exact hfirst post (by simp [htail]) + | cons q mid => + have hq : f = q := (List.cons.inj hrest).1 + subst q + exact hl pre f mid hleft hp + +private theorem rooted {α : Type} {l : List α} {fs : List (Face α)} + (h : P3511T1CyclicDissection α l fs) (hn : l.Nodup) + (hi : ∀ f ∈ fs, Function.Injective f) : + ∀ x y, (x, y) ∈ edges l → + ∃ r tail, (r :: tail).Perm fs ∧ x ∈ Set.range r ∧ y ∈ Set.range r ∧ + Shell (r :: tail) := by + classical + let Face (α : Type) := Fin 3 → α + let edges {α : Type} (l : List α) : List (α × α) := + List.zipWith Prod.mk l (l.rotate 1) + have edges_split {α : Type} (a b : α) (u v : List α) : + edges (a :: (u ++ b :: v)) = + List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ + List.zipWith Prod.mk (b :: v) (v ++ [a]) := edges_split (α := α) a b u v + have edges_arc {α : Type} (a b : α) (u : List α) : + edges (a :: (u ++ [b])) = + List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ [(b, a)] := edges_arc (α := α) a b u + have edges_rotate {α : Type} (l : List α) (k : Nat) : + edges (l.rotate k) = (edges l).rotate k := edges_rotate (α := α) l k + have edges_members {α : Type} {l : List α} {a b : α} + (h : (a, b) ∈ edges l) : a ∈ l ∧ b ∈ l := edges_members (α := α) (l := l) (a := a) (b := b) h + have supported {α : Type} {l : List α} {fs : List (Face α)} + (h : P3511T1CyclicDissection α l fs) : + ∀ f ∈ fs, ∀ x ∈ Set.range f, x ∈ l := supported (α := α) (l := l) (fs := fs) h + let Shell {α : Type} (fs : List (Face α)) : Prop := + ∀ pre f post, fs = pre ++ f :: post → pre ≠ [] → + ∃ a b c : α, a ≠ b ∧ a ≠ c ∧ b ≠ c ∧ Set.range f = {a, b, c} ∧ + (∀ g ∈ pre, c ∉ Set.range g) ∧ + ∃ g ∈ pre, a ∈ Set.range g ∧ b ∈ Set.range g + have split_lists {α : Type} {a b : α} {u v : List α} + (hn : (a :: (u ++ b :: v)).Nodup) : + (a :: (u ++ [b])).Nodup ∧ (b :: (v ++ [a])).Nodup ∧ a ≠ b ∧ + (∀ x, x ∈ a :: (u ++ [b]) → x ∈ b :: (v ++ [a]) → x = a ∨ x = b) := split_lists (α := α) + (a := a) (b := b) (u := u) (v := v) hn + have shell_join {α : Type} {left : List (Face α)} {r : Face α} + {tail : List (Face α)} {a b : α} + (hl : Shell left) (hr : Shell (r :: tail)) + (hab : a ≠ b) (hir : Function.Injective r) + (ha : a ∈ Set.range r) (hb : b ∈ Set.range r) + (hattach : ∃ g ∈ left, a ∈ Set.range g ∧ b ∈ Set.range g) + (hsep : ∀ g ∈ left, ∀ f ∈ r :: tail, ∀ x, + x ∈ Set.range g → x ∈ Set.range f → x = a ∨ x = b) : + Shell (left ++ r :: tail) := shell_join (α := α) (left := left) (r := r) (tail := tail) (a + := a) (b := b) hl hr hab hir ha hb hattach hsep + change (∀ x y, (x, y) ∈ edges l → + ∃ r tail, (r :: tail).Perm fs ∧ x ∈ Set.range r ∧ y ∈ Set.range r ∧ + Shell (r :: tail)) + induction h with + | triangle a b c => + intro x y hxy + have hm := edges_members hxy + refine ⟨![a, b, c], [], List.Perm.refl _, ?_, ?_, ?_⟩ + · simpa [Set.mem_range, Fin.exists_fin_succ, eq_comm, + or_comm, or_left_comm, or_assoc] using hm.1 + · simpa [Set.mem_range, Fin.exists_fin_succ, eq_comm, + or_comm, or_left_comm, or_assoc] using hm.2 + · intro pre f post he hp + have hlen := congrArg List.length he + have hpos : 0 < pre.length := List.length_pos_iff.mpr hp + simp only [List.length_cons, List.length_nil, List.length_append] at hlen + omega + | split a b u v left right hu hv hl hr ihl ihr => + obtain ⟨hnl, hnr, hab, hover⟩ := split_lists hn + have hil : ∀ f ∈ left, Function.Injective f := + fun f hf => hi f (List.mem_append_left _ hf) + have hir : ∀ f ∈ right, Function.Injective f := + fun f hf => hi f (List.mem_append_right _ hf) + have hba : (b, a) ∈ edges (a :: (u ++ [b])) := by rw [edges_arc]; simp + have habr : (a, b) ∈ edges (b :: (v ++ [a])) := by rw [edges_arc]; simp + have hpairl : ∃ g ∈ left, a ∈ Set.range g ∧ b ∈ Set.range g := by + obtain ⟨r, tail, hp, hb, ha, hs⟩ := ihl hnl hil b a hba + exact ⟨r, hp.mem_iff.mp (by simp), ha, hb⟩ + have hpairr : ∃ g ∈ right, a ∈ Set.range g ∧ b ∈ Set.range g := by + obtain ⟨r, tail, hp, ha, hb, hs⟩ := ihr hnr hir a b habr + exact ⟨r, hp.mem_iff.mp (by simp), ha, hb⟩ + intro x y hxy + rw [edges_split] at hxy + rcases List.mem_append.mp hxy with hxy | hxy + · have hxy' : (x, y) ∈ edges (a :: (u ++ [b])) := by + rw [edges_arc]; exact List.mem_append_left _ hxy + obtain ⟨rl, tl, hpl, hx, hy, hsl⟩ := ihl hnl hil x y hxy' + obtain ⟨rr, tr, hpr, ha, hb, hsr⟩ := ihr hnr hir a b habr + refine ⟨rl, tl ++ rr :: tr, ?_, hx, hy, ?_⟩ + · exact hpl.append hpr + · apply shell_join hsl hsr hab (hir rr (hpr.mem_iff.mp (by simp))) ha hb + · obtain ⟨g, hg, hga, hgb⟩ := hpairl + exact ⟨g, hpl.mem_iff.mpr hg, hga, hgb⟩ + · intro g hg f hf z hzg hzf + exact hover z (supported hl g (hpl.mem_iff.mp hg) z hzg) + (supported hr f (hpr.mem_iff.mp hf) z hzf) + · have hxy' : (x, y) ∈ edges (b :: (v ++ [a])) := by + rw [edges_arc]; exact List.mem_append_left _ hxy + obtain ⟨rr, tr, hpr, hx, hy, hsr⟩ := ihr hnr hir x y hxy' + obtain ⟨rl, tl, hpl, hb, ha, hsl⟩ := ihl hnl hil b a hba + refine ⟨rr, tr ++ rl :: tl, ?_, hx, hy, ?_⟩ + · exact (hpr.append hpl).trans (List.perm_append_comm ..) + · apply shell_join hsr hsl hab (hil rl (hpl.mem_iff.mp (by simp))) ha hb + · obtain ⟨g, hg, hga, hgb⟩ := hpairr + exact ⟨g, hpr.mem_iff.mpr hg, hga, hgb⟩ + · intro g hg f hf z hzg hzf + exact hover z (supported hl f (hpl.mem_iff.mp hf) z hzf) + (supported hr g (hpr.mem_iff.mp hg) z hzg) + | rotate l fs k h ih => + intro x y hxy + apply ih (List.nodup_rotate.mpr hn) hi x y + rw [edges_rotate] + exact List.mem_rotate.mpr hxy + +end DissectionLeafOrderConstruction + +theorem P3511T1LeafOrder {n : Nat} + {p : P3381T1PolygonBoundary n} {X : Set (Real × Real)} + (s : P3511T1SourceDissection p X) : + ∃ order : Fin s.count ≃ Fin s.count, + ∀ k : Fin s.count, 0 < k.val → + ∃ a b c : Fin (n + 3), a ≠ b ∧ a ≠ c ∧ b ≠ c ∧ + Set.range (s.face (order k)) = {a, b, c} ∧ + (∀ l : Fin s.count, l.val < k.val → + c ∉ Set.range (s.face (order l))) ∧ + Set.ncard {l : Fin s.count | l.val < k.val ∧ + a ∈ Set.range (s.face (order l)) ∧ + b ∈ Set.range (s.face (order l))} = 1 := by +-- BODY + classical + -- Root shellings at a cyclic boundary edge, including the split diagonal. + let Face (α : Type) := Fin 3 → α + let edges {α : Type} (l : List α) : List (α × α) := + List.zipWith Prod.mk l (l.rotate 1) + have edges_cons {α : Type} (a : α) (l : List α) : + edges (a :: l) = List.zipWith Prod.mk (a :: l) (l ++ [a]) := + DissectionLeafOrderConstruction.edges_cons (α := α) a l + have path_split {α : Type} (a b z : α) (u v : List α) : + List.zipWith Prod.mk (a :: (u ++ b :: v)) ((u ++ b :: v) ++ [z]) = + List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ + List.zipWith Prod.mk (b :: v) (v ++ [z]) := DissectionLeafOrderConstruction.path_split + (α := α) a b z u v + have edges_split {α : Type} (a b : α) (u v : List α) : + edges (a :: (u ++ b :: v)) = + List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ + List.zipWith Prod.mk (b :: v) (v ++ [a]) := DissectionLeafOrderConstruction.edges_split + (α := α) a b u v + have edges_arc {α : Type} (a b : α) (u : List α) : + edges (a :: (u ++ [b])) = + List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ [(b, a)] := + DissectionLeafOrderConstruction.edges_arc (α := α) a b u + have edges_rotate {α : Type} (l : List α) (k : Nat) : + edges (l.rotate k) = (edges l).rotate k := DissectionLeafOrderConstruction.edges_rotate (α + := α) l k + have edges_members {α : Type} {l : List α} {a b : α} + (h : (a, b) ∈ edges l) : a ∈ l ∧ b ∈ l := DissectionLeafOrderConstruction.edges_members (α + := α) (l := l) (a := a) (b := b) h + have supported {α : Type} {l : List α} {fs : List (Face α)} + (h : P3511T1CyclicDissection α l fs) : + ∀ f ∈ fs, ∀ x ∈ Set.range f, x ∈ l := DissectionLeafOrderConstruction.supported (α := α) (l + := l) (fs := fs) h + let Shell {α : Type} (fs : List (Face α)) : Prop := + ∀ pre f post, fs = pre ++ f :: post → pre ≠ [] → + ∃ a b c : α, a ≠ b ∧ a ≠ c ∧ b ≠ c ∧ Set.range f = {a, b, c} ∧ + (∀ g ∈ pre, c ∉ Set.range g) ∧ + ∃ g ∈ pre, a ∈ Set.range g ∧ b ∈ Set.range g + have triple_pair {α : Type} {f : Face α} (hf : Function.Injective f) + {a b : α} (hab : a ≠ b) (ha : a ∈ Set.range f) (hb : b ∈ Set.range f) : + ∃ c, a ≠ c ∧ b ≠ c ∧ Set.range f = {a, b, c} := DissectionLeafOrderConstruction.triple_pair + (α := α) (f := f) hf (a := a) (b := b) hab ha hb + have split_lists {α : Type} {a b : α} {u v : List α} + (hn : (a :: (u ++ b :: v)).Nodup) : + (a :: (u ++ [b])).Nodup ∧ (b :: (v ++ [a])).Nodup ∧ a ≠ b ∧ + (∀ x, x ∈ a :: (u ++ [b]) → x ∈ b :: (v ++ [a]) → x = a ∨ x = b) := + DissectionLeafOrderConstruction.split_lists (α := α) (a := a) (b := b) (u := u) (v := + v) hn + have shell_join {α : Type} {left : List (Face α)} {r : Face α} + {tail : List (Face α)} {a b : α} + (hl : Shell left) (hr : Shell (r :: tail)) + (hab : a ≠ b) (hir : Function.Injective r) + (ha : a ∈ Set.range r) (hb : b ∈ Set.range r) + (hattach : ∃ g ∈ left, a ∈ Set.range g ∧ b ∈ Set.range g) + (hsep : ∀ g ∈ left, ∀ f ∈ r :: tail, ∀ x, + x ∈ Set.range g → x ∈ Set.range f → x = a ∨ x = b) : + Shell (left ++ r :: tail) := DissectionLeafOrderConstruction.shell_join (α := α) (left := + left) (r := r) (tail := tail) (a := a) (b := b) hl hr hab hir ha hb hattach hsep + have rooted {α : Type} {l : List α} {fs : List (Face α)} + (h : P3511T1CyclicDissection α l fs) (hn : l.Nodup) + (hi : ∀ f ∈ fs, Function.Injective f) : + ∀ x y, (x, y) ∈ edges l → + ∃ r tail, (r :: tail).Perm fs ∧ x ∈ Set.range r ∧ y ∈ Set.range r ∧ + Shell (r :: tail) := DissectionLeafOrderConstruction.rooted (α := α) (l := l) (fs := + fs) h hn hi + let boundary := List.ofFn (fun i : Fin (n + 3) => i) + have hn : boundary.Nodup := List.nodup_ofFn.mpr Function.injective_id + have hi : ∀ f ∈ List.ofFn s.face, Function.Injective f := by + intro f hf + obtain ⟨k, rfl⟩ := List.mem_ofFn.mp hf + exact s.face_injective k + have hne : edges boundary ≠ [] := by + intro he + have hlen := congrArg List.length he + simp [edges, boundary] at hlen + obtain ⟨⟨x, y⟩, hxy⟩ := List.exists_mem_of_ne_nil _ hne + obtain ⟨r, tail, hp, hx, hy, hs⟩ := rooted s.dissection hn hi x y hxy + let fs := r :: tail + have hlen : fs.length = s.count := by simpa [fs] using hp.length_eq + let e : Fin fs.length ≃ Fin (List.ofFn s.face).length := + Equiv.ofBijective hp.idxBij ⟨hp.idxBij_injective, hp.idxBij_surjective⟩ + let order : Fin s.count ≃ Fin s.count := + (finCongr hlen.symm).trans (e.trans (finCongr (List.length_ofFn (f := s.face)))) + have hface (k : Fin s.count) : s.face (order k) = fs[k.val]'(by omega) := by + have he := hp.getElem_idxBij_eq_getElem (Fin.cast hlen.symm k) + simpa only [order, e, fs, Equiv.trans_apply, Equiv.ofBijective, finCongr, + Equiv.coe_fn_mk, List.getElem_ofFn, Fin.val_cast, Fin.cast] using he + refine ⟨order, ?_⟩ + intro k hk + have hkfs : k.val < fs.length := by omega + have hsplit : fs = fs.take k.val ++ fs[k.val] :: fs.drop (k.val + 1) := by + rw [List.getElem_cons_drop, List.take_append_drop] + have hpre : fs.take k.val ≠ [] := by + intro he + have hh := congrArg List.length he + simp only [List.length_take, List.length_nil] at hh + omega + obtain ⟨a, b, c, hab, hac, hbc, hset, hnew, g, hg, hga, hgb⟩ := + hs (fs.take k.val) fs[k.val] (fs.drop (k.val + 1)) hsplit hpre + refine ⟨a, b, c, hab, hac, hbc, ?_, ?_, ?_⟩ + · simpa only [hface] using hset + · intro l hl + rw [hface] + apply hnew + exact List.mem_take_iff_getElem.mpr ⟨l.val, by omega, rfl⟩ + · obtain ⟨j, hj, hjg⟩ := List.mem_take_iff_getElem.mp hg + let l : Fin s.count := ⟨j, by omega⟩ + have hlj : l.val < k.val := by dsimp [l]; omega + have hgl : s.face (order l) = g := by rw [hface]; exact hjg + have hka : a ∈ Set.range (s.face (order k)) := by rw [hface, hset]; simp + have hkb : b ∈ Set.range (s.face (order k)) := by rw [hface, hset]; simp + have hla : a ∈ Set.range (s.face (order l)) := by rw [hgl]; exact hga + have hlb : b ∈ Set.range (s.face (order l)) := by rw [hgl]; exact hgb + let S : Set (Fin s.count) := {i | a ∈ Set.range (s.face i) ∧ b ∈ Set.range (s.face i)} + have hbound : S.ncard ≤ 2 := by + have hc := s.edge_count a b hab + change S.ncard = _ at hc + split_ifs at hc <;> omega + have hmemk : order k ∈ S := ⟨hka, hkb⟩ + have hmeml : order l ∈ S := ⟨hla, hlb⟩ + have hkl : order k ≠ order l := by + intro he + have := congrArg Fin.val (order.injective he) + omega + have heq : ({order k, order l} : Set (Fin s.count)) = S := by + apply Set.eq_of_subset_of_ncard_le + · intro i hi + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hi + rcases hi with rfl | rfl + · exact hmemk + · exact hmeml + · rw [Set.ncard_pair hkl] + exact hbound + · exact Set.toFinite _ + have hpred : {i : Fin s.count | i.val < k.val ∧ + a ∈ Set.range (s.face (order i)) ∧ b ∈ Set.range (s.face (order i))} = {l} := by + ext i + constructor + · rintro ⟨hik, hia, hib⟩ + have hm : order i ∈ S := ⟨hia, hib⟩ + rw [← heq] at hm + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hm + rcases hm with h | h + · have := congrArg Fin.val (order.injective h) + omega + · exact order.injective h + · intro he + simp only [Set.mem_singleton_iff] at he + subst i + exact ⟨hlj, hla, hlb⟩ + rw [hpred, Set.ncard_singleton] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3511T1SourceConstruction.lean b/LeanPool/ApollonianSuperharmonic/P3511T1SourceConstruction.lean new file mode 100644 index 0000000000..4f6098c2e2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3511T1SourceConstruction.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3511T1SourceDissection +public import LeanPool.ApollonianSuperharmonic.P3544T1TriangleRayGeometry +public import LeanPool.ApollonianSuperharmonic.P3544T1DiagonalSelection +public import LeanPool.ApollonianSuperharmonic.P3544T1IndexedGluing +public import Mathlib.Tactic.FinCases + +-- [TABLET NODE: P3511T1SourceConstruction] + +/-! +# P3511T1SourceConstruction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3511T1SourceConstruction : + ∀ {n : Nat}, ∀ (p : P3381T1PolygonBoundary n), (∀ i : Fin (n + 3), + P3381T1TriangleDeterminant (fun j : Fin 3 => + p.vertex (i + ⟨j.val, Nat.lt_of_lt_of_le j.isLt (Nat.le_add_left 3 n)⟩)) ≠ 0) → (∃ X : + Set (Real × Real), Nonempty (P3511T1SourceDissection p X)) := by + intro n p hcorner +-- BODY + classical + -- The children may have straight corners, so the induction omits hcorner. + have construct : ∀ m (q : P3381T1PolygonBoundary m), + ∃ X : Set (Real × Real), Nonempty (P3511T1SourceDissection q X) ∧ + X = closure (P3544T1RayParity q) ∧ + IsPathConnected (P3544T1RayParity q) := by + intro m + induction m using Nat.strong_induction_on with + | h m ih => + intro q + have hclosure := (P3544T1LocalParity q).1 + cases m with + | zero => + obtain ⟨hdet, hfill, hpath⟩ := P3544T1TriangleRayGeometry q + let f : Fin 1 → Fin 3 → Fin 3 := fun _ j => j + refine ⟨convexHull Real (Set.range q.vertex), + ⟨{ count := 1 + count_pos := by decide + face := f + dissection := ?_ + face_injective := ?_ + face_distinct := ?_ + vertex_used := ?_ + nondegenerate := ?_ + cover := ?_ + intersection := ?_ + edge_count := ?_ }⟩, + hfill.trans hclosure.symm, hpath⟩ + · have hid : (![0, 1, 2] : Fin 3 → Fin 3) = fun j => j := by + funext j + fin_cases j <;> rfl + have ht := P3511T1CyclicDissection.triangle (0 : Fin 3) 1 2 + rw [hid] at ht + exact ht + · intro k + exact Function.injective_id + · intro k l _ + exact Subsingleton.elim k l + · intro i + exact ⟨0, i, rfl⟩ + · intro k + exact hdet + · change convexHull Real (Set.range q.vertex) = + ⋃ _ : Fin 1, convexHull Real (Set.range q.vertex) + ext x + constructor + · intro hx + exact Set.mem_iUnion.mpr ⟨(0 : Fin 1), hx⟩ + · intro hx + obtain ⟨k, hk⟩ := Set.mem_iUnion.mp hx + exact hk + · intro k l + change convexHull Real (Set.range q.vertex) ∩ + convexHull Real (Set.range q.vertex) = + convexHull Real (q.vertex '' (Set.range (fun j : Fin 3 => j) ∩ + Set.range (fun j : Fin 3 => j))) + simp + · intro i j hij + have hneighbor : j = i + 1 ∨ i = j + 1 := by + have h : ∀ i j : Fin 3, i ≠ j → j = i + 1 ∨ i = j + 1 := by + decide + exact h i j hij + simp [f, hneighbor] + | succ m => + obtain ⟨S⟩ := P3544T1DiagonalSelection q (Nat.succ_pos m) + obtain ⟨XL, ⟨L⟩, hL, hcL⟩ := ih S.left_n S.left_lt S.left + obtain ⟨XR, ⟨R⟩, hR, hcR⟩ := ih S.right_n S.right_lt S.right + have hLfill := hL.trans (P3544T1LocalParity S.left).1 + have hRfill := hR.trans (P3544T1LocalParity S.right).1 + obtain ⟨Z, _hfaces, hfill, hpath⟩ := + P3544T1IndexedGluing S L R hLfill hRfill hcL hcR + exact ⟨XL ∪ XR, ⟨Z⟩, hfill.trans hclosure.symm, hpath⟩ + obtain ⟨X, hX, _⟩ := construct n p + exact ⟨X, hX⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3511T1SourceDissection.lean b/LeanPool/ApollonianSuperharmonic/P3511T1SourceDissection.lean new file mode 100644 index 0000000000..a0462d0cd5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3511T1SourceDissection.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3511T1CyclicDissection +public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public import Mathlib.Data.Set.Card + +-- [TABLET NODE: P3511T1SourceDissection] + +/-! +# P3511T1SourceDissection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a boundary $p$ of `P3381T1PolygonBoundary` with $m=n+3$ +vertices and a plane set $X$, a source dissection consists of a positive +integer $N$ and triples $f_k:\{0,1,2\}\to\{0,\ldots,m-1\}$, +$0\le k i)) (List.ofFn face) + face_injective : ∀ k, Function.Injective (face k) + face_distinct : Function.Injective (fun k => Set.range (face k)) + vertex_used : ∀ i, ∃ k j, face k j = i + nondegenerate : ∀ k, + P3381T1TriangleDeterminant (p.vertex ∘ face k) ≠ 0 + cover : X = ⋃ k, convexHull Real (Set.range (p.vertex ∘ face k)) + intersection : ∀ k l, + convexHull Real (Set.range (p.vertex ∘ face k)) ∩ + convexHull Real (Set.range (p.vertex ∘ face l)) = + convexHull Real (p.vertex '' (Set.range (face k) ∩ Set.range (face l))) + edge_count : ∀ i j : Fin (n + 3), i ≠ j → + Set.ncard {k : Fin count | + i ∈ Set.range (face k) ∧ j ∈ Set.range (face k)} = + if j = i + 1 ∨ i = j + 1 then 1 + else if ∃ k, i ∈ Set.range (face k) ∧ j ∈ Set.range (face k) then 2 else 0 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1BoundaryFaceSplit.lean b/LeanPool/ApollonianSuperharmonic/P3523T1BoundaryFaceSplit.lean new file mode 100644 index 0000000000..8770a9053e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3523T1BoundaryFaceSplit.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionData + +-- [TABLET NODE: P3523T1BoundaryFaceSplit] + +/-! +# P3523T1BoundaryFaceSplit + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a finite family $\mathcal F$ of finite label sets and labels +$a,d,b$, replace every $F\in\mathcal F$ containing $a,b$ by +$$ + (F\setminus\{b\})\cup\{d\},\qquad + (F\setminus\{a\})\cup\{d\}, +$$ +and retain every other $F$. Take the finite union of these outputs. +In the intended application exactly one face contains the boundary +pair $a,b$. The formula is defined even without that hypothesis and +makes no claim of correctness for such inputs. +-/ +def P3523T1BoundaryFaceSplit {I : Type} [DecidableEq I] + (faces : Finset (Finset I)) (a d b : I) : Finset (Finset I) := +-- BODY + faces.biUnion fun F => + if a ∈ F ∧ b ∈ F then {insert d (F.erase b), insert d (F.erase a)} + else {F} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1FaceEnumeration.lean b/LeanPool/ApollonianSuperharmonic/P3523T1FaceEnumeration.lean new file mode 100644 index 0000000000..a3008c924c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3523T1FaceEnumeration.lean @@ -0,0 +1,49 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionConstruction +public import Mathlib.Data.Fintype.EquivFin + +-- [TABLET NODE: P3523T1FaceEnumeration] + +/-! +# P3523T1FaceEnumeration + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a finite family $\mathcal F$ of finite subsets of +$\operatorname{Fin}(n+3)$, fix the standard finite-cardinality +equivalence from $\operatorname{Fin}(|\mathcal F|)$ to the elements +of $\mathcal F$. At each index $k$, choose an injective map +$f_k:\operatorname{Fin}3\to\operatorname{Fin}(n+3)$ with range +equal to its corresponding finite face, if such a map exists. +If none exists use the constant zero map. Thus this is a total +definition; correctness must in particular prove that the fallback +is never used in the constructed family. It retains every original +fine label literally and orders only the three labels of each face. +-/ +noncomputable def P3523T1FaceEnumeration {n : Nat} + (fs : Finset (Finset (Fin (n + 3)))) : Fin fs.card → Fin 3 → Fin (n + 3) := by +-- BODY + classical + let e : Fin fs.card ≃ {F // F ∈ fs} := fs.equivFin.symm + exact fun k => + if h : ∃ f : Fin 3 → Fin (n + 3), Function.Injective f ∧ + Set.range f = ((e k).val : Set (Fin (n + 3))) then + Classical.choose h + else fun _ => 0 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionConstruction.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionConstruction.lean new file mode 100644 index 0000000000..84d7cfb342 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionConstruction.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3523T1BoundaryFaceSplit +public import LeanPool.ApollonianSuperharmonic.P3523T1InterpolatedTarget +public import Mathlib.Data.Finset.Image + +-- [TABLET NODE: P3523T1InsertionConstruction] + +/-! +# P3523T1InsertionConstruction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $s$ be an ordered subdivision and $t$ a triangle tree, as in +`P3475T1BoundarySubdivision` and +`P3475T1TriangleTree`. Put $I=\operatorname{Fin}(n+3)$. +List the indices $s.\mathrm{start}(0)+k$ for $0\le k s.start 0 + k).filter + fun j => s.parameter j ≠ 0).map + fun j => (j - 1, j, s.start (s.edge j + 1)) + let initialFaces : Finset (Finset (Fin (n + 3))) := + Finset.univ.image fun k : Fin t.count => + Finset.univ.image (s.start ∘ t.face k) + let initialVertices := Finset.univ.image s.start + let initialBoundary := Finset.univ.image fun i : Fin (r + 3) => + ({s.start i, s.start (i + 1)} : Finset (Fin (n + 3))) + exact { + steps := steps + faces := fun k => (steps.take k).foldl + (fun fs e => P3523T1BoundaryFaceSplit fs e.1 e.2.1 e.2.2) initialFaces + vertices := fun k => (steps.take k).foldl + (fun vs e => insert e.2.1 vs) initialVertices + boundary := fun k => (steps.take k).foldl + (fun es e => insert {e.1, e.2.1} + (insert {e.2.1, e.2.2} (es.erase {e.1, e.2.2}))) initialBoundary } + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionData.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionData.lean new file mode 100644 index 0000000000..673e033cd2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionData.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Data.Finset.Union + +-- [TABLET NODE: P3523T1InsertionData] + +/-! +# P3523T1InsertionData + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For an arbitrary label set $I$, insertion data consist of a record +with four independently chosen fields: + + +- $\mathrm{steps}$ is an arbitrary finite list of ordered triples +$(a,d,b)\in I\times I\times I$. The list may be empty, and its +entries and their component labels may repeat. + +- $\mathrm{faces}$ assigns to every $n\in\mathbb N$ an arbitrary +finite set of finite subsets of $I$. + +- $\mathrm{vertices}$ assigns to every $n\in\mathbb N$ an +arbitrary finite subset of $I$. + +- $\mathrm{boundary}$ assigns to every $n\in\mathbb N$ an +arbitrary finite set of finite subsets of $I$. + +All three sequences are defined for every natural number, including +$n\ge |\mathrm{steps}|$; no constancy after the end of the list is +required. The field names indicate their intended roles in insertion +schedules only. Members of $\mathrm{faces}(n)$ and +$\mathrm{boundary}(n)$ are not required to have cardinality three or +two, respectively. No distinctness of step labels, membership of +labels from the steps, faces, or boundary in $\mathrm{vertices}(n)$, +coherence between fields or stages, or geometric correctness is +imposed. Such properties of the actual insertion schedule are +supplied separately by its construction and incidence results, not +by this data carrier. +-/ +structure P3523T1InsertionData (I : Type) where +-- BODY + /-- The finite schedule of triples naming an old edge and its inserted label. -/ + steps : List (I × I × I) + /-- The finite face family at each stage of the schedule. -/ + faces : Nat → Finset (Finset I) + /-- The finite set of present labels at each stage. -/ + vertices : Nat → Finset I + /-- The finite boundary-edge family at each stage. -/ + boundary : Nat → Finset (Finset I) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean new file mode 100644 index 0000000000..be0a4b23a5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean @@ -0,0 +1,2785 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionIncidence +public import LeanPool.ApollonianSuperharmonic.P3523T1TargetBoundary +public import LeanPool.ApollonianSuperharmonic.P3523T1TargetHull +public import LeanPool.ApollonianSuperharmonic.P3523T1TwoTriangleSplit +public import LeanPool.ApollonianSuperharmonic.P3523T1SplitDeterminants +public import Mathlib.LinearAlgebra.Matrix.Determinant.Basic + + +-- [TABLET NODE: P3523T1InsertionGeometry] + +/-! +# P3523T1InsertionGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FacialInsertionGeometry + +private theorem split_mem : + (by + classical + exact + ∀ {I : Type}, ∀ [DecidableEq I], ∀ (fs : Finset (Finset I)), ∀ (a : I), ∀ (d : I), + ∀ (b : I), ∀ (G : Finset I), G ∈ P3523T1BoundaryFaceSplit fs a d b ↔ ∃ F ∈ fs, if a + ∈ F ∧ b ∈ F then G = insert d (F.erase b) ∨ G = insert d (F.erase a) else G = F ) := by + classical + intro I typeclassInstance0 fs a d b G + constructor + · intro h + rcases Finset.mem_biUnion.mp h with ⟨F, hF, hG⟩ + refine ⟨F, hF, ?_⟩ + by_cases hab : a ∈ F ∧ b ∈ F + · simpa [P3523T1BoundaryFaceSplit, hab] using hG + · simpa [P3523T1BoundaryFaceSplit, hab] using hG + · rintro ⟨F, hF, hG⟩ + apply Finset.mem_biUnion.mpr + refine ⟨F, hF, ?_⟩ + by_cases hab : a ∈ F ∧ b ∈ F + · simpa [P3523T1BoundaryFaceSplit, hab] using hG + · simpa [P3523T1BoundaryFaceSplit, hab] using hG + +private theorem split_mem_cases : + (by + classical + exact + (∀ {I : Type}, ∀ [DecidableEq I], ∀ (fs : Finset (Finset I)), ∀ (a : I), ∀ (d : I), ∀ (b + : I), ∀ (G : Finset I), G ∈ P3523T1BoundaryFaceSplit fs a d b ↔ ∃ F ∈ fs, if a ∈ F + ∧ b ∈ F then G = insert d (F.erase b) ∨ G = insert d (F.erase a) else G = F) → (∀ + {I : Type}, ∀ [DecidableEq I], ∀ (fs : Finset (Finset I)), ∀ (a : I), ∀ (d : + I), ∀ (b : I), ∀ (G : Finset I), G ∈ P3523T1BoundaryFaceSplit fs a d b ↔ ∃ F ∈ fs, + a ∈ F ∧ b ∈ F ∧ (G = insert d (F.erase b) ∨ G = insert d (F.erase a)) ∨ ¬(a ∈ F ∧ b ∈ + F) ∧ G = F) ) := by + classical + intro split_mem I typeclassInstance0 fs a d b G + constructor + · intro h + rcases (split_mem fs a d b G).mp h with ⟨F, hF, hbranch⟩ + by_cases hh : a ∈ F ∧ b ∈ F + · refine ⟨F, hF, Or.inl ⟨hh.1, hh.2, ?_⟩⟩ + exact Eq.mp (ite_eq_left hh) hbranch + · refine ⟨F, hF, Or.inr ⟨hh, ?_⟩⟩ + exact Eq.mp (ite_eq_right hh) hbranch + · rintro ⟨F, hF, hbranch⟩ + apply (split_mem fs a d b G).mpr + refine ⟨F, hF, ?_⟩ + rcases hbranch with ⟨ha, hb, hchildren⟩ | ⟨hh, hsame⟩ + · have hh : a ∈ F ∧ b ∈ F := ⟨ha, hb⟩ + rw [ite_eq_left hh] + exact hchildren + · rw [ite_eq_right hh] + exact hsame + +private theorem triangleMatrix_det : + (by + classical + exact + let triangleMatrix (v : Fin 3 → Real × Real) : + Matrix (Fin 3) (Fin 3) Real := + fun i j => if j = 0 then (v i).1 else if j = 1 then (v i).2 else 1 + ∀ (v : Fin (3 : ℕ) → ℝ × ℝ), P3381T1TriangleDeterminant v = (triangleMatrix v).det ) := by + classical + intro triangleMatrix v + rw [Matrix.det_fin_three] + simp [triangleMatrix, P3381T1TriangleDeterminant] + ring + +private theorem det_range_transport : + (by + classical + exact + let triangleMatrix (v : Fin 3 → Real × Real) : + Matrix (Fin 3) (Fin 3) Real := + fun i j => if j = 0 then (v i).1 else if j = 1 then (v i).2 else 1 + (∀ (v : Fin 3 → Real × Real), P3381T1TriangleDeterminant v = (triangleMatrix v).det) → + (∀ {I : Type}, ∀ (f : Fin (3 : ℕ) → I), ∀ (g : Fin (3 : ℕ) → I), Function.Injective f + → Function.Injective g → Set.range f = Set.range g → ∀ (v : I → ℝ × ℝ), + P3381T1TriangleDeterminant (v ∘ f) ≠ (0 : ℝ) ↔ P3381T1TriangleDeterminant (v ∘ g) + ≠ (0 : ℝ)) ) := by + classical + intro triangleMatrix triangleMatrix_det I f g hf hg hr v + have hmem (i : Fin 3) : f i ∈ Set.range g := by + rw [← hr] + exact Set.mem_range_self i + let eFun : Fin 3 → Fin 3 := + fun i => Classical.choose (Set.mem_range.mp (hmem i)) + have heq (i : Fin 3) : g (eFun i) = f i := + Classical.choose_spec (Set.mem_range.mp (hmem i)) + have heinj : Function.Injective eFun := by + intro i j hij + apply hf + calc + f i = g (eFun i) := (heq i).symm + _ = g (eFun j) := by rw [hij] + _ = f j := heq j + have hes : Function.Surjective eFun := Finite.surjective_of_injective heinj + let σ : Equiv.Perm (Fin 3) := Equiv.ofBijective eFun ⟨heinj, hes⟩ + have hcomp : v ∘ f = (v ∘ g) ∘ σ := by + funext i + change v (f i) = v (g (eFun i)) + exact congrArg v (heq i).symm + have hdet : P3381T1TriangleDeterminant (v ∘ f) = + (Equiv.Perm.sign σ : ℤˣ) * + P3381T1TriangleDeterminant (v ∘ g) := by + calc + _ = (triangleMatrix (v ∘ f)).det := triangleMatrix_det _ + _ = (triangleMatrix ((v ∘ g) ∘ σ)).det := by rw [hcomp] + _ = ((triangleMatrix (v ∘ g)).submatrix σ id).det := by congr 1 + _ = (Equiv.Perm.sign σ : ℤˣ) * (triangleMatrix (v ∘ g)).det := by + simpa using (Matrix.det_permute σ (triangleMatrix (v ∘ g))) + _ = _ := by rw [← triangleMatrix_det] + have hsign : (Equiv.Perm.sign σ : Real) ≠ 0 := by + have hz : (Equiv.Perm.sign σ : ℤ) ≠ 0 := + (Equiv.Perm.sign σ).ne_zero + exact_mod_cast hz + rw [hdet] + constructor + · intro h + exact (mul_ne_zero_iff_left hsign).mp h + · intro h + exact mul_ne_zero hsign h + +private theorem hfaces0 : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + c.faces 0 = Finset.univ.image (fun k : Fin t.count => Finset.univ.image (s.start ∘ t.face + k)) ) := by + classical + intro r n q p s X K t c + simp [c, P3523T1InsertionConstruction] + +private theorem initialDet : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ + {I : Type}, ∀ (f : Fin 3 → I), ∀ (g : Fin 3 → I), (Function.Injective f) → + ((Function.Injective g) → ((Set.range f = Set.range g) → (∀ (v : I → Real × Real), + P3381T1TriangleDeterminant (v ∘ f) ≠ 0 ↔ P3381T1TriangleDeterminant (v ∘ g) ≠ + 0)))) → ( + let c := P3523T1InsertionConstruction s t + (c.faces 0 = Finset.univ.image (fun k : Fin t.count => Finset.univ.image (s.start ∘ + t.face k))) → (∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (old : Fin (r + (3 : ℕ)) → ℝ × + ℝ), (∀ (i : Fin (r + (3 : ℕ))), v (s.start i) = old i) → (∀ (k : Fin t.count), + P3381T1TriangleDeterminant (old ∘ t.face k) ≠ (0 : ℝ)) → ∀ F ∈ c.faces (0 : ℕ), ∀ + (g : Fin (3 : ℕ) → Fin (n + (3 : ℕ))), Function.Injective g → Set.range g = (↑F : Set + (Fin (n + (3 : ℕ)))) → P3381T1TriangleDeterminant (v ∘ g) ≠ (0 : ℝ))) ) := by + classical + intro r n q p s X K t det_range_transport c hfaces0 v old hstart hcert F hF g hg hgrange + rw [hfaces0] at hF + rcases Finset.mem_image.mp hF with ⟨k, -, hF⟩ + have hrange : + ((Finset.univ.image (s.start ∘ t.face k) : Finset (Fin (n + 3))) : + Set (Fin (n + 3))) = Set.range (s.start ∘ t.face k) := by + ext x + simp [Function.comp_apply] + have hcanonical : Set.range (s.start ∘ t.face k) = (F : Set _) := by + rw [← hrange, ← hF] + have hcanonicalInj : Function.Injective (s.start ∘ t.face k) := + s.start_injective.comp (t.face_injective k) + have htransport := det_range_transport g (s.start ∘ t.face k) + hg hcanonicalInj (hgrange.trans hcanonical.symm) v + have hvalues : v ∘ (s.start ∘ t.face k) = old ∘ t.face k := by + funext i + simp only [Function.comp_apply] + rw [hstart] + exact htransport.mpr (by rw [hvalues]; exact hcert k) + +private theorem existsThird : + (by + classical + exact + ∀ {I : Type}, ∀ [DecidableEq I], ∀ {F : Finset I}, F.card = (3 : ℕ) → ∀ {a : I}, ∀ + {b : I}, a ∈ F → b ∈ F → a ≠ b → ∃ (z : I), a ≠ z ∧ b ≠ z ∧ F = {a, b, z} ) := by + classical + intro I typeclassInstance0 F hcard a b ha hb hab + obtain ⟨x, y, z, hxy, hxz, hyz, hF⟩ := Finset.card_eq_three.mp hcard + subst F + simp only [Finset.mem_insert, Finset.mem_singleton] at ha hb + rcases ha with hax | hay | haz + · subst a + rcases hb with hbx | hby | hbz + · exact (hab hbx.symm).elim + · subst b + exact ⟨z, hxz, hyz, by ext w; simp⟩ + · subst b + exact ⟨y, hxy, hyz.symm, + by ext w; simp [or_comm]⟩ + · subst a + rcases hb with hbx | hby | hbz + · subst b + exact ⟨z, hyz, hxz, by ext w; simp [or_left_comm]⟩ + · exact (hab hby.symm).elim + · subst b + exact ⟨x, hxy.symm, hxz.symm, + by ext w; simp [or_left_comm, or_comm]⟩ + · subst a + rcases hb with hbx | hby | hbz + · subst b + exact ⟨y, hyz.symm, hxy, + by ext w; simp [or_left_comm, or_comm]⟩ + · subst b + exact ⟨x, hxz.symm, hxy.symm, + by ext w; simp [or_left_comm, or_comm]⟩ + · exact (hab hbz.symm).elim + +private theorem hstartSource : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (i : Fin (r + + (3 : ℕ))), p.vertex (s.start i) = q.vertex i ) := by + classical + intro r n q p s i + simpa [s.edge_start, s.parameter_start] using s.vertex_formula (s.start i) + +private theorem sourceInterp : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ (h + : ℕ), ∀ (hh : h < (P3523T1InsertionConstruction s t).steps.length), + let e := (P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩; e.1 ≠ e.2.2 ∧ e.1 ∈ + (P3523T1InsertionConstruction s t).vertices h ∧ e.2.2 ∈ + (P3523T1InsertionConstruction s t).vertices h ∧ e.2.1 ∉ + (P3523T1InsertionConstruction s t).vertices h ∧ {e.1, e.2.2} ∈ + (P3523T1InsertionConstruction s t).boundary h ∧ ∃ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : + ℝ) ∧ p.vertex e.2.1 = ((1 : ℝ) - u) • p.vertex e.1 + u • p.vertex e.2.2 ∧ + P3523T1InterpolatedTarget s t e.2.1 = ((1 : ℝ) - u) • P3523T1InterpolatedTarget s + t e.1 + u • P3523T1InterpolatedTarget s t e.2.2) → ( + let c := P3523T1InsertionConstruction s t + ∀ h, ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∃ u : Real, 0 < u ∧ u < 1 ∧ + p.vertex e.2.1 = (1-u) • p.vertex e.1 + u • p.vertex e.2.2) ) := by + classical + intro r n q p s X K t hstep c h hh + rcases hstep h hh with ⟨_, _, _, _, _, ⟨u, hu0, hu1, hsource, _⟩⟩ + exact ⟨u, hu0, hu1, hsource⟩ + +private theorem targetInterp : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ (h + : ℕ), ∀ (hh : h < (P3523T1InsertionConstruction s t).steps.length), + let e := (P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩; e.1 ≠ e.2.2 ∧ e.1 ∈ + (P3523T1InsertionConstruction s t).vertices h ∧ e.2.2 ∈ + (P3523T1InsertionConstruction s t).vertices h ∧ e.2.1 ∉ + (P3523T1InsertionConstruction s t).vertices h ∧ {e.1, e.2.2} ∈ + (P3523T1InsertionConstruction s t).boundary h ∧ ∃ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : + ℝ) ∧ p.vertex e.2.1 = ((1 : ℝ) - u) • p.vertex e.1 + u • p.vertex e.2.2 ∧ + P3523T1InterpolatedTarget s t e.2.1 = ((1 : ℝ) - u) • P3523T1InterpolatedTarget s + t e.1 + u • P3523T1InterpolatedTarget s t e.2.2) → ( + let c := P3523T1InsertionConstruction s t + ∀ h, ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∃ u : Real, 0 < u ∧ u < 1 ∧ + P3523T1InterpolatedTarget s t e.2.1 = + (1-u) • P3523T1InterpolatedTarget s t e.1 + + u • P3523T1InterpolatedTarget s t e.2.2) ) := by + classical + intro r n q p s X K t hstep c h hh + rcases hstep h hh with ⟨_, _, _, _, _, ⟨u, hu0, hu1, _, htarget⟩⟩ + exact ⟨u, hu0, hu1, htarget⟩ + +private theorem tripleInj : + (by + classical + exact + ∀ {I : Type}, ∀ {a : I}, ∀ {b : I}, ∀ {z : I}, a ≠ b → a ≠ z → b ≠ z → Function.Injective + ![a, b, z] ) := by + classical + intro I a b z hab haz hbz i j hij + fin_cases i + · fin_cases j + · rfl + · exact (hab (by simpa using hij)).elim + · exact (haz (by simpa using hij)).elim + · fin_cases j + · exact (hab (by simpa using hij.symm)).elim + · rfl + · exact (hbz (by simpa using hij)).elim + · fin_cases j + · exact (haz (by simpa using hij.symm)).elim + · exact (hbz (by simpa using hij.symm)).elim + · rfl + +private theorem tripleRange : + (by + classical + exact + ∀ {I : Type}, ∀ [DecidableEq I], ∀ (a : I), ∀ (b : I), ∀ (z : I), Set.range ![a, + b, z] = (↑({a, b, z} : Finset _) : Set I) ) := by + classical + intro I typeclassInstance0 a b z + ext x + simp [or_left_comm, or_comm] + +private theorem splitFinsets : + (by + classical + exact + ∀ (n : Nat), ∀ (a : Fin (n + (3 : ℕ))), ∀ (d : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : + ℕ))), ∀ (z : Fin (n + (3 : ℕ))), a ≠ b → a ≠ z → b ≠ z → insert d (({a, b, z} : + Finset (Fin (n + 3))).erase b) + = {a, d, z} ∧ insert d (({a, b, z} : Finset (Fin (n + 3))).erase a) = {d, b, z} ) := by + classical + intro n a d b z hab haz hbz + constructor + · ext x + simp only [Finset.mem_insert, Finset.mem_erase, Finset.mem_singleton] + constructor + · rintro (hd | ⟨hnb, ha | hb | hz⟩) + · exact Or.inr (Or.inl hd) + · exact Or.inl ha + · exact (hnb hb).elim + · exact Or.inr (Or.inr hz) + · rintro (ha | hd | hz) + · exact Or.inr ⟨fun h => hab (ha.symm.trans h), Or.inl ha⟩ + · exact Or.inl hd + · exact Or.inr ⟨fun h => hbz (h.symm.trans hz), Or.inr (Or.inr hz)⟩ + · ext x + simp only [Finset.mem_insert, Finset.mem_erase, Finset.mem_singleton] + constructor + · rintro (hd | ⟨hna, ha | hb | hz⟩) + · exact Or.inl hd + · exact (hna ha).elim + · exact Or.inr (Or.inl hb) + · exact Or.inr (Or.inr hz) + · rintro (hd | hb | hz) + · exact Or.inl hd + · exact Or.inr ⟨fun h => hab (h.symm.trans hb), Or.inr (Or.inl hb)⟩ + · exact Or.inr ⟨fun h => haz (h.symm.trans hz), Or.inr (Or.inr hz)⟩ + +private theorem mapTriple : + (by + classical + exact + ∀ {I : Type}, ∀ {J : Type}, ∀ (v : I → J), ∀ (a : I), ∀ (b : I), ∀ (z : I), v ∘ ![a, b, + z] = ![v a, v b, v z] ) := by + classical + intro I J v a b z + funext i + fin_cases i <;> rfl + +private theorem detState : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ + {I : Type}, ∀ [DecidableEq I], ∀ (fs : Finset (Finset I)), ∀ (a : I), ∀ (d : I), ∀ (b + : I), ∀ (G : Finset I), G ∈ P3523T1BoundaryFaceSplit fs a d b ↔ ∃ F ∈ fs, if a ∈ F + ∧ b ∈ F then G = insert d (F.erase b) ∨ G = insert d (F.erase a) else G = F) → ((∀ + {I : Type}, ∀ (f : Fin 3 → I), ∀ (g : Fin 3 → I), (Function.Injective f) → + ((Function.Injective g) → ((Set.range f = Set.range g) → (∀ (v : I → Real × Real), + P3381T1TriangleDeterminant (v ∘ f) ≠ 0 ↔ P3381T1TriangleDeterminant (v ∘ g) ≠ + 0)))) → ((∀ h ≤ (P3523T1InsertionConstruction s t).steps.length, ∀ F ∈ + (P3523T1InsertionConstruction s t).faces h, F.card = (3 : ℕ) ∧ F ⊆ + (P3523T1InsertionConstruction s t).vertices h) → ((∀ (h : ℕ), ∀ (hh : h < + (P3523T1InsertionConstruction s t).steps.length), + let e := (P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩; e.1 ≠ e.2.2 ∧ e.1 ∈ + (P3523T1InsertionConstruction s t).vertices h ∧ e.2.2 ∈ + (P3523T1InsertionConstruction s t).vertices h ∧ e.2.1 ∉ + (P3523T1InsertionConstruction s t).vertices h ∧ {e.1, e.2.2} ∈ + (P3523T1InsertionConstruction s t).boundary h ∧ ∃ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : + ℝ) ∧ p.vertex e.2.1 = ((1 : ℝ) - u) • p.vertex e.1 + u • p.vertex e.2.2 ∧ + P3523T1InterpolatedTarget s t e.2.1 = ((1 : ℝ) - u) • P3523T1InterpolatedTarget s + t e.1 + u • P3523T1InterpolatedTarget s t e.2.2) → ( + let c := P3523T1InsertionConstruction s t + (∀ {I : Type}, ∀ [DecidableEq I], ∀ {F : Finset I}, (F.card = 3) → (∀ {a : I}, ∀ {b : I}, + (a ∈ F) → ((b ∈ F) → ((a ≠ b) → (∃ z, a ≠ z ∧ b ≠ z ∧ F = {a, b, z}))))) → ((∀ + {I : Type}, ∀ {a : I}, ∀ {b : I}, ∀ {z : I}, (a ≠ b) → ((a ≠ z) → ((b ≠ z) → + (Function.Injective ![a, b, z])))) → ((∀ {I : Type}, ∀ [DecidableEq I], ∀ (a : I), ∀ + (b : I), ∀ (z : I), Set.range ![a, b, z] = (({a, b, z} : Finset I) : Set I)) → ((∀ + {I : Type}, ∀ {J : Type}, ∀ (v : I → J), ∀ (a : I), ∀ (b : I), ∀ (z : I), v ∘ ![a, b, + z] = ![v a, v b, v z]) → (∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), (∀ (h : ℕ), ∀ (hh : h < + c.steps.length), + let e := c.steps.get ⟨h, hh⟩; + ∃ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : ℝ) ∧ v e.2.1 = ((1 : ℝ) - u) • v e.1 + u • v e.2.2) → + (∀ F ∈ c.faces (0 : ℕ), + ∀ (g : Fin (3 : ℕ) → Fin (n + (3 : ℕ))), Function.Injective g → + Set.range g = (↑F : Set (Fin (n + (3 : ℕ)))) → P3381T1TriangleDeterminant (v ∘ + g) ≠ (0 : ℝ)) → + ∀ h ≤ c.steps.length, + ∀ F ∈ c.faces h, + ∀ (g : Fin (3 : ℕ) → Fin (n + (3 : ℕ))), Function.Injective g → + Set.range g = (↑F : Set (Fin (n + (3 : ℕ)))) → P3381T1TriangleDeterminant (v + ∘ g) ≠ (0 : ℝ))))))))) ) := by + classical + intro r n q p s X K t split_mem det_range_transport hfaceShape hstep c existsThird tripleInj + tripleRange mapTriple v hinterp hinit h + induction h with + | zero => + intro _ F hF g hg hgrange + exact hinit F hF g hg hgrange + | succ h ih => + intro hle F hF g hg hgrange + have hh : h < c.steps.length := by omega + let e := c.steps.get ⟨h, hh⟩ + rcases hstep h hh with ⟨hab, haV, hbV, hdV, _, _⟩ + have hfacesRec : c.faces (h + 1) = + P3523T1BoundaryFaceSplit (c.faces h) e.1 e.2.1 e.2.2 := by + change (c.steps.take (h + 1)).foldl + (fun fs e => P3523T1BoundaryFaceSplit fs e.1 e.2.1 e.2.2) + (Finset.univ.image fun k : Fin t.count => + Finset.univ.image (s.start ∘ t.face k)) = + P3523T1BoundaryFaceSplit + ((c.steps.take h).foldl + (fun fs e => P3523T1BoundaryFaceSplit fs e.1 e.2.1 e.2.2) + (Finset.univ.image fun k : Fin t.count => + Finset.univ.image (s.start ∘ t.face k))) + (c.steps[h].1) (c.steps[h].2.1) (c.steps[h].2.2) + rw [List.take_succ_eq_append_getElem hh] + simp only [List.foldl_append, List.foldl_cons, List.foldl_nil] + rw [hfacesRec] at hF + obtain ⟨F₀, hF₀, hbranch⟩ := + (split_mem (c.faces h) e.1 e.2.1 e.2.2 F).mp hF + by_cases hhit : e.1 ∈ F₀ ∧ e.2.2 ∈ F₀ + · have hchildren : + F = insert e.2.1 (F₀.erase e.2.2) ∨ + F = insert e.2.1 (F₀.erase e.1) := by + simpa [hhit] using hbranch + rcases hchildren with hleft | hright + · have hleFace : h ≤ (P3523T1InsertionConstruction s t).steps.length := by + have : h ≤ c.steps.length := by omega + simpa [c] using this + have hshape := hfaceShape h hleFace F₀ hF₀ + obtain ⟨z, haz, hbz, hF₀eq⟩ := + existsThird hshape.1 hhit.1 hhit.2 hab + have hzV : z ∈ c.vertices h := hshape.2 (by rw [hF₀eq]; simp) + have had : e.1 ≠ e.2.1 := by + intro heq + exact hdV (heq ▸ haV) + have hzd : z ≠ e.2.1 := by + intro heq + exact hdV (heq ▸ hzV) + have hcanInj := tripleInj had haz hzd.symm + have hprev := ih (by omega) F₀ hF₀ ![e.1, e.2.2, z] + (tripleInj hab haz hbz) (by + rw [hF₀eq] + exact tripleRange e.1 e.2.2 z) + have hn : P3381T1TriangleDeterminant ![v e.1, v e.2.2, v z] ≠ 0 := by + rw [mapTriple v e.1 e.2.2 z] at hprev + exact hprev + obtain ⟨u, hu0, hu1, hvalue⟩ := hinterp h hh + have hsplit := P3523T1SplitDeterminants + (v e.1) (v e.2.2) (v z) u ⟨hu0, hu1⟩ hn + have hfinLeft : insert e.2.1 (F₀.erase e.2.2) = + ({e.1, e.2.1, z} : Finset (Fin (n + 3))) := by + rw [hF₀eq] + ext x + simp only [Finset.mem_insert, Finset.mem_singleton, Finset.mem_erase] + constructor + · rintro (hxd | ⟨hxb, hxa | hxb' | hxz⟩) + · exact Or.inr (Or.inl hxd) + · exact Or.inl hxa + · exact (hxb hxb').elim + · exact Or.inr (Or.inr hxz) + · rintro (hxa | hxd | hxz) + · exact Or.inr ⟨fun h => hab (hxa.symm.trans h), Or.inl hxa⟩ + · exact Or.inl hxd + · exact Or.inr ⟨fun h => hbz (h.symm.trans hxz), Or.inr (Or.inr hxz)⟩ + have hrangeLeft : Set.range ![e.1, e.2.1, z] = + (F : Set _) := by + rw [tripleRange, hleft, ← hfinLeft] + have hcanonicalLeft : + P3381T1TriangleDeterminant ![v e.1, v e.2.1, v z] ≠ 0 := by + simpa only [e, ← hvalue] using hsplit.2.2.1 + have htransport := det_range_transport g ![e.1, e.2.1, z] + hg hcanInj (hgrange.trans hrangeLeft.symm) v + exact htransport.mpr (by + rw [mapTriple v e.1 e.2.1 z] + exact hcanonicalLeft) + · have hleFace : h ≤ (P3523T1InsertionConstruction s t).steps.length := by + have : h ≤ c.steps.length := by omega + simpa [c] using this + have hshape := hfaceShape h hleFace F₀ hF₀ + obtain ⟨z, haz, hbz, hF₀eq⟩ := + existsThird hshape.1 hhit.1 hhit.2 hab + have hzV : z ∈ c.vertices h := hshape.2 (by rw [hF₀eq]; simp) + have hbd : e.2.2 ≠ e.2.1 := by + intro heq + exact hdV (heq.symm ▸ hbV) + have hzd : z ≠ e.2.1 := by + intro heq + exact hdV (heq ▸ hzV) + have hprev := ih (by omega) F₀ hF₀ ![e.1, e.2.2, z] + (tripleInj hab haz hbz) (by rw [hF₀eq]; exact tripleRange _ _ _) + have hn : P3381T1TriangleDeterminant ![v e.1, v e.2.2, v z] ≠ 0 := by + rw [mapTriple v e.1 e.2.2 z] at hprev + exact hprev + obtain ⟨u, hu0, hu1, hvalue⟩ := hinterp h hh + have hsplit := P3523T1SplitDeterminants + (v e.1) (v e.2.2) (v z) u ⟨hu0, hu1⟩ hn + have hfinRight : insert e.2.1 (F₀.erase e.1) = + ({e.2.1, e.2.2, z} : Finset (Fin (n + 3))) := by + rw [hF₀eq] + ext x + simp only [Finset.mem_insert, Finset.mem_singleton, Finset.mem_erase] + constructor + · rintro (hxd | ⟨hxa, hxa' | hxb | hxz⟩) + · exact Or.inl hxd + · exact (hxa hxa').elim + · exact Or.inr (Or.inl hxb) + · exact Or.inr (Or.inr hxz) + · rintro (hxd | hxb | hxz) + · exact Or.inl hxd + · exact Or.inr ⟨fun h => hab (h.symm.trans hxb), Or.inr (Or.inl hxb)⟩ + · exact Or.inr ⟨fun h => haz (h.symm.trans hxz), Or.inr (Or.inr hxz)⟩ + have hrangeRight : Set.range ![e.2.1, e.2.2, z] = + (F : Set _) := by + rw [tripleRange, hright, ← hfinRight] + have hcanRightInj := tripleInj hbd.symm hzd.symm hbz + have hcanonicalRight : + P3381T1TriangleDeterminant ![v e.2.1, v e.2.2, v z] ≠ 0 := by + have hvalue' : v e.2.1 = (1-u) • v e.1 + u • v e.2.2 := by + simpa [e] using hvalue + have htemp := hsplit.2.2.2 + change P3381T1TriangleDeterminant + ![(1-u) • v e.1 + u • v e.2.2, v e.2.2, v z] ≠ 0 at htemp + rw [← hvalue'] at htemp + exact htemp + have htransport := det_range_transport g ![e.2.1, e.2.2, z] + hg hcanRightInj (hgrange.trans hrangeRight.symm) v + exact htransport.mpr (by + rw [mapTriple v e.2.1 e.2.2 z] + exact hcanonicalRight) + · have hunchanged : F = F₀ := by simpa [hhit] using hbranch + subst F + exact ih (by omega) F₀ hF₀ g hg hgrange + +private theorem terminalFace : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + ((Set.range fun (k : Fin ((P3523T1InsertionConstruction s t).faces + (P3523T1InsertionConstruction s t).steps.length).card) => Set.range + (P3523T1FaceEnumeration ((P3523T1InsertionConstruction s t).faces + (P3523T1InsertionConstruction s t).steps.length) k)) = {J : Set (Fin (n + (3 : ℕ))) + | ∃ F ∈ (P3523T1InsertionConstruction s t).faces (P3523T1InsertionConstruction s + t).steps.length, (↑F : Set (Fin (n + (3 : ℕ)))) = J}) → ( + let c := P3523T1InsertionConstruction s t + let f := P3523T1FaceEnumeration (c.faces c.steps.length) + ∀ (k : Fin (c.faces c.steps.length).card), ∃ F ∈ c.faces c.steps.length, Set.range (f k) + = (↑F : Set (Fin (n + (3 : ℕ))))) ) := by + classical + intro r n q p s X K t hfaceRange c f k + have hk : Set.range (f k) ∈ Set.range (fun j => Set.range (f j)) := + Set.mem_range_self k + rw [hfaceRange] at hk + rcases hk with ⟨F, hF, hEq⟩ + exact ⟨F, by simpa [c] using hF, hEq.symm⟩ + +private theorem hsourceDet : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ (k + : Fin ((P3523T1InsertionConstruction s t).faces (P3523T1InsertionConstruction s + t).steps.length).card), Function.Injective (P3523T1FaceEnumeration + ((P3523T1InsertionConstruction s t).faces (P3523T1InsertionConstruction s + t).steps.length) k)) → ( + let c := P3523T1InsertionConstruction s t + (∀ h ≤ c.steps.length, ∀ F ∈ c.faces h, ∀ (g : Fin (3 : ℕ) → Fin (n + (3 : ℕ))), + Function.Injective g → Set.range g = (↑F : Set (Fin (n + (3 : ℕ)))) → + P3381T1TriangleDeterminant (p.vertex ∘ g) ≠ (0 : ℝ)) → ( + let f := P3523T1FaceEnumeration (c.faces c.steps.length) + (∀ (k : Fin (c.faces c.steps.length).card), ∃ F ∈ c.faces c.steps.length, Set.range (f k) + = (F : Set _)) → (∀ k : Fin (c.faces c.steps.length).card, + P3381T1TriangleDeterminant (p.vertex ∘ f k) ≠ 0))) ) := by + classical + intro r n q p s X K t hfaceInj c sourceState f terminalFace k + obtain ⟨F, hF, hrange⟩ := terminalFace k + exact sourceState c.steps.length le_rfl F hF (f k) (hfaceInj k) hrange + +private theorem htargetDet : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ (k + : Fin ((P3523T1InsertionConstruction s t).faces (P3523T1InsertionConstruction s + t).steps.length).card), Function.Injective (P3523T1FaceEnumeration + ((P3523T1InsertionConstruction s t).faces (P3523T1InsertionConstruction s + t).steps.length) k)) → ( + let c := P3523T1InsertionConstruction s t + (∀ h ≤ c.steps.length, ∀ F ∈ c.faces h, ∀ (g : Fin (3 : ℕ) → Fin (n + (3 : ℕ))), + Function.Injective g → Set.range g = (↑F : Set (Fin (n + (3 : ℕ)))) → + P3381T1TriangleDeterminant (P3523T1InterpolatedTarget s t ∘ g) ≠ (0 : ℝ)) → ( + let f := P3523T1FaceEnumeration (c.faces c.steps.length) + (∀ (k : Fin (c.faces c.steps.length).card), ∃ F ∈ c.faces c.steps.length, Set.range (f k) + = (F : Set _)) → (∀ k : Fin (c.faces c.steps.length).card, + P3381T1TriangleDeterminant (P3523T1InterpolatedTarget s t ∘ f k) ≠ 0))) ) := by + classical + intro r n q p s X K t hfaceInj c targetState f terminalFace k + obtain ⟨F, hF, hrange⟩ := terminalFace k + exact targetState c.steps.length le_rfl F hF (f k) (hfaceInj k) hrange + +private theorem imageUnion : + (by + classical + exact + ∀ {α : Type}, ∀ {β : Type}, ∀ {γ : Type}, ∀ [inst : DecidableEq β], ∀ + (s₀ : Finset α), ∀ (g₀ : α → β), ∀ (P : β → Set γ), ⋃ y ∈ (↑(Finset.image g₀ s₀) : + Set β), P y = ⋃ x ∈ (↑s₀ : Set α), P (g₀ x) ) := by + classical + intro α β γ typeclassInstance1 s₀ g₀ P + ext z + simp only [Set.mem_iUnion, Finset.mem_coe, Finset.mem_image] + constructor + · rintro ⟨y, ⟨a, ha, rfl⟩, hz⟩ + exact ⟨a, ha, hz⟩ + · rintro ⟨a, ha, hz⟩ + exact ⟨g₀ a, ⟨a, ha, rfl⟩, hz⟩ + +private theorem imageTriple : + (by + classical + exact + ∀ (n : Nat), ∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + + (3 : ℕ))), ∀ (z : Fin (n + (3 : ℕ))), v '' (↑({a, b, z} : Finset _) : Set (Fin (n + + (3 : ℕ)))) = + {v a, v b, v z} ) := by + classical + intro n v a b z + ext x + simp [] + +private theorem imagePair : + (by + classical + exact + ∀ (n : Nat), ∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (a : Fin (n + (3 : ℕ))), ∀ (z : Fin (n + + (3 : ℕ))), v '' (↑({a, z} : Finset _) : Set (Fin (n + (3 : ℕ)))) = {v a, v z} ) := by + classical + intro n v a z + ext x + simp [] + +private theorem splitHull : + (by + classical + exact + ∀ (n : Nat), (∀ (v : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (z : Fin (n + 3)), v '' (({a, b, z} : Finset (Fin (n + 3))) : Set (Fin (n + + 3))) = {v a, v b, v z}) → (∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (a : Fin (n + (3 : + ℕ))), ∀ (d : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (z : Fin (n + (3 : + ℕ))), a ≠ b → a ≠ z → b ≠ z → ∀ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : ℝ) → v d = ((1 : ℝ) - + u) • v a + u • v b → P3381T1TriangleDeterminant ![v a, v b, v z] ≠ (0 : ℝ) → + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, b, z} : Finset _) : Set (Fin + (n + (3 : + ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : + Set (Fin (n + + (3 : ℕ))))) ∪ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset + _) : Set (Fin + (n + (3 : ℕ)))))) ) := by + classical + intro n imageTriple v a d b z hab haz hbz u hu hvalue hdet + have hgeo := P3523T1TwoTriangleSplit (v a) (v b) (v z) u hu hdet + have hleft := imageTriple v a d z + have hright := imageTriple v d b z + have hold := imageTriple v a b z + rw [hold, hleft, hright] + simpa [hvalue] using hgeo.1 + +private theorem splitGeometry : + (by + classical + exact + ∀ (n : Nat), (∀ (v : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (z : Fin (n + 3)), v '' (({a, b, z} : Finset (Fin (n + 3))) : Set (Fin (n + + 3))) = {v a, v b, v z}) → (∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (a : Fin (n + (3 : + ℕ))), ∀ (d : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (z : Fin (n + (3 : + ℕ))), a ≠ b → a ≠ z → b ≠ z → ∀ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : ℝ) → v d = ((1 : ℝ) - + u) • v a + u • v b → P3381T1TriangleDeterminant ![v a, v b, v z] ≠ (0 : ℝ) → + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, b, z} : Finset _) : Set (Fin + (n + (3 : + ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : + Set (Fin (n + + (3 : ℕ))))) ∪ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset + _) : Set (Fin + (n + (3 : ℕ))))) ∧ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, d, z} : + Finset _) : Set + (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} + : Finset _) + : Set (Fin (n + (3 : ℕ))))) = segment ℝ (v d) (v z) ∧ ∀ J ⊆ {v a, v b, v z}, ¬(v a ∈ + J ∧ v b ∈ J) → (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset + _) : Set + (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = (convexHull ℝ + : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (J ∩ {v a, v z}) ∧ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ + × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : + Set (ℝ × ℝ) → + Set (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (J ∩ {v b, v z})) ) := by + classical + intro n imageTriple v a d b z hab haz hbz u hu hvalue hdet + have hgeo := P3523T1TwoTriangleSplit (v a) (v b) (v z) u hu hdet + have hleft := imageTriple v a d z + have hright := imageTriple v d b z + have hold := imageTriple v a b z + constructor + · rw [hold, hleft, hright] + simpa [hvalue] using hgeo.1 + constructor + · rw [hleft, hright] + simpa [hvalue] using hgeo.2.1 + · intro J hJ hnot + rcases hgeo.2.2 J hJ hnot with ⟨hl, hr⟩ + constructor + · rw [hleft] + simpa [hvalue] using hl + · rw [hright] + simpa [hvalue] using hr + +private theorem sourceStartImage : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ (i + : Fin (r + 3)), p.vertex (s.start i) = q.vertex i) → (∀ (k : Fin t.count), p.vertex + '' (↑(Finset.image (s.start ∘ t.face k) Finset.univ) : Set (Fin (n + (3 : ℕ)))) = + Set.range (q.vertex ∘ t.face k)) ) := by + classical + intro r n q p s X K t hstartSource k + ext x + simp [Function.comp_apply, hstartSource] + +private theorem targetStartImage : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ (i + : Fin (r + (3 : ℕ))), P3523T1InterpolatedTarget s t (s.start i) = t.target i) → (∀ + (k : Fin t.count), P3523T1InterpolatedTarget s t '' (↑(Finset.image (s.start ∘ + t.face k) Finset.univ) : Set (Fin (n + (3 : ℕ)))) = Set.range (t.target ∘ t.face k)) + ) := by + classical + intro r n q p s X K t hstartTarget k + ext x + simp [Function.comp_apply, hstartTarget] + +private theorem startFaceSet : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (k + : Fin t.count), (↑(Finset.image (s.start ∘ t.face k) Finset.univ) : Set (Fin (n + (3 + : ℕ)))) = s.start '' Set.range (t.face k) ) := by + classical + intro r n q p s X K t k + ext x + simp [Function.comp_apply] + +private theorem sourceStartCommon : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ (i + : Fin (r + 3)), p.vertex (s.start i) = q.vertex i) → ((∀ (k : Fin t.count), + ((Finset.univ.image (s.start ∘ t.face k) : Finset (Fin (n + 3))) : Set (Fin (n + 3))) + = s.start '' Set.range (t.face k)) → (∀ (i : Fin t.count), ∀ (j : Fin t.count), + p.vertex '' ((↑(Finset.image (s.start ∘ t.face i) Finset.univ) : Set (Fin (n + (3 : + ℕ)))) ∩ (↑(Finset.image (s.start ∘ t.face j) Finset.univ) : Set (Fin (n + (3 : ℕ))))) + = q.vertex '' (Set.range (t.face i) ∩ Set.range (t.face j)))) ) := by + classical + intro r n q p s X K t hstartSource startFaceSet i j + rw [startFaceSet i, startFaceSet j, ← Set.image_inter s.start_injective] + rw [Set.image_image] + ext x + simp [hstartSource] + +private theorem targetStartCommon : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ (i + : Fin (r + (3 : ℕ))), P3523T1InterpolatedTarget s t (s.start i) = t.target i) → ((∀ + (k : Fin t.count), ((Finset.univ.image (s.start ∘ t.face k) : Finset (Fin (n + 3))) : + Set (Fin (n + 3))) = s.start '' Set.range (t.face k)) → (∀ (i : Fin t.count), ∀ (j : + Fin t.count), P3523T1InterpolatedTarget s t '' ((↑(Finset.image (s.start ∘ t.face + i) Finset.univ) : Set (Fin (n + (3 : ℕ)))) ∩ (↑(Finset.image (s.start ∘ t.face j) + Finset.univ) : Set (Fin (n + (3 : ℕ))))) = t.target '' (Set.range (t.face i) ∩ + Set.range (t.face j)))) ) := by + classical + intro r n q p s X K t hstartTarget startFaceSet i j + rw [startFaceSet i, startFaceSet j, ← Set.image_inter s.start_injective] + rw [Set.image_image] + ext x + simp [hstartTarget] + +private theorem sourceBase : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (c.faces 0 = Finset.univ.image (fun k : Fin t.count => Finset.univ.image (s.start ∘ + t.face k))) → ( + let faceUnion (v : Fin (n + 3) → Real × Real) + (faces : Finset (Finset (Fin (n + 3)))) : Set (Real × Real) := + ⋃ F ∈ (faces : Set (Finset (Fin (n + 3)))), + convexHull Real (v '' (F : Set (Fin (n + 3)))) + (∀ {α : Type}, ∀ {β : Type}, ∀ {γ : Type}, ∀ [DecidableEq α], ∀ [DecidableEq β], ∀ (s₀ : + Finset α), ∀ (g₀ : α → β), ∀ (P : β → Set γ), (⋃ y ∈ (s₀.image g₀ : Set β), P y) = ⋃ + x ∈ (s₀ : Set α), P (g₀ x)) → ((∀ (k : Fin t.count), p.vertex '' ((Finset.univ.image + (s.start ∘ t.face k) : Finset (Fin (n + 3))) : Set (Fin (n + 3))) = Set.range + (q.vertex ∘ t.face k)) → (faceUnion p.vertex (c.faces 0) = X))) ) := by + classical + intro r n q p s X K t c hfaces0 faceUnion imageUnion sourceStartImage + rw [hfaces0] + dsimp only [faceUnion] + rw [imageUnion] + simp_rw [sourceStartImage] + simpa using t.source_cover.symm + +private theorem targetBase : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (c.faces 0 = Finset.univ.image (fun k : Fin t.count => Finset.univ.image (s.start ∘ + t.face k))) → ( + let faceUnion (v : Fin (n + 3) → Real × Real) + (faces : Finset (Finset (Fin (n + 3)))) : Set (Real × Real) := + ⋃ F ∈ (faces : Set (Finset (Fin (n + 3)))), + convexHull Real (v '' (F : Set (Fin (n + 3)))) + (∀ {α : Type}, ∀ {β : Type}, ∀ {γ : Type}, ∀ [DecidableEq α], ∀ [DecidableEq β], ∀ (s₀ : + Finset α), ∀ (g₀ : α → β), ∀ (P : β → Set γ), (⋃ y ∈ (s₀.image g₀ : Set β), P y) = ⋃ + x ∈ (s₀ : Set α), P (g₀ x)) → ((∀ (k : Fin t.count), (P3523T1InterpolatedTarget s + t) '' ((Finset.univ.image (s.start ∘ t.face k) : Finset (Fin (n + 3))) : Set (Fin (n + + 3))) = Set.range (t.target ∘ t.face k)) → (faceUnion (P3523T1InterpolatedTarget s + t) (c.faces 0) = K))) ) := by + classical + intro r n q p s X K t c hfaces0 faceUnion imageUnion targetStartImage + rw [hfaces0] + dsimp only [faceUnion] + rw [imageUnion] + simp_rw [targetStartImage] + simpa using t.target_cover.symm + +private theorem hfacesRecAt698 : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + c.faces (h + 1) = P3523T1BoundaryFaceSplit (c.faces h) e.1 e.2.1 e.2.2 ) := by + classical + intro r n q p s X K t c h hh e + change (c.steps.take (h + 1)).foldl + (fun fs e => P3523T1BoundaryFaceSplit fs e.1 e.2.1 e.2.2) + (Finset.univ.image fun k : Fin t.count => + Finset.univ.image (s.start ∘ t.face k)) = + P3523T1BoundaryFaceSplit + ((c.steps.take h).foldl + (fun fs e => P3523T1BoundaryFaceSplit fs e.1 e.2.1 e.2.2) + (Finset.univ.image fun k : Fin t.count => + Finset.univ.image (s.start ∘ t.face k))) + (c.steps[h].1) (c.steps[h].2.1) (c.steps[h].2.2) + rw [List.take_succ_eq_append_getElem hh] + simp only [List.foldl_append, List.foldl_cons, List.foldl_nil] + +private theorem hchildrenAt721 : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∀ (G : Finset (Fin (n + (3 : ℕ)))), ∀ (F : Finset (Fin (n + (3 : ℕ)))), (if e.1 ∈ F ∧ + e.2.2 ∈ F then G = insert e.2.1 (F.erase e.2.2) ∨ G = insert e.2.1 (F.erase e.1) else + G = F) → ((e.1 ∈ F ∧ e.2.2 ∈ F) → (G = insert e.2.1 (F.erase e.2.2) ∨ G = insert + e.2.1 (F.erase e.1))) ) := by + classical + intro r n q p s X K t c h hh e G F hbranch hhit + simpa [hhit] using hbranch + +private theorem hleftFaceAt728 : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).1 ≠ + ((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.2) → (∀ (F : Finset (Fin + (n + (3 : ℕ)))), ∀ (z : Fin (n + (3 : ℕ))), (e.2.2 ≠ z) → ((F = {e.1, e.2.2, z}) → + (insert e.2.1 (F.erase e.2.2) = ({e.1, e.2.1, z} : Finset (Fin (n + 3)))))) ) := by + classical + intro r n q p s X K t c h hh e hab F z hbz hFeq + rw [hFeq] + ext y + simp only [Finset.mem_insert, Finset.mem_erase, + Finset.mem_singleton] + constructor + · rintro (hd | ⟨hne, ha | hb | hz⟩) + · exact Or.inr (Or.inl hd) + · exact Or.inl ha + · exact (hne hb).elim + · exact Or.inr (Or.inr hz) + · rintro (ha | hd | hz) + · exact Or.inr ⟨fun h => hab (ha.symm.trans h), Or.inl ha⟩ + · exact Or.inl hd + · exact Or.inr ⟨fun h => hbz (h.symm.trans hz), Or.inr (Or.inr hz)⟩ + +private theorem hrightFaceAt744 : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).1 ≠ + ((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.2) → (∀ (F : Finset (Fin + (n + (3 : ℕ)))), ∀ (z : Fin (n + (3 : ℕ))), (e.1 ≠ z) → ((F = {e.1, e.2.2, z}) → + (insert e.2.1 (F.erase e.1) = ({e.2.1, e.2.2, z} : Finset (Fin (n + 3)))))) ) := by + classical + intro r n q p s X K t c h hh e hab F z haz hFeq + rw [hFeq] + ext y + simp only [Finset.mem_insert, Finset.mem_erase, + Finset.mem_singleton] + constructor + · rintro (hd | ⟨hne, ha | hb | hz⟩) + · exact Or.inl hd + · exact (hne ha).elim + · exact Or.inr (Or.inl hb) + · exact Or.inr (Or.inr hz) + · rintro (hd | hb | hz) + · exact Or.inl hd + · exact Or.inr ⟨fun h => hab (h.symm.trans hb), Or.inr (Or.inl hb)⟩ + · exact Or.inr ⟨fun h => haz (h.symm.trans hz), Or.inr (Or.inr hz)⟩ + +private theorem hdet'At762 : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (∀ {I : Type}, ∀ {J : Type}, ∀ (v : I → J), ∀ (a : I), ∀ (b : I), ∀ (z : I), v ∘ ![a, b, + z] = ![v a, v b, v z]) → (∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (h : ℕ), ∀ (hh : h < + c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∀ (z : Fin (n + (3 : ℕ))), (P3381T1TriangleDeterminant (v ∘ ![e.1, e.2.2, z]) ≠ (0 : + ℝ)) → (P3381T1TriangleDeterminant ![v e.1, v e.2.2, v z] ≠ 0)) ) := by + classical + intro r n q p s X K t c mapTriple v h hh e z hdet + rw [mapTriple v e.1 e.2.2 z] at hdet + exact hdet + +private theorem hxParent : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∀ (x : ℝ × ℝ), ∀ (G : Finset (Fin (n + (3 : ℕ)))), (x ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set + (ℝ × ℝ)) (v '' (↑G : Set (Fin (n + (3 : ℕ)))))) → (∀ (F : Finset (Fin (n + (3 : + ℕ)))), (G = insert e.2.1 (F.erase e.2.2) ∨ G = insert e.2.1 (F.erase e.1)) → (∀ (z : + Fin (n + (3 : ℕ))), (F = {e.1, e.2.2, z}) → ((insert e.2.1 (F.erase e.2.2) = ({e.1, + e.2.1, z} : Finset (Fin (n + 3)))) → ((insert e.2.1 (F.erase e.1) = ({e.2.1, e.2.2, + z} : Finset (Fin (n + 3)))) → (((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' + (↑({e.1, e.2.2, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × + ℝ) → Set (ℝ + × ℝ)) (v '' (↑({e.1, e.2.1, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∪ (convexHull + ℝ : Set (ℝ × + ℝ) → Set (ℝ × ℝ)) (v '' (↑({e.2.1, e.2.2, z} : Finset _) : Set (Fin (n + (3 : ℕ)))))) + → (x ∈ + convexHull Real (v '' (F : Set _)))))))) ) := by + classical + intro r n q p s X K t c v h hh e x G hxG F hchildren z hFeq hleftFace hrightFace hgeo + rcases hchildren with hleft | hright + · rw [hleft, hleftFace] at hxG + have : x ∈ convexHull Real (v '' + (({e.1, e.2.1, z} : Finset (Fin (n + 3))) : Set _)) := hxG + have hgeo' := hgeo + rw [← hFeq] at hgeo' + rw [hgeo'] + exact Or.inl this + · rw [hright, hrightFace] at hxG + have : x ∈ convexHull Real (v '' + (({e.2.1, e.2.2, z} : Finset (Fin (n + 3))) : Set _)) := hxG + have hgeo' := hgeo + rw [← hFeq] at hgeo' + rw [hgeo'] + exact Or.inr this + +private theorem hxoldAt785 : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (F : Finset (Fin (n + (3 : ℕ)))), + let faceUnion (v : Fin (n + 3) → Real × Real) + (faces : Finset (Finset (Fin (n + 3)))) : Set (Real × Real) := + ⋃ F ∈ (faces : Set (Finset (Fin (n + 3)))), + convexHull Real (v '' (F : Set (Fin (n + 3)))) + ∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (h : ℕ), ∀ (x : ℝ × ℝ), (F ∈ c.faces h) → ((x ∈ + convexHull Real (v '' (F : Set _))) → (x ∈ faceUnion v (c.faces h))) ) := by + classical + intro r n q p s X K t c F faceUnion v h x hF hxParent + simp only [faceUnion, Set.mem_iUnion, Finset.mem_coe] + exact ⟨F, hF, hxParent⟩ + +private theorem hxoldAt793 : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (F : Finset (Fin (n + (3 : ℕ)))), + let faceUnion (v : Fin (n + 3) → Real × Real) + (faces : Finset (Finset (Fin (n + 3)))) : Set (Real × Real) := + ⋃ F ∈ (faces : Set (Finset (Fin (n + 3)))), + convexHull Real (v '' (F : Set (Fin (n + 3)))) + ∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (h : ℕ), ∀ (x : ℝ × ℝ), (F ∈ c.faces h) → ((x ∈ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑F : Set (Fin (n + (3 : ℕ)))))) → + (x ∈ faceUnion v (c.faces h))) ) := by + classical + intro r n q p s X K t c F faceUnion v h x hF hxG + simp only [faceUnion, Set.mem_iUnion, Finset.mem_coe] + exact ⟨F, hF, hxG⟩ + +private theorem hchildrenAt804 : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ + {I : Type}, ∀ [DecidableEq I], ∀ (fs : Finset (Finset I)), ∀ (a : I), ∀ (d : I), ∀ (b + : I), ∀ (G : Finset I), G ∈ P3523T1BoundaryFaceSplit fs a d b ↔ ∃ F ∈ fs, if a ∈ F + ∧ b ∈ F then G = insert d (F.erase b) ∨ G = insert d (F.erase a) else G = F) → ( + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∀ (F : Finset (Fin (n + (3 : ℕ)))), (F ∈ c.faces h) → ((e.1 ∈ F ∧ e.2.2 ∈ F) → (insert + e.2.1 (F.erase e.2.2) ∈ P3523T1BoundaryFaceSplit (c.faces h) e.1 e.2.1 e.2.2 ∧ + insert e.2.1 (F.erase e.1) ∈ P3523T1BoundaryFaceSplit (c.faces h) e.1 e.2.1 + e.2.2))) ) := by + classical + intro r n q p s X K t split_mem c h hh e F hF hhit + apply And.intro <;> + apply (split_mem (c.faces h) e.1 e.2.1 e.2.2 _).mpr + · exact ⟨F, hF, by simp [hhit]⟩ + · exact ⟨F, hF, by simp [hhit]⟩ + +private theorem hleftFaceAt816 : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).1 ≠ + ((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.2) → (∀ (F : Finset (Fin + (n + (3 : ℕ)))), ∀ (z : Fin (n + (3 : ℕ))), (e.2.2 ≠ z) → ((F = {e.1, e.2.2, z}) → + (insert e.2.1 (F.erase e.2.2) = ({e.1, e.2.1, z} : Finset (Fin (n + 3)))))) ) := by + classical + intro r n q p s X K t c h hh e hab F z hbz hFeq + rw [hFeq] + ext y + simp only [Finset.mem_insert, Finset.mem_erase, + Finset.mem_singleton] + constructor + · rintro (hd | ⟨hne, ha | hb | hz⟩) + · exact Or.inr (Or.inl hd) + · exact Or.inl ha + · exact (hne hb).elim + · exact Or.inr (Or.inr hz) + · rintro (ha | hd | hz) + · exact Or.inr ⟨fun h => hab (ha.symm.trans h), Or.inl ha⟩ + · exact Or.inl hd + · exact Or.inr ⟨fun h => hbz (h.symm.trans hz), Or.inr (Or.inr hz)⟩ + +private theorem hrightFaceAt832 : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).1 ≠ + ((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.2) → (∀ (F : Finset (Fin + (n + (3 : ℕ)))), ∀ (z : Fin (n + (3 : ℕ))), (e.1 ≠ z) → ((F = {e.1, e.2.2, z}) → + (insert e.2.1 (F.erase e.1) = ({e.2.1, e.2.2, z} : Finset (Fin (n + 3)))))) ) := by + classical + intro r n q p s X K t c h hh e hab F z haz hFeq + rw [hFeq] + ext y + simp only [Finset.mem_insert, Finset.mem_erase, + Finset.mem_singleton] + constructor + · rintro (hd | ⟨hne, ha | hb | hz⟩) + · exact Or.inl hd + · exact (hne ha).elim + · exact Or.inr (Or.inl hb) + · exact Or.inr (Or.inr hz) + · rintro (hd | hb | hz) + · exact Or.inl hd + · exact Or.inr ⟨fun h => hab (h.symm.trans hb), Or.inr (Or.inl hb)⟩ + · exact Or.inr ⟨fun h => haz (h.symm.trans hz), Or.inr (Or.inr hz)⟩ + +private theorem hdet'At850 : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (∀ {I : Type}, ∀ {J : Type}, ∀ (v : I → J), ∀ (a : I), ∀ (b : I), ∀ (z : I), v ∘ ![a, b, + z] = ![v a, v b, v z]) → (∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (h : ℕ), ∀ (hh : h < + c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∀ (z : Fin (n + (3 : ℕ))), (P3381T1TriangleDeterminant (v ∘ ![e.1, e.2.2, z]) ≠ (0 : + ℝ)) → (P3381T1TriangleDeterminant ![v e.1, v e.2.2, v z] ≠ 0)) ) := by + classical + intro r n q p s X K t c mapTriple v h hh e z hdet + rw [mapTriple v e.1 e.2.2 z] at hdet + exact hdet + +private theorem hxSplit : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∀ (x : ℝ × ℝ), ∀ (F : Finset (Fin (n + (3 : ℕ)))), (x ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set + (ℝ × ℝ)) (v '' (↑F : Set (Fin (n + (3 : ℕ)))))) → (∀ (z : Fin (n + (3 : ℕ))), (F = + {e.1, e.2.2, z}) → (((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({e.1, e.2.2, + z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × + ℝ)) (v '' + (↑({e.1, e.2.1, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∪ (convexHull ℝ : Set (ℝ × + ℝ) → Set (ℝ + × ℝ)) (v '' (↑({e.2.1, e.2.2, z} : Finset _) : Set (Fin (n + (3 : ℕ)))))) → (x ∈ + convexHull Real + (v '' (({e.1, e.2.1, z} : Finset (Fin (n + 3))) : Set _)) ∪ convexHull Real (v '' + (({e.2.1, e.2.2, z} : Finset (Fin (n + 3))) : Set _))))) ) := by + classical + intro r n q p s X K t c v h hh e x F hxF z hFeq hgeo + have : x ∈ convexHull Real (v '' (F : Set _)) := hxF + have hgeo' := hgeo + rw [← hFeq] at hgeo' + rw [hgeo'] at this + exact this + +private theorem hunchangedAt874 : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ + {I : Type}, ∀ [DecidableEq I], ∀ (fs : Finset (Finset I)), ∀ (a : I), ∀ (d : I), ∀ (b + : I), ∀ (G : Finset I), G ∈ P3523T1BoundaryFaceSplit fs a d b ↔ ∃ F ∈ fs, if a ∈ F + ∧ b ∈ F then G = insert d (F.erase b) ∨ G = insert d (F.erase a) else G = F) → ( + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∀ (F : Finset (Fin (n + (3 : ℕ)))), (F ∈ c.faces h) → ((¬(e.1 ∈ F ∧ e.2.2 ∈ F)) → (F ∈ + P3523T1BoundaryFaceSplit (c.faces h) e.1 e.2.1 e.2.2))) ) := by + classical + intro r n q p s X K t split_mem c h hh e F hF hhit + apply (split_mem (c.faces h) e.1 e.2.1 e.2.2 F).mpr + exact ⟨F, hF, by simp only [hhit, ite_false]⟩ + +private theorem uniqueEdgeFace : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ h + ≤ (P3523T1InsertionConstruction s t).steps.length, ∀ (a : Fin (n + (3 : ℕ))), ∀ (b + : Fin (n + (3 : ℕ))), a ≠ b → {F ∈ (P3523T1InsertionConstruction s t).faces h | a ∈ + F ∧ b ∈ F}.card = if {a, b} ∈ (P3523T1InsertionConstruction s t).boundary h then (1 + : ℕ) else if ∃ F ∈ (P3523T1InsertionConstruction s t).faces h, a ∈ F ∧ b ∈ F then + (2 : ℕ) else (0 : ℕ)) → ( + let c := P3523T1InsertionConstruction s t + ∀ h ≤ c.steps.length, ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), a ≠ b → {a, + b} ∈ c.boundary h → ∀ (F : Finset (Fin (n + (3 : ℕ)))), ∀ (G : Finset (Fin (n + (3 : + ℕ)))), F ∈ c.faces h → G ∈ c.faces h → a ∈ F → b ∈ F → a ∈ G → b ∈ G → F = G) ) := by + classical + intro r n q p s X K t hincidence c h hle a b hab hboundary F G hF hG haF hbF haG hbG + have hcard := hincidence h hle a b hab + rw [ite_eq_left hboundary] at hcard + let S := (c.faces h).filter fun H => a ∈ H ∧ b ∈ H + have hS : S.card = 1 := by simpa [S] using hcard + obtain ⟨H, hH⟩ := (Finset.card_eq_one.mp hS) + have hFm : F ∈ S := by simp [S, hF, haF, hbF] + have hGm : G ∈ S := by simp [S, hG, haG, hbG] + have hFU : F = H := by simpa [hH] using hFm + have hGU : G = H := by simpa [hH] using hGm + exact hFU.trans hGU.symm + +private theorem retainedLeft : + (by + classical + exact + ∀ (n : Nat), (∀ (v : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (z : Fin (n + + 3)), v '' (({a, z} : Finset (Fin (n + 3))) : Set (Fin (n + 3))) = {v a, v z}) → (∀ (v + : Fin (n + (3 : ℕ)) → ℝ × ℝ), Function.Injective v → ∀ (a : Fin (n + (3 : ℕ))), ∀ (d + : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (z : Fin (n + (3 : ℕ))), a ≠ b → a + ≠ z → b ≠ z → ∀ (F : Finset (Fin (n + (3 : ℕ)))), ∀ (H : Finset (Fin (n + (3 : ℕ)))), + F = {a, b, z} → insert d (F.erase b) = {a, d, z} → d ∉ H → ¬(a ∈ H ∧ b ∈ H) → + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑F : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' ((↑F : Set (Fin (n + (3 : ℕ)))) ∩ + (↑H : Set (Fin (n + (3 : ℕ)))))) → ((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' + (↑({a, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) + (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∪ (convexHull ℝ : Set (ℝ × + ℝ) → Set (ℝ + × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∧ (convexHull ℝ : + Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull + ℝ : Set (ℝ × + ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = + segment ℝ (v d) (v + z) ∧ ∀ J ⊆ {v a, v b, v z}, ¬(v a ∈ J ∧ v b ∈ J) → (convexHull ℝ : Set (ℝ × ℝ) → Set + (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : + Set (ℝ × ℝ) + → Set (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (J ∩ {v a, v z}) ∧ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin + (n + (3 : + ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (J ∩ {v b, v z})) → (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' + (↑(insert d (F.erase b)) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (v '' ((↑(insert d (F.erase b)) : Set (Fin (n + (3 : ℕ)))) ∩ (↑H : Set + (Fin (n + (3 : ℕ))))))) ) := by + classical + intro n imagePair v vinj a d b z hab haz hbz F H hF hleftFace hdH hnot hpair hgeo + let J := v '' ((F : Set _) ∩ (H : Set _)) + have hJsub : J ⊆ {v a, v b, v z} := by + intro y hy + rcases (Set.mem_image v _ _).mp hy with ⟨x, hx, hxy⟩ + subst y + rw [hF] at hx + rcases hx with ⟨hxF, hxH⟩ + change x ∈ ({a, b, z} : Finset (Fin (n + 3))) at hxF + simp only [Finset.mem_insert, Finset.mem_singleton] at hxF + rcases hxF with ha | hb | hz + · simp [ha] + · simp [hb] + · simp [hz] + have hJnot : ¬ (v a ∈ J ∧ v b ∈ J) := by + rintro ⟨⟨x, ⟨hxF, hxH⟩, hxa⟩, ⟨y, ⟨hyF, hyH⟩, hyb⟩⟩ + have hx : x = a := vinj hxa + have hy : y = b := vinj hyb + subst x + subst y + exact hnot ⟨hxH, hyH⟩ + have hleftRet := (hgeo.2.2 J hJsub hJnot).1 + have hleftFace' : insert d (({a, b, z} : Finset (Fin (n + 3))).erase b) = + {a, d, z} := by simpa [hF] using hleftFace + have hlabels : ((F : Set _) ∩ (H : Set _)) ∩ + (({a, z} : Finset (Fin (n + 3))) : Set (Fin (n + 3))) = + (((insert d (F.erase b) : Finset (Fin (n + 3))) : Set _) ∩ + (H : Set _)) := by + ext x + rw [hleftFace, hF] + simp only [Set.mem_inter_iff, Finset.mem_coe, Finset.mem_insert, + Finset.mem_singleton] + constructor + · rintro ⟨⟨_, hxH⟩, hpair⟩ + rcases hpair with hxa | hxz + · exact ⟨Or.inl hxa, hxH⟩ + · exact ⟨Or.inr (Or.inr hxz), hxH⟩ + · rintro ⟨hchild, hxH⟩ + rcases hchild with hxa | hdz + · exact ⟨⟨Or.inl hxa, hxH⟩, Or.inl hxa⟩ + · rcases hdz with hxd | hxz + · have hdinH : d ∈ H := by rw [hxd] at hxH; exact hxH + exact (hdH hdinH).elim + · exact ⟨⟨Or.inr (Or.inr hxz), hxH⟩, + Or.inr hxz⟩ + have hJAC : J ∩ {v a, v z} = + v '' (((F : Set _) ∩ (H : Set _)) ∩ + (({a, z} : Finset (Fin (n + 3))) : Set _)) := by + dsimp [J] + rw [← imagePair, ← Set.image_inter vinj] + have hchildSub : + convexHull Real (v '' ((insert d (F.erase b) : Finset _) : Set _)) ⊆ + convexHull Real (v '' (F : Set _)) := by + rw [hleftFace, hF] + rw [hgeo.1] + exact Set.subset_union_left + have hpairJ : convexHull Real (v '' ((F : Set _) ∩ (H : Set _))) = + convexHull Real J := by rfl + calc + _ = (convexHull Real (v '' ((insert d (F.erase b) : Finset _) : Set _)) ∩ + convexHull Real (v '' (F : Set _))) ∩ + convexHull Real (v '' (H : Set _)) := by + apply Set.ext + intro x + simp only [Set.mem_inter_iff] + constructor + · rintro ⟨hxL, hxH⟩ + exact ⟨⟨hxL, hchildSub hxL⟩, hxH⟩ + · rintro ⟨⟨hxL, _⟩, hxH⟩ + exact ⟨hxL, hxH⟩ + _ = convexHull Real (v '' ((insert d (F.erase b) : Finset _) : Set _)) ∩ + (convexHull Real (v '' ((F : Set _) ∩ (H : Set _))) ) := by + rw [Set.inter_assoc, hpair] + _ = convexHull Real (v '' (({a, d, z} : Finset (Fin (n + 3))) : Set _)) ∩ + convexHull Real J := by rw [hleftFace, hpairJ] + _ = convexHull Real (J ∩ {v a, v z}) := hleftRet + _ = convexHull Real (v '' (((insert d (F.erase b) : Finset _) : Set _) ∩ + (H : Set _))) := by rw [hJAC, hlabels] + +private theorem retainedRight : + (by + classical + exact + ∀ (n : Nat), (∀ (v : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (z : Fin (n + + 3)), v '' (({a, z} : Finset (Fin (n + 3))) : Set (Fin (n + 3))) = {v a, v z}) → (∀ (v + : Fin (n + (3 : ℕ)) → ℝ × ℝ), Function.Injective v → ∀ (a : Fin (n + (3 : ℕ))), ∀ (d + : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (z : Fin (n + (3 : ℕ))), a ≠ b → a + ≠ z → b ≠ z → ∀ (F : Finset (Fin (n + (3 : ℕ)))), ∀ (H : Finset (Fin (n + (3 : ℕ)))), + F = {a, b, z} → insert d (F.erase a) = {d, b, z} → d ∉ H → ¬(a ∈ H ∧ b ∈ H) → + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑F : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' ((↑F : Set (Fin (n + (3 : ℕ)))) ∩ + (↑H : Set (Fin (n + (3 : ℕ)))))) → ((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' + (↑({a, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) + (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∪ (convexHull ℝ : Set (ℝ × + ℝ) → Set (ℝ + × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∧ (convexHull ℝ : + Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull + ℝ : Set (ℝ × + ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = + segment ℝ (v d) (v + z) ∧ ∀ J ⊆ {v a, v b, v z}, ¬(v a ∈ J ∧ v b ∈ J) → (convexHull ℝ : Set (ℝ × ℝ) → Set + (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : + Set (ℝ × ℝ) + → Set (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (J ∩ {v a, v z}) ∧ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin + (n + (3 : + ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (J ∩ {v b, v z})) → (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' + (↑(insert d (F.erase a)) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (v '' ((↑(insert d (F.erase a)) : Set (Fin (n + (3 : ℕ)))) ∩ (↑H : Set + (Fin (n + (3 : ℕ))))))) ) := by + classical + intro n imagePair v vinj a d b z hab haz hbz F H hF hrightFace hdH hnot hpair hgeo + let J := v '' ((F : Set _) ∩ (H : Set _)) + have hJsub : J ⊆ {v a, v b, v z} := by + intro y hy + rcases (Set.mem_image v _ _).mp hy with ⟨x, hx, hxy⟩ + subst y + rw [hF] at hx + rcases hx with ⟨hxF, _⟩ + change x ∈ ({a, b, z} : Finset (Fin (n + 3))) at hxF + simp only [Finset.mem_insert, Finset.mem_singleton] at hxF + rcases hxF with ha | hb | hz + · simp [ha] + · simp [hb] + · simp [hz] + have hJnot : ¬ (v a ∈ J ∧ v b ∈ J) := by + rintro ⟨⟨x, ⟨_, hxH⟩, hxa⟩, ⟨y, ⟨_, hyH⟩, hyb⟩⟩ + have hx : x = a := vinj hxa + have hy : y = b := vinj hyb + subst x + subst y + exact hnot ⟨hxH, hyH⟩ + have hrightRet := (hgeo.2.2 J hJsub hJnot).2 + have hlabels : ((F : Set _) ∩ (H : Set _)) ∩ + (({b, z} : Finset (Fin (n + 3))) : Set (Fin (n + 3))) = + (((insert d (F.erase a) : Finset (Fin (n + 3))) : Set _) ∩ + (H : Set _)) := by + have hrightFace' : insert d (({a, b, z} : Finset (Fin (n + 3))).erase a) = + {d, b, z} := by simpa [hF] using hrightFace + ext x + rw [hrightFace, hF] + simp only [Set.mem_inter_iff, Finset.mem_coe, Finset.mem_insert, + Finset.mem_singleton] + constructor + · rintro ⟨⟨_, hxH⟩, hpair⟩ + rcases hpair with hxb | hxz + · exact ⟨Or.inr (Or.inl hxb), hxH⟩ + · exact ⟨Or.inr (Or.inr hxz), hxH⟩ + · rintro ⟨hchild, hxH⟩ + rcases hchild with hxd | hrem + · have hdinH : d ∈ H := by rw [hxd] at hxH; exact hxH + exact (hdH hdinH).elim + · rcases hrem with hxb | hxz + · exact ⟨⟨Or.inr (Or.inl hxb), hxH⟩, Or.inl hxb⟩ + · exact ⟨⟨Or.inr (Or.inr hxz), hxH⟩, Or.inr hxz⟩ + have hJBC : J ∩ {v b, v z} = + v '' (((F : Set _) ∩ (H : Set _)) ∩ + (({b, z} : Finset (Fin (n + 3))) : Set _)) := by + dsimp [J] + rw [← imagePair, ← Set.image_inter vinj] + have hchildSub : + convexHull Real (v '' ((insert d (F.erase a) : Finset _) : Set _)) ⊆ + convexHull Real (v '' (F : Set _)) := by + rw [hrightFace, hF] + rw [hgeo.1] + exact Set.subset_union_right + have hpairJ : convexHull Real (v '' ((F : Set _) ∩ (H : Set _))) = + convexHull Real J := by rfl + calc + _ = (convexHull Real (v '' ((insert d (F.erase a) : Finset _) : Set _)) ∩ + convexHull Real (v '' (F : Set _))) ∩ + convexHull Real (v '' (H : Set _)) := by + apply Set.ext + intro x + simp only [Set.mem_inter_iff] + constructor + · rintro ⟨hxR, hxH⟩ + exact ⟨⟨hxR, hchildSub hxR⟩, hxH⟩ + · rintro ⟨⟨hxR, _⟩, hxH⟩ + exact ⟨hxR, hxH⟩ + _ = convexHull Real (v '' ((insert d (F.erase a) : Finset _) : Set _)) ∩ + convexHull Real (v '' ((F : Set _) ∩ (H : Set _))) := by + rw [Set.inter_assoc, hpair] + _ = convexHull Real (v '' ((insert d (F.erase a) : Finset _) : Set _)) ∩ + convexHull Real J := by rw [hpairJ] + _ = convexHull Real (J ∩ {v b, v z}) := by + rw [hrightFace] + exact hrightRet + _ = convexHull Real (v '' (((insert d (F.erase a) : Finset _) : Set _) ∩ + (H : Set _))) := by rw [hJBC, hlabels] + +private theorem mixedPair : + (by + classical + exact + ∀ (n : Nat), (∀ (v : Fin (n + 3) → Real × Real), (Function.Injective v) → (∀ (a : Fin (n + + 3)), ∀ (d : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (z : Fin (n + 3)), (a ≠ b) → ((a ≠ + z) → ((b ≠ z) → (∀ (F : Finset (Fin (n + 3))), ∀ (H : Finset (Fin (n + 3))), (F = {a, + b, z}) → ((insert d (F.erase b) = {a, d, z}) → ((d ∉ H) → ((¬ (a ∈ H ∧ b ∈ H)) → + ((convexHull Real (v '' (F : Set _)) ∩ convexHull Real (v '' (H : Set _)) = + convexHull Real (v '' ((F : Set _) ∩ (H : Set _)))) → ((convexHull Real (v '' (({a, + b, z} : Finset (Fin (n + 3))) : Set _)) = convexHull Real (v '' (({a, d, z} : Finset + (Fin (n + 3))) : Set _)) ∪ convexHull Real (v '' (({d, b, z} : Finset (Fin (n + 3))) + : Set _)) ∧ convexHull Real (v '' (({a, d, z} : Finset (Fin (n + 3))) : Set _)) ∩ + convexHull Real (v '' (({d, b, z} : Finset (Fin (n + 3))) : Set _)) = segment Real (v + d) (v z) ∧ (∀ J : Set (Real × Real), J ⊆ {v a, v b, v z} → ¬ (v a ∈ J ∧ v b ∈ J) → + convexHull Real (v '' (({a, d, z} : Finset (Fin (n + 3))) : Set _)) ∩ convexHull Real + J = convexHull Real (J ∩ {v a, v z}) ∧ convexHull Real (v '' (({d, b, z} : Finset + (Fin (n + 3))) : Set _)) ∩ convexHull Real J = convexHull Real (J ∩ {v b, v z}))) → + (convexHull Real (v '' ((insert d (F.erase b) : Finset _) : Set _)) ∩ convexHull Real + (v '' (H : Set _)) = convexHull Real (v '' (((insert d (F.erase b) : Finset _) : Set + _) ∩ (H : Set _)))))))))))))) → ((∀ (v : Fin (n + 3) → Real × Real), + (Function.Injective v) → (∀ (a : Fin (n + 3)), ∀ (d : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (z : Fin (n + 3)), (a ≠ b) → ((a ≠ z) → ((b ≠ z) → (∀ (F : Finset (Fin (n + + 3))), ∀ (H : Finset (Fin (n + 3))), (F = {a, b, z}) → ((insert d (F.erase a) = {d, b, + z}) → ((d ∉ H) → ((¬ (a ∈ H ∧ b ∈ H)) → ((convexHull Real (v '' (F : Set _)) ∩ + convexHull Real (v '' (H : Set _)) = convexHull Real (v '' ((F : Set _) ∩ (H : Set + _)))) → ((convexHull Real (v '' (({a, b, z} : Finset (Fin (n + 3))) : Set _)) = + convexHull Real (v '' (({a, d, z} : Finset (Fin (n + 3))) : Set _)) ∪ convexHull Real + (v '' (({d, b, z} : Finset (Fin (n + 3))) : Set _)) ∧ convexHull Real (v '' (({a, d, + z} : Finset (Fin (n + 3))) : Set _)) ∩ convexHull Real (v '' (({d, b, z} : Finset + (Fin (n + 3))) : Set _)) = segment Real (v d) (v z) ∧ (∀ J : Set (Real × Real), J ⊆ + {v a, v b, v z} → ¬ (v a ∈ J ∧ v b ∈ J) → convexHull Real (v '' (({a, d, z} : Finset + (Fin (n + 3))) : Set _)) ∩ convexHull Real J = convexHull Real (J ∩ {v a, v z}) ∧ + convexHull Real (v '' (({d, b, z} : Finset (Fin (n + 3))) : Set _)) ∩ convexHull Real + J = convexHull Real (J ∩ {v b, v z}))) → (convexHull Real (v '' ((insert d (F.erase + a) : Finset _) : Set _)) ∩ convexHull Real (v '' (H : Set _)) = convexHull Real (v '' + (((insert d (F.erase a) : Finset _) : Set _) ∩ (H : Set _)))))))))))))) → (∀ (v : Fin + (n + (3 : ℕ)) → ℝ × ℝ), Function.Injective v → ∀ (a : Fin (n + (3 : ℕ))), ∀ (d : Fin + (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (z : Fin (n + (3 : ℕ))), a ≠ b → a ≠ z → + b ≠ z → ∀ (F : Finset (Fin (n + (3 : ℕ)))), ∀ (H : Finset (Fin (n + (3 : ℕ)))), F = + {a, b, z} → insert d (F.erase b) = {a, d, z} → insert d (F.erase a) = {d, b, z} → d ∉ + H → ¬(a ∈ H ∧ b ∈ H) → (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑F : Set + (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑H : Set + (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' ((↑F : Set + (Fin (n + (3 : ℕ)))) ∩ (↑H : Set (Fin (n + (3 : ℕ)))))) → ((convexHull ℝ : Set (ℝ × + ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = + (convexHull ℝ : Set + (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∪ + (convexHull ℝ + : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin (n + (3 : + ℕ))))) ∧ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : Set (Fin + (n + (3 : + ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset _) : + Set (Fin (n + + (3 : ℕ))))) = segment ℝ (v d) (v z) ∧ ∀ J ⊆ {v a, v b, v z}, ¬(v a ∈ J ∧ v b ∈ J) → + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : Set (Fin + (n + (3 : + ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (J ∩ {v a, v z}) ∧ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' + (↑({d, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) + J = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (J ∩ {v b, v z})) → (convexHull ℝ : + Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑(insert d (F.erase b)) : Set (Fin (n + (3 : ℕ))))) + ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' ((↑(insert d (F.erase b)) : Set (Fin + (n + (3 : ℕ)))) ∩ (↑H : Set (Fin (n + (3 : ℕ)))))) ∧ (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (v '' (↑(insert d (F.erase a)) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull + ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ + : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' ((↑(insert d (F.erase a)) : Set (Fin (n + (3 : + ℕ)))) ∩ (↑H : Set (Fin (n + (3 : ℕ)))))) ∧ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' (↑H : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v + '' (↑(insert d (F.erase b)) : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) + → Set (ℝ × ℝ)) (v '' ((↑H : Set (Fin (n + (3 : ℕ)))) ∩ (↑(insert d (F.erase b)) : Set + (Fin (n + (3 : ℕ)))))) ∧ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑H : Set + (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑(insert d + (F.erase a)) : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' ((↑H : Set (Fin (n + (3 : ℕ)))) ∩ (↑(insert d (F.erase a)) : Set (Fin (n + (3 : + ℕ)))))))) ) := by + classical + intro n retainedLeft retainedRight v vinj a d b z hab haz hbz F H hF hleftFace hrightFace hdH + hnot hpair hgeo + have hleft := retainedLeft v vinj a d b z hab haz hbz F H hF + hleftFace hdH hnot hpair hgeo + have hright := retainedRight v vinj a d b z hab haz hbz F H hF + hrightFace hdH hnot hpair hgeo + refine ⟨hleft, hright, ?_, ?_⟩ + · calc + _ = convexHull Real (v '' ((insert d (F.erase b) : Finset _) : Set _)) ∩ + convexHull Real (v '' (H : Set _)) := Set.inter_comm _ _ + _ = convexHull Real (v '' (((insert d (F.erase b) : Finset _) : Set _) ∩ + (H : Set _))) := hleft + _ = convexHull Real (v '' ((H : Set _) ∩ + ((insert d (F.erase b) : Finset _) : Set _))) := by rw [Set.inter_comm] + · calc + _ = convexHull Real (v '' ((insert d (F.erase a) : Finset _) : Set _)) ∩ + convexHull Real (v '' (H : Set _)) := Set.inter_comm _ _ + _ = convexHull Real (v '' (((insert d (F.erase a) : Finset _) : Set _) ∩ + (H : Set _))) := hright + _ = convexHull Real (v '' ((H : Set _) ∩ + ((insert d (F.erase a) : Finset _) : Set _))) := by rw [Set.inter_comm] + +private theorem hfacesRecAt1185 : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + c.faces (h + 1) = P3523T1BoundaryFaceSplit (c.faces h) e.1 e.2.1 e.2.2 ) := by + classical + intro r n q p s X K t c h hh e + change (c.steps.take (h + 1)).foldl + (fun fs e => P3523T1BoundaryFaceSplit fs e.1 e.2.1 e.2.2) + (Finset.univ.image fun k : Fin t.count => + Finset.univ.image (s.start ∘ t.face k)) = + P3523T1BoundaryFaceSplit + ((c.steps.take h).foldl + (fun fs e => P3523T1BoundaryFaceSplit fs e.1 e.2.1 e.2.2) + (Finset.univ.image fun k : Fin t.count => + Finset.univ.image (s.start ∘ t.face k))) + (c.steps[h].1) (c.steps[h].2.1) (c.steps[h].2.2) + rw [List.take_succ_eq_append_getElem hh] + simp only [List.foldl_append, List.foldl_cons, List.foldl_nil] + +private theorem splitFacts : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ h + ≤ (P3523T1InsertionConstruction s t).steps.length, ∀ F ∈ + (P3523T1InsertionConstruction s t).faces h, F.card = (3 : ℕ) ∧ F ⊆ + (P3523T1InsertionConstruction s t).vertices h) → ( + let c := P3523T1InsertionConstruction s t + (∀ {I : Type}, ∀ [DecidableEq I], ∀ {F : Finset I}, (F.card = 3) → (∀ {a : I}, ∀ {b : I}, + (a ∈ F) → ((b ∈ F) → ((a ≠ b) → (∃ z, a ≠ z ∧ b ≠ z ∧ F = {a, b, z}))))) → ((∀ + {I : Type}, ∀ {a : I}, ∀ {b : I}, ∀ {z : I}, (a ≠ b) → ((a ≠ z) → ((b ≠ z) → + (Function.Injective ![a, b, z])))) → ((∀ {I : Type}, ∀ [DecidableEq I], ∀ (a : I), ∀ + (b : I), ∀ (z : I), Set.range ![a, b, z] = (({a, b, z} : Finset I) : Set I)) → ((∀ (a + : Fin (n + 3)), ∀ (d : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (z : Fin (n + 3)), (a ≠ + b) → ((a ≠ z) → ((b ≠ z) → (insert d (({a, b, z} : Finset (Fin (n + 3))).erase b) = + {a, d, z} ∧ insert d (({a, b, z} : Finset (Fin (n + 3))).erase a) = {d, b, z})))) → + ((∀ {I : Type}, ∀ {J : Type}, ∀ (v : I → J), ∀ (a : I), ∀ (b : I), ∀ (z : I), v ∘ + ![a, b, z] = ![v a, v b, v z]) → ((∀ (v : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + + 3)), ∀ (d : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (z : Fin (n + 3)), (a ≠ b) → ((a ≠ + z) → ((b ≠ z) → (∀ (u : Real), (0 < u ∧ u < 1) → ((v d = (1-u) • v a + u • v b) → + ((P3381T1TriangleDeterminant ![v a, v b, v z] ≠ 0) → (convexHull Real (v '' (({a, + b, z} : Finset (Fin (n + 3))) : Set _)) = convexHull Real (v '' (({a, d, z} : Finset + (Fin (n + 3))) : Set _)) ∪ convexHull Real (v '' (({d, b, z} : Finset (Fin (n + 3))) + : Set _)) ∧ convexHull Real (v '' (({a, d, z} : Finset (Fin (n + 3))) : Set _)) ∩ + convexHull Real (v '' (({d, b, z} : Finset (Fin (n + 3))) : Set _)) = segment Real (v + d) (v z) ∧ (∀ J : Set (Real × Real), J ⊆ {v a, v b, v z} → ¬ (v a ∈ J ∧ v b ∈ J) → + convexHull Real (v '' (({a, d, z} : Finset (Fin (n + 3))) : Set _)) ∩ convexHull Real + J = convexHull Real (J ∩ {v a, v z}) ∧ convexHull Real (v '' (({d, b, z} : Finset + (Fin (n + 3))) : Set _)) ∩ convexHull Real J = convexHull Real (J ∩ {v b, + v z}))))))))) → (∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (h : ℕ), ∀ (hh : h < + c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + (∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩; + ∃ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : ℝ) ∧ v e.2.1 = ((1 : ℝ) - u) • v e.1 + u • v e.2.2) → ((∀ + h ≤ c.steps.length, ∀ F ∈ c.faces h, ∀ (g : Fin (3 : ℕ) → Fin (n + (3 : ℕ))), + Function.Injective g → Set.range g = (↑F : Set (Fin (n + (3 : ℕ)))) → + P3381T1TriangleDeterminant (v ∘ g) ≠ (0 : ℝ)) → ((((P3523T1InsertionConstruction s + t).steps.get ⟨h, hh⟩).1 ≠ ((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.2) + → ((h ≤ c.steps.length) → (∀ P ∈ c.faces h, e.1 ∈ P ∧ e.2.2 ∈ P → ∃ (z : Fin (n + (3 : + ℕ))), e.1 ≠ z ∧ e.2.2 ≠ z ∧ P = {e.1, e.2.2, z} ∧ insert e.2.1 (P.erase e.2.2) = {e.1, + e.2.1, z} ∧ insert e.2.1 (P.erase e.1) = {e.2.1, e.2.2, z} ∧ ∃ (u : ℝ), (0 : ℝ) < u ∧ u + < (1 : ℝ) ∧ v e.2.1 = ((1 : ℝ) - u) • v e.1 + u • v e.2.2 ∧ (convexHull ℝ : Set (ℝ × ℝ) + → Set (ℝ × ℝ)) (v '' (↑({e.1, e.2.2, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = + (convexHull ℝ : + Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({e.1, e.2.1, z} : Finset _) : Set (Fin (n + (3 : + ℕ))))) ∪ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({e.2.1, e.2.2, z} : Finset _) : Set + (Fin (n + (3 + : ℕ))))) ∧ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({e.1, e.2.1, z} : Finset + _) : Set + (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({e.2.1, + e.2.2, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = segment ℝ (v e.2.1) (v z) ∧ ∀ J ⊆ + {v e.1, + v e.2.2, v z}, ¬(v e.1 ∈ J ∧ v e.2.2 ∈ J) → (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' (↑({e.1, e.2.1, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set + (ℝ × ℝ) → Set + (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (J ∩ {v e.1, v z}) ∧ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({e.2.1, e.2.2, z} : Finset _) : Set + (Fin (n + (3 + : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (J ∩ {v e.2.2, v z})))))))))))) ) := by + classical + intro r n q p s X K t hfaceShape c existsThird tripleInj tripleRange splitFinsets mapTriple + splitGeometry v h hh e hinterp hnondeg hab hleFace P hP hhit + have hshape := hfaceShape h (by simpa [c] using hleFace) P hP + obtain ⟨z, haz, hbz, hPeq⟩ := + existsThird hshape.1 hhit.1 hhit.2 hab + have hfin := splitFinsets e.1 e.2.1 e.2.2 z hab haz hbz + have hdet0 := hnondeg h hleFace P hP ![e.1, e.2.2, z] + (tripleInj hab haz hbz) (by rw [hPeq]; exact tripleRange _ _ _) + have hdet : P3381T1TriangleDeterminant + ![v e.1, v e.2.2, v z] ≠ 0 := by + rw [mapTriple v e.1 e.2.2 z] at hdet0 + exact hdet0 + obtain ⟨u, hu0, hu1, hvalue⟩ := hinterp h hh + have hgeo := splitGeometry v e.1 e.2.1 e.2.2 z hab haz hbz u + ⟨hu0, hu1⟩ hvalue hdet + exact ⟨z, haz, hbz, hPeq, by rw [hPeq]; exact hfin.1, + by rw [hPeq]; exact hfin.2, u, hu0, hu1, hvalue, hgeo⟩ + +private theorem hda : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.1 ∉ + (P3523T1InsertionConstruction s t).vertices h) → ((e.1 ∈ c.vertices h) → (e.2.1 ≠ + e.1)) ) := by + classical + intro r n q p s X K t c h hh e hdV haV0 heq + exact hdV (heq ▸ haV0) + +private theorem hdb : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.1 ∉ + (P3523T1InsertionConstruction s t).vertices h) → ((e.2.2 ∈ c.vertices h) → (e.2.1 ≠ + e.2.2)) ) := by + classical + intro r n q p s X K t c h hh e hdV hbV0 heq + exact hdV (heq ▸ hbV0) + +private theorem hdz : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.1 ∉ + (P3523T1InsertionConstruction s t).vertices h) → (∀ (z : Fin (n + (3 : ℕ))), (z ∈ + c.vertices h) → (e.2.1 ≠ z)) ) := by + classical + intro r n q p s X K t c h hh e hdV z hzV0 heq + exact hdV (heq ▸ hzV0) + +private theorem siblingsPair : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).1 ≠ + ((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.2) → (∀ (z : Fin (n + (3 : + ℕ))), (e.2.2 ≠ z) → (∀ (u : ℝ), (v e.2.1 = ((1 : ℝ) - u) • v e.1 + u • v e.2.2) → + (((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({e.1, e.2.2, z} : Finset _) : + Set (Fin (n + + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({e.1, e.2.1, z} : + Finset _) : + Set (Fin (n + (3 : ℕ))))) ∪ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' + (↑({e.2.1, e.2.2, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∧ (convexHull ℝ : Set (ℝ + × ℝ) → Set + (ℝ × ℝ)) (v '' (↑({e.1, e.2.1, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ + × ℝ) → Set (ℝ × ℝ)) (v '' (↑({e.2.1, e.2.2, z} : Finset _) : Set (Fin (n + (3 : + ℕ))))) = segment ℝ + (v e.2.1) (v z) ∧ ∀ J ⊆ {v e.1, v e.2.2, v z}, ¬(v e.1 ∈ J ∧ v e.2.2 ∈ J) → + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({e.1, e.2.1, z} : Finset _) : Set + (Fin (n + (3 + : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) + → Set (ℝ × ℝ)) (J ∩ {v e.1, v z}) ∧ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' + (↑({e.2.1, e.2.2, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ + × ℝ) → Set + (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (J ∩ {v e.2.2, v z})) → (∀ (L + : Finset (Fin (n + (3 : ℕ)))), ∀ (R : Finset (Fin (n + (3 : ℕ)))), L = {e.1, e.2.1, + z} → R = {e.2.1, e.2.2, z} → (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑L : + Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑R : + Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' ((↑L : + Set (Fin (n + (3 : ℕ)))) ∩ (↑R : Set (Fin (n + (3 : ℕ)))))))))) ) := by + classical + intro r n q p s X K t c v h hh e hab z hbz u hvalue hgeo L R hL hR + have hcommon : (L : Set _) ∩ (R : Set _) = + ({e.2.1, z} : Set (Fin (n + 3))) := by + rw [hL, hR] + ext x + simp only [Set.mem_inter_iff, Finset.mem_coe, + Finset.mem_insert, Finset.mem_singleton] + constructor + · rintro ⟨hl, hr⟩ + rcases hl with ha | hrest + · rcases hr with hd | hrest' + · exact Or.inl hd + · rcases hrest' with hb | hz + · exact (hab (ha.symm.trans hb)).elim + · exact Or.inr hz + · rcases hrest with hd | hz + · exact Or.inl hd + · rcases hr with hd | hrest' + · exact Or.inl hd + · rcases hrest' with hb | hz' + · exact (hbz (hb.symm.trans hz)).elim + · exact Or.inr hz' + · rintro (hd | hz) + · exact ⟨Or.inr (Or.inl hd), Or.inl hd⟩ + · exact ⟨Or.inr (Or.inr hz), Or.inr (Or.inr hz)⟩ + have himage : v '' ({e.2.1, z} : Set (Fin (n + 3))) = + {v e.2.1, v z} := by + ext x + simp [or_comm] + calc + _ = segment Real (v e.2.1) (v z) := by + rw [hL, hR] + simpa [hvalue] using hgeo.2.1 + _ = convexHull Real (v '' ((L : Set _) ∩ (R : Set _))) := by + rw [hcommon, himage] + exact (convexHull_pair (v e.2.1) (v z)).symm + +private theorem hnotGactual : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (G : Finset (Fin (n + (3 : ℕ)))), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∀ (G₀ : Finset (Fin (n + (3 : ℕ)))), (¬(e.1 ∈ G₀ ∧ e.2.2 ∈ G₀)) → ((G = G₀) → (¬ (e.1 ∈ G + ∧ e.2.2 ∈ G))) ) := by + classical + intro r n q p s X K t c h G hh e G₀ hnotG hGsame hit + exact hnotG ⟨hGsame ▸ hit.1, hGsame ▸ hit.2⟩ + +private theorem hdG : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.1 ∉ + (P3523T1InsertionConstruction s t).vertices h) → (∀ (G₀ : Finset (Fin (n + (3 : + ℕ)))), (G₀ ⊆ (P3523T1InsertionConstruction s t).vertices h) → (e.2.1 ∉ G₀)) ) := by + classical + intro r n q p s X K t c h hh e hdV G₀ hG₀subset hd + exact hdV (hG₀subset hd) + +private theorem hdGactual : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (G : Finset (Fin (n + (3 : ℕ)))), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∀ (G₀ : Finset (Fin (n + (3 : ℕ)))), (G = G₀) → ((e.2.1 ∉ G₀) → (e.2.1 ∉ G)) ) := by + classical + intro r n q p s X K t c h G hh e G₀ hGsame hdG hd + exact hdG (hGsame ▸ hd) + +private theorem hnotFactual : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (F : Finset (Fin (n + (3 : ℕ)))), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∀ (F₀ : Finset (Fin (n + (3 : ℕ)))), (¬(e.1 ∈ F₀ ∧ e.2.2 ∈ F₀)) → ((F = F₀) → (¬ (e.1 ∈ F + ∧ e.2.2 ∈ F))) ) := by + classical + intro r n q p s X K t c h F hh e F₀ hnotF hFsame hit + exact hnotF ⟨hFsame ▸ hit.1, hFsame ▸ hit.2⟩ + +private theorem hdF : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.1 ∉ + (P3523T1InsertionConstruction s t).vertices h) → (∀ (F₀ : Finset (Fin (n + (3 : + ℕ)))), (F₀ ⊆ (P3523T1InsertionConstruction s t).vertices h) → (e.2.1 ∉ F₀)) ) := by + classical + intro r n q p s X K t c h hh e hdV F₀ hF₀subset hd + exact hdV (hF₀subset hd) + +private theorem hdFactual : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (F : Finset (Fin (n + (3 : ℕ)))), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∀ (F₀ : Finset (Fin (n + (3 : ℕ)))), (F = F₀) → ((e.2.1 ∉ F₀) → (e.2.1 ∉ F)) ) := by + classical + intro r n q p s X K t c h F hh e F₀ hFsame hdF hd + exact hdF (hFsame ▸ hd) + +private theorem enumUnion : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + ((Set.range fun (k : Fin ((P3523T1InsertionConstruction s t).faces + (P3523T1InsertionConstruction s t).steps.length).card) => Set.range + (P3523T1FaceEnumeration ((P3523T1InsertionConstruction s t).faces + (P3523T1InsertionConstruction s t).steps.length) k)) = {J : Set (Fin (n + (3 : ℕ))) + | ∃ F ∈ (P3523T1InsertionConstruction s t).faces (P3523T1InsertionConstruction s + t).steps.length, (↑F : Set (Fin (n + (3 : ℕ)))) = J}) → ( + let c := P3523T1InsertionConstruction s t + let f := P3523T1FaceEnumeration (c.faces c.steps.length) + let faceUnion (v : Fin (n + 3) → Real × Real) + (faces : Finset (Finset (Fin (n + 3)))) : Set (Real × Real) := + ⋃ F ∈ (faces : Set (Finset (Fin (n + 3)))), + convexHull Real (v '' (F : Set (Fin (n + 3)))) + ∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), faceUnion v (c.faces c.steps.length) = ⋃ (k : Fin + (c.faces c.steps.length).card), (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (Set.range + (v ∘ f k))) ) := by + classical + intro r n q p s X K t hfaceRange c f faceUnion v + have imageRange (k : Fin (c.faces c.steps.length).card) : + v '' Set.range (f k) = Set.range (v ∘ f k) := by + ext x + constructor + · rintro ⟨y, ⟨i, rfl⟩, rfl⟩ + exact ⟨i, rfl⟩ + · rintro ⟨i, hi⟩ + exact ⟨f k i, ⟨i, rfl⟩, hi⟩ + ext x + simp only [faceUnion, Set.mem_iUnion, Finset.mem_coe] + constructor + · rintro ⟨F, hF, hx⟩ + have hFmember : (F : Set (Fin (n + 3))) ∈ + Set.range (fun k : Fin (c.faces c.steps.length).card => Set.range (f k)) := by + rw [hfaceRange] + exact ⟨F, hF, rfl⟩ + rcases hFmember with ⟨k, hk⟩ + refine ⟨k, ?_⟩ + rw [← hk] at hx + simpa [imageRange] using hx + · rintro ⟨k, hx⟩ + have hKmember : Set.range (f k) ∈ + {J : Set (Fin (n + 3)) | + ∃ F ∈ c.faces c.steps.length, (F : Set (Fin (n + 3))) = J} := by + rw [← hfaceRange] + exact Set.mem_range_self k + rcases hKmember with ⟨F, hF, hEq⟩ + refine ⟨F, hF, ?_⟩ + rw [hEq] + simpa [imageRange] using hx + +private theorem hsourceCoverage : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + let f := P3523T1FaceEnumeration (c.faces c.steps.length) + let faceUnion (v : Fin (n + 3) → Real × Real) + (faces : Finset (Finset (Fin (n + 3)))) : Set (Real × Real) := + ⋃ F ∈ (faces : Set (Finset (Fin (n + 3)))), + convexHull Real (v '' (F : Set (Fin (n + 3)))) + (∀ (v : Fin (n + 3) → Real × Real), faceUnion v (c.faces c.steps.length) = ⋃ k, + convexHull Real (Set.range (v ∘ f k))) → ((∀ h ≤ c.steps.length, faceUnion p.vertex + (c.faces h) = X) → (X = ⋃ k, convexHull Real (Set.range (p.vertex ∘ f k)))) ) := by + classical + intro r n q p s X K t c f faceUnion enumUnion hsourceCoverState + calc + X = faceUnion p.vertex (c.faces c.steps.length) := + (hsourceCoverState c.steps.length le_rfl).symm + _ = ⋃ k, convexHull Real (Set.range (p.vertex ∘ f k)) := enumUnion p.vertex + +private theorem htargetCoverage : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + let f := P3523T1FaceEnumeration (c.faces c.steps.length) + let faceUnion (v : Fin (n + 3) → Real × Real) + (faces : Finset (Finset (Fin (n + 3)))) : Set (Real × Real) := + ⋃ F ∈ (faces : Set (Finset (Fin (n + 3)))), + convexHull Real (v '' (F : Set (Fin (n + 3)))) + (∀ (v : Fin (n + 3) → Real × Real), faceUnion v (c.faces c.steps.length) = ⋃ k, + convexHull Real (Set.range (v ∘ f k))) → ((∀ h ≤ c.steps.length, faceUnion + (P3523T1InterpolatedTarget s t) (c.faces h) = K) → (K = ⋃ k, convexHull Real + (Set.range (P3523T1InterpolatedTarget s t ∘ f k)))) ) := by + classical + intro r n q p s X K t c f faceUnion enumUnion htargetCoverState + calc + K = faceUnion (P3523T1InterpolatedTarget s t) (c.faces c.steps.length) := + (htargetCoverState c.steps.length le_rfl).symm + _ = ⋃ k, + convexHull Real (Set.range (P3523T1InterpolatedTarget s t ∘ f k)) := + enumUnion (P3523T1InterpolatedTarget s t) + +private theorem sourceInitialPair : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (c.faces 0 = Finset.univ.image (fun k : Fin t.count => Finset.univ.image (s.start ∘ + t.face k))) → ((∀ (k : Fin t.count), p.vertex '' ((Finset.univ.image (s.start ∘ + t.face k) : Finset (Fin (n + 3))) : Set (Fin (n + 3))) = Set.range (q.vertex ∘ t.face + k)) → ((∀ (i : Fin t.count), ∀ (j : Fin t.count), p.vertex '' (((Finset.univ.image + (s.start ∘ t.face i) : Finset (Fin (n + 3))) : Set _) ∩ ((Finset.univ.image (s.start + ∘ t.face j) : Finset (Fin (n + 3))) : Set _)) = q.vertex '' (Set.range (t.face i) ∩ + Set.range (t.face j))) → (∀ F ∈ c.faces 0, ∀ G ∈ c.faces 0, convexHull Real (p.vertex + '' (F : Set _)) ∩ convexHull Real (p.vertex '' (G : Set _)) = convexHull Real + (p.vertex '' ((F : Set _) ∩ (G : Set _)))))) ) := by + classical + intro r n q p s X K t c hfaces0 sourceStartImage sourceStartCommon F hF G hG + rw [hfaces0] at hF hG + obtain ⟨i, -, hFi⟩ := Finset.mem_image.mp hF + obtain ⟨j, -, hGj⟩ := Finset.mem_image.mp hG + subst F + subst G + rw [sourceStartImage i, sourceStartImage j, sourceStartCommon i j] + exact t.source_intersection i j + +private theorem targetInitialPair : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (c.faces 0 = Finset.univ.image (fun k : Fin t.count => Finset.univ.image (s.start ∘ + t.face k))) → ((∀ (k : Fin t.count), (P3523T1InterpolatedTarget s t) '' + ((Finset.univ.image (s.start ∘ t.face k) : Finset (Fin (n + 3))) : Set (Fin (n + 3))) + = Set.range (t.target ∘ t.face k)) → ((∀ (i : Fin t.count), ∀ (j : Fin t.count), + P3523T1InterpolatedTarget s t '' (((Finset.univ.image (s.start ∘ t.face i) : Finset + (Fin (n + 3))) : Set _) ∩ ((Finset.univ.image (s.start ∘ t.face j) : Finset (Fin (n + + 3))) : Set _)) = t.target '' (Set.range (t.face i) ∩ Set.range (t.face j))) → (∀ F ∈ + c.faces 0, ∀ G ∈ c.faces 0, convexHull Real ((P3523T1InterpolatedTarget s t) '' (F + : Set _)) ∩ convexHull Real ((P3523T1InterpolatedTarget s t) '' (G : Set _)) = + convexHull Real ((P3523T1InterpolatedTarget s t) '' ((F : Set _) ∩ (G : Set _)))))) + ) := by + classical + intro r n q p s X K t c hfaces0 targetStartImage targetStartCommon F hF G hG + rw [hfaces0] at hF hG + obtain ⟨i, -, hFi⟩ := Finset.mem_image.mp hF + obtain ⟨j, -, hGj⟩ := Finset.mem_image.mp hG + subst F + subst G + rw [targetStartImage i, targetStartImage j, targetStartCommon i j] + exact t.target_intersection i j + +private theorem imageRangeAt1467 : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + let f := P3523T1FaceEnumeration (c.faces c.steps.length) + ∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (k : Fin (c.faces c.steps.length).card), v '' + Set.range (f k) = Set.range (v ∘ f k) ) := by + classical + intro r n q p s X K t c f v k + ext x + constructor + · rintro ⟨y, ⟨i, rfl⟩, rfl⟩ + exact ⟨i, rfl⟩ + · rintro ⟨i, hi⟩ + exact ⟨f k i, ⟨i, rfl⟩, hi⟩ + +private theorem hsourcePairs : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + let f := P3523T1FaceEnumeration (c.faces c.steps.length) + (∀ (k : Fin (c.faces c.steps.length).card), ∃ F ∈ c.faces c.steps.length, Set.range (f k) + = (F : Set _)) → ((∀ h ≤ c.steps.length, ∀ F ∈ c.faces h, ∀ G ∈ c.faces h, convexHull + Real (p.vertex '' (F : Set _)) ∩ convexHull Real (p.vertex '' (G : Set _)) = + convexHull Real (p.vertex '' ((F : Set _) ∩ (G : Set _)))) → ((∀ (v : Fin (n + 3) → + Real × Real), ∀ (k : Fin (c.faces c.steps.length).card), v '' Set.range (f k) = + Set.range (v ∘ f k)) → (∀ k l : Fin (c.faces c.steps.length).card, convexHull Real + (Set.range (p.vertex ∘ f k)) ∩ convexHull Real (Set.range (p.vertex ∘ f l)) = + convexHull Real (p.vertex '' (Set.range (f k) ∩ Set.range (f l)))))) ) := by + classical + intro r n q p s X K t c f terminalFace sourcePairState imageRange k l + obtain ⟨F, hF, hFk⟩ := terminalFace k + obtain ⟨G, hG, hGl⟩ := terminalFace l + have hpair := sourcePairState c.steps.length le_rfl F hF G hG + rw [← hFk, ← hGl] at hpair + simpa only [imageRange] using hpair + +private theorem htargetPairs : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + let f := P3523T1FaceEnumeration (c.faces c.steps.length) + (∀ (k : Fin (c.faces c.steps.length).card), ∃ F ∈ c.faces c.steps.length, Set.range (f k) + = (F : Set _)) → ((∀ h ≤ c.steps.length, ∀ F ∈ c.faces h, ∀ G ∈ c.faces h, convexHull + Real ((P3523T1InterpolatedTarget s t) '' (F : Set _)) ∩ convexHull Real + ((P3523T1InterpolatedTarget s t) '' (G : Set _)) = convexHull Real + ((P3523T1InterpolatedTarget s t) '' ((F : Set _) ∩ (G : Set _)))) → ((∀ (v : Fin (n + + 3) → Real × Real), ∀ (k : Fin (c.faces c.steps.length).card), v '' Set.range (f k) + = Set.range (v ∘ f k)) → (∀ k l : Fin (c.faces c.steps.length).card, convexHull Real + (Set.range (P3523T1InterpolatedTarget s t ∘ f k)) ∩ convexHull Real (Set.range + (P3523T1InterpolatedTarget s t ∘ f l)) = convexHull Real + ((P3523T1InterpolatedTarget s t) '' (Set.range (f k) ∩ Set.range (f l)))))) ) := by + classical + intro r n q p s X K t c f terminalFace targetPairState imageRange k l + obtain ⟨F, hF, hFk⟩ := terminalFace k + obtain ⟨G, hG, hGl⟩ := terminalFace l + have hpair := targetPairState c.steps.length le_rfl F hF G hG + rw [← hFk, ← hGl] at hpair + simpa only [imageRange] using hpair + +end FacialInsertionGeometry + +namespace InsertionAssembly + +private theorem coverState : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ + {I : Type}, ∀ [inst : DecidableEq I], ∀ (fs : Finset (Finset I)), ∀ (a : I), ∀ (d : + I), ∀ (b : I), ∀ (G : Finset I), G ∈ P3523T1BoundaryFaceSplit fs a d b ↔ ∃ F ∈ fs, + if a ∈ F ∧ b ∈ F then G = insert d (F.erase b) ∨ G = insert d (F.erase a) else G = F) + → ((∀ h ≤ (P3523T1InsertionConstruction s t).steps.length, ∀ F ∈ + (P3523T1InsertionConstruction s t).faces h, F.card = (3 : ℕ) ∧ F ⊆ + (P3523T1InsertionConstruction s t).vertices h) → ((∀ (h : ℕ), ∀ (hh : h < + (P3523T1InsertionConstruction s t).steps.length), + let e := (P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩; e.1 ≠ e.2.2 ∧ e.1 ∈ + (P3523T1InsertionConstruction s t).vertices h ∧ e.2.2 ∈ + (P3523T1InsertionConstruction s t).vertices h ∧ e.2.1 ∉ + (P3523T1InsertionConstruction s t).vertices h ∧ {e.1, e.2.2} ∈ + (P3523T1InsertionConstruction s t).boundary h ∧ ∃ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : + ℝ) ∧ p.vertex e.2.1 = ((1 : ℝ) - u) • p.vertex e.1 + u • p.vertex e.2.2 ∧ + P3523T1InterpolatedTarget s t e.2.1 = ((1 : ℝ) - u) • P3523T1InterpolatedTarget s + t e.1 + u • P3523T1InterpolatedTarget s t e.2.2) → ( + let c := P3523T1InsertionConstruction s t + (∀ {I : Type}, ∀ [inst : DecidableEq I], ∀ {F : Finset I}, F.card = (3 : ℕ) → ∀ {a : I}, + ∀ {b : I}, a ∈ F → b ∈ F → a ≠ b → ∃ (z : I), a ≠ z ∧ b ≠ z ∧ F = {a, b, z}) → ((∀ + {I : Type}, ∀ {a : I}, ∀ {b : I}, ∀ {z : I}, (a ≠ b) → ((a ≠ z) → ((b ≠ z) → + (Function.Injective ![a, b, z])))) → ((∀ {I : Type}, ∀ [DecidableEq I], ∀ (a : I), ∀ + (b : I), ∀ (z : I), Set.range ![a, b, z] = (({a, b, z} : Finset I) : Set I)) → ((∀ + {I : Type}, ∀ {J : Type}, ∀ (v : I → J), ∀ (a : I), ∀ (b : I), ∀ (z : I), v ∘ ![a, b, + z] = ![v a, v b, v z]) → ( + let faceUnion (v : Fin (n + 3) → Real × Real) + (faces : Finset (Finset (Fin (n + 3)))) : Set (Real × Real) := + ⋃ F ∈ (faces : Set (Finset (Fin (n + 3)))), + convexHull Real (v '' (F : Set (Fin (n + 3)))) + (∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (a : Fin (n + (3 : ℕ))), ∀ (d : Fin (n + (3 : ℕ))), + ∀ (b : Fin (n + (3 : ℕ))), ∀ (z : Fin (n + (3 : ℕ))), a ≠ b → a ≠ z → b ≠ z → ∀ (u : + ℝ), (0 : ℝ) < u ∧ u < (1 : ℝ) → v d = ((1 : ℝ) - u) • v a + u • v b → + P3381T1TriangleDeterminant ![v a, v b, v z] ≠ (0 : ℝ) → (convexHull ℝ : Set (ℝ × ℝ) + → Set (ℝ × ℝ)) (v '' (↑({a, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = + (convexHull ℝ : Set (ℝ + × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∪ + (convexHull ℝ : + Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin (n + (3 : + ℕ)))))) → (∀ (v : + Fin (n + (3 : ℕ)) → ℝ × ℝ), (∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩; + ∃ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : ℝ) ∧ v e.2.1 = ((1 : ℝ) - u) • v e.1 + u • v e.2.2) → + (∀ h ≤ c.steps.length, + ∀ F ∈ c.faces h, + ∀ (g : Fin (3 : ℕ) → Fin (n + (3 : ℕ))), Function.Injective g → + Set.range g = (↑F : Set (Fin (n + (3 : ℕ)))) → P3381T1TriangleDeterminant (v + ∘ g) ≠ (0 : ℝ)) → + ∀ (Y : Set (ℝ × ℝ)), faceUnion v (c.faces (0 : ℕ)) = Y → ∀ h ≤ c.steps.length, + faceUnion v (c.faces h) = Y)))))))) ) := by + classical + intro r n q p s X K t split_mem hfaceShape hstep c existsThird tripleInj tripleRange mapTriple + faceUnion splitHull v hinterp hnondeg Y hbase h + induction h with + | zero => + intro _ + exact hbase + | succ h ih => + intro hle + have hh : h < c.steps.length := by omega + let e := c.steps.get ⟨h, hh⟩ + rcases hstep h hh with ⟨hab, haV, hbV, hdV, _, _⟩ + have hfacesRec : c.faces (h + 1) = + P3523T1BoundaryFaceSplit (c.faces h) e.1 e.2.1 e.2.2 := + FacialInsertionGeometry.hfacesRecAt698 r n q p s X K t h hh + rw [hfacesRec] + have hold : faceUnion v (c.faces h) = Y := ih (by omega) + ext x + simp only [faceUnion, Set.mem_iUnion, Finset.mem_coe] + constructor + · rintro ⟨G, hG, hxG⟩ + obtain ⟨F, hF, hbranch⟩ := + (split_mem (c.faces h) e.1 e.2.1 e.2.2 G).mp hG + by_cases hhit : e.1 ∈ F ∧ e.2.2 ∈ F + · have hchildren : G = insert e.2.1 (F.erase e.2.2) ∨ + G = insert e.2.1 (F.erase e.1) := FacialInsertionGeometry.hchildrenAt721 r n q p + s X K t h hh G F hbranch hhit + have hleFace : h ≤ c.steps.length := by omega + have hshape := hfaceShape h (by simpa [c] using hleFace) F hF + obtain ⟨z, haz, hbz, hFeq⟩ := + existsThird hshape.1 hhit.1 hhit.2 hab + have hleftFace : insert e.2.1 (F.erase e.2.2) = + ({e.1, e.2.1, z} : Finset (Fin (n + 3))) := + FacialInsertionGeometry.hleftFaceAt728 r n q p s X K t h hh hab F z hbz hFeq + have hrightFace : insert e.2.1 (F.erase e.1) = + ({e.2.1, e.2.2, z} : Finset (Fin (n + 3))) := + FacialInsertionGeometry.hrightFaceAt744 r n q p s X K t h hh hab F z haz hFeq + have hdet := hnondeg h hleFace F hF ![e.1, e.2.2, z] + (tripleInj hab haz hbz) (by rw [hFeq]; exact tripleRange _ _ _) + have hdet' := FacialInsertionGeometry.hdet'At762 r n q p s X K t mapTriple v h hh z hdet + obtain ⟨u, hu0, hu1, hvalue⟩ := hinterp h hh + have hgeo := splitHull v e.1 e.2.1 e.2.2 z hab haz hbz u + ⟨hu0, hu1⟩ hvalue hdet' + have hxold : x ∈ faceUnion v (c.faces h) := FacialInsertionGeometry.hxoldAt785 r n q + p s X K t F v h x hF (FacialInsertionGeometry.hxParent r n q p s X K t v h hh x G + hxG F hchildren z hFeq hleftFace hrightFace hgeo) + rw [hold] at hxold + exact hxold + · have hG' : G = F := by + simpa only [hhit, ite_false] using hbranch + subst G + have hxold : x ∈ faceUnion v (c.faces h) := FacialInsertionGeometry.hxoldAt793 r n q + p s X K t F v h x hF hxG + rw [hold] at hxold + exact hxold + · intro hx + have hxold : x ∈ faceUnion v (c.faces h) := by rw [hold]; exact hx + have hx := hxold + simp only [faceUnion, Set.mem_iUnion, Finset.mem_coe] at hx ⊢ + obtain ⟨F, hF, hxF⟩ := hx + by_cases hhit : e.1 ∈ F ∧ e.2.2 ∈ F + · have hchildren : insert e.2.1 (F.erase e.2.2) ∈ + P3523T1BoundaryFaceSplit (c.faces h) e.1 e.2.1 e.2.2 ∧ + insert e.2.1 (F.erase e.1) ∈ + P3523T1BoundaryFaceSplit (c.faces h) e.1 e.2.1 e.2.2 := + FacialInsertionGeometry.hchildrenAt804 r n q p s X K t split_mem h hh F hF + hhit + have hleFace : h ≤ c.steps.length := by omega + have hshape := hfaceShape h (by simpa [c] using hleFace) F hF + obtain ⟨z, haz, hbz, hFeq⟩ := + existsThird hshape.1 hhit.1 hhit.2 hab + have hleftFace : insert e.2.1 (F.erase e.2.2) = + ({e.1, e.2.1, z} : Finset (Fin (n + 3))) := + FacialInsertionGeometry.hleftFaceAt816 r n q p s X K t h hh hab F z hbz hFeq + have hrightFace : insert e.2.1 (F.erase e.1) = + ({e.2.1, e.2.2, z} : Finset (Fin (n + 3))) := + FacialInsertionGeometry.hrightFaceAt832 r n q p s X K t h hh hab F z haz hFeq + have hdet := hnondeg h hleFace F hF ![e.1, e.2.2, z] + (tripleInj hab haz hbz) (by rw [hFeq]; exact tripleRange _ _ _) + have hdet' := FacialInsertionGeometry.hdet'At850 r n q p s X K t mapTriple v h hh z hdet + obtain ⟨u, hu0, hu1, hvalue⟩ := hinterp h hh + have hgeo := splitHull v e.1 e.2.1 e.2.2 z hab haz hbz u + ⟨hu0, hu1⟩ hvalue hdet' + have hxSplit : x ∈ convexHull Real (v '' + (({e.1, e.2.1, z} : Finset (Fin (n + 3))) : Set _)) ∪ + convexHull Real (v '' + (({e.2.1, e.2.2, z} : Finset (Fin (n + 3))) : Set _)) := + FacialInsertionGeometry.hxSplit r n q p s X K t v h hh x F hxF z hFeq hgeo + simp only [Set.mem_union] at hxSplit + rcases hxSplit with hleft | hright + · refine ⟨insert e.2.1 (F.erase e.2.2), hchildren.1, ?_⟩ + rw [hleftFace] + exact hleft + · refine ⟨insert e.2.1 (F.erase e.1), hchildren.2, ?_⟩ + rw [hrightFace] + exact hright + · have hunchanged : F ∈ P3523T1BoundaryFaceSplit + (c.faces h) e.1 e.2.1 e.2.2 := FacialInsertionGeometry.hunchangedAt874 r n q p s + X K t split_mem h hh F hF hhit + exact ⟨F, hunchanged, hxF⟩ + +private theorem pairState : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ + {I : Type}, ∀ [inst : DecidableEq I], ∀ (fs : Finset (Finset I)), ∀ (a : I), ∀ (d : + I), ∀ (b : I), ∀ (G : Finset I), G ∈ P3523T1BoundaryFaceSplit fs a d b ↔ ∃ F ∈ fs, + a ∈ F ∧ b ∈ F ∧ (G = insert d (F.erase b) ∨ G = insert d (F.erase a)) ∨ ¬(a ∈ F ∧ b ∈ + F) ∧ G = F) → ((∀ {I : Type}, ∀ [DecidableEq I], ∀ {fs : Finset (Finset I)}, ∀ + {F : Finset I}, ∀ {G : Finset I}, (F = G) → ((G ∈ fs) → (F ∈ fs))) → ((∀ h ≤ + (P3523T1InsertionConstruction s t).steps.length, ∀ F ∈ + (P3523T1InsertionConstruction s t).faces h, F.card = (3 : ℕ) ∧ F ⊆ + (P3523T1InsertionConstruction s t).vertices h) → ((∀ h ≤ + (P3523T1InsertionConstruction s t).steps.length, ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : + Fin (n + (3 : ℕ))), a ≠ b → {F ∈ (P3523T1InsertionConstruction s t).faces h | a ∈ F + ∧ b ∈ F}.card = if {a, b} ∈ (P3523T1InsertionConstruction s t).boundary h then (1 : + ℕ) else if ∃ F ∈ (P3523T1InsertionConstruction s t).faces h, a ∈ F ∧ b ∈ F then (2 + : ℕ) else (0 : ℕ)) → ((∀ (h : ℕ), ∀ (hh : h < (P3523T1InsertionConstruction s + t).steps.length), + let e := (P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩; e.1 ≠ e.2.2 ∧ e.1 ∈ + (P3523T1InsertionConstruction s t).vertices h ∧ e.2.2 ∈ + (P3523T1InsertionConstruction s t).vertices h ∧ e.2.1 ∉ + (P3523T1InsertionConstruction s t).vertices h ∧ {e.1, e.2.2} ∈ + (P3523T1InsertionConstruction s t).boundary h ∧ ∃ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : + ℝ) ∧ p.vertex e.2.1 = ((1 : ℝ) - u) • p.vertex e.1 + u • p.vertex e.2.2 ∧ + P3523T1InterpolatedTarget s t e.2.1 = ((1 : ℝ) - u) • P3523T1InterpolatedTarget s + t e.1 + u • P3523T1InterpolatedTarget s t e.2.2) → ( + let c := P3523T1InsertionConstruction s t + (∀ {I : Type}, ∀ [inst : DecidableEq I], ∀ {F : Finset I}, F.card = (3 : ℕ) → ∀ {a : I}, + ∀ {b : I}, a ∈ F → b ∈ F → a ≠ b → ∃ (z : I), a ≠ z ∧ b ≠ z ∧ F = {a, b, z}) → ((∀ + {I : Type}, ∀ {a : I}, ∀ {b : I}, ∀ {z : I}, (a ≠ b) → ((a ≠ z) → ((b ≠ z) → + (Function.Injective ![a, b, z])))) → ((∀ {I : Type}, ∀ [DecidableEq I], ∀ (a : I), ∀ + (b : I), ∀ (z : I), Set.range ![a, b, z] = (({a, b, z} : Finset I) : Set I)) → ((∀ + {I : Type}, ∀ {J : Type}, ∀ (v : I → J), ∀ (a : I), ∀ (b : I), ∀ (z : I), v ∘ ![a, b, + z] = ![v a, v b, v z]) → ((∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (a : Fin (n + (3 : + ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (z : Fin (n + (3 : ℕ))), v '' (↑({a, b, z} : + Finset _) : Set + (Fin (n + (3 : ℕ)))) = {v a, v b, v z}) → ((∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), + Function.Injective v → ∀ (a : Fin (n + (3 : ℕ))), ∀ (d : Fin (n + (3 : ℕ))), ∀ (b : + Fin (n + (3 : ℕ))), ∀ (z : Fin (n + (3 : ℕ))), a ≠ b → a ≠ z → b ≠ z → ∀ (F : Finset + (Fin (n + (3 : ℕ)))), ∀ (H : Finset (Fin (n + (3 : ℕ)))), F = {a, b, z} → insert d + (F.erase b) = {a, d, z} → insert d (F.erase a) = {d, b, z} → d ∉ H → ¬(a ∈ H ∧ b ∈ H) + → (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑F : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' ((↑F : Set (Fin (n + (3 : ℕ)))) ∩ + (↑H : Set (Fin (n + (3 : ℕ)))))) → ((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' + (↑({a, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) + (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∪ (convexHull ℝ : Set (ℝ × + ℝ) → Set (ℝ + × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∧ (convexHull ℝ : + Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull + ℝ : Set (ℝ × + ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = + segment ℝ (v d) (v + z) ∧ ∀ J ⊆ {v a, v b, v z}, ¬(v a ∈ J ∧ v b ∈ J) → (convexHull ℝ : Set (ℝ × ℝ) → Set + (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : + Set (ℝ × ℝ) + → Set (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (J ∩ {v a, v z}) ∧ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin + (n + (3 : + ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (J ∩ {v b, v z})) → (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' + (↑(insert d (F.erase b)) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (v '' ((↑(insert d (F.erase b)) : Set (Fin (n + (3 : ℕ)))) ∩ (↑H : Set + (Fin (n + (3 : ℕ)))))) ∧ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑(insert d + (F.erase a)) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v + '' ((↑(insert d (F.erase a)) : Set (Fin (n + (3 : ℕ)))) ∩ (↑H : Set (Fin (n + (3 : + ℕ)))))) ∧ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑H : Set (Fin (n + (3 : + ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑(insert d (F.erase b)) : + Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' ((↑H : + Set (Fin (n + (3 : ℕ)))) ∩ (↑(insert d (F.erase b)) : Set (Fin (n + (3 : ℕ)))))) ∧ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑H : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑(insert d (F.erase a)) : Set (Fin + (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' ((↑H : Set (Fin + (n + (3 : ℕ)))) ∩ (↑(insert d (F.erase a)) : Set (Fin (n + (3 : ℕ))))))) → (∀ (v : + Fin (n + (3 : ℕ)) → ℝ × ℝ), Function.Injective v → + (∀ (h : ℕ), ∀ (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩; + ∃ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : ℝ) ∧ v e.2.1 = ((1 : ℝ) - u) • v e.1 + u • v e.2.2) → + (∀ h ≤ c.steps.length, + ∀ F ∈ c.faces h, + ∀ (g : Fin (3 : ℕ) → Fin (n + (3 : ℕ))), Function.Injective g → + Set.range g = (↑F : Set (Fin (n + (3 : ℕ)))) → P3381T1TriangleDeterminant + (v ∘ g) ≠ (0 : ℝ)) → + (∀ F ∈ c.faces (0 : ℕ), + ∀ G ∈ c.faces (0 : ℕ), + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑F : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑G : Set (Fin (n + (3 : + ℕ))))) = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' ((↑F : Set (Fin (n + (3 : ℕ)))) ∩ (↑G : Set (Fin (n + (3 : ℕ))))))) → + ∀ h ≤ c.steps.length, + ∀ F ∈ c.faces h, + ∀ G ∈ c.faces h, + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑F : Set (Fin (n + (3 : + ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑G : Set (Fin (n + (3 : + ℕ))))) = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' ((↑F : Set (Fin (n + (3 : ℕ)))) ∩ (↑G : Set (Fin (n + (3 : + ℕ))))))))))))))))) ) := by + classical + intro r n q p s X K t split_mem_cases faceMemTransport hfaceShape hincidence hstep c + existsThird tripleInj tripleRange mapTriple imageTriple mixedPair v vinj hinterp hnondeg + hinit h + induction h with + | zero => + intro _ F hF G hG + exact hinit F hF G hG + | succ h ih => + intro hle F hF G hG + have hh : h < c.steps.length := by omega + let e := c.steps.get ⟨h, hh⟩ + rcases hstep h hh with ⟨hab, haV, hbV, hdV, hboundary, _⟩ + have hfacesRec : c.faces (h + 1) = + P3523T1BoundaryFaceSplit (c.faces h) e.1 e.2.1 e.2.2 := + FacialInsertionGeometry.hfacesRecAt1185 r n q p s X K t h hh + rw [hfacesRec] at hF hG + obtain ⟨F₀, hF₀, hbranchF⟩ := + (split_mem_cases (c.faces h) e.1 e.2.1 e.2.2 F).mp hF + obtain ⟨G₀, hG₀, hbranchG⟩ := + (split_mem_cases (c.faces h) e.1 e.2.1 e.2.2 G).mp hG + have hleFace : h ≤ c.steps.length := by omega + have hshapeF₀ := hfaceShape h (by simpa [c] using hleFace) F₀ hF₀ + have hshapeG₀ := hfaceShape h (by simpa [c] using hleFace) G₀ hG₀ + rcases hshapeF₀ with ⟨_, hF₀subset⟩ + rcases hshapeG₀ with ⟨_, hG₀subset⟩ + have splitFacts (P : Finset (Fin (n + 3))) (hP : P ∈ c.faces h) + (hhit : e.1 ∈ P ∧ e.2.2 ∈ P) := FacialInsertionGeometry.splitFacts r n q p s X K t + hfaceShape existsThird tripleInj tripleRange + (FacialInsertionGeometry.splitFinsets n) mapTriple + (FacialInsertionGeometry.splitGeometry n imageTriple) + v h hh hinterp hnondeg hab hleFace P hP hhit + rcases hbranchF with ⟨haF, hbF, hchildrenF⟩ | ⟨hnotF, hFsame⟩ + · have hhitF : e.1 ∈ F₀ ∧ e.2.2 ∈ F₀ := ⟨haF, hbF⟩ + rcases hbranchG with ⟨haG, hbG, hchildrenG⟩ | ⟨hnotG, hGsame⟩ + · have hhitG : e.1 ∈ G₀ ∧ e.2.2 ∈ G₀ := ⟨haG, hbG⟩ + obtain ⟨z, haz, hbz, hFeq, hleftFace, hrightFace, + u, hu0, hu1, hvalue, hgeo⟩ := splitFacts F₀ hF₀ hhitF + have hFG : F₀ = G₀ := (FacialInsertionGeometry.uniqueEdgeFace r n q p s X K t + hincidence) h hleFace + e.1 e.2.2 hab hboundary F₀ G₀ hF₀ hG₀ + hhitF.1 hhitF.2 hhitG.1 hhitG.2 + subst G₀ + have haV0 : e.1 ∈ c.vertices h := hF₀subset haF + have hbV0 : e.2.2 ∈ c.vertices h := hF₀subset hbF + have hzV0 : z ∈ c.vertices h := hF₀subset (by rw [hFeq]; simp) + have hda := FacialInsertionGeometry.hda r n q p s X K t h hh hdV haV0 + have hdb := FacialInsertionGeometry.hdb r n q p s X K t h hh hdV hbV0 + have hdz := FacialInsertionGeometry.hdz r n q p s X K t h hh hdV z hzV0 + have siblingsPair (L R : Finset (Fin (n + 3))) + (hL : L = {e.1, e.2.1, z}) + (hR : R = {e.2.1, e.2.2, z}) := FacialInsertionGeometry.siblingsPair r n q p s X + K t v h hh hab z hbz u hvalue hgeo L R hL hR + rcases hchildrenF with hFL | hFR + · rcases hchildrenG with hGL | hGR + · subst F + subst G + simp only [Set.inter_self] + · subst F + subst G + rw [hleftFace, hrightFace] + exact siblingsPair ({e.1, e.2.1, z}) + ({e.2.1, e.2.2, z}) rfl rfl + · rcases hchildrenG with hGL | hGR + · subst F + subst G + rw [hrightFace, hleftFace] + have hrev := siblingsPair + ({e.1, e.2.1, z}) ({e.2.1, e.2.2, z}) rfl rfl + simpa only [Set.inter_comm] using hrev + · subst F + subst G + simp only [Set.inter_self] + · have hGparent : G ∈ c.faces h := by + exact faceMemTransport hGsame hG₀ + have hparentG := ih hleFace F₀ hF₀ G hGparent + obtain ⟨z, haz, hbz, hFeq, hleftFace, hrightFace, + u, hu0, hu1, hvalue, hgeo⟩ := splitFacts F₀ hF₀ hhitF + have hmixed := mixedPair v vinj e.1 e.2.1 e.2.2 z + hab haz hbz F₀ G hFeq hleftFace hrightFace (FacialInsertionGeometry.hdGactual r n q + p s X K t h G hh G₀ hGsame (FacialInsertionGeometry.hdG r n q p s X K t h hh + hdV G₀ hG₀subset)) (FacialInsertionGeometry.hnotGactual r n q p s X K t h G hh + G₀ hnotG hGsame) + hparentG hgeo + rcases hchildrenF with hFL | hFR + · rw [hFL] + exact hmixed.1 + · rw [hFR] + exact hmixed.2.1 + · rcases hbranchG with ⟨haG, hbG, hchildrenG⟩ | ⟨hnotG, hGsame⟩ + · have hhitG : e.1 ∈ G₀ ∧ e.2.2 ∈ G₀ := ⟨haG, hbG⟩ + have hFparent : F ∈ c.faces h := by + exact faceMemTransport hFsame hF₀ + have hparentF := ih hleFace G₀ hG₀ F hFparent + obtain ⟨z, haz, hbz, hFeq, hleftFace, hrightFace, + u, hu0, hu1, hvalue, hgeo⟩ := splitFacts G₀ hG₀ hhitG + have hmixed := mixedPair v vinj e.1 e.2.1 e.2.2 z + hab haz hbz G₀ F hFeq hleftFace hrightFace (FacialInsertionGeometry.hdFactual r n q + p s X K t h F hh F₀ hFsame (FacialInsertionGeometry.hdF r n q p s X K t h hh + hdV F₀ hF₀subset)) (FacialInsertionGeometry.hnotFactual r n q p s X K t h F hh + F₀ hnotF hFsame) + hparentF hgeo + rcases hchildrenG with hGL | hGR + · rw [hGL] + exact hmixed.2.2.1 + · rw [hGR] + exact hmixed.2.2.2 + · have hFparent : F ∈ c.faces h := by + exact faceMemTransport hFsame hF₀ + have hGparent : G ∈ c.faces h := by + exact faceMemTransport hGsame hG₀ + exact ih hleFace F hFparent G hGparent + +end InsertionAssembly + +theorem P3523T1InsertionGeometry {r n : Nat} + (q : P3381T1PolygonBoundary r) (p : P3381T1PolygonBoundary n) + (s : P3475T1BoundarySubdivision q p) + (X K : Set (Real × Real)) (t : P3475T1TriangleTree q X K) : + let c := P3523T1InsertionConstruction s t + let fs := c.faces c.steps.length + let f := P3523T1FaceEnumeration fs + let Q := P3523T1InterpolatedTarget s t + (∀ k, P3381T1TriangleDeterminant (p.vertex ∘ f k) ≠ 0) ∧ + (∀ k, P3381T1TriangleDeterminant (Q ∘ f k) ≠ 0) ∧ + X = ⋃ k, convexHull Real (Set.range (p.vertex ∘ f k)) ∧ + K = ⋃ k, convexHull Real (Set.range (Q ∘ f k)) ∧ + (∀ k l, + convexHull Real (Set.range (p.vertex ∘ f k)) ∩ + convexHull Real (Set.range (p.vertex ∘ f l)) = + convexHull Real (p.vertex '' (Set.range (f k) ∩ Set.range (f l)))) ∧ + (∀ k l, + convexHull Real (Set.range (Q ∘ f k)) ∩ + convexHull Real (Set.range (Q ∘ f l)) = + convexHull Real (Q '' (Set.range (f k) ∩ Set.range (f l)))) := by +-- BODY + classical + dsimp only + have split_mem {I : Type} [DecidableEq I] + (fs : Finset (Finset I)) (a d b : I) (G : Finset I) := FacialInsertionGeometry.split_mem (I + := I) fs a d b G + have split_mem_cases {I : Type} [DecidableEq I] + (fs : Finset (Finset I)) (a d b : I) (G : Finset I) := + FacialInsertionGeometry.split_mem_cases split_mem (I := I) fs a d b G + have faceMemTransport {I : Type} [DecidableEq I] + {fs : Finset (Finset I)} {F G : Finset I} (hFG : F = G) + (hG : G ∈ fs) : F ∈ fs := hFG ▸ hG + let triangleMatrix (v : Fin 3 → Real × Real) : + Matrix (Fin 3) (Fin 3) Real := + fun i j => if j = 0 then (v i).1 else if j = 1 then (v i).2 else 1 + have det_range_transport {I : Type} (f g : Fin 3 → I) + (hf : Function.Injective f) (hg : Function.Injective g) + (hr : Set.range f = Set.range g) (v : I → Real × Real) := + FacialInsertionGeometry.det_range_transport + (FacialInsertionGeometry.triangleMatrix_det) (I := I) f g hf hg hr v + have hInc := P3523T1InsertionIncidence q p s X K t + have hOrd := P3523T1OrderedInsertion q p s X K t + have hHull := P3523T1TargetHull s t + have hTargetBoundary := P3523T1TargetBoundary q p s X K t + rcases hInc with ⟨hfaceShape, hincidence, hfaceInj, + hfaceDistinct, hfaceCover, hfaceEdgeCount, hfaceRange⟩ + rcases hOrd with ⟨hstartOrdering, hstep, hvertices, hboundary⟩ + rcases hHull with ⟨hstartTarget, htargetHull⟩ + rcases hTargetBoundary with ⟨hTargetInj, _, _⟩ + let c := P3523T1InsertionConstruction s t + have hfaces0 := FacialInsertionGeometry.hfaces0 r n q p s X K t + have initialDet (v : Fin (n + 3) → Real × Real) + (old : Fin (r + 3) → Real × Real) + (hstart : ∀ i, v (s.start i) = old i) + (hcert : ∀ k, P3381T1TriangleDeterminant (old ∘ t.face k) ≠ 0) + (F : Finset (Fin (n + 3))) (hF : F ∈ c.faces 0) + (g : Fin 3 → Fin (n + 3)) (hg : Function.Injective g) + (hgrange : Set.range g = (F : Set (Fin (n + 3)))) := FacialInsertionGeometry.initialDet r n + q p s X K t det_range_transport hfaces0 v old hstart hcert F hF g hg hgrange + have existsThird {I : Type} [DecidableEq I] {F : Finset I} + (hcard : F.card = 3) {a b : I} (ha : a ∈ F) (hb : b ∈ F) + (hab : a ≠ b) := FacialInsertionGeometry.existsThird (I := I) (F := F) hcard (a := a) (b := + b) ha hb hab + have hstartSource (i : Fin (r + 3)) := FacialInsertionGeometry.hstartSource r n q p s i + have sourceInitialDet := initialDet p.vertex q.vertex hstartSource + t.source_nondegenerate + have targetInitialDet := initialDet (P3523T1InterpolatedTarget s t) + t.target hstartTarget t.target_nondegenerate + have sourceInterp := FacialInsertionGeometry.sourceInterp r n q p s X K t hstep + have targetInterp := FacialInsertionGeometry.targetInterp r n q p s X K t hstep + have tripleInj {I : Type} {a b z : I} (hab : a ≠ b) + (haz : a ≠ z) (hbz : b ≠ z) := FacialInsertionGeometry.tripleInj (I := I) (a := a) (b := + b) (z := z) hab haz hbz + have tripleRange {I : Type} [DecidableEq I] (a b z : I) := FacialInsertionGeometry.tripleRange + (I := I) a b z + have mapTriple {I J : Type} (v : I → J) (a b z : I) := FacialInsertionGeometry.mapTriple (I := + I) (J := J) v a b z + have detState (v : Fin (n + 3) → Real × Real) + (hinterp : ∀ h (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∃ u : Real, 0 < u ∧ u < 1 ∧ + v e.2.1 = (1-u) • v e.1 + u • v e.2.2) + (hinit : ∀ F ∈ c.faces 0, ∀ g : Fin 3 → Fin (n + 3), + Function.Injective g → Set.range g = (F : Set _) → + P3381T1TriangleDeterminant (v ∘ g) ≠ 0) := FacialInsertionGeometry.detState r n q p s + X K t split_mem det_range_transport hfaceShape hstep existsThird tripleInj + tripleRange mapTriple v hinterp hinit + have sourceState := detState p.vertex sourceInterp sourceInitialDet + have targetState := detState (P3523T1InterpolatedTarget s t) + targetInterp targetInitialDet + let f := P3523T1FaceEnumeration (c.faces c.steps.length) + have terminalFace (k : Fin (c.faces c.steps.length).card) := + FacialInsertionGeometry.terminalFace r n q p s X K t hfaceRange k + let faceUnion (v : Fin (n + 3) → Real × Real) + (faces : Finset (Finset (Fin (n + 3)))) : Set (Real × Real) := + ⋃ F ∈ (faces : Set (Finset (Fin (n + 3)))), + convexHull Real (v '' (F : Set (Fin (n + 3)))) + have imageUnion {α β γ : Type} [DecidableEq β] + (s₀ : Finset α) (g₀ : α → β) (P : β → Set γ) := FacialInsertionGeometry.imageUnion (α := α) + (β := β) (γ := γ) s₀ g₀ P + have imageTriple (v : Fin (n + 3) → Real × Real) + (a b z : Fin (n + 3)) := FacialInsertionGeometry.imageTriple n v a b z + have imagePair (v : Fin (n + 3) → Real × Real) + (a z : Fin (n + 3)) := FacialInsertionGeometry.imagePair n v a z + have splitHull (v : Fin (n + 3) → Real × Real) + (a d b z : Fin (n + 3)) (hab : a ≠ b) (haz : a ≠ z) + (hbz : b ≠ z) (u : Real) (hu : 0 < u ∧ u < 1) + (hvalue : v d = (1-u) • v a + u • v b) + (hdet : P3381T1TriangleDeterminant ![v a, v b, v z] ≠ 0) := + FacialInsertionGeometry.splitHull n imageTriple v a d b z hab haz hbz u hu hvalue hdet + have sourceStartImage (k : Fin t.count) := FacialInsertionGeometry.sourceStartImage r n q p s X + K t hstartSource k + have targetStartImage (k : Fin t.count) := FacialInsertionGeometry.targetStartImage r n q p s X + K t hstartTarget k + have startFaceSet (k : Fin t.count) := FacialInsertionGeometry.startFaceSet r n q p s X K t k + have coverState (v : Fin (n + 3) → Real × Real) + (hinterp : ∀ h (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∃ u : Real, 0 < u ∧ u < 1 ∧ + v e.2.1 = (1-u) • v e.1 + u • v e.2.2) + (hnondeg : ∀ h ≤ c.steps.length, ∀ F ∈ c.faces h, + ∀ g : Fin 3 → Fin (n + 3), Function.Injective g → + Set.range g = (F : Set _) → + P3381T1TriangleDeterminant (v ∘ g) ≠ 0) + (Y : Set (Real × Real)) (hbase : faceUnion v (c.faces 0) = Y) := + InsertionAssembly.coverState r n q p s X K t split_mem hfaceShape hstep existsThird + tripleInj tripleRange mapTriple splitHull v hinterp hnondeg Y hbase + have mixedPair (v : Fin (n + 3) → Real × Real) + (vinj : Function.Injective v) (a d b z : Fin (n + 3)) + (hab : a ≠ b) (haz : a ≠ z) (hbz : b ≠ z) + (F H : Finset (Fin (n + 3))) (hF : F = {a, b, z}) + (hleftFace : insert d (F.erase b) = {a, d, z}) + (hrightFace : insert d (F.erase a) = {d, b, z}) + (hdH : d ∉ H) (hnot : ¬ (a ∈ H ∧ b ∈ H)) + (hpair : convexHull Real (v '' (F : Set _)) ∩ + convexHull Real (v '' (H : Set _)) = + convexHull Real (v '' ((F : Set _) ∩ (H : Set _)))) + (hgeo : convexHull Real (v '' (({a, b, z} : Finset (Fin (n + 3))) : Set _)) = + convexHull Real (v '' (({a, d, z} : Finset (Fin (n + 3))) : Set _)) ∪ + convexHull Real (v '' (({d, b, z} : Finset (Fin (n + 3))) : Set _)) ∧ + convexHull Real (v '' (({a, d, z} : Finset (Fin (n + 3))) : Set _)) ∩ + convexHull Real (v '' (({d, b, z} : Finset (Fin (n + 3))) : Set _)) = + segment Real (v d) (v z) ∧ + (∀ J : Set (Real × Real), J ⊆ {v a, v b, v z} → + ¬ (v a ∈ J ∧ v b ∈ J) → + convexHull Real (v '' (({a, d, z} : Finset (Fin (n + 3))) : Set _)) ∩ + convexHull Real J = convexHull Real (J ∩ {v a, v z}) ∧ + convexHull Real (v '' (({d, b, z} : Finset (Fin (n + 3))) : Set _)) ∩ + convexHull Real J = convexHull Real (J ∩ {v b, v z}))) := + FacialInsertionGeometry.mixedPair n (FacialInsertionGeometry.retainedLeft n + imagePair) (FacialInsertionGeometry.retainedRight n imagePair) v vinj a d b z + hab haz hbz F H hF hleftFace hrightFace hdH hnot hpair hgeo + have pairState (v : Fin (n + 3) → Real × Real) + (vinj : Function.Injective v) + (hinterp : ∀ h (hh : h < c.steps.length), + let e := c.steps.get ⟨h, hh⟩ + ∃ u : Real, 0 < u ∧ u < 1 ∧ + v e.2.1 = (1-u) • v e.1 + u • v e.2.2) + (hnondeg : ∀ h ≤ c.steps.length, ∀ F ∈ c.faces h, + ∀ g : Fin 3 → Fin (n + 3), Function.Injective g → + Set.range g = (F : Set _) → + P3381T1TriangleDeterminant (v ∘ g) ≠ 0) + (hinit : ∀ F ∈ c.faces 0, ∀ G ∈ c.faces 0, + convexHull Real (v '' (F : Set _)) ∩ + convexHull Real (v '' (G : Set _)) = + convexHull Real (v '' ((F : Set _) ∩ (G : Set _)))) := InsertionAssembly.pairState r + n q p s X K t split_mem_cases faceMemTransport hfaceShape hincidence hstep + existsThird tripleInj tripleRange mapTriple imageTriple mixedPair v vinj hinterp + hnondeg hinit + have enumUnion (v : Fin (n + 3) → Real × Real) := FacialInsertionGeometry.enumUnion r n q p s X + K t hfaceRange v + have hsourceCoverState := + coverState p.vertex sourceInterp sourceState X (FacialInsertionGeometry.sourceBase r n q p s + X K t hfaces0 imageUnion sourceStartImage) + have htargetCoverState := coverState (P3523T1InterpolatedTarget s t) + targetInterp targetState K (FacialInsertionGeometry.targetBase r n q p s X K t hfaces0 + imageUnion targetStartImage) + have sourcePairState : ∀ h ≤ c.steps.length, ∀ F ∈ c.faces h, + ∀ G ∈ c.faces h, + convexHull Real (p.vertex '' (F : Set _)) ∩ + convexHull Real (p.vertex '' (G : Set _)) = + convexHull Real (p.vertex '' ((F : Set _) ∩ (G : Set _))) := + pairState p.vertex p.injective sourceInterp sourceState + (FacialInsertionGeometry.sourceInitialPair r n q p s X K t hfaces0 sourceStartImage + (FacialInsertionGeometry.sourceStartCommon r n q p s X K t hstartSource startFaceSet)) + have targetPairState : ∀ h ≤ c.steps.length, ∀ F ∈ c.faces h, + ∀ G ∈ c.faces h, + convexHull Real ((P3523T1InterpolatedTarget s t) '' (F : Set _)) ∩ + convexHull Real ((P3523T1InterpolatedTarget s t) '' (G : Set _)) = + convexHull Real ((P3523T1InterpolatedTarget s t) '' + ((F : Set _) ∩ (G : Set _))) := + pairState (P3523T1InterpolatedTarget s t) hTargetInj targetInterp + targetState (FacialInsertionGeometry.targetInitialPair r n q p s X K t hfaces0 + targetStartImage (FacialInsertionGeometry.targetStartCommon r n q p s X K t + hstartTarget startFaceSet)) + have imageRange (v : Fin (n + 3) → Real × Real) + (k : Fin (c.faces c.steps.length).card) := FacialInsertionGeometry.imageRangeAt1467 r n q p + s X K t v k + exact ⟨(FacialInsertionGeometry.hsourceDet r n q p s X K t hfaceInj sourceState terminalFace), + (FacialInsertionGeometry.htargetDet r n q p s X K t hfaceInj targetState terminalFace), + (FacialInsertionGeometry.hsourceCoverage r n q p s X K t enumUnion hsourceCoverState), + (FacialInsertionGeometry.htargetCoverage r n q p s X K t enumUnion htargetCoverState), + (FacialInsertionGeometry.hsourcePairs r n q p s X K t terminalFace sourcePairState + imageRange), (FacialInsertionGeometry.htargetPairs r n q p s X K t terminalFace + targetPairState imageRange)⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean new file mode 100644 index 0000000000..06866f73b4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean @@ -0,0 +1,1806 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3523T1OrderedInsertion +public import LeanPool.ApollonianSuperharmonic.P3523T1FaceEnumeration + +-- [TABLET NODE: P3523T1InsertionIncidence] + +/-! +# P3523T1InsertionIncidence + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace InsertionIncidenceProof + +private theorem hface_inj : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), Function.Injective (fun k : Fin t.count => + Finset.univ.image (s.start ∘ t.face k)) ) := by + classical + intro r n q p s X K t k l heq + apply t.face_distinct + have h' : (Finset.univ.image (t.face k)).image s.start = + (Finset.univ.image (t.face l)).image s.start := by + simpa only [Finset.image_image, Function.comp_def] using heq + have h'' := (Finset.image_injective s.start_injective) h' + apply Set.ext + intro x + simpa only [Set.mem_range, Finset.mem_image, Finset.mem_univ, true_and] using Iff.of_eq + (congrArg (fun A : Finset (Fin (r + 3)) => x ∈ A) h'') + +private theorem hsplit_card : + (by + classical + exact + ∀ (n : Nat), ∀ (fs : Finset (Finset (Fin (n + (3 : ℕ))))), ∀ (a : Fin (n + (3 : ℕ))), ∀ + (d : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), (∀ F ∈ fs, F.card = (3 : ℕ)) → (∀ + F ∈ fs, + d ∉ F) → ∀ G ∈ P3523T1BoundaryFaceSplit fs a d b, G.card = (3 : ℕ) ) := by + classical + intro n fs a d b hf hd G hG + change G ∈ fs.biUnion (fun F => + if a ∈ F ∧ b ∈ F then {insert d (F.erase b), insert d (F.erase a)} + else {F}) at hG + rw [Finset.mem_biUnion] at hG + rcases hG with ⟨F, hF, hG⟩ + by_cases hp : a ∈ F ∧ b ∈ F + · simp? [hp] at hG + rcases hG with hG | hG + · subst G + have hnot : d ∉ F.erase b := fun hx => hd F hF (Finset.mem_of_mem_erase hx) + rw [Finset.card_insert_of_notMem hnot, Finset.card_erase_of_mem hp.2] + rw [hf F hF] + · subst G + have hnot : d ∉ F.erase a := fun hx => hd F hF (Finset.mem_of_mem_erase hx) + rw [Finset.card_insert_of_notMem hnot, Finset.card_erase_of_mem hp.1] + rw [hf F hF] + · simp? [hp] at hG + subst G + exact hf F hF + +private theorem hsplit_sub : + (by + classical + exact + ∀ (n : Nat), ∀ (fs : Finset (Finset (Fin (n + (3 : ℕ))))), ∀ (a : Fin (n + (3 : ℕ))), ∀ + (d : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (V : Finset (Fin (n + (3 : + ℕ)))), (∀ F ∈ + fs, F ⊆ V) → ∀ G ∈ P3523T1BoundaryFaceSplit fs a d b, G ⊆ insert d V ) := by + classical + intro n fs a d b V hf G hG + change G ∈ fs.biUnion (fun F => + if a ∈ F ∧ b ∈ F then {insert d (F.erase b), insert d (F.erase a)} + else {F}) at hG + rw [Finset.mem_biUnion] at hG + rcases hG with ⟨F, hF, hG⟩ + by_cases hp : a ∈ F ∧ b ∈ F + · simp? [hp] at hG + rcases hG with hG | hG + · subst G + intro x hx + simp only [Finset.mem_insert] at hx ⊢ + rcases hx with rfl | hx + · exact Or.inl rfl + · exact Or.inr (hf F hF (Finset.mem_of_mem_erase hx)) + · subst G + intro x hx + simp only [Finset.mem_insert] at hx ⊢ + rcases hx with rfl | hx + · exact Or.inl rfl + · exact Or.inr (hf F hF (Finset.mem_of_mem_erase hx)) + · simp? [hp] at hG + subst G + intro x hx + simp only [Finset.mem_insert] + exact Or.inr (hf F hF hx) + +private theorem hfaces_next : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), c.faces (h + (1 : ℕ)) = P3523T1BoundaryFaceSplit + (c.faces h) (c.steps.get ⟨h, hh⟩).1 (c.steps.get ⟨h, hh⟩).2.1 (c.steps.get ⟨h, hh⟩).2.2 ) + := by + classical + intro r n q p s X K t c h hh + change (c.steps.take (h + 1)).foldl + (fun fs e => P3523T1BoundaryFaceSplit fs e.1 e.2.1 e.2.2) + (Finset.univ.image fun k : Fin t.count => + Finset.univ.image (s.start ∘ t.face k)) = + P3523T1BoundaryFaceSplit ((c.steps.take h).foldl + (fun fs e => P3523T1BoundaryFaceSplit fs e.1 e.2.1 e.2.2) + (Finset.univ.image fun k : Fin t.count => + Finset.univ.image (s.start ∘ t.face k))) + (c.steps.get ⟨h, hh⟩).1 (c.steps.get ⟨h, hh⟩).2.1 (c.steps.get ⟨h, hh⟩).2.2 + rw [← List.take_append_getElem hh] + simp only [List.foldl_append, List.foldl_cons, List.foldl_nil] + simp only [List.get_eq_getElem] + +private theorem hboundary_next : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), c.boundary (h + (1 : ℕ)) = insert {(c.steps.get ⟨h, + hh⟩).1, (c.steps.get ⟨h, hh⟩).2.1} (insert {(c.steps.get ⟨h, hh⟩).2.1, (c.steps.get ⟨h, + hh⟩).2.2} ((c.boundary h).erase {(c.steps.get ⟨h, hh⟩).1, (c.steps.get ⟨h, hh⟩).2.2})) ) + := by + classical + intro r n q p s X K t c h hh + let B0 : Finset (Finset (Fin (n + 3))) := Finset.univ.image fun i : Fin (r + 3) => + ({s.start i, s.start (i + 1)} : Finset (Fin (n + 3))) + change (c.steps.take (h + 1)).foldl + (fun es e => insert {e.1, e.2.1} + (insert {e.2.1, e.2.2} (es.erase {e.1, e.2.2}))) B0 = + insert {(c.steps.get ⟨h, hh⟩).1, (c.steps.get ⟨h, hh⟩).2.1} + (insert {(c.steps.get ⟨h, hh⟩).2.1, (c.steps.get ⟨h, hh⟩).2.2} + (((c.steps.take h).foldl (fun es e => insert {e.1, e.2.1} + (insert {e.2.1, e.2.2} (es.erase {e.1, e.2.2}))) B0).erase + {(c.steps.get ⟨h, hh⟩).1, (c.steps.get ⟨h, hh⟩).2.2})) + rw [← List.take_append_getElem hh] + simp only [List.foldl_append, List.foldl_cons, List.foldl_nil, List.get_eq_getElem] + +private theorem hstage : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (∀ (h : ℕ), ∀ (hh : h < (P3523T1InsertionConstruction s t).steps.length), + let e := + (P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩; e.1 ≠ e.2.2 ∧ e.1 ∈ + (P3523T1InsertionConstruction s t).vertices h ∧ e.2.2 ∈ (P3523T1InsertionConstruction + s t).vertices h ∧ e.2.1 ∉ (P3523T1InsertionConstruction s t).vertices h ∧ {e.1, e.2.2} + ∈ (P3523T1InsertionConstruction s t).boundary h ∧ ∃ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : ℝ) + ∧ p.vertex e.2.1 = ((1 : ℝ) - u) • p.vertex e.1 + u • p.vertex e.2.2 ∧ + P3523T1InterpolatedTarget s t e.2.1 = ((1 : ℝ) - u) • P3523T1InterpolatedTarget s t + e.1 + u • P3523T1InterpolatedTarget s t e.2.2) → ((∀ F ∈ c.faces 0, F.card = 3) → ((∀ + (fs : Finset (Finset (Fin (n + 3)))), ∀ (a : Fin (n + 3)), ∀ (d : Fin (n + 3)), ∀ (b + : Fin (n + 3)), (∀ F ∈ fs, F.card = 3) → ((∀ F ∈ fs, d ∉ F) → (∀ G ∈ + P3523T1BoundaryFaceSplit fs a d b, G.card = 3))) → ((∀ (fs : Finset (Finset (Fin (n + + 3)))), ∀ (a : Fin (n + 3)), ∀ (d : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (V : Finset (Fin + (n + 3))), (∀ F ∈ fs, F ⊆ V) → (∀ G ∈ P3523T1BoundaryFaceSplit fs a d b, G ⊆ insert d + V)) → ((∀ F ∈ c.faces 0, F ⊆ c.vertices 0) → ((∀ (h : Nat), ∀ (hh : h < c.steps.length), + c.faces (h + 1) = P3523T1BoundaryFaceSplit (c.faces h) (c.steps.get ⟨h, hh⟩).1 + (c.steps.get ⟨h, hh⟩).2.1 (c.steps.get ⟨h, hh⟩).2.2) → ((∀ (h : Nat), ∀ (hh : h < + c.steps.length), c.vertices (h + 1) = insert (c.steps.get ⟨h, hh⟩).2.1 (c.vertices h)) → + (∀ h : Nat, h ≤ c.steps.length → ∀ F ∈ c.faces h, F.card = 3 ∧ F ⊆ c.vertices h))))))) ) + := by + classical + intro r n q p s X K t c hsteps hinit hsplit_card hsplit_sub hinit_sub hfaces_next + hvertices_next h hh + induction h with + | zero => + intro F hF + exact ⟨hinit F hF, hinit_sub F hF⟩ + | succ h ih => + have hlt : h < c.steps.length := by omega + have ih' := ih (by omega) + intro F hF + let e := c.steps.get ⟨h, hlt⟩ + have he := hsteps h hlt + dsimp [e] at he + rcases he with ⟨_, _, _, hdnew, _, _⟩ + rw [hfaces_next h hlt] at hF + constructor + · apply hsplit_card + · intro G hG + exact (ih' G hG).1 + · intro G hG hdG + exact hdnew ((ih' G hG).2 hdG) + · exact hF + · rw [hvertices_next h hlt] + apply hsplit_sub + · intro G hG + exact (ih' G hG).2 + · exact hF + +private theorem hboundary_support : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (∀ (h : ℕ), ∀ (hh : h < (P3523T1InsertionConstruction s t).steps.length), + let e := + (P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩; e.1 ≠ e.2.2 ∧ e.1 ∈ + (P3523T1InsertionConstruction s t).vertices h ∧ e.2.2 ∈ (P3523T1InsertionConstruction + s t).vertices h ∧ e.2.1 ∉ (P3523T1InsertionConstruction s t).vertices h ∧ {e.1, e.2.2} + ∈ (P3523T1InsertionConstruction s t).boundary h ∧ ∃ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : ℝ) + ∧ p.vertex e.2.1 = ((1 : ℝ) - u) • p.vertex e.1 + u • p.vertex e.2.2 ∧ + P3523T1InterpolatedTarget s t e.2.1 = ((1 : ℝ) - u) • P3523T1InterpolatedTarget s t + e.1 + u • P3523T1InterpolatedTarget s t e.2.2) → ((∀ (h : Nat), ∀ (hh : h < + c.steps.length), c.vertices (h + 1) = insert (c.steps.get ⟨h, hh⟩).2.1 (c.vertices h)) → + ((∀ (h : Nat), ∀ (hh : h < c.steps.length), c.boundary (h + 1) = insert {(c.steps.get ⟨h, + hh⟩).1, (c.steps.get ⟨h, hh⟩).2.1} (insert {(c.steps.get ⟨h, hh⟩).2.1, (c.steps.get ⟨h, + hh⟩).2.2} ((c.boundary h).erase {(c.steps.get ⟨h, hh⟩).1, (c.steps.get ⟨h, hh⟩).2.2}))) → + (∀ h : Nat, h ≤ c.steps.length → ∀ P ∈ c.boundary h, ∀ x ∈ P, x ∈ c.vertices h))) ) := by + classical + intro r n q p s X K t c hsteps hvertices_next hboundary_next h hh + induction h with + | zero => + intro P hP x hx + change P ∈ Finset.univ.image (fun i : Fin (r + 3) => + ({s.start i, s.start (i + 1)} : Finset (Fin (n + 3)))) at hP + rcases Finset.mem_image.mp hP with ⟨i, -, rfl⟩ + change x ∈ Finset.univ.image s.start + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + rcases hx with hx | hx + · subst x + exact Finset.mem_image.mpr ⟨i, Finset.mem_univ _, rfl⟩ + · subst x + exact Finset.mem_image.mpr ⟨i + 1, Finset.mem_univ _, rfl⟩ + | succ h ih => + have hlt : h < c.steps.length := by omega + have ih' := ih (by omega) + let e := c.steps.get ⟨h, hlt⟩ + have he := hsteps h hlt + dsimp [e] at he + rcases he with ⟨_, ha, hb, _, _, _⟩ + intro P hP x hx + rw [hboundary_next h hlt] at hP + rw [hvertices_next h hlt] + simp only [Finset.mem_insert] at hP + rcases hP with hP | hP + · subst P + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + simp only [Finset.mem_insert] + rcases hx with hx | hx + · subst x + exact Or.inr ha + · subst x + exact Or.inl rfl + · rcases hP with hP | hP + · subst P + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + simp only [Finset.mem_insert] + rcases hx with hx | hx + · subst x + exact Or.inl rfl + · subst x + exact Or.inr hb + · simp only [Finset.mem_erase] at hP + exact Finset.mem_insert.mpr (Or.inr (ih' P hP.2 x hx)) + +private theorem hthird : + (by + classical + exact + ∀ (n : Nat), ∀ (F : Finset (Fin (n + (3 : ℕ)))), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + + (3 : ℕ))), a ≠ b → F.card = (3 : ℕ) → a ∈ F → b ∈ F → ∃ (x : Fin (n + (3 : ℕ))), x ≠ a ∧ + x ≠ b ∧ F = {a, b, x} ) := by + classical + intro n F a b hab hcard ha hb + have hb' : b ∈ F.erase a := Finset.mem_erase.mpr ⟨hab.symm, hb⟩ + have hFa : (F.erase a).card = 2 := by rw [Finset.card_erase_of_mem ha, hcard] + have hS : ((F.erase a).erase b).card = 1 := by + rw [Finset.card_erase_of_mem hb', hFa] + rcases Finset.card_eq_one.mp hS with ⟨x, hx⟩ + have hxa : x ≠ a := by + intro h + subst x + have : a ∉ (F.erase a).erase b := by simp + rw [hx] at this + simp at this + have hxb : x ≠ b := by + intro h + subst x + have : b ∉ (F.erase a).erase b := by simp + rw [hx] at this + simp at this + have hxF : x ∈ F := Finset.mem_of_mem_erase (Finset.mem_of_mem_erase + (by rw [hx]; simp)) + refine ⟨x, hxa, hxb, ?_⟩ + ext y + simp only [Finset.mem_insert, Finset.mem_singleton] + constructor + · intro hy + by_cases hya : y = a + · exact Or.inl hya + · by_cases hyb : y = b + · exact Or.inr (Or.inl hyb) + · have hyS : y ∈ (F.erase a).erase b := + Finset.mem_erase.mpr ⟨hyb, Finset.mem_erase.mpr ⟨hya, hy⟩⟩ + have : y = x := by simpa [hx] using hyS + exact Or.inr (Or.inr this) + · rintro (rfl | rfl | rfl) + · exact ha + · exact hb + · exact hxF + +private theorem hfaceChoice : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + let fs := c.faces c.steps.length + (∀ F ∈ fs, F.card = 3) → (∀ (k : Fin fs.card), ∃ (g : Fin (3 : ℕ) → Fin (n + (3 : ℕ))), + Function.Injective g ∧ Set.range g = (↑(↑((fs.equivFin.symm : Fin fs.card → ↥fs) k) : + Finset (Fin (n + (3 : ℕ)))) : Set (Fin (n + (3 : ℕ))))) ) := by + classical + intro r n q p s X K t c fs hfinal_card k + let F := (fs.equivFin.symm k).val + have hF : F ∈ fs := (fs.equivFin.symm k).property + have hc : F.card = 3 := hfinal_card F hF + let g : Fin 3 → Fin (n + 3) := fun j => + (F.equivFin.symm (Fin.cast hc.symm j)).val + refine ⟨g, ?_, ?_⟩ + · intro i j hij + have hsub : F.equivFin.symm (Fin.cast hc.symm i) = + F.equivFin.symm (Fin.cast hc.symm j) := Subtype.ext hij + have hcast := F.equivFin.symm.injective hsub + exact Fin.cast_injective hc.symm hcast + · apply Set.ext + intro x + constructor + · rintro ⟨j, rfl⟩ + exact (F.equivFin.symm (Fin.cast hc.symm j)).property + · intro hx + have hxF : x ∈ F := by simpa [F] using hx + refine ⟨Fin.cast hc (F.equivFin ⟨x, hxF⟩), ?_⟩ + simp [g, Fin.cast_cast] + +private theorem hindexed_filter_card : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + let fs := c.faces c.steps.length + let f := P3523T1FaceEnumeration fs + (∀ (k : Fin fs.card), Function.Injective (f k) ∧ Set.range (f k) = ((fs.equivFin.symm k).val + : Set (Fin (n + 3)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ({k : Fin + fs.card | i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)} : Finset (Fin fs.card)).card = + {F ∈ fs | i ∈ F ∧ j ∈ + F}.card) ) := by + classical + intro r n q p s X K t c fs f hf_spec i j + apply Finset.card_bij (fun k hk => (fs.equivFin.symm k).val) + · intro k hk + rcases Finset.mem_filter.mp hk with ⟨_, hk⟩ + apply Finset.mem_filter.mpr + refine ⟨(fs.equivFin.symm k).property, ?_⟩ + constructor + · have hi : i ∈ Set.range (f k) := hk.1 + rw [(hf_spec k).2] at hi + exact hi + · have hj : j ∈ Set.range (f k) := hk.2 + rw [(hf_spec k).2] at hj + exact hj + · intro k hk l hl heq + apply (fs.equivFin.symm).injective + apply Subtype.ext + exact heq + · intro F hF + rcases Finset.mem_filter.mp hF with ⟨hF, hp⟩ + let k := fs.equivFin ⟨F, hF⟩ + have hface : (fs.equivFin.symm k).val = F := by simp [k] + have hrange : Set.range (f k) = (F : Set (Fin (n + 3))) := by + rw [(hf_spec k).2, hface] + refine ⟨k, ?_, ?_⟩ + · apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + rw [hrange] + exact hp + · simp [k] + +private theorem hindexed_exists : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + let fs := c.faces c.steps.length + let f := P3523T1FaceEnumeration fs + (∀ (k : Fin fs.card), Function.Injective (f k) ∧ Set.range (f k) = ((fs.equivFin.symm k).val + : Set (Fin (n + 3)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (∃ (k : + Fin fs.card), i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)) ↔ ∃ F ∈ fs, i ∈ F ∧ j ∈ F) ) := by + classical + intro r n q p s X K t c fs f hf_spec i j + constructor + · rintro ⟨k, hk⟩ + refine ⟨(fs.equivFin.symm k).val, (fs.equivFin.symm k).property, ?_⟩ + constructor + · have hi : i ∈ Set.range (f k) := hk.1 + rw [(hf_spec k).2] at hi + exact hi + · have hj : j ∈ Set.range (f k) := hk.2 + rw [(hf_spec k).2] at hj + exact hj + · rintro ⟨F, hF, hp⟩ + let k := fs.equivFin ⟨F, hF⟩ + have hface : (fs.equivFin.symm k).val = F := by simp [k] + have hrange : Set.range (f k) = (F : Set (Fin (n + 3))) := by + rw [(hf_spec k).2, hface] + refine ⟨k, ?_⟩ + rw [hrange] + exact hp + +private theorem hinitial_pair_count : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (Function.Injective (fun k : Fin t.count => Finset.univ.image (s.start ∘ t.face k))) → (∀ + (i : Fin (r + (3 : ℕ))), ∀ (j : Fin (r + (3 : ℕ))), {F ∈ c.faces (0 : ℕ) | s.start i + ∈ F ∧ + s.start j ∈ F}.card = {k : Fin t.count | i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face + k)}.ncard) ) := by + classical + intro r n q p s X K t c hface_inj i j + change ((Finset.univ.image (fun k : Fin t.count => + Finset.univ.image (s.start ∘ t.face k))).filter + (fun F => s.start i ∈ F ∧ s.start j ∈ F)).card = _ + rw [Finset.filter_image] + rw [Finset.card_image_of_injective _ hface_inj] + have hp (k : Fin t.count) : + (s.start i ∈ Finset.univ.image (s.start ∘ t.face k) ∧ + s.start j ∈ Finset.univ.image (s.start ∘ t.face k)) ↔ + i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k) := by + simp only [Finset.mem_image, Finset.mem_univ, true_and, Set.mem_range] + constructor + · rintro ⟨⟨x, hx⟩, ⟨y, hy⟩⟩ + exact ⟨⟨x, s.start_injective hx⟩, ⟨y, s.start_injective hy⟩⟩ + · rintro ⟨⟨x, hx⟩, ⟨y, hy⟩⟩ + exact ⟨⟨x, congrArg s.start hx⟩, ⟨y, congrArg s.start hy⟩⟩ + have heq : Finset.univ.filter (fun k : Fin t.count => + s.start i ∈ Finset.univ.image (s.start ∘ t.face k) ∧ + s.start j ∈ Finset.univ.image (s.start ∘ t.face k)) = + Finset.univ.filter (fun k : Fin t.count => + i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k)) := by + ext k + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + exact hp k + rw [heq] + have hset : (Finset.univ.filter (fun k : Fin t.count => + i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k)) : Set (Fin t.count)) = + {k : Fin t.count | i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k)} := by + ext k + simp + rw [← hset, Set.ncard_coe_finset] + +private theorem pair_eq_pair : + (by + classical + exact + ∀ {α : Type}, ∀ [DecidableEq α], ∀ (a : α), ∀ (b : α), ∀ (c : α), ∀ (d : α), a ≠ b → c + ≠ d → (({a, b} : Finset α) = {c, d} ↔ a = c ∧ b = d ∨ a = d ∧ b = c) ) := by + classical + intro α typeclassInstance0 a b c d hab hcd + constructor + · intro h + have hc : c = a ∨ c = b := by + have : c ∈ ({a, b} : Finset α) := by rw [h]; simp + simpa using this + have hd : d = a ∨ d = b := by + have : d ∈ ({a, b} : Finset α) := by rw [h]; simp + simpa using this + rcases hc with hc | hc <;> rcases hd with hd | hd + · exact False.elim (hcd (hc.trans hd.symm)) + · exact Or.inl ⟨hc.symm, hd.symm⟩ + · exact Or.inr ⟨hd.symm, hc.symm⟩ + · have : a ∈ ({c, d} : Finset α) := by rw [← h]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at this + rcases this with ha | ha + · exact False.elim (hab (ha.trans hc)) + · exact False.elim (hab (ha.trans hd)) + · rintro (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩) + · rfl + · exact Finset.pair_comm _ _ + +private theorem hboundary_final_pair : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ((P3523T1InsertionConstruction s t).boundary (P3523T1InsertionConstruction s + t).steps.length = Finset.image (fun (j : Fin (n + (3 : ℕ))) => {j, + j + (1 : Fin (n + (3 : ℕ)))}) Finset.univ) → ((∀ {α : Type}, ∀ [DecidableEq α], ∀ (a : + α), ∀ (b : α), ∀ (c : α), ∀ (d : α), (a ≠ b) → ((c ≠ d) → (({a, b} : Finset α) = {c, + d} ↔ + (a = c ∧ b = d) ∨ (a = d ∧ b = c)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : + ℕ))), i ≠ j → ({i, j} ∈ c.boundary c.steps.length ↔ j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = + j + (1 : Fin (n + (3 : ℕ)))))) ) := by + classical + intro r n q p s X K t c hboundary pair_eq_pair i j hij + rw [hboundary, Finset.mem_image] + constructor + · rintro ⟨k, -, hpair⟩ + have hk : k ≠ k + 1 := by + intro heq + have hv := congrArg Fin.val heq + change k.val = (k.val + 1) % (n + 3) at hv + by_cases hlt : k.val + 1 < n + 3 + · rw [Nat.mod_eq_of_lt hlt] at hv + omega + · have hend : k.val + 1 = n + 3 := by omega + rw [hend, Nat.mod_self] at hv + omega + rcases (pair_eq_pair i j k (k + 1) hij hk).mp hpair.symm with h | h + · left + rw [h.1, h.2] + · right + rw [h.1, h.2] + · intro h + rcases h with h | h + · subst j + exact ⟨i, Finset.mem_univ _, rfl⟩ + · subst i + exact ⟨j, Finset.mem_univ _, Finset.pair_comm _ _⟩ + +private theorem hindexed_ledger : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + let fs := c.faces c.steps.length + let f := P3523T1FaceEnumeration fs + (∀ (i : Fin (n + 3)), ∀ (j : Fin (n + 3)), (Finset.univ.filter (fun k : Fin fs.card => i ∈ + Set.range (f k) ∧ j ∈ Set.range (f k))).card = (fs.filter (fun F => i ∈ F ∧ j ∈ F)).card) + → ((∀ (i : Fin (n + 3)), ∀ (j : Fin (n + 3)), (∃ k : Fin fs.card, i ∈ Set.range (f k) ∧ j + ∈ Set.range (f k)) ↔ ∃ F ∈ fs, i ∈ F ∧ j ∈ F) → ((∀ (i : Fin (n + 3)), ∀ (j : Fin (n + + 3)), (i ≠ j) → (({i, j} : Finset (Fin (n + 3))) ∈ c.boundary c.steps.length ↔ j = i + 1 ∨ + i = j + 1)) → ((∀ h ≤ c.steps.length, ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : + ℕ))), a ≠ b → {F ∈ c.faces h | a ∈ F ∧ b ∈ F}.card = if {a, b} ∈ c.boundary h then (1 : + ℕ) else if ∃ F ∈ c.faces h, a ∈ F ∧ b ∈ F then (2 : ℕ) else (0 : ℕ)) → ∀ (i : Fin (n + (3 + : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ≠ j → {k : Fin fs.card | i ∈ Set.range (f k) ∧ j ∈ + Set.range (f k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : + ℕ))) then (1 : ℕ) else if ∃ (k : Fin fs.card), i ∈ Set.range (f k) ∧ j ∈ Set.range (f k) + then (2 : ℕ) else (0 : ℕ)))) ) := by + classical + intro r n q p s X K t c fs f hindexed_filter_card hindexed_exists hboundary_final_pair hinc i j + hij + have hset : (Finset.univ.filter (fun k : Fin fs.card => + i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)) : Set (Fin fs.card)) = + {k : Fin fs.card | i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)} := by + ext k + simp + rw [← hset, Set.ncard_coe_finset, hindexed_filter_card] + have h := hinc c.steps.length le_rfl i j hij + by_cases hbnd : {i, j} ∈ c.boundary c.steps.length + · have hbSucc := (hboundary_final_pair i j hij).mp hbnd + by_cases hex : ∃ F ∈ fs, i ∈ F ∧ j ∈ F + · simp? [hbnd, hbSucc] at h ⊢ + exact h + · simp? [hbnd, hbSucc] at h ⊢ + exact h + · have hbSucc : ¬(j = i + 1 ∨ i = j + 1) := by + intro hsucc + exact hbnd ((hboundary_final_pair i j hij).mpr hsucc) + by_cases hex : ∃ F ∈ fs, i ∈ F ∧ j ∈ F + · have hex' : ∃ F ∈ c.faces c.steps.length, i ∈ F ∧ j ∈ F := by + simpa [fs] using hex + have hidx := (hindexed_exists i j).2 hex + have hidx' : ∃ k : Fin fs.card, (∃ y, f k y = i) ∧ ∃ y, f k y = j := by + simpa only [Set.mem_range] using hidx + simp? [hbnd, hbSucc, hex', hidx'] at h ⊢ + exact h + · have hidx : ¬∃ k : Fin fs.card, i ∈ Set.range (f k) ∧ j ∈ Set.range (f k) := by + intro hk + exact hex ((hindexed_exists i j).1 hk) + have hex' : ¬∃ F ∈ c.faces c.steps.length, i ∈ F ∧ j ∈ F := by + simpa [fs] using hex + have hidx' : ¬∃ k : Fin fs.card, (∃ y, f k y = i) ∧ ∃ y, f k y = j := by + simpa only [Set.mem_range] using hidx + simp? [hbnd, hbSucc, hex', hidx'] at h ⊢ + exact h + +private theorem hboundary0_pair : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (∀ {α : Type}, ∀ [DecidableEq α], ∀ (a : α), ∀ (b : α), ∀ (c : α), ∀ (d : α), (a ≠ b) → + ((c ≠ + d) → (({a, b} : Finset α) = {c, d} ↔ (a = c ∧ b = d) ∨ (a = d ∧ b = c)))) → (∀ (i : Fin + (r + (3 : ℕ))), ∀ (j : Fin (r + (3 : ℕ))), i ≠ j → ({s.start i, s.start j} ∈ c.boundary + (0 : ℕ) ↔ j = i + (1 : Fin (r + (3 : ℕ))) ∨ i = j + (1 : Fin (r + (3 : ℕ))))) ) := by + classical + intro r n q p s X K t c pair_eq_pair i j hij + have hzero : c.boundary 0 = Finset.univ.image (fun k : Fin (r + 3) => + ({s.start k, s.start (k + 1)} : Finset (Fin (n + 3)))) := by + rfl + rw [hzero, Finset.mem_image] + constructor + · rintro ⟨k, -, hpair⟩ + have hk : k ≠ k + 1 := by + intro heq + have hv := congrArg Fin.val heq + change k.val = (k.val + 1) % (r + 3) at hv + by_cases hlt : k.val + 1 < r + 3 + · rw [Nat.mod_eq_of_lt hlt] at hv + omega + · have heq' : k.val + 1 = r + 3 := by omega + rw [heq', Nat.mod_self] at hv + omega + rcases (pair_eq_pair (s.start i) (s.start j) (s.start k) (s.start (k + 1)) + (fun h => hij (s.start_injective h)) (fun h => hk (s.start_injective h))).mp hpair.symm with + h | h + · left + have hi' := s.start_injective h.1 + have hj' := s.start_injective h.2 + rw [← hi'] at hj' + exact hj' + · right + have hj' := s.start_injective h.2 + have hi' := s.start_injective h.1 + rw [← hj'] at hi' + exact hi' + · intro h + rcases h with h | h + · subst j + refine ⟨i, Finset.mem_univ _, ?_⟩ + rfl + · subst i + refine ⟨j, Finset.mem_univ _, ?_⟩ + exact Finset.pair_comm _ _ + +private theorem hexists_initial_pair : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (i : Fin (r + (3 : ℕ))), ∀ (j : Fin (r + (3 : ℕ))), (∃ F ∈ c.faces (0 : ℕ), s.start i ∈ + F ∧ + s.start j ∈ F) ↔ ∃ (k : Fin t.count), i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k) + ) := by + classical + intro r n q p s X K t c i j + have hp (k : Fin t.count) : + (s.start i ∈ Finset.univ.image (s.start ∘ t.face k) ∧ + s.start j ∈ Finset.univ.image (s.start ∘ t.face k)) ↔ + i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k) := by + simp only [Finset.mem_image, Finset.mem_univ, true_and, Set.mem_range] + constructor + · rintro ⟨⟨x, hx⟩, ⟨y, hy⟩⟩ + exact ⟨⟨x, s.start_injective hx⟩, ⟨y, s.start_injective hy⟩⟩ + · rintro ⟨⟨x, hx⟩, ⟨y, hy⟩⟩ + exact ⟨⟨x, congrArg s.start hx⟩, ⟨y, congrArg s.start hy⟩⟩ + constructor + · rintro ⟨F, hF, hi, hj⟩ + change F ∈ Finset.univ.image (fun k : Fin t.count => + Finset.univ.image (s.start ∘ t.face k)) at hF + rcases Finset.mem_image.mp hF with ⟨k, -, rfl⟩ + exact ⟨k, hp k |>.mp ⟨hi, hj⟩⟩ + · rintro ⟨k, hk⟩ + refine ⟨Finset.univ.image (s.start ∘ t.face k), ?_, (hp k).2 hk |>.1, + (hp k).2 hk |>.2⟩ + · change _ ∈ Finset.univ.image (fun k : Fin t.count => + Finset.univ.image (s.start ∘ t.face k)) + exact Finset.mem_image.mpr ⟨k, Finset.mem_univ _, rfl⟩ + +private theorem hboundary0_support : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ P ∈ c.boundary 0, ∀ x ∈ P, x ∈ c.vertices 0 ) := by + classical + intro r n q p s X K t c P hP x hx + change P ∈ Finset.univ.image (fun i : Fin (r + 3) => + ({s.start i, s.start (i + 1)} : Finset (Fin (n + 3)))) at hP + rcases Finset.mem_image.mp hP with ⟨i, -, rfl⟩ + change x ∈ Finset.univ.image s.start + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + rcases hx with hx | hx + · subst x + exact Finset.mem_image.mpr ⟨i, Finset.mem_univ _, rfl⟩ + · subst x + exact Finset.mem_image.mpr ⟨i + 1, Finset.mem_univ _, rfl⟩ + +private theorem hinit_ledger : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (∀ F ∈ c.faces 0, F ⊆ c.vertices 0) → ((∀ (i : Fin (r + 3)), ∀ (j : Fin (r + 3)), (i ≠ j) → + (((c.faces 0).filter (fun F => s.start i ∈ F ∧ s.start j ∈ F)).card = if {s.start i, + s.start j} ∈ c.boundary 0 then 1 else if ∃ F ∈ c.faces 0, s.start i ∈ F ∧ s.start j ∈ F + then 2 else 0)) → ((∀ P ∈ c.boundary 0, ∀ x ∈ P, x ∈ c.vertices 0) → ((∀ x ∈ c.vertices + 0, ∃ i : Fin (r + 3), s.start i = x) → (∀ a b : Fin (n + 3), a ≠ b → ((c.faces 0).filter + (fun F => a ∈ F ∧ b ∈ F)).card = if {a, b} ∈ c.boundary 0 then 1 else if ∃ F ∈ c.faces 0, + a ∈ F ∧ b ∈ F then 2 else 0)))) ) := by + classical + intro r n q p s X K t c hinit_sub hinit_ledger_starts hboundary0_support hvertex0_start a b hab + by_cases ha : ∃ i : Fin (r + 3), s.start i = a + · by_cases hb : ∃ j : Fin (r + 3), s.start j = b + · rcases ha with ⟨i, rfl⟩ + rcases hb with ⟨j, rfl⟩ + apply hinit_ledger_starts + intro hij + exact hab (congrArg s.start hij) + · have hno : ¬ ∃ F ∈ c.faces 0, a ∈ F ∧ b ∈ F := by + rintro ⟨F, hF, _, hbF⟩ + exact hb (hvertex0_start b (hinit_sub F hF hbF)) + have hnb : {a, b} ∉ c.boundary 0 := by + intro hP + exact hb (hvertex0_start b (hboundary0_support {a, b} hP b (by simp))) + have he : (c.faces 0).filter (fun F => a ∈ F ∧ b ∈ F) = ∅ := by + rw [Finset.filter_eq_empty_iff] + intro F hF hp + exact hno ⟨F, hF, hp⟩ + rw [he] + simp [hnb, hno] + · have hno : ¬ ∃ F ∈ c.faces 0, a ∈ F ∧ b ∈ F := by + rintro ⟨F, hF, haF, _⟩ + exact ha (hvertex0_start a (hinit_sub F hF haF)) + have hnb : {a, b} ∉ c.boundary 0 := by + intro hP + exact ha (hvertex0_start a (hboundary0_support {a, b} hP a (by simp))) + have he : (c.faces 0).filter (fun F => a ∈ F ∧ b ∈ F) = ∅ := by + rw [Finset.filter_eq_empty_iff] + intro F hF hp + exact hno ⟨F, hF, hp⟩ + rw [he] + simp [hnb, hno] + +private theorem hsplit_eq : + (by + classical + exact + ∀ (n : Nat), ∀ (A : Finset (Finset (Fin (n + (3 : ℕ))))), ∀ (a : Fin (n + (3 : ℕ))), ∀ (d + : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), a ≠ b → ∀ F ∈ A, a ∈ F ∧ b ∈ F → (∀ + G ∈ A, + a ∈ G ∧ b ∈ G → G = F) → (∀ G ∈ A, d ∉ G) → P3523T1BoundaryFaceSplit A a d b = A.erase + F ∪ {insert d (F.erase b), insert d (F.erase a)} ) := by + classical + intro n A a d b hab F hF hpF huniq hd + let FL := insert d (F.erase b) + let FR := insert d (F.erase a) + have hFL : FL ∉ A := by + intro h + have : d ∈ FL := Finset.mem_insert_self _ _ + exact hd FL h this + have hFR : FR ∉ A := by + intro h + have : d ∈ FR := Finset.mem_insert_self _ _ + exact hd FR h this + have hFLFR : FL ≠ FR := by + intro h + have hda : d ≠ a := by intro hda; subst d; exact hd F hF hpF.1 + have hdb : d ≠ b := by intro hdb; subst d; exact hd F hF hpF.2 + have haFL : a ∈ FL := Finset.mem_insert.mpr + (Or.inr (Finset.mem_erase.mpr ⟨hab, hpF.1⟩)) + have haFR : a ∉ FR := by simp [FR, hda.symm] + exact haFR (h ▸ haFL) + ext G + constructor + · intro hG + change G ∈ A.biUnion (fun H => + if a ∈ H ∧ b ∈ H then {insert d (H.erase b), insert d (H.erase a)} else {H}) at hG + rw [Finset.mem_biUnion] at hG + rcases hG with ⟨H, hH, hGH⟩ + by_cases hp : a ∈ H ∧ b ∈ H + · have hEq := huniq H hH hp + subst H + simp? [hpF] at hGH + rcases hGH with rfl | rfl + · simp [FL, FR, hFL, hFLFR] + · simp [FR, hFR] + · simp [hp] at hGH + subst G + have hHF : H ≠ F := by + intro h + subst H + exact hp ⟨hpF.1, hpF.2⟩ + simp [Finset.mem_erase, hHF, hH] + · intro hG + rw [Finset.mem_union] at hG + rcases hG with hG | hG + · rw [Finset.mem_erase] at hG + rcases hG with ⟨hGF, hG⟩ + have hn : ¬(a ∈ G ∧ b ∈ G) := by + intro hp + exact hGF (huniq G hG hp) + change G ∈ A.biUnion (fun H => + if a ∈ H ∧ b ∈ H then {insert d (H.erase b), insert d (H.erase a)} else {H}) + rw [Finset.mem_biUnion] + refine ⟨G, hG, ?_⟩ + simp [hn] + · simp only [Finset.mem_insert, Finset.mem_singleton] at hG + rcases hG with hG | hG + · subst G + change insert d (F.erase b) ∈ A.biUnion (fun H => + if a ∈ H ∧ b ∈ H then {insert d (H.erase b), insert d (H.erase a)} else {H}) + rw [Finset.mem_biUnion] + refine ⟨F, hF, ?_⟩ + simp [hpF] + · subst G + change insert d (F.erase a) ∈ A.biUnion (fun H => + if a ∈ H ∧ b ∈ H then {insert d (H.erase b), insert d (H.erase a)} else {H}) + rw [Finset.mem_biUnion] + refine ⟨F, hF, ?_⟩ + simp [hpF] + +private theorem hsplit_filter_card : + (by + classical + exact + ∀ (n : Nat), (∀ (A : Finset (Finset (Fin (n + 3)))), ∀ (a : Fin (n + 3)), ∀ (d : Fin (n + + 3)), ∀ (b : Fin (n + 3)), (a ≠ b) → (∀ (F : Finset (Fin (n + 3))), (F ∈ A) → ((a ∈ F ∧ b + ∈ F) → ((∀ G ∈ A, a ∈ G ∧ b ∈ G → G = F) → ((∀ G ∈ A, d ∉ G) → + (P3523T1BoundaryFaceSplit A a d b = A.erase F ∪ {insert d (F.erase b), + insert d (F.erase a)})))))) → (∀ (A : Finset (Finset (Fin (n + (3 : ℕ))))), ∀ (a : Fin (n + + (3 : ℕ))), ∀ (d : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), a ≠ b → ∀ F ∈ A, a ∈ F + ∧ b ∈ F → (∀ G ∈ A, a ∈ G ∧ b ∈ G → G = F) → (∀ G ∈ A, d ∉ G) → ∀ (P : Finset (Fin (n + + (3 : ℕ))) → Prop), ∀ [inst : DecidablePred P], (Finset.filter P + (P3523T1BoundaryFaceSplit A a d b)).card = ((Finset.filter P (A.erase F)).card + if P + (insert d (F.erase b)) then (1 : ℕ) else (0 : ℕ)) + if P (insert d (F.erase a)) then (1 : + ℕ) else (0 : ℕ)) ) := by + classical + intro n hsplit_eq A a d b hab F hF hpF huniq hd P typeclassInstance0 + have heq := hsplit_eq A a d b hab F hF hpF huniq hd + have hFL : insert d (F.erase b) ∉ A := by + intro h + exact hd _ h (Finset.mem_insert_self _ _) + have hFR : insert d (F.erase a) ∉ A := by + intro h + exact hd _ h (Finset.mem_insert_self _ _) + have hneq : insert d (F.erase b) ≠ insert d (F.erase a) := by + intro h + have hda : d ≠ a := by intro hda; subst d; exact hd F hF hpF.1 + have haL : a ∈ insert d (F.erase b) := + Finset.mem_insert.mpr (Or.inr (Finset.mem_erase.mpr ⟨hab, hpF.1⟩)) + have haR : a ∉ insert d (F.erase a) := by simp [hda.symm] + exact haR (h ▸ haL) + have hDisj : Disjoint ((A.erase F).filter P) + (({insert d (F.erase b), insert d (F.erase a)} : Finset (Finset (Fin (n + 3)))).filter P) + := by + apply Finset.disjoint_left.mpr + intro G hG1 hG2 + rcases Finset.mem_filter.mp hG1 with ⟨hG1, _⟩ + rcases Finset.mem_filter.mp hG2 with ⟨hG2, _⟩ + have hGA : G ∈ A := Finset.mem_of_mem_erase hG1 + simp only [Finset.mem_insert, Finset.mem_singleton] at hG2 + rcases hG2 with hG2 | hG2 + · subst G + exact hFL hGA + · subst G + exact hFR hGA + rw [heq, Finset.filter_union, Finset.card_union_of_disjoint hDisj] + by_cases h1 : P (insert d (F.erase b)) <;> + by_cases h2 : P (insert d (F.erase a)) <;> + simp [Finset.filter_insert, Finset.filter_singleton, h1, h2, hneq] + +private theorem herase_filter_card : + (by + classical + exact + ∀ (n : Nat), ∀ (A : Finset (Finset (Fin (n + (3 : ℕ))))), ∀ F ∈ A, ∀ (P : Finset (Fin (n + + (3 + : ℕ))) → Prop), ∀ [inst : DecidablePred P], (Finset.filter P A).card = (Finset.filter P + (A.erase F)).card + if P F then (1 : ℕ) else (0 : ℕ) ) := by + classical + intro n A F hF P typeclassInstance0 + have heq : A.filter P = (A.erase F).filter P ∪ ({F} : Finset (Finset (Fin (n + 3)))).filter P + := by + ext G + by_cases hGF : G = F <;> simp [hGF, hF] + have hdisj : Disjoint ((A.erase F).filter P) + (({F} : Finset (Finset (Fin (n + 3)))).filter P) := by + apply Finset.disjoint_left.mpr + intro G hG1 hG2 + rcases Finset.mem_filter.mp hG1 with ⟨hG1, _⟩ + rcases Finset.mem_filter.mp hG2 with ⟨hG2, _⟩ + exact (Finset.mem_erase.mp hG1).1 (by simpa using hG2) + rw [heq, Finset.card_union_of_disjoint hdisj] + by_cases hPF : P F <;> simp [Finset.filter_singleton, hPF] + +private theorem hfilter_exists_iff_pos : + (by + classical + exact + ∀ (n : Nat), ∀ (A : Finset (Finset (Fin (n + (3 : ℕ))))), ∀ (P : Finset (Fin (n + (3 : + ℕ))) → + Prop), ∀ [inst : DecidablePred P], (∃ F ∈ A, P F) ↔ (0 : ℕ) < (Finset.filter P A).card ) + := by + classical + intro n A P typeclassInstance0 + constructor + · rintro ⟨F, hF, hP⟩ + apply Finset.card_pos.mpr + exact ⟨F, Finset.mem_filter.mpr ⟨hF, hP⟩⟩ + · intro hpos + obtain ⟨F, hF⟩ := Finset.card_pos.mp hpos + exact ⟨F, (Finset.mem_filter.mp hF).1, (Finset.mem_filter.mp hF).2⟩ + +private theorem old_pair_split_indicators : + (by + classical + exact + ∀ (n : Nat), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (z : Fin (n + (3 : + ℕ))), ∀ (d : Fin (n + (3 : ℕ))), ∀ (x : Fin (n + (3 : ℕ))), ∀ (y : Fin (n + (3 : + ℕ))), a ≠ b → + a ≠ z → b ≠ z → x ≠ y → x ≠ d → y ≠ d → (if x ∈ ({a, b, z} : Finset (Fin (n + 3))) ∧ y ∈ + ({a, b, z} : Finset (Fin (n + 3))) then (1 : ℕ) + else (0 : ℕ)) = ((if x ∈ ({a, d, z} : Finset (Fin (n + 3))) ∧ y ∈ ({a, d, z} : Finset + (Fin (n + 3))) then (1 : ℕ) else (0 : ℕ)) + if x ∈ + ({d, b, z} : Finset (Fin (n + 3))) ∧ y ∈ ({d, b, z} : Finset (Fin (n + 3))) then (1 : ℕ) + else (0 : ℕ)) + if x = a ∧ y = b ∨ x = b ∧ y = a + then (1 : ℕ) else (0 : ℕ) ) := by + classical + intro n a b z d x y hab haz hbz hxy hxd hyd + by_cases hxa : x = a <;> by_cases hxb : x = b <;> + by_cases hxz : x = z <;> by_cases hya : y = a <;> + by_cases hyb : y = b <;> by_cases hyz : y = z <;> + simp_all [Finset.mem_insert, Finset.mem_singleton] + +private theorem old_boundary_membership : + (by + classical + exact + ∀ (n : Nat), ∀ (B : Finset (Finset (Fin (n + (3 : ℕ))))), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b + : Fin (n + (3 : ℕ))), ∀ (d : Fin (n + (3 : ℕ))), ∀ (x : Fin (n + (3 : ℕ))), ∀ (y : + Fin (n + + (3 : ℕ))), x ≠ d → y ≠ d → (({x, y} : Finset (Fin (n + 3))) ∈ insert ({a, d} : Finset + (Fin (n + 3))) (insert ({d, b} : Finset (Fin (n + 3))) (B.erase ({a, b} : Finset (Fin + (n + 3))))) ↔ {x, + y} ∈ B ∧ ({x, y} : Finset (Fin (n + 3))) ≠ ({a, b} : Finset (Fin (n + 3)))) ) := by + classical + intro n B a b d x y hxd hyd + have hleft : ({x, y} : Finset _) ≠ {a, d} := by + intro h + have hdmem : d ∈ ({x, y} : Finset _) := by rw [h]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at hdmem + exact hdmem.elim (fun h => hxd h.symm) (fun h => hyd h.symm) + have hright : ({x, y} : Finset _) ≠ {d, b} := by + intro h + have hdmem : d ∈ ({x, y} : Finset _) := by rw [h]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at hdmem + exact hdmem.elim (fun h => hxd h.symm) (fun h => hyd h.symm) + simp only [Finset.mem_insert, Finset.mem_erase, hleft, hright, false_or] + exact and_comm + +private theorem hledger : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (∀ (h : ℕ), ∀ (hh : h < (P3523T1InsertionConstruction s t).steps.length), + let e := + (P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩; e.1 ≠ e.2.2 ∧ e.1 ∈ + (P3523T1InsertionConstruction s t).vertices h ∧ e.2.2 ∈ (P3523T1InsertionConstruction + s t).vertices h ∧ e.2.1 ∉ (P3523T1InsertionConstruction s t).vertices h ∧ {e.1, e.2.2} + ∈ (P3523T1InsertionConstruction s t).boundary h ∧ ∃ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : ℝ) + ∧ p.vertex e.2.1 = ((1 : ℝ) - u) • p.vertex e.1 + u • p.vertex e.2.2 ∧ + P3523T1InterpolatedTarget s t e.2.1 = ((1 : ℝ) - u) • P3523T1InterpolatedTarget s t + e.1 + u • P3523T1InterpolatedTarget s t e.2.2) → ((∀ (h : Nat), ∀ (hh : h < + c.steps.length), c.faces (h + 1) = P3523T1BoundaryFaceSplit (c.faces h) (c.steps.get + ⟨h, hh⟩).1 (c.steps.get ⟨h, hh⟩).2.1 (c.steps.get ⟨h, hh⟩).2.2) → ((∀ (h : Nat), ∀ (hh : + h < c.steps.length), c.boundary (h + 1) = insert {(c.steps.get ⟨h, hh⟩).1, + (c.steps.get ⟨h, hh⟩).2.1} (insert {(c.steps.get ⟨h, hh⟩).2.1, (c.steps.get ⟨h, hh⟩).2.2} + ((c.boundary h).erase {(c.steps.get ⟨h, hh⟩).1, (c.steps.get ⟨h, hh⟩).2.2}))) → ((∀ h : + Nat, h ≤ c.steps.length → ∀ F ∈ c.faces h, F.card = 3 ∧ F ⊆ c.vertices h) → ((∀ h : Nat, + h ≤ c.steps.length → ∀ P ∈ c.boundary h, ∀ x ∈ P, x ∈ c.vertices h) → ((∀ (F : Finset + (Fin (n + 3))), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), (a ≠ b) → ((F.card = 3) → ((a ∈ + F) → ((b ∈ F) → (∃ x, x ≠ a ∧ x ≠ b ∧ F = {a, b, x}))))) → ((∀ {α : Type}, ∀ [DecidableEq + α], ∀ (a : α), ∀ (b : α), ∀ (c : α), ∀ (d : α), (a ≠ b) → ((c ≠ d) → (({a, b} : Finset α) + = {c, d} ↔ (a = c ∧ b = d) ∨ (a = d ∧ b = c)))) → ((∀ a b : Fin (n + 3), a ≠ b → + ((c.faces 0).filter (fun F => a ∈ F ∧ b ∈ F)).card = if {a, b} ∈ c.boundary 0 then 1 else + if ∃ F ∈ c.faces 0, a ∈ F ∧ b ∈ F then 2 else 0) → ((∀ (A : Finset (Finset (Fin (n + + 3)))), ∀ (a : Fin (n + 3)), ∀ (d : Fin (n + 3)), ∀ (b : Fin (n + 3)), (a ≠ b) → (∀ (F : + Finset (Fin (n + 3))), (F ∈ A) → ((a ∈ F ∧ b ∈ F) → ((∀ G ∈ A, a ∈ G ∧ b ∈ G → G = F) → + ((∀ G ∈ A, d ∉ G) → (∀ (P : Finset (Fin (n + 3)) → Prop), ∀ [DecidablePred P], + ((P3523T1BoundaryFaceSplit A a d b).filter P).card = ((A.erase F).filter P).card + (if + P (insert d (F.erase b)) then 1 else 0) + (if P (insert d (F.erase a)) then 1 else + 0))))))) → ((∀ (A : Finset (Finset (Fin (n + 3)))), ∀ (F : Finset (Fin (n + 3))), (F ∈ A) + → (∀ (P : Finset (Fin (n + 3)) → Prop), ∀ [DecidablePred P], (A.filter P).card = + ((A.erase F).filter P).card + if P F then 1 else 0)) → ((∀ (A : Finset (Finset (Fin (n + + 3)))), ∀ (P : Finset (Fin (n + 3)) → Prop), ∀ [DecidablePred P], (∃ F ∈ A, P F) ↔ 0 < + (A.filter P).card) → ((∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (z : Fin (n + 3)), ∀ + (d : Fin (n + 3)), ∀ (x : Fin (n + 3)), ∀ (y : Fin (n + 3)), (a ≠ b) → ((a ≠ z) → ((b ≠ + z) → ((x ≠ y) → ((x ≠ d) → ((y ≠ d) → ((if x ∈ ({a, b, z} : Finset _) ∧ y ∈ ({a, b, z} : + Finset _) then 1 else 0 : Nat) = (if x ∈ ({a, d, z} : Finset _) ∧ y ∈ ({a, d, z} : Finset + _) then 1 else 0) + (if x ∈ ({d, b, z} : Finset _) ∧ y ∈ ({d, b, z} : Finset _) then 1 + else 0) + (if (x = a ∧ y = b) ∨ (x = b ∧ y = a) then 1 else 0)))))))) → ((∀ (B : Finset + (Finset (Fin (n + 3)))), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (d : Fin (n + 3)), ∀ + (x : Fin (n + 3)), ∀ (y : Fin (n + 3)), (x ≠ d) → ((y ≠ d) → (({x, y} : Finset _) ∈ + insert {a, d} (insert {d, b} (B.erase {a, b})) ↔ ({x, y} : Finset _) ∈ B ∧ ({x, y} : + Finset _) ≠ {a, b}))) → ((∀ (A : Finset (Finset (Fin (n + 3)))), ∀ (x : Fin (n + 3)), ∀ + (y : Fin (n + 3)), (A.filter (fun F => x ∈ F ∧ y ∈ F)).card = (A.filter (fun F => y ∈ + F ∧ + x ∈ F)).card) → ((∀ (old : Nat), ∀ (new : Nat), ∀ (onBoundary : Prop), ∀ (removed : + Prop), ∀ [Decidable onBoundary], ∀ [Decidable removed], (old = if onBoundary then 1 else + if 0 < old then 2 else 0) → ((removed → onBoundary) → ((old = new + (if removed then 1 + else 0)) → (new = if onBoundary ∧ ¬ removed then 1 else if 0 < new then 2 else 0)))) → (∀ + h : Nat, h ≤ c.steps.length → ∀ a b : Fin (n + 3), a ≠ b → ((c.faces h).filter (fun F => + a ∈ F ∧ b ∈ F)).card = if {a, b} ∈ c.boundary h then 1 else if ∃ F ∈ c.faces h, a ∈ F ∧ b + ∈ F then 2 else 0))))))))))))))) ) := by + classical + intro r n q p s X K t c hsteps hfaces_next hboundary_next hstage hboundary_support hthird + pair_eq_pair hinit_ledger hsplit_filter_card herase_filter_card hfilter_exists_iff_pos + old_pair_split_indicators old_boundary_membership pair_filter_card_symmetry + old_pair_ledger_transfer h hh + induction h with + | zero => exact hinit_ledger + | succ h ih => + have hlt : h < c.steps.length := by omega + have ih' := ih (by omega) + let e := c.steps.get ⟨h, hlt⟩ + have he := hsteps h hlt + dsimp [e] at he + rcases he with ⟨hab, ha, hb, hd, hEdge, _⟩ + change e.1 ≠ e.2.2 at hab + change e.1 ∈ c.vertices h at ha + change e.2.2 ∈ c.vertices h at hb + change e.2.1 ∉ c.vertices h at hd + change {e.1, e.2.2} ∈ c.boundary h at hEdge + have hcountAB : ((c.faces h).filter + (fun G => e.1 ∈ G ∧ e.2.2 ∈ G)).card = 1 := by + have hprev := ih' e.1 e.2.2 hab + rw [ite_eq_left hEdge] at hprev + exact hprev + rcases Finset.card_eq_one.mp hcountAB with ⟨F, hfilter⟩ + have hFfilter : F ∈ (c.faces h).filter + (fun G => e.1 ∈ G ∧ e.2.2 ∈ G) := by + rw [hfilter] + simp + rcases Finset.mem_filter.mp hFfilter with ⟨hF, hpF⟩ + have huniq : ∀ G ∈ c.faces h, e.1 ∈ G ∧ e.2.2 ∈ G → G = F := by + intro G hG hp + have hGfilter : G ∈ (c.faces h).filter + (fun H => e.1 ∈ H ∧ e.2.2 ∈ H) := Finset.mem_filter.mpr ⟨hG, hp⟩ + rw [hfilter] at hGfilter + simpa using hGfilter + have hdFaces : ∀ G ∈ c.faces h, e.2.1 ∉ G := by + intro G hG hdG + exact hd ((hstage h (by omega) G hG).2 hdG) + have hthirdF := hthird F e.1 e.2.2 hab + (hstage h (by omega) F hF).1 hpF.1 hpF.2 + rcases hthirdF with ⟨z, hza, hzb, hFtriple⟩ + let A := c.faces h + let N := P3523T1BoundaryFaceSplit A e.1 e.2.1 e.2.2 + let B := insert {e.1, e.2.1} + (insert {e.2.1, e.2.2} ((c.boundary h).erase {e.1, e.2.2})) + have hda : e.2.1 ≠ e.1 := by + intro heq + exact hd (heq ▸ ha) + have hdb : e.2.1 ≠ e.2.2 := by + intro heq + exact hd (heq ▸ hb) + have hzF : z ∈ F := by rw [hFtriple]; simp + have hdz : e.2.1 ≠ z := by + intro heq + exact hd (heq ▸ (hstage h (by omega) F hF).2 hzF) + have hleftTriple : insert e.2.1 (F.erase e.2.2) = {e.1, e.2.1, z} := by + clear * - e F z hab hza hzb hFtriple + rw [hFtriple] + ext w + by_cases hwa : w = e.1 <;> by_cases hwb : w = e.2.2 <;> + by_cases hwz : w = z <;> + simp_all [Finset.mem_insert, Finset.mem_singleton, Finset.mem_erase] + have hrightTriple : insert e.2.1 (F.erase e.1) = {e.2.1, e.2.2, z} := by + clear * - e F z hab hza hzb hFtriple + rw [hFtriple] + ext w + by_cases hwa : w = e.1 <;> by_cases hwb : w = e.2.2 <;> + by_cases hwz : w = z <;> + simp_all [Finset.mem_insert, Finset.mem_singleton, Finset.mem_erase] + have hnoB (w : Fin (n + 3)) : {e.2.1, w} ∉ c.boundary h := by + intro hP + exact hd (hboundary_support h (by omega) {e.2.1, w} hP e.2.1 (by simp)) + -- The fresh label occurs only in the two replacement faces. + have hcountFresh (w : Fin (n + 3)) (hdw : e.2.1 ≠ w) : + (N.filter (fun G => e.2.1 ∈ G ∧ w ∈ G)).card = + (if w = e.1 ∨ w = z then 1 else 0) + + (if w = e.2.2 ∨ w = z then 1 else 0) := by + have hzero : ((A.erase F).filter + (fun G => e.2.1 ∈ G ∧ w ∈ G)).card = 0 := by + have hempty : (A.erase F).filter + (fun G => e.2.1 ∈ G ∧ w ∈ G) = ∅ := by + apply Finset.filter_eq_empty_iff.mpr + intro G hG hp + exact hdFaces G (Finset.mem_of_mem_erase hG) hp.1 + rw [hempty, Finset.card_empty] + dsimp only [N] + rw [hsplit_filter_card A e.1 e.2.1 e.2.2 hab F hF hpF huniq hdFaces, + hzero, hleftTriple, hrightTriple] + simp [hdw.symm, hda, hdb, hdz] + have hboundaryFresh (w : Fin (n + 3)) (hdw : e.2.1 ≠ w) : + {e.2.1, w} ∈ B ↔ w = e.1 ∨ w = e.2.2 := by + have hleft := pair_eq_pair e.2.1 w e.1 e.2.1 hdw hda.symm + have hright := pair_eq_pair e.2.1 w e.2.1 e.2.2 hdw hdb + dsimp only [B] + simp only [Finset.mem_insert, Finset.mem_erase] + simp [hleft, hright, hda, hdb, hnoB w] + have hfresh (w : Fin (n + 3)) (hdw : e.2.1 ≠ w) : + (N.filter (fun G => e.2.1 ∈ G ∧ w ∈ G)).card = + if {e.2.1, w} ∈ B then 1 + else if 0 < (N.filter (fun G => e.2.1 ∈ G ∧ w ∈ G)).card then 2 else 0 := by + simp only [hboundaryFresh w hdw, hcountFresh w hdw] + by_cases hwa : w = e.1 + · subst w + simp [hab, hza.symm] + · by_cases hwb : w = e.2.2 + · subst w + simp [hab.symm, hzb.symm] + · by_cases hwz : w = z + · subst w + simp [hza, hzb] + · simp [hwa, hwb, hwz] + intro x y hxy + rw [hfaces_next h hlt, hboundary_next h hlt] + change (N.filter (fun G => x ∈ G ∧ y ∈ G)).card = + if {x, y} ∈ B then 1 + else if ∃ G ∈ N, x ∈ G ∧ y ∈ G then 2 else 0 + simp only [hfilter_exists_iff_pos N (fun G => x ∈ G ∧ y ∈ G)] + by_cases hxd : x = e.2.1 + · subst x + exact hfresh y hxy + · by_cases hyd : y = e.2.1 + · subst y + rw [pair_filter_card_symmetry N x e.2.1, Finset.pair_comm x e.2.1] + exact hfresh x hxy.symm + · have hindicator := old_pair_split_indicators e.1 e.2.2 z e.2.1 x y + hab hza.symm hzb.symm hxy hxd hyd + simp only [← hFtriple, ← hleftTriple, ← hrightTriple, + ← pair_eq_pair x y e.1 e.2.2 hxy hab] at hindicator + have herase := herase_filter_card A F hF (fun G => x ∈ G ∧ y ∈ G) + have hsplit := hsplit_filter_card A e.1 e.2.1 e.2.2 + hab F hF hpF huniq hdFaces (fun G => x ∈ G ∧ y ∈ G) + have hdelta : (A.filter (fun G => x ∈ G ∧ y ∈ G)).card = + (N.filter (fun G => x ∈ G ∧ y ∈ G)).card + + if ({x, y} : Finset (Fin (n + 3))) = {e.1, e.2.2} then 1 else 0 := by + dsimp only [N] + omega + have hprev := ih' x y hxy + change (A.filter (fun G => x ∈ G ∧ y ∈ G)).card = + if {x, y} ∈ c.boundary h then 1 + else if ∃ G ∈ A, x ∈ G ∧ y ∈ G then 2 else 0 at hprev + simp only [hfilter_exists_iff_pos A (fun G => x ∈ G ∧ y ∈ G)] at hprev + have hremove : ({x, y} : Finset _) = {e.1, e.2.2} → + {x, y} ∈ c.boundary h := by + intro heq + rw [heq] + exact hEdge + have hboundaryOld := old_boundary_membership + (c.boundary h) e.1 e.2.2 e.2.1 x y hxd hyd + change ({x, y} ∈ B ↔ _) at hboundaryOld + simp only [hboundaryOld] + exact old_pair_ledger_transfer _ _ _ _ hprev hremove hdelta + +private theorem hselected_face : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (∀ (h : ℕ), ∀ (hh : h < (P3523T1InsertionConstruction s t).steps.length), + let e := + (P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩; e.1 ≠ e.2.2 ∧ e.1 ∈ + (P3523T1InsertionConstruction s t).vertices h ∧ e.2.2 ∈ (P3523T1InsertionConstruction + s t).vertices h ∧ e.2.1 ∉ (P3523T1InsertionConstruction s t).vertices h ∧ {e.1, e.2.2} + ∈ (P3523T1InsertionConstruction s t).boundary h ∧ ∃ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : ℝ) + ∧ p.vertex e.2.1 = ((1 : ℝ) - u) • p.vertex e.1 + u • p.vertex e.2.2 ∧ + P3523T1InterpolatedTarget s t e.2.1 = ((1 : ℝ) - u) • P3523T1InterpolatedTarget s t + e.1 + u • P3523T1InterpolatedTarget s t e.2.2) → ((∀ h : Nat, h ≤ c.steps.length → ∀ a + b : Fin (n + 3), a ≠ b → ((c.faces h).filter (fun F => a ∈ F ∧ b ∈ F)).card = if {a, b} ∈ + c.boundary h then 1 else if ∃ F ∈ c.faces h, a ∈ F ∧ b ∈ F then 2 else 0) → (∀ (h : ℕ), ∀ + (hh : h < c.steps.length), ∃ F ∈ c.faces h, (c.steps.get ⟨h, hh⟩).1 ∈ F ∧ (c.steps.get + ⟨h, hh⟩).2.2 ∈ F)) ) := by + classical + intro r n q p s X K t c hsteps hledger h hh + let e := c.steps.get ⟨h, hh⟩ + have he := hsteps h hh + dsimp [e] at he + rcases he with ⟨hab, _, _, _, hEdge, _⟩ + change {e.1, e.2.2} ∈ c.boundary h at hEdge + have hcount := hledger h (by omega) e.1 e.2.2 hab + rw [ite_eq_left hEdge] at hcount + have hpos : 0 < ((c.faces h).filter + (fun F => e.1 ∈ F ∧ e.2.2 ∈ F)).card := by omega + obtain ⟨F, hF⟩ := Finset.card_pos.mp hpos + exact ⟨F, (Finset.mem_filter.mp hF).1, (Finset.mem_filter.mp hF).2.1, + (Finset.mem_filter.mp hF).2.2⟩ + +private theorem husage : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (∀ (h : ℕ), ∀ (hh : h < (P3523T1InsertionConstruction s t).steps.length), + let e := + (P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩; e.1 ≠ e.2.2 ∧ e.1 ∈ + (P3523T1InsertionConstruction s t).vertices h ∧ e.2.2 ∈ (P3523T1InsertionConstruction + s t).vertices h ∧ e.2.1 ∉ (P3523T1InsertionConstruction s t).vertices h ∧ {e.1, e.2.2} + ∈ (P3523T1InsertionConstruction s t).boundary h ∧ ∃ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : ℝ) + ∧ p.vertex e.2.1 = ((1 : ℝ) - u) • p.vertex e.1 + u • p.vertex e.2.2 ∧ + P3523T1InterpolatedTarget s t e.2.1 = ((1 : ℝ) - u) • P3523T1InterpolatedTarget s t + e.1 + u • P3523T1InterpolatedTarget s t e.2.2) → ((∀ (h : Nat), ∀ (hh : h < + c.steps.length), c.faces (h + 1) = P3523T1BoundaryFaceSplit (c.faces h) (c.steps.get + ⟨h, hh⟩).1 (c.steps.get ⟨h, hh⟩).2.1 (c.steps.get ⟨h, hh⟩).2.2) → ((∀ (h : Nat), ∀ (hh : + h < c.steps.length), c.vertices (h + 1) = insert (c.steps.get ⟨h, hh⟩).2.1 (c.vertices + h)) → ((∀ h : Nat, h ≤ c.steps.length → ∀ F ∈ c.faces h, F.card = 3 ∧ F ⊆ c.vertices h) → + ((∀ (F : Finset (Fin (n + 3))), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), (a ≠ b) → + ((F.card = 3) → ((a ∈ F) → ((b ∈ F) → (∃ x, x ≠ a ∧ x ≠ b ∧ F = {a, b, x}))))) → ((∀ x ∈ + c.vertices 0, ∃ i : Fin (r + 3), s.start i = x) → ((∀ h : Nat, h ≤ c.steps.length → ∀ a b + : Fin (n + 3), a ≠ b → ((c.faces h).filter (fun F => a ∈ F ∧ b ∈ F)).card = if {a, b} ∈ + c.boundary h then 1 else if ∃ F ∈ c.faces h, a ∈ F ∧ b ∈ F then 2 else 0) → ((∀ (h : + Nat), ∀ (hh : h < c.steps.length), ∃ F ∈ c.faces h, (c.steps.get ⟨h, hh⟩).1 ∈ F ∧ + (c.steps.get ⟨h, hh⟩).2.2 ∈ F) → (∀ h : Nat, h ≤ c.steps.length → ∀ x ∈ c.vertices h, ∃ F + ∈ c.faces h, x ∈ F)))))))) ) := by + classical + intro r n q p s X K t c hsteps hfaces_next hvertices_next hstage hthird hvertex0_start hledger + hselected_face h hh + induction h with + | zero => + intro x hx + rcases hvertex0_start x hx with ⟨i, rfl⟩ + rcases t.vertex_used i with ⟨k, j, hj⟩ + refine ⟨Finset.univ.image (s.start ∘ t.face k), ?_, ?_⟩ + · change _ ∈ Finset.univ.image (fun k : Fin t.count => + Finset.univ.image (s.start ∘ t.face k)) + exact Finset.mem_image.mpr ⟨k, Finset.mem_univ _, rfl⟩ + · exact Finset.mem_image.mpr ⟨j, Finset.mem_univ _, congrArg s.start hj⟩ + | succ h ih => + have hlt : h < c.steps.length := by omega + have ih' := ih (by omega) + let e := c.steps.get ⟨h, hlt⟩ + have he := hsteps h hlt + dsimp [e] at he + rcases he with ⟨hab, ha, hb, hd, _, _⟩ + obtain ⟨F, hF, hFa, hFb⟩ := hselected_face h hlt + have huniq : ∀ G ∈ c.faces h, e.1 ∈ G ∧ e.2.2 ∈ G → G = F := by + intro G hG hp + have hcnt := hledger h (by omega) e.1 e.2.2 hab + have hEdge := (hsteps h hlt).2.2.2.2.1 + change {e.1, e.2.2} ∈ c.boundary h at hEdge + rw [ite_eq_left hEdge] at hcnt + have hGmem : G ∈ (c.faces h).filter + (fun H => e.1 ∈ H ∧ e.2.2 ∈ H) := Finset.mem_filter.mpr ⟨hG, hp⟩ + have hFmem : F ∈ (c.faces h).filter + (fun H => e.1 ∈ H ∧ e.2.2 ∈ H) := Finset.mem_filter.mpr ⟨hF, ⟨hFa, hFb⟩⟩ + rcases Finset.card_eq_one.mp hcnt with ⟨H, hH⟩ + have hG' : G ∈ ({H} : Finset (Finset (Fin (n + 3)))) := by + rw [← hH] + exact hGmem + have hF' : F ∈ ({H} : Finset (Finset (Fin (n + 3)))) := by + rw [← hH] + exact hFmem + have hGH : G = H := by simpa using hG' + have hFH : F = H := by simpa using hF' + exact hGH.trans hFH.symm + intro x hx + rw [hvertices_next h hlt] at hx + simp only [Finset.mem_insert] at hx + rcases hx with hx | hx + · subst x + rcases hthird F e.1 e.2.2 hab (hstage h (by omega) F hF).1 hFa hFb with + ⟨z, hza, hzb, hFtriple⟩ + refine ⟨insert e.2.1 (F.erase e.2.2), ?_, ?_⟩ + · rw [hfaces_next h hlt] + change insert e.2.1 (F.erase e.2.2) ∈ + (c.faces h).biUnion (fun G => + if e.1 ∈ G ∧ e.2.2 ∈ G then + {insert e.2.1 (G.erase e.2.2), insert e.2.1 (G.erase e.1)} else {G}) + rw [Finset.mem_biUnion] + refine ⟨F, hF, ?_⟩ + rw [ite_eq_left ⟨hFa, hFb⟩] + exact Finset.mem_insert_self _ _ + · exact Finset.mem_insert_self _ _ + · rcases ih' x hx with ⟨G, hG, hxG⟩ + by_cases hGF : G = F + · subst G + rcases hthird F e.1 e.2.2 hab (hstage h (by omega) F hF).1 hFa hFb with + ⟨z, hza, hzb, hFtriple⟩ + have hxCases : x = e.1 ∨ x = e.2.2 ∨ x = z := by + rw [hFtriple] at hxG + simpa only [Finset.mem_insert, Finset.mem_singleton] using hxG + rcases hxCases with hxA | hxB | hxZ + · subst x + refine ⟨insert e.2.1 (F.erase e.2.2), ?_, ?_⟩ + · rw [hfaces_next h hlt] + change insert e.2.1 (F.erase e.2.2) ∈ (c.faces h).biUnion _ + rw [Finset.mem_biUnion] + refine ⟨F, hF, ?_⟩ + rw [ite_eq_left ⟨hFa, hFb⟩] + exact Finset.mem_insert_self _ _ + · exact Finset.mem_insert.mpr (Or.inr + (Finset.mem_erase.mpr ⟨hab, hFa⟩)) + · subst x + refine ⟨insert e.2.1 (F.erase e.1), ?_, ?_⟩ + · rw [hfaces_next h hlt] + change insert e.2.1 (F.erase e.1) ∈ (c.faces h).biUnion _ + rw [Finset.mem_biUnion] + refine ⟨F, hF, ?_⟩ + rw [ite_eq_left ⟨hFa, hFb⟩] + exact Finset.mem_insert.mpr (Or.inr + (Finset.mem_singleton.mpr rfl)) + · exact Finset.mem_insert.mpr (Or.inr + (Finset.mem_erase.mpr ⟨(fun hba => hab hba.symm), hFb⟩)) + · subst x + refine ⟨insert e.2.1 (F.erase e.2.2), ?_, ?_⟩ + · rw [hfaces_next h hlt] + change insert e.2.1 (F.erase e.2.2) ∈ (c.faces h).biUnion _ + rw [Finset.mem_biUnion] + refine ⟨F, hF, ?_⟩ + rw [ite_eq_left ⟨hFa, hFb⟩] + exact Finset.mem_insert_self _ _ + · have hzF : z ∈ F := by rw [hFtriple]; simp + exact Finset.mem_insert.mpr (Or.inr + (Finset.mem_erase.mpr ⟨hzb, hzF⟩)) + · have hnot : ¬(e.1 ∈ G ∧ e.2.2 ∈ G) := by + intro hp + exact hGF (huniq G hG hp) + refine ⟨G, ?_, hxG⟩ + rw [hfaces_next h hlt] + change G ∈ (c.faces h).biUnion _ + rw [Finset.mem_biUnion] + refine ⟨G, hG, ?_⟩ + change G ∈ (if e.1 ∈ G ∧ e.2.2 ∈ G then + {insert e.2.1 (G.erase e.2.2), insert e.2.1 (G.erase e.1)} else {G}) + rw [ite_eq_right hnot] + simp + +end InsertionIncidenceProof + +namespace InsertionDetails + +private theorem hinner : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (k + : Fin t.count), (Finset.image (s.start ∘ t.face k) Finset.univ).card = (3 : ℕ) ) := by + classical + intro r n q p s X K t k + rw [Finset.card_image_of_injective] + · simp + · intro i j hij + apply t.face_injective k + exact s.start_injective hij + +private theorem hinit : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (∀ (k : Fin t.count), (Finset.univ.image (s.start ∘ t.face k)).card = 3) → (∀ F ∈ c.faces + 0, F.card = 3) ) := by + classical + intro r n q p s X K t c hinner F hF + change F ∈ Finset.univ.image + (fun k : Fin t.count => Finset.univ.image (s.start ∘ t.face k)) at hF + rcases Finset.mem_image.mp hF with ⟨k, -, rfl⟩ + exact hinner k + +private theorem hinit_sub : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ F ∈ c.faces 0, F ⊆ c.vertices 0 ) := by + classical + intro r n q p s X K t c F hF x hx + change F ∈ Finset.univ.image + (fun k : Fin t.count => Finset.univ.image (s.start ∘ t.face k)) at hF + rcases Finset.mem_image.mp hF with ⟨k, -, rfl⟩ + change x ∈ Finset.univ.image (s.start ∘ t.face k) at hx + rcases Finset.mem_image.mp hx with ⟨j, -, rfl⟩ + change s.start (t.face k j) ∈ Finset.univ.image s.start + exact Finset.mem_image.mpr ⟨_, Finset.mem_univ _, rfl⟩ + +private theorem hvertices_next : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ (h : ℕ), ∀ (hh : h < c.steps.length), c.vertices (h + (1 : ℕ)) = insert (c.steps.get + ⟨h, hh⟩).2.1 (c.vertices h) ) := by + classical + intro r n q p s X K t c h hh + change (c.steps.take (h + 1)).foldl + (fun vs e => insert e.2.1 vs) (Finset.univ.image s.start) = + insert (c.steps.get ⟨h, hh⟩).2.1 + ((c.steps.take h).foldl (fun vs e => insert e.2.1 vs) (Finset.univ.image s.start)) + rw [← List.take_append_getElem hh] + simp only [List.foldl_append, List.foldl_cons, List.foldl_nil] + simp only [List.get_eq_getElem] + +private theorem hfinal_card : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (∀ h : Nat, h ≤ c.steps.length → ∀ F ∈ c.faces h, F.card = 3 ∧ F ⊆ c.vertices h) → ( + let fs := c.faces c.steps.length + ∀ F ∈ fs, F.card = 3) ) := by + classical + intro r n q p s X K t c hstage fs F hF + exact (hstage c.steps.length le_rfl F hF).1 + +private theorem hf_spec : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + let fs := c.faces c.steps.length + let f := P3523T1FaceEnumeration fs + (∀ (k : Fin fs.card), ∃ g : Fin 3 → Fin (n + 3), Function.Injective g ∧ Set.range g = + ((fs.equivFin.symm k).val : Set (Fin (n + 3)))) → (∀ (k : Fin fs.card), + Function.Injective (f k) ∧ Set.range (f k) = (↑(↑((fs.equivFin.symm : Fin fs.card → + ↥fs) k) : Finset (Fin (n + (3 : ℕ)))) : Set (Fin (n + (3 : ℕ))))) ) := by + classical + intro r n q p s X K t c fs f hfaceChoice k + have hh := hfaceChoice k + dsimp [f, P3523T1FaceEnumeration] + rw [dite_eq_left hh] + exact Classical.choose_spec hh + +private theorem hinit_ledger_starts : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (∀ (i : Fin (r + 3)), ∀ (j : Fin (r + 3)), ((c.faces 0).filter (fun F => s.start i ∈ F ∧ + s.start j ∈ F)).card = Set.ncard {k : Fin t.count | i ∈ Set.range (t.face k) ∧ j ∈ + Set.range (t.face k)}) → ((∀ (i : Fin (r + 3)), ∀ (j : Fin (r + 3)), (i ≠ j) → + (({s.start i, s.start j} : Finset (Fin (n + 3))) ∈ c.boundary 0 ↔ j = i + 1 ∨ i = j + + 1)) → ((∀ (i : Fin (r + 3)), ∀ (j : Fin (r + 3)), (∃ F ∈ c.faces 0, s.start i ∈ F ∧ + s.start j ∈ F) ↔ ∃ k : Fin t.count, i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face + k)) → (∀ (i : Fin (r + (3 : ℕ))), ∀ (j : Fin (r + (3 : ℕ))), i ≠ j → {F ∈ c.faces (0 + : ℕ) | s.start i ∈ F ∧ s.start j ∈ F}.card = if {s.start i, s.start j} ∈ c.boundary + (0 : ℕ) then (1 : ℕ) else if ∃ F ∈ c.faces (0 : ℕ), s.start i ∈ F ∧ s.start j ∈ F + then (2 : ℕ) else (0 : ℕ)))) ) := by + classical + intro r n q p s X K t c hinitial_pair_count hboundary0_pair hexists_initial_pair i j hij + rw [hinitial_pair_count i j, t.edge_count i j hij] + simp [hboundary0_pair i j hij, hexists_initial_pair i j] + +private theorem hvertex0_start : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ∀ x ∈ c.vertices 0, ∃ i : Fin (r + 3), s.start i = x ) := by + classical + intro r n q p s X K t c x hx + change x ∈ Finset.univ.image s.start at hx + rcases Finset.mem_image.mp hx with ⟨i, -, hi⟩ + exact ⟨i, hi⟩ + +private theorem pair_filter_card_symmetry : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + let fs := c.faces c.steps.length + let f := P3523T1FaceEnumeration fs + ((∀ h : Nat, h ≤ c.steps.length → ∀ a b : Fin (n + 3), a ≠ b → ((c.faces h).filter (fun F + => a ∈ F ∧ b ∈ F)).card = if {a, b} ∈ c.boundary h then 1 else if ∃ F ∈ c.faces h, a + ∈ F ∧ b ∈ F then 2 else 0) → (∀ (i : Fin (n + 3)), ∀ (j : Fin (n + 3)), (i ≠ j) → + (Set.ncard {k : Fin fs.card | i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)} = if j = i + + 1 ∨ i = j + 1 then 1 else if ∃ k, i ∈ Set.range (f k) ∧ j ∈ Set.range (f k) then 2 + else 0))) → (∀ (A : Finset (Finset (Fin (n + (3 : ℕ))))), ∀ (x : Fin (n + (3 : ℕ))), + ∀ (y : Fin (n + (3 : ℕ))), {F ∈ A | x ∈ F ∧ y ∈ F}.card = {F ∈ A | y ∈ F ∧ x ∈ + F}.card) ) := by + classical + intro r n q p s X K t c fs f hindexed_ledger A x y + congr 1 + ext F + simp only [Finset.mem_filter] + tauto + +private theorem old_pair_ledger_transfer : + (by + classical + exact + ∀ (old : ℕ), ∀ (new : ℕ), ∀ (onBoundary : Prop), ∀ (removed : Prop), ∀ [inst : Decidable + onBoundary], ∀ [inst_1 : Decidable removed], (old = if onBoundary then (1 : ℕ) else + if (0 : ℕ) < old then (2 : ℕ) else (0 : ℕ)) → (removed → onBoundary) → (old = new + + if removed then (1 : ℕ) else (0 : ℕ)) → new = if onBoundary ∧ ¬removed then (1 : ℕ) + else if (0 : ℕ) < new then (2 : ℕ) else (0 : ℕ) ) := by + classical + intro old new onBoundary removed typeclassInstance0 typeclassInstance1 hold hremove hdelta + by_cases hr : removed <;> by_cases hb : onBoundary <;> + by_cases hn : 0 < new <;> simp_all + +private theorem hiV : + (by + classical + exact + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : + P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set + (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + ((P3523T1InsertionConstruction s t).vertices (P3523T1InsertionConstruction s + t).steps.length = Finset.univ) → (∀ (i : Fin (n + (3 : ℕ))), i ∈ c.vertices + c.steps.length) ) := by + classical + intro r n q p s X K t c hvertices i + rw [hvertices] + simp + +end InsertionDetails + +theorem P3523T1InsertionIncidence {r n : Nat} + (q : P3381T1PolygonBoundary r) (p : P3381T1PolygonBoundary n) + (s : P3475T1BoundarySubdivision q p) + (X K : Set (Real × Real)) (t : P3475T1TriangleTree q X K) : + let c := P3523T1InsertionConstruction s t + let fs := c.faces c.steps.length + let f := P3523T1FaceEnumeration fs + (∀ h : Nat, h ≤ c.steps.length → ∀ F ∈ c.faces h, + F.card = 3 ∧ F ⊆ c.vertices h) ∧ + (∀ h : Nat, h ≤ c.steps.length → ∀ a b : Fin (n + 3), a ≠ b → + ((c.faces h).filter (fun F => a ∈ F ∧ b ∈ F)).card = + if {a, b} ∈ c.boundary h then 1 + else if ∃ F ∈ c.faces h, a ∈ F ∧ b ∈ F then 2 else 0) ∧ + (∀ k, Function.Injective (f k)) ∧ + Function.Injective (fun k => Set.range (f k)) ∧ + (∀ i, ∃ k j, f k j = i) ∧ + (∀ i j : Fin (n + 3), i ≠ j → + Set.ncard {k : Fin fs.card | i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)} = + if j = i + 1 ∨ i = j + 1 then 1 + else if ∃ k, i ∈ Set.range (f k) ∧ j ∈ Set.range (f k) then 2 else 0) ∧ + Set.range (fun k => Set.range (f k)) = + {J : Set (Fin (n + 3)) | ∃ F ∈ fs, (F : Set (Fin (n + 3))) = J} := by +-- BODY + classical + dsimp only + let c := P3523T1InsertionConstruction s t + obtain ⟨hblocks, hsteps, hvertices, hboundary⟩ := + P3523T1OrderedInsertion q p s X K t + have hface_inj := InsertionIncidenceProof.hface_inj r n q p s X K t + have hinner (k : Fin t.count) := InsertionDetails.hinner r n q p s X K t k + have hinit := InsertionDetails.hinit r n q p s X K t hinner + have hsplit_card (fs : Finset (Finset (Fin (n + 3)))) + (a d b : Fin (n + 3)) + (hf : ∀ F ∈ fs, F.card = 3) + (hd : ∀ F ∈ fs, d ∉ F) := InsertionIncidenceProof.hsplit_card n fs a d b hf hd + have hsplit_sub (fs : Finset (Finset (Fin (n + 3)))) + (a d b : Fin (n + 3)) (V : Finset (Fin (n + 3))) + (hf : ∀ F ∈ fs, F ⊆ V) := InsertionIncidenceProof.hsplit_sub n fs a d b V hf + have hinit_sub := InsertionDetails.hinit_sub r n q p s X K t + have hfaces_next (h : Nat) (hh : h < c.steps.length) := InsertionIncidenceProof.hfaces_next r n + q p s X K t h hh + have hvertices_next (h : Nat) (hh : h < c.steps.length) := InsertionDetails.hvertices_next r n + q p s X K t h hh + have hboundary_next (h : Nat) (hh : h < c.steps.length) := + InsertionIncidenceProof.hboundary_next r n q p s X K t h hh + have hstage := InsertionIncidenceProof.hstage r n q p s + X K t hsteps hinit hsplit_card hsplit_sub hinit_sub hfaces_next hvertices_next + have hboundary_support := InsertionIncidenceProof.hboundary_support + r n q p s X K t hsteps hvertices_next hboundary_next + have hthird (F : Finset (Fin (n + 3))) (a b : Fin (n + 3)) + (hab : a ≠ b) (hcard : F.card = 3) (ha : a ∈ F) (hb : b ∈ F) := + InsertionIncidenceProof.hthird n F a b hab hcard ha hb + let fs := c.faces c.steps.length + let f := P3523T1FaceEnumeration fs + have hfinal_card := InsertionDetails.hfinal_card r n q p s X K t hstage + have hfaceChoice (k : Fin fs.card) := InsertionIncidenceProof.hfaceChoice r n q p s X K t + hfinal_card k + have hf_spec (k : Fin fs.card) := InsertionDetails.hf_spec r n q p s X K t hfaceChoice k + have hindexed_filter_card (i j : Fin (n + 3)) := InsertionIncidenceProof.hindexed_filter_card + r n q p s X K t hf_spec i j + have hindexed_exists (i j : Fin (n + 3)) := InsertionIncidenceProof.hindexed_exists r n q p s X + K t + hf_spec i j + have hinitial_pair_count (i j : Fin (r + 3)) := InsertionIncidenceProof.hinitial_pair_count r n + q p s X K t hface_inj i j + have pair_eq_pair {α : Type} [DecidableEq α] (a b c d : α) + (hab : a ≠ b) (hcd : c ≠ d) := InsertionIncidenceProof.pair_eq_pair (α := α) a b c d hab hcd + have hboundary_final_pair (i j : Fin (n + 3)) (hij : i ≠ j) := + InsertionIncidenceProof.hboundary_final_pair r n q p s X K t + hboundary pair_eq_pair i j hij + have hindexed_ledger (hinc : ∀ h : Nat, h ≤ c.steps.length → + ∀ a b : Fin (n + 3), a ≠ b → + ((c.faces h).filter (fun F => a ∈ F ∧ b ∈ F)).card = + if {a, b} ∈ c.boundary h then 1 + else if ∃ F ∈ c.faces h, a ∈ F ∧ b ∈ F then 2 else 0) + (i j : Fin (n + 3)) (hij : i ≠ j) := InsertionIncidenceProof.hindexed_ledger r n q p s X K + t hindexed_filter_card + hindexed_exists hboundary_final_pair hinc i j hij + have hboundary0_pair (i j : Fin (r + 3)) (hij : i ≠ j) := + InsertionIncidenceProof.hboundary0_pair r n q p s X K t + pair_eq_pair i j hij + have hexists_initial_pair (i j : Fin (r + 3)) := InsertionIncidenceProof.hexists_initial_pair r + n q p s X K t i j + have hinit_ledger_starts (i j : Fin (r + 3)) (hij : i ≠ j) := + InsertionDetails.hinit_ledger_starts r n q p s X K t hinitial_pair_count + hboundary0_pair hexists_initial_pair i j hij + have hboundary0_support := InsertionIncidenceProof.hboundary0_support r n q p s X K t + have hvertex0_start := InsertionDetails.hvertex0_start r n q p s X K t + have hinit_ledger := InsertionIncidenceProof.hinit_ledger r n q p s X K t hinit_sub + hinit_ledger_starts + hboundary0_support hvertex0_start + have hsplit_eq (A : Finset (Finset (Fin (n + 3)))) + (a d b : Fin (n + 3)) (hab : a ≠ b) (F : Finset (Fin (n + 3))) + (hF : F ∈ A) (hpF : a ∈ F ∧ b ∈ F) + (huniq : ∀ G ∈ A, a ∈ G ∧ b ∈ G → G = F) + (hd : ∀ G ∈ A, d ∉ G) := InsertionIncidenceProof.hsplit_eq n A a d b hab F hF hpF huniq hd + have hsplit_filter_card (A : Finset (Finset (Fin (n + 3)))) + (a d b : Fin (n + 3)) (hab : a ≠ b) (F : Finset (Fin (n + 3))) + (hF : F ∈ A) (hpF : a ∈ F ∧ b ∈ F) + (huniq : ∀ G ∈ A, a ∈ G ∧ b ∈ G → G = F) + (hd : ∀ G ∈ A, d ∉ G) (P : Finset (Fin (n + 3)) → Prop) + [DecidablePred P] := InsertionIncidenceProof.hsplit_filter_card n hsplit_eq A a d b hab F + hF hpF huniq hd P + have herase_filter_card (A : Finset (Finset (Fin (n + 3)))) + (F : Finset (Fin (n + 3))) (hF : F ∈ A) + (P : Finset (Fin (n + 3)) → Prop) [DecidablePred P] := + InsertionIncidenceProof.herase_filter_card n A F hF P + have hfilter_exists_iff_pos (A : Finset (Finset (Fin (n + 3)))) + (P : Finset (Fin (n + 3)) → Prop) [DecidablePred P] := + InsertionIncidenceProof.hfilter_exists_iff_pos n A P + -- Old-pair contributions are conserved except for the removed boundary edge. + have old_pair_split_indicators (a b z d x y : Fin (n + 3)) (hab : a ≠ b) (haz : a ≠ z) (hbz : b + ≠ z) + (hxy : x ≠ y) (hxd : x ≠ d) (hyd : y ≠ d) := + InsertionIncidenceProof.old_pair_split_indicators n a b z d x y hab haz hbz hxy hxd hyd + have old_boundary_membership (B : Finset (Finset (Fin (n + 3)))) (a b d x y : Fin (n + 3)) + (hxd : x ≠ d) (hyd : y ≠ d) := InsertionIncidenceProof.old_boundary_membership n B a b d x + y hxd hyd + have pair_filter_card_symmetry (A : Finset (Finset (Fin (n + 3)))) (x y : Fin (n + 3)) := + InsertionDetails.pair_filter_card_symmetry r + n q p s X K t hindexed_ledger A x y + have old_pair_ledger_transfer (old new : Nat) + (onBoundary removed : Prop) [Decidable onBoundary] [Decidable removed] + (hold : old = if onBoundary then 1 else if 0 < old then 2 else 0) + (hremove : removed → onBoundary) + (hdelta : old = new + (if removed then 1 else 0)) := + InsertionDetails.old_pair_ledger_transfer old new onBoundary removed hold hremove hdelta + have hledger := InsertionIncidenceProof.hledger + r n q p s X K t hsteps hfaces_next hboundary_next hstage hboundary_support hthird + pair_eq_pair hinit_ledger hsplit_filter_card herase_filter_card + hfilter_exists_iff_pos old_pair_split_indicators old_boundary_membership + pair_filter_card_symmetry old_pair_ledger_transfer + have hselected_face (h : Nat) (hh : h < c.steps.length) := + InsertionIncidenceProof.hselected_face r n q p s X K t + hsteps hledger h hh + have husage := InsertionIncidenceProof.husage r n q p s X K + t hsteps hfaces_next hvertices_next hstage hthird hvertex0_start hledger hselected_face + refine ⟨hstage, ?_⟩ + constructor + · exact hledger + constructor + · intro k + exact (hf_spec k).1 + constructor + · intro k l hkl + change Set.range (f k) = Set.range (f l) at hkl + apply (fs.equivFin.symm).injective + apply Subtype.ext + apply Finset.ext + intro x + have hmem := congrArg (fun A : Set (Fin (n + 3)) => x ∈ A) hkl + rw [(hf_spec k).2, (hf_spec l).2] at hmem + exact Iff.of_eq hmem + constructor + · intro i + have hiV := InsertionDetails.hiV r n q p s X K t hvertices i + rcases husage c.steps.length le_rfl i hiV with ⟨F, hF, hiF⟩ + have hFs : F ∈ fs := by simpa [fs] using hF + let k := fs.equivFin ⟨F, hFs⟩ + have hface : (fs.equivFin.symm k).val = F := by simp [k] + have hrange : Set.range (f k) = (F : Set (Fin (n + 3))) := by + rw [(hf_spec k).2, hface] + have hiRange : i ∈ Set.range (f k) := by rw [hrange]; exact hiF + rcases Set.mem_range.mp hiRange with ⟨j, hj⟩ + exact ⟨k, j, hj⟩ + constructor + · intro i j hij + exact hindexed_ledger hledger i j hij + apply Set.ext + intro J + constructor + · rintro ⟨k, rfl⟩ + refine ⟨(fs.equivFin.symm k).val, (fs.equivFin.symm k).property, ?_⟩ + exact (hf_spec k).2.symm + · rintro ⟨F, hF, hFJ⟩ + let k := fs.equivFin ⟨F, hF⟩ + refine ⟨k, ?_⟩ + calc + Set.range (f k) = ((fs.equivFin.symm k).val : Set (Fin (n + 3))) := (hf_spec k).2 + _ = (F : Set (Fin (n + 3))) := by simp [k] + _ = J := hFJ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InterpolatedTarget.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InterpolatedTarget.lean new file mode 100644 index 0000000000..8100d5d4da --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InterpolatedTarget.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundarySubdivision +public import LeanPool.ApollonianSuperharmonic.P3475T1TriangleTree + +-- [TABLET NODE: P3523T1InterpolatedTarget] + +/-! +# P3523T1InterpolatedTarget + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For an ordered subdivision $s$ of $q$ by $p$ as in +`P3475T1BoundarySubdivision` and a triangle tree $t$ for +$(q,X,K)$ as in `P3475T1TriangleTree`, define, at every +original fine index $j$, +$$ + Q_j=(1-s.\mathrm{parameter}(j))t.\mathrm{target}(s.\mathrm{edge}(j)) + +s.\mathrm{parameter}(j)t.\mathrm{target}(s.\mathrm{edge}(j)+1). +$$ +The fine labels are unchanged; this definition only gives their target +positions using the same coarse-edge parameters as the source. +-/ +def P3523T1InterpolatedTarget {r n : Nat} + {q : P3381T1PolygonBoundary r} {p : P3381T1PolygonBoundary n} + (s : P3475T1BoundarySubdivision q p) + {X K : Set (Real × Real)} (t : P3475T1TriangleTree q X K) + (j : Fin (n + 3)) : Real × Real := +-- BODY + (1 - s.parameter j) • t.target (s.edge j) + + s.parameter j • t.target (s.edge j + 1) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean b/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean new file mode 100644 index 0000000000..67cdef257e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean @@ -0,0 +1,1797 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionConstruction +public import LeanPool.ApollonianSuperharmonic.P3523T1SubdivisionExit + +/-! +# P3523T1OrderedInsertion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open Fin.NatCast + +-- [TABLET NODE: P3523T1OrderedInsertion] +namespace OrderedInsertionGeometry + +private theorem hsameAt138 : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), (∀ (j : Fin (n + (3 : ℕ))), ∃ k < n + (3 : + ℕ), s.edge (j + (↑(k + (1 : ℕ)) : Fin (n + (3 : ℕ)))) ≠ s.edge j) → (∀ (i : Fin (r + (3 : + ℕ))), ∀ (ex : ∃ k < n + (3 : ℕ), s.edge (s.start i + (↑(k + (1 : ℕ)) : Fin (n + (3 : + ℕ)))) ≠ s.edge (s.start i)), + let k₀ := Nat.find ex + let m := k₀ + 1 + (k₀ < n + 3) → (∀ (k : Nat), (k < m) → (s.edge (s.start i + (k : Fin (n + 3))) = i))) := by + classical + intro r n q p s hexit i ex k₀ m hk₀ k hk + cases k with + | zero => simpa using s.edge_start i + | succ k => + have hmin := Nat.find_min ex (show k < k₀ by dsimp [m] at hk; omega) + have hkn : k < n + 3 := by dsimp [m] at hk; omega + have heq : s.edge (s.start i + ((k + 1 : Nat) : Fin (n + 3))) = + s.edge (s.start i) := by + by_contra hn + exact hmin ⟨hkn, hn⟩ + simpa only [s.edge_start] using heq + +private theorem hstartAt150 : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), (∀ (j : Fin (n + (3 : ℕ))), s.parameter j = + (0 : ℝ) → j = s.start (s.edge j)) → ((∀ (j : Fin (n + (3 : ℕ))), ∃ k < n + (3 : ℕ), + s.edge (j + (↑(k + (1 : ℕ)) : Fin (n + (3 : ℕ)))) ≠ s.edge j) → (∀ (i : Fin (r + (3 : + ℕ))), ∀ (ex : ∃ k < n + (3 : ℕ), s.edge (s.start i + (↑(k + (1 : ℕ)) : Fin (n + (3 : + ℕ)))) ≠ s.edge (s.start i)), + let k₀ := Nat.find ex + let m := k₀ + 1 + (s.edge (s.start i + (m : Fin (n + 3))) ≠ i) → ((∀ (k : Nat), (k < m) → (s.edge (s.start i + + (k : Fin (n + 3))) = i)) → (s.start i + (m : Fin (n + 3)) = s.start (i + 1))))) := by + classical + intro r n q p s hzero hexit i ex k₀ m hlast hsame + rcases s.successor (s.start i + (k₀ : Fin (n + 3))) with hs | hs + · have heq : s.edge (s.start i + (m : Fin (n + 3))) = i := by + simpa [m, Nat.cast_add, add_assoc, hsame k₀ (by dsimp [m]; omega)] + using hs.1 + exact (hlast heq).elim + · have heq : s.edge (s.start i + (m : Fin (n + 3))) = i + 1 := by + simpa [m, Nat.cast_add, add_assoc, hsame k₀ (by dsimp [m]; omega)] + using hs.1 + have hz : s.parameter (s.start i + (m : Fin (n + 3))) = 0 := by + simpa [m, Nat.cast_add, add_assoc] using hs.2 + simpa only [heq] using hzero _ hz + +private theorem hstepAt162 : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), (∀ (j : Fin (n + (3 : ℕ))), ∃ k < n + (3 : + ℕ), s.edge (j + (↑(k + (1 : ℕ)) : Fin (n + (3 : ℕ)))) ≠ s.edge j) → (∀ (i : Fin (r + (3 : + ℕ))), ∀ (ex : ∃ k < n + (3 : ℕ), s.edge (s.start i + (↑(k + (1 : ℕ)) : Fin (n + (3 : + ℕ)))) ≠ s.edge (s.start i)), + let k₀ := Nat.find ex + let m := k₀ + 1 + (∀ (k : Nat), (k < m) → (s.edge (s.start i + (k : Fin (n + 3))) = i)) → (∀ (k : Nat), (k + 1 + < m) → (s.parameter (s.start i + (k : Fin (n + 3))) < + s.parameter (s.start i + ((k + 1 : Nat) : Fin (n + 3)))))) := by + classical + intro r n q p s hexit i ex k₀ m hsame k hk + rcases s.successor (s.start i + (k : Fin (n + 3))) with hs | hs + · simpa [Nat.cast_add, add_assoc] using hs.2 + · have heq : i = i + 1 := by + have hadv : s.edge (s.start i + ((k + 1 : Nat) : Fin (n + 3))) = + s.edge (s.start i + (k : Fin (n + 3))) + 1 := by + simpa only [Nat.cast_add, Nat.cast_one, add_assoc] using hs.1 + rw [hsame k (by omega), hsame (k + 1) hk] at hadv + exact hadv + have hi := congrArg Fin.val heq + change i.val = (i.val + 1) % (r + 3) at hi + by_cases hlt : i.val + 1 < r + 3 + · rw [Nat.mod_eq_of_lt hlt] at hi + omega + · have hend : i.val + 1 = r + 3 := by omega + rw [hend, Nat.mod_self] at hi + omega + +private theorem hstrict : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), (∀ (j : Fin (n + (3 : ℕ))), ∃ k < n + (3 : + ℕ), s.edge (j + (↑(k + (1 : ℕ)) : Fin (n + (3 : ℕ)))) ≠ s.edge j) → (∀ (i : Fin (r + (3 : + ℕ))), ∀ (ex : ∃ k < n + (3 : ℕ), s.edge (s.start i + (↑(k + (1 : ℕ)) : Fin (n + (3 : + ℕ)))) ≠ s.edge (s.start i)), + let k₀ := Nat.find ex + let m := k₀ + 1 + (∀ (k : Nat), (k + 1 < m) → (s.parameter (s.start i + (k : Fin (n + 3))) < s.parameter + (s.start i + ((k + 1 : Nat) : Fin (n + 3))))) → (∀ (l : Nat), l < m → ∀ k : Nat, k < l → + s.parameter (s.start i + (k : Fin (n + 3))) < + s.parameter (s.start i + (l : Fin (n + 3))))) := by + classical + intro r n q p s hexit i ex k₀ m hstep l + induction l with + | zero => intro _ k hk; omega + | succ l ih => + intro hl k hkl + have hsl := hstep l hl + by_cases heq : k = l + · simpa only [heq] using hsl + · exact (ih (by omega) k (by omega)).trans hsl + +private theorem affine : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ [NeZero (n + (3 : ℕ))], + ∀ (j : Fin (n + (3 : ℕ))), + let t₀ := s.parameter (j - 1) + let t₁ := s.parameter j + let u := (t₁ - t₀) / (1 - t₀) + ((1 - u) * (1 - t₀) = 1 - t₁) → (((1 - u) * t₀ + u = t₁) → (∀ (A : Real × Real), ∀ (B : Real + × Real), (1 - t₁) • A + t₁ • B = + (1 - u) • ((1 - t₀) • A + t₀ • B) + u • B)) := by + classical + intro r n q p s this j t₀ t₁ u hc₀ hc₁ A B + calc + (1 - t₁) • A + t₁ • B = + ((1 - u) * (1 - t₀)) • A + ((1 - u) * t₀ + u) • B := by + rw [hc₀, hc₁] + _ = (1 - u) • ((1 - t₀) • A + t₀ • B) + u • B := by + rw [add_smul, smul_add, smul_smul, smul_smul] + simp [add_assoc] + +private theorem filterPrev : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), (P3475T1BoundarySubdivision q + p) → (∀ (X : Set (Real × Real)), ∀ (K : Set (Real × Real)), (P3475T1TriangleTree q X K) + → ((Fin (n + (3 : ℕ))) → (∀ {α : Type}, ∀ (l : List α), ∀ (p : α → Bool), ∀ (k : Nat), ∀ + (h : Nat), (l.Nodup) → (∀ (hk : k < l.length), (0 < k) → (∀ (hlen : h < (l.filter + p).length), (p (l.get ⟨k - 1, by omega⟩) = true) → (((l.filter p).get ⟨h, hlen⟩ = l.get + ⟨k, hk⟩) → (l.get ⟨k - 1, by omega⟩ ∈ (l.filter p).take h))))))) := by + classical + intro r n q s X K t j α l p k h hn hk hpos hlen hp hcur + induction l generalizing k h with + | nil => simp at hk + | cons a l ih => + cases k with + | zero => omega + | succ k => + have hk' : k < l.length := by simpa using hk + cases hp0 : p a with + | false => + by_cases hkz : k = 0 + · subst k + simp [hp0] at hp + · obtain ⟨k, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hkz + have hk'' : k + 1 < l.length := by simpa using hk' + have hlen' : h < (l.filter p).length := by simpa [hp0] using hlen + have hcur' : (l.filter p).get ⟨h, hlen'⟩ = l.get ⟨k + 1, hk''⟩ := by + simpa [hp0] using hcur + have hprev := ih (k := k + 1) (h := h) (hn := hn.of_cons) (hk := hk'') + (hpos := by omega) (hlen := hlen') (hp := by simpa using hp) (hcur := hcur') + simpa [hp0] using hprev + | true => + cases h with + | zero => + have heq : a = l.get ⟨k, hk'⟩ := by simpa [hp0] using hcur + have hmem : l.get ⟨k, hk'⟩ ∈ l := List.get_mem l ⟨k, hk'⟩ + exact False.elim (hn.notMem (heq ▸ hmem)) + | succ h => + by_cases hkz : k = 0 + · subst k + simp [hp0] + · obtain ⟨k, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hkz + have hk'' : k + 1 < l.length := by simpa using hk' + have hlen' : h < (l.filter p).length := by simpa [hp0] using hlen + have hcur' : (l.filter p).get ⟨h, hlen'⟩ = l.get ⟨k + 1, hk''⟩ := by + simpa [hp0] using hcur + have hprev := ih (k := k + 1) (h := h) (hn := hn.of_cons) (hk := hk'') + (hpos := by omega) (hlen := hlen') (hp := by simpa using hp) (hcur := hcur') + simpa [hp0] using Or.inr hprev + +private theorem fold_not_mem : + ∀ (n : Nat), ∀ (l : List (Fin (n + 3) × Fin (n + 3) × Fin (n + 3))), ∀ (A : Finset (Fin (n + + 3))), ∀ (x : Fin (n + 3)), (x ∉ A) → ((∀ a ∈ l, a.2.1 ≠ x) → (x ∉ l.foldl (fun vs e => + insert e.2.1 vs) A)) := by + classical + intro n l A x hx hall + induction l generalizing A with + | nil => simpa + | cons a l ih => + have hhead : a.2.1 ≠ x := hall a (by simp) + apply ih + · simpa [Finset.mem_insert, hhead.symm] using hx + · intro b hb + exact hall b (by simp [hb]) + +private theorem fold_insert_mem : + ∀ (n : Nat), ∀ (l : List (Fin (n + 3) × Fin (n + 3) × Fin (n + 3))), ∀ (A : Finset (Fin (n + + 3))), ∀ (x : Fin (n + 3)), (x ∈ A ∨ x ∈ l.map (fun e => e.2.1)) → (x ∈ l.foldl (fun vs e + => insert e.2.1 vs) A) := by + classical + intro n l A x hx + induction l generalizing A with + | nil => + rcases hx with hxA | hxFalse + · simpa using hxA + · simp at hxFalse + | cons a l ih => + simp only [List.map_cons, List.mem_cons] at hx + simp only [List.foldl_cons] + rcases hx with hxA | hx + · apply ih (A := insert a.2.1 A) + exact Or.inl (Finset.mem_insert.mpr (Or.inr hxA)) + · rcases hx with hxa | hx + · subst x + apply ih (A := insert a.2.1 A) + exact Or.inl (Finset.mem_insert.mpr (Or.inl rfl)) + · apply ih (A := insert a.2.1 A) + exact Or.inr hx + +private theorem keepBoundaryAt383 : + ∀ (n : Nat), + let boundaryStep := fun + (es : Finset (Finset (Fin (n + 3)))) + (e : Fin (n + 3) × Fin (n + 3) × Fin (n + 3)) => + insert {e.1, e.2.1} + (insert {e.2.1, e.2.2} (es.erase {e.1, e.2.2})) + ∀ (l : List (Fin (n + 3) × Fin (n + 3) × Fin (n + 3))), ∀ (A : Finset (Finset (Fin (n + + 3)))), ∀ (P : Finset (Fin (n + 3))), (P ∈ A ∨ ∃ e ∈ l, + P = {e.1, e.2.1} ∨ P = {e.2.1, e.2.2}) → ((∀ e ∈ l, P ≠ {e.1, e.2.2}) → (P ∈ l.foldl + boundaryStep A)) := by + classical + intro n boundaryStep l A P hseed hno + induction l generalizing A with + | nil => + rcases hseed with hA | ⟨e, he, _⟩ + · simpa using hA + · simp at he + | cons a l ih => + simp only [List.foldl_cons] + rcases hseed with hA | ⟨e, he, hedge⟩ + · apply ih (A := boundaryStep A a) + · left + change P ∈ insert {a.1, a.2.1} + (insert {a.2.1, a.2.2} (A.erase {a.1, a.2.2})) + simp only [Finset.mem_insert, Finset.mem_erase] + exact Or.inr (Or.inr ⟨hno a (by simp), hA⟩) + · intro b hb + exact hno b (by simp [hb]) + · rcases List.mem_cons.mp he with heq | heTail + · subst e + apply ih (A := boundaryStep A a) + · left + rcases hedge with h1 | h2 + · simp [boundaryStep, h1] + · simp [boundaryStep, h2] + · intro b hb + exact hno b (by simp [hb]) + · apply ih (A := boundaryStep A a) + · right + exact ⟨e, heTail, hedge⟩ + · intro b hb + exact hno b (by simp [hb]) + +private theorem prevTupleMem : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (h : ℕ), ∀ (hh : h < + (P3523T1InsertionConstruction s t).steps.length), ∀ [NeZero (n + (3 : ℕ))], + let c := P3523T1InsertionConstruction s t + let e := c.steps.get ⟨h, hh⟩ + ∀ (j : Fin (n + (3 : ℕ))), ((j - (1 : Fin (n + (3 : ℕ))), j, s.start (s.edge j + (1 : Fin (r + + (3 : ℕ))))) = e) → (∀ (k : Fin (n + (3 : ℕ))), ∀ (hk : s.start (0 : Fin (r + (3 : ℕ))) + + k = j), (s.parameter j ≠ 0) → (((j - 1) + 1 = j) → (((List.ofFn fun k : Fin (n + 3) => + s.start 0 + k).Nodup) → ((∀ {α : Type}, ∀ (l : List α), ∀ (p : α → Bool), ∀ (k : Nat), ∀ + (h : Nat), (l.Nodup) → (∀ (hk : k < l.length), (0 < k) → (∀ (hlen : h < (l.filter + p).length), (p (l.get ⟨k - 1, by omega⟩) = true) → (((l.filter p).get ⟨h, hlen⟩ = l.get + ⟨k, hk⟩) → (l.get ⟨k - 1, by omega⟩ ∈ (l.filter p).take h))))) → ( + (s.parameter (j - 1) ≠ 0) → (((j - 1) - 1, j - 1, s.start (s.edge (j - 1) + 1)) ∈ + c.steps.take h)))))) := by + classical + intro r n q p s X K t h hh this c e j heq k hk hparam hp hrawNodup filterPrev hzprev + let raw := List.ofFn (fun k : Fin (n + 3) => s.start 0 + k) + let pred := fun z : Fin (n + 3) => decide (s.parameter z ≠ 0) + let kp : Fin (n + 3) := ⟨k.val - 1, by omega⟩ + have hrawLen : raw.length = n + 3 := by simp [raw] + have hkpos : 0 < k.val := by + by_contra hnot + have hkval : k.val = 0 := by omega + have hkz : k = 0 := Fin.ext hkval + subst k + have hjstart : j = s.start 0 := by simpa using hk.symm + exact hparam (by rw [hjstart]; exact s.parameter_start 0) + have hkprev : kp + 1 = k := by + apply Fin.ext + rw [Fin.val_add_eq_of_add_lt (by simp [kp]; omega)] + simp [kp] + omega + have hprevLabel : s.start 0 + kp = j - 1 := by + apply add_right_cancel + calc + (s.start 0 + kp) + 1 = s.start 0 + (kp + 1) := by simp [add_assoc] + _ = s.start 0 + k := by rw [hkprev] + _ = j := hk + _ = (j - 1) + 1 := hp.symm + have hrawPrev : raw.get ⟨k.val - 1, by + rw [hrawLen] + exact lt_of_le_of_lt (Nat.sub_le _ _) k.isLt⟩ = j - 1 := by + have hcast : Fin.cast hrawLen ⟨k.val - 1, by + rw [hrawLen] + exact lt_of_le_of_lt (Nat.sub_le _ _) k.isLt⟩ = kp := by + apply Fin.ext + rfl + change (List.ofFn (fun i : Fin (n + 3) => s.start 0 + i)).get + ⟨k.val - 1, by + rw [hrawLen] + exact lt_of_le_of_lt (Nat.sub_le _ _) k.isLt⟩ = j - 1 + rw [List.get_ofFn, hcast] + exact hprevLabel + have hrawCur : raw.get ⟨k.val, by rw [hrawLen]; exact k.isLt⟩ = j := by + have hcast : Fin.cast hrawLen ⟨k.val, by rw [hrawLen]; exact k.isLt⟩ = k := by + apply Fin.ext + rfl + change (List.ofFn (fun i : Fin (n + 3) => s.start 0 + i)).get + ⟨k.val, by rw [hrawLen]; exact k.isLt⟩ = j + rw [List.get_ofFn, hcast] + exact hk + have hfilterLen : h < (List.filter pred raw).length := by + simpa [c, P3523T1InsertionConstruction, raw, pred] using hh + have hfilterCur : (List.filter pred raw).get ⟨h, hfilterLen⟩ = j := by + have hget : (j - 1, j, s.start (s.edge j + 1)) = c.steps.get ⟨h, hh⟩ := by + simpa only [e] using heq + have hm := congrArg + (fun z : Fin (n + 3) × Fin (n + 3) × Fin (n + 3) => z.2.1) hget.symm + simpa [c, P3523T1InsertionConstruction, raw, pred] using hm + have hpred : pred (raw.get ⟨k.val - 1, + by + rw [hrawLen] + exact lt_of_le_of_lt (Nat.sub_le _ _) k.isLt⟩) = true := by + rw [hrawPrev] + simp [pred, hzprev] + have hfilteredPrev := filterPrev raw pred k.val h hrawNodup + (by rw [hrawLen]; exact k.isLt) hkpos hfilterLen hpred + (hfilterCur.trans hrawCur.symm) + have hfilteredPrev' : j - 1 ∈ (List.filter pred raw).take h := by + rw [← hrawPrev] + exact hfilteredPrev + have : ((j - 1) - 1, j - 1, s.start (s.edge (j - 1) + 1)) ∈ + (List.map (fun z => (z - 1, z, s.start (s.edge z + 1))) + (List.filter pred raw)).take h := by + rw [← List.map_take] + exact List.mem_map.mpr ⟨j - 1, hfilteredPrev', rfl⟩ + simpa [c, P3523T1InsertionConstruction, raw, pred] using this + +private theorem pairCasesAt487 : + ∀ (n : Nat), ∀ {a : Fin (n + 3)}, ∀ {b : Fin (n + 3)}, ∀ {c : Fin (n + 3)}, ∀ + {d : Fin (n + 3)}, (a ≠ b) → ((({a, b} : Finset (Fin (n + 3))) = {c, d}) → ((a = c ∧ b = + d) ∨ (a = d ∧ b = c))) := by + classical + intro n a b c d hab h + have hac : a = c ∨ a = d := by + have ha : a ∈ ({c, d} : Finset (Fin (n + 3))) := by + rw [← h] + simp + simpa only [Finset.mem_insert, Finset.mem_singleton] using ha + rcases hac with hac | had + · have hb : b = c ∨ b = d := by + have hb' : b ∈ ({c, d} : Finset (Fin (n + 3))) := by + rw [← h] + simp + simpa only [Finset.mem_insert, Finset.mem_singleton] using hb' + rcases hb with hbc | hbd + · exact False.elim (hab (hac.trans hbc.symm)) + · exact Or.inl ⟨hac, hbd⟩ + · have hb : b = c ∨ b = d := by + have hb' : b ∈ ({c, d} : Finset (Fin (n + 3))) := by + rw [← h] + simp + simpa only [Finset.mem_insert, Finset.mem_singleton] using hb' + rcases hb with hbc | hbd + · exact Or.inr ⟨had, hbc⟩ + · exact False.elim (hab (had.trans hbd.symm)) + +private theorem hrawPrevAt546 : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), (P3475T1TriangleTree q X K) → ((ℕ) → (∀ [NeZero (n + (3 : ℕ))], + ∀ (j : Fin (n + (3 : ℕ))), ∀ (k : Fin (n + (3 : ℕ))), ((j - 1) + 1 = j) → ( + let raw := List.ofFn (fun k : Fin (n + 3) => s.start 0 + k) + let kp : Fin (n + 3) := ⟨k.val - 1, by omega⟩ + ∀ (hrawLen : raw.length = n + 3), (s.start 0 + kp = j - 1) → (raw.get ⟨k.val - 1, by + rw [hrawLen] + exact lt_of_le_of_lt (Nat.sub_le _ _) k.isLt⟩ = j - 1)))) := by + classical + intro r n q p s X K t h this j k hp raw kp hrawLen hprevLabel + have hcast : Fin.cast hrawLen ⟨k.val - 1, by + rw [hrawLen] + exact lt_of_le_of_lt (Nat.sub_le _ _) k.isLt⟩ = kp := by + apply Fin.ext + rfl + change (List.ofFn (fun i : Fin (n + 3) => s.start 0 + i)).get + ⟨k.val - 1, by + rw [hrawLen] + exact lt_of_le_of_lt (Nat.sub_le _ _) k.isLt⟩ = j - 1 + rw [List.get_ofFn, hcast] + exact hprevLabel + +private theorem hrawCurAt556 : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (j : Fin (n + (3 : ℕ))), ∀ (k : Fin (n + + (3 : ℕ))), (s.start (0 : Fin (r + (3 : ℕ))) + k = j) → ( + let raw := List.ofFn (fun k : Fin (n + 3) => s.start 0 + k) + ∀ (hrawLen : raw.length = n + 3), raw.get ⟨k.val, by + rw [hrawLen] + exact k.isLt⟩ = j) := by + classical + intro r n q p s j k hk raw hrawLen + have hcast : Fin.cast hrawLen ⟨k.val, by rw [hrawLen]; exact k.isLt⟩ = k := by + apply Fin.ext + rfl + change (List.ofFn (fun i : Fin (n + 3) => s.start 0 + i)).get + ⟨k.val, by rw [hrawLen]; exact k.isLt⟩ = j + rw [List.get_ofFn, hcast] + exact hk + +private theorem hprefix : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (h : ℕ), ∀ (hh : h < + (P3523T1InsertionConstruction s t).steps.length), ∀ [NeZero (n + (3 : ℕ))], + let c := P3523T1InsertionConstruction s t + let e := c.steps.get ⟨h, hh⟩ + ∀ (j : Fin (n + (3 : ℕ))), ((j - (1 : Fin (n + (3 : ℕ))), j, s.start (s.edge j + (1 : Fin (r + + (3 : ℕ))))) = e) → ((Fin (n + (3 : ℕ))) → ((c.steps.Nodup) → (∀ a ∈ c.steps.take h, + a.2.1 ≠ j))) := by + classical + intro r n q p s X K t h hh this c e j heq k hstepsNodup a ha haj + rcases List.mem_take_iff_getElem.mp ha with ⟨i, hi, haeq⟩ + have hi' : i < h := by omega + have hiSteps : i < c.steps.length := lt_trans hi' hh + have haSteps := List.getElem_mem hiSteps + rcases List.mem_map.mp haSteps with ⟨j', hj', htuple⟩ + have hjEq : j' = j := by + have hm := congrArg (fun z : Fin (n + 3) × Fin (n + 3) × Fin (n + 3) => z.2.1) + (htuple.trans haeq) + simpa using hm.trans haj + have hget : c.steps[i] = c.steps[h] := by + calc + c.steps[i] = a := haeq + _ = (j' - 1, j', s.start (s.edge j' + 1)) := (htuple.trans haeq).symm + _ = (j - 1, j, s.start (s.edge j + 1)) := by rw [hjEq] + _ = e := heq + _ = c.steps[h] := rfl + have hidx := hstepsNodup.getElem_inj_iff.mp hget + omega + +private theorem hno : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (h : ℕ), ∀ (hh : h < + (P3523T1InsertionConstruction s t).steps.length), ∀ [NeZero (n + (3 : ℕ))], + let c := P3523T1InsertionConstruction s t + let e := c.steps.get ⟨h, hh⟩ + ∀ (j : Fin (n + (3 : ℕ))), ((j - (1 : Fin (n + (3 : ℕ))), j, s.start (s.edge j + (1 : Fin (r + + (3 : ℕ))))) = e) → ((Fin (n + (3 : ℕ))) → (((j - 1) + 1 = j) → ((s.edge (j - 1) = + s.edge j) → ((j - 1 ≠ s.start (s.edge j + 1)) → ((c.steps.Nodup) → ((∀ {α : Type}, ∀ (l : + List α), (l.Nodup) → (∀ (m : Nat), ∀ (hm : m < l.length), l.get ⟨m, hm⟩ ∉ l.take m)) → + ((∀ {a : Fin (n + 3)}, ∀ {b : Fin (n + 3)}, ∀ {c : Fin (n + 3)}, ∀ {d : Fin (n + 3)}, (a + ≠ b) → ((({a, b} : Finset (Fin (n + 3))) = {c, d}) → ((a = c ∧ b = d) ∨ (a = d ∧ b = + c)))) → ( + let P : Finset (Fin (n + 3)) := {j - 1, s.start (s.edge j + 1)} + ∀ z ∈ c.steps.take h, P ≠ {z.1, z.2.2})))))))) := by + classical + intro r n q p s X K t h hh this c e j heq k hp hsame hne hstepsNodup getNotTake pairCases P z + hz hpair + have hzsteps : z ∈ c.steps := List.mem_of_mem_take hz + rcases List.mem_map.mp hzsteps with ⟨w, hw, hztuple⟩ + have hwfilter := List.mem_filter.mp hw + rcases List.mem_ofFn.mp hwfilter.1 with ⟨v, hv⟩ + have hparamw : s.parameter w ≠ 0 := of_decide_eq_true hwfilter.2 + have hpw : (w - 1) + 1 = w := by simp + have hsw := s.successor (w - 1) + rw [hpw] at hsw + have hsamew : s.edge (w - 1) = s.edge w := by + rcases hsw with h | h + · exact h.1.symm + · exact False.elim (hparamw h.2) + have hneW : w - 1 ≠ s.start (s.edge w + 1) := by + intro heqW + have hed := congrArg s.edge heqW + rw [hsamew, s.edge_start] at hed + have hone : (1 : Fin (r + 3)) = 0 := add_left_cancel + (show s.edge w + 1 = s.edge w + 0 by simp at hed) + have hvone := congrArg Fin.val hone + norm_num at hvone + have horient := pairCases hne hpair + rcases horient with ⟨hleft, hright⟩ | ⟨hleft, hright⟩ + · have hwj : w = j := by + calc + w = (w - 1) + 1 := hpw.symm + _ = (j - 1) + 1 := by + have hwleft : z.1 = w - 1 := congrArg Prod.fst hztuple.symm + rw [← hwleft, hleft] + _ = j := hp + have hztuple' : z = (j - 1, j, s.start (s.edge j + 1)) := by + calc + z = (w - 1, w, s.start (s.edge w + 1)) := hztuple.symm + _ = (j - 1, j, s.start (s.edge j + 1)) := by rw [hwj] + have hget : z = c.steps.get ⟨h, hh⟩ := by + calc + z = (j - 1, j, s.start (s.edge j + 1)) := hztuple' + _ = e := heq + _ = c.steps.get ⟨h, hh⟩ := rfl + have hmem : c.steps.get ⟨h, hh⟩ ∈ c.steps.take h := hget ▸ hz + exact getNotTake c.steps hstepsNodup h hh hmem + · have hwprev : w = s.start (s.edge j + 1) + 1 := by + calc + w = (w - 1) + 1 := hpw.symm + _ = s.start (s.edge j + 1) + 1 := by + have hwleft : z.1 = w - 1 := congrArg Prod.fst hztuple.symm + rw [← hwleft, hright] + let b := s.start (s.edge j + 1) + have hparamb : s.parameter b = 0 := s.parameter_start (s.edge j + 1) + have hsb := s.successor b + have hbnext : s.edge b = s.edge j + 1 := s.edge_start _ + have hsameb : s.edge (b + 1) = s.edge b := by + rcases hsb with hsameb | hadv + · exact hsameb.1 + · exact False.elim (hparamw (by rw [hwprev]; exact hadv.2)) + have hstartEq : s.start (s.edge (b + 1) + 1) = j - 1 := by + calc + s.start (s.edge (b + 1) + 1) = z.2.2 := by + calc + _ = s.start (s.edge w + 1) := by simp [b, hwprev] + _ = z.2.2 := congrArg Prod.snd (congrArg Prod.snd hztuple) + _ = j - 1 := hleft.symm + have hcontr := congrArg s.edge hstartEq + rw [s.edge_start] at hcontr + have heqEdge : s.edge (b + 1) + 1 = s.edge j := by + simpa [hsame] using hcontr + rw [hsameb, hbnext] at heqEdge + have htwo : s.edge j + 2 = s.edge j := by + calc + s.edge j + 2 = (s.edge j + 1) + 1 := by + rw [show (2 : Fin (r + 3)) = 1 + 1 by norm_num] + simp [add_assoc] + _ = s.edge j := heqEdge + have htwoFin : (2 : Fin (r + 3)) = 0 := by + exact add_left_cancel (show s.edge j + 2 = s.edge j + 0 by simpa using htwo) + have hvtwo := congrArg Fin.val htwoFin + change 2 % (r + 3) = 0 at hvtwo + rw [Nat.mod_eq_of_lt (by omega : 2 < r + 3)] at hvtwo + omega + +private theorem hseed : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ (j : Fin (n + (3 : ℕ))), s.parameter j + = (0 : ℝ) → j = s.start (s.edge j)) → (∀ (h : ℕ), ∀ [NeZero (n + (3 : ℕ))], + let c := P3523T1InsertionConstruction s t + ∀ (j : Fin (n + (3 : ℕ))), (s.edge (j - 1) = s.edge j) → (((s.parameter (j - 1) ≠ 0) → (((j - + 1) - 1, j - 1, s.start (s.edge (j - 1) + 1)) ∈ c.steps.take h)) → ( + let P : Finset (Fin (n + 3)) := {j - 1, s.start (s.edge j + 1)} + P ∈ (Finset.univ.image fun i : Fin (r + 3) => + ({s.start i, s.start (i + 1)} : Finset (Fin (n + 3)))) ∨ + ∃ z ∈ c.steps.take h, + P = {z.1, z.2.1} ∨ P = {z.2.1, z.2.2}))) := by + classical + intro r n q p s X K t hzero h this c j hsame prevTupleMem P + by_cases hzprev : s.parameter (j - 1) = 0 + · left + apply Finset.mem_image.mpr + refine ⟨s.edge j, Finset.mem_univ _, ?_⟩ + have hstart := hzero (j - 1) hzprev + simp only [P] + rw [hstart, hsame] + · right + have hprev := prevTupleMem hzprev + refine ⟨((j - 1) - 1, j - 1, s.start (s.edge (j - 1) + 1)), hprev, Or.inr ?_⟩ + simp only [P, hsame] + +private theorem hvertices : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ (j : Fin (n + (3 : ℕ))), s.parameter j + = (0 : ℝ) → j = s.start (s.edge j)) → ((P3523T1InsertionConstruction s t).vertices + (P3523T1InsertionConstruction s t).steps.length = Finset.univ) := by + classical + intro r n q p s X K t hzero + classical + let c := P3523T1InsertionConstruction s t + have hinj : Function.Injective (fun k : Fin (n + 3) => s.start 0 + k) := by + intro a b hab + exact add_left_cancel hab + have himage : Finset.univ.image (fun k : Fin (n + 3) => s.start 0 + k) = + (Finset.univ : Finset (Fin (n + 3))) := by + apply Finset.eq_univ_of_card + rw [Finset.card_image_of_injective _ hinj] + simp + have fold_mem (l : List (Fin (n + 3) × Fin (n + 3) × Fin (n + 3))) + (A : Finset (Fin (n + 3))) (x : Fin (n + 3)) + (hx : x ∈ A ∨ x ∈ l.map (fun e => e.2.1)) : + x ∈ l.foldl (fun vs e => insert e.2.1 vs) A := by + induction l generalizing A with + | nil => simpa using hx.elim id (by simp) + | cons a l ih => + simp only [List.map_cons, List.mem_cons] at hx + simp only [List.foldl_cons] + rcases hx with hxA | hx + · apply ih (A := insert a.2.1 A) + exact Or.inl (Finset.mem_insert.mpr (Or.inr hxA)) + · rcases hx with hxa | hx + · subst x + apply ih (A := insert a.2.1 A) + exact Or.inl (Finset.mem_insert.mpr (Or.inl rfl)) + · apply ih (A := insert a.2.1 A) + exact Or.inr hx + change (c.steps.take c.steps.length).foldl + (fun vs e => insert e.2.1 vs) (Finset.univ.image s.start) = Finset.univ + simp only [List.take_length] + ext x + constructor + · intro _ + simp + · intro _ + by_cases hz : s.parameter x = 0 + · have hxstart := hzero x hz + rw [hxstart] + apply fold_mem + left + exact Finset.mem_image.mpr ⟨s.edge x, Finset.mem_univ _, rfl⟩ + · apply fold_mem + right + change x ∈ (List.map (fun j => (j - 1, j, s.start (s.edge j + 1))) + (List.filter (fun j => decide (s.parameter j ≠ 0)) + (List.ofFn fun k : Fin (n + 3) => s.start 0 + k))).map + (fun e => e.2.1) + have hximg : x ∈ Finset.univ.image (fun k : Fin (n + 3) => s.start 0 + k) := by + rw [himage] + exact Finset.mem_univ x + obtain ⟨k, _, hk⟩ := Finset.mem_image.mp hximg + have hxsource : x ∈ List.ofFn (fun k : Fin (n + 3) => s.start 0 + k) := + List.mem_ofFn.mpr ⟨k, hk⟩ + have hxfilter : x ∈ List.filter (fun j => decide (s.parameter j ≠ 0)) + (List.ofFn fun k : Fin (n + 3) => s.start 0 + k) := + List.mem_filter.mpr ⟨hxsource, by simp [hz]⟩ + simpa [List.map_map] using hxfilter + +private theorem pairCasesAt830 : + ∀ (n : Nat), ∀ {a : Fin (n + 3)}, ∀ {b : Fin (n + 3)}, ∀ {c : Fin (n + 3)}, ∀ + {d : Fin (n + 3)}, (a ≠ b) → ((({a, b} : Finset (Fin (n + 3))) = {c, d}) → ((a = c ∧ b = + d) ∨ (a = d ∧ b = c))) := by + classical + intro n a b c d hab h + have hac : a = c ∨ a = d := by + have ha : a ∈ ({c, d} : Finset (Fin (n + 3))) := by + rw [← h] + simp + simpa only [Finset.mem_insert, Finset.mem_singleton] using ha + rcases hac with hac | had + · have hb : b = c ∨ b = d := by + have hb' : b ∈ ({c, d} : Finset (Fin (n + 3))) := by + rw [← h] + simp + simpa only [Finset.mem_insert, Finset.mem_singleton] using hb' + rcases hb with hbc | hbd + · exact False.elim (hab (hac.trans hbc.symm)) + · exact Or.inl ⟨hac, hbd⟩ + · have hb : b = c ∨ b = d := by + have hb' : b ∈ ({c, d} : Finset (Fin (n + 3))) := by + rw [← h] + simp + simpa only [Finset.mem_insert, Finset.mem_singleton] using hb' + rcases hb with hbc | hbd + · exact Or.inr ⟨had, hbc⟩ + · exact False.elim (hab (had.trans hbd.symm)) + +private theorem boundaryEdgeInj : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), (∀ {a : Fin (n + 3)}, ∀ {b : Fin (n + 3)}, + ∀ {c : Fin (n + 3)}, ∀ {d : Fin (n + 3)}, (a ≠ b) → ((({a, b} : Finset (Fin (n + 3))) = + {c, d}) → ((a = c ∧ b = d) ∨ (a = d ∧ b = c)))) → ((∀ (i : Fin (r + 3)), i ≠ i + 1) → + (Function.Injective + (fun i : Fin (r + 3) => + ({s.start i, s.start (i + 1)} : Finset (Fin (n + 3)))))) := by + classical + intro r n q p s pairCases adjacentNe i j hij + have hends := pairCases (by + intro h + exact adjacentNe i (s.start_injective (by simpa using h))) hij + rcases hends with ⟨hleft, _⟩ | ⟨hleft, hright⟩ + · exact s.start_injective hleft + · have hij' : i = j + 1 := s.start_injective hleft + have hji' : i + 1 = j := s.start_injective hright + have htwo : i + 2 = i := by + calc + i + 2 = (i + 1) + 1 := by + rw [show (2 : Fin (r + 3)) = 1 + 1 by norm_num] + simp [add_assoc] + _ = j + 1 := by rw [hji'] + _ = i := by rw [hij'] + have htwoFin : (2 : Fin (r + 3)) = 0 := + add_left_cancel (show i + 2 = i + 0 by simpa using htwo) + have hv := congrArg Fin.val htwoFin + change 2 % (r + 3) = 0 at hv + rw [Nat.mod_eq_of_lt (by omega : 2 < r + 3)] at hv + omega + +private theorem boundaryCardUpdate : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), (P3475T1BoundarySubdivision q p) → (∀ (B : Finset (Finset (Fin (n + 3)))), ∀ (V : + Finset (Fin (n + 3))), ∀ (a : Fin (n + 3)), ∀ (d : Fin (n + 3)), ∀ (b : Fin (n + 3)), (a + ≠ b) → ((a ∈ V) → ((b ∈ V) → ((d ∉ V) → ((∀ P ∈ B, ∀ x ∈ P, x ∈ V) → (({a, b} ∈ B) → + ((insert {a, d} (insert {d, b} (B.erase {a, b}))).card = B.card + 1))))))) := by + classical + intro r n q p s B V a d b hab ha hb hd hend herase + have had : a ≠ d := by + intro h + exact hd (h ▸ ha) + have hbd : b ≠ d := by + intro h + exact hd (h ▸ hb) + have hnewA : ({a, d} : Finset (Fin (n + 3))) ∉ B := by + intro hmem + have hdmem : d ∈ ({a, d} : Finset (Fin (n + 3))) := by simp + exact hd (hend _ hmem d hdmem) + have hnewB : ({d, b} : Finset (Fin (n + 3))) ∉ B := by + intro hmem + have hdmem : d ∈ ({d, b} : Finset (Fin (n + 3))) := by simp + exact hd (hend _ hmem d hdmem) + have hnewNe : ({a, d} : Finset (Fin (n + 3))) ≠ {d, b} := by + intro heq + have hamem : a ∈ ({d, b} : Finset (Fin (n + 3))) := by + rw [← heq] + simp + rcases Finset.mem_insert.mp hamem with had' | hab' + · exact had had' + · exact hab (Finset.mem_singleton.mp hab') + have hnewBErase : ({d, b} : Finset (Fin (n + 3))) ∉ B.erase {a, b} := by + intro hmem + exact hnewB (Finset.mem_erase.mp hmem).2 + have hnewAnot : ({a, d} : Finset (Fin (n + 3))) ∉ + insert {d, b} (B.erase {a, b}) := by + intro hmem + rcases Finset.mem_insert.mp hmem with hnew | hmem + · exact hnewNe hnew + · exact hnewA (Finset.mem_erase.mp hmem).2 + rw [Finset.card_insert_of_notMem hnewAnot, + Finset.card_insert_of_notMem hnewBErase, + Finset.card_erase_of_mem herase] + have hcardpos : 0 < B.card := Finset.card_pos.mpr ⟨{a, b}, herase⟩ + have hcardpos' : 1 ≤ B.card := hcardpos + omega + +private theorem hstate : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), ((∀ h : Nat, ∀ hh : h < + (P3523T1InsertionConstruction s t).steps.length, + let e := (P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩ + e.1 ≠ e.2.2 ∧ e.1 ∈ (P3523T1InsertionConstruction s t).vertices h ∧ + e.2.2 ∈ (P3523T1InsertionConstruction s t).vertices h ∧ + e.2.1 ∉ (P3523T1InsertionConstruction s t).vertices h ∧ + {e.1, e.2.2} ∈ (P3523T1InsertionConstruction s t).boundary h ∧ + ∃ u : Real, 0 < u ∧ u < 1 ∧ + p.vertex e.2.1 = (1 - u) • p.vertex e.1 + u • p.vertex e.2.2 ∧ + P3523T1InterpolatedTarget s t e.2.1 = + (1 - u) • P3523T1InterpolatedTarget s t e.1 + + u • P3523T1InterpolatedTarget s t e.2.2)) → ( + let c := P3523T1InsertionConstruction s t + let initialBoundary := Finset.univ.image (fun i : Fin (r + 3) => + ({s.start i, s.start (i + 1)} : Finset (Fin (n + 3)))) + let initialVertices := Finset.univ.image s.start + (initialBoundary.card = initialVertices.card) → ((∀ (B : Finset (Finset (Fin (n + 3)))), ∀ (V + : Finset (Fin (n + 3))), ∀ (a : Fin (n + 3)), ∀ (d : Fin (n + 3)), ∀ (b : Fin (n + 3)), + (a ≠ b) → ((a ∈ V) → ((b ∈ V) → ((d ∉ V) → ((∀ P ∈ B, ∀ x ∈ P, x ∈ V) → (({a, b} ∈ B) → + ((insert {a, d} (insert {d, b} (B.erase {a, b}))).card = B.card + 1))))))) → (∀ h : Nat, + h ≤ c.steps.length → + (∀ P ∈ c.boundary h, ∀ x ∈ P, x ∈ c.vertices h) ∧ + (c.boundary h).card = (c.vertices h).card))) := by + classical + intro r n q p s X K t hvalid c initialBoundary initialVertices hinitCard boundaryCardUpdate + let boundaryStep := fun + (es : Finset (Finset (Fin (n + 3)))) + (e : Fin (n + 3) × Fin (n + 3) × Fin (n + 3)) => + insert {e.1, e.2.1} + (insert {e.2.1, e.2.2} (es.erase {e.1, e.2.2})) + intro h + induction h with + | zero => + intro _ + constructor + · simp [c, P3523T1InsertionConstruction] + · simpa [c, P3523T1InsertionConstruction, initialBoundary, + initialVertices] using hinitCard + | succ h ih => + intro hle + have hh : h < c.steps.length := by omega + have hprev := ih (by omega) + have hentry := hvalid h hh + rcases hentry with ⟨hab, ha, hb, hd, herase, _⟩ + have hboundaryRec : c.boundary (h + 1) = + boundaryStep (c.boundary h) c.steps[h] := by + change (c.steps.take (h + 1)).foldl + (fun es e => insert {e.1, e.2.1} + (insert {e.2.1, e.2.2} (es.erase {e.1, e.2.2}))) initialBoundary = _ + rw [List.take_succ_eq_append_getElem hh] + simp only [List.foldl_append, List.foldl_cons, List.foldl_nil] + rfl + have hverticesRec : c.vertices (h + 1) = + insert c.steps[h].2.1 (c.vertices h) := by + change (c.steps.take (h + 1)).foldl + (fun vs e => insert e.2.1 vs) initialVertices = _ + rw [List.take_succ_eq_append_getElem hh] + simp only [List.foldl_append, List.foldl_cons, List.foldl_nil] + rfl + have hupdateCard : + (c.boundary (h + 1)).card = (c.boundary h).card + 1 := by + rw [hboundaryRec] + exact boundaryCardUpdate (c.boundary h) (c.vertices h) + (c.steps[h].1) (c.steps[h].2.1) (c.steps[h].2.2) + (by simpa using hab) (by simpa using ha) (by simpa using hb) + (by simpa using hd) hprev.1 (by simpa using herase) + have hupdateVertices : + (c.vertices (h + 1)).card = (c.vertices h).card + 1 := by + rw [hverticesRec] + have hfresh : c.steps[h].2.1 ∉ c.vertices h := by simpa using hd + exact Finset.card_insert_of_notMem hfresh + constructor + · intro P hP x hx + rw [hboundaryRec] at hP + rw [hverticesRec] + simp only [boundaryStep, Finset.mem_insert] at hP + rcases hP with hA | hP + · subst P + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + rcases hx with hx | hx + · subst x + exact Finset.mem_insert.mpr (Or.inr ha) + · subst x + exact Finset.mem_insert.mpr (Or.inl rfl) + · rcases hP with hB | hP + · subst P + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + rcases hx with hx | hx + · subst x + exact Finset.mem_insert.mpr (Or.inl rfl) + · subst x + exact Finset.mem_insert.mpr (Or.inr hb) + · have hold : P ∈ c.boundary h := (Finset.mem_erase.mp hP).2 + exact Finset.mem_insert.mpr (Or.inr (hprev.1 P hold x hx)) + · rw [hupdateCard, hupdateVertices, hprev.2] + +private theorem targetPairInj : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), (P3475T1BoundarySubdivision q p) → (∀ (X : Set (Real × Real)), ∀ (K : Set (Real × + Real)), (P3475T1TriangleTree q X K) → ((∀ {a : Fin (n + 3)}, ∀ {b : Fin (n + 3)}, ∀ + {c : Fin (n + 3)}, ∀ {d : Fin (n + 3)}, (a ≠ b) → ((({a, b} : Finset (Fin (n + 3))) = + {c, + d}) → ((a = c ∧ b = d) ∨ (a = d ∧ b = c)))) → ((∀ (i : Fin (n + 3)), i ≠ i + 1) → + (Function.Injective + (fun i : Fin (n + 3) => ({i, i + 1} : Finset (Fin (n + 3)))))))) := by + classical + intro r n q p s X K t pairCases targetAdjNe i j hij + have hcases := pairCases (targetAdjNe i) hij + rcases hcases with ⟨hij, _⟩ | ⟨hij, hji⟩ + · exact hij + · have htwo : i + 2 = i := by + calc + i + 2 = (i + 1) + 1 := by + rw [show (2 : Fin (n + 3)) = 1 + 1 by norm_num] + simp [add_assoc] + _ = j + 1 := by rw [hji] + _ = i := by rw [hij] + have htwoFin : (2 : Fin (n + 3)) = 0 := + add_left_cancel (show i + 2 = i + 0 by simpa using htwo) + have hv := congrArg Fin.val htwoFin + change 2 % (n + 3) = 0 at hv + rw [Nat.mod_eq_of_lt (by omega : 2 < n + 3)] at hv + omega + +private theorem keepBoundaryAt1047 : + ∀ (n : Nat), + let boundaryStep := fun + (es : Finset (Finset (Fin (n + 3)))) + (e : Fin (n + 3) × Fin (n + 3) × Fin (n + 3)) => + insert {e.1, e.2.1} + (insert {e.2.1, e.2.2} (es.erase {e.1, e.2.2})) + ∀ (l : List (Fin (n + 3) × Fin (n + 3) × Fin (n + 3))), ∀ (A : Finset (Finset (Fin (n + + 3)))), ∀ (P : Finset (Fin (n + 3))), (P ∈ A ∨ ∃ e ∈ l, + P = {e.1, e.2.1} ∨ P = {e.2.1, e.2.2}) → ((∀ e ∈ l, P ≠ {e.1, e.2.2}) → (P ∈ l.foldl + boundaryStep A)) := by + classical + intro n boundaryStep l A P hseed hno + induction l generalizing A with + | nil => + rcases hseed with hA | ⟨e, he, _⟩ + · simpa using hA + · simp at he + | cons a l ih => + simp only [List.foldl_cons] + rcases hseed with hA | ⟨e, he, hedge⟩ + · apply ih (A := boundaryStep A a) + · left + change P ∈ insert {a.1, a.2.1} + (insert {a.2.1, a.2.2} (A.erase {a.1, a.2.2})) + simp only [Finset.mem_insert, Finset.mem_erase] + exact Or.inr (Or.inr ⟨hno a (by simp), hA⟩) + · intro b hb + exact hno b (by simp [hb]) + · rcases List.mem_cons.mp he with heq | heTail + · subst e + apply ih (A := boundaryStep A a) + · left + rcases hedge with h1 | h2 + · simp [boundaryStep, h1] + · simp [boundaryStep, h2] + · intro b hb + exact hno b (by simp [hb]) + · apply ih (A := boundaryStep A a) + · right + exact ⟨e, heTail, hedge⟩ + · intro b hb + exact hno b (by simp [hb]) + +private theorem memStep : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (Finset.univ.image (fun k : Fin (n + 3) => s.start 0 + k) = (Finset.univ : Finset (Fin (n + + 3)))) → (∀ (j : Fin (n + 3)), (s.parameter j ≠ 0) → ((j - 1, j, s.start (s.edge j + 1)) ∈ + c.steps)) := by + classical + intro r n q p s X K t c hshiftImage j hj + change (j - 1, j, s.start (s.edge j + 1)) ∈ + (List.map (fun z => (z - 1, z, s.start (s.edge z + 1))) + (List.filter (fun z => decide (s.parameter z ≠ 0)) + (List.ofFn fun k : Fin (n + 3) => s.start 0 + k))) + apply List.mem_map.mpr + refine ⟨j, ?_, rfl⟩ + apply List.mem_filter.mpr + constructor + · obtain ⟨k, _, hk⟩ := Finset.mem_image.mp (by + rw [hshiftImage] + exact Finset.mem_univ j) + exact List.mem_ofFn.mpr ⟨k, hk⟩ + · simp [hj] + +private theorem noErase : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + (∀ {a : Fin (n + 3)}, ∀ {b : Fin (n + 3)}, ∀ {c : Fin (n + 3)}, ∀ {d : Fin (n + 3)}, (a ≠ b) + → ((({a, b} : Finset (Fin (n + 3))) = {c, d}) → ((a = c ∧ b = d) ∨ (a = d ∧ b = c)))) → + ((∀ (i : Fin (n + 3)), i ≠ i + 1) → (∀ (x : Fin (n + 3)), ∀ e ∈ c.steps, ({x, x + 1} : + Finset (Fin (n + 3))) ≠ {e.1, e.2.2})) := by + classical + intro r n q p s X K t c pairCases targetAdjNe x e he hpair + change e ∈ List.map (fun z => (z - 1, z, s.start (s.edge z + 1))) + (List.filter (fun z => decide (s.parameter z ≠ 0)) + (List.ofFn fun k : Fin (n + 3) => s.start 0 + k)) at he + rcases List.mem_map.mp he with ⟨w, hw, htuple⟩ + have hwf := List.mem_filter.mp hw + have hparamw : s.parameter w ≠ 0 := of_decide_eq_true hwf.2 + have hpw : (w - 1) + 1 = w := by simp + have hsPrev := s.successor (w - 1) + rw [hpw] at hsPrev + have hsamew : s.edge (w - 1) = s.edge w := by + rcases hsPrev with h | h + · exact h.1.symm + · exact False.elim (hparamw h.2) + have hwleft : e.1 = w - 1 := congrArg Prod.fst htuple.symm + have hwend : e.2.2 = s.start (s.edge w + 1) := + (congrArg Prod.snd (congrArg Prod.snd htuple)).symm + have hcases := pairCases (targetAdjNe x) hpair + rcases hcases with ⟨hleft, hright⟩ | ⟨hleft, hright⟩ + · have hwx : w = x + 1 := by + calc + w = (w - 1) + 1 := hpw.symm + _ = x + 1 := by rw [← hwleft, hleft] + have hstart : w = s.start (s.edge w + 1) := by + calc + w = x + 1 := hwx + _ = e.2.2 := hright + _ = s.start (s.edge w + 1) := hwend + have hz : s.parameter w = 0 := by + rw [hstart] + exact s.parameter_start _ + exact hparamw hz + · have hwx : w = x + 2 := by + calc + w = (w - 1) + 1 := hpw.symm + _ = (x + 1) + 1 := by rw [← hwleft, hright] + _ = x + 2 := by + rw [show (2 : Fin (n + 3)) = 1 + 1 by norm_num] + simp [add_assoc] + have hxstart : x = s.start (s.edge w + 1) := by + calc + x = e.2.2 := hleft + _ = s.start (s.edge w + 1) := hwend + have hedgeX : s.edge x = s.edge w + 1 := by + rw [hxstart] + exact s.edge_start _ + have hEdgeW : s.edge w = s.edge (x + 1) := by + calc + s.edge w = s.edge (w - 1) := hsamew.symm + _ = s.edge (x + 1) := by rw [← hwleft, hright] + rcases s.successor x with hsX | haX + · have hzeroOne : (1 : Fin (r + 3)) = 0 := by + have hEq : s.edge x = s.edge x + 1 := by + calc + s.edge x = s.edge w + 1 := hedgeX + _ = s.edge (x + 1) + 1 := by rw [hEdgeW] + _ = s.edge x + 1 := by rw [hsX.1] + exact add_left_cancel + (show s.edge x + 1 = s.edge x + 0 by simpa using hEq.symm) + have hv := congrArg Fin.val hzeroOne + norm_num at hv + · have hzeroTwo : (2 : Fin (r + 3)) = 0 := by + have hEq : s.edge x = s.edge x + 2 := by + calc + s.edge x = s.edge w + 1 := hedgeX + _ = s.edge (x + 1) + 1 := by rw [hEdgeW] + _ = s.edge x + 2 := by + rw [haX.1, show (2 : Fin (r + 3)) = 1 + 1 by norm_num] + simp [add_assoc] + exact add_left_cancel + (show s.edge x + 2 = s.edge x + 0 by simpa using hEq.symm) + have hv := congrArg Fin.val hzeroTwo + change 2 % (r + 3) = 0 at hv + rw [Nat.mod_eq_of_lt (by omega : 2 < r + 3)] at hv + omega + +private theorem cycleSeed : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ (j : Fin (n + (3 : ℕ))), s.parameter j + = (0 : ℝ) → j = s.start (s.edge j)) → ( + let c := P3523T1InsertionConstruction s t + let initialBoundary := Finset.univ.image (fun i : Fin (r + 3) => + ({s.start i, s.start (i + 1)} : Finset (Fin (n + 3)))) + (∀ {a : Fin (n + 3)}, ∀ {b : Fin (n + 3)}, ∀ {c : Fin (n + 3)}, ∀ {d : Fin (n + 3)}, (a = c) + → ((b = d) → (({a, b} : Finset (Fin (n + 3))) = {c, d}))) → ((∀ (j : Fin (n + 3)), + (s.parameter j ≠ 0) → ((j - 1, j, s.start (s.edge j + 1)) ∈ c.steps)) → (∀ (x : Fin (n + + 3)), ({x, x + 1} : Finset (Fin (n + 3))) ∈ initialBoundary ∨ + ∃ e ∈ c.steps, + ({x, x + 1} : Finset (Fin (n + 3))) = {e.1, e.2.1} ∨ + ({x, x + 1} : Finset (Fin (n + 3))) = {e.2.1, e.2.2}))) := by + classical + intro r n q p s X K t hzero c initialBoundary pairEq memStep x + by_cases hyzero : s.parameter (x + 1) = 0 + · by_cases hxzero : s.parameter x = 0 + · left + have hxstart := hzero x hxzero + have hystart := hzero (x + 1) hyzero + have hsx := s.successor x + have hadv : s.edge (x + 1) = s.edge x + 1 := by + rcases hsx with hs | ha + · have hlt := hs.2 + rw [hyzero] at hlt + have hnonneg := s.parameter_nonneg x + linarith + · exact ha.1 + apply Finset.mem_image.mpr + refine ⟨s.edge x, Finset.mem_univ _, ?_⟩ + have hright : x + 1 = s.start (s.edge x + 1) := by + rw [hadv] at hystart + exact hystart + exact pairEq hxstart.symm hright.symm + · right + have hstep := memStep x hxzero + refine ⟨(x - 1, x, s.start (s.edge x + 1)), hstep, Or.inr ?_⟩ + have hystart := hzero (x + 1) hyzero + have hsx := s.successor x + have hadv : s.edge (x + 1) = s.edge x + 1 := by + rcases hsx with hs | ha + · have hlt := hs.2 + rw [hyzero] at hlt + have hnonneg := s.parameter_nonneg x + linarith + · exact ha.1 + have hright : x + 1 = s.start (s.edge x + 1) := by + rw [hadv] at hystart + exact hystart + exact pairEq rfl hright + · right + have hstep := memStep (x + 1) hyzero + refine ⟨(x + 1 - 1, x + 1, s.start (s.edge (x + 1) + 1)), hstep, Or.inl ?_⟩ + have hpred : x + 1 - 1 = x := by simp + exact pairEq hpred.symm rfl + +private theorem htargetSubset : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let c := P3523T1InsertionConstruction s t + let initialBoundary := Finset.univ.image (fun i : Fin (r + 3) => + ({s.start i, s.start (i + 1)} : Finset (Fin (n + 3)))) + let targetBoundary := Finset.univ.image (fun j : Fin (n + 3) => + ({j, j + 1} : Finset (Fin (n + 3)))) + let boundaryStep := fun + (es : Finset (Finset (Fin (n + 3)))) + (e : Fin (n + 3) × Fin (n + 3) × Fin (n + 3)) => + insert {e.1, e.2.1} + (insert {e.2.1, e.2.2} (es.erase {e.1, e.2.2})) + (∀ (l : List (Fin (n + 3) × Fin (n + 3) × Fin (n + 3))), ∀ (A : Finset (Finset (Fin (n + + 3)))), ∀ (P : Finset (Fin (n + 3))), (P ∈ A ∨ ∃ e ∈ l, P = {e.1, e.2.1} ∨ P = {e.2.1, + e.2.2}) → ((∀ e ∈ l, P ≠ {e.1, e.2.2}) → (P ∈ l.foldl boundaryStep A))) → ((∀ (x : Fin (n + + 3)), ∀ e ∈ c.steps, ({x, x + 1} : Finset (Fin (n + 3))) ≠ {e.1, e.2.2}) → ((∀ (x : Fin + (n + 3)), ({x, x + 1} : Finset (Fin (n + 3))) ∈ initialBoundary ∨ ∃ e ∈ c.steps, ({x, + x + 1} : Finset (Fin (n + 3))) = {e.1, e.2.1} ∨ ({x, x + 1} : Finset (Fin (n + 3))) = + {e.2.1, e.2.2}) → (targetBoundary ⊆ c.boundary c.steps.length))) := by + classical + intro r n q p s X K t c initialBoundary targetBoundary boundaryStep keepBoundary noErase + cycleSeed P hP + rcases Finset.mem_image.mp hP with ⟨x, -, rfl⟩ + have hkeep := keepBoundary c.steps initialBoundary {x, x + 1} + (cycleSeed x) (noErase x) + change {x, x + 1} ∈ + (c.steps.take c.steps.length).foldl + (fun es e => insert {e.1, e.2.1} + (insert {e.2.1, e.2.2} (es.erase {e.1, e.2.2}))) initialBoundary + rw [List.take_length] + exact hkeep + +end OrderedInsertionGeometry + +namespace OrderedInsertionDetails + +private theorem hsameAt1300 : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ [NeZero (n + (3 : ℕ))], + ∀ (j : Fin (n + (3 : ℕ))), (s.parameter j ≠ 0) → ((s.edge j = s.edge (j - (1 : Fin (n + (3 : + ℕ)))) ∧ s.parameter (j - (1 : Fin (n + (3 : ℕ)))) < s.parameter j ∨ s.edge j = s.edge (j + - (1 : Fin (n + (3 : ℕ)))) + (1 : Fin (r + (3 : ℕ))) ∧ s.parameter j = (0 : ℝ)) → (s.edge + (j - 1) = s.edge j)) := by + classical + intro r n q p s this j hparam hs + rcases hs with h | h + · exact h.1.symm + · exact False.elim (hparam h.2) + +private theorem hnext : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (j : Fin (n + (3 : ℕ))), s.edge j ≠ + s.edge j + 1 := by + classical + intro r n q p s j h + have hone : (1 : Fin (r + 3)) = 0 := + add_left_cancel (show s.edge j + 1 = s.edge j + 0 by simp at h) + have hv := congrArg Fin.val hone + norm_num at hv + +private theorem hne : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ [NeZero (n + (3 : ℕ))], + ∀ (j : Fin (n + (3 : ℕ))), (s.edge (j - 1) = s.edge j) → ((s.edge j ≠ s.edge j + 1) → (j - 1 + ≠ s.start (s.edge j + 1))) := by + classical + intro r n q p s this j hsame hnext h + have hed := congrArg s.edge h + rw [hsame, s.edge_start] at hed + exact hnext hed + +private theorem hlt : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ [NeZero (n + (3 : ℕ))], + ∀ (j : Fin (n + (3 : ℕ))), (s.parameter j ≠ 0) → ((s.edge j = s.edge (j - (1 : Fin (n + (3 : + ℕ)))) ∧ s.parameter (j - (1 : Fin (n + (3 : ℕ)))) < s.parameter j ∨ s.edge j = s.edge (j + - (1 : Fin (n + (3 : ℕ)))) + (1 : Fin (r + (3 : ℕ))) ∧ s.parameter j = (0 : ℝ)) → + (s.parameter (j - 1) < s.parameter j)) := by + classical + intro r n q p s this j hparam hs + rcases hs with h | h + · exact h.2 + · exact False.elim (hparam h.2) + +private theorem hu : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ [NeZero (n + (3 : ℕ))], + ∀ (j : Fin (n + (3 : ℕ))), (s.parameter (j - 1) < s.parameter j) → ( + let t₀ := s.parameter (j - 1) + let t₁ := s.parameter j + let u := (t₁ - t₀) / (1 - t₀) + (t₀ < 1) → ((t₁ < 1) → (0 < u ∧ u < 1))) := by + classical + intro r n q p s this j hlt t₀ t₁ u ht₀one ht₁one + dsimp [u] + constructor + · exact div_pos (sub_pos.mpr hlt) (sub_pos.mpr ht₀one) + · rw [div_lt_one (sub_pos.mpr ht₀one)] + linarith + +private theorem hc₀ : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ [NeZero (n + (3 : ℕ))], + ∀ (j : Fin (n + (3 : ℕ))), + let t₀ := s.parameter (j - 1) + let t₁ := s.parameter j + let u := (t₁ - t₀) / (1 - t₀) + (1 - t₀ ≠ 0) → ((1 - u) * (1 - t₀) = 1 - t₁) := by + classical + intro r n q p s this j t₀ t₁ u hden + dsimp [u] + field_simp [hden] + ring + +private theorem hc₁ : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ [NeZero (n + (3 : ℕ))], + ∀ (j : Fin (n + (3 : ℕ))), + let t₀ := s.parameter (j - 1) + let t₁ := s.parameter j + let u := (t₁ - t₀) / (1 - t₀) + (1 - t₀ ≠ 0) → ((1 - u) * t₀ + u = t₁) := by + classical + intro r n q p s this j t₀ t₁ u hden + dsimp [u] + field_simp [hden] + ring + +private theorem retain : + ∀ (n : Nat), ∀ (l : List (Fin (n + 3) × Fin (n + 3) × Fin (n + 3))), ∀ (A : Finset (Fin (n + + 3))), ∀ (x : Fin (n + 3)), (x ∈ A) → (x ∈ l.foldl (fun vs e => insert e.2.1 vs) A) := by + classical + intro n l A x hx + induction l generalizing A with + | nil => simpa + | cons a l ih => + simpa only [List.foldl_cons] using + ih (insert a.2.1 A) (Finset.mem_insert.mpr (Or.inr hx)) + +private theorem hrawNodup : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), (List.ofFn fun k : Fin (n + 3) => s.start 0 + + k).Nodup := by + classical + intro r n q p s + apply List.nodup_ofFn.mpr + intro a b hab + exact add_left_cancel hab + +private theorem htupleInj : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ [NeZero (n + (3 : ℕ))], + Function.Injective + (fun j : Fin (n + 3) => (j - 1, j, s.start (s.edge j + 1))) := by + classical + intro r n q p s this a b hab + exact congrArg (fun e : Fin (n + 3) × Fin (n + 3) × Fin (n + 3) => e.2.1) hab + +private theorem hstepsNodup : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ [NeZero (n + (3 : ℕ))], + let c := P3523T1InsertionConstruction s t + ((List.filter (fun j => decide (s.parameter j ≠ 0)) (List.ofFn fun k : Fin (n + 3) => s.start + 0 + k)).Nodup) → ((Function.Injective (fun j : Fin (n + 3) => (j - 1, j, s.start (s.edge + j + 1)))) → (c.steps.Nodup)) := by + classical + intro r n q p s X K t this c hfilterNodup htupleInj + change (List.map (fun j => (j - 1, j, s.start (s.edge j + 1))) + (List.filter (fun j => decide (s.parameter j ≠ 0)) + (List.ofFn fun k : Fin (n + 3) => s.start 0 + k))).Nodup + exact hfilterNodup.map htupleInj + +private theorem getNotTake : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), (P3475T1BoundarySubdivision q p) → (∀ (X : Set (Real × Real)), ∀ (K : Set (Real × + Real)), (P3475T1TriangleTree q X K) → ((ℕ) → ((Fin (n + (3 : ℕ))) → ((Fin (n + (3 : + ℕ))) → (∀ {α : Type}, ∀ (l : List α), (l.Nodup) → (∀ (m : Nat), ∀ (hm : m < l.length), + l.get ⟨m, hm⟩ ∉ l.take m)))))) := by + classical + intro r n q p s X K t h j k α l hn m hm hmem + rcases List.mem_take_iff_getElem.mp hmem with ⟨i, hi, heq⟩ + have hi' : i < m := by omega + have hiList : i < l.length := lt_trans hi' hm + have heq' : l[i] = l[m] := by simpa using heq + have hidx := hn.getElem_inj_iff.mp heq' + omega + +private theorem hkpos : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (h : ℕ), ∀ [NeZero (n + (3 : ℕ))], + ∀ (j : Fin (n + (3 : ℕ))), ∀ (k : Fin (n + (3 : ℕ))), ∀ (hk : s.start (0 : Fin (r + (3 : ℕ))) + + k = j), ∀ (hparam : s.parameter j ≠ 0), ∀ (hp : (j - 1) + 1 = j), (∀ {α : Type}, ∀ (l : + List α), ∀ (p : α → Bool), ∀ (k : Nat), ∀ (h : Nat), ∀ (hn : l.Nodup), ∀ (hk : k < + l.length), ∀ (hpos : 0 < k), ∀ (hlen : h < (l.filter p).length), (p (l.get ⟨k - 1, + by omega⟩) = true) → (((l.filter p).get ⟨h, hlen⟩ = l.get ⟨k, hk⟩) → (l.get ⟨k - 1, + by omega⟩ ∈ (l.filter p).take h))) → (0 < k.val) := by + classical + intro r n q p s X K t h this j k hk hparam hp filterPrev + by_contra hnot + have hkval : k.val = 0 := by omega + have hkz : k = 0 := Fin.ext hkval + subst k + have hjstart : j = s.start 0 := by simpa using hk.symm + exact hparam (by rw [hjstart]; exact s.parameter_start 0) + +private theorem hkprev : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (h : ℕ), ∀ [NeZero (n + (3 : ℕ))], + ∀ (j : Fin (n + (3 : ℕ))), ∀ (k : Fin (n + (3 : ℕ))), ∀ (hp : (j - 1) + 1 = j), + let raw := List.ofFn (fun k : Fin (n + 3) => s.start 0 + k) + let kp : Fin (n + 3) := ⟨k.val - 1, by omega⟩ + (raw.length = n + 3) → ((0 < k.val) → (kp + 1 = k)) := by + classical + intro r n q p s X K t h this j k hp raw kp hrawLen hkpos + apply Fin.ext + rw [Fin.val_add_eq_of_add_lt (by simp [kp]; omega)] + simp [kp] + omega + +private theorem hprevLabel : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (h : ℕ), ∀ [NeZero (n + (3 : ℕ))], + ∀ (j : Fin (n + (3 : ℕ))), ∀ (k : Fin (n + (3 : ℕ))), ∀ (hk : s.start (0 : Fin (r + (3 : ℕ))) + + k = j), ∀ (hp : (j - 1) + 1 = j), + let kp : Fin (n + 3) := ⟨k.val - 1, by omega⟩ + (kp + 1 = k) → (s.start 0 + kp = j - 1) := by + classical + intro r n q p s X K t h this j k hk hp kp hkprev + apply add_right_cancel + calc + (s.start 0 + kp) + 1 = s.start 0 + (kp + 1) := by simp [add_assoc] + _ = s.start 0 + k := by rw [hkprev] + _ = j := hk + _ = (j - 1) + 1 := hp.symm + +private theorem hfilterCur : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (h : ℕ), ∀ (hh : h < + (P3523T1InsertionConstruction s t).steps.length), ∀ [NeZero (n + (3 : ℕ))], + let c := P3523T1InsertionConstruction s t + let e := c.steps.get ⟨h, hh⟩ + ∀ (j : Fin (n + (3 : ℕ))), ((j - (1 : Fin (n + (3 : ℕ))), j, s.start (s.edge j + (1 : Fin (r + + (3 : ℕ))))) = e) → ( + let raw := List.ofFn (fun k : Fin (n + 3) => s.start 0 + k) + let pred := fun z : Fin (n + 3) => decide (s.parameter z ≠ 0) + ∀ (hfilterLen : h < (List.filter pred raw).length), (List.filter pred raw).get ⟨h, + hfilterLen⟩ = j) := by + classical + intro r n q p s X K t h hh this c e j heq raw pred hfilterLen + have hget : (j - 1, j, s.start (s.edge j + 1)) = + c.steps.get ⟨h, hh⟩ := by simpa only [e] using heq + have hm := congrArg + (fun z : Fin (n + 3) × Fin (n + 3) × Fin (n + 3) => z.2.1) hget.symm + simpa [c, P3523T1InsertionConstruction, raw, pred] using hm + +private theorem hpred : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ [NeZero (n + (3 : ℕ))], + ∀ (j : Fin (n + (3 : ℕ))), ∀ (k : Fin (n + (3 : ℕ))), let raw := List.ofFn (fun k : Fin (n + + 3) => s.start 0 + k) + let pred := fun z : Fin (n + 3) => decide (s.parameter z ≠ 0) + (¬s.parameter (j - (1 : Fin (n + (3 : ℕ)))) = (0 : ℝ)) → (∀ (hrawLen : raw.length = + n + 3), (raw.get ⟨k.val - 1, by + rw [hrawLen] + exact lt_of_le_of_lt (Nat.sub_le _ _) k.isLt⟩ = j - 1) → (pred (raw.get ⟨k.val - 1, + by + rw [hrawLen] + exact lt_of_le_of_lt (Nat.sub_le _ _) k.isLt⟩) = true)) := by + classical + intro r n q p s this j k raw pred hzprev hrawLen hrawPrev + rw [hrawPrev] + simp [pred, hzprev] + +private theorem hfilteredPrev' : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (h : ℕ), ∀ [NeZero (n + (3 : ℕ))], + ∀ (j : Fin (n + (3 : ℕ))), ∀ (k : Fin (n + (3 : ℕ))), + let raw := List.ofFn (fun k : Fin (n + 3) => s.start 0 + k) + let pred := fun z : Fin (n + 3) => decide (s.parameter z ≠ 0) + ∀ (hrawLen : raw.length = n + 3), (raw.get ⟨k.val - 1, by + rw [hrawLen] + exact lt_of_le_of_lt (Nat.sub_le _ _) k.isLt⟩ = j - 1) → ((raw.get ⟨(↑k : ℕ) - (1 : ℕ), + by rw [hrawLen]; exact lt_of_le_of_lt (Nat.sub_le _ _) k.isLt⟩ + ∈ List.take h (List.filter pred raw)) → (j - 1 ∈ (List.filter pred raw).take h)) := by + classical + intro r n q p s h this j k raw pred hrawLen hrawPrev hfilteredPrev + rw [← hrawPrev] + exact hfilteredPrev + +private theorem htuplePrev : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (h : ℕ), ∀ [NeZero (n + (3 : ℕ))], + let c := P3523T1InsertionConstruction s t + ∀ (j : Fin (n + (3 : ℕ))), + let raw := List.ofFn (fun k : Fin (n + 3) => s.start 0 + k) + let pred := fun z : Fin (n + 3) => decide (s.parameter z ≠ 0) + (j - 1 ∈ (List.filter pred raw).take h) → (((j - 1) - 1, j - 1, s.start (s.edge (j - 1) + 1)) + ∈ c.steps.take h) := by + classical + intro r n q p s X K t h this c j raw pred hfilteredPrev' + change ((j - 1) - 1, j - 1, s.start (s.edge (j - 1) + 1)) ∈ + (List.map (fun z => (z - 1, z, s.start (s.edge z + 1))) + (List.filter pred raw)).take h + rw [← List.map_take] + exact List.mem_map.mpr ⟨j - 1, hfilteredPrev', rfl⟩ + +private theorem hxinit : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (j : Fin (n + (3 : ℕ))), (s.parameter j ≠ + 0) → (j ∉ Finset.univ.image s.start) := by + classical + intro r n q p s j hparam hx + rcases Finset.mem_image.mp hx with ⟨i, _, hi⟩ + apply hparam + rw [← hi] + exact s.parameter_start i + +private theorem hboundary : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), (∀ (j : Fin (n + (3 : ℕ))), s.parameter j + = (0 : ℝ) → j = s.start (s.edge j)) → (((∀ h : Nat, ∀ hh : h < + (P3523T1InsertionConstruction s t).steps.length, + let e := (P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩ + e.1 ≠ e.2.2 ∧ e.1 ∈ (P3523T1InsertionConstruction s t).vertices h ∧ + e.2.2 ∈ (P3523T1InsertionConstruction s t).vertices h ∧ + e.2.1 ∉ (P3523T1InsertionConstruction s t).vertices h ∧ + {e.1, e.2.2} ∈ (P3523T1InsertionConstruction s t).boundary h ∧ + ∃ u : Real, 0 < u ∧ u < 1 ∧ + p.vertex e.2.1 = (1 - u) • p.vertex e.1 + u • p.vertex e.2.2 ∧ + P3523T1InterpolatedTarget s t e.2.1 = + (1 - u) • P3523T1InterpolatedTarget s t e.1 + + u • P3523T1InterpolatedTarget s t e.2.2)) → (((P3523T1InsertionConstruction s + t).vertices (P3523T1InsertionConstruction s t).steps.length = Finset.univ) → + ((P3523T1InsertionConstruction s t).boundary + (P3523T1InsertionConstruction s t).steps.length = + Finset.univ.image (fun j : Fin (n + 3) => ({j, j + 1} : Finset _))))) := by + classical + intro r n q p s X K t hzero hvalid hvertices + classical + let c := P3523T1InsertionConstruction s t + let initialBoundary := Finset.univ.image (fun i : Fin (r + 3) => + ({s.start i, s.start (i + 1)} : Finset (Fin (n + 3)))) + let initialVertices := Finset.univ.image s.start + let targetBoundary := Finset.univ.image (fun j : Fin (n + 3) => + ({j, j + 1} : Finset (Fin (n + 3)))) + let boundaryStep := fun + (es : Finset (Finset (Fin (n + 3)))) + (e : Fin (n + 3) × Fin (n + 3) × Fin (n + 3)) => + insert {e.1, e.2.1} + (insert {e.2.1, e.2.2} (es.erase {e.1, e.2.2})) + have pairCases {a b c d : Fin (n + 3)} (hab : a ≠ b) + (h : ({a, b} : Finset (Fin (n + 3))) = {c, d}) : + (a = c ∧ b = d) ∨ (a = d ∧ b = c) := OrderedInsertionGeometry.pairCasesAt830 n (a := a) + (b := b) (c := c) (d := d) hab h + have adjacentNe (i : Fin (r + 3)) : i ≠ i + 1 := by + intro heq + have hone : (1 : Fin (r + 3)) = 0 := + add_left_cancel (show i + 1 = i + 0 by simp at heq) + have hv := congrArg Fin.val hone + norm_num at hv + have boundaryEdgeInj : Function.Injective + (fun i : Fin (r + 3) => + ({s.start i, s.start (i + 1)} : Finset (Fin (n + 3)))) := + OrderedInsertionGeometry.boundaryEdgeInj r n q p s pairCases adjacentNe + have hinitCard : initialBoundary.card = initialVertices.card := by + dsimp [initialBoundary, initialVertices] + rw [Finset.card_image_of_injective _ boundaryEdgeInj, + Finset.card_image_of_injective _ s.start_injective] + have hinitEndpoints : ∀ P ∈ initialBoundary, ∀ x ∈ P, x ∈ initialVertices := by + intro P hP x hx + rcases Finset.mem_image.mp hP with ⟨i, -, rfl⟩ + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + rcases hx with hx | hx + · subst x + exact Finset.mem_image.mpr ⟨i, Finset.mem_univ _, rfl⟩ + · subst x + exact Finset.mem_image.mpr ⟨i + 1, Finset.mem_univ _, rfl⟩ + have pairEq {a b c d : Fin (n + 3)} (hac : a = c) (hbd : b = d) : + ({a, b} : Finset (Fin (n + 3))) = {c, d} := by + ext z + simp [hac, hbd] + have boundaryCardUpdate + (B : Finset (Finset (Fin (n + 3)))) + (V : Finset (Fin (n + 3))) (a d b : Fin (n + 3)) + (hab : a ≠ b) (ha : a ∈ V) (hb : b ∈ V) (hd : d ∉ V) + (hend : ∀ P ∈ B, ∀ x ∈ P, x ∈ V) + (herase : {a, b} ∈ B) : + (insert {a, d} (insert {d, b} (B.erase {a, b}))).card = B.card + 1 := + OrderedInsertionGeometry.boundaryCardUpdate r n q p s B V a d b hab ha hb hd hend + herase + have hstate : ∀ h : Nat, h ≤ c.steps.length → + (∀ P ∈ c.boundary h, ∀ x ∈ P, x ∈ c.vertices h) ∧ + (c.boundary h).card = (c.vertices h).card := OrderedInsertionGeometry.hstate r n q p + s X K t hvalid hinitCard boundaryCardUpdate + have hfinalState := hstate c.steps.length (by omega) + have hboundaryCard : (c.boundary c.steps.length).card = n + 3 := by + rw [hfinalState.2, hvertices] + simp + have targetAdjNe (i : Fin (n + 3)) : i ≠ i + 1 := by + intro heq + have hone : (1 : Fin (n + 3)) = 0 := + add_left_cancel (show i + 1 = i + 0 by simp at heq) + have hv := congrArg Fin.val hone + norm_num at hv + have targetPairInj : Function.Injective + (fun i : Fin (n + 3) => ({i, i + 1} : Finset (Fin (n + 3)))) := + OrderedInsertionGeometry.targetPairInj r n q p s X K t pairCases targetAdjNe + have htargetCard : targetBoundary.card = n + 3 := by + dsimp [targetBoundary] + rw [Finset.card_image_of_injective _ targetPairInj] + simp + have keepBoundary + (l : List (Fin (n + 3) × Fin (n + 3) × Fin (n + 3))) + (A : Finset (Finset (Fin (n + 3)))) (P : Finset (Fin (n + 3))) + (hseed : P ∈ A ∨ ∃ e ∈ l, + P = {e.1, e.2.1} ∨ P = {e.2.1, e.2.2}) + (hno : ∀ e ∈ l, P ≠ {e.1, e.2.2}) : + P ∈ l.foldl boundaryStep A := OrderedInsertionGeometry.keepBoundaryAt1047 n l A P hseed + hno + have hinjShift : Function.Injective (fun k : Fin (n + 3) => s.start 0 + k) := by + intro a b hab + exact add_left_cancel hab + have hshiftImage : Finset.univ.image (fun k : Fin (n + 3) => s.start 0 + k) = + (Finset.univ : Finset (Fin (n + 3))) := by + apply Finset.eq_univ_of_card + rw [Finset.card_image_of_injective _ hinjShift] + simp + have memStep (j : Fin (n + 3)) (hj : s.parameter j ≠ 0) : + (j - 1, j, s.start (s.edge j + 1)) ∈ c.steps := OrderedInsertionGeometry.memStep r n q + p s X K t hshiftImage j hj + have offsetNe (a : Fin (r + 3)) (k : Nat) (hk : k < r + 3) + (hkpos : 0 < k) : a + (k : Fin (r + 3)) ≠ a := by + intro heq + have hkfin : (k : Fin (r + 3)) = 0 := + add_left_cancel (show a + (k : Fin (r + 3)) = a + 0 by simpa using heq) + have hv := congrArg Fin.val hkfin + change k % (r + 3) = 0 at hv + rw [Nat.mod_eq_of_lt hk] at hv + omega + have noErase (x : Fin (n + 3)) : + ∀ e ∈ c.steps, ({x, x + 1} : Finset (Fin (n + 3))) ≠ {e.1, e.2.2} := + OrderedInsertionGeometry.noErase r n q p s X K t pairCases targetAdjNe x + have cycleSeed (x : Fin (n + 3)) : + ({x, x + 1} : Finset (Fin (n + 3))) ∈ initialBoundary ∨ + ∃ e ∈ c.steps, + ({x, x + 1} : Finset (Fin (n + 3))) = {e.1, e.2.1} ∨ + ({x, x + 1} : Finset (Fin (n + 3))) = {e.2.1, e.2.2} := + OrderedInsertionGeometry.cycleSeed r n q p s X K t hzero pairEq memStep x + have htargetSubset : targetBoundary ⊆ c.boundary c.steps.length := + OrderedInsertionGeometry.htargetSubset r n q p s X K t keepBoundary noErase cycleSeed + change c.boundary c.steps.length = targetBoundary + exact (Finset.eq_of_subset_of_card_le htargetSubset (by + rw [hboundaryCard, htargetCard])).symm + +end OrderedInsertionDetails + +theorem P3523T1OrderedInsertion {r n : Nat} + (q : P3381T1PolygonBoundary r) (p : P3381T1PolygonBoundary n) + (s : P3475T1BoundarySubdivision q p) + (X K : Set (Real × Real)) (t : P3475T1TriangleTree q X K) : + let c := P3523T1InsertionConstruction s t + (∀ i : Fin (r + 3), ∃ m : Nat, 0 < m ∧ m ≤ n + 3 ∧ + s.start i + (m : Fin (n + 3)) = s.start (i + 1) ∧ + (∀ k : Nat, k < m → s.edge (s.start i + (k : Fin (n + 3))) = i) ∧ + (∀ k l : Nat, k < l → l < m → + s.parameter (s.start i + (k : Fin (n + 3))) < + s.parameter (s.start i + (l : Fin (n + 3))))) ∧ + (∀ h : Nat, ∀ hh : h < c.steps.length, + let e := c.steps.get ⟨h, hh⟩ + e.1 ≠ e.2.2 ∧ e.1 ∈ c.vertices h ∧ e.2.2 ∈ c.vertices h ∧ + e.2.1 ∉ c.vertices h ∧ {e.1, e.2.2} ∈ c.boundary h ∧ + ∃ u : Real, 0 < u ∧ u < 1 ∧ + p.vertex e.2.1 = (1 - u) • p.vertex e.1 + u • p.vertex e.2.2 ∧ + P3523T1InterpolatedTarget s t e.2.1 = + (1 - u) • P3523T1InterpolatedTarget s t e.1 + + u • P3523T1InterpolatedTarget s t e.2.2) ∧ + c.vertices c.steps.length = Finset.univ ∧ + c.boundary c.steps.length = + Finset.univ.image (fun j : Fin (n + 3) => ({j, j + 1} : Finset _)) := by +-- BODY + obtain ⟨hzero, hexit⟩ := P3523T1SubdivisionExit q p s + dsimp only + constructor + · intro i + let ex := hexit (s.start i) + let k₀ := Nat.find ex + let m := k₀ + 1 + have hk₀ : k₀ < n + 3 := (Nat.find_spec ex).1 + have hm : m ≤ n + 3 := by dsimp [m]; omega + have hlast : s.edge (s.start i + (m : Fin (n + 3))) ≠ i := by + simpa only [m, k₀, s.edge_start] using (Nat.find_spec ex).2 + have hsame (k : Nat) (hk : k < m) := OrderedInsertionGeometry.hsameAt138 r n q p + s hexit i ex hk₀ k hk + have hstart := OrderedInsertionGeometry.hstartAt150 r n q p s hzero hexit i ex hlast hsame + have hstep (k : Nat) (hk : k + 1 < m) := OrderedInsertionGeometry.hstepAt162 r n q p s hexit + i ex hsame k hk + exact ⟨m, by dsimp [m]; omega, hm, hstart, hsame, + fun k l hkl hl => OrderedInsertionGeometry.hstrict r n q p s hexit i ex hstep l hl k hkl⟩ + · have hvalid : (∀ h : Nat, ∀ hh : h < (P3523T1InsertionConstruction s t).steps.length, + let e := (P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩ + e.1 ≠ e.2.2 ∧ e.1 ∈ (P3523T1InsertionConstruction s t).vertices h ∧ + e.2.2 ∈ (P3523T1InsertionConstruction s t).vertices h ∧ + e.2.1 ∉ (P3523T1InsertionConstruction s t).vertices h ∧ + {e.1, e.2.2} ∈ (P3523T1InsertionConstruction s t).boundary h ∧ + ∃ u : Real, 0 < u ∧ u < 1 ∧ + p.vertex e.2.1 = (1 - u) • p.vertex e.1 + u • p.vertex e.2.2 ∧ + P3523T1InterpolatedTarget s t e.2.1 = + (1 - u) • P3523T1InterpolatedTarget s t e.1 + + u • P3523T1InterpolatedTarget s t e.2.2) := by + intro h hh + let : NeZero (n + 3) := ⟨by omega⟩ + let c := P3523T1InsertionConstruction s t + let e := c.steps.get ⟨h, hh⟩ + have hem : e ∈ c.steps := List.get_mem c.steps ⟨h, hh⟩ + simp only [c, P3523T1InsertionConstruction] at e hem + rcases List.mem_map.mp hem with ⟨j, hj, heq⟩ + have hjfilter := List.mem_filter.mp hj + rcases List.mem_ofFn.mp hjfilter.1 with ⟨k, hk⟩ + have hparam : s.parameter j ≠ 0 := of_decide_eq_true hjfilter.2 + have hp : (j - 1) + 1 = j := by simp + have hs := s.successor (j - 1) + rw [hp] at hs + have hsame := OrderedInsertionDetails.hsameAt1300 r n q p s j + hparam hs + have hnext := OrderedInsertionDetails.hnext r n q p s j + have hne := OrderedInsertionDetails.hne r n q p s j hsame + hnext + have hlt := OrderedInsertionDetails.hlt r n q p s j + hparam hs + let t₀ := s.parameter (j - 1) + let t₁ := s.parameter j + let u := (t₁ - t₀) / (1 - t₀) + have ht₀one : t₀ < 1 := s.parameter_lt_one _ + have ht₁one : t₁ < 1 := s.parameter_lt_one _ + have hden : 1 - t₀ ≠ 0 := ne_of_gt (sub_pos.mpr ht₀one) + have hu := OrderedInsertionDetails.hu r n q p s j hlt ht₀one ht₁one + have hc₀ := OrderedInsertionDetails.hc₀ r n q p s j hden + have hc₁ := OrderedInsertionDetails.hc₁ r n q p s j hden + have affine (A B : Real × Real) := OrderedInsertionGeometry.affine r n q p + s j hc₀ hc₁ A B + have retain (l : List (Fin (n + 3) × Fin (n + 3) × Fin (n + 3))) + (A : Finset (Fin (n + 3))) (x : Fin (n + 3)) (hx : x ∈ A) := + OrderedInsertionDetails.retain n l A x hx + have hrawNodup := OrderedInsertionDetails.hrawNodup r n q p s + have hfilterNodup : + (List.filter (fun j => decide (s.parameter j ≠ 0)) + (List.ofFn fun k : Fin (n + 3) => s.start 0 + k)).Nodup := + hrawNodup.filter _ + have htupleInj := OrderedInsertionDetails.htupleInj r n q p s + have hstepsNodup := OrderedInsertionDetails.hstepsNodup r n q p s X K t + hfilterNodup htupleInj + have filterPrev {α : Type} (l : List α) (p : α → Bool) (k h : Nat) + (hn : l.Nodup) (hk : k < l.length) (hpos : 0 < k) + (hlen : h < (l.filter p).length) + (hp : p (l.get ⟨k - 1, by omega⟩) = true) + (hcur : (l.filter p).get ⟨h, hlen⟩ = l.get ⟨k, hk⟩) := + OrderedInsertionGeometry.filterPrev r + n q s X K t j (α := α) l p k h hn hk hpos hlen hp hcur + have getNotTake {α : Type} (l : List α) (hn : l.Nodup) (m : Nat) + (hm : m < l.length) := OrderedInsertionDetails.getNotTake r + n q p s X K t h j k (α := α) l hn m hm + have fold_not_mem (l : List (Fin (n + 3) × Fin (n + 3) × Fin (n + 3))) + (A : Finset (Fin (n + 3))) (x : Fin (n + 3)) (hx : x ∉ A) + (hall : ∀ a ∈ l, a.2.1 ≠ x) := OrderedInsertionGeometry.fold_not_mem n + l A x hx hall + have fold_insert_mem (l : List (Fin (n + 3) × Fin (n + 3) × Fin (n + 3))) + (A : Finset (Fin (n + 3))) (x : Fin (n + 3)) + (hx : x ∈ A ∨ x ∈ l.map (fun e => e.2.1)) := OrderedInsertionGeometry.fold_insert_mem + n l A x hx + let boundaryStep := fun + (es : Finset (Finset (Fin (n + 3)))) + (e : Fin (n + 3) × Fin (n + 3) × Fin (n + 3)) => + insert {e.1, e.2.1} + (insert {e.2.1, e.2.2} (es.erase {e.1, e.2.2})) + have keepBoundary (l : List (Fin (n + 3) × Fin (n + 3) × Fin (n + 3))) + (A : Finset (Finset (Fin (n + 3)))) (P : Finset (Fin (n + 3))) + (hseed : P ∈ A ∨ ∃ e ∈ l, + P = {e.1, e.2.1} ∨ P = {e.2.1, e.2.2}) + (hno : ∀ e ∈ l, P ≠ {e.1, e.2.2}) := OrderedInsertionGeometry.keepBoundaryAt383 n l A P + hseed hno + let raw := List.ofFn (fun k : Fin (n + 3) => s.start 0 + k) + let pred := fun z : Fin (n + 3) => decide (s.parameter z ≠ 0) + have prevTupleMem (hzprev : s.parameter (j - 1) ≠ 0) := + OrderedInsertionGeometry.prevTupleMem r n q p s X K t h hh j heq k hk hparam hp + hrawNodup filterPrev hzprev + have pairCases {a b c d : Fin (n + 3)} (hab : a ≠ b) + (h : ({a, b} : Finset (Fin (n + 3))) = {c, d}) := + OrderedInsertionGeometry.pairCasesAt487 n (a := a) + (b := b) (c := c) (d := d) hab h + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · change e.1 ≠ e.2.2 + rw [← heq] + exact hne + · by_cases hzprev : s.parameter (j - 1) = 0 + · change e.1 ∈ (c.steps.take h).foldl + (fun vs e => insert e.2.1 vs) (Finset.univ.image s.start) + rw [← heq] + rw [hzero (j - 1) hzprev, hsame] + apply retain + exact Finset.mem_image.mpr ⟨s.edge j, Finset.mem_univ _, rfl⟩ + · let raw := List.ofFn (fun k : Fin (n + 3) => s.start 0 + k) + let pred := fun z : Fin (n + 3) => decide (s.parameter z ≠ 0) + let kp : Fin (n + 3) := ⟨k.val - 1, by omega⟩ + have hrawLen : raw.length = n + 3 := by simp [raw] + have hkpos := OrderedInsertionDetails.hkpos r n q p s X K t h j k hk hparam + hp filterPrev + have hkprev := OrderedInsertionDetails.hkprev r n q p s X K t h j k hp + hrawLen hkpos + have hprevLabel := OrderedInsertionDetails.hprevLabel r n q p + s X K t h j k hk hp hkprev + have hrawPrev := OrderedInsertionGeometry.hrawPrevAt546 r n q p s X K t h j k hp + hrawLen hprevLabel + have hrawCur := OrderedInsertionGeometry.hrawCurAt556 r n q p s j k hk hrawLen + have hfilterLen : h < (List.filter pred raw).length := by + simpa [c, P3523T1InsertionConstruction, raw, pred] using hh + have hfilterCur := OrderedInsertionDetails.hfilterCur r n q p s X K t h hh j heq + hfilterLen + have hpred := OrderedInsertionDetails.hpred r n q p s j k hzprev hrawLen hrawPrev + have hfilteredPrev := filterPrev raw pred k.val h hrawNodup + (by rw [hrawLen]; exact k.isLt) hkpos hfilterLen hpred + (hfilterCur.trans hrawCur.symm) + have hfilteredPrev' := OrderedInsertionDetails.hfilteredPrev' r n q p s h j k hrawLen + hrawPrev hfilteredPrev + have htuplePrev := OrderedInsertionDetails.htuplePrev r n q p s X K t h j hfilteredPrev' + have hlabel : j - 1 ∈ (c.steps.take h).map (fun z => z.2.1) := + List.mem_map.mpr ⟨_, htuplePrev, rfl⟩ + change e.1 ∈ (c.steps.take h).foldl + (fun vs e => insert e.2.1 vs) (Finset.univ.image s.start) + rw [← heq] + exact fold_insert_mem _ _ _ (Or.inr hlabel) + · have hbinit : s.start (s.edge j + 1) ∈ Finset.univ.image s.start := by + exact Finset.mem_image.mpr ⟨s.edge j + 1, Finset.mem_univ _, rfl⟩ + change e.2.2 ∈ (c.steps.take h).foldl + (fun vs e => insert e.2.1 vs) (Finset.univ.image s.start) + rw [← heq] + exact retain _ _ _ hbinit + · have hxinit := OrderedInsertionDetails.hxinit r n q p s j + hparam + have hprefix := OrderedInsertionGeometry.hprefix r n q + p s X K t h hh j heq k hstepsNodup + change e.2.1 ∉ (c.steps.take h).foldl + (fun vs e => insert e.2.1 vs) (Finset.univ.image s.start) + rw [← heq] + exact fold_not_mem _ _ _ hxinit hprefix + · change {e.1, e.2.2} ∈ (c.steps.take h).foldl boundaryStep + (Finset.univ.image fun i : Fin (r + 3) => + ({s.start i, s.start (i + 1)} : Finset (Fin (n + 3)))) + rw [← heq] + let P : Finset (Fin (n + 3)) := {j - 1, s.start (s.edge j + 1)} + have hno := OrderedInsertionGeometry.hno r n q p + s X K t h hh j heq k hp hsame hne hstepsNodup getNotTake pairCases + have hseed := OrderedInsertionGeometry.hseed r n q p s X + K t hzero h j hsame prevTupleMem + have hmem := keepBoundary (c.steps.take h) + (Finset.univ.image fun i : Fin (r + 3) => + ({s.start i, s.start (i + 1)} : Finset (Fin (n + 3)))) P hseed hno + simpa [P, c, P3523T1InsertionConstruction, boundaryStep] using hmem + · refine ⟨u, hu.1, hu.2, ?_, ?_⟩ + · change p.vertex e.2.1 = (1 - u) • p.vertex e.1 + u • p.vertex e.2.2 + rw [← heq] + rw [s.vertex_formula j, s.vertex_formula (j - 1), + s.vertex_formula (s.start (s.edge j + 1))] + rw [hsame, s.edge_start, s.parameter_start] + simp only [sub_zero, one_smul, zero_smul] + rw [add_zero] + exact affine (q.vertex (s.edge j)) (q.vertex (s.edge j + 1)) + · change P3523T1InterpolatedTarget s t e.2.1 = + (1 - u) • P3523T1InterpolatedTarget s t e.1 + + u • P3523T1InterpolatedTarget s t e.2.2 + rw [← heq] + simp only [P3523T1InterpolatedTarget] + rw [hsame, s.edge_start, s.parameter_start] + simp only [sub_zero, one_smul, zero_smul] + rw [add_zero] + exact affine (t.target (s.edge j)) (t.target (s.edge j + 1)) + have hvertices := OrderedInsertionGeometry.hvertices r n q p s X K t hzero + have hboundary := OrderedInsertionDetails.hboundary r n q p s X K t hzero hvalid hvertices + exact ⟨hvalid, hvertices, hboundary⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1SplitDeterminants.lean b/LeanPool/ApollonianSuperharmonic/P3523T1SplitDeterminants.lean new file mode 100644 index 0000000000..c38b6a551f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3523T1SplitDeterminants.lean @@ -0,0 +1,49 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public import Mathlib.Data.Fin.VecNotation + +-- [TABLET NODE: P3523T1SplitDeterminants] + +/-! +# P3523T1SplitDeterminants + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3523T1SplitDeterminants (A B C : Real × Real) (u : Real) + (hu : 0 < u ∧ u < 1) + (hn : P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : + let D := (1 - u) • A + u • B + P3381T1TriangleDeterminant ![A, D, C] = + u * P3381T1TriangleDeterminant ![A, B, C] ∧ + P3381T1TriangleDeterminant ![D, B, C] = + (1 - u) * P3381T1TriangleDeterminant ![A, B, C] ∧ + P3381T1TriangleDeterminant ![A, D, C] ≠ 0 ∧ + P3381T1TriangleDeterminant ![D, B, C] ≠ 0 := by +-- BODY + dsimp only + have hl : P3381T1TriangleDeterminant ![A, (1 - u) • A + u • B, C] = + u * P3381T1TriangleDeterminant ![A, B, C] := by + simp [P3381T1TriangleDeterminant] + ring + have hr : P3381T1TriangleDeterminant ![(1 - u) • A + u • B, B, C] = + (1 - u) * P3381T1TriangleDeterminant ![A, B, C] := by + simp [P3381T1TriangleDeterminant] + ring + exact ⟨hl, hr, hl ▸ mul_ne_zero (ne_of_gt hu.1) hn, + hr ▸ mul_ne_zero (ne_of_gt (sub_pos.mpr hu.2)) hn⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1SubdivisionExit.lean b/LeanPool/ApollonianSuperharmonic/P3523T1SubdivisionExit.lean new file mode 100644 index 0000000000..2ea3137ad5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3523T1SubdivisionExit.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundarySubdivision + +/-! +# P3523T1SubdivisionExit + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open Fin.NatCast + +-- [TABLET NODE: P3523T1SubdivisionExit] +theorem P3523T1SubdivisionExit {r n : Nat} + (q : P3381T1PolygonBoundary r) (p : P3381T1PolygonBoundary n) + (s : P3475T1BoundarySubdivision q p) : + (∀ j, s.parameter j = 0 → j = s.start (s.edge j)) ∧ + (∀ j, ∃ k : Nat, k < n + 3 ∧ + s.edge (j + (Nat.cast (k + 1) : Fin (n + 3))) ≠ s.edge j) := by +-- BODY + let : NeZero (n + 3) := ⟨by omega⟩ + let : NeZero (r + 3) := ⟨by omega⟩ + constructor + · intro j hz + apply p.injective + rw [s.vertex_formula j, s.vertex_formula (s.start (s.edge j)), + s.edge_start, s.parameter_start, hz] + · intro j + classical + by_contra h + push Not at h + have he (k : Nat) (hk : k ≤ n + 3) : + s.edge (j + (Nat.cast k : Fin (n + 3))) = s.edge j := by + cases k with + | zero => simp + | succ k => exact h k (by omega) + have hinc (k : Nat) (hk : k < n + 3) : + s.parameter (j + (Nat.cast k : Fin (n + 3))) < + s.parameter (j + (Nat.cast (k + 1) : Fin (n + 3))) := by + rcases s.successor (j + (Nat.cast k : Fin (n + 3))) with hs | hs + · simpa [Nat.cast_add, add_assoc] using hs.2 + · have hcoarse : s.edge (j + (Nat.cast k : Fin (n + 3))) + 1 = + s.edge (j + (Nat.cast k : Fin (n + 3))) := by + have hsame := (he (k + 1) (by omega)).trans (he k (by omega)).symm + have hadv : s.edge (j + (Nat.cast (k + 1) : Fin (n + 3))) = + s.edge (j + (Nat.cast k : Fin (n + 3))) + 1 := by + simpa [Nat.cast_add, add_assoc] using hs.1 + exact hadv.symm.trans hsame + simp at hcoarse + have hchain (k : Nat) (hk : k ≤ n + 3) : + s.parameter j ≤ s.parameter (j + (Nat.cast k : Fin (n + 3))) := by + induction k with + | zero => simp + | succ k ih => exact (ih (by omega)).trans (hinc k (by omega)).le + have hlast := (hchain (n + 2) (by omega)).trans_lt (hinc (n + 2) (by omega)) + simp at hlast + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean new file mode 100644 index 0000000000..cb63ed540a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean @@ -0,0 +1,688 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3523T1OrderedInsertion + +-- [TABLET NODE: P3523T1TargetBoundary] + +/-! +# P3523T1TargetBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TargetBoundaryProof + +private theorem htarget_edge : + ∀ (r : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (i : Fin (r + (3 : ℕ))), t.target i ≠ + t.target (i + (1 : Fin (r + (3 : ℕ)))) := by + classical + intro r q X K t i h + have hi : i = i + 1 := t.target_injective h + have hv := congrArg Fin.val hi + change i.val = (i.val + 1) % (r + 3) at hv + by_cases hlt : i.val + 1 < r + 3 + · rw [Nat.mod_eq_of_lt hlt] at hv + omega + · have heq : i.val + 1 = r + 3 := by omega + rw [heq, Nat.mod_self] at hv + have hi_lt := i.isLt + omega + +private theorem haffine_injective : + ∀ (A : ℝ × ℝ), ∀ (B : ℝ × ℝ), A ≠ B → Function.Injective fun (u : ℝ) => ((1 : ℝ) - u) • A + u + • B := by + classical + intro A B hAB u v h + have h1 := congrArg Prod.fst h + have h2 := congrArg Prod.snd h + change (1 - u) * A.1 + u * B.1 = (1 - v) * A.1 + v * B.1 at h1 + change (1 - u) * A.2 + u * B.2 = (1 - v) * A.2 + v * B.2 at h2 + have hprod1 : (u - v) * (B.1 - A.1) = 0 := by nlinarith + have hprod2 : (u - v) * (B.2 - A.2) = 0 := by nlinarith + by_cases hx : A.1 = B.1 + · have hy : B.2 - A.2 ≠ 0 := by + intro he + apply hAB + exact Prod.ext hx (sub_eq_zero.mp he).symm + exact sub_eq_zero.mp ((mul_eq_zero.mp hprod2).resolve_right hy) + · have hy : B.1 - A.1 ≠ 0 := by + intro he + exact hx (sub_eq_zero.mp he).symm + exact sub_eq_zero.mp ((mul_eq_zero.mp hprod1).resolve_right hy) + +private theorem hQinj : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let Q := P3523T1InterpolatedTarget s t + (∀ (j : Fin (n + 3)), Q j ∈ segment Real (t.target (s.edge j)) (t.target (s.edge j + 1))) → + ((∀ (i : Fin (r + 3)), Function.Injective (fun u : Real => (1 - u) • t.target i + u • + t.target (i + 1))) → ((∀ (j : Fin (n + 3)), Q j ≠ t.target (s.edge j + 1)) → + (Function.Injective Q))) := by + classical + intro r n q p s X K t Q hparam_mem haffine_inj hparam_start i j hij + have heqseg : Q i ∈ segment Real (t.target (s.edge i)) + (t.target (s.edge i + 1)) ∩ + segment Real (t.target (s.edge j)) (t.target (s.edge j + 1)) := + ⟨hparam_mem i, hij ▸ hparam_mem j⟩ + by_cases hed : s.edge i = s.edge j + · have hparam : s.parameter i = s.parameter j := by + apply haffine_inj (s.edge j) + simpa [Q, P3523T1InterpolatedTarget, hed] using hij + have hp : p.vertex i = p.vertex j := by + rw [s.vertex_formula i, s.vertex_formula j, hed, hparam] + exact p.injective hp + · rw [t.target_edge_intersection _ _ hed] at heqseg + rcases heqseg with ⟨hleft, hright⟩ + have hi_end : Q i ≠ t.target (s.edge i + 1) := hparam_start i + have hj_end : Q j ≠ t.target (s.edge j + 1) := hparam_start j + rcases hleft with hleft | hleft <;> rcases hright with hright | hright + · have htargets : t.target (s.edge i) = t.target (s.edge j) := by + exact hleft.symm.trans hright + have : s.edge i = s.edge j := t.target_injective htargets + exact (hed this).elim + · exact (hj_end (hij.symm.trans hright)).elim + · exact (hi_end hleft).elim + · exact (hi_end hleft).elim + +private theorem hfine_step : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let Q := P3523T1InterpolatedTarget s t + let src (e : Fin (r + 3)) (u : Real) := + (1 - u) • q.vertex e + u • q.vertex (e + 1) + let tgt (e : Fin (r + 3)) (u : Real) := + (1 - u) • t.target e + u • t.target (e + 1) + ∀ (j : Fin (n + (3 : ℕ))), ∃ (b : ℝ), s.parameter j ≤ b ∧ b ≤ (1 : ℝ) ∧ p.vertex (j + (1 : + Fin (n + (3 : ℕ)))) = src (s.edge j) b ∧ Q (j + (1 : Fin (n + (3 : ℕ)))) = tgt (s.edge j) + b := by + classical + intro r n q p s X K t Q src tgt j + rcases s.successor j with hs | hs + · refine ⟨s.parameter (j + 1), ?_, ?_, ?_, ?_⟩ + · exact hs.2.le + · exact (s.parameter_lt_one _).le + · rw [s.vertex_formula (j + 1), hs.1] + · simp [Q, tgt, P3523T1InterpolatedTarget, hs.1] + · refine ⟨1, (s.parameter_lt_one j).le, le_rfl, ?_, ?_⟩ + · rw [s.vertex_formula (j + 1), hs.1, hs.2] + simp [src] + · simp [Q, tgt, P3523T1InterpolatedTarget, hs.1, hs.2] + +private theorem hmix : + ∀ (A : ℝ × ℝ), ∀ (B : ℝ × ℝ), ∀ (a : ℝ), ∀ (b : ℝ), ∀ (θ : ℝ), ((1 : ℝ) - θ) • (((1 : ℝ) - a) + • A + a • B) + θ • (((1 : ℝ) - b) • A + b • B) = ((1 : ℝ) - (a + θ * (b - a))) • A + (a + + θ * (b - a)) • B := by + classical + intro A B a b θ + apply Prod.ext + · change (1 - θ) * ((1 - a) * A.1 + a * B.1) + + θ * ((1 - b) * A.1 + b * B.1) = + (1 - (a + θ * (b - a))) * A.1 + (a + θ * (b - a)) * B.1 + ring + · change (1 - θ) * ((1 - a) * A.2 + a * B.2) + + θ * ((1 - b) * A.2 + b * B.2) = + (1 - (a + θ * (b - a))) * A.2 + (a + θ * (b - a)) * B.2 + ring + +private theorem hcoarse_inj_src : + ∀ (r : Nat), ∀ (q : P3381T1PolygonBoundary r), (∀ (A : Real × Real), ∀ (B : Real × Real), + (A ≠ B) → (Function.Injective (fun u : Real => (1 - u) • A + u • B))) → ( + let src (e : Fin (r + 3)) (u : Real) := + (1 - u) • q.vertex e + u • q.vertex (e + 1) + ∀ (e : Fin (r + (3 : ℕ))), Function.Injective (src e)) := by + classical + intro r q haffine_injective src e u v huv + exact haffine_injective (q.vertex e) (q.vertex (e + 1)) + (by + intro h + have hi := q.injective h + have hv := congrArg Fin.val hi + change e.val = (e.val + 1) % (r + 3) at hv + by_cases hlt : e.val + 1 < r + 3 + · rw [Nat.mod_eq_of_lt hlt] at hv + omega + · have heq : e.val + 1 = r + 3 := by omega + rw [heq, Nat.mod_self] at hv + omega) huv + +private theorem hy_j : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), + let src (e : Fin (r + 3)) (u : Real) := + (1 - u) • q.vertex e + u • q.vertex (e + 1) + (∀ (A : Real × Real), ∀ (B : Real × Real), ∀ (a : Real), ∀ (b : Real), ∀ (θ : Real), (1 - θ) + • ((1 - a) • A + a • B) + θ • ((1 - b) • A + b • B) = (1 - (a + θ * (b - a))) • A + (a + + θ * (b - a)) • B) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ∀ (bi : ℝ), ∀ + (bj : ℝ), (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) = src (s.edge j) bj) → (∀ (θ : ℝ), + ∀ (φ : ℝ), (φ ∈ Set.Icc (0 : ℝ) (1 : ℝ)) → ( + let ci := s.parameter i + θ * (bi - s.parameter i) + let cj := s.parameter j + φ * (bj - s.parameter j) + (p.vertex j = src (s.edge j) (s.parameter j)) → ((s.edge i = s.edge j) → ( + let y := src (s.edge i) ci + (ci = cj) → (y ∈ segment Real (p.vertex j) (p.vertex (j + 1)))))))) := by + classical + intro r n q p s src hmix i j bi bj hpj θ φ hφ ci cj hpj0 he y hparam_eq + rw [segment_eq_image] + refine ⟨φ, hφ, ?_⟩ + dsimp [y] + rw [hpj0, hpj] + have hm : (1 - φ) • src (s.edge j) (s.parameter j) + + φ • src (s.edge j) bj = src (s.edge j) cj := by + simpa [src, cj] using hmix (q.vertex (s.edge j)) + (q.vertex (s.edge j + 1)) (s.parameter j) bj φ + calc (1 - φ) • src (s.edge j) (s.parameter j) + + φ • src (s.edge j) bj = src (s.edge j) cj := hm + _ = src (s.edge i) ci := by rw [← he, ← hparam_eq] + +private theorem hx_i_endAt340 : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let Q := P3523T1InterpolatedTarget s t + let src (e : Fin (r + 3)) (u : Real) := + (1 - u) • q.vertex e + u • q.vertex (e + 1) + let tgt (e : Fin (r + 3)) (u : Real) := + (1 - u) • t.target e + u • t.target (e + 1) + (∀ (e : Fin (r + 3)), Function.Injective (src e)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (x : ℝ × + ℝ), ∀ (bi : ℝ), (p.vertex (i + (1 : Fin (n + (3 : ℕ)))) = src (s.edge i) bi) → ((Q (i + + (1 : Fin (n + (3 : ℕ)))) = tgt (s.edge i) bi) → (∀ (θ : ℝ), + let ci := s.parameter i + θ * (bi - s.parameter i) + (Q i = tgt (s.edge i) (s.parameter i)) → ((p.vertex i = src (s.edge i) (s.parameter i)) → ((x + = tgt (s.edge i) ci) → ( + let y := src (s.edge i) ci + (y = p.vertex i ∨ y = p.vertex (i + (1 : Fin (n + (3 : ℕ))))) → (x = Q i ∨ x = Q (i + + 1)))))))) := by + classical + intro r n q p s X K t Q src tgt hcoarse_inj_src i x bi hpi hqi θ ci hqi0 hpi0 hx_i' y hi_end + rcases hi_end with hi_end | hi_end + · have hc : ci = s.parameter i := hcoarse_inj_src (s.edge i) (by + calc src (s.edge i) ci = y := rfl + _ = p.vertex i := hi_end + _ = src (s.edge i) (s.parameter i) := hpi0) + left + calc x = tgt (s.edge i) ci := hx_i' + _ = tgt (s.edge i) (s.parameter i) := congrArg _ hc + _ = Q i := hqi0.symm + · have hc : ci = bi := hcoarse_inj_src (s.edge i) (by + calc src (s.edge i) ci = y := rfl + _ = p.vertex (i + 1) := hi_end + _ = src (s.edge i) bi := hpi) + right + calc x = tgt (s.edge i) ci := hx_i' + _ = tgt (s.edge i) bi := congrArg _ hc + _ = Q (i + 1) := hqi.symm + +private theorem hx_j_endAt358 : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let Q := P3523T1InterpolatedTarget s t + let src (e : Fin (r + 3)) (u : Real) := + (1 - u) • q.vertex e + u • q.vertex (e + 1) + let tgt (e : Fin (r + 3)) (u : Real) := + (1 - u) • t.target e + u • t.target (e + 1) + (∀ (e : Fin (r + 3)), Function.Injective (src e)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + + (3 : ℕ))), ∀ (x : ℝ × ℝ), ∀ (bi : ℝ), ∀ (bj : ℝ), (p.vertex (j + (1 : Fin (n + (3 : + ℕ)))) = src (s.edge j) bj) → ((Q (j + (1 : Fin (n + (3 : ℕ)))) = tgt (s.edge j) bj) → (∀ + (θ : ℝ), ∀ (φ : ℝ), + let ci := s.parameter i + θ * (bi - s.parameter i) + let cj := s.parameter j + φ * (bj - s.parameter j) + (Q j = tgt (s.edge j) (s.parameter j)) → ((p.vertex j = src (s.edge j) (s.parameter j)) → ((x + = tgt (s.edge j) cj) → ((s.edge i = s.edge j) → ( + let y := src (s.edge i) ci + (ci = cj) → ((y = p.vertex j ∨ y = p.vertex (j + (1 : Fin (n + (3 : ℕ))))) → (x = Q j ∨ x = Q + (j + 1)))))))))) := by + classical + intro r n q p s X K t Q src tgt hcoarse_inj_src i j x bi bj hpj hqj θ φ ci cj hqj0 hpj0 hx_j' + he y hparam_eq hj_end + rcases hj_end with hj_end | hj_end + · have hc : cj = s.parameter j := hcoarse_inj_src (s.edge i) (by + calc src (s.edge i) cj = y := by simp [y, hparam_eq] + _ = p.vertex j := hj_end + _ = src (s.edge i) (s.parameter j) := by simpa [he] using hpj0) + left + calc x = tgt (s.edge j) cj := hx_j' + _ = tgt (s.edge j) (s.parameter j) := congrArg _ hc + _ = Q j := hqj0.symm + · have hc : cj = bj := hcoarse_inj_src (s.edge i) (by + calc src (s.edge i) cj = y := by simp [y, hparam_eq] + _ = p.vertex (j + 1) := hj_end + _ = src (s.edge i) bj := by simpa [he] using hpj) + right + calc x = tgt (s.edge j) cj := hx_j' + _ = tgt (s.edge j) bj := congrArg _ hc + _ = Q (j + 1) := hqj.symm + +private theorem hx_i_endAt391 : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let Q := P3523T1InterpolatedTarget s t + let tgt (e : Fin (r + 3)) (u : Real) := + (1 - u) • t.target e + u • t.target (e + 1) + (∀ (e : Fin (r + 3)), Function.Injective (tgt e)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (x : ℝ × + ℝ), ∀ (bi : ℝ), (s.parameter i ≤ bi) → ((bi ≤ (1 : ℝ)) → ((Q (i + (1 : Fin (n + (3 : + ℕ)))) = tgt (s.edge i) bi) → (∀ (θ : ℝ), (θ ∈ Set.Icc (0 : ℝ) (1 : ℝ)) → ( + let ci := s.parameter i + θ * (bi - s.parameter i) + (Q i = tgt (s.edge i) (s.parameter i)) → ((x = tgt (s.edge i) ci) → ((x = t.target (s.edge i) + ∨ x = t.target (s.edge i + (1 : Fin (r + (3 : ℕ))))) → (x = Q i ∨ x = Q (i + 1))))))))) + := by + classical + intro r n q p s X K t Q tgt hcoarse_inj_tgt i x bi hai hbi hqi θ hθ ci hqi0 hx_i' hi_end + rcases hi_end with hi_end | hi_end + · have hc : ci = 0 := hcoarse_inj_tgt (s.edge i) (by + calc tgt (s.edge i) ci = x := hx_i'.symm + _ = t.target (s.edge i) := hi_end + _ = tgt (s.edge i) 0 := by simp [tgt]) + have ha0 : s.parameter i = 0 := by + dsimp [ci] at hc + nlinarith [s.parameter_nonneg i, hθ.1, hθ.2, hai] + left + calc x = tgt (s.edge i) ci := hx_i' + _ = tgt (s.edge i) (s.parameter i) := by rw [hc, ha0] + _ = Q i := hqi0.symm + · have hc : ci = 1 := hcoarse_inj_tgt (s.edge i) (by + calc tgt (s.edge i) ci = x := hx_i'.symm + _ = t.target (s.edge i + 1) := hi_end + _ = tgt (s.edge i) 1 := by simp [tgt]) + have hb1 : bi = 1 := by + dsimp [ci] at hc + nlinarith [hai, hbi, hθ.1, hθ.2] + right + calc x = tgt (s.edge i) ci := hx_i' + _ = tgt (s.edge i) bi := by rw [hc, hb1] + _ = Q (i + 1) := hqi.symm + +private theorem hx_j_endAt415 : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let Q := P3523T1InterpolatedTarget s t + let tgt (e : Fin (r + 3)) (u : Real) := + (1 - u) • t.target e + u • t.target (e + 1) + (∀ (e : Fin (r + 3)), Function.Injective (tgt e)) → (∀ (j : Fin (n + (3 : ℕ))), ∀ (x : ℝ × + ℝ), ∀ (bj : ℝ), (s.parameter j ≤ bj) → ((bj ≤ (1 : ℝ)) → ((Q (j + (1 : Fin (n + (3 : + ℕ)))) = tgt (s.edge j) bj) → (∀ (φ : ℝ), (φ ∈ Set.Icc (0 : ℝ) (1 : ℝ)) → ( + let cj := s.parameter j + φ * (bj - s.parameter j) + (Q j = tgt (s.edge j) (s.parameter j)) → ((x = tgt (s.edge j) cj) → ((x = t.target (s.edge j) + ∨ x = t.target (s.edge j + (1 : Fin (r + (3 : ℕ))))) → (x = Q j ∨ x = Q (j + 1))))))))) + := by + classical + intro r n q p s X K t Q tgt hcoarse_inj_tgt j x bj haj hbj hqj φ hφ cj hqj0 hx_j' hj_end + rcases hj_end with hj_end | hj_end + · have hc : cj = 0 := hcoarse_inj_tgt (s.edge j) (by + calc tgt (s.edge j) cj = x := hx_j'.symm + _ = t.target (s.edge j) := hj_end + _ = tgt (s.edge j) 0 := by simp [tgt]) + have ha0 : s.parameter j = 0 := by + dsimp [cj] at hc + nlinarith [s.parameter_nonneg j, hφ.1, hφ.2, haj] + left + calc x = tgt (s.edge j) cj := hx_j' + _ = tgt (s.edge j) (s.parameter j) := by rw [hc, ha0] + _ = Q j := hqj0.symm + · have hc : cj = 1 := hcoarse_inj_tgt (s.edge j) (by + calc tgt (s.edge j) cj = x := hx_j'.symm + _ = t.target (s.edge j + 1) := hj_end + _ = tgt (s.edge j) 1 := by simp [tgt]) + have hb1 : bj = 1 := by + dsimp [cj] at hc + nlinarith [haj, hbj, hφ.1, hφ.2] + right + calc x = tgt (s.edge j) cj := hx_j' + _ = tgt (s.edge j) bj := by rw [hc, hb1] + _ = Q (j + 1) := hqj.symm + +private theorem hfine_subset : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let Q := P3523T1InterpolatedTarget s t + let src (e : Fin (r + 3)) (u : Real) := + (1 - u) • q.vertex e + u • q.vertex (e + 1) + let tgt (e : Fin (r + 3)) (u : Real) := + (1 - u) • t.target e + u • t.target (e + 1) + (∀ (j : Fin (n + 3)), ∃ b : Real, s.parameter j ≤ b ∧ b ≤ 1 ∧ p.vertex (j + 1) = src (s.edge + j) b ∧ Q (j + 1) = tgt (s.edge j) b) → ((∀ (e : Fin (r + 3)), ∀ (u : Real), (u ∈ Set.Icc + (0 : Real) 1) → (tgt e u ∈ segment Real (t.target e) (t.target (e + 1)))) → ((⋃ j : Fin + (n + 3), segment Real (Q j) (Q (j + 1))) ⊆ ⋃ e : Fin (r + 3), segment Real (t.target e) + (t.target (e + 1)))) := by + classical + intro r n q p s X K t Q src tgt hfine_step htgt_mem x hx + rcases Set.mem_iUnion.mp hx with ⟨j, hx⟩ + rcases hfine_step j with ⟨b, hab, hb, hp, hq⟩ + have hleft : Q j ∈ segment Real (t.target (s.edge j)) + (t.target (s.edge j + 1)) := by + rw [show Q j = tgt (s.edge j) (s.parameter j) from rfl] + exact htgt_mem _ _ ⟨s.parameter_nonneg j, (s.parameter_lt_one j).le⟩ + have hright : Q (j + 1) ∈ segment Real (t.target (s.edge j)) + (t.target (s.edge j + 1)) := by + rw [hq] + exact htgt_mem _ _ ⟨(s.parameter_nonneg j).trans hab, hb⟩ + refine Set.mem_iUnion.mpr ⟨s.edge j, ?_⟩ + exact (convex_segment _ _).segment_subset hleft hright hx + +private theorem hcoarse_subset : + ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary + n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real + × Real)), ∀ (t : P3475T1TriangleTree q X K), + let Q := P3523T1InterpolatedTarget s t + let src (e : Fin (r + 3)) (u : Real) := + (1 - u) • q.vertex e + u • q.vertex (e + 1) + let tgt (e : Fin (r + 3)) (u : Real) := + (1 - u) • t.target e + u • t.target (e + 1) + (∀ (j : Fin (n + 3)), ∃ b : Real, s.parameter j ≤ b ∧ b ≤ 1 ∧ p.vertex (j + 1) = src (s.edge + j) b ∧ Q (j + 1) = tgt (s.edge j) b) → ((∀ (A : Real × Real), ∀ (B : Real × Real), ∀ (a : + Real), ∀ (b : Real), ∀ (θ : Real), (1 - θ) • ((1 - a) • A + a • B) + θ • ((1 - b) • A + + b + • B) = (1 - (a + θ * (b - a))) • A + (a + θ * (b - a)) • B) → ((∀ {A : Real × Real}, ∀ + {B : Real × Real}, ∀ {x : Real × Real}, (x ∈ segment Real A B) → (∃ θ : Real, θ ∈ + Set.Icc + (0 : Real) 1 ∧ x = (1 - θ) • A + θ • B)) → ((∀ (e : Fin (r + 3)), Function.Injective (src + e)) → ((∀ (e : Fin (r + 3)), ∀ (u : Real), (u ∈ Set.Icc (0 : Real) 1) → (src e u ∈ + segment Real (q.vertex e) (q.vertex (e + 1)))) → ((⋃ e : Fin (r + 3), segment Real + (t.target e) (t.target (e + 1))) ⊆ ⋃ j : Fin (n + 3), segment Real (Q j) (Q (j + 1))))))) + := by + classical + intro r n q p s X K t Q src tgt hfine_step hmix hsegment_scalar hcoarse_inj_src hsrc_mem x hx + rcases Set.mem_iUnion.mp hx with ⟨e, hx⟩ + rcases hsegment_scalar hx with ⟨v, hv, hxv⟩ + have hQstart (i : Fin (r + 3)) : Q (s.start i) = t.target i := by + simp [Q, P3523T1InterpolatedTarget, s.edge_start, s.parameter_start] + by_cases hvzero : v = 0 + · have hx0 : x = t.target e := by simpa [tgt, hvzero] using hxv + refine Set.mem_iUnion.mpr ⟨s.start e, ?_⟩ + have hleft : t.target e ∈ segment Real (Q (s.start e)) + (Q (s.start e + 1)) := by + rw [← hQstart e] + exact left_mem_segment Real _ _ + exact hx0 ▸ hleft + · by_cases hvone : v = 1 + · have hx1 : x = t.target (e + 1) := by simpa [tgt, hvone] using hxv + refine Set.mem_iUnion.mpr ⟨s.start (e + 1), ?_⟩ + have hleft : t.target (e + 1) ∈ segment Real (Q (s.start (e + 1))) + (Q (s.start (e + 1) + 1)) := by + rw [← hQstart (e + 1)] + exact left_mem_segment Real _ _ + exact hx1 ▸ hleft + · have hvint : 0 < v ∧ v < 1 := + ⟨lt_of_le_of_ne hv.1 (Ne.symm hvzero), lt_of_le_of_ne hv.2 hvone⟩ + let y := src e v + have hy_coarse : y ∈ ⋃ f : Fin (r + 3), segment Real (q.vertex f) (q.vertex (f + 1)) := + Set.mem_iUnion.mpr ⟨e, hsrc_mem e v hv⟩ + have hy_fine : y ∈ ⋃ j : Fin (n + 3), segment Real (p.vertex j) (p.vertex (j + 1)) := by + simpa only [s.carrier_eq.symm] using hy_coarse + rcases Set.mem_iUnion.mp hy_fine with ⟨j, hyseg⟩ + rcases hfine_step j with ⟨b, hab, hb, hp, hq⟩ + have hp0 : p.vertex j = src (s.edge j) (s.parameter j) := by + simp [src, s.vertex_formula] + have hp1 : p.vertex (j + 1) = src (s.edge j) b := hp + have hsource_subset : + segment Real (p.vertex j) (p.vertex (j + 1)) ⊆ + segment Real (q.vertex (s.edge j)) (q.vertex (s.edge j + 1)) := by + apply (convex_segment _ _).segment_subset + · rw [hp0] + exact hsrc_mem _ _ ⟨s.parameter_nonneg j, + (s.parameter_lt_one j).le⟩ + · rw [hp1] + exact hsrc_mem _ _ ⟨(s.parameter_nonneg j).trans hab, hb⟩ + have hyboth : y ∈ segment Real (q.vertex e) (q.vertex (e + 1)) ∩ + segment Real (q.vertex (s.edge j)) (q.vertex (s.edge j + 1)) := + ⟨by simpa [y] using hsrc_mem e v hv, hsource_subset hyseg⟩ + have hedge_eq : e = s.edge j := by + by_contra hne + rw [q.edge_intersection e (s.edge j) hne] at hyboth + rcases hyboth with ⟨hleft, _⟩ + rcases hleft with hleft | hleft + · have hvzero' : v = 0 := hcoarse_inj_src e (by + calc src e v = y := rfl + _ = q.vertex e := hleft + _ = src e 0 := by simp [src]) + exact hvzero (by linarith) + · have hvone' : v = 1 := hcoarse_inj_src e (by + calc src e v = y := rfl + _ = q.vertex (e + 1) := hleft + _ = src e 1 := by simp [src]) + exact hvone (by linarith) + rcases hsegment_scalar hyseg with ⟨θ, hθ, hyθ⟩ + let c := s.parameter j + θ * (b - s.parameter j) + have hp0' : p.vertex j = src e (s.parameter j) := by simpa [hedge_eq] using hp0 + have hp1' : p.vertex (j + 1) = src e b := by simpa [hedge_eq] using hp1 + have hy_eq : y = src e c := by + rw [hyθ, hp0', hp1'] + simpa [c, src] using hmix (q.vertex e) (q.vertex (e + 1)) + (s.parameter j) b θ + have hvc : v = c := hcoarse_inj_src e (by simpa [y] using hy_eq) + have hxv' : x = tgt e v := by simpa [tgt] using hxv + have htarget_mix : (1 - θ) • Q j + θ • Q (j + 1) = tgt e c := by + calc (1 - θ) • Q j + θ • Q (j + 1) = + (1 - θ) • tgt (s.edge j) (s.parameter j) + + θ • tgt (s.edge j) b := by rw [show Q j = + tgt (s.edge j) (s.parameter j) from rfl, hq] + _ = tgt e c := by + simpa [c, tgt, hedge_eq] using hmix (t.target e) + (t.target (e + 1)) (s.parameter j) b θ + have hx_fine : x = (1 - θ) • Q j + θ • Q (j + 1) := by + calc x = tgt e v := hxv' + _ = tgt e c := congrArg (tgt e) hvc + _ = (1 - θ) • Q j + θ • Q (j + 1) := htarget_mix.symm + refine Set.mem_iUnion.mpr ⟨j, ?_⟩ + rw [segment_eq_image] + exact ⟨θ, hθ, hx_fine.symm⟩ + +end TargetBoundaryProof + +theorem P3523T1TargetBoundary {r n : Nat} + (q : P3381T1PolygonBoundary r) (p : P3381T1PolygonBoundary n) + (s : P3475T1BoundarySubdivision q p) + (X K : Set (Real × Real)) (t : P3475T1TriangleTree q X K) : + let Q := P3523T1InterpolatedTarget s t + Function.Injective Q ∧ + (∀ i j : Fin (n + 3), i ≠ j → + segment Real (Q i) (Q (i + 1)) ∩ segment Real (Q j) (Q (j + 1)) = + {x | (x = Q i ∨ x = Q (i + 1)) ∧ + (x = Q j ∨ x = Q (j + 1))}) ∧ + frontier K = ⋃ i, segment Real (Q i) (Q (i + 1)) := by +-- BODY + classical + dsimp only + let Q := P3523T1InterpolatedTarget s t + have htarget_edge (i : Fin (r + 3)) : + t.target i ≠ t.target (i + 1) := TargetBoundaryProof.htarget_edge r q X K t i + have hparam_mem (j : Fin (n + 3)) : + Q j ∈ segment Real (t.target (s.edge j)) (t.target (s.edge j + 1)) := by + rw [segment_eq_image] + refine ⟨s.parameter j, ⟨s.parameter_nonneg j, (s.parameter_lt_one j).le⟩, ?_⟩ + simp [Q, P3523T1InterpolatedTarget] + have haffine_injective (A B : Real × Real) (hAB : A ≠ B) : + Function.Injective (fun u : Real => (1 - u) • A + u • B) := + TargetBoundaryProof.haffine_injective A B hAB + have haffine_inj (i : Fin (r + 3)) : + Function.Injective (fun u : Real => + (1 - u) • t.target i + u • t.target (i + 1)) := by + intro u v huv + exact haffine_injective (t.target i) (t.target (i + 1)) + (htarget_edge i) huv + have hparam_start (j : Fin (n + 3)) : + Q j ≠ t.target (s.edge j + 1) := by + intro h + have hu : s.parameter j = 1 := by + apply haffine_injective (t.target (s.edge j)) + (t.target (s.edge j + 1)) (htarget_edge (s.edge j)) + simpa [Q, P3523T1InterpolatedTarget] using h + linarith [s.parameter_lt_one j] + have hQinj : Function.Injective Q := TargetBoundaryProof.hQinj r n q p s X K t hparam_mem + haffine_inj hparam_start + let src (e : Fin (r + 3)) (u : Real) := + (1 - u) • q.vertex e + u • q.vertex (e + 1) + let tgt (e : Fin (r + 3)) (u : Real) := + (1 - u) • t.target e + u • t.target (e + 1) + have hfine_step (j : Fin (n + 3)) : + ∃ b : Real, s.parameter j ≤ b ∧ b ≤ 1 ∧ + p.vertex (j + 1) = src (s.edge j) b ∧ + Q (j + 1) = tgt (s.edge j) b := TargetBoundaryProof.hfine_step r n q p s X K t j + have hmix (A B : Real × Real) (a b θ : Real) : + (1 - θ) • ((1 - a) • A + a • B) + + θ • ((1 - b) • A + b • B) = + (1 - (a + θ * (b - a))) • A + (a + θ * (b - a)) • B := TargetBoundaryProof.hmix A B a b θ + have hsegment_scalar {A B x : Real × Real} + (hx : x ∈ segment Real A B) : + ∃ θ : Real, θ ∈ Set.Icc (0 : Real) 1 ∧ + x = (1 - θ) • A + θ • B := by + rw [segment_eq_image] at hx + rcases hx with ⟨θ, hθ, rfl⟩ + exact ⟨θ, hθ, rfl⟩ + have hcoarse_inj_src (e : Fin (r + 3)) : + Function.Injective (src e) := TargetBoundaryProof.hcoarse_inj_src r q haffine_injective e + have hcoarse_inj_tgt (e : Fin (r + 3)) : + Function.Injective (tgt e) := haffine_inj e + have hsrc_mem (e : Fin (r + 3)) (u : Real) + (hu : u ∈ Set.Icc (0 : Real) 1) : + src e u ∈ segment Real (q.vertex e) (q.vertex (e + 1)) := by + rw [segment_eq_image] + exact ⟨u, hu, rfl⟩ + have htgt_mem (e : Fin (r + 3)) (u : Real) + (hu : u ∈ Set.Icc (0 : Real) 1) : + tgt e u ∈ segment Real (t.target e) (t.target (e + 1)) := by + rw [segment_eq_image] + exact ⟨u, hu, rfl⟩ + refine ⟨hQinj, ?_, ?_⟩ + · intro i j hij + apply Set.ext + intro x + constructor + · intro hx + rcases hx with ⟨hx_i, hx_j⟩ + rcases hfine_step i with ⟨bi, hai, hbi, hpi, hqi⟩ + rcases hfine_step j with ⟨bj, haj, hbj, hpj, hqj⟩ + rcases hsegment_scalar hx_i with ⟨θ, hθ, hxθ⟩ + rcases hsegment_scalar hx_j with ⟨φ, hφ, hxφ⟩ + let ci := s.parameter i + θ * (bi - s.parameter i) + let cj := s.parameter j + φ * (bj - s.parameter j) + have hqi0 : Q i = tgt (s.edge i) (s.parameter i) := rfl + have hqj0 : Q j = tgt (s.edge j) (s.parameter j) := rfl + have hpi0 : p.vertex i = src (s.edge i) (s.parameter i) := by + simp [src, s.vertex_formula] + have hpj0 : p.vertex j = src (s.edge j) (s.parameter j) := by + simp [src, s.vertex_formula] + have hx_i' : x = tgt (s.edge i) ci := by + have hxθ' : x = (1 - θ) • Q i + θ • Q (i + 1) := by + simpa [Q] using hxθ + calc x = (1 - θ) • Q i + θ • Q (i + 1) := hxθ' + _ = (1 - θ) • tgt (s.edge i) (s.parameter i) + + θ • tgt (s.edge i) bi := by rw [hqi0, hqi] + _ = tgt (s.edge i) ci := by + simpa [ci, tgt] using hmix (t.target (s.edge i)) + (t.target (s.edge i + 1)) (s.parameter i) bi θ + have hx_j' : x = tgt (s.edge j) cj := by + have hxφ' : x = (1 - φ) • Q j + φ • Q (j + 1) := by + simpa [Q] using hxφ + calc x = (1 - φ) • Q j + φ • Q (j + 1) := hxφ' + _ = (1 - φ) • tgt (s.edge j) (s.parameter j) + + φ • tgt (s.edge j) bj := by rw [hqj0, hqj] + _ = tgt (s.edge j) cj := by + simpa [cj, tgt] using hmix (t.target (s.edge j)) + (t.target (s.edge j + 1)) (s.parameter j) bj φ + have hci : ci ∈ Set.Icc (0 : Real) 1 := by + constructor + · dsimp [ci] + nlinarith [s.parameter_nonneg i, hθ.1, hθ.2, hai] + · dsimp [ci] + nlinarith [s.parameter_nonneg i, s.parameter_lt_one i, hθ.1, + hθ.2, hai, hbi] + have hcj : cj ∈ Set.Icc (0 : Real) 1 := by + constructor + · dsimp [cj] + nlinarith [s.parameter_nonneg j, hφ.1, hφ.2, haj] + · dsimp [cj] + nlinarith [s.parameter_nonneg j, s.parameter_lt_one j, hφ.1, + hφ.2, haj, hbj] + by_cases he : s.edge i = s.edge j + · let y := src (s.edge i) ci + have hparam_eq : ci = cj := by + apply hcoarse_inj_tgt (s.edge i) + calc tgt (s.edge i) ci = x := hx_i'.symm + _ = tgt (s.edge j) cj := hx_j' + _ = tgt (s.edge i) cj := by rw [he] + have hy_i : y ∈ segment Real (p.vertex i) (p.vertex (i + 1)) := by + rw [segment_eq_image] + refine ⟨θ, hθ, ?_⟩ + dsimp [y] + rw [hpi0, hpi] + simpa [src] using hmix (q.vertex (s.edge i)) (q.vertex (s.edge i + 1)) + (s.parameter i) bi θ + have hy_j : y ∈ segment Real (p.vertex j) (p.vertex (j + 1)) := TargetBoundaryProof.hy_j + r n q p s hmix i j bi bj hpj θ φ hφ hpj0 he hparam_eq + have hy : y ∈ segment Real (p.vertex i) (p.vertex (i + 1)) ∩ + segment Real (p.vertex j) (p.vertex (j + 1)) := ⟨hy_i, hy_j⟩ + rw [p.edge_intersection i j hij] at hy + rcases hy with ⟨hi_end, hj_end⟩ + have hx_i_end : x = Q i ∨ x = Q (i + 1) := TargetBoundaryProof.hx_i_endAt340 r n q p s X + K t hcoarse_inj_src i x bi hpi hqi θ hqi0 hpi0 hx_i' hi_end + have hx_j_end : x = Q j ∨ x = Q (j + 1) := TargetBoundaryProof.hx_j_endAt358 r n q p s X + K t hcoarse_inj_src i j x bi bj hpj hqj θ φ hqj0 hpj0 hx_j' he hparam_eq hj_end + exact ⟨hx_i_end, hx_j_end⟩ + · have hx_coarse_i : x ∈ segment Real (t.target (s.edge i)) + (t.target (s.edge i + 1)) := by + rw [hx_i'] + exact htgt_mem (s.edge i) ci hci + have hx_coarse_j : x ∈ segment Real (t.target (s.edge j)) + (t.target (s.edge j + 1)) := by + rw [hx_j'] + exact htgt_mem (s.edge j) cj hcj + have hx_coarse : x ∈ segment Real (t.target (s.edge i)) + (t.target (s.edge i + 1)) ∩ + segment Real (t.target (s.edge j)) (t.target (s.edge j + 1)) := + ⟨hx_coarse_i, hx_coarse_j⟩ + rw [t.target_edge_intersection _ _ he] at hx_coarse + rcases hx_coarse with ⟨hi_end, hj_end⟩ + have hx_i_end : x = Q i ∨ x = Q (i + 1) := TargetBoundaryProof.hx_i_endAt391 r n q p s X + K t hcoarse_inj_tgt i x bi hai hbi hqi θ hθ hqi0 hx_i' hi_end + have hx_j_end : x = Q j ∨ x = Q (j + 1) := TargetBoundaryProof.hx_j_endAt415 r n q p s X + K t hcoarse_inj_tgt j x bj haj hbj hqj φ hφ hqj0 hx_j' hj_end + exact ⟨hx_i_end, hx_j_end⟩ + · intro hx + rcases hx with ⟨hxi, hxj⟩ + rcases hxi with hxi | hxi + · rcases hxj with hxj | hxj + · subst x + exact ⟨left_mem_segment Real _ _, by rw [hxj]; exact left_mem_segment Real _ _⟩ + · subst x + exact ⟨left_mem_segment Real _ _, by rw [hxj]; exact right_mem_segment Real _ _⟩ + · rcases hxj with hxj | hxj + · subst x + exact ⟨right_mem_segment Real _ _, by rw [hxj]; exact left_mem_segment Real _ _⟩ + · subst x + exact ⟨right_mem_segment Real _ _, by rw [hxj]; exact right_mem_segment Real _ _⟩ + have hfine_subset : + (⋃ j : Fin (n + 3), segment Real (Q j) (Q (j + 1))) ⊆ + ⋃ e : Fin (r + 3), segment Real (t.target e) (t.target (e + 1)) := + TargetBoundaryProof.hfine_subset r n q p s X K t hfine_step htgt_mem + have hcoarse_subset : + (⋃ e : Fin (r + 3), segment Real (t.target e) (t.target (e + 1))) ⊆ + ⋃ j : Fin (n + 3), segment Real (Q j) (Q (j + 1)) := TargetBoundaryProof.hcoarse_subset r + n q p s X K t hfine_step hmix hsegment_scalar hcoarse_inj_src hsrc_mem + have hcarrier : (⋃ j : Fin (n + 3), segment Real (Q j) (Q (j + 1))) = + ⋃ e : Fin (r + 3), segment Real (t.target e) (t.target (e + 1)) := + Set.Subset.antisymm hfine_subset hcoarse_subset + calc + frontier K = ⋃ e : Fin (r + 3), segment Real (t.target e) (t.target (e + 1)) := + t.target_frontier + _ = ⋃ j : Fin (n + 3), segment Real (Q j) (Q (j + 1)) := hcarrier.symm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1TargetHull.lean b/LeanPool/ApollonianSuperharmonic/P3523T1TargetHull.lean new file mode 100644 index 0000000000..48f77778d6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3523T1TargetHull.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3523T1InterpolatedTarget + +-- [TABLET NODE: P3523T1TargetHull] + +/-! +# P3523T1TargetHull + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3523T1TargetHull {r n : Nat} + {q : P3381T1PolygonBoundary r} {p : P3381T1PolygonBoundary n} + (s : P3475T1BoundarySubdivision q p) + {X K : Set (Real × Real)} (t : P3475T1TriangleTree q X K) : + (∀ i, P3523T1InterpolatedTarget s t (s.start i) = t.target i) ∧ + K = convexHull Real (Set.range (P3523T1InterpolatedTarget s t)) := by +-- BODY + constructor + · intro i + simp [P3523T1InterpolatedTarget, s.edge_start, s.parameter_start] + · apply Set.Subset.antisymm + · calc + K = convexHull Real (Set.range t.target) := t.target_hull + _ ⊆ convexHull Real (Set.range (P3523T1InterpolatedTarget s t)) := by + apply convexHull_mono + rintro _ ⟨i, rfl⟩ + refine ⟨s.start i, ?_⟩ + simp [P3523T1InterpolatedTarget, s.edge_start, s.parameter_start] + · apply convexHull_min _ t.target_convex + rintro _ ⟨j, rfl⟩ + have hseg : segment Real (t.target (s.edge j)) (t.target (s.edge j + 1)) + ⊆ K := by + calc + segment Real (t.target (s.edge j)) (t.target (s.edge j + 1)) + ⊆ convexHull Real (Set.range t.target) := + segment_subset_convexHull ⟨_, rfl⟩ ⟨_, rfl⟩ + _ = K := t.target_hull.symm + apply hseg + rw [segment_eq_image] + exact ⟨s.parameter j, + ⟨s.parameter_nonneg j, (s.parameter_lt_one j).le⟩, rfl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean b/LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean new file mode 100644 index 0000000000..54f81a7426 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean @@ -0,0 +1,1084 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public import Mathlib.Analysis.Convex.Hull +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Data.Fin.VecNotation + +-- [TABLET NODE: P3523T1TwoTriangleSplit] + +/-! +# P3523T1TwoTriangleSplit + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TwoTriangleSplit + +private theorem hu_nonneg (u : Real) (hu : 0 < u ∧ u < 1) : 0 ≤ u := by + classical + exact hu.1.le + +private theorem h1u_nonneg (u : Real) (hu : 0 < u ∧ u < 1) : 0 ≤ 1-u := by + classical + linarith [hu.2] + +private noncomputable def d (A : Real × Real) (B : Real × Real) (C : Real × Real) : Real := (B.1 + - A.1) * (C.2 - A.2) - (C.1 - A.1) * (B.2 - A.2) + +private theorem hd (A : Real × Real) (B : Real × Real) (C : Real × Real) (hn : + P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : (d A B C) ≠ 0 := by + classical + let d : Real := (B.1 - A.1) * (C.2 - A.2) - (C.1 - A.1) * (B.2 - A.2) + change (d ≠ 0) + dsimp [d, P3381T1TriangleDeterminant] at hn ⊢ + simpa [Prod.fst_sub, Prod.snd_sub] using hn + +private theorem distinctAB (A : Real × Real) (B : Real × Real) (C : Real × Real) (hn : + P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : A ≠ B := by + classical + let d : Real := (B.1 - A.1) * (C.2 - A.2) - (C.1 - A.1) * (B.2 - A.2) + have hd : d ≠ 0 := hd A B C hn + intro h + subst B + apply hd + dsimp [d] + ring + +private theorem distinctAC (A : Real × Real) (B : Real × Real) (C : Real × Real) (hn : + P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : A ≠ C := by + classical + let d : Real := (B.1 - A.1) * (C.2 - A.2) - (C.1 - A.1) * (B.2 - A.2) + have hd : d ≠ 0 := hd A B C hn + intro h + subst C + apply hd + dsimp [d] + ring + +private theorem distinctBC (A : Real × Real) (B : Real × Real) (C : Real × Real) (hn : + P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : B ≠ C := by + classical + let d : Real := (B.1 - A.1) * (C.2 - A.2) - (C.1 - A.1) * (B.2 - A.2) + have hd : d ≠ 0 := hd A B C hn + intro h + subst C + apply hd + dsimp [d] + ring + +private theorem hull3 (P Q R x : Real × Real) (hPQ : P ≠ Q) (hPR : P ≠ R) + (hQR : Q ≠ R) : + x ∈ convexHull Real ({P, Q, R} : Set (Real × Real)) ↔ + ∃ a b c : Real, 0 ≤ a ∧ 0 ≤ b ∧ 0 ≤ c ∧ a + b + c = 1 ∧ + a • P + b • Q + c • R = x := by + classical + rw [show ({P, Q, R} : Set (Real × Real)) = + ↑({P, Q, R} : Finset (Real × Real)) by ext y; simp] + rw [Finset.mem_convexHull'] + constructor + · rintro ⟨w, hpos, hsum, hvec⟩ + simp? [Finset.sum_insert, hPQ, hPR, hQR] at hpos hsum hvec + rcases hpos with ⟨hP, hQ, hR⟩ + refine ⟨w P, w Q, w R, ?_, ?_, ?_, ?_, ?_⟩ + · exact hP + · exact hQ + · exact hR + · nlinarith [hsum] + · simpa [add_assoc] using hvec + · rintro ⟨a, b, c, ha, hb, hc, hsum, hvec⟩ + refine ⟨(fun y => if P = y then a else if Q = y then b else c), + ?_, ?_, ?_⟩ + · intro y hy + simp only [Finset.mem_insert, Finset.mem_singleton] at hy + rcases hy with hy | hy | hy + · subst y; simpa using ha + · subst y; simpa [hPQ] using hb + · subst y; simpa [hPR, hQR] using hc + · simp [Finset.sum_insert, hPQ, hPR, hQR] + nlinarith [hsum] + · simp [Finset.sum_insert, hPQ, hPR, hQR] + simpa [add_assoc] using hvec + +private theorem affineUnique (A : Real × Real) (B : Real × Real) (C : Real × Real) (hn : + P3381T1TriangleDeterminant ![A, B, C] ≠ 0) (a b c a' b' c' : Real) + (hs : a + b + c = 1) (hs' : a' + b' + c' = 1) + (he : a • A + b • B + c • C = a' • A + b' • B + c' • C) : + a = a' ∧ b = b' ∧ c = c' := by + classical + let d : Real := (B.1 - A.1) * (C.2 - A.2) - (C.1 - A.1) * (B.2 - A.2) + have hd : d ≠ 0 := hd A B C hn + have he1 := congrArg Prod.fst he + have he2 := congrArg Prod.snd he + simp only [Prod.fst_add, Prod.snd_add, Prod.smul_fst, Prod.smul_snd] at he1 he2 + have hsum : (b - b') + (c - c') = -(a - a') := by linarith + have hsumdiff : (a - a') + (b - b') + (c - c') = 0 := by linarith + have hx : (b - b') * (B.1 - A.1) + (c - c') * (C.1 - A.1) = 0 := by + linear_combination he1 - A.1 * hsumdiff + have hy : (b - b') * (B.2 - A.2) + (c - c') * (C.2 - A.2) = 0 := by + linear_combination he2 - A.2 * hsumdiff + have hb0 : d * (b - b') = 0 := by + dsimp [d] + linear_combination hx * (C.2 - A.2) - hy * (C.1 - A.1) + have hc0 : d * (c - c') = 0 := by + dsimp [d] + linear_combination hy * (B.1 - A.1) - hx * (B.2 - A.2) + have hb : b = b' := by + have := (mul_eq_zero.mp hb0).resolve_left hd + linarith + have hc : c = c' := by + have := (mul_eq_zero.mp hc0).resolve_left hd + linarith + have ha : a = a' := by linarith + exact ⟨ha, hb, hc⟩ + +private theorem hDneA (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) (hu : 0 < + u ∧ u < 1) (hn : P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : (1 - u) • A + u • B ≠ A := by + classical + have affineUnique (a b c a' b' c' : Real) + (hs : a + b + c = 1) (hs' : a' + b' + c' = 1) + (he : a • A + b • B + c • C = a' • A + b' • B + c' • C) : + a = a' ∧ b = b' ∧ c = c' := affineUnique A B C hn a b c a' b' c' hs hs' he + intro h + have huniq := affineUnique (1-u) u (0:Real) 1 0 0 (by ring) (by norm_num) + (by simpa using h) + have : u = 0 := by linarith [huniq.2.1] + exact (ne_of_gt hu.1) this + +private theorem hDneB (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) (hu : 0 < + u ∧ u < 1) (hn : P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : (1 - u) • A + u • B ≠ B := by + classical + have affineUnique (a b c a' b' c' : Real) + (hs : a + b + c = 1) (hs' : a' + b' + c' = 1) + (he : a • A + b • B + c • C = a' • A + b' • B + c' • C) : + a = a' ∧ b = b' ∧ c = c' := affineUnique A B C hn a b c a' b' c' hs hs' he + intro h + have huniq := affineUnique (1-u) u (0:Real) 0 1 0 (by ring) (by norm_num) + (by simpa using h) + have : 1 - u = 0 := by linarith [huniq.1] + linarith [hu.2] + +private theorem hDneC (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) (hn : + P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : (1 - u) • A + u • B ≠ C := by + classical + have affineUnique (a b c a' b' c' : Real) + (hs : a + b + c = 1) (hs' : a' + b' + c' = 1) + (he : a • A + b • B + c • C = a' • A + b' • B + c' • C) : + a = a' ∧ b = b' ∧ c = c' := affineUnique A B C hn a b c a' b' c' hs hs' he + intro h + have huniq := affineUnique (1-u) u (0:Real) (0:Real) (0:Real) (1:Real) + (by ring) (by norm_num) (by simpa using h) + linarith [huniq.2.1] + +private theorem coeffSplit (u : Real) (hu : 0 < u ∧ u < 1) (a b c : Real) (ha : 0 ≤ a) (hb : 0 ≤ + b) (hc : 0 ≤ c) + (hsum : a + b + c = 1) : + (∃ l m t : Real, 0 ≤ l ∧ 0 ≤ m ∧ 0 ≤ t ∧ l + m + t = 1 ∧ + a = l + (1-u)*m ∧ b = u*m ∧ c = t) ∨ + (∃ m r t : Real, 0 ≤ m ∧ 0 ≤ r ∧ 0 ≤ t ∧ m + r + t = 1 ∧ + a = (1-u)*m ∧ b = u*m+r ∧ c = t) := by + classical + have hu0 : u ≠ 0 := ne_of_gt hu.1 + have hv : 0 < 1-u := by linarith [hu.2] + have hv0 : 1-u ≠ 0 := ne_of_gt hv + rcases le_total ((1-u)*b) (u*a) with h | h + · left + refine ⟨a-(1-u)*b/u, b/u, c, ?_, div_nonneg hb hu.1.le, hc, ?_, ?_, ?_, rfl⟩ + · apply sub_nonneg.mpr + exact (div_le_iff₀ hu.1).2 (by nlinarith) + · field_simp + nlinarith [hsum] + · field_simp + ring + · field_simp + · right + refine ⟨a/(1-u), b-u*a/(1-u), c, div_nonneg ha hv.le, ?_, hc, ?_, ?_, ?_, rfl⟩ + · apply sub_nonneg.mpr + exact (div_le_iff₀ hv).2 (by nlinarith) + · field_simp + nlinarith [hsum] + · field_simp + · field_simp + ring + +private noncomputable def D (A : Real × Real) (B : Real × Real) (u : Real) : Real × Real := (1-u) + • A + u • B + +private theorem hcoverage (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) (hu : + 0 < u ∧ u < 1) (hn : P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : convexHull Real ({A, B, + C} : Set (Real × Real)) = + convexHull Real ({A, (D A B u), C} : Set (Real × Real)) ∪ + convexHull Real ({(D A B u), B, C} : Set (Real × Real)) := by + classical + have hu_nonneg : 0 ≤ u := hu_nonneg u hu + have h1u_nonneg : 0 ≤ 1-u := h1u_nonneg u hu + have distinctAB : A ≠ B := distinctAB A B C hn + have distinctAC : A ≠ C := distinctAC A B C hn + have distinctBC : B ≠ C := distinctBC A B C hn + have hull3 (P Q R x : Real × Real) (hPQ : P ≠ Q) (hPR : P ≠ R) + (hQR : Q ≠ R) : + x ∈ convexHull Real ({P, Q, R} : Set (Real × Real)) ↔ + ∃ a b c : Real, 0 ≤ a ∧ 0 ≤ b ∧ 0 ≤ c ∧ a + b + c = 1 ∧ + a • P + b • Q + c • R = x := hull3 P Q R x hPQ hPR hQR + have hDneA : (1 - u) • A + u • B ≠ A := hDneA A B C u hu hn + have hDneB : (1 - u) • A + u • B ≠ B := hDneB A B C u hu hn + have hDneC : (1 - u) • A + u • B ≠ C := hDneC A B C u hn + have hleftHull (x : Real × Real) := hull3 A ((1 - u) • A + u • B) C x + (fun h => hDneA h.symm) distinctAC hDneC + have hrightHull (x : Real × Real) := hull3 ((1 - u) • A + u • B) B C + x hDneB hDneC distinctBC + have holdHull (x : Real × Real) := hull3 A B C x distinctAB distinctAC distinctBC + have coeffSplit (a b c : Real) (ha : 0 ≤ a) (hb : 0 ≤ b) (hc : 0 ≤ c) + (hsum : a + b + c = 1) : + (∃ l m t : Real, 0 ≤ l ∧ 0 ≤ m ∧ 0 ≤ t ∧ l + m + t = 1 ∧ + a = l + (1-u)*m ∧ b = u*m ∧ c = t) ∨ + (∃ m r t : Real, 0 ≤ m ∧ 0 ≤ r ∧ 0 ≤ t ∧ m + r + t = 1 ∧ + a = (1-u)*m ∧ b = u*m+r ∧ c = t) := coeffSplit u hu a b c ha hb hc hsum + let D : Real × Real := (1-u) • A + u • B + change (convexHull Real ({A, B, C} : Set (Real × Real)) = + convexHull Real ({A, D, C} : Set (Real × Real)) ∪ + convexHull Real ({D, B, C} : Set (Real × Real))) + apply Set.ext + intro x + constructor + · intro hx + obtain ⟨a, b, c, ha, hb, hc, hsum, hvec⟩ := (holdHull x).1 hx + rcases coeffSplit a b c ha hb hc hsum with hleft | hright + · obtain ⟨l, m, t, hl, hm, ht, hst, hla, hmb, htc⟩ := hleft + have hla' : a = l + m*(1-u) := by rw [hla]; ring + have hmb' : b = m*u := by rw [hmb]; ring + left + apply (hleftHull x).2 + refine ⟨l, m, t, hl, hm, ht, hst, ?_⟩ + calc + l • A + m • D + t • C = a • A + b • B + c • C := by + simp only [D, smul_add, smul_smul] + subst a + subst b + subst c + module + _ = x := hvec + · obtain ⟨m, r, t, hm, hr, ht, hst, ham, hbr, htc⟩ := hright + have ham' : a = m*(1-u) := by rw [ham]; ring + have hbr' : b = m*u+r := by rw [hbr]; ring + right + apply (hrightHull x).2 + refine ⟨m, r, t, hm, hr, ht, hst, ?_⟩ + calc + m • D + r • B + t • C = a • A + b • B + c • C := by + simp only [D, smul_add, smul_smul] + subst a + subst b + subst c + module + _ = x := hvec + · rintro (hx | hx) + · obtain ⟨l, m, t, hl, hm, ht, hst, hvec⟩ := (hleftHull x).1 hx + apply (holdHull x).2 + refine ⟨l+(1-u)*m, u*m, t, ?_, ?_, ht, ?_, ?_⟩ + · exact add_nonneg hl (mul_nonneg h1u_nonneg hm) + · exact mul_nonneg hu_nonneg hm + · nlinarith [hst] + · calc + (l+(1-u)*m) • A + (u*m) • B + t • C = l • A + m • D + t • C := by + simp only [D, smul_add, smul_smul] + module + _ = x := hvec + · obtain ⟨m, r, t, hm, hr, ht, hst, hvec⟩ := (hrightHull x).1 hx + apply (holdHull x).2 + refine ⟨(1-u)*m, u*m+r, t, ?_, ?_, ht, ?_, ?_⟩ + · exact mul_nonneg h1u_nonneg hm + · exact add_nonneg (mul_nonneg hu_nonneg hm) hr + · nlinarith [hst] + · calc + ((1-u)*m) • A + (u*m+r) • B + t • C = m • D + r • B + t • C := by + simp only [D, smul_add, smul_smul] + module + _ = x := hvec + +private theorem hdiag (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) (hu : 0 < + u ∧ u < 1) (hn : P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : + convexHull Real ({A, (D A B u), C} : Set (Real × Real)) ∩ + convexHull Real ({(D A B u), B, C} : Set (Real × Real)) = segment Real (D A B u) C := by + classical + have hu_nonneg : 0 ≤ u := hu_nonneg u hu + have h1u_nonneg : 0 ≤ 1-u := h1u_nonneg u hu + have distinctAC : A ≠ C := distinctAC A B C hn + have distinctBC : B ≠ C := distinctBC A B C hn + have hull3 (P Q R x : Real × Real) (hPQ : P ≠ Q) (hPR : P ≠ R) + (hQR : Q ≠ R) : + x ∈ convexHull Real ({P, Q, R} : Set (Real × Real)) ↔ + ∃ a b c : Real, 0 ≤ a ∧ 0 ≤ b ∧ 0 ≤ c ∧ a + b + c = 1 ∧ + a • P + b • Q + c • R = x := hull3 P Q R x hPQ hPR hQR + have affineUnique (a b c a' b' c' : Real) + (hs : a + b + c = 1) (hs' : a' + b' + c' = 1) + (he : a • A + b • B + c • C = a' • A + b' • B + c' • C) : + a = a' ∧ b = b' ∧ c = c' := affineUnique A B C hn a b c a' b' c' hs hs' he + have hDneA : (1 - u) • A + u • B ≠ A := hDneA A B C u hu hn + have hDneB : (1 - u) • A + u • B ≠ B := hDneB A B C u hu hn + have hDneC : (1 - u) • A + u • B ≠ C := hDneC A B C u hn + have hleftHull (x : Real × Real) := hull3 A ((1 - u) • A + u • B) C x + (fun h => hDneA h.symm) distinctAC hDneC + have hrightHull (x : Real × Real) := hull3 ((1 - u) • A + u • B) B C + x hDneB hDneC distinctBC + let D : Real × Real := (1-u) • A + u • B + change (convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({D, B, C} : Set (Real × Real)) = segment Real D C) + ext x + constructor + · rintro ⟨hxL, hxR⟩ + obtain ⟨l, m, t, hl, hm, ht, hsumL, hvecL⟩ := (hleftHull x).1 hxL + obtain ⟨m', r, t', hm', hr, ht', hsumR, hvecR⟩ := (hrightHull x).1 hxR + have hLold : (l+(1-u)*m) • A + (u*m) • B + t • C = x := by + calc + (l+(1-u)*m) • A + (u*m) • B + t • C = l • A + m • D + t • C := by + simp only [D, smul_add, smul_smul] + module + _ = x := hvecL + have hRold : ((1-u)*m') • A + (u*m'+r) • B + t' • C = x := by + calc + ((1-u)*m') • A + (u*m'+r) • B + t' • C = m' • D + r • B + t' • C := by + simp only [D, smul_add, smul_smul] + module + _ = x := hvecR + have huniq := affineUnique (l+(1-u)*m) (u*m) t ((1-u)*m') (u*m'+r) t' + (by nlinarith [hsumL]) (by nlinarith [hsumR]) (hLold.trans hRold.symm) + have hzero : u*l + (1-u)*r = 0 := by + linear_combination u * huniq.1 - (1-u) * huniq.2.1 + have hl0 : l = 0 := by + nlinarith [mul_nonneg hu_nonneg hl, mul_nonneg h1u_nonneg hr] + have hr0 : r = 0 := by + nlinarith [mul_nonneg hu_nonneg hl, mul_nonneg h1u_nonneg hr] + have hmm : m = m' := by + have hbEq := huniq.2.1 + rw [hr0] at hbEq + nlinarith [hu.1] + have hmt : m+t = 1 := by nlinarith [hsumL, hl0] + refine ⟨m, t, hm, ht, hmt, ?_⟩ + calc + m • D + t • C = ((1-u)*m) • A + (u*m) • B + t • C := by + simp only [D, smul_add, smul_smul] + module + _ = x := by + rw [← hLold, hl0] + simp + · rintro ⟨s, t, hs, ht, hst, hvec⟩ + constructor + · apply (hleftHull x).2 + refine ⟨0, s, t, le_rfl, hs, ht, ?_, ?_⟩ + · simpa using hst + · simpa only [zero_smul, zero_add, add_zero] using hvec + · apply (hrightHull x).2 + refine ⟨s, 0, t, hs, le_rfl, ht, ?_, ?_⟩ + · simpa using hst + · simpa only [zero_smul, zero_add, add_zero] using hvec + +private theorem pairACsubL (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) : + convexHull Real ({A, C} : Set (Real × Real)) ⊆ + convexHull Real ({A, (D A B u), C} : Set (Real × Real)) := by + classical + let D : Real × Real := (1-u) • A + u • B + change (convexHull Real ({A, C} : Set (Real × Real)) ⊆ + convexHull Real ({A, D, C} : Set (Real × Real))) + apply convexHull_mono + intro z hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz ⊢ + rcases hz with hz | hz + · subst z; simp + · subst z; simp + +private theorem pairBCsubR (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) : + convexHull Real ({B, C} : Set (Real × Real)) ⊆ + convexHull Real ({(D A B u), B, C} : Set (Real × Real)) := by + classical + let D : Real × Real := (1-u) • A + u • B + change (convexHull Real ({B, C} : Set (Real × Real)) ⊆ + convexHull Real ({D, B, C} : Set (Real × Real))) + apply convexHull_mono + intro z hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz ⊢ + rcases hz with hz | hz + · subst z; simp + · subst z; simp + +private theorem hleftAC (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) : + convexHull Real ({A, (D A B u), C} : Set (Real × Real)) ∩ + convexHull Real ({A, C} : Set (Real × Real)) = + convexHull Real ({A, C} : Set (Real × Real)) := by + classical + let D : Real × Real := (1-u) • A + u • B + have pairACsubL : convexHull Real ({A, C} : Set (Real × Real)) ⊆ + convexHull Real ({A, D, C} : Set (Real × Real)) := pairACsubL A B C u + change (convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({A, C} : Set (Real × Real)) = + convexHull Real ({A, C} : Set (Real × Real))) + ext z + constructor + · exact And.right + · intro hz + exact ⟨pairACsubL hz, hz⟩ + +private theorem hrightBC (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) : + convexHull Real ({(D A B u), B, C} : Set (Real × Real)) ∩ + convexHull Real ({B, C} : Set (Real × Real)) = + convexHull Real ({B, C} : Set (Real × Real)) := by + classical + let D : Real × Real := (1-u) • A + u • B + have pairBCsubR : convexHull Real ({B, C} : Set (Real × Real)) ⊆ + convexHull Real ({D, B, C} : Set (Real × Real)) := pairBCsubR A B C u + change (convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({B, C} : Set (Real × Real)) = + convexHull Real ({B, C} : Set (Real × Real))) + ext z + constructor + · exact And.right + · intro hz + exact ⟨pairBCsubR hz, hz⟩ + +private theorem hrightAC (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) (hu : 0 + < u ∧ u < 1) (hn : P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : + convexHull Real ({(D A B u), B, C} : Set (Real × Real)) ∩ + convexHull Real ({A, C} : Set (Real × Real)) = + convexHull Real ({C} : Set (Real × Real)) := by + classical + have hu_nonneg : 0 ≤ u := hu_nonneg u hu + have distinctBC : B ≠ C := distinctBC A B C hn + have hull3 (P Q R x : Real × Real) (hPQ : P ≠ Q) (hPR : P ≠ R) + (hQR : Q ≠ R) : + x ∈ convexHull Real ({P, Q, R} : Set (Real × Real)) ↔ + ∃ a b c : Real, 0 ≤ a ∧ 0 ≤ b ∧ 0 ≤ c ∧ a + b + c = 1 ∧ + a • P + b • Q + c • R = x := hull3 P Q R x hPQ hPR hQR + have affineUnique (a b c a' b' c' : Real) + (hs : a + b + c = 1) (hs' : a' + b' + c' = 1) + (he : a • A + b • B + c • C = a' • A + b' • B + c' • C) : + a = a' ∧ b = b' ∧ c = c' := affineUnique A B C hn a b c a' b' c' hs hs' he + have hDneB : (1 - u) • A + u • B ≠ B := hDneB A B C u hu hn + have hDneC : (1 - u) • A + u • B ≠ C := hDneC A B C u hn + have hrightHull (x : Real × Real) := hull3 ((1 - u) • A + u • B) B C + x hDneB hDneC distinctBC + let D : Real × Real := (1-u) • A + u • B + change (convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({A, C} : Set (Real × Real)) = + convexHull Real ({C} : Set (Real × Real))) + ext x + constructor + · rintro ⟨hxR, hxAC⟩ + obtain ⟨m, r, t, hm, hr, ht, hsumR, hvecR⟩ := (hrightHull x).1 hxR + rw [convexHull_pair] at hxAC + obtain ⟨a, c, ha, hc, hsumAC, hvecAC⟩ := hxAC + have hRold : ((1-u)*m) • A + (u*m+r) • B + t • C = x := by + calc + ((1-u)*m) • A + (u*m+r) • B + t • C = m • D + r • B + t • C := by + simp only [D, smul_add, smul_smul] + module + _ = x := hvecR + have hsumOld : (1-u)*m + (u*m+r) + t = 1 := by nlinarith [hsumR] + have hpoint : ((1-u)*m) • A + (u*m+r) • B + t • C = + a • A + (0:Real) • B + c • C := by + calc + ((1-u)*m) • A + (u*m+r) • B + t • C = x := hRold + _ = a • A + (0:Real) • B + c • C := by simpa using hvecAC.symm + have huniq := affineUnique ((1-u)*m) (u*m+r) t a 0 c hsumOld + (by simpa using hsumAC) hpoint + have hm0 : m = 0 := by + nlinarith [huniq.2.1, mul_nonneg hu_nonneg hm] + have hr0 : r = 0 := by nlinarith [huniq.2.1] + have ht1 : t = 1 := by nlinarith [hsumR, hm0, hr0] + have hxC : x = C := by + rw [← hRold, hm0, hr0, ht1] + simp + simp [hxC] + · intro hxC + have hxEq : x = C := by simpa using hxC + subst x + constructor + · exact subset_convexHull _ _ (by simp) + · exact subset_convexHull _ _ (by simp) + +private theorem hleftBC (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) (hu : 0 + < u ∧ u < 1) (hn : P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : + convexHull Real ({A, (D A B u), C} : Set (Real × Real)) ∩ + convexHull Real ({B, C} : Set (Real × Real)) = + convexHull Real ({C} : Set (Real × Real)) := by + classical + have h1u_nonneg : 0 ≤ 1-u := h1u_nonneg u hu + have distinctAC : A ≠ C := distinctAC A B C hn + have hull3 (P Q R x : Real × Real) (hPQ : P ≠ Q) (hPR : P ≠ R) + (hQR : Q ≠ R) : + x ∈ convexHull Real ({P, Q, R} : Set (Real × Real)) ↔ + ∃ a b c : Real, 0 ≤ a ∧ 0 ≤ b ∧ 0 ≤ c ∧ a + b + c = 1 ∧ + a • P + b • Q + c • R = x := hull3 P Q R x hPQ hPR hQR + have affineUnique (a b c a' b' c' : Real) + (hs : a + b + c = 1) (hs' : a' + b' + c' = 1) + (he : a • A + b • B + c • C = a' • A + b' • B + c' • C) : + a = a' ∧ b = b' ∧ c = c' := affineUnique A B C hn a b c a' b' c' hs hs' he + have hDneA : (1 - u) • A + u • B ≠ A := hDneA A B C u hu hn + have hDneC : (1 - u) • A + u • B ≠ C := hDneC A B C u hn + have hleftHull (x : Real × Real) := hull3 A ((1 - u) • A + u • B) C x + (fun h => hDneA h.symm) distinctAC hDneC + let D : Real × Real := (1-u) • A + u • B + change (convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({B, C} : Set (Real × Real)) = + convexHull Real ({C} : Set (Real × Real))) + ext x + constructor + · rintro ⟨hxL, hxBC⟩ + obtain ⟨l, m, t, hl, hm, ht, hsumL, hvecL⟩ := (hleftHull x).1 hxL + rw [convexHull_pair] at hxBC + obtain ⟨b, c, hb, hc, hsumBC, hvecBC⟩ := hxBC + have hLold : (l+(1-u)*m) • A + (u*m) • B + t • C = x := by + calc + (l+(1-u)*m) • A + (u*m) • B + t • C = l • A + m • D + t • C := by + simp only [D, smul_add, smul_smul] + module + _ = x := hvecL + have hsumOld : l+(1-u)*m + u*m+t=1 := by nlinarith [hsumL] + have hpoint : (l+(1-u)*m) • A + (u*m) • B + t • C = + (0:Real) • A + b • B + c • C := by + calc + (l+(1-u)*m) • A + (u*m) • B + t • C = x := hLold + _ = (0:Real) • A + b • B + c • C := by simpa using hvecBC.symm + have huniq := affineUnique (l+(1-u)*m) (u*m) t 0 b c hsumOld + (by simpa using hsumBC) hpoint + have hm0 : m = 0 := by + have hprod : 0 ≤ (1-u)*m := mul_nonneg h1u_nonneg hm + nlinarith [huniq.1] + have hl0 : l = 0 := by nlinarith [huniq.1, hm0] + have ht1 : t = 1 := by nlinarith [hsumL, hl0, hm0] + have hxC : x = C := by + rw [← hLold, hl0, hm0, ht1] + simp + simp [hxC] + · intro hxC + have hxEq : x = C := by simpa using hxC + subst x + constructor + · exact subset_convexHull _ _ (by simp) + · exact subset_convexHull _ _ (by simp) + +private theorem leftA (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) : + convexHull Real ({A, (D A B u), C} : Set (Real × Real)) ∩ + convexHull Real ({A} : Set (Real × Real)) = convexHull Real ({A} : Set (Real × Real)) := by + classical + let D : Real × Real := (1-u) • A + u • B + change (convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({A} : Set (Real × Real)) = convexHull Real ({A} : Set (Real × Real))) + ext x + constructor + · exact And.right + · intro hx + have hxA : x = A := by simpa using hx + subst x + exact ⟨(subset_convexHull Real ({A,D,C} : Set (Real × Real))) (by simp), by simp⟩ + +private theorem rightA (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) (hu : 0 < + u ∧ u < 1) (hn : P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : convexHull Real ({(D A B u), + B, C} : Set (Real × Real)) ∩ + convexHull Real ({A} : Set (Real × Real)) = ∅ := by + classical + have distinctAC : A ≠ C := distinctAC A B C hn + let D : Real × Real := (1-u) • A + u • B + have hrightAC : + convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({A, C} : Set (Real × Real)) = + convexHull Real ({C} : Set (Real × Real)) := hrightAC A B C u hu hn + change (convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({A} : Set (Real × Real)) = ∅) + ext x + constructor + · rintro ⟨hxR, hxA⟩ + have hsub : convexHull Real ({A} : Set (Real × Real)) ⊆ + convexHull Real ({A, C} : Set (Real × Real)) := by + apply convexHull_mono + intro z hz + simp only [Set.mem_singleton_iff] at hz + subst z + simp + have hC : x ∈ convexHull Real ({C} : Set (Real × Real)) := by + have := hrightAC ▸ (show x ∈ convexHull Real ({D,B,C} : Set (Real × Real)) ∩ + convexHull Real ({A,C} : Set (Real × Real)) from ⟨hxR, hsub hxA⟩) + exact this + have hxEqC : x = C := by simpa using hC + have hxEqA : x = A := by simpa using hxA + exact False.elim (distinctAC (hxEqA.symm.trans hxEqC)) + · simp + +private theorem leftB (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) (hu : 0 < + u ∧ u < 1) (hn : P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : convexHull Real ({A, (D A B + u), C} : Set (Real × Real)) ∩ + convexHull Real ({B} : Set (Real × Real)) = ∅ := by + classical + have distinctBC : B ≠ C := distinctBC A B C hn + let D : Real × Real := (1-u) • A + u • B + have hleftBC : + convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({B, C} : Set (Real × Real)) = + convexHull Real ({C} : Set (Real × Real)) := hleftBC A B C u hu hn + change (convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({B} : Set (Real × Real)) = ∅) + ext x + constructor + · rintro ⟨hxL, hxB⟩ + have hsub : convexHull Real ({B} : Set (Real × Real)) ⊆ + convexHull Real ({B, C} : Set (Real × Real)) := by + apply convexHull_mono + intro z hz + simp only [Set.mem_singleton_iff] at hz + subst z + simp + have hC : x ∈ convexHull Real ({C} : Set (Real × Real)) := by + have := hleftBC ▸ (show x ∈ convexHull Real ({A,D,C} : Set (Real × Real)) ∩ + convexHull Real ({B,C} : Set (Real × Real)) from ⟨hxL, hsub hxB⟩) + exact this + have hxEqC : x = C := by simpa using hC + have hxEqB : x = B := by simpa using hxB + exact False.elim (distinctBC (hxEqB.symm.trans hxEqC)) + · simp + +private theorem rightB (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) : + convexHull Real ({(D A B u), B, C} : Set (Real × Real)) ∩ + convexHull Real ({B} : Set (Real × Real)) = convexHull Real ({B} : Set (Real × Real)) := by + classical + let D : Real × Real := (1-u) • A + u • B + change (convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({B} : Set (Real × Real)) = convexHull Real ({B} : Set (Real × Real))) + ext x + constructor + · exact And.right + · intro hx + have hxB : x = B := by simpa using hx + subst x + exact ⟨(subset_convexHull Real ({D,B,C} : Set (Real × Real))) (by simp), by simp⟩ + +private theorem leftC (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) : + convexHull Real ({A, (D A B u), C} : Set (Real × Real)) ∩ + convexHull Real ({C} : Set (Real × Real)) = convexHull Real ({C} : Set (Real × Real)) := by + classical + let D : Real × Real := (1-u) • A + u • B + change (convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({C} : Set (Real × Real)) = convexHull Real ({C} : Set (Real × Real))) + ext x + constructor + · exact And.right + · intro hx + have hxC : x = C := by simpa using hx + subst x + exact ⟨(subset_convexHull Real ({A,D,C} : Set (Real × Real))) (by simp), by simp⟩ + +private theorem rightC (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) : + convexHull Real ({(D A B u), B, C} : Set (Real × Real)) ∩ + convexHull Real ({C} : Set (Real × Real)) = convexHull Real ({C} : Set (Real × Real)) := by + classical + let D : Real × Real := (1-u) • A + u • B + change (convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({C} : Set (Real × Real)) = convexHull Real ({C} : Set (Real × Real))) + ext x + constructor + · exact And.right + · intro hx + have hxC : x = C := by simpa using hx + subst x + exact ⟨(subset_convexHull Real ({D,B,C} : Set (Real × Real))) (by simp), by simp⟩ + +private theorem hACinterAC (A : Real × Real) (C : Real × Real) : ({A,C} : Set (Real × Real)) ∩ + {A,C} = {A,C} := by + classical + exact Set.inter_self _ + +private theorem hBCinterBC (B : Real × Real) (C : Real × Real) : ({B,C} : Set (Real × Real)) ∩ + {B,C} = {B,C} := by + classical + exact Set.inter_self _ + +private theorem hACinterBC (A : Real × Real) (B : Real × Real) (C : Real × Real) (hn : + P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : ({A,C} : Set (Real × Real)) ∩ {B,C} = {C} := by + classical + have distinctAB : A ≠ B := distinctAB A B C hn + have distinctAC : A ≠ C := distinctAC A B C hn + have distinctBC : B ≠ C := distinctBC A B C hn + ext z + simp only [Set.mem_inter_iff, Set.mem_insert_iff, Set.mem_singleton_iff] + constructor + · rintro ⟨hzA | hzC, hzB | hzC'⟩ + · exact False.elim (distinctAB (hzA.symm.trans hzB)) + · exact False.elim (distinctAC (hzA.symm.trans hzC')) + · exact False.elim (distinctBC (hzB.symm.trans hzC)) + · exact hzC + · intro hz + subst z + exact ⟨Or.inr rfl, Or.inr rfl⟩ + +private theorem hBCinterAC (A : Real × Real) (B : Real × Real) (C : Real × Real) (hn : + P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : ({B,C} : Set (Real × Real)) ∩ {A,C} = {C} := by + classical + have distinctAB : A ≠ B := distinctAB A B C hn + have distinctAC : A ≠ C := distinctAC A B C hn + have distinctBC : B ≠ C := distinctBC A B C hn + ext z + simp only [Set.mem_inter_iff, Set.mem_insert_iff, Set.mem_singleton_iff] + constructor + · rintro ⟨hzB | hzC, hzA | hzC'⟩ + · exact False.elim (distinctAB (hzA.symm.trans hzB)) + · exact False.elim (distinctBC (hzB.symm.trans hzC')) + · exact False.elim (distinctAC (hzA.symm.trans hzC)) + · exact hzC + · intro hz + subst z + exact ⟨Or.inr rfl, Or.inr rfl⟩ + +private theorem hAinterAC (A : Real × Real) (B : Real × Real) (C : Real × Real) (hn : + P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : ({A} : Set (Real × Real)) ∩ {A,C} = {A} := by + classical + have distinctAC : A ≠ C := distinctAC A B C hn + ext z + simp [distinctAC] + +private theorem hAinterBC (A : Real × Real) (B : Real × Real) (C : Real × Real) (hn : + P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : ({A} : Set (Real × Real)) ∩ {B,C} = ∅ := by + classical + have distinctAB : A ≠ B := distinctAB A B C hn + have distinctAC : A ≠ C := distinctAC A B C hn + ext z + simp [distinctAB, distinctAC] + +private theorem hBinterAC (A : Real × Real) (B : Real × Real) (C : Real × Real) (hn : + P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : ({B} : Set (Real × Real)) ∩ {A,C} = ∅ := by + classical + have distinctAB : A ≠ B := distinctAB A B C hn + have distinctBC : B ≠ C := distinctBC A B C hn + ext z + simp only [Set.mem_inter_iff, Set.mem_singleton_iff, Set.mem_insert_iff, + Set.mem_empty_iff_false] + constructor + · rintro ⟨rfl, hzA | hzC⟩ + · exact False.elim (distinctAB hzA.symm) + · exact False.elim (distinctBC hzC) + · intro h + exact False.elim h + +private theorem hBinterBC (A : Real × Real) (B : Real × Real) (C : Real × Real) (hn : + P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : ({B} : Set (Real × Real)) ∩ {B,C} = {B} := by + classical + have distinctBC : B ≠ C := distinctBC A B C hn + ext z + simp [distinctBC] + +private theorem hCinterAC (A : Real × Real) (C : Real × Real) : ({C} : Set (Real × Real)) ∩ {A,C} + = {C} := by + classical + ext z + simp [] + +private theorem hCinterBC (B : Real × Real) (C : Real × Real) : ({C} : Set (Real × Real)) ∩ {B,C} + = {C} := by + classical + ext z + simp [] + +private theorem hfaces (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) (hu : 0 < + u ∧ u < 1) (hn : P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : ∀ J : Set (Real × Real), J ⊆ + {A, B, C} → + ¬(A ∈ J ∧ B ∈ J) → + convexHull Real ({A, (D A B u), C} : Set (Real × Real)) ∩ convexHull Real J = + convexHull Real (J ∩ {A, C}) ∧ + convexHull Real ({(D A B u), B, C} : Set (Real × Real)) ∩ convexHull Real J = + convexHull Real (J ∩ {B, C}) := by + classical + let D : Real × Real := (1-u) • A + u • B + have hleftAC : + convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({A, C} : Set (Real × Real)) = + convexHull Real ({A, C} : Set (Real × Real)) := hleftAC A B C u + have hrightBC : + convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({B, C} : Set (Real × Real)) = + convexHull Real ({B, C} : Set (Real × Real)) := hrightBC A B C u + have hrightAC : + convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({A, C} : Set (Real × Real)) = + convexHull Real ({C} : Set (Real × Real)) := hrightAC A B C u hu hn + have hleftBC : + convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({B, C} : Set (Real × Real)) = + convexHull Real ({C} : Set (Real × Real)) := hleftBC A B C u hu hn + have leftA : convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({A} : Set (Real × Real)) = convexHull Real ({A} : Set (Real × Real)) := + leftA A B C u + have rightA : convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({A} : Set (Real × Real)) = ∅ := rightA A B C u hu hn + have leftB : convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({B} : Set (Real × Real)) = ∅ := leftB A B C u hu hn + have rightB : convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({B} : Set (Real × Real)) = convexHull Real ({B} : Set (Real × Real)) := + rightB A B C u + have leftC : convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({C} : Set (Real × Real)) = convexHull Real ({C} : Set (Real × Real)) := + leftC A B C u + have rightC : convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({C} : Set (Real × Real)) = convexHull Real ({C} : Set (Real × Real)) := + rightC A B C u + have hACinterAC : ({A,C} : Set (Real × Real)) ∩ {A,C} = {A,C} := hACinterAC A C + have hBCinterBC : ({B,C} : Set (Real × Real)) ∩ {B,C} = {B,C} := hBCinterBC B C + have hACinterBC : ({A,C} : Set (Real × Real)) ∩ {B,C} = {C} := hACinterBC A B C hn + have hBCinterAC : ({B,C} : Set (Real × Real)) ∩ {A,C} = {C} := hBCinterAC A B C hn + have hAinterAC : ({A} : Set (Real × Real)) ∩ {A,C} = {A} := hAinterAC A B C hn + have hAinterBC : ({A} : Set (Real × Real)) ∩ {B,C} = ∅ := hAinterBC A B C hn + have hBinterAC : ({B} : Set (Real × Real)) ∩ {A,C} = ∅ := hBinterAC A B C hn + have hBinterBC : ({B} : Set (Real × Real)) ∩ {B,C} = {B} := hBinterBC A B C hn + have hCinterAC : ({C} : Set (Real × Real)) ∩ {A,C} = {C} := hCinterAC A C + have hCinterBC : ({C} : Set (Real × Real)) ∩ {B,C} = {C} := hCinterBC B C + change (∀ J : Set (Real × Real), J ⊆ {A, B, C} → + ¬(A ∈ J ∧ B ∈ J) → + convexHull Real ({A, D, C} : Set (Real × Real)) ∩ convexHull Real J = + convexHull Real (J ∩ {A, C}) ∧ + convexHull Real ({D, B, C} : Set (Real × Real)) ∩ convexHull Real J = + convexHull Real (J ∩ {B, C})) + intro J hJ hnot + by_cases hA : A ∈ J + · by_cases hB : B ∈ J + · exact False.elim (hnot ⟨hA, hB⟩) + · by_cases hC : C ∈ J + · have hJAC : J = ({A, C} : Set (Real × Real)) := by + ext z + constructor + · intro hz + have hz' := hJ hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz' ⊢ + rcases hz' with hzA | hzB | hzC + · exact Or.inl hzA + · subst z; exact False.elim (hB hz) + · exact Or.inr hzC + · intro hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with hzA | hzC + · subst z; exact hA + · subst z; exact hC + rw [hJAC] + constructor + · rw [hACinterAC] + exact hleftAC + · rw [hACinterBC] + exact hrightAC + · have hJA : J = ({A} : Set (Real × Real)) := by + ext z + constructor + · intro hz + have hz' := hJ hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz' ⊢ + rcases hz' with hzA | hzB | hzC + · exact hzA + · subst z; exact False.elim (hB hz) + · subst z; exact False.elim (hC hz) + · intro hz + simp only [Set.mem_singleton_iff] at hz + subst z; exact hA + rw [hJA] + constructor + · rw [hAinterAC] + exact leftA + · rw [hAinterBC] + simpa only [convexHull_empty] using rightA + · by_cases hB : B ∈ J + · by_cases hC : C ∈ J + · have hJBC : J = ({B, C} : Set (Real × Real)) := by + ext z + constructor + · intro hz + have hz' := hJ hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz' ⊢ + rcases hz' with hzA | hzB | hzC + · subst z; exact False.elim (hA hz) + · exact Or.inl hzB + · exact Or.inr hzC + · intro hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with hzB | hzC + · subst z; exact hB + · subst z; exact hC + rw [hJBC] + constructor + · rw [hBCinterAC] + exact hleftBC + · rw [hBCinterBC] + exact hrightBC + · have hJB : J = ({B} : Set (Real × Real)) := by + ext z + constructor + · intro hz + have hz' := hJ hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz' ⊢ + rcases hz' with hzA | hzB | hzC + · subst z; exact False.elim (hA hz) + · exact hzB + · subst z; exact False.elim (hC hz) + · intro hz + simp only [Set.mem_singleton_iff] at hz + subst z; exact hB + rw [hJB] + constructor + · rw [hBinterAC] + simpa only [convexHull_empty] using leftB + · rw [hBinterBC] + exact rightB + · by_cases hC : C ∈ J + · have hJC : J = ({C} : Set (Real × Real)) := by + ext z + constructor + · intro hz + have hz' := hJ hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz' ⊢ + rcases hz' with hzA | hzB | hzC + · subst z; exact False.elim (hA hz) + · subst z; exact False.elim (hB hz) + · exact hzC + · intro hz + simp only [Set.mem_singleton_iff] at hz + subst z; exact hC + rw [hJC] + constructor + · rw [hCinterAC] + exact leftC + · rw [hCinterBC] + exact rightC + · have hJ0 : J = ∅ := by + ext z + constructor + · intro hz + have hz' := hJ hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz' + rcases hz' with hzA | hzB | hzC + · subst z; exact False.elim (hA hz) + · subst z; exact False.elim (hB hz) + · subst z; exact False.elim (hC hz) + · simp + rw [hJ0] + simp + +end TwoTriangleSplit + +theorem P3523T1TwoTriangleSplit (A B C : Real × Real) (u : Real) + (hu : 0 < u ∧ u < 1) + (hn : P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : + let D := (1 - u) • A + u • B + convexHull Real ({A, B, C} : Set (Real × Real)) = + convexHull Real ({A, D, C} : Set (Real × Real)) ∪ + convexHull Real ({D, B, C} : Set (Real × Real)) ∧ + convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({D, B, C} : Set (Real × Real)) = segment Real D C ∧ + (∀ J : Set (Real × Real), J ⊆ {A, B, C} → ¬ (A ∈ J ∧ B ∈ J) → + convexHull Real ({A, D, C} : Set (Real × Real)) ∩ convexHull Real J = + convexHull Real (J ∩ {A, C}) ∧ + convexHull Real ({D, B, C} : Set (Real × Real)) ∩ convexHull Real J = + convexHull Real (J ∩ {B, C})) := by +-- BODY + classical + have hu_nonneg : 0 ≤ u := TwoTriangleSplit.hu_nonneg u hu + have h1u_nonneg : 0 ≤ 1-u := TwoTriangleSplit.h1u_nonneg u hu + let d : Real := (B.1 - A.1) * (C.2 - A.2) - (C.1 - A.1) * (B.2 - A.2) + have hd : d ≠ 0 := TwoTriangleSplit.hd A B C hn + have distinctAB : A ≠ B := TwoTriangleSplit.distinctAB A B C hn + have distinctAC : A ≠ C := TwoTriangleSplit.distinctAC A B C hn + have distinctBC : B ≠ C := TwoTriangleSplit.distinctBC A B C hn + have hull3 (P Q R x : Real × Real) (hPQ : P ≠ Q) (hPR : P ≠ R) + (hQR : Q ≠ R) : + x ∈ convexHull Real ({P, Q, R} : Set (Real × Real)) ↔ + ∃ a b c : Real, 0 ≤ a ∧ 0 ≤ b ∧ 0 ≤ c ∧ a + b + c = 1 ∧ + a • P + b • Q + c • R = x := TwoTriangleSplit.hull3 P Q R x hPQ hPR hQR + have affineUnique (a b c a' b' c' : Real) + (hs : a + b + c = 1) (hs' : a' + b' + c' = 1) + (he : a • A + b • B + c • C = a' • A + b' • B + c' • C) : + a = a' ∧ b = b' ∧ c = c' := TwoTriangleSplit.affineUnique A B C hn a b c a' b' c' hs hs' he + have hDneA : (1 - u) • A + u • B ≠ A := TwoTriangleSplit.hDneA A B C u hu hn + have hDneB : (1 - u) • A + u • B ≠ B := TwoTriangleSplit.hDneB A B C u hu hn + have hDneC : (1 - u) • A + u • B ≠ C := TwoTriangleSplit.hDneC A B C u hn + have hleftHull (x : Real × Real) := hull3 A ((1 - u) • A + u • B) C x + (fun h => hDneA h.symm) distinctAC hDneC + have hrightHull (x : Real × Real) := hull3 ((1 - u) • A + u • B) B C + x hDneB hDneC distinctBC + have holdHull (x : Real × Real) := hull3 A B C x distinctAB distinctAC distinctBC + have coeffSplit (a b c : Real) (ha : 0 ≤ a) (hb : 0 ≤ b) (hc : 0 ≤ c) + (hsum : a + b + c = 1) : + (∃ l m t : Real, 0 ≤ l ∧ 0 ≤ m ∧ 0 ≤ t ∧ l + m + t = 1 ∧ + a = l + (1-u)*m ∧ b = u*m ∧ c = t) ∨ + (∃ m r t : Real, 0 ≤ m ∧ 0 ≤ r ∧ 0 ≤ t ∧ m + r + t = 1 ∧ + a = (1-u)*m ∧ b = u*m+r ∧ c = t) := TwoTriangleSplit.coeffSplit u hu a b c ha hb hc hsum + let D : Real × Real := (1-u) • A + u • B + have hcoverage : convexHull Real ({A, B, C} : Set (Real × Real)) = + convexHull Real ({A, D, C} : Set (Real × Real)) ∪ + convexHull Real ({D, B, C} : Set (Real × Real)) := TwoTriangleSplit.hcoverage A B C u hu hn + change (convexHull Real ({A, B, C} : Set (Real × Real)) = + convexHull Real ({A, D, C} : Set (Real × Real)) ∪ + convexHull Real ({D, B, C} : Set (Real × Real))) ∧ _ ∧ _ + have hdiag : + convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({D, B, C} : Set (Real × Real)) = segment Real D C := + TwoTriangleSplit.hdiag A B C u hu hn + have pairACsubL : convexHull Real ({A, C} : Set (Real × Real)) ⊆ + convexHull Real ({A, D, C} : Set (Real × Real)) := TwoTriangleSplit.pairACsubL A B C u + have pairBCsubR : convexHull Real ({B, C} : Set (Real × Real)) ⊆ + convexHull Real ({D, B, C} : Set (Real × Real)) := TwoTriangleSplit.pairBCsubR A B C u + have hleftAC : + convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({A, C} : Set (Real × Real)) = + convexHull Real ({A, C} : Set (Real × Real)) := TwoTriangleSplit.hleftAC A B C u + have hrightBC : + convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({B, C} : Set (Real × Real)) = + convexHull Real ({B, C} : Set (Real × Real)) := TwoTriangleSplit.hrightBC A B C u + have hrightAC : + convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({A, C} : Set (Real × Real)) = + convexHull Real ({C} : Set (Real × Real)) := TwoTriangleSplit.hrightAC A B C u hu hn + have hleftBC : + convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({B, C} : Set (Real × Real)) = + convexHull Real ({C} : Set (Real × Real)) := TwoTriangleSplit.hleftBC A B C u hu hn + have leftA : convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({A} : Set (Real × Real)) = convexHull Real ({A} : Set (Real × Real)) := + TwoTriangleSplit.leftA A B C u + have rightA : convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({A} : Set (Real × Real)) = ∅ := TwoTriangleSplit.rightA A B C u hu hn + have leftB : convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({B} : Set (Real × Real)) = ∅ := TwoTriangleSplit.leftB A B C u hu hn + have rightB : convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({B} : Set (Real × Real)) = convexHull Real ({B} : Set (Real × Real)) := + TwoTriangleSplit.rightB A B C u + have leftC : convexHull Real ({A, D, C} : Set (Real × Real)) ∩ + convexHull Real ({C} : Set (Real × Real)) = convexHull Real ({C} : Set (Real × Real)) := + TwoTriangleSplit.leftC A B C u + have rightC : convexHull Real ({D, B, C} : Set (Real × Real)) ∩ + convexHull Real ({C} : Set (Real × Real)) = convexHull Real ({C} : Set (Real × Real)) := + TwoTriangleSplit.rightC A B C u + have hACinterAC : ({A,C} : Set (Real × Real)) ∩ {A,C} = {A,C} := TwoTriangleSplit.hACinterAC A C + have hBCinterBC : ({B,C} : Set (Real × Real)) ∩ {B,C} = {B,C} := TwoTriangleSplit.hBCinterBC B C + have hACinterBC : ({A,C} : Set (Real × Real)) ∩ {B,C} = {C} := TwoTriangleSplit.hACinterBC A B + C hn + have hBCinterAC : ({B,C} : Set (Real × Real)) ∩ {A,C} = {C} := TwoTriangleSplit.hBCinterAC A B + C hn + have hAinterAC : ({A} : Set (Real × Real)) ∩ {A,C} = {A} := TwoTriangleSplit.hAinterAC A B C hn + have hAinterBC : ({A} : Set (Real × Real)) ∩ {B,C} = ∅ := TwoTriangleSplit.hAinterBC A B C hn + have hBinterAC : ({B} : Set (Real × Real)) ∩ {A,C} = ∅ := TwoTriangleSplit.hBinterAC A B C hn + have hBinterBC : ({B} : Set (Real × Real)) ∩ {B,C} = {B} := TwoTriangleSplit.hBinterBC A B C hn + have hCinterAC : ({C} : Set (Real × Real)) ∩ {A,C} = {C} := TwoTriangleSplit.hCinterAC A C + have hCinterBC : ({C} : Set (Real × Real)) ∩ {B,C} = {C} := TwoTriangleSplit.hCinterBC B C + have hfaces : ∀ J : Set (Real × Real), J ⊆ {A, B, C} → + ¬(A ∈ J ∧ B ∈ J) → + convexHull Real ({A, D, C} : Set (Real × Real)) ∩ convexHull Real J = + convexHull Real (J ∩ {A, C}) ∧ + convexHull Real ({D, B, C} : Set (Real × Real)) ∩ convexHull Real J = + convexHull Real (J ∩ {B, C}) := TwoTriangleSplit.hfaces A B C u hu hn + exact ⟨hcoverage, hdiag, hfaces⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1BoundaryCarrier.lean b/LeanPool/ApollonianSuperharmonic/P3544T1BoundaryCarrier.lean new file mode 100644 index 0000000000..f216d4f398 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3544T1BoundaryCarrier.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary + +-- [TABLET NODE: P3544T1BoundaryCarrier] + +/-! +# P3544T1BoundaryCarrier + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For every integer $n\ge0$ and every +$p\in\operatorname{PolygonBoundary}(n)$ as defined in +`P3381T1PolygonBoundary`, write $p_i$ for the vertex at index +$i\in\operatorname{Fin}(n+3)=\{0,\ldots,n+2\}$. Here $i+1$ denotes +the cyclic successor modulo $n+3$. The geometric carrier of $p$ is +$$ + C_p:=\bigcup_{i\in\operatorname{Fin}(n+3)}[p_i,p_{i+1}] + \subseteq\mathbb R^2, +$$ +where each $[p_i,p_{i+1}]$ is the closed real line segment between its +endpoints. All indexed vertices, including straight vertices, are +retained. This carrier is not a filled region; no interior region or +disk model is supplied. +-/ +def P3544T1BoundaryCarrier {n : Nat} (p : P3381T1PolygonBoundary n) : + Set (Real × Real) := +-- BODY + ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSelection.lean b/LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSelection.lean new file mode 100644 index 0000000000..f7ed176504 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSelection.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3544T1DiagonalSplit +public import LeanPool.ApollonianSuperharmonic.P3650T1ExposedCorner +public import LeanPool.ApollonianSuperharmonic.P3650T1VisibleDiagonal +public import LeanPool.ApollonianSuperharmonic.P3650T1CyclicChildren +public import LeanPool.ApollonianSuperharmonic.P3650T1ExposedCornerExists +public import LeanPool.ApollonianSuperharmonic.P3650T1TriangleEntry +public import LeanPool.ApollonianSuperharmonic.P3650T1EmptyTriangleDiagonal +public import LeanPool.ApollonianSuperharmonic.P3650T1MaximalHeightDiagonal +public import LeanPool.ApollonianSuperharmonic.P3650T1CyclicChildrenExists +public import LeanPool.ApollonianSuperharmonic.P3650T1ParitySum +public import LeanPool.ApollonianSuperharmonic.P3650T1OldArcEven +public import LeanPool.ApollonianSuperharmonic.P3650T1LocalCoherence + +-- [TABLET NODE: P3544T1DiagonalSelection] + +/-! +# P3544T1DiagonalSelection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3544T1DiagonalSelection {n : Nat} (p : P3381T1PolygonBoundary n) + (hn : 0 < n) : Nonempty (P3544T1DiagonalSplit p) := by +-- BODY + classical + obtain ⟨E⟩ := P3650T1ExposedCornerExists p + have hentry := P3650T1TriangleEntry p E + have hvisible : Nonempty (P3650T1VisibleDiagonal p E) := by + by_cases hempty : ∀ i, p.vertex i ∈ convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : + Set (Real × Real)) → i = E.b - 1 ∨ i = E.b ∨ i = E.b + 1 + · obtain ⟨D, _, _⟩ := P3650T1EmptyTriangleDiagonal p hn E hentry hempty + exact ⟨D⟩ + · obtain ⟨D, _, _, _⟩ := P3650T1MaximalHeightDiagonal p E hentry hempty + exact ⟨D⟩ + obtain ⟨D⟩ := hvisible + obtain ⟨C⟩ := P3650T1CyclicChildrenExists p D.a D.b + D.distinct D.not_next D.not_previous D.clear + have hsum := (P3650T1ParitySum p D.a D.b C).2 + obtain ⟨hleft, hright⟩ := P3650T1OldArcEven p E D C + obtain ⟨hsides, hendpoints⟩ := P3650T1LocalCoherence p D.a D.b D.distinct C + D.odd hleft hright hsum + exact ⟨{ + left_n := C.left_n + right_n := C.right_n + left_lt := C.left_lt + right_lt := C.right_lt + left := C.left + right := C.right + il := C.il + ir := C.ir + il_injective := C.il_injective + ir_injective := C.ir_injective + left_vertex := C.left_vertex + right_vertex := C.right_vertex + a := D.a + b := D.b + a_ne_b := D.distinct + u := C.u + v := C.v + hu := C.hu + hv := C.hv + rotation := C.rotation + parent_order := C.parent_order + left_order := C.left_order + right_order := C.right_order + common_indices := C.common_indices + carrier_union := C.carrier_union + carrier_intersection := C.carrier_intersection + diagonal_odd := D.odd + left_arc_even := hleft + right_arc_even := hright + parity_sum := hsum + diagonal_sides := hsides + endpoint_coherence := hendpoints }⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSplit.lean b/LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSplit.lean new file mode 100644 index 0000000000..398ac2f7ec --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSplit.lean @@ -0,0 +1,128 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity + +-- [TABLET NODE: P3544T1DiagonalSplit] + +/-! +# P3544T1DiagonalSplit + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $p$ with $n+3$ vertices, this data consists of two integers +$n_L,n_R i)).rotate rotation = + a :: (u ++ b :: v) + left_order : List.ofFn il = a :: (u ++ [b]) + right_order : List.ofFn ir = b :: (v ++ [a]) + common_indices : Set.range il ∩ Set.range ir = {a, b} + carrier_union : P3544T1BoundaryCarrier left ∪ P3544T1BoundaryCarrier right = + P3544T1BoundaryCarrier p ∪ segment Real (p.vertex a) (p.vertex b) + carrier_intersection : P3544T1BoundaryCarrier left ∩ + P3544T1BoundaryCarrier right = segment Real (p.vertex a) (p.vertex b) + diagonal_odd : openSegment Real (p.vertex a) (p.vertex b) ⊆ P3544T1RayParity p + left_arc_even : Disjoint + (P3544T1BoundaryCarrier left \ segment Real (p.vertex a) (p.vertex b)) + (P3544T1RayParity right) + right_arc_even : Disjoint + (P3544T1BoundaryCarrier right \ segment Real (p.vertex a) (p.vertex b)) + (P3544T1RayParity left) + parity_sum : ∀ x, x ∉ P3544T1BoundaryCarrier left → + x ∉ P3544T1BoundaryCarrier right → + (x ∈ P3544T1RayParity p ↔ + (x ∈ P3544T1RayParity left ∧ x ∉ P3544T1RayParity right) ∨ + (x ∉ P3544T1RayParity left ∧ x ∈ P3544T1RayParity right)) + diagonal_sides : ∀ x, x ∈ openSegment Real (p.vertex a) (p.vertex b) → + ∃ r : Real, 0 < r ∧ ∃ s : Bool, ∀ y ∈ Metric.ball x r, + (y ∈ P3544T1RayParity left ↔ + if s then 0 < P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] + else P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] < 0) ∧ + (y ∈ P3544T1RayParity right ↔ + if s then P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] < 0 + else 0 < P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y]) + endpoint_coherence : ∀ z ∈ ({p.vertex a, p.vertex b} : Set (Real × Real)), + ∃ r : Real, 0 < r ∧ + Metric.ball z r ∩ P3544T1RayParity p = + Metric.ball z r ∩ (P3544T1RayParity left ∪ P3544T1RayParity right ∪ + openSegment Real (p.vertex a) (p.vertex b)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1IndexedGluing.lean b/LeanPool/ApollonianSuperharmonic/P3544T1IndexedGluing.lean new file mode 100644 index 0000000000..ef9261c9b6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3544T1IndexedGluing.lean @@ -0,0 +1,128 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3544T1DiagonalSplit +public import LeanPool.ApollonianSuperharmonic.P3511T1SourceDissection +public import LeanPool.ApollonianSuperharmonic.P3652T1ChildFillSeparation +public import LeanPool.ApollonianSuperharmonic.P3652T1ParentOddGluing +public import LeanPool.ApollonianSuperharmonic.P3652T1DiagonalFaceIntersections +public import LeanPool.ApollonianSuperharmonic.P3652T1IndexedFaceLedger + +-- [TABLET NODE: P3544T1IndexedGluing] + +/-! +# P3544T1IndexedGluing + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3544T1IndexedGluing {n : Nat} {p : P3381T1PolygonBoundary n} + (S : P3544T1DiagonalSplit p) {XL XR : Set (Real × Real)} + (L : P3511T1SourceDissection S.left XL) + (R : P3511T1SourceDissection S.right XR) + (hL : XL = P3544T1RayParity S.left ∪ P3544T1BoundaryCarrier S.left) + (hR : XR = P3544T1RayParity S.right ∪ P3544T1BoundaryCarrier S.right) + (hcL : IsPathConnected (P3544T1RayParity S.left)) + (hcR : IsPathConnected (P3544T1RayParity S.right)) : + ∃ Z : P3511T1SourceDissection p (XL ∪ XR), + List.ofFn Z.face = List.ofFn (fun k => S.il ∘ L.face k) ++ + List.ofFn (fun k => S.ir ∘ R.face k) ∧ + XL ∪ XR = P3544T1RayParity p ∪ P3544T1BoundaryCarrier p ∧ + IsPathConnected (P3544T1RayParity p) := by +-- BODY + classical + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + obtain ⟨hlist, hdissection, hinjective, hdistinct, hused, hnondegenerate, hedge, _, _⟩ := + P3652T1IndexedFaceLedger S L R + have hsep := P3652T1ChildFillSeparation S hL hR hcL hcR + obtain ⟨_, hfill, hconnected⟩ := P3652T1ParentOddGluing S hL hR hcL hcR hsep + have hcross := P3652T1DiagonalFaceIntersections S L R hsep + have hwithin {m : Nat} (q : P3381T1PolygonBoundary m) + {X : Set (Real × Real)} (D : P3511T1SourceDissection q X) + (e : Fin (m + 3) → Fin (n + 3)) (he : Function.Injective e) + (hq : q.vertex = p.vertex ∘ e) (k l : Fin D.count) : + convexHull Real (Set.range (p.vertex ∘ (e ∘ D.face k))) ∩ + convexHull Real (Set.range (p.vertex ∘ (e ∘ D.face l))) = + convexHull Real (p.vertex '' + (Set.range (e ∘ D.face k) ∩ Set.range (e ∘ D.face l))) := by + have hv (i : Fin D.count) : + q.vertex ∘ D.face i = p.vertex ∘ (e ∘ D.face i) := by + rw [hq] + rfl + rw [← hv k, ← hv l, D.intersection] + congr 1 + rw [Set.range_comp, Set.range_comp, ← Set.image_inter he, Set.image_image, hq] + rfl + have hcover : XL ∪ XR = + ⋃ k, convexHull Real (Set.range (p.vertex ∘ f k)) := by + ext x + constructor + · rintro (hx | hx) + · rw [L.cover] at hx + obtain ⟨k, hk⟩ := Set.mem_iUnion.mp hx + refine Set.mem_iUnion.mpr ⟨Fin.castAdd R.count k, ?_⟩ + simpa only [f, Fin.addCases_left, ← Function.comp_assoc, ← S.left_vertex] using hk + · rw [R.cover] at hx + obtain ⟨k, hk⟩ := Set.mem_iUnion.mp hx + refine Set.mem_iUnion.mpr ⟨Fin.natAdd L.count k, ?_⟩ + simpa only [f, Fin.addCases_right, ← Function.comp_assoc, ← S.right_vertex] using hk + · intro hx + obtain ⟨k, hk⟩ := Set.mem_iUnion.mp hx + revert hk + refine Fin.addCases (fun i => ?_) (fun j => ?_) k + · intro hi + apply Or.inl + rw [L.cover] + apply Set.mem_iUnion.mpr + refine ⟨i, ?_⟩ + simpa only [f, Fin.addCases_left, ← Function.comp_assoc, ← S.left_vertex] using hi + · intro hj + apply Or.inr + rw [R.cover] + apply Set.mem_iUnion.mpr + refine ⟨j, ?_⟩ + simpa only [f, Fin.addCases_right, ← Function.comp_assoc, ← S.right_vertex] using hj + have hintersection : ∀ k l, + convexHull Real (Set.range (p.vertex ∘ f k)) ∩ + convexHull Real (Set.range (p.vertex ∘ f l)) = + convexHull Real (p.vertex '' (Set.range (f k) ∩ Set.range (f l))) := by + intro k l + refine Fin.addCases (fun i => ?_) (fun j => ?_) k + · refine Fin.addCases (fun i' => ?_) (fun j' => ?_) l + · simpa only [f, Fin.addCases_left] using + hwithin S.left L S.il S.il_injective S.left_vertex i i' + · simpa only [f, Fin.addCases_left, Fin.addCases_right] using hcross i j' + · refine Fin.addCases (fun i' => ?_) (fun j' => ?_) l + · simpa only [f, Fin.addCases_left, Fin.addCases_right, Set.inter_comm] using + hcross i' j + · simpa only [f, Fin.addCases_right] using + hwithin S.right R S.ir S.ir_injective S.right_vertex j j' + let Z : P3511T1SourceDissection p (XL ∪ XR) := + { count := L.count + R.count + count_pos := by + have hpos := L.count_pos + omega + face := f + dissection := hdissection + face_injective := hinjective + face_distinct := hdistinct + vertex_used := hused + nondegenerate := hnondegenerate + cover := hcover + intersection := hintersection + edge_count := hedge } + exact ⟨Z, hlist, hfill, hconnected⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1LocalParity.lean b/LeanPool/ApollonianSuperharmonic/P3544T1LocalParity.lean new file mode 100644 index 0000000000..3c0c8f750c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3544T1LocalParity.lean @@ -0,0 +1,182 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3544T1RayParity +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public import Mathlib.Topology.Connected.PathConnected +public import LeanPool.ApollonianSuperharmonic.P3597T1GenericRayStability +public import LeanPool.ApollonianSuperharmonic.P3597T1DirectionParity +public import LeanPool.ApollonianSuperharmonic.P3597T1SideCrossing +public import LeanPool.ApollonianSuperharmonic.P3597T1VertexSectors + +-- [TABLET NODE: P3544T1LocalParity] + +/-! +# P3544T1LocalParity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3544T1LocalParity {n : Nat} (p : P3381T1PolygonBoundary n) : + closure (P3544T1RayParity p) = + P3544T1RayParity p ∪ P3544T1BoundaryCarrier p ∧ + IsOpen (P3544T1RayParity p) ∧ + interior (P3544T1RayParity p ∪ P3544T1BoundaryCarrier p) = + P3544T1RayParity p ∧ + frontier (P3544T1RayParity p ∪ P3544T1BoundaryCarrier p) = + P3544T1BoundaryCarrier p ∧ + (∀ x, x ∉ P3544T1BoundaryCarrier p → + ∃ r : Real, 0 < r ∧ + (Metric.ball x r ⊆ P3544T1RayParity p ∨ + Disjoint (Metric.ball x r) (P3544T1RayParity p))) ∧ + (∀ x, x ∉ P3544T1BoundaryCarrier p → ∃ d : Real × Real, + (∀ i, d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ 0) ∧ + (∀ i, d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1 ≠ 0)) ∧ + (∀ x d : Real × Real, x ∉ P3544T1BoundaryCarrier p → + (∀ i, d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ 0) → + (∀ i, d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1 ≠ 0) → + (x ∈ P3544T1RayParity p ↔ + Set.ncard {i : Fin (n + 3) | ∃ t : Real, 0 < t ∧ + x + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1))} % 2 = 1)) ∧ + (∀ i, ∃ r : Real, 0 < r ∧ + IsPathConnected (Metric.ball (p.vertex i) r ∩ P3544T1RayParity p) ∧ + IsPathConnected (Metric.ball (p.vertex i) r \ + (P3544T1RayParity p ∪ P3544T1BoundaryCarrier p))) ∧ + (∀ i x, x ∈ openSegment Real (p.vertex i) (p.vertex (i + 1)) → + ∃ r : Real, 0 < r ∧ ∃ s : Bool, ∀ y ∈ Metric.ball x r, + (y ∈ P3544T1RayParity p ↔ + if s then 0 < P3381T1TriangleDeterminant + ![p.vertex i, p.vertex (i + 1), y] + else P3381T1TriangleDeterminant + ![p.vertex i, p.vertex (i + 1), y] < 0)) := by +-- BODY + classical + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + have hgeneric : ∀ x : Real × Real, x ∉ C → ∃ d : Real × Real, + (∀ i, d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ 0) ∧ + (∀ i, d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1 ≠ 0) := by + intro x hx + apply (P3597T1GenericRayStability p).1 x + intro i hi + have hv : p.vertex i ∈ C := by + exact Set.mem_iUnion.mpr ⟨i, left_mem_segment Real _ _⟩ + exact hx (hi ▸ hv) + have hparity : ∀ x d : Real × Real, x ∉ C → + (∀ i, d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ 0) → + (∀ i, d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1 ≠ 0) → + (x ∈ O ↔ Set.ncard {i : Fin (n + 3) | ∃ t : Real, 0 < t ∧ + x + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1))} % 2 = 1) := by + intro x d hx hdv hde + constructor + · rintro ⟨_, d', hdv', hde', hodd⟩ + exact (P3597T1DirectionParity p x d d' hx hdv hdv').trans hodd + · intro hodd + exact ⟨hx, d, hdv, hde, hodd⟩ + have hlocal : ∀ x : Real × Real, x ∉ C → ∃ r : Real, 0 < r ∧ + ∀ y ∈ Metric.ball x r, y ∉ C ∧ (y ∈ O ↔ x ∈ O) := by + intro x hx + obtain ⟨d, hdv, hde⟩ := hgeneric x hx + obtain ⟨r, hr, hstable⟩ := (P3597T1GenericRayStability p).2.1 x d hx hdv hde + refine ⟨r, hr, ?_⟩ + intro y hy + obtain ⟨hyC, hdy, hsides⟩ := hstable y hy + refine ⟨hyC, ?_⟩ + have hcount : Set.ncard {i : Fin (n + 3) | ∃ t : Real, 0 < t ∧ + y + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1))} % 2 = + Set.ncard {i : Fin (n + 3) | ∃ t : Real, 0 < t ∧ + x + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1))} % 2 := + congrArg (fun S : Set (Fin (n + 3)) => Set.ncard S % 2) (Set.ext hsides) + rw [hparity y d hyC hdy hde, hparity x d hx hdv hde, hcount] + have hballs : ∀ x : Real × Real, x ∉ C → ∃ r : Real, 0 < r ∧ + (Metric.ball x r ⊆ O ∨ Disjoint (Metric.ball x r) O) := by + intro x hx + obtain ⟨r, hr, hball⟩ := hlocal x hx + refine ⟨r, hr, ?_⟩ + by_cases ho : x ∈ O + · exact Or.inl (fun y hy => (hball y hy).2.mpr ho) + · exact Or.inr (Set.disjoint_left.mpr (fun y hy hyo => ho ((hball y hy).2.mp hyo))) + have hdisjoint : Disjoint O C := + Set.disjoint_left.mpr (fun _ ho hc => ho.1 hc) + have hO : IsOpen O := by + apply Metric.isOpen_iff.mpr + intro x hx + obtain ⟨r, hr, hball⟩ := hlocal x hx.1 + exact ⟨r, hr, fun y hy => (hball y hy).2.mpr hx⟩ + have hE : IsOpen (O ∪ C)ᶜ := by + apply Metric.isOpen_iff.mpr + intro x hx + obtain ⟨r, hr, hball⟩ := hlocal x (fun hc => hx (Or.inr hc)) + refine ⟨r, hr, ?_⟩ + intro y hy hmem + rcases hmem with hyo | hyc + · exact hx (Or.inl ((hball y hy).2.mp hyo)) + · exact (hball y hy).1 hyc + have hvertices : ∀ i, ∃ r : Real, 0 < r ∧ + IsPathConnected (Metric.ball (p.vertex i) r ∩ O) ∧ + IsPathConnected (Metric.ball (p.vertex i) r \ (O ∪ C)) := by + intro i + obtain ⟨r, hr, hodd, heven, _, _⟩ := P3597T1VertexSectors p i + exact ⟨r, hr, hodd, heven⟩ + have hsides : ∀ i x, x ∈ openSegment Real (p.vertex i) (p.vertex (i + 1)) → + ∃ r : Real, 0 < r ∧ ∃ s : Bool, ∀ y ∈ Metric.ball x r, + (y ∈ O ↔ if s then 0 < P3381T1TriangleDeterminant + ![p.vertex i, p.vertex (i + 1), y] + else P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i + 1), y] < 0) := by + intro i x hx + obtain ⟨r, hr, hsign, _, _⟩ := P3597T1SideCrossing p i x hx + exact ⟨r, hr, hsign⟩ + have haccumulation : ∀ x ∈ C, x ∈ closure O ∧ x ∈ closure (O ∪ C)ᶜ := by + intro x hx + obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hx + by_cases hleft : p.vertex i = x + · obtain ⟨_, _, _, _, hodd, heven⟩ := P3597T1VertexSectors p i + exact hleft ▸ ⟨hodd, heven⟩ + by_cases hright : p.vertex (i + 1) = x + · obtain ⟨_, _, _, _, hodd, heven⟩ := P3597T1VertexSectors p (i + 1) + exact hright ▸ ⟨hodd, heven⟩ + · have hopen := mem_openSegment_of_ne_left_right hleft hright hi + obtain ⟨_, _, _, hodd, heven⟩ := P3597T1SideCrossing p i x hopen + exact ⟨hodd, heven⟩ + have hodd : C ⊆ closure O := fun x hx => (haccumulation x hx).1 + have heven : C ⊆ closure (O ∪ C)ᶜ := fun x hx => (haccumulation x hx).2 + -- The boundary identities use only the local odd/even accumulation. + have hclosed : IsClosed (O ∪ C) := by + simpa only [compl_compl] using hE.isClosed_compl + have hclosure : closure O = O ∪ C := + (closure_minimal Set.subset_union_left hclosed).antisymm + (Set.union_subset subset_closure hodd) + have hinterior : interior (O ∪ C) = O := by + apply Set.Subset.antisymm _ (interior_maximal Set.subset_union_left hO) + intro x hx + rcases interior_subset hx with ho | hc + · exact ho + · have hnot : x ∉ closure (O ∪ C)ᶜ := by + simpa only [interior_eq_compl_closure_compl, Set.mem_compl_iff] using hx + exact False.elim (hnot (heven hc)) + have hfrontier : frontier (O ∪ C) = C := by + rw [frontier, hclosed.closure_eq, hinterior] + ext x + constructor + · rintro ⟨h, hn⟩ + exact h.resolve_left hn + · intro hc + exact ⟨Or.inr hc, fun ho => Set.disjoint_left.mp hdisjoint ho hc⟩ + exact ⟨hclosure, hO, hinterior, hfrontier, hballs, hgeneric, hparity, hvertices, hsides⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1RayParity.lean b/LeanPool/ApollonianSuperharmonic/P3544T1RayParity.lean new file mode 100644 index 0000000000..24d6e36bc4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3544T1RayParity.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3544T1BoundaryCarrier +public import Mathlib.Data.Set.Card + +-- [TABLET NODE: P3544T1RayParity] + +/-! +# P3544T1RayParity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $C_p$ be `P3544T1BoundaryCarrier`. A vector $d$ is generic +at $x\notin C_p$ if $\det(d,p_i-x)\ne0$ and +$\det(d,p_{i+1}-p_i)\ne0$ for every index $i$. Count those side indices +whose closed segment meets $x+td$ for some $t>0$; write this finite count +as $N_p(x,d)$. The set $O_p$ consists of the points $x\notin C_p$ for +which some generic $d$ has $N_p(x,d)$ odd. Here +$\det(u,v)=u_1v_2-u_2v_1$. The existential convention does not assume +direction independence, connectedness, diskness, or separation. +-/ +noncomputable def P3544T1RayParity {n : Nat} (p : P3381T1PolygonBoundary n) : + Set (Real × Real) := +-- BODY + {x | x ∉ P3544T1BoundaryCarrier p ∧ ∃ d : Real × Real, + (∀ i, d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ 0) ∧ + (∀ i, d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1 ≠ 0) ∧ + Set.ncard {i : Fin (n + 3) | ∃ t : Real, 0 < t ∧ + x + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1))} % 2 = 1} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean new file mode 100644 index 0000000000..13c987c28a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean @@ -0,0 +1,1806 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Analysis.Convex.PathConnected +public import Mathlib.Tactic.FieldSimp +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.FunProp +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.LinearCombination +public import Mathlib.Tactic.Module +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P3544T1TriangleRayGeometry] + +/-! +# P3544T1TriangleRayGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TriangleRayIntersections + +private theorem habAt122 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + a ≠ b ) := by + classical + intro p a b h + exact (by decide : (0 : Fin 3) ≠ 1) (p.injective h) + +private theorem hac : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let c : Real × Real := p.vertex 2 + a ≠ c ) := by + classical + intro p a c h + exact (by decide : (0 : Fin 3) ≠ 2) (p.injective h) + +private theorem hbcAt128 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + b ≠ c ) := by + classical + intro p b c h + exact (by decide : (1 : Fin 3) ≠ 2) (p.injective h) + +private theorem hu : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + (a ≠ b) → (b - a ≠ (0, 0)) ) := by + classical + intro p a b hab h + apply hab + apply Prod.ext + · have hh := congrArg Prod.fst h + simp at hh + dsimp [a, b] at hh ⊢ + linarith + · have hh := congrArg Prod.snd h + simp at hh + dsimp [a, b] at hh ⊢ + linarith + +private theorem hDne : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + (a ≠ b) → ((a ≠ c) → ((b ≠ c) → ((b - a ≠ (0, 0)) → (P3381T1TriangleDeterminant + p.vertex ≠ 0)))) ) := by + classical + intro p a b c hab hac hbc hu hD + have hdet0 : (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 = 0 := by + simpa [P3381T1TriangleDeterminant, a, b, c] using hD + have hcol : ∃ t : Real, c - a = t • (b - a) := by + by_cases hx : b.1 - a.1 = 0 + · have hy : b.2 - a.2 ≠ 0 := by + intro hy + apply hu + apply Prod.ext <;> simp [hx, hy] + change (b.1 - a.1) * (c.2 - a.2) - (c.1 - a.1) * (b.2 - a.2) = 0 at hdet0 + rw [hx] at hdet0 + have hc0 : c.1 - a.1 = 0 := by + have hm : (c.1 - a.1) * (b.2 - a.2) = 0 := by nlinarith + exact (mul_eq_zero.mp hm).resolve_right hy + refine ⟨(c - a).2 / (b - a).2, ?_⟩ + apply Prod.ext + · change c.1 - a.1 = ((c.2 - a.2) / (b.2 - a.2)) * (b.1 - a.1) + simp [hx, hc0] + · change c.2 - a.2 = ((c.2 - a.2) / (b.2 - a.2)) * (b.2 - a.2) + field_simp + · have hy : b.1 - a.1 ≠ 0 := hx + change (b.1 - a.1) * (c.2 - a.2) - (c.1 - a.1) * (b.2 - a.2) = 0 at hdet0 + refine ⟨(c - a).1 / (b - a).1, ?_⟩ + apply Prod.ext + · change c.1 - a.1 = ((c.1 - a.1) / (b.1 - a.1)) * (b.1 - a.1) + field_simp + · change c.2 - a.2 = ((c.1 - a.1) / (b.1 - a.1)) * (b.2 - a.2) + have hm : (b.1 - a.1) * (c.2 - a.2) = (c.1 - a.1) * (b.2 - a.2) := by linarith + field_simp + nlinarith + obtain ⟨t, ht⟩ := hcol + have ht0 : t ≠ 0 := by + intro ht0 + have : c - a = (0 : Real) • (b - a) := by simpa [ht0] using ht + apply hac + have := congrArg (fun z : Real × Real => z + a) this + have heq : c = a := by simpa using this + exact heq.symm + have ht1 : t ≠ 1 := by + intro ht1 + apply hbc + have : c - a = (1 : Real) • (b - a) := by simpa [ht1] using ht + have := congrArg (fun z : Real × Real => z + a) this + have heq : c = b := by simpa using this + exact heq.symm + have hcform : c = (1 - t) • a + t • b := by + have htx : c.1 - a.1 = t * (b.1 - a.1) := by + have hh := congrArg Prod.fst ht + simpa using hh + have hty : c.2 - a.2 = t * (b.2 - a.2) := by + have hh := congrArg Prod.snd ht + simpa using hh + ext <;> simp [smul_eq_mul] <;> nlinarith [htx, hty] + rcases lt_trichotomy t 0 with htneg | htzero | htpos + · have hseg : a ∈ segment Real b c := by + rw [segment_eq_image] + have hden : 0 < 1 - t := by linarith + refine ⟨1 / (1 - t), ?_, ?_⟩ + · constructor + · exact le_of_lt (div_pos (by norm_num) hden) + · rw [div_le_one hden] + linarith + · rw [hcform] + ext <;> simp [smul_eq_mul] <;> field_simp <;> ring + have hpair := p.edge_intersection 1 2 (by decide) + have hca : a ∈ segment Real c a := by + rw [segment_eq_image] + refine ⟨1, ⟨by norm_num, by norm_num⟩, ?_⟩ + simp [] + have : a ∈ segment Real b c ∩ segment Real c a := ⟨hseg, hca⟩ + have hpair' : segment Real b c ∩ segment Real c a = + {x | (x = b ∨ x = c) ∧ (x = c ∨ x = a)} := by + simpa [a, b, c] using hpair + rw [hpair'] at this + have hs := this + simp only [Set.mem_ofPred_eq] at hs + rcases hs.1 with h | h + · exact hab h + · exact hac h + · exact (ht0 htzero).elim + · rcases lt_trichotomy t 1 with htlt | hteq | htgt + · have hcs : c ∈ segment Real a b := by + rw [segment_eq_image] + refine ⟨t, ⟨le_of_lt htpos, le_of_lt htlt⟩, ?_⟩ + rw [hcform] + have hcb : c ∈ segment Real b c := by + rw [segment_eq_image] + refine ⟨1, ⟨by norm_num, by norm_num⟩, ?_⟩ + simp [] + have hpair : segment Real a b ∩ segment Real b c = + {x | (x = a ∨ x = b) ∧ (x = b ∨ x = c)} := by + simpa [a, b, c] using p.edge_intersection 0 1 (by decide) + have hi : c ∈ segment Real a b ∩ segment Real b c := ⟨hcs, hcb⟩ + rw [hpair] at hi + simp only [Set.mem_ofPred_eq] at hi + rcases hi.1 with h | h + · exact hac h.symm + · exact hbc h.symm + · exact (ht1 hteq).elim + · have hbetween : b ∈ segment Real a c := by + rw [segment_eq_image] + refine ⟨1 / t, ?_, ?_⟩ + · constructor + · exact le_of_lt (div_pos (by norm_num) htpos) + · rw [div_le_one htpos] + linarith + · rw [hcform] + ext <;> simp [smul_eq_mul] <;> field_simp <;> ring + have hpair := p.edge_intersection 0 2 (by decide) + have hpair' : segment Real a b ∩ segment Real c a = + {x | (x = a ∨ x = b) ∧ (x = c ∨ x = a)} := by + simpa [a, b, c] using hpair + have hbca : b ∈ segment Real c a := by + rw [segment_eq_image] + refine ⟨(t - 1) / t, ?_, ?_⟩ + · constructor + · exact div_nonneg (by linarith) (le_of_lt htpos) + · rw [div_le_one htpos] + linarith + · rw [hcform] + ext <;> simp [smul_eq_mul] <;> field_simp <;> ring + have habseg : b ∈ segment Real a b := by + rw [segment_eq_image] + refine ⟨1, ⟨by norm_num, by norm_num⟩, ?_⟩ + simp [] + have : b ∈ segment Real a b ∩ segment Real c a := ⟨habseg, hbca⟩ + rw [hpair'] at this + have hs := this + simp only [Set.mem_ofPred_eq] at hs + rcases hs.2 with h | h + · exact hbc h + · exact hab h.symm + +private theorem hsum : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + ∀ x, alpha x + beta x + gamma x = 1 ) := by + classical + intro p a b c D beta gamma alpha x + simp [alpha] + ring + +private theorem hrec : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + (D ≠ 0) → ( + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + ∀ x, x = alpha x • a + beta x • b + gamma x • c) ) := by + classical + intro p a b c D hDneq beta gamma alpha x + dsimp [alpha, beta, gamma] + ext <;> simp [smul_eq_mul] + · field_simp [hDneq] + simp [D] + ring + · field_simp [hDneq] + simp [D] + ring + +private theorem hbeta_affine : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + (D ≠ 0) → ( + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + ∀ x, ∀ y, ∀ s, ∀ t, s + t = 1 → beta (s • x + t • y) = s * beta x + t * beta y) ) := by + classical + intro p a b c D hDneq beta x y s t hst + have hsub : s • x + t • y - a = s • (x - a) + t • (y - a) := by + ext <;> simp [smul_eq_mul] + · linear_combination a.1 * hst + · linear_combination a.2 * hst + change (((s • x + t • y - a).1 * (c - a).2 - + (s • x + t • y - a).2 * (c - a).1) / D) = + s * (((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D) + + t * (((y - a).1 * (c - a).2 - (y - a).2 * (c - a).1) / D) + rw [hsub] + simp [smul_eq_mul] + field_simp [hDneq] + ring + +private theorem hgamma_affine : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + (D ≠ 0) → ( + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + ∀ x, ∀ y, ∀ s, ∀ t, s + t = 1 → gamma (s • x + t • y) = s * gamma x + t * gamma y) ) := by + classical + intro p a b c D hDneq gamma x y s t hst + have hsub : s • x + t • y - a = s • (x - a) + t • (y - a) := by + ext <;> simp [smul_eq_mul] + · linear_combination a.1 * hst + · linear_combination a.2 * hst + change (((b - a).1 * (s • x + t • y - a).2 - + (b - a).2 * (s • x + t • y - a).1) / D) = + s * (((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D) + + t * (((b - a).1 * (y - a).2 - (b - a).2 * (y - a).1) / D) + rw [hsub] + simp [smul_eq_mul] + field_simp [hDneq] + ring + +private theorem halpha_affine : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + (∀ x, ∀ y, ∀ s, ∀ t, s + t = 1 → beta (s • x + t • y) = s * beta x + t * beta y) → ((∀ x, + ∀ y, ∀ s, ∀ t, s + t = 1 → gamma (s • x + t • y) = s * gamma x + t * gamma y) → (∀ x, + ∀ y, ∀ s, ∀ t, s + t = 1 → alpha (s • x + t • y) = s * alpha x + t * alpha y)) ) := by + classical + intro p a b c D beta gamma alpha hbeta_affine hgamma_affine x y s t hst + simp [alpha, hbeta_affine x y s t hst, hgamma_affine x y s t hst] + nlinarith [hst] + +private theorem hCsubset : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let K : Set (Real × Real) := convexHull Real (Set.range p.vertex) + (Convex Real K) → (P3544T1BoundaryCarrier p ⊆ K) ) := by + classical + intro p K hKconv x hx + change x ∈ ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) at hx + rcases Set.mem_iUnion.mp hx with ⟨i, hi⟩ + have hpi : p.vertex i ∈ K := by + change p.vertex i ∈ convexHull Real (Set.range p.vertex) + exact subset_convexHull Real (Set.range p.vertex) ⟨i, rfl⟩ + have hpn : p.vertex (i + 1) ∈ K := by + change p.vertex (i + 1) ∈ convexHull Real (Set.range p.vertex) + exact subset_convexHull Real (Set.range p.vertex) ⟨i + 1, rfl⟩ + exact hKconv.segment_subset hpi hpn hi + +private theorem hβb : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + (D ≠ 0) → ( + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + beta b = 1) ) := by + classical + intro p a b c D hDneq beta + dsimp [beta] + field_simp [hDneq] + simp [D] + ring + +private theorem hγb : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + (D ≠ 0) → ( + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + gamma b = 0) ) := by + classical + intro p a b c D hDneq gamma + dsimp [gamma] + field_simp [hDneq] + ring + +private theorem hβc : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + (D ≠ 0) → ( + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + beta c = 0) ) := by + classical + intro p a b c D hDneq beta + dsimp [beta] + field_simp [hDneq] + ring + +private theorem hγc : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + (D ≠ 0) → ( + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + gamma c = 1) ) := by + classical + intro p a b c D hDneq gamma + dsimp [gamma] + field_simp [hDneq] + simp [D] + ring + +private theorem hSconv : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + (∀ x, ∀ y, ∀ s, ∀ t, s + t = 1 → beta (s • x + t • y) = s * beta x + t * beta y) → ((∀ x, + ∀ y, ∀ s, ∀ t, s + t = 1 → gamma (s • x + t • y) = s * gamma x + t * gamma y) → ((∀ + x, ∀ y, ∀ s, ∀ t, s + t = 1 → alpha (s • x + t • y) = s * alpha x + t * alpha y) → ( + let S : Set (Real × Real) := {x | 0 ≤ alpha x ∧ 0 ≤ beta x ∧ 0 ≤ gamma x} + Convex Real S))) ) := by + classical + intro p a b c D beta gamma alpha hbeta_affine hgamma_affine halpha_affine S x hx y hy r s hr hs + hrs + change 0 ≤ alpha x ∧ 0 ≤ beta x ∧ 0 ≤ gamma x at hx + change 0 ≤ alpha y ∧ 0 ≤ beta y ∧ 0 ≤ gamma y at hy + change 0 ≤ alpha (r • x + s • y) ∧ 0 ≤ beta (r • x + s • y) ∧ + 0 ≤ gamma (r • x + s • y) + rw [halpha_affine x y r s hrs, hbeta_affine x y r s hrs, + hgamma_affine x y r s hrs] + exact ⟨add_nonneg (mul_nonneg hr hx.1) (mul_nonneg hs hy.1), + add_nonneg (mul_nonneg hr hx.2.1) (mul_nonneg hs hy.2.1), + add_nonneg (mul_nonneg hr hx.2.2) (mul_nonneg hs hy.2.2)⟩ + +private theorem hKsubS : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + let K : Set (Real × Real) := convexHull Real (Set.range p.vertex) + (beta a = 0) → ((gamma a = 0) → ((beta b = 1) → ((gamma b = 0) → ((beta c = 0) → ((gamma + c = 1) → ((alpha a = 1) → ((alpha b = 0) → ((alpha c = 0) → ( + let S : Set (Real × Real) := {x | 0 ≤ alpha x ∧ 0 ≤ beta x ∧ 0 ≤ gamma x} + (Convex Real S) → (K ⊆ S)))))))))) ) := by + classical + intro p a b c D beta gamma alpha K hβa hγa hβb hγb hβc hγc hαa hαb hαc S hSconv + apply convexHull_min + · intro x hx + rcases hx with ⟨i, rfl⟩ + fin_cases i + · change 0 ≤ alpha a ∧ 0 ≤ beta a ∧ 0 ≤ gamma a + simp [hαa, hβa, hγa] + · change 0 ≤ alpha b ∧ 0 ≤ beta b ∧ 0 ≤ gamma b + simp [hαb, hβb, hγb] + · change 0 ≤ alpha c ∧ 0 ≤ beta c ∧ 0 ≤ gamma c + simp [hαc, hβc, hγc] + · exact hSconv + +private theorem hSsubK : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + (∀ x, x = alpha x • a + beta x • b + gamma x • c) → ( + let K : Set (Real × Real) := convexHull Real (Set.range p.vertex) + let S : Set (Real × Real) := {x | 0 ≤ alpha x ∧ 0 ≤ beta x ∧ 0 ≤ gamma x} + S ⊆ K) ) := by + classical + intro p a b c D beta gamma alpha hrec K S x hx + change 0 ≤ alpha x ∧ 0 ≤ beta x ∧ 0 ≤ gamma x at hx + have hw0 : ∀ i : Fin 3, + 0 ≤ if i = 0 then alpha x else if i = 1 then beta x else gamma x := by + intro i + fin_cases i <;> simp [hx.1, hx.2.1, hx.2.2] + have hwsum : (∑ i : Fin 3, + if i = 0 then alpha x else if i = 1 then beta x else gamma x) = 1 := by + simp [Fin.sum_univ_succ] + linarith [hsum p x] + have hz : ∀ i : Fin 3, p.vertex i ∈ Set.range p.vertex := by + intro i + exact ⟨i, rfl⟩ + have hcomb : (∑ i : Fin 3, + (if i = 0 then alpha x else if i = 1 then beta x else gamma x) • p.vertex i) = x := by + simp [Fin.sum_univ_succ] + simpa [add_assoc] using (hrec x).symm + have hxK : x ∈ convexHull Real (Set.range p.vertex) := + mem_convexHull_of_exists_fintype + (fun i : Fin 3 => if i = 0 then alpha x else if i = 1 then beta x else gamma x) + p.vertex hw0 hwsum hz hcomb + simpa [K] using hxK + +private theorem hSpath : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + (∀ x, ∀ y, ∀ s, ∀ t, s + t = 1 → beta (s • x + t • y) = s * beta x + t * beta y) → ((∀ x, + ∀ y, ∀ s, ∀ t, s + t = 1 → gamma (s • x + t • y) = s * gamma x + t * gamma y) → ((∀ + x, ∀ y, ∀ s, ∀ t, s + t = 1 → alpha (s • x + t • y) = s * alpha x + t * alpha y) → + ((beta a = 0) → ((gamma a = 0) → ((beta b = 1) → ((gamma b = 0) → ((beta c = 0) → + ((gamma c = 1) → (IsPathConnected {x | 0 < alpha x ∧ 0 < beta x ∧ 0 < gamma + x}))))))))) ) := by + classical + intro p a b c D beta gamma alpha hbeta_affine hgamma_affine halpha_affine hβa hγa hβb hγb hβc hγc + apply (Convex.isPathConnected ?_ ?_) + · intro x hx y hy r s hr hs hrs + change 0 < alpha x ∧ 0 < beta x ∧ 0 < gamma x at hx + change 0 < alpha y ∧ 0 < beta y ∧ 0 < gamma y at hy + change 0 < alpha (r • x + s • y) ∧ 0 < beta (r • x + s • y) ∧ + 0 < gamma (r • x + s • y) + rw [halpha_affine x y r s hrs, hbeta_affine x y r s hrs, + hgamma_affine x y r s hrs] + have hweighted : ∀ u v : Real, 0 < u → 0 < v → + 0 ≤ r → 0 ≤ s → r + s = 1 → 0 < r * u + s * v := by + intro u v hu hv hr hs hrs + by_cases hr0 : r = 0 + · have hspos : 0 < s := by linarith + nlinarith [mul_pos hspos hv] + · have hrpos : 0 < r := lt_of_le_of_ne hr (Ne.symm hr0) + nlinarith [mul_pos hrpos hu] + refine ⟨hweighted _ _ hx.1 hy.1 hr hs hrs, ?_⟩ + exact ⟨hweighted _ _ hx.2.1 hy.2.1 hr hs hrs, + hweighted _ _ hx.2.2 hy.2.2 hr hs hrs⟩ + · refine ⟨((1 : Real) / 3) • a + ((1 : Real) / 3) • b + + ((1 : Real) / 3) • c, ?_⟩ + let m : Real × Real := ((1 : Real) / 2) • a + ((1 : Real) / 2) • b + let z : Real × Real := ((1 : Real) / 3) • a + ((1 : Real) / 3) • b + + ((1 : Real) / 3) • c + have hma : beta m = 1 / 2 := by + calc + beta m = beta (((1 : Real) / 2) • a + ((1 : Real) / 2) • b) := rfl + _ = (1 / 2) * beta a + (1 / 2) * beta b := + hbeta_affine a b (1 / 2) (1 / 2) (by norm_num) + _ = 1 / 2 := by rw [hβa, hβb]; norm_num + have hmg : gamma m = 0 := by + calc + gamma m = gamma (((1 : Real) / 2) • a + ((1 : Real) / 2) • b) := rfl + _ = (1 / 2) * gamma a + (1 / 2) * gamma b := + hgamma_affine a b (1 / 2) (1 / 2) (by norm_num) + _ = 0 := by rw [hγa, hγb]; norm_num + have hza : z = ((2 : Real) / 3) • m + ((1 : Real) / 3) • c := by + dsimp [z, m] + ext <;> simp [smul_eq_mul] <;> ring + have hbz : beta z = 1 / 3 := by + calc + beta z = beta (((2 : Real) / 3) • m + ((1 : Real) / 3) • c) := congrArg beta hza + _ = (2 / 3) * beta m + (1 / 3) * beta c := + hbeta_affine m c (2 / 3) (1 / 3) (by norm_num) + _ = 1 / 3 := by rw [hma, hβc]; norm_num + have hgz : gamma z = 1 / 3 := by + calc + gamma z = gamma (((2 : Real) / 3) • m + ((1 : Real) / 3) • c) := congrArg gamma hza + _ = (2 / 3) * gamma m + (1 / 3) * gamma c := + hgamma_affine m c (2 / 3) (1 / 3) (by norm_num) + _ = 1 / 3 := by rw [hmg, hγc]; norm_num + have haz : alpha z = 1 / 3 := by + dsimp [alpha] + rw [hbz, hgz] + norm_num + simp only [Set.mem_ofPred_eq] + have hzstrict : 0 < alpha z ∧ 0 < beta z ∧ 0 < gamma z := by + rw [haz, hbz, hgz] + norm_num + simpa [z] using hzstrict + +private theorem hKdecomp : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + (∀ x, x = alpha x • a + beta x • b + gamma x • c) → ( + let K : Set (Real × Real) := convexHull Real (Set.range p.vertex) + (P3544T1BoundaryCarrier p ⊆ K) → ( + let S : Set (Real × Real) := {x | 0 ≤ alpha x ∧ 0 ≤ beta x ∧ 0 ≤ gamma x} + (K ⊆ S) → ((S ⊆ K) → (K = {x | 0 < alpha x ∧ 0 < beta x ∧ 0 < gamma x} ∪ + P3544T1BoundaryCarrier p)))) ) := by + classical + intro p a b c D beta gamma alpha hrec K hCsubset S hKsubS hSsubK + have hzeroA : ∀ x, alpha x = 0 → 0 ≤ beta x → 0 ≤ gamma x → + x ∈ P3544T1BoundaryCarrier p := by + intro x hα hβ hγ + have hbc : beta x + gamma x = 1 := by linarith [hsum p x] + have heq : x = (1 - gamma x) • b + gamma x • c := by + calc + x = alpha x • a + beta x • b + gamma x • c := hrec x + _ = (1 - gamma x) • b + gamma x • c := by + rw [hα, show beta x = 1 - gamma x by linarith [hbc]] + module + have hseg : x ∈ segment Real b c := by + rw [segment_eq_image] + refine ⟨gamma x, ⟨hγ, ?_⟩, heq.symm⟩ + linarith + change x ∈ ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) + refine Set.mem_iUnion.mpr ⟨1, ?_⟩ + simpa [b, c] using hseg + have hzeroB : ∀ x, beta x = 0 → 0 ≤ alpha x → 0 ≤ gamma x → + x ∈ P3544T1BoundaryCarrier p := by + intro x hβ hα hγ + have hca : alpha x + gamma x = 1 := by linarith [hsum p x] + have heq : x = (1 - alpha x) • c + alpha x • a := by + calc + x = alpha x • a + beta x • b + gamma x • c := hrec x + _ = (1 - alpha x) • c + alpha x • a := by + rw [hβ, show gamma x = 1 - alpha x by linarith [hca]] + module + have hseg : x ∈ segment Real c a := by + rw [segment_eq_image] + refine ⟨alpha x, ⟨hα, ?_⟩, heq.symm⟩ + linarith + change x ∈ ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) + refine Set.mem_iUnion.mpr ⟨2, ?_⟩ + simpa [a, c] using hseg + have hzeroC : ∀ x, gamma x = 0 → 0 ≤ alpha x → 0 ≤ beta x → + x ∈ P3544T1BoundaryCarrier p := by + intro x hγ hα hβ + have hab : alpha x + beta x = 1 := by linarith [hsum p x] + have heq : x = (1 - beta x) • a + beta x • b := by + calc + x = alpha x • a + beta x • b + gamma x • c := hrec x + _ = (1 - beta x) • a + beta x • b := by + rw [hγ, show alpha x = 1 - beta x by linarith [hab]] + module + have hseg : x ∈ segment Real a b := by + rw [segment_eq_image] + refine ⟨beta x, ⟨hβ, ?_⟩, heq.symm⟩ + linarith + change x ∈ ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) + exact Set.mem_iUnion.mpr ⟨0, by simpa [a, b] using hseg⟩ + ext x + constructor + · intro hx + have hsx := hKsubS hx + change 0 ≤ alpha x ∧ 0 ≤ beta x ∧ 0 ≤ gamma x at hsx + by_cases hα : alpha x = 0 + · right + exact hzeroA x hα hsx.2.1 hsx.2.2 + by_cases hβ : beta x = 0 + · right + exact hzeroB x hβ hsx.1 hsx.2.2 + by_cases hγ : gamma x = 0 + · right + exact hzeroC x hγ hsx.1 hsx.2.1 + · left + exact ⟨lt_of_le_of_ne hsx.1 (Ne.symm hα), + lt_of_le_of_ne hsx.2.1 (Ne.symm hβ), + lt_of_le_of_ne hsx.2.2 (Ne.symm hγ)⟩ + · rintro (hx | hx) + · apply hSsubK + change 0 ≤ alpha x ∧ 0 ≤ beta x ∧ 0 ≤ gamma x + exact ⟨le_of_lt hx.1, le_of_lt hx.2.1, le_of_lt hx.2.2⟩ + · exact hCsubset hx + +private theorem hmuA_neg : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + let muA : (Real × Real) → Real := fun d => -(muB d + muC d) + ∀ (d : ℝ × ℝ), muA (-d) = -muA d ) := by + classical + intro p a b c D muB muC muA d + simp [muA, muB, muC] + ring + +private theorem hmuB_neg : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + ∀ (d : ℝ × ℝ), muB (-d) = -muB d ) := by + classical + intro p a b c D muB d + simp [muB] + ring + +private theorem hmuC_neg : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + ∀ (d : ℝ × ℝ), muC (-d) = -muC d ) := by + classical + intro p a b c D muC d + simp [muC] + ring + +private theorem hbeta_ray : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + (D ≠ 0) → ( + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + ∀ x, ∀ d, ∀ t, beta (x + t • d) = beta x + t * muB d) ) := by + classical + intro p a b c D hDneq beta muB x d t + dsimp [beta, muB] + field_simp [hDneq] + ring + +private theorem hgamma_ray : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + (D ≠ 0) → ( + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + ∀ x, ∀ d, ∀ t, gamma (x + t • d) = gamma x + t * muC d) ) := by + classical + intro p a b c D hDneq gamma muC x d t + dsimp [gamma, muC] + field_simp [hDneq] + ring + +private theorem halpha_ray : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + let muA : (Real × Real) → Real := fun d => -(muB d + muC d) + (∀ x, ∀ d, ∀ t, beta (x + t • d) = beta x + t * muB d) → ((∀ x, ∀ d, ∀ t, gamma (x + t • + d) = gamma x + t * muC d) → (∀ x, ∀ d, ∀ t, alpha (x + t • d) = alpha x + t * muA d)) + ) := by + classical + intro p a b c D beta gamma alpha muB muC muA hbeta_ray hgamma_ray x d t + dsimp [alpha, muA] + rw [hbeta_ray, hgamma_ray] + ring + +private theorem hxC : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let K : Set (Real × Real) := convexHull Real (Set.range p.vertex) + (P3544T1BoundaryCarrier p ⊆ K) → (∀ (x : ℝ × ℝ), (x ∉ K) → (x ∉ + P3544T1BoundaryCarrier p)) ) := by + classical + intro p K hCsubset x hxK hxC + exact hxK (hCsubset hxC) + +private theorem hmuAt597 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + (D ≠ 0) → ( + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + let muA : (Real × Real) → Real := fun d => -(muB d + muC d) + ∀ (d : ℝ × ℝ), (d.1 * (c - b).2 - d.2 * (c - b).1 ≠ 0) → (muA d ≠ 0)) ) := by + classical + intro p a b c D hDneq muB muC muA d hcross hmu + apply hcross + dsimp [muA, muB, muC] at hmu + field_simp [hDneq] at hmu + have hcrossEq : d.1 * (c - b).2 - d.2 * (c - b).1 = + d.1 * (c.2 - a.2) - d.2 * (c.1 - a.1) + + -(d.1 * (b.2 - a.2) - d.2 * (b.1 - a.1)) := by + dsimp [a, b, c] + ring + rw [hcrossEq] + nlinarith [hmu] + +private theorem hmu'At610 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + let muA : (Real × Real) → Real := fun d => -(muB d + muC d) + (∀ (d : Real × Real), muA (-d) = -muA d) → (∀ (d : ℝ × ℝ), (muA d ≠ 0) → ( + let d' : Real × Real := if 0 < muA d then -d else d + muA d' < 0)) ) := by + classical + intro p a b c D muB muC muA hmuA_neg d hmu d' + by_cases hpos : 0 < muA d + · simp only [d', ite_eq_left hpos] + rw [hmuA_neg] + linarith + · have hneg : muA d < 0 := lt_of_le_of_ne (le_of_not_gt hpos) hmu + simpa [d', hpos] using hneg + +private theorem hdv'At617 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + let muA : (Real × Real) → Real := fun d => -(muB d + muC d) + ∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), (∀ (i : Fin ((0 : ℕ) + (3 : ℕ))), d.1 * (p.vertex i - x).2 + - d.2 * (p.vertex i - x).1 ≠ (0 : ℝ)) → ( + let d' : Real × Real := if 0 < muA d then -d else d + ∀ i, d'.1 * (p.vertex i - x).2 - d'.2 * (p.vertex i - x).1 ≠ 0) ) := by + classical + intro p a b c D muB muC muA x d hdv d' i + by_cases hpos : 0 < muA d + · have heq : d'.1 * (p.vertex i - x).2 - d'.2 * (p.vertex i - x).1 = + -(d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1) := by + simp only [d', ite_eq_left hpos] + change (-d.1) * (p.vertex i - x).2 - (-d.2) * (p.vertex i - x).1 = + -(d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1) + ring + rw [heq] + exact fun hz => hdv i (by linarith [hz]) + · simpa [d', hpos] using hdv i + +private theorem hde'At630 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + let muA : (Real × Real) → Real := fun d => -(muB d + muC d) + ∀ (d : ℝ × ℝ), (∀ (i : Fin ((0 : ℕ) + (3 : ℕ))), d.1 * (p.vertex (i + (1 : Fin ((0 : ℕ) + + (3 : ℕ)))) - p.vertex i).2 - d.2 * (p.vertex (i + (1 : Fin ((0 : ℕ) + (3 : ℕ)))) - + p.vertex i).1 ≠ (0 : ℝ)) → ( + let d' : Real × Real := if 0 < muA d then -d else d + ∀ i, d'.1 * (p.vertex (i + 1) - p.vertex i).2 - d'.2 * (p.vertex (i + 1) - p.vertex i).1 + ≠ 0) ) := by + classical + intro p a b c D muB muC muA d hde d' i + by_cases hpos : 0 < muA d + · have heq : d'.1 * (p.vertex (i + 1) - p.vertex i).2 - + d'.2 * (p.vertex (i + 1) - p.vertex i).1 = + -(d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1) := by + simp only [d', ite_eq_left hpos] + change (-d.1) * (p.vertex (i + 1) - p.vertex i).2 - + (-d.2) * (p.vertex (i + 1) - p.vertex i).1 = + -(d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1) + ring + rw [heq] + exact fun hz => hde i (by linarith [hz]) + · simpa [d', hpos] using hde i + +private theorem hnoAt647 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + let K : Set (Real × Real) := convexHull Real (Set.range p.vertex) + (P3544T1BoundaryCarrier p ⊆ K) → ( + let S : Set (Real × Real) := {x | 0 ≤ alpha x ∧ 0 ≤ beta x ∧ 0 ≤ gamma x} + (K ⊆ S) → ( + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + let muA : (Real × Real) → Real := fun d => -(muB d + muC d) + (∀ x, ∀ d, ∀ t, alpha (x + t • d) = alpha x + t * muA d) → (∀ (x : ℝ × ℝ), (¬(0 : ℝ) ≤ + alpha x) → (∀ (d : ℝ × ℝ), + let d' : Real × Real := if 0 < muA d then -d else d + (muA d' < 0) → (∀ i : Fin 3, ¬ ∃ t : Real, 0 < t ∧ x + t • d' ∈ segment Real (p.vertex i) + (p.vertex (i + 1))))))) ) := by + classical + intro p a b c D beta gamma alpha K hCsubset S hKsubS muB muC muA halpha_ray x hαneg d d' hmu' i hi + rcases hi with ⟨t, ht, hseg⟩ + have hyC : x + t • d' ∈ P3544T1BoundaryCarrier p := by + change x + t • d' ∈ ⋃ j, segment Real (p.vertex j) (p.vertex (j + 1)) + exact Set.mem_iUnion.mpr ⟨i, hseg⟩ + have hyS := hKsubS (hCsubset hyC) + change 0 ≤ alpha (x + t • d') ∧ 0 ≤ beta (x + t • d') ∧ + 0 ≤ gamma (x + t • d') at hyS + have : alpha (x + t • d') < 0 := by + rw [halpha_ray] + have hm := mul_neg_of_pos_of_neg ht hmu' + linarith + exact (not_lt_of_ge hyS.1) this + +private theorem hcount0At662 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + let muA : (Real × Real) → Real := fun d => -(muB d + muC d) + ∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), + let d' : Real × Real := if 0 < muA d then -d else d + (∀ i : Fin 3, ¬ ∃ t : Real, 0 < t ∧ x + t • d' ∈ segment Real (p.vertex i) (p.vertex (i + + 1))) → (Set.ncard {i : Fin 3 | ∃ t : Real, 0 < t ∧ x + t • d' ∈ segment Real + (p.vertex i) (p.vertex (i + 1))} = 0) ) := by + classical + intro p a b c D muB muC muA x d d' hno + have hset : {i : Fin 3 | ∃ t : Real, 0 < t ∧ + x + t • d' ∈ segment Real (p.vertex i) (p.vertex (i + 1))} = ∅ := by + ext i + simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false, iff_false] + exact hno i + simp [hset] + +private theorem hmuAt678 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + (D ≠ 0) → ( + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + ∀ (d : ℝ × ℝ), (d.1 * (a - c).2 - d.2 * (a - c).1 ≠ 0) → (muB d ≠ 0)) ) := by + classical + intro p a b c D hDneq muB d hcross hm + dsimp [muB] at hm + field_simp [hDneq] at hm + have hc0 : d.1 * (c.2 - a.2) - d.2 * (c.1 - a.1) = 0 := by + simpa using hm + have heq : d.1 * (a - c).2 - d.2 * (a - c).1 = + -(d.1 * (c - a).2 - d.2 * (c - a).1) := by + dsimp [a, c] + ring + apply hcross + rw [heq] + change -(d.1 * (c.2 - a.2) - d.2 * (c.1 - a.1)) = 0 + rw [hc0] + simp + +private theorem hmu'At694 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + (∀ (d : Real × Real), muB (-d) = -muB d) → (∀ (d : ℝ × ℝ), (muB d ≠ 0) → ( + let d' : Real × Real := if 0 < muB d then -d else d + muB d' < 0)) ) := by + classical + intro p a b c D muB hmuB_neg d hmu d' + by_cases hpos : 0 < muB d + · simp only [d', ite_eq_left hpos] + rw [hmuB_neg] + linarith + · have hneg : muB d < 0 := lt_of_le_of_ne (le_of_not_gt hpos) hmu + simpa [d', hpos] using hneg + +private theorem hdv'At701 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + ∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), (∀ (i : Fin ((0 : ℕ) + (3 : ℕ))), d.1 * (p.vertex i - x).2 + - d.2 * (p.vertex i - x).1 ≠ (0 : ℝ)) → ( + let d' : Real × Real := if 0 < muB d then -d else d + ∀ i, d'.1 * (p.vertex i - x).2 - d'.2 * (p.vertex i - x).1 ≠ 0) ) := by + classical + intro p a b c D muB x d hdv d' i + by_cases hpos : 0 < muB d + · have heq : d'.1 * (p.vertex i - x).2 - d'.2 * (p.vertex i - x).1 = + -(d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1) := by + simp only [d', ite_eq_left hpos] + change (-d.1) * (p.vertex i - x).2 - (-d.2) * (p.vertex i - x).1 = + -(d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1) + ring + rw [heq] + exact fun hz => hdv i (by linarith [hz]) + · simpa [d', hpos] using hdv i + +private theorem hde'At714 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + ∀ (d : ℝ × ℝ), (∀ (i : Fin ((0 : ℕ) + (3 : ℕ))), d.1 * (p.vertex (i + (1 : Fin ((0 : ℕ) + + (3 : ℕ)))) - p.vertex i).2 - d.2 * (p.vertex (i + (1 : Fin ((0 : ℕ) + (3 : ℕ)))) - + p.vertex i).1 ≠ (0 : ℝ)) → ( + let d' : Real × Real := if 0 < muB d then -d else d + ∀ i, d'.1 * (p.vertex (i + 1) - p.vertex i).2 - d'.2 * (p.vertex (i + 1) - p.vertex i).1 + ≠ 0) ) := by + classical + intro p a b c D muB d hde d' i + by_cases hpos : 0 < muB d + · have heq : d'.1 * (p.vertex (i + 1) - p.vertex i).2 - + d'.2 * (p.vertex (i + 1) - p.vertex i).1 = + -(d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1) := by + simp only [d', ite_eq_left hpos] + change (-d.1) * (p.vertex (i + 1) - p.vertex i).2 - + (-d.2) * (p.vertex (i + 1) - p.vertex i).1 = + -(d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1) + ring + rw [heq] + exact fun hz => hde i (by linarith [hz]) + · simpa [d', hpos] using hde i + +private theorem hnoAt731 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + let K : Set (Real × Real) := convexHull Real (Set.range p.vertex) + (P3544T1BoundaryCarrier p ⊆ K) → ( + let S : Set (Real × Real) := {x | 0 ≤ alpha x ∧ 0 ≤ beta x ∧ 0 ≤ gamma x} + (K ⊆ S) → ( + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + (∀ x, ∀ d, ∀ t, beta (x + t • d) = beta x + t * muB d) → (∀ (x : ℝ × ℝ), (¬(0 : ℝ) ≤ beta + x) → (∀ (d : ℝ × ℝ), + let d' : Real × Real := if 0 < muB d then -d else d + (muB d' < 0) → (∀ i : Fin 3, ¬ ∃ t : Real, 0 < t ∧ x + t • d' ∈ segment Real (p.vertex i) + (p.vertex (i + 1))))))) ) := by + classical + intro p a b c D beta gamma alpha K hCsubset S hKsubS muB hbeta_ray x hβneg d d' hmu' i hi + rcases hi with ⟨t, ht, hseg⟩ + have hyC : x + t • d' ∈ P3544T1BoundaryCarrier p := by + change x + t • d' ∈ ⋃ j, segment Real (p.vertex j) (p.vertex (j + 1)) + exact Set.mem_iUnion.mpr ⟨i, hseg⟩ + have hyS := hKsubS (hCsubset hyC) + change 0 ≤ alpha (x + t • d') ∧ 0 ≤ beta (x + t • d') ∧ + 0 ≤ gamma (x + t • d') at hyS + have : beta (x + t • d') < 0 := by + rw [hbeta_ray] + have hm := mul_neg_of_pos_of_neg ht hmu' + linarith + exact (not_lt_of_ge hyS.2.1) this + +private theorem hcount0At746 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + ∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), + let d' : Real × Real := if 0 < muB d then -d else d + (∀ i : Fin 3, ¬ ∃ t : Real, 0 < t ∧ x + t • d' ∈ segment Real (p.vertex i) (p.vertex (i + + 1))) → (Set.ncard {i : Fin 3 | ∃ t : Real, 0 < t ∧ x + t • d' ∈ segment Real + (p.vertex i) (p.vertex (i + 1))} = 0) ) := by + classical + intro p a b c D muB x d d' hno + have hset : {i : Fin 3 | ∃ t : Real, 0 < t ∧ + x + t • d' ∈ segment Real (p.vertex i) (p.vertex (i + 1))} = ∅ := by + ext i + simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false, iff_false] + exact hno i + simp [hset] + +private theorem hmuAt761 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + (D ≠ 0) → ( + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + ∀ (d : ℝ × ℝ), (d.1 * (b - a).2 - d.2 * (b - a).1 ≠ 0) → (muC d ≠ 0)) ) := by + classical + intro p a b c D hDneq muC d hcross hm + dsimp [muC] at hm + field_simp [hDneq] at hm + have hab0 : d.1 * (b - a).2 - d.2 * (b - a).1 = 0 := by + have hm' := hm + simp only [mul_zero] at hm' + exact neg_eq_zero.mp hm' + exact hcross hab0 + +private theorem hmu'At771 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + (∀ (d : Real × Real), muC (-d) = -muC d) → (∀ (d : ℝ × ℝ), (muC d ≠ 0) → ( + let d' : Real × Real := if 0 < muC d then -d else d + muC d' < 0)) ) := by + classical + intro p a b c D muC hmuC_neg d hmu d' + by_cases hpos : 0 < muC d + · simp only [d', ite_eq_left hpos] + rw [hmuC_neg] + linarith + · have hneg : muC d < 0 := lt_of_le_of_ne (le_of_not_gt hpos) hmu + simpa [d', hpos] using hneg + +private theorem hdv'At778 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + ∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), (∀ (i : Fin ((0 : ℕ) + (3 : ℕ))), d.1 * (p.vertex i - x).2 + - d.2 * (p.vertex i - x).1 ≠ (0 : ℝ)) → ( + let d' : Real × Real := if 0 < muC d then -d else d + ∀ i, d'.1 * (p.vertex i - x).2 - d'.2 * (p.vertex i - x).1 ≠ 0) ) := by + classical + intro p a b c D muC x d hdv d' i + by_cases hpos : 0 < muC d + · have heq : d'.1 * (p.vertex i - x).2 - d'.2 * (p.vertex i - x).1 = + -(d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1) := by + simp only [d', ite_eq_left hpos] + change (-d.1) * (p.vertex i - x).2 - (-d.2) * (p.vertex i - x).1 = + -(d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1) + ring + rw [heq] + exact fun hz => hdv i (by linarith [hz]) + · simpa [d', hpos] using hdv i + +private theorem hde'At791 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + ∀ (d : ℝ × ℝ), (∀ (i : Fin ((0 : ℕ) + (3 : ℕ))), d.1 * (p.vertex (i + (1 : Fin ((0 : ℕ) + + (3 : ℕ)))) - p.vertex i).2 - d.2 * (p.vertex (i + (1 : Fin ((0 : ℕ) + (3 : ℕ)))) - + p.vertex i).1 ≠ (0 : ℝ)) → ( + let d' : Real × Real := if 0 < muC d then -d else d + ∀ i, d'.1 * (p.vertex (i + 1) - p.vertex i).2 - d'.2 * (p.vertex (i + 1) - p.vertex i).1 + ≠ 0) ) := by + classical + intro p a b c D muC d hde d' i + by_cases hpos : 0 < muC d + · have heq : d'.1 * (p.vertex (i + 1) - p.vertex i).2 - + d'.2 * (p.vertex (i + 1) - p.vertex i).1 = + -(d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1) := by + simp only [d', ite_eq_left hpos] + change (-d.1) * (p.vertex (i + 1) - p.vertex i).2 - + (-d.2) * (p.vertex (i + 1) - p.vertex i).1 = + -(d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1) + ring + rw [heq] + exact fun hz => hde i (by linarith [hz]) + · simpa [d', hpos] using hde i + +private theorem hnoAt808 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + let K : Set (Real × Real) := convexHull Real (Set.range p.vertex) + (P3544T1BoundaryCarrier p ⊆ K) → ( + let S : Set (Real × Real) := {x | 0 ≤ alpha x ∧ 0 ≤ beta x ∧ 0 ≤ gamma x} + (K ⊆ S) → ( + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + (∀ x, ∀ d, ∀ t, gamma (x + t • d) = gamma x + t * muC d) → (∀ (x : ℝ × ℝ), (¬(0 : ℝ) ≤ + gamma x) → (∀ (d : ℝ × ℝ), + let d' : Real × Real := if 0 < muC d then -d else d + (muC d' < 0) → (∀ i : Fin 3, ¬ ∃ t : Real, 0 < t ∧ x + t • d' ∈ segment Real (p.vertex i) + (p.vertex (i + 1))))))) ) := by + classical + intro p a b c D beta gamma alpha K hCsubset S hKsubS muC hgamma_ray x hγneg d d' hmu' i hi + rcases hi with ⟨t, ht, hseg⟩ + have hyC : x + t • d' ∈ P3544T1BoundaryCarrier p := by + change x + t • d' ∈ ⋃ j, segment Real (p.vertex j) (p.vertex (j + 1)) + exact Set.mem_iUnion.mpr ⟨i, hseg⟩ + have hyS := hKsubS (hCsubset hyC) + change 0 ≤ alpha (x + t • d') ∧ 0 ≤ beta (x + t • d') ∧ + 0 ≤ gamma (x + t • d') at hyS + have : gamma (x + t • d') < 0 := by + rw [hgamma_ray] + have hm := mul_neg_of_pos_of_neg ht hmu' + linarith + exact (not_lt_of_ge hyS.2.2) this + +private theorem hcount0At823 : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + ∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), + let d' : Real × Real := if 0 < muC d then -d else d + (∀ i : Fin 3, ¬ ∃ t : Real, 0 < t ∧ x + t • d' ∈ segment Real (p.vertex i) (p.vertex (i + + 1))) → (Set.ncard {i : Fin 3 | ∃ t : Real, 0 < t ∧ x + t • d' ∈ segment Real + (p.vertex i) (p.vertex (i + 1))} = 0) ) := by + classical + intro p a b c D muC x d d' hno + have hset : {i : Fin 3 | ∃ t : Real, 0 < t ∧ + x + t • d' ∈ segment Real (p.vertex i) (p.vertex (i + 1))} = ∅ := by + ext i + simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false, iff_false] + exact hno i + simp [hset] + +private theorem hCdisjH : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + (∀ x, ∀ y, ∀ s, ∀ t, s + t = 1 → beta (s • x + t • y) = s * beta x + t * beta y) → ((∀ x, + ∀ y, ∀ s, ∀ t, s + t = 1 → gamma (s • x + t • y) = s * gamma x + t * gamma y) → ((∀ + x, ∀ y, ∀ s, ∀ t, s + t = 1 → alpha (s • x + t • y) = s * alpha x + t * alpha y) → + ((beta a = 0) → ((gamma a = 0) → ((gamma b = 0) → ((beta c = 0) → ((alpha b = 0) → + ((alpha c = 0) → ( + let H : Set (Real × Real) := {x | 0 < alpha x ∧ 0 < beta x ∧ 0 < gamma x} + ∀ x, x ∈ H → x ∉ P3544T1BoundaryCarrier p))))))))) ) := by + classical + intro p a b c D beta gamma alpha hbeta_affine hgamma_affine halpha_affine hβa hγa hγb hβc hαb + hαc H x hxH hxC + change x ∈ ⋃ i : Fin 3, segment Real (p.vertex i) (p.vertex (i + 1)) at hxC + rcases Set.mem_iUnion.mp hxC with ⟨i, hi⟩ + rw [segment_eq_image] at hi + rcases hi with ⟨t, ht, heq⟩ + fin_cases i + · have hg := hgamma_affine a b (1 - t) t (by ring) + rw [hγa, hγb] at hg + have hz : gamma x = 0 := by rw [← heq]; simpa using hg + linarith [hxH.2.2] + · have ha := halpha_affine b c (1 - t) t (by ring) + rw [hαb, hαc] at ha + have hz : alpha x = 0 := by rw [← heq]; simpa using ha + linarith [hxH.1] + · have hb := hbeta_affine c a (1 - t) t (by ring) + rw [hβc, hβa] at hb + have hz : beta x = 0 := by rw [← heq]; simpa using hb + linarith [hxH.2.1] + +private theorem hbeta_cont : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + Continuous beta ) := by + classical + intro p a b c D beta + dsimp [beta] + fun_prop + +private theorem hgamma_cont : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + Continuous gamma ) := by + classical + intro p a b c D gamma + dsimp [gamma] + fun_prop + +private theorem halpha_cont : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + Continuous alpha ) := by + classical + intro p a b c D beta gamma alpha + dsimp [alpha, beta, gamma] + fun_prop + +private theorem hHopen : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + let H : Set (Real × Real) := {x | 0 < alpha x ∧ 0 < beta x ∧ 0 < gamma x} + (Continuous beta) → ((Continuous gamma) → ((Continuous alpha) → (IsOpen H))) ) := by + classical + intro p a b c D beta gamma alpha H hbeta_cont hgamma_cont halpha_cont + have hα : IsOpen {x | 0 < alpha x} := isOpen_lt continuous_const halpha_cont + have hβ : IsOpen {x | 0 < beta x} := isOpen_lt continuous_const hbeta_cont + have hγ : IsOpen {x | 0 < gamma x} := isOpen_lt continuous_const hgamma_cont + simpa [H, Set.ofPred_and] using hα.inter (hβ.inter hγ) + +private theorem hHminusOopen : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + (∀ x ∉ P3544T1BoundaryCarrier p, ∃ (r : ℝ), (0 : ℝ) < r ∧ (Metric.ball x r ⊆ + P3544T1RayParity p ∨ Disjoint (Metric.ball x r) (P3544T1RayParity p))) → ( + let H : Set (Real × Real) := {x | 0 < alpha x ∧ 0 < beta x ∧ 0 < gamma x} + (∀ x, x ∈ H → x ∉ P3544T1BoundaryCarrier p) → ((IsOpen H) → (IsOpen (H \ + P3544T1RayParity p)))) ) := by + classical + intro p a b c D beta gamma alpha hlocal H hCdisjH hHopen + rw [Metric.isOpen_iff] + intro x hx + obtain ⟨r, hr, hchoice⟩ := hlocal x (hCdisjH x hx.1) + obtain ⟨s, hs, hballH⟩ := Metric.isOpen_iff.mp hHopen x hx.1 + have hdisj : Disjoint (Metric.ball x r) (P3544T1RayParity p) := by + rcases hchoice with hball | hdisj + · exfalso + have hxball : x ∈ Metric.ball x r := Metric.mem_ball_self hr + exact hx.2 (hball hxball) + · exact hdisj + have hmin : 0 < min r s := by + rw [lt_min_iff] + exact ⟨hr, hs⟩ + refine ⟨min r s, hmin, ?_⟩ + intro y hy + have hy' := Metric.mem_ball.mp hy + have hyr : dist y x < r := lt_of_lt_of_le hy' (min_le_left _ _) + have hys : dist y x < s := lt_of_lt_of_le hy' (min_le_right _ _) + refine ⟨hballH (Metric.mem_ball.mpr hys), ?_⟩ + intro hyO + exact (Set.disjoint_left.mp hdisj) hyr hyO + +private theorem hOsubK : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let K : Set (Real × Real) := convexHull Real (Set.range p.vertex) + (∀ x, x ∉ K → x ∉ P3544T1RayParity p) → (P3544T1RayParity p ⊆ K) ) := by + classical + intro p K hnotOoutside x hxO + by_contra hxK + exact hnotOoutside x hxK hxO + +private theorem hOeqH : + (by + classical + exact + ∀ (p : P3381T1PolygonBoundary 0), + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + let K : Set (Real × Real) := convexHull Real (Set.range p.vertex) + (IsPathConnected {x | 0 < alpha x ∧ 0 < beta x ∧ 0 < gamma x}) → ((IsOpen + (P3544T1RayParity p)) → ((∀ (i : Fin ((0 : ℕ) + (3 : ℕ))), ∃ (r : ℝ), (0 : ℝ) < r ∧ + IsPathConnected (Metric.ball (p.vertex i) r ∩ P3544T1RayParity p) ∧ IsPathConnected + (Metric.ball (p.vertex i) r \ (P3544T1RayParity p ∪ P3544T1BoundaryCarrier p))) → ( + let H : Set (Real × Real) := {x | 0 < alpha x ∧ 0 < beta x ∧ 0 < gamma x} + (K = H ∪ P3544T1BoundaryCarrier p) → ((IsOpen (H \ P3544T1RayParity p)) → + ((P3544T1RayParity p ⊆ K) → (P3544T1RayParity p = H)))))) ) := by + classical + intro p a b c D beta gamma alpha K hSpath hOpenO hvertex H hKdecompH hHminusOopen hOsubK + apply Set.Subset.antisymm + · intro x hxO + have hxK := hOsubK hxO + have hxKH : x ∈ H ∨ x ∈ P3544T1BoundaryCarrier p := by + simpa [hKdecompH] using hxK + rcases hxKH with hxH | hxC + · exact hxH + · exact (hxO.1 hxC).elim + · intro x hxH + have hU : IsClopen (Subtype.val ⁻¹' P3544T1RayParity p : Set H) := by + have hcomp : (Subtype.val ⁻¹' P3544T1RayParity p : Set H)ᶜ = + Subtype.val ⁻¹' (H \ P3544T1RayParity p) := by + ext y + change (↑y ∉ P3544T1RayParity p) ↔ + (↑y ∈ H ∧ ↑y ∉ P3544T1RayParity p) + exact ⟨fun hy => ⟨y.property, hy⟩, And.right⟩ + have hcompopen : IsOpen ((Subtype.val ⁻¹' P3544T1RayParity p : Set H)ᶜ) := by + rw [hcomp] + exact hHminusOopen.preimage continuous_subtype_val + exact ⟨⟨hcompopen⟩, hOpenO.preimage continuous_subtype_val⟩ + let : PathConnectedSpace H := (isPathConnected_iff_pathConnectedSpace.mp hSpath) + obtain ⟨r, hr, hnear, _⟩ := hvertex (0 : Fin 3) + obtain ⟨y, hy⟩ := hnear.nonempty + have hyO : y ∈ P3544T1RayParity p := hy.2 + have hyK := hOsubK hyO + have hyKH : y ∈ H ∨ y ∈ P3544T1BoundaryCarrier p := by + simpa [hKdecompH] using hyK + have hyH : y ∈ H := by + rcases hyKH with hyH | hyC + · exact hyH + · exact (hyO.1 hyC).elim + have hnonempty : (Subtype.val ⁻¹' P3544T1RayParity p : Set H).Nonempty := + ⟨⟨y, hyH⟩, hyO⟩ + have huniv := hU.eq_univ hnonempty + have hxO : x ∈ P3544T1RayParity p := by + have hxmem : (⟨x, hxH⟩ : H) ∈ Subtype.val ⁻¹' P3544T1RayParity p := by + rw [huniv] + simp + exact hxmem + exact hxO + +end TriangleRayIntersections + +theorem P3544T1TriangleRayGeometry (p : P3381T1PolygonBoundary 0) : + P3381T1TriangleDeterminant p.vertex ≠ 0 ∧ + convexHull Real (Set.range p.vertex) = + P3544T1RayParity p ∪ P3544T1BoundaryCarrier p ∧ + IsPathConnected (P3544T1RayParity p) := by +-- BODY + let a : Real × Real := p.vertex 0 + let b : Real × Real := p.vertex 1 + let c : Real × Real := p.vertex 2 + have hab := TriangleRayIntersections.habAt122 p + have hac := TriangleRayIntersections.hac p + have hbc := TriangleRayIntersections.hbcAt128 p + have hu := TriangleRayIntersections.hu p hab + have hDne : P3381T1TriangleDeterminant p.vertex ≠ 0 := TriangleRayIntersections.hDne p hab + hac hbc hu + let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 + have hDneq : D ≠ 0 := by + simpa [D, P3381T1TriangleDeterminant, a, b, c] using hDne + let beta : (Real × Real) → Real := fun x => + ((x - a).1 * (c - a).2 - (x - a).2 * (c - a).1) / D + let gamma : (Real × Real) → Real := fun x => + ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D + let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x + have hsum := TriangleRayIntersections.hsum p + have hrec := TriangleRayIntersections.hrec p hDneq + have hbeta_affine := TriangleRayIntersections.hbeta_affine p hDneq + have hgamma_affine := TriangleRayIntersections.hgamma_affine p hDneq + have halpha_affine := TriangleRayIntersections.halpha_affine p hbeta_affine hgamma_affine + let K : Set (Real × Real) := convexHull Real (Set.range p.vertex) + have hKconv : Convex Real K := by + exact convex_convexHull Real (Set.range p.vertex) + have hCsubset := TriangleRayIntersections.hCsubset p hKconv + have hβa : beta a = 0 := by simp [beta] + have hγa : gamma a = 0 := by simp [gamma] + have hβb : beta b = 1 := TriangleRayIntersections.hβb p hDneq + have hγb : gamma b = 0 := TriangleRayIntersections.hγb p hDneq + have hβc : beta c = 0 := TriangleRayIntersections.hβc p hDneq + have hγc : gamma c = 1 := TriangleRayIntersections.hγc p hDneq + have hαa : alpha a = 1 := by dsimp [alpha]; rw [hβa, hγa]; norm_num + have hαb : alpha b = 0 := by dsimp [alpha]; rw [hβb, hγb]; norm_num + have hαc : alpha c = 0 := by dsimp [alpha]; rw [hβc, hγc]; norm_num + let S : Set (Real × Real) := {x | 0 ≤ alpha x ∧ 0 ≤ beta x ∧ 0 ≤ gamma x} + have hSconv := TriangleRayIntersections.hSconv p hbeta_affine hgamma_affine halpha_affine + have hKsubS := TriangleRayIntersections.hKsubS p hβa hγa hβb hγb hβc hγc hαa hαb hαc hSconv + have hSsubK := TriangleRayIntersections.hSsubK p hrec + have hKS : K = S := Set.Subset.antisymm hKsubS hSsubK + have hSpath : IsPathConnected {x | 0 < alpha x ∧ 0 < beta x ∧ 0 < gamma x} := + TriangleRayIntersections.hSpath p hbeta_affine hgamma_affine halpha_affine hβa hγa hβb hγb + hβc hγc + have hKdecomp : K = {x | 0 < alpha x ∧ 0 < beta x ∧ 0 < gamma x} ∪ + P3544T1BoundaryCarrier p := TriangleRayIntersections.hKdecomp p hrec hCsubset hKsubS hSsubK + let muB : (Real × Real) → Real := fun d => + (d.1 * (c - a).2 - d.2 * (c - a).1) / D + let muC : (Real × Real) → Real := fun d => + -(d.1 * (b - a).2 - d.2 * (b - a).1) / D + let muA : (Real × Real) → Real := fun d => -(muB d + muC d) + have hmuA_neg (d : Real × Real) := TriangleRayIntersections.hmuA_neg p d + have hmuB_neg (d : Real × Real) := TriangleRayIntersections.hmuB_neg p d + have hmuC_neg (d : Real × Real) := TriangleRayIntersections.hmuC_neg p d + have hbeta_ray := TriangleRayIntersections.hbeta_ray p hDneq + have hgamma_ray := TriangleRayIntersections.hgamma_ray p hDneq + have halpha_ray := TriangleRayIntersections.halpha_ray p hbeta_ray hgamma_ray + have hLocalParity := P3544T1LocalParity p + rcases hLocalParity with ⟨_, hOpenO, _, _, hlocal, hgeneric, hchar, hvertex, _⟩ + have hnotOoutside : ∀ x, x ∉ K → x ∉ P3544T1RayParity p := by + intro x hxK hxO + have hxC := TriangleRayIntersections.hxC p hCsubset x hxK + have hxS : x ∉ S := by simpa [hKS] using hxK + change ¬ (0 ≤ alpha x ∧ 0 ≤ beta x ∧ 0 ≤ gamma x) at hxS + rcases not_and_or.mp hxS with hαneg | hrest + · have hαlt : alpha x < 0 := lt_of_not_ge hαneg + obtain ⟨d, hdv, hde⟩ := hgeneric x hxC + have hcross : d.1 * (c - b).2 - d.2 * (c - b).1 ≠ 0 := by + simpa [a, b, c] using hde 1 + have hmu := TriangleRayIntersections.hmuAt597 p hDneq d hcross + let d' : Real × Real := if 0 < muA d then -d else d + have hmu' := TriangleRayIntersections.hmu'At610 p hmuA_neg d hmu + have hdv' := TriangleRayIntersections.hdv'At617 p x d hdv + have hde' := TriangleRayIntersections.hde'At630 p d hde + have hno := TriangleRayIntersections.hnoAt647 p hCsubset hKsubS halpha_ray x hαneg d hmu' + have hcount0 : Set.ncard {i : Fin 3 | ∃ t : Real, 0 < t ∧ + x + t • d' ∈ segment Real (p.vertex i) (p.vertex (i + 1))} = 0 := + TriangleRayIntersections.hcount0At662 p x d hno + have hodd := (hchar x d' hxC hdv' hde').mp hxO + rw [hcount0] at hodd + norm_num at hodd + · rcases not_and_or.mp hrest with hβneg | hγneg + · have hβlt : beta x < 0 := lt_of_not_ge hβneg + obtain ⟨d, hdv, hde⟩ := hgeneric x hxC + have hcross : d.1 * (a - c).2 - d.2 * (a - c).1 ≠ 0 := by + simpa [a, b, c] using hde 2 + have hmu := TriangleRayIntersections.hmuAt678 p hDneq d hcross + let d' : Real × Real := if 0 < muB d then -d else d + have hmu' := TriangleRayIntersections.hmu'At694 p hmuB_neg d hmu + have hdv' := TriangleRayIntersections.hdv'At701 p x d hdv + have hde' := TriangleRayIntersections.hde'At714 p d hde + have hno := TriangleRayIntersections.hnoAt731 p hCsubset hKsubS hbeta_ray x hβneg d hmu' + have hcount0 : Set.ncard {i : Fin 3 | ∃ t : Real, 0 < t ∧ + x + t • d' ∈ segment Real (p.vertex i) (p.vertex (i + 1))} = 0 := + TriangleRayIntersections.hcount0At746 p x d hno + have hodd := (hchar x d' hxC hdv' hde').mp hxO + rw [hcount0] at hodd + norm_num at hodd + · have hγlt : gamma x < 0 := lt_of_not_ge hγneg + obtain ⟨d, hdv, hde⟩ := hgeneric x hxC + have hcross : d.1 * (b - a).2 - d.2 * (b - a).1 ≠ 0 := by + simpa [a, b, c] using hde 0 + have hmu := TriangleRayIntersections.hmuAt761 p hDneq d hcross + let d' : Real × Real := if 0 < muC d then -d else d + have hmu' := TriangleRayIntersections.hmu'At771 p hmuC_neg d hmu + have hdv' := TriangleRayIntersections.hdv'At778 p x d hdv + have hde' := TriangleRayIntersections.hde'At791 p d hde + have hno := TriangleRayIntersections.hnoAt808 p hCsubset hKsubS hgamma_ray x hγneg d hmu' + have hcount0 : Set.ncard {i : Fin 3 | ∃ t : Real, 0 < t ∧ + x + t • d' ∈ segment Real (p.vertex i) (p.vertex (i + 1))} = 0 := + TriangleRayIntersections.hcount0At823 p x d hno + have hodd := (hchar x d' hxC hdv' hde').mp hxO + rw [hcount0] at hodd + norm_num at hodd + let H : Set (Real × Real) := {x | 0 < alpha x ∧ 0 < beta x ∧ 0 < gamma x} + have hKdecompH : K = H ∪ P3544T1BoundaryCarrier p := by + simpa [H] using hKdecomp + have hCdisjH := TriangleRayIntersections.hCdisjH p hbeta_affine hgamma_affine halpha_affine hβa + hγa hγb hβc hαb hαc + have hbeta_cont := TriangleRayIntersections.hbeta_cont p + have hgamma_cont := TriangleRayIntersections.hgamma_cont p + have halpha_cont := TriangleRayIntersections.halpha_cont p + have hHopen := TriangleRayIntersections.hHopen p hbeta_cont hgamma_cont halpha_cont + have hHminusOopen := TriangleRayIntersections.hHminusOopen p hlocal hCdisjH hHopen + have hOsubK := TriangleRayIntersections.hOsubK p hnotOoutside + have hOeqH : P3544T1RayParity p = H := TriangleRayIntersections.hOeqH p hSpath hOpenO hvertex + hKdecompH hHminusOopen hOsubK + refine ⟨hDne, ?_, ?_⟩ + · rw [hOeqH] + simpa [H] using hKdecomp + · simpa [hOeqH] using hSpath + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean new file mode 100644 index 0000000000..9f4f04480d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean @@ -0,0 +1,1925 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3555T2ParabolaSupporting +public import Mathlib.Analysis.Convex.Hull +public import Mathlib.Analysis.Convex.Join +public import Mathlib.Data.List.Rotate +public import Mathlib.Data.List.OfFn +public import Mathlib.Data.List.NodupEquivFin + +-- [TABLET NODE: P3555T2ParabolaChordCuts] + +/-! +# P3555T2ParabolaChordCuts + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ParabolaChordLemmas + +private theorem hL : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), ((a :: (u ++ b :: v)).Nodup) → ( + let L := a :: (u ++ b :: v) + L.Nodup) := by + classical + intro n a b u v hboundary L + exact hboundary + +private theorem haNotTail : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + (L.Nodup) → (a ∉ u ++ b :: v) := by + classical + intro n a b u v L hL + exact (List.nodup_cons.mp hL).1 + +private theorem htailNodup : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + (L.Nodup) → ((u ++ b :: v).Nodup) := by + classical + intro n a b u v L hL + exact (List.nodup_cons.mp hL).2 + +private theorem hne : + ∀ (n : Nat), (Fin (n + 3) → Real × Real) → (∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : + List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), ((a :: (u ++ b :: v)).Nodup) → ((∃ k : + Nat, (a :: (u ++ b :: v)).Sublist ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) → ( + let L := a :: (u ++ b :: v) + (L.Nodup) → ((a ∉ u ++ b :: v) → (((u ++ b :: v).Nodup) → (a ≠ b)))))) := by + classical + intro n q a b u v hboundary hcyclic L hL haNotTail htailNodup hab + subst b + apply haNotTail + simp + +private theorem hparts : + ∀ (n : Nat), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), ((u + ++ b :: v).Nodup) → (u.Nodup ∧ (b :: v).Nodup ∧ ∀ a ∈ u, ∀ b_1 ∈ b :: v, a ≠ b_1) := by + classical + intro n b u v htailNodup + exact List.nodup_append.mp htailNodup + +private theorem huNodup : + ∀ (n : Nat), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + (u.Nodup ∧ (b :: v).Nodup ∧ ∀ a ∈ u, ∀ b_1 ∈ b :: v, a ≠ b_1) → (u.Nodup) := by + classical + intro n b u v hparts + exact hparts.1 + +private theorem hbNotU : + ∀ (n : Nat), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + (u.Nodup ∧ (b :: v).Nodup ∧ ∀ a ∈ u, ∀ b_1 ∈ b :: v, a ≠ b_1) → (b ∉ u) := by + classical + intro n b u v hparts hb + exact hparts.2.2 b hb b (by simp) rfl + +private theorem hvNodup : + ∀ (n : Nat), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + (u.Nodup ∧ (b :: v).Nodup ∧ ∀ a ∈ u, ∀ b_1 ∈ b :: v, a ≠ b_1) → (v.Nodup) := by + classical + intro n b u v hparts + have := List.nodup_cons.mp hparts.2.1 + exact this.2 + +private theorem hbNotV : + ∀ (n : Nat), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + (u.Nodup ∧ (b :: v).Nodup ∧ ∀ a ∈ u, ∀ b_1 ∈ b :: v, a ≠ b_1) → (b ∉ v) := by + classical + intro n b u v hparts + exact (List.nodup_cons.mp hparts.2.1).1 + +private theorem haNotU : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), (a ∉ u ++ b :: v) → (a ∉ u) := by + classical + intro n a b u v haNotTail ha + apply haNotTail + exact List.mem_append_left _ ha + +private theorem haNotV : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), (a ∉ u ++ b :: v) → (a ∉ v) := by + classical + intro n a b u v haNotTail ha + apply haNotTail + exact List.mem_append_right _ (List.mem_cons_of_mem _ ha) + +private theorem huvDisjoint : + ∀ (n : Nat), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + (u.Nodup ∧ (b :: v).Nodup ∧ ∀ a ∈ u, ∀ b_1 ∈ b :: v, a ≠ b_1) → (∀ i, i ∈ u → i ∈ v → + False) := by + classical + intro n b u v hparts i hiU hiV + have hcross := hparts.2.2 i hiU i (List.mem_cons_of_mem _ hiV) + exact hcross rfl + +private theorem hANodup : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), + let A := a :: (u ++ [b]) + (a ≠ b) → ((u.Nodup) → ((b ∉ u) → ((a ∉ u) → (A.Nodup)))) := by + classical + intro n a b u A hne huNodup hbNotU haNotU + apply List.nodup_cons.mpr + constructor + · intro ha + rcases List.mem_append.mp ha with hau | hab + · exact haNotU hau + · exact hne (List.mem_singleton.mp hab) + · apply List.nodup_append.mpr + exact ⟨huNodup, by simp, by + intro x hx y hy hxy + simp only [List.mem_singleton] at hy + have hxb : x = b := hxy.trans hy + exact hbNotU (hxb ▸ hx)⟩ + +private theorem hBNodup : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (v : List (Fin (n + 3))), + let B := b :: (v ++ [a]) + (a ≠ b) → ((v.Nodup) → ((b ∉ v) → ((a ∉ v) → (B.Nodup)))) := by + classical + intro n a b v B hne hvNodup hbNotV haNotV + apply List.nodup_cons.mpr + constructor + · intro hb + rcases List.mem_append.mp hb with hbv | hba + · exact hbNotV hbv + · exact hne.symm (List.mem_singleton.mp hba) + · apply List.nodup_append.mpr + exact ⟨hvNodup, by simp, by + intro x hx y hy hxy + simp only [List.mem_singleton] at hy + have hxa : x = a := hxy.trans hy + exact haNotV (hxa ▸ hx)⟩ + +private theorem hsets : + ∀ (n : Nat), (Fin (n + 3) → Real × Real) → (∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : + List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), (∃ k : Nat, (a :: (u ++ b :: v)).Sublist + ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) → ( + let A := a :: (u ++ [b]) + let B := b :: (v ++ [a]) + ((u ++ b :: v).Nodup) → ((a ≠ b) → ((u.Nodup ∧ (b :: v).Nodup ∧ ∀ a ∈ u, ∀ b_1 ∈ b :: v, a ≠ + b_1) → ((u.Nodup) → ((b ∉ u) → ((v.Nodup) → ((b ∉ v) → ((a ∉ u) → ((a ∉ v) → ((∀ i, i ∈ u + → i ∈ v → False) → ((A.Nodup) → ((B.Nodup) → ({i | i ∈ A} ∩ {i | i ∈ B} = {a, + b})))))))))))))) := by + classical + intro n q a b u v hcyclic A B htailNodup hne hparts huNodup hbNotU hvNodup hbNotV haNotU haNotV + huvDisjoint hANodup hBNodup + ext i + simp [A, B, List.mem_cons, List.mem_append]; aesop + +private theorem hnil : + ∀ (n : Nat), ∀ (xs : List (Fin (n + 3))), ([] : List (Fin (n + 3))).Sublist xs := by + classical + intro n xs + induction xs with + | nil => exact List.Sublist.slnil + | cons x xs ih => exact List.Sublist.cons x ih + +private theorem hnilv : + ∀ (n : Nat), ∀ (v : List (Fin (n + 3))), (∀ (xs : List (Fin (n + 3))), ([] : List (Fin (n + + 3))).Sublist xs) → ([].Sublist v) := by + classical + intro n v hnil + exact hnil v + +private theorem hbSub : + ∀ (n : Nat), ∀ (b : Fin (n + 3)), ∀ (v : List (Fin (n + 3))), ([].Sublist v) → (([b] : List + (Fin (n + 3))).Sublist (b :: v)) := by + classical + intro n b v hnilv + exact List.Sublist.cons_cons b hnilv + +private theorem hAtail : + ∀ (n : Nat), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + (([b] : List (Fin (n + 3))).Sublist (b :: v)) → ((u ++ [b]).Sublist (u ++ b :: v)) := by + classical + intro n b u v hbSub + exact List.Sublist.append (List.Sublist.refl u) hbSub + +private theorem hAsubL : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let A := a :: (u ++ [b]) + ((u ++ [b]).Sublist (u ++ b :: v)) → (A.Sublist L) := by + classical + intro n a b u v L A hAtail + exact List.Sublist.cons_cons a hAtail + +private theorem hrootlen : + ∀ (n : Nat), + let root := List.ofFn (fun i : Fin (n + 3) => i) + root.length = n + 3 := by + classical + intro n root + simp [root] + +private theorem hRval : + ∀ (n : Nat), ∀ (k : ℕ), + let root := List.ofFn (fun i : Fin (n + 3) => i) + let R := root.rotate k + (root.length = n + 3) → (∀ (j : Fin R.length), (R.get j).val = (j.val + k) % (n + 3)) := by + classical + intro n k root R hrootlen j + rw [List.get_rotate] + rw [List.get_ofFn] + simp only [Fin.val_cast, hrootlen] + +private theorem hrankDiff : + ∀ (n : Nat), (List (Fin (n + 3))) → (∀ (m : Nat), ∀ (k : Nat), ∀ (p : Nat), ∀ (s : Nat), (0 < + m) → ((p < m) → ((s < m) → ((p ≤ s) → ((((s+k)%m+m-((p+k)%m))%m) = s-p))))) := by + classical + intro n v m k p s hm hp hs hps + let x := (p + k) % m + let d := s-p + have hx : x < m := Nat.mod_lt _ hm + have hd : d < m := by omega + have hy : (s + k) % m = (x + d) % m := by + rw [show s + k = (p + k) + (s-p) by omega, Nat.add_mod, + Nat.mod_eq_of_lt hd] + rw [hy] + dsimp [d] + by_cases hwrap : x + (s-p) < m + · rw [Nat.mod_eq_of_lt hwrap, + show x + (s-p) + m - x = m + (s-p) by omega, Nat.add_mod] + simp? [Nat.mod_self] + exact Nat.mod_eq_of_lt hd + · have hwrap' : m ≤ x + (s-p) := by omega + have hmod : (x + (s-p)) % m = x + (s-p) - m := by + rw [Nat.mod_eq_sub_mod hwrap', + Nat.mod_eq_of_lt (by omega : x + (s-p) - m < m)] + rw [hmod, show x + (s-p) - m + m - x = s-p by omega, Nat.mod_eq_of_lt hd] + +private theorem hsourceA : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + (⟨0, by simp [L]⟩ : Fin L.length).val < + (⟨u.length+1, by simp [L]⟩ : Fin L.length).val := by + classical + intro n a b u v L + simp + +private theorem hsourceB : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), (0 < v.length) → ( + let L := a :: (u ++ b :: v) + u.length+1 < L.length) := by + classical + intro n a b u v hv L + simp only [L, List.length_cons, List.length_append] + omega + +private theorem haAtRoot : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + ∀ (k : ℕ), + let root := List.ofFn (fun i : Fin (n + 3) => i) + let R := root.rotate k + ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => + i).rotate k).length), (∀ (ix : Fin (a :: (u ++ b :: v)).length), (a :: (u ++ b :: v)).get + ix = ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k).get ((emb : Fin (a :: (u ++ + b :: v)).length → Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k).length) + ix)) → ( + let ia : Fin L.length := ⟨0, by simp [L]⟩ + R.get (emb ia) = a) := by + classical + intro n a b u v L k root R emb hemb ia + have h := hemb ia + calc + R.get (emb ia) = L.get ia := h.symm + _ = a := by simp [L, ia] + +private theorem hbAtRoot : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + ∀ (k : ℕ), + let root := List.ofFn (fun i : Fin (n + 3) => i) + let R := root.rotate k + ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => + i).rotate k).length), (∀ (ix : Fin (a :: (u ++ b :: v)).length), (a :: (u ++ b :: v)).get + ix = ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k).get ((emb : Fin (a :: (u ++ + b :: v)).length → Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k).length) + ix)) → (∀ (hsourceB : u.length+1 < L.length), + let ib : Fin L.length := ⟨u.length+1, hsourceB⟩ + R.get (emb ib) = b) := by + classical + intro n a b u v L k root R emb hemb hsourceB ib + have h := hemb ib + calc + R.get (emb ib) = L.get ib := h.symm + _ = b := by simp [L, ib] + +private theorem hrootOrder : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + ∀ (k : ℕ), ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : + ℕ))) => i).rotate k).length), ((⟨0, by simp [L]⟩ : Fin L.length).val < (⟨u.length+1, by + simp [L]⟩ : Fin L.length).val) → (∀ (hsourceB : u.length+1 < L.length), + let ia : Fin L.length := ⟨0, by simp [L]⟩ + let ib : Fin L.length := ⟨u.length+1, hsourceB⟩ + (emb ia).val < (emb ib).val) := by + classical + intro n a b u v L k emb hsourceA hsourceB ia ib + exact emb.lt_iff_lt.mpr hsourceA + +private theorem hBVsubDrop : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + ∀ (k : ℕ), + let root := List.ofFn (fun i : Fin (n + 3) => i) + let R := root.rotate k + ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => + i).rotate k).length), (∀ (ix : Fin (a :: (u ++ b :: v)).length), (a :: (u ++ b :: v)).get + ix = ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k).get ((emb : Fin (a :: (u ++ + b :: v)).length → Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k).length) + ix)) → (∀ (hsourceB : u.length+1 < L.length), + let ib : Fin L.length := ⟨u.length+1, hsourceB⟩ + (b :: v).Sublist (R.drop (emb ib).val)) := by + classical + intro n a b u v L k root R emb hemb hsourceB ib + apply List.sublist_iff_exists_fin_orderEmbedding_get_eq.mpr + let src (p : Fin (b :: v).length) : Fin L.length := + ⟨ib.val + p.val, by + have hLen : ib.val + (b :: v).length = L.length := by + simp only [ib, L, List.length_cons, List.length_append] + omega + exact (Nat.add_lt_add_left p.isLt ib.val).trans_eq hLen⟩ + let f (p : Fin (b :: v).length) : Fin (R.drop (emb ib).val).length := + ⟨(emb (src p)).val - (emb ib).val, by + have hs : ib ≤ src p := by + apply Fin.le_iff_val_le_val.mpr + change ib.val ≤ ib.val + p.val + exact Nat.le_add_right _ _ + have hm : (emb ib).val ≤ (emb (src p)).val := + Fin.le_iff_val_le_val.mp (emb.monotone hs) + have ht : (emb (src p)).val < R.length := (emb (src p)).isLt + simp only [List.length_drop] + omega⟩ + have hf : StrictMono f := by + intro p q hpq + apply Fin.lt_def.mpr + have hpq' : (src p).val < (src q).val := by + change ib.val + p.val < ib.val + q.val + exact Nat.add_lt_add_left (Fin.lt_def.mp hpq) _ + have he : (emb (src p)).val < (emb (src q)).val := + Fin.lt_def.mp (emb.strictMono hpq') + have hpLower : (emb ib).val ≤ (emb (src p)).val := by + apply Fin.le_iff_val_le_val.mp (emb.monotone _) + apply Fin.le_iff_val_le_val.mpr + change ib.val ≤ ib.val+p.val + exact Nat.le_add_right _ _ + have hqLower : (emb ib).val ≤ (emb (src q)).val := by + apply Fin.le_iff_val_le_val.mp (emb.monotone _) + apply Fin.le_iff_val_le_val.mpr + change ib.val ≤ ib.val+q.val + exact Nat.le_add_right _ _ + simp only [f] + omega + refine ⟨OrderEmbedding.ofStrictMono f hf, ?_⟩ + intro p + have hsrc : (b :: v).get p = L.get (src p) := by + refine Fin.cases ?_ ?_ p + · simp [L, ib, src] + · intro j + have hix : (src (Fin.succ j)).val = u.length + (j.val+1) + 1 := by + simp [src, ib] + omega + have htail : L.get ⟨u.length+(j.val+1)+1, by + simp only [L, List.length_cons, List.length_append, List.length_cons] + omega⟩ = v.get j := by + rw [List.get_eq_getElem, List.get_eq_getElem] + change (a :: (u ++ b :: v))[(u.length+(j.val+1))+1] = v[j.val] + rw [List.getElem_cons_succ] + rw [List.getElem_append_right (by omega)] + simp [List.getElem_cons_succ] + calc + (b :: v).get (Fin.succ j) = v.get j := by rfl + _ = L.get ⟨u.length+(j.val+1)+1, by + simp only [L, List.length_cons, List.length_append, List.length_cons] + omega⟩ := htail.symm + _ = L.get (src (Fin.succ j)) := by + congr 1 + exact Fin.ext hix.symm + calc + (b :: v).get p = L.get (src p) := hsrc + _ = R.get (emb (src p)) := hemb (src p) + _ = (R.drop (emb ib).val).get (f p) := by + change R[(emb (src p)).val] = (R.drop (emb ib).val)[(f p).val] + rw [List.getElem_drop] + have hm : (emb ib).val ≤ (emb (src p)).val := by + exact Fin.le_iff_val_le_val.mp (emb.monotone (Fin.le_iff_val_le_val.mpr + (by change ib.val ≤ ib.val+p.val; exact Nat.le_add_right _ _))) + have heq : (emb ib).val + (f p).val = (emb (src p)).val := by + simp only [f] + exact Nat.add_sub_of_le hm + simp only [heq] + +private theorem hAsingleTake : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + ∀ (k : ℕ), + let root := List.ofFn (fun i : Fin (n + 3) => i) + let R := root.rotate k + ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => + i).rotate k).length), ∀ (hsourceB : u.length+1 < L.length), + let ia : Fin L.length := ⟨0, by simp [L]⟩ + let ib : Fin L.length := ⟨u.length+1, hsourceB⟩ + (R.get (emb ia) = a) → (((emb ia).val < (emb ib).val) → (([a] : List (Fin (n+3))).Sublist + (R.take (emb ib).val))) := by + classical + intro n a b u v L k root R emb hsourceB ia ib haAtRoot hrootOrder + let ip : Fin (R.take (emb ib).val).length := ⟨(emb ia).val, by + rw [List.length_take] + apply Nat.lt_min.mpr + exact ⟨Fin.lt_def.mp hrootOrder, (emb ia).isLt⟩⟩ + apply List.sublist_iff_exists_fin_orderEmbedding_get_eq.mpr + let f : Fin 1 → Fin (R.take (emb ib).val).length := fun _ => ip + have hf : StrictMono f := by + intro x y hxy + have : x.val < y.val := Fin.lt_def.mp hxy + have : False := by omega + exact this.elim + refine ⟨OrderEmbedding.ofStrictMono f hf, ?_⟩ + intro ix + have hx : ix = 0 := Fin.eq_zero ix + rw [hx] + change a = (R.take (emb ib).val).get ip + rw [List.get_eq_getElem, List.getElem_take] + change a = R.get (emb ia) + exact haAtRoot.symm + +private theorem hBsubAtB : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let B := b :: (v ++ [a]) + ∀ (k : ℕ), + let root := List.ofFn (fun i : Fin (n + 3) => i) + let R := root.rotate k + ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => + i).rotate k).length), ∀ (hsourceB : u.length+1 < L.length), + let ib : Fin L.length := ⟨u.length+1, hsourceB⟩ + ((b :: v).Sublist (R.drop (emb ib).val)) → ((([a] : List (Fin (n+3))).Sublist (R.take (emb + ib).val)) → (B.Sublist (R.rotate (emb ib).val))) := by + classical + intro n a b u v L B k root R emb hsourceB ib hBVsubDrop hAsingleTake + have hconcat : B.Sublist (R.drop (emb ib).val ++ R.take (emb ib).val) := by + change (b :: v ++ [a]).Sublist _ + exact List.Sublist.append hBVsubDrop hAsingleTake + rw [List.rotate_eq_drop_append_take (by exact (emb ib).isLt.le)] + exact hconcat + +private theorem hBsubRoot : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let B := b :: (v ++ [a]) + ∀ (k : ℕ), + let root := List.ofFn (fun i : Fin (n + 3) => i) + let R := root.rotate k + ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => + i).rotate k).length), ∀ (hsourceB : u.length+1 < L.length), + let ib : Fin L.length := ⟨u.length+1, hsourceB⟩ + (B.Sublist (R.rotate (emb ib).val)) → (∃ k : Nat, B.Sublist (root.rotate k)) := by + classical + intro n a b u v L B k root R emb hsourceB ib hBsubAtB + refine ⟨k + (emb ib).val, ?_⟩ + simpa [R, root, List.rotate_rotate] using hBsubAtB + +private theorem hvalA : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + ∀ (k : ℕ), + let root := List.ofFn (fun i : Fin (n + 3) => i) + let R := root.rotate k + ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => + i).rotate k).length), (∀ (j : Fin R.length), (R.get j).val = (j.val + k) % (n + 3)) → ( + let ia : Fin L.length := ⟨0, by simp [L]⟩ + (R.get (emb ia) = a) → (a.val = ((emb ia).val + k) % (n + 3))) := by + classical + intro n a b u v L k root R emb hRval ia haAtRoot + rw [← haAtRoot] + exact hRval (emb ia) + +private theorem hvalB : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + ∀ (k : ℕ), + let root := List.ofFn (fun i : Fin (n + 3) => i) + let R := root.rotate k + ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => + i).rotate k).length), (∀ (j : Fin R.length), (R.get j).val = (j.val + k) % (n + 3)) → (∀ + (hsourceB : u.length+1 < L.length), + let ib : Fin L.length := ⟨u.length+1, hsourceB⟩ + (R.get (emb ib) = b) → (b.val = ((emb ib).val + k) % (n + 3))) := by + classical + intro n a b u v L k root R emb hRval hsourceB ib hbAtRoot + calc + b.val = (R.get (emb ib)).val := congrArg Fin.val hbAtRoot.symm + _ = ((emb ib).val + k) % (n + 3) := hRval (emb ib) + +private theorem hrankB : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + ∀ (k : ℕ), ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : + ℕ))) => i).rotate k).length), (∀ (m : Nat), ∀ (k : Nat), ∀ (p : Nat), ∀ (s : Nat), (0 < + m) → ((p < m) → ((s < m) → ((p ≤ s) → ((((s+k)%m+m-((p+k)%m))%m) = s-p))))) → (∀ + (hsourceB : u.length+1 < L.length), + let ia : Fin L.length := ⟨0, by simp [L]⟩ + let ib : Fin L.length := ⟨u.length+1, hsourceB⟩ + ((emb ia).val < (emb ib).val) → ((a.val = ((emb ia).val + k) % (n + 3)) → ((b.val = ((emb + ib).val + k) % (n + 3)) → (((b.val + (n+3) - a.val) % (n+3)) = + (emb ib).val - (emb ia).val)))) := by + classical + intro n a b u v L k emb hrankDiff hsourceB ia ib hrootOrder hvalA hvalB + calc + ((b.val + (n+3) - a.val) % (n+3)) = + (((emb ib).val + k) % (n+3) + (n+3) - + ((emb ia).val + k) % (n+3)) % (n+3) := by rw [hvalB, hvalA] + _ = (emb ib).val - (emb ia).val := by + apply hrankDiff (n+3) k (emb ia).val (emb ib).val + · omega + · have h := (emb ia).isLt + simp [] at h + omega + · have h := (emb ib).isLt + simp [] at h + omega + · exact hrootOrder.le + +private theorem hrankB' : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + ∀ (k : ℕ), ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : + ℕ))) => i).rotate k).length), ∀ (hsourceB : u.length+1 < L.length), + let ia : Fin L.length := ⟨0, by simp [L]⟩ + let ib : Fin L.length := ⟨u.length+1, hsourceB⟩ + (((b.val + (n+3) - a.val) % (n+3)) = (emb ib).val - (emb ia).val) → ( + let rank := fun i : Fin (n+3) => (i.val + (n+3) - a.val) % (n+3) + rank b = (emb ib).val - (emb ia).val) := by + classical + intro n a b u v L k emb hsourceB ia ib hrankB rank + simpa [rank] using hrankB + +private theorem hrankAt : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + ∀ (k : ℕ), + let root := List.ofFn (fun i : Fin (n + 3) => i) + let R := root.rotate k + ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => + i).rotate k).length), (∀ (ix : Fin (a :: (u ++ b :: v)).length), (a :: (u ++ b :: v)).get + ix = ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k).get ((emb : Fin (a :: (u ++ + b :: v)).length → Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k).length) + ix)) → ((∀ (j : Fin R.length), (R.get j).val = (j.val + k) % (n + 3)) → ((∀ (m : Nat), ∀ + (k : Nat), ∀ (p : Nat), ∀ (s : Nat), (0 < m) → ((p < m) → ((s < m) → ((p ≤ s) → + ((((s+k)%m+m-((p+k)%m))%m) = s-p))))) → ((u.length+1 < L.length) → ( + let ia : Fin L.length := ⟨0, by simp [L]⟩ + (a.val = ((emb ia).val + k) % (n + 3)) → ( + let rank := fun i : Fin (n+3) => (i.val + (n+3) - a.val) % (n+3) + ∀ (p : Fin L.length), (ia ≤ p) → (∀ (i : Fin (n+3)), (L.get p = i) → (rank i = (emb p).val - + (emb ia).val))))))) := by + classical + intro n a b u v L k root R emb hemb hRval hrankDiff hsourceB ia hvalA rank p hp i hpi + have hvalI : i.val = ((emb p).val + k) % (n+3) := by + calc + i.val = (R.get (emb p)).val := (congrArg Fin.val ((hemb p).symm.trans hpi)).symm + _ = ((emb p).val+k)%(n+3) := hRval (emb p) + calc + rank i = (((emb p).val+k)%(n+3)+(n+3)-((emb ia).val+k)%(n+3))%(n+3) := by + dsimp [rank] + rw [hvalI, hvalA] + _ = (emb p).val-(emb ia).val := by + apply hrankDiff (n+3) k (emb ia).val (emb p).val + · omega + · have h := (emb ia).isLt + simp [] at h + omega + · have h := (emb p).isLt + simp [] at h + omega + · exact emb.monotone hp + +private theorem hrankU : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), (0 < v.length) → ( + let L := a :: (u ++ b :: v) + ∀ (k : ℕ), ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : + ℕ))) => i).rotate k).length), ∀ (hsourceB : u.length+1 < L.length), + let ia : Fin L.length := ⟨0, by simp [L]⟩ + let ib : Fin L.length := ⟨u.length+1, hsourceB⟩ + ((emb ia).val < (emb ib).val) → ( + let rank := fun i : Fin (n+3) => (i.val + (n+3) - a.val) % (n+3) + (rank b = (emb ib).val - (emb ia).val) → ((∀ (p : Fin L.length), (ia ≤ p) → (∀ (i : Fin + (n+3)), (L.get p = i) → (rank i = (emb p).val - (emb ia).val))) → (∀ (i : Fin (n+3)), (i + ∈ u) → (0 < rank i ∧ rank i < rank b))))) := by + classical + intro n a b u v hv L k emb hsourceB ia ib hrootOrder rank hrankB' hrankAt i hi + obtain ⟨j, hj, hji⟩ := List.getElem_of_mem hi + have hpBound : j+1 < L.length := by simp [L]; omega + let p : Fin L.length := ⟨j+1, hpBound⟩ + have hpi : L.get p = i := by + rw [List.get_eq_getElem] + change (a :: (u ++ b :: v))[j+1] = i + rw [List.getElem_cons_succ, List.getElem_append_left hj, hji] + have hpos : ia < p := by + apply Fin.lt_def.mpr + simp [ia, p] + have hposB : p < ib := by + apply Fin.lt_def.mpr + simp [ib, p] + omega + have hr := hrankAt p hpos.le i hpi + constructor + · rw [hr] + have he : (emb ia).val < (emb p).val := emb.lt_iff_lt.mpr hpos + omega + · rw [hr, hrankB'] + have he1 : (emb ia).val < (emb p).val := emb.lt_iff_lt.mpr hpos + have he2 : (emb p).val < (emb ib).val := emb.lt_iff_lt.mpr hposB + omega + +private theorem hrankV : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + ∀ (k : ℕ), ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : + ℕ))) => i).rotate k).length), ∀ (hsourceB : u.length+1 < L.length), + let ia : Fin L.length := ⟨0, by simp [L]⟩ + let ib : Fin L.length := ⟨u.length+1, hsourceB⟩ + ((emb ia).val < (emb ib).val) → ( + let rank := fun i : Fin (n+3) => (i.val + (n+3) - a.val) % (n+3) + (rank b = (emb ib).val - (emb ia).val) → ((∀ (p : Fin L.length), (ia ≤ p) → (∀ (i : Fin + (n+3)), (L.get p = i) → (rank i = (emb p).val - (emb ia).val))) → (∀ (i : Fin (n+3)), (i + ∈ v) → (rank b < rank i)))) := by + classical + intro n a b u v L k emb hsourceB ia ib hrootOrder rank hrankB' hrankAt i hi + obtain ⟨j, hj, hji⟩ := List.getElem_of_mem hi + have hpBound : u.length+1+j+1 < L.length := by simp [L]; omega + let p : Fin L.length := ⟨u.length+1+j+1, hpBound⟩ + have hpi : L.get p = i := by + rw [List.get_eq_getElem] + change (a :: (u ++ b :: v))[u.length+1+j+1] = i + rw [List.getElem_cons_succ] + rw [List.getElem_append_right (by omega)] + have hidx : u.length+1+j-u.length = j+1 := by omega + simpa [hidx] using hji + have hposB : ib < p := by + apply Fin.lt_def.mpr + simp [ib, p] + have hiaB : ia ≤ ib := by + apply Fin.le_iff_val_le_val.mpr + simp [ia, ib] + have hr := hrankAt p (hiaB.trans hposB.le) i hpi + rw [hr, hrankB'] + have he1 : (emb ia).val < (emb ib).val := hrootOrder + have he2 : (emb ib).val < (emb p).val := emb.lt_iff_lt.mpr hposB + omega + +private theorem hrankFormula : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + ∀ (k : ℕ), + let root := List.ofFn (fun i : Fin (n + 3) => i) + let R := root.rotate k + ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => + i).rotate k).length), (u.length+1 < L.length) → ( + let ia : Fin L.length := ⟨0, by simp [L]⟩ + (R.get (emb ia) = a) → ((a.val = ((emb ia).val + k) % (n + 3)) → ( + let rank := fun i : Fin (n+3) => (i.val + (n+3) - a.val) % (n+3) + ∀ (i : Fin (n+3)), rank i = + if a.val ≤ i.val then i.val-a.val else n+3-a.val+i.val))) := by + classical + intro n a b u v L k root R emb hsourceB ia haAtRoot hvalA rank i + by_cases h : a.val ≤ i.val + · have heq : i.val+(n+3)-a.val = (n+3)+(i.val-a.val) := by omega + simp [rank, h, heq, Nat.mod_eq_of_lt (by omega : i.val-a.val < n+3)] + · have heq : i.val+(n+3)-a.val = n+3-a.val+i.val := by omega + simp [rank, h, heq, Nat.mod_eq_of_lt (by omega : n+3-a.val+i.val < n+3)] + +private theorem hrankHi : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), + let rank := fun i : Fin (n+3) => (i.val + (n+3) - a.val) % (n+3) + (∀ (i : Fin (n+3)), rank i = if a.val ≤ i.val then i.val-a.val else n+3-a.val+i.val) → (∀ (i + : Fin (n+3)), (a.val ≤ i.val) → (rank i = i.val-a.val)) := by + classical + intro n a rank hrankFormula i h + rw [hrankFormula i, ite_eq_left h] + +private theorem hrankLo : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), + let rank := fun i : Fin (n+3) => (i.val + (n+3) - a.val) % (n+3) + (∀ (i : Fin (n+3)), rank i = if a.val ≤ i.val then i.val-a.val else n+3-a.val+i.val) → (∀ (i + : Fin (n+3)), (¬ a.val ≤ i.val) → (rank i = n+3-a.val+i.val)) := by + classical + intro n a rank hrankFormula i h + rw [hrankFormula i, ite_eq_right h] + +private theorem hAsubRoot : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let A := a :: (u ++ [b]) + (A.Sublist L) → (∀ (k : ℕ), ((a :: (u ++ b :: v)).Sublist ((List.ofFn fun (i : Fin (n + (3 : + ℕ))) => i).rotate k)) → (∃ k : Nat, A.Sublist + ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k))) := by + classical + intro n a b u v L A hAsubL k hLrot + exact ⟨k, hAsubL.trans hLrot⟩ + +private theorem hdet : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), (∀ i, q i = ((i.val : Real), (i.val : Real) ^ + 2)) → (∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + ∀ (c : Fin (n + 3)), D (q c) = ((b.val : Real) - a.val) * + ((c.val : Real) - a.val) * ((c.val : Real) - b.val)) := by + classical + intro n q hq a b D c + simp [D, P3381T1TriangleDeterminant, hq] + ring + +private theorem hDform : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), (∀ i, q i = ((i.val : Real), (i.val : Real) ^ + 2)) → (∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + ∀ (z : Real × Real), D z = ((b.val : Real) - a.val) * + (z.2 - ((a.val : Real)+(b.val : Real))*z.1 + a.val*b.val)) := by + classical + intro n q hq a b D z + simp [D, P3381T1TriangleDeterminant, hq] + ring + +private theorem hTaConv : + ∀ (n : Nat), ∀ (c : Fin (n+3)), Convex Real {z : Real × Real | 0 ≤ z.2 - 2*(c.val : Real)*z.1 + + (c.val : Real)^2} := by + classical + intro n c + rw [convex_iff_div] + intro x hx y hy r s hr hs hrs + change 0 ≤ x.2 - 2*(c.val : Real)*x.1 + (c.val : Real)^2 at hx + change 0 ≤ y.2 - 2*(c.val : Real)*y.1 + (c.val : Real)^2 at hy + change 0 ≤ (((r/(r+s)) • x + (s/(r+s)) • y).2 - + 2*(c.val : Real)*((r/(r+s)) • x + (s/(r+s)) • y).1 + (c.val : Real)^2) + simp only [Prod.smul_fst, Prod.smul_snd, Prod.fst_add, Prod.snd_add, smul_eq_mul] + have hw : r/(r+s)+s/(r+s)=1 := by rw [← add_div, div_self hrs.ne'] + have hlin : r/(r+s)*x.2+s/(r+s)*y.2 - + 2*(c.val : Real)*(r/(r+s)*x.1+s/(r+s)*y.1)+(c.val : Real)^2 = + r/(r+s)*(x.2-2*(c.val : Real)*x.1+(c.val : Real)^2) + + s/(r+s)*(y.2-2*(c.val : Real)*y.1+(c.val : Real)^2) := by + calc + _ = r/(r+s)*(x.2-2*(c.val : Real)*x.1+(c.val : Real)^2) + + s/(r+s)*(y.2-2*(c.val : Real)*y.1+(c.val : Real)^2) + + (c.val : Real)^2*(1-(r/(r+s)+s/(r+s))) := by ring + _ = _ := by rw [hw]; ring + rw [hlin] + exact add_nonneg (mul_nonneg (div_nonneg hr hrs.le) hx) + (mul_nonneg (div_nonneg hs hrs.le) hy) + +private theorem hTaV : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), (∀ i, q i = ((i.val : Real), (i.val : Real) ^ + 2)) → (∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : List + (Fin (n + 3))), + let L := a :: (u ++ b :: v) + q '' {i | i ∈ L} ⊆ + {z : Real × Real | 0 ≤ z.2 - 2*(a.val : Real)*z.1 + (a.val : Real)^2}) := by + classical + intro n q hq a b u v L + rintro z ⟨i, hi, rfl⟩ + change 0 ≤ (q i).2 - 2*(a.val : Real)*(q i).1 + (a.val : Real)^2 + rw [hq i] + have hsquare : 0 ≤ ((i.val : Real)-(a.val : Real))^2 := sq_nonneg _ + nlinarith [hsquare] + +private theorem hTbV : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), (∀ i, q i = ((i.val : Real), (i.val : Real) ^ + 2)) → (∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : List + (Fin (n + 3))), + let L := a :: (u ++ b :: v) + q '' {i | i ∈ L} ⊆ + {z : Real × Real | 0 ≤ z.2 - 2*(b.val : Real)*z.1 + (b.val : Real)^2}) := by + classical + intro n q hq a b u v L + rintro z ⟨i, hi, rfl⟩ + change 0 ≤ (q i).2 - 2*(b.val : Real)*(q i).1 + (b.val : Real)^2 + rw [hq i] + have hsquare : 0 ≤ ((i.val : Real)-(b.val : Real))^2 := sq_nonneg _ + nlinarith [hsquare] + +private theorem hTaH : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let H := convexHull Real (q '' {i | i ∈ L}) + (∀ (c : Fin (n+3)), Convex Real {z : Real × Real | 0 ≤ z.2 - 2*(c.val : Real)*z.1 + (c.val : + Real)^2}) → ((q '' {i | i ∈ L} ⊆ {z : Real × Real | 0 ≤ z.2 - 2*(a.val : Real)*z.1 + + (a.val : Real)^2}) → (H ⊆ {z : Real × Real | 0 ≤ z.2 - 2*(a.val : Real)*z.1 + (a.val : + Real)^2})) := by + classical + intro n q a b u v L H hTaConv hTaV + exact convexHull_min hTaV (hTaConv a) + +private theorem hTbH : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let H := convexHull Real (q '' {i | i ∈ L}) + (∀ (c : Fin (n+3)), Convex Real {z : Real × Real | 0 ≤ z.2 - 2*(c.val : Real)*z.1 + (c.val : + Real)^2}) → ((q '' {i | i ∈ L} ⊆ {z : Real × Real | 0 ≤ z.2 - 2*(b.val : Real)*z.1 + + (b.val : Real)^2}) → (H ⊆ {z : Real × Real | 0 ≤ z.2 - 2*(b.val : Real)*z.1 + (b.val : + Real)^2})) := by + classical + intro n q a b u v L H hTaConv hTbV + exact convexHull_min hTbV (hTaConv b) + +private theorem haH : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let H := convexHull Real (q '' {i | i ∈ L}) + q a ∈ H := by + classical + intro n q a b u v L H + exact subset_convexHull Real _ ⟨a, by simp [L]⟩ + +private theorem hbH : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let H := convexHull Real (q '' {i | i ∈ L}) + q b ∈ H := by + classical + intro n q a b u v L H + exact subset_convexHull Real _ ⟨b, by simp [L]⟩ + +private theorem hsegH : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let H := convexHull Real (q '' {i | i ∈ L}) + (q a ∈ H) → ((q b ∈ H) → (segment Real (q a) (q b) ⊆ H)) := by + classical + intro n q a b u v L H haH hbH + exact (convex_convexHull Real (q '' {i | i ∈ L})).segment_subset haH hbH + +private theorem hneR : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), (a ≠ b) → ((b.val : Real)-(a.val : + Real) ≠ 0) := by + classical + intro n a b hne he + apply hne + exact Fin.ext (by exact_mod_cast (sub_eq_zero.mp he).symm) + +private theorem hFfromD : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (∀ (z : Real × Real), D z = ((b.val : Real) - a.val) * (z.2 - ((a.val : Real)+(b.val : + Real))*z.1 + a.val*b.val)) → ( + let F := fun z : Real × Real => z.2 - + ((a.val : Real)+(b.val : Real))*z.1 + (a.val : Real)*(b.val : Real) + ((b.val : Real)-(a.val : Real) ≠ 0) → (∀ (z : Real × Real), (D z = 0) → (F z = 0))) := by + classical + intro n q a b D hDform F hneR z hDz + rw [hDform] at hDz + dsimp [F] + exact (mul_eq_zero.mp hDz).resolve_left hneR + +private theorem hTaLine : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), + let F := fun z : Real × Real => z.2 - + ((a.val : Real)+(b.val : Real))*z.1 + (a.val : Real)*(b.val : Real) + ∀ (z : Real × Real), (F z = 0) → (z.2 - 2*(a.val : Real)*z.1 + (a.val : Real)^2 = + ((b.val : Real)-(a.val : Real))*(z.1-(a.val : Real))) := by + classical + intro n a b F z hf + dsimp [F] at hf + nlinarith + +private theorem hTbLine : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), + let F := fun z : Real × Real => z.2 - + ((a.val : Real)+(b.val : Real))*z.1 + (a.val : Real)*(b.val : Real) + ∀ (z : Real × Real), (F z = 0) → (z.2 - 2*(b.val : Real)*z.1 + (b.val : Real)^2 = + ((a.val : Real)-(b.val : Real))*(z.1-(b.val : Real))) := by + classical + intro n a b F z hf + dsimp [F] at hf + nlinarith + +private theorem chordMemberInc : + ∀ (A : Real), ∀ (B : Real), ∀ (X : Real), ∀ (Y : Real), (A < B) → ((Y-(A+B)*X+A*B=0) → ((A ≤ + X) → ((X ≤ B) → ((X,Y) ∈ segment Real (A,A^2) (B,B^2))))) := by + classical + intro A B X Y hab hF hAX hXB + rw [segment_eq_image_lineMap] + rw [Set.mem_image] + let t := (X-A)/(B-A) + refine ⟨t, ?_, ?_⟩ + · constructor + · dsimp [t] + exact div_nonneg (sub_nonneg.mpr hAX) (sub_nonneg.mpr hab.le) + · dsimp [t] + rw [div_le_one (sub_pos.mpr hab)] + linarith + · rw [AffineMap.lineMap_apply_module] + ext <;> simp only [Prod.smul_fst, Prod.smul_snd, Prod.fst_add, Prod.snd_add, smul_eq_mul] + · dsimp [t] + field_simp [ne_of_gt (sub_pos.mpr hab)] + ring + · dsimp [t] + field_simp [ne_of_gt (sub_pos.mpr hab)] + nlinarith [hF] + +private theorem hsegD : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), (∀ i, q i = ((i.val : Real), (i.val : Real) ^ + 2)) → (∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (∀ (z : Real × Real), D z = ((b.val : Real) - a.val) * (z.2 - ((a.val : Real)+(b.val : + Real))*z.1 + a.val*b.val)) → (segment Real (q a) (q b) ⊆ {z | D z = 0})) := by + classical + intro n q hq a b D hDform z hz + rw [segment_eq_image_lineMap] at hz + rw [Set.mem_image] at hz + obtain ⟨t, ht, hzt⟩ := hz + change D z = 0 + rw [← hzt, hDform, AffineMap.lineMap_apply_module] + simp only [Prod.smul_fst, Prod.smul_snd, Prod.fst_add, Prod.snd_add, smul_eq_mul] + rw [hq a, hq b] + simp only [] + ring + +private theorem hzeroLine : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), (∀ i, q i = ((i.val : Real), (i.val : Real) ^ + 2)) → (∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : List + (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let H := convexHull Real (q '' {i | i ∈ L}) + (a ≠ b) → ( + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (H ⊆ {z : Real × Real | 0 ≤ z.2 - 2*(a.val : Real)*z.1 + (a.val : Real)^2}) → ((H ⊆ {z : Real + × Real | 0 ≤ z.2 - 2*(b.val : Real)*z.1 + (b.val : Real)^2}) → ((segment Real (q a) (q b) + ⊆ H) → ( + let F := fun z : Real × Real => z.2 - + ((a.val : Real)+(b.val : Real))*z.1 + (a.val : Real)*(b.val : Real) + (∀ (z : Real × Real), (D z = 0) → (F z = 0)) → ((∀ (z : Real × Real), (F z = 0) → (z.2 - + 2*(a.val : Real)*z.1 + (a.val : Real)^2 = ((b.val : Real)-(a.val : Real))*(z.1-(a.val : + Real)))) → ((∀ (z : Real × Real), (F z = 0) → (z.2 - 2*(b.val : Real)*z.1 + (b.val : + Real)^2 = ((a.val : Real)-(b.val : Real))*(z.1-(b.val : Real)))) → ((∀ (A : Real), ∀ (B : + Real), ∀ (X : Real), ∀ (Y : Real), (A < B) → ((Y-(A+B)*X+A*B=0) → ((A ≤ X) → ((X ≤ B) → + ((X,Y) ∈ segment Real (A,A^2) (B,B^2)))))) → ((segment Real (q a) (q b) ⊆ {z | D z = 0}) + → (H ∩ {z | D z = 0} = segment Real (q a) (q b))))))))))) := by + classical + intro n q hq a b u v L H hne D hTaH hTbH hsegH F hFfromD hTaLine hTbLine chordMemberInc hsegD + ext z + constructor + · rintro ⟨hzH, hDz⟩ + have hf := hFfromD z hDz + have hTa := hTaH hzH + have hTb := hTbH hzH + have hTa' : 0 ≤ z.2 - 2*(a.val : Real)*z.1 + (a.val : Real)^2 := hTa + have hTb' : 0 ≤ z.2 - 2*(b.val : Real)*z.1 + (b.val : Real)^2 := hTb + have hxy : (z.1,z.2) ∈ segment Real + ((a.val : Real),(a.val : Real)^2) ((b.val : Real),(b.val : Real)^2) := by + by_cases hab : a.val < b.val + · have hAX : (a.val : Real) ≤ z.1 := by + rw [hTaLine z hf] at hTa' + have habR : (a.val : Real) < (b.val : Real) := by exact_mod_cast hab + have hnonneg := (mul_nonneg_iff_of_pos_left (sub_pos.mpr habR)).mp hTa' + linarith + have hXB : z.1 ≤ (b.val : Real) := by + rw [hTbLine z hf] at hTb' + have habR : (a.val : Real) < (b.val : Real) := by exact_mod_cast hab + have hpos : 0 < (b.val : Real)-(a.val : Real) := sub_pos.mpr habR + have hnonneg : 0 ≤ ((b.val : Real)-(a.val : Real))*((b.val : Real)-z.1) := by + rw [show ((b.val : Real)-(a.val : Real))*((b.val : Real)-z.1) = + ((a.val : Real)-(b.val : Real))*(z.1-(b.val : Real)) by ring] + exact hTb' + have hx := (mul_nonneg_iff_of_pos_left hpos).mp hnonneg + linarith + exact chordMemberInc _ _ _ _ (by exact_mod_cast hab) hf hAX hXB + · have hba : b.val < a.val := by + rcases Nat.lt_trichotomy b.val a.val with hba | heq | hlt + · exact hba + · exact False.elim (hne (Fin.ext heq.symm)) + · exact (hab hlt).elim + have hBX : (b.val : Real) ≤ z.1 := by + rw [hTbLine z hf] at hTb' + have hbaR : (b.val : Real) < (a.val : Real) := by exact_mod_cast hba + have hnonneg := (mul_nonneg_iff_of_pos_left (sub_pos.mpr hbaR)).mp hTb' + linarith + have hXA : z.1 ≤ (a.val : Real) := by + rw [hTaLine z hf] at hTa' + have hbaR : (b.val : Real) < (a.val : Real) := by exact_mod_cast hba + have hpos : 0 < (a.val : Real)-(b.val : Real) := sub_pos.mpr hbaR + have hnonneg : 0 ≤ ((a.val : Real)-(b.val : Real))*((a.val : Real)-z.1) := by + rw [show ((a.val : Real)-(b.val : Real))*((a.val : Real)-z.1) = + ((b.val : Real)-(a.val : Real))*(z.1-(a.val : Real)) by ring] + exact hTa' + have hx := (mul_nonneg_iff_of_pos_left hpos).mp hnonneg + linarith + have hf' : z.2 - ((b.val : Real)+(a.val : Real))*z.1 + + (b.val : Real)*(a.val : Real) = 0 := by + rw [add_comm (b.val : Real) (a.val : Real), mul_comm (b.val : Real) (a.val : Real)] + exact hf + have hh := chordMemberInc (b.val : Real) (a.val : Real) z.1 z.2 + (by exact_mod_cast hba) hf' hBX hXA + have hsym := segment_symm Real + ((b.val : Real),(b.val : Real)^2) ((a.val : Real),(a.val : Real)^2) + rw [hsym] at hh + exact hh + simpa only [hq a, hq b] using hxy + · intro hz + constructor + · exact hsegH hz + · exact hsegD hz + +private theorem hBcyclic : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (v : List (Fin (n + 3))), + let B := b :: (v ++ [a]) + let root := List.ofFn (fun i : Fin (n + 3) => i) + (∃ k : Nat, B.Sublist (root.rotate k)) → (∃ k : Nat, B.Sublist + ((List.ofFn (fun i : Fin (n+3) => i)).rotate k)) := by + classical + intro n a b v B root hBsubRoot + simpa [root] using hBsubRoot + +private theorem hDcombo : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (∀ (z : Real × Real), D z = ((b.val : Real) - a.val) * (z.2 - ((a.val : Real)+(b.val : + Real))*z.1 + a.val*b.val)) → (∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (r : Real), ∀ + (s : Real), (r+s ≠ 0) → (D ((r/(r+s)) • x + (s/(r+s)) • y) = + r/(r+s)*D x + s/(r+s)*D y)) := by + classical + intro n q a b D hDform x y r s hrs + have hw : r/(r+s)+s/(r+s)=1 := by rw [← add_div, div_self hrs] + calc + D ((r/(r+s)) • x + (s/(r+s)) • y) = + r/(r+s)*D x + s/(r+s)*D y + + ((b.val : Real)-(a.val : Real))*(a.val : Real)*(b.val : Real)* + (1-(r/(r+s)+s/(r+s))) := by + rw [hDform, hDform x, hDform y] + simp only [Prod.smul_fst, Prod.smul_snd, Prod.fst_add, Prod.snd_add, smul_eq_mul] + ring + _ = r/(r+s)*D x + s/(r+s)*D y := by rw [hw]; ring + +private theorem hDleConv : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (r : Real), ∀ (s : Real), (r+s ≠ 0) → (D + ((r/(r+s)) • x + (s/(r+s)) • y) = r/(r+s)*D x + s/(r+s)*D y)) → (Convex Real {z : Real × + Real | D z ≤ 0}) := by + classical + intro n q a b D hDcombo + rw [convex_iff_div] + intro x hx y hy r s hr hs hrs + change D x ≤ 0 at hx + change D y ≤ 0 at hy + change D ((r/(r+s)) • x + (s/(r+s)) • y) ≤ 0 + rw [hDcombo x y r s hrs.ne'] + exact add_nonpos + (mul_nonpos_of_nonneg_of_nonpos (div_nonneg hr hrs.le) hx) + (mul_nonpos_of_nonneg_of_nonpos (div_nonneg hs hrs.le) hy) + +private theorem hDgeConv : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (r : Real), ∀ (s : Real), (r+s ≠ 0) → (D + ((r/(r+s)) • x + (s/(r+s)) • y) = r/(r+s)*D x + s/(r+s)*D y)) → (Convex Real {z : Real × + Real | 0 ≤ D z}) := by + classical + intro n q a b D hDcombo + rw [convex_iff_div] + intro x hx y hy r s hr hs hrs + change 0 ≤ D x at hx + change 0 ≤ D y at hy + change 0 ≤ D ((r/(r+s)) • x + (s/(r+s)) • y) + rw [hDcombo x y r s hrs.ne'] + exact add_nonneg + (mul_nonneg (div_nonneg hr hrs.le) hx) + (mul_nonneg (div_nonneg hs hrs.le) hy) + +private theorem hUneg : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), (List (Fin (n + 3))) → ((a ≠ b) → ( + let rank := fun i : Fin (n+3) => (i.val + (n+3) - a.val) % (n+3) + (∀ (i : Fin (n+3)), (i ∈ u) → (0 < rank i ∧ rank i < rank b)) → ((∀ (i : Fin (n+3)), (a.val ≤ + i.val) → (rank i = i.val-a.val)) → ((∀ (i : Fin (n+3)), (¬ a.val ≤ i.val) → (rank i = + n+3-a.val+i.val)) → ( + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (∀ (c : Fin (n + 3)), D (q c) = ((b.val : Real) - a.val) * ((c.val : Real) - a.val) * ((c.val + : Real) - b.val)) → (∀ i ∈ u, D (q i) < 0)))))) := by + classical + intro n q a b u v hne rank hrankU hrankHi hrankLo D hdet i hi + have hru := hrankU i hi + by_cases hab : a.val < b.val + · have hrb := hrankHi b hab.le + have hAi : a.val ≤ i.val := by + by_contra h + have hform := hrankLo i h + omega + have hia : a.val < i.val := by + have hform := hrankHi i hAi + omega + have hib : i.val < b.val := by + have hform := hrankHi i hAi + omega + have habR : (a.val : Real) < (b.val : Real) := by exact_mod_cast hab + have hiaR : (a.val : Real) < (i.val : Real) := by exact_mod_cast hia + have hibR : (i.val : Real) < (b.val : Real) := by exact_mod_cast hib + have hcoeff : 0 < (b.val : Real)-(a.val : Real) := sub_pos.mpr habR + have hleft : 0 < ((b.val : Real)-(a.val : Real)) * ((i.val : Real)-(a.val : Real)) := + mul_pos hcoeff (sub_pos.mpr hiaR) + have hright : (i.val : Real)-(b.val : Real) < 0 := sub_neg.mpr hibR + change D (q i) < 0 + rw [hdet i] + exact mul_neg_of_pos_of_neg hleft hright + · have hba : b.val < a.val := by + rcases Nat.lt_trichotomy b.val a.val with hba | heq | hlt + · exact hba + · exact False.elim (hne (Fin.ext heq.symm)) + · exact (hab hlt).elim + by_cases hAi : a.val ≤ i.val + · have hform := hrankHi i hAi + have hbform := hrankLo b (not_le_of_gt hba) + have hia : a.val < i.val := by omega + have hib : b.val < i.val := by omega + have hbaR : (b.val : Real) < (a.val : Real) := by exact_mod_cast hba + have hiaR : (a.val : Real) < (i.val : Real) := by exact_mod_cast hia + have hibR : (b.val : Real) < (i.val : Real) := by exact_mod_cast hib + have hcoeff : (b.val : Real)-(a.val : Real) < 0 := sub_neg.mpr hbaR + have hleft : ((b.val : Real)-(a.val : Real)) * ((i.val : Real)-(a.val : Real)) < 0 := + mul_neg_of_neg_of_pos hcoeff (sub_pos.mpr hiaR) + have hright : 0 < (i.val : Real)-(b.val : Real) := sub_pos.mpr hibR + change D (q i) < 0 + rw [hdet i] + exact mul_neg_of_neg_of_pos hleft hright + · have hform := hrankLo i hAi + have hbform := hrankLo b (not_le_of_gt hba) + have hib : i.val < b.val := by omega + have hbaR : (b.val : Real) < (a.val : Real) := by exact_mod_cast hba + have hiaNat : i.val < a.val := by omega + have hiaR : (i.val : Real) < (a.val : Real) := by exact_mod_cast hiaNat + have hibR : (i.val : Real) < (b.val : Real) := by exact_mod_cast hib + have hcoeff : (b.val : Real)-(a.val : Real) < 0 := sub_neg.mpr hbaR + have hiaReal : (i.val : Real)-(a.val : Real) < 0 := sub_neg.mpr hiaR + have hleft : 0 < ((b.val : Real)-(a.val : Real)) * ((i.val : Real)-(a.val : Real)) := + mul_pos_of_neg_of_neg hcoeff hiaReal + have hright : (i.val : Real)-(b.val : Real) < 0 := sub_neg.mpr hibR + change D (q i) < 0 + rw [hdet i] + exact mul_neg_of_pos_of_neg hleft hright + +private theorem hVpos : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (v : List (Fin (n + 3))), (a ≠ b) → ( + let rank := fun i : Fin (n+3) => (i.val + (n+3) - a.val) % (n+3) + (∀ (i : Fin (n+3)), (i ∈ v) → (rank b < rank i)) → ((∀ (i : Fin (n+3)), (a.val ≤ i.val) → + (rank i = i.val-a.val)) → ((∀ (i : Fin (n+3)), (¬ a.val ≤ i.val) → (rank i = + n+3-a.val+i.val)) → ( + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (∀ (c : Fin (n + 3)), D (q c) = ((b.val : Real) - a.val) * ((c.val : Real) - a.val) * ((c.val + : Real) - b.val)) → (∀ i ∈ v, 0 < D (q i)))))) := by + classical + intro n q a b v hne rank hrankV hrankHi hrankLo D hdet i hi + have hrv := hrankV i hi + by_cases hab : a.val < b.val + · by_cases hAi : a.val ≤ i.val + · have hformI := hrankHi i hAi + have hformB := hrankHi b hab.le + have hib : b.val < i.val := by omega + have habR : (a.val : Real) < (b.val : Real) := by exact_mod_cast hab + have hiaR : (a.val : Real) < (i.val : Real) := by exact_mod_cast (by omega : a.val < i.val) + have hibR : (b.val : Real) < (i.val : Real) := by exact_mod_cast hib + have hcoeff : 0 < (b.val : Real)-(a.val : Real) := sub_pos.mpr habR + have hleft : 0 < ((b.val : Real)-(a.val : Real))*((i.val : Real)-(a.val : Real)) := + mul_pos hcoeff (sub_pos.mpr hiaR) + have hright : 0 < (i.val : Real)-(b.val : Real) := sub_pos.mpr hibR + change D (q i) > 0 + rw [hdet i] + exact mul_pos hleft hright + · have hia : i.val < a.val := by omega + have habR : (a.val : Real) < (b.val : Real) := by exact_mod_cast hab + have hiaR : (i.val : Real) < (a.val : Real) := by exact_mod_cast hia + have hibR : (i.val : Real) < (b.val : Real) := by exact_mod_cast (by omega : i.val < b.val) + have hcoeff : 0 < (b.val : Real)-(a.val : Real) := sub_pos.mpr habR + have hleft : 0 < ((i.val : Real)-(a.val : Real))*((i.val : Real)-(b.val : Real)) := + mul_pos_of_neg_of_neg (sub_neg.mpr hiaR) (sub_neg.mpr hibR) + change D (q i) > 0 + rw [hdet i] + rw [mul_assoc] + exact mul_pos hcoeff hleft + · have hba : b.val < a.val := by + have hneval : a.val ≠ b.val := fun e => hne (Fin.ext e) + omega + have hAi : ¬ a.val ≤ i.val := by + intro h + have hformI := hrankHi i h + have hformB := hrankLo b (not_le_of_gt hba) + have hiBound : i.val < n+3 := i.isLt + omega + have hformI := hrankLo i hAi + have hformB := hrankLo b (not_le_of_gt hba) + have hib : b.val < i.val := by omega + have hia : i.val < a.val := by omega + have hbaR : (b.val : Real) < (a.val : Real) := by exact_mod_cast hba + have hiaR : (i.val : Real) < (a.val : Real) := by exact_mod_cast hia + have hibR : (b.val : Real) < (i.val : Real) := by exact_mod_cast hib + have hleft : 0 < ((b.val : Real)-(a.val : Real))*((i.val : Real)-(a.val : Real)) := + mul_pos_of_neg_of_neg (sub_neg.mpr hbaR) (sub_neg.mpr hiaR) + have hright : 0 < (i.val : Real)-(b.val : Real) := sub_pos.mpr hibR + change D (q i) > 0 + rw [hdet i] + exact mul_pos hleft hright + +private theorem hAidx : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let A := a :: (u ++ [b]) + (A.Sublist L) → ({i | i ∈ A} ⊆ {i | i ∈ L}) := by + classical + intro n a b u v L A hAsubL + exact hAsubL.subset + +private theorem hAinH : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let A := a :: (u ++ [b]) + let H := convexHull Real (q '' {i | i ∈ L}) + ({i | i ∈ A} ⊆ {i | i ∈ L}) → (q '' {i | i ∈ A} ⊆ H) := by + classical + intro n q a b u v L A H hAidx + exact (Set.image_mono hAidx).trans (subset_convexHull Real _) + +private theorem hAhalf : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), + let A := a :: (u ++ [b]) + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (∀ (c : Fin (n + 3)), D (q c) = ((b.val : Real) - a.val) * ((c.val : Real) - a.val) * ((c.val + : Real) - b.val)) → ((∀ i ∈ u, D (q i) < 0) → (q '' {i | i ∈ A} ⊆ {z | D z ≤ 0})) := by + classical + intro n q a b u A D hdet hUneg + rintro z ⟨i, hi, rfl⟩ + change D (q i) ≤ 0 + simp only [A, List.mem_cons, List.mem_append] at hi + rcases hi with hia | hiu | hib | hnil + · subst i + rw [hdet a] + simp + · exact le_of_lt (hUneg i hiu) + · subst i + rw [hdet b] + simp + · simp at hnil + +private theorem hAcut : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let A := a :: (u ++ [b]) + let H := convexHull Real (q '' {i | i ∈ L}) + let HA := convexHull Real (q '' {i | i ∈ A}) + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (Convex Real {z : Real × Real | D z ≤ 0}) → ((q '' {i | i ∈ A} ⊆ H) → ((q '' {i | i ∈ A} ⊆ {z + | D z ≤ 0}) → (HA ⊆ H ∩ {z | D z ≤ 0}))) := by + classical + intro n q a b u v L A H HA D hDleConv hAinH hAhalf + exact convexHull_min (Set.subset_inter hAinH hAhalf) + (Convex.inter (convex_convexHull Real _) hDleConv) + +private theorem hBidx : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let B := b :: (v ++ [a]) + {i | i ∈ B} ⊆ {i | i ∈ L} := by + classical + intro n a b u v L B i hi + simp only [B, List.mem_cons, List.mem_append] at hi + rcases hi with hib | hiv | hia | hnil + · subst i + simp [L] + · change i ∈ a :: (u ++ b :: v) + simp only [List.mem_cons, List.mem_append] + exact Or.inr (Or.inr (Or.inr hiv)) + · subst i + simp [L] + · simp at hnil + +private theorem hBinH : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let B := b :: (v ++ [a]) + let H := convexHull Real (q '' {i | i ∈ L}) + ({i | i ∈ B} ⊆ {i | i ∈ L}) → (q '' {i | i ∈ B} ⊆ H) := by + classical + intro n q a b u v L B H hBidx + exact (Set.image_mono hBidx).trans (subset_convexHull Real _) + +private theorem hBhalf : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (v : List (Fin (n + 3))), + let B := b :: (v ++ [a]) + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (∀ (c : Fin (n + 3)), D (q c) = ((b.val : Real) - a.val) * ((c.val : Real) - a.val) * ((c.val + : Real) - b.val)) → ((∀ i ∈ v, 0 < D (q i)) → (q '' {i | i ∈ B} ⊆ {z | 0 ≤ D z})) := by + classical + intro n q a b v B D hdet hVpos + rintro z ⟨i, hi, rfl⟩ + change 0 ≤ D (q i) + simp only [B, List.mem_cons, List.mem_append] at hi + rcases hi with hib | hiv | hia | hnil + · subst i + rw [hdet b] + simp + · exact le_of_lt (hVpos i hiv) + · subst i + rw [hdet a] + simp + · simp at hnil + +private theorem hBcut : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let B := b :: (v ++ [a]) + let H := convexHull Real (q '' {i | i ∈ L}) + let HB := convexHull Real (q '' {i | i ∈ B}) + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (Convex Real {z : Real × Real | 0 ≤ D z}) → ((q '' {i | i ∈ B} ⊆ H) → ((q '' {i | i ∈ B} ⊆ {z + | 0 ≤ D z}) → (HB ⊆ H ∩ {z | 0 ≤ D z}))) := by + classical + intro n q a b u v L B H HB D hDgeConv hBinH hBhalf + exact convexHull_min (Set.subset_inter hBinH hBhalf) + (Convex.inter (convex_convexHull Real _) hDgeConv) + +private theorem hIndexUnion : + ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : + List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let A := a :: (u ++ [b]) + let B := b :: (v ++ [a]) + {i | i ∈ L} = {i | i ∈ A} ∪ {i | i ∈ B} := by + classical + intro n a b u v L A B + ext i + simp only [Set.mem_union, L, A, B, List.mem_cons, List.mem_append, + ] + simp only [List.not_mem_nil, or_false] + constructor + · rintro (ha | hu | hb | hv) + · exact Or.inl (Or.inl ha) + · exact Or.inl (Or.inr (Or.inl hu)) + · exact Or.inl (Or.inr (Or.inr hb)) + · exact Or.inr (Or.inr (Or.inl hv)) + · rintro (hA | hB) + · rcases hA with ha | hu | hb + · exact Or.inl ha + · exact Or.inr (Or.inl hu) + · exact Or.inr (Or.inr (Or.inl hb)) + · rcases hB with hb | hv | ha + · exact Or.inr (Or.inr (Or.inl hb)) + · exact Or.inr (Or.inr (Or.inr hv)) + · exact Or.inl ha + +private theorem hImageUnion : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let A := a :: (u ++ [b]) + let B := b :: (v ++ [a]) + ({i | i ∈ L} = {i | i ∈ A} ∪ {i | i ∈ B}) → (q '' {i | i ∈ L} = + (q '' {i | i ∈ A}) ∪ (q '' {i | i ∈ B})) := by + classical + intro n q a b u v L A B hIndexUnion + rw [hIndexUnion, Set.image_union] + +private theorem hSA : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), + let A := a :: (u ++ [b]) + (q '' {i | i ∈ A}).Nonempty := by + classical + intro n q a b u A + exact ⟨q a, ⟨a, by simp [A], rfl⟩⟩ + +private theorem hSB : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (v : List (Fin (n + 3))), + let B := b :: (v ++ [a]) + (q '' {i | i ∈ B}).Nonempty := by + classical + intro n q a b v B + exact ⟨q b, ⟨b, by simp [B], rfl⟩⟩ + +private theorem hHjoin : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let A := a :: (u ++ [b]) + let B := b :: (v ++ [a]) + let H := convexHull Real (q '' {i | i ∈ L}) + let HA := convexHull Real (q '' {i | i ∈ A}) + let HB := convexHull Real (q '' {i | i ∈ B}) + (q '' {i | i ∈ L} = (q '' {i | i ∈ A}) ∪ (q '' {i | i ∈ B})) → (((q '' {i | i ∈ A}).Nonempty) + → (((q '' {i | i ∈ B}).Nonempty) → (H = convexJoin Real HA HB))) := by + classical + intro n q a b u v L A B H HA HB hImageUnion hSA hSB + change convexHull Real (q '' {i | i ∈ L}) = _ + rw [hImageUnion] + exact convexHull_union hSA hSB + +private theorem hchordA : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), + let A := a :: (u ++ [b]) + let HA := convexHull Real (q '' {i | i ∈ A}) + segment Real (q a) (q b) ⊆ HA := by + classical + intro n q a b u A HA + apply segment_subset_convexHull + · exact ⟨a, by simp [A], rfl⟩ + · exact ⟨b, by simp [A], rfl⟩ + +private theorem hchordB : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (v : List (Fin (n + 3))), + let B := b :: (v ++ [a]) + let HB := convexHull Real (q '' {i | i ∈ B}) + segment Real (q a) (q b) ⊆ HB := by + classical + intro n q a b v B HB + apply segment_subset_convexHull + · exact ⟨a, by simp [B], rfl⟩ + · exact ⟨b, by simp [B], rfl⟩ + +private theorem negativeJoinCut : + ∀ {S : Set (Real × Real)}, ∀ {T : Set (Real × Real)}, ∀ (D' : Real × Real → Real), (Convex + Real S) → ((∀ x, x ∈ S → D' x ≤ 0) → ((∀ y, y ∈ T → 0 ≤ D' y) → ((∀ x y : Real × Real, ∀ + r s : Real, r + s ≠ 0 → + D' ((r / (r + s)) • x + (s / (r + s)) • y) = + r / (r + s) * D' x + s / (r + s) * D' y) → ((∀ w, w ∈ convexJoin Real S T → D' w = 0 → + w ∈ S) → (convexJoin Real S T ∩ {z | D' z ≤ 0} ⊆ S))))) := by + classical + intro S T D' hS hneg hpos haff hzero + rintro z ⟨hz, hDz⟩ + obtain ⟨x, hx, y, hy, hseg⟩ := mem_convexJoin.mp hz + obtain ⟨r, s, hr, hs, hrs, rfl⟩ := hseg + have hdx := hneg x hx + have hdy := hpos y hy + have hDz' : D' (r • x + s • y) = r * D' x + s * D' y := by + have hh := haff x y r s (by rw [hrs]; norm_num) + simpa only [hrs, div_one, one_smul] using hh + by_cases hdyzero : D' y = 0 + · have hyS : y ∈ S := hzero y + (mem_convexJoin.mpr ⟨x, hx, y, hy, right_mem_segment Real x y⟩) hdyzero + exact hS hx hyS hr hs hrs + have hdypos : 0 < D' y := lt_of_le_of_ne hdy (Ne.symm hdyzero) + by_cases hdxzero : D' x = 0 + · have hszero : s = 0 := by + by_contra hsne + have hspos : 0 < s := lt_of_le_of_ne hs (Ne.symm hsne) + rw [hdxzero] at hDz' + have hprod : 0 < s * D' y := mul_pos hspos hdypos + change D' (r • x + s • y) ≤ 0 at hDz + rw [hDz'] at hDz + nlinarith + have hrone : r = 1 := by linarith + simpa [hszero, hrone] using hx + have hdxneg : D' x < 0 := lt_of_le_of_ne hdx hdxzero + let den := D' y - D' x + have hden : 0 < den := sub_pos.mpr (lt_trans hdxneg hdypos) + have hdenne : D' y - D' x ≠ 0 := ne_of_gt hden + let alpha := D' y / den + let beta := -D' x / den + have halpha : 0 ≤ alpha := le_of_lt (div_pos hdypos hden) + have hbeta : 0 < beta := div_pos (neg_pos.mpr hdxneg) hden + have hsum : alpha + beta = 1 := by + dsimp [alpha, beta, den] + field_simp [hdenne] + ring + let w := alpha • x + beta • y + have hwseg : w ∈ segment Real x y := ⟨alpha, beta, halpha, hbeta.le, hsum, rfl⟩ + have hwjoin : w ∈ convexJoin Real S T := mem_convexJoin.mpr ⟨x, hx, y, hy, hwseg⟩ + have hwzero : D' w = 0 := by + have hh := haff x y alpha beta (by rw [hsum]; norm_num) + rw [show D' w = alpha * D' x + beta * D' y by + simpa only [hsum, div_one, one_smul] using hh] + dsimp [alpha, beta, den] + field_simp [hdenne] + ring + have hwS : w ∈ S := hzero w hwjoin hwzero + have hs_le : s ≤ beta := by + apply (le_div_iff₀ hden).mpr + dsimp [den] + have hmix : r * D' x + s * D' y ≤ 0 := by + rw [← hDz'] + exact hDz + have hmixEq : r * D' x + s * D' y = + D' x + s * (D' y - D' x) := by + calc + _ = (r + s) * D' x + s * (D' y - D' x) := by ring + _ = D' x + s * (D' y - D' x) := by rw [hrs]; ring + nlinarith only [hmix, hmixEq] + let c := s / beta + have hc : 0 ≤ c := div_nonneg hs hbeta.le + have hc_le : c ≤ 1 := (div_le_one hbeta).mpr hs_le + have hc_beta : c * beta = s := div_mul_cancel₀ s (ne_of_gt hbeta) + have hr_eq : r = 1 - s := by + nlinarith only [hrs] + have hc_alpha : (1 - c) + c * alpha = r := by + have halpha' : alpha = 1 - beta := by + linarith only [hsum] + calc + (1 - c) + c * alpha = (1 - c) + c * (1 - beta) := by rw [halpha'] + _ = 1 - c * beta := by + rw [mul_sub] + simp only [mul_one] + rw [← add_sub_assoc, sub_add_cancel] + _ = 1 - s := by rw [hc_beta] + _ = r := hr_eq.symm + have heq : (1 - c) • x + c • w = r • x + s • y := by + dsimp [w] + rw [smul_add, smul_smul, smul_smul, ← add_assoc, ← add_smul, + hc_alpha, hc_beta] + rw [← heq] + exact hS hx hwS (sub_nonneg.mpr hc_le) hc (by ring) + +private theorem hAeq : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let A := a :: (u ++ [b]) + let B := b :: (v ++ [a]) + let H := convexHull Real (q '' {i | i ∈ L}) + let HA := convexHull Real (q '' {i | i ∈ A}) + let HB := convexHull Real (q '' {i | i ∈ B}) + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (H ∩ {z | D z = 0} = segment Real (q a) (q b)) → ((∀ (x : Real × Real), ∀ (y : Real × Real), + ∀ (r : Real), ∀ (s : Real), (r+s ≠ 0) → (D ((r/(r+s)) • x + (s/(r+s)) • y) = r/(r+s)*D x + + s/(r+s)*D y)) → ((HA ⊆ H ∩ {z | D z ≤ 0}) → ((HB ⊆ H ∩ {z | 0 ≤ D z}) → ((H = + convexJoin Real HA HB) → ((segment Real (q a) (q b) ⊆ HA) → ((∀ {S : Set (Real × Real)}, + ∀ {T : Set (Real × Real)}, ∀ (D' : Real × Real → Real), (Convex Real S) → ((∀ x, x ∈ S → + D' x ≤ 0) → ((∀ y, y ∈ T → 0 ≤ D' y) → ((∀ x y : Real × Real, ∀ r s : Real, r + s ≠ 0 → + D' ((r / (r + s)) • x + (s / (r + s)) • y) = r / (r + s) * D' x + s / (r + s) * D' y) → + ((∀ w, w ∈ convexJoin Real S T → D' w = 0 → w ∈ S) → (convexJoin Real S T ∩ {z | D' z ≤ + 0} ⊆ S)))))) → (HA = H ∩ {z | D z ≤ 0}))))))) := by + classical + intro n q a b u v L A B H HA HB D hzeroLine hDcombo hAcut hBcut hHjoin hchordA negativeJoinCut + apply Set.Subset.antisymm hAcut + intro z hz + have hzjoin : z ∈ convexJoin Real HA HB := by rw [← hHjoin]; exact hz.1 + have hzeroA : ∀ w, w ∈ convexJoin Real HA HB → D w = 0 → w ∈ HA := by + intro w hw hDw + have hwH : w ∈ H := by rw [hHjoin]; exact hw + have hwseg : w ∈ segment Real (q a) (q b) := by + exact (Set.ext_iff.mp hzeroLine w).mp ⟨hwH, hDw⟩ + exact hchordA hwseg + exact negativeJoinCut D (convex_convexHull Real _) (fun z hz => (hAcut hz).2) + (fun z hz => (hBcut hz).2) hDcombo hzeroA ⟨hzjoin, hz.2⟩ + +private theorem hBeq : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let A := a :: (u ++ [b]) + let B := b :: (v ++ [a]) + let H := convexHull Real (q '' {i | i ∈ L}) + let HA := convexHull Real (q '' {i | i ∈ A}) + let HB := convexHull Real (q '' {i | i ∈ B}) + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (H ∩ {z | D z = 0} = segment Real (q a) (q b)) → ((∀ (x : Real × Real), ∀ (y : Real × Real), + ∀ (r : Real), ∀ (s : Real), (r+s ≠ 0) → (D ((r/(r+s)) • x + (s/(r+s)) • y) = r/(r+s)*D x + + s/(r+s)*D y)) → ((HA ⊆ H ∩ {z | D z ≤ 0}) → ((HB ⊆ H ∩ {z | 0 ≤ D z}) → ((H = + convexJoin Real HA HB) → ((segment Real (q a) (q b) ⊆ HB) → ((∀ {S : Set (Real × Real)}, + ∀ {T : Set (Real × Real)}, ∀ (D' : Real × Real → Real), (Convex Real S) → ((∀ x, x ∈ S → + D' x ≤ 0) → ((∀ y, y ∈ T → 0 ≤ D' y) → ((∀ x y : Real × Real, ∀ r s : Real, r + s ≠ 0 → + D' ((r / (r + s)) • x + (s / (r + s)) • y) = r / (r + s) * D' x + s / (r + s) * D' y) → + ((∀ w, w ∈ convexJoin Real S T → D' w = 0 → w ∈ S) → (convexJoin Real S T ∩ {z | D' z ≤ + 0} ⊆ S)))))) → (HB = H ∩ {z | 0 ≤ D z}))))))) := by + classical + intro n q a b u v L A B H HA HB D hzeroLine hDcombo hAcut hBcut hHjoin hchordB negativeJoinCut + apply Set.Subset.antisymm hBcut + intro z hz + have hzjoin : z ∈ convexJoin Real HB HA := by + rw [convexJoin_comm, ← hHjoin] + exact hz.1 + have hzeroB : ∀ w, w ∈ convexJoin Real HB HA → -D w = 0 → w ∈ HB := by + intro w hw hDw + have hw' : w ∈ convexJoin Real HA HB := by rw [convexJoin_comm]; exact hw + have hwH : w ∈ H := by rw [hHjoin]; exact hw' + have hwseg : w ∈ segment Real (q a) (q b) := by + exact (Set.ext_iff.mp hzeroLine w).mp ⟨hwH, (neg_eq_zero.mp hDw)⟩ + exact hchordB hwseg + have hcut := negativeJoinCut (fun z => -D z) (convex_convexHull Real _) + (fun z hz => neg_nonpos.mpr ((hBcut hz).2)) + (fun z hz => neg_nonneg.mpr ((hAcut hz).2)) + (by intro x y r s hrs; rw [hDcombo x y r s hrs]; ring) hzeroB + apply hcut ⟨hzjoin, ?_⟩ + change -D z ≤ 0 + exact neg_nonpos.mpr hz.2 + +private theorem hunion : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let A := a :: (u ++ [b]) + let B := b :: (v ++ [a]) + let H := convexHull Real (q '' {i | i ∈ L}) + let HA := convexHull Real (q '' {i | i ∈ A}) + let HB := convexHull Real (q '' {i | i ∈ B}) + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (HA = H ∩ {z | D z ≤ 0}) → ((HB = H ∩ {z | 0 ≤ D z}) → (HA ∪ HB = H)) := by + classical + intro n q a b u v L A B H HA HB D hAeq hBeq + rw [hAeq, hBeq] + ext z + constructor + · rintro (⟨hz, _⟩ | ⟨hz, _⟩) + · exact hz + · exact hz + · intro hz + by_cases h : D z ≤ 0 + · exact Or.inl ⟨hz, h⟩ + · exact Or.inr ⟨hz, le_of_not_ge h⟩ + +private theorem hinter : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ + (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v) + let A := a :: (u ++ [b]) + let B := b :: (v ++ [a]) + let H := convexHull Real (q '' {i | i ∈ L}) + let HA := convexHull Real (q '' {i | i ∈ A}) + let HB := convexHull Real (q '' {i | i ∈ B}) + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (H ∩ {z | D z = 0} = segment Real (q a) (q b)) → ((HA = H ∩ {z | D z ≤ 0}) → ((HB = H ∩ {z | + 0 ≤ D z}) → (HA ∩ HB = segment Real (q a) (q b)))) := by + classical + intro n q a b u v L A B H HA HB D hzeroLine hAeq hBeq + rw [hAeq, hBeq] + ext z + simp only [Set.mem_inter_iff, Set.mem_ofPred_eq] + constructor + · rintro ⟨⟨hz, hle⟩, ⟨_, hge⟩⟩ + have hzero : z ∈ H ∩ {w | D w = 0} := ⟨hz, le_antisymm hle hge⟩ + rw [hzeroLine] at hzero + exact hzero + · intro hz + have hzero : z ∈ H ∩ {w | D w = 0} := by rw [hzeroLine]; exact hz + exact ⟨⟨hzero.1, le_of_eq hzero.2⟩, + ⟨hzero.1, le_of_eq hzero.2.symm⟩⟩ + +end ParabolaChordLemmas + +theorem P3555T2ParabolaChordCuts {n : Nat} + (q : Fin (n + 3) → Real × Real) + (hq : ∀ i, q i = ((i.val : Real), (i.val : Real) ^ 2)) + (a b : Fin (n + 3)) (u v : List (Fin (n + 3))) + (hv : 0 < v.length) + (hboundary : (a :: (u ++ b :: v)).Nodup) + (hcyclic : ∃ k : Nat, (a :: (u ++ b :: v)).Sublist + ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) : + let L := a :: (u ++ b :: v) + let A := a :: (u ++ [b]) + let B := b :: (v ++ [a]) + let H := convexHull Real (q '' {i | i ∈ L}) + let HA := convexHull Real (q '' {i | i ∈ A}) + let HB := convexHull Real (q '' {i | i ∈ B}) + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + a ≠ b ∧ A.Nodup ∧ B.Nodup ∧ + (∃ k : Nat, A.Sublist ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) ∧ + (∃ k : Nat, B.Sublist ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) ∧ + ({i | i ∈ A} ∩ {i | i ∈ B} = {a, b}) ∧ + (∀ i ∈ u, D (q i) < 0) ∧ (∀ i ∈ v, 0 < D (q i)) ∧ + HA = H ∩ {z | D z ≤ 0} ∧ HB = H ∩ {z | 0 ≤ D z} ∧ + HA ∪ HB = H ∧ HA ∩ HB = segment Real (q a) (q b) := by +-- BODY + classical + let L := a :: (u ++ b :: v) + let A := a :: (u ++ [b]) + let B := b :: (v ++ [a]) + let H := convexHull Real (q '' {i | i ∈ L}) + let HA := convexHull Real (q '' {i | i ∈ A}) + let HB := convexHull Real (q '' {i | i ∈ B}) + have hL : L.Nodup := ParabolaChordLemmas.hL n a b u v hboundary + have haNotTail : a ∉ u ++ b :: v := ParabolaChordLemmas.haNotTail n a b u v hL + have htailNodup : (u ++ b :: v).Nodup := ParabolaChordLemmas.htailNodup n a b u v hL + have hne : a ≠ b := ParabolaChordLemmas.hne n q a b u v hboundary hcyclic hL haNotTail htailNodup + have hparts := ParabolaChordLemmas.hparts n b u v htailNodup + have huNodup : u.Nodup := ParabolaChordLemmas.huNodup n b u v hparts + have hbNotU : b ∉ u := ParabolaChordLemmas.hbNotU n b u v hparts + have hvNodup : v.Nodup := ParabolaChordLemmas.hvNodup n b u v hparts + have hbNotV : b ∉ v := ParabolaChordLemmas.hbNotV n b u v hparts + have haNotU : a ∉ u := ParabolaChordLemmas.haNotU n a b u v haNotTail + have haNotV : a ∉ v := ParabolaChordLemmas.haNotV n a b u v haNotTail + have huvDisjoint : ∀ i, i ∈ u → i ∈ v → False := ParabolaChordLemmas.huvDisjoint n b u v hparts + have hANodup : A.Nodup := ParabolaChordLemmas.hANodup n a b u hne huNodup hbNotU haNotU + have hBNodup : B.Nodup := ParabolaChordLemmas.hBNodup n a b v hne hvNodup hbNotV haNotV + have hsets : {i | i ∈ A} ∩ {i | i ∈ B} = {a, b} := ParabolaChordLemmas.hsets n q a b u v + hcyclic htailNodup hne hparts huNodup hbNotU hvNodup hbNotV haNotU haNotV huvDisjoint + hANodup hBNodup + have hnil (xs : List (Fin (n + 3))) : + ([] : List (Fin (n + 3))).Sublist xs := ParabolaChordLemmas.hnil n xs + have hnilv := ParabolaChordLemmas.hnilv n v hnil + have hbSub : ([b] : List (Fin (n + 3))).Sublist (b :: v) := ParabolaChordLemmas.hbSub n b v hnilv + have hAtail : (u ++ [b]).Sublist (u ++ b :: v) := ParabolaChordLemmas.hAtail n b u v hbSub + have hAsubL : A.Sublist L := ParabolaChordLemmas.hAsubL n a b u v hAtail + obtain ⟨k, hLrot⟩ := hcyclic + let root := List.ofFn (fun i : Fin (n + 3) => i) + let R := root.rotate k + have hrootlen : root.length = n + 3 := ParabolaChordLemmas.hrootlen n + obtain ⟨emb, hemb⟩ := List.sublist_iff_exists_fin_orderEmbedding_get_eq.mp hLrot + have hRval (j : Fin R.length) : (R.get j).val = (j.val + k) % (n + 3) := + ParabolaChordLemmas.hRval n k hrootlen j + have hrankDiff (m k p s : Nat) (hm : 0 < m) (hp : p < m) (hs : s < m) + (hps : p ≤ s) : (((s+k)%m+m-((p+k)%m))%m) = s-p := ParabolaChordLemmas.hrankDiff n v m k p + s hm hp hs hps + have hsourceA : (⟨0, by simp [L]⟩ : Fin L.length).val < + (⟨u.length+1, by simp [L]⟩ : Fin L.length).val := ParabolaChordLemmas.hsourceA n a b u v + have hsourceB : u.length+1 < L.length := ParabolaChordLemmas.hsourceB n a b u v hv + let ia : Fin L.length := ⟨0, by simp [L]⟩ + let ib : Fin L.length := ⟨u.length+1, hsourceB⟩ + have haAtRoot : R.get (emb ia) = a := ParabolaChordLemmas.haAtRoot n a b u v k emb hemb + have hbAtRoot : R.get (emb ib) = b := ParabolaChordLemmas.hbAtRoot n a b u v k emb hemb hsourceB + have hrootOrder : (emb ia).val < (emb ib).val := ParabolaChordLemmas.hrootOrder n a b u v k emb + hsourceA hsourceB + have hBVsubDrop : (b :: v).Sublist (R.drop (emb ib).val) := ParabolaChordLemmas.hBVsubDrop n a + b u v k emb hemb hsourceB + let ip : Fin (R.take (emb ib).val).length := ⟨(emb ia).val, by + rw [List.length_take] + apply Nat.lt_min.mpr + exact ⟨Fin.lt_def.mp hrootOrder, (emb ia).isLt⟩⟩ + have hAsingleTake : ([a] : List (Fin (n+3))).Sublist (R.take (emb ib).val) := + ParabolaChordLemmas.hAsingleTake n a b u v k emb hsourceB haAtRoot hrootOrder + have hBsubAtB : B.Sublist (R.rotate (emb ib).val) := ParabolaChordLemmas.hBsubAtB n a b u v k + emb hsourceB hBVsubDrop hAsingleTake + have hBsubRoot : ∃ k : Nat, B.Sublist (root.rotate k) := ParabolaChordLemmas.hBsubRoot n a b u + v k emb hsourceB hBsubAtB + have hvalA : a.val = ((emb ia).val + k) % (n + 3) := ParabolaChordLemmas.hvalA n a b u v k emb + hRval haAtRoot + have hvalB : b.val = ((emb ib).val + k) % (n + 3) := ParabolaChordLemmas.hvalB n a b u v k emb + hRval hsourceB hbAtRoot + have hrankB : ((b.val + (n+3) - a.val) % (n+3)) = + (emb ib).val - (emb ia).val := ParabolaChordLemmas.hrankB n a b u v k emb hrankDiff + hsourceB hrootOrder hvalA hvalB + let rank := fun i : Fin (n+3) => (i.val + (n+3) - a.val) % (n+3) + have hrankB' : rank b = (emb ib).val - (emb ia).val := ParabolaChordLemmas.hrankB' n a b u v k + emb hsourceB hrankB + have hrankAt (p : Fin L.length) (hp : ia ≤ p) (i : Fin (n+3)) + (hpi : L.get p = i) : rank i = (emb p).val - (emb ia).val := ParabolaChordLemmas.hrankAt n + a b u v k emb hemb hRval hrankDiff hsourceB hvalA p hp i hpi + have hrankU (i : Fin (n+3)) (hi : i ∈ u) : 0 < rank i ∧ rank i < rank b := + ParabolaChordLemmas.hrankU n a b u v hv k emb hsourceB hrootOrder hrankB' hrankAt i hi + have hrankV (i : Fin (n+3)) (hi : i ∈ v) : rank b < rank i := ParabolaChordLemmas.hrankV n a b + u v k emb hsourceB hrootOrder hrankB' hrankAt i hi + have hrankFormula (i : Fin (n+3)) : rank i = + if a.val ≤ i.val then i.val-a.val else n+3-a.val+i.val := ParabolaChordLemmas.hrankFormula + n a b u v k emb hsourceB haAtRoot hvalA i + have hrankHi (i : Fin (n+3)) (h : a.val ≤ i.val) : rank i = i.val-a.val := + ParabolaChordLemmas.hrankHi n a hrankFormula i h + have hrankLo (i : Fin (n+3)) (h : ¬ a.val ≤ i.val) : + rank i = n+3-a.val+i.val := ParabolaChordLemmas.hrankLo n a hrankFormula i h + have hAsubRoot : ∃ k : Nat, A.Sublist + ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k) := ParabolaChordLemmas.hAsubRoot n a b u + v hAsubL k hLrot + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + have hdet (c : Fin (n + 3)) : + D (q c) = ((b.val : Real) - a.val) * + ((c.val : Real) - a.val) * ((c.val : Real) - b.val) := ParabolaChordLemmas.hdet n q hq a b c + have hDform (z : Real × Real) : + D z = ((b.val : Real) - a.val) * + (z.2 - ((a.val : Real)+(b.val : Real))*z.1 + a.val*b.val) := ParabolaChordLemmas.hDform n + q hq a b z + have hTaConv (c : Fin (n+3)) : + Convex Real {z : Real × Real | 0 ≤ z.2 - 2*(c.val : Real)*z.1 + (c.val : Real)^2} := + ParabolaChordLemmas.hTaConv n c + have hTaV : q '' {i | i ∈ L} ⊆ + {z : Real × Real | 0 ≤ z.2 - 2*(a.val : Real)*z.1 + (a.val : Real)^2} := + ParabolaChordLemmas.hTaV n q hq a b u v + have hTbV : q '' {i | i ∈ L} ⊆ + {z : Real × Real | 0 ≤ z.2 - 2*(b.val : Real)*z.1 + (b.val : Real)^2} := + ParabolaChordLemmas.hTbV n q hq a b u v + have hTaH : H ⊆ {z : Real × Real | 0 ≤ z.2 - 2*(a.val : Real)*z.1 + (a.val : Real)^2} := + ParabolaChordLemmas.hTaH n q a b u v hTaConv hTaV + have hTbH : H ⊆ {z : Real × Real | 0 ≤ z.2 - 2*(b.val : Real)*z.1 + (b.val : Real)^2} := + ParabolaChordLemmas.hTbH n q a b u v hTaConv hTbV + have haH : q a ∈ H := ParabolaChordLemmas.haH n q a b u v + have hbH : q b ∈ H := ParabolaChordLemmas.hbH n q a b u v + have hsegH : segment Real (q a) (q b) ⊆ H := ParabolaChordLemmas.hsegH n q a b u v haH hbH + let F := fun z : Real × Real => z.2 - + ((a.val : Real)+(b.val : Real))*z.1 + (a.val : Real)*(b.val : Real) + have hneR : (b.val : Real)-(a.val : Real) ≠ 0 := ParabolaChordLemmas.hneR n a b hne + have hFfromD (z : Real × Real) (hDz : D z = 0) : F z = 0 := ParabolaChordLemmas.hFfromD n q a b + hDform hneR z hDz + have hTaLine (z : Real × Real) (hf : F z = 0) : + z.2 - 2*(a.val : Real)*z.1 + (a.val : Real)^2 = + ((b.val : Real)-(a.val : Real))*(z.1-(a.val : Real)) := ParabolaChordLemmas.hTaLine n a b + z hf + have hTbLine (z : Real × Real) (hf : F z = 0) : + z.2 - 2*(b.val : Real)*z.1 + (b.val : Real)^2 = + ((a.val : Real)-(b.val : Real))*(z.1-(b.val : Real)) := ParabolaChordLemmas.hTbLine n a b + z hf + have chordMemberInc (A B X Y : Real) (hab : A < B) + (hF : Y-(A+B)*X+A*B=0) (hAX : A ≤ X) (hXB : X ≤ B) : + (X,Y) ∈ segment Real (A,A^2) (B,B^2) := ParabolaChordLemmas.chordMemberInc A B X Y hab hF + hAX hXB + have hsegD : segment Real (q a) (q b) ⊆ {z | D z = 0} := ParabolaChordLemmas.hsegD n q hq a b + hDform + have hzeroLine : H ∩ {z | D z = 0} = segment Real (q a) (q b) := ParabolaChordLemmas.hzeroLine + n q hq a b u v hne hTaH hTbH hsegH hFfromD hTaLine hTbLine chordMemberInc hsegD + have hBcyclic : ∃ k : Nat, B.Sublist + ((List.ofFn (fun i : Fin (n+3) => i)).rotate k) := ParabolaChordLemmas.hBcyclic n a b v + hBsubRoot + have hDcombo (x y : Real × Real) (r s : Real) (hrs : r+s ≠ 0) : + D ((r/(r+s)) • x + (s/(r+s)) • y) = + r/(r+s)*D x + s/(r+s)*D y := ParabolaChordLemmas.hDcombo n q a b hDform x y r s hrs + have hDleConv : Convex Real {z : Real × Real | D z ≤ 0} := ParabolaChordLemmas.hDleConv n q a b + hDcombo + have hDgeConv : Convex Real {z : Real × Real | 0 ≤ D z} := ParabolaChordLemmas.hDgeConv n q a b + hDcombo + clear hsegD hTaLine hTbLine hFfromD hneR + chordMemberInc hTaConv hTaV hTbV hTaH hTbH haH hbH hsegH + clear ip hAsingleTake hBsubAtB hBVsubDrop hrootOrder + clear hrankB' + clear hBsubRoot k hLrot root R hrootlen emb hemb hRval hrankDiff hsourceA hsourceB + ia ib haAtRoot hbAtRoot hvalA hvalB hrankB hrankAt + have hUneg : ∀ i ∈ u, D (q i) < 0 := ParabolaChordLemmas.hUneg n q a b u v hne hrankU hrankHi + hrankLo hdet + have hVpos : ∀ i ∈ v, 0 < D (q i) := ParabolaChordLemmas.hVpos n q a b v hne hrankV hrankHi + hrankLo hdet + clear rank hrankU hrankV hrankFormula hrankHi hrankLo + have hAidx : {i | i ∈ A} ⊆ {i | i ∈ L} := ParabolaChordLemmas.hAidx n a b u v hAsubL + have hAinH : q '' {i | i ∈ A} ⊆ H := ParabolaChordLemmas.hAinH n q a b u v hAidx + have hAhalf : q '' {i | i ∈ A} ⊆ {z | D z ≤ 0} := ParabolaChordLemmas.hAhalf n q a b u hdet hUneg + have hAcut : HA ⊆ H ∩ {z | D z ≤ 0} := ParabolaChordLemmas.hAcut n q a b u v hDleConv hAinH hAhalf + have hBidx : {i | i ∈ B} ⊆ {i | i ∈ L} := ParabolaChordLemmas.hBidx n a b u v + have hBinH : q '' {i | i ∈ B} ⊆ H := ParabolaChordLemmas.hBinH n q a b u v hBidx + have hBhalf : q '' {i | i ∈ B} ⊆ {z | 0 ≤ D z} := ParabolaChordLemmas.hBhalf n q a b v hdet hVpos + have hBcut : HB ⊆ H ∩ {z | 0 ≤ D z} := ParabolaChordLemmas.hBcut n q a b u v hDgeConv hBinH hBhalf + clear hdet hAidx hAinH hAhalf hBidx hBinH hBhalf hDleConv hDgeConv + clear hL haNotTail htailNodup hparts huNodup hbNotU hvNodup hbNotV haNotU haNotV huvDisjoint + clear hnil hnilv hbSub hAtail hAsubL hboundary + have hIndexUnion : {i | i ∈ L} = {i | i ∈ A} ∪ {i | i ∈ B} := ParabolaChordLemmas.hIndexUnion n + a b u v + have hImageUnion : q '' {i | i ∈ L} = + (q '' {i | i ∈ A}) ∪ (q '' {i | i ∈ B}) := ParabolaChordLemmas.hImageUnion n q a b u v + hIndexUnion + have hSA : (q '' {i | i ∈ A}).Nonempty := ParabolaChordLemmas.hSA n q a b u + have hSB : (q '' {i | i ∈ B}).Nonempty := ParabolaChordLemmas.hSB n q a b v + have hHjoin : H = convexJoin Real HA HB := ParabolaChordLemmas.hHjoin n q a b u v hImageUnion + hSA hSB + have hchordA : segment Real (q a) (q b) ⊆ HA := ParabolaChordLemmas.hchordA n q a b u + have hchordB : segment Real (q a) (q b) ⊆ HB := ParabolaChordLemmas.hchordB n q a b v + have negativeJoinCut {S T : Set (Real × Real)} (D' : Real × Real → Real) + (hS : Convex Real S) + (hneg : ∀ x, x ∈ S → D' x ≤ 0) + (hpos : ∀ y, y ∈ T → 0 ≤ D' y) + (haff : ∀ x y : Real × Real, ∀ r s : Real, r + s ≠ 0 → + D' ((r / (r + s)) • x + (s / (r + s)) • y) = + r / (r + s) * D' x + s / (r + s) * D' y) + (hzero : ∀ w, w ∈ convexJoin Real S T → D' w = 0 → w ∈ S) : + convexJoin Real S T ∩ {z | D' z ≤ 0} ⊆ S := ParabolaChordLemmas.negativeJoinCut (S := S) (T + := T) D' hS hneg hpos haff hzero + have hAeq : HA = H ∩ {z | D z ≤ 0} := ParabolaChordLemmas.hAeq n q a b u v hzeroLine hDcombo + hAcut hBcut hHjoin hchordA negativeJoinCut + have hBeq : HB = H ∩ {z | 0 ≤ D z} := ParabolaChordLemmas.hBeq n q a b u v hzeroLine hDcombo + hAcut hBcut hHjoin hchordB negativeJoinCut + have hunion : HA ∪ HB = H := ParabolaChordLemmas.hunion n q a b u v hAeq hBeq + have hinter : HA ∩ HB = segment Real (q a) (q b) := ParabolaChordLemmas.hinter n q a b u v + hzeroLine hAeq hBeq + exact ⟨hne, hANodup, hBNodup, hAsubRoot, hBcyclic, hsets, + hUneg, hVpos, hAeq, hBeq, hunion, hinter⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean new file mode 100644 index 0000000000..604917207c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean @@ -0,0 +1,1329 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3555T2ParabolaSupporting +public import Mathlib.Analysis.Convex.Topology +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Algebra.Order.Floor.Semiring +public import LeanPool.ApollonianSuperharmonic.P3381T1AffineTriangleMap + +-- [TABLET NODE: P3555T2ParabolaHullFrontier] + +/-! +# P3555T2ParabolaHullFrontier + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ParabolaHullConstruction + +private theorem seg_rep (a b x : Real × Real) (hx : x ∈ segment Real a b) : + ∃ t : Real, t ∈ Set.Icc 0 1 ∧ x = (1-t) • a + t • b := by + classical + rw [segment_eq_image_lineMap] at hx + rcases hx with ⟨t, ht, htx⟩ + refine ⟨t, ht, ?_⟩ + rw [← htx] + simp [AffineMap.lineMap_apply_module] + +private theorem det_affine (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (i : Fin (n + 3)) (a b : Real × + Real) (t : Real) : + P3381T1TriangleDeterminant ![q i, q (i+1), (1-t) • a + t • b] = + (1-t) * P3381T1TriangleDeterminant ![q i, q (i+1), a] + + t * P3381T1TriangleDeterminant ![q i, q (i+1), b] := by + classical + simp [P3381T1TriangleDeterminant, Prod.smul_fst, Prod.smul_snd] + ring + +private theorem det_zero_left (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (i : Fin (n + 3)) : + P3381T1TriangleDeterminant ![q i, q (i+1), q i] = 0 := by + classical + simp [P3381T1TriangleDeterminant] + +private theorem det_zero_right (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (i : Fin (n + 3)) : + P3381T1TriangleDeterminant ![q i, q (i+1), q (i+1)] = 0 := by + classical + simp [P3381T1TriangleDeterminant] + +private theorem endpoint_det_nonneg (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (hsupport : ∀ (i j : Fin (n + + 3)), j ≠ i → j ≠ i + 1 → 0 < P3381T1TriangleDeterminant ![q i, q (i + 1), q j]) + (det_zero_left : ∀ (i : Fin (n + 3)), P3381T1TriangleDeterminant ![q i, q (i + 1), q i] = + 0) (det_zero_right : ∀ (i : Fin (n + 3)), P3381T1TriangleDeterminant ![q i, q (i + 1), q (i + + 1)] = 0) (i k : Fin (n + 3)) : + 0 ≤ P3381T1TriangleDeterminant ![q i, q (i+1), q k] := by + classical + by_cases h : k = i ∨ k = i+1 + · rcases h with h | h + · subst k + simp [det_zero_left] + · subst k + simp [det_zero_right] + · exact (hsupport i k (by tauto) (by tauto)).le + +private theorem no_two_cycle (n : ℕ) (i : Fin (n + 3)) : i + 1 + 1 ≠ i := by + classical + intro h + by_cases hi : i = Fin.last (n + 2) + · have h1 : (i+1).val = 0 := by simp [hi] + have h2 : (i+1+1).val = 1 := by + have hlast : i+1 = (0 : Fin (n+3)) := by + apply Fin.ext + simp [hi] + simp [hlast] + have hv := congrArg Fin.val h + rw [h2] at hv + simp [hi] at hv + · have h1 : (i+1).val = i.val + 1 := by simp [Fin.val_add_one, hi] + by_cases hi1 : i+1 = Fin.last (n+2) + · have h2 : (i+1+1).val = 0 := by simp [hi1] + have hv := congrArg Fin.val h + rw [h2] at hv + have hi1v : (i+1).val = n+2 := by simp [hi1] + omega + · have h2 : (i+1+1).val = i.val + 2 := by + simp [Fin.val_add_one, hi, hi1] + have hv := congrArg Fin.val h + rw [h2] at hv + omega + +private noncomputable abbrev M (n : ℕ) : Real := by + classical + let M : Real := (n+2 : Nat) + exact M + +private noncomputable abbrev kmax (n : ℕ) : Fin (n+3) := by + classical + let kmax : Fin (n+3) := Fin.last (n+2) + exact kmax + +private theorem hqzero (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (hq : ∀ (i : Fin (n + 3)), q i = ((↑(↑i + : ℕ) : ℝ), (↑(↑i : ℕ) : ℝ) ^ 2)) : q (0 : Fin (n+3)) = (0,0) := by + classical + rw [hq]; simp + +private theorem hqmax (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (hq : ∀ (i : Fin (n + 3)), q i = ((↑(↑i : + ℕ) : ℝ), (↑(↑i : ℕ) : ℝ) ^ 2)) : q (kmax n) = ((M n),(M n)^2) := by + classical + let M : Real := (n+2 : Nat) + let kmax : Fin (n+3) := Fin.last (n+2) + change (q kmax = (M,M^2)) + rw [hq] + simp [kmax, M] + +private noncomputable abbrev L (n : ℕ) (j : Fin (n + 2)) (x : Real) : Real := by + classical + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + exact L j x + +private noncomputable abbrev D (n : ℕ) : Set (Real × Real) := by + classical + let M : Real := (n+2 : Nat) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ + ∀ j : Fin (n+2), L j z.1 ≤ z.2} + exact D + +private theorem hvertex (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (hq : ∀ (i : Fin (n + 3)), q i = ((↑(↑i + : ℕ) : ℝ), (↑(↑i : ℕ) : ℝ) ^ 2)) : ∀ k : Fin (n+3), q k ∈ (D n) := by + classical + let M : Real := (n+2 : Nat) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ + ∀ j : Fin (n+2), L j z.1 ≤ z.2} + change (∀ k : Fin (n+3), q k ∈ D) + intro k + rw [hq k] + have hkM : k.val ≤ n+2 := by omega + have hkM' : (k.val : Real) ≤ M := by + dsimp [M] + exact_mod_cast hkM + refine ⟨Nat.cast_nonneg _, ?_, ?_, ?_⟩ + · change (k.val : Real) ≤ M + exact hkM' + · change (k.val : Real)^2 ≤ M * (k.val : Real) + nlinarith [mul_nonneg (show 0 ≤ (k.val : Real) by positivity) + (sub_nonneg.mpr hkM')] + · intro j + have hkcase : k.val ≤ j.val ∨ j.val < k.val := by omega + have hprod : 0 ≤ ((k.val : Real)-(j.val : Real)) * + ((k.val : Real)-(j.val : Real)-1) := by + rcases hkcase with hk | hk + · have hk' : (k.val : Real) ≤ (j.val : Real) := by exact_mod_cast hk + exact mul_nonneg_of_nonpos_of_nonpos (sub_nonpos.mpr hk') (by linarith) + · have hk' : (j.val : Real)+1 ≤ (k.val : Real) := by exact_mod_cast (Nat.succ_le_iff.mpr hk) + have hk'' : (j.val : Real) ≤ (k.val : Real) := by linarith + exact mul_nonneg (sub_nonneg.mpr hk'') (by linarith) + dsimp [L] + nlinarith [hprod] + +private theorem hDconv (n : ℕ) (seg_rep : ∀ (a b x : ℝ × ℝ), x ∈ segment ℝ a b → ∃ t ∈ Set.Icc (0 + : ℝ) 1, x = (1 - t) • a + t • b) : Convex Real (D n) := by + classical + let M : Real := (n+2 : Nat) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ + ∀ j : Fin (n+2), L j z.1 ≤ z.2} + change (Convex Real D) + rw [convex_iff_segment_subset] + intro a ha b hb z hz + obtain ⟨t, ht, hzt⟩ := seg_rep a b z hz + rw [hzt] + rcases ha with ⟨ha0, haM, haU, haL⟩ + rcases hb with ⟨hb0, hbM, hbU, hbL⟩ + have ht0 : 0 ≤ t := ht.1 + have ht1 : 0 ≤ 1-t := sub_nonneg.mpr ht.2 + have hlin (j : Fin (n+2)) : + L j ((1-t)*a.1+t*b.1) = (1-t)*L j a.1+t*L j b.1 := by + dsimp [L] + ring + refine ⟨?_, ?_, ?_, ?_⟩ + · change 0 ≤ (1-t)*a.1+t*b.1 + nlinarith [mul_nonneg ht1 ha0, mul_nonneg ht0 hb0] + · change (1-t)*a.1+t*b.1 ≤ M + nlinarith [mul_nonneg ht1 (sub_nonneg.mpr haM), + mul_nonneg ht0 (sub_nonneg.mpr hbM)] + · change (1-t)*a.2+t*b.2 ≤ M*((1-t)*a.1+t*b.1) + nlinarith [mul_nonneg ht1 (sub_nonneg.mpr haU), + mul_nonneg ht0 (sub_nonneg.mpr hbU)] + · intro j + change L j ((1-t)*a.1+t*b.1) ≤ (1-t)*a.2+t*b.2 + rw [hlin] + nlinarith [mul_nonneg ht1 (sub_nonneg.mpr (haL j)), + mul_nonneg ht0 (sub_nonneg.mpr (hbL j))] + +private theorem hKD (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (hvertex : ∀ (k : Fin (n + 3)), q k ∈ (D + n)) (hDconv : Convex ℝ (D n)) : convexHull Real (Set.range q) ⊆ (D n) := by + classical + let M : Real := (n+2 : Nat) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ + ∀ j : Fin (n+2), L j z.1 ≤ z.2} + change (∀ (k : Fin (n + 3)), q k ∈ D) at hvertex + change (Convex ℝ D) at hDconv + change (convexHull Real (Set.range q) ⊆ D) + apply convexHull_min + · rintro z ⟨k, rfl⟩ + exact hvertex k + · exact hDconv + +private theorem choose_interval (n : ℕ) (x : Real) (hx0 : 0 ≤ x) (hxM : x ≤ (M n)) : + ∃ j : Fin (n+2), (j.val : Real) ≤ x ∧ x ≤ (j.val : Real)+1 := by + classical + let M : Real := (n+2 : Nat) + change x ≤ M at hxM + let r := min ⌊x⌋₊ (n+1) + have hfloor : (⌊x⌋₊ : Real) ≤ x := Nat.floor_le hx0 + have hr_le : r ≤ n+1 := Nat.min_le_right _ _ + have hr_cast : (r : Real) ≤ x := by + exact (Nat.cast_le.mpr (Nat.min_le_left _ _)).trans hfloor + have hx_lt : x < (⌊x⌋₊ : Real)+1 := Nat.lt_floor_add_one x + have hr_lt : x ≤ (r : Real)+1 := by + by_cases hcap : ⌊x⌋₊ ≤ n+1 + · have hr : r = ⌊x⌋₊ := Nat.min_eq_left hcap + rw [hr] + exact hx_lt.le + · have hfloorM : ⌊x⌋₊ = n+2 := by + have hfloor_le : ⌊x⌋₊ ≤ n+2 := by + apply Nat.floor_le_of_le + simpa [M] using hxM + omega + have hx_eq : x = M := by + have hfcast : (n : Real)+2 ≤ x := by + simpa [Nat.cast_add] using + (show (↑(n+2) : Real) ≤ x by rw [← hfloorM]; exact hfloor) + exact le_antisymm (by simpa [M] using hxM) (by simpa [M] using hfcast) + have hr : r = n+1 := by simp [r, hfloorM] + rw [hx_eq, hr] + change (↑(n+2) : Real) ≤ (↑(n+1) : Real)+1 + exact_mod_cast (show n+2 ≤ n+1+1 by omega) + refine ⟨⟨r, by omega⟩, ?_, ?_⟩ + · exact hr_cast + · exact hr_lt + +private theorem segment_combo_mem (a b : Real × Real) (t : Real) + (ht : t ∈ Set.Icc (0 : Real) 1) : + (1-t) • a + t • b ∈ segment Real a b := by + classical + rw [segment_eq_image_lineMap] + refine ⟨t, ht, ?_⟩ + simp [AffineMap.lineMap_apply_module] + +private theorem qmem (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (i : Fin (n + 3)) : q i ∈ convexHull Real + (Set.range q) := by + classical + exact subset_convexHull Real _ (Set.mem_range_self i) + +private theorem segment_memK (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (qmem : ∀ (i : Fin (n + 3)), q i ∈ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (Set.range q)) (a b : Fin (n + 3)) : + segment Real (q a) (q b) ⊆ convexHull Real (Set.range q) := by + classical + intro z hz + exact (convex_convexHull Real (Set.range q)).segment_subset (qmem a) (qmem b) hz + +private theorem hDK (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (hq : ∀ (i : Fin (n + 3)), q i = ((↑(↑i : + ℕ) : ℝ), (↑(↑i : ℕ) : ℝ) ^ 2)) (hqzero : q 0 = (0, 0)) (hqmax : q (kmax n) = ((M n), (M n) ^ + 2)) (choose_interval : ∀ (x : ℝ), 0 ≤ x → x ≤ (M n) → ∃ (j : Fin (n + 2)), (↑(↑j : ℕ) : ℝ) ≤ + x ∧ x ≤ (↑(↑j : ℕ) : ℝ) + 1) (segment_combo_mem : ∀ (a b : ℝ × ℝ), ∀ t ∈ Set.Icc (0 : ℝ) 1, + (1 - t) • a + t • b ∈ segment ℝ a b) (qmem : ∀ (i : Fin (n + 3)), q i ∈ (convexHull ℝ : Set + (ℝ × ℝ) → Set (ℝ × ℝ)) (Set.range q)) (segment_memK : ∀ (a b : Fin (n + 3)), segment ℝ (q a) + (q b) ⊆ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (Set.range q)) : (D n) ⊆ convexHull Real + (Set.range q) := by + classical + let M : Real := (n+2 : Nat) + let kmax : Fin (n+3) := Fin.last (n+2) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ + ∀ j : Fin (n+2), L j z.1 ≤ z.2} + change (q kmax = (M, M ^ 2)) at hqmax + change (∀ (x : ℝ), 0 ≤ x → x ≤ M → ∃ (j : Fin (n + 2)), (↑(↑j : ℕ) : ℝ) ≤ x ∧ x ≤ (↑(↑j : ℕ) : + ℝ) + 1) at choose_interval + change (D ⊆ convexHull Real (Set.range q)) + intro z hz + rcases hz with ⟨hx0, hxM, hyU, hyL⟩ + by_cases hxzero : z.1 = 0 + · have hlow := hyL (⟨0, by omega⟩ : Fin (n+2)) + have hylo : 0 ≤ z.2 := by simpa [L, hxzero] using hlow + have hyhi : z.2 ≤ 0 := by simpa [hxzero] using hyU + have hz : z = q (0 : Fin (n+3)) := by + apply Prod.ext + · rw [hxzero, hqzero] + · rw [hqzero] + exact le_antisymm hyhi hylo + rw [hz] + exact qmem 0 + by_cases hxmax : z.1 = M + · let jt : Fin (n+2) := ⟨n+1, by omega⟩ + have hlow := hyL jt + have hline : L jt M = M^2 := by + dsimp [L, jt, M] + push_cast + ring + have hylo : M^2 ≤ z.2 := by simpa [hxmax, hline] using hlow + have hyhi : z.2 ≤ M^2 := by rw [hxmax] at hyU; nlinarith [hyU] + have hz : z = q kmax := by + apply Prod.ext + · rw [hxmax, hqmax] + · rw [hqmax] + exact le_antisymm hyhi hylo + rw [hz] + exact qmem kmax + have hxpos : 0 < z.1 := by + apply lt_of_le_of_ne hx0 + intro h + exact hxzero h.symm + have hxlt : z.1 < M := lt_of_le_of_ne hxM hxmax + obtain ⟨j, hjx, hxj⟩ := choose_interval z.1 hx0 hxM + let jj : Fin (n+3) := ⟨j.val, by omega⟩ + let jn : Fin (n+3) := jj+1 + have hjne : jj ≠ Fin.last (n+2) := by + intro h + have hv := congrArg Fin.val h + simp [jj] at hv + omega + have hval : jn.val = j.val+1 := by + simp [jn, Fin.val_add_one, hjne, jj] + let t : Real := z.1 - (j.val : Real) + have ht : t ∈ Set.Icc (0 : Real) 1 := by + constructor + · dsimp [t] + exact sub_nonneg.mpr hjx + · dsimp [t] + have hxj' : z.1 ≤ (j.val : Real)+1 := hxj + linarith + let lower : Real × Real := (1-t) • q jj + t • q jn + have hlower : lower = (z.1, L j z.1) := by + apply Prod.ext + · dsimp [lower, t] + rw [hq jj, hq jn] + simp only [] + have hval' : (jn.val : Real) = (j.val : Real)+1 := by exact_mod_cast hval + rw [hval'] + ring + · dsimp [lower, t] + rw [hq jj, hq jn] + simp only [] + have hval' : (jn.val : Real) = (j.val : Real)+1 := by exact_mod_cast hval + rw [hval'] + dsimp [L] + ring + have hMpos : 0 < M := by dsimp [M]; positivity + let s : Real := z.1 / M + have hs : s ∈ Set.Icc (0 : Real) 1 := by + constructor + · dsimp [s] + exact div_nonneg hx0 hMpos.le + · dsimp [s] + exact (div_le_one hMpos).2 (by simpa [M] using hxM) + let upper : Real × Real := (1-s) • q (0:Fin (n+3)) + s • q kmax + have hupper : upper = (z.1, M*z.1) := by + apply Prod.ext + · dsimp [upper, s] + rw [hqzero, hqmax] + simp only [] + field_simp [ne_of_gt hMpos] + ring + · dsimp [upper, s] + rw [hqzero, hqmax] + simp only [] + field_simp [ne_of_gt hMpos] + ring + have hlower_mem : lower ∈ convexHull Real (Set.range q) := + segment_memK jj jn (segment_combo_mem (q jj) (q jn) t ht) + have hupper_mem : upper ∈ convexHull Real (Set.range q) := + segment_memK (0:Fin (n+3)) kmax (segment_combo_mem + (q (0:Fin (n+3))) (q kmax) s hs) + have hy_bounds : L j z.1 ≤ z.2 ∧ z.2 ≤ M*z.1 := ⟨hyL j, hyU⟩ + let A : Real := (j.val : Real) * (M - (j.val : Real)) + let B : Real := ((j.val : Real)+1) * (M - (j.val : Real)-1) + have hJplus : (j.val : Real)+1 ≤ M := by + have hc : ((j.val+1 : Nat) : Real) ≤ ((n+2 : Nat) : Real) := by + exact_mod_cast (show j.val+1 ≤ n+2 by omega) + simpa [M, Nat.cast_add] using hc + have hA : 0 ≤ A := by + dsimp [A] + exact mul_nonneg (Nat.cast_nonneg _) (by linarith) + have hB : 0 ≤ B := by + dsimp [B] + exact mul_nonneg (by positivity) (by linarith [hJplus]) + have hfactor : M*z.1 - L j z.1 = (1-t)*A+t*B := by + dsimp [A, B, L, t] + ring + have hgap : L j z.1 < M*z.1 := by + by_cases hj0 : j.val = 0 + · have hJ : (j.val : Real) = 0 := by exact_mod_cast hj0 + have htEq : t = z.1 := by dsimp [t]; rw [hJ]; ring + have hAeq : A = 0 := by dsimp [A]; rw [hJ]; ring + have hBpos : 0 < B := by + dsimp [B] + rw [hJ] + nlinarith [show 2 ≤ M by dsimp [M]; exact_mod_cast (show 2 ≤ n+2 by omega)] + rw [← sub_pos, hfactor, htEq, hAeq] + simpa using mul_pos hxpos hBpos + · have hJpos : 0 < (j.val : Real) := by + exact_mod_cast (Nat.pos_of_ne_zero hj0) + have hApos : 0 < A := by + dsimp [A] + exact mul_pos hJpos (by linarith [hJplus]) + by_cases htlt : t < 1 + · rw [← sub_pos, hfactor] + exact add_pos_of_pos_of_nonneg + (mul_pos (sub_pos.mpr htlt) hApos) (mul_nonneg ht.1 hB) + · have htEq : t = 1 := le_antisymm ht.2 (le_of_not_gt htlt) + have hxEq : z.1 = (j.val : Real)+1 := by + dsimp [t] at htEq + linarith + have hJstrict : (j.val : Real)+1 < M := by linarith [hxEq, hxlt] + have hBpos : 0 < B := by + dsimp [B] + exact mul_pos (by linarith [hJpos]) (by linarith [hJstrict]) + rw [← sub_pos, hfactor, htEq] + simpa using hBpos + let u : Real := (z.2 - L j z.1) / (M*z.1 - L j z.1) + have hu : u ∈ Set.Icc (0 : Real) 1 := by + constructor + · dsimp [u] + exact div_nonneg (sub_nonneg.mpr hy_bounds.1) (le_of_lt (sub_pos.mpr hgap)) + · dsimp [u] + apply (div_le_iff₀ (sub_pos.mpr hgap)).2 + nlinarith [hy_bounds.2] + have hzline : z = (1-u) • lower + u • upper := by + apply Prod.ext + · rw [hlower, hupper] + simp only [Prod.smul_fst, Prod.fst_add, smul_eq_mul] + ring + · rw [hlower, hupper] + simp only [Prod.smul_snd, Prod.snd_add, smul_eq_mul] + dsimp [u] + field_simp [ne_of_gt (sub_pos.mpr hgap)] + ring + rw [hzline] + exact (convex_convexHull Real (Set.range q)).segment_subset hlower_mem hupper_mem + (segment_combo_mem lower upper u hu) + +private theorem hHullEq (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (hKD : (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (Set.range q) ⊆ (D n)) (hDK : (D n) ⊆ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (Set.range q)) : convexHull Real (Set.range q) = (D n) := by + classical + let M : Real := (n+2 : Nat) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ + ∀ j : Fin (n+2), L j z.1 ≤ z.2} + change ((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (Set.range q) ⊆ D) at hKD + change (D ⊆ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (Set.range q)) at hDK + change (convexHull Real (Set.range q) = D) + exact Set.Subset.antisymm hKD hDK + +private theorem lowerEdge (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (hq : ∀ (i : Fin (n + 3)), q i = + ((↑(↑i : ℕ) : ℝ), (↑(↑i : ℕ) : ℝ) ^ 2)) (segment_combo_mem : ∀ (a b : ℝ × ℝ), ∀ t ∈ Set.Icc + (0 : ℝ) 1, (1 - t) • a + t • b ∈ segment ℝ a b) (j : Fin (n + 2)) (x : Real) + (hx0 : (j.val : Real) ≤ x) (hx1 : x ≤ (j.val : Real) + 1) : + (x, (L n) j x) ∈ segment Real (q ⟨j.val, by omega⟩) + (q ((⟨j.val, by omega⟩ : Fin (n+3))+1)) := by + classical + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + change ((x, L j x) ∈ segment Real (q ⟨j.val, by omega⟩) + (q ((⟨j.val, by omega⟩ : Fin (n+3))+1))) + let jj : Fin (n+3) := ⟨j.val, by omega⟩ + let jn : Fin (n+3) := jj+1 + have hjne : jj ≠ Fin.last (n+2) := by + intro h + have hv := congrArg Fin.val h + simp [jj] at hv + omega + have hval : jn.val = j.val+1 := by simp [jn, Fin.val_add_one, hjne, jj] + let t : Real := x-(j.val:Real) + have ht : t ∈ Set.Icc (0 : Real) 1 := by + constructor + · dsimp [t] + exact sub_nonneg.mpr hx0 + · dsimp [t] + linarith [hx1] + have hpoint : (x,L j x) = (1-t) • q jj+t • q jn := by + apply Prod.ext + · dsimp [t] + rw [hq jj,hq jn] + simp only [] + have hval' : (jn.val:Real)=(j.val:Real)+1 := by exact_mod_cast hval + rw [hval'] + ring + · dsimp [t] + rw [hq jj,hq jn] + simp only [] + have hval' : (jn.val:Real)=(j.val:Real)+1 := by exact_mod_cast hval + rw [hval'] + dsimp [L] + ring + rw [hpoint] + exact segment_combo_mem (q jj) (q jn) t ht + +private theorem upperEdge (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (hqzero : q 0 = (0, 0)) (hqmax : q + (kmax n) = ((M n), (M n) ^ 2)) (segment_combo_mem : ∀ (a b : ℝ × ℝ), ∀ t ∈ Set.Icc (0 : ℝ) 1, + (1 - t) • a + t • b ∈ segment ℝ a b) (x : Real) (hx0 : 0 ≤ x) (hxM : x ≤ (M n)) : + (x, (M n)*x) ∈ segment Real (q (0 : Fin (n+3))) (q (kmax n)) := by + classical + let M : Real := (n+2 : Nat) + let kmax : Fin (n+3) := Fin.last (n+2) + change (q kmax = (M, M ^ 2)) at hqmax + change ((x, M*x) ∈ segment Real (q (0 : Fin (n+3))) (q kmax)) + have hMpos : 0 < M := by dsimp [M]; positivity + let s : Real := x/M + have hs : s ∈ Set.Icc (0 : Real) 1 := by + constructor + · dsimp [s] + exact div_nonneg hx0 hMpos.le + · dsimp [s] + exact (div_le_one hMpos).2 hxM + have hpoint : (x, M*x) = (1-s) • q (0 : Fin (n+3)) + s • q kmax := by + apply Prod.ext + · dsimp [s] + rw [hqzero,hqmax] + simp only [] + field_simp [ne_of_gt hMpos] + ring + · dsimp [s] + rw [hqzero,hqmax] + simp only [] + field_simp [ne_of_gt hMpos] + ring + rw [hpoint] + exact segment_combo_mem (q (0 : Fin (n+3))) (q kmax) s hs + +private theorem edgeLowerEquation (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (hq : ∀ (i : Fin (n + 3)), q + i = ((↑(↑i : ℕ) : ℝ), (↑(↑i : ℕ) : ℝ) ^ 2)) (seg_rep : ∀ (a b x : ℝ × ℝ), x ∈ segment ℝ a b → + ∃ t ∈ Set.Icc (0 : ℝ) 1, x = (1 - t) • a + t • b) (i : Fin (n + 3)) (hi : i ≠ (kmax n)) (z : + Real × Real) + (hz : z ∈ segment Real (q i) (q (i + 1))) : + ∃ j : Fin (n+2), (L n) j z.1 = z.2 := by + classical + let kmax : Fin (n+3) := Fin.last (n+2) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + change (∃ j : Fin (n+2), L j z.1 = z.2) + have hival : i.val ≤ n+1 := by + by_contra hn + have : i.val = n+2 := by omega + apply hi + apply Fin.ext + simpa [kmax] using this + let j : Fin (n+2) := ⟨i.val, by omega⟩ + have hnext : (i+1).val = i.val+1 := by + simp [Fin.val_add_one, hi] + have hnextR : ((i+1).val : Real) = (i.val : Real)+1 := by exact_mod_cast hnext + obtain ⟨t, ht, hzt⟩ := seg_rep (q i) (q (i+1)) z hz + refine ⟨j, ?_⟩ + rw [hzt, hq i, hq (i+1)] + simp only [Prod.smul_fst, Prod.fst_add, Prod.smul_snd, Prod.snd_add, smul_eq_mul] + have hjval : (j.val : Real) = (i.val : Real) := by rfl + rw [hnextR, hjval] + dsimp [L] + ring + +private theorem edgeUpperEquation (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (seg_rep : ∀ (a b x : ℝ × ℝ), + x ∈ segment ℝ a b → ∃ t ∈ Set.Icc (0 : ℝ) 1, x = (1 - t) • a + t • b) (hqzero : q 0 = (0, 0)) + (hqmax : q (kmax n) = ((M n), (M n) ^ 2)) (z : Real × Real) + (hz : z ∈ segment Real (q (kmax n)) (q ((kmax n) + 1))) : + z.2 = (M n)*z.1 := by + classical + let M : Real := (n+2 : Nat) + let kmax : Fin (n+3) := Fin.last (n+2) + change (q kmax = (M, M ^ 2)) at hqmax + change (z.2 = M*z.1) + have hwrap : kmax+1 = (0 : Fin (n+3)) := by + apply Fin.ext + simp [kmax] + obtain ⟨t, ht, hzt⟩ := seg_rep (q kmax) (q (kmax+1)) z hz + rw [hzt, hqmax, hwrap, hqzero] + simp only [Prod.smul_fst, Prod.fst_add, Prod.smul_snd, Prod.snd_add, smul_eq_mul] + ring + +private theorem hcompact (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) : IsCompact ((convexHull ℝ : Set (ℝ × + ℝ) → Set (ℝ × ℝ)) (Set.range q)) := by + classical + exact (Set.finite_range q).isCompact_convexHull Real + +end ParabolaHullConstruction + +namespace ParabolaHullInterior + +private theorem hshared : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 + : ℕ))), ∀ (t : ℝ), ((1-t) * P3381T1TriangleDeterminant ![q i, q (i+1), q j] = 0) → (t * + P3381T1TriangleDeterminant ![q i, q (i+1), q (j+1)] = 0) → (j ≠ i ∧ j ≠ i+1 → 0 < + P3381T1TriangleDeterminant ![q i, q (i+1), q j]) → (j+1 ≠ i ∧ j+1 ≠ i+1 → 0 < + P3381T1TriangleDeterminant ![q i, q (i+1), q (j+1)]) → (j = i ∨ j = i+1) ∨ (j+1 = i ∨ + j+1 = i+1) := by + classical + intro n q i j t hleftzero hrightzero hleftstrict hrightstrict + by_cases hj : j = i ∨ j = i+1 + · exact Or.inl hj + · right + by_contra hj' + have hp₁ := hleftstrict ⟨by tauto, by tauto⟩ + have hp₂ := hrightstrict ⟨by tauto, by tauto⟩ + have htone : 1-t = 0 := (mul_eq_zero.mp hleftzero).resolve_right hp₁.ne' + have htzero : t = 0 := (mul_eq_zero.mp hrightzero).resolve_right hp₂.ne' + linarith + +private theorem hnotboth : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), (∀ (i : Fin (n + 3)), i + 1 + 1 ≠ i) → ∀ (i : + Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ∀ (x : ℝ × ℝ), (x ∈ segment ℝ (q + j) (q (j + (1 : Fin (n + (3 : ℕ)))))) → ∀ (t : ℝ), (x = ((1 : ℝ) - t) • q j + t • q (j + + (1 : Fin (n + (3 : ℕ))))) → (((1 : ℝ) - t) * P3381T1TriangleDeterminant ![q i, q (i + + (1 : Fin (n + (3 : ℕ)))), q j] + t * P3381T1TriangleDeterminant ![q i, q (i + (1 : Fin + (n + (3 : ℕ)))), q (j + (1 : Fin (n + (3 : ℕ))))] = (0 : ℝ)) → + (P3381T1TriangleDeterminant ![q i, q (i + (1 : Fin (n + (3 : ℕ)))), ((1 : ℝ) - t) • q j + + t • q (j + (1 : Fin (n + (3 : ℕ))))] = ((1 : ℝ) - t) * P3381T1TriangleDeterminant ![q + i, q (i + (1 : Fin (n + (3 : ℕ)))), q j] + t * P3381T1TriangleDeterminant ![q i, q (i + + (1 : Fin (n + (3 : ℕ)))), q (j + (1 : Fin (n + (3 : ℕ))))]) → (0 ≤ (1-t) * + P3381T1TriangleDeterminant ![q i, q (i+1), q j]) → (0 ≤ t * + P3381T1TriangleDeterminant ![q i, q (i+1), q (j+1)]) → ((1-t) * + P3381T1TriangleDeterminant ![q i, q (i+1), q j] = 0) → (t * + P3381T1TriangleDeterminant ![q i, q (i+1), q (j+1)] = 0) → (j ≠ i ∧ j ≠ i+1 → 0 < + P3381T1TriangleDeterminant ![q i, q (i+1), q j]) → (j+1 ≠ i ∧ j+1 ≠ i+1 → 0 < + P3381T1TriangleDeterminant ![q i, q (i+1), q (j+1)]) → ((j = i ∨ j = i+1) ∨ (j+1 = i ∨ + j+1 = i+1)) → ¬ ((j = i ∨ j = i+1) ∧ (j+1 = i ∨ j+1 = i+1)) := by + classical + intro n q no_two_cycle i j hij x hxj t hxt hz hcomb hleft hright hleftzero hrightzero + hleftstrict hrightstrict hshared + rintro ⟨hj, hj'⟩ + rcases hj with hj | hj <;> rcases hj' with hj' | hj' + · subst j + have hne : i+1 ≠ i := by + intro h + have hv := congrArg Fin.val h + by_cases hi : i = Fin.last (n+2) + · simp [hi] at hv + · have hv' : (i+1).val = i.val+1 := by simp [Fin.val_add_one, hi] + rw [hv'] at hv + omega + exact hne hj' + · subst j + exact hij (add_right_cancel hj') + · subst j + exact no_two_cycle i hj' + · exact hij (add_right_cancel hj'.symm) + +private theorem hxend : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 + : ℕ))), ∀ (x : ℝ × ℝ), ∀ (t : ℝ), (x = ((1 : ℝ) - t) • q j + t • q (j + (1 : Fin (n + (3 + : ℕ))))) → ((1-t) * P3381T1TriangleDeterminant ![q i, q (i+1), q j] = 0) → (t * + P3381T1TriangleDeterminant ![q i, q (i+1), q (j+1)] = 0) → (j ≠ i ∧ j ≠ i+1 → 0 < + P3381T1TriangleDeterminant ![q i, q (i+1), q j]) → (j+1 ≠ i ∧ j+1 ≠ i+1 → 0 < + P3381T1TriangleDeterminant ![q i, q (i+1), q (j+1)]) → ((j = i ∨ j = i+1) ∨ (j+1 = i ∨ + j+1 = i+1)) → (¬ ((j = i ∨ j = i+1) ∧ (j+1 = i ∨ j+1 = i+1))) → x = q j ∧ (j = i ∨ j = + i+1) ∨ + x = q (j+1) ∧ (j+1 = i ∨ j+1 = i+1) := by + classical + intro n q i j x t hxt hleftzero hrightzero hleftstrict hrightstrict hshared hnotboth + rcases hshared with hj | hj' + · have hj' : ¬ (j+1 = i ∨ j+1 = i+1) := fun h => hnotboth ⟨hj,h⟩ + have hp := hrightstrict ⟨by tauto, by tauto⟩ + have ht0 : t = 0 := (mul_eq_zero.mp hrightzero).resolve_right hp.ne' + left + refine ⟨?_, hj⟩ + rw [hxt, ht0] + simp + · have hj : ¬ (j = i ∨ j = i+1) := by + intro h + exact hnotboth ⟨h,hj'⟩ + have hp := hleftstrict ⟨by tauto, by tauto⟩ + have ht1 : 1-t = 0 := (mul_eq_zero.mp hleftzero).resolve_right hp.ne' + right + refine ⟨?_, hj'⟩ + rw [hxt] + have : t = 1 := by linarith + rw [this] + simp + +private theorem hUopen : + let U : Set (Real × Real) := {z | 0 < z.1 ∧ 0 < z.2 ∧ z.1+z.2 < 1} + IsOpen U := by + classical + intro U + have hEq : U = {z | 0 < z.1} ∩ {z | 0 < z.2} ∩ {z | z.1+z.2 < 1} := by + ext z + constructor + · rintro ⟨h1,h2,h3⟩ + exact ⟨⟨h1,h2⟩,h3⟩ + · rintro ⟨⟨h1,h2⟩,h3⟩ + exact ⟨h1,h2,h3⟩ + rw [hEq] + exact ((isOpen_lt continuous_const continuous_fst).inter + (isOpen_lt continuous_const continuous_snd)).inter + (isOpen_lt (continuous_fst.add continuous_snd) continuous_const) + +private theorem hUsub : + let p : Fin 3 → Real × Real := ![(0,0),(1,0),(0,1)] + let w (z : Real × Real) : Fin 3 → Real := ![1-z.1-z.2,z.1,z.2] + (∀ (z : Real × Real), (∑ i, w z i) = 1) → (∀ (z : Real × Real), (∑ i, w z i • p i) = z) → + let U : Set (Real × Real) := {z | 0 < z.1 ∧ 0 < z.2 ∧ z.1+z.2 < 1} + U ⊆ convexHull Real (Set.range p) := by + classical + intro p w hw_sum hp_sum U z hz + apply mem_convexHull_of_exists_fintype (w z) p + · intro i + fin_cases i + · dsimp [w] + linarith [hz.2.2] + · dsimp [w] + exact hz.1.le + · dsimp [w] + exact hz.2.1.le + · exact hw_sum z + · intro i + exact Set.mem_range_self i + · exact hp_sum z + +private theorem hImageSub : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), + let f : Fin 3 → Fin (n+3) := fun i => ⟨i.val, by omega⟩ + let p : Fin 3 → Real × Real := ![(0,0),(1,0),(0,1)] + ∀ (H : ℝ × ℝ ≃ₜ ℝ × ℝ), (∀ (w : Fin (3 : ℕ) → ℝ), ∑ i : Fin (3 : ℕ), w i = (1 : ℝ) → (H : ℝ × + ℝ → ℝ × ℝ) (∑ i : Fin (3 : ℕ), w i • p i) = ∑ i : Fin (3 : ℕ), w i • (q ∘ f) i) → + let w (z : Real × Real) : Fin 3 → Real := ![1-z.1-z.2,z.1,z.2] + (∀ (z : Real × Real), (∑ i, w z i) = 1) → (∀ (z : Real × Real), (∑ i, w z i • p i) = z) → + let U : Set (Real × Real) := {z | 0 < z.1 ∧ 0 < z.2 ∧ z.1+z.2 < 1} + (Set.range (q ∘ f) ⊆ Set.range q) → H '' U ⊆ convexHull Real (Set.range q) := by + classical + intro n q f p H hH w hw_sum hp_sum U target_subset + rintro y ⟨z, hz, rfl⟩ + have hHz : H z = ∑ i, w z i • (q ∘ f) i := by + calc + H z = H (∑ i, w z i • p i) := congrArg H (hp_sum z).symm + _ = ∑ i, w z i • (q ∘ f) i := hH (w z) (hw_sum z) + rw [hHz] + apply mem_convexHull_of_exists_fintype (w z) (q ∘ f) + · intro i + fin_cases i + · dsimp [w] + linarith [hz.2.2] + · dsimp [w] + exact hz.1.le + · dsimp [w] + exact hz.2.1.le + · exact hw_sum z + · intro i + exact target_subset (Set.mem_range_self i) + · rfl + +private theorem hOopen : + ∀ (n : Nat), + let M : Real := (n+2 : Nat) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + let O : Set (Real × Real) := + {z | 0 < z.1 ∧ z.1 < M ∧ z.2 < M*z.1 ∧ ∀ j : Fin (n+2), L j z.1 < z.2} + IsOpen O := by + classical + intro n M L O + have hlow : IsOpen (⋂ j : Fin (n+2), {z : Real × Real | L j z.1 < z.2}) := + isOpen_iInter_of_finite fun j => isOpen_lt (by fun_prop) continuous_snd + have hEq : O = {z | 0 < z.1} ∩ + ({z | z.1 < M} ∩ ({z | z.2 < M*z.1} ∩ + ⋂ j : Fin (n+2), {z : Real × Real | L j z.1 < z.2})) := by + ext z + simp [O] + rw [hEq] + exact (isOpen_lt continuous_const continuous_fst).inter + ((isOpen_lt continuous_fst continuous_const).inter + ((isOpen_lt continuous_snd (by fun_prop)).inter hlow)) + +private theorem noLeftInterior : + ∀ (n : Nat), + let M : Real := (n+2 : Nat) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ + ∀ j : Fin (n+2), L j z.1 ≤ z.2} + (∀ (z : Real × Real), (z ∈ interior D) → ∃ e : Real, 0 < e ∧ Metric.ball z e ⊆ D) → ∀ (z : + Real × Real), (z ∈ interior D) → z.1 ≠ 0 := by + classical + intro n M L D ballAt z hz heq + obtain ⟨e,he,hball⟩ := ballAt z hz + let w : Real × Real := (z.1-e/2,z.2) + have hwball : w ∈ Metric.ball z e := by + change dist w z < e + simp [w, Prod.dist_eq, Real.dist_eq, + abs_of_pos (show 0 < e/2 by linarith)] + linarith + have hwD := hball hwball + rcases hwD with ⟨hw0,_,_,_⟩ + dsimp [w] at hw0 + rw [heq] at hw0 + linarith + +private theorem noRightInterior : + ∀ (n : Nat), + let M : Real := (n+2 : Nat) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ + ∀ j : Fin (n+2), L j z.1 ≤ z.2} + (∀ (z : Real × Real), (z ∈ interior D) → ∃ e : Real, 0 < e ∧ Metric.ball z e ⊆ D) → ∀ (z : + Real × Real), (z ∈ interior D) → z.1 ≠ M := by + classical + intro n M L D ballAt z hz heq + obtain ⟨e,he,hball⟩ := ballAt z hz + let w : Real × Real := (z.1+e/2,z.2) + have hwball : w ∈ Metric.ball z e := by + change dist w z < e + simp [w, Prod.dist_eq, Real.dist_eq, + abs_of_pos (show 0 < e/2 by linarith)] + linarith + have hwD := hball hwball + rcases hwD with ⟨_,hwM,_,_⟩ + dsimp [w] at hwM + rw [heq] at hwM + linarith + +private theorem noUpperInterior : + ∀ (n : Nat), + let M : Real := (n+2 : Nat) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ + ∀ j : Fin (n+2), L j z.1 ≤ z.2} + (∀ (z : Real × Real), (z ∈ interior D) → ∃ e : Real, 0 < e ∧ Metric.ball z e ⊆ D) → ∀ (z : + Real × Real), (z ∈ interior D) → (z.2 = M*z.1) → False := by + classical + intro n M L D ballAt z hz heq + obtain ⟨e,he,hball⟩ := ballAt z hz + let w : Real × Real := (z.1,z.2+e/2) + have hwball : w ∈ Metric.ball z e := by + change dist w z < e + simp [w, Prod.dist_eq, Real.dist_eq, + abs_of_pos (show 0 < e/2 by linarith)] + linarith + have hwD := hball hwball + rcases hwD with ⟨_,_,hwU,_⟩ + dsimp [w] at hwU + rw [heq] at hwU + linarith + +private theorem noLowerInterior : + ∀ (n : Nat), + let M : Real := (n+2 : Nat) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ + ∀ j : Fin (n+2), L j z.1 ≤ z.2} + (∀ (z : Real × Real), (z ∈ interior D) → ∃ e : Real, 0 < e ∧ Metric.ball z e ⊆ D) → ∀ (z : + Real × Real), (z ∈ interior D) → ∀ (j : Fin (n+2)), (L j z.1 = z.2) → False := by + classical + intro n M L D ballAt z hz j heq + obtain ⟨e,he,hball⟩ := ballAt z hz + let w : Real × Real := (z.1,z.2-e/2) + have hwball : w ∈ Metric.ball z e := by + change dist w z < e + simp [w, Prod.dist_eq, Real.dist_eq, + abs_of_pos (show 0 < e/2 by linarith)] + linarith + have hwD := hball hwball + have hwL := hwD.2.2.2 j + dsimp [w] at hwL + rw [heq] at hwL + linarith + +private theorem interiorStrict : + ∀ (n : Nat), + let M : Real := (n+2 : Nat) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ + ∀ j : Fin (n+2), L j z.1 ≤ z.2} + let O : Set (Real × Real) := + {z | 0 < z.1 ∧ z.1 < M ∧ z.2 < M*z.1 ∧ ∀ j : Fin (n+2), L j z.1 < z.2} + (∀ (z : Real × Real), (z ∈ interior D) → z.1 ≠ 0) → (∀ (z : Real × Real), (z ∈ interior D) → + z.1 ≠ M) → (∀ (z : Real × Real), (z ∈ interior D) → (z.2 = M*z.1) → False) → (∀ (z : Real + × Real), (z ∈ interior D) → ∀ (j : Fin (n+2)), (L j z.1 = z.2) → False) → ∀ (z : Real × + Real), (z ∈ interior D) → z ∈ O := by + classical + intro n M L D O noLeftInterior noRightInterior noUpperInterior noLowerInterior z hz + have hzD : z ∈ D := interior_subset hz + rcases hzD with ⟨hz0,hzM,hzU,hzL⟩ + have h0 : 0 < z.1 := by + apply lt_of_le_of_ne hz0 + intro h + exact noLeftInterior z hz h.symm + have hM : z.1 < M := by + apply lt_of_le_of_ne hzM + exact noRightInterior z hz + have hU : z.2 < M*z.1 := by + apply lt_of_le_of_ne hzU + intro h + exact noUpperInterior z hz h + have hL : ∀ j : Fin (n+2), L j z.1 < z.2 := by + intro j + apply lt_of_le_of_ne (hzL j) + intro h + exact noLowerInterior z hz j h + exact ⟨h0,hM,hU,hL⟩ + +private theorem heqcases : + ∀ (n : Nat), + let M : Real := (n+2 : Nat) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + let O : Set (Real × Real) := + {z | 0 < z.1 ∧ z.1 < M ∧ z.2 < M*z.1 ∧ ∀ j : Fin (n+2), L j z.1 < z.2} + ∀ (x : ℝ × ℝ), (x ∉ O) → ((0 : ℝ) ≤ x.1) → (x.1 ≤ M) → (x.2 ≤ M * x.1) → (∀ (j : Fin (n + (2 + : ℕ))), L j x.1 ≤ x.2) → x.1 = 0 ∨ x.1 = M ∨ x.2 = M*x.1 ∨ + ∃ j : Fin (n+2), L j x.1 = x.2 := by + classical + intro n M L O x hnotO hx0 hxM hxU hxL + by_cases h0 : x.1 = 0 + · exact Or.inl h0 + by_cases hM : x.1 = M + · exact Or.inr (Or.inl hM) + by_cases hU : x.2 = M*x.1 + · exact Or.inr (Or.inr (Or.inl hU)) + by_cases hL : ∃ j : Fin (n+2), L j x.1 = x.2 + · exact Or.inr (Or.inr (Or.inr hL)) + have h0' : x.1 ≠ 0 := h0 + have hM' : x.1 ≠ M := hM + have hU' : x.2 ≠ M*x.1 := hU + have hstrict0 : 0 < x.1 := lt_of_le_of_ne hx0 (Ne.symm h0') + have hstrictM : x.1 < M := lt_of_le_of_ne hxM hM' + have hstrictU : x.2 < M*x.1 := lt_of_le_of_ne hxU hU' + have hstrictL : ∀ j : Fin (n+2), L j x.1 < x.2 := by + intro j + apply lt_of_le_of_ne (hxL j) + intro heq + exact hL ⟨j, heq⟩ + exact (hnotO ⟨hstrict0,hstrictM,hstrictU,hstrictL⟩).elim + +private theorem hjlower : + ∀ (n : Nat), + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + ∀ (x : ℝ × ℝ), ((0 : ℝ) ≤ x.1) → (∀ (j : Fin (n + (2 : ℕ))), L j x.1 ≤ x.2) → ∀ (j : Fin (n + + (2 : ℕ))), (L j x.1 = x.2) → (j.val : Real) ≤ x.1 := by + classical + intro n L x hx0 hxL j hxlower + by_cases hj0 : j.val = 0 + · have : (j.val : Real) = 0 := by exact_mod_cast hj0 + rw [this] + exact hx0 + · let jm : Fin (n+2) := ⟨j.val-1, by omega⟩ + have hprev : jm.val+1=j.val := by dsimp [jm]; omega + have hprevR : (jm.val:Real)+1=(j.val:Real) := by exact_mod_cast hprev + have hineq := hxL jm + rw [← hxlower] at hineq + dsimp [L] at hineq + rw [hprevR] at hineq + nlinarith [hineq] + +private theorem hjupper : + ∀ (n : Nat), + let M : Real := (n+2 : Nat) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + ∀ (x : ℝ × ℝ), (x.1 ≤ M) → (∀ (j : Fin (n + (2 : ℕ))), L j x.1 ≤ x.2) → ∀ (j : Fin (n + (2 : + ℕ))), (L j x.1 = x.2) → x.1 ≤ (j.val : Real)+1 := by + classical + intro n M L x hxM hxL j hxlower + by_cases hjlast : j.val = n+1 + · have : (j.val : Real)+1 = M := by + dsimp [M] + exact_mod_cast congrArg Nat.succ hjlast + rw [this] + exact hxM + · let jn : Fin (n+2) := ⟨j.val+1, by omega⟩ + have hnext : jn.val=j.val+1 := by rfl + have hnextR : (jn.val:Real)=(j.val:Real)+1 := by exact_mod_cast hnext + have hineq := hxL jn + rw [← hxlower] at hineq + dsimp [L] at hineq + rw [hnextR] at hineq + nlinarith [hineq] + +private theorem hnotintK : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), + let M : Real := (n+2 : Nat) + let kmax : Fin (n+3) := Fin.last (n+2) + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ + ∀ j : Fin (n+2), L j z.1 ≤ z.2} + (∀ (i : Fin (n+3)), (i ≠ kmax) → ∀ (z : Real × Real), (z ∈ segment Real (q i) (q (i+1))) → ∃ + j : Fin (n+2), L j z.1 = z.2) → (∀ (z : Real × Real), (z ∈ segment Real (q kmax) (q + (kmax+1))) → z.2 = M*z.1) → (∀ (z : Real × Real), (z ∈ interior D) → (z.2 = M*z.1) → + False) → (∀ (z : Real × Real), (z ∈ interior D) → ∀ (j : Fin (n+2)), (L j z.1 = z.2) → + False) → ∀ (x : ℝ × ℝ), ∀ (i : Fin (n + (3 : ℕ))), (x ∈ segment ℝ (q i) (q (i + (1 : Fin + (n + (3 : ℕ)))))) → (interior (convexHull Real (Set.range q)) = interior D) → x ∉ + interior (convexHull Real (Set.range q)) := by + classical + intro n q M kmax L D edgeLowerEquation edgeUpperEquation noUpperInterior noLowerInterior x i + hxi hIntEq hxint + have hxintD : x ∈ interior D := by simpa [hIntEq] using hxint + by_cases hi : i = kmax + · subst i + have heq := edgeUpperEquation x hxi + exact noUpperInterior x hxintD heq + · obtain ⟨j,heq⟩ := edgeLowerEquation i hi x hxi + exact noLowerInterior x hxintD j heq + +end ParabolaHullInterior + +namespace ParabolaHullEdges + +private theorem edge_intersections : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + + (3 : ℕ))), j ≠ i → j ≠ i + (1 : Fin (n + (3 : ℕ))) → (0 : ℝ) < + P3381T1TriangleDeterminant ![q i, q (i + (1 : Fin (n + (3 : ℕ)))), q j]) → (∀ (a : Real + × Real), ∀ (b : Real × Real), ∀ (x : Real × Real), (x ∈ segment Real a b) → ∃ t : Real, t + ∈ Set.Icc 0 1 ∧ x = (1-t) • a + t • b) → (∀ (i : Fin (n + 3)), ∀ (a : Real × Real), ∀ (b + : Real × Real), ∀ (t : Real), P3381T1TriangleDeterminant ![q i, q (i+1), (1-t) • a + t + • b] = (1-t) * P3381T1TriangleDeterminant ![q i, q (i+1), a] + t * + P3381T1TriangleDeterminant ![q i, q (i+1), b]) → (∀ (i : Fin (n + 3)), + P3381T1TriangleDeterminant ![q i, q (i+1), q i] = 0) → (∀ (i : Fin (n + 3)), + P3381T1TriangleDeterminant ![q i, q (i+1), q (i+1)] = 0) → (∀ (i : Fin (n + 3)), ∀ + (k : Fin (n + 3)), 0 ≤ P3381T1TriangleDeterminant ![q i, q (i+1), q k]) → (∀ (i : + Fin (n + + 3)), i + 1 + 1 ≠ i) → ∀ i j : Fin (n + 3), i ≠ j → + segment Real (q i) (q (i + 1)) ∩ segment Real (q j) (q (j + 1)) = + {x | (x = q i ∨ x = q (i + 1)) ∧ + (x = q j ∨ x = q (j + 1))} := by + classical + intro n q hsupport seg_rep det_affine det_zero_left det_zero_right endpoint_det_nonneg + no_two_cycle i j hij + apply Set.ext + intro x + constructor + · intro hx + rcases hx with ⟨hxi, hxj⟩ + obtain ⟨s, hs, hxs⟩ := seg_rep (q i) (q (i+1)) x hxi + obtain ⟨t, ht, hxt⟩ := seg_rep (q j) (q (j+1)) x hxj + have hz : P3381T1TriangleDeterminant ![q i, q (i+1), x] = 0 := by + rw [hxs] + rw [det_affine i (q i) (q (i+1)) s, det_zero_left, det_zero_right] + ring + have hcomb := det_affine i (q j) (q (j+1)) t + rw [hxt] at hz + rw [hcomb] at hz + have hleft : 0 ≤ (1-t) * + P3381T1TriangleDeterminant ![q i, q (i+1), q j] := + mul_nonneg (sub_nonneg.mpr ht.2) (endpoint_det_nonneg i j) + have hright : 0 ≤ t * + P3381T1TriangleDeterminant ![q i, q (i+1), q (j+1)] := + mul_nonneg ht.1 (endpoint_det_nonneg i (j+1)) + have hleftzero : (1-t) * + P3381T1TriangleDeterminant ![q i, q (i+1), q j] = 0 := by + nlinarith [hz] + have hrightzero : t * + P3381T1TriangleDeterminant ![q i, q (i+1), q (j+1)] = 0 := by + nlinarith [hz] + have hleftstrict : j ≠ i ∧ j ≠ i+1 → + 0 < P3381T1TriangleDeterminant ![q i, q (i+1), q j] := by + intro h + exact hsupport i j h.1 h.2 + have hrightstrict : j+1 ≠ i ∧ j+1 ≠ i+1 → + 0 < P3381T1TriangleDeterminant ![q i, q (i+1), q (j+1)] := by + intro h + exact hsupport i (j+1) h.1 h.2 + have hshared : (j = i ∨ j = i+1) ∨ (j+1 = i ∨ j+1 = i+1) := ParabolaHullInterior.hshared n + q i j t hleftzero hrightzero hleftstrict hrightstrict + have hnotboth : ¬ ((j = i ∨ j = i+1) ∧ (j+1 = i ∨ j+1 = i+1)) := + ParabolaHullInterior.hnotboth n q no_two_cycle i j hij x hxj t hxt hz hcomb hleft + hright hleftzero hrightzero hleftstrict hrightstrict hshared + have hxend : x = q j ∧ (j = i ∨ j = i+1) ∨ + x = q (j+1) ∧ (j+1 = i ∨ j+1 = i+1) := ParabolaHullInterior.hxend n q i j x t hxt hleftzero + hrightzero hleftstrict hrightstrict hshared hnotboth + rcases hxend with ⟨hxj, hji⟩ | ⟨hxj, hji⟩ + · rcases hji with hji | hji + · subst j + exact ⟨Or.inl hxj, Or.inl hxj⟩ + · subst j + exact ⟨Or.inr hxj, Or.inl hxj⟩ + · rcases hji with hji | hji + · subst i + exact ⟨Or.inl hxj, Or.inr hxj⟩ + · have hj : j = i := add_right_cancel hji + subst j + exact ⟨Or.inr hxj, Or.inr hxj⟩ + · rintro ⟨hxij, hxji⟩ + refine ⟨?_, ?_⟩ + · rcases hxij with hx | hx + · rw [hx] + exact left_mem_segment Real (q i) (q (i+1)) + · rw [hx] + exact right_mem_segment Real (q i) (q (i+1)) + · rcases hxji with hx | hx + · rw [hx] + exact left_mem_segment Real (q j) (q (j+1)) + · rw [hx] + exact right_mem_segment Real (q j) (q (j+1)) + +end ParabolaHullEdges + +theorem P3555T2ParabolaHullFrontier {n : Nat} + (q : Fin (n + 3) → Real × Real) + (hq : ∀ i, q i = ((i.val : Real), (i.val : Real) ^ 2)) : + let K := convexHull Real (Set.range q) + (∀ i j : Fin (n + 3), i ≠ j → + segment Real (q i) (q (i + 1)) ∩ segment Real (q j) (q (j + 1)) = + {x | (x = q i ∨ x = q (i + 1)) ∧ + (x = q j ∨ x = q (j + 1))}) ∧ + Convex Real K ∧ IsClosed K ∧ Bornology.IsBounded K ∧ + (interior K).Nonempty ∧ + frontier K = ⋃ i, segment Real (q i) (q (i + 1)) := by +-- BODY + classical + obtain ⟨hinjective, hnondegenerate, hsupport⟩ := + P3555T2ParabolaSupporting q hq + have seg_rep (a b x : Real × Real) (hx : x ∈ segment Real a b) : + ∃ t : Real, t ∈ Set.Icc 0 1 ∧ x = (1-t) • a + t • b := ParabolaHullConstruction.seg_rep a b + x hx + have det_affine (i : Fin (n + 3)) (a b : Real × Real) (t : Real) : + P3381T1TriangleDeterminant ![q i, q (i+1), (1-t) • a + t • b] = + (1-t) * P3381T1TriangleDeterminant ![q i, q (i+1), a] + + t * P3381T1TriangleDeterminant ![q i, q (i+1), b] := + ParabolaHullConstruction.det_affine n q i a b t + have det_zero_left (i : Fin (n + 3)) : + P3381T1TriangleDeterminant ![q i, q (i+1), q i] = 0 := + ParabolaHullConstruction.det_zero_left n q i + have det_zero_right (i : Fin (n + 3)) : + P3381T1TriangleDeterminant ![q i, q (i+1), q (i+1)] = 0 := + ParabolaHullConstruction.det_zero_right n q i + have endpoint_det_nonneg (i k : Fin (n + 3)) : + 0 ≤ P3381T1TriangleDeterminant ![q i, q (i+1), q k] := + ParabolaHullConstruction.endpoint_det_nonneg n q hsupport det_zero_left det_zero_right i k + have no_two_cycle (i : Fin (n + 3)) : i + 1 + 1 ≠ i := ParabolaHullConstruction.no_two_cycle n i + let M : Real := (n+2 : Nat) + let kmax : Fin (n+3) := Fin.last (n+2) + have hqzero : q (0 : Fin (n+3)) = (0,0) := ParabolaHullConstruction.hqzero n q hq + have hqmax : q kmax = (M,M^2) := ParabolaHullConstruction.hqmax n q hq + let L (j : Fin (n+2)) (x : Real) : Real := + (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) + let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ + ∀ j : Fin (n+2), L j z.1 ≤ z.2} + have hvertex : ∀ k : Fin (n+3), q k ∈ D := ParabolaHullConstruction.hvertex n q hq + have hDconv : Convex Real D := ParabolaHullConstruction.hDconv n seg_rep + have hKD : convexHull Real (Set.range q) ⊆ D := ParabolaHullConstruction.hKD n q hvertex hDconv + have choose_interval (x : Real) (hx0 : 0 ≤ x) (hxM : x ≤ M) : + ∃ j : Fin (n+2), (j.val : Real) ≤ x ∧ x ≤ (j.val : Real)+1 := + ParabolaHullConstruction.choose_interval n x hx0 hxM + have segment_combo_mem (a b : Real × Real) (t : Real) + (ht : t ∈ Set.Icc (0 : Real) 1) : + (1-t) • a + t • b ∈ segment Real a b := ParabolaHullConstruction.segment_combo_mem a b t ht + have qmem (i : Fin (n+3)) : q i ∈ convexHull Real (Set.range q) := + ParabolaHullConstruction.qmem n q i + have segment_memK (a b : Fin (n+3)) : + segment Real (q a) (q b) ⊆ convexHull Real (Set.range q) := + ParabolaHullConstruction.segment_memK n q qmem a b + have hDK : D ⊆ convexHull Real (Set.range q) := ParabolaHullConstruction.hDK n q hq hqzero + hqmax choose_interval segment_combo_mem qmem segment_memK + have hHullEq : convexHull Real (Set.range q) = D := ParabolaHullConstruction.hHullEq n q hKD hDK + have lowerEdge (j : Fin (n+2)) (x : Real) + (hx0 : (j.val : Real) ≤ x) (hx1 : x ≤ (j.val : Real)+1) : + (x, L j x) ∈ segment Real (q ⟨j.val, by omega⟩) + (q ((⟨j.val, by omega⟩ : Fin (n+3))+1)) := ParabolaHullConstruction.lowerEdge n q hq + segment_combo_mem j x hx0 hx1 + have upperEdge (x : Real) (hx0 : 0 ≤ x) (hxM : x ≤ M) : + (x, M*x) ∈ segment Real (q (0 : Fin (n+3))) (q kmax) := ParabolaHullConstruction.upperEdge + n q hqzero hqmax segment_combo_mem x hx0 hxM + have edgeLowerEquation (i : Fin (n+3)) (hi : i ≠ kmax) (z : Real × Real) + (hz : z ∈ segment Real (q i) (q (i+1))) : + ∃ j : Fin (n+2), L j z.1 = z.2 := ParabolaHullConstruction.edgeLowerEquation n q hq seg_rep + i hi z hz + have edgeUpperEquation (z : Real × Real) + (hz : z ∈ segment Real (q kmax) (q (kmax+1))) : + z.2 = M*z.1 := ParabolaHullConstruction.edgeUpperEquation n q seg_rep hqzero hqmax z hz + have hcompact := ParabolaHullConstruction.hcompact n q + have edge_intersections := ParabolaHullEdges.edge_intersections n q hsupport seg_rep + det_affine det_zero_left det_zero_right endpoint_det_nonneg no_two_cycle + refine ⟨edge_intersections, convex_convexHull Real _, hcompact.isClosed, hcompact.isBounded, + ?_, ?_⟩ + · let f : Fin 3 → Fin (n+3) := fun i => ⟨i.val, by omega⟩ + have hf : Function.Injective f := by + intro a b h + apply Fin.ext + simpa [f] using congrArg Fin.val h + have hdet : P3381T1TriangleDeterminant (q ∘ f) ≠ 0 := hnondegenerate f hf + let p : Fin 3 → Real × Real := ![(0,0),(1,0),(0,1)] + have hp : P3381T1TriangleDeterminant p ≠ 0 := by + change ((1:Real)-0) * (1-0) - (0-0) * (0-0) ≠ 0 + norm_num + obtain ⟨H, hH⟩ := P3381T1AffineTriangleMap p (q ∘ f) hp hdet + let w (z : Real × Real) : Fin 3 → Real := ![1-z.1-z.2,z.1,z.2] + have hw_sum (z : Real × Real) : (∑ i, w z i) = 1 := by + rw [Fin.sum_univ_three] + simp [w] + ring + have hp_sum (z : Real × Real) : (∑ i, w z i • p i) = z := by + apply Prod.ext <;> simp [Fin.sum_univ_three, w, p] + let U : Set (Real × Real) := {z | 0 < z.1 ∧ 0 < z.2 ∧ z.1+z.2 < 1} + have hUopen : IsOpen U := ParabolaHullInterior.hUopen + have hUsub : U ⊆ convexHull Real (Set.range p) := ParabolaHullInterior.hUsub hw_sum hp_sum + have target_subset : Set.range (q ∘ f) ⊆ Set.range q := by + rintro x ⟨i, rfl⟩ + exact ⟨f i, rfl⟩ + have hImageSub : H '' U ⊆ convexHull Real (Set.range q) := ParabolaHullInterior.hImageSub n q + H hH hw_sum hp_sum target_subset + have hImageOpen : IsOpen (H '' U) := H.isOpenMap U hUopen + let z₀ : Real × Real := (1/3,1/3) + have hz₀ : z₀ ∈ U := by norm_num [U, z₀] + refine ⟨H z₀, (hImageOpen.subset_interior_iff.mpr hImageSub) ?_⟩ + exact Set.mem_image_of_mem H hz₀ + · have hDclosed : IsClosed D := by + rw [← hHullEq] + exact hcompact.isClosed + let O : Set (Real × Real) := + {z | 0 < z.1 ∧ z.1 < M ∧ z.2 < M*z.1 ∧ ∀ j : Fin (n+2), L j z.1 < z.2} + have hOopen : IsOpen O := ParabolaHullInterior.hOopen n + have hOsub : O ⊆ D := by + intro z hz + simp only [O, Set.mem_ofPred_eq] at hz + rcases hz with ⟨hz0,hzM,hzU,hzL⟩ + exact ⟨hz0.le,hzM.le,hzU.le,fun j => (hzL j).le⟩ + have hOinter : O ⊆ interior D := hOopen.subset_interior_iff.mpr hOsub + have ballAt (z : Real × Real) (hz : z ∈ interior D) : + ∃ e : Real, 0 < e ∧ Metric.ball z e ⊆ D := + Metric.mem_nhds_iff.mp (mem_interior_iff_mem_nhds.mp hz) + have noLeftInterior (z : Real × Real) (hz : z ∈ interior D) : z.1 ≠ 0 := + ParabolaHullInterior.noLeftInterior n ballAt z hz + have noRightInterior (z : Real × Real) (hz : z ∈ interior D) : z.1 ≠ M := + ParabolaHullInterior.noRightInterior n ballAt z hz + have noUpperInterior (z : Real × Real) (hz : z ∈ interior D) + (heq : z.2 = M*z.1) : False := ParabolaHullInterior.noUpperInterior n ballAt z hz heq + have noLowerInterior (z : Real × Real) (hz : z ∈ interior D) + (j : Fin (n+2)) (heq : L j z.1 = z.2) : False := ParabolaHullInterior.noLowerInterior n + ballAt z hz j heq + have interiorStrict (z : Real × Real) (hz : z ∈ interior D) : z ∈ O := + ParabolaHullInterior.interiorStrict n noLeftInterior noRightInterior noUpperInterior + noLowerInterior z hz + apply Set.ext + intro x + constructor + · intro hx + have hxDfront : x ∈ frontier D := by simpa [hHullEq] using hx + rw [hDclosed.frontier_eq] at hxDfront + rcases hxDfront with ⟨hxD,hnotint⟩ + have hnotO : x ∉ O := fun h => hnotint (hOinter h) + rcases hxD with ⟨hx0,hxM,hxU,hxL⟩ + have heqcases : x.1 = 0 ∨ x.1 = M ∨ x.2 = M*x.1 ∨ + ∃ j : Fin (n+2), L j x.1 = x.2 := ParabolaHullInterior.heqcases n x hnotO hx0 hxM hxU hxL + rcases heqcases with hxzero | hxmax | hxupper | ⟨j,hxlower⟩ + · have hylo : 0 ≤ x.2 := by + have := hxL (⟨0, by omega⟩ : Fin (n+2)) + simpa [L,hxzero] using this + have hyhi : x.2 ≤ 0 := by simpa [hxzero] using hxU + have hxq : x = q (0 : Fin (n+3)) := by + apply Prod.ext + · rw [hxzero,hqzero] + · rw [hqzero] + exact le_antisymm hyhi hylo + have hwrap : kmax+1 = (0 : Fin (n+3)) := by + apply Fin.ext + simp [kmax] + refine Set.mem_iUnion.mpr ⟨kmax, ?_⟩ + rw [hwrap,hxq] + exact right_mem_segment Real (q kmax) (q (0 : Fin (n+3))) + · let jtop : Fin (n+2) := ⟨n+1, by omega⟩ + have hline : L jtop M = M^2 := by + dsimp [L,jtop,M] + push_cast + ring + have hylo : M^2 ≤ x.2 := by simpa [hxmax,hline] using hxL jtop + have hyhi : x.2 ≤ M^2 := by rw [hxmax] at hxU; nlinarith [hxU] + have hxq : x = q kmax := by + apply Prod.ext + · rw [hxmax,hqmax] + · rw [hqmax] + exact le_antisymm hyhi hylo + have hwrap : kmax+1 = (0 : Fin (n+3)) := by + apply Fin.ext + simp [kmax] + refine Set.mem_iUnion.mpr ⟨kmax, ?_⟩ + rw [hwrap,hxq] + exact left_mem_segment Real (q kmax) (q (0 : Fin (n+3))) + · have hedge := upperEdge x.1 hx0 hxM + have hxline : x = (x.1,M*x.1) := Prod.ext rfl hxupper + have hedge' : x ∈ segment Real (q (0 : Fin (n+3))) (q kmax) := by + rw [hxline] + exact hedge + have hwrap : kmax+1 = (0 : Fin (n+3)) := by + apply Fin.ext + simp [kmax] + refine Set.mem_iUnion.mpr ⟨kmax, ?_⟩ + rw [hwrap] + simpa [segment_symm] using hedge' + · have hjlower : (j.val : Real) ≤ x.1 := ParabolaHullInterior.hjlower n x hx0 hxL j hxlower + have hjupper : x.1 ≤ (j.val : Real)+1 := ParabolaHullInterior.hjupper n x hxM hxL j hxlower + let jj : Fin (n+3) := ⟨j.val, by omega⟩ + have hedge := lowerEdge j x.1 hjlower hjupper + have hxline : x = (x.1,L j x.1) := Prod.ext rfl hxlower.symm + refine Set.mem_iUnion.mpr ⟨jj, ?_⟩ + rw [hxline] + simpa [jj] using hedge + · intro hx + obtain ⟨i,hxi⟩ := Set.mem_iUnion.mp hx + have hxK : x ∈ convexHull Real (Set.range q) := segment_memK i (i+1) hxi + have hIntEq : interior (convexHull Real (Set.range q)) = interior D := + congrArg interior hHullEq + have hnotintK : x ∉ interior (convexHull Real (Set.range q)) := + ParabolaHullInterior.hnotintK n q edgeLowerEquation edgeUpperEquation noUpperInterior + noLowerInterior x i hxi hIntEq + rw [hcompact.isClosed.frontier_eq] + exact ⟨hxK,hnotintK⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaSupporting.lean b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaSupporting.lean new file mode 100644 index 0000000000..c4d12ca8ee --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaSupporting.lean @@ -0,0 +1,99 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant + +-- [TABLET NODE: P3555T2ParabolaSupporting] + +/-! +# P3555T2ParabolaSupporting + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3555T2ParabolaSupporting {n : Nat} + (q : Fin (n + 3) → Real × Real) + (hq : ∀ i, q i = ((i.val : Real), (i.val : Real) ^ 2)) : + Function.Injective q ∧ + (∀ f : Fin 3 → Fin (n + 3), Function.Injective f → + P3381T1TriangleDeterminant (q ∘ f) ≠ 0) ∧ + (∀ i j : Fin (n + 3), j ≠ i → j ≠ i + 1 → + 0 < P3381T1TriangleDeterminant ![q i, q (i + 1), q j]) := by +-- BODY + have cast_inj : Function.Injective (fun i : Fin (n + 3) => (i.val : Real)) := by + intro i j hij + change (i.val : Real) = (j.val : Real) at hij + apply Fin.ext + exact_mod_cast hij + have formula (a b c : Fin (n + 3)) : + P3381T1TriangleDeterminant ![q a, q b, q c] = + ((b.val : Real) - a.val) * ((c.val : Real) - a.val) * + ((c.val : Real) - b.val) := by + simp [P3381T1TriangleDeterminant, hq] + ring + have injective : Function.Injective q := by + intro i j hij + apply cast_inj + simpa only [hq, Prod.mk.injEq] using congrArg Prod.fst hij + refine ⟨injective, ?_, ?_⟩ + · intro f hf + have hf01 : f 1 ≠ f 0 := hf.ne (by decide) + have hf02 : f 2 ≠ f 0 := hf.ne (by decide) + have hf12 : f 2 ≠ f 1 := hf.ne (by decide) + have hform : P3381T1TriangleDeterminant (q ∘ f) = + ((f 1).val - (f 0).val : Real) * + ((f 2).val - (f 0).val : Real) * + ((f 2).val - (f 1).val : Real) := by + simpa [P3381T1TriangleDeterminant, Function.comp_apply] using + formula (f 0) (f 1) (f 2) + rw [hform] + exact mul_ne_zero + (mul_ne_zero (sub_ne_zero.mpr (cast_inj.ne hf01)) + (sub_ne_zero.mpr (cast_inj.ne hf02))) + (sub_ne_zero.mpr (cast_inj.ne hf12)) + · intro i j hji hjnext + rw [formula] + by_cases hi : i = Fin.last (n + 2) + · have hiv : i.val = n + 2 := by simp [hi] + have hnext : (i + 1).val = 0 := by simp [hi] + have hjpos : 0 < j.val := by + have hjne : j.val ≠ (i + 1).val := fun h => hjnext (Fin.ext h) + omega + have hjlt : j.val < i.val := by + have hjne : j.val ≠ i.val := fun h => hji (Fin.ext h) + have hjbound := j.isLt + omega + have hI : 0 < (i.val : Real) := by exact_mod_cast (show 0 < i.val by omega) + have hJ : 0 < (j.val : Real) := by exact_mod_cast hjpos + have hJI : (j.val : Real) < i.val := by exact_mod_cast hjlt + simp only [hnext, Nat.cast_zero, zero_sub, sub_zero] + exact mul_pos (mul_pos_of_neg_of_neg (neg_neg_of_pos hI) (sub_neg.mpr hJI)) hJ + · have hnext : (i + 1).val = i.val + 1 := by simp [Fin.val_add_one, hi] + have hjne : j.val ≠ i.val := fun h => hji (Fin.ext h) + have hjnne : j.val ≠ i.val + 1 := by + intro h + apply hjnext + apply Fin.ext + exact h.trans hnext.symm + have cases : j.val < i.val ∨ i.val + 1 < j.val := by omega + simp only [hnext, Nat.cast_add, Nat.cast_one] + have hfactor : (i.val : Real) + 1 - i.val = 1 := by ring + rw [hfactor, one_mul] + rcases cases with hj | hj + · have hlt : (j.val : Real) < i.val := by exact_mod_cast hj + exact mul_pos_of_neg_of_neg (sub_neg.mpr hlt) (by linarith) + · have hlt : (i.val : Real) + 1 < j.val := by exact_mod_cast hj + exact mul_pos (by linarith) (sub_pos.mpr hlt) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean new file mode 100644 index 0000000000..f6f198dfd5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean @@ -0,0 +1,1502 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3555T2ParabolaChordCuts +public import LeanPool.ApollonianSuperharmonic.P3511T1CyclicDissection +public import Mathlib.Analysis.Convex.Combination + +-- [TABLET NODE: P3555T2SavedDissectionGeometry] + +/-! +# P3555T2SavedDissectionGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SavedDissectionProof + +private theorem hsetAt164 : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 + : ℕ))), ∀ (c : Fin (n + (3 : ℕ))), ([a, b, c].Nodup) → ((∃ (k : ℕ), [a, b, c].Sublist + ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k)) → (([a, b, c].Nodup) → ((∃ (k : + ℕ), [a, b, c].Sublist ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k)) → (((a ≠ b + ∧ a ≠ c) ∧ b ≠ c) → ( + let f : Fin 3 → Fin (n + 3) := ![a, b, c] + (Function.Injective f) → ((P3381T1TriangleDeterminant (q ∘ f) ≠ 0) → (q '' {i | i ∈ [a, b, + c]} = Set.range (q ∘ f)))))))) := by + classical + intro n q a b c hboundary hcyclic hnd hcyc hnd' f hfi hdet + ext x + change (∃ i, i ∈ [a, b, c] ∧ q i = x) ↔ ∃ j : Fin 3, q (f j) = x + constructor + · rintro ⟨i, hi, hix⟩ + simp? at hi + rcases hi with rfl | rfl | rfl + · exact ⟨0, by simpa [f] using hix⟩ + · exact ⟨1, by simpa [f] using hix⟩ + · exact ⟨2, by simpa [f] using hix⟩ + · rintro ⟨j, hj⟩ + fin_cases j + · exact ⟨a, by simp, by simpa [f] using hj⟩ + · exact ⟨b, by simp, by simpa [f] using hj⟩ + · exact ⟨c, by simp, by simpa [f] using hj⟩ + +private theorem hDaffine : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 + : ℕ))), + let D : Real × Real → Real := fun z => + P3381T1TriangleDeterminant ![q a, q b, z] + ∀ (w : Fin 3 → Real), ∀ (p : Fin 3 → Real × Real), ((∑ i, w i) = 1) → (D (∑ i, w i • p i) = ∑ + i, w i * D (p i)) := by + classical + intro n q a b D w p hw + have hform (z : Real × Real) : + D z = ((q b).1 - (q a).1) * (z.2 - (q a).2) - + (z.1 - (q a).1) * ((q b).2 - (q a).2) := by + simp [D, P3381T1TriangleDeterminant] + rw [hform] + have hfst : (∑ i, w i • p i).1 = ∑ i, w i * (p i).1 := by + rw [Prod.fst_sum] + simp only [Prod.smul_fst, smul_eq_mul] + have hsnd : (∑ i, w i • p i).2 = ∑ i, w i * (p i).2 := by + rw [Prod.snd_sum] + simp only [Prod.smul_snd, smul_eq_mul] + rw [hfst, hsnd] + simp_rw [hform] + simp only [Fin.sum_univ_three] at hw ⊢ + have hw2 : w 2 = 1 - w 0 - w 1 := by linarith + rw [hw2] + ring + +private theorem faceChord : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 + : ℕ))), ∀ (f : Fin 3 → Fin (n + 3)), ∀ (φ : (Real × Real) → Real), (∀ (w : Fin 3 → Real), + ∀ (p : Fin 3 → Real × Real), (∑ i, w i) = 1 → φ (∑ i, w i • p i) = ∑ i, w i * φ (p i)) → + ((∀ i, φ (q (f i)) ≤ 0) → ((∀ i, f i ≠ a → f i ≠ b → φ (q (f i)) < 0) → (∀ (z : Real × + Real), (z ∈ convexHull Real (Set.range (q ∘ f))) → ((φ z = 0) → (z ∈ convexHull Real (q + '' (Set.range f ∩ ({a, b} : Set (Fin (n + 3)))))))))) := by + classical + intro n q a b f φ hφ hweak hstrict z hz hzφ + classical + obtain ⟨ι, inst, w, y, hw0, hw1, hy, hyz⟩ := + mem_convexHull_iff_exists_fintype.mp hz + let _ := inst + choose j hj using hy + let W : Fin 3 → Real := fun i => ∑ r, if j r = i then w r else 0 + have hW0 : ∀ i, 0 ≤ W i := by + intro i + exact Finset.sum_nonneg fun r _ => by + split_ifs + · exact hw0 r + · exact le_rfl + have hWsum : (∑ i, W i) = 1 := by + simpa [W, Finset.sum_comm] using hw1 + have hWz : (∑ i, W i • q (f i)) = z := by + calc + (∑ i, W i • q (f i)) = ∑ r, w r • q (f (j r)) := by + simp [W, Finset.sum_smul, Finset.sum_comm, ite_smul] + _ = ∑ r, w r • y r := by + apply Finset.sum_congr rfl + intro r hr + simpa [Function.comp_apply] using + congrArg (fun x => w r • x) (hj r) + _ = z := hyz + have hsumφ : (∑ i, W i * φ (q (f i))) = 0 := by + calc + (∑ i, W i * φ (q (f i))) = φ (∑ i, W i • q (f i)) := + (hφ W (fun i => q (f i)) hWsum).symm + _ = φ z := congrArg φ hWz + _ = 0 := hzφ + have hterm : ∀ i, W i * φ (q (f i)) ≤ 0 := by + intro i + exact mul_nonpos_of_nonneg_of_nonpos (hW0 i) (hweak i) + have hWzero : ∀ i, f i ≠ a → f i ≠ b → W i = 0 := by + intro i hia hib + have hzeroTerms := + (Finset.sum_eq_zero_iff_of_nonpos (fun j _ => hterm j)).mp hsumφ + have ht := hzeroTerms i (Finset.mem_univ i) + rcases mul_eq_zero.mp ht with hzero | hzero + · exact hzero + · exact False.elim ((hstrict i hia hib).ne' hzero.symm) + by_cases hS : (Set.range f ∩ ({a, b} : Set (Fin (n + 3)))).Nonempty + · obtain ⟨c, hc⟩ := hS + let g : Fin 3 → Fin (n + 3) := + fun i => if f i ∈ ({a, b} : Set (Fin (n + 3))) then f i else c + have hg : ∀ i, g i ∈ Set.range f ∩ ({a, b} : Set (Fin (n + 3))) := by + intro i + by_cases hi : f i ∈ ({a, b} : Set (Fin (n + 3))) + · have hi' : f i = a ∨ f i = b := by simpa using hi + refine ⟨⟨i, ?_⟩, ?_⟩ + · simp [g, hi'] + · simp [g, hi'] + · have hne : f i ≠ a ∧ f i ≠ b := by simpa using hi + exact by simpa [g, hne] using hc + have hvec : (∑ i, W i • q (g i)) = z := by + rw [← hWz] + apply Finset.sum_congr rfl + intro i hi + by_cases he : f i ∈ ({a, b} : Set (Fin (n + 3))) + · have he' : f i = a ∨ f i = b := by simpa using he + simp [g, he'] + · have hne : f i ≠ a ∧ f i ≠ b := by simpa using he + simp [g, hWzero i hne.1 hne.2] + exact mem_convexHull_of_exists_fintype W (fun i => q (g i)) hW0 hWsum + (fun i => Set.mem_image_of_mem q (hg i)) hvec + · have hna : ∀ i, f i ≠ a := by + intro i hi + apply hS + exact ⟨a, ⟨i, hi⟩, by simp⟩ + have hnb : ∀ i, f i ≠ b := by + intro i hi + apply hS + exact ⟨b, ⟨i, hi⟩, by simp⟩ + have hzero : ∀ i, W i = 0 := fun i => hWzero i (hna i) (hnb i) + have : (∑ i, W i) = 0 := by simp [hzero] + rw [hWsum] at this + norm_num at this + +private theorem hAparent : + ∀ (n : Nat), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : + ℕ)))), ∀ (v : List (Fin (n + (3 : ℕ)))), ∀ i, i ∈ a :: (u ++ [b]) → i ∈ a :: (u ++ b :: + v) := by + classical + intro n a b u v i hi + simp only [List.mem_cons, List.mem_append, + List.not_mem_nil] at hi + simp only [or_false] at hi + simp only [List.mem_cons, List.mem_append] + rcases hi with ha | hu | hb + · exact Or.inl ha + · exact Or.inr (Or.inl hu) + · exact Or.inr (Or.inr (Or.inl hb)) + +private theorem hBparent : + ∀ (n : Nat), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : + ℕ)))), ∀ (v : List (Fin (n + (3 : ℕ)))), ∀ i, i ∈ b :: (v ++ [a]) → i ∈ a :: (u ++ b :: + v) := by + classical + intro n a b u v i hi + simp only [List.mem_cons, List.mem_append, + List.not_mem_nil] at hi + simp only [or_false] at hi + simp only [List.mem_cons, List.mem_append] + rcases hi with hb | hv | ha + · exact Or.inr (Or.inr (Or.inl hb)) + · exact Or.inr (Or.inr (Or.inr hv)) + · exact Or.inl ha + +private theorem hcross : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 + : ℕ))), ∀ (u : List (Fin (n + (3 : ℕ)))), ∀ (v : List (Fin (n + (3 : ℕ)))), ∀ (left : + List (Fin (3 : ℕ) → Fin (n + (3 : ℕ)))), ∀ (right : List (Fin (3 : ℕ) → Fin (n + (3 : + ℕ)))), ({i : Fin (n + (3 : ℕ)) | i ∈ a :: (u ++ [b])} ∩ {i : Fin (n + (3 : ℕ)) | i ∈ b :: + (v ++ [a])} = {a, b}) → ((∀ f ∈ left, Function.Injective f ∧ Set.range f ⊆ {i : Fin (n + + (3 : ℕ)) | i ∈ a :: (u ++ [b])} ∧ P3381T1TriangleDeterminant (q ∘ f) ≠ (0 : ℝ)) → ((∀ f + ∈ right, Function.Injective f ∧ Set.range f ⊆ {i : Fin (n + (3 : ℕ)) | i ∈ b :: (v ++ + [a])} ∧ P3381T1TriangleDeterminant (q ∘ f) ≠ (0 : ℝ)) → (∀ f ∈ left, ∀ g ∈ right, + Set.range f ≠ Set.range g))) := by + classical + intro n q a b u v left right hAB hfaceA hfaceB f hf g hg heq + have hfi := (hfaceA f hf).1 + have hgi := (hfaceB g hg).1 + have hsubA := (hfaceA f hf).2.1 + have hsubB := (hfaceB g hg).2.1 + have hsmall : Set.range f ⊆ ({a, b} : Set (Fin (n + 3))) := by + intro x hx + have hxA : x ∈ a :: (u ++ [b]) := hsubA hx + have hxg : x ∈ Set.range g := by rw [← heq]; exact hx + have hxB : x ∈ b :: (v ++ [a]) := hsubB hxg + have hxAB : x ∈ {i | i ∈ a :: (u ++ [b])} ∩ + {i | i ∈ b :: (v ++ [a])} := ⟨hxA, hxB⟩ + rw [hAB] at hxAB + simpa using hxAB + have h0 : f 0 = a ∨ f 0 = b := by + have := hsmall ⟨0, rfl⟩ + simpa using this + have h1 : f 1 = a ∨ f 1 = b := by + have := hsmall ⟨1, rfl⟩ + simpa using this + have h2 : f 2 = a ∨ f 2 = b := by + have := hsmall ⟨2, rfl⟩ + simpa using this + have hn01 : f 0 ≠ f 1 := hfi.ne (by decide) + have hn02 : f 0 ≠ f 2 := hfi.ne (by decide) + have hn12 : f 1 ≠ f 2 := hfi.ne (by decide) + rcases h0 with h0a | h0b + · rcases h1 with h1a | h1b + · exact hn01 (h0a.trans h1a.symm) + · rcases h2 with h2a | h2b + · exact hn02 (h0a.trans h2a.symm) + · exact hn12 (h1b.trans h2b.symm) + · rcases h1 with h1a | h1b + · rcases h2 with h2a | h2b + · exact hn12 (h1a.trans h2a.symm) + · exact hn02 (h0b.trans h2b.symm) + · exact hn01 (h0b.trans h1b.symm) + +private theorem hsignA : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 + : ℕ))), ∀ (u : List (Fin (n + (3 : ℕ)))), ∀ (left : List (Fin (3 : ℕ) → Fin (n + (3 : + ℕ)))), (∀ i ∈ u, (fun (z : ℝ × ℝ) => P3381T1TriangleDeterminant ![q a, q b, z]) (q i) < + (0 : ℝ)) → ((∀ f ∈ left, Function.Injective f ∧ Set.range f ⊆ {i : Fin (n + (3 : ℕ)) | i + ∈ a :: (u ++ [b])} ∧ P3381T1TriangleDeterminant (q ∘ f) ≠ (0 : ℝ)) → ( + let D : Real × Real → Real := fun z => + P3381T1TriangleDeterminant ![q a, q b, z] + (D (q a) = 0) → ((D (q b) = 0) → (∀ (f : Fin 3 → Fin (n + 3)), (f ∈ left) → ((∀ i, D (q (f + i)) ≤ 0) ∧ + (∀ i, f i ≠ a → f i ≠ b → D (q (f i)) < 0)))))) := by + classical + intro n q a b u left hU hfaceA D hDa hDb f hf + have hlabels := (hfaceA f hf).2.1 + constructor + · intro i + have hi := hlabels ⟨i, rfl⟩ + simp only [List.mem_cons, List.mem_append, + List.not_mem_nil, or_false] at hi + rcases hi with ha | hu | hb + · rw [ha, hDa] + · exact (hU (f i) hu).le + · rw [hb] + simp [hDb] + · intro i hia hib + have hi := hlabels ⟨i, rfl⟩ + simp only [List.mem_cons, List.mem_append, + List.not_mem_nil, or_false] at hi + rcases hi with ha | hu | hb + · exact (hia ha).elim + · exact hU (f i) hu + · exact (hib hb).elim + +private theorem hsignB : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 + : ℕ))), ∀ (v : List (Fin (n + (3 : ℕ)))), ∀ (right : List (Fin (3 : ℕ) → Fin (n + (3 : + ℕ)))), (∀ i ∈ v, (0 : ℝ) < (fun (z : ℝ × ℝ) => P3381T1TriangleDeterminant ![q a, q b, + z]) (q i)) → ((∀ f ∈ right, Function.Injective f ∧ Set.range f ⊆ {i : Fin (n + (3 : ℕ)) | + i ∈ b :: (v ++ [a])} ∧ P3381T1TriangleDeterminant (q ∘ f) ≠ (0 : ℝ)) → ( + let D : Real × Real → Real := fun z => + P3381T1TriangleDeterminant ![q a, q b, z] + (D (q a) = 0) → ((D (q b) = 0) → (∀ (f : Fin 3 → Fin (n + 3)), (f ∈ right) → ((∀ i, (-D) (q + (f i)) ≤ 0) ∧ + (∀ i, f i ≠ a → f i ≠ b → (-D) (q (f i)) < 0)))))) := by + classical + intro n q a b v right hV hfaceB D hDa hDb f hf + have hlabels := (hfaceB f hf).2.1 + constructor + · intro i + have hi := hlabels ⟨i, rfl⟩ + simp only [List.mem_cons, List.mem_append, + List.not_mem_nil, or_false] at hi + rcases hi with hb | hv | ha + · rw [hb] + simp [hDb] + · exact (neg_nonpos.mpr (hV (f i) hv).le) + · rw [ha] + simp [hDa] + · intro i hia hib + have hi := hlabels ⟨i, rfl⟩ + simp only [List.mem_cons, List.mem_append, + List.not_mem_nil, or_false] at hi + rcases hi with hb | hv | ha + · exact (hib hb).elim + · exact neg_neg_of_pos (hV (f i) hv) + · exact (hia ha).elim + +private theorem hendpoint_intersection : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), (Function.Injective q ∧ (∀ (f : Fin (3 : ℕ) → + Fin (n + (3 : ℕ))), Function.Injective f → P3381T1TriangleDeterminant (q ∘ f) ≠ (0 : + ℝ)) ∧ ∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), j ≠ i → j ≠ i + (1 : Fin (n + + (3 : ℕ))) → (0 : ℝ) < P3381T1TriangleDeterminant ![q i, q (i + (1 : Fin (n + (3 : + ℕ)))), q j]) → (∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), (a ≠ b) → (∀ (S : + Set (Fin (n + 3))), ∀ (T : Set (Fin (n + 3))), (S ⊆ ({a, b} : Set (Fin (n + 3)))) → ((T ⊆ + ({a, b} : Set (Fin (n + 3)))) → (∀ (z : Real × Real), (z ∈ convexHull Real (q '' S)) → + ((z ∈ convexHull Real (q '' T)) → (z ∈ convexHull Real (q '' (S ∩ T)))))))) := by + classical + intro n q hsupport a b hab S T hS hT z hzS hzT + classical + have hqa_ne_hqb : q a ≠ q b := fun h => hab (hsupport.1 h) + by_cases haS : a ∈ S <;> by_cases hbS : b ∈ S <;> + by_cases haT : a ∈ T <;> by_cases hbT : b ∈ T + all_goals + have hSform : S = if a ∈ S then if b ∈ S then {a, b} else {a} else if b ∈ S then {b} else ∅ + := by + ext x + constructor + · intro hx + rcases hS hx with hx' | hx' + · subst x; simp [haS, hbS, hab] at hx ⊢ + · subst x; simp [haS, hbS, hab.symm] at hx ⊢ + · intro hx + by_cases hxa : x = a + · subst x; simp [haS, hbS, hab] at hx ⊢ + · by_cases hxb : x = b + · subst x; simp [haS, hbS, hab.symm] at hx ⊢ + · simp [hxa, hxb, haS, hbS] at hx + have hTform : T = if a ∈ T then if b ∈ T then {a, b} else {a} else if b ∈ T then {b} else ∅ + := by + ext x + constructor + · intro hx + rcases hT hx with hx' | hx' + · subst x; simp [haT, hbT, hab] at hx ⊢ + · subst x; simp [haT, hbT, hab.symm] at hx ⊢ + · intro hx + by_cases hxa : x = a + · subst x; simp [haT, hbT, hab] at hx ⊢ + · by_cases hxb : x = b + · subst x; simp [haT, hbT, hab.symm] at hx ⊢ + · simp [hxa, hxb, haT, hbT] at hx + rw [hSform] at hzS ⊢ + rw [hTform] at hzT ⊢ + simp? [haS, hbS, haT, hbT, convexHull_pair, + ] at hzS hzT ⊢ + all_goals + first + | exact hzS + | exact hzT + | exact False.elim (hqa_ne_hqb (hzS.symm.trans hzT)) + | exact False.elim (hqa_ne_hqb (hzT.symm.trans hzS)) + +private theorem hcrossInter : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 + : ℕ))), ∀ (u : List (Fin (n + (3 : ℕ)))), ∀ (v : List (Fin (n + (3 : ℕ)))), ∀ (left : + List (Fin (3 : ℕ) → Fin (n + (3 : ℕ)))), ∀ (right : List (Fin (3 : ℕ) → Fin (n + (3 : + ℕ)))), ({i : Fin (n + (3 : ℕ)) | i ∈ a :: (u ++ [b])} ∩ {i : Fin (n + (3 : ℕ)) | i ∈ b :: + (v ++ [a])} = {a, b}) → (((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (q '' {i : Fin (n + + (3 : ℕ)) | i ∈ a :: (u ++ [b])}) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (q '' {i : + Fin (n + (3 : ℕ)) | i ∈ b :: (v ++ [a])}) = segment ℝ (q a) (q b)) → ((∀ f ∈ left, + Function.Injective f ∧ Set.range f ⊆ {i : Fin (n + (3 : ℕ)) | i ∈ a :: (u ++ [b])} ∧ + P3381T1TriangleDeterminant (q ∘ f) ≠ (0 : ℝ)) → ((∀ f ∈ right, Function.Injective f ∧ + Set.range f ⊆ {i : Fin (n + (3 : ℕ)) | i ∈ b :: (v ++ [a])} ∧ + P3381T1TriangleDeterminant (q ∘ f) ≠ (0 : ℝ)) → ( + let D : Real × Real → Real := fun z => + P3381T1TriangleDeterminant ![q a, q b, z] + (D (q a) = 0) → ((D (q b) = 0) → ((∀ (w : Fin 3 → Real), ∀ (p : Fin 3 → Real × Real), ((∑ i, + w i) = 1) → (D (∑ i, w i • p i) = ∑ i, w i * D (p i))) → ((∀ (f : Fin 3 → Fin (n + 3)), ∀ + (φ : (Real × Real) → Real), (∀ (w : Fin 3 → Real), ∀ (p : Fin 3 → Real × Real), (∑ i, w + i) = 1 → φ (∑ i, w i • p i) = ∑ i, w i * φ (p i)) → ((∀ i, φ (q (f i)) ≤ 0) → ((∀ i, f i + ≠ a → f i ≠ b → φ (q (f i)) < 0) → (∀ (z : Real × Real), (z ∈ convexHull Real (Set.range + (q ∘ f))) → ((φ z = 0) → (z ∈ convexHull Real (q '' (Set.range f ∩ ({a, b} : Set (Fin (n + + 3))))))))))) → ((∀ (w : Fin 3 → Real), ∀ (p : Fin 3 → Real × Real), ((∑ i, w i) = 1) → + (-D (∑ i, w i • p i) = ∑ i, w i * (-D (p i)))) → ((∀ (f : Fin 3 → Fin (n + 3)), (f ∈ + left) → ((∀ i, D (q (f i)) ≤ 0) ∧ (∀ i, f i ≠ a → f i ≠ b → D (q (f i)) < 0))) → ((∀ (f : + Fin 3 → Fin (n + 3)), (f ∈ right) → ((∀ i, (-D) (q (f i)) ≤ 0) ∧ (∀ i, f i ≠ a → f i ≠ b + → (-D) (q (f i)) < 0))) → ((∀ (S : Set (Fin (n + 3))), ∀ (T : Set (Fin (n + 3))), (S ⊆ + ({a, b} : Set (Fin (n + 3)))) → ((T ⊆ ({a, b} : Set (Fin (n + 3)))) → (∀ (z : Real × + Real), (z ∈ convexHull Real (q '' S)) → ((z ∈ convexHull Real (q '' T)) → (z ∈ convexHull + Real (q '' (S ∩ T))))))) → (∀ (f : Fin 3 → Fin (n + 3)), (f ∈ left) → (∀ (g : Fin 3 → Fin + (n + 3)), (g ∈ right) → (convexHull Real (Set.range (q ∘ f)) ∩ convexHull Real (Set.range + (q ∘ g)) = + convexHull Real (q '' (Set.range f ∩ Set.range g)))))))))))))))) := by + classical + intro n q a b u v left right hAB hinter hfaceA hfaceB D hDa hDb hDaffine faceChord hDnegAffine + hsignA hsignB hendpoint_intersection f hf g hg + have hrangeA : Set.range (q ∘ f) ⊆ + q '' {i | i ∈ a :: (u ++ [b])} := by + rintro z ⟨i, rfl⟩ + exact ⟨f i, (hfaceA f hf).2.1 ⟨i, rfl⟩, rfl⟩ + have hrangeB : Set.range (q ∘ g) ⊆ + q '' {i | i ∈ b :: (v ++ [a])} := by + rintro z ⟨i, rfl⟩ + exact ⟨g i, (hfaceB g hg).2.1 ⟨i, rfl⟩, rfl⟩ + have hshared : Set.range f ∩ Set.range g ⊆ ({a, b} : Set (Fin (n + 3))) := by + intro x hx + have hxA : x ∈ a :: (u ++ [b]) := (hfaceA f hf).2.1 hx.1 + have hxB : x ∈ b :: (v ++ [a]) := (hfaceB g hg).2.1 hx.2 + have hxAB : x ∈ {i | i ∈ a :: (u ++ [b])} ∩ + {i | i ∈ b :: (v ++ [a])} := ⟨hxA, hxB⟩ + rw [hAB] at hxAB + simpa using hxAB + have hendpointSet : + (Set.range f ∩ ({a, b} : Set (Fin (n + 3)))) ∩ + (Set.range g ∩ ({a, b} : Set (Fin (n + 3)))) = + Set.range f ∩ Set.range g := by + ext x + simp only [Set.mem_inter_iff] + constructor + · rintro ⟨⟨hxf, hxAB⟩, ⟨hxg, _⟩⟩ + exact ⟨hxf, hxg⟩ + · rintro ⟨hxf, hxg⟩ + exact ⟨⟨hxf, hshared ⟨hxf, hxg⟩⟩, ⟨hxg, hshared ⟨hxf, hxg⟩⟩⟩ + have hDzero (z : Real × Real) + (hz : z ∈ segment Real (q a) (q b)) : D z = 0 := by + rw [segment_eq_image] at hz + rcases hz with ⟨t, ht, htz⟩ + let w : Fin 3 → Real := ![1 - t, t, 0] + let p : Fin 3 → Real × Real := ![q a, q b, (0, 0)] + have hw : (∑ i, w i) = 1 := by simp [w, Fin.sum_univ_three] + have hp : (∑ i, w i • p i) = (1 - t) • q a + t • q b := by + simp [w, p, Fin.sum_univ_three] + calc + D z = D ((1 - t) • q a + t • q b) := by rw [← htz] + _ = D (∑ i, w i • p i) := by rw [hp] + _ = ∑ i, w i * D (p i) := hDaffine w p hw + _ = 0 := by simp [w, p, Fin.sum_univ_three, hDa, hDb] + have hleftHull : + convexHull Real (Set.range (q ∘ f)) ⊆ + convexHull Real (q '' {i | i ∈ a :: (u ++ [b])}) := + convexHull_mono hrangeA + have hrightHull : + convexHull Real (Set.range (q ∘ g)) ⊆ + convexHull Real (q '' {i | i ∈ b :: (v ++ [a])}) := + convexHull_mono hrangeB + ext z + constructor + · intro hz + have hzA : z ∈ convexHull Real (q '' {i | i ∈ a :: (u ++ [b])}) := + hleftHull hz.1 + have hzB : z ∈ convexHull Real (q '' {i | i ∈ b :: (v ++ [a])}) := + hrightHull hz.2 + have hzChord : z ∈ segment Real (q a) (q b) := by + have : z ∈ convexHull Real (q '' {i | i ∈ a :: (u ++ [b])}) ∩ + convexHull Real (q '' {i | i ∈ b :: (v ++ [a])}) := ⟨hzA, hzB⟩ + rw [hinter] at this + exact this + have hzero := hDzero z hzChord + have hzfa : z ∈ convexHull Real (q '' + (Set.range f ∩ ({a, b} : Set (Fin (n + 3))))) := + faceChord f D hDaffine (hsignA f hf).1 (hsignA f hf).2 z hz.1 hzero + have hzg : (-D) z = 0 := by simp [hzero] + have hzgb : z ∈ convexHull Real (q '' + (Set.range g ∩ ({a, b} : Set (Fin (n + 3))))) := + faceChord g (-D) hDnegAffine (hsignB g hg).1 (hsignB g hg).2 z hz.2 hzg + have hzBoth : z ∈ convexHull Real (q '' + ((Set.range f ∩ ({a, b} : Set (Fin (n + 3)))) ∩ + (Set.range g ∩ ({a, b} : Set (Fin (n + 3)))))) := + hendpoint_intersection _ _ (by intro x hx; exact hx.2) + (by intro x hx; exact hx.2) z hzfa hzgb + simpa only [hendpointSet] using hzBoth + · intro hz + have hmonoA : q '' (Set.range f ∩ Set.range g) ⊆ Set.range (q ∘ f) := by + rintro z ⟨x, ⟨hxf, hxg⟩, rfl⟩ + rcases hxf with ⟨i, rfl⟩ + exact ⟨i, rfl⟩ + have hmonoB : q '' (Set.range f ∩ Set.range g) ⊆ Set.range (q ∘ g) := by + rintro z ⟨x, ⟨hxf, hxg⟩, rfl⟩ + rcases hxg with ⟨i, rfl⟩ + exact ⟨i, rfl⟩ + exact ⟨convexHull_mono hmonoA hz, convexHull_mono hmonoB hz⟩ + +private theorem hAget : + ∀ (n : Nat), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : + ℕ)))), ∀ (v : List (Fin (n + (3 : ℕ)))), ∀ (i : Fin (a :: (u ++ b :: v)).length), ∀ (hi : + i.val ≤ u.length + 1), (a :: (u ++ b :: v)).get i = + (a :: (u ++ [b])).get ⟨i.val, by + have hlen : (a :: (u ++ [b])).length = u.length + 2 := by simp + rw [hlen] + omega⟩ := by + classical + intro n a b u v i hi + by_cases hprefix : i.val ≤ u.length + · rw [List.get_eq_getElem, List.get_eq_getElem] + have hip : i.val < (a :: u).length := by simp; omega + have hiA : i.val < (a :: (u ++ [b])).length := by + have hlen : (a :: (u ++ [b])).length = u.length + 2 := by simp + rw [hlen] + omega + change ((a :: u) ++ (b :: v))[i.val] = ((a :: u) ++ [b])[i.val] + rw [List.getElem_append_left hip, List.getElem_append_left hip] + · have hlast : i.val = u.length + 1 := by omega + have hpar : (a :: (u ++ b :: v)).get i = b := by + rw [List.get_eq_getElem] + simp [hlast, List.getElem_append_right] + have hchild : (a :: (u ++ [b])).get + ⟨i.val, by + have hlen : (a :: (u ++ [b])).length = u.length + 2 := by simp + rw [hlen] + omega⟩ = b := by + rw [List.get_eq_getElem] + simp [hlast] + exact hpar.trans hchild.symm + +private theorem hBget : + ∀ (n : Nat), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : + ℕ)))), ∀ (v : List (Fin (n + (3 : ℕ)))), ∀ (j : Fin (a :: (u ++ b :: v)).length), ∀ (hj : + u.length + 1 ≤ j.val), (a :: (u ++ b :: v)).get j = + (b :: (v ++ [a])).get ⟨j.val - (u.length + 1), by + have hlenL : (a :: (u ++ b :: v)).length = u.length + v.length + 2 := by + simp; omega + have hlenB : (b :: (v ++ [a])).length = v.length + 2 := by simp + rw [hlenB] + omega⟩ := by + classical + intro n a b u v j hj + have hlenL : (a :: (u ++ b :: v)).length = u.length + v.length + 2 := by + simp; omega + have hlenB : (b :: (v ++ [a])).length = v.length + 2 := by simp + have hip : (a :: u).length ≤ j.val := by simp; omega + have hj' : j.val < u.length + v.length + 2 := by simpa [hlenL] using j.isLt + let jB : Fin (b :: (v ++ [a])).length := + ⟨j.val - (u.length + 1), by rw [hlenB]; omega⟩ + have hpre : (a :: u).length = u.length + 1 := by simp + have hjBval : jB.val = j.val - (u.length + 1) := rfl + have htail : j.val - (a :: u).length < (b :: v).length := by + rw [hpre] + simp only [List.length_cons] + omega + have htailB : jB.val < (b :: v).length := by + rw [hjBval] + simp only [List.length_cons] + omega + have hresult : (a :: (u ++ b :: v)).get j = (b :: (v ++ [a])).get jB := by + rw [List.get_eq_getElem, List.get_eq_getElem] + change ((a :: u) ++ (b :: v))[j.val] = ((b :: v) ++ [a])[jB.val] + rw [List.getElem_append_right hip, List.getElem_append_left htailB] + have hidx : j.val - (a :: u).length = jB.val := by rw [hpre, hjBval] + have hfin : (⟨j.val - (a :: u).length, htail⟩ : Fin (b :: v).length) = + ⟨jB.val, htailB⟩ := Fin.ext hidx + simpa only [List.get_eq_getElem] using congrArg (List.get (b :: v)) hfin + simpa [jB] using hresult + +private theorem hNoAEndpoints : + ∀ (n : Nat), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : + ℕ)))), (List (Fin (n + (3 : ℕ)))) → (((0 : ℕ) < u.length) → (((a :: (u ++ [b])).Nodup) → + (∀ (i : Fin (a :: (u ++ [b])).length), ∀ (j : Fin (a :: (u ++ [b])).length), (i.val + 1 = + j.val) → (((a :: (u ++ [b])).get i ∈ ({a, b} : Set (Fin (n + 3)))) → (((a :: (u ++ + [b])).get j ∈ ({a, b} : Set (Fin (n + 3)))) → (False)))))) := by + classical + intro n a b u v hu hndA i j hij hia hja + have hzero : (a :: (u ++ [b])).get ⟨0, by simp⟩ = a := by simp + have hend : (a :: (u ++ [b])).get ⟨u.length + 1, by simp⟩ = b := by + simp [List.get_eq_getElem] + have hne : (a :: (u ++ [b])).get i ≠ (a :: (u ++ [b])).get j := by + intro heq + have hij' := (hndA.get_inj_iff).mp heq + have hv := congrArg Fin.val hij' + omega + have hia' : (a :: (u ++ [b])).get i = a ∨ + (a :: (u ++ [b])).get i = b := by simpa using hia + have hja' : (a :: (u ++ [b])).get j = a ∨ + (a :: (u ++ [b])).get j = b := by simpa using hja + rcases hia' with hia' | hia' + · have hi0 : i = 0 := (hndA.get_inj_iff).mp (hia'.trans hzero.symm) + rcases hja' with hja' | hja' + · have hj0 : j = 0 := (hndA.get_inj_iff).mp (hja'.trans hzero.symm) + exact hne (by rw [hi0, hj0]) + · have hjend : j = ⟨u.length + 1, by simp⟩ := + (hndA.get_inj_iff).mp (hja'.trans hend.symm) + have hi0v : i.val = 0 := congrArg Fin.val hi0 + have hjendv : j.val = u.length + 1 := congrArg Fin.val hjend + have hm : u.length = 0 := by omega + exact (Nat.ne_of_gt hu) hm + · have hiend : i = ⟨u.length + 1, by simp⟩ := + (hndA.get_inj_iff).mp (hia'.trans hend.symm) + rcases hja' with hja' | hja' + · have hj0 : j = 0 := (hndA.get_inj_iff).mp (hja'.trans hzero.symm) + have hiendv : i.val = u.length + 1 := congrArg Fin.val hiend + have hj0v : j.val = 0 := congrArg Fin.val hj0 + omega + · have hjend : j = ⟨u.length + 1, by simp⟩ := + (hndA.get_inj_iff).mp (hja'.trans hend.symm) + exact hne (by rw [hiend, hjend]) + +private theorem hNoBEndpoints : + ∀ (n : Nat), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), (List (Fin (n + (3 : ℕ)))) + → (∀ (v : List (Fin (n + (3 : ℕ)))), ((0 : ℕ) < v.length) → (((b :: (v ++ [a])).Nodup) → + (∀ (i : Fin (b :: (v ++ [a])).length), ∀ (j : Fin (b :: (v ++ [a])).length), (i.val + 1 = + j.val) → (((b :: (v ++ [a])).get i ∈ ({a, b} : Set (Fin (n + 3)))) → (((b :: (v ++ + [a])).get j ∈ ({a, b} : Set (Fin (n + 3)))) → (False)))))) := by + classical + intro n a b u v hv hndB i j hij hia hja + have hzero : (b :: (v ++ [a])).get ⟨0, by simp⟩ = b := by simp + have hend : (b :: (v ++ [a])).get ⟨v.length + 1, by simp⟩ = a := by + simp [List.get_eq_getElem] + have hne : (b :: (v ++ [a])).get i ≠ (b :: (v ++ [a])).get j := by + intro heq + have hij' := (hndB.get_inj_iff).mp heq + have hv := congrArg Fin.val hij' + omega + have hia' : (b :: (v ++ [a])).get i = a ∨ + (b :: (v ++ [a])).get i = b := by simpa [or_comm] using hia + have hja' : (b :: (v ++ [a])).get j = a ∨ + (b :: (v ++ [a])).get j = b := by simpa [or_comm] using hja + rcases hia' with hia' | hia' + · have hiend : i = ⟨v.length + 1, by simp⟩ := + (hndB.get_inj_iff).mp (hia'.trans hend.symm) + have hv := congrArg Fin.val hiend + simp at hv + rcases hja' with hja' | hja' + · have hjend : j = ⟨v.length + 1, by simp⟩ := + (hndB.get_inj_iff).mp (hja'.trans hend.symm) + exact hne (by rw [hiend, hjend]) + · have hj0 : j = 0 := (hndB.get_inj_iff).mp (hja'.trans hzero.symm) + have hiendv : i.val = v.length + 1 := congrArg Fin.val hiend + have hj0v : j.val = 0 := congrArg Fin.val hj0 + omega + · have hi0 : i = 0 := (hndB.get_inj_iff).mp (hia'.trans hzero.symm) + rcases hja' with hja' | hja' + · have hjend : j = ⟨v.length + 1, by simp⟩ := + (hndB.get_inj_iff).mp (hja'.trans hend.symm) + have hi0v : i.val = 0 := congrArg Fin.val hi0 + have hjendv : j.val = v.length + 1 := congrArg Fin.val hjend + have hm : v.length = 0 := by omega + exact (Nat.ne_of_gt hv) hm + · have hj0 : j = 0 := (hndB.get_inj_iff).mp (hja'.trans hzero.symm) + exact hne (by rw [hi0, hj0]) + +private theorem hfaces : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (left : List (Fin (3 : ℕ) → Fin (n + (3 : + ℕ)))), ∀ (right : List (Fin (3 : ℕ) → Fin (n + (3 : ℕ)))), (⋃ f ∈ left ++ right, + convexHull Real (Set.range (q ∘ f))) = + (⋃ f ∈ left, convexHull Real (Set.range (q ∘ f))) ∪ + (⋃ f ∈ right, convexHull Real (Set.range (q ∘ f))) := by + classical + intro n q left right + ext x + simp only [Set.mem_union, Set.mem_iUnion, List.mem_append] + constructor + · rintro ⟨f, hf, hx⟩ + rcases hf with hf | hf + · exact Or.inl ⟨f, hf, hx⟩ + · exact Or.inr ⟨f, hf, hx⟩ + · rintro (⟨f, hf, hx⟩ | ⟨f, hf, hx⟩) + · exact ⟨f, Or.inl hf, hx⟩ + · exact ⟨f, Or.inr hf, hx⟩ + +private theorem hchildNextAt805 : + ∀ (n : Nat), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : + ℕ)))), ∀ (v : List (Fin (n + (3 : ℕ)))), ∀ (k : Fin (a :: (u ++ b :: v)).length), ∀ + (hlenL : (a :: (u ++ b :: v)).length = u.length + v.length + 2), ∀ (hkA : (↑k : ℕ) ≤ + u.length), + let iA : Fin (a :: (u ++ [b])).length := + ⟨k.val, by have hlen : (a :: (u ++ [b])).length = u.length + 2 := by simp + rw [hlen]; omega⟩ + let iA1 : Fin (a :: (u ++ [b])).length := + ⟨k.val + 1, by have hlen : (a :: (u ++ [b])).length = u.length + 2 := by simp + rw [hlen]; omega⟩ + (k.val + 1 < (a :: (u ++ b :: v)).length) → ((a :: (u ++ [b])).get + ⟨(iA.val + 1) % (a :: (u ++ [b])).length, + Nat.mod_lt _ (Nat.zero_lt_of_lt iA.isLt)⟩ = + (a :: (u ++ [b])).get iA1) := by + classical + intro n a b u v k hlenL hkA iA iA1 hk1Lt + apply congrArg + apply Fin.ext + have hlen : (a :: (u ++ [b])).length = u.length + 2 := by simp + have hiLt : iA.val + 1 < (a :: (u ++ [b])).length := by + simp only [List.length_cons, List.length_append] + dsimp [iA] + omega + exact Nat.mod_eq_of_lt hiLt + +private theorem hsecondAt889 : + ∀ (n : Nat), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : + ℕ)))), ∀ (v : List (Fin (n + (3 : ℕ)))), ∀ (hv : (0 : ℕ) < v.length), ∀ (hBget : ∀ (j : + Fin (a :: (u ++ b :: v)).length), ∀ (hj : u.length + 1 ≤ j.val), (a :: (u ++ b :: + v)).get + j = + (b :: (v ++ [a])).get ⟨j.val - (u.length + 1), by + have hlenL : (a :: (u ++ b :: v)).length = u.length + v.length + 2 := by + simp; omega + have hlenB : (b :: (v ++ [a])).length = v.length + 2 := by simp + rw [hlenB] + omega⟩), ∀ (k : Fin (a :: (u ++ b :: v)).length), ∀ (hlenL : (a :: (u ++ b :: + v)).length = u.length + v.length + 2), ∀ (hkA : ¬(↑k : ℕ) ≤ u.length), ∀ (hjval : + k.val - (u.length + 1) ≤ v.length), + let iB : Fin (b :: (v ++ [a])).length := + ⟨k.val - (u.length + 1), by + have hlen : (b :: (v ++ [a])).length = v.length + 2 := by simp + rw [hlen] + omega⟩ + ∀ (hjlast : (↑iB : ℕ) < v.length), + let k1 : Fin (a :: (u ++ b :: v)).length := + ⟨k.val + 1, by + have hks : k.val + 1 < u.length + v.length + 2 := by dsimp [iB] at hjlast; omega + simpa [hlenL] using hks⟩ + let nextParent : Fin (a :: (u ++ b :: v)).length := + ⟨(k.val + 1) % (a :: (u ++ b :: v)).length, + Nat.mod_lt _ (Nat.zero_lt_of_lt k.isLt)⟩ + ∀ (hk1mod : (k.val + 1) % (a :: (u ++ b :: v)).length = k.val + 1), (nextParent = k1) → ( + let iB1 : Fin (b :: (v ++ [a])).length := + ⟨k1.val - (u.length + 1), by + have hlen : (b :: (v ++ [a])).length = v.length + 2 := by simp + rw [hlen] + have hks : k.val + 1 < u.length + v.length + 2 := by dsimp [iB] at hjlast; omega + dsimp [k1] + omega⟩ + (a :: (u ++ b :: v)).get nextParent = (b :: (v ++ [a])).get iB1) := by + classical + intro n a b u v hv hBget k hlenL hkA hjval iB hjlast k1 nextParent hk1mod hnextIndex iB1 + calc + (a :: (u ++ b :: v)).get nextParent = (a :: (u ++ b :: v)).get k1 := by + rw [hnextIndex] + _ = (b :: (v ++ [a])).get iB1 := by + have hkB1 : u.length + 1 ≤ k1.val := by dsimp [k1]; omega + have htemp := hBget k1 hkB1 + have hidx : (k1.val - (u.length + 1)) = iB1.val := by rfl + have hfin : (⟨k1.val - (u.length + 1), (show _ by + have hlen : (b :: (v ++ [a])).length = v.length + 2 := by simp + rw [hlen] + have hkv : k.val < u.length + v.length + 2 := by simpa [hlenL] using k.isLt + have hks : k.val + 1 < u.length + v.length + 2 := by dsimp [iB] at hjlast; omega + dsimp [k1] + omega)⟩ : Fin (b :: (v ++ [a])).length) = iB1 := Fin.ext hidx + rw [← hfin] + exact htemp + +private theorem hchildNextAt907 : + ∀ (n : Nat), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : + ℕ)))), ∀ (v : List (Fin (n + (3 : ℕ)))), ∀ (hv : (0 : ℕ) < v.length), ∀ (k : Fin (a :: (u + ++ b :: v)).length), ∀ (hlenL : (a :: (u ++ b :: v)).length = u.length + v.length + 2), ∀ + (hkA : ¬(↑k : ℕ) ≤ u.length), ∀ (hjval : k.val - (u.length + 1) ≤ v.length), + let iB : Fin (b :: (v ++ [a])).length := + ⟨k.val - (u.length + 1), by + have hlen : (b :: (v ++ [a])).length = v.length + 2 := by simp + rw [hlen] + omega⟩ + ∀ (hjlast : (↑iB : ℕ) < v.length), + let k1 : Fin (a :: (u ++ b :: v)).length := + ⟨k.val + 1, by + have hks : k.val + 1 < u.length + v.length + 2 := by dsimp [iB] at hjlast; omega + simpa [hlenL] using hks⟩ + ∀ (hk1mod : (k.val + 1) % (a :: (u ++ b :: v)).length = k.val + 1), + let iB1 : Fin (b :: (v ++ [a])).length := + ⟨k1.val - (u.length + 1), by + have hlen : (b :: (v ++ [a])).length = v.length + 2 := by simp + rw [hlen] + have hks : k.val + 1 < u.length + v.length + 2 := by dsimp [iB] at hjlast; omega + dsimp [k1] + omega⟩ + (b :: (v ++ [a])).get + ⟨(iB.val + 1) % (b :: (v ++ [a])).length, + Nat.mod_lt _ (Nat.zero_lt_of_lt iB.isLt)⟩ = + (b :: (v ++ [a])).get iB1 := by + classical + intro n a b u v hv k hlenL hkA hjval iB hjlast k1 hk1mod iB1 + apply congrArg + apply Fin.ext + have hlen : (b :: (v ++ [a])).length = v.length + 2 := by simp + have hstep : iB.val + 1 < (b :: (v ++ [a])).length := by + have hvlen : v.length < (b :: (v ++ [a])).length := by simp + omega + have hiB1 : iB1.val = iB.val + 1 := by dsimp [iB, iB1, k1]; omega + exact (Nat.mod_eq_of_lt hstep).trans hiB1.symm + +private theorem hchildNextAt975 : + ∀ (n : Nat), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : + ℕ)))), ∀ (v : List (Fin (n + (3 : ℕ)))), ∀ (k : Fin (a :: (u ++ b :: v)).length), ∀ + (hjval : k.val - (u.length + 1) ≤ v.length), + let iB : Fin (b :: (v ++ [a])).length := + ⟨k.val - (u.length + 1), by + have hlen : (b :: (v ++ [a])).length = v.length + 2 := by simp + rw [hlen] + omega⟩ + (iB.val = v.length) → ( + let iB1 : Fin (b :: (v ++ [a])).length := ⟨v.length + 1, by simp⟩ + (b :: (v ++ [a])).get + ⟨(iB.val + 1) % (b :: (v ++ [a])).length, + Nat.mod_lt _ (Nat.zero_lt_of_lt iB.isLt)⟩ = + (b :: (v ++ [a])).get iB1) := by + classical + intro n a b u v k hjval iB hjEq iB1 + apply congrArg + apply Fin.ext + have hiEq : iB.val + 1 = v.length + 1 := by omega + have hstep : iB.val + 1 < (b :: (v ++ [a])).length := by + have hstep' : iB.val + 1 < v.length + 2 := by rw [hiEq]; omega + have hlen : v.length + 2 = (b :: (v ++ [a])).length := by simp + exact Nat.lt_of_lt_of_eq hstep' hlen + exact (Nat.mod_eq_of_lt hstep).trans (by rw [hiEq]) + +private theorem hcycR : + ∀ (n : Nat), ∀ (L : List (Fin (n + (3 : ℕ)))), ∀ (k : ℕ), (∃ (k : ℕ), L.Sublist ((List.ofFn + fun (i : Fin (n + (3 : ℕ))) => i).rotate k)) → (∃ m : Nat, (L.rotate k).Sublist + ((List.ofFn (fun i : Fin (n + 3) => i)).rotate m)) := by + classical + intro n L k hcyc + obtain ⟨r, hr⟩ := hcyc + have hrotateSublist (h : L.Sublist + ((List.ofFn (fun i : Fin (n + 3) => i)).rotate r)) : + ∃ s, (L.rotate k).Sublist + (((List.ofFn (fun i : Fin (n + 3) => i)).rotate r).rotate s) := by + have hs : (L.take (k % L.length) ++ L.drop (k % L.length)).Sublist + ((List.ofFn (fun i : Fin (n + 3) => i)).rotate r) := by + simpa only [List.take_append_drop] using h + obtain ⟨A, B, hroot, htake, hdrop⟩ := List.append_sublist_iff.mp hs + refine ⟨A.length, ?_⟩ + rw [hroot, List.rotate_append_length_eq, List.rotate_eq_drop_append_take_mod] + exact hdrop.append htake + obtain ⟨s, hs⟩ := hrotateSublist hr + exact ⟨r + s, by simpa only [List.rotate_rotate] using hs⟩ + +end SavedDissectionProof + +namespace SavedDissectionCases + +private theorem triangleCase : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), (Function.Injective q ∧ (∀ (f : Fin (3 : ℕ) → + Fin (n + (3 : ℕ))), Function.Injective f → P3381T1TriangleDeterminant (q ∘ f) ≠ (0 : + ℝ)) ∧ ∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), j ≠ i → j ≠ i + (1 : Fin (n + + (3 : ℕ))) → (0 : ℝ) < P3381T1TriangleDeterminant ![q i, q (i + (1 : Fin (n + (3 : + ℕ)))), q j]) → ( + let Good : List (Fin (n + 3)) → List (Fin 3 → Fin (n + 3)) → Prop := fun L F => + L.Nodup → + (∃ k : Nat, L.Sublist + ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) → + (∀ f ∈ F, Function.Injective f ∧ + Set.range f ⊆ {i | i ∈ L} ∧ + P3381T1TriangleDeterminant (q ∘ f) ≠ 0) ∧ + F.Pairwise (fun f g => Set.range f ≠ Set.range g) ∧ + convexHull Real (q '' {i | i ∈ L}) = + ⋃ (f : Fin 3 → Fin (n + 3)) (_ : f ∈ F), + convexHull Real (Set.range (q ∘ f)) ∧ + (∀ f ∈ F, ∀ g ∈ F, + convexHull Real (Set.range (q ∘ f)) ∩ + convexHull Real (Set.range (q ∘ g)) = + convexHull Real (q '' (Set.range f ∩ Set.range g))) ∧ + (∀ k : Fin L.length, + ∃! f : Fin 3 → Fin (n + 3), f ∈ F ∧ + L.get k ∈ Set.range f ∧ + L.get ⟨(k.val + 1) % L.length, + Nat.mod_lt _ (Nat.zero_lt_of_lt k.isLt)⟩ ∈ Set.range f) + ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (c : Fin (n + (3 : ℕ))), ([a, b, + c].Nodup) → ((∃ (k : ℕ), [a, b, c].Sublist ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => + i).rotate k)) → (Good [a, b, c] [![a, b, c]]))) := by + classical + intro n q hsupport Good a b c hboundary hcyclic hnd hcyc + have hnd' : (a ≠ b ∧ a ≠ c) ∧ b ≠ c := by simpa using hnd + let f : Fin 3 → Fin (n + 3) := ![a, b, c] + have hfi : Function.Injective f := by + intro i j hij + fin_cases i <;> fin_cases j <;> simp_all [f] + have hdet : P3381T1TriangleDeterminant (q ∘ f) ≠ 0 := + hsupport.2.1 f hfi + have hset := SavedDissectionProof.hsetAt164 + n q a b c hboundary hcyclic hnd hcyc hnd' hfi hdet + refine ⟨?_, by simp, ?_, ?_, ?_⟩ + · intro g hg + simp only [List.mem_singleton] at hg + subst g + refine ⟨hfi, ?_, hdet⟩ + intro x hx + rcases hx with ⟨i, rfl⟩ + fin_cases i <;> simp [] + · calc + convexHull Real (q '' {i | i ∈ [a, b, c]}) = + convexHull Real (Set.range (q ∘ f)) := congrArg (convexHull Real) hset + _ = ⋃ g ∈ [f], convexHull Real (Set.range (q ∘ g)) := by simp + · intro g hg j hj + simp only [List.mem_singleton] at hg hj + subst g + subst j + simp [Set.range_comp] + · intro k + fin_cases k + · refine ⟨f, ?_, ?_⟩ + · simp [f] + · intro g hg + exact List.mem_singleton.mp hg.1 + · refine ⟨f, ?_, ?_⟩ + · simp [f] + · intro g hg + exact List.mem_singleton.mp hg.1 + · refine ⟨f, ?_, ?_⟩ + · simp [f] + · intro g hg + exact List.mem_singleton.mp hg.1 + +private theorem leftBoundaryCase : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), + let Good : List (Fin (n + 3)) → List (Fin 3 → Fin (n + 3)) → Prop := fun L F => + L.Nodup → + (∃ k : Nat, L.Sublist + ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) → + (∀ f ∈ F, Function.Injective f ∧ + Set.range f ⊆ {i | i ∈ L} ∧ + P3381T1TriangleDeterminant (q ∘ f) ≠ 0) ∧ + F.Pairwise (fun f g => Set.range f ≠ Set.range g) ∧ + convexHull Real (q '' {i | i ∈ L}) = + ⋃ (f : Fin 3 → Fin (n + 3)) (_ : f ∈ F), + convexHull Real (Set.range (q ∘ f)) ∧ + (∀ f ∈ F, ∀ g ∈ F, + convexHull Real (Set.range (q ∘ f)) ∩ + convexHull Real (Set.range (q ∘ g)) = + convexHull Real (q '' (Set.range f ∩ Set.range g))) ∧ + (∀ k : Fin L.length, + ∃! f : Fin 3 → Fin (n + 3), f ∈ F ∧ + L.get k ∈ Set.range f ∧ + L.get ⟨(k.val + 1) % L.length, + Nat.mod_lt _ (Nat.zero_lt_of_lt k.isLt)⟩ ∈ Set.range f) + ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : ℕ)))), ∀ (v + : List (Fin (n + (3 : ℕ)))), ∀ (left : List (Fin (3 : ℕ) → Fin (n + (3 : ℕ)))), ∀ (right + : List (Fin (3 : ℕ) → Fin (n + (3 : ℕ)))), ∀ (hv : (0 : ℕ) < v.length), ∀ (hndA : (a :: + (u ++ [b])).Nodup), ∀ (hcycA : ∃ (k : ℕ), (a :: (u ++ [b])).Sublist ((List.ofFn fun (i : + Fin (n + (3 : ℕ))) => i).rotate k)), ∀ (hgoodA : Good (a :: (u ++ [b])) left), ∀ (hfaceB + : ∀ f ∈ right, Function.Injective f ∧ Set.range f ⊆ {i : Fin (n + (3 : ℕ)) | i ∈ b :: (v + ++ [a])} ∧ P3381T1TriangleDeterminant (q ∘ f) ≠ (0 : ℝ)), (∀ (i : Fin (a :: (u ++ b :: + v)).length), ∀ (hi : i.val ≤ u.length + 1), (a :: (u ++ b :: v)).get i = + (a :: (u ++ [b])).get ⟨i.val, by + have hlen : (a :: (u ++ [b])).length = u.length + 2 := by simp + rw [hlen] + omega⟩) → ((∀ (i : Fin (a :: (u ++ [b])).length), ∀ (j : Fin (a :: (u ++ [b])).length), + (i.val + 1 = j.val) → (((a :: (u ++ [b])).get i ∈ ({a, b} : Set (Fin (n + 3)))) → + (((a :: (u ++ [b])).get j ∈ ({a, b} : Set (Fin (n + 3)))) → (False)))) → (∀ (k : + Fin (a :: (u ++ b :: v)).length), ((a :: (u ++ b :: v)).length = u.length + + v.length + 2) → ((∀ (x : Fin (n + 3)), (x ∈ a :: (u ++ [b])) → ((x ∈ b :: (v ++ + [a])) → (x ∈ ({a, b} : Set (Fin (n + 3)))))) → (((↑k : ℕ) ≤ u.length) → (∃! f : Fin + 3 → Fin (n + 3), f ∈ left ++ right ∧ (a :: (u ++ b :: v)).get k ∈ Set.range f ∧ (a + :: (u ++ b :: v)).get ⟨(k.val + 1) % (a :: (u ++ b :: v)).length, Nat.mod_lt _ + (Nat.zero_lt_of_lt k.isLt)⟩ ∈ Set.range f))))) := by + classical + intro n q Good a b u v left right hv hndA hcycA hgoodA hfaceB hAget hNoAEndpoints k hlenL + hABpoint hkA + let iA : Fin (a :: (u ++ [b])).length := + ⟨k.val, by have hlen : (a :: (u ++ [b])).length = u.length + 2 := by simp + rw [hlen]; omega⟩ + let iA1 : Fin (a :: (u ++ [b])).length := + ⟨k.val + 1, by have hlen : (a :: (u ++ [b])).length = u.length + 2 := by simp + rw [hlen]; omega⟩ + have hk1Lt : k.val + 1 < (a :: (u ++ b :: v)).length := by + have hk1 : k.val + 1 < u.length + v.length + 2 := by omega + simpa [hlenL] using hk1 + let k1 : Fin (a :: (u ++ b :: v)).length := ⟨k.val + 1, hk1Lt⟩ + let nextParent : Fin (a :: (u ++ b :: v)).length := + ⟨(k.val + 1) % (a :: (u ++ b :: v)).length, + Nat.mod_lt _ (Nat.zero_lt_of_lt k.isLt)⟩ + have hnextIndex : nextParent = k1 := by + apply Fin.ext + exact Nat.mod_eq_of_lt hk1Lt + have hfirst : (a :: (u ++ b :: v)).get k = (a :: (u ++ [b])).get iA := by + exact hAget k (by omega) + have hsecond : + (a :: (u ++ b :: v)).get nextParent = (a :: (u ++ [b])).get iA1 := by + calc + (a :: (u ++ b :: v)).get nextParent = (a :: (u ++ b :: v)).get k1 := by + rw [hnextIndex] + _ = (a :: (u ++ [b])).get iA1 := by + exact hAget k1 (by dsimp [k1]; omega) + have hchildNext := SavedDissectionProof.hchildNextAt805 n a b u v k + hlenL hkA hk1Lt + have hincA := (hgoodA hndA hcycA).2.2.2.2 iA + rcases hincA with ⟨f, hfA, huniqA⟩ + have hfAfirst : (a :: (u ++ [b])).get iA ∈ Set.range f := hfA.2.1 + have hfAsecond : (a :: (u ++ [b])).get iA1 ∈ Set.range f := by + rw [← hchildNext] + exact hfA.2.2 + refine ⟨f, ?_, ?_⟩ + · refine ⟨List.mem_append_left _ hfA.1, ?_, ?_⟩ + · rw [hfirst]; exact hfAfirst + · change (a :: (u ++ b :: v)).get nextParent ∈ Set.range f + rw [hsecond] + exact hfAsecond + · intro g hg + rcases List.mem_append.mp hg.1 with hgA | hgB + · apply huniqA g + refine ⟨hgA, ?_, ?_⟩ + · rw [← hfirst]; exact hg.2.1 + · have hgSecond := hg.2.2 + change (a :: (u ++ b :: v)).get nextParent ∈ Set.range g at hgSecond + rw [hsecond] at hgSecond + rw [← hchildNext] at hgSecond + exact hgSecond + · have hxgA : (a :: (u ++ [b])).get iA ∈ Set.range g := by + rw [← hfirst]; exact hg.2.1 + have hygA : (a :: (u ++ [b])).get iA1 ∈ Set.range g := by + have hgSecond := hg.2.2 + change (a :: (u ++ b :: v)).get nextParent ∈ Set.range g at hgSecond + rw [hsecond] at hgSecond + exact hgSecond + have hsmallA : (a :: (u ++ [b])).get iA ∈ ({a, b} : Set _) := + hABpoint _ (List.get_mem _ iA) + ((hfaceB g hgB).2.1 hxgA) + have hsmallA1 : (a :: (u ++ [b])).get iA1 ∈ ({a, b} : Set _) := + hABpoint _ (List.get_mem _ iA1) + ((hfaceB g hgB).2.1 hygA) + exact False.elim (hNoAEndpoints iA iA1 (by dsimp [iA, iA1]) hsmallA hsmallA1) + +private theorem rightBoundaryCase : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), + let Good : List (Fin (n + 3)) → List (Fin 3 → Fin (n + 3)) → Prop := fun L F => + L.Nodup → + (∃ k : Nat, L.Sublist + ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) → + (∀ f ∈ F, Function.Injective f ∧ + Set.range f ⊆ {i | i ∈ L} ∧ + P3381T1TriangleDeterminant (q ∘ f) ≠ 0) ∧ + F.Pairwise (fun f g => Set.range f ≠ Set.range g) ∧ + convexHull Real (q '' {i | i ∈ L}) = + ⋃ (f : Fin 3 → Fin (n + 3)) (_ : f ∈ F), + convexHull Real (Set.range (q ∘ f)) ∧ + (∀ f ∈ F, ∀ g ∈ F, + convexHull Real (Set.range (q ∘ f)) ∩ + convexHull Real (Set.range (q ∘ g)) = + convexHull Real (q '' (Set.range f ∩ Set.range g))) ∧ + (∀ k : Fin L.length, + ∃! f : Fin 3 → Fin (n + 3), f ∈ F ∧ + L.get k ∈ Set.range f ∧ + L.get ⟨(k.val + 1) % L.length, + Nat.mod_lt _ (Nat.zero_lt_of_lt k.isLt)⟩ ∈ Set.range f) + ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : ℕ)))), ∀ (v + : List (Fin (n + (3 : ℕ)))), ∀ (left : List (Fin (3 : ℕ) → Fin (n + (3 : ℕ)))), ∀ (right + : List (Fin (3 : ℕ) → Fin (n + (3 : ℕ)))), ∀ (hv : (0 : ℕ) < v.length), ∀ (hndB : (b :: + (v ++ [a])).Nodup), ∀ (hcycB : ∃ (k : ℕ), (b :: (v ++ [a])).Sublist ((List.ofFn fun (i : + Fin (n + (3 : ℕ))) => i).rotate k)), ∀ (hgoodB : Good (b :: (v ++ [a])) right), ∀ (hfaceA + : ∀ f ∈ left, Function.Injective f ∧ Set.range f ⊆ {i : Fin (n + (3 : ℕ)) | i ∈ a :: (u + ++ [b])} ∧ P3381T1TriangleDeterminant (q ∘ f) ≠ (0 : ℝ)), ∀ (hlenL : (a :: (u ++ b :: + v)).length = u.length + v.length + 2), (∀ (j : Fin (a :: (u ++ b :: v)).length), ∀ (hj : + u.length + 1 ≤ j.val), (a :: (u ++ b :: v)).get j = + (b :: (v ++ [a])).get ⟨j.val - (u.length + 1), by + have hlenB : (b :: (v ++ [a])).length = v.length + 2 := by simp + rw [hlenB] + omega⟩) → ((∀ (i : Fin (b :: (v ++ [a])).length), ∀ (j : Fin (b :: (v ++ [a])).length), + (i.val + 1 = j.val) → (((b :: (v ++ [a])).get i ∈ ({a, b} : Set (Fin (n + 3)))) → + (((b :: (v ++ [a])).get j ∈ ({a, b} : Set (Fin (n + 3)))) → (False)))) → (∀ (k : + Fin (a :: (u ++ b :: v)).length), (∀ (x : Fin (n + 3)), (x ∈ a :: (u ++ [b])) → ((x + ∈ b :: (v ++ [a])) → (x ∈ ({a, b} : Set (Fin (n + 3)))))) → ((¬(↑k : ℕ) ≤ u.length) + → (∃! f : Fin 3 → Fin (n + 3), f ∈ left ++ right ∧ (a :: (u ++ b :: v)).get k ∈ + Set.range f ∧ (a :: (u ++ b :: v)).get ⟨(k.val + 1) % (a :: (u ++ b :: v)).length, + Nat.mod_lt _ (Nat.zero_lt_of_lt k.isLt)⟩ ∈ Set.range f)))) := by + classical + intro n q Good a b u v left right hv hndB hcycB hgoodB hfaceA hlenL hBget hNoBEndpoints k + hABpoint hkA + have hkB : u.length + 1 ≤ k.val := by omega + have hjval : k.val - (u.length + 1) ≤ v.length := by + have hkv : k.val < u.length + v.length + 2 := by simpa [hlenL] using k.isLt + omega + let iB : Fin (b :: (v ++ [a])).length := + ⟨k.val - (u.length + 1), by + have hlen : (b :: (v ++ [a])).length = v.length + 2 := by simp + rw [hlen] + omega⟩ + have hfirst : (a :: (u ++ b :: v)).get k = (b :: (v ++ [a])).get iB := by + simpa [iB] using hBget k hkB + by_cases hjlast : iB.val < v.length + · let k1 : Fin (a :: (u ++ b :: v)).length := + ⟨k.val + 1, by + have hkv : k.val < u.length + v.length + 2 := by simpa [hlenL] using k.isLt + have hks : k.val + 1 < u.length + v.length + 2 := by dsimp [iB] at hjlast; omega + simpa [hlenL] using hks⟩ + let nextParent : Fin (a :: (u ++ b :: v)).length := + ⟨(k.val + 1) % (a :: (u ++ b :: v)).length, + Nat.mod_lt _ (Nat.zero_lt_of_lt k.isLt)⟩ + have hk1mod : (k.val + 1) % (a :: (u ++ b :: v)).length = k.val + 1 := by + have hkv : k.val < u.length + v.length + 2 := by simpa [hlenL] using k.isLt + have hks : k.val + 1 < u.length + v.length + 2 := by dsimp [iB] at hjlast; omega + simpa [hlenL] using Nat.mod_eq_of_lt hks + have hnextIndex : nextParent = k1 := by + apply Fin.ext + exact hk1mod + let iB1 : Fin (b :: (v ++ [a])).length := + ⟨k1.val - (u.length + 1), by + have hlen : (b :: (v ++ [a])).length = v.length + 2 := by simp + rw [hlen] + have hkv : k.val < u.length + v.length + 2 := by simpa [hlenL] using k.isLt + have hks : k.val + 1 < u.length + v.length + 2 := by dsimp [iB] at hjlast; omega + dsimp [k1] + omega⟩ + have hsecond := SavedDissectionProof.hsecondAt889 n a b u v hv hBget k hlenL hkA hjval hjlast + hk1mod hnextIndex + have hchildNext := SavedDissectionProof.hchildNextAt907 n a b u v hv + k hlenL hkA hjval hjlast hk1mod + have hincB := (hgoodB hndB hcycB).2.2.2.2 iB + rcases hincB with ⟨f, hfB, huniqB⟩ + have hfBfirst : (b :: (v ++ [a])).get iB ∈ Set.range f := hfB.2.1 + have hfBsecond : (b :: (v ++ [a])).get iB1 ∈ Set.range f := by + rw [← hchildNext] + exact hfB.2.2 + refine ⟨f, ?_, ?_⟩ + · refine ⟨List.mem_append_right _ hfB.1, ?_, ?_⟩ + · rw [hfirst]; exact hfBfirst + · change (a :: (u ++ b :: v)).get nextParent ∈ Set.range f + rw [hsecond] + exact hfBsecond + · intro g hg + rcases List.mem_append.mp hg.1 with hgA | hgB + · have hxgB : (b :: (v ++ [a])).get iB ∈ Set.range g := by + rw [← hfirst]; exact hg.2.1 + have hygB : (b :: (v ++ [a])).get iB1 ∈ Set.range g := by + have hgSecond := hg.2.2 + change (a :: (u ++ b :: v)).get nextParent ∈ Set.range g at hgSecond + rw [hsecond] at hgSecond + exact hgSecond + have hsmallB : (b :: (v ++ [a])).get iB ∈ ({a, b} : Set _) := + hABpoint _ ((hfaceA g hgA).2.1 hxgB) (List.get_mem _ iB) + have hsmallB1 : (b :: (v ++ [a])).get iB1 ∈ ({a, b} : Set _) := + hABpoint _ ((hfaceA g hgA).2.1 hygB) (List.get_mem _ iB1) + exact False.elim (hNoBEndpoints iB iB1 (by dsimp [iB, iB1, k1]; omega) + hsmallB hsmallB1) + · apply huniqB g + refine ⟨hgB, ?_, ?_⟩ + · rw [← hfirst]; exact hg.2.1 + · have hgSecond := hg.2.2 + change (a :: (u ++ b :: v)).get nextParent ∈ Set.range g at hgSecond + rw [hsecond] at hgSecond + rw [← hchildNext] at hgSecond + exact hgSecond + · have hjEq : iB.val = v.length := by + have hival : iB.val = k.val - (u.length + 1) := rfl + omega + have hkLast : k.val + 1 = (a :: (u ++ b :: v)).length := by + have hkv : k.val < u.length + v.length + 2 := by simpa [hlenL] using k.isLt + dsimp [iB] at hjEq + omega + let nextParent : Fin (a :: (u ++ b :: v)).length := + ⟨(k.val + 1) % (a :: (u ++ b :: v)).length, + Nat.mod_lt _ (Nat.zero_lt_of_lt k.isLt)⟩ + have hnextZero : nextParent = 0 := by + apply Fin.ext + change (k.val + 1) % (a :: (u ++ b :: v)).length = 0 + rw [hkLast] + exact Nat.mod_self _ + let iB1 : Fin (b :: (v ++ [a])).length := ⟨v.length + 1, by simp⟩ + have hsecond : + (a :: (u ++ b :: v)).get nextParent = (b :: (v ++ [a])).get iB1 := by + rw [hnextZero] + simp [iB1, List.get_eq_getElem] + have hchildNext := SavedDissectionProof.hchildNextAt975 n a b u v k + hjval hjEq + have hincB := (hgoodB hndB hcycB).2.2.2.2 iB + rcases hincB with ⟨f, hfB, huniqB⟩ + have hfBfirst : (b :: (v ++ [a])).get iB ∈ Set.range f := hfB.2.1 + have hfBsecond : (b :: (v ++ [a])).get iB1 ∈ Set.range f := by + rw [← hchildNext] + exact hfB.2.2 + refine ⟨f, ?_, ?_⟩ + · refine ⟨List.mem_append_right _ hfB.1, ?_, ?_⟩ + · rw [hfirst]; exact hfBfirst + · change (a :: (u ++ b :: v)).get nextParent ∈ Set.range f + rw [hsecond] + exact hfBsecond + · intro g hg + rcases List.mem_append.mp hg.1 with hgA | hgB + · have hxgB : (b :: (v ++ [a])).get iB ∈ Set.range g := by + rw [← hfirst]; exact hg.2.1 + have hygB : (b :: (v ++ [a])).get iB1 ∈ Set.range g := by + have hgSecond := hg.2.2 + change (a :: (u ++ b :: v)).get nextParent ∈ Set.range g at hgSecond + rw [hsecond] at hgSecond + exact hgSecond + have hsmallB : (b :: (v ++ [a])).get iB ∈ ({a, b} : Set _) := + hABpoint _ ((hfaceA g hgA).2.1 hxgB) (List.get_mem _ iB) + have hsmallB1 : (b :: (v ++ [a])).get iB1 ∈ ({a, b} : Set _) := + hABpoint _ ((hfaceA g hgA).2.1 hygB) (List.get_mem _ iB1) + exact False.elim (hNoBEndpoints iB iB1 (by dsimp [iB, iB1]; omega) + hsmallB hsmallB1) + · apply huniqB g + refine ⟨hgB, ?_, ?_⟩ + · rw [← hfirst]; exact hg.2.1 + · have hgSecond := hg.2.2 + change (a :: (u ++ b :: v)).get nextParent ∈ Set.range g at hgSecond + rw [hsecond] at hgSecond + rw [← hchildNext] at hgSecond + exact hgSecond + +private theorem rotationCase : + ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), + let Good : List (Fin (n + 3)) → List (Fin 3 → Fin (n + 3)) → Prop := fun L F => + L.Nodup → + (∃ k : Nat, L.Sublist + ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) → + (∀ f ∈ F, Function.Injective f ∧ + Set.range f ⊆ {i | i ∈ L} ∧ + P3381T1TriangleDeterminant (q ∘ f) ≠ 0) ∧ + F.Pairwise (fun f g => Set.range f ≠ Set.range g) ∧ + convexHull Real (q '' {i | i ∈ L}) = + ⋃ (f : Fin 3 → Fin (n + 3)) (_ : f ∈ F), + convexHull Real (Set.range (q ∘ f)) ∧ + (∀ f ∈ F, ∀ g ∈ F, + convexHull Real (Set.range (q ∘ f)) ∩ + convexHull Real (Set.range (q ∘ g)) = + convexHull Real (q '' (Set.range f ∩ Set.range g))) ∧ + (∀ k : Fin L.length, + ∃! f : Fin 3 → Fin (n + 3), f ∈ F ∧ + L.get k ∈ Set.range f ∧ + L.get ⟨(k.val + 1) % L.length, + Nat.mod_lt _ (Nat.zero_lt_of_lt k.isLt)⟩ ∈ Set.range f) + ∀ (L : List (Fin (n + (3 : ℕ)))), ∀ (F : List (Fin (3 : ℕ) → Fin (n + (3 : ℕ)))), ∀ (k : ℕ), + (P3511T1CyclicDissection (Fin (n + (3 : ℕ))) (L.rotate k) F) → (((L.rotate k).Nodup → + (∃ (k_1 : ℕ), (L.rotate k).Sublist ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate + k_1)) → Good (L.rotate k) F) → (Good L F)) := by + classical + intro n q Good L F k d ih hnd hcyc + have hndR : (L.rotate k).Nodup := by simpa using hnd + have hcycR := SavedDissectionProof.hcycR n L k hcyc + have hR : Good (L.rotate k) F := ih hndR hcycR + have hRfacts := hR hndR hcycR + have hset : q '' {i | i ∈ L} = q '' {i | i ∈ L.rotate k} := by + ext x + constructor + · rintro ⟨i, hi, rfl⟩ + exact ⟨i, (List.mem_rotate).2 hi, rfl⟩ + · rintro ⟨i, hi, rfl⟩ + exact ⟨i, (List.mem_rotate).1 hi, rfl⟩ + have hreplaceMod (N x y : Nat) : (x + y % N) % N = (x + y) % N := by + rw [Nat.add_mod, Nat.add_mod] + simp + have hsuccMod (N x : Nat) : ((x % N) + 1) % N = (x + 1) % N := by + rw [Nat.add_mod, Nat.add_mod] + simp + have hrotateSuccMod (N r i : Nat) : + (N - r + ((i + 1) % N)) % N = (((N - r + i) % N) + 1) % N := by + calc + (N - r + ((i + 1) % N)) % N = (N - r + (i + 1)) % N := + hreplaceMod N (N - r) (i + 1) + _ = ((N - r + i) % N + 1) % N := (hsuccMod N (N - r + i)).symm + refine ⟨?_, hRfacts.2.1, ?_, hRfacts.2.2.2.1, ?_⟩ + · intro f hf + rcases hRfacts.1 f hf with ⟨hfi, hsub, hdet⟩ + refine ⟨hfi, ?_, hdet⟩ + intro x hx + exact (List.mem_rotate).1 (hsub hx) + · calc + convexHull Real (q '' {i | i ∈ L}) = + convexHull Real (q '' {i | i ∈ L.rotate k}) := + congrArg (convexHull Real) hset + _ = ⋃ (f : Fin 3 → Fin (n + 3)) (_ : f ∈ F), + convexHull Real (Set.range (q ∘ f)) := hRfacts.2.2.1 + · intro i + let offset := L.length - k % L.length + let j : Fin (L.rotate k).length := + ⟨(offset + i.val) % L.length, by + simp only [List.length_rotate] + exact Nat.mod_lt _ (Nat.zero_lt_of_lt i.isLt)⟩ + let nextI : Fin L.length := + ⟨(i.val + 1) % L.length, Nat.mod_lt _ (Nat.zero_lt_of_lt i.isLt)⟩ + let jNext : Fin (L.rotate k).length := + ⟨(offset + nextI.val) % L.length, by + simp only [List.length_rotate] + exact Nat.mod_lt _ (Nat.zero_lt_of_lt i.isLt)⟩ + let jSucc : Fin (L.rotate k).length := + ⟨(j.val + 1) % (L.rotate k).length, + Nat.mod_lt _ (Nat.zero_lt_of_lt j.isLt)⟩ + have hjEq : jNext = jSucc := by + apply Fin.ext + change (offset + nextI.val) % L.length = (j.val + 1) % (L.rotate k).length + simp only [List.length_rotate] + dsimp [nextI, jNext, jSucc, j, offset] + exact hrotateSuccMod L.length (k % L.length) i.val + have hfirst : L.get i = (L.rotate k).get j := by + simpa [j, offset] using List.get_eq_get_rotate L k i + have hsecond : L.get nextI = (L.rotate k).get jSucc := by + have h := List.get_eq_get_rotate L k nextI + simpa [jNext, offset, hjEq] using h + obtain ⟨f, hfR, huniqR⟩ := hRfacts.2.2.2.2 j + refine ⟨f, ?_, ?_⟩ + · refine ⟨hfR.1, ?_, ?_⟩ + · rw [hfirst] + exact hfR.2.1 + · rw [hsecond] + exact hfR.2.2 + · intro g hg + apply huniqR g + refine ⟨hg.1, ?_, ?_⟩ + · rw [← hfirst] + exact hg.2.1 + · rw [← hsecond] + exact hg.2.2 + +end SavedDissectionCases + +theorem P3555T2SavedDissectionGeometry {n : Nat} + (q : Fin (n + 3) → Real × Real) + (hq : ∀ i, q i = ((i.val : Real), (i.val : Real) ^ 2)) + (boundary : List (Fin (n + 3))) + (faces : List (Fin 3 → Fin (n + 3))) + (hboundary : boundary.Nodup) + (hcyclic : ∃ k : Nat, boundary.Sublist + ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) + (hd : P3511T1CyclicDissection (Fin (n + 3)) boundary faces) : + (∀ f ∈ faces, Function.Injective f ∧ + Set.range f ⊆ {i | i ∈ boundary} ∧ + P3381T1TriangleDeterminant (q ∘ f) ≠ 0) ∧ + faces.Pairwise (fun f g => Set.range f ≠ Set.range g) ∧ + convexHull Real (q '' {i | i ∈ boundary}) = + ⋃ (f : Fin 3 → Fin (n + 3)) (_ : f ∈ faces), + convexHull Real (Set.range (q ∘ f)) ∧ + (∀ f ∈ faces, ∀ g ∈ faces, + convexHull Real (Set.range (q ∘ f)) ∩ + convexHull Real (Set.range (q ∘ g)) = + convexHull Real (q '' (Set.range f ∩ Set.range g))) ∧ + (∀ k : Fin boundary.length, + ∃! f : Fin 3 → Fin (n + 3), f ∈ faces ∧ + boundary.get k ∈ Set.range f ∧ + boundary.get ⟨(k.val + 1) % boundary.length, + Nat.mod_lt _ (Nat.zero_lt_of_lt k.isLt)⟩ ∈ Set.range f) := by +-- BODY + classical + have hsupport := P3555T2ParabolaSupporting q hq + let Good : List (Fin (n + 3)) → List (Fin 3 → Fin (n + 3)) → Prop := fun L F => + L.Nodup → + (∃ k : Nat, L.Sublist + ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) → + (∀ f ∈ F, Function.Injective f ∧ + Set.range f ⊆ {i | i ∈ L} ∧ + P3381T1TriangleDeterminant (q ∘ f) ≠ 0) ∧ + F.Pairwise (fun f g => Set.range f ≠ Set.range g) ∧ + convexHull Real (q '' {i | i ∈ L}) = + ⋃ (f : Fin 3 → Fin (n + 3)) (_ : f ∈ F), + convexHull Real (Set.range (q ∘ f)) ∧ + (∀ f ∈ F, ∀ g ∈ F, + convexHull Real (Set.range (q ∘ f)) ∩ + convexHull Real (Set.range (q ∘ g)) = + convexHull Real (q '' (Set.range f ∩ Set.range g))) ∧ + (∀ k : Fin L.length, + ∃! f : Fin 3 → Fin (n + 3), f ∈ F ∧ + L.get k ∈ Set.range f ∧ + L.get ⟨(k.val + 1) % L.length, + Nat.mod_lt _ (Nat.zero_lt_of_lt k.isLt)⟩ ∈ Set.range f) + have hgood : Good boundary faces := by + induction hd with + | triangle a b c => + have triangleCase : Good [a, b, c] [![a, b, c]] := SavedDissectionCases.triangleCase n q + hsupport a b c hboundary hcyclic + exact triangleCase + | split a b u v left right hu hv hleft hright ihleft ihright => + intro hnd hcyc + have hcuts := P3555T2ParabolaChordCuts q hq a b u v hv hnd hcyc + rcases hcuts with ⟨hab, hndA, hndB, hcycA, hcycB, hAB, hU, hV, + hcutA, hcutB, hunion, hinter⟩ + have hgoodA : Good (a :: (u ++ [b])) left := ihleft hndA hcycA + have hgoodB : Good (b :: (v ++ [a])) right := ihright hndB hcycB + have hfaceA := (hgoodA hndA hcycA).1 + have hpairA := (hgoodA hndA hcycA).2.1 + have hfaceB := (hgoodB hndB hcycB).1 + have hpairB := (hgoodB hndB hcycB).2.1 + have hcoverA := (hgoodA hndA hcycA).2.2.1 + have hcoverB := (hgoodB hndB hcycB).2.2.1 + have hinterA := (hgoodA hndA hcycA).2.2.2.1 + have hinterB := (hgoodB hndB hcycB).2.2.2.1 + let D : Real × Real → Real := fun z => + P3381T1TriangleDeterminant ![q a, q b, z] + have hDa : D (q a) = 0 := by simp [D, P3381T1TriangleDeterminant] + have hDb : D (q b) = 0 := by simp [D, P3381T1TriangleDeterminant] + have hDaffine (w : Fin 3 → Real) (p : Fin 3 → Real × Real) + (hw : (∑ i, w i) = 1) : + D (∑ i, w i • p i) = ∑ i, w i * D (p i) := SavedDissectionProof.hDaffine n q a b w p hw + have faceChord (f : Fin 3 → Fin (n + 3)) + (φ : (Real × Real) → Real) + (hφ : ∀ (w : Fin 3 → Real) (p : Fin 3 → Real × Real), + (∑ i, w i) = 1 → φ (∑ i, w i • p i) = ∑ i, w i * φ (p i)) + (hweak : ∀ i, φ (q (f i)) ≤ 0) + (hstrict : ∀ i, f i ≠ a → f i ≠ b → φ (q (f i)) < 0) + (z : Real × Real) (hz : z ∈ convexHull Real (Set.range (q ∘ f))) + (hzφ : φ z = 0) := SavedDissectionProof.faceChord n q a b f φ hφ hweak hstrict z hz hzφ + have hAparent := SavedDissectionProof.hAparent n a b u v + have hBparent := SavedDissectionProof.hBparent n a b u v + have hcross := SavedDissectionProof.hcross n q a b u v left right hAB + hfaceA hfaceB + have hDnegAffine (w : Fin 3 → Real) (p : Fin 3 → Real × Real) + (hw : (∑ i, w i) = 1) : + -D (∑ i, w i • p i) = ∑ i, w i * (-D (p i)) := by + rw [hDaffine w p hw] + simp + have hsignA (f : Fin 3 → Fin (n + 3)) (hf : f ∈ left) := SavedDissectionProof.hsignA n q a b u + left hU hfaceA hDa hDb f hf + have hsignB (f : Fin 3 → Fin (n + 3)) (hf : f ∈ right) := SavedDissectionProof.hsignB n q a + b v + right hV hfaceB hDa hDb f hf + have hendpoint_intersection (S T : Set (Fin (n + 3))) + (hS : S ⊆ ({a, b} : Set (Fin (n + 3)))) + (hT : T ⊆ ({a, b} : Set (Fin (n + 3)))) + (z : Real × Real) + (hzS : z ∈ convexHull Real (q '' S)) + (hzT : z ∈ convexHull Real (q '' T)) := SavedDissectionProof.hendpoint_intersection n q + hsupport a b hab S T hS hT z hzS hzT + have hcrossInter (f : Fin 3 → Fin (n + 3)) (hf : f ∈ left) + (g : Fin 3 → Fin (n + 3)) (hg : g ∈ right) := SavedDissectionProof.hcrossInter n q a b + u v left right hAB hinter hfaceA hfaceB + hDa hDb hDaffine faceChord hDnegAffine hsignA hsignB hendpoint_intersection f hf + g hg + have hAget (i : Fin (a :: (u ++ b :: v)).length) (hi : i.val ≤ u.length + 1) : + (a :: (u ++ b :: v)).get i = + (a :: (u ++ [b])).get ⟨i.val, by + have hlen : (a :: (u ++ [b])).length = u.length + 2 := by simp + rw [hlen] + omega⟩ := SavedDissectionProof.hAget n a b u v i hi + have hBget (j : Fin (a :: (u ++ b :: v)).length) (hj : u.length + 1 ≤ j.val) : + (a :: (u ++ b :: v)).get j = + (b :: (v ++ [a])).get ⟨j.val - (u.length + 1), by + have hlenL : (a :: (u ++ b :: v)).length = u.length + v.length + 2 := by + simp; omega + have hlenB : (b :: (v ++ [a])).length = v.length + 2 := by simp + have hj' : j.val < u.length + v.length + 2 := by simpa [hlenL] using j.isLt + rw [hlenB] + omega⟩ := SavedDissectionProof.hBget n a b u v j hj + have hNoAEndpoints (i j : Fin (a :: (u ++ [b])).length) + (hij : i.val + 1 = j.val) + (hia : (a :: (u ++ [b])).get i ∈ ({a, b} : Set (Fin (n + 3)))) + (hja : (a :: (u ++ [b])).get j ∈ ({a, b} : Set (Fin (n + 3)))) : False := + SavedDissectionProof.hNoAEndpoints n a b u v hu hndA i j hij hia hja + have hNoBEndpoints (i j : Fin (b :: (v ++ [a])).length) + (hij : i.val + 1 = j.val) + (hia : (b :: (v ++ [a])).get i ∈ ({a, b} : Set (Fin (n + 3)))) + (hja : (b :: (v ++ [a])).get j ∈ ({a, b} : Set (Fin (n + 3)))) : False := + SavedDissectionProof.hNoBEndpoints n a b u v hv hndB i j hij hia hja + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · intro f hf + rcases List.mem_append.mp hf with hf | hf + · rcases hfaceA f hf with ⟨hfi, hsub, hdet⟩ + refine ⟨hfi, ?_, hdet⟩ + intro x hx + exact hAparent x (hsub hx) + · rcases hfaceB f hf with ⟨hfi, hsub, hdet⟩ + refine ⟨hfi, ?_, hdet⟩ + intro x hx + exact hBparent x (hsub hx) + · apply List.pairwise_append.mpr + refine ⟨hpairA, hpairB, ?_⟩ + intro f hf g hg + exact hcross f hf g hg + · have hfaces := SavedDissectionProof.hfaces + n q left right + calc + convexHull Real (q '' {i | i ∈ a :: (u ++ b :: v)}) = + convexHull Real (q '' {i | i ∈ a :: (u ++ [b])}) ∪ + convexHull Real (q '' {i | i ∈ b :: (v ++ [a])}) := hunion.symm + _ = (⋃ f ∈ left, convexHull Real (Set.range (q ∘ f))) ∪ + (⋃ f ∈ right, convexHull Real (Set.range (q ∘ f))) := by + rw [hcoverA, hcoverB] + _ = ⋃ f ∈ left ++ right, convexHull Real (Set.range (q ∘ f)) := hfaces.symm + · intro f hf g hg + rcases List.mem_append.mp hf with hfA | hfB + · rcases List.mem_append.mp hg with hgA | hgB + · exact hinterA f hfA g hgA + · exact hcrossInter f hfA g hgB + · rcases List.mem_append.mp hg with hgA | hgB + · simpa [Set.inter_comm] using hcrossInter g hgA f hfB + · exact hinterB f hfB g hgB + · intro k + have hlenL : (a :: (u ++ b :: v)).length = u.length + v.length + 2 := by + simp; omega + have hABpoint (x : Fin (n + 3)) + (hxA : x ∈ a :: (u ++ [b])) (hxB : x ∈ b :: (v ++ [a])) : + x ∈ ({a, b} : Set (Fin (n + 3))) := by + have hx : x ∈ {i | i ∈ a :: (u ++ [b])} ∩ + {i | i ∈ b :: (v ++ [a])} := ⟨hxA, hxB⟩ + rw [hAB] at hx + simpa using hx + by_cases hkA : k.val ≤ u.length + · have leftBoundaryCase : + ∃! f : Fin 3 → Fin (n + 3), f ∈ left ++ right ∧ + (a :: (u ++ b :: v)).get k ∈ Set.range f ∧ + (a :: (u ++ b :: v)).get + ⟨(k.val + 1) % (a :: (u ++ b :: v)).length, + Nat.mod_lt _ (Nat.zero_lt_of_lt k.isLt)⟩ ∈ Set.range f := + SavedDissectionCases.leftBoundaryCase n q a b u v left right hv hndA hcycA + hgoodA hfaceB hAget hNoAEndpoints k hlenL hABpoint hkA + exact leftBoundaryCase + · have rightBoundaryCase : + ∃! f : Fin 3 → Fin (n + 3), f ∈ left ++ right ∧ + (a :: (u ++ b :: v)).get k ∈ Set.range f ∧ + (a :: (u ++ b :: v)).get + ⟨(k.val + 1) % (a :: (u ++ b :: v)).length, + Nat.mod_lt _ (Nat.zero_lt_of_lt k.isLt)⟩ ∈ Set.range f := + SavedDissectionCases.rightBoundaryCase n q a b u v left right hv hndB hcycB + hgoodB hfaceA hlenL hBget hNoBEndpoints k hABpoint hkA + exact rightBoundaryCase + | rotate L F k d ih => + have rotationCase : Good L F := SavedDissectionCases.rotationCase n q L F k d ih + exact rotationCase + exact hgood hboundary hcyclic + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean b/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean new file mode 100644 index 0000000000..15f1c18355 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean @@ -0,0 +1,1416 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3597T1GenericRayStability + +-- [TABLET NODE: P3597T1DirectionParity] + +/-! +# P3597T1DirectionParity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DirectionParityLemmas + +private theorem basis_coordinates : + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 + let coordA (d e : Real × Real) (v : Real × Real) : Real := det2 v e / det2 d e + let coordB (d e : Real × Real) (v : Real × Real) : Real := det2 d v / det2 d e + ∀ (d : Real × Real), ∀ (e : Real × Real), ∀ (v : Real × Real), (det2 d e ≠ 0) → (v = coordA d + e v • d + coordB d e v • e) := by + classical + intro det2 coordA coordB d e v hD + apply Prod.ext + · change v.1 = (det2 v e / det2 d e) * d.1 + (det2 d v / det2 d e) * e.1 + field_simp [hD] + dsimp [det2]; ring + · change v.2 = (det2 v e / det2 d e) * d.2 + (det2 d v / det2 d e) * e.2 + field_simp [hD] + dsimp [det2]; ring + +private theorem coordA_swap : + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 + let coordA (d e : Real × Real) (v : Real × Real) : Real := det2 v e / det2 d e + let coordB (d e : Real × Real) (v : Real × Real) : Real := det2 d v / det2 d e + ∀ (d : Real × Real), ∀ (e : Real × Real), ∀ (v : Real × Real), (det2 d e ≠ 0) → (coordA e d v + = coordB d e v) := by + classical + intro det2 coordA coordB d e v hD + have hED : det2 e d ≠ 0 := by + intro h + have hs : det2 e d = -det2 d e := by dsimp [det2]; ring + rw [hs] at h + exact hD (by linarith) + have hnum : det2 v d = -det2 d v := by dsimp [det2]; ring + have hden : det2 e d = -det2 d e := by dsimp [det2]; ring + dsimp [coordA, coordB] + rw [hnum, hden] + simp + +private theorem coordB_swap : + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 + let coordA (d e : Real × Real) (v : Real × Real) : Real := det2 v e / det2 d e + let coordB (d e : Real × Real) (v : Real × Real) : Real := det2 d v / det2 d e + ∀ (d : Real × Real), ∀ (e : Real × Real), ∀ (v : Real × Real), (det2 d e ≠ 0) → (coordB e d v + = coordA d e v) := by + classical + intro det2 coordA coordB d e v hD + have hED : det2 e d ≠ 0 := by + intro h + have hs : det2 e d = -det2 d e := by dsimp [det2]; ring + rw [hs] at h + exact hD (by linarith) + have hnum : det2 e v = -det2 v e := by dsimp [det2]; ring + have hden : det2 e d = -det2 d e := by dsimp [det2]; ring + dsimp [coordA, coordB] + rw [hnum, hden] + simp + +private theorem coordA_affine : + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 + let coordA (d e : Real × Real) (v : Real × Real) : Real := det2 v e / det2 d e + ∀ (d : Real × Real), ∀ (e : Real × Real), ∀ (v : Real × Real), ∀ (w : Real × Real), ∀ (u : + Real), coordA d e (v + u • (w-v)) = (1-u) * coordA d e v + u * coordA d e w := by + classical + intro det2 coordA d e v w u + simp [coordA, det2, smul_eq_mul]; ring + +private theorem coordB_affine : + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 + let coordB (d e : Real × Real) (v : Real × Real) : Real := det2 d v / det2 d e + ∀ (d : Real × Real), ∀ (e : Real × Real), ∀ (v : Real × Real), ∀ (w : Real × Real), ∀ (u : + Real), coordB d e (v + u • (w-v)) = (1-u) * coordB d e v + u * coordB d e w := by + classical + intro det2 coordB d e v w u + simp [coordB, det2, smul_eq_mul]; ring + +private theorem coordA_scale : + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 + let coordA (d e : Real × Real) (v : Real × Real) : Real := det2 v e / det2 d e + ∀ (d : Real × Real), ∀ (e : Real × Real), (det2 d e ≠ 0) → (∀ (t : Real), coordA d e (t • d) + = t) := by + classical + intro det2 coordA d e hD t + have hD' : d.1 * e.2 - d.2 * e.1 ≠ 0 := by simpa [det2] using hD + dsimp [coordA, det2, smul_eq_mul] + field_simp [hD'] + + +private theorem coordB_scale : + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 + let coordB (d e : Real × Real) (v : Real × Real) : Real := det2 d v / det2 d e + ∀ (d : Real × Real), ∀ (e : Real × Real), (det2 d e ≠ 0) → (∀ (t : Real), coordB d e (t • d) + = 0) := by + classical + intro det2 coordB d e hD t + dsimp [coordB, det2, smul_eq_mul] + rw [show d.1 * (t * d.2) - d.2 * (t * d.1) = 0 by ring] + simp + +private theorem ray_segment_axes : + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 + let coordA (d e : Real × Real) (v : Real × Real) : Real := det2 v e / det2 d e + let coordB (d e : Real × Real) (v : Real × Real) : Real := det2 d v / det2 d e + (∀ (d : Real × Real), ∀ (e : Real × Real), ∀ (v : Real × Real), (det2 d e ≠ 0) → (v = coordA + d e v • d + coordB d e v • e)) → ((∀ (d : Real × Real), ∀ (e : Real × Real), ∀ (v : Real + × Real), ∀ (w : Real × Real), ∀ (u : Real), coordA d e (v + u • (w-v)) = (1-u) * coordA d + e v + u * coordA d e w) → ((∀ (d : Real × Real), ∀ (e : Real × Real), ∀ (v : Real × + Real), ∀ (w : Real × Real), ∀ (u : Real), coordB d e (v + u • (w-v)) = (1-u) * coordB d e + v + u * coordB d e w) → ((∀ (d : Real × Real), ∀ (e : Real × Real), (det2 d e ≠ 0) → (∀ + (t : Real), coordA d e (t • d) = t)) → ((∀ (d : Real × Real), ∀ (e : Real × Real), (det2 + d e ≠ 0) → (∀ (t : Real), coordB d e (t • d) = 0)) → (∀ (x : Real × Real), ∀ (d : Real × + Real), ∀ (e : Real × Real), ∀ (v : Real × Real), ∀ (w : Real × Real), (det2 d e ≠ 0) → + ((∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real v w) ↔ + (∃ u : Real, 0 ≤ u ∧ u ≤ 1 ∧ + (1-u) * coordB d e (v-x) + u * coordB d e (w-x) = 0 ∧ + 0 < (1-u) * coordA d e (v-x) + u * coordA d e (w-x)))))))) := by + classical + intro det2 coordA coordB basis_coordinates coordA_affine coordB_affine coordA_scale + coordB_scale x d e v w hD + constructor + · rintro ⟨t, ht, hseg⟩ + rw [segment_eq_image'] at hseg + obtain ⟨u, hu, heq⟩ := hseg + refine ⟨u, hu.1, hu.2, ?_, ?_⟩ + · have hrel : t • d = (v-x) + u • ((w-x) - (v-x)) := by + calc + t • d = x + t • d - x := by simp + _ = (v + u • (w-v)) - x := by rw [← heq] + _ = (v-x) + u • ((w-x)-(v-x)) := by + apply Prod.ext <;> simp [smul_eq_mul] <;> ring + have hB := congrArg (coordB d e) hrel + rw [coordB_scale d e hD t] at hB + rw [coordB_affine] at hB + exact hB.symm + · have hrel : t • d = (v-x) + u • ((w-x) - (v-x)) := by + calc + t • d = x + t • d - x := by simp + _ = (v + u • (w-v)) - x := by rw [← heq] + _ = (v-x) + u • ((w-x)-(v-x)) := by + apply Prod.ext <;> simp [smul_eq_mul] <;> ring + have hA := congrArg (coordA d e) hrel + rw [coordA_scale d e hD t] at hA + rw [coordA_affine] at hA + exact hA.symm ▸ ht + · rintro ⟨u, hu0, hu1, hB, hA⟩ + let z := (v-x) + u • ((w-x) - (v-x)) + have hz := basis_coordinates d e z hD + have hzB : coordB d e z = 0 := by + dsimp [z] + rw [coordB_affine] + simpa using hB + have hzA : 0 < coordA d e z := by + dsimp [z] + rw [coordA_affine] + exact hA + have hz' : z = coordA d e z • d := by + rw [hzB] at hz + simpa using hz + have hrel : z = v + u • (w-v) - x := by + dsimp [z] + apply Prod.ext <;> simp [smul_eq_mul] <;> ring + have hpoint : x + coordA d e z • d = v + u • (w-v) := by + rw [← hz'] + calc + x + z = x + (v + u • (w-v) - x) := by rw [hrel] + _ = v + u • (w-v) := by ext <;> simp [smul_eq_mul] + refine ⟨coordA d e z, hzA, ?_⟩ + rw [segment_eq_image'] + exact ⟨u, ⟨hu0, hu1⟩, hpoint.symm⟩ + +private theorem cyclicSucc_eq_add : + let cyclicSucc (m : Nat) : Fin (m+1) ≃ Fin (m+1) := { + toFun := fun i => ⟨(i.val + 1) % (m+1), Nat.mod_lt _ (by omega)⟩ + invFun := fun i => ⟨(i.val + m) % (m+1), Nat.mod_lt _ (by omega)⟩ + left_inv := by + intro i + apply Fin.ext + change (((i.val + 1) % (m+1) + m) % (m+1)) = i.val + by_cases hi : i.val = m + · simp [hi] + · have him : i.val < m := by omega + have hinner : (i.val + 1) % (m+1) = i.val + 1 := Nat.mod_eq_of_lt (by omega) + rw [hinner] + have heq : i.val + 1 + m = (m+1) + i.val := by omega + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [Nat.mod_eq_of_lt i.isLt] + right_inv := by + intro i + apply Fin.ext + change (((i.val + m) % (m+1) + 1) % (m+1)) = i.val + by_cases hi : i.val = 0 + · simp [hi] + · have heq : i.val + m = (m+1) + (i.val-1) := by omega + have hmod : (i.val + m) % (m+1) = i.val - 1 := by + have hmodi : (i.val-1) % (m+1) = i.val-1 := Nat.mod_eq_of_lt (by omega) + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [hmodi] + rw [hmod] + have hlt : i.val - 1 + 1 < m+1 := by omega + rw [Nat.mod_eq_of_lt hlt] + omega + } + ∀ {m : Nat}, ∀ (i : Fin (m+1)), cyclicSucc m i = i + 1 := by + classical + intro cyclicSucc m i + apply Fin.ext + simp [cyclicSucc, Fin.val_add] + +private theorem transition_sum_even : + let cyclicSucc (m : Nat) : Fin (m+1) ≃ Fin (m+1) := { + toFun := fun i => ⟨(i.val + 1) % (m+1), Nat.mod_lt _ (by omega)⟩ + invFun := fun i => ⟨(i.val + m) % (m+1), Nat.mod_lt _ (by omega)⟩ + left_inv := by + intro i + apply Fin.ext + change (((i.val + 1) % (m+1) + m) % (m+1)) = i.val + by_cases hi : i.val = m + · simp [hi] + · have him : i.val < m := by omega + have hinner : (i.val + 1) % (m+1) = i.val + 1 := Nat.mod_eq_of_lt (by omega) + rw [hinner] + have heq : i.val + 1 + m = (m+1) + i.val := by omega + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [Nat.mod_eq_of_lt i.isLt] + right_inv := by + intro i + apply Fin.ext + change (((i.val + m) % (m+1) + 1) % (m+1)) = i.val + by_cases hi : i.val = 0 + · simp [hi] + · have heq : i.val + m = (m+1) + (i.val-1) := by omega + have hmod : (i.val + m) % (m+1) = i.val - 1 := by + have hmodi : (i.val-1) % (m+1) = i.val-1 := Nat.mod_eq_of_lt (by omega) + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [hmodi] + rw [hmod] + have hlt : i.val - 1 + 1 < m+1 := by omega + rw [Nat.mod_eq_of_lt hlt] + omega + } + ∀ {m : Nat}, ∀ (b : Fin (m+1) → Bool), (∑ i : Fin (m+1), (if b i = b (cyclicSucc m i) then (0 + : Int) else 1)) % 2 = 0 := by + classical + intro cyclicSucc m b + classical + let w : Fin (m+1) → Int := fun i => if b i then 1 else 0 + let u : Fin (m+1) → Int := fun i => if b i = false ∧ b (cyclicSucc m i) = true then 1 else 0 + have hlocal (i : Fin (m+1)) : + (if b i = b (cyclicSucc m i) then (0 : Int) else 1) = + w i - w (cyclicSucc m i) + 2 * u i := by + simp only [w, u] + cases b i <;> cases b (cyclicSucc m i) <;> norm_num + have hsum : (∑ i, w (cyclicSucc m i)) = ∑ i, w i := (cyclicSucc m).sum_comp w + have heven : ∃ k : Int, (∑ i, if b i = b (cyclicSucc m i) then (0 : Int) else 1) = 2*k := by + refine ⟨∑ i, u i, ?_⟩ + simp_rw [hlocal] + rw [Finset.sum_add_distrib, Finset.sum_sub_distrib, hsum, sub_self, + zero_add, Finset.mul_sum] + obtain ⟨k, hk⟩ := heven + omega + +private theorem cyclic_xor_count : + let cyclicSucc (m : Nat) : Fin (m+1) ≃ Fin (m+1) := { + toFun := fun i => ⟨(i.val + 1) % (m+1), Nat.mod_lt _ (by omega)⟩ + invFun := fun i => ⟨(i.val + m) % (m+1), Nat.mod_lt _ (by omega)⟩ + left_inv := by + intro i + apply Fin.ext + change (((i.val + 1) % (m+1) + m) % (m+1)) = i.val + by_cases hi : i.val = m + · simp [hi] + · have him : i.val < m := by omega + have hinner : (i.val + 1) % (m+1) = i.val + 1 := Nat.mod_eq_of_lt (by omega) + rw [hinner] + have heq : i.val + 1 + m = (m+1) + i.val := by omega + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [Nat.mod_eq_of_lt i.isLt] + right_inv := by + intro i + apply Fin.ext + change (((i.val + m) % (m+1) + 1) % (m+1)) = i.val + by_cases hi : i.val = 0 + · simp [hi] + · have heq : i.val + m = (m+1) + (i.val-1) := by omega + have hmod : (i.val + m) % (m+1) = i.val - 1 := by + have hmodi : (i.val-1) % (m+1) = i.val-1 := Nat.mod_eq_of_lt (by omega) + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [hmodi] + rw [hmod] + have hlt : i.val - 1 + 1 < m+1 := by omega + rw [Nat.mod_eq_of_lt hlt] + omega + } + ∀ {m : Nat}, ∀ (P : Fin (m+1) → Prop), ∀ (Q : Fin (m+1) → Prop), ∀ [DecidablePred P], ∀ + [DecidablePred Q], ∀ (b : Fin (m+1) → Bool), (∀ i, (P i ∧ ¬ Q i ∨ ¬ P i ∧ Q i) ↔ + b i ≠ b (cyclicSucc m i)) → ((Finset.univ.filter P).card % 2 = (Finset.univ.filter + Q).card % 2) := by + classical + intro cyclicSucc m P Q typeclassInstance0 typeclassInstance1 b hxor + classical + let tr : Fin (m+1) → Prop := fun i => b i ≠ b (cyclicSucc m i) + have hlocal (i : Fin (m+1)) : + (if P i then 1 else 0) + (if Q i then 1 else 0) = + (if tr i then 1 else 0) + 2 * (if P i ∧ Q i then 1 else 0) := by + by_cases hp : P i <;> by_cases hq : Q i + · have hnotx : ¬ (P i ∧ ¬ Q i ∨ ¬ P i ∧ Q i) := by simp [hp, hq] + have ht : ¬ tr i := by + intro htr + exact hnotx ((hxor i).mpr htr) + simp [hp, hq, tr, ht] + · have hx : P i ∧ ¬ Q i ∨ ¬ P i ∧ Q i := by simp [hp, hq] + have ht : tr i := (hxor i).mp hx + simp [hp, hq, tr, ht] + · have hx : P i ∧ ¬ Q i ∨ ¬ P i ∧ Q i := by simp [hp, hq] + have ht : tr i := (hxor i).mp hx + simp [hp, hq, tr, ht] + · have hnotx : ¬ (P i ∧ ¬ Q i ∨ ¬ P i ∧ Q i) := by simp [hp, hq] + have ht : ¬ tr i := by + intro htr + exact hnotx ((hxor i).mpr htr) + simp [hp, hq, tr, ht] + have hcounts : + (Finset.univ.filter P).card + (Finset.univ.filter Q).card = + (Finset.univ.filter tr).card + 2 * (Finset.univ.filter (fun i => P i ∧ Q i)).card := by + have hp : (Finset.univ.filter P).card = ∑ i : Fin (m+1), if P i then 1 else 0 := by + rw [Finset.card_filter] + have hq : (Finset.univ.filter Q).card = ∑ i : Fin (m+1), if Q i then 1 else 0 := by + rw [Finset.card_filter] + have ht : (Finset.univ.filter tr).card = ∑ i : Fin (m+1), if tr i then 1 else 0 := by + rw [Finset.card_filter] + have hu : (Finset.univ.filter (fun i => P i ∧ Q i)).card = + ∑ i : Fin (m+1), if P i ∧ Q i then 1 else 0 := by + rw [Finset.card_filter] + have hsum : + (∑ i : Fin (m+1), if P i then 1 else 0) + + (∑ i : Fin (m+1), if Q i then 1 else 0) = + (∑ i : Fin (m+1), if tr i then 1 else 0) + + 2 * (∑ i : Fin (m+1), if P i ∧ Q i then 1 else 0) := by + calc + _ = ∑ i : Fin (m+1), + ((if P i then 1 else 0) + (if Q i then 1 else 0)) := by + rw [Finset.sum_add_distrib] + _ = ∑ i : Fin (m+1), + ((if tr i then 1 else 0) + 2 * (if P i ∧ Q i then 1 else 0)) := by + exact Finset.sum_congr rfl (fun i _ => hlocal i) + _ = _ := by rw [Finset.sum_add_distrib, Finset.mul_sum] + rw [hp, hq, ht, hu] + exact hsum + have htrans : ∃ k : Nat, (Finset.univ.filter tr).card = 2*k := by + have heven : ∃ k : Int, + (∑ i : Fin (m+1), if b i = b (cyclicSucc m i) then (0 : Int) else 1) = 2*k := by + let w : Fin (m+1) → Int := fun i => if b i then 1 else 0 + let u : Fin (m+1) → Int := fun i => + if b i = false ∧ b (cyclicSucc m i) = true then 1 else 0 + have hlocal' (i : Fin (m+1)) : + (if b i = b (cyclicSucc m i) then (0 : Int) else 1) = + w i - w (cyclicSucc m i) + 2 * u i := by + simp only [w, u] + cases b i <;> cases b (cyclicSucc m i) <;> norm_num + have hcomp : (∑ i, w (cyclicSucc m i)) = ∑ i, w i := + (cyclicSucc m).sum_comp w + refine ⟨∑ i, u i, ?_⟩ + simp_rw [hlocal'] + rw [Finset.sum_add_distrib, Finset.sum_sub_distrib, hcomp, sub_self, + zero_add, Finset.mul_sum] + obtain ⟨k, hk⟩ := heven + have hcard : ((Finset.univ.filter tr).card : Int) = + ∑ i : Fin (m+1), if b i = b (cyclicSucc m i) then (0 : Int) else 1 := by + simp [tr, Finset.card_filter] + have hk' : ((Finset.univ.filter tr).card : Int) = 2*k := by + rw [hcard] + exact hk + have hk0 : 0 ≤ k := by + have hc : 0 ≤ ((Finset.univ.filter tr).card : Int) := Int.natCast_nonneg _ + omega + refine ⟨k.toNat, ?_⟩ + omega + obtain ⟨k, hk⟩ := htrans + omega + +private theorem ncard_filter : + ∀ {m : Nat}, ∀ (P : Fin (m+1) → Prop), ∀ [DecidablePred P], Set.ncard {i : Fin (m+1) | P i} = + (Finset.univ.filter P).card := by + classical + intro m P typeclassInstance0 + classical + rw [Set.ncard_eq_toFinset_card] + congr 1 + ext i + simp + +private theorem affine_root_between : + ∀ (a : Real), ∀ (c : Real), (a*c < 0) → (∃ u, 0 < u ∧ u < 1 ∧ (1-u)*a+u*c=0) := by + classical + intro a c hac + have ha : a ≠ 0 := by + intro h + rw [h, zero_mul] at hac + exact (lt_irrefl 0) hac + have hc : c ≠ 0 := by + intro h + rw [h, mul_zero] at hac + exact (lt_irrefl 0) hac + by_cases hap : 0 < a + · have hcn : c < 0 := by + by_contra hn + have hc0 : 0 ≤ c := le_of_not_gt hn + exact (not_lt_of_ge (mul_nonneg (le_of_lt hap) hc0)) hac + have hden : 0 < a-c := by linarith + refine ⟨a/(a-c), div_pos hap hden, ?_, ?_⟩ + · rw [div_lt_one hden] + linarith + · field_simp [ne_of_gt hden]; ring + · have han : a < 0 := lt_of_le_of_ne (le_of_not_gt hap) ha + have hcp : 0 < c := by + by_contra hn + have hc0 : c ≤ 0 := le_of_not_gt hn + exact (not_lt_of_ge (mul_nonneg_of_nonpos_of_nonpos (le_of_lt han) hc0)) hac + have hden : a-c < 0 := by linarith + have hpos : 0 < a/(a-c) := div_pos_of_neg_of_neg han hden + have hlt : a/(a-c) < 1 := by + have hden' : 0 < c-a := by linarith + have hgap : 0 < c/(c-a) := div_pos hcp hden' + have hEq : 1-a/(a-c) = c/(c-a) := by + have hden1 : c-a ≠ 0 := ne_of_gt hden' + field_simp [ne_of_lt hden, hden1]; ring + have : 0 < 1-a/(a-c) := by rw [hEq]; exact hgap + linarith + refine ⟨a/(a-c), hpos, hlt, ?_⟩ + field_simp [ne_of_lt hden]; ring + +private theorem axis_root_x_identity : + ∀ (a : Real), ∀ (b : Real), ∀ (c : Real), ∀ (d : Real), ∀ (u : Real), ((1-u)*b+u*d=0) → + ((d-b)*((1-u)*a+u*c)=a*d-b*c) := by + classical + intro a b c d u hy + linear_combination (c-a)*hy + +private theorem axis_root_y_identity : + ∀ (a : Real), ∀ (b : Real), ∀ (c : Real), ∀ (d : Real), ∀ (u : Real), ((1-u)*a+u*c=0) → + ((a-c)*((1-u)*b+u*d)=a*d-b*c) := by + classical + intro a b c d u hx + linear_combination (b-d)*hx + +private theorem affine_pos : + ∀ (a : Real), ∀ (c : Real), ∀ (u : Real), (0 ≤ u) → ((u ≤ 1) → ((0 < a) → ((0 < c) → (0 < + (1-u)*a+u*c)))) := by + classical + intro a c u hu0 hu1 ha hc + by_cases hu : u = 0 + · subst u + simpa using ha + · by_cases hu' : u = 1 + · subst u + simpa using hc + · have hlt : u < 1 := by + by_contra hn + exact hu' (le_antisymm hu1 (le_of_not_gt hn)) + have h1 : 0 < 1-u := by linarith + have h2 : 0 < u := lt_of_le_of_ne hu0 (Ne.symm hu) + exact add_pos (mul_pos h1 ha) (mul_pos h2 hc) + +private theorem affine_neg : + ∀ (a : Real), ∀ (c : Real), ∀ (u : Real), (0 ≤ u) → ((u ≤ 1) → ((a < 0) → ((c < 0) → + ((1-u)*a+u*c < 0)))) := by + classical + intro a c u hu0 hu1 ha hc + by_cases hu : u = 0 + · subst u + simpa using ha + · by_cases hu' : u = 1 + · subst u + simpa using hc + · have hlt : u < 1 := by + by_contra hn + exact hu' (le_antisymm hu1 (le_of_not_gt hn)) + have h1 : (1-u)*a < 0 := mul_neg_of_pos_of_neg (by linarith) ha + have h2 : u*c ≤ 0 := mul_nonpos_of_nonneg_of_nonpos hu0 (le_of_lt hc) + linarith + +private theorem root_positive_product : + ∀ (e : Real), ∀ (z : Real), ∀ (K : Real), (e ≠ 0) → ((e*z=K) → (0 < z ↔ 0 < K*e)) := by + classical + intro e z K he h + rw [← h, mul_right_comm e z e, + mul_pos_iff_of_pos_left (mul_self_pos.mpr he)] + +private theorem affine_axis_crossing_iff : + (∀ (a : Real), ∀ (c : Real), (a*c < 0) → (∃ u, 0 < u ∧ u < 1 ∧ (1-u)*a+u*c=0)) → ((∀ (a : + Real), ∀ (c : Real), ∀ (u : Real), (0 ≤ u) → ((u ≤ 1) → ((0 < a) → ((0 < c) → (0 < + (1-u)*a+u*c))))) → ((∀ (a : Real), ∀ (c : Real), ∀ (u : Real), (0 ≤ u) → ((u ≤ 1) → ((a < + 0) → ((c < 0) → ((1-u)*a+u*c < 0))))) → ((∀ (e : Real), ∀ (z : Real), ∀ (K : Real), (e ≠ + 0) → ((e*z=K) → (0 < z ↔ 0 < K*e))) → (∀ (a : Real), ∀ (b : Real), ∀ (c : Real), ∀ (d : + Real), (b ≠ 0) → ((d ≠ 0) → ((∃ u, 0 ≤ u ∧ u ≤ 1 ∧ (1-u)*b+u*d=0 ∧ 0<(1-u)*a+u*c) ↔ + b*d<0 ∧ 0<(a*d-b*c)*(d-b))))))) := by + classical + intro affine_root_between affine_pos affine_neg root_positive_product a b c d hb hd + constructor + · rintro ⟨u, hu0, hu1, hroot, hpos⟩ + have hbd : b*d<0 := by + by_contra hn + have hnonneg : 0≤b*d := le_of_not_gt hn + rcases mul_nonneg_iff.mp hnonneg with ⟨hb0,hd0⟩ | ⟨hb0,hd0⟩ + · have hbpos : 0 + rcases lt_or_gt_of_ne hb with hb | hb <;> + rcases lt_or_gt_of_ne hc with hc | hc <;> + rcases lt_or_gt_of_ne hd with hd | hd <;> + rcases lt_or_gt_of_ne hK with hK | hK + all_goals + try have hbd : b < d := by linarith + try have hdb : d < b := by linarith + try have hac : a < c := by linarith + try have hca : c < a := by linarith + simp only [mul_pos_iff, mul_neg_iff, sub_pos, sub_neg] + first + | solve | simp_all only [not_lt_of_gt, and_true, and_false, true_and, false_and, + or_true, or_false, false_or, iff_self, iff_false, + iff_true, not_true_eq_false] + | simp_all only [not_lt_of_gt, and_true, and_false, true_and, false_and, + or_true, or_false, false_or, iff_self, iff_false, + iff_true, not_true_eq_false] + nlinarith + +private theorem cone_crossing_accounting_collinear : + ∀ (a : Real), ∀ (b : Real), ∀ (c : Real), ∀ (d : Real), (0 < a*c) → ((0 < b*d) → ((((0 ⟨(i.val + 1) % (m+1), Nat.mod_lt _ (by omega)⟩ + invFun := fun i => ⟨(i.val + m) % (m+1), Nat.mod_lt _ (by omega)⟩ + left_inv := by + intro i + apply Fin.ext + change (((i.val + 1) % (m+1) + m) % (m+1)) = i.val + by_cases hi : i.val = m + · simp [hi] + · have him : i.val < m := by omega + have hinner : (i.val + 1) % (m+1) = i.val + 1 := Nat.mod_eq_of_lt (by omega) + rw [hinner] + have heq : i.val + 1 + m = (m+1) + i.val := by omega + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [Nat.mod_eq_of_lt i.isLt] + right_inv := by + intro i + apply Fin.ext + change (((i.val + m) % (m+1) + 1) % (m+1)) = i.val + by_cases hi : i.val = 0 + · simp [hi] + · have heq : i.val + m = (m+1) + (i.val-1) := by omega + have hmod : (i.val + m) % (m+1) = i.val - 1 := by + have hmodi : (i.val-1) % (m+1) = i.val-1 := Nat.mod_eq_of_lt (by omega) + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [hmodi] + rw [hmod] + have hlt : i.val - 1 + 1 < m+1 := by omega + rw [Nat.mod_eq_of_lt hlt] + omega + } + (∀ {m : Nat}, ∀ (P : Fin (m+1) → Prop), ∀ (Q : Fin (m+1) → Prop), ∀ [DecidablePred P], ∀ + [DecidablePred Q], ∀ (b : Fin (m+1) → Bool), (∀ i, (P i ∧ ¬ Q i ∨ ¬ P i ∧ Q i) ↔ b i ≠ b + (cyclicSucc m i)) → ((Finset.univ.filter P).card % 2 = (Finset.univ.filter Q).card % 2)) + → ((∀ (a : Real), ∀ (c : Real), (a*c < 0) → (∃ u, 0 < u ∧ u < 1 ∧ (1-u)*a+u*c=0)) → ((∀ + (a : Real), ∀ (b : Real), ∀ (c : Real), ∀ (d : Real), ∀ (u : Real), ((1-u)*b+u*d=0) → + ((d-b)*((1-u)*a+u*c)=a*d-b*c)) → ((∀ (a : Real), ∀ (b : Real), ∀ (c : Real), ∀ (d : + Real), ∀ (u : Real), ((1-u)*a+u*c=0) → ((a-c)*((1-u)*b+u*d)=a*d-b*c)) → ((∀ (a : Real), ∀ + (b : Real), ∀ (c : Real), ∀ (d : Real), ∀ (K : Real), (a ≠ 0) → ((b ≠ 0) → ((c ≠ 0) → ((d + ≠ 0) → ((K ≠ 0) → ((K = a*d-b*c) → ((((0 + B i * B (cyclicSucc m i) < 0 ∧ + 0 < (A i * B (cyclicSucc m i) - B i * A (cyclicSucc m i)) * + (B (cyclicSucc m i) - B i))).card % 2 = + (Finset.univ.filter (fun i => + A i * A (cyclicSucc m i) < 0 ∧ + 0 < (A i * B (cyclicSucc m i) - B i * A (cyclicSucc m i)) * + (A i - A (cyclicSucc m i)))).card % 2))))))))) := by + classical + intro cyclicSucc cyclic_xor_count affine_root_between axis_root_x_identity axis_root_y_identity + cone_crossing_accounting cone_crossing_accounting_collinear m A B hA hB hno + classical + let K : Fin (m+1) → Real := fun i => + A i * B (cyclicSucc m i) - B i * A (cyclicSucc m i) + let X : Fin (m+1) → Prop := fun i => + B i * B (cyclicSucc m i) < 0 ∧ 0 < K i * (B (cyclicSucc m i)-B i) + let Y : Fin (m+1) → Prop := fun i => + A i * A (cyclicSucc m i) < 0 ∧ 0 < K i * (A i-A (cyclicSucc m i)) + let L : Fin (m+1) → Prop := fun i => 0 < A i ∧ 0 < B i + let label : Fin (m+1) → Bool := fun i => decide (L i) + have hxor : ∀ i, (X i ∧ ¬Y i ∨ ¬X i ∧ Y i) ↔ + label i ≠ label (cyclicSucc m i) := by + intro i + have hsameA (hK0 : K i = 0) : 0 < A i * A (cyclicSucc m i) := by + have hne : A i * A (cyclicSucc m i) ≠ 0 := mul_ne_zero (hA i) (hA _) + rcases lt_or_gt_of_ne hne with hneg | hpos + · obtain ⟨u, hu0, hu1, hroot⟩ := affine_root_between (A i) + (A (cyclicSucc m i)) hneg + have hden : A i - A (cyclicSucc m i) ≠ 0 := by + intro heq + have hEq : A i = A (cyclicSucc m i) := sub_eq_zero.mp heq + rw [hEq] at hneg + nlinarith [sq_nonneg (A i)] + have hBroot : (1-u)*B i + u*B (cyclicSucc m i) = 0 := by + have hid := axis_root_y_identity (A i) (B i) + (A (cyclicSucc m i)) (B (cyclicSucc m i)) u hroot + dsimp [K] at hK0 + have : (A i-A (cyclicSucc m i)) * + ((1-u)*B i+u*B (cyclicSucc m i)) = 0 := by + nlinarith [hid, hK0] + rcases mul_eq_zero.mp this with he | hr + · exact (hden he).elim + · exact hr + exact False.elim (hno i u ⟨le_of_lt hu0, le_of_lt hu1⟩ hroot hBroot) + · exact hpos + have hsameB (hK0 : K i = 0) : 0 < B i * B (cyclicSucc m i) := by + have hne : B i * B (cyclicSucc m i) ≠ 0 := mul_ne_zero (hB i) (hB _) + rcases lt_or_gt_of_ne hne with hneg | hpos + · obtain ⟨u, hu0, hu1, hroot⟩ := affine_root_between (B i) + (B (cyclicSucc m i)) hneg + have hden : B (cyclicSucc m i) - B i ≠ 0 := by + intro heq + have hEq : B (cyclicSucc m i) = B i := sub_eq_zero.mp heq + rw [hEq] at hneg + nlinarith [sq_nonneg (B i)] + have hAroot : (1-u)*A i + u*A (cyclicSucc m i) = 0 := by + have hid := axis_root_x_identity (A i) (B i) + (A (cyclicSucc m i)) (B (cyclicSucc m i)) u hroot + dsimp [K] at hK0 + have : (B (cyclicSucc m i)-B i) * + ((1-u)*A i+u*A (cyclicSucc m i)) = 0 := by + nlinarith [hid, hK0] + rcases mul_eq_zero.mp this with he | hr + · exact (hden he).elim + · exact hr + exact False.elim (hno i u ⟨le_of_lt hu0, le_of_lt hu1⟩ hAroot hroot) + · exact hpos + have hcone : + (L i ↔ L (cyclicSucc m i)) ↔ (X i ↔ Y i) := by + by_cases hK : K i = 0 + · simpa [L, X, Y, K, hK] using + cone_crossing_accounting_collinear (A i) (B i) + (A (cyclicSucc m i)) (B (cyclicSucc m i)) (hsameA hK) (hsameB hK) + · exact cone_crossing_accounting (A i) (B i) + (A (cyclicSucc m i)) (B (cyclicSucc m i)) (K i) + (hA i) (hB i) (hA _) (hB _) hK (by rfl) + have hlabels : (label i ≠ label (cyclicSucc m i)) ↔ + ¬ (L i ↔ L (cyclicSucc m i)) := by + by_cases h1 : L i <;> by_cases h2 : L (cyclicSucc m i) <;> + simp [label, h1, h2] + have hxor' : (X i ∧ ¬Y i ∨ ¬X i ∧ Y i) ↔ ¬(X i ↔ Y i) := by + by_cases hx : X i <;> by_cases hy : Y i <;> simp [hx, hy] + exact hxor'.trans ((not_congr hcone.symm).trans hlabels.symm) + exact cyclic_xor_count X Y label hxor + +private theorem coordinate_hit_d : + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 + let coordA (d e : Real × Real) (v : Real × Real) : Real := det2 v e / det2 d e + let coordB (d e : Real × Real) (v : Real × Real) : Real := det2 d v / det2 d e + (∀ (x : Real × Real), ∀ (d : Real × Real), ∀ (e : Real × Real), ∀ (v : Real × Real), ∀ (w : + Real × Real), (det2 d e ≠ 0) → ((∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real v w) ↔ (∃ u + : Real, 0 ≤ u ∧ u ≤ 1 ∧ (1-u) * coordB d e (v-x) + u * coordB d e (w-x) = 0 ∧ 0 < (1-u) * + coordA d e (v-x) + u * coordA d e (w-x)))) → ((∀ (a : Real), ∀ (b : Real), ∀ (c : Real), + ∀ (d : Real), (b ≠ 0) → ((d ≠ 0) → ((∃ u, 0 ≤ u ∧ u ≤ 1 ∧ (1-u)*b+u*d=0 ∧ 0<(1-u)*a+u*c) + ↔ b*d<0 ∧ 0<(a*d-b*c)*(d-b)))) → (∀ (x : Real × Real), ∀ (d : Real × Real), ∀ (e : Real × + Real), ∀ (v : Real × Real), ∀ (w : Real × Real), (det2 d e ≠ 0) → ((coordB d e (v-x) ≠ 0) + → ((coordB d e (w-x) ≠ 0) → ((∃ t : Real, 0 ⟨(i.val + 1) % (m+1), Nat.mod_lt _ (by omega)⟩ + invFun := fun i => ⟨(i.val + m) % (m+1), Nat.mod_lt _ (by omega)⟩ + left_inv := by + intro i + apply Fin.ext + change (((i.val + 1) % (m+1) + m) % (m+1)) = i.val + by_cases hi : i.val = m + · simp [hi] + · have him : i.val < m := by omega + have hinner : (i.val + 1) % (m+1) = i.val + 1 := Nat.mod_eq_of_lt (by omega) + rw [hinner] + have heq : i.val + 1 + m = (m+1) + i.val := by omega + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [Nat.mod_eq_of_lt i.isLt] + right_inv := by + intro i + apply Fin.ext + change (((i.val + m) % (m+1) + 1) % (m+1)) = i.val + by_cases hi : i.val = 0 + · simp [hi] + · have heq : i.val + m = (m+1) + (i.val-1) := by omega + have hmod : (i.val + m) % (m+1) = i.val - 1 := by + have hmodi : (i.val-1) % (m+1) = i.val-1 := Nat.mod_eq_of_lt (by omega) + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [hmodi] + rw [hmod] + have hlt : i.val - 1 + 1 < m+1 := by omega + rw [Nat.mod_eq_of_lt hlt] + omega + } + (∀ {m : Nat}, ∀ (A : Fin (m+1) → Real), ∀ (B : Fin (m+1) → Real), (∀ i, A i ≠ 0) → ((∀ i, B i + ≠ 0) → ((∀ i u, u ∈ Set.Icc (0:Real) 1 → (1-u)*A i + u*A (cyclicSucc m i) = 0 → (1-u)*B i + + u*B (cyclicSucc m i) = 0 → False) → ((Finset.univ.filter (fun i => B i * B (cyclicSucc + m i) < 0 ∧ 0 < (A i * B (cyclicSucc m i) - B i * A (cyclicSucc m i)) * (B (cyclicSucc m + i) - B i))).card % 2 = (Finset.univ.filter (fun i => A i * A (cyclicSucc m i) < 0 ∧ 0 < + (A i * B (cyclicSucc m i) - B i * A (cyclicSucc m i)) * (A i - A (cyclicSucc m i)))).card + % 2)))) → ((∀ (x : Real × Real), ∀ (d : Real × Real), ∀ (e : Real × Real), ∀ (v : Real × + Real), ∀ (w : Real × Real), (det2 d e ≠ 0) → ((coordB d e (v-x) ≠ 0) → ((coordB d e (w-x) + ≠ 0) → ((∃ t : Real, 0 coordA d e (v i-x) + let B : Fin (m+1) → Real := fun i => coordB d e (v i-x) + have hA : ∀ i, A i ≠ 0 := by + intro i + apply div_ne_zero + · have hswap : det2 (v i-x) e = -det2 e (v i-x) := by dsimp [det2]; ring + rw [hswap] + exact neg_ne_zero.mpr (hev i) + · exact hD + have hB : ∀ i, B i ≠ 0 := by + intro i + exact div_ne_zero (hdv i) hD + have hno : ∀ i u, u ∈ Set.Icc (0:Real) 1 → + (1-u)*A i+u*A (cyclicSucc m i)=0 → + (1-u)*B i+u*B (cyclicSucc m i)=0 → False := by + intro i u hu ha hb + let z := (v i-x)+u • ((v (cyclicSucc m i)-x)-(v i-x)) + have hzA : coordA d e z = 0 := by + dsimp [z, A] at ha ⊢ + rw [coordA_affine] + exact ha + have hzB : coordB d e z = 0 := by + dsimp [z, B] at hb ⊢ + rw [coordB_affine] + exact hb + have hz : z = 0 := by + rw [basis_coordinates d e z hD] + simp [hzA, hzB] + have hsum : x+z = v i+u • (v (cyclicSucc m i)-v i) := by + dsimp [z] + module + rw [hz] at hsum + have hmem : x ∈ segment Real (v i) (v (cyclicSucc m i)) := by + rw [segment_eq_image'] + exact ⟨u, hu, by simpa using hsum.symm⟩ + exact hx i hmem + have haxes := axis_parity_from_no_origin A B hA hB hno + let PX : Fin (m+1) → Prop := fun i => + ∃ t : Real, 0 + ∃ t : Real, 0 + B i*B (cyclicSucc m i)<0 ∧ + 0<(A i*B (cyclicSucc m i)-B i*A (cyclicSucc m i))*(B (cyclicSucc m i)-B i) + let Y : Fin (m+1) → Prop := fun i => + A i*A (cyclicSucc m i)<0 ∧ + 0<(A i*B (cyclicSucc m i)-B i*A (cyclicSucc m i))*(A i-A (cyclicSucc m i)) + have hPX : ∀ i, PX i ↔ X i := by + intro i + exact coordinate_hit_d x d e (v i) (v (cyclicSucc m i)) hD (hB i) (hB _) + have hPY : ∀ i, PY i ↔ Y i := by + intro i + exact coordinate_hit_e x d e (v i) (v (cyclicSucc m i)) hD (hA i) (hA _) + have hsetX : {i : Fin (m+1) | PX i} = {i | X i} := by + ext i + exact hPX i + have hsetY : {i : Fin (m+1) | PY i} = {i | Y i} := by + ext i + exact hPY i + have hnX : Set.ncard {i : Fin (m+1) | PX i} = (Finset.univ.filter X).card := by + rw [hsetX, Set.ncard_eq_toFinset_card] + congr 1 + ext i + simp + have hnY : Set.ncard {i : Fin (m+1) | PY i} = (Finset.univ.filter Y).card := by + rw [hsetY, Set.ncard_eq_toFinset_card] + congr 1 + ext i + simp + rw [hnX, hnY] + simpa [X, Y, A, B] using haxes + +private theorem choose_common_generic : + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 + ∀ {n : Nat}, ∀ (p : P3381T1PolygonBoundary n), ∀ (x : Real × Real), ∀ (d : Real × Real), ∀ + (e : Real × Real), (x ∉ P3544T1BoundaryCarrier p) → ((d ≠ 0) → ((e ≠ 0) → (∃ f : Real × + Real, + (∀ i, det2 f (p.vertex i-x) ≠ 0) ∧ + (∀ i, det2 f (p.vertex (i+1)-p.vertex i) ≠ 0) ∧ + det2 f d ≠ 0 ∧ det2 f e ≠ 0))) := by + classical + intro det2 n p x d e hx hd he + classical + have hvertices : ∀ i, p.vertex i ≠ x := by + intro i hiv + have hv : p.vertex i ∈ ⋃ j, segment Real (p.vertex j) (p.vertex (j+1)) := + Set.mem_iUnion.mpr ⟨i, left_mem_segment Real _ _⟩ + exact hx (hiv ▸ hv) + obtain ⟨g, hgV, hgE⟩ := (P3597T1GenericRayStability p).1 x hvertices + have hgn : g ≠ 0 := by + intro hzero + have hh := hgV 0 + rw [hzero] at hh + exact hh (by simp []) + let k : Real × Real := (-g.2, g.1) + have hGk : det2 g k ≠ 0 := by + intro hzero + have hpos : 0 < g.1^2+g.2^2 := by + have hcoord : g.1 ≠ 0 ∨ g.2 ≠ 0 := by + by_contra h + push Not at h + apply hgn + exact Prod.ext h.1 h.2 + rcases hcoord with hcoord | hcoord + · exact add_pos_of_pos_of_nonneg (sq_pos_of_ne_zero hcoord) (sq_nonneg _) + · exact add_pos_of_nonneg_of_pos (sq_nonneg _) (sq_pos_of_ne_zero hcoord) + have hh : det2 g k = g.1^2+g.2^2 := by dsimp [det2, k]; ring + rw [hh] at hzero + linarith + have hIndependent (z : Real × Real) (h1 : det2 g z = 0) + (h2 : det2 k z = 0) : z=0 := by + have hpos : 0 < g.1^2+g.2^2 := by + have hcoord : g.1 ≠ 0 ∨ g.2 ≠ 0 := by + by_contra h + push Not at h + apply hgn + exact Prod.ext h.1 h.2 + rcases hcoord with hcoord | hcoord + · exact add_pos_of_pos_of_nonneg (sq_pos_of_ne_zero hcoord) (sq_nonneg _) + · exact add_pos_of_nonneg_of_pos (sq_nonneg _) (sq_pos_of_ne_zero hcoord) + have hposne : g.1^2+g.2^2 ≠ 0 := ne_of_gt hpos + have hz1 : (g.1^2+g.2^2)*z.1=0 := by + dsimp [det2, k] at h1 h2 ⊢ + linear_combination -g.2 * h1 - g.1 * h2 + have hz2 : (g.1^2+g.2^2)*z.2=0 := by + dsimp [det2, k] at h1 h2 ⊢ + linear_combination g.1 * h1 - g.2 * h2 + have hz1' : z.1=0 := (mul_eq_zero.mp hz1).resolve_left hposne + have hz2' : z.2=0 := (mul_eq_zero.mp hz2).resolve_left hposne + exact Prod.ext hz1' hz2' + let W : Fin (n+3) × Bool → Real × Real := fun j => + if j.2 then p.vertex j.1-x else p.vertex (j.1+1)-p.vertex j.1 + have hbase : ∀ j, det2 g (W j) ≠ 0 := by + intro j + cases j with + | mk i b => + cases b with + | false => simpa [W, det2] using hgE i + | true => simpa [W, det2] using hgV i + let bad : (Real × Real) → Real := fun w => + if det2 k w = 0 then 0 else -det2 g w / det2 k w + let S : Finset Real := Finset.univ.image (fun j => bad (W j)) + let S' : Finset Real := insert (bad d) (insert (bad e) S) + have hcard : S'.card < ENat.card Real := by + rw [ENat.card_eq_top_of_infinite] + exact ENat.natCast_lt_top _ + obtain ⟨s, hs⟩ := Finset.exists_notMem_of_card_lt_enatCard hcard + let f : Real × Real := g+s • k + have avoid (w : Real × Real) (hcoef : det2 k w=0 → det2 g w ≠0) + (hmem : bad w∈S') : det2 f w ≠0 := by + intro hz + have hlin : det2 g w+s*det2 k w=0 := by + have heq : det2 (g+s • k) w = det2 g w+s*det2 k w := by + dsimp [det2, smul_eq_mul]; ring + dsimp [f] at hz + rw [heq] at hz + exact hz + by_cases hc : det2 k w=0 + · exact hcoef hc (by simpa [hc] using hlin) + · have hs' : s= -det2 g w/det2 k w := by + apply (eq_div_iff hc).2 + nlinarith [hlin] + have hsb : s=bad w := by simpa [bad, hc] using hs' + have hmem' : s∈S' := by rw [hsb]; exact hmem + exact hs hmem' + have hfv : ∀ i, det2 f (p.vertex i-x) ≠ 0 := by + intro i + apply avoid + · intro _ + simpa [W, det2] using hbase (i,true) + · have hm : bad (W (i,true))∈S := + Finset.mem_image.mpr ⟨(i,true), Finset.mem_univ _, rfl⟩ + exact Finset.mem_insert_of_mem (Finset.mem_insert_of_mem (by simpa [W] using hm)) + have hfe : ∀ i, det2 f (p.vertex (i+1)-p.vertex i) ≠ 0 := by + intro i + apply avoid + · intro _ + simpa [W, det2] using hbase (i,false) + · have hm : bad (W (i,false))∈S := + Finset.mem_image.mpr ⟨(i,false), Finset.mem_univ _, rfl⟩ + exact Finset.mem_insert_of_mem (Finset.mem_insert_of_mem (by simpa [W] using hm)) + have hfd : det2 f d ≠ 0 := by + apply avoid + · intro hc hg + exact hd (hIndependent d hg hc) + · simp [S'] + have hfe' : det2 f e ≠ 0 := by + apply avoid + · intro hc hg + exact he (hIndependent e hg hc) + · simp [S'] + exact ⟨f, hfv, hfe, hfd, hfe'⟩ + +private theorem hcyc : + ∀ (n : Nat), + let cyclicSucc (m : Nat) : Fin (m+1) ≃ Fin (m+1) := { + toFun := fun i => ⟨(i.val + 1) % (m+1), Nat.mod_lt _ (by omega)⟩ + invFun := fun i => ⟨(i.val + m) % (m+1), Nat.mod_lt _ (by omega)⟩ + left_inv := by + intro i + apply Fin.ext + change (((i.val + 1) % (m+1) + m) % (m+1)) = i.val + by_cases hi : i.val = m + · simp [hi] + · have him : i.val < m := by omega + have hinner : (i.val + 1) % (m+1) = i.val + 1 := Nat.mod_eq_of_lt (by omega) + rw [hinner] + have heq : i.val + 1 + m = (m+1) + i.val := by omega + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [Nat.mod_eq_of_lt i.isLt] + right_inv := by + intro i + apply Fin.ext + change (((i.val + m) % (m+1) + 1) % (m+1)) = i.val + by_cases hi : i.val = 0 + · simp [hi] + · have heq : i.val + m = (m+1) + (i.val-1) := by omega + have hmod : (i.val + m) % (m+1) = i.val - 1 := by + have hmodi : (i.val-1) % (m+1) = i.val-1 := Nat.mod_eq_of_lt (by omega) + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [hmodi] + rw [hmod] + have hlt : i.val - 1 + 1 < m+1 := by omega + rw [Nat.mod_eq_of_lt hlt] + omega + } + (∀ {m : Nat}, ∀ (i : Fin (m+1)), cyclicSucc m i = i + 1) → ( + let m := n+2 + ∀ (i : Fin (m+1)), cyclicSucc m i = i+1) := by + classical + intro n cyclicSucc cyclicSucc_eq_add m i + simpa [m] using cyclicSucc_eq_add i + +private theorem hxseg : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (x : Real × Real), (x ∉ + P3544T1BoundaryCarrier p) → ( + let cyclicSucc (m : Nat) : Fin (m+1) ≃ Fin (m+1) := { + toFun := fun i => ⟨(i.val + 1) % (m+1), Nat.mod_lt _ (by omega)⟩ + invFun := fun i => ⟨(i.val + m) % (m+1), Nat.mod_lt _ (by omega)⟩ + left_inv := by + intro i + apply Fin.ext + change (((i.val + 1) % (m+1) + m) % (m+1)) = i.val + by_cases hi : i.val = m + · simp [hi] + · have him : i.val < m := by omega + have hinner : (i.val + 1) % (m+1) = i.val + 1 := Nat.mod_eq_of_lt (by omega) + rw [hinner] + have heq : i.val + 1 + m = (m+1) + i.val := by omega + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [Nat.mod_eq_of_lt i.isLt] + right_inv := by + intro i + apply Fin.ext + change (((i.val + m) % (m+1) + 1) % (m+1)) = i.val + by_cases hi : i.val = 0 + · simp [hi] + · have heq : i.val + m = (m+1) + (i.val-1) := by omega + have hmod : (i.val + m) % (m+1) = i.val - 1 := by + have hmodi : (i.val-1) % (m+1) = i.val-1 := Nat.mod_eq_of_lt (by omega) + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [hmodi] + rw [hmod] + have hlt : i.val - 1 + 1 < m+1 := by omega + rw [Nat.mod_eq_of_lt hlt] + omega + } + let m := n+2 + let v : Fin (m+1) → Real × Real := p.vertex + (∀ (i : Fin (m+1)), cyclicSucc m i = i+1) → (∀ i, x ∉ segment Real (v i) (v (cyclicSucc m + i)))) := by + classical + intro n p x hx cyclicSucc m v hcyc i hi + apply hx + change x ∈ ⋃ j, segment Real (p.vertex j) (p.vertex (j+1)) + exact Set.mem_iUnion.mpr ⟨i, by simpa [v, hcyc] using hi⟩ + +private theorem hdv0 : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (x : Real × Real), ∀ (d : Real × Real), (∀ + i, d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ 0) → ( + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 + let m := n+2 + let v : Fin (m+1) → Real × Real := p.vertex + ∀ i, det2 d (v i-x) ≠ 0) := by + classical + intro n p x d hdv det2 m v i + simpa [det2, v] using hdv i + +private theorem hdv'0 : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (x : Real × Real), ∀ (d' : Real × Real), + (∀ i, d'.1 * (p.vertex i - x).2 - d'.2 * (p.vertex i - x).1 ≠ 0) → ( + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 + let m := n+2 + let v : Fin (m+1) → Real × Real := p.vertex + ∀ i, det2 d' (v i-x) ≠ 0) := by + classical + intro n p x d' hdv' det2 m v i + simpa [det2, v] using hdv' i + +private theorem hdn : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (x : Real × Real), ∀ (d : Real × Real), + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 + let m := n+2 + let v : Fin (m+1) → Real × Real := p.vertex + (∀ i, det2 d (v i-x) ≠ 0) → (d ≠ 0) := by + classical + intro n p x d det2 m v hdv0 hz + have h := hdv0 0 + rw [hz] at h + exact h (by simp [det2]) + +private theorem hd'n : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (x : Real × Real), ∀ (d' : Real × Real), + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 + let m := n+2 + let v : Fin (m+1) → Real × Real := p.vertex + (∀ i, det2 d' (v i-x) ≠ 0) → (d' ≠ 0) := by + classical + intro n p x d' det2 m v hdv'0 hz + have h := hdv'0 0 + rw [hz] at h + exact h (by simp [det2]) + +end DirectionParityLemmas + +theorem P3597T1DirectionParity {n : Nat} (p : P3381T1PolygonBoundary n) + (x d d' : Real × Real) (hx : x ∉ P3544T1BoundaryCarrier p) + (hdv : ∀ i, d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ 0) + (hdv' : ∀ i, d'.1 * (p.vertex i - x).2 - d'.2 * (p.vertex i - x).1 ≠ 0) + : + Set.ncard {i : Fin (n + 3) | ∃ t : Real, 0 < t ∧ + x + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1))} % 2 = + Set.ncard {i : Fin (n + 3) | ∃ t : Real, 0 < t ∧ + x + t • d' ∈ segment Real (p.vertex i) (p.vertex (i + 1))} % 2 := by +-- BODY + classical + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 + let coordA (d e : Real × Real) (v : Real × Real) : Real := det2 v e / det2 d e + let coordB (d e : Real × Real) (v : Real × Real) : Real := det2 d v / det2 d e + let basis_coordinates (d e v : Real × Real) (hD : det2 d e ≠ 0) : + v = coordA d e v • d + coordB d e v • e := DirectionParityLemmas.basis_coordinates d e v hD + let coordA_swap (d e v : Real × Real) (hD : det2 d e ≠ 0) : + coordA e d v = coordB d e v := DirectionParityLemmas.coordA_swap d e v hD + let coordB_swap (d e v : Real × Real) (hD : det2 d e ≠ 0) : + coordB e d v = coordA d e v := DirectionParityLemmas.coordB_swap d e v hD + let coordA_affine (d e v w : Real × Real) (u : Real) : + coordA d e (v + u • (w-v)) = (1-u) * coordA d e v + u * coordA d e w := + DirectionParityLemmas.coordA_affine d e v w u + let coordB_affine (d e v w : Real × Real) (u : Real) : + coordB d e (v + u • (w-v)) = (1-u) * coordB d e v + u * coordB d e w := + DirectionParityLemmas.coordB_affine d e v w u + let coordA_scale (d e : Real × Real) (hD : det2 d e ≠ 0) (t : Real) : + coordA d e (t • d) = t := DirectionParityLemmas.coordA_scale d e hD t + let coordB_scale (d e : Real × Real) (hD : det2 d e ≠ 0) (t : Real) : + coordB d e (t • d) = 0 := DirectionParityLemmas.coordB_scale d e hD t + let ray_segment_axes (x d e v w : Real × Real) (hD : det2 d e ≠ 0) : + (∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real v w) ↔ + (∃ u : Real, 0 ≤ u ∧ u ≤ 1 ∧ + (1-u) * coordB d e (v-x) + u * coordB d e (w-x) = 0 ∧ + 0 < (1-u) * coordA d e (v-x) + u * coordA d e (w-x)) := + DirectionParityLemmas.ray_segment_axes basis_coordinates coordA_affine coordB_affine + coordA_scale coordB_scale x d e v w hD + let cyclicSucc (m : Nat) : Fin (m+1) ≃ Fin (m+1) := { + toFun := fun i => ⟨(i.val + 1) % (m+1), Nat.mod_lt _ (by omega)⟩ + invFun := fun i => ⟨(i.val + m) % (m+1), Nat.mod_lt _ (by omega)⟩ + left_inv := by + intro i + apply Fin.ext + change (((i.val + 1) % (m+1) + m) % (m+1)) = i.val + by_cases hi : i.val = m + · simp [hi] + · have him : i.val < m := by omega + have hinner : (i.val + 1) % (m+1) = i.val + 1 := Nat.mod_eq_of_lt (by omega) + rw [hinner] + have heq : i.val + 1 + m = (m+1) + i.val := by omega + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [Nat.mod_eq_of_lt i.isLt] + right_inv := by + intro i + apply Fin.ext + change (((i.val + m) % (m+1) + 1) % (m+1)) = i.val + by_cases hi : i.val = 0 + · simp [hi] + · have heq : i.val + m = (m+1) + (i.val-1) := by omega + have hmod : (i.val + m) % (m+1) = i.val - 1 := by + have hmodi : (i.val-1) % (m+1) = i.val-1 := Nat.mod_eq_of_lt (by omega) + rw [heq, Nat.add_mod, Nat.mod_self, zero_add] + simp [hmodi] + rw [hmod] + have hlt : i.val - 1 + 1 < m+1 := by omega + rw [Nat.mod_eq_of_lt hlt] + omega + } + let cyclicSucc_eq_add {m : Nat} (i : Fin (m+1)) : cyclicSucc m i = i + 1 := + DirectionParityLemmas.cyclicSucc_eq_add (m := m) i + let transition_sum_even {m : Nat} (b : Fin (m+1) → Bool) : + (∑ i : Fin (m+1), (if b i = b (cyclicSucc m i) then (0 : Int) else 1)) % 2 = 0 := + DirectionParityLemmas.transition_sum_even (m := m) b + let cyclic_xor_count {m : Nat} (P Q : Fin (m+1) → Prop) + [DecidablePred P] [DecidablePred Q] (b : Fin (m+1) → Bool) + (hxor : ∀ i, (P i ∧ ¬ Q i ∨ ¬ P i ∧ Q i) ↔ + b i ≠ b (cyclicSucc m i)) : + (Finset.univ.filter P).card % 2 = (Finset.univ.filter Q).card % 2 := + DirectionParityLemmas.cyclic_xor_count (m := m) P Q b hxor + let ncard_filter {m : Nat} (P : Fin (m+1) → Prop) [DecidablePred P] : + Set.ncard {i : Fin (m+1) | P i} = (Finset.univ.filter P).card := + DirectionParityLemmas.ncard_filter (m := m) P + let affine_root_between (a c : Real) (hac : a*c < 0) : + ∃ u, 0 < u ∧ u < 1 ∧ (1-u)*a+u*c=0 := DirectionParityLemmas.affine_root_between a c hac + let axis_root_x_identity (a b c d u : Real) + (hy : (1-u)*b+u*d=0) : + (d-b)*((1-u)*a+u*c)=a*d-b*c := DirectionParityLemmas.axis_root_x_identity a b c d u hy + let axis_root_y_identity (a b c d u : Real) + (hx : (1-u)*a+u*c=0) : + (a-c)*((1-u)*b+u*d)=a*d-b*c := DirectionParityLemmas.axis_root_y_identity a b c d u hx + let affine_pos (a c u : Real) (hu0 : 0 ≤ u) (hu1 : u ≤ 1) + (ha : 0 < a) (hc : 0 < c) : 0 < (1-u)*a+u*c := DirectionParityLemmas.affine_pos a c u hu0 + hu1 ha hc + let affine_neg (a c u : Real) (hu0 : 0 ≤ u) (hu1 : u ≤ 1) + (ha : a < 0) (hc : c < 0) : (1-u)*a+u*c < 0 := DirectionParityLemmas.affine_neg a c u hu0 + hu1 ha hc + let root_positive_product (e z K : Real) (he : e ≠ 0) (h : e*z=K) : + 0 < z ↔ 0 < K*e := DirectionParityLemmas.root_positive_product e z K he h + let affine_axis_crossing_iff (a b c d : Real) (hb : b ≠ 0) (hd : d ≠ 0) : + (∃ u, 0 ≤ u ∧ u ≤ 1 ∧ (1-u)*b+u*d=0 ∧ 0<(1-u)*a+u*c) ↔ + b*d<0 ∧ 0<(a*d-b*c)*(d-b) := DirectionParityLemmas.affine_axis_crossing_iff + affine_root_between affine_pos affine_neg root_positive_product a b c d hb hd + let cone_crossing_accounting (a b c d K : Real) + (ha : a ≠ 0) (hb : b ≠ 0) (hc : c ≠ 0) (hd : d ≠ 0) + (hK : K ≠ 0) (hKeq : K = a*d-b*c) : + (((0 + B i * B (cyclicSucc m i) < 0 ∧ + 0 < (A i * B (cyclicSucc m i) - B i * A (cyclicSucc m i)) * + (B (cyclicSucc m i) - B i))).card % 2 = + (Finset.univ.filter (fun i => + A i * A (cyclicSucc m i) < 0 ∧ + 0 < (A i * B (cyclicSucc m i) - B i * A (cyclicSucc m i)) * + (A i - A (cyclicSucc m i)))).card % 2 := + DirectionParityLemmas.axis_parity_from_no_origin cyclic_xor_count + affine_root_between axis_root_x_identity axis_root_y_identity + cone_crossing_accounting cone_crossing_accounting_collinear (m := m) A B hA hB hno + let coordinate_hit_d (x d e v w : Real × Real) + (hD : det2 d e ≠ 0) + (hb : coordB d e (v-x) ≠ 0) (hd : coordB d e (w-x) ≠ 0) : + (∃ t : Real, 0 + if j.2 then p.vertex j.1 - x else p.vertex (j.1 + 1) - p.vertex j.1 + let S : Finset Real := Finset.univ.image fun j => (W j).2 / (W j).1 + have hcard : S.card < ENat.card Real := by + rw [ENat.card_eq_top_of_infinite] + exact ENat.natCast_lt_top _ + obtain ⟨q, hq⟩ := Finset.exists_notMem_of_card_lt_enatCard hcard + refine ⟨(1, q), ?_, ?_⟩ + · intro i + let w := p.vertex i - x + have hw : w ≠ 0 := sub_ne_zero.mpr (hx i) + have hnot : q ≠ w.2 / w.1 := by + intro he + apply hq + apply Finset.mem_image.mpr + refine ⟨(i, true), Finset.mem_univ _, ?_⟩ + simp [W, w, he] + intro hz + have hz' : w.2 - q * w.1 = 0 := by simpa [w] using hz + by_cases hzero : w.1 = 0 + · simp? [hzero] at hz' + exact hw (Prod.ext hzero hz') + · apply hnot + apply (eq_div_iff hzero).2 + nlinarith [hz'] + · intro i + let w := p.vertex (i + 1) - p.vertex i + have hi : i + 1 ≠ i := by + intro he + have hv := congrArg Fin.val he + simp only [Fin.val_add, Fin.val_one] at hv + have hm : 2 ≤ n + 3 := by omega + by_cases hs : i.val + 1 < n + 3 + · rw [Nat.mod_eq_of_lt hs] at hv + omega + · have hi' : i.val + 1 = n + 3 := by omega + rw [hi'] at hv + simp at hv + omega + have hw : w ≠ 0 := by + intro hz + have hv : p.vertex (i + 1) = p.vertex i := sub_eq_zero.mp hz + exact hi (p.injective hv) + have hnot : q ≠ w.2 / w.1 := by + intro he + apply hq + apply Finset.mem_image.mpr + refine ⟨(i, false), Finset.mem_univ _, ?_⟩ + simp [W, w, he] + intro hz + have hz' : w.2 - q * w.1 = 0 := by simpa [w] using hz + by_cases hzero : w.1 = 0 + · simp? [hzero] at hz' + exact hw (Prod.ext hzero hz') + · apply hnot + apply (eq_div_iff hzero).2 + nlinarith [hz'] + +namespace RayCrossingStability + +private noncomputable def det (v w : Real × Real) := v.1 * w.2 - v.2 * w.1 + +private theorem params : ∀ (y a d' e : Real × Real), det d' e ≠ 0 → + y + (det (a - y) e / det d' e) • d' = + a + (det (a - y) d' / det d' e) • e ∧ + (∀ t u : Real, y + t • d' = a + u • e → + t = det (a - y) e / det d' e ∧ u = det (a - y) d' / det d' e) := by + classical + let det (v w : Real × Real) := v.1 * w.2 - v.2 * w.1 + change (∀ (y a d' e : Real × Real), det d' e ≠ 0 → + y + (det (a - y) e / det d' e) • d' = + a + (det (a - y) d' / det d' e) • e ∧ + (∀ t u : Real, y + t • d' = a + u • e → + t = det (a - y) e / det d' e ∧ u = det (a - y) d' / det d' e)) + intro y a d' e hD + constructor + · have hDn : d'.1 * e.2 - d'.2 * e.1 ≠ 0 := by + simpa only [det] using hD + apply Prod.ext + · change y.1 + (det (a - y) e / det d' e) * d'.1 = + a.1 + (det (a - y) d' / det d' e) * e.1 + simp only [det, Prod.fst_sub, Prod.snd_sub] + field_simp (disch := simpa only [mul_comm] using hDn) + ring + · change y.2 + (det (a - y) e / det d' e) * d'.2 = + a.2 + (det (a - y) d' / det d' e) * e.2 + simp only [det, Prod.fst_sub, Prod.snd_sub] + field_simp (disch := simpa only [mul_comm] using hDn) + ring + · intro t u h + have h1 : y.1 + t * d'.1 = a.1 + u * e.1 := by + simpa using congrArg Prod.fst h + have h2 : y.2 + t * d'.2 = a.2 + u * e.2 := by + simpa using congrArg Prod.snd h + constructor + · apply (eq_div_iff hD).2 + dsimp only [det, Prod.fst_sub, Prod.snd_sub] + linear_combination e.2 * h1 - e.1 * h2 + · apply (eq_div_iff hD).2 + dsimp only [det, Prod.fst_sub, Prod.snd_sub] + linear_combination d'.2 * h1 - d'.1 * h2 + +private theorem hitCriterion : ∀ (y a b d' : Real × Real), det d' (b - a) ≠ 0 → + ((∃ t : Real, 0 < t ∧ y + t • d' ∈ segment Real a b) ↔ + 0 < det (a - y) (b - a) / det d' (b - a) ∧ + 0 ≤ det (a - y) d' / det d' (b - a) ∧ + det (a - y) d' / det d' (b - a) ≤ 1) := by + classical + let det (v w : Real × Real) := v.1 * w.2 - v.2 * w.1 + have params : ∀ (y a d' e : Real × Real), det d' e ≠ 0 → + y + (det (a - y) e / det d' e) • d' = + a + (det (a - y) d' / det d' e) • e ∧ + (∀ t u : Real, y + t • d' = a + u • e → + t = det (a - y) e / det d' e ∧ u = det (a - y) d' / det d' e) := params + change (∀ (y a b d' : Real × Real), det d' (b - a) ≠ 0 → + ((∃ t : Real, 0 < t ∧ y + t • d' ∈ segment Real a b) ↔ + 0 < det (a - y) (b - a) / det d' (b - a) ∧ + 0 ≤ det (a - y) d' / det d' (b - a) ∧ + det (a - y) d' / det d' (b - a) ≤ 1)) + intro y a b d' hD + obtain ⟨heq, huniq⟩ := params y a d' (b - a) hD + constructor + · rintro ⟨t, ht, hseg⟩ + rw [segment_eq_image'] at hseg + obtain ⟨u, hu, he⟩ := hseg + obtain ⟨hT, hU⟩ := huniq t u he.symm + exact ⟨hT ▸ ht, hU ▸ hu.1, hU ▸ hu.2⟩ + · rintro ⟨ht, hu0, hu1⟩ + refine ⟨_, ht, ?_⟩ + rw [segment_eq_image'] + exact ⟨_, ⟨hu0, hu1⟩, heq.symm⟩ + +private theorem hsegCompact (n : Nat) (p : P3381T1PolygonBoundary n) : ∀ i : Fin (n + 3), + IsCompact (segment Real (p.vertex i) (p.vertex (i + 1))) := by + classical + intro i + have hfinite : ({p.vertex i, p.vertex (i + 1)} : Set (Real × Real)).Finite := by + simp + rw [← convexHull_pair] + exact hfinite.isCompact_convexHull Real + +private theorem hcarrierCompact (n : Nat) (p : P3381T1PolygonBoundary n) : IsCompact + (P3544T1BoundaryCarrier p) := by + classical + have hsegCompact : ∀ i : Fin (n + 3), + IsCompact (segment Real (p.vertex i) (p.vertex (i + 1))) := hsegCompact n p + change IsCompact (⋃ i, segment Real (p.vertex i) (p.vertex (i + 1))) + exact isCompact_iUnion hsegCompact + +private theorem hcarrierOpen (n : Nat) (p : P3381T1PolygonBoundary n) : IsOpen + (P3544T1BoundaryCarrier p)ᶜ := by + classical + have hcarrierCompact : IsCompact (P3544T1BoundaryCarrier p) := hcarrierCompact n p + exact hcarrierCompact.isClosed.isOpen_compl + +private noncomputable def T (n : Nat) (p : P3381T1PolygonBoundary n) (d : Real × Real) : Fin (n + + 3) → (Real × Real) → Real := fun i y => + (((p.vertex i).1 - y.1) * ((p.vertex (i + 1)).2 - (p.vertex i).2) - + ((p.vertex i).2 - y.2) * ((p.vertex (i + 1)).1 - (p.vertex i).1)) * + (det d (p.vertex (i + 1) - p.vertex i))⁻¹ + +private noncomputable def U (n : Nat) (p : P3381T1PolygonBoundary n) (d : Real × Real) : Fin (n + + 3) → (Real × Real) → Real := fun i y => + (((p.vertex i).1 - y.1) * d.2 - ((p.vertex i).2 - y.2) * d.1) * + (det d (p.vertex (i + 1) - p.vertex i))⁻¹ + +private noncomputable def G (n : Nat) (p : P3381T1PolygonBoundary n) (d : Real × Real) : Fin (n + + 3) → (Real × Real) → Real := fun i y => + d.1 * ((p.vertex i).2 - y.2) - d.2 * ((p.vertex i).1 - y.1) + +private noncomputable def H (n : Nat) (p : P3381T1PolygonBoundary n) (d : Real × Real) : Fin (n + + 3) → (Real × Real) → Prop := fun i y => + ∃ t : Real, 0 < t ∧ y + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1)) + +private theorem hcriterion (n : Nat) (p : P3381T1PolygonBoundary n) (d : Real × Real) (hs : ∀ + i, d.1 * (p.vertex (i + 1) - p.vertex i).2 - d.2 * (p.vertex (i + 1) - p.vertex i).1 ≠ 0) : ∀ + i y, (H n p d) i y ↔ + 0 < (T n p d) i y ∧ 0 ≤ (U n p d) i y ∧ (U n p d) i y ≤ 1 := by + classical + let det (v w : Real × Real) := v.1 * w.2 - v.2 * w.1 + have hitCriterion : ∀ (y a b d' : Real × Real), det d' (b - a) ≠ 0 → + ((∃ t : Real, 0 < t ∧ y + t • d' ∈ segment Real a b) ↔ + 0 < det (a - y) (b - a) / det d' (b - a) ∧ + 0 ≤ det (a - y) d' / det d' (b - a) ∧ + det (a - y) d' / det d' (b - a) ≤ 1) := hitCriterion + let T : Fin (n + 3) → (Real × Real) → Real := fun i y => + (((p.vertex i).1 - y.1) * ((p.vertex (i + 1)).2 - (p.vertex i).2) - + ((p.vertex i).2 - y.2) * ((p.vertex (i + 1)).1 - (p.vertex i).1)) * + (det d (p.vertex (i + 1) - p.vertex i))⁻¹ + let U : Fin (n + 3) → (Real × Real) → Real := fun i y => + (((p.vertex i).1 - y.1) * d.2 - ((p.vertex i).2 - y.2) * d.1) * + (det d (p.vertex (i + 1) - p.vertex i))⁻¹ + let H : Fin (n + 3) → (Real × Real) → Prop := fun i y => + ∃ t : Real, 0 < t ∧ y + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1)) + change (∀ i y, H i y ↔ + 0 < T i y ∧ 0 ≤ U i y ∧ U i y ≤ 1) + intro i y + have hD : det d (p.vertex (i + 1) - p.vertex i) ≠ 0 := by + simpa [det] using hs i + have hh := hitCriterion y (p.vertex i) (p.vertex (i + 1)) d hD + simpa [H, T, U, det, Prod.fst_sub, Prod.snd_sub, div_eq_mul_inv] using hh + +private theorem hVi (n : Nat) (p : P3381T1PolygonBoundary n) (x : Real × Real) (d : Real × + Real) (hx : x ∉ P3544T1BoundaryCarrier p) (hg : ∀ i, d.1 * (p.vertex i - x).2 - d.2 * + (p.vertex i - x).1 ≠ 0) (hs : ∀ i, d.1 * (p.vertex (i + 1) - p.vertex i).2 - d.2 * (p.vertex + (i + 1) - p.vertex i).1 ≠ 0) : ∀ i : Fin (n + 3), ∃ V : Set (Real × Real), + IsOpen V ∧ x ∈ V ∧ ∀ y ∈ V, + (G n p d) i y ≠ 0 ∧ ((H n p d) i y ↔ (H n p d) i x) := by + classical + let det (v w : Real × Real) := v.1 * w.2 - v.2 * w.1 + have params : ∀ (y a d' e : Real × Real), det d' e ≠ 0 → + y + (det (a - y) e / det d' e) • d' = + a + (det (a - y) d' / det d' e) • e ∧ + (∀ t u : Real, y + t • d' = a + u • e → + t = det (a - y) e / det d' e ∧ u = det (a - y) d' / det d' e) := params + let T : Fin (n + 3) → (Real × Real) → Real := fun i y => + (((p.vertex i).1 - y.1) * ((p.vertex (i + 1)).2 - (p.vertex i).2) - + ((p.vertex i).2 - y.2) * ((p.vertex (i + 1)).1 - (p.vertex i).1)) * + (det d (p.vertex (i + 1) - p.vertex i))⁻¹ + let U : Fin (n + 3) → (Real × Real) → Real := fun i y => + (((p.vertex i).1 - y.1) * d.2 - ((p.vertex i).2 - y.2) * d.1) * + (det d (p.vertex (i + 1) - p.vertex i))⁻¹ + let G : Fin (n + 3) → (Real × Real) → Real := fun i y => + d.1 * ((p.vertex i).2 - y.2) - d.2 * ((p.vertex i).1 - y.1) + let H : Fin (n + 3) → (Real × Real) → Prop := fun i y => + ∃ t : Real, 0 < t ∧ y + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1)) + have hcriterion : ∀ i y, H i y ↔ + 0 < T i y ∧ 0 ≤ U i y ∧ U i y ≤ 1 := hcriterion n p d hs + change (∀ i : Fin (n + 3), ∃ V : Set (Real × Real), + IsOpen V ∧ x ∈ V ∧ ∀ y ∈ V, + G i y ≠ 0 ∧ (H i y ↔ H i x)) + intro i + have hD : det d (p.vertex (i + 1) - p.vertex i) ≠ 0 := by + simpa [det] using hs i + have hparams := params x (p.vertex i) d (p.vertex (i + 1) - p.vertex i) hD + have hTform : T i x = + det (p.vertex i - x) (p.vertex (i + 1) - p.vertex i) / + det d (p.vertex (i + 1) - p.vertex i) := by + simp [T, det, Prod.fst_sub, Prod.snd_sub, div_eq_mul_inv] + have hUform : U i x = + det (p.vertex i - x) d / det d (p.vertex (i + 1) - p.vertex i) := by + simp [U, det, Prod.fst_sub, Prod.snd_sub, div_eq_mul_inv] + have hparams' : x + T i x • d = p.vertex i + U i x • + (p.vertex (i + 1) - p.vertex i) := by + simpa only [hTform, hUform] using hparams.1 + have hU0 : U i x ≠ 0 := by + intro hu + have hpoint : x + T i x • d = p.vertex i := by + simpa [hu] using hparams' + have h1 : (p.vertex i - x).1 = T i x * d.1 := by + have hh := congrArg Prod.fst hpoint + dsimp [smul_eq_mul] at hh + change (p.vertex i).1 - x.1 = T i x * d.1 + linarith + have h2 : (p.vertex i - x).2 = T i x * d.2 := by + have hh := congrArg Prod.snd hpoint + dsimp [smul_eq_mul] at hh + change (p.vertex i).2 - x.2 = T i x * d.2 + linarith + have hz : d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 = 0 := by + rw [h1, h2] + ring + exact (hg i) hz + have hU1 : U i x ≠ 1 := by + intro hu + have hpoint : x + T i x • d = p.vertex (i + 1) := by + calc + x + T i x • d = p.vertex i + U i x • + (p.vertex (i + 1) - p.vertex i) := hparams' + _ = p.vertex (i + 1) := by simp [hu, sub_eq_add_neg, add_comm] + have h1 : (p.vertex (i + 1) - x).1 = T i x * d.1 := by + have hh := congrArg Prod.fst hpoint + dsimp [smul_eq_mul] at hh + change (p.vertex (i + 1)).1 - x.1 = T i x * d.1 + linarith + have h2 : (p.vertex (i + 1) - x).2 = T i x * d.2 := by + have hh := congrArg Prod.snd hpoint + dsimp [smul_eq_mul] at hh + change (p.vertex (i + 1)).2 - x.2 = T i x * d.2 + linarith + have hz : d.1 * (p.vertex (i + 1) - x).2 - + d.2 * (p.vertex (i + 1) - x).1 = 0 := by + rw [h1, h2] + ring + exact (hg (i + 1)) hz + have hT0 : 0 < U i x ∧ U i x < 1 → T i x ≠ 0 := by + rintro ⟨hu0, hu1⟩ ht + have hpoint : x = p.vertex i + U i x • + (p.vertex (i + 1) - p.vertex i) := by + have hh : x + T i x • d = p.vertex i + U i x • + (p.vertex (i + 1) - p.vertex i) := hparams' + simpa [ht] using hh + have hxseg : x ∈ segment Real (p.vertex i) (p.vertex (i + 1)) := by + rw [segment_eq_image'] + refine ⟨U i x, ⟨le_of_lt hu0, le_of_lt hu1⟩, ?_⟩ + exact hpoint.symm + apply hx + change x ∈ ⋃ j, segment Real (p.vertex j) (p.vertex (j + 1)) + exact Set.mem_iUnion.mpr ⟨i, hxseg⟩ + have hTcont : Continuous (T i) := by + change Continuous (fun y : Real × Real => + (((p.vertex i).1 - y.1) * ((p.vertex (i + 1)).2 - (p.vertex i).2) - + ((p.vertex i).2 - y.2) * ((p.vertex (i + 1)).1 - (p.vertex i).1)) * + (det d (p.vertex (i + 1) - p.vertex i))⁻¹) + fun_prop + have hUcont : Continuous (U i) := by + change Continuous (fun y : Real × Real => + (((p.vertex i).1 - y.1) * d.2 - ((p.vertex i).2 - y.2) * d.1) * + (det d (p.vertex (i + 1) - p.vertex i))⁻¹) + fun_prop + have hGcont : Continuous (G i) := by + change Continuous (fun y : Real × Real => + d.1 * ((p.vertex i).2 - y.2) - d.2 * ((p.vertex i).1 - y.1)) + fun_prop + have hGopen : IsOpen {y | G i y ≠ 0} := isOpen_ne.preimage hGcont + by_cases hneg : U i x < 0 + · let V : Set (Real × Real) := {y | U i y < 0} ∩ {y | G i y ≠ 0} + refine ⟨V, ?_, ?_, ?_⟩ + · exact (isOpen_lt hUcont continuous_const).inter hGopen + · simp only [V, Set.mem_inter_iff, Set.mem_ofPred_eq] + exact ⟨hneg, hg i⟩ + · intro y hy + simp only [V, Set.mem_inter_iff, Set.mem_ofPred_eq] at hy + refine ⟨hy.2, ?_⟩ + have hNoX : ¬ H i x := by + intro hh + have hh' := (hcriterion i x).mp hh + rcases hh' with ⟨_, hu, _⟩ + exact (not_le_of_gt hneg) hu + have hNoY : ¬ H i y := by + intro hh + have hh' := (hcriterion i y).mp hh + rcases hh' with ⟨_, hu, _⟩ + exact (not_le_of_gt hy.1) hu + exact ⟨fun hh => (hNoY hh).elim, fun hh => (hNoX hh).elim⟩ + · by_cases hhigh : 1 < U i x + · let V : Set (Real × Real) := {y | 1 < U i y} ∩ {y | G i y ≠ 0} + refine ⟨V, ?_, ?_, ?_⟩ + · exact (isOpen_lt continuous_const hUcont).inter hGopen + · simp only [V, Set.mem_inter_iff, Set.mem_ofPred_eq] + exact ⟨hhigh, hg i⟩ + · intro y hy + simp only [V, Set.mem_inter_iff, Set.mem_ofPred_eq] at hy + refine ⟨hy.2, ?_⟩ + have hNoX : ¬ H i x := by + intro hh + have hh' := (hcriterion i x).mp hh + rcases hh' with ⟨_, _, hu⟩ + exact (not_le_of_gt hhigh) hu + have hNoY : ¬ H i y := by + intro hh + have hh' := (hcriterion i y).mp hh + rcases hh' with ⟨_, _, hu⟩ + exact (not_le_of_gt hy.1) hu + exact ⟨fun hh => (hNoY hh).elim, fun hh => (hNoX hh).elim⟩ + · have hlow : 0 < U i x := by + rcases lt_or_eq_of_le (le_of_not_gt hneg) with h | h + · exact h + · exact False.elim (hU0 h.symm) + have hupper : U i x < 1 := by + rcases lt_or_eq_of_le (le_of_not_gt hhigh) with h | h + · exact h + · exact False.elim (hU1 h) + have hTnonzero : T i x ≠ 0 := hT0 ⟨hlow, hupper⟩ + by_cases htpos : 0 < T i x + · let V : Set (Real × Real) := + {y | 0 < U i y} ∩ {y | U i y < 1} ∩ + {y | 0 < T i y} ∩ {y | G i y ≠ 0} + refine ⟨V, ?_, ?_, ?_⟩ + · exact (((isOpen_lt continuous_const hUcont).inter + (isOpen_lt hUcont continuous_const)).inter + (isOpen_lt continuous_const hTcont)).inter hGopen + · simp only [V, Set.mem_inter_iff, Set.mem_ofPred_eq] + exact ⟨⟨⟨hlow, hupper⟩, htpos⟩, hg i⟩ + · intro y hy + simp only [V, Set.mem_inter_iff, Set.mem_ofPred_eq] at hy + rcases hy with ⟨⟨⟨hu0, hu1⟩, htposY⟩, hgy⟩ + refine ⟨hgy, ?_⟩ + constructor + · intro _ + exact (hcriterion i x).mpr ⟨htpos, le_of_lt hlow, le_of_lt hupper⟩ + · intro _ + exact (hcriterion i y).mpr ⟨htposY, le_of_lt hu0, le_of_lt hu1⟩ + · have htneg : T i x < 0 := by + rcases lt_or_eq_of_le (le_of_not_gt htpos) with h | h + · exact h + · exact False.elim (hTnonzero h) + let V : Set (Real × Real) := + {y | 0 < U i y} ∩ {y | U i y < 1} ∩ + {y | T i y < 0} ∩ {y | G i y ≠ 0} + refine ⟨V, ?_, ?_, ?_⟩ + · exact (((isOpen_lt continuous_const hUcont).inter + (isOpen_lt hUcont continuous_const)).inter + (isOpen_lt hTcont continuous_const)).inter hGopen + · simp only [V, Set.mem_inter_iff, Set.mem_ofPred_eq] + exact ⟨⟨⟨hlow, hupper⟩, htneg⟩, hg i⟩ + · intro y hy + simp only [V, Set.mem_inter_iff, Set.mem_ofPred_eq] at hy + rcases hy with ⟨⟨⟨hu0, hu1⟩, htnegY⟩, hgy⟩ + refine ⟨hgy, ?_⟩ + constructor + · intro hh + have hh' := (hcriterion i y).mp hh + linarith [hh'.1] + · intro hh + have hh' := (hcriterion i x).mp hh + linarith [hh'.1] + +end RayCrossingStability + +private theorem localRayCrossingStability {n : Nat} (p : P3381T1PolygonBoundary n) : + (∀ x d : Real × Real, x ∉ P3544T1BoundaryCarrier p → + (∀ i, d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ 0) → + (∀ i, d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1 ≠ 0) → + ∃ r : Real, 0 < r ∧ ∀ y ∈ Metric.ball x r, + y ∉ P3544T1BoundaryCarrier p ∧ + (∀ i, d.1 * (p.vertex i - y).2 - d.2 * (p.vertex i - y).1 ≠ 0) ∧ + (∀ i, (∃ t : Real, 0 < t ∧ + y + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1))) ↔ + (∃ t : Real, 0 < t ∧ + x + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1))))) := by + intro x d hx hg hs + let det (v w : Real × Real) := v.1 * w.2 - v.2 * w.1 + have params : ∀ (y a d' e : Real × Real), det d' e ≠ 0 → + y + (det (a - y) e / det d' e) • d' = + a + (det (a - y) d' / det d' e) • e ∧ + (∀ t u : Real, y + t • d' = a + u • e → + t = det (a - y) e / det d' e ∧ u = det (a - y) d' / det d' e) := RayCrossingStability.params + have hitCriterion : ∀ (y a b d' : Real × Real), det d' (b - a) ≠ 0 → + ((∃ t : Real, 0 < t ∧ y + t • d' ∈ segment Real a b) ↔ + 0 < det (a - y) (b - a) / det d' (b - a) ∧ + 0 ≤ det (a - y) d' / det d' (b - a) ∧ + det (a - y) d' / det d' (b - a) ≤ 1) := RayCrossingStability.hitCriterion + have hsegCompact : ∀ i : Fin (n + 3), + IsCompact (segment Real (p.vertex i) (p.vertex (i + 1))) := + RayCrossingStability.hsegCompact n p + have hcarrierCompact : IsCompact (P3544T1BoundaryCarrier p) := + RayCrossingStability.hcarrierCompact n p + have hcarrierOpen : IsOpen (P3544T1BoundaryCarrier p)ᶜ := RayCrossingStability.hcarrierOpen n p + let T : Fin (n + 3) → (Real × Real) → Real := fun i y => + (((p.vertex i).1 - y.1) * ((p.vertex (i + 1)).2 - (p.vertex i).2) - + ((p.vertex i).2 - y.2) * ((p.vertex (i + 1)).1 - (p.vertex i).1)) * + (det d (p.vertex (i + 1) - p.vertex i))⁻¹ + let U : Fin (n + 3) → (Real × Real) → Real := fun i y => + (((p.vertex i).1 - y.1) * d.2 - ((p.vertex i).2 - y.2) * d.1) * + (det d (p.vertex (i + 1) - p.vertex i))⁻¹ + let G : Fin (n + 3) → (Real × Real) → Real := fun i y => + d.1 * ((p.vertex i).2 - y.2) - d.2 * ((p.vertex i).1 - y.1) + let H : Fin (n + 3) → (Real × Real) → Prop := fun i y => + ∃ t : Real, 0 < t ∧ y + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1)) + have hcriterion : ∀ i y, H i y ↔ + 0 < T i y ∧ 0 ≤ U i y ∧ U i y ≤ 1 := RayCrossingStability.hcriterion n p d hs + have hVi : ∀ i : Fin (n + 3), ∃ V : Set (Real × Real), + IsOpen V ∧ x ∈ V ∧ ∀ y ∈ V, + G i y ≠ 0 ∧ (H i y ↔ H i x) := RayCrossingStability.hVi n p x d hx hg hs + choose V hVopen hxV hVstable using hVi + have hVopen : IsOpen (⋂ i, V i) := isOpen_iInter_of_finite hVopen + have hxV : x ∈ ⋂ i, V i := Set.mem_iInter.mpr hxV + have hOpen : IsOpen ((P3544T1BoundaryCarrier p)ᶜ ∩ ⋂ i, V i) := + hcarrierOpen.inter hVopen + have hxOpen : x ∈ (P3544T1BoundaryCarrier p)ᶜ ∩ ⋂ i, V i := ⟨hx, hxV⟩ + obtain ⟨r, hr, hball⟩ := Metric.isOpen_iff.mp hOpen x hxOpen + refine ⟨r, hr, ?_⟩ + intro y hy + have hyOpen := hball hy + refine ⟨hyOpen.1, ?_, ?_⟩ + · intro i + exact hVstable i y (Set.mem_iInter.mp hyOpen.2 i) |>.1 + · intro i + exact (hVstable i y (Set.mem_iInter.mp hyOpen.2 i)).2 + +private theorem rayIntersectionParameters {n : Nat} (p : P3381T1PolygonBoundary n) : + (∀ (x d : Real × Real) (i : Fin (n + 3)), + let a := p.vertex i + let e := p.vertex (i + 1) - a + let D := d.1 * e.2 - d.2 * e.1 + D ≠ 0 → + let t := ((a - x).1 * e.2 - (a - x).2 * e.1) / D + let u := ((a - x).1 * d.2 - (a - x).2 * d.1) / D + x + t • d = a + u • e ∧ + (∀ t' u' : Real, x + t' • d = a + u' • e → t' = t ∧ u' = u) ∧ + ((∃ t' : Real, 0 < t' ∧ + x + t' • d ∈ segment Real a (p.vertex (i + 1))) ↔ + 0 < t ∧ 0 ≤ u ∧ u ≤ 1)) := by + intro x d i + dsimp + intro hD + let a := p.vertex i + let e := p.vertex (i + 1) - a + let D := d.1 * e.2 - d.2 * e.1 + let t := ((a - x).1 * e.2 - (a - x).2 * e.1) / D + let u := ((a - x).1 * d.2 - (a - x).2 * d.1) / D + let det (v w : Real × Real) := v.1 * w.2 - v.2 * w.1 + have hDet : det d e ≠ 0 := by + simpa [det, e, a, Prod.fst_sub, Prod.snd_sub] using hD + have hparams : + x + (det (a - x) e / det d e) • d = + a + (det (a - x) d / det d e) • e ∧ + (∀ t' u' : Real, x + t' • d = a + u' • e → + t' = det (a - x) e / det d e ∧ u' = det (a - x) d / det d e) := by + constructor + · have hDn : d.1 * e.2 - d.2 * e.1 ≠ 0 := by + simpa only [det] using hDet + apply Prod.ext + · change x.1 + (det (a - x) e / det d e) * d.1 = + a.1 + (det (a - x) d / det d e) * e.1 + simp only [det, Prod.fst_sub, Prod.snd_sub] + field_simp (disch := simpa only [mul_comm] using hDn) + ring + · change x.2 + (det (a - x) e / det d e) * d.2 = + a.2 + (det (a - x) d / det d e) * e.2 + simp only [det, Prod.fst_sub, Prod.snd_sub] + field_simp (disch := simpa only [mul_comm] using hDn) + ring + · intro t' u' h + have h1 : x.1 + t' * d.1 = a.1 + u' * e.1 := by + simpa using congrArg Prod.fst h + have h2 : x.2 + t' * d.2 = a.2 + u' * e.2 := by + simpa using congrArg Prod.snd h + constructor + · apply (eq_div_iff hDet).2 + dsimp only [det, Prod.fst_sub, Prod.snd_sub] + linear_combination e.2 * h1 - e.1 * h2 + · apply (eq_div_iff hDet).2 + dsimp only [det, Prod.fst_sub, Prod.snd_sub] + linear_combination d.2 * h1 - d.1 * h2 + have heq : x + t • d = a + u • e := by + simpa [det, t, u, D] using hparams.1 + have huniq : ∀ t' u' : Real, x + t' • d = a + u' • e → + t' = t ∧ u' = u := by + intro t' u' h + obtain ⟨ht, hu⟩ := hparams.2 t' u' h + exact ⟨by simpa [det, t, D] using ht, by simpa [det, u, D] using hu⟩ + refine ⟨heq, huniq, ?_⟩ + constructor + · rintro ⟨t', ht', hseg⟩ + rw [segment_eq_image'] at hseg + obtain ⟨u', hu', he⟩ := hseg + obtain ⟨hT, hU⟩ := huniq t' u' he.symm + rw [hT] at ht' + rw [hU] at hu' + exact ⟨by simpa [det, t, D, a, e] using ht', + by simpa [det, u, D, a, e] using hu'.1, + by simpa [det, u, D, a, e] using hu'.2⟩ + · rintro ⟨ht, hu0, hu1⟩ + refine ⟨t, ht, ?_⟩ + rw [segment_eq_image'] + exact ⟨u, ⟨hu0, hu1⟩, heq.symm⟩ + +theorem P3597T1GenericRayStability {n : Nat} (p : P3381T1PolygonBoundary n) : + (∀ x : Real × Real, (∀ i, p.vertex i ≠ x) → ∃ d : Real × Real, + (∀ i, d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ 0) ∧ + (∀ i, d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1 ≠ 0)) ∧ + (∀ x d : Real × Real, x ∉ P3544T1BoundaryCarrier p → + (∀ i, d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ 0) → + (∀ i, d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1 ≠ 0) → + ∃ r : Real, 0 < r ∧ ∀ y ∈ Metric.ball x r, + y ∉ P3544T1BoundaryCarrier p ∧ + (∀ i, d.1 * (p.vertex i - y).2 - d.2 * (p.vertex i - y).1 ≠ 0) ∧ + (∀ i, (∃ t : Real, 0 < t ∧ + y + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1))) ↔ + (∃ t : Real, 0 < t ∧ + x + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1))))) ∧ + (∀ (x d : Real × Real) (i : Fin (n + 3)), + let a := p.vertex i + let e := p.vertex (i + 1) - a + let D := d.1 * e.2 - d.2 * e.1 + D ≠ 0 → + let t := ((a - x).1 * e.2 - (a - x).2 * e.1) / D + let u := ((a - x).1 * d.2 - (a - x).2 * d.1) / D + x + t • d = a + u • e ∧ + (∀ t' u' : Real, x + t' • d = a + u' • e → t' = t ∧ u' = u) ∧ + ((∃ t' : Real, 0 < t' ∧ + x + t' • d ∈ segment Real a (p.vertex (i + 1))) ↔ + 0 < t ∧ 0 ≤ u ∧ u ≤ 1)) := by + exact ⟨genericRayDirection p, localRayCrossingStability p, rayIntersectionParameters p⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean b/LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean new file mode 100644 index 0000000000..2004c6bcf3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean @@ -0,0 +1,1912 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3597T1DirectionParity +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public import Mathlib.Tactic.FunProp +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring +public import Mathlib.Topology.Algebra.GroupWithZero +public import Mathlib.Topology.MetricSpace.Algebra +public import Mathlib.Topology.Algebra.UniformRing +public import Mathlib.Analysis.Normed.Ring.Lemmas +public import Mathlib.Analysis.Normed.Module.Basic + +-- [TABLET NODE: P3597T1SideCrossing] + +/-! +# P3597T1SideCrossing + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SideCrossingProof + +private theorem hidx : + ∀ (n : Nat), ∀ (i : Fin (n + 3)), i ≠ i + 1 := by + classical + intro n i h + have hv := congrArg Fin.val h + have hval : (i + 1).val = if i.val = n + 2 then 0 else i.val + 1 := by + simp [Fin.val_add_eq_ite] + split_ifs <;> omega + rw [hval] at hv + split_ifs at hv <;> omega + +private theorem hab : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let a := p.vertex i + let b := p.vertex (i + 1) + (i ≠ i + 1) → (a ≠ b) := by + classical + intro n p i a b hidx h + exact hidx (p.injective h) + +private theorem hxleft : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), (x + ∈ openSegment ℝ (p.vertex i) (p.vertex (i + (1 : Fin (n + (3 : ℕ)))))) → ( + let a := p.vertex i + let b := p.vertex (i + 1) + (a ≠ b) → (x ≠ a)) := by + classical + intro n p i x hx a b hab h + subst x + have hab' : a = b := left_mem_openSegment_iff.mp hx + exact hab hab' + +private theorem hxright : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), (x + ∈ openSegment ℝ (p.vertex i) (p.vertex (i + (1 : Fin (n + (3 : ℕ)))))) → ( + let a := p.vertex i + let b := p.vertex (i + 1) + (a ≠ b) → ((x ≠ a) → (x ≠ b))) := by + classical + intro n p i x hx a b hab hxleft h + subst x + have hab' : a = b := right_mem_openSegment_iff.mp hx + exact hab hab' + +private theorem hxseg : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), (x + ∈ openSegment ℝ (p.vertex i) (p.vertex (i + (1 : Fin (n + (3 : ℕ)))))) → ( + let a := p.vertex i + let b := p.vertex (i + 1) + x ∈ segment Real a b) := by + classical + intro n p i x hx a b + exact openSegment_subset_segment Real a b hx + +private theorem hxline : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (q : ℝ), ((fun (θ : ℝ) => ((1 : ℝ) - θ) • p.vertex i + θ • p.vertex (i + (1 : Fin (n + (3 : + ℕ))))) q = x) → (x = a + q • (b - a)) := by + classical + intro n p i x a b q hxq + rw [← hxq] + apply Prod.ext <;> simp [sub_smul] <;> ring + +private theorem hx1 : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (q : ℝ), (x = a + q • (b - a)) → (x.1 = a.1 + q * (b.1 - a.1)) := by + classical + intro n p i x a b q hxline + have h := congrArg Prod.fst hxline + simpa using h + +private theorem hx2 : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (q : ℝ), (x = a + q • (b - a)) → (x.2 = a.2 + q * (b.2 - a.2)) := by + classical + intro n p i x a b q hxline + have h := congrArg Prod.snd hxline + simpa using h + +private theorem hxnotseg : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + (x ≠ a) → ((x ≠ b) → ((x ∈ segment ℝ a b) → (∀ j : Fin (n + 3), j ≠ i → + x ∉ segment Real (p.vertex j) (p.vertex (j + 1))))) := by + classical + intro n p i x a b hxleft hxright hxseg j hji hxj + have hint : x ∈ segment Real a b ∩ + segment Real (p.vertex j) (p.vertex (j + 1)) := ⟨hxseg, hxj⟩ + rw [p.edge_intersection i j (Ne.symm hji)] at hint + rcases hint with ⟨(h | h), _⟩ + · exact hxleft h + · exact hxright h + +private theorem hnonvertex : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + (x ≠ a) → ((∀ j : Fin (n + 3), j ≠ i → x ∉ segment Real (p.vertex j) (p.vertex (j + 1))) → (∀ + k : Fin (n + 3), p.vertex k ≠ x)) := by + classical + intro n p i x a hxleft hxnotseg k hk + by_cases hki : k = i + · subst k + exact hxleft hk.symm + · apply hxnotseg k hki + rw [← hk] + exact left_mem_segment Real _ _ + +private theorem hD : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (d : ℝ × ℝ), (∀ (i : Fin (n + (3 : ℕ))), + d.1 * (p.vertex (i + (1 : Fin (n + (3 : ℕ)))) - p.vertex i).2 - d.2 * (p.vertex (i + (1 : + Fin (n + (3 : ℕ)))) - p.vertex i).1 ≠ (0 : ℝ)) → ( + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + ∀ j, D j ≠ 0) := by + classical + intro n p d hde D j + exact hde j + +private theorem hparam : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (x : Real × Real), ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + (∀ j, D j ≠ 0) → (∀ (j : Fin (n + (3 : ℕ))), have t := + ((p.vertex j - x).1 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).2 - + (p.vertex j - x).2 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).1) / + (d.1 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).2 - + d.2 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).1); + have u := + ((p.vertex j - x).1 * d.2 - (p.vertex j - x).2 * d.1) / + (d.1 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).2 - + d.2 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).1); + x + t • d = p.vertex j + u • (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j) ∧ + (∀ (t' : ℝ), ∀ (u' : ℝ), x + t' • d = p.vertex j + u' • (p.vertex (j + (1 : Fin (n + (3 : + ℕ)))) - p.vertex j) → t' = t ∧ u' = u) ∧ + ((∃ (t' : ℝ), (0 : ℝ) < t' ∧ x + t' • d ∈ segment ℝ (p.vertex j) (p.vertex (j + (1 : Fin (n + + (3 : ℕ)))))) ↔ + (0 : ℝ) < t ∧ (0 : ℝ) ≤ u ∧ u ≤ (1 : ℝ))) := by + classical + intro n p x d D hD j + exact (P3597T1GenericRayStability p).2.2 x d j (hD j) + +private theorem hcontT : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + (∀ j, D j ≠ 0) → (∀ (j : Fin (n + 3)), Continuous (T j)) := by + classical + intro n p d D T hD j + dsimp [T, D] + apply Continuous.div + · fun_prop + · exact continuous_const + · intro y + exact hD j + +private theorem hcontU : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + (∀ j, D j ≠ 0) → (∀ (j : Fin (n + 3)), Continuous (U j)) := by + classical + intro n p d D U hD j + dsimp [U, D] + apply Continuous.div + · fun_prop + · exact continuous_const + · intro y + exact hD j + +private theorem hTi : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (q : ℝ), (x.1 = a.1 + q * (b.1 - a.1)) → ((x.2 = a.2 + q * (b.2 - a.2)) → (∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + (∀ j, D j ≠ 0) → (T i x = 0))) := by + classical + intro n p i x a b q hx1 hx2 d D T hD + change ((a.1 - x.1) * (b.2 - a.2) - (a.2 - x.2) * (b.1 - a.1)) / + (d.1 * (b.2 - a.2) - d.2 * (b.1 - a.1)) = 0 + have hden : d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1 ≠ 0 := by + simpa [D] using hD i + change d.1 * (b.2 - a.2) - d.2 * (b.1 - a.1) ≠ 0 at hden + apply (div_eq_zero_iff).2 + left + rw [hx1, hx2] + dsimp [a, b] + ring + +private theorem hUi : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (q : ℝ), (x.1 = a.1 + q * (b.1 - a.1)) → ((x.2 = a.2 + q * (b.2 - a.2)) → (∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + (∀ j, D j ≠ 0) → (U i x = q))) := by + classical + intro n p i x a b q hx1 hx2 d D U hD + change ((a.1 - x.1) * d.2 - (a.2 - x.2) * d.1) / + (d.1 * (b.2 - a.2) - d.2 * (b.1 - a.1)) = q + have hden : d.1 * (p.vertex (i + 1) - p.vertex i).2 - + d.2 * (p.vertex (i + 1) - p.vertex i).1 ≠ 0 := by + simpa [D] using hD i + apply (div_eq_iff hden).2 + change d.1 * (b.2 - a.2) - d.2 * (b.1 - a.1) ≠ 0 at hden + rw [hx1, hx2] + dsimp [a, b] + ring + +private theorem hUzero : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (x : Real × Real), ∀ (d : ℝ × ℝ), (∀ (i : + Fin (n + (3 : ℕ))), d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ (0 : ℝ)) → ( + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + (∀ j, D j ≠ 0) → (∀ (j : Fin (n + 3)), U j x ≠ 0)) := by + classical + intro n p x d hdv D U hD j h + change (((p.vertex j).1 - x.1) * d.2 - ((p.vertex j).2 - x.2) * d.1) / + (d.1 * ((p.vertex (j + 1)).2 - (p.vertex j).2) - + d.2 * ((p.vertex (j + 1)).1 - (p.vertex j).1)) = 0 at h + have hden : d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 ≠ 0 := by + simpa [D] using hD j + have hn := (div_eq_zero_iff).mp h + rcases hn with hn | hn + · have hv0 : d.1 * ((p.vertex j).2 - x.2) - + d.2 * ((p.vertex j).1 - x.1) = 0 := by nlinarith [hn] + exact (hdv j) hv0 + · exact hden hn + +private theorem hUone : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (x : Real × Real), ∀ (d : ℝ × ℝ), (∀ (i : + Fin (n + (3 : ℕ))), d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ (0 : ℝ)) → ( + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + (∀ j, D j ≠ 0) → (∀ (j : Fin (n + 3)), U j x ≠ 1)) := by + classical + intro n p x d hdv D U hD j h + change (((p.vertex j).1 - x.1) * d.2 - ((p.vertex j).2 - x.2) * d.1) / + (d.1 * ((p.vertex (j + 1)).2 - (p.vertex j).2) - + d.2 * ((p.vertex (j + 1)).1 - (p.vertex j).1)) = 1 at h + have hden : d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 ≠ 0 := by + simpa [D] using hD j + have hn := (div_eq_iff hden).mp h + simp only [one_mul, Prod.fst_sub, Prod.snd_sub] at hn + have hv0 : d.1 * ((p.vertex (j + 1)).2 - x.2) - + d.2 * ((p.vertex (j + 1)).1 - x.1) = 0 := by + nlinarith [hn] + exact (hdv (j + 1)) hv0 + +private theorem hTne : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), (∀ + j : Fin (n + 3), j ≠ i → x ∉ segment Real (p.vertex j) (p.vertex (j + 1))) → (∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + (∀ (j : Fin (n + (3 : ℕ))), have t := ((p.vertex j - x).1 * (p.vertex (j + (1 : Fin (n + (3 : + ℕ)))) - p.vertex j).2 - (p.vertex j - x).2 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - + p.vertex j).1) / (d.1 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).2 - d.2 * + (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).1); have u := ((p.vertex j - x).1 * + d.2 - (p.vertex j - x).2 * d.1) / (d.1 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - + p.vertex j).2 - d.2 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).1); x + t • d + = p.vertex j + u • (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j) ∧ (∀ (t' : ℝ), ∀ + (u' : ℝ), x + t' • d = p.vertex j + u' • (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - + p.vertex j) → t' = t ∧ u' = u) ∧ ((∃ (t' : ℝ), (0 : ℝ) < t' ∧ x + t' • d ∈ segment ℝ + (p.vertex j) (p.vertex (j + (1 : Fin (n + (3 : ℕ)))))) ↔ (0 : ℝ) < t ∧ (0 : ℝ) ≤ u ∧ u ≤ + (1 : ℝ))) → (∀ (j : Fin (n + 3)), (j ≠ i) → ((0 < U j x ∧ U j x < 1) → (T j x ≠ 0)))) := by + classical + intro n p i x hxnotseg d D T U hparam j hji hinside ht + have ht' : (((p.vertex j - x).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - x).2 * (p.vertex (j + 1) - p.vertex j).1) / + (d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1)) = 0 := by + simpa [T, D] using ht + have heq := (hparam j).1 + change x + T j x • d = p.vertex j + U j x • + (p.vertex (j + 1) - p.vertex j) at heq + rw [ht, zero_smul, add_zero] at heq + have hxj : x ∈ segment Real (p.vertex j) (p.vertex (j + 1)) := by + rw [segment_eq_image] + let u := U j x + refine ⟨u, ⟨le_of_lt hinside.1, hinside.2.le⟩, ?_⟩ + change (1 - u) • p.vertex j + u • p.vertex (j + 1) = x + calc + (1 - u) • p.vertex j + u • p.vertex (j + 1) = + p.vertex j + u • (p.vertex (j + 1) - p.vertex j) := by + apply Prod.ext <;> simp [smul_sub, sub_smul] <;> ring + _ = x := heq.symm + exact (hxnotseg j hji) hxj + +private theorem hVopen : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), ∀ + (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + (∀ (j : Fin (n + 3)), Continuous (T j)) → ((∀ (j : Fin (n + 3)), Continuous (U j)) → ( + let V : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then {y | 0 < U j y ∧ U j y < 1} + else if U j x < 0 then {y | U j y < 0} + else if 1 < U j x then {y | 1 < U j y} + else if 0 < T j x then {y | 0 < T j y ∧ 0 < U j y ∧ U j y < 1} + else {y | T j y < 0 ∧ 0 < U j y ∧ U j y < 1} + ∀ (j : Fin (n + 3)), IsOpen (V j))) := by + classical + intro n p i x d D T U hcontT hcontU V j + dsimp [V] + split_ifs with hji hu0 hu1 ht + · simpa only [Set.ofPred_and] using (isOpen_lt + (continuous_const : Continuous fun _ : Real × Real => (0 : Real)) (hcontU j)).inter + (isOpen_lt (hcontU j) + (continuous_const : Continuous fun _ : Real × Real => (1 : Real))) + · exact isOpen_lt (hcontU j) continuous_const + · exact isOpen_lt (continuous_const : Continuous fun _ : Real × Real => (1 : Real)) (hcontU j) + · simpa only [Set.ofPred_and] using (isOpen_lt + (continuous_const : Continuous fun _ : Real × Real => (0 : Real)) (hcontT j)).inter + ((isOpen_lt (continuous_const : Continuous fun _ : Real × Real => (0 : Real)) + (hcontU j)).inter (isOpen_lt (hcontU j) + (continuous_const : Continuous fun _ : Real × Real => (1 : Real)))) + · simpa only [Set.ofPred_and] using (isOpen_lt (hcontT j) + (continuous_const : Continuous fun _ : Real × Real => (0 : Real))).inter + ((isOpen_lt (continuous_const : Continuous fun _ : Real × Real => (0 : Real)) + (hcontU j)).inter (isOpen_lt (hcontU j) + (continuous_const : Continuous fun _ : Real × Real => (1 : Real)))) + +private theorem hVmem : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), ∀ + (q : ℝ), (q ∈ Set.Ioo (0 : ℝ) (1 : ℝ)) → (∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + (U i x = q) → ((∀ (j : Fin (n + 3)), U j x ≠ 0) → ((∀ (j : Fin (n + 3)), U j x ≠ 1) → ((∀ (j + : Fin (n + 3)), (j ≠ i) → ((0 < U j x ∧ U j x < 1) → (T j x ≠ 0))) → ( + let V : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then {y | 0 < U j y ∧ U j y < 1} + else if U j x < 0 then {y | U j y < 0} + else if 1 < U j x then {y | 1 < U j y} + else if 0 < T j x then {y | 0 < T j y ∧ 0 < U j y ∧ U j y < 1} + else {y | T j y < 0 ∧ 0 < U j y ∧ U j y < 1} + ∀ j, x ∈ V j))))) := by + classical + intro n p i x q hq d D T U hUi hUzero hUone hTne V j + by_cases hji : j = i + · subst j + simp [V, hUi, hq.1, hq.2] + · have hz := hUzero j + have ho := hUone j + by_cases hu0 : U j x < 0 + · simp [V, hji, hu0] + · by_cases hu1 : 1 < U j x + · simp [V, hji, hu0, hu1] + · have hinside : 0 < U j x ∧ U j x < 1 := by + constructor + · exact lt_of_le_of_ne (le_of_not_gt hu0) (Ne.symm hz) + · exact lt_of_le_of_ne (le_of_not_gt hu1) ho + have htne := hTne j hji hinside + by_cases ht : 0 < T j x + · simp [V, hji, hu0, hu1, ht, hinside] + · have ht' : T j x < 0 := lt_of_le_of_ne (le_of_not_gt ht) htne + simp [V, hji, hu0, hu1, ht, ht', hinside] + +private theorem hVallopen : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), ∀ + (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + let V : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then {y | 0 < U j y ∧ U j y < 1} + else if U j x < 0 then {y | U j y < 0} + else if 1 < U j x then {y | 1 < U j y} + else if 0 < T j x then {y | 0 < T j y ∧ 0 < U j y ∧ U j y < 1} + else {y | T j y < 0 ∧ 0 < U j y ∧ U j y < 1} + (∀ (j : Fin (n + 3)), IsOpen (V j)) → ( + let Vall : Set (Real × Real) := ⋂ j, V j + IsOpen Vall) := by + classical + intro n p i x d D T U V hVopen Vall + dsimp [Vall] + exact isOpen_iInter_of_finite hVopen + +private theorem hxVall : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), ∀ + (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + let V : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then {y | 0 < U j y ∧ U j y < 1} + else if U j x < 0 then {y | U j y < 0} + else if 1 < U j x then {y | 1 < U j y} + else if 0 < T j x then {y | 0 < T j y ∧ 0 < U j y ∧ U j y < 1} + else {y | T j y < 0 ∧ 0 < U j y ∧ U j y < 1} + (∀ j, x ∈ V j) → ( + let Vall : Set (Real × Real) := ⋂ j, V j + x ∈ Vall) := by + classical + intro n p i x d D T U V hVmem Vall + exact Set.mem_iInter.mpr hVmem + +private theorem hcompactseg : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (j : Fin (n + 3)), IsCompact (segment Real + (p.vertex j) (p.vertex (j + 1))) := by + classical + intro n p j + rw [segment_eq_image] + apply isCompact_Icc.image + fun_prop + +private theorem hWopen : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), (∀ (j : Fin (n + 3)), + IsCompact (segment Real (p.vertex j) (p.vertex (j + 1)))) → ( + let W : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then Set.univ else (segment Real (p.vertex j) (p.vertex (j + 1)))ᶜ + ∀ (j : Fin (n + 3)), IsOpen (W j)) := by + classical + intro n p i hcompactseg W j + dsimp [W] + split_ifs + · exact isOpen_univ + · exact (hcompactseg j).isClosed.isOpen_compl + +private theorem hWmem : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), (∀ + j : Fin (n + 3), j ≠ i → x ∉ segment Real (p.vertex j) (p.vertex (j + 1))) → ( + let W : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then Set.univ else (segment Real (p.vertex j) (p.vertex (j + 1)))ᶜ + ∀ j, x ∈ W j) := by + classical + intro n p i x hxnotseg W j + by_cases hji : j = i + · simp [W, hji] + · simp [W, hji, hxnotseg j hji] + +private theorem hWallopen : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let W : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then Set.univ else (segment Real (p.vertex j) (p.vertex (j + 1)))ᶜ + (∀ (j : Fin (n + 3)), IsOpen (W j)) → ( + let Wall : Set (Real × Real) := ⋂ j, W j + IsOpen Wall) := by + classical + intro n p i W hWopen Wall + dsimp [Wall] + exact isOpen_iInter_of_finite hWopen + +private theorem hxWall : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let W : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then Set.univ else (segment Real (p.vertex j) (p.vertex (j + 1)))ᶜ + (∀ j, x ∈ W j) → ( + let Wall : Set (Real × Real) := ⋂ j, W j + x ∈ Wall) := by + classical + intro n p i x W hWmem Wall + exact Set.mem_iInter.mpr hWmem + +private theorem hFexplicit : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let a := p.vertex i + let b := p.vertex (i + 1) + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + ∀ (y : Real × Real), F y = + (b.1 - a.1) * (y.2 - a.2) - (y.1 - a.1) * (b.2 - a.2) := by + classical + intro n p i a b F y + simp [F, P3381T1TriangleDeterminant] + +private theorem hsegF : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let a := p.vertex i + let b := p.vertex (i + 1) + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + (∀ (y : Real × Real), F y = (b.1 - a.1) * (y.2 - a.2) - (y.1 - a.1) * (b.2 - a.2)) → (∀ (y : + Real × Real), (y ∈ segment Real a b) → (F y = 0)) := by + classical + intro n p i a b F hFexplicit y hy + rw [segment_eq_image] at hy + rcases hy with ⟨u, hu, rfl⟩ + rw [hFexplicit] + simp [sub_smul] + ring + +private theorem hecoord : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let a := p.vertex i + let b := p.vertex (i + 1) + (a ≠ b) → ((b.1 - a.1 ≠ 0) ∨ (b.2 - a.2 ≠ 0)) := by + classical + intro n p i a b hab + by_contra h + push Not at h + rcases h with ⟨h1, h2⟩ + apply hab + apply Prod.ext <;> linarith + +private theorem hQcont : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let a := p.vertex i + let b := p.vertex (i + 1) + let Q : (Real × Real) → Real := fun y => + if b.1 - a.1 = 0 then (y.2 - a.2) / (b.2 - a.2) + else (y.1 - a.1) / (b.1 - a.1) + ((b.1 - a.1 ≠ 0) ∨ (b.2 - a.2 ≠ 0)) → (Continuous Q) := by + classical + intro n p i a b Q hecoord + dsimp [Q] + split_ifs with hfirst + · have hsecond : b.2 - a.2 ≠ 0 := by + rcases hecoord with h | h + · exact False.elim (h hfirst) + · exact h + apply Continuous.div + · fun_prop + · exact continuous_const + · intro y + exact hsecond + · have hfirst' : b.1 - a.1 ≠ 0 := by + exact hfirst + apply Continuous.div + · fun_prop + · exact continuous_const + · intro y + exact hfirst' + +private theorem hQx : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (q : ℝ), (x.1 = a.1 + q * (b.1 - a.1)) → ((x.2 = a.2 + q * (b.2 - a.2)) → ( + let Q : (Real × Real) → Real := fun y => + if b.1 - a.1 = 0 then (y.2 - a.2) / (b.2 - a.2) + else (y.1 - a.1) / (b.1 - a.1) + ((b.1 - a.1 ≠ 0) ∨ (b.2 - a.2 ≠ 0)) → (Q x = q))) := by + classical + intro n p i x a b q hx1 hx2 Q hecoord + dsimp [Q] + split_ifs with hfirst + · have hsecond : b.2 - a.2 ≠ 0 := by + rcases hecoord with h | h + · exact False.elim (h hfirst) + · exact h + apply (div_eq_iff hsecond).2 + rw [hx2] + ring + · have hfirst' : b.1 - a.1 ≠ 0 := by + exact hfirst + apply (div_eq_iff hfirst').2 + rw [hx1] + ring + +private theorem hQline : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let a := p.vertex i + let b := p.vertex (i + 1) + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + (∀ (y : Real × Real), F y = (b.1 - a.1) * (y.2 - a.2) - (y.1 - a.1) * (b.2 - a.2)) → ( + let Q : (Real × Real) → Real := fun y => + if b.1 - a.1 = 0 then (y.2 - a.2) / (b.2 - a.2) + else (y.1 - a.1) / (b.1 - a.1) + ((b.1 - a.1 ≠ 0) ∨ (b.2 - a.2 ≠ 0)) → (∀ (y : Real × Real), (F y = 0) → (y = a + Q y • (b - + a)))) := by + classical + intro n p i a b F hFexplicit Q hecoord y hFy + have hF' := hFexplicit y + rw [hFy] at hF' + by_cases hfirst : b.1 - a.1 = 0 + · have hsecond : b.2 - a.2 ≠ 0 := by + rcases hecoord with h | h + · exact False.elim (h hfirst) + · exact h + have hQmul : Q y * (b.2 - a.2) = y.2 - a.2 := by + rw [show Q y = (y.2 - a.2) / (b.2 - a.2) by simp [Q, hfirst]] + field_simp [hsecond] + have hy1 : y.1 = a.1 := by + have : (y.1 - a.1) * (b.2 - a.2) = 0 := by + simp? [hfirst] at hF' + rcases hF' with h | h + · rw [h] + ring + · exact (hsecond h).elim + rcases mul_eq_zero.mp this with h | h + · linarith + · exact (hsecond h).elim + apply Prod.ext + · simp [Prod.fst_add, Prod.fst_sub, hfirst, hy1] + · simp [Prod.snd_add, Prod.snd_sub] + nlinarith [hQmul] + · have hfirst' : b.1 - a.1 ≠ 0 := by + intro h + exact hfirst h + have hQmul : Q y * (b.1 - a.1) = y.1 - a.1 := by + rw [show Q y = (y.1 - a.1) / (b.1 - a.1) by simp [Q, hfirst]] + field_simp [hfirst'] + have hy2 : y.2 - a.2 = Q y * (b.2 - a.2) := by + have : (b.1 - a.1) * (y.2 - a.2) = + (y.1 - a.1) * (b.2 - a.2) := by + nlinarith [hF'] + rw [← hQmul] at this + field_simp [hfirst'] at this + exact this + apply Prod.ext + · simp [Prod.fst_add, Prod.fst_sub] + nlinarith [hQmul] + · simp [Prod.snd_add, Prod.snd_sub] + nlinarith [hy2] + +private theorem hQlineopen : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let a := p.vertex i + let b := p.vertex (i + 1) + let Q : (Real × Real) → Real := fun y => + if b.1 - a.1 = 0 then (y.2 - a.2) / (b.2 - a.2) + else (y.1 - a.1) / (b.1 - a.1) + (Continuous Q) → ( + let Qline : Set (Real × Real) := {y | 0 < Q y ∧ Q y < 1} + IsOpen Qline) := by + classical + intro n p i a b Q hQcont Qline + dsimp [Qline] + simpa only [Set.ofPred_and] using (isOpen_lt + (continuous_const : Continuous fun _ : Real × Real => (0 : Real)) hQcont).inter + (isOpen_lt hQcont (continuous_const : Continuous fun _ : Real × Real => (1 : Real))) + +private theorem hxQline : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (q : ℝ), (q ∈ Set.Ioo (0 : ℝ) (1 : ℝ)) → ( + let Q : (Real × Real) → Real := fun y => + if b.1 - a.1 = 0 then (y.2 - a.2) / (b.2 - a.2) + else (y.1 - a.1) / (b.1 - a.1) + (Q x = q) → ( + let Qline : Set (Real × Real) := {y | 0 < Q y ∧ Q y < 1} + x ∈ Qline)) := by + classical + intro n p i x a b q hq Q hQx Qline + simp [Qline, hQx, hq.1, hq.2] + +private theorem hcontg : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (d : ℝ × ℝ), + let g : Fin (n + 3) → (Real × Real) → Real := fun j y => + d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 + ∀ (j : Fin (n + 3)), Continuous (g j) := by + classical + intro n p d g j + dsimp [g] + fun_prop + +private theorem hGopen : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (d : ℝ × ℝ), + let g : Fin (n + 3) → (Real × Real) → Real := fun j y => + d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 + (∀ (j : Fin (n + 3)), Continuous (g j)) → ( + let G : Fin (n + 3) → Set (Real × Real) := fun j => + {y | g j y < 0} ∪ {y | 0 < g j y} + ∀ (j : Fin (n + 3)), IsOpen (G j)) := by + classical + intro n p d g hcontg G j + dsimp [G] + exact (isOpen_lt (hcontg j) continuous_const).union + (isOpen_lt (continuous_const : Continuous fun _ : Real × Real => (0 : Real)) (hcontg j)) + +private theorem hGmem : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (x : Real × Real), ∀ (d : ℝ × ℝ), (∀ (i : + Fin (n + (3 : ℕ))), d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ (0 : ℝ)) → ( + let g : Fin (n + 3) → (Real × Real) → Real := fun j y => + d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 + let G : Fin (n + 3) → Set (Real × Real) := fun j => + {y | g j y < 0} ∪ {y | 0 < g j y} + ∀ j, x ∈ G j) := by + classical + intro n p x d hdv g G j + have hj := hdv j + have hj' : g j x ≠ 0 := by simpa [g] using hj + rcases lt_or_gt_of_ne (Ne.symm hj') with hpos | hneg + · exact Or.inr hpos + · exact Or.inl hneg + +private theorem hGallopen : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (d : ℝ × ℝ), + let g : Fin (n + 3) → (Real × Real) → Real := fun j y => + d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 + let G : Fin (n + 3) → Set (Real × Real) := fun j => + {y | g j y < 0} ∪ {y | 0 < g j y} + (∀ (j : Fin (n + 3)), IsOpen (G j)) → ( + let Gall : Set (Real × Real) := ⋂ j, G j + IsOpen Gall) := by + classical + intro n p d g G hGopen Gall + dsimp [Gall] + exact isOpen_iInter_of_finite hGopen + +private theorem hxGall : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (x : Real × Real), ∀ (d : ℝ × ℝ), + let g : Fin (n + 3) → (Real × Real) → Real := fun j y => + d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 + let G : Fin (n + 3) → Set (Real × Real) := fun j => + {y | g j y < 0} ∪ {y | 0 < g j y} + (∀ j, x ∈ G j) → ( + let Gall : Set (Real × Real) := ⋂ j, G j + x ∈ Gall) := by + classical + intro n p x d g G hGmem Gall + exact Set.mem_iInter.mpr hGmem + +private theorem hNopen : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + let V : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then {y | 0 < U j y ∧ U j y < 1} + else if U j x < 0 then {y | U j y < 0} + else if 1 < U j x then {y | 1 < U j y} + else if 0 < T j x then {y | 0 < T j y ∧ 0 < U j y ∧ U j y < 1} + else {y | T j y < 0 ∧ 0 < U j y ∧ U j y < 1} + let Vall : Set (Real × Real) := ⋂ j, V j + (IsOpen Vall) → ( + let W : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then Set.univ else (segment Real (p.vertex j) (p.vertex (j + 1)))ᶜ + let Wall : Set (Real × Real) := ⋂ j, W j + (IsOpen Wall) → ( + let Q : (Real × Real) → Real := fun y => + if b.1 - a.1 = 0 then (y.2 - a.2) / (b.2 - a.2) + else (y.1 - a.1) / (b.1 - a.1) + let Qline : Set (Real × Real) := {y | 0 < Q y ∧ Q y < 1} + (IsOpen Qline) → ( + let g : Fin (n + 3) → (Real × Real) → Real := fun j y => + d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 + let G : Fin (n + 3) → Set (Real × Real) := fun j => + {y | g j y < 0} ∪ {y | 0 < g j y} + let Gall : Set (Real × Real) := ⋂ j, G j + (IsOpen Gall) → ( + let N : Set (Real × Real) := Vall ∩ (Wall ∩ (Qline ∩ Gall)) + IsOpen N)))) := by + classical + intro n p i x a b d D T U V Vall hVallopen W Wall hWallopen Q Qline hQlineopen g G Gall + hGallopen N + exact hVallopen.inter (hWallopen.inter (hQlineopen.inter hGallopen)) + +private theorem hxN : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + let V : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then {y | 0 < U j y ∧ U j y < 1} + else if U j x < 0 then {y | U j y < 0} + else if 1 < U j x then {y | 1 < U j y} + else if 0 < T j x then {y | 0 < T j y ∧ 0 < U j y ∧ U j y < 1} + else {y | T j y < 0 ∧ 0 < U j y ∧ U j y < 1} + let Vall : Set (Real × Real) := ⋂ j, V j + (x ∈ Vall) → ( + let W : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then Set.univ else (segment Real (p.vertex j) (p.vertex (j + 1)))ᶜ + let Wall : Set (Real × Real) := ⋂ j, W j + (x ∈ Wall) → ( + let Q : (Real × Real) → Real := fun y => + if b.1 - a.1 = 0 then (y.2 - a.2) / (b.2 - a.2) + else (y.1 - a.1) / (b.1 - a.1) + let Qline : Set (Real × Real) := {y | 0 < Q y ∧ Q y < 1} + (x ∈ Qline) → ( + let g : Fin (n + 3) → (Real × Real) → Real := fun j y => + d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 + let G : Fin (n + 3) → Set (Real × Real) := fun j => + {y | g j y < 0} ∪ {y | 0 < g j y} + let Gall : Set (Real × Real) := ⋂ j, G j + (x ∈ Gall) → ( + let N : Set (Real × Real) := Vall ∩ (Wall ∩ (Qline ∩ Gall)) + x ∈ N)))) := by + classical + intro n p i x a b d D T U V Vall hxVall W Wall hxWall Q Qline hxQline g G Gall hxGall N + exact ⟨hxVall, ⟨hxWall, ⟨hxQline, hxGall⟩⟩⟩ + +private theorem hcarrier : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + let V : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then {y | 0 < U j y ∧ U j y < 1} + else if U j x < 0 then {y | U j y < 0} + else if 1 < U j x then {y | 1 < U j y} + else if 0 < T j x then {y | 0 < T j y ∧ 0 < U j y ∧ U j y < 1} + else {y | T j y < 0 ∧ 0 < U j y ∧ U j y < 1} + let Vall : Set (Real × Real) := ⋂ j, V j + let W : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then Set.univ else (segment Real (p.vertex j) (p.vertex (j + 1)))ᶜ + let Wall : Set (Real × Real) := ⋂ j, W j + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + (∀ (y : Real × Real), (y ∈ segment Real a b) → (F y = 0)) → ( + let Q : (Real × Real) → Real := fun y => + if b.1 - a.1 = 0 then (y.2 - a.2) / (b.2 - a.2) + else (y.1 - a.1) / (b.1 - a.1) + (∀ (y : Real × Real), (F y = 0) → (y = a + Q y • (b - a))) → ( + let Qline : Set (Real × Real) := {y | 0 < Q y ∧ Q y < 1} + let g : Fin (n + 3) → (Real × Real) → Real := fun j y => + d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 + let G : Fin (n + 3) → Set (Real × Real) := fun j => + {y | g j y < 0} ∪ {y | 0 < g j y} + let Gall : Set (Real × Real) := ⋂ j, G j + let N : Set (Real × Real) := Vall ∩ (Wall ∩ (Qline ∩ Gall)) + ∀ (rN : ℝ), (Metric.ball x rN ⊆ N) → (∀ (y : Real × Real), (y ∈ Metric.ball x rN) → (y ∈ + P3544T1BoundaryCarrier p ↔ F y = 0)))) := by + classical + intro n p i x a b d D T U V Vall W Wall F hsegF Q hQline Qline g G Gall N rN hballN y hy + have hyN := hballN hy + constructor + · intro hc + obtain ⟨j, hj⟩ := Set.mem_iUnion.mp hc + have hyWall : y ∈ Wall := hyN.2.1 + have hyWj := Set.mem_iInter.mp hyWall j + by_cases hji : j = i + · subst j + exact hsegF y hj + · have hcompl : y ∈ (segment Real (p.vertex j) (p.vertex (j + 1)))ᶜ := by + simpa [W, hji] using hyWj + exact False.elim (hcompl hj) + · intro hFy + have hyQ : y ∈ Qline := hyN.2.2.1 + rcases hyQ with ⟨hQlo, hQhi⟩ + have hline := hQline y hFy + have hyseg : y ∈ segment Real a b := by + rw [segment_eq_image] + let u := Q y + have hline' : y = a + u • (b - a) := by simpa [u] using hline + refine ⟨u, ⟨by simpa [u] using hQlo.le, by simpa [u] using hQhi.le⟩, ?_⟩ + calc + (1 - u) • a + u • b = a + u • (b - a) := by + apply Prod.ext <;> simp [smul_sub, sub_smul] <;> ring + _ = y := hline'.symm + exact Set.mem_iUnion.mpr ⟨i, hyseg⟩ + +private theorem hgenericY : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + let V : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then {y | 0 < U j y ∧ U j y < 1} + else if U j x < 0 then {y | U j y < 0} + else if 1 < U j x then {y | 1 < U j y} + else if 0 < T j x then {y | 0 < T j y ∧ 0 < U j y ∧ U j y < 1} + else {y | T j y < 0 ∧ 0 < U j y ∧ U j y < 1} + let Vall : Set (Real × Real) := ⋂ j, V j + let W : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then Set.univ else (segment Real (p.vertex j) (p.vertex (j + 1)))ᶜ + let Wall : Set (Real × Real) := ⋂ j, W j + let Q : (Real × Real) → Real := fun y => + if b.1 - a.1 = 0 then (y.2 - a.2) / (b.2 - a.2) + else (y.1 - a.1) / (b.1 - a.1) + let Qline : Set (Real × Real) := {y | 0 < Q y ∧ Q y < 1} + let g : Fin (n + 3) → (Real × Real) → Real := fun j y => + d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 + let G : Fin (n + 3) → Set (Real × Real) := fun j => + {y | g j y < 0} ∪ {y | 0 < g j y} + let Gall : Set (Real × Real) := ⋂ j, G j + let N : Set (Real × Real) := Vall ∩ (Wall ∩ (Qline ∩ Gall)) + ∀ (rN : ℝ), (Metric.ball x rN ⊆ N) → (∀ (y : Real × Real), (y ∈ Metric.ball x rN) → (∀ j, d.1 + * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 ≠ 0)) := by + classical + intro n p i x a b d D T U V Vall W Wall Q Qline g G Gall N rN hballN y hy + have hyGall : y ∈ Gall := (hballN hy).2.2.2 + intro j + have hGj := Set.mem_iInter.mp hyGall j + have hg : g j y < 0 ∨ 0 < g j y := by simpa [G] using hGj + rcases hg with h | h + · simpa [g] using (ne_of_lt h) + · simpa [g] using (ne_of_gt h) + +private theorem hparity : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (d : ℝ × ℝ), (∀ (i : Fin (n + (3 : ℕ))), + d.1 * (p.vertex (i + (1 : Fin (n + (3 : ℕ)))) - p.vertex i).2 - d.2 * (p.vertex (i + (1 : + Fin (n + (3 : ℕ)))) - p.vertex i).1 ≠ (0 : ℝ)) → (∀ (y : Real × Real), (y ∉ + P3544T1BoundaryCarrier p) → ((∀ j, d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 + ≠ 0) → ((y ∈ P3544T1RayParity p ↔ + Set.ncard {j : Fin (n + 3) | ∃ t : Real, 0 < t ∧ + y + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))} % 2 = 1)))) := by + classical + intro n p d hde y hyC hgv + constructor + · rintro ⟨_, d', hdv', hde', hodd⟩ + exact (P3597T1DirectionParity p y d d' hyC hgv hdv').trans hodd + · intro hodd + exact ⟨hyC, d, hgv, hde, hodd⟩ + +private theorem hparamY : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + (∀ j, D j ≠ 0) → (∀ (y : ℝ × ℝ), ∀ (j : Fin (n + (3 : ℕ))), have t := + ((p.vertex j - y).1 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).1) / + (d.1 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).2 - + d.2 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).1); + have u := + ((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / + (d.1 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).2 - + d.2 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).1); + y + t • d = p.vertex j + u • (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j) ∧ + (∀ (t' : ℝ), ∀ (u' : ℝ), y + t' • d = p.vertex j + u' • (p.vertex (j + (1 : Fin (n + (3 : + ℕ)))) - p.vertex j) → t' = t ∧ u' = u) ∧ + ((∃ (t' : ℝ), (0 : ℝ) < t' ∧ y + t' • d ∈ segment ℝ (p.vertex j) (p.vertex (j + (1 : Fin (n + + (3 : ℕ)))))) ↔ + (0 : ℝ) < t ∧ (0 : ℝ) ≤ u ∧ u ≤ (1 : ℝ))) := by + classical + intro n p d D hD y j + exact (P3597T1GenericRayStability p).2.2 y d j (hD j) + +private theorem hiffX : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (x : Real × Real), ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + (∀ (j : Fin (n + (3 : ℕ))), have t := ((p.vertex j - x).1 * (p.vertex (j + (1 : Fin (n + (3 : + ℕ)))) - p.vertex j).2 - (p.vertex j - x).2 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - + p.vertex j).1) / (d.1 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).2 - d.2 * + (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).1); have u := ((p.vertex j - x).1 * + d.2 - (p.vertex j - x).2 * d.1) / (d.1 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - + p.vertex j).2 - d.2 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).1); x + t • d + = p.vertex j + u • (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j) ∧ (∀ (t' : ℝ), ∀ + (u' : ℝ), x + t' • d = p.vertex j + u' • (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - + p.vertex j) → t' = t ∧ u' = u) ∧ ((∃ (t' : ℝ), (0 : ℝ) < t' ∧ x + t' • d ∈ segment ℝ + (p.vertex j) (p.vertex (j + (1 : Fin (n + (3 : ℕ)))))) ↔ (0 : ℝ) < t ∧ (0 : ℝ) ≤ u ∧ u ≤ + (1 : ℝ))) → (∀ (j : Fin (n + 3)), (∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex + j) (p.vertex (j + 1))) ↔ + 0 < T j x ∧ 0 ≤ U j x ∧ U j x ≤ 1) := by + classical + intro n p x d D T U hparam j + simpa [T, U, D] using (hparam j).2.2 + +private theorem hiffY : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + (∀ (y : ℝ × ℝ), ∀ (j : Fin (n + (3 : ℕ))), have t := ((p.vertex j - y).1 * (p.vertex (j + (1 + : Fin (n + (3 : ℕ)))) - p.vertex j).2 - (p.vertex j - y).2 * (p.vertex (j + (1 : Fin (n + + (3 : ℕ)))) - p.vertex j).1) / (d.1 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex + j).2 - d.2 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j).1); have u := + ((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / (d.1 * (p.vertex (j + (1 : Fin (n + + (3 : ℕ)))) - p.vertex j).2 - d.2 * (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex + j).1); y + t • d = p.vertex j + u • (p.vertex (j + (1 : Fin (n + (3 : ℕ)))) - p.vertex j) + ∧ (∀ (t' : ℝ), ∀ (u' : ℝ), y + t' • d = p.vertex j + u' • (p.vertex (j + (1 : Fin (n + (3 + : ℕ)))) - p.vertex j) → t' = t ∧ u' = u) ∧ ((∃ (t' : ℝ), (0 : ℝ) < t' ∧ y + t' • d ∈ + segment ℝ (p.vertex j) (p.vertex (j + (1 : Fin (n + (3 : ℕ)))))) ↔ (0 : ℝ) < t ∧ (0 : ℝ) + ≤ u ∧ u ≤ (1 : ℝ))) → (∀ (y : Real × Real), ∀ (j : Fin (n + 3)), (∃ t : Real, 0 < t ∧ y + + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))) ↔ + 0 < T j y ∧ 0 ≤ U j y ∧ U j y ≤ 1) := by + classical + intro n p d D T U hparamY y j + simpa [T, U, D] using (hparamY y j).2.2 + +private theorem hpred : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + (∀ (j : Fin (n + 3)), U j x ≠ 0) → ((∀ (j : Fin (n + 3)), U j x ≠ 1) → ((∀ (j : Fin (n + 3)), + (j ≠ i) → ((0 < U j x ∧ U j x < 1) → (T j x ≠ 0))) → ( + let V : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then {y | 0 < U j y ∧ U j y < 1} + else if U j x < 0 then {y | U j y < 0} + else if 1 < U j x then {y | 1 < U j y} + else if 0 < T j x then {y | 0 < T j y ∧ 0 < U j y ∧ U j y < 1} + else {y | T j y < 0 ∧ 0 < U j y ∧ U j y < 1} + let Vall : Set (Real × Real) := ⋂ j, V j + let W : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then Set.univ else (segment Real (p.vertex j) (p.vertex (j + 1)))ᶜ + let Wall : Set (Real × Real) := ⋂ j, W j + let Q : (Real × Real) → Real := fun y => + if b.1 - a.1 = 0 then (y.2 - a.2) / (b.2 - a.2) + else (y.1 - a.1) / (b.1 - a.1) + let Qline : Set (Real × Real) := {y | 0 < Q y ∧ Q y < 1} + let g : Fin (n + 3) → (Real × Real) → Real := fun j y => + d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 + let G : Fin (n + 3) → Set (Real × Real) := fun j => + {y | g j y < 0} ∪ {y | 0 < g j y} + let Gall : Set (Real × Real) := ⋂ j, G j + let N : Set (Real × Real) := Vall ∩ (Wall ∩ (Qline ∩ Gall)) + ∀ (rN : ℝ), (Metric.ball x rN ⊆ N) → ((∀ (j : Fin (n + 3)), (∃ t : Real, 0 < t ∧ x + t • d ∈ + segment Real (p.vertex j) (p.vertex (j + 1))) ↔ 0 < T j x ∧ 0 ≤ U j x ∧ U j x ≤ 1) → ((∀ + (y : Real × Real), ∀ (j : Fin (n + 3)), (∃ t : Real, 0 < t ∧ y + t • d ∈ segment Real + (p.vertex j) (p.vertex (j + 1))) ↔ 0 < T j y ∧ 0 ≤ U j y ∧ U j y ≤ 1) → (∀ (y : Real × + Real), (y ∈ Metric.ball x rN) → (∀ (j : Fin (n + 3)), (j ≠ i) → (((∃ t : Real, 0 < t ∧ y + + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))) ↔ + (∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1)))))))))))) + := by + classical + intro n p i x a b d D T U hUzero hUone hTne V Vall W Wall Q Qline g G Gall N rN hballN hiffX + hiffY y hy j hji + have hyVall : y ∈ Vall := (hballN hy).1 + have hyVj := Set.mem_iInter.mp hyVall j + rw [hiffY y j, hiffX j] + by_cases hu0 : U j x < 0 + · have hyU : U j y < 0 := by simpa [V, hji, hu0] using hyVj + constructor <;> rintro ⟨ht, hU, hU1⟩ + · exact False.elim (not_le_of_gt hyU hU) + · exact False.elim (not_le_of_gt hu0 hU) + · by_cases hu1 : 1 < U j x + · have hyU : 1 < U j y := by simpa [V, hji, hu0, hu1] using hyVj + constructor <;> rintro ⟨ht, hU, hU1⟩ + · exact False.elim (not_le_of_gt hyU hU1) + · exact False.elim (not_le_of_gt hu1 hU1) + · have hinside : 0 < U j x ∧ U j x < 1 := by + constructor + · exact lt_of_le_of_ne (le_of_not_gt hu0) (Ne.symm (hUzero j)) + · exact lt_of_le_of_ne (le_of_not_gt hu1) (hUone j) + by_cases ht : 0 < T j x + · have hycond : 0 < T j y ∧ 0 < U j y ∧ U j y < 1 := by + simpa [V, hji, hu0, hu1, ht] using hyVj + constructor + · intro h + exact ⟨ht, hinside.1.le, hinside.2.le⟩ + · intro h + exact ⟨hycond.1, hycond.2.1.le, hycond.2.2.le⟩ + · have ht' : T j x < 0 := lt_of_le_of_ne (le_of_not_gt ht) (hTne j hji hinside) + have hycond : T j y < 0 ∧ 0 < U j y ∧ U j y < 1 := by + simpa [V, hji, hu0, hu1, ht] using hyVj + constructor + · rintro ⟨hty, _, _⟩ + exact False.elim (not_lt_of_ge (le_of_lt hycond.1) hty) + · rintro ⟨htx, _, _⟩ + exact False.elim (ht htx) + +private theorem hcardSplit : + ∀ (n : Nat), ∀ (i : Fin (n + 3)), ∀ (A : Fin (n + 3) → Prop), Set.ncard {j | A j} = Set.ncard + ({j | A j} \ {i}) + @ite Nat (A i) (Classical.propDecidable _) 1 0 := by + classical + intro n i A + by_cases hi : A i + · have hs : {j | A j} = insert i ({j | A j} \ {i}) := by + ext j + by_cases hji : j = i <;> simp [hji, hi] + rw [hs, Set.ncard_insert_of_notMem (by simp)] + simp [hi] + · have hs : {j | A j} = {j | A j} \ {i} := by + ext j + simp [hi] + rw [hs] + simp [hi] + +private theorem hrest : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), ∀ + (d : ℝ × ℝ), ∀ (rN : ℝ), (∀ (y : Real × Real), (y ∈ Metric.ball x rN) → (∀ (j : Fin (n + + 3)), (j ≠ i) → (((∃ t : Real, 0 < t ∧ y + t • d ∈ segment Real (p.vertex j) (p.vertex (j + + 1))) ↔ (∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex j) (p.vertex (j + + 1))))))) → ( + let S : (Real × Real) → Set (Fin (n + 3)) := fun z => {j | ∃ t : Real, 0 < t ∧ + z + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))} + ∀ (y : Real × Real), (y ∈ Metric.ball x rN) → (S y \ {i} = S x \ {i})) := by + classical + intro n p i x d rN hpred S y hy + ext j + by_cases hji : j = i + · simp [hji] + · simp only [Set.mem_sdiff, Set.mem_singleton_iff] + constructor + · rintro ⟨hmem, hne⟩ + exact ⟨(hpred y hy j hji).mp hmem, hne⟩ + · rintro ⟨hmem, hne⟩ + exact ⟨(hpred y hy j hji).mpr hmem, hne⟩ + +private theorem hiX : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + (T i x = 0) → ((∀ (j : Fin (n + 3)), (∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex + j) (p.vertex (j + 1))) ↔ 0 < T j x ∧ 0 ≤ U j x ∧ U j x ≤ 1) → ( + let S : (Real × Real) → Set (Fin (n + 3)) := fun z => {j | ∃ t : Real, 0 < t ∧ + z + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))} + i ∉ S x)) := by + classical + intro n p i x d D T U hTi hiffX S + let a := p.vertex i + let b := p.vertex (i + 1) + change ¬ (∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real a b) + rw [hiffX i] + simp [hTi] + +private theorem hiY : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + let V : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then {y | 0 < U j y ∧ U j y < 1} + else if U j x < 0 then {y | U j y < 0} + else if 1 < U j x then {y | 1 < U j y} + else if 0 < T j x then {y | 0 < T j y ∧ 0 < U j y ∧ U j y < 1} + else {y | T j y < 0 ∧ 0 < U j y ∧ U j y < 1} + let Vall : Set (Real × Real) := ⋂ j, V j + let W : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then Set.univ else (segment Real (p.vertex j) (p.vertex (j + 1)))ᶜ + let Wall : Set (Real × Real) := ⋂ j, W j + let Q : (Real × Real) → Real := fun y => + if b.1 - a.1 = 0 then (y.2 - a.2) / (b.2 - a.2) + else (y.1 - a.1) / (b.1 - a.1) + let Qline : Set (Real × Real) := {y | 0 < Q y ∧ Q y < 1} + let g : Fin (n + 3) → (Real × Real) → Real := fun j y => + d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 + let G : Fin (n + 3) → Set (Real × Real) := fun j => + {y | g j y < 0} ∪ {y | 0 < g j y} + let Gall : Set (Real × Real) := ⋂ j, G j + let N : Set (Real × Real) := Vall ∩ (Wall ∩ (Qline ∩ Gall)) + ∀ (rN : ℝ), (Metric.ball x rN ⊆ N) → ((∀ (y : Real × Real), ∀ (j : Fin (n + 3)), (∃ t : Real, + 0 < t ∧ y + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))) ↔ 0 < T j y ∧ 0 ≤ U j y + ∧ U j y ≤ 1) → ( + let S : (Real × Real) → Set (Fin (n + 3)) := fun z => {j | ∃ t : Real, 0 < t ∧ + z + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))} + ∀ (y : Real × Real), (y ∈ Metric.ball x rN) → ((i ∈ S y ↔ 0 < T i y)))) := by + classical + intro n p i x a b d D T U V Vall W Wall Q Qline g G Gall N rN hballN hiffY S y hy + change ((∃ t : Real, 0 < t ∧ y + t • d ∈ segment Real a b) ↔ 0 < T i y) + rw [hiffY y i] + have hyVi := Set.mem_iInter.mp ((hballN hy).1) i + have hUy : 0 < U i y ∧ U i y < 1 := by + simpa [V] using hyVi + constructor + · rintro ⟨ht, _, _⟩ + exact ht + · intro ht + exact ⟨ht, hUy.1.le, hUy.2.le⟩ + +private theorem hcount : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), ∀ + (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + ∀ (rN : ℝ), (∀ (A : Fin (n + 3) → Prop), Set.ncard {j | A j} = Set.ncard ({j | A j} \ {i}) + + @ite Nat (A i) (Classical.propDecidable _) 1 0) → ( + let S : (Real × Real) → Set (Fin (n + 3)) := fun z => {j | ∃ t : Real, 0 < t ∧ + z + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))} + (∀ (y : Real × Real), (y ∈ Metric.ball x rN) → (S y \ {i} = S x \ {i})) → ((i ∉ S x) → ((∀ (y + : Real × Real), (y ∈ Metric.ball x rN) → ((i ∈ S y ↔ 0 < T i y))) → (∀ (y : Real × Real), + (y ∈ Metric.ball x rN) → ((S y).ncard = (S x).ncard + if 0 < T i y then 1 else 0))))) := by + classical + intro n p i x d D T rN hcardSplit S hrest hiX hiY y hy + change {j : Fin (n + 3) | j ∈ S y}.ncard = + {j : Fin (n + 3) | j ∈ S x}.ncard + if 0 < T i y then 1 else 0 + rw [hcardSplit (fun j => j ∈ S y), hcardSplit (fun j => j ∈ S x)] + have hrest' : ({j : Fin (n + 3) | j ∈ S y} \ {i}) = + ({j : Fin (n + 3) | j ∈ S x} \ {i}) := by + exact hrest y hy + rw [hrest', ite_eq_right hiX] + simp only [add_zero] + rw [hiY y hy] + +private theorem hTformula : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + (∀ (y : Real × Real), F y = (b.1 - a.1) * (y.2 - a.2) - (y.1 - a.1) * (b.2 - a.2)) → (∀ (y : + Real × Real), T i y = F y / D i) := by + classical + intro n p i a b d D T F hFexplicit y + rw [hFexplicit] + dsimp [T, D] + simp only [show p.vertex (i + 1) = b by rfl, show p.vertex i = a by rfl] + congr 1; ring + +private theorem hmulF : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + (∀ j, D j ≠ 0) → ( + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + (∀ (y : Real × Real), T i y = F y / D i) → (∀ (y : Real × Real), F y = T i y * D i)) := by + classical + intro n p i a b d D T hD F hTformula y + rw [hTformula y] + field_simp [hD i] + + +private theorem hsignPosPos : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + (∀ (y : Real × Real), F y = T i y * D i) → (∀ (y : Real × Real), (0 < D i) → ((0 < T i y ↔ 0 + < F y))) := by + classical + intro n p i a b d D T F hmulF y hDpos + constructor + · intro ht + have hp := mul_pos ht hDpos + rw [← hmulF y] at hp + exact hp + · intro hF + by_contra hT + have hTle : T i y ≤ 0 := le_of_not_gt hT + have hp := mul_nonpos_of_nonpos_of_nonneg hTle hDpos.le + rw [← hmulF y] at hp + linarith + +private theorem hsignPosNeg : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + (∀ (y : Real × Real), F y = T i y * D i) → (∀ (y : Real × Real), (D i < 0) → ((0 < T i y ↔ F + y < 0))) := by + classical + intro n p i a b d D T F hmulF y hDneg + constructor + · intro ht + have hn := mul_neg_of_pos_of_neg ht hDneg + rw [← hmulF y] at hn + exact hn + · intro hF + by_contra hT + have hTle : T i y ≤ 0 := le_of_not_gt hT + have hp := mul_nonneg_of_nonpos_of_nonpos hTle (le_of_lt hDneg) + rw [← hmulF y] at hp + linarith + +private theorem hsignNegPos : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + (∀ (y : Real × Real), F y = T i y * D i) → (∀ (y : Real × Real), (0 < D i) → ((T i y < 0 ↔ F + y < 0))) := by + classical + intro n p i a b d D T F hmulF y hDpos + constructor + · intro ht + have hn := mul_neg_of_neg_of_pos ht hDpos + rw [← hmulF y] at hn + exact hn + · intro hF + by_contra hT + have hTnonneg : 0 ≤ T i y := le_of_not_gt hT + have hp := mul_nonneg hTnonneg hDpos.le + rw [← hmulF y] at hp + linarith + +private theorem hsignNegNeg : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + (∀ (y : Real × Real), F y = T i y * D i) → (∀ (y : Real × Real), (D i < 0) → ((T i y < 0 ↔ 0 + < F y))) := by + classical + intro n p i a b d D T F hmulF y hDneg + constructor + · intro ht + have htn : 0 < -T i y := by linarith + have hdn : 0 < -D i := by linarith + have hp := mul_pos htn hdn + have heq : (-T i y) * (-D i) = F y := by + calc + (-T i y) * (-D i) = T i y * D i := by ring + _ = F y := (hmulF y).symm + rw [heq] at hp + exact hp + · intro hF + by_contra hT + have hTnonneg : 0 ≤ T i y := le_of_not_gt hT + have hp := mul_nonpos_of_nonneg_of_nonpos hTnonneg (le_of_lt hDneg) + rw [← hmulF y] at hp + linarith + +private theorem hDpositive : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + (∀ j, D j ≠ 0) → (0 < D i ∨ D i < 0) := by + classical + intro n p i d D hD + exact lt_or_gt_of_ne (Ne.symm (hD i)) + +private theorem hlocal : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + ∀ (rN : ℝ), (∀ (y : Real × Real), (y ∈ Metric.ball x rN) → (y ∈ P3544T1BoundaryCarrier p ↔ + F y = 0)) → ((∀ (y : Real × Real), (y ∈ Metric.ball x rN) → (∀ j, d.1 * (p.vertex j - + y).2 - d.2 * (p.vertex j - y).1 ≠ 0)) → ((∀ (y : Real × Real), (y ∉ + P3544T1BoundaryCarrier p) → ((∀ j, d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 + ≠ 0) → ((y ∈ P3544T1RayParity p ↔ Set.ncard {j : Fin (n + 3) | ∃ t : Real, 0 < t ∧ y + + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))} % 2 = 1)))) → ( + let S : (Real × Real) → Set (Fin (n + 3)) := fun z => {j | ∃ t : Real, 0 < t ∧ + z + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))} + (∀ (y : Real × Real), (y ∈ Metric.ball x rN) → ((i ∈ S y ↔ 0 < T i y))) → ((∀ (y : Real × + Real), (y ∈ Metric.ball x rN) → ((S y).ncard = (S x).ncard + if 0 < T i y then 1 else 0)) + → ((∀ (y : Real × Real), F y = T i y * D i) → ((∀ (y : Real × Real), (0 < D i) → ((0 < T + i y ↔ 0 < F y))) → ((∀ (y : Real × Real), (D i < 0) → ((0 < T i y ↔ F y < 0))) → ((∀ (y : + Real × Real), (0 < D i) → ((T i y < 0 ↔ F y < 0))) → ((∀ (y : Real × Real), (D i < 0) → + ((T i y < 0 ↔ 0 < F y))) → ((0 < D i ∨ D i < 0) → ( + let s : Bool := + if (S x).ncard % 2 = 0 then decide (0 < D i) else decide (D i < 0) + ∀ (y : Real × Real), (y ∈ Metric.ball x rN) → ((y ∈ P3544T1RayParity p ↔ if s then 0 < F y + else F y < 0))))))))))))) := by + classical + intro n p i x a b d D T F rN hcarrier hgenericY hparity S hiY hcount hmulF hsignPosPos + hsignPosNeg hsignNegPos hsignNegNeg hDpositive s y hy + by_cases hyC : y ∈ P3544T1BoundaryCarrier p + · have hFy := (hcarrier y hy).mp hyC + simp [P3544T1RayParity, hyC, hFy, s] + · have hFy : F y ≠ 0 := by + intro h + exact hyC ((hcarrier y hy).mpr h) + have hg := hgenericY y hy + have hodd := hparity y hyC hg + have hcnt := hcount y hy + have hselected := hiY y hy + have hTneY : T i y ≠ 0 := by + intro ht + apply hFy + rw [hmulF y, ht] + simp + have hcountodd : (S y).ncard % 2 = 1 ↔ + if (S x).ncard % 2 = 0 then 0 < T i y else T i y < 0 := by + by_cases he : (S x).ncard % 2 = 0 + · by_cases ht : 0 < T i y + · rw [hcnt, ite_eq_left ht, he] + simp [Nat.add_mod, he, ht] + · rw [hcnt, ite_eq_right ht, he] + simp [he, ht] + · have ho : (S x).ncard % 2 = 1 := by omega + by_cases ht : 0 < T i y + · rw [hcnt, ite_eq_left ht, ho] + simp [Nat.add_mod, ho]; linarith + · rw [hcnt, ite_eq_right ht, ho] + have hTneg : T i y < 0 := lt_of_le_of_ne (le_of_not_gt ht) hTneY + simp [ho, hTneg] + have hpar : y ∈ P3544T1RayParity p ↔ + (if (S x).ncard % 2 = 0 then 0 < T i y else T i y < 0) := by + exact (hparity y hyC hg).trans hcountodd + rw [hpar] + by_cases he : (S x).ncard % 2 = 0 + · rcases hDpositive with hDpos | hDneg + · have hs : s = true := by simp [s, he, hDpos] + simpa [hs, he] using hsignPosPos y hDpos + · have hs : s = false := by simp [s, he, not_lt.mpr (le_of_lt hDneg)] + simpa [hs, he] using hsignPosNeg y hDneg + · have ho : (S x).ncard % 2 = 1 := by omega + rcases hDpositive with hDpos | hDneg + · have hs : s = false := by simp [s, ho, not_lt.mpr (le_of_lt hDpos)] + simpa [hs, ho] using hsignNegPos y hDpos + · have hs : s = true := by simp [s, ho, hDneg] + simpa [hs, ho] using hsignNegNeg y hDneg + +private theorem hnormsq : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let a := p.vertex i + let b := p.vertex (i + 1) + (a ≠ b) → (0 < (b.1 - a.1)^2 + (b.2 - a.2)^2) := by + classical + intro n p i a b hab + by_cases h1 : b.1 = a.1 + · have h2 : b.2 - a.2 ≠ 0 := by + intro he + apply hab + apply Prod.ext + · exact h1.symm + · linarith + nlinarith [sq_pos_of_ne_zero h2] + · nlinarith [sq_pos_of_ne_zero (sub_ne_zero.mpr h1)] + +private theorem hnormal : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + (x ∈ segment ℝ a b) → ( + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + (∀ (y : Real × Real), (y ∈ segment Real a b) → (F y = 0)) → (∀ (h : Real), F (x + h • (-(b.2 + - a.2), b.1 - a.1)) = + h * ((b.1 - a.1)^2 + (b.2 - a.2)^2))) := by + classical + intro n p i x a b hxseg F hsegF h + have hxF : F x = 0 := hsegF x hxseg + simp [F, P3381T1TriangleDeterminant] at hxF ⊢ + linear_combination hxF + +private theorem htransverse : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + ∀ (rN : ℝ), (rN > (0 : ℝ)) → ((0 < (b.1 - a.1)^2 + (b.2 - a.2)^2) → ((∀ (h : Real), F (x + h + • (-(b.2 - a.2), b.1 - a.1)) = h * ((b.1 - a.1)^2 + (b.2 - a.2)^2)) → (∀ (ε : Real), (0 < + ε) → (∃ y z : Real × Real, y ∈ Metric.ball x (min rN ε) ∧ + z ∈ Metric.ball x (min rN ε) ∧ 0 < F y ∧ F z < 0)))) := by + classical + intro n p i x a b F rN hrN hnormsq hnormal ε hε + let ρ := min rN ε + have hρ : 0 < ρ := lt_min hrN hε + have hc : Continuous (fun h : Real => x + h • (-(b.2 - a.2), b.1 - a.1)) := by fun_prop + obtain ⟨δ, hδ, hdist⟩ := + (Metric.continuousAt_iff.mp (hc.continuousAt (x := 0))) ρ hρ + have hp : dist (δ / 2) (0 : Real) < δ := by + rw [Real.dist_eq, sub_zero, abs_of_pos (by linarith : 0 < δ / 2)] + linarith + have hm : dist (-(δ / 2)) (0 : Real) < δ := by + rw [Real.dist_eq, sub_zero, abs_neg, abs_of_pos (by linarith : 0 < δ / 2)] + linarith + let y := x + (δ / 2) • (-(b.2 - a.2), b.1 - a.1) + let z := x + (-(δ / 2)) • (-(b.2 - a.2), b.1 - a.1) + have hyρ : y ∈ Metric.ball x ρ := by simpa [y, Metric.mem_ball] using hdist hp + have hzρ : z ∈ Metric.ball x ρ := by simpa [z, Metric.mem_ball] using hdist hm + refine ⟨y, z, hyρ, hzρ, ?_, ?_⟩ + · rw [hnormal] + exact mul_pos (by linarith) hnormsq + · rw [hnormal] + exact mul_neg_of_neg_of_pos (by linarith) hnormsq + +private theorem hclosureOdd : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + ∀ (rN : ℝ), + let S : (Real × Real) → Set (Fin (n + 3)) := fun z => {j | ∃ t : Real, 0 < t ∧ + z + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))} + let s : Bool := + if (S x).ncard % 2 = 0 then decide (0 < D i) else decide (D i < 0) + (∀ (y : Real × Real), (y ∈ Metric.ball x rN) → ((y ∈ P3544T1RayParity p ↔ if s then 0 < F y + else F y < 0))) → ((∀ (ε : Real), (0 < ε) → (∃ y z : Real × Real, y ∈ Metric.ball x (min + rN ε) ∧ z ∈ Metric.ball x (min rN ε) ∧ 0 < F y ∧ F z < 0)) → (x ∈ closure + (P3544T1RayParity p))) := by + classical + intro n p i x a b d D F rN S s hlocal htransverse + rw [mem_closure_iff] + intro U hUopen hxU + obtain ⟨ε, hε, hεball⟩ := Metric.isOpen_iff.mp hUopen x hxU + obtain ⟨yp, ym, hyp, hym, hFp, hFm⟩ := htransverse ε hε + have hyN : yp ∈ Metric.ball x rN := Metric.ball_subset_ball (min_le_left _ _) hyp + have hymN : ym ∈ Metric.ball x rN := Metric.ball_subset_ball (min_le_left _ _) hym + by_cases hs : s = true + · have hsign : (if s then 0 < F yp else F yp < 0) := by simp [hs, hFp] + have hyo := (hlocal yp hyN).mpr hsign + exact ⟨yp, ⟨hεball (Metric.ball_subset_ball (min_le_right _ _) hyp), hyo⟩⟩ + · have hs' : s = false := Bool.eq_false_of_not_eq_true hs + have hsign : (if s then 0 < F ym else F ym < 0) := by simp [hs', hFm] + have hyo := (hlocal ym hymN).mpr hsign + exact ⟨ym, ⟨hεball (Metric.ball_subset_ball (min_le_right _ _) hym), hyo⟩⟩ + +private theorem hclosureEven : + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), + let a := p.vertex i + let b := p.vertex (i + 1) + ∀ (d : ℝ × ℝ), + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + ∀ (rN : ℝ), (∀ (y : Real × Real), (y ∈ Metric.ball x rN) → (y ∈ P3544T1BoundaryCarrier p ↔ + F y = 0)) → ( + let S : (Real × Real) → Set (Fin (n + 3)) := fun z => {j | ∃ t : Real, 0 < t ∧ + z + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))} + let s : Bool := + if (S x).ncard % 2 = 0 then decide (0 < D i) else decide (D i < 0) + (∀ (y : Real × Real), (y ∈ Metric.ball x rN) → ((y ∈ P3544T1RayParity p ↔ if s then 0 < F y + else F y < 0))) → ((∀ (ε : Real), (0 < ε) → (∃ y z : Real × Real, y ∈ Metric.ball x (min + rN ε) ∧ z ∈ Metric.ball x (min rN ε) ∧ 0 < F y ∧ F z < 0)) → (x ∈ closure + (P3544T1RayParity p ∪ P3544T1BoundaryCarrier p)ᶜ))) := by + classical + intro n p i x a b d D F rN hcarrier S s hlocal htransverse + rw [mem_closure_iff] + intro U hUopen hxU + obtain ⟨ε, hε, hεball⟩ := Metric.isOpen_iff.mp hUopen x hxU + obtain ⟨yp, ym, hyp, hym, hFp, hFm⟩ := htransverse ε hε + have hyN : yp ∈ Metric.ball x rN := Metric.ball_subset_ball (min_le_left _ _) hyp + have hymN : ym ∈ Metric.ball x rN := Metric.ball_subset_ball (min_le_left _ _) hym + by_cases hs : s = true + · have hsign : ¬ (if s then 0 < F ym else F ym < 0) := by + simp [hs] + linarith + have hnotO : ym ∉ P3544T1RayParity p := by + intro hO + exact hsign ((hlocal ym hymN).mp hO) + have hnotC : ym ∉ P3544T1BoundaryCarrier p := by + intro hC + have : F ym = 0 := (hcarrier ym hymN).mp hC + linarith + have hmem : ym ∈ (P3544T1RayParity p ∪ P3544T1BoundaryCarrier p)ᶜ := by + simp [Set.mem_compl_iff, hnotO, hnotC] + exact ⟨ym, ⟨hεball (Metric.ball_subset_ball (min_le_right _ _) hym), hmem⟩⟩ + · have hs' : s = false := Bool.eq_false_of_not_eq_true hs + have hsign : ¬ (if s then 0 < F yp else F yp < 0) := by + simp [hs'] + linarith + have hnotO : yp ∉ P3544T1RayParity p := by + intro hO + exact hsign ((hlocal yp hyN).mp hO) + have hnotC : yp ∉ P3544T1BoundaryCarrier p := by + intro hC + have : F yp = 0 := (hcarrier yp hyN).mp hC + linarith + have hmem : yp ∈ (P3544T1RayParity p ∪ P3544T1BoundaryCarrier p)ᶜ := by + simp [Set.mem_compl_iff, hnotO, hnotC] + exact ⟨yp, ⟨hεball (Metric.ball_subset_ball (min_le_right _ _) hyp), hmem⟩⟩ + +end SideCrossingProof + +theorem P3597T1SideCrossing {n : Nat} (p : P3381T1PolygonBoundary n) + (i : Fin (n + 3)) (x : Real × Real) + (hx : x ∈ openSegment Real (p.vertex i) (p.vertex (i + 1))) : + ∃ r : Real, 0 < r ∧ + (∃ s : Bool, ∀ y ∈ Metric.ball x r, + (y ∈ P3544T1RayParity p ↔ + if s then 0 < P3381T1TriangleDeterminant + ![p.vertex i, p.vertex (i + 1), y] + else P3381T1TriangleDeterminant + ![p.vertex i, p.vertex (i + 1), y] < 0)) ∧ + x ∈ closure (P3544T1RayParity p) ∧ + x ∈ closure (P3544T1RayParity p ∪ P3544T1BoundaryCarrier p)ᶜ := by +-- BODY + classical + let a := p.vertex i + let b := p.vertex (i + 1) + have hidx : i ≠ i + 1 := SideCrossingProof.hidx n i + have hab : a ≠ b := SideCrossingProof.hab n p i hidx + have hxleft : x ≠ a := SideCrossingProof.hxleft n p i x hx hab + have hxright : x ≠ b := SideCrossingProof.hxright n p i x hx hab hxleft + have hxseg : x ∈ segment Real a b := SideCrossingProof.hxseg n p i x hx + rw [openSegment_eq_image] at hx + obtain ⟨q, hq, hxq⟩ := hx + have hxline : x = a + q • (b - a) := SideCrossingProof.hxline n p i x q hxq + have hx1 : x.1 = a.1 + q * (b.1 - a.1) := SideCrossingProof.hx1 n p i x q hxline + have hx2 : x.2 = a.2 + q * (b.2 - a.2) := SideCrossingProof.hx2 n p i x q hxline + have hxnotseg : ∀ j : Fin (n + 3), j ≠ i → + x ∉ segment Real (p.vertex j) (p.vertex (j + 1)) := SideCrossingProof.hxnotseg n p i x + hxleft hxright hxseg + have hnonvertex : ∀ k : Fin (n + 3), p.vertex k ≠ x := SideCrossingProof.hnonvertex n p i x + hxleft hxnotseg + have ⟨d, hdv, hde⟩ := (P3597T1GenericRayStability p).1 x hnonvertex + let D : Fin (n + 3) → Real := fun j => + d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 + let T : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - + (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) + let U : Fin (n + 3) → (Real × Real) → Real := fun j y => + (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) + have hD : ∀ j, D j ≠ 0 := SideCrossingProof.hD n p d hde + have hparam (j : Fin (n + 3)) := SideCrossingProof.hparam n p x d hD j + have hcontT (j : Fin (n + 3)) : Continuous (T j) := SideCrossingProof.hcontT n p d hD j + have hcontU (j : Fin (n + 3)) : Continuous (U j) := SideCrossingProof.hcontU n p d hD j + have hTi : T i x = 0 := SideCrossingProof.hTi n p i x q hx1 hx2 d hD + have hUi : U i x = q := SideCrossingProof.hUi n p i x q hx1 hx2 d hD + have hUzero (j : Fin (n + 3)) : U j x ≠ 0 := SideCrossingProof.hUzero n p x d hdv hD j + have hUone (j : Fin (n + 3)) : U j x ≠ 1 := SideCrossingProof.hUone n p x d hdv hD j + have hTne (j : Fin (n + 3)) (hji : j ≠ i) + (hinside : 0 < U j x ∧ U j x < 1) : T j x ≠ 0 := SideCrossingProof.hTne n p i x hxnotseg d + hparam j hji hinside + let V : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then {y | 0 < U j y ∧ U j y < 1} + else if U j x < 0 then {y | U j y < 0} + else if 1 < U j x then {y | 1 < U j y} + else if 0 < T j x then {y | 0 < T j y ∧ 0 < U j y ∧ U j y < 1} + else {y | T j y < 0 ∧ 0 < U j y ∧ U j y < 1} + have hVopen (j : Fin (n + 3)) : IsOpen (V j) := SideCrossingProof.hVopen n p i x d hcontT hcontU j + have hVmem : ∀ j, x ∈ V j := SideCrossingProof.hVmem n p i x q hq d hUi hUzero hUone hTne + let Vall : Set (Real × Real) := ⋂ j, V j + have hVallopen : IsOpen Vall := SideCrossingProof.hVallopen n p i x d hVopen + have hxVall : x ∈ Vall := SideCrossingProof.hxVall n p i x d hVmem + obtain ⟨rV, hrV, hballV⟩ := Metric.isOpen_iff.mp hVallopen x hxVall + have hcompactseg (j : Fin (n + 3)) : + IsCompact (segment Real (p.vertex j) (p.vertex (j + 1))) := SideCrossingProof.hcompactseg n + p j + let W : Fin (n + 3) → Set (Real × Real) := fun j => + if j = i then Set.univ else (segment Real (p.vertex j) (p.vertex (j + 1)))ᶜ + have hWopen (j : Fin (n + 3)) : IsOpen (W j) := SideCrossingProof.hWopen n p i hcompactseg j + have hWmem : ∀ j, x ∈ W j := SideCrossingProof.hWmem n p i x hxnotseg + let Wall : Set (Real × Real) := ⋂ j, W j + have hWallopen : IsOpen Wall := SideCrossingProof.hWallopen n p i hWopen + have hxWall : x ∈ Wall := SideCrossingProof.hxWall n p i x hWmem + let F : (Real × Real) → Real := + fun y => P3381T1TriangleDeterminant ![a, b, y] + have hFexplicit (y : Real × Real) : F y = + (b.1 - a.1) * (y.2 - a.2) - (y.1 - a.1) * (b.2 - a.2) := SideCrossingProof.hFexplicit n p i y + have hsegF (y : Real × Real) (hy : y ∈ segment Real a b) : F y = 0 := SideCrossingProof.hsegF n + p i hFexplicit y hy + let Q : (Real × Real) → Real := fun y => + if b.1 - a.1 = 0 then (y.2 - a.2) / (b.2 - a.2) + else (y.1 - a.1) / (b.1 - a.1) + have hecoord : (b.1 - a.1 ≠ 0) ∨ (b.2 - a.2 ≠ 0) := SideCrossingProof.hecoord n p i hab + have hQcont : Continuous Q := SideCrossingProof.hQcont n p i hecoord + have hQx : Q x = q := SideCrossingProof.hQx n p i x q hx1 hx2 hecoord + have hQline (y : Real × Real) (hFy : F y = 0) : + y = a + Q y • (b - a) := SideCrossingProof.hQline n p i hFexplicit hecoord y hFy + let Qline : Set (Real × Real) := {y | 0 < Q y ∧ Q y < 1} + have hQlineopen : IsOpen Qline := SideCrossingProof.hQlineopen n p i hQcont + have hxQline : x ∈ Qline := SideCrossingProof.hxQline n p i x q hq hQx + let g : Fin (n + 3) → (Real × Real) → Real := fun j y => + d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 + have hcontg (j : Fin (n + 3)) : Continuous (g j) := SideCrossingProof.hcontg n p d j + let G : Fin (n + 3) → Set (Real × Real) := fun j => + {y | g j y < 0} ∪ {y | 0 < g j y} + have hGopen (j : Fin (n + 3)) : IsOpen (G j) := SideCrossingProof.hGopen n p d hcontg j + have hGmem : ∀ j, x ∈ G j := SideCrossingProof.hGmem n p x d hdv + let Gall : Set (Real × Real) := ⋂ j, G j + have hGallopen : IsOpen Gall := SideCrossingProof.hGallopen n p d hGopen + have hxGall : x ∈ Gall := SideCrossingProof.hxGall n p x d hGmem + let N : Set (Real × Real) := Vall ∩ (Wall ∩ (Qline ∩ Gall)) + have hNopen : IsOpen N := SideCrossingProof.hNopen n p i x d hVallopen hWallopen hQlineopen + hGallopen + have hxN : x ∈ N := SideCrossingProof.hxN n p i x d hxVall hxWall hxQline hxGall + obtain ⟨rN, hrN, hballN⟩ := Metric.isOpen_iff.mp hNopen x hxN + have hcarrier (y : Real × Real) (hy : y ∈ Metric.ball x rN) : + y ∈ P3544T1BoundaryCarrier p ↔ F y = 0 := SideCrossingProof.hcarrier n p i x d hsegF + hQline rN hballN y hy + have hgenericY (y : Real × Real) (hy : y ∈ Metric.ball x rN) : + ∀ j, d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 ≠ 0 := SideCrossingProof.hgenericY + n p i x d rN hballN y hy + have hparity (y : Real × Real) (hyC : y ∉ P3544T1BoundaryCarrier p) + (hgv : ∀ j, d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 ≠ 0) : + (y ∈ P3544T1RayParity p ↔ + Set.ncard {j : Fin (n + 3) | ∃ t : Real, 0 < t ∧ + y + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))} % 2 = 1) := + SideCrossingProof.hparity n p d hde y hyC hgv + have hparamY (y : Real × Real) (j : Fin (n + 3)) := SideCrossingProof.hparamY n p d hD y j + have hiffX (j : Fin (n + 3)) : + (∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))) ↔ + 0 < T j x ∧ 0 ≤ U j x ∧ U j x ≤ 1 := SideCrossingProof.hiffX n p x d hparam j + have hiffY (y : Real × Real) (j : Fin (n + 3)) : + (∃ t : Real, 0 < t ∧ y + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))) ↔ + 0 < T j y ∧ 0 ≤ U j y ∧ U j y ≤ 1 := SideCrossingProof.hiffY n p d hparamY y j + have hpred (y : Real × Real) (hy : y ∈ Metric.ball x rN) (j : Fin (n + 3)) + (hji : j ≠ i) : + ((∃ t : Real, 0 < t ∧ y + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))) ↔ + (∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1)))) := + SideCrossingProof.hpred n p i x d hUzero hUone hTne rN hballN hiffX hiffY y hy j hji + have hcardSplit (A : Fin (n + 3) → Prop) : + Set.ncard {j | A j} = Set.ncard ({j | A j} \ {i}) + @ite Nat (A i) (Classical.propDecidable + _) 1 0 := + SideCrossingProof.hcardSplit n i A + let S : (Real × Real) → Set (Fin (n + 3)) := fun z => {j | ∃ t : Real, 0 < t ∧ + z + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))} + have hrest (y : Real × Real) (hy : y ∈ Metric.ball x rN) : S y \ {i} = S x \ {i} := + SideCrossingProof.hrest n p i x d rN hpred y hy + have hiX : i ∉ S x := SideCrossingProof.hiX n p i x d hTi hiffX + have hiY (y : Real × Real) (hy : y ∈ Metric.ball x rN) : + (i ∈ S y ↔ 0 < T i y) := SideCrossingProof.hiY n p i x d rN hballN hiffY y hy + have hcount (y : Real × Real) (hy : y ∈ Metric.ball x rN) : + (S y).ncard = (S x).ncard + if 0 < T i y then 1 else 0 := SideCrossingProof.hcount n p i x + d rN hcardSplit hrest hiX hiY y hy + have hTformula (y : Real × Real) : T i y = F y / D i := SideCrossingProof.hTformula n p i d + hFexplicit y + have hmulF (y : Real × Real) : F y = T i y * D i := SideCrossingProof.hmulF n p i d hD hTformula y + have hsignPosPos (y : Real × Real) (hDpos : 0 < D i) : + (0 < T i y ↔ 0 < F y) := SideCrossingProof.hsignPosPos n p i d hmulF y hDpos + have hsignPosNeg (y : Real × Real) (hDneg : D i < 0) : + (0 < T i y ↔ F y < 0) := SideCrossingProof.hsignPosNeg n p i d hmulF y hDneg + have hsignNegPos (y : Real × Real) (hDpos : 0 < D i) : + (T i y < 0 ↔ F y < 0) := SideCrossingProof.hsignNegPos n p i d hmulF y hDpos + have hsignNegNeg (y : Real × Real) (hDneg : D i < 0) : + (T i y < 0 ↔ 0 < F y) := SideCrossingProof.hsignNegNeg n p i d hmulF y hDneg + have hDpositive : 0 < D i ∨ D i < 0 := SideCrossingProof.hDpositive n p i d hD + let s : Bool := + if (S x).ncard % 2 = 0 then decide (0 < D i) else decide (D i < 0) + have hlocal (y : Real × Real) (hy : y ∈ Metric.ball x rN) : + (y ∈ P3544T1RayParity p ↔ if s then 0 < F y else F y < 0) := SideCrossingProof.hlocal n p + i x d rN hcarrier hgenericY hparity hiY hcount hmulF hsignPosPos hsignPosNeg + hsignNegPos hsignNegNeg hDpositive y hy + have hnormsq : 0 < (b.1 - a.1)^2 + (b.2 - a.2)^2 := SideCrossingProof.hnormsq n p i hab + have hnormal (h : Real) : F (x + h • (-(b.2 - a.2), b.1 - a.1)) = + h * ((b.1 - a.1)^2 + (b.2 - a.2)^2) := SideCrossingProof.hnormal n p i x hxseg hsegF h + have htransverse (ε : Real) (hε : 0 < ε) : + ∃ y z : Real × Real, y ∈ Metric.ball x (min rN ε) ∧ + z ∈ Metric.ball x (min rN ε) ∧ 0 < F y ∧ F z < 0 := SideCrossingProof.htransverse n p i x + rN hrN hnormsq hnormal ε hε + have hclosureOdd : x ∈ closure (P3544T1RayParity p) := SideCrossingProof.hclosureOdd n p i x + d rN hlocal htransverse + have hclosureEven : x ∈ closure (P3544T1RayParity p ∪ P3544T1BoundaryCarrier p)ᶜ := + SideCrossingProof.hclosureEven n p i x d rN hcarrier hlocal htransverse + refine ⟨rN, hrN, ⟨s, ?_⟩, ?_, ?_⟩ + · intro y hy + exact hlocal y hy + · exact hclosureOdd + · exact hclosureEven + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean b/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean new file mode 100644 index 0000000000..053432dcae --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean @@ -0,0 +1,3368 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3597T1SideCrossing +public import Mathlib.Topology.Connected.PathConnected +public import Mathlib.Analysis.Convex.Topology +public import Mathlib.Analysis.Normed.Module.Convex +public import Mathlib.Topology.LocallyConstant.Basic + +-- [TABLET NODE: P3597T1VertexSectors] + +/-! +# P3597T1VertexSectors + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace VertexSectorProof + +private theorem hgeneric : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let C := P3544T1BoundaryCarrier p + ∀ x : Real × Real, x ∉ C → ∃ d : Real × Real, (∀ j, d.1 * (p.vertex j - x).2 - d.2 * + (p.vertex j - x).1 ≠ 0) ∧ (∀ j, d.1 * (p.vertex (j + 1) - p.vertex j).2 - d.2 * + (p.vertex + (j + 1) - p.vertex j).1 ≠ 0) ) := by + classical + intro n p C x hx + apply (P3597T1GenericRayStability p).1 x + intro j hj + have hv : p.vertex j ∈ C := by + exact Set.mem_iUnion.mpr ⟨j, left_mem_segment Real _ _⟩ + exact hx (hj ▸ hv) + +private theorem hparity : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + ∀ x d : Real × Real, x ∉ C → (∀ j, d.1 * (p.vertex j - x).2 - d.2 * (p.vertex j - x).1 ≠ + 0) → + (∀ j, d.1 * (p.vertex (j + 1) - p.vertex j).2 - d.2 * (p.vertex (j + 1) - p.vertex + j).1 ≠ + 0) → (x ∈ O ↔ Set.ncard {j : Fin (n + 3) | ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real + (p.vertex j) (p.vertex (j + 1))} % 2 = 1) ) := by + classical + intro n p O C x d hx hdv hde + constructor + · rintro ⟨_, d', hdv', hde', hodd⟩ + exact (P3597T1DirectionParity p x d d' hx hdv hdv').trans hodd + · intro hodd + exact ⟨hx, d, hdv, hde, hodd⟩ + +private theorem hlocal : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + (∀ x : Real × Real, x ∉ C → ∃ d : Real × Real, (∀ j, d.1 * (p.vertex j - x).2 - d.2 * + (p.vertex j - x).1 ≠ 0) ∧ (∀ j, d.1 * (p.vertex (j + 1) - p.vertex j).2 - d.2 * + (p.vertex + (j + 1) - p.vertex j).1 ≠ 0)) → ((∀ x d : Real × Real, x ∉ C → (∀ j, d.1 * (p.vertex j - + x).2 - d.2 * (p.vertex j - x).1 ≠ 0) → (∀ j, d.1 * (p.vertex (j + 1) - p.vertex j).2 - + d.2 * (p.vertex (j + 1) - p.vertex j).1 ≠ 0) → (x ∈ O ↔ Set.ncard {j : Fin (n + 3) | ∃ t + : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))} % 2 = 1)) → (∀ + x : Real × Real, x ∉ C → ∃ r : Real, 0 < r ∧ ∀ y ∈ Metric.ball x r, y ∉ C ∧ (y ∈ O ↔ x ∈ + O))) ) := by + classical + intro n p O C hgeneric hparity x hx + obtain ⟨d, hdv, hde⟩ := hgeneric x hx + obtain ⟨r, hr, hstable⟩ := (P3597T1GenericRayStability p).2.1 x d hx hdv hde + refine ⟨r, hr, ?_⟩ + intro y hy + obtain ⟨hyC, hdy, hsides⟩ := hstable y hy + refine ⟨hyC, ?_⟩ + have hcount : Set.ncard {j : Fin (n + 3) | ∃ t : Real, 0 < t ∧ + y + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))} % 2 = + Set.ncard {j : Fin (n + 3) | ∃ t : Real, 0 < t ∧ + x + t • d ∈ segment Real (p.vertex j) (p.vertex (j + 1))} % 2 := by + exact congrArg (fun S : Set (Fin (n + 3)) => Set.ncard S % 2) (Set.ext hsides) + rw [hparity y d hyC hdy hde, hparity x d hx hdv hde, hcount] + +private theorem hvnot : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let J : Set (Fin (n + 3)) := {j | j ≠ i ∧ j + 1 ≠ i} + let K : Set (Real × Real) := ⋃ j ∈ J, + segment Real (p.vertex j) (p.vertex (j + 1)) + v ∉ K ) := by + classical + intro n p i v J K hvK + obtain ⟨j, hj⟩ := Set.mem_iUnion.mp hvK + obtain ⟨hjJ, hvseg⟩ := Set.mem_iUnion.mp hj + have hii : v ∈ segment Real (p.vertex i) (p.vertex (i + 1)) := by + dsimp [v] + exact left_mem_segment Real _ _ + have hmem : v ∈ segment Real (p.vertex i) (p.vertex (i + 1)) ∩ + segment Real (p.vertex j) (p.vertex (j + 1)) := ⟨hii, hvseg⟩ + rw [p.edge_intersection i j hjJ.1.symm] at hmem + have hend : (v = p.vertex i ∨ v = p.vertex (i + 1)) ∧ + (v = p.vertex j ∨ v = p.vertex (j + 1)) := by + simpa only [Set.mem_ofPred_eq] using hmem + rcases hend.2 with hjleft | hjright + · have heq : i = j := p.injective (by simpa [v] using hjleft) + exact hjJ.1 heq.symm + · have heq : i = j + 1 := p.injective (by simpa [v] using hjright) + exact hjJ.2 heq.symm + +private theorem haddne : + (by + classical + exact + ∀ (n : Nat), (Fin (n + 3)) → (∀ j : Fin (n + 3), j + 1 ≠ j) ) := by + classical + intro n i j hj + have hv' := congrArg Fin.val hj + simp only [Fin.val_add] at hv' + have hv'' : (j.val + 1) % (n + 3) = j.val := by simpa using hv' + by_cases hlt : j.val + 1 < n + 3 + · rw [Nat.mod_eq_of_lt hlt] at hv'' + omega + · have heq : j.val + 1 = n + 3 := by omega + rw [heq, Nat.mod_self] at hv'' + omega + +private theorem haddinj : + (by + classical + exact + ∀ (n : Nat), (Fin (n + 3)) → (∀ x y : Fin (n + 3), x + 1 = y + 1 → x = y) ) := by + classical + intro n i x y hxy + apply Fin.ext + have hv := congrArg Fin.val hxy + simp only [Fin.val_add] at hv + have hv' : (x.val + 1) % (n + 3) = (y.val + 1) % (n + 3) := by simpa using hv + have hxbound : x.val + 1 ≤ n + 3 := by omega + have hybound : y.val + 1 ≤ n + 3 := by omega + by_cases hxwrap : x.val + 1 = n + 3 + · have hywrap : y.val + 1 = n + 3 := by + by_contra hne + have hylt : y.val + 1 < n + 3 := by omega + rw [hxwrap, Nat.mod_self, Nat.mod_eq_of_lt hylt] at hv' + omega + rw [hxwrap, Nat.mod_self, hywrap, Nat.mod_self] at hv' + omega + · have hxlt : x.val + 1 < n + 3 := by omega + by_cases hywrap : y.val + 1 = n + 3 + · rw [Nat.mod_eq_of_lt hxlt, hywrap, Nat.mod_self] at hv' + omega + · have hylt : y.val + 1 < n + 3 := by omega + rw [Nat.mod_eq_of_lt hxlt, Nat.mod_eq_of_lt hylt] at hv' + omega + +private theorem hcrosszero : + (by + classical + exact + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + ∀ x z : Real × Real, x ≠ 0 → cross x z = 0 → ∃ c : Real, z = c • x ) := by + classical + intro cross x z hx hD + by_cases hx1 : x.1 = 0 + · have hx2 : x.2 ≠ 0 := by + intro h + apply hx + ext <;> simp [hx1, h] + have hz1 : z.1 = 0 := by + dsimp [cross] at hD + rw [hx1] at hD + have hprod : x.2 * z.1 = 0 := by nlinarith + rcases mul_eq_zero.mp hprod with hzero | hzero + · exact (hx2 hzero).elim + · exact hzero + refine ⟨z.2 / x.2, ?_⟩ + ext + · simp [hx1, hz1] + · simp + field_simp + · let c := z.1 / x.1 + refine ⟨c, ?_⟩ + have hdet : x.1 * z.2 = x.2 * z.1 := by + dsimp [cross] at hD + linarith + ext + · simp [c] + field_simp + · simp [c] + field_simp + nlinarith [hdet] + +private theorem hcarrierLocal : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + let J : Set (Fin (n + 3)) := {j | j ≠ i ∧ j + 1 ≠ i} + let K : Set (Real × Real) := ⋃ j ∈ J, + segment Real (p.vertex j) (p.vertex (j + 1)) + ∀ (rK : ℝ), ∀ (hballK : Metric.ball v rK ⊆ Kᶜ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + (prev + 1 = i) → ((∀ x y : Fin (n + 3), x + 1 = y + 1 → x = y) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + (r ≤ rK) → (∀ x : Real × Real, x ∈ Metric.ball v r → (x ∈ C ↔ x ∈ segment Real v + (p.vertex (i + + 1)) ∨ x ∈ segment Real (p.vertex prev) v)))) ) := by + classical + intro n p i C v J K rK hballK prev hprev haddinj r hrKle x hx + constructor + · intro hxC + obtain ⟨j, hj⟩ := Set.mem_iUnion.mp hxC + by_cases hji : j = i + · left + simpa [v, hji] using hj + · by_cases hjp : j + 1 = i + · right + have hji' : j = prev := haddinj j prev (hjp.trans hprev.symm) + simpa [v, hji', hprev] using hj + · have hjJ : j ∈ J := ⟨hji, hjp⟩ + have hxK : x ∈ K := Set.mem_iUnion.mpr ⟨j, Set.mem_iUnion.mpr ⟨hjJ, hj⟩⟩ + have hxKc : x ∈ Kᶜ := hballK (Metric.ball_subset_ball hrKle hx) + exact False.elim (hxKc hxK) + · rintro (hx | hx) + · have : x ∈ C := Set.mem_iUnion.mpr ⟨i, by simpa [v] using hx⟩ + exact this + · have : x ∈ C := Set.mem_iUnion.mpr ⟨prev, by simpa [hprev] using hx⟩ + exact this + +private theorem hsegA : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let a := p.vertex (i + 1) - v + (∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x y t = x + t • (y - x)) → (∀ x : Real × + Real, (x ∈ segment Real v (p.vertex (i + 1)) ↔ ∃ t : Real, t ∈ Set.Icc 0 1 ∧ x = v + t • + a)) ) := by + classical + intro n p i v a hlineMap x + rw [segment_eq_image_lineMap] + simp only [Set.mem_image] + constructor + · rintro ⟨t, ht, htx⟩ + refine ⟨t, ht, ?_⟩ + rw [← htx, hlineMap] + · rintro ⟨t, ht, rfl⟩ + refine ⟨t, ht, ?_⟩ + rw [hlineMap] + +private theorem hsegB : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let b := p.vertex prev - v + (∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x y t = x + t • (y - x)) → (∀ x : Real × + Real, (x ∈ segment Real (p.vertex prev) v ↔ ∃ t : Real, t ∈ Set.Icc 0 1 ∧ x = v + t • + b)) ) := by + classical + intro n p i v prev b hlineMap x + rw [segment_symm Real (p.vertex prev) v, segment_eq_image_lineMap] + simp only [Set.mem_image] + constructor + · rintro ⟨t, ht, htx⟩ + refine ⟨t, ht, ?_⟩ + rw [← htx, hlineMap] + · rintro ⟨t, ht, rfl⟩ + refine ⟨t, ht, ?_⟩ + rw [hlineMap] + +private theorem hRayA : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + (0 < dist v (p.vertex (i + 1))) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + (r ≤ dist v (p.vertex (i + 1)) / 2) → ((∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x + y t = x + t • (y - x)) → ((∀ (u : Real × Real), ∀ (t : Real), 0 ≤ t → dist (v + t • u) v + = t * dist (v + u) v) → (∀ x : Real × Real, x ∈ Metric.ball v r → ∀ t : Real, 0 < t → + x = + v + t • a → x ∈ segment Real v (p.vertex (i + 1)))))) ) := by + classical + intro n p i v rK prev a hdistA r hrAle hlineMap hdistRadial x hx t ht hxeq + have hdistx : dist (v + t • a) v < r := by + simpa [hxeq] using (Metric.mem_ball.mp hx) + have he : v + a = p.vertex (i + 1) := by dsimp [a]; abel + have hdist : dist (v + t • a) v = t * dist v (p.vertex (i + 1)) := by + calc + dist (v + t • a) v = t * dist (v + a) v := hdistRadial a t ht.le + _ = t * dist v (p.vertex (i + 1)) := by rw [he, dist_comm] + have hdistx' : dist v (v + t • a) < r := by simpa [dist_comm] using hdistx + have htlt : t < 1 := by nlinarith [hdistx', hdist] + have hmem := lineMap_mem_segment Real v (p.vertex (i + 1)) + (show t ∈ Set.Icc 0 1 from ⟨ht.le, htlt.le⟩) + rw [hlineMap] at hmem + rw [hxeq] + simpa [a] using hmem + +private theorem hRayB : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let b := p.vertex prev - v + (0 < dist v (p.vertex prev)) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + (r ≤ dist v (p.vertex prev) / 2) → ((∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x + y t + = x + t • (y - x)) → ((∀ (u : Real × Real), ∀ (t : Real), 0 ≤ t → dist (v + t • u) v = t + * dist (v + u) v) → (∀ x : Real × Real, x ∈ Metric.ball v r → ∀ t : Real, 0 < t → x = + v + + t • b → x ∈ segment Real (p.vertex prev) v)))) ) := by + classical + intro n p i v rK prev b hdistB r hrBle hlineMap hdistRadial x hx t ht hxeq + have hdistx : dist (v + t • b) v < r := by + simpa [hxeq] using (Metric.mem_ball.mp hx) + have he : v + b = p.vertex prev := by dsimp [b]; abel + have hdistB' : dist (v + t • b) v = t * dist v (p.vertex prev) := by + calc + dist (v + t • b) v = t * dist (v + b) v := hdistRadial b t ht.le + _ = t * dist v (p.vertex prev) := by rw [he, dist_comm] + have htlt : t < 1 := by nlinarith [hdistx, hdistB'] + have hmem := lineMap_mem_segment Real v (p.vertex prev) + (show t ∈ Set.Icc 0 1 from ⟨ht.le, htlt.le⟩) + rw [hlineMap] at hmem + have hmem' : v + t • b ∈ segment Real (p.vertex prev) v := by + rw [segment_symm Real (p.vertex prev) v] + simpa [b] using hmem + rw [hxeq] + exact hmem' + +private theorem hcarrierRays : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + (∀ x : Real × Real, x ∈ Metric.ball v r → (x ∈ C ↔ x ∈ segment Real v (p.vertex (i + 1)) ∨ x + ∈ segment Real (p.vertex prev) v)) → ((∀ x : Real × Real, (x ∈ segment Real v (p.vertex + (i + 1)) ↔ ∃ t : Real, t ∈ Set.Icc 0 1 ∧ x = v + t • a)) → ((∀ x : Real × Real, (x ∈ + segment Real (p.vertex prev) v ↔ ∃ t : Real, t ∈ Set.Icc 0 1 ∧ x = v + t • b)) → ((∀ x : + Real × Real, x ∈ Metric.ball v r → ∀ t : Real, 0 < t → x = v + t • a → x ∈ segment + Real v + (p.vertex (i + 1))) → ((∀ x : Real × Real, x ∈ Metric.ball v r → ∀ t : Real, 0 < t → x = + v + t • b → x ∈ segment Real (p.vertex prev) v) → (∀ x : Real × Real, x ∈ Metric.ball + v r + → (x ∈ C ↔ x = v ∨ (∃ t : Real, 0 < t ∧ x = v + t • a) ∨ (∃ t : Real, 0 < t ∧ x = v + + t • + b))))))) ) := by + classical + intro n p i C v rK prev a b r hcarrierLocal hsegA hsegB hRayA hRayB x hx + rw [hcarrierLocal x hx] + constructor + · rintro (hA | hB) + · obtain ⟨t, ht, hxt⟩ := (hsegA x).mp hA + rcases eq_or_ne t 0 with ht0 | ht0 + · left + simpa [ht0] using hxt + · right + left + refine ⟨t, ?_⟩ + exact ⟨lt_of_le_of_ne ht.1 (Ne.symm ht0), hxt⟩ + · obtain ⟨t, ht, hxt⟩ := (hsegB x).mp hB + rcases eq_or_ne t 0 with ht0 | ht0 + · left + simpa [ht0] using hxt + · right + right + refine ⟨t, ?_⟩ + exact ⟨lt_of_le_of_ne ht.1 (Ne.symm ht0), hxt⟩ + · rintro (h | h | h) + · subst x + left + exact left_mem_segment Real _ _ + · obtain ⟨t, ht, hxt⟩ := h + left + exact hRayA x hx t ht hxt + · obtain ⟨t, ht, hxt⟩ := h + right + exact hRayB x hx t ht hxt + +private theorem hnoPosMultiple : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + (prev + 1 = i) → ((prev ≠ i) → ((p.vertex (i + 1) ≠ v) → ( + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + (∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x y t = x + t • (y - x)) → (¬ ∃ c : + Real, + 0 < c ∧ b = c • a)))) ) := by + classical + intro n p i v prev hprev hprevne hnextVertex a b hlineMap + rintro ⟨c, hc, hba⟩ + let t := 1 / (2 * c + 2) + have ht : 0 < t := by dsimp [t]; positivity + have hct : 0 < c * t := mul_pos hc ht + have hctlt : c * t < 1 := by + dsimp [t] + have hden : 0 < 2 * c + 2 := by positivity + have he : c * (1 / (2 * c + 2)) = c / (2 * c + 2) := by + field_simp + rw [he, div_lt_iff₀ hden] + nlinarith + have htlt : t < 1 := by + dsimp [t] + have hden : 0 < 2 * c + 2 := by positivity + rw [div_lt_iff₀ hden] + nlinarith + let q := v + (c * t) • a + have hqA : q ∈ segment Real v (p.vertex (i + 1)) := by + have hseg := lineMap_mem_segment Real v (p.vertex (i + 1)) + (show c * t ∈ Set.Icc 0 1 from ⟨hct.le, hctlt.le⟩) + rw [hlineMap] at hseg + simpa [q, a] using hseg + have hqb : v + t • b = q := by + rw [hba, smul_smul] + congr 1 + ring + have hqB : q ∈ segment Real (p.vertex prev) v := by + rw [← hqb, segment_symm Real (p.vertex prev) v] + have hseg := lineMap_mem_segment Real v (p.vertex prev) + (show t ∈ Set.Icc 0 1 from ⟨ht.le, htlt.le⟩) + rw [hlineMap] at hseg + simpa [b] using hseg + have hqOpen : q ∈ openSegment Real v (p.vertex (i + 1)) := by + have hopen := lineMap_mem_openSegment Real v (p.vertex (i + 1)) + (show c * t ∈ Set.Ioo 0 1 from ⟨hct, hctlt⟩) + rw [hlineMap] at hopen + simpa [q, a] using hopen + have hinter : q ∈ segment Real v (p.vertex (i + 1)) ∩ + segment Real (p.vertex prev) v := ⟨hqA, hqB⟩ + have hinter' : q ∈ segment Real (p.vertex i) (p.vertex (i + 1)) ∩ + segment Real (p.vertex prev) (p.vertex (prev + 1)) := by + simpa [v, hprev] using hinter + rw [p.edge_intersection i prev hprevne.symm] at hinter' + have hends : (q = v ∨ q = p.vertex (i + 1)) ∧ + (q = p.vertex prev ∨ q = v) := by + simpa [v, hprev] using hinter' + rcases hends.1 with hqv | hqe + · rw [hqv] at hqOpen + have heq := (left_mem_openSegment_iff.mp hqOpen) + exact hnextVertex (by simpa [v] using heq.symm) + · rw [hqe] at hqOpen + have heq := (right_mem_openSegment_iff.mp hqOpen) + exact hnextVertex (by simpa [v] using heq.symm) + +private theorem hstraight : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + (a ≠ 0) → ((b ≠ 0) → ( + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ x z : Real × Real, x ≠ 0 → cross x z = 0 → ∃ c : Real, z = c • x) → ((¬ ∃ c : Real, 0 < c + ∧ b = c • a) → (cross a b = 0 → ∃ c : Real, c < 0 ∧ b = c • a)))) ) := by + classical + intro n p i v prev a b ha hb cross hcrosszero hnoPosMultiple hD + obtain ⟨c, hba⟩ := hcrosszero a b ha hD + have hcne : c ≠ 0 := by + intro hc + rw [hc, zero_smul] at hba + exact hb hba + have hcnpos : ¬ 0 < c := by + intro hc + exact hnoPosMultiple ⟨c, hc, hba⟩ + exact ⟨c, lt_of_le_of_ne (le_of_not_gt hcnpos) hcne, hba⟩ + +private theorem happroach : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + (0 < dist v (p.vertex (i + 1))) → ((∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x y t + = x + t • (y - x)) → ((∀ (u : Real × Real), ∀ (t : Real), 0 ≤ t → dist (v + t • u) v = t + * dist (v + u) v) → (∀ ε : Real, 0 < ε → ∃ x : Real × Real, x ∈ openSegment Real v + (p.vertex (i + 1)) ∧ dist v x < ε / 2))) ) := by + classical + intro n p i v hdistA hlineMap hdistRadial ε hε + let a := p.vertex (i + 1) - v + let d := dist v (p.vertex (i + 1)) + let t := min (1 / 2) (ε / (4 * (d + 1))) + have ht : 0 < t := by + dsimp [t] + apply lt_min + · norm_num + · positivity + have htle : t ≤ ε / (4 * (d + 1)) := min_le_right _ _ + have htlt : t < 1 := lt_of_le_of_lt (min_le_left _ _) (by norm_num) + have hdist : dist (v + t • a) v = t * d := by + have he : v + a = p.vertex (i + 1) := by dsimp [a]; abel + rw [hdistRadial a t ht.le, he, dist_comm] + have hclose : dist v (v + t • a) < ε / 2 := by + rw [dist_comm, hdist] + have hd0 : 0 ≤ d := dist_nonneg + calc + t * d ≤ (ε / (4 * (d + 1))) * d := mul_le_mul_of_nonneg_right htle hd0 + _ < ε / 4 := by + rw [div_mul_eq_mul_div, div_lt_iff₀ (by positivity)] + nlinarith + _ < ε / 2 := by linarith + let x := v + t • a + have hopen : x ∈ openSegment Real v (p.vertex (i + 1)) := by + have hmem := lineMap_mem_openSegment Real v (p.vertex (i + 1)) + (show t ∈ Set.Ioo 0 1 from ⟨ht, htlt⟩) + rw [hlineMap] at hmem + simpa [x, a] using hmem + exact ⟨x, hopen, by simpa [x] using hclose⟩ + +private theorem hvOdd : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let v := p.vertex i + (∀ ε : Real, 0 < ε → ∃ x : Real × Real, x ∈ openSegment Real v (p.vertex (i + 1)) ∧ dist v x + < ε / 2) → (v ∈ closure O) ) := by + classical + intro n p i O v happroach + rw [Metric.mem_closure_iff] + intro ε hε + obtain ⟨x, hxopen, hxclose⟩ := happroach ε hε + obtain ⟨_, _, _, hxO, _⟩ := P3597T1SideCrossing p i x hxopen + obtain ⟨y, hyO, hydist⟩ := (Metric.mem_closure_iff.mp hxO) (ε / 2) (by linarith) + refine ⟨y, hyO, ?_⟩ + calc + dist v y ≤ dist v x + dist x y := dist_triangle _ _ _ + _ < ε / 2 + ε / 2 := add_lt_add hxclose hydist + _ = ε := by ring + +private theorem hvEven : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + (∀ ε : Real, 0 < ε → ∃ x : Real × Real, x ∈ openSegment Real v (p.vertex (i + 1)) ∧ dist v x + < ε / 2) → (v ∈ closure (O ∪ C)ᶜ) ) := by + classical + intro n p i O C v happroach + rw [Metric.mem_closure_iff] + intro ε hε + obtain ⟨x, hxopen, hxclose⟩ := happroach ε hε + obtain ⟨_, _, _, _, hxEven⟩ := P3597T1SideCrossing p i x hxopen + obtain ⟨y, hyEven, hydist⟩ := (Metric.mem_closure_iff.mp hxEven) (ε / 2) (by linarith) + refine ⟨y, hyEven, ?_⟩ + calc + dist v y ≤ dist v x + dist x y := dist_triangle _ _ _ + _ < ε / 2 + ε / 2 := add_lt_add hxclose hydist + _ = ε := by ring + +private theorem hdetuw : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + 0 < cross u w ∨ cross u w = 0 ) := by + classical + intro n p i v prev a b cross u w + by_cases hpos : 0 < cross a b + · left + simp only [u, w, ite_eq_left hpos] + exact hpos + · by_cases hzero : cross a b = 0 + · right + simp only [u, w, ite_eq_right hpos] + have hswap : cross b a = -cross a b := by dsimp [cross]; ring + rw [hswap, hzero] + simp + · left + have hneg : cross a b < 0 := lt_of_le_of_ne (le_of_not_gt hpos) hzero + have hswap : cross b a = -cross a b := by dsimp [cross]; ring + simp only [u, w, ite_eq_right hpos] + rw [hswap] + exact neg_pos.mpr hneg + +private theorem hcarrierUW : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + (∀ x : Real × Real, x ∈ Metric.ball v r → (x ∈ C ↔ x = v ∨ (∃ t : Real, 0 < t ∧ x = v + t • + a) ∨ (∃ t : Real, 0 < t ∧ x = v + t • b))) → ( + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + ∀ x : Real × Real, x ∈ Metric.ball v r → (x ∈ C ↔ x = v ∨ (∃ t : Real, 0 < t ∧ x = v + t + • u) + ∨ (∃ t : Real, 0 < t ∧ x = v + t • w))) ) := by + classical + intro n p i C v rK prev a b cross r hcarrierRays u w x hx + by_cases hpos : 0 < cross a b + · simp only [u, w, ite_eq_left hpos] + exact hcarrierRays x hx + · simp only [u, w, ite_eq_right hpos] + have hrays := hcarrierRays x hx + constructor + · intro hc + rcases hrays.mp hc with hv | ha | hb + · exact Or.inl hv + · exact Or.inr (Or.inr ha) + · exact Or.inr (Or.inl hb) + · intro hc + rcases hc with hv | hb | ha + · exact hrays.mpr (Or.inl hv) + · exact hrays.mpr (Or.inr (Or.inr hb)) + · exact hrays.mpr (Or.inr (Or.inl ha)) + +private theorem hconstOn : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + (∀ x : Real × Real, x ∉ C → ∃ r : Real, 0 < r ∧ ∀ y ∈ Metric.ball x r, y ∉ C ∧ (y ∈ O ↔ x ∈ + O)) → (∀ S : Set (Real × Real), IsConnected S → (∀ x, x ∈ S → x ∉ C) → ∀ x ∈ S, ∀ y ∈ S, + (x ∈ O ↔ y ∈ O)) ) := by + classical + intro n p O C hlocal S hconn hSC x hx y hy + let f : S → Bool := fun z => decide ((z : Real × Real) ∈ O) + have hf : IsLocallyConstant f := by + rw [IsLocallyConstant.iff_exists_open] + intro z + obtain ⟨ρ, hρ, hstable⟩ := hlocal z.1 (hSC z.1 z.2) + let U : Set S := Subtype.val ⁻¹' Metric.ball z.1 ρ + refine ⟨U, Metric.isOpen_ball.preimage continuous_subtype_val, ?_, ?_⟩ + · exact Metric.mem_ball_self hρ + · intro z' hz' + have hzball : (z' : Real × Real) ∈ Metric.ball z.1 ρ := hz' + have hsame := (hstable z' hzball).2 + have hbool : decide ((z' : Real × Real) ∈ O) = decide ((z : Real × Real) ∈ O) := by + by_cases hzO : (z' : Real × Real) ∈ O + · by_cases hzbase : (z : Real × Real) ∈ O + · simp [hzO, hzbase] + · exact False.elim (hzbase (hsame.mp hzO)) + · by_cases hzbase : (z : Real × Real) ∈ O + · exact False.elim (hzO (hsame.mpr hzbase)) + · simp [hzO, hzbase] + simpa [f] using hbool + have hfcont : ContinuousOn (fun z : Real × Real => decide (z ∈ O)) S := by + apply continuousOn_iff_continuous_domRestrict.mpr + change Continuous f + exact hf.continuous + let : PreconnectedSpace S := isPreconnected_iff_preconnectedSpace.mp hconn.2 + have heq := hf.apply_eq_of_preconnectedSpace ⟨x, hx⟩ ⟨y, hy⟩ + change (decide (x ∈ O) = decide (y ∈ O)) at heq + by_cases hxo : x ∈ O <;> by_cases hyo : y ∈ O <;> simp [hxo, hyo] at heq ⊢ + +private theorem hsmallScale : + (by + classical + exact + ∀ z : Real × Real, ∀ δ : Real, 0 < δ → ∃ t : Real, 0 < t ∧ t • z ∈ Metric.ball ((0 : Real), + (0 : Real)) δ ) := by + classical + intro z δ hδ + let t := δ / (‖z‖ + 1) + have ht : 0 < t := by dsimp [t]; positivity + have hn : ‖t • z‖ < δ := by + rw [norm_smul, Real.norm_eq_abs, abs_of_pos ht] + dsimp [t] + have hd : 0 < ‖z‖ + 1 := by positivity + rw [div_mul_eq_mul_div] + exact (div_lt_iff₀ hd).2 (by nlinarith [norm_nonneg z]) + have hmem : t • z ∈ Metric.ball ((0 : Real), (0 : Real)) δ := by + rw [Metric.mem_ball, dist_eq_norm] + have he : (t • z : Real × Real) - (0, 0) = t • z := by ext <;> simp + rw [he] + exact hn + exact ⟨t, ht, hmem⟩ + +private theorem hNandW : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + (0 < r) → ( + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + (∀ z : Real × Real, ∀ δ : Real, 0 < δ → ∃ t : Real, 0 < t ∧ t • z ∈ Metric.ball ((0 : Real), + (0 : Real)) δ) → ( + let N : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + 0 < cross u (x - v) ∧ cross w (x - v) < 0} + let W : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + (cross u (x - v) < 0 ∨ 0 < cross w (x - v))} + 0 < cross u w → IsPathConnected N ∧ IsPathConnected W))) ) := by + classical + intro n p i v rK prev a b cross hcrossLinear r hr u w hsmallScale N W hD + let H : Set (Real × Real) := {z | z ∈ Metric.ball ((0 : Real), (0 : Real)) r ∧ + 0 < cross u z ∧ cross w z < 0} + have hconv : Convex Real H := by + exact (convex_ball _ _).inter + ((convex_halfSpace_gt (hcrossLinear u) 0).inter + (convex_halfSpace_lt (hcrossLinear w) 0)) + have hne : H.Nonempty := by + let z := u + w + have hzu : 0 < cross u z := by + have he : cross u z = cross u w := by dsimp [z, cross]; ring + rw [he] + exact hD + have hzw : cross w z < 0 := by + have he : cross w z = -cross u w := by dsimp [z, cross]; ring + rw [he] + linarith + obtain ⟨δ, hδ, hball⟩ := Metric.isOpen_iff.mp Metric.isOpen_ball + ((0 : Real), (0 : Real)) (Metric.mem_ball_self hr) + obtain ⟨t, ht, hsmall⟩ := hsmallScale z δ hδ + refine ⟨t • z, hball hsmall, ?_, ?_⟩ + · rw [(hcrossLinear u).map_smul] + change 0 < t * cross u z + exact mul_pos ht hzu + · rw [(hcrossLinear w).map_smul] + change t * cross w z < 0 + exact mul_neg_of_pos_of_neg ht hzw + have hpH : IsPathConnected H := hconv.isPathConnected hne + have himage : (fun z : Real × Real => z + v) '' H = N := by + ext x + constructor + · rintro ⟨z, hz, rfl⟩ + rcases hz with ⟨hzball, hzu, hzw⟩ + refine ⟨?_, ?_, ?_⟩ + · rw [Metric.mem_ball, dist_eq_norm] at hzball ⊢ + have he : (z : Real × Real) - (0, 0) = z := by ext <;> simp + rw [he] at hzball + have he' : (z + v : Real × Real) - v = z := by abel + rw [he'] + exact hzball + · simpa using hzu + · simpa using hzw + · intro hx + rcases hx with ⟨hxball, hxu, hxw⟩ + refine ⟨x - v, ?_, by simp⟩ + refine ⟨?_, ?_, ?_⟩ + · rw [Metric.mem_ball, dist_eq_norm] at hxball ⊢ + have he : (x - v : Real × Real) - (0, 0) = x - v := by ext <;> simp + rw [he] + exact hxball + · exact hxu + · exact hxw + have hN : IsPathConnected N := + himage ▸ hpH.image (continuous_id.add continuous_const) + let z := u + w + have hzu : cross u z = cross u w := by dsimp [z, cross]; ring + have hzw : cross w z = -cross u w := by dsimp [z, cross]; ring + obtain ⟨δ, hδ, hball⟩ := Metric.isOpen_iff.mp Metric.isOpen_ball + ((0 : Real), (0 : Real)) (Metric.mem_ball_self hr) + obtain ⟨t, ht, hsmall⟩ := hsmallScale z δ hδ + let H₁ : Set (Real × Real) := {z | z ∈ Metric.ball ((0 : Real), (0 : Real)) r ∧ + cross u z < 0} + let H₂ : Set (Real × Real) := {z | z ∈ Metric.ball ((0 : Real), (0 : Real)) r ∧ + 0 < cross w z} + have hconv₁ : Convex Real H₁ := + (convex_ball _ _).inter (convex_halfSpace_lt (hcrossLinear u) 0) + have hconv₂ : Convex Real H₂ := + (convex_ball _ _).inter (convex_halfSpace_gt (hcrossLinear w) 0) + have hsmallNeg : -(t • z) ∈ Metric.ball ((0 : Real), (0 : Real)) r := by + have hsmall' : t • z ∈ Metric.ball ((0 : Real), (0 : Real)) r := hball hsmall + rw [Metric.mem_ball, dist_eq_norm] at hsmall' ⊢ + have he : (-(t • z) : Real × Real) - (0, 0) = -(t • z) := by ext <;> simp + have he' : (t • z : Real × Real) - (0, 0) = t • z := by ext <;> simp + rw [he] + rw [he'] at hsmall' + simpa [norm_neg] using hsmall' + have hnegU : cross u (-(t • z)) < 0 := by + rw [(hcrossLinear u).map_neg, (hcrossLinear u).map_smul] + change -(t * cross u z) < 0 + rw [hzu] + exact neg_neg_of_pos (mul_pos ht hD) + have hposW : 0 < cross w (-(t • z)) := by + rw [(hcrossLinear w).map_neg, (hcrossLinear w).map_smul] + change 0 < -(t * cross w z) + rw [hzw] + nlinarith [mul_pos ht hD] + have hne₁ : H₁.Nonempty := ⟨-(t • z), hsmallNeg, hnegU⟩ + have hne₂ : H₂.Nonempty := ⟨-(t • z), hsmallNeg, hposW⟩ + have hov : (H₁ ∩ H₂).Nonempty := + ⟨-(t • z), ⟨hsmallNeg, hnegU⟩, ⟨hsmallNeg, hposW⟩⟩ + have hpWide : IsPathConnected (H₁ ∪ H₂) := + (hconv₁.isPathConnected hne₁).union (hconv₂.isPathConnected hne₂) hov + have himageWide : (fun z : Real × Real => z + v) '' (H₁ ∪ H₂) = W := by + ext x + constructor + · rintro ⟨z, hz, rfl⟩ + rcases hz with hz | hz + · rcases hz with ⟨hzball, hzu⟩ + refine ⟨?_, Or.inl ?_⟩ + · rw [Metric.mem_ball, dist_eq_norm] at hzball ⊢ + have he : (z : Real × Real) - (0, 0) = z := by ext <;> simp + rw [he] at hzball + have he' : (z + v : Real × Real) - v = z := by abel + rw [he'] + exact hzball + · simpa using hzu + · rcases hz with ⟨hzball, hzw⟩ + refine ⟨?_, Or.inr ?_⟩ + · rw [Metric.mem_ball, dist_eq_norm] at hzball ⊢ + have he : (z : Real × Real) - (0, 0) = z := by ext <;> simp + rw [he] at hzball + have he' : (z + v : Real × Real) - v = z := by abel + rw [he'] + exact hzball + · simpa using hzw + · intro hx + rcases hx with ⟨hxball, hsign⟩ + refine ⟨x - v, ?_, by simp⟩ + have hballx : x - v ∈ Metric.ball ((0 : Real), (0 : Real)) r := by + rw [Metric.mem_ball, dist_eq_norm] at hxball ⊢ + have he : (x - v : Real × Real) - (0, 0) = x - v := by ext <;> simp + rw [he] + exact hxball + rcases hsign with hsign | hsign + · exact Or.inl ⟨hballx, hsign⟩ + · exact Or.inr ⟨hballx, hsign⟩ + have hW : IsPathConnected W := + himageWide ▸ hpWide.image (continuous_id.add continuous_const) + exact ⟨hN, hW⟩ + +private theorem hzeroUNegW : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ((∀ x z : Real × Real, x ≠ 0 → cross x z = + 0 → ∃ c : Real, z = c • x) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + (∀ x : Real × Real, x ∈ Metric.ball v r → (x ∈ C ↔ x = v ∨ (∃ t : Real, 0 < t ∧ x = v + t • + u) ∨ (∃ t : Real, 0 < t ∧ x = v + t • w))) → ((u ≠ 0) → ((cross w u = -cross u w) → (0 < + cross u w → ∀ x : Real × Real, x ∈ Metric.ball v r → cross u (x - v) = 0 → cross w (x - + v) < 0 → x ∈ C))))) ) := by + classical + intro n p i C v rK prev a b cross hcrossLinear hcrosszero r u w hcarrierUW hu0 hswapuw hD x hx + hA hB + obtain ⟨t, hzt⟩ := hcrosszero u (x - v) hu0 hA + have hcalc : cross w (x - v) = -(t * cross u w) := by + rw [hzt, (hcrossLinear w).map_smul] + change t * cross w u = -(t * cross u w) + rw [hswapuw] + ring + have ht : 0 < t := by nlinarith [hB, hcalc, hD] + have hxeq : x = v + t • u := by + calc x = v + (x - v) := by abel + _ = v + t • u := by rw [hzt] + exact (hcarrierUW x hx).2 (Or.inr (Or.inl ⟨t, ht, hxeq⟩)) + +private theorem hzeroWPosU : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ((∀ x z : Real × Real, x ≠ 0 → cross x z = + 0 → ∃ c : Real, z = c • x) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + (∀ x : Real × Real, x ∈ Metric.ball v r → (x ∈ C ↔ x = v ∨ (∃ t : Real, 0 < t ∧ x = v + t • + u) ∨ (∃ t : Real, 0 < t ∧ x = v + t • w))) → ((w ≠ 0) → (0 < cross u w → ∀ x : Real × + Real, x ∈ Metric.ball v r → cross w (x - v) = 0 → 0 < cross u (x - v) → x ∈ C)))) ) + := by + classical + intro n p i C v rK prev a b cross hcrossLinear hcrosszero r u w hcarrierUW hw0 hD x hx hB hA + obtain ⟨t, hzt⟩ := hcrosszero w (x - v) hw0 hB + have hcalc : cross u (x - v) = t * cross u w := by + rw [hzt, (hcrossLinear u).map_smul] + simp only [smul_eq_mul] + have ht : 0 < t := by nlinarith [hA, hcalc, hD] + have hxeq : x = v + t • w := by + calc x = v + (x - v) := by abel + _ = v + t • w := by rw [hzt] + exact (hcarrierUW x hx).2 (Or.inr (Or.inr ⟨t, ht, hxeq⟩)) + +private theorem hzeroBoth : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ((∀ x z : Real × Real, x ≠ 0 → cross x z = + 0 → ∃ c : Real, z = c • x) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + (∀ x : Real × Real, x ∈ Metric.ball v r → (x ∈ C ↔ x = v ∨ (∃ t : Real, 0 < t ∧ x = v + t • + u) ∨ (∃ t : Real, 0 < t ∧ x = v + t • w))) → ((u ≠ 0) → ((cross w u = -cross u w) → (0 < + cross u w → ∀ x : Real × Real, x ∈ Metric.ball v r → cross u (x - v) = 0 → cross w (x - + v) = 0 → x ∈ C))))) ) := by + classical + intro n p i C v rK prev a b cross hcrossLinear hcrosszero r u w hcarrierUW hu0 hswapuw hD x hx + hA hB + obtain ⟨t, hzt⟩ := hcrosszero u (x - v) hu0 hA + have hcalc : cross w (x - v) = -(t * cross u w) := by + rw [hzt, (hcrossLinear w).map_smul] + change t * cross w u = -(t * cross u w) + rw [hswapuw] + ring + have ht : t = 0 := by nlinarith [hB, hcalc, hD] + rw [ht] at hzt + have hz : x - v = 0 := by simpa using hzt + have hxv : x = v := sub_eq_zero.mp hz + exact (hcarrierUW x hx).2 (Or.inl hxv) + +private theorem hNoff : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + (∀ x : Real × Real, x ∈ Metric.ball v r → (x ∈ C ↔ x = v ∨ (∃ t : Real, 0 < t ∧ x = v + t • + u) ∨ (∃ t : Real, 0 < t ∧ x = v + t • w))) → ( + let N : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + 0 < cross u (x - v) ∧ cross w (x - v) < 0} + (∀ z : Real × Real, cross z z = 0) → (∀ x : Real × Real, x ∈ N → x ∉ C))) ) := by + classical + intro n p i C v rK prev a b cross hcrossLinear r u w hcarrierUW N hcrossSelf x hx hxc + rcases hx with ⟨hxball, hA, hB⟩ + rcases (hcarrierUW x hxball).mp hxc with hv | hu | hw + · subst x + simp [cross] at hA + · obtain ⟨t, ht, hxeq⟩ := hu + have hz : x - v = t • u := by rw [hxeq]; abel + rw [hz, (hcrossLinear u).map_smul, hcrossSelf] at hA + simp only [smul_eq_mul, mul_zero] at hA + exact (lt_irrefl 0) hA + · obtain ⟨t, ht, hxeq⟩ := hw + have hz : x - v = t • w := by rw [hxeq]; abel + rw [hz, (hcrossLinear w).map_smul, hcrossSelf] at hB + simp only [smul_eq_mul, mul_zero] at hB + exact (lt_irrefl 0) hB + +private theorem hWoff : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + (0 < cross u w ∨ cross u w = 0) → ((∀ x : Real × Real, x ∈ Metric.ball v r → (x ∈ C ↔ x = + v ∨ + (∃ t : Real, 0 < t ∧ x = v + t • u) ∨ (∃ t : Real, 0 < t ∧ x = v + t • w))) → ( + let W : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + (cross u (x - v) < 0 ∨ 0 < cross w (x - v))} + (cross w u = -cross u w) → ((∀ z : Real × Real, cross z z = 0) → (∀ x : Real × Real, x ∈ W → + x ∉ C))))) ) := by + classical + intro n p i C v rK prev a b cross hcrossLinear r u w hdetuw hcarrierUW W hswapuw hcrossSelf x + hx hxc + rcases hx with ⟨hxball, hW⟩ + rcases (hcarrierUW x hxball).mp hxc with hv | hu | hw + · subst x + simp [cross] at hW + · obtain ⟨t, ht, hxeq⟩ := hu + have hz : x - v = t • u := by rw [hxeq]; abel + have hA : cross u (x - v) = 0 := by + rw [hz, (hcrossLinear u).map_smul, hcrossSelf] + simp + have hB : cross w (x - v) = -(t * cross u w) := by + rw [hz, (hcrossLinear w).map_smul] + change t * cross w u = -(t * cross u w) + rw [hswapuw] + ring + rcases hW with hneg | hpos + · rw [hA] at hneg + linarith + · rcases hdetuw with hDpos | hDzero + · have hBneg : cross w (x-v) < 0 := by + rw [hB] + exact neg_neg_of_pos (mul_pos ht hDpos) + linarith + · rw [hDzero] at hB + simp at hB + linarith + · obtain ⟨t, ht, hxeq⟩ := hw + have hz : x - v = t • w := by rw [hxeq]; abel + have hB : cross w (x - v) = 0 := by + rw [hz, (hcrossLinear w).map_smul, hcrossSelf] + simp + have hA : cross u (x - v) = t * cross u w := by + rw [hz, (hcrossLinear u).map_smul] + simp only [smul_eq_mul] + rcases hW with hneg | hpos + · rcases hdetuw with hDpos | hDzero + · have hApos : 0 < cross u (x-v) := by rw [hA]; exact mul_pos ht hDpos + linarith + · rw [hDzero] at hA + simp at hA + linarith + · rw [hB] at hpos + linarith + +private theorem hcover : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + let N : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + 0 < cross u (x - v) ∧ cross w (x - v) < 0} + let W : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + (cross u (x - v) < 0 ∨ 0 < cross w (x - v))} + (0 < cross u w → ∀ x : Real × Real, x ∈ Metric.ball v r → cross u (x - v) = 0 → cross w (x - + v) < 0 → x ∈ C) → ((0 < cross u w → ∀ x : Real × Real, x ∈ Metric.ball v r → cross w + (x - + v) = 0 → 0 < cross u (x - v) → x ∈ C) → ((0 < cross u w → ∀ x : Real × Real, x ∈ + Metric.ball v r → cross u (x - v) = 0 → cross w (x - v) = 0 → x ∈ C) → (0 < cross u w + → ∀ + x : Real × Real, x ∈ Metric.ball v r → x ∉ C → x ∈ N ∨ x ∈ W))) ) := by + classical + intro n p i C v rK prev a b cross r u w N W hzeroUNegW hzeroWPosU hzeroBoth hD x hx hxC + rcases lt_trichotomy 0 (cross u (x-v)) with hApos | hAzero | hAneg + · rcases lt_trichotomy 0 (cross w (x-v)) with hBpos | hBzero | hBneg + · exact Or.inr ⟨hx, Or.inr hBpos⟩ + · exact False.elim (hxC (hzeroWPosU hD x hx (by simpa using hBzero.symm) hApos)) + · exact Or.inl ⟨hx, hApos, hBneg⟩ + · rcases lt_trichotomy 0 (cross w (x-v)) with hBpos | hBzero | hBneg + · exact Or.inr ⟨hx, Or.inr hBpos⟩ + · exact False.elim (hxC (hzeroBoth hD x hx (by simpa using hAzero.symm) + (by simpa using hBzero.symm))) + · exact False.elim (hxC (hzeroUNegW hD x hx (by simpa using hAzero.symm) hBneg)) + · exact Or.inr ⟨hx, Or.inl hAneg⟩ + +private theorem hx0ballAt924 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + (0 < dist v (p.vertex (i + 1))) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + (0 < r) → ( + let d := dist v (p.vertex (i + 1)) + let τ := min (1 / 2) (r / (4 * (d + 1))) + (τ ≤ r / (4 * (d + 1))) → ( + let x0 := v + τ • a + (dist v x0 = τ * d) → (x0 ∈ Metric.ball v r)))) ) := by + classical + intro n p i v rK prev a hdistA r hr d τ hτle x0 hdistance + rw [Metric.mem_ball, dist_comm, hdistance] + have hd0 : 0 ≤ d := dist_nonneg + have hbound : τ * d ≤ (r / (4 * (d + 1))) * d := + mul_le_mul_of_nonneg_right hτle hd0 + have hfrac : (r / (4 * (d + 1))) * d < r := by + rw [div_mul_eq_mul_div, div_lt_iff₀ (by positivity)] + have hd0 : 0 ≤ d := dist_nonneg + nlinarith + exact lt_of_le_of_lt hbound hfrac + +private theorem hqaAt937 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let a := p.vertex (i + 1) - v + (a ≠ 0) → ( + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let q : Real × Real := (-a.2, a.1) + 0 < cross a q) ) := by + classical + intro n p i v a ha cross q + have hnz : a.1 ≠ 0 ∨ a.2 ≠ 0 := by + by_cases h : a.1 = 0 + · right + intro h2 + exact ha (Prod.ext h h2) + · exact Or.inl h + have hcalc : cross a q = a.1 ^ 2 + a.2 ^ 2 := by + change a.1 * a.1 - a.2 * (-a.2) = a.1 ^ 2 + a.2 ^ 2 + ring + rw [hcalc] + rcases hnz with h | h + · exact add_pos_of_pos_of_nonneg (sq_pos_of_ne_zero h) (sq_nonneg a.2) + · exact add_pos_of_nonneg_of_pos (sq_nonneg a.1) (sq_pos_of_ne_zero h) + +private theorem hUopenAt954 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let d := dist v (p.vertex (i + 1)) + let τ := min (1 / 2) (r / (4 * (d + 1))) + let x0 := v + τ • a + ∀ (rS : ℝ), + let U : Set (Real × Real) := if 0 < cross a b then + Metric.ball x0 rS ∩ Metric.ball v r ∩ {y | cross b (y-v) < 0} + else Metric.ball x0 rS ∩ Metric.ball v r ∩ {y | 0 < cross b (y-v)} + IsOpen U ) := by + classical + intro n p i v rK prev a b cross r d τ x0 rS U + by_cases hab : 0 < cross a b + · have hc : Continuous (fun y : Real × Real => cross b (y-v)) := by + change Continuous (fun y : Real × Real => + b.1 * (y.2-v.2) - b.2 * (y.1-v.1)) + fun_prop + simp only [U, ite_eq_left hab] + exact (Metric.isOpen_ball.inter Metric.isOpen_ball).inter + (isOpen_lt hc (continuous_const : Continuous fun _ : Real × Real => (0 : Real))) + · have hc : Continuous (fun y : Real × Real => cross b (y-v)) := by + change Continuous (fun y : Real × Real => + b.1 * (y.2-v.2) - b.2 * (y.1-v.1)) + fun_prop + simp only [U, ite_eq_right hab] + exact (Metric.isOpen_ball.inter Metric.isOpen_ball).inter + (isOpen_lt (continuous_const : Continuous fun _ : Real × Real => (0 : Real)) hc) + +private theorem hx0UAt970 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + ((0 : ℝ) < cross u w) → ( + let d := dist v (p.vertex (i + 1)) + let τ := min (1 / 2) (r / (4 * (d + 1))) + (0 < τ) → ( + let x0 := v + τ • a + (x0 ∈ Metric.ball v r) → ((x0 - v = τ • a) → (∀ (rS : ℝ), ((0 : ℝ) < rS) → ( + let U : Set (Real × Real) := if 0 < cross a b then + Metric.ball x0 rS ∩ Metric.ball v r ∩ {y | cross b (y-v) < 0} + else Metric.ball x0 rS ∩ Metric.ball v r ∩ {y | 0 < cross b (y-v)} + x0 ∈ U)))))) ) := by + classical + intro n p i v rK prev a b cross hcrossLinear r u w hD d τ hτ x0 hx0ball hx0form rS hrS U + by_cases hab : 0 < cross a b + · have hbcalc : cross b (x0-v) = -(τ * cross a b) := by + rw [hx0form, (hcrossLinear b).map_smul] + change τ * cross b a = -(τ * cross a b) + have hswap : cross b a = -cross a b := by dsimp [cross]; ring + rw [hswap] + ring + have hbneg : cross b (x0-v) < 0 := by rw [hbcalc]; exact neg_neg_of_pos (mul_pos hτ hab) + simp [U, hab, Metric.mem_ball_self hrS, hx0ball, hbneg] + · have habneg : cross a b < 0 := by + have hba : 0 < cross b a := by simpa [u, w, hab] using hD + have hswap : cross b a = -cross a b := by dsimp [cross]; ring + rw [hswap] at hba + linarith + have hbcalc : cross b (x0-v) = -(τ * cross a b) := by + rw [hx0form, (hcrossLinear b).map_smul] + change τ * cross b a = -(τ * cross a b) + have hswap : cross b a = -cross a b := by dsimp [cross]; ring + rw [hswap] + ring + have hbpos : 0 < cross b (x0-v) := by + rw [hbcalc] + exact neg_pos.mpr (mul_neg_of_pos_of_neg hτ habneg) + simp [U, hab, Metric.mem_ball_self hrS, hx0ball, hbpos] + +private theorem hplusball : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let d := dist v (p.vertex (i + 1)) + let τ := min (1 / 2) (r / (4 * (d + 1))) + let x0 := v + τ • a + let q : Real × Real := (-a.2, a.1) + ∀ (δ : ℝ), ∀ (s : ℝ), (‖s • q‖ < δ) → (x0 + s • q ∈ Metric.ball x0 δ) ) := by + classical + intro n p i v rK prev a r d τ x0 q δ s hsmallNorm + have hdist : dist (x0 + s • q) x0 = dist (s • q) (0, 0) := by + rw [dist_eq_norm, dist_eq_norm] + congr 1 + ext <;> simp + rw [Metric.mem_ball, hdist] + rw [dist_eq_norm] + have he : (s • q : Real × Real) - (0, 0) = s • q := by ext <;> simp + rw [he] + exact hsmallNorm + +private theorem hminusball : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let d := dist v (p.vertex (i + 1)) + let τ := min (1 / 2) (r / (4 * (d + 1))) + let x0 := v + τ • a + let q : Real × Real := (-a.2, a.1) + ∀ (δ : ℝ), ∀ (s : ℝ), (‖s • q‖ < δ) → (x0 - s • q ∈ Metric.ball x0 δ) ) := by + classical + intro n p i v rK prev a r d τ x0 q δ s hsmallNorm + have hdist : dist (x0 - s • q) x0 = dist (-(s • q)) (0, 0) := by + rw [dist_eq_norm, dist_eq_norm] + congr 1 + ext <;> simp + rw [Metric.mem_ball, hdist] + rw [dist_eq_norm] + have he : (-(s • q) : Real × Real) - (0, 0) = -(s • q) := by ext <;> simp + rw [he] + simpa only [norm_neg] using hsmallNorm + +private theorem hAminusAt1037 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + (∀ z : Real × Real, cross z z = 0) → ( + let d := dist v (p.vertex (i + 1)) + let τ := min (1 / 2) (r / (4 * (d + 1))) + let x0 := v + τ • a + let q : Real × Real := (-a.2, a.1) + ∀ (s : ℝ), + let ym := x0 - s • q + cross a (ym-v) = -(s * cross a q))) ) := by + classical + intro n p i v rK prev a cross hcrossLinear r hcrossSelf d τ x0 q s ym + have he : ym-v = τ • a - s • q := by + ext <;> simp [ym, x0] <;> ring + calc + cross a (ym-v) = cross a (τ • a - s • q) := by rw [he] + _ = cross a (τ • a) - cross a (s • q) := (hcrossLinear a).map_sub _ _ + _ = 0 - s * cross a q := by + rw [(hcrossLinear a).map_smul, (hcrossLinear a).map_smul, hcrossSelf] + simp only [smul_eq_mul, mul_zero] + _ = -(s * cross a q) := by ring + +private theorem hOppAt1058 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let d := dist v (p.vertex (i + 1)) + let τ := min (1 / 2) (r / (4 * (d + 1))) + let x0 := v + τ • a + ∀ (rS : ℝ), (∃ (s : Bool), ∀ y ∈ Metric.ball x0 rS, y ∈ P3544T1RayParity p ↔ if s = true + then (0 : ℝ) < P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i + (1 : Fin (n + (3 + : ℕ)))), y] else P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i + (1 : Fin (n + + (3 : ℕ)))), y] < (0 : ℝ)) → ( + let q : Real × Real := (-a.2, a.1) + let U : Set (Real × Real) := if 0 < cross a b then + Metric.ball x0 rS ∩ Metric.ball v r ∩ {y | cross b (y-v) < 0} + else Metric.ball x0 rS ∩ Metric.ball v r ∩ {y | 0 < cross b (y-v)} + ∀ (s : ℝ), + let yp := x0 + s • q + let ym := x0 - s • q + (yp ∈ U) → ((ym ∈ U) → ((0 < P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), yp]) + → ((P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), ym] < 0) → ((yp ∈ O ↔ + ym ∉ + O)))))) ) := by + classical + intro n p i O v rK prev a b cross r d τ x0 rS hside q U s yp ym hypU hymU hdetp hdetm + rcases hside with ⟨sbit, hrule⟩ + have hypS : yp ∈ Metric.ball x0 rS := by + by_cases hab : 0 < cross a b + · have ht := hypU + simp only [U, ite_eq_left hab, Set.mem_inter_iff, Set.mem_ofPred_eq] at ht + exact ht.1.1 + · have ht := hypU + simp only [U, ite_eq_right hab, Set.mem_inter_iff, Set.mem_ofPred_eq] at ht + exact ht.1.1 + have hymS : ym ∈ Metric.ball x0 rS := by + by_cases hab : 0 < cross a b + · have ht := hymU + simp only [U, ite_eq_left hab, Set.mem_inter_iff, Set.mem_ofPred_eq] at ht + exact ht.1.1 + · have ht := hymU + simp only [U, ite_eq_right hab, Set.mem_inter_iff, Set.mem_ofPred_eq] at ht + exact ht.1.1 + by_cases hsbit : sbit + · have hpiff := hrule yp hypS + have hmiff := hrule ym hymS + have hpiff' : yp ∈ O ↔ 0 < P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), yp] := by + simpa only [O, ite_eq_left hsbit] using hpiff + have hmiff' : ym ∈ O ↔ 0 < P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), ym] := by + simpa only [O, ite_eq_left hsbit] using hmiff + have hp : yp ∈ O := hpiff'.mpr hdetp + have hm : ym ∉ O := by + intro hm + have hh := hmiff'.mp hm + linarith + simp [hp, hm] + · have hpiff := hrule yp hypS + have hmiff := hrule ym hymS + have hpiff' : yp ∈ O ↔ P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), yp] < 0 := by + simpa only [O, ite_eq_right hsbit] using hpiff + have hmiff' : ym ∈ O ↔ P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), ym] < 0 := by + simpa only [O, ite_eq_right hsbit] using hmiff + have hp : yp ∉ O := by + intro hp + have hh := hpiff'.mp hp + linarith + have hm : ym ∈ O := hmiff'.mpr hdetm + simp [hp, hm] + +private theorem hOddEqAt1181 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + let N : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + 0 < cross u (x - v) ∧ cross w (x - v) < 0} + let W : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + (cross u (x - v) < 0 ∨ 0 < cross w (x - v))} + (0 < cross u w → ∀ x : Real × Real, x ∈ Metric.ball v r → x ∉ C → x ∈ N ∨ x ∈ W) → (((0 : ℝ) + < cross u w) → (∀ (xN : ℝ × ℝ), ∀ (xW : ℝ × ℝ), (xN ∈ O ↔ xW ∉ O) → ((∀ x, x ∈ N → (x + ∈ O + ↔ xN ∈ O)) → ((∀ x, x ∈ W → (x ∈ O ↔ xW ∈ O)) → ((∀ x, x ∈ O → x ∉ C) → ((xN ∈ O) → + (Metric.ball v r ∩ O = N))))))) ) := by + classical + intro n p i O C v rK prev a b cross r u w N W hcover hD xN xW hOpp hNconstant hWconstant hOoff hn + ext x + constructor + · rintro ⟨hxb, hxo⟩ + rcases hcover hD x hxb (hOoff x hxo) with hxn | hxw + · exact hxn + · have hxwo := (hWconstant x hxw).mp hxo + exact False.elim ((hOpp.mp hn) hxwo) + · intro hxn + have hxo : x ∈ O := (hNconstant x hxn).mpr hn + exact ⟨hxn.1, hxo⟩ + +private theorem hEvenEqAt1192 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + let N : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + 0 < cross u (x - v) ∧ cross w (x - v) < 0} + let W : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + (cross u (x - v) < 0 ∨ 0 < cross w (x - v))} + (∀ x : Real × Real, x ∈ W → x ∉ C) → ((0 < cross u w → ∀ x : Real × Real, x ∈ Metric.ball + v r + → x ∉ C → x ∈ N ∨ x ∈ W) → (((0 : ℝ) < cross u w) → (∀ (xN : ℝ × ℝ), ∀ (xW : ℝ × ℝ), (xN + ∈ O ↔ xW ∉ O) → ((∀ x, x ∈ N → (x ∈ O ↔ xN ∈ O)) → ((∀ x, x ∈ W → (x ∈ O ↔ xW ∈ O)) → + ((xN ∈ O) → (Metric.ball v r \ (O ∪ C) = W))))))) ) := by + classical + intro n p i O C v rK prev a b cross r u w N W hWoff hcover hD xN xW hOpp hNconstant hWconstant hn + ext x + constructor + · rintro ⟨hxb, hnot⟩ + have hnotO : x ∉ O := by intro hxo; exact hnot (Or.inl hxo) + have hnotC : x ∉ C := by intro hxc; exact hnot (Or.inr hxc) + rcases hcover hD x hxb hnotC with hxn | hxw + · have hxo := (hNconstant x hxn).mpr hn + exact False.elim (hnotO hxo) + · exact hxw + · intro hxw + have hnotO : x ∉ O := by + intro hxo + have hxwo := (hWconstant x hxw).mp hxo + exact (hOpp.mp hn) hxwo + have hnotC := hWoff x hxw + refine ⟨hxw.1, ?_⟩ + intro hu + rcases hu with hxo | hxc + · exact hnotO hxo + · exact hnotC hxc + +private theorem hOddEqAt1218 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + let N : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + 0 < cross u (x - v) ∧ cross w (x - v) < 0} + let W : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + (cross u (x - v) < 0 ∨ 0 < cross w (x - v))} + (0 < cross u w → ∀ x : Real × Real, x ∈ Metric.ball v r → x ∉ C → x ∈ N ∨ x ∈ W) → (((0 : ℝ) + < cross u w) → (∀ (xN : ℝ × ℝ), ∀ (xW : ℝ × ℝ), (xN ∈ O ↔ xW ∉ O) → ((∀ x, x ∈ N → (x + ∈ O + ↔ xN ∈ O)) → ((∀ x, x ∈ W → (x ∈ O ↔ xW ∈ O)) → ((∀ x, x ∈ O → x ∉ C) → ((xN ∉ O) → + (Metric.ball v r ∩ O = W))))))) ) := by + classical + intro n p i O C v rK prev a b cross r u w N W hcover hD xN xW hOpp hNconstant hWconstant hOoff hn + ext x + constructor + · rintro ⟨hxb, hxo⟩ + rcases hcover hD x hxb (hOoff x hxo) with hxn | hxw + · have hxno := (hNconstant x hxn).mp hxo + exact False.elim (hn hxno) + · exact hxw + · intro hxw + have hxwo : xW ∈ O := by + by_contra hnotW + exact hn (hOpp.mpr hnotW) + have hxo : x ∈ O := (hWconstant x hxw).mpr hxwo + exact ⟨hxw.1, hxo⟩ + +private theorem hEvenEqAt1232 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + let N : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + 0 < cross u (x - v) ∧ cross w (x - v) < 0} + let W : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + (cross u (x - v) < 0 ∨ 0 < cross w (x - v))} + (∀ x : Real × Real, x ∈ N → x ∉ C) → ((0 < cross u w → ∀ x : Real × Real, x ∈ Metric.ball + v r + → x ∉ C → x ∈ N ∨ x ∈ W) → (((0 : ℝ) < cross u w) → (∀ (xN : ℝ × ℝ), ∀ (xW : ℝ × ℝ), (xN + ∈ O ↔ xW ∉ O) → ((∀ x, x ∈ N → (x ∈ O ↔ xN ∈ O)) → ((∀ x, x ∈ W → (x ∈ O ↔ xW ∈ O)) → + ((xN ∉ O) → (Metric.ball v r \ (O ∪ C) = N))))))) ) := by + classical + intro n p i O C v rK prev a b cross r u w N W hNoff hcover hD xN xW hOpp hNconstant hWconstant hn + ext x + constructor + · rintro ⟨hxb, hnot⟩ + have hnotC : x ∉ C := by intro hxc; exact hnot (Or.inr hxc) + have hnotO : x ∉ O := by intro hxo; exact hnot (Or.inl hxo) + rcases hcover hD x hxb hnotC with hxn | hxw + · exact hxn + · have hxwo : xW ∈ O := by + by_contra hnotW + exact hn (hOpp.mpr hnotW) + have hxo := (hWconstant x hxw).mpr hxwo + exact False.elim (hnotO hxo) + · intro hxn + have hnotO : x ∉ O := by + intro hxo + exact hn ((hNconstant x hxn).mp hxo) + have hnotC := hNoff x hxn + refine ⟨hxn.1, ?_⟩ + intro hu + rcases hu with hxo | hxc + · exact hnotO hxo + · exact hnotC hxc + +private theorem hcneg : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (¬ ∃ c : Real, 0 < c ∧ b = c • a) → ( + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + ∀ (c : ℝ), (w = c • u) → ((c ≠ 0) → (c < 0))) ) := by + classical + intro n p i v prev a b cross hnoPosMultiple u w c hcw hcne + have hcnot : ¬0 < c := by + intro hcpos + by_cases hab : 0 < cross a b + · apply hnoPosMultiple ⟨c, hcpos, ?_⟩ + simpa [u, w, hab] using hcw + · have hcw' : a = c • b := by simpa [u, w, hab] using hcw + have hrel : b = c⁻¹ • a := by + have hmul : c⁻¹ * c = (1 : Real) := inv_mul_cancel₀ hcne + calc + b = (1 : Real) • b := by simp + _ = (c⁻¹ * c) • b := by rw [hmul] + _ = c⁻¹ • (c • b) := by rw [smul_smul] + _ = c⁻¹ • a := by rw [← hcw'] + exact hnoPosMultiple ⟨c⁻¹, inv_pos.mpr hcpos, hrel⟩ + exact lt_of_le_of_ne (le_of_not_gt hcnot) hcne + +private theorem hlineCarrier : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ x z : Real × Real, x ≠ 0 → cross x z = 0 → ∃ c : Real, z = c • x) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + (∀ x : Real × Real, x ∈ Metric.ball v r → (x ∈ C ↔ x = v ∨ (∃ t : Real, 0 < t ∧ x = v + t • + u) ∨ (∃ t : Real, 0 < t ∧ x = v + t • w))) → ((u ≠ 0) → (∀ (c : ℝ), (w = c • u) → ((c ≠ + 0) → ((c < 0) → (∀ x ∈ Metric.ball v r, cross u (x-v) = 0 → x ∈ C)))))) ) := by + classical + intro n p i C v rK prev a b cross hcrosszero r u w hcarrierUW hu0 c hcw hcne hcneg x hx hzero + obtain ⟨t, hzt⟩ := hcrosszero u (x-v) hu0 hzero + have hxform : x = v + t • u := by + calc x = v + (x-v) := by abel + _ = v + t • u := by rw [hzt] + by_cases ht : 0 < t + · exact (hcarrierUW x hx).2 (Or.inr (Or.inl ⟨t, ht, hxform⟩)) + · by_cases ht0 : t = 0 + · rw [ht0, zero_smul] at hxform + exact (hcarrierUW x hx).2 (Or.inl (by simpa using hxform)) + · have htneg : t < 0 := lt_of_le_of_ne (le_of_not_gt ht) ht0 + have htc : 0 < t / c := div_pos_of_neg_of_neg htneg hcneg + have hsmul : t • u = (t / c) • w := by + rw [hcw, smul_smul, div_mul_cancel₀ t hcne] + rw [hsmul] at hxform + exact (hcarrierUW x hx).2 (Or.inr (Or.inr ⟨t / c, htc, hxform⟩)) + +private theorem hcarrierZero : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + (∀ x : Real × Real, x ∈ Metric.ball v r → (x ∈ C ↔ x = v ∨ (∃ t : Real, 0 < t ∧ x = v + t • + u) ∨ (∃ t : Real, 0 < t ∧ x = v + t • w))) → ((∀ z : Real × Real, cross z z = 0) → (∀ + (c : ℝ), (w = c • u) → (∀ x, x ∈ Metric.ball v r → x ∈ C → cross u (x-v) = 0)))) + ) := by + classical + intro n p i C v rK prev a b cross hcrossLinear r u w hcarrierUW hcrossSelf c hcw x hx hxc + rcases (hcarrierUW x hx).mp hxc with hv | hu | hw + · subst x + simp [cross] + · obtain ⟨t, ht, he⟩ := hu + have he' : x-v = t • u := by rw [he]; abel + rw [he', (hcrossLinear u).map_smul, hcrossSelf] + simp + · obtain ⟨t, ht, he⟩ := hw + have he' : x-v = t • w := by rw [he]; abel + rw [he', hcw, (hcrossLinear u).map_smul, (hcrossLinear u).map_smul, hcrossSelf] + simp + +private theorem hqu : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + (a ≠ 0) → ((b ≠ 0) → ( + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let u := if 0 < cross a b then a else b + let qline : Real × Real := (-u.2, u.1) + 0 < cross u qline)) ) := by + classical + intro n p i v prev a b ha hb cross u qline + have hnz : u.1 ≠ 0 ∨ u.2 ≠ 0 := by + by_cases hpos : 0 < cross a b + · have hA : a.1 ≠ 0 ∨ a.2 ≠ 0 := by + by_contra h + push Not at h + exact ha (Prod.ext h.1 h.2) + simpa only [u, ite_eq_left hpos] using hA + · have hB : b.1 ≠ 0 ∨ b.2 ≠ 0 := by + by_contra h + push Not at h + exact hb (Prod.ext h.1 h.2) + simpa only [u, ite_eq_right hpos] using hB + have hcalc : cross u qline = u.1 ^ 2 + u.2 ^ 2 := by + change u.1 * u.1 - u.2 * (-u.2) = u.1 ^ 2 + u.2 ^ 2 + ring + rw [hcalc] + rcases hnz with h | h + · exact add_pos_of_pos_of_nonneg (sq_pos_of_ne_zero h) (sq_nonneg u.2) + · exact add_pos_of_nonneg_of_pos (sq_nonneg u.1) (sq_pos_of_ne_zero h) + +private theorem htranslate : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + ∀ z : Real × Real, z ∈ Metric.ball (0, 0) r → v + z ∈ Metric.ball v r ) := by + classical + intro n p i v rK prev r z hz + have hzero : ((0 : Real), (0 : Real)) = (0 : Real × Real) := by + ext <;> simp + have he : dist (v + z) v = dist z (0, 0) := by + calc + dist (v + z) v = dist (v + z) (v + (0 : Real × Real)) := by simp + _ = dist z 0 := dist_add_left v z 0 + _ = dist z (0, 0) := by rw [← hzero] + rw [Metric.mem_ball, he] + exact hz + +private theorem hxmdet : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ( + let u := if 0 < cross a b then a else b + let qline : Real × Real := (-u.2, u.1) + (0 < cross u qline) → (∀ (tm : ℝ), ((0 : ℝ) < tm) → ( + let xm := v + (-tm) • qline + cross u (xm-v) < 0))) ) := by + classical + intro n p i v prev a b cross hcrossLinear u qline hqu tm htm xm + have he : xm-v = (-tm) • qline := by + dsimp only [xm] + exact add_sub_cancel_left v ((-tm) • qline) + have hpos : 0 < tm * cross u qline := mul_pos htm hqu + calc + cross u (xm-v) = (-tm) * cross u qline := by + rw [he, (hcrossLinear u).map_smul, smul_eq_mul] + _ = -(tm * cross u qline) := by rw [neg_mul] + _ < 0 := neg_neg_of_pos hpos + +private theorem htranslateAt : + (by + classical + exact + ∀ (x0 : ℝ × ℝ), ∀ (δ : ℝ), ∀ z : Real × Real, z ∈ Metric.ball (0, 0) δ → x0 + z ∈ + Metric.ball + x0 δ ) := by + classical + intro x0 δ z hz + have hz0 : ((0 : Real), (0 : Real)) = (0 : Real × Real) := by ext <;> simp + have he : dist (x0 + z) x0 = dist z (0, 0) := by + calc + dist (x0 + z) x0 = dist (x0 + z) (x0 + (0 : Real × Real)) := by simp + _ = dist z 0 := dist_add_left x0 z 0 + _ = dist z (0, 0) := by rw [← hz0] + rw [Metric.mem_ball, he] + exact hz + +private theorem hOppAt1494 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let qline : Real × Real := (-u.2, u.1) + let qside : Real × Real := if 0 < cross a qline then qline else -qline + ∀ (x0 : ℝ × ℝ), ∀ (rS : ℝ), (∃ (s : Bool), ∀ y ∈ Metric.ball x0 rS, y ∈ P3544T1RayParity p + ↔ if s = true then (0 : ℝ) < P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i + (1 + : Fin (n + (3 : ℕ)))), y] else P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i + + (1 : Fin (n + (3 : ℕ)))), y] < (0 : ℝ)) → ( + let U : Set (Real × Real) := Metric.ball x0 rS ∩ Metric.ball v r + ∀ (s : ℝ), ∀ (t : ℝ), + let yp := x0 + s • qside + let ym := x0 + t • (-qside) + (yp ∈ U) → ((ym ∈ U) → ((0 < P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), yp]) + → ((P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), ym] < 0) → ((yp ∈ O ↔ + ym ∉ + O)))))) ) := by + classical + intro n p i O v rK prev a b cross r u qline qside x0 rS hside U s t yp ym hypU hymU hdetp hdetm + rcases hside with ⟨sbit, hrule⟩ + have hypS : yp ∈ Metric.ball x0 rS := hypU.1 + have hymS : ym ∈ Metric.ball x0 rS := hymU.1 + by_cases hsbit : sbit + · have hpiff := hrule yp hypS + have hmiff := hrule ym hymS + have hpiff' : yp ∈ O ↔ 0 < P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), yp] := by + simpa only [O, ite_eq_left hsbit] using hpiff + have hmiff' : ym ∈ O ↔ 0 < P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), ym] := by + simpa only [O, ite_eq_left hsbit] using hmiff + have hp : yp ∈ O := hpiff'.mpr hdetp + have hm : ym ∉ O := by intro hm; have hh := hmiff'.mp hm; linarith + simp [hp, hm] + · have hpiff := hrule yp hypS + have hmiff := hrule ym hymS + have hpiff' : yp ∈ O ↔ P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), yp] < 0 := by + simpa only [O, ite_eq_right hsbit] using hpiff + have hmiff' : ym ∈ O ↔ P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), ym] < 0 := by + simpa only [O, ite_eq_right hsbit] using hmiff + have hp : yp ∉ O := by intro hp; have hh := hpiff'.mp hp; linarith + have hm : ym ∈ O := hmiff'.mpr hdetm + simp [hp, hm] + +private theorem hLopp : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let Lp : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ 0 < cross u (x-v)} + let Lm : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ cross u (x-v) < 0} + let qline : Real × Real := (-u.2, u.1) + let qside : Real × Real := if 0 < cross a qline then qline else -qline + (0 < cross u qside ∨ cross u qside < 0) → (∀ (x0 : ℝ × ℝ), ∀ (rS : ℝ), + let U : Set (Real × Real) := Metric.ball x0 rS ∩ Metric.ball v r + ∀ (s : ℝ), ((0 : ℝ) < s) → (∀ (t : ℝ), ((0 : ℝ) < t) → ( + let yp := x0 + s • qside + let ym := x0 + t • (-qside) + (yp ∈ U) → ((ym ∈ U) → (((yp ∈ O ↔ ym ∉ O)) → ((cross u (yp-v) = s * cross u qside) → + ((cross + u (ym-v) = -(t * cross u qside)) → (∃ xP ∈ Lp, ∃ xM ∈ Lm, (xP ∈ O ↔ xM ∉ O))))))))) ) + := by + classical + intro n p i O v rK prev a b cross r u Lp Lm qline qside hcrossuQ x0 rS U s hs t ht yp ym hypU + hymU hOpp hUplus hUminus + rcases hcrossuQ with huq | huq + · have hP : yp ∈ Lp := ⟨hypU.2, by rw [hUplus]; exact mul_pos hs huq⟩ + have hM : ym ∈ Lm := ⟨hymU.2, by rw [hUminus]; exact neg_neg_of_pos (mul_pos ht huq)⟩ + exact ⟨yp, hP, ym, hM, hOpp⟩ + · have hP : ym ∈ Lp := ⟨hymU.2, by rw [hUminus]; exact neg_pos.mpr (mul_neg_of_pos_of_neg ht huq)⟩ + have hM : yp ∈ Lm := ⟨hypU.2, by rw [hUplus]; exact mul_neg_of_pos_of_neg hs huq⟩ + have hOpp' : (ym ∈ O ↔ yp ∉ O) := by + constructor + · intro hym hyo + exact (hOpp.mp hyo) hym + · intro hnp + by_contra hym + exact hnp (hOpp.mpr hym) + exact ⟨ym, hP, yp, hM, hOpp'⟩ + +private theorem hOddEqAt1554 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let Lp : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ 0 < cross u (x-v)} + let Lm : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ cross u (x-v) < 0} + (∀ x ∈ Metric.ball v r, x ∉ C → x ∈ Lp ∨ x ∈ Lm) → (∀ (xP : ℝ × ℝ), ∀ (xM : ℝ × ℝ), (xP ∈ + O ↔ + xM ∉ O) → ((∀ x, x ∈ Lp → (x ∈ O ↔ xP ∈ O)) → ((∀ x, x ∈ Lm → (x ∈ O ↔ xM ∈ O)) → ((∀ + x, x ∈ O → x ∉ C) → ((xP ∈ O) → (Metric.ball v r ∩ O = Lp)))))) ) := by + classical + intro n p i O C v rK prev a b cross r u Lp Lm hLcover xP xM hOpp hPconstant hMconstant hOoff hn + ext x + constructor + · rintro ⟨hxb, hxo⟩ + rcases hLcover x hxb (hOoff x hxo) with hxp | hxm + · exact hxp + · have hxmo := (hMconstant x hxm).mp hxo + exact False.elim ((hOpp.mp hn) hxmo) + · intro hxp + have hxo : x ∈ O := (hPconstant x hxp).mpr hn + exact ⟨hxp.1, hxo⟩ + +private theorem hEvenEqAt1565 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let Lp : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ 0 < cross u (x-v)} + let Lm : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ cross u (x-v) < 0} + (∀ x, x ∈ Lm → x ∉ C) → ((∀ x ∈ Metric.ball v r, x ∉ C → x ∈ Lp ∨ x ∈ Lm) → (∀ (xP : ℝ × + ℝ), ∀ (xM : ℝ × ℝ), (xP ∈ O ↔ xM ∉ O) → ((∀ x, x ∈ Lp → (x ∈ O ↔ xP ∈ O)) → ((∀ x, x + ∈ Lm → + (x ∈ O ↔ xM ∈ O)) → ((xP ∈ O) → (Metric.ball v r \ (O ∪ C) = Lm)))))) ) := by + classical + intro n p i O C v rK prev a b cross r u Lp Lm hLmoff hLcover xP xM hOpp hPconstant hMconstant hn + ext x + constructor + · rintro ⟨hxb, hnot⟩ + have hnotO : x ∉ O := by intro hxo; exact hnot (Or.inl hxo) + have hnotC : x ∉ C := by intro hxc; exact hnot (Or.inr hxc) + rcases hLcover x hxb hnotC with hxp | hxm + · have hxo := (hPconstant x hxp).mpr hn + exact False.elim (hnotO hxo) + · exact hxm + · intro hxm + have hnotO : x ∉ O := by + intro hxo + have hxmo := (hMconstant x hxm).mp hxo + exact (hOpp.mp hn) hxmo + have hnotC := hLmoff x hxm + refine ⟨hxm.1, ?_⟩ + intro hu + rcases hu with hxo | hxc + · exact hnotO hxo + · exact hnotC hxc + +private theorem hOddEqAt1591 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let Lp : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ 0 < cross u (x-v)} + let Lm : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ cross u (x-v) < 0} + (∀ x ∈ Metric.ball v r, x ∉ C → x ∈ Lp ∨ x ∈ Lm) → (∀ (xP : ℝ × ℝ), ∀ (xM : ℝ × ℝ), (xP ∈ + O ↔ + xM ∉ O) → ((∀ x, x ∈ Lp → (x ∈ O ↔ xP ∈ O)) → ((∀ x, x ∈ Lm → (x ∈ O ↔ xM ∈ O)) → ((∀ + x, x ∈ O → x ∉ C) → ((xP ∉ O) → (Metric.ball v r ∩ O = Lm)))))) ) := by + classical + intro n p i O C v rK prev a b cross r u Lp Lm hLcover xP xM hOpp hPconstant hMconstant hOoff hn + ext x + constructor + · rintro ⟨hxb, hxo⟩ + rcases hLcover x hxb (hOoff x hxo) with hxp | hxm + · have hxpo := (hPconstant x hxp).mp hxo + exact False.elim (hn hxpo) + · exact hxm + · intro hxm + have hxmo : xM ∈ O := by + by_contra hnotM + exact hn (hOpp.mpr hnotM) + have hxo : x ∈ O := (hMconstant x hxm).mpr hxmo + exact ⟨hxm.1, hxo⟩ + +private theorem hEvenEqAt1605 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let Lp : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ 0 < cross u (x-v)} + let Lm : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ cross u (x-v) < 0} + (∀ x, x ∈ Lp → x ∉ C) → ((∀ x ∈ Metric.ball v r, x ∉ C → x ∈ Lp ∨ x ∈ Lm) → (∀ (xP : ℝ × + ℝ), ∀ (xM : ℝ × ℝ), (xP ∈ O ↔ xM ∉ O) → ((∀ x, x ∈ Lp → (x ∈ O ↔ xP ∈ O)) → ((∀ x, x + ∈ Lm → + (x ∈ O ↔ xM ∈ O)) → ((xP ∉ O) → (Metric.ball v r \ (O ∪ C) = Lp)))))) ) := by + classical + intro n p i O C v rK prev a b cross r u Lp Lm hLpoff hLcover xP xM hOpp hPconstant hMconstant hn + ext x + constructor + · rintro ⟨hxb, hnot⟩ + have hnotC : x ∉ C := by intro hxc; exact hnot (Or.inr hxc) + have hnotO : x ∉ O := by intro hxo; exact hnot (Or.inl hxo) + rcases hLcover x hxb hnotC with hxp | hxm + · exact hxp + · have hxmo : xM ∈ O := by + by_contra hnotM + exact hn (hOpp.mpr hnotM) + have hxo := (hMconstant x hxm).mpr hxmo + exact False.elim (hnotO hxo) + · intro hxp + have hnotO : x ∉ O := by + intro hxo + exact hn ((hPconstant x hxp).mp hxo) + have hnotC := hLpoff x hxp + refine ⟨hxp.1, ?_⟩ + intro hu + rcases hu with hxo | hxc + · exact hnotO hxo + · exact hnotC hxc + +end VertexSectorProof + +namespace VertexSectorDetails + +private theorem hsegcompact : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ j : Fin (n + 3), IsCompact (segment + Real (p.vertex j) (p.vertex (j + 1))) ) := by + classical + intro n p j + rw [segment_eq_image_lineMap] + exact isCompact_Icc.image AffineMap.lineMap_continuous + +private theorem hKcompact : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), (∀ j : Fin (n + 3), + IsCompact (segment Real (p.vertex j) (p.vertex (j + 1)))) → ( + let J : Set (Fin (n + 3)) := {j | j ≠ i ∧ j + 1 ≠ i} + let K : Set (Real × Real) := ⋃ j ∈ J, + segment Real (p.vertex j) (p.vertex (j + 1)) + IsCompact K) ) := by + classical + intro n p i hsegcompact J K + dsimp [K] + exact (Set.toFinite J).isCompact_biUnion fun j hj => hsegcompact j + +private theorem hprev : + (by + classical + exact + ∀ (n : Nat), ∀ (i : Fin (n + 3)), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + prev + 1 = i ) := by + classical + intro n i prev + apply Fin.ext + simp only [Fin.val_add] + by_cases h : i.val = 0 + · simp [prev, h] + · have hiv := i.isLt + simp? [prev, h] + rw [Nat.sub_add_cancel (Nat.one_le_iff_ne_zero.mpr h), Nat.mod_eq_of_lt hiv] + +private theorem hprevne : + (by + classical + exact + ∀ (n : Nat), ∀ (i : Fin (n + 3)), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + (prev + 1 = i) → ((∀ j : Fin (n + 3), j + 1 ≠ j) → (prev ≠ i)) ) := by + classical + intro n i prev hprev haddne heq + have : i + 1 = i := by simp [heq] at hprev + exact haddne i this + +private theorem hnextVertex : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + (i + 1 ≠ i) → (p.vertex (i + 1) ≠ v) ) := by + classical + intro n p i v hnextne h + have hi : i + 1 = i := p.injective (by simpa [v] using h) + exact hnextne hi + +private theorem hprevVertex : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + (prev ≠ i) → (p.vertex prev ≠ v) ) := by + classical + intro n p i v prev hprevne h + have hi : prev = i := p.injective (by simpa [v] using h) + exact hprevne hi + +private theorem hcrossLinear : + (by + classical + exact + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + ∀ u : Real × Real, IsLinearMap Real (cross u) ) := by + classical + intro cross u + refine IsLinearMap.mk ?_ ?_ + · intro x y + simp [cross, mul_add] + ring + · intro c x + simp [cross] + ring + +private theorem hr : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + ∀ (rK : ℝ), ∀ (hrK : rK > (0 : ℝ)), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + (0 < dist v (p.vertex (i + 1))) → ((0 < dist v (p.vertex prev)) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + 0 < r)) ) := by + classical + intro n p i v rK hrK prev hdistA hdistB r + dsimp [r] + positivity + +private theorem hlineMap : + (by + classical + exact + ∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x y t = x + t • (y - x) ) := by + classical + intro x y t + rw [AffineMap.lineMap_apply_module] + module + +private theorem hdistRadial : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + ∀ (u : Real × Real), ∀ (t : Real), 0 ≤ t → dist (v + t • u) v = t * dist (v + u) v ) := by + classical + intro n p i v u t ht + rw [dist_eq_norm, dist_eq_norm] + have h1 : v + t • u - v = t • u := by abel + have h2 : v + u - v = u := by abel + rw [h1, h2, norm_smul, Real.norm_eq_abs, abs_of_nonneg ht] + +private theorem hu0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + (a ≠ 0) → ((b ≠ 0) → ( + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let u := if 0 < cross a b then a else b + u ≠ 0)) ) := by + classical + intro n p i v prev a b ha hb cross u + by_cases hpos : 0 < cross a b + · simpa only [u, ite_eq_left hpos] using ha + · simpa only [u, ite_eq_right hpos] using hb + +private theorem hw0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + (a ≠ 0) → ((b ≠ 0) → ( + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let w := if 0 < cross a b then b else a + w ≠ 0)) ) := by + classical + intro n p i v prev a b ha hb cross w + by_cases hpos : 0 < cross a b + · simpa only [w, ite_eq_left hpos] using hb + · simpa only [w, ite_eq_right hpos] using ha + +private theorem hswapuw : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + cross w u = -cross u w ) := by + classical + intro n p i v prev a b cross u w + dsimp [cross] + ring + +private theorem hcrossSelf : + (by + classical + exact + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + ∀ z : Real × Real, cross z z = 0 ) := by + classical + intro cross z + dsimp [cross] + ring + +private theorem hsectorOpp : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let v := p.vertex i + ∀ (rK : ℝ), (rK > (0 : ℝ)) → ( + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + (a ≠ 0) → ( + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ((0 < dist v (p.vertex (i + 1))) → ((0 + < dist v (p.vertex prev)) → ( + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + (0 < r) → ((∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x y t = x + t • (y - x)) → + ((∀ (u : Real × Real), ∀ (t : Real), 0 ≤ t → dist (v + t • u) v = t * dist (v + u) v) + → ( + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + (∀ z : Real × Real, ∀ δ : Real, 0 < δ → ∃ t : Real, 0 < t ∧ t • z ∈ Metric.ball ((0 : + Real), (0 : Real)) δ) → ( + let N : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + 0 < cross u (x - v) ∧ cross w (x - v) < 0} + let W : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + (cross u (x - v) < 0 ∨ 0 < cross w (x - v))} + (∀ z : Real × Real, cross z z = 0) → (0 < cross u w → ∃ xN ∈ N, ∃ xW ∈ W, (xN ∈ O ↔ xW ∉ + O)))))))))))) := by + classical + intro n p i O v rK hrK prev a b ha cross hcrossLinear hdistA hdistB r hr hlineMap hdistRadial u + w hsmallScale N W hcrossSelf hD + let d := dist v (p.vertex (i + 1)) + let τ := min (1 / 2) (r / (4 * (d + 1))) + have hτ : 0 < τ := by dsimp [τ]; positivity + have hτle : τ ≤ r / (4 * (d + 1)) := min_le_right _ _ + have hτlt : τ < 1 := lt_of_le_of_lt (min_le_left _ _) (by norm_num) + let x0 := v + τ • a + have hx0seg : x0 ∈ openSegment Real v (p.vertex (i + 1)) := by + have hm := lineMap_mem_openSegment Real v (p.vertex (i + 1)) + (show τ ∈ Set.Ioo 0 1 from ⟨hτ, hτlt⟩) + rw [hlineMap] at hm + have he : v + a = p.vertex (i + 1) := by dsimp [a]; abel + simpa [x0, he] using hm + have hdistance : dist v x0 = τ * d := by + have he : v + a = p.vertex (i + 1) := by dsimp [a]; abel + rw [dist_comm, hdistRadial a τ hτ.le, he, dist_comm] + have hx0ball : x0 ∈ Metric.ball v r := VertexSectorProof.hx0ballAt924 n p i rK hdistA hr hτle + hdistance + have hx0form : x0 - v = τ • a := by dsimp [x0]; abel + obtain ⟨rS, hrS, hside, _, _⟩ := P3597T1SideCrossing p i x0 hx0seg + let q : Real × Real := (-a.2, a.1) + have hqa : 0 < cross a q := VertexSectorProof.hqaAt937 n p i ha + let U : Set (Real × Real) := if 0 < cross a b then + Metric.ball x0 rS ∩ Metric.ball v r ∩ {y | cross b (y-v) < 0} + else Metric.ball x0 rS ∩ Metric.ball v r ∩ {y | 0 < cross b (y-v)} + have hUopen : IsOpen U := VertexSectorProof.hUopenAt954 n p i rK rS + have hx0U : x0 ∈ U := VertexSectorProof.hx0UAt970 n p i rK hcrossLinear hD hτ hx0ball hx0form + rS hrS + obtain ⟨δ, hδ, hballU⟩ := Metric.isOpen_iff.mp hUopen x0 hx0U + obtain ⟨s, hs, hsmall⟩ := hsmallScale q δ hδ + have hsmallNorm : ‖s • q‖ < δ := by + have hh := hsmall + rw [Metric.mem_ball, dist_eq_norm] at hh + have he : (s • q : Real × Real) - (0, 0) = s • q := by ext <;> simp + rw [he] at hh + exact hh + have hsmallNeg : -(s • q) ∈ Metric.ball ((0 : Real), (0 : Real)) δ := by + rw [Metric.mem_ball, dist_eq_norm] + have he : (-(s • q) : Real × Real) - (0, 0) = -(s • q) := by ext <;> simp + rw [he] + simpa only [norm_neg] using hsmallNorm + have hplusball : x0 + s • q ∈ Metric.ball x0 δ := VertexSectorProof.hplusball n p i rK δ s + hsmallNorm + have hminusball : x0 - s • q ∈ Metric.ball x0 δ := VertexSectorProof.hminusball n p i rK δ s + hsmallNorm + let yp := x0 + s • q + let ym := x0 - s • q + have hypU : yp ∈ U := hballU (by simpa [yp] using hplusball) + have hymU : ym ∈ U := hballU (by simpa [ym] using hminusball) + have hAplus : cross a (yp-v) = s * cross a q := by + have he : yp-v = τ • a + s • q := by dsimp [yp, x0]; abel + rw [he, (hcrossLinear a).map_add, (hcrossLinear a).map_smul, + (hcrossLinear a).map_smul, hcrossSelf] + simp only [smul_eq_mul, mul_zero, zero_add] + have hAminus : cross a (ym-v) = -(s * cross a q) := VertexSectorProof.hAminusAt1037 n p i rK + hcrossLinear hcrossSelf s + have hdetformula : ∀ y : Real × Real, + P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), y] = cross a (y-v) := by + intro y + simp [P3381T1TriangleDeterminant, cross, a, v] + ring + have hdetp : 0 < P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), yp] := by + rw [hdetformula, hAplus] + exact mul_pos hs hqa + have hdetm : P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), ym] < 0 := by + rw [hdetformula, hAminus] + exact neg_neg_of_pos (mul_pos hs hqa) + have hOpp : (yp ∈ O ↔ ym ∉ O) := VertexSectorProof.hOppAt1058 n p i rK rS hside s hypU hymU + hdetp hdetm + by_cases hab : 0 < cross a b + · have hbp : cross b (yp-v) < 0 := by + have ht := hypU + simp only [U, ite_eq_left hab, Set.mem_inter_iff, Set.mem_ofPred_eq] at ht + exact ht.2 + have hbm : cross b (ym-v) < 0 := by + have ht := hymU + simp only [U, ite_eq_left hab, Set.mem_inter_iff, Set.mem_ofPred_eq] at ht + exact ht.2 + have hyball : yp ∈ Metric.ball v r := by + have ht := hypU + simp only [U, ite_eq_left hab, Set.mem_inter_iff, Set.mem_ofPred_eq] at ht + exact ht.1.2 + have hmball : ym ∈ Metric.ball v r := by + have ht := hymU + simp only [U, ite_eq_left hab, Set.mem_inter_iff, Set.mem_ofPred_eq] at ht + exact ht.1.2 + have hApluspos : 0 < cross u (yp-v) := by + rw [show u = a by simp [u, hab], hAplus] + exact mul_pos hs hqa + have hAminusneg : cross u (ym-v) < 0 := by + rw [show u = a by simp [u, hab], hAminus] + exact neg_neg_of_pos (mul_pos hs hqa) + have hwp : cross w (yp-v) < 0 := by simpa [w, hab] using hbp + exact ⟨yp, ⟨hyball, hApluspos, hwp⟩, ym, + ⟨hmball, Or.inl hAminusneg⟩, hOpp⟩ + · have habneg : cross a b < 0 := by + have hba : 0 < cross b a := by simpa [u, w, hab] using hD + have hswap : cross b a = -cross a b := by dsimp [cross]; ring + rw [hswap] at hba + linarith + have hbp : 0 < cross b (yp-v) := by + have ht := hypU + simp only [U, ite_eq_right hab, Set.mem_inter_iff, Set.mem_ofPred_eq] at ht + exact ht.2 + have hbm : 0 < cross b (ym-v) := by + have ht := hymU + simp only [U, ite_eq_right hab, Set.mem_inter_iff, Set.mem_ofPred_eq] at ht + exact ht.2 + have hyball : yp ∈ Metric.ball v r := by + have ht := hypU + simp only [U, ite_eq_right hab, Set.mem_inter_iff, Set.mem_ofPred_eq] at ht + exact ht.1.2 + have hmball : ym ∈ Metric.ball v r := by + have ht := hymU + simp only [U, ite_eq_right hab, Set.mem_inter_iff, Set.mem_ofPred_eq] at ht + exact ht.1.2 + have hUminus : 0 < cross u (ym-v) := by + rw [show u = b by simp [u, hab]] + exact hbm + have hWplus : 0 < cross w (yp-v) := by + rw [show w = a by simp [w, hab], hAplus] + exact mul_pos hs hqa + have hNside : cross w (ym-v) < 0 := by + rw [show w = a by simp [w, hab], hAminus] + exact neg_neg_of_pos (mul_pos hs hqa) + have hOpp' : (ym ∈ O ↔ yp ∉ O) := by + constructor + · intro hym hyo + exact (hOpp.mp hyo) hym + · intro hnp + by_contra hym + exact hnp (hOpp.mpr hym) + exact ⟨ym, ⟨hmball, hUminus, hNside⟩, yp, + ⟨hyball, Or.inr hWplus⟩, hOpp'⟩ + +private theorem hNconstant : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + (∀ S : Set (Real × Real), IsConnected S → (∀ x, x ∈ S → x ∉ C) → ∀ x ∈ S, ∀ y ∈ S, (x ∈ O + ↔ y ∈ O)) → ( + let N : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + 0 < cross u (x - v) ∧ cross w (x - v) < 0} + (∀ x : Real × Real, x ∈ N → x ∉ C) → (∀ (xN : ℝ × ℝ), (xN ∈ N) → ((IsPathConnected N) → + (∀ x, x ∈ N → (x ∈ O ↔ xN ∈ O))))) ) := by + classical + intro n p i O C v rK prev a b cross r u w hconstOn N hNoff xN hxN hNpath x hx + exact hconstOn N hNpath.isConnected (fun y hy => hNoff y hy) x hx xN hxN + +private theorem hWconstant : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + (∀ S : Set (Real × Real), IsConnected S → (∀ x, x ∈ S → x ∉ C) → ∀ x ∈ S, ∀ y ∈ S, (x ∈ O + ↔ y ∈ O)) → ( + let W : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + (cross u (x - v) < 0 ∨ 0 < cross w (x - v))} + (∀ x : Real × Real, x ∈ W → x ∉ C) → (∀ (xW : ℝ × ℝ), (xW ∈ W) → ((IsPathConnected W) → + (∀ x, x ∈ W → (x ∈ O ↔ xW ∈ O))))) ) := by + classical + intro n p i O C v rK prev a b cross r u w hconstOn W hWoff xW hxW hWpath x hx + exact hconstOn W hWpath.isConnected (fun y hy => hWoff y hy) x hx xW hxW + +private theorem hOoffAt2413 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + ∀ x, x ∈ O → x ∉ C ) := by + classical + intro n p O C x hx + change x ∉ C ∧ _ at hx + exact hx.1 + +private theorem habzero : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + (cross u w = (0 : ℝ)) → (cross a b = 0) ) := by + classical + intro n p i v prev a b cross u w hDzero + by_cases hab : 0 < cross a b + · simpa [u, w, hab] using hDzero + · have hba : cross b a = 0 := by simpa [u, w, hab] using hDzero + have hswap : cross b a = -cross a b := by dsimp [cross]; ring + rw [hswap] at hba + linarith + +private theorem hcne : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + (w ≠ 0) → (∀ (c : ℝ), (w = c • u) → (c ≠ 0)) ) := by + classical + intro n p i v prev a b cross u w hw0 c hcw hc + rw [hc, zero_smul] at hcw + exact hw0 hcw + +private theorem hLpoff : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + (∀ x, x ∈ Metric.ball v r → x ∈ C → cross u (x-v) = 0) → ( + let Lp : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ 0 < cross u (x-v)} + ∀ x, x ∈ Lp → x ∉ C) ) := by + classical + intro n p i C v rK prev a b cross r u hcarrierZero Lp x hx hxc + change x ∈ Metric.ball v r ∧ 0 < cross u (x-v) at hx + have hz := hcarrierZero x hx.1 hxc + exact (lt_irrefl (0 : Real)) (by rw [hz] at hx; exact hx.2) + +private theorem hLmoff : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + (∀ x, x ∈ Metric.ball v r → x ∈ C → cross u (x-v) = 0) → ( + let Lm : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ cross u (x-v) < 0} + ∀ x, x ∈ Lm → x ∉ C) ) := by + classical + intro n p i C v rK prev a b cross r u hcarrierZero Lm x hx hxc + change x ∈ Metric.ball v r ∧ cross u (x-v) < 0 at hx + have hz := hcarrierZero x hx.1 hxc + exact (lt_irrefl (0 : Real)) (by rw [hz] at hx; exact hx.2) + +private theorem hLcover : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + (∀ x ∈ Metric.ball v r, cross u (x-v) = 0 → x ∈ C) → ( + let Lp : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ 0 < cross u (x-v)} + let Lm : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ cross u (x-v) < 0} + ∀ x ∈ Metric.ball v r, x ∉ C → x ∈ Lp ∨ x ∈ Lm) ) := by + classical + intro n p i C v rK prev a b cross r u hlineCarrier Lp Lm x hx hxc + have hne : cross u (x-v) ≠ 0 := by + intro hzero + exact hxc (hlineCarrier x hx hzero) + rcases lt_or_gt_of_ne hne with hneg | hpos + · exact Or.inr ⟨hx, hneg⟩ + · exact Or.inl ⟨hx, hpos⟩ + +private theorem hLpconv : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let Lp : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ 0 < cross u (x-v)} + let HP : Set (Real × Real) := {z | 0 < cross u z} + (Convex Real ((fun x : Real × Real => x + (-v)) ⁻¹' HP)) → (Convex Real Lp) ) := by + classical + intro n p i v rK prev a b cross r u Lp HP hpreP + change Convex Real (Metric.ball v r ∩ (fun x : Real × Real => x + (-v)) ⁻¹' HP) + exact (convex_ball v r).inter hpreP + +private theorem hLmconv : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + let Lm : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ cross u (x-v) < 0} + let HM : Set (Real × Real) := {z | cross u z < 0} + (Convex Real ((fun x : Real × Real => x + (-v)) ⁻¹' HM)) → (Convex Real Lm) ) := by + classical + intro n p i v rK prev a b cross r u Lm HM hpreM + change Convex Real (Metric.ball v r ∩ (fun x : Real × Real => x + (-v)) ⁻¹' HM) + exact (convex_ball v r).inter hpreM + +private theorem hxpdet : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ( + let u := if 0 < cross a b then a else b + let qline : Real × Real := (-u.2, u.1) + (0 < cross u qline) → (∀ (tp : ℝ), ((0 : ℝ) < tp) → ( + let xp := v + tp • qline + 0 < cross u (xp-v)))) ) := by + classical + intro n p i v prev a b cross hcrossLinear u qline hqu tp htp xp + have he : xp-v = tp • qline := by + dsimp only [xp] + exact add_sub_cancel_left v (tp • qline) + rw [he, (hcrossLinear u).map_smul] + simp only [smul_eq_mul] + exact mul_pos htp hqu + +private theorem hcrossua : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + (∀ z : Real × Real, cross z z = 0) → ((cross u w = (0 : ℝ)) → (cross u a = 0)) ) := by + classical + intro n p i v prev a b cross u w hcrossSelf hDzero + by_cases hpos : 0 < cross a b + · simpa [u, hpos] using hcrossSelf a + · have hba : cross b a = 0 := by simpa [u, w, hpos] using hDzero + simpa [u, hpos] using hba + +private theorem hcrossaQ : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + (a ≠ 0) → ( + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ((∀ x z : Real × Real, x ≠ 0 → cross x + z = 0 → ∃ c : Real, z = c • x) → ( + let u := if 0 < cross a b then a else b + let qline : Real × Real := (-u.2, u.1) + (0 < cross u qline) → ((cross u a = 0) → (cross a qline ≠ 0))))) ) := by + classical + intro n p i v prev a b ha cross hcrossLinear hcrosszero u qline hqu hcrossua hz + obtain ⟨c, hc⟩ := hcrosszero a qline ha hz + have hzero : cross u qline = 0 := by + rw [hc, (hcrossLinear u).map_smul, hcrossua] + simp + exact (ne_of_gt hqu) hzero + +private theorem hqaAt2526 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ( + let u := if 0 < cross a b then a else b + let qline : Real × Real := (-u.2, u.1) + (cross a qline ≠ 0) → ( + let qside : Real × Real := if 0 < cross a qline then qline else -qline + 0 < cross a qside)) ) := by + classical + intro n p i v prev a b cross hcrossLinear u qline hcrossaQ qside + by_cases hpos : 0 < cross a qline + · simp [qside, hpos] + · have hneg : cross a qline < 0 := lt_of_le_of_ne (le_of_not_gt hpos) hcrossaQ + rw [show qside = -qline by simp [qside, hpos], (hcrossLinear a).map_neg] + exact neg_pos.mpr hneg + +private theorem hcrossuQ : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ( + let u := if 0 < cross a b then a else b + let qline : Real × Real := (-u.2, u.1) + (0 < cross u qline) → ( + let qside : Real × Real := if 0 < cross a qline then qline else -qline + 0 < cross u qside ∨ cross u qside < 0)) ) := by + classical + intro n p i v prev a b cross hcrossLinear u qline hqu qside + by_cases hpos : 0 < cross a qline + · left + simpa [qside, hpos] using hqu + · right + have hneg : cross u (-qline) = -cross u qline := (hcrossLinear u).map_neg qline + rw [show qside = -qline by simp [qside, hpos], hneg] + exact neg_neg_of_pos hqu + +private theorem hx0ballAt2541 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + (0 < r) → (∀ (x0 : ℝ × ℝ), (dist v x0 < r / (2 : ℝ)) → (x0 ∈ Metric.ball v r)) ) := by + classical + intro n p i v rK prev r hr x0 hx0dist + rw [Metric.mem_ball, dist_comm] + exact lt_of_lt_of_le hx0dist (by linarith) + +private theorem hAplusAt2561 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ( + let u := if 0 < cross a b then a else b + (∀ z : Real × Real, cross z z = 0) → ( + let qline : Real × Real := (-u.2, u.1) + let qside : Real × Real := if 0 < cross a qline then qline else -qline + ∀ (x0 : ℝ × ℝ), ∀ (t0 : ℝ), (x0-v = t0 • a) → (∀ (s : ℝ), + let yp := x0 + s • qside + cross a (yp-v) = s * cross a qside))) ) := by + classical + intro n p i v prev a b cross hcrossLinear u hcrossSelf qline qside x0 t0 hx0form s yp + have he : yp-v = t0 • a + s • qside := by rw [← hx0form]; dsimp [yp]; abel + rw [he, (hcrossLinear a).map_add, (hcrossLinear a).map_smul, + (hcrossLinear a).map_smul, hcrossSelf] + simp only [smul_eq_mul, mul_zero, zero_add] + +private theorem hAminusAt2566 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ( + let u := if 0 < cross a b then a else b + (∀ z : Real × Real, cross z z = 0) → ( + let qline : Real × Real := (-u.2, u.1) + let qside : Real × Real := if 0 < cross a qline then qline else -qline + ∀ (x0 : ℝ × ℝ), ∀ (t0 : ℝ), (x0-v = t0 • a) → (∀ (t : ℝ), + let ym := x0 + t • (-qside) + cross a (ym-v) = -(t * cross a qside)))) ) := by + classical + intro n p i v prev a b cross hcrossLinear u hcrossSelf qline qside x0 t0 hx0form t ym + have he : ym-v = t0 • a + t • (-qside) := by rw [← hx0form]; dsimp [ym]; abel + rw [he, (hcrossLinear a).map_add, (hcrossLinear a).map_smul, + (hcrossLinear a).map_smul, hcrossSelf, (hcrossLinear a).map_neg] + simp only [smul_eq_mul, mul_zero, zero_add, mul_neg] + +private theorem hdetformulaAt2571 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let a := p.vertex (i + 1) - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + ∀ y : Real × Real, P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), y] = cross + a (y-v) ) := by + classical + intro n p i v a cross y + simp [P3381T1TriangleDeterminant, cross, a, v] + ring + +private theorem hdetpAt2576 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let u := if 0 < cross a b then a else b + let qline : Real × Real := (-u.2, u.1) + let qside : Real × Real := if 0 < cross a qline then qline else -qline + (0 < cross a qside) → (∀ (x0 : ℝ × ℝ), ∀ (s : ℝ), ((0 : ℝ) < s) → ( + let yp := x0 + s • qside + (cross a (yp-v) = s * cross a qside) → ((∀ y : Real × Real, P3381T1TriangleDeterminant + ![p.vertex i, p.vertex (i+1), y] = cross a (y-v)) → (0 < P3381T1TriangleDeterminant + ![p.vertex i, p.vertex (i+1), yp])))) ) := by + classical + intro n p i v prev a b cross u qline qside hqa x0 s hs yp hAplus hdetformula + rw [hdetformula, hAplus] + exact mul_pos hs hqa + +private theorem hdetmAt2579 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let u := if 0 < cross a b then a else b + let qline : Real × Real := (-u.2, u.1) + let qside : Real × Real := if 0 < cross a qline then qline else -qline + (0 < cross a qside) → (∀ (x0 : ℝ × ℝ), ∀ (t : ℝ), ((0 : ℝ) < t) → ( + let ym := x0 + t • (-qside) + (cross a (ym-v) = -(t * cross a qside)) → ((∀ y : Real × Real, + P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), y] = cross a (y-v)) → + (P3381T1TriangleDeterminant ![p.vertex i, p.vertex (i+1), ym] < 0)))) ) := by + classical + intro n p i v prev a b cross u qline qside hqa x0 t ht ym hAminus hdetformula + rw [hdetformula, hAminus] + exact neg_neg_of_pos (mul_pos ht hqa) + +private theorem hUplus : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ( + let u := if 0 < cross a b then a else b + let qline : Real × Real := (-u.2, u.1) + (cross u a = 0) → ( + let qside : Real × Real := if 0 < cross a qline then qline else -qline + ∀ (x0 : ℝ × ℝ), ∀ (t0 : ℝ), (x0-v = t0 • a) → (∀ (s : ℝ), + let yp := x0 + s • qside + cross u (yp-v) = s * cross u qside))) ) := by + classical + intro n p i v prev a b cross hcrossLinear u qline hcrossua qside x0 t0 hx0form s yp + have he : yp-v = t0 • a + s • qside := by rw [← hx0form]; dsimp [yp]; abel + rw [he, (hcrossLinear u).map_add, (hcrossLinear u).map_smul, + (hcrossLinear u).map_smul, hcrossua] + simp only [smul_eq_mul, mul_zero, zero_add] + +private theorem hUminusAt2589 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let v := p.vertex i + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + (∀ u : Real × Real, IsLinearMap Real (cross u)) → ( + let u := if 0 < cross a b then a else b + let qline : Real × Real := (-u.2, u.1) + (cross u a = 0) → ( + let qside : Real × Real := if 0 < cross a qline then qline else -qline + ∀ (x0 : ℝ × ℝ), ∀ (t0 : ℝ), (x0-v = t0 • a) → (∀ (t : ℝ), + let ym := x0 + t • (-qside) + cross u (ym-v) = -(t * cross u qside)))) ) := by + classical + intro n p i v prev a b cross hcrossLinear u qline hcrossua qside x0 t0 hx0form t ym + have he : ym-v = t0 • a + t • (-qside) := by rw [← hx0form]; dsimp [ym]; abel + rw [he, (hcrossLinear u).map_add, (hcrossLinear u).map_smul, + (hcrossLinear u).map_smul, hcrossua, (hcrossLinear u).map_neg] + simp only [smul_eq_mul, mul_zero, zero_add, mul_neg] + +private theorem hPconstant : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + (∀ S : Set (Real × Real), IsConnected S → (∀ x, x ∈ S → x ∉ C) → ∀ x ∈ S, ∀ y ∈ S, (x ∈ O + ↔ y ∈ O)) → ( + let Lp : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ 0 < cross u (x-v)} + (∀ x, x ∈ Lp → x ∉ C) → ((IsPathConnected Lp) → (∀ (xP : ℝ × ℝ), (xP ∈ Lp) → (∀ x, x ∈ Lp + → (x ∈ O ↔ xP ∈ O))))) ) := by + classical + intro n p i O C v rK prev a b cross r u hconstOn Lp hLpoff hLppath xP hxP x hx + exact hconstOn Lp hLppath.isConnected (fun y hy => hLpoff y hy) x hx xP hxP + +private theorem hMconstant : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + ∀ (rK : ℝ), + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + let u := if 0 < cross a b then a else b + (∀ S : Set (Real × Real), IsConnected S → (∀ x, x ∈ S → x ∉ C) → ∀ x ∈ S, ∀ y ∈ S, (x ∈ O + ↔ y ∈ O)) → ( + let Lm : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ cross u (x-v) < 0} + (∀ x, x ∈ Lm → x ∉ C) → ((IsPathConnected Lm) → (∀ (xM : ℝ × ℝ), (xM ∈ Lm) → (∀ x, x ∈ Lm + → (x ∈ O ↔ xM ∈ O))))) ) := by + classical + intro n p i O C v rK prev a b cross r u hconstOn Lm hLmoff hLmpath xM hxM x hx + exact hconstOn Lm hLmpath.isConnected (fun y hy => hLmoff y hy) x hx xM hxM + +private theorem hOoffAt2603 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + ∀ x, x ∈ O → x ∉ C ) := by + classical + intro n p O C x hx + change x ∉ C ∧ _ at hx + exact hx.1 + +end VertexSectorDetails + +theorem P3597T1VertexSectors {n : Nat} (p : P3381T1PolygonBoundary n) + (i : Fin (n + 3)) : + ∃ r : Real, 0 < r ∧ + IsPathConnected (Metric.ball (p.vertex i) r ∩ P3544T1RayParity p) ∧ + IsPathConnected (Metric.ball (p.vertex i) r \ + (P3544T1RayParity p ∪ P3544T1BoundaryCarrier p)) ∧ + p.vertex i ∈ closure (P3544T1RayParity p) ∧ + p.vertex i ∈ closure + (P3544T1RayParity p ∪ P3544T1BoundaryCarrier p)ᶜ := by +-- BODY + classical + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + let v := p.vertex i + let J : Set (Fin (n + 3)) := {j | j ≠ i ∧ j + 1 ≠ i} + let K : Set (Real × Real) := ⋃ j ∈ J, + segment Real (p.vertex j) (p.vertex (j + 1)) + have hvKopen : IsOpen Kᶜ := (VertexSectorDetails.hKcompact n p i + (VertexSectorDetails.hsegcompact n p)).isClosed.isOpen_compl + obtain ⟨rK, hrK, hballK⟩ := Metric.isOpen_iff.mp hvKopen v (VertexSectorProof.hvnot n p i) + let prev : Fin (n + 3) := + if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ + have hprev := VertexSectorDetails.hprev n i + have haddne : ∀ j : Fin (n + 3), j + 1 ≠ j := VertexSectorProof.haddne n i + have hprevne := VertexSectorDetails.hprevne n i hprev haddne + have hnextne : i + 1 ≠ i := haddne i + have hnextVertex := VertexSectorDetails.hnextVertex n p i hnextne + have hprevVertex := VertexSectorDetails.hprevVertex n p i hprevne + let a := p.vertex (i + 1) - v + let b := p.vertex prev - v + have ha : a ≠ 0 := sub_ne_zero.mpr hnextVertex + have hb : b ≠ 0 := sub_ne_zero.mpr hprevVertex + let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 + have hcrossLinear := VertexSectorDetails.hcrossLinear + have hcrosszero : ∀ x z : Real × Real, x ≠ 0 → cross x z = 0 → + ∃ c : Real, z = c • x := VertexSectorProof.hcrosszero + have hdistA : 0 < dist v (p.vertex (i + 1)) := dist_pos.mpr hnextVertex.symm + have hdistB : 0 < dist v (p.vertex prev) := dist_pos.mpr hprevVertex.symm + let r := min rK (min (dist v (p.vertex (i + 1)) / 2) + (dist v (p.vertex prev) / 2)) + have hr := VertexSectorDetails.hr n p i rK hrK hdistA hdistB + have hrKle : r ≤ rK := min_le_left _ _ + have hrAle : r ≤ dist v (p.vertex (i + 1)) / 2 := by + exact le_trans (min_le_right _ _) (min_le_left _ _) + have hrBle : r ≤ dist v (p.vertex prev) / 2 := by + exact le_trans (min_le_right _ _) (min_le_right _ _) + have hlineMap := VertexSectorDetails.hlineMap + have hsegA := VertexSectorProof.hsegA n p i hlineMap + have hdistRadial := VertexSectorDetails.hdistRadial n p i + have hnoPosMultiple := VertexSectorProof.hnoPosMultiple n p i + hprev hprevne hnextVertex hlineMap + have happroach := VertexSectorProof.happroach n p i hdistA hlineMap hdistRadial + have hvOdd := VertexSectorProof.hvOdd n p i happroach + have hvEven := VertexSectorProof.hvEven n p i happroach + let u := if 0 < cross a b then a else b + let w := if 0 < cross a b then b else a + have hdetuw := VertexSectorProof.hdetuw n p i + have hcarrierUW := VertexSectorProof.hcarrierUW n p i rK + (VertexSectorProof.hcarrierRays n p i rK (VertexSectorProof.hcarrierLocal n p i rK + hballK hprev (VertexSectorProof.haddinj n i) hrKle) hsegA (VertexSectorProof.hsegB n + p i hlineMap) (VertexSectorProof.hRayA n p i rK hdistA hrAle hlineMap hdistRadial) + (VertexSectorProof.hRayB n p i rK hdistB hrBle hlineMap hdistRadial)) + have hconstOn := VertexSectorProof.hconstOn n p + (VertexSectorProof.hlocal n p (VertexSectorProof.hgeneric n p) + (VertexSectorProof.hparity n p)) + have hsmallScale := VertexSectorProof.hsmallScale + let N : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + 0 < cross u (x - v) ∧ cross w (x - v) < 0} + let W : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ + (cross u (x - v) < 0 ∨ 0 < cross w (x - v))} + have hNandW := VertexSectorProof.hNandW + n p i rK hcrossLinear hr hsmallScale + have hu0 := VertexSectorDetails.hu0 n p i ha hb + have hw0 := VertexSectorDetails.hw0 n p i ha hb + have hswapuw := VertexSectorDetails.hswapuw n p i + have hcrossSelf := VertexSectorDetails.hcrossSelf + have hNoff := VertexSectorProof.hNoff n p i rK hcrossLinear + hcarrierUW hcrossSelf + have hWoff := VertexSectorProof.hWoff n p i rK hcrossLinear + hdetuw hcarrierUW hswapuw hcrossSelf + have hcover := VertexSectorProof.hcover n p i rK + (VertexSectorProof.hzeroUNegW n p i rK hcrossLinear hcrosszero hcarrierUW hu0 hswapuw) + (VertexSectorProof.hzeroWPosU n p i rK hcrossLinear hcrosszero hcarrierUW hw0) + (VertexSectorProof.hzeroBoth n p i rK hcrossLinear hcrosszero hcarrierUW hu0 hswapuw) + rcases hdetuw with hD | hDzero + · obtain ⟨xN, hxN, xW, hxW, hOpp⟩ := (VertexSectorDetails.hsectorOpp n p i rK hrK ha + hcrossLinear hdistA hdistB hr hlineMap hdistRadial hsmallScale hcrossSelf) hD + have hNpath := (hNandW hD).1 + have hWpath := (hNandW hD).2 + have hNconstant := VertexSectorDetails.hNconstant n p i rK + hconstOn hNoff xN hxN hNpath + have hWconstant := VertexSectorDetails.hWconstant n p i rK + hconstOn hWoff xW hxW hWpath + have hOoff := VertexSectorDetails.hOoffAt2413 n p + by_cases hn : xN ∈ O + · have hOddEq : Metric.ball v r ∩ O = N := VertexSectorProof.hOddEqAt1181 n p i rK hcover hD + xN xW hOpp hNconstant hWconstant hOoff hn + have hEvenEq : Metric.ball v r \ (O ∪ C) = W := VertexSectorProof.hEvenEqAt1192 n p i rK + hWoff hcover hD xN xW hOpp hNconstant hWconstant hn + refine ⟨r, hr, ?_, ?_, hvOdd, hvEven⟩ + · rw [hOddEq] + exact hNpath + · rw [hEvenEq] + exact hWpath + · have hOddEq : Metric.ball v r ∩ O = W := VertexSectorProof.hOddEqAt1218 n p i rK hcover hD + xN xW hOpp hNconstant hWconstant hOoff hn + have hEvenEq : Metric.ball v r \ (O ∪ C) = N := VertexSectorProof.hEvenEqAt1232 n p i rK + hNoff hcover hD xN xW hOpp hNconstant hWconstant hn + refine ⟨r, hr, ?_, ?_, hvOdd, hvEven⟩ + · rw [hOddEq] + exact hWpath + · rw [hEvenEq] + exact hNpath + · have habzero : cross a b = 0 := VertexSectorDetails.habzero n p i hDzero + obtain ⟨c, hcw⟩ := hcrosszero u w hu0 hDzero + have hcne := VertexSectorDetails.hcne n p i hw0 c hcw + have hcarrierZero := VertexSectorProof.hcarrierZero n p i rK hcrossLinear hcarrierUW + hcrossSelf c hcw + let Lp : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ 0 < cross u (x-v)} + let Lm : Set (Real × Real) := {x | x ∈ Metric.ball v r ∧ cross u (x-v) < 0} + have hLpoff := VertexSectorDetails.hLpoff n p i rK hcarrierZero + have hLmoff := VertexSectorDetails.hLmoff n p i rK hcarrierZero + have hLcover := VertexSectorDetails.hLcover + n p i rK (VertexSectorProof.hlineCarrier n p i rK hcrosszero hcarrierUW hu0 c hcw hcne + (VertexSectorProof.hcneg n p i hnoPosMultiple c hcw hcne)) + let HP : Set (Real × Real) := {z | 0 < cross u z} + let HM : Set (Real × Real) := {z | cross u z < 0} + have hconvP : Convex Real HP := convex_halfSpace_gt (hcrossLinear u) 0 + have hconvM : Convex Real HM := convex_halfSpace_lt (hcrossLinear u) 0 + have hpreP : Convex Real ((fun x : Real × Real => x + (-v)) ⁻¹' HP) := + hconvP.translate_preimage_left (-v) + have hpreM : Convex Real ((fun x : Real × Real => x + (-v)) ⁻¹' HM) := + hconvM.translate_preimage_left (-v) + let qline : Real × Real := (-u.2, u.1) + have hqu : 0 < cross u qline := VertexSectorProof.hqu n p i ha hb + obtain ⟨tp, htp, htpball⟩ := hsmallScale qline r hr + obtain ⟨tm, htm, htmball⟩ := hsmallScale (-qline) r hr + have htranslate : ∀ z : Real × Real, z ∈ Metric.ball (0, 0) r → + v + z ∈ Metric.ball v r := VertexSectorProof.htranslate n p i rK + let xp := v + tp • qline + let xm := v + (-tm) • qline + have hxpball : xp ∈ Metric.ball v r := by + exact htranslate (tp • qline) htpball + have hxmball : xm ∈ Metric.ball v r := by + exact htranslate ((-tm) • qline) (by simpa using htmball) + have hxpLp : xp ∈ Lp := ⟨hxpball, (VertexSectorDetails.hxpdet n p i hcrossLinear hqu tp htp)⟩ + have hxmLm : xm ∈ Lm := ⟨hxmball, (VertexSectorProof.hxmdet n p i hcrossLinear hqu tm htm)⟩ + have hLppath : IsPathConnected Lp := (VertexSectorDetails.hLpconv n p i rK + hpreP).isPathConnected ⟨xp, hxpLp⟩ + have hLmpath : IsPathConnected Lm := (VertexSectorDetails.hLmconv n p i rK + hpreM).isPathConnected ⟨xm, hxmLm⟩ + have hcrossua := VertexSectorDetails.hcrossua n p i hcrossSelf hDzero + let qside : Real × Real := if 0 < cross a qline then qline else -qline + have hqa := VertexSectorDetails.hqaAt2526 n p i hcrossLinear + (VertexSectorDetails.hcrossaQ n p i ha hcrossLinear hcrosszero hqu hcrossua) + obtain ⟨x0, hx0open, hx0dist⟩ := happroach r hr + have hx0seg : x0 ∈ segment Real v (p.vertex (i+1)) := + openSegment_subset_segment Real v (p.vertex (i+1)) hx0open + obtain ⟨t0, ht0, hx0eq⟩ := (hsegA x0).mp hx0seg + have hx0form : x0-v = t0 • a := by rw [hx0eq]; abel + obtain ⟨rS, hrS, hside, _, _⟩ := P3597T1SideCrossing p i x0 hx0open + let U : Set (Real × Real) := Metric.ball x0 rS ∩ Metric.ball v r + have hx0U : x0 ∈ U := ⟨Metric.mem_ball_self hrS, (VertexSectorDetails.hx0ballAt2541 n p i rK + hr x0 hx0dist)⟩ + obtain ⟨δ, hδ, hballU⟩ := Metric.isOpen_iff.mp (Metric.isOpen_ball.inter Metric.isOpen_ball) + x0 hx0U + obtain ⟨s, hs, hsmall⟩ := hsmallScale qside δ hδ + obtain ⟨t, ht, hsmallNeg⟩ := hsmallScale (-qside) δ hδ + have htranslateAt := VertexSectorProof.htranslateAt x0 δ + let yp := x0 + s • qside + let ym := x0 + t • (-qside) + have hypU : yp ∈ U := hballU (by simpa [yp] using htranslateAt (s • qside) hsmall) + have hymU : ym ∈ U := hballU (by simpa [ym] using htranslateAt (t • (-qside)) hsmallNeg) + have hdetformula := VertexSectorDetails.hdetformulaAt2571 n p i + have hOpp : (yp ∈ O ↔ ym ∉ O) := VertexSectorProof.hOppAt1494 n p i rK x0 rS hside s t hypU + hymU (VertexSectorDetails.hdetpAt2576 n p i hqa x0 s hs (VertexSectorDetails.hAplusAt2561 + n p i hcrossLinear hcrossSelf x0 t0 hx0form s) hdetformula) + (VertexSectorDetails.hdetmAt2579 n p i hqa x0 t ht (VertexSectorDetails.hAminusAt2566 + n p i hcrossLinear hcrossSelf x0 t0 hx0form t) hdetformula) + obtain ⟨xP, hxP, xM, hxM, hOpp⟩ := (VertexSectorProof.hLopp n p i rK + (VertexSectorDetails.hcrossuQ n p i hcrossLinear hqu) x0 rS s hs t ht hypU hymU hOpp + (VertexSectorDetails.hUplus n p i hcrossLinear hcrossua x0 t0 hx0form s) + (VertexSectorDetails.hUminusAt2589 n p i hcrossLinear hcrossua x0 t0 hx0form t)) + have hPconstant := VertexSectorDetails.hPconstant n p i rK + hconstOn hLpoff hLppath xP hxP + have hMconstant := VertexSectorDetails.hMconstant n p i rK + hconstOn hLmoff hLmpath xM hxM + have hOoff := VertexSectorDetails.hOoffAt2603 n p + by_cases hn : xP ∈ O + · have hOddEq : Metric.ball v r ∩ O = Lp := VertexSectorProof.hOddEqAt1554 n p i rK hLcover + xP xM hOpp hPconstant hMconstant hOoff hn + have hEvenEq : Metric.ball v r \ (O ∪ C) = Lm := VertexSectorProof.hEvenEqAt1565 n p i rK + hLmoff hLcover xP xM hOpp hPconstant hMconstant hn + refine ⟨r, hr, ?_, ?_, hvOdd, hvEven⟩ + · rw [hOddEq] + exact hLppath + · rw [hEvenEq] + exact hLmpath + · have hOddEq : Metric.ball v r ∩ O = Lm := VertexSectorProof.hOddEqAt1591 n p i rK hLcover + xP xM hOpp hPconstant hMconstant hOoff hn + have hEvenEq : Metric.ball v r \ (O ∪ C) = Lp := VertexSectorProof.hEvenEqAt1605 n p i rK + hLpoff hLcover xP xM hOpp hPconstant hMconstant hn + refine ⟨r, hr, ?_, ?_, hvOdd, hvEven⟩ + · rw [hOddEq] + exact hLmpath + · rw [hEvenEq] + exact hLppath + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildren.lean b/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildren.lean new file mode 100644 index 0000000000..0635865979 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildren.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3544T1BoundaryCarrier + +-- [TABLET NODE: P3650T1CyclicChildren] + +/-! +# P3650T1CyclicChildren + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a parent boundary $p$ and specified indices $A,B$, these data +consist of sizes $n_L,n_R i)).rotate rotation = + a :: (u ++ b :: v) + left_order : List.ofFn il = a :: (u ++ [b]) + right_order : List.ofFn ir = b :: (v ++ [a]) + common_indices : Set.range il ∩ Set.range ir = {a, b} + carrier_union : P3544T1BoundaryCarrier left ∪ P3544T1BoundaryCarrier right = + P3544T1BoundaryCarrier p ∪ segment Real (p.vertex a) (p.vertex b) + carrier_intersection : P3544T1BoundaryCarrier left ∩ + P3544T1BoundaryCarrier right = segment Real (p.vertex a) (p.vertex b) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean b/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean new file mode 100644 index 0000000000..5897dd4569 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean @@ -0,0 +1,2365 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3650T1CyclicChildren + +-- [TABLET NODE: P3650T1CyclicChildrenExists] + +/-! +# P3650T1CyclicChildrenExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CyclicChildrenConstruction + +private noncomputable abbrev N (n : Nat) := n + 3 + +private theorem hN (n : Nat) : 3 ≤ (N n) := by + classical + let N := n + 3 + dsimp only [CyclicChildrenConstruction.N] at * + change (3 ≤ N) + dsimp [N]; omega + +private theorem hNpos (n : Nat) : 0 < (N n) := by + classical + let N := n + 3 + have hN : 3 ≤ N := hN n + dsimp only [CyclicChildrenConstruction.N] at * + change (0 < N) + omega + +private noncomputable abbrev rot (n : Nat) (a : Fin (n + 3)) : Fin (N n) → Fin (N n) := by + classical + let N := n + 3 + dsimp only [CyclicChildrenConstruction.N] at * + change (Fin N → Fin N) + exact fun i => a + i + +private theorem hrot_inj (n : Nat) (a : Fin (n + 3)) : Function.Injective (rot n a) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + change (Function.Injective rot) + intro i j hij + apply Fin.ext + have hv := congrArg Fin.val hij + simp only [rot, Fin.val_add_eq_ite] at hv + by_cases hi : N ≤ a.val + i.val <;> + by_cases hj : N ≤ a.val + j.val <;> simp_all [N] <;> omega + +private noncomputable abbrev k (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) : Nat := by + classical + let N := n + 3 + exact (b.val + N - a.val) % N + +private theorem hklt (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) : (k n a b) < (N n) := by + classical + let N := n + 3 + have hNpos : 0 < N := hNpos n + let k : Nat := (b.val + N - a.val) % N + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k] at * + change (k < N) + dsimp [k]; exact Nat.mod_lt _ hNpos + +private theorem hrotzero (n : Nat) (a : Fin (n + 3)) : (rot n a) (0 : Fin (N n)) = a := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + dsimp only [CyclicChildrenConstruction.N] at * + change (rot (0 : Fin N) = a) + apply Fin.ext + simp [rot, N] + +private theorem hkv (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) : (k n a b) = if a.val ≤ b.val + then b.val - a.val else b.val + (N n) - a.val := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hrotzero : rot (0 : Fin N) = a := hrotzero n a + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k] at * + change (k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val) + dsimp [k] + split_ifs with habv + · have hsub : b.val + N - a.val = N + (b.val - a.val) := by omega + rw [hsub, Nat.add_mod] + simp only [Nat.mod_self, zero_add] + simp [Nat.mod_eq_of_lt (show b.val - a.val < N by omega)] + · have hsub : b.val + N - a.val = b.val + (N - a.val) := by omega + rw [hsub] + exact Nat.mod_eq_of_lt (show b.val + (N - a.val) < N by omega) + +private theorem hrotk (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) : (rot n a) ⟨(k n a b), (hklt + n a b)⟩ = b := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hrotzero : rot (0 : Fin N) = a := hrotzero n a + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + dsimp only [CyclicChildrenConstruction.k] at * + change (rot ⟨k, hklt⟩ = b) + apply Fin.ext + simp only [rot, Fin.val_add_eq_ite] + rw [hkv] + split_ifs <;> omega + +private theorem hkpos (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) : 0 < (k n a b) + := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + have hrot_inj : Function.Injective rot := hrot_inj n a + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hrotzero : rot (0 : Fin N) = a := hrotzero n a + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hrotk : rot ⟨k, hklt⟩ = b := hrotk n a b + dsimp only [CyclicChildrenConstruction.k] at * + change (0 < k) + by_contra h + have hkz : k = 0 := by omega + have : (⟨k, hklt⟩ : Fin N) = 0 := by apply Fin.ext; simp [hkz] + have heq := hrot_inj (show rot ⟨k, hklt⟩ = rot 0 by rw [this]) + have : a = b := by rw [← hrotzero, ← hrotk, heq] + exact hab this + +private theorem hkne1 (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hnext : b ≠ a + 1) : (k n a + b) ≠ 1 := by + classical + let N := n + 3 + have hN : 3 ≤ N := hN n + let rot : Fin N → Fin N := fun i => a + i + have hrot_inj : Function.Injective rot := hrot_inj n a + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hrotk : rot ⟨k, hklt⟩ = b := hrotk n a b + dsimp only [CyclicChildrenConstruction.k] at * + change (k ≠ 1) + intro he + have hidx : (⟨k, hklt⟩ : Fin N) = 1 := by + apply Fin.ext + simp [he, Nat.mod_eq_of_lt (show 1 < N by omega)] + have heq := hrot_inj (show rot ⟨k, hklt⟩ = rot 1 by rw [hidx]) + apply hnext + calc + b = rot 1 := hrotk.symm.trans (congrArg rot hidx) + _ = a + 1 := rfl + +private theorem hkle (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hprev : a ≠ b + 1) : (k n a + b) + 2 ≤ (N n) := by + classical + let N := n + 3 + have hN : 3 ≤ N := hN n + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hrotzero : rot (0 : Fin N) = a := hrotzero n a + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hrotk : rot ⟨k, hklt⟩ = b := hrotk n a b + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k] at * + change (k + 2 ≤ N) + by_contra h + have hbad : k = N - 1 := by omega + let last : Fin N := ⟨N - 1, by omega⟩ + have hrlast : (rot last).val = if a.val = 0 then N - 1 else a.val - 1 := by + by_cases ha0 : a.val = 0 + · simp [rot, last, Fin.val_add_eq_ite, ha0, + ] + omega + · have hap : 0 < a.val := by omega + simp only [rot, last, Fin.val_add_eq_ite] + split_ifs <;> omega + have hlast : (rot last) + 1 = a := by + apply Fin.ext + rw [Fin.val_add_eq_ite, hrlast] + by_cases ha0 : a.val = 0 + · rw [ite_eq_left ha0] + have hNm1 : N - 1 + 1 = N := by omega + have hone : 1 % N = 1 := Nat.mod_eq_of_lt (by omega : 1 < N) + simp [hNm1, hone, ha0] + · rw [ite_eq_right ha0] + have hsum : a.val - 1 + 1 = a.val := by omega + have hone : 1 % N = 1 := Nat.mod_eq_of_lt (by omega : 1 < N) + simp [hsum, hone] + omega + have hidx : (⟨k, hklt⟩ : Fin N) = last := by apply Fin.ext; simp [last, hbad] + have hb : b = rot last := hrotk.symm.trans (congrArg rot hidx) + have heq : a = b + 1 := by + calc + a = rot last + 1 := hlast.symm + _ = b + 1 := (congrArg (fun x : Fin N => x + 1) hb).symm + exact (hprev heq).elim + +private theorem hk_bounds (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b + ≠ a + 1) (hprev : a ≠ b + 1) : 2 ≤ (k n a b) ∧ (k n a b) ≤ (N n) - 2 := by + classical + let N := n + 3 + have hN : 3 ≤ N := hN n + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkpos : 0 < k := hkpos n a b hab + have hkne1 : k ≠ 1 := hkne1 n a b hnext + have hkle : k + 2 ≤ N := hkle n a b hprev + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k] at * + change (2 ≤ k ∧ k ≤ N - 2) + omega + +private theorem hrot_val (n : Nat) (a : Fin (n + 3)) (i : Fin (N n)) : ((rot n + a) i).val = (a.val + i.val) % (N n) := by + rfl + +private noncomputable abbrev root (n : Nat) : List (Fin (N n)) := by + classical + let N := n + 3 + dsimp only [CyclicChildrenConstruction.N] at * + change (List (Fin N)) + exact List.ofFn (fun i : Fin N => i) + +private theorem hrootlen (n : Nat) : (root n).length = (N n) := by + classical + let N := n + 3 + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + dsimp only [CyclicChildrenConstruction.N] at * + change (root.length = N) + simp [root, N] + +private theorem hrot_list (n : Nat) (a : Fin (n + 3)) : (root n).rotate a.val = + List.ofFn (rot n a) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + have hrot_val (i : Fin N) : (rot i).val = (a.val + i.val) % N := hrot_val n a i + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + change (root.rotate a.val = List.ofFn rot) + apply List.ext_getElem + · simp [root] + · intro j hj₁ hj₂ + rw [List.getElem_rotate] + simp only [root, List.getElem_ofFn, List.length_ofFn] + apply Fin.ext + rw [hrot_val, Nat.add_comm j a.val] + +private noncomputable abbrev l (n : Nat) (a : Fin (n + 3)) : List (Fin (N n)) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + dsimp only [CyclicChildrenConstruction.N] at * + change (List (Fin N)) + exact List.ofFn rot + +private noncomputable abbrev u (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) : List (Fin (N n)) + := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + let l : List (Fin N) := List.ofFn rot + dsimp only [CyclicChildrenConstruction.N] at * + change (List (Fin N)) + exact (l.drop 1).take (k - 1) + +private noncomputable abbrev v (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) : List (Fin (N n)) + := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + let l : List (Fin N) := List.ofFn rot + dsimp only [CyclicChildrenConstruction.N] at * + change (List (Fin N)) + exact l.drop (k + 1) + +private theorem hlu (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hprev : a ≠ b + 1) : (u n a + b).length = (k n a b) - 1 := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let l : List (Fin N) := List.ofFn rot + let u : List (Fin N) := (l.drop 1).take (k - 1) + dsimp only [CyclicChildrenConstruction.k] at * + change (u.length = k - 1) + simp [u, l, List.length_take] + omega + +private theorem hlv (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hprev : a ≠ b + 1) : (v n a + b).length = (N n) - ((k n a b) + 1) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let l : List (Fin N) := List.ofFn rot + let v : List (Fin N) := l.drop (k + 1) + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k] at * + change (v.length = N - (k + 1)) + simp [v, l, List.length_drop] + omega + +private theorem hget_l (n : Nat) (a : Fin (n + 3)) (j : Nat) (hj : j < (N n)) : + (l n a)[j]'(by simpa only [l, id_eq, List.length_ofFn] using hj) = (rot n a) ⟨j, hj⟩ := by + change (List.ofFn (rot n a))[j]'(by simpa only [List.length_ofFn] using hj) = _ + rw [List.getElem_ofFn] + +private theorem hparent_order (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext + : b ≠ a + 1) (hprev : a ≠ b + 1) : (root n).rotate a.val = a :: ((u n a b) ++ b :: (v n a b)) + := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hrotzero : rot (0 : Fin N) = a := hrotzero n a + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hrotk : rot ⟨k, hklt⟩ = b := hrotk n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + have hk_bounds : 2 ≤ k ∧ k ≤ N - 2 := hk_bounds n a b hab hnext hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + have hrot_list : root.rotate a.val = List.ofFn rot := hrot_list n a + let l : List (Fin N) := List.ofFn rot + let u : List (Fin N) := (l.drop 1).take (k - 1) + let v : List (Fin N) := l.drop (k + 1) + have hlu : u.length = k - 1 := hlu n a b hprev + have hlv : v.length = N - (k + 1) := hlv n a b hprev + have hget_l (j : Nat) (hj : j < N) : + l[j]'(by simp [l]; omega) = rot ⟨j, hj⟩ := hget_l n a j hj + change (root.rotate a.val = a :: (u ++ b :: v)) + rw [hrot_list] + apply List.ext_getElem + · simp only [List.length_ofFn] + simp only [List.length_cons, List.length_append] + rw [hlu, hlv] + omega + · intro j hj₁ hj₂ + cases j with + | zero => simp [hrotzero] + | succ j => + by_cases hjk : j + 1 = k + · have hju : j = u.length := by rw [hlu]; omega + subst j + simp only [List.getElem_cons_succ] + rw [List.getElem_append_right (as := u) (bs := b :: v) (by omega)] + simp only [Nat.sub_self] + simp only [List.getElem_cons_zero] + have hpos : u.length + 1 = k := by rw [hlu]; omega + have hget := hget_l k hklt + have hh : l[k] = b := hget.trans hrotk + simpa only [l, hpos] using hh + · by_cases hju : j < u.length + · simp only [List.getElem_cons_succ] + rw [List.getElem_append_left hju] + simp only [u, List.getElem_take, List.getElem_drop] + simp [l, Nat.add_comm] + · have hjtail : u.length < j := by rw [hlu]; omega + simp only [List.getElem_cons_succ] + have hj' : j < (u ++ b :: v).length := by simpa using hj₂ + rw [List.getElem_append_right (as := u) (bs := b :: v) + hjtail.le (h₂ := hj')] + let t := j - u.length - 1 + have hsub : j - u.length = t + 1 := by dsimp [t]; omega + simp only [hsub, List.getElem_cons_succ] + simp only [v, List.getElem_drop] + rw [List.getElem_ofFn] + have hjN : j + 1 < N := by + dsimp [N] + simp only [List.length_ofFn] at hj₁ + omega + have hbnd : k + 1 + (j - u.length - 1) < N := by + rw [hlu] + omega + have hidx := hget_l (k + 1 + (j - u.length - 1)) hbnd + rw [hidx] + apply congrArg rot + apply Fin.ext + simp only [] + rw [hlu] + omega + +private noncomputable abbrev leftN (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) := (k n a b) - 2 + +private noncomputable abbrev rightN (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) := (N n) - (k n + a b) - 2 + +private theorem hleftLen (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ + a + 1) (hprev : a ≠ b + 1) : (leftN n a b) + 3 = (k n a b) + 1 := by + classical + let N := n + 3 + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hk_bounds : 2 ≤ k ∧ k ≤ N - 2 := hk_bounds n a b hab hnext hprev + let leftN := k - 2 + dsimp only [CyclicChildrenConstruction.k, CyclicChildrenConstruction.leftN] at * + change (leftN + 3 = k + 1) + dsimp [leftN]; omega + +private theorem hrightLen (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b + ≠ a + 1) (hprev : a ≠ b + 1) : (rightN n a b) + 3 = (N n) - (k n a b) + 1 := by + classical + let N := n + 3 + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k, + CyclicChildrenConstruction.rightN] at * + change (rightN + 3 = N - k + 1) + dsimp [rightN]; omega + +private theorem hleftLt (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ + a + 1) (hprev : a ≠ b + 1) : (leftN n a b) < n := by + classical + let N := n + 3 + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + dsimp only [CyclicChildrenConstruction.leftN] at * + change (leftN < n) + dsimp [leftN, N]; omega + +private theorem hrightLt (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ + a + 1) (hprev : a ≠ b + 1) : (rightN n a b) < n := by + classical + let N := n + 3 + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + have hk_bounds : 2 ≤ k ∧ k ≤ N - 2 := hk_bounds n a b hab hnext hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + dsimp only [CyclicChildrenConstruction.rightN] at * + change (rightN < n) + dsimp [rightN, N]; omega + +private noncomputable abbrev il (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) + (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) : Fin ((leftN n a b) + 3) → Fin (N n) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.leftN] at * + change (Fin (leftN + 3) → Fin N) + exact fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + +private noncomputable abbrev posR (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) : Fin ((rightN n + a b) + 3) → Nat := by + classical + let N := n + 3 + let k : Nat := (b.val + N - a.val) % N + let rightN := N - k - 2 + dsimp only [CyclicChildrenConstruction.rightN] at * + change (Fin (rightN + 3) → Nat) + exact fun i => + if i.val = N - k then 0 else k + i.val + +private theorem hposRlt (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ + a + 1) (hprev : a ≠ b + 1) (i : Fin ((rightN n a b) + 3)) : (posR n a b) i < (N n) := by + classical + let N := n + 3 + have hNpos : 0 < N := hNpos n + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.rightN] at * + change (posR i < N) + have hi : i.val < N - k + 1 := by rw [← hrightLen]; exact i.isLt + dsimp [posR] + split_ifs <;> omega + +private noncomputable abbrev ir (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) + (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) : Fin ((rightN n a b) + 3) → Fin (N n) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + let rightN := N - k - 2 + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.rightN] at * + change (Fin (rightN + 3) → Fin N) + exact fun i => rot ⟨posR i, hposRlt i⟩ + +private theorem hleft_inj (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b + ≠ a + 1) (hprev : a ≠ b + 1) : Function.Injective (il n a b hab hnext hprev) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + have hrot_inj : Function.Injective rot := hrot_inj n a + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + change (Function.Injective il) + intro i j hij + have heq := hrot_inj hij + apply Fin.ext + have h := congrArg Fin.val heq + dsimp [il] at h + exact h + +private theorem hright_inj (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b + ≠ a + 1) (hprev : a ≠ b + 1) : Function.Injective (ir n a b hab hnext hprev) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + have hrot_inj : Function.Injective rot := hrot_inj n a + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hk_bounds : 2 ≤ k ∧ k ≤ N - 2 := hk_bounds n a b hab hnext hprev + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + change (Function.Injective ir) + intro i j hij + have heq := hrot_inj hij + have hval : posR i = posR j := congrArg Fin.val heq + apply Fin.ext + have hi_lt : i.val < N - k + 1 := by + calc i.val < rightN + 3 := i.isLt + _ = N - k + 1 := hrightLen + have hj_lt : j.val < N - k + 1 := by + calc j.val < rightN + 3 := j.isLt + _ = N - k + 1 := hrightLen + have hi : i.val ≤ N - k := by omega + have hj : j.val ≤ N - k := by omega + dsimp [posR] at hval + split_ifs at hval <;> omega + +private theorem hleft_order (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : + b ≠ a + 1) (hprev : a ≠ b + 1) : List.ofFn (il n a b hab hnext hprev) = a :: ((u n a b) ++ + [b]) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hrotzero : rot (0 : Fin N) = a := hrotzero n a + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hrotk : rot ⟨k, hklt⟩ = b := hrotk n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + have hk_bounds : 2 ≤ k ∧ k ≤ N - 2 := hk_bounds n a b hab hnext hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let l : List (Fin N) := List.ofFn rot + let u : List (Fin N) := (l.drop 1).take (k - 1) + have hlu : u.length = k - 1 := hlu n a b hprev + have hget_l (j : Nat) (hj : j < N) : + l[j]'(by simp [l]; omega) = rot ⟨j, hj⟩ := hget_l n a j hj + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev + have hrightLt : rightN < n := hrightLt n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + change (List.ofFn il = a :: (u ++ [b])) + apply List.ext_getElem + · simp only [List.length_ofFn] + rw [hleftLen] + simp [hlu] + omega + · intro j hj₁ hj₂ + cases j with + | zero => + simp [il, hrotzero] + | succ j => + by_cases hjk : j + 1 = k + · have hlast : j = u.length := by rw [hlu]; omega + have hpos : j + 1 = k := hjk + simp only [List.getElem_cons_succ] + rw [List.getElem_append_right (as := u) (bs := [b]) (by omega)] + simp only [hlast, Nat.sub_self, List.getElem_cons_zero] + have hkbound : k < leftN + 3 := by rw [hleftLen]; omega + have hget := List.getElem_ofFn (f := il) (i := k) + (by simpa only [List.length_ofFn] using hkbound) + have hilk : il ⟨k, hkbound⟩ = b := by + change rot ⟨k, hklt⟩ = b + exact hrotk + have hpos2 : u.length + 1 = k := by rw [← hlast]; exact hjk + simpa only [hpos2] using hget.trans hilk + · have hjlt : j + 1 < k := by simp only [List.length_ofFn, hleftLen] at hj₁; omega + have hju : j < u.length := by rw [hlu]; omega + simp only [List.getElem_cons_succ] + rw [List.getElem_append_left hju] + have hleftElem : (List.ofFn il)[j + 1]'(by simpa only [List.length_ofFn] using hj₁) = + rot ⟨j + 1, by omega⟩ := by + rw [List.getElem_ofFn] + have hrightElem : u[j]'hju = rot ⟨j + 1, by omega⟩ := by + change ((l.drop 1).take (k - 1))[j] = _ + simp only [List.getElem_take, List.getElem_drop] + have hg := hget_l (j + 1) (by omega) + simpa [Nat.add_comm] using hg + exact hleftElem.trans hrightElem.symm + +private theorem hright_order (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : + b ≠ a + 1) (hprev : a ≠ b + 1) : List.ofFn (ir n a b hab hnext hprev) = b :: ((v n a b) ++ + [a]) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hrotzero : rot (0 : Fin N) = a := hrotzero n a + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hrotk : rot ⟨k, hklt⟩ = b := hrotk n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + have hk_bounds : 2 ≤ k ∧ k ≤ N - 2 := hk_bounds n a b hab hnext hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let l : List (Fin N) := List.ofFn rot + let v : List (Fin N) := l.drop (k + 1) + have hlv : v.length = N - (k + 1) := hlv n a b hprev + have hget_l (j : Nat) (hj : j < N) : + l[j]'(by simp [l]; omega) = rot ⟨j, hj⟩ := hget_l n a j hj + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + change (List.ofFn ir = b :: (v ++ [a])) + apply List.ext_getElem + · simp only [List.length_ofFn] + rw [hrightLen] + simp [hlv] + omega + · intro j hj₁ hj₂ + cases j with + | zero => + have hz : ¬ (0 : Nat) = N - k := by omega + simp [ir, posR, hz, hrotk] + | succ j => + by_cases hjend : j + 1 = N - k + · have hlast : j = v.length := by rw [hlv]; omega + simp only [List.getElem_cons_succ] + rw [List.getElem_append_right (as := v) (bs := [a]) (by omega)] + simp only [hlast, Nat.sub_self, List.getElem_cons_zero] + have hpos : v.length + 1 = N - k := by rw [hlv]; omega + have hbound : N - k < rightN + 3 := by rw [hrightLen]; omega + have hget := List.getElem_ofFn (f := ir) (i := N - k) + (by simpa only [List.length_ofFn] using hbound) + have hirlast : ir ⟨N - k, hbound⟩ = a := by + change rot ⟨posR ⟨N - k, hbound⟩, hposRlt _⟩ = a + simp? [posR] + exact hrotzero + simpa only [hpos] using hget.trans hirlast + · have hjlt : j + 1 < N - k := by + simp only [List.length_ofFn, hrightLen] at hj₁ + omega + have hjv : j < v.length := by rw [hlv]; omega + simp only [List.getElem_cons_succ] + rw [List.getElem_append_left hjv] + have hleftElem : (List.ofFn ir)[j + 1] = + rot ⟨k + (j + 1), by omega⟩ := by + rw [List.getElem_ofFn] + simp [ir, posR, Nat.ne_of_lt hjlt] + have hrightElem : v[j]'hjv = rot ⟨k + (j + 1), by omega⟩ := by + change (l.drop (k + 1))[j] = _ + rw [List.getElem_drop] + have hg := hget_l (k + 1 + j) (by omega) + simpa [Nat.add_comm, Nat.add_left_comm, Nat.add_assoc] using hg + exact hleftElem.trans hrightElem.symm + +private theorem hAil (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + + 1) (hprev : a ≠ b + 1) : (il n a b hab hnext hprev) 0 = a := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hrotzero : rot (0 : Fin N) = a := hrotzero n a + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + change (il 0 = a) + simp [il, hrotzero] + +private theorem hik (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + + 1) (hprev : a ≠ b + 1) : (k n a b) < (leftN n a b) + 3 := by + classical + let N := n + 3 + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + dsimp only [CyclicChildrenConstruction.k, CyclicChildrenConstruction.leftN] at * + change (k < leftN + 3) + rw [hleftLen]; omega + +private noncomputable abbrev ik (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) + (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) : Fin ((leftN n a b) + 3) := by + classical + let N := n + 3 + let k : Nat := (b.val + N - a.val) % N + let leftN := k - 2 + have hik : k < leftN + 3 := hik n a b hab hnext hprev + dsimp only [CyclicChildrenConstruction.leftN] at * + change (Fin (leftN + 3)) + exact ⟨k, hik⟩ + +private theorem hBil (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + + 1) (hprev : a ≠ b + 1) : (il n a b hab hnext hprev) (ik n a b hab hnext hprev) = b := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hrotk : rot ⟨k, hklt⟩ = b := hrotk n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + have hik : k < leftN + 3 := hik n a b hab hnext hprev + let ik : Fin (leftN + 3) := ⟨k, hik⟩ + change (il ik = b) + change rot ⟨k, hklt⟩ = b + exact hrotk + +private theorem hBir (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + + 1) (hprev : a ≠ b + 1) : (ir n a b hab hnext hprev) 0 = b := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hrotk : rot ⟨k, hklt⟩ = b := hrotk n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + have hik : k < leftN + 3 := hik n a b hab hnext hprev + change (ir 0 = b) + have hz : ¬ (0 : Nat) = N - k := by omega + simp [ir, posR, hz, hrotk] + +private theorem hlastRlt (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ + a + 1) (hprev : a ≠ b + 1) : (N n) - (k n a b) < (rightN n a b) + 3 := by + classical + let N := n + 3 + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + have hik : k < leftN + 3 := hik n a b hab hnext hprev + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k, + CyclicChildrenConstruction.rightN] at * + change (N - k < rightN + 3) + rw [hrightLen]; omega + +private noncomputable abbrev lastR (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) + (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) : Fin ((rightN n a b) + 3) := by + classical + let N := n + 3 + let k : Nat := (b.val + N - a.val) % N + let rightN := N - k - 2 + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + dsimp only [CyclicChildrenConstruction.rightN] at * + change (Fin (rightN + 3)) + exact ⟨N - k, hlastRlt⟩ + +private theorem hAir (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + + 1) (hprev : a ≠ b + 1) : (ir n a b hab hnext hprev) (lastR n a b hab hnext hprev) = a := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hrotzero : rot (0 : Fin N) = a := hrotzero n a + let rightN := N - k - 2 + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + let lastR : Fin (rightN + 3) := ⟨N - k, hlastRlt⟩ + change (ir lastR = a) + change rot ⟨posR lastR, hposRlt lastR⟩ = a + simp [lastR, posR, hrotzero] + +private theorem hcommon (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ + a + 1) (hprev : a ≠ b + 1) : Set.range (il n a b hab hnext hprev) ∩ Set.range (ir n a b hab + hnext hprev) = {a, b} := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + have hrot_inj : Function.Injective rot := hrot_inj n a + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + have hAil : il 0 = a := hAil n a b hab hnext hprev + have hik : k < leftN + 3 := hik n a b hab hnext hprev + let ik : Fin (leftN + 3) := ⟨k, hik⟩ + have hBil : il ik = b := hBil n a b hab hnext hprev + have hBir : ir 0 = b := hBir n a b hab hnext hprev + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + let lastR : Fin (rightN + 3) := ⟨N - k, hlastRlt⟩ + have hAir : ir lastR = a := hAir n a b hab hnext hprev + change (Set.range il ∩ Set.range ir = {a, b}) + apply Set.ext + intro x + constructor + · intro hx + rcases hx.1 with ⟨i, hxi⟩ + rcases hx.2 with ⟨j, hxj⟩ + have hEq : ir j = il i := hxj.trans hxi.symm + have hiN : i.val < N := by + have hi' : i.val < k + 1 := by simpa only [hleftLen] using i.isLt + omega + have hpos : (⟨i.val, hiN⟩ : Fin N) = + ⟨posR j, hposRlt j⟩ := by + apply hrot_inj + simpa [il, ir] using hEq.symm + have hv : i.val = posR j := congrArg Fin.val hpos + have hi : i.val ≤ k := by + have hbound : i.val < k + 1 := by simpa only [hleftLen] using i.isLt + omega + have hj : j.val ≤ N - k := by + have hbound : j.val < N - k + 1 := by simpa only [hrightLen] using j.isLt + omega + by_cases hend : j.val = N - k + · have hzero : posR j = 0 := by simp [posR, hend] + have hizero : i.val = 0 := by omega + have hi0 : i = 0 := Fin.ext hizero + apply Or.inl + calc + x = il i := hxi.symm + _ = il 0 := by rw [hi0] + _ = a := hAil + · have hposr : posR j = k + j.val := by simp [posR, hend] + have hjeq : j.val = 0 := by omega + have hival : i.val = k := by omega + have hiK : i = ik := Fin.ext hival + apply Or.inr + calc + x = il i := hxi.symm + _ = il ik := by rw [hiK] + _ = b := hBil + · intro hx + rcases hx with hxa | hxb + · subst x + exact ⟨⟨0, hAil⟩, ⟨lastR, hAir⟩⟩ + · subst x + exact ⟨⟨ik, hBil⟩, ⟨0, hBir⟩⟩ + +private theorem hopen_old_disjoint (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) + (b : Fin (n + 3)) (hclear : Disjoint (openSegment Real (p.vertex a) (p.vertex b)) + (P3544T1BoundaryCarrier p)) (x : Real × Real) (hx : + x ∈ openSegment Real (p.vertex a) (p.vertex b)) (j : Fin (N n)) : + x ∉ segment Real (p.vertex j) (p.vertex (j + 1)) := by + classical + let N := n + 3 + dsimp only [CyclicChildrenConstruction.N] at * + intro hxj + have hxC : x ∈ P3544T1BoundaryCarrier p := by + simp? [P3544T1BoundaryCarrier] + exact ⟨j, hxj⟩ + exact (Set.disjoint_left.mp hclear) hx hxC + +private theorem hvertex_side (n : Nat) (p : P3381T1PolygonBoundary n) (e j : Fin (N n)) (hmem : + p.vertex e ∈ segment Real (p.vertex j) (p.vertex (j + 1))) : + e = j ∨ e = j + 1 := by + classical + let N := n + 3 + dsimp only [CyclicChildrenConstruction.N] at * + by_cases heq : e = j + · exact Or.inl heq + · by_cases heq' : e = j + 1 + · exact Or.inr heq' + · have hedge := p.edge_intersection e j heq + have hpt : p.vertex e ∈ segment Real (p.vertex e) (p.vertex (e + 1)) := + left_mem_segment Real _ _ + have hpair : p.vertex e ∈ + segment Real (p.vertex e) (p.vertex (e + 1)) ∩ + segment Real (p.vertex j) (p.vertex (j + 1)) := ⟨hpt, hmem⟩ + rw [hedge] at hpair + rcases hpair with ⟨_, hends⟩ + rcases hends with h | h + · exact Or.inl (p.injective h) + · exact Or.inr (p.injective h) + +private theorem hchord_old (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b : Fin + (n + 3)) (hclear : Disjoint (openSegment Real (p.vertex a) (p.vertex b)) + (P3544T1BoundaryCarrier p)) (x : Real × Real) (j : Fin (N n)) : + x ∈ segment Real (p.vertex a) (p.vertex b) ∩ + segment Real (p.vertex j) (p.vertex (j + 1)) ↔ + (x = p.vertex a ∨ x = p.vertex b) ∧ + (x = p.vertex j ∨ x = p.vertex (j + 1)) := by + classical + let N := n + 3 + have hopen_old_disjoint (x : Real × Real) (hx : + x ∈ openSegment Real (p.vertex a) (p.vertex b)) (j : Fin N) : + x ∉ segment Real (p.vertex j) (p.vertex (j + 1)) := hopen_old_disjoint n p a b hclear x hx j + have hvertex_side (e j : Fin N) (hmem : + p.vertex e ∈ segment Real (p.vertex j) (p.vertex (j + 1))) : + e = j ∨ e = j + 1 := hvertex_side n p e j hmem + dsimp only [CyclicChildrenConstruction.N] at * + constructor + · rintro ⟨hxchord, hxold⟩ + rw [← insert_endpoints_openSegment Real (p.vertex a) (p.vertex b)] at hxchord + simp only [Set.mem_insert_iff] at hxchord + rcases hxchord with hxa | hxb | hopen + · subst x + rcases hvertex_side a j hxold with h | h + · exact ⟨Or.inl rfl, Or.inl (congrArg p.vertex h)⟩ + · exact ⟨Or.inl rfl, Or.inr (congrArg p.vertex h)⟩ + · subst x + rcases hvertex_side b j hxold with h | h + · exact ⟨Or.inr rfl, Or.inl (congrArg p.vertex h)⟩ + · exact ⟨Or.inr rfl, Or.inr (congrArg p.vertex h)⟩ + · exact False.elim ((hopen_old_disjoint x hopen j) hxold) + · rintro ⟨hchord, hold⟩ + constructor + · rcases hchord with hxa | hxb + · rw [hxa] + exact left_mem_segment Real _ _ + · rw [hxb] + exact right_mem_segment Real _ _ + · rcases hold with hxj | hxj1 + · rw [hxj] + exact left_mem_segment Real _ _ + · rw [hxj1] + exact right_mem_segment Real _ _ + +private theorem hrot_succ (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b + ≠ a + 1) (hprev : a ≠ b + 1) (i : Fin (N n)) : (rot n a) (i + 1) = (rot n a) i + 1 := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + have hik : k < leftN + 3 := hik n a b hab hnext hprev + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + dsimp only [CyclicChildrenConstruction.N] at * + change (rot (i + 1) = rot i + 1) + apply Fin.ext + change (a.val + (i.val + 1) % N) % N = + ((a.val + i.val) % N + 1) % N + calc + (a.val + (i.val + 1) % N) % N = + ((i.val + 1) % N + a.val) % N := by rw [Nat.add_comm] + _ = (i.val + 1 + a.val) % N := Nat.mod_add_mod (i.val + 1) N a.val + _ = (a.val + i.val + 1) % N := by congr 1; omega + _ = ((a.val + i.val) % N + 1) % N := + (Nat.mod_add_mod (a.val + i.val) N 1).symm + +private theorem hleftLen_gt (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : + b ≠ a + 1) (hprev : a ≠ b + 1) : 1 < (leftN n a b) + 3 := by + classical + let N := n + 3 + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + have hk_bounds : 2 ≤ k ∧ k ≤ N - 2 := hk_bounds n a b hab hnext hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + have hik : k < leftN + 3 := hik n a b hab hnext hprev + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + dsimp only [CyclicChildrenConstruction.leftN] at * + change (1 < leftN + 3) + rw [hleftLen]; omega + +private theorem hrightLen_gt (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : + b ≠ a + 1) (hprev : a ≠ b + 1) : 1 < (rightN n a b) + 3 := by + classical + let N := n + 3 + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + have hik : k < leftN + 3 := hik n a b hab hnext hprev + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + dsimp only [CyclicChildrenConstruction.rightN] at * + change (1 < rightN + 3) + rw [hrightLen]; omega + +private theorem hleft_succ (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b + ≠ a + 1) (hprev : a ≠ b + 1) (i : Fin ((leftN n a b) + 3)) (hi : i.val < (k n a b)) : + (il n a b hab hnext hprev) (i + 1) = (il n a b hab hnext hprev) i + 1 := by + classical + let N := n + 3 + have hN : 3 ≤ N := hN n + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + have hik : k < leftN + 3 := hik n a b hab hnext hprev + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + have hrot_succ (i : Fin N) : rot (i + 1) = rot i + 1 := hrot_succ n a b hab hnext hprev i + have hleftLen_gt : 1 < leftN + 3 := hleftLen_gt n a b hab hnext hprev + dsimp only [CyclicChildrenConstruction.k, CyclicChildrenConstruction.leftN] at * + change (il (i + 1) = il i + 1) + have hbound : i.val + 1 < leftN + 3 := by + calc i.val + 1 < k + 1 := Nat.succ_lt_succ hi + _ = leftN + 3 := hleftLen.symm + have hone : (1 : Fin (leftN + 3)).val = 1 := by + simp [Nat.mod_eq_of_lt hleftLen_gt] + have hval : (i + 1).val = i.val + 1 := by + change (i.val + (1 : Fin (leftN + 3)).val) % (leftN + 3) = i.val + 1 + rw [hone, Nat.mod_eq_of_lt hbound] + have hparentidx : (⟨i.val, by omega⟩ : Fin N) + 1 = ⟨i.val + 1, by omega⟩ := by + apply Fin.ext + simp [Fin.val_add_eq_ite, Nat.mod_eq_of_lt (by omega : 1 < N), + Nat.not_le.mpr (by omega : i.val + 1 < N)] + calc + il (i + 1) = rot ⟨i.val + 1, by + calc i.val + 1 < k + 1 := Nat.succ_lt_succ hi + _ ≤ N := by rw [← hleftLen]; omega⟩ := by + dsimp [il] + congr 1 + exact Fin.ext hval + _ = rot ((⟨i.val, by omega⟩ : Fin N) + 1) := by rw [hparentidx] + _ = rot ⟨i.val, by omega⟩ + 1 := hrot_succ ⟨i.val, by omega⟩ + _ = il i + 1 := rfl + +private theorem hright_succ (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : + b ≠ a + 1) (hprev : a ≠ b + 1) (i : Fin ((rightN n a b) + 3)) (hi : i.val < (N n) - (k n a b)) : + (ir n a b hab hnext hprev) (i + 1) = (ir n a b hab hnext hprev) i + 1 := by + classical + let N := n + 3 + have hN : 3 ≤ N := hN n + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + have hik : k < leftN + 3 := hik n a b hab hnext hprev + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + have hrot_succ (i : Fin N) : rot (i + 1) = rot i + 1 := hrot_succ n a b hab hnext hprev i + have hrightLen_gt : 1 < rightN + 3 := hrightLen_gt n a b hab hnext hprev + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k, + CyclicChildrenConstruction.rightN] at * + change (ir (i + 1) = ir i + 1) + have hbound : i.val + 1 < rightN + 3 := by + calc i.val + 1 < N - k + 1 := Nat.succ_lt_succ hi + _ = rightN + 3 := hrightLen.symm + have hone : (1 : Fin (rightN + 3)).val = 1 := by + simp [Nat.mod_eq_of_lt hrightLen_gt] + have hval : (i + 1).val = i.val + 1 := by + change (i.val + (1 : Fin (rightN + 3)).val) % (rightN + 3) = i.val + 1 + rw [hone, Nat.mod_eq_of_lt hbound] + by_cases hend : i.val + 1 = N - k + · have hpnext : posR (i + 1) = 0 := by simp [posR, hval, hend] + have hpar : (⟨k + i.val, by omega⟩ : Fin N) + 1 = 0 := by + apply Fin.ext + have hsum : k + i.val + 1 = N := by omega + have honeN : (1 : Fin N).val = 1 := by + simp [Nat.mod_eq_of_lt (by omega : 1 < N)] + rw [Fin.val_add_eq_ite, honeN] + rw [ite_eq_left (show N ≤ k + i.val + 1 by omega)] + simp [hsum] + calc + ir (i + 1) = rot 0 := by simp [ir, hpnext] + _ = rot ((⟨k + i.val, by omega⟩ : Fin N) + 1) := by rw [hpar] + _ = rot ⟨k + i.val, by omega⟩ + 1 := hrot_succ _ + _ = ir i + 1 := by + have hpi : posR i = k + i.val := by simp [posR]; omega + simp [ir, hpi] + · have hpnext : posR (i + 1) = k + i.val + 1 := by + simp only [posR, hval, ite_eq_right hend] + exact (Nat.add_assoc k i.val 1).symm + have hpi : posR i = k + i.val := by + have hne : i.val ≠ N - k := by omega + simp [posR, hne] + have hparentidx : (⟨k + i.val, by omega⟩ : Fin N) + 1 = + ⟨k + i.val + 1, by omega⟩ := by + apply Fin.ext + simp [Fin.val_add_eq_ite, Nat.mod_eq_of_lt (by omega : 1 < N), + Nat.not_le.mpr (by omega : k + i.val + 1 < N)] + calc + ir (i + 1) = rot ⟨k + i.val + 1, by omega⟩ := by + simp only [ir, hpnext] + _ = rot ((⟨k + i.val, by omega⟩ : Fin N) + 1) := by rw [hparentidx] + _ = rot ⟨k + i.val, by omega⟩ + 1 := hrot_succ _ + _ = ir i + 1 := by simp [ir, hpi] + +private theorem hleft_wrap (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b + ≠ a + 1) (hprev : a ≠ b + 1) : (ik n a b hab hnext hprev) + 1 = 0 := by + classical + let N := n + 3 + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + have hk_bounds : 2 ≤ k ∧ k ≤ N - 2 := hk_bounds n a b hab hnext hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + have hik : k < leftN + 3 := hik n a b hab hnext hprev + let ik : Fin (leftN + 3) := ⟨k, hik⟩ + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + change (ik + 1 = 0) + apply Fin.ext + simp [ik, Fin.val_add_eq_ite, hleftLen, + Nat.mod_eq_of_lt (by omega : 1 < k + 1)] + +private theorem hright_wrap (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : + b ≠ a + 1) (hprev : a ≠ b + 1) : (lastR n a b hab hnext hprev) + 1 = 0 := by + classical + let N := n + 3 + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + have hik : k < leftN + 3 := hik n a b hab hnext hprev + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + let lastR : Fin (rightN + 3) := ⟨N - k, hlastRlt⟩ + change (lastR + 1 = 0) + apply Fin.ext + simp [lastR, Fin.val_add_eq_ite, hrightLen, + Nat.mod_eq_of_lt (by omega : 1 < N - k + 1)] + +private theorem hleft_ord_edge (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext + : b ≠ a + 1) (hprev : a ≠ b + 1) (i : Fin ((leftN n a b) + 3)) (hi : i.val < (k n a b)) : + (il n a b hab hnext hprev) (i + 1) = (il n a b hab hnext hprev) i + 1 := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + have hleft_succ (i : Fin (leftN + 3)) (hi : i.val < k) : + il (i + 1) = il i + 1 := hleft_succ n a b hab hnext hprev i hi + dsimp only [CyclicChildrenConstruction.k, CyclicChildrenConstruction.leftN] at * + change (il (i + 1) = il i + 1) + exact hleft_succ i hi + +private theorem hright_ord_edge (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) + (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (i : Fin ((rightN n a b) + 3)) (hi : i.val < (N n) - + (k n a b)) : + (ir n a b hab hnext hprev) (i + 1) = (ir n a b hab hnext hprev) i + 1 := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + let rightN := N - k - 2 + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + have hright_succ (i : Fin (rightN + 3)) (hi : i.val < N - k) : + ir (i + 1) = ir i + 1 := hright_succ n a b hab hnext hprev i hi + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k, + CyclicChildrenConstruction.rightN] at * + change (ir (i + 1) = ir i + 1) + exact hright_succ i hi + +private theorem hleft_last_edge (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b : + Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) : + segment Real (p.vertex ((il n a b hab hnext hprev) (ik n a b hab hnext hprev))) (p.vertex + ((il n a b hab hnext hprev) ((ik n a b hab hnext hprev) + 1))) = + segment Real (p.vertex a) (p.vertex b) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + have hAil : il 0 = a := hAil n a b hab hnext hprev + have hik : k < leftN + 3 := hik n a b hab hnext hprev + let ik : Fin (leftN + 3) := ⟨k, hik⟩ + have hBil : il ik = b := hBil n a b hab hnext hprev + have hleft_wrap : ik + 1 = 0 := hleft_wrap n a b hab hnext hprev + change (segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) = + segment Real (p.vertex a) (p.vertex b)) + rw [hleft_wrap, hBil, hAil] + exact segment_symm Real _ _ + +private theorem hright_last_edge (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b + : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) : + segment Real (p.vertex ((ir n a b hab hnext hprev) (lastR n a b hab hnext hprev))) + (p.vertex ((ir n a b hab hnext hprev) ((lastR n a b hab hnext hprev) + 1))) = + segment Real (p.vertex a) (p.vertex b) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + let rightN := N - k - 2 + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + have hBir : ir 0 = b := hBir n a b hab hnext hprev + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + let lastR : Fin (rightN + 3) := ⟨N - k, hlastRlt⟩ + have hAir : ir lastR = a := hAir n a b hab hnext hprev + have hright_wrap : lastR + 1 = 0 := hright_wrap n a b hab hnext hprev + change (segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) = + segment Real (p.vertex a) (p.vertex b)) + rw [hright_wrap, hAir, hBir] + +private theorem hleft_nonlast (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b : + Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (i : Fin ((leftN n a b) + + 3)) (hi : i.val < (k n a b)) : + segment Real (p.vertex ((il n a b hab hnext hprev) i)) (p.vertex ((il n a b hab hnext + hprev) (i + 1))) = + segment Real (p.vertex ((il n a b hab hnext hprev) i)) (p.vertex ((il n a b hab hnext + hprev) i + 1)) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + have hleft_succ (i : Fin (leftN + 3)) (hi : i.val < k) : + il (i + 1) = il i + 1 := hleft_succ n a b hab hnext hprev i hi + dsimp only [CyclicChildrenConstruction.k, CyclicChildrenConstruction.leftN] at * + change (segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) = + segment Real (p.vertex (il i)) (p.vertex (il i + 1))) + rw [hleft_succ i hi] + +private theorem hright_nonlast (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b : + Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (i : Fin ((rightN n a b) + + 3)) (hi : i.val < (N n) - (k n a b)) : + segment Real (p.vertex ((ir n a b hab hnext hprev) i)) (p.vertex ((ir n a b hab hnext + hprev) (i + 1))) = + segment Real (p.vertex ((ir n a b hab hnext hprev) i)) (p.vertex ((ir n a b hab hnext + hprev) i + 1)) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + let rightN := N - k - 2 + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + have hright_succ (i : Fin (rightN + 3)) (hi : i.val < N - k) : + ir (i + 1) = ir i + 1 := hright_succ n a b hab hnext hprev i hi + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k, + CyclicChildrenConstruction.rightN] at * + change (segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) = + segment Real (p.vertex (ir i)) (p.vertex (ir i + 1))) + rw [hright_succ i hi] + +private theorem hleft_old_old (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b : + Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (i j : Fin ((leftN n a b) + + 3)) (hi : i.val < (k n a b)) + (hj : j.val < (k n a b)) (hij : i ≠ j) : + segment Real (p.vertex ((il n a b hab hnext hprev) i)) (p.vertex ((il n a b hab hnext + hprev) (i + 1))) ∩ + segment Real (p.vertex ((il n a b hab hnext hprev) j)) (p.vertex ((il n a b hab hnext + hprev) (j + 1))) = + {x | (x = p.vertex ((il n a b hab hnext hprev) i) ∨ x = p.vertex ((il n a b hab hnext + hprev) (i + 1))) ∧ + (x = p.vertex ((il n a b hab hnext hprev) j) ∨ x = p.vertex ((il n a b hab hnext hprev) + (j + 1)))} := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + have hleft_inj : Function.Injective il := hleft_inj n a b hab hnext hprev + have hleft_succ (i : Fin (leftN + 3)) (hi : i.val < k) : + il (i + 1) = il i + 1 := hleft_succ n a b hab hnext hprev i hi + dsimp only [CyclicChildrenConstruction.k, CyclicChildrenConstruction.leftN] at * + change (segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) ∩ + segment Real (p.vertex (il j)) (p.vertex (il (j + 1))) = + {x | (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1))) ∧ + (x = p.vertex (il j) ∨ x = p.vertex (il (j + 1)))}) + have hq : il i ≠ il j := by + intro he + exact hij (hleft_inj he) + have hp := p.edge_intersection (il i) (il j) hq + rw [← hleft_succ i hi, ← hleft_succ j hj] at hp + exact hp + +private theorem hright_old_old (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b : + Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (i j : Fin ((rightN n a b) + + 3)) (hi : i.val < (N n) - (k n a b)) + (hj : j.val < (N n) - (k n a b)) (hij : i ≠ j) : + segment Real (p.vertex ((ir n a b hab hnext hprev) i)) (p.vertex ((ir n a b hab hnext + hprev) (i + 1))) ∩ + segment Real (p.vertex ((ir n a b hab hnext hprev) j)) (p.vertex ((ir n a b hab hnext + hprev) (j + 1))) = + {x | (x = p.vertex ((ir n a b hab hnext hprev) i) ∨ x = p.vertex ((ir n a b hab hnext + hprev) (i + 1))) ∧ + (x = p.vertex ((ir n a b hab hnext hprev) j) ∨ x = p.vertex ((ir n a b hab hnext hprev) + (j + 1)))} := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + let rightN := N - k - 2 + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + have hright_inj : Function.Injective ir := hright_inj n a b hab hnext hprev + have hright_succ (i : Fin (rightN + 3)) (hi : i.val < N - k) : + ir (i + 1) = ir i + 1 := hright_succ n a b hab hnext hprev i hi + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k, + CyclicChildrenConstruction.rightN] at * + change (segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) ∩ + segment Real (p.vertex (ir j)) (p.vertex (ir (j + 1))) = + {x | (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1))) ∧ + (x = p.vertex (ir j) ∨ x = p.vertex (ir (j + 1)))}) + have hq : ir i ≠ ir j := by + intro he + exact hij (hright_inj he) + have hp := p.edge_intersection (ir i) (ir j) hq + rw [← hright_succ i hi, ← hright_succ j hj] at hp + exact hp + +private theorem hleft_old_last (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b : + Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (hclear : Disjoint + (openSegment Real (p.vertex a) (p.vertex b)) (P3544T1BoundaryCarrier p)) (i : Fin ((leftN n + a b) + 3)) (hi : i.val < (k n a b)) : + segment Real (p.vertex ((il n a b hab hnext hprev) i)) (p.vertex ((il n a b hab hnext + hprev) (i + 1))) ∩ + segment Real (p.vertex ((il n a b hab hnext hprev) (ik n a b hab hnext hprev))) + (p.vertex ((il n a b hab hnext hprev) ((ik n a b hab hnext hprev) + 1))) = + {x | (x = p.vertex ((il n a b hab hnext hprev) i) ∨ x = p.vertex ((il n a b hab hnext + hprev) (i + 1))) ∧ + (x = p.vertex ((il n a b hab hnext hprev) (ik n a b hab hnext hprev)) ∨ x = p.vertex + ((il n a b hab hnext hprev) ((ik n a b hab hnext hprev) + 1)))} := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + have hAil : il 0 = a := hAil n a b hab hnext hprev + have hik : k < leftN + 3 := hik n a b hab hnext hprev + let ik : Fin (leftN + 3) := ⟨k, hik⟩ + have hBil : il ik = b := hBil n a b hab hnext hprev + have hchord_old (x : Real × Real) (j : Fin N) : + x ∈ segment Real (p.vertex a) (p.vertex b) ∩ + segment Real (p.vertex j) (p.vertex (j + 1)) ↔ + (x = p.vertex a ∨ x = p.vertex b) ∧ + (x = p.vertex j ∨ x = p.vertex (j + 1)) := hchord_old n p a b hclear x j + have hleft_succ (i : Fin (leftN + 3)) (hi : i.val < k) : + il (i + 1) = il i + 1 := hleft_succ n a b hab hnext hprev i hi + have hleft_wrap : ik + 1 = 0 := hleft_wrap n a b hab hnext hprev + have hleft_last_edge : + segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) = + segment Real (p.vertex a) (p.vertex b) := hleft_last_edge n p a b hab hnext hprev + have hleft_nonlast (i : Fin (leftN + 3)) (hi : i.val < k) : + segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) = + segment Real (p.vertex (il i)) (p.vertex (il i + 1)) := hleft_nonlast n p a b hab hnext + hprev i hi + dsimp only [CyclicChildrenConstruction.k, CyclicChildrenConstruction.leftN] at * + change (segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) ∩ + segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) = + {x | (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1))) ∧ + (x = p.vertex (il ik) ∨ x = p.vertex (il (ik + 1)))}) + rw [hleft_nonlast i hi, hleft_last_edge] + ext x + have hh := hchord_old x (il i) + rw [Set.mem_inter_iff] at hh + simp only [Set.mem_inter_iff, Set.mem_ofPred_eq] + simpa only [hleft_succ i hi, hleft_wrap, hBil, hAil, and_comm, or_comm] using hh + +private theorem hright_old_last (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b : + Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (hclear : Disjoint + (openSegment Real (p.vertex a) (p.vertex b)) (P3544T1BoundaryCarrier p)) (i : Fin ((rightN + n a b) + 3)) (hi : i.val < (N n) - (k n a b)) : + segment Real (p.vertex ((ir n a b hab hnext hprev) i)) (p.vertex ((ir n a b hab hnext + hprev) (i + 1))) ∩ + segment Real (p.vertex ((ir n a b hab hnext hprev) (lastR n a b hab hnext hprev))) + (p.vertex ((ir n a b hab hnext hprev) ((lastR n a b hab hnext hprev) + 1))) = + {x | (x = p.vertex ((ir n a b hab hnext hprev) i) ∨ x = p.vertex ((ir n a b hab hnext + hprev) (i + 1))) ∧ + (x = p.vertex ((ir n a b hab hnext hprev) (lastR n a b hab hnext hprev)) ∨ x = p.vertex + ((ir n a b hab hnext hprev) ((lastR n a b hab hnext hprev) + 1)))} := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + let rightN := N - k - 2 + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + have hBir : ir 0 = b := hBir n a b hab hnext hprev + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + let lastR : Fin (rightN + 3) := ⟨N - k, hlastRlt⟩ + have hAir : ir lastR = a := hAir n a b hab hnext hprev + have hchord_old (x : Real × Real) (j : Fin N) : + x ∈ segment Real (p.vertex a) (p.vertex b) ∩ + segment Real (p.vertex j) (p.vertex (j + 1)) ↔ + (x = p.vertex a ∨ x = p.vertex b) ∧ + (x = p.vertex j ∨ x = p.vertex (j + 1)) := hchord_old n p a b hclear x j + have hright_succ (i : Fin (rightN + 3)) (hi : i.val < N - k) : + ir (i + 1) = ir i + 1 := hright_succ n a b hab hnext hprev i hi + have hright_wrap : lastR + 1 = 0 := hright_wrap n a b hab hnext hprev + have hright_last_edge : + segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) = + segment Real (p.vertex a) (p.vertex b) := hright_last_edge n p a b hab hnext hprev + have hright_nonlast (i : Fin (rightN + 3)) (hi : i.val < N - k) : + segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) = + segment Real (p.vertex (ir i)) (p.vertex (ir i + 1)) := hright_nonlast n p a b hab hnext + hprev i hi + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k, + CyclicChildrenConstruction.rightN] at * + change (segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) ∩ + segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) = + {x | (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1))) ∧ + (x = p.vertex (ir lastR) ∨ x = p.vertex (ir (lastR + 1)))}) + rw [hright_nonlast i hi, hright_last_edge] + ext x + have hh := hchord_old x (ir i) + rw [Set.mem_inter_iff] at hh + simp only [Set.mem_inter_iff, Set.mem_ofPred_eq] + simpa only [hright_succ i hi, hright_wrap, hAir, hBir, and_comm] using hh + +private theorem hleft_last_old (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b : + Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (hclear : Disjoint + (openSegment Real (p.vertex a) (p.vertex b)) (P3544T1BoundaryCarrier p)) (i : Fin ((leftN n + a b) + 3)) (hi : i.val < (k n a b)) : + segment Real (p.vertex ((il n a b hab hnext hprev) (ik n a b hab hnext hprev))) (p.vertex + ((il n a b hab hnext hprev) ((ik n a b hab hnext hprev) + 1))) ∩ + segment Real (p.vertex ((il n a b hab hnext hprev) i)) (p.vertex ((il n a b hab hnext + hprev) (i + 1))) = + {x | (x = p.vertex ((il n a b hab hnext hprev) (ik n a b hab hnext hprev)) ∨ x = p.vertex + ((il n a b hab hnext hprev) ((ik n a b hab hnext hprev) + 1))) ∧ + (x = p.vertex ((il n a b hab hnext hprev) i) ∨ x = p.vertex ((il n a b hab hnext hprev) + (i + 1)))} := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + have hik : k < leftN + 3 := hik n a b hab hnext hprev + let ik : Fin (leftN + 3) := ⟨k, hik⟩ + have hleft_old_last (i : Fin (leftN + 3)) (hi : i.val < k) : + segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) ∩ + segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) = + {x | (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1))) ∧ + (x = p.vertex (il ik) ∨ x = p.vertex (il (ik + 1)))} := hleft_old_last n p a b hab + hnext hprev hclear i hi + dsimp only [CyclicChildrenConstruction.k, CyclicChildrenConstruction.leftN] at * + change (segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) ∩ + segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) = + {x | (x = p.vertex (il ik) ∨ x = p.vertex (il (ik + 1))) ∧ + (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1)))}) + ext x + simp only [Set.mem_inter_iff, Set.mem_ofPred_eq] + have hh := congrArg (fun s : Set (Real × Real) => x ∈ s) (hleft_old_last i hi) + simp only [Set.mem_inter_iff, Set.mem_ofPred_eq] at hh + constructor + · rintro ⟨hdiag, hold⟩ + rcases hh.mp ⟨hold, hdiag⟩ with ⟨eold, ediag⟩ + exact ⟨ediag, eold⟩ + · rintro ⟨ediag, eold⟩ + rcases hh.mpr ⟨eold, ediag⟩ with ⟨hold, hdiag⟩ + exact ⟨hdiag, hold⟩ + +private theorem hright_last_old (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b : + Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (hclear : Disjoint + (openSegment Real (p.vertex a) (p.vertex b)) (P3544T1BoundaryCarrier p)) (i : Fin ((rightN + n a b) + 3)) (hi : i.val < (N n) - (k n a b)) : + segment Real (p.vertex ((ir n a b hab hnext hprev) (lastR n a b hab hnext hprev))) + (p.vertex ((ir n a b hab hnext hprev) ((lastR n a b hab hnext hprev) + 1))) ∩ + segment Real (p.vertex ((ir n a b hab hnext hprev) i)) (p.vertex ((ir n a b hab hnext + hprev) (i + 1))) = + {x | (x = p.vertex ((ir n a b hab hnext hprev) (lastR n a b hab hnext hprev)) ∨ x = + p.vertex ((ir n a b hab hnext hprev) ((lastR n a b hab hnext hprev) + 1))) ∧ + (x = p.vertex ((ir n a b hab hnext hprev) i) ∨ x = p.vertex ((ir n a b hab hnext hprev) + (i + 1)))} := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + let rightN := N - k - 2 + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + let lastR : Fin (rightN + 3) := ⟨N - k, hlastRlt⟩ + have hright_old_last (i : Fin (rightN + 3)) (hi : i.val < N - k) : + segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) ∩ + segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) = + {x | (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1))) ∧ + (x = p.vertex (ir lastR) ∨ x = p.vertex (ir (lastR + 1)))} := hright_old_last n p a b + hab hnext hprev hclear i hi + dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k, + CyclicChildrenConstruction.rightN] at * + change (segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) ∩ + segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) = + {x | (x = p.vertex (ir lastR) ∨ x = p.vertex (ir (lastR + 1))) ∧ + (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1)))}) + ext x + simp only [Set.mem_inter_iff, Set.mem_ofPred_eq] + have hh := congrArg (fun s : Set (Real × Real) => x ∈ s) (hright_old_last i hi) + simp only [Set.mem_inter_iff, Set.mem_ofPred_eq] at hh + constructor + · rintro ⟨hdiag, hold⟩ + rcases hh.mp ⟨hold, hdiag⟩ with ⟨eold, ediag⟩ + exact ⟨ediag, eold⟩ + · rintro ⟨ediag, eold⟩ + rcases hh.mpr ⟨eold, ediag⟩ with ⟨hold, hdiag⟩ + exact ⟨hdiag, hold⟩ + +private noncomputable abbrev leftPoly (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (hclear : + Disjoint (openSegment Real (p.vertex a) (p.vertex b)) (P3544T1BoundaryCarrier p)) : + P3381T1PolygonBoundary (leftN n a b) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + have hleft_inj : Function.Injective il := hleft_inj n a b hab hnext hprev + have hik : k < leftN + 3 := hik n a b hab hnext hprev + let ik : Fin (leftN + 3) := ⟨k, hik⟩ + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + have hleft_old_old (i j : Fin (leftN + 3)) (hi : i.val < k) + (hj : j.val < k) (hij : i ≠ j) : + segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) ∩ + segment Real (p.vertex (il j)) (p.vertex (il (j + 1))) = + {x | (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1))) ∧ + (x = p.vertex (il j) ∨ x = p.vertex (il (j + 1)))} := hleft_old_old n p a b hab hnext + hprev i j hi hj hij + have hleft_old_last (i : Fin (leftN + 3)) (hi : i.val < k) : + segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) ∩ + segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) = + {x | (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1))) ∧ + (x = p.vertex (il ik) ∨ x = p.vertex (il (ik + 1)))} := hleft_old_last n p a b hab + hnext hprev hclear i hi + have hleft_last_old (i : Fin (leftN + 3)) (hi : i.val < k) : + segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) ∩ + segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) = + {x | (x = p.vertex (il ik) ∨ x = p.vertex (il (ik + 1))) ∧ + (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1)))} := hleft_last_old n p a b hab hnext + hprev hclear i hi + dsimp only [CyclicChildrenConstruction.leftN] at * + change (P3381T1PolygonBoundary leftN) + exact { + vertex := fun i => p.vertex (il i) + rational := fun i => p.rational (il i) + injective := p.injective.comp hleft_inj + edge_intersection := by + intro i j hij + have hi' : i.val < leftN + 3 := i.isLt + have hj' : j.val < leftN + 3 := j.isLt + by_cases hi : i.val = k + · have hik' : i = ik := Fin.ext hi + subst i + by_cases hj : j.val = k + · have hjk' : j = ik := Fin.ext hj + subst j + exact (hij rfl).elim + · have hjlt : j.val < k := by + have hb : j.val < k + 1 := by calc j.val < leftN + 3 := j.isLt + _ = k + 1 := hleftLen + omega + exact hleft_last_old j hjlt + · have hilt : i.val < k := by + have hb : i.val < k + 1 := by calc i.val < leftN + 3 := i.isLt + _ = k + 1 := hleftLen + omega + by_cases hj : j.val = k + · have hjk' : j = ik := Fin.ext hj + subst j + exact hleft_old_last i hilt + · have hjlt : j.val < k := by + have hb : j.val < k + 1 := by calc j.val < leftN + 3 := j.isLt + _ = k + 1 := hleftLen + omega + exact hleft_old_old i j hilt hjlt hij + } + +private noncomputable abbrev rightPoly (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (hclear : + Disjoint (openSegment Real (p.vertex a) (p.vertex b)) (P3544T1BoundaryCarrier p)) : + P3381T1PolygonBoundary (rightN n a b) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + have hright_inj : Function.Injective ir := hright_inj n a b hab hnext hprev + have hik : k < leftN + 3 := hik n a b hab hnext hprev + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + let lastR : Fin (rightN + 3) := ⟨N - k, hlastRlt⟩ + have hright_old_old (i j : Fin (rightN + 3)) (hi : i.val < N - k) + (hj : j.val < N - k) (hij : i ≠ j) : + segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) ∩ + segment Real (p.vertex (ir j)) (p.vertex (ir (j + 1))) = + {x | (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1))) ∧ + (x = p.vertex (ir j) ∨ x = p.vertex (ir (j + 1)))} := hright_old_old n p a b hab hnext + hprev i j hi hj hij + have hright_old_last (i : Fin (rightN + 3)) (hi : i.val < N - k) : + segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) ∩ + segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) = + {x | (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1))) ∧ + (x = p.vertex (ir lastR) ∨ x = p.vertex (ir (lastR + 1)))} := hright_old_last n p a b + hab hnext hprev hclear i hi + have hright_last_old (i : Fin (rightN + 3)) (hi : i.val < N - k) : + segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) ∩ + segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) = + {x | (x = p.vertex (ir lastR) ∨ x = p.vertex (ir (lastR + 1))) ∧ + (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1)))} := hright_last_old n p a b hab hnext + hprev hclear i hi + dsimp only [CyclicChildrenConstruction.rightN] at * + change (P3381T1PolygonBoundary rightN) + exact { + vertex := fun i => p.vertex (ir i) + rational := fun i => p.rational (ir i) + injective := p.injective.comp hright_inj + edge_intersection := by + intro i j hij + have hi' : i.val < rightN + 3 := i.isLt + have hj' : j.val < rightN + 3 := j.isLt + by_cases hi : i.val = N - k + · have hilast' : i = lastR := Fin.ext hi + subst i + by_cases hj : j.val = N - k + · have hjlast' : j = lastR := Fin.ext hj + subst j + exact (hij rfl).elim + · have hjlt : j.val < N - k := by + have hb : j.val < N - k + 1 := by calc j.val < rightN + 3 := j.isLt + _ = N - k + 1 := hrightLen + omega + exact hright_last_old j hjlt + · have hilt : i.val < N - k := by + have hb : i.val < N - k + 1 := by calc i.val < rightN + 3 := i.isLt + _ = N - k + 1 := hrightLen + omega + by_cases hj : j.val = N - k + · have hjlast' : j = lastR := Fin.ext hj + subst j + exact hright_old_last i hilt + · have hjlt : j.val < N - k := by + have hb : j.val < N - k + 1 := by calc j.val < rightN + 3 := j.isLt + _ = N - k + 1 := hrightLen + omega + exact hright_old_old i j hilt hjlt hij + } + +private theorem hrotsurj (n : Nat) (a : Fin (n + 3)) : Function.Surjective (rot n a) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + have hrot_inj : Function.Injective rot := hrot_inj n a + change (Function.Surjective rot) + exact Finite.injective_iff_surjective.mp hrot_inj + +private theorem hparent_mem (n : Nat) (p : P3381T1PolygonBoundary n) (x : Real × Real) : + x ∈ P3544T1BoundaryCarrier p ↔ + ∃ j : Fin (N n), x ∈ segment Real (p.vertex j) (p.vertex (j + 1)) := by + classical + let N := n + 3 + dsimp only [CyclicChildrenConstruction.N] at * + change (x ∈ P3544T1BoundaryCarrier p ↔ + ∃ j : Fin N, x ∈ segment Real (p.vertex j) (p.vertex (j + 1))) + change x ∈ (⋃ j : Fin N, segment Real (p.vertex j) (p.vertex (j + 1))) ↔ _ + simp only [Set.mem_iUnion] + +private theorem hleft_mem (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b : Fin + (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (hclear : Disjoint + (openSegment Real (p.vertex a) (p.vertex b)) (P3544T1BoundaryCarrier p)) (x : Real × Real) : + x ∈ P3544T1BoundaryCarrier (leftPoly n p a b hab hnext hprev hclear) ↔ + ∃ i : Fin ((leftN n a b) + 3), + x ∈ segment Real (p.vertex ((il n a b hab hnext hprev) i)) (p.vertex ((il n a b hab + hnext hprev) (i + 1))) := by + simp only [P3544T1BoundaryCarrier, Set.mem_iUnion, leftPoly, il, id_eq] + +private theorem hright_mem (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b : Fin + (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (hclear : Disjoint + (openSegment Real (p.vertex a) (p.vertex b)) (P3544T1BoundaryCarrier p)) (x : Real × Real) : + x ∈ P3544T1BoundaryCarrier (rightPoly n p a b hab hnext hprev hclear) ↔ + ∃ i : Fin ((rightN n a b) + 3), + x ∈ segment Real (p.vertex ((ir n a b hab hnext hprev) i)) (p.vertex ((ir n a b hab + hnext hprev) (i + 1))) := by + simp only [P3544T1BoundaryCarrier, Set.mem_iUnion, rightPoly, ir, id_eq] + +private theorem hcarrier_union (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b : + Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (hclear : Disjoint + (openSegment Real (p.vertex a) (p.vertex b)) (P3544T1BoundaryCarrier p)) : + P3544T1BoundaryCarrier (leftPoly n p a b hab hnext hprev hclear) ∪ + P3544T1BoundaryCarrier (rightPoly n p a b hab hnext hprev hclear) = + P3544T1BoundaryCarrier p ∪ segment Real (p.vertex a) (p.vertex b) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + have hleft_inj : Function.Injective il := hleft_inj n a b hab hnext hprev + have hright_inj : Function.Injective ir := hright_inj n a b hab hnext hprev + have hik : k < leftN + 3 := hik n a b hab hnext hprev + let ik : Fin (leftN + 3) := ⟨k, hik⟩ + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + let lastR : Fin (rightN + 3) := ⟨N - k, hlastRlt⟩ + have hleft_succ (i : Fin (leftN + 3)) (hi : i.val < k) : + il (i + 1) = il i + 1 := hleft_succ n a b hab hnext hprev i hi + have hright_succ (i : Fin (rightN + 3)) (hi : i.val < N - k) : + ir (i + 1) = ir i + 1 := hright_succ n a b hab hnext hprev i hi + have hleft_last_edge : + segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) = + segment Real (p.vertex a) (p.vertex b) := hleft_last_edge n p a b hab hnext hprev + have hright_last_edge : + segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) = + segment Real (p.vertex a) (p.vertex b) := hright_last_edge n p a b hab hnext hprev + have hleft_nonlast (i : Fin (leftN + 3)) (hi : i.val < k) : + segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) = + segment Real (p.vertex (il i)) (p.vertex (il i + 1)) := hleft_nonlast n p a b hab hnext + hprev i hi + have hright_nonlast (i : Fin (rightN + 3)) (hi : i.val < N - k) : + segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) = + segment Real (p.vertex (ir i)) (p.vertex (ir i + 1)) := hright_nonlast n p a b hab hnext + hprev i hi + have hleft_old_old (i j : Fin (leftN + 3)) (hi : i.val < k) + (hj : j.val < k) (hij : i ≠ j) : + segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) ∩ + segment Real (p.vertex (il j)) (p.vertex (il (j + 1))) = + {x | (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1))) ∧ + (x = p.vertex (il j) ∨ x = p.vertex (il (j + 1)))} := hleft_old_old n p a b hab hnext + hprev i j hi hj hij + have hright_old_old (i j : Fin (rightN + 3)) (hi : i.val < N - k) + (hj : j.val < N - k) (hij : i ≠ j) : + segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) ∩ + segment Real (p.vertex (ir j)) (p.vertex (ir (j + 1))) = + {x | (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1))) ∧ + (x = p.vertex (ir j) ∨ x = p.vertex (ir (j + 1)))} := hright_old_old n p a b hab hnext + hprev i j hi hj hij + have hleft_old_last (i : Fin (leftN + 3)) (hi : i.val < k) : + segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) ∩ + segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) = + {x | (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1))) ∧ + (x = p.vertex (il ik) ∨ x = p.vertex (il (ik + 1)))} := hleft_old_last n p a b hab + hnext hprev hclear i hi + have hright_old_last (i : Fin (rightN + 3)) (hi : i.val < N - k) : + segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) ∩ + segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) = + {x | (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1))) ∧ + (x = p.vertex (ir lastR) ∨ x = p.vertex (ir (lastR + 1)))} := hright_old_last n p a b + hab hnext hprev hclear i hi + have hleft_last_old (i : Fin (leftN + 3)) (hi : i.val < k) : + segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) ∩ + segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) = + {x | (x = p.vertex (il ik) ∨ x = p.vertex (il (ik + 1))) ∧ + (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1)))} := hleft_last_old n p a b hab hnext + hprev hclear i hi + have hright_last_old (i : Fin (rightN + 3)) (hi : i.val < N - k) : + segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) ∩ + segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) = + {x | (x = p.vertex (ir lastR) ∨ x = p.vertex (ir (lastR + 1))) ∧ + (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1)))} := hright_last_old n p a b hab hnext + hprev hclear i hi + let leftPoly : P3381T1PolygonBoundary leftN := CyclicChildrenConstruction.leftPoly n p a b + hab hnext hprev hclear + let rightPoly : P3381T1PolygonBoundary rightN := CyclicChildrenConstruction.rightPoly n p a b + hab hnext hprev hclear + have hrotsurj : Function.Surjective rot := hrotsurj n a + have hparent_mem (x : Real × Real) : + x ∈ P3544T1BoundaryCarrier p ↔ + ∃ j : Fin N, x ∈ segment Real (p.vertex j) (p.vertex (j + 1)) := hparent_mem n p x + have hleft_mem (x : Real × Real) : + x ∈ P3544T1BoundaryCarrier leftPoly ↔ + ∃ i : Fin (leftN + 3), + x ∈ segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) := hleft_mem n p a b hab + hnext hprev hclear x + have hright_mem (x : Real × Real) : + x ∈ P3544T1BoundaryCarrier rightPoly ↔ + ∃ i : Fin (rightN + 3), + x ∈ segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) := hright_mem n p a b hab + hnext hprev hclear x + change (P3544T1BoundaryCarrier leftPoly ∪ P3544T1BoundaryCarrier rightPoly = + P3544T1BoundaryCarrier p ∪ segment Real (p.vertex a) (p.vertex b)) + ext x + constructor + · intro hx + rcases hx with hx | hx + · obtain ⟨i, hxi⟩ := hleft_mem x |>.mp hx + by_cases hi : i.val = k + · have hiK : i = ik := Fin.ext hi + subst i + apply Or.inr + rw [← hleft_last_edge] + exact hxi + · have hilt : i.val < k := by + have hb : i.val < k + 1 := by calc i.val < leftN + 3 := i.isLt + _ = k + 1 := hleftLen + omega + have hxi' := hxi + rw [hleft_nonlast i hilt] at hxi' + apply Or.inl + exact (hparent_mem x).mpr ⟨il i, hxi'⟩ + · obtain ⟨i, hxi⟩ := hright_mem x |>.mp hx + by_cases hi : i.val = N - k + · have hiK : i = lastR := Fin.ext hi + subst i + apply Or.inr + rw [← hright_last_edge] + exact hxi + · have hilt : i.val < N - k := by + have hb : i.val < N - k + 1 := by calc i.val < rightN + 3 := i.isLt + _ = N - k + 1 := hrightLen + omega + have hxi' := hxi + rw [hright_nonlast i hilt] at hxi' + apply Or.inl + exact (hparent_mem x).mpr ⟨ir i, hxi'⟩ + · rintro (hx | hx) + · obtain ⟨j, hj⟩ := (hparent_mem x).mp hx + obtain ⟨t, ht⟩ := hrotsurj j + by_cases htleft : t.val < k + · let i : Fin (leftN + 3) := ⟨t.val, by rw [hleftLen]; omega⟩ + have hil : il i = j := by + dsimp [il, i] + rw [← ht] + have hilnext : il (i + 1) = j + 1 := by + rw [hleft_succ i htleft, hil] + have hxi : x ∈ segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) := by + simpa only [hil, hilnext] using hj + exact Or.inl ((hleft_mem x).mpr ⟨i, hxi⟩) + · have htge : k ≤ t.val := by omega + have hti : t.val - k < N - k := by omega + let i : Fin (rightN + 3) := ⟨t.val - k, by rw [hrightLen]; omega⟩ + have hir : ir i = j := by + have hpos : posR ⟨t.val - k, by rw [hrightLen]; omega⟩ = t.val := by + simp only [posR] + split_ifs with h + · omega + · omega + calc + ir i = rot t := by + dsimp [ir] + congr 1 + apply Fin.ext + exact hpos + _ = j := ht + have hirnext : ir (i + 1) = j + 1 := by + rw [hright_succ i hti, hir] + have hxi : x ∈ segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) := by + simpa only [hir, hirnext] using hj + exact Or.inr ((hright_mem x).mpr ⟨i, hxi⟩) + · have hxiL : x ∈ segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) := by + rw [hleft_last_edge] + exact hx + have hxiR : x ∈ segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) := by + rw [hright_last_edge] + exact hx + exact Or.inl ((hleft_mem x).mpr ⟨ik, hxiL⟩) + +private theorem hcommon_index (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext + : b ≠ a + 1) (hprev : a ≠ b + 1) (s t : Fin (N n)) (hs : s ∈ Set.range (il n a b hab hnext + hprev)) + (ht : t ∈ Set.range (ir n a b hab hnext hprev)) (hst : s = t) : s = a ∨ s = b := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + have hcommon : Set.range il ∩ Set.range ir = {a, b} := hcommon n a b hab hnext hprev + dsimp only [CyclicChildrenConstruction.N] at * + have hm : s ∈ Set.range il ∩ Set.range ir := by + refine ⟨hs, ?_⟩ + rcases ht with ⟨j, hj⟩ + exact ⟨j, hj.trans hst.symm⟩ + have habmem : s ∈ ({a, b} : Set (Fin N)) := by + rw [← hcommon] + exact hm + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using habmem + +private theorem hpoint_chord (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b : + Fin (n + 3)) (x : Real × Real) (s : Fin (N n)) + (hxs : x = p.vertex s) (hs : s = a ∨ s = b) : + x ∈ segment Real (p.vertex a) (p.vertex b) := by + classical + let N := n + 3 + dsimp only [CyclicChildrenConstruction.N] at * + rcases hs with h | h + · rw [hxs, h] + exact left_mem_segment Real _ _ + · rw [hxs, h] + exact right_mem_segment Real _ _ + +private theorem hcarrier_intersection (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (hclear : + Disjoint (openSegment Real (p.vertex a) (p.vertex b)) (P3544T1BoundaryCarrier p)) : + P3544T1BoundaryCarrier (leftPoly n p a b hab hnext hprev hclear) ∩ + P3544T1BoundaryCarrier (rightPoly n p a b hab hnext hprev hclear) = + segment Real (p.vertex a) (p.vertex b) := by + classical + let N := n + 3 + let rot : Fin N → Fin N := fun i => a + i + let k : Nat := (b.val + N - a.val) % N + have hklt : k < N := hklt n a b + have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b + have hkle : k + 2 ≤ N := hkle n a b hprev + let root : List (Fin N) := List.ofFn (fun i : Fin N => i) + have hrootlen : root.length = N := hrootlen n + let leftN := k - 2 + let rightN := N - k - 2 + have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev + have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev + let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ + let posR : Fin (rightN + 3) → Nat := fun i => + if i.val = N - k then 0 else k + i.val + have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i + let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ + have hleft_inj : Function.Injective il := hleft_inj n a b hab hnext hprev + have hright_inj : Function.Injective ir := hright_inj n a b hab hnext hprev + have hAil : il 0 = a := hAil n a b hab hnext hprev + have hik : k < leftN + 3 := hik n a b hab hnext hprev + let ik : Fin (leftN + 3) := ⟨k, hik⟩ + have hBil : il ik = b := hBil n a b hab hnext hprev + have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev + let lastR : Fin (rightN + 3) := ⟨N - k, hlastRlt⟩ + have hAir : ir lastR = a := hAir n a b hab hnext hprev + have hcommon : Set.range il ∩ Set.range ir = {a, b} := hcommon n a b hab hnext hprev + have hleft_succ (i : Fin (leftN + 3)) (hi : i.val < k) : + il (i + 1) = il i + 1 := hleft_succ n a b hab hnext hprev i hi + have hright_succ (i : Fin (rightN + 3)) (hi : i.val < N - k) : + ir (i + 1) = ir i + 1 := hright_succ n a b hab hnext hprev i hi + have hleft_last_edge : + segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) = + segment Real (p.vertex a) (p.vertex b) := hleft_last_edge n p a b hab hnext hprev + have hright_last_edge : + segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) = + segment Real (p.vertex a) (p.vertex b) := hright_last_edge n p a b hab hnext hprev + have hleft_nonlast (i : Fin (leftN + 3)) (hi : i.val < k) : + segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) = + segment Real (p.vertex (il i)) (p.vertex (il i + 1)) := hleft_nonlast n p a b hab hnext + hprev i hi + have hright_nonlast (i : Fin (rightN + 3)) (hi : i.val < N - k) : + segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) = + segment Real (p.vertex (ir i)) (p.vertex (ir i + 1)) := hright_nonlast n p a b hab hnext + hprev i hi + have hleft_old_old (i j : Fin (leftN + 3)) (hi : i.val < k) + (hj : j.val < k) (hij : i ≠ j) : + segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) ∩ + segment Real (p.vertex (il j)) (p.vertex (il (j + 1))) = + {x | (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1))) ∧ + (x = p.vertex (il j) ∨ x = p.vertex (il (j + 1)))} := hleft_old_old n p a b hab hnext + hprev i j hi hj hij + have hright_old_old (i j : Fin (rightN + 3)) (hi : i.val < N - k) + (hj : j.val < N - k) (hij : i ≠ j) : + segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) ∩ + segment Real (p.vertex (ir j)) (p.vertex (ir (j + 1))) = + {x | (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1))) ∧ + (x = p.vertex (ir j) ∨ x = p.vertex (ir (j + 1)))} := hright_old_old n p a b hab hnext + hprev i j hi hj hij + have hleft_old_last (i : Fin (leftN + 3)) (hi : i.val < k) : + segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) ∩ + segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) = + {x | (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1))) ∧ + (x = p.vertex (il ik) ∨ x = p.vertex (il (ik + 1)))} := hleft_old_last n p a b hab + hnext hprev hclear i hi + have hright_old_last (i : Fin (rightN + 3)) (hi : i.val < N - k) : + segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) ∩ + segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) = + {x | (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1))) ∧ + (x = p.vertex (ir lastR) ∨ x = p.vertex (ir (lastR + 1)))} := hright_old_last n p a b + hab hnext hprev hclear i hi + have hleft_last_old (i : Fin (leftN + 3)) (hi : i.val < k) : + segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) ∩ + segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) = + {x | (x = p.vertex (il ik) ∨ x = p.vertex (il (ik + 1))) ∧ + (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1)))} := hleft_last_old n p a b hab hnext + hprev hclear i hi + have hright_last_old (i : Fin (rightN + 3)) (hi : i.val < N - k) : + segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) ∩ + segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) = + {x | (x = p.vertex (ir lastR) ∨ x = p.vertex (ir (lastR + 1))) ∧ + (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1)))} := hright_last_old n p a b hab hnext + hprev hclear i hi + let leftPoly : P3381T1PolygonBoundary leftN := CyclicChildrenConstruction.leftPoly n p a b + hab hnext hprev hclear + let rightPoly : P3381T1PolygonBoundary rightN := CyclicChildrenConstruction.rightPoly n p a b + hab hnext hprev hclear + have hleft_mem (x : Real × Real) : + x ∈ P3544T1BoundaryCarrier leftPoly ↔ + ∃ i : Fin (leftN + 3), + x ∈ segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) := hleft_mem n p a b hab + hnext hprev hclear x + have hright_mem (x : Real × Real) : + x ∈ P3544T1BoundaryCarrier rightPoly ↔ + ∃ i : Fin (rightN + 3), + x ∈ segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) := hright_mem n p a b hab + hnext hprev hclear x + have hcommon_index (s t : Fin N) (hs : s ∈ Set.range il) + (ht : t ∈ Set.range ir) (hst : s = t) : s = a ∨ s = b := hcommon_index n a b hab hnext + hprev s t hs ht hst + have hpoint_chord (x : Real × Real) (s : Fin N) + (hxs : x = p.vertex s) (hs : s = a ∨ s = b) : + x ∈ segment Real (p.vertex a) (p.vertex b) := hpoint_chord n p a b x s hxs hs + change (P3544T1BoundaryCarrier leftPoly ∩ P3544T1BoundaryCarrier rightPoly = + segment Real (p.vertex a) (p.vertex b)) + ext x + constructor + · rintro ⟨hxL, hxR⟩ + obtain ⟨i, hxi⟩ := (hleft_mem x).mp hxL + obtain ⟨j, hxj⟩ := (hright_mem x).mp hxR + by_cases hi : i.val = k + · have hiK : i = ik := Fin.ext hi + subst i + rw [hleft_last_edge] at hxi + exact hxi + · have hilt : i.val < k := by + have hb : i.val < k + 1 := by calc i.val < leftN + 3 := i.isLt + _ = k + 1 := hleftLen + omega + by_cases hj : j.val = N - k + · have hjK : j = lastR := Fin.ext hj + subst j + rw [hright_last_edge] at hxj + exact hxj + · have hjlt : j.val < N - k := by + have hb : j.val < N - k + 1 := by calc j.val < rightN + 3 := j.isLt + _ = N - k + 1 := hrightLen + omega + have hxi' := hxi + have hxj' := hxj + rw [hleft_nonlast i hilt] at hxi' + rw [hright_nonlast j hjlt] at hxj' + have hqne : il i ≠ ir j := by + intro hq + have hm : il i ∈ Set.range il ∩ Set.range ir := by + exact ⟨⟨i, rfl⟩, ⟨j, hq.symm⟩⟩ + have habmem : il i ∈ ({a, b} : Set (Fin N)) := by + rw [← hcommon] + exact hm + have habidx : il i = a ∨ il i = b := by + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using habmem + rcases habidx with hia | hib + · have hi0 : i = 0 := hleft_inj (hia.trans hAil.symm) + have hjlast : j = lastR := hright_inj (by + calc + ir j = il i := hq.symm + _ = a := hia + _ = ir lastR := hAir.symm) + have : j.val = N - k := congrArg Fin.val hjlast + omega + · have hik' : i = ik := hleft_inj (hib.trans hBil.symm) + have : i.val = k := congrArg Fin.val hik' + omega + have hp := p.edge_intersection (il i) (ir j) hqne + have hboth : x ∈ segment Real (p.vertex (il i)) (p.vertex (il i + 1)) ∩ + segment Real (p.vertex (ir j)) (p.vertex (ir j + 1)) := ⟨hxi', hxj'⟩ + rw [hp] at hboth + rcases hboth with ⟨hleftEnd, hrightEnd⟩ + rcases hleftEnd with hL | hL + · rcases hrightEnd with hR | hR + · have hst : il i = ir j := p.injective (hL.symm.trans hR) + have habidx := hcommon_index (il i) (ir j) ⟨i, rfl⟩ ⟨j, rfl⟩ hst + exact hpoint_chord x (il i) hL habidx + · have hR' : x = p.vertex (ir (j + 1)) := by + simpa only [← hright_succ j hjlt] using hR + have hst : il i = ir (j + 1) := p.injective (hL.symm.trans hR') + have hri : ir (j + 1) ∈ Set.range ir := ⟨j + 1, rfl⟩ + have habidx := hcommon_index (il i) (ir (j + 1)) ⟨i, rfl⟩ hri hst + exact hpoint_chord x (il i) hL habidx + · rcases hrightEnd with hR | hR + · have hL' : x = p.vertex (il (i + 1)) := by + simpa only [← hleft_succ i hilt] using hL + have hst : il (i + 1) = ir j := p.injective (hL'.symm.trans hR) + have hli : il (i + 1) ∈ Set.range il := ⟨i + 1, rfl⟩ + have habidx := hcommon_index (il (i + 1)) (ir j) hli ⟨j, rfl⟩ hst + exact hpoint_chord x (il (i + 1)) hL' habidx + · have hL' : x = p.vertex (il (i + 1)) := by + simpa only [← hleft_succ i hilt] using hL + have hR' : x = p.vertex (ir (j + 1)) := by + simpa only [← hright_succ j hjlt] using hR + have hst : il (i + 1) = ir (j + 1) := p.injective (hL'.symm.trans hR') + have hli : il (i + 1) ∈ Set.range il := ⟨i + 1, rfl⟩ + have hri : ir (j + 1) ∈ Set.range ir := ⟨j + 1, rfl⟩ + have habidx := hcommon_index (il (i + 1)) (ir (j + 1)) hli hri hst + exact hpoint_chord x (il (i + 1)) hL' habidx + · intro hx + have hxiL : x ∈ segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) := by + rw [hleft_last_edge] + exact hx + have hxiR : x ∈ segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) := by + rw [hright_last_edge] + exact hx + exact ⟨(hleft_mem x).mpr ⟨ik, hxiL⟩, + (hright_mem x).mpr ⟨lastR, hxiR⟩⟩ + +end CyclicChildrenConstruction + +theorem P3650T1CyclicChildrenExists {n : Nat} (p : P3381T1PolygonBoundary n) + (a b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) + (hprev : a ≠ b + 1) + (hclear : Disjoint (openSegment Real (p.vertex a) (p.vertex b)) + (P3544T1BoundaryCarrier p)) : + Nonempty (P3650T1CyclicChildren p a b) := by + classical + have hk_bounds := CyclicChildrenConstruction.hk_bounds n a b hab hnext hprev + refine ⟨{ + left_n := (CyclicChildrenConstruction.leftN n a b) + right_n := (CyclicChildrenConstruction.rightN n a b) + left_lt := (CyclicChildrenConstruction.hleftLt n a b hab hnext hprev) + right_lt := (CyclicChildrenConstruction.hrightLt n a b hab hnext hprev) + left := (CyclicChildrenConstruction.leftPoly n p a b hab hnext hprev hclear) + right := (CyclicChildrenConstruction.rightPoly n p a b hab hnext hprev hclear) + il := (CyclicChildrenConstruction.il n a b hab hnext hprev) + ir := (CyclicChildrenConstruction.ir n a b hab hnext hprev) + il_injective := (CyclicChildrenConstruction.hleft_inj n a b hab hnext hprev) + ir_injective := (CyclicChildrenConstruction.hright_inj n a b hab hnext hprev) + left_vertex := rfl + right_vertex := rfl + u := (CyclicChildrenConstruction.u n a b) + v := (CyclicChildrenConstruction.v n a b) + hu := by rw [(CyclicChildrenConstruction.hlu n a b hprev)]; omega + hv := by rw [(CyclicChildrenConstruction.hlv n a b hprev)]; omega + rotation := a.val + parent_order := (CyclicChildrenConstruction.hparent_order n a b hab hnext hprev) + left_order := (CyclicChildrenConstruction.hleft_order n a b hab hnext hprev) + right_order := (CyclicChildrenConstruction.hright_order n a b hab hnext hprev) + common_indices := (CyclicChildrenConstruction.hcommon n a b hab hnext hprev) + carrier_union := (CyclicChildrenConstruction.hcarrier_union n p a b hab hnext hprev hclear) + carrier_intersection := (CyclicChildrenConstruction.hcarrier_intersection n p a b hab hnext + hprev hclear) + }⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean b/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean new file mode 100644 index 0000000000..f34204ab21 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean @@ -0,0 +1,2156 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.LinearAlgebra.AffineSpace.FiniteDimensional + +public import LeanPool.ApollonianSuperharmonic.P3650T1VisibleDiagonal +public import Mathlib.Analysis.Normed.Affine.AddTorsorBases +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Analysis.Convex.Topology +public import Mathlib.Topology.Order.IntermediateValue +public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity + +-- [TABLET NODE: P3650T1EmptyTriangleDiagonal] + +/-! +# P3650T1EmptyTriangleDiagonal + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TriangleDiagonalGeometry + +private theorem hdet : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + (b.1 - a.1) * (c.2 - a.2) - (c.1 - a.1) * (b.2 - a.2) ≠ 0 ) := by + classical + intro n p E a b c + simpa [P3381T1TriangleDeterminant, a, b, c] using E.nondegenerate + +private theorem hind : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ((b.1 - a.1) * (c.2 - a.2) - (c.1 - a.1) * (b.2 - a.2) ≠ 0) → (AffineIndependent Real v) + ) := by + classical + intro n p E a b c v hdet + apply (affineIndependent_iff_of_fintype Real v).mpr + intro z hz hsum i + rw [Finset.weightedVSub_eq_linear_combination Finset.univ hz] at hsum + have hz' : z 0 + z 1 + z 2 = 0 := by + simpa [Fin.sum_univ_succ, ← add_assoc] using hz + have hx : z 0 * a.1 + z 1 * b.1 + z 2 * c.1 = 0 := by + simpa [Fin.sum_univ_succ, v, ← add_assoc] using congrArg Prod.fst hsum + have hy : z 0 * a.2 + z 1 * b.2 + z 2 * c.2 = 0 := by + simpa [Fin.sum_univ_succ, v, ← add_assoc] using congrArg Prod.snd hsum + have hx' : z 1 * (b.1 - a.1) + z 2 * (c.1 - a.1) = 0 := by + linear_combination hx - a.1 * hz' + have hy' : z 1 * (b.2 - a.2) + z 2 * (c.2 - a.2) = 0 := by + linear_combination hy - a.2 * hz' + have hz1 : z 1 = 0 := by + have hz1mul : z 1 * ((b.1 - a.1) * (c.2 - a.2) - + (c.1 - a.1) * (b.2 - a.2)) = 0 := by + linear_combination (c.2 - a.2) * hx' - (c.1 - a.1) * hy' + exact (mul_eq_zero.mp hz1mul).resolve_right hdet + have hz2 : z 2 = 0 := by + have hz2mul : z 2 * ((b.1 - a.1) * (c.2 - a.2) - + (c.1 - a.1) * (b.2 - a.2)) = 0 := by + linear_combination (b.1 - a.1) * hy' - (b.2 - a.2) * hx' + exact (mul_eq_zero.mp hz2mul).resolve_right hdet + fin_cases i <;> simp_all + +private theorem hspan : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + (AffineIndependent Real v) → (affineSpan Real (Set.range v) = ⊤) ) := by + classical + intro n p E a b c v hind + apply hind.affineSpan_eq_top_iff_card_eq_finrank_add_one.mpr + simp [Module.finrank_prod] + +private theorem hheight : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + E.height = A.coord 1 ) := by + classical + intro n p E a b c v hind hspan A + apply AffineMap.ext_on A.tot + rintro x ⟨i, rfl⟩ + fin_cases i <;> simp only [AffineBasis.coord_apply] + · exact E.height_prev + · exact E.height_top + · exact E.height_next + +private theorem hrangeAt179 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + Set.range A = ({a, b, c} : Set (Real × Real)) ) := by + classical + intro n p E a b c v hind hspan A + rw [show (A : Fin 3 → Real × Real) = ![a, b, c] from funext (by + intro i + fin_cases i <;> rfl)] + ext x + simp; tauto + +private theorem hmemAt186 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + (Set.range A = ({a, b, c} : Set (Real × Real))) → (∀ x, x ∈ T ↔ ∀ i, 0 ≤ A.coord i x) ) + := by + classical + intro n p E a b c v hind hspan A T hrange x + exact Set.ext_iff.mp (by simpa [T, hrange] using A.convexHull_eq_nonneg_coord) x + +private theorem hint : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + (Set.range A = ({a, b, c} : Set (Real × Real))) → (∀ x, x ∈ interior T ↔ ∀ i, 0 < A.coord + i x) ) := by + classical + intro n p E a b c v hind hspan A T hrange x + exact Set.ext_iff.mp (by simpa [T, hrange] using A.interior_convexHull) x + +private theorem hbase : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + (convexHull Real ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : Set (Real × + Real))) = T ) := by + classical + intro n p E a b c T + rfl + +private theorem hvertexSide : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + + (3 : ℕ))), p.vertex j ∈ segment ℝ (p.vertex i) (p.vertex (i + (1 : Fin (n + (3 : + ℕ))))) ↔ j = i ∨ j = i + (1 : Fin (n + (3 : ℕ))) ) := by + classical + intro n p i j + constructor + · intro hj + by_cases hji : j = i + · exact Or.inl hji + · have hmem : p.vertex j ∈ + segment Real (p.vertex i) (p.vertex (i + 1)) ∩ + segment Real (p.vertex j) (p.vertex (j + 1)) := + ⟨hj, left_mem_segment Real _ _⟩ + rw [p.edge_intersection i j (Ne.symm hji)] at hmem + rcases hmem.1 with hl | hr + · exact Or.inl (p.injective hl) + · exact Or.inr (p.injective hr) + · rintro (rfl | rfl) + · exact left_mem_segment Real _ _ + · exact right_mem_segment Real _ _ + +private theorem hleftFace : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + ∀ x ∈ T, x ∈ segment ℝ a b → (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ) := by + classical + intro n p E a b c v hind hspan A T x hx hxs + have h2a : A.coord 2 a = 0 := by + change A.coord 2 (A 0) = 0 + exact A.coord_apply_ne (by decide) + have h2b : A.coord 2 b = 0 := by + change A.coord 2 (A 1) = 0 + exact A.coord_apply_ne (by decide) + rw [segment_eq_image_lineMap] at hxs + obtain ⟨t, ht, rfl⟩ := hxs + rw [(A.coord 2).apply_lineMap] + simp only [AffineMap.lineMap_apply_ring, + ] + rw [h2a, h2b] + ring + +private theorem hrightFace : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + ∀ x ∈ T, x ∈ segment ℝ b c → (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ) := by + classical + intro n p E a b c v hind hspan A T x hx hxs + have h0b : A.coord 0 b = 0 := by + change A.coord 0 (A 1) = 0 + exact A.coord_apply_ne (by decide) + have h0c : A.coord 0 c = 0 := by + change A.coord 0 (A 2) = 0 + exact A.coord_apply_ne (by decide) + rw [segment_eq_image_lineMap] at hxs + obtain ⟨t, ht, rfl⟩ := hxs + rw [(A.coord 0).apply_lineMap] + simp only [AffineMap.lineMap_apply_ring, + ] + rw [h0b, h0c] + ring + +private theorem hcoordLine : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (i : Fin (3 : ℕ)), ∀ (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), ∀ (s : ℝ), (A.coord i : ℝ × ℝ → ℝ) + ((AffineMap.lineMap x y : ℝ → ℝ × ℝ) s) = ((1 : ℝ) - s) * (A.coord i : ℝ × ℝ → ℝ) x + + s * (A.coord i : ℝ × ℝ → ℝ) y ) := by + classical + intro n p E a b c v hind hspan A i x y s + rw [(A.coord i).apply_lineMap, AffineMap.lineMap_apply_ring] + +private theorem hacOuter : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + ((b.1 - a.1) * (c.2 - a.2) - (c.1 - a.1) * (b.2 - a.2) ≠ 0) → (a ≠ c) ) := by + classical + intro n p E a b c hdet heq + have hzeroDet : (b.1 - a.1) * (c.2 - a.2) - + (c.1 - a.1) * (b.2 - a.2) = 0 := by rw [heq]; ring + exact hdet hzeroDet + +private theorem habdist : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let c := p.vertex (E.b + 1) + (a ≠ c) → (E.b - 1 ≠ E.b + 1) ) := by + classical + intro n p E a c hacOuter heq + have hv : p.vertex (E.b - 1) = p.vertex (E.b + 1) := congrArg p.vertex heq + exact hacOuter hv + +private theorem hbcOuter : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + p.vertex E.b ≠ p.vertex (E.b + 1) ) := by + classical + intro n p E heq + have hh := congrArg E.height heq + rw [E.height_top, E.height_next] at hh + norm_num at hh + +private theorem habNext : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), E.b + + 1 ≠ (E.b - 1) + 1 ) := by + classical + intro n p E heq + have hv := congrArg p.vertex heq + have hidx : (E.b - 1) + 1 = E.b := sub_add_cancel _ _ + rw [hidx] at hv + have hh := congrArg E.height hv + rw [E.height_next, E.height_top] at hh + norm_num at hh + +private theorem hcaNext : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ((0 : ℕ) < n) → (∀ (E : + P3650T1ExposedCorner p), E.b - 1 ≠ (E.b + 1) + 1) ) := by + classical + intro n p hn E heq + have hneg' := congrArg (fun k : Fin (n + 3) => k - E.b) heq + have hneg : (-1 : Fin (n + 3)) = 1 + 1 := by + calc + -1 = (E.b - 1) - E.b := by abel + _ = (E.b + 1 + 1) - E.b := hneg' + _ = 1 + 1 := by abel + have hval1 : (1 : Fin (n + 3)).val = 1 := by + simp [Nat.mod_eq_of_lt (by omega : 1 < n + 3)] + have hval2 : (2 : Fin (n + 3)).val = 2 := by + simp [Nat.mod_eq_of_lt (by omega : 2 < n + 3)] + have htwo : (2 : Fin (n + 3)) = 1 + 1 := by + apply Fin.ext + have hlt : (1 : Fin (n + 3)).val + (1 : Fin (n + 3)).val < n + 3 := by + rw [hval1] + omega + rw [Fin.val_add_eq_of_add_lt hlt, hval1, hval2] + have hthree : (3 : Fin (n + 3)) = 0 := by + calc + (3 : Fin (n + 3)) = (2 : Fin (n + 3)) + 1 := by + apply Fin.ext + have hlt : (2 : Fin (n + 3)).val + (1 : Fin (n + 3)).val < n + 3 := by + rw [hval2, hval1] + omega + rw [Fin.val_add_eq_of_add_lt hlt, hval2, hval1] + norm_num [Nat.mod_eq_of_lt (by omega : 3 < n + 3), + Nat.mod_eq_of_lt (by omega : 2 < n + 3)] + _ = (1 + 1 : Fin (n + 3)) + 1 := by rw [htwo] + _ = (-1 : Fin (n + 3)) + 1 := by rw [← hneg] + _ = 0 := by simp + have hv := congrArg Fin.val hthree + have hval : (3 : Fin (n + 3)).val = 3 := by + simp [Nat.mod_eq_of_lt (by omega : 3 < n + 3)] + rw [hval] at hv + norm_num at hv + +private theorem hintAvoid : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), (∀ (j + : Fin (n + (3 : ℕ))), ∀ (w : ℝ × ℝ), j ≠ E.b - (1 : Fin (n + (3 : ℕ))) → j ≠ E.b → w + ∈ interior ((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))}) → w ∈ segment ℝ (p.vertex j) (p.vertex (j + + (1 : Fin (n + (3 : ℕ))))) → ∃ (k : Fin (n + (3 : ℕ))), (k = j ∨ k = j + (1 : Fin (n + + (3 : ℕ)))) ∧ p.vertex k ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))} ∧ (E.height : ℝ × ℝ → ℝ) w ≤ (E.height : ℝ + × ℝ → ℝ) (p.vertex k)) → ((∀ (i : Fin (n + (3 : ℕ))), p.vertex i ∈ (convexHull ℝ : + Set (ℝ × ℝ) → Set (ℝ × ℝ)) {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))} → i = E.b - (1 : Fin (n + (3 : ℕ))) ∨ i = + E.b ∨ i = E.b + (1 : Fin (n + (3 : ℕ)))) → ( + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + (∀ x, x ∈ interior T ↔ ∀ i, 0 < A.coord i x) → ((∀ (x : Real × Real), E.height x = + A.coord 1 x) → ((∀ (x : Real × Real), (x ∈ T) → ((x ∈ segment Real a b) → (A.coord 2 + x = 0))) → ((∀ (x : Real × Real), (x ∈ T) → ((x ∈ segment Real b c) → (A.coord 0 x = + 0))) → (interior T ∩ P3544T1BoundaryCarrier p = ∅)))))) ) := by + classical + intro n p E hentry hempty a b c v hind hspan A T hint hheightcoord hleftFace hrightFace + ext x + simp only [Set.mem_inter_iff, Set.mem_empty_iff_false, iff_false] + rintro ⟨hxi, hxC⟩ + obtain ⟨j, hj⟩ := Set.mem_iUnion.mp hxC + by_cases hja : j = E.b - 1 + · subst j + have hxface := hleftFace x (interior_subset hxi) (by simpa [a, b] using hj) + have := (hint x).mp hxi 2 + linarith + by_cases hjb : j = E.b + · subst j + have hxface := hrightFace x (interior_subset hxi) (by simpa [b, c] using hj) + have := (hint x).mp hxi 0 + linarith + obtain ⟨k, hkor, hkT, hle⟩ := hentry j x hja hjb hxi hj + have hkheight : 0 < E.height (p.vertex k) := by + have : 0 < E.height x := by + rw [hheightcoord] + exact (hint x).mp hxi 1 + exact lt_of_lt_of_le this hle + obtain hka | hkb | hkc := hempty k hkT + · rw [hka, E.height_prev] at hkheight + norm_num at hkheight + · have hkB : k = E.b := hkb + rcases hkor with hkj | hkj + · have hjB : j = E.b := hkj.symm.trans hkB + exact hjb hjB + · have hjplus : j + 1 = E.b := hkj.symm.trans hkB + have hjprev : j = E.b - 1 := by + apply Fin.ext + by_cases hb0 : E.b.val = 0 + · have hbeq : E.b = 0 := Fin.ext hb0 + rw [hbeq] at hjplus ⊢ + have hjlast : j = Fin.last (n + 2) := by + apply Fin.ext + have hjv := congrArg Fin.val hjplus + by_cases hjlt : j.val + 1 < n + 3 + · have hadd : (j + 1).val = j.val + 1 := + Fin.val_add_eq_of_add_lt (by simpa using hjlt) + rw [hadd] at hjv + simp at hjv + · have hjval' : j.val + 1 = n + 3 := by omega + simp [Fin.val_last] + omega + rw [hjlast] + simp [] + · have hbne : E.b ≠ 0 := fun h => hb0 (congrArg Fin.val h) + have hjval := congrArg Fin.val hjplus + have hsub := Fin.val_sub_one_of_ne_zero hbne + by_cases hjwrap : j.val + 1 = n + 3 + · have hjadd : (j + 1).val = 0 := by + rw [Fin.val_add_eq_ite] + simp [hjwrap] + rw [hjadd] at hjval + omega + · have hjlt : j.val + 1 < n + 3 := by omega + have hjadd : (j + 1).val = j.val + 1 := + Fin.val_add_eq_of_add_lt (by simpa using hjlt) + rw [hjadd] at hjval + rw [hsub] + omega + exact hja hjprev + · rw [hkc, E.height_next] at hkheight + norm_num at hkheight + +private theorem hcoordA : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + A.coord 0 a = 1 ∧ A.coord 1 a = 0 ∧ A.coord 2 a = 0 ) := by + classical + intro n p E a b c v hind hspan A + constructor + · change A.coord 0 (A 0) = 1 + exact A.coord_apply_eq 0 + constructor + · change A.coord 1 (A 0) = 0 + exact A.coord_apply_ne (by decide) + · change A.coord 2 (A 0) = 0 + exact A.coord_apply_ne (by decide) + +private theorem hcoordB : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + A.coord 0 b = 0 ∧ A.coord 1 b = 1 ∧ A.coord 2 b = 0 ) := by + classical + intro n p E a b c v hind hspan A + constructor + · change A.coord 0 (A 1) = 0 + exact A.coord_apply_ne (by decide) + constructor + · change A.coord 1 (A 1) = 1 + exact A.coord_apply_eq 1 + · change A.coord 2 (A 1) = 0 + exact A.coord_apply_ne (by decide) + +private theorem hcoordC : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + A.coord 0 c = 0 ∧ A.coord 1 c = 0 ∧ A.coord 2 c = 1 ) := by + classical + intro n p E a b c v hind hspan A + constructor + · change A.coord 0 (A 2) = 0 + exact A.coord_apply_ne (by decide) + constructor + · change A.coord 1 (A 2) = 0 + exact A.coord_apply_ne (by decide) + · change A.coord 2 (A 2) = 1 + exact A.coord_apply_eq 2 + +private theorem hopenBaseCoords : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + (A.coord 0 a = 1 ∧ A.coord 1 a = 0 ∧ A.coord 2 a = 0) → ((A.coord 0 c = 0 ∧ A.coord 1 c = + 0 ∧ A.coord 2 c = 1) → (∀ x, x ∈ openSegment Real a c → 0 < A.coord 0 x ∧ A.coord 1 x + = 0 ∧ 0 < A.coord 2 x)) ) := by + classical + intro n p E a b c v hind hspan A hcoordA hcoordC x hx + rw [openSegment_eq_image_lineMap] at hx + obtain ⟨t, ht, rfl⟩ := hx + have h0 : A.coord 0 (AffineMap.lineMap a c t) = 1 - t := by + rw [(A.coord 0).apply_lineMap] + rw [AffineMap.lineMap_apply_ring, hcoordA.1, hcoordC.1] + ring + have h1 : A.coord 1 (AffineMap.lineMap a c t) = 0 := by + rw [(A.coord 1).apply_lineMap] + rw [AffineMap.lineMap_apply_ring, hcoordA.2.1, hcoordC.2.1] + ring + have h2 : A.coord 2 (AffineMap.lineMap a c t) = t := by + rw [(A.coord 2).apply_lineMap] + rw [AffineMap.lineMap_apply_ring, hcoordA.2.2, hcoordC.2.2] + ring + rw [h0, h1, h2] + exact ⟨sub_pos.mpr ht.2, rfl, ht.1⟩ + +private theorem hline : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + (∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (s : Real), A.coord i + (AffineMap.lineMap x y s) = (1 - s) * A.coord i x + s * A.coord i y) → (∀ (j : Fin (n + + (3 : ℕ))), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + ∀ (i : Fin (3 : ℕ)), ∀ (s : ℝ), (A.coord i : ℝ × ℝ → ℝ) (q s) = ((1 : ℝ) - s) * (A.coord + i : ℝ × ℝ → ℝ) (p.vertex j) + s * (A.coord i : ℝ × ℝ → ℝ) (p.vertex (j + (1 : Fin (n + + (3 : ℕ)))))) ) := by + classical + intro n p E a b c v hind hspan A hcoordLine j q i s + exact hcoordLine i (p.vertex j) (p.vertex (j + 1)) s + +private theorem hnotLeft : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), (∀ (i + : Fin (n + (3 : ℕ))), p.vertex i ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))} → i = E.b - (1 : Fin (n + (3 : ℕ))) ∨ i = + E.b ∨ i = E.b + (1 : Fin (n + (3 : ℕ)))) → ( + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + (A.coord 0 a = 1 ∧ A.coord 1 a = 0 ∧ A.coord 2 a = 0) → ((A.coord 0 b = 0 ∧ A.coord 1 b = + 1 ∧ A.coord 2 b = 0) → ((A.coord 0 c = 0 ∧ A.coord 1 c = 0 ∧ A.coord 2 c = 1) → (∀ (x + : ℝ × ℝ), ∀ (j : Fin (n + (3 : ℕ))), ((0 : ℝ) < (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → + ℝ) x ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : ℝ) < (A.coord (2 : + Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x) → ((x ∈ T) → ((¬j = E.b - (1 : Fin (n + (3 : ℕ)))) → + ((¬j = E.b) → (∀ (t : ℝ), ((AffineMap.lineMap (p.vertex j) (p.vertex (j + (1 : Fin (n + + (3 : ℕ))))) : ℝ → ℝ × ℝ) t = x) → ( + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + (q t = x) → ((Continuous q) → ((∀ (i : Fin 3), Continuous (fun s => A.coord i (q s))) → + ((∀ (i : Fin 3), ∀ (s : Real), A.coord i (q s) = (1 - s) * A.coord i (p.vertex j) + s + * A.coord i (p.vertex (j + 1))) → (x ≠ p.vertex j))))))))))))) ) := by + classical + intro n p E hempty a b c v hind hspan A T hcoordA hcoordB hcoordC x j hxb hxT hja hjb t hqt q + hqtq hqcont hfc hline h + have hjT : p.vertex j ∈ T := by rw [← h]; exact hxT + obtain hja' | hjb' | hjc' := hempty j (by simpa [T, a, b, c] using hjT) + · subst j + have heq := congrArg (A.coord 2) h + rw [hcoordA.2.2] at heq + linarith [hxb.2.2] + · subst j + have heq := congrArg (A.coord 1) h + rw [hcoordB.2.1] at heq + linarith [hxb.2.1] + · subst j + have heq := congrArg (A.coord 0) h + rw [hcoordC.1] at heq + linarith [hxb.1] + +private theorem hnotRight : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), (∀ (i + : Fin (n + (3 : ℕ))), p.vertex i ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))} → i = E.b - (1 : Fin (n + (3 : ℕ))) ∨ i = + E.b ∨ i = E.b + (1 : Fin (n + (3 : ℕ)))) → ( + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + (A.coord 0 a = 1 ∧ A.coord 1 a = 0 ∧ A.coord 2 a = 0) → ((A.coord 0 b = 0 ∧ A.coord 1 b = + 1 ∧ A.coord 2 b = 0) → ((A.coord 0 c = 0 ∧ A.coord 1 c = 0 ∧ A.coord 2 c = 1) → (∀ (x + : ℝ × ℝ), ∀ (j : Fin (n + (3 : ℕ))), ((0 : ℝ) < (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → + ℝ) x ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : ℝ) < (A.coord (2 : + Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x) → ((x ∈ T) → (x ≠ p.vertex (j + 1))))))) ) := by + classical + intro n p E hempty a b c v hind hspan A T hcoordA hcoordB hcoordC x j hxb hxT h + have hjT : p.vertex (j + 1) ∈ T := by rw [← h]; exact hxT + obtain hja' | hjb' | hjc' := hempty (j + 1) (by simpa [T, a, b, c] using hjT) + · rw [hja'] at h + have heq := congrArg (A.coord 2) h + rw [hcoordA.2.2] at heq + linarith [hxb.2.2] + · rw [hjb'] at h + have heq := congrArg (A.coord 1) h + rw [hcoordB.2.1] at heq + linarith [hxb.2.1] + · rw [hjc'] at h + have heq := congrArg (A.coord 0) h + rw [hcoordC.1] at heq + linarith [hxb.1] + +private theorem ht' : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (x : ℝ × ℝ), ∀ (j : Fin (n + (3 : + ℕ))), ∀ (t : ℝ), (t ∈ Set.Icc (0 : ℝ) (1 : ℝ)) → ( + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + (q t = x) → ((x ≠ p.vertex j) → ((x ≠ p.vertex (j + 1)) → (t ∈ Set.Ioo (0 : Real) 1)))) ) + := by + classical + intro n p x j t ht q hqtq hnotLeft hnotRight + constructor + · by_contra hnot + have : t = 0 := le_antisymm (not_lt.mp hnot) ht.1 + have hq0 : q 0 = p.vertex j := by simp [q] + exact hnotLeft (hqtq.symm.trans (by rw [this]; exact hq0)) + · by_contra hnot + have : t = 1 := le_antisymm ht.2 (not_lt.mp hnot) + have hq1 : q 1 = p.vertex (j + 1) := by simp [q] + exact hnotRight (hqtq.symm.trans (by rw [this]; exact hq1)) + +private theorem hzero : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (x : ℝ × ℝ), ∀ (j : Fin (n + (3 : ℕ))), ((0 : ℝ) < (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → + ℝ) x ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : ℝ) < (A.coord (2 : + Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x) → (∀ (t : ℝ), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + (q t = x) → ((∀ (i : Fin 3), ∀ (s : Real), A.coord i (q s) = (1 - s) * A.coord i + (p.vertex j) + s * A.coord i (p.vertex (j + 1))) → ((1 - t) * A.coord 1 (p.vertex j) + + t * A.coord 1 (p.vertex (j + 1)) = 0))) ) := by + classical + intro n p E a b c v hind hspan A x j hxb t q hqtq hline + calc + _ = A.coord 1 (q t) := (hline 1 t).symm + _ = A.coord 1 x := congrArg (A.coord 1) hqtq + _ = 0 := hxb.2.1 + +private theorem hqt0At504 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (x : ℝ × ℝ), ∀ (j : Fin (n + (3 : ℕ))), ((0 : ℝ) < (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → + ℝ) x ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : ℝ) < (A.coord (2 : + Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x) → (∀ (t : ℝ), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + (q t = x) → (0 < A.coord 0 (q t))) ) := by + classical + intro n p E a b c v hind hspan A x j hxb t q hqtq + calc + _ = A.coord 0 x := congrArg _ hqtq + _ > 0 := hxb.1 + +private theorem hqt2At507 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (x : ℝ × ℝ), ∀ (j : Fin (n + (3 : ℕ))), ((0 : ℝ) < (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → + ℝ) x ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : ℝ) < (A.coord (2 : + Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x) → (∀ (t : ℝ), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + (q t = x) → (0 < A.coord 2 (q t))) ) := by + classical + intro n p E a b c v hind hspan A x j hxb t q hqtq + calc + _ = A.coord 2 x := congrArg _ hqtq + _ > 0 := hxb.2.2 + +private theorem hq1At528 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (v : Fin 3 → Real × Real), ∀ (hind : + AffineIndependent + Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (j : Fin (n + (3 : ℕ))), ∀ (t : ℝ), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + (∀ (i : Fin 3), ∀ (s : Real), A.coord i (q s) = (1 - s) * A.coord i (p.vertex j) + s * + A.coord i (p.vertex (j + 1))) → ((t ∈ Set.Ioo (0 : Real) 1) → (((1 - t) * A.coord 1 + (p.vertex j) + t * A.coord 1 (p.vertex (j + 1)) = 0) → (((0 : ℝ) < (A.coord (1 : Fin + (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex j)) → (∀ (s : ℝ), (s < t) → (0 < A.coord 1 (q s)))))) + ) := by + classical + intro n p v hind hspan A j t q hline ht' hzero hposj s hst + have hlineS := hline 1 s + have : A.coord 1 (q s) = + ((t - s) / t) * A.coord 1 (p.vertex j) := by + rw [hlineS] + have htne : t ≠ 0 := ne_of_gt ht'.1 + have hβ : A.coord 1 (p.vertex (j + 1)) = + -((1 - t) / t) * A.coord 1 (p.vertex j) := by + field_simp [htne] + nlinarith [hzero] + rw [hβ] + field_simp [htne] + ring + rw [this] + exact mul_pos (div_pos (sub_pos.mpr hst) ht'.1) hposj + +private theorem hqsegAt546 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (j : Fin (n + (3 : ℕ))), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + ∀ (s : ℝ), (s ∈ Set.Ioo (0 : Real) 1) → (q s ∈ segment Real (p.vertex j) (p.vertex (j + + 1))) ) := by + classical + intro n p j q s hs01 + rw [segment_eq_image_lineMap] + exact ⟨s, ⟨le_of_lt hs01.1, le_of_lt hs01.2⟩, rfl⟩ + +private theorem hfalseAt549 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + (interior T ∩ P3544T1BoundaryCarrier p = ∅) → (∀ (j : Fin (n + (3 : ℕ))), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + ∀ (s : ℝ), (q s ∈ interior T) → ((q s ∈ segment Real (p.vertex j) (p.vertex (j + 1))) → + (q s ∈ (∅ : Set (Real × Real))))) ) := by + classical + intro n p E a b c T hintAvoid j q s hqint hqseg + rw [← hintAvoid] + exact ⟨hqint, Set.mem_iUnion.mpr ⟨j, hqseg⟩⟩ + +private theorem hqt0At555 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (x : ℝ × ℝ), ∀ (j : Fin (n + (3 : ℕ))), ((0 : ℝ) < (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → + ℝ) x ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : ℝ) < (A.coord (2 : + Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x) → (∀ (t : ℝ), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + (q t = x) → (0 < A.coord 0 (q t))) ) := by + classical + intro n p E a b c v hind hspan A x j hxb t q hqtq + calc + _ = A.coord 0 x := congrArg _ hqtq + _ > 0 := hxb.1 + +private theorem hqt2At558 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (x : ℝ × ℝ), ∀ (j : Fin (n + (3 : ℕ))), ((0 : ℝ) < (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → + ℝ) x ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : ℝ) < (A.coord (2 : + Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x) → (∀ (t : ℝ), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + (q t = x) → (0 < A.coord 2 (q t))) ) := by + classical + intro n p E a b c v hind hspan A x j hxb t q hqtq + calc + _ = A.coord 2 x := congrArg _ hqtq + _ > 0 := hxb.2.2 + +private theorem hq1At579 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (v : Fin 3 → Real × Real), ∀ (hind : + AffineIndependent + Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (j : Fin (n + (3 : ℕ))), ∀ (t : ℝ), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + (∀ (i : Fin 3), ∀ (s : Real), A.coord i (q s) = (1 - s) * A.coord i (p.vertex j) + s * + A.coord i (p.vertex (j + 1))) → ((t ∈ Set.Ioo (0 : Real) 1) → (((1 - t) * A.coord 1 + (p.vertex j) + t * A.coord 1 (p.vertex (j + 1)) = 0) → (((0 : ℝ) < (A.coord (1 : Fin + (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (j + (1 : Fin (n + (3 : ℕ)))))) → (∀ (s : ℝ), (t < s) + → (0 < A.coord 1 (q s)))))) ) := by + classical + intro n p v hind hspan A j t q hline ht' hzero hposnext s hts + have hlineS := hline 1 s + have : A.coord 1 (q s) = + ((s - t) / (1 - t)) * A.coord 1 (p.vertex (j + 1)) := by + rw [hlineS] + have htne : 1 - t ≠ 0 := ne_of_gt (sub_pos.mpr ht'.2) + have hα : A.coord 1 (p.vertex j) = + -(t / (1 - t)) * A.coord 1 (p.vertex (j + 1)) := by + field_simp [htne] + nlinarith [hzero] + rw [hα] + field_simp [htne] + ring + rw [this] + exact mul_pos (div_pos (sub_pos.mpr hts) (sub_pos.mpr ht'.2)) hposnext + +private theorem hqsegAt597 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (j : Fin (n + (3 : ℕ))), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + ∀ (s : ℝ), (s ∈ Set.Ioo (0 : Real) 1) → (q s ∈ segment Real (p.vertex j) (p.vertex (j + + 1))) ) := by + classical + intro n p j q s hs01 + rw [segment_eq_image_lineMap] + exact ⟨s, ⟨le_of_lt hs01.1, le_of_lt hs01.2⟩, rfl⟩ + +private theorem hfalseAt600 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + (interior T ∩ P3544T1BoundaryCarrier p = ∅) → (∀ (j : Fin (n + (3 : ℕ))), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + ∀ (s : ℝ), (q s ∈ interior T) → ((q s ∈ segment Real (p.vertex j) (p.vertex (j + 1))) → + (q s ∈ (∅ : Set (Real × Real))))) ) := by + classical + intro n p E a b c T hintAvoid j q s hqint hqseg + rw [← hintAvoid] + exact ⟨hqint, Set.mem_iUnion.mpr ⟨j, hqseg⟩⟩ + +private theorem hα0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (j : Fin (n + (3 : ℕ))), ∀ (t : ℝ), (t ∈ Set.Ioo (0 : Real) 1) → (((1 - t) * A.coord 1 + (p.vertex j) + t * A.coord 1 (p.vertex (j + 1)) = 0) → (((1 - t) * A.coord 1 + (p.vertex j) ≤ 0) → ((t * A.coord 1 (p.vertex (j + 1)) ≤ 0) → (A.coord 1 (p.vertex j) + = 0)))) ) := by + classical + intro n p E a b c v hind hspan A j t ht' hzero hleftTerm hrightTerm + have hmul : (1 - t) * A.coord 1 (p.vertex j) = 0 := by linarith [hzero, hrightTerm] + rcases mul_eq_zero.mp hmul with htone | hαzero + · exact (False.elim ((ne_of_gt (sub_pos.mpr ht'.2)) htone)) + · exact hαzero + +private theorem hβ0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (j : Fin (n + (3 : ℕ))), ∀ (t : ℝ), (t ∈ Set.Ioo (0 : Real) 1) → (((1 - t) * A.coord 1 + (p.vertex j) + t * A.coord 1 (p.vertex (j + 1)) = 0) → (((1 - t) * A.coord 1 + (p.vertex j) ≤ 0) → ((t * A.coord 1 (p.vertex (j + 1)) ≤ 0) → (A.coord 1 (p.vertex (j + + 1)) = 0)))) ) := by + classical + intro n p E a b c v hind hspan A j t ht' hzero hleftTerm hrightTerm + have hmul : t * A.coord 1 (p.vertex (j + 1)) = 0 := by linarith [hzero, hleftTerm] + rcases mul_eq_zero.mp hmul with htzero | hβzero + · exact (False.elim ((ne_of_gt ht'.1) htzero)) + · exact hβzero + +private theorem hline1 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (j : Fin (n + (3 : ℕ))), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + (∀ (i : Fin 3), ∀ (s : Real), A.coord i (q s) = (1 - s) * A.coord i (p.vertex j) + s * + A.coord i (p.vertex (j + 1))) → ((A.coord 1 (p.vertex j) = 0) → ((A.coord 1 (p.vertex + (j + 1)) = 0) → (∀ (s : ℝ), (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (q s) = (0 : + ℝ)))) ) := by + classical + intro n p E a b c v hind hspan A j q hline hα0 hβ0 s + rw [hline 1 s, hα0, hβ0] + ring + +private theorem hzt : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (x : ℝ × ℝ), ∀ (j : Fin (n + (3 : ℕ))), ∀ (t : ℝ), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + (q t = x) → ( + let z0 := A.coord 2 (p.vertex j) + let z1 := A.coord 2 (p.vertex (j + 1)) + (∀ (s : Real), A.coord 2 (q s) = (1 - s) * z0 + s * z1) → ((1 - t) * z0 + t * z1 = + A.coord 2 x)) ) := by + classical + intro n p E a b c v hind hspan A x j t q hqtq z0 z1 hline2 + calc + _ = A.coord 2 (q t) := (hline2 t).symm + _ = A.coord 2 x := congrArg (A.coord 2) hqtq + +private theorem hsum0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (j : Fin (n + (3 : ℕ))), A.coord 0 (p.vertex j) + A.coord 1 (p.vertex j) + A.coord 2 + (p.vertex j) = 1 ) := by + classical + intro n p E a b c v hind hspan A j + simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one (p.vertex j) + +private theorem hsum1 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (j : Fin (n + (3 : ℕ))), A.coord 0 (p.vertex (j + 1)) + A.coord 1 (p.vertex (j + 1)) + + A.coord 2 (p.vertex (j + 1)) = 1 ) := by + classical + intro n p E a b c v hind hspan A j + simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one (p.vertex (j + 1)) + +private theorem hcoord0j : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (j : Fin (n + (3 : ℕ))), (¬(0 : ℝ) < (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex + j)) → ((A.coord 1 (p.vertex j) = 0) → ( + let z0 := A.coord 2 (p.vertex j) + (A.coord 0 (p.vertex j) + A.coord 1 (p.vertex j) + A.coord 2 (p.vertex j) = 1) → (A.coord + 0 (p.vertex j) = 1 - z0))) ) := by + classical + intro n p E a b c v hind hspan A j hposj hα0 z0 hsum0 + have hh : A.coord 0 (p.vertex j) + z0 = 1 := by + dsimp [z0] at * + rw [hα0] at hsum0 + simpa only [add_zero] using hsum0 + linarith + +private theorem hcoord01 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (j : Fin (n + (3 : ℕ))), (¬(0 : ℝ) < (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex + (j + (1 : Fin (n + (3 : ℕ)))))) → ((A.coord 1 (p.vertex (j + 1)) = 0) → ( + let z1 := A.coord 2 (p.vertex (j + 1)) + (A.coord 0 (p.vertex (j + 1)) + A.coord 1 (p.vertex (j + 1)) + A.coord 2 (p.vertex (j + + 1)) = 1) → (A.coord 0 (p.vertex (j + 1)) = 1 - z1))) ) := by + classical + intro n p E a b c v hind hspan A j hposnext hβ0 z1 hsum1 + have hh : A.coord 0 (p.vertex (j + 1)) + z1 = 1 := by + dsimp [z1] at * + rw [hβ0] at hsum1 + simpa only [add_zero] using hsum1 + linarith + +private theorem hnotIoo0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), (∀ (i + : Fin (n + (3 : ℕ))), p.vertex i ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))} → i = E.b - (1 : Fin (n + (3 : ℕ))) ∨ i = + E.b ∨ i = E.b + (1 : Fin (n + (3 : ℕ)))) → ( + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + (∀ x, x ∈ T ↔ ∀ i, 0 ≤ A.coord i x) → ((A.coord 0 a = 1 ∧ A.coord 1 a = 0 ∧ A.coord 2 a = + 0) → ((A.coord 0 b = 0 ∧ A.coord 1 b = 1 ∧ A.coord 2 b = 0) → ((A.coord 0 c = 0 ∧ + A.coord 1 c = 0 ∧ A.coord 2 c = 1) → (∀ (j : Fin (n + (3 : ℕ))), (¬(0 : ℝ) < (A.coord + (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex j)) → ((A.coord 1 (p.vertex j) = 0) → ( + let z0 := A.coord 2 (p.vertex j) + (A.coord 0 (p.vertex j) = 1 - z0) → (z0 ∉ Set.Ioo (0 : Real) 1)))))))) ) := by + classical + intro n p E hempty a b c v hind hspan A T hmem hcoordA hcoordB hcoordC j hposj hα0 z0 hcoord0j hz + have hjT : p.vertex j ∈ T := (hmem _).mpr (by + intro i + fin_cases i + · change 0 ≤ A.coord 0 (p.vertex j) + rw [hcoord0j] + linarith [hz.2] + · change 0 ≤ A.coord 1 (p.vertex j) + rw [hα0] + · change 0 ≤ A.coord 2 (p.vertex j) + exact le_of_lt hz.1) + obtain hja' | hjb' | hjc' := hempty j (by simpa [T, a, b, c] using hjT) + · have hz' : z0 = 0 := by + simpa [z0, a, hcoordA.2.2] using congrArg (A.coord 2) (congrArg p.vertex hja') + exact (not_le_of_gt hz.1) (hz'.symm ▸ le_rfl) + · have : A.coord 1 (p.vertex j) = 1 := by simpa [hjb'] using hcoordB.2.1 + linarith [hα0] + · have hz' : z0 = 1 := by + simpa [z0, c, hcoordC.2.2] using congrArg (A.coord 2) (congrArg p.vertex hjc') + linarith [hz.2] + +private theorem hnotIoo1 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), (∀ (i + : Fin (n + (3 : ℕ))), p.vertex i ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))} → i = E.b - (1 : Fin (n + (3 : ℕ))) ∨ i = + E.b ∨ i = E.b + (1 : Fin (n + (3 : ℕ)))) → ( + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + (∀ x, x ∈ T ↔ ∀ i, 0 ≤ A.coord i x) → ((A.coord 0 a = 1 ∧ A.coord 1 a = 0 ∧ A.coord 2 a = + 0) → ((A.coord 0 b = 0 ∧ A.coord 1 b = 1 ∧ A.coord 2 b = 0) → ((A.coord 0 c = 0 ∧ + A.coord 1 c = 0 ∧ A.coord 2 c = 1) → (∀ (j : Fin (n + (3 : ℕ))), (¬(0 : ℝ) < (A.coord + (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (j + (1 : Fin (n + (3 : ℕ)))))) → ((A.coord + 1 (p.vertex (j + 1)) = 0) → ( + let z1 := A.coord 2 (p.vertex (j + 1)) + (A.coord 0 (p.vertex (j + 1)) = 1 - z1) → (z1 ∉ Set.Ioo (0 : Real) 1)))))))) ) := by + classical + intro n p E hempty a b c v hind hspan A T hmem hcoordA hcoordB hcoordC j hposnext hβ0 z1 + hcoord01 hz + have hjT : p.vertex (j + 1) ∈ T := (hmem _).mpr (by + intro i + fin_cases i + · change 0 ≤ A.coord 0 (p.vertex (j + 1)) + rw [hcoord01] + linarith [hz.2] + · change 0 ≤ A.coord 1 (p.vertex (j + 1)) + rw [hβ0] + · change 0 ≤ A.coord 2 (p.vertex (j + 1)) + exact le_of_lt hz.1) + obtain hja' | hjb' | hjc' := hempty (j + 1) (by simpa [T, a, b, c] using hjT) + · have hz' : z1 = 0 := by + simpa [z1, a, hcoordA.2.2] using + congrArg (A.coord 2) (congrArg p.vertex hja') + linarith [hz.1] + · have : A.coord 1 (p.vertex (j + 1)) = 1 := by simpa [hjb'] using hcoordB.2.1 + linarith [hβ0] + · have hz' : z1 = 1 := by + simpa [z1, c, hcoordC.2.2] using + congrArg (A.coord 2) (congrArg p.vertex hjc') + exact (not_le_of_gt hz.2) (hz'.symm ▸ le_rfl) + +private theorem hz0case : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (j : Fin (n + (3 : ℕ))), + let z0 := A.coord 2 (p.vertex j) + (z0 ∉ Set.Ioo (0 : Real) 1) → (z0 ≤ 0 ∨ 1 ≤ z0) ) := by + classical + intro n p E a b c v hind hspan A j z0 hnotIoo0 + by_contra h + push Not at h + exact hnotIoo0 ⟨h.1, h.2⟩ + +private theorem hz1case : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (j : Fin (n + (3 : ℕ))), + let z1 := A.coord 2 (p.vertex (j + 1)) + (z1 ∉ Set.Ioo (0 : Real) 1) → (z1 ≤ 0 ∨ 1 ≤ z1) ) := by + classical + intro n p E a b c v hind hspan A j z1 hnotIoo1 + by_contra h + push Not at h + exact hnotIoo1 ⟨h.1, h.2⟩ + +private theorem hzlt : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (x : ℝ × ℝ), ((0 : ℝ) < (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x ∧ (A.coord (1 : Fin + (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : ℝ) < (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) + x) → ((A.coord 0 x + A.coord 1 x + A.coord 2 x = 1) → (A.coord 2 x < 1)) ) := by + classical + intro n p E a b c v hind hspan A x hxb hxsum + rw [hxb.2.1] at hxsum + linarith [hxb.1] + +private theorem hstraddle : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (x : ℝ × ℝ), ∀ (j : Fin (n + (3 : ℕ))), ((0 : ℝ) < (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → + ℝ) x ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : ℝ) < (A.coord (2 : + Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x) → (∀ (t : ℝ), (t ∈ Set.Ioo (0 : Real) 1) → ( + let z0 := A.coord 2 (p.vertex j) + let z1 := A.coord 2 (p.vertex (j + 1)) + ((1 - t) * z0 + t * z1 = A.coord 2 x) → ((z0 ≤ 0 ∨ 1 ≤ z0) → ((z1 ≤ 0 ∨ 1 ≤ z1) → + ((A.coord 0 x + A.coord 1 x + A.coord 2 x = 1) → ((z0 ≤ 0 ∧ 1 ≤ z1) ∨ (z1 ≤ 0 ∧ 1 ≤ + z0))))))) ) := by + classical + intro n p E a b c v hind hspan A x j hxb t ht' z0 z1 hzt hz0case hz1case hxsum + rcases hz0case with h0 | h0 <;> rcases hz1case with h1 | h1 + · exfalso + have hleft : (1 - t) * z0 ≤ 0 := + mul_nonpos_of_nonneg_of_nonpos (sub_nonneg.mpr ht'.2.le) h0 + have hright : t * z1 ≤ 0 := mul_nonpos_of_nonneg_of_nonpos ht'.1.le h1 + linarith [hxb.2.2, hleft, hright] + · exact Or.inl ⟨h0, h1⟩ + · exact Or.inr ⟨h1, h0⟩ + · exfalso + have hleft : 1 - t ≤ (1 - t) * z0 := + by simpa only [mul_one] using mul_le_mul_of_nonneg_left h0 (sub_nonneg.mpr ht'.2.le) + have hright : t ≤ t * z1 := by + simpa only [mul_one] using mul_le_mul_of_nonneg_left h1 ht'.1.le + linarith [hzlt, hzt, hleft, hright] + +private theorem hzeroHit : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (j : Fin (n + (3 : ℕ))), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + (Set.Icc ((A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (q (0 : ℝ))) ((A.coord (2 : Fin (3 : + ℕ)) : ℝ × ℝ → ℝ) (q (1 : ℝ))) ⊆ (fun (s : ℝ) => (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → + ℝ) (q s)) '' Set.Icc (0 : ℝ) (1 : ℝ)) → (∀ (x : ℝ × ℝ), ((0 : ℝ) < (A.coord (0 : Fin + (3 : ℕ)) : ℝ × ℝ → ℝ) x ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : + ℝ) < (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x) → ((∀ (i : Fin 3), Continuous (fun s + => A.coord i (q s))) → ( + let z0 := A.coord 2 (p.vertex j) + let z1 := A.coord 2 (p.vertex (j + 1)) + (A.coord 0 x + A.coord 1 x + A.coord 2 x = 1) → (((z0 ≤ 0 ∧ 1 ≤ z1) ∨ (z1 ≤ 0 ∧ 1 ≤ z0)) + → ((A.coord 2 (q 0) = z0) → ((A.coord 2 (q 1) = z1) → (∃ s ∈ Set.Icc (0 : Real) 1, + A.coord 2 (q s) = 0))))))) ) := by + classical + intro n p E a b c v hind hspan A j q hrange x hxb hfc z0 z1 hxsum hstraddle hz0eq hz1eq + rcases hstraddle with ⟨h0, h1⟩ | ⟨h1, h0⟩ + · have hmemRange : 0 ∈ Set.Icc z0 z1 := ⟨h0, by linarith⟩ + obtain ⟨s, hs, heq⟩ := hrange (by simpa [hz0eq, hz1eq] using hmemRange) + exact ⟨s, hs, heq⟩ + · have hrange' := intermediate_value_Icc' (a := (0 : Real)) (b := 1) + (by norm_num) (hfc 2).continuousOn + have hmemRange : 0 ∈ Set.Icc z1 z0 := ⟨h1, by linarith⟩ + obtain ⟨s, hs, heq⟩ := hrange' (by simpa [hz0eq, hz1eq] using hmemRange) + exact ⟨s, hs, heq⟩ + +private theorem honeHit : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + ∀ (j : Fin (n + (3 : ℕ))), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + (Set.Icc ((A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (q (0 : ℝ))) ((A.coord (2 : Fin (3 : + ℕ)) : ℝ × ℝ → ℝ) (q (1 : ℝ))) ⊆ (fun (s : ℝ) => (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → + ℝ) (q s)) '' Set.Icc (0 : ℝ) (1 : ℝ)) → (∀ (x : ℝ × ℝ), ((0 : ℝ) < (A.coord (0 : Fin + (3 : ℕ)) : ℝ × ℝ → ℝ) x ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : + ℝ) < (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x) → ((∀ (i : Fin 3), Continuous (fun s + => A.coord i (q s))) → ( + let z0 := A.coord 2 (p.vertex j) + let z1 := A.coord 2 (p.vertex (j + 1)) + (A.coord 0 x + A.coord 1 x + A.coord 2 x = 1) → (((z0 ≤ 0 ∧ 1 ≤ z1) ∨ (z1 ≤ 0 ∧ 1 ≤ z0)) + → ((A.coord 2 (q 0) = z0) → ((A.coord 2 (q 1) = z1) → (∃ s ∈ Set.Icc (0 : Real) 1, + A.coord 2 (q s) = 1))))))) ) := by + classical + intro n p E a b c v hind hspan A j q hrange x hxb hfc z0 z1 hxsum hstraddle hz0eq hz1eq + rcases hstraddle with ⟨h0, h1⟩ | ⟨h1, h0⟩ + · have hmemRange : 1 ∈ Set.Icc z0 z1 := ⟨by linarith, h1⟩ + obtain ⟨s, hs, heq⟩ := hrange (by simpa [hz0eq, hz1eq] using hmemRange) + exact ⟨s, hs, heq⟩ + · have hrange' := intermediate_value_Icc' (a := (0 : Real)) (b := 1) + (by norm_num) (hfc 2).continuousOn + have hmemRange : 1 ∈ Set.Icc z1 z0 := ⟨by linarith, h0⟩ + obtain ⟨s, hs, heq⟩ := hrange' (by simpa [hz0eq, hz1eq] using hmemRange) + exact ⟨s, hs, heq⟩ + +private theorem hqseg0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (j : Fin (n + (3 : ℕ))), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + ∀ (s0 : ℝ), (s0 ∈ Set.Icc (0 : ℝ) (1 : ℝ)) → (q s0 ∈ segment Real (p.vertex j) (p.vertex + (j + 1))) ) := by + classical + intro n p j q s0 hs0 + rw [segment_eq_image_lineMap] + exact ⟨s0, hs0, rfl⟩ + +private theorem hqa : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + (A.coord 0 a = 1 ∧ A.coord 1 a = 0 ∧ A.coord 2 a = 0) → (∀ (j : Fin (n + (3 : ℕ))), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + ∀ (s0 : ℝ), ((A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (q s0) = (0 : ℝ)) → ((A.coord 1 (q + s0) = 0) → (q s0 = a))) ) := by + classical + intro n p E a b c v hind hspan A hcoordA j q s0 hzs0 hq1zero + apply A.ext_elem + intro i + fin_cases i + · change A.coord 0 (q s0) = A.coord 0 a + have hsum : A.coord 0 (q s0) + A.coord 1 (q s0) + + A.coord 2 (q s0) = 1 := by + simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one (q s0) + rw [hcoordA.1] + linarith + · change A.coord 1 (q s0) = A.coord 1 a + calc + _ = 0 := hq1zero + _ = A.coord 1 a := hcoordA.2.1.symm + · change A.coord 2 (q s0) = A.coord 2 a + calc + _ = 0 := hzs0 + _ = A.coord 2 a := hcoordA.2.2.symm + +private theorem hsideA : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + (∀ (i : Fin (n + 3)), ∀ (j : Fin (n + 3)), p.vertex j ∈ segment Real (p.vertex i) + (p.vertex (i + 1)) ↔ j = i ∨ j = i + 1) → (∀ (j : Fin (n + (3 : ℕ))), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + ∀ (s0 : ℝ), (q s0 ∈ segment Real (p.vertex j) (p.vertex (j + 1))) → ((q s0 = a) → (E.b - + 1 = j ∨ E.b - 1 = j + 1))) ) := by + classical + intro n p E a hvertexSide j q s0 hqseg0 hqa + apply (hvertexSide j (E.b - 1)).mp + have : a ∈ segment Real (p.vertex j) (p.vertex (j + 1)) := by + rw [← hqa] + exact hqseg0 + simpa [a] using this + +private theorem hqseg1 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (j : Fin (n + (3 : ℕ))), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + ∀ (s1 : ℝ), (s1 ∈ Set.Icc (0 : ℝ) (1 : ℝ)) → (q s1 ∈ segment Real (p.vertex j) (p.vertex + (j + 1))) ) := by + classical + intro n p j q s1 hs1 + rw [segment_eq_image_lineMap] + exact ⟨s1, hs1, rfl⟩ + +private theorem hqc : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + (A.coord 0 c = 0 ∧ A.coord 1 c = 0 ∧ A.coord 2 c = 1) → (∀ (j : Fin (n + (3 : ℕ))), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + ∀ (s1 : ℝ), ((A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (q s1) = (1 : ℝ)) → ((A.coord 1 (q + s1) = 0) → (q s1 = c))) ) := by + classical + intro n p E a b c v hind hspan A hcoordC j q s1 hzs1 hq1one + apply A.ext_elem + intro i + fin_cases i + · change A.coord 0 (q s1) = A.coord 0 c + have hsum : A.coord 0 (q s1) + A.coord 1 (q s1) + + A.coord 2 (q s1) = 1 := by + simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one (q s1) + rw [hcoordC.1] + linarith + · change A.coord 1 (q s1) = A.coord 1 c + calc + _ = 0 := hq1one + _ = A.coord 1 c := hcoordC.2.1.symm + · change A.coord 2 (q s1) = A.coord 2 c + calc + _ = 1 := hzs1 + _ = A.coord 2 c := hcoordC.2.2.symm + +private theorem hsideC : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let c := p.vertex (E.b + 1) + (∀ (i : Fin (n + 3)), ∀ (j : Fin (n + 3)), p.vertex j ∈ segment Real (p.vertex i) + (p.vertex (i + 1)) ↔ j = i ∨ j = i + 1) → (∀ (j : Fin (n + (3 : ℕ))), + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + ∀ (s1 : ℝ), (q s1 ∈ segment Real (p.vertex j) (p.vertex (j + 1))) → ((q s1 = c) → (E.b + + 1 = j ∨ E.b + 1 = j + 1))) ) := by + classical + intro n p E c hvertexSide j q s1 hqseg1 hqc + apply (hvertexSide j (E.b + 1)).mp + have : c ∈ segment Real (p.vertex j) (p.vertex (j + 1)) := by + rw [← hqc] + exact hqseg1 + simpa [c] using this + +private theorem hidxAt807 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (j : + Fin (n + (3 : ℕ))), (E.b - (1 : Fin (n + (3 : ℕ))) = j) → ((E.b + (1 : Fin (n + (3 : + ℕ))) = j + (1 : Fin (n + (3 : ℕ)))) → (E.b + 1 = (E.b - 1) + 1)) ) := by + classical + intro n p E j ha hc + calc + E.b + 1 = j + 1 := hc + _ = (E.b - 1) + 1 := congrArg (fun k : Fin (n + 3) => k + 1) ha.symm + +private theorem hidxAt812 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (j : + Fin (n + (3 : ℕ))), (E.b - (1 : Fin (n + (3 : ℕ))) = j + (1 : Fin (n + (3 : ℕ)))) → + ((E.b + (1 : Fin (n + (3 : ℕ))) = j) → (E.b - 1 = (E.b + 1) + 1)) ) := by + classical + intro n p E j ha hc + calc + E.b - 1 = j + 1 := ha + _ = (E.b + 1) + 1 := congrArg (fun k : Fin (n + 3) => k + 1) hc.symm + +private theorem hlocal : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + ∀ x : Real × Real, x ∉ C → ∃ r : Real, 0 < r ∧ ∀ y ∈ Metric.ball x r, (y ∈ O ↔ x ∈ O) ) + := by + classical + intro n p O C x hx + obtain ⟨r, hr, hball⟩ := (P3544T1LocalParity p).2.2.2.2.1 x hx + refine ⟨r, hr, ?_⟩ + intro y hy + rcases hball with hsub | hdisj + · have hyO := hsub hy + have hxO := hsub (Metric.mem_ball_self hr) + exact ⟨fun _ => hxO, fun _ => hyO⟩ + · have hyO : y ∉ O := fun hyo => Set.disjoint_left.mp hdisj hy hyo + have hxO : x ∉ O := fun hxo => Set.disjoint_left.mp hdisj + (Metric.mem_ball_self hr) hxo + exact ⟨fun hyo => (hyO hyo).elim, fun hxo => (hxO hxo).elim⟩ + +private theorem hconstOn : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + (∀ x : Real × Real, x ∉ C → ∃ r : Real, 0 < r ∧ ∀ y ∈ Metric.ball x r, (y ∈ O ↔ x ∈ O)) → + (∀ S : Set (Real × Real), IsConnected S → (∀ x, x ∈ S → x ∉ C) → ∀ x ∈ S, ∀ y ∈ S, (x + ∈ O ↔ y ∈ O)) ) := by + classical + intro n p O C hlocal S hconn hSC x hx y hy + let f : S → Bool := fun z => decide ((z : Real × Real) ∈ O) + have hf : IsLocallyConstant f := by + rw [IsLocallyConstant.iff_exists_open] + intro z + obtain ⟨ρ, hρ, hstable⟩ := hlocal z.1 (hSC z.1 z.2) + let U : Set S := Subtype.val ⁻¹' Metric.ball z.1 ρ + refine ⟨U, Metric.isOpen_ball.preimage continuous_subtype_val, ?_, ?_⟩ + · exact Metric.mem_ball_self hρ + · intro z' hz' + have hsame := hstable z' hz' + have hbool : decide ((z' : Real × Real) ∈ O) = decide ((z : Real × Real) ∈ O) := by + by_cases hzO : (z' : Real × Real) ∈ O + · by_cases hzbase : (z : Real × Real) ∈ O + · simp [hzO, hzbase] + · exact False.elim (hzbase (hsame.mp hzO)) + · by_cases hzbase : (z : Real × Real) ∈ O + · exact False.elim (hzO (hsame.mpr hzbase)) + · simp [hzO, hzbase] + simpa [f] using hbool + let : PreconnectedSpace S := isPreconnected_iff_preconnectedSpace.mp hconn.2 + have heq := hf.apply_eq_of_preconnectedSpace ⟨x, hx⟩ ⟨y, hy⟩ + change (decide (x ∈ O) = decide (y ∈ O)) at heq + by_cases hxo : x ∈ O <;> by_cases hyo : y ∈ O <;> simp [hxo, hyo] at heq ⊢ + +private theorem hcoordm : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let c := p.vertex (E.b + 1) + ∀ (v : Fin 3 → Real × Real), ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan + Real (Set.range v) + = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + let m : Real × Real := AffineMap.lineMap a c (1 / 2 : Real) + ∀ (i : Fin (3 : ℕ)), (A.coord i : ℝ × ℝ → ℝ) m = (1 / 2 : ℝ) * (A.coord i : ℝ × ℝ → ℝ) a + + (1 / 2 : ℝ) * (A.coord i : ℝ × ℝ → ℝ) c ) := by + classical + intro n p E a c v hind hspan A m i + change A.coord i (AffineMap.lineMap a c (1 / 2 : Real)) = _ + rw [(A.coord i).apply_lineMap, AffineMap.lineMap_apply_ring] + ring + +private theorem hcoordq : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + ∀ (v : Fin 3 → Real × Real), ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan + Real (Set.range v) + = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + let m : Real × Real := AffineMap.lineMap a c (1 / 2 : Real) + let q : Real → Real × Real := fun t => AffineMap.lineMap b m t + ∀ (t : ℝ), ∀ (i : Fin (3 : ℕ)), (A.coord i : ℝ × ℝ → ℝ) (q t) = ((1 : ℝ) - t) * (A.coord + i : ℝ × ℝ → ℝ) b + t * (A.coord i : ℝ × ℝ → ℝ) m ) := by + classical + intro n p E a b c v hind hspan A m q t i + change A.coord i (AffineMap.lineMap b m t) = _ + rw [(A.coord i).apply_lineMap, AffineMap.lineMap_apply_ring] + +private theorem hseed0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + ∀ (v : Fin 3 → Real × Real), ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan + Real (Set.range v) + = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + (A.coord 0 a = 1 ∧ A.coord 1 a = 0 ∧ A.coord 2 a = 0) → ((A.coord 0 b = 0 ∧ A.coord 1 b = + 1 ∧ A.coord 2 b = 0) → ((A.coord 0 c = 0 ∧ A.coord 1 c = 0 ∧ A.coord 2 c = 1) → ( + let m : Real × Real := AffineMap.lineMap a c (1 / 2 : Real) + let q : Real → Real × Real := fun t => AffineMap.lineMap b m t + ∀ (t : ℝ), ((0 : ℝ) < t) → ((∀ (i : Fin 3), A.coord i m = (1 / 2) * A.coord i a + (1 / 2) + * A.coord i c) → ((∀ (i : Fin 3), A.coord i (q t) = (1 - t) * A.coord i b + t * + A.coord i m) → (0 < A.coord 0 (q t))))))) ) := by + classical + intro n p E a b c v hind hspan A hcoordA hcoordB hcoordC m q t ht0 hcoordm hcoordq + rw [hcoordq 0, hcoordm 0, hcoordB.1, hcoordA.1, hcoordC.1] + norm_num + positivity + +private theorem hseed1 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + ∀ (v : Fin 3 → Real × Real), ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan + Real (Set.range v) + = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + (A.coord 0 a = 1 ∧ A.coord 1 a = 0 ∧ A.coord 2 a = 0) → ((A.coord 0 b = 0 ∧ A.coord 1 b = + 1 ∧ A.coord 2 b = 0) → ((A.coord 0 c = 0 ∧ A.coord 1 c = 0 ∧ A.coord 2 c = 1) → ( + let m : Real × Real := AffineMap.lineMap a c (1 / 2 : Real) + let q : Real → Real × Real := fun t => AffineMap.lineMap b m t + ∀ (t : ℝ), (t ∈ Set.Ioo (0 : Real) 1) → ((∀ (i : Fin 3), A.coord i m = (1 / 2) * A.coord + i a + (1 / 2) * A.coord i c) → ((∀ (i : Fin 3), A.coord i (q t) = (1 - t) * A.coord i + b + t * A.coord i m) → (0 < A.coord 1 (q t))))))) ) := by + classical + intro n p E a b c v hind hspan A hcoordA hcoordB hcoordC m q t ht01 hcoordm hcoordq + rw [hcoordq 1, hcoordm 1, hcoordB.2.1, hcoordA.2.1, hcoordC.2.1] + norm_num + exact ht01.2 + +private theorem hseed2 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + ∀ (v : Fin 3 → Real × Real), ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan + Real (Set.range v) + = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + (A.coord 0 a = 1 ∧ A.coord 1 a = 0 ∧ A.coord 2 a = 0) → ((A.coord 0 b = 0 ∧ A.coord 1 b = + 1 ∧ A.coord 2 b = 0) → ((A.coord 0 c = 0 ∧ A.coord 1 c = 0 ∧ A.coord 2 c = 1) → ( + let m : Real × Real := AffineMap.lineMap a c (1 / 2 : Real) + let q : Real → Real × Real := fun t => AffineMap.lineMap b m t + ∀ (t : ℝ), ((0 : ℝ) < t) → ((∀ (i : Fin 3), A.coord i m = (1 / 2) * A.coord i a + (1 / 2) + * A.coord i c) → ((∀ (i : Fin 3), A.coord i (q t) = (1 - t) * A.coord i b + t * + A.coord i m) → (0 < A.coord 2 (q t))))))) ) := by + classical + intro n p E a b c v hind hspan A hcoordA hcoordB hcoordC m q t ht0 hcoordm hcoordq + rw [hcoordq 2, hcoordm 2, hcoordB.2.2, hcoordA.2.2, hcoordC.2.2] + norm_num + positivity + +private theorem hseedCone : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let m : Real × Real := AffineMap.lineMap a c (1 / 2 : Real) + let q : Real → Real × Real := fun t => AffineMap.lineMap b m t + ∀ (t : ℝ), ((0 : ℝ) < t) → (∃ s u : Real, 0 < s ∧ 0 < u ∧ q t = b + s • (a - b) + u • (c + - b)) ) := by + classical + intro n p E a b c m q t ht0 + refine ⟨t / 2, t / 2, by positivity, by positivity, ?_⟩ + apply Prod.ext <;> simp [q, m, AffineMap.lineMap_apply_ring] <;> ring + +private theorem hinteriorOdd : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + (interior T ∩ P3544T1BoundaryCarrier p = ∅) → ( + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + (∀ S : Set (Real × Real), IsConnected S → (∀ x, x ∈ S → x ∉ C) → ∀ x ∈ S, ∀ y ∈ S, (x ∈ O + ↔ y ∈ O)) → ( + let m : Real × Real := AffineMap.lineMap a c (1 / 2 : Real) + let q : Real → Real × Real := fun t => AffineMap.lineMap b m t + ∀ (t : ℝ), (q t ∈ interior T) → ((q t ∈ O) → ((IsConnected (interior T)) → (interior T ⊆ + O))))) ) := by + classical + intro n p E a b c T hintAvoid O C hconstOn m q t hseed hseedOdd hIconn x hx + have hconst := hconstOn (interior T) hIconn + (fun y hy => fun hyC => by + have hmem : y ∈ interior T ∩ P3544T1BoundaryCarrier p := ⟨hy, hyC⟩ + simp [hintAvoid] at hmem) x hx (q t) hseed + exact hconst.mpr hseedOdd + +private theorem hbaseOdd : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + (∀ x, x ∈ openSegment Real a c → x ∉ P3544T1BoundaryCarrier p) → ( + let O := P3544T1RayParity p + let m : Real × Real := AffineMap.lineMap a c (1 / 2 : Real) + let q : Real → Real × Real := fun t => AffineMap.lineMap b m t + ∀ (t : ℝ), (q t ∈ interior T) → ((Convex Real T) → ((interior T ⊆ O) → (∀ x, x ∈ + openSegment Real a c → x ∈ O)))) ) := by + classical + intro n p E a b c T hbaseAvoid O m q t hseed hTconv hinteriorOdd x hx + let C := P3544T1BoundaryCarrier p + have hxT : x ∈ T := by + change x ∈ convexHull Real ({a, b, c} : Set (Real × Real)) + have ha : a ∈ ({a, b, c} : Set (Real × Real)) := by + exact Or.inl rfl + have hc : c ∈ ({a, b, c} : Set (Real × Real)) := by + exact Or.inr (Or.inr rfl) + exact (segment_subset_convexHull ha hc) (openSegment_subset_segment Real a c hx) + have hxcl : x ∈ closure (interior T) := by + rw [hTconv.closure_interior_eq_closure_of_nonempty_interior ⟨q t, hseed⟩] + exact subset_closure hxT + have hxclO : x ∈ closure O := closure_mono hinteriorOdd hxcl + have hclosure : closure O = O ∪ C := by + simpa [O, C] using (P3544T1LocalParity p).1 + have hxunion : x ∈ O ∪ C := by + rw [← hclosure] + exact hxclO + rcases hxunion with ho | hc + · exact ho + · exact False.elim (hbaseAvoid x hx hc) + +private theorem hclear : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1) + let c := p.vertex (E.b + 1) + (∀ x, x ∈ openSegment Real a c → x ∉ P3544T1BoundaryCarrier p) → ( + let C := P3544T1BoundaryCarrier p + Disjoint (openSegment Real (p.vertex (E.b - 1)) (p.vertex (E.b + 1))) C) ) := by + classical + intro n p E a c hbaseAvoid C + apply Set.disjoint_left.mpr + intro x hx hxC + have hx' : x ∈ openSegment Real a c := by simpa [a, c] using hx + exact hbaseAvoid x hx' hxC + +end TriangleDiagonalGeometry + +namespace TriangleBaseAvoidance + +private theorem hbaseAvoid : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), (∀ (i + : Fin (n + (3 : ℕ))), p.vertex i ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))} → i = E.b - (1 : Fin (n + (3 : ℕ))) ∨ i = + E.b ∨ i = E.b + (1 : Fin (n + (3 : ℕ)))) → ( + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let triangleVertices : Fin 3 → Real × Real := ![a, b, c] + ∀ (hind : AffineIndependent ℝ ![p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))]), ∀ (hspan : affineSpan ℝ (Set.range + ![p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, p.vertex (E.b + (1 : Fin (n + + (3 : ℕ))))]) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨triangleVertices, hind, hspan⟩ + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + (∀ (x : ℝ × ℝ), x ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))} ↔ ∀ (i : Fin (3 : ℕ)), (0 : ℝ) ≤ (A.coord i + : ℝ × ℝ → ℝ) x) → ((∀ (x : ℝ + × ℝ), x ∈ interior ((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))}) ↔ ∀ (i : Fin (3 : ℕ)), (0 : ℝ) < (A.coord + i : ℝ × ℝ → ℝ) x) → ((∀ (i : + Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), p.vertex j ∈ segment ℝ (p.vertex i) + (p.vertex (i + (1 : Fin (n + (3 : ℕ))))) ↔ j = i ∨ j = i + (1 : Fin (n + (3 : ℕ)))) → + ((∀ x ∈ T, x ∈ segment ℝ a b → (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ)) → + ((∀ x ∈ T, x ∈ segment ℝ + b c → (A.coord (0 : Fin (3 : + ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ)) → ((E.b - (1 : Fin (n + (3 : ℕ))) ≠ E.b + (1 : Fin (n + + (3 : ℕ)))) → ((E.b + (1 : Fin (n + (3 : ℕ))) ≠ E.b - (1 : Fin (n + (3 : ℕ))) + (1 : + Fin (n + (3 : ℕ)))) → ((E.b - (1 : Fin (n + (3 : ℕ))) ≠ E.b + (1 : Fin (n + (3 : ℕ))) + + (1 : Fin (n + (3 : ℕ)))) → ((interior ((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))}) ∩ P3544T1BoundaryCarrier p = ∅) → (( + let A := A; (A.coord (0 : Fin (3 + : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b - (1 : Fin (n + (3 : ℕ))))) = (1 : ℝ) ∧ (A.coord (1 + : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b - (1 : Fin (n + (3 : ℕ))))) = (0 : ℝ) ∧ + (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b - (1 : Fin (n + (3 : ℕ))))) = + (0 : ℝ)) → (( + let A := A; (A.coord (0 : Fin (3 + : ℕ)) : ℝ × ℝ → ℝ) (p.vertex E.b) = (0 : ℝ) ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) + (p.vertex E.b) = (1 : ℝ) ∧ (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex E.b) = + (0 : ℝ)) → (( + let A := A; (A.coord (0 : Fin (3 + : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))) = (0 : ℝ) ∧ (A.coord (1 + : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))) = (0 : ℝ) ∧ + (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))) = + (1 : ℝ)) → (∀ x, x ∈ openSegment Real a c → x ∉ P3544T1BoundaryCarrier + p))))))))))))) ) := by + classical + intro n p E hempty a b c triangleVertices hind hspan A T hmem hint hvertexSide hleftFace + hrightFace habdist habNext hcaNext hintAvoid hcoordA hcoordB hcoordC x hx hxC + obtain ⟨j, hj⟩ := Set.mem_iUnion.mp hxC + have hxb := (TriangleDiagonalGeometry.hopenBaseCoords n p E hind hspan hcoordA hcoordC) x hx + have hxT : x ∈ T := (hmem x).mpr (by + intro i + fin_cases i + · exact le_of_lt hxb.1 + · change 0 ≤ A.coord 1 x + rw [hxb.2.1] + · exact le_of_lt hxb.2.2) + by_cases hja : j = E.b - 1 + · subst j + have hface := hleftFace x hxT + (by simpa [a, b] using hj) + exact (ne_of_gt hxb.2.2) hface + by_cases hjb : j = E.b + · subst j + have hface := hrightFace x hxT + (by simpa [b, c] using hj) + exact (ne_of_gt hxb.1) hface + rw [segment_eq_image_lineMap] at hj + obtain ⟨t, ht, hqt⟩ := hj + let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) + have hqtq : q t = x := hqt + have hqcont : Continuous q := + (AffineMap.lineMap (k := Real) (p.vertex j) (p.vertex (j + + 1))).continuous_of_finiteDimensional + have hfc (i : Fin 3) : Continuous (fun s => A.coord i (q s)) := + (A.coord i).continuous_of_finiteDimensional.comp hqcont + have hline (i : Fin 3) (s : Real) : + A.coord i (q s) = (1 - s) * A.coord i (p.vertex j) + + s * A.coord i (p.vertex (j + 1)) := TriangleDiagonalGeometry.hline n p E hind hspan + (TriangleDiagonalGeometry.hcoordLine n p E hind hspan) j i s + have ht' := TriangleDiagonalGeometry.ht' n p x j t ht hqtq + (TriangleDiagonalGeometry.hnotLeft n p E hempty hind hspan hcoordA hcoordB hcoordC x j + hxb hxT hja hjb t hqt hqtq hqcont hfc hline) (TriangleDiagonalGeometry.hnotRight n p + E hempty hind hspan hcoordA hcoordB hcoordC x j hxb hxT) + have hzero := TriangleDiagonalGeometry.hzero n p E hind hspan x + j hxb t hqtq hline + by_cases hposj : 0 < A.coord 1 (p.vertex j) + · have hqt0 : 0 < A.coord 0 (q t) := TriangleDiagonalGeometry.hqt0At504 n p E hind hspan x j + hxb t hqtq + have hqt2 := TriangleDiagonalGeometry.hqt2At507 n p E hind hspan x j + hxb t hqtq + have hn : (fun s => A.coord 0 (q s)) ⁻¹' Set.Ioi (0 : Real) ∈ nhds t := + (hfc 0).continuousAt.preimage_mem_nhds + (isOpen_Ioi.mem_nhds hqt0) + have hn' : (fun s => A.coord 2 (q s)) ⁻¹' Set.Ioi (0 : Real) ∈ nhds t := + (hfc 2).continuousAt.preimage_mem_nhds + (isOpen_Ioi.mem_nhds hqt2) + have hn'' : (fun s => A.coord 0 (q s)) ⁻¹' Set.Ioi (0 : Real) ∩ + (fun s => A.coord 2 (q s)) ⁻¹' Set.Ioi (0 : Real) ∈ nhds t := + Filter.inter_mem hn hn' + obtain ⟨u, v, huv, hsub⟩ := mem_nhds_iff_exists_Ioo_subset.mp hn'' + have hlow : max u 0 < t := max_lt_iff.mpr ⟨huv.1, ht'.1⟩ + obtain ⟨s, hus, hst⟩ := exists_between hlow + have hs01 : s ∈ Set.Ioo (0 : Real) 1 := ⟨lt_of_le_of_lt (le_max_right _ _) hus, + hst.trans ht'.2⟩ + have hsuv : s ∈ Set.Ioo u v := + ⟨lt_of_le_of_lt (le_max_left _ _) hus, hst.trans huv.2⟩ + have hq0 : 0 < A.coord 0 (q s) := (hsub hsuv).1 + have hq2 : 0 < A.coord 2 (q s) := (hsub hsuv).2 + have hq1 : 0 < A.coord 1 (q s) := TriangleDiagonalGeometry.hq1At528 n p triangleVertices + hind hspan j t + hline ht' hzero hposj s hst + have hqint : q s ∈ interior T := (hint _).mpr (by + intro i + fin_cases i + · exact hq0 + · exact hq1 + · exact hq2) + have hqseg := TriangleDiagonalGeometry.hqsegAt546 n p j s hs01 + have hfalse : q s ∈ (∅ : Set (Real × Real)) := TriangleDiagonalGeometry.hfalseAt549 n p E + hintAvoid j s hqint hqseg + simp at hfalse + · by_cases hposnext : 0 < A.coord 1 (p.vertex (j + 1)) + · have hqt0 := TriangleDiagonalGeometry.hqt0At555 n p E hind hspan x + j hxb t hqtq + have hqt2 := TriangleDiagonalGeometry.hqt2At558 n p E hind hspan x + j hxb t hqtq + have hn : (fun s => A.coord 0 (q s)) ⁻¹' Set.Ioi (0 : Real) ∈ nhds t := + (hfc 0).continuousAt.preimage_mem_nhds + (isOpen_Ioi.mem_nhds hqt0) + have hn' : (fun s => A.coord 2 (q s)) ⁻¹' Set.Ioi (0 : Real) ∈ nhds t := + (hfc 2).continuousAt.preimage_mem_nhds + (isOpen_Ioi.mem_nhds hqt2) + have hn'' : (fun s => A.coord 0 (q s)) ⁻¹' Set.Ioi (0 : Real) ∩ + (fun s => A.coord 2 (q s)) ⁻¹' Set.Ioi (0 : Real) ∈ nhds t := + Filter.inter_mem hn hn' + obtain ⟨u, v, huv, hsub⟩ := mem_nhds_iff_exists_Ioo_subset.mp hn'' + have hhigh : t < min v 1 := lt_min huv.2 ht'.2 + obtain ⟨s, hts, hsv⟩ := exists_between hhigh + have hs01 : s ∈ Set.Ioo (0 : Real) 1 := ⟨ht'.1.trans hts, + lt_of_lt_of_le hsv (min_le_right _ _)⟩ + have hsuv : s ∈ Set.Ioo u v := + ⟨huv.1.trans hts, lt_of_lt_of_le hsv (min_le_left _ _)⟩ + have hq0 : 0 < A.coord 0 (q s) := (hsub hsuv).1 + have hq2 : 0 < A.coord 2 (q s) := (hsub hsuv).2 + have hq1 : 0 < A.coord 1 (q s) := TriangleDiagonalGeometry.hq1At579 n p triangleVertices + hind hspan j t + hline ht' hzero hposnext s hts + have hqint : q s ∈ interior T := (hint _).mpr (by + intro i + fin_cases i + · exact hq0 + · exact hq1 + · exact hq2) + have hqseg := TriangleDiagonalGeometry.hqsegAt597 n p j s hs01 + have hfalse : q s ∈ (∅ : Set (Real × Real)) := TriangleDiagonalGeometry.hfalseAt600 n p E + hintAvoid j s hqint hqseg + simp at hfalse + · have hαnonpos : A.coord 1 (p.vertex j) ≤ 0 := le_of_not_gt hposj + have hβnonpos : A.coord 1 (p.vertex (j + 1)) ≤ 0 := le_of_not_gt hposnext + have hleftTerm : (1 - t) * A.coord 1 (p.vertex j) ≤ 0 := + mul_nonpos_of_nonneg_of_nonpos (sub_nonneg.mpr ht'.2.le) hαnonpos + have hrightTerm : t * A.coord 1 (p.vertex (j + 1)) ≤ 0 := + mul_nonpos_of_nonneg_of_nonpos ht'.1.le hβnonpos + have hα0 := TriangleDiagonalGeometry.hα0 n p E hind hspan j + t ht' hzero hleftTerm hrightTerm + have hβ0 := TriangleDiagonalGeometry.hβ0 n p E hind + hspan j t ht' hzero hleftTerm hrightTerm + have hline1 (s : Real) := TriangleDiagonalGeometry.hline1 n p E + hind hspan j hline hα0 hβ0 s + let z0 := A.coord 2 (p.vertex j) + let z1 := A.coord 2 (p.vertex (j + 1)) + have hline2 (s : Real) : A.coord 2 (q s) = (1 - s) * z0 + s * z1 := by + simpa [z0, z1] using hline 2 s + have hzt : (1 - t) * z0 + t * z1 = A.coord 2 x := TriangleDiagonalGeometry.hzt n p E hind + hspan x j t hqtq hline2 + have hzpos : 0 < (1 - t) * z0 + t * z1 := by rw [hzt]; exact hxb.2.2 + have hxsum : A.coord 0 x + A.coord 1 x + A.coord 2 x = 1 := by + simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one x + have hzlt := TriangleDiagonalGeometry.hzlt n p E hind hspan x hxb hxsum + have hstraddle := TriangleDiagonalGeometry.hstraddle n p E hind hspan x j hxb t ht' hzt + (TriangleDiagonalGeometry.hz0case n p E hind hspan j + (TriangleDiagonalGeometry.hnotIoo0 n p E hempty hind hspan hmem hcoordA hcoordB + hcoordC j hposj hα0 (TriangleDiagonalGeometry.hcoord0j n p E hind hspan j hposj hα0 + (TriangleDiagonalGeometry.hsum0 n p E hind hspan j)))) + (TriangleDiagonalGeometry.hz1case n p E hind hspan j + (TriangleDiagonalGeometry.hnotIoo1 n p E hempty hind hspan hmem hcoordA hcoordB + hcoordC j hposnext hβ0 (TriangleDiagonalGeometry.hcoord01 n p E hind hspan j hposnext + hβ0 (TriangleDiagonalGeometry.hsum1 n p E hind hspan j)))) + hxsum + have hrange := intermediate_value_Icc (a := (0 : Real)) (b := 1) + (by norm_num) (hfc 2).continuousOn + have hz0eq : A.coord 2 (q 0) = z0 := by simpa [z0] using hline2 0 + have hz1eq : A.coord 2 (q 1) = z1 := by simpa [z1] using hline2 1 + obtain ⟨s0, hs0, hzs0⟩ := (TriangleDiagonalGeometry.hzeroHit n p E hind hspan j hrange x + hxb hfc hxsum hstraddle hz0eq hz1eq) + have hq1zero : A.coord 1 (q s0) = 0 := hline1 s0 + have hsideA := TriangleDiagonalGeometry.hsideA n p E + hvertexSide j s0 (TriangleDiagonalGeometry.hqseg0 n p j s0 hs0) + (TriangleDiagonalGeometry.hqa n p E hind hspan hcoordA j s0 hzs0 hq1zero) + obtain ⟨s1, hs1, hzs1⟩ := (TriangleDiagonalGeometry.honeHit n p E hind hspan j hrange x + hxb hfc hxsum hstraddle hz0eq hz1eq) + have hq1one : A.coord 1 (q s1) = 0 := hline1 s1 + have hsideC := TriangleDiagonalGeometry.hsideC n p E + hvertexSide j s1 (TriangleDiagonalGeometry.hqseg1 n p j s1 hs1) + (TriangleDiagonalGeometry.hqc n p E hind hspan hcoordC j s1 hzs1 hq1one) + rcases hsideA with ha | ha <;> rcases hsideC with hc | hc + · exact habdist (ha.trans hc.symm) + · have hidx : E.b + 1 = (E.b - 1) + 1 := TriangleDiagonalGeometry.hidxAt807 n p E j ha hc + exact habNext hidx + · have hidx : E.b - 1 = (E.b + 1) + 1 := TriangleDiagonalGeometry.hidxAt812 n p E j ha hc + exact hcaNext hidx + · exact habdist (ha.trans hc.symm) + +end TriangleBaseAvoidance + +theorem P3650T1EmptyTriangleDiagonal {n : Nat} (p : P3381T1PolygonBoundary n) + (hn : 0 < n) (E : P3650T1ExposedCorner p) + (hentry : ∀ (j : Fin (n + 3)) (w : Real × Real), j ≠ E.b - 1 → j ≠ E.b → + w ∈ interior (convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : + Set (Real × Real))) → + w ∈ segment Real (p.vertex j) (p.vertex (j + 1)) → + ∃ k, (k = j ∨ k = j + 1) ∧ + p.vertex k ∈ convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : + Set (Real × Real)) ∧ E.height w ≤ E.height (p.vertex k)) + (hempty : ∀ i, p.vertex i ∈ convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : + Set (Real × Real)) → i = E.b - 1 ∨ i = E.b ∨ i = E.b + 1) : + ∃ D : P3650T1VisibleDiagonal p E, D.a = E.b - 1 ∧ D.b = E.b + 1 := by +-- BODY + classical + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let triangleVertices : Fin 3 → Real × Real := ![a, b, c] + have hdet := TriangleDiagonalGeometry.hdet n p E + have hind := TriangleDiagonalGeometry.hind n p E hdet + have hspan := TriangleDiagonalGeometry.hspan n p E hind + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨triangleVertices, hind, hspan⟩ + have hA0 : A 0 = a := rfl + have hA1 : A 1 = b := rfl + have hA2 : A 2 = c := rfl + have hheight : E.height = A.coord 1 := TriangleDiagonalGeometry.hheight n p E hind hspan + let T := convexHull Real ({a, b, c} : Set (Real × Real)) + have hrange := TriangleDiagonalGeometry.hrangeAt179 n p E hind hspan + have hmem := TriangleDiagonalGeometry.hmemAt186 n p E hind + hspan hrange + have hint := TriangleDiagonalGeometry.hint n p E + hind hspan hrange + have hbase := TriangleDiagonalGeometry.hbase n p E + have hheightcoord (x : Real × Real) : E.height x = A.coord 1 x := by + rw [hheight] + have hvertexSide (i j : Fin (n + 3)) := TriangleDiagonalGeometry.hvertexSide n p i j + have hleftFace (x : Real × Real) (hx : x ∈ T) + (hxs : x ∈ segment Real a b) := TriangleDiagonalGeometry.hleftFace n p E + hind hspan x hx hxs + have hrightFace (x : Real × Real) (hx : x ∈ T) + (hxs : x ∈ segment Real b c) := TriangleDiagonalGeometry.hrightFace n p E + hind hspan x hx hxs + have habdist := TriangleDiagonalGeometry.habdist n p E (TriangleDiagonalGeometry.hacOuter n p E + hdet) + have hbcOuter := TriangleDiagonalGeometry.hbcOuter n p E + have habNext := TriangleDiagonalGeometry.habNext n p E + have hcaNext := TriangleDiagonalGeometry.hcaNext n p hn E + have hintAvoid := TriangleDiagonalGeometry.hintAvoid n p E hentry hempty hind hspan hint + hheightcoord + hleftFace hrightFace + have hcoordA := TriangleDiagonalGeometry.hcoordA n p E hind hspan + have hcoordB := TriangleDiagonalGeometry.hcoordB n p E hind hspan + have hcoordC := TriangleDiagonalGeometry.hcoordC n p E hind hspan + have hbaseAvoid := TriangleBaseAvoidance.hbaseAvoid n p E hempty hind hspan hmem hint + hvertexSide hleftFace hrightFace habdist habNext hcaNext hintAvoid hcoordA hcoordB hcoordC + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + obtain ⟨rcone, hrcone, hcone⟩ := E.cone_odd + let m : Real × Real := AffineMap.lineMap a c (1 / 2 : Real) + let q : Real → Real × Real := fun t => AffineMap.lineMap b m t + have hq0 : q 0 = b := by simp [q] + have hqcont : Continuous q := by + exact (AffineMap.lineMap (k := Real) b m).continuous_of_finiteDimensional + have hqball : q ⁻¹' Metric.ball b rcone ∈ nhds (0 : Real) := + hqcont.continuousAt.preimage_mem_nhds + (Metric.isOpen_ball.mem_nhds (by rw [hq0]; exact Metric.mem_ball_self hrcone)) + obtain ⟨u, v, huv, hsub⟩ := mem_nhds_iff_exists_Ioo_subset.mp hqball + have hzeroI : (0 : Real) ∈ Set.Ioo u v := huv + obtain ⟨t, ht0, htmin⟩ : ∃ t : Real, 0 < t ∧ t < min v 1 := + exists_between (lt_min hzeroI.2 one_pos) + have ht01 : t ∈ Set.Ioo (0 : Real) 1 := ⟨ht0, (lt_min_iff.mp htmin).2⟩ + have htuv' : t ∈ Set.Ioo u v := ⟨by linarith [hzeroI.1, ht0], + (lt_min_iff.mp htmin).1⟩ + have hqnear : q t ∈ Metric.ball b rcone := hsub htuv' + have hcoordm (i : Fin 3) := TriangleDiagonalGeometry.hcoordm n p E triangleVertices + hind hspan i + have hcoordq (i : Fin 3) := TriangleDiagonalGeometry.hcoordq n p E triangleVertices hind + hspan t i + have hseed0 : 0 < A.coord 0 (q t) := TriangleDiagonalGeometry.hseed0 n p E triangleVertices + hind hspan hcoordA + hcoordB hcoordC t ht0 hcoordm hcoordq + have hseed1 : 0 < A.coord 1 (q t) := TriangleDiagonalGeometry.hseed1 n p E triangleVertices + hind hspan hcoordA + hcoordB hcoordC t ht01 hcoordm hcoordq + have hseed2 : 0 < A.coord 2 (q t) := TriangleDiagonalGeometry.hseed2 n p E triangleVertices + hind hspan hcoordA + hcoordB hcoordC t ht0 hcoordm hcoordq + have hseed : q t ∈ interior T := (hint _).mpr (by + intro i + fin_cases i + · simpa using hseed0 + · simpa using hseed1 + · simpa using hseed2) + have hseedOdd : q t ∈ O := (hcone (q t) hqnear).2 (TriangleDiagonalGeometry.hseedCone n p E t ht0) + have hTconv : Convex Real T := convex_convexHull Real _ + have hIconn : IsConnected (interior T) := + (hTconv.interior).isConnected ⟨q t, hseed⟩ + have hbaseOdd : ∀ x, x ∈ openSegment Real a c → x ∈ O := TriangleDiagonalGeometry.hbaseOdd n p + E hbaseAvoid t hseed hTconv (TriangleDiagonalGeometry.hinteriorOdd n p E hintAvoid + (TriangleDiagonalGeometry.hconstOn n p (TriangleDiagonalGeometry.hlocal n p)) t hseed + hseedOdd hIconn) + refine ⟨⟨E.b - 1, E.b + 1, habdist, habNext, hcaNext, (TriangleDiagonalGeometry.hclear n p E + hbaseAvoid), ?_, ?_⟩, + rfl, rfl⟩ + · intro x hx + exact hbaseOdd x (by simpa [a, c] using hx) + · exact Or.inl ⟨rfl, rfl, hempty⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCorner.lean b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCorner.lean new file mode 100644 index 0000000000..ef366d9289 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCorner.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity + +-- [TABLET NODE: P3650T1ExposedCorner] + +/-! +# P3650T1ExposedCorner + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a boundary $p$ of `P3381T1PolygonBoundary`, an exposed +corner consists of an index $b$ and a real linear functional $\ell$ +whose values at all indexed vertices are distinct, with its unique +maximum at $p_b$. Put $a=p_{b-1}$, $B=p_b$, $c=p_{b+1}$, with indices +read cyclically. The determinant of $(a,B,c)$ in +`P3381T1TriangleDeterminant` is nonzero. The data include an +affine height function $h$ with $h(a)=h(c)=0$, $h(B)=1$, together with +the existence of a positive product-metric radius $r$ such that, +for every $x\in B(B,r)$, +$$ + x\in O_p\quad\Longleftrightarrow\quad + x=B+s(a-B)+t(c-B)\text{ for some }s,t>0, +$$ +where $O_p$ is `P3544T1RayParity`. Thus the local odd set +is precisely the open convex cone between the two lower incident rays. +-/ +structure P3650T1ExposedCorner {n : Nat} (p : P3381T1PolygonBoundary n) where +-- BODY + /-- The unique boundary vertex maximizing the chosen linear functional. -/ + b : Fin (n + 3) + /-- A linear functional with distinct values on all boundary vertices. -/ + ell : (Real × Real) →ₗ[Real] Real + distinct_heights : Function.Injective (ell ∘ p.vertex) + maximum : ∀ i, i ≠ b → ell (p.vertex i) < ell (p.vertex b) + nondegenerate : P3381T1TriangleDeterminant + ![p.vertex (b - 1), p.vertex b, p.vertex (b + 1)] ≠ 0 + /-- The affine height normalized to zero at the two neighbors and one at the exposed vertex. -/ + height : (Real × Real) →ᵃ[Real] Real + height_prev : height (p.vertex (b - 1)) = 0 + height_top : height (p.vertex b) = 1 + height_next : height (p.vertex (b + 1)) = 0 + cone_odd : ∃ r : Real, 0 < r ∧ ∀ x ∈ Metric.ball (p.vertex b) r, + (x ∈ P3544T1RayParity p ↔ ∃ s t : Real, 0 < s ∧ 0 < t ∧ + x = p.vertex b + s • (p.vertex (b - 1) - p.vertex b) + + t • (p.vertex (b + 1) - p.vertex b)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean new file mode 100644 index 0000000000..1ddf9d32f0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean @@ -0,0 +1,3483 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3650T1ExposedCorner +public import Mathlib.Data.Set.Finite.Range +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P3650T1ExposedCornerExists] + +/-! +# P3650T1ExposedCornerExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ExposedCornerGeometry + +private theorem hdistinct : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + (q ∉ Set.range f) → ( + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + Function.Injective (ell ∘ v))) := by + classical + intro n p v f hqexists q hq ell i j hij + have heq : (v i).1 + q * (v i).2 = (v j).1 + q * (v j).2 := hij + have hy : (v i).2 = (v j).2 := by + by_contra hne + have hden : (v i).2 - (v j).2 ≠ 0 := sub_ne_zero.mpr hne + have hratio : q = ((v j).1 - (v i).1) / ((v i).2 - (v j).2) := by + apply (eq_div_iff hden).2 + nlinarith [heq] + apply hq + exact ⟨(i, j), by simp [f, v, hratio]⟩ + have hx : (v i).1 = (v j).1 := by rw [hy] at heq; linarith + exact p.injective (Prod.ext hx hy) + +private theorem hstrict : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + (Function.Injective (ell ∘ v)) → (∀ (b : Fin (n + (3 : ℕ))), (∀ x' ∈ Finset.univ, (ell : + ℝ × ℝ → ℝ) (v x') ≤ (ell : ℝ × ℝ → ℝ) (v b)) → (∀ i : Fin (n + 3), i ≠ b → ell (v i) + < ell (v b))) ) := by + classical + intro n p v f hqexists q ell hdistinct b hmax i hib + have hle := hmax i (Finset.mem_univ i) + exact lt_of_le_of_ne hle (fun heq => hib (hdistinct heq)) + +private theorem hnextne : + (by + classical + exact + ∀ (n : Nat), ∀ (b : Fin (n + (3 : ℕ))), b + 1 ≠ b ) := by + classical + intro n b h + have hv := congrArg Fin.val h + simp only [Fin.val_add, Fin.val_one] at hv + have hN : 2 ≤ n + 3 := by omega + by_cases hlt : b.val + 1 < n + 3 + · rw [Nat.mod_eq_of_lt hlt] at hv + omega + · have heq : b.val + 1 = n + 3 := by omega + rw [heq] at hv + simp at hv + omega + +private theorem hprevne : + (by + classical + exact + ∀ (n : Nat), ∀ (b : Fin (n + (3 : ℕ))), (b - 1 + 1 = b) → ((b + 1 ≠ b) → (b - 1 ≠ b)) ) + := by + classical + intro n b hprev hnextne heq + have hh := congrArg (fun j : Fin (n + 3) => j + 1) heq + rw [hprev] at hh + exact hnextne hh.symm + +private theorem haB : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), (b - 1 ≠ b) → ( + let B := v b + let a := v (b - 1) + a ≠ B) ) := by + classical + intro n p v b hprevne B a heq + exact hprevne (p.injective (by simpa [a, B, v] using heq)) + +private theorem hcB : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), (b + 1 ≠ b) → ( + let B := v b + let c := v (b + 1) + c ≠ B) ) := by + classical + intro n p v b hnextne B c heq + exact hnextne (p.injective (by simpa [c, B, v] using heq)) + +private theorem hellu : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + ∀ (b : Fin (n + (3 : ℕ))), + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + (∀ i : Fin (n + 3), i ≠ b → ell (v i) < ell (v b)) → ((b - 1 ≠ b) → ( + let B := v b + let a := v (b - 1) + let u : Real × Real := a - B + ell u < 0)) ) := by + classical + intro n p v f hqexists q b ell hstrict hprevne B a u + let c := v (b + 1) + have hh := hstrict (b - 1) hprevne + calc + ell u = ell (a - B) := rfl + _ = ell a - ell B := map_sub ell a B + _ < 0 := by simpa [a, B, v] using hh + +private theorem hellw : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + ∀ (b : Fin (n + (3 : ℕ))), + let c := v (b + 1) + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + (∀ i : Fin (n + 3), i ≠ b → ell (v i) < ell (v b)) → ((b + 1 ≠ b) → ( + let B := v b + let w : Real × Real := c - B + ell w < 0)) ) := by + classical + intro n p v f hqexists q b c ell hstrict hnextne B w + have hh := hstrict (b + 1) hnextne + calc + ell w = ell (c - B) := rfl + _ = ell c - ell B := map_sub ell c B + _ < 0 := by simpa [c, B, v] using hh + +private theorem hlineMap : + (by + classical + exact + ∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x y t = x + t • (y - x) ) := by + classical + intro x y t + rw [AffineMap.lineMap_apply_module] + module + +private theorem hcrosszero : + (by + classical + exact + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ x y : Real × Real, x ≠ 0 → cross x y = 0 → ∃ t : Real, y = t • x ) := by + classical + intro cross x y hx hxy + by_cases hx1 : x.1 = 0 + · have hx2 : x.2 ≠ 0 := by + intro h + apply hx + exact Prod.ext hx1 h + have hy1 : y.1 = 0 := by + dsimp [cross] at hxy + rw [hx1] at hxy + have hprod : x.2 * y.1 = 0 := by nlinarith + rcases mul_eq_zero.mp hprod with h | h + · exact (hx2 h).elim + · exact h + refine ⟨y.2 / x.2, ?_⟩ + ext + · simp [hx1, hy1] + · simp + field_simp + · refine ⟨y.1 / x.1, ?_⟩ + have hdet : x.1 * y.2 = x.2 * y.1 := by + dsimp [cross] at hxy + linarith + ext + · simp + field_simp + · simp + field_simp + nlinarith [hdet] + +private theorem hdetAt218 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + ∀ (b : Fin (n + (3 : ℕ))), + let c := v (b + 1) + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + (b - 1 + 1 = b) → ((b - 1 ≠ b) → ( + let B := v b + let a := v (b - 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + (u ≠ 0) → ((w ≠ 0) → ((ell u < 0) → ((ell w < 0) → ((∀ x y : Real × Real, ∀ t : Real, + AffineMap.lineMap x y t = x + t • (y - x)) → ( + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + (∀ x y : Real × Real, x ≠ 0 → cross x y = 0 → ∃ t : Real, y = t • x) → (cross u w ≠ + 0)))))))) ) := by + classical + intro n p v f hqexists q b c ell hprev hprevne B a u w hu hw hellu hellw hlineMap cross + hcrosszero hzero + obtain ⟨t, htw⟩ := hcrosszero u w hu hzero + have hmap : ell w = t * ell u := by + rw [htw, map_smul] + simp only [smul_eq_mul] + have htpos : 0 < t := by nlinarith [hellu, hellw, hmap] + let s := 1 / (2 * t + 2) + have hs : 0 < s := by dsimp [s]; positivity + have hts : 0 < t * s := mul_pos htpos hs + have htslt : t * s < 1 := by + dsimp [s] + have hden : 0 < 2 * t + 2 := by positivity + rw [show t * (1 / (2 * t + 2)) = t / (2 * t + 2) by ring] + rw [div_lt_iff₀ hden] + nlinarith + have hslt : s < 1 := by + dsimp [s] + have hden : 0 < 2 * t + 2 := by positivity + rw [div_lt_iff₀ hden] + nlinarith + let z : Real × Real := B + s • w + have hzw : z = B + (t * s) • u := by + dsimp [z] + rw [htw, smul_smul] + congr 1 + ring + have hseg₁ : z ∈ segment Real B c := by + have hh := lineMap_mem_segment Real B c (show s ∈ Set.Icc 0 1 from ⟨hs.le, hslt.le⟩) + rw [hlineMap] at hh + simpa [z, w, c, B] using hh + have hseg₂ : z ∈ segment Real B a := by + have hh := lineMap_mem_segment Real B a + (show t * s ∈ Set.Icc 0 1 from ⟨hts.le, htslt.le⟩) + rw [hlineMap] at hh + rw [hzw] + simpa [u] using hh + have hinter : z ∈ segment Real a B ∩ segment Real B c := by + have hseg₂' : z ∈ segment Real a B := by + rw [← segment_symm Real B a] + exact hseg₂ + exact ⟨hseg₂', hseg₁⟩ + have hlaw := p.edge_intersection (b - 1) b hprevne + have hinter' : z ∈ segment Real (v (b - 1)) (v ((b - 1) + 1)) ∩ + segment Real (v b) (v (b + 1)) := by + simpa [a, B, c, v, hprev] using hinter + rw [hlaw] at hinter' + have hend : (z = a ∨ z = B) ∧ (z = B ∨ z = c) := by + simpa [a, B, c, v, hprev] using hinter' + have hzneB : z ≠ B := by + intro hz + have hmul : s • w = 0 := by + have hh := congrArg (fun x : Real × Real => x - B) hz + simpa [z] using hh + rcases (smul_eq_zero.mp hmul) with hs0 | hw0 + · exact (ne_of_gt hs) hs0 + · exact hw hw0 + have hzneC : z ≠ c := by + intro hz + have hmul : (s - 1) • w = 0 := by + have hh := congrArg (fun x : Real × Real => x - B) hz + have hh' : s • w = w := by simpa [z, c, w, B] using hh + calc + (s - 1) • w = s • w - 1 • w := sub_smul s 1 w + _ = w - w := by rw [hh', one_smul] + _ = 0 := sub_self _ + rcases (smul_eq_zero.mp hmul) with hs1 | hw0 + · linarith [hslt] + · exact hw hw0 + rcases hend.2 with hzB | hzC + · exact hzneB hzB + · exact hzneC hzC + +private theorem htriangle : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + (cross u w ≠ 0) → (P3381T1TriangleDeterminant ![a, B, c] ≠ 0) ) := by + classical + intro n p v b B a c u w cross hdet hz + have hrel : cross u w = + -P3381T1TriangleDeterminant ![a, B, c] := by + simp [P3381T1TriangleDeterminant, cross, u, w, a, B, c] + ring + have hz' : cross u w = 0 := by + rw [hrel] + have hzero : P3381T1TriangleDeterminant ![a, B, c] = 0 := by + simpa [P3381T1TriangleDeterminant] using hz + rw [hzero] + ring + exact hdet hz' + +private theorem hD : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + (P3381T1TriangleDeterminant ![a, B, c] ≠ 0) → ( + let D := cross (c - a) (B - a) + D ≠ 0) ) := by + classical + intro n p v b B a c cross htriangle D hzero + apply htriangle + have hrel : P3381T1TriangleDeterminant ![a, B, c] = -D := by + simp [P3381T1TriangleDeterminant, D, cross, a, B, c] + ring + rw [hrel, hzero] + simp + +private theorem hFaff : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let D := cross (c - a) (B - a) + let L : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => cross (c - a) x * D⁻¹ + map_add' := by intro x y; simp [cross]; ring + map_smul' := by intro t x; simp [cross]; ring } + let F : (Real × Real) → Real := fun x => L (x - a) + ∀ x : Real × Real, F x = L (x -ᵥ a) +ᵥ F a ) := by + classical + intro n p v b B a c cross D L F x + simp [F] + +private theorem hFc : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let D := cross (c - a) (B - a) + let L : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => cross (c - a) x * D⁻¹ + map_add' := by intro x y; simp [cross]; ring + map_smul' := by intro t x; simp [cross]; ring } + let F : (Real × Real) → Real := fun x => L (x - a) + F c = 0 ) := by + classical + intro n p v b B a c cross D L F + simp? [F, L, cross] + left + ring + +private theorem hFB : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let D := cross (c - a) (B - a) + (D ≠ 0) → ( + let L : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => cross (c - a) x * D⁻¹ + map_add' := by intro x y; simp [cross]; ring + map_smul' := by intro t x; simp [cross]; ring } + let F : (Real × Real) → Real := fun x => L (x - a) + F B = 1)) := by + classical + intro n p v b B a c cross D hD L F + dsimp [F, L, D] + rw [mul_inv_cancel₀ hD] + +private theorem hsegcompact : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ j : Fin (n + 3), IsCompact (segment Real (v j) (v (j + 1))) ) := by + classical + intro n p v j + rw [segment_eq_image_lineMap] + exact isCompact_Icc.image AffineMap.lineMap_continuous + +private theorem hKcompact : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), (∀ j : Fin (n + 3), IsCompact (segment Real (v j) (v (j + + 1)))) → ( + let J : Set (Fin (n + 3)) := {j | j ≠ b ∧ j + 1 ≠ b} + let K : Set (Real × Real) := ⋃ j ∈ J, + segment Real (v j) (v (j + 1)) + IsCompact K) ) := by + classical + intro n p v b hsegcompact J K + dsimp [K] + exact (Set.toFinite J).isCompact_biUnion fun j hj => hsegcompact j + +private theorem hBnotK : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let J : Set (Fin (n + 3)) := {j | j ≠ b ∧ j + 1 ≠ b} + let K : Set (Real × Real) := ⋃ j ∈ J, + segment Real (v j) (v (j + 1)) + B ∉ K ) := by + classical + intro n p v b B J K hBK + obtain ⟨j, hj⟩ := Set.mem_iUnion.mp hBK + obtain ⟨hjJ, hBj⟩ := Set.mem_iUnion.mp hj + have hleft : B ∈ segment Real (v b) (v (b + 1)) := by + exact left_mem_segment Real _ _ + have hinter : B ∈ segment Real (v b) (v (b + 1)) ∩ + segment Real (v j) (v (j + 1)) := ⟨hleft, hBj⟩ + rw [p.edge_intersection b j hjJ.1.symm] at hinter + have hend : (B = v b ∨ B = v (b + 1)) ∧ + (B = v j ∨ B = v (j + 1)) := by simpa using hinter + rcases hend.2 with hj0 | hj1 + · have heq : b = j := p.injective (by simpa [B, v] using hj0) + exact hjJ.1 heq.symm + · have heq : b = j + 1 := p.injective (by simpa [B, v] using hj1) + exact hjJ.2 heq.symm + +private theorem haddinj : + (by + classical + exact + ∀ (n : Nat), ∀ x y : Fin (n + 3), x + 1 = y + 1 → x = y ) := by + classical + intro n x y hxy + exact add_right_cancel hxy + +private theorem hcarrierLocal : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), (b - 1 + 1 = b) → ( + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let C := P3544T1BoundaryCarrier p + let J : Set (Fin (n + 3)) := {j | j ≠ b ∧ j + 1 ≠ b} + let K : Set (Real × Real) := ⋃ j ∈ J, + segment Real (v j) (v (j + 1)) + ∀ (rK : ℝ), (Metric.ball B rK ⊆ Kᶜ) → ( + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (r ≤ rK) → ((∀ x y : Fin (n + 3), x + 1 = y + 1 → x = y) → (∀ x : Real × Real, x ∈ + Metric.ball B r → (x ∈ C ↔ x ∈ segment Real B c ∨ x ∈ segment Real a B))))) ) := by + classical + intro n p v b hprev B a c C J K rK hballK r hrKle haddinj x hx + constructor + · intro hxC + obtain ⟨j, hj⟩ := Set.mem_iUnion.mp hxC + by_cases hjb : j = b + · left + simpa [hjb, B, c, v] using hj + · by_cases hjnext : j + 1 = b + · have hjprev : j = b - 1 := by + apply haddinj + rw [hjnext, hprev] + right + simpa [hjprev, a, B, v, hprev] using hj + · have hjJ : j ∈ J := ⟨hjb, hjnext⟩ + have hxK : x ∈ K := Set.mem_iUnion.mpr ⟨j, Set.mem_iUnion.mpr ⟨hjJ, hj⟩⟩ + have hxKc : x ∈ Kᶜ := hballK (Metric.ball_subset_ball hrKle hx) + exact (hxKc hxK).elim + · rintro (hx | hx) + · exact Set.mem_iUnion.mpr ⟨b, by simpa [B, c, v] using hx⟩ + · exact Set.mem_iUnion.mpr ⟨b - 1, by + simpa [a, B, v, hprev] using hx⟩ + +private theorem hsegParam : + (by + classical + exact + (∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x y t = x + t • (y - x)) → (∀ x y z : + Real × Real, z ∈ segment Real x y → ∃ t : Real, t ∈ Set.Icc 0 1 ∧ z = x + t • (y - + x)) ) := by + classical + intro hlineMap x y z hz + rw [segment_eq_image_lineMap] at hz + obtain ⟨t, ht, hzt⟩ := hz + refine ⟨t, ht, ?_⟩ + rw [← hzt, hlineMap] + +private theorem hcrossLinear : + (by + classical + exact + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ z : Real × Real, IsLinearMap Real (cross z) ) := by + classical + intro cross z + refine IsLinearMap.mk ?_ ?_ + · intro x y + dsimp [cross] + ring + · intro t x + dsimp [cross] + ring + +private theorem hcrossSelf : + (by + classical + exact + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ z : Real × Real, cross z z = 0 ) := by + classical + intro cross z + dsimp [cross] + ring + +private theorem hcarrierCross : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let C := P3544T1BoundaryCarrier p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (∀ x : Real × Real, x ∈ Metric.ball B r → (x ∈ C ↔ x ∈ segment Real B c ∨ x ∈ segment + Real a B)) → ((∀ x y z : Real × Real, z ∈ segment Real x y → ∃ t : Real, t ∈ Set.Icc + 0 1 ∧ z = x + t • (y - x)) → ((∀ z : Real × Real, IsLinearMap Real (cross z)) → (∀ x + : Real × Real, x ∈ Metric.ball B r → x ∈ C → cross u (x - B) = 0 ∨ cross w (x - B) = + 0))) ) := by + classical + intro n p v b B a c u w cross C rK r hcarrierLocal hsegParam hcrossLinear x hx hxC + rcases (hcarrierLocal x hx).mp hxC with hxc | hxa + · obtain ⟨t, ht, hform⟩ := hsegParam B c x hxc + right + have hdiff : x - B = t • w := by + rw [hform] + dsimp [w, c, B] + module + rw [hdiff, (hcrossLinear w).map_smul] + change t * cross w w = 0 + rw [show cross w w = 0 by simp [cross]; ring] + simp + · obtain ⟨t, ht, hform⟩ := hsegParam a B x hxa + left + have hdiff : x - B = (1 - t) • u := by + rw [hform] + dsimp [u, a, B] + module + rw [hdiff] + rw [(hcrossLinear u).map_smul] + change (1 - t) * cross u u = 0 + rw [show cross u u = 0 by simp [cross]; ring] + simp + +private theorem hUV : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + (cross w u = -cross u w) → ((0 < cross u w ∨ cross u w < 0) → ( + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + 0 < cross U V)) ) := by + classical + intro n p v b B a c u w cross hswap hpos U V + rcases hpos with hp | hn + · simp [U, V, hp] + · have hnp : ¬ 0 < cross u w := not_lt_of_gt hn + simpa [U, V, hnp, hswap] using neg_pos.mpr hn + +private theorem hUne : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + (u ≠ 0) → ((w ≠ 0) → ( + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let U := if 0 < cross u w then u else w + U ≠ 0)) ) := by + classical + intro n p v b B a c u w hu hw cross U + by_cases hp : 0 < cross u w + · simpa [U, hp] using hu + · simpa [U, hp] using hw + +private theorem hVne : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + (u ≠ 0) → ((w ≠ 0) → ( + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let V := if 0 < cross u w then w else u + V ≠ 0)) ) := by + classical + intro n p v b B a c u w hu hw cross V + by_cases hp : 0 < cross u w + · simpa [V, hp] using hw + · simpa [V, hp] using hu + +private theorem hdecomp : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + (0 < cross U V) → (∀ z : Real × Real, z = (-cross V z / cross U V) • U + (cross U z / + cross U V) • V) ) := by + classical + intro n p v b B a c u w cross U V hUV z + apply Prod.ext + · have hcoeff : -cross V z * U.1 + cross U z * V.1 = + z.1 * cross U V := by dsimp [cross]; ring + calc + z.1 = z.1 * (cross U V * (cross U V)⁻¹) := by + rw [mul_inv_cancel₀ (ne_of_gt hUV)] + ring + _ = (-cross V z * U.1 + cross U z * V.1) * (cross U V)⁻¹ := by + rw [hcoeff] + ring + _ = (-cross V z / cross U V) * U.1 + + (cross U z / cross U V) * V.1 := by + rw [div_eq_mul_inv, div_eq_mul_inv] + ring + · have hcoeff : -cross V z * U.2 + cross U z * V.2 = + z.2 * cross U V := by dsimp [cross]; ring + calc + z.2 = z.2 * (cross U V * (cross U V)⁻¹) := by + rw [mul_inv_cancel₀ (ne_of_gt hUV)] + ring + _ = (-cross V z * U.2 + cross U z * V.2) * (cross U V)⁻¹ := by + rw [hcoeff] + ring + _ = (-cross V z / cross U V) * U.2 + + (cross U z / cross U V) * V.2 := by + rw [div_eq_mul_inv, div_eq_mul_inv] + ring + +private theorem hconeUV : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + (cross u w ≠ 0) → ((∀ z : Real × Real, IsLinearMap Real (cross z)) → ( + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + (0 < cross U V) → ((∀ z : Real × Real, z = (-cross V z / cross U V) • U + (cross U z / + cross U V) • V) → (∀ x : Real × Real, (∃ s t : Real, 0 < s ∧ 0 < t ∧ x = B + s • u + + t • w) ↔ (0 < cross U (x - B) ∧ cross V (x - B) < 0))))) ) := by + classical + intro n p v b B a c u w cross hdet hcrossLinear U V hUV hdecomp x + constructor + · rintro ⟨s, t, hs, ht, rfl⟩ + by_cases hp : 0 < cross u w + · have hA : cross U (s • u + t • w) = t * cross U V := by + rw [show U = u by simp [U, hp], show V = w by simp [V, hp]] + rw [(hcrossLinear u).map_add, (hcrossLinear u).map_smul, + (hcrossLinear u).map_smul] + simp only [smul_eq_mul] + dsimp [cross] + ring + have hB : cross V (s • u + t • w) = -(s * cross U V) := by + rw [show U = u by simp [U, hp], show V = w by simp [V, hp]] + rw [(hcrossLinear w).map_add, (hcrossLinear w).map_smul, + (hcrossLinear w).map_smul] + simp only [smul_eq_mul] + dsimp [cross] + ring + constructor + · have hpoint : B + s • u + t • w - B = s • u + t • w := by abel + rw [hpoint, hA] + exact mul_pos ht hUV + · have hpoint : B + s • u + t • w - B = s • u + t • w := by abel + rw [hpoint, hB] + exact neg_neg_of_pos (mul_pos hs hUV) + · have hn : cross u w < 0 := lt_of_le_of_ne (le_of_not_gt hp) hdet + have hA : cross U (t • w + s • u) = s * cross U V := by + rw [show U = w by simp [U, hp], show V = u by simp [V, hp]] + rw [(hcrossLinear w).map_add, (hcrossLinear w).map_smul, + (hcrossLinear w).map_smul] + simp only [smul_eq_mul] + dsimp [cross] + ring + have hB : cross V (t • w + s • u) = -(t * cross U V) := by + rw [show U = w by simp [U, hp], show V = u by simp [V, hp]] + rw [(hcrossLinear u).map_add, (hcrossLinear u).map_smul, + (hcrossLinear u).map_smul] + simp only [smul_eq_mul] + dsimp [cross] + ring + constructor + · have he : B + s • u + t • w - B = t • w + s • u := by abel + rw [he, hA] + exact mul_pos hs hUV + · have he : B + s • u + t • w - B = t • w + s • u := by abel + rw [he, hB] + exact neg_neg_of_pos (mul_pos ht hUV) + · rintro ⟨hA, hB⟩ + have hz := hdecomp (x - B) + let s := -cross V (x - B) / cross U V + let t := cross U (x - B) / cross U V + have hs : 0 < s := by dsimp [s]; exact div_pos (neg_pos.mpr hB) hUV + have ht : 0 < t := by dsimp [t]; exact div_pos hA hUV + have hz' : x - B = s • U + t • V := by simpa [s, t] using hdecomp (x - B) + have hx : x = B + s • U + t • V := by + calc + x = B + (x - B) := by abel + _ = B + (s • U + t • V) := by rw [hz'] + _ = B + s • U + t • V := by abel + by_cases hp : 0 < cross u w + · refine ⟨s, t, hs, ht, ?_⟩ + simpa [U, V, hp, add_assoc] using hx + · refine ⟨t, s, ht, hs, ?_⟩ + calc + x = B + s • U + t • V := hx + _ = B + s • w + t • u := by simp [U, V, hp] + _ = B + t • u + s • w := by abel + +private theorem hsmallScale : + (by + classical + exact + ∀ z : Real × Real, ∀ δ : Real, 0 < δ → ∃ t : Real, 0 < t ∧ t • z ∈ Metric.ball (0 : Real + × Real) δ ) := by + classical + intro z δ hδ + let t := δ / (‖z‖ + 1) + have ht : 0 < t := by dsimp [t]; positivity + have hn : ‖t • z‖ < δ := by + rw [norm_smul, Real.norm_eq_abs, abs_of_pos ht] + dsimp [t] + have hd : 0 < ‖z‖ + 1 := by positivity + rw [div_mul_eq_mul_div, div_lt_iff₀ hd] + nlinarith [norm_nonneg z] + have hmem : t • z ∈ Metric.ball (0 : Real × Real) δ := by + rw [Metric.mem_ball, dist_eq_norm] + have he : (t • z : Real × Real) - 0 = t • z := by ext <;> simp + rw [he] + exact hn + exact ⟨t, ht, hmem⟩ + +private theorem hconstOn : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + (∀ x ∉ P3544T1BoundaryCarrier p, ∃ (r : ℝ), (0 : ℝ) < r ∧ (Metric.ball x r ⊆ + P3544T1RayParity p ∨ Disjoint (Metric.ball x r) (P3544T1RayParity p))) → (∀ S : + Set (Real × Real), IsConnected S → (∀ x, x ∈ S → x ∉ C) → ∀ x, x ∈ S → ∀ y, y ∈ S → + (x ∈ O ↔ y ∈ O)) ) := by + classical + intro n p O C hlocal S hconn hSC x hx y hy + let f : S → Bool := fun z => decide ((z : Real × Real) ∈ O) + have hf : IsLocallyConstant f := by + rw [IsLocallyConstant.iff_exists_open] + intro z + obtain ⟨ρ, hρ, hstable⟩ := hlocal z.1 (hSC z.1 z.2) + let V : Set S := Subtype.val ⁻¹' Metric.ball z.1 ρ + refine ⟨V, Metric.isOpen_ball.preimage continuous_subtype_val, + Metric.mem_ball_self hρ, ?_⟩ + intro z' hz' + have hzball : (z' : Real × Real) ∈ Metric.ball z.1 ρ := hz' + have heq : decide ((z' : Real × Real) ∈ O) = decide (z.1 ∈ O) := by + rcases hstable with hsub | hdis + · have hzO : z.1 ∈ O := hsub (Metric.mem_ball_self hρ) + have hz'O : (z' : Real × Real) ∈ O := hsub hzball + simp [hzO, hz'O] + · have hzO : z.1 ∉ O := by + intro hmem + exact (Set.disjoint_left.mp hdis (Metric.mem_ball_self hρ)) hmem + have hz'O : (z' : Real × Real) ∉ O := by + intro hmem + exact (Set.disjoint_left.mp hdis hzball) hmem + simp [hzO, hz'O] + simpa [f] using heq + have hfcont : ContinuousOn (fun z : Real × Real => decide (z ∈ O)) S := by + apply continuousOn_iff_continuous_domRestrict.mpr + change Continuous f + exact hf.continuous + let : PreconnectedSpace S := isPreconnected_iff_preconnectedSpace.mp hconn.2 + have heq := hf.apply_eq_of_preconnectedSpace ⟨x, hx⟩ ⟨y, hy⟩ + change decide (x ∈ O) = decide (y ∈ O) at heq + by_cases hxo : x ∈ O <;> by_cases hyo : y ∈ O <;> simp [hxo, hyo] at heq ⊢ + +private theorem hNconvex : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (∀ z : Real × Real, IsLinearMap Real (cross z)) → ( + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + let N0 : Set (Real × Real) := {z | z ∈ Metric.ball 0 r ∧ + 0 < cross U z ∧ cross V z < 0} + Convex Real N0) ) := by + classical + intro n p v b B a c u w cross rK r hcrossLinear U V N0 + exact (convex_ball 0 r).inter + ((convex_halfSpace_gt (hcrossLinear U) 0).inter + (convex_halfSpace_lt (hcrossLinear V) 0)) + +private theorem hN0ne : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (∀ z : Real × Real, IsLinearMap Real (cross z)) → ( + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + (0 < cross U V) → ( + let N0 : Set (Real × Real) := {z | z ∈ Metric.ball 0 r ∧ + 0 < cross U z ∧ cross V z < 0} + let z0 := U + V + (cross U z0 = cross U V) → ((cross V z0 = -cross U V) → (∀ (τ : ℝ), ((0 : ℝ) < τ) → ((τ • + z0 ∈ Metric.ball (0 : ℝ × ℝ) r) → (N0.Nonempty)))))) ) := by + classical + intro n p v b B a c u w cross rK r hcrossLinear U V hUV N0 z0 hz0U hz0V τ hτ hτball + refine ⟨τ • z0, ?_, ?_, ?_⟩ + · exact hτball + · rw [(hcrossLinear U).map_smul] + rw [hz0U] + exact mul_pos hτ hUV + · rw [(hcrossLinear V).map_smul] + rw [hz0V] + change τ * (-cross U V) < 0 + exact mul_neg_of_pos_of_neg hτ (neg_neg_of_pos hUV) + +private theorem hτnegBall : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + let z0 := U + V + ∀ (τ : ℝ), (τ • z0 ∈ Metric.ball (0 : ℝ × ℝ) r) → (-(τ • z0) ∈ Metric.ball (0 : Real × + Real) r) ) := by + classical + intro n p v b B a c u w cross rK r U V z0 τ hτball + have hh := hτball + rw [Metric.mem_ball, dist_eq_norm] at hh ⊢ + have he : (τ • z0 : Real × Real) - 0 = τ • z0 := by ext <;> simp + have he' : (-(τ • z0) : Real × Real) - 0 = -(τ • z0) := by ext <;> simp + rw [he] at hh + rw [he'] + simpa [norm_neg] using hh + +private theorem hnegU : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + (∀ z : Real × Real, IsLinearMap Real (cross z)) → ( + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + (0 < cross U V) → ( + let z0 := U + V + (cross U z0 = cross U V) → (∀ (τ : ℝ), ((0 : ℝ) < τ) → (cross U (-(τ • z0)) < 0)))) ) := by + classical + intro n p v b B a c u w cross hcrossLinear U V hUV z0 hz0U τ hτ + rw [(hcrossLinear U).map_neg, (hcrossLinear U).map_smul, hz0U] + change -(τ * cross U V) < 0 + exact neg_neg_of_pos (mul_pos hτ hUV) + +private theorem hposV : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + (∀ z : Real × Real, IsLinearMap Real (cross z)) → ( + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + (0 < cross U V) → ( + let z0 := U + V + (cross V z0 = -cross U V) → (∀ (τ : ℝ), ((0 : ℝ) < τ) → (0 < cross V (-(τ • z0)))))) ) := by + classical + intro n p v b B a c u w cross hcrossLinear U V hUV z0 hz0V τ hτ + rw [(hcrossLinear V).map_neg, (hcrossLinear V).map_smul, hz0V] + change 0 < - (τ * -cross U V) + nlinarith [mul_pos hτ hUV] + +private theorem himageN : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + let N0 : Set (Real × Real) := {z | z ∈ Metric.ball 0 r ∧ + 0 < cross U z ∧ cross V z < 0} + let N : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + 0 < cross U (x - B) ∧ cross V (x - B) < 0} + (fun z : Real × Real => B + z) '' N0 = N ) := by + classical + intro n p v b B a c u w cross rK r U V N0 N + ext x + constructor + · rintro ⟨z, hz, rfl⟩ + rcases hz with ⟨hzball, hzu, hzw⟩ + refine ⟨?_, ?_, ?_⟩ + · rw [Metric.mem_ball, dist_eq_norm] at hzball ⊢ + have he : (B + z : Real × Real) - B = z := by abel + rw [he] + simpa using hzball + · have he : (B + z : Real × Real) - B = z := by abel + rw [he] + exact hzu + · have he : (B + z : Real × Real) - B = z := by abel + rw [he] + exact hzw + · rintro ⟨hxball, hxu, hxw⟩ + refine ⟨x - B, ?_, by abel⟩ + refine ⟨?_, ?_, ?_⟩ + · rw [Metric.mem_ball, dist_eq_norm] at hxball ⊢ + have he : (x - B : Real × Real) - 0 = x - B := by ext <;> simp + rw [he] + exact hxball + · exact hxu + · exact hxw + +private theorem himageW : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + let W1 : Set (Real × Real) := {z | z ∈ Metric.ball 0 r ∧ cross U z < 0} + let W2 : Set (Real × Real) := {z | z ∈ Metric.ball 0 r ∧ 0 < cross V z} + let W0 : Set (Real × Real) := W1 ∪ W2 + let W : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + (cross U (x - B) < 0 ∨ 0 < cross V (x - B))} + (fun z : Real × Real => B + z) '' W0 = W ) := by + classical + intro n p v b B a c u w cross rK r U V W1 W2 W0 W + ext x + constructor + · rintro ⟨z, hz, rfl⟩ + rcases hz with hz | hz + · rcases hz with ⟨hzball, hzu⟩ + refine ⟨?_, Or.inl ?_⟩ + · rw [Metric.mem_ball, dist_eq_norm] at hzball ⊢ + have he : (B + z : Real × Real) - B = z := by abel + rw [he] + simpa using hzball + · have he : (B + z : Real × Real) - B = z := by abel + rw [he] + exact hzu + · rcases hz with ⟨hzball, hzw⟩ + refine ⟨?_, Or.inr ?_⟩ + · rw [Metric.mem_ball, dist_eq_norm] at hzball ⊢ + have he : (B + z : Real × Real) - B = z := by abel + rw [he] + simpa using hzball + · have he : (B + z : Real × Real) - B = z := by abel + rw [he] + exact hzw + · rintro ⟨hxball, hsign⟩ + refine ⟨x - B, ?_, by abel⟩ + have hx0 : x - B ∈ Metric.ball (0 : Real × Real) r := by + rw [Metric.mem_ball, dist_eq_norm] at hxball ⊢ + have he : (x - B : Real × Real) - 0 = x - B := by ext <;> simp + rw [he] + exact hxball + rcases hsign with hsign | hsign + · exact Or.inl ⟨hx0, hsign⟩ + · exact Or.inr ⟨hx0, hsign⟩ + +private theorem hsegmentHeight : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + ∀ (b : Fin (n + (3 : ℕ))), + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + (∀ x' ∈ Finset.univ, (ell : ℝ × ℝ → ℝ) (v x') ≤ (ell : ℝ × ℝ → ℝ) (v b)) → ( + let B := v b + (∀ x y z : Real × Real, z ∈ segment Real x y → ∃ t : Real, t ∈ Set.Icc 0 1 ∧ z = x + t • + (y - x)) → (∀ i : Fin (n + 3), ∀ x : Real × Real, x ∈ segment Real (v i) (v (i + 1)) + → ell x ≤ ell B)) ) := by + classical + intro n p v f hqexists q b ell hmax B hsegParam i x hx + let c := v (b + 1) + obtain ⟨t, ht, hform⟩ := hsegParam (v i) (v (i + 1)) x hx + have hvalue : ell x = (1 - t) * ell (v i) + t * ell (v (i + 1)) := by + rw [hform, map_add, map_smul, map_sub] + simp only [smul_eq_mul] + ring + have hi := hmax i (Finset.mem_univ i) + have hinext := hmax (i + 1) (Finset.mem_univ (i + 1)) + calc + ell x = (1 - t) * ell (v i) + t * ell (v (i + 1)) := hvalue + _ ≤ (1 - t) * ell B + t * ell B := by + apply add_le_add + · exact mul_le_mul_of_nonneg_left hi (sub_nonneg.mpr ht.2) + · exact mul_le_mul_of_nonneg_left hinext ht.1 + _ = ell B := by ring + +private theorem hellCarrier : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + ∀ (b : Fin (n + (3 : ℕ))), + let c := v (b + 1) + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + (b - 1 + 1 = b) → ( + let B := v b + let a := v (b - 1) + let C := P3544T1BoundaryCarrier p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (∀ x : Real × Real, x ∈ Metric.ball B r → (x ∈ C ↔ x ∈ segment Real B c ∨ x ∈ segment + Real a B)) → ((∀ i : Fin (n + 3), ∀ x : Real × Real, x ∈ segment Real (v i) (v (i + + 1)) → ell x ≤ ell B) → (∀ x : Real × Real, x ∈ Metric.ball B r → x ∈ C → ell x ≤ ell + B))) ) := by + classical + intro n p v f hqexists q b c ell hprev B a C rK r hcarrierLocal hsegmentHeight x hx hxC + rcases (hcarrierLocal x hx).mp hxC with hxc | hxa + · exact hsegmentHeight b x (by simpa [B, c, v] using hxc) + · have hprevseg : x ∈ segment Real (v (b - 1)) (v ((b - 1) + 1)) := by + simpa [a, B, v, hprev] using hxa + exact hsegmentHeight (b - 1) x hprevseg + +private theorem hradialDist : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + ∀ d : Real × Real, ∀ t : Real, 0 ≤ t → dist (B + t • d) B = t * dist (B + d) B ) := by + classical + intro n p v b B d t ht + rw [dist_eq_norm, dist_eq_norm] + have he : B + t • d - B = t • d := by abel + have he' : B + d - B = d := by abel + rw [he, he', norm_smul, Real.norm_eq_abs, abs_of_nonneg ht] + +private theorem hUendpoint : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let U := if 0 < cross u w then u else w + B + U = a ∨ B + U = c ) := by + classical + intro n p v b B a c u w cross U + by_cases hp : 0 < cross u w + · left + simp [U, hp, B, a, u] + · right + simp [U, hp, B, c, w] + +private theorem hVendpoint : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let V := if 0 < cross u w then w else u + B + V = a ∨ B + V = c ) := by + classical + intro n p v b B a c u w cross V + by_cases hp : 0 < cross u w + · right + simp [V, hp, B, c, w] + · left + simp [V, hp, B, a, u] + +private theorem hUdist : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (r < dist B a) → ((r < dist B c) → ( + let U := if 0 < cross u w then u else w + (B + U = a ∨ B + U = c) → (r < dist (B + U) B))) ) := by + classical + intro n p v b B a c u w cross rK r hrA hrC U hUendpoint + rcases hUendpoint with h | h + · rw [h, dist_comm] + exact hrA + · rw [h, dist_comm] + exact hrC + +private theorem hVdist : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (r < dist B a) → ((r < dist B c) → ( + let V := if 0 < cross u w then w else u + (B + V = a ∨ B + V = c) → (r < dist (B + V) B))) ) := by + classical + intro n p v b B a c u w cross rK r hrA hrC V hVendpoint + rcases hVendpoint with h | h + · rw [h, dist_comm] + exact hrA + · rw [h, dist_comm] + exact hrC + +private theorem haxisU : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + (∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x y t = x + t • (y - x)) → ( + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let C := P3544T1BoundaryCarrier p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (0 < r) → ((∀ x : Real × Real, x ∈ Metric.ball B r → (x ∈ C ↔ x ∈ segment Real B c ∨ x ∈ + segment Real a B)) → ( + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + (0 < cross U V) → ((∀ z : Real × Real, z = (-cross V z / cross U V) • U + (cross U z / + cross U V) • V) → ((∀ d : Real × Real, ∀ t : Real, 0 ≤ t → dist (B + t • d) B = t * + dist (B + d) B) → ((B + U = a ∨ B + U = c) → ((r < dist (B + U) B) → (∀ x : Real × + Real, x ∈ Metric.ball B r → cross U (x - B) = 0 → cross V (x - B) ≤ 0 → x ∈ C)))))))) + ) := by + classical + intro n p v b B a c u w hlineMap cross C rK r hr hcarrierLocal U V hUV hdecomp hradialDist + hUendpoint hUdist x hx hzero hle + let z := x - B + let s := -cross V z / cross U V + have hz : z = s • U := by + have hh := hdecomp z + have hzero' : cross U z = 0 := by simpa [z] using hzero + rw [hzero'] at hh + simp only [zero_div, zero_smul, add_zero] at hh + simpa [s] using hh + have hs : 0 ≤ s := by dsimp [s]; exact div_nonneg (neg_nonneg.mpr hle) hUV.le + have hslt : s < 1 := by + by_contra hnot + have hge : 1 ≤ s := le_of_not_gt hnot + have hdistx : dist x B < r := Metric.mem_ball.mp hx + have heq : x = B + s • U := by + calc + x = B + (x-B) := by abel + _ = B + s • U := congrArg (fun z : Real × Real => B + z) (by simpa [z] using hz) + rw [heq, hradialDist U s hs] at hdistx + have hmul0 := mul_le_mul_of_nonneg_right hge + (le_of_lt (lt_trans hr hUdist)) + have hmul : dist (B + U) B ≤ s * dist (B + U) B := by + simpa only [one_mul] using hmul0 + exact (not_lt_of_ge (le_of_lt hUdist)) (lt_of_le_of_lt hmul hdistx) + have hseg : x ∈ segment Real B (B + U) := by + have hh := lineMap_mem_segment Real B (B + U) + (show s ∈ Set.Icc 0 1 from ⟨hs, hslt.le⟩) + rw [hlineMap] at hh + have heq : B + s • ((B + U) - B) = B + s • U := by congr 1; abel + rw [heq] at hh + have hxform : x = B + s • U := by + calc + x = B + (x-B) := by abel + _ = B + s • U := congrArg (fun z : Real × Real => B + z) (by simpa [z] using hz) + rw [hxform] + exact hh + rcases hUendpoint with h | h + · have hseg' : x ∈ segment Real a B := by + rw [← segment_symm Real B a] + simpa [h] using hseg + exact (hcarrierLocal x hx).mpr (Or.inr (by simpa [a, B] using hseg')) + · rw [h] at hseg + exact (hcarrierLocal x hx).mpr (Or.inl (by simpa [c, B] using hseg)) + +private theorem haxisV : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + (∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x y t = x + t • (y - x)) → ( + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let C := P3544T1BoundaryCarrier p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (0 < r) → ((∀ x : Real × Real, x ∈ Metric.ball B r → (x ∈ C ↔ x ∈ segment Real B c ∨ x ∈ + segment Real a B)) → ( + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + (0 < cross U V) → ((∀ z : Real × Real, z = (-cross V z / cross U V) • U + (cross U z / + cross U V) • V) → ((∀ d : Real × Real, ∀ t : Real, 0 ≤ t → dist (B + t • d) B = t * + dist (B + d) B) → ((B + V = a ∨ B + V = c) → ((r < dist (B + V) B) → (∀ x : Real × + Real, x ∈ Metric.ball B r → cross V (x - B) = 0 → 0 ≤ cross U (x - B) → x ∈ C)))))))) + ) := by + classical + intro n p v b B a c u w hlineMap cross C rK r hr hcarrierLocal U V hUV hdecomp hradialDist + hVendpoint hVdist x hx hzero hle + let z := x - B + let t := cross U z / cross U V + have hz : z = t • V := by + have hh := hdecomp z + have hzero' : cross V z = 0 := by simpa [z] using hzero + rw [hzero'] at hh + simp only [neg_zero, zero_div, zero_smul, zero_add] at hh + simpa [t] using hh + have ht : 0 ≤ t := by dsimp [t]; exact div_nonneg hle hUV.le + have htlt : t < 1 := by + by_contra hnot + have hge : 1 ≤ t := le_of_not_gt hnot + have hdistx : dist x B < r := Metric.mem_ball.mp hx + have heq : x = B + t • V := by + calc + x = B + (x-B) := by abel + _ = B + t • V := congrArg (fun z : Real × Real => B + z) (by simpa [z] using hz) + rw [heq, hradialDist V t ht] at hdistx + have hmul0 := mul_le_mul_of_nonneg_right hge + (le_of_lt (lt_trans hr hVdist)) + have hmul : dist (B + V) B ≤ t * dist (B + V) B := by + simpa only [one_mul] using hmul0 + exact (not_lt_of_ge (le_of_lt hVdist)) (lt_of_le_of_lt hmul hdistx) + have hseg : x ∈ segment Real B (B + V) := by + have hh := lineMap_mem_segment Real B (B + V) + (show t ∈ Set.Icc 0 1 from ⟨ht, htlt.le⟩) + rw [hlineMap] at hh + have heq : B + t • ((B + V) - B) = B + t • V := by congr 1; abel + rw [heq] at hh + have hxform : x = B + t • V := by + calc + x = B + (x-B) := by abel + _ = B + t • V := congrArg (fun z : Real × Real => B + z) (by simpa [z] using hz) + rw [hxform] + exact hh + rcases hVendpoint with h | h + · have hseg' : x ∈ segment Real a B := by + rw [← segment_symm Real B a] + simpa [h] using hseg + exact (hcarrierLocal x hx).mpr (Or.inr (by simpa [a, B] using hseg')) + · rw [h] at hseg + exact (hcarrierLocal x hx).mpr (Or.inl (by simpa [c, B] using hseg)) + +private theorem hcarrierSigns : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + (cross u w ≠ 0) → ( + let C := P3544T1BoundaryCarrier p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (∀ x : Real × Real, x ∈ Metric.ball B r → (x ∈ C ↔ x ∈ segment Real B c ∨ x ∈ segment + Real a B)) → ((∀ x y z : Real × Real, z ∈ segment Real x y → ∃ t : Real, t ∈ Set.Icc + 0 1 ∧ z = x + t • (y - x)) → ((∀ z : Real × Real, IsLinearMap Real (cross z)) → ((∀ z + : Real × Real, cross z z = 0) → ((cross w u = -cross u w) → ( + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + ∀ x, x ∈ Metric.ball B r → x ∈ C → 0 ≤ cross U (x-B) ∧ cross V (x-B) ≤ 0)))))) ) := by + classical + intro n p v b B a c u w cross hdet C rK r hcarrierLocal hsegParam hcrossLinear hcrossSelf hswap + U V x hx hxC + rcases (hcarrierLocal x hx).mp hxC with hxc | hxa + · obtain ⟨t, ht, hform⟩ := hsegParam B c x hxc + have hdiff : x-B = t • w := by rw [hform]; dsimp [w, c, B]; module + by_cases hp : 0 < cross u w + · constructor + · rw [show U = u by simp [U, hp], hdiff, (hcrossLinear u).map_smul] + change 0 ≤ t * cross u w + exact mul_nonneg ht.1 hp.le + · rw [show V = w by simp [V, hp], hdiff, (hcrossLinear w).map_smul] + rw [hcrossSelf] + simp + · have hn : cross u w < 0 := lt_of_le_of_ne (le_of_not_gt hp) hdet + constructor + · rw [show U = w by simp [U, hp], hdiff, (hcrossLinear w).map_smul] + rw [hcrossSelf] + simp + · rw [show V = u by simp [V, hp], hdiff, (hcrossLinear u).map_smul] + change t * cross u w ≤ 0 + exact mul_nonpos_of_nonneg_of_nonpos ht.1 hn.le + · obtain ⟨t, ht, hform⟩ := hsegParam a B x hxa + have hdiff : x-B = (1-t) • u := by rw [hform]; dsimp [u, a, B]; module + have hcoef : 0 ≤ 1-t := by linarith [ht.2] + by_cases hp : 0 < cross u w + · constructor + · rw [show U = u by simp [U, hp], hdiff, (hcrossLinear u).map_smul] + change 0 ≤ (1-t) * cross u u + rw [hcrossSelf] + simp + · rw [show V = w by simp [V, hp], hdiff, (hcrossLinear w).map_smul] + change (1-t) * cross w u ≤ 0 + rw [hswap] + exact mul_nonpos_of_nonneg_of_nonpos hcoef (neg_nonpos.mpr hp.le) + · have hn : cross u w < 0 := lt_of_le_of_ne (le_of_not_gt hp) hdet + constructor + · rw [show U = w by simp [U, hp], hdiff, (hcrossLinear w).map_smul] + change (1-t) * cross w u ≥ 0 + rw [hswap] + exact mul_nonneg hcoef (neg_nonneg.mpr hn.le) + · rw [show V = u by simp [V, hp], hdiff, (hcrossLinear u).map_smul] + rw [hcrossSelf] + simp + +private theorem hNoff : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let C := P3544T1BoundaryCarrier p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (∀ x : Real × Real, x ∈ Metric.ball B r → x ∈ C → cross u (x - B) = 0 ∨ cross w (x - B) = + 0) → ( + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + let N : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + 0 < cross U (x - B) ∧ cross V (x - B) < 0} + ∀ x, x ∈ N → x ∉ C) ) := by + classical + intro n p v b B a c u w cross C rK r hcarrierCross U V N x hx hc + by_cases hp : 0 < cross u w + · rcases hcarrierCross x hx.1 hc with hu0 | hw0 + · exact (ne_of_gt hx.2.1) (by simpa [U, hp] using hu0) + · exact (ne_of_lt hx.2.2) (by simpa [V, hp] using hw0) + · rcases hcarrierCross x hx.1 hc with hu0 | hw0 + · exact (ne_of_lt hx.2.2) (by simpa [V, hp] using hu0) + · exact (ne_of_gt hx.2.1) (by simpa [U, hp] using hw0) + +private theorem hWoff : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let C := P3544T1BoundaryCarrier p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + let W : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + (cross U (x - B) < 0 ∨ 0 < cross V (x - B))} + (∀ x, x ∈ Metric.ball B r → x ∈ C → 0 ≤ cross U (x-B) ∧ cross V (x-B) ≤ 0) → (∀ x, x ∈ W + → x ∉ C) ) := by + classical + intro n p v b B a c u w cross C rK r U V W hcarrierSigns x hx hc + have hs := hcarrierSigns x hx.1 hc + rcases hx.2 with hn | hp + · exact (not_lt_of_ge hs.1) hn + · exact (not_lt_of_ge hs.2) hp + +private theorem hcover : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let C := P3544T1BoundaryCarrier p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + let N : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + 0 < cross U (x - B) ∧ cross V (x - B) < 0} + let W : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + (cross U (x - B) < 0 ∨ 0 < cross V (x - B))} + (∀ x : Real × Real, x ∈ Metric.ball B r → cross U (x - B) = 0 → cross V (x - B) ≤ 0 → x ∈ + C) → ((∀ x : Real × Real, x ∈ Metric.ball B r → cross V (x - B) = 0 → 0 ≤ cross U (x + - B) → x ∈ C) → (∀ x, x ∈ Metric.ball B r → x ∉ C → x ∈ N ∨ x ∈ W)) ) := by + classical + intro n p v b B a c u w cross C rK r U V N W haxisU haxisV x hx hxC + by_cases hu : cross U (x-B) < 0 + · exact Or.inr ⟨hx, Or.inl hu⟩ + · by_cases hv : 0 < cross V (x-B) + · exact Or.inr ⟨hx, Or.inr hv⟩ + · have hu' : 0 ≤ cross U (x-B) := le_of_not_gt hu + have hv' : cross V (x-B) ≤ 0 := le_of_not_gt hv + by_cases hu0 : cross U (x-B) = 0 + · exact False.elim (hxC (haxisU x hx hu0 hv')) + · have huPos : 0 < cross U (x-B) := lt_of_le_of_ne hu' (Ne.symm hu0) + by_cases hv0 : cross V (x-B) = 0 + · exact False.elim (hxC (haxisV x hx hv0 hu')) + · have hvNeg : cross V (x-B) < 0 := lt_of_le_of_ne hv' hv0 + exact Or.inl ⟨hx, huPos, hvNeg⟩ + +private theorem hellU : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + ∀ (b : Fin (n + (3 : ℕ))), + let c := v (b + 1) + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + let B := v b + let a := v (b - 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + (ell u < 0) → ((ell w < 0) → ( + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let U := if 0 < cross u w then u else w + ell U < 0)) ) := by + classical + intro n p v f hqexists q b c ell B a u w hellu hellw cross U + by_cases hp : 0 < cross u w + · simpa [U, hp] using hellu + · simpa [U, hp] using hellw + +private theorem hellV : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + ∀ (b : Fin (n + (3 : ℕ))), + let c := v (b + 1) + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + let B := v b + let a := v (b - 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + (ell u < 0) → ((ell w < 0) → ( + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let V := if 0 < cross u w then w else u + ell V < 0)) ) := by + classical + intro n p v f hqexists q b c ell B a u w hellu hellw cross V + by_cases hp : 0 < cross u w + · simpa [V, hp] using hellw + · simpa [V, hp] using hellu + +private theorem hconeHeight : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + ∀ (b : Fin (n + (3 : ℕ))), + let c := v (b + 1) + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + let B := v b + let a := v (b - 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + (ell u < 0) → ((ell w < 0) → (∀ x : Real × Real, (∃ s t : Real, 0 < s ∧ 0 < t ∧ x = B + s + • u + t • w) → ell x < ell B)) ) := by + classical + intro n p v f hqexists q b c ell B a u w hellu hellw x hx + obtain ⟨s, t, hs, ht, rfl⟩ := hx + have hcalc : ell (B + s • u + t • w) = ell B + s * ell u + t * ell w := by + rw [map_add, map_add, map_smul, map_smul] + simp only [smul_eq_mul] + rw [hcalc] + have hsneg : s * ell u < 0 := mul_neg_of_pos_of_neg hs hellu + have htneg : t * ell w < 0 := mul_neg_of_pos_of_neg ht hellw + calc + ell B + s * ell u + t * ell w = ell B + (s * ell u + t * ell w) := by ring + _ < ell B := by + have hsum : s * ell u + t * ell w < 0 := add_neg_of_neg_of_nonpos hsneg htneg.le + simpa using add_lt_add_left hsum (ell B) + +private theorem htranslate : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + ∀ z : Real × Real, z ∈ Metric.ball (0 : Real × Real) r → B + z ∈ Metric.ball B r ) := by + classical + intro n p v b B a c rK r z hz + have he : dist (B + z) B = dist z (0 : Real × Real) := by + calc + dist (B + z) B = dist (B + z) (B + (0 : Real × Real)) := by simp + _ = dist z 0 := dist_add_left B z 0 + rw [Metric.mem_ball, he] + exact hz + +private theorem hyheight : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let e : Real × Real := (1, 0) + ∀ (ε : ℝ), + let y : Real × Real := B + ε • e + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + ((0 : ℝ) < ε) → (ell B < ell y) ) := by + classical + intro n p v f hqexists q b B e ε y ell hε + let c := v (b + 1) + have he : ell e = 1 := by simp [e, ell] + have hval : ell y = ell B + ε := by + change ell (B + ε • e) = ell B + ε + rw [map_add, map_smul, he] + simp only [smul_eq_mul, mul_one] + rw [hval] + linarith + +private theorem hynotC : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + ∀ (b : Fin (n + (3 : ℕ))), + let c := v (b + 1) + let B := v b + let e : Real × Real := (1, 0) + ∀ (ε : ℝ), + let y : Real × Real := B + ε • e + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + let a := v (b - 1) + let C := P3544T1BoundaryCarrier p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (∀ x : Real × Real, x ∈ Metric.ball B r → x ∈ C → ell x ≤ ell B) → ((y ∈ Metric.ball B r) + → ((ell B < ell y) → (y ∉ C))) ) := by + classical + intro n p v f hqexists q b c B e ε y ell a C rK r hellCarrier hyball hyheight hyC + have hle := hellCarrier y hyball hyC + exact (not_lt_of_ge hle) hyheight + +private theorem hYclass : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + ∀ (b : Fin (n + (3 : ℕ))), + let c := v (b + 1) + let B := v b + let e : Real × Real := (1, 0) + ∀ (ε : ℝ), + let y : Real × Real := B + ε • e + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + let a := v (b - 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let C := P3544T1BoundaryCarrier p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + (∀ x : Real × Real, (∃ s t : Real, 0 < s ∧ 0 < t ∧ x = B + s • u + t • w) ↔ (0 < cross U + (x - B) ∧ cross V (x - B) < 0)) → ( + let N : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + 0 < cross U (x - B) ∧ cross V (x - B) < 0} + let W : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + (cross U (x - B) < 0 ∨ 0 < cross V (x - B))} + (∀ x, x ∈ Metric.ball B r → x ∉ C → x ∈ N ∨ x ∈ W) → ((∀ x : Real × Real, (∃ s t : Real, + 0 < s ∧ 0 < t ∧ x = B + s • u + t • w) → ell x < ell B) → ((y ∈ Metric.ball B r) → + ((ell B < ell y) → ((y ∉ C) → (y ∈ W)))))) ) := by + classical + intro n p v f hqexists q b c B e ε y ell a u w cross C rK r U V hconeUV N W hcover hconeHeight + hyball hyheight hynotC + rcases hcover y hyball hynotC with hyN | hyW + · have hlt := hconeHeight y ((hconeUV y).mpr ⟨hyN.2.1, hyN.2.2⟩) + exact False.elim ((not_lt_of_ge (le_of_lt hlt)) hyheight) + · exact hyW + +private theorem hellD : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + (Fin (n + (3 : ℕ))) → ( + let e : Real × Real := (1, 0) + (ℝ) → ( + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + ∀ (d0 : ℝ × ℝ), + let T := max 0 (-ell d0 + 1) + ∀ (κ : ℝ), (κ ∈ Set.Ioi T) → ( + let d := d0 + κ • e + 0 < ell d)))) := by + classical + intro n p v f hqexists q b e ε ell d0 T κ hκT d + let B := v b + let c := v (b + 1) + let y : Real × Real := B + ε • e + have heval : ell d = ell d0 + κ := by simp [d, e, ell]; ring + have hκlarge : -ell d0 + 1 < κ := lt_of_le_of_lt (le_max_right _ _) hκT + rw [heval] + linarith + +private theorem hdv : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let e : Real × Real := (1, 0) + ∀ (ε : ℝ), + let y : Real × Real := B + ε • e + ∀ (d0 : ℝ × ℝ), (∀ (i : Fin (n + (3 : ℕ))), d0.1 * (p.vertex i - y).2 - d0.2 * (p.vertex + i - y).1 ≠ (0 : ℝ)) → ( + let badV : Fin (n + 3) → Real := fun i => + if (v i - y).2 = 0 then 0 else -cross d0 (v i - y) / (v i - y).2 + let badE : Fin (n + 3) → Real := fun i => + if (v (i + 1) - v i).2 = 0 then 0 else + -cross d0 (v (i + 1) - v i) / (v (i + 1) - v i).2 + ∀ (κ : ℝ), (κ ∉ Set.range badV ∪ Set.range badE) → ( + let d := d0 + κ • e + ∀ i : Fin (n + 3), cross d (v i - y) ≠ 0)) ) := by + classical + intro n p v b B cross e ε y d0 hdv0 badV badE κ hκbad d i + have hdform : cross d (v i-y) = cross d0 (v i-y) + κ * (v i-y).2 := by + dsimp [cross, d, e] + ring + by_cases hzero : (v i-y).2 = 0 + · rw [hdform] + simp only [hzero, mul_zero, add_zero] + simpa [cross] using hdv0 i + · intro hz + have hroot : κ = -cross d0 (v i-y) / (v i-y).2 := by + rw [hdform] at hz + apply (eq_div_iff hzero).2 + linear_combination hz + have hmem : κ ∈ Set.range badV := by + refine ⟨i, ?_⟩ + change (if (v i-y).2 = 0 then 0 else + -cross d0 (v i-y) / (v i-y).2) = κ + rw [ite_eq_right hzero] + exact hroot.symm + exact hκbad (Set.mem_union_left _ hmem) + +private theorem hde : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let e : Real × Real := (1, 0) + ∀ (ε : ℝ), + let y : Real × Real := B + ε • e + ∀ (d0 : ℝ × ℝ), (∀ (i : Fin (n + (3 : ℕ))), d0.1 * (p.vertex (i + (1 : Fin (n + (3 : + ℕ)))) - p.vertex i).2 - d0.2 * (p.vertex (i + (1 : Fin (n + (3 : ℕ)))) - p.vertex + i).1 ≠ (0 : ℝ)) → ( + let badV : Fin (n + 3) → Real := fun i => + if (v i - y).2 = 0 then 0 else -cross d0 (v i - y) / (v i - y).2 + let badE : Fin (n + 3) → Real := fun i => + if (v (i + 1) - v i).2 = 0 then 0 else + -cross d0 (v (i + 1) - v i) / (v (i + 1) - v i).2 + ∀ (κ : ℝ), (κ ∉ Set.range badV ∪ Set.range badE) → ( + let d := d0 + κ • e + ∀ i : Fin (n + 3), cross d (v (i + 1)-v i) ≠ 0)) ) := by + classical + intro n p v b B cross e ε y d0 hde0 badV badE κ hκbad d i + let z := v (i + 1)-v i + have hdform : cross d z = cross d0 z + κ * z.2 := by + dsimp [cross, d, e] + ring + by_cases hzero : z.2 = 0 + · rw [hdform] + simp only [hzero, mul_zero, add_zero] + simpa [cross, z] using hde0 i + · intro hz + have hroot : κ = -cross d0 z / z.2 := by + rw [hdform] at hz + apply (eq_div_iff hzero).2 + linear_combination hz + have hmem : κ ∈ Set.range badE := by + refine ⟨i, ?_⟩ + change (if (v (i + 1) - v i).2 = 0 then 0 else + -cross d0 (v (i + 1) - v i) / (v (i + 1) - v i).2) = κ + rw [ite_eq_right (by simpa [z] using hzero)] + exact hroot.symm + exact hκbad (Set.mem_union_right _ hmem) + +private theorem hhitsEmpty : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let e : Real × Real := (1, 0) + ∀ (ε : ℝ), + let y : Real × Real := B + ε • e + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + (∀ i : Fin (n + 3), ∀ x : Real × Real, x ∈ segment Real (v i) (v (i + 1)) → ell x ≤ ell + B) → ((ell B < ell y) → (∀ (d0 : ℝ × ℝ), ∀ (κ : ℝ), + let d := d0 + κ • e + (0 < ell d) → ( + let hits : Set (Fin (n + 3)) := {i | ∃ t : Real, 0 < t ∧ y + t • d ∈ segment Real (v i) + (v (i + + 1))} + hits = ∅))) ) := by + classical + intro n p v f hqexists q b B e ε y ell hsegmentHeight hyheight d0 κ d hellD hits + let c := v (b + 1) + apply Set.eq_empty_iff_forall_notMem.mpr + intro i hi + obtain ⟨t, ht, hseg⟩ := hi + have hle := hsegmentHeight i (y + t • d) hseg + have hval : ell (y + t • d) = ell y + t * ell d := by + rw [map_add, map_smul] + simp only [smul_eq_mul] + rw [hval] at hle + have hpos : 0 < t * ell d := mul_pos ht hellD + have hgt : ell B < ell y + t * ell d := by linarith + exact (not_lt_of_ge hle) hgt + +private theorem hyEven : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + (∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), x ∉ P3544T1BoundaryCarrier p → (∀ (i : Fin (n + (3 : + ℕ))), d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ (0 : ℝ)) → (∀ (i : Fin (n + + (3 : ℕ))), d.1 * (p.vertex (i + (1 : Fin (n + (3 : ℕ)))) - p.vertex i).2 - d.2 * + (p.vertex (i + (1 : Fin (n + (3 : ℕ)))) - p.vertex i).1 ≠ (0 : ℝ)) → (x ∈ + P3544T1RayParity p ↔ {i : Fin (n + (3 : ℕ)) | ∃ (t : ℝ), (0 : ℝ) < t ∧ x + t • d ∈ + segment ℝ (p.vertex i) (p.vertex (i + (1 : Fin (n + (3 : ℕ)))))}.ncard % (2 : ℕ) = (1 + : ℕ))) → ( + let e : Real × Real := (1, 0) + ∀ (ε : ℝ), + let y : Real × Real := B + ε • e + (y ∉ C) → (∀ (d0 : ℝ × ℝ), ∀ (κ : ℝ), + let d := d0 + κ • e + (∀ i : Fin (n + 3), cross d (v i - y) ≠ 0) → ((∀ i : Fin (n + 3), cross d (v (i + 1)-v i) + ≠ 0) → ( + let hits : Set (Fin (n + 3)) := {i | ∃ t : Real, 0 < t ∧ y + t • d ∈ segment Real (v i) + (v (i + + 1))} + (hits = ∅) → (y ∉ O))))) ) := by + classical + intro n p v b B cross O C hparity e ε y hynotC d0 κ d hdv hde hits hhitsEmpty hyO + have hpar := (hparity y d hynotC hdv hde).mp hyO + have hpar' : hits.ncard % 2 = 1 := by simpa [hits, v] using hpar + simp [hhitsEmpty] at hpar' + +private theorem hWeven : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + (∀ S : Set (Real × Real), IsConnected S → (∀ x, x ∈ S → x ∉ C) → ∀ x, x ∈ S → ∀ y, y ∈ S + → (x ∈ O ↔ y ∈ O)) → ( + let W : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + (cross U (x - B) < 0 ∨ 0 < cross V (x - B))} + (IsPathConnected W) → ((∀ x, x ∈ W → x ∉ C) → ( + let e : Real × Real := (1, 0) + ∀ (ε : ℝ), + let y : Real × Real := B + ε • e + (y ∈ W) → ((y ∉ O) → (∀ x, x ∈ W → x ∉ O))))) ) := by + classical + intro n p v b B a c u w cross O C rK r U V hconstOn W hWpc hWoff e ε y hYclass hyEven x hx hxO + have hsame := hconstOn W hWpc.isConnected hWoff y hYclass x hx + exact hyEven (hsame.mpr hxO) + +private theorem hdistx0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + ∀ (rK : ℝ), (rK > (0 : ℝ)) → ((0 < dist B a) → ((0 < dist B c) → ( + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (0 < r) → ((∀ d : Real × Real, ∀ t : Real, 0 ≤ t → dist (B + t • d) B = t * dist (B + d) + B) → ( + let σ := min (1 / 2) (r / (4 * (dist B a + 1))) + (0 < σ) → ((σ ≤ r / (4 * (dist B a + 1))) → ((σ < 1) → ( + let x0 := B + σ • u + (B + u = a) → (dist B x0 < r / 2))))))))) ) := by + classical + intro n p v b B a c u rK hrK hdistA hdistC r hr hradialDist σ hσ hσle hσlt x0 hBu + have hrad : dist B x0 = σ * dist B a := by + calc + dist B x0 = dist x0 B := dist_comm _ _ + _ = σ * dist (B + u) B := by + change dist (B + σ • u) B = σ * dist (B + u) B + exact hradialDist u σ hσ.le + _ = σ * dist B a := by rw [hBu, dist_comm] + rw [hrad] + have hd0 : 0 ≤ dist B a := dist_nonneg + calc + σ * dist B a ≤ (r / (4 * (dist B a + 1))) * dist B a := + mul_le_mul_of_nonneg_right hσle hd0 + _ = r / 4 * (dist B a / (dist B a + 1)) := by field_simp + _ < r / 4 := by + have hfrac : dist B a / (dist B a + 1) < 1 := by + rw [div_lt_iff₀ (by positivity)] + linarith + simpa only [mul_one] using mul_lt_mul_of_pos_left hfrac (by positivity : 0 < r / 4) + _ < r / 2 := by linarith + +private theorem hx0open : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + (∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x y t = x + t • (y - x)) → (∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let σ := min (1 / 2) (r / (4 * (dist B a + 1))) + (0 < σ) → ((σ < 1) → ( + let x0 := B + σ • u + x0 ∈ openSegment Real a B))) ) := by + classical + intro n p v b B a c u hlineMap rK r σ hσ hσlt x0 + have hmem := lineMap_mem_openSegment Real a B + (show 1 - σ ∈ Set.Ioo 0 1 by constructor <;> linarith [hσ, hσlt]) + rw [hlineMap] at hmem + have heq : a + (1-σ) • (B-a) = x0 := by + dsimp [x0, u] + module + rw [heq] at hmem + exact hmem + +private theorem hx0ball : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (0 < r) → ( + let σ := min (1 / 2) (r / (4 * (dist B a + 1))) + let x0 := B + σ • u + (dist B x0 < r / 2) → (x0 ∈ Metric.ball B r)) ) := by + classical + intro n p v b B a c u rK r hr σ x0 hdistx0 + rw [Metric.mem_ball, dist_comm] + exact lt_trans hdistx0 (by linarith) + +private theorem hcrossUq : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + (cross u w ≠ 0) → ((∀ z : Real × Real, IsLinearMap Real (cross z)) → ( + let qside : Real × Real := if 0 < cross u w then w else -w + 0 < cross u qside)) ) := by + classical + intro n p v b B a c u w cross hdet hcrossLinear qside + by_cases hp : 0 < cross u w + · simp [qside, hp] + · have hn : cross u w < 0 := lt_of_le_of_ne (le_of_not_gt hp) hdet + rw [show qside = -w by simp [qside, hp], (hcrossLinear u).map_neg] + exact neg_pos.mpr hn + +private theorem hcrossWq : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + (∀ z : Real × Real, IsLinearMap Real (cross z)) → ((∀ z : Real × Real, cross z z = 0) → ( + let qside : Real × Real := if 0 < cross u w then w else -w + cross w qside = 0)) ) := by + classical + intro n p v b B a c u w cross hcrossLinear hcrossSelf qside + by_cases hp : 0 < cross u w + · rw [show qside = w by simp [qside, hp], hcrossSelf] + · rw [show qside = -w by simp [qside, hp], (hcrossLinear w).map_neg, hcrossSelf] + simp + +private theorem hηballNeg : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (δ : ℝ), + let qside : Real × Real := if 0 < cross u w then w else -w + ∀ (η : ℝ), (η • qside ∈ Metric.ball (0 : ℝ × ℝ) δ) → (-(η • qside) ∈ Metric.ball (0 : + Real × Real) δ) ) := by + classical + intro n p v b B a c u w cross δ qside η hηball + rw [Metric.mem_ball, dist_eq_norm] + have hh : ‖η • qside‖ < δ := by + simpa [Metric.mem_ball, dist_eq_norm] using hηball + simpa only [sub_zero, norm_neg] using hh + +private theorem htranslateS : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let σ := min (1 / 2) (r / (4 * (dist B a + 1))) + let x0 := B + σ • u + ∀ (δ : ℝ), ∀ z : Real × Real, z ∈ Metric.ball (0 : Real × Real) δ → x0 + z ∈ Metric.ball + x0 δ ) := by + classical + intro n p v b B a c u rK r σ x0 δ z hz + have he : dist (x0 + z) x0 = dist z (0 : Real × Real) := by + calc + dist (x0 + z) x0 = dist (x0 + z) (x0 + (0 : Real × Real)) := by simp + _ = dist z 0 := dist_add_left x0 z 0 + rw [Metric.mem_ball, he] + exact hz + +private theorem hymS : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let σ := min (1 / 2) (r / (4 * (dist B a + 1))) + let x0 := B + σ • u + ∀ (rS : ℝ), + let S := Metric.ball x0 rS ∩ Metric.ball B r + ∀ (δ : ℝ), (Metric.ball x0 δ ⊆ S) → ( + let qside : Real × Real := if 0 < cross u w then w else -w + ∀ (η : ℝ), (-(η • qside) ∈ Metric.ball (0 : Real × Real) δ) → ((∀ z : Real × Real, z ∈ + Metric.ball (0 : Real × Real) δ → x0 + z ∈ Metric.ball x0 δ) → ( + let ym := x0 - η • qside + ym ∈ S))) ) := by + classical + intro n p v b B a c u w cross rK r σ x0 rS S δ hballS qside η hηballNeg htranslateS ym + have hh := htranslateS (-(η • qside)) hηballNeg + simpa [ym, sub_eq_add_neg] using hballS hh + +private theorem hcrossUplus : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (∀ z : Real × Real, IsLinearMap Real (cross z)) → ((∀ z : Real × Real, cross z z = 0) → ( + let σ := min (1 / 2) (r / (4 * (dist B a + 1))) + let x0 := B + σ • u + let qside : Real × Real := if 0 < cross u w then w else -w + ∀ (η : ℝ), + let yp := x0 + η • qside + (yp - B = σ • u + η • qside) → (cross u (yp-B) = η * cross u qside))) ) := by + classical + intro n p v b B a c u w cross rK r hcrossLinear hcrossSelf σ x0 qside η yp hyplus + rw [hyplus, (hcrossLinear u).map_add, (hcrossLinear u).map_smul, + (hcrossLinear u).map_smul, hcrossSelf] + simp only [smul_eq_mul, mul_zero, zero_add] + +private theorem hcrossUminus : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (∀ z : Real × Real, IsLinearMap Real (cross z)) → ((∀ z : Real × Real, cross z z = 0) → ( + let σ := min (1 / 2) (r / (4 * (dist B a + 1))) + let x0 := B + σ • u + let qside : Real × Real := if 0 < cross u w then w else -w + ∀ (η : ℝ), + let ym := x0 - η • qside + (ym - B = σ • u - η • qside) → (cross u (ym-B) = -(η * cross u qside)))) ) := by + classical + intro n p v b B a c u w cross rK r hcrossLinear hcrossSelf σ x0 qside η ym hyminus + rw [hyminus, (hcrossLinear u).map_sub, (hcrossLinear u).map_smul, + (hcrossLinear u).map_smul, hcrossSelf] + simp only [smul_eq_mul, mul_zero, zero_sub] + +private theorem hcrossWplus : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (∀ z : Real × Real, IsLinearMap Real (cross z)) → ( + let σ := min (1 / 2) (r / (4 * (dist B a + 1))) + let x0 := B + σ • u + let qside : Real × Real := if 0 < cross u w then w else -w + (cross w qside = 0) → (∀ (η : ℝ), + let yp := x0 + η • qside + (yp - B = σ • u + η • qside) → (cross w (yp-B) = σ * cross w u))) ) := by + classical + intro n p v b B a c u w cross rK r hcrossLinear σ x0 qside hcrossWq η yp hyplus + rw [hyplus, (hcrossLinear w).map_add, (hcrossLinear w).map_smul, + (hcrossLinear w).map_smul, hcrossWq] + simp only [smul_eq_mul, mul_zero, add_zero] + +private theorem hcrossWminus : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (∀ z : Real × Real, IsLinearMap Real (cross z)) → ( + let σ := min (1 / 2) (r / (4 * (dist B a + 1))) + let x0 := B + σ • u + let qside : Real × Real := if 0 < cross u w then w else -w + (cross w qside = 0) → (∀ (η : ℝ), + let ym := x0 - η • qside + (ym - B = σ • u - η • qside) → (cross w (ym-B) = σ * cross w u))) ) := by + classical + intro n p v b B a c u w cross rK r hcrossLinear σ x0 qside hcrossWq η ym hyminus + rw [hyminus, (hcrossLinear w).map_sub, (hcrossLinear w).map_smul, + (hcrossLinear w).map_smul, hcrossWq] + simp only [smul_eq_mul, mul_zero, sub_zero] + +private theorem hdetSide : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let u : Real × Real := a - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ z : Real × Real, P3381T1TriangleDeterminant ![a, B, z] = -cross u (z-B) ) := by + classical + intro n p v b B a u cross z + simp [P3381T1TriangleDeterminant, cross, u, a, B] + ring + +private theorem hdetPlus : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let σ := min (1 / 2) (r / (4 * (dist B a + 1))) + let x0 := B + σ • u + let qside : Real × Real := if 0 < cross u w then w else -w + (0 < cross u qside) → (∀ (η : ℝ), ((0 : ℝ) < η) → ( + let yp := x0 + η • qside + (cross u (yp-B) = η * cross u qside) → ((∀ z : Real × Real, P3381T1TriangleDeterminant + ![a, B, z] = -cross u (z-B)) → (P3381T1TriangleDeterminant ![a, B, yp] < 0)))) ) := by + classical + intro n p v b B a c u w cross rK r σ x0 qside hcrossUq η hη yp hcrossUplus hdetSide + rw [hdetSide, hcrossUplus] + exact neg_neg_of_pos (mul_pos hη hcrossUq) + +private theorem hdetMinus : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let σ := min (1 / 2) (r / (4 * (dist B a + 1))) + let x0 := B + σ • u + let qside : Real × Real := if 0 < cross u w then w else -w + (0 < cross u qside) → (∀ (η : ℝ), ((0 : ℝ) < η) → ( + let ym := x0 - η • qside + (cross u (ym-B) = -(η * cross u qside)) → ((∀ z : Real × Real, + P3381T1TriangleDeterminant ![a, B, z] = -cross u (z-B)) → (0 < + P3381T1TriangleDeterminant ![a, B, ym])))) ) := by + classical + intro n p v b B a c u w cross rK r σ x0 qside hcrossUq η hη ym hcrossUminus hdetSide + rw [hdetSide, hcrossUminus] + exact neg_pos.mpr (neg_neg_of_pos (mul_pos hη hcrossUq)) + +private theorem hOpp : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), (b - 1 + 1 = b) → ( + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let O := P3544T1RayParity p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let σ := min (1 / 2) (r / (4 * (dist B a + 1))) + let x0 := B + σ • u + ∀ (rS : ℝ), ∀ (sbit : Bool), (∀ y ∈ Metric.ball x0 rS, y ∈ P3544T1RayParity p ↔ if sbit + = true then (0 : ℝ) < P3381T1TriangleDeterminant ![p.vertex (b - (1 : Fin (n + (3 : + ℕ)))), p.vertex (b - (1 : Fin (n + (3 : ℕ))) + (1 : Fin (n + (3 : ℕ)))), y] else + P3381T1TriangleDeterminant ![p.vertex (b - (1 : Fin (n + (3 : ℕ)))), p.vertex (b - + (1 : Fin (n + (3 : ℕ))) + (1 : Fin (n + (3 : ℕ)))), y] < (0 : ℝ)) → ( + let S := Metric.ball x0 rS ∩ Metric.ball B r + let qside : Real × Real := if 0 < cross u w then w else -w + ∀ (η : ℝ), + let yp := x0 + η • qside + let ym := x0 - η • qside + (yp ∈ S) → ((ym ∈ S) → ((P3381T1TriangleDeterminant ![a, B, yp] < 0) → ((0 < + P3381T1TriangleDeterminant ![a, B, ym]) → ((yp ∈ O ↔ ym ∉ O))))))) ) := by + classical + intro n p v b hprev B a c u w cross O rK r σ x0 rS sbit hrule S qside η yp ym hypS hymS + hdetPlus hdetMinus + have hpS := hrule yp hypS.1 + have hmS := hrule ym hymS.1 + have hpS' : yp ∈ O ↔ if sbit then 0 < P3381T1TriangleDeterminant ![a, B, yp] + else P3381T1TriangleDeterminant ![a, B, yp] < 0 := by + simpa [O, a, B, v, hprev] using hpS + have hmS' : ym ∈ O ↔ if sbit then 0 < P3381T1TriangleDeterminant ![a, B, ym] + else P3381T1TriangleDeterminant ![a, B, ym] < 0 := by + simpa [O, a, B, v, hprev] using hmS + by_cases hb : sbit + · have hpiff : yp ∈ O ↔ 0 < P3381T1TriangleDeterminant ![a, B, yp] := by + simpa only [ite_eq_left hb] using hpS' + have hmiff : ym ∈ O ↔ 0 < P3381T1TriangleDeterminant ![a, B, ym] := by + simpa only [ite_eq_left hb] using hmS' + have hpnot : yp ∉ O := by intro h; exact (not_lt_of_ge (le_of_lt hdetPlus)) (hpiff.mp h) + have hm : ym ∈ O := hmiff.mpr hdetMinus + simp [hpnot, hm] + · have hpiff : yp ∈ O ↔ P3381T1TriangleDeterminant ![a, B, yp] < 0 := by + simpa only [ite_eq_right hb] using hpS' + have hmiff : ym ∈ O ↔ P3381T1TriangleDeterminant ![a, B, ym] < 0 := by + simpa only [ite_eq_right hb] using hmS' + have hp : yp ∈ O := hpiff.mpr hdetPlus + have hmnot : ym ∉ O := by intro h; exact (not_lt_of_ge (le_of_lt hdetMinus)) (hmiff.mp h) + simp [hp, hmnot] + +private theorem hNanchor : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + (cross u w ≠ 0) → ( + let O := P3544T1RayParity p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (cross w u = -cross u w) → ( + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + let N : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + 0 < cross U (x - B) ∧ cross V (x - B) < 0} + let W : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + (cross U (x - B) < 0 ∨ 0 < cross V (x - B))} + (∀ x, x ∈ W → x ∉ O) → ( + let σ := min (1 / 2) (r / (4 * (dist B a + 1))) + (0 < σ) → ( + let x0 := B + σ • u + ∀ (rS : ℝ), + let S := Metric.ball x0 rS ∩ Metric.ball B r + let qside : Real × Real := if 0 < cross u w then w else -w + (0 < cross u qside) → (∀ (η : ℝ), ((0 : ℝ) < η) → ( + let yp := x0 + η • qside + let ym := x0 - η • qside + (yp ∈ S) → ((ym ∈ S) → ((cross u (yp-B) = η * cross u qside) → ((cross u (ym-B) = -(η * + cross u qside)) → ((cross w (yp-B) = σ * cross w u) → ((cross w (ym-B) = σ * cross w + u) → (((yp ∈ O ↔ ym ∉ O)) → (∃ z, z ∈ N ∧ z ∈ O))))))))))))) ) := by + classical + intro n p v b B a c u w cross hdet O rK r hswap U V N W hWeven σ hσ x0 rS S qside hcrossUq η hη + yp ym hypS hymS hcrossUplus hcrossUminus hcrossWplus hcrossWminus hOpp + by_cases hp : 0 < cross u w + · have hNp : yp ∈ N := by + refine ⟨hypS.2, ?_, ?_⟩ + · simpa [U, hp] using (show 0 < cross u (yp-B) from by + rw [hcrossUplus] + exact mul_pos hη hcrossUq) + · have hneg : cross w u < 0 := by rw [hswap]; linarith + simpa [V, hp] using (show cross w (yp-B) < 0 from by + rw [hcrossWplus] + exact mul_neg_of_pos_of_neg hσ hneg) + have hWm : ym ∈ W := by + refine ⟨hymS.2, Or.inl ?_⟩ + simpa [U, hp] using (show cross u (ym-B) < 0 from by + rw [hcrossUminus] + exact neg_neg_of_pos (mul_pos hη hcrossUq)) + have hymnot := hWeven ym hWm + exact ⟨yp, hNp, hOpp.mpr hymnot⟩ + · have hn : cross u w < 0 := lt_of_le_of_ne (le_of_not_gt hp) hdet + have hNu : ym ∈ N := by + refine ⟨hymS.2, ?_, ?_⟩ + · have hpos : 0 < cross w u := by rw [hswap]; exact neg_pos.mpr hn + simpa [U, hp] using (show 0 < cross w (ym-B) from by + rw [hcrossWminus] + exact mul_pos hσ hpos) + · simpa [V, hp] using (show cross u (ym-B) < 0 from by + rw [hcrossUminus] + exact neg_neg_of_pos (mul_pos hη hcrossUq)) + have hWp : yp ∈ W := by + refine ⟨hypS.2, Or.inr ?_⟩ + simpa [V, hp] using (show 0 < cross u (yp-B) from by + rw [hcrossUplus] + exact mul_pos hη hcrossUq) + have hypnot := hWeven yp hWp + have hymO : ym ∈ O := by + by_contra hm + exact hypnot (hOpp.mpr hm) + exact ⟨ym, hNu, hymO⟩ + +private theorem hNodd : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + (∀ S : Set (Real × Real), IsConnected S → (∀ x, x ∈ S → x ∉ C) → ∀ x, x ∈ S → ∀ y, y ∈ S + → (x ∈ O ↔ y ∈ O)) → ( + let N : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + 0 < cross U (x - B) ∧ cross V (x - B) < 0} + (IsPathConnected N) → ((∀ x, x ∈ N → x ∉ C) → ((∃ z, z ∈ N ∧ z ∈ O) → (∀ x, x ∈ N → x ∈ + O)))) ) := by + classical + intro n p v b B a c u w cross O C rK r U V hconstOn N hNpc hNoff hNanchor + obtain ⟨z, hzN, hzO⟩ := hNanchor + intro x hx + have hsame := hconstOn N hNpc.isConnected hNoff x hx z hzN + exact hsame.mpr hzO + +private theorem hLocalCone : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + (∀ x : Real × Real, (∃ s t : Real, 0 < s ∧ 0 < t ∧ x = B + s • u + t • w) ↔ (0 < cross U + (x - B) ∧ cross V (x - B) < 0)) → ( + let N : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + 0 < cross U (x - B) ∧ cross V (x - B) < 0} + let W : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + (cross U (x - B) < 0 ∨ 0 < cross V (x - B))} + (∀ x, x ∈ Metric.ball B r → x ∉ C → x ∈ N ∨ x ∈ W) → ((∀ x, x ∈ W → x ∉ O) → ((∀ x, x ∈ N + → x ∈ O) → (∀ x : Real × Real, x ∈ Metric.ball B r → (x ∈ O ↔ ∃ s t : Real, 0 < s ∧ 0 + < t ∧ x = B + s • u + t • w))))) ) := by + classical + intro n p v b B a c u w cross O C rK r U V hconeUV N W hcover hWeven hNodd x hx + constructor + · intro hxO + have hxC : x ∉ C := by + change x ∉ C ∧ _ at hxO + exact hxO.1 + rcases hcover x hx hxC with hxN | hxW + · exact (hconeUV x).mpr ⟨hxN.2.1, hxN.2.2⟩ + · exact False.elim (hWeven x hxW hxO) + · intro hxcone + have hsign := (hconeUV x).mp hxcone + exact hNodd x ⟨hx, hsign.1, hsign.2⟩ + +end ExposedCornerGeometry + +namespace ExposedCornerAssembly + +private theorem hN0pc : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + ( + let cross := fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1; ∀ (z : ℝ × ℝ), IsLinearMap ℝ + (cross z)) → ( + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + ( + let U := if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex + b) then p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + (1 : + Fin (n + (3 : ℕ)))) - p.vertex b; + let V := if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex + b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b - (1 : + Fin (n + (3 : ℕ)))) - p.vertex b; (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * + y.1) U V) → ( + let N0 : Set (Real × Real) := {z | z ∈ Metric.ball 0 r ∧ + 0 < cross U z ∧ cross V z < 0} + let z0 := U + V + (cross U z0 = cross U V) → ((cross V z0 = -cross U V) → (∀ (τ : ℝ), ((0 : ℝ) < τ) → ((τ • + z0 ∈ Metric.ball (0 : ℝ × ℝ) r) → (IsPathConnected N0)))))) ) := by + classical + intro n p v b B a c u w cross rK r hcrossLinear U V hUV N0 z0 hz0U hz0V τ hτ hτball + exact (ExposedCornerGeometry.hNconvex n p b rK + hcrossLinear).isPathConnected (ExposedCornerGeometry.hN0ne n p b rK hcrossLinear hUV hz0U + hz0V τ hτ hτball) + +private theorem hW0pc : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + let W1 : Set (Real × Real) := {z | z ∈ Metric.ball 0 r ∧ cross U z < 0} + let W2 : Set (Real × Real) := {z | z ∈ Metric.ball 0 r ∧ 0 < cross V z} + let W0 : Set (Real × Real) := W1 ∪ W2 + (Convex Real W1) → ((Convex Real W2) → ((W1.Nonempty) → ((W2.Nonempty) → (((W1 ∩ + W2).Nonempty) → (IsPathConnected W0))))) ) := by + classical + intro n p v b B a c u w cross rK r U V W1 W2 W0 hW1convex hW2convex hW1ne hW2ne hWoverlap + exact (hW1convex.isPathConnected hW1ne).union + (hW2convex.isPathConnected hW2ne) hWoverlap + +private theorem hcover : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), + let B := v b + let a := v (b - 1) + let c := v (b + 1) + (∀ (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), ∀ (t : ℝ), (AffineMap.lineMap x y : ℝ → ℝ × ℝ) t = x + t • + (y - x)) → ( + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (0 < r) → ((r < dist B a) → ((r < dist B c) → ((∀ x ∈ Metric.ball (p.vertex b) (min rK + (min (dist (p.vertex b) (p.vertex (b - (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ)) (dist + (p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ)))), x ∈ + P3544T1BoundaryCarrier p ↔ x ∈ segment ℝ (p.vertex b) (p.vertex (b + (1 : Fin (n + + (3 : ℕ))))) ∨ x ∈ segment ℝ (p.vertex (b - (1 : Fin (n + (3 : ℕ))))) (p.vertex b)) → ( + ( + let U := if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex + b) then p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + (1 : + Fin (n + (3 : ℕ)))) - p.vertex b; + let V := if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex + b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b - (1 : + Fin (n + (3 : ℕ)))) - p.vertex b; (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * + y.1) U V) → ((∀ (z : ℝ × ℝ), z = ((-(fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (if + (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then + p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b - (1 : Fin (n + + (3 : ℕ)))) - p.vertex b) z / (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (if (0 : ℝ) + < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : + ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then + p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + (1 : Fin (n + + (3 : ℕ)))) - p.vertex b) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) + (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 + : ℕ)))) - p.vertex b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else + p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b)) • if (0 : ℝ) < (fun (x y : ℝ × + ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) + (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then p.vertex (b - (1 : Fin (n + + (3 : ℕ)))) - p.vertex b else p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) + + ((fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 + * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then p.vertex (b - (1 : Fin (n + (3 : ℕ)))) + - p.vertex b else p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) z / (fun (x y + : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - + x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) then p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - + p.vertex b else p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (if (0 : ℝ) < + (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) + - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then p.vertex (b + + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - + p.vertex b)) • if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b + - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - + p.vertex b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) → (( + let B := p.vertex b; ∀ (d : ℝ × ℝ), ∀ (t : ℝ), (0 : ℝ) ≤ t → dist (B + t • d) B = t * + dist (B + d) B) → (( + let B := p.vertex b; + let a := p.vertex (b - (1 : Fin (n + (3 : ℕ)))); + let c := p.vertex (b + (1 : Fin (n + (3 : ℕ)))); + let u := a - B; + let w := c - B; + let cross := fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1; + let U := if (0 : ℝ) < cross u w then u else w; B + U = a ∨ B + U = c) → (( + let B := p.vertex b; + let a := p.vertex (b - (1 : Fin (n + (3 : ℕ)))); + let c := p.vertex (b + (1 : Fin (n + (3 : ℕ)))); + let u := a - B; + let w := c - B; + let cross := fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1; + let V := if (0 : ℝ) < cross u w then w else u; B + V = a ∨ B + V = c) → (∀ x ∈ + Metric.ball (p.vertex b) (min rK (min (dist (p.vertex b) (p.vertex (b - (1 : Fin (n + + (3 : ℕ))))) / (2 : ℝ)) (dist (p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ))))) / + (2 : ℝ)))), x ∉ P3544T1BoundaryCarrier p → x ∈ {x : ℝ × ℝ | x ∈ Metric.ball + (p.vertex b) (min rK (min (dist (p.vertex b) (p.vertex (b - (1 : Fin (n + (3 : ℕ))))) + / (2 : ℝ)) (dist (p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ)))) ∧ + (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (if (0 : ℝ) < (fun (x y : ℝ × + ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) + (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then p.vertex (b - (1 : Fin (n + + (3 : ℕ)))) - p.vertex b else p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) + (x - p.vertex b) ∧ (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (if (0 : ℝ) < (fun (x + y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - + p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then p.vertex (b + + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - + p.vertex b) (x - p.vertex b) < (0 : ℝ)} ∨ x ∈ {x : ℝ × ℝ | x ∈ Metric.ball (p.vertex + b) (min rK (min (dist (p.vertex b) (p.vertex (b - (1 : Fin (n + (3 : ℕ))))) / (2 : + ℝ)) (dist (p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ)))) ∧ ((fun + (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 + - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 + : Fin (n + (3 : ℕ)))) - p.vertex b) then p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - + p.vertex b else p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (x - p.vertex b) + < (0 : ℝ) ∨ (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (if (0 : ℝ) < (fun + (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - + p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then p.vertex (b + + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - + p.vertex b) (x - p.vertex b))})))))))))) ) := by + classical + intro n p v b B a c hlineMap rK r hr hrA hrC hcarrierLocal hUV hdecomp hradialDist hUendpoint + hVendpoint + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + exact ExposedCornerGeometry.hcover n p b rK (ExposedCornerGeometry.haxisU n p b + hlineMap rK hr hcarrierLocal hUV hdecomp hradialDist hUendpoint + (ExposedCornerGeometry.hUdist n p b rK hrA hrC hUendpoint)) (ExposedCornerGeometry.haxisV n + p b hlineMap rK hr hcarrierLocal hUV hdecomp hradialDist hVendpoint + (ExposedCornerGeometry.hVdist n p b rK hrA hrC hVendpoint)) + +private theorem hynotC : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), ∀ (b : Fin (n + (3 : ℕ))), (b - 1 + 1 = b) → ( + let B := v b + let a := v (b - 1) + let c := v (b + 1) + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (∀ x ∈ Metric.ball (p.vertex b) (min rK (min (dist (p.vertex b) (p.vertex (b - (1 : Fin + (n + (3 : ℕ))))) / (2 : ℝ)) (dist (p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : + ℕ))))) / (2 : ℝ)))), x ∈ P3544T1BoundaryCarrier p ↔ x ∈ segment ℝ (p.vertex b) + (p.vertex (b + (1 : Fin (n + (3 : ℕ))))) ∨ x ∈ segment ℝ (p.vertex (b - (1 : Fin (n + + (3 : ℕ))))) (p.vertex b)) → ((∀ (i : Fin (n + (3 : ℕ))), ∀ x ∈ segment ℝ (p.vertex i) + (p.vertex (i + (1 : Fin (n + (3 : ℕ))))), ((fun (x : ℝ × ℝ) => x.1 + + Classical.choose hqexists * x.2) : ℝ × ℝ → ℝ) x ≤ ((fun (x : ℝ × ℝ) => x.1 + + Classical.choose hqexists * x.2) : ℝ × ℝ → ℝ) (p.vertex b)) → ( + let e : Real × Real := (1, 0) + ∀ (ε : ℝ), + let y : Real × Real := B + ε • e + (y ∈ Metric.ball B r) → ((((fun (x : ℝ × ℝ) => x.1 + Classical.choose hqexists + * x.2) : ℝ × ℝ → ℝ) (p.vertex b) < ((fun (x + : ℝ × ℝ) => x.1 + Classical.choose hqexists * x.2) : + ℝ × ℝ → ℝ) (p.vertex b + ε • ((1 : ℝ), (0 : ℝ)))) → (p.vertex b + ε • ((1 : ℝ), (0 : + ℝ)) ∉ P3544T1BoundaryCarrier p))))) ) := by + classical + intro n p v f hqexists b hprev B a c rK r hcarrierLocal hsegmentHeight e ε y hyball hyheight + exact ExposedCornerGeometry.hynotC n p hqexists b ε rK + (ExposedCornerGeometry.hellCarrier n p hqexists b hprev rK hcarrierLocal hsegmentHeight) + hyball hyheight + +private theorem hWeven : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), + let q := Classical.choose hqexists + ∀ (b : Fin (n + (3 : ℕ))), + let c := v (b + 1) + let B := v b + let e : Real × Real := (1, 0) + ∀ (ε : ℝ), + let y : Real × Real := B + ε • e + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + let a := v (b - 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + ( + let B := p.vertex b; + let a := p.vertex (b - (1 : Fin (n + (3 : ℕ)))); + let u := a - B; ((fun (x : ℝ × ℝ) => x.1 + Classical.choose hqexists * x.2) : ℝ × ℝ → ℝ) + u < (0 : ℝ)) → (( + let B := p.vertex b; + let w := p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - B; ((fun (x : ℝ × ℝ) => x.1 + + Classical.choose hqexists * x.2) : ℝ × ℝ → ℝ) w < (0 + : ℝ)) → ( + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ((fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - + p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) ≠ (0 : ℝ)) → ((∀ (x + : ℝ × ℝ), ∀ (d : ℝ × ℝ), x ∉ P3544T1BoundaryCarrier p → (∀ (i : Fin (n + (3 : ℕ))), + d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ (0 : ℝ)) → (∀ (i : Fin (n + (3 + : ℕ))), d.1 * (p.vertex (i + (1 : Fin (n + (3 : ℕ)))) - p.vertex i).2 - d.2 * + (p.vertex (i + (1 : Fin (n + (3 : ℕ)))) - p.vertex i).1 ≠ (0 : ℝ)) → (x ∈ + P3544T1RayParity p ↔ {i : Fin (n + (3 : ℕ)) | ∃ (t : ℝ), (0 : ℝ) < t ∧ x + t • d ∈ + segment ℝ (p.vertex i) (p.vertex (i + (1 : Fin (n + (3 : ℕ)))))}.ncard % (2 : ℕ) = (1 + : ℕ))) → (∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (∀ x ∈ Metric.ball (p.vertex b) (min rK (min (dist (p.vertex b) (p.vertex (b - (1 : Fin + (n + (3 : ℕ))))) / (2 : ℝ)) (dist (p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : + ℕ))))) / (2 : ℝ)))), x ∈ P3544T1BoundaryCarrier p ↔ x ∈ segment ℝ (p.vertex b) + (p.vertex (b + (1 : Fin (n + (3 : ℕ))))) ∨ x ∈ segment ℝ (p.vertex (b - (1 : Fin (n + + (3 : ℕ))))) (p.vertex b)) → ((∀ (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), ∀ (z : ℝ × ℝ), z ∈ + segment ℝ x y → ∃ t ∈ Set.Icc (0 : ℝ) (1 : ℝ), z = x + t • (y - x)) → (( + let cross := fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1; ∀ (z : ℝ × ℝ), IsLinearMap ℝ + (cross z)) → (( + let cross := fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1; ∀ (z : ℝ × ℝ), cross z z = (0 : + ℝ)) → ((cross w u = -cross u w) → ( + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + (∀ (x : ℝ × ℝ), (∃ (s : ℝ) (t : ℝ), (0 : ℝ) < s ∧ (0 : ℝ) < t ∧ x = p.vertex b + s • + (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) + t • (p.vertex (b + (1 : Fin + (n + (3 : ℕ)))) - p.vertex b)) ↔ (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * + y.1) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex + b) then p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) (x - p.vertex b) ∧ (fun (x y : ℝ × ℝ) => x.1 * y.2 + - x.2 * y.1) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b + - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - + p.vertex b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (x - p.vertex b) < (0 : ℝ)) → ((∀ (S : Set + (ℝ × ℝ)), IsConnected S → (∀ x ∈ S, x ∉ P3544T1BoundaryCarrier p) → ∀ x ∈ S, ∀ y ∈ + S, x ∈ P3544T1RayParity p ↔ y ∈ P3544T1RayParity p) → ( + let W : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + (cross U (x - B) < 0 ∨ 0 < cross V (x - B))} + (IsPathConnected W) → ((∀ (i : Fin (n + (3 : ℕ))), ∀ x ∈ segment ℝ (p.vertex i) (p.vertex + (i + (1 : Fin (n + (3 : ℕ))))), ((fun (x : ℝ × ℝ) => x.1 + Classical.choose + hqexists * x.2) : ℝ × ℝ → ℝ) x ≤ ((fun (x : + ℝ × ℝ) => x.1 + Classical.choose hqexists * x.2) : ℝ + × ℝ → ℝ) (p.vertex b)) → ((∀ x ∈ Metric.ball (p.vertex b) (min rK (min (dist + (p.vertex b) (p.vertex (b - (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ)) (dist (p.vertex b) + (p.vertex (b + (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ)))), x ∉ P3544T1BoundaryCarrier p + → x ∈ {x : ℝ × ℝ | x ∈ Metric.ball (p.vertex b) (min rK (min (dist (p.vertex b) + (p.vertex (b - (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ)) (dist (p.vertex b) (p.vertex (b + + (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ)))) ∧ (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - + x.2 * y.1) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - + p.vertex b) then p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (x - p.vertex b) ∧ (fun (x y : ℝ × ℝ) => x.1 + * y.2 - x.2 * y.1) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) + (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 + : ℕ)))) - p.vertex b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else + p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (x - p.vertex b) < (0 : ℝ)} ∨ x + ∈ {x : ℝ × ℝ | x ∈ Metric.ball (p.vertex b) (min rK (min (dist (p.vertex b) (p.vertex + (b - (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ)) (dist (p.vertex b) (p.vertex (b + (1 : Fin + (n + (3 : ℕ))))) / (2 : ℝ)))) ∧ ((fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (if (0 + : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : + ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then + p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + (1 : Fin (n + + (3 : ℕ)))) - p.vertex b) (x - p.vertex b) < (0 : ℝ) ∨ (0 : ℝ) < (fun (x y : ℝ × ℝ) => + x.1 * y.2 - x.2 * y.1) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) + (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 + : ℕ)))) - p.vertex b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else + p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (x - p.vertex b))}) → ((y ∈ + Metric.ball B r) → ((((fun (x : ℝ × ℝ) => x.1 + Classical.choose hqexists * + x.2) : ℝ × ℝ → ℝ) (p.vertex b) < ((fun (x : + ℝ × ℝ) => x.1 + Classical.choose hqexists * x.2) : ℝ + × ℝ → ℝ) (p.vertex b + ε • ((1 : ℝ), (0 : ℝ)))) → ((p.vertex b + ε • ((1 : ℝ), (0 : + ℝ)) ∉ P3544T1BoundaryCarrier p) → (∀ (d0 : ℝ × ℝ), (∀ (i : Fin (n + (3 : ℕ))), d0.1 + * (p.vertex i - y).2 - d0.2 * (p.vertex i - y).1 ≠ (0 : ℝ)) → ((∀ (i : Fin (n + (3 : + ℕ))), d0.1 * (p.vertex (i + (1 : Fin (n + (3 : ℕ)))) - p.vertex i).2 - d0.2 * + (p.vertex (i + (1 : Fin (n + (3 : ℕ)))) - p.vertex i).1 ≠ (0 : ℝ)) → ( + let badV : Fin (n + 3) → Real := fun i => + if (v i - y).2 = 0 then 0 else -cross d0 (v i - y) / (v i - y).2 + let badE : Fin (n + 3) → Real := fun i => + if (v (i + 1) - v i).2 = 0 then 0 else + -cross d0 (v (i + 1) - v i) / (v (i + 1) - v i).2 + let T := max 0 (-ell d0 + 1) + ∀ (κ : ℝ), (κ ∈ Set.Ioi T) → ((κ ∉ Set.range badV ∪ Set.range badE) → (∀ x ∈ {x : ℝ × ℝ | + x ∈ Metric.ball (p.vertex b) (min rK (min (dist (p.vertex b) (p.vertex (b - (1 : Fin + (n + (3 : ℕ))))) / (2 : ℝ)) (dist (p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : + ℕ))))) / (2 : ℝ)))) ∧ ((fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (if (0 : ℝ) < + (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) + - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then p.vertex (b + - (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - + p.vertex b) (x - p.vertex b) < (0 : ℝ) ∨ (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - + x.2 * y.1) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - + p.vertex b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (x - p.vertex b))}, x ∉ P3544T1RayParity + p))))))))))))))))))))) ) := by + classical + intro n p v f hqexists q b c B e ε y ell a u w hellu hellw cross hdet hparity rK r + hcarrierLocal hsegParam hcrossLinear hcrossSelf hswap U V hconeUV hconstOn W hWpc + hsegmentHeight hcover hyball hyheight hynotC d0 hdv0 hde0 badV badE T κ hκT hκbad + exact ExposedCornerGeometry.hWeven n p b rK hconstOn hWpc (ExposedCornerGeometry.hWoff + n p b rK (ExposedCornerGeometry.hcarrierSigns n p b hdet rK hcarrierLocal hsegParam + hcrossLinear hcrossSelf hswap)) ε (ExposedCornerGeometry.hYclass n p hqexists b ε rK + hconeUV hcover (ExposedCornerGeometry.hconeHeight n p hqexists b hellu hellw) hyball + hyheight hynotC) (ExposedCornerGeometry.hyEven n p b hparity ε hynotC d0 κ + (ExposedCornerGeometry.hdv n p b ε d0 hdv0 κ hκbad) (ExposedCornerGeometry.hde n p b ε d0 + hde0 κ hκbad) (ExposedCornerGeometry.hhitsEmpty n p hqexists b ε hsegmentHeight hyheight d0 + κ (ExposedCornerGeometry.hellD n p hqexists b ε d0 κ hκT))) + +private theorem hLocalCone : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let v := p.vertex + ∀ (b : Fin (n + (3 : ℕ))), (b - 1 + 1 = b) → ( + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + ((fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - + p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) ≠ (0 : ℝ)) → ( + let O := P3544T1RayParity p + ∀ (rK : ℝ), + let r := min rK (min (dist B a / 2) (dist B c / 2)) + (∀ x ∈ Metric.ball (p.vertex b) (min rK (min (dist (p.vertex b) (p.vertex (b - (1 : Fin + (n + (3 : ℕ))))) / (2 : ℝ)) (dist (p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : + ℕ))))) / (2 : ℝ)))), x ∈ P3544T1BoundaryCarrier p ↔ x ∈ segment ℝ (p.vertex b) + (p.vertex (b + (1 : Fin (n + (3 : ℕ))))) ∨ x ∈ segment ℝ (p.vertex (b - (1 : Fin (n + + (3 : ℕ))))) (p.vertex b)) → ((∀ (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), ∀ (z : ℝ × ℝ), z ∈ + segment ℝ x y → ∃ t ∈ Set.Icc (0 : ℝ) (1 : ℝ), z = x + t • (y - x)) → (( + let cross := fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1; ∀ (z : ℝ × ℝ), IsLinearMap ℝ + (cross z)) → ((cross w u = -cross u w) → ( + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + (∀ (x : ℝ × ℝ), (∃ (s : ℝ) (t : ℝ), (0 : ℝ) < s ∧ (0 : ℝ) < t ∧ x = p.vertex b + s • + (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) + t • (p.vertex (b + (1 : Fin + (n + (3 : ℕ)))) - p.vertex b)) ↔ (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * + y.1) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex + b) then p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) (x - p.vertex b) ∧ (fun (x y : ℝ × ℝ) => x.1 * y.2 + - x.2 * y.1) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b + - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - + p.vertex b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (x - p.vertex b) < (0 : ℝ)) → ((∀ (S : Set + (ℝ × ℝ)), IsConnected S → (∀ x ∈ S, x ∉ P3544T1BoundaryCarrier p) → ∀ x ∈ S, ∀ y ∈ + S, x ∈ P3544T1RayParity p ↔ y ∈ P3544T1RayParity p) → ( + let N : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + 0 < cross U (x - B) ∧ cross V (x - B) < 0} + (IsPathConnected N) → ((∀ x ∈ Metric.ball (p.vertex b) (min rK (min (dist (p.vertex b) + (p.vertex (b - (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ)) (dist (p.vertex b) (p.vertex (b + + (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ)))), x ∉ P3544T1BoundaryCarrier p → x ∈ {x : ℝ × + ℝ | x ∈ Metric.ball (p.vertex b) (min rK (min (dist (p.vertex b) (p.vertex (b - (1 : + Fin (n + (3 : ℕ))))) / (2 : ℝ)) (dist (p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : + ℕ))))) / (2 : ℝ)))) ∧ (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (if (0 : + ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : + ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then + p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + (1 : Fin (n + + (3 : ℕ)))) - p.vertex b) (x - p.vertex b) ∧ (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * + y.1) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex + b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b - (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) (x - p.vertex b) < (0 : ℝ)} ∨ x ∈ {x : ℝ × ℝ | x ∈ + Metric.ball (p.vertex b) (min rK (min (dist (p.vertex b) (p.vertex (b - (1 : Fin (n + + (3 : ℕ))))) / (2 : ℝ)) (dist (p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ))))) / + (2 : ℝ)))) ∧ ((fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (if (0 : ℝ) < (fun (x y : + ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex + b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then p.vertex (b - (1 : Fin + (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex + b) (x - p.vertex b) < (0 : ℝ) ∨ (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * + y.1) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex + b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b - (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) (x - p.vertex b))}) → ((∀ x ∈ {x : ℝ × ℝ | x ∈ + Metric.ball (p.vertex b) (min rK (min (dist (p.vertex b) (p.vertex (b - (1 : Fin (n + + (3 : ℕ))))) / (2 : ℝ)) (dist (p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ))))) / + (2 : ℝ)))) ∧ ((fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (if (0 : ℝ) < (fun (x y : + ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex + b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then p.vertex (b - (1 : Fin + (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex + b) (x - p.vertex b) < (0 : ℝ) ∨ (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * + y.1) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex + b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b - (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) (x - p.vertex b))}, x ∉ P3544T1RayParity p) → ( + let σ := min (1 / 2) (r / (4 * (dist B a + 1))) + (0 < σ) → ( + let x0 := B + σ • u + ∀ (rS : ℝ), ∀ (sbit : Bool), (∀ y ∈ Metric.ball x0 rS, y ∈ P3544T1RayParity p ↔ if sbit + = true then (0 : ℝ) < P3381T1TriangleDeterminant ![p.vertex (b - (1 : Fin (n + (3 : + ℕ)))), p.vertex (b - (1 : Fin (n + (3 : ℕ))) + (1 : Fin (n + (3 : ℕ)))), y] else + P3381T1TriangleDeterminant ![p.vertex (b - (1 : Fin (n + (3 : ℕ)))), p.vertex (b - + (1 : Fin (n + (3 : ℕ))) + (1 : Fin (n + (3 : ℕ)))), y] < (0 : ℝ)) → ( + let S := Metric.ball x0 rS ∩ Metric.ball B r + let qside : Real × Real := if 0 < cross u w then w else -w + ( + let qside := if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 + : Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - + p.vertex b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else -(p.vertex + (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b); (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * + y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) qside) → (( + let qside := if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 + : Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - + p.vertex b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else -(p.vertex + (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b); (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * + y.1) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) qside = (0 : ℝ)) → (∀ (η : + ℝ), ((0 : ℝ) < η) → ( + let yp := x0 + η • qside + let ym := x0 - η • qside + (yp ∈ S) → (( + let ym := p.vertex b + min (1 / 2 : ℝ) (min rK (min (dist (p.vertex b) (p.vertex (b - (1 + : Fin (n + (3 : ℕ))))) / (2 : ℝ)) (dist (p.vertex b) (p.vertex (b + (1 : Fin (n + (3 + : ℕ))))) / (2 : ℝ))) / ((4 : ℝ) * (dist (p.vertex b) (p.vertex (b - (1 : Fin (n + (3 + : ℕ))))) + (1 : ℝ)))) • (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) - η • + if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then + p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else -(p.vertex (b + (1 : Fin (n + + (3 : ℕ)))) - p.vertex b); ym ∈ Metric.ball (p.vertex b + min (1 / 2 : ℝ) (min rK + (min (dist (p.vertex b) (p.vertex (b - (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ)) (dist + (p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ))) / ((4 : ℝ) * (dist + (p.vertex b) (p.vertex (b - (1 : Fin (n + (3 : ℕ))))) + (1 : ℝ)))) • (p.vertex (b - + (1 : Fin (n + (3 : ℕ)))) - p.vertex b)) rS ∩ Metric.ball (p.vertex b) (min rK (min + (dist (p.vertex b) (p.vertex (b - (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ)) (dist + (p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ))))) → ((yp - B = σ • + u + η • qside) → ((ym - B = σ • u - η • qside) → (((fun (x y : ℝ × ℝ) => x.1 * y.2 - + x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) ((p.vertex b + min + (1 / 2 : ℝ) (min rK (min (dist (p.vertex b) (p.vertex (b - (1 : Fin (n + (3 : ℕ))))) + / (2 : ℝ)) (dist (p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ))) / + ((4 : ℝ) * (dist (p.vertex b) (p.vertex (b - (1 : Fin (n + (3 : ℕ))))) + (1 : ℝ)))) • + (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) + η • if (0 : ℝ) < (fun (x y : + ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex + b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then p.vertex (b + (1 : Fin + (n + (3 : ℕ)))) - p.vertex b else -(p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex + b)) - p.vertex b) = η * (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 + - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 + : Fin (n + (3 : ℕ)))) - p.vertex b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - + p.vertex b else -(p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b))) → (((fun (x + y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - + p.vertex b) ((p.vertex b + min (1 / 2 : ℝ) (min rK (min (dist (p.vertex b) (p.vertex + (b - (1 : Fin (n + (3 : ℕ))))) / (2 : ℝ)) (dist (p.vertex b) (p.vertex (b + (1 : Fin + (n + (3 : ℕ))))) / (2 : ℝ))) / ((4 : ℝ) * (dist (p.vertex b) (p.vertex (b - (1 : Fin + (n + (3 : ℕ))))) + (1 : ℝ)))) • (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) + - η • if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : + Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex + b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else -(p.vertex (b + (1 : + Fin (n + (3 : ℕ)))) - p.vertex b)) - p.vertex b) = -(η * (fun (x y : ℝ × ℝ) => x.1 * + y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b) (if (0 : ℝ) < + (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : Fin (n + (3 : ℕ)))) + - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b) then p.vertex (b + + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else -(p.vertex (b + (1 : Fin (n + (3 : ℕ)))) + - p.vertex b)))) → (( + let B := p.vertex b; + let a := p.vertex (b - (1 : Fin (n + (3 : ℕ)))); + let u := a - B; + let cross := fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1; ∀ (z : ℝ × ℝ), + P3381T1TriangleDeterminant ![a, B, z] = -cross u (z - B)) → (∀ x : Real × Real, x ∈ + Metric.ball B r → (x ∈ O ↔ ∃ s t : Real, 0 < s ∧ 0 < t ∧ x = B + s • u + t • + w)))))))))))))))))))))))) ) := by + classical + intro n p v b hprev B a c u w cross hdet O rK r hcarrierLocal hsegParam hcrossLinear hswap U V + hconeUV hconstOn N hNpc hcover hWeven σ hσ x0 rS sbit hrule S qside hcrossUq hcrossWq η hη + yp ym hypS hymS hyplus hyminus hcrossUplus hcrossUminus hdetSide + exact ExposedCornerGeometry.hLocalCone n p b rK hconeUV hcover hWeven + (ExposedCornerGeometry.hNodd n p b rK hconstOn hNpc (ExposedCornerGeometry.hNoff n + p b rK (ExposedCornerGeometry.hcarrierCross n p b rK hcarrierLocal hsegParam + hcrossLinear)) (ExposedCornerGeometry.hNanchor n p b hdet rK hswap hWeven hσ rS + hcrossUq η hη hypS hymS hcrossUplus hcrossUminus (ExposedCornerGeometry.hcrossWplus + n p b rK hcrossLinear hcrossWq η hyplus) (ExposedCornerGeometry.hcrossWminus n p b + rK hcrossLinear hcrossWq η hyminus) (ExposedCornerGeometry.hOpp n p b hprev rK rS + sbit hrule η hypS hymS (ExposedCornerGeometry.hdetPlus n p b rK hcrossUq η hη + hcrossUplus hdetSide) (ExposedCornerGeometry.hdetMinus n p b rK hcrossUq η hη + hcrossUminus hdetSide)))) + +end ExposedCornerAssembly + +theorem P3650T1ExposedCornerExists {n : Nat} (p : P3381T1PolygonBoundary n) : + Nonempty (P3650T1ExposedCorner p) := by +-- BODY + classical + let v := p.vertex + let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => + ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) + have hqexists : ∃ q : Real, q ∉ Set.range f := + Set.finite_range f |>.exists_notMem + let q := Classical.choose hqexists + let ell : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => x.1 + q * x.2 + map_add' := by intro x y; simp; ring + map_smul' := by intro c x; simp; ring } + have hdistinct := ExposedCornerGeometry.hdistinct n p hqexists (Classical.choose_spec hqexists) + obtain ⟨b, hb, hmax⟩ := Finset.univ.exists_max_image + (fun i : Fin (n + 3) => ell (v i)) (Finset.univ_nonempty) + have hstrict := ExposedCornerGeometry.hstrict n p hqexists hdistinct b hmax + have hprev : b - 1 + 1 = b := by simp + have hnextne := ExposedCornerGeometry.hnextne n b + have hprevne := ExposedCornerGeometry.hprevne n b hprev hnextne + let B := v b + let a := v (b - 1) + let c := v (b + 1) + let u : Real × Real := a - B + let w : Real × Real := c - B + have haB := ExposedCornerGeometry.haB n p b hprevne + have hcB := ExposedCornerGeometry.hcB n p b hnextne + have hu : u ≠ 0 := sub_ne_zero.mpr haB + have hw : w ≠ 0 := sub_ne_zero.mpr hcB + have hellu := ExposedCornerGeometry.hellu n p hqexists b hstrict hprevne + have hellw := ExposedCornerGeometry.hellw n p hqexists b hstrict hnextne + have hlineMap := ExposedCornerGeometry.hlineMap + let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 + have hdet := ExposedCornerGeometry.hdetAt218 n p hqexists b hprev hprevne hu hw hellu hellw + hlineMap (ExposedCornerGeometry.hcrosszero) + have htriangle : P3381T1TriangleDeterminant ![a, B, c] ≠ 0 := ExposedCornerGeometry.htriangle + n p b hdet + let D := cross (c - a) (B - a) + let L : (Real × Real) →ₗ[Real] Real := + { toFun := fun x => cross (c - a) x * D⁻¹ + map_add' := by intro x y; simp [cross]; ring + map_smul' := by intro t x; simp [cross]; ring } + let F : (Real × Real) → Real := fun x => L (x - a) + let height : (Real × Real) →ᵃ[Real] Real := AffineMap.mk' F L a (ExposedCornerGeometry.hFaff n + p b) + have hFa : F a = 0 := by simp [F, L, cross] + have hFc : F c = 0 := ExposedCornerGeometry.hFc n p b + have hFB : F B = 1 := ExposedCornerGeometry.hFB n p b (ExposedCornerGeometry.hD n p b htriangle) + have hheightPrev : height a = 0 := by simpa [height] using hFa + have hheightTop : height B = 1 := by simpa [height] using hFB + have hheightNext : height c = 0 := by simpa [height] using hFc + let O := P3544T1RayParity p + let C := P3544T1BoundaryCarrier p + rcases P3544T1LocalParity p with + ⟨_, _, _, _, hlocal, hgeneric, hparity, _, hsides⟩ + let J : Set (Fin (n + 3)) := {j | j ≠ b ∧ j + 1 ≠ b} + let K : Set (Real × Real) := ⋃ j ∈ J, + segment Real (v j) (v (j + 1)) + have hKopen : IsOpen Kᶜ := (ExposedCornerGeometry.hKcompact n p b + (ExposedCornerGeometry.hsegcompact n p)).isClosed.isOpen_compl + obtain ⟨rK, hrK, hballK⟩ := Metric.isOpen_iff.mp hKopen B (ExposedCornerGeometry.hBnotK n p b) + have hdistA : 0 < dist B a := dist_pos.mpr haB.symm + have hdistC : 0 < dist B c := dist_pos.mpr hcB.symm + let r := min rK (min (dist B a / 2) (dist B c / 2)) + have hr : 0 < r := by dsimp [r]; positivity + have hrKle : r ≤ rK := min_le_left _ _ + have hrAle : r ≤ dist B a / 2 := by + exact le_trans (min_le_right _ _) (min_le_left _ _) + have hrCle : r ≤ dist B c / 2 := by + exact le_trans (min_le_right _ _) (min_le_right _ _) + have hrA : r < dist B a := lt_of_le_of_lt hrAle (half_lt_self hdistA) + have hrC : r < dist B c := lt_of_le_of_lt hrCle (half_lt_self hdistC) + have hcarrierLocal := ExposedCornerGeometry.hcarrierLocal n p b hprev rK hballK hrKle + (ExposedCornerGeometry.haddinj n) + have hsegParam := ExposedCornerGeometry.hsegParam hlineMap + have hcrossLinear := ExposedCornerGeometry.hcrossLinear + have hcrossSelf := ExposedCornerGeometry.hcrossSelf + have hswap : cross w u = -cross u w := by dsimp [cross]; ring + have hpos : 0 < cross u w ∨ cross u w < 0 := lt_or_gt_of_ne hdet.symm + let U := if 0 < cross u w then u else w + let V := if 0 < cross u w then w else u + have hUV := ExposedCornerGeometry.hUV n p b hswap hpos + have hUne := ExposedCornerGeometry.hUne n p b hu hw + have hVne := ExposedCornerGeometry.hVne n p b hu hw + have hdecomp := ExposedCornerGeometry.hdecomp n p b hUV + have hconeUV := ExposedCornerGeometry.hconeUV n p b hdet hcrossLinear hUV hdecomp + have hsmallScale := ExposedCornerGeometry.hsmallScale + have hconstOn := ExposedCornerGeometry.hconstOn n p hlocal + let N0 : Set (Real × Real) := {z | z ∈ Metric.ball 0 r ∧ + 0 < cross U z ∧ cross V z < 0} + let W1 : Set (Real × Real) := {z | z ∈ Metric.ball 0 r ∧ cross U z < 0} + let W2 : Set (Real × Real) := {z | z ∈ Metric.ball 0 r ∧ 0 < cross V z} + let W0 : Set (Real × Real) := W1 ∪ W2 + let z0 := U + V + have hz0U : cross U z0 = cross U V := by dsimp [z0]; dsimp [cross]; ring + have hz0V : cross V z0 = -cross U V := by dsimp [z0]; dsimp [cross]; ring + obtain ⟨τ, hτ, hτball⟩ := hsmallScale z0 r hr + have hN0pc : IsPathConnected N0 := ExposedCornerAssembly.hN0pc n p b rK hcrossLinear hUV hz0U + hz0V τ hτ hτball + have hW1convex : Convex Real W1 := + (convex_ball 0 r).inter (convex_halfSpace_lt (hcrossLinear U) 0) + have hW2convex : Convex Real W2 := + (convex_ball 0 r).inter (convex_halfSpace_gt (hcrossLinear V) 0) + have hτnegBall := ExposedCornerGeometry.hτnegBall n p b rK τ hτball + have hnegU := ExposedCornerGeometry.hnegU n p b hcrossLinear hUV hz0U τ hτ + have hposV := ExposedCornerGeometry.hposV n p b hcrossLinear hUV hz0V τ hτ + have hW1ne : W1.Nonempty := ⟨-(τ • z0), hτnegBall, hnegU⟩ + have hW2ne : W2.Nonempty := ⟨-(τ • z0), hτnegBall, hposV⟩ + have hWoverlap : (W1 ∩ W2).Nonempty := + ⟨-(τ • z0), ⟨hτnegBall, hnegU⟩, ⟨hτnegBall, hposV⟩⟩ + have hW0pc : IsPathConnected W0 := ExposedCornerAssembly.hW0pc n p b rK hW1convex hW2convex + hW1ne hW2ne hWoverlap + let N : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + 0 < cross U (x - B) ∧ cross V (x - B) < 0} + let W : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ + (cross U (x - B) < 0 ∨ 0 < cross V (x - B))} + have himageN : (fun z : Real × Real => B + z) '' N0 = N := ExposedCornerGeometry.himageN n p b rK + have himageW : (fun z : Real × Real => B + z) '' W0 = W := ExposedCornerGeometry.himageW n p b rK + have hNpc : IsPathConnected N := + himageN ▸ hN0pc.image (continuous_const.add continuous_id) + have hWpc : IsPathConnected W := + himageW ▸ hW0pc.image (continuous_const.add continuous_id) + have hsegmentHeight := ExposedCornerGeometry.hsegmentHeight n p hqexists b hmax hsegParam + have hradialDist := ExposedCornerGeometry.hradialDist n p b + have hUendpoint := ExposedCornerGeometry.hUendpoint n p b + have hVendpoint := ExposedCornerGeometry.hVendpoint n p b + have hcover := ExposedCornerAssembly.hcover n p b hlineMap rK hr hrA hrC hcarrierLocal hUV + hdecomp hradialDist hUendpoint hVendpoint + have hellU := ExposedCornerGeometry.hellU n p hqexists b hellu hellw + have hellV := ExposedCornerGeometry.hellV n p hqexists b hellu hellw + have htranslate : ∀ z : Real × Real, z ∈ Metric.ball (0 : Real × Real) r → + B + z ∈ Metric.ball B r := ExposedCornerGeometry.htranslate n p b rK + let e : Real × Real := (1, 0) + obtain ⟨ε, hε, hεball⟩ := hsmallScale e r hr + let y : Real × Real := B + ε • e + have hyball : y ∈ Metric.ball B r := by + exact htranslate (ε • e) (by simpa [y] using hεball) + have hyheight := ExposedCornerGeometry.hyheight n p hqexists b ε hε + have hynotC := ExposedCornerAssembly.hynotC n p hqexists b hprev rK hcarrierLocal + hsegmentHeight ε hyball hyheight + obtain ⟨d0, hdv0, hde0⟩ := hgeneric y hynotC + let badV : Fin (n + 3) → Real := fun i => + if (v i - y).2 = 0 then 0 else -cross d0 (v i - y) / (v i - y).2 + let badE : Fin (n + 3) → Real := fun i => + if (v (i + 1) - v i).2 = 0 then 0 else + -cross d0 (v (i + 1) - v i) / (v (i + 1) - v i).2 + let T := max 0 (-ell d0 + 1) + have hbadfinite : (Set.range badV ∪ Set.range badE).Finite := + (Set.finite_range badV).union (Set.finite_range badE) + obtain ⟨κ, hκT, hκbad⟩ := (Set.Ioi_infinite T).exists_notMem_finite hbadfinite + let d := d0 + κ • e + have hκpos : 0 < κ := lt_of_le_of_lt (le_max_left _ _) hκT + let hits : Set (Fin (n + 3)) := {i | ∃ t : Real, 0 < t ∧ y + t • d ∈ segment Real (v i) (v (i + + 1))} + have hWeven := ExposedCornerAssembly.hWeven n p hqexists b ε hellu hellw hdet hparity rK + hcarrierLocal hsegParam hcrossLinear hcrossSelf hswap hconeUV hconstOn hWpc hsegmentHeight + hcover hyball hyheight hynotC d0 hdv0 hde0 κ hκT hκbad + have hdistBA : 0 < dist B a := hdistA + let σ := min (1 / 2) (r / (4 * (dist B a + 1))) + have hσ : 0 < σ := by dsimp [σ]; positivity + have hσle : σ ≤ r / (4 * (dist B a + 1)) := min_le_right _ _ + have hσlt : σ < 1 := lt_of_le_of_lt (min_le_left _ _) (by norm_num) + let x0 := B + σ • u + have hBu : B + u = a := by dsimp [u, a, B]; abel + have hx0open : x0 ∈ openSegment Real a B := ExposedCornerGeometry.hx0open n p b hlineMap rK hσ + hσlt + have hx0prev : x0 ∈ openSegment Real (v (b - 1)) (v ((b - 1) + 1)) := by + simpa [a, B, v, hprev] using hx0open + obtain ⟨rS, hrS, sbit, hrule⟩ := hsides (b - 1) x0 hx0prev + let S := Metric.ball x0 rS ∩ Metric.ball B r + have hx0S : x0 ∈ S := ⟨Metric.mem_ball_self hrS, (ExposedCornerGeometry.hx0ball n p b rK hr + (ExposedCornerGeometry.hdistx0 n p b rK hrK hdistA hdistC hr hradialDist hσ hσle hσlt hBu))⟩ + obtain ⟨δ, hδ, hballS⟩ := Metric.isOpen_iff.mp (Metric.isOpen_ball.inter Metric.isOpen_ball) x0 + hx0S + let qside : Real × Real := if 0 < cross u w then w else -w + have hcrossUq := ExposedCornerGeometry.hcrossUq n p b hdet hcrossLinear + have hcrossWq := ExposedCornerGeometry.hcrossWq n p b hcrossLinear hcrossSelf + obtain ⟨η, hη, hηball⟩ := hsmallScale qside δ hδ + have htranslateS := ExposedCornerGeometry.htranslateS n p b rK δ + let yp := x0 + η • qside + let ym := x0 - η • qside + have hypS : yp ∈ S := hballS (htranslateS (η • qside) hηball) + have hymS := ExposedCornerGeometry.hymS n p b rK rS δ hballS η (ExposedCornerGeometry.hηballNeg + n p b δ η hηball) htranslateS + have hyplus : yp - B = σ • u + η • qside := by dsimp [yp, x0]; abel + have hyminus : ym - B = σ • u - η • qside := by dsimp [ym, x0]; abel + have hcrossUplus := ExposedCornerGeometry.hcrossUplus n p b rK hcrossLinear hcrossSelf η hyplus + have hcrossUminus := ExposedCornerGeometry.hcrossUminus n p b rK hcrossLinear hcrossSelf η hyminus + have hdetSide := ExposedCornerGeometry.hdetSide n p b + have hLocalCone : ∀ x : Real × Real, x ∈ Metric.ball B r → + (x ∈ O ↔ ∃ s t : Real, 0 < s ∧ 0 < t ∧ x = B + s • u + t • w) := + ExposedCornerAssembly.hLocalCone n p b hprev hdet rK hcarrierLocal hsegParam + hcrossLinear hswap hconeUV hconstOn hNpc hcover hWeven hσ rS sbit hrule hcrossUq + hcrossWq η hη hypS hymS hyplus hyminus hcrossUplus hcrossUminus hdetSide + refine ⟨⟨b, ell, hdistinct, hstrict, ?_, height, hheightPrev, + hheightTop, hheightNext, ?_⟩⟩ + · simpa [a, B, c, v] using htriangle + · refine ⟨r, hr, ?_⟩ + intro x hx + simpa [O, a, B, c, u, w, v] using hLocalCone x hx + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean b/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean new file mode 100644 index 0000000000..9577344e62 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean @@ -0,0 +1,1138 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3650T1CyclicChildren +public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity + +-- [TABLET NODE: P3650T1LocalCoherence] + +/-! +# P3650T1LocalCoherence + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace LocalCoherenceProof + +private theorem hOL_Cp : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), (Disjoint (P3544T1BoundaryCarrier + C.right \ segment ℝ (p.vertex a) (p.vertex b)) (P3544T1RayParity C.left)) → ( + let Cp := P3544T1BoundaryCarrier p + let OL := P3544T1RayParity C.left + Disjoint OL Cp) ) := by + classical + intro n p a b C hright Cp OL + let CL := P3544T1BoundaryCarrier C.left + let CR := P3544T1BoundaryCarrier C.right + let e := segment Real (p.vertex a) (p.vertex b) + apply Set.disjoint_left.mpr + intro x hxL hxP + have hxU : x ∈ CL ∪ CR ∪ e := by + rw [C.carrier_union] + exact Or.inl (Or.inl hxP) + rcases hxU with hxCC | hxe + · rcases hxCC with hxCL | hxCR + · exact hxL.1 hxCL + · have hxDiff : x ∈ CR \ e := ⟨hxCR, fun hxe => by + have hxCL' : x ∈ CL := by + have hsub : e ⊆ CL := by + intro y hy + have hy' : y ∈ CL ∩ CR := by + rw [C.carrier_intersection] + exact hy + exact hy'.1 + exact hsub hxe + exact hxL.1 hxCL'⟩ + exact (Set.disjoint_left.mp hright) hxDiff hxL + · have hxCL : x ∈ CL := by + have hsub : e ⊆ CL := by + intro y hy + have hy' : y ∈ CL ∩ CR := by + rw [C.carrier_intersection] + exact hy + exact hy'.1 + exact hsub hxe + exact hxL.1 hxCL + +private theorem hOR_Cp : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), (Disjoint (P3544T1BoundaryCarrier + C.left \ segment ℝ (p.vertex a) (p.vertex b)) (P3544T1RayParity C.right)) → ( + let Cp := P3544T1BoundaryCarrier p + let OR := P3544T1RayParity C.right + Disjoint OR Cp) ) := by + classical + intro n p a b C hleft Cp OR + let CL := P3544T1BoundaryCarrier C.left + let CR := P3544T1BoundaryCarrier C.right + let e := segment Real (p.vertex a) (p.vertex b) + apply Set.disjoint_left.mpr + intro x hxR hxP + have hxU : x ∈ CL ∪ CR ∪ e := by + rw [C.carrier_union] + exact Or.inl (Or.inl hxP) + rcases hxU with hxCC | hxe + · rcases hxCC with hxCL | hxCR + · have hxDiff : x ∈ CL \ e := ⟨hxCL, fun hxe => by + have hxCR : x ∈ CR := by + have hsub : e ⊆ CR := by + intro y hy + have hy' : y ∈ CL ∩ CR := by + rw [C.carrier_intersection] + exact hy + exact hy'.2 + exact hsub hxe + exact hxR.1 hxCR⟩ + exact (Set.disjoint_left.mp hleft) hxDiff hxR + · exact hxR.1 hxCR + · have hxCR : x ∈ CR := by + have hsub : e ⊆ CR := by + intro y hy + have hy' : y ∈ CL ∩ CR := by + rw [C.carrier_intersection] + exact hy + exact hy'.2 + exact hsub hxe + exact hxR.1 hxCR + +private theorem hpropagate : + (by + classical + exact + ∀ (O : Set (ℝ × ℝ)), ∀ (K : Set (ℝ × ℝ)), closure O = O ∪ K → IsOpen O → ∀ (S : Set (ℝ × + ℝ)), IsPreconnected S → Disjoint S K → (S ∩ O).Nonempty → S ⊆ O ) := by + classical + intro O K hclosure hopen S hpre hdisj hseed + have houtside : IsOpen (closure O)ᶜ := isClosed_closure.isOpen_compl + have hdisjoint' : Disjoint O (closure O)ᶜ := by + apply Set.disjoint_left.mpr + intro x hxO hxoutside + exact hxoutside (subset_closure hxO) + have hsplit := hpre.subset_or_subset hopen houtside hdisjoint' (by + intro x hx + by_cases hxO : x ∈ O + · exact Or.inl hxO + · exact Or.inr (by + intro hxcl + have hxOK : x ∈ O ∪ K := by simpa only [hclosure] using hxcl + rcases hxOK with hxO' | hxK + · exact hxO hxO' + · exact (Set.disjoint_left.mp hdisj) hx hxK)) + rcases hseed with ⟨x, hxS, hxO⟩ + rcases hsplit with hS | hS + · exact hS + · exact False.elim ((hS hxS) (subset_closure hxO)) + +private theorem hzclosure : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (z : ℝ × ℝ), (z = p.vertex a ∨ z = p.vertex b) → (z ∈ closure (openSegment + Real (p.vertex a) (p.vertex b))) ) := by + classical + intro n p a b z hzab + rcases hzab with hza | hzb + · rw [hza] + exact segment_subset_closure_openSegment (left_mem_segment Real _ _) + · rw [hzb, openSegment_symm] + exact segment_subset_closure_openSegment (left_mem_segment Real _ _) + +private theorem hidxL : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), ∀ t : Fin (n + 3), t ∈ ({a, b} : Set (Fin + (n + 3))) → ∃ i : Fin (C.left_n + 3), C.left.vertex i = p.vertex t ) := by + classical + intro n p a b C t ht + have ht' : t ∈ Set.range C.il ∩ Set.range C.ir := by + rw [C.common_indices] + simpa using ht + obtain ⟨i, hi⟩ := Set.mem_range.mp ht'.1 + refine ⟨i, ?_⟩ + rw [C.left_vertex] + simp [hi] + +private theorem hidxR : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), ∀ t : Fin (n + 3), t ∈ ({a, b} : Set (Fin + (n + 3))) → ∃ i : Fin (C.right_n + 3), C.right.vertex i = p.vertex t ) := by + classical + intro n p a b C t ht + have ht' : t ∈ Set.range C.il ∩ Set.range C.ir := by + rw [C.common_indices] + simpa using ht + obtain ⟨i, hi⟩ := Set.mem_range.mp ht'.2 + refine ⟨i, ?_⟩ + rw [C.right_vertex] + simp [hi] + +private theorem hidxLz : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), ∀ (z : ℝ × ℝ), (z = p.vertex a ∨ z = + p.vertex b) → ((∀ t : Fin (n + 3), t ∈ ({a, b} : Set (Fin (n + 3))) → ∃ i : Fin + (C.left_n + 3), C.left.vertex i = p.vertex t) → (∃ i : Fin (C.left_n + 3), + C.left.vertex i = z)) ) := by + classical + intro n p a b C z hzab hidxL + rcases hzab with hza | hzb + · obtain ⟨i, hi⟩ := hidxL a (by simp) + exact ⟨i, hi.trans hza.symm⟩ + · obtain ⟨i, hi⟩ := hidxL b (by simp) + exact ⟨i, hi.trans hzb.symm⟩ + +private theorem hidxRz : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), ∀ (z : ℝ × ℝ), (z = p.vertex a ∨ z = + p.vertex b) → ((∀ t : Fin (n + 3), t ∈ ({a, b} : Set (Fin (n + 3))) → ∃ i : Fin + (C.right_n + 3), C.right.vertex i = p.vertex t) → (∃ i : Fin (C.right_n + 3), + C.right.vertex i = z)) ) := by + classical + intro n p a b C z hzab hidxR + rcases hzab with hza | hzb + · obtain ⟨i, hi⟩ := hidxR a (by simp) + exact ⟨i, hi.trans hza.symm⟩ + · obtain ⟨i, hi⟩ := hidxR b (by simp) + exact ⟨i, hi.trans hzb.symm⟩ + +private theorem hseedL : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), (openSegment ℝ (p.vertex a) (p.vertex b) + ⊆ P3544T1RayParity p) → ( + let CL := P3544T1BoundaryCarrier C.left + let Op := P3544T1RayParity p + let OL := P3544T1RayParity C.left + ∀ (z : ℝ × ℝ), (z ∈ closure (openSegment Real (p.vertex a) (p.vertex b))) → (∀ (rL : ℝ), + ((0 : ℝ) < rL) → ((IsOpen Op) → ((closure OL = OL ∪ CL) → (((Metric.ball z rL ∩ OL) ∩ + Op).Nonempty))))) ) := by + classical + intro n p a b C hodd CL Op OL z hzclosure rL hrL hopenP hclosureL + let CR := P3544T1BoundaryCarrier C.right + let e := segment Real (p.vertex a) (p.vertex b) + obtain ⟨x, hx⟩ := (mem_closure_iff_nhds.mp hzclosure) + (Metric.ball z rL) (Metric.ball_mem_nhds z hrL) + have hxseg : x ∈ openSegment Real (p.vertex a) (p.vertex b) := hx.2 + have hxop : x ∈ Op := hodd hxseg + have hxCL : x ∈ CL := by + have hxe : x ∈ e := openSegment_subset_segment Real (p.vertex a) (p.vertex b) hxseg + have hboth : x ∈ CL ∩ CR := by + rw [C.carrier_intersection] + exact hxe + exact hboth.1 + have hxclosure : x ∈ closure OL := by + rw [hclosureL] + exact Or.inr hxCL + have hopenN : IsOpen (Metric.ball z rL ∩ Op) := Metric.isOpen_ball.inter hopenP + obtain ⟨y, hy, hyL⟩ := (mem_closure_iff_nhds.mp hxclosure) + (Metric.ball z rL ∩ Op) (hopenN.mem_nhds ⟨hx.1, hxop⟩) + exact ⟨y, ⟨hy.1, hyL⟩, hy.2⟩ + +private theorem hseedR : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), (openSegment ℝ (p.vertex a) (p.vertex b) + ⊆ P3544T1RayParity p) → ( + let CR := P3544T1BoundaryCarrier C.right + let Op := P3544T1RayParity p + let OR := P3544T1RayParity C.right + ∀ (z : ℝ × ℝ), (z ∈ closure (openSegment Real (p.vertex a) (p.vertex b))) → (∀ (rR : ℝ), + ((0 : ℝ) < rR) → ((IsOpen Op) → ((closure OR = OR ∪ CR) → (((Metric.ball z rR ∩ OR) ∩ + Op).Nonempty))))) ) := by + classical + intro n p a b C hodd CR Op OR z hzclosure rR hrR hopenP hclosureR + let CL := P3544T1BoundaryCarrier C.left + let e := segment Real (p.vertex a) (p.vertex b) + obtain ⟨x, hx⟩ := (mem_closure_iff_nhds.mp hzclosure) + (Metric.ball z rR) (Metric.ball_mem_nhds z hrR) + have hxseg : x ∈ openSegment Real (p.vertex a) (p.vertex b) := hx.2 + have hxop : x ∈ Op := hodd hxseg + have hxCR : x ∈ CR := by + have hxe : x ∈ e := openSegment_subset_segment Real (p.vertex a) (p.vertex b) hxseg + have hboth : x ∈ CL ∩ CR := by + rw [C.carrier_intersection] + exact hxe + exact hboth.2 + have hxclosure : x ∈ closure OR := by + rw [hclosureR] + exact Or.inr hxCR + have hopenN : IsOpen (Metric.ball z rR ∩ Op) := Metric.isOpen_ball.inter hopenP + obtain ⟨y, hy, hyR⟩ := (mem_closure_iff_nhds.mp hxclosure) + (Metric.ball z rR ∩ Op) (hopenN.mem_nhds ⟨hx.1, hxop⟩) + exact ⟨y, ⟨hy.1, hyR⟩, hy.2⟩ + +private theorem hOLin : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let Cp := P3544T1BoundaryCarrier p + let Op := P3544T1RayParity p + let OL := P3544T1RayParity C.left + (Disjoint OL Cp) → ((∀ (O : Set (Real × Real)), ∀ (K : Set (Real × Real)), (closure O = O + ∪ K) → ((IsOpen O) → (∀ (S : Set (Real × Real)), (IsPreconnected S) → ((Disjoint S K) + → (((S ∩ O).Nonempty) → (S ⊆ O)))))) → (∀ (z : ℝ × ℝ), ∀ (iL : Fin (C.left_n + (3 : + ℕ))), (C.left.vertex iL = z) → (∀ (rL : ℝ), (IsPathConnected (Metric.ball + (C.left.vertex iL) rL ∩ P3544T1RayParity C.left)) → ((IsOpen Op) → ((closure Op = + Op ∪ Cp) → ((((Metric.ball z rL ∩ OL) ∩ Op).Nonempty) → (Metric.ball z rL ∩ OL ⊆ + Op))))))) ) := by + classical + intro n p a b C Cp Op OL hOL_Cp hpropagate z iL hiL rL hpathL hopenP hclosureP hseedL + apply hpropagate Op Cp hclosureP hopenP (Metric.ball z rL ∩ OL) + · have hpathLz : IsPathConnected (Metric.ball z rL ∩ OL) := by + simpa [OL, hiL] using hpathL + exact hpathLz.isConnected.isPreconnected + · apply Set.disjoint_left.mpr + intro x hx hc + exact (Set.disjoint_left.mp hOL_Cp) hx.2 hc + · exact hseedL + +private theorem hORin : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let Cp := P3544T1BoundaryCarrier p + let Op := P3544T1RayParity p + let OR := P3544T1RayParity C.right + (Disjoint OR Cp) → ((∀ (O : Set (Real × Real)), ∀ (K : Set (Real × Real)), (closure O = O + ∪ K) → ((IsOpen O) → (∀ (S : Set (Real × Real)), (IsPreconnected S) → ((Disjoint S K) + → (((S ∩ O).Nonempty) → (S ⊆ O)))))) → (∀ (z : ℝ × ℝ), ∀ (iR : Fin (C.right_n + (3 : + ℕ))), (C.right.vertex iR = z) → (∀ (rR : ℝ), (IsPathConnected (Metric.ball + (C.right.vertex iR) rR ∩ P3544T1RayParity C.right)) → ((IsOpen Op) → ((closure Op = + Op ∪ Cp) → ((((Metric.ball z rR ∩ OR) ∩ Op).Nonempty) → (Metric.ball z rR ∩ OR ⊆ + Op))))))) ) := by + classical + intro n p a b C Cp Op OR hOR_Cp hpropagate z iR hiR rR hpathR hopenP hclosureP hseedR + apply hpropagate Op Cp hclosureP hopenP (Metric.ball z rR ∩ OR) + · have hpathRz : IsPathConnected (Metric.ball z rR ∩ OR) := by + simpa [OR, hiR] using hpathR + exact hpathRz.isConnected.isPreconnected + · apply Set.disjoint_left.mpr + intro x hx hc + exact (Set.disjoint_left.mp hOR_Cp) hx.2 hc + · exact hseedR + +private theorem hnotA : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), + let Cp := P3544T1BoundaryCarrier p + ∀ (y : ℝ × ℝ), (y ∉ Cp) → (y ≠ p.vertex a) ) := by + classical + intro n p a Cp y hyCp h + apply hyCp + have : p.vertex a ∈ Cp := by + change p.vertex a ∈ ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) + exact Set.mem_iUnion.mpr ⟨a, left_mem_segment Real _ _⟩ + simpa [h] using this + +private theorem hnotB : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (b : Fin (n + 3)), + let Cp := P3544T1BoundaryCarrier p + ∀ (y : ℝ × ℝ), (y ∉ Cp) → (y ≠ p.vertex b) ) := by + classical + intro n p b Cp y hyCp h + apply hyCp + have : p.vertex b ∈ Cp := by + change p.vertex b ∈ ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) + exact Set.mem_iUnion.mpr ⟨b, left_mem_segment Real _ _⟩ + simpa [h] using this + +private theorem hmem : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), + let e := segment Real (p.vertex a) (p.vertex b) + ∀ (y : ℝ × ℝ), (y ∈ e) → (y = p.vertex a ∨ y = p.vertex b ∨ y ∈ openSegment Real + (p.vertex a) (p.vertex b)) ) := by + classical + intro n p a b e y hye + have hseg : y ∈ segment Real (p.vertex a) (p.vertex b) := by + simpa [e] using hye + rw [← insert_endpoints_openSegment] at hseg + simpa using hseg + +private theorem hyLcar : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let Cp := P3544T1BoundaryCarrier p + let CL := P3544T1BoundaryCarrier C.left + let e := segment Real (p.vertex a) (p.vertex b) + ∀ (y : ℝ × ℝ), (y ∉ Cp) → ((y ∉ e) → (y ∉ CL)) ) := by + classical + intro n p a b C Cp CL e y hyCp hye hy + let CR := P3544T1BoundaryCarrier C.right + have hyin : y ∈ Cp ∪ e := by + have hycc : y ∈ CL ∪ CR := Or.inl hy + rw [C.carrier_union] at hycc + exact hycc + rcases hyin with hyCp' | hyE + · exact hyCp hyCp' + · exact hye hyE + +private theorem hyRcar : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let Cp := P3544T1BoundaryCarrier p + let CR := P3544T1BoundaryCarrier C.right + let e := segment Real (p.vertex a) (p.vertex b) + ∀ (y : ℝ × ℝ), (y ∉ Cp) → ((y ∉ e) → (y ∉ CR)) ) := by + classical + intro n p a b C Cp CR e y hyCp hye hy + let CL := P3544T1BoundaryCarrier C.left + have hyin : y ∈ Cp ∪ e := by + have hycc : y ∈ CL ∪ CR := Or.inr hy + rw [C.carrier_union] at hycc + exact hycc + rcases hyin with hyCp' | hyE + · exact hyCp hyCp' + · exact hye hyE + +private theorem hfirstL : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), C.il 0 = a ) := by + classical + intro n p a b C + have h := congrArg (fun l : List (Fin (n + 3)) => l[0]?) C.left_order + simpa using h + +private theorem hfirstR : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), C.ir 0 = b ) := by + classical + intro n p a b C + have h := congrArg (fun l : List (Fin (n + 3)) => l[0]?) C.right_order + simpa using h + +private theorem hlastL : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) + C.il ilast = b ) := by + classical + intro n p a b C ilast + have hfn : (List.ofFn C.il).getLast? = some (C.il ilast) := by + calc + (List.ofFn C.il).getLast? = + some ((List.ofFn C.il).getLast (by simp)) := + List.getLast?_eq_getLast_of_ne_nil (by simp) + _ = some (C.il (Fin.last (C.left_n + 2))) := + congrArg some (List.getLast_ofFn_succ C.il) + _ = some (C.il ilast) := by simp [ilast] + have ho : (List.ofFn C.il).getLast? = some b := by + rw [C.left_order, ← List.cons_append, + List.getLast?_append_of_ne_nil (a :: C.u) (by simp)] + simp + rw [hfn] at ho + injection ho + +private theorem hlastR : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + C.ir irlast = a ) := by + classical + intro n p a b C irlast + have hfn : (List.ofFn C.ir).getLast? = some (C.ir irlast) := by + calc + (List.ofFn C.ir).getLast? = + some ((List.ofFn C.ir).getLast (by simp)) := + List.getLast?_eq_getLast_of_ne_nil (by simp) + _ = some (C.ir (Fin.last (C.right_n + 2))) := + congrArg some (List.getLast_ofFn_succ C.ir) + _ = some (C.ir irlast) := by simp [irlast] + have ho : (List.ofFn C.ir).getLast? = some a := by + rw [C.right_order, ← List.cons_append, + List.getLast?_append_of_ne_nil (b :: C.v) (by simp)] + simp + rw [hfn] at ho + injection ho + +private theorem hwrapL : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) + ilast + 1 = 0 ) := by + classical + intro n p a b C ilast + apply Fin.ext + simp [ilast] + +private theorem hwrapR : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + irlast + 1 = 0 ) := by + classical + intro n p a b C irlast + apply Fin.ext + simp [irlast] + +private theorem hleftB : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) + (C.il ilast = b) → (C.left.vertex ilast = p.vertex b) ) := by + classical + intro n p a b C ilast hlastL + rw [C.left_vertex] + change p.vertex (C.il ilast) = p.vertex b + rw [hlastL] + +private theorem hleftA : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) + (C.il 0 = a) → ((ilast + 1 = 0) → (C.left.vertex (ilast + 1) = p.vertex a)) ) := by + classical + intro n p a b C ilast hfirstL hwrapL + rw [C.left_vertex] + change p.vertex (C.il (ilast + 1)) = p.vertex a + rw [hwrapL, hfirstL] + +private theorem hrightA : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + (C.ir irlast = a) → (C.right.vertex irlast = p.vertex a) ) := by + classical + intro n p a b C irlast hlastR + rw [C.right_vertex] + change p.vertex (C.ir irlast) = p.vertex a + rw [hlastR] + +private theorem hrightB : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + (C.ir 0 = b) → ((irlast + 1 = 0) → (C.right.vertex (irlast + 1) = p.vertex b)) ) := by + classical + intro n p a b C irlast hfirstR hwrapR + rw [C.right_vertex] + change p.vertex (C.ir (irlast + 1)) = p.vertex b + rw [hwrapR, hfirstR] + +private theorem hreverse : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), + let H : Real × Real → Real := fun y => + P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] + ∀ (y : ℝ × ℝ), P3381T1TriangleDeterminant ![p.vertex b, p.vertex a, y] = -H y ) := by + classical + intro n p a b H y + simp [H, P3381T1TriangleDeterminant] + ring + +private theorem hcanonL : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let OL := P3544T1RayParity C.left + ∀ (x : ℝ × ℝ), + let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) + (C.left.vertex ilast = p.vertex b) → ((C.left.vertex (ilast + 1) = p.vertex a) → (∀ (rL : + ℝ), ∀ (sL : Bool), (∀ y ∈ Metric.ball x rL, y ∈ P3544T1RayParity C.left ↔ if sL = + true then (0 : ℝ) < P3381T1TriangleDeterminant ![C.left.vertex ilast, C.left.vertex + (ilast + (1 : Fin (C.left_n + (3 : ℕ)))), y] else P3381T1TriangleDeterminant + ![C.left.vertex ilast, C.left.vertex (ilast + (1 : Fin (C.left_n + (3 : ℕ)))), y] < + (0 : ℝ)) → ( + let H : Real × Real → Real := fun y => + P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] + (∀ (y : Real × Real), P3381T1TriangleDeterminant ![p.vertex b, p.vertex a, y] = -H y) → + (∀ y ∈ Metric.ball x rL, (y ∈ OL ↔ if !sL then 0 < H y else H y < 0))))) ) := by + classical + intro n p a b C OL x ilast hleftB hleftA rL sL hsideL H hreverse y hy + have h := hsideL y hy + rw [hleftB, hleftA] at h + rw [hreverse y] at h + cases sL <;> simpa [H, neg_pos, neg_lt_zero] using h + +private theorem hcanonR : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let OR := P3544T1RayParity C.right + ∀ (x : ℝ × ℝ), + let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + (C.right.vertex irlast = p.vertex a) → ((C.right.vertex (irlast + 1) = p.vertex b) → (∀ + (rR : ℝ), ∀ (sR : Bool), (∀ y ∈ Metric.ball x rR, y ∈ P3544T1RayParity C.right ↔ if + sR = true then (0 : ℝ) < P3381T1TriangleDeterminant ![C.right.vertex irlast, + C.right.vertex (irlast + (1 : Fin (C.right_n + (3 : ℕ)))), y] else + P3381T1TriangleDeterminant ![C.right.vertex irlast, C.right.vertex (irlast + (1 : + Fin (C.right_n + (3 : ℕ)))), y] < (0 : ℝ)) → ( + let H : Real × Real → Real := fun y => + P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] + ∀ y ∈ Metric.ball x rR, (y ∈ OR ↔ if sR then 0 < H y else H y < 0)))) ) := by + classical + intro n p a b C OR x irlast hrightA hrightB rR sR hsideR H y hy + have h := hsideR y hy + rw [hrightA, hrightB] at h + simpa [H] using h + +private theorem hABne : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), (a ≠ b) → (p.vertex a ≠ p.vertex b) ) := by + classical + intro n p a b hab h + exact hab (p.injective h) + +private theorem hcoord : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), (p.vertex a ≠ p.vertex b) → ( + let dx := (p.vertex b).1 - (p.vertex a).1 + let dy := (p.vertex b).2 - (p.vertex a).2 + dx ≠ 0 ∨ dy ≠ 0) ) := by + classical + intro n p a b hABne dx dy + by_contra h + push Not at h + apply hABne + apply Prod.ext <;> dsimp [dx, dy] at * <;> linarith + +private theorem hxdet : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let Op := P3544T1RayParity p + let OL := P3544T1RayParity C.left + let OR := P3544T1RayParity C.right + ∀ (x : ℝ × ℝ), (x ∈ openSegment ℝ (p.vertex a) (p.vertex b)) → ( + let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) + let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + (x ∈ openSegment Real (C.left.vertex ilast) (C.left.vertex (ilast + 1))) → ((x ∈ + openSegment Real (C.right.vertex irlast) (C.right.vertex (irlast + 1))) → (∀ (rL : + ℝ), ∀ (sL : Bool), (∀ y ∈ Metric.ball x rL, y ∈ P3544T1RayParity C.left ↔ if sL = + true then (0 : ℝ) < P3381T1TriangleDeterminant ![C.left.vertex ilast, C.left.vertex + (ilast + (1 : Fin (C.left_n + (3 : ℕ)))), y] else P3381T1TriangleDeterminant + ![C.left.vertex ilast, C.left.vertex (ilast + (1 : Fin (C.left_n + (3 : ℕ)))), y] < + (0 : ℝ)) → (∀ (rR : ℝ), ∀ (sR : Bool), (∀ y ∈ Metric.ball x rR, y ∈ + P3544T1RayParity C.right ↔ if sR = true then (0 : ℝ) < P3381T1TriangleDeterminant + ![C.right.vertex irlast, C.right.vertex (irlast + (1 : Fin (C.right_n + (3 : ℕ)))), + y] else P3381T1TriangleDeterminant ![C.right.vertex irlast, C.right.vertex (irlast + + (1 : Fin (C.right_n + (3 : ℕ)))), y] < (0 : ℝ)) → ( + let H : Real × Real → Real := fun y => + P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] + (∀ y ∈ Metric.ball x rL, (y ∈ OL ↔ if !sL then 0 < H y else H y < 0)) → ((∀ y ∈ + Metric.ball x rR, (y ∈ OR ↔ if sR then 0 < H y else H y < 0)) → ((x ∈ Op) → (∀ (rp : + ℝ), (Metric.ball x rp ⊆ Op) → (H x = 0))))))))) ) := by + classical + intro n p a b C Op OL OR x hx ilast irlast hxL hxR rL sL hsideL rR sR hsideR H hcanonL hcanonR + hxop rp hparentball + have hxseg : x ∈ segment Real (p.vertex a) (p.vertex b) := + openSegment_subset_segment Real (p.vertex a) (p.vertex b) hx + rw [segment_eq_image] at hxseg + rcases hxseg with ⟨t, ht, rfl⟩ + simp [H, P3381T1TriangleDeterminant, Prod.smul_fst, Prod.smul_snd, + Prod.fst_add, Prod.snd_add, smul_eq_mul] + ring + +private theorem hshift : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (x : ℝ × ℝ), + let H : Real × Real → Real := fun y => + P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] + let dx := (p.vertex b).1 - (p.vertex a).1 + let dy := (p.vertex b).2 - (p.vertex a).2 + ∀ (u : ℝ), ∀ (v : ℝ), H (x.1 + u, x.2 + v) = H x + dx * v - dy * u ) := by + classical + intro n p a b x H dx dy u v + simp [H, P3381T1TriangleDeterminant, dx, dy] + ring + +private theorem hrho : + (by + classical + exact + ∀ (rL : ℝ), ((0 : ℝ) < rL) → (∀ (rR : ℝ), ((0 : ℝ) < rR) → (∀ (rp : ℝ), (rp > (0 : ℝ)) → ( + let rho := min (min rL rR) rp + 0 < rho))) ) := by + classical + intro rL hrL rR hrR rp hrp rho + dsimp [rho] + exact lt_min (lt_min hrL hrR) hrp + +private theorem hballV : + (by + classical + exact + ∀ (x : ℝ × ℝ), ∀ (rL : ℝ), ∀ (rR : ℝ), ∀ (rp : ℝ), + let rho := min (min rL rR) rp + ∀ (t : ℝ), |t| < rho → (x.1, x.2 + t) ∈ Metric.ball x rho ) := by + classical + intro x rL rR rp rho t ht + simpa [Metric.mem_ball, Prod.dist_eq, Real.dist_eq, + add_comm, add_left_comm, add_assoc] using ht + +private theorem hballH : + (by + classical + exact + ∀ (x : ℝ × ℝ), ∀ (rL : ℝ), ∀ (rR : ℝ), ∀ (rp : ℝ), + let rho := min (min rL rR) rp + ∀ (t : ℝ), |t| < rho → (x.1 + t, x.2) ∈ Metric.ball x rho ) := by + classical + intro x rL rR rp rho t ht + simpa [Metric.mem_ball, Prod.dist_eq, Real.dist_eq, + add_comm, add_left_comm, add_assoc] using ht + +private theorem hballNegDelta : + (by + classical + exact + ∀ (rL : ℝ), ∀ (rR : ℝ), ∀ (rp : ℝ), + let rho := min (min rL rR) rp + let delta := rho / 2 + (0 < delta) → ((delta < rho) → (|-delta| < rho)) ) := by + classical + intro rL rR rp rho delta hdelta hdelta_lt + rw [abs_neg, abs_of_pos hdelta] + exact hdelta_lt + +private theorem htransverse : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (x : ℝ × ℝ), ∀ (rL : ℝ), ∀ (sL : Bool), ∀ (rR : ℝ), + let H : Real × Real → Real := fun y => + P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] + ∀ (rp : ℝ), + let rho := min (min rL rR) rp + let dx := (p.vertex b).1 - (p.vertex a).1 + let dy := (p.vertex b).2 - (p.vertex a).2 + (dx ≠ 0 ∨ dy ≠ 0) → ((H x = 0) → ((∀ (v : Real), H (x.1, x.2 + v) = H x + dx * v) → ((∀ + (u : Real), H (x.1 + u, x.2) = H x - dy * u) → ( + let delta := rho / 2 + (0 < delta) → ((∀ (t : Real), (|t| < rho) → ((x.1, x.2 + t) ∈ Metric.ball x rho)) → ((∀ + (t : Real), (|t| < rho) → ((x.1 + t, x.2) ∈ Metric.ball x rho)) → ((|delta| < rho) → + ((|-delta| < rho) → (∃ y ∈ Metric.ball x rho, if sL then H y < 0 else 0 < H + y))))))))) ) := by + classical + intro n p a b x rL sL rR H rp rho dx dy hcoord hxdet hshiftV hshiftH delta hdelta hballV hballH + hballDelta hballNegDelta + by_cases hdx : dx ≠ 0 + · by_cases hsL : sL + · by_cases hdxpos : 0 < dx + · refine ⟨(x.1, x.2 + -delta), hballV (-delta) hballNegDelta, ?_⟩ + rw [ite_eq_left hsL] + rw [hshiftV, hxdet] + simpa [neg_mul] using (neg_lt_zero.mpr (mul_pos hdxpos hdelta)) + · have hdxneg : dx < 0 := by + exact lt_of_le_of_ne (le_of_not_gt hdxpos) hdx + refine ⟨(x.1, x.2 + delta), hballV delta hballDelta, ?_⟩ + rw [ite_eq_left hsL] + rw [hshiftV, hxdet] + simpa using (mul_neg_of_neg_of_pos hdxneg hdelta) + · by_cases hdxpos : 0 < dx + · refine ⟨(x.1, x.2 + delta), hballV delta hballDelta, ?_⟩ + rw [ite_eq_right hsL] + rw [hshiftV, hxdet] + simpa using mul_pos hdxpos hdelta + · have hdxneg : dx < 0 := by + exact lt_of_le_of_ne (le_of_not_gt hdxpos) hdx + refine ⟨(x.1, x.2 + -delta), hballV (-delta) hballNegDelta, ?_⟩ + rw [ite_eq_right hsL] + rw [hshiftV, hxdet] + simpa [neg_mul] using (neg_pos.mpr (mul_neg_of_neg_of_pos hdxneg hdelta)) + · have hdx0 : dx = 0 := by + by_contra h + exact hdx h + have hdy : dy ≠ 0 := hcoord.resolve_left hdx + by_cases hsL : sL + · by_cases hdypos : 0 < dy + · refine ⟨(x.1 + delta, x.2), hballH delta hballDelta, ?_⟩ + rw [ite_eq_left hsL] + rw [hshiftH, hxdet] + simpa [sub_eq_add_neg] using (neg_lt_zero.mpr (mul_pos hdypos hdelta)) + · have hdyneg : dy < 0 := by + exact lt_of_le_of_ne (le_of_not_gt hdypos) hdy + refine ⟨(x.1 + -delta, x.2), hballH (-delta) hballNegDelta, ?_⟩ + rw [ite_eq_left hsL] + rw [hshiftH, hxdet] + simpa [neg_mul, sub_eq_add_neg] using (mul_neg_of_neg_of_pos hdyneg hdelta) + · by_cases hdypos : 0 < dy + · refine ⟨(x.1 + -delta, x.2), hballH (-delta) hballNegDelta, ?_⟩ + rw [ite_eq_right hsL] + rw [hshiftH, hxdet] + simpa [neg_mul, sub_eq_add_neg] using (mul_pos hdypos hdelta) + · have hdyneg : dy < 0 := by + exact lt_of_le_of_ne (le_of_not_gt hdypos) hdy + refine ⟨(x.1 + delta, x.2), hballH delta hballDelta, ?_⟩ + rw [ite_eq_right hsL] + rw [hshiftH, hxdet] + simpa [sub_eq_add_neg] using (neg_pos.mpr (mul_neg_of_neg_of_pos hdyneg hdelta)) + +private theorem hsignsOpp : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), (∀ x ∉ P3544T1BoundaryCarrier C.left, x + ∉ P3544T1BoundaryCarrier C.right → (x ∈ P3544T1RayParity p ↔ x ∈ + P3544T1RayParity C.left ∧ x ∉ P3544T1RayParity C.right ∨ x ∉ P3544T1RayParity + C.left ∧ x ∈ P3544T1RayParity C.right)) → ( + let Op := P3544T1RayParity p + let OL := P3544T1RayParity C.left + let OR := P3544T1RayParity C.right + ∀ (x : ℝ × ℝ), + let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) + let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + ∀ (rL : ℝ), ∀ (sL : Bool), (∀ y ∈ Metric.ball x rL, y ∈ P3544T1RayParity C.left ↔ if sL + = true then (0 : ℝ) < P3381T1TriangleDeterminant ![C.left.vertex ilast, + C.left.vertex (ilast + (1 : Fin (C.left_n + (3 : ℕ)))), y] else + P3381T1TriangleDeterminant ![C.left.vertex ilast, C.left.vertex (ilast + (1 : Fin + (C.left_n + (3 : ℕ)))), y] < (0 : ℝ)) → (∀ (rR : ℝ), ∀ (sR : Bool), (∀ y ∈ + Metric.ball x rR, y ∈ P3544T1RayParity C.right ↔ if sR = true then (0 : ℝ) < + P3381T1TriangleDeterminant ![C.right.vertex irlast, C.right.vertex (irlast + (1 : + Fin (C.right_n + (3 : ℕ)))), y] else P3381T1TriangleDeterminant ![C.right.vertex + irlast, C.right.vertex (irlast + (1 : Fin (C.right_n + (3 : ℕ)))), y] < (0 : ℝ)) → ( + let H : Real × Real → Real := fun y => + P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] + (∀ y ∈ Metric.ball x rL, (y ∈ OL ↔ if !sL then 0 < H y else H y < 0)) → ((∀ y ∈ + Metric.ball x rR, (y ∈ OR ↔ if sR then 0 < H y else H y < 0)) → (∀ (rp : ℝ), + (Metric.ball x rp ⊆ Op) → ( + let rho := min (min rL rR) rp + (∃ y ∈ Metric.ball x rho, if sL then H y < 0 else 0 < H y) → (sR = sL))))))) ) := by + classical + intro n p a b C hsum Op OL OR x ilast irlast rL sL hsideL rR sR hsideR H hcanonL hcanonR rp + hparentball rho htransverse + cases sL <;> cases sR + · rfl + · exfalso + obtain ⟨y, hyball, hysign⟩ := htransverse + have hyLball : y ∈ Metric.ball x rL := + Metric.ball_subset_ball (le_trans (min_le_left (min rL rR) rp) (min_le_left rL rR)) hyball + have hyRball : y ∈ Metric.ball x rR := + Metric.ball_subset_ball (le_trans (min_le_left (min rL rR) rp) (min_le_right rL rR)) hyball + have hyparent : y ∈ Metric.ball x rp := + Metric.ball_subset_ball (min_le_right (min rL rR) rp) hyball + have hyL : y ∈ OL := by + apply (hcanonL y hyLball).2 + simpa using hysign + have hyR : y ∈ OR := by + apply (hcanonR y hyRball).2 + simpa using hysign + have hyOp : y ∈ Op := hparentball hyparent + rcases (hsum y hyL.1 hyR.1).mp hyOp with ⟨_, hn⟩ | ⟨hn, _⟩ + · exact hn hyR + · exact hn hyL + · exfalso + obtain ⟨y, hyball, hysign⟩ := htransverse + have hyLball : y ∈ Metric.ball x rL := + Metric.ball_subset_ball (le_trans (min_le_left (min rL rR) rp) (min_le_left rL rR)) hyball + have hyRball : y ∈ Metric.ball x rR := + Metric.ball_subset_ball (le_trans (min_le_left (min rL rR) rp) (min_le_right rL rR)) hyball + have hyparent : y ∈ Metric.ball x rp := + Metric.ball_subset_ball (min_le_right (min rL rR) rp) hyball + have hyL : y ∈ OL := by + apply (hcanonL y hyLball).2 + simpa using hysign + have hyR : y ∈ OR := by + apply (hcanonR y hyRball).2 + simpa using hysign + have hyOp : y ∈ Op := hparentball hyparent + rcases (hsum y hyL.1 hyR.1).mp hyOp with ⟨_, hn⟩ | ⟨hn, _⟩ + · exact hn hyR + · exact hn hyL + · rfl + +end LocalCoherenceProof + +theorem P3650T1LocalCoherence {n : Nat} (p : P3381T1PolygonBoundary n) + (a b : Fin (n + 3)) (hab : a ≠ b) (C : P3650T1CyclicChildren p a b) + (hodd : openSegment Real (p.vertex a) (p.vertex b) ⊆ P3544T1RayParity p) + (hleft : Disjoint + (P3544T1BoundaryCarrier C.left \ segment Real (p.vertex a) (p.vertex b)) + (P3544T1RayParity C.right)) + (hright : Disjoint + (P3544T1BoundaryCarrier C.right \ segment Real (p.vertex a) (p.vertex b)) + (P3544T1RayParity C.left)) + (hsum : ∀ x, x ∉ P3544T1BoundaryCarrier C.left → + x ∉ P3544T1BoundaryCarrier C.right → + (x ∈ P3544T1RayParity p ↔ + (x ∈ P3544T1RayParity C.left ∧ x ∉ P3544T1RayParity C.right) ∨ + (x ∉ P3544T1RayParity C.left ∧ x ∈ P3544T1RayParity C.right))) : + (∀ x, x ∈ openSegment Real (p.vertex a) (p.vertex b) → + ∃ r : Real, 0 < r ∧ ∃ s : Bool, ∀ y ∈ Metric.ball x r, + (y ∈ P3544T1RayParity C.left ↔ + if s then 0 < P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] + else P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] < 0) ∧ + (y ∈ P3544T1RayParity C.right ↔ + if s then P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] < 0 + else 0 < P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y])) ∧ + (∀ z ∈ ({p.vertex a, p.vertex b} : Set (Real × Real)), + ∃ r : Real, 0 < r ∧ + Metric.ball z r ∩ P3544T1RayParity p = + Metric.ball z r ∩ (P3544T1RayParity C.left ∪ + P3544T1RayParity C.right ∪ openSegment Real (p.vertex a) (p.vertex b))) := by +-- BODY + classical + let Cp := P3544T1BoundaryCarrier p + let CL := P3544T1BoundaryCarrier C.left + let CR := P3544T1BoundaryCarrier C.right + let Op := P3544T1RayParity p + let OL := P3544T1RayParity C.left + let OR := P3544T1RayParity C.right + let e := segment Real (p.vertex a) (p.vertex b) + have hOL_Cp : Disjoint OL Cp := LocalCoherenceProof.hOL_Cp n p a b C hright + have hOR_Cp : Disjoint OR Cp := LocalCoherenceProof.hOR_Cp n p a b C hleft + have hpropagate (O : Set (Real × Real)) (K : Set (Real × Real)) + (hclosure : closure O = O ∪ K) (hopen : IsOpen O) + (S : Set (Real × Real)) (hpre : IsPreconnected S) + (hdisj : Disjoint S K) (hseed : (S ∩ O).Nonempty) : S ⊆ O := LocalCoherenceProof.hpropagate + O K hclosure hopen S hpre hdisj hseed + have hfirst : ∀ z ∈ ({p.vertex a, p.vertex b} : Set (Real × Real)), + ∃ r : Real, 0 < r ∧ Metric.ball z r ∩ Op = + Metric.ball z r ∩ (OL ∪ OR ∪ openSegment Real (p.vertex a) (p.vertex b)) := by + intro z hz + have hzab : z = p.vertex a ∨ z = p.vertex b := by simpa using hz + have hzclosure : z ∈ closure (openSegment Real (p.vertex a) (p.vertex b)) := + LocalCoherenceProof.hzclosure n p a b z hzab + have hidxL : ∀ t : Fin (n + 3), t ∈ ({a, b} : Set (Fin (n + 3))) → + ∃ i : Fin (C.left_n + 3), C.left.vertex i = p.vertex t := LocalCoherenceProof.hidxL n p a + b C + have hidxR : ∀ t : Fin (n + 3), t ∈ ({a, b} : Set (Fin (n + 3))) → + ∃ i : Fin (C.right_n + 3), C.right.vertex i = p.vertex t := LocalCoherenceProof.hidxR n p + a b C + have hidxLz : ∃ i : Fin (C.left_n + 3), C.left.vertex i = z := LocalCoherenceProof.hidxLz n p + a b C z hzab hidxL + have hidxRz : ∃ i : Fin (C.right_n + 3), C.right.vertex i = z := LocalCoherenceProof.hidxRz n + p a b C z hzab hidxR + obtain ⟨iL, hiL⟩ := hidxLz + obtain ⟨iR, hiR⟩ := hidxRz + obtain ⟨rL, hrL, hpathL, _⟩ := (P3544T1LocalParity C.left).2.2.2.2.2.2.2.1 iL + obtain ⟨rR, hrR, hpathR, _⟩ := (P3544T1LocalParity C.right).2.2.2.2.2.2.2.1 iR + have hopenP : IsOpen Op := (P3544T1LocalParity p).2.1 + have hopenL : IsOpen OL := (P3544T1LocalParity C.left).2.1 + have hopenR : IsOpen OR := (P3544T1LocalParity C.right).2.1 + have hclosureL : closure OL = OL ∪ CL := by + simpa [OL, CL] using (P3544T1LocalParity C.left).1 + have hclosureR : closure OR = OR ∪ CR := by + simpa [OR, CR] using (P3544T1LocalParity C.right).1 + have hclosureP : closure Op = Op ∪ Cp := by + simpa [Op, Cp] using (P3544T1LocalParity p).1 + have hseedL : ((Metric.ball z rL ∩ OL) ∩ Op).Nonempty := LocalCoherenceProof.hseedL n p a b C + hodd z hzclosure rL hrL hopenP hclosureL + have hseedR : ((Metric.ball z rR ∩ OR) ∩ Op).Nonempty := LocalCoherenceProof.hseedR n p a b C + hodd z hzclosure rR hrR hopenP hclosureR + have hOLin : Metric.ball z rL ∩ OL ⊆ Op := LocalCoherenceProof.hOLin n p a b C hOL_Cp + hpropagate z iL hiL rL hpathL hopenP hclosureP hseedL + have hORin : Metric.ball z rR ∩ OR ⊆ Op := LocalCoherenceProof.hORin n p a b C hOR_Cp + hpropagate z iR hiR rR hpathR hopenP hclosureP hseedR + refine ⟨min rL rR, lt_min hrL hrR, ?_⟩ + ext y + constructor + · rintro ⟨hyball, hyop⟩ + have hyCp : y ∉ Cp := hyop.1 + by_cases hye : y ∈ e + · have hnotA : y ≠ p.vertex a := LocalCoherenceProof.hnotA n p a y hyCp + have hnotB : y ≠ p.vertex b := LocalCoherenceProof.hnotB n p b y hyCp + have hmem : y = p.vertex a ∨ y = p.vertex b ∨ + y ∈ openSegment Real (p.vertex a) (p.vertex b) := LocalCoherenceProof.hmem n p a b y hye + rcases hmem with h | h | hyseg + · exact False.elim (hnotA h) + · exact False.elim (hnotB h) + · exact ⟨hyball, Or.inr hyseg⟩ + · have hyLcar : y ∉ CL := LocalCoherenceProof.hyLcar n p a b C y hyCp hye + have hyRcar : y ∉ CR := LocalCoherenceProof.hyRcar n p a b C y hyCp hye + have hxsum := (hsum y hyLcar hyRcar).mp hyop + rcases hxsum with hx | hx + · exact ⟨hyball, Or.inl (Or.inl hx.1)⟩ + · exact ⟨hyball, Or.inl (Or.inr hx.2)⟩ + · rintro ⟨hyball, hy⟩ + have hballL : Metric.ball z (min rL rR) ⊆ Metric.ball z rL := + Metric.ball_subset_ball (min_le_left rL rR) + have hballR : Metric.ball z (min rL rR) ⊆ Metric.ball z rR := + Metric.ball_subset_ball (min_le_right rL rR) + rcases hy with hyLR | hyseg + · rcases hyLR with hyL | hyR + · exact ⟨hyball, hOLin ⟨hballL hyball, hyL⟩⟩ + · exact ⟨hyball, hORin ⟨hballR hyball, hyR⟩⟩ + · have hyop : y ∈ Op := hodd hyseg + exact ⟨hyball, hyop⟩ + have hinterior : ∀ x ∈ openSegment Real (p.vertex a) (p.vertex b), + ∃ r : Real, 0 < r ∧ ∃ s : Bool, ∀ y ∈ Metric.ball x r, + (y ∈ OL ↔ if s then 0 < P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] + else P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] < 0) ∧ + (y ∈ OR ↔ if s then P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] < 0 + else 0 < P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y]) := by + intro x hx + let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) + let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + have hfirstL : C.il 0 = a := LocalCoherenceProof.hfirstL n p a b C + have hfirstR : C.ir 0 = b := LocalCoherenceProof.hfirstR n p a b C + have hlastL : C.il ilast = b := LocalCoherenceProof.hlastL n p a b C + have hlastR : C.ir irlast = a := LocalCoherenceProof.hlastR n p a b C + have hwrapL : ilast + 1 = 0 := LocalCoherenceProof.hwrapL n p a b C + have hwrapR : irlast + 1 = 0 := LocalCoherenceProof.hwrapR n p a b C + have hleftB : C.left.vertex ilast = p.vertex b := LocalCoherenceProof.hleftB n p a b C hlastL + have hleftA : C.left.vertex (ilast + 1) = p.vertex a := LocalCoherenceProof.hleftA n p a b C + hfirstL hwrapL + have hrightA : C.right.vertex irlast = p.vertex a := LocalCoherenceProof.hrightA n p a b C + hlastR + have hrightB : C.right.vertex (irlast + 1) = p.vertex b := LocalCoherenceProof.hrightB n p a + b C hfirstR hwrapR + have hxL : x ∈ openSegment Real (C.left.vertex ilast) (C.left.vertex (ilast + 1)) := by + simpa [hleftA, hleftB, openSegment_symm] using hx + have hxR : x ∈ openSegment Real (C.right.vertex irlast) (C.right.vertex (irlast + 1)) := by + simpa [hrightA, hrightB] using hx + obtain ⟨rL, hrL, sL, hsideL⟩ := + (P3544T1LocalParity C.left).2.2.2.2.2.2.2.2 ilast x hxL + obtain ⟨rR, hrR, sR, hsideR⟩ := + (P3544T1LocalParity C.right).2.2.2.2.2.2.2.2 irlast x hxR + let H : Real × Real → Real := fun y => + P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] + have hreverse (y : Real × Real) : + P3381T1TriangleDeterminant ![p.vertex b, p.vertex a, y] = -H y := + LocalCoherenceProof.hreverse n p a b y + have hcanonL : ∀ y ∈ Metric.ball x rL, + (y ∈ OL ↔ if !sL then 0 < H y else H y < 0) := LocalCoherenceProof.hcanonL n p a b C x + hleftB hleftA rL sL hsideL hreverse + have hcanonR : ∀ y ∈ Metric.ball x rR, + (y ∈ OR ↔ if sR then 0 < H y else H y < 0) := LocalCoherenceProof.hcanonR n p a b C x + hrightA hrightB rR sR hsideR + have hxop : x ∈ Op := hodd hx + have hopenP : IsOpen Op := (P3544T1LocalParity p).2.1 + obtain ⟨rp, hrp, hparentball⟩ := (Metric.isOpen_iff.mp hopenP) x hxop + let rho := min (min rL rR) rp + have hABne : p.vertex a ≠ p.vertex b := LocalCoherenceProof.hABne n p a b hab + let dx := (p.vertex b).1 - (p.vertex a).1 + let dy := (p.vertex b).2 - (p.vertex a).2 + have hcoord : dx ≠ 0 ∨ dy ≠ 0 := LocalCoherenceProof.hcoord n p a b hABne + have hxdet : H x = 0 := LocalCoherenceProof.hxdet n p a b C x hx hxL hxR rL sL hsideL rR sR + hsideR hcanonL hcanonR hxop rp hparentball + have hshift (u v : Real) : H (x.1 + u, x.2 + v) = H x + dx * v - dy * u := + LocalCoherenceProof.hshift n p a b x u v + have hshiftV (v : Real) : H (x.1, x.2 + v) = H x + dx * v := by + simpa using hshift 0 v + have hshiftH (u : Real) : H (x.1 + u, x.2) = H x - dy * u := by + simpa using hshift u 0 + have hrho : 0 < rho := LocalCoherenceProof.hrho rL hrL rR hrR rp hrp + let delta := rho / 2 + have hdelta : 0 < delta := by dsimp [delta]; positivity + have hdelta_lt : delta < rho := by dsimp [delta]; linarith + have hballV (t : Real) (ht : |t| < rho) : + (x.1, x.2 + t) ∈ Metric.ball x rho := LocalCoherenceProof.hballV x rL rR rp t ht + have hballH (t : Real) (ht : |t| < rho) : + (x.1 + t, x.2) ∈ Metric.ball x rho := LocalCoherenceProof.hballH x rL rR rp t ht + have hballDelta : |delta| < rho := by rw [abs_of_pos hdelta]; exact hdelta_lt + have hballNegDelta : |-delta| < rho := LocalCoherenceProof.hballNegDelta rL rR rp hdelta + hdelta_lt + have htransverse : ∃ y ∈ Metric.ball x rho, if sL then H y < 0 else 0 < H y := + LocalCoherenceProof.htransverse n p a b x rL sL rR rp hcoord hxdet hshiftV hshiftH hdelta + hballV hballH hballDelta hballNegDelta + have hsignsOpp : sR = sL := LocalCoherenceProof.hsignsOpp n p a b C hsum x rL sL hsideL rR sR + hsideR hcanonL hcanonR rp hparentball htransverse + let s := !sL + let r := min (min rL rR) rp + refine ⟨r, lt_min (lt_min hrL hrR) hrp, s, ?_⟩ + intro y hy + have hsmallL : Metric.ball x r ⊆ Metric.ball x rL := + Metric.ball_subset_ball (le_trans (min_le_left (min rL rR) rp) (min_le_left rL rR)) + have hsmallR : Metric.ball x r ⊆ Metric.ball x rR := + Metric.ball_subset_ball (le_trans (min_le_left (min rL rR) rp) (min_le_right rL rR)) + have hsmallP : Metric.ball x r ⊆ Metric.ball x rp := + Metric.ball_subset_ball (min_le_right (min rL rR) rp) + have hyL : y ∈ Metric.ball x rL := hsmallL hy + have hyR : y ∈ Metric.ball x rR := hsmallR hy + have hyP : y ∈ Metric.ball x rp := hsmallP hy + have hL := hcanonL y hyL + have hR := hcanonR y hyR + simpa [H, s, hsignsOpp] using And.intro hL hR + exact ⟨hinterior, hfirst⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean b/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean new file mode 100644 index 0000000000..4d0e5164ef --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean @@ -0,0 +1,929 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3650T1VisibleDiagonal +public import LeanPool.ApollonianSuperharmonic.P3650T1TriangleEntry +public import Mathlib.Analysis.Normed.Affine.AddTorsorBases +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Analysis.Convex.Topology +public import Mathlib.Topology.Connected.PathConnected + +-- [TABLET NODE: P3650T1MaximalHeightDiagonal] + +/-! +# P3650T1MaximalHeightDiagonal + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace MaximalHeightGeometry + +private theorem hSne : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), (¬∀ (i + : Fin (n + (3 : ℕ))), p.vertex i ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))} → i = E.b - (1 : Fin (n + (3 : ℕ))) ∨ i = + E.b ∨ i = E.b + (1 : Fin (n + (3 : ℕ)))) → ( + let Δ := convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : Set (Real × Real)) + let S : Finset (Fin (n + 3)) := Finset.univ.filter fun i => + i ≠ E.b - 1 ∧ i ≠ E.b ∧ i ≠ E.b + 1 ∧ p.vertex i ∈ Δ + S.Nonempty) ) := by + classical + intro n p E hnotempty Δ S + by_contra h + apply hnotempty + intro i hi + by_contra hn + have hm : i ≠ E.b - 1 ∧ i ≠ E.b ∧ i ≠ E.b + 1 ∧ p.vertex i ∈ Δ := by + exact ⟨by aesop, by aesop, by aesop, hi⟩ + exact h ⟨i, Finset.mem_filter.mpr ⟨Finset.mem_univ _, hm⟩⟩ + +private theorem hbasis : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∃ A : + AffineBasis (Fin 3) Real (Real × Real), (∀ i, A i = ![p.vertex (E.b - 1), p.vertex + E.b, p.vertex (E.b + 1)] i) ∧ E.height = A.coord 1 ) := by + classical + intro n p E + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + have hdet : (b.1 - a.1) * (c.2 - a.2) - + (c.1 - a.1) * (b.2 - a.2) ≠ 0 := by + simpa [P3381T1TriangleDeterminant, a, b, c] using E.nondegenerate + have hind : AffineIndependent Real v := by + apply (affineIndependent_iff_of_fintype Real v).mpr + intro z hz hsum i + rw [Finset.weightedVSub_eq_linear_combination Finset.univ hz] at hsum + have hz' : z 0 + z 1 + z 2 = 0 := by + simpa [Fin.sum_univ_succ, ← add_assoc] using hz + have hx : z 0 * a.1 + z 1 * b.1 + z 2 * c.1 = 0 := by + simpa [Fin.sum_univ_succ, v, ← add_assoc] using congrArg Prod.fst hsum + have hy : z 0 * a.2 + z 1 * b.2 + z 2 * c.2 = 0 := by + simpa [Fin.sum_univ_succ, v, ← add_assoc] using congrArg Prod.snd hsum + have hx' : z 1 * (b.1 - a.1) + z 2 * (c.1 - a.1) = 0 := by + linear_combination hx - a.1 * hz' + have hy' : z 1 * (b.2 - a.2) + z 2 * (c.2 - a.2) = 0 := by + linear_combination hy - a.2 * hz' + have hz1 : z 1 = 0 := by + apply (mul_eq_zero.mp (show z 1 * ((b.1 - a.1) * (c.2 - a.2) - + (c.1 - a.1) * (b.2 - a.2)) = 0 by + linear_combination (c.2 - a.2) * hx' - (c.1 - a.1) * hy')).resolve_right hdet + have hz2 : z 2 = 0 := by + apply (mul_eq_zero.mp (show z 2 * ((b.1 - a.1) * (c.2 - a.2) - + (c.1 - a.1) * (b.2 - a.2)) = 0 by + linear_combination (b.1 - a.1) * hy' - (b.2 - a.2) * hx')).resolve_right hdet + fin_cases i <;> simp_all + have hspan : affineSpan Real (Set.range v) = ⊤ := by + apply hind.affineSpan_eq_top_iff_card_eq_finrank_add_one.mpr + simp [Module.finrank_prod] + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + refine ⟨A, fun _ => rfl, ?_⟩ + apply AffineMap.ext_on A.tot + rintro x ⟨i, rfl⟩ + fin_cases i <;> simp only [AffineBasis.coord_apply] + · exact E.height_prev + · exact E.height_top + · exact E.height_next + +private theorem hrange : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let Δ := convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : Set (Real × Real)) + ∀ (d : Fin (n + (3 : ℕ))), (d ≠ E.b - (1 : Fin (n + (3 : ℕ))) ∧ d ≠ E.b ∧ d ≠ E.b + (1 : + Fin (n + (3 : ℕ))) ∧ p.vertex d ∈ Δ) → (∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), + (∀ (i : Fin (3 : ℕ)), (A : Fin (3 : ℕ) → ℝ × ℝ) i = ![p.vertex (E.b - (1 : Fin (n + + (3 : ℕ)))), p.vertex E.b, p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))] i) → (Set.range A + = ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : Set (Real × Real)))) ) := by + classical + intro n p E Δ d hdprops A hA + rw [show (A : Fin 3 → Real × Real) = + ![p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)] from funext hA] + ext x + simp + tauto + +private theorem hmem : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let Δ := convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : Set (Real × Real)) + ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (Δ = convexHull Real (Set.range A)) → (∀ x, + x ∈ Δ ↔ ∀ i, 0 ≤ A.coord i x) ) := by + classical + intro n p E Δ A hΔ x + rw [hΔ] + exact (Set.ext_iff.mp A.convexHull_eq_nonneg_coord x).trans (by simp) + +private theorem hint : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let Δ := convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : Set (Real × Real)) + ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (Δ = convexHull Real (Set.range A)) → (∀ x, + x ∈ interior Δ ↔ ∀ i, 0 < A.coord i x) ) := by + classical + intro n p E Δ A hΔ x + rw [hΔ] + exact (Set.ext_iff.mp A.interior_convexHull x).trans (by simp) + +private theorem hsum : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (d : Fin (n + (3 : ℕ))), ∀ (A : + AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), A.coord 0 (p.vertex d) + A.coord 1 (p.vertex d) + + A.coord 2 (p.vertex d) = 1 ) := by + classical + intro n p d A + simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one (p.vertex d) + +private theorem hcoord0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), (d ≠ E.b) → ((d ≠ E.b + 1) → (∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ + (ℝ × ℝ)), (A 1 = p.vertex E.b) → ((A 2 = p.vertex (E.b + 1)) → ((∀ i, 0 ≤ A.coord i + (p.vertex d)) → ((A.coord 0 (p.vertex d) + A.coord 1 (p.vertex d) + A.coord 2 + (p.vertex d) = 1) → (0 < A.coord 0 (p.vertex d))))))) ) := by + classical + intro n p E d hdb hdnext A hA1 hA2 hcoord_nonneg hsum + have hn : A.coord 0 (p.vertex d) ≠ 0 := by + intro heq + have hseg : p.vertex d ∈ segment Real (p.vertex E.b) (p.vertex (E.b + 1)) := by + rw [← hA1, ← hA2, segment_eq_image_lineMap] + refine ⟨A.coord 2 (p.vertex d), ⟨hcoord_nonneg 2, ?_⟩, ?_⟩ + · have := hcoord_nonneg 1 + linarith [hsum, heq] + · apply A.ext_elem + intro i + rw [(A.coord i).apply_lineMap] + fin_cases i <;> simp [AffineMap.lineMap_apply_ring, Fin.ext_iff] <;> + linarith [hsum, heq] + have h := p.edge_intersection E.b d (by + intro heqidx + exact hdb heqidx.symm) + have hv : p.vertex d ∈ segment Real (p.vertex E.b) (p.vertex (E.b + 1)) ∩ + segment Real (p.vertex d) (p.vertex (d + 1)) := by + constructor + · exact hseg + · exact left_mem_segment Real _ _ + rw [h] at hv + rcases hv.1 with hv | hv + · exact hdb (p.injective hv) + · exact hdnext (p.injective hv) + exact lt_of_le_of_ne (hcoord_nonneg 0) (Ne.symm hn) + +private theorem hcoord2 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), (d ≠ E.b - 1) → ((d ≠ E.b) → (∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ + (ℝ × ℝ)), (A 0 = p.vertex (E.b - 1)) → ((A 1 = p.vertex E.b) → ((∀ i, 0 ≤ A.coord i + (p.vertex d)) → ((A.coord 0 (p.vertex d) + A.coord 1 (p.vertex d) + A.coord 2 + (p.vertex d) = 1) → ((0 < A.coord 0 (p.vertex d)) → (0 < A.coord 2 (p.vertex + d)))))))) ) := by + classical + intro n p E d hdprev hdb A hA0 hA1 hcoord_nonneg hsum hcoord0 + have hn : A.coord 2 (p.vertex d) ≠ 0 := by + intro heq + have hseg : p.vertex d ∈ segment Real (p.vertex (E.b - 1)) (p.vertex E.b) := by + rw [← hA0, ← hA1, segment_eq_image_lineMap] + refine ⟨A.coord 1 (p.vertex d), ⟨hcoord_nonneg 1, ?_⟩, ?_⟩ + · have := hcoord_nonneg 0 + linarith [hsum, heq] + · apply A.ext_elem + intro i + rw [(A.coord i).apply_lineMap] + fin_cases i <;> simp [AffineMap.lineMap_apply_ring, Fin.ext_iff] <;> + linarith [hsum, heq] + have h := p.edge_intersection (E.b - 1) d (by + intro heqidx + exact hdprev heqidx.symm) + have hv : p.vertex d ∈ segment Real (p.vertex (E.b - 1)) + (p.vertex ((E.b - 1) + 1)) ∩ segment Real (p.vertex d) (p.vertex (d + 1)) := by + constructor + · simpa only [sub_add_cancel] using hseg + · exact left_mem_segment Real _ _ + rw [h] at hv + rcases hv.1 with hv | hv + · exact hdprev (p.injective hv) + · have heq : d = E.b := by + simpa only [sub_add_cancel] using (p.injective hv) + exact hdb heq + exact lt_of_le_of_ne (hcoord_nonneg 2) (Ne.symm hn) + +private theorem hheightlt : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (∀ i, 0 ≤ A.coord i + (p.vertex d)) → ((A.coord 0 (p.vertex d) + A.coord 1 (p.vertex d) + A.coord 2 + (p.vertex d) = 1) → ((E.height (p.vertex d) = A.coord 1 (p.vertex d)) → ((0 < A.coord + 0 (p.vertex d)) → ((0 < A.coord 2 (p.vertex d)) → (E.height (p.vertex d) < 1))))) ) + := by + classical + intro n p E d A hcoord_nonneg hsum hheightd hcoord0 hcoord2 + rw [hheightd] + have h1 := hcoord_nonneg 1 + have h2 := hcoord_nonneg 2 + have h0 := hcoord0 + linarith + +private theorem hcoordB0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (A : + AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (A 1 = p.vertex E.b) → ( + let B := p.vertex E.b + A.coord 0 B = 0) ) := by + classical + intro n p E A hA1 B + dsimp [B] + rw [← hA1] + simp [] + +private theorem hcoordB1 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (A : + AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (A 1 = p.vertex E.b) → ( + let B := p.vertex E.b + A.coord 1 B = 1) ) := by + classical + intro n p E A hA1 B + dsimp [B] + rw [← hA1] + simp [] + +private theorem hcoordB2 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (A : + AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (A 1 = p.vertex E.b) → ( + let B := p.vertex E.b + A.coord 2 B = 0) ) := by + classical + intro n p E A hA1 B + dsimp [B] + rw [← hA1] + simp [] + +private theorem hqcoord : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + ∀ t, ∀ i, A.coord i (q t) = (1 - t) * A.coord i B + t * A.coord i P ) := by + classical + intro n p E d A B P q t i + rw [(A.coord i).apply_lineMap] + simp [AffineMap.lineMap_apply_ring] + +private theorem hqheight : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (E.height = A.coord + (1 : Fin (3 : ℕ))) → ( + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + (A.coord 1 B = 1) → ((∀ t, ∀ i, A.coord i (q t) = (1 - t) * A.coord i B + t * A.coord i + P) → (∀ t, E.height (q t) = (1 - t) + t * E.height P))) ) := by + classical + intro n p E d A hheight B P q hcoordB1 hqcoord t + rw [hheight, hqcoord t 1, hcoordB1] + ring + +private theorem hqinterior : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let Δ := convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : Set (Real × Real)) + ∀ (d : Fin (n + (3 : ℕ))), ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (∀ x, x ∈ + interior Δ ↔ ∀ i, 0 < A.coord i x) → ((∀ i, 0 ≤ A.coord i (p.vertex d)) → ((A.coord 0 + (p.vertex d) + A.coord 1 (p.vertex d) + A.coord 2 (p.vertex d) = 1) → ((0 < A.coord 0 + (p.vertex d)) → ((0 < A.coord 2 (p.vertex d)) → ( + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + (A.coord 0 B = 0) → ((A.coord 1 B = 1) → ((A.coord 2 B = 0) → ((∀ t, ∀ i, A.coord i (q t) + = (1 - t) * A.coord i B + t * A.coord i P) → (∀ t, 0 < t → t < 1 → q t ∈ interior + Δ))))))))) ) := by + classical + intro n p E Δ d A hint hcoord_nonneg hsum hcoord0 hcoord2 B P q hcoordB0 hcoordB1 hcoordB2 + hqcoord t ht0 ht1 + apply (hint _).2 + intro i + fin_cases i + · change 0 < A.coord (0 : Fin 3) (q t) + rw [hqcoord t 0, hcoordB0] + dsimp [P] + nlinarith [mul_pos ht0 hcoord0] + · change 0 < A.coord (1 : Fin 3) (q t) + rw [hqcoord t 1, hcoordB1] + dsimp [P] + nlinarith [hcoord_nonneg 1] + · change 0 < A.coord (2 : Fin 3) (q t) + rw [hqcoord t 2, hcoordB2] + dsimp [P] + nlinarith [mul_pos ht0 hcoord2] + +private theorem hqmargin : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (A.coord 0 (p.vertex + d) + A.coord 1 (p.vertex d) + A.coord 2 (p.vertex d) = 1) → ((E.height (p.vertex d) = + A.coord 1 (p.vertex d)) → ((0 < A.coord 0 (p.vertex d)) → ((0 < A.coord 2 (p.vertex + d)) → ( + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + (∀ t, E.height (q t) = (1 - t) + t * E.height P) → (∀ t, 0 < t → t < 1 → E.height P < + E.height (q t)))))) ) := by + classical + intro n p E d A hsum hheightd hcoord0 hcoord2 B P q hqheight t ht0 ht1 + rw [hqheight] + have hprod : 0 < (1 - t) * (1 - E.height P) := + mul_pos (by linarith) (by linarith [hheightlt]) + nlinarith + +private theorem hqleft : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (A 0 = p.vertex (E.b + - 1)) → ((0 < A.coord 2 (p.vertex d)) → ( + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + (A.coord 2 B = 0) → ((∀ t, ∀ i, A.coord i (q t) = (1 - t) * A.coord i B + t * A.coord i + P) → (∀ t, 0 < t → t < 1 → q t ∉ segment Real (p.vertex (E.b - 1)) B)))) ) := by + classical + intro n p E d A hA0 hcoord2 B P q hcoordB2 hqcoord t ht0 ht1 hs + have hcoordprev : A.coord 2 (p.vertex (E.b - 1)) = 0 := by + rw [← hA0] + simp [] + rw [segment_eq_image_lineMap] at hs + obtain ⟨u, hu, heq⟩ := hs + have heqcoord := congrArg (A.coord 2) heq + rw [(A.coord 2).apply_lineMap, hcoordprev, hcoordB2] at heqcoord + have hqtpos : 0 < A.coord 2 (q t) := by + rw [hqcoord t 2, hcoordB2] + dsimp [P] + nlinarith [mul_pos ht0 hcoord2] + simp [] at heqcoord + linarith + +private theorem hqright : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (A 2 = p.vertex (E.b + + 1)) → ((0 < A.coord 0 (p.vertex d)) → ( + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + (A.coord 0 B = 0) → ((∀ t, ∀ i, A.coord i (q t) = (1 - t) * A.coord i B + t * A.coord i + P) → (∀ t, 0 < t → t < 1 → q t ∉ segment Real B (p.vertex (E.b + 1)))))) ) := by + classical + intro n p E d A hA2 hcoord0 B P q hcoordB0 hqcoord t ht0 ht1 hs + have hcoordnext : A.coord 0 (p.vertex (E.b + 1)) = 0 := by + rw [← hA2] + simp [] + rw [segment_eq_image_lineMap] at hs + obtain ⟨u, hu, heq⟩ := hs + have heqcoord := congrArg (A.coord 0) heq + rw [(A.coord 0).apply_lineMap, hcoordB0, hcoordnext] at heqcoord + have hqtpos : 0 < A.coord 0 (q t) := by + rw [hqcoord t 0, hcoordB0] + dsimp [P] + nlinarith [mul_pos ht0 hcoord0] + simp [] at heqcoord + linarith + +private theorem hqclear : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), (∀ (j + : Fin (n + (3 : ℕ))), ∀ (w : ℝ × ℝ), j ≠ E.b - (1 : Fin (n + (3 : ℕ))) → j ≠ E.b → w + ∈ interior ((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))}) → w ∈ segment ℝ (p.vertex j) (p.vertex (j + + (1 : Fin (n + (3 : ℕ))))) → ∃ (k : Fin (n + (3 : ℕ))), (k = j ∨ k = j + (1 : Fin (n + + (3 : ℕ)))) ∧ p.vertex k ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))} ∧ (E.height : ℝ × ℝ → ℝ) w ≤ (E.height : ℝ + × ℝ → ℝ) (p.vertex k)) → ( + let Δ := convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : Set (Real × Real)) + let S : Finset (Fin (n + 3)) := Finset.univ.filter fun i => + i ≠ E.b - 1 ∧ i ≠ E.b ∧ i ≠ E.b + 1 ∧ p.vertex i ∈ Δ + ∀ (d : Fin (n + (3 : ℕ))), (∀ x' ∈ S, (E.height : ℝ × ℝ → ℝ) (p.vertex x') ≤ (E.height : + ℝ × ℝ → ℝ) (p.vertex d)) → (∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (∀ i, 0 ≤ + A.coord i (p.vertex d)) → ((E.height (p.vertex d) = A.coord 1 (p.vertex d)) → ( + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + (∀ t, 0 < t → t < 1 → q t ∈ interior Δ) → ((∀ t, 0 < t → t < 1 → E.height P < E.height (q + t)) → ((∀ t, 0 < t → t < 1 → q t ∉ segment Real (p.vertex (E.b - 1)) B) → ((∀ t, 0 < + t → t < 1 → q t ∉ segment Real B (p.vertex (E.b + 1))) → (∀ t, 0 < t → t < 1 → q t ∉ + P3544T1BoundaryCarrier p)))))))) ) := by + classical + intro n p E hentry Δ S d hdmax A hcoord_nonneg hheightd B P q hqinterior hqmargin hqleft + hqright t ht0 ht1 hc + obtain ⟨j, hj⟩ := Set.mem_iUnion.mp hc + change q t ∈ segment Real (p.vertex j) (p.vertex (j + 1)) at hj + have hspecial : j ≠ E.b - 1 ∧ j ≠ E.b := by + constructor + · intro h + exact hqleft t ht0 ht1 (by simpa [h, sub_add_cancel] using hj) + · intro h + exact hqright t ht0 ht1 (by simpa [h] using hj) + obtain ⟨k, hkj, hkΔ, hle⟩ := hentry j (q t) hspecial.1 hspecial.2 + (hqinterior t ht0 ht1) hj + have hstrict := hqmargin t ht0 ht1 + have hknotb : k ≠ E.b := by + intro hk + rcases hkj with hkj | hkj + · have hjval : j = E.b := hkj.symm.trans hk + exact hspecial.2 hjval + · have hjval : j = E.b - 1 := by + calc + j = (j + 1) - 1 := by simp + _ = E.b - 1 := by rw [hkj.symm.trans hk] + exact hspecial.1 hjval + have hknotsides : k ≠ E.b - 1 ∧ k ≠ E.b + 1 := by + constructor + · intro hk + have hzero : E.height (p.vertex k) = 0 := by + simpa [hk] using E.height_prev + have hnonneg : 0 ≤ E.height P := by + rw [hheightd] + exact hcoord_nonneg 1 + linarith + · intro hk + have hzero : E.height (p.vertex k) = 0 := by + simpa [hk] using E.height_next + have hnonneg : 0 ≤ E.height P := by + rw [hheightd] + exact hcoord_nonneg 1 + linarith + have hkS : k ∈ S := by + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + exact ⟨hknotsides.1, hknotb, hknotsides.2, by simpa [Δ] using hkΔ⟩ + have hmax := hdmax k hkS + linarith + +private theorem hPdecomp : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (A 0 = p.vertex (E.b + - 1)) → ((A 1 = p.vertex E.b) → ((A 2 = p.vertex (E.b + 1)) → ((A.coord 0 (p.vertex + d) + A.coord 1 (p.vertex d) + A.coord 2 (p.vertex d) = 1) → ( + let B := p.vertex E.b + let P := p.vertex d + P = B + A.coord 0 P • (p.vertex (E.b - 1) - B) + A.coord 2 P • (p.vertex (E.b + 1) - + B))))) ) := by + classical + intro n p E d A hA0 hA1 hA2 hsum B P + have hcomb := A.linear_combination_coord_eq_self P + rw [Fin.sum_univ_three, hA0, hA1, hA2] at hcomb + have hsumP : A.coord 0 P + A.coord 1 P + A.coord 2 P = 1 := by + simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one P + have hcoord1P : A.coord 1 P = 1 - A.coord 0 P - A.coord 2 P := by + linarith [hsumP] + apply Prod.ext + · have hxcomb := congrArg Prod.fst hcomb + change A.coord 0 P * (p.vertex (E.b - 1)).1 + + A.coord 1 P * B.1 + A.coord 2 P * (p.vertex (E.b + 1)).1 = P.1 at hxcomb + calc + P.1 = A.coord 0 P * (p.vertex (E.b - 1)).1 + + A.coord 1 P * B.1 + A.coord 2 P * (p.vertex (E.b + 1)).1 := by + exact hxcomb.symm + _ = B.1 + A.coord 0 P * ((p.vertex (E.b - 1)).1 - B.1) + + A.coord 2 P * ((p.vertex (E.b + 1)).1 - B.1) := by + linear_combination B.1 * hsumP + · have hycomb := congrArg Prod.snd hcomb + change A.coord 0 P * (p.vertex (E.b - 1)).2 + + A.coord 1 P * B.2 + A.coord 2 P * (p.vertex (E.b + 1)).2 = P.2 at hycomb + calc + P.2 = A.coord 0 P * (p.vertex (E.b - 1)).2 + + A.coord 1 P * B.2 + A.coord 2 P * (p.vertex (E.b + 1)).2 := by + exact hycomb.symm + _ = B.2 + A.coord 0 P * ((p.vertex (E.b - 1)).2 - B.2) + + A.coord 2 P * ((p.vertex (E.b + 1)).2 - B.2) := by + linear_combination B.2 * hsumP + +private theorem ht₀ball : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + ∀ (r : ℝ), ∀ (u : ℝ), ∀ (v : ℝ), (Set.Ioo u v ⊆ q ⁻¹' Metric.ball B r) → ((u < (0 : ℝ)) → + (∀ (t₀ : ℝ), ((0 : ℝ) < t₀) → ((t₀ < min v (1 : ℝ)) → (q t₀ ∈ Metric.ball B r)))) ) + := by + classical + intro n p E d B P q r u v hsub huv t₀ ht₀ ht₀min + apply hsub + exact ⟨by linarith [huv], lt_of_lt_of_le ht₀min (min_le_left _ _)⟩ + +private theorem hqdecomp : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + (P = B + A.coord 0 P • (p.vertex (E.b - 1) - B) + A.coord 2 P • (p.vertex (E.b + 1) - B)) + → (∀ (t₀ : ℝ), q t₀ = B + (t₀ * A.coord 0 P) • (p.vertex (E.b - 1) - B) + (t₀ * + A.coord 2 P) • (p.vertex (E.b + 1) - B)) ) := by + classical + intro n p E d A B P q hPdecomp t₀ + rw [show q t₀ = B + t₀ • (P - B) by + apply Prod.ext <;> simp [q, AffineMap.lineMap_apply_ring, smul_eq_mul] <;> ring] + have hvec : P - B = + A.coord 0 P • (p.vertex (E.b - 1) - B) + + A.coord 2 P • (p.vertex (E.b + 1) - B) := by + calc + P - B = (B + A.coord 0 P • (p.vertex (E.b - 1) - B) + + A.coord 2 P • (p.vertex (E.b + 1) - B)) - B := + congrArg (fun x : Real × Real => x - B) hPdecomp + _ = A.coord 0 P • (p.vertex (E.b - 1) - B) + + A.coord 2 P • (p.vertex (E.b + 1) - B) := by abel + rw [hvec] + module + +private theorem hodd0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (0 < A.coord 0 + (p.vertex d)) → ((0 < A.coord 2 (p.vertex d)) → ( + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + ∀ (r : ℝ), (∀ x ∈ Metric.ball (p.vertex E.b) r, x ∈ P3544T1RayParity p ↔ ∃ (s : ℝ) (t : + ℝ), (0 : ℝ) < s ∧ (0 : ℝ) < t ∧ x = p.vertex E.b + s • (p.vertex (E.b - (1 : Fin (n + + (3 : ℕ)))) - p.vertex E.b) + t • (p.vertex (E.b + (1 : Fin (n + (3 : ℕ)))) - p.vertex + E.b)) → (∀ (t₀ : ℝ), ((0 : ℝ) < t₀) → ((q t₀ ∈ Metric.ball B r) → ((q t₀ = B + (t₀ * + A.coord 0 P) • (p.vertex (E.b - 1) - B) + (t₀ * A.coord 2 P) • (p.vertex (E.b + 1) - + B)) → (q t₀ ∈ P3544T1RayParity p)))))) ) := by + classical + intro n p E d A hcoord0 hcoord2 B P q r hcone t₀ ht₀ ht₀ball hqdecomp + apply (hcone (q t₀) ht₀ball).2 + refine ⟨t₀ * A.coord 0 P, t₀ * A.coord 2 P, + mul_pos ht₀ hcoord0, mul_pos ht₀ hcoord2, ?_⟩ + simpa only [B, P] using hqdecomp + +private theorem hUopen : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + (Continuous q) → ((IsOpen (P3544T1RayParity p)) → ( + let I : Set Real := Set.Ioo 0 1 + let U : Set Real := I ∩ q ⁻¹' P3544T1RayParity p + IsOpen U)) ) := by + classical + intro n p E d B P q hqcont hO I U + change IsOpen (I ∩ q ⁻¹' P3544T1RayParity p) + exact isOpen_Ioo.inter (hO.preimage hqcont) + +private theorem hVopen : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + (∀ t, 0 < t → t < 1 → q t ∉ P3544T1BoundaryCarrier p) → ((Continuous q) → ((∀ x ∉ + P3544T1BoundaryCarrier p, ∃ (r : ℝ), (0 : ℝ) < r ∧ (Metric.ball x r ⊆ + P3544T1RayParity p ∨ Disjoint (Metric.ball x r) (P3544T1RayParity p))) → ( + let I : Set Real := Set.Ioo 0 1 + let V : Set Real := I ∩ (q ⁻¹' P3544T1RayParity p)ᶜ + IsOpen V))) ) := by + classical + intro n p E d B P q hqclear hqcont hballs I V + apply isOpen_iff_forall_mem_open.mpr + intro t ht + rcases ht with ⟨htI, htO⟩ + obtain ⟨ρ, hρ, hballO | hdisj⟩ := + hballs (q t) (hqclear t htI.1 htI.2) + · have hqtball : q t ∈ Metric.ball (q t) ρ := Metric.mem_ball_self hρ + exact (htO (hballO hqtball)).elim + · let W : Set Real := I ∩ q ⁻¹' Metric.ball (q t) ρ + refine ⟨W, ?_, ?_, ?_⟩ + · intro s hs + rcases hs with ⟨hsI, hsball⟩ + exact ⟨hsI, fun hsO => (Set.disjoint_left.mp hdisj hsball hsO).elim⟩ + · change IsOpen (I ∩ q ⁻¹' Metric.ball (q t) ρ) + exact isOpen_Ioo.inter (Metric.isOpen_ball.preimage hqcont) + · exact ⟨htI, Metric.mem_ball_self hρ⟩ + +private theorem hUVdisj : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + let I : Set Real := Set.Ioo 0 1 + let U : Set Real := I ∩ q ⁻¹' P3544T1RayParity p + let V : Set Real := I ∩ (q ⁻¹' P3544T1RayParity p)ᶜ + Disjoint U V ) := by + classical + intro n p E d B P q I U V + apply Set.disjoint_left.mpr + intro t htU htV + exact htV.2 htU.2 + +private theorem hIcover : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + let I : Set Real := Set.Ioo 0 1 + let U : Set Real := I ∩ q ⁻¹' P3544T1RayParity p + let V : Set Real := I ∩ (q ⁻¹' P3544T1RayParity p)ᶜ + I ⊆ U ∪ V ) := by + classical + intro n p E d B P q I U V t ht + by_cases ho : q t ∈ P3544T1RayParity p + · exact Or.inl ⟨ht, ho⟩ + · exact Or.inr ⟨ht, ho⟩ + +private theorem hIodd : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + ∀ (t₀ : ℝ), ((0 : ℝ) < t₀) → ((t₀ < 1) → ((q t₀ ∈ P3544T1RayParity p) → ( + let I : Set Real := Set.Ioo 0 1 + let U : Set Real := I ∩ q ⁻¹' P3544T1RayParity p + let V : Set Real := I ∩ (q ⁻¹' P3544T1RayParity p)ᶜ + (I ⊆ U ∨ I ⊆ V) → (I ⊆ q ⁻¹' P3544T1RayParity p)))) ) := by + classical + intro n p E d B P q t₀ ht₀ ht₀1 hodd0 I U V hIsplit + rcases hIsplit with hU | hV + · intro t ht + exact (hU ht).2 + · exfalso + have := (hV ⟨ht₀, ht₀1⟩).2 + exact this hodd0 + +private theorem hodd : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + let I : Set Real := Set.Ioo 0 1 + (I ⊆ q ⁻¹' P3544T1RayParity p) → (openSegment Real B P ⊆ P3544T1RayParity p) ) := by + classical + intro n p E d B P q I hIodd x hx + rw [openSegment_eq_image_lineMap] at hx + simp only [Set.mem_image] at hx + rcases hx with ⟨t, ht, htx⟩ + have htI : t ∈ I := by simpa [I] using ht + have hqt := hIodd htI + change q t ∈ P3544T1RayParity p at hqt + rw [← htx] + exact hqt + +private theorem hnotprevious : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : + Fin (n + (3 : ℕ))), (d ≠ E.b - 1) → (E.b ≠ d + 1) ) := by + classical + intro n p E d hdprev heq + have hdval : d = E.b - 1 := by + calc + d = (d + 1) - 1 := by simp + _ = E.b - 1 := by rw [heq] + exact hdprev hdval + +private theorem hiS : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let Δ := convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : Set (Real × Real)) + let S : Finset (Fin (n + 3)) := Finset.univ.filter fun i => + i ≠ E.b - 1 ∧ i ≠ E.b ∧ i ≠ E.b + 1 ∧ p.vertex i ∈ Δ + ∀ (i : Fin (n + (3 : ℕ))), (i ≠ E.b - (1 : Fin (n + (3 : ℕ)))) → ((i ≠ E.b) → ((i ≠ E.b + + (1 : Fin (n + (3 : ℕ)))) → ((p.vertex i ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))}) → (i ∈ S)))) ) := by + classical + intro n p E Δ S i hiprev hib hinext hiΔ + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_univ _, ?_⟩ + exact ⟨hiprev, hib, hinext, by simpa [Δ] using hiΔ⟩ + +end MaximalHeightGeometry + +theorem P3650T1MaximalHeightDiagonal {n : Nat} (p : P3381T1PolygonBoundary n) + (E : P3650T1ExposedCorner p) + (hentry : ∀ (j : Fin (n + 3)) (w : Real × Real), j ≠ E.b - 1 → j ≠ E.b → + w ∈ interior (convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : + Set (Real × Real))) → + w ∈ segment Real (p.vertex j) (p.vertex (j + 1)) → + ∃ k, (k = j ∨ k = j + 1) ∧ + p.vertex k ∈ convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : + Set (Real × Real)) ∧ E.height w ≤ E.height (p.vertex k)) + (hnotempty : ¬ (∀ i, p.vertex i ∈ convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : + Set (Real × Real)) → i = E.b - 1 ∨ i = E.b ∨ i = E.b + 1)) : + ∃ D : P3650T1VisibleDiagonal p E, D.a = E.b ∧ + p.vertex D.b ∈ convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : + Set (Real × Real)) ∧ + ∀ i, i ≠ E.b - 1 → i ≠ E.b → i ≠ E.b + 1 → + p.vertex i ∈ convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : + Set (Real × Real)) → E.height (p.vertex i) ≤ E.height (p.vertex D.b) := by +-- BODY + classical + let Δ := convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : Set (Real × Real)) + let S : Finset (Fin (n + 3)) := Finset.univ.filter fun i => + i ≠ E.b - 1 ∧ i ≠ E.b ∧ i ≠ E.b + 1 ∧ p.vertex i ∈ Δ + have hSne := MaximalHeightGeometry.hSne n p E hnotempty + obtain ⟨d, hdS, hdmax⟩ := Finset.exists_max_image S (fun i => E.height (p.vertex i)) hSne + have hdmem : d ∈ S := hdS + have hdprops := (Finset.mem_filter.mp hdmem).2 + have hdΔ : p.vertex d ∈ Δ := hdprops.2.2.2 + have hdprev : d ≠ E.b - 1 := hdprops.1 + have hdb : d ≠ E.b := hdprops.2.1 + have hdnext : d ≠ E.b + 1 := hdprops.2.2.1 + have hbasis := MaximalHeightGeometry.hbasis n p E + obtain ⟨A, hA, hheight⟩ := hbasis + have hA0 : A 0 = p.vertex (E.b - 1) := hA 0 + have hA1 : A 1 = p.vertex E.b := hA 1 + have hA2 : A 2 = p.vertex (E.b + 1) := hA 2 + have hrange : Set.range A = + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : Set (Real × Real)) := + MaximalHeightGeometry.hrange n p E d hdprops A hA + have hΔ : Δ = convexHull Real (Set.range A) := by + rw [hrange] + have hmem := MaximalHeightGeometry.hmem n p E A hΔ + have hint := MaximalHeightGeometry.hint n p E A hΔ + have hcoord_nonneg : ∀ i, 0 ≤ A.coord i (p.vertex d) := (hmem _).mp hdΔ + have hsum := MaximalHeightGeometry.hsum n p d A + have hheightd : E.height (p.vertex d) = A.coord 1 (p.vertex d) := by + rw [hheight] + have hcoord0 := MaximalHeightGeometry.hcoord0 n p E d hdb hdnext A hA1 hA2 hcoord_nonneg hsum + have hcoord2 := MaximalHeightGeometry.hcoord2 n p E d hdprev hdb A hA0 hA1 hcoord_nonneg hsum + hcoord0 + have hheightlt := MaximalHeightGeometry.hheightlt n p E d A hcoord_nonneg hsum hheightd hcoord0 + hcoord2 + let B := p.vertex E.b + let P := p.vertex d + let q : Real → Real × Real := AffineMap.lineMap B P + have hcoordB0 := MaximalHeightGeometry.hcoordB0 n p E A hA1 + have hcoordB1 := MaximalHeightGeometry.hcoordB1 n p E A hA1 + have hcoordB2 := MaximalHeightGeometry.hcoordB2 n p E A hA1 + have hqcoord := MaximalHeightGeometry.hqcoord n p E d A + have hqheight := MaximalHeightGeometry.hqheight n p E d A hheight hcoordB1 hqcoord + have hqinterior := MaximalHeightGeometry.hqinterior n p E d A hint hcoord_nonneg hsum hcoord0 + hcoord2 hcoordB0 hcoordB1 hcoordB2 hqcoord + have hqmargin := MaximalHeightGeometry.hqmargin n p E d A hsum hheightd hcoord0 hcoord2 hqheight + have hqleft := MaximalHeightGeometry.hqleft n p E d A hA0 hcoord2 hcoordB2 hqcoord + have hqright := MaximalHeightGeometry.hqright n p E d A hA2 hcoord0 hcoordB0 hqcoord + have hqclear := MaximalHeightGeometry.hqclear n p E hentry d hdmax A hcoord_nonneg hheightd + hqinterior hqmargin hqleft hqright + have hPdecomp := MaximalHeightGeometry.hPdecomp n p E d A hA0 hA1 hA2 hsum + obtain ⟨r, hr, hcone⟩ := E.cone_odd + have hqcont : Continuous q := + (AffineMap.lineMap (k := Real) B P).continuous_of_finiteDimensional + have hqzero : q 0 = B := by + simp [q] + have hball := Metric.ball_mem_nhds (q 0) hr + have hqat0 : ContinuousAt q (0 : Real) := hqcont.continuousAt + have hpre := hqat0.preimage_mem_nhds hball + have hcontinuousball := by simpa only [hqzero] using hpre + obtain ⟨u, v, ⟨huv, hv1⟩, hsub⟩ := + mem_nhds_iff_exists_Ioo_subset.mp hcontinuousball + have hmin : 0 < min v (1 : Real) := lt_min hv1 zero_lt_one + obtain ⟨t₀, ht₀, ht₀min⟩ := exists_between hmin + have ht₀1 : t₀ < 1 := lt_of_lt_of_le ht₀min (min_le_right _ _) + have ht₀ball := MaximalHeightGeometry.ht₀ball n p E d r u v hsub huv t₀ ht₀ ht₀min + have hqdecomp := MaximalHeightGeometry.hqdecomp n p E d A hPdecomp t₀ + have hodd0 := MaximalHeightGeometry.hodd0 n p E d A hcoord0 hcoord2 r hcone t₀ ht₀ ht₀ball + hqdecomp + obtain ⟨_, hO, _, _, hballs, _, _, _, _⟩ := P3544T1LocalParity p + let I : Set Real := Set.Ioo 0 1 + let U : Set Real := I ∩ q ⁻¹' P3544T1RayParity p + let V : Set Real := I ∩ (q ⁻¹' P3544T1RayParity p)ᶜ + have hUopen := MaximalHeightGeometry.hUopen n p E d hqcont hO + have hVopen := MaximalHeightGeometry.hVopen n p E d hqclear hqcont hballs + have hUVdisj := MaximalHeightGeometry.hUVdisj n p E d + have hIcover := MaximalHeightGeometry.hIcover n p E d + have hIsplit : + I ⊆ U ∨ I ⊆ V := + isPreconnected_Ioo.subset_or_subset hUopen hVopen hUVdisj hIcover + have hIodd := MaximalHeightGeometry.hIodd n p E d t₀ ht₀ ht₀1 hodd0 hIsplit + have hodd := MaximalHeightGeometry.hodd n p E d hIodd + have hnotprevious := MaximalHeightGeometry.hnotprevious n p E d hdprev + refine ⟨{ + a := E.b + b := d + distinct := hdb.symm + not_next := hdnext + not_previous := hnotprevious + clear := ?_ + odd := ?_ + route := Or.inr ⟨rfl, hdprev, hdnext, hdΔ⟩ + }, rfl, hdΔ, ?_⟩ + · apply Set.disjoint_left.mpr + intro x hx hc + rw [openSegment_eq_image_lineMap] at hx + simp only [Set.mem_image] at hx + rcases hx with ⟨t, ht, rfl⟩ + exact hqclear t ht.1 ht.2 hc + · intro x hx + exact hodd hx + · intro i hiprev hib hinext hiΔ + have hiS := MaximalHeightGeometry.hiS n p E i hiprev hib hinext hiΔ + exact hdmax i hiS + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean new file mode 100644 index 0000000000..eaa08e8389 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean @@ -0,0 +1,3300 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3650T1VisibleDiagonal +public import LeanPool.ApollonianSuperharmonic.P3650T1CyclicChildren +public import LeanPool.ApollonianSuperharmonic.P3650T1ParitySum +public import LeanPool.ApollonianSuperharmonic.P3650T1TriangleEntry +public import LeanPool.ApollonianSuperharmonic.P3544T1TriangleRayGeometry +public import LeanPool.ApollonianSuperharmonic.P5667T1CyclicChildrenOldArcsPreconnected + +-- [TABLET NODE: P3650T1OldArcEven] + +/-! +# P3650T1OldArcEven + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OldArcParityProof + +private theorem hLoff : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let e := segment Real (p.vertex D.a) (p.vertex D.b) + let CL := P3544T1BoundaryCarrier C.left + let CR := P3544T1BoundaryCarrier C.right + Disjoint (CL \ e) CR ) := by + classical + intro n p E D C e CL CR + rw [Set.disjoint_left] + intro x hxL hxR + have hi : x ∈ CL ∩ CR := ⟨hxL.1, hxR⟩ + change x ∈ P3544T1BoundaryCarrier C.left ∩ + P3544T1BoundaryCarrier C.right at hi + rw [C.carrier_intersection] at hi + exact hxL.2 hi + +private theorem hRoff : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let e := segment Real (p.vertex D.a) (p.vertex D.b) + let CL := P3544T1BoundaryCarrier C.left + let CR := P3544T1BoundaryCarrier C.right + Disjoint (CR \ e) CL ) := by + classical + intro n p E D C e CL CR + rw [Set.disjoint_left] + intro x hxR hxL + have hi : x ∈ CL ∩ CR := ⟨hxL, hxR.1⟩ + change x ∈ P3544T1BoundaryCarrier C.left ∩ + P3544T1BoundaryCarrier C.right at hi + rw [C.carrier_intersection] at hi + exact hxR.2 hi + +private theorem hLparent : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let e := segment Real (p.vertex D.a) (p.vertex D.b) + let CL := P3544T1BoundaryCarrier C.left + let CP := P3544T1BoundaryCarrier p + CL \ e ⊆ CP ) := by + classical + intro n p E D C e CL CP x hx + let CR := P3544T1BoundaryCarrier C.right + have hmem : x ∈ CL ∪ CR := Or.inl hx.1 + change x ∈ P3544T1BoundaryCarrier C.left ∪ + P3544T1BoundaryCarrier C.right at hmem + rw [C.carrier_union] at hmem + rcases hmem with hparent | hdiag + · exact hparent + · exact (hx.2 hdiag).elim + +private theorem hRparent : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let e := segment Real (p.vertex D.a) (p.vertex D.b) + let CR := P3544T1BoundaryCarrier C.right + let CP := P3544T1BoundaryCarrier p + CR \ e ⊆ CP ) := by + classical + intro n p E D C e CR CP x hx + let CL := P3544T1BoundaryCarrier C.left + have hmem : x ∈ CL ∪ CR := Or.inr hx.1 + change x ∈ P3544T1BoundaryCarrier C.left ∪ + P3544T1BoundaryCarrier C.right at hmem + rw [C.carrier_union] at hmem + rcases hmem with hparent | hdiag + · exact hparent + · exact (hx.2 hdiag).elim + +private theorem oldArcEvenOnPreconnected : + (by + classical + exact + ∀ {X : Type}, ∀ [TopologicalSpace X], ∀ (O : Set X), ∀ (K : Set X), ∀ (S : Set X), + (IsOpen O) → ((closure O = O ∪ K) → ((IsPreconnected S) → ((Disjoint S K) → (∀ (x : + X), (x ∈ S) → ((x ∉ O) → (Disjoint S O)))))) ) := by + classical + intro X typeclassInstance0 O K S hO hclosure hS hSK x hx hxO + classical + have hE : IsOpen (O ∪ K)ᶜ := by + rw [← hclosure] + exact isClosed_closure.isOpen_compl + have hOE : Disjoint O (O ∪ K)ᶜ := + Set.disjoint_left.mpr (fun y hy hye => hye (Or.inl hy)) + have hcover : S ⊆ O ∪ (O ∪ K)ᶜ := by + intro y hy + by_cases hyO : y ∈ O + · exact Or.inl hyO + · refine Or.inr ?_ + rintro (hyO' | hyK) + · exact hyO hyO' + · exact Set.disjoint_left.mp hSK hy hyK + rcases IsPreconnected.subset_or_subset hO hE hOE hcover hS with hSO | hSE + · exact False.elim (hxO (hSO hx)) + · exact Set.disjoint_left.mpr (fun y hy hyO => hSE hy (Or.inl hyO)) + +private theorem oldArcOddOnPreconnected : + (by + classical + exact + (∀ {X : Type}, ∀ [TopologicalSpace X], ∀ (O : Set X), ∀ (K : Set X), ∀ (S : Set X), + (IsOpen O) → ((closure O = O ∪ K) → ((IsPreconnected S) → ((Disjoint S K) → (∀ (x : + X), (x ∈ S) → ((x ∉ O) → (Disjoint S O))))))) → (∀ {X : Type}, ∀ [TopologicalSpace + X], ∀ (O : Set X), ∀ (K : Set X), ∀ (S : Set X), (IsOpen O) → ((closure O = O ∪ K) → + ((IsPreconnected S) → ((Disjoint S K) → (∀ (x : X), (x ∈ S) → ((x ∈ O) → (S ⊆ + O))))))) ) := by + classical + intro oldArcEvenOnPreconnected X typeclassInstance0 O K S hO hclosure hS hSK x hx hxO y hy + by_contra hyO + have hEven := oldArcEvenOnPreconnected O K S hO hclosure hS hSK y hy hyO + exact Set.disjoint_left.mp hEven hx hxO + +private theorem oldArcEvenClosure : + (by + classical + exact + ∀ {X : Type}, ∀ [TopologicalSpace X], ∀ (O : Set X), ∀ (S : Set X), (IsOpen O) → + ((Disjoint S O) → (Disjoint (closure S) O)) ) := by + classical + intro X typeclassInstance0 O S hO hSO + have hsub : S ⊆ Oᶜ := fun y hy hyO => Set.disjoint_left.mp hSO hy hyO + have hclosed : closure S ⊆ Oᶜ := closure_minimal hsub hO.isClosed_compl + exact Set.disjoint_left.mpr (fun y hy hyO => hclosed hy hyO) + +private theorem leftFirstIndex : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), C.il 1 = + D.a + 1 ) := by + classical + intro n p E D C + have hN : 0 < n + 3 := by omega + have hlen : (List.ofFn (fun i : Fin (n + 3) => i)).length = n + 3 := by simp + have hrot0 := List.getElem?_rotate + (l := List.ofFn (fun i : Fin (n + 3) => i)) (n := C.rotation) (m := 0) (by simp) + rw [C.parent_order] at hrot0 + simp only [List.getElem?_cons_zero] at hrot0 + conv_rhs at hrot0 => + rw [List.getElem?_eq_getElem (Nat.mod_lt _ (by simp []))] + rw [List.getElem_ofFn] + have hrotval : C.rotation % (n + 3) = D.a.val := by + have heq := Option.some.inj hrot0 + have hv := congrArg Fin.val heq.symm + simpa [hlen] using hv + have hrot1 := List.getElem?_rotate + (l := List.ofFn (fun i : Fin (n + 3) => i)) (n := C.rotation) (m := 1) (by omega) + rw [C.parent_order] at hrot1 + have hidxNat : (1 + C.rotation) % (n + 3) = (D.a.val + 1) % (n + 3) := by + calc + (1 + C.rotation) % (n + 3) = (1 + C.rotation % (n + 3)) % (n + 3) := by + rw [Nat.add_mod] + simp [] + _ = (1 + D.a.val) % (n + 3) := by rw [hrotval] + _ = (D.a.val + 1) % (n + 3) := by rw [Nat.add_comm] + have hidx : (⟨(1 + C.rotation) % + (List.ofFn (fun i : Fin (n + 3) => i)).length, + by rw [hlen]; exact Nat.mod_lt _ hN⟩ : Fin (n + 3)) = D.a + 1 := by + apply Fin.ext + simpa only [Fin.val_add, Fin.val_one, hlen] using hidxNat + have hsource : (List.ofFn (fun i : Fin (n + 3) => i))[ + (1 + C.rotation) % (List.ofFn (fun i : Fin (n + 3) => i)).length]? = + some (D.a + 1) := by + rw [List.getElem?_eq_getElem (Nat.mod_lt _ (by simp []))] + rw [List.getElem_ofFn] + exact congrArg some hidx + rw [hsource] at hrot1 + have hu0 : C.u[0]? = some (D.a + 1) := by + simpa [List.getElem?_append, C.hu] using hrot1 + have hleft1 := congrArg (fun l => l[1]?) C.left_order + simp? at hleft1 + have hu0val : C.u[0]'C.hu = D.a + 1 := by + have hopt := hu0 + rw [List.getElem?_eq_getElem C.hu] at hopt + exact Option.some.inj hopt + have hleft1' : C.il 1 = C.u[0]'C.hu := by + simpa only [List.getElem_append_left C.hu] using hleft1 + exact hleft1'.trans hu0val + +private theorem propagateRight : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let e := segment Real (p.vertex D.a) (p.vertex D.b) + let CL := P3544T1BoundaryCarrier C.left + let CR := P3544T1BoundaryCarrier C.right + let OR := P3544T1RayParity C.right + (Disjoint (CL \ e) CR) → ((∀ {X : Type}, ∀ [TopologicalSpace X], ∀ (O : Set X), ∀ (K : + Set X), ∀ (S : Set X), (IsOpen O) → ((closure O = O ∪ K) → ((IsPreconnected S) → + ((Disjoint S K) → (∀ (x : X), (x ∈ S) → ((x ∉ O) → (Disjoint S O))))))) → + ((IsPreconnected (P3544T1BoundaryCarrier C.left \ segment ℝ (p.vertex D.a) + (p.vertex D.b))) → ((IsOpen OR) → ((closure OR = OR ∪ CR) → ((∃ x, x ∈ CL \ e ∧ x ∉ + OR) → Disjoint (CL \ e) OR))))) ) := by + classical + intro n p E D C e CL CR OR hLoff oldArcEvenOnPreconnected leftArcPreconnected hRopen hRclosure + rintro ⟨x, hx, hxO⟩ + exact oldArcEvenOnPreconnected OR CR (CL \ e) hRopen hRclosure + leftArcPreconnected hLoff x hx hxO + +private theorem propagateLeft : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let e := segment Real (p.vertex D.a) (p.vertex D.b) + let CL := P3544T1BoundaryCarrier C.left + let CR := P3544T1BoundaryCarrier C.right + let OL := P3544T1RayParity C.left + (Disjoint (CR \ e) CL) → ((∀ {X : Type}, ∀ [TopologicalSpace X], ∀ (O : Set X), ∀ (K : + Set X), ∀ (S : Set X), (IsOpen O) → ((closure O = O ∪ K) → ((IsPreconnected S) → + ((Disjoint S K) → (∀ (x : X), (x ∈ S) → ((x ∉ O) → (Disjoint S O))))))) → + ((IsPreconnected (P3544T1BoundaryCarrier C.right \ segment ℝ (p.vertex D.a) + (p.vertex D.b))) → ((IsOpen OL) → ((closure OL = OL ∪ CL) → ((∃ x, x ∈ CR \ e ∧ x ∉ + OL) → Disjoint (CR \ e) OL))))) ) := by + classical + intro n p E D C e CL CR OL hRoff oldArcEvenOnPreconnected rightArcPreconnected hLopen hLclosure + rintro ⟨x, hx, hxO⟩ + exact oldArcEvenOnPreconnected OL CL (CR \ e) hLopen hLclosure + rightArcPreconnected hRoff x hx hxO + +private theorem cyclicStep : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), (P3650T1CyclicChildren p D.a D.b) → (∀ {m : Nat}, ∀ + (i : Fin (m + 3)), (i - 1) + 2 = i + 1) ) := by + classical + intro n p E D C m i + have hsub : (i - 1).val = if i.val = 0 then m + 2 else i.val - 1 := by + by_cases hz : i.val = 0 + · have hi : i = 0 := Fin.ext hz + subst i + simp [] + · rw [ite_eq_right hz] + have hi : i ≠ 0 := by intro he; exact hz (congrArg Fin.val he) + exact Fin.val_sub_one_of_ne_zero hi + apply Fin.ext + rw [Fin.val_add, Fin.val_add] + simp only [Fin.val_one] + rw [hsub] + by_cases hz : i.val = 0 + · rw [ite_eq_left hz] + have hmod : m + 2 + (2 : Nat) = m + 3 + 1 := by omega + norm_num [hmod, hz] + · simp? [hz] + have hwrap : i.val + 1 = m + 3 ∨ i.val + 1 < m + 3 := by omega + rcases hwrap with hwrap | hlt + · have hleft : i.val - 1 + 2 = m + 3 := by omega + simp [hleft, hwrap] + · have hleft : i.val - 1 + 2 < m + 3 := by omega + simp [Nat.mod_eq_of_lt hleft, Nat.mod_eq_of_lt hlt] + omega + +private theorem parityEvenAlongPath : + (by + classical + exact + (∀ {X : Type}, ∀ [TopologicalSpace X], ∀ (O : Set X), ∀ (K : Set X), ∀ (S : Set X), + (IsOpen O) → ((closure O = O ∪ K) → ((IsPreconnected S) → ((Disjoint S K) → (∀ (x : + X), (x ∈ S) → ((x ∉ O) → (Disjoint S O))))))) → (∀ {m : Nat}, ∀ (q : + P3381T1PolygonBoundary m), ∀ (γ : Real → Real × Real), (ContinuousOn γ (Set.Icc (0 + : Real) 1)) → ((∀ t ∈ Set.Icc (0 : Real) 1, + γ t ∉ P3544T1BoundaryCarrier q) → ((γ 0 ∉ P3544T1RayParity q) → (∀ t ∈ Set.Icc (0 + : Real) 1, γ t ∉ P3544T1RayParity q)))) ) := by + classical + intro oldArcEvenOnPreconnected m q γ hcont havoid hstart + classical + let S : Set (Real × Real) := γ '' Set.Icc (0 : Real) 1 + have hpre : IsPreconnected S := isPreconnected_Icc.image γ hcont + have hSK : Disjoint S (P3544T1BoundaryCarrier q) := by + rw [Set.disjoint_left] + rintro x ⟨t, ht, rfl⟩ hxK + exact havoid t ht hxK + have hzero : γ 0 ∈ S := ⟨0, ⟨by norm_num, by norm_num⟩, rfl⟩ + have hdisj := oldArcEvenOnPreconnected + (P3544T1RayParity q) (P3544T1BoundaryCarrier q) S + (P3544T1LocalParity q).2.1 (P3544T1LocalParity q).1 hpre hSK + (γ 0) hzero hstart + intro t ht hodd + exact Set.disjoint_left.mp hdisj ⟨t, ht, rfl⟩ hodd + +private theorem upperHalfplaneEven : + (by + classical + exact + ∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), ∀ (ell : (Real × Real) →ₗ[Real] Real), ∀ + (H : Real), (∀ i, ell (q.vertex i) ≤ H) → (∀ (x : Real × Real), (H < ell x) → (x ∉ + P3544T1RayParity q)) ) := by + classical + intro m q ell H hbound x hx + classical + have hsegment : ∀ i y, + y ∈ segment Real (q.vertex i) (q.vertex (i + 1)) → ell y ≤ H := by + intro i y hy + rw [segment_eq_image] at hy + obtain ⟨t, ht, rfl⟩ := hy + rw [map_add, map_smul, map_smul] + simp only [smul_eq_mul] + have h1 := mul_le_mul_of_nonneg_left (hbound i) + (show 0 ≤ 1 - t by linarith [ht.2]) + have h2 := mul_le_mul_of_nonneg_left (hbound (i + 1)) ht.1 + nlinarith + have hxC : x ∉ P3544T1BoundaryCarrier q := by + intro h + obtain ⟨i, hi⟩ := Set.mem_iUnion.mp h + exact (not_le_of_gt hx) (hsegment i x hi) + obtain ⟨d, hdv, hde⟩ := + (P3544T1LocalParity q).2.2.2.2.2.1 x hxC + have use_direction : ∀ e : Real × Real, 0 ≤ ell e → + (∀ i, e.1 * (q.vertex i - x).2 - e.2 * (q.vertex i - x).1 ≠ 0) → + (∀ i, e.1 * (q.vertex (i + 1) - q.vertex i).2 - + e.2 * (q.vertex (i + 1) - q.vertex i).1 ≠ 0) → + x ∉ P3544T1RayParity q := by + intro e he hev hee hxO + have hno : ∀ i : Fin (m + 3), ¬ ∃ t : Real, 0 < t ∧ + x + t • e ∈ segment Real (q.vertex i) (q.vertex (i + 1)) := by + intro i hi + obtain ⟨t, ht, hseg⟩ := hi + have hle := hsegment i (x + t • e) hseg + rw [map_add, map_smul] at hle + simp only [smul_eq_mul] at hle + have hp := mul_nonneg ht.le he + linarith + have hset : {i : Fin (m + 3) | ∃ t : Real, 0 < t ∧ + x + t • e ∈ segment Real (q.vertex i) (q.vertex (i + 1))} = ∅ := by + ext i + simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false, iff_false] + exact hno i + have hchar := (P3544T1LocalParity q).2.2.2.2.2.2.1 x e hxC hev hee + have hc := hchar.mp hxO + rw [hset] at hc + norm_num at hc + by_cases hd : 0 ≤ ell d + · exact use_direction d hd hdv hde + · apply use_direction (-d) + · rw [map_neg] + linarith + · intro i + have heq : (-d).1 * (q.vertex i - x).2 - + (-d).2 * (q.vertex i - x).1 = + -(d.1 * (q.vertex i - x).2 - d.2 * (q.vertex i - x).1) := by + simp only [Prod.fst_neg, Prod.snd_neg] + ring + rw [heq] + exact neg_ne_zero.mpr (hdv i) + · intro i + have heq : (-d).1 * (q.vertex (i + 1) - q.vertex i).2 - + (-d).2 * (q.vertex (i + 1) - q.vertex i).1 = + -(d.1 * (q.vertex (i + 1) - q.vertex i).2 - + d.2 * (q.vertex (i + 1) - q.vertex i).1) := by + simp only [Prod.fst_neg, Prod.snd_neg] + ring + rw [heq] + exact neg_ne_zero.mpr (hde i) + +private theorem triangleHull : + (by + classical + exact + ∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), (m = 0) → (convexHull Real (Set.range + q.vertex) = P3544T1RayParity q ∪ P3544T1BoundaryCarrier q) ) := by + classical + intro m q hm + subst m + exact (P3544T1TriangleRayGeometry q).2.1 + +private theorem middleNotSegment : + (by + classical + exact + ∀ {a : Real × Real}, ∀ {b : Real × Real}, ∀ {c : Real × Real}, + (P3381T1TriangleDeterminant ![a, b, c] ≠ 0) → (b ∉ segment Real a c) ) := by + classical + intro a b c hdet hb + rw [segment_eq_image] at hb + obtain ⟨t, ht, hpoint⟩ := hb + have hx := congrArg Prod.fst hpoint + have hy := congrArg Prod.snd hpoint + have hx' : b.1 = (1 - t) * a.1 + t * c.1 := by + simpa [smul_eq_mul] using hx.symm + have hy' : b.2 = (1 - t) * a.2 + t * c.2 := by + simpa [smul_eq_mul] using hy.symm + apply hdet + simp only [P3381T1TriangleDeterminant, Matrix.cons_val_zero, + Matrix.cons_val_one] + change (b.1 - a.1) * (c.2 - a.2) - + (c.1 - a.1) * (b.2 - a.2) = 0 + rw [hx', hy'] + ring + +private theorem prevIndexNe : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), (P3650T1CyclicChildren p D.a D.b) → (∀ {m : Nat}, ∀ + (i : Fin (m + 3)), i - 1 ≠ i) ) := by + classical + intro n p E D C m i h + have hv := congrArg Fin.val h + by_cases hi : i = 0 + · subst i + simp at hv + · have hsub := Fin.val_sub_one_of_ne_zero hi + rw [hsub] at hv + have hpos : 0 < i.val := by + by_contra hnot + have hz : i.val = 0 := by omega + exact hi (Fin.ext hz) + omega + +private theorem nextIndexNe : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), (P3650T1CyclicChildren p D.a D.b) → (∀ {m : Nat}, ∀ + (i : Fin (m + 3)), i + 1 ≠ i) ) := by + classical + intro n p E D C m i h + have hv := congrArg Fin.val h + have hval : (i + 1).val = if i = Fin.last (m + 2) then 0 else i.val + 1 := + Fin.val_add_one i + rw [hval] at hv + split_ifs at hv with hi + · have hvlast := congrArg Fin.val hi + simp at hvlast + omega + · omega + +private theorem nonincidentBall : + (by + classical + exact + ∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), ∀ (i : Fin (m + 3)), ∃ r : Real, 0 < r ∧ + ∀ x ∈ Metric.ball (q.vertex i) r, x ∉ ⋃ j : Fin (m + 3), (if j ≠ i ∧ j + 1 ≠ i then + segment Real (q.vertex j) (q.vertex (j + 1)) else ∅) ) := by + classical + intro m q i + classical + let J : Set (Fin (m + 3)) := {j | j ≠ i ∧ j + 1 ≠ i} + let K : Set (Real × Real) := ⋃ j ∈ J, + segment Real (q.vertex j) (q.vertex (j + 1)) + have hsegcompact (j : Fin (m + 3)) : + IsCompact (segment Real (q.vertex j) (q.vertex (j + 1))) := by + rw [segment_eq_image_lineMap] + exact isCompact_Icc.image AffineMap.lineMap_continuous + have hKcompact : IsCompact K := by + dsimp [K] + exact (Set.toFinite J).isCompact_biUnion fun j hj => hsegcompact j + have hvnot : q.vertex i ∉ K := by + intro hvK + obtain ⟨j, hj⟩ := Set.mem_iUnion.mp hvK + obtain ⟨hjJ, hvseg⟩ := Set.mem_iUnion.mp hj + have hleft : q.vertex i ∈ segment Real (q.vertex i) (q.vertex (i + 1)) := + left_mem_segment Real _ _ + have hmem : q.vertex i ∈ segment Real (q.vertex i) (q.vertex (i + 1)) ∩ + segment Real (q.vertex j) (q.vertex (j + 1)) := ⟨hleft, hvseg⟩ + rw [q.edge_intersection i j hjJ.1.symm] at hmem + have hend : (q.vertex i = q.vertex i ∨ q.vertex i = q.vertex (i + 1)) ∧ + (q.vertex i = q.vertex j ∨ q.vertex i = q.vertex (j + 1)) := by + simpa only [Set.mem_ofPred_eq] using hmem + rcases hend.2 with hji | hjnext + · have heq : i = j := q.injective hji + exact hjJ.1 heq.symm + · have heq : i = j + 1 := q.injective hjnext + exact hjJ.2 heq.symm + have hopen : IsOpen Kᶜ := hKcompact.isClosed.isOpen_compl + obtain ⟨r, hr, hball⟩ := Metric.isOpen_iff.mp hopen (q.vertex i) hvnot + refine ⟨r, hr, ?_⟩ + intro x hx hmem + have hxK : x ∈ K := by + dsimp [K] + obtain ⟨j, hj⟩ := Set.mem_iUnion.mp hmem + by_cases hjJ : j ≠ i ∧ j + 1 ≠ i + · exact Set.mem_iUnion.mpr ⟨j, Set.mem_iUnion.mpr ⟨hjJ, by simpa [hjJ] using hj⟩⟩ + · simp [hjJ] at hj + exact hball hx hxK + +private theorem rightPreviousParent : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), (P3650T1CyclicChildren p D.a D.b) → (∀ {m : Nat}, ∀ + (q : P3381T1PolygonBoundary m), ∀ (a : Fin (m + 3)), ∀ (b : Fin (m + + 3)), ∀ (K : P3650T1CyclicChildren q a b), (K.rotation % (m + 3) = a.val) → (K.ir + ⟨K.right_n + 1, by omega⟩ = a - 1))) := by + classical + intro n p E D C m q a b K hrot + have hidx : (m + 2 + K.rotation) % (m + 3) = (a - 1).val := by + by_cases ha0 : a.val = 0 + · have ha : a = 0 := Fin.ext ha0 + subst a + rw [Nat.add_mod] + simp [Nat.mod_eq_of_lt (show m + 2 < m + 3 by omega), hrot] + · have hsub : (a - 1).val = a.val - 1 := + Fin.val_sub_one_of_ne_zero (by intro he; exact ha0 (congrArg Fin.val he)) + rw [hsub, Nat.add_mod, Nat.mod_eq_of_lt (show m + 2 < m + 3 by omega), hrot] + have hsum : m + 2 + a.val = (m + 3) + (a.val - 1) := by omega + rw [hsum] + simp only [Nat.add_mod, Nat.mod_self, Nat.zero_add, + Nat.mod_eq_of_lt (show a.val - 1 < m + 3 by omega)] + have hrotlast := List.getElem?_rotate + (l := List.ofFn (fun i : Fin (m + 3) => i)) (n := K.rotation) (m := m+2) (by simp) + have hsource : (List.ofFn (fun i : Fin (m + 3) => i))[(m+2 + K.rotation) % (m+3)]? = + some (a-1) := by + have hbound : (m+2 + K.rotation) % (m+3) < + (List.ofFn (fun i : Fin (m+3) => i)).length := by simp; omega + rw [List.getElem?_eq_getElem hbound, List.getElem_ofFn hbound] + congr 1 + exact Fin.ext hidx + have hlenBase : (List.ofFn (fun i : Fin (m+3) => i)).length = m+3 := by simp + rw [hlenBase] at hrotlast + rw [hsource] at hrotlast + have hrotlast? : + ((List.ofFn (fun i : Fin (m+3) => i)).rotate K.rotation).getLast? = some (a-1) := by + rw [List.getLast?_eq_getElem?] + have hlen : ((List.ofFn (fun i : Fin (m+3) => i)).rotate K.rotation).length = m+3 := by simp + rw [show ((List.ofFn (fun i : Fin (m+3) => i)).rotate K.rotation).length - 1 = m+2 by omega] + exact hrotlast + have hparentlast : (a :: (K.u ++ b :: K.v)).getLast? = K.v.getLast? := by + rw [show a :: (K.u ++ b :: K.v) = [a] ++ (K.u ++ b :: K.v) by simp] + rw [List.getLast?_append_of_ne_nil _ (by simp)] + rw [List.getLast?_append_of_ne_nil _ (by simp)] + change (([b] ++ K.v).getLast? = K.v.getLast?) + exact List.getLast?_append_of_ne_nil [b] (List.ne_nil_of_length_pos K.hv) + rw [K.parent_order, hparentlast] at hrotlast? + have hvlast : K.v.getLast? = some (a-1) := hrotlast? + have hlenV : K.v.length = K.right_n + 1 := by + have h := congrArg List.length K.right_order + simp at h + omega + have hget : (List.ofFn K.ir)[K.right_n+1]? = + some (K.ir ⟨K.right_n+1, by omega⟩) := by + have hbnd : K.right_n+1 < (List.ofFn K.ir).length := by simp + rw [List.getElem?_eq_getElem hbnd, List.getElem_ofFn hbnd] + rw [K.right_order] at hget + simp only [List.getElem?_cons_succ] at hget + rw [List.getElem?_append_left (by omega : K.right_n < K.v.length)] at hget + have hvget : K.v.getLast? = some (K.ir ⟨K.right_n+1, by omega⟩) := by + rw [List.getLast?_eq_getElem?] + rw [show K.v.length - 1 = K.right_n by omega] + exact hget + have hright : some (a - 1) = some (K.ir ⟨K.right_n+1, by omega⟩) := + hvlast.symm.trans hvget + have hne : K.v ≠ [] := List.ne_nil_of_length_pos K.hv + have hright' := hright + exact (Option.some.inj hright').symm + +private theorem hbaseChild : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (C.il 1 = + D.a + 1) → ((∀ {m : Nat}, ∀ (i : Fin (m + 3)), (i - 1) + 2 = i + 1) → ((D.a = E.b - + (1 : Fin (n + (3 : ℕ)))) → ((D.b = E.b + (1 : Fin (n + (3 : ℕ)))) → (C.u = [E.b] ∧ + C.left_n = 0)))) ) := by + classical + intro n p E D C leftFirstIndex cyclicStep ha hb + have hN : 0 < n + 3 := by omega + have hrotLen : (List.ofFn (fun i : Fin (n + 3) => i)).length = n + 3 := by simp + have hrot0 := List.getElem?_rotate (l := List.ofFn (fun i : Fin (n + 3) => i)) + (n := C.rotation) (m := 0) (by simp) + rw [C.parent_order] at hrot0 + conv_rhs at hrot0 => + rw [List.getElem?_eq_getElem (Nat.mod_lt _ (by simp []))] + rw [List.getElem_ofFn] + simp? at hrot0 + have hrLen : C.rotation % (List.ofFn (fun i : Fin (n + 3) => i)).length = D.a.val := by + simpa only [hrotLen] using (congrArg Fin.val hrot0).symm + have hr : C.rotation % (n + 3) = D.a.val := by simpa [hrotLen] using hrLen + have hpos2 : 2 < n + 3 := by omega + have hrot2 := List.getElem?_rotate (l := List.ofFn (fun i : Fin (n + 3) => i)) + (n := C.rotation) (m := 2) (by omega) + rw [C.parent_order] at hrot2 + rw [hrotLen] at hrot2 + have habFin : D.a + 2 = D.b := by rw [ha, hb]; exact cyclicStep E.b + have htwo : (2 : Fin (n + 3)).val = 2 := by norm_num + have hmod2 : (2 + C.rotation) % (n + 3) = + (2 + C.rotation % (n + 3)) % (n + 3) := by + rw [Nat.add_mod] + simp [] + rw [hr] at hmod2 + have hmodB : (2 + C.rotation) % (n + 3) = D.b.val := by + calc + (2 + C.rotation) % (n + 3) = (2 + D.a.val) % (n + 3) := hmod2 + _ = D.b.val := by + have hv := congrArg Fin.val habFin + simpa only [Fin.val_add, htwo, Nat.add_comm] using hv + have hidxB : (⟨(2 + C.rotation % (List.ofFn (fun i : Fin (n + 3) => i)).length) % + (List.ofFn (fun i : Fin (n + 3) => i)).length, by + have hlt : (2 + C.rotation % (n + 3)) % (n + 3) < n + 3 := Nat.mod_lt _ hN + simpa only [List.length_ofFn] using hlt⟩ : Fin (n + 3)) = D.b := by + apply Fin.ext + have hmod : (2 + C.rotation % (n + 3)) % (n + 3) = + (2 + C.rotation) % (n + 3) := by + have h2lt : 2 < n + 3 := by omega + calc + (2 + C.rotation % (n + 3)) % (n + 3) = + (2 % (n + 3) + C.rotation % (n + 3)) % (n + 3) := by + rw [Nat.mod_eq_of_lt h2lt] + _ = (2 + C.rotation) % (n + 3) := by + rw [Nat.add_mod] + simp [Nat.mod_eq_of_lt h2lt] + simpa only [List.length_ofFn] using hmod.trans hmodB + have hsource : (List.ofFn (fun i : Fin (n + 3) => i))[ + (2 + C.rotation) % (n + 3)]? = some D.b := by + have hidxlt : (2 + C.rotation) % (n + 3) < + (List.ofFn (fun i : Fin (n + 3) => i)).length := by + rw [hrotLen] + exact Nat.mod_lt _ hN + rw [List.getElem?_eq_getElem hidxlt] + simp only [List.getElem_ofFn] + apply congrArg some + exact Fin.ext hmodB + have hparLen : 2 < (D.a :: (C.u ++ D.b :: C.v)).length := by + have hu := C.hu + have hv := C.hv + simp + omega + have hrot2' : (D.a :: (C.u ++ D.b :: C.v))[2]? = some D.b := by + rw [hsource] at hrot2 + exact hrot2 + have hparentCell : (D.a :: (C.u ++ D.b :: C.v))[2]'hparLen = D.b := by + rw [List.getElem?_eq_getElem hparLen] at hrot2' + exact Option.some.inj hrot2' + have hprefix : (D.a :: (C.u ++ D.b :: C.v))[2]' + (by have hu := C.hu; simp; omega) = + (D.a :: (C.u ++ [D.b]))[2]'(by have hu := C.hu; simp; omega) := by + by_cases hu2 : 1 < C.u.length + · simp only [List.getElem_cons_succ] + rw [List.getElem_append_left (by omega : 1 < C.u.length)] + rw [List.getElem_append_left (by omega : 1 < C.u.length)] + · have hu1 : C.u.length = 1 := by have := C.hu; omega + simp [hu1] + have hleftCell : (D.a :: (C.u ++ [D.b]))[2]' + (by have hu := C.hu; simp; omega) = D.b := hprefix.symm.trans hparentCell + have huLen : C.u.length = 1 := by + by_contra hn + have hu2 : 1 < C.u.length := by have hu := C.hu; omega + have hcell : (C.u)[1]'(by omega) = D.b := by + simpa only [List.getElem_cons_succ, + List.getElem_append_left (by omega : 1 < C.u.length)] using hleftCell + have hnd : (D.a :: (C.u ++ [D.b])).Nodup := by + rw [← C.left_order] + exact List.nodup_ofFn_ofInjective C.il_injective + have hlast : (D.a :: (C.u ++ [D.b]))[C.u.length + 1]'(by simp) = D.b := by + simp [List.getElem_append_right] + have hposeq := (hnd.getElem_inj_iff).mp (hleftCell.trans hlast.symm) + omega + have huval : (C.u)[0]'(by omega) = E.b := by + have hleftn : 1 < C.left_n + 3 := by omega + have hleftOrder := congrArg (fun l => l[1]?) C.left_order + simp only [List.getElem?_ofFn, dite_eq_left hleftn] at hleftOrder + simp only [List.getElem?_cons_succ, + List.getElem?_append_left (by have := C.hu; omega : 0 < C.u.length)] at hleftOrder + rw [List.getElem?_eq_getElem C.hu] at hleftOrder + have hu0 : C.u[0]'(by omega) = C.il 1 := Option.some.inj hleftOrder.symm + calc + C.u[0]'(by omega) = C.il 1 := hu0 + _ = D.a + 1 := leftFirstIndex + _ = (E.b - 1) + 1 := by rw [ha] + _ = E.b := sub_add_cancel _ _ + constructor + · apply List.ext_getElem + · simp [huLen] + · intro i hi₁ hi₂ + have hi : i = 0 := by omega + simpa [hi] using huval + · have hlen := congrArg List.length C.left_order + simp [huLen] at hlen + omega + +private theorem hleftIndices : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (D.a = E.b + - (1 : Fin (n + (3 : ℕ)))) → ((C.u = [E.b] ∧ C.left_n = 0) → (List.ofFn C.il = [D.a, + E.b, D.b])) ) := by + classical + intro n p E D C ha hbaseChild + rw [C.left_order] + simp [hbaseChild.1, ha] + +private theorem hleftIndexRange : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (List.ofFn + C.il = [D.a, E.b, D.b]) → (Set.range C.il = {D.a, E.b, D.b}) ) := by + classical + intro n p E D C hleftIndices + ext i + constructor + · rintro ⟨j, rfl⟩ + have hj : C.il j ∈ List.ofFn C.il := List.mem_ofFn.mpr ⟨j, rfl⟩ + rw [hleftIndices] at hj + simpa using hj + · intro hi + have hi' : i ∈ [D.a, E.b, D.b] := by simpa using hi + rw [← hleftIndices] at hi' + obtain ⟨j, hj⟩ := List.mem_ofFn.mp hi' + exact ⟨j, hj⟩ + +private theorem hleftVertexRange : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (D.a = E.b + - (1 : Fin (n + (3 : ℕ)))) → ((D.b = E.b + (1 : Fin (n + (3 : ℕ)))) → ((Set.range + C.il = {D.a, E.b, D.b}) → (Set.range C.left.vertex = {p.vertex (E.b - 1), + p.vertex E.b, p.vertex (E.b + 1)}))) ) := by + classical + intro n p E D C ha hb hleftIndexRange + rw [C.left_vertex, Set.range_comp, hleftIndexRange] + rw [ha, hb] + ext x + simp only [Set.mem_image, Set.mem_insert_iff, Set.mem_singleton_iff] + constructor + · rintro ⟨y, hy, rfl⟩ + rcases hy with rfl | rfl | rfl <;> simp + · rintro (rfl | rfl | rfl) + · exact ⟨E.b - 1, by simp, rfl⟩ + · exact ⟨E.b, by simp, rfl⟩ + · exact ⟨E.b + 1, by simp, rfl⟩ + +private theorem hseedRAt680 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let e := segment Real (p.vertex D.a) (p.vertex D.b) + let CL := P3544T1BoundaryCarrier C.left + let OR := P3544T1RayParity C.right + (∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), ∀ (ell : (Real × Real) →ₗ[Real] Real), + ∀ (H : Real), (∀ i, ell (q.vertex i) ≤ H) → (∀ (x : Real × Real), (H < ell x) → (x ∉ + P3544T1RayParity q))) → ((∀ {a : Real × Real}, ∀ {b : Real × Real}, ∀ + {c : Real × Real}, (P3381T1TriangleDeterminant ![a, b, c] ≠ 0) → (b ∉ segment Real + a c)) → ((∀ {m : Nat}, ∀ (i : Fin (m + 3)), i - 1 ≠ i) → ((∀ {m : Nat}, ∀ (i : Fin (m + + 3)), i + 1 ≠ i) → ((D.a = E.b - (1 : Fin (n + (3 : ℕ)))) → ((D.b = E.b + (1 : Fin + (n + (3 : ℕ)))) → ((Set.range C.il = {D.a, E.b, D.b}) → ((Set.range C.left.vertex = + {p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)}) → (∃ x, x ∈ CL \ e ∧ x ∉ + OR)))))))) ) := by + classical + intro n p E D C e CL OR upperHalfplaneEven middleNotSegment prevIndexNe nextIndexNe ha hb + hleftIndexRange hleftVertexRange + refine ⟨p.vertex E.b, ?_, ?_⟩ + · constructor + · change p.vertex E.b ∈ P3544T1BoundaryCarrier C.left + change p.vertex E.b ∈ ⋃ i, segment Real (C.left.vertex i) (C.left.vertex (i + 1)) + have hmem : p.vertex E.b ∈ Set.range C.left.vertex := by + rw [hleftVertexRange] + simp + obtain ⟨i, hi⟩ := hmem + exact Set.mem_iUnion.mpr ⟨i, hi ▸ left_mem_segment Real _ _⟩ + · intro hdiag + exact middleNotSegment (by simpa [ha, hb, P3381T1TriangleDeterminant] using + E.nondegenerate) hdiag + · let S : Finset Real := Finset.univ.image (fun i : Fin (C.right_n + 3) => + E.ell (C.right.vertex i)) + have hS : S.Nonempty := by + refine ⟨E.ell (C.right.vertex 0), ?_⟩ + exact Finset.mem_image.mpr ⟨0, Finset.mem_univ _, rfl⟩ + let H := S.max' hS + have hbound (i : Fin (C.right_n + 3)) : E.ell (C.right.vertex i) < + E.ell (p.vertex E.b) := by + have hirne : C.ir i ≠ E.b := by + intro heq + have hmemR : E.b ∈ Set.range C.ir := ⟨i, heq⟩ + have hmemL : E.b ∈ Set.range C.il := by rw [hleftIndexRange]; simp + have hcommon : E.b ∈ ({D.a, D.b} : Set (Fin (n + 3))) := by + rw [← C.common_indices] + exact ⟨hmemL, hmemR⟩ + rcases (by simpa using hcommon) with hh | hh + · have hp := prevIndexNe E.b + have hh' : E.b = E.b - 1 := by rw [ha] at hh; exact hh + exact hp hh'.symm + · have hp := nextIndexNe E.b + have hh' : E.b = E.b + 1 := by rw [hb] at hh; exact hh + exact hp hh'.symm + rw [C.right_vertex] + exact E.maximum (C.ir i) hirne + have hH : H < E.ell (p.vertex E.b) := by + apply (Finset.max'_lt_iff S hS).2 + intro y hy + rcases Finset.mem_image.mp hy with ⟨i, hi, rfl⟩ + exact hbound i + have hbelow (i : Fin (C.right_n + 3)) : E.ell (C.right.vertex i) ≤ H := by + apply Finset.le_max' + exact Finset.mem_image.mpr ⟨i, Finset.mem_univ _, rfl⟩ + have hB : H < E.ell (p.vertex E.b) := hH + exact upperHalfplaneEven C.right E.ell H hbelow + (p.vertex E.b) hB + +private theorem hseedLAt728 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let e := segment Real (p.vertex D.a) (p.vertex D.b) + let CR := P3544T1BoundaryCarrier C.right + let OL := P3544T1RayParity C.left + (∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), (m = 0) → (convexHull Real (Set.range + q.vertex) = P3544T1RayParity q ∪ P3544T1BoundaryCarrier q)) → ((∀ {m : Nat}, ∀ (i + : Fin (m + 3)), i - 1 ≠ i) → ((∀ {m : Nat}, ∀ (i : Fin (m + 3)), i + 1 ≠ i) → ((D.a = + E.b - (1 : Fin (n + (3 : ℕ)))) → ((D.b = E.b + (1 : Fin (n + (3 : ℕ)))) → ((∀ (i : + Fin (n + (3 : ℕ))), p.vertex i ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))} → i = E.b - (1 : Fin (n + (3 : ℕ))) ∨ i = + E.b ∨ i = E.b + (1 : Fin (n + (3 : ℕ)))) → ((C.u = [E.b] ∧ C.left_n = 0) → + ((Set.range C.il = {D.a, E.b, D.b}) → ((Set.range C.left.vertex = + {p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)}) → (∃ x, x ∈ CR \ e ∧ x ∉ + OL))))))))) ) := by + classical + intro n p E D C e CR OL triangleHull prevIndexNe nextIndexNe ha hb hempty hbaseChild + hleftIndexRange hleftVertexRange + let j : Fin (n + 3) := C.ir 1 + have hjrange : j ∈ Set.range C.ir := ⟨1, rfl⟩ + have hjneA : j ≠ D.a := by + intro heq + have hfirst : C.ir 0 = D.b := by + have h := congrArg List.head? C.right_order + simpa using h + have hlast : C.ir (Fin.last (C.right_n + 2)) = D.a := by + have hlast? : (List.ofFn C.ir).getLast? = + some (C.ir (Fin.last (C.right_n + 2))) := by + rw [List.getLast?_eq_getLast_of_ne_nil (by simp)] + rw [List.getLast_ofFn_succ] + have h := congrArg List.getLast? C.right_order + rw [hlast?] at h + have hrhs : (D.b :: (C.v ++ [D.a])).getLast? = some D.a := by + rw [show D.b :: (C.v ++ [D.a]) = [D.b] ++ (C.v ++ [D.a]) by simp] + rw [List.getLast?_append_of_ne_nil _ (by simp)] + rw [List.getLast?_append_of_ne_nil _ (by simp)] + simp + rw [hrhs] at h + exact Option.some.inj h + have hii : (1 : Fin (C.right_n + 3)) ≠ Fin.last (C.right_n + 2) := by + intro he + have hv := congrArg Fin.val he + simp at hv + have heq' : C.ir 1 = C.ir (Fin.last (C.right_n + 2)) := heq.trans hlast.symm + exact hii (C.ir_injective heq') + have hjneB : j ≠ D.b := by + intro heq + have hfirst : C.ir 0 = D.b := by + have h := congrArg List.head? C.right_order + simpa using h + have hi' : (1 : Fin (C.right_n + 3)) ≠ 0 := by + intro he + have hv := congrArg Fin.val he + norm_num at hv + have heq' : C.ir 1 = C.ir 0 := heq.trans hfirst.symm + exact hi' (C.ir_injective heq') + have hjneTop : j ≠ E.b := by + intro heq + have hmemL : E.b ∈ Set.range C.il := by rw [hleftIndexRange]; simp + have hcommon : E.b ∈ ({D.a, D.b} : Set (Fin (n + 3))) := by + simpa only [C.common_indices] using + (show E.b ∈ Set.range C.il ∩ Set.range C.ir from ⟨hmemL, ⟨1, heq⟩⟩) + rcases (by simpa using hcommon) with hh | hh + · have hp := prevIndexNe E.b + have hh' : E.b = E.b - 1 := by rw [ha] at hh; exact hh + exact hp hh'.symm + · have hp := nextIndexNe E.b + have hh' : E.b = E.b + 1 := by rw [hb] at hh; exact hh + exact hp hh'.symm + have hjnotHull : p.vertex j ∉ convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : Set (Real × Real)) := by + intro hmem + have hallowed := hempty j hmem + rcases hallowed with h | h | h + · exact hjneA (by simpa [ha] using h) + · exact hjneTop h + · exact hjneB (by simpa [ha, hb] using h) + have hjnotDiag : p.vertex j ∉ e := by + intro hmem + have hseg : e ⊆ convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : Set (Real × Real)) := by + intro x hx + exact segment_subset_convexHull (by simp [ha]) (by simp [hb]) hx + exact hjnotHull (hseg hmem) + refine ⟨p.vertex j, ?_, ?_⟩ + · constructor + · change p.vertex j ∈ P3544T1BoundaryCarrier C.right + change p.vertex j ∈ ⋃ i, segment Real (C.right.vertex i) (C.right.vertex (i + 1)) + have hmem : p.vertex j ∈ Set.range C.right.vertex := by + refine ⟨1, ?_⟩ + rw [C.right_vertex] + rfl + obtain ⟨i, hi⟩ := hmem + exact Set.mem_iUnion.mpr ⟨i, hi ▸ left_mem_segment Real _ _⟩ + · exact hjnotDiag + · intro hodd + have htri := triangleHull C.left hbaseChild.2 + have hnotHull : p.vertex j ∉ convexHull Real (Set.range C.left.vertex) := by + rw [hleftVertexRange] + simpa using hjnotHull + have hsub : OL ⊆ convexHull Real (Set.range C.left.vertex) := by + intro x hx + rw [htri] + exact Or.inl hx + exact hnotHull (hsub hodd) + +private theorem hdet : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + (vb.1 - va.1) * (vc.2 - va.2) - (vc.1 - va.1) * (vb.2 - va.2) ≠ 0 ) := by + classical + intro n p E va vb vc + simpa [P3381T1TriangleDeterminant, va, vb, vc] using E.nondegenerate + +private theorem hind : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ((vb.1 - va.1) * (vc.2 - va.2) - (vc.1 - va.1) * (vb.2 - va.2) ≠ 0) → (AffineIndependent + Real vv) ) := by + classical + intro n p E va vb vc vv hdet + apply (affineIndependent_iff_of_fintype Real vv).mpr + intro z hz hsum i + rw [Finset.weightedVSub_eq_linear_combination Finset.univ hz] at hsum + have hzsum : z 0 + z 1 + z 2 = 0 := by + simpa [Fin.sum_univ_succ, ← add_assoc] using hz + have hx : z 0 * va.1 + z 1 * vb.1 + z 2 * vc.1 = 0 := by + simpa [Fin.sum_univ_succ, vv, ← add_assoc] using congrArg Prod.fst hsum + have hy : z 0 * va.2 + z 1 * vb.2 + z 2 * vc.2 = 0 := by + simpa [Fin.sum_univ_succ, vv, ← add_assoc] using congrArg Prod.snd hsum + have hx' : z 1 * (vb.1 - va.1) + z 2 * (vc.1 - va.1) = 0 := by + linear_combination hx - va.1 * hzsum + have hy' : z 1 * (vb.2 - va.2) + z 2 * (vc.2 - va.2) = 0 := by + linear_combination hy - va.2 * hzsum + have hz1 : z 1 = 0 := by + have hmul : z 1 * ((vb.1 - va.1) * (vc.2 - va.2) - + (vc.1 - va.1) * (vb.2 - va.2)) = 0 := by + linear_combination (vc.2 - va.2) * hx' - (vc.1 - va.1) * hy' + exact (mul_eq_zero.mp hmul).resolve_right hdet + have hz2 : z 2 = 0 := by + have hmul : z 2 * ((vb.1 - va.1) * (vc.2 - va.2) - + (vc.1 - va.1) * (vb.2 - va.2)) = 0 := by + linear_combination (vb.1 - va.1) * hy' - (vb.2 - va.2) * hx' + exact (mul_eq_zero.mp hmul).resolve_right hdet + fin_cases i + · change z 0 = 0 + linarith + · change z 1 = 0 + exact hz1 + · change z 2 = 0 + exact hz2 + +private theorem hspan : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + (AffineIndependent Real vv) → (affineSpan Real (Set.range vv) = ⊤) ) := by + classical + intro n p E va vb vc vv hind + apply hind.affineSpan_eq_top_iff_card_eq_finrank_add_one.mpr + norm_num [Module.finrank_prod] + +private theorem hrange : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let e := segment Real (p.vertex D.a) (p.vertex D.b) + let CL := P3544T1BoundaryCarrier C.left + let CR := P3544T1BoundaryCarrier C.right + let OL := P3544T1RayParity C.left + let OR := P3544T1RayParity C.right + ((∃ x, x ∈ CL \ e ∧ x ∉ OR) → Disjoint (CL \ e) OR) → (((∃ x, x ∈ CR \ e ∧ x ∉ OL) → + Disjoint (CR \ e) OL) → ( + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + Set.range A = ({va, vb, vc} : Set (Real × Real)))) ) := by + classical + intro n p E D C e CL CR OL OR propagateRight propagateLeft va vb vc vv hind hspan A + rw [show (A : Fin 3 → Real × Real) = ![va, vb, vc] from funext (by + intro i + fin_cases i <;> rfl)] + ext x + simp + tauto + +private theorem hcoord_nonneg : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (p.vertex D.b ∈ convexHull Real (Set.range A)) → (∀ i : Fin 3, 0 ≤ A.coord i (p.vertex + D.b)) ) := by + classical + intro n p E D va vb vc vv hind hspan A htriangle + have hmem := (Set.ext_iff.mp A.convexHull_eq_nonneg_coord) (p.vertex D.b) + exact (hmem.mp htriangle) + +private theorem hcoord_sum : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + A.coord 0 (p.vertex D.b) + A.coord 1 (p.vertex D.b) + A.coord 2 (p.vertex D.b) = 1 ) := by + classical + intro n p E D va vb vc vv hind hspan A + simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one (p.vertex D.b) + +private theorem hside0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + ∀ (x : Real × Real), (x ∈ convexHull Real (Set.range A)) → ((A.coord 0 x = 0) → (x ∈ + segment Real vb vc)) ) := by + classical + intro n p E va vb vc vv hind hspan A x hx h0 + have h0b : A.coord 0 vb = 0 := by + change A.coord 0 (A 1) = 0 + exact A.coord_apply_ne (by decide) + have h0c : A.coord 0 vc = 0 := by + change A.coord 0 (A 2) = 0 + exact A.coord_apply_ne (by decide) + have hn := (Set.ext_iff.mp A.convexHull_eq_nonneg_coord x).mp hx + have hsum : A.coord 0 x + A.coord 1 x + A.coord 2 x = 1 := by + simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one x + rw [segment_eq_image_lineMap] + refine ⟨A.coord 2 x, ⟨hn 2, ?_⟩, ?_⟩ + · linarith [hn 1] + · apply A.ext_elem + intro i + rw [(A.coord i).apply_lineMap] + rw [AffineMap.lineMap_apply_ring] + fin_cases i + · change (1 - A.coord 2 x) * A.coord 0 (A 1) + + A.coord 2 x * A.coord 0 (A 2) = A.coord 0 x + rw [A.coord_apply_ne (by decide : (0 : Fin 3) ≠ 1), + A.coord_apply_ne (by decide : (0 : Fin 3) ≠ 2)] + simpa using h0.symm + · change (1 - A.coord 2 x) * A.coord 1 (A 1) + + A.coord 2 x * A.coord 1 (A 2) = A.coord 1 x + rw [A.coord_apply_eq 1, + A.coord_apply_ne (by decide : (1 : Fin 3) ≠ 2)] + linarith [h0, hsum] + · change (1 - A.coord 2 x) * A.coord 2 (A 1) + + A.coord 2 x * A.coord 2 (A 2) = A.coord 2 x + rw [A.coord_apply_ne (by decide : (2 : Fin 3) ≠ 1), + A.coord_apply_eq 2] + ring + +private theorem hside2 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + ∀ (x : Real × Real), (x ∈ convexHull Real (Set.range A)) → ((A.coord 2 x = 0) → (x ∈ + segment Real va vb)) ) := by + classical + intro n p E va vb vc vv hind hspan A x hx h2 + have h2a : A.coord 2 va = 0 := by + change A.coord 2 (A 0) = 0 + exact A.coord_apply_ne (by decide) + have h2b : A.coord 2 vb = 0 := by + change A.coord 2 (A 1) = 0 + exact A.coord_apply_ne (by decide) + have hn := (Set.ext_iff.mp A.convexHull_eq_nonneg_coord x).mp hx + have hsum : A.coord 0 x + A.coord 1 x + A.coord 2 x = 1 := by + simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one x + rw [segment_eq_image_lineMap] + refine ⟨A.coord 1 x, ⟨hn 1, ?_⟩, ?_⟩ + · linarith [hn 0] + · apply A.ext_elem + intro i + rw [(A.coord i).apply_lineMap] + rw [AffineMap.lineMap_apply_ring] + fin_cases i + · change (1 - A.coord 1 x) * A.coord 0 (A 0) + + A.coord 1 x * A.coord 0 (A 1) = A.coord 0 x + rw [A.coord_apply_eq 0, + A.coord_apply_ne (by decide : (0 : Fin 3) ≠ 1)] + linarith [h2, hsum] + · change (1 - A.coord 1 x) * A.coord 1 (A 0) + + A.coord 1 x * A.coord 1 (A 1) = A.coord 1 x + rw [A.coord_apply_ne (by decide : (1 : Fin 3) ≠ 0), + A.coord_apply_eq 1] + ring + · change (1 - A.coord 1 x) * A.coord 2 (A 0) + + A.coord 1 x * A.coord 2 (A 1) = A.coord 2 x + rw [A.coord_apply_ne (by decide : (2 : Fin 3) ≠ 0), + A.coord_apply_ne (by decide : (2 : Fin 3) ≠ 1)] + simpa using h2.symm + +private theorem hcoord0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), (D.a = E.b) → ((D.b ≠ E.b + (1 : Fin (n + (3 : ℕ)))) → ( + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (p.vertex D.b ∈ convexHull Real (Set.range A)) → ((∀ i : Fin 3, 0 ≤ A.coord i (p.vertex + D.b)) → ((∀ (x : Real × Real), (x ∈ convexHull Real (Set.range A)) → ((A.coord 0 x = + 0) → (x ∈ segment Real vb vc))) → (0 < A.coord 0 (p.vertex D.b)))))) ) := by + classical + intro n p E D ha hbnext va vb vc vv hind hspan A htriangle hcoord_nonneg hside0 + have hn := hcoord_nonneg 0 + by_contra hnot + have hz : A.coord 0 (p.vertex D.b) = 0 := by linarith + have hs := hside0 (p.vertex D.b) htriangle hz + have hi : D.b ≠ E.b := by + intro he + have := D.distinct + rw [ha, he] at this + exact this rfl + have hp : p.vertex D.b ∈ segment Real (p.vertex E.b) (p.vertex (E.b + 1)) := by + simpa [vb, vc] using hs + have hpair : p.vertex D.b ∈ segment Real (p.vertex E.b) (p.vertex (E.b + 1)) ∩ + segment Real (p.vertex D.b) (p.vertex (D.b + 1)) := + ⟨hp, left_mem_segment Real _ _⟩ + rw [p.edge_intersection E.b D.b hi.symm] at hpair + rcases hpair.1 with heq | heq + · exact hi (p.injective heq) + · exact hbnext (p.injective heq) + +private theorem hcoord2 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), (D.a = E.b) → ((D.b ≠ E.b - (1 : Fin (n + (3 : ℕ)))) → ( + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (p.vertex D.b ∈ convexHull Real (Set.range A)) → ((∀ i : Fin 3, 0 ≤ A.coord i (p.vertex + D.b)) → ((∀ (x : Real × Real), (x ∈ convexHull Real (Set.range A)) → ((A.coord 2 x = + 0) → (x ∈ segment Real va vb))) → (0 < A.coord 2 (p.vertex D.b)))))) ) := by + classical + intro n p E D ha hbprev va vb vc vv hind hspan A htriangle hcoord_nonneg hside2 + have hn := hcoord_nonneg 2 + by_contra hnot + have hz : A.coord 2 (p.vertex D.b) = 0 := by linarith + have hs := hside2 (p.vertex D.b) htriangle hz + have hi : E.b - 1 ≠ D.b := by + intro he + have := hbprev + exact this he.symm + have hp : p.vertex D.b ∈ segment Real (p.vertex (E.b - 1)) (p.vertex E.b) := by + simpa [va, vb] using hs + have hpair : p.vertex D.b ∈ segment Real (p.vertex (E.b - 1)) (p.vertex ((E.b - 1) + 1)) ∩ + segment Real (p.vertex D.b) (p.vertex (D.b + 1)) := by + exact ⟨by simpa only [sub_add_cancel] using hp, left_mem_segment Real _ _⟩ + rw [p.edge_intersection (E.b - 1) D.b hi] at hpair + rcases hpair.1 with heq | heq + · exact hbprev (p.injective heq) + · exact (by + have heq' : p.vertex D.b = p.vertex E.b := by + simpa only [sub_add_cancel] using heq + have hd : D.b = E.b := p.injective heq' + have hne : D.b ≠ E.b := by + intro he + have := D.distinct + rw [ha, he] at this + exact this rfl + exact hne hd) + +private theorem hrotvalAt999 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (some D.a = + some ⟨((0 : ℕ) + C.rotation) % (List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).length, + (by simp only [List.length_ofFn]; exact Nat.mod_lt _ (by omega))⟩) → (C.rotation % (n + + 3) = D.a.val) ) := by + classical + intro n p E D C hrot0 + have heq := Option.some.inj hrot0 + have hv := congrArg Fin.val heq.symm + simpa using hv + +private theorem hrightLast : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), C.ir + (Fin.last (C.right_n + 2)) = D.a ) := by + classical + intro n p E D C + have hlast? : (List.ofFn C.ir).getLast? = some (C.ir (Fin.last _)) := by + rw [List.getLast?_eq_getLast_of_ne_nil (by simp)] + rw [List.getLast_ofFn_succ] + have h := congrArg List.getLast? C.right_order + rw [hlast?] at h + have hrhs : (D.b :: (C.v ++ [D.a])).getLast? = some D.a := by + rw [show D.b :: (C.v ++ [D.a]) = [D.b] ++ (C.v ++ [D.a]) by simp] + rw [List.getLast?_append_of_ne_nil _ (by simp)] + rw [List.getLast?_append_of_ne_nil _ (by simp)] + simp + rw [hrhs] at h + exact Option.some.inj h + +private theorem hrightFirst : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), C.ir 0 = + D.b ) := by + classical + intro n p E D C + have h := congrArg List.head? C.right_order + simpa using h + +private theorem hleftLast : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), C.il + (Fin.last (C.left_n + 2)) = D.b ) := by + classical + intro n p E D C + have hlast? : (List.ofFn C.il).getLast? = some (C.il (Fin.last _)) := by + rw [List.getLast?_eq_getLast_of_ne_nil (by simp)] + rw [List.getLast_ofFn_succ] + have h := congrArg List.getLast? C.left_order + rw [hlast?] at h + have hrhs : (D.a :: (C.u ++ [D.b])).getLast? = some D.b := by + rw [show D.a :: (C.u ++ [D.b]) = [D.a] ++ (C.u ++ [D.b]) by simp] + rw [List.getLast?_append_of_ne_nil _ (by simp)] + rw [List.getLast?_append_of_ne_nil _ (by simp)] + simp + rw [hrhs] at h + exact Option.some.inj h + +private theorem hleftFirst : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), C.il 0 = + D.a ) := by + classical + intro n p E D C + have h := congrArg List.head? C.left_order + simpa using h + +private theorem hcoordA0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + A.coord 0 va = 1 ) := by + classical + intro n p E va vb vc vv hind hspan A + change A.coord 0 (A 0) = 1 + exact A.coord_apply_eq 0 + +private theorem hcoordA2 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + A.coord 2 va = 0 ) := by + classical + intro n p E va vb vc vv hind hspan A + change A.coord 2 (A 0) = 0 + exact A.coord_apply_ne (by decide) + +private theorem hcoordB0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + A.coord 0 vb = 0 ) := by + classical + intro n p E va vb vc vv hind hspan A + change A.coord 0 (A 1) = 0 + exact A.coord_apply_ne (by decide) + +private theorem hcoordB2 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + A.coord 2 vb = 0 ) := by + classical + intro n p E va vb vc vv hind hspan A + change A.coord 2 (A 1) = 0 + exact A.coord_apply_ne (by decide) + +private theorem hcoordC0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + A.coord 0 vc = 0 ) := by + classical + intro n p E va vb vc vv hind hspan A + change A.coord 0 (A 2) = 0 + exact A.coord_apply_ne (by decide) + +private theorem hcoordC2 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + A.coord 2 vc = 1 ) := by + classical + intro n p E va vb vc vv hind hspan A + change A.coord 2 (A 2) = 1 + exact A.coord_apply_eq 2 + +private theorem hcoordLine : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + ∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), A.coord i + (AffineMap.lineMap x y t) = (1 - t) * A.coord i x + t * A.coord i y ) := by + classical + intro n p E va vb vc vv hind hspan A i x y t + rw [(A.coord i).apply_lineMap] + rw [AffineMap.lineMap_apply_ring] + +private theorem lineMapSub : + (by + classical + exact + ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), AffineMap.lineMap x y t - x = t • + (y - x) ) := by + classical + intro x y t + apply Prod.ext <;> simp [AffineMap.lineMap_apply_ring, smul_eq_mul] <;> ring + +private theorem hscaleAt1080 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + (0 < r) → ( + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + δ₀ * (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) = r) ) := by + classical + intro n p E va vb vc r₀ r hr δ₀ + change (r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1))) * + (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) = r + field_simp + +private theorem hδaAt1084 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + (0 < δ₀) → ((δ₀ * (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) = r) → (δ * ‖va - vb‖ < r)) ) := by + classical + intro n p E va vb vc r₀ r δ₀ δ hδ₀ hscale + have hbound : ‖va - vb‖ < 2 * (‖va - vb‖ + ‖vc - vb‖ + 1) := by + linarith only [norm_nonneg (va - vb), norm_nonneg (vc - vb)] + calc + δ * ‖va - vb‖ ≤ δ₀ * ‖va - vb‖ := + mul_le_mul_of_nonneg_right (min_le_left δ₀ (1/2)) (norm_nonneg _) + _ < δ₀ * (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) := + mul_lt_mul_of_pos_left hbound hδ₀ + _ = r := hscale + +private theorem hδcAt1093 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + (0 < δ₀) → ((δ₀ * (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) = r) → (δ * ‖vc - vb‖ < r)) ) := by + classical + intro n p E va vb vc r₀ r δ₀ δ hδ₀ hscale + have hbound : ‖vc - vb‖ < 2 * (‖va - vb‖ + ‖vc - vb‖ + 1) := by + linarith only [norm_nonneg (va - vb), norm_nonneg (vc - vb)] + calc + δ * ‖vc - vb‖ ≤ δ₀ * ‖vc - vb‖ := + mul_le_mul_of_nonneg_right (min_le_left δ₀ (1/2)) (norm_nonneg _) + _ < δ₀ * (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) := + mul_lt_mul_of_pos_left hbound hδ₀ + _ = r := hscale + +private theorem hUdiffAt1102 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + (∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), AffineMap.lineMap x y t - x = t + • (y - x)) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb va (-δ) + U - vb = (-δ) • (va - vb)) ) := by + classical + intro n p E va vb vc lineMapSub r₀ r δ₀ δ U + change AffineMap.lineMap vb va (-δ) - vb = (-δ) • (va - vb) + exact lineMapSub vb va (-δ) + +private theorem hXdiffAt1105 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + (∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), AffineMap.lineMap x y t - x = t + • (y - x)) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let X : Real × Real := AffineMap.lineMap vb vc δ + X - vb = δ • (vc - vb)) ) := by + classical + intro n p E va vb vc lineMapSub r₀ r δ₀ δ X + change AffineMap.lineMap vb vc δ - vb = δ • (vc - vb) + exact lineMapSub vb vc δ + +private theorem hUballAt1108 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb va (-δ) + (0 < δ) → ((δ * ‖va - vb‖ < r) → ((U - vb = (-δ) • (va - vb)) → (U ∈ Metric.ball vb r))) + ) := by + classical + intro n p E va vb vc r₀ r δ₀ δ U hδ hδa hUdiff + rw [Metric.mem_ball, dist_eq_norm, hUdiff, norm_smul] + simp only [Real.norm_eq_abs, abs_neg, abs_of_pos hδ] + exact hδa + +private theorem hXballAt1112 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let X : Real × Real := AffineMap.lineMap vb vc δ + (0 < δ) → ((δ * ‖vc - vb‖ < r) → ((X - vb = δ • (vc - vb)) → (X ∈ Metric.ball vb r))) ) + := by + classical + intro n p E va vb vc r₀ r δ₀ δ X hδ hδc hXdiff + rw [Metric.mem_ball, dist_eq_norm, hXdiff, norm_smul] + simp only [Real.norm_eq_abs, abs_of_pos hδ] + exact hδc + +private theorem hUhighAt1116 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), (∀ + {m : Nat}, ∀ (i : Fin (m + 3)), i - 1 ≠ i) → ( + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb va (-δ) + (0 < δ) → ((U - vb = (-δ) • (va - vb)) → (E.ell vb < E.ell U))) ) := by + classical + intro n p E prevIndexNe va vb vc r₀ r δ₀ δ U hδ hUdiff + have hmap : E.ell (U - vb) = E.ell U - E.ell vb := map_sub E.ell U vb + rw [hUdiff, map_smul] at hmap + have hprev := E.maximum (E.b - 1) (prevIndexNe E.b) + have hlin : E.ell (va - vb) = E.ell va - E.ell vb := map_sub E.ell va vb + rw [hlin] at hmap + simp only [smul_eq_mul] at hmap + have hprod : 0 < (-δ) * (E.ell va - E.ell vb) := + mul_pos_of_neg_of_neg (neg_lt_zero.mpr hδ) (sub_neg.mpr hprev) + have hmap' : E.ell U - E.ell vb = (-δ) * (E.ell va - E.ell vb) := by + exact hmap.symm + linarith only [hmap', hprod] + +private theorem hbelowAt1128 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let vb := p.vertex E.b + ∀ i, E.ell (C.right.vertex i) ≤ E.ell vb ) := by + classical + intro n p E D C vb i + rw [C.right_vertex] + change E.ell (p.vertex (C.ir i)) ≤ E.ell (p.vertex E.b) + by_cases hi : C.ir i = E.b + · simp [hi] + · have hm := E.maximum (C.ir i) hi + simpa [vb] using le_of_lt hm + +private theorem hU0At1138 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (A.coord 0 va = 1) → ((A.coord 0 vb = 0) → ((∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : + Real × Real), ∀ (t : Real), A.coord i (AffineMap.lineMap x y t) = (1 - t) * A.coord i + x + t * A.coord i y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb va (-δ) + A.coord 0 U = -δ))) ) := by + classical + intro n p E va vb vc vv hind hspan A hcoordA0 hcoordB0 hcoordLine r₀ r δ₀ δ U + rw [hcoordLine 0 vb va (-δ), hcoordB0, hcoordA0] + ring + +private theorem hU2At1141 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (A.coord 2 va = 0) → ((A.coord 2 vb = 0) → ((∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : + Real × Real), ∀ (t : Real), A.coord i (AffineMap.lineMap x y t) = (1 - t) * A.coord i + x + t * A.coord i y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb va (-δ) + A.coord 2 U = 0))) ) := by + classical + intro n p E va vb vc vv hind hspan A hcoordA2 hcoordB2 hcoordLine r₀ r δ₀ δ U + rw [hcoordLine 2 vb va (-δ), hcoordB2, hcoordA2] + ring + +private theorem hX0At1144 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (A.coord 0 vb = 0) → ((A.coord 0 vc = 0) → ((∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : + Real × Real), ∀ (t : Real), A.coord i (AffineMap.lineMap x y t) = (1 - t) * A.coord i + x + t * A.coord i y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let X : Real × Real := AffineMap.lineMap vb vc δ + A.coord 0 X = 0))) ) := by + classical + intro n p E va vb vc vv hind hspan A hcoordB0 hcoordC0 hcoordLine r₀ r δ₀ δ X + rw [hcoordLine 0 vb vc δ, hcoordB0, hcoordC0] + ring + +private theorem hX2At1147 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (A.coord 2 vb = 0) → ((A.coord 2 vc = 1) → ((∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : + Real × Real), ∀ (t : Real), A.coord i (AffineMap.lineMap x y t) = (1 - t) * A.coord i + x + t * A.coord i y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let X : Real × Real := AffineMap.lineMap vb vc δ + A.coord 2 X = δ))) ) := by + classical + intro n p E va vb vc vv hind hspan A hcoordB2 hcoordC2 hcoordLine r₀ r δ₀ δ X + rw [hcoordLine 2 vb vc δ, hcoordB2, hcoordC2] + ring + +private theorem hγ0At1150 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), A.coord i + (AffineMap.lineMap x y t) = (1 - t) * A.coord i x + t * A.coord i y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb va (-δ) + let X : Real × Real := AffineMap.lineMap vb vc δ + let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t + (A.coord 0 U = -δ) → ((A.coord 0 X = 0) → (∀ (t : Real), A.coord 0 (γ t) = -(1-t)*δ))) ) + := by + classical + intro n p E va vb vc vv hind hspan A hcoordLine r₀ r δ₀ δ U X γ hU0 hX0 t + rw [hcoordLine 0 U X t, hU0, hX0] + ring + +private theorem hγ2At1153 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), A.coord i + (AffineMap.lineMap x y t) = (1 - t) * A.coord i x + t * A.coord i y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb va (-δ) + let X : Real × Real := AffineMap.lineMap vb vc δ + let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t + (A.coord 2 U = 0) → ((A.coord 2 X = δ) → (∀ (t : Real), A.coord 2 (γ t) = t*δ))) ) := by + classical + intro n p E va vb vc vv hind hspan A hcoordLine r₀ r δ₀ δ U X γ hU2 hX2 t + rw [hcoordLine 2 U X t, hU2, hX2] + ring + +private theorem hrightCenterAt1156 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (D.a = E.b) + → ( + let vb := p.vertex E.b + (C.ir (Fin.last (C.right_n + 2)) = D.a) → (C.right.vertex (Fin.last (C.right_n + 2)) = + vb)) ) := by + classical + intro n p E D C ha vb hrightLast + rw [C.right_vertex] + simp [hrightLast, ha, vb] + +private theorem hrightZero : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (C.ir 0 = + D.b) → (C.right.vertex 0 = p.vertex D.b) ) := by + classical + intro n p E D C hrightFirst + rw [C.right_vertex] + simp [hrightFirst] + +private theorem hrightWrap : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), Fin.last + (C.right_n + 2) + 1 = (0 : Fin (C.right_n + 3)) ) := by + classical + intro n p E D C + apply Fin.ext + simp + +private theorem hrightIncidentPrevAt1166 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let va := p.vertex (E.b - 1) + (C.ir ⟨C.right_n+1, by omega⟩ = E.b - 1) → (C.right.vertex ⟨C.right_n + 1, + by omega⟩ = va)) := by + classical + intro n p E D C va hrightPrev + rw [C.right_vertex] + exact congrArg p.vertex hrightPrev + +private theorem hballPathAt1170 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb va (-δ) + let X : Real × Real := AffineMap.lineMap vb vc δ + let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t + (U ∈ Metric.ball vb r) → ((X ∈ Metric.ball vb r) → (∀ (t : Real), (t ∈ Set.Icc (0 : Real) + 1) → (γ t ∈ Metric.ball vb r))) ) := by + classical + intro n p E va vb vc r₀ r δ₀ δ U X γ hUball hXball t ht + have hseg := (convex_ball vb r).segment_subset hUball hXball + apply hseg + rw [segment_eq_image_lineMap] + exact ⟨t, ht, rfl⟩ + +private theorem havoidAt1176 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let CR := P3544T1BoundaryCarrier C.right + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (0 < A.coord 0 (p.vertex D.b)) → ((A.coord 0 va = 1) → ((A.coord 2 va = 0) → ((A.coord 0 + vb = 0) → ((A.coord 2 vb = + 0) → ((∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), A.coord + i (AffineMap.lineMap x y t) = (1 - t) * A.coord i x + t * A.coord i + y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + (∀ x ∈ Metric.ball (C.right.vertex (Fin.last (C.right_n + (2 : ℕ)))) r, x ∉ ⋃ + (j : Fin (C.right_n + (3 : ℕ))), if j ≠ Fin.last (C.right_n + (2 : ℕ)) ∧ j + (1 : Fin + (C.right_n + (3 : ℕ))) ≠ Fin.last (C.right_n + (2 : ℕ)) then segment ℝ + (C.right.vertex j) (C.right.vertex (j + (1 : Fin (C.right_n + (3 : ℕ))))) else ∅) → ( + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb va (-δ) + let X : Real × Real := AffineMap.lineMap vb vc δ + let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t + (0 < δ) → ((∀ (t : Real), A.coord 0 (γ t) = -(1-t)*δ) → ((∀ (t : Real), A.coord 2 (γ t) = + t*δ) → ((C.right.vertex (Fin.last (C.right_n + + 2)) = vb) → ((C.right.vertex 0 = p.vertex D.b) → ((Fin.last (C.right_n + 2) + 1 = + (0 : Fin (C.right_n + 3))) → ((C.right.vertex ⟨C.right_n + + 1, by omega⟩ = va) → ((∀ (t : Real), (t ∈ Set.Icc (0 : Real) 1) → (γ t ∈ + Metric.ball vb r)) → (∀ t ∈ Set.Icc (0 : Real) 1, γ t ∉ CR)))))))))))))))) := by + classical + intro n p E D C CR va vb vc vv hind hspan A hcoord0 hcoordA0 hcoordA2 hcoordB0 hcoordB2 + hcoordLine r₀ r hnear δ₀ δ U X γ hδ hγ0 hγ2 hrightCenter hrightZero hrightWrap + hrightIncidentPrev hballPath t ht hcarrier + have hnear' := hnear (γ t) (by rw [hrightCenter]; exact hballPath t ht) + obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hcarrier + have hinc : i = Fin.last (C.right_n + 2) ∨ + i + 1 = Fin.last (C.right_n + 2) := by + by_contra hn + have hnot : i ≠ Fin.last (C.right_n + 2) ∧ + i + 1 ≠ Fin.last (C.right_n + 2) := by + constructor + · intro he + exact hn (Or.inl he) + · intro he + exact hn (Or.inr he) + have hsegment : + γ t ∈ (if i ≠ Fin.last (C.right_n + 2) ∧ + i + 1 ≠ Fin.last (C.right_n + 2) then + segment Real (C.right.vertex i) (C.right.vertex (i + 1)) else ∅) := by + rw [ite_eq_left hnot] + exact hi + exact hnear' (Set.mem_iUnion.mpr ⟨i, hsegment⟩) + rcases hinc with htopEdge | hprevEdge + · subst i + have hseg : γ t ∈ segment Real vb (p.vertex D.b) := by + simpa [hrightCenter, hrightWrap, hrightZero] using hi + rw [segment_eq_image_lineMap] at hseg + obtain ⟨s, hs, heq⟩ := hseg + have h0 := congrArg (A.coord 0) heq + rw [hγ0, hcoordLine 0 vb (p.vertex D.b) s, hcoordB0] at h0 + have hprod : 0 ≤ s * A.coord 0 (p.vertex D.b) := + mul_nonneg hs.1 hcoord0.le + have hγle : -(1-t)*δ ≤ 0 := by + apply mul_nonpos_of_nonpos_of_nonneg _ hδ.le + linarith [ht.2] + have hsprod : s * A.coord 0 (p.vertex D.b) = 0 := by + linarith only [h0, hγle, hprod] + have hmul : (1-t)*δ = 0 := by linarith only [h0, hsprod] + have hs0 : s = 0 := (mul_eq_zero.mp hsprod).resolve_right (ne_of_gt hcoord0) + have ht1 : t = 1 := by + have ht' := (mul_eq_zero.mp hmul).resolve_right (ne_of_gt hδ) + linarith only [ht'] + have h2 := congrArg (A.coord 2) heq + rw [hγ2, hcoordLine 2 vb (p.vertex D.b) s, hcoordB2] at h2 + subst s + rw [ht1] at h2 + simp at h2 + exact (ne_of_gt hδ) h2.symm + · have hidx : i = ⟨C.right_n + 1, by omega⟩ := by + have hv0 := congrArg Fin.val hprevEdge + have hnotlast : i ≠ Fin.last (C.right_n + 2) := by + intro he + rw [he, Fin.val_add_one] at hv0 + simp at hv0 + have hv : i.val + 1 = C.right_n + 2 := by + simpa [Fin.val_add_one, hnotlast] using hv0 + have hv' : i.val + 1 = (C.right_n + 1) + 1 := by + simpa [Nat.add_assoc] using hv + exact Fin.ext (Nat.add_right_cancel hv') + rw [hidx] at hi + have hnextLast : + (⟨C.right_n + 1, by omega⟩ : Fin (C.right_n + 3)) + 1 = + Fin.last (C.right_n + 2) := by + apply Fin.ext + have hne : (⟨C.right_n + 1, by omega⟩ : Fin (C.right_n + 3)) ≠ + Fin.last (C.right_n + 2) := by + intro he + have hv := congrArg Fin.val he + simp at hv + rw [Fin.val_add_one] + simp [hne] + have hseg : γ t ∈ segment Real va vb := by + simpa [hrightIncidentPrev, hrightCenter, hnextLast] using hi + rw [segment_eq_image_lineMap] at hseg + obtain ⟨s, hs, heq⟩ := hseg + have h2 := congrArg (A.coord 2) heq + rw [hγ2, hcoordLine 2 va vb s, hcoordA2, hcoordB2] at h2 + have ht0 : t = 0 := by + have htprod : t * δ = 0 := by simpa using h2 + exact (mul_eq_zero.mp htprod).resolve_right (ne_of_gt hδ) + have h0 := congrArg (A.coord 0) heq + rw [hγ0, hcoordLine 0 va vb s, hcoordA0, hcoordB0] at h0 + rw [ht0] at h0 + have hnonneg : 0 ≤ 1-s := by linarith only [hs.2] + have h0' : -δ = 1-s := by simpa using h0.symm + have : -δ < 0 := neg_lt_zero.mpr hδ + linarith only [h0', hnonneg, this] + +private theorem hXnotAt1265 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let OR := P3544T1RayParity C.right + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb va (-δ) + let X : Real × Real := AffineMap.lineMap vb vc δ + let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t + (∀ t ∈ Set.Icc (0 : ℝ) (1 : ℝ), γ t ∉ P3544T1RayParity C.right) → (X ∉ OR) ) := by + classical + intro n p E D C OR va vb vc r₀ r δ₀ δ U X γ hXeven + have h := hXeven 1 ⟨by norm_num, by norm_num⟩ + simpa [γ, AffineMap.lineMap_apply_one] using h + +private theorem hleftStart : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (D.a = E.b) + → ( + let vb := p.vertex E.b + (C.il 0 = D.a) → (C.left.vertex 0 = vb)) ) := by + classical + intro n p E D C ha vb hleftFirst + rw [C.left_vertex] + simp [hleftFirst, ha, vb] + +private theorem hleftStartNext : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let vc := p.vertex (E.b + 1) + (C.il 1 = E.b + 1) → (C.left.vertex 1 = vc) ) := by + classical + intro n p E D C vc hleftNext + rw [C.left_vertex] + simp [hleftNext, vc] + +private theorem hXcarrierAt1274 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let CL := P3544T1BoundaryCarrier C.left + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let X : Real × Real := AffineMap.lineMap vb vc δ + (0 < δ) → ((δ < 1) → ((C.left.vertex 0 = vb) → ((C.left.vertex 1 = vc) → (X ∈ CL)))) ) := by + classical + intro n p E D C CL va vb vc r₀ r δ₀ δ X hδ hδlt1 hleftStart hleftStartNext + change X ∈ P3544T1BoundaryCarrier C.left + change X ∈ ⋃ i, segment Real (C.left.vertex i) (C.left.vertex (i + 1)) + refine Set.mem_iUnion.mpr ⟨0, ?_⟩ + simp only [zero_add] + rw [hleftStart, hleftStartNext, segment_eq_image_lineMap] + exact ⟨δ, ⟨le_of_lt hδ, le_of_lt hδlt1⟩, rfl⟩ + +private theorem hXnotDiagAt1281 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), + let e := segment Real (p.vertex D.a) (p.vertex D.b) + (D.a = E.b) → ( + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (0 < A.coord 0 (p.vertex D.b)) → ((A.coord 0 vb = 0) → ((A.coord 2 vb = 0) → ((∀ (i : Fin + 3), ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), A.coord i + (AffineMap.lineMap x y t) = (1 - t) * A.coord i x + t * A.coord i y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let X : Real × Real := AffineMap.lineMap vb vc δ + (0 < δ) → ((A.coord 0 X = 0) → ((A.coord 2 X = δ) → (X ∉ e)))))))) ) := by + classical + intro n p E D e ha va vb vc vv hind hspan A hcoord0 hcoordB0 hcoordB2 hcoordLine r₀ r δ₀ δ X hδ + hX0 hX2 hmem + change X ∈ segment Real (p.vertex D.a) (p.vertex D.b) at hmem + rw [ha] at hmem + change X ∈ segment Real vb (p.vertex D.b) at hmem + rw [segment_eq_image_lineMap] at hmem + obtain ⟨s, hs, heq⟩ := hmem + have h0 := congrArg (A.coord 0) heq + rw [hcoordLine 0 vb (p.vertex D.b) s, hcoordB0, hX0] at h0 + have h0' : s * A.coord 0 (p.vertex D.b) = 0 := by + simpa only [mul_zero, zero_add] using h0 + have hs0 : s = 0 := + (mul_eq_zero.mp h0').resolve_right (ne_of_gt hcoord0) + have h2 := congrArg (A.coord 2) heq + rw [hcoordLine 2 vb (p.vertex D.b) s, hcoordB2, hX2] at h2 + rw [hs0] at h2 + simp at h2 + exact (ne_of_gt hδ) h2.symm + +private theorem hscaleAt1324 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + (0 < r) → ( + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + δ₀ * (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) = r) ) := by + classical + intro n p E va vb vc r₀ r hr δ₀ + change (r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1))) * + (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) = r + field_simp + +private theorem hδaAt1328 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + (0 < δ₀) → ((δ₀ * (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) = r) → (δ * ‖va - vb‖ < r)) ) := by + classical + intro n p E va vb vc r₀ r δ₀ δ hδ₀ hscale + have hbound : ‖va - vb‖ < 2 * (‖va - vb‖ + ‖vc - vb‖ + 1) := by + linarith only [norm_nonneg (va - vb), norm_nonneg (vc - vb)] + calc + δ * ‖va - vb‖ ≤ δ₀ * ‖va - vb‖ := + mul_le_mul_of_nonneg_right (min_le_left δ₀ (1/2)) (norm_nonneg _) + _ < δ₀ * (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) := + mul_lt_mul_of_pos_left hbound hδ₀ + _ = r := hscale + +private theorem hδcAt1337 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + (0 < δ₀) → ((δ₀ * (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) = r) → (δ * ‖vc - vb‖ < r)) ) := by + classical + intro n p E va vb vc r₀ r δ₀ δ hδ₀ hscale + have hbound : ‖vc - vb‖ < 2 * (‖va - vb‖ + ‖vc - vb‖ + 1) := by + linarith only [norm_nonneg (va - vb), norm_nonneg (vc - vb)] + calc + δ * ‖vc - vb‖ ≤ δ₀ * ‖vc - vb‖ := + mul_le_mul_of_nonneg_right (min_le_left δ₀ (1/2)) (norm_nonneg _) + _ < δ₀ * (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) := + mul_lt_mul_of_pos_left hbound hδ₀ + _ = r := hscale + +private theorem hUdiffAt1346 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + (∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), AffineMap.lineMap x y t - x = t + • (y - x)) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb vc (-δ) + U - vb = (-δ) • (vc - vb)) ) := by + classical + intro n p E va vb vc lineMapSub r₀ r δ₀ δ U + change AffineMap.lineMap vb vc (-δ) - vb = (-δ) • (vc - vb) + exact lineMapSub vb vc (-δ) + +private theorem hXdiffAt1349 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + (∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), AffineMap.lineMap x y t - x = t + • (y - x)) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let X : Real × Real := AffineMap.lineMap vb va δ + X - vb = δ • (va - vb)) ) := by + classical + intro n p E va vb vc lineMapSub r₀ r δ₀ δ X + change AffineMap.lineMap vb va δ - vb = δ • (va - vb) + exact lineMapSub vb va δ + +private theorem hUballAt1352 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb vc (-δ) + (0 < δ) → ((δ * ‖vc - vb‖ < r) → ((U - vb = (-δ) • (vc - vb)) → (U ∈ Metric.ball vb r))) + ) := by + classical + intro n p E va vb vc r₀ r δ₀ δ U hδ hδc hUdiff + rw [Metric.mem_ball, dist_eq_norm, hUdiff, norm_smul] + simp only [Real.norm_eq_abs, abs_neg, abs_of_pos hδ] + exact hδc + +private theorem hXballAt1356 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let X : Real × Real := AffineMap.lineMap vb va δ + (0 < δ) → ((δ * ‖va - vb‖ < r) → ((X - vb = δ • (va - vb)) → (X ∈ Metric.ball vb r))) ) + := by + classical + intro n p E va vb vc r₀ r δ₀ δ X hδ hδa hXdiff + rw [Metric.mem_ball, dist_eq_norm, hXdiff, norm_smul] + simp only [Real.norm_eq_abs, abs_of_pos hδ] + exact hδa + +private theorem hUhighAt1360 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), (∀ + {m : Nat}, ∀ (i : Fin (m + 3)), i + 1 ≠ i) → ( + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb vc (-δ) + (0 < δ) → ((U - vb = (-δ) • (vc - vb)) → (E.ell vb < E.ell U))) ) := by + classical + intro n p E nextIndexNe va vb vc r₀ r δ₀ δ U hδ hUdiff + have hmap : E.ell (U - vb) = E.ell U - E.ell vb := map_sub E.ell U vb + rw [hUdiff, map_smul] at hmap + have hnext := E.maximum (E.b + 1) (nextIndexNe E.b) + have hlin : E.ell (vc - vb) = E.ell vc - E.ell vb := map_sub E.ell vc vb + rw [hlin] at hmap + simp only [smul_eq_mul] at hmap + have hprod : 0 < (-δ) * (E.ell vc - E.ell vb) := + mul_pos_of_neg_of_neg (neg_lt_zero.mpr hδ) (sub_neg.mpr hnext) + have hmap' : E.ell U - E.ell vb = (-δ) * (E.ell vc - E.ell vb) := + hmap.symm + linarith only [hmap', hprod] + +private theorem hbelowAt1372 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let vb := p.vertex E.b + ∀ i, E.ell (C.left.vertex i) ≤ E.ell vb ) := by + classical + intro n p E D C vb i + rw [C.left_vertex] + change E.ell (p.vertex (C.il i)) ≤ E.ell (p.vertex E.b) + by_cases hi : C.il i = E.b + · simp [hi] + · have hm := E.maximum (C.il i) hi + simpa [vb] using le_of_lt hm + +private theorem hU0At1382 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (A.coord 0 vb = 0) → ((A.coord 0 vc = 0) → ((∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : + Real × Real), ∀ (t : Real), A.coord i (AffineMap.lineMap x y t) = (1 - t) * A.coord i + x + t * A.coord i y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb vc (-δ) + A.coord 0 U = 0))) ) := by + classical + intro n p E va vb vc vv hind hspan A hcoordB0 hcoordC0 hcoordLine r₀ r δ₀ δ U + rw [hcoordLine 0 vb vc (-δ), hcoordB0, hcoordC0] + ring + +private theorem hU2At1385 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (A.coord 2 vb = 0) → ((A.coord 2 vc = 1) → ((∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : + Real × Real), ∀ (t : Real), A.coord i (AffineMap.lineMap x y t) = (1 - t) * A.coord i + x + t * A.coord i y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb vc (-δ) + A.coord 2 U = -δ))) ) := by + classical + intro n p E va vb vc vv hind hspan A hcoordB2 hcoordC2 hcoordLine r₀ r δ₀ δ U + rw [hcoordLine 2 vb vc (-δ), hcoordB2, hcoordC2] + ring + +private theorem hX0At1388 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (A.coord 0 va = 1) → ((A.coord 0 vb = 0) → ((∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : + Real × Real), ∀ (t : Real), A.coord i (AffineMap.lineMap x y t) = (1 - t) * A.coord i + x + t * A.coord i y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let X : Real × Real := AffineMap.lineMap vb va δ + A.coord 0 X = δ))) ) := by + classical + intro n p E va vb vc vv hind hspan A hcoordA0 hcoordB0 hcoordLine r₀ r δ₀ δ X + rw [hcoordLine 0 vb va δ, hcoordB0, hcoordA0] + ring + +private theorem hX2At1391 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (A.coord 2 va = 0) → ((A.coord 2 vb = 0) → ((∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : + Real × Real), ∀ (t : Real), A.coord i (AffineMap.lineMap x y t) = (1 - t) * A.coord i + x + t * A.coord i y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let X : Real × Real := AffineMap.lineMap vb va δ + A.coord 2 X = 0))) ) := by + classical + intro n p E va vb vc vv hind hspan A hcoordA2 hcoordB2 hcoordLine r₀ r δ₀ δ X + rw [hcoordLine 2 vb va δ, hcoordB2, hcoordA2] + ring + +private theorem hγ0At1394 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), A.coord i + (AffineMap.lineMap x y t) = (1 - t) * A.coord i x + t * A.coord i y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb vc (-δ) + let X : Real × Real := AffineMap.lineMap vb va δ + let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t + (A.coord 0 U = 0) → ((A.coord 0 X = δ) → (∀ (t : Real), A.coord 0 (γ t) = t*δ))) ) := by + classical + intro n p E va vb vc vv hind hspan A hcoordLine r₀ r δ₀ δ U X γ hU0 hX0 t + rw [hcoordLine 0 U X t, hU0, hX0] + ring + +private theorem hγ2At1397 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), A.coord i + (AffineMap.lineMap x y t) = (1 - t) * A.coord i x + t * A.coord i y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb vc (-δ) + let X : Real × Real := AffineMap.lineMap vb va δ + let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t + (A.coord 2 U = -δ) → ((A.coord 2 X = 0) → (∀ (t : Real), A.coord 2 (γ t) = -(1-t)*δ))) ) + := by + classical + intro n p E va vb vc vv hind hspan A hcoordLine r₀ r δ₀ δ U X γ hU2 hX2 t + rw [hcoordLine 2 U X t, hU2, hX2] + ring + +private theorem hleftCenter : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (D.a = E.b) + → ( + let vb := p.vertex E.b + (C.il 0 = D.a) → (C.left.vertex 0 = vb)) ) := by + classical + intro n p E D C ha vb hleftFirst + rw [C.left_vertex] + simp [hleftFirst, ha, vb] + +private theorem hleftOne : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let vc := p.vertex (E.b + 1) + (C.il 1 = E.b + 1) → (C.left.vertex 1 = vc) ) := by + classical + intro n p E D C vc hleftNext + rw [C.left_vertex] + simp [hleftNext, vc] + +private theorem hleftWrap : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), Fin.last + (C.left_n + 2) + 1 = (0 : Fin (C.left_n + 3)) ) := by + classical + intro n p E D C + apply Fin.ext + simp + +private theorem hleftEnd : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (C.il + (Fin.last (C.left_n + 2)) = D.b) → (C.left.vertex (Fin.last (C.left_n + 2)) = + p.vertex D.b) ) := by + classical + intro n p E D C hleftLast + rw [C.left_vertex] + simp [hleftLast] + +private theorem hballPathAt1412 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb vc (-δ) + let X : Real × Real := AffineMap.lineMap vb va δ + let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t + (U ∈ Metric.ball vb r) → ((X ∈ Metric.ball vb r) → ((C.left.vertex 0 = vb) → (∀ (t : + Real), (t ∈ Set.Icc (0 : Real) 1) → (γ t ∈ Metric.ball (C.left.vertex 0) r)))) ) := by + classical + intro n p E D C va vb vc r₀ r δ₀ δ U X γ hUball hXball hleftCenter t ht + have hseg := (convex_ball vb r).segment_subset hUball hXball + rw [hleftCenter] + apply hseg + rw [segment_eq_image_lineMap] + exact ⟨t, ht, rfl⟩ + +private theorem havoidAt1419 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let CL := P3544T1BoundaryCarrier C.left + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (0 < A.coord 2 (p.vertex D.b)) → ((A.coord 0 vb = 0) → ((A.coord 2 vb = 0) → ((A.coord 0 + vc = 0) → ((A.coord 2 vc = 1) → ((∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : Real × + Real), ∀ (t : Real), A.coord i (AffineMap.lineMap x y t) = (1 - t) * A.coord i x + t + * A.coord i y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + (∀ x ∈ Metric.ball (C.left.vertex (0 : Fin (C.left_n + (3 : ℕ)))) r, x ∉ ⋃ (j : Fin + (C.left_n + (3 : ℕ))), if j ≠ (0 : Fin (C.left_n + (3 : ℕ))) ∧ j + (1 : Fin (C.left_n + + (3 : ℕ))) ≠ (0 : Fin (C.left_n + (3 : ℕ))) then segment ℝ (C.left.vertex j) + (C.left.vertex (j + (1 : Fin (C.left_n + (3 : ℕ))))) else ∅) → ( + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb vc (-δ) + let X : Real × Real := AffineMap.lineMap vb va δ + let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t + (0 < δ) → ((∀ (t : Real), A.coord 0 (γ t) = t*δ) → ((∀ (t : Real), A.coord 2 (γ t) = + -(1-t)*δ) → ((C.left.vertex 0 = vb) → ((C.left.vertex 1 = vc) → ((Fin.last (C.left_n + + 2) + 1 = (0 : Fin (C.left_n + 3))) → ((C.left.vertex (Fin.last (C.left_n + 2)) = + p.vertex D.b) → ((∀ (t : Real), (t ∈ Set.Icc (0 : Real) 1) → (γ t ∈ Metric.ball + (C.left.vertex 0) r)) → (∀ t ∈ Set.Icc (0 : Real) 1, γ t ∉ CL))))))))))))))) ) := by + classical + intro n p E D C CL va vb vc vv hind hspan A hcoord2 hcoordB0 hcoordB2 hcoordC0 hcoordC2 + hcoordLine r₀ r hnear δ₀ δ U X γ hδ hγ0 hγ2 hleftCenter hleftOne hleftWrap hleftEnd + hballPath t ht hcarrier + have hnear' := hnear (γ t) (hballPath t ht) + obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hcarrier + have hinc : i = 0 ∨ i + 1 = 0 := by + by_contra hn + have hnot : i ≠ 0 ∧ i + 1 ≠ 0 := by + constructor + · intro he + exact hn (Or.inl he) + · intro he + exact hn (Or.inr he) + have hsegment : + γ t ∈ (if i ≠ 0 ∧ i + 1 ≠ 0 then + segment Real (C.left.vertex i) (C.left.vertex (i + 1)) else ∅) := by + rw [ite_eq_left hnot] + exact hi + exact hnear' (Set.mem_iUnion.mpr ⟨i, hsegment⟩) + rcases hinc with hfirstEdge | hlastEdge + · subst i + have hseg : γ t ∈ segment Real vb vc := by + simpa [hleftCenter, hleftOne] using hi + rw [segment_eq_image_lineMap] at hseg + obtain ⟨s, hs, heq⟩ := hseg + have h0 := congrArg (A.coord 0) heq + rw [hγ0, hcoordLine 0 vb vc s, hcoordB0, hcoordC0] at h0 + have ht0 : t = 0 := by + have htprod : t * δ = 0 := by + simpa only [mul_zero, zero_mul, zero_add] using h0.symm + exact (mul_eq_zero.mp htprod).resolve_right (ne_of_gt hδ) + have h2 := congrArg (A.coord 2) heq + rw [hγ2, hcoordLine 2 vb vc s, hcoordB2, hcoordC2] at h2 + rw [ht0] at h2 + have h2' : s = -δ := by + norm_num at h2 + exact h2 + have hsnonneg : 0 ≤ s := hs.1 + have hδneg : -δ < 0 := neg_lt_zero.mpr hδ + linarith only [h2', hsnonneg, hδneg] + · have hidx : i = Fin.last (C.left_n + 2) := by + have hv := congrArg Fin.val hlastEdge + rw [Fin.val_add_one] at hv + split_ifs at hv with hwrap + · exact hwrap + · simp at hv + rw [hidx] at hi + have hseg : γ t ∈ segment Real (p.vertex D.b) vb := by + simpa [hleftEnd, hleftWrap, hleftCenter] using hi + rw [segment_eq_image_lineMap] at hseg + obtain ⟨s, hs, heq⟩ := hseg + have h2 := congrArg (A.coord 2) heq + rw [hγ2, hcoordLine 2 (p.vertex D.b) vb s, hcoordB2] at h2 + have hprod : 0 ≤ (1-s) * A.coord 2 (p.vertex D.b) := + mul_nonneg (by linarith [hs.2]) hcoord2.le + have hγle : -(1-t)*δ ≤ 0 := by + exact mul_nonpos_of_nonpos_of_nonneg + (by linarith only [ht.2]) hδ.le + have h2' : -(1-t)*δ = (1-s) * A.coord 2 (p.vertex D.b) := by + simpa only [mul_zero, add_zero] using h2.symm + have hγge : 0 ≤ -(1-t)*δ := by rw [h2']; exact hprod + have hz : -(1-t)*δ = 0 := + le_antisymm hγle hγge + have hprod0 : (1-s) * A.coord 2 (p.vertex D.b) = 0 := by + rw [← h2'] + exact hz + have hmul : (1-t)*δ = 0 := by + have hneg : -((1-t)*δ) = 0 := by simpa only [neg_mul] using hz + exact neg_eq_zero.mp hneg + have hs1 : s = 1 := by + have hs' := (mul_eq_zero.mp hprod0).resolve_right (ne_of_gt hcoord2) + linarith only [hs'] + have ht1 : t = 1 := by + have ht' := (mul_eq_zero.mp hmul).resolve_right (ne_of_gt hδ) + linarith only [ht'] + have h0 := congrArg (A.coord 0) heq + rw [hγ0, hcoordLine 0 (p.vertex D.b) vb s] at h0 + rw [ht1, hs1, hcoordB0] at h0 + simp only [one_mul, zero_mul, mul_zero, add_zero, sub_self] at h0 + exact (ne_of_gt hδ) h0.symm + +private theorem hXnotAt1500 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let OL := P3544T1RayParity C.left + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb vc (-δ) + let X : Real × Real := AffineMap.lineMap vb va δ + let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t + (∀ t ∈ Set.Icc (0 : ℝ) (1 : ℝ), γ t ∉ P3544T1RayParity C.left) → (X ∉ OL) ) := by + classical + intro n p E D C OL va vb vc r₀ r δ₀ δ U X γ hXeven + have h := hXeven 1 ⟨by norm_num, by norm_num⟩ + simpa only [γ, AffineMap.lineMap_apply_one] using h + +private theorem hrightCenterAt1503 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (D.a = E.b) + → ( + let vb := p.vertex E.b + (C.ir (Fin.last (C.right_n + 2)) = D.a) → (C.right.vertex (Fin.last (C.right_n + 2)) = + vb)) ) := by + classical + intro n p E D C ha vb hrightLast + rw [C.right_vertex] + simp [hrightLast, ha, vb] + +private theorem hrightIncidentPrevAt1506 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let va := p.vertex (E.b - 1) + (C.ir ⟨C.right_n+1, by omega⟩ = E.b - 1) → (C.right.vertex ⟨C.right_n + 1, + by omega⟩ = va)) := by + classical + intro n p E D C va hrightPrev + rw [C.right_vertex] + exact congrArg p.vertex hrightPrev + +private theorem hrightNextLast : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (⟨C.right_n + + 1, by omega⟩ : Fin (C.right_n + 3)) + 1 = + Fin.last (C.right_n + 2) ) := by + classical + intro n p E D C + apply Fin.ext + have hne : (⟨C.right_n + 1, by omega⟩ : Fin (C.right_n + 3)) ≠ + Fin.last (C.right_n + 2) := by + intro he + have hv := congrArg Fin.val he + simp at hv + rw [Fin.val_add_one] + simp [hne] + +private theorem hXcarrierAt1521 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let CR := P3544T1BoundaryCarrier C.right + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + ∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let X : Real × Real := AffineMap.lineMap vb va δ + (0 < δ) → ((δ < 1) → ((C.right.vertex (Fin.last (C.right_n + + 2)) = vb) → ((C.right.vertex ⟨C.right_n + 1, by omega⟩ = va) → (((⟨C.right_n + 1, + by omega⟩ : Fin (C.right_n + 3)) + 1 = + Fin.last (C.right_n + 2)) → (X ∈ CR)))))) := by + classical + intro n p E D C CR va vb vc r₀ r δ₀ δ X hδ hδlt1 hrightCenter hrightIncidentPrev hrightNextLast + change X ∈ P3544T1BoundaryCarrier C.right + change X ∈ ⋃ i, segment Real (C.right.vertex i) (C.right.vertex (i + 1)) + refine Set.mem_iUnion.mpr ⟨⟨C.right_n + 1, by omega⟩, ?_⟩ + rw [hrightNextLast, hrightIncidentPrev, hrightCenter] + rw [segment_symm] + rw [segment_eq_image_lineMap] + exact ⟨δ, ⟨le_of_lt hδ, le_of_lt hδlt1⟩, rfl⟩ + +private theorem hXnotDiagAt1529 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), + let e := segment Real (p.vertex D.a) (p.vertex D.b) + (D.a = E.b) → ( + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + (0 < A.coord 2 (p.vertex D.b)) → ((A.coord 0 vb = 0) → ((A.coord 2 vb = 0) → ((∀ (i : Fin + 3), ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), A.coord i + (AffineMap.lineMap x y t) = (1 - t) * A.coord i x + t * A.coord i y) → (∀ (r₀ : ℝ), + let r : Real := min r₀ 1 + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let X : Real × Real := AffineMap.lineMap vb va δ + (0 < δ) → ((A.coord 0 X = δ) → ((A.coord 2 X = 0) → (X ∉ e)))))))) ) := by + classical + intro n p E D e ha va vb vc vv hind hspan A hcoord2 hcoordB0 hcoordB2 hcoordLine r₀ r δ₀ δ X hδ + hX0 hX2 hmem + change X ∈ segment Real (p.vertex D.a) (p.vertex D.b) at hmem + rw [ha] at hmem + change X ∈ segment Real vb (p.vertex D.b) at hmem + rw [segment_eq_image_lineMap] at hmem + obtain ⟨s, hs, heq⟩ := hmem + have h2 := congrArg (A.coord 2) heq + rw [hcoordLine 2 vb (p.vertex D.b) s, hcoordB2, hX2] at h2 + have h2' : s * A.coord 2 (p.vertex D.b) = 0 := by + simpa only [mul_zero, zero_add] using h2 + have hs0 : s = 0 := + (mul_eq_zero.mp h2').resolve_right (ne_of_gt hcoord2) + have h0 := congrArg (A.coord 0) heq + rw [hcoordLine 0 vb (p.vertex D.b) s, hcoordB0, hX0] at h0 + rw [hs0] at h0 + simp only [zero_mul, mul_zero, add_zero] at h0 + exact (ne_of_gt hδ) h0.symm + +end OldArcParityProof + +namespace OldArcAssembly + +private theorem oldArcEvenOnPreconnected : + (by + classical + exact + ∀ {X : Type}, ∀ [inst : TopologicalSpace X], ∀ (O : Set X), ∀ (K : Set X), ∀ (S : Set X), + IsOpen O → closure O = O ∪ K → IsPreconnected S → Disjoint S K → ∀ x ∈ S, x ∉ O → + Disjoint S O ) := by + classical + intro X typeclassInstance0 O K S hO hclosure hS hSK x hx hxO + exact OldArcParityProof.oldArcEvenOnPreconnected (X := X) O + K S hO hclosure hS hSK x hx hxO + +private theorem oldArcOddOnPreconnected : + (by + classical + exact + (∀ {X : Type}, ∀ [inst : TopologicalSpace X], ∀ (O : Set X), ∀ (K : Set X), ∀ (S : Set + X), IsOpen O → closure O = O ∪ K → IsPreconnected S → Disjoint S K → ∀ x ∈ S, x ∉ O → + Disjoint S O) → (∀ {X : Type}, ∀ [inst : TopologicalSpace X], ∀ (O : Set X), ∀ (K : + Set X), ∀ (S : Set X), IsOpen O → closure O = O ∪ K → IsPreconnected S → Disjoint S K + → ∀ x ∈ S, x ∈ O → S ⊆ O) ) := by + classical + intro oldArcEvenOnPreconnected X typeclassInstance0 O K S hO hclosure hS hSK x hx hxO + exact OldArcParityProof.oldArcOddOnPreconnected + oldArcEvenOnPreconnected (X := X) O K S hO hclosure hS hSK x hx hxO + +private theorem oldArcEvenClosure : + (by + classical + exact + ∀ {X : Type}, ∀ [inst : TopologicalSpace X], ∀ (O : Set X), ∀ (S : Set X), IsOpen O → + Disjoint S O → Disjoint (closure S) O ) := by + classical + intro X typeclassInstance0 O S hO hSO + exact OldArcParityProof.oldArcEvenClosure + (X := X) O S hO hSO + +private theorem parityEvenAlongPath : + (by + classical + exact + (∀ {X : Type}, ∀ [inst : TopologicalSpace X], ∀ (O : Set X), ∀ (K : Set X), ∀ (S : Set + X), IsOpen O → closure O = O ∪ K → IsPreconnected S → Disjoint S K → ∀ x ∈ S, x ∉ O → + Disjoint S O) → (∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), ∀ (γ : Real → Real + × Real), (ContinuousOn γ (Set.Icc (0 : Real) 1)) → ((∀ t ∈ Set.Icc (0 : Real) 1, + γ t ∉ P3544T1BoundaryCarrier q) → ((γ 0 ∉ P3544T1RayParity q) → (∀ t ∈ Set.Icc (0 + : Real) 1, γ t ∉ P3544T1RayParity q)))) ) := by + classical + intro oldArcEvenOnPreconnected m q γ hcont havoid hstart + exact OldArcParityProof.parityEvenAlongPath oldArcEvenOnPreconnected (m := m) q γ hcont + havoid hstart + +private theorem upperHalfplaneEven : + (by + classical + exact + ∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), ∀ (ell : (Real × Real) →ₗ[Real] Real), ∀ + (H : Real), (∀ i, ell (q.vertex i) ≤ H) → (∀ (x : Real × Real), (H < ell x) → (x ∉ + P3544T1RayParity q)) ) := by + classical + intro m q ell H hbound x hx + exact OldArcParityProof.upperHalfplaneEven (m := m) q ell H hbound x hx + +private theorem middleNotSegment : + (by + classical + exact + ∀ {a : ℝ × ℝ}, ∀ {b : ℝ × ℝ}, ∀ {c : ℝ × ℝ}, P3381T1TriangleDeterminant ![a, b, c] ≠ (0 + : ℝ) → b ∉ segment ℝ a c ) := by + classical + intro a b c hdet + exact OldArcParityProof.middleNotSegment + (a := a) (b := b) (c := c) hdet + +private theorem strictUpperHalfplaneEven : + (by + classical + exact + (∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), ∀ (ell : (Real × Real) →ₗ[Real] Real), + ∀ (H : Real), (∀ i, ell (q.vertex i) ≤ H) → (∀ (x : Real × Real), (H < ell x) → (x ∉ + P3544T1RayParity q))) → (∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), ∀ (ell : + (Real × Real) →ₗ[Real] Real), ∀ (H : Real), (∀ i, ell (q.vertex i) < H) → (∀ (x : + Real × Real), (H < ell x) → (x ∉ P3544T1RayParity q))) ) := by + classical + intro upperHalfplaneEven m q ell H hbound x hx + exact upperHalfplaneEven q ell H (fun i => le_of_lt (hbound i)) x hx + +private theorem rightPreviousParent : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), (P3650T1CyclicChildren p D.a D.b) → (∀ {m : Nat}, ∀ + (q : P3381T1PolygonBoundary m), ∀ (a : Fin (m + 3)), ∀ (b : Fin (m + + 3)), ∀ (K : P3650T1CyclicChildren q a b), (K.rotation % (m + 3) = a.val) → (K.ir + ⟨K.right_n + 1, by omega⟩ = a - 1))) := by + classical + intro n p E D C m q a b K hrot + exact OldArcParityProof.rightPreviousParent n p E D C + (m := m) q a b K hrot + +private theorem hseedRAt3047 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let e := segment Real (p.vertex D.a) (p.vertex D.b) + let CL := P3544T1BoundaryCarrier C.left + let OR := P3544T1RayParity C.right + (∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), ∀ (γ : Real → + Real × Real), (ContinuousOn γ (Set.Icc (0 : Real) 1)) → ((∀ t ∈ Set.Icc (0 : Real) 1, + γ t ∉ P3544T1BoundaryCarrier q) → ((γ 0 ∉ P3544T1RayParity q) → (∀ t ∈ Set.Icc (0 + : Real) 1, γ t ∉ P3544T1RayParity q)))) → ((∀ {m : Nat}, ∀ (q : + P3381T1PolygonBoundary m), ∀ (ell : (Real × Real) →ₗ[Real] Real), ∀ (H : Real), + (∀ i, ell (q.vertex i) ≤ H) → (∀ (x : Real × Real), (H < ell x) → (x ∉ + P3544T1RayParity q))) → ((∀ {m : ℕ}, ∀ (i : Fin (m + (3 : ℕ))), i - + (1 : Fin (m + (3 : ℕ))) ≠ i) → ((∀ {m : ℕ}, ∀ (q : P3381T1PolygonBoundary m), ∀ (i + : Fin (m + (3 : ℕ))), ∃ (r : ℝ), (0 : ℝ) < r ∧ ∀ x + ∈ Metric.ball (q.vertex i) r, x ∉ ⋃ (j : Fin (m + (3 : ℕ))), if j ≠ i ∧ j + (1 : Fin + (m + (3 : ℕ))) ≠ i then segment ℝ (q.vertex j) (q.vertex (j + (1 : Fin (m + (3 : + ℕ))))) else ∅) → ((D.a = E.b) → ( + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent ℝ ![p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))]), ∀ (hspan : affineSpan ℝ (Set.range + ![p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, p.vertex (E.b + (1 : Fin (n + + (3 : ℕ))))]) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + ((0 : ℝ) < (A.coord + (0 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex D.b)) → ((C.ir (Fin.last + (C.right_n + (2 : ℕ))) = D.a) → ((C.ir ⟨C.right_n+1, by omega⟩ = E.b - 1) → ((C.ir (0 : + Fin (C.right_n + (3 : ℕ))) = D.b) → ((C.il (0 : Fin (C.left_n + (3 : ℕ))) = D.a) → + ((C.il 1 = E.b + 1) → (( + (A.coord (0 : Fin (3 + : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b - (1 : Fin (n + (3 : ℕ))))) = (1 : ℝ)) → (( + (A.coord (2 : Fin (3 + : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b - (1 : Fin (n + (3 : ℕ))))) = (0 : ℝ)) → (( + (A.coord (0 : Fin (3 + : ℕ)) : ℝ × ℝ → ℝ) (p.vertex E.b) = (0 : ℝ)) → (( + (A.coord (2 : Fin (3 + : ℕ)) : ℝ × ℝ → ℝ) (p.vertex E.b) = (0 : ℝ)) → (( + (A.coord (0 : Fin (3 + : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))) = (0 : ℝ)) → (( + (A.coord (2 : Fin (3 + : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))) = (1 : ℝ)) → ((∀ (i : + Fin (3 : ℕ)), ∀ (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), ∀ (t : ℝ), (A.coord i : ℝ × ℝ → ℝ) + ((AffineMap.lineMap x y : ℝ → ℝ × + ℝ) t) = ((1 : ℝ) - t) * (A.coord i : ℝ × ℝ → ℝ) x + t * (A.coord i : ℝ × ℝ → ℝ) y) → + ((∀ (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), ∀ (t : ℝ), (AffineMap.lineMap x y : ℝ → ℝ × ℝ) t + - x = t • (y - x)) → (∃ x, x ∈ CL \ e ∧ x ∉ + OR)))))))))))))))))))) := by + classical + intro n p E D C e CL OR parityEvenAlongPath upperHalfplaneEven prevIndexNe nonincidentBall ha + va vb vc vv hind hspan A hcoord0 hrightLast hrightPrev hrightFirst hleftFirst hleftNext + hcoordA0 hcoordA2 hcoordB0 hcoordB2 hcoordC0 hcoordC2 hcoordLine lineMapSub + let CR := P3544T1BoundaryCarrier C.right + obtain ⟨r₀, hr₀, hnear₀⟩ := nonincidentBall C.right (Fin.last (C.right_n + 2)) + let r : Real := min r₀ 1 + have hr : 0 < r := lt_min hr₀ zero_lt_one + have hnear (x : Real × Real) (hx : x ∈ + Metric.ball (C.right.vertex (Fin.last (C.right_n + 2))) r) := + hnear₀ x (Metric.ball_subset_ball (min_le_left r₀ 1) hx) + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb va (-δ) + let X : Real × Real := AffineMap.lineMap vb vc δ + let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t + have hδ₀ : 0 < δ₀ := by dsimp [δ₀]; positivity + have hδ : 0 < δ := lt_min hδ₀ (by norm_num) + have hδlt1 : δ < 1 := lt_of_le_of_lt (min_le_right δ₀ (1/2)) (by norm_num) + have hscale := OldArcParityProof.hscaleAt1080 n p E r₀ hr + have hδa := OldArcParityProof.hδaAt1084 n p E r₀ hδ₀ hscale + have hδc := OldArcParityProof.hδcAt1093 n p E r₀ hδ₀ hscale + have hUdiff := OldArcParityProof.hUdiffAt1102 n p E lineMapSub r₀ + have hXdiff := OldArcParityProof.hXdiffAt1105 n p E lineMapSub r₀ + have hUball := OldArcParityProof.hUballAt1108 n p E r₀ hδ hδa hUdiff + have hXball := OldArcParityProof.hXballAt1112 n p E r₀ hδ hδc hXdiff + have hUhigh : E.ell vb < E.ell U := OldArcParityProof.hUhighAt1116 n p E prevIndexNe r₀ hδ + hUdiff + have hbelow : ∀ i, E.ell (C.right.vertex i) ≤ E.ell vb := OldArcParityProof.hbelowAt1128 n + p E D C + have hUeven : U ∉ OR := by + simpa [OR] using upperHalfplaneEven C.right E.ell (E.ell vb) hbelow U hUhigh + have hU0 := OldArcParityProof.hU0At1138 n p E hind hspan hcoordA0 hcoordB0 hcoordLine r₀ + have hU2 := OldArcParityProof.hU2At1141 n p E hind hspan hcoordA2 hcoordB2 hcoordLine r₀ + have hX0 := OldArcParityProof.hX0At1144 n p E hind hspan hcoordB0 hcoordC0 hcoordLine r₀ + have hX2 := OldArcParityProof.hX2At1147 n p E hind hspan hcoordB2 hcoordC2 hcoordLine r₀ + have hγ0 (t : Real) := OldArcParityProof.hγ0At1150 n p E hind hspan hcoordLine r₀ hU0 hX0 t + have hγ2 (t : Real) := OldArcParityProof.hγ2At1153 n p E hind hspan hcoordLine r₀ hU2 hX2 t + have hrightCenter := OldArcParityProof.hrightCenterAt1156 n p E D C ha hrightLast + have hrightZero := OldArcParityProof.hrightZero n p E D C hrightFirst + have hrightWrap := OldArcParityProof.hrightWrap n p E D C + have hrightIncidentPrev := OldArcParityProof.hrightIncidentPrevAt1166 n p E D C hrightPrev + have hballPath (t : Real) (ht : t ∈ Set.Icc (0 : Real) 1) := + OldArcParityProof.hballPathAt1170 n p E r₀ hUball hXball t ht + have havoid : ∀ t ∈ Set.Icc (0 : Real) 1, γ t ∉ CR := OldArcParityProof.havoidAt1176 n p E + D C hind hspan hcoord0 hcoordA0 hcoordA2 hcoordB0 hcoordB2 hcoordLine r₀ hnear hδ hγ0 + hγ2 hrightCenter hrightZero hrightWrap hrightIncidentPrev hballPath + have hcont : ContinuousOn γ (Set.Icc (0 : Real) 1) := by + exact continuousOn_const.lineMap continuousOn_const continuousOn_id + have hXeven := parityEvenAlongPath C.right γ hcont havoid (by simpa [γ, OR] using hUeven) + have hXnot := OldArcParityProof.hXnotAt1265 n p E D C r₀ hXeven + have hleftStart := OldArcParityProof.hleftStart n p E D C ha hleftFirst + have hleftStartNext := OldArcParityProof.hleftStartNext n p E D C hleftNext + have hXcarrier := OldArcParityProof.hXcarrierAt1274 n p E D C r₀ hδ hδlt1 hleftStart + hleftStartNext + have hXnotDiag := OldArcParityProof.hXnotDiagAt1281 n p E D ha hind hspan hcoord0 hcoordB0 + hcoordB2 hcoordLine r₀ hδ hX0 hX2 + exact ⟨X, ⟨hXcarrier, hXnotDiag⟩, hXnot⟩ + +private theorem hseedLAt3101 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), + let e := segment Real (p.vertex D.a) (p.vertex D.b) + let CR := P3544T1BoundaryCarrier C.right + let OL := P3544T1RayParity C.left + (∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), ∀ (γ : Real → + Real × Real), (ContinuousOn γ (Set.Icc (0 : Real) 1)) → ((∀ t ∈ Set.Icc (0 : Real) 1, + γ t ∉ P3544T1BoundaryCarrier q) → ((γ 0 ∉ P3544T1RayParity q) → (∀ t ∈ Set.Icc (0 + : Real) 1, γ t ∉ P3544T1RayParity q)))) → ((∀ {m : Nat}, ∀ (q : + P3381T1PolygonBoundary m), ∀ (ell : (Real × Real) →ₗ[Real] Real), ∀ (H : Real), + (∀ i, ell (q.vertex i) ≤ H) → (∀ (x : Real × Real), (H < ell x) → (x ∉ + P3544T1RayParity q))) → ((∀ {m : ℕ}, ∀ (i : Fin (m + (3 : ℕ))), i + + (1 : Fin (m + (3 : ℕ))) ≠ i) → ((∀ {m : ℕ}, ∀ (q : P3381T1PolygonBoundary m), ∀ (i + : Fin (m + (3 : ℕ))), ∃ (r : ℝ), (0 : ℝ) < r ∧ ∀ x + ∈ Metric.ball (q.vertex i) r, x ∉ ⋃ (j : Fin (m + (3 : ℕ))), if j ≠ i ∧ j + (1 : Fin + (m + (3 : ℕ))) ≠ i then segment ℝ (q.vertex j) (q.vertex (j + (1 : Fin (m + (3 : + ℕ))))) else ∅) → ((D.a = E.b) → ( + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + ∀ (hind : AffineIndependent ℝ ![p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))]), ∀ (hspan : affineSpan ℝ (Set.range + ![p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, p.vertex (E.b + (1 : Fin (n + + (3 : ℕ))))]) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + ((0 : ℝ) < (A.coord + (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex D.b)) → ((C.ir (Fin.last + (C.right_n + (2 : ℕ))) = D.a) → ((C.ir ⟨C.right_n+1, by omega⟩ = E.b - 1) → ((C.il + (Fin.last (C.left_n + (2 : ℕ))) = D.b) → ((C.il (0 : Fin (C.left_n + (3 : ℕ))) = D.a) + → ((C.il 1 = E.b + 1) → (( + (A.coord (0 : Fin (3 + : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b - (1 : Fin (n + (3 : ℕ))))) = (1 : ℝ)) → (( + (A.coord (2 : Fin (3 + : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b - (1 : Fin (n + (3 : ℕ))))) = (0 : ℝ)) → (( + (A.coord (0 : Fin (3 + : ℕ)) : ℝ × ℝ → ℝ) (p.vertex E.b) = (0 : ℝ)) → (( + (A.coord (2 : Fin (3 + : ℕ)) : ℝ × ℝ → ℝ) (p.vertex E.b) = (0 : ℝ)) → (( + (A.coord (0 : Fin (3 + : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))) = (0 : ℝ)) → (( + (A.coord (2 : Fin (3 + : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))) = (1 : ℝ)) → ((∀ (i : + Fin (3 : ℕ)), ∀ (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), ∀ (t : ℝ), (A.coord i : ℝ × ℝ → ℝ) + ((AffineMap.lineMap x y : ℝ → ℝ × + ℝ) t) = ((1 : ℝ) - t) * (A.coord i : ℝ × ℝ → ℝ) x + t * (A.coord i : ℝ × ℝ → ℝ) y) → + ((∀ (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), ∀ (t : ℝ), (AffineMap.lineMap x y : ℝ → ℝ × ℝ) t + - x = t • (y - x)) → (∃ x, x ∈ CR \ e ∧ x ∉ + OL)))))))))))))))))))) := by + classical + intro n p E D C e CR OL parityEvenAlongPath upperHalfplaneEven nextIndexNe nonincidentBall ha + va vb vc vv hind hspan A hcoord2 hrightLast hrightPrev hleftLast hleftFirst hleftNext + hcoordA0 hcoordA2 hcoordB0 hcoordB2 hcoordC0 hcoordC2 hcoordLine lineMapSub + let CL := P3544T1BoundaryCarrier C.left + obtain ⟨r₀, hr₀, hnear₀⟩ := nonincidentBall C.left 0 + let r : Real := min r₀ 1 + have hr : 0 < r := lt_min hr₀ zero_lt_one + have hnear (x : Real × Real) (hx : x ∈ Metric.ball (C.left.vertex 0) r) := + hnear₀ x (Metric.ball_subset_ball (min_le_left r₀ 1) hx) + let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) + let δ : Real := min δ₀ (1/2) + let U : Real × Real := AffineMap.lineMap vb vc (-δ) + let X : Real × Real := AffineMap.lineMap vb va δ + let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t + have hcont : ContinuousOn γ (Set.Icc (0 : Real) 1) := by + exact continuousOn_const.lineMap continuousOn_const continuousOn_id + have hδ₀ : 0 < δ₀ := by dsimp [δ₀]; positivity + have hδ : 0 < δ := lt_min hδ₀ (by norm_num) + have hδlt1 : δ < 1 := lt_of_le_of_lt (min_le_right δ₀ (1/2)) (by norm_num) + have hscale := OldArcParityProof.hscaleAt1324 n p E r₀ hr + have hδa := OldArcParityProof.hδaAt1328 n p E r₀ hδ₀ hscale + have hδc := OldArcParityProof.hδcAt1337 n p E r₀ hδ₀ hscale + have hUdiff := OldArcParityProof.hUdiffAt1346 n p E lineMapSub r₀ + have hXdiff := OldArcParityProof.hXdiffAt1349 n p E lineMapSub r₀ + have hUball := OldArcParityProof.hUballAt1352 n p E r₀ hδ hδc hUdiff + have hXball := OldArcParityProof.hXballAt1356 n p E r₀ hδ hδa hXdiff + have hUhigh : E.ell vb < E.ell U := OldArcParityProof.hUhighAt1360 n p E nextIndexNe r₀ hδ + hUdiff + have hbelow : ∀ i, E.ell (C.left.vertex i) ≤ E.ell vb := OldArcParityProof.hbelowAt1372 n p + E D C + have hUeven : U ∉ OL := by + simpa [OL] using upperHalfplaneEven C.left E.ell (E.ell vb) hbelow U hUhigh + have hU0 := OldArcParityProof.hU0At1382 n p E hind hspan hcoordB0 hcoordC0 hcoordLine r₀ + have hU2 := OldArcParityProof.hU2At1385 n p E hind hspan hcoordB2 hcoordC2 hcoordLine r₀ + have hX0 := OldArcParityProof.hX0At1388 n p E hind hspan hcoordA0 hcoordB0 hcoordLine r₀ + have hX2 := OldArcParityProof.hX2At1391 n p E hind hspan hcoordA2 hcoordB2 hcoordLine r₀ + have hγ0 (t : Real) := OldArcParityProof.hγ0At1394 n p E hind hspan hcoordLine r₀ hU0 hX0 t + have hγ2 (t : Real) := OldArcParityProof.hγ2At1397 n p E hind hspan hcoordLine r₀ hU2 hX2 t + have hleftCenter := OldArcParityProof.hleftCenter n p E D C ha hleftFirst + have hleftOne := OldArcParityProof.hleftOne n p E D C hleftNext + have hleftWrap := OldArcParityProof.hleftWrap n p E D C + have hleftEnd := OldArcParityProof.hleftEnd n p E D C hleftLast + have hballPath (t : Real) (ht : t ∈ Set.Icc (0 : Real) 1) := + OldArcParityProof.hballPathAt1412 n p E D C r₀ hUball hXball hleftCenter t ht + have havoid : ∀ t ∈ Set.Icc (0 : Real) 1, γ t ∉ CL := OldArcParityProof.havoidAt1419 n p E + D C hind hspan hcoord2 hcoordB0 hcoordB2 hcoordC0 hcoordC2 hcoordLine r₀ hnear hδ hγ0 + hγ2 hleftCenter hleftOne hleftWrap hleftEnd hballPath + have hXeven := parityEvenAlongPath C.left γ hcont havoid + (by simpa only [γ, AffineMap.lineMap_apply_zero] using hUeven) + have hXnot := OldArcParityProof.hXnotAt1500 n p E D C r₀ hXeven + have hrightCenter := OldArcParityProof.hrightCenterAt1503 n p E D C ha hrightLast + have hrightIncidentPrev := OldArcParityProof.hrightIncidentPrevAt1506 n p E D C hrightPrev + have hrightNextLast := OldArcParityProof.hrightNextLast n p E D C + have hXcarrier := OldArcParityProof.hXcarrierAt1521 n p E D C r₀ hδ hδlt1 hrightCenter + hrightIncidentPrev hrightNextLast + have hXnotDiag := OldArcParityProof.hXnotDiagAt1529 n p E D ha hind hspan hcoord2 hcoordB0 + hcoordB2 hcoordLine r₀ hδ hX0 hX2 + exact ⟨X, ⟨hXcarrier, hXnotDiag⟩, hXnot⟩ + +end OldArcAssembly + +theorem P3650T1OldArcEven {n : Nat} (p : P3381T1PolygonBoundary n) + (E : P3650T1ExposedCorner p) (D : P3650T1VisibleDiagonal p E) + (C : P3650T1CyclicChildren p D.a D.b) : + Disjoint + (P3544T1BoundaryCarrier C.left \ segment Real (p.vertex D.a) (p.vertex D.b)) + (P3544T1RayParity C.right) ∧ + Disjoint + (P3544T1BoundaryCarrier C.right \ segment Real (p.vertex D.a) (p.vertex D.b)) + (P3544T1RayParity C.left) := by +-- BODY + classical + let e := segment Real (p.vertex D.a) (p.vertex D.b) + let CL := P3544T1BoundaryCarrier C.left + let CR := P3544T1BoundaryCarrier C.right + let CP := P3544T1BoundaryCarrier p + let OL := P3544T1RayParity C.left + let OR := P3544T1RayParity C.right + have hLoff := OldArcParityProof.hLoff n p E D C + have hRoff := OldArcParityProof.hRoff n p E D C + have hLparent := OldArcParityProof.hLparent n p E D C + have hRparent := OldArcParityProof.hRparent n p E D C + have oldArcEvenOnPreconnected {X : Type} [TopologicalSpace X] + (O K S : Set X) (hO : IsOpen O) (hclosure : closure O = O ∪ K) + (hS : IsPreconnected S) (hSK : Disjoint S K) + (x : X) (hx : x ∈ S) (hxO : x ∉ O) := OldArcAssembly.oldArcEvenOnPreconnected (X := X) O K + S hO hclosure hS hSK x hx hxO + have oldArcOddOnPreconnected {X : Type} [TopologicalSpace X] + (O K S : Set X) (hO : IsOpen O) (hclosure : closure O = O ∪ K) + (hS : IsPreconnected S) (hSK : Disjoint S K) + (x : X) (hx : x ∈ S) (hxO : x ∈ O) := OldArcAssembly.oldArcOddOnPreconnected + oldArcEvenOnPreconnected (X := X) O K S hO hclosure hS hSK x hx hxO + have oldArcEvenClosure {X : Type} [TopologicalSpace X] + (O S : Set X) (hO : IsOpen O) (hSO : Disjoint S O) := OldArcAssembly.oldArcEvenClosure (X + := X) O S hO hSO + obtain ⟨leftArcPreconnected, rightArcPreconnected⟩ := + P5667T1CyclicChildrenOldArcsPreconnected p D.a D.b C + have leftFirstIndex : C.il 1 = D.a + 1 := OldArcParityProof.leftFirstIndex n p E D C + have hRopen : IsOpen OR := (P3544T1LocalParity C.right).2.1 + have hLopen : IsOpen OL := (P3544T1LocalParity C.left).2.1 + have hRclosure : closure OR = OR ∪ CR := (P3544T1LocalParity C.right).1 + have hLclosure : closure OL = OL ∪ CL := (P3544T1LocalParity C.left).1 + have propagateRight := OldArcParityProof.propagateRight n p E D C hLoff + oldArcEvenOnPreconnected leftArcPreconnected hRopen hRclosure + have propagateLeft := OldArcParityProof.propagateLeft n p E D C hRoff oldArcEvenOnPreconnected + rightArcPreconnected hLopen hLclosure + have cyclicStep {m : Nat} (i : Fin (m + 3)) := OldArcParityProof.cyclicStep n p E D C (m := m) i + have parityEvenAlongPath {m : Nat} (q : P3381T1PolygonBoundary m) + (γ : Real → Real × Real) (hcont : ContinuousOn γ (Set.Icc (0 : Real) 1)) + (havoid : ∀ t ∈ Set.Icc (0 : Real) 1, + γ t ∉ P3544T1BoundaryCarrier q) + (hstart : γ 0 ∉ P3544T1RayParity q) := OldArcAssembly.parityEvenAlongPath + oldArcEvenOnPreconnected (m := m) q γ hcont havoid hstart + have upperHalfplaneEven {m : Nat} (q : P3381T1PolygonBoundary m) + (ell : (Real × Real) →ₗ[Real] Real) (H : Real) + (hbound : ∀ i, ell (q.vertex i) ≤ H) + (x : Real × Real) (hx : H < ell x) := OldArcAssembly.upperHalfplaneEven (m := m) q ell H + hbound x hx + have triangleHull {m : Nat} (q : P3381T1PolygonBoundary m) + (hm : m = 0) := OldArcParityProof.triangleHull (m := m) q hm + have middleNotSegment {a b c : Real × Real} + (hdet : P3381T1TriangleDeterminant ![a, b, c] ≠ 0) := OldArcAssembly.middleNotSegment (a + := a) (b := b) (c := c) hdet + have prevIndexNe {m : Nat} (i : Fin (m + 3)) := OldArcParityProof.prevIndexNe n p E D C (m := m) i + have nextIndexNe {m : Nat} (i : Fin (m + 3)) := OldArcParityProof.nextIndexNe n p E D C (m := m) i + have strictUpperHalfplaneEven {m : Nat} (q : P3381T1PolygonBoundary m) + (ell : (Real × Real) →ₗ[Real] Real) (H : Real) + (hbound : ∀ i, ell (q.vertex i) < H) + (x : Real × Real) (hx : H < ell x) := OldArcAssembly.strictUpperHalfplaneEven + upperHalfplaneEven (m := m) q ell H hbound x hx + have nonincidentBall {m : Nat} (q : P3381T1PolygonBoundary m) + (i : Fin (m + 3)) := OldArcParityProof.nonincidentBall (m := m) q i + have rightPreviousParent {m : Nat} (q : P3381T1PolygonBoundary m) + (a b : Fin (m + 3)) (K : P3650T1CyclicChildren q a b) + (hrot : K.rotation % (m + 3) = a.val) : + K.ir ⟨K.right_n + 1, by omega⟩ = a - 1 := OldArcAssembly.rightPreviousParent n p E D C (m + := m) q a b K hrot + rcases D.route with hbase | htop + · rcases hbase with ⟨ha, hb, hempty⟩ + have hbaseChild := OldArcParityProof.hbaseChild n p E D C leftFirstIndex cyclicStep ha hb + have hleftIndices := OldArcParityProof.hleftIndices n p E D C ha hbaseChild + have hleftIndexRange := OldArcParityProof.hleftIndexRange n p E D C hleftIndices + have hleftVertexRange := OldArcParityProof.hleftVertexRange n p E D C ha hb hleftIndexRange + have hseedR := OldArcParityProof.hseedRAt680 n p E D C upperHalfplaneEven middleNotSegment + prevIndexNe nextIndexNe ha hb hleftIndexRange hleftVertexRange + have hseedL := OldArcParityProof.hseedLAt728 n p E D C triangleHull prevIndexNe nextIndexNe + ha hb hempty hbaseChild hleftIndexRange hleftVertexRange + exact ⟨propagateRight hseedR, propagateLeft hseedL⟩ + · rcases htop with ⟨ha, hbprev, hbnext, hvertex⟩ + let va := p.vertex (E.b - 1) + let vb := p.vertex E.b + let vc := p.vertex (E.b + 1) + let vv : Fin 3 → Real × Real := ![va, vb, vc] + have hdet := OldArcParityProof.hdet n p E + have hind := OldArcParityProof.hind n p E hdet + have hspan := OldArcParityProof.hspan n p E hind + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ + have hrange : Set.range A = ({va, vb, vc} : Set (Real × Real)) := OldArcParityProof.hrange n + p E D C propagateRight propagateLeft hind hspan + have htriangle : p.vertex D.b ∈ convexHull Real (Set.range A) := by + simpa [hrange, va, vb, vc] using hvertex + have hcoord_nonneg := OldArcParityProof.hcoord_nonneg n p E D hind hspan htriangle + have hcoord_sum := OldArcParityProof.hcoord_sum n p E D hind hspan + have hside0 (x : Real × Real) (hx : x ∈ convexHull Real (Set.range A)) + (h0 : A.coord 0 x = 0) := OldArcParityProof.hside0 n p E hind hspan x hx h0 + have hside2 (x : Real × Real) (hx : x ∈ convexHull Real (Set.range A)) + (h2 : A.coord 2 x = 0) := OldArcParityProof.hside2 n p E hind hspan x hx h2 + have hcoord0 := OldArcParityProof.hcoord0 n p E D ha hbnext hind hspan htriangle + hcoord_nonneg hside0 + have hcoord2 := OldArcParityProof.hcoord2 n p E D ha hbprev hind hspan htriangle + hcoord_nonneg hside2 + have hrot0 := List.getElem?_rotate + (l := List.ofFn (fun i : Fin (n + 3) => i)) (n := C.rotation) (m := 0) (by simp) + rw [C.parent_order] at hrot0 + simp only [List.getElem?_cons_zero] at hrot0 + conv_rhs at hrot0 => + rw [List.getElem?_eq_getElem (Nat.mod_lt _ (by simp))] + rw [List.getElem_ofFn] + have hrotval : C.rotation % (n + 3) = D.a.val := OldArcParityProof.hrotvalAt999 n p E D C hrot0 + have hrightLast := OldArcParityProof.hrightLast n p E D C + have hrightPrev : C.ir ⟨C.right_n+1, by omega⟩ = E.b - 1 := by + rw [rightPreviousParent p D.a D.b C hrotval, ha] + have hrightFirst := OldArcParityProof.hrightFirst n p E D C + have hleftLast := OldArcParityProof.hleftLast n p E D C + have hleftFirst := OldArcParityProof.hleftFirst n p E D C + have hleftNext : C.il 1 = E.b + 1 := by + rw [leftFirstIndex, ha] + have hcoordA0 := OldArcParityProof.hcoordA0 n p E hind hspan + have hcoordA2 := OldArcParityProof.hcoordA2 n p E hind hspan + have hcoordB0 := OldArcParityProof.hcoordB0 n p E hind hspan + have hcoordB2 := OldArcParityProof.hcoordB2 n p E hind hspan + have hcoordC0 := OldArcParityProof.hcoordC0 n p E hind hspan + have hcoordC2 := OldArcParityProof.hcoordC2 n p E hind hspan + have hcoordLine (i : Fin 3) (x y : Real × Real) (t : Real) := OldArcParityProof.hcoordLine n + p E hind hspan i x y t + have lineMapSub (x y : Real × Real) (t : Real) := OldArcParityProof.lineMapSub x y t + have hseedR := OldArcAssembly.hseedRAt3047 n p E D C parityEvenAlongPath upperHalfplaneEven + prevIndexNe nonincidentBall ha hind hspan hcoord0 hrightLast hrightPrev hrightFirst + hleftFirst hleftNext hcoordA0 hcoordA2 hcoordB0 hcoordB2 hcoordC0 hcoordC2 hcoordLine + lineMapSub + have hseedL := OldArcAssembly.hseedLAt3101 n p E D C parityEvenAlongPath upperHalfplaneEven + nextIndexNe nonincidentBall ha hind hspan hcoord2 hrightLast hrightPrev hleftLast + hleftFirst hleftNext hcoordA0 hcoordA2 hcoordB0 hcoordB2 hcoordC0 hcoordC2 hcoordLine + lineMapSub + exact ⟨propagateRight hseedR, propagateLeft hseedL⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1ParitySum.lean b/LeanPool/ApollonianSuperharmonic/P3650T1ParitySum.lean new file mode 100644 index 0000000000..e6c446b654 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3650T1ParitySum.lean @@ -0,0 +1,619 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3650T1CyclicChildren +public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity + +/-! +# P3650T1ParitySum + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + + +-- [TABLET NODE: P3650T1ParitySum] +namespace PolygonParityProof + +private theorem cardPred : + (by + classical + exact + ∀ {k : ℕ}, ∀ (P : Fin k → Prop), ∀ [inst : DecidablePred P], {i : Fin k | P i}.ncard = ∑ + i : Fin k, if P i then (1 : ℕ) else (0 : ℕ) ) := by + classical + intro k P typeclassInstance0 + have hset : ({i : Fin k | P i} : Set (Fin k)) = + ((Finset.univ.filter P : Finset (Fin k)) : Set (Fin k)) := by + ext i + simp + rw [hset, Set.ncard_coe_finset, Finset.card_filter] + +private theorem edges_cons : + (by + classical + exact + let edges {A : Type} (l : List A) : List (A × A) := + List.zipWith Prod.mk l (l.rotate 1) + ∀ {A : Type}, ∀ (a : A), ∀ (l : List A), edges (a :: l) = List.zipWith Prod.mk (a :: l) + (l ++ [a]) ) := by + classical + intro edges A a l + simp [edges] + +private theorem path_split : + (by + classical + exact + ∀ {A : Type}, ∀ (a : A), ∀ (b : A), ∀ (z : A), ∀ (u : List A), ∀ (v : List A), + List.zipWith Prod.mk (a :: (u ++ b :: v)) (u ++ b :: v ++ [z]) = List.zipWith Prod.mk + (a :: u) (u ++ [b]) ++ List.zipWith Prod.mk (b :: v) (v ++ [z]) ) := by + classical + intro A a b z u v + induction u generalizing a with + | nil => simp + | cons c u ih => simpa using congrArg (fun l => (a, c) :: l) (ih c) + +private theorem edges_split : + (by + classical + exact + let edges {A : Type} (l : List A) : List (A × A) := + List.zipWith Prod.mk l (l.rotate 1) + (∀ {A : Type}, ∀ (a : A), ∀ (l : List A), edges (a :: l) = List.zipWith Prod.mk (a :: l) + (l ++ [a])) → ((∀ {A : Type}, ∀ (a : A), ∀ (b : A), ∀ (z : A), ∀ (u : List A), ∀ (v : + List A), List.zipWith Prod.mk (a :: (u ++ b :: v)) ((u ++ b :: v) ++ [z]) = + List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ List.zipWith Prod.mk (b :: v) (v ++ [z])) + → (∀ {A : Type}, ∀ (a : A), ∀ (b : A), ∀ (u : List A), ∀ (v : List A), edges (a :: (u + ++ b :: v)) = List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ List.zipWith Prod.mk (b :: + v) (v ++ [a]))) ) := by + classical + intro edges edges_cons path_split A a b u v + rw [edges_cons, path_split] + +private theorem edges_arc : + (by + classical + exact + let edges {A : Type} (l : List A) : List (A × A) := + List.zipWith Prod.mk l (l.rotate 1) + (∀ {A : Type}, ∀ (a : A), ∀ (b : A), ∀ (u : List A), ∀ (v : List A), edges (a :: (u ++ b + :: v)) = List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ List.zipWith Prod.mk (b :: v) (v + ++ [a])) → (∀ {A : Type}, ∀ (a : A), ∀ (b : A), ∀ (u : List A), edges (a :: (u ++ + [b])) = List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ [(b, a)]) ) := by + classical + intro edges edges_split A a b u + simpa using edges_split a b u [] + +private theorem edges_rotate : + (by + classical + exact + let edges {A : Type} (l : List A) : List (A × A) := + List.zipWith Prod.mk l (l.rotate 1) + ∀ {A : Type}, ∀ (l : List A), ∀ (k : ℕ), edges (l.rotate k) = (edges l).rotate k ) := by + classical + intro edges A l k + simp only [edges] + rw [List.zipWith_rotate_distrib _ _ _ _ (List.length_rotate _ _).symm] + congr 1 + rw [List.rotate_rotate, List.rotate_rotate, Nat.add_comm] + +private theorem edges_ofFn : + (by + classical + exact + let edges {A : Type} (l : List A) : List (A × A) := + List.zipWith Prod.mk l (l.rotate 1) + ∀ {k : ℕ}, ∀ {A : Type}, ∀ (f : Fin (k + (3 : ℕ)) → A), edges (List.ofFn f) = List.ofFn + fun (i : Fin (k + (3 : ℕ))) => (f i, f (i + (1 : Fin (k + (3 : ℕ))))) ) := by + classical + intro edges k A f + apply List.ext_getElem + · simp [edges] + · intro i hi₁ hi₂ + have hi : i < k + 3 := by + have htmp := hi₁ + simp [edges] at htmp + omega + have hzip : i < (List.zipWith Prod.mk (List.ofFn f) ((List.ofFn f).rotate 1)).length := by + simp only [List.length_zipWith, List.length_ofFn, List.length_rotate] + omega + have hrot : i < ((List.ofFn f).rotate 1).length := by + simp only [List.length_rotate, List.length_ofFn] + exact hi + change (List.zipWith Prod.mk (List.ofFn f) ((List.ofFn f).rotate 1))[i]'hzip = + (List.ofFn fun i : Fin (k + 3) => (f i, f (i + 1)))[i]'hi₂ + rw [List.getElem_zipWith (h := hzip)] + simp only [List.getElem_ofFn] + rw [List.getElem_rotate (List.ofFn f) 1 i hrot] + simp only [List.getElem_ofFn] + congr 1 + apply congrArg f + apply Fin.ext + simp only [Fin.val_add, Fin.val_one, List.length_ofFn] + +private theorem hsum_ofFn : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let hit (x d : Real × Real) (i j : Fin (n + 3)) : Prop := + ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex i) (p.vertex j) + let weight (x d : Real × Real) (i j : Fin (n + 3)) : Nat := + if hit x d i j then 1 else 0 + let edges {A : Type} (l : List A) : List (A × A) := + List.zipWith Prod.mk l (l.rotate 1) + (∀ {k : Nat}, ∀ {A : Type}, ∀ (f : Fin (k + 3) → A), edges (List.ofFn f) = List.ofFn (fun + i : Fin (k + 3) => (f i, f (i + 1)))) → ( + let edgeWeight (x d : Real × Real) (L : List (Fin (n + 3))) : Nat := + ((edges L).map fun e => weight x d e.1 e.2).sum + ∀ {k : ℕ}, ∀ (f : Fin (k + (3 : ℕ)) → Fin (n + (3 : ℕ))), ∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), ∑ + i : Fin (k + (3 : ℕ)), weight x d (f i) (f (i + (1 : Fin (k + (3 : ℕ))))) = + edgeWeight x d (List.ofFn f)) ) := by + classical + intro n p hit weight edges edges_ofFn edgeWeight k f x d + rw [← List.sum_ofFn] + simp only [edgeWeight, edges_ofFn, List.map_ofFn, List.sum_ofFn] + simp only [Function.comp_apply] + +private theorem hweight_symm : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let hit (x d : Real × Real) (i j : Fin (n + 3)) : Prop := + ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex i) (p.vertex j) + let weight (x d : Real × Real) (i j : Fin (n + 3)) : Nat := + if hit x d i j then 1 else 0 + ∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), ∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), + weight x d i j = weight x d j i ) := by + classical + intro n p hit weight x d i j + simp [weight, hit, segment_symm] + +private theorem hleftCount : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let hit (x d : Real × Real) (i j : Fin (n + 3)) : Prop := + ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex i) (p.vertex j) + let weight (x d : Real × Real) (i j : Fin (n + 3)) : Nat := + if hit x d i j then 1 else 0 + (∀ {k : Nat}, ∀ (P : Fin k → Prop), ∀ [DecidablePred P], Set.ncard {i : Fin k | P i} = ∑ + i : Fin k, if P i then 1 else 0) → ( + let edges {A : Type} (l : List A) : List (A × A) := + List.zipWith Prod.mk l (l.rotate 1) + let edgeWeight (x d : Real × Real) (L : List (Fin (n + 3))) : Nat := + ((edges L).map fun e => weight x d e.1 e.2).sum + (∀ {k : Nat}, ∀ (f : Fin (k + 3) → Fin (n + 3)), ∀ (x : Real × Real), ∀ (d : Real × + Real), (∑ i : Fin (k + 3), weight x d (f i) (f (i + 1))) = edgeWeight x d (List.ofFn + f)) → (∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), {i : Fin (C.left_n + (3 : ℕ)) | ∃ (t : ℝ), (0 : + ℝ) < t ∧ x + t • d ∈ segment ℝ (C.left.vertex i) (C.left.vertex (i + (1 : Fin + (C.left_n + (3 : ℕ)))))}.ncard = edgeWeight x d (a :: (C.u ++ [b])))) ) := by + classical + intro n p a b C hit weight cardPred edges edgeWeight hsum_ofFn x d + rw [cardPred] + have h := hsum_ofFn C.il x d + rw [C.left_order] at h + calc + (∑ i : Fin (C.left_n + 3), + if ∃ t : Real, 0 < t ∧ x + t • d ∈ + segment Real (C.left.vertex i) (C.left.vertex (i + 1)) then 1 else 0) = + ∑ i : Fin (C.left_n + 3), weight x d (C.il i) (C.il (i + 1)) := by + apply Finset.sum_congr rfl + intro i hi + simp [weight, hit, C.left_vertex] + _ = edgeWeight x d (a :: (C.u ++ [b])) := h + +private theorem hrightCount : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let hit (x d : Real × Real) (i j : Fin (n + 3)) : Prop := + ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex i) (p.vertex j) + let weight (x d : Real × Real) (i j : Fin (n + 3)) : Nat := + if hit x d i j then 1 else 0 + (∀ {k : Nat}, ∀ (P : Fin k → Prop), ∀ [DecidablePred P], Set.ncard {i : Fin k | P i} = ∑ + i : Fin k, if P i then 1 else 0) → ( + let edges {A : Type} (l : List A) : List (A × A) := + List.zipWith Prod.mk l (l.rotate 1) + let edgeWeight (x d : Real × Real) (L : List (Fin (n + 3))) : Nat := + ((edges L).map fun e => weight x d e.1 e.2).sum + (∀ {k : Nat}, ∀ (f : Fin (k + 3) → Fin (n + 3)), ∀ (x : Real × Real), ∀ (d : Real × + Real), (∑ i : Fin (k + 3), weight x d (f i) (f (i + 1))) = edgeWeight x d (List.ofFn + f)) → (∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), {i : Fin (C.right_n + (3 : ℕ)) | ∃ (t : ℝ), (0 : + ℝ) < t ∧ x + t • d ∈ segment ℝ (C.right.vertex i) (C.right.vertex (i + (1 : Fin + (C.right_n + (3 : ℕ)))))}.ncard = edgeWeight x d (b :: (C.v ++ [a])))) ) := by + classical + intro n p a b C hit weight cardPred edges edgeWeight hsum_ofFn x d + rw [cardPred] + have h := hsum_ofFn C.ir x d + rw [C.right_order] at h + calc + (∑ i : Fin (C.right_n + 3), + if ∃ t : Real, 0 < t ∧ x + t • d ∈ + segment Real (C.right.vertex i) (C.right.vertex (i + 1)) then 1 else 0) = + ∑ i : Fin (C.right_n + 3), weight x d (C.ir i) (C.ir (i + 1)) := by + apply Finset.sum_congr rfl + intro i hi + simp [weight, hit, C.right_vertex] + _ = edgeWeight x d (b :: (C.v ++ [a])) := h + +private theorem hparentCount : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), + let hit (x d : Real × Real) (i j : Fin (n + 3)) : Prop := + ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex i) (p.vertex j) + let weight (x d : Real × Real) (i j : Fin (n + 3)) : Nat := + if hit x d i j then 1 else 0 + (∀ {k : Nat}, ∀ (P : Fin k → Prop), ∀ [DecidablePred P], Set.ncard {i : Fin k | P i} = ∑ + i : Fin k, if P i then 1 else 0) → ( + let edges {A : Type} (l : List A) : List (A × A) := + List.zipWith Prod.mk l (l.rotate 1) + let edgeWeight (x d : Real × Real) (L : List (Fin (n + 3))) : Nat := + ((edges L).map fun e => weight x d e.1 e.2).sum + (∀ {k : Nat}, ∀ (f : Fin (k + 3) → Fin (n + 3)), ∀ (x : Real × Real), ∀ (d : Real × + Real), (∑ i : Fin (k + 3), weight x d (f i) (f (i + 1))) = edgeWeight x d (List.ofFn + f)) → (∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), {i : Fin (n + (3 : ℕ)) | ∃ (t : ℝ), (0 : ℝ) < t + ∧ x + t • d ∈ segment ℝ (p.vertex i) (p.vertex (i + (1 : Fin (n + (3 : ℕ)))))}.ncard + = edgeWeight x d (List.ofFn fun (i : Fin (n + (3 : ℕ))) => i))) ) := by + classical + intro n p hit weight cardPred edges edgeWeight hsum_ofFn x d + rw [cardPred] + have h := hsum_ofFn (fun i : Fin (n + 3) => i) x d + calc + (∑ i : Fin (n + 3), + if ∃ t : Real, 0 < t ∧ x + t • d ∈ + segment Real (p.vertex i) (p.vertex (i + 1)) then 1 else 0) = + ∑ i : Fin (n + 3), weight x d i (i + 1) := by + apply Finset.sum_congr rfl + intro i hi + rfl + _ = edgeWeight x d (List.ofFn fun i : Fin (n + 3) => i) := h + +private theorem hparentOrder : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let hit (x d : Real × Real) (i j : Fin (n + 3)) : Prop := + ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex i) (p.vertex j) + let weight (x d : Real × Real) (i j : Fin (n + 3)) : Nat := + if hit x d i j then 1 else 0 + let edges {A : Type} (l : List A) : List (A × A) := + List.zipWith Prod.mk l (l.rotate 1) + (∀ {A : Type}, ∀ (l : List A), ∀ (k : Nat), edges (l.rotate k) = (edges l).rotate k) → ( + let edgeWeight (x d : Real × Real) (L : List (Fin (n + 3))) : Nat := + ((edges L).map fun e => weight x d e.1 e.2).sum + ∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), edgeWeight x d (List.ofFn fun (i : Fin (n + (3 : ℕ))) => i) + = edgeWeight x d (a :: (C.u ++ b :: C.v))) ) := by + classical + intro n p a b C hit weight edges edges_rotate edgeWeight x d + calc + edgeWeight x d (List.ofFn (fun i : Fin (n + 3) => i)) = + edgeWeight x d ((List.ofFn (fun i : Fin (n + 3) => i)).rotate C.rotation) := by + unfold edgeWeight + rw [edges_rotate, List.map_rotate] + exact (List.Perm.sum_eq (List.rotate_perm _ _)).symm + _ = edgeWeight x d (a :: (C.u ++ b :: C.v)) := by + rw [C.parent_order] + +private theorem hledger : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let hit (x d : Real × Real) (i j : Fin (n + 3)) : Prop := + ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex i) (p.vertex j) + let weight (x d : Real × Real) (i j : Fin (n + 3)) : Nat := + if hit x d i j then 1 else 0 + let edges {A : Type} (l : List A) : List (A × A) := + List.zipWith Prod.mk l (l.rotate 1) + (∀ {A : Type}, ∀ (a : A), ∀ (b : A), ∀ (u : List A), ∀ (v : List A), edges (a :: (u ++ b + :: v)) = List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ List.zipWith Prod.mk (b :: v) (v + ++ [a])) → ((∀ {A : Type}, ∀ (a : A), ∀ (b : A), ∀ (u : List A), edges (a :: (u ++ + [b])) = List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ [(b, a)]) → ( + let edgeWeight (x d : Real × Real) (L : List (Fin (n + 3))) : Nat := + ((edges L).map fun e => weight x d e.1 e.2).sum + (∀ (x : Real × Real), ∀ (d : Real × Real), ∀ (i : Fin (n + 3)), ∀ (j : Fin (n + 3)), + weight x d i j = weight x d j i) → (∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), edgeWeight x d (a + :: (C.u ++ [b])) + edgeWeight x d (b :: (C.v ++ [a])) = edgeWeight x d (a :: (C.u ++ + b :: C.v)) + (2 : ℕ) * weight x d a b))) ) := by + classical + intro n p a b C hit weight edges edges_split edges_arc edgeWeight hweight_symm x d + simp only [edgeWeight, edges_arc, edges_split, List.map_append, List.sum_append, + List.map_singleton, List.sum_singleton] + rw [hweight_symm x d b a] + omega + +private theorem hcount : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), + let hit (x d : Real × Real) (i j : Fin (n + 3)) : Prop := + ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex i) (p.vertex j) + let weight (x d : Real × Real) (i j : Fin (n + 3)) : Nat := + if hit x d i j then 1 else 0 + let edges {A : Type} (l : List A) : List (A × A) := + List.zipWith Prod.mk l (l.rotate 1) + let edgeWeight (x d : Real × Real) (L : List (Fin (n + 3))) : Nat := + ((edges L).map fun e => weight x d e.1 e.2).sum + (∀ (x : Real × Real), ∀ (d : Real × Real), Set.ncard {i : Fin (C.left_n + 3) | ∃ t : + Real, 0 < t ∧ x + t • d ∈ segment Real (C.left.vertex i) (C.left.vertex (i + 1))} = + edgeWeight x d (a :: (C.u ++ [b]))) → ((∀ (x : Real × Real), ∀ (d : Real × Real), + Set.ncard {i : Fin (C.right_n + 3) | ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real + (C.right.vertex i) (C.right.vertex (i + 1))} = edgeWeight x d (b :: (C.v ++ [a]))) → + ((∀ (x : Real × Real), ∀ (d : Real × Real), Set.ncard {i : Fin (n + 3) | ∃ t : Real, + 0 < t ∧ x + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1))} = edgeWeight x d + (List.ofFn (fun i : Fin (n + 3) => i))) → ((∀ (x : Real × Real), ∀ (d : Real × Real), + edgeWeight x d (List.ofFn (fun i : Fin (n + 3) => i)) = edgeWeight x d (a :: (C.u ++ + b :: C.v))) → ((∀ (x : Real × Real), ∀ (d : Real × Real), edgeWeight x d (a :: (C.u + ++ [b])) + edgeWeight x d (b :: (C.v ++ [a])) = edgeWeight x d (a :: (C.u ++ b :: + C.v)) + 2 * weight x d a b) → (∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), {i : Fin (C.left_n + (3 + : ℕ)) | ∃ (t : ℝ), (0 : ℝ) < t ∧ x + t • d ∈ segment ℝ (C.left.vertex i) + (C.left.vertex (i + (1 : Fin (C.left_n + (3 : ℕ)))))}.ncard + {i : Fin (C.right_n + + (3 : ℕ)) | ∃ (t : ℝ), (0 : ℝ) < t ∧ x + t • d ∈ segment ℝ (C.right.vertex i) + (C.right.vertex (i + (1 : Fin (C.right_n + (3 : ℕ)))))}.ncard = {i : Fin (n + (3 : + ℕ)) | ∃ (t : ℝ), (0 : ℝ) < t ∧ x + t • d ∈ segment ℝ (p.vertex i) (p.vertex (i + (1 : + Fin (n + (3 : ℕ)))))}.ncard + (2 : ℕ) * if ∃ (t : ℝ), (0 : ℝ) < t ∧ x + t • d ∈ + segment ℝ (p.vertex a) (p.vertex b) then (1 : ℕ) else (0 : ℕ)))))) ) := by + classical + intro n p a b C hit weight edges edgeWeight hleftCount hrightCount hparentCount hparentOrder + hledger x d + rw [hleftCount, hrightCount, hparentCount, hparentOrder] + simpa [weight, hit, edgeWeight] using hledger x d + +private theorem hcommon : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), ∀ x ∉ P3544T1BoundaryCarrier C.left, x + ∉ P3544T1BoundaryCarrier C.right → ∃ (d : ℝ × ℝ), (∀ (i : Fin (n + (3 : ℕ))), d.1 * + (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ (0 : ℝ)) ∧ (∀ (i : Fin (n + (3 : + ℕ))), d.1 * (p.vertex (i + (1 : Fin (n + (3 : ℕ)))) - p.vertex i).2 - d.2 * (p.vertex + (i + (1 : Fin (n + (3 : ℕ)))) - p.vertex i).1 ≠ (0 : ℝ)) ∧ (∀ (i : Fin (C.left_n + (3 + : ℕ))), d.1 * (C.left.vertex i - x).2 - d.2 * (C.left.vertex i - x).1 ≠ (0 : ℝ)) ∧ (∀ + (i : Fin (C.left_n + (3 : ℕ))), d.1 * (C.left.vertex (i + (1 : Fin (C.left_n + (3 : + ℕ)))) - C.left.vertex i).2 - d.2 * (C.left.vertex (i + (1 : Fin (C.left_n + (3 : + ℕ)))) - C.left.vertex i).1 ≠ (0 : ℝ)) ∧ (∀ (i : Fin (C.right_n + (3 : ℕ))), d.1 * + (C.right.vertex i - x).2 - d.2 * (C.right.vertex i - x).1 ≠ (0 : ℝ)) ∧ ∀ (i : Fin + (C.right_n + (3 : ℕ))), d.1 * (C.right.vertex (i + (1 : Fin (C.right_n + (3 : ℕ)))) - + C.right.vertex i).2 - d.2 * (C.right.vertex (i + (1 : Fin (C.right_n + (3 : ℕ)))) - + C.right.vertex i).1 ≠ (0 : ℝ) ) := by + classical + intro n p a b C x hxL hxR + have hxParent : x ∉ P3544T1BoundaryCarrier p := by + have hxChildren : x ∉ + (P3544T1BoundaryCarrier C.left ∪ P3544T1BoundaryCarrier C.right) := by + intro h + rcases h with h | h + · exact hxL h + · exact hxR h + have hxBoth : x ∉ (P3544T1BoundaryCarrier p ∪ + segment Real (p.vertex a) (p.vertex b)) := by + rw [← C.carrier_union] + exact hxChildren + exact fun hx => hxBoth (Or.inl hx) + have finSucc_ne {m : Nat} (i : Fin (m + 3)) : i + 1 ≠ i := by + intro he + have hv := congrArg Fin.val he + simp only [Fin.val_add, Fin.val_one] at hv + by_cases hs : i.val + 1 < m + 3 + · rw [Nat.mod_eq_of_lt hs] at hv + omega + · have hi' : i.val + 1 = m + 3 := by omega + rw [hi'] at hv + simp at hv + omega + let Idx := (Fin (n + 3) × Bool) ⊕ + ((Fin (C.left_n + 3) × Bool) ⊕ (Fin (C.right_n + 3) × Bool)) + let vec : Idx → Real × Real := fun j => + match j with + | Sum.inl (i, isVertex) => + if isVertex then p.vertex i - x else p.vertex (i + 1) - p.vertex i + | Sum.inr (Sum.inl (i, isVertex)) => + if isVertex then C.left.vertex i - x else + C.left.vertex (i + 1) - C.left.vertex i + | Sum.inr (Sum.inr (i, isVertex)) => + if isVertex then C.right.vertex i - x else + C.right.vertex (i + 1) - C.right.vertex i + have hvec : ∀ j : Idx, vec j ≠ 0 := by + intro j + rcases j with ⟨i, isVertex⟩ | j + · by_cases htag : isVertex + · simp? [vec, htag] + intro hzero + have hv : p.vertex i ∈ P3544T1BoundaryCarrier p := by + exact Set.mem_iUnion.mpr ⟨i, left_mem_segment Real _ _⟩ + exact hxParent ((sub_eq_zero.mp hzero) ▸ hv) + · simp? [vec, htag] + intro hzero + apply finSucc_ne i + apply p.injective + exact sub_eq_zero.mp hzero + · rcases j with ⟨i, isVertex⟩ | ⟨i, isVertex⟩ + · by_cases htag : isVertex + · simp? [vec, htag] + intro hzero + have hv : C.left.vertex i ∈ P3544T1BoundaryCarrier C.left := by + exact Set.mem_iUnion.mpr ⟨i, left_mem_segment Real _ _⟩ + exact hxL ((sub_eq_zero.mp hzero) ▸ hv) + · simp? [vec, htag] + intro hzero + apply finSucc_ne i + apply C.left.injective + exact sub_eq_zero.mp hzero + · by_cases htag : isVertex + · simp? [vec, htag] + intro hzero + have hv : C.right.vertex i ∈ P3544T1BoundaryCarrier C.right := by + exact Set.mem_iUnion.mpr ⟨i, left_mem_segment Real _ _⟩ + exact hxR ((sub_eq_zero.mp hzero) ▸ hv) + · simp? [vec, htag] + intro hzero + apply finSucc_ne i + apply C.right.injective + exact sub_eq_zero.mp hzero + let bad : Finset Real := Finset.univ.image fun j : Idx => (vec j).2 / (vec j).1 + have hcard : (bad.card : ENat) < ENat.card Real := by + rw [ENat.card_eq_top_of_infinite] + exact ENat.natCast_lt_top _ + obtain ⟨q, hq⟩ := Finset.exists_notMem_of_card_lt_enatCard hcard + let d : Real × Real := (1, q) + have hgeneric : ∀ j : Idx, + d.1 * (vec j).2 - d.2 * (vec j).1 ≠ 0 := by + intro j + have hn := hvec j + have hnot : q ≠ (vec j).2 / (vec j).1 := by + intro he + apply hq + apply Finset.mem_image.mpr + exact ⟨j, Finset.mem_univ _, by simp [he]⟩ + intro hz + have hz' : (vec j).2 - q * (vec j).1 = 0 := by simpa [d] using hz + by_cases hzero : (vec j).1 = 0 + · have hsecond : (vec j).2 = 0 := by simpa [hzero] using hz' + exact hn (Prod.ext hzero hsecond) + · apply hnot + apply (eq_div_iff hzero).2 + nlinarith [hz'] + refine ⟨d, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro i + exact hgeneric (Sum.inl (i, true)) + · intro i + exact hgeneric (Sum.inl (i, false)) + · intro i + exact hgeneric (Sum.inr (Sum.inl (i, true))) + · intro i + exact hgeneric (Sum.inr (Sum.inl (i, false))) + · intro i + exact hgeneric (Sum.inr (Sum.inr (i, true))) + · intro i + exact hgeneric (Sum.inr (Sum.inr (i, false))) + +private theorem hxParentAt401 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + + 3)), ∀ (C : P3650T1CyclicChildren p a b), ∀ (x : ℝ × ℝ), (x ∉ + P3544T1BoundaryCarrier C.left) → ((x ∉ P3544T1BoundaryCarrier C.right) → (x ∉ + P3544T1BoundaryCarrier p)) ) := by + classical + intro n p a b C x hxL hxR + have hxChildren : x ∉ + (P3544T1BoundaryCarrier C.left ∪ P3544T1BoundaryCarrier C.right) := by + intro h + rcases h with h | h + · exact hxL h + · exact hxR h + have hxBoth : x ∉ (P3544T1BoundaryCarrier p ∪ + segment Real (p.vertex a) (p.vertex b)) := by + rw [← C.carrier_union] + exact hxChildren + exact fun hx => hxBoth (Or.inl hx) + +end PolygonParityProof + +theorem P3650T1ParitySum {n : Nat} (p : P3381T1PolygonBoundary n) + (a b : Fin (n + 3)) (C : P3650T1CyclicChildren p a b) : + (by + classical + exact + (∀ x d : Real × Real, + Set.ncard {i : Fin (C.left_n + 3) | ∃ t : Real, 0 < t ∧ + x + t • d ∈ segment Real (C.left.vertex i) (C.left.vertex (i + 1))} + + Set.ncard {i : Fin (C.right_n + 3) | ∃ t : Real, 0 < t ∧ + x + t • d ∈ segment Real (C.right.vertex i) (C.right.vertex (i + 1))} = + Set.ncard {i : Fin (n + 3) | ∃ t : Real, 0 < t ∧ + x + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1))} + + 2 * (if ∃ t : Real, 0 < t ∧ + x + t • d ∈ segment Real (p.vertex a) (p.vertex b) then 1 else 0)) ∧ + (∀ x, x ∉ P3544T1BoundaryCarrier C.left → + x ∉ P3544T1BoundaryCarrier C.right → + (x ∈ P3544T1RayParity p ↔ + (x ∈ P3544T1RayParity C.left ∧ x ∉ P3544T1RayParity C.right) ∨ + (x ∉ P3544T1RayParity C.left ∧ x ∈ P3544T1RayParity C.right)))) := by +-- BODY + classical + let hit (x d : Real × Real) (i j : Fin (n + 3)) : Prop := + ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex i) (p.vertex j) + let weight (x d : Real × Real) (i j : Fin (n + 3)) : Nat := + if hit x d i j then 1 else 0 + have cardPred {k : Nat} (P : Fin k → Prop) [DecidablePred P] := PolygonParityProof.cardPred (k + := k) P + let edges {A : Type} (l : List A) : List (A × A) := + List.zipWith Prod.mk l (l.rotate 1) + have edges_cons {A : Type} (a : A) (l : List A) := PolygonParityProof.edges_cons (A := A) a l + have path_split {A : Type} (a b z : A) (u v : List A) := PolygonParityProof.path_split (A := A) + a b z u v + have edges_split {A : Type} (a b : A) (u v : List A) := PolygonParityProof.edges_split + edges_cons path_split (A := A) a b u v + have edges_arc {A : Type} (a b : A) (u : List A) := PolygonParityProof.edges_arc edges_split (A + := A) a b u + have edges_rotate {A : Type} (l : List A) (k : Nat) := PolygonParityProof.edges_rotate (A := A) + l k + have edges_ofFn {k : Nat} {A : Type} (f : Fin (k + 3) → A) := PolygonParityProof.edges_ofFn (k + := k) (A := A) f + let edgeWeight (x d : Real × Real) (L : List (Fin (n + 3))) : Nat := + ((edges L).map fun e => weight x d e.1 e.2).sum + have hsum_ofFn {k : Nat} (f : Fin (k + 3) → Fin (n + 3)) (x d : Real × Real) := + PolygonParityProof.hsum_ofFn n p edges_ofFn (k := k) f x d + have hweight_symm (x d : Real × Real) (i j : Fin (n + 3)) := PolygonParityProof.hweight_symm n + p x d i j + have hleftCount (x d : Real × Real) := PolygonParityProof.hleftCount n p a b C cardPred + hsum_ofFn x d + have hrightCount (x d : Real × Real) := PolygonParityProof.hrightCount n p a b C cardPred + hsum_ofFn x d + have hparentCount (x d : Real × Real) := PolygonParityProof.hparentCount n p cardPred hsum_ofFn + x d + have hparentOrder (x d : Real × Real) := PolygonParityProof.hparentOrder n p a b C edges_rotate + x d + have hledger (x d : Real × Real) := PolygonParityProof.hledger n p a b C edges_split edges_arc + hweight_symm x d + have hcount (x d : Real × Real) := PolygonParityProof.hcount n p a b C hleftCount hrightCount + hparentCount hparentOrder hledger x d + have hcommon (x : Real × Real) + (hxL : x ∉ P3544T1BoundaryCarrier C.left) + (hxR : x ∉ P3544T1BoundaryCarrier C.right) := PolygonParityProof.hcommon n p a b C x hxL hxR + constructor + · exact hcount + · intro x hxL hxR + obtain ⟨d, hpv, hpe, hlv, hle, hrv, hre⟩ := hcommon x hxL hxR + have hxParent := PolygonParityProof.hxParentAt401 n p a b C x hxL hxR + have hpar := (P3544T1LocalParity p).2.2.2.2.2.2.1 x d hxParent hpv hpe + have hleft := (P3544T1LocalParity C.left).2.2.2.2.2.2.1 x d hxL hlv hle + have hright := (P3544T1LocalParity C.right).2.2.2.2.2.2.1 x d hxR hrv hre + have hsum := hcount x d + by_cases hdiag : ∃ t : Real, 0 < t ∧ + x + t • d ∈ segment Real (p.vertex a) (p.vertex b) + · simp [hdiag] at hsum + rw [hpar, hleft, hright] + omega + · simp [hdiag] at hsum + rw [hpar, hleft, hright] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean b/LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean new file mode 100644 index 0000000000..d47d97b2fd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean @@ -0,0 +1,381 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.LinearAlgebra.AffineSpace.FiniteDimensional + +public import LeanPool.ApollonianSuperharmonic.P3650T1ExposedCorner +public import Mathlib.Analysis.Normed.Affine.AddTorsorBases +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Analysis.Convex.Topology + +-- [TABLET NODE: P3650T1TriangleEntry] + +/-! +# P3650T1TriangleEntry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TriangleEntryGeometry + +private theorem hbasis : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∃ A : + AffineBasis (Fin 3) Real (Real × Real), (∀ i, A i = ![p.vertex (E.b - 1), p.vertex + E.b, p.vertex (E.b + 1)] i) ∧ E.height = A.coord 1 ) := by + classical + intro n p E + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + have hdet : (b.1 - a.1) * (c.2 - a.2) - + (c.1 - a.1) * (b.2 - a.2) ≠ 0 := by + simpa [P3381T1TriangleDeterminant, a, b, c] using E.nondegenerate + have hind : AffineIndependent Real v := by + apply (affineIndependent_iff_of_fintype Real v).mpr + intro z hz hsum i + rw [Finset.weightedVSub_eq_linear_combination Finset.univ hz] at hsum + have hz' : z 0 + z 1 + z 2 = 0 := by + simpa [Fin.sum_univ_succ, ← add_assoc] using hz + have hx : z 0 * a.1 + z 1 * b.1 + z 2 * c.1 = 0 := by + simpa [Fin.sum_univ_succ, v, ← add_assoc] using congrArg Prod.fst hsum + have hy : z 0 * a.2 + z 1 * b.2 + z 2 * c.2 = 0 := by + simpa [Fin.sum_univ_succ, v, ← add_assoc] using congrArg Prod.snd hsum + have hx' : z 1 * (b.1 - a.1) + z 2 * (c.1 - a.1) = 0 := by + linear_combination hx - a.1 * hz' + have hy' : z 1 * (b.2 - a.2) + z 2 * (c.2 - a.2) = 0 := by + linear_combination hy - a.2 * hz' + have hz1 : z 1 = 0 := by + apply (mul_eq_zero.mp (show z 1 * ((b.1 - a.1) * (c.2 - a.2) - + (c.1 - a.1) * (b.2 - a.2)) = 0 by + linear_combination (c.2 - a.2) * hx' - (c.1 - a.1) * hy')).resolve_right hdet + have hz2 : z 2 = 0 := by + apply (mul_eq_zero.mp (show z 2 * ((b.1 - a.1) * (c.2 - a.2) - + (c.1 - a.1) * (b.2 - a.2)) = 0 by + linear_combination (b.1 - a.1) * hy' - (b.2 - a.2) * hx')).resolve_right hdet + fin_cases i <;> simp_all + have hspan : affineSpan Real (Set.range v) = ⊤ := by + apply hind.affineSpan_eq_top_iff_card_eq_finrank_add_one.mpr + simp [Module.finrank_prod] + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + refine ⟨A, fun _ => rfl, ?_⟩ + apply AffineMap.ext_on A.tot + rintro x ⟨i, rfl⟩ + fin_cases i <;> simp only [AffineBasis.coord_apply] + · exact E.height_prev + · exact E.height_top + · exact E.height_next + +private theorem hrange : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (A : + AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (∀ (i : Fin (3 : ℕ)), (A : Fin (3 : ℕ) → ℝ × ℝ) + i = ![p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, p.vertex (E.b + (1 : + Fin (n + (3 : ℕ))))] i) → (Set.range A = ({p.vertex (E.b - 1), p.vertex E.b, + p.vertex (E.b + 1)} : Set (Real × Real))) ) := by + classical + intro n p E A hA + rw [show (A : Fin 3 → Real × Real) = + ![p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)] from funext hA] + ext x + simp + tauto + +private theorem hmem : + (by + classical + exact + ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), + let D := convexHull Real (Set.range A) + ∀ x, x ∈ D ↔ ∀ i, 0 ≤ A.coord i x ) := by + classical + intro A D x + exact Set.ext_iff.mp A.convexHull_eq_nonneg_coord x + +private theorem hint : + (by + classical + exact + ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), + let D := convexHull Real (Set.range A) + ∀ x, x ∈ interior D ↔ ∀ i, 0 < A.coord i x ) := by + classical + intro A D x + exact Set.ext_iff.mp A.interior_convexHull x + +private theorem hpos : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (w : + ℝ × ℝ), ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (E.height = A.coord (1 : Fin (3 + : ℕ))) → ( + let D := convexHull Real (Set.range A) + (w ∈ interior D) → ((∀ x, x ∈ interior D ↔ ∀ i, 0 < A.coord i x) → (0 < E.height w))) ) + := by + classical + intro n p E w A hheight D hwD hint + rw [hheight] + exact (hint w).mp hwD 1 + +private theorem hface0 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (A : + AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (A 1 = p.vertex E.b) → ((A 2 = p.vertex (E.b + + 1)) → ( + let D := convexHull Real (Set.range A) + (∀ x, x ∈ D ↔ ∀ i, 0 ≤ A.coord i x) → (∀ x, x ∈ D → A.coord 0 x = 0 → x ∈ segment Real + (p.vertex E.b) (p.vertex (E.b + 1))))) ) := by + classical + intro n p E A hA1 hA2 D hmem x hx hx0 + have hxnonneg := (hmem x).mp hx + have hxsum : A.coord 0 x + A.coord 1 x + A.coord 2 x = 1 := by + simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one x + rw [← hA1, ← hA2, segment_eq_image_lineMap] + refine ⟨A.coord 2 x, ⟨hxnonneg 2, by linarith [hxnonneg 1]⟩, ?_⟩ + apply A.ext_elem + intro i + rw [(A.coord i).apply_lineMap] + fin_cases i <;> simp [AffineMap.lineMap_apply_ring, Fin.ext_iff] <;> + linarith only [hxsum, hx0] + +private theorem hface2 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (A : + AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (A 0 = p.vertex (E.b - 1)) → ((A 1 = p.vertex + E.b) → ( + let D := convexHull Real (Set.range A) + (∀ x, x ∈ D ↔ ∀ i, 0 ≤ A.coord i x) → (∀ x, x ∈ D → A.coord 2 x = 0 → x ∈ segment Real + (p.vertex (E.b - 1)) (p.vertex E.b)))) ) := by + classical + intro n p E A hA0 hA1 D hmem x hx hx2 + have hxnonneg := (hmem x).mp hx + have hxsum : A.coord 0 x + A.coord 1 x + A.coord 2 x = 1 := by + simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one x + rw [← hA0, ← hA1, segment_eq_image_lineMap] + refine ⟨A.coord 1 x, ⟨hxnonneg 1, by linarith [hxnonneg 0]⟩, ?_⟩ + apply A.ext_elem + intro i + rw [(A.coord i).apply_lineMap] + fin_cases i <;> simp [AffineMap.lineMap_apply_ring, Fin.ext_iff] <;> + linarith only [hxsum, hx2] + +private theorem hside : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (j : + Fin (n + (3 : ℕ))), (j ≠ E.b - (1 : Fin (n + (3 : ℕ)))) → ((j ≠ E.b) → (∀ x, x ∈ + segment Real (p.vertex j) (p.vertex (j + 1)) → x ≠ p.vertex j → x ≠ p.vertex (j + 1) + → x ∉ segment Real (p.vertex (E.b - 1)) (p.vertex E.b) ∧ x ∉ segment Real (p.vertex + E.b) (p.vertex (E.b + 1)))) ) := by + classical + intro n p E j hjprev hjtop x hx hxj hxj1 + constructor + · intro hxl + have hxl' : x ∈ segment Real (p.vertex (E.b - 1)) + (p.vertex (E.b - 1 + 1)) := by simpa only [sub_add_cancel] using hxl + have hh : x ∈ segment Real (p.vertex j) (p.vertex (j + 1)) ∩ + segment Real (p.vertex (E.b - 1)) (p.vertex (E.b - 1 + 1)) := ⟨hx, hxl'⟩ + rw [p.edge_intersection j (E.b - 1) hjprev] at hh + exact hh.1.elim hxj hxj1 + · intro hxl + have hh : x ∈ segment Real (p.vertex j) (p.vertex (j + 1)) ∩ + segment Real (p.vertex E.b) (p.vertex (E.b + 1)) := ⟨hx, hxl⟩ + rw [p.edge_intersection j E.b hjtop] at hh + exact hh.1.elim hxj hxj1 + +private theorem hreach : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (j : + Fin (n + (3 : ℕ))), ∀ (w : ℝ × ℝ), (j ≠ E.b - (1 : Fin (n + (3 : ℕ)))) → ((j ≠ E.b) → + ((w ∈ segment ℝ (p.vertex j) (p.vertex (j + (1 : Fin (n + (3 : ℕ)))))) → (∀ (A : + AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (E.height = A.coord (1 : Fin (3 : ℕ))) → ( + let D := convexHull Real (Set.range A) + (w ∈ interior D) → ((∀ x, x ∈ D ↔ ∀ i, 0 ≤ A.coord i x) → ((∀ x, x ∈ interior D ↔ ∀ i, 0 + < A.coord i x) → ((0 < E.height w) → ((∀ x, x ∈ D → A.coord 0 x = 0 → x ∈ segment + Real (p.vertex E.b) (p.vertex (E.b + 1))) → ((∀ x, x ∈ D → A.coord 2 x = 0 → x ∈ + segment Real (p.vertex (E.b - 1)) (p.vertex E.b)) → ((∀ x, x ∈ segment Real (p.vertex + j) (p.vertex (j + 1)) → x ≠ p.vertex j → x ≠ p.vertex (j + 1) → x ∉ segment Real + (p.vertex (E.b - 1)) (p.vertex E.b) ∧ x ∉ segment Real (p.vertex E.b) (p.vertex (E.b + + 1))) → ((¬w = p.vertex j) → ((¬w = p.vertex (j + (1 : Fin (n + (3 : ℕ))))) → (∀ (l + : Fin (n + 3)), ∀ (k : Fin (n + 3)), (l = j ∧ k = j + 1) ∨ (l = j + 1 ∧ k = j) → + E.height (p.vertex l) ≤ E.height (p.vertex k) → p.vertex k ∈ D ∧ E.height w ≤ + E.height (p.vertex k)))))))))))))) ) := by + classical + intro n p E j w hjprev hjtop hws A hheight D hwD hmem hint hpos hface0 hface2 hside hwj hwj1 l + k hlk hhk + have hsegment : segment Real (p.vertex l) (p.vertex k) = + segment Real (p.vertex j) (p.vertex (j + 1)) := by + rcases hlk with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · rfl + · exact segment_symm Real _ _ + have hwl : w ≠ p.vertex l := by + rcases hlk with ⟨rfl, _⟩ | ⟨rfl, _⟩ + · exact hwj + · exact hwj1 + have hwk : w ≠ p.vertex k := by + rcases hlk with ⟨_, rfl⟩ | ⟨_, rfl⟩ + · exact hwj1 + · exact hwj + have hlkne : p.vertex l ≠ p.vertex k := by + intro heq + have hw' : w ∈ segment Real (p.vertex l) (p.vertex k) := by + rw [hsegment] + exact hws + rw [← heq] at hw' + exact hwl (by simpa only [segment_same, Set.mem_singleton_iff] using hw') + let q : Real → Real × Real := AffineMap.lineMap (p.vertex l) (p.vertex k) + have hqinj : Function.Injective q := AffineMap.lineMap_injective Real hlkne + have hq0 : q 0 = p.vertex l := AffineMap.lineMap_apply_zero _ _ + have hq1 : q 1 = p.vertex k := AffineMap.lineMap_apply_one _ _ + have hqcont : Continuous q := + (AffineMap.lineMap (k := Real) (p.vertex l) (p.vertex k)).continuous_of_finiteDimensional + obtain ⟨t, ht, htq⟩ : ∃ t ∈ Set.Icc (0 : Real) 1, q t = w := by + have hw' : w ∈ segment Real (p.vertex l) (p.vertex k) := hsegment ▸ hws + rw [segment_eq_image_lineMap] at hw' + exact hw' + have ht0 : 0 < t := lt_of_le_of_ne ht.1 (by + intro heq + exact hwl (by rw [← htq, ← heq, hq0])) + have hhq : ∀ s, E.height (q s) = + (1 - s) * E.height (p.vertex l) + s * E.height (p.vertex k) := by + intro s + exact (E.height.apply_lineMap _ _ s).trans (AffineMap.lineMap_apply_ring _ _ s) + have hhw : E.height w ≤ E.height (p.vertex k) := by + rw [← htq, hhq] + nlinarith [mul_nonneg (sub_nonneg.mpr ht.2) (sub_nonneg.mpr hhk)] + let I : Set Real := Set.Icc 0 1 ∩ q ⁻¹' D + have hDclosed : IsClosed D := (Set.finite_range A).isClosed_convexHull Real + have hIcompact : IsCompact I := isCompact_Icc.inter_right (hDclosed.preimage hqcont) + have htI : t ∈ I := by + refine ⟨ht, ?_⟩ + change q t ∈ D + rw [htq] + exact interior_subset hwD + obtain ⟨m, hmI, hmmax⟩ := + hIcompact.exists_isMaxOn ⟨t, htI⟩ continuous_id.continuousOn + have htm : t ≤ m := hmmax htI + have hmpos : 0 < m := ht0.trans_le htm + have hmheight : 0 < E.height (q m) := by + have hhwle : E.height w ≤ E.height (q m) := by + rw [← htq, hhq, hhq] + nlinarith [mul_nonneg (sub_nonneg.mpr htm) (sub_nonneg.mpr hhk)] + exact hpos.trans_le hhwle + -- A maximal parameter below one would still be interior. + have hm1 : m = 1 := by + by_contra hmne + have hmlt : m < 1 := lt_of_le_of_ne hmI.1.2 hmne + have hqmseg : q m ∈ segment Real (p.vertex j) (p.vertex (j + 1)) := by + rw [← hsegment, segment_eq_image_lineMap] + exact ⟨m, hmI.1, rfl⟩ + have hqmne : q m ≠ p.vertex j ∧ q m ≠ p.vertex (j + 1) := by + have hne0 : q m ≠ p.vertex l := by + intro heq + have := hqinj (heq.trans hq0.symm) + linarith + have hne1 : q m ≠ p.vertex k := by + intro heq + have := hqinj (heq.trans hq1.symm) + linarith + rcases hlk with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact ⟨hne0, hne1⟩ + · exact ⟨hne1, hne0⟩ + have hqmavoid := hside (q m) hqmseg hqmne.1 hqmne.2 + have hqmint : q m ∈ interior D := by + apply (hint _).mpr + intro i + have hn := (hmem _).mp hmI.2 i + fin_cases i + · exact lt_of_le_of_ne hn (by + intro heq + exact hqmavoid.2 (hface0 _ hmI.2 heq.symm)) + · simpa [hheight, Fin.isValue, Fin.reduceFinMk] using hmheight + · exact lt_of_le_of_ne hn (by + intro heq + exact hqmavoid.1 (hface2 _ hmI.2 heq.symm)) + have hnhds : q ⁻¹' interior D ∩ Set.Iio (1 : Real) ∈ nhds m := + Filter.inter_mem (hqcont.continuousAt.preimage_mem_nhds + (isOpen_interior.mem_nhds hqmint)) (Iio_mem_nhds hmlt) + obtain ⟨u, v, ⟨hum, hmv⟩, hsub⟩ := mem_nhds_iff_exists_Ioo_subset.mp hnhds + obtain ⟨s, hms, hsv⟩ := exists_between hmv + have hs := hsub ⟨hum.trans hms, hsv⟩ + have hsD : q s ∈ D := interior_subset hs.1 + have hsI : s ∈ I := ⟨⟨by linarith, hs.2.le⟩, hsD⟩ + exact (not_lt_of_ge (hmmax hsI)) hms + refine ⟨?_, hhw⟩ + have hmmem : q m ∈ D := hmI.2 + simpa only [hm1, hq1] using hmmem + +end TriangleEntryGeometry + +theorem P3650T1TriangleEntry {n : Nat} (p : P3381T1PolygonBoundary n) + (E : P3650T1ExposedCorner p) : + ∀ (j : Fin (n + 3)) (w : Real × Real), j ≠ E.b - 1 → j ≠ E.b → + w ∈ interior (convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : + Set (Real × Real))) → + w ∈ segment Real (p.vertex j) (p.vertex (j + 1)) → + ∃ k, (k = j ∨ k = j + 1) ∧ + p.vertex k ∈ convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : + Set (Real × Real)) ∧ E.height w ≤ E.height (p.vertex k) := by +-- BODY + classical + -- The determinant makes the neighboring vertices an affine basis. + have hbasis := TriangleEntryGeometry.hbasis n p E + intro j w hjprev hjtop hw hws + obtain ⟨A, hA, hheight⟩ := hbasis + have hA0 : A 0 = p.vertex (E.b - 1) := hA 0 + have hA1 : A 1 = p.vertex E.b := hA 1 + have hA2 : A 2 = p.vertex (E.b + 1) := hA 2 + have hrange : Set.range A = + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : + Set (Real × Real)) := TriangleEntryGeometry.hrange n p E A hA + let D := convexHull Real (Set.range A) + have hwD : w ∈ interior D := by simpa only [D, hrange] using hw + have hmem := TriangleEntryGeometry.hmem A + have hint := TriangleEntryGeometry.hint A + have hpos := TriangleEntryGeometry.hpos n p E w A hheight hwD hint + -- Vanishing lateral coordinates identify the two incident polygon sides. + have hface0 := TriangleEntryGeometry.hface0 n p E A hA1 hA2 hmem + have hface2 := TriangleEntryGeometry.hface2 n p E A hA0 hA1 hmem + have hside := TriangleEntryGeometry.hside n p E j hjprev hjtop + by_cases hwj : w = p.vertex j + · refine ⟨j, Or.inl rfl, ?_, by rw [hwj]⟩ + exact interior_subset (hwj ▸ hw) + by_cases hwj1 : w = p.vertex (j + 1) + · refine ⟨j + 1, Or.inr rfl, ?_, by rw [hwj1]⟩ + exact interior_subset (hwj1 ▸ hw) + -- Follow the selected side toward its endpoint of greater height. + have hreach := TriangleEntryGeometry.hreach n p E j w hjprev hjtop hws A hheight hwD hmem hint + hpos hface0 hface2 hside hwj hwj1 + rcases le_total (E.height (p.vertex j)) (E.height (p.vertex (j + 1))) with hh | hh + · obtain ⟨hkD, hkh⟩ := hreach j (j + 1) (Or.inl ⟨rfl, rfl⟩) hh + exact ⟨j + 1, Or.inr rfl, by simpa only [D, hrange] using hkD, hkh⟩ + · obtain ⟨hkD, hkh⟩ := hreach (j + 1) j (Or.inr ⟨rfl, rfl⟩) hh + exact ⟨j, Or.inl rfl, by simpa only [D, hrange] using hkD, hkh⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1VisibleDiagonal.lean b/LeanPool/ApollonianSuperharmonic/P3650T1VisibleDiagonal.lean new file mode 100644 index 0000000000..c9b86d3d68 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3650T1VisibleDiagonal.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3650T1ExposedCorner + +-- [TABLET NODE: P3650T1VisibleDiagonal] + +/-! +# P3650T1VisibleDiagonal + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $p$ and exposed-corner data $E$ of `P3650T1ExposedCorner`, +this record consists of distinct, nonneighboring cyclic indices $A,B$. +The open segment $(p_A,p_B)$ is disjoint from the parent carrier of +`P3544T1BoundaryCarrier` and contained in its odd set of +`P3544T1RayParity`. One of the following routes is recorded. +In the base route, $A=E.b-1$, $B=E.b+1$, and the closed triangle +$\Delta=\operatorname{conv}\{p_{E.b-1},p_{E.b},p_{E.b+1}\}$ contains +no indexed vertex other than these three. In the top route, +$A=E.b$, $B\ne E.b-1,E.b+1$, and $p_B\in\Delta$. +No child boundary or child parity is part of these data. +-/ +structure P3650T1VisibleDiagonal {n : Nat} (p : P3381T1PolygonBoundary n) + (E : P3650T1ExposedCorner p) where +-- BODY + /-- The first original boundary label of the visible interior diagonal. -/ + a : Fin (n + 3) + /-- The second original boundary label of that diagonal. -/ + b : Fin (n + 3) + distinct : a ≠ b + not_next : b ≠ a + 1 + not_previous : a ≠ b + 1 + clear : Disjoint (openSegment Real (p.vertex a) (p.vertex b)) + (P3544T1BoundaryCarrier p) + odd : openSegment Real (p.vertex a) (p.vertex b) ⊆ P3544T1RayParity p + route : + (a = E.b - 1 ∧ b = E.b + 1 ∧ + ∀ i, p.vertex i ∈ convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : + Set (Real × Real)) → i = E.b - 1 ∨ i = E.b ∨ i = E.b + 1) ∨ + (a = E.b ∧ b ≠ E.b - 1 ∧ b ≠ E.b + 1 ∧ + p.vertex b ∈ convexHull Real + ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : + Set (Real × Real))) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1ChildFillSeparation.lean b/LeanPool/ApollonianSuperharmonic/P3652T1ChildFillSeparation.lean new file mode 100644 index 0000000000..945251d0ce --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3652T1ChildFillSeparation.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3544T1DiagonalSplit + +-- [TABLET NODE: P3652T1ChildFillSeparation] + +/-! +# P3652T1ChildFillSeparation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3652T1ChildFillSeparation {n : Nat} {p : P3381T1PolygonBoundary n} + (S : P3544T1DiagonalSplit p) {XL XR : Set (Real × Real)} + (hL : XL = P3544T1RayParity S.left ∪ P3544T1BoundaryCarrier S.left) + (hR : XR = P3544T1RayParity S.right ∪ P3544T1BoundaryCarrier S.right) + (hcL : IsPathConnected (P3544T1RayParity S.left)) + (hcR : IsPathConnected (P3544T1RayParity S.right)) : + XL ∩ XR = segment Real (p.vertex S.a) (p.vertex S.b) := by +-- BODY + let OL := P3544T1RayParity S.left + let OR := P3544T1RayParity S.right + let CL := P3544T1BoundaryCarrier S.left + let CR := P3544T1BoundaryCarrier S.right + let e := segment Real (p.vertex S.a) (p.vertex S.b) + have heL : e ⊆ CL := by + rw [show e = CL ∩ CR from S.carrier_intersection.symm] + exact Set.inter_subset_left + have heR : e ⊆ CR := by + rw [show e = CL ∩ CR from S.carrier_intersection.symm] + exact Set.inter_subset_right + have hOLCR : Disjoint OL CR := by + apply Set.disjoint_left.mpr + intro x hx hC + by_cases he : x ∈ e + · exact hx.1 (heL he) + · exact Set.disjoint_left.mp S.right_arc_even ⟨hC, he⟩ hx + have hORCL : Disjoint OR CL := by + apply Set.disjoint_left.mpr + intro x hx hC + by_cases he : x ∈ e + · exact hx.1 (heR he) + · exact Set.disjoint_left.mp S.left_arc_even ⟨hC, he⟩ hx + let m := midpoint Real (p.vertex S.a) (p.vertex S.b) + have hm : m ∈ openSegment Real (p.vertex S.a) (p.vertex S.b) := + midpoint_mem_openSegment _ _ + have hme : m ∈ e := openSegment_subset_segment Real _ _ hm + obtain ⟨r, hr, s, hs⟩ := S.diagonal_sides m hm + have hlocal : Disjoint (Metric.ball m r ∩ OL) OR := by + apply Set.disjoint_left.mpr + intro x hx hy + have hleft := (hs x hx.1).1.mp hx.2 + have hright := (hs x hx.1).2.mp hy + cases s <;> simp only [Bool.false_eq_true, ite_false, ite_true] at hleft hright <;> + linarith + have hclosureL : closure OL = OL ∪ CL := (P3544T1LocalParity S.left).1 + have hclosureR : closure OR = OR ∪ CR := (P3544T1LocalParity S.right).1 + have hmL : m ∈ closure OL := hclosureL.symm ▸ Or.inr (heL hme) + have hmR : m ∈ closure OR := hclosureR.symm ▸ Or.inr (heR hme) + obtain ⟨xL, hxL, hdL⟩ := Metric.mem_closure_iff.mp hmL r hr + obtain ⟨xR, hxR, hdR⟩ := Metric.mem_closure_iff.mp hmR r hr + have hbL : xL ∈ Metric.ball m r := by simpa only [Metric.mem_ball, dist_comm] using hdL + have hbR : xR ∈ Metric.ball m r := by simpa only [Metric.mem_ball, dist_comm] using hdR + have hxLout : xL ∈ (closure OR)ᶜ := by + rw [hclosureR] + rintro (ho | hc) + · exact Set.disjoint_left.mp hlocal ⟨hbL, hxL⟩ ho + · exact Set.disjoint_left.mp hOLCR hxL hc + have hxRout : xR ∈ (closure OL)ᶜ := by + rw [hclosureL] + rintro (ho | hc) + · exact Set.disjoint_left.mp hlocal ⟨hbR, ho⟩ hxR + · exact Set.disjoint_left.mp hORCL hxR hc + have hLout : OL ⊆ (closure OR)ᶜ := by + apply hcL.isConnected.isPreconnected.subset_right_of_subset_union + (P3544T1LocalParity S.right).2.1 isClosed_closure.isOpen_compl + (Set.disjoint_left.mpr (fun _ hx hy => hy (subset_closure hx))) + · intro x hx + by_cases ho : x ∈ OR + · exact Or.inl ho + · apply Or.inr + rw [hclosureR] + exact fun h => h.elim ho (Set.disjoint_left.mp hOLCR hx) + · exact ⟨xL, hxL, hxLout⟩ + have hRout : OR ⊆ (closure OL)ᶜ := by + apply hcR.isConnected.isPreconnected.subset_right_of_subset_union + (P3544T1LocalParity S.left).2.1 isClosed_closure.isOpen_compl + (Set.disjoint_left.mpr (fun _ hx hy => hy (subset_closure hx))) + · intro x hx + by_cases ho : x ∈ OL + · exact Or.inl ho + · apply Or.inr + rw [hclosureL] + exact fun h => h.elim ho (Set.disjoint_left.mp hORCL hx) + · exact ⟨xR, hxR, hxRout⟩ + rw [hL, hR] + ext x + constructor + · rintro ⟨hx, hy⟩ + rcases hx with hx | hx + · exact False.elim (hLout hx (hclosureR.symm ▸ hy)) + · rcases hy with hy | hy + · exact False.elim (hRout hy (hclosureL.symm ▸ Or.inr hx)) + · exact S.carrier_intersection ▸ ⟨hx, hy⟩ + · intro hx + exact ⟨Or.inr (heL hx), Or.inr (heR hx)⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1DiagonalFaceIntersections.lean b/LeanPool/ApollonianSuperharmonic/P3652T1DiagonalFaceIntersections.lean new file mode 100644 index 0000000000..125654e8d0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3652T1DiagonalFaceIntersections.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3652T1TriangleFaceRestriction +public import LeanPool.ApollonianSuperharmonic.P3652T1IndexedFaceLedger + +-- [TABLET NODE: P3652T1DiagonalFaceIntersections] + +/-! +# P3652T1DiagonalFaceIntersections + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3652T1DiagonalFaceIntersections {n : Nat} {p : P3381T1PolygonBoundary n} + (S : P3544T1DiagonalSplit p) {XL XR : Set (Real × Real)} + (L : P3511T1SourceDissection S.left XL) + (R : P3511T1SourceDissection S.right XR) + (hsep : XL ∩ XR = segment Real (p.vertex S.a) (p.vertex S.b)) : + ∀ k l, + convexHull Real (Set.range (p.vertex ∘ (S.il ∘ L.face k))) ∩ + convexHull Real (Set.range (p.vertex ∘ (S.ir ∘ R.face l))) = + convexHull Real (p.vertex '' + (Set.range (S.il ∘ L.face k) ∩ Set.range (S.ir ∘ R.face l))) := by +-- BODY + classical + have hfaces (v : Fin 3 → Fin (n + 3)) + (hv : P3381T1TriangleDeterminant (p.vertex ∘ v) ≠ 0) + (A B : Set (Fin (n + 3))) (hA : A ⊆ Set.range v) (hB : B ⊆ Set.range v) : + convexHull Real (p.vertex '' A) ∩ convexHull Real (p.vertex '' B) = + convexHull Real (p.vertex '' (A ∩ B)) := by + have hAB : A ∩ B ⊆ Set.range v := fun _ hx => hA hx.1 + have h := P3652T1TriangleFaceRestriction (p.vertex ∘ v) hv + (v ⁻¹' A) (v ⁻¹' B) + simpa only [← Set.preimage_inter, Set.image_comp, + Set.image_preimage_eq_of_subset hA, Set.image_preimage_eq_of_subset hB, + Set.image_preimage_eq_of_subset hAB] using h + have hwithin {m : Nat} (q : P3381T1PolygonBoundary m) + {X : Set (Real × Real)} (D : P3511T1SourceDissection q X) + (e : Fin (m + 3) → Fin (n + 3)) (he : Function.Injective e) + (hq : q.vertex = p.vertex ∘ e) (k l : Fin D.count) : + convexHull Real (Set.range (p.vertex ∘ (e ∘ D.face k))) ∩ + convexHull Real (Set.range (p.vertex ∘ (e ∘ D.face l))) = + convexHull Real (p.vertex '' + (Set.range (e ∘ D.face k) ∩ Set.range (e ∘ D.face l))) := by + have hv (i : Fin D.count) : + q.vertex ∘ D.face i = p.vertex ∘ (e ∘ D.face i) := by rw [hq]; rfl + rw [← hv k, ← hv l, D.intersection] + congr 1 + rw [Set.range_comp, Set.range_comp, ← Set.image_inter he, Set.image_image, hq] + rfl + have hclip {m : Nat} (q : P3381T1PolygonBoundary m) + {X : Set (Real × Real)} (D : P3511T1SourceDissection q X) + (e : Fin (m + 3) → Fin (n + 3)) (he : Function.Injective e) + (hq : q.vertex = p.vertex ∘ e) (K : Fin D.count) + (hKa : S.a ∈ Set.range (e ∘ D.face K)) + (hKb : S.b ∈ Set.range (e ∘ D.face K)) (k : Fin D.count) : + convexHull Real (Set.range (p.vertex ∘ (e ∘ D.face k))) ∩ + segment Real (p.vertex S.a) (p.vertex S.b) = + convexHull Real (p.vertex '' (Set.range (e ∘ D.face k) ∩ {S.a, S.b})) := by + let F := Set.range (e ∘ D.face k) + let H := Set.range (e ∘ D.face K) + have hbase : ({S.a, S.b} : Set (Fin (n + 3))) ⊆ H := by + intro i hi + rcases Set.mem_insert_iff.mp hi with rfl | hi + · exact hKa + · exact Set.mem_singleton_iff.mp hi ▸ hKb + have hnd : P3381T1TriangleDeterminant (p.vertex ∘ (e ∘ D.face K)) ≠ 0 := by + simpa only [← Function.comp_assoc, ← hq] using D.nondegenerate K + have hbaseHull : convexHull Real (p.vertex '' ({S.a, S.b} : Set (Fin (n + 3)))) = + segment Real (p.vertex S.a) (p.vertex S.b) := by rw [Set.image_pair, convexHull_pair] + have hbaseSub : segment Real (p.vertex S.a) (p.vertex S.b) ⊆ + convexHull Real (Set.range (p.vertex ∘ (e ∘ D.face K))) := by + rw [← hbaseHull, Set.range_comp] + exact convexHull_mono (Set.image_mono hbase) + have hi : (F ∩ H) ∩ ({S.a, S.b} : Set (Fin (n + 3))) = F ∩ {S.a, S.b} := by + ext i + exact ⟨fun h => ⟨h.1.1, h.2⟩, fun h => ⟨⟨h.1, hbase h.2⟩, h.2⟩⟩ + calc + _ = (convexHull Real (Set.range (p.vertex ∘ (e ∘ D.face k))) ∩ + convexHull Real (Set.range (p.vertex ∘ (e ∘ D.face K)))) ∩ + segment Real (p.vertex S.a) (p.vertex S.b) := by + ext x + exact ⟨fun h => ⟨⟨h.1, hbaseSub h.2⟩, h.2⟩, fun h => ⟨h.1.1, h.2⟩⟩ + _ = convexHull Real (p.vertex '' (F ∩ H)) ∩ + convexHull Real (p.vertex '' ({S.a, S.b} : Set (Fin (n + 3)))) := by + rw [hwithin q D e he hq k K, hbaseHull] + _ = convexHull Real (p.vertex '' ((F ∩ H) ∩ {S.a, S.b})) := + hfaces (e ∘ D.face K) hnd (F ∩ H) {S.a, S.b} Set.inter_subset_right hbase + _ = _ := by rw [hi] + obtain ⟨_, _, _, _, _, _, _, ⟨KL, hLa, hLb⟩, ⟨KR, hRa, hRb⟩⟩ := + P3652T1IndexedFaceLedger S L R + have hnd : P3381T1TriangleDeterminant (p.vertex ∘ (S.il ∘ L.face KL)) ≠ 0 := by + simpa only [← Function.comp_assoc, ← S.left_vertex] using L.nondegenerate KL + have hbase : ({S.a, S.b} : Set (Fin (n + 3))) ⊆ Set.range (S.il ∘ L.face KL) := by + intro i hi + rcases Set.mem_insert_iff.mp hi with rfl | hi + · exact hLa + · exact Set.mem_singleton_iff.mp hi ▸ hLb + intro k l + have hLsub : convexHull Real (Set.range (p.vertex ∘ (S.il ∘ L.face k))) ⊆ XL := by + intro x hx + have hi : x ∈ ⋃ j, convexHull Real (Set.range (S.left.vertex ∘ L.face j)) := by + apply Set.mem_iUnion.mpr + exact ⟨k, by simpa only [← Function.comp_assoc, ← S.left_vertex] using hx⟩ + exact L.cover.symm ▸ hi + have hRsub : convexHull Real (Set.range (p.vertex ∘ (S.ir ∘ R.face l))) ⊆ XR := by + intro x hx + have hi : x ∈ ⋃ j, convexHull Real (Set.range (S.right.vertex ∘ R.face j)) := by + apply Set.mem_iUnion.mpr + exact ⟨l, by simpa only [← Function.comp_assoc, ← S.right_vertex] using hx⟩ + exact R.cover.symm ▸ hi + have hcommon : Set.range (S.il ∘ L.face k) ∩ Set.range (S.ir ∘ R.face l) ⊆ + ({S.a, S.b} : Set (Fin (n + 3))) := by + intro i hi + rw [← S.common_indices] + obtain ⟨j, hj⟩ := hi.1 + obtain ⟨z, hz⟩ := hi.2 + exact ⟨⟨L.face k j, hj⟩, ⟨R.face l z, hz⟩⟩ + have hi : (Set.range (S.il ∘ L.face k) ∩ ({S.a, S.b} : Set (Fin (n + 3)))) ∩ + (Set.range (S.ir ∘ R.face l) ∩ {S.a, S.b}) = + Set.range (S.il ∘ L.face k) ∩ Set.range (S.ir ∘ R.face l) := by + ext i + exact ⟨fun h => ⟨h.1.1, h.2.1⟩, + fun h => ⟨⟨h.1, hcommon h⟩, ⟨h.2, hcommon h⟩⟩⟩ + calc + _ = (convexHull Real (Set.range (p.vertex ∘ (S.il ∘ L.face k))) ∩ + segment Real (p.vertex S.a) (p.vertex S.b)) ∩ + (convexHull Real (Set.range (p.vertex ∘ (S.ir ∘ R.face l))) ∩ + segment Real (p.vertex S.a) (p.vertex S.b)) := by + ext x + constructor + · intro h + have he : x ∈ segment Real (p.vertex S.a) (p.vertex S.b) := + hsep ▸ (show x ∈ XL ∩ XR from ⟨hLsub h.1, hRsub h.2⟩) + exact ⟨⟨h.1, he⟩, ⟨h.2, he⟩⟩ + · intro h + exact ⟨h.1.1, h.2.1⟩ + _ = convexHull Real (p.vertex '' (Set.range (S.il ∘ L.face k) ∩ {S.a, S.b})) ∩ + convexHull Real (p.vertex '' (Set.range (S.ir ∘ R.face l) ∩ {S.a, S.b})) := by + rw [hclip S.left L S.il S.il_injective S.left_vertex KL hLa hLb k, + hclip S.right R S.ir S.ir_injective S.right_vertex KR hRa hRb l] + _ = convexHull Real (p.vertex '' + ((Set.range (S.il ∘ L.face k) ∩ {S.a, S.b}) ∩ + (Set.range (S.ir ∘ R.face l) ∩ {S.a, S.b}))) := + hfaces (S.il ∘ L.face KL) hnd _ _ + (fun _ h => hbase h.2) (fun _ h => hbase h.2) + _ = _ := by rw [hi] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean new file mode 100644 index 0000000000..ce0dfb1ea2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean @@ -0,0 +1,2677 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3544T1DiagonalSplit +public import LeanPool.ApollonianSuperharmonic.P3511T1SourceDissection + +-- [TABLET NODE: P3652T1IndexedFaceLedger] + +/-! +# P3652T1IndexedFaceLedger + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace IndexedFaceLedgerProof + +private theorem hlist : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + List.ofFn f = List.ofFn (fun k => S.il ∘ L.face k) ++ List.ofFn (fun k => S.ir ∘ R.face + k) ) := by + classical + intro n p S XL XR L R f + exact List.ofFn_fin_append _ _ + +private theorem hmap : + (by + classical + exact + ∀ {α : Type}, ∀ {β : Type}, ∀ (e : α → β), ∀ {b : List α}, ∀ + {fs : List (Fin (3 : ℕ) → α)}, P3511T1CyclicDissection α b fs → + P3511T1CyclicDissection β (List.map e b) (List.map (fun (t : Fin (3 : ℕ) → α) => e + ∘ t) fs) ) := by + classical + intro α β e b fs h + induction h with + | triangle a b c => + have ht : e ∘ ![a, b, c] = ![e a, e b, e c] := by + funext i + fin_cases i <;> rfl + simpa only [List.map_cons, List.map_nil, ht] using + P3511T1CyclicDissection.triangle (e a) (e b) (e c) + | split a b u v left right hu hv hleft hright ihL ihR => + simp only [List.map_cons, List.map_append, List.map_nil] at ihL ihR + simpa only [List.map_cons, List.map_append, List.map_nil] using + P3511T1CyclicDissection.split (e a) (e b) (u.map e) (v.map e) + (left.map (fun t => e ∘ t)) (right.map (fun t => e ∘ t)) + (by simpa using hu) (by simpa using hv) ihL ihR + | rotate b fs k h ih => + apply P3511T1CyclicDissection.rotate _ _ k + simpa only [List.map_rotate] using ih + +private theorem hdissection : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + (List.ofFn f = List.ofFn (fun k => S.il ∘ L.face k) ++ List.ofFn (fun k => S.ir ∘ R.face + k)) → ((∀ {α : Type}, ∀ {β : Type}, ∀ (e : α → β), ∀ {b : List α}, ∀ + {fs : List (Fin 3 → α)}, (P3511T1CyclicDissection α b fs) → + (P3511T1CyclicDissection β (b.map e) (fs.map (fun t => e ∘ t)))) → + (P3511T1CyclicDissection (Fin (n + 3)) (List.ofFn (fun i : Fin (n + 3) => i)) + (List.ofFn f))) ) := by + classical + intro n p S XL XR L R f hlist hmap + have hl := hmap S.il L.dissection + have hr := hmap S.ir R.dissection + simp only [List.map_ofFn, Function.comp_def] at hl hr + rw [S.left_order] at hl + rw [S.right_order] at hr + rw [hlist] + apply P3511T1CyclicDissection.rotate _ _ S.rotation + rw [S.parent_order] + exact P3511T1CyclicDissection.split _ _ _ _ _ _ S.hu S.hv hl hr + +private theorem hinjective : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + ∀ k, Function.Injective (f k) ) := by + classical + intro n p S XL XR L R f k + refine Fin.addCases (fun i => ?_) (fun j => ?_) k + · simpa only [f, Fin.addCases_left] using S.il_injective.comp (L.face_injective i) + · simpa only [f, Fin.addCases_right] using S.ir_injective.comp (R.face_injective j) + +private theorem hnondegenerate : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + ∀ k, P3381T1TriangleDeterminant (p.vertex ∘ f k) ≠ 0 ) := by + classical + intro n p S XL XR L R f k + refine Fin.addCases (fun i => ?_) (fun j => ?_) k + · simpa only [f, Fin.addCases_left, ← Function.comp_assoc, ← S.left_vertex] + using L.nondegenerate i + · simpa only [f, Fin.addCases_right, ← Function.comp_assoc, ← S.right_vertex] + using R.nondegenerate j + +private theorem hcrossAt176 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), ∀ (i : Fin L.count), ∀ (j : + Fin R.count), Set.range (S.il ∘ L.face i) ≠ Set.range (S.ir ∘ R.face j) ) := by + classical + intro n p S XL XR L R i j heq + have hsub : Set.range (S.il ∘ L.face i) ⊆ ({S.a, S.b} : Set (Fin (n + 3))) := by + intro x hx + rw [← S.common_indices] + constructor + · obtain ⟨z, rfl⟩ := hx + exact ⟨L.face i z, rfl⟩ + · rw [heq] at hx + obtain ⟨z, rfl⟩ := hx + exact ⟨R.face j z, rfl⟩ + have hcard : (Set.range (S.il ∘ L.face i)).ncard = 3 := by + rw [Set.ncard_range_of_injective (S.il_injective.comp (L.face_injective i))] + simp + have hle := Set.ncard_le_ncard hsub (Set.toFinite _) + rw [hcard, Set.ncard_pair S.a_ne_b] at hle + omega + +private theorem hiAt215 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (i : + Fin (n + (3 : ℕ))), i ∈ (List.ofFn (fun j : Fin (n + 3) => j)).rotate S.rotation ) := by + classical + intro n p S i + rw [List.mem_rotate, List.mem_ofFn] + exact ⟨i, rfl⟩ + +private theorem hmemAt219 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (i : + Fin (n + (3 : ℕ))), (i ∈ S.a :: (S.u ++ S.b :: S.v)) → (i ∈ List.ofFn S.il ∨ i ∈ + List.ofFn S.ir) ) := by + classical + intro n p S i hi + rw [S.left_order, S.right_order] + simp only [List.mem_cons, List.mem_append] at hi ⊢ + tauto + +private theorem hblock : + (by + classical + exact + ∀ {l : ℕ}, ∀ {r : ℕ}, ∀ (P : Fin l → Prop), ∀ (Q : Fin r → Prop), {k : Fin (l + r) | + Fin.addCases P Q k}.ncard = {i : Fin l | P i}.ncard + {j : Fin r | Q j}.ncard ) := by + classical + intro l r P Q + have hleft : Function.Injective (Fin.castAdd r : Fin l → Fin (l + r)) := by + intro i j hij + apply Fin.ext + have hv := congrArg Fin.val hij + simpa only [Fin.val_castAdd] using hv + have hright : Function.Injective (Fin.natAdd l : Fin r → Fin (l + r)) := by + intro i j hij + apply Fin.ext + have hv := congrArg Fin.val hij + simp only [Fin.val_natAdd] at hv + omega + have hdisj : Disjoint + ((Fin.castAdd r) '' {i : Fin l | P i}) + ((Fin.natAdd l) '' {j : Fin r | Q j}) := by + apply Set.disjoint_left.mpr + rintro k ⟨i, hi, rfl⟩ ⟨j, hj, heq⟩ + have hv := congrArg Fin.val heq + simp only [Fin.val_castAdd, Fin.val_natAdd] at hv + omega + have hset : {k : Fin (l + r) | Fin.addCases P Q k} = + ((Fin.castAdd r) '' {i : Fin l | P i}) ∪ + ((Fin.natAdd l) '' {j : Fin r | Q j}) := by + ext k + constructor + · refine Fin.addCases (fun i hi => ?_) (fun j hj => ?_) k + · exact Or.inl ⟨i, by simpa using hi, rfl⟩ + · exact Or.inr ⟨j, by simpa using hj, rfl⟩ + · rintro (⟨i, hi, rfl⟩ | ⟨j, hj, rfl⟩) + · simpa using hi + · simpa using hj + rw [hset, Set.ncard_union_eq hdisj, + Set.ncard_image_of_injective _ hleft, Set.ncard_image_of_injective _ hright] + +private theorem hblockCount : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + (∀ {l : Nat}, ∀ {r : Nat}, ∀ (P : Fin l → Prop), ∀ (Q : Fin r → Prop), Set.ncard {k : Fin + (l + r) | Fin.addCases P Q k} = Set.ncard {i : Fin l | P i} + Set.ncard {j : Fin r | + Q j}) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), {k : Fin (L.count + + R.count) | i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)}.ncard = {k : Fin L.count | i ∈ + Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)}.ncard + {k : Fin + R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)}.ncard) ) + := by + classical + intro n p S XL XR L R f hblock i j + let P : Fin L.count → Prop := fun k => + i ∈ Set.range (f (Fin.castAdd R.count k)) ∧ + j ∈ Set.range (f (Fin.castAdd R.count k)) + let Q : Fin R.count → Prop := fun k => + i ∈ Set.range (f (Fin.natAdd L.count k)) ∧ + j ∈ Set.range (f (Fin.natAdd L.count k)) + have hc := hblock P Q + have hpred : {k : Fin (L.count + R.count) | Fin.addCases P Q k} = + {k | i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)} := by + ext k + refine Fin.addCases (fun a => ?_) (fun b => ?_) k + · simp only [Set.mem_ofPred_eq, Fin.addCases_left, P, f] + · simp only [Set.mem_ofPred_eq, Fin.addCases_right, Q, f] + rw [← hpred] + simpa only [P, Q, f, Fin.addCases_left, Fin.addCases_right] using hc + +private theorem hlenP : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), n + 3 + = S.u.length + S.v.length + 2 ) := by + classical + intro n p S + have h := congrArg List.length S.parent_order + simp only [List.length_rotate, List.length_ofFn, List.length_cons, + List.length_append] at h + omega + +private theorem hlenL : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), + S.left_n + 3 = S.u.length + 2 ) := by + classical + intro n p S + have h := congrArg List.length S.left_order + simp only [List.length_ofFn, List.length_cons, List.length_append] at h + omega + +private theorem hlenR : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), + S.right_n + 3 = S.v.length + 2 ) := by + classical + intro n p S + have h := congrArg List.length S.right_order + simp only [List.length_ofFn, List.length_cons, List.length_append] at h + omega + +private theorem hleftcoord : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + 3 + = S.u.length + S.v.length + 2) → ((S.left_n + 3 = S.u.length + 2) → ((S.right_n + 3 = + S.v.length + 2) → (∀ (x : Fin (S.left_n + (3 : ℕ))), (↑(S.il x) : ℕ) = ((↑x : ℕ) + + S.rotation) % (n + (3 : ℕ))))) ) := by + classical + intro n p S hlenP hlenL hlenR x + have hx : x.val < S.u.length + 2 := by rw [← hlenL]; exact x.isLt + have hpre : x.val < (S.a :: (S.u ++ [S.b])).length := by simp; omega + have hfullVal : x.val < n + 3 := by omega + have hfull : x.val < (S.a :: (S.u ++ S.b :: S.v)).length := by + simp only [List.length_cons, List.length_append] + omega + have hidx? : (List.ofFn S.il)[x.val]? = (S.a :: (S.u ++ [S.b]))[x.val]? := by + exact congrArg (fun l : List (Fin (n + 3)) => l[x.val]?) S.left_order + have hrotbound : x.val < ((List.ofFn (fun i : Fin (n + 3) => i)).rotate S.rotation).length + := by + simpa only [List.length_rotate, List.length_ofFn] using hfullVal + have hpar? : ((List.ofFn (fun i : Fin (n + 3) => i)).rotate S.rotation)[x.val]? = + (S.a :: (S.u ++ S.b :: S.v))[x.val]? := by + exact congrArg (fun l : List (Fin (n + 3)) => l[x.val]?) S.parent_order + have hprefix? : (S.a :: (S.u ++ [S.b]))[x.val]? = + (S.a :: (S.u ++ S.b :: S.v))[x.val]? := by + have happend : S.a :: (S.u ++ S.b :: S.v) = + (S.a :: (S.u ++ [S.b])) ++ S.v := by simp [List.cons_append] + rw [happend, List.getElem?_append, ite_eq_left hpre] + have hcoord : ((List.ofFn (fun i : Fin (n + 3) => i)).rotate S.rotation)[x.val]? = + some ⟨(x.val + S.rotation) % (n + 3), Nat.mod_lt _ (by omega)⟩ := by + rw [List.getElem?_eq_some_iff] + refine ⟨hrotbound, ?_⟩ + rw [List.getElem_rotate, List.getElem_ofFn] + simp only [List.length_ofFn] + have hsome : some (S.il x) = + some ⟨(x.val + S.rotation) % (n + 3), Nat.mod_lt _ (by omega)⟩ := by + calc + some (S.il x) = (List.ofFn S.il)[x.val]? := by + symm + rw [List.getElem?_eq_some_iff] + refine ⟨by simpa only [List.length_ofFn] using x.isLt, ?_⟩ + rw [List.getElem_ofFn] + _ = (S.a :: (S.u ++ [S.b]))[x.val]? := hidx? + _ = (S.a :: (S.u ++ S.b :: S.v))[x.val]? := hprefix? + _ = ((List.ofFn (fun i : Fin (n + 3) => i)).rotate S.rotation)[x.val]? := hpar?.symm + _ = _ := hcoord + exact congrArg Fin.val (Option.some.inj hsome) + +private theorem haCoord : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + 3 + = S.u.length + S.v.length + 2) → ((S.left_n + 3 = S.u.length + 2) → ((S.right_n + 3 = + S.v.length + 2) → (S.a.val = S.rotation % (n + 3)))) ) := by + classical + intro n p S hlenP hlenL hlenR + have hpar0 : ((List.ofFn (fun i : Fin (n + 3) => i)).rotate S.rotation)[0]? = + (S.a :: (S.u ++ S.b :: S.v))[0]? := + congrArg (fun l : List (Fin (n + 3)) => l[0]?) S.parent_order + have hright0 : (S.a :: (S.u ++ S.b :: S.v))[0]? = some S.a := by rfl + have hcoord0 : ((List.ofFn (fun i : Fin (n + 3) => i)).rotate S.rotation)[0]? = + some ⟨S.rotation % (n + 3), Nat.mod_lt _ (by omega)⟩ := by + rw [List.getElem?_eq_some_iff] + refine ⟨by simp, ?_⟩ + rw [List.getElem_rotate, List.getElem_ofFn] + simp only [List.length_ofFn, Nat.zero_add] + have heq := hcoord0.symm.trans (hpar0.trans hright0) + exact (congrArg Fin.val (Option.some.inj heq)).symm + +private theorem hrightcoord : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + 3 + = S.u.length + S.v.length + 2) → ((S.left_n + 3 = S.u.length + 2) → ((S.right_n + 3 = + S.v.length + 2) → ((S.a.val = S.rotation % (n + 3)) → (∀ (y : Fin (S.right_n + (3 : + ℕ))), (↑(S.ir y) : ℕ) = (S.u.length + (1 : ℕ) + (↑y : ℕ) + S.rotation) % (n + (3 : + ℕ)))))) ) := by + classical + intro n p S hlenP hlenL hlenR haCoord y + have hyBound : y.val ≤ S.v.length + 1 := by omega + have hlenA : (S.a :: S.u).length = S.u.length + 1 := by simp + have hlenB : (S.b :: S.v).length = S.v.length + 1 := by simp + have hshapeR : S.b :: (S.v ++ [S.a]) = (S.b :: S.v) ++ [S.a] := by simp + have hshapeP : S.a :: (S.u ++ S.b :: S.v) = (S.a :: S.u) ++ (S.b :: S.v) := by simp + have hidx? : (List.ofFn S.ir)[y.val]? = (S.b :: (S.v ++ [S.a]))[y.val]? := by + exact congrArg (fun l : List (Fin (n + 3)) => l[y.val]?) S.right_order + have hiy? : (List.ofFn S.ir)[y.val]? = some (S.ir y) := by + rw [List.getElem?_eq_some_iff] + refine ⟨by simpa only [List.length_ofFn] using y.isLt, ?_⟩ + rw [List.getElem_ofFn] + by_cases hyEnd : y.val = S.v.length + 1 + · have hlast? : (S.b :: (S.v ++ [S.a]))[y.val]? = some S.a := by + rw [hshapeR, List.getElem?_append] + have hnot : ¬ y.val < (S.b :: S.v).length := by rw [hlenB, hyEnd]; omega + rw [ite_eq_right hnot] + have hsub : y.val - (S.b :: S.v).length = 0 := by rw [hlenB, hyEnd]; omega + rw [hsub] + rfl + have hlast : S.ir y = S.a := by + have hh := hiy?.symm.trans (hidx?.trans hlast?) + exact Option.some.inj hh + rw [hlast, haCoord, hyEnd] + have hM : S.u.length + 1 + (S.v.length + 1) = n + 3 := by omega + rw [hM, Nat.add_mod, Nat.mod_self, zero_add] + simp only [Nat.mod_mod] + · have hyB : y.val < (S.b :: S.v).length := by rw [hlenB]; omega + let q := S.u.length + 1 + y.val + have hq : q < n + 3 := by dsimp [q]; omega + have hseg? : (S.b :: (S.v ++ [S.a]))[y.val]? = + (S.a :: (S.u ++ S.b :: S.v))[q]? := by + rw [hshapeR, hshapeP, List.getElem?_append, List.getElem?_append] + have hnot : ¬ q < (S.a :: S.u).length := by simp [q, hlenA]; omega + rw [ite_eq_left hyB, ite_eq_right hnot] + have hsub : q - (S.a :: S.u).length = y.val := by simp [q, hlenA] + rw [hsub] + have hparq? : ((List.ofFn (fun i : Fin (n + 3) => i)).rotate S.rotation)[q]? = + (S.a :: (S.u ++ S.b :: S.v))[q]? := + congrArg (fun l : List (Fin (n + 3)) => l[q]?) S.parent_order + have hcoord : ((List.ofFn (fun i : Fin (n + 3) => i)).rotate S.rotation)[q]? = + some ⟨(q + S.rotation) % (n + 3), Nat.mod_lt _ (by omega)⟩ := by + rw [List.getElem?_eq_some_iff] + refine ⟨by simpa only [List.length_rotate, List.length_ofFn] using hq, ?_⟩ + rw [List.getElem_rotate, List.getElem_ofFn] + simp only [List.length_ofFn] + have hsome : some (S.ir y) = + some ⟨(q + S.rotation) % (n + 3), Nat.mod_lt _ (by omega)⟩ := by + calc + some (S.ir y) = (List.ofFn S.ir)[y.val]? := hiy?.symm + _ = (S.b :: (S.v ++ [S.a]))[y.val]? := hidx? + _ = (S.a :: (S.u ++ S.b :: S.v))[q]? := hseg? + _ = ((List.ofFn (fun i : Fin (n + 3) => i)).rotate S.rotation)[q]? := hparq?.symm + _ = _ := hcoord + have hv := congrArg Fin.val (Option.some.inj hsome) + dsimp [q] at hv ⊢ + omega + +private theorem hmodShift : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), (P3544T1DiagonalSplit p) → (∀ {m : ℕ}, + ∀ {r : ℕ}, ∀ {x : ℕ}, ∀ {y : ℕ}, (0 : ℕ) < m → x < m → y < m → (r + x) % m = (r + y) + % m → x = y) ) := by + classical + intro n p S m r x y hm hx hy he + have hrx : (r + x) % m = (r % m + x) % m := by + rw [Nat.add_mod, Nat.mod_eq_of_lt hx] + have hry : (r + y) % m = (r % m + y) % m := by + rw [Nat.add_mod, Nat.mod_eq_of_lt hy] + have h' : (r % m + x) % m = (r % m + y) % m := hrx.symm.trans (he.trans hry) + let a := r % m + have ha : a < m := Nat.mod_lt _ hm + have hxq : (a + x) / m < 2 := (Nat.div_lt_iff_lt_mul hm).2 (by omega) + have hyq : (a + y) / m < 2 := (Nat.div_lt_iff_lt_mul hm).2 (by omega) + have hxrep := Nat.mod_add_div (a + x) m + have hyrep := Nat.mod_add_div (a + y) m + have hxq' : (a + x) / m = 0 ∨ (a + x) / m = 1 := by + rcases Nat.eq_zero_or_pos ((a + x) / m) with hz | hp + · exact Or.inl hz + · exact Or.inr (by omega) + have hyq' : (a + y) / m = 0 ∨ (a + y) / m = 1 := by + rcases Nat.eq_zero_or_pos ((a + y) / m) with hz | hp + · exact Or.inl hz + · exact Or.inr (by omega) + rcases hxq' with hxq' | hxq' <;> rcases hyq' with hyq' | hyq' + all_goals + rw [hxq'] at hxrep + rw [hyq'] at hyrep + dsimp [a] at h' hxrep hyrep + omega + +private theorem hmodSucc : + (by + classical + exact + ∀ {m : ℕ}, ∀ {r : ℕ}, ∀ {x : ℕ}, (1 : ℕ) < m → ((r + x) % m + (1 : ℕ)) % m = (r + (x + (1 + : ℕ))) % m ) := by + classical + intro m r x hm + calc + ((r + x) % m + 1) % m = ((r + x) % m + 1 % m) % m := by + rw [Nat.mod_eq_of_lt (by omega : 1 < m)] + _ = (r + x + 1) % m := by rw [← Nat.add_mod] + _ = (r + (x + 1)) % m := by congr 1 + +private theorem hfinAdj : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), (P3544T1DiagonalSplit p) → (∀ {m : ℕ}, + ∀ (x : Fin (m + (3 : ℕ))), ∀ (y : Fin (m + (3 : ℕ))), y = x + (1 : Fin (m + (3 : ℕ))) + ∨ x = y + (1 : Fin (m + (3 : ℕ))) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : + ℕ) + (1 : ℕ) ∨ (↑x : ℕ) + (1 : ℕ) = m + (3 : ℕ) ∧ (↑y : ℕ) = (0 : ℕ) ∨ (↑y : ℕ) + (1 + : ℕ) = m + (3 : ℕ) ∧ (↑x : ℕ) = (0 : ℕ)) ) := by + classical + intro n p S m x y + have hv (z : Fin (m + 3)) : (z + 1).val = (z.val + 1) % (m + 3) := by + rw [Fin.val_add, Fin.val_one] + constructor + · rintro (h | h) + · have he := congrArg Fin.val h + rw [hv] at he + by_cases hlt : x.val + 1 < m + 3 + · left + simpa [Nat.mod_eq_of_lt hlt] using he + · right + right + left + have hx : x.val + 1 = m + 3 := by omega + have hy : y.val = 0 := by rw [hx] at he; simpa using he + exact ⟨hx, hy⟩ + · have he := congrArg Fin.val h + rw [hv] at he + by_cases hlt : y.val + 1 < m + 3 + · right + left + simpa [Nat.mod_eq_of_lt hlt] using he + · right + right + right + have hy : y.val + 1 = m + 3 := by omega + have hx : x.val = 0 := by rw [hy] at he; simpa using he + exact ⟨hy, hx⟩ + · rintro (h | h | h | h) + · left + apply Fin.ext + rw [hv, Nat.mod_eq_of_lt (by omega : x.val + 1 < m + 3)] + omega + · right + apply Fin.ext + rw [hv, Nat.mod_eq_of_lt (by omega : y.val + 1 < m + 3)] + omega + · left + apply Fin.ext + rw [hv, h.1, Nat.mod_self] + exact h.2 + · right + apply Fin.ext + rw [hv, h.1, Nat.mod_self] + exact h.2 + +private theorem hleftA : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ (x + : Fin (S.left_n + 3)), (S.il x).val = (x.val + S.rotation) % (n + 3)) → ((S.a.val = + S.rotation % (n + 3)) → (S.il (0 : Fin (S.left_n + 3)) = S.a)) ) := by + classical + intro n p S hleftcoord haCoord + apply Fin.ext + have h := hleftcoord (0 : Fin (S.left_n + 3)) + simpa only [Fin.val_zero, Nat.zero_add, haCoord] using h + +private theorem hleftB : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), S.il + (Fin.last (S.left_n + 2)) = S.b ) := by + classical + intro n p S + have h := congrArg List.getLast? S.left_order + rw [List.ofFn_succ_last, ← List.cons_append] at h + simpa only [List.getLast?_concat, Option.some.injEq] using h + +private theorem hrightB : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), S.ir + (0 : Fin (S.right_n + 3)) = S.b ) := by + classical + intro n p S + have h := congrArg List.head? S.right_order + simpa [List.ofFn_succ] using h + +private theorem hrightA : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), S.ir + (Fin.last (S.right_n + 2)) = S.a ) := by + classical + intro n p S + have h := congrArg List.getLast? S.right_order + rw [List.ofFn_succ_last, ← List.cons_append] at h + simpa only [List.getLast?_concat, Option.some.injEq] using h + +private theorem hleftSucc : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + 3 + = S.u.length + S.v.length + 2) → ((S.left_n + 3 = S.u.length + 2) → ((S.right_n + 3 = + S.v.length + 2) → ((∀ (x : Fin (S.left_n + 3)), (S.il x).val = (x.val + S.rotation) % + (n + 3)) → ((∀ {m : Nat}, ∀ {r : Nat}, ∀ {x : Nat}, ∀ {y : Nat}, (0 < m) → ((x < m) → + ((y < m) → (((r + x) % m = (r + y) % m) → (x = y))))) → ((∀ {m : Nat}, ∀ {r : Nat}, ∀ + {x : Nat}, (1 < m) → (((r + x) % m + 1) % m = (r + (x + 1)) % m)) → (∀ (x : Fin + (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.left_n + (3 : ℕ))), (↑(S.il y) : ℕ) = ((↑(S.il + x) : ℕ) + (1 : ℕ)) % (n + (3 : ℕ)) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ))))))) ) := by + classical + intro n p S hlenP hlenL hlenR hleftcoord hmodShift hmodSucc x y + have hxCoord : (S.il x).val = (S.rotation + x.val) % (n + 3) := by + simpa only [Nat.add_comm] using hleftcoord x + have hyCoord : (S.il y).val = (S.rotation + y.val) % (n + 3) := by + simpa only [Nat.add_comm] using hleftcoord y + rw [hxCoord, hyCoord] + have hx : x.val + 1 < n + 3 := by omega + have hy : y.val < n + 3 := by omega + have hs := hmodSucc (m := n + 3) (by omega) (r := S.rotation) (x := x.val) + constructor + · intro h + have he : (S.rotation + (x.val + 1)) % (n + 3) = + (S.rotation + y.val) % (n + 3) := hs.symm.trans h.symm + have hxy := hmodShift (m := n + 3) (r := S.rotation) + (x := x.val + 1) (y := y.val) (by omega) hx hy he + omega + · intro h + rw [h] + exact hs.symm + +private theorem hleftOrd : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ (z + : Fin (n + 3)), (z + 1).val = (z.val + 1) % (n + 3)) → ((∀ (x : Fin (S.left_n + 3)), + ∀ (y : Fin (S.left_n + 3)), (S.il y).val = ((S.il x).val + 1) % (n + 3) ↔ y.val = + x.val + 1) → (∀ (x : Fin (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.left_n + (3 : ℕ))), + S.il y = S.il x + (1 : Fin (n + (3 : ℕ))) ∨ S.il x = S.il y + (1 : Fin (n + (3 : ℕ))) + ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : ℕ) + (1 : ℕ))) ) := by + classical + intro n p S hparentSuccVal hleftSucc x y + constructor + · rintro (h | h) + · have hv := congrArg Fin.val h + rw [hparentSuccVal] at hv + exact Or.inl (hleftSucc x y |>.mp hv) + · have hv := congrArg Fin.val h + rw [hparentSuccVal] at hv + exact Or.inr (hleftSucc y x |>.mp hv) + · rintro (h | h) + · left + apply Fin.ext + rw [hparentSuccVal] + exact (hleftSucc x y).mpr h + · right + apply Fin.ext + rw [hparentSuccVal] + exact (hleftSucc y x).mpr h + +private theorem hrightSucc : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + 3 + = S.u.length + S.v.length + 2) → ((S.left_n + 3 = S.u.length + 2) → ((S.right_n + 3 = + S.v.length + 2) → ((∀ (y : Fin (S.right_n + 3)), (S.ir y).val = (S.u.length + 1 + + y.val + S.rotation) % (n + 3)) → ((∀ {m : Nat}, ∀ {r : Nat}, ∀ {x : Nat}, ∀ + {y : Nat}, (0 < m) → ((x < m) → ((y < m) → (((r + x) % m = (r + y) % m) → (x = y))))) + → ((∀ {m : Nat}, ∀ {r : Nat}, ∀ {x : Nat}, (1 < m) → (((r + x) % m + 1) % m = (r + (x + + 1)) % m)) → (∀ (x : Fin (S.right_n + (3 : ℕ))), ∀ (y : Fin (S.right_n + (3 : ℕ))), + (↑x : ℕ) + (1 : ℕ) < S.right_n + (3 : ℕ) → (((↑(S.ir x) : ℕ) + (1 : ℕ)) % (n + (3 : + ℕ)) = (↑(S.ir y) : ℕ) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ)))))))) ) := by + classical + intro n p S hlenP hlenL hlenR hrightcoord hmodShift hmodSucc x y hx + have hoff : S.u.length + 1 + (S.right_n + 2) = n + 3 := by omega + have hxCoord : (S.ir x).val = + (S.rotation + (S.u.length + 1 + x.val)) % (n + 3) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hrightcoord x + have hyCoord : (S.ir y).val = + (S.rotation + (S.u.length + 1 + y.val)) % (n + 3) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hrightcoord y + rw [hxCoord, hyCoord] + let tx := S.u.length + 1 + x.val + let ty := S.u.length + 1 + y.val + have htx : tx < n + 3 := by dsimp [tx]; omega + have htyLe : ty ≤ n + 3 := by dsimp [ty]; omega + have htx1 : tx + 1 ≤ n + 3 := by dsimp [tx]; omega + have hs := hmodSucc (m := n + 3) (by omega) (r := S.rotation) (x := tx) + have hposMin : 2 ≤ tx := by dsimp [tx]; omega + constructor + · intro h + have he : (S.rotation + (tx + 1)) % (n + 3) = + (S.rotation + ty) % (n + 3) := hs.symm.trans h + by_cases hyLast : y.val = S.right_n + 2 + · have htyM : ty = n + 3 := by dsimp [ty]; omega + by_cases htxM : tx + 1 = n + 3 + · have hval : y.val = x.val + 1 := by dsimp [tx, ty] at htxM htyM ⊢; omega + exact hval + · have htxlt : tx + 1 < n + 3 := by omega + have hzeroEq : (S.rotation + (tx + 1)) % (n + 3) = + (S.rotation + 0) % (n + 3) := by + simpa [htyM] using he + have hz := hmodShift (m := n + 3) (r := S.rotation) + (x := tx + 1) (y := 0) (by omega) (by omega) (by omega) hzeroEq + omega + · have htylt : ty < n + 3 := by dsimp [ty]; omega + by_cases htxM : tx + 1 = n + 3 + · have hzeroEq : (S.rotation + 0) % (n + 3) = + (S.rotation + ty) % (n + 3) := by + simpa [htxM] using he + have hz := hmodShift (m := n + 3) (r := S.rotation) + (x := 0) (y := ty) (by omega) (by omega) (by omega) hzeroEq + omega + · have htxlt : tx + 1 < n + 3 := by omega + have hpos := hmodShift (m := n + 3) (r := S.rotation) + (x := tx + 1) (y := ty) (by omega) htxlt htylt he + dsimp [tx, ty] at hpos ⊢ + omega + · intro h + have hpos : tx + 1 = ty := by dsimp [tx, ty]; omega + rw [hs, hpos] + +private theorem hrightOrd : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + 3 + = S.u.length + S.v.length + 2) → ((S.left_n + 3 = S.u.length + 2) → ((S.right_n + 3 = + S.v.length + 2) → ((∀ (y : Fin (S.right_n + 3)), (S.ir y).val = (S.u.length + 1 + + y.val + S.rotation) % (n + 3)) → ((∀ {m : Nat}, ∀ {r : Nat}, ∀ {x : Nat}, ∀ + {y : Nat}, (0 < m) → ((x < m) → ((y < m) → (((r + x) % m = (r + y) % m) → (x = y))))) + → ((∀ {m : Nat}, ∀ {r : Nat}, ∀ {x : Nat}, (1 < m) → (((r + x) % m + 1) % m = (r + (x + + 1)) % m)) → ((∀ (z : Fin (n + 3)), (z + 1).val = (z.val + 1) % (n + 3)) → ((∀ (x : + Fin (S.right_n + 3)), ∀ (y : Fin (S.right_n + 3)), (x.val + 1 < S.right_n + 3) → + (((S.ir x).val + 1) % (n + 3) = (S.ir y).val ↔ y.val = x.val + 1)) → (∀ (x : Fin + (S.right_n + (3 : ℕ))), ∀ (y : Fin (S.right_n + (3 : ℕ))), x ≠ y → (S.ir y = S.ir x + + (1 : Fin (n + (3 : ℕ))) ∨ S.ir x = S.ir y + (1 : Fin (n + (3 : ℕ))) ↔ (↑y : ℕ) = (↑x + : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : ℕ) + (1 : ℕ)))))))))) ) := by + classical + intro n p S hlenP hlenL hlenR hrightcoord hmodShift hmodSucc hparentSuccVal hrightSucc x y hxy + have hxlast : x.val + 1 = S.right_n + 3 ∨ x.val + 1 < S.right_n + 3 := by omega + have hylast : y.val + 1 = S.right_n + 3 ∨ y.val + 1 < S.right_n + 3 := by omega + constructor + · rintro (h | h) + · have hv := congrArg Fin.val h + rw [hparentSuccVal] at hv + rcases hxlast with hxlast | hxlt + · have hylt : y.val + 1 < S.right_n + 3 := by + rcases hylast with hylast | hylt + · exfalso; exact hxy (Fin.ext (by omega)) + · exact hylt + have hM : S.u.length + 1 + (S.right_n + 2) = n + 3 := by omega + have hxEndCoord : (S.ir x).val = S.rotation % (n + 3) := by + have hxl : x.val = S.right_n + 2 := by omega + rw [hrightcoord, hxl] + calc + (S.u.length + 1 + (S.right_n + 2) + S.rotation) % (n + 3) = + ((n + 3) + S.rotation) % (n + 3) := by rw [hM] + _ = S.rotation % (n + 3) := by + rw [Nat.add_mod, Nat.mod_self, zero_add] + simp only [Nat.mod_mod] + have hs0 := hmodSucc (m := n + 3) (by omega) (r := S.rotation) (x := 0) + have hzero : (S.rotation + 1) % (n + 3) = + (S.rotation + (S.u.length + 1 + y.val)) % (n + 3) := by + calc + (S.rotation + 1) % (n + 3) = + ((S.rotation % (n + 3) + 1) % (n + 3)) := hs0.symm + _ = ((S.ir x).val + 1) % (n + 3) := by rw [hxEndCoord] + _ = (S.ir y).val := hv.symm + _ = (S.rotation + (S.u.length + 1 + y.val)) % (n + 3) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hrightcoord y + have hypos := hmodShift (m := n + 3) (r := S.rotation) + (x := 1) (y := S.u.length + 1 + y.val) (by omega) (by omega) (by omega) hzero + omega + · exact Or.inl (hrightSucc x y hxlt |>.mp hv.symm) + · have hv := congrArg Fin.val h + rw [hparentSuccVal] at hv + rcases hylast with hylast | hylt + · rcases hxlast with hxlast | hxlt + · exfalso; exact hxy.symm (Fin.ext (by omega)) + · have hM : S.u.length + 1 + (S.right_n + 2) = n + 3 := by omega + have hyEndCoord : (S.ir y).val = S.rotation % (n + 3) := by + have hyl : y.val = S.right_n + 2 := by omega + rw [hrightcoord, hyl] + calc + (S.u.length + 1 + (S.right_n + 2) + S.rotation) % (n + 3) = + ((n + 3) + S.rotation) % (n + 3) := by rw [hM] + _ = S.rotation % (n + 3) := by + rw [Nat.add_mod, Nat.mod_self, zero_add] + simp only [Nat.mod_mod] + have hs0 := hmodSucc (m := n + 3) (by omega) (r := S.rotation) (x := 0) + have hzero : (S.rotation + 1) % (n + 3) = + (S.rotation + (S.u.length + 1 + x.val)) % (n + 3) := by + calc + (S.rotation + 1) % (n + 3) = + ((S.rotation % (n + 3) + 1) % (n + 3)) := hs0.symm + _ = ((S.ir y).val + 1) % (n + 3) := by rw [hyEndCoord] + _ = (S.ir x).val := hv.symm + _ = (S.rotation + (S.u.length + 1 + x.val)) % (n + 3) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hrightcoord x + have hxpos := hmodShift (m := n + 3) (r := S.rotation) + (x := 1) (y := S.u.length + 1 + x.val) (by omega) (by omega) (by omega) hzero + omega + · exact Or.inr (hrightSucc y x hylt |>.mp hv.symm) + · rintro (h | h) + · have hxlt : x.val + 1 < S.right_n + 3 := by omega + have hv := (hrightSucc x y hxlt).mpr h + left + apply Fin.ext + rw [hparentSuccVal] + exact hv.symm + · have hylt : y.val + 1 < S.right_n + 3 := by omega + have hv := (hrightSucc y x hylt).mpr h + right + apply Fin.ext + rw [hparentSuccVal] + exact hv.symm + +private theorem hleftWrap : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (S.il + (0 : Fin (S.left_n + 3)) = S.a) → ((S.il (Fin.last (S.left_n + 2)) = S.b) → (∀ (x : + Fin (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.left_n + (3 : ℕ))), (↑x : ℕ) + (1 : ℕ) = + S.left_n + (3 : ℕ) ∧ (↑y : ℕ) = (0 : ℕ) ∨ (↑y : ℕ) + (1 : ℕ) = S.left_n + (3 : ℕ) ∧ + (↑x : ℕ) = (0 : ℕ) ↔ S.il x = S.b ∧ S.il y = S.a ∨ S.il y = S.b ∧ S.il x = S.a)) ) := by + classical + intro n p S hleftA hleftB x y + constructor + · rintro (h | h) + · have hx : x = Fin.last (S.left_n + 2) := by + apply Fin.ext + simp only [Fin.val_last] + omega + have hy : y = 0 := Fin.ext (by simpa only [Fin.val_zero] using h.2) + exact Or.inl ⟨by rw [hx, hleftB], by rw [hy, hleftA]⟩ + · have hy : y = Fin.last (S.left_n + 2) := by + apply Fin.ext + simp only [Fin.val_last] + omega + have hx : x = 0 := Fin.ext (by simpa only [Fin.val_zero] using h.2) + exact Or.inr ⟨by rw [hy, hleftB], by rw [hx, hleftA]⟩ + · rintro (h | h) + · have hx : x = Fin.last (S.left_n + 2) := S.il_injective (h.1.trans hleftB.symm) + have hy : y = 0 := S.il_injective (h.2.trans hleftA.symm) + subst x + subst y + exact Or.inl ⟨by simp, by simp⟩ + · have hy : y = Fin.last (S.left_n + 2) := S.il_injective (h.1.trans hleftB.symm) + have hx : x = 0 := S.il_injective (h.2.trans hleftA.symm) + subst x + subst y + exact Or.inr ⟨by simp, by simp⟩ + +private theorem hleftAdj : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ + {m : Nat}, ∀ (x : Fin (m + 3)), ∀ (y : Fin (m + 3)), (y = x + 1 ∨ x = y + 1) ↔ (y.val + = x.val + 1 ∨ x.val = y.val + 1 ∨ (x.val + 1 = m + 3 ∧ y.val = 0) ∨ (y.val + 1 = m + + 3 ∧ x.val = 0))) → ((∀ (x : Fin (S.left_n + 3)), ∀ (y : Fin (S.left_n + 3)), (S.il y + = S.il x + 1 ∨ S.il x = S.il y + 1) ↔ (y.val = x.val + 1 ∨ x.val = y.val + 1)) → ((∀ + (x : Fin (S.left_n + 3)), ∀ (y : Fin (S.left_n + 3)), ((x.val + 1 = S.left_n + 3 ∧ + y.val = 0) ∨ (y.val + 1 = S.left_n + 3 ∧ x.val = 0)) ↔ ((S.il x = S.b ∧ S.il y = S.a) + ∨ (S.il y = S.b ∧ S.il x = S.a))) → (∀ (x : Fin (S.left_n + (3 : ℕ))), ∀ (y : Fin + (S.left_n + (3 : ℕ))), y = x + (1 : Fin (S.left_n + (3 : ℕ))) ∨ x = y + (1 : Fin + (S.left_n + (3 : ℕ))) ↔ (S.il y = S.il x + (1 : Fin (n + (3 : ℕ))) ∨ S.il x = S.il y + + (1 : Fin (n + (3 : ℕ)))) ∨ S.il x = S.a ∧ S.il y = S.b ∨ S.il y = S.a ∧ S.il x = + S.b))) ) := by + classical + intro n p S hfinAdj hleftOrd hleftWrap x y + rw [hfinAdj x y, hleftOrd x y, hleftWrap x y] + tauto + +private theorem hrightWrap : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (S.ir + (0 : Fin (S.right_n + 3)) = S.b) → ((S.ir (Fin.last (S.right_n + 2)) = S.a) → (∀ (x : + Fin (S.right_n + (3 : ℕ))), ∀ (y : Fin (S.right_n + (3 : ℕ))), (↑x : ℕ) + (1 : ℕ) = + S.right_n + (3 : ℕ) ∧ (↑y : ℕ) = (0 : ℕ) ∨ (↑y : ℕ) + (1 : ℕ) = S.right_n + (3 : ℕ) ∧ + (↑x : ℕ) = (0 : ℕ) ↔ S.ir x = S.a ∧ S.ir y = S.b ∨ S.ir y = S.a ∧ S.ir x = S.b)) ) := by + classical + intro n p S hrightB hrightA x y + constructor + · rintro (h | h) + · have hx : x = Fin.last (S.right_n + 2) := by + apply Fin.ext + simp only [Fin.val_last] + omega + have hy : y = 0 := Fin.ext (by simpa only [Fin.val_zero] using h.2) + exact Or.inl ⟨by rw [hx, hrightA], by rw [hy, hrightB]⟩ + · have hy : y = Fin.last (S.right_n + 2) := by + apply Fin.ext + simp only [Fin.val_last] + omega + have hx : x = 0 := Fin.ext (by simpa only [Fin.val_zero] using h.2) + exact Or.inr ⟨by rw [hy, hrightA], by rw [hx, hrightB]⟩ + · rintro (h | h) + · have hx : x = Fin.last (S.right_n + 2) := S.ir_injective (h.1.trans hrightA.symm) + have hy : y = 0 := S.ir_injective (h.2.trans hrightB.symm) + subst x + subst y + exact Or.inl ⟨by simp, by simp⟩ + · have hy : y = Fin.last (S.right_n + 2) := S.ir_injective (h.1.trans hrightA.symm) + have hx : x = 0 := S.ir_injective (h.2.trans hrightB.symm) + subst x + subst y + exact Or.inr ⟨by simp, by simp⟩ + +private theorem hrightAdj : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ + {m : Nat}, ∀ (x : Fin (m + 3)), ∀ (y : Fin (m + 3)), (y = x + 1 ∨ x = y + 1) ↔ (y.val + = x.val + 1 ∨ x.val = y.val + 1 ∨ (x.val + 1 = m + 3 ∧ y.val = 0) ∨ (y.val + 1 = m + + 3 ∧ x.val = 0))) → ((∀ (x : Fin (S.right_n + 3)), ∀ (y : Fin (S.right_n + 3)), (x ≠ + y) → ((S.ir y = S.ir x + 1 ∨ S.ir x = S.ir y + 1) ↔ (y.val = x.val + 1 ∨ x.val = + y.val + 1))) → ((∀ (x : Fin (S.right_n + 3)), ∀ (y : Fin (S.right_n + 3)), ((x.val + + 1 = S.right_n + 3 ∧ y.val = 0) ∨ (y.val + 1 = S.right_n + 3 ∧ x.val = 0)) ↔ ((S.ir x + = S.a ∧ S.ir y = S.b) ∨ (S.ir y = S.a ∧ S.ir x = S.b))) → (∀ (x : Fin (S.right_n + (3 + : ℕ))), ∀ (y : Fin (S.right_n + (3 : ℕ))), x ≠ y → (y = x + (1 : Fin (S.right_n + (3 + : ℕ))) ∨ x = y + (1 : Fin (S.right_n + (3 : ℕ))) ↔ (S.ir y = S.ir x + (1 : Fin (n + + (3 : ℕ))) ∨ S.ir x = S.ir y + (1 : Fin (n + (3 : ℕ)))) ∨ S.ir x = S.a ∧ S.ir y = S.b + ∨ S.ir y = S.a ∧ S.ir x = S.b)))) ) := by + classical + intro n p S hfinAdj hrightOrd hrightWrap x y hxy + rw [hfinAdj x y, hrightOrd x y hxy, hrightWrap x y] + tauto + +private theorem hcover : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (i : + Fin (n + (3 : ℕ))), i ∈ Set.range S.il ∨ i ∈ Set.range S.ir ) := by + classical + intro n p S i + have hi : i ∈ (List.ofFn (fun j : Fin (n + 3) => j)).rotate S.rotation := by + rw [List.mem_rotate, List.mem_ofFn] + exact ⟨i, rfl⟩ + rw [S.parent_order] at hi + have hmem : i ∈ List.ofFn S.il ∨ i ∈ List.ofFn S.ir := by + rw [S.left_order, S.right_order] + simp only [List.mem_cons, List.mem_append] at hi ⊢ + tauto + simp only [List.mem_ofFn] at hmem + rcases hmem with ⟨x, hx⟩ | ⟨y, hy⟩ + · exact Or.inl ⟨x, hx⟩ + · exact Or.inr ⟨y, hy⟩ + +private theorem hcrossNoAdj : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + 3 + = S.u.length + S.v.length + 2) → ((S.left_n + 3 = S.u.length + 2) → ((S.right_n + 3 = + S.v.length + 2) → ((∀ (x : Fin (S.left_n + 3)), (S.il x).val = (x.val + S.rotation) % + (n + 3)) → ((∀ (y : Fin (S.right_n + 3)), (S.ir y).val = (S.u.length + 1 + y.val + + S.rotation) % (n + 3)) → ((∀ {m : Nat}, ∀ {r : Nat}, ∀ {x : Nat}, ∀ {y : Nat}, (0 < + m) → ((x < m) → ((y < m) → (((r + x) % m = (r + y) % m) → (x = y))))) → ((∀ + {m : Nat}, ∀ {r : Nat}, ∀ {x : Nat}, (1 < m) → (((r + x) % m + 1) % m = (r + (x + 1)) + % m)) → ((S.il (0 : Fin (S.left_n + 3)) = S.a) → ((S.il (Fin.last (S.left_n + 2)) = + S.b) → ((S.ir (0 : Fin (S.right_n + 3)) = S.b) → ((S.ir (Fin.last (S.right_n + 2)) = + S.a) → ((∀ (z : Fin (n + 3)), (z + 1).val = (z.val + 1) % (n + 3)) → (∀ (x : Fin + (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.right_n + (3 : ℕ))), S.il x ∉ Set.range S.ir → + S.ir y ∉ Set.range S.il → ¬(S.ir y = S.il x + (1 : Fin (n + (3 : ℕ))) ∨ S.il x = S.ir + y + (1 : Fin (n + (3 : ℕ)))))))))))))))) ) := by + classical + intro n p S hlenP hlenL hlenR hleftcoord hrightcoord hmodShift hmodSucc hleftA hleftB hrightB + hrightA hparentSuccVal x y hxNot hyNot + have hx0 : x.val ≠ 0 := by + intro hx + apply hxNot + have hx' : x = 0 := Fin.ext (by simpa only [Fin.val_zero] using hx) + rw [hx', hleftA] + exact ⟨Fin.last (S.right_n + 2), hrightA⟩ + have hxlast : x.val ≠ S.left_n + 2 := by + intro hx + apply hxNot + have hx' : x = Fin.last (S.left_n + 2) := by + apply Fin.ext + simp only [Fin.val_last] + omega + rw [hx', hleftB] + exact ⟨0, hrightB⟩ + have hxlo : 1 ≤ x.val := by omega + have hxlt : x.val < S.u.length + 2 := by rw [← hlenL]; exact x.isLt + have hxhi : x.val ≤ S.u.length := by omega + have hy0 : y.val ≠ 0 := by + intro hy + apply hyNot + have hy' : y = 0 := Fin.ext (by simpa only [Fin.val_zero] using hy) + rw [hy', hrightB] + exact ⟨Fin.last (S.left_n + 2), hleftB⟩ + have hylast : y.val ≠ S.right_n + 2 := by + intro hy + apply hyNot + have hy' : y = Fin.last (S.right_n + 2) := by + apply Fin.ext + simp only [Fin.val_last] + omega + rw [hy', hrightA] + exact ⟨0, hleftA⟩ + have hylo : 1 ≤ y.val := by omega + have hylt : y.val < S.v.length + 2 := by rw [← hlenR]; exact y.isLt + have hyhi : y.val ≤ S.v.length := by omega + have hxCoord : (S.il x).val = (S.rotation + x.val) % (n + 3) := by + simpa only [Nat.add_comm] using hleftcoord x + have hyCoord : (S.ir y).val = + (S.rotation + (S.u.length + 1 + y.val)) % (n + 3) := by + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hrightcoord y + have hM : S.u.length + S.v.length + 2 = n + 3 := by omega + have hoff : S.u.length + 1 + y.val < n + 3 := by omega + have hsucc := hmodSucc (m := n + 3) (by omega) (r := S.rotation) (x := x.val) + intro h + rcases h with h | h + · have hv := congrArg Fin.val h + rw [hparentSuccVal] at hv + have he : (S.rotation + (x.val + 1)) % (n + 3) = + (S.rotation + (S.u.length + 1 + y.val)) % (n + 3) := by + calc + (S.rotation + (x.val + 1)) % (n + 3) = + ((S.rotation + x.val) % (n + 3) + 1) % (n + 3) := hsucc.symm + _ = ((S.il x).val + 1) % (n + 3) := by rw [hxCoord] + _ = (S.ir y).val := hv.symm + _ = _ := hyCoord + have hpos := hmodShift (m := n + 3) (r := S.rotation) + (x := x.val + 1) (y := S.u.length + 1 + y.val) + (by omega) (by omega) hoff he + omega + · have hv := congrArg Fin.val h + rw [hparentSuccVal] at hv + let q := S.u.length + 1 + y.val + have hsuccQ := hmodSucc (m := n + 3) (by omega) (r := S.rotation) (x := q) + have he : (S.rotation + (q + 1)) % (n + 3) = + (S.rotation + x.val) % (n + 3) := by + calc + (S.rotation + (q + 1)) % (n + 3) = + ((S.rotation + q) % (n + 3) + 1) % (n + 3) := hsuccQ.symm + _ = ((S.ir y).val + 1) % (n + 3) := by rw [hyCoord] + _ = (S.il x).val := hv.symm + _ = _ := hxCoord + by_cases hq : q + 1 < n + 3 + · have hpos := hmodShift (m := n + 3) (r := S.rotation) + (x := q + 1) (y := x.val) (by omega) hq (by omega) he + dsimp [q] at hpos + omega + · have hqM : q + 1 = n + 3 := by omega + have hzero : (S.rotation + 0) % (n + 3) = + (S.rotation + x.val) % (n + 3) := by simpa [hqM] using he + have hpos := hmodShift (m := n + 3) (r := S.rotation) + (x := 0) (y := x.val) (by omega) (by omega) (by omega) hzero + omega + +private theorem hparentPairCover : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ (i + : Fin (n + 3)), i ∈ Set.range S.il ∨ i ∈ Set.range S.ir) → ((∀ (x : Fin (S.left_n + + 3)), ∀ (y : Fin (S.right_n + 3)), (S.il x ∉ Set.range S.ir) → ((S.ir y ∉ Set.range + S.il) → (¬(S.ir y = S.il x + 1 ∨ S.il x = S.ir y + 1)))) → (∀ (i : Fin (n + (3 : + ℕ))), ∀ (j : Fin (n + (3 : ℕ))), j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin + (n + (3 : ℕ))) → i ∈ Set.range S.il ∧ j ∈ Set.range S.il ∨ i ∈ Set.range S.ir ∧ j ∈ + Set.range S.ir)) ) := by + classical + intro n p S hcover hcrossNoAdj i j hij + rcases hcover i with hiL | hiR <;> rcases hcover j with hjL | hjR + · exact Or.inl ⟨hiL, hjL⟩ + · by_cases hiR' : i ∈ Set.range S.ir + · exact Or.inr ⟨hiR', hjR⟩ + · by_cases hjL' : j ∈ Set.range S.il + · exact Or.inl ⟨hiL, hjL'⟩ + · rcases hiL with ⟨x, rfl⟩ + rcases hjR with ⟨y, rfl⟩ + exact False.elim (hcrossNoAdj x y hiR' hjL' (by + rcases hij with h | h + · exact Or.inl h + · exact Or.inr h)) + · by_cases hiL' : i ∈ Set.range S.il + · exact Or.inl ⟨hiL', hjL⟩ + · by_cases hjR' : j ∈ Set.range S.ir + · exact Or.inr ⟨hiR, hjR'⟩ + · rcases hjL with ⟨x, rfl⟩ + rcases hiR with ⟨y, rfl⟩ + have hcross := hcrossNoAdj x y hjR' hiL' + apply False.elim (hcross ?_) + rcases hij with h | h + · exact Or.inr h + · exact Or.inl h + · exact Or.inr ⟨hiR, hjR⟩ + +private theorem hdiagPair : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (S.il + (0 : Fin (S.left_n + 3)) = S.a) → ((S.il (Fin.last (S.left_n + 2)) = S.b) → ((S.ir (0 + : Fin (S.right_n + 3)) = S.b) → ((S.ir (Fin.last (S.right_n + 2)) = S.a) → (∀ (i : + Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ≠ j → (i ∈ Set.range S.il ∧ i ∈ + Set.range S.ir ∧ j ∈ Set.range S.il ∧ j ∈ Set.range S.ir ↔ i = S.a ∧ j = S.b ∨ i = + S.b ∧ j = S.a))))) ) := by + classical + intro n p S hleftA hleftB hrightB hrightA i j hij + constructor + · rintro ⟨hiL, hiR, hjL, hjR⟩ + have hi : i ∈ ({S.a, S.b} : Set (Fin (n + 3))) := by + have hh : i ∈ Set.range S.il ∩ Set.range S.ir := ⟨hiL, hiR⟩ + rw [S.common_indices] at hh + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hh + have hj : j ∈ ({S.a, S.b} : Set (Fin (n + 3))) := by + have hh : j ∈ Set.range S.il ∩ Set.range S.ir := ⟨hjL, hjR⟩ + rw [S.common_indices] at hh + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hh + rcases hi with hia | hib <;> rcases hj with hja | hjb + · subst i + subst j + exact False.elim (hij rfl) + · exact Or.inl ⟨hia, hjb⟩ + · exact Or.inr ⟨hib, hja⟩ + · subst i + subst j + exact False.elim (hij rfl) + · rintro (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩) + · exact ⟨⟨0, hleftA⟩, ⟨Fin.last (S.right_n + 2), hrightA⟩, + ⟨Fin.last (S.left_n + 2), hleftB⟩, ⟨0, hrightB⟩⟩ + · exact ⟨⟨Fin.last (S.left_n + 2), hleftB⟩, ⟨0, hrightB⟩, + ⟨0, hleftA⟩, ⟨Fin.last (S.right_n + 2), hrightA⟩⟩ + +private theorem hleftCountImage : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), ∀ (x : Fin + (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.left_n + (3 : ℕ))), x ≠ y → {k : Fin L.count | + S.il x ∈ Set.range (S.il ∘ L.face k) ∧ S.il y ∈ Set.range (S.il ∘ L.face k)}.ncard = + if y = x + (1 : Fin (S.left_n + (3 : ℕ))) ∨ x = y + (1 : Fin (S.left_n + (3 : ℕ))) + then (1 : ℕ) else if ∃ (k : Fin L.count), x ∈ Set.range (L.face k) ∧ y ∈ Set.range + (L.face k) then (2 : ℕ) else (0 : ℕ) ) := by + classical + intro n p S XL L x y hxy + have hset : {k : Fin L.count | + S.il x ∈ Set.range (S.il ∘ L.face k) ∧ + S.il y ∈ Set.range (S.il ∘ L.face k)} = + {k : Fin L.count | x ∈ Set.range (L.face k) ∧ y ∈ Set.range (L.face k)} := by + ext k + simp only [Set.mem_ofPred_eq] + constructor + · rintro ⟨hx, hy⟩ + constructor + · simp only [Set.mem_range] at hx ⊢ + obtain ⟨z, hz⟩ := hx + exact ⟨z, S.il_injective (by simpa only [Function.comp_apply] using hz)⟩ + · simp only [Set.mem_range] at hy ⊢ + obtain ⟨z, hz⟩ := hy + exact ⟨z, S.il_injective (by simpa only [Function.comp_apply] using hz)⟩ + · rintro ⟨hx, hy⟩ + constructor + · simp only [Set.mem_range] at hx ⊢ + obtain ⟨z, hz⟩ := hx + exact ⟨z, by simpa only [Function.comp_apply] using congrArg S.il hz⟩ + · simp only [Set.mem_range] at hy ⊢ + obtain ⟨z, hz⟩ := hy + exact ⟨z, by simpa only [Function.comp_apply] using congrArg S.il hz⟩ + rw [hset] + exact L.edge_count x y hxy + +private theorem hrightCountImage : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), ∀ (x : Fin + (S.right_n + (3 : ℕ))), ∀ (y : Fin (S.right_n + (3 : ℕ))), x ≠ y → {k : Fin R.count | + S.ir x ∈ Set.range (S.ir ∘ R.face k) ∧ S.ir y ∈ Set.range (S.ir ∘ R.face k)}.ncard = + if y = x + (1 : Fin (S.right_n + (3 : ℕ))) ∨ x = y + (1 : Fin (S.right_n + (3 : ℕ))) + then (1 : ℕ) else if ∃ (k : Fin R.count), x ∈ Set.range (R.face k) ∧ y ∈ Set.range + (R.face k) then (2 : ℕ) else (0 : ℕ) ) := by + classical + intro n p S XR R x y hxy + have hset : {k : Fin R.count | + S.ir x ∈ Set.range (S.ir ∘ R.face k) ∧ + S.ir y ∈ Set.range (S.ir ∘ R.face k)} = + {k : Fin R.count | x ∈ Set.range (R.face k) ∧ y ∈ Set.range (R.face k)} := by + ext k + simp only [Set.mem_ofPred_eq] + constructor + · rintro ⟨hx, hy⟩ + constructor + · simp only [Set.mem_range] at hx ⊢ + obtain ⟨z, hz⟩ := hx + exact ⟨z, S.ir_injective (by simpa only [Function.comp_apply] using hz)⟩ + · simp only [Set.mem_range] at hy ⊢ + obtain ⟨z, hz⟩ := hy + exact ⟨z, S.ir_injective (by simpa only [Function.comp_apply] using hz)⟩ + · rintro ⟨hx, hy⟩ + constructor + · simp only [Set.mem_range] at hx ⊢ + obtain ⟨z, hz⟩ := hx + exact ⟨z, by simpa only [Function.comp_apply] using congrArg S.ir hz⟩ + · simp only [Set.mem_range] at hy ⊢ + obtain ⟨z, hz⟩ := hy + exact ⟨z, by simpa only [Function.comp_apply] using congrArg S.ir hz⟩ + rw [hset] + exact R.edge_count x y hxy + +private theorem hleftZero : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), ∀ (i : Fin (n + (3 + : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∉ Set.range S.il → {k : Fin L.count | i ∈ + Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)}.ncard = (0 : ℕ) ) := by + classical + intro n p S XL L i j hi + have hempty : {k : Fin L.count | + i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = ∅ := by + ext k + simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false] + constructor + · rintro ⟨hik, _⟩ + apply hi + obtain ⟨z, hz⟩ := Set.mem_range.mp hik + exact ⟨L.face k z, hz⟩ + · intro h + exact False.elim h + rw [hempty] + simp + +private theorem hrightZero : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), ∀ (i : Fin (n + + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∉ Set.range S.ir → {k : Fin R.count | i ∈ + Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)}.ncard = (0 : ℕ) ) := by + classical + intro n p S XR R i j hi + have hempty : {k : Fin R.count | + i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = ∅ := by + ext k + simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false] + constructor + · rintro ⟨hik, _⟩ + apply hi + obtain ⟨z, hz⟩ := Set.mem_range.mp hik + exact ⟨R.face k z, hz⟩ + · intro h + exact False.elim h + rw [hempty] + simp + +private theorem husedSplit : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + ∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (∃ (k : Fin (L.count + R.count)), i + ∈ Set.range (f k) ∧ j ∈ Set.range (f k)) ↔ (∃ (k : Fin L.count), i ∈ Set.range (S.il + ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)) ∨ ∃ (k : Fin R.count), i ∈ Set.range + (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k) ) := by + classical + intro n p S XL XR L R f i j + constructor + · rintro ⟨k, hk⟩ + refine Fin.addCases + (motive := fun k => + (i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)) → + (∃ k : Fin L.count, i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face + k)) ∨ + (∃ k : Fin R.count, i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face + k))) + (fun a ha => Or.inl ⟨a, by simpa only [f, Fin.addCases_left] using ha⟩) + (fun b hb => Or.inr ⟨b, by simpa only [f, Fin.addCases_right] using hb⟩) k hk + · rintro (⟨a, ha⟩ | ⟨b, hb⟩) + · refine ⟨Fin.castAdd R.count a, ?_⟩ + simpa only [f, Fin.addCases_left] using ha + · refine ⟨Fin.natAdd L.count b, ?_⟩ + simpa only [f, Fin.addCases_right] using hb + +private theorem hleftFaceMem : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), ∀ (x : Fin + (S.left_n + (3 : ℕ))), ∀ (k : Fin L.count), S.il x ∈ Set.range (S.il ∘ L.face k) ↔ x + ∈ Set.range (L.face k) ) := by + classical + intro n p S XL L x k + simp only [Set.mem_range] + constructor + · rintro ⟨z, hz⟩ + exact ⟨z, S.il_injective (by simpa only [Function.comp_apply] using hz)⟩ + · rintro ⟨z, hz⟩ + exact ⟨z, by simpa only [Function.comp_apply] using congrArg S.il hz⟩ + +private theorem hrightFaceMem : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), ∀ (x : Fin + (S.right_n + (3 : ℕ))), ∀ (k : Fin R.count), S.ir x ∈ Set.range (S.ir ∘ R.face k) ↔ x + ∈ Set.range (R.face k) ) := by + classical + intro n p S XR R x k + simp only [Set.mem_range] + constructor + · rintro ⟨z, hz⟩ + exact ⟨z, S.ir_injective (by simpa only [Function.comp_apply] using hz)⟩ + · rintro ⟨z, hz⟩ + exact ⟨z, by simpa only [Function.comp_apply] using congrArg S.ir hz⟩ + +private theorem hleftUsedMap : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (x : Fin + (S.left_n + 3)), ∀ (k : Fin L.count), S.il x ∈ Set.range (S.il ∘ L.face k) ↔ x ∈ + Set.range (L.face k)) → (∀ (x : Fin (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.left_n + (3 + : ℕ))), (∃ (k : Fin L.count), x ∈ Set.range (L.face k) ∧ y ∈ Set.range (L.face k)) ↔ + ∃ (k : Fin L.count), S.il x ∈ Set.range (S.il ∘ L.face k) ∧ S.il y ∈ Set.range (S.il + ∘ L.face k)) ) := by + classical + intro n p S XL L hleftFaceMem x y + constructor + · rintro ⟨k, hx, hy⟩ + exact ⟨k, (hleftFaceMem x k).2 hx, (hleftFaceMem y k).2 hy⟩ + · rintro ⟨k, hx, hy⟩ + exact ⟨k, (hleftFaceMem x k).1 hx, (hleftFaceMem y k).1 hy⟩ + +private theorem hrightUsedMap : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (∀ (x : Fin + (S.right_n + 3)), ∀ (k : Fin R.count), S.ir x ∈ Set.range (S.ir ∘ R.face k) ↔ x ∈ + Set.range (R.face k)) → (∀ (x : Fin (S.right_n + (3 : ℕ))), ∀ (y : Fin (S.right_n + + (3 : ℕ))), (∃ (k : Fin R.count), x ∈ Set.range (R.face k) ∧ y ∈ Set.range (R.face k)) + ↔ ∃ (k : Fin R.count), S.ir x ∈ Set.range (S.ir ∘ R.face k) ∧ S.ir y ∈ Set.range + (S.ir ∘ R.face k)) ) := by + classical + intro n p S XR R hrightFaceMem x y + constructor + · rintro ⟨k, hx, hy⟩ + exact ⟨k, (hrightFaceMem x k).2 hx, (hrightFaceMem y k).2 hy⟩ + · rintro ⟨k, hx, hy⟩ + exact ⟨k, (hrightFaceMem x k).1 hx, (hrightFaceMem y k).1 hy⟩ + +private theorem hleftCountMapped : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (x : Fin + (S.left_n + 3)), ∀ (y : Fin (S.left_n + 3)), (y = x + 1 ∨ x = y + 1) ↔ (S.il y = S.il + x + 1 ∨ S.il x = S.il y + 1) ∨ (S.il x = S.a ∧ S.il y = S.b) ∨ (S.il y = S.a ∧ S.il x + = S.b)) → ((∀ (x : Fin (S.left_n + 3)), ∀ (y : Fin (S.left_n + 3)), (x ≠ y) → + (Set.ncard {k : Fin L.count | S.il x ∈ Set.range (S.il ∘ L.face k) ∧ S.il y ∈ + Set.range (S.il ∘ L.face k)} = if y = x + 1 ∨ x = y + 1 then 1 else if ∃ k, x ∈ + Set.range (L.face k) ∧ y ∈ Set.range (L.face k) then 2 else 0)) → ((∀ (x : Fin + (S.left_n + 3)), ∀ (y : Fin (S.left_n + 3)), (∃ k : Fin L.count, x ∈ Set.range + (L.face k) ∧ y ∈ Set.range (L.face k)) ↔ (∃ k : Fin L.count, S.il x ∈ Set.range (S.il + ∘ L.face k) ∧ S.il y ∈ Set.range (S.il ∘ L.face k))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ + (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.il → j ∈ Set.range S.il → i ≠ j → {k : Fin + L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)}.ncard = + if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i = S.a ∧ j = + S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin L.count), i ∈ Set.range (S.il + ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k) then (2 : ℕ) else (0 : ℕ)))) ) := by + classical + intro n p S XL L hleftAdj hleftCountImage hleftUsedMap i j hi hj hij + obtain ⟨x, hx⟩ := hi + obtain ⟨y, hy⟩ := hj + have hxy : x ≠ y := by + intro h + apply hij + rw [← hx, ← hy, h] + have hAdj : (y = x + 1 ∨ x = y + 1) ↔ + (j = i + 1 ∨ i = j + 1) ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) := by + simpa only [hx, hy] using hleftAdj x y + simpa only [hx, hy, hAdj, hleftUsedMap x y, or_assoc] using hleftCountImage x y hxy + +private theorem hrightCountMapped : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (∀ (x : Fin + (S.right_n + 3)), ∀ (y : Fin (S.right_n + 3)), (x ≠ y) → ((y = x + 1 ∨ x = y + 1) ↔ + (S.ir y = S.ir x + 1 ∨ S.ir x = S.ir y + 1) ∨ (S.ir x = S.a ∧ S.ir y = S.b) ∨ (S.ir y + = S.a ∧ S.ir x = S.b))) → ((∀ (x : Fin (S.right_n + 3)), ∀ (y : Fin (S.right_n + 3)), + (x ≠ y) → (Set.ncard {k : Fin R.count | S.ir x ∈ Set.range (S.ir ∘ R.face k) ∧ S.ir y + ∈ Set.range (S.ir ∘ R.face k)} = if y = x + 1 ∨ x = y + 1 then 1 else if ∃ k, x ∈ + Set.range (R.face k) ∧ y ∈ Set.range (R.face k) then 2 else 0)) → ((∀ (x : Fin + (S.right_n + 3)), ∀ (y : Fin (S.right_n + 3)), (∃ k : Fin R.count, x ∈ Set.range + (R.face k) ∧ y ∈ Set.range (R.face k)) ↔ (∃ k : Fin R.count, S.ir x ∈ Set.range (S.ir + ∘ R.face k) ∧ S.ir y ∈ Set.range (S.ir ∘ R.face k))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ + (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.ir → j ∈ Set.range S.ir → i ≠ j → {k : Fin + R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)}.ncard = + if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i = S.a ∧ j = + S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin R.count), i ∈ Set.range (S.ir + ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k) then (2 : ℕ) else (0 : ℕ)))) ) := by + classical + intro n p S XR R hrightAdj hrightCountImage hrightUsedMap i j hi hj hij + obtain ⟨x, hx⟩ := hi + obtain ⟨y, hy⟩ := hj + have hxy : x ≠ y := by + intro h + apply hij + rw [← hx, ← hy, h] + have hAdj : (y = x + 1 ∨ x = y + 1) ↔ + (j = i + 1 ∨ i = j + 1) ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) := by + simpa only [hx, hy] using hrightAdj x y hxy + simpa only [hx, hy, hAdj, hrightUsedMap x y, or_assoc] using hrightCountImage x y hxy + +private theorem hleftZeroPair : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), ∀ (i : Fin (n + (3 + : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ¬(i ∈ Set.range S.il ∧ j ∈ Set.range S.il) → {k : + Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face + k)}.ncard = (0 : ℕ) ) := by + classical + intro n p S XL L i j hno + have hempty : {k : Fin L.count | + i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = ∅ := by + ext k + simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false] + constructor + · rintro ⟨hik, hjk⟩ + apply hno + constructor + · obtain ⟨z, hz⟩ := Set.mem_range.mp hik + exact ⟨L.face k z, by simpa only [Function.comp_apply] using hz⟩ + · obtain ⟨z, hz⟩ := Set.mem_range.mp hjk + exact ⟨L.face k z, by simpa only [Function.comp_apply] using hz⟩ + · intro h + exact False.elim h + rw [hempty] + simp + +private theorem hrightZeroPair : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), ∀ (i : Fin (n + + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ¬(i ∈ Set.range S.ir ∧ j ∈ Set.range S.ir) → {k + : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face + k)}.ncard = (0 : ℕ) ) := by + classical + intro n p S XR R i j hno + have hempty : {k : Fin R.count | + i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = ∅ := by + ext k + simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false] + constructor + · rintro ⟨hik, hjk⟩ + apply hno + constructor + · obtain ⟨z, hz⟩ := Set.mem_range.mp hik + exact ⟨R.face k z, by simpa only [Function.comp_apply] using hz⟩ + · obtain ⟨z, hz⟩ := Set.mem_range.mp hjk + exact ⟨R.face k z, by simpa only [Function.comp_apply] using hz⟩ + · intro h + exact False.elim h + rw [hempty] + simp + +private theorem hnotDiagBoundary : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (S.il + (0 : Fin (S.left_n + 3)) = S.a) → ((S.il (Fin.last (S.left_n + 2)) = S.b) → ((∀ (x : + Fin (S.left_n + 3)), ∀ (y : Fin (S.left_n + 3)), (S.il y = S.il x + 1 ∨ S.il x = S.il + y + 1) ↔ (y.val = x.val + 1 ∨ x.val = y.val + 1)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j + : Fin (n + (3 : ℕ))), i = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b → ¬(j = i + (1 : Fin (n + + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))))))) ) := by + classical + intro n p S hleftA hleftB hleftOrd i j hdiag + rcases hdiag with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · intro h + have hlocal : S.il (Fin.last (S.left_n + 2)) = + S.il (0 : Fin (S.left_n + 3)) + 1 ∨ + S.il (0 : Fin (S.left_n + 3)) = + S.il (Fin.last (S.left_n + 2)) + 1 := by + simpa only [hleftA, hleftB] using h + have hnum := (hleftOrd (0 : Fin (S.left_n + 3)) (Fin.last (S.left_n + 2))).mp hlocal + have hu : 0 < S.u.length := S.hu + simp only [Fin.val_zero, Fin.val_last] at hnum + omega + · intro h + have hlocal : S.il (0 : Fin (S.left_n + 3)) = + S.il (Fin.last (S.left_n + 2)) + 1 ∨ + S.il (Fin.last (S.left_n + 2)) = + S.il (0 : Fin (S.left_n + 3)) + 1 := by + simpa only [hleftA, hleftB] using h + have hnum := (hleftOrd (Fin.last (S.left_n + 2)) (0 : Fin (S.left_n + 3))).mp hlocal + have hu : 0 < S.u.length := S.hu + simp only [Fin.val_zero, Fin.val_last] at hnum + omega + +private theorem hnotDiag : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ (i + : Fin (n + 3)), ∀ (j : Fin (n + 3)), ((i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b)) → + (¬(j = i + 1 ∨ i = j + 1))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), + (j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ)))) → (¬ ((i = S.a ∧ + j = S.b) ∨ (j = S.a ∧ i = S.b)))) ) := by + classical + intro n p S hnotDiagBoundary i j hboundary hd + exact hnotDiagBoundary i j hd hboundary + +private theorem hnoRAt1159 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ (i + : Fin (n + 3)), ∀ (j : Fin (n + 3)), (i ≠ j) → ((i ∈ Set.range S.il ∧ i ∈ Set.range + S.ir ∧ j ∈ Set.range S.il ∧ j ∈ Set.range S.ir) ↔ ((i = S.a ∧ j = S.b) ∨ (i = S.b ∧ j + = S.a)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((¬ ((i + = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b))) → ((i ∈ Set.range S.il) → ((j ∈ Set.range + S.il) → (¬ (i ∈ Set.range S.ir ∧ j ∈ Set.range S.ir)))))) ) := by + classical + intro n p S hdiagPair i j hij hnotDiag hiL hjL hboth + have hd := (hdiagPair i j hij).1 ⟨hiL, hboth.1, hjL, hboth.2⟩ + have hd' : (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) := by + rcases hd with h | h + · exact Or.inl h + · exact Or.inr ⟨h.2, h.1⟩ + exact hnotDiag hd' + +private theorem hcountLAt1167 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (i : Fin (n + + 3)), ∀ (j : Fin (n + 3)), (i ∈ Set.range S.il) → ((j ∈ Set.range S.il) → ((i ≠ j) → + (Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ + L.face k)} = if j = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) + then 1 else if ∃ k : Fin L.count, i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range + (S.il ∘ L.face k) then 2 else 0)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 + : ℕ))), (i ≠ j) → ((j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : + ℕ)))) → ((i ∈ Set.range S.il) → ((j ∈ Set.range S.il) → (Set.ncard {k : Fin L.count | + i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = 1))))) ) := by + classical + intro n p S XL L hleftCountMapped i j hij hboundary hiL hjL + have h := hleftCountMapped i j hiL hjL hij + have hs : j = i + 1 ∨ i = j + 1 ∨ + (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) := by + rcases hboundary with h | h + · exact Or.inl h + · exact Or.inr (Or.inl h) + rw [ite_eq_left hs] at h + exact h + +private theorem hnoLAt1180 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ (i + : Fin (n + 3)), ∀ (j : Fin (n + 3)), (i ≠ j) → ((i ∈ Set.range S.il ∧ i ∈ Set.range + S.ir ∧ j ∈ Set.range S.il ∧ j ∈ Set.range S.ir) ↔ ((i = S.a ∧ j = S.b) ∨ (i = S.b ∧ j + = S.a)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((¬ ((i + = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b))) → ((i ∈ Set.range S.ir) → ((j ∈ Set.range + S.ir) → (¬ (i ∈ Set.range S.il ∧ j ∈ Set.range S.il)))))) ) := by + classical + intro n p S hdiagPair i j hij hnotDiag hiR hjR hboth + have hd := (hdiagPair i j hij).1 ⟨hboth.1, hiR, hboth.2, hjR⟩ + have hd' : (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) := by + rcases hd with h | h + · exact Or.inl h + · exact Or.inr ⟨h.2, h.1⟩ + exact hnotDiag hd' + +private theorem hcountRAt1188 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (∀ (i : Fin (n + + 3)), ∀ (j : Fin (n + 3)), (i ∈ Set.range S.ir) → ((j ∈ Set.range S.ir) → ((i ≠ j) → + (Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ + R.face k)} = if j = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) + then 1 else if ∃ k : Fin R.count, i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range + (S.ir ∘ R.face k) then 2 else 0)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 + : ℕ))), (i ≠ j) → ((j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : + ℕ)))) → ((i ∈ Set.range S.ir) → ((j ∈ Set.range S.ir) → (Set.ncard {k : Fin R.count | + i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = 1))))) ) := by + classical + intro n p S XR R hrightCountMapped i j hij hboundary hiR hjR + have h := hrightCountMapped i j hiR hjR hij + have hs : j = i + 1 ∨ i = j + 1 ∨ + (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) := by + rcases hboundary with h | h + · exact Or.inl h + · exact Or.inr (Or.inl h) + rw [ite_eq_left hs] at h + exact h + +private theorem hdiag' : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (i : + Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i = S.a ∧ j = S.b ∨ j = S.a ∧ i = + S.b) → ((i = S.a ∧ j = S.b) ∨ (i = S.b ∧ j = S.a)) ) := by + classical + intro n p S i j hdiag + rcases hdiag with h | h + · exact Or.inl h + · exact Or.inr ⟨h.2, h.1⟩ + +private theorem hcountLAt1209 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (i : Fin (n + + 3)), ∀ (j : Fin (n + 3)), (i ∈ Set.range S.il) → ((j ∈ Set.range S.il) → ((i ≠ j) → + (Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ + L.face k)} = if j = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) + then 1 else if ∃ k : Fin L.count, i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range + (S.il ∘ L.face k) then 2 else 0)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 + : ℕ))), (i ≠ j) → ((i = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b) → ((i ∈ Set.range S.il) → + ((j ∈ Set.range S.il) → (Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) + ∧ j ∈ Set.range (S.il ∘ L.face k)} = 1))))) ) := by + classical + intro n p S XL L hleftCountMapped i j hij hdiag hiL hjL + have h := hleftCountMapped i j hiL hjL hij + have hs : j = i + 1 ∨ i = j + 1 ∨ + (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) := by + rcases hdiag with h | h + · exact Or.inr (Or.inr (Or.inl h)) + · exact Or.inr (Or.inr (Or.inr h)) + rw [ite_eq_left hs] at h + exact h + +private theorem hcountRAt1219 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (∀ (i : Fin (n + + 3)), ∀ (j : Fin (n + 3)), (i ∈ Set.range S.ir) → ((j ∈ Set.range S.ir) → ((i ≠ j) → + (Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ + R.face k)} = if j = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) + then 1 else if ∃ k : Fin R.count, i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range + (S.ir ∘ R.face k) then 2 else 0)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 + : ℕ))), (i ≠ j) → ((i = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b) → ((i ∈ Set.range S.ir) → + ((j ∈ Set.range S.ir) → (Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) + ∧ j ∈ Set.range (S.ir ∘ R.face k)} = 1))))) ) := by + classical + intro n p S XR R hrightCountMapped i j hij hdiag hiR hjR + have h := hrightCountMapped i j hiR hjR hij + have hs : j = i + 1 ∨ i = j + 1 ∨ + (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) := by + rcases hdiag with h | h + · exact Or.inr (Or.inr (Or.inl h)) + · exact Or.inr (Or.inr (Or.inr h)) + rw [ite_eq_left hs] at h + exact h + +private theorem hcountAt1229 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + ∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ({k : Fin (L.count + R.count) | i ∈ + Set.range (f k) ∧ j ∈ Set.range (f k)}.ncard = {k : Fin L.count | i ∈ Set.range (S.il + ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)}.ncard + {k : Fin R.count | i ∈ + Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)}.ncard) → ((Set.ncard + {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} + = 1) → ((Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range + (S.ir ∘ R.face k)} = 1) → (Set.ncard {k : Fin (L.count + R.count) | i ∈ Set.range (f + k) ∧ j ∈ Set.range (f k)} = 2))) ) := by + classical + intro n p S XL XR L R f i j htotal hcountL hcountR + rw [htotal, hcountL, hcountR] + +private theorem hused : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + ∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (Set.ncard {k : Fin (L.count + + R.count) | i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)} = 2) → (∃ k : Fin (L.count + + R.count), i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)) ) := by + classical + intro n p S XL XR L R f i j hcount + have hp : 0 < Set.ncard {k : Fin (L.count + R.count) | + i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)} := by rw [hcount]; omega + obtain ⟨k, hk⟩ := (Set.ncard_pos (Set.toFinite _)).mp hp + exact ⟨k, hk⟩ + +private theorem hNoSpecial : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (i : + Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (¬(j = i + (1 : Fin (n + (3 : ℕ))) ∨ i + = j + (1 : Fin (n + (3 : ℕ))))) → ((¬(i = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b)) → (¬ (j + = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b)))) ) := by + classical + intro n p S i j hboundary hdiag hs + rcases hs with hfirst | hrest + · exact hboundary (Or.inl hfirst) + · rcases hrest with hsecond | hrest + · exact hboundary (Or.inr hsecond) + · rcases hrest with hthird | hfourth + · exact hdiag (Or.inl hthird) + · exact hdiag (Or.inr hfourth) + +private theorem hiL : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), ∀ (i : Fin (n + (3 + : ℕ))), ∀ (k : Fin L.count), (i ∈ Set.range (S.il ∘ L.face k)) → (i ∈ Set.range S.il) + ) := by + classical + intro n p S XL L i k hik + obtain ⟨z, hz⟩ := Set.mem_range.mp hik + exact ⟨L.face k z, by simpa only [Function.comp_apply] using hz⟩ + +private theorem hjL : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), ∀ (j : Fin (n + (3 + : ℕ))), ∀ (k : Fin L.count), (j ∈ Set.range (S.il ∘ L.face k)) → (j ∈ Set.range S.il) + ) := by + classical + intro n p S XL L j k hjk + obtain ⟨z, hz⟩ := Set.mem_range.mp hjk + exact ⟨L.face k z, by simpa only [Function.comp_apply] using hz⟩ + +private theorem hnoRAt1259 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ (i + : Fin (n + 3)), ∀ (j : Fin (n + 3)), (i ≠ j) → ((i ∈ Set.range S.il ∧ i ∈ Set.range + S.ir ∧ j ∈ Set.range S.il ∧ j ∈ Set.range S.ir) ↔ ((i = S.a ∧ j = S.b) ∨ (i = S.b ∧ j + = S.a)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((¬(i = + S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b)) → ((i ∈ Set.range S.il) → ((j ∈ Set.range S.il) → + (¬ (i ∈ Set.range S.ir ∧ j ∈ Set.range S.ir)))))) ) := by + classical + intro n p S hdiagPair i j hij hdiag hiL hjL hh + have hd := (hdiagPair i j hij).1 ⟨hiL, hh.1, hjL, hh.2⟩ + have hd' : (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) := by + rcases hd with h | h + · exact Or.inl h + · exact Or.inr ⟨h.2, h.1⟩ + exact hdiag hd' + +private theorem hcountLAt1267 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (i : Fin (n + + 3)), ∀ (j : Fin (n + 3)), (i ∈ Set.range S.il) → ((j ∈ Set.range S.il) → ((i ≠ j) → + (Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ + L.face k)} = if j = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) + then 1 else if ∃ k : Fin L.count, i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range + (S.il ∘ L.face k) then 2 else 0)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 + : ℕ))), (i ≠ j) → ((¬ (j = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = + S.b))) → (∀ (k : Fin L.count), (i ∈ Set.range (S.il ∘ L.face k)) → ((j ∈ Set.range + (S.il ∘ L.face k)) → ((i ∈ Set.range S.il) → ((j ∈ Set.range S.il) → (Set.ncard {k : + Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = + 2))))))) ) := by + classical + intro n p S XL L hleftCountMapped i j hij hNoSpecial k hik hjk hiL hjL + have h := hleftCountMapped i j hiL hjL hij + have hfacePair : ∃ k : Fin L.count, + i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k) := + ⟨k, hik, hjk⟩ + rw [ite_eq_right hNoSpecial, ite_eq_left hfacePair] at h + exact h + +private theorem hiR : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), ∀ (i : Fin (n + + (3 : ℕ))), ∀ (k : Fin R.count), (i ∈ Set.range (S.ir ∘ R.face k)) → (i ∈ Set.range + S.ir) ) := by + classical + intro n p S XR R i k hik + obtain ⟨z, hz⟩ := Set.mem_range.mp hik + exact ⟨R.face k z, by simpa only [Function.comp_apply] using hz⟩ + +private theorem hjR : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), ∀ (j : Fin (n + + (3 : ℕ))), ∀ (k : Fin R.count), (j ∈ Set.range (S.ir ∘ R.face k)) → (j ∈ Set.range + S.ir) ) := by + classical + intro n p S XR R j k hjk + obtain ⟨z, hz⟩ := Set.mem_range.mp hjk + exact ⟨R.face k z, by simpa only [Function.comp_apply] using hz⟩ + +private theorem hnoLAt1285 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ (i + : Fin (n + 3)), ∀ (j : Fin (n + 3)), (i ≠ j) → ((i ∈ Set.range S.il ∧ i ∈ Set.range + S.ir ∧ j ∈ Set.range S.il ∧ j ∈ Set.range S.ir) ↔ ((i = S.a ∧ j = S.b) ∨ (i = S.b ∧ j + = S.a)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((¬(i = + S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b)) → ((i ∈ Set.range S.ir) → ((j ∈ Set.range S.ir) → + (¬ (i ∈ Set.range S.il ∧ j ∈ Set.range S.il)))))) ) := by + classical + intro n p S hdiagPair i j hij hdiag hiR hjR hh + have hd := (hdiagPair i j hij).1 ⟨hh.1, hiR, hh.2, hjR⟩ + have hd' : (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) := by + rcases hd with h | h + · exact Or.inl h + · exact Or.inr ⟨h.2, h.1⟩ + exact hdiag hd' + +private theorem hcountRAt1293 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (∀ (i : Fin (n + + 3)), ∀ (j : Fin (n + 3)), (i ∈ Set.range S.ir) → ((j ∈ Set.range S.ir) → ((i ≠ j) → + (Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ + R.face k)} = if j = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) + then 1 else if ∃ k : Fin R.count, i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range + (S.ir ∘ R.face k) then 2 else 0)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 + : ℕ))), (i ≠ j) → ((¬ (j = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = + S.b))) → (∀ (k : Fin R.count), (i ∈ Set.range (S.ir ∘ R.face k)) → ((j ∈ Set.range + (S.ir ∘ R.face k)) → ((i ∈ Set.range S.ir) → ((j ∈ Set.range S.ir) → (Set.ncard {k : + Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = + 2))))))) ) := by + classical + intro n p S XR R hrightCountMapped i j hij hNoSpecial k hik hjk hiR hjR + have h := hrightCountMapped i j hiR hjR hij + have hfacePair : ∃ k : Fin R.count, + i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k) := + ⟨k, hik, hjk⟩ + rw [ite_eq_right hNoSpecial, ite_eq_left hfacePair] at h + exact h + +private theorem hnoUsedL : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + (∀ (i : Fin (n + 3)), ∀ (j : Fin (n + 3)), (∃ k : Fin (L.count + R.count), i ∈ Set.range + (f k) ∧ j ∈ Set.range (f k)) ↔ (∃ k : Fin L.count, i ∈ Set.range (S.il ∘ L.face k) ∧ + j ∈ Set.range (S.il ∘ L.face k)) ∨ (∃ k : Fin R.count, i ∈ Set.range (S.ir ∘ R.face + k) ∧ j ∈ Set.range (S.ir ∘ R.face k))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + + (3 : ℕ))), (¬∃ (k : Fin (L.count + R.count)), i ∈ Set.range (f k) ∧ j ∈ Set.range (f + k)) → (¬ ∃ k : Fin L.count, i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ + L.face k))) ) := by + classical + intro n p S XL XR L R f husedSplit i j hused h + exact hused ((husedSplit i j).2 (Or.inl h)) + +private theorem hnoUsedR : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + (∀ (i : Fin (n + 3)), ∀ (j : Fin (n + 3)), (∃ k : Fin (L.count + R.count), i ∈ Set.range + (f k) ∧ j ∈ Set.range (f k)) ↔ (∃ k : Fin L.count, i ∈ Set.range (S.il ∘ L.face k) ∧ + j ∈ Set.range (S.il ∘ L.face k)) ∨ (∃ k : Fin R.count, i ∈ Set.range (S.ir ∘ R.face + k) ∧ j ∈ Set.range (S.ir ∘ R.face k))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + + (3 : ℕ))), (¬∃ (k : Fin (L.count + R.count)), i ∈ Set.range (f k) ∧ j ∈ Set.range (f + k)) → (¬ ∃ k : Fin R.count, i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ + R.face k))) ) := by + classical + intro n p S XL XR L R f husedSplit i j hused h + exact hused ((husedSplit i j).2 (Or.inr h)) + +private theorem hcountLAt1312 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (i : Fin (n + + 3)), ∀ (j : Fin (n + 3)), (i ∈ Set.range S.il) → ((j ∈ Set.range S.il) → ((i ≠ j) → + (Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ + L.face k)} = if j = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) + then 1 else if ∃ k : Fin L.count, i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range + (S.il ∘ L.face k) then 2 else 0)))) → ((∀ (i : Fin (n + 3)), ∀ (j : Fin (n + 3)), (¬ + (i ∈ Set.range S.il ∧ j ∈ Set.range S.il)) → (Set.ncard {k : Fin L.count | i ∈ + Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = 0)) → (∀ (i : Fin (n + + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((¬ (j = i + 1 ∨ i = j + 1 ∨ (i = + S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b))) → ((¬ ∃ k : Fin L.count, i ∈ Set.range (S.il ∘ + L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)) → (Set.ncard {k : Fin L.count | i ∈ + Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = 0))))) ) := by + classical + intro n p S XL L hleftCountMapped hleftZeroPair i j hij hNoSpecial hnoUsedL + by_cases hiL : i ∈ Set.range S.il + · by_cases hjL : j ∈ Set.range S.il + · have h := hleftCountMapped i j hiL hjL hij + rw [ite_eq_right hNoSpecial, ite_eq_right hnoUsedL] at h + exact h + · exact hleftZeroPair i j (fun hh => hjL hh.2) + · exact hleftZeroPair i j (fun hh => hiL hh.1) + +private theorem hcountRAt1321 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (∀ (i : Fin (n + + 3)), ∀ (j : Fin (n + 3)), (i ∈ Set.range S.ir) → ((j ∈ Set.range S.ir) → ((i ≠ j) → + (Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ + R.face k)} = if j = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) + then 1 else if ∃ k : Fin R.count, i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range + (S.ir ∘ R.face k) then 2 else 0)))) → ((∀ (i : Fin (n + 3)), ∀ (j : Fin (n + 3)), (¬ + (i ∈ Set.range S.ir ∧ j ∈ Set.range S.ir)) → (Set.ncard {k : Fin R.count | i ∈ + Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = 0)) → (∀ (i : Fin (n + + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((¬ (j = i + 1 ∨ i = j + 1 ∨ (i = + S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b))) → ((¬ ∃ k : Fin R.count, i ∈ Set.range (S.ir ∘ + R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)) → (Set.ncard {k : Fin R.count | i ∈ + Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = 0))))) ) := by + classical + intro n p S XR R hrightCountMapped hrightZeroPair i j hij hNoSpecial hnoUsedR + by_cases hiR : i ∈ Set.range S.ir + · by_cases hjR : j ∈ Set.range S.ir + · have h := hrightCountMapped i j hiR hjR hij + rw [ite_eq_right hNoSpecial, ite_eq_right hnoUsedR] at h + exact h + · exact hrightZeroPair i j (fun hh => hjR hh.2) + · exact hrightZeroPair i j (fun hh => hiR hh.1) + +private theorem hdiag : + (by + classical + exact + ∀ (n : Nat), ∀ {m : ℕ}, ∀ {q : P3381T1PolygonBoundary m}, ∀ {X : Set (ℝ × ℝ)}, ∀ (D : + P3511T1SourceDissection q X), ∀ (e : Fin (m + (3 : ℕ)) → Fin (n + (3 : ℕ))), ∀ (a : + Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : ℕ)))), + List.ofFn e = a :: (u ++ [b]) → ∃ (k : Fin D.count), a ∈ Set.range (e ∘ D.face k) ∧ b + ∈ Set.range (e ∘ D.face k) ) := by + classical + intro n m q X D e a b u horder + have hfirst : e 0 = a := by + have h := congrArg List.head? horder + simpa [List.ofFn_succ] using h + have hlast : e (Fin.last (m + 2)) = b := by + have h := congrArg List.getLast? horder + rw [List.ofFn_succ_last, ← List.cons_append] at h + simpa only [List.getLast?_concat, Option.some.injEq] using h + have hne : (0 : Fin (m + 3)) ≠ Fin.last (m + 2) := by + intro h + have hv := congrArg Fin.val h + simp only [Fin.val_zero, Fin.val_last] at hv + omega + have hboundary : (0 : Fin (m + 3)) = Fin.last (m + 2) + 1 := by simp + have hcount := D.edge_count 0 (Fin.last (m + 2)) hne + rw [ite_eq_left (Or.inr hboundary)] at hcount + have hpos : 0 < Set.ncard {k : Fin D.count | + 0 ∈ Set.range (D.face k) ∧ Fin.last (m + 2) ∈ Set.range (D.face k)} := by + rw [hcount] + omega + obtain ⟨k, ⟨z, hz⟩, ⟨w, hw⟩⟩ := (Set.ncard_pos (Set.toFinite _)).mp hpos + exact ⟨k, ⟨z, by simp only [Function.comp_apply, hz, hfirst]⟩, + ⟨w, by simp only [Function.comp_apply, hw, hlast]⟩⟩ + +end IndexedFaceLedgerProof + +namespace IndexedLedgerAssembly + +private theorem hcross : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), ∀ (i : Fin L.count), ∀ (j : + Fin R.count), Set.range (S.il ∘ L.face i) ≠ Set.range (S.ir ∘ R.face j) ) := by + classical + intro n p S XL XR L R i j + exact IndexedFaceLedgerProof.hcrossAt176 n p S XL XR L R i j + +private theorem hblock : + (by + classical + exact + ∀ {l : ℕ}, ∀ {r : ℕ}, ∀ (P : Fin l → Prop), ∀ (Q : Fin r → Prop), {k : Fin (l + r) | + Fin.addCases P Q k}.ncard = {i : Fin l | P i}.ncard + {j : Fin r | Q j}.ncard ) := by + classical + intro l r P Q + exact IndexedFaceLedgerProof.hblock (l := l) (r := r) P Q + +private theorem hmodShift : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), (P3544T1DiagonalSplit p) → (∀ {m : ℕ}, + ∀ {r : ℕ}, ∀ {x : ℕ}, ∀ {y : ℕ}, (0 : ℕ) < m → x < m → y < m → (r + x) % m = (r + y) + % m → x = y) ) := by + classical + intro n p S m r x y hm hx hy he + exact IndexedFaceLedgerProof.hmodShift n p S (m := m) (r := + r) (x := x) (y := y) hm hx hy he + +private theorem hleftOrd : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + + (3 : ℕ) = S.u.length + S.v.length + (2 : ℕ)) → ((S.left_n + (3 : ℕ) = S.u.length + (2 + : ℕ)) → ((S.right_n + (3 : ℕ) = S.v.length + (2 : ℕ)) → ((∀ (x : Fin (S.left_n + (3 : + ℕ))), (↑(S.il x) : ℕ) = ((↑x : ℕ) + S.rotation) % (n + (3 : ℕ))) → ((∀ {m : ℕ}, ∀ + {r : ℕ}, ∀ {x : ℕ}, ∀ {y : ℕ}, (0 : ℕ) < m → x < m → y < m → (r + x) % m = (r + y) % + m → x = y) → ((∀ {m : ℕ}, ∀ {r : ℕ}, ∀ {x : ℕ}, (1 : ℕ) < m → ((r + x) % m + (1 : ℕ)) + % m = (r + (x + (1 : ℕ))) % m) → ((∀ (z : Fin (n + 3)), (z + 1).val = (z.val + 1) % + (n + 3)) → (∀ (x : Fin (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.left_n + (3 : ℕ))), S.il + y = S.il x + (1 : Fin (n + (3 : ℕ))) ∨ S.il x = S.il y + (1 : Fin (n + (3 : ℕ))) ↔ + (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : ℕ) + (1 : ℕ)))))))) ) := by + classical + intro n p S hlenP hlenL hlenR hleftcoord hmodShift hmodSucc hparentSuccVal x y + exact IndexedFaceLedgerProof.hleftOrd n p S + hparentSuccVal (IndexedFaceLedgerProof.hleftSucc n p S hlenP hlenL hlenR hleftcoord + hmodShift hmodSucc) x y + +private theorem hleftCountMapped : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ {m : ℕ}, ∀ (x : + Fin (m + (3 : ℕ))), ∀ (y : Fin (m + (3 : ℕ))), y = x + (1 : Fin (m + (3 : ℕ))) ∨ x = + y + (1 : Fin (m + (3 : ℕ))) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : ℕ) + + (1 : ℕ) ∨ (↑x : ℕ) + (1 : ℕ) = m + (3 : ℕ) ∧ (↑y : ℕ) = (0 : ℕ) ∨ (↑y : ℕ) + (1 : ℕ) + = m + (3 : ℕ) ∧ (↑x : ℕ) = (0 : ℕ)) → ((S.il (0 : Fin (S.left_n + (3 : ℕ))) = S.a) → + ((S.il (Fin.last (S.left_n + (2 : ℕ))) = S.b) → ((∀ (x : Fin (S.left_n + (3 : ℕ))), ∀ + (y : Fin (S.left_n + (3 : ℕ))), S.il y = S.il x + (1 : Fin (n + (3 : ℕ))) ∨ S.il x = + S.il y + (1 : Fin (n + (3 : ℕ))) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : + ℕ) + (1 : ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range + S.il → j ∈ Set.range S.il → i ≠ j → {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face + k) ∧ j ∈ Set.range (S.il ∘ L.face k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i + = j + (1 : Fin (n + (3 : ℕ))) ∨ i = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) + else if ∃ (k : Fin L.count), i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ + L.face k) then (2 : ℕ) else (0 : ℕ))))) ) := by + classical + intro n p S XL L hfinAdj hleftA hleftB hleftOrd i j hi hj hij + exact IndexedFaceLedgerProof.hleftCountMapped n p S XL L (IndexedFaceLedgerProof.hleftAdj n + p S hfinAdj hleftOrd (IndexedFaceLedgerProof.hleftWrap n p S hleftA hleftB)) + (IndexedFaceLedgerProof.hleftCountImage n p S XL L) + (IndexedFaceLedgerProof.hleftUsedMap n p S XL L (IndexedFaceLedgerProof.hleftFaceMem + n p S XL L)) i j hi hj hij + +private theorem hrightCountMapped : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (n + (3 : ℕ) = + S.u.length + S.v.length + (2 : ℕ)) → ((S.left_n + (3 : ℕ) = S.u.length + (2 : ℕ)) → + ((S.right_n + (3 : ℕ) = S.v.length + (2 : ℕ)) → ((∀ (y : Fin (S.right_n + (3 : ℕ))), + (↑(S.ir y) : ℕ) = (S.u.length + (1 : ℕ) + (↑y : ℕ) + S.rotation) % (n + (3 : ℕ))) → + ((∀ {m : ℕ}, ∀ {r : ℕ}, ∀ {x : ℕ}, ∀ {y : ℕ}, (0 : ℕ) < m → x < m → y < m → (r + x) % + m = (r + y) % m → x = y) → ((∀ {m : ℕ}, ∀ {r : ℕ}, ∀ {x : ℕ}, (1 : ℕ) < m → ((r + x) + % m + (1 : ℕ)) % m = (r + (x + (1 : ℕ))) % m) → ((∀ {m : ℕ}, ∀ (x : Fin (m + (3 : + ℕ))), ∀ (y : Fin (m + (3 : ℕ))), y = x + (1 : Fin (m + (3 : ℕ))) ∨ x = y + (1 : Fin + (m + (3 : ℕ))) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : ℕ) + (1 : ℕ) ∨ (↑x + : ℕ) + (1 : ℕ) = m + (3 : ℕ) ∧ (↑y : ℕ) = (0 : ℕ) ∨ (↑y : ℕ) + (1 : ℕ) = m + (3 : ℕ) + ∧ (↑x : ℕ) = (0 : ℕ)) → ((S.ir (0 : Fin (S.right_n + (3 : ℕ))) = S.b) → ((S.ir + (Fin.last (S.right_n + (2 : ℕ))) = S.a) → ((∀ (z : Fin (n + 3)), (z + 1).val = (z.val + + 1) % (n + 3)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ + Set.range S.ir → j ∈ Set.range S.ir → i ≠ j → {k : Fin R.count | i ∈ Set.range (S.ir + ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)}.ncard = if j = i + (1 : Fin (n + (3 : + ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then + (1 : ℕ) else if ∃ (k : Fin R.count), i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range + (S.ir ∘ R.face k) then (2 : ℕ) else (0 : ℕ))))))))))) ) := by + classical + intro n p S XR R hlenP hlenL hlenR hrightcoord hmodShift hmodSucc hfinAdj hrightB hrightA + hparentSuccVal i j hi hj hij + exact IndexedFaceLedgerProof.hrightCountMapped n p S XR R (IndexedFaceLedgerProof.hrightAdj + n p S hfinAdj (IndexedFaceLedgerProof.hrightOrd n p S hlenP hlenL hlenR + hrightcoord hmodShift hmodSucc hparentSuccVal (IndexedFaceLedgerProof.hrightSucc + n p S hlenP hlenL hlenR hrightcoord hmodShift hmodSucc)) + (IndexedFaceLedgerProof.hrightWrap n p S hrightB hrightA)) + (IndexedFaceLedgerProof.hrightCountImage n p S XR R) + (IndexedFaceLedgerProof.hrightUsedMap n p S XR R + (IndexedFaceLedgerProof.hrightFaceMem n p S XR R)) i j hi hj hij + +private theorem hleftZeroPair : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), ∀ (i : Fin (n + (3 + : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ¬(i ∈ Set.range S.il ∧ j ∈ Set.range S.il) → {k : + Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face + k)}.ncard = (0 : ℕ) ) := by + classical + intro n p S XL L i j hno + exact IndexedFaceLedgerProof.hleftZeroPair n p S XL L i j hno + +private theorem hrightZeroPair : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), ∀ (i : Fin (n + + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ¬(i ∈ Set.range S.ir ∧ j ∈ Set.range S.ir) → {k + : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face + k)}.ncard = (0 : ℕ) ) := by + classical + intro n p S XR R i j hno + exact IndexedFaceLedgerProof.hrightZeroPair n p S XR R i j hno + +private theorem hnotDiagBoundary : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (S.il + (0 : Fin (S.left_n + (3 : ℕ))) = S.a) → ((S.il (Fin.last (S.left_n + (2 : ℕ))) = S.b) + → ((∀ (x : Fin (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.left_n + (3 : ℕ))), S.il y = S.il + x + (1 : Fin (n + (3 : ℕ))) ∨ S.il x = S.il y + (1 : Fin (n + (3 : ℕ))) ↔ (↑y : ℕ) = + (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : ℕ) + (1 : ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ + (j : Fin (n + (3 : ℕ))), i = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b → ¬(j = i + (1 : Fin + (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))))))) ) := by + classical + intro n p S hleftA hleftB hleftOrd i j hdiag + exact IndexedFaceLedgerProof.hnotDiagBoundary n p S hleftA hleftB hleftOrd i j hdiag + +private theorem hcoverPair : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + + (3 : ℕ) = S.u.length + S.v.length + (2 : ℕ)) → ((S.left_n + (3 : ℕ) = S.u.length + (2 + : ℕ)) → ((S.right_n + (3 : ℕ) = S.v.length + (2 : ℕ)) → ((∀ (x : Fin (S.left_n + (3 : + ℕ))), (↑(S.il x) : ℕ) = ((↑x : ℕ) + S.rotation) % (n + (3 : ℕ))) → ((∀ (y : Fin + (S.right_n + (3 : ℕ))), (↑(S.ir y) : ℕ) = (S.u.length + (1 : ℕ) + (↑y : ℕ) + + S.rotation) % (n + (3 : ℕ))) → ((∀ {m : ℕ}, ∀ {r : ℕ}, ∀ {x : ℕ}, ∀ {y : ℕ}, (0 : ℕ) + < m → x < m → y < m → (r + x) % m = (r + y) % m → x = y) → ((∀ {m : ℕ}, ∀ {r : ℕ}, ∀ + {x : ℕ}, (1 : ℕ) < m → ((r + x) % m + (1 : ℕ)) % m = (r + (x + (1 : ℕ))) % m) → + ((S.il (0 : Fin (S.left_n + (3 : ℕ))) = S.a) → ((S.il (Fin.last (S.left_n + (2 : ℕ))) + = S.b) → ((S.ir (0 : Fin (S.right_n + (3 : ℕ))) = S.b) → ((S.ir (Fin.last (S.right_n + + (2 : ℕ))) = S.a) → ((∀ (z : Fin (n + 3)), (z + 1).val = (z.val + 1) % (n + 3)) → (∀ + (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (j = i + (1 : Fin (n + (3 : ℕ))) + ∨ i = j + (1 : Fin (n + (3 : ℕ)))) → (i ∈ Set.range S.il ∧ j ∈ Set.range S.il ∨ i ∈ + Set.range S.ir ∧ j ∈ Set.range S.ir))))))))))))) ) := by + classical + intro n p S hlenP hlenL hlenR hleftcoord hrightcoord hmodShift hmodSucc hleftA hleftB hrightB + hrightA hparentSuccVal i j hboundary + exact (IndexedFaceLedgerProof.hparentPairCover n p S + (IndexedFaceLedgerProof.hcover n p S) (IndexedFaceLedgerProof.hcrossNoAdj n p S hlenP + hlenL hlenR hleftcoord hrightcoord hmodShift hmodSucc hleftA hleftB hrightB hrightA + hparentSuccVal)) i j hboundary + +private theorem hcountLAt2222 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (i : Fin (n + + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.il → j ∈ Set.range S.il → i ≠ j + → {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face + k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i + = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin L.count), i ∈ + Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k) then (2 : ℕ) else (0 : + ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((j = i + (1 : + Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ)))) → ((i ∈ Set.range S.il) → ((j ∈ + Set.range S.il) → (Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ + Set.range (S.il ∘ L.face k)} = 1))))) ) := by + classical + intro n p S XL L hleftCountMapped i j hij hboundary hiL hjL + exact IndexedFaceLedgerProof.hcountLAt1167 n p S XL L hleftCountMapped i j hij + hboundary hiL hjL + +private theorem hcountRAt2231 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (∀ (i : Fin (n + + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.ir → j ∈ Set.range S.ir → i ≠ j + → {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face + k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i + = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin R.count), i ∈ + Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k) then (2 : ℕ) else (0 : + ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((j = i + (1 : + Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ)))) → ((i ∈ Set.range S.ir) → ((j ∈ + Set.range S.ir) → (Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ + Set.range (S.ir ∘ R.face k)} = 1))))) ) := by + classical + intro n p S XR R hrightCountMapped i j hij hboundary hiR hjR + exact IndexedFaceLedgerProof.hcountRAt1188 n p S XR R hrightCountMapped i j hij + hboundary hiR hjR + +private theorem hcountLAt2242 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (i : Fin (n + + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.il → j ∈ Set.range S.il → i ≠ j + → {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face + k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i + = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin L.count), i ∈ + Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k) then (2 : ℕ) else (0 : + ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((i = S.a ∧ j + = S.b ∨ j = S.a ∧ i = S.b) → ((i ∈ Set.range S.il) → ((j ∈ Set.range S.il) → + (Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ + L.face k)} = 1))))) ) := by + classical + intro n p S XL L hleftCountMapped i j hij hdiag hiL hjL + exact IndexedFaceLedgerProof.hcountLAt1209 n p S XL L hleftCountMapped i j hij hdiag + hiL hjL + +private theorem hcountRAt2246 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (∀ (i : Fin (n + + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.ir → j ∈ Set.range S.ir → i ≠ j + → {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face + k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i + = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin R.count), i ∈ + Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k) then (2 : ℕ) else (0 : + ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((i = S.a ∧ j + = S.b ∨ j = S.a ∧ i = S.b) → ((i ∈ Set.range S.ir) → ((j ∈ Set.range S.ir) → + (Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ + R.face k)} = 1))))) ) := by + classical + intro n p S XR R hrightCountMapped i j hij hdiag hiR hjR + exact IndexedFaceLedgerProof.hcountRAt1219 n p S XR R hrightCountMapped i j hij hdiag + hiR hjR + +private theorem hcount : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + ∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ({k : Fin (L.count + R.count) | i ∈ + Set.range ((fun (i : Fin (L.count + R.count)) => Fin.addCases (motive := fun (_ : Fin + (L.count + R.count)) => Fin (3 : ℕ) → Fin (n + (3 : ℕ))) (fun (k : Fin L.count) => + S.il ∘ L.face k) (fun (k : Fin R.count) => S.ir ∘ R.face k) i) k) ∧ j ∈ Set.range + ((fun (i : Fin (L.count + R.count)) => Fin.addCases (motive := fun (_ : Fin (L.count + + R.count)) => Fin (3 : ℕ) → Fin (n + (3 : ℕ))) (fun (k : Fin L.count) => S.il ∘ + L.face k) (fun (k : Fin R.count) => S.ir ∘ R.face k) i) k)}.ncard = {k : Fin L.count + | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)}.ncard + {k : Fin + R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)}.ncard) → + ((Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il + ∘ L.face k)} = 1) → ((Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ + j ∈ Set.range (S.ir ∘ R.face k)} = 1) → (Set.ncard {k : Fin (L.count + R.count) | i ∈ + Set.range (f k) ∧ j ∈ Set.range (f k)} = 2)))) := by + classical + intro n p S XL XR L R f i j htotal hcountL hcountR + exact IndexedFaceLedgerProof.hcountAt1229 + n p S XL XR L R i j htotal hcountL hcountR + +private theorem hused : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + ∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (Set.ncard {k : Fin (L.count + + R.count) | i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)} = 2) → (∃ k : Fin (L.count + + R.count), i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)) ) := by + classical + intro n p S XL XR L R f i j hcount + exact IndexedFaceLedgerProof.hused n p S XL XR + L R i j hcount + +private theorem hNoSpecial : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (i : + Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (¬(j = i + (1 : Fin (n + (3 : ℕ))) ∨ i + = j + (1 : Fin (n + (3 : ℕ))))) → ((¬(i = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b)) → (¬ (j + = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b)))) ) := by + classical + intro n p S i j hboundary hdiag + exact IndexedFaceLedgerProof.hNoSpecial n p S i j hboundary hdiag + +private theorem hcountLAt2267 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (i : Fin (n + + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.il → j ∈ Set.range S.il → i ≠ j + → {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face + k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i + = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin L.count), i ∈ + Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k) then (2 : ℕ) else (0 : + ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((¬ (j = i + 1 + ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b))) → (∀ (k : Fin L.count), (i + ∈ Set.range (S.il ∘ L.face k)) → ((j ∈ Set.range (S.il ∘ L.face k)) → ((i ∈ Set.range + S.il) → ((j ∈ Set.range S.il) → (Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ + L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = 2))))))) ) := by + classical + intro n p S XL L hleftCountMapped i j hij hNoSpecial k hik hjk hiL hjL + exact IndexedFaceLedgerProof.hcountLAt1267 n p S XL L hleftCountMapped i j hij + hNoSpecial k hik hjk hiL hjL + +private theorem hcountRAt2278 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR + : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (∀ (i : Fin (n + + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.ir → j ∈ Set.range S.ir → i ≠ j + → {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face + k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i + = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin R.count), i ∈ + Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k) then (2 : ℕ) else (0 : + ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((¬ (j = i + 1 + ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b))) → (∀ (k : Fin R.count), (i + ∈ Set.range (S.ir ∘ R.face k)) → ((j ∈ Set.range (S.ir ∘ R.face k)) → ((i ∈ Set.range + S.ir) → ((j ∈ Set.range S.ir) → (Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ + R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = 2))))))) ) := by + classical + intro n p S XR R hrightCountMapped i j hij hNoSpecial k hik hjk hiR hjR + exact IndexedFaceLedgerProof.hcountRAt1293 n p S XR R hrightCountMapped i j hij + hNoSpecial k hik hjk hiR hjR + +private theorem hnoUsedL : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (∃ (k : Fin (L.count + R.count)), + i ∈ Set.range ((fun (i : Fin (L.count + R.count)) => Fin.addCases (motive := fun (_ : + Fin (L.count + R.count)) => Fin (3 : ℕ) → Fin (n + (3 : ℕ))) (fun (k : Fin L.count) + => S.il ∘ L.face k) (fun (k : Fin R.count) => S.ir ∘ R.face k) i) k) ∧ j ∈ Set.range + ((fun (i : Fin (L.count + R.count)) => Fin.addCases (motive := fun (_ : Fin (L.count + + R.count)) => Fin (3 : ℕ) → Fin (n + (3 : ℕ))) (fun (k : Fin L.count) => S.il ∘ + L.face k) (fun (k : Fin R.count) => S.ir ∘ R.face k) i) k)) ↔ (∃ (k : Fin L.count), i + ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)) ∨ ∃ (k : Fin + R.count), i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)) → (∀ (i + : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (¬∃ (k : Fin (L.count + + R.count)), i + ∈ Set.range (f k) ∧ j ∈ Set.range (f k)) → (¬ ∃ k : Fin L.count, i ∈ Set.range (S.il + ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)))) := by + classical + intro n p S XL XR L R f husedSplit i j hused + exact IndexedFaceLedgerProof.hnoUsedL n p S XL XR L R husedSplit i j hused + +private theorem hcountLAt2288 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (i : Fin (n + + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.il → j ∈ Set.range S.il → i ≠ j + → {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face + k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i + = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin L.count), i ∈ + Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k) then (2 : ℕ) else (0 : + ℕ)) → ((∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ¬(i ∈ Set.range S.il ∧ + j ∈ Set.range S.il) → {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ + Set.range (S.il ∘ L.face k)}.ncard = (0 : ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : + Fin (n + (3 : ℕ))), (i ≠ j) → ((¬ (j = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = + S.a ∧ i = S.b))) → ((¬ ∃ k : Fin L.count, i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ + Set.range (S.il ∘ L.face k)) → (Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ + L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = 0))))) ) := by + classical + intro n p S XL L hleftCountMapped hleftZeroPair i j hij hNoSpecial hnoUsedL + exact IndexedFaceLedgerProof.hcountLAt1312 n p S XL L hleftCountMapped hleftZeroPair + i j hij hNoSpecial hnoUsedL + +private theorem hcountRAt2292 : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL + : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection + S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (∃ (k : Fin (L.count + R.count)), + i ∈ Set.range ((fun (i : Fin (L.count + R.count)) => Fin.addCases (motive := fun (_ : + Fin (L.count + R.count)) => Fin (3 : ℕ) → Fin (n + (3 : ℕ))) (fun (k : Fin L.count) + => S.il ∘ L.face k) (fun (k : Fin R.count) => S.ir ∘ R.face k) i) k) ∧ j ∈ Set.range + ((fun (i : Fin (L.count + R.count)) => Fin.addCases (motive := fun (_ : Fin (L.count + + R.count)) => Fin (3 : ℕ) → Fin (n + (3 : ℕ))) (fun (k : Fin L.count) => S.il ∘ + L.face k) (fun (k : Fin R.count) => S.ir ∘ R.face k) i) k)) ↔ (∃ (k : Fin L.count), i + ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)) ∨ ∃ (k : Fin + R.count), i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)) → ((∀ (i + : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.ir → j ∈ Set.range + S.ir → i ≠ j → {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range + (S.ir ∘ R.face k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + + (3 : ℕ))) ∨ i = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin + R.count), i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k) then (2 : + ℕ) else (0 : ℕ)) → ((∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ¬(i ∈ + Set.range S.ir ∧ j ∈ Set.range S.ir) → {k : Fin R.count | i ∈ Set.range (S.ir ∘ + R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)}.ncard = (0 : ℕ)) → (∀ (i : Fin (n + (3 : + ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((¬ (j = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j + = S.b) ∨ (j = S.a ∧ i = S.b))) → ((¬∃ (k : Fin (L.count + R.count)), i ∈ Set.range (f + k) ∧ j ∈ Set.range (f k)) → (Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ + R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = 0))))))) := by + classical + intro n p S XL XR L R f husedSplit hrightCountMapped hrightZeroPair i j hij hNoSpecial hused + exact IndexedFaceLedgerProof.hcountRAt1321 n p S XR R hrightCountMapped + hrightZeroPair i j hij hNoSpecial (IndexedFaceLedgerProof.hnoUsedR n p S XL XR + L R husedSplit i j hused) + +private theorem hdiag : + (by + classical + exact + ∀ (n : Nat), ∀ {m : ℕ}, ∀ {q : P3381T1PolygonBoundary m}, ∀ {X : Set (ℝ × ℝ)}, ∀ (D : + P3511T1SourceDissection q X), ∀ (e : Fin (m + (3 : ℕ)) → Fin (n + (3 : ℕ))), ∀ (a : + Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : ℕ)))), + List.ofFn e = a :: (u ++ [b]) → ∃ (k : Fin D.count), a ∈ Set.range (e ∘ D.face k) ∧ b + ∈ Set.range (e ∘ D.face k) ) := by + classical + intro n m q X D e a b u horder + exact IndexedFaceLedgerProof.hdiag n (m := m) (q := + q) (X := X) D e a b u horder + +end IndexedLedgerAssembly + +theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} + (S : P3544T1DiagonalSplit p) {XL XR : Set (Real × Real)} + (L : P3511T1SourceDissection S.left XL) + (R : P3511T1SourceDissection S.right XR) : + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + List.ofFn f = List.ofFn (fun k => S.il ∘ L.face k) ++ + List.ofFn (fun k => S.ir ∘ R.face k) ∧ + P3511T1CyclicDissection (Fin (n + 3)) + (List.ofFn (fun i : Fin (n + 3) => i)) (List.ofFn f) ∧ + (∀ k, Function.Injective (f k)) ∧ + Function.Injective (fun k => Set.range (f k)) ∧ + (∀ i, ∃ k j, f k j = i) ∧ + (∀ k, P3381T1TriangleDeterminant (p.vertex ∘ f k) ≠ 0) ∧ + (∀ i j : Fin (n + 3), i ≠ j → + Set.ncard {k : Fin (L.count + R.count) | + i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)} = + if j = i + 1 ∨ i = j + 1 then 1 + else if ∃ k, i ∈ Set.range (f k) ∧ j ∈ Set.range (f k) then 2 else 0) ∧ + (∃ k, S.a ∈ Set.range (S.il ∘ L.face k) ∧ S.b ∈ Set.range (S.il ∘ L.face k)) ∧ + (∃ k, S.a ∈ Set.range (S.ir ∘ R.face k) ∧ S.b ∈ Set.range (S.ir ∘ R.face k)) := by +-- BODY + classical + dsimp only + let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := + Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) + have hlist := IndexedFaceLedgerProof.hlist n p S XL XR L R + refine ⟨hlist, (IndexedFaceLedgerProof.hdissection n p S XL XR L R hlist + (IndexedFaceLedgerProof.hmap)), (IndexedFaceLedgerProof.hinjective n p S XL XR L R), ?_, + ?_, (IndexedFaceLedgerProof.hnondegenerate n p S XL XR L R), ?_, ?_, ?_⟩ + · have hcross (i : Fin L.count) (j : Fin R.count) : + Set.range (S.il ∘ L.face i) ≠ Set.range (S.ir ∘ R.face j) := IndexedLedgerAssembly.hcross + n p S XL XR L R i j + intro k l + refine Fin.addCases (fun i => ?_) (fun j => ?_) k + · refine Fin.addCases (fun i' => ?_) (fun j' => ?_) l + · simp only [Fin.addCases_left] + intro h + have hh : Set.range (L.face i) = Set.range (L.face i') := + S.il_injective.image_injective (by simpa only [Set.range_comp] using h) + exact congrArg (Fin.castAdd R.count) (L.face_distinct hh) + · simp only [Fin.addCases_left, Fin.addCases_right] + intro h + exact False.elim (hcross i j' h) + · refine Fin.addCases (fun i' => ?_) (fun j' => ?_) l + · simp only [Fin.addCases_left, Fin.addCases_right] + intro h + exact False.elim (hcross i' j h.symm) + · simp only [Fin.addCases_right] + intro h + have hh : Set.range (R.face j) = Set.range (R.face j') := + S.ir_injective.image_injective (by simpa only [Set.range_comp] using h) + exact congrArg (Fin.natAdd L.count) (R.face_distinct hh) + · intro i + have hi : i ∈ (List.ofFn (fun j : Fin (n + 3) => j)).rotate S.rotation := + IndexedFaceLedgerProof.hiAt215 n p S i + rw [S.parent_order] at hi + have hmem : i ∈ List.ofFn S.il ∨ i ∈ List.ofFn S.ir := IndexedFaceLedgerProof.hmemAt219 n p S + i hi + simp only [List.mem_ofFn] at hmem + rcases hmem with ⟨j, rfl⟩ | ⟨j, rfl⟩ + · obtain ⟨k, z, hz⟩ := L.vertex_used j + exact ⟨Fin.castAdd R.count k, z, by simp only [Fin.addCases_left, + Function.comp_apply, hz]⟩ + · obtain ⟨k, z, hz⟩ := R.vertex_used j + exact ⟨Fin.natAdd L.count k, z, by simp only [Fin.addCases_right, + Function.comp_apply, hz]⟩ + · have hblock {l r : Nat} (P : Fin l → Prop) (Q : Fin r → Prop) : + Set.ncard {k : Fin (l + r) | Fin.addCases P Q k} = + Set.ncard {i : Fin l | P i} + Set.ncard {j : Fin r | Q j} := + IndexedLedgerAssembly.hblock (l := l) (r := r) P Q + have hlenP := IndexedFaceLedgerProof.hlenP n p S + have hlenL := IndexedFaceLedgerProof.hlenL n p S + have hlenR := IndexedFaceLedgerProof.hlenR n p S + have hleftcoord (x : Fin (S.left_n + 3)) := IndexedFaceLedgerProof.hleftcoord n p S hlenP + hlenL hlenR x + have haCoord := IndexedFaceLedgerProof.haCoord n p S hlenP hlenL hlenR + have hrightcoord (y : Fin (S.right_n + 3)) := IndexedFaceLedgerProof.hrightcoord n p S hlenP + hlenL hlenR haCoord y + have hmodShift {m r x y : Nat} (hm : 0 < m) (hx : x < m) (hy : y < m) + (he : (r + x) % m = (r + y) % m) := IndexedLedgerAssembly.hmodShift n p S (m := m) (r := + r) (x := x) (y := y) hm hx hy he + have hmodSucc {m r x : Nat} (hm : 1 < m) := IndexedFaceLedgerProof.hmodSucc (m := m) (r := r) + (x := x) hm + have hfinAdj {m : Nat} (x y : Fin (m + 3)) := IndexedFaceLedgerProof.hfinAdj n p S (m := m) x y + have hleftA := IndexedFaceLedgerProof.hleftA n p S hleftcoord haCoord + have hleftB := IndexedFaceLedgerProof.hleftB n p S + have hrightB := IndexedFaceLedgerProof.hrightB n p S + have hrightA := IndexedFaceLedgerProof.hrightA n p S + have hparentSuccVal (z : Fin (n + 3)) : (z + 1).val = (z.val + 1) % (n + 3) := by + rw [Fin.val_add, Fin.val_one] + have hleftOrd (x y : Fin (S.left_n + 3)) := IndexedLedgerAssembly.hleftOrd n p S hlenP hlenL + hlenR hleftcoord hmodShift hmodSucc hparentSuccVal x y + have hdiagPair (i j : Fin (n + 3)) (hij : i ≠ j) := IndexedFaceLedgerProof.hdiagPair n p S + hleftA hleftB hrightB hrightA i j hij + have hleftZero (i j : Fin (n + 3)) + (hi : i ∉ Set.range S.il) := IndexedFaceLedgerProof.hleftZero n p S XL L i j hi + have hrightZero (i j : Fin (n + 3)) + (hi : i ∉ Set.range S.ir) := IndexedFaceLedgerProof.hrightZero n p S XR R i j hi + have husedSplit (i j : Fin (n + 3)) := IndexedFaceLedgerProof.husedSplit n p S XL XR L R i j + have hleftCountMapped (i j : Fin (n + 3)) + (hi : i ∈ Set.range S.il) (hj : j ∈ Set.range S.il) (hij : i ≠ j) := + IndexedLedgerAssembly.hleftCountMapped n p S XL L hfinAdj hleftA hleftB hleftOrd i j + hi hj hij + have hrightCountMapped (i j : Fin (n + 3)) + (hi : i ∈ Set.range S.ir) (hj : j ∈ Set.range S.ir) (hij : i ≠ j) := + IndexedLedgerAssembly.hrightCountMapped n p S XR R hlenP hlenL hlenR hrightcoord + hmodShift hmodSucc hfinAdj hrightB hrightA hparentSuccVal i j hi hj hij + have hleftZeroPair (i j : Fin (n + 3)) + (hno : ¬ (i ∈ Set.range S.il ∧ j ∈ Set.range S.il)) := + IndexedLedgerAssembly.hleftZeroPair n p S XL L i j hno + have hrightZeroPair (i j : Fin (n + 3)) + (hno : ¬ (i ∈ Set.range S.ir ∧ j ∈ Set.range S.ir)) := + IndexedLedgerAssembly.hrightZeroPair n p S XR R i j hno + have hnotDiagBoundary (i j : Fin (n + 3)) + (hdiag : (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b)) := + IndexedLedgerAssembly.hnotDiagBoundary n p S hleftA hleftB hleftOrd i j hdiag + intro i j hij + have htotal := (IndexedFaceLedgerProof.hblockCount n p S XL XR L R hblock) i j + by_cases hboundary : j = i + 1 ∨ i = j + 1 + · have hcoverPair := IndexedLedgerAssembly.hcoverPair n p S hlenP hlenL hlenR hleftcoord + hrightcoord hmodShift hmodSucc hleftA hleftB hrightB hrightA hparentSuccVal i j hboundary + have hnotDiag := IndexedFaceLedgerProof.hnotDiag n p S hnotDiagBoundary i j hboundary + rcases hcoverPair with ⟨hiL, hjL⟩ | ⟨hiR, hjR⟩ + · have hnoR : ¬ (i ∈ Set.range S.ir ∧ j ∈ Set.range S.ir) := + IndexedFaceLedgerProof.hnoRAt1159 n p S hdiagPair i j hij hnotDiag hiL hjL + have hcountL : Set.ncard {k : Fin L.count | + i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = 1 := + IndexedLedgerAssembly.hcountLAt2222 n p S XL L hleftCountMapped i j hij hboundary + hiL hjL + have hcountR := hrightZeroPair i j hnoR + rw [htotal, hcountL, hcountR] + rw [ite_eq_left hboundary] + · have hnoL : ¬ (i ∈ Set.range S.il ∧ j ∈ Set.range S.il) := + IndexedFaceLedgerProof.hnoLAt1180 n p S hdiagPair i j hij hnotDiag hiR hjR + have hcountR : Set.ncard {k : Fin R.count | + i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = 1 := + IndexedLedgerAssembly.hcountRAt2231 n p S XR R hrightCountMapped i j hij + hboundary hiR hjR + have hcountL := hleftZeroPair i j hnoL + rw [htotal, hcountL, hcountR] + rw [ite_eq_left hboundary] + · by_cases hdiag : (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) + · have hnotBoundary := hnotDiagBoundary i j hdiag + have hcommon := (hdiagPair i j hij).2 (IndexedFaceLedgerProof.hdiag' n p S i j hdiag) + rcases hcommon with ⟨hiL, hiR, hjL, hjR⟩ + have hcountL : Set.ncard {k : Fin L.count | + i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = 1 := + IndexedLedgerAssembly.hcountLAt2242 n p S XL L hleftCountMapped i j hij hdiag hiL + hjL + have hcountR : Set.ncard {k : Fin R.count | + i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = 1 := + IndexedLedgerAssembly.hcountRAt2246 n p S XR R hrightCountMapped i j hij hdiag + hiR hjR + have hcount : Set.ncard {k : Fin (L.count + R.count) | + i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)} = 2 := IndexedLedgerAssembly.hcount n p S + XL XR L R i j htotal hcountL hcountR + have hused : ∃ k : Fin (L.count + R.count), + i ∈ Set.range (f k) ∧ j ∈ Set.range (f k) := IndexedLedgerAssembly.hused n p S XL XR + L R i j hcount + rw [hcount, ite_eq_right hnotBoundary, ite_eq_left hused] + · have hNoSpecial : + ¬ (j = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b)) := + IndexedLedgerAssembly.hNoSpecial n p S i j hboundary hdiag + by_cases hused : ∃ k : Fin (L.count + R.count), + i ∈ Set.range (f k) ∧ j ∈ Set.range (f k) + · rcases (husedSplit i j).1 hused with husedL | husedR + · obtain ⟨k, hik, hjk⟩ := husedL + have hiL := IndexedFaceLedgerProof.hiL n p S XL L i k hik + have hjL := IndexedFaceLedgerProof.hjL n p S XL L j k hjk + have hnoR := IndexedFaceLedgerProof.hnoRAt1259 n p S hdiagPair i j hij hdiag hiL hjL + have hcountL : Set.ncard {k : Fin L.count | + i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = 2 := + IndexedLedgerAssembly.hcountLAt2267 n p S XL L hleftCountMapped i j hij + hNoSpecial k hik hjk hiL hjL + have hcountR := hrightZeroPair i j hnoR + rw [htotal, hcountL, hcountR] + rw [ite_eq_right hboundary, ite_eq_left hused] + · obtain ⟨k, hik, hjk⟩ := husedR + have hiR := IndexedFaceLedgerProof.hiR n p S XR R i k hik + have hjR := IndexedFaceLedgerProof.hjR n p S XR R j k hjk + have hnoL := IndexedFaceLedgerProof.hnoLAt1285 n p S hdiagPair i j hij hdiag hiR hjR + have hcountR : Set.ncard {k : Fin R.count | + i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = 2 := + IndexedLedgerAssembly.hcountRAt2278 n p S XR R hrightCountMapped i j hij + hNoSpecial k hik hjk hiR hjR + have hcountL := hleftZeroPair i j hnoL + rw [htotal, hcountL, hcountR] + rw [ite_eq_right hboundary, ite_eq_left hused] + · have hnoUsedL : ¬ ∃ k : Fin L.count, + i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k) := + IndexedLedgerAssembly.hnoUsedL n p S XL XR L R husedSplit i j hused + have hcountL : Set.ncard {k : Fin L.count | + i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = 0 := + IndexedLedgerAssembly.hcountLAt2288 n p S XL L hleftCountMapped hleftZeroPair i + j hij hNoSpecial hnoUsedL + have hcountR : Set.ncard {k : Fin R.count | + i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = 0 := + IndexedLedgerAssembly.hcountRAt2292 n p S XL XR L R husedSplit + hrightCountMapped hrightZeroPair i j hij hNoSpecial hused + rw [htotal, hcountL, hcountR] + rw [ite_eq_right hboundary, ite_eq_right hused] + all_goals + have hdiag {m : Nat} {q : P3381T1PolygonBoundary m} {X : Set (Real × Real)} + (D : P3511T1SourceDissection q X) (e : Fin (m + 3) → Fin (n + 3)) + (a b : Fin (n + 3)) (u : List (Fin (n + 3))) + (horder : List.ofFn e = a :: (u ++ [b])) := IndexedLedgerAssembly.hdiag n (m := m) (q := + q) (X := X) D e a b u horder + · exact hdiag L S.il S.a S.b S.u S.left_order + · obtain ⟨k, hb, ha⟩ := hdiag R S.ir S.b S.a S.v S.right_order + exact ⟨k, ha, hb⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1ParentOddGluing.lean b/LeanPool/ApollonianSuperharmonic/P3652T1ParentOddGluing.lean new file mode 100644 index 0000000000..bc36a0b553 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3652T1ParentOddGluing.lean @@ -0,0 +1,155 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3544T1DiagonalSplit +public import Mathlib.Analysis.Convex.PathConnected +public import Mathlib.Analysis.Normed.Module.Convex + +-- [TABLET NODE: P3652T1ParentOddGluing] + +/-! +# P3652T1ParentOddGluing + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3652T1ParentOddGluing {n : Nat} {p : P3381T1PolygonBoundary n} + (S : P3544T1DiagonalSplit p) {XL XR : Set (Real × Real)} + (hL : XL = P3544T1RayParity S.left ∪ P3544T1BoundaryCarrier S.left) + (hR : XR = P3544T1RayParity S.right ∪ P3544T1BoundaryCarrier S.right) + (hcL : IsPathConnected (P3544T1RayParity S.left)) + (hcR : IsPathConnected (P3544T1RayParity S.right)) + (hsep : XL ∩ XR = segment Real (p.vertex S.a) (p.vertex S.b)) : + P3544T1RayParity p = P3544T1RayParity S.left ∪ + P3544T1RayParity S.right ∪ openSegment Real (p.vertex S.a) (p.vertex S.b) ∧ + XL ∪ XR = P3544T1RayParity p ∪ P3544T1BoundaryCarrier p ∧ + IsPathConnected (P3544T1RayParity p) := by +-- BODY + let OL := P3544T1RayParity S.left + let OR := P3544T1RayParity S.right + let CL := P3544T1BoundaryCarrier S.left + let CR := P3544T1BoundaryCarrier S.right + let e := segment Real (p.vertex S.a) (p.vertex S.b) + let d := openSegment Real (p.vertex S.a) (p.vertex S.b) + have heL : e ⊆ CL := by + rw [show e = CL ∩ CR from S.carrier_intersection.symm] + exact Set.inter_subset_left + have heR : e ⊆ CR := by + rw [show e = CL ∩ CR from S.carrier_intersection.symm] + exact Set.inter_subset_right + have hOLCR : Disjoint OL CR := by + apply Set.disjoint_left.mpr + intro x hx hC + by_cases he : x ∈ e + · exact hx.1 (heL he) + · exact Set.disjoint_left.mp S.right_arc_even ⟨hC, he⟩ hx + have hORCL : Disjoint OR CL := by + apply Set.disjoint_left.mpr + intro x hx hC + by_cases he : x ∈ e + · exact hx.1 (heR he) + · exact Set.disjoint_left.mp S.left_arc_even ⟨hC, he⟩ hx + have hdis : Disjoint OL OR := by + apply Set.disjoint_left.mpr + intro x hx hy + have hxy : x ∈ XL ∩ XR := ⟨hL.symm ▸ Or.inl hx, hR.symm ▸ Or.inl hy⟩ + have he : x ∈ e := by rwa [hsep] at hxy + exact hx.1 (heL he) + have hCp : P3544T1BoundaryCarrier p ⊆ CL ∪ CR := by + intro x hx + exact S.carrier_union.symm ▸ Or.inl hx + have hv (i : Fin (n + 3)) : p.vertex i ∈ P3544T1BoundaryCarrier p := + Set.mem_iUnion.mpr ⟨i, left_mem_segment Real _ _⟩ + have hodd : P3544T1RayParity p = OL ∪ OR ∪ d := by + ext x + constructor + · intro hx + by_cases hC : x ∈ CL ∪ CR + · have he : x ∈ e := (S.carrier_union ▸ hC).resolve_left hx.1 + exact Or.inr (mem_openSegment_of_ne_left_right + (fun h => hx.1 (h ▸ hv S.a)) (fun h => hx.1 (h ▸ hv S.b)) he) + · have hnL : x ∉ CL := fun h => hC (Or.inl h) + have hnR : x ∉ CR := fun h => hC (Or.inr h) + exact Or.inl ((S.parity_sum x hnL hnR).mp hx |>.elim + (fun h => Or.inl h.1) (fun h => Or.inr h.2)) + · rintro ((hx | hx) | hx) + · apply (S.parity_sum x hx.1 (Set.disjoint_left.mp hOLCR hx)).mpr + exact Or.inl ⟨hx, Set.disjoint_left.mp hdis hx⟩ + · apply (S.parity_sum x (Set.disjoint_left.mp hORCL hx) hx.1).mpr + exact Or.inr ⟨fun h => Set.disjoint_left.mp hdis h hx, hx⟩ + · exact S.diagonal_odd hx + have heCp : e ⊆ d ∪ P3544T1BoundaryCarrier p := by + intro x hx + by_cases ha : p.vertex S.a = x + · exact Or.inr (ha ▸ hv S.a) + by_cases hb : p.vertex S.b = x + · exact Or.inr (hb ▸ hv S.b) + exact Or.inl (mem_openSegment_of_ne_left_right ha hb hx) + have hfill : XL ∪ XR = P3544T1RayParity p ∪ P3544T1BoundaryCarrier p := by + rw [hL, hR, hodd] + change (OL ∪ CL) ∪ (OR ∪ CR) = (OL ∪ OR ∪ d) ∪ P3544T1BoundaryCarrier p + apply Set.Subset.antisymm + · intro x hx + rcases hx with (hx | hx) | (hx | hx) + · exact Or.inl (Or.inl (Or.inl hx)) + · have hC : x ∈ CL ∪ CR := Or.inl hx + rw [show CL ∪ CR = P3544T1BoundaryCarrier p ∪ e from S.carrier_union] at hC + rcases hC with hc | he + · exact Or.inr hc + · exact (heCp he).elim (fun h => Or.inl (Or.inr h)) Or.inr + · exact Or.inl (Or.inl (Or.inr hx)) + · have hC : x ∈ CL ∪ CR := Or.inr hx + rw [show CL ∪ CR = P3544T1BoundaryCarrier p ∪ e from S.carrier_union] at hC + rcases hC with hc | he + · exact Or.inr hc + · exact (heCp he).elim (fun h => Or.inl (Or.inr h)) Or.inr + · intro x + rintro (((hx | hx) | hx) | hx) + · exact Or.inl (Or.inl hx) + · exact Or.inr (Or.inl hx) + · exact Or.inl (Or.inr (heL (openSegment_subset_segment Real _ _ hx))) + · exact (hCp hx).elim (fun h => Or.inl (Or.inr h)) (fun h => Or.inr (Or.inr h)) + let m := midpoint Real (p.vertex S.a) (p.vertex S.b) + have hm : m ∈ d := midpoint_mem_openSegment _ _ + have hme : m ∈ e := openSegment_subset_segment Real _ _ hm + obtain ⟨r, hr, hball⟩ := Metric.isOpen_iff.mp (P3544T1LocalParity p).2.1 m + (S.diagonal_odd hm) + have hmL : m ∈ closure OL := (P3544T1LocalParity S.left).1.symm ▸ Or.inr (heL hme) + have hmR : m ∈ closure OR := (P3544T1LocalParity S.right).1.symm ▸ Or.inr (heR hme) + obtain ⟨xL, hxL, hdL⟩ := Metric.mem_closure_iff.mp hmL r hr + obtain ⟨xR, hxR, hdR⟩ := Metric.mem_closure_iff.mp hmR r hr + have hbL : xL ∈ Metric.ball m r := by simpa only [Metric.mem_ball, dist_comm] using hdL + have hbR : xR ∈ Metric.ball m r := by simpa only [Metric.mem_ball, dist_comm] using hdR + have hb : m ∈ Metric.ball m r := Metric.mem_ball_self hr + have hballc := (convex_ball m r).isPathConnected ⟨m, hb⟩ + have hdc := (convex_openSegment (p.vertex S.a) (p.vertex S.b)).isPathConnected ⟨m, hm⟩ + have hconn := ((hcL.union hballc ⟨xL, hxL, hbL⟩).union hcR + ⟨xR, Or.inr hbR, hxR⟩).union hdc ⟨m, Or.inl (Or.inr hb), hm⟩ + have heq : ((OL ∪ Metric.ball m r) ∪ OR) ∪ d = P3544T1RayParity p := by + rw [hodd] + have hsub : Metric.ball m r ⊆ OL ∪ OR ∪ d := hodd ▸ hball + ext x + constructor + · rintro (((hx | hx) | hx) | hx) + · exact Or.inl (Or.inl hx) + · exact hsub hx + · exact Or.inl (Or.inr hx) + · exact Or.inr hx + · rintro ((hx | hx) | hx) + · exact Or.inl (Or.inl (Or.inl hx)) + · exact Or.inl (Or.inr hx) + · exact Or.inr hx + exact ⟨hodd, hfill, heq ▸ hconn⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1TriangleFaceRestriction.lean b/LeanPool/ApollonianSuperharmonic/P3652T1TriangleFaceRestriction.lean new file mode 100644 index 0000000000..efdf33db7a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3652T1TriangleFaceRestriction.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public import Mathlib.Analysis.Convex.Combination + +-- [TABLET NODE: P3652T1TriangleFaceRestriction] + +/-! +# P3652T1TriangleFaceRestriction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3652T1TriangleFaceRestriction (v : Fin 3 → Real × Real) + (hv : P3381T1TriangleDeterminant v ≠ 0) (s t : Set (Fin 3)) : + convexHull Real (v '' s) ∩ convexHull Real (v '' t) = + convexHull Real (v '' (s ∩ t)) := by +-- BODY + classical + have ha : AffineIndependent Real v := by + apply (affineIndependent_iff_of_fintype Real v).mpr + intro w hw hs i + rw [Finset.weightedVSub_eq_linear_combination _ hw] at hs + have hw' : w 0 + w 1 + w 2 = 0 := by + simpa [Fin.sum_univ_succ, add_assoc] using hw + have hx : w 0 * (v 0).1 + (w 1 * (v 1).1 + w 2 * (v 2).1) = 0 := by + simpa [Fin.sum_univ_succ] using congrArg Prod.fst hs + have hy : w 0 * (v 0).2 + (w 1 * (v 1).2 + w 2 * (v 2).2) = 0 := by + simpa [Fin.sum_univ_succ] using congrArg Prod.snd hs + have hx' : w 1 * ((v 1).1 - (v 0).1) + w 2 * ((v 2).1 - (v 0).1) = 0 := by + linear_combination hx - (v 0).1 * hw' + have hy' : w 1 * ((v 1).2 - (v 0).2) + w 2 * ((v 2).2 - (v 0).2) = 0 := by + linear_combination hy - (v 0).2 * hw' + have h1 : w 1 * P3381T1TriangleDeterminant v = 0 := by + dsimp [P3381T1TriangleDeterminant] + linear_combination ((v 2).2 - (v 0).2) * hx' - ((v 2).1 - (v 0).1) * hy' + have h2 : w 2 * P3381T1TriangleDeterminant v = 0 := by + dsimp [P3381T1TriangleDeterminant] + linear_combination ((v 1).1 - (v 0).1) * hy' - ((v 1).2 - (v 0).2) * hx' + have hw1 : w 1 = 0 := (mul_eq_zero.mp h1).resolve_right hv + have hw2 : w 2 = 0 := (mul_eq_zero.mp h2).resolve_right hv + have hw0 : w 0 = 0 := by linarith + fin_cases i <;> assumption + have hfin : (Set.range v).Finite := Set.finite_range v + have hsfin : (v '' s).Finite := s.toFinite.image v + have htfin : (v '' t).Finite := t.toFinite.image v + have ha' : AffineIndependent Real ((↑) : hfin.toFinset → Real × Real) := by + change AffineIndependent Real ((↑) : (↑hfin.toFinset : Set (Real × Real)) → Real × Real) + rw [Set.Finite.coe_toFinset] + exact ha.range + have his : hsfin.toFinset ⊆ hfin.toFinset := by + intro x hx + exact hfin.mem_toFinset.mpr (Set.image_subset_range _ _ (hsfin.mem_toFinset.mp hx)) + have hit : htfin.toFinset ⊆ hfin.toFinset := by + intro x hx + exact hfin.mem_toFinset.mpr (Set.image_subset_range _ _ (htfin.mem_toFinset.mp hx)) + have h := ha'.convexHull_inter his hit + simpa only [Finset.coe_inter, Set.Finite.coe_toFinset, + ← Set.image_inter ha.injective] using h.symm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean new file mode 100644 index 0000000000..9ea9fdfa6c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean @@ -0,0 +1,3646 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting +public import LeanPool.ApollonianSuperharmonic.P3723T1GridDiskBoundaryStars +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +/-! +# P3723T1AllContactDrawingExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open Set + +-- [TABLET NODE: P3723T1AllContactDrawingExists] +namespace ContactDrawingGeometry + +private theorem symmetric : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P + a b ↔ P3723T1EdgeContact P b a ) := by + classical + intro ι P a b + simp only [P3723T1EdgeContact, ne_comm, Set.inter_comm] + +private theorem present : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (p : Real × Real), (D.port a b = some p) → (P3723T1EdgeContact P a b) + ) := by + classical + intro ι P D a b p hp + by_contra hn + have he := (D.port_eq_none_iff a b).mpr hn + rw [hp] at he + cases he + +private theorem port_exists : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), (P3723T1EdgeContact P a b) → (∃ p, D.port a b = some p) ) := by + classical + intro ι P D a b hab + exact ⟨_, D.port_midpoint a b hab⟩ + +private theorem qinjective : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ + (port_exists : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → (∃ p, D.port a b + = some p)), + let q (a : ι) (b : {b // P3723T1EdgeContact P a b}) : Real × Real := + Classical.choose (port_exists a b b.property) + (∀ (a : ι), ∀ (b : {b // P3723T1EdgeContact P a b}), D.port a b = some (q a b)) → (∀ (a + : ι), Function.Injective (q a)) ) := by + classical + intro ι P D port_exists q hq a b c heq + apply Subtype.ext + by_contra hne + exact D.incident_ports_distinct a b c (q a b) (q a c) (hq a b) (hq a c) hne heq + +private theorem pulled_contact : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (P3723T1ContactPorts P) → ( + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + (∀ (a : ι), a = P.shift (period a) (rep a)) → (∀ (a : ι), ∀ (b : ι), + (P3723T1EdgeContact P a b) → (P3723T1EdgeContact P (rep a) (P.shift (-period a) + b)))) ) := by + classical + intro ι P D rep rep_spec period period_spec a b hab + have ht := (D.contact_periodic (-period a) a b).mpr hab + have hs : P.shift (-period a) a = rep a := by + calc + P.shift (-period a) a = P.shift (-period a) (P.shift (period a) (rep a)) := + congrArg (P.shift (-period a)) (period_spec a) + _ = P.shift (-period a + period a) (rep a) := (P.shift_add _ _ _).symm + _ = rep a := by rw [neg_add_cancel, P.shift_zero] + rw [hs] at ht + exact ht + +private theorem gproperties : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ + (port_exists : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → (∃ p, D.port a b + = some p)), + let q (a : ι) (b : {b // P3723T1EdgeContact P a b}) : Real × Real := + Classical.choose (port_exists a b b.property) + (∀ (a : ι), ∀ (b : {b // P3723T1EdgeContact P a b}), D.port a b = some (q a b)) → (∀ + (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 + : ℝ)) : Type) → ℝ × ℝ), (∀ (a : ι), ∀ (i : { b : ι // P3723T1EdgeContact P a b }), + Continuous (localStar a i) ∧ + Function.Injective (localStar a i) ∧ localStar a i ⟨(0 : ℝ), + by norm_num⟩ = D.position a ∧ localStar a i ⟨(1 : ℝ), + by norm_num⟩ = q a i ∧ Nonempty + (P3723T1PolygonalParameterization (localStar a i))) → ((∀ (a : ι), ∀ (i : + { b : ι // P3723T1EdgeContact P a b }), range (localStar a i) ⊆ interior + (TileRealization (P.tile a)) ∪ {q a i}) → ( + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + (∀ (a : ι), a = P.shift (period a) (rep a)) → (∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), + (P3723T1EdgeContact P a b) → (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ a, ∀ b, P3723T1EdgeContact P a b → + Continuous (g a b) ∧ Function.Injective (g a b) ∧ + g a b ⟨0, by norm_num⟩ = D.position a ∧ + D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ + Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ + Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ + {g a b ⟨1, by norm_num⟩}))))) := by + classical + intro ι P D port_exists q hq localStar local_properties local_support rep rep_spec period + period_spec pulled_contact g a b hab + let r := rep a + let u := period a + let c : {b // P3723T1EdgeContact P r b} := + ⟨P.shift (-u) b, pulled_contact a b hab⟩ + let w := GaussianRealPoint u + have heq : g a b = fun s => localStar r c s + w := by + funext s + simp only [g, dite_eq_left hab] + rfl + obtain ⟨hc, hi, h0, h1, ⟨poly⟩⟩ := local_properties r c + have hcenter : D.position a = D.position r + w := + (congrArg D.position (period_spec a)).trans (D.position_periodic u r) + have hneighbor : P.shift u c = b := by + change P.shift u (P.shift (-u) b) = b + rw [← P.shift_add, add_neg_cancel, P.shift_zero] + have hport : D.port a b = some (q r c + w) := by + calc + D.port a b = D.port (P.shift u r) (P.shift u c) := + congrArg₂ D.port (period_spec a) hneighbor.symm + _ = (D.port r c).map (fun p => p + w) := D.port_periodic u r c + _ = some (q r c + w) := by rw [hq r c]; rfl + have htile : P.tile a = TileTranslation (P.tile r) u := + (congrArg P.tile (period_spec a)).trans (P.tile_periodic u r) + have hrealization : TileRealization (P.tile a) = + (fun p => p + w) '' TileRealization (P.tile r) := by + rw [htile] + exact (TileTranslationFormulas (P.tile r) u).2.2.2.1 + have hinterior : interior (TileRealization (P.tile a)) = + (fun p => p + w) '' interior (TileRealization (P.tile r)) := by + rw [hrealization] + exact ((Homeomorph.addRight w).image_interior _).symm + rw [heq] + refine ⟨hc.add continuous_const, ?_, ?_, ?_, ?_, ?_⟩ + · intro s t hst + exact hi (add_right_cancel hst) + · change localStar r c ⟨0, by norm_num⟩ + w = D.position a + rw [h0, ← hcenter] + · change D.port a b = some (localStar r c ⟨1, by norm_num⟩ + w) + rw [h1] + exact hport + · refine ⟨{ + count := poly.count + positive := poly.positive + time := poly.time + strict := poly.strict + start := poly.start + finish := poly.finish + affine_on := ?_ + }⟩ + intro i + obtain ⟨A, B, hpiece⟩ := poly.affine_on i + refine ⟨A + w, B, ?_⟩ + intro s hs ht + rw [hpiece s hs ht] + abel + · rintro z ⟨s, rfl⟩ + rcases local_support r c (Set.mem_range_self s) with hz | hz + · apply Or.inl + rw [hinterior] + exact ⟨localStar r c s, hz, rfl⟩ + · apply Or.inr + rw [Set.mem_singleton_iff] at hz ⊢ + change localStar r c s + w = localStar r c ⟨1, by norm_num⟩ + w + rw [hz, h1] + +private theorem range_form : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ + (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : + ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (a : ι), ∀ (b : ι), ∀ (hab : P3723T1EdgeContact P a b), Set.range (g a b) = (fun p => + p + GaussianRealPoint (period a)) '' Set.range (localStar (rep a) ⟨P.shift (-period + a) b, pulled_contact a b hab⟩) ) := by + classical + intro ι P D localStar rep rep_spec period pulled_contact g a b hab + ext z + constructor + · rintro ⟨s, rfl⟩ + refine ⟨localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s, + ⟨s, rfl⟩, ?_⟩ + simp only [g, dite_eq_left hab] + · rintro ⟨p, ⟨s, rfl⟩, rfl⟩ + refine ⟨s, ?_⟩ + simp only [g, dite_eq_left hab] + +private theorem gintersections : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ + (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : + ℝ)) : Type) → ℝ × ℝ), (∀ (a : ι), ∀ (i : { b : ι // P3723T1EdgeContact P a b }), ∀ + (j : { b : ι // P3723T1EdgeContact P a b }), i ≠ j → range (localStar a i) ∩ range + (localStar a j) = {D.position a}) → ( + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + (∀ (a : ι), a = P.shift (period a) (rep a)) → (∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), + (P3723T1EdgeContact P a b) → (P3723T1EdgeContact P (rep a) (P.shift (-period a) + b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + (∀ (a : ι), ∀ (b : ι), ∀ (hab : P3723T1EdgeContact P a b), Set.range (g a b) = (fun p + => p + GaussianRealPoint (period a)) '' Set.range (localStar (rep a) ⟨P.shift + (-period a) b, pulled_contact a b hab⟩)) → (∀ a, ∀ b, ∀ c, P3723T1EdgeContact P a b + → P3723T1EdgeContact P a c → b ≠ c → Set.range (g a b) ∩ Set.range (g a c) = + {D.position a}))) ) := by + classical + intro ι P D localStar local_intersections rep rep_spec period period_spec pulled_contact g + range_form a b c hab hac hbc + let B : {b // P3723T1EdgeContact P (rep a) b} := + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ + let C : {b // P3723T1EdgeContact P (rep a) b} := + ⟨P.shift (-period a) c, pulled_contact a c hac⟩ + have hne : B ≠ C := by + intro h + have hh : P.shift (-period a) b = P.shift (-period a) c := congrArg Subtype.val h + apply hbc + simpa only [← P.shift_add, add_neg_cancel, P.shift_zero] using + congrArg (P.shift (period a)) hh + have hj := local_intersections (rep a) B C hne + rw [range_form a b hab, range_form a c hac, + ← Set.image_inter (show Function.Injective + (fun p : Real × Real => p + GaussianRealPoint (period a)) from + fun _ _ h => add_right_cancel h), hj, Set.image_singleton] + rw [← D.position_periodic, ← period_spec a] + +private theorem gperiodic : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ + (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : + ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + (∀ (a : ι), a = P.shift (period a) (rep a)) → (∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), + (P3723T1EdgeContact P a b) → (P3723T1EdgeContact P (rep a) (P.shift (-period a) + b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ u : P.lattice, ∀ a, ∀ b, P3723T1EdgeContact P a b → ∀ s, g (P.shift u a) (P.shift u + b) s = g a b s + GaussianRealPoint u) ) := by + classical + intro ι P D localStar rep rep_spec period period_spec pulled_contact g u a b hab s + have hrep : rep (P.shift u a) = rep a := by + apply (P.vertex_orbit_representatives (P.shift u a)).unique + · exact rep_spec (P.shift u a) + · refine ⟨(rep_spec a).1, ?_⟩ + refine ⟨u + period a, ?_⟩ + calc + P.shift u a = P.shift u (P.shift (period a) (rep a) : ι) := + congrArg (P.shift u) (period_spec a) + _ = P.shift (u + period a) (rep a) := (P.shift_add u (period a) (rep a)).symm + have hperiod : period (P.shift u a) = u + period a := by + have hleft := period_spec (P.shift u a) + rw [hrep] at hleft + have hrepperiod : P.shift (period (P.shift u a)) (rep a) = + P.shift (u + period a) (rep a) := by + calc + P.shift (period (P.shift u a)) (rep a) = P.shift u a := hleft.symm + _ = P.shift u (P.shift (period a) (rep a)) := + congrArg (P.shift u) (period_spec a) + _ = P.shift (u + period a) (rep a) := + (P.shift_add u (period a) (rep a)).symm + have hfix : P.shift (period (P.shift u a) - (u + period a)) (rep a) = rep a := by + calc + P.shift (period (P.shift u a) - (u + period a)) (rep a) = + P.shift (-(u + period a)) + (P.shift (period (P.shift u a)) (rep a)) := by + rw [← P.shift_add] + congr 1; abel + _ = P.shift (-(u + period a)) (P.shift (u + period a) (rep a)) := + congrArg (P.shift (-(u + period a))) hrepperiod + _ = rep a := by rw [← P.shift_add, neg_add_cancel, P.shift_zero] + have hz := D.unordered_stabilizer + (period (P.shift u a) - (u + period a)) (rep a) (rep a) (by + simpa using congrArg (fun x : ι => ({x, x} : Set ι)) hfix) + have : period (P.shift u a) - (u + period a) = 0 := hz + exact (sub_eq_zero.mp this) + have hcontact : P3723T1EdgeContact P (P.shift u a) (P.shift u b) := + (D.contact_periodic u a b).mpr hab + have hneighbor : P.shift (-period (P.shift u a)) (P.shift u b) = + P.shift (-period a) b := by + rw [hperiod, ← P.shift_add] + congr 1; abel + have hgauss : GaussianRealPoint (period (P.shift u a)) = + GaussianRealPoint (period a) + GaussianRealPoint u := by + rw [hperiod] + ext <;> simp [GaussianRealPoint] <;> ring + simp only [g, dite_eq_left hcontact, dite_eq_left hab] + let c₁ : {x // P3723T1EdgeContact P (rep (P.shift u a)) x} := + ⟨P.shift (-period (P.shift u a)) (P.shift u b), + pulled_contact (P.shift u a) (P.shift u b) hcontact⟩ + let c₂ : {x // P3723T1EdgeContact P (rep a) x} := + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ + have htypes : {x // P3723T1EdgeContact P (rep (P.shift u a)) x} = + {x // P3723T1EdgeContact P (rep a) x} := + congrArg (fun r => {x // P3723T1EdgeContact P r x}) hrep + have castSubtypeVal {p q : ι → Prop} (e : p = q) (x : {y // p y}) : + (cast (congrArg (fun r => {y // r y}) e) x).val = x.val := by + cases e + rfl + have hcast : cast htypes c₁ = c₂ := by + apply Subtype.ext + have hv := castSubtypeVal + (congrArg (fun r => P3723T1EdgeContact P r) hrep) c₁ + change (cast htypes c₁).val = c₂.val + exact hv.trans hneighbor + have hc₁₂ : c₁ ≍ c₂ := (cast_heq htypes c₁).symm.trans (heq_of_eq hcast) + have hpair : (⟨rep (P.shift u a), c₁⟩ : + Σ r, {x // P3723T1EdgeContact P r x}) = ⟨rep a, c₂⟩ := by + exact Sigma.ext hrep hc₁₂ + have hstar := congrArg + (fun z : Σ r, {x // P3723T1EdgeContact P r x} => localStar z.1 z.2 s) hpair + change localStar (rep (P.shift u a)) c₁ s = localStar (rep a) c₂ s at hstar + rw [hstar, hgauss] + abel + +private theorem half_parameters : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), (∀ (a : ι), + ∀ (b : ι), ∀ (p : Real × Real), (D.port a b = some p) → + (P3723T1EdgeContact P a b)) → (∀ (localStar : (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + (∀ a, ∀ b, P3723T1EdgeContact P a b → + Continuous (g a b) ∧ Function.Injective (g a b) ∧ + g a b ⟨0, by norm_num⟩ = D.position a ∧ + D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ + Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ + Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ + {g a b ⟨1, by norm_num⟩}) → ( + let halfArc (a b : ι) : Set (Real × Real) := + if P3723T1EdgeContact P a b then Set.range (g a b) else ∅ + ∀ a, ∀ b, ∀ p, D.port a b = some p → + ∃ f : Icc (0 : Real) 1 → Real × Real, + Continuous f ∧ Function.Injective f ∧ Set.range f = halfArc a b ∧ + f ⟨0, by norm_num⟩ = D.position a ∧ f ⟨1, by norm_num⟩ = p ∧ + Nonempty (P3723T1PolygonalParameterization f)))) := by + classical + intro ι P D present localStar rep rep_spec period pulled_contact g gproperties halfArc a b p hp + have hab := present a b p hp + obtain ⟨hc, hi, h0, h1, hpoly, _hsupport⟩ := gproperties a b hab + have hend : g a b ⟨1, by norm_num⟩ = p := Option.some.inj (h1.symm.trans hp) + exact ⟨g a b, hc, hi, by simp only [halfArc, ite_eq_left hab], h0, hend, hpoly⟩ + +private theorem hclip_cont : + (by + classical + exact + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + Continuous clip ) := by + classical + intro clip + apply Continuous.subtype_mk + exact continuous_const.max (continuous_const.min continuous_id) + +private theorem hmeet : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (hg1ab : D.port a b = some (g a b ⟨(1 : ℝ), by norm_num⟩)), ∀ (hg1ba : D.port b a = + some (g b a + ⟨(1 : ℝ), by norm_num⟩)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) + let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + ∀ (s : Icc (0 : Real) 1), (s ∈ (Set.univ : Set (Icc (0 : Real) 1)) ∩ frontier A) → (left + s = right s) ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g hg1ab hg1ba clip left right + A s hs + have hend : g a b ⟨1, by norm_num⟩ = g b a ⟨1, by norm_num⟩ := by + apply Option.some.inj + calc + some (g a b ⟨1, by norm_num⟩) = D.port a b := hg1ab.symm + _ = D.port b a := D.port_symmetric a b + _ = some (g b a ⟨1, by norm_num⟩) := hg1ba + have hhalf : (s : Real) = 1 / 2 := by + have hcl : s ∈ closure A := hs.2.1 + have hnint : s ∉ interior A := hs.2.2 + have hAclosed : IsClosed A := isClosed_Iic.preimage continuous_subtype_val + have hle : (s : Real) ≤ 1 / 2 := hAclosed.closure_subset hcl + have hge : 1 / 2 ≤ (s : Real) := by + by_contra h + have hlt : (s : Real) < 1 / 2 := lt_of_not_ge h + have hopen : IsOpen ((Subtype.val : Icc (0 : Real) 1 → Real) ⁻¹' Set.Iio (1 / 2 : Real)) := + isOpen_Iio.preimage continuous_subtype_val + have hsub : ((Subtype.val : Icc (0 : Real) 1 → Real) ⁻¹' Set.Iio (1 / 2 : Real)) ⊆ A := by + intro t ht + change (t : Real) < 1 / 2 at ht + exact le_of_lt ht + have hmem : s ∈ interior A := mem_interior_iff_mem_nhds.mpr + (Filter.mem_of_superset (hopen.mem_nhds hlt) hsub) + exact hnint hmem + linarith + have hscale₁ : clip (2 * s) = ⟨1, by norm_num⟩ := by + apply Subtype.ext + simp [clip, hhalf] + have hscale₂ : clip (2 - 2 * s) = ⟨1, by norm_num⟩ := by + apply Subtype.ext + norm_num [clip, hhalf] + simp only [left, right, hscale₁, hscale₂] + exact hend + +private theorem hfcont : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) + let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right + (Continuous left) → ((Continuous right) → ((∀ (s : Icc (0 : Real) 1), (s ∈ (Set.univ : + Set (Icc (0 : Real) 1)) ∩ frontier A) → (left s = right s)) → (Continuous f))) ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g clip left right A f hleftc + hrightc hmeet + apply continuousOn_univ.mp + apply ContinuousOn.piecewise (s := Set.univ) (t := A) hmeet + · exact hleftc.continuousOn.mono + (show Set.univ ∩ closure A ⊆ Set.univ from fun _ _ => Set.mem_univ _) + · exact hrightc.continuousOn.mono + (show Set.univ ∩ closure Aᶜ ⊆ Set.univ from fun _ _ => Set.mem_univ _) + +private theorem hscale_left : + (by + classical + exact + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + ∀ (s : Icc (0 : Real) 1), (s ∈ A) → ((clip (2 * s) : Real) = 2 * s) ) := by + classical + intro clip A s hs + have hnonneg : 0 ≤ (2 * (s : Real)) := by nlinarith [s.property.1] + have hle : 2 * (s : Real) ≤ 1 := by dsimp [A] at hs; nlinarith [s.property.1] + simp [clip, max_eq_right hnonneg, min_eq_right hle] + +private theorem hscale_right : + (by + classical + exact + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + ∀ (s : Icc (0 : Real) 1), (s ∉ A) → ((clip (2 - 2 * s) : Real) = 2 - 2 * s) ) := by + classical + intro clip A s hs + have hnonneg : 0 ≤ 2 - 2 * (s : Real) := by + have : (1 / 2 : Real) ≤ s := by dsimp [A] at hs; linarith + nlinarith [s.property.2] + have hle : 2 - 2 * (s : Real) ≤ 1 := by + have : (1 / 2 : Real) < s := by dsimp [A] at hs; linarith + nlinarith + simp [clip, max_eq_right hnonneg, min_eq_right hle] + +private theorem hf0 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (hg0ab : g a b ⟨(0 : ℝ), by norm_num⟩ = D.position a), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) + let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right + f ⟨0, by norm_num⟩ = D.position a ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g hg0ab clip left right A f + have hz : (⟨0, by norm_num⟩ : Icc (0 : Real) 1) ∈ A := by simp [A] + have hc : clip (0 : Real) = ⟨0, by norm_num⟩ := by + apply Subtype.ext + simp [clip] + have hEq : Set.EqOn f left A := Set.piecewise_eqOn A left right + calc + f ⟨0, by norm_num⟩ = left ⟨0, by norm_num⟩ := hEq hz + _ = D.position a := by + simp only [left, show (2 : Real) * (0 : Real) = 0 by norm_num, hc] + simpa [g, dite_eq_left hab] using hg0ab + +private theorem hf1 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (hba : P3723T1EdgeContact P b a), ∀ (hg0ba : g b a ⟨(0 : ℝ), by norm_num⟩ = + D.position b), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) + let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right + f ⟨1, by norm_num⟩ = D.position b ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g hba hg0ba clip left right A f + have hz : (⟨1, by norm_num⟩ : Icc (0 : Real) 1) ∉ A := by norm_num [A] + have hc : clip (0 : Real) = ⟨0, by norm_num⟩ := by + apply Subtype.ext + simp [clip] + have hEq : Set.EqOn f right Aᶜ := Set.piecewise_eqOn_compl A left right + calc + f ⟨1, by norm_num⟩ = right ⟨1, by norm_num⟩ := hEq hz + _ = D.position b := by + simp only [right, show (2 : Real) - 2 * (1 : Real) = 0 by norm_num, hc] + simpa [g, dite_eq_left hba] using hg0ba + +private theorem hendab : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + (∀ a, ∀ b, P3723T1EdgeContact P a b → + Continuous (g a b) ∧ Function.Injective (g a b) ∧ + g a b ⟨0, by norm_num⟩ = D.position a ∧ + D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ + Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ + Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ + {g a b ⟨1, by norm_num⟩}) → (∀ (p : ℝ × ℝ), (D.port a b = some p) → (g a b ⟨1, + by norm_num⟩ = p)))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g gproperties p hp + have h₁ := (gproperties a b hab).2.2.2.1 + exact Option.some.inj (h₁.symm.trans hp) + +private theorem hendba : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + (∀ a, ∀ b, P3723T1EdgeContact P a b → + Continuous (g a b) ∧ Function.Injective (g a b) ∧ + g a b ⟨0, by norm_num⟩ = D.position a ∧ + D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ + Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ + Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ + {g a b ⟨1, by norm_num⟩}) → ((P3723T1EdgeContact P b a) → (∀ (p : ℝ × ℝ), (D.port b + a = some p) → (g b a ⟨1, by norm_num⟩ = p))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g gproperties hba p hpba + have h₁ := (gproperties b a hba).2.2.2.1 + exact Option.some.inj (h₁.symm.trans hpba) + +private theorem hcross : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + (range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ {g a b ⟨(1 : ℝ), + by norm_num⟩}) → ((range (g b a) ⊆ interior (TileRealization (P.tile b)) ∪ {g b a ⟨(1 + : ℝ), + by norm_num⟩}) → (∀ (p : ℝ × ℝ), (g a b ⟨1, by norm_num⟩ = p) → ((g b a + ⟨1, by norm_num⟩ + = p) → (Set.range (g a b) ∩ Set.range (g b a) = {p})))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g hsab hsba p hendab hendba + ext z + constructor + · rintro ⟨⟨s, rfl⟩, ⟨t, ht⟩⟩ + have hsupp := hsab (Set.mem_range_self s) + have htsupp := hsba ⟨t, ht⟩ + rcases hsupp with hia | hpa + · rcases htsupp with hib | hpb + · exfalso + have hne : a ≠ b := hab.1 + have hmem : g a b s ∈ TileRealization (P.tile b) := interior_subset hib + exact Set.disjoint_left.mp (D.interior_disjoint_tiles a b hne) hia hmem + · simp only [Set.mem_singleton_iff] at hpb + have : g a b s = p := hpb.trans hendba + exact this + · simp only [Set.mem_singleton_iff] at hpa + have : g a b s = p := hpa.trans hendab + exact this + · intro hz + rw [Set.mem_singleton_iff] at hz + subst z + refine ⟨⟨⟨1, by norm_num⟩, hendab⟩, ?_⟩ + exact ⟨⟨1, by norm_num⟩, hendba⟩ + +private theorem hfinj : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (higab : Function.Injective (g a b)), ∀ (higba : Function.Injective (g b a)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) + let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right + (∀ (s : Icc (0 : Real) 1), (s ∈ A) → ((clip (2 * s) : Real) = 2 * s)) → ((∀ (s : Icc (0 : + Real) 1), (s ∉ A) → ((clip (2 - 2 * s) : Real) = 2 - + 2 * s)) → (∀ (p : ℝ × ℝ), (g a b ⟨1, by norm_num⟩ = p) → ((g b a ⟨1, + by norm_num⟩ = p) → ((Set.range (g a b) ∩ Set.range (g b a) = {p}) → + (Function.Injective f)))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g higab higba clip left right + A f hscale_left hscale_right p hendab hendba hcross s t hst + by_cases hs : s ∈ A + · by_cases ht : t ∈ A + · have hval : g a b (clip (2 * s)) = g a b (clip (2 * t)) := by + simpa [f, hs, ht, left] using hst + have harg := higab hval + apply Subtype.ext + have hv := congrArg (fun x : Icc (0 : Real) 1 => (x : Real)) harg + rw [hscale_left s hs, hscale_left t ht] at hv + nlinarith + · have hval : g a b (clip (2 * s)) = g b a (clip (2 - 2 * t)) := by + simpa [f, hs, ht, left, right] using hst + have hm : g a b (clip (2 * s)) ∈ Set.range (g a b) ∩ Set.range (g b a) := + ⟨⟨clip (2 * s), rfl⟩, ⟨clip (2 - 2 * t), hval.symm⟩⟩ + have hm' : g a b (clip (2 * s)) = p := by simpa [hcross] using hm + have hleftend : clip (2 * s) = ⟨1, by norm_num⟩ := + higab (hm'.trans hendab.symm) + have hrightp : g b a (clip (2 - 2 * t)) = p := hval.symm.trans hm' + have hrightend : clip (2 - 2 * t) = ⟨1, by norm_num⟩ := + higba (hrightp.trans hendba.symm) + apply Subtype.ext + have hv₁ := congrArg (fun x : Icc (0 : Real) 1 => (x : Real)) hleftend + have hv₂ := congrArg (fun x : Icc (0 : Real) 1 => (x : Real)) hrightend + have hsval : 2 * (s : Real) = 1 := by + calc + _ = (clip (2 * s) : Real) := (hscale_left s hs).symm + _ = 1 := congrArg Subtype.val hleftend + have htval : 2 - 2 * (t : Real) = 1 := by + calc + _ = (clip (2 - 2 * t) : Real) := (hscale_right t ht).symm + _ = 1 := congrArg Subtype.val hrightend + nlinarith + · by_cases ht : t ∈ A + · have hval : g b a (clip (2 - 2 * s)) = g a b (clip (2 * t)) := by + simpa [f, hs, ht, left, right] using hst + have hm : g b a (clip (2 - 2 * s)) ∈ Set.range (g a b) ∩ Set.range (g b a) := + ⟨⟨clip (2 * t), hval.symm⟩, ⟨clip (2 - 2 * s), rfl⟩⟩ + have hm' : g b a (clip (2 - 2 * s)) = p := by + have hmem := hcross ▸ hm + simpa using hmem + have hrightend : clip (2 - 2 * s) = ⟨1, by norm_num⟩ := + higba (hm'.trans hendba.symm) + have hleftp : g a b (clip (2 * t)) = p := hval.symm.trans hm' + have hleftend : clip (2 * t) = ⟨1, by norm_num⟩ := + higab (hleftp.trans hendab.symm) + apply Subtype.ext + have hv₁ := congrArg (fun x : Icc (0 : Real) 1 => (x : Real)) hrightend + have hv₂ := congrArg (fun x : Icc (0 : Real) 1 => (x : Real)) hleftend + have hsval : 2 - 2 * (s : Real) = 1 := by + calc + _ = (clip (2 - 2 * s) : Real) := (hscale_right s hs).symm + _ = 1 := congrArg Subtype.val hrightend + have htval : 2 * (t : Real) = 1 := by + calc + _ = (clip (2 * t) : Real) := (hscale_left t ht).symm + _ = 1 := congrArg Subtype.val hleftend + nlinarith + · have hval : g b a (clip (2 - 2 * s)) = g b a (clip (2 - 2 * t)) := by + simpa [f, hs, ht, right] using hst + have harg := higba hval + apply Subtype.ext + have hv := congrArg (fun x : Icc (0 : Real) 1 => (x : Real)) harg + rw [hscale_right s hs, hscale_right t ht] at hv + linarith + +private theorem hrange : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + let halfArc (a b : ι) : Set (Real × Real) := + if P3723T1EdgeContact P a b then Set.range (g a b) else ∅ + let edgeArc (a b : ι) : Set (Real × Real) := halfArc a b ∪ halfArc b a + ∀ (hba : P3723T1EdgeContact P b a), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) + let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right + ∀ (p : ℝ × ℝ), (g a b ⟨1, by norm_num⟩ = p) → ((g b a ⟨1, by norm_num⟩ = p) → + (Set.range f = edgeArc a b))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g halfArc edgeArc hba clip + left right A f p hendab hendba + have harc : edgeArc a b = Set.range (g a b) ∪ Set.range (g b a) := by + simp [edgeArc, halfArc, hab, hba] + rw [harc] + ext z + constructor + · rintro ⟨s, rfl⟩ + by_cases hs : s ∈ A + · left + refine ⟨clip (2 * s), ?_⟩ + simpa [f, left] using (Set.piecewise_eqOn A left right hs).symm + · right + refine ⟨clip (2 - 2 * s), ?_⟩ + simpa [f, right] using (Set.piecewise_eqOn_compl A left right hs).symm + · intro hz + rcases hz with hz | hz + · obtain ⟨t, rfl⟩ := hz + let s : Icc (0 : Real) 1 := ⟨(t : Real) / 2, div_nonneg t.property.1 (by norm_num), + by nlinarith [t.property.2]⟩ + have hsA : s ∈ A := by dsimp [A, s]; nlinarith [t.property.2] + have hscale : clip (2 * s) = t := by + apply Subtype.ext + have ht0 := t.property.1 + have ht1 := t.property.2 + change max 0 (min 1 (2 * (s : Real))) = (t : Real) + rw [show 2 * (s : Real) = (t : Real) by dsimp [s]; ring] + simp [max_eq_right ht0, min_eq_right ht1] + refine ⟨s, ?_⟩ + calc + f s = left s := Set.piecewise_eqOn A left right hsA + _ = g a b t := by simp [left, hscale] + · obtain ⟨t, rfl⟩ := hz + by_cases htone : t = ⟨1, by norm_num⟩ + · subst t + let s : Icc (0 : Real) 1 := ⟨1 / 2, by norm_num, by norm_num⟩ + have hsA : s ∈ A := by simp [A, s] + have hclip : clip (2 * s) = ⟨1, by norm_num⟩ := by + apply Subtype.ext + norm_num [clip, s] + refine ⟨s, ?_⟩ + calc + f s = left s := Set.piecewise_eqOn A left right hsA + _ = g a b ⟨1, by norm_num⟩ := by simp [left, hclip] + _ = g b a ⟨1, by norm_num⟩ := hendab.trans hendba.symm + · have htlt : (t : Real) < 1 := by + by_contra h + have : (t : Real) = 1 := by linarith [t.property.2] + exact htone (Subtype.ext this) + let s : Icc (0 : Real) 1 := ⟨1 - (t : Real) / 2, by linarith [t.property.2], by linarith + [t.property.1]⟩ + have hsA : s ∉ A := by dsimp [A, s]; nlinarith + have hscale : clip (2 - 2 * s) = t := by + apply Subtype.ext + have ht0 := t.property.1 + have ht1 := t.property.2 + change max 0 (min 1 (2 - 2 * (s : Real))) = (t : Real) + rw [show 2 - 2 * (s : Real) = (t : Real) by dsimp [s]; ring] + simp [max_eq_right ht0, min_eq_right ht1] + refine ⟨s, ?_⟩ + calc + f s = right s := Set.piecewise_eqOn_compl A left right hsA + _ = g b a t := by simp [right, hscale] + +private theorem left_eval : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (j : Fin (m + 1)), tm ⟨j.val, by omega⟩ = polyab.time j / 2)) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm j + have hcond : j.val ≤ m := by omega + simp only [tm, dite_eq_left hcond] + have hj : (⟨j.val, by omega⟩ : Fin (m + 1)) = j := Fin.ext rfl + exact congrArg (fun k : Fin (m + 1) => polyab.time k / 2) hj + +private theorem right_eval : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (j : Fin n), tm ⟨m + 1 + j.val, by omega⟩ = + 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2 ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm j + have hnot : ¬ m + 1 + j.val ≤ m := by omega + simp only [tm, dite_eq_right hnot] + have hj : (⟨n + m - (m + 1 + j.val), by omega⟩ : Fin (n + 1)) = + ⟨n - 1 - j.val, by omega⟩ := by + apply Fin.ext + dsimp [m, n] + omega + exact congrArg (fun k : Fin (n + 1) => 1 - polyba.time k / 2) hj + +private theorem htm_strict : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + (∀ (j : Fin (m + 1)), tm ⟨j.val, by omega⟩ = polyab.time j / 2) → ((∀ (j : Fin n), tm ⟨m + + 1 + j.val, by omega⟩ = + 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2) → (StrictMono tm)))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm + left_eval right_eval + apply Fin.strictMono_iff_lt_succ.mpr + intro i + change tm ⟨i.val, by omega⟩ < tm ⟨i.val + 1, by omega⟩ + by_cases hlt : i.val < m + · let j : Fin (m + 1) := ⟨i.val, by omega⟩ + let j' : Fin (m + 1) := ⟨i.val + 1, by omega⟩ + have hjbound : i.val < polyab.count + 1 := by + dsimp [m] + omega + have hj'bound : i.val + 1 < polyab.count + 1 := by + dsimp [m] + omega + have hjlt : (⟨i.val, hjbound⟩ : Fin (polyab.count + 1)) < + ⟨i.val + 1, hj'bound⟩ := by + apply Fin.mk_lt_mk.mpr + exact Nat.lt_succ_self _ + have hstep := polyab.strict hjlt + rw [left_eval j, left_eval j'] + linarith + · by_cases heq : i.val = m + · have hi : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = ⟨m, by omega⟩ := by + apply Fin.ext + exact heq + have hisucc : (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = ⟨m + 1, by omega⟩ := by + apply Fin.ext + simp [heq] + rw [hi] + rw [hisucc] + let jm : Fin (m + 1) := ⟨m, by omega⟩ + rw [left_eval jm] + have hjlast : jm = Fin.last m := by apply Fin.ext; rfl + rw [hjlast, polyab.finish] + have hright0 : tm ⟨m + 1, by omega⟩ = + 1 - polyba.time ⟨n - 1, by omega⟩ / 2 := by + calc + tm ⟨m + 1, by omega⟩ = tm ⟨m + 1 + 0, by omega⟩ := by + congr 1 + _ = 1 - polyba.time ⟨n - 1 - 0, by omega⟩ / 2 := + right_eval ⟨0, hnpos⟩ + _ = 1 - polyba.time ⟨n - 1, by omega⟩ / 2 := by + congr 1 + rw [hright0] + have hklt : + (⟨n - 1, by simp [n]⟩ : + Fin (polyba.count + 1)) < + ⟨n, by simp [n]⟩ := by + apply Fin.mk_lt_mk.mpr + omega + have hstep := polyba.strict hklt + have hknlast : + (⟨n, by omega⟩ : Fin (polyba.count + 1)) = Fin.last polyba.count := by + apply Fin.ext + rfl + rw [hknlast, polyba.finish] at hstep + linarith + · let j : Fin n := ⟨i.val - m - 1, by omega⟩ + have hij : i.val = m + 1 + j.val := by dsimp [j]; omega + have hjn : j.val + 1 < n := by dsimp [j]; omega + rw [show (⟨i.val, by omega⟩ : Fin (m + n + 1)) = + ⟨m + 1 + j.val, by omega⟩ by apply Fin.ext; simp [hij], + right_eval j, + show (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = + ⟨m + 1 + (j.val + 1), by omega⟩ by apply Fin.ext; simp [hij]; omega, + right_eval ⟨j.val + 1, hjn⟩] + have hklt : + (⟨n - 2 - j.val, by simpa [n] using (show n - 2 - j.val < n + 1 by omega)⟩ : + Fin (polyba.count + 1)) < + ⟨n - 1 - j.val, by simpa [n] using (show n - 1 - j.val < n + 1 by omega)⟩ := by + apply Fin.mk_lt_mk.mpr + omega + have hstep := polyba.strict hklt + have hidx : n - 2 - j.val = n - 1 - (j.val + 1) := by omega + have hidxFin : (⟨n - 2 - j.val, by omega⟩ : Fin (n + 1)) = + ⟨n - 1 - (j.val + 1), by omega⟩ := by + apply Fin.ext + exact hidx + rw [hidxFin] at hstep + linarith + +private theorem htm_start : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + (0 < m) → (∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + (∀ (j : Fin (m + 1)), tm ⟨j.val, by omega⟩ = polyab.time j / 2) → (tm 0 = 0)))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hmpos + hnpos tm left_eval + change tm ⟨0, by omega⟩ = 0 + rw [left_eval ⟨0, by omega⟩] + simp [polyab.start] + +private theorem htm_mid : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + (∀ (j : Fin (m + 1)), tm ⟨j.val, by omega⟩ = polyab.time j / 2) → (tm ⟨m, + by omega⟩ = 1 / 2))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm + left_eval + let jm : Fin (m + 1) := ⟨m, by omega⟩ + rw [left_eval jm] + have hjlast : jm = Fin.last m := by apply Fin.ext; rfl + rw [hjlast, polyab.finish] + +private theorem htm_finish : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + (∀ (j : Fin n), tm ⟨m + 1 + j.val, by omega⟩ = + 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2) → (tm (Fin.last (m + n)) = 1) ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm + right_eval + have hnlast : n - 1 < n := by omega + have hindex : (Fin.last (m + n) : Fin (m + n + 1)) = + ⟨m + 1 + (n - 1), by omega⟩ := by + apply Fin.ext + simp + dsimp [m, n] + omega + rw [hindex, right_eval ⟨n - 1, by omega⟩] + have hidx : n - 1 - (n - 1) = 0 := by omega + have hzero : (⟨n - 1 - (n - 1), by omega⟩ : Fin (n + 1)) = 0 := by + apply Fin.ext + exact hidx + rw [hzero, polyba.start] + ring + +private theorem hcastAt761 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (i : Fin (m + n)), i.castSucc = (⟨i.val, by omega⟩ : Fin (m + n + 1)))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i + apply Fin.ext + rfl + +private theorem hsuccAt764 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (i : Fin (m + n)), i.succ = (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i + apply Fin.ext + rfl + +private theorem hlo'At767 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (i : Fin (m + n)), ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), (tm i.castSucc ≤ + (↑s : ℝ)) → ((i.castSucc = (⟨i.val, by omega⟩ : Fin (m + n + 1))) → (tm ⟨i.val, + by omega⟩ ≤ (s : Real))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm i s hlo + hcast + rw [← hcast] + exact hlo + +private theorem hhi'At770 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (i : Fin (m + n)), ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ((↑s : ℝ) ≤ tm + i.succ) → ((i.succ = (⟨i.val + 1, by omega⟩ : Fin (m + n + 1))) → ((s : Real) ≤ + tm ⟨i.val + 1, by omega⟩)))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm i s hhi + hsucc + rw [← hsucc] + exact hhi + +private theorem hlastbound : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (i : Fin (m + n)), ∀ (hleftidx : (↑i : ℕ) < m), + let j : Fin m := ⟨i.val, by omega⟩ + let j' : Fin (m + 1) := j.succ + polyab.time j' ≤ 1)) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i hleftidx + j j' + calc + polyab.time j' ≤ polyab.time (Fin.last m) := + polyab.strict.monotone (Fin.le_last j') + _ = 1 := polyab.finish + +private theorem hsAAt786 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let m := polyab.count + let n := polyba.count + (0 < n) → ( + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (i : Fin (m + n)), ∀ (hleftidx : (↑i : ℕ) < m), + let j : Fin m := ⟨i.val, by omega⟩ + let j' : Fin (m + 1) := j.succ + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ((s : Real) ≤ tm ⟨i.val + 1, + by omega⟩) → ((tm ⟨i.val + 1, by omega⟩ = polyab.time j' / 2) → ((polyab.time j' ≤ 1) → + (s ∈ A)))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba A m n hnpos tm + i hleftidx j j' s hhi' hend hlastbound + change (s : Real) ≤ 1 / 2 + rw [hend] at hhi' + nlinarith [hlastbound] + +private theorem htlowerAt794 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (i : Fin (m + n)), ∀ (hleftidx : (↑i : ℕ) < m), + let j : Fin m := ⟨i.val, by omega⟩ + let j' : Fin (m + 1) := j.succ + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), ∀ + (hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩), ∀ (hstart : tm ⟨i.val, by omega⟩ = + polyab.time j.castSucc / 2), ∀ (hend : tm ⟨i.val + 1, by omega⟩ = polyab.time j' / + 2), ∀ (hlastbound : polyab.time j' ≤ 1), + let t : Icc (0 : Real) 1 := ⟨2 * (s : Real), by + constructor + · nlinarith [s.property.1] + · nlinarith⟩ + polyab.time j.castSucc ≤ (t : Real) ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm i + hleftidx j j' s hlo' hhi' hstart hend hlastbound t + have h := hlo' + rw [hstart] at h + dsimp [t] + linarith + +private theorem htupperAt799 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (i : Fin (m + n)), ∀ (hleftidx : (↑i : ℕ) < m), + let j : Fin m := ⟨i.val, by omega⟩ + let j' : Fin (m + 1) := j.succ + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hhi' : (s : Real) ≤ tm ⟨i.val + 1, + by omega⟩), ∀ (hend : tm ⟨i.val + 1, by omega⟩ = polyab.time j' / 2), ∀ (hlastbound : + polyab.time j' ≤ 1), + let t : Icc (0 : Real) 1 := ⟨2 * (s : Real), by + constructor + · nlinarith [s.property.1] + · nlinarith⟩ + (t : Real) ≤ polyab.time j' ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm i + hleftidx j j' s hhi' hend hlastbound t + have h := hhi' + rw [hend] at h + dsimp [t] + linarith + +private theorem htvalAt804 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + ∀ (hscale_left : ∀ (s : Icc (0 : Real) 1), (s ∈ A) → ((clip (2 * s) : Real) = 2 * s)), + let m := polyab.count + let n := polyba.count + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (i : Fin (m + n)), ∀ (hleftidx : (↑i : ℕ) < m), + let j : Fin m := ⟨i.val, by omega⟩ + let j' : Fin (m + 1) := j.succ + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hhi' : (s : Real) ≤ tm ⟨i.val + 1, + by omega⟩), ∀ (hend : tm ⟨i.val + 1, by omega⟩ = polyab.time j' / 2), ∀ (hlastbound : + polyab.time j' ≤ 1), (s ∈ A) → ( + let t : Icc (0 : Real) 1 := ⟨2 * (s : Real), by + constructor + · nlinarith [s.property.1] + · nlinarith⟩ + clip (2 * s) = t)) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba clip A + hscale_left m n hnpos tm i hleftidx j j' s hhi' hend hlastbound hsA t + apply Subtype.ext + exact hscale_left s hsA + +private theorem hfvalueAt807 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) + let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right + let m := polyab.count + let n := polyba.count + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (i : Fin (m + n)), ∀ (hleftidx : (↑i : ℕ) < m), + let j : Fin m := ⟨i.val, by omega⟩ + let j' : Fin (m + 1) := j.succ + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hhi' : (s : Real) ≤ tm ⟨i.val + 1, + by omega⟩), ∀ (hend : tm ⟨i.val + 1, by omega⟩ = polyab.time j' / 2), ∀ (hlastbound : + polyab.time j' ≤ 1), (s ∈ A) → ( + let t : Icc (0 : Real) 1 := ⟨2 * (s : Real), by + constructor + · nlinarith [s.property.1] + · nlinarith⟩ + (clip (2 * s) = t) → (f s = g a b t))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba clip left + right A f m n hnpos tm i hleftidx j j' s hhi' hend hlastbound hsA t htval + calc + f s = left s := Set.piecewise_eqOn A left right hsA + _ = g a b t := by simp [left, htval] + +private theorem hcastAt824 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (i : Fin (m + n)), i.castSucc = (⟨i.val, by omega⟩ : Fin (m + n + 1)))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i + apply Fin.ext + rfl + +private theorem hsuccAt827 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (i : Fin (m + n)), i.succ = (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i + apply Fin.ext + rfl + +private theorem hlo'At830 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (i : Fin (m + n)), ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), (tm i.castSucc ≤ + (↑s : ℝ)) → ((i.castSucc = (⟨i.val, by omega⟩ : Fin (m + n + 1))) → (tm ⟨i.val, + by omega⟩ ≤ (s : Real))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm i s hlo + hcast + rw [← hcast] + exact hlo + +private theorem hhi'At833 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (i : Fin (m + n)), ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ((↑s : ℝ) ≤ tm + i.succ) → ((i.succ = (⟨i.val + 1, by omega⟩ : Fin (m + n + 1))) → ((s : Real) ≤ + tm ⟨i.val + 1, by omega⟩)))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm i s hhi + hsucc + rw [← hsucc] + exact hhi + +private theorem hcurIndex : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ + (⟨n - r, by omega⟩ : Fin (n + 1)) = k.succ ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i r hr k + apply Fin.ext + dsimp [k] + omega + +private theorem hnextIndex : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ + (⟨n - r - 1, by omega⟩ : Fin (n + 1)) = k.castSucc ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i r hr k + apply Fin.ext + dsimp [k] + +private theorem hendIndexAt843 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (i : Fin (m + n)), (¬(↑i : ℕ) < m) → ( + let r : Nat := i.val - m + ∀ (hr : r < n), (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = + ⟨m + 1 + r, by omega⟩))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i hleftidx + r hr + apply Fin.ext + dsimp [r] + omega + +private theorem hstartAt848 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (right_eval : ∀ (j : Fin n), tm ⟨m + 1 + j.val, by omega⟩ = + 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2), ∀ (htm_mid : tm ⟨m, by omega⟩ = 1 / + 2), ∀ (i : Fin (m + n)), ∀ (hleftidx : ¬(↑i : ℕ) < m), + let r : Nat := i.val - m + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ + tm ⟨i.val, by omega⟩ = + 1 - polyba.time k.succ / 2 ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm + right_eval htm_mid i hleftidx r hr k + by_cases hrzero : r = 0 + · have hiv : i.val = m := by dsimp [r] at hrzero ⊢; omega + have hindex : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = ⟨m, by omega⟩ := by + apply Fin.ext + exact hiv + have hksucc : k.succ = Fin.last n := by + apply Fin.ext + dsimp [k] + omega + calc + tm ⟨i.val, by omega⟩ = tm ⟨m, by omega⟩ := congrArg tm hindex + _ = 1 / 2 := htm_mid + _ = 1 - polyba.time k.succ / 2 := by rw [hksucc, polyba.finish]; norm_num + · let j : Fin n := ⟨r - 1, by omega⟩ + have hstartIndex : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = + ⟨m + 1 + j.val, by omega⟩ := by + apply Fin.ext + dsimp [j, r] + omega + calc + tm ⟨i.val, by omega⟩ = tm ⟨m + 1 + j.val, by omega⟩ := + congrArg tm hstartIndex + _ = 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2 := right_eval j + _ = 1 - polyba.time k.succ / 2 := by + have hidx : (⟨n - 1 - j.val, by omega⟩ : Fin (n + 1)) = k.succ := by + apply Fin.ext + dsimp [k, j, r] + omega + exact congrArg (fun z : Real => 1 - z / 2) + (congrArg polyba.time hidx) + +private theorem hendAt880 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (right_eval : ∀ (j : Fin n), tm ⟨m + 1 + j.val, by omega⟩ = + 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2), ∀ (i : Fin (m + n)), + let r : Nat := i.val - m + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ + ((⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = + ⟨m + 1 + r, by omega⟩) → (tm ⟨i.val + 1, by omega⟩ = + 1 - polyba.time k.castSucc / 2)) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm + right_eval i r hr k hendIndex + calc + tm ⟨i.val + 1, by omega⟩ = tm ⟨m + 1 + r, by omega⟩ := + congrArg tm hendIndex + _ = 1 - polyba.time ⟨n - 1 - r, by omega⟩ / 2 := + right_eval ⟨r, hr⟩ + _ = 1 - polyba.time k.castSucc / 2 := by + have hidx : (⟨n - 1 - r, by omega⟩ : Fin (n + 1)) = k.castSucc := by + apply Fin.ext + dsimp [k] + omega + exact congrArg (fun z : Real => 1 - z / 2) + (congrArg polyba.time hidx) + +private theorem hA_imp_mid : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let m := polyab.count + let n := polyba.count + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + (StrictMono tm) → ((tm ⟨m, by omega⟩ = 1 / 2) → (∀ (i : Fin (m + + n)), (¬(↑i : ℕ) < m) → ( + let r : Nat := i.val - m + (r < n) → (∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), (tm ⟨i.val, by omega⟩ ≤ (s : + Real)) → (s ∈ A → i.val = m ∧ (s : Real) = 1 / 2))))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba A m n hnpos tm + htm_strict htm_mid i hleftidx r hr s hlo' hsA + by_cases heq : i.val = m + · have hi : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = ⟨m, by omega⟩ := by + apply Fin.ext + exact heq + have hhalf : (s : Real) = 1 / 2 := by + have hlow := hlo' + rw [hi, htm_mid] at hlow + change (s : Real) ≤ 1 / 2 at hsA + exact le_antisymm hsA hlow + exact ⟨heq, hhalf⟩ + · have hi : (⟨m, by omega⟩ : Fin (m + n + 1)) < ⟨i.val, by omega⟩ := by + apply Fin.mk_lt_mk.mpr + omega + have hmid : 1 / 2 < tm ⟨i.val, by omega⟩ := by + calc + 1 / 2 = tm ⟨m, by omega⟩ := htm_mid.symm + _ < tm ⟨i.val, by omega⟩ := htm_strict hi + have hlow := hlo' + change (s : Real) ≤ 1 / 2 at hsA + linarith + +private theorem hsRight : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) + let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right + ∀ (p : ℝ × ℝ), (g a b ⟨1, by norm_num⟩ = p) → ((g b a ⟨1, by norm_num⟩ = p) → ( + let m := polyab.count + let n := polyba.count + ∀ (i : Fin (m + n)), ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), (s ∈ A → i.val = m ∧ (s : + Real) = 1 / 2) → (f s = right s))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba clip left + right A f p hendab hendba m n i s hA_imp_mid + by_cases hsA : s ∈ A + · obtain ⟨_, hhalf⟩ := hA_imp_mid hsA + have hc1 : clip (2 * s) = ⟨1, by norm_num⟩ := by + apply Subtype.ext + change max 0 (min 1 (2 * (s : Real))) = 1 + rw [hhalf] + norm_num + have hc2 : clip (2 - 2 * s) = ⟨1, by norm_num⟩ := by + apply Subtype.ext + change max 0 (min 1 (2 - 2 * (s : Real))) = 1 + rw [hhalf] + norm_num + have hval : left s = right s := by + simp only [left, right, hc1, hc2] + exact hendab.trans hendba.symm + calc + f s = left s := Set.piecewise_eqOn A left right hsA + _ = right s := hval + · exact Set.piecewise_eqOn_compl A left right hsA + +private theorem hkbound : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ + polyba.time k.succ ≤ 1 ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i r hr k + calc + polyba.time k.succ ≤ polyba.time (Fin.last n) := + polyba.strict.monotone (Fin.le_last k.succ) + _ = 1 := polyba.finish + +private theorem hsHalf : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), (tm ⟨i.val, by omega⟩ ≤ (s : Real)) → ((tm + ⟨i.val, by omega⟩ = + 1 - polyba.time k.succ / 2) → ((polyba.time k.succ ≤ 1) → ((1 / 2 : Real) ≤ s)))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm i r hr + k s hlo' hstart hkbound + have hlow := hlo' + rw [hstart] at hlow + nlinarith + +private theorem htlowerAt951 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), ∀ + (hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩), ∀ (hstart : tm ⟨i.val, by omega⟩ = + 1 - polyba.time k.succ / 2), ∀ (hend : tm ⟨i.val + 1, by omega⟩ = + 1 - polyba.time k.castSucc / 2), ∀ (hkbound : polyba.time k.succ ≤ 1), ∀ (hsHalf : (1 / + 2 : Real) ≤ s), + let t : Icc (0 : Real) 1 := ⟨2 - 2 * (s : Real), by + constructor + · have hlow := hlo' + rw [hstart] at hlow + nlinarith [s.property.2] + · nlinarith [s.property.1, hsHalf]⟩ + polyba.time k.castSucc ≤ (t : Real) ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm i r hr + k s hlo' hhi' hstart hend hkbound hsHalf t + have h := hhi' + rw [hend] at h + dsimp [t] + linarith + +private theorem htupperAt956 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), ∀ + (hstart : tm ⟨i.val, by omega⟩ = + 1 - polyba.time k.succ / 2), ∀ (hkbound : polyba.time k.succ ≤ 1), ∀ (hsHalf : (1 / 2 : + Real) ≤ s), + let t : Icc (0 : Real) 1 := ⟨2 - 2 * (s : Real), by + constructor + · have hlow := hlo' + rw [hstart] at hlow + nlinarith [s.property.2] + · nlinarith [s.property.1, hsHalf]⟩ + (t : Real) ≤ polyba.time k.succ ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm i r hr + k s hlo' hstart hkbound hsHalf t + have h := hlo' + rw [hstart] at h + dsimp [t] + linarith + +private theorem htvalAt961 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + ∀ (hscale_right : ∀ (s : Icc (0 : Real) 1), (s ∉ A) → ((clip (2 - 2 * s) : Real) = 2 - 2 + * s)), + let m := polyab.count + let n := polyba.count + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), ∀ + (hstart : tm ⟨i.val, by omega⟩ = + 1 - polyba.time k.succ / 2), ∀ (hA_imp_mid : s ∈ A → i.val = m ∧ (s : Real) = 1 / 2), ∀ + (hkbound : polyba.time k.succ ≤ 1), ∀ (hsHalf : (1 / 2 : Real) ≤ s), + let t : Icc (0 : Real) 1 := ⟨2 - 2 * (s : Real), by + constructor + · have hlow := hlo' + rw [hstart] at hlow + nlinarith [s.property.2] + · nlinarith [s.property.1, hsHalf]⟩ + clip (2 - 2 * s) = t ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba clip A + hscale_right m n tm i r hr k s hlo' hstart hA_imp_mid hkbound hsHalf t + apply Subtype.ext + change (clip (2 - 2 * (s : Real)) : Real) = 2 - 2 * (s : Real) + by_cases hsA : s ∈ A + · obtain ⟨_, hhalf⟩ := hA_imp_mid hsA + change max 0 (min 1 (2 - 2 * (s : Real))) = 2 - 2 * (s : Real) + rw [hhalf] + norm_num + · exact hscale_right s hsA + +private theorem hfvalueAt970 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) + let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right + let m := polyab.count + let n := polyba.count + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), ∀ + (hstart : tm ⟨i.val, by omega⟩ = + 1 - polyba.time k.succ / 2), ∀ (hsRight : f s = right s), ∀ (hkbound : polyba.time + k.succ ≤ 1), ∀ (hsHalf : (1 / 2 : Real) ≤ s), + let t : Icc (0 : Real) 1 := ⟨2 - 2 * (s : Real), by + constructor + · have hlow := hlo' + rw [hstart] at hlow + nlinarith [s.property.2] + · nlinarith [s.property.1, hsHalf]⟩ + (clip (2 - 2 * s) = t) → (f s = g b a t) ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba clip left + right A f m n tm i r hr k s hlo' hstart hsRight hkbound hsHalf t htval + calc + f s = right s := hsRight + _ = g b a t := by simp [right, htval] + +private theorem parameter_homeomorph : + (by + classical + exact + ∀ (A : Set (Real × Real)), ∀ (f : Icc (0 : Real) 1 → Real × Real), (Continuous f) → + ((Function.Injective f) → ((Set.range f = A) → (∃ h : Icc (0 : Real) 1 ≃ₜ A, ∀ s, (h + s : Real × Real) = f s))) ) := by + classical + intro A f hc hi hr + let F : Icc (0 : Real) 1 → A := fun s => + ⟨f s, hr ▸ Set.mem_range_self s⟩ + have hFc : Continuous F := hc.subtype_mk _ + have hFi : Function.Injective F := fun s t hst => + hi (congrArg Subtype.val hst) + have hFs : Function.Surjective F := by + intro y + obtain ⟨s, hs⟩ := (Set.ext_iff.mp hr y).mpr y.property + exact ⟨s, Subtype.ext hs⟩ + let h := (isHomeomorph_iff_continuous_bijective.mpr ⟨hFc, hFi, hFs⟩).homeomorph + exact ⟨h, fun _ => rfl⟩ + +private theorem half_periodic : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ + (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : + ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + (∀ u : P.lattice, ∀ a, ∀ b, P3723T1EdgeContact P a b → ∀ s, g (P.shift u a) (P.shift u + b) s = g a b s + GaussianRealPoint u) → ( + let halfArc (a b : ι) : Set (Real × Real) := + if P3723T1EdgeContact P a b then Set.range (g a b) else ∅ + ∀ u : P.lattice, ∀ a, ∀ b, halfArc (P.shift u a) (P.shift u b) = (fun p => p + + GaussianRealPoint u) '' halfArc a b) ) := by + classical + intro ι P D localStar rep rep_spec period pulled_contact g gperiodic halfArc u a b + by_cases hab : P3723T1EdgeContact P a b + · simp only [halfArc, ite_eq_left hab, ite_eq_left ((D.contact_periodic u a b).mpr hab)] + ext p + constructor + · rintro ⟨s, rfl⟩ + exact ⟨g a b s, ⟨s, rfl⟩, (gperiodic u a b hab s).symm⟩ + · rintro ⟨q, ⟨s, rfl⟩, rfl⟩ + exact ⟨s, gperiodic u a b hab s⟩ + · have hn : ¬ P3723T1EdgeContact P (P.shift u a) (P.shift u b) := + fun h => hab ((D.contact_periodic u a b).mp h) + simp only [halfArc, ite_eq_right hab, ite_eq_right hn, Set.image_empty] + +private theorem tile_closed : + (by + classical + exact + ∀ (T : ProtoTile), IsClosed (TileRealization T) ) := by + classical + intro T + classical + unfold TileRealization + apply isClosed_biUnion_finset + intro x hx + exact isClosed_Icc + +private theorem compact_cells_finite : + (by + classical + exact + ∀ (K : Set (Real × Real)), (IsCompact K) → (Set.Finite {x : GaussianInt | ∃ p ∈ K, p ∈ + ClosedSquareRealization x}) ) := by + classical + intro K hK + classical + by_cases hne : K.Nonempty + · obtain ⟨p₀, hp₀⟩ := hne + obtain ⟨C, hC⟩ := Metric.isBounded_iff.mp hK.isBounded + have hCpos : 0 ≤ C := by + have := hC hp₀ hp₀ + simpa using this + let B := max (abs p₀.1) (abs p₀.2) + C + 2 + obtain ⟨N, hN⟩ := exists_nat_gt (B + 1) + let box : Set (Int × Int) := + Set.Icc (-(N : Int)) (N : Int) ×ˢ Set.Icc (-(N : Int)) (N : Int) + let cells : Set GaussianInt := + (fun z : Int × Int => Zsqrtd.mk z.1 z.2) '' box + have hboxfinite : box.Finite := by + dsimp [box] + exact (Set.finite_Icc (-(N : Int)) (N : Int)).prod + (Set.finite_Icc (-(N : Int)) (N : Int)) + have hcfinite : cells.Finite := hboxfinite.image _ + apply hcfinite.subset + intro x hx + obtain ⟨p, hpK, hpsq⟩ := hx + have hdist := hC hpK hp₀ + rw [Prod.dist_eq, max_le_iff, Real.dist_eq, Real.dist_eq] at hdist + have hd1 := abs_le.mp hdist.1 + have hd2 := abs_le.mp hdist.2 + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpsq + change x ∈ (fun z : Int × Int => Zsqrtd.mk z.1 z.2) '' box + simp only [Set.mem_image] + refine ⟨(x.re, x.im), ?_, ?_⟩ + · change (x.re, x.im) ∈ + (Set.Icc (-(N : Int)) (N : Int) ×ˢ Set.Icc (-(N : Int)) (N : Int)) + rw [Set.mem_prod] + simp only [Set.mem_Icc] + constructor + · constructor + · have hpbound : -B ≤ p.1 := by + dsimp [B] + have hp0 : -abs p₀.1 ≤ p₀.1 := neg_abs_le _ + have hm : abs p₀.1 ≤ max (abs p₀.1) (abs p₀.2) := le_max_left _ _ + linarith [hd1.1, hm] + have hxlow : ((x.re : Int) : Real) ≥ p.1 - 1 := by linarith [hpsq.2.1] + have : -(N : Real) < ((x.re : Int) : Real) := by linarith [hN] + exact_mod_cast (le_of_lt this) + · have hpbound : p.1 ≤ B := by + dsimp [B] + have hp0 : p₀.1 ≤ abs p₀.1 := le_abs_self _ + have hm : abs p₀.1 ≤ max (abs p₀.1) (abs p₀.2) := le_max_left _ _ + linarith [hd1.2, hm] + have hxhigh : ((x.re : Int) : Real) ≤ p.1 := hpsq.1.1 + have : ((x.re : Int) : Real) < (N : Real) := by linarith [hN] + exact_mod_cast (le_of_lt this) + · constructor + · have hpbound : -B ≤ p.2 := by + dsimp [B] + have hp0 : -abs p₀.2 ≤ p₀.2 := neg_abs_le _ + have hm : abs p₀.2 ≤ max (abs p₀.1) (abs p₀.2) := le_max_right _ _ + linarith [hd2.1, hm] + have hxlow : ((x.im : Int) : Real) ≥ p.2 - 1 := by linarith [hpsq.2.2] + have : -(N : Real) < ((x.im : Int) : Real) := by linarith [hN] + exact_mod_cast (le_of_lt this) + · have hpbound : p.2 ≤ B := by + dsimp [B] + have hp0 : p₀.2 ≤ abs p₀.2 := le_abs_self _ + have hm : abs p₀.2 ≤ max (abs p₀.1) (abs p₀.2) := le_max_right _ _ + linarith [hd2.2, hm] + have hxhigh : ((x.im : Int) : Real) ≤ p.2 := hpsq.1.2 + have : ((x.im : Int) : Real) < (N : Real) := by linarith [hN] + exact_mod_cast (le_of_lt this) + · apply Zsqrtd.ext <;> rfl + · have hKempty : K = ∅ := Set.not_nonempty_iff_eq_empty.mp hne + simp [hKempty] + +private theorem half_range_in_tile : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ + (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : + ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + (∀ a, ∀ b, P3723T1EdgeContact P a b → + Continuous (g a b) ∧ Function.Injective (g a b) ∧ + g a b ⟨0, by norm_num⟩ = D.position a ∧ + D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ + Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ + Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ + {g a b ⟨1, by norm_num⟩}) → ((∀ (T : ProtoTile), IsClosed (TileRealization T)) → (∀ + (x : ι), ∀ (y : ι), (P3723T1EdgeContact P x y) → (Set.range (g x y) ⊆ + TileRealization (P.tile x)))) ) := by + classical + intro ι P D localStar rep rep_spec period pulled_contact g gproperties tile_closed x y hxy + obtain ⟨_, _, _, hport, _, hs⟩ := gproperties x y hxy + intro z hz + rcases hs hz with hinside | hport' + · exact interior_subset hinside + · rw [Set.mem_singleton_iff] at hport' + have hfront := (D.port_frontier x y (g x y ⟨1, by norm_num⟩) hport).1 + have htile := (tile_closed (P.tile x)).closure_eq ▸ frontier_subset_closure hfront + rw [hport'] + exact htile + +private theorem frontier_no_interior : + (by + classical + exact + (∀ (T : ProtoTile), IsClosed (TileRealization T)) → (∀ (T : ProtoTile), ∀ (p : Real × + Real), (p ∈ frontier (TileRealization T)) → (p ∉ interior (TileRealization T))) ) := by + classical + intro tile_closed T p hp + have hpT : p ∈ TileRealization T := + (tile_closed T).closure_eq ▸ frontier_subset_closure hp + exact (mem_frontier_iff_notMem_interior hpT).mp hp + +private theorem half_disjoint : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), (∀ (a : ι), + ∀ (b : ι), (P3723T1EdgeContact P a b) → (∃ p, D.port a b + = some p)) → (∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + (∀ a, ∀ b, P3723T1EdgeContact P a b → + Continuous (g a b) ∧ Function.Injective (g a b) ∧ + g a b ⟨0, by norm_num⟩ = D.position a ∧ + D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ + Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ + Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ + {g a b ⟨1, by norm_num⟩}) → ((∀ (T : ProtoTile), ∀ (p : Real × Real), (p ∈ frontier + (TileRealization T)) → (p ∉ interior (TileRealization T))) → (∀ (x : ι), ∀ (y : + ι), ∀ (u : ι), ∀ (v : ι), (P3723T1EdgeContact P x y) → + ((P3723T1EdgeContact P + u v) → ((({x, y} : Set ι) ≠ {u, v}) → ((x ≠ u) → (Disjoint (Set.range (g x y)) + (Set.range (g u v)))))))))) := by + classical + intro ι P D port_exists localStar rep rep_spec period pulled_contact g gproperties + frontier_no_interior x y u v hxy huv hpair hxu + obtain ⟨p, hp⟩ := port_exists x y hxy + obtain ⟨q, hq⟩ := port_exists u v huv + obtain ⟨_, _, _, hpG, _, hsG⟩ := gproperties x y hxy + obtain ⟨_, _, _, hqG, _, htG⟩ := gproperties u v huv + have hp1 : g x y ⟨1, by norm_num⟩ = p := Option.some.inj (hpG.symm.trans hp) + have hq1 : g u v ⟨1, by norm_num⟩ = q := Option.some.inj (hqG.symm.trans hq) + rw [Set.disjoint_left] + intro z hz1 hz2 + rcases hsG hz1 with hzi | hzp + · rcases htG hz2 with hzu | hzq + · exact Set.disjoint_left.mp (D.interior_disjoint_tiles x u hxu) hzi (interior_subset hzu) + · have hzq' : z = q := hzq.trans hq1 + have hqint : q ∈ interior (TileRealization (P.tile x)) := by + rw [← hzq'] + exact hzi + by_cases hxv : x = v + · have hfront := (D.port_frontier u v q hq).2 + exact frontier_no_interior (P.tile v) q hfront (by simpa [hxv] using hqint) + · have hnot := D.port_no_third u v q hq + exact hnot x hxu hxv (interior_subset hqint) + · have hzp' : z = p := hzp.trans hp1 + rcases htG hz2 with hzu | hzq + · have hfront := D.port_frontier x y p hp + have hpint : p ∈ interior (TileRealization (P.tile u)) := by + rw [← hzp'] + exact hzu + by_cases hux : u = x + · exact frontier_no_interior (P.tile x) p hfront.1 (by simpa [hux] using hpint) + · by_cases huy : u = y + · exact frontier_no_interior (P.tile y) p hfront.2 (by simpa [huy] using hpint) + · have hnot := D.port_no_third x y p hp u hux huy + exact hnot (interior_subset hpint) + · have hzq' : z = q := hzq.trans hq1 + have hpq : p = q := hzp'.symm.trans hzq' + have hq' : D.port u v = some p := by rw [hq, hpq] + have howner := D.port_owner_pair x y u v p hp hq' + exact hpair howner + +private theorem half_subset : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + (∀ a, ∀ b, ∀ c, P3723T1EdgeContact P a b → P3723T1EdgeContact P a c → b ≠ c → + Set.range (g a b) ∩ Set.range (g a c) = {D.position a}) → ((∀ (x : ι), ∀ (y : ι), ∀ + (u : ι), ∀ (v : ι), (P3723T1EdgeContact P x y) → ((P3723T1EdgeContact P u v) → + ((({x, y} : Set ι) ≠ {u, v}) → ((x ≠ u) → (Disjoint (Set.range (g x y)) (Set.range (g + u v))))))) → (∀ (x : ι), ∀ (y : ι), ∀ (u : ι), ∀ (v : ι), (P3723T1EdgeContact P x + y) → ((P3723T1EdgeContact P u v) → ((({x, y} : Set ι) ≠ {u, v}) → (Set.range (g x + y) ∩ Set.range (g u v) ⊆ D.position '' (({x, y} : Set ι) ∩ {u, v})))))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g gintersections half_disjoint + x y u v hxy huv hxyuv z hz + by_cases hxu : x = u + · subst u + have hyv : y ≠ v := by + intro h + apply hxyuv + simp [h] + have huv' : P3723T1EdgeContact P x v := by simpa using huv + have hstar := gintersections x y v hxy huv' hyv + have hzpos : z = D.position x := by + rw [hstar] at hz + exact Set.mem_singleton_iff.mp hz + refine ⟨x, ?_, hzpos.symm⟩ + exact ⟨by simp, by simp⟩ + · exfalso + exact (Set.disjoint_left.mp (half_disjoint x y u v hxy huv hxyuv hxu) hz.1 hz.2) + +private theorem hstartAt1216 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), (∀ (a : ι), + ∀ (b : ι), P3723T1EdgeContact P a b ↔ P3723T1EdgeContact + P b a) → (∀ (a : ι), ∀ (b : ι), ∀ (localStar : (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + (∀ a, ∀ b, P3723T1EdgeContact P a b → + Continuous (g a b) ∧ Function.Injective (g a b) ∧ + g a b ⟨0, by norm_num⟩ = D.position a ∧ + D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ + Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ + Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ + {g a b ⟨1, by norm_num⟩}) → ( + let halfArc (a b : ι) : Set (Real × Real) := + if P3723T1EdgeContact P a b then Set.range (g a b) else ∅ + let edgeArc (a b : ι) : Set (Real × Real) := halfArc a b ∪ halfArc b a + ∀ (x : ι), ∀ (y : ι), (P3723T1EdgeContact P x y) → (D.position x ∈ edgeArc x y))))) := by + classical + intro ι P D symmetric a b localStar rep rep_spec period pulled_contact hab g gproperties + halfArc edgeArc x y hxy + have hrev := (symmetric x y).mp hxy + simp only [edgeArc, halfArc, ite_eq_left hxy, ite_eq_left hrev] + left + exact ⟨⟨0, by norm_num⟩, (gproperties x y hxy).2.2.1⟩ + +private theorem hendAt1222 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), (∀ (a : ι), + ∀ (b : ι), P3723T1EdgeContact P a b ↔ P3723T1EdgeContact + P b a) → (∀ (a : ι), ∀ (b : ι), ∀ (localStar : (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + (∀ a, ∀ b, P3723T1EdgeContact P a b → + Continuous (g a b) ∧ Function.Injective (g a b) ∧ + g a b ⟨0, by norm_num⟩ = D.position a ∧ + D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ + Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ + Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ + {g a b ⟨1, by norm_num⟩}) → ( + let halfArc (a b : ι) : Set (Real × Real) := + if P3723T1EdgeContact P a b then Set.range (g a b) else ∅ + let edgeArc (a b : ι) : Set (Real × Real) := halfArc a b ∪ halfArc b a + ∀ (x : ι), ∀ (y : ι), (P3723T1EdgeContact P x y) → (D.position y ∈ edgeArc x y))))) := by + classical + intro ι P D symmetric a b localStar rep rep_spec period pulled_contact hab g gproperties + halfArc edgeArc x y hxy + have hrev := (symmetric x y).mp hxy + simp only [edgeArc, halfArc, ite_eq_left hxy, ite_eq_left hrev] + right + exact ⟨⟨0, by norm_num⟩, (gproperties y x hrev).2.2.1⟩ + +private theorem vertex_mem : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + let halfArc (a b : ι) : Set (Real × Real) := + if P3723T1EdgeContact P a b then Set.range (g a b) else ∅ + let edgeArc (a b : ι) : Set (Real × Real) := halfArc a b ∪ halfArc b a + (∀ (x : ι), ∀ (y : ι), (P3723T1EdgeContact P x y) → (D.position x ∈ edgeArc x y)) → ((∀ + (x : ι), ∀ (y : ι), (P3723T1EdgeContact P x y) → (D.position y ∈ edgeArc x y)) → (∀ + (x : ι), ∀ (y : ι), ∀ (i : ι), (P3723T1EdgeContact P x y) → ((i = x ∨ i = y) → + (D.position i ∈ edgeArc x y)))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g halfArc edgeArc hstart hend + x y i hxy hi + rcases hi with hi | hi + · rw [hi] + exact hstart x y hxy + · rw [hi] + exact hend x y hxy + +private theorem hab_mem : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + (∀ a, ∀ b, P3723T1EdgeContact P a b → + Continuous (g a b) ∧ Function.Injective (g a b) ∧ + g a b ⟨0, by norm_num⟩ = D.position a ∧ + D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ + Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ + Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ + {g a b ⟨1, by norm_num⟩}) → (∀ (c : ι), ∀ (d : ι), (P3723T1EdgeContact P b a) → (∀ + (i : ι), (i ∈ ({a, b} : Set ι) ∩ {c, d}) → ((i = a ∨ i = b) → ((i = c ∨ i = d) → + (D.position i ∈ Set.range (g a b) ∪ Set.range (g b a)))))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g gproperties c d hba i hi + hiab hicd + rcases hiab with hi | hi + · subst i + left + exact ⟨⟨0, by norm_num⟩, (gproperties a b hab).2.2.1⟩ + · subst i + right + exact ⟨⟨0, by norm_num⟩, (gproperties b a hba).2.2.1⟩ + +private theorem hcd_mem : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + (∀ a, ∀ b, P3723T1EdgeContact P a b → + Continuous (g a b) ∧ Function.Injective (g a b) ∧ + g a b ⟨0, by norm_num⟩ = D.position a ∧ + D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ + Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ + Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ + {g a b ⟨1, by norm_num⟩}) → (∀ (c : ι), ∀ (d : ι), (P3723T1EdgeContact P c d) → + ((P3723T1EdgeContact P d c) → (∀ (i : ι), (i ∈ ({a, b} : Set ι) ∩ {c, d}) → ((i + = a ∨ i = + b) → ((i = c ∨ i = d) → ((D.position i ∈ Set.range (g a b) ∪ Set.range (g b a)) → + (D.position i ∈ Set.range (g c d) ∪ Set.range (g d c)))))))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g gproperties c d hcd hdc i hi + hiab hicd hab_mem + rcases hicd with hi | hi + · subst i + left + exact ⟨⟨0, by norm_num⟩, (gproperties c d hcd).2.2.1⟩ + · subst i + right + exact ⟨⟨0, by norm_num⟩, (gproperties d c hdc).2.2.1⟩ + +private theorem owner_unique : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), + let owner : GaussianInt → ι := fun x => + Classical.choose (PeriodicTileIndexedMultiplicityOne P x).exists + (∀ (x : GaussianInt), x ∈ (P.tile (owner x)).cells) → (∀ (x : GaussianInt), ∀ (a : ι), (x + ∈ (P.tile a).cells) → (a = owner x)) ) := by + classical + intro ι P owner owner_mem x a ha + exact (PeriodicTileIndexedMultiplicityOne P x).unique ha (owner_mem x) + +private theorem arc_endpoint_owner : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), (∀ (a : ι), + ∀ (b : ι), P3723T1EdgeContact P a b ↔ P3723T1EdgeContact P b a) → (∀ (localStar : + (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → + ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + let halfArc (a b : ι) : Set (Real × Real) := + if P3723T1EdgeContact P a b then Set.range (g a b) else ∅ + let edgeArc (a b : ι) : Set (Real × Real) := halfArc a b ∪ halfArc b a + (∀ (x : ι), ∀ (y : ι), (P3723T1EdgeContact P x y) → (Set.range (g x y) ⊆ + TileRealization (P.tile x))) → (∀ (K : Set (ℝ × ℝ)), + let cells : Set GaussianInt := + {x | ∃ p ∈ K, p ∈ ClosedSquareRealization x} + let owner : GaussianInt → ι := fun x => + Classical.choose (PeriodicTileIndexedMultiplicityOne P x).exists + (∀ (x : GaussianInt), ∀ (a : ι), (x ∈ (P.tile a).cells) → (a = owner x)) → ( + let ownerIndices : Set ι := owner '' cells + ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → (∀ (z : Real × Real), (z ∈ edgeArc a + b) → ((z ∈ K) → (a ∈ ownerIndices ∨ b ∈ ownerIndices)))))) ) := by + classical + intro ι P D symmetric localStar rep rep_spec period pulled_contact g halfArc edgeArc + half_range_in_tile K cells owner owner_unique ownerIndices a b hab z hz hzK + have hba : P3723T1EdgeContact P b a := (symmetric a b).mp hab + change z ∈ halfArc a b ∪ halfArc b a at hz + simp only [halfArc, ite_eq_left hab, ite_eq_left hba] at hz + rcases hz with hz | hz + · have htile : z ∈ TileRealization (P.tile a) := half_range_in_tile a b hab hz + change z ∈ ⋃ x ∈ (P.tile a).cells, ClosedSquareRealization x at htile + simp only [Set.mem_iUnion] at htile + obtain ⟨x, hx, hxsq⟩ := htile + have hxowner : a = owner x := owner_unique x a hx + have hxmem : x ∈ cells := ⟨z, hzK, hxsq⟩ + left + change ∃ x, x ∈ cells ∧ owner x = a + exact ⟨x, hxmem, hxowner.symm⟩ + · have htile : z ∈ TileRealization (P.tile b) := half_range_in_tile b a hba hz + change z ∈ ⋃ x ∈ (P.tile b).cells, ClosedSquareRealization x at htile + simp only [Set.mem_iUnion] at htile + obtain ⟨x, hx, hxsq⟩ := htile + have hxowner : b = owner x := owner_unique x b hx + have hxmem : x ∈ cells := ⟨z, hzK, hxsq⟩ + right + change ∃ x, x ∈ cells ∧ owner x = b + exact ⟨x, hxmem, hxowner.symm⟩ + +private theorem houtAt1326 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (K : Set + (ℝ × ℝ)), + let cells : Set GaussianInt := + {x | ∃ p ∈ K, p ∈ ClosedSquareRealization x} + let owner : GaussianInt → ι := fun x => + Classical.choose (PeriodicTileIndexedMultiplicityOne P x).exists + let ownerIndices : Set ι := owner '' cells + ∀ (hownerIndices : ownerIndices.Finite), + let outgoing : Finset (ι × ι) := hownerIndices.toFinset.biUnion fun a => + (D.finite_degree a).toFinset.image fun b => (a, b) + ∀ (e : ι × ι), (e.1 ∈ hownerIndices.toFinset) → ((e.2 ∈ (D.finite_degree e.1).toFinset) → + (e ∈ outgoing)) ) := by + classical + intro ι P D K cells owner ownerIndices hownerIndices outgoing e ha' hb' + apply Finset.mem_biUnion.mpr + refine ⟨e.1, ha', ?_⟩ + apply Finset.mem_image.mpr + exact ⟨e.2, hb', rfl⟩ + +private theorem ha'At1334 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), (∀ (a : ι), + ∀ (b : ι), P3723T1EdgeContact P a b ↔ P3723T1EdgeContact P b a) → (∀ (e : ι × ι), + (P3723T1EdgeContact P e.1 e.2) → (e.1 ∈ (D.finite_degree e.2).toFinset)) ) := by + classical + intro ι P D symmetric e hab + have hsym : P3723T1EdgeContact P e.2 e.1 := (symmetric e.1 e.2).mp hab + exact (D.finite_degree e.2).mem_toFinset.mpr hsym + +private theorem houtAt1337 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (K : Set + (ℝ × ℝ)), + let cells : Set GaussianInt := + {x | ∃ p ∈ K, p ∈ ClosedSquareRealization x} + let owner : GaussianInt → ι := fun x => + Classical.choose (PeriodicTileIndexedMultiplicityOne P x).exists + let ownerIndices : Set ι := owner '' cells + ∀ (hownerIndices : ownerIndices.Finite), + let outgoing : Finset (ι × ι) := hownerIndices.toFinset.biUnion fun a => + (D.finite_degree a).toFinset.image fun b => (a, b) + ∀ (e : ι × ι), (e.2 ∈ hownerIndices.toFinset) → ((e.1 ∈ (D.finite_degree e.2).toFinset) → + ((e.2, e.1) ∈ outgoing)) ) := by + classical + intro ι P D K cells owner ownerIndices hownerIndices outgoing e hb' ha' + apply Finset.mem_biUnion.mpr + refine ⟨e.2, hb', ?_⟩ + apply Finset.mem_image.mpr + exact ⟨e.1, ha', rfl⟩ + +end ContactDrawingGeometry + +namespace ContactDrawingConcatenation + +private theorem hpoly : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) + let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right + (∀ (s : Icc (0 : Real) 1), (s ∈ A) → ((clip (2 * s) : Real) = 2 * s)) → ((∀ (s : Icc (0 : + Real) 1), (s ∉ A) → ((clip (2 - 2 * s) : Real) = 2 - + 2 * s)) → (∀ (p : ℝ × ℝ), (g a b ⟨1, by norm_num⟩ = p) → ((g b a ⟨1, + by norm_num⟩ = p) → (Nonempty (P3723T1PolygonalParameterization f)))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba clip left + right A f hscale_left hscale_right p hendab hendba + let m := polyab.count + let n := polyba.count + have hmpos : 0 < m := polyab.positive + have hnpos : 0 < n := polyba.positive + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + have left_eval (j : Fin (m + 1)) : + tm ⟨j.val, by omega⟩ = polyab.time j / 2 := ContactDrawingGeometry.left_eval ι P D a b + localStar rep_spec pulled_contact hab polyab polyba hnpos j + have right_eval (j : Fin n) := ContactDrawingGeometry.right_eval ι P D a b localStar + rep_spec pulled_contact hab polyab polyba j + have htm_strict := ContactDrawingGeometry.htm_strict ι P D a b localStar rep_spec + pulled_contact hab polyab polyba hnpos left_eval right_eval + have htm_start := ContactDrawingGeometry.htm_start ι P D a b localStar rep_spec + pulled_contact hab polyab polyba hmpos hnpos left_eval + have htm_mid := ContactDrawingGeometry.htm_mid ι P D a b localStar rep_spec pulled_contact + hab polyab polyba hnpos left_eval + have htm_finish := ContactDrawingGeometry.htm_finish ι P D a b localStar rep_spec + pulled_contact hab polyab polyba hnpos right_eval + refine ⟨{ + count := m + n + positive := by omega + time := tm + strict := htm_strict + start := htm_start + finish := htm_finish + affine_on := ?_ + }⟩ + intro i + by_cases hleftidx : i.val < m + · let j : Fin m := ⟨i.val, by omega⟩ + let j' : Fin (m + 1) := j.succ + obtain ⟨C, V, hpiece⟩ := polyab.affine_on j + refine ⟨C, 2 • V, ?_⟩ + intro s hlo hhi + have hcast := ContactDrawingGeometry.hcastAt761 ι P D a b localStar rep_spec + pulled_contact hab polyab polyba i + have hsucc := ContactDrawingGeometry.hsuccAt764 ι P D a b localStar rep_spec + pulled_contact hab polyab polyba i + have hlo' := ContactDrawingGeometry.hlo'At767 ι P D a b localStar rep_spec pulled_contact + hab polyab polyba i s hlo hcast + have hhi' := ContactDrawingGeometry.hhi'At770 ι P D a b localStar rep_spec pulled_contact + hab polyab polyba i s hhi hsucc + have hstartIndex : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = + ⟨j.castSucc.val, by omega⟩ := by apply Fin.ext; rfl + have hendIndex : (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = + ⟨j'.val, by omega⟩ := by apply Fin.ext; rfl + have hstart : tm ⟨i.val, by omega⟩ = polyab.time j.castSucc / 2 := by + rw [hstartIndex, left_eval j.castSucc] + have hend : tm ⟨i.val + 1, by omega⟩ = polyab.time j' / 2 := by + rw [hendIndex, left_eval j'] + have hlastbound := ContactDrawingGeometry.hlastbound ι P D a b localStar rep_spec + pulled_contact hab polyab polyba i hleftidx + have hsA := ContactDrawingGeometry.hsAAt786 ι P D a b localStar rep_spec pulled_contact + hab polyab polyba hnpos i hleftidx s hhi' hend hlastbound + let t : Icc (0 : Real) 1 := ⟨2 * (s : Real), by + constructor + · nlinarith [s.property.1] + · nlinarith⟩ + have htlower := ContactDrawingGeometry.htlowerAt794 ι P D a b localStar rep_spec + pulled_contact hab polyab polyba hnpos i hleftidx s hlo' hhi' hstart hend hlastbound + have htupper := ContactDrawingGeometry.htupperAt799 ι P D a b localStar rep_spec + pulled_contact hab polyab polyba hnpos i hleftidx s hhi' hend hlastbound + have htval := ContactDrawingGeometry.htvalAt804 ι P D a b localStar rep_spec + pulled_contact hab polyab polyba hscale_left hnpos i hleftidx s hhi' hend hlastbound hsA + have hfvalue := ContactDrawingGeometry.hfvalueAt807 ι P D a b localStar rep_spec + pulled_contact hab polyab polyba hnpos i hleftidx s hhi' hend hlastbound hsA htval + calc + f s = g a b t := hfvalue + _ = C + (t : Real) • V := hpiece t htlower htupper + _ = C + (s : Real) • (2 • V) := by + have htdef : (t : Real) = 2 * (s : Real) := rfl + rw [htdef, ← smul_smul] + ext <;> simp [smul_eq_mul] <;> ring + · let r : Nat := i.val - m + have hr : r < n := by dsimp [r]; omega + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ + obtain ⟨C, V, hpiece⟩ := polyba.affine_on k + refine ⟨C + 2 • V, -2 • V, ?_⟩ + intro s hlo hhi + have hcast := ContactDrawingGeometry.hcastAt824 ι P D a b localStar rep_spec + pulled_contact hab polyab polyba i + have hsucc := ContactDrawingGeometry.hsuccAt827 ι P D a b localStar rep_spec + pulled_contact hab polyab polyba i + have hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real) := ContactDrawingGeometry.hlo'At830 ι P D a b + localStar rep_spec pulled_contact + hab polyab polyba i s hlo hcast + have hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩ := ContactDrawingGeometry.hhi'At833 ι P D + a b localStar rep_spec pulled_contact + hab polyab polyba i s hhi hsucc + have hcurIndex := ContactDrawingGeometry.hcurIndex ι P D a b localStar rep_spec + pulled_contact hab polyab polyba i hr + have hnextIndex := ContactDrawingGeometry.hnextIndex ι P D a b localStar rep_spec + pulled_contact hab polyab polyba i hr + have hendIndex : (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = + ⟨m + 1 + r, by omega⟩ := ContactDrawingGeometry.hendIndexAt843 ι P D a b localStar + rep_spec pulled_contact hab polyab polyba i hleftidx hr + have hstart : tm ⟨i.val, by omega⟩ = + 1 - polyba.time k.succ / 2 := ContactDrawingGeometry.hstartAt848 ι P D a b localStar + rep_spec pulled_contact hab polyab polyba hnpos right_eval htm_mid i hleftidx hr + have hend : tm ⟨i.val + 1, by omega⟩ = + 1 - polyba.time k.castSucc / 2 := ContactDrawingGeometry.hendAt880 ι P D a b + localStar rep_spec pulled_contact hab polyab polyba right_eval i hr hendIndex + have hA_imp_mid := ContactDrawingGeometry.hA_imp_mid ι P D a b localStar rep_spec + pulled_contact hab polyab polyba hnpos htm_strict htm_mid i hleftidx hr s hlo' + have hsRight := ContactDrawingGeometry.hsRight ι P D a b localStar rep_spec + pulled_contact hab polyab polyba p hendab hendba i s hA_imp_mid + have hkbound := ContactDrawingGeometry.hkbound ι P D a b localStar rep_spec + pulled_contact hab polyab polyba i hr + have hsHalf := ContactDrawingGeometry.hsHalf ι P D a b localStar rep_spec pulled_contact + hab polyab polyba i hr s hlo' hstart hkbound + let t : Icc (0 : Real) 1 := ⟨2 - 2 * (s : Real), by + constructor + · have hlow := hlo' + rw [hstart] at hlow + nlinarith [s.property.2] + · nlinarith [s.property.1, hsHalf]⟩ + have htlower := ContactDrawingGeometry.htlowerAt951 ι P D a b localStar rep_spec + pulled_contact hab polyab polyba i hr s hlo' hhi' hstart hend hkbound hsHalf + have htupper := ContactDrawingGeometry.htupperAt956 ι P D a b localStar rep_spec + pulled_contact hab polyab polyba i hr s hlo' hstart hkbound hsHalf + have htval := ContactDrawingGeometry.htvalAt961 ι P D a b localStar rep_spec + pulled_contact hab polyab polyba hscale_right i hr s hlo' hstart hA_imp_mid hkbound + hsHalf + have hfvalue := ContactDrawingGeometry.hfvalueAt970 ι P D a b localStar rep_spec + pulled_contact hab polyab polyba i hr s hlo' hstart hsRight hkbound hsHalf htval + calc + f s = g b a t := hfvalue + _ = C + (t : Real) • V := hpiece t htlower htupper + _ = C + 2 • V + (s : Real) • (-2 • V) := by + change C + (2 - 2 * (s : Real)) • V = + C + 2 • V + (s : Real) • (-2 • V) + ext <;> simp [smul_eq_mul] <;> ring + +end ContactDrawingConcatenation + +namespace ContactDrawingParameterization + +private theorem full_parameters : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), (∀ (a : ι), + ∀ (b : ι), P3723T1EdgeContact P a b ↔ P3723T1EdgeContact + P b a) → ((∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → (∃ p, + D.port a b = some p)) → (∀ (localStar : (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + (∀ a, ∀ b, P3723T1EdgeContact P a b → + Continuous (g a b) ∧ Function.Injective (g a b) ∧ + g a b ⟨0, by norm_num⟩ = D.position a ∧ + D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ + Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ + Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ + {g a b ⟨1, by norm_num⟩}) → ( + let halfArc (a b : ι) : Set (Real × Real) := + if P3723T1EdgeContact P a b then Set.range (g a b) else ∅ + let edgeArc (a b : ι) : Set (Real × Real) := halfArc a b ∪ halfArc b a + ∀ a, ∀ b, P3723T1EdgeContact P a b → + ∃ f : Icc (0 : Real) 1 → Real × Real, + Continuous f ∧ Function.Injective f ∧ Set.range f = edgeArc a b ∧ + f ⟨0, by norm_num⟩ = D.position a ∧ f ⟨1, by norm_num⟩ = D.position b ∧ + Nonempty (P3723T1PolygonalParameterization f))))) := by + classical + intro ι P D symmetric port_exists localStar rep rep_spec period pulled_contact g gproperties + halfArc edgeArc a b hab + obtain ⟨hgab, higab, hg0ab, hg1ab, ⟨polyab⟩, hsab⟩ := gproperties a b hab + have hba : P3723T1EdgeContact P b a := (symmetric a b).mp hab + obtain ⟨hgba, higba, hg0ba, hg1ba, ⟨polyba⟩, hsba⟩ := gproperties b a hba + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ + have hclip_cont := ContactDrawingGeometry.hclip_cont + let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) + let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right + have hleftc : Continuous left := hgab.comp (hclip_cont.comp (continuous_const.mul + continuous_subtype_val)) + have hrightc : Continuous right := hgba.comp + (hclip_cont.comp (continuous_const.sub (continuous_const.mul continuous_subtype_val))) + have hmeet (s : Icc (0 : Real) 1) (hs : s ∈ (Set.univ : Set (Icc (0 : Real) 1)) ∩ frontier A) + := ContactDrawingGeometry.hmeet ι P D a b localStar rep_spec pulled_contact hab hg1ab + hg1ba s hs + have hfcont := ContactDrawingGeometry.hfcont ι P D a b localStar rep_spec pulled_contact hab + hleftc hrightc hmeet + have hscale_left (s : Icc (0 : Real) 1) (hs : s ∈ A) := ContactDrawingGeometry.hscale_left s hs + have hscale_right (s : Icc (0 : Real) 1) (hs : s ∉ A) := ContactDrawingGeometry.hscale_right + s hs + have hf0 := ContactDrawingGeometry.hf0 ι P D a b localStar rep_spec pulled_contact hab hg0ab + have hf1 := ContactDrawingGeometry.hf1 ι P D a b localStar rep_spec pulled_contact hab hba hg0ba + obtain ⟨p, hp⟩ := port_exists a b hab + have hpba : D.port b a = some p := by rw [D.port_symmetric, hp] + have hendab := ContactDrawingGeometry.hendab ι P D a b localStar rep_spec pulled_contact hab + gproperties p hp + have hendba := ContactDrawingGeometry.hendba ι P D a b localStar rep_spec pulled_contact hab + gproperties hba p hpba + have hcross := ContactDrawingGeometry.hcross ι P D a b localStar rep_spec pulled_contact hab + hsab hsba p hendab hendba + have hfinj := ContactDrawingGeometry.hfinj ι P D a b localStar rep_spec pulled_contact hab + higab higba hscale_left hscale_right p hendab hendba hcross + have hrange := ContactDrawingGeometry.hrange ι P D a b localStar rep_spec pulled_contact hab + hba p hendab hendba + have hpoly : Nonempty (P3723T1PolygonalParameterization f) := + ContactDrawingConcatenation.hpoly ι P D a b localStar rep_spec pulled_contact hab polyab + polyba hscale_left hscale_right p hendab hendba + exact ⟨f, hfcont, hfinj, hrange, hf0, hf1, hpoly⟩ + +end ContactDrawingParameterization + +namespace ContactDrawingCertificate + +private theorem drawingCertificate : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), (∀ (a : ι), + ∀ (b : ι), P3723T1EdgeContact P a b ↔ P3723T1EdgeContact + P b a) → ((∀ (a : ι), ∀ (b : ι), ∀ (p : Real × Real), (D.port a b = some p) + → (P3723T1EdgeContact P a b)) → (∀ (localStar : (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + (∀ a, ∀ b, P3723T1EdgeContact P a b → + Continuous (g a b) ∧ Function.Injective (g a b) ∧ + g a b ⟨0, by norm_num⟩ = D.position a ∧ + D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ + Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ + Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ + {g a b ⟨1, by norm_num⟩}) → ((∀ a, ∀ b, ∀ c, P3723T1EdgeContact P + a b → P3723T1EdgeContact P a c → b ≠ c → Set.range (g a b) ∩ Set.range (g a c) + = {D.position a}) → ( + let halfArc (a b : ι) : Set (Real × Real) := + if P3723T1EdgeContact P a b then Set.range (g a b) else ∅ + let edgeArc (a b : ι) : Set (Real × Real) := halfArc a b ∪ halfArc b a + (∀ a, ∀ b, ∀ p, D.port a b = some p → + ∃ f : Icc (0 : Real) 1 → Real × Real, + Continuous f ∧ Function.Injective f ∧ Set.range f = halfArc a b ∧ + f ⟨0, by norm_num⟩ = D.position a ∧ f ⟨1, by norm_num⟩ = p ∧ + Nonempty (P3723T1PolygonalParameterization f)) → ((∀ a, ∀ b, P3723T1EdgeContact P a + b → + ∃ f : Icc (0 : Real) 1 → Real × Real, + Continuous f ∧ Function.Injective f ∧ Set.range f = edgeArc a b ∧ + f ⟨0, by norm_num⟩ = D.position a ∧ f ⟨1, by norm_num⟩ = D.position b ∧ + Nonempty (P3723T1PolygonalParameterization f)) → ((∀ (A : Set (Real × Real)), ∀ (f + : Icc (0 : Real) 1 → Real × Real), (Continuous f) → ((Function.Injective f) → + ((Set.range f = A) → (∃ h : Icc (0 : Real) 1 ≃ₜ A, ∀ s, (h s : Real × Real) = f + s)))) → ((∀ u : P.lattice, ∀ a, ∀ b, halfArc (P.shift u a) (P.shift u b) = (fun p + => p + GaussianRealPoint u) '' halfArc a b) → ((∀ (K : Set (Real × Real)), + (IsCompact K) → (Set.Finite {x : GaussianInt | ∃ p ∈ K, p ∈ + ClosedSquareRealization x})) → ((∀ (x : ι), ∀ (y : ι), (P3723T1EdgeContact P x + y) → (Set.range (g x y) ⊆ TileRealization (P.tile x))) → ((∀ (x : ι), ∀ (y : ι), + ∀ (u : ι), ∀ (v : ι), (P3723T1EdgeContact P x y) → ((P3723T1EdgeContact P u + v) → ((({x, y} : Set ι) ≠ {u, v}) → ((x ≠ u) → (Disjoint (Set.range (g x y)) + (Set.range (g u v))))))) → (∃ R : P3723T1AllContactRouting P, + R.toP3723T1ContactPorts = D)))))))))))) := by + classical + intro ι P D symmetric present localStar rep rep_spec period pulled_contact g gproperties + gintersections halfArc edgeArc half_parameters full_parameters parameter_homeomorph + half_periodic compact_cells_finite half_range_in_tile half_disjoint + refine ⟨{ + toP3723T1ContactPorts := D + halfArc := halfArc + edgeArc := edgeArc + noncontact_has_no_halfArc := ?_ + noncontact_has_no_edgeArc := ?_ + halfArc_homeomorph := ?_ + halfArc_supported := ?_ + incident_halfArc_intersections := ?_ + edgeArc_symmetric := ?_ + edgeArc_from_halfArcs := ?_ + edgeArc_homeomorph := ?_ + edgeArc_intersections := ?_ + compact_local_finiteness := ?_ + halfArc_parameterization := half_parameters + edgeArc_parameterization := full_parameters + halfArc_periodic := half_periodic + edgeArc_periodic := ?_ + }, rfl⟩ + · intro a b hn + simp only [halfArc, ite_eq_right hn] + · intro a b hn + have hba : ¬ P3723T1EdgeContact P b a := fun h => hn ((symmetric a b).mpr h) + simp only [edgeArc, halfArc, ite_eq_right hn, ite_eq_right hba, Set.union_empty] + · intro a b p hp + obtain ⟨f, hc, hi, hr, h0, h1, _hpoly⟩ := half_parameters a b p hp + obtain ⟨h, hh⟩ := parameter_homeomorph (halfArc a b) f hc hi hr + exact ⟨h, (hh _).trans h0, (hh _).trans h1⟩ + · intro a b p hp + have hab := present a b p hp + obtain ⟨_hc, _hi, _h0, h1, _hpoly, hs⟩ := gproperties a b hab + have hend : g a b ⟨1, by norm_num⟩ = p := Option.some.inj (h1.symm.trans hp) + simpa only [halfArc, ite_eq_left hab, hend] using hs + · intro a b c hab hac hbc + simpa only [halfArc, ite_eq_left hab, ite_eq_left hac] using gintersections a b c hab hac hbc + · intro a b + exact Set.union_comm _ _ + · intro a b p hp + rfl + · intro a b hab + obtain ⟨f, hc, hi, hr, h0, h1, _hpoly⟩ := full_parameters a b hab + obtain ⟨h, hh⟩ := parameter_homeomorph (edgeArc a b) f hc hi hr + exact ⟨h, (hh _).trans h0, (hh _).trans h1⟩ + · intro a b c d hab hcd hpair + have hba : P3723T1EdgeContact P b a := (symmetric a b).mp hab + have hdc : P3723T1EdgeContact P d c := (symmetric c d).mp hcd + have half_subset (x y u v : ι) (hxy : P3723T1EdgeContact P x y) + (huv : P3723T1EdgeContact P u v) + (hxyuv : ({x, y} : Set ι) ≠ {u, v}) : + Set.range (g x y) ∩ Set.range (g u v) ⊆ + D.position '' (({x, y} : Set ι) ∩ {u, v}) := ContactDrawingGeometry.half_subset ι P D a + b localStar rep_spec pulled_contact hab gintersections half_disjoint x y u v hxy + huv hxyuv + have hstart (x y : ι) (hxy : P3723T1EdgeContact P x y) : + D.position x ∈ edgeArc x y := ContactDrawingGeometry.hstartAt1216 ι P D symmetric a b + localStar rep_spec pulled_contact hab gproperties x y hxy + have hend (x y : ι) (hxy : P3723T1EdgeContact P x y) : + D.position y ∈ edgeArc x y := ContactDrawingGeometry.hendAt1222 ι P D symmetric a b + localStar rep_spec pulled_contact hab gproperties x y hxy + have vertex_mem (x y i : ι) (hxy : P3723T1EdgeContact P x y) + (hi : i = x ∨ i = y) := ContactDrawingGeometry.vertex_mem ι P D a b localStar rep_spec + pulled_contact hab hstart hend x y i hxy hi + have hfull : edgeArc a b = halfArc a b ∪ halfArc b a := rfl + have hfull' : edgeArc c d = halfArc c d ∪ halfArc d c := rfl + simp only [edgeArc, halfArc, ite_eq_left hab, ite_eq_left hba, ite_eq_left hcd, ite_eq_left + hdc] + ext z + constructor + · rintro ⟨hzab, hzcd⟩ + rcases hzab with hzab | hzba + · rcases hzcd with hzcd | hzdc + · exact half_subset a b c d hab hcd hpair ⟨hzab, hzcd⟩ + · simpa [Set.pair_comm] using + half_subset a b d c hab hdc (by simpa [Set.pair_comm] using hpair) ⟨hzab, hzdc⟩ + · rcases hzcd with hzcd | hzdc + · simpa [Set.pair_comm] using + half_subset b a c d hba hcd (by simpa [Set.pair_comm] using hpair) ⟨hzba, hzcd⟩ + · simpa [Set.pair_comm] using + half_subset b a d c hba hdc (by simpa [Set.pair_comm] using hpair) ⟨hzba, hzdc⟩ + · intro hz + change ∃ i ∈ ({a, b} : Set ι) ∩ {c, d}, D.position i = z at hz + obtain ⟨i, hi, hpos⟩ := hz + subst z + have hiab : i = a ∨ i = b := by simpa using hi.1 + have hicd : i = c ∨ i = d := by simpa using hi.2 + have hab_mem := ContactDrawingGeometry.hab_mem ι P D a b localStar rep_spec pulled_contact + hab gproperties c d hba i hi hiab hicd + have hcd_mem := ContactDrawingGeometry.hcd_mem ι P D a b localStar rep_spec pulled_contact + hab gproperties c d hcd hdc i hi hiab hicd hab_mem + exact ⟨hab_mem, hcd_mem⟩ + · intro K hK + let cells : Set GaussianInt := + {x | ∃ p ∈ K, p ∈ ClosedSquareRealization x} + have hcells : cells.Finite := compact_cells_finite K hK + let owner : GaussianInt → ι := fun x => + Classical.choose (PeriodicTileIndexedMultiplicityOne P x).exists + have owner_mem (x : GaussianInt) : x ∈ (P.tile (owner x)).cells := + Classical.choose_spec (PeriodicTileIndexedMultiplicityOne P x).exists + have owner_unique (x : GaussianInt) (a : ι) + (ha : x ∈ (P.tile a).cells) := ContactDrawingGeometry.owner_unique ι P owner_mem x a ha + let ownerIndices : Set ι := owner '' cells + have hownerIndices : ownerIndices.Finite := hcells.image owner + have arc_endpoint_owner (a b : ι) (hab : P3723T1EdgeContact P a b) + (z : Real × Real) (hz : z ∈ edgeArc a b) (hzK : z ∈ K) := + ContactDrawingGeometry.arc_endpoint_owner ι P D symmetric localStar rep_spec + pulled_contact half_range_in_tile K owner_unique a b hab z hz hzK + let outgoing : Finset (ι × ι) := hownerIndices.toFinset.biUnion fun a => + (D.finite_degree a).toFinset.image fun b => (a, b) + let pairs : Finset (ι × ι) := outgoing ∪ outgoing.image Prod.swap + apply pairs.finite_toSet.subset + intro e he + rcases he with ⟨hab, hmeet⟩ + obtain ⟨z, hz⟩ := hmeet + have hendpoint := arc_endpoint_owner e.1 e.2 hab z hz.1 hz.2 + change e ∈ (pairs : Set (ι × ι)) + rcases hendpoint with ha | hb + · have ha' : e.1 ∈ hownerIndices.toFinset := by + exact hownerIndices.mem_toFinset.mpr ha + have hb' : e.2 ∈ (D.finite_degree e.1).toFinset := by + exact (D.finite_degree e.1).mem_toFinset.mpr hab + have hout := ContactDrawingGeometry.houtAt1326 ι P D K hownerIndices e ha' hb' + exact Finset.mem_union_left _ hout + · have hb' : e.2 ∈ hownerIndices.toFinset := by + exact hownerIndices.mem_toFinset.mpr hb + have ha' := ContactDrawingGeometry.ha'At1334 ι P D symmetric e hab + have hout := ContactDrawingGeometry.houtAt1337 ι P D K hownerIndices e hb' ha' + apply Finset.mem_union_right + apply Finset.mem_image.mpr + exact ⟨(e.2, e.1), hout, by cases e; rfl⟩ + · intro u a b + simp only [edgeArc, half_periodic, Set.image_union] + +end ContactDrawingCertificate + +theorem P3723T1AllContactDrawingExists {ι : Type} (P : PeriodicTileComplex ι) + (D : P3723T1ContactPorts P) : + ∃ R : P3723T1AllContactRouting P, R.toP3723T1ContactPorts = D := by +-- BODY + classical + have symmetric (a b : ι) := ContactDrawingGeometry.symmetric ι P a b + have present (a b : ι) (p : Real × Real) (hp : D.port a b = some p) := + ContactDrawingGeometry.present ι P D a b p hp + have port_exists (a b : ι) (hab : P3723T1EdgeContact P a b) := + ContactDrawingGeometry.port_exists ι P D a b hab + let q (a : ι) (b : {b // P3723T1EdgeContact P a b}) : Real × Real := + Classical.choose (port_exists a b b.property) + have hq (a : ι) (b : {b // P3723T1EdgeContact P a b}) : + D.port a b = some (q a b) := Classical.choose_spec (port_exists a b b.property) + have qfrontier (a : ι) (b : {b // P3723T1EdgeContact P a b}) : + q a b ∈ frontier (TileRealization (P.tile a)) := + (D.port_frontier a b (q a b) (hq a b)).1 + have qinjective (a : ι) := ContactDrawingGeometry.qinjective ι P D port_exists hq a + choose localStar local_properties local_support local_intersections using + fun a => P3723T1GridDiskBoundaryStars (P.tile a) (P.tiles_are_disks a) + (D.position a) (D.position_in_tile_interior a) (q a) (qfrontier a) (qinjective a) + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + have rep_spec (a : ι) : rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a) := + Classical.choose_spec (P.vertex_orbit_representatives a).exists + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + have period_spec (a : ι) : a = P.shift (period a) (rep a) := + Classical.choose_spec (rep_spec a).2 + have pulled_contact (a b : ι) (hab : P3723T1EdgeContact P a b) := + ContactDrawingGeometry.pulled_contact ι P D rep_spec period_spec a b hab + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + have gproperties : ∀ a b, P3723T1EdgeContact P a b → + Continuous (g a b) ∧ Function.Injective (g a b) ∧ + g a b ⟨0, by norm_num⟩ = D.position a ∧ + D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ + Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ + Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ + {g a b ⟨1, by norm_num⟩} := ContactDrawingGeometry.gproperties ι P D port_exists hq + localStar + local_properties local_support rep_spec period_spec pulled_contact + have range_form (a b : ι) (hab : P3723T1EdgeContact P a b) := + ContactDrawingGeometry.range_form ι P D localStar rep_spec pulled_contact a b hab + have gintersections : ∀ a b c, P3723T1EdgeContact P a b → + P3723T1EdgeContact P a c → b ≠ c → + Set.range (g a b) ∩ Set.range (g a c) = {D.position a} := + ContactDrawingGeometry.gintersections ι P D localStar local_intersections rep_spec + period_spec pulled_contact range_form + have gperiodic := ContactDrawingGeometry.gperiodic ι P D localStar rep_spec period_spec + pulled_contact + let halfArc (a b : ι) : Set (Real × Real) := + if P3723T1EdgeContact P a b then Set.range (g a b) else ∅ + let edgeArc (a b : ι) : Set (Real × Real) := halfArc a b ∪ halfArc b a + have half_parameters := ContactDrawingGeometry.half_parameters ι P D present localStar rep_spec + pulled_contact gproperties + have full_parameters : ∀ a b, P3723T1EdgeContact P a b → + ∃ f : Icc (0 : Real) 1 → Real × Real, + Continuous f ∧ Function.Injective f ∧ Set.range f = edgeArc a b ∧ + f ⟨0, by norm_num⟩ = D.position a ∧ f ⟨1, by norm_num⟩ = D.position b ∧ + Nonempty (P3723T1PolygonalParameterization f) := + ContactDrawingParameterization.full_parameters ι P D symmetric port_exists localStar + rep_spec pulled_contact gproperties + have parameter_homeomorph (A : Set (Real × Real)) + (f : Icc (0 : Real) 1 → Real × Real) (hc : Continuous f) + (hi : Function.Injective f) (hr : Set.range f = A) := + ContactDrawingGeometry.parameter_homeomorph A f hc hi hr + have half_periodic : ∀ u : P.lattice, ∀ a b, + halfArc (P.shift u a) (P.shift u b) = + (fun p => p + GaussianRealPoint u) '' halfArc a b := ContactDrawingGeometry.half_periodic + ι P D localStar rep_spec pulled_contact gperiodic + have tile_closed (T : ProtoTile) := ContactDrawingGeometry.tile_closed T + have compact_cells_finite (K : Set (Real × Real)) (hK : IsCompact K) := + ContactDrawingGeometry.compact_cells_finite K hK + have half_range_in_tile (x y : ι) (hxy : P3723T1EdgeContact P x y) := + ContactDrawingGeometry.half_range_in_tile ι P D localStar rep_spec pulled_contact + gproperties tile_closed x y hxy + have frontier_no_interior (T : ProtoTile) (p : Real × Real) + (hp : p ∈ frontier (TileRealization T)) := ContactDrawingGeometry.frontier_no_interior + tile_closed T p hp + have half_disjoint (x y u v : ι) + (hxy : P3723T1EdgeContact P x y) (huv : P3723T1EdgeContact P u v) + (hpair : ({x, y} : Set ι) ≠ {u, v}) (hxu : x ≠ u) := ContactDrawingGeometry.half_disjoint ι + P D port_exists localStar rep_spec pulled_contact gproperties frontier_no_interior x y + u v hxy huv hpair hxu + have drawingCertificate : + ∃ R : P3723T1AllContactRouting P, R.toP3723T1ContactPorts = D := + ContactDrawingCertificate.drawingCertificate ι P D symmetric present localStar rep_spec + pulled_contact gproperties gintersections half_parameters full_parameters + parameter_homeomorph half_periodic compact_cells_finite half_range_in_tile half_disjoint + exact drawingCertificate + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactRouting.lean b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactRouting.lean new file mode 100644 index 0000000000..95c26ea4c1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactRouting.lean @@ -0,0 +1,104 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3723T1ContactPorts +public import LeanPool.ApollonianSuperharmonic.P3723T1PolygonalParameterization + +-- [TABLET NODE: P3723T1AllContactRouting] + +/-! +# P3723T1AllContactRouting + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a `PeriodicTileComplex` $P$, an all-contact routing +extends `P3723T1ContactPorts` by half-arc sets $J_{ab}$ +and full-arc sets $A_{ab}$. Both sets are empty on noncontacts. +For every present port $q_{ab}$, $J_{ab}$ is interval-homeomorphic +with named endpoints $x_a,q_{ab}$ and is contained in +$\operatorname{int}I_a\cup\{q_{ab}\}$. Distinct contact half-arcs +incident to $a$ meet exactly in $\{x_a\}$. + +Full arcs are symmetric and, on present ports, satisfy +$A_{ab}=J_{ab}\cup J_{ba}$. For every genuine contact they are +interval-homeomorphic with endpoints $x_a,x_b$. Distinct unordered +contact pairs satisfy the exact intersection law +$A_{ab}\cap A_{cd}=x(\{a,b\}\cap\{c,d\})$. +For every compact plane set $K$, the ordered contacts whose full arcs +meet $K$ form a finite set. Every half-arc at a present port and every +full contact arc also retain a continuous injective plane-valued +parametrization with that exact range, the stated endpoint values, +and a `P3723T1PolygonalParameterization` certificate. +Half- and full-arc sets translate equivariantly under all periods. +Here $I_a=\operatorname{TileRealization}(T_a)$ as in +`TileRealization`. These data retain +arcs for nonprescribed genuine contacts as public fields; no contact +classification or facial-region data are included. +-/ +structure P3723T1AllContactRouting {ι : Type} + (P : PeriodicTileComplex ι) extends P3723T1ContactPorts P where +-- BODY + /-- The tile-interior half arc from a tile position to a genuine-contact port. -/ + halfArc : ι → ι → Set (Real × Real) + /-- The full arc joining the positions of two genuinely contacting tiles. -/ + edgeArc : ι → ι → Set (Real × Real) + noncontact_has_no_halfArc : ∀ a b, ¬ P3723T1EdgeContact P a b → halfArc a b = ∅ + noncontact_has_no_edgeArc : ∀ a b, ¬ P3723T1EdgeContact P a b → edgeArc a b = ∅ + halfArc_homeomorph : ∀ a b p, port a b = some p → + ∃ h : (Set.Icc (0 : Real) 1) ≃ₜ halfArc a b, + ((h ⟨0, by norm_num⟩ : halfArc a b) : Real × Real) = + position a ∧ + ((h ⟨1, by norm_num⟩ : halfArc a b) : Real × Real) = p + halfArc_supported : ∀ a b p, port a b = some p → + halfArc a b ⊆ interior (TileRealization (P.tile a)) ∪ {p} + incident_halfArc_intersections : ∀ a b c, + P3723T1EdgeContact P a b → P3723T1EdgeContact P a c → b ≠ c → + halfArc a b ∩ halfArc a c = {position a} + edgeArc_symmetric : ∀ a b, edgeArc a b = edgeArc b a + edgeArc_from_halfArcs : ∀ a b p, port a b = some p → + edgeArc a b = halfArc a b ∪ halfArc b a + edgeArc_homeomorph : ∀ a b, P3723T1EdgeContact P a b → + ∃ h : (Set.Icc (0 : Real) 1) ≃ₜ edgeArc a b, + ((h ⟨0, by norm_num⟩ : edgeArc a b) : Real × Real) = + position a ∧ + ((h ⟨1, by norm_num⟩ : edgeArc a b) : Real × Real) = + position b + edgeArc_intersections : ∀ a b c d, + P3723T1EdgeContact P a b → P3723T1EdgeContact P c d → + ({a, b} : Set ι) ≠ ({c, d} : Set ι) → + edgeArc a b ∩ edgeArc c d = + position '' (({a, b} : Set ι) ∩ ({c, d} : Set ι)) + compact_local_finiteness : ∀ K : Set (Real × Real), IsCompact K → + Set.Finite {e : ι × ι | + P3723T1EdgeContact P e.1 e.2 ∧ (edgeArc e.1 e.2 ∩ K).Nonempty} + halfArc_parameterization : ∀ a b p, port a b = some p → + ∃ g : Set.Icc (0 : Real) 1 → Real × Real, + Continuous g ∧ Function.Injective g ∧ Set.range g = halfArc a b ∧ + g ⟨0, by norm_num⟩ = position a ∧ g ⟨1, by norm_num⟩ = p ∧ + Nonempty (P3723T1PolygonalParameterization g) + edgeArc_parameterization : ∀ a b, P3723T1EdgeContact P a b → + ∃ g : Set.Icc (0 : Real) 1 → Real × Real, + Continuous g ∧ Function.Injective g ∧ Set.range g = edgeArc a b ∧ + g ⟨0, by norm_num⟩ = position a ∧ g ⟨1, by norm_num⟩ = position b ∧ + Nonempty (P3723T1PolygonalParameterization g) + halfArc_periodic : ∀ u : P.lattice, ∀ a b, + halfArc (P.shift u a) (P.shift u b) = + (fun p => p + GaussianRealPoint u) '' halfArc a b + edgeArc_periodic : ∀ u : P.lattice, ∀ a b, + edgeArc (P.shift u a) (P.shift u b) = + (fun p => p + GaussianRealPoint u) '' edgeArc a b + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1ContactPorts.lean b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPorts.lean new file mode 100644 index 0000000000..7692bb9e77 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPorts.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3723T1EdgeContact +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: P3723T1ContactPorts] + +/-! +# P3723T1ContactPorts + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a `PeriodicTileComplex` $P$, this record has a position +$x_a$ for each index, a selected lattice edge $e_{ab}$ and optional +plane point $q_{ab}$ for each ordered pair, with the following laws. +The edge and port are symmetric. On every genuine +`P3723T1EdgeContact`, the edge belongs to both footprint +edge sets, has two endpoints, and the port is present and equals the +coordinatewise sum of these endpoints divided by two. Off contacts +the port is absent and the edge empty, and port absence is equivalent +to noncontact. + +Each position is the center +$\operatorname{GaussianRealPoint}(z)+(1/2,1/2)$ of some cell +$z\in T_a.\mathrm{cells}$, is in the tile's ambient interior, and +the position map is injective. For $a\ne b$, the interior of $T_a$'s +realization is disjoint from all of $T_b$'s realization. Every present +port is in both ambient frontiers and in no third tile realization. +Two present ports at the same point have the same unordered owner +pair, and distinct contacts incident to one index have distinct ports. + +Every index has finitely many contact neighbors. The record retains a +finite set of ordered genuine contact representatives such that every +ordered contact is a simultaneous lattice shift of one of them. +A shift stabilizing any unordered pair of indices is zero, and genuine +contact is invariant under simultaneous shifts. Positions translate +by the real period, selected edges by endpointwise lattice translation, +and ports by optional real translation, for every pair including +noncontacts. No reverse implication from contact to prescribed +adjacency is included. +-/ +structure P3723T1ContactPorts {ι : Type} (P : PeriodicTileComplex ι) where +-- BODY + /-- The selected constituent-cell center used as the tile position. -/ + position : ι → Real × Real + /-- The selected common unit footprint edge at each genuine contact. -/ + portEdge : ι → ι → Finset GaussianInt + /-- The midpoint of the selected edge, absent exactly on noncontacts. -/ + port : ι → ι → Option (Real × Real) + portEdge_symmetric : ∀ a b, portEdge a b = portEdge b a + port_symmetric : ∀ a b, port a b = port b a + portEdge_common : ∀ a b, P3723T1EdgeContact P a b → + portEdge a b ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b) + portEdge_two : ∀ a b, P3723T1EdgeContact P a b → (portEdge a b).card = 2 + port_midpoint : ∀ a b, P3723T1EdgeContact P a b → + port a b = some + (((∑ z ∈ portEdge a b, (((z.re : Int) : Real))) / 2), + ((∑ z ∈ portEdge a b, (((z.im : Int) : Real))) / 2)) + port_eq_none_iff : ∀ a b, port a b = none ↔ ¬ P3723T1EdgeContact P a b + noncontact_has_no_portEdge : ∀ a b, ¬ P3723T1EdgeContact P a b → + portEdge a b = ∅ + position_cell : ∀ a, ∃ z ∈ (P.tile a).cells, + position a = GaussianRealPoint z + ((1 / 2 : Real), (1 / 2 : Real)) + position_in_tile_interior : ∀ a, position a ∈ interior (TileRealization (P.tile a)) + position_injective : Function.Injective position + interior_disjoint_tiles : ∀ a b, a ≠ b → + Disjoint (interior (TileRealization (P.tile a))) (TileRealization (P.tile b)) + port_frontier : ∀ a b p, port a b = some p → + p ∈ frontier (TileRealization (P.tile a)) ∩ frontier (TileRealization (P.tile b)) + port_no_third : ∀ a b p, port a b = some p → + ∀ c, c ≠ a → c ≠ b → p ∉ TileRealization (P.tile c) + port_owner_pair : ∀ a b c d p, port a b = some p → port c d = some p → + ({a, b} : Set ι) = {c, d} + incident_ports_distinct : ∀ a b c p q, + port a b = some p → port a c = some q → b ≠ c → p ≠ q + finite_degree : ∀ a, Set.Finite {b | P3723T1EdgeContact P a b} + /-- A finite set representing all ordered genuine contacts under period translation. -/ + contactOrbitReps : Finset (ι × ι) + contactOrbitReps_genuine : ∀ e ∈ contactOrbitReps, P3723T1EdgeContact P e.1 e.2 + contact_orbit_representatives : ∀ a b, P3723T1EdgeContact P a b → + ∃ e ∈ contactOrbitReps, ∃ u : P.lattice, + a = P.shift u e.1 ∧ b = P.shift u e.2 + unordered_stabilizer : ∀ u : P.lattice, ∀ a b, + ({P.shift u a, P.shift u b} : Set ι) = {a, b} → u = 0 + contact_periodic : ∀ u : P.lattice, ∀ a b, + P3723T1EdgeContact P (P.shift u a) (P.shift u b) ↔ P3723T1EdgeContact P a b + position_periodic : ∀ u : P.lattice, ∀ a, + position (P.shift u a) = position a + GaussianRealPoint u + portEdge_periodic : ∀ u : P.lattice, ∀ a b, + portEdge (P.shift u a) (P.shift u b) = + (portEdge a b).image (fun z => z + (u : GaussianInt)) + port_periodic : ∀ u : P.lattice, ∀ a b, + port (P.shift u a) (P.shift u b) = + (port a b).map (fun p => p + GaussianRealPoint u) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean new file mode 100644 index 0000000000..36bd0e9669 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean @@ -0,0 +1,1982 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3723T1ContactPorts +public import LeanPool.ApollonianSuperharmonic.P3723T1ContactStabilizer +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import Mathlib.Topology.Order.DenselyOrdered +public import Mathlib.Data.Quot + +-- [TABLET NODE: P3723T1ContactPortsExist] + +/-! +# P3723T1ContactPortsExist + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ContactPortGeometry + +private theorem owner_unique : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), ∀ (z : GaussianInt), + (z ∈ (P.tile a).cells) → ((z ∈ (P.tile b).cells) → (a = b)) ) := by + classical + intro ι P a b z ha hb + exact (PeriodicTileIndexedMultiplicityOne P z).unique ha hb + +private theorem openSquare_closure : + (by + classical + exact + let openSquare (z : GaussianInt) : Set (Real × Real) := + Set.Ioo (z.re : Real) ((z.re : Real) + 1) ×ˢ + Set.Ioo (z.im : Real) ((z.im : Real) + 1) + ∀ (z : GaussianInt), closure (openSquare z) = ClosedSquareRealization z ) := by + classical + intro openSquare z + dsimp [openSquare, ClosedSquareRealization] + rw [closure_prod_eq, closure_Ioo (by linarith), closure_Ioo (by linarith), + Set.Icc_prod_Icc] + +private theorem coord_unique : + (by + classical + exact + ∀ (m : Int), ∀ (n : Int), ∀ (t : Real), ((m : Real) < t ∧ t < (m : Real) + 1) → (((n : + Real) ≤ t ∧ t ≤ (n : Real) + 1) → (m = n)) ) := by + classical + intro m n t hm hn + have hmn : (m : Real) < ((n + 1 : Int) : Real) := by + push_cast + linarith + have hnm : (n : Real) < ((m + 1 : Int) : Real) := by + push_cast + linarith + have hi : m < n + 1 := by exact_mod_cast hmn + have hj : n < m + 1 := by exact_mod_cast hnm + omega + +private theorem square_unique : + (by + classical + exact + let openSquare (z : GaussianInt) : Set (Real × Real) := + Set.Ioo (z.re : Real) ((z.re : Real) + 1) ×ˢ + Set.Ioo (z.im : Real) ((z.im : Real) + 1) + (∀ (m : Int), ∀ (n : Int), ∀ (t : Real), ((m : Real) < t ∧ t < (m : Real) + 1) → (((n : + Real) ≤ t ∧ t ≤ (n : Real) + 1) → (m = n))) → (∀ (x : GaussianInt), ∀ (y : + GaussianInt), ∀ (p : Real × Real), (p ∈ openSquare x) → ((p ∈ ClosedSquareRealization + y) → (x = y))) ) := by + classical + intro openSquare coord_unique x y p hx hy + simp only [openSquare, Set.mem_prod, Set.mem_Ioo] at hx + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hy + apply Zsqrtd.ext + · exact coord_unique x.re y.re p.1 hx.1 ⟨hy.1.1, hy.2.1⟩ + · exact coord_unique x.im y.im p.2 hx.2 ⟨hy.1.2, hy.2.2⟩ + +private theorem interior_disjoint : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (a : ι), ∀ (b : ι), ∀ (z : GaussianInt), + (z ∈ (P.tile a).cells) → ((z ∈ (P.tile b).cells) → (a = b))) → ( + let openSquare (z : GaussianInt) : Set (Real × Real) := + Set.Ioo (z.re : Real) ((z.re : Real) + 1) ×ˢ + Set.Ioo (z.im : Real) ((z.im : Real) + 1) + (∀ (z : GaussianInt), closure (openSquare z) = ClosedSquareRealization z) → ((∀ (x : + GaussianInt), ∀ (y : GaussianInt), ∀ (p : Real × Real), (p ∈ openSquare x) → ((p ∈ + ClosedSquareRealization y) → (x = y))) → (∀ (a : ι), ∀ (b : ι), (a ≠ b) → (Disjoint + (interior (TileRealization (P.tile a))) (TileRealization (P.tile b)))))) ) := by + classical + intro ι P owner_unique openSquare openSquare_closure square_unique a b hab + apply Set.disjoint_left.mpr + intro p hp hpb + obtain ⟨z, hz, hpz⟩ := Set.mem_iUnion₂.mp hpb + have hd : Disjoint (TileRealization (P.tile a)) (openSquare z) := by + apply Set.disjoint_left.mpr + intro q hqa hqz + obtain ⟨x, hx, hqx⟩ := Set.mem_iUnion₂.mp hqa + have hxz := square_unique z x q hqz hqx + exact hab (owner_unique a b z (hxz.symm ▸ hx) hz) + have hc := (hd.mono_left interior_subset).closure_right isOpen_interior + rw [openSquare_closure] at hc + exact Set.disjoint_left.mp hc hp hpz + +private theorem center_interior : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), + let openSquare (z : GaussianInt) : Set (Real × Real) := + Set.Ioo (z.re : Real) ((z.re : Real) + 1) ×ˢ + Set.Ioo (z.im : Real) ((z.im : Real) + 1) + (∀ (z : GaussianInt), IsOpen (openSquare z)) → ((∀ (z : GaussianInt), closure (openSquare + z) = ClosedSquareRealization z) → (∀ (a : ι), ∀ (z : GaussianInt), (z ∈ (P.tile + a).cells) → (GaussianRealPoint z + ((1 / 2 : Real), (1 / 2 : Real)) ∈ interior + (TileRealization (P.tile a))))) ) := by + classical + intro ι P openSquare openSquare_open openSquare_closure a z hz + apply interior_mono (s := openSquare z) + · exact (subset_closure.trans (by + rw [openSquare_closure] + exact fun _ h => Set.mem_iUnion₂.mpr ⟨z, hz, h⟩)) + · rw [(openSquare_open z).interior_eq] + simp only [openSquare, GaussianRealPoint, Set.mem_prod, Set.mem_Ioo, + Prod.fst_add, Prod.snd_add] + constructor <;> constructor <;> linarith + +private theorem horizontal_midpoint : + (by + classical + exact + let midpoint (e : Finset GaussianInt) : Real × Real := + ((∑ z ∈ e, (z.re : Real)) / 2, (∑ z ∈ e, (z.im : Real)) / 2) + ∀ (z : GaussianInt), midpoint {z, z + 1} = ((z.re : Real) + 1 / 2, (z.im : Real)) ) := by + classical + intro midpoint z + have hn : z ≠ z + 1 := by + intro h + have hh := congrArg Zsqrtd.re h + simp at hh + simp [midpoint, Finset.sum_pair hn] + ring + +private theorem vertical_midpoint : + (by + classical + exact + let midpoint (e : Finset GaussianInt) : Real × Real := + ((∑ z ∈ e, (z.re : Real)) / 2, (∑ z ∈ e, (z.im : Real)) / 2) + ∀ (z : GaussianInt), midpoint {z, z + ⟨0, 1⟩} = ((z.re : Real), (z.im : Real) + 1 / 2) ) + := by + classical + intro midpoint z + have hn : z ≠ z + ⟨0, 1⟩ := by + intro h + have hh := congrArg Zsqrtd.im h + simp at hh + simp [midpoint, Finset.sum_pair hn] + ring + +private theorem edge_normal : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges T) → (∃ z : + GaussianInt, e = {z, z + 1} ∨ e = {z, z + ⟨0, 1⟩}) ) := by + classical + intro T e he + obtain ⟨x, hx, he⟩ := he + rcases he with he | he | he | he + · exact ⟨x, Or.inl he⟩ + · exact ⟨x, Or.inr he⟩ + · exact ⟨x + 1, Or.inr he⟩ + · refine ⟨x + ⟨0, 1⟩, Or.inl ?_⟩ + simpa only [add_assoc, add_comm, add_left_comm] using he + +private theorem midpoint_cell : + (by + classical + exact + let midpoint (e : Finset GaussianInt) : Real × Real := + ((∑ z ∈ e, (z.re : Real)) / 2, (∑ z ∈ e, (z.im : Real)) / 2) + (∀ (z : GaussianInt), midpoint {z, z + 1} = ((z.re : Real) + 1 / 2, (z.im : Real))) → ((∀ + (z : GaussianInt), midpoint {z, z + ⟨0, 1⟩} = ((z.re : Real), (z.im : Real) + 1 / 2)) + → (∀ (T : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges T) → (∃ z ∈ + T.cells, midpoint e ∈ ClosedSquareRealization z))) ) := by + classical + intro midpoint horizontal_midpoint vertical_midpoint T e he + obtain ⟨x, hx, he⟩ := he + refine ⟨x, hx, ?_⟩ + rcases he with he | he | he | he + · rw [he, horizontal_midpoint] + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor <;> constructor <;> linarith + · rw [he, vertical_midpoint] + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor <;> constructor <;> linarith + · rw [he, vertical_midpoint] + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, + Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one, + Int.cast_add, Int.cast_one, Int.cast_zero] + constructor <;> constructor <;> linarith + · have he' : e = {x + ⟨0, 1⟩, (x + ⟨0, 1⟩) + 1} := by + simpa only [add_assoc, add_comm, add_left_comm] using he + rw [he', horizontal_midpoint] + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, + Zsqrtd.re_add, Zsqrtd.im_add, Int.cast_add, Int.cast_one, Int.cast_zero] + constructor <;> constructor <;> norm_num + +private theorem midpoint_two_cells : + (by + classical + exact + (∀ (m : Int), ∀ (n : Int), ∀ (t : Real), ((m : Real) < t ∧ t < (m : Real) + 1) → (((n : + Real) ≤ t ∧ t ≤ (n : Real) + 1) → (m = n))) → ( + let midpoint (e : Finset GaussianInt) : Real × Real := + ((∑ z ∈ e, (z.re : Real)) / 2, (∑ z ∈ e, (z.im : Real)) / 2) + (∀ (z : GaussianInt), midpoint {z, z + 1} = ((z.re : Real) + 1 / 2, (z.im : Real))) → ((∀ + (z : GaussianInt), midpoint {z, z + ⟨0, 1⟩} = ((z.re : Real), (z.im : Real) + 1 / 2)) + → ((∀ (T : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges T) → (∃ z : + GaussianInt, e = {z, z + 1} ∨ e = {z, z + ⟨0, 1⟩})) → (∀ (T : ProtoTile), ∀ (e : + Finset GaussianInt), (e ∈ FootprintEdges T) → (∃ x y : GaussianInt, x ≠ y ∧ ∀ z, + midpoint e ∈ ClosedSquareRealization z → z = x ∨ z = y))))) ) := by + classical + intro coord_unique midpoint horizontal_midpoint vertical_midpoint edge_normal T e he + obtain ⟨x, rfl | rfl⟩ := edge_normal T e he + · refine ⟨x, x - ⟨0, 1⟩, ?_, ?_⟩ + · intro h + have hi := congrArg Zsqrtd.im h + simp at hi + omega + · intro z hz + rw [horizontal_midpoint] at hz + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hz + have hre : x.re = z.re := coord_unique x.re z.re ((x.re : Real) + 1 / 2) + ⟨by linarith, by linarith⟩ ⟨hz.1.1, hz.2.1⟩ + have hlo : z.im ≤ x.im := by exact_mod_cast hz.1.2 + have hup : x.im ≤ z.im + 1 := by exact_mod_cast hz.2.2 + have him : z.im = x.im ∨ z.im = x.im - 1 := by omega + rcases him with him | him + · left + exact Zsqrtd.ext hre.symm him + · right + apply Zsqrtd.ext + · simpa using hre.symm + · simpa using him + · refine ⟨x, x - 1, ?_, ?_⟩ + · intro h + have hr := congrArg Zsqrtd.re h + simp at hr + omega + · intro z hz + rw [vertical_midpoint] at hz + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hz + have him : x.im = z.im := coord_unique x.im z.im ((x.im : Real) + 1 / 2) + ⟨by linarith, by linarith⟩ ⟨hz.1.2, hz.2.2⟩ + have hlo : z.re ≤ x.re := by exact_mod_cast hz.1.1 + have hup : x.re ≤ z.re + 1 := by exact_mod_cast hz.2.1 + have hre : z.re = x.re ∨ z.re = x.re - 1 := by omega + rcases hre with hre | hre + · left + exact Zsqrtd.ext hre him.symm + · right + apply Zsqrtd.ext + · simpa using hre + · simpa using him.symm + +private theorem common_midpoint : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (a : ι), ∀ (b : ι), ∀ (z : GaussianInt), + (z ∈ (P.tile a).cells) → ((z ∈ (P.tile b).cells) → (a = b))) → ( + let midpoint (e : Finset GaussianInt) : Real × Real := + ((∑ z ∈ e, (z.re : Real)) / 2, (∑ z ∈ e, (z.im : Real)) / 2) + (∀ (T : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges T) → (∃ z ∈ T.cells, + midpoint e ∈ ClosedSquareRealization z)) → ((∀ (T : ProtoTile), ∀ (e : Finset + GaussianInt), (e ∈ FootprintEdges T) → (∃ x y : GaussianInt, x ≠ y ∧ ∀ z, midpoint e + ∈ ClosedSquareRealization z → z = x ∨ z = y)) → (∀ (a : ι), ∀ (b : ι), (a ≠ b) → (∀ + (e : Finset GaussianInt), (e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) + → (midpoint e ∈ TileRealization (P.tile a) ∩ TileRealization (P.tile b) ∧ ∀ c, + midpoint e ∈ TileRealization (P.tile c) → c = a ∨ c = b))))) ) := by + classical + intro ι P owner_unique midpoint midpoint_cell midpoint_two_cells a b hab e he + obtain ⟨x, hx, hpx⟩ := midpoint_cell (P.tile a) e he.1 + obtain ⟨y, hy, hpy⟩ := midpoint_cell (P.tile b) e he.2 + have hxy : x ≠ y := by + intro h + exact hab (owner_unique a b x hx (h.symm ▸ hy)) + refine ⟨⟨Set.mem_iUnion₂.mpr ⟨x, hx, hpx⟩, + Set.mem_iUnion₂.mpr ⟨y, hy, hpy⟩⟩, ?_⟩ + intro c hc + obtain ⟨z, hz, hpz⟩ := Set.mem_iUnion₂.mp hc + obtain ⟨s, t, hst, hall⟩ := midpoint_two_cells (P.tile a) e he.1 + have hxst := hall x hpx + have hyst := hall y hpy + have hzst := hall z hpz + have hzx : z = x ∨ z = y := by + rcases hxst with rfl | rfl <;> rcases hyst with rfl | rfl + · exact (hxy rfl).elim + · exact hzst + · exact hzst.symm + · exact (hxy rfl).elim + rcases hzx with rfl | rfl + · exact Or.inl (owner_unique c a z hz hx) + · exact Or.inr (owner_unique c b z hz hy) + +private theorem common_frontier : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (T : ProtoTile), IsClosed + (TileRealization T)) → ((∀ (a : ι), ∀ (b : ι), (a ≠ b) → (Disjoint (interior + (TileRealization (P.tile a))) (TileRealization (P.tile b)))) → ( + let midpoint (e : Finset GaussianInt) : Real × Real := + ((∑ z ∈ e, (z.re : Real)) / 2, (∑ z ∈ e, (z.im : Real)) / 2) + (∀ (a : ι), ∀ (b : ι), (a ≠ b) → (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges (P.tile + a) ∩ FootprintEdges (P.tile b)) → (midpoint e ∈ TileRealization (P.tile a) ∩ + TileRealization (P.tile b) ∧ ∀ c, midpoint e ∈ TileRealization (P.tile c) → c = a ∨ c + = b))) → (∀ (a : ι), ∀ (b : ι), (a ≠ b) → (∀ (e : Finset GaussianInt), (e ∈ + FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) → (midpoint e ∈ frontier + (TileRealization (P.tile a)) ∩ frontier (TileRealization (P.tile b))))))) ) := by + classical + intro ι P realization_closed interior_disjoint midpoint common_midpoint a b hab e he + have hm := (common_midpoint a b hab e he).1 + constructor + · rw [(realization_closed (P.tile a)).frontier_eq] + exact ⟨hm.1, fun h => Set.disjoint_left.mp (interior_disjoint a b hab) h hm.2⟩ + · rw [(realization_closed (P.tile b)).frontier_eq] + exact ⟨hm.2, fun h => Set.disjoint_left.mp (interior_disjoint b a hab.symm) h hm.1⟩ + +private theorem footprint_finite : + (by + classical + exact + ∀ (T : ProtoTile), (FootprintEdges T).Finite ) := by + classical + intro T + let es : Finset (Finset GaussianInt) := T.cells.biUnion fun x => + {{x, x + 1}, {x, x + ⟨0, 1⟩}, {x + 1, x + 1 + ⟨0, 1⟩}, + {x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}} + apply es.finite_toSet.subset + rintro e ⟨x, hx, he⟩ + apply Finset.mem_biUnion.mpr + refine ⟨x, hx, ?_⟩ + simpa only [Finset.mem_insert, Finset.mem_singleton] using he + +private theorem finite_degree : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), + let midpoint (e : Finset GaussianInt) : Real × Real := + ((∑ z ∈ e, (z.re : Real)) / 2, (∑ z ∈ e, (z.im : Real)) / 2) + (∀ (T : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges T) → (∃ z ∈ T.cells, + midpoint e ∈ ClosedSquareRealization z)) → ((∀ (a : ι), ∀ (b : ι), (a ≠ b) → (∀ (e : + Finset GaussianInt), (e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) → + (midpoint e ∈ TileRealization (P.tile a) ∩ TileRealization (P.tile b) ∧ ∀ c, midpoint + e ∈ TileRealization (P.tile c) → c = a ∨ c = b))) → ((∀ (T : ProtoTile), + (FootprintEdges T).Finite) → (∀ (a : ι), Set.Finite {b | P3723T1EdgeContact P a + b}))) ) := by + classical + intro ι P midpoint midpoint_cell common_midpoint footprint_finite a + have hf (e : Finset GaussianInt) (he : e ∈ FootprintEdges (P.tile a)) : + Set.Finite {b | b ≠ a ∧ e ∈ FootprintEdges (P.tile b)} := by + apply Set.Subsingleton.finite + intro b hb c hc + obtain ⟨z, hz, hpz⟩ := midpoint_cell (P.tile c) e hc.2 + have hm := (common_midpoint a b hb.1.symm e ⟨he, hb.2⟩).2 c + (Set.mem_iUnion₂.mpr ⟨z, hz, hpz⟩) + exact hm.resolve_left hc.1 |>.symm + apply ((footprint_finite (P.tile a)).biUnion hf).subset + intro b hb + obtain ⟨e, he⟩ := hb.2 + exact Set.mem_iUnion₂.mpr ⟨e, he.1, hb.1.symm, he.2⟩ + +private theorem rep_spec : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep a) ) := by + classical + intro ι P rep a + exact Classical.choose_spec (P.vertex_orbit_representatives a).exists + +private theorem contact_symmetric : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P + a b ↔ P3723T1EdgeContact P b a ) := by + classical + intro ι P a b + simp only [P3723T1EdgeContact, ne_comm, Set.inter_comm] + +private theorem shift_injective : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (u : P.lattice), ∀ (a : ι), P.shift (-u) + (P.shift u a) = a) → (∀ (u : P.lattice), Function.Injective (P.shift u)) ) := by + classical + intro ι P shift_cancel u a b h + simpa only [shift_cancel] using congrArg (P.shift (-u)) h + +private theorem edges_periodic : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (u : P.lattice), ∀ (a : ι), FootprintEdges + (P.tile (P.shift u a)) = (fun e : Finset GaussianInt => e.image (fun z => z + (u : + GaussianInt))) '' FootprintEdges (P.tile a) ) := by + classical + intro ι P u a + rw [P.tile_periodic] + exact (TileTranslationFormulas (P.tile a) u).2.2.2.2.2.2.1 + +private theorem common_edge_transport : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (u : P.lattice), ∀ (a : ι), + FootprintEdges (P.tile (P.shift u a)) = (fun e : Finset GaussianInt => e.image (fun z + => z + (u : GaussianInt))) '' FootprintEdges (P.tile a)) → (∀ (u : P.lattice), ∀ (a : + ι), ∀ (b : ι), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges (P.tile a) ∩ + FootprintEdges (P.tile b)) → (e.image (fun z => z + (u : GaussianInt)) ∈ + FootprintEdges (P.tile (P.shift u a)) ∩ FootprintEdges (P.tile (P.shift u b)))) ) := by + classical + intro ι P edges_periodic u a b e he + rw [edges_periodic, edges_periodic] + exact ⟨⟨e, he.1, rfl⟩, ⟨e, he.2, rfl⟩⟩ + +private theorem contact_forward : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (u : P.lattice), Function.Injective + (P.shift u)) → ((∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), ∀ (e : Finset GaussianInt), + (e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) → (e.image (fun z => z + + (u : GaussianInt)) ∈ FootprintEdges (P.tile (P.shift u a)) ∩ FootprintEdges (P.tile + (P.shift u b)))) → (∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P + a b) → (P3723T1EdgeContact P (P.shift u a) (P.shift u b)))) ) := by + classical + intro ι P shift_injective common_edge_transport u a b hab + refine ⟨fun h => hab.1 (shift_injective u h), ?_⟩ + obtain ⟨e, he⟩ := hab.2 + exact ⟨_, common_edge_transport u a b e he⟩ + +private theorem contact_periodic : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (u : P.lattice), ∀ (a : ι), P.shift (-u) + (P.shift u a) = a) → ((∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact + P a b) → (P3723T1EdgeContact P (P.shift u a) (P.shift u b))) → (∀ (u : P.lattice), + ∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P (P.shift u a) (P.shift u b) ↔ + P3723T1EdgeContact P a b)) ) := by + classical + intro ι P shift_cancel contact_forward u a b + constructor + · intro h + simpa only [shift_cancel] using contact_forward (-u) _ _ h + · exact contact_forward u a b + +private theorem period_unique : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (u : P.lattice), ∀ (a : ι), P.shift (-u) + (P.shift u a) = a) → (∀ (r : ι), ∀ (u : P.lattice), ∀ (v : P.lattice), (P.shift u r = + P.shift v r) → (u = v)) ) := by + classical + intro ι P shift_cancel r u v h + have hfix : P.shift (u - v) r = r := by + rw [sub_eq_add_neg, add_comm, P.shift_add, h, shift_cancel] + have hz : u - v = 0 := P3723T1ContactStabilizer P.toPeriodicTileCore (u - v) r r + (by simp only [hfix]) + exact sub_eq_zero.mp hz + +private theorem rep_shift : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + (∀ (a : ι), a = P.shift (period a) (rep a)) → (∀ (u : P.lattice), ∀ (a : ι), rep (P.shift + u a) = rep a) ) := by + classical + intro ι P rep rep_spec period period_spec u a + apply (P.vertex_orbit_representatives (P.shift u a)).unique + · exact rep_spec (P.shift u a) + · refine ⟨(rep_spec a).1, u + period a, ?_⟩ + rw [P.shift_add, ← period_spec] + +private theorem period_shift : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + (∀ (a : ι), a = P.shift (period a) (rep a)) → ((∀ (r : ι), ∀ (u : P.lattice), ∀ (v : + P.lattice), (P.shift u r = P.shift v r) → (u = v)) → ((∀ (u : P.lattice), ∀ (a : ι), + rep (P.shift u a) = rep a) → (∀ (u : P.lattice), ∀ (a : ι), period (P.shift u a) = u + + period a))) ) := by + classical + intro ι P rep rep_spec period period_spec period_unique rep_shift u a + apply period_unique (rep a) + calc + P.shift (period (P.shift u a)) (rep a) = P.shift u a := by + rw [← rep_shift u a, ← period_spec] + _ = P.shift (u + period a) (rep a) := by rw [P.shift_add, ← period_spec] + +private theorem real_add : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (w : GaussianInt), GaussianRealPoint (z + w) = GaussianRealPoint z + + GaussianRealPoint w ) := by + classical + intro z w + ext <;> simp [GaussianRealPoint] + +private theorem position_cell : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (cells_nonempty : ∀ (a : ι), (P.tile + a).cells.Nonempty), + let cell (a : ι) : GaussianInt := Classical.choose (cells_nonempty a) + (∀ (a : ι), cell a ∈ (P.tile a).cells) → ( + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + (∀ (a : ι), a = P.shift (period a) (rep a)) → ( + let position (a : ι) : Real × Real := + GaussianRealPoint (cell (rep a) + (period a : GaussianInt)) + (1 / 2, 1 / 2) + ∀ (a : ι), ∃ z ∈ (P.tile a).cells, position a = GaussianRealPoint z + ((1 / 2 : Real), (1 + / 2 : Real)))) ) := by + classical + intro ι P cells_nonempty cell cell_mem rep rep_spec period period_spec position a + refine ⟨cell (rep a) + (period a : GaussianInt), ?_, rfl⟩ + have htile : P.tile a = TileTranslation (P.tile (rep a)) (period a) := + (congrArg P.tile (period_spec a)).trans (P.tile_periodic (period a) (rep a)) + rw [htile] + exact Finset.mem_image.mpr ⟨cell (rep a), cell_mem (rep a), rfl⟩ + +private theorem position_interior : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (a : ι), ∀ (z : GaussianInt), (z ∈ + (P.tile a).cells) → (GaussianRealPoint z + ((1 / 2 : Real), (1 / 2 : Real)) ∈ + interior (TileRealization (P.tile a)))) → (∀ (cells_nonempty : ∀ (a : ι), (P.tile + a).cells.Nonempty), + let cell (a : ι) : GaussianInt := Classical.choose (cells_nonempty a) + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + let position (a : ι) : Real × Real := + GaussianRealPoint (cell (rep a) + (period a : GaussianInt)) + (1 / 2, 1 / 2) + (∀ (a : ι), ∃ z ∈ (P.tile a).cells, position a = GaussianRealPoint z + ((1 / 2 : Real), + (1 / 2 : Real))) → (∀ (a : ι), position a ∈ interior (TileRealization (P.tile a)))) ) + := by + classical + intro ι P center_interior cells_nonempty cell rep rep_spec period position position_cell a + obtain ⟨z, hz, heq⟩ := position_cell a + rw [heq] + exact center_interior a z hz + +private theorem position_periodic : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (cells_nonempty : ∀ (a : ι), (P.tile + a).cells.Nonempty), + let cell (a : ι) : GaussianInt := Classical.choose (cells_nonempty a) + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + let position (a : ι) : Real × Real := + GaussianRealPoint (cell (rep a) + (period a : GaussianInt)) + (1 / 2, 1 / 2) + (∀ (u : P.lattice), ∀ (a : ι), rep (P.shift u a) = rep a) → ((∀ (u : P.lattice), ∀ (a : + ι), period (P.shift u a) = u + period a) → ((∀ (z : GaussianInt), ∀ (w : + GaussianInt), GaussianRealPoint (z + w) = GaussianRealPoint z + GaussianRealPoint w) + → (∀ (u : P.lattice), ∀ (a : ι), position (P.shift u a) = position a + + GaussianRealPoint u))) ) := by + classical + intro ι P cells_nonempty cell rep rep_spec period position rep_shift period_shift real_add u a + simp only [position, rep_shift, period_shift, AddSubgroup.coe_add, real_add] + abel + +private theorem representative_eq : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : + ι), P.shift (-u) (P.shift u a) = a), + let S : Setoid (ι × ι) := { + r := fun p q => ∃ u : P.lattice, + ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} + iseqv := { + refl := by + intro p + exact ⟨0, by simp only [P.shift_zero]⟩ + symm := by + intro p q h + obtain ⟨u, hu⟩ := h + refine ⟨-u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm + trans := by + intro p q r hpq hqr + obtain ⟨u, hu⟩ := hpq + obtain ⟨v, hv⟩ := hqr + refine ⟨v + u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift v '' s) hu + simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh + exact hh.trans hv + } + } + let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out + ∀ (p : ι × ι), ∀ (q : ι × ι), (S.r p q) → (representative p = representative q) ) := by + classical + intro ι P shift_cancel S representative p q h + exact congrArg Quotient.out (Quotient.sound h) + +private theorem transport_spec : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : + ι), P.shift (-u) (P.shift u a) = a), + let S : Setoid (ι × ι) := { + r := fun p q => ∃ u : P.lattice, + ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} + iseqv := { + refl := by + intro p + exact ⟨0, by simp only [P.shift_zero]⟩ + symm := by + intro p q h + obtain ⟨u, hu⟩ := h + refine ⟨-u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm + trans := by + intro p q r hpq hqr + obtain ⟨u, hu⟩ := hpq + obtain ⟨v, hv⟩ := hqr + refine ⟨v + u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift v '' s) hu + simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh + exact hh.trans hv + } + } + let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out + ∀ (representative_spec : ∀ (p : ι × ι), S.r (representative p) p), + let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) + ∀ (p : ι × ι), ({P.shift (transport p) (representative p).1, + P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2} ) := by + classical + intro ι P shift_cancel S representative representative_spec transport p + exact Classical.choose_spec (representative_spec p) + +private theorem transport_unique : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (u : P.lattice), ∀ (a : ι), P.shift (-u) + (P.shift u a) = a) → (∀ (r : ι × ι), ∀ (p : ι × ι), ∀ (u : P.lattice), ∀ (v : + P.lattice), (({P.shift u r.1, P.shift u r.2} : Set ι) = {p.1, p.2}) → + ((({P.shift v r.1, P.shift v r.2} : Set ι) = {p.1, p.2}) → (u = v))) ) := by + classical + intro ι P shift_cancel r p u v hu hv + have hh := congrArg (fun s : Set ι => P.shift (-v) '' s) (hu.trans hv.symm) + have hfix : ({P.shift (-v + u) r.1, P.shift (-v + u) r.2} : Set ι) = {r.1, r.2} := by + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel, + ← P.shift_add] using hh + have hz := P3723T1ContactStabilizer P.toPeriodicTileCore (-v + u) r.1 r.2 hfix + have hsub : u - v = 0 := by simpa only [sub_eq_add_neg, add_comm] using hz + exact sub_eq_zero.mp hsub + +private theorem transport_swap : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : + ι), P.shift (-u) (P.shift u a) = a), + let S : Setoid (ι × ι) := { + r := fun p q => ∃ u : P.lattice, + ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} + iseqv := { + refl := by + intro p + exact ⟨0, by simp only [P.shift_zero]⟩ + symm := by + intro p q h + obtain ⟨u, hu⟩ := h + refine ⟨-u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm + trans := by + intro p q r hpq hqr + obtain ⟨u, hu⟩ := hpq + obtain ⟨v, hv⟩ := hqr + refine ⟨v + u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift v '' s) hu + simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh + exact hh.trans hv + } + } + let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out + ∀ (representative_spec : ∀ (p : ι × ι), S.r (representative p) p), + let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) + (∀ (p : ι × ι), ({P.shift (transport p) (representative p).1, + P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2}) → ((∀ (r : ι × ι), + ∀ (p : ι × ι), ∀ (u : P.lattice), ∀ (v : P.lattice), (({P.shift u r.1, P.shift u r.2} + : Set ι) = {p.1, p.2}) → ((({P.shift v r.1, P.shift v r.2} : Set ι) = {p.1, p.2}) → + (u = v))) → ((∀ (a : ι), ∀ (b : ι), representative (a, b) = representative (b, a)) → + (∀ (a : ι), ∀ (b : ι), transport (a, b) = transport (b, a)))) ) := by + classical + intro ι P shift_cancel S representative representative_spec transport transport_spec + transport_unique representative_swap a b + apply transport_unique (representative (a, b)) (a, b) + · exact transport_spec (a, b) + · rw [representative_swap a b] + exact (transport_spec (b, a)).trans (Set.pair_comm _ _) + +private theorem representative_shift : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : + ι), P.shift (-u) (P.shift u a) = a), + let S : Setoid (ι × ι) := { + r := fun p q => ∃ u : P.lattice, + ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} + iseqv := { + refl := by + intro p + exact ⟨0, by simp only [P.shift_zero]⟩ + symm := by + intro p q h + obtain ⟨u, hu⟩ := h + refine ⟨-u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm + trans := by + intro p q r hpq hqr + obtain ⟨u, hu⟩ := hpq + obtain ⟨v, hv⟩ := hqr + refine ⟨v + u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift v '' s) hu + simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh + exact hh.trans hv + } + } + let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out + (∀ (p : ι × ι), ∀ (q : ι × ι), (S.r p q) → (representative p = representative q)) → (∀ (u + : P.lattice), ∀ (a : ι), ∀ (b : ι), representative (P.shift u a, P.shift u b) = + representative (a, b)) ) := by + classical + intro ι P shift_cancel S representative representative_eq u a b + apply (representative_eq (a, b) (P.shift u a, P.shift u b) ⟨u, rfl⟩).symm + +private theorem transport_shift : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : + ι), P.shift (-u) (P.shift u a) = a), + let S : Setoid (ι × ι) := { + r := fun p q => ∃ u : P.lattice, + ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} + iseqv := { + refl := by + intro p + exact ⟨0, by simp only [P.shift_zero]⟩ + symm := by + intro p q h + obtain ⟨u, hu⟩ := h + refine ⟨-u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm + trans := by + intro p q r hpq hqr + obtain ⟨u, hu⟩ := hpq + obtain ⟨v, hv⟩ := hqr + refine ⟨v + u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift v '' s) hu + simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh + exact hh.trans hv + } + } + let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out + ∀ (representative_spec : ∀ (p : ι × ι), S.r (representative p) p), + let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) + (∀ (p : ι × ι), ({P.shift (transport p) (representative p).1, + P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2}) → ((∀ (r : ι × ι), + ∀ (p : ι × ι), ∀ (u : P.lattice), ∀ (v : P.lattice), (({P.shift u r.1, P.shift u r.2} + : Set ι) = {p.1, p.2}) → ((({P.shift v r.1, P.shift v r.2} : Set ι) = {p.1, p.2}) → + (u = v))) → ((∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), representative (P.shift u a, + P.shift u b) = representative (a, b)) → (∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), + transport (P.shift u a, P.shift u b) = u + transport (a, b)))) ) := by + classical + intro ι P shift_cancel S representative representative_spec transport transport_spec + transport_unique representative_shift u a b + apply transport_unique (representative (a, b)) (P.shift u a, P.shift u b) + · rw [← representative_shift u a b] + exact transport_spec (P.shift u a, P.shift u b) + · have hh := congrArg (fun s : Set ι => P.shift u '' s) (transport_spec (a, b)) + simpa only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] using hh + +private theorem pair_contact : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact + P a b ↔ P3723T1EdgeContact P b a) → (∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (d : ι), + (({a, b} : Set ι) = {c, d}) → (P3723T1EdgeContact P a b ↔ P3723T1EdgeContact P c + d)) ) := by + classical + intro ι P contact_symmetric a b c d h + rcases Set.pair_eq_pair_iff.mp h with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · rfl + · exact contact_symmetric _ _ + +private theorem representative_contact : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : + ι), P.shift (-u) (P.shift u a) = a), (∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), + P3723T1EdgeContact P (P.shift u a) (P.shift u b) ↔ + P3723T1EdgeContact P a b) → ( + let S : Setoid (ι × ι) := { + r := fun p q => ∃ u : P.lattice, + ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} + iseqv := { + refl := by + intro p + exact ⟨0, by simp only [P.shift_zero]⟩ + symm := by + intro p q h + obtain ⟨u, hu⟩ := h + refine ⟨-u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm + trans := by + intro p q r hpq hqr + obtain ⟨u, hu⟩ := hpq + obtain ⟨v, hv⟩ := hqr + refine ⟨v + u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift v '' s) hu + simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh + exact hh.trans hv + } + } + let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out + ∀ (representative_spec : ∀ (p : ι × ι), S.r (representative p) p), + let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) + (∀ (p : ι × ι), ({P.shift (transport p) (representative p).1, + P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2}) → ((∀ (a : ι), ∀ + (b : ι), ∀ (c : ι), ∀ (d : ι), (({a, b} : Set ι) = {c, d}) → (P3723T1EdgeContact P + a b ↔ P3723T1EdgeContact P c d)) → (∀ (p : ι × ι), (P3723T1EdgeContact P p.1 p.2) + → (P3723T1EdgeContact P (representative p).1 (representative p).2))))) := by + classical + intro ι P shift_cancel contact_periodic S representative representative_spec transport + transport_spec pair_contact p hp + apply (contact_periodic (transport p) _ _).mp + exact (pair_contact _ _ _ _ (transport_spec p)).mpr hp + +private theorem baseEdge_common : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), + let baseEdge (p : ι × ι) : Finset GaussianInt := + if hp : P3723T1EdgeContact P p.1 p.2 then Classical.choose hp.2 else ∅ + ∀ (p : ι × ι), (P3723T1EdgeContact P p.1 p.2) → (baseEdge p ∈ FootprintEdges (P.tile + p.1) ∩ FootprintEdges (P.tile p.2)) ) := by + classical + intro ι P baseEdge p hp + simp only [baseEdge, dite_eq_left hp] + exact Classical.choose_spec hp.2 + +private theorem edge_common : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : + ι), P.shift (-u) (P.shift u a) = a), (∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), ∀ (e : + Finset GaussianInt), (e ∈ FootprintEdges (P.tile a) ∩ + FootprintEdges (P.tile b)) → (e.image (fun z => z + (u : GaussianInt)) ∈ + FootprintEdges (P.tile (P.shift u a)) ∩ FootprintEdges (P.tile (P.shift u b)))) → ( + let S : Setoid (ι × ι) := { + r := fun p q => ∃ u : P.lattice, + ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} + iseqv := { + refl := by + intro p + exact ⟨0, by simp only [P.shift_zero]⟩ + symm := by + intro p q h + obtain ⟨u, hu⟩ := h + refine ⟨-u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm + trans := by + intro p q r hpq hqr + obtain ⟨u, hu⟩ := hpq + obtain ⟨v, hv⟩ := hqr + refine ⟨v + u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift v '' s) hu + simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh + exact hh.trans hv + } + } + let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out + ∀ (representative_spec : ∀ (p : ι × ι), S.r (representative p) p), + let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) + (∀ (p : ι × ι), ({P.shift (transport p) (representative p).1, + P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2}) → ((∀ (p : ι × ι), + (P3723T1EdgeContact P p.1 p.2) → (P3723T1EdgeContact P (representative p).1 + (representative p).2)) → ( + let baseEdge (p : ι × ι) : Finset GaussianInt := + if hp : P3723T1EdgeContact P p.1 p.2 then Classical.choose hp.2 else ∅ + (∀ (p : ι × ι), (P3723T1EdgeContact P p.1 p.2) → (baseEdge p ∈ FootprintEdges (P.tile + p.1) ∩ FootprintEdges (P.tile p.2))) → ( + let edge (a b : ι) : Finset GaussianInt := + if P3723T1EdgeContact P a b then + (baseEdge (representative (a, b))).image + (fun z => z + (transport (a, b) : GaussianInt)) + else ∅ + ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → (edge a b ∈ FootprintEdges (P.tile + a) ∩ FootprintEdges (P.tile b))))))) := by + classical + intro ι P shift_cancel common_edge_transport S representative representative_spec transport + transport_spec representative_contact baseEdge baseEdge_common edge a b hab + have hh := common_edge_transport (transport (a, b)) + (representative (a, b)).1 (representative (a, b)).2 _ + (baseEdge_common _ (representative_contact (a, b) hab)) + simp only [edge, ite_eq_left hab] + rcases Set.pair_eq_pair_iff.mp (transport_spec (a, b)) with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · rw [h1, h2] at hh + exact hh + · rw [h1, h2] at hh + exact ⟨hh.2, hh.1⟩ + +private theorem footprint_card : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges T) → (e.card = 2) ) := by + classical + intro T e he + obtain ⟨x, hx, he⟩ := he + have hone (z : GaussianInt) : z ≠ z + 1 := by + intro h + have hh := congrArg Zsqrtd.re h + simp at hh + have him (z : GaussianInt) : z ≠ z + ⟨0, 1⟩ := by + intro h + have hh := congrArg Zsqrtd.im h + simp at hh + rcases he with rfl | rfl | rfl | he + · simp [hone] + · simp [him] + · simp [him] + · have he' : e = {x + ⟨0, 1⟩, (x + ⟨0, 1⟩) + 1} := by + simpa only [add_assoc, add_comm, add_left_comm] using he + rw [he'] + simp [hone] + +private theorem port_present : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), + let midpoint (e : Finset GaussianInt) : Real × Real := + ((∑ z ∈ e, (z.re : Real)) / 2, (∑ z ∈ e, (z.im : Real)) / 2) + ∀ (edge : ι → ι → Finset GaussianInt), + let port (a b : ι) : Option (Real × Real) := + if P3723T1EdgeContact P a b then some (midpoint (edge a b)) else none + ∀ (a : ι), ∀ (b : ι), ∀ (p : Real × Real), (port a b = some p) → (P3723T1EdgeContact P + a b ∧ midpoint (edge a b) = p) ) := by + classical + intro ι P midpoint edge port a b p hp + by_cases h : P3723T1EdgeContact P a b + · exact ⟨h, Option.some.inj (by simpa only [port, ite_eq_left h] using hp)⟩ + · simp only [port, ite_eq_right h] at hp + cases hp + +private theorem midpoint_periodic : + (by + classical + exact + let midpoint (e : Finset GaussianInt) : Real × Real := + ((∑ z ∈ e, (z.re : Real)) / 2, (∑ z ∈ e, (z.im : Real)) / 2) + ∀ (e : Finset GaussianInt), ∀ (u : GaussianInt), (e.card = 2) → (midpoint (e.image (fun z + => z + u)) = midpoint e + GaussianRealPoint u) ) := by + classical + intro midpoint e u he + have hinj : Function.Injective (fun z : GaussianInt => z + u) := + fun _ _ h => add_right_cancel h + dsimp [midpoint] + rw [Finset.sum_image, Finset.sum_image] + · simp only [Zsqrtd.re_add, Zsqrtd.im_add, Int.cast_add, + Finset.sum_add_distrib, Finset.sum_const, he, nsmul_eq_mul, + Nat.cast_ofNat, GaussianRealPoint] + apply Prod.ext <;> dsimp <;> ring + · exact hinj.injOn + · exact hinj.injOn + +private theorem hac : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + (∀ (a : ι), a = P.shift (period a) (rep a)) → ((∀ (u : P.lattice), ∀ (a : ι), P.shift + (-u) (P.shift u a) = a) → ((∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), + (P3723T1EdgeContact P a b) → (P3723T1EdgeContact P (P.shift u a) (P.shift u b))) + → (∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → ( + let c := P.shift (-period a) b + P3723T1EdgeContact P (rep a) c)))) ) := by + classical + intro ι P rep rep_spec period period_spec shift_cancel contact_forward a b hab c + have h := contact_forward (-period a) a b hab + have ha : P.shift (-period a) a = rep a := by + calc + P.shift (-period a) a = + P.shift (-period a) (P.shift (period a) (rep a)) := + congrArg (P.shift (-period a)) (period_spec a) + _ = rep a := shift_cancel (period a) (rep a) + rw [ha] at h + exact h + +end ContactPortGeometry + +namespace ContactPortClosure + +private theorem owner_unique : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), ∀ z ∈ (P.tile + a).cells, z ∈ (P.tile b).cells → a = b ) := by + classical + intro ι P a b z ha hb + exact ContactPortGeometry.owner_unique + ι P a b z ha hb + +private theorem coord_unique : + (by + classical + exact + ∀ (m : ℤ), ∀ (n : ℤ), ∀ (t : ℝ), (↑m : ℝ) < t ∧ t < (↑m : ℝ) + (1 : ℝ) → (↑n : ℝ) ≤ t ∧ t + ≤ (↑n : ℝ) + (1 : ℝ) → m = n ) := by + classical + intro m n t hm hn + exact ContactPortGeometry.coord_unique m n t hm hn + +private theorem square_unique : + (by + classical + exact + let openSquare (z : GaussianInt) : Set (Real × Real) := + Set.Ioo (z.re : Real) ((z.re : Real) + 1) ×ˢ + Set.Ioo (z.im : Real) ((z.im : Real) + 1) + (∀ (m : ℤ), ∀ (n : ℤ), ∀ (t : ℝ), (↑m : ℝ) < t ∧ t < (↑m : ℝ) + (1 : ℝ) → (↑n : ℝ) ≤ t ∧ + t ≤ (↑n : ℝ) + (1 : ℝ) → m = n) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ p ∈ + openSquare x, p ∈ ClosedSquareRealization y → x = y) ) := by + classical + intro openSquare coord_unique x y p hx hy + exact ContactPortGeometry.square_unique coord_unique x y p hx hy + +private theorem midpoint_cell : + (by + classical + exact + (∀ (z : GaussianInt), (fun (e : Finset GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), + (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) {z, z + (1 : GaussianInt)} = ((↑z.re : ℝ) + (1 / 2 + : ℝ), (↑z.im : ℝ))) → ((∀ (z : GaussianInt), (fun (e : Finset GaussianInt) => ((∑ z ∈ + e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) {z, z + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)} = ((↑z.re : ℝ), (↑z.im : ℝ) + (1 / 2 : ℝ))) → (∀ (T : + ProtoTile), ∀ e ∈ FootprintEdges T, ∃ z ∈ T.cells, (fun (e : Finset GaussianInt) => + ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) e ∈ + ClosedSquareRealization z)) ) := by + classical + intro horizontal_midpoint vertical_midpoint T e he + exact ContactPortGeometry.midpoint_cell horizontal_midpoint + vertical_midpoint T e he + +private theorem midpoint_two_cells : + (by + classical + exact + (∀ (m : ℤ), ∀ (n : ℤ), ∀ (t : ℝ), (↑m : ℝ) < t ∧ t < (↑m : ℝ) + (1 : ℝ) → (↑n : ℝ) ≤ t ∧ + t ≤ (↑n : ℝ) + (1 : ℝ) → m = n) → ((∀ (z : GaussianInt), (fun (e : Finset + GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) + {z, z + (1 : GaussianInt)} = ((↑z.re : ℝ) + (1 / 2 : ℝ), (↑z.im : ℝ))) → ((∀ (z : + GaussianInt), (fun (e : Finset GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ + z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) {z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} = ((↑z.re + : ℝ), (↑z.im : ℝ) + (1 / 2 : ℝ))) → ((∀ (T : ProtoTile), ∀ e ∈ FootprintEdges T, ∃ (z + : GaussianInt), e = {z, z + (1 : GaussianInt)} ∨ e = {z, z + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)}) → (∀ (T : ProtoTile), ∀ e ∈ FootprintEdges T, ∃ (x : + GaussianInt) (y : GaussianInt), x ≠ y ∧ ∀ (z : LatticeCell), (fun (e : Finset + GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) + e ∈ ClosedSquareRealization z → z = x ∨ z = y)))) ) := by + classical + intro coord_unique horizontal_midpoint vertical_midpoint edge_normal T e he + exact ContactPortGeometry.midpoint_two_cells coord_unique + horizontal_midpoint vertical_midpoint edge_normal T e he + +private theorem common_midpoint : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (a : ι), ∀ (b : ι), ∀ z ∈ (P.tile + a).cells, z ∈ (P.tile b).cells → a = b) → ((∀ (T : ProtoTile), ∀ e ∈ FootprintEdges + T, ∃ z ∈ T.cells, (fun (e : Finset GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), + (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) e ∈ ClosedSquareRealization z) → ((∀ (T : + ProtoTile), ∀ e ∈ FootprintEdges T, ∃ (x : GaussianInt) (y : GaussianInt), x ≠ y ∧ ∀ + (z : LatticeCell), (fun (e : Finset GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : + ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) e ∈ ClosedSquareRealization z → z = x ∨ z = y) + → (∀ (a : ι), ∀ (b : ι), a ≠ b → ∀ e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges + (P.tile b), (fun (e : Finset GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z + ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) e ∈ TileRealization (P.tile a) ∩ TileRealization + (P.tile b) ∧ ∀ (c : ι), (fun (e : Finset GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 + : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) e ∈ TileRealization (P.tile c) → c = a ∨ c = + b))) ) := by + classical + intro ι P owner_unique midpoint_cell midpoint_two_cells a b hab e he + exact ContactPortGeometry.common_midpoint ι P owner_unique midpoint_cell midpoint_two_cells a + b hab e he + +private theorem common_frontier : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (T : ProtoTile), IsClosed + (TileRealization T)) → ((∀ (a : ι), ∀ (b : ι), a ≠ b → Disjoint (interior + (TileRealization (P.tile a))) (TileRealization (P.tile b))) → ((∀ (a : ι), ∀ (b : ι), + a ≠ b → ∀ e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b), (fun (e : Finset + GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) + e ∈ TileRealization (P.tile a) ∩ TileRealization (P.tile b) ∧ ∀ (c : ι), (fun (e : + Finset GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 + : ℝ))) e ∈ TileRealization (P.tile c) → c = a ∨ c = b) → (∀ (a : ι), ∀ (b : ι), a ≠ b + → ∀ e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b), (fun (e : Finset + GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) + e ∈ frontier (TileRealization (P.tile a)) ∩ frontier (TileRealization (P.tile b))))) + ) := by + classical + intro ι P realization_closed interior_disjoint common_midpoint a b hab e he + exact ContactPortGeometry.common_frontier ι P realization_closed interior_disjoint + common_midpoint a b hab e he + +private theorem contact_symmetric : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P + a b ↔ P3723T1EdgeContact P b a ) := by + classical + intro ι P a b + exact ContactPortGeometry.contact_symmetric ι P a b + +private theorem common_edge_transport : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (u : ↥P.lattice), ∀ (a : ι), + FootprintEdges (P.tile (P.shift u a)) = (fun (e : Finset GaussianInt) => Finset.image + (fun (z : GaussianInt) => z + (↑u : GaussianInt)) e) '' FootprintEdges (P.tile a)) → + (∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), ∀ (e : Finset GaussianInt), (e ∈ + FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) → (e.image (fun z => z + (u : + GaussianInt)) ∈ FootprintEdges (P.tile (P.shift u a)) ∩ FootprintEdges (P.tile + (P.shift u b)))) ) := by + classical + intro ι P edges_periodic u a b e he + exact ContactPortGeometry.common_edge_transport ι P edges_periodic u a b e he + +private theorem contact_forward : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (u : ↥P.lattice), Function.Injective + (P.shift u)) → ((∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), ∀ (e : Finset GaussianInt), + (e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) → (e.image (fun z => z + + (u : GaussianInt)) ∈ FootprintEdges (P.tile (P.shift u a)) ∩ FootprintEdges (P.tile + (P.shift u b)))) → (∀ (u : ↥P.lattice), ∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P + a b → P3723T1EdgeContact P (P.shift u a) (P.shift u b))) ) := by + classical + intro ι P shift_injective common_edge_transport u a b hab + exact ContactPortGeometry.contact_forward ι P + shift_injective common_edge_transport u a b hab + +private theorem contact_periodic : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (u : P.lattice), ∀ (a : ι), P.shift (-u) + (P.shift u a) = a) → ((∀ (u : ↥P.lattice), ∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact + P a b → P3723T1EdgeContact P (P.shift u a) (P.shift u b)) → (∀ (u : P.lattice), ∀ + (a : ι), ∀ (b : ι), P3723T1EdgeContact P (P.shift u a) (P.shift u b) ↔ + P3723T1EdgeContact P a b)) ) := by + classical + intro ι P shift_cancel contact_forward u a b + exact ContactPortGeometry.contact_periodic ι P shift_cancel + contact_forward u a b + +private theorem position_cell : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (cells_nonempty : ∀ (a : ι), (P.tile + a).cells.Nonempty), + let cell (a : ι) : GaussianInt := Classical.choose (cells_nonempty a) + (∀ (a : ι), cell a ∈ (P.tile a).cells) → ( + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + (∀ (a : ι), a = P.shift (period a) (rep a)) → ( + let position (a : ι) : Real × Real := + GaussianRealPoint (cell (rep a) + (period a : GaussianInt)) + (1 / 2, 1 / 2) + ∀ (a : ι), ∃ z ∈ (P.tile a).cells, position a = GaussianRealPoint z + ((1 / 2 : Real), (1 + / 2 : Real)))) ) := by + classical + intro ι P cells_nonempty cell cell_mem rep rep_spec period period_spec position a + exact ContactPortGeometry.position_cell ι P cells_nonempty cell_mem + rep_spec period_spec a + +private theorem position_interior : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (a : ι), ∀ z ∈ (P.tile a).cells, + GaussianRealPoint z + ((1 / 2 : ℝ), (1 / 2 : ℝ)) ∈ interior (TileRealization (P.tile + a))) → (∀ (cells_nonempty : ∀ (a : ι), (P.tile a).cells.Nonempty), + let cell (a : ι) : GaussianInt := Classical.choose (cells_nonempty a) + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + let position (a : ι) : Real × Real := + GaussianRealPoint (cell (rep a) + (period a : GaussianInt)) + (1 / 2, 1 / 2) + (∀ (a : ι), ∃ z ∈ (P.tile a).cells, position a = GaussianRealPoint z + ((1 / 2 : Real), + (1 / 2 : Real))) → (∀ (a : ι), position a ∈ interior (TileRealization (P.tile a)))) ) + := by + classical + intro ι P center_interior cells_nonempty cell rep rep_spec period position position_cell a + exact ContactPortGeometry.position_interior ι P center_interior cells_nonempty rep_spec + position_cell a + +private theorem representative_eq : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : + ι), P.shift (-u) (P.shift u a) = a), + let S : Setoid (ι × ι) := { + r := fun p q => ∃ u : P.lattice, + ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} + iseqv := { + refl := by + intro p + exact ⟨0, by simp only [P.shift_zero]⟩ + symm := by + intro p q h + obtain ⟨u, hu⟩ := h + refine ⟨-u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm + trans := by + intro p q r hpq hqr + obtain ⟨u, hu⟩ := hpq + obtain ⟨v, hv⟩ := hqr + refine ⟨v + u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift v '' s) hu + simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh + exact hh.trans hv + } + } + let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out + ∀ (p : ι × ι), ∀ (q : ι × ι), (S.r p q) → (representative p = representative q) ) := by + classical + intro ι P shift_cancel S representative p q h + exact ContactPortGeometry.representative_eq ι P + shift_cancel p q h + +private theorem transport_spec : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : + ι), P.shift (-u) (P.shift u a) = a), + let S : Setoid (ι × ι) := { + r := fun p q => ∃ u : P.lattice, + ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} + iseqv := { + refl := by + intro p + exact ⟨0, by simp only [P.shift_zero]⟩ + symm := by + intro p q h + obtain ⟨u, hu⟩ := h + refine ⟨-u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm + trans := by + intro p q r hpq hqr + obtain ⟨u, hu⟩ := hpq + obtain ⟨v, hv⟩ := hqr + refine ⟨v + u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift v '' s) hu + simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh + exact hh.trans hv + } + } + let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out + ∀ (representative_spec : ∀ (p : ι × ι), S.r (representative p) p), + let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) + ∀ (p : ι × ι), ({P.shift (transport p) (representative p).1, + P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2} ) := by + classical + intro ι P shift_cancel S representative representative_spec transport p + exact ContactPortGeometry.transport_spec ι P shift_cancel + representative_spec p + +private theorem transport_unique : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (u : P.lattice), ∀ (a : ι), P.shift (-u) + (P.shift u a) = a) → (∀ (r : ι × ι), ∀ (p : ι × ι), ∀ (u : ↥P.lattice), ∀ (v : + ↥P.lattice), ({P.shift u r.1, P.shift u r.2} : Set ι) = {p.1, p.2} → ({P.shift v r.1, + P.shift v r.2} : Set ι) = {p.1, p.2} → u = v) ) := by + classical + intro ι P shift_cancel r p u v hu hv + exact ContactPortGeometry.transport_unique ι P shift_cancel r p u v hu hv + +private theorem transport_swap : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : + ι), P.shift (-u) (P.shift u a) = a), + let S : Setoid (ι × ι) := { + r := fun p q => ∃ u : P.lattice, + ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} + iseqv := { + refl := by + intro p + exact ⟨0, by simp only [P.shift_zero]⟩ + symm := by + intro p q h + obtain ⟨u, hu⟩ := h + refine ⟨-u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm + trans := by + intro p q r hpq hqr + obtain ⟨u, hu⟩ := hpq + obtain ⟨v, hv⟩ := hqr + refine ⟨v + u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift v '' s) hu + simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh + exact hh.trans hv + } + } + let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out + ∀ (representative_spec : ∀ (p : ι × ι), S.r (representative p) p), + let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) + (∀ (p : ι × ι), ({P.shift (transport p) (representative p).1, + P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2}) → ((∀ (r : ι × ι), + ∀ (p : ι × ι), ∀ (u : ↥P.lattice), ∀ (v : ↥P.lattice), ({P.shift u r.1, + P.shift u r.2} : Set ι) + = {p.1, p.2} → ({P.shift v r.1, P.shift v r.2} : Set ι) = {p.1, p.2} → u = v) → ((∀ + (a : ι), ∀ + (b : ι), representative (a, b) = representative (b, a)) → (∀ (a : ι), ∀ (b : ι), + transport (a, b) = transport (b, a)))) ) := by + classical + intro ι P shift_cancel S representative representative_spec transport transport_spec + transport_unique representative_swap a b + exact ContactPortGeometry.transport_swap ι P shift_cancel representative_spec transport_spec + transport_unique representative_swap a b + +private theorem representative_shift : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : + ι), P.shift (-u) (P.shift u a) = a), + let S : Setoid (ι × ι) := { + r := fun p q => ∃ u : P.lattice, + ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} + iseqv := { + refl := by + intro p + exact ⟨0, by simp only [P.shift_zero]⟩ + symm := by + intro p q h + obtain ⟨u, hu⟩ := h + refine ⟨-u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm + trans := by + intro p q r hpq hqr + obtain ⟨u, hu⟩ := hpq + obtain ⟨v, hv⟩ := hqr + refine ⟨v + u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift v '' s) hu + simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh + exact hh.trans hv + } + } + let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out + (∀ (p : ι × ι), ∀ (q : ι × ι), (S.r p q) → (representative p = representative q)) → (∀ (u + : P.lattice), ∀ (a : ι), ∀ (b : ι), representative (P.shift u a, P.shift u b) = + representative (a, b)) ) := by + classical + intro ι P shift_cancel S representative representative_eq u a b + exact ContactPortGeometry.representative_shift ι P shift_cancel representative_eq u a b + +private theorem transport_shift : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : + ι), P.shift (-u) (P.shift u a) = a), + let S : Setoid (ι × ι) := { + r := fun p q => ∃ u : P.lattice, + ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} + iseqv := { + refl := by + intro p + exact ⟨0, by simp only [P.shift_zero]⟩ + symm := by + intro p q h + obtain ⟨u, hu⟩ := h + refine ⟨-u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm + trans := by + intro p q r hpq hqr + obtain ⟨u, hu⟩ := hpq + obtain ⟨v, hv⟩ := hqr + refine ⟨v + u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift v '' s) hu + simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh + exact hh.trans hv + } + } + let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out + ∀ (representative_spec : ∀ (p : ι × ι), S.r (representative p) p), + let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) + (∀ (p : ι × ι), ({P.shift (transport p) (representative p).1, + P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2}) → ((∀ (r : ι × ι), + ∀ (p : ι × ι), ∀ (u : ↥P.lattice), ∀ (v : ↥P.lattice), ({P.shift u r.1, + P.shift u r.2} : Set ι) + = {p.1, p.2} → ({P.shift v r.1, P.shift v r.2} : Set ι) = {p.1, p.2} → u = v) → ((∀ (u : + P.lattice), ∀ (a : ι), ∀ (b : ι), representative (P.shift u a, P.shift u b) = + representative (a, b)) → (∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), transport (P.shift + u a, P.shift u b) = u + transport (a, b)))) ) := by + classical + intro ι P shift_cancel S representative representative_spec transport transport_spec + transport_unique representative_shift u a b + exact ContactPortGeometry.transport_shift ι P shift_cancel representative_spec + transport_spec transport_unique representative_shift u a b + +private theorem representative_contact : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : + ι), P.shift (-u) (P.shift u a) = a), (∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), + P3723T1EdgeContact P (P.shift u a) (P.shift u b) ↔ + P3723T1EdgeContact P a b) → ( + let S : Setoid (ι × ι) := { + r := fun p q => ∃ u : P.lattice, + ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} + iseqv := { + refl := by + intro p + exact ⟨0, by simp only [P.shift_zero]⟩ + symm := by + intro p q h + obtain ⟨u, hu⟩ := h + refine ⟨-u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm + trans := by + intro p q r hpq hqr + obtain ⟨u, hu⟩ := hpq + obtain ⟨v, hv⟩ := hqr + refine ⟨v + u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift v '' s) hu + simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh + exact hh.trans hv + } + } + let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out + ∀ (representative_spec : ∀ (p : ι × ι), S.r (representative p) p), + let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) + (∀ (p : ι × ι), ({P.shift (transport p) (representative p).1, + P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2}) → ((∀ (a : ι), ∀ + (b : ι), ∀ (c : ι), ∀ (d : ι), ({a, b} : Set ι) = {c, d} → (P3723T1EdgeContact + P a b ↔ + P3723T1EdgeContact P c d)) → (∀ (p : ι × ι), (P3723T1EdgeContact P p.1 p.2) → + (P3723T1EdgeContact P (representative p).1 (representative p).2))))) := by + classical + intro ι P shift_cancel contact_periodic S representative representative_spec transport + transport_spec pair_contact p hp + exact ContactPortGeometry.representative_contact ι P shift_cancel contact_periodic + representative_spec transport_spec pair_contact p hp + +private theorem edge_common : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : + ι), P.shift (-u) (P.shift u a) = a), (∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), ∀ (e : + Finset GaussianInt), (e ∈ FootprintEdges (P.tile a) ∩ + FootprintEdges (P.tile b)) → (e.image (fun z => z + (u : GaussianInt)) ∈ + FootprintEdges (P.tile (P.shift u a)) ∩ FootprintEdges (P.tile (P.shift u b)))) → ( + let S : Setoid (ι × ι) := { + r := fun p q => ∃ u : P.lattice, + ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} + iseqv := { + refl := by + intro p + exact ⟨0, by simp only [P.shift_zero]⟩ + symm := by + intro p q h + obtain ⟨u, hu⟩ := h + refine ⟨-u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm + trans := by + intro p q r hpq hqr + obtain ⟨u, hu⟩ := hpq + obtain ⟨v, hv⟩ := hqr + refine ⟨v + u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift v '' s) hu + simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh + exact hh.trans hv + } + } + let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out + ∀ (representative_spec : ∀ (p : ι × ι), S.r (representative p) p), + let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) + (∀ (p : ι × ι), ({P.shift (transport p) (representative p).1, + P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2}) → ((∀ (p : ι × ι), + (P3723T1EdgeContact P p.1 p.2) → (P3723T1EdgeContact P (representative p).1 + (representative p).2)) → ( + let baseEdge (p : ι × ι) : Finset GaussianInt := + if hp : P3723T1EdgeContact P p.1 p.2 then Classical.choose hp.2 else ∅ + (∀ (p : ι × ι), (P3723T1EdgeContact P p.1 p.2) → (baseEdge p ∈ FootprintEdges (P.tile + p.1) ∩ FootprintEdges (P.tile p.2))) → ( + let edge (a b : ι) : Finset GaussianInt := + if P3723T1EdgeContact P a b then + (baseEdge (representative (a, b))).image + (fun z => z + (transport (a, b) : GaussianInt)) + else ∅ + ∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P a b → + edge a b ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)))))) := by + classical + intro ι P shift_cancel common_edge_transport S representative representative_spec transport + transport_spec representative_contact baseEdge baseEdge_common edge a b hab + exact ContactPortGeometry.edge_common ι P shift_cancel common_edge_transport + representative_spec transport_spec representative_contact baseEdge_common a b hab + +private theorem midpoint_periodic : + (by + classical + exact + let midpoint (e : Finset GaussianInt) : Real × Real := + ((∑ z ∈ e, (z.re : Real)) / 2, (∑ z ∈ e, (z.im : Real)) / 2) + ∀ (e : Finset GaussianInt), ∀ (u : GaussianInt), (e.card = 2) → (midpoint (e.image (fun z + => z + u)) = midpoint e + GaussianRealPoint u) ) := by + classical + intro midpoint e u he + exact ContactPortGeometry.midpoint_periodic e u he + +end ContactPortClosure + +namespace ContactPortConstruction + +private theorem finiteOrbitRepresentatives : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (a : ι), Set.Finite {b | + P3723T1EdgeContact P a b}) → ( + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + (∀ (a : ι), a = P.shift (period a) (rep a)) → ((∀ (u : P.lattice), ∀ (a : ι), P.shift + (-u) (P.shift u a) = a) → ((∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), + (P3723T1EdgeContact P a b) → (P3723T1EdgeContact P (P.shift u a) (P.shift u b))) + → (∃ reps : Finset (ι × ι), (∀ e ∈ reps, P3723T1EdgeContact P e.1 e.2) ∧ (∀ a, ∀ b, + P3723T1EdgeContact P a b → ∃ e ∈ reps, ∃ u : P.lattice, a = P.shift u e.1 ∧ b = + P.shift u e.2))))) ) := by + classical + intro ι P finite_degree rep rep_spec period period_spec shift_cancel contact_forward + -- Normalize the first index into the given finite vertex transversal. + let reps : Finset (ι × ι) := P.vertexOrbitReps.biUnion fun r => + ((finite_degree r).toFinset).image (fun b => (r, b)) + refine ⟨reps, ?_, ?_⟩ + · intro e he + obtain ⟨r, hr, he⟩ := Finset.mem_biUnion.mp he + obtain ⟨b, hb, rfl⟩ := Finset.mem_image.mp he + exact (finite_degree r).mem_toFinset.mp hb + · intro a b hab + let c := P.shift (-period a) b + have hac := ContactPortGeometry.hac ι P rep_spec period_spec shift_cancel contact_forward a + b hab + refine ⟨(rep a, c), Finset.mem_biUnion.mpr ⟨rep a, (rep_spec a).1, + Finset.mem_image.mpr ⟨c, (finite_degree (rep a)).mem_toFinset.mpr hac, rfl⟩⟩, + period a, period_spec a, ?_⟩ + dsimp [c] + rw [← P.shift_add, add_neg_cancel, P.shift_zero] + +private theorem portConstruction : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (a : ι), ∀ (b : ι), (a ≠ b) → (Disjoint + (interior (TileRealization (P.tile a))) (TileRealization (P.tile b)))) → ( + let midpoint (e : Finset GaussianInt) : Real × Real := + ((∑ z ∈ e, (z.re : Real)) / 2, (∑ z ∈ e, (z.im : Real)) / 2) + (∀ (a : ι), ∀ (b : ι), (a ≠ b) → (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges (P.tile + a) ∩ FootprintEdges (P.tile b)) → (midpoint e ∈ TileRealization (P.tile a) ∩ + TileRealization (P.tile b) ∧ ∀ c, midpoint e ∈ TileRealization (P.tile c) → c = a ∨ c + = b))) → ((∀ (a : ι), ∀ (b : ι), (a ≠ b) → (∀ (e : Finset GaussianInt), (e ∈ + FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) → (midpoint e ∈ frontier + (TileRealization (P.tile a)) ∩ frontier (TileRealization (P.tile b))))) → ((∀ (a : + ι), Set.Finite {b | P3723T1EdgeContact P a b}) → (∀ (cells_nonempty : ∀ (a : ι), + (P.tile a).cells.Nonempty), + let cell (a : ι) : GaussianInt := Classical.choose (cells_nonempty a) + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + let position (a : ι) : Real × Real := + GaussianRealPoint (cell (rep a) + (period a : GaussianInt)) + (1 / 2, 1 / 2) + (∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P a b ↔ P3723T1EdgeContact P b a) → ((∀ (u + : P.lattice), ∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P (P.shift u a) (P.shift u + b) ↔ P3723T1EdgeContact P a b) → ((∀ (a : ι), ∃ z ∈ (P.tile a).cells, position a = + GaussianRealPoint z + ((1 / 2 : Real), (1 / 2 : Real))) → ((∀ (a : ι), position a ∈ + interior (TileRealization (P.tile a))) → ((∀ (u : P.lattice), ∀ (a : ι), position + (P.shift u a) = position a + GaussianRealPoint u) → (∀ (edge : ι → ι → Finset + GaussianInt), (∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P a b → edge a b ∈ + FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) → ((∀ (a : ι), ∀ (b : ι), + P3723T1EdgeContact P a b → (edge a b).card = (2 : ℕ)) → ((∀ (a : ι), ∀ (b : ι), + edge a b = edge b a) → ((∀ (a : ι), ∀ (b : ι), ¬P3723T1EdgeContact P a b → edge a b + = ∅) → ((∀ (u : ↥P.lattice), ∀ (a : ι), ∀ (b : ι), edge (P.shift u a) (P.shift u b) = + Finset.image (fun (z : GaussianInt) => z + (↑u : GaussianInt)) (edge a b)) → ( + let port (a b : ι) : Option (Real × Real) := + if P3723T1EdgeContact P a b then some (midpoint (edge a b)) else none + (∀ (a : ι), ∀ (b : ι), ∀ (p : Real × Real), (port a b = some p) → (P3723T1EdgeContact P + a b ∧ midpoint (edge a b) = p)) → ((∀ (e : Finset GaussianInt), ∀ (u : GaussianInt), + (e.card = 2) → (midpoint (e.image (fun z => z + u)) = midpoint e + GaussianRealPoint + u)) → (∀ (reps : Finset (ι × ι)), (∀ e ∈ reps, P3723T1EdgeContact P e.1 e.2) → ((∀ + (a : ι), ∀ (b : ι), P3723T1EdgeContact P a b → ∃ e ∈ reps, ∃ (u : ↥P.lattice), a = + P.shift u e.1 ∧ b = P.shift u e.2) → (Nonempty (P3723T1ContactPorts + P))))))))))))))))))) ) := by + classical + intro ι P interior_disjoint midpoint common_midpoint common_frontier finite_degree + cells_nonempty cell rep rep_spec period position contact_symmetric contact_periodic + position_cell position_interior position_periodic edge edge_common edge_two edge_sym + edge_absent edge_periodic port port_present midpoint_periodic reps reps_genuine reps_cover + refine ⟨{ + position := position + portEdge := edge + port := port + portEdge_symmetric := edge_sym + port_symmetric := ?_ + portEdge_common := edge_common + portEdge_two := edge_two + port_midpoint := ?_ + port_eq_none_iff := ?_ + noncontact_has_no_portEdge := edge_absent + position_cell := position_cell + position_in_tile_interior := position_interior + position_injective := ?_ + interior_disjoint_tiles := interior_disjoint + port_frontier := ?_ + port_no_third := ?_ + port_owner_pair := ?_ + incident_ports_distinct := ?_ + finite_degree := finite_degree + contactOrbitReps := reps + contactOrbitReps_genuine := reps_genuine + contact_orbit_representatives := reps_cover + unordered_stabilizer := fun u a b h => + P3723T1ContactStabilizer P.toPeriodicTileCore u a b h + contact_periodic := contact_periodic + position_periodic := position_periodic + portEdge_periodic := edge_periodic + port_periodic := ?_ + }⟩ + · intro a b + simp only [port, contact_symmetric a b, edge_sym a b] + · intro a b hab + simp only [port, ite_eq_left hab, midpoint] + · intro a b + simp only [port, ite_eq_right_iff, reduceCtorEq, imp_false] + · intro a b heq + by_contra hab + exact Set.disjoint_left.mp (interior_disjoint a b hab) (position_interior a) + (heq.symm ▸ interior_subset (position_interior b)) + · intro a b p hp + obtain ⟨hab, rfl⟩ := port_present a b p hp + exact common_frontier a b hab.1 (edge a b) (edge_common a b hab) + · intro a b p hp c hca hcb hc + obtain ⟨hab, hmid⟩ := port_present a b p hp + rw [← hmid] at hc + exact ((common_midpoint a b hab.1 (edge a b) (edge_common a b hab)).2 c hc).elim hca hcb + · intro a b c d p hab hcd + obtain ⟨h1, hm1⟩ := port_present a b p hab + obtain ⟨h2, hm2⟩ := port_present c d p hcd + have hp := (common_midpoint c d h2.1 (edge c d) (edge_common c d h2)).1 + rw [hm2, ← hm1] at hp + have hc := (common_midpoint a b h1.1 (edge a b) (edge_common a b h1)).2 c hp.1 + have hd := (common_midpoint a b h1.1 (edge a b) (edge_common a b h1)).2 d hp.2 + rcases hc with rfl | rfl <;> rcases hd with rfl | rfl + · exact (h2.1 rfl).elim + · rfl + · exact Set.pair_comm _ _ + · exact (h2.1 rfl).elim + · intro a b c p q hab hac hbc hpq + obtain ⟨h1, hm1⟩ := port_present a b p hab + obtain ⟨h2, hm2⟩ := port_present a c q hac + have hc := (common_midpoint a c h2.1 (edge a c) (edge_common a c h2)).1.2 + rw [hm2, ← hpq, ← hm1] at hc + have he := (common_midpoint a b h1.1 (edge a b) (edge_common a b h1)).2 c hc + exact he.elim (fun h => h2.1 h.symm) (fun h => hbc h.symm) + · intro u a b + by_cases hab : P3723T1EdgeContact P a b + · simp only [port, ite_eq_left hab, ite_eq_left ((contact_periodic u a b).mpr hab), + edge_periodic, midpoint_periodic _ _ (edge_two a b hab), Option.map_some] + · have hn : ¬ P3723T1EdgeContact P (P.shift u a) (P.shift u b) := + fun h => hab ((contact_periodic u a b).mp h) + simp only [port, ite_eq_right hab, ite_eq_right hn, Option.map_none] + +end ContactPortConstruction + +theorem P3723T1ContactPortsExist {ι : Type} (P : PeriodicTileComplex ι) : + Nonempty (P3723T1ContactPorts P) := by +-- BODY + classical + -- Unique cell ownership controls the square and midpoint geometry. + have owner_unique := ContactPortClosure.owner_unique ι P + let openSquare (z : GaussianInt) : Set (Real × Real) := + Set.Ioo (z.re : Real) ((z.re : Real) + 1) ×ˢ + Set.Ioo (z.im : Real) ((z.im : Real) + 1) + have openSquare_open (z : GaussianInt) : IsOpen (openSquare z) := + isOpen_Ioo.prod isOpen_Ioo + have openSquare_closure := ContactPortGeometry.openSquare_closure + have coord_unique := ContactPortClosure.coord_unique + have square_unique := ContactPortClosure.square_unique coord_unique + have realization_closed (T : ProtoTile) : IsClosed (TileRealization T) := + isClosed_biUnion_finset (fun _ _ => isClosed_Icc) + have interior_disjoint := ContactPortGeometry.interior_disjoint ι P owner_unique + openSquare_closure square_unique + have center_interior := ContactPortGeometry.center_interior ι P openSquare_open openSquare_closure + let midpoint (e : Finset GaussianInt) : Real × Real := + ((∑ z ∈ e, (z.re : Real)) / 2, (∑ z ∈ e, (z.im : Real)) / 2) + have horizontal_midpoint := ContactPortGeometry.horizontal_midpoint + have vertical_midpoint := ContactPortGeometry.vertical_midpoint + have edge_normal := ContactPortGeometry.edge_normal + have midpoint_cell := ContactPortClosure.midpoint_cell horizontal_midpoint vertical_midpoint + have midpoint_two_cells := ContactPortClosure.midpoint_two_cells coord_unique + horizontal_midpoint vertical_midpoint edge_normal + have common_midpoint := ContactPortClosure.common_midpoint ι P owner_unique midpoint_cell + midpoint_two_cells + have common_frontier := ContactPortClosure.common_frontier ι P realization_closed + interior_disjoint common_midpoint + have footprint_finite := ContactPortGeometry.footprint_finite + have finite_degree := ContactPortGeometry.finite_degree ι P midpoint_cell common_midpoint + footprint_finite + have cells_nonempty (a : ι) : (P.tile a).cells.Nonempty := + (LatticeTileGridStructure (P.tile a) (P.tiles_are_disks a)).1.1 + let cell (a : ι) : GaussianInt := Classical.choose (cells_nonempty a) + have cell_mem (a : ι) : cell a ∈ (P.tile a).cells := + Classical.choose_spec (cells_nonempty a) + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + have rep_spec (a : ι) : rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a) := ContactPortGeometry.rep_spec ι P a + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + have period_spec (a : ι) : a = P.shift (period a) (rep a) := + Classical.choose_spec (rep_spec a).2 + let position (a : ι) : Real × Real := + GaussianRealPoint (cell (rep a) + (period a : GaussianInt)) + (1 / 2, 1 / 2) + have contact_symmetric (a b : ι) : + P3723T1EdgeContact P a b ↔ P3723T1EdgeContact P b a := + ContactPortClosure.contact_symmetric ι P a b + have shift_cancel (u : P.lattice) (a : ι) : P.shift (-u) (P.shift u a) = a := by + rw [← P.shift_add, neg_add_cancel, P.shift_zero] + have shift_injective := ContactPortGeometry.shift_injective ι P shift_cancel + have edges_periodic := ContactPortGeometry.edges_periodic ι P + have common_edge_transport (u : P.lattice) (a b : ι) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) : + e.image (fun z => z + (u : GaussianInt)) ∈ + FootprintEdges (P.tile (P.shift u a)) ∩ FootprintEdges (P.tile (P.shift u b)) := + ContactPortClosure.common_edge_transport ι P edges_periodic u a b e he + have contact_forward := ContactPortClosure.contact_forward ι P shift_injective + common_edge_transport + have contact_periodic (u : P.lattice) (a b : ι) : + P3723T1EdgeContact P (P.shift u a) (P.shift u b) ↔ + P3723T1EdgeContact P a b := ContactPortClosure.contact_periodic ι P shift_cancel + contact_forward u a b + have period_unique := ContactPortGeometry.period_unique ι P shift_cancel + have rep_shift := ContactPortGeometry.rep_shift ι P rep_spec period_spec + have period_shift := ContactPortGeometry.period_shift ι P rep_spec period_spec period_unique + rep_shift + have real_add := ContactPortGeometry.real_add + have position_cell (a : ι) : ∃ z ∈ (P.tile a).cells, + position a = GaussianRealPoint z + ((1 / 2 : Real), (1 / 2 : Real)) := + ContactPortClosure.position_cell ι P cells_nonempty cell_mem rep_spec period_spec a + have position_interior (a : ι) : position a ∈ interior (TileRealization (P.tile a)) := + ContactPortClosure.position_interior ι P center_interior cells_nonempty rep_spec + position_cell a + have position_periodic := ContactPortGeometry.position_periodic ι P cells_nonempty rep_spec + rep_shift period_shift real_add + obtain ⟨edge, edge_common, edge_two, edge_sym, edge_absent, edge_periodic⟩ : + ∃ edge : ι → ι → Finset GaussianInt, + (∀ a b, P3723T1EdgeContact P a b → + edge a b ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) ∧ + (∀ a b, P3723T1EdgeContact P a b → (edge a b).card = 2) ∧ + (∀ a b, edge a b = edge b a) ∧ + (∀ a b, ¬ P3723T1EdgeContact P a b → edge a b = ∅) ∧ + (∀ u : P.lattice, ∀ a b, + edge (P.shift u a) (P.shift u b) = + (edge a b).image (fun z => z + (u : GaussianInt))) := by + -- Identify both orientations and all simultaneous translates before choosing an edge. + let S : Setoid (ι × ι) := { + r := fun p q => ∃ u : P.lattice, + ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} + iseqv := { + refl := by + intro p + exact ⟨0, by simp only [P.shift_zero]⟩ + symm := by + intro p q h + obtain ⟨u, hu⟩ := h + refine ⟨-u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu + simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm + trans := by + intro p q r hpq hqr + obtain ⟨u, hu⟩ := hpq + obtain ⟨v, hv⟩ := hqr + refine ⟨v + u, ?_⟩ + have hh := congrArg (fun s : Set ι => P.shift v '' s) hu + simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh + exact hh.trans hv + } + } + let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out + have representative_spec (p : ι × ι) : S.r (representative p) p := + @Quotient.mk_out _ S p + have representative_eq (p q : ι × ι) (h : S.r p q) : + representative p = representative q := ContactPortClosure.representative_eq ι P + shift_cancel p q h + let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) + have transport_spec (p : ι × ι) : + ({P.shift (transport p) (representative p).1, + P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2} := + ContactPortClosure.transport_spec ι P shift_cancel representative_spec p + have transport_unique := ContactPortClosure.transport_unique ι P shift_cancel + have representative_swap (a b : ι) : representative (a, b) = representative (b, a) := + representative_eq _ _ ⟨0, by simp only [P.shift_zero]; exact Set.pair_comm _ _⟩ + have transport_swap (a b : ι) : transport (a, b) = transport (b, a) := + ContactPortClosure.transport_swap ι P shift_cancel representative_spec transport_spec + transport_unique representative_swap a b + have representative_shift (u : P.lattice) (a b : ι) : + representative (P.shift u a, P.shift u b) = representative (a, b) := + ContactPortClosure.representative_shift ι P shift_cancel representative_eq u a b + have transport_shift (u : P.lattice) (a b : ι) : + transport (P.shift u a, P.shift u b) = u + transport (a, b) := + ContactPortClosure.transport_shift ι P shift_cancel representative_spec + transport_spec transport_unique representative_shift u a b + have pair_contact := ContactPortGeometry.pair_contact ι P contact_symmetric + have representative_contact (p : ι × ι) (hp : P3723T1EdgeContact P p.1 p.2) : + P3723T1EdgeContact P (representative p).1 (representative p).2 := + ContactPortClosure.representative_contact ι P shift_cancel contact_periodic + representative_spec transport_spec pair_contact p hp + let baseEdge (p : ι × ι) : Finset GaussianInt := + if hp : P3723T1EdgeContact P p.1 p.2 then Classical.choose hp.2 else ∅ + have baseEdge_common (p : ι × ι) (hp : P3723T1EdgeContact P p.1 p.2) : + baseEdge p ∈ FootprintEdges (P.tile p.1) ∩ FootprintEdges (P.tile p.2) := + ContactPortGeometry.baseEdge_common ι P p hp + let edge (a b : ι) : Finset GaussianInt := + if P3723T1EdgeContact P a b then + (baseEdge (representative (a, b))).image + (fun z => z + (transport (a, b) : GaussianInt)) + else ∅ + have edge_common := ContactPortClosure.edge_common ι P shift_cancel common_edge_transport + representative_spec transport_spec representative_contact baseEdge_common + have footprint_card := ContactPortGeometry.footprint_card + refine ⟨edge, edge_common, ?_, ?_, ?_, ?_⟩ + · intro a b hab + exact footprint_card (P.tile a) (edge a b) (edge_common a b hab).1 + · intro a b + by_cases hab : P3723T1EdgeContact P a b + · have hba := (contact_symmetric a b).mp hab + simp only [edge, ite_eq_left hab, ite_eq_left hba, representative_swap a b, + transport_swap a b] + · have hba : ¬ P3723T1EdgeContact P b a := fun h => hab ((contact_symmetric a b).mpr h) + simp only [edge, ite_eq_right hab, ite_eq_right hba] + · intro a b hab + simp only [edge, ite_eq_right hab] + · intro u a b + by_cases hab : P3723T1EdgeContact P a b + · simp only [edge, ite_eq_left hab, ite_eq_left ((contact_periodic u a b).mpr hab), + representative_shift, transport_shift, Finset.image_image, AddSubgroup.coe_add] + congr 1 + funext z + dsimp only [Function.comp_def] + abel + · have hn : ¬ P3723T1EdgeContact P (P.shift u a) (P.shift u b) := + fun h => hab ((contact_periodic u a b).mp h) + simp only [edge, ite_eq_right hab, ite_eq_right hn, Finset.image_empty] + let port (a b : ι) : Option (Real × Real) := + if P3723T1EdgeContact P a b then some (midpoint (edge a b)) else none + have port_present := ContactPortGeometry.port_present ι P edge + have midpoint_periodic (e : Finset GaussianInt) (u : GaussianInt) (he : e.card = 2) : + midpoint (e.image (fun z => z + u)) = midpoint e + GaussianRealPoint u := + ContactPortClosure.midpoint_periodic e u he + have finiteOrbitRepresentatives : ∃ reps : Finset (ι × ι), + (∀ e ∈ reps, P3723T1EdgeContact P e.1 e.2) ∧ + (∀ a b, P3723T1EdgeContact P a b → + ∃ e ∈ reps, ∃ u : P.lattice, a = P.shift u e.1 ∧ b = P.shift u e.2) := + ContactPortConstruction.finiteOrbitRepresentatives ι P finite_degree rep_spec + period_spec shift_cancel contact_forward + obtain ⟨reps, reps_genuine, reps_cover⟩ := finiteOrbitRepresentatives + have portConstruction : + Nonempty (P3723T1ContactPorts P) := ContactPortConstruction.portConstruction ι P + interior_disjoint common_midpoint common_frontier finite_degree cells_nonempty rep_spec + contact_symmetric contact_periodic position_cell position_interior position_periodic edge + edge_common edge_two edge_sym edge_absent edge_periodic port_present midpoint_periodic + reps reps_genuine reps_cover + exact portConstruction + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1ContactStabilizer.lean b/LeanPool/ApollonianSuperharmonic/P3723T1ContactStabilizer.lean new file mode 100644 index 0000000000..77dcd16d27 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3723T1ContactStabilizer.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P3723T1ContactStabilizer] + +/-! +# P3723T1ContactStabilizer + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3723T1ContactStabilizer {ι : Type} (P : PeriodicTileCore ι) + (u : P.lattice) (a b : ι) + (h : ({P.shift u a, P.shift u b} : Set ι) = {a, b}) : u = 0 := by +-- BODY + have pairzero (p q w : Real × Real) + (h : ({p + w, q + w} : Set (Real × Real)) = {p, q}) : w = 0 := by + have hp : p + w = p ∨ p + w = q := by + have hm : p + w ∈ ({p, q} : Set (Real × Real)) := by + rw [← h] + simp + simpa using hm + have hq : q + w = p ∨ q + w = q := by + have hm : q + w ∈ ({p, q} : Set (Real × Real)) := by + rw [← h] + simp + simpa using hm + rcases hp with hp | hp + · have h1 := congrArg Prod.fst hp + have h2 := congrArg Prod.snd hp + change p.1 + w.1 = p.1 at h1 + change p.2 + w.2 = p.2 at h2 + apply Prod.ext <;> change _ = (0 : Real) <;> linarith + · rcases hq with hq | hq + · have h1 := congrArg Prod.fst hp + have h2 := congrArg Prod.snd hp + have h3 := congrArg Prod.fst hq + have h4 := congrArg Prod.snd hq + change p.1 + w.1 = q.1 at h1 + change p.2 + w.2 = q.2 at h2 + change q.1 + w.1 = p.1 at h3 + change q.2 + w.2 = p.2 at h4 + apply Prod.ext <;> change _ = (0 : Real) <;> linarith + · have h1 := congrArg Prod.fst hq + have h2 := congrArg Prod.snd hq + change q.1 + w.1 = q.1 at h1 + change q.2 + w.2 = q.2 at h2 + apply Prod.ext <;> change _ = (0 : Real) <;> linarith + have hpos : + ({P.plane.position a + GaussianRealPoint u, + P.plane.position b + GaussianRealPoint u} : Set (Real × Real)) = + {P.plane.position a, P.plane.position b} := by + have himage := congrArg (fun s : Set ι => P.plane.position '' s) h + simpa only [Set.image_insert_eq, Set.image_singleton, + P.position_periodic] using himage + have hz := pairzero _ _ _ hpos + apply Subtype.ext + ext + · have h1 := congrArg Prod.fst hz + change (((u : GaussianInt).re : Int) : Real) = 0 at h1 + change (u : GaussianInt).re = 0 + exact_mod_cast h1 + · have h2 := congrArg Prod.snd hz + change (((u : GaussianInt).im : Int) : Real) = 0 at h2 + change (u : GaussianInt).im = 0 + exact_mod_cast h2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialIntersection.lean b/LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialIntersection.lean new file mode 100644 index 0000000000..66f643219a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialIntersection.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Convex.Topology +public import Mathlib.Analysis.Convex.PathConnected +public import Mathlib.Topology.Homeomorph.Lemmas +public import Mathlib.Tactic.FieldSimp +public import Mathlib.Tactic.Linarith + +/-! +# P3723T1ConvexRadialIntersection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open Set + +-- [TABLET NODE: P3723T1ConvexRadialIntersection] +theorem P3723T1ConvexRadialIntersection + (K : Set (Real × Real)) (hK : Convex Real K) (hclosed : IsClosed K) + (x y z : Real × Real) (hx : x ∈ interior K) + (hy : y ∈ frontier K) (hz : z ∈ frontier K) (hne : y ≠ z) : + segment Real x y ∩ segment Real x z = {x} := by +-- BODY + have unique (y z : Real × Real) (hy : y ∈ frontier K) (hz : z ∈ frontier K) + (a b : Real) (ha : 0 < a) (hb : 0 < b) + (heq : (1 - a) • x + a • y = (1 - b) • x + b • z) : y = z := by + have boundary_not_interior : ∀ q ∈ frontier K, q ∉ interior K := by + intro q hq + exact hq.2 + have no_lt : ∀ (u v : Real × Real) (s t : Real), + u ∈ frontier K → v ∈ frontier K → 0 < s → 0 < t → + (1 - s) • x + s • u = (1 - t) • x + t • v → ¬ s < t := by + intro u v s t hu hv hs ht huv hlt + have ht0 : t ≠ 0 := ne_of_gt ht + have hvblend : v = (1 - s / t) • x + (s / t) • u := by + have he1 := congrArg Prod.fst huv + have he2 := congrArg Prod.snd huv + dsimp at he1 he2 + apply Prod.ext <;> dsimp <;> field_simp <;> nlinarith + have hr0 : 0 ≤ s / t := le_of_lt (div_pos hs ht) + have hr1 : s / t < 1 := (div_lt_one ht).mpr hlt + have hvI : v ∈ interior K := by + rw [hvblend] + exact hK.combo_interior_self_mem_interior hx + (hclosed.frontier_subset hu) (sub_pos.mpr hr1) hr0 (by ring) + exact boundary_not_interior v hv hvI + have hab : a = b := le_antisymm + (le_of_not_gt (no_lt z y b a hz hy hb ha heq.symm)) + (le_of_not_gt (no_lt y z a b hy hz ha hb heq)) + subst b + have he : a • y = a • z := add_left_cancel heq + exact (smul_right_injective _ (ne_of_gt ha)) he + ext q + constructor + · rintro ⟨hqy, hqz⟩ + rw [segment_eq_image] at hqy hqz + obtain ⟨a, ha, hqa⟩ := hqy + obtain ⟨b, hb, hqb⟩ := hqz + by_cases hqx : q = x + · exact hqx + · have ha0 : a ≠ 0 := by + intro h + subst a + simp only [sub_zero, one_smul, zero_smul, add_zero] at hqa + exact hqx hqa.symm + have hb0 : b ≠ 0 := by + intro h + subst b + simp only [sub_zero, one_smul, zero_smul, add_zero] at hqb + exact hqx hqb.symm + exact False.elim (hne (unique y z hy hz a b (lt_of_le_of_ne ha.1 ha0.symm) + (lt_of_le_of_ne hb.1 hb0.symm) (hqa.trans hqb.symm))) + · intro hq + rw [Set.mem_singleton_iff] at hq + rw [hq] + exact ⟨left_mem_segment Real x y, left_mem_segment Real x z⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialParameterization.lean b/LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialParameterization.lean new file mode 100644 index 0000000000..efed3818a3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialParameterization.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Convex.Topology +public import Mathlib.Analysis.Convex.PathConnected +public import Mathlib.Topology.Homeomorph.Lemmas +public import Mathlib.Tactic.FieldSimp +public import Mathlib.Tactic.Linarith + +/-! +# P3723T1ConvexRadialParameterization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open Set + +-- [TABLET NODE: P3723T1ConvexRadialParameterization] +theorem P3723T1ConvexRadialParameterization + (K : Set (Real × Real)) (hK : Convex Real K) (hclosed : IsClosed K) + (x y : Real × Real) (hx : x ∈ interior K) (hy : y ∈ frontier K) : + ∃ h : Icc (0 : Real) 1 ≃ₜ segment Real x y, + ((h ⟨0, by norm_num⟩ : segment Real x y) : Real × Real) = x ∧ + ((h ⟨1, by norm_num⟩ : segment Real x y) : Real × Real) = y ∧ + segment Real x y ⊆ interior K ∪ {y} ∧ + ∀ t : Icc (0 : Real) 1, + ((h t : segment Real x y) : Real × Real) = + (1 - (t : Real)) • x + (t : Real) • y := by +-- BODY + have hxy : x ≠ y := by + intro he + exact hy.2 (he ▸ hx) + let f : Icc (0 : Real) 1 → segment Real x y := fun t => + ⟨(1 - (t : Real)) • x + (t : Real) • y, + by rw [segment_eq_image]; exact ⟨t, t.property, rfl⟩⟩ + have hfc : Continuous f := by + apply Continuous.subtype_mk + exact ((continuous_const.sub continuous_subtype_val).smul continuous_const).add + (continuous_subtype_val.smul continuous_const) + have hfi : Function.Injective f := by + intro s t hst + apply Subtype.ext + apply AffineMap.lineMap_injective Real hxy + simpa only [AffineMap.lineMap_apply_module] using congrArg Subtype.val hst + have hfs : Function.Surjective f := by + intro q + have hq := q.property + simp only [segment_eq_image] at hq + obtain ⟨t, ht, heq⟩ := hq + exact ⟨⟨t, ht⟩, Subtype.ext heq⟩ + let h : Icc (0 : Real) 1 ≃ₜ segment Real x y := + (isHomeomorph_iff_continuous_bijective.mpr ⟨hfc, hfi, hfs⟩).homeomorph + refine ⟨h, by simp [h, f], by simp [h, f], ?_, ?_⟩ + · intro q hq + rw [segment_eq_image] at hq + obtain ⟨t, ht, rfl⟩ := hq + by_cases ht1 : t = 1 + · simp [ht1] + · exact Or.inl (hK.combo_interior_self_mem_interior hx + (hclosed.frontier_subset hy) (sub_pos.mpr (lt_of_le_of_ne ht.2 ht1)) ht.1 + (by ring)) + · intro t + rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1EdgeContact.lean b/LeanPool/ApollonianSuperharmonic/P3723T1EdgeContact.lean new file mode 100644 index 0000000000..df61ca553e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3723T1EdgeContact.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex + +-- [TABLET NODE: P3723T1EdgeContact] + +/-! +# P3723T1EdgeContact + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a `PeriodicTileComplex` $P$, two indices have genuine +edge contact if they are distinct and the intersection of their +`FootprintEdges` is nonempty. This relation does not require +prescribed adjacency and does not include corner-only contacts. +-/ +def P3723T1EdgeContact {ι : Type} (P : PeriodicTileComplex ι) + (a b : ι) : Prop := +-- BODY + a ≠ b ∧ (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1GridDiskBoundaryStars.lean b/LeanPool/ApollonianSuperharmonic/P3723T1GridDiskBoundaryStars.lean new file mode 100644 index 0000000000..c057c346a0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3723T1GridDiskBoundaryStars.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3723T1GridDiskPairedModel +public import LeanPool.ApollonianSuperharmonic.P3723T1ConvexRadialIntersection +public import LeanPool.ApollonianSuperharmonic.P3723T1ConvexRadialParameterization +public import LeanPool.ApollonianSuperharmonic.P3723T1PairedModelSegmentPullback + +/-! +# P3723T1GridDiskBoundaryStars + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open Set + +-- [TABLET NODE: P3723T1GridDiskBoundaryStars] +theorem P3723T1GridDiskBoundaryStars {ι : Type} + (T : ProtoTile) (hT : LatticeTile T) + (x : Real × Real) (hx : x ∈ interior (TileRealization T)) + (port : ι → Real × Real) + (hport : ∀ i, port i ∈ frontier (TileRealization T)) + (hinj : Function.Injective port) : + ∃ g : ι → Icc (0 : Real) 1 → Real × Real, + (∀ i, Continuous (g i) ∧ Function.Injective (g i) ∧ + g i ⟨0, by norm_num⟩ = x ∧ + g i ⟨1, by norm_num⟩ = port i ∧ + Nonempty (P3723T1PolygonalParameterization (g i))) ∧ + (∀ i, Set.range (g i) ⊆ interior (TileRealization T) ∪ {port i}) ∧ + ∀ i j, i ≠ j → Set.range (g i) ∩ Set.range (g j) = {x} := by +-- BODY + classical + obtain ⟨n, p, v, K, t, h, _hvertex, _hedges, _hfrontier, hboundary, + _hinterior, haffine⟩ := P3723T1GridDiskPairedModel T hT + let X := TileRealization T + have hX : IsClosed X := + (P3381T1TriangulationBoundary p X K t).1.isClosed + have hK : IsClosed K := t.target_closed + have hconv : Convex Real K := t.target_convex + let xX : X := ⟨x, interior_subset hx⟩ + let pX : ι → X := fun i => ⟨port i, hX.frontier_subset (hport i)⟩ + have hint : ∀ q : X, + (q : Real × Real) ∈ interior X ↔ (h q : Real × Real) ∈ interior K := by + intro q + rw [mem_interior_iff_notMem_frontier q.property, + mem_interior_iff_notMem_frontier (h q).property] + exact not_congr (hboundary q) + have hxK : (h xX : Real × Real) ∈ interior K := (hint xX).mp hx + have hpK : ∀ i, (h (pX i) : Real × Real) ∈ frontier K := + fun i => (hboundary (pX i)).mp (hport i) + have hpKinj : Function.Injective (fun i => (h (pX i) : Real × Real)) := by + intro i j hij + apply hinj + exact congrArg Subtype.val (h.injective (Subtype.ext hij)) + obtain ⟨r, hr0, hr1, hrsub, hrline⟩ : + ∃ r : ∀ i, Icc (0 : Real) 1 ≃ₜ + segment Real (h xX : Real × Real) (h (pX i) : Real × Real), + (∀ i, ((r i ⟨0, by norm_num⟩ : + segment Real (h xX : Real × Real) (h (pX i) : Real × Real)) : + Real × Real) = (h xX : Real × Real)) ∧ + (∀ i, ((r i ⟨1, by norm_num⟩ : + segment Real (h xX : Real × Real) (h (pX i) : Real × Real)) : + Real × Real) = (h (pX i) : Real × Real)) ∧ + (∀ i, segment Real (h xX : Real × Real) (h (pX i) : Real × Real) ⊆ + interior K ∪ {(h (pX i) : Real × Real)}) ∧ + (∀ i s, ((r i s : segment Real (h xX : Real × Real) + (h (pX i) : Real × Real)) : Real × Real) = + (1 - (s : Real)) • (h xX : Real × Real) + + (s : Real) • (h (pX i) : Real × Real)) := by + choose r hr0 hr1 hrsub hrline using fun i => + P3723T1ConvexRadialParameterization K hconv hK (h xX) (h (pX i)) hxK (hpK i) + exact ⟨r, hr0, hr1, hrsub, hrline⟩ + let R : ι → Icc (0 : Real) 1 → K := fun i t => + ⟨r i t, hconv.segment_subset (h xX).property (h (pX i)).property + (r i t).property⟩ + let g : ι → Icc (0 : Real) 1 → Real × Real := fun i t => h.symm (R i t) + have hgcont : ∀ i, Continuous (g i) := by + intro i + have hRcont : Continuous (R i) := + Continuous.subtype_mk (continuous_subtype_val.comp (r i).continuous) _ + exact continuous_subtype_val.comp (h.symm.continuous.comp hRcont) + have hginj : ∀ i, Function.Injective (g i) := by + intro i s t hst + apply (r i).injective + apply Subtype.ext + have hRt : R i s = R i t := h.symm.injective (Subtype.ext hst) + exact congrArg (fun a : K => (a : Real × Real)) hRt + have hg0 : ∀ i, g i ⟨0, by norm_num⟩ = x := by + intro i + have hR0 : R i ⟨0, by norm_num⟩ = h xX := Subtype.ext (hr0 i) + change (h.symm (R i ⟨0, by norm_num⟩) : Real × Real) = x + rw [hR0, h.symm_apply_apply] + have hg1 : ∀ i, g i ⟨1, by norm_num⟩ = port i := by + intro i + have hR1 : R i ⟨1, by norm_num⟩ = h (pX i) := Subtype.ext (hr1 i) + change (h.symm (R i ⟨1, by norm_num⟩) : Real × Real) = port i + rw [hR1, h.symm_apply_apply] + have hgpoly : ∀ i, Nonempty (P3723T1PolygonalParameterization (g i)) := by + intro i + let gi : Icc (0 : Real) 1 → X := fun s => h.symm (R i s) + have hgi : ∀ s, (h (gi s) : Real × Real) = + (1 - (s : Real)) • (h xX : Real × Real) + + (s : Real) • (h (pX i) : Real × Real) := by + intro s + change (h (h.symm (R i s)) : Real × Real) = _ + rw [h.apply_symm_apply] + exact hrline i s + exact P3723T1PairedModelSegmentPullback p X K t h haffine + (h xX) (h (pX i)) gi hgi + refine ⟨g, ?_, ?_, ?_⟩ + · intro i + exact ⟨hgcont i, hginj i, hg0 i, hg1 i, hgpoly i⟩ + · intro i q hq + obtain ⟨t, rfl⟩ := hq + rcases hrsub i (r i t).property with hi | hp + · apply Or.inl + apply (hint (h.symm (R i t))).mpr + simpa only [h.apply_symm_apply] using hi + · apply Or.inr + have hRp : R i t = h (pX i) := Subtype.ext hp + change (h.symm (R i t) : Real × Real) = port i + rw [hRp, h.symm_apply_apply] + · intro i j hij + ext q + constructor + · rintro ⟨⟨t, rfl⟩, ⟨s, hs⟩⟩ + have hR : R i t = R j s := + h.symm.injective (Subtype.ext hs.symm) + have hm : (R i t : Real × Real) ∈ + segment Real (h xX : Real × Real) (h (pX i) : Real × Real) ∩ + segment Real (h xX : Real × Real) (h (pX j) : Real × Real) := by + refine ⟨(r i t).property, ?_⟩ + rw [hR] + exact (r j s).property + rw [P3723T1ConvexRadialIntersection K hconv hK + (h xX) (h (pX i)) (h (pX j)) hxK (hpK i) (hpK j) + (hpKinj.ne hij)] at hm + have hRx : R i t = h xX := Subtype.ext hm + change (h.symm (R i t) : Real × Real) = x + rw [hRx, h.symm_apply_apply] + · intro hq + rw [Set.mem_singleton_iff] at hq + rw [hq] + exact ⟨⟨⟨0, by norm_num⟩, hg0 i⟩, ⟨⟨0, by norm_num⟩, hg0 j⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1GridDiskPairedModel.lean b/LeanPool/ApollonianSuperharmonic/P3723T1GridDiskPairedModel.lean new file mode 100644 index 0000000000..c5bdc788f8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3723T1GridDiskPairedModel.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.LatticeTileComplementGridConnected +public import LeanPool.ApollonianSuperharmonic.P3475T1GridBoundary +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundaryReduction +public import LeanPool.ApollonianSuperharmonic.P3475T1PolygonTriangleConstruction +public import LeanPool.ApollonianSuperharmonic.P3475T1PolygonalSeparation +public import LeanPool.ApollonianSuperharmonic.P3475T1SquareUnionIdentification +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundaryRestoration +public import LeanPool.ApollonianSuperharmonic.P3381T1PiecewiseAffinePolygonModel + +-- [TABLET NODE: P3723T1GridDiskPairedModel] + +/-! +# P3723T1GridDiskPairedModel + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3723T1GridDiskPairedModel (T : ProtoTile) (hT : LatticeTile T) : + ∃ (n : Nat) (p : P3381T1PolygonBoundary n) + (v : Fin (n + 3) → GaussianInt) (K : Set (Real × Real)) + (t : P3381T1PairedTriangulation p (TileRealization T) K) + (h : TileRealization T ≃ₜ K), + (∀ i, p.vertex i = GaussianRealPoint (v i)) ∧ + BoundaryFootprintEdges T = {e | ∃ i, e = {v i, v (i + 1)}} ∧ + frontier (TileRealization T) = + ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) ∧ + (∀ x : TileRealization T, + (x : Real × Real) ∈ frontier (TileRealization T) ↔ + (h x : Real × Real) ∈ frontier K) ∧ + (∀ x : TileRealization T, + (x : Real × Real) ∈ interior (TileRealization T) ↔ + (h x : Real × Real) ∈ interior K) ∧ + ∀ k (x : TileRealization T), + (x : Real × Real) ∈ convexHull Real (Set.range (p.vertex ∘ t.face k)) → + ∀ w : Fin 3 → Real, (∑ i, w i) = 1 → + (x : Real × Real) = ∑ i, w i • p.vertex (t.face k i) → + (h x : Real × Real) = ∑ i, w i • t.target (t.face k i) := by +-- BODY + obtain ⟨hinside, hchecker, _hcycle⟩ := LatticeTileGridStructure T hT + have houtside := LatticeTileComplementGridConnected T hT + obtain ⟨n, p, v, hvertex, _hadj, _hvertices, hedges⟩ := + P3475T1GridBoundary T hinside houtside hchecker + obtain ⟨r, q, ⟨s⟩, hcorner⟩ := P3475T1BoundaryReduction p + obtain ⟨X, K, ⟨tree⟩⟩ := P3475T1PolygonTriangleConstruction q hcorner + obtain ⟨U, V, hUopen, hUconn, hUb, hVopen, hVconn, hVub, + hdisj, hcover, hfrontU, hfrontV, hX⟩ := + P3475T1PolygonalSeparation q X K tree + have hcoverP : U ∪ V = + (⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)))ᶜ := by + rw [s.carrier_eq] + exact hcover + have hfrontUP : frontier U = + ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) := + hfrontU.trans s.carrier_eq.symm + have hfrontVP : frontier V = + ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) := + hfrontV.trans s.carrier_eq.symm + have htile := P3475T1SquareUnionIdentification T hinside houtside + p v hvertex hedges U V hUopen hUconn hUb hVopen hVconn hVub + hdisj hcoverP hfrontUP hfrontVP + have hsource : X = TileRealization T := by + rw [htile, s.carrier_eq] + exact hX + obtain ⟨t⟩ := P3475T1BoundaryRestoration q p s X K tree + rw [hsource] at t + obtain ⟨h, hboundary, haffine⟩ := + P3381T1PiecewiseAffinePolygonModel p (TileRealization T) K t + have hfrontier := + (P3381T1TriangulationBoundary p (TileRealization T) K t).2.2.1 + refine ⟨n, p, v, K, t, h, hvertex, hedges, hfrontier, hboundary, ?_, haffine⟩ + intro x + rw [mem_interior_iff_notMem_frontier x.property, + mem_interior_iff_notMem_frontier (h x).property] + exact not_congr (hboundary x) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1PairedModelSegmentPullback.lean b/LeanPool/ApollonianSuperharmonic/P3723T1PairedModelSegmentPullback.lean new file mode 100644 index 0000000000..1c2e884bae --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3723T1PairedModelSegmentPullback.lean @@ -0,0 +1,560 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3723T1PolygonalParameterization +public import LeanPool.ApollonianSuperharmonic.P3381T1PiecewiseAffinePolygonModel +public import Mathlib.Data.Finset.Sort + +-- [TABLET NODE: P3723T1PairedModelSegmentPullback] + +/-! +# P3723T1PairedModelSegmentPullback + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SegmentPullbackProof + +private theorem hgconst : + (by + classical + exact + ∀ (X : Set (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (h : X ≃ₜ K), ∀ (a : K), ∀ (b : + K), ∀ (g : Set.Icc (0 : Real) 1 → X), (∀ (s : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), + (↑((h : (↑X : Type) → (↑K : Type)) (g s)) : ℝ × ℝ) = ((1 : ℝ) - (↑s : ℝ)) • (↑a : ℝ × + ℝ) + (↑s : ℝ) • (↑b : ℝ × ℝ)) → ((a = b) → (∀ (s : Set.Icc (0 : Real) 1), g s = g ⟨0, + by norm_num⟩))) := by + classical + intro X K h a b g hg hab s + apply h.injective + apply Subtype.ext + have hs := hg s + have h0 := hg ⟨0, by norm_num⟩ + rw [hab] at hs h0 + have hline : (1 - (s : Real)) • (b : Real × Real) + + (s : Real) • (b : Real × Real) = b := by + ext <;> simp [smul_eq_mul] <;> ring + have hzero : (1 - (0 : Real)) • (b : Real × Real) + + (0 : Real) • (b : Real × Real) = b := by simp + exact (hs.trans hline).trans (h0.trans (by simp)).symm + +private theorem hFbounds : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set + (Real × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (a : K), ∀ (b : K), + let L : Real → Real × Real := + AffineMap.lineMap (a : Real × Real) (b : Real × Real) + let E : Fin t.count → Set (Real × Real) := fun k => + convexHull Real (Set.range (t.target ∘ t.face k)) + let I : Fin t.count → Set Real := fun k => + Set.Icc 0 1 ∩ L ⁻¹' E k + ∀ (hIcompact : ∀ (k : Fin t.count), IsCompact (I k)), + let lo : Fin t.count → Real := fun k => + if hk : (I k).Nonempty then Classical.choose ((hIcompact k).exists_isLeast hk) else 0 + let hi : Fin t.count → Real := fun k => + if hk : (I k).Nonempty then Classical.choose ((hIcompact k).exists_isGreatest hk) else 0 + let F : Finset Real := {0, 1} ∪ Finset.univ.biUnion (fun k => + if (I k).Nonempty then {lo k, hi k} else ∅) + (∀ (k : Fin t.count), ((I k).Nonempty) → (lo k ∈ I k)) → ((∀ (k : Fin t.count), ((I + k).Nonempty) → (hi k ∈ I k)) → (∀ x ∈ F, x ∈ Set.Icc (0 : ℝ) (1 : ℝ))) + ) := by + classical + intro n p X K t a b L E I hIcompact lo hi F hlo_mem hhi_mem x hx + simp only [F, Finset.mem_union] at hx + rcases hx with hxpair | hxends + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxpair + rcases hxpair with rfl | rfl <;> norm_num + · obtain ⟨k, _, hxk⟩ := Finset.mem_biUnion.mp hxends + by_cases hk : (I k).Nonempty + · simp? [hk] at hxk + rcases hxk with hxlo | hxhi + · subst x + have hm := hlo_mem k hk + simpa [I] using hm.1 + · subst x + have hm := hhi_mem k hk + simpa [I] using hm.1 + · simp [hk] at hxk + +private theorem hpart : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set + (Real × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (a : K), ∀ (b : K), + let L : Real → Real × Real := + AffineMap.lineMap (a : Real × Real) (b : Real × Real) + let E : Fin t.count → Set (Real × Real) := fun k => + convexHull Real (Set.range (t.target ∘ t.face k)) + let I : Fin t.count → Set Real := fun k => + Set.Icc 0 1 ∩ L ⁻¹' E k + ∀ (hIcompact : ∀ (k : Fin t.count), IsCompact (I k)), (∀ (k : Fin t.count), Convex Real + (I k)) → ((Set.Icc (0 : Real) 1 ⊆ ⋃ k, I k) → ( + let lo : Fin t.count → Real := fun k => + if hk : (I k).Nonempty then Classical.choose ((hIcompact k).exists_isLeast hk) else 0 + let hi : Fin t.count → Real := fun k => + if hk : (I k).Nonempty then Classical.choose ((hIcompact k).exists_isGreatest hk) else 0 + (∀ (k : Fin t.count), ((I k).Nonempty) → (IsLeast (I k) (lo k))) → ((∀ (k : Fin t.count), + ((I k).Nonempty) → (IsGreatest (I k) (hi k))) → ( + let F : Finset Real := {0, 1} ∪ Finset.univ.biUnion (fun k => + if (I k).Nonempty then {lo k, hi k} else ∅) + (∀ (k : Fin t.count), ((I k).Nonempty) → (lo k ∈ F)) → ((∀ (k : Fin t.count), ((I + k).Nonempty) → (hi k ∈ F)) → ((∀ (k : Fin t.count), ((I k).Nonempty) → (lo k ∈ I k)) + → ((∀ (k : Fin t.count), ((I k).Nonempty) → (hi k ∈ I k)) → ((∀ (x : Real), (x ∈ F) → + (x ∈ Set.Icc 0 1)) → (∀ (hcount : F.card - 1 + 1 = F.card), + let e : Fin F.card ↪o Real := F.orderEmbOfFin rfl + let tm : Fin (F.card - 1 + 1) → Real := fun i => e (Fin.cast hcount i) + (StrictMono tm) → (∀ (i : Fin (F.card - (1 : ℕ))), ∃ (k : Fin t.count), Set.Icc (tm + i.castSucc) (tm i.succ) ⊆ I k)))))))))) + ) := by + classical + intro n p X K t a b L E I hIcompact hIconvex hIcover lo hi hlo hhi F hloF hhiF hlo_mem hhi_mem + hFbounds hcount e tm htm_strict i + let l := tm i.castSucc + let r := tm i.succ + have hir : i.castSucc < i.succ := by + apply Fin.lt_def.mpr + simp + have hlr : l < r := by + exact htm_strict hir + have hlF : l ∈ F := by + change e (Fin.cast hcount i.castSucc) ∈ F + exact Finset.orderEmbOfFin_mem F rfl _ + have hrF : r ∈ F := by + change e (Fin.cast hcount i.succ) ∈ F + exact Finset.orderEmbOfFin_mem F rfl _ + let m := (l + r) / 2 + have hlm : l < m := by dsimp [m]; linarith + have hmr : m < r := by dsimp [m]; linarith + have hmIcc : m ∈ Set.Icc (0 : Real) 1 := by + have hbl := (hFbounds l hlF).1 + have hbr := (hFbounds r hrF).2 + constructor <;> dsimp [m] <;> linarith + obtain ⟨k, hkm⟩ := Set.mem_iUnion.mp (hIcover hmIcc) + have hkn : (I k).Nonempty := ⟨m, hkm⟩ + have hno (x : Real) (hxF : x ∈ F) : ¬ (l < x ∧ x < r) := by + rintro ⟨hlx, hxr⟩ + obtain ⟨j, hj⟩ : ∃ j : Fin F.card, e j = x := by + have hxrange : x ∈ Set.range e := by + rw [Finset.range_orderEmbOfFin F rfl] + exact hxF + exact hxrange + have hlj : Fin.cast hcount i.castSucc < j := by + apply e.lt_iff_lt.mp + change e (Fin.cast hcount i.castSucc) < e j + simpa [l, tm, hj] using hlx + have hjr : j < Fin.cast hcount i.succ := by + apply e.lt_iff_lt.mp + change e j < e (Fin.cast hcount i.succ) + simpa [r, tm, hj] using hxr + have hljv : i.val < j.val := by + have h := hlj + simp only [Fin.lt_def, Fin.val_cast, Fin.val_castSucc] at h + exact h + have hjrv : j.val < i.val + 1 := by + have h := hjr + simp only [Fin.lt_def, Fin.val_cast, Fin.val_succ] at h + exact h + omega + have hlole : lo k ≤ l := by + by_contra hn + have hml := (hlo k hkn).2 hkm + exact hno (lo k) (hloF k hkn) ⟨lt_of_not_ge hn, lt_of_le_of_lt hml hmr⟩ + have hler : r ≤ hi k := by + by_contra hn + have hml := (hhi k hkn).2 hkm + exact hno (hi k) (hhiF k hkn) ⟨lt_of_lt_of_le hlm hml, lt_of_not_ge hn⟩ + have hlowhi : lo k ≤ hi k := le_trans hlole (le_trans hlr.le hler) + have hseg := (hIconvex k).segment_subset (hlo_mem k hkn) (hhi_mem k hkn) + rw [segment_eq_Icc hlowhi] at hseg + refine ⟨k, ?_⟩ + intro s hs + apply hseg + exact ⟨le_trans hlole hs.1, le_trans hs.2 hler⟩ + +private theorem target_weights : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set + (Real × Real)), ∀ (t : P3381T1PairedTriangulation p X K), + let E : Fin t.count → Set (Real × Real) := fun k => + convexHull Real (Set.range (t.target ∘ t.face k)) + ∀ (k : Fin t.count), ∀ z ∈ E k, ∃ (w : Fin (3 : ℕ) → ℝ), ∑ j : Fin (3 : ℕ), w j = (1 : ℝ) + ∧ (∀ (j : Fin (3 : ℕ)), (0 : ℝ) ≤ w j) ∧ z = ∑ j : Fin (3 : ℕ), w j • t.target + (t.face k j) + ) := by + classical + intro n p X K t E k z hz + change z ∈ convexHull Real (Set.range (t.target ∘ t.face k)) at hz + obtain ⟨ι, inst, w, y, hw0, hw1, hy, hzy⟩ := + mem_convexHull_iff_exists_fintype.mp hz + let _ := inst + choose c hc using hy + simp only [Function.comp_apply] at hc + let W : Fin 3 → Real := fun j => ∑ r, if c r = j then w r else 0 + have hW : (∑ j, W j) = 1 := by + simpa [W, Finset.sum_comm] using hw1 + have hWnonneg : ∀ j, 0 ≤ W j := by + intro j + apply Finset.sum_nonneg + intro r _ + split_ifs with h + · exact hw0 r + · exact le_rfl + have sum_eq : ∀ f : Fin 3 → Real × Real, + (∑ j, W j • f j) = ∑ r, w r • f (c r) := by + intro f + simp [W, Finset.sum_smul, Finset.sum_comm, ite_smul] + refine ⟨W, hW, hWnonneg, ?_⟩ + calc + z = ∑ r, w r • y r := hzy.symm + _ = ∑ r, w r • t.target (t.face k (c r)) := by + apply Finset.sum_congr rfl + intro r _ + rw [← hc r] + _ = ∑ j, W j • t.target (t.face k j) := + (sum_eq (t.target ∘ t.face k)).symm + +private theorem piece : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set + (Real × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (h : X ≃ₜ K), (∀ (k : + Fin t.count), ∀ (x : (↑X : Type)), (↑x : ℝ × ℝ) ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set + (ℝ × ℝ)) (Set.range (p.vertex ∘ t.face k)) → ∀ (w : Fin (3 : ℕ) → ℝ), ∑ i : Fin (3 : + ℕ), w i = (1 : ℝ) → (↑x : ℝ × ℝ) = ∑ i : Fin (3 : ℕ), w i • p.vertex (t.face k i) → + (↑((h : (↑X : Type) → (↑K : Type)) x) : ℝ × ℝ) = ∑ i : Fin (3 : ℕ), w i • t.target + (t.face k i)) → (∀ (a : K), ∀ (b : K), ∀ (g : Set.Icc (0 : Real) 1 → X), (∀ (s : + (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (↑((h : (↑X : Type) → (↑K : Type)) (g s)) : ℝ × + ℝ) = ((1 : ℝ) - (↑s : ℝ)) • (↑a : ℝ × ℝ) + (↑s : ℝ) • (↑b : ℝ × ℝ)) → ( + let L : Real → Real × Real := + AffineMap.lineMap (a : Real × Real) (b : Real × Real) + (∀ (s : Real), L s = (1 - s) • (a : Real × Real) + s • (b : Real × Real)) → ( + let E : Fin t.count → Set (Real × Real) := fun k => + convexHull Real (Set.range (t.target ∘ t.face k)) + let I : Fin t.count → Set Real := fun k => + Set.Icc 0 1 ∩ L ⁻¹' E k + ∀ (hIcompact : ∀ (k : Fin t.count), IsCompact (I k)), + let lo : Fin t.count → Real := fun k => + if hk : (I k).Nonempty then Classical.choose ((hIcompact k).exists_isLeast hk) else 0 + let hi : Fin t.count → Real := fun k => + if hk : (I k).Nonempty then Classical.choose ((hIcompact k).exists_isGreatest hk) else 0 + let F : Finset Real := {0, 1} ∪ Finset.univ.biUnion (fun k => + if (I k).Nonempty then {lo k, hi k} else ∅) + ∀ (hcount : F.card - 1 + 1 = F.card), + let e : Fin F.card ↪o Real := F.orderEmbOfFin rfl + let tm : Fin (F.card - 1 + 1) → Real := fun i => e (Fin.cast hcount i) + (StrictMono tm) → ((∀ (i : Fin (F.card - 1)), ∃ k, Set.Icc (tm i.castSucc) (tm i.succ) ⊆ + I k) → ((∀ (k : Fin t.count), ∀ (z : Real × Real), (z ∈ E k) → (∃ w : Fin 3 → Real, + (∑ j, w j) = 1 ∧ (∀ j, 0 ≤ w j) ∧ z = ∑ j, w j • t.target (t.face k j))) → ((∀ (k : + Fin t.count), ∀ (w : Fin 3 → Real), ((∑ j, w j) = 1) → ((∀ j, 0 ≤ w j) → ((∑ j, w j • + p.vertex (t.face k j)) ∈ convexHull Real (Set.range (p.vertex ∘ t.face k))))) → (∀ (i + : Fin (F.card - (1 : ℕ))), ∃ (A : ℝ × ℝ) (B : ℝ × ℝ), ∀ (s : (↑(Set.Icc (0 : ℝ) (1 : + ℝ)) : Type)), tm i.castSucc ≤ (↑s : ℝ) → (↑s : ℝ) ≤ tm i.succ → (↑(g s) : ℝ × ℝ) = A + + (↑s : ℝ) • B))))))) + ) := by + classical + intro n p X K t h haffine a b g hg L hL E I hIcompact lo hi F hcount e tm htm_strict hpart + target_weights source_hull i + obtain ⟨k, hsub⟩ := hpart i + let u := tm i.castSucc + let v := tm i.succ + have huv : u < v := htm_strict (by + apply Fin.lt_def.mpr + simp) + have huI : u ∈ I k := hsub ⟨le_rfl, huv.le⟩ + have hvI : v ∈ I k := hsub ⟨huv.le, le_rfl⟩ + have huI' : u ∈ Set.Icc 0 1 ∧ L u ∈ E k := by simpa [I] using huI + have hvI' : v ∈ Set.Icc 0 1 ∧ L v ∈ E k := by simpa [I] using hvI + have huE : L u ∈ E k := huI'.2 + have hvE : L v ∈ E k := hvI'.2 + obtain ⟨w0, hw0sum, hw0nonneg, hw0target⟩ := target_weights k (L u) huE + obtain ⟨w1, hw1sum, hw1nonneg, hw1target⟩ := target_weights k (L v) hvE + let x0 : Real × Real := ∑ j, w0 j • p.vertex (t.face k j) + let x1 : Real × Real := ∑ j, w1 j • p.vertex (t.face k j) + have hx0src : x0 ∈ convexHull Real (Set.range (p.vertex ∘ t.face k)) := by + exact source_hull k w0 hw0sum hw0nonneg + have hx1src : x1 ∈ convexHull Real (Set.range (p.vertex ∘ t.face k)) := by + exact source_hull k w1 hw1sum hw1nonneg + have hx0X : x0 ∈ X := by + rw [t.source_cover] + exact Set.mem_iUnion.mpr ⟨k, hx0src⟩ + have hx1X : x1 ∈ X := by + rw [t.source_cover] + exact Set.mem_iUnion.mpr ⟨k, hx1src⟩ + let z0 : X := ⟨x0, hx0X⟩ + let z1 : X := ⟨x1, hx1X⟩ + have hz0map : (h z0 : Real × Real) = L u := by + calc + (h z0 : Real × Real) = ∑ j, w0 j • t.target (t.face k j) := + haffine k z0 hx0src w0 hw0sum rfl + _ = L u := hw0target.symm + have hz1map : (h z1 : Real × Real) = L v := by + calc + (h z1 : Real × Real) = ∑ j, w1 j • t.target (t.face k j) := + haffine k z1 hx1src w1 hw1sum rfl + _ = L v := hw1target.symm + let su : Set.Icc (0 : Real) 1 := ⟨u, huI'.1⟩ + let sv : Set.Icc (0 : Real) 1 := ⟨v, hvI'.1⟩ + have hg0 : g su = z0 := by + apply h.injective + apply Subtype.ext + rw [hg su, ← hL u, hz0map] + have hg1 : g sv = z1 := by + apply h.injective + apply Subtype.ext + rw [hg sv, ← hL v, hz1map] + let B : Real × Real := (v - u)⁻¹ • (x1 - x0) + let A : Real × Real := x0 - u • B + refine ⟨A, B, ?_⟩ + intro s hs₀ hs₁ + have hs : (s : Real) ∈ Set.Icc u v := ⟨hs₀, hs₁⟩ + let q : Real := ((s : Real) - u) / (v - u) + have hden : 0 < v - u := sub_pos.mpr huv + have hq : q ∈ Set.Icc 0 1 := by + constructor + · dsimp [q] + exact div_nonneg (sub_nonneg.mpr hs.1) hden.le + · dsimp [q] + apply (div_le_iff₀ hden).2 + linarith + have hparam : (1 - q) * u + q * v = (s : Real) := by + dsimp [q] + field_simp [ne_of_gt hden] + ring + let w : Fin 3 → Real := fun j => (1 - q) * w0 j + q * w1 j + have hwSum : (∑ j, w j) = 1 := by + simp [w, Finset.sum_add_distrib, ← Finset.mul_sum, hw0sum, hw1sum] + have hwNonneg : ∀ j, 0 ≤ w j := by + intro j + dsimp [w] + exact add_nonneg (mul_nonneg (sub_nonneg.mpr hq.2) (hw0nonneg j)) + (mul_nonneg hq.1 (hw1nonneg j)) + have hinterp (f : Fin 3 → Real × Real) : + (∑ j, w j • f j) = + (1 - q) • (∑ j, w0 j • f j) + q • (∑ j, w1 j • f j) := by + ext <;> simp [w, Fin.sum_univ_three, smul_eq_mul] <;> ring + have hsourceInterp : + (∑ j, w j • p.vertex (t.face k j)) = (1 - q) • x0 + q • x1 := by + simpa [x0, x1] using hinterp (p.vertex ∘ t.face k) + have htargetInterp : + (∑ j, w j • t.target (t.face k j)) = L (s : Real) := by + calc + (∑ j, w j • t.target (t.face k j)) = + (1 - q) • (∑ j, w0 j • t.target (t.face k j)) + + q • (∑ j, w1 j • t.target (t.face k j)) := by + exact hinterp (t.target ∘ t.face k) + _ = (1 - q) • L u + q • L v := by rw [← hw0target, ← hw1target] + _ = L (s : Real) := by + have hlin : (1 - q) • L u + q • L v = + L ((1 - q) * u + q * v) := by + rw [hL u, hL v, hL ((1 - q) * u + q * v)] + ext <;> simp [smul_eq_mul] <;> ring + rw [hlin, hparam] + let xs : Real × Real := ∑ j, w j • p.vertex (t.face k j) + have hxssrc : xs ∈ convexHull Real (Set.range (p.vertex ∘ t.face k)) := + source_hull k w hwSum hwNonneg + have hxsX : xs ∈ X := by + rw [t.source_cover] + exact Set.mem_iUnion.mpr ⟨k, hxssrc⟩ + let zs : X := ⟨xs, hxsX⟩ + have hzsm : (h zs : Real × Real) = L (s : Real) := by + calc + (h zs : Real × Real) = ∑ j, w j • t.target (t.face k j) := + haffine k zs hxssrc w hwSum rfl + _ = L (s : Real) := htargetInterp + have hgs : g s = zs := by + apply h.injective + apply Subtype.ext + calc + (h (g s) : Real × Real) = (1 - (s : Real)) • (a : Real × Real) + + (s : Real) • (b : Real × Real) := hg s + _ = L (s : Real) := (hL (s : Real)).symm + _ = (h zs : Real × Real) := hzsm.symm + rw [hgs] + change xs = A + (s : Real) • B + change (∑ j, w j • p.vertex (t.face k j)) = A + (s : Real) • B + rw [hsourceInterp] + dsimp [A, B, q] + ext <;> simp [smul_eq_mul] <;> field_simp [ne_of_gt hden] <;> ring + +end SegmentPullbackProof + +theorem P3723T1PairedModelSegmentPullback {n : Nat} + (p : P3381T1PolygonBoundary n) (X K : Set (Real × Real)) + (t : P3381T1PairedTriangulation p X K) (h : X ≃ₜ K) + (haffine : ∀ k (x : X), + (x : Real × Real) ∈ convexHull Real (Set.range (p.vertex ∘ t.face k)) → + ∀ w : Fin 3 → Real, (∑ i, w i) = 1 → + (x : Real × Real) = ∑ i, w i • p.vertex (t.face k i) → + (h x : Real × Real) = ∑ i, w i • t.target (t.face k i)) + (a b : K) (g : Set.Icc (0 : Real) 1 → X) + (hg : ∀ s, (h (g s) : Real × Real) = + (1 - (s : Real)) • (a : Real × Real) + (s : Real) • (b : Real × Real)) : + Nonempty (P3723T1PolygonalParameterization + (fun s => (g s : Real × Real))) := by +-- BODY + classical + by_cases hab : a = b + · have hgconst (s : Set.Icc (0 : Real) 1) : g s = g ⟨0, by norm_num⟩ := + SegmentPullbackProof.hgconst X K h a b g hg hab s + refine ⟨{ count := 1 + positive := by norm_num + time := fun i => (i : Real) + strict := ?_ + start := by simp + finish := by simp + affine_on := ?_ }⟩ + · intro i j hij + have hij' : (i : Nat) < (j : Nat) := hij + change (i : Real) < (j : Real) + exact Nat.cast_lt.mpr hij' + · intro i + have hi : i = 0 := Fin.eq_zero i + subst i + refine ⟨(g ⟨0, by norm_num⟩ : Real × Real), 0, ?_⟩ + intro s _ _ + rw [hgconst s] + simp + · let L : Real → Real × Real := + AffineMap.lineMap (a : Real × Real) (b : Real × Real) + have hL (s : Real) : L s = + (1 - s) • (a : Real × Real) + s • (b : Real × Real) := by + simp [L, AffineMap.lineMap_apply_module] + have hLc : Continuous L := by + dsimp [L] + fun_prop + let E : Fin t.count → Set (Real × Real) := fun k => + convexHull Real (Set.range (t.target ∘ t.face k)) + let I : Fin t.count → Set Real := fun k => + Set.Icc 0 1 ∩ L ⁻¹' E k + have hEcompact (k : Fin t.count) : IsCompact (E k) := by + exact (Set.finite_range (t.target ∘ t.face k)).isCompact_convexHull Real + have hEconvex (k : Fin t.count) : Convex Real (E k) := + convex_convexHull Real _ + have hIcompact (k : Fin t.count) : IsCompact (I k) := by + exact isCompact_Icc.inter_right ((hEcompact k).isClosed.preimage hLc) + have hIconvex (k : Fin t.count) : Convex Real (I k) := by + change Convex Real (Set.Icc 0 1 ∩ L ⁻¹' E k) + exact Convex.inter (convex_Icc 0 1) (Convex.affine_preimage + (AffineMap.lineMap (a : Real × Real) (b : Real × Real)) + (hEconvex k)) + have hIcover : Set.Icc (0 : Real) 1 ⊆ ⋃ k, I k := by + intro s hs + have hsline : L s ∈ segment Real (a : Real × Real) (b : Real × Real) := by + rw [segment_eq_image] + exact ⟨s, hs, (hL s).symm⟩ + have hsK : L s ∈ K := (t.target_convex.segment_subset a.property b.property) hsline + rw [t.target_cover] at hsK + obtain ⟨k, hk⟩ := Set.mem_iUnion.mp hsK + exact Set.mem_iUnion.mpr ⟨k, hs, hk⟩ + let lo : Fin t.count → Real := fun k => + if hk : (I k).Nonempty then Classical.choose ((hIcompact k).exists_isLeast hk) else 0 + let hi : Fin t.count → Real := fun k => + if hk : (I k).Nonempty then Classical.choose ((hIcompact k).exists_isGreatest hk) else 0 + have hlo (k : Fin t.count) (hk : (I k).Nonempty) : IsLeast (I k) (lo k) := by + simp only [lo, dite_eq_left hk] + exact Classical.choose_spec ((hIcompact k).exists_isLeast hk) + have hhi (k : Fin t.count) (hk : (I k).Nonempty) : IsGreatest (I k) (hi k) := by + simp only [hi, dite_eq_left hk] + exact Classical.choose_spec ((hIcompact k).exists_isGreatest hk) + let F : Finset Real := {0, 1} ∪ Finset.univ.biUnion (fun k => + if (I k).Nonempty then {lo k, hi k} else ∅) + have hzeroF : (0 : Real) ∈ F := by simp [F] + have honeF : (1 : Real) ∈ F := by simp [F] + have hloF (k : Fin t.count) (hk : (I k).Nonempty) : lo k ∈ F := by + apply Finset.mem_union.mpr + right + apply Finset.mem_biUnion.mpr + exact ⟨k, Finset.mem_univ _, by simp [hk]⟩ + have hhiF (k : Fin t.count) (hk : (I k).Nonempty) : hi k ∈ F := by + apply Finset.mem_union.mpr + right + apply Finset.mem_biUnion.mpr + exact ⟨k, Finset.mem_univ _, by simp [hk]⟩ + have hlo_mem (k : Fin t.count) (hk : (I k).Nonempty) : lo k ∈ I k := + (hlo k hk).1 + have hhi_mem (k : Fin t.count) (hk : (I k).Nonempty) : hi k ∈ I k := + (hhi k hk).1 + have hFbounds (x : Real) (hx : x ∈ F) : x ∈ Set.Icc 0 1 := SegmentPullbackProof.hFbounds n p + X K t a b hIcompact hlo_mem hhi_mem x hx + have hFne : F.Nonempty := ⟨0, hzeroF⟩ + have hFcard : 1 < F.card := by + apply Finset.one_lt_card.mpr + exact ⟨0, hzeroF, 1, honeF, by norm_num⟩ + have hFmin : F.min' hFne = 0 := by + apply (Finset.min'_eq_iff F hFne 0).2 + exact ⟨hzeroF, fun x hx => (hFbounds x hx).1⟩ + have hFmax : F.max' hFne = 1 := by + apply (Finset.max'_eq_iff F hFne 1).2 + exact ⟨honeF, fun x hx => (hFbounds x hx).2⟩ + have hN : 0 < F.card := Nat.lt_trans Nat.zero_lt_one hFcard + have hcount : F.card - 1 + 1 = F.card := by omega + let e : Fin F.card ↪o Real := F.orderEmbOfFin rfl + let tm : Fin (F.card - 1 + 1) → Real := fun i => e (Fin.cast hcount i) + have htm_strict : StrictMono tm := by + intro i j hij + apply e.strictMono + apply Fin.lt_def.mpr + simpa using hij + have htm_start : tm 0 = 0 := by + change e (Fin.cast hcount 0) = 0 + have hcast : Fin.cast hcount 0 = ⟨0, hN⟩ := by + apply Fin.ext + rfl + rw [hcast, Finset.orderEmbOfFin_zero rfl hN, hFmin] + have htm_finish : tm (Fin.last (F.card - 1)) = 1 := by + change e (Fin.cast hcount (Fin.last (F.card - 1))) = 1 + have hcast : Fin.cast hcount (Fin.last (F.card - 1)) = + ⟨F.card - 1, by omega⟩ := by + apply Fin.ext + rfl + rw [hcast, Finset.orderEmbOfFin_last rfl hN, hFmax] + have hpart (i : Fin (F.card - 1)) : + ∃ k, Set.Icc (tm i.castSucc) (tm i.succ) ⊆ I k := SegmentPullbackProof.hpart n p X K t a + b hIcompact hIconvex hIcover hlo hhi hloF hhiF hlo_mem hhi_mem hFbounds hcount + htm_strict i + have target_weights (k : Fin t.count) (z : Real × Real) + (hz : z ∈ E k) : ∃ w : Fin 3 → Real, + (∑ j, w j) = 1 ∧ (∀ j, 0 ≤ w j) ∧ + z = ∑ j, w j • t.target (t.face k j) := SegmentPullbackProof.target_weights n p X K t k + z hz + have source_hull (k : Fin t.count) (w : Fin 3 → Real) + (hw : (∑ j, w j) = 1) (hw0 : ∀ j, 0 ≤ w j) : + (∑ j, w j • p.vertex (t.face k j)) ∈ + convexHull Real (Set.range (p.vertex ∘ t.face k)) := by + apply mem_convexHull_of_exists_fintype w (p.vertex ∘ t.face k) hw0 hw + · intro j + exact Set.mem_range_self j + · rfl + have piece (i : Fin (F.card - 1)) : ∃ A B : Real × Real, + ∀ s : Set.Icc (0 : Real) 1, + tm i.castSucc ≤ (s : Real) → (s : Real) ≤ tm i.succ → + (g s : Real × Real) = A + (s : Real) • B := SegmentPullbackProof.piece n p X K t h + haffine a b g hg hL hIcompact hcount htm_strict hpart target_weights source_hull i + refine ⟨{ count := F.card - 1 + positive := by omega + time := tm + strict := htm_strict + start := htm_start + finish := htm_finish + affine_on := ?_ }⟩ + intro i + exact piece i + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1PolygonalParameterization.lean b/LeanPool/ApollonianSuperharmonic/P3723T1PolygonalParameterization.lean new file mode 100644 index 0000000000..b50224881c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3723T1PolygonalParameterization.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Convex.Segment + +-- [TABLET NODE: P3723T1PolygonalParameterization] + +/-! +# P3723T1PolygonalParameterization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $g:[0,1]\to\mathbb R^2$, a polygonal parametrization certificate +consists of an integer $m>0$, a strictly increasing sequence +$0=\tau_0<\cdots<\tau_m=1$, and, for each $i hxc (subset_closure hxu))) + · intro x hx + by_cases hxu : x ∈ U + · exact Or.inl hxu + · right + intro hxc + have hxf : x ∈ frontier U := by + rw [frontier, hU.interior_eq] + exact ⟨hxc, hxu⟩ + exact Set.disjoint_left.mp havoid hx (hfront hxf) + · exact hmeet + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3767T1FixedFaceComponents.lean b/LeanPool/ApollonianSuperharmonic/P3767T1FixedFaceComponents.lean new file mode 100644 index 0000000000..4537c84517 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3767T1FixedFaceComponents.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3767T1FixedTrace +public import LeanPool.ApollonianSuperharmonic.P3767T1BarrierRegionMaximal +public import LeanPool.ApollonianSuperharmonic.P3767T1VertexEdgeIncidence + +-- [TABLET NODE: P3767T1FixedFaceComponents] + +/-! +# P3767T1FixedFaceComponents + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3767T1FixedFaceComponents {ι : Type} [Nontrivial ι] + (P : PlaneTriangulation ι) : + (∀ f, Disjoint (P3767T1FixedTrace P) (P.faceRegion f) ∧ + frontier (P.faceRegion f) ⊆ P3767T1FixedTrace P) ∧ + (∀ f (V : Set (Real × Real)), IsPreconnected V → + Disjoint V (frontier (P.faceRegion f)) → + (V ∩ P.faceRegion f).Nonempty → V ⊆ P.faceRegion f) ∧ + (P3767T1FixedTrace P)ᶜ = {x | ∃ f, x ∈ P.faceRegion f} := by +-- BODY + have hfrontier (f g : P.Face) : + Disjoint (frontier (P.faceRegion g)) (P.faceRegion f) := by + by_cases h : g = f + · subst g + exact (disjoint_frontier_iff_isOpen).mpr (P.region_open f) + · exact (P.region_disjoint h).frontier_left (P.region_open f) + have hedge (f : P.Face) (a b : ι) (hab : P.adjacent a b) : + Disjoint (P.edgeArc a b) (P.faceRegion f) := by + obtain ⟨g, _, _, hg, _, _⟩ := P.every_edge_two_faces a b hab + obtain ⟨i, hi⟩ := hg.1 + obtain ⟨j, hj⟩ := hg.2 + have hij : i ≠ j := by + intro h + have heq : a = b := hi.symm.trans (h ▸ hj) + exact P.adjacent_irreflexive a (heq ▸ hab) + have hs : P.edgeArc a b ⊆ frontier (P.faceRegion g) := by + rw [P.face_boundary g, ← hi, ← hj] + fin_cases i <;> fin_cases j <;> dsimp at * + all_goals try exact (hij rfl).elim + all_goals intro x hx + all_goals first + | exact Or.inl (Or.inl hx) + | exact Or.inl (Or.inr hx) + | exact Or.inr hx + | rw [P.arc_symmetric] at hx + first + | exact Or.inl (Or.inl hx) + | exact Or.inl (Or.inr hx) + | exact Or.inr hx + exact (hfrontier f g).mono_left hs + have havoid (f : P.Face) : + Disjoint (P3767T1FixedTrace P) (P.faceRegion f) := by + apply Set.disjoint_left.mpr + intro x hx hxf + rcases hx with ⟨a, rfl⟩ | ⟨a, b, hab, hx⟩ + · obtain ⟨b, hab⟩ := (P3767T1VertexEdgeIncidence P a).1 + obtain ⟨h, hzero, _⟩ := P.arc_homeomorph a b hab + have ha : P.position a ∈ P.edgeArc a b := by + rw [← hzero] + exact (h ⟨0, by norm_num⟩).property + exact Set.disjoint_left.mp (hedge f a b hab) ha hxf + · exact Set.disjoint_left.mp (hedge f a b hab) hx hxf + refine ⟨?_, ?_, ?_⟩ + · intro f + refine ⟨havoid f, ?_⟩ + intro x hx + rw [P.face_boundary f] at hx + right + rcases hx with (hx | hx) | hx + · exact ⟨_, _, P.face_edges f 0 1 (by decide), hx⟩ + · exact ⟨_, _, P.face_edges f 1 2 (by decide), hx⟩ + · exact ⟨_, _, P.face_edges f 2 0 (by decide), hx⟩ + · intro f V hV hdis hmeet + exact P3767T1BarrierRegionMaximal _ _ _ (P.region_open f) + (Set.Subset.refl _) hV hdis hmeet + · ext x + constructor + · intro hx + have hcover : x ∈ P3767T1FixedTrace P ∪ + {x | ∃ f, x ∈ P.faceRegion f} := by + rw [P3767T1FixedTrace, P.plane_cover] + trivial + exact hcover.resolve_left hx + · rintro ⟨f, hxf⟩ hxt + exact Set.disjoint_left.mp (havoid f) hxt hxf + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3767T1FixedTrace.lean b/LeanPool/ApollonianSuperharmonic/P3767T1FixedTrace.lean new file mode 100644 index 0000000000..5b6e0b6f87 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3767T1FixedTrace.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation + +-- [TABLET NODE: P3767T1FixedTrace] + +/-! +# P3767T1FixedTrace + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a plane triangulation $P$ in the sense of +`PlaneTriangulation`, its fixed trace is the subset of +$\mathbb R^2$ consisting of all stored vertex positions and all points +on stored arcs of adjacent pairs: +$$ + \mathcal T_P=\{P.\mathrm{position}(a):a\in\iota\} + \cup\{x:\exists a,b,\ a\sim b\text{ and }x\in P.\mathrm{edgeArc}(a,b)\}. +$$ +This is the trace of the given drawing, not of a newly constructed +tile-interior contact drawing. +-/ +def P3767T1FixedTrace {ι : Type} (P : PlaneTriangulation ι) : + Set (Real × Real) := +-- BODY + Set.range P.position ∪ {x | ∃ a b, P.adjacent a b ∧ x ∈ P.edgeArc a b} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3767T1VertexEdgeIncidence.lean b/LeanPool/ApollonianSuperharmonic/P3767T1VertexEdgeIncidence.lean new file mode 100644 index 0000000000..0ecf42183b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3767T1VertexEdgeIncidence.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation + +-- [TABLET NODE: P3767T1VertexEdgeIncidence] + +/-! +# P3767T1VertexEdgeIncidence + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3767T1VertexEdgeIncidence {ι : Type} [Nontrivial ι] + (P : PlaneTriangulation ι) (w : ι) : + (∃ z, P.adjacent w z) ∧ + ∀ a b, P.adjacent a b → P.position w ∈ P.edgeArc a b → + w = a ∨ w = b := by +-- BODY + classical + have hneighbor : ∃ z, P.adjacent w z := by + obtain ⟨z, hzw⟩ := exists_ne w + obtain ⟨p, hp, hl, _, hadj⟩ := + P.three_connected ∅ (by simp) w (by simp) z (by simp) + cases p with + | nil => simp at hp + | cons x xs => + have hxw : x = w := by simpa using hp + subst x + cases xs with + | nil => + have hwz : w = z := by simpa using hl + exact (hzw hwz.symm).elim + | cons y ys => exact ⟨y, hadj w y [] ys rfl⟩ + refine ⟨hneighbor, ?_⟩ + intro a b hab hw + obtain ⟨z, hwz⟩ := hneighbor + obtain ⟨h, hzero, _⟩ := P.arc_homeomorph w z hwz + have hw' : P.position w ∈ P.edgeArc w z := by + rw [← hzero] + exact (h ⟨0, by norm_num⟩).property + by_cases heq : ({w, z} : Set ι) = {a, b} + · have hmem : w ∈ ({a, b} : Set ι) := heq ▸ (by simp) + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hmem + · have hmem : P.position w ∈ + P.position '' (({w, z} : Set ι) ∩ {a, b}) := by + rw [← P.arc_intersections w z a b hwz hab heq] + exact ⟨hw', hw⟩ + obtain ⟨v, hv, hvw⟩ := hmem + have hvw' : v = w := P.position_injective hvw + subst v + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hv.2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean b/LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean new file mode 100644 index 0000000000..a0d3edf054 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean @@ -0,0 +1,793 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3776T1DiskMapExponentialLift +public import Mathlib.Analysis.SpecialFunctions.Trigonometric.Complex +public import Mathlib.Analysis.SpecialFunctions.Complex.Log + +-- [TABLET NODE: P3776T1BoundedDisplacementSurjective] + +/-! +# P3776T1BoundedDisplacementSurjective + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace BoundedDisplacementConstruction + +private theorem hmiss (f : ℝ × ℝ → ℝ × ℝ) (y : ℝ × ℝ) (hnot : ¬∃ a, f a = y) : ∀ x, f x ≠ y := by + classical + simpa [Function.Surjective] using hnot + +private noncomputable abbrev pc : (Real × Real) → ℂ := by + classical + exact fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + +private noncomputable abbrev R (M : ℝ) : Real := by + classical + exact 2 * M + 1 + +private theorem hR (M : ℝ) (hM : 0 ≤ M) : 0 ≤ (R M) := by + classical + let R : Real := 2 * M + 1 + change (0 ≤ R) + dsimp [R]; linarith + +private theorem hRpos (M : ℝ) (hM : 0 ≤ M) : 0 < (R M) := by + classical + let R : Real := 2 * M + 1 + change (0 < R) + dsimp [R]; linarith + +private theorem hMR (M : ℝ) : 2 * M < (R M) := by + classical + let R : Real := 2 * M + 1 + change (2 * M < R) + dsimp [R]; linarith + +private noncomputable abbrev D (M : ℝ) (y : ℝ × ℝ) : Set (ℝ × ℝ) := by + classical + let R : Real := 2 * M + 1 + exact Metric.closedBall y R + +private noncomputable abbrev g (f : ℝ × ℝ → ℝ × ℝ) (hf : Continuous f) (M : ℝ) (y : ℝ × ℝ) : C((D + M y), ℂ) := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let D := Metric.closedBall y R + change (C(D, ℂ)) + exact ⟨fun x => pc (f x) - pc y, by fun_prop⟩ + +private theorem hg (f : ℝ × ℝ → ℝ × ℝ) (hf : Continuous f) (M : ℝ) (y : ℝ × ℝ) (hmiss : ∀ (x : ℝ + × ℝ), f x ≠ y) : ∀ x, (g f hf M y) x ≠ 0 := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let D := Metric.closedBall y R + let g : C(D, ℂ) := ⟨fun x => pc (f x) - pc y, by fun_prop⟩ + change (∀ x, g x ≠ 0) + intro x hx + apply hmiss x + have hpc : pc (f x) = pc y := sub_eq_zero.mp hx + have hpair : f x = y := by + apply Prod.ext + · have := congrArg Complex.re hpc + simpa [pc] using this + · have := congrArg Complex.im hpc + simpa [pc] using this + exact hpair + +private noncomputable abbrev T : Set ℝ := by + classical + exact Set.Icc (0 : Real) 1 + +private noncomputable abbrev c (M : ℝ) (y : ℝ × ℝ) : (T) → Real × Real := by + classical + let R : Real := 2 * M + 1 + let T := Set.Icc (0 : Real) 1 + change (T → Real × Real) + exact fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + +private theorem hccont (M : ℝ) (y : ℝ × ℝ) : Continuous (c M y) := by + classical + let R : Real := 2 * M + 1 + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + change (Continuous c) + fun_prop + +private theorem hcin (M : ℝ) (y : ℝ × ℝ) (hR : 0 ≤ (R M)) : ∀ t, (c M y) t ∈ (D M y) := by + classical + let R : Real := 2 * M + 1 + let D := Metric.closedBall y R + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + change (0 ≤ R) at hR + change (∀ t, c t ∈ D) + intro t + change dist (c t) y ≤ R + rw [Prod.dist_eq, Real.dist_eq, Real.dist_eq] + simp only [c, add_sub_cancel_left] + apply max_le + · rw [abs_mul, abs_of_nonneg hR] + exact mul_le_of_le_one_right hR (Real.abs_cos_le_one _) + · rw [abs_mul, abs_of_nonneg hR] + exact mul_le_of_le_one_right hR (Real.abs_sin_le_one _) + +private noncomputable abbrev θ : (T) → Real := by + classical + let T := Set.Icc (0 : Real) 1 + change (T → Real) + exact fun t => 2 * Real.pi * (t : Real) + +private noncomputable abbrev E : (T) → ℂ := by + classical + let T := Set.Icc (0 : Real) 1 + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + change (T → ℂ) + exact fun t => Complex.exp ((θ t : ℂ) * Complex.I) + +private theorem hcircle (M : ℝ) (y : ℝ × ℝ) : ∀ t, (pc) ((c M y) t) - (pc) y = ((R M) : ℂ) * (E) + t := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + change (∀ t, pc (c t) - pc y = (R : ℂ) * E t) + intro t + apply Complex.ext + · simp [pc, c, E, θ, Complex.exp_mul_I] + ring + · simp [pc, c, E, θ, Complex.exp_mul_I] + ring + +private theorem hE : ∀ t, ‖(E) t‖ = 1 := by + classical + let T := Set.Icc (0 : Real) 1 + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + change (∀ t, ‖E t‖ = 1) + intro t + simp [E, Complex.norm_exp] + +private theorem hEne : ∀ t, (E) t ≠ 0 := by + classical + let T := Set.Icc (0 : Real) 1 + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + change (∀ t, E t ≠ 0) + intro t; exact Complex.exp_ne_zero _ + +private noncomputable abbrev A (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (y : ℝ × ℝ) : (T) → ℂ := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + change (T → ℂ) + exact fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + +private noncomputable abbrev err (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (y : ℝ × ℝ) : (T) → ℂ := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + change (T → ℂ) + exact fun t => pc (f (c t)) - pc (c t) + +private theorem hAform (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (y : ℝ × ℝ) (hRpos : 0 < (R M)) (hcircle : ∀ + (t : ↑(T)), (pc) ((c M y) t) - (pc) y = ↑(R M) * (E) t) (hEne : ∀ (t : ↑(T)), (E) t ≠ 0) : ∀ + t, (A f M y) t = 1 + (err f M y) t / (((R M) : ℂ) * (E) t) := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + let A : T → ℂ := fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + let err : T → ℂ := fun t => pc (f (c t)) - pc (c t) + change (0 < R) at hRpos + change (∀ (t : ↑T), pc (c t) - pc y = ↑R * E t) at hcircle + change (∀ (t : ↑T), E t ≠ 0) at hEne + change (∀ t, A t = 1 + err t / ((R : ℂ) * E t)) + intro t + have hden : (R : ℂ) * E t ≠ 0 := mul_ne_zero (by exact_mod_cast hRpos.ne') (hEne t) + have hsum : pc (f (c t)) - pc y = err t + (R : ℂ) * E t := by + dsimp [err] + rw [← hcircle t] + ring + dsimp [A] + rw [hsum] + field_simp [hden, hRpos.ne', hEne t] + ring + +private theorem hcoord (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (hbound : ∀ (x : ℝ × ℝ), dist (f x) x ≤ M) (y + : ℝ × ℝ) : ∀ t, |(f ((c M y) t)).1 - ((c M y) t).1| ≤ M ∧ + |(f ((c M y) t)).2 - ((c M y) t).2| ≤ M := by + classical + let R : Real := 2 * M + 1 + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + change (∀ t, |(f (c t)).1 - (c t).1| ≤ M ∧ + |(f (c t)).2 - (c t).2| ≤ M) + intro t + have h := hbound (c t) + rw [Prod.dist_eq, Real.dist_eq, Real.dist_eq] at h + exact ⟨(le_max_left _ _).trans h, (le_max_right _ _).trans h⟩ + +private theorem herr (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (y : ℝ × ℝ) (hcoord : ∀ (t : ↑(T)), |(f ((c M y) + t)).1 - ((c M y) t).1| ≤ M ∧ |(f ((c M y) t)).2 - ((c M y) t).2| ≤ M) : ∀ t, ‖(err f M y) t‖ + ≤ 2 * M := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let err : T → ℂ := fun t => pc (f (c t)) - pc (c t) + change (∀ (t : ↑T), |(f (c t)).1 - (c t).1| ≤ M ∧ |(f (c t)).2 - (c t).2| ≤ M) at hcoord + change (∀ t, ‖err t‖ ≤ 2 * M) + intro t + have hc := hcoord t + have heq : err t = (((f (c t)).1 - (c t).1 : Real) : ℂ) + + (((f (c t)).2 - (c t).2 : Real) : ℂ) * Complex.I := by + apply Complex.ext <;> simp [err, pc] + rw [heq] + calc + ‖(((f (c t)).1 - (c t).1 : Real) : ℂ) + + (((f (c t)).2 - (c t).2 : Real) : ℂ) * Complex.I‖ ≤ + ‖(((f (c t)).1 - (c t).1 : Real) : ℂ)‖ + + ‖(((f (c t)).2 - (c t).2 : Real) : ℂ) * Complex.I‖ := norm_add_le _ _ + _ = |(f (c t)).1 - (c t).1| + |(f (c t)).2 - (c t).2| := by + have hfirst : ‖(((f (c t)).1 - (c t).1 : Real) : ℂ)‖ = + |(f (c t)).1 - (c t).1| := by + simp only [Complex.norm_real, Real.norm_eq_abs] + have hsecond : ‖(((f (c t)).2 - (c t).2 : Real) : ℂ) * Complex.I‖ = + |(f (c t)).2 - (c t).2| := by + simp only [Complex.norm_mul, Complex.norm_real, + Complex.norm_I, mul_one, Real.norm_eq_abs] + rw [hfirst, hsecond] + _ ≤ 2 * M := by linarith [hc.1, hc.2] + +private theorem hAclose (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (hM : 0 ≤ M) (y : ℝ × ℝ) (hR : 0 ≤ (R M)) + (hMR : 2 * M < (R M)) (hE : ∀ (t : ↑(T)), ‖(E) t‖ = 1) (hAform : ∀ (t : ↑(T)), (A f M y) t = + 1 + (err f M y) t / (↑(R M) * (E) t)) (herr : ∀ (t : ↑(T)), ‖(err f M y) t‖ ≤ 2 * M) : ∀ t, + ‖(A f M y) t - 1‖ < 1 := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + let A : T → ℂ := fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + let err : T → ℂ := fun t => pc (f (c t)) - pc (c t) + change (0 ≤ R) at hR + change (2 * M < R) at hMR + change (∀ (t : ↑T), ‖E t‖ = 1) at hE + change (∀ (t : ↑T), A t = 1 + err t / (↑R * E t)) at hAform + change (∀ (t : ↑T), ‖err t‖ ≤ 2 * M) at herr + change (∀ t, ‖A t - 1‖ < 1) + intro t + rw [hAform t, add_sub_cancel_left] + have hden : ‖(R : ℂ) * E t‖ = R := by simp [hE t, hR] + rw [norm_div, hden] + exact (div_lt_one (by positivity)).2 ((herr t).trans_lt hMR) + +private theorem hreA (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (y : ℝ × ℝ) (hAclose : ∀ (t : ↑(T)), ‖(A f M y) + t - 1‖ < 1) : ∀ t, 0 < ((A f M y) t).re := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + let A : T → ℂ := fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + change (∀ (t : ↑T), ‖A t - 1‖ < 1) at hAclose + change (∀ t, 0 < (A t).re) + intro t + have hn := hAclose t + have hreal : |(A t).re - 1| ≤ ‖A t - 1‖ := by + simpa using Complex.abs_re_le_norm (A t - 1) + have : |(A t).re - 1| < 1 := lt_of_le_of_lt hreal hn + rw [abs_lt] at this + linarith + +private theorem hAcont (f : ℝ × ℝ → ℝ × ℝ) (hf : Continuous f) (M : ℝ) (y : ℝ × ℝ) (hRpos : 0 < + (R M)) (hccont : Continuous (c M y)) (hEne : ∀ (t : ↑(T)), (E) t ≠ 0) : Continuous (A f M y) + := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + let A : T → ℂ := fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + change (0 < R) at hRpos + change (Continuous c) at hccont + change (∀ (t : ↑T), E t ≠ 0) at hEne + change (Continuous A) + have hdencont : Continuous (fun t : T => (R : ℂ) * E t) := by fun_prop + have hdenne : ∀ t : T, (R : ℂ) * E t ≠ 0 := by + intro t + exact mul_ne_zero (by exact_mod_cast hRpos.ne') (hEne t) + have hnumcont : Continuous (fun t : T => pc (f (c t)) - pc y) := by fun_prop + exact hnumcont.div hdencont hdenne + +private theorem hlogcont (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (y : ℝ × ℝ) (hreA : ∀ (t : ↑(T)), 0 < ((A f + M y) t).re) (hAcont : Continuous (A f M y)) : Continuous (fun t : (T) => Complex.log ((A f M + y) t)) := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + let A : T → ℂ := fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + change (∀ (t : ↑T), 0 < (A t).re) at hreA + change (Continuous A) at hAcont + change (Continuous (fun t : T => Complex.log (A t))) + apply hAcont.clog + intro t + rw [Complex.mem_slitPlane_iff] + exact Or.inl (hreA t) + +private theorem hexpL (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (y : ℝ × ℝ) (hreA : ∀ (t : ↑(T)), 0 < ((A f M + y) t).re) : ∀ t, Complex.exp (Complex.log ((A f M y) t)) = (A f M y) t := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + let A : T → ℂ := fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + change (∀ (t : ↑T), 0 < (A t).re) at hreA + change (∀ t, Complex.exp (Complex.log (A t)) = A t) + intro t + apply Complex.exp_log + intro hz + have : (A t).re = 0 := by rw [hz]; simp + linarith [hreA t] + +private noncomputable abbrev J (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (y : ℝ × ℝ) (F : C(↑(Metric.closedBall + y (R M)), ℂ)) (hcin : ∀ (t : ↑(T)), (c M y) t ∈ (D M y)) : (T) → ℂ := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let D := Metric.closedBall y R + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + let A : T → ℂ := fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + change (C(↑(Metric.closedBall y R), ℂ)) at F + change (∀ (t : ↑T), c t ∈ D) at hcin + change (T → ℂ) + exact fun t => F ⟨c t, hcin t⟩ - + (Real.log R + (θ t : ℂ) * Complex.I + Complex.log (A t)) + +private theorem hJcont (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (y : ℝ × ℝ) (F : C(↑(Metric.closedBall y (R + M)), ℂ)) (hccont : Continuous (c M y)) (hcin : ∀ (t : ↑(T)), (c M y) t ∈ (D M y)) (hlogcont : + Continuous fun t => Complex.log ((A f M y) t)) : Continuous (J f M y F hcin) := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let D := Metric.closedBall y R + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + let A : T → ℂ := fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + let J : T → ℂ := fun t => F ⟨c t, hcin t⟩ - + (Real.log R + (θ t : ℂ) * Complex.I + Complex.log (A t)) + change (C(↑(Metric.closedBall y R), ℂ)) at F + change (Continuous c) at hccont + change (∀ (t : ↑T), c t ∈ D) at hcin + change (Continuous fun t => Complex.log (A t)) at hlogcont + change (Continuous J) + dsimp [J] + fun_prop + +private theorem hJexp (f : ℝ × ℝ → ℝ × ℝ) (hf : Continuous f) (M : ℝ) (y : ℝ × ℝ) (hmiss : ∀ (x : + ℝ × ℝ), f x ≠ y) (hRpos : 0 < (R M)) (F : C(↑(Metric.closedBall y (R M)), ℂ)) (hF : ∀ (x : + ↑(Metric.closedBall y (R M))), Complex.exp (F x) = (g f hf M y) x) (hcin : ∀ (t : ↑(T)), (c M + y) t ∈ (D M y)) (hEne : ∀ (t : ↑(T)), (E) t ≠ 0) (hAform : ∀ (t : ↑(T)), (A f M y) t = 1 + + (err f M y) t / (↑(R M) * (E) t)) (hexpL : ∀ (t : ↑(T)), Complex.exp (Complex.log ((A f M y) + t)) = (A f M y) t) : ∀ t, Complex.exp ((J f M y F hcin) t) = 1 := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let D := Metric.closedBall y R + let g : C(D, ℂ) := ⟨fun x => pc (f x) - pc y, by fun_prop⟩ + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + let A : T → ℂ := fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + let err : T → ℂ := fun t => pc (f (c t)) - pc (c t) + let J : T → ℂ := fun t => F ⟨c t, hcin t⟩ - + (Real.log R + (θ t : ℂ) * Complex.I + Complex.log (A t)) + change (0 < R) at hRpos + change (C(↑(Metric.closedBall y R), ℂ)) at F + change (∀ (x : ↑(Metric.closedBall y R)), Complex.exp (F x) = g x) at hF + change (∀ (t : ↑T), c t ∈ D) at hcin + change (∀ (t : ↑T), E t ≠ 0) at hEne + change (∀ (t : ↑T), A t = 1 + err t / (↑R * E t)) at hAform + change (∀ (t : ↑T), Complex.exp (Complex.log (A t)) = A t) at hexpL + change (∀ t, Complex.exp (J t) = 1) + intro t + have hFval := hF ⟨c t, hcin t⟩ + have hA := hAform t + have hEcomplex : E t = Complex.exp ((θ t : ℂ) * Complex.I) := rfl + have hfac : (R : ℂ) * E t * A t = pc (f (c t)) - pc y := by + dsimp [A] + have hden : (R : ℂ) * E t ≠ 0 := mul_ne_zero (by exact_mod_cast hRpos.ne') (hEne t) + field_simp [hden, hRpos.ne', hEne t] + have hfac' : (R : ℂ) * Complex.exp ((θ t : ℂ) * Complex.I) * A t = + pc (f (c t)) - pc y := by simpa [E] using hfac + have hsum : Complex.exp (Real.log R + (θ t : ℂ) * Complex.I + + Complex.log (A t)) = pc (f (c t)) - pc y := by + rw [Complex.exp_add, Complex.exp_add, ← Complex.ofReal_exp, Real.exp_log hRpos, + hexpL t] + convert hfac' using 1 + rw [Complex.exp_sub, hFval, hsum] + exact div_self (sub_ne_zero.mpr (by + intro hz + apply hmiss (c t) + have hp : pc (f (c t)) = pc y := hz + apply Prod.ext + · have := congrArg Complex.re hp; simpa [pc] using this + · have := congrArg Complex.im hp; simpa [pc] using this)) + +private theorem hJzero (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (y : ℝ × ℝ) (F : C(↑(Metric.closedBall y (R + M)), ℂ)) (hcin : ∀ (t : ↑(T)), (c M y) t ∈ (D M y)) (hJexp : ∀ (t : ↑(T)), Complex.exp ((J f + M y F hcin) t) = 1) : ∀ t, ∃ n : Int, ((J f M y F hcin) t).im / (2 * Real.pi) = n := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let D := Metric.closedBall y R + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + let A : T → ℂ := fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + let J : T → ℂ := fun t => F ⟨c t, hcin t⟩ - + (Real.log R + (θ t : ℂ) * Complex.I + Complex.log (A t)) + change (C(↑(Metric.closedBall y R), ℂ)) at F + change (∀ (t : ↑T), c t ∈ D) at hcin + change (∀ (t : ↑T), Complex.exp (J t) = 1) at hJexp + change (∀ t, ∃ n : Int, (J t).im / (2 * Real.pi) = n) + intro t + obtain ⟨n, hn⟩ := (Complex.exp_eq_one_iff).mp (hJexp t) + refine ⟨n, ?_⟩ + rw [hn] + simp [Complex.mul_re, Complex.mul_im] + +private theorem hJcontIm (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (y : ℝ × ℝ) (F : C(↑(Metric.closedBall y (R + M)), ℂ)) (hcin : ∀ (t : ↑(T)), (c M y) t ∈ (D M y)) (hJcont : Continuous (J f M y F hcin)) : + Continuous (fun t : (T) => ((J f M y F hcin) t).im / (2 * Real.pi)) := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let D := Metric.closedBall y R + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + let A : T → ℂ := fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + let J : T → ℂ := fun t => F ⟨c t, hcin t⟩ - + (Real.log R + (θ t : ℂ) * Complex.I + Complex.log (A t)) + change (C(↑(Metric.closedBall y R), ℂ)) at F + change (∀ (t : ↑T), c t ∈ D) at hcin + change (Continuous J) at hJcont + change (Continuous (fun t : T => (J t).im / (2 * Real.pi))) + exact (Complex.continuous_im.comp hJcont).div_const _ + +private noncomputable abbrev t0 : (T) := by + classical + let T := Set.Icc (0 : Real) 1 + change (T) + exact ⟨0, by norm_num [T]⟩ + +private noncomputable abbrev t1 : (T) := by + classical + let T := Set.Icc (0 : Real) 1 + change (T) + exact ⟨1, by norm_num [T]⟩ + +private theorem hJend (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (y : ℝ × ℝ) (F : C(↑(Metric.closedBall y (R + M)), ℂ)) (hcin : ∀ (t : ↑(T)), (c M y) t ∈ (D M y)) (hJexp : ∀ (t : ↑(T)), Complex.exp ((J f + M y F hcin) t) = 1) (hJzero : ∀ (t : ↑(T)), ∃ n : Int, ((J f M y F hcin) t).im / (2 * + Real.pi) = ↑n) (hJcontIm : Continuous fun t => ((J f M y F hcin) t).im / (2 * Real.pi)) : (J + f M y F hcin) (t0) = (J f M y F hcin) (t1) := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let D := Metric.closedBall y R + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + let A : T → ℂ := fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + let J : T → ℂ := fun t => F ⟨c t, hcin t⟩ - + (Real.log R + (θ t : ℂ) * Complex.I + Complex.log (A t)) + let t0 : T := ⟨0, by norm_num [T]⟩ + let t1 : T := ⟨1, by norm_num [T]⟩ + change (C(↑(Metric.closedBall y R), ℂ)) at F + change (∀ (t : ↑T), c t ∈ D) at hcin + change (∀ (t : ↑T), Complex.exp (J t) = 1) at hJexp + change (∀ (t : ↑T), ∃ n : Int, (J t).im / (2 * Real.pi) = ↑n) at hJzero + change (Continuous fun t => (J t).im / (2 * Real.pi)) at hJcontIm + change (J t0 = J t1) + have hfiber : ∀ t : T, ∃ n : Int, J t = (n : ℂ) * (2 * Real.pi * Complex.I) := by + intro t + obtain ⟨n, hn⟩ := (Complex.exp_eq_one_iff).mp (hJexp t) + exact ⟨n, hn⟩ + obtain ⟨n0, hn0⟩ := hfiber t0 + obtain ⟨n1, hn1⟩ := hfiber t1 + have him0 : (J t0).im / (2 * Real.pi) = (n0 : ℝ) := by rw [hn0]; simp + have him1 : (J t1).im / (2 * Real.pi) = (n1 : ℝ) := by rw [hn1]; simp + by_contra hneq + have hnneq : n0 ≠ n1 := by + intro heq + apply hneq + rw [hn0, hn1, heq] + rcases lt_or_gt_of_ne hnneq with hlt | hgt + · have hgap : n0 + 1 ≤ n1 := Int.add_one_le_iff.mpr hlt + have hgapR : (n0 : ℝ) + 1 ≤ (n1 : ℝ) := by exact_mod_cast hgap + let q : ℝ := (n0 : ℝ) + 1 / 2 + have hqlo : (J t0).im / (2 * Real.pi) ≤ q := by rw [him0]; dsimp [q]; linarith + have hqhi : q ≤ (J t1).im / (2 * Real.pi) := by rw [him1]; dsimp [q]; linarith + have hrange := intermediate_value_Icc (show t0 ≤ t1 by norm_num [t0, t1, T]) + hJcontIm.continuousOn (Set.mem_Icc.mpr ⟨hqlo, hqhi⟩) + rcases hrange with ⟨t, ht, hqt⟩ + obtain ⟨n, hn⟩ := hJzero t + have : (n0 : ℝ) + 1 / 2 = (n : ℝ) := by + have hqt' : (J t).im / (2 * Real.pi) = q := by simpa using hqt + rw [hn] at hqt' + dsimp [q] at hqt' + exact hqt'.symm + have hcastR : (2 : ℝ) * (n0 : ℝ) + 1 = 2 * (n : ℝ) := by nlinarith [this] + have hcast : (2 * n0 + 1 : Int) = 2 * n := by exact_mod_cast hcastR + omega + · have hgap : n1 + 1 ≤ n0 := Int.add_one_le_iff.mpr hgt + have hgapR : (n1 : ℝ) + 1 ≤ (n0 : ℝ) := by exact_mod_cast hgap + let q : ℝ := (n1 : ℝ) + 1 / 2 + have hqlo : -((J t0).im / (2 * Real.pi)) ≤ -q := by rw [him0]; dsimp [q]; linarith + have hqhi : -q ≤ -((J t1).im / (2 * Real.pi)) := by rw [him1]; dsimp [q]; linarith + have hrange := intermediate_value_Icc (show t0 ≤ t1 by norm_num [t0, t1, T]) + hJcontIm.neg.continuousOn (Set.mem_Icc.mpr ⟨hqlo, hqhi⟩) + rcases hrange with ⟨t, ht, hqt⟩ + obtain ⟨n, hn⟩ := hJzero t + have : (n1 : ℝ) + 1 / 2 = (n : ℝ) := by + change -((J t).im / (2 * Real.pi)) = -q at hqt + have hqt' : (J t).im / (2 * Real.pi) = q := by linarith + rw [hn] at hqt' + dsimp [q] at hqt' + exact hqt'.symm + have hcastR : (2 : ℝ) * (n1 : ℝ) + 1 = 2 * (n : ℝ) := by nlinarith [this] + have hcast : (2 * n1 + 1 : Int) = 2 * n := by exact_mod_cast hcastR + omega + +private theorem hcircleend (M : ℝ) (y : ℝ × ℝ) : (c M y) (t0) = (c M y) (t1) := by + classical + let R : Real := 2 * M + 1 + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let t0 : T := ⟨0, by norm_num [T]⟩ + let t1 : T := ⟨1, by norm_num [T]⟩ + change (c t0 = c t1) + simp [c, t0, t1, T, Real.cos_two_pi, Real.sin_two_pi] + +private theorem hEend : (E) (t0) = (E) (t1) := by + classical + let T := Set.Icc (0 : Real) 1 + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + let t0 : T := ⟨0, by norm_num [T]⟩ + let t1 : T := ⟨1, by norm_num [T]⟩ + change (E t0 = E t1) + simp [E, θ, t0, t1, T, Complex.exp_mul_I] + +private theorem hAend (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (y : ℝ × ℝ) (hcircleend : (c M y) (t0) = (c M + y) (t1)) (hEend : (E) (t0) = (E) (t1)) : (A f M y) (t0) = (A f M y) (t1) := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + let A : T → ℂ := fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + let t0 : T := ⟨0, by norm_num [T]⟩ + let t1 : T := ⟨1, by norm_num [T]⟩ + change (c t0 = c t1) at hcircleend + change (E t0 = E t1) at hEend + change (A t0 = A t1) + change (pc (f (c t0)) - pc y) / ((R : ℂ) * E t0) = + (pc (f (c t1)) - pc y) / ((R : ℂ) * E t1) + rw [hcircleend, hEend] + +private theorem hJdiff (f : ℝ × ℝ → ℝ × ℝ) (M : ℝ) (y : ℝ × ℝ) (F : C(↑(Metric.closedBall y (R + M)), ℂ)) (hcin : ∀ (t : ↑(T)), (c M y) t ∈ (D M y)) (hcircleend : (c M y) (t0) = (c M y) + (t1)) (hAend : (A f M y) (t0) = (A f M y) (t1)) : (J f M y F hcin) (t1) - (J f M y F hcin) + (t0) = + -(2 * Real.pi * Complex.I) := by + classical + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + let D := Metric.closedBall y R + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + let A : T → ℂ := fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + let J : T → ℂ := fun t => F ⟨c t, hcin t⟩ - + (Real.log R + (θ t : ℂ) * Complex.I + Complex.log (A t)) + let t0 : T := ⟨0, by norm_num [T]⟩ + let t1 : T := ⟨1, by norm_num [T]⟩ + change (C(↑(Metric.closedBall y R), ℂ)) at F + change (∀ (t : ↑T), c t ∈ D) at hcin + change (c t0 = c t1) at hcircleend + change (A t0 = A t1) at hAend + change (J t1 - J t0 = + -(2 * Real.pi * Complex.I)) + have hFend : F ⟨c t0, hcin t0⟩ = F ⟨c t1, hcin t1⟩ := by + congr 1 + exact Subtype.ext hcircleend + have ht0 : θ t0 = 0 := by simp [θ, t0, T] + have ht1 : θ t1 = 2 * Real.pi := by simp [θ, t1, T] + dsimp [J] + rw [hFend, hAend, ht0, ht1] + push_cast + ring + +private theorem hpi : (2 * Real.pi : ℂ) ≠ 0 := by + classical + exact_mod_cast (mul_ne_zero (by norm_num) Real.pi_ne_zero) + +private theorem hI : Complex.I ≠ 0 := by + classical + exact Complex.I_ne_zero + +end BoundedDisplacementConstruction + +theorem P3776T1BoundedDisplacementSurjective + (f : (Real × Real) → (Real × Real)) (hf : Continuous f) + (hbound : ∃ M : Real, 0 ≤ M ∧ ∀ x, dist (f x) x ≤ M) : + Function.Surjective f := by +-- BODY + obtain ⟨M, hM, hbound⟩ := hbound + intro y + by_contra hnot + have hmiss : ∀ x, f x ≠ y := BoundedDisplacementConstruction.hmiss f y hnot + let pc : (Real × Real) → ℂ := fun x => (x.1 : ℂ) + (x.2 : ℂ) * Complex.I + let R : Real := 2 * M + 1 + have hR : 0 ≤ R := BoundedDisplacementConstruction.hR M hM + have hRpos : 0 < R := BoundedDisplacementConstruction.hRpos M hM + have hMR : 2 * M < R := BoundedDisplacementConstruction.hMR M + let D := Metric.closedBall y R + let g : C(D, ℂ) := ⟨fun x => pc (f x) - pc y, by fun_prop⟩ + have hg : ∀ x, g x ≠ 0 := BoundedDisplacementConstruction.hg f hf M y hmiss + obtain ⟨F, hF⟩ := P3776T1DiskMapExponentialLift y R hR g hg + let T := Set.Icc (0 : Real) 1 + let c : T → Real × Real := fun t => + (y.1 + R * Real.cos (2 * Real.pi * (t : Real)), + y.2 + R * Real.sin (2 * Real.pi * (t : Real))) + have hccont : Continuous c := BoundedDisplacementConstruction.hccont M y + have hcin : ∀ t, c t ∈ D := BoundedDisplacementConstruction.hcin M y hR + let θ : T → Real := fun t => 2 * Real.pi * (t : Real) + let E : T → ℂ := fun t => Complex.exp ((θ t : ℂ) * Complex.I) + have hcircle : ∀ t, pc (c t) - pc y = (R : ℂ) * E t := BoundedDisplacementConstruction.hcircle M y + have hE : ∀ t, ‖E t‖ = 1 := BoundedDisplacementConstruction.hE + have hEne : ∀ t, E t ≠ 0 := BoundedDisplacementConstruction.hEne + let A : T → ℂ := fun t => (pc (f (c t)) - pc y) / ((R : ℂ) * E t) + let err : T → ℂ := fun t => pc (f (c t)) - pc (c t) + have hAform : ∀ t, A t = 1 + err t / ((R : ℂ) * E t) := BoundedDisplacementConstruction.hAform + f M y hRpos hcircle hEne + have hcoord : ∀ t, |(f (c t)).1 - (c t).1| ≤ M ∧ + |(f (c t)).2 - (c t).2| ≤ M := BoundedDisplacementConstruction.hcoord f M hbound y + have herr : ∀ t, ‖err t‖ ≤ 2 * M := BoundedDisplacementConstruction.herr f M y hcoord + have hAclose : ∀ t, ‖A t - 1‖ < 1 := BoundedDisplacementConstruction.hAclose f M hM y hR hMR hE + hAform herr + have hreA : ∀ t, 0 < (A t).re := BoundedDisplacementConstruction.hreA f M y hAclose + have hAcont : Continuous A := BoundedDisplacementConstruction.hAcont f hf M y hRpos hccont hEne + have hlogcont : Continuous (fun t : T => Complex.log (A t)) := + BoundedDisplacementConstruction.hlogcont f M y hreA hAcont + have hexpL : ∀ t, Complex.exp (Complex.log (A t)) = A t := + BoundedDisplacementConstruction.hexpL f M y hreA + let J : T → ℂ := fun t => F ⟨c t, hcin t⟩ - + (Real.log R + (θ t : ℂ) * Complex.I + Complex.log (A t)) + have hJcont : Continuous J := BoundedDisplacementConstruction.hJcont f M y F hccont hcin hlogcont + have hJexp : ∀ t, Complex.exp (J t) = 1 := BoundedDisplacementConstruction.hJexp f hf M y hmiss + hRpos F hF hcin hEne hAform hexpL + have hJzero : ∀ t, ∃ n : Int, (J t).im / (2 * Real.pi) = n := + BoundedDisplacementConstruction.hJzero f M y F hcin hJexp + have hJcontIm : Continuous (fun t : T => (J t).im / (2 * Real.pi)) := + BoundedDisplacementConstruction.hJcontIm f M y F hcin hJcont + let t0 : T := ⟨0, by norm_num [T]⟩ + let t1 : T := ⟨1, by norm_num [T]⟩ + have hJend : J t0 = J t1 := BoundedDisplacementConstruction.hJend f M y F hcin hJexp hJzero + hJcontIm + have hcircleend : c t0 = c t1 := BoundedDisplacementConstruction.hcircleend M y + have hEend : E t0 = E t1 := BoundedDisplacementConstruction.hEend + have hAend : A t0 = A t1 := BoundedDisplacementConstruction.hAend f M y hcircleend hEend + have hJdiff : J t1 - J t0 = + -(2 * Real.pi * Complex.I) := BoundedDisplacementConstruction.hJdiff f M y F hcin + hcircleend hAend + have : J t0 = J t1 := hJend + rw [this] at hJdiff + have hpi : (2 * Real.pi : ℂ) ≠ 0 := BoundedDisplacementConstruction.hpi + have hI : Complex.I ≠ 0 := BoundedDisplacementConstruction.hI + have : (2 * Real.pi : ℂ) * Complex.I ≠ 0 := mul_ne_zero hpi hI + exact (this (by linear_combination hJdiff)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1CellCenterMembership.lean b/LeanPool/ApollonianSuperharmonic/P3776T1CellCenterMembership.lean new file mode 100644 index 0000000000..a8d0ed5821 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1CellCenterMembership.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P3776T1CellCenterMembership] + +/-! +# P3776T1CellCenterMembership + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3776T1CellCenterMembership (T : ProtoTile) (q : LatticeCell) : + GaussianRealPoint q + ((1 / 2, 1 / 2) : Real × Real) ∈ TileRealization T ↔ + q ∈ T.cells := by +-- BODY + constructor + · intro h + simp only [TileRealization, Set.mem_iUnion] at h + obtain ⟨x, hx, hpoint⟩ := h + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, + GaussianRealPoint, Prod.fst_add, Prod.snd_add] at hpoint + have hre : x.re = q.re := by + have hlow : (x.re : Real) < (q.re : Real) + 1 := by linarith [hpoint.1.1] + have hhigh : (q.re : Real) < (x.re : Real) + 1 := by linarith [hpoint.2.1] + have hl : x.re < q.re + 1 := by exact_mod_cast hlow + have hh : q.re < x.re + 1 := by exact_mod_cast hhigh + omega + have him : x.im = q.im := by + have hlow : (x.im : Real) < (q.im : Real) + 1 := by linarith [hpoint.1.2] + have hhigh : (q.im : Real) < (x.im : Real) + 1 := by linarith [hpoint.2.2] + have hl : x.im < q.im + 1 := by exact_mod_cast hlow + have hh : q.im < x.im + 1 := by exact_mod_cast hhigh + omega + have heq : x = q := by ext <;> assumption + simpa [heq] using hx + · intro hq + apply Set.mem_iUnion.mpr + refine ⟨q, Set.mem_iUnion.mpr ⟨hq, ?_⟩⟩ + norm_num [ClosedSquareRealization, GaussianRealPoint, Set.mem_Icc, Prod.le_def] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1DiskMapExponentialLift.lean b/LeanPool/ApollonianSuperharmonic/P3776T1DiskMapExponentialLift.lean new file mode 100644 index 0000000000..787b346312 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1DiskMapExponentialLift.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Complex.CoveringMap +public import Mathlib.Analysis.Normed.Module.Connected +public import Mathlib.Topology.Algebra.Module.LocallyConvex +public import Mathlib.Topology.Homotopy.Lifting + +-- [TABLET NODE: P3776T1DiskMapExponentialLift] + +/-! +# P3776T1DiskMapExponentialLift + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3776T1DiskMapExponentialLift (z : Real × Real) (R : Real) + (hR : 0 ≤ R) (g : C(Metric.closedBall z R, Complex)) + (hg : ∀ x, g x ≠ 0) : + ∃ F : C(Metric.closedBall z R, Complex), ∀ x, Complex.exp (F x) = g x := by +-- BODY + let D : Set (Real × Real) := Metric.closedBall z R + let : ContractibleSpace D := Metric.contractibleSpace_closedBall hR + let : LocallyPathConnectedSpace D := + (convex_closedBall z R).locallyPathConnectedSpace + let x0 : D := ⟨z, by change dist z z ≤ R; simpa using hR⟩ + have he0 : Complex.exp (Complex.log (g x0)) = g x0 := Complex.exp_log (hg x0) + obtain ⟨F, hF, _⟩ := Complex.isCoveringMapOn_exp.existsUnique_continuousMap_lifts + g (a₀ := x0) (e₀ := Complex.log (g x0)) he0 (fun x => by simpa using hg x) + exact ⟨F, fun x => congrFun hF.2 x⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1DualEdges.lean b/LeanPool/ApollonianSuperharmonic/P3776T1DualEdges.lean new file mode 100644 index 0000000000..63515312e5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1DualEdges.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3776T1WalkMap +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P3776T1DualEdges] + +/-! +# P3776T1DualEdges + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a core $P$, dual-edge data consist of an unordered-edge port $m_{ab}$ +and paths $b_{f,ab}:[0,1]\to I(T_a)\cap I(T_b)$ for every incident +face $f$ of $ab$. The paths are continuous, start at $[\rho(f)]$, end at +$m_{ab}$, and are unchanged by exchanging $a,b$. For the other incident +face $g$ they are exactly +$b_{f,ab}(t)=\operatorname{P3776\_T1\_WalkMap}(P.\mathrm{facePath}(f,g),t/2)$. +The port belongs to both tile realizations, is symmetric in $a,b$, and +all ports and half paths commute with lattice translations. Fields on +nonedges or nonincident faces are unrestricted. +-/ +structure P3776T1DualEdges {ι : Type} (P : PeriodicTileCore ι) where +-- BODY + /-- The symmetric port on each common tile interface. -/ + port : ι → ι → (Real × Real) + /-- The path from an incident face point to the edge port. -/ + half : P.plane.Face → ι → ι → Set.Icc (0 : Real) 1 → (Real × Real) + port_symmetric : ∀ a b, P.plane.adjacent a b → port a b = port b a + port_support : ∀ a b, P.plane.adjacent a b → + port a b ∈ TileRealization (P.tile a) ∩ TileRealization (P.tile b) + port_periodic : ∀ u : P.lattice, ∀ a b, P.plane.adjacent a b → + port (P.shift u a) (P.shift u b) = port a b + GaussianRealPoint u + half_spec : ∀ f a b, P.plane.adjacent a b → + (∃ i, P.plane.faceVertex f i = a) → + (∃ i, P.plane.faceVertex f i = b) → + Continuous (half f a b) ∧ + half f a b ⟨0, by norm_num⟩ = GaussianRealPoint (P.rho f) ∧ + half f a b ⟨1, by norm_num⟩ = port a b ∧ + (∀ t, half f a b t ∈ TileRealization (P.tile a) ∩ TileRealization (P.tile b)) ∧ + (∀ t, half f a b t = half f b a t) ∧ + ∃ g, g ≠ f ∧ (∃ i, P.plane.faceVertex g i = a) ∧ + (∃ i, P.plane.faceVertex g i = b) ∧ + ∀ t, half f a b t = P3776T1WalkMap (P.facePath f g) + ⟨(t : Real) / 2, by constructor <;> linarith [t.2.1, t.2.2]⟩ + half_periodic : ∀ u : P.lattice, ∀ f a b, + P.plane.adjacent a b → (∃ i, P.plane.faceVertex f i = a) → + (∃ i, P.plane.faceVertex f i = b) → ∀ t, + half (P.faceShift u f) (P.shift u a) (P.shift u b) t = + half f a b t + GaussianRealPoint u + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean b/LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean new file mode 100644 index 0000000000..466d87d590 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean @@ -0,0 +1,970 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3776T1DualEdges +public import LeanPool.ApollonianSuperharmonic.P3776T1WalkMapProperties +public import Mathlib.Topology.Algebra.Field +public import Mathlib.Topology.Algebra.Order.Field + +-- [TABLET NODE: P3776T1DualEdgesExist] + +/-! +# P3776T1DualEdgesExist + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DualEdgesProof + +private theorem pair_spec : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), first a b hab ≠ second a b hab ∧ (∃ (i + : Fin (3 : ℕ)), P.plane.faceVertex (first a b hab) i = a) ∧ (∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex (first a b hab) i = b) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + (second a b hab) i = a) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (second a b hab) i = + b) ∧ ∀ (h : P.plane.Face), ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex h i = a) ∧ ∃ (i : + Fin (3 : ℕ)), P.plane.faceVertex h i = b) → h = first a b hab ∨ h = second a b hab := by + classical + intro ι P first second a b hab + rcases Classical.choose_spec (Classical.choose_spec + (P.plane.every_edge_two_faces a b hab)) with + ⟨hne, ⟨ha, hb⟩, ⟨hc, hd⟩, hu⟩ + exact ⟨hne, ha, hb, hc, hd, hu⟩ + +private theorem midpoint_reverse : + ∀ (p : List GaussianInt), (p ≠ []) → (P3776T1WalkMap p ⟨1 / 2, by norm_num⟩ = + P3776T1WalkMap p.reverse ⟨1 / 2, by norm_num⟩) := by + classical + intro p hp + obtain ⟨_, _, _, hrev, _, _⟩ := P3776T1WalkMapProperties p hp + let t : Set.Icc (0 : Real) 1 := ⟨1 / 2, by norm_num⟩ + have ht : t = ⟨1 - (t : Real), by constructor <;> norm_num⟩ := by + apply Subtype.ext + norm_num [t] + have heq : P3776T1WalkMap p t = + P3776T1WalkMap p ⟨1 - (t : Real), by constructor <;> norm_num⟩ := + congrArg (P3776T1WalkMap p) ht + exact heq.trans (hrev t).symm + +private theorem other_spec : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + let other (f : P.plane.Face) (a b : ι) (hab : P.plane.adjacent a b) := + @ite P.plane.Face (f = first a b hab) (Classical.propDecidable _) + (second a b hab) (first a b hab) + (∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), first a b hab ≠ second a b hab ∧ (∃ i, + P.plane.faceVertex (first a b hab) i = a) ∧ (∃ i, P.plane.faceVertex (first a b hab) i = + b) ∧ (∃ i, P.plane.faceVertex (second a b hab) i = a) ∧ (∃ i, P.plane.faceVertex (second + a b hab) i = b) ∧ ∀ h : P.plane.Face, ((∃ i, P.plane.faceVertex h i = a) ∧ (∃ i, + P.plane.faceVertex h i = b)) → h = first a b hab ∨ h = second a b hab) → (∀ (f : + P.plane.Face), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), (∃ (i : Fin (3 : + ℕ)), P.plane.faceVertex f i = a) → (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = b) → + other f a b hab ≠ f ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (other f a b hab) i = a) ∧ + ∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (other f a b hab) i = b) := by + classical + intro ι P first second other pair_spec f a b hab hfa hfb + have hp := pair_spec a b hab + have hf := hp.2.2.2.2.2 f ⟨hfa, hfb⟩ + rcases hf with hf | hf + · change f = first a b hab at hf + rw [hf] + simp only [other, ite_eq_left rfl] + exact ⟨hp.1.symm, hp.2.2.2.1, hp.2.2.2.2.1⟩ + · change f = second a b hab at hf + rw [hf] + simp only [other, ite_eq_right hp.1.symm] + exact ⟨hp.1, hp.2.1, hp.2.2.1⟩ + +private theorem hswap : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + ∀ (hba : P.plane.adjacent b a), (first b a hba ≠ second b a hba ∧ (∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex (first b a hba) i = b) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + (first b a hba) i = a) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (second b a hba) i = b) + ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (second b a hba) i = a) ∧ ∀ (h : + P.plane.Face), ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex h i = b) ∧ ∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex h i = a) → h = first b a hba ∨ h = second b a hba) → ((first b a hba = + first a b hab ∨ first b a hba = second a b hab) → ((second b a hba = first a b hab ∨ + second b a hba = second a b hab) → ((first b a hba = first a b hab ∧ second b a hba = + second a b hab) ∨ (first b a hba = second a b hab ∧ second b a hba = first a b hab)))) := by + classical + intro ι P a b hab first second hba hq hfirst hsecond + rcases hfirst with hf | hf <;> rcases hsecond with hg | hg + · have heq : first b a hba = second b a hba := hf.trans hg.symm + exact (hq.1 heq).elim + · exact Or.inl ⟨hf, hg⟩ + · exact Or.inr ⟨hf, hg⟩ + · have heq : first b a hba = second b a hba := hf.trans hg.symm + exact (hq.1 heq).elim + +private theorem hfirstAt289 : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + (∀ (u : P.lattice), ∀ (f : P.plane.Face), ∀ (a : ι), (∃ i, P.plane.faceVertex f i = P.shift u + a) → (∃ i, P.plane.faceVertex (P.faceShift (-u) f) i = a)) → ((∀ (u : P.lattice), ∀ (f : + P.plane.Face), P.faceShift u (P.faceShift (-u) f) = f) → (∀ (u : ↥P.lattice), ∀ (hab' + : P.plane.adjacent (P.shift u a) (P.shift u b)), (first a b hab ≠ second a b hab ∧ (∃ + (i : + Fin (3 : ℕ)), P.plane.faceVertex (first a b hab) i = a) ∧ (∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex (first a b hab) i = b) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + (second a b hab) i = a) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (second a b hab) i = + b) ∧ ∀ (h : P.plane.Face), ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex h i = a) ∧ ∃ (i : + Fin (3 : ℕ)), P.plane.faceVertex h i = b) → h = first a b hab ∨ h = second a b hab) → + ((first (P.shift u a) (P.shift u b) hab' ≠ second (P.shift u a) (P.shift u b) hab' ∧ (∃ + (i : Fin (3 : ℕ)), P.plane.faceVertex (first (P.shift u a) (P.shift u b) hab') i = + P.shift u a) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (first (P.shift u a) (P.shift u + b) hab') i = P.shift u b) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (second (P.shift u + a) (P.shift u b) hab') i = P.shift u a) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + (second (P.shift u a) (P.shift u b) hab') i = P.shift u b) ∧ ∀ (h : P.plane.Face), ((∃ (i + : Fin (3 : ℕ)), P.plane.faceVertex h i = P.shift u a) ∧ ∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex h i = P.shift u b) → h = first (P.shift u a) (P.shift u b) hab' ∨ h = + second (P.shift u a) (P.shift u b) hab') → ( + let f := first a b hab + let g := second a b hab + let f' := P.faceShift u f + let g' := P.faceShift u g + first (P.shift u a) (P.shift u b) hab' = f' ∨ first (P.shift u a) (P.shift u b) hab' = g')))) + := by + classical + intro ι P a b hab first second unshifted_incidence faceShift_cancel u hab' hp hq f g f' g' + have hinc1 := unshifted_incidence u + (first (P.shift u a) (P.shift u b) hab') a hq.2.1 + have hinc2 := unshifted_incidence u + (first (P.shift u a) (P.shift u b) hab') b hq.2.2.1 + rcases hp.2.2.2.2.2 _ ⟨hinc1, hinc2⟩ with h | h + · left + calc + first (P.shift u a) (P.shift u b) hab' = + P.faceShift u (P.faceShift (-u) + (first (P.shift u a) (P.shift u b) hab')) := + (faceShift_cancel u _).symm + _ = P.faceShift u f := congrArg (P.faceShift u) h + _ = f' := rfl + · right + calc + first (P.shift u a) (P.shift u b) hab' = + P.faceShift u (P.faceShift (-u) + (first (P.shift u a) (P.shift u b) hab')) := + (faceShift_cancel u _).symm + _ = P.faceShift u g := congrArg (P.faceShift u) h + _ = g' := rfl + +private theorem hsecondAt312 : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + (∀ (u : P.lattice), ∀ (f : P.plane.Face), ∀ (a : ι), (∃ i, P.plane.faceVertex f i = P.shift u + a) → (∃ i, P.plane.faceVertex (P.faceShift (-u) f) i = a)) → ((∀ (u : P.lattice), ∀ (f : + P.plane.Face), P.faceShift u (P.faceShift (-u) f) = f) → (∀ (u : ↥P.lattice), ∀ (hab' + : P.plane.adjacent (P.shift u a) (P.shift u b)), (first a b hab ≠ second a b hab ∧ (∃ + (i : + Fin (3 : ℕ)), P.plane.faceVertex (first a b hab) i = a) ∧ (∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex (first a b hab) i = b) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + (second a b hab) i = a) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (second a b hab) i = + b) ∧ ∀ (h : P.plane.Face), ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex h i = a) ∧ ∃ (i : + Fin (3 : ℕ)), P.plane.faceVertex h i = b) → h = first a b hab ∨ h = second a b hab) → + ((first (P.shift u a) (P.shift u b) hab' ≠ second (P.shift u a) (P.shift u b) hab' ∧ (∃ + (i : Fin (3 : ℕ)), P.plane.faceVertex (first (P.shift u a) (P.shift u b) hab') i = + P.shift u a) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (first (P.shift u a) (P.shift u + b) hab') i = P.shift u b) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (second (P.shift u + a) (P.shift u b) hab') i = P.shift u a) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + (second (P.shift u a) (P.shift u b) hab') i = P.shift u b) ∧ ∀ (h : P.plane.Face), ((∃ (i + : Fin (3 : ℕ)), P.plane.faceVertex h i = P.shift u a) ∧ ∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex h i = P.shift u b) → h = first (P.shift u a) (P.shift u b) hab' ∨ h = + second (P.shift u a) (P.shift u b) hab') → ( + let f := first a b hab + let g := second a b hab + let f' := P.faceShift u f + let g' := P.faceShift u g + second (P.shift u a) (P.shift u b) hab' = f' ∨ second (P.shift u a) (P.shift u b) hab' = + g')))) := by + classical + intro ι P a b hab first second unshifted_incidence faceShift_cancel u hab' hp hq f g f' g' + have hinc1 := unshifted_incidence u + (second (P.shift u a) (P.shift u b) hab') a hq.2.2.2.1 + have hinc2 := unshifted_incidence u + (second (P.shift u a) (P.shift u b) hab') b hq.2.2.2.2.1 + rcases hp.2.2.2.2.2 _ ⟨hinc1, hinc2⟩ with h | h + · left + calc + second (P.shift u a) (P.shift u b) hab' = + P.faceShift u (P.faceShift (-u) + (second (P.shift u a) (P.shift u b) hab')) := + (faceShift_cancel u _).symm + _ = P.faceShift u f := congrArg (P.faceShift u) h + _ = f' := rfl + · right + calc + second (P.shift u a) (P.shift u b) hab' = + P.faceShift u (P.faceShift (-u) + (second (P.shift u a) (P.shift u b) hab')) := + (faceShift_cancel u _).symm + _ = P.faceShift u g := congrArg (P.faceShift u) h + _ = g' := rfl + +private theorem horder : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + ∀ (u : ↥P.lattice), ∀ (hab' : P.plane.adjacent (P.shift u a) (P.shift u b)), (first (P.shift + u a) (P.shift u b) hab' ≠ second (P.shift u a) (P.shift u b) hab' ∧ (∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex (first (P.shift u a) (P.shift u b) hab') i = P.shift u a) ∧ (∃ (i : + Fin (3 : ℕ)), P.plane.faceVertex (first (P.shift u a) (P.shift u b) hab') i = P.shift u + b) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (second (P.shift u a) (P.shift u b) hab') i + = P.shift u a) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (second (P.shift u a) (P.shift + u b) hab') i = P.shift u b) ∧ ∀ (h : P.plane.Face), ((∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex h i = P.shift u a) ∧ ∃ (i : Fin (3 : ℕ)), P.plane.faceVertex h i = + P.shift u b) → h = first (P.shift u a) (P.shift u b) hab' ∨ h = second (P.shift u a) + (P.shift u b) hab') → ( + let f := first a b hab + let g := second a b hab + let f' := P.faceShift u f + let g' := P.faceShift u g + (first (P.shift u a) (P.shift u b) hab' = f' ∨ first (P.shift u a) (P.shift u b) hab' = g') → + ((second (P.shift u a) (P.shift u b) hab' = f' ∨ second (P.shift u a) (P.shift u b) hab' + = g') → ((first (P.shift u a) (P.shift u b) hab' = f' ∧ second (P.shift u a) (P.shift u + b) hab' = g') ∨ (first (P.shift u a) (P.shift u b) hab' = g' ∧ second (P.shift u a) + (P.shift u b) hab' = f')))) := by + classical + intro ι P a b hab first second u hab' hq f g f' g' hfirst hsecond + rcases hfirst with hf | hf <;> rcases hsecond with hg | hg + · exact (hq.1 (hf.trans hg.symm)).elim + · exact Or.inl ⟨hf, hg⟩ + · exact Or.inr ⟨hf, hg⟩ + · exact (hq.1 (hf.trans hg.symm)).elim + +private theorem hotherEq : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + ∀ (f : P.plane.Face), + let other (f : P.plane.Face) (a b : ι) (hab : P.plane.adjacent a b) := + @ite P.plane.Face (f = first a b hab) (Classical.propDecidable _) + (second a b hab) (first a b hab) + ∀ (hba : P.plane.adjacent b a), (other f b a hba ≠ f ∧ (∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex (other f b a hba) i = b) ∧ ∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + (other f b a hba) i = a) → ((first a b hab ≠ second a b hab ∧ (∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex (first a b hab) i = a) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + (first a b hab) i = b) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (second a b hab) i = a) + ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (second a b hab) i = b) ∧ ∀ (h : + P.plane.Face), ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex h i = a) ∧ ∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex h i = b) → h = first a b hab ∨ h = second a b hab) → ((f = first a b + hab ∨ f = second a b hab) → ((other f b a hba = first a b hab ∨ other f b a hba = second + a b hab) → (other f b a hba = other f a b hab)))) := by + classical + intro ι P a b hab first second f other hba hotherBA hp hf hcand + rcases hf with hf | hf + · change f = first a b hab at hf + rcases hcand with hc | hc + · exact (hotherBA.1 (hc.trans hf.symm)).elim + · simpa only [other, ite_eq_left hf] using hc + · change f = second a b hab at hf + rcases hcand with hc | hc + · have hnot : f ≠ first a b hab := fun h => hp.1 (h.symm.trans hf) + simpa only [other, ite_eq_right hnot] using hc + · exact (hotherBA.1 (hc.trans hf.symm)).elim + +private theorem hother_shift : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + ∀ (f : P.plane.Face), + let other (f : P.plane.Face) (a b : ι) (hab : P.plane.adjacent a b) := + @ite P.plane.Face (f = first a b hab) (Classical.propDecidable _) + (second a b hab) (first a b hab) + (∀ (u : P.lattice), Function.Injective (P.faceShift u)) → (∀ (u : ↥P.lattice), ∀ (hab' : + P.plane.adjacent (P.shift u a) (P.shift u b)), + let g := other f a b hab + let f' := P.faceShift u f + let g' := P.faceShift u g + (other f a b hab ≠ f ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (other f a b hab) i = a) ∧ ∃ + (i : Fin (3 : ℕ)), P.plane.faceVertex (other f a b hab) i = b) → ((other f' (P.shift u a) + (P.shift u b) hab' ≠ f' ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (other f' (P.shift u + a) (P.shift u b) hab') i = P.shift u a) ∧ ∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (other + f' (P.shift u a) (P.shift u b) hab') i = P.shift u b) → ((f' = first (P.shift u a) + (P.shift u b) hab' ∨ f' = second (P.shift u a) (P.shift u b) hab') → ((other f' (P.shift + u a) (P.shift u b) hab' = first (P.shift u a) (P.shift u b) hab' ∨ other f' (P.shift u a) + (P.shift u b) hab' = second (P.shift u a) (P.shift u b) hab') → ((g' = first (P.shift u + a) (P.shift u b) hab' ∨ g' = second (P.shift u a) (P.shift u b) hab') → (other f' + (P.shift u a) (P.shift u b) hab' = g')))))) := by + classical + intro ι P a b hab first second f other faceShift_injective u hab' g f' g' hother hlhs hfchoice + hlchoice hgchoice + rcases hfchoice with hf | hf + · rcases hlchoice with hl | hl + · exact (hlhs.1 (hl.trans hf.symm)).elim + · rcases hgchoice with hg | hg + · exact (hother.1 (faceShift_injective u (hg.trans hf.symm))).elim + · exact hl.trans hg.symm + · rcases hlchoice with hl | hl + · rcases hgchoice with hg | hg + · exact hl.trans hg.symm + · exact (hother.1 (faceShift_injective u (hg.trans hf.symm))).elim + · exact (hlhs.1 (hl.trans hf.symm)).elim + +end DualEdgesProof + +namespace DualEdgeDetails + +private theorem faceShift_injective : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (u : ↥P.lattice), Function.Injective (P.faceShift + u) := by + classical + intro ι P u f g h + have h' := congrArg (P.faceShift (-u)) h + simpa only [← P.faceShift_add, neg_add_cancel, P.faceShift_zero] using h' + +private theorem shifted_incidence : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (u : ↥P.lattice), ∀ (f : P.plane.Face), ∀ (a : + ι), (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = a) → ∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex (P.faceShift u f) i = P.shift u a := by + classical + intro ι P u f a ha + rcases ha with ⟨i, hi⟩ + refine ⟨i, ?_⟩ + rw [P.face_vertices_periodic, hi] + +private theorem unshifted_incidence : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (u : ↥P.lattice), ∀ (f : P.plane.Face), ∀ (a : + ι), (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = P.shift u a) → ∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex (P.faceShift (-u) f) i = a := by + classical + intro ι P u f a ha + rcases ha with ⟨i, hi⟩ + refine ⟨i, ?_⟩ + rw [P.face_vertices_periodic, hi] + rw [← P.shift_add, neg_add_cancel, P.shift_zero] + +private theorem faceShift_cancel : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (u : ↥P.lattice), ∀ (f : P.plane.Face), + P.faceShift u (P.faceShift (-u) f) = f := by + classical + intro ι P u f + rw [← P.faceShift_add, add_neg_cancel, P.faceShift_zero] + +private theorem faceShift_cancel' : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (u : ↥P.lattice), ∀ (f : P.plane.Face), + P.faceShift (-u) (P.faceShift u f) = f := by + classical + intro ι P u f + rw [← P.faceShift_add, neg_add_cancel, P.faceShift_zero] + +private theorem walk_translate : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (p : List GaussianInt), p ≠ [] → ∀ (u : + ↥P.lattice), ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), P3776T1WalkMap (List.map (fun + (z : GaussianInt) => z + (↑u : GaussianInt)) p) t = P3776T1WalkMap p t + + GaussianRealPoint (↑u : GaussianInt) := by + classical + intro ι P p hp u t + obtain ⟨_, _, _, _, htranslate, _⟩ := P3776T1WalkMapProperties p hp + exact htranslate (u : GaussianInt) t + +private theorem hfirstAt497 : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + ∀ (hba : P.plane.adjacent b a), (first a b hab ≠ second a b hab ∧ (∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex (first a b hab) i = a) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + (first a b hab) i = b) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (second a b hab) i = a) + ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (second a b hab) i = b) ∧ ∀ (h : + P.plane.Face), ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex h i = a) ∧ ∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex h i = b) → h = first a b hab ∨ h = second a b hab) → ((first b a hba ≠ + second b a hba ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (first b a hba) i = b) ∧ (∃ (i + : Fin (3 : ℕ)), P.plane.faceVertex (first b a hba) i = a) ∧ (∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex (second b a hba) i = b) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + (second b a hba) i = a) ∧ ∀ (h : P.plane.Face), ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + h i = b) ∧ ∃ (i : Fin (3 : ℕ)), P.plane.faceVertex h i = a) → h = first b a hba ∨ h = + second b a hba) → (first b a hba = first a b hab ∨ first b a hba = second a b hab)) := by + classical + intro ι P a b hab first second hba hp hq + apply hp.2.2.2.2.2 + exact ⟨hq.2.2.1, hq.2.1⟩ + +private theorem hsecondAt501 : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + ∀ (hba : P.plane.adjacent b a), (first a b hab ≠ second a b hab ∧ (∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex (first a b hab) i = a) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + (first a b hab) i = b) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (second a b hab) i = a) + ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (second a b hab) i = b) ∧ ∀ (h : + P.plane.Face), ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex h i = a) ∧ ∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex h i = b) → h = first a b hab ∨ h = second a b hab) → ((first b a hba ≠ + second b a hba ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (first b a hba) i = b) ∧ (∃ (i + : Fin (3 : ℕ)), P.plane.faceVertex (first b a hba) i = a) ∧ (∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex (second b a hba) i = b) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + (second b a hba) i = a) ∧ ∀ (h : P.plane.Face), ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + h i = b) ∧ ∃ (i : Fin (3 : ℕ)), P.plane.faceVertex h i = a) → h = first b a hba ∨ h = + second b a hba) → (second b a hba = first a b hab ∨ second b a hba = second a b hab)) := by + classical + intro ι P a b hab first second hba hp hq + apply hp.2.2.2.2.2 + exact ⟨hq.2.2.2.2.1, hq.2.2.2.1⟩ + +private theorem hneAt517 : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + let p := P.facePath (first a b hab) (second a b hab) + ((P.facePath (first a b hab) (second a b hab)).head? = some (P.rho (first a b hab))) → (p ≠ + []) := by + classical + intro ι P a b hab first second p hhead he + change P.facePath (first a b hab) (second a b hab) = [] at he + rw [he] at hhead + simp at hhead + +private theorem ht : + let t : Set.Icc (0 : Real) 1 := ⟨1 / 2, by norm_num⟩ + t = ⟨1 - (t : Real), by constructor <;> norm_num⟩ := by + classical + intro t + apply Subtype.ext + norm_num [t] + +private theorem hneAt542 : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + ((P.facePath (first a b hab) (second a b hab)).head? = some (P.rho (first a b hab)) ∧ + (P.facePath (first a b hab) (second a b hab)).getLast? = some (P.rho (second a b hab)) ∧ + (∀ x ∈ P.facePath (first a b hab) (second a b hab), x ∈ FootprintVertices (P.tile a) ∩ + FootprintVertices (P.tile b)) ∧ ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (l₁ : List + GaussianInt), ∀ (l₂ : List GaussianInt), P.facePath (first a b hab) (second a b hab) = l₁ + ++ x :: y :: l₂ → {x, y} ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) → + (P.facePath (first a b hab) (second a b hab) ≠ []) := by + classical + intro ι P a b hab first second hhead he + have hh := hhead.1 + rw [he] at hh + simp at hh + +private theorem hfgAt566 : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + (∀ (u : P.lattice), Function.Injective (P.faceShift u)) → (∀ (u : ↥P.lattice), (first a b hab + ≠ second a b hab ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (first a b hab) i = a) ∧ (∃ + (i : Fin (3 : ℕ)), P.plane.faceVertex (first a b hab) i = b) ∧ (∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex (second a b hab) i = a) ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + (second a b hab) i = b) ∧ ∀ (h : P.plane.Face), ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex + h i = a) ∧ ∃ (i : Fin (3 : ℕ)), P.plane.faceVertex h i = b) → h = first a b hab ∨ h = + second a b hab) → ( + let f := first a b hab + let g := second a b hab + let f' := P.faceShift u f + let g' := P.faceShift u g + f' ≠ g')) := by + classical + intro ι P a b hab first second faceShift_injective u hp f g f' g' h + exact hp.1 (faceShift_injective u h) + +private theorem hpneAt583 : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + let f := first a b hab + let g := second a b hab + ((P.facePath f g).head? = some (P.rho f) ∧ (P.facePath f g).getLast? = some (P.rho g) ∧ (∀ x + ∈ P.facePath f g, x ∈ FootprintVertices (P.tile a) ∩ FootprintVertices (P.tile b)) ∧ ∀ (x + : GaussianInt), ∀ (y : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List + GaussianInt), P.facePath f g = l₁ ++ x :: y :: l₂ → {x, y} ∈ FootprintEdges (P.tile a) ∩ + FootprintEdges (P.tile b)) → (P.facePath f g ≠ []) := by + classical + intro ι P a b hab first second f g hspec he + rw [he] at hspec + simp at hspec + +private theorem hpath : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + ∀ (u : ↥P.lattice), + let f := first a b hab + let g := second a b hab + let f' := P.faceShift u f + let g' := P.faceShift u g + P.facePath f' g' = (P.facePath f g).map (fun z => z + (u : GaussianInt)) := by + classical + intro ι P a b hab first second u f g f' g' + exact P.facePath_periodic u f g + +private theorem hpathne : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + ∀ (u : ↥P.lattice), + let f := first a b hab + let g := second a b hab + let f' := P.faceShift u f + let g' := P.faceShift u g + (P.facePath f g ≠ []) → ((P.facePath f' g' = (P.facePath f g).map (fun z => z + (u : + GaussianInt))) → (P.facePath f' g' ≠ [])) := by + classical + intro ι P a b hab first second u f g f' g' hpne hpath + rw [hpath] + intro hm + apply hpne + cases hp : P.facePath f g with + | nil => rfl + | cons z zs => simp [hp] at hm + +private theorem hnonempty : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + ∀ (f : P.plane.Face), + let other (f : P.plane.Face) (a b : ι) (hab : P.plane.adjacent a b) := + @ite P.plane.Face (f = first a b hab) (Classical.propDecidable _) + (second a b hab) (first a b hab) + ((P.facePath f (other f a b hab)).head? = some (P.rho f)) → (P.facePath f (other f a b hab) ≠ + []) := by + classical + intro ι P a b hab first second f other hhead h + simp [h] at hhead + +private theorem hfirstpoint : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + ∀ (f : P.plane.Face), + let other (f : P.plane.Face) (a b : ι) (hab : P.plane.adjacent a b) := + @ite P.plane.Face (f = first a b hab) (Classical.propDecidable _) + (second a b hab) (first a b hab) + ((P.facePath f (other f a b hab)).head? = some (P.rho f)) → ((P.facePath f (other f a b + hab)).getD 0 0 = P.rho f) := by + classical + intro ι P a b hab first second f other hhead + cases hp : P.facePath f (other f a b hab) with + | nil => simp [hp] at hhead + | cons z zs => simpa [hp] using hhead + +private theorem hparameter : + Continuous (fun t : Set.Icc (0 : Real) 1 => + (⟨(t : Real) / 2, by constructor <;> linarith [t.2.1, t.2.2]⟩ : + Set.Icc (0 : Real) 1)) := by + classical + fun_prop + +private theorem hparam : + (⟨(⟨1, by norm_num⟩ : Set.Icc (0 : Real) 1) / 2, + by constructor <;> norm_num⟩ : Set.Icc (0 : Real) 1) = + (⟨1 / 2, by norm_num⟩ : Set.Icc (0 : Real) 1) := by + classical + apply Subtype.ext + norm_num + +private theorem hfgAt699 : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + ∀ (f : P.plane.Face), + let other (f : P.plane.Face) (a b : ι) (hab : P.plane.adjacent a b) := + @ite P.plane.Face (f = first a b hab) (Classical.propDecidable _) + (second a b hab) (first a b hab) + (∀ (u : P.lattice), Function.Injective (P.faceShift u)) → (∀ (u : ↥P.lattice), + let g := other f a b hab + let f' := P.faceShift u f + let g' := P.faceShift u g + (other f a b hab ≠ f ∧ (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (other f a b hab) i = a) ∧ ∃ + (i : Fin (3 : ℕ)), P.plane.faceVertex (other f a b hab) i = b) → (f' ≠ g')) := by + classical + intro ι P a b hab first second f other faceShift_injective u g f' g' hother h + exact hother.1 (faceShift_injective u h).symm + +private theorem hpneAt718 : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + ∀ (f : P.plane.Face), + let other (f : P.plane.Face) (a b : ι) (hab : P.plane.adjacent a b) := + @ite P.plane.Face (f = first a b hab) (Classical.propDecidable _) + (second a b hab) (first a b hab) + let g := other f a b hab + ((P.facePath f g).head? = some (P.rho f) ∧ (P.facePath f g).getLast? = some (P.rho g) ∧ (∀ x + ∈ P.facePath f g, x ∈ FootprintVertices (P.tile a) ∩ FootprintVertices (P.tile b)) ∧ ∀ (x + : GaussianInt), ∀ (y : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List + GaussianInt), P.facePath f g = l₁ ++ x :: y :: l₂ → {x, y} ∈ FootprintEdges (P.tile a) ∩ + FootprintEdges (P.tile b)) → (P.facePath f g ≠ []) := by + classical + intro ι P a b hab first second f other g hspec he + rw [he] at hspec + simp at hspec + +end DualEdgeDetails + +namespace DualHalfSpecification + +private theorem halfSpecification : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let first (a b : ι) (hab : P.plane.adjacent a + b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + let other (f : P.plane.Face) (a b : ι) (hab : P.plane.adjacent a b) := + @ite P.plane.Face (f = first a b hab) (Classical.propDecidable _) + (second a b hab) (first a b hab) + let port (a b : ι) : Real × Real := + if hab : P.plane.adjacent a b then + P3776T1WalkMap (P.facePath (first a b hab) (second a b hab)) + ⟨1 / 2, by norm_num⟩ + else 0 + let half (f : P.plane.Face) (a b : ι) (t : Set.Icc (0 : Real) 1) : Real × Real := + if hab : P.plane.adjacent a b then + P3776T1WalkMap (P.facePath f (other f a b hab)) + ⟨(t : Real) / 2, by constructor <;> linarith [t.2.1, t.2.2]⟩ + else 0 + (∀ (a : ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), first a b hab ≠ second a b hab ∧ + (∃ i, P.plane.faceVertex (first a b hab) i = a) ∧ (∃ i, P.plane.faceVertex (first a b + hab) i = b) ∧ (∃ i, P.plane.faceVertex (second a b hab) i = a) ∧ (∃ i, + P.plane.faceVertex (second a b hab) i = b) ∧ ∀ h : P.plane.Face, ((∃ i, + P.plane.faceVertex h i = a) ∧ (∃ i, P.plane.faceVertex h i = b)) → h = first a b hab + ∨ h = second a b hab) → ((∀ (p : List GaussianInt), (p ≠ []) → (P3776T1WalkMap p ⟨1 + / 2, by norm_num⟩ = + P3776T1WalkMap p.reverse ⟨1 / 2, by norm_num⟩)) → ((∀ (f : P.plane.Face), ∀ (a : + ι), ∀ (b : ι), ∀ (hab : P.plane.adjacent a b), (∃ i, P.plane.faceVertex f i = a) + → ((∃ i, P.plane.faceVertex f i = b) → (other f a b hab ≠ f ∧ (∃ i, + P.plane.faceVertex (other f a b hab) i = a) ∧ (∃ i, P.plane.faceVertex (other f a + b hab) i = b)))) → (∀ f, ∀ a, ∀ b, P.plane.adjacent a b → + (∃ i, P.plane.faceVertex f i = a) → + (∃ i, P.plane.faceVertex f i = b) → + Continuous (half f a b) ∧ + half f a b ⟨0, by norm_num⟩ = GaussianRealPoint (P.rho f) ∧ + half f a b ⟨1, by norm_num⟩ = port a b ∧ + (∀ t, half f a b t ∈ TileRealization (P.tile a) ∩ TileRealization (P.tile b)) ∧ + (∀ t, half f a b t = half f b a t) ∧ + ∃ g, g ≠ f ∧ (∃ i, P.plane.faceVertex g i = a) ∧ + (∃ i, P.plane.faceVertex g i = b) ∧ + ∀ t, half f a b t = P3776T1WalkMap (P.facePath f g) + ⟨(t : Real) / 2, by constructor <;> linarith [t.2.1, t.2.2]⟩)))) := by + classical + intro ι P first second other port half pair_spec midpoint_reverse other_spec f a b hab hfa hfb + have hpairs := pair_spec a b hab + have hother := other_spec f a b hab hfa hfb + obtain ⟨hhead, hlast, hvertices, hedges⟩ := + P.facePath_spec a b hab f (other f a b hab) hother.1.symm hfa hfb + hother.2.1 hother.2.2 + have hnonempty : P.facePath f (other f a b hab) ≠ [] := DualEdgeDetails.hnonempty ι P a b hab + f hhead + obtain ⟨hcontinuous, hzero, _, _, _, hsupport⟩ := + P3776T1WalkMapProperties _ hnonempty + have hfirstpoint : + (P.facePath f (other f a b hab)).getD 0 0 = P.rho f := DualEdgeDetails.hfirstpoint ι P a + b hab f hhead + refine ⟨?_, ?_, ?_, ?_, ?_, other f a b hab, + hother.1, hother.2.1, hother.2.2, ?_⟩ + · have hparameter : Continuous (fun t : Set.Icc (0 : Real) 1 => + (⟨(t : Real) / 2, by constructor <;> linarith [t.2.1, t.2.2]⟩ : + Set.Icc (0 : Real) 1)) := DualEdgeDetails.hparameter + simpa only [half, dite_eq_left hab, Function.comp_def] using hcontinuous.comp hparameter + · rw [hfirstpoint] at hzero + simpa only [half, dite_eq_left hab, zero_div] using hzero + · have hparam : + (⟨(⟨1, by norm_num⟩ : Set.Icc (0 : Real) 1) / 2, + by constructor <;> norm_num⟩ : Set.Icc (0 : Real) 1) = + (⟨1 / 2, by norm_num⟩ : Set.Icc (0 : Real) 1) := DualEdgeDetails.hparam + have hf := hpairs.2.2.2.2.2 f ⟨hfa, hfb⟩ + have hneq := hpairs.1 + simp only [half, port, dite_eq_left hab] + rw [hparam] + change f = first a b hab ∨ f = second a b hab at hf + rcases hf with hf | hf + · rw [hf] + simp only [other, ite_eq_left rfl] + · rw [hf] + have hneq' : ¬ second a b hab = first a b hab := fun h => hneq h.symm + simp only [other, ite_eq_right hneq'] + have hnon' : P.facePath (second a b hab) (first a b hab) ≠ [] := by + simpa [hf, other, hneq'] using hnonempty + have hmr := midpoint_reverse (P.facePath (second a b hab) + (first a b hab)) hnon' + have hpathrev : P.facePath (second a b hab) (first a b hab) = + (P.facePath (first a b hab) (second a b hab)).reverse := + P.facePath_reverse _ _ + calc + P3776T1WalkMap (P.facePath (second a b hab) (first a b hab)) + ⟨1 / 2, by norm_num⟩ = + P3776T1WalkMap (P.facePath (second a b hab) (first a b hab)).reverse + ⟨1 / 2, by norm_num⟩ := hmr + _ = P3776T1WalkMap (P.facePath (first a b hab) (second a b hab)) + ⟨1 / 2, by norm_num⟩ := by rw [hpathrev, List.reverse_reverse] + · intro t + simp only [half, dite_eq_left hab] + exact ⟨hsupport (P.tile a) (P.tiles_are_disks a) + (fun z hz => (hvertices z hz).1) + (fun x y l₁ l₂ h => (hedges x y l₁ l₂ h).1) _, + hsupport (P.tile b) (P.tiles_are_disks b) + (fun z hz => (hvertices z hz).2) + (fun x y l₁ l₂ h => (hedges x y l₁ l₂ h).2) _⟩ + · intro t + have hba : P.plane.adjacent b a := (P.plane.adjacent_symmetric a b).mp hab + have hotherBA := other_spec f b a hba hfb hfa + have hp := pair_spec a b hab + have hf := hp.2.2.2.2.2 f ⟨hfa, hfb⟩ + have hcand := hp.2.2.2.2.2 (other f b a hba) + ⟨hotherBA.2.2, hotherBA.2.1⟩ + have hotherEq : other f b a hba = other f a b hab := DualEdgesProof.hotherEq ι P a b hab f + hba hotherBA hp hf hcand + simp only [half, dite_eq_left hab, dite_eq_left hba] + rw [hotherEq] + · intro t + simp only [half, dite_eq_left hab] + +end DualHalfSpecification + +theorem P3776T1DualEdgesExist {ι : Type} (P : PeriodicTileCore ι) : + Nonempty (P3776T1DualEdges P) := by +-- BODY + classical + let first (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a b hab) + let second (a b : ι) (hab : P.plane.adjacent a b) : P.plane.Face := + Classical.choose (Classical.choose_spec (P.plane.every_edge_two_faces a b hab)) + let other (f : P.plane.Face) (a b : ι) (hab : P.plane.adjacent a b) := + @ite P.plane.Face (f = first a b hab) (Classical.propDecidable _) + (second a b hab) (first a b hab) + let port (a b : ι) : Real × Real := + if hab : P.plane.adjacent a b then + P3776T1WalkMap (P.facePath (first a b hab) (second a b hab)) + ⟨1 / 2, by norm_num⟩ + else 0 + let half (f : P.plane.Face) (a b : ι) (t : Set.Icc (0 : Real) 1) : Real × Real := + if hab : P.plane.adjacent a b then + P3776T1WalkMap (P.facePath f (other f a b hab)) + ⟨(t : Real) / 2, by constructor <;> linarith [t.2.1, t.2.2]⟩ + else 0 + have pair_spec (a b : ι) (hab : P.plane.adjacent a b) : + first a b hab ≠ second a b hab ∧ + (∃ i, P.plane.faceVertex (first a b hab) i = a) ∧ + (∃ i, P.plane.faceVertex (first a b hab) i = b) ∧ + (∃ i, P.plane.faceVertex (second a b hab) i = a) ∧ + (∃ i, P.plane.faceVertex (second a b hab) i = b) ∧ + ∀ h : P.plane.Face, + ((∃ i, P.plane.faceVertex h i = a) ∧ + (∃ i, P.plane.faceVertex h i = b)) → + h = first a b hab ∨ h = second a b hab := DualEdgesProof.pair_spec ι P a b hab + have midpoint_reverse (p : List GaussianInt) (hp : p ≠ []) : + P3776T1WalkMap p ⟨1 / 2, by norm_num⟩ = + P3776T1WalkMap p.reverse ⟨1 / 2, by norm_num⟩ := DualEdgesProof.midpoint_reverse p hp + have other_spec (f : P.plane.Face) (a b : ι) + (hab : P.plane.adjacent a b) (hfa : ∃ i, P.plane.faceVertex f i = a) + (hfb : ∃ i, P.plane.faceVertex f i = b) : + other f a b hab ≠ f ∧ + (∃ i, P.plane.faceVertex (other f a b hab) i = a) ∧ + (∃ i, P.plane.faceVertex (other f a b hab) i = b) := DualEdgesProof.other_spec ι P + pair_spec f a b hab hfa hfb + have faceShift_injective (u : P.lattice) : Function.Injective (P.faceShift u) := + DualEdgeDetails.faceShift_injective ι P u + have shifted_incidence (u : P.lattice) (f : P.plane.Face) (a : ι) + (ha : ∃ i, P.plane.faceVertex f i = a) : + ∃ i, P.plane.faceVertex (P.faceShift u f) i = P.shift u a := + DualEdgeDetails.shifted_incidence ι P u f a ha + have unshifted_incidence (u : P.lattice) (f : P.plane.Face) (a : ι) + (ha : ∃ i, P.plane.faceVertex f i = P.shift u a) : + ∃ i, P.plane.faceVertex (P.faceShift (-u) f) i = a := DualEdgeDetails.unshifted_incidence ι + P u f a ha + have faceShift_cancel (u : P.lattice) (f : P.plane.Face) : + P.faceShift u (P.faceShift (-u) f) = f := DualEdgeDetails.faceShift_cancel ι P u f + have faceShift_cancel' (u : P.lattice) (f : P.plane.Face) : + P.faceShift (-u) (P.faceShift u f) = f := DualEdgeDetails.faceShift_cancel' ι P u f + have walk_translate (p : List GaussianInt) (hp : p ≠ []) + (u : P.lattice) (t : Set.Icc (0 : Real) 1) : + P3776T1WalkMap (p.map (fun z => z + (u : GaussianInt))) t = + P3776T1WalkMap p t + GaussianRealPoint u := DualEdgeDetails.walk_translate ι P p hp u t + refine ⟨{ + port := port + half := half + port_symmetric := ?_ + port_support := ?_ + port_periodic := ?_ + half_spec := ?_ + half_periodic := ?_ }⟩ + · intro a b hab + have hba : P.plane.adjacent b a := (P.plane.adjacent_symmetric a b).mp hab + have hp := pair_spec a b hab + have hq := pair_spec b a hba + have hfirst : first b a hba = first a b hab ∨ + first b a hba = second a b hab := DualEdgeDetails.hfirstAt497 ι P a b hab hba hp hq + have hsecond : second b a hba = first a b hab ∨ + second b a hba = second a b hab := DualEdgeDetails.hsecondAt501 ι P a b hab hba hp hq + have hswap : (first b a hba = first a b hab ∧ + second b a hba = second a b hab) ∨ + (first b a hba = second a b hab ∧ + second b a hba = first a b hab) := DualEdgesProof.hswap ι P a b hab hba hq hfirst hsecond + unfold port + simp only [dite_eq_left hab, dite_eq_left hba] + rcases hswap with ⟨hf, hg⟩ | ⟨hf, hg⟩ + · rw [hf, hg] + · rw [hf, hg] + let p := P.facePath (first a b hab) (second a b hab) + have hhead := (P.facePath_spec a b hab (first a b hab) + (second a b hab) hp.1 hp.2.1 hp.2.2.1 hp.2.2.2.1 hp.2.2.2.2.1).1 + have hne : p ≠ [] := DualEdgeDetails.hneAt517 ι P a b hab hhead + obtain ⟨_, _, _, hrev, _, _⟩ := P3776T1WalkMapProperties p hne + have hpathrev : P.facePath (second a b hab) (first a b hab) = + (P.facePath (first a b hab) (second a b hab)).reverse := + P.facePath_reverse _ _ + rw [hpathrev] + let t : Set.Icc (0 : Real) 1 := ⟨1 / 2, by norm_num⟩ + have heq : P3776T1WalkMap p t = + P3776T1WalkMap p ⟨1 - (t : Real), by constructor <;> norm_num⟩ := + congrArg (P3776T1WalkMap p) (DualEdgeDetails.ht) + exact heq.trans (hrev t).symm + · intro a b hab + have hp := pair_spec a b hab + obtain ⟨_, _, hvertices, hedges⟩ := P.facePath_spec a b hab + (first a b hab) (second a b hab) hp.1 hp.2.1 hp.2.2.1 + hp.2.2.2.1 hp.2.2.2.2.1 + have hhead := P.facePath_spec a b hab (first a b hab) (second a b hab) + hp.1 hp.2.1 hp.2.2.1 hp.2.2.2.1 hp.2.2.2.2.1 + have hne : P.facePath (first a b hab) (second a b hab) ≠ [] := DualEdgeDetails.hneAt542 ι P a + b hab hhead + obtain ⟨_, _, _, _, _, hsupport⟩ := + P3776T1WalkMapProperties _ hne + unfold port + simp only [dite_eq_left hab] + exact ⟨hsupport (P.tile a) (P.tiles_are_disks a) + (fun z hz => (hvertices z hz).1) + (fun x y l₁ l₂ h => (hedges x y l₁ l₂ h).1) _, + hsupport (P.tile b) (P.tiles_are_disks b) + (fun z hz => (hvertices z hz).2) + (fun x y l₁ l₂ h => (hedges x y l₁ l₂ h).2) _⟩ + · intro u a b hab + have hab' : P.plane.adjacent (P.shift u a) (P.shift u b) := + (P.edge_periodic u a b).mpr hab + have hp := pair_spec a b hab + have hq := pair_spec (P.shift u a) (P.shift u b) hab' + let f := first a b hab + let g := second a b hab + let f' := P.faceShift u f + let g' := P.faceShift u g + have hfg : f' ≠ g' := DualEdgeDetails.hfgAt566 ι P a b hab faceShift_injective u hp + have hfirst : first (P.shift u a) (P.shift u b) hab' = f' ∨ + first (P.shift u a) (P.shift u b) hab' = g' := DualEdgesProof.hfirstAt289 ι P a b hab + unshifted_incidence faceShift_cancel u hab' hp hq + have hsecond : second (P.shift u a) (P.shift u b) hab' = f' ∨ + second (P.shift u a) (P.shift u b) hab' = g' := DualEdgesProof.hsecondAt312 ι P a b hab + unshifted_incidence faceShift_cancel u hab' hp hq + have horder : + (first (P.shift u a) (P.shift u b) hab' = f' ∧ + second (P.shift u a) (P.shift u b) hab' = g') ∨ + (first (P.shift u a) (P.shift u b) hab' = g' ∧ + second (P.shift u a) (P.shift u b) hab' = f') := DualEdgesProof.horder ι P a b hab u + hab' hq hfirst hsecond + have hspec := P.facePath_spec a b hab f g hp.1 hp.2.1 hp.2.2.1 + hp.2.2.2.1 hp.2.2.2.2.1 + have hpne : P.facePath f g ≠ [] := DualEdgeDetails.hpneAt583 ι P a b hab hspec + have hpath : P.facePath f' g' = + (P.facePath f g).map (fun z => z + (u : GaussianInt)) := DualEdgeDetails.hpath ι P a b hab u + simp only [port, dite_eq_left hab, dite_eq_left hab'] + rcases horder with ⟨hf, hg⟩ | ⟨hf, hg⟩ + · rw [hf, hg, hpath] + exact walk_translate (P.facePath f g) hpne u ⟨1 / 2, by norm_num⟩ + · rw [hf, hg] + have hrevpath : P.facePath g' f' = (P.facePath f' g').reverse := + P.facePath_reverse f' g' + calc + P3776T1WalkMap (P.facePath g' f') ⟨1 / 2, by norm_num⟩ = + P3776T1WalkMap (P.facePath f' g').reverse ⟨1 / 2, by norm_num⟩ := by + rw [hrevpath] + _ = P3776T1WalkMap (P.facePath f' g') ⟨1 / 2, by norm_num⟩ := + (midpoint_reverse (P.facePath f' g') (DualEdgeDetails.hpathne ι P a b hab u hpne + hpath)).symm + _ = P3776T1WalkMap + ((P.facePath f g).map (fun z => z + (u : GaussianInt))) + ⟨1 / 2, by norm_num⟩ := by rw [hpath] + _ = P3776T1WalkMap (P.facePath f g) ⟨1 / 2, by norm_num⟩ + + GaussianRealPoint u := walk_translate (P.facePath f g) hpne u + ⟨1 / 2, by norm_num⟩ + · exact DualHalfSpecification.halfSpecification ι P pair_spec midpoint_reverse other_spec + · intro u f a b hab hfa hfb t + have hab' : P.plane.adjacent (P.shift u a) (P.shift u b) := + (P.edge_periodic u a b).mpr hab + let g := other f a b hab + let f' := P.faceShift u f + let g' := P.faceShift u g + have hother := other_spec f a b hab hfa hfb + have hfg : f' ≠ g' := DualEdgeDetails.hfgAt699 ι P a b hab f faceShift_injective u hother + have hf'a := shifted_incidence u f a hfa + have hf'b := shifted_incidence u f b hfb + have hg'a := shifted_incidence u g a hother.2.1 + have hg'b := shifted_incidence u g b hother.2.2 + have hlhs := other_spec f' (P.shift u a) (P.shift u b) hab' hf'a hf'b + have hq := pair_spec (P.shift u a) (P.shift u b) hab' + have hfchoice := hq.2.2.2.2.2 f' ⟨hf'a, hf'b⟩ + have hlchoice := hq.2.2.2.2.2 + (other f' (P.shift u a) (P.shift u b) hab') + ⟨hlhs.2.1, hlhs.2.2⟩ + have hgchoice := hq.2.2.2.2.2 g' ⟨hg'a, hg'b⟩ + have hother_shift : other f' (P.shift u a) (P.shift u b) hab' = g' := + DualEdgesProof.hother_shift ι P a b hab f faceShift_injective u hab' hother hlhs hfchoice + hlchoice hgchoice + have hspec := P.facePath_spec a b hab f g hother.1.symm hfa hfb + hother.2.1 hother.2.2 + have hpne : P.facePath f g ≠ [] := DualEdgeDetails.hpneAt718 ι P a b hab f hspec + simp only [half, dite_eq_left hab', dite_eq_left hab] + rw [hother_shift, P.facePath_periodic] + exact walk_translate (P.facePath f g) hpne u + ⟨(t : Real) / 2, by constructor <;> linarith [t.2.1, t.2.2]⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1EquivariantDisplacementBound.lean b/LeanPool/ApollonianSuperharmonic/P3776T1EquivariantDisplacementBound.lean new file mode 100644 index 0000000000..0f612cef62 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1EquivariantDisplacementBound.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeFundamentalSet +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import Mathlib.Topology.MetricSpace.ProperSpace +public import Mathlib.Analysis.Normed.Group.Bounded +public import Mathlib.Analysis.Normed.Group.Real +public import Mathlib.Algebra.Order.Floor.Ring +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P3776T1EquivariantDisplacementBound] + +/-! +# P3776T1EquivariantDisplacementBound + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3776T1EquivariantDisplacementBound + (L : AddSubgroup GaussianInt) (R : Finset GaussianInt) + (hR : LatticeFundamentalSet L R) + (f : (Real × Real) → (Real × Real)) (hf : Continuous f) + (hperiodic : ∀ u : L, ∀ x, f (x + GaussianRealPoint u) = f x + GaussianRealPoint u) : + ∃ M : Real, 0 ≤ M ∧ ∀ x, dist (f x) x ≤ M := by +-- BODY + classical + let A : Set (Real × Real) := Set.Icc (0 : Real) 1 ×ˢ Set.Icc (0 : Real) 1 + let Q : Set (Real × Real) := ⋃ r ∈ R, (fun v => v + GaussianRealPoint r) '' A + have hA : IsCompact A := isCompact_Icc.prod isCompact_Icc + have hQ : IsCompact Q := R.isCompact_biUnion fun r _ => + hA.image (continuous_id.add continuous_const) + obtain ⟨M, hM, hbound⟩ := + (hQ.image (hf.dist continuous_id)).isBounded.exists_pos_norm_le + refine ⟨M, hM.le, ?_⟩ + intro x + let n : GaussianInt := ⟨Int.floor x.1, Int.floor x.2⟩ + let v : Real × Real := x - GaussianRealPoint n + have hv : v ∈ A := by + change (0 ≤ x.1 - (Int.floor x.1 : Real) ∧ x.1 - (Int.floor x.1 : Real) ≤ 1) ∧ + (0 ≤ x.2 - (Int.floor x.2 : Real) ∧ x.2 - (Int.floor x.2 : Real) ≤ 1) + constructor <;> constructor + · linarith [Int.floor_le x.1] + · linarith [Int.lt_floor_add_one x.1] + · linarith [Int.floor_le x.2] + · linarith [Int.lt_floor_add_one x.2] + obtain ⟨r, ⟨hr, hnr⟩, _⟩ := hR n + let u : L := ⟨n - r, hnr⟩ + let y : Real × Real := x - GaussianRealPoint u + have hpoint : GaussianRealPoint (n - r) = GaussianRealPoint n - GaussianRealPoint r := by + ext <;> simp [GaussianRealPoint] + have hy : y ∈ Q := by + apply Set.mem_iUnion.mpr + refine ⟨r, Set.mem_iUnion.mpr ⟨hr, ?_⟩⟩ + refine ⟨v, hv, ?_⟩ + change x - GaussianRealPoint n + GaussianRealPoint r = x - GaussianRealPoint (n - r) + rw [hpoint] + abel + have hxy : y + GaussianRealPoint u = x := sub_add_cancel x _ + have hp : f x = f y + GaussianRealPoint u := by + rw [← hxy] + exact hperiodic u y + have hdist : dist (f y) y ≤ M := by + simpa [Real.norm_eq_abs, abs_of_nonneg dist_nonneg] using + hbound _ ⟨y, hy, rfl⟩ + rw [hp, ← hxy] + simpa [Prod.dist_eq, Real.dist_eq] using hdist + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1FixedGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3776T1FixedGeometry.lean new file mode 100644 index 0000000000..4dafe3da77 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1FixedGeometry.lean @@ -0,0 +1,793 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3776T1OpenStar +public import LeanPool.ApollonianSuperharmonic.P3767T1FixedFaceComponents +public import Mathlib.Topology.Compactness.LocallyFinite +public import Mathlib.Topology.MetricSpace.ProperSpace +public import Mathlib.Analysis.Normed.Group.Bounded +public import Mathlib.Analysis.Normed.Group.Real +public import Mathlib.Analysis.Normed.Group.Constructions +public import Mathlib.Topology.Order.IntermediateValue +public import Mathlib.Topology.Algebra.Group.Basic +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Tauto +public import Mathlib.Data.Int.Interval +public import Mathlib.Algebra.Order.Floor.Ring + +-- [TABLET NODE: P3776T1FixedGeometry] + +/-! +# P3776T1FixedGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FixedPeriodicGeometryProof + +private theorem hfree : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (u : P.lattice), ∀ (v : P.lattice), ∀ (a : ι), + (P.shift u a = P.shift v a) → (u = v) := by + classical + intro ι P u v a h + have hpos := congrArg P.plane.position h + rw [P.position_periodic u a, P.position_periodic v a] at hpos + have hvec : GaussianRealPoint (u : GaussianInt) = + GaussianRealPoint (v : GaussianInt) := add_left_cancel hpos + simp only [GaussianRealPoint, Prod.mk.injEq] at hvec + apply Subtype.ext + apply Zsqrtd.ext + · exact_mod_cast hvec.1 + · exact_mod_cast hvec.2 + +private theorem hnonzero : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∃ u : P.lattice, u ≠ 0 := by + classical + intro ι P + by_contra h + have hz : ∀ u : P.lattice, u = 0 := by simpa using h + have hrep : ∀ x : GaussianInt, x ∈ P.latticeReps := by + intro x + obtain ⟨r, ⟨hr, hxr⟩, _⟩ := P.lattice_full_rank x + have heq : x - r = 0 := congrArg Subtype.val (hz ⟨x - r, hxr⟩) + simpa [sub_eq_zero.mp heq] using hr + have hinj : Function.Injective (fun n : ℕ => (n : GaussianInt)) := + Nat.cast_injective + have hfinite := P.latticeReps.finite_toSet.preimage hinj.injOn + have hall : (fun n : ℕ => (n : GaussianInt)) ⁻¹' + (P.latticeReps : Set GaussianInt) = Set.univ := by + ext n + simp [hrep] + rw [hall] at hfinite + exact Set.infinite_univ hfinite + +private theorem hinhab : + ∀ (ι : Type), (PeriodicTileCore ι) → (Nonempty ι) := by + classical + intro ι P + have hcover : (0 : Real × Real) ∈ + Set.range P.plane.position ∪ + {p | ∃ a b, P.plane.adjacent a b ∧ p ∈ P.plane.edgeArc a b} ∪ + {p | ∃ f, p ∈ P.plane.faceRegion f} := by + rw [P.plane.plane_cover] + trivial + rcases hcover with (⟨a, _⟩ | ⟨a, b, _⟩) | ⟨f, _⟩ + · exact ⟨a⟩ + · exact ⟨a⟩ + · exact ⟨P.plane.faceVertex f 0⟩ + +private theorem harc : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), (P.plane.adjacent a b) → + (IsCompact (P.plane.edgeArc a b)) := by + classical + intro ι P a b hab + obtain ⟨h, _, _⟩ := P.plane.arc_homeomorph a b hab + have : CompactSpace (Set.Icc (0 : Real) 1) := inferInstance + have hs : Set.range (fun t : Set.Icc (0 : Real) 1 => + ((h t : P.plane.edgeArc a b) : Real × Real)) = P.plane.edgeArc a b := by + ext x + constructor + · rintro ⟨t, rfl⟩ + exact (h t).property + · intro hx + exact ⟨h.symm ⟨x, hx⟩, by simp⟩ + rw [← hs] + exact isCompact_range (continuous_subtype_val.comp h.continuous) + +private theorem hexterior : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), (∃ u : P.lattice, u ≠ 0) → (∀ (B : Real), + IsPreconnected {x : Real × Real | B < ‖x‖}) := by + classical + intro ι P hnonzero B + let R : Set (Real × Real) := Set.Ioi B ×ˢ Set.univ + let T : Set (Real × Real) := Set.univ ×ˢ Set.Ioi B + let L : Set (Real × Real) := Set.Iio (-B) ×ˢ Set.univ + let D : Set (Real × Real) := Set.univ ×ˢ Set.Iio (-B) + have hR : IsPreconnected R := isPreconnected_Ioi.prod isPreconnected_univ + have hT : IsPreconnected T := isPreconnected_univ.prod isPreconnected_Ioi + have hL : IsPreconnected L := isPreconnected_Iio.prod isPreconnected_univ + have hD : IsPreconnected D := isPreconnected_univ.prod isPreconnected_Iio + have hRT : IsPreconnected (R ∪ T) := + hR.union' ⟨(B + 1, B + 1), by simp [R, T]⟩ hT + have hRTL : IsPreconnected (R ∪ T ∪ L) := + hRT.union' ⟨(-B - 1, B + 1), by simp [R, T, L]⟩ hL + have hRTLD : IsPreconnected (R ∪ T ∪ L ∪ D) := + hRTL.union' ⟨(-B - 1, -B - 1), by simp [R, T, L, D]⟩ hD + have heq : {x : Real × Real | B < ‖x‖} = R ∪ T ∪ L ∪ D := by + ext x + simp only [Set.mem_ofPred_eq, Prod.norm_def, Real.norm_eq_abs, lt_max_iff, + lt_abs, Set.mem_union, R, T, L, D, Set.mem_prod, Set.mem_Ioi, + Set.mem_Iio, Set.mem_univ, and_true, true_and] + have h1 : B < -x.1 ↔ x.1 < -B := by constructor <;> intro h <;> linarith + have h2 : B < -x.2 ↔ x.2 < -B := by constructor <;> intro h <;> linarith + rw [h1, h2] + tauto + rw [heq] + exact hRTLD + +private theorem hcompact : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), (∃ u : P.lattice, u ≠ 0) → ((∀ (u : P.lattice), ∀ + (f : P.plane.Face), (P.faceShift u f = f) → (u = 0)) → ((∀ (f : P.plane.Face), IsCompact + (frontier (P.plane.faceRegion f))) → ((∀ (B : Real), IsPreconnected {x : Real × Real | B + < ‖x‖}) → (∀ (f : P.plane.Face), IsCompact (closure (P.plane.faceRegion f)))))) := by + classical + intro ι P hnonzero hfacefree hfront hexterior f + apply Bornology.IsBounded.isCompact_closure + by_contra hunbounded + obtain ⟨B, hB, hbound⟩ := (hfront f).isBounded.exists_pos_norm_le + have hmeet : ({x : Real × Real | B < ‖x‖} ∩ P.plane.faceRegion f).Nonempty := by + by_contra h + apply hunbounded + apply isBounded_iff_forall_norm_le.mpr + refine ⟨B, fun x hx => ?_⟩ + by_contra hle + exact h ⟨x, lt_of_not_ge hle, hx⟩ + have houtside : {x : Real × Real | B < ‖x‖} ⊆ P.plane.faceRegion f := + P3767T1BarrierRegionMaximal _ _ _ (P.plane.region_open f) + (Set.Subset.refl _) (hexterior B) + (Set.disjoint_left.mpr (fun x hx hxf => (not_lt_of_ge (hbound x hxf)) hx)) hmeet + obtain ⟨u, hu⟩ := hnonzero + let y : Real × Real := (B + |(GaussianRealPoint u).1| + 1, 0) + have hy : B < ‖y‖ := by + have hh : B < ‖y.1‖ := by + change B < |B + |(GaussianRealPoint u).1| + 1| + linarith [le_abs_self (B + |(GaussianRealPoint u).1| + 1), + abs_nonneg (GaussianRealPoint u).1] + exact hh.trans_le (norm_fst_le y) + have hyu : B < ‖y - GaussianRealPoint u‖ := by + have hfst := norm_fst_le (y - GaussianRealPoint u) + change ‖B + |(GaussianRealPoint u).1| + 1 - (GaussianRealPoint u).1‖ ≤ + ‖y - GaussianRealPoint u‖ at hfst + rw [Real.norm_eq_abs] at hfst + have hh := le_abs_self (B + |(GaussianRealPoint u).1| + 1 - (GaussianRealPoint u).1) + linarith [le_abs_self (GaussianRealPoint u).1] + have hys : y ∈ P.plane.faceRegion (P.faceShift u f) := by + rw [P.faceRegion_periodic] + exact ⟨y - GaussianRealPoint u, houtside hyu, sub_add_cancel _ _⟩ + exact Set.disjoint_left.mp + (P.plane.region_disjoint (fun h => hu (hfacefree u f h.symm))) (houtside hy) hys + +private theorem hfiniteTrans : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (K : Set (Real × Real)), ∀ (A : Set (Real × + Real)), (IsCompact K) → ((IsCompact A) → (Set.Finite {u : P.lattice | + (K ∩ (fun x => x + GaussianRealPoint u) '' A).Nonempty})) := by + classical + intro ι P K A hK hA + obtain ⟨C, _, hC⟩ := hK.isBounded.exists_pos_norm_le + obtain ⟨D, _, hD⟩ := hA.isBounded.exists_pos_norm_le + let N : ℤ := Int.ceil (C + D) + have hN : C + D ≤ (N : Real) := Int.le_ceil _ + have hinj : Function.Injective (fun u : P.lattice => + ((u : GaussianInt).re, (u : GaussianInt).im)) := by + intro u v h + apply Subtype.ext + exact Zsqrtd.ext (congrArg Prod.fst h) (congrArg Prod.snd h) + apply (((Set.finite_Icc (-N) N).prod (Set.finite_Icc (-N) N)).preimage hinj.injOn).subset + rintro u ⟨x, hx, y, hy, hxy⟩ + have hv : GaussianRealPoint u = x - y := by + have hh : y + GaussianRealPoint u = x := hxy + rw [← hh] + exact (add_sub_cancel_left y (GaussianRealPoint u)).symm + have hb : ‖GaussianRealPoint u‖ ≤ C + D := by + rw [hv] + exact (norm_sub_le x y).trans (add_le_add (hC x hx) (hD y hy)) + have hre : |((u : GaussianInt).re : Real)| ≤ (N : Real) := + (norm_fst_le (GaussianRealPoint u)).trans (hb.trans hN) + have him : |((u : GaussianInt).im : Real)| ≤ (N : Real) := + (norm_snd_le (GaussianRealPoint u)).trans (hb.trans hN) + change (-N ≤ (u : GaussianInt).re ∧ (u : GaussianInt).re ≤ N) ∧ + (-N ≤ (u : GaussianInt).im ∧ (u : GaussianInt).im ≤ N) + constructor + · constructor + · exact_mod_cast (abs_le.mp hre).1 + · exact_mod_cast (abs_le.mp hre).2 + · constructor + · exact_mod_cast (abs_le.mp him).1 + · exact_mod_cast (abs_le.mp him).2 + +private theorem hfiniteFace : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), (∀ (f : P.plane.Face), IsCompact (closure + (P.plane.faceRegion f))) → ((∀ (K : Set (Real × Real)), ∀ (A : Set (Real × Real)), + (IsCompact K) → ((IsCompact A) → (Set.Finite {u : P.lattice | (K ∩ (fun x => x + + GaussianRealPoint u) '' A).Nonempty}))) → ((∀ (u : P.lattice), ∀ (f : P.plane.Face), + closure (P.plane.faceRegion (P.faceShift u f)) = (fun x => x + GaussianRealPoint u) '' + closure (P.plane.faceRegion f)) → (∀ (K : Set (Real × Real)), (IsCompact K) → (Set.Finite + {f | (K ∩ closure (P.plane.faceRegion f)).Nonempty})))) := by + classical + intro ι P hcompact hfiniteTrans hclosurePeriodic K hK + have hrep : Set.Finite (⋃ r ∈ P.faceOrbitReps, + (fun u => P.faceShift u r) '' {u : P.lattice | + (K ∩ (fun x => x + GaussianRealPoint u) '' + closure (P.plane.faceRegion r)).Nonempty}) := + P.faceOrbitReps.finite_toSet.biUnion fun r _ => + (hfiniteTrans K _ hK (hcompact r)).image (fun u => P.faceShift u r) + apply hrep.subset + intro f hf + obtain ⟨r, hr, u, rfl⟩ := P.face_orbit_representatives f + refine Set.mem_iUnion.mpr ⟨r, Set.mem_iUnion.mpr ⟨hr, ?_⟩⟩ + refine ⟨u, ?_, rfl⟩ + change (K ∩ closure (P.plane.faceRegion (P.faceShift u r))).Nonempty at hf + rwa [hclosurePeriodic] at hf + +private theorem hboundaryEdge : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (f : P.plane.Face), ∀ (i : Fin 3), ∀ (j : Fin 3), + (i ≠ j) → (P.plane.edgeArc (P.plane.faceVertex f i) (P.plane.faceVertex f j) ⊆ + frontier (P.plane.faceRegion f)) := by + classical + intro ι P f i j hij + rw [P.plane.face_boundary f] + fin_cases i <;> fin_cases j <;> dsimp at * + all_goals try exact (hij rfl).elim + all_goals intro x hx + all_goals first + | exact Or.inl (Or.inl hx) + | exact Or.inl (Or.inr hx) + | exact Or.inr hx + | rw [P.plane.arc_symmetric] at hx + first + | exact Or.inl (Or.inl hx) + | exact Or.inl (Or.inr hx) + | exact Or.inr hx + +private theorem hedgeFace : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), (∀ (f : P.plane.Face), ∀ (i : Fin 3), ∀ (j : Fin + 3), (i ≠ j) → (P.plane.edgeArc (P.plane.faceVertex f i) (P.plane.faceVertex f j) ⊆ + frontier (P.plane.faceRegion f))) → (∀ (a : ι), ∀ (b : ι), (P.plane.adjacent a b) → (∃ f + : P.plane.Face, + (∃ i, P.plane.faceVertex f i = a) ∧ + (∃ j, P.plane.faceVertex f j = b) ∧ + P.plane.edgeArc a b ⊆ closure (P.plane.faceRegion f))) := by + classical + intro ι P hboundaryEdge a b hab + obtain ⟨f, _, _, ⟨⟨i, hi⟩, ⟨j, hj⟩⟩, _, _⟩ := + P.plane.every_edge_two_faces a b hab + have hij : i ≠ j := by + intro h + have heq : a = b := hi.symm.trans (h ▸ hj) + exact P.plane.adjacent_irreflexive a (heq ▸ hab) + refine ⟨f, ⟨i, hi⟩, ⟨j, hj⟩, ?_⟩ + rw [← hi, ← hj] + exact (hboundaryEdge f i j hij).trans frontier_subset_closure + +private theorem hcoverAt366 : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ [Nontrivial ι], (∀ (a : ι), ∀ (b : ι), + (P.plane.adjacent a b) → (∃ f : P.plane.Face, (∃ i, P.plane.faceVertex f i = a) ∧ (∃ j, + P.plane.faceVertex f j = b) ∧ P.plane.edgeArc a b ⊆ closure (P.plane.faceRegion f))) → + ((∀ (f : P.plane.Face), ∀ (i : Fin 3), P.plane.position (P.plane.faceVertex f i) ∈ + closure (P.plane.faceRegion f)) → (∀ (x : Real × Real), ∃ f, x ∈ closure + (P.plane.faceRegion f))) := by + classical + intro ι P this hedgeFace hposFace x + have hx : x ∈ Set.range P.plane.position ∪ + {p | ∃ a b, P.plane.adjacent a b ∧ p ∈ P.plane.edgeArc a b} ∪ + {p | ∃ f, p ∈ P.plane.faceRegion f} := by + rw [P.plane.plane_cover] + trivial + rcases hx with (⟨a, rfl⟩ | ⟨a, b, hab, hx⟩) | ⟨f, hx⟩ + · obtain ⟨b, hab⟩ := (P3767T1VertexEdgeIncidence P.plane a).1 + obtain ⟨f, ⟨i, hi⟩, _, _⟩ := hedgeFace a b hab + exact ⟨f, hi ▸ hposFace f i⟩ + · obtain ⟨f, _, _, hs⟩ := hedgeFace a b hab + exact ⟨f, hs hx⟩ + · exact ⟨f, subset_closure hx⟩ + +private theorem harcMatch : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (d : ι), + (P.plane.adjacent a b) → ((P.plane.adjacent c d) → (∀ (x : Real × Real), (x ∈ + P.plane.edgeArc a b) → ((x ≠ P.plane.position a) → ((x ≠ P.plane.position b) → ((x ∈ + P.plane.edgeArc c d) → (({a, b} : Set ι) = {c, d})))))) := by + classical + intro ι P a b c d hab hcd x hx hxa hxb hy + by_contra hne + have hh : x ∈ P.plane.position '' (({a, b} : Set ι) ∩ {c, d}) := by + rw [← P.plane.arc_intersections a b c d hab hcd hne] + exact ⟨hx, hy⟩ + obtain ⟨v, hv, hvx⟩ := hh + rcases Set.mem_insert_iff.mp hv.1 with rfl | hv + · exact hxa hvx.symm + · have hvb : v = b := Set.mem_singleton_iff.mp hv + exact hxb (hvb ▸ hvx.symm) + +private theorem hclosureVertex : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ [Nontrivial ι], (∀ (f : P.plane.Face), + Disjoint (P3767T1FixedTrace P.plane) (P.plane.faceRegion f)) → (∀ (f : P.plane.Face), ∀ + (w : ι), (P.plane.position w ∈ closure (P.plane.faceRegion f)) → (∃ i, P.plane.faceVertex + f i = w)) := by + classical + intro ι P this havoid f w hx + rw [closure_eq_self_union_frontier] at hx + rcases hx with hx | hx + · exact (Set.disjoint_left.mp (havoid f) (Or.inl ⟨w, rfl⟩) hx).elim + · rw [P.plane.face_boundary] at hx + rcases hx with (hx | hx) | hx + · rcases (P3767T1VertexEdgeIncidence P.plane w).2 _ _ + (P.plane.face_edges f 0 1 (by decide)) hx with h | h + · exact ⟨0, h.symm⟩ + · exact ⟨1, h.symm⟩ + · rcases (P3767T1VertexEdgeIncidence P.plane w).2 _ _ + (P.plane.face_edges f 1 2 (by decide)) hx with h | h + · exact ⟨1, h.symm⟩ + · exact ⟨2, h.symm⟩ + · rcases (P3767T1VertexEdgeIncidence P.plane w).2 _ _ + (P.plane.face_edges f 2 0 (by decide)) hx with h | h + · exact ⟨2, h.symm⟩ + · exact ⟨0, h.symm⟩ + +private theorem hclosureEdge : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), (∀ (f : P.plane.Face), Disjoint + (P3767T1FixedTrace P.plane) (P.plane.faceRegion f)) → ((∀ (a : ι), ∀ (b : ι), ∀ (c : + ι), ∀ (d : ι), (P.plane.adjacent a b) → ((P.plane.adjacent c d) → (∀ (x : Real × Real), + (x ∈ P.plane.edgeArc a b) → ((x ≠ P.plane.position a) → ((x ≠ P.plane.position b) → ((x ∈ + P.plane.edgeArc c d) → (({a, b} : Set ι) = {c, d}))))))) → (∀ (f : P.plane.Face), ∀ (a : + ι), ∀ (b : ι), (P.plane.adjacent a b) → (∀ (x : Real × Real), (x ∈ P.plane.edgeArc a b) → + ((x ≠ P.plane.position a) → ((x ≠ P.plane.position b) → ((x ∈ closure (P.plane.faceRegion + f)) → ((∃ i, P.plane.faceVertex f i = a) ∧ (∃ i, P.plane.faceVertex f i = b)))))))) := by + classical + intro ι P havoid harcMatch f a b hab x hx hxa hxb hxf + have hpair (i j : Fin 3) (hij : i ≠ j) + (hy : x ∈ P.plane.edgeArc (P.plane.faceVertex f i) (P.plane.faceVertex f j)) : + (∃ i, P.plane.faceVertex f i = a) ∧ (∃ i, P.plane.faceVertex f i = b) := by + have heq := harcMatch a b _ _ hab (P.plane.face_edges f i j hij) x hx hxa hxb hy + have ha : a ∈ ({P.plane.faceVertex f i, P.plane.faceVertex f j} : Set ι) := + heq ▸ (by simp) + have hb : b ∈ ({P.plane.faceVertex f i, P.plane.faceVertex f j} : Set ι) := + heq ▸ (by simp) + constructor + · rcases Set.mem_insert_iff.mp ha with h | h + · exact ⟨i, h.symm⟩ + · exact ⟨j, (Set.mem_singleton_iff.mp h).symm⟩ + · rcases Set.mem_insert_iff.mp hb with h | h + · exact ⟨i, h.symm⟩ + · exact ⟨j, (Set.mem_singleton_iff.mp h).symm⟩ + rw [closure_eq_self_union_frontier] at hxf + rcases hxf with hxf | hxf + · exact (Set.disjoint_left.mp (havoid f) (Or.inr ⟨a, b, hab, hx⟩) hxf).elim + · rw [P.plane.face_boundary] at hxf + rcases hxf with (hy | hy) | hy + · exact hpair 0 1 (by decide) hy + · exact hpair 1 2 (by decide) hy + · exact hpair 2 0 (by decide) hy + +private theorem hstaropen : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ [Nontrivial ι], (∀ (a : ι), ∀ (b : ι), + (P.plane.adjacent a b) → (IsCompact (P.plane.edgeArc a b))) → ((LocallyFinite (fun f => + closure (P.plane.faceRegion f))) → ((∀ (f : P.plane.Face), ∀ (i : Fin 3), ∀ (j : Fin 3), + (i ≠ j) → (P.plane.edgeArc (P.plane.faceVertex f i) (P.plane.faceVertex f j) ⊆ frontier + (P.plane.faceRegion f))) → ((∀ (f : P.plane.Face), ∀ (i : Fin 3), P.plane.position + (P.plane.faceVertex f i) ∈ closure (P.plane.faceRegion f)) → ((∀ (x : Real × Real), ∃ f, + x ∈ closure (P.plane.faceRegion f)) → ((∀ (f : P.plane.Face), Disjoint + (P3767T1FixedTrace P.plane) (P.plane.faceRegion f)) → ((∀ (a : ι), ∀ (b : ι), ∀ (c : + ι), ∀ (d : ι), (P.plane.adjacent a b) → ((P.plane.adjacent c d) → (∀ (x : Real × Real), + (x ∈ P.plane.edgeArc a b) → ((x ≠ P.plane.position a) → ((x ≠ P.plane.position b) → ((x ∈ + P.plane.edgeArc c d) → (({a, b} : Set ι) = {c, d}))))))) → ((∀ (f : P.plane.Face), ∀ (w : + ι), (P.plane.position w ∈ closure (P.plane.faceRegion f)) → (∃ i, P.plane.faceVertex f i + = w)) → ((∀ (f : P.plane.Face), ∀ (a : ι), ∀ (b : ι), (P.plane.adjacent a b) → (∀ (x : + Real × Real), (x ∈ P.plane.edgeArc a b) → ((x ≠ P.plane.position a) → ((x ≠ + P.plane.position b) → ((x ∈ closure (P.plane.faceRegion f)) → ((∃ i, P.plane.faceVertex f + i = a) ∧ (∃ i, P.plane.faceVertex f i = b))))))) → ((∀ (f : P.plane.Face), ∀ (g : + P.plane.Face), ∀ (x : Real × Real), (x ∈ P.plane.faceRegion f) → ((x ∈ closure + (P.plane.faceRegion g)) → (f = g))) → (∀ (a : ι), IsOpen (P3776T1OpenStar P + a))))))))))) := by + classical + intro ι P this harc hLF hboundaryEdge hposFace hcover havoid harcMatch hclosureVertex + hclosureEdge hclosureRegion a + -- Group the closed nonincident strata by face, so local finiteness is inherited. + let badVertex (f : P.plane.Face) (i : Fin 3) : Set (Real × Real) := + if P.plane.faceVertex f i ≠ a then {P.plane.position (P.plane.faceVertex f i)} else ∅ + let badEdge (f : P.plane.Face) (ij : Fin 3 × Fin 3) : Set (Real × Real) := + if ij.1 ≠ ij.2 ∧ P.plane.faceVertex f ij.1 ≠ a ∧ + P.plane.faceVertex f ij.2 ≠ a then + P.plane.edgeArc (P.plane.faceVertex f ij.1) (P.plane.faceVertex f ij.2) else ∅ + let bad (f : P.plane.Face) : Set (Real × Real) := + (if ¬ ∃ i, P.plane.faceVertex f i = a then closure (P.plane.faceRegion f) else ∅) ∪ + (⋃ i, badVertex f i) ∪ ⋃ ij, badEdge f ij + have hbV (f : P.plane.Face) (i : Fin 3) : + badVertex f i ⊆ closure (P.plane.faceRegion f) := by + by_cases h : P.plane.faceVertex f i = a + · simp [badVertex, h] + · simpa [badVertex, h] using Set.singleton_subset_iff.mpr (hposFace f i) + have hbE (f : P.plane.Face) (ij : Fin 3 × Fin 3) : + badEdge f ij ⊆ closure (P.plane.faceRegion f) := by + dsimp [badEdge] + split_ifs with h + · exact (hboundaryEdge f ij.1 ij.2 h.1).trans frontier_subset_closure + · exact Set.empty_subset _ + have hbsub (f : P.plane.Face) : bad f ⊆ closure (P.plane.faceRegion f) := by + intro x hx + rcases hx with (hx | hx) | hx + · by_cases hf : ∃ i, P.plane.faceVertex f i = a + · simp [hf] at hx + · simpa [hf] using hx + · obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hx + exact hbV f i hi + · obtain ⟨ij, hij⟩ := Set.mem_iUnion.mp hx + exact hbE f ij hij + have hbclosed (f : P.plane.Face) : IsClosed (bad f) := by + have hc : IsClosed + (if ¬ ∃ i, P.plane.faceVertex f i = a then closure (P.plane.faceRegion f) else ∅) := by + by_cases hf : ∃ i, P.plane.faceVertex f i = a + · simp [hf] + · simpa only [hf, not_false_eq_true, ↓reduceIte] using + (isClosed_closure : IsClosed (closure (P.plane.faceRegion f))) + have hv : IsClosed (⋃ i, badVertex f i) := by + apply isClosed_iUnion_of_finite + intro i + by_cases h : P.plane.faceVertex f i = a + · simp [badVertex, h] + · simpa only [badVertex, ite_eq_left h] using + (isClosed_singleton : IsClosed {P.plane.position (P.plane.faceVertex f i)}) + have he : IsClosed (⋃ ij, badEdge f ij) := by + apply isClosed_iUnion_of_finite + intro ij + dsimp [badEdge] + split_ifs with h + · exact (harc _ _ (P.plane.face_edges f ij.1 ij.2 h.1)).isClosed + · exact isClosed_empty + exact (hc.union hv).union he + have hvertexNot (w : ι) (hwa : w ≠ a) : + P.plane.position w ∉ P3776T1OpenStar P a := by + rintro (hx | ⟨b, hab, hx, hxa, hxb⟩ | ⟨f, hf, hx⟩) + · exact hwa (P.plane.position_injective hx) + · rcases (P3767T1VertexEdgeIncidence P.plane w).2 a b hab hx with h | h + · exact hwa h + · exact hxb (congrArg P.plane.position h) + · exact Set.disjoint_left.mp (havoid f) (Or.inl ⟨w, rfl⟩) hx + have hedgeNot (c d : ι) (hcd : P.plane.adjacent c d) + (hca : c ≠ a) (hda : d ≠ a) (x : Real × Real) + (hx : x ∈ P.plane.edgeArc c d) : x ∉ P3776T1OpenStar P a := by + rintro (hxa | ⟨b, hab, hy, hya, hyb⟩ | ⟨f, hf, hy⟩) + · rw [hxa] at hx + rcases (P3767T1VertexEdgeIncidence P.plane a).2 c d hcd hx with h | h + · exact hca h.symm + · exact hda h.symm + · have heq := harcMatch a b c d hab hcd x hy hya hyb hx + have ha : a ∈ ({c, d} : Set ι) := heq ▸ (by simp) + rcases Set.mem_insert_iff.mp ha with h | h + · exact hca h.symm + · exact hda (Set.mem_singleton_iff.mp h).symm + · exact Set.disjoint_left.mp (havoid f) (Or.inr ⟨c, d, hcd, hx⟩) hy + have hbadNot (f : P.plane.Face) : bad f ⊆ (P3776T1OpenStar P a)ᶜ := by + intro x hx hs + rcases hx with (hx | hx) | hx + · have hf : ¬ ∃ i, P.plane.faceVertex f i = a := by + by_contra h + simp [h] at hx + have hxf : x ∈ closure (P.plane.faceRegion f) := by simpa [hf] using hx + rcases hs with hxa | ⟨b, hab, hx, hxa, hxb⟩ | ⟨g, hga, hxg⟩ + · rw [hxa] at hxf + exact hf (hclosureVertex f a hxf) + · exact hf (hclosureEdge f a b hab x hx hxa hxb hxf).1 + · have hgf := hclosureRegion g f x hxg hxf + exact hf (hgf ▸ hga) + · obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hx + by_cases h : P.plane.faceVertex f i = a + · simp [badVertex, h] at hi + · have hxi : x = P.plane.position (P.plane.faceVertex f i) := by + simpa [badVertex, h] using hi + exact hvertexNot _ h (hxi ▸ hs) + · obtain ⟨ij, hij⟩ := Set.mem_iUnion.mp hx + dsimp [badEdge] at hij + split_ifs at hij with h + · exact hedgeNot _ _ (P.plane.face_edges f ij.1 ij.2 h.1) + h.2.1 h.2.2 x hij hs + · exact hij.elim + have hbadArc (f : P.plane.Face) (i j : Fin 3) (hij : i ≠ j) + (x : Real × Real) + (hx : x ∈ P.plane.edgeArc (P.plane.faceVertex f i) (P.plane.faceVertex f j)) + (hs : x ∉ P3776T1OpenStar P a) : x ∈ bad f := by + by_cases hxi : x = P.plane.position (P.plane.faceVertex f i) + · have hia : P.plane.faceVertex f i ≠ a := by + intro h + exact hs (Or.inl (h ▸ hxi)) + apply Or.inl ∘ Or.inr + exact Set.mem_iUnion.mpr ⟨i, by simp [badVertex, hia, hxi]⟩ + by_cases hxj : x = P.plane.position (P.plane.faceVertex f j) + · have hja : P.plane.faceVertex f j ≠ a := by + intro h + exact hs (Or.inl (h ▸ hxj)) + apply Or.inl ∘ Or.inr + exact Set.mem_iUnion.mpr ⟨j, by simp [badVertex, hja, hxj]⟩ + have hia : P.plane.faceVertex f i ≠ a := by + intro h + apply hs + right + left + exact ⟨P.plane.faceVertex f j, h ▸ P.plane.face_edges f i j hij, + h ▸ hx, h ▸ hxi, hxj⟩ + have hja : P.plane.faceVertex f j ≠ a := by + intro h + apply hs + right + left + refine ⟨P.plane.faceVertex f i, h ▸ P.plane.face_edges f j i hij.symm, ?_, h ▸ hxj, hxi⟩ + rw [P.plane.arc_symmetric] + simpa only [h] using hx + right + exact Set.mem_iUnion.mpr ⟨(i, j), by simp [badEdge, hij, hia, hja, hx]⟩ + have heq : (P3776T1OpenStar P a)ᶜ = ⋃ f, bad f := by + ext x + constructor + · intro hs + obtain ⟨f, hxf⟩ := hcover x + apply Set.mem_iUnion.mpr + refine ⟨f, ?_⟩ + by_cases hf : ∃ i, P.plane.faceVertex f i = a + · rw [closure_eq_self_union_frontier] at hxf + rcases hxf with hxr | hxf + · exact (hs (Or.inr (Or.inr ⟨f, hf, hxr⟩))).elim + · rw [P.plane.face_boundary] at hxf + rcases hxf with (hx | hx) | hx + · exact hbadArc f 0 1 (by decide) x hx hs + · exact hbadArc f 1 2 (by decide) x hx hs + · exact hbadArc f 2 0 (by decide) x hx hs + · exact Or.inl (Or.inl (by simpa [hf] using hxf)) + · intro hx + obtain ⟨f, hf⟩ := Set.mem_iUnion.mp hx + exact hbadNot f hf + rw [← isClosed_compl_iff, heq] + exact (hLF.subset hbsub).isClosed_iUnion hbclosed + +private theorem hstarcompact : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ [Nontrivial ι], (∀ (f : P.plane.Face), + IsCompact (closure (P.plane.faceRegion f))) → ((∀ (K : Set (Real × Real)), (IsCompact K) + → (Set.Finite {f | (K ∩ closure (P.plane.faceRegion f)).Nonempty})) → ((∀ (a : ι), ∀ (b : + ι), (P.plane.adjacent a b) → (∃ f : P.plane.Face, (∃ i, P.plane.faceVertex f i = a) ∧ (∃ + j, P.plane.faceVertex f j = b) ∧ P.plane.edgeArc a b ⊆ closure (P.plane.faceRegion f))) → + ((∀ (f : P.plane.Face), ∀ (i : Fin 3), P.plane.position (P.plane.faceVertex f i) ∈ + closure (P.plane.faceRegion f)) → (∀ (a : ι), IsCompact (closure (P3776T1OpenStar P + a)))))) := by + classical + intro ι P this hcompact hfiniteFace hedgeFace hposFace a + have hfiniteInc : Set.Finite {f : P.plane.Face | ∃ i, P.plane.faceVertex f i = a} := by + apply (hfiniteFace {P.plane.position a} isCompact_singleton).subset + rintro f ⟨i, hi⟩ + exact ⟨P.plane.position a, rfl, hi ▸ hposFace f i⟩ + let A : Set (Real × Real) := + ⋃ f ∈ {f : P.plane.Face | ∃ i, P.plane.faceVertex f i = a}, + closure (P.plane.faceRegion f) + have hA : IsCompact A := hfiniteInc.isCompact_biUnion (fun f _ => hcompact f) + have hsub : P3776T1OpenStar P a ⊆ A := by + intro x hx + rcases hx with hxa | ⟨b, hab, hx, _, _⟩ | ⟨f, hf, hx⟩ + · obtain ⟨b, hab⟩ := (P3767T1VertexEdgeIncidence P.plane a).1 + obtain ⟨f, ⟨i, hi⟩, _, _⟩ := hedgeFace a b hab + exact Set.mem_iUnion.mpr ⟨f, Set.mem_iUnion.mpr + ⟨⟨i, hi⟩, hxa.symm ▸ (hi ▸ hposFace f i)⟩⟩ + · obtain ⟨f, hf, _, hs⟩ := hedgeFace a b hab + exact Set.mem_iUnion.mpr ⟨f, Set.mem_iUnion.mpr ⟨hf, hs hx⟩⟩ + · exact Set.mem_iUnion.mpr ⟨f, Set.mem_iUnion.mpr ⟨hf, subset_closure hx⟩⟩ + exact hA.of_isClosed_subset isClosed_closure (closure_minimal hsub hA.isClosed) + +private theorem hstarcover : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (x : Real × Real), ∃ a, x ∈ P3776T1OpenStar P a + := by + classical + intro ι P x + have hx : x ∈ Set.range P.plane.position ∪ + {p | ∃ a b, P.plane.adjacent a b ∧ p ∈ P.plane.edgeArc a b} ∪ + {p | ∃ f, p ∈ P.plane.faceRegion f} := by + rw [P.plane.plane_cover] + trivial + rcases hx with (⟨a, rfl⟩ | ⟨a, b, hab, hx⟩) | ⟨f, hx⟩ + · exact ⟨a, Or.inl rfl⟩ + · by_cases hxa : x = P.plane.position a + · exact ⟨a, Or.inl hxa⟩ + by_cases hxb : x = P.plane.position b + · exact ⟨b, Or.inl hxb⟩ + exact ⟨a, Or.inr (Or.inl ⟨b, hab, hx, hxa, hxb⟩)⟩ + · exact ⟨P.plane.faceVertex f 0, Or.inr (Or.inr ⟨f, ⟨0, rfl⟩, hx⟩)⟩ + +private theorem hstarForward : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (u : P.lattice), ∀ (a : ι), (fun x => x + + GaussianRealPoint u) '' P3776T1OpenStar P a ⊆ + P3776T1OpenStar P (P.shift u a) := by + classical + intro ι P u a + rintro x ⟨y, hy, rfl⟩ + rcases hy with hya | ⟨b, hab, hy, hya, hyb⟩ | ⟨f, ⟨i, hi⟩, hy⟩ + · left + rw [P.position_periodic, hya] + · right + left + refine ⟨P.shift u b, (P.edge_periodic u a b).mpr hab, ?_, ?_, ?_⟩ + · rw [P.edgeArc_periodic] + exact ⟨y, hy, rfl⟩ + · intro h + rw [P.position_periodic] at h + exact hya (add_right_cancel h) + · intro h + rw [P.position_periodic] at h + exact hyb (add_right_cancel h) + · right + right + refine ⟨P.faceShift u f, ⟨i, ?_⟩, ?_⟩ + · rw [P.face_vertices_periodic, hi] + · rw [P.faceRegion_periodic] + exact ⟨y, hy, rfl⟩ + +private theorem hstarPeriodic : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), (∀ (u : P.lattice), ∀ (a : ι), (fun x => x + + GaussianRealPoint u) '' P3776T1OpenStar P a ⊆ P3776T1OpenStar P (P.shift u a)) → (∀ + (u : P.lattice), ∀ (a : ι), P3776T1OpenStar P (P.shift u a) = + (fun x => x + GaussianRealPoint u) '' P3776T1OpenStar P a) := by + classical + intro ι P hstarForward u a + apply Set.Subset.antisymm + · intro x hx + have hinv : P.shift (-u) (P.shift u a) = a := by + rw [← P.shift_add] + simp only [neg_add_cancel, P.shift_zero] + have hneg : GaussianRealPoint ((-u : P.lattice) : GaussianInt) = + -GaussianRealPoint (u : GaussianInt) := by + ext <;> simp [GaussianRealPoint] + have hy : x + GaussianRealPoint ((-u : P.lattice) : GaussianInt) ∈ + P3776T1OpenStar P a := by + rw [← hinv] + exact hstarForward (-u) (P.shift u a) ⟨x, hx, rfl⟩ + refine ⟨x + GaussianRealPoint ((-u : P.lattice) : GaussianInt), hy, ?_⟩ + rw [hneg] + exact neg_add_cancel_right x (GaussianRealPoint u) + · exact hstarForward u a + +end FixedPeriodicGeometryProof + +theorem P3776T1FixedGeometry {ι : Type} (P : PeriodicTileCore ι) : + Nontrivial ι ∧ + (∀ f, IsCompact (closure (P.plane.faceRegion f))) ∧ + (∀ K : Set (Real × Real), IsCompact K → + Set.Finite {f | (K ∩ closure (P.plane.faceRegion f)).Nonempty}) ∧ + (∀ x : Real × Real, ∃ f, x ∈ closure (P.plane.faceRegion f)) ∧ + (∀ a, IsOpen (P3776T1OpenStar P a) ∧ + IsCompact (closure (P3776T1OpenStar P a))) ∧ + (∀ x : Real × Real, ∃ a, x ∈ P3776T1OpenStar P a) ∧ + (∀ u : P.lattice, ∀ a, + P3776T1OpenStar P (P.shift u a) = + (fun x => x + GaussianRealPoint u) '' P3776T1OpenStar P a) ∧ + (∀ u v : P.lattice, ∀ a, P.shift u a = P.shift v a → u = v) := by +-- BODY + classical + have hfree (u v : P.lattice) (a : ι) + (h : P.shift u a = P.shift v a) : u = v := FixedPeriodicGeometryProof.hfree ι P u v a h + have hnonzero : ∃ u : P.lattice, u ≠ 0 := FixedPeriodicGeometryProof.hnonzero ι P + have hinhab : Nonempty ι := FixedPeriodicGeometryProof.hinhab ι P + have hntriv : Nontrivial ι := by + obtain ⟨a⟩ := hinhab + obtain ⟨u, hu⟩ := hnonzero + refine ⟨⟨P.shift u a, a, ?_⟩⟩ + intro h + exact hu (hfree u 0 a (h.trans (P.shift_zero a).symm)) + let : Nontrivial ι := hntriv + have hfacefree (u : P.lattice) (f : P.plane.Face) + (h : P.faceShift u f = f) : u = 0 := by + apply hfree u 0 (P.plane.faceVertex f 0) + rw [P.shift_zero, ← P.face_vertices_periodic, h] + have harc (a b : ι) (hab : P.plane.adjacent a b) : + IsCompact (P.plane.edgeArc a b) := FixedPeriodicGeometryProof.harc ι P a b hab + have hfront (f : P.plane.Face) : IsCompact (frontier (P.plane.faceRegion f)) := by + rw [P.plane.face_boundary] + exact ((harc _ _ (P.plane.face_edges f 0 1 (by decide))).union + (harc _ _ (P.plane.face_edges f 1 2 (by decide)))).union + (harc _ _ (P.plane.face_edges f 2 0 (by decide))) + have hexterior (B : Real) : IsPreconnected {x : Real × Real | B < ‖x‖} := + FixedPeriodicGeometryProof.hexterior ι P hnonzero B + have hcompact (f : P.plane.Face) : IsCompact (closure (P.plane.faceRegion f)) := + FixedPeriodicGeometryProof.hcompact ι P hnonzero hfacefree hfront hexterior f + have hfiniteTrans (K A : Set (Real × Real)) (hK : IsCompact K) (hA : IsCompact A) : + Set.Finite {u : P.lattice | + (K ∩ (fun x => x + GaussianRealPoint u) '' A).Nonempty} := + FixedPeriodicGeometryProof.hfiniteTrans ι P K A hK hA + have hclosurePeriodic (u : P.lattice) (f : P.plane.Face) : + closure (P.plane.faceRegion (P.faceShift u f)) = + (fun x => x + GaussianRealPoint u) '' closure (P.plane.faceRegion f) := by + rw [P.faceRegion_periodic] + exact (Homeomorph.addRight (GaussianRealPoint u)).image_closure _ |>.symm + have hfiniteFace (K : Set (Real × Real)) (hK : IsCompact K) : + Set.Finite {f | (K ∩ closure (P.plane.faceRegion f)).Nonempty} := + FixedPeriodicGeometryProof.hfiniteFace ι P hcompact hfiniteTrans hclosurePeriodic K hK + have hLF : LocallyFinite (fun f => closure (P.plane.faceRegion f)) := by + intro x + refine ⟨Metric.closedBall x 1, Metric.closedBall_mem_nhds x (by norm_num), ?_⟩ + exact (hfiniteFace _ (isCompact_closedBall x 1)).subset + (fun f ⟨y, hyf, hyK⟩ => ⟨y, hyK, hyf⟩) + have hendpoints (a b : ι) (hab : P.plane.adjacent a b) : + P.plane.position a ∈ P.plane.edgeArc a b ∧ + P.plane.position b ∈ P.plane.edgeArc a b := by + obtain ⟨h, hzero, hone⟩ := P.plane.arc_homeomorph a b hab + constructor + · rw [← hzero] + exact (h ⟨0, by norm_num⟩).property + · rw [← hone] + exact (h ⟨1, by norm_num⟩).property + have hboundaryEdge (f : P.plane.Face) (i j : Fin 3) (hij : i ≠ j) : + P.plane.edgeArc (P.plane.faceVertex f i) (P.plane.faceVertex f j) ⊆ + frontier (P.plane.faceRegion f) := FixedPeriodicGeometryProof.hboundaryEdge ι P f i j hij + have hedgeFace (a b : ι) (hab : P.plane.adjacent a b) : + ∃ f : P.plane.Face, + (∃ i, P.plane.faceVertex f i = a) ∧ + (∃ j, P.plane.faceVertex f j = b) ∧ + P.plane.edgeArc a b ⊆ closure (P.plane.faceRegion f) := + FixedPeriodicGeometryProof.hedgeFace ι P hboundaryEdge a b hab + have hposFace (f : P.plane.Face) (i : Fin 3) : + P.plane.position (P.plane.faceVertex f i) ∈ closure (P.plane.faceRegion f) := by + have hi : ∃ j : Fin 3, i ≠ j := exists_ne i |>.imp (fun _ h => h.symm) + obtain ⟨j, hij⟩ := hi + exact frontier_subset_closure (hboundaryEdge f i j hij + (hendpoints _ _ (P.plane.face_edges f i j hij)).1) + have hcover (x : Real × Real) : ∃ f, x ∈ closure (P.plane.faceRegion f) := + FixedPeriodicGeometryProof.hcoverAt366 ι P hedgeFace hposFace x + have havoid (f : P.plane.Face) : + Disjoint (P3767T1FixedTrace P.plane) (P.plane.faceRegion f) := + (P3767T1FixedFaceComponents P.plane).1 f |>.1 + have harcMatch (a b c d : ι) (hab : P.plane.adjacent a b) + (hcd : P.plane.adjacent c d) (x : Real × Real) + (hx : x ∈ P.plane.edgeArc a b) (hxa : x ≠ P.plane.position a) + (hxb : x ≠ P.plane.position b) (hy : x ∈ P.plane.edgeArc c d) : + ({a, b} : Set ι) = {c, d} := FixedPeriodicGeometryProof.harcMatch ι P a b c d hab hcd x hx + hxa hxb hy + have hclosureVertex (f : P.plane.Face) (w : ι) + (hx : P.plane.position w ∈ closure (P.plane.faceRegion f)) : + ∃ i, P.plane.faceVertex f i = w := FixedPeriodicGeometryProof.hclosureVertex ι P havoid f + w hx + have hclosureEdge (f : P.plane.Face) (a b : ι) (hab : P.plane.adjacent a b) + (x : Real × Real) (hx : x ∈ P.plane.edgeArc a b) + (hxa : x ≠ P.plane.position a) (hxb : x ≠ P.plane.position b) + (hxf : x ∈ closure (P.plane.faceRegion f)) : + (∃ i, P.plane.faceVertex f i = a) ∧ (∃ i, P.plane.faceVertex f i = b) := + FixedPeriodicGeometryProof.hclosureEdge ι P havoid harcMatch f a b hab x hx hxa hxb hxf + have hclosureRegion (f g : P.plane.Face) (x : Real × Real) + (hx : x ∈ P.plane.faceRegion f) (hy : x ∈ closure (P.plane.faceRegion g)) : f = g := by + by_contra hne + exact Set.disjoint_left.mp ((P.plane.region_disjoint hne).closure_right + (P.plane.region_open f)) hx hy + have hstaropen (a : ι) : IsOpen (P3776T1OpenStar P a) := FixedPeriodicGeometryProof.hstaropen + ι P harc hLF hboundaryEdge hposFace hcover havoid harcMatch hclosureVertex + hclosureEdge hclosureRegion a + have hstarcompact (a : ι) : IsCompact (closure (P3776T1OpenStar P a)) := + FixedPeriodicGeometryProof.hstarcompact ι P hcompact hfiniteFace hedgeFace + hposFace a + have hstarcover (x : Real × Real) : ∃ a, x ∈ P3776T1OpenStar P a := + FixedPeriodicGeometryProof.hstarcover ι P x + have hstarForward (u : P.lattice) (a : ι) : + (fun x => x + GaussianRealPoint u) '' P3776T1OpenStar P a ⊆ + P3776T1OpenStar P (P.shift u a) := FixedPeriodicGeometryProof.hstarForward ι P u a + have hstarPeriodic (u : P.lattice) (a : ι) : + P3776T1OpenStar P (P.shift u a) = + (fun x => x + GaussianRealPoint u) '' P3776T1OpenStar P a := + FixedPeriodicGeometryProof.hstarPeriodic ι P hstarForward u a + exact ⟨hntriv, hcompact, hfiniteFace, hcover, + fun a => ⟨hstaropen a, hstarcompact a⟩, hstarcover, hstarPeriodic, hfree⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1OpenStar.lean b/LeanPool/ApollonianSuperharmonic/P3776T1OpenStar.lean new file mode 100644 index 0000000000..850ea3a81e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1OpenStar.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore + +-- [TABLET NODE: P3776T1OpenStar] + +/-! +# P3776T1OpenStar + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For an area-free periodic core $P$ and an index $a$, let $U_a$ consist of +the position of $a$, the interiors (with both endpoints removed) of all +fixed arcs incident to $a$, and the open regions of all faces incident to +$a$. These are subsets of the actual fixed plane drawing, not of a new +polygonal drawing. +-/ +def P3776T1OpenStar {ι : Type} (P : PeriodicTileCore ι) (a : ι) : + Set (Real × Real) := +-- BODY + {x | x = P.plane.position a ∨ + (∃ b, P.plane.adjacent a b ∧ x ∈ P.plane.edgeArc a b ∧ + x ≠ P.plane.position a ∧ x ≠ P.plane.position b) ∨ + ∃ f, (∃ i, P.plane.faceVertex f i = a) ∧ x ∈ P.plane.faceRegion f} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1PlaneMapExists.lean b/LeanPool/ApollonianSuperharmonic/P3776T1PlaneMapExists.lean new file mode 100644 index 0000000000..9be72a8df5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1PlaneMapExists.lean @@ -0,0 +1,589 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3776T1StarWeightsExist +public import LeanPool.ApollonianSuperharmonic.P3776T1TileContractionsExist +public import LeanPool.ApollonianSuperharmonic.P3776T1DualEdgesExist +public import LeanPool.ApollonianSuperharmonic.P3776T1SectorMapsExist + +-- [TABLET NODE: P3776T1PlaneMapExists] + +/-! +# P3776T1PlaneMapExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PlaneMapConstruction + +private theorem faceCoords_continuous : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (W : P3776T1StarWeights P), + let faceCoords (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + StandardSimplex (Fin 3) := + ⟨fun i => W.weight (P.plane.faceVertex g i) x.1, + W.face_simplex g x.1 x.2⟩ + ∀ (g : P.plane.Face), Continuous (faceCoords g) ) := by + classical + intro ι P W faceCoords g + apply continuous_induced_rng.mpr + apply continuous_pi + intro i + exact (W.continuous (P.plane.faceVertex g i)).comp continuous_subtype_val + +private theorem hEdgeFormula : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (W : P3776T1StarWeights P), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (M : + P3776T1SectorMaps P H E), + let faceCoords (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + StandardSimplex (Fin 3) := + ⟨fun i => W.weight (P.plane.faceVertex g i) x.1, + W.face_simplex g x.1 x.2⟩ + let faceValue (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + Real × Real := M.faceMap g (faceCoords g x) + ∀ (g : P.plane.Face), ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), ∀ (x : ℝ × ℝ), ∀ (hg : x + ∈ closure (P.plane.faceRegion g)), x ∈ P.plane.edgeArc (P.plane.faceVertex g i) + (P.plane.faceVertex g j) → i ≠ j → faceValue g ⟨x, hg⟩ = if W.weight + (P.plane.faceVertex g i) x ≤ (1 / 2 : ℝ) then H.homotopy (P.plane.faceVertex g j) ((2 + : ℝ) * W.weight (P.plane.faceVertex g i) x) (E.port (P.plane.faceVertex g i) + (P.plane.faceVertex g j)) else H.homotopy (P.plane.faceVertex g i) ((2 : ℝ) * ((1 : + ℝ) - W.weight (P.plane.faceVertex g i) x)) (E.port (P.plane.faceVertex g i) + (P.plane.faceVertex g j)) ) := by + classical + intro ι P W H E M faceCoords faceValue g i j x hg hx hij + let s := faceCoords g ⟨x, hg⟩ + have hadj := P.plane.face_edges g i j hij + have hzero : ∀ k, k ≠ i → k ≠ j → s.1 k = 0 := by + intro k hki hkj + apply W.edge_support _ _ hadj x hx (P.plane.faceVertex g k) + · intro he + exact hki (P.plane.face_vertices_distinct g he) + · intro he + exact hkj (P.plane.face_vertices_distinct g he) + have hrange : (s.1 i : Real) ∈ Set.Icc 0 1 := + ⟨s.2.1 i, by + have h := Finset.single_le_sum (fun j _ => s.2.1 j) (Finset.mem_univ i) + simpa only [s.2.2] using h⟩ + have hsum : s.1 j = 1 - s.1 i := by + have hsum' : (∑ k : Fin 3, s.1 k) = s.1 i + s.1 j := by + calc + (∑ k : Fin 3, s.1 k) = ∑ k ∈ ({i, j} : Finset (Fin 3)), s.1 k := + (Finset.sum_subset (by simp) (by + intro k hk hknot + have hki : k ≠ i := by + intro he + subst k + simp at hknot + have hkj : k ≠ j := by + intro he + subst k + simp at hknot + exact hzero k hki hkj)).symm + _ = s.1 i + s.1 j := by simp [Finset.sum_insert, hij] + have hs : (∑ k : Fin 3, s.1 k) = 1 := by + exact s.2.2 + rw [hsum'] at hs + linarith + have hvec : ∀ k, s.1 k = if k = i then (s.1 i : Real) + else if k = j then 1 - (s.1 i : Real) else 0 := by + intro k + by_cases hki : k = i + · simp [hki] + · by_cases hkj : k = j + · simp [hkj, hsum, hij.symm] + · simp [hki, hkj, hzero k hki hkj] + have hformula := M.edge g i j hij ⟨s.1 i, hrange⟩ s hvec + simpa [faceValue, faceCoords, s] using hformula + +private theorem hBoundaryArc : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (g : P.plane.Face), ∀ x ∈ frontier + (P.plane.faceRegion g), ∃ (i : Fin (3 : ℕ)) (j : Fin (3 : ℕ)), i ≠ j ∧ x ∈ + P.plane.edgeArc (P.plane.faceVertex g i) (P.plane.faceVertex g j) ) := by + classical + intro ι P g x hx + rw [P.plane.face_boundary] at hx + rcases hx with (hx | hx) | hx + · exact ⟨0, 1, by decide, hx⟩ + · exact ⟨1, 2, by decide, hx⟩ + · exact ⟨2, 0, by decide, hx⟩ + +private theorem hEdgeWeightSum : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (W : P3776T1StarWeights P), + ∀ (g : P.plane.Face), ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), ∀ x ∈ closure + (P.plane.faceRegion g), x ∈ P.plane.edgeArc (P.plane.faceVertex g i) + (P.plane.faceVertex g j) → i ≠ j → W.weight (P.plane.faceVertex g i) x + W.weight + (P.plane.faceVertex g j) x = (1 : ℝ) ) := by + classical + intro ι P W g i j x hg hx hij + let faceCoords (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + StandardSimplex (Fin 3) := + ⟨fun i => W.weight (P.plane.faceVertex g i) x.1, + W.face_simplex g x.1 x.2⟩ + let s := faceCoords g ⟨x, hg⟩ + have hzero : ∀ k, k ≠ i → k ≠ j → s.1 k = 0 := by + intro k hki hkj + apply W.edge_support _ _ (P.plane.face_edges g i j hij) x hx + (P.plane.faceVertex g k) + · intro he + exact hki (P.plane.face_vertices_distinct g he) + · intro he + exact hkj (P.plane.face_vertices_distinct g he) + have hsum' : (∑ k : Fin 3, s.1 k) = s.1 i + s.1 j := by + calc + (∑ k : Fin 3, s.1 k) = ∑ k ∈ ({i, j} : Finset (Fin 3)), s.1 k := + (Finset.sum_subset (by simp) (by + intro k hk hknot + have hki : k ≠ i := by intro he; subst k; simp at hknot + have hkj : k ≠ j := by intro he; subst k; simp at hknot + exact hzero k hki hkj)).symm + _ = s.1 i + s.1 j := by simp [Finset.sum_insert, hij] + have hs : (∑ k : Fin 3, s.1 k) = 1 := + s.2.2 + have hresult : s.1 i + s.1 j = 1 := by rw [← hsum']; exact hs + simpa [s, faceCoords] using hresult + +private theorem hVertexValue : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (W : P3776T1StarWeights P), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (M : + P3776T1SectorMaps P H E), + let faceCoords (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + StandardSimplex (Fin 3) := + ⟨fun i => W.weight (P.plane.faceVertex g i) x.1, + W.face_simplex g x.1 x.2⟩ + let faceValue (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + Real × Real := M.faceMap g (faceCoords g x) + ∀ (g : P.plane.Face), ∀ (x : ℝ × ℝ), ∀ (hg : x ∈ closure (P.plane.faceRegion g)), ∀ (v : + ι), ∀ (i : Fin (3 : ℕ)), P.plane.faceVertex g i = v → x = P.plane.position v → + faceValue g ⟨x, hg⟩ = H.center v ) := by + classical + intro ι P W H E M faceCoords faceValue g x hg v i hvi hx + subst x + have hcoord : ∀ k : Fin 3, + W.weight (P.plane.faceVertex g k) (P.plane.position v) = + if k = i then 1 else 0 := by + intro k + have hk : P.plane.faceVertex g k = v ↔ k = i := by + constructor + · intro h + exact P.plane.face_vertices_distinct g (h.trans hvi.symm) + · rintro rfl + exact hvi + simp [W.vertex_value, hk] + have hsimplex : ∀ k : Fin 3, (faceCoords g ⟨P.plane.position v, hg⟩).1 k = + if k = i then 1 else 0 := by + intro k + exact hcoord k + change M.faceMap g (faceCoords g ⟨P.plane.position v, hg⟩) = H.center v + simpa [hvi] using M.vertex g i (faceCoords g ⟨P.plane.position v, hg⟩) hsimplex + +private theorem hAgree : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (W : P3776T1StarWeights P), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (M : + P3776T1SectorMaps P H E), + let faceCoords (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + StandardSimplex (Fin 3) := + ⟨fun i => W.weight (P.plane.faceVertex g i) x.1, + W.face_simplex g x.1 x.2⟩ + let faceValue (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + Real × Real := M.faceMap g (faceCoords g x) + (∀ (g : P.plane.Face), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (x : Real × Real), ∀ (hg : x ∈ + closure (P.plane.faceRegion g)), (x ∈ P.plane.edgeArc (P.plane.faceVertex g i) + (P.plane.faceVertex g j)) → ((i ≠ j) → (faceValue g ⟨x, hg⟩ = if W.weight + (P.plane.faceVertex g i) x ≤ 1 / 2 then H.homotopy (P.plane.faceVertex g j) (2 * + W.weight (P.plane.faceVertex g i) x) (E.port (P.plane.faceVertex g i) + (P.plane.faceVertex g j)) else H.homotopy (P.plane.faceVertex g i) (2 * (1 - W.weight + (P.plane.faceVertex g i) x)) (E.port (P.plane.faceVertex g i) (P.plane.faceVertex g + j))))) → ((∀ (g : P.plane.Face), ∀ (x : Real × Real), (x ∈ frontier + (P.plane.faceRegion g)) → (∃ i j : Fin 3, i ≠ j ∧ x ∈ P.plane.edgeArc + (P.plane.faceVertex g i) (P.plane.faceVertex g j))) → ((∀ (g : P.plane.Face), ∀ (i : + Fin 3), ∀ (j : Fin 3), ∀ (x : Real × Real), (x ∈ closure (P.plane.faceRegion g)) → + ((x ∈ P.plane.edgeArc (P.plane.faceVertex g i) (P.plane.faceVertex g j)) → ((i ≠ j) → + (W.weight (P.plane.faceVertex g i) x + W.weight (P.plane.faceVertex g j) x = 1)))) → + ((∀ (g : P.plane.Face), ∀ (x : Real × Real), ∀ (hg : x ∈ closure (P.plane.faceRegion + g)), ∀ (v : ι), ∀ (i : Fin 3), (P.plane.faceVertex g i = v) → ((x = P.plane.position + v) → (faceValue g ⟨x, hg⟩ = H.center v))) → (∀ g, ∀ h, ∀ x, ∀ (hg : x ∈ closure + (P.plane.faceRegion g)), ∀ (hh : x ∈ closure (P.plane.faceRegion h)), faceValue g ⟨x, + hg⟩ = faceValue h ⟨x, hh⟩)))) ) := by + classical + intro ι P W H E M faceCoords faceValue hEdgeFormula hBoundaryArc hEdgeWeightSum hVertexValue g + h x hg hh + by_cases hgh : g = h + · subst h + rfl + · have hxg : x ∉ P.plane.faceRegion g := by + intro hx + have : g = h := by + by_contra hn + exact Set.disjoint_left.mp ((P.plane.region_disjoint hn).closure_right + (P.plane.region_open g)) hx hh + exact hgh this + have hxh : x ∉ P.plane.faceRegion h := by + intro hx + have : h = g := by + by_contra hn + exact Set.disjoint_left.mp ((P.plane.region_disjoint hn).closure_right + (P.plane.region_open h)) hx hg + exact hgh this.symm + have hfg : x ∈ frontier (P.plane.faceRegion g) := by + simpa [frontier, (P.plane.region_open g).interior_eq] using ⟨hg, hxg⟩ + have hfh : x ∈ frontier (P.plane.faceRegion h) := by + simpa [frontier, (P.plane.region_open h).interior_eq] using ⟨hh, hxh⟩ + obtain ⟨i, j, hij, hxij⟩ := hBoundaryArc g x hfg + obtain ⟨k, l, hkl, hxkl⟩ := hBoundaryArc h x hfh + let a := P.plane.faceVertex g i + let b := P.plane.faceVertex g j + let c := P.plane.faceVertex h k + let d := P.plane.faceVertex h l + have hab : a ≠ b := by + intro he + exact hij (P.plane.face_vertices_distinct g he) + have hcd : c ≠ d := by + intro he + exact hkl (P.plane.face_vertices_distinct h he) + have hadj := P.plane.face_edges g i j hij + by_cases hsame : ({a, b} : Set ι) = {c, d} + · have ha : a = c ∨ a = d := by + have hm : a ∈ ({c, d} : Set ι) := by rw [← hsame]; simp + simpa using hm + have hb : b = c ∨ b = d := by + have hm : b ∈ ({c, d} : Set ι) := by rw [← hsame]; simp + simpa using hm + rcases ha with hac | had + · rcases hb with hbc | hbd + · exact (hab (hac.trans hbc.symm)).elim + · have hfirst := hEdgeFormula g i j x hg hxij hij + have hsecond := hEdgeFormula h k l x hh hxkl hkl + have hki : P.plane.faceVertex h k = P.plane.faceVertex g i := hac.symm + have hlj : P.plane.faceVertex h l = P.plane.faceVertex g j := hbd.symm + rw [hki, hlj] at hsecond + rw [hfirst, hsecond] + · rcases hb with hbc | hbd + · have hfirst := hEdgeFormula g i j x hg hxij hij + have hsecond := hEdgeFormula h k l x hh hxkl hkl + have hki : P.plane.faceVertex h k = P.plane.faceVertex g j := hbc.symm + have hlj : P.plane.faceVertex h l = P.plane.faceVertex g i := had.symm + rw [hki, hlj] at hsecond + have hsum := hEdgeWeightSum g i j x hg hxij hij + change W.weight a x + W.weight b x = 1 at hsum + have hs : W.weight b x = 1 - W.weight a x := by linarith + have hport := E.port_symmetric a b hadj + by_cases hr : W.weight a x < 1 / 2 + · have hrle : W.weight a x ≤ 1 / 2 := le_of_lt hr + have hsGreater : 1 / 2 < W.weight b x := by rw [hs]; linarith + have hsnot : ¬ W.weight b x ≤ 1 / 2 := not_le_of_gt hsGreater + rw [hfirst, hsecond] + rw [ite_eq_left hrle, ite_eq_right hsnot] + rw [hs, hport] + congr 1; ring + · have hge : 1 / 2 ≤ W.weight a x := le_of_not_gt hr + by_cases hre : W.weight a x = 1 / 2 + · have hsval : W.weight b x = 1 / 2 := by rw [hs, hre]; norm_num + have hre' : W.weight (P.plane.faceVertex g i) x = 1 / 2 := hre + have hs' : W.weight (P.plane.faceVertex g j) x = 1 / 2 := hsval + have hportmem := E.port_support a b hadj + have hrev : P.plane.adjacent b a := + (P.plane.adjacent_symmetric a b).mp hadj + have hportmem' := E.port_support b a hrev + calc + faceValue g ⟨x, hg⟩ = H.homotopy b 1 (E.port a b) := by + rw [hfirst] + have hi : W.weight (P.plane.faceVertex g i) x ≤ 1 / 2 := by + rw [hre'] + rw [ite_eq_left hi] + rw [hre'] + simp [a, b] + _ = E.port a b := H.one b _ hportmem.2 + _ = E.port b a := hport + _ = H.homotopy a 1 (E.port b a) := (H.one a _ hportmem'.2).symm + _ = faceValue h ⟨x, hh⟩ := by + rw [hsecond] + have hj : W.weight (P.plane.faceVertex g j) x ≤ 1 / 2 := by + rw [hs'] + rw [ite_eq_left hj] + rw [hs'] + simp [a, b] + · have hrgt : 1 / 2 < W.weight a x := lt_of_le_of_ne hge (Ne.symm hre) + have hslt : W.weight b x < 1 / 2 := by rw [hs]; linarith + rw [hfirst, hsecond] + rw [ite_eq_right (not_le_of_gt hrgt), ite_eq_left (le_of_lt hslt)] + rw [hs, hport] + · exact (hab (had.trans hbd.symm)).elim + · have hadj' := P.plane.face_edges h k l hkl + have hxintersection : x ∈ P.plane.edgeArc a b ∩ P.plane.edgeArc c d := + ⟨hxij, hxkl⟩ + rw [P.plane.arc_intersections a b c d hadj hadj' hsame] at hxintersection + obtain ⟨v, hv, hvx⟩ := hxintersection + have hva : v = a ∨ v = b := by simpa using hv.1 + have hvc : v = c ∨ v = d := by simpa using hv.2 + rcases hva with hva | hvb <;> rcases hvc with hvc | hvd + · have hleft := hVertexValue g x hg v i (rfl.trans hva.symm) hvx.symm + have hright := hVertexValue h x hh v k (rfl.trans hvc.symm) hvx.symm + exact hleft.trans hright.symm + · have hleft := hVertexValue g x hg v i (rfl.trans hva.symm) hvx.symm + have hright := hVertexValue h x hh v l (rfl.trans hvd.symm) hvx.symm + exact hleft.trans hright.symm + · have hleft := hVertexValue g x hg v j (rfl.trans hvb.symm) hvx.symm + have hright := hVertexValue h x hh v k (rfl.trans hvc.symm) hvx.symm + exact hleft.trans hright.symm + · have hleft := hVertexValue g x hg v j (rfl.trans hvb.symm) hvx.symm + have hright := hVertexValue h x hh v l (rfl.trans hvd.symm) hvx.symm + exact hleft.trans hright.symm + +private theorem hLoc : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), LocallyFinite (fun g : P.plane.Face => closure + (P.plane.faceRegion g)) ) := by + classical + intro ι P x + refine ⟨Metric.closedBall x 1, Metric.closedBall_mem_nhds x (by norm_num), ?_⟩ + have hfin := (P3776T1FixedGeometry P).2.2.1 + (Metric.closedBall x 1) (isCompact_closedBall x 1) + exact hfin.subset (by + intro g hg + rcases hg with ⟨y, hyball, hyg⟩ + exact ⟨y, hyg, hyball⟩) + +private theorem hcoverUnion : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), (∀ x : Real × Real, ∃ g, x ∈ closure + (P.plane.faceRegion g)) → ((⋃ g : P.plane.Face, closure (P.plane.faceRegion g)) = + Set.univ) ) := by + classical + intro ι P hcover + ext x + simp only [Set.mem_iUnion, Set.mem_univ, iff_true] + exact hcover x + +private theorem heq : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (W : P3776T1StarWeights P), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (M : + P3776T1SectorMaps P H E), ∀ (hcover : ∀ x : Real × Real, ∃ g, x ∈ closure + (P.plane.faceRegion g)), + let pick (x : Real × Real) : P.plane.Face := Classical.choose (hcover x) + ∀ (hpick : ∀ (x : Real × Real), x ∈ closure (P.plane.faceRegion (pick x))), + let coordinates (x : Real × Real) : StandardSimplex (Fin 3) := + ⟨fun i => W.weight (P.plane.faceVertex (pick x) i) x, + W.face_simplex (pick x) x (hpick x)⟩ + let f (x : Real × Real) : Real × Real := M.faceMap (pick x) (coordinates x) + let faceCoords (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + StandardSimplex (Fin 3) := + ⟨fun i => W.weight (P.plane.faceVertex g i) x.1, + W.face_simplex g x.1 x.2⟩ + let faceValue (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + Real × Real := M.faceMap g (faceCoords g x) + (∀ g, ∀ h, ∀ x, ∀ (hg : x ∈ closure (P.plane.faceRegion g)), ∀ (hh : x ∈ closure + (P.plane.faceRegion h)), faceValue g ⟨x, hg⟩ = faceValue h ⟨x, hh⟩) → (∀ (g : + P.plane.Face), ∀ x : ↥(closure (P.plane.faceRegion g)), f x.1 = faceValue g x) ) := by + classical + intro ι P W H E M hcover pick hpick coordinates f faceCoords faceValue hAgree g x + simpa [f, coordinates, faceValue, faceCoords] using + (hAgree (pick x.1) g x.1 (hpick x.1) x.2) + +private theorem hcont : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (W : P3776T1StarWeights P), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (M : + P3776T1SectorMaps P H E), ∀ (hcover : ∀ x : Real × Real, ∃ g, x ∈ closure + (P.plane.faceRegion g)), + let pick (x : Real × Real) : P.plane.Face := Classical.choose (hcover x) + ∀ (hpick : ∀ (x : Real × Real), x ∈ closure (P.plane.faceRegion (pick x))), + let coordinates (x : Real × Real) : StandardSimplex (Fin 3) := + ⟨fun i => W.weight (P.plane.faceVertex (pick x) i) x, + W.face_simplex (pick x) x (hpick x)⟩ + let f (x : Real × Real) : Real × Real := M.faceMap (pick x) (coordinates x) + let faceCoords (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + StandardSimplex (Fin 3) := + ⟨fun i => W.weight (P.plane.faceVertex g i) x.1, + W.face_simplex g x.1 x.2⟩ + let faceValue (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + Real × Real := M.faceMap g (faceCoords g x) + (∀ (g : P.plane.Face), Continuous (faceValue g)) → (∀ (g : P.plane.Face), (∀ x : + ↥(closure (P.plane.faceRegion g)), f x.1 = faceValue g x) → (Continuous (fun x : + ↥(closure (P.plane.faceRegion g)) => f x.1))) ) := by + classical + intro ι P W H E M hcover pick hpick coordinates f faceCoords faceValue faceValue_continuous g heq + have heqFun : (fun x : ↥(closure (P.plane.faceRegion g)) => f x.1) = + faceValue g := funext heq + rw [heqFun] + exact faceValue_continuous g + +private theorem htranslated : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (hcover : ∀ x : Real × Real, ∃ g, x ∈ closure + (P.plane.faceRegion g)), + let pick (x : Real × Real) : P.plane.Face := Classical.choose (hcover x) + ∀ (u : ↥P.lattice), ∀ (x : ℝ × ℝ), + let g := pick x + (x ∈ closure (P.plane.faceRegion g)) → (x + GaussianRealPoint u ∈ closure + (P.plane.faceRegion (P.faceShift u g))) ) := by + classical + intro ι P hcover pick u x g hg + rw [P.faceRegion_periodic] + have hcl : closure ((fun p => p + GaussianRealPoint u) '' + P.plane.faceRegion g) = + (fun p => p + GaussianRealPoint u) '' closure (P.plane.faceRegion g) := + (Homeomorph.addRight (GaussianRealPoint u)).image_closure _ |>.symm + rw [hcl] + exact ⟨x, hg, rfl⟩ + +private theorem hleft' : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (W : P3776T1StarWeights P), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (M : + P3776T1SectorMaps P H E), ∀ (hcover : ∀ x : Real × Real, ∃ g, x ∈ closure + (P.plane.faceRegion g)), + let pick (x : Real × Real) : P.plane.Face := Classical.choose (hcover x) + ∀ (hpick : ∀ (x : Real × Real), x ∈ closure (P.plane.faceRegion (pick x))), + let coordinates (x : Real × Real) : StandardSimplex (Fin 3) := + ⟨fun i => W.weight (P.plane.faceVertex (pick x) i) x, + W.face_simplex (pick x) x (hpick x)⟩ + let f (x : Real × Real) : Real × Real := M.faceMap (pick x) (coordinates x) + let faceCoords (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + StandardSimplex (Fin 3) := + ⟨fun i => W.weight (P.plane.faceVertex g i) x.1, + W.face_simplex g x.1 x.2⟩ + let faceValue (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + Real × Real := M.faceMap g (faceCoords g x) + ∀ (u : ↥P.lattice), ∀ (x : ℝ × ℝ), + let g := pick x + ∀ (htranslated : x + GaussianRealPoint u ∈ closure (P.plane.faceRegion (P.faceShift u + g))), (faceValue (pick (x + GaussianRealPoint (↑u : GaussianInt))) ⟨x + + GaussianRealPoint (↑u : GaussianInt), hpick (x + GaussianRealPoint u)⟩ = faceValue + (P.faceShift u g) ⟨x + + GaussianRealPoint (↑u : GaussianInt), htranslated⟩) → (f (x + GaussianRealPoint u) = + faceValue (P.faceShift u g) ⟨x + GaussianRealPoint u, htranslated⟩) ) := by + classical + intro ι P W H E M hcover pick hpick coordinates f faceCoords faceValue u x g htranslated hleft + simpa [f, coordinates, faceValue, faceCoords] using hleft + +end PlaneMapConstruction + +theorem P3776T1PlaneMapExists {ι : Type} (P : PeriodicTileCore ι) : + ∃ f : (Real × Real) → (Real × Real), Continuous f ∧ + (∀ u : P.lattice, ∀ x, f (x + GaussianRealPoint u) = f x + GaussianRealPoint u) ∧ + ∀ x, ∃ a, f x ∈ TileRealization (P.tile a) := by +-- BODY + classical + obtain ⟨W⟩ := P3776T1StarWeightsExist P + obtain ⟨H⟩ := P3776T1TileContractionsExist P + obtain ⟨E⟩ := P3776T1DualEdgesExist P + obtain ⟨M⟩ := P3776T1SectorMapsExist P H E + have hcover : ∀ x : Real × Real, ∃ g, x ∈ closure (P.plane.faceRegion g) := + (P3776T1FixedGeometry P).2.2.2.1 + let pick (x : Real × Real) : P.plane.Face := Classical.choose (hcover x) + have hpick (x : Real × Real) : x ∈ closure (P.plane.faceRegion (pick x)) := + Classical.choose_spec (hcover x) + let coordinates (x : Real × Real) : StandardSimplex (Fin 3) := + ⟨fun i => W.weight (P.plane.faceVertex (pick x) i) x, + W.face_simplex (pick x) x (hpick x)⟩ + let f (x : Real × Real) : Real × Real := M.faceMap (pick x) (coordinates x) + let faceCoords (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + StandardSimplex (Fin 3) := + ⟨fun i => W.weight (P.plane.faceVertex g i) x.1, + W.face_simplex g x.1 x.2⟩ + let faceValue (g : P.plane.Face) (x : ↥(closure (P.plane.faceRegion g))) : + Real × Real := M.faceMap g (faceCoords g x) + have faceCoords_continuous (g : P.plane.Face) := PlaneMapConstruction.faceCoords_continuous ι P + W g + have faceValue_continuous (g : P.plane.Face) : Continuous (faceValue g) := by + exact (M.faceMap g).continuous.comp (faceCoords_continuous g) + have hEdgeFormula (g : P.plane.Face) (i j : Fin 3) (x : Real × Real) + (hg : x ∈ closure (P.plane.faceRegion g)) + (hx : x ∈ P.plane.edgeArc (P.plane.faceVertex g i) (P.plane.faceVertex g j)) + (hij : i ≠ j) := PlaneMapConstruction.hEdgeFormula ι P W H E M g i j x hg hx hij + have hBoundaryArc (g : P.plane.Face) (x : Real × Real) + (hx : x ∈ frontier (P.plane.faceRegion g)) := PlaneMapConstruction.hBoundaryArc ι P g x hx + have hEdgeWeightSum (g : P.plane.Face) (i j : Fin 3) (x : Real × Real) + (hg : x ∈ closure (P.plane.faceRegion g)) + (hx : x ∈ P.plane.edgeArc (P.plane.faceVertex g i) (P.plane.faceVertex g j)) + (hij : i ≠ j) := PlaneMapConstruction.hEdgeWeightSum ι P W g i j x hg hx hij + have hVertexValue (g : P.plane.Face) (x : Real × Real) + (hg : x ∈ closure (P.plane.faceRegion g)) (v : ι) (i : Fin 3) + (hvi : P.plane.faceVertex g i = v) (hx : x = P.plane.position v) := + PlaneMapConstruction.hVertexValue ι P W H E M g x hg v i hvi hx + have hAgree := PlaneMapConstruction.hAgree ι P W H E M hEdgeFormula hBoundaryArc hEdgeWeightSum + hVertexValue + refine ⟨f, ?_, ?_, ?_⟩ + · have hLoc : LocallyFinite (fun g : P.plane.Face => closure (P.plane.faceRegion g)) := + PlaneMapConstruction.hLoc ι P + have hcoverUnion := PlaneMapConstruction.hcoverUnion ι P hcover + apply hLoc.continuous hcoverUnion + (fun g => isClosed_closure) + (fun g => ?_) + rw [continuousOn_iff_continuous_domRestrict] + change Continuous (fun x : ↥(closure (P.plane.faceRegion g)) => f x.1) + have heq := PlaneMapConstruction.heq ι P W H E M hcover hpick hAgree g + have hcont := PlaneMapConstruction.hcont ι P W H E M hcover hpick faceValue_continuous g heq + exact hcont + · intro u x + let g := pick x + have hg : x ∈ closure (P.plane.faceRegion g) := hpick x + have htranslated : x + GaussianRealPoint u ∈ + closure (P.plane.faceRegion (P.faceShift u g)) := PlaneMapConstruction.htranslated ι P + hcover u x hg + have hleft := hAgree (pick (x + GaussianRealPoint u)) (P.faceShift u g) + (x + GaussianRealPoint u) (hpick _) htranslated + have hright := hAgree (pick x) g x (hpick x) hg + have hleft' : f (x + GaussianRealPoint u) = + faceValue (P.faceShift u g) ⟨x + GaussianRealPoint u, htranslated⟩ := + PlaneMapConstruction.hleft' ι P W H E M hcover hpick u x htranslated hleft + have hright' : f x = faceValue g ⟨x, hg⟩ := by + simpa [f, coordinates, faceValue, faceCoords] using hright.symm + rw [hleft', hright'] + change M.faceMap (P.faceShift u g) + (faceCoords (P.faceShift u g) ⟨x + GaussianRealPoint u, htranslated⟩) = + M.faceMap g (faceCoords g ⟨x, hg⟩) + GaussianRealPoint u + rw [M.periodic] + rw [add_right_cancel_iff] + apply congrArg (M.faceMap g) + apply Subtype.ext + funext i + change W.weight (P.plane.faceVertex (P.faceShift u g) i) + (x + GaussianRealPoint u) = W.weight (P.plane.faceVertex g i) x + rw [P.face_vertices_periodic, W.periodic] + · intro x + obtain ⟨i, _, hi⟩ := M.support (pick x) (coordinates x) + exact ⟨P.plane.faceVertex (pick x) i, hi⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1SectorMaps.lean b/LeanPool/ApollonianSuperharmonic/P3776T1SectorMaps.lean new file mode 100644 index 0000000000..6f51a7bc59 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1SectorMaps.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3776T1DualEdges +public import LeanPool.ApollonianSuperharmonic.P3776T1TileContractions +public import LeanPool.ApollonianSuperharmonic.StandardSimplex +public import Mathlib.Topology.ContinuousMap.Basic + +-- [TABLET NODE: P3776T1SectorMaps] + +/-! +# P3776T1SectorMaps + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Given contractions $H$ from `P3776T1TileContractions` and edge +halves $E$ from `P3776T1DualEdges`, a sector-map family assigns +a continuous map $M_f$ from the standard two-simplex to the real plane +for every numbered face $f$. Its value belongs to a tile at a vertex +whose coordinate is positive. At simplex vertex $i$ its value is +$c_{a_i}$, where $a_i$ is the numbered primal vertex. On the simplex edge +with coordinates $s_i=r$, $s_j=1-r$ and the other coordinate zero, +its value is +$$ +\begin{cases} +H_{a_j}(2r,m_{a_i a_j}),&0\leq r\leq1/2,\\ +H_{a_i}(2(1-r),m_{a_i a_j}),&1/2 + H.homotopy a z.1 (E.half f a b z.2)) := + (H.continuous a).comp_continuous + ((continuous_subtype_val.comp continuous_fst).prodMk + (hp.1.comp continuous_snd)) + (fun z => ⟨z.1.2, (hp.2.2.2.1 z.2).1⟩) + let g : C(SectorInterval × SectorInterval, ℝ × ℝ) := + ⟨fun z => H.homotopy a z.1 (E.half f a b z.2), hc⟩ + exact sectorConeDescent g (H.center a) + (fun t => H.zero a _ (hp.2.2.2.1 t).1) + +private theorem sectorOrderExists : + ∀ x : Fin 3 → ℝ, + ∃ i j k : Fin 3, i ≠ j ∧ i ≠ k ∧ j ≠ k ∧ x k ≤ x j ∧ x j ≤ x i := by + classical + intro x + by_cases h01 : x 0 ≤ x 1 + · by_cases h12 : x 1 ≤ x 2 + · exact ⟨2,1,0,by decide,by decide,by decide,by linarith,by linarith⟩ + · by_cases h02 : x 0 ≤ x 2 + · exact ⟨1,2,0,by decide,by decide,by decide,by linarith,by linarith⟩ + · exact ⟨1,0,2,by decide,by decide,by decide,by linarith,by linarith⟩ + · by_cases h02 : x 0 ≤ x 2 + · exact ⟨2,0,1,by decide,by decide,by decide,by linarith,by linarith⟩ + · by_cases h12 : x 1 ≤ x 2 + · exact ⟨0,2,1,by decide,by decide,by decide,by linarith,by linarith⟩ + · exact ⟨0,1,2,by decide,by decide,by decide,by linarith,by linarith⟩ + +private theorem sectorChamber_closed : + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + ∀ i j k : Fin 3, IsClosed (sectorChamber i j k) := by + classical + intro SectorSimplex sectorChamber i j k + apply IsClosed.inter + · exact isClosed_le ((continuous_apply j).comp continuous_subtype_val) + ((continuous_apply i).comp continuous_subtype_val) + · exact isClosed_le ((continuous_apply k).comp continuous_subtype_val) + ((continuous_apply j).comp continuous_subtype_val) + +private theorem sectorOrder_cover : + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + (∀ x : Fin 3 → ℝ, ∃ i j k : Fin 3, i ≠ j ∧ i ≠ k ∧ j ≠ k ∧ x k ≤ x j ∧ x j ≤ x i) → (∀ s : + SectorSimplex, ∃ o : SectorOrder, s ∈ sectorCh o) := by + classical + intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrderExists s + obtain ⟨i,j,k,hij,hik,hjk,hkj,hji⟩ := sectorOrderExists s.1 + exact ⟨⟨(i,j,k),hij,hik,hjk⟩,hji,hkj⟩ + +private theorem sectorIndexCover : + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + ∀ (o : SectorOrder), ∀ (n : Fin 3), n = sectorI o ∨ n = sectorJ o ∨ n = sectorK o := by + classical + intro SectorOrder sectorI sectorJ sectorK o n + let t : Finset (Fin 3) := {sectorI o, sectorJ o, sectorK o} + have hcard : t.card = Fintype.card (Fin 3) := by + simp [t, sectorI, sectorJ, sectorK, o.2.1, o.2.2.1, o.2.2.2] + have huniv := Finset.eq_univ_of_card t hcard + have hn : n ∈ t := by rw [huniv]; simp + simpa [t] using hn + +private theorem sectorOrderedSum : + let SectorSimplex := StandardSimplex (Fin 3) + ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j + ≠ k) → (s.1 i + s.1 j + s.1 k = 1))) := by + classical + intro SectorSimplex s i j k hij hik hjk + have hs : ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 |>.2 + fin_cases i <;> fin_cases j <;> fin_cases k + all_goals + first + | contradiction + | simpa [Fin.sum_univ_succ, add_assoc, add_comm, add_left_comm] using hs + +private theorem sectorParam_values : + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i + ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + ∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), (sectorParam o s hs).1.1 + = 2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o) ∧ + (sectorParam o s hs).1.2 = 2*(s.1 (sectorJ o)-s.1 (sectorK o)) := by + classical + intro SectorInterval SectorCone SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK + sectorCh sectorOrderedSum sectorParam o s hs + constructor <;> rfl + +private theorem sectorParam_continuous : + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i + ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + ∀ (o : SectorOrder), Continuous (fun s : {s : SectorSimplex // s ∈ sectorCh o} => sectorParam + o s.1 s.2) := by + classical + intro SectorInterval SectorCone SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK + sectorCh sectorOrderedSum sectorParam o + let A := {s : SectorSimplex // s ∈ sectorCh o} + let y : A → ℝ := fun s => s.1.1 (sectorJ o) + let z : A → ℝ := fun s => s.1.1 (sectorK o) + have hy : Continuous y := (continuous_apply _).comp + (continuous_subtype_val.comp continuous_subtype_val) + have hz : Continuous z := (continuous_apply _).comp + (continuous_subtype_val.comp continuous_subtype_val) + have hr : Continuous (fun s : A => 2 * (y s-z s)+3*z s) := by fun_prop + have hb : Continuous (fun s : A => 2*(y s-z s)) := by fun_prop + change Continuous (fun s : A => sectorParam o s.1 s.2) + unfold sectorParam + apply Continuous.subtype_mk + apply Continuous.prodMk + · apply Continuous.subtype_mk + exact hr + · apply Continuous.subtype_mk + exact hb + +private theorem sectorOrdersTie : + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ + sectorCh o') → (o = o' ∨ s.1 (sectorI o)=s.1 (sectorJ o) ∨ s.1 (sectorJ o)=s.1 (sectorK + o))) := by + classical + intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' + exact (P3832T1ChamberOverlap s.1 o o' ho ho').1 + +private theorem sectorOrderedBetaTop : + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ + sectorCh o') → ((s.1 (sectorI o)=s.1 (sectorJ o)) → (2*(s.1 (sectorJ o)-s.1 (sectorK o))= + 2*(s.1 (sectorJ o')-s.1 (sectorK o'))))) := by + classical + intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' ht + exact ((P3832T1ChamberOverlap s.1 o o' ho ho').2.1 ht).2.1 + +private theorem sectorOrderedRBottom : + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ + sectorCh o') → ((s.1 (sectorJ o)=s.1 (sectorK o)) → (2*(s.1 (sectorJ o)-s.1 (sectorK + o))+3*s.1 (sectorK o)= + 2*(s.1 (sectorJ o')-s.1 (sectorK o'))+3*s.1 (sectorK o')))) := by + classical + intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' ht + exact ((P3832T1ChamberOverlap s.1 o o' ho ho').2.2 ht).2.1 + +private theorem sectorTopTieParams : + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i + ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + (∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), (sectorParam o s + hs).1.1 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o) ∧ (sectorParam o s + hs).1.2 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))) → ((∀ (s : SectorSimplex), ∀ (o : + SectorOrder), ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ sectorCh o') → ((s.1 + (sectorI o)=s.1 (sectorJ o)) → (2*(s.1 (sectorJ o)-s.1 (sectorK o))= 2*(s.1 (sectorJ + o')-s.1 (sectorK o')))))) → (∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : + SectorOrder), ∀ (ho : s ∈ sectorCh o), ∀ (ho' : s ∈ sectorCh o'), (s.1 (sectorI o)=s.1 + (sectorJ o)) → ((sectorParam o s ho).1.1=1 ∧ + (sectorParam o s ho).1.2=(sectorParam o' s ho').1.2))) := by + classical + intro SectorInterval SectorCone SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK + sectorCh sectorOrderedSum sectorParam sectorParam_values sectorOrderedBetaTop s o o' ho ho' ht + rcases sectorParam_values o s ho with ⟨hr,hb⟩ + rcases sectorParam_values o' s ho' with ⟨_,hb'⟩ + constructor + · apply Subtype.ext + rw [hr] + have hsum := sectorOrderedSum s (sectorI o) (sectorJ o) (sectorK o) + o.2.1 o.2.2.1 o.2.2.2 + rw [ht] at hsum + calc + 2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o)= + s.1 (sectorJ o)+s.1 (sectorJ o)+s.1 (sectorK o) := by ring + _=1 := hsum + · apply Subtype.ext + rw [hb,hb'] + exact sectorOrderedBetaTop s o o' ho ho' ht + +private theorem sectorBottomTieParams : + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i + ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + (∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ + sectorCh o') → ((s.1 (sectorJ o)=s.1 (sectorK o)) → (2*(s.1 (sectorJ o)-s.1 (sectorK + o))+3*s.1 (sectorK o)= 2*(s.1 (sectorJ o')-s.1 (sectorK o'))+3*s.1 (sectorK o'))))) → (∀ + (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), ∀ (ho : s ∈ sectorCh o), + ∀ (ho' : s ∈ sectorCh o'), (s.1 (sectorJ o)=s.1 (sectorK o)) → ((sectorParam o s ho).1.2=0 ∧ + (sectorParam o s ho).1.1=(sectorParam o' s ho').1.1)) := by + classical + intro SectorInterval SectorCone SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK + sectorCh sectorOrderedSum sectorParam sectorOrderedRBottom s o o' ho ho' ht + constructor + · apply Subtype.ext + change 2 * (s.1 (sectorJ o) - s.1 (sectorK o)) = 0 + rw [ht, sub_self, mul_zero] + · apply Subtype.ext + change 2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o) = + 2*(s.1 (sectorJ o')-s.1 (sectorK o'))+3*s.1 (sectorK o') + exact sectorOrderedRBottom s o o' ho ho' ht + +private theorem sectorBottomSameTop : + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ + sectorCh o') → ((s.1 (sectorJ o)=s.1 (sectorK o)) → (sectorI o=sectorI o' ∨ + (s.1 (sectorI o)=s.1 (sectorJ o) ∧ s.1 (sectorJ o)=s.1 (sectorK o))))) := by + classical + intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' ht + exact ((P3832T1ChamberOverlap s.1 o o' ho ho').2.2 ht).2.2 + +private theorem sectorTopTieOther : + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ + sectorCh o') → ((s.1 (sectorI o)=s.1 (sectorJ o)) → (s.1 (sectorI o')=s.1 (sectorJ o')))) + := by + classical + intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' ht + exact ((P3832T1ChamberOverlap s.1 o o' ho ho').2.1 ht).1 + +private theorem sectorBottomTieOther : + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ + sectorCh o') → ((s.1 (sectorJ o)=s.1 (sectorK o)) → (s.1 (sectorJ o')=s.1 (sectorK o')))) + := by + classical + intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' ht + exact ((P3832T1ChamberOverlap s.1 o o' ho ho').2.2 ht).1 + +private theorem sectorTopPairClassify : + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ + sectorCh o') → ((s.1 (sectorI o)=s.1 (sectorJ o)) → ((s.1 (sectorI o')=s.1 (sectorJ o')) + → ((sectorI o=sectorI o' ∧ sectorJ o=sectorJ o' ∧ sectorK o=sectorK o') ∨ + (sectorI o=sectorJ o' ∧ sectorJ o=sectorI o' ∧ sectorK o=sectorK o') ∨ + (s.1 (sectorI o)=s.1 (sectorJ o) ∧ s.1 (sectorJ o)=s.1 (sectorK o)))))) := by + classical + intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' ht + ht' + exact ((P3832T1ChamberOverlap s.1 o o' ho ho').2.1 ht).2.2 + +private theorem sectorChosenCone_spec : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : + P3776T1DualEdges P), + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let sectorCollapse := P3832T1ConeCollapse + ∀ (sectorSupportedHalfCone : ∀ {ι : Type}, ∀ (P : PeriodicTileCore ι), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (f : P.plane.Face), ∀ (a : + ι), ∀ (b : ι), (P.plane.adjacent a b) → ((∃ i, P.plane.faceVertex f i = a) → ((∃ i, + P.plane.faceVertex f i = b) → (∃ G : C(SectorCone, ℝ × ℝ), ∀ z : SectorInterval × + SectorInterval, G (sectorCollapse z) = H.homotopy a z.1 (E.half f a b z.2))))), + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorChosenCone (f : P.plane.Face) (o : SectorOrder) : C(SectorCone,ℝ×ℝ) := + Classical.choose (sectorSupportedHalfCone P H E f + (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) + ∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (z : SectorInterval × SectorInterval), + sectorChosenCone f o (sectorCollapse z) = + H.homotopy (P.plane.faceVertex f (sectorI o)) z.1 + (E.half f (P.plane.faceVertex f (sectorI o)) + (P.plane.faceVertex f (sectorJ o)) z.2) := by + classical + intro ι P H E SectorInterval SectorCone sectorCollapse sectorSupportedHalfCone SectorOrder + sectorI sectorJ sectorChosenCone f o z + exact Classical.choose_spec (sectorSupportedHalfCone P H E f + (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) z + +private theorem sectorChosenPiece_top : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : + P3776T1DualEdges P), + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let sectorCollapse := P3832T1ConeCollapse + ∀ (sectorSupportedHalfCone : ∀ {ι : Type}, ∀ (P : PeriodicTileCore ι), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (f : P.plane.Face), ∀ (a : + ι), ∀ (b : ι), (P.plane.adjacent a b) → ((∃ i, P.plane.faceVertex f i = a) → ((∃ i, + P.plane.faceVertex f i = b) → (∃ G : C(SectorCone, ℝ × ℝ), ∀ z : SectorInterval × + SectorInterval, G (sectorCollapse z) = H.homotopy a z.1 (E.half f a b z.2))))), + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i + ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : + {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), (∀ (s : SectorSimplex), + ∀ (o : SectorOrder), ∀ (o' : SectorOrder), ∀ (ho : s ∈ sectorCh o), ∀ (ho' : s ∈ sectorCh + o'), (s.1 (sectorI o)=s.1 (sectorJ o)) → ((sectorParam o s ho).1.1=1 ∧ (sectorParam o s + ho).1.2=(sectorParam o' s ho').1.2)) → ( + let sectorPiece (o : SectorOrder) + (G : C(SectorCone,ℝ×ℝ)) : C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + ⟨fun s => G (sectorParam o s.1 s.2), + G.continuous.comp (sectorParam_continuous o)⟩ + let sectorChosenCone (f : P.plane.Face) (o : SectorOrder) : C(SectorCone,ℝ×ℝ) := + Classical.choose (sectorSupportedHalfCone P H E f + (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) + (∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (z : SectorInterval × SectorInterval), + sectorChosenCone f o (sectorCollapse z) = H.homotopy (P.plane.faceVertex f (sectorI o)) + z.1 (E.half f (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) z.2)) + → ( + let sectorChosenPiece (f : P.plane.Face) (o : SectorOrder) : + C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + sectorPiece o (sectorChosenCone f o) + ∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), + (s.1 (sectorI o)=s.1 (sectorJ o)) → (sectorChosenPiece f o ⟨s,hs⟩ = + E.half f (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) + (sectorParam o s hs).1.2))) := by + classical + intro ι P H E SectorInterval SectorCone sectorCollapse sectorSupportedHalfCone SectorSimplex + sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrderedSum sectorParam + sectorParam_continuous sectorTopTieParams sectorPiece sectorChosenCone + sectorChosenCone_spec sectorChosenPiece f o s hs ht + let z := sectorParam o s hs + have hr : (z.1.1 : ℝ) = 1 := by + simpa [z] using (sectorTopTieParams s o o hs hs ht).1 + let t : SectorInterval := z.1.2 + have hz : z = sectorCollapse (⟨1,by norm_num [SectorInterval]⟩,t) := by + apply Subtype.ext + apply Prod.ext + · apply Subtype.ext; exact hr + · apply Subtype.ext + simp [sectorCollapse, P3832T1ConeCollapse,t] + change sectorChosenCone f o z = _ + rw [hz,sectorChosenCone_spec] + have hp := E.half_spec f (P.plane.faceVertex f (sectorI o)) + (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩ + have hin := (hp.2.2.2.1 t).1 + simpa [t] using H.one (P.plane.faceVertex f (sectorI o)) + (E.half f (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) t) hin + +private theorem sectorChosenPiece_bottom : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : + P3776T1DualEdges P), + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let sectorCollapse := P3832T1ConeCollapse + ∀ (sectorSupportedHalfCone : ∀ {ι : Type}, ∀ (P : PeriodicTileCore ι), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (f : P.plane.Face), ∀ (a : + ι), ∀ (b : ι), (P.plane.adjacent a b) → ((∃ i, P.plane.faceVertex f i = a) → ((∃ i, + P.plane.faceVertex f i = b) → (∃ G : C(SectorCone, ℝ × ℝ), ∀ z : SectorInterval × + SectorInterval, G (sectorCollapse z) = H.homotopy a z.1 (E.half f a b z.2))))), + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i + ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : + {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), (∀ (s : SectorSimplex), + ∀ (o : SectorOrder), ∀ (o' : SectorOrder), ∀ (ho : s ∈ sectorCh o), ∀ (ho' : s ∈ sectorCh + o'), (s.1 (sectorJ o)=s.1 (sectorK o)) → ((sectorParam o s ho).1.2=0 ∧ (sectorParam o s + ho).1.1=(sectorParam o' s ho').1.1)) → ( + let sectorPiece (o : SectorOrder) + (G : C(SectorCone,ℝ×ℝ)) : C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + ⟨fun s => G (sectorParam o s.1 s.2), + G.continuous.comp (sectorParam_continuous o)⟩ + let sectorChosenCone (f : P.plane.Face) (o : SectorOrder) : C(SectorCone,ℝ×ℝ) := + Classical.choose (sectorSupportedHalfCone P H E f + (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) + (∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (z : SectorInterval × SectorInterval), + sectorChosenCone f o (sectorCollapse z) = H.homotopy (P.plane.faceVertex f (sectorI o)) + z.1 (E.half f (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) z.2)) + → ( + let sectorChosenPiece (f : P.plane.Face) (o : SectorOrder) : + C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + sectorPiece o (sectorChosenCone f o) + ∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), + (s.1 (sectorJ o)=s.1 (sectorK o)) → (sectorChosenPiece f o ⟨s,hs⟩ = + H.homotopy (P.plane.faceVertex f (sectorI o)) + (sectorParam o s hs).1.1 (GaussianRealPoint (P.rho f))))) := by + classical + intro ι P H E SectorInterval SectorCone sectorCollapse sectorSupportedHalfCone SectorSimplex + sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrderedSum sectorParam + sectorParam_continuous sectorBottomTieParams sectorPiece sectorChosenCone + sectorChosenCone_spec sectorChosenPiece f o s hs ht + let z := sectorParam o s hs + have hb : (z.1.2 : ℝ) = 0 := by + simpa [z] using (sectorBottomTieParams s o o hs hs ht).1 + let t0 : SectorInterval := ⟨0,by norm_num [SectorInterval]⟩ + have hz : z = sectorCollapse (z.1.1,t0) := by + apply Subtype.ext + apply Prod.ext + · rfl + · apply Subtype.ext + simp [sectorCollapse, P3832T1ConeCollapse,hb,t0] + change sectorChosenCone f o z = _ + rw [hz,sectorChosenCone_spec] + have hp := E.half_spec f (P.plane.faceVertex f (sectorI o)) + (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩ + rw [hp.2.1] + +private theorem sectorParam_beta_zero : + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i + ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + (∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), (sectorParam o s + hs).1.1 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o) ∧ (sectorParam o s + hs).1.2 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))) → (∀ (o : SectorOrder), ∀ (s : + SectorSimplex), ∀ (hs : s ∈ sectorCh o), (s.1 (sectorJ o)=s.1 (sectorK o)) → + ((sectorParam o s hs).1.2=⟨0,by norm_num [SectorInterval]⟩)) := by + classical + intro SectorInterval SectorCone SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK + sectorCh sectorOrderedSum sectorParam sectorParam_values o s hs ht + apply Subtype.ext + rcases sectorParam_values o s hs with ⟨_,hb⟩ + rw [hb,ht] + norm_num + +private theorem sectorChosenPieces_agree : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : + P3776T1DualEdges P), + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let sectorCollapse := P3832T1ConeCollapse + ∀ (sectorSupportedHalfCone : ∀ {ι : Type}, ∀ (P : PeriodicTileCore ι), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (f : P.plane.Face), ∀ (a : + ι), ∀ (b : ι), (P.plane.adjacent a b) → ((∃ i, P.plane.faceVertex f i = a) → ((∃ i, + P.plane.faceVertex f i = b) → (∃ G : C(SectorCone, ℝ × ℝ), ∀ z : SectorInterval × + SectorInterval, G (sectorCollapse z) = H.homotopy a z.1 (E.half f a b z.2))))), + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i + ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : + {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), (∀ (s : SectorSimplex), + ∀ (o : SectorOrder), ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ sectorCh o') → (o = + o' ∨ s.1 (sectorI o)=s.1 (sectorJ o) ∨ s.1 (sectorJ o)=s.1 (sectorK o)))) → ((∀ (s : + SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), ∀ (ho : s ∈ sectorCh o), ∀ + (ho' : s ∈ sectorCh o'), (s.1 (sectorI o)=s.1 (sectorJ o)) → ((sectorParam o s ho).1.1=1 + ∧ (sectorParam o s ho).1.2=(sectorParam o' s ho').1.2)) → ((∀ (s : SectorSimplex), ∀ (o : + SectorOrder), ∀ (o' : SectorOrder), ∀ (ho : s ∈ sectorCh o), ∀ (ho' : s ∈ sectorCh o'), + (s.1 (sectorJ o)=s.1 (sectorK o)) → ((sectorParam o s ho).1.2=0 ∧ (sectorParam o s + ho).1.1=(sectorParam o' s ho').1.1)) → ((∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ + (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ sectorCh o') → ((s.1 (sectorJ o)=s.1 + (sectorK o)) → (sectorI o=sectorI o' ∨ (s.1 (sectorI o)=s.1 (sectorJ o) ∧ s.1 (sectorJ + o)=s.1 (sectorK o)))))) → ((∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : + SectorOrder), (s ∈ sectorCh o) → ((s ∈ sectorCh o') → ((s.1 (sectorI o)=s.1 (sectorJ o)) + → (s.1 (sectorI o')=s.1 (sectorJ o'))))) → ((∀ (s : SectorSimplex), ∀ (o : SectorOrder), + ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ sectorCh o') → ((s.1 (sectorJ o)=s.1 + (sectorK o)) → (s.1 (sectorJ o')=s.1 (sectorK o'))))) → ((∀ (s : SectorSimplex), ∀ (o : + SectorOrder), ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ sectorCh o') → ((s.1 + (sectorI o)=s.1 (sectorJ o)) → ((s.1 (sectorI o')=s.1 (sectorJ o')) → ((sectorI o=sectorI + o' ∧ sectorJ o=sectorJ o' ∧ sectorK o=sectorK o') ∨ (sectorI o=sectorJ o' ∧ sectorJ + o=sectorI o' ∧ sectorK o=sectorK o') ∨ (s.1 (sectorI o)=s.1 (sectorJ o) ∧ s.1 (sectorJ + o)=s.1 (sectorK o))))))) → ( + let sectorPiece (o : SectorOrder) + (G : C(SectorCone,ℝ×ℝ)) : C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + ⟨fun s => G (sectorParam o s.1 s.2), + G.continuous.comp (sectorParam_continuous o)⟩ + let sectorChosenCone (f : P.plane.Face) (o : SectorOrder) : C(SectorCone,ℝ×ℝ) := + Classical.choose (sectorSupportedHalfCone P H E f + (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) + let sectorChosenPiece (f : P.plane.Face) (o : SectorOrder) : + C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + sectorPiece o (sectorChosenCone f o) + (∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), + (s.1 (sectorI o)=s.1 (sectorJ o)) → (sectorChosenPiece f o ⟨s,hs⟩ = E.half f + (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) (sectorParam o s + hs).1.2)) → ((∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s + ∈ sectorCh o), (s.1 (sectorJ o)=s.1 (sectorK o)) → (sectorChosenPiece f o ⟨s,hs⟩ = + H.homotopy (P.plane.faceVertex f (sectorI o)) (sectorParam o s hs).1.1 (GaussianRealPoint + (P.rho f)))) → ((∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), + (s.1 (sectorJ o)=s.1 (sectorK o)) → ((sectorParam o s hs).1.2=⟨0,by norm_num + [SectorInterval]⟩)) → (∀ (f : P.plane.Face), ∀ (s : SectorSimplex), ∀ (o : SectorOrder), + ∀ (o' : SectorOrder), ∀ (ho : s ∈ sectorCh o), ∀ (ho' : s ∈ sectorCh o'), + sectorChosenPiece f o ⟨s,ho⟩=sectorChosenPiece f o' ⟨s,ho'⟩)))))))))) := by + classical + intro ι P H E SectorInterval SectorCone sectorCollapse sectorSupportedHalfCone SectorSimplex + sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrderedSum sectorParam + sectorParam_continuous sectorOrdersTie sectorTopTieParams sectorBottomTieParams + sectorBottomSameTop sectorTopTieOther sectorBottomTieOther sectorTopPairClassify + sectorPiece sectorChosenCone sectorChosenPiece sectorChosenPiece_top + sectorChosenPiece_bottom sectorParam_beta_zero f s o o' ho ho' + rcases sectorOrdersTie s o o' ho ho' with heq | htop | hbottom + · subst o'; rfl + · have htop' := sectorTopTieOther s o o' ho ho' htop + have hclass := sectorTopPairClassify s o o' ho ho' htop htop' + rw [sectorChosenPiece_top f o s ho htop, + sectorChosenPiece_top f o' s ho' htop'] + rcases hclass with hpairs | hpairs | hall + · rcases hpairs with ⟨hi,hj,hk⟩ + rw [← hi,← hj,← (sectorTopTieParams s o o' ho ho' htop).2] + · rcases hpairs with ⟨hi,hj,hk⟩ + rw [← hi,← hj,← (sectorTopTieParams s o o' ho ho' htop).2] + have hsym := E.half_spec f (P.plane.faceVertex f (sectorI o)) + (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩ + simpa using hsym.2.2.2.2.1 ((sectorParam o s ho).1.2) + · have hzero := sectorParam_beta_zero o s ho hall.2 + have hbottom' := sectorBottomTieOther s o o' ho ho' hall.2 + have hzero' := sectorParam_beta_zero o' s ho' hbottom' + rw [hzero,hzero'] + have hp := E.half_spec f (P.plane.faceVertex f (sectorI o)) + (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩ + have hp' := E.half_spec f (P.plane.faceVertex f (sectorI o')) + (P.plane.faceVertex f (sectorJ o')) + (P.plane.face_edges f (sectorI o') (sectorJ o') o'.2.1) + ⟨sectorI o',rfl⟩ ⟨sectorJ o',rfl⟩ + exact hp.2.1.trans hp'.2.1.symm + · have hbottom' := sectorBottomTieOther s o o' ho ho' hbottom + have hclass := sectorBottomSameTop s o o' ho ho' hbottom + rw [sectorChosenPiece_bottom f o s ho hbottom, + sectorChosenPiece_bottom f o' s ho' hbottom'] + rcases hclass with hI | hall + · rw [hI,(sectorBottomTieParams s o o' ho ho' hbottom).2] + · have htop : s.1 (sectorI o)=s.1 (sectorJ o) := hall.1 + have htop' := sectorTopTieOther s o o' ho ho' htop + have hr := (sectorTopTieParams s o o ho ho htop).1 + have hr' := (sectorTopTieParams s o' o' ho' ho' htop').1 + rw [hr,hr'] + have hp := E.half_spec f (P.plane.faceVertex f (sectorI o)) + (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩ + have hp' := E.half_spec f (P.plane.faceVertex f (sectorI o')) + (P.plane.faceVertex f (sectorJ o')) + (P.plane.face_edges f (sectorI o') (sectorJ o') o'.2.1) + ⟨sectorI o',rfl⟩ ⟨sectorJ o',rfl⟩ + let t0 : SectorInterval := ⟨0,by norm_num [SectorInterval]⟩ + have hm := (hp.2.2.2.1 t0).1 + have hm' := (hp'.2.2.2.1 t0).1 + have hmL : E.half f (P.plane.faceVertex f (sectorI o)) + (P.plane.faceVertex f (sectorJ o)) ⟨0,by norm_num [SectorInterval]⟩ ∈ + TileRealization (P.tile (P.plane.faceVertex f (sectorI o))) := by + simpa [t0] using hm + have hmL' : E.half f (P.plane.faceVertex f (sectorI o')) + (P.plane.faceVertex f (sectorJ o')) ⟨0,by norm_num [SectorInterval]⟩ ∈ + TileRealization (P.tile (P.plane.faceVertex f (sectorI o'))) := by + simpa [t0] using hm' + have hm0 : GaussianRealPoint (P.rho f) ∈ + TileRealization (P.tile (P.plane.faceVertex f (sectorI o))) := by + rw [hp.2.1] at hmL; exact hmL + have hm0' : GaussianRealPoint (P.rho f) ∈ + TileRealization (P.tile (P.plane.faceVertex f (sectorI o'))) := by + rw [hp'.2.1] at hmL'; exact hmL' + have hone := H.one (P.plane.faceVertex f (sectorI o)) + (GaussianRealPoint (P.rho f)) hm0 + have hone' := H.one (P.plane.faceVertex f (sectorI o')) + (GaussianRealPoint (P.rho f)) hm0' + calc + H.homotopy (P.plane.faceVertex f (sectorI o)) 1 _ = + GaussianRealPoint (P.rho f) := by simpa using hone + _ = H.homotopy (P.plane.faceVertex f (sectorI o')) 1 _ := by + simpa using hone'.symm + +private theorem sectorGlobalMap : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : + P3776T1DualEdges P), + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let sectorCollapse := P3832T1ConeCollapse + ∀ (sectorSupportedHalfCone : ∀ {ι : Type}, ∀ (P : PeriodicTileCore ι), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (f : P.plane.Face), ∀ (a : + ι), ∀ (b : ι), (P.plane.adjacent a b) → ((∃ i, P.plane.faceVertex f i = a) → ((∃ i, + P.plane.faceVertex f i = b) → (∃ G : C(SectorCone, ℝ × ℝ), ∀ z : SectorInterval × + SectorInterval, G (sectorCollapse z) = H.homotopy a z.1 (E.half f a b z.2))))), + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + (∀ s : + SectorSimplex, ∃ o : SectorOrder, s ∈ sectorCh o) → (∀ (sectorOrderedSum : ∀ (s : + SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ + k) → (s.1 i + s.1 j + s.1 k = 1)))), + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : + {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), + let sectorPiece (o : SectorOrder) + (G : C(SectorCone,ℝ×ℝ)) : C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + ⟨fun s => G (sectorParam o s.1 s.2), + G.continuous.comp (sectorParam_continuous o)⟩ + let sectorChosenCone (f : P.plane.Face) (o : SectorOrder) : C(SectorCone,ℝ×ℝ) := + Classical.choose (sectorSupportedHalfCone P H E f + (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) + let sectorChosenPiece (f : P.plane.Face) (o : SectorOrder) : + C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + sectorPiece o (sectorChosenCone f o) + (∀ (f : P.plane.Face), ∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), ∀ + (ho : s ∈ sectorCh o), ∀ (ho' : s ∈ sectorCh o'), sectorChosenPiece f o + ⟨s,ho⟩=sectorChosenPiece f o' ⟨s,ho'⟩) → (∀ (f : P.plane.Face), ∃ F : + C(SectorSimplex,ℝ×ℝ), ∀ o s (hs : s ∈ sectorCh o), + F s=sectorChosenPiece f o ⟨s,hs⟩)) := by + classical + intro ι P H E SectorInterval SectorCone sectorCollapse sectorSupportedHalfCone SectorSimplex + sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrder_cover + sectorOrderedSum sectorParam sectorParam_continuous sectorPiece sectorChosenCone + sectorChosenPiece sectorChosenPieces_agree f + let sectorChamber_closed : ∀ i j k : Fin 3, IsClosed (sectorChamber i j k) := + SectorMapsProof.sectorChamber_closed + classical + let S : SectorOrder → Set SectorSimplex := sectorCh + let φ : ∀ o, C(S o,ℝ×ℝ) := sectorChosenPiece f + have hclosed : ∀ o, IsClosed (S o) := by + intro o + exact sectorChamber_closed _ _ _ + have hcover : ∀ s : SectorSimplex, ∃ o, s ∈ S o := by + intro s + exact sectorOrder_cover s + have hagree : ∀ o o' s (ho : s ∈ S o) (ho' : s ∈ S o'), + φ o ⟨s,ho⟩=φ o' ⟨s,ho'⟩ := by + intro o o' s ho ho' + exact sectorChosenPieces_agree f s o o' ho ho' + obtain ⟨F,hF⟩ := P3832T1FiniteClosedCoverPasting (S:=S) hclosed hcover φ hagree + exact ⟨F,fun o s hs => hF o s hs⟩ + +private theorem sectorChosenPiece_support : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : + P3776T1DualEdges P), + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let sectorCollapse := P3832T1ConeCollapse + (Function.Surjective sectorCollapse) → (∀ (sectorSupportedHalfCone : ∀ {ι : Type}, ∀ (P : + PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ + (f : P.plane.Face), ∀ (a : ι), ∀ (b : ι), (P.plane.adjacent a b) → ((∃ i, + P.plane.faceVertex f i = a) → ((∃ i, P.plane.faceVertex f i = b) → (∃ G : C(SectorCone, ℝ + × ℝ), ∀ z : SectorInterval × SectorInterval, G (sectorCollapse z) = H.homotopy a z.1 + (E.half f a b z.2))))), + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i + ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : + {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), + let sectorPiece (o : SectorOrder) + (G : C(SectorCone,ℝ×ℝ)) : C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + ⟨fun s => G (sectorParam o s.1 s.2), + G.continuous.comp (sectorParam_continuous o)⟩ + let sectorChosenCone (f : P.plane.Face) (o : SectorOrder) : C(SectorCone,ℝ×ℝ) := + Classical.choose (sectorSupportedHalfCone P H E f + (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) + (∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (z : SectorInterval × SectorInterval), + sectorChosenCone f o (sectorCollapse z) = H.homotopy (P.plane.faceVertex f (sectorI o)) + z.1 (E.half f (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) z.2)) + → ( + let sectorChosenPiece (f : P.plane.Face) (o : SectorOrder) : + C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + sectorPiece o (sectorChosenCone f o) + ∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), + sectorChosenPiece f o ⟨s,hs⟩ ∈ + TileRealization (P.tile (P.plane.faceVertex f (sectorI o))))) := by + classical + intro ι P H E SectorInterval SectorCone sectorCollapse sectorCollapse_surjective + sectorSupportedHalfCone SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK + sectorCh sectorOrderedSum sectorParam sectorParam_continuous sectorPiece sectorChosenCone + sectorChosenCone_spec sectorChosenPiece f o s hs + let z := sectorParam o s hs + let w := Classical.choose (sectorCollapse_surjective z) + have hw : sectorCollapse w = z := Classical.choose_spec (sectorCollapse_surjective z) + have hp := E.half_spec f (P.plane.faceVertex f (sectorI o)) + (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩ + have hmember := (hp.2.2.2.1 w.2).1 + have hval : sectorChosenPiece f o ⟨s,hs⟩ = + H.homotopy (P.plane.faceVertex f (sectorI o)) w.1 + (E.half f (P.plane.faceVertex f (sectorI o)) + (P.plane.faceVertex f (sectorJ o)) w.2) := by + change sectorChosenCone f o z = _ + rw [← hw] + exact sectorChosenCone_spec f o w + rw [hval] + exact H.support (P.plane.faceVertex f (sectorI o)) w.1 w.1.2 + (E.half f (P.plane.faceVertex f (sectorI o)) + (P.plane.faceVertex f (sectorJ o)) w.2) hmember + +private theorem sectorTopPositive : + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + (∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j + ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))) → (∀ (s : SectorSimplex), ∀ (o : SectorOrder), (s ∈ + sectorCh o) → (0 < s.1 (sectorI o))) := by + classical + intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrderedSum + s o hs + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum := sectorOrderedSum s (sectorI o) (sectorJ o) (sectorK o) + o.2.1 o.2.2.1 o.2.2.2 + have hj : s.1 (sectorJ o) ≤ s.1 (sectorI o) := hs.1 + have hk : s.1 (sectorK o) ≤ s.1 (sectorJ o) := hs.2 + have hj0 := hc.1 (sectorJ o) + have hk0 := hc.1 (sectorK o) + linarith + +private theorem sectorChosenCone_periodic : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : + P3776T1DualEdges P), + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let sectorCollapse := P3832T1ConeCollapse + (Function.Surjective sectorCollapse) → (∀ (sectorSupportedHalfCone : ∀ {ι : Type}, ∀ (P : + PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ + (f : P.plane.Face), ∀ (a : ι), ∀ (b : ι), (P.plane.adjacent a b) → ((∃ i, + P.plane.faceVertex f i = a) → ((∃ i, P.plane.faceVertex f i = b) → (∃ G : C(SectorCone, ℝ + × ℝ), ∀ z : SectorInterval × SectorInterval, G (sectorCollapse z) = H.homotopy a z.1 + (E.half f a b z.2))))), + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorChosenCone (f : P.plane.Face) (o : SectorOrder) : C(SectorCone,ℝ×ℝ) := + Classical.choose (sectorSupportedHalfCone P H E f + (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) + (∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (z : SectorInterval × SectorInterval), + sectorChosenCone f o (sectorCollapse z) = H.homotopy (P.plane.faceVertex f (sectorI o)) + z.1 (E.half f (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) z.2)) + → (∀ (u : P.lattice), ∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (z : SectorCone), + sectorChosenCone (P.faceShift u f) o z = + sectorChosenCone f o z + GaussianRealPoint u)) := by + classical + intro ι P H E SectorInterval SectorCone sectorCollapse sectorCollapse_surjective + sectorSupportedHalfCone SectorOrder sectorI sectorJ sectorChosenCone sectorChosenCone_spec + u f o z + let w := Classical.choose (sectorCollapse_surjective z) + have hw : sectorCollapse w = z := Classical.choose_spec (sectorCollapse_surjective z) + let a := P.plane.faceVertex f (sectorI o) + let b := P.plane.faceVertex f (sectorJ o) + have hadj := P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1 + have hpath := (E.half_spec f a b hadj ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩).2.2.2.1 w.2 + have hshift := E.half_periodic u f a b hadj ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩ w.2 + have hvI := P.face_vertices_periodic u f (sectorI o) + have hvJ := P.face_vertices_periodic u f (sectorJ o) + calc + sectorChosenCone (P.faceShift u f) o z = + sectorChosenCone (P.faceShift u f) o (sectorCollapse w) := by rw [hw] + _ = H.homotopy (P.plane.faceVertex (P.faceShift u f) (sectorI o)) w.1 + (E.half (P.faceShift u f) (P.plane.faceVertex (P.faceShift u f) (sectorI o)) + (P.plane.faceVertex (P.faceShift u f) (sectorJ o)) w.2) := + sectorChosenCone_spec (P.faceShift u f) o w + _ = H.homotopy (P.shift u a) w.1 + (E.half (P.faceShift u f) (P.shift u a) (P.shift u b) w.2) := by rw [hvI,hvJ] + _ = H.homotopy a w.1 (E.half f a b w.2) + GaussianRealPoint u := by + rw [hshift] + exact H.homotopy_periodic u a w.1 (E.half f a b w.2) w.1.2 hpath.1 + _ = sectorChosenCone f o (sectorCollapse w) + GaussianRealPoint u := by + rw [sectorChosenCone_spec f o w] + _ = sectorChosenCone f o z + GaussianRealPoint u := by rw [hw] + +private theorem sectorGlobalChosen_spec : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : + P3776T1DualEdges P), + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let sectorCollapse := P3832T1ConeCollapse + ∀ (sectorSupportedHalfCone : ∀ {ι : Type}, ∀ (P : PeriodicTileCore ι), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (f : P.plane.Face), ∀ (a : + ι), ∀ (b : ι), (P.plane.adjacent a b) → ((∃ i, P.plane.faceVertex f i = a) → ((∃ i, + P.plane.faceVertex f i = b) → (∃ G : C(SectorCone, ℝ × ℝ), ∀ z : SectorInterval × + SectorInterval, G (sectorCollapse z) = H.homotopy a z.1 (E.half f a b z.2))))), + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i + ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : + {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), + let sectorPiece (o : SectorOrder) + (G : C(SectorCone,ℝ×ℝ)) : C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + ⟨fun s => G (sectorParam o s.1 s.2), + G.continuous.comp (sectorParam_continuous o)⟩ + let sectorChosenCone (f : P.plane.Face) (o : SectorOrder) : C(SectorCone,ℝ×ℝ) := + Classical.choose (sectorSupportedHalfCone P H E f + (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) + let sectorChosenPiece (f : P.plane.Face) (o : SectorOrder) : + C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + sectorPiece o (sectorChosenCone f o) + ∀ (sectorGlobalMap : ∀ (f : P.plane.Face), ∃ F : C(SectorSimplex,ℝ×ℝ), ∀ o s (hs : s ∈ + sectorCh o), F s=sectorChosenPiece f o ⟨s,hs⟩), + let sectorGlobalChosen (f : P.plane.Face) : C(SectorSimplex,ℝ×ℝ) := + Classical.choose (sectorGlobalMap f) + ∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), + sectorGlobalChosen f s = sectorChosenPiece f o ⟨s,hs⟩ := by + classical + intro ι P H E SectorInterval SectorCone sectorCollapse sectorSupportedHalfCone SectorSimplex + sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrderedSum sectorParam + sectorParam_continuous sectorPiece sectorChosenCone sectorChosenPiece sectorGlobalMap + sectorGlobalChosen f o s hs + exact Classical.choose_spec (sectorGlobalMap f) o s hs + +private theorem sectorGlobalChosen_periodic : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : + P3776T1DualEdges P), + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let sectorCollapse := P3832T1ConeCollapse + ∀ (sectorSupportedHalfCone : ∀ {ι : Type}, ∀ (P : PeriodicTileCore ι), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (f : P.plane.Face), ∀ (a : + ι), ∀ (b : ι), (P.plane.adjacent a b) → ((∃ i, P.plane.faceVertex f i = a) → ((∃ i, + P.plane.faceVertex f i = b) → (∃ G : C(SectorCone, ℝ × ℝ), ∀ z : SectorInterval × + SectorInterval, G (sectorCollapse z) = H.homotopy a z.1 (E.half f a b z.2))))), + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + (∀ s : SectorSimplex, ∃ o : SectorOrder, s ∈ sectorCh o) → (∀ (sectorOrderedSum : ∀ (s : + SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ + k) → (s.1 i + s.1 j + s.1 k = 1)))), + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : + {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), + let sectorPiece (o : SectorOrder) + (G : C(SectorCone,ℝ×ℝ)) : C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + ⟨fun s => G (sectorParam o s.1 s.2), + G.continuous.comp (sectorParam_continuous o)⟩ + let sectorChosenCone (f : P.plane.Face) (o : SectorOrder) : C(SectorCone,ℝ×ℝ) := + Classical.choose (sectorSupportedHalfCone P H E f + (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) + let sectorChosenPiece (f : P.plane.Face) (o : SectorOrder) : + C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + sectorPiece o (sectorChosenCone f o) + ∀ (sectorGlobalMap : ∀ (f : P.plane.Face), ∃ F : C(SectorSimplex,ℝ×ℝ), ∀ o s (hs : s ∈ + sectorCh o), F s=sectorChosenPiece f o ⟨s,hs⟩), (∀ (u : P.lattice), ∀ (f : P.plane.Face), + ∀ (o : SectorOrder), ∀ (z : SectorCone), sectorChosenCone (P.faceShift u f) o z = + sectorChosenCone f o z + GaussianRealPoint u) → ( + let sectorGlobalChosen (f : P.plane.Face) : C(SectorSimplex,ℝ×ℝ) := + Classical.choose (sectorGlobalMap f) + (∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), + sectorGlobalChosen f s = sectorChosenPiece f o ⟨s,hs⟩) → (∀ (u : P.lattice), ∀ (f : + P.plane.Face), ∀ (s : SectorSimplex), sectorGlobalChosen (P.faceShift u f) s = + sectorGlobalChosen f s + GaussianRealPoint u))) := by + classical + intro ι P H E SectorInterval SectorCone sectorCollapse sectorSupportedHalfCone SectorSimplex + sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrder_cover + sectorOrderedSum sectorParam sectorParam_continuous sectorPiece sectorChosenCone + sectorChosenPiece sectorGlobalMap sectorChosenCone_periodic sectorGlobalChosen + sectorGlobalChosen_spec u f s + obtain ⟨o,ho⟩ := sectorOrder_cover s + rw [sectorGlobalChosen_spec (P.faceShift u f) o s ho, + sectorGlobalChosen_spec f o s ho] + change sectorChosenCone (P.faceShift u f) o (sectorParam o s ho) = + sectorChosenCone f o (sectorParam o s ho) + GaussianRealPoint u + exact sectorChosenCone_periodic u f o (sectorParam o s ho) + +private theorem sectorGlobalChosen_support : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : + P3776T1DualEdges P), + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let sectorCollapse := P3832T1ConeCollapse + ∀ (sectorSupportedHalfCone : ∀ {ι : Type}, ∀ (P : PeriodicTileCore ι), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (f : P.plane.Face), ∀ (a : + ι), ∀ (b : ι), (P.plane.adjacent a b) → ((∃ i, P.plane.faceVertex f i = a) → ((∃ i, + P.plane.faceVertex f i = b) → (∃ G : C(SectorCone, ℝ × ℝ), ∀ z : SectorInterval × + SectorInterval, G (sectorCollapse z) = H.homotopy a z.1 (E.half f a b z.2))))), + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + (∀ s : SectorSimplex, ∃ o : SectorOrder, s ∈ sectorCh o) → (∀ (sectorOrderedSum : ∀ (s : + SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ + k) → (s.1 i + s.1 j + s.1 k = 1)))), + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : + {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), + let sectorPiece (o : SectorOrder) + (G : C(SectorCone,ℝ×ℝ)) : C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + ⟨fun s => G (sectorParam o s.1 s.2), + G.continuous.comp (sectorParam_continuous o)⟩ + let sectorChosenCone (f : P.plane.Face) (o : SectorOrder) : C(SectorCone,ℝ×ℝ) := + Classical.choose (sectorSupportedHalfCone P H E f + (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) + let sectorChosenPiece (f : P.plane.Face) (o : SectorOrder) : + C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + sectorPiece o (sectorChosenCone f o) + ∀ (sectorGlobalMap : ∀ (f : P.plane.Face), ∃ F : C(SectorSimplex,ℝ×ℝ), ∀ o s (hs : s ∈ + sectorCh o), F s=sectorChosenPiece f o ⟨s,hs⟩), (∀ (f : P.plane.Face), ∀ (o : + SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), sectorChosenPiece f o + ⟨s,hs⟩ ∈ TileRealization (P.tile (P.plane.faceVertex f (sectorI o)))) → ((∀ (s : + SectorSimplex), ∀ (o : SectorOrder), (s ∈ sectorCh o) → (0 < s.1 (sectorI o))) → ( + let sectorGlobalChosen (f : P.plane.Face) : C(SectorSimplex,ℝ×ℝ) := + Classical.choose (sectorGlobalMap f) + (∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), + sectorGlobalChosen f s = sectorChosenPiece f o ⟨s,hs⟩) → (∀ (f : P.plane.Face), ∀ (s : + SectorSimplex), ∃ i, 0 < s.1 i ∧ sectorGlobalChosen f s ∈ + TileRealization (P.tile (P.plane.faceVertex f i)))))) := by + classical + intro ι P H E SectorInterval SectorCone sectorCollapse sectorSupportedHalfCone SectorSimplex + sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrder_cover + sectorOrderedSum sectorParam sectorParam_continuous sectorPiece sectorChosenCone + sectorChosenPiece sectorGlobalMap sectorChosenPiece_support sectorTopPositive + sectorGlobalChosen sectorGlobalChosen_spec f s + obtain ⟨o,ho⟩ := sectorOrder_cover s + refine ⟨sectorI o, sectorTopPositive s o ho, ?_⟩ + rw [sectorGlobalChosen_spec f o s ho] + exact sectorChosenPiece_support f o s ho + +private theorem sectorGlobalChosen_vertex : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : + P3776T1DualEdges P), + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let sectorCollapse := P3832T1ConeCollapse + ∀ (sectorSupportedHalfCone : ∀ {ι : Type}, ∀ (P : PeriodicTileCore ι), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (f : P.plane.Face), ∀ (a : + ι), ∀ (b : ι), (P.plane.adjacent a b) → ((∃ i, P.plane.faceVertex f i = a) → ((∃ i, + P.plane.faceVertex f i = b) → (∃ G : C(SectorCone, ℝ × ℝ), ∀ z : SectorInterval × + SectorInterval, G (sectorCollapse z) = H.homotopy a z.1 (E.half f a b z.2))))), + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + (∀ s : SectorSimplex, ∃ o : SectorOrder, s ∈ sectorCh o) → ((∀ (o : SectorOrder), ∀ (n : Fin + 3), n = sectorI o ∨ n = sectorJ o ∨ n = sectorK o) → (∀ (sectorOrderedSum : ∀ (s : + SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ + k) → (s.1 i + s.1 j + s.1 k = 1)))), + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + (∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), (sectorParam o s + hs).1.1 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o) ∧ (sectorParam o s + hs).1.2 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))) → (∀ (sectorParam_continuous : ∀ (o : + SectorOrder), Continuous (fun s : {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o + s.1 s.2)), + let sectorPiece (o : SectorOrder) + (G : C(SectorCone,ℝ×ℝ)) : C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + ⟨fun s => G (sectorParam o s.1 s.2), + G.continuous.comp (sectorParam_continuous o)⟩ + let sectorChosenCone (f : P.plane.Face) (o : SectorOrder) : C(SectorCone,ℝ×ℝ) := + Classical.choose (sectorSupportedHalfCone P H E f + (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) + (∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (z : SectorInterval × SectorInterval), + sectorChosenCone f o (sectorCollapse z) = H.homotopy (P.plane.faceVertex f (sectorI o)) + z.1 (E.half f (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) z.2)) + → ( + let sectorChosenPiece (f : P.plane.Face) (o : SectorOrder) : + C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + sectorPiece o (sectorChosenCone f o) + ∀ (sectorGlobalMap : ∀ (f : P.plane.Face), ∃ F : C(SectorSimplex,ℝ×ℝ), ∀ o s (hs : s ∈ + sectorCh o), F s=sectorChosenPiece f o ⟨s,hs⟩), + let sectorGlobalChosen (f : P.plane.Face) : C(SectorSimplex,ℝ×ℝ) := + Classical.choose (sectorGlobalMap f) + (∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), + sectorGlobalChosen f s = sectorChosenPiece f o ⟨s,hs⟩) → (∀ (f : P.plane.Face), ∀ (i : + Fin 3), ∀ (s : SectorSimplex), (∀ j, s.1 j = if j = i then 1 else 0) → + (sectorGlobalChosen f s = H.center (P.plane.faceVertex f i))))))) := by + classical + intro ι P H E SectorInterval SectorCone sectorCollapse sectorSupportedHalfCone SectorSimplex + sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrder_cover + sectorIndexCover sectorOrderedSum sectorParam sectorParam_values sectorParam_continuous + sectorPiece sectorChosenCone sectorChosenCone_spec sectorChosenPiece sectorGlobalMap + sectorGlobalChosen sectorGlobalChosen_spec f i s hcoord + obtain ⟨o,ho⟩ := sectorOrder_cover s + have hI : sectorI o = i := by + rcases sectorIndexCover o i with h | h | h + · exact h.symm + · have hJ : s.1 (sectorJ o) = 1 := by rw [← h]; simp [hcoord] + have hIzero : s.1 (sectorI o) = 0 := by + have hneq : sectorI o ≠ i := fun e => o.2.1 (e.trans h) + simpa [hneq] using hcoord (sectorI o) + linarith [ho.1] + · have hK : s.1 (sectorK o) = 1 := by rw [← h]; simp [hcoord] + have hJzero : s.1 (sectorJ o) = 0 := by + have hneq : sectorJ o ≠ i := fun e => o.2.2.2 (e.trans h) + simpa [hneq] using hcoord (sectorJ o) + have hIzero : s.1 (sectorI o) = 0 := by + have hneq : sectorI o ≠ i := fun e => o.2.2.1 (e.trans h) + simpa [hneq] using hcoord (sectorI o) + linarith [ho.1, ho.2] + have hJ : s.1 (sectorJ o) = 0 := by + have hij : sectorJ o ≠ i := by rw [← hI]; exact o.2.1.symm + simpa [hij] using hcoord (sectorJ o) + have hK : s.1 (sectorK o) = 0 := by + have hik : sectorK o ≠ i := by rw [← hI]; exact o.2.2.1.symm + simpa [hik] using hcoord (sectorK o) + have hr : (sectorParam o s ho).1.1 = ⟨0, by norm_num [SectorInterval]⟩ := by + apply Subtype.ext + rcases sectorParam_values o s ho with ⟨hr,_⟩ + rw [hr,hJ,hK] + norm_num [SectorInterval] + have hb : (sectorParam o s ho).1.2 = ⟨0, by norm_num [SectorInterval]⟩ := by + apply Subtype.ext + rcases sectorParam_values o s ho with ⟨_,hb⟩ + rw [hb,hJ,hK] + norm_num + let t0 : SectorInterval := ⟨0, by norm_num [SectorInterval]⟩ + have hparam : sectorParam o s ho = sectorCollapse (t0,t0) := by + apply Subtype.ext + apply Prod.ext + · exact hr + · apply Subtype.ext + simp [sectorCollapse, P3832T1ConeCollapse, t0, hb] + rw [sectorGlobalChosen_spec f o s ho] + change sectorChosenCone f o (sectorParam o s ho) = _ + rw [hparam, sectorChosenCone_spec] + have hp := E.half_spec f (P.plane.faceVertex f (sectorI o)) + (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩ + have hm := (hp.2.2.2.1 t0).1 + have hm0 : GaussianRealPoint (P.rho f) ∈ + TileRealization (P.tile (P.plane.faceVertex f (sectorI o))) := by + have hml : E.half f (P.plane.faceVertex f (sectorI o)) + (P.plane.faceVertex f (sectorJ o)) ⟨0,by norm_num [t0]⟩ ∈ + TileRealization (P.tile (P.plane.faceVertex f (sectorI o))) := by simpa [t0] using hm + rw [hp.2.1] at hml + exact hml + rw [hp.2.1] + rw [hI] + rw [hI] at hm0 + exact H.zero (P.plane.faceVertex f i) (GaussianRealPoint (P.rho f)) hm0 + +private theorem sectorGlobalChosen_edge : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : + P3776T1DualEdges P), + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let sectorCollapse := P3832T1ConeCollapse + ∀ (sectorSupportedHalfCone : ∀ {ι : Type}, ∀ (P : PeriodicTileCore ι), ∀ (H : + P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (f : P.plane.Face), ∀ (a : + ι), ∀ (b : ι), (P.plane.adjacent a b) → ((∃ i, P.plane.faceVertex f i = a) → ((∃ i, + P.plane.faceVertex f i = b) → (∃ G : C(SectorCone, ℝ × ℝ), ∀ z : SectorInterval × + SectorInterval, G (sectorCollapse z) = H.homotopy a z.1 (E.half f a b z.2))))), + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i + ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + (∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), (sectorParam o s + hs).1.1 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o) ∧ (sectorParam o s + hs).1.2 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))) → (∀ (sectorParam_continuous : ∀ (o : + SectorOrder), Continuous (fun s : {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o + s.1 s.2)), + let sectorPiece (o : SectorOrder) + (G : C(SectorCone,ℝ×ℝ)) : C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + ⟨fun s => G (sectorParam o s.1 s.2), + G.continuous.comp (sectorParam_continuous o)⟩ + let sectorChosenCone (f : P.plane.Face) (o : SectorOrder) : C(SectorCone,ℝ×ℝ) := + Classical.choose (sectorSupportedHalfCone P H E f + (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) + (∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (z : SectorInterval × SectorInterval), + sectorChosenCone f o (sectorCollapse z) = H.homotopy (P.plane.faceVertex f (sectorI o)) + z.1 (E.half f (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) z.2)) + → ( + let sectorChosenPiece (f : P.plane.Face) (o : SectorOrder) : + C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + sectorPiece o (sectorChosenCone f o) + ∀ (sectorGlobalMap : ∀ (f : P.plane.Face), ∃ F : C(SectorSimplex,ℝ×ℝ), ∀ o s (hs : s ∈ + sectorCh o), F s=sectorChosenPiece f o ⟨s,hs⟩), + let sectorGlobalChosen (f : P.plane.Face) : C(SectorSimplex,ℝ×ℝ) := + Classical.choose (sectorGlobalMap f) + (∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), + sectorGlobalChosen f s = sectorChosenPiece f o ⟨s,hs⟩) → (∀ (f : P.plane.Face), ∀ (i : + Fin 3), ∀ (j : Fin 3), (i ≠ j) → (∀ (r : SectorInterval), ∀ (s : SectorSimplex), (∀ k, + s.1 k = if k = i then (r : ℝ) else if k = j then 1-r else 0) → (sectorGlobalChosen f s = + if (r : ℝ) ≤ 1/2 then + H.homotopy (P.plane.faceVertex f j) (2 * (r : ℝ)) + (E.port (P.plane.faceVertex f i) (P.plane.faceVertex f j)) + else + H.homotopy (P.plane.faceVertex f i) (2 * (1 - (r : ℝ))) + (E.port (P.plane.faceVertex f i) (P.plane.faceVertex f j))))))) := by + classical + intro ι P H E SectorInterval SectorCone sectorCollapse sectorSupportedHalfCone SectorSimplex + sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrderedSum sectorParam + sectorParam_values sectorParam_continuous sectorPiece sectorChosenCone + sectorChosenCone_spec sectorChosenPiece sectorGlobalMap sectorGlobalChosen + sectorGlobalChosen_spec f i j hij r s hcoord + have hexists : ∀ i j : Fin 3, i ≠ j → ∃ k : Fin 3, i ≠ k ∧ j ≠ k := by decide + obtain ⟨k,hik,hjk⟩ := hexists i j hij + have hi : s.1 i = (r : ℝ) := by simpa [hij] using hcoord i + have hj : s.1 j = 1-r := by simpa [Ne.symm hij] using hcoord j + have hk : s.1 k = 0 := by simpa [Ne.symm hik, Ne.symm hjk] using hcoord k + by_cases hr : (r : ℝ) ≤ 1/2 + · let o : SectorOrder := ⟨(j,i,k), hij.symm, hjk, hik⟩ + have ho : s ∈ sectorCh o := by + change s.1 i ≤ s.1 j ∧ s.1 k ≤ s.1 i + rw [hi,hj,hk] + constructor <;> nlinarith [hr, r.2.1] + have hrad0 : 0 ≤ 2 * (r : ℝ) := mul_nonneg (by norm_num) r.2.1 + have hrad1 : 2 * (r : ℝ) ≤ 1 := by nlinarith [hr] + let rad : SectorInterval := ⟨2*(r:ℝ), hrad0, hrad1⟩ + let one : SectorInterval := ⟨1, by exact ⟨by norm_num, le_rfl⟩⟩ + have hrad : (sectorParam o s ho).1.1 = rad := by + apply Subtype.ext + have vals := sectorParam_values o s ho + simp? [o, sectorJ, sectorK] at vals + calc + (sectorParam o s ho).1.1 = 2*(s.1 i-s.1 k)+3*s.1 k := vals.1 + _ = 2*(r:ℝ) := by rw [hi,hk]; ring + _ = (rad : ℝ) := rfl + have hbeta : (sectorParam o s ho).1.2 = rad := by + apply Subtype.ext + have vals := sectorParam_values o s ho + simp? [o, sectorJ, sectorK] at vals + calc + (sectorParam o s ho).1.2 = 2*(s.1 i-s.1 k) := vals.2 + _ = 2*(r:ℝ) := by rw [hi,hk]; ring + _ = (rad : ℝ) := rfl + have hparam : sectorParam o s ho = sectorCollapse (rad,one) := by + apply Subtype.ext + apply Prod.ext + · exact hrad + · apply Subtype.ext + calc + (sectorParam o s ho).1.2 = (rad : ℝ) := congrArg Subtype.val hbeta + _ = (rad : ℝ) * (one : ℝ) := by simp [one] + rw [sectorGlobalChosen_spec f o s ho] + change sectorChosenCone f o (sectorParam o s ho) = _ + rw [hparam, sectorChosenCone_spec] + change H.homotopy (P.plane.faceVertex f j) (rad : ℝ) + (E.half f (P.plane.faceVertex f j) (P.plane.faceVertex f i) one) = _ + have hp := E.half_spec f (P.plane.faceVertex f j) (P.plane.faceVertex f i) + (P.plane.face_edges f j i hij.symm) ⟨j,rfl⟩ ⟨i,rfl⟩ + have hone : one = ⟨1, by norm_num [SectorInterval]⟩ := by apply Subtype.ext; rfl + rw [hone, hp.2.2.1] + have hport := E.port_symmetric (P.plane.faceVertex f i) (P.plane.faceVertex f j) + (P.plane.face_edges f i j hij) + rw [← hport] + rw [ite_eq_left hr] + · let o : SectorOrder := ⟨(i,j,k), hij, hik, hjk⟩ + have ho : s ∈ sectorCh o := by + change s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j + rw [hi,hj,hk] + constructor <;> nlinarith [r.2.1,r.2.2,hr] + have hq0 : 0 ≤ 2*(1-(r:ℝ)) := by linarith [r.2.2] + have hq1 : 2*(1-(r:ℝ)) ≤ 1 := by linarith + let rad : SectorInterval := ⟨2*(1-(r:ℝ)),hq0,hq1⟩ + let one : SectorInterval := ⟨1, by exact ⟨by norm_num, le_rfl⟩⟩ + have hrad : (sectorParam o s ho).1.1 = rad := by + apply Subtype.ext + have vals := sectorParam_values o s ho + simp? [o, sectorJ, sectorK] at vals + calc + (sectorParam o s ho).1.1 = 2*(s.1 j-s.1 k)+3*s.1 k := vals.1 + _ = 2*(1-(r:ℝ)) := by rw [hj,hk]; ring + _ = (rad : ℝ) := rfl + have hbeta : (sectorParam o s ho).1.2 = rad := by + apply Subtype.ext + have vals := sectorParam_values o s ho + simp? [o, sectorJ, sectorK] at vals + calc + (sectorParam o s ho).1.2 = 2*(s.1 j-s.1 k) := vals.2 + _ = 2*(1-(r:ℝ)) := by rw [hj,hk]; ring + _ = (rad : ℝ) := rfl + have hparam : sectorParam o s ho = sectorCollapse (rad,one) := by + apply Subtype.ext + apply Prod.ext + · exact hrad + · apply Subtype.ext + calc + (sectorParam o s ho).1.2 = (rad : ℝ) := congrArg Subtype.val hbeta + _ = (rad : ℝ) * (one : ℝ) := by simp [one] + rw [sectorGlobalChosen_spec f o s ho] + change sectorChosenCone f o (sectorParam o s ho) = _ + rw [hparam, sectorChosenCone_spec] + change H.homotopy (P.plane.faceVertex f i) (rad : ℝ) + (E.half f (P.plane.faceVertex f i) (P.plane.faceVertex f j) one) = _ + have hp := E.half_spec f (P.plane.faceVertex f i) (P.plane.faceVertex f j) + (P.plane.face_edges f i j hij) ⟨i,rfl⟩ ⟨j,rfl⟩ + have hone : one = ⟨1, by norm_num [SectorInterval]⟩ := by apply Subtype.ext; rfl + rw [hone, hp.2.2.1] + rw [ite_eq_right hr] + +end SectorMapsProof + +theorem P3776T1SectorMapsExist {ι : Type} (P : PeriodicTileCore ι) + (H : P3776T1TileContractions P) (E : P3776T1DualEdges P) : + Nonempty (P3776T1SectorMaps P H E) := by +-- BODY + classical + let SectorInterval := Set.Icc (0 : ℝ) 1 + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} + let sectorCollapse := P3832T1ConeCollapse + have sectorCollapse_surjective := SectorMapsProof.sectorCollapse_surjective + have sectorConeDescent (g : C(SectorInterval × SectorInterval, ℝ × ℝ)) (c : ℝ × ℝ) + (hzero : ∀ t : SectorInterval, g (⟨0, by norm_num [SectorInterval]⟩, t) = c) := + SectorMapsProof.sectorConeDescent g c hzero + have sectorSupportedHalfCone {ι : Type} (P : PeriodicTileCore ι) + (H : P3776T1TileContractions P) (E : P3776T1DualEdges P) + (f : P.plane.Face) (a b : ι) (hab : P.plane.adjacent a b) + (ha : ∃ i, P.plane.faceVertex f i = a) + (hb : ∃ i, P.plane.faceVertex f i = b) := SectorMapsProof.sectorSupportedHalfCone + sectorConeDescent (ι := ι) P H E f a b hab ha hb + let SectorSimplex := StandardSimplex (Fin 3) + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + have sectorOrderExists := SectorMapsProof.sectorOrderExists + have sectorChamber_closed := SectorMapsProof.sectorChamber_closed + have sectorOrder_cover := SectorMapsProof.sectorOrder_cover sectorOrderExists + have sectorIndexCover (o : SectorOrder) (n : Fin 3) := SectorMapsProof.sectorIndexCover o n + have sectorOrderedSum (s : SectorSimplex) (i j k : Fin 3) + (hij : i ≠ j) (hik : i ≠ k) (hjk : j ≠ k) := SectorMapsProof.sectorOrderedSum s i j k hij + hik hjk + let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + have sectorParam_values (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) := + SectorMapsProof.sectorParam_values sectorOrderedSum o s hs + have sectorParam_continuous (o : SectorOrder) := SectorMapsProof.sectorParam_continuous + sectorOrderedSum o + have sectorOrdersTie (s : SectorSimplex) (o o' : SectorOrder) + (ho : s ∈ sectorCh o) (ho' : s ∈ sectorCh o') := SectorMapsProof.sectorOrdersTie s o o' ho ho' + have sectorOrderedBetaTop (s : SectorSimplex) (o o' : SectorOrder) + (ho : s ∈ sectorCh o) (ho' : s ∈ sectorCh o') + (ht : s.1 (sectorI o)=s.1 (sectorJ o)) := SectorMapsProof.sectorOrderedBetaTop s o o' ho + ho' ht + have sectorOrderedRBottom (s : SectorSimplex) (o o' : SectorOrder) + (ho : s ∈ sectorCh o) (ho' : s ∈ sectorCh o') + (ht : s.1 (sectorJ o)=s.1 (sectorK o)) := SectorMapsProof.sectorOrderedRBottom s o o' ho + ho' ht + have sectorTopTieParams (s : SectorSimplex) (o o' : SectorOrder) + (ho : s ∈ sectorCh o) (ho' : s ∈ sectorCh o') + (ht : s.1 (sectorI o)=s.1 (sectorJ o)) := SectorMapsProof.sectorTopTieParams + sectorOrderedSum sectorParam_values sectorOrderedBetaTop s o o' ho ho' ht + have sectorBottomTieParams (s : SectorSimplex) (o o' : SectorOrder) + (ho : s ∈ sectorCh o) (ho' : s ∈ sectorCh o') + (ht : s.1 (sectorJ o)=s.1 (sectorK o)) := SectorMapsProof.sectorBottomTieParams + sectorOrderedSum sectorOrderedRBottom s o o' ho + ho' ht + have sectorBottomSameTop (s : SectorSimplex) (o o' : SectorOrder) + (ho : s ∈ sectorCh o) (ho' : s ∈ sectorCh o') + (ht : s.1 (sectorJ o)=s.1 (sectorK o)) := SectorMapsProof.sectorBottomSameTop s o o' ho ho' ht + have sectorTopTieOther (s : SectorSimplex) (o o' : SectorOrder) + (ho : s ∈ sectorCh o) (ho' : s ∈ sectorCh o') + (ht : s.1 (sectorI o)=s.1 (sectorJ o)) := SectorMapsProof.sectorTopTieOther s o o' ho ho' ht + have sectorBottomTieOther (s : SectorSimplex) (o o' : SectorOrder) + (ho : s ∈ sectorCh o) (ho' : s ∈ sectorCh o') + (ht : s.1 (sectorJ o)=s.1 (sectorK o)) := SectorMapsProof.sectorBottomTieOther s o o' ho + ho' ht + have sectorTopPairClassify (s : SectorSimplex) (o o' : SectorOrder) + (ho : s ∈ sectorCh o) (ho' : s ∈ sectorCh o') + (ht : s.1 (sectorI o)=s.1 (sectorJ o)) + (ht' : s.1 (sectorI o')=s.1 (sectorJ o')) := SectorMapsProof.sectorTopPairClassify s o o' + ho ho' ht ht' + let sectorPiece (o : SectorOrder) + (G : C(SectorCone,ℝ×ℝ)) : C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + ⟨fun s => G (sectorParam o s.1 s.2), + G.continuous.comp (sectorParam_continuous o)⟩ + let sectorChosenCone (f : P.plane.Face) (o : SectorOrder) : C(SectorCone,ℝ×ℝ) := + Classical.choose (sectorSupportedHalfCone P H E f + (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) + (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) + ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) + have sectorChosenCone_spec (f : P.plane.Face) (o : SectorOrder) + (z : SectorInterval × SectorInterval) := SectorMapsProof.sectorChosenCone_spec ι P + H E sectorSupportedHalfCone f o z + let sectorChosenPiece (f : P.plane.Face) (o : SectorOrder) : + C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := + sectorPiece o (sectorChosenCone f o) + have sectorChosenPiece_top (f : P.plane.Face) (o : SectorOrder) (s : SectorSimplex) + (hs : s ∈ sectorCh o) (ht : s.1 (sectorI o)=s.1 (sectorJ o)) := + SectorMapsProof.sectorChosenPiece_top ι P H E + sectorSupportedHalfCone sectorOrderedSum sectorParam_continuous sectorTopTieParams + sectorChosenCone_spec f o s hs ht + have sectorChosenPiece_bottom (f : P.plane.Face) (o : SectorOrder) (s : SectorSimplex) + (hs : s ∈ sectorCh o) (ht : s.1 (sectorJ o)=s.1 (sectorK o)) := + SectorMapsProof.sectorChosenPiece_bottom ι P H E sectorSupportedHalfCone + sectorOrderedSum sectorParam_continuous sectorBottomTieParams sectorChosenCone_spec + f o s hs ht + have sectorParam_beta_zero (o : SectorOrder) (s : SectorSimplex) + (hs : s ∈ sectorCh o) (ht : s.1 (sectorJ o)=s.1 (sectorK o)) := + SectorMapsProof.sectorParam_beta_zero sectorOrderedSum sectorParam_values o s hs ht + have sectorChosenPieces_agree (f : P.plane.Face) (s : SectorSimplex) + (o o' : SectorOrder) (ho : s ∈ sectorCh o) (ho' : s ∈ sectorCh o') := + SectorMapsProof.sectorChosenPieces_agree ι P H E sectorSupportedHalfCone + sectorOrderedSum sectorParam_continuous sectorOrdersTie sectorTopTieParams + sectorBottomTieParams sectorBottomSameTop sectorTopTieOther sectorBottomTieOther + sectorTopPairClassify sectorChosenPiece_top sectorChosenPiece_bottom + sectorParam_beta_zero f s o o' ho ho' + have sectorGlobalMap (f : P.plane.Face) := SectorMapsProof.sectorGlobalMap ι P H E + sectorSupportedHalfCone + sectorOrder_cover sectorOrderedSum sectorParam_continuous sectorChosenPieces_agree f + have sectorChosenPiece_support (f : P.plane.Face) (o : SectorOrder) + (s : SectorSimplex) (hs : s ∈ sectorCh o) := SectorMapsProof.sectorChosenPiece_support ι P + H E sectorCollapse_surjective + sectorSupportedHalfCone sectorOrderedSum sectorParam_continuous sectorChosenCone_spec + f o s hs + have sectorTopPositive (s : SectorSimplex) (o : SectorOrder) + (hs : s ∈ sectorCh o) := SectorMapsProof.sectorTopPositive + sectorOrderedSum s o hs + have sectorChosenCone_periodic (u : P.lattice) (f : P.plane.Face) + (o : SectorOrder) (z : SectorCone) := SectorMapsProof.sectorChosenCone_periodic + ι P H E sectorCollapse_surjective sectorSupportedHalfCone sectorChosenCone_spec u f o z + let sectorGlobalChosen (f : P.plane.Face) : C(SectorSimplex,ℝ×ℝ) := + Classical.choose (sectorGlobalMap f) + have sectorGlobalChosen_spec (f : P.plane.Face) (o : SectorOrder) + (s : SectorSimplex) (hs : s ∈ sectorCh o) := SectorMapsProof.sectorGlobalChosen_spec ι P H + E sectorSupportedHalfCone + sectorOrderedSum sectorParam_continuous sectorGlobalMap f o s hs + have sectorGlobalChosen_periodic (u : P.lattice) (f : P.plane.Face) + (s : SectorSimplex) := SectorMapsProof.sectorGlobalChosen_periodic ι P H E + sectorSupportedHalfCone + sectorOrder_cover sectorOrderedSum sectorParam_continuous sectorGlobalMap + sectorChosenCone_periodic sectorGlobalChosen_spec u f s + have sectorGlobalChosen_support (f : P.plane.Face) (s : SectorSimplex) := + SectorMapsProof.sectorGlobalChosen_support ι P H E sectorSupportedHalfCone + sectorOrder_cover sectorOrderedSum sectorParam_continuous sectorGlobalMap + sectorChosenPiece_support sectorTopPositive sectorGlobalChosen_spec f s + have sectorGlobalChosen_vertex (f : P.plane.Face) (i : Fin 3) (s : SectorSimplex) + (hcoord : ∀ j, s.1 j = if j = i then 1 else 0) := SectorMapsProof.sectorGlobalChosen_vertex + ι P H E sectorSupportedHalfCone + sectorOrder_cover sectorIndexCover sectorOrderedSum sectorParam_values + sectorParam_continuous sectorChosenCone_spec sectorGlobalMap sectorGlobalChosen_spec f + i s hcoord + have sectorGlobalChosen_edge (f : P.plane.Face) (i j : Fin 3) (hij : i ≠ j) + (r : SectorInterval) (s : SectorSimplex) + (hcoord : ∀ k, s.1 k = if k = i then (r : ℝ) else if k = j then 1-r else 0) := + SectorMapsProof.sectorGlobalChosen_edge ι P H E sectorSupportedHalfCone + sectorOrderedSum sectorParam_values sectorParam_continuous sectorChosenCone_spec + sectorGlobalMap sectorGlobalChosen_spec f i j hij r s hcoord + refine ⟨{ + faceMap := sectorGlobalChosen + support := ?_ + vertex := ?_ + edge := ?_ + periodic := ?_ + }⟩ + · intro f s + exact sectorGlobalChosen_support f s + · intro f i s hcoord + exact sectorGlobalChosen_vertex f i s hcoord + · intro f i j hij r s hcoord + exact sectorGlobalChosen_edge f i j hij r s hcoord + · intro u f s + exact sectorGlobalChosen_periodic u f s + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1StarWeights.lean b/LeanPool/ApollonianSuperharmonic/P3776T1StarWeights.lean new file mode 100644 index 0000000000..6a7adfc0a9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1StarWeights.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3776T1OpenStar +public import LeanPool.ApollonianSuperharmonic.StandardSimplex + +/-! +# P3776T1StarWeights + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +-- [TABLET NODE: P3776T1StarWeights] +/-- +For $P$, star coordinates are continuous real functions $w_a$ on the +plane, nonnegative and positive exactly on $U_a$ of +`P3776T1OpenStar`. On every closed face region the three +functions at its numbered vertices form a point of the standard +two-simplex. On the arc $ab$ all functions other than $w_a,w_b$ vanish; +at the position of $b$, $w_a$ is $1$ if $a=b$ and $0$ otherwise. +They satisfy $w_{u+a}(x+[u])=w_a(x)$ for every lattice translation. +-/ +structure P3776T1StarWeights {ι : Type} (P : PeriodicTileCore ι) where +-- BODY + /-- The nonnegative continuous barycentric weight supported on each open vertex star. -/ + weight : ι → (Real × Real) → Real + continuous : ∀ a, Continuous (weight a) + nonnegative : ∀ a x, 0 ≤ weight a x + positive_iff : ∀ a x, 0 < weight a x ↔ x ∈ P3776T1OpenStar P a + face_simplex : ∀ f x, x ∈ closure (P.plane.faceRegion f) → + (fun i => weight (P.plane.faceVertex f i) x) ∈ StandardSimplex (Fin 3) + edge_support : ∀ a b, P.plane.adjacent a b → ∀ x, + x ∈ P.plane.edgeArc a b → ∀ c, c ≠ a → c ≠ b → weight c x = 0 + vertex_value : ∀ a b, + weight a (P.plane.position b) = + @ite Real (a = b) (Classical.propDecidable _) 1 0 + periodic : ∀ u : P.lattice, ∀ a x, + weight (P.shift u a) (x + GaussianRealPoint u) = weight a x + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1StarWeightsExist.lean b/LeanPool/ApollonianSuperharmonic/P3776T1StarWeightsExist.lean new file mode 100644 index 0000000000..6d6863fd5e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1StarWeightsExist.lean @@ -0,0 +1,545 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry +public import LeanPool.ApollonianSuperharmonic.P3776T1StarWeights +public import Mathlib.Topology.MetricSpace.HausdorffDistance +public import Mathlib.Topology.Algebra.Monoid +public import Mathlib.Algebra.BigOperators.Finprod + +-- [TABLET NODE: P3776T1StarWeightsExist] + +/-! +# P3776T1StarWeightsExist + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace StarWeightsProof + +private theorem hfaceEdge : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (f : P.plane.Face), ∀ (a : ι), ∀ (b : ι), + P.plane.adjacent a b → (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = a) → (∃ (i : Fin (3 + : ℕ)), P.plane.faceVertex f i = b) → P.plane.edgeArc a b ⊆ closure (P.plane.faceRegion f) + := by + classical + intro ι P f a b hab ha hb + obtain ⟨i, hi⟩ := ha + obtain ⟨j, hj⟩ := hb + have hij : i ≠ j := by + intro h + have hab' : a = b := hi.symm.trans ((congrArg (P.plane.faceVertex f) h).trans hj) + exact P.plane.adjacent_irreflexive a (hab' ▸ hab) + have heq : P.plane.edgeArc a b = P.plane.edgeArc (P.plane.faceVertex f i) + (P.plane.faceVertex f j) := by rw [← hi, ← hj] + have hside : P.plane.edgeArc a b ⊆ frontier (P.plane.faceRegion f) := by + rw [heq] + rw [P.plane.face_boundary f] + fin_cases i <;> fin_cases j + all_goals + first + | exact (hij rfl).elim + | intro x hx + first + | exact Or.inl (Or.inl hx) + | rw [P.plane.arc_symmetric] at hx + exact Or.inl (Or.inl hx) + | exact Or.inl (Or.inr hx) + | rw [P.plane.arc_symmetric] at hx + exact Or.inl (Or.inr hx) + | exact Or.inr hx + | rw [P.plane.arc_symmetric] at hx + exact Or.inr hx + exact Set.Subset.trans hside frontier_subset_closure + +private theorem hstarFace : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U : ι → Set (Real × Real) := P3776T1OpenStar P + (Nontrivial ι ∧ (∀ (f : P.plane.Face), IsCompact (closure (P.plane.faceRegion f))) ∧ (∀ (K : + Set (ℝ × ℝ)), IsCompact K → {f : P.plane.Face | (K ∩ closure (P.plane.faceRegion + f)).Nonempty}.Finite) ∧ (∀ (x : ℝ × ℝ), ∃ (f : P.plane.Face), x ∈ closure + (P.plane.faceRegion f)) ∧ (∀ (a : ι), IsOpen (P3776T1OpenStar P a) ∧ IsCompact (closure + (P3776T1OpenStar P a))) ∧ (∀ (x : ℝ × ℝ), ∃ (a : ι), x ∈ P3776T1OpenStar P a) ∧ (∀ (u + : ↥P.lattice), ∀ (a : ι), P3776T1OpenStar P (P.shift u a) = (fun (x : ℝ × ℝ) => x + + GaussianRealPoint (↑u : GaussianInt)) '' P3776T1OpenStar P a) ∧ ∀ (u : ↥P.lattice), ∀ + (v : ↥P.lattice), ∀ (a : ι), P.shift u a = P.shift v a → u = v) → (∀ [Nontrivial ι], + (∀ (f : P.plane.Face), ∀ (a : ι), ∀ (b : ι), (P.plane.adjacent a b) → ((∃ i, + P.plane.faceVertex f i = a) → ((∃ i, P.plane.faceVertex f i = b) → (P.plane.edgeArc a b ⊆ + closure (P.plane.faceRegion f))))) → (∀ (a : ι), ∀ x ∈ U a, ∃ (f : P.plane.Face), x ∈ + closure (P.plane.faceRegion f) ∧ ∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = a)) := by + classical + intro ι P U hgeom hnontriv hfaceEdge a x hx + rcases hx with hpos | hedge | hface + · rw [hpos] + obtain ⟨f, hxf⟩ := hgeom.2.2.2.1 (P.plane.position a) + have hnotreg : P.plane.position a ∉ P.plane.faceRegion f := by + have hdis := (P3767T1FixedFaceComponents P.plane).1 f |>.1 + exact fun h => (Set.disjoint_left.mp hdis) (Or.inl ⟨a, rfl⟩) h + have hfr : P.plane.position a ∈ frontier (P.plane.faceRegion f) := by + have hopen := P.plane.region_open f + have hcl : P.plane.position a ∈ closure (P.plane.faceRegion f) := hxf + rw [frontier, (P.plane.region_open f).interior_eq] + exact ⟨hcl, hnotreg⟩ + rw [P.plane.face_boundary f] at hfr + rcases hfr with hfr | hfr + · rcases hfr with hfr | hfr + · have hend := (P3767T1VertexEdgeIncidence P.plane a).2 + (P.plane.faceVertex f 0) (P.plane.faceVertex f 1) + (P.plane.face_edges f 0 1 (by decide)) hfr + rcases hend with h | h + · exact ⟨f, hxf, ⟨0, h.symm⟩⟩ + · exact ⟨f, hxf, ⟨1, h.symm⟩⟩ + · have hend := (P3767T1VertexEdgeIncidence P.plane a).2 + (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) + (P.plane.face_edges f 1 2 (by decide)) hfr + rcases hend with h | h + · exact ⟨f, hxf, ⟨1, h.symm⟩⟩ + · exact ⟨f, hxf, ⟨2, h.symm⟩⟩ + · have hend := (P3767T1VertexEdgeIncidence P.plane a).2 + (P.plane.faceVertex f 2) (P.plane.faceVertex f 0) + (P.plane.face_edges f 2 0 (by decide)) hfr + rcases hend with h | h + · exact ⟨f, hxf, ⟨2, h.symm⟩⟩ + · exact ⟨f, hxf, ⟨0, h.symm⟩⟩ + · rcases hedge with ⟨b, hab, hxab, hxa, hxb⟩ + obtain ⟨f, g, hfg, ⟨hfa, hfb⟩, _, hall⟩ := + P.plane.every_edge_two_faces a b hab + refine ⟨f, ?_, hfa⟩ + exact hfaceEdge f a b hab hfa hfb hxab + · rcases hface with ⟨f, hfa, hxf⟩ + exact ⟨f, subset_closure hxf, hfa⟩ + +private theorem hpairLabel : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (d : ι), + P.plane.adjacent a b → P.plane.adjacent c d → ∀ x ∈ P.plane.edgeArc a b ∩ P.plane.edgeArc + c d, x ≠ P.plane.position a → x ≠ P.plane.position b → a = c ∨ a = d := by + classical + intro ι P a b c d hab hcd x hx hxa hxb + by_cases hsets : ({a, b} : Set ι) = {c, d} + · have ha : a ∈ ({c, d} : Set ι) := hsets ▸ (by simp) + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using ha + · have hintersection := P.plane.arc_intersections a b c d hab hcd hsets + rw [hintersection] at hx + obtain ⟨v, hv, hvx⟩ := hx + have hvab : v = a ∨ v = b := by + simpa only [Set.mem_inter_iff, Set.mem_insert_iff, Set.mem_singleton_iff] using hv.1 + rcases hvab with h | h + · subst v + exact (hxa hvx.symm).elim + · subst v + exact (hxb hvx.symm).elim + +private theorem hfaceStarLabel : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U : ι → Set (Real × Real) := P3776T1OpenStar P + ∀ [Nontrivial ι], (∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (d : ι), (P.plane.adjacent a b) → + ((P.plane.adjacent c d) → (∀ (x : Real × Real), (x ∈ P.plane.edgeArc a b ∩ + P.plane.edgeArc c d) → ((x ≠ P.plane.position a) → ((x ≠ P.plane.position b) → (a = c ∨ a + = d)))))) → (∀ (f : P.plane.Face), ∀ x ∈ closure (P.plane.faceRegion f), ∀ (a : ι), x ∈ U + a → ∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = a) := by + classical + intro ι P U hnontriv hpairLabel f x hxf a hxa + have htraceAvoid := (P3767T1FixedFaceComponents P.plane).1 f + by_cases hregion : x ∈ P.plane.faceRegion f + · rcases hxa with hpos | hedge | ⟨g, hga, hxg⟩ + · exact False.elim ((Set.disjoint_left.mp htraceAvoid.1) + (Or.inl ⟨a, hpos.symm⟩) hregion) + · rcases hedge with ⟨b, hab, hxarc, _, _⟩ + exact False.elim ((Set.disjoint_left.mp htraceAvoid.1) + (Or.inr ⟨a, b, hab, hxarc⟩) hregion) + · by_cases hgf : g = f + · subst g + exact hga + · exact False.elim (Set.disjoint_left.mp (P.plane.region_disjoint hgf) hxg hregion) + · have hfront : x ∈ frontier (P.plane.faceRegion f) := by + rw [frontier, (P.plane.region_open f).interior_eq] + exact ⟨hxf, hregion⟩ + have hxtrace := htraceAvoid.2 hfront + rcases hxa with hpos | hedge | hface + · rw [hpos] at hfront + rw [P.plane.face_boundary f] at hfront + rcases hfront with hrest | h20 + · rcases hrest with h01 | h12 + · have h := (P3767T1VertexEdgeIncidence P.plane a).2 + (P.plane.faceVertex f 0) (P.plane.faceVertex f 1) + (P.plane.face_edges f 0 1 (by decide)) h01 + rcases h with h | h + · exact ⟨0, h.symm⟩ + · exact ⟨1, h.symm⟩ + · have h := (P3767T1VertexEdgeIncidence P.plane a).2 + (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) + (P.plane.face_edges f 1 2 (by decide)) h12 + rcases h with h | h + · exact ⟨1, h.symm⟩ + · exact ⟨2, h.symm⟩ + · have h : a = P.plane.faceVertex f 2 ∨ a = P.plane.faceVertex f 0 := by + exact (P3767T1VertexEdgeIncidence P.plane a).2 + (P.plane.faceVertex f 2) (P.plane.faceVertex f 0) + (P.plane.face_edges f 2 0 (by decide)) h20 + rcases h with h | h + · exact ⟨2, h.symm⟩ + · exact ⟨0, h.symm⟩ + · rcases hedge with ⟨b, hab, hxab, hxa', hxb'⟩ + rw [P.plane.face_boundary f] at hfront + rcases hfront with hrest | h20 + · rcases hrest with h01 | h12 + · have hlabel : a = P.plane.faceVertex f 0 ∨ a = P.plane.faceVertex f 1 := by + exact hpairLabel a b (P.plane.faceVertex f 0) (P.plane.faceVertex f 1) + hab (P.plane.face_edges f 0 1 (by decide)) x ⟨hxab, h01⟩ hxa' hxb' + rcases hlabel with h | h + · exact ⟨0, h.symm⟩ + · exact ⟨1, h.symm⟩ + · have hlabel : a = P.plane.faceVertex f 1 ∨ a = P.plane.faceVertex f 2 := by + exact hpairLabel a b (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) + hab (P.plane.face_edges f 1 2 (by decide)) x ⟨hxab, h12⟩ hxa' hxb' + rcases hlabel with h | h + · exact ⟨1, h.symm⟩ + · exact ⟨2, h.symm⟩ + · have hlabel : a = P.plane.faceVertex f 2 ∨ a = P.plane.faceVertex f 0 := by + exact hpairLabel a b (P.plane.faceVertex f 2) (P.plane.faceVertex f 0) + hab (P.plane.face_edges f 2 0 (by decide)) x ⟨hxab, h20⟩ hxa' hxb' + rcases hlabel with h | h + · exact ⟨2, h.symm⟩ + · exact ⟨0, h.symm⟩ + · rcases hface with ⟨g, hga, hxg⟩ + exact False.elim (Set.disjoint_left.mp + ((P3767T1FixedFaceComponents P.plane).1 g).1 hxtrace hxg) + +private theorem hvertexStar : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U : ι → Set (Real × Real) := P3776T1OpenStar P + ∀ [Nontrivial ι], ∀ (a : ι), ∀ (b : ι), P.plane.position b ∈ U a ↔ a = b := by + classical + intro ι P U hnontriv a b + constructor + · intro h + rcases h with hpos | hedge | hface + · exact (P.plane.position_injective hpos).symm + · rcases hedge with ⟨c, hac, hbc, hxa, hxb⟩ + have hend := (P3767T1VertexEdgeIncidence P.plane b).2 a c hac hbc + rcases hend with h | h + · exact (hxa (congrArg P.plane.position h)).elim + · exact (hxb (congrArg P.plane.position h)).elim + · rcases hface with ⟨f, hfa, hfb⟩ + exact False.elim ((Set.disjoint_left.mp + ((P3767T1FixedFaceComponents P.plane).1 f).1) + (Or.inl ⟨b, rfl⟩) hfb) + · rintro rfl + exact Or.inl rfl + +private theorem hEdgeNoOther : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U : ι → Set (Real × Real) := P3776T1OpenStar P + ∀ [Nontrivial ι], (∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (d : ι), (P.plane.adjacent a b) → + ((P.plane.adjacent c d) → (∀ (x : Real × Real), (x ∈ P.plane.edgeArc a b ∩ + P.plane.edgeArc c d) → ((x ≠ P.plane.position a) → ((x ≠ P.plane.position b) → (a = c ∨ a + = d)))))) → (∀ (a : ι), ∀ (b : ι), P.plane.adjacent a b → ∀ x ∈ P.plane.edgeArc a b, ∀ (c + : ι), c ≠ a → c ≠ b → x ∉ U c) := by + classical + intro ι P U hnontriv hpairLabel a b hab x hx c hca hcb hc + rcases hc with hpos | hedge | hface + · rw [hpos] at hx + have hend := (P3767T1VertexEdgeIncidence P.plane c).2 a b hab hx + rcases hend with h | h + · exact hca h + · exact hcb h + · rcases hedge with ⟨d', hcd, hxc, hxc', hxd'⟩ + have hlabel := hpairLabel c d' a b hcd hab x ⟨hxc, hx⟩ hxc' hxd' + rcases hlabel with h | h + · exact hca h + · exact hcb h + · rcases hface with ⟨f, hfa, hxf⟩ + exact (Set.disjoint_left.mp ((P3767T1FixedFaceComponents P.plane).1 f).1) + (Or.inr ⟨a, b, hab, hx⟩) hxf + +private theorem hlf : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U : ι → Set (Real × Real) := P3776T1OpenStar P + (Nontrivial ι ∧ (∀ (f : P.plane.Face), IsCompact (closure (P.plane.faceRegion f))) ∧ (∀ (K : + Set (ℝ × ℝ)), IsCompact K → {f : P.plane.Face | (K ∩ closure (P.plane.faceRegion + f)).Nonempty}.Finite) ∧ (∀ (x : ℝ × ℝ), ∃ (f : P.plane.Face), x ∈ closure + (P.plane.faceRegion f)) ∧ (∀ (a : ι), IsOpen (P3776T1OpenStar P a) ∧ IsCompact (closure + (P3776T1OpenStar P a))) ∧ (∀ (x : ℝ × ℝ), ∃ (a : ι), x ∈ P3776T1OpenStar P a) ∧ (∀ (u + : ↥P.lattice), ∀ (a : ι), P3776T1OpenStar P (P.shift u a) = (fun (x : ℝ × ℝ) => x + + GaussianRealPoint (↑u : GaussianInt)) '' P3776T1OpenStar P a) ∧ ∀ (u : ↥P.lattice), ∀ + (v : ↥P.lattice), ∀ (a : ι), P.shift u a = P.shift v a → u = v) → ((∀ (a : ι), ∀ (x : + Real × Real), (x ∈ U a) → (∃ f, x ∈ closure (P.plane.faceRegion f) ∧ ∃ i, + P.plane.faceVertex f i = a)) → (LocallyFinite U)) := by + classical + intro ι P U hgeom hstarFace x + refine ⟨Metric.ball x (1:Real), Metric.ball_mem_nhds x (by norm_num), ?_⟩ + let K := Metric.closedBall x (1:Real) + have hKcompact : IsCompact K := isCompact_closedBall x 1 + let F := {f : P.plane.Face | (K ∩ closure (P.plane.faceRegion f)).Nonempty} + have hF : F.Finite := hgeom.2.2.1 K hKcompact + let S : Set ι := {a | (U a ∩ Metric.ball x 1).Nonempty} + have hS : S ⊆ ⋃ f ∈ F, Set.range (P.plane.faceVertex f) := by + intro a ha + change (U a ∩ Metric.ball x 1).Nonempty at ha + obtain ⟨z, ⟨hza, hzB⟩⟩ := ha + obtain ⟨f, hzf, i, hia⟩ := hstarFace a z hza + have hzK : z ∈ K := Metric.mem_closedBall.mpr (le_of_lt hzB) + exact Set.mem_iUnion.mpr ⟨f, Set.mem_iUnion.mpr ⟨by + change (K ∩ closure (P.plane.faceRegion f)).Nonempty + exact ⟨z, hzK, hzf⟩, ⟨i, hia⟩⟩⟩ + have hfinite : S.Finite := by + exact Set.Finite.subset (hF.biUnion fun f _ => Set.finite_range (P.plane.faceVertex f)) hS + simpa [S] using hfinite + +private theorem hne : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U : ι → Set (Real × Real) := P3776T1OpenStar P + ∀ [Nontrivial ι], ∀ a, (U a)ᶜ.Nonempty := by + classical + intro ι P U hnontriv a + obtain ⟨b, hba⟩ := exists_ne a + refine ⟨P.plane.position b, ?_⟩ + intro hb + rcases hb with hpos | hedge | hface + · exact hba (P.plane.position_injective hpos) + · rcases hedge with ⟨c, hac, hbc, hxc, hxd⟩ + have hend := (P3767T1VertexEdgeIncidence P.plane b).2 a c hac hbc + rcases hend with h | h + · exact hxc (congrArg P.plane.position h) + · exact hxd (congrArg P.plane.position h) + · rcases hface with ⟨f, hfa, hfb⟩ + have hdis := (P3767T1FixedFaceComponents P.plane).1 f |>.1 + exact (Set.disjoint_left.mp hdis) (Or.inl ⟨b, rfl⟩) hfb + +private theorem hdistShift : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U : ι → Set (Real × Real) := P3776T1OpenStar P + (Nontrivial ι ∧ (∀ (f : P.plane.Face), IsCompact (closure (P.plane.faceRegion f))) ∧ (∀ (K : + Set (ℝ × ℝ)), IsCompact K → {f : P.plane.Face | (K ∩ closure (P.plane.faceRegion + f)).Nonempty}.Finite) ∧ (∀ (x : ℝ × ℝ), ∃ (f : P.plane.Face), x ∈ closure + (P.plane.faceRegion f)) ∧ (∀ (a : ι), IsOpen (P3776T1OpenStar P a) ∧ IsCompact (closure + (P3776T1OpenStar P a))) ∧ (∀ (x : ℝ × ℝ), ∃ (a : ι), x ∈ P3776T1OpenStar P a) ∧ (∀ (u + : ↥P.lattice), ∀ (a : ι), P3776T1OpenStar P (P.shift u a) = (fun (x : ℝ × ℝ) => x + + GaussianRealPoint (↑u : GaussianInt)) '' P3776T1OpenStar P a) ∧ ∀ (u : ↥P.lattice), ∀ + (v : ↥P.lattice), ∀ (a : ι), P.shift u a = P.shift v a → u = v) → ( + let d : ι → (Real × Real) → Real := fun a x => Metric.infDist x (U a)ᶜ + ∀ (u : ↥P.lattice), ∀ (a : ι), ∀ (x : ℝ × ℝ), d (P.shift u a) (x + GaussianRealPoint (↑u : + GaussianInt)) = d a x) := by + classical + intro ι P U hgeom d u a x + let Φ : (Real × Real) → (Real × Real) := fun y => y + GaussianRealPoint u + have hIso : Isometry Φ := by + intro y z + change edist (y.1 + (GaussianRealPoint u).1, y.2 + (GaussianRealPoint u).2) + (z.1 + (GaussianRealPoint u).1, z.2 + (GaussianRealPoint u).2) = edist y z + have h1 : dist (y.1 + (GaussianRealPoint u).1) (z.1 + (GaussianRealPoint u).1) = + dist y.1 z.1 := by + rw [Real.dist_eq, Real.dist_eq] + congr 1; ring + have h2 : dist (y.2 + (GaussianRealPoint u).2) (z.2 + (GaussianRealPoint u).2) = + dist y.2 z.2 := by + rw [Real.dist_eq, Real.dist_eq] + congr 1; ring + rw [Prod.edist_eq, Prod.edist_eq, edist_dist, edist_dist, edist_dist, edist_dist, + h1, h2] + have hU : U (P.shift u a) = Φ '' U a := hgeom.2.2.2.2.2.2.1 u a + have hcomp : (U (P.shift u a))ᶜ = Φ '' (U a)ᶜ := by + ext y + constructor + · intro hy + refine ⟨y - GaussianRealPoint u, ?_, ?_⟩ + · intro hya + apply hy + rw [hU] + exact ⟨y - GaussianRealPoint u, hya, by dsimp [Φ]; simp⟩ + · dsimp [Φ] + exact sub_add_cancel y (GaussianRealPoint u) + · rintro ⟨z, hz, rfl⟩ hy + apply hz + rw [hU] at hy + rcases hy with ⟨w, hw, hwy⟩ + have hwz : w = z := add_right_cancel hwy + simpa [hwz] using hw + dsimp [d, Φ] + rw [hcomp] + exact Metric.infDist_image hIso + +private theorem hsuppAt449 : + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U : ι → Set (Real × Real) := P3776T1OpenStar P + (∀ (f : P.plane.Face), ∀ (x : Real × Real), (x ∈ closure (P.plane.faceRegion f)) → (∀ (a : + ι), (x ∈ U a) → (∃ i, P.plane.faceVertex f i = a))) → ( + let d : ι → (Real × Real) → Real := fun a x => Metric.infDist x (U a)ᶜ + let D : (Real × Real) → Real := fun x => ∑ᶠ a, d a x + (∀ (a : ι), ∀ (x : Real × Real), 0 < d a x ↔ x ∈ U a) → (∀ (f : P.plane.Face), ∀ (x : ℝ × ℝ), + (x ∈ closure (P.plane.faceRegion f)) → ( + let S : Finset ι := @Finset.image (Fin 3) ι (Classical.decEq ι) (P.plane.faceVertex f) + Finset.univ + Function.support (fun a => d a x / D x) ⊆ (S : Set ι)))) := by + classical + intro ι P U hfaceStarLabel d D hdpos f x hxf S a ha + change d a x / D x ≠ 0 at ha + have hda : d a x ≠ 0 := by + intro hz + apply ha + simp [hz] + have hdaPos : 0 < d a x := + (Metric.infDist_nonneg : 0 ≤ d a x).lt_iff_ne'.2 hda + obtain ⟨i, hi⟩ := hfaceStarLabel f x hxf a ((hdpos a x).mp hdaPos) + exact Finset.mem_image.mpr ⟨i, Finset.mem_univ _, hi⟩ + +end StarWeightsProof + +theorem P3776T1StarWeightsExist {ι : Type} (P : PeriodicTileCore ι) : + Nonempty (P3776T1StarWeights P) := by +-- BODY + classical + let U : ι → Set (Real × Real) := P3776T1OpenStar P + have hgeom := P3776T1FixedGeometry P + let hnontriv : Nontrivial ι := hgeom.1 + have hfaceEdge (f : P.plane.Face) (a b : ι) (hab : P.plane.adjacent a b) + (ha : ∃ i, P.plane.faceVertex f i = a) + (hb : ∃ i, P.plane.faceVertex f i = b) : + P.plane.edgeArc a b ⊆ closure (P.plane.faceRegion f) := StarWeightsProof.hfaceEdge ι P f a + b hab ha hb + have hstarFace (a : ι) (x : Real × Real) (hx : x ∈ U a) : + ∃ f, x ∈ closure (P.plane.faceRegion f) ∧ + ∃ i, P.plane.faceVertex f i = a := StarWeightsProof.hstarFace ι P hgeom hfaceEdge a x hx + have hpairLabel (a b c d : ι) (hab : P.plane.adjacent a b) + (hcd : P.plane.adjacent c d) (x : Real × Real) + (hx : x ∈ P.plane.edgeArc a b ∩ P.plane.edgeArc c d) + (hxa : x ≠ P.plane.position a) (hxb : x ≠ P.plane.position b) : + a = c ∨ a = d := StarWeightsProof.hpairLabel ι P a b c d hab hcd x hx hxa hxb + have hfaceStarLabel (f : P.plane.Face) (x : Real × Real) + (hxf : x ∈ closure (P.plane.faceRegion f)) (a : ι) (hxa : x ∈ U a) : + ∃ i, P.plane.faceVertex f i = a := StarWeightsProof.hfaceStarLabel ι P hpairLabel f x hxf + a hxa + have hvertexStar (a b : ι) : + P.plane.position b ∈ U a ↔ a = b := StarWeightsProof.hvertexStar ι P a b + have hEdgeNoOther (a b : ι) (hab : P.plane.adjacent a b) + (x : Real × Real) (hx : x ∈ P.plane.edgeArc a b) (c : ι) + (hca : c ≠ a) (hcb : c ≠ b) : x ∉ U c := StarWeightsProof.hEdgeNoOther ι P hpairLabel a b + hab x hx c hca hcb + have hlf : LocallyFinite U := StarWeightsProof.hlf ι P hgeom hstarFace + have hne : ∀ a, (U a)ᶜ.Nonempty := StarWeightsProof.hne ι P + let d : ι → (Real × Real) → Real := fun a x => Metric.infDist x (U a)ᶜ + let D : (Real × Real) → Real := fun x => ∑ᶠ a, d a x + have hdpos (a : ι) (x : Real × Real) : 0 < d a x ↔ x ∈ U a := by + change 0 < Metric.infDist x (P3776T1OpenStar P a)ᶜ ↔ + x ∈ P3776T1OpenStar P a + simpa only [Set.notMem_compl_iff] using + (((hgeom.2.2.2.2.1 a).1).isClosed_compl.notMem_iff_infDist_pos (hne a)).symm + have hdsupp (a : ι) : Function.support (d a) = U a := by + ext x + change d a x ≠ 0 ↔ x ∈ U a + rw [← (Metric.infDist_nonneg : 0 ≤ d a x).lt_iff_ne'] + exact hdpos a x + have hld : LocallyFinite (fun a => Function.support (d a)) := by + simpa only [hdsupp] using hlf + have hdc (a : ι) : Continuous (d a) := Metric.continuous_infDist_pt _ + have hDc : Continuous D := by + exact continuous_finsum hdc hld + have hDpos (x : Real × Real) : 0 < D x := by + apply finsum_pos (fun a => Metric.infDist_nonneg) + · obtain ⟨a, ha⟩ := hgeom.2.2.2.2.2.1 x + exact ⟨a, (hdpos a x).2 ha⟩ + · exact hld.point_finite x + have hsum (x : Real × Real) : (∑ᶠ a, d a x / D x) = 1 := by + change (∑ᶠ a, d a x / (∑ᶠ j, d j x)) = 1 + simp_rw [div_eq_mul_inv] + rw [← finsum_mul (fun a => d a x) ((∑ᶠ j, d j x)⁻¹)] + exact mul_inv_cancel₀ (ne_of_gt (hDpos x)) + have hweight_cont (a : ι) : Continuous (fun x => d a x / D x) := + (hdc a).div hDc (fun x => ne_of_gt (hDpos x)) + have hshiftInv (u : P.lattice) (a : ι) : P.shift (-u) (P.shift u a) = a := by + rw [← P.shift_add, neg_add_cancel, P.shift_zero] + have hshiftInv' (u : P.lattice) (a : ι) : P.shift u (P.shift (-u) a) = a := by + rw [← P.shift_add, add_neg_cancel, P.shift_zero] + have hshiftBij (u : P.lattice) : Function.Bijective (P.shift u) := by + constructor + · intro a b hab + have h := congrArg (P.shift (-u)) hab + simpa only [hshiftInv] using h + · intro b + exact ⟨P.shift (-u) b, hshiftInv' u b⟩ + have hdistShift (u : P.lattice) (a : ι) (x : Real × Real) : + d (P.shift u a) (x + GaussianRealPoint u) = d a x := StarWeightsProof.hdistShift ι P hgeom + u a x + have hDShift (u : P.lattice) (x : Real × Real) : + D (x + GaussianRealPoint u) = D x := by + change (∑ᶠ a, d a (x + GaussianRealPoint u)) = _ + rw [← finsum_comp (P.shift u) (hshiftBij u)] + simp_rw [hdistShift] + rfl + refine ⟨{ + weight := fun a x => d a x / D x + continuous := hweight_cont + nonnegative := ?_ + positive_iff := ?_ + face_simplex := ?_ + edge_support := ?_ + vertex_value := ?_ + periodic := ?_ + }⟩ + · intro a x + exact (div_nonneg (Metric.infDist_nonneg) (le_of_lt (hDpos x))) + · intro a x + rw [div_pos_iff_of_pos_right (hDpos x)] + exact hdpos a x + · intro f x hxf + change (∀ i : Fin 3, 0 ≤ d (P.plane.faceVertex f i) x / D x) ∧ + (∑ i : Fin 3, d (P.plane.faceVertex f i) x / D x) = 1 + constructor + · intro i + exact div_nonneg Metric.infDist_nonneg (le_of_lt (hDpos x)) + · let S : Finset ι := @Finset.image (Fin 3) ι (Classical.decEq ι) (P.plane.faceVertex f) + Finset.univ + have hsupp : Function.support (fun a => d a x / D x) ⊆ (S : Set ι) := + StarWeightsProof.hsuppAt449 ι P hfaceStarLabel hdpos f x hxf + have hinj : Set.InjOn (P.plane.faceVertex f) (↑(Finset.univ : Finset (Fin 3))) := by + intro i hi j hj hij + exact (P.plane.face_vertices_distinct f) hij + have htotal := hsum x + rw [finsum_eq_sum_of_support_subset _ hsupp] at htotal + rw [Finset.sum_image hinj] at htotal + simpa [S] using htotal + · intro a b hab x hx c hca hcb + have hn : x ∉ U c := hEdgeNoOther a b hab x hx c hca hcb + have hnpos : ¬ 0 < d c x := fun hp => hn ((hdpos c x).mp hp) + have hzero : d c x = 0 := le_antisymm (le_of_not_gt hnpos) Metric.infDist_nonneg + simp [hzero] + · intro a b + by_cases hab : a = b + · subst b + have hzero (c : ι) (hca : c ≠ a) : d c (P.plane.position a) = 0 := by + have hn : ¬ 0 < d c (P.plane.position a) := by + intro hp + exact hca ((hvertexStar c a).mp ((hdpos c (P.plane.position a)).mp hp)) + exact le_antisymm (le_of_not_gt hn) Metric.infDist_nonneg + have hsupp : Function.support (fun c => d c (P.plane.position a) / D (P.plane.position a)) ⊆ + ({a} : Finset ι) := by + intro c hc + by_contra hca + have hca' : c ≠ a := by simpa using hca + have hz := hzero c hca' + change d c (P.plane.position a) / D (P.plane.position a) ≠ 0 at hc + simp [hz] at hc + have htotal := hsum (P.plane.position a) + rw [finsum_eq_sum_of_support_subset _ hsupp] at htotal + simpa using htotal + · have hzero : d a (P.plane.position b) = 0 := by + have hn : ¬ 0 < d a (P.plane.position b) := by + intro hp + exact hab ((hvertexStar a b).mp ((hdpos a (P.plane.position b)).mp hp)) + exact le_antisymm (le_of_not_gt hn) Metric.infDist_nonneg + simp [hzero, hab] + · intro u a x + rw [hdistShift, hDShift] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1TileContractions.lean b/LeanPool/ApollonianSuperharmonic/P3776T1TileContractions.lean new file mode 100644 index 0000000000..70a9785392 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1TileContractions.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore + +-- [TABLET NODE: P3776T1TileContractions] + +/-! +# P3776T1TileContractions + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A contraction family for $P$ consists of a point $c_a\in I(T_a)$ and +a map $H_a:[0,1]\times I(T_a)\to I(T_a)$, continuous on this domain, +with $H_a(0,z)=c_a$ and $H_a(1,z)=z$. The ambiently defined functions +outside these domains have no prescribed behavior. The centers and +homotopies commute with lattice translation: +$c_{u+a}=c_a+[u]$ and $H_{u+a}(t,z+[u])=H_a(t,z)+[u]$. +-/ +structure P3776T1TileContractions {ι : Type} (P : PeriodicTileCore ι) where +-- BODY + /-- The equivariantly selected contraction center of each tile realization. -/ + center : ι → (Real × Real) + /-- The equivariant homotopy from the selected center to the identity on each tile. -/ + homotopy : ι → Real → (Real × Real) → (Real × Real) + center_mem : ∀ a, center a ∈ TileRealization (P.tile a) + continuous : ∀ a, ContinuousOn (fun x : Real × (Real × Real) => homotopy a x.1 x.2) + (Set.Icc (0 : Real) 1 ×ˢ TileRealization (P.tile a)) + zero : ∀ a z, z ∈ TileRealization (P.tile a) → homotopy a 0 z = center a + one : ∀ a z, z ∈ TileRealization (P.tile a) → homotopy a 1 z = z + support : ∀ a t, t ∈ Set.Icc (0 : Real) 1 → ∀ z, + z ∈ TileRealization (P.tile a) → homotopy a t z ∈ TileRealization (P.tile a) + center_periodic : ∀ u : P.lattice, ∀ a, + center (P.shift u a) = center a + GaussianRealPoint u + homotopy_periodic : ∀ u : P.lattice, ∀ a t z, + t ∈ Set.Icc (0 : Real) 1 → z ∈ TileRealization (P.tile a) → + homotopy (P.shift u a) t (z + GaussianRealPoint u) = + homotopy a t z + GaussianRealPoint u + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1TileContractionsExist.lean b/LeanPool/ApollonianSuperharmonic/P3776T1TileContractionsExist.lean new file mode 100644 index 0000000000..701e6159f1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1TileContractionsExist.lean @@ -0,0 +1,403 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3776T1TileContractions +public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import Mathlib.Analysis.Normed.Module.Convex + +-- [TABLET NODE: P3776T1TileContractionsExist] + +/-! +# P3776T1TileContractionsExist + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TileContractionProof + +private theorem scale_mem : + (by + classical + exact + let ball : Set (Real × Real) := Metric.closedBall (0 : Real × Real) 1 + ∀ t ∈ Set.Icc (0 : ℝ) (1 : ℝ), ∀ (x : (↑ball : Type)), t • (↑x : ℝ × ℝ) ∈ ball + ) := by + classical + intro ball t ht x + change dist (t • x.val) 0 ≤ 1 + have hx : ‖x.val‖ ≤ 1 := by + have hxmem : x.val ∈ Metric.closedBall (0 : Real × Real) 1 := by + simp [ball] + have hx' := Metric.mem_closedBall.mp hxmem + simpa [dist_eq_norm] using hx' + have ht' := Set.mem_Icc.mp ht + rw [dist_eq_norm, sub_zero, norm_smul, Real.norm_eq_abs, + abs_of_nonneg ht'.1] + have hm : t * ‖x.val‖ ≤ 1 * 1 := by + calc + t * ‖x.val‖ ≤ t * 1 := mul_le_mul_of_nonneg_left hx ht'.1 + _ ≤ 1 * 1 := by nlinarith [ht'.2] + simpa using hm + +private theorem realization_translate : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let rep : ι → ι := fun a => Classical.choose (P.vertex_orbit_representatives a) + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period : ι → P.lattice := fun a => Classical.choose (rep_spec a).2 + (∀ (a : ι), a = P.shift (period a) (rep a)) → (∀ (a : ι), TileRealization (P.tile a) = + (fun (z : ℝ × ℝ) => z + GaussianRealPoint (↑(period a) : GaussianInt)) '' + TileRealization (P.tile (rep a))) + ) := by + classical + intro ι P rep rep_spec period coord a + have h := (TileTranslationFormulas (P.tile (rep a)) (period a : GaussianInt)).2.2.2.1 + calc + TileRealization (P.tile a) = + TileRealization (P.tile (P.shift (period a) (rep a))) := by + exact congrArg (fun i => TileRealization (P.tile i)) (coord a) + _ = TileRealization (TileTranslation (P.tile (rep a)) (period a : GaussianInt)) := by + rw [P.tile_periodic] + _ = (fun z : Real × Real => z + GaussianRealPoint (period a : GaussianInt)) '' + TileRealization (P.tile (rep a)) := by + rw [h] + apply congrArg (fun f : (Real × Real) → (Real × Real) => + f '' TileRealization (P.tile (rep a))) + funext z + apply Prod.ext <;> + simp [GaussianRealPoint, GaussianInt.intCast_re, GaussianInt.intCast_im] + +private theorem local_continuous : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let ball : Set (Real × Real) := Metric.closedBall (0 : Real × Real) 1 + let diskMap (r : ι) : ball ≃ₜ TileRealization (P.tile r) := + Classical.choice (show Nonempty (ball ≃ₜ TileRealization (P.tile r)) from + by simpa [ball, LatticeTile, TopologicalDisk] using P.tiles_are_disks r) + ∀ (scale_mem : ∀ (t : Real), (t ∈ Set.Icc (0 : Real) 1) → (∀ (x : ball), t • x.val ∈ ball)), + let localHomotopy (r : ι) (t : Real) (z : Real × Real) : Real × Real := + if hz : z ∈ TileRealization (P.tile r) then + if ht : t ∈ Set.Icc (0 : Real) 1 then + let x := (diskMap r).symm ⟨z, hz⟩ + ((diskMap r) ⟨t • x.val, scale_mem t ht x⟩).val + else (diskMap r) ⟨0, by simp [ball, Metric.mem_closedBall]⟩ |>.val + else (diskMap r) ⟨0, by simp [ball, Metric.mem_closedBall]⟩ |>.val + let localDomain (r : ι) : Set (Real × (Real × Real)) := + Set.Icc (0 : Real) 1 ×ˢ TileRealization (P.tile r) + ∀ (r : ι), ContinuousOn (fun (p : ℝ × ℝ × ℝ) => localHomotopy r p.1 p.2) (localDomain r) + ) := by + classical + intro ι P ball diskMap scale_mem localHomotopy localDomain r + rw [continuousOn_iff_continuous_domRestrict] + let D := localDomain r + let point : D → TileRealization (P.tile r) := fun p => + ⟨p.val.2, (Set.mem_prod.mp p.property).2⟩ + have hpoint : Continuous point := by + apply Continuous.subtype_mk + exact continuous_snd.comp continuous_subtype_val + let x : D → ball := fun p => (diskMap r).symm (point p) + have hx : Continuous x := (diskMap r).symm.continuous.comp hpoint + let scaled : D → ball := fun p => + ⟨p.val.1 • (x p).val, + scale_mem p.val.1 (Set.mem_prod.mp p.property).1 (x p)⟩ + have hscaled : Continuous scaled := by + apply Continuous.subtype_mk + exact (continuous_fst.comp continuous_subtype_val).smul + (continuous_subtype_val.comp hx) + let out : D → TileRealization (P.tile r) := fun p => (diskMap r) (scaled p) + have hout : Continuous out := (diskMap r).continuous.comp hscaled + have hval : Continuous (fun p : D => (out p).val) := + continuous_subtype_val.comp hout + apply hval.congr + intro p + have hp := Set.mem_prod.mp p.property + change (out p).val = localHomotopy r p.val.1 p.val.2 + unfold localHomotopy + rw [dite_eq_left hp.2, dite_eq_left hp.1] + +private theorem homotopy_continuous : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let rep : ι → ι := fun a => Classical.choose (P.vertex_orbit_representatives a) + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period : ι → P.lattice := fun a => Classical.choose (rep_spec a).2 + let ball : Set (Real × Real) := Metric.closedBall (0 : Real × Real) 1 + let diskMap (r : ι) : ball ≃ₜ TileRealization (P.tile r) := + Classical.choice (show Nonempty (ball ≃ₜ TileRealization (P.tile r)) from + by simpa [ball, LatticeTile, TopologicalDisk] using P.tiles_are_disks r) + let center (a : ι) : Real × Real := + (diskMap (rep a) ⟨0, by simp [ball, Metric.mem_closedBall]⟩).val + + GaussianRealPoint (period a : GaussianInt) + ∀ (scale_mem : ∀ (t : Real), (t ∈ Set.Icc (0 : Real) 1) → (∀ (x : ball), t • x.val ∈ ball)), + let localHomotopy (r : ι) (t : Real) (z : Real × Real) : Real × Real := + if hz : z ∈ TileRealization (P.tile r) then + if ht : t ∈ Set.Icc (0 : Real) 1 then + let x := (diskMap r).symm ⟨z, hz⟩ + ((diskMap r) ⟨t • x.val, scale_mem t ht x⟩).val + else (diskMap r) ⟨0, by simp [ball, Metric.mem_closedBall]⟩ |>.val + else (diskMap r) ⟨0, by simp [ball, Metric.mem_closedBall]⟩ |>.val + let homotopy (a : ι) (t : Real) (z : Real × Real) : Real × Real := + if z ∈ TileRealization (P.tile a) then + localHomotopy (rep a) t (z - GaussianRealPoint (period a : GaussianInt)) + + GaussianRealPoint (period a : GaussianInt) + else center a + let localDomain (r : ι) : Set (Real × (Real × Real)) := + Set.Icc (0 : Real) 1 ×ˢ TileRealization (P.tile r) + (∀ (r : ι), ContinuousOn (fun p : Real × (Real × Real) => localHomotopy r p.1 p.2) + (localDomain r)) → ((∀ (a : ι), ∀ (z : Real × Real), (z ∈ TileRealization (P.tile a)) + → (z - GaussianRealPoint (period a : GaussianInt) ∈ TileRealization (P.tile (rep + a)))) → ( + let targetDomain (a : ι) : Set (Real × (Real × Real)) := + Set.Icc (0 : Real) 1 ×ˢ TileRealization (P.tile a) + ∀ (a : ι), ContinuousOn (fun (p : ℝ × ℝ × ℝ) => homotopy a p.1 p.2) (targetDomain a))) + ) := by + classical + intro ι P rep rep_spec period ball diskMap center scale_mem localHomotopy homotopy localDomain + local_continuous translated_preimage targetDomain a + rw [continuousOn_iff_continuous_domRestrict] + let D := targetDomain a + let Dlocal := localDomain (rep a) + let toLocal : D → Dlocal := fun p => + ⟨(p.val.1, p.val.2 - GaussianRealPoint (period a : GaussianInt)), by + rw [Set.mem_prod] + exact ⟨(Set.mem_prod.mp p.property).1, + translated_preimage a p.val.2 (Set.mem_prod.mp p.property).2⟩⟩ + have htoLocal : Continuous toLocal := by + apply Continuous.subtype_mk + exact Continuous.prodMk (continuous_fst.comp continuous_subtype_val) + ((continuous_snd.comp continuous_subtype_val).sub continuous_const) + have hlocal : Continuous + (fun p : Dlocal => localHomotopy (rep a) p.val.1 p.val.2) := + continuousOn_iff_continuous_domRestrict.mp (local_continuous (rep a)) + have hpre : Continuous + (fun p : D => localHomotopy (rep a) (toLocal p).val.1 (toLocal p).val.2) := by + exact hlocal.comp htoLocal + have hout : Continuous + (fun p : D => localHomotopy (rep a) (toLocal p).val.1 (toLocal p).val.2 + + GaussianRealPoint (period a : GaussianInt)) := + hpre.add continuous_const + apply hout.congr + intro p + have hp := Set.mem_prod.mp p.property + change localHomotopy (rep a) (toLocal p).val.1 (toLocal p).val.2 + + GaussianRealPoint (period a : GaussianInt) = homotopy a p.val.1 p.val.2 + unfold homotopy + rw [ite_eq_left hp.2] + +private theorem shift_free : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ u v : P.lattice, ∀ a, P.shift u a = P.shift v + a → u = v + ) := by + classical + intro ι P u v a huv + have hpos := congrArg P.plane.position huv + rw [P.position_periodic u a, P.position_periodic v a] at hpos + have hpoint : GaussianRealPoint (u : GaussianInt) = + GaussianRealPoint (v : GaussianInt) := add_left_cancel hpos + simp only [GaussianRealPoint, Prod.mk.injEq] at hpoint + apply Subtype.ext + apply Zsqrtd.ext + · exact_mod_cast hpoint.1 + · exact_mod_cast hpoint.2 + +private theorem period_shift : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let rep : ι → ι := fun a => Classical.choose (P.vertex_orbit_representatives a) + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period : ι → P.lattice := fun a => Classical.choose (rep_spec a).2 + (∀ (a : ι), a = P.shift (period a) (rep a)) → ((∀ (u : P.lattice), ∀ (a : ι), rep + (P.shift u a) = rep a) → ((∀ u v : P.lattice, ∀ a, P.shift u a = P.shift v a → u = v) + → (∀ (u : ↥P.lattice), ∀ (a : ι), period (P.shift u a) = u + period a))) + ) := by + classical + intro ι P rep rep_spec period coord rep_shift shift_free u a + apply shift_free (period (P.shift u a)) (u + period a) (rep a) + calc + P.shift (period (P.shift u a)) (rep a) = P.shift u a := by + calc + P.shift (period (P.shift u a)) (rep a) = + P.shift (period (P.shift u a)) (rep (P.shift u a)) := + congrArg (P.shift (period (P.shift u a))) (rep_shift u a).symm + _ = P.shift u a := (coord (P.shift u a)).symm + _ = P.shift (u + period a) (rep a) := by + calc + P.shift u a = P.shift u (P.shift (period a) (rep a)) := + congrArg (P.shift u) (coord a) + _ = P.shift (u + period a) (rep a) := (P.shift_add u (period a) (rep a)).symm + +end TileContractionProof + +theorem P3776T1TileContractionsExist {ι : Type} (P : PeriodicTileCore ι) : + Nonempty (P3776T1TileContractions P) := by +-- BODY + classical + let rep : ι → ι := fun a => Classical.choose (P.vertex_orbit_representatives a) + have rep_spec (a : ι) : + rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep a) := + (Classical.choose_spec (P.vertex_orbit_representatives a)).1 + let period : ι → P.lattice := fun a => Classical.choose (rep_spec a).2 + have coord (a : ι) : a = P.shift (period a) (rep a) := + Classical.choose_spec (rep_spec a).2 + let ball : Set (Real × Real) := Metric.closedBall (0 : Real × Real) 1 + let diskMap (r : ι) : ball ≃ₜ TileRealization (P.tile r) := + Classical.choice (show Nonempty (ball ≃ₜ TileRealization (P.tile r)) from + by simpa [ball, LatticeTile, TopologicalDisk] using P.tiles_are_disks r) + let center (a : ι) : Real × Real := + (diskMap (rep a) ⟨0, by simp [ball, Metric.mem_closedBall]⟩).val + + GaussianRealPoint (period a : GaussianInt) + have scale_mem (t : Real) (ht : t ∈ Set.Icc (0 : Real) 1) + (x : ball) : t • x.val ∈ ball := TileContractionProof.scale_mem t ht x + have realization_translate (a : ι) : + TileRealization (P.tile a) = + (fun z : Real × Real => z + GaussianRealPoint (period a : GaussianInt)) '' + TileRealization (P.tile (rep a)) := TileContractionProof.realization_translate ι P + rep_spec coord a + let localHomotopy (r : ι) (t : Real) (z : Real × Real) : Real × Real := + if hz : z ∈ TileRealization (P.tile r) then + if ht : t ∈ Set.Icc (0 : Real) 1 then + let x := (diskMap r).symm ⟨z, hz⟩ + ((diskMap r) ⟨t • x.val, scale_mem t ht x⟩).val + else (diskMap r) ⟨0, by simp [ball, Metric.mem_closedBall]⟩ |>.val + else (diskMap r) ⟨0, by simp [ball, Metric.mem_closedBall]⟩ |>.val + let homotopy (a : ι) (t : Real) (z : Real × Real) : Real × Real := + if hz : z ∈ TileRealization (P.tile a) then + localHomotopy (rep a) t (z - GaussianRealPoint (period a : GaussianInt)) + + GaussianRealPoint (period a : GaussianInt) + else center a + have local_zero (r : ι) (z : Real × Real) (hz : z ∈ TileRealization (P.tile r)) : + localHomotopy r 0 z = + ((diskMap r) ⟨0, by simp [ball, Metric.mem_closedBall]⟩).val := by + simp [localHomotopy, hz, ball, Set.mem_Icc] + have local_one (r : ι) (z : Real × Real) (hz : z ∈ TileRealization (P.tile r)) : + localHomotopy r 1 z = z := by + simp [localHomotopy, hz, ball, (diskMap r).apply_symm_apply ⟨z, hz⟩] + have local_support (r : ι) (t : Real) (ht : t ∈ Set.Icc (0 : Real) 1) + (z : Real × Real) (hz : z ∈ TileRealization (P.tile r)) : + localHomotopy r t z ∈ TileRealization (P.tile r) := by + unfold localHomotopy + rw [dite_eq_left hz, dite_eq_left ht] + exact ((diskMap r) ⟨t • ((diskMap r).symm ⟨z, hz⟩).val, + scale_mem t ht ((diskMap r).symm ⟨z, hz⟩)⟩).property + let localDomain (r : ι) : Set (Real × (Real × Real)) := + Set.Icc (0 : Real) 1 ×ˢ TileRealization (P.tile r) + have local_continuous (r : ι) : + ContinuousOn (fun p : Real × (Real × Real) => localHomotopy r p.1 p.2) + (localDomain r) := TileContractionProof.local_continuous ι P scale_mem r + have translated_preimage (a : ι) (z : Real × Real) + (hz : z ∈ TileRealization (P.tile a)) : + z - GaussianRealPoint (period a : GaussianInt) ∈ + TileRealization (P.tile (rep a)) := by + rw [realization_translate a] at hz + rcases (Set.mem_image _ _ _).mp hz with ⟨y, hy, hzy⟩ + rw [← hzy] + simpa using hy + let targetDomain (a : ι) : Set (Real × (Real × Real)) := + Set.Icc (0 : Real) 1 ×ˢ TileRealization (P.tile a) + have homotopy_continuous (a : ι) : + ContinuousOn (fun p : Real × (Real × Real) => homotopy a p.1 p.2) + (targetDomain a) := TileContractionProof.homotopy_continuous ι P rep_spec scale_mem + local_continuous translated_preimage a + have rep_unique (a s : ι) + (hs : s ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u s) : + s = rep a := by + exact (Classical.choose_spec (P.vertex_orbit_representatives a)).2 s hs + have rep_shift (u : P.lattice) (a : ι) : rep (P.shift u a) = rep a := by + apply (rep_unique (P.shift u a) (rep a) ?_).symm + refine ⟨rep_spec a |>.1, ?_⟩ + refine ⟨u + period a, ?_⟩ + calc + P.shift u a = P.shift u (P.shift (period a) (rep a)) := + congrArg (P.shift u) (coord a) + _ = P.shift (u + period a) (rep a) := (P.shift_add u (period a) (rep a)).symm + have shift_free : ∀ u v : P.lattice, ∀ a, P.shift u a = P.shift v a → u = v := + TileContractionProof.shift_free ι P + have period_shift (u : P.lattice) (a : ι) : + period (P.shift u a) = u + period a := TileContractionProof.period_shift ι P rep_spec coord + rep_shift shift_free u a + have point_add (u v : P.lattice) : + GaussianRealPoint ((u + v : P.lattice) : GaussianInt) = + GaussianRealPoint (u : GaussianInt) + GaussianRealPoint (v : GaussianInt) := by + apply Prod.ext <;> simp [GaussianRealPoint] + refine ⟨⟨center, homotopy, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩⟩ + · intro a + rw [realization_translate a] + exact (Set.mem_image _ _ _).2 ⟨ + (diskMap (rep a) ⟨0, by simp [ball, Metric.mem_closedBall]⟩).val, + (diskMap (rep a) ⟨0, by simp [ball, Metric.mem_closedBall]⟩).property, rfl⟩ + · intro a + simpa [targetDomain] using homotopy_continuous a + · intro a z hz + have hy := translated_preimage a z hz + unfold homotopy + rw [dite_eq_left hz, local_zero (rep a) (z - GaussianRealPoint (period a : GaussianInt)) hy] + · intro a z hz + have hy := translated_preimage a z hz + unfold homotopy + rw [dite_eq_left hz, local_one (rep a) (z - GaussianRealPoint (period a : GaussianInt)) hy] + simp + · intro a t ht z hz + have hy := translated_preimage a z hz + unfold homotopy + rw [dite_eq_left hz, realization_translate a] + exact (Set.mem_image _ _ _).2 ⟨localHomotopy (rep a) t + (z - GaussianRealPoint (period a : GaussianInt)), + local_support (rep a) t ht _ hy, rfl⟩ + · intro u a + unfold center + rw [rep_shift u a, period_shift u a, point_add] + apply Prod.ext <;> abel + · intro u a t z ht hz + have hy := translated_preimage a z hz + have hrep := rep_shift u a + have hperiod := period_shift u a + have hpoint : GaussianRealPoint (period (P.shift u a) : GaussianInt) = + GaussianRealPoint (u : GaussianInt) + + GaussianRealPoint (period a : GaussianInt) := by + rw [hperiod, point_add] + have htarget : z + GaussianRealPoint (u : GaussianInt) ∈ + TileRealization (P.tile (P.shift u a)) := by + rw [realization_translate (P.shift u a)] + apply (Set.mem_image _ _ _).2 + refine ⟨z - GaussianRealPoint (period a : GaussianInt), ?_, ?_⟩ + · simpa [hrep] using hy + · rw [hpoint] + abel + unfold homotopy + rw [dite_eq_left htarget, dite_eq_left hz] + rw [hrep, hperiod, point_add] + have harg : z + GaussianRealPoint (u : GaussianInt) - + (GaussianRealPoint (u : GaussianInt) + + GaussianRealPoint (period a : GaussianInt)) = + z - GaussianRealPoint (period a : GaussianInt) := by + abel + rw [harg] + abel + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1WalkMap.lean b/LeanPool/ApollonianSuperharmonic/P3776T1WalkMap.lean new file mode 100644 index 0000000000..65e027e092 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1WalkMap.lean @@ -0,0 +1,49 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import Mathlib.Algebra.Order.Floor.Ring + +/-! +# P3776T1WalkMap + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +noncomputable section + +-- [TABLET NODE: P3776T1WalkMap] +/-- +For a list $p=(z_0,\ldots,z_n)$ with at least two terms, its map on +$[0,1]$ linearly traverses each consecutive segment in time $1/n$. +Precisely, set $s=nt$, $k=\min(\lfloor s\rfloor,n-1)$ and $r=s-k$, +and take $(1-r)[z_k]+r[z_{k+1}]$. For a singleton the map is constant +at its real point; for the empty list it is constant at the origin. +Thus the endpoint $t=1$ is on the final segment with $r=1$. +-/ +def P3776T1WalkMap (p : List GaussianInt) (t : Set.Icc (0 : Real) 1) : + Real × Real := +-- BODY + let n := p.length - 1 + if n = 0 then GaussianRealPoint (p.getD 0 0) + else + let s := (n : Real) * (t : Real) + let k := min (Nat.floor s) (n - 1) + let r := s - (k : Real) + (1 - r) • GaussianRealPoint (p.getD k 0) + + r • GaussianRealPoint (p.getD (k + 1) 0) + +end + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean b/LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean new file mode 100644 index 0000000000..91452bf197 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean @@ -0,0 +1,774 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3776T1WalkMap +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import Mathlib.Tactic.Linarith +public import Mathlib.Topology.Algebra.Module.Basic +public import Mathlib.Analysis.Normed.Module.Basic +public import Mathlib.Tactic.Module +public import Mathlib.Data.List.GetD + +-- [TABLET NODE: P3776T1WalkMapProperties] + +/-! +# P3776T1WalkMapProperties + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace WalkMapLemmas + +private theorem hsingle : + ∀ (a : GaussianInt), Continuous (P3776T1WalkMap [a]) := by + classical + intro a + have heq : P3776T1WalkMap [a] = + (fun _ : Set.Icc (0 : Real) 1 => GaussianRealPoint a) := by + funext t + simp [P3776T1WalkMap] + rw [heq] + exact continuous_const + +private theorem hseg : + ∀ (q : List GaussianInt), ∀ (k : Nat), (k < q.length - 1) → ∀ (t : Set.Icc (0 : Real) 1), ((k + : Real) / (q.length - 1) ≤ (t : Real)) → ((t : Real) ≤ ((k + 1 : Nat) : Real) / (q.length + - 1)) → P3776T1WalkMap q t = + (1 - ((q.length - 1 : Nat) * (t : Real) - k)) • + GaussianRealPoint (q.getD k 0) + + ((q.length - 1 : Nat) * (t : Real) - k) • + GaussianRealPoint (q.getD (k + 1) 0) := by + classical + intro q k hk t ht1 ht2 + have hn : 0 < q.length - 1 := by omega + have hncast : ((q.length - 1 : Nat) : Real) = (q.length : Real) - 1 := by + rw [Nat.cast_sub (by omega : 1 ≤ q.length)] + simp + have hden : (0 : Real) < (q.length : Real) - 1 := by + rw [← hncast] + exact_mod_cast hn + have s1 : (k : Real) ≤ (q.length - 1 : Nat) * (t : Real) := by + have ht := ht1 + rw [div_le_iff₀ hden] at ht + rw [hncast] + nlinarith [mul_comm (↑(q.length - 1 : Nat) : Real) (t : Real)] + have s2 : (q.length - 1 : Nat) * (t : Real) ≤ (k + 1 : Nat) := by + have ht := ht2 + rw [le_div_iff₀ hden] at ht + rw [hncast] + nlinarith [mul_comm (↑(q.length - 1 : Nat) : Real) (t : Real)] + have hjlo : k ≤ ⌊(q.length - 1 : Nat) * (t : Real)⌋₊ := Nat.le_floor s1 + have hjhi : ⌊(q.length - 1 : Nat) * (t : Real)⌋₊ ≤ k + 1 := + Nat.floor_le_of_le s2 + unfold P3776T1WalkMap + simp only [ite_eq_right (by omega : q.length - 1 ≠ 0)] + by_cases hj : ⌊(↑(q.length - 1 : Nat) * (t : Real))⌋₊ = k + · rw [hj] + simp only [min_eq_left (by omega : k ≤ q.length - 1 - 1)] + · have hj' : ⌊(↑(q.length - 1 : Nat) * (t : Real))⌋₊ = k + 1 := by omega + rw [hj'] + have hsEq : (↑(q.length - 1 : Nat) * (t : Real)) = (k + 1 : Nat) := by + have hfloor : (⌊(↑(q.length - 1 : Nat) * (t : Real))⌋₊ : Real) ≤ + ↑(q.length - 1 : Nat) * (t : Real) := + Nat.floor_le (by nlinarith [t.2.1]) + apply le_antisymm + · exact s2 + · simpa [hj'] using hfloor + by_cases hlast : k + 1 = q.length - 1 + · have hminlast : min (k + 1) (q.length - 1 - 1) = k := by omega + rw [hminlast, hsEq] + · have hmin : min (k + 1) (q.length - 1 - 1) = k + 1 := by + apply min_eq_left + omega + rw [hmin, hsEq]; norm_num [Nat.cast_add] + +private theorem hlastD : + ∀ (p : List GaussianInt), (p ≠ []) → p.getLast?.getD 0 = p.getD (p.length - 1) 0 := by + classical + intro p hp + induction p using List.reverseRecOn with + | nil => simp + | append_singleton q a ih => simp [List.getLast?_append] + +private theorem hinterval : + ∀ (p : List GaussianInt), (0 < p.length - 1) → ∀ (t : Set.Icc (0 : Real) 1), ∃ k, k < + p.length - 1 ∧ + (k : Real) / (p.length - 1) ≤ (t : Real) ∧ + (t : Real) ≤ ((k + 1 : Nat) : Real) / (p.length - 1) := by + classical + intro p hn t + let n := p.length - 1 + let s : Real := (n : Real) * (t : Real) + let j := Nat.floor s + have hnR : (0 : Real) < n := by exact_mod_cast hn + have hncast : (n : Real) = (p.length : Real) - 1 := by + dsimp [n] + rw [Nat.cast_sub (by omega : 1 ≤ p.length)] + simp + have hden : (0 : Real) < (p.length : Real) - 1 := by rw [← hncast]; exact hnR + have hslo : (j : Real) ≤ s := Nat.floor_le (by + dsimp [s] + nlinarith [t.2.1]) + have hshi : s < (j : Real) + 1 := by + dsimp [j, s] + exact Nat.lt_floor_add_one _ + have hsn : s ≤ n := by + dsimp [s] + nlinarith [t.2.2] + have hjle : j ≤ n := by exact_mod_cast (hslo.trans hsn) + by_cases hjn : j = n + · let k := n - 1 + have hk : k < n := by dsimp [k]; omega + have hklo : (k : Real) ≤ s := by + dsimp [k] + rw [hjn] at hslo + have hkn : ((n - 1 : Nat) : Real) ≤ n := by exact_mod_cast (Nat.sub_le n 1) + exact hkn.trans hslo + have hleft : (k : Real) / ((p.length : Real) - 1) ≤ (t : Real) := by + rw [div_le_iff₀ hden] + dsimp [s] at hklo + rw [← hncast] + nlinarith [hklo, mul_comm (↑n) (t : Real)] + have hright : (t : Real) ≤ ((k + 1 : Nat) : Real) / ((p.length : Real) - 1) := by + rw [le_div_iff₀ hden] + rw [← hncast] + dsimp [k] + rw [show n - 1 + 1 = n by omega] + rw [mul_comm] + dsimp [s] at hsn + exact hsn + refine ⟨k, hk, hleft, hright⟩ + · have hjlt : j < n := by omega + have hleft : (j : Real) / ((p.length : Real) - 1) ≤ (t : Real) := by + rw [div_le_iff₀ hden] + dsimp [s] at hslo + rw [← hncast] + nlinarith [hslo, mul_comm (↑n) (t : Real)] + have hright : (t : Real) ≤ ((j + 1 : Nat) : Real) / ((p.length : Real) - 1) := by + rw [le_div_iff₀ hden] + dsimp [s] at hshi + rw [hncast] at hshi + have hh := hshi + rw [mul_comm] at hh + norm_num [Nat.cast_add] at hh ⊢ + exact hh.le + exact ⟨j, hjlt, hleft, hright⟩ + +private theorem hcombo : + ∀ (lo : Real × Real), ∀ (hi : Real × Real), ∀ (a : Real × Real), ∀ (b : Real × Real), (a ∈ + Set.Icc lo hi) → (b ∈ Set.Icc lo hi) → ∀ (r : Real), (0 ≤ r) → (r ≤ 1) → (1 - r) • a + r + • b ∈ Set.Icc lo hi := by + classical + intro lo hi a b ha hb r hr0 hr1 + simp only [Set.mem_Icc, Prod.le_def] at ha hb ⊢ + simp only [Prod.fst_add, Prod.smul_fst, Prod.snd_add, Prod.smul_snd, smul_eq_mul] at ⊢ + rcases ha with ⟨⟨hal, hal'⟩, ⟨hai, hai'⟩⟩ + rcases hb with ⟨⟨hbl, hbl'⟩, ⟨hbi, hbi'⟩⟩ + constructor <;> constructor + · have h1 := mul_nonneg (sub_nonneg.mpr hr1) (sub_nonneg.mpr hal) + have h2 := mul_nonneg hr0 (sub_nonneg.mpr hbl) + nlinarith [h1, h2] + · have h1 := mul_nonneg (sub_nonneg.mpr hr1) (sub_nonneg.mpr hal') + have h2 := mul_nonneg hr0 (sub_nonneg.mpr hbl') + nlinarith [h1, h2] + · have h1 := mul_nonneg (sub_nonneg.mpr hr1) (sub_nonneg.mpr hai) + have h2 := mul_nonneg hr0 (sub_nonneg.mpr hbi) + nlinarith [h1, h2] + · have h1 := mul_nonneg (sub_nonneg.mpr hr1) (sub_nonneg.mpr hai') + have h2 := mul_nonneg hr0 (sub_nonneg.mpr hbi') + nlinarith [h1, h2] + +private theorem walk_continuous : + ∀ (p : List GaussianInt), (p ≠ []) → (∀ (a : GaussianInt), Continuous (P3776T1WalkMap [a])) + → (∀ (q : List GaussianInt), ∀ (k : Nat), (k < q.length - 1) → ∀ (t : Set.Icc (0 : Real) + 1), ((k : Real) / (q.length - 1) ≤ (t : Real)) → ((t : Real) ≤ ((k + 1 : Nat) : Real) / + (q.length - 1)) → P3776T1WalkMap q t = (1 - ((q.length - 1 : Nat) * (t : Real) - k)) • + GaussianRealPoint (q.getD k 0) + ((q.length - 1 : Nat) * (t : Real) - k) • + GaussianRealPoint (q.getD (k + 1) 0)) → (p.getLast?.getD 0 = p.getD (p.length - 1) 0) → + ((0 < p.length - 1) → ∀ (t : Set.Icc (0 : Real) 1), ∃ k, k < p.length - 1 ∧ (k : Real) / + (p.length - 1) ≤ (t : Real) ∧ (t : Real) ≤ ((k + 1 : Nat) : Real) / (p.length - 1)) → + Continuous (P3776T1WalkMap p) := by + classical + intro p hp hsingle hseg hlastD hinterval + by_cases hp1 : p.length = 1 + · obtain ⟨a, rfl⟩ : ∃ a : GaussianInt, p = [a] := by + cases p with + | nil => simp at hp + | cons a q => + cases q with + | nil => exact ⟨a, rfl⟩ + | cons b q => simp at hp1 + exact hsingle a + · have hpLen : 0 < p.length := by + cases p with + | nil => contradiction + | cons a q => simp + have hn : 0 < p.length - 1 := by omega + let I : Fin (p.length - 1) → Set (Set.Icc (0 : Real) 1) := fun i => + {t | (i.val : Real) / (p.length - 1) ≤ (t : Real) ∧ + (t : Real) ≤ ((i.val + 1 : Nat) : Real) / (p.length - 1)} + have hclosed (i : Fin (p.length - 1)) : IsClosed (I i) := by + change IsClosed ((fun t : Set.Icc (0 : Real) 1 => (t : Real)) ⁻¹' + Set.Icc ((i.val : Real) / (p.length - 1)) + (((i.val + 1 : Nat) : Real) / (p.length - 1))) + exact isClosed_Icc.preimage continuous_subtype_val + have hcont (i : Fin (p.length - 1)) : + ContinuousOn (P3776T1WalkMap p) (I i) := by + let A := GaussianRealPoint (p.getD i.val 0) + let B := GaussianRealPoint (p.getD (i.val + 1) 0) + have ha : Continuous (fun t : Set.Icc (0 : Real) 1 => + (1 - ((p.length - 1 : Nat) * (t : Real) - i.val)) • A + + ((p.length - 1 : Nat) * (t : Real) - i.val) • B) := by + have hc : Continuous (fun t : Set.Icc (0 : Real) 1 => + (p.length - 1 : Nat) * (t : Real) - i.val) := + (continuous_const.mul continuous_subtype_val).sub continuous_const + exact ((continuous_const.sub hc).smul continuous_const).add + (hc.smul continuous_const) + apply ha.continuousOn.congr + intro t ht + simpa [A, B] using hseg p i.val i.isLt t ht.1 ht.2 + have hcover : (⋃ i : Fin (p.length - 1), I i) = Set.univ := by + ext t + constructor + · intro _ + simp + · intro _ + let n := p.length - 1 + let s : Real := (n : Real) * (t : Real) + let j := Nat.floor s + have hnR : (0 : Real) < n := by exact_mod_cast hn + have hncast : (n : Real) = (p.length : Real) - 1 := by + dsimp [n] + rw [Nat.cast_sub (by omega : 1 ≤ p.length)] + simp + have hden : (0 : Real) < (p.length : Real) - 1 := by + rw [← hncast] + exact hnR + have hslo : (j : Real) ≤ s := Nat.floor_le (by + dsimp [s] + nlinarith [t.2.1]) + have hshi : s < (j : Real) + 1 := by + dsimp [j, s] + exact Nat.lt_floor_add_one _ + have hsn : s ≤ n := by + dsimp [s] + nlinarith [t.2.2] + have hjle : j ≤ n := by exact_mod_cast (hslo.trans hsn) + by_cases hjn : j = n + · let k := n - 1 + have hk : k < n := by dsimp [k]; omega + have hklo : (k : Real) ≤ s := by + dsimp [k] + rw [hjn] at hslo + have hkn : ((n - 1 : Nat) : Real) ≤ n := by exact_mod_cast (Nat.sub_le n 1) + exact hkn.trans hslo + have hleft : (k : Real) / ((p.length : Real) - 1) ≤ (t : Real) := by + rw [div_le_iff₀ hden] + dsimp [s] at hsn + nlinarith [hklo] + have hright : (t : Real) ≤ ((k + 1 : Nat) : Real) / ((p.length : Real) - 1) := by + rw [le_div_iff₀ hden] + rw [← hncast] + dsimp [k] + rw [show n - 1 + 1 = n by omega] + rw [mul_comm] + dsimp [s] at hsn + exact hsn + refine Set.mem_iUnion.mpr ⟨⟨k, hk⟩, ?_⟩ + exact ⟨hleft, hright⟩ + · have hjlt : j < n := by omega + have hk : j < n := hjlt + have hleft : (j : Real) / ((p.length : Real) - 1) ≤ (t : Real) := by + rw [div_le_iff₀ hden] + dsimp [s] at hslo + nlinarith [hslo, mul_comm (↑n) (t : Real)] + have hright : (t : Real) ≤ ((j + 1 : Nat) : Real) / ((p.length : Real) - 1) := by + rw [le_div_iff₀ hden] + dsimp [s] at hshi + rw [hncast] at hshi + have hh := hshi + rw [mul_comm] at hh + norm_num [Nat.cast_add] at hh ⊢ + exact hh.le + refine Set.mem_iUnion.mpr ⟨⟨j, hk⟩, ?_⟩ + exact ⟨hleft, hright⟩ + have hlf := locallyFinite_of_finite (I) + have hall : ContinuousOn (P3776T1WalkMap p) (⋃ i, I i) := + hlf.continuousOn_iUnion hclosed hcont + rw [hcover, continuousOn_univ] at hall + exact hall + +private theorem walk_start : + ∀ (p : List GaussianInt), (p ≠ []) → (∀ (q : List GaussianInt), ∀ (k : Nat), (k < q.length - + 1) → ∀ (t : Set.Icc (0 : Real) 1), ((k : Real) / (q.length - 1) ≤ (t : Real)) → ((t : + Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1)) → P3776T1WalkMap q t = (1 - ((q.length + - 1 : Nat) * (t : Real) - k)) • GaussianRealPoint (q.getD k 0) + ((q.length - 1 : Nat) * + (t : Real) - k) • GaussianRealPoint (q.getD (k + 1) 0)) → (p.getLast?.getD 0 = p.getD + (p.length - 1) 0) → ((0 < p.length - 1) → ∀ (t : Set.Icc (0 : Real) 1), ∃ k, k < p.length + - 1 ∧ (k : Real) / (p.length - 1) ≤ (t : Real) ∧ (t : Real) ≤ ((k + 1 : Nat) : Real) / + (p.length - 1)) → (Continuous (P3776T1WalkMap p)) → P3776T1WalkMap p ⟨0, by norm_num⟩ + = GaussianRealPoint (p.getD 0 0) := by + classical + intro p hp hseg hlastD hinterval walk_continuous + by_cases hp1 : p.length = 1 + · obtain ⟨a, rfl⟩ : ∃ a : GaussianInt, p = [a] := by + cases p with + | nil => simp at hp + | cons a q => cases q with + | nil => exact ⟨a, rfl⟩ + | cons b q => simp at hp1 + simp [P3776T1WalkMap] + · have hpLen : 0 < p.length := by cases p with | nil => contradiction | cons a q => simp + have hn : 0 < p.length - 1 := by omega + let t0 : Set.Icc (0 : Real) 1 := ⟨0, by norm_num, by norm_num⟩ + have hden : (0 : Real) < (p.length : Real) - 1 := by + rw [← (show ((p.length - 1 : Nat) : Real) = (p.length : Real) - 1 by + rw [Nat.cast_sub (by omega : 1 ≤ p.length)]; simp)] + exact_mod_cast hn + have ht1 : (0 : Real) / ((p.length : Real) - 1) ≤ (t0 : Real) := by + simp [t0] + have ht2 : (t0 : Real) ≤ ((0 + 1 : Nat) : Real) / ((p.length : Real) - 1) := by + simpa [t0] using (div_nonneg (by norm_num : (0 : Real) ≤ 1) hden.le) + have hval := hseg p 0 (by omega) t0 (by simpa using ht1) ht2 + simpa [t0] using hval + +private theorem walk_end : + ∀ (p : List GaussianInt), (p ≠ []) → (∀ (q : List GaussianInt), ∀ (k : Nat), (k < q.length - + 1) → ∀ (t : Set.Icc (0 : Real) 1), ((k : Real) / (q.length - 1) ≤ (t : Real)) → ((t : + Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1)) → P3776T1WalkMap q t = (1 - ((q.length + - 1 : Nat) * (t : Real) - k)) • GaussianRealPoint (q.getD k 0) + ((q.length - 1 : Nat) * + (t : Real) - k) • GaussianRealPoint (q.getD (k + 1) 0)) → (p.getLast?.getD 0 = p.getD + (p.length - 1) 0) → ((0 < p.length - 1) → ∀ (t : Set.Icc (0 : Real) 1), ∃ k, k < p.length + - 1 ∧ (k : Real) / (p.length - 1) ≤ (t : Real) ∧ (t : Real) ≤ ((k + 1 : Nat) : Real) / + (p.length - 1)) → (Continuous (P3776T1WalkMap p)) → (P3776T1WalkMap p ⟨0, by + norm_num⟩ = GaussianRealPoint (p.getD 0 0)) → P3776T1WalkMap p ⟨1, by norm_num⟩ = + GaussianRealPoint (p.getLast?.getD 0) := by + classical + intro p hp hseg hlastD hinterval walk_continuous walk_start + by_cases hp1 : p.length = 1 + · obtain ⟨a, rfl⟩ : ∃ a : GaussianInt, p = [a] := by + cases p with + | nil => simp at hp + | cons a q => cases q with + | nil => exact ⟨a, rfl⟩ + | cons b q => simp at hp1 + simp [P3776T1WalkMap] + · have hpLen : 0 < p.length := by cases p with | nil => contradiction | cons a q => simp + have hn : 0 < p.length - 1 := by omega + let n := p.length - 1 + let t1 : Set.Icc (0 : Real) 1 := ⟨1, by norm_num, by norm_num⟩ + have hnR : (0 : Real) < n := by exact_mod_cast hn + have hncast : (n : Real) = (p.length : Real) - 1 := by + dsimp [n] + rw [Nat.cast_sub (by omega : 1 ≤ p.length)] + simp + have hden : (0 : Real) < (p.length : Real) - 1 := by rw [← hncast]; exact hnR + have hlen : n + 1 = p.length := by dsimp [n]; omega + have hleft : ((n - 1 : Nat) : Real) / ((p.length : Real) - 1) ≤ (t1 : Real) := by + rw [div_le_iff₀ hden] + simp? [t1] + rw [← hncast] + exact_mod_cast (Nat.sub_le n 1) + have hright' : (t1 : Real) ≤ ((n - 1 + 1 : Nat) : Real) / ((p.length : Real) - 1) := by + rw [le_div_iff₀ hden] + simp? [t1, Nat.sub_add_cancel (by omega : 1 ≤ n)] + exact_mod_cast hlen.symm.le + have hval := hseg p (n - 1) (by dsimp [n]; omega) t1 hleft hright' + rw [← hlen] at hval + simpa [t1, hlastD, Nat.cast_sub (by omega : 1 ≤ n), + Nat.sub_add_cancel (by omega : 1 ≤ n)] using hval + +private theorem walk_reverse : + ∀ (p : List GaussianInt), (p ≠ []) → (∀ (q : List GaussianInt), ∀ (k : Nat), (k < q.length - + 1) → ∀ (t : Set.Icc (0 : Real) 1), ((k : Real) / (q.length - 1) ≤ (t : Real)) → ((t : + Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1)) → P3776T1WalkMap q t = (1 - ((q.length + - 1 : Nat) * (t : Real) - k)) • GaussianRealPoint (q.getD k 0) + ((q.length - 1 : Nat) * + (t : Real) - k) • GaussianRealPoint (q.getD (k + 1) 0)) → (p.getLast?.getD 0 = p.getD + (p.length - 1) 0) → ((0 < p.length - 1) → ∀ (t : Set.Icc (0 : Real) 1), ∃ k, k < p.length + - 1 ∧ (k : Real) / (p.length - 1) ≤ (t : Real) ∧ (t : Real) ≤ ((k + 1 : Nat) : Real) / + (p.length - 1)) → (Continuous (P3776T1WalkMap p)) → (P3776T1WalkMap p ⟨0, by + norm_num⟩ = GaussianRealPoint (p.getD 0 0)) → (P3776T1WalkMap p ⟨1, by norm_num⟩ = + GaussianRealPoint (p.getLast?.getD 0)) → (∀ t : Set.Icc (0 : Real) 1, + P3776T1WalkMap p.reverse t = + P3776T1WalkMap p ⟨1 - (t : Real), by constructor <;> linarith [t.2.1, t.2.2]⟩) := by + classical + intro p hp hseg hlastD hinterval walk_continuous walk_start walk_end t + by_cases hp1 : p.length = 1 + · obtain ⟨a, rfl⟩ : ∃ a : GaussianInt, p = [a] := by + cases p with + | nil => simp at hp + | cons a q => cases q with + | nil => exact ⟨a, rfl⟩ + | cons b q => simp at hp1 + let t' : Set.Icc (0 : Real) 1 := ⟨1 - (t : Real), by constructor <;> linarith [t.2.1, t.2.2]⟩ + simp [P3776T1WalkMap] + · have hpLen : 0 < p.length := by cases p with | nil => contradiction | cons a q => simp + have hn : 0 < p.length - 1 := by omega + let n := p.length - 1 + obtain ⟨k, hk, ht1, ht2⟩ := hinterval hn t + let j := n - 1 - k + have hj : j + k + 1 = n := by dsimp [j]; omega + have hjlt : j < n := by dsimp [j]; omega + have hnR : (0 : Real) < n := by exact_mod_cast hn + have hncast : (n : Real) = (p.length : Real) - 1 := by + dsimp [n] + rw [Nat.cast_sub (by omega : 1 ≤ p.length)] + simp + have hden : (0 : Real) < (p.length : Real) - 1 := by + rw [← hncast] + exact_mod_cast hn + let t' : Set.Icc (0 : Real) 1 := ⟨1 - (t : Real), by + constructor <;> linarith [t.2.1, t.2.2]⟩ + have hrevlo : (k : Real) / (p.reverse.length - 1) ≤ (t : Real) := by + simpa [List.length_reverse] using ht1 + have hrevhi : (t : Real) ≤ ((k + 1 : Nat) : Real) / (p.reverse.length - 1) := by + simpa [List.length_reverse] using ht2 + have hbaselo : (j : Real) / (p.length - 1) ≤ (t' : Real) := by + rw [div_le_iff₀ hden] + have htop := ht2 + rw [le_div_iff₀ hden, ← hncast] at htop + rw [← hncast] + have hjR : (j : Real) + k + 1 = n := by exact_mod_cast hj + dsimp [t'] + have htop' : (t : Real) * n ≤ (k : Real) + 1 := by + norm_num [Nat.cast_add] at htop ⊢ + exact htop + have hsub : n - ((k : Real) + 1) = (j : Real) := by linarith + have hmul : (1 - (t : Real)) * n = n - (t : Real) * n := by ring + rw [hmul, ← hsub] + linarith [htop'] + have hbasehi : (t' : Real) ≤ ((j + 1 : Nat) : Real) / (p.length - 1) := by + rw [le_div_iff₀ hden] + have hbot := ht1 + rw [div_le_iff₀ hden, ← hncast] at hbot + rw [← hncast] + have hjR : (j : Real) + k + 1 = n := by exact_mod_cast hj + dsimp [t'] + norm_num [Nat.cast_add] + nlinarith [hbot, mul_comm (↑n) (t : Real)] + have hrev := by + simpa [List.length_reverse] using + hseg p.reverse k (by simpa [List.length_reverse] using hk) t hrevlo hrevhi + have hbase := hseg p j hjlt t' hbaselo hbasehi + have hidx0 : p.reverse.getD k 0 = p.getD (j + 1) 0 := by + rw [List.getD_reverse k (by simpa [List.length_reverse] using (show k < p.length by omega))] + congr 1 + dsimp [j, n] + omega + have hidx1 : p.reverse.getD (k + 1) 0 = p.getD j 0 := by + rw [List.getD_reverse (k + 1) (by simpa [List.length_reverse] using (show k + 1 < + p.length by omega))] + congr 1 + dsimp [j, n] + omega + have hcoeff : (p.length - 1 : Nat) * (t : Real) - k = + 1 - ((p.length - 1 : Nat) * (t' : Real) - j) := by + have hjR : (j : Real) + k + 1 = n := by exact_mod_cast hj + have hcastN : ((p.length - 1 : Nat) : Real) = (n : Real) := rfl + rw [hcastN] + dsimp [t'] + nlinarith [hjR, mul_comm (↑n) (t : Real)] + rw [hrev, hbase] + change (1 - ((p.length - 1 : Nat) * (t : Real) - k)) • + GaussianRealPoint (p.reverse.getD k 0) + + ((p.length - 1 : Nat) * (t : Real) - k) • + GaussianRealPoint (p.reverse.getD (k + 1) 0) = + (1 - ((p.length - 1 : Nat) * (t' : Real) - j)) • GaussianRealPoint (p.getD j 0) + + ((p.length - 1 : Nat) * (t' : Real) - j) • GaussianRealPoint (p.getD (j + 1) 0) + rw [hidx0, hidx1, hcoeff] + module + +private theorem walk_translate : + ∀ (p : List GaussianInt), (p ≠ []) → (∀ (q : List GaussianInt), ∀ (k : Nat), (k < q.length - + 1) → ∀ (t : Set.Icc (0 : Real) 1), ((k : Real) / (q.length - 1) ≤ (t : Real)) → ((t : + Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1)) → P3776T1WalkMap q t = (1 - ((q.length + - 1 : Nat) * (t : Real) - k)) • GaussianRealPoint (q.getD k 0) + ((q.length - 1 : Nat) * + (t : Real) - k) • GaussianRealPoint (q.getD (k + 1) 0)) → (p.getLast?.getD 0 = p.getD + (p.length - 1) 0) → ((0 < p.length - 1) → ∀ (t : Set.Icc (0 : Real) 1), ∃ k, k < p.length + - 1 ∧ (k : Real) / (p.length - 1) ≤ (t : Real) ∧ (t : Real) ≤ ((k + 1 : Nat) : Real) / + (p.length - 1)) → (Continuous (P3776T1WalkMap p)) → (P3776T1WalkMap p ⟨0, by + norm_num⟩ = GaussianRealPoint (p.getD 0 0)) → (P3776T1WalkMap p ⟨1, by norm_num⟩ = + GaussianRealPoint (p.getLast?.getD 0)) → ((∀ t : Set.Icc (0 : Real) 1, P3776T1WalkMap + p.reverse t = P3776T1WalkMap p ⟨1 - (t : Real), by constructor <;> linarith [t.2.1, + t.2.2]⟩)) → (∀ u : GaussianInt, ∀ t : Set.Icc (0 : Real) 1, + P3776T1WalkMap (p.map (fun z => z + u)) t = + P3776T1WalkMap p t + GaussianRealPoint u) := by + classical + intro p hp hseg hlastD hinterval walk_continuous walk_start walk_end walk_reverse u t + have hpoint (z : GaussianInt) : + GaussianRealPoint (z + u) = GaussianRealPoint z + GaussianRealPoint u := by + ext <;> simp [GaussianRealPoint] + by_cases hp1 : p.length = 1 + · obtain ⟨a, rfl⟩ : ∃ a : GaussianInt, p = [a] := by + cases p with + | nil => simp at hp + | cons a q => cases q with + | nil => exact ⟨a, rfl⟩ + | cons b q => simp at hp1 + simp [P3776T1WalkMap, hpoint] + · have hpLen : 0 < p.length := by cases p with | nil => contradiction | cons a q => simp + have hn : 0 < p.length - 1 := by omega + obtain ⟨k, hk, ht1, ht2⟩ := hinterval hn t + have hval := hseg p k hk t ht1 ht2 + have hmval := hseg (p.map fun z => z + u) k + (by simpa [List.length_map] using hk) t + (by simpa [List.length_map] using ht1) + (by simpa [List.length_map] using ht2) + have hget (i : Nat) (hi : i < p.length) : + (p.map (fun z => z + u)).getD i 0 = (p.getD i 0) + u := by + rw [List.getD_eq_getElem (l := p.map (fun z => z + u)) (d := 0) + (by simpa [List.length_map] using hi)] + rw [List.getD_eq_getElem (l := p) (d := 0) hi] + simp + have hi0 : k < p.length := by omega + have hi1 : k + 1 < p.length := by omega + simp only [List.length_map] at hmval + rw [hmval, hval, hget k hi0, hget (k + 1) hi1, hpoint, hpoint] + module + +private theorem walk_contained : + ∀ (p : List GaussianInt), (p ≠ []) → (∀ (q : List GaussianInt), ∀ (k : Nat), (k < q.length - + 1) → ∀ (t : Set.Icc (0 : Real) 1), ((k : Real) / (q.length - 1) ≤ (t : Real)) → ((t : + Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1)) → P3776T1WalkMap q t = (1 - ((q.length + - 1 : Nat) * (t : Real) - k)) • GaussianRealPoint (q.getD k 0) + ((q.length - 1 : Nat) * + (t : Real) - k) • GaussianRealPoint (q.getD (k + 1) 0)) → (p.getLast?.getD 0 = p.getD + (p.length - 1) 0) → ((0 < p.length - 1) → ∀ (t : Set.Icc (0 : Real) 1), ∃ k, k < p.length + - 1 ∧ (k : Real) / (p.length - 1) ≤ (t : Real) ∧ (t : Real) ≤ ((k + 1 : Nat) : Real) / + (p.length - 1)) → (∀ (lo : Real × Real), ∀ (hi : Real × Real), ∀ (a : Real × Real), ∀ (b + : Real × Real), (a ∈ Set.Icc lo hi) → (b ∈ Set.Icc lo hi) → ∀ (r : Real), (0 ≤ r) → (r ≤ + 1) → (1 - r) • a + r • b ∈ Set.Icc lo hi) → (Continuous (P3776T1WalkMap p)) → + (P3776T1WalkMap p ⟨0, by norm_num⟩ = GaussianRealPoint (p.getD 0 0)) → + (P3776T1WalkMap p ⟨1, by norm_num⟩ = GaussianRealPoint (p.getLast?.getD 0)) → ((∀ t : + Set.Icc (0 : Real) 1, P3776T1WalkMap p.reverse t = P3776T1WalkMap p ⟨1 - (t : Real), + by constructor <;> linarith [t.2.1, t.2.2]⟩)) → ((∀ u : GaussianInt, ∀ t : Set.Icc (0 : + Real) 1, P3776T1WalkMap (p.map (fun z => z + u)) t = P3776T1WalkMap p t + + GaussianRealPoint u)) → (∀ T : ProtoTile, LatticeTile T → + (∀ z ∈ p, z ∈ FootprintVertices T) → + (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → {a, b} ∈ FootprintEdges T) → + ∀ t, P3776T1WalkMap p t ∈ TileRealization T) := by + classical + intro p hp hseg hlastD hinterval hcombo walk_continuous walk_start walk_end walk_reverse + walk_translate T hT hv hed t + have hdisc : Nonempty + ((Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) ≃ₜ + TileRealization T) := by + simpa [LatticeTile, TopologicalDisk] using hT + rcases hdisc with ⟨e⟩ + have hreal : (TileRealization T).Nonempty := by + let z : Real × Real := 0 + have hz : z ∈ (Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) := by + simp [z, Metric.mem_closedBall] + exact ⟨e ⟨z, hz⟩, (e ⟨z, hz⟩).property⟩ + have hcells : T.cells.Nonempty := by + by_contra hne + have hemptyCells : T.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hne + have hempty : TileRealization T = ∅ := by simp [TileRealization, hemptyCells] + rw [hempty] at hreal + simp at hreal + have hvertex (z : GaussianInt) (hz : z ∈ FootprintVertices T) : + ∃ x ∈ T.cells, z = x ∨ z = x + 1 ∨ + z = x + ⟨0, 1⟩ ∨ z = x + 1 + ⟨0, 1⟩ := by + simpa [FootprintVertices, hcells] using hz + have hcorner (x z : GaussianInt) + (hz : z = x ∨ z = x + 1 ∨ z = x + ⟨0, 1⟩ ∨ z = x + 1 + ⟨0, 1⟩) : + GaussianRealPoint z ∈ ClosedSquareRealization x := by + rcases hz with hz | hz | hz | hz + · subst z + simp [GaussianRealPoint, ClosedSquareRealization] + · subst z + simp [GaussianRealPoint, ClosedSquareRealization] + · subst z + simp [GaussianRealPoint, ClosedSquareRealization] + · subst z + simp [GaussianRealPoint, ClosedSquareRealization] + have hpair (a b c d x : GaussianInt) + (hc : c = x ∨ c = x + 1 ∨ c = x + ⟨0, 1⟩ ∨ c = x + 1 + ⟨0, 1⟩) + (hd : d = x ∨ d = x + 1 ∨ d = x + ⟨0, 1⟩ ∨ d = x + 1 + ⟨0, 1⟩) + (hab : ({a, b} : Finset GaussianInt) = {c, d}) : + GaussianRealPoint a ∈ ClosedSquareRealization x ∧ + GaussianRealPoint b ∈ ClosedSquareRealization x := by + have hamem : a ∈ ({c, d} : Finset GaussianInt) := by + rw [← hab] + simp + have hbmem : b ∈ ({c, d} : Finset GaussianInt) := by + rw [← hab] + simp + have hcs := hcorner x c hc + have hds := hcorner x d hd + simp only [Finset.mem_insert, Finset.mem_singleton] at hamem hbmem + rcases hamem with hac | had + · rcases hbmem with hbc | hbd + · exact ⟨by simpa [hac] using hcs, by simpa [hbc] using hcs⟩ + · exact ⟨by simpa [hac] using hcs, by simpa [hbd] using hds⟩ + · rcases hbmem with hbc | hbd + · exact ⟨by simpa [had] using hds, by simpa [hbc] using hcs⟩ + · exact ⟨by simpa [had] using hds, by simpa [hbd] using hds⟩ + have hedgeSupport (a b : GaussianInt) (he : {a, b} ∈ FootprintEdges T) : + ∃ x ∈ T.cells, GaussianRealPoint a ∈ ClosedSquareRealization x ∧ + GaussianRealPoint b ∈ ClosedSquareRealization x := by + change ∃ x ∈ T.cells, + ({a, b} : Finset GaussianInt) = {x, x + 1} ∨ + ({a, b} : Finset GaussianInt) = {x, x + ⟨0, 1⟩} ∨ + ({a, b} : Finset GaussianInt) = {x + 1, x + 1 + ⟨0, 1⟩} ∨ + ({a, b} : Finset GaussianInt) = {x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩} at he + rcases he with ⟨x, hx, he | he | he | he⟩ + · have h := hpair a b x (x + 1) x (by simp) (by simp) he + exact ⟨x, hx, h.1, h.2⟩ + · have h := hpair a b x (x + ⟨0, 1⟩) x (by simp) (by simp) he + exact ⟨x, hx, h.1, h.2⟩ + · have h := hpair a b (x + 1) (x + 1 + ⟨0, 1⟩) x (by simp) (by simp) he + exact ⟨x, hx, h.1, h.2⟩ + · have h := hpair a b (x + ⟨0, 1⟩) (x + 1 + ⟨0, 1⟩) x (by simp) (by simp) he + exact ⟨x, hx, h.1, h.2⟩ + by_cases hp1 : p.length = 1 + · obtain ⟨a, rfl⟩ : ∃ a : GaussianInt, p = [a] := by + cases p with + | nil => simp at hp + | cons a q => cases q with + | nil => exact ⟨a, rfl⟩ + | cons b q => simp at hp1 + obtain ⟨x, hx, hca⟩ := hvertex a (hv a (by simp)) + change GaussianRealPoint a ∈ ⋃ x ∈ T.cells, ClosedSquareRealization x + exact Set.mem_iUnion.mpr ⟨x, Set.mem_iUnion.mpr ⟨hx, hcorner x a hca⟩⟩ + · have hpLen : 0 < p.length := by cases p with | nil => contradiction | cons a q => simp + have hn : 0 < p.length - 1 := by omega + obtain ⟨k, hk, ht1, ht2⟩ := hinterval hn t + have hk0 : k < p.length := by omega + have hk1 : k + 1 < p.length := by omega + let a := p.getD k 0 + let b := p.getD (k + 1) 0 + have hgetA : a = p[k] := by + exact List.getD_eq_getElem (l := p) (d := 0) hk0 + have hgetB : b = p[k + 1] := by + exact List.getD_eq_getElem (l := p) (d := 0) hk1 + have haV : a ∈ FootprintVertices T := by + apply hv a + rw [hgetA] + exact List.getElem_mem hk0 + have hbV : b ∈ FootprintVertices T := by + apply hv b + rw [hgetB] + exact List.getElem_mem hk1 + have hdrop0 : p.drop k = a :: p.drop (k + 1) := by + calc + p.drop k = p[k] :: p.drop (k + 1) := (List.cons_getElem_drop_succ (h := hk0)).symm + _ = a :: p.drop (k + 1) := by + congr 1 + exact hgetA.symm + have hdrop1 : p.drop (k + 1) = b :: p.drop (k + 2) := by + calc + p.drop (k + 1) = p[k + 1] :: p.drop (k + 2) := (List.cons_getElem_drop_succ (h := + hk1)).symm + _ = b :: p.drop (k + 2) := by + congr 1 + exact hgetB.symm + have hdecomp : p = p.take k ++ a :: b :: p.drop (k + 2) := by + calc + p = p.take k ++ p.drop k := (List.take_append_drop k p).symm + _ = p.take k ++ a :: b :: p.drop (k + 2) := by rw [hdrop0, hdrop1] + have he := hed a b (p.take k) (p.drop (k + 2)) hdecomp + obtain ⟨x, hx, hax, hbx⟩ := hedgeSupport a b he + have hval := hseg p k hk t ht1 ht2 + let r : Real := (p.length - 1 : Nat) * (t : Real) - k + have hncast : ((p.length - 1 : Nat) : Real) = (p.length : Real) - 1 := by + rw [Nat.cast_sub (by omega : 1 ≤ p.length)] + simp + have hden : (0 : Real) < (p.length : Real) - 1 := by + rw [← hncast] + exact_mod_cast hn + have hmlo : (k : Real) ≤ (p.length - 1 : Nat) * (t : Real) := by + rw [div_le_iff₀ hden] at ht1 + rw [← hncast] at ht1 + nlinarith [mul_comm (↑(p.length - 1 : Nat) : Real) (t : Real)] + have hmhi : (p.length - 1 : Nat) * (t : Real) ≤ (k + 1 : Nat) := by + rw [le_div_iff₀ hden] at ht2 + rw [← hncast] at ht2 + nlinarith [mul_comm (↑(p.length - 1 : Nat) : Real) (t : Real)] + have hr0 : 0 ≤ r := by dsimp [r]; linarith [hmlo] + have hr1 : r ≤ 1 := by + dsimp [r] + norm_num [Nat.cast_add] at hmhi ⊢ + linarith [hmhi] + have hsq : P3776T1WalkMap p t ∈ ClosedSquareRealization x := by + rw [hval] + exact hcombo _ _ _ _ hax hbx r hr0 hr1 + change P3776T1WalkMap p t ∈ ⋃ x ∈ T.cells, ClosedSquareRealization x + exact Set.mem_iUnion.mpr ⟨x, Set.mem_iUnion.mpr ⟨hx, hsq⟩⟩ + +end WalkMapLemmas + +theorem P3776T1WalkMapProperties (p : List GaussianInt) (hp : p ≠ []) : + Continuous (P3776T1WalkMap p) ∧ + P3776T1WalkMap p ⟨0, by norm_num⟩ = GaussianRealPoint (p.getD 0 0) ∧ + P3776T1WalkMap p ⟨1, by norm_num⟩ = + GaussianRealPoint (p.getLast?.getD 0) ∧ + (∀ t : Set.Icc (0 : Real) 1, + P3776T1WalkMap p.reverse t = + P3776T1WalkMap p ⟨1 - (t : Real), by constructor <;> linarith [t.2.1, t.2.2]⟩) ∧ + (∀ u : GaussianInt, ∀ t : Set.Icc (0 : Real) 1, + P3776T1WalkMap (p.map (fun z => z + u)) t = + P3776T1WalkMap p t + GaussianRealPoint u) ∧ + (∀ T : ProtoTile, LatticeTile T → + (∀ z ∈ p, z ∈ FootprintVertices T) → + (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → {a, b} ∈ FootprintEdges T) → + ∀ t, P3776T1WalkMap p t ∈ TileRealization T) := by +-- BODY + classical + have hsingle (a : GaussianInt) : Continuous (P3776T1WalkMap [a]) := WalkMapLemmas.hsingle a + have hseg (q : List GaussianInt) (k : Nat) (hk : k < q.length - 1) + (t : Set.Icc (0 : Real) 1) + (ht1 : (k : Real) / (q.length - 1) ≤ (t : Real)) + (ht2 : (t : Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1)) : + P3776T1WalkMap q t = + (1 - ((q.length - 1 : Nat) * (t : Real) - k)) • + GaussianRealPoint (q.getD k 0) + + ((q.length - 1 : Nat) * (t : Real) - k) • + GaussianRealPoint (q.getD (k + 1) 0) := WalkMapLemmas.hseg q k hk t ht1 ht2 + have hlastD : p.getLast?.getD 0 = p.getD (p.length - 1) 0 := WalkMapLemmas.hlastD p hp + have hinterval (hn : 0 < p.length - 1) (t : Set.Icc (0 : Real) 1) : + ∃ k, k < p.length - 1 ∧ + (k : Real) / (p.length - 1) ≤ (t : Real) ∧ + (t : Real) ≤ ((k + 1 : Nat) : Real) / (p.length - 1) := WalkMapLemmas.hinterval p hn t + have hcombo (lo hi a b : Real × Real) (ha : a ∈ Set.Icc lo hi) + (hb : b ∈ Set.Icc lo hi) (r : Real) (hr0 : 0 ≤ r) (hr1 : r ≤ 1) : + (1 - r) • a + r • b ∈ Set.Icc lo hi := WalkMapLemmas.hcombo lo hi a b ha hb r hr0 hr1 + have walk_continuous : Continuous (P3776T1WalkMap p) := WalkMapLemmas.walk_continuous p hp + hsingle hseg hlastD hinterval + have walk_start : P3776T1WalkMap p ⟨0, by norm_num⟩ = GaussianRealPoint (p.getD 0 0) := + WalkMapLemmas.walk_start p hp hseg hlastD hinterval walk_continuous + have walk_end : P3776T1WalkMap p ⟨1, by norm_num⟩ = + GaussianRealPoint (p.getLast?.getD 0) := WalkMapLemmas.walk_end p hp hseg hlastD hinterval + walk_continuous walk_start + have walk_reverse : (∀ t : Set.Icc (0 : Real) 1, + P3776T1WalkMap p.reverse t = + P3776T1WalkMap p ⟨1 - (t : Real), by constructor <;> linarith [t.2.1, t.2.2]⟩) := + WalkMapLemmas.walk_reverse p hp hseg hlastD hinterval walk_continuous walk_start + walk_end + have walk_translate : (∀ u : GaussianInt, ∀ t : Set.Icc (0 : Real) 1, + P3776T1WalkMap (p.map (fun z => z + u)) t = + P3776T1WalkMap p t + GaussianRealPoint u) := WalkMapLemmas.walk_translate p hp hseg + hlastD hinterval walk_continuous walk_start walk_end walk_reverse + have walk_contained : (∀ T : ProtoTile, LatticeTile T → + (∀ z ∈ p, z ∈ FootprintVertices T) → + (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → {a, b} ∈ FootprintEdges T) → + ∀ t, P3776T1WalkMap p t ∈ TileRealization T) := WalkMapLemmas.walk_contained p hp hseg + hlastD hinterval hcombo walk_continuous walk_start walk_end walk_reverse walk_translate + exact ⟨walk_continuous, walk_start, walk_end, walk_reverse, walk_translate, walk_contained⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrement.lean b/LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrement.lean new file mode 100644 index 0000000000..20c5f3cdc9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrement.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Analysis.SpecialFunctions.Complex.Circle +public import Mathlib.Topology.Homotopy.Path +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: P3821T1AngularIncrement] + +/-! +# P3821T1AngularIncrement + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a continuous map $g:[0,1]\to\mathbb C$ and $p\in\mathbb C$, define +$\Delta_p(g)=\operatorname{P3821\_T1\_AngularIncrement}(g,p)$ as follows. +If there is a continuous real function $\theta$ with +$$ + e^{\mathrm i\theta(t)}=\frac{g(t)-p}{|g(t)-p|}\quad(0\le t\le1), +$$ +choose one such function and set $\Delta_p(g)=\theta(1)-\theta(0)$. +If there is no such function, set $\Delta_p(g)=0$. +Here complex division by zero has its usual totalized value zero. +The choice is part of the definition; independence and the existence of +a lift for a puncture-avoiding path are separate assertions. +-/ +noncomputable def P3821T1AngularIncrement + (g : C(unitInterval, ℂ)) (p : ℂ) : ℝ := by +-- BODY + classical + exact if h : ∃ theta : C(unitInterval, ℝ), ∀ t, + Complex.exp ((theta t : ℂ) * Complex.I) = + (g t - p) / (‖g t - p‖ : ℂ) then + (Classical.choose h) ⟨1, by norm_num⟩ - + (Classical.choose h) ⟨0, by norm_num⟩ + else 0 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrementLaws.lean b/LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrementLaws.lean new file mode 100644 index 0000000000..3e0ac012b9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrementLaws.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3821T1AngularIncrement +public import Mathlib.Topology.Homotopy.Lifting + +-- [TABLET NODE: P3821T1AngularIncrementLaws] + +/-! +# P3821T1AngularIncrementLaws + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3821T1AngularIncrementLaws : + (∀ (g : C(unitInterval, ℂ)) (p : ℂ), (∀ t, g t ≠ p) → + ∃ theta : C(unitInterval, ℝ), + (∀ t, Complex.exp ((theta t : ℂ) * Complex.I) = + (g t - p) / (‖g t - p‖ : ℂ)) ∧ + (∀ eta : C(unitInterval, ℝ), + (∀ t, Complex.exp ((eta t : ℂ) * Complex.I) = + (g t - p) / (‖g t - p‖ : ℂ)) → + eta ⟨1, by norm_num⟩ - eta ⟨0, by norm_num⟩ = + P3821T1AngularIncrement g p) ∧ + (g ⟨0, by norm_num⟩ = g ⟨1, by norm_num⟩ → + ∃ n : ℤ, P3821T1AngularIncrement g p = 2 * Real.pi * n)) ∧ + (∀ (x y z p : ℂ) (g : Path x y) (h : Path y z), + (∀ t, g t ≠ p) → (∀ t, h t ≠ p) → + P3821T1AngularIncrement (g.trans h).toContinuousMap p = + P3821T1AngularIncrement g.toContinuousMap p + + P3821T1AngularIncrement h.toContinuousMap p) ∧ + (∀ (x y p : ℂ) (g : Path x y), (∀ t, g t ≠ p) → + P3821T1AngularIncrement g.symm.toContinuousMap p = + -P3821T1AngularIncrement g.toContinuousMap p) := by +-- BODY + classical + have lift_exists (g : C(unitInterval, ℂ)) (p : ℂ) (hg : ∀ t, g t ≠ p) : + ∃ theta : C(unitInterval, ℝ), ∀ t, + Complex.exp ((theta t : ℂ) * Complex.I) = + (g t - p) / (‖g t - p‖ : ℂ) := by + let n : C(unitInterval, Circle) := + ⟨fun t => ⟨(g t - p) / (‖g t - p‖ : ℂ), by + apply mem_sphere_zero_iff_norm.mpr + simp only [norm_div, Complex.norm_real, Real.norm_eq_abs, abs_norm] + exact div_self (norm_ne_zero_iff.mpr (sub_ne_zero.mpr (hg t)))⟩, + by + apply Continuous.subtype_mk + exact (g.continuous.sub continuous_const).div + (Complex.continuous_ofReal.comp (g.continuous.sub continuous_const).norm) + (fun t => Complex.ofReal_ne_zero.mpr + (norm_ne_zero_iff.mpr (sub_ne_zero.mpr (hg t))))⟩ + obtain ⟨theta, htheta, _⟩ := Circle.isCoveringMap_exp.exists_path_lifts n + (Complex.arg (n 0)) (Circle.exp_arg (n 0)).symm + exact ⟨theta, fun t => congrArg (fun u : Circle => (u : ℂ)) (congrFun htheta t)⟩ + have difference_eq (theta eta : C(unitInterval, ℝ)) + (h : ∀ t, Circle.exp (theta t) = Circle.exp (eta t)) : + eta 1 - eta 0 = theta 1 - theta 0 := by + let shifted : C(unitInterval, ℝ) := + ⟨fun t => eta t + (theta 0 - eta 0), by fun_prop⟩ + have hs : Circle.exp ∘ shifted = Circle.exp ∘ theta := by + funext t + change Circle.exp (eta t + (theta 0 - eta 0)) = Circle.exp (theta t) + simp only [Circle.exp_add, Circle.exp_sub, h 0, div_self', mul_one, h t] + have heq := Circle.isCoveringMap_exp.eq_of_comp_eq + shifted.continuous theta.continuous hs 0 (by dsimp [shifted]; ring) + have hv := congrFun heq 1 + dsimp [shifted] at hv + linarith + have increment_of_lift (g : C(unitInterval, ℂ)) (p : ℂ) + (theta : C(unitInterval, ℝ)) + (htheta : ∀ t, Complex.exp ((theta t : ℂ) * Complex.I) = + (g t - p) / (‖g t - p‖ : ℂ)) : + P3821T1AngularIncrement g p = theta 1 - theta 0 := by + unfold P3821T1AngularIncrement + split_ifs with h + · apply difference_eq theta (Classical.choose h) + intro t + apply Circle.ext + simp only [Circle.coe_exp] + exact (htheta t).trans ((Classical.choose_spec h) t).symm + · exact (h ⟨theta, htheta⟩).elim + refine ⟨?_, ?_, ?_⟩ + · intro g p hg + obtain ⟨theta, htheta⟩ := lift_exists g p hg + refine ⟨theta, htheta, ?_, ?_⟩ + · intro eta heta + exact (increment_of_lift g p eta heta).symm + · intro hclosed + change g 0 = g 1 at hclosed + have heq : Circle.exp (theta 1) = Circle.exp (theta 0) := by + apply Circle.ext + simp only [Circle.coe_exp] + rw [htheta 1, htheta 0, hclosed] + obtain ⟨n, hn⟩ := Circle.exp_eq_exp.mp heq + refine ⟨n, ?_⟩ + rw [increment_of_lift g p theta htheta] + linarith + · intro x y z p g h hg hh + obtain ⟨theta, htheta⟩ := lift_exists g.toContinuousMap p hg + obtain ⟨eta, heta⟩ := lift_exists h.toContinuousMap p hh + have hend : Circle.exp (theta 1) = Circle.exp (eta 0) := by + apply Circle.ext + simp only [Circle.coe_exp] + rw [htheta 1, heta 0] + simp only [Path.coe_toContinuousMap, Path.target, Path.source] + let shifted : C(unitInterval, ℝ) := + ⟨fun t => eta t + (theta 1 - eta 0), by fun_prop⟩ + have hshifted (t : unitInterval) : + Complex.exp ((shifted t : ℂ) * Complex.I) = + (h t - p) / (‖h t - p‖ : ℂ) := by + have hc : Circle.exp (shifted t) = Circle.exp (eta t) := by + change Circle.exp (eta t + (theta 1 - eta 0)) = Circle.exp (eta t) + simp only [Circle.exp_add, Circle.exp_sub, hend, div_self', mul_one] + exact (congrArg (fun u : Circle => (u : ℂ)) hc).trans (heta t) + let lg : Path (theta 0) (theta 1) := ⟨theta, rfl, rfl⟩ + let lh : Path (theta 1) (shifted 1) := + ⟨shifted, by dsimp [shifted]; ring, rfl⟩ + have hconcat (t : unitInterval) : + Complex.exp (((lg.trans lh) t : ℂ) * Complex.I) = + ((g.trans h) t - p) / (‖(g.trans h) t - p‖ : ℂ) := by + rw [Path.trans_apply, Path.trans_apply] + split_ifs with ht + · exact htheta _ + · exact hshifted _ + rw [increment_of_lift (g.trans h).toContinuousMap p + (lg.trans lh).toContinuousMap hconcat, + increment_of_lift g.toContinuousMap p theta htheta, + increment_of_lift h.toContinuousMap p eta heta] + change (lg.trans lh) 1 - (lg.trans lh) 0 = _ + rw [Path.target, Path.source] + dsimp only [shifted, ContinuousMap.coe_mk] + ring + · intro x y p g hg + obtain ⟨theta, htheta⟩ := lift_exists g.toContinuousMap p hg + let rev : C(unitInterval, ℝ) := + ⟨fun t => theta (unitInterval.symm t), by fun_prop⟩ + have hrev (t : unitInterval) : + Complex.exp ((rev t : ℂ) * Complex.I) = + (g.symm t - p) / (‖g.symm t - p‖ : ℂ) := by + simpa only [rev, ContinuousMap.coe_mk, Path.symm_apply, Function.comp_apply, + Path.coe_toContinuousMap] + using htheta (unitInterval.symm t) + rw [increment_of_lift g.symm.toContinuousMap p rev hrev, + increment_of_lift g.toContinuousMap p theta htheta] + simp only [rev, ContinuousMap.coe_mk, unitInterval.symm_one, unitInterval.symm_zero] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean b/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean new file mode 100644 index 0000000000..ff46374722 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean @@ -0,0 +1,481 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3821T1ControlledNeighborhood +public import LeanPool.ApollonianSuperharmonic.P3821T1ComponentContours +public import LeanPool.ApollonianSuperharmonic.P3821T1LoopIndexLaws +public import Mathlib.Analysis.Complex.Basic +public import Mathlib.Analysis.Normed.Module.Connected +public import Mathlib.Topology.Connected.PathConnected +public import Mathlib.Topology.Homeomorph.Lemmas +public import Mathlib.LinearAlgebra.Complex.FiniteDimensional + +-- [TABLET NODE: P3821T1CircleComponentBound] + +/-! +# P3821T1CircleComponentBound + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CircleComponentProof + +private theorem hRadialImage : + ∀ (r : ℝ), + let R : ℝ := max r 0 + 1 + (0 < R) → ( + let U : Set ℂ := {w | R < ‖w‖} + let radial : ℂ × ℝ → ℂ := fun v => v.2 • v.1 + radial '' (Metric.sphere (0 : ℂ) 1 ×ˢ Set.Ioi R) = U) := by + classical + intro r R hRpos U radial + ext w + constructor + · rintro ⟨⟨u, t⟩, ⟨hu, ht⟩, rfl⟩ + have hu' : ‖u‖ = 1 := by + simpa [Metric.mem_sphere, dist_zero_right] using hu + have htpos : 0 < t := lt_trans hRpos ht + change R < ‖t • u‖ + rw [norm_smul, Real.norm_eq_abs, abs_of_pos htpos, hu'] + simpa using ht + · intro hw + have hwpos : 0 < ‖w‖ := lt_trans hRpos hw + refine ⟨(w / ‖w‖, ‖w‖), ?_, ?_⟩ + · constructor + · change dist (w / ‖w‖) 0 = 1 + simp only [dist_zero_right, norm_div, Complex.norm_real, + Real.norm_eq_abs, abs_norm] + exact div_self hwpos.ne' + · exact hw + · change ‖w‖ • (w / ‖w‖) = w + change (‖w‖ : ℂ) * (w / (‖w‖ : ℂ)) = w + field_simp [Complex.ofReal_ne_zero.mpr hwpos.ne'] + +private theorem boundedComponent : + ∀ (e : C(Circle, Real × Real)), + let h₀ : ℂ ≃ₜ (Real × Real) := + Complex.equivRealProd.toHomeomorphOfIsInducing + Complex.isUniformEmbedding_equivRealProd.isInducing + let h : (Real × Real) ≃ₜ ℂ := h₀.symm + let ec : C(Circle, ℂ) := ⟨fun t => h (e t), h.continuous.comp e.continuous⟩ + let K : Set ℂ := Set.range ec + let T : Set ℂ := Kᶜ + ∀ (r : ℝ), + let R : ℝ := max r 0 + 1 + let U : Set ℂ := {w | R < ‖w‖} + let aInf : ℂ := (R + 1 : ℝ) + let CInf : Set ℂ := connectedComponentIn T aInf + (U ⊆ CInf) → (∀ w ∈ T, connectedComponentIn T w ≠ CInf → Bornology.IsBounded + (connectedComponentIn T w)) := by + classical + intro e h₀ h ec K T r R U aInf CInf hUcomponent w hw hneq + rw [Metric.isBounded_iff_subset_closedBall (0 : ℂ)] + refine ⟨R, ?_⟩ + intro v hv + have hvT : v ∈ T := connectedComponentIn_subset T w hv + by_contra hvball + have hvU : v ∈ U := by + change R < ‖v‖ + have hnotnorm : ¬ ‖v‖ ≤ R := by + simpa [Metric.mem_closedBall, dist_zero_right] using hvball + exact lt_of_not_ge hnotnorm + have hvInf : v ∈ CInf := hUcomponent hvU + have hweqv : connectedComponentIn T w = connectedComponentIn T v := + connectedComponentIn_eq hv + have hIneqv : CInf = connectedComponentIn T v := connectedComponentIn_eq hvInf + exact hneq (hweqv.trans hIneqv.symm) + +private theorem hcomp_pull : + ∀ (e : C(Circle, Real × Real)), + let h₀ : ℂ ≃ₜ (Real × Real) := + Complex.equivRealProd.toHomeomorphOfIsInducing + Complex.isUniformEmbedding_equivRealProd.isInducing + let h : (Real × Real) ≃ₜ ℂ := h₀.symm + let ec : C(Circle, ℂ) := ⟨fun t => h (e t), h.continuous.comp e.continuous⟩ + let K : Set ℂ := Set.range ec + let T : Set ℂ := Kᶜ + let S : Set (Real × Real) := (Set.range e)ᶜ + (h '' S = T) → ((h.symm '' T = S) → (∀ (u : ℝ × ℝ), ∀ (v : ℝ × ℝ), u ∈ S → v ∈ S → + connectedComponentIn T ((h : ℝ × ℝ → ℂ) u) = connectedComponentIn T ((h : ℝ × ℝ → ℂ) v) → + connectedComponentIn S u = connectedComponentIn S v)) := by + classical + intro e h₀ h ec K T S hImageS hSymmImageT u v hu hv hcmp + have huT : h u ∈ T := by rw [← hImageS]; exact Set.mem_image_of_mem h hu + have hvT : h v ∈ T := by rw [← hImageS]; exact Set.mem_image_of_mem h hv + have hmem : h v ∈ connectedComponentIn T (h u) := by + rw [hcmp] + exact mem_connectedComponentIn hvT + have himage := h.symm.continuous.continuousOn.image_connectedComponentIn_subset + (s := T) (a := h u) huT + have hmem' : v ∈ connectedComponentIn S u := by + have : h.symm (h v) ∈ h.symm '' connectedComponentIn T (h u) := ⟨h v, hmem, rfl⟩ + have him := himage this + simpa [hSymmImageT, h.symm_apply_apply] using him + exact connectedComponentIn_eq hmem' + +private theorem hcomp_push : + ∀ (e : C(Circle, Real × Real)), + let h₀ : ℂ ≃ₜ (Real × Real) := + Complex.equivRealProd.toHomeomorphOfIsInducing + Complex.isUniformEmbedding_equivRealProd.isInducing + let h : (Real × Real) ≃ₜ ℂ := h₀.symm + let ec : C(Circle, ℂ) := ⟨fun t => h (e t), h.continuous.comp e.continuous⟩ + let K : Set ℂ := Set.range ec + let T : Set ℂ := Kᶜ + let S : Set (Real × Real) := (Set.range e)ᶜ + (h '' S = T) → (∀ (u : ℝ × ℝ), ∀ (v : ℝ × ℝ), u ∈ S → v ∈ S → connectedComponentIn S u = + connectedComponentIn S v → connectedComponentIn T ((h : ℝ × ℝ → ℂ) u) = + connectedComponentIn T ((h : ℝ × ℝ → ℂ) v)) := by + classical + intro e h₀ h ec K T S hImageS u v hu hv hcmp + have huT : h u ∈ T := by rw [← hImageS]; exact Set.mem_image_of_mem h hu + have hvT : h v ∈ T := by rw [← hImageS]; exact Set.mem_image_of_mem h hv + have hmem : v ∈ connectedComponentIn S u := by rw [hcmp]; exact mem_connectedComponentIn hv + have himage := h.continuous.continuousOn.image_connectedComponentIn_subset + (s := S) (a := u) hu + have hmem' : h v ∈ connectedComponentIn T (h u) := by + have : h v ∈ h '' connectedComponentIn S u := ⟨v, hmem, rfl⟩ + have him := himage this + simpa [hImageS] using him + exact connectedComponentIn_eq hmem' + +private theorem impossible_pair : + ∀ (e : C(Circle, Real × Real)), (Function.Injective (⇑e : Circle → ℝ × ℝ)) → ( + let h₀ : ℂ ≃ₜ (Real × Real) := + Complex.equivRealProd.toHomeomorphOfIsInducing + Complex.isUniformEmbedding_equivRealProd.isInducing + let h : (Real × Real) ≃ₜ ℂ := h₀.symm + let ec : C(Circle, ℂ) := ⟨fun t => h (e t), h.continuous.comp e.continuous⟩ + let K : Set ℂ := Set.range ec + let T : Set ℂ := Kᶜ + (IsCompact K) → ((K.Nonempty) → (∀ (p : ℂ), ∀ (q : ℂ), p ∈ T → q ∈ T → connectedComponentIn T + p ≠ connectedComponentIn T q → Bornology.IsBounded (connectedComponentIn T p) → + Bornology.IsBounded (connectedComponentIn T q) → False))) := by + classical + intro e he h₀ h ec K T hKcompact hKne p q hp hq hne hpBound hqBound + have hpDist : 0 < Metric.infDist p K := + (hKcompact.isClosed.notMem_iff_infDist_pos hKne).1 hp + have hqDist : 0 < Metric.infDist q K := + (hKcompact.isClosed.notMem_iff_infDist_pos hKne).1 hq + let eps : ℝ := min (Metric.infDist p K) (Metric.infDist q K) / 2 + have heps : 0 < eps := by dsimp [eps]; positivity + have hpMargin : eps < Metric.infDist p K := by + dsimp [eps] + have hm : min (Metric.infDist p K) (Metric.infDist q K) ≤ Metric.infDist p K := min_le_left _ _ + linarith + have hqMargin : eps < Metric.infDist q K := by + dsimp [eps] + have hm : min (Metric.infDist p K) (Metric.infDist q K) ≤ Metric.infDist q K := min_le_right _ _ + linarith + have hec : Function.Injective ec := by + intro s t hst + apply he + exact congrArg h.symm hst + obtain ⟨N, hNopen, hKN, phi, hphi⟩ := + P3821T1ControlledNeighborhood ec hec eps heps + obtain ⟨n, g, hgN, hgAvoid, hgp, hgq⟩ := + P3821T1ComponentContours K N hKcompact hNopen hKN p q hp hq hne hpBound + obtain ⟨m, k, hkN, hkAvoid, hkq, hkp⟩ := + P3821T1ComponentContours K N hKcompact hNopen hKN q p hq hp hne.symm hqBound + let j : C(Circle, ℂ) := ⟨fun t => (t : ℂ), continuous_subtype_val⟩ + rcases P3821T1LoopIndexLaws with ⟨_, hcomp, hhom⟩ + let alphaOf (f : C(Circle, ℂ)) (hfN : Set.range f ⊆ N) : C(Circle, Circle) := + phi.comp ⟨fun t => ⟨f t, hfN ⟨t, rfl⟩⟩, + Continuous.subtype_mk f.continuous (fun t => hfN ⟨t, rfl⟩)⟩ + have index_relation (f : C(Circle, ℂ)) (hfN : Set.range f ⊆ N) + (r : ℂ) (hr : r ∈ T) (hmargin : eps < Metric.infDist r K) + (hfavoid : ∀ t, f t ≠ r) : + P3821T1LoopIndex f r = + P3821T1LoopIndex (j.comp (alphaOf f hfN)) 0 * + P3821T1LoopIndex ec r := by + let alpha := alphaOf f hfN + let H : C(unitInterval × Circle, ℂ) := + ⟨fun st => ((1 - (st.1 : ℝ) : ℝ) : ℂ) * f st.2 + + ((st.1 : ℝ) : ℂ) * ec (alpha st.2), by fun_prop⟩ + have hAvoid (s : unitInterval) (t : Circle) : H (s, t) ≠ r := by + intro heq + have happrox := hphi ⟨f t, hfN ⟨t, rfl⟩⟩ + have hmem : ec (alpha t) ∈ K := ⟨alpha t, rfl⟩ + have hinf : Metric.infDist r K ≤ dist r (ec (alpha t)) := + Metric.infDist_le_dist_of_mem hmem + have hclose : dist (H (s, t)) (ec (alpha t)) < eps := by + have hlinear : H (s, t) - ec (alpha t) = + ((1 - (s : ℝ) : ℝ) : ℂ) * (f t - ec (alpha t)) := by + dsimp [H] + push_cast + ring + have hnorm : ‖H (s, t) - ec (alpha t)‖ < eps := by + rw [hlinear, norm_mul] + simp only [Complex.norm_real, Real.norm_eq_abs] + have hs : 0 ≤ 1 - (s : ℝ) := by linarith [s.2.2] + rw [abs_of_nonneg hs] + have herr : ‖f t - ec (alpha t)‖ < eps := by + simpa [alpha, alphaOf, dist_eq_norm, norm_sub_rev] using happrox + have hcoeff : 1 - (s : ℝ) ≤ 1 := by linarith [s.2.1] + calc + (1 - (s : ℝ)) * ‖f t - ec (alpha t)‖ ≤ + 1 * ‖f t - ec (alpha t)‖ := by gcongr + _ < eps := by simpa using herr + simpa [dist_eq_norm] using hnorm + have hdist : dist r (ec (alpha t)) < eps := by + rw [← heq] + exact hclose + linarith + let H0 : C(Circle, ℂ) := ⟨fun t => H (⟨0, by norm_num⟩, t), by fun_prop⟩ + let H1 : C(Circle, ℂ) := ⟨fun t => H (⟨1, by norm_num⟩, t), by fun_prop⟩ + have hH0 : H0 = f := by ext t; simp [H0, H] + have hH1 : H1 = ec.comp alpha := by ext t; simp [H1, H] + have hhom' := hhom H r hAvoid + have hcomp' := hcomp ec alpha r (fun t => by + intro heq + exact (show r ∉ K from hr) ⟨t, heq⟩) + have hhom'' : P3821T1LoopIndex H0 r = P3821T1LoopIndex H1 r := by + change P3821T1LoopIndex + ⟨fun t => H (⟨0, by norm_num⟩, t), by fun_prop⟩ r = + P3821T1LoopIndex ⟨fun t => H (⟨1, by norm_num⟩, t), by fun_prop⟩ r + exact hhom' + calc + P3821T1LoopIndex f r = P3821T1LoopIndex H0 r := by rw [hH0] + _ = P3821T1LoopIndex H1 r := hhom'' + _ = P3821T1LoopIndex (ec.comp alpha) r := by rw [hH1] + _ = P3821T1LoopIndex (j.comp alpha) 0 * P3821T1LoopIndex ec r := hcomp' + _ = P3821T1LoopIndex (j.comp (alphaOf f hfN)) 0 * + P3821T1LoopIndex ec r := by rfl + have hgRelP (i : Fin n) : P3821T1LoopIndex (g i) p = + P3821T1LoopIndex (j.comp (alphaOf (g i) (hgN i))) 0 * + P3821T1LoopIndex ec p := + index_relation (g i) (hgN i) p hp hpMargin (fun t => (hgAvoid i t).1) + have hgRelQ (i : Fin n) : P3821T1LoopIndex (g i) q = + P3821T1LoopIndex (j.comp (alphaOf (g i) (hgN i))) 0 * + P3821T1LoopIndex ec q := + index_relation (g i) (hgN i) q hq hqMargin (fun t => (hgAvoid i t).2) + let dg : Fin n → ℝ := fun i => + P3821T1LoopIndex (j.comp (alphaOf (g i) (hgN i))) 0 + let A : ℝ := ∑ i, dg i + have hrowgp : (∑ i, P3821T1LoopIndex (g i) p) = A * + P3821T1LoopIndex ec p := by + calc + _ = ∑ i, dg i * P3821T1LoopIndex ec p := + Finset.sum_congr rfl (fun i _ => hgRelP i) + _ = A * P3821T1LoopIndex ec p := by + dsimp [A] + rw [Finset.sum_mul] + have hrowgq : (∑ i, P3821T1LoopIndex (g i) q) = A * + P3821T1LoopIndex ec q := by + calc + _ = ∑ i, dg i * P3821T1LoopIndex ec q := + Finset.sum_congr rfl (fun i _ => hgRelQ i) + _ = A * P3821T1LoopIndex ec q := by + dsimp [A] + rw [Finset.sum_mul] + have hAprod : A * P3821T1LoopIndex ec p = 1 := by + rw [← hrowgp] + exact hgp + have hAzero : A * P3821T1LoopIndex ec q = 0 := by + rw [← hrowgq] + exact hgq + have hAne : A ≠ 0 := by + intro hz + rw [hz] at hAprod + norm_num at hAprod + have hBrelQ (i : Fin m) : P3821T1LoopIndex (k i) q = + P3821T1LoopIndex (j.comp (alphaOf (k i) (hkN i))) 0 * + P3821T1LoopIndex ec q := + index_relation (k i) (hkN i) q hq hqMargin (fun t => (hkAvoid i t).1) + have hBrelP (i : Fin m) : P3821T1LoopIndex (k i) p = + P3821T1LoopIndex (j.comp (alphaOf (k i) (hkN i))) 0 * + P3821T1LoopIndex ec p := + index_relation (k i) (hkN i) p hp hpMargin (fun t => (hkAvoid i t).2) + let dk : Fin m → ℝ := fun i => + P3821T1LoopIndex (j.comp (alphaOf (k i) (hkN i))) 0 + let B : ℝ := ∑ i, dk i + have hrowkq : (∑ i, P3821T1LoopIndex (k i) q) = B * + P3821T1LoopIndex ec q := by + calc + _ = ∑ i, dk i * P3821T1LoopIndex ec q := + Finset.sum_congr rfl (fun i _ => hBrelQ i) + _ = B * P3821T1LoopIndex ec q := by + dsimp [B] + rw [Finset.sum_mul] + have hrowkp : (∑ i, P3821T1LoopIndex (k i) p) = B * + P3821T1LoopIndex ec p := by + calc + _ = ∑ i, dk i * P3821T1LoopIndex ec p := + Finset.sum_congr rfl (fun i _ => hBrelP i) + _ = B * P3821T1LoopIndex ec p := by + dsimp [B] + rw [Finset.sum_mul] + have hBq : B * P3821T1LoopIndex ec q = 1 := by + rw [← hrowkq] + exact hkq + have hBp : B * P3821T1LoopIndex ec p = 0 := by + rw [← hrowkp] + exact hkp + have hbzero : P3821T1LoopIndex ec q = 0 := + (mul_eq_zero.mp hAzero).resolve_left hAne + rw [hbzero] at hBq + norm_num at hBq + +end CircleComponentProof + +theorem P3821T1CircleComponentBound (e : C(Circle, Real × Real)) + (he : Function.Injective e) (x y z : Real × Real) + (hx : x ∈ (Set.range e)ᶜ) (hy : y ∈ (Set.range e)ᶜ) + (hz : z ∈ (Set.range e)ᶜ) : + connectedComponentIn (Set.range e)ᶜ x = connectedComponentIn (Set.range e)ᶜ y ∨ + connectedComponentIn (Set.range e)ᶜ y = connectedComponentIn (Set.range e)ᶜ z ∨ + connectedComponentIn (Set.range e)ᶜ x = connectedComponentIn (Set.range e)ᶜ z := by +-- BODY + classical + let h₀ : ℂ ≃ₜ (Real × Real) := + Complex.equivRealProd.toHomeomorphOfIsInducing + Complex.isUniformEmbedding_equivRealProd.isInducing + let h : (Real × Real) ≃ₜ ℂ := h₀.symm + let ec : C(Circle, ℂ) := ⟨fun t => h (e t), h.continuous.comp e.continuous⟩ + let K : Set ℂ := Set.range ec + let T : Set ℂ := Kᶜ + have hKcompact : IsCompact K := isCompact_range ec.continuous + have hKbounded : Bornology.IsBounded K := hKcompact.isBounded + obtain ⟨r, hrK⟩ := (Metric.isBounded_iff_subset_closedBall (0 : ℂ)).mp hKbounded + let R : ℝ := max r 0 + 1 + have hRpos : 0 < R := by dsimp [R]; linarith [le_max_right r 0] + have hKball : K ⊆ Metric.closedBall (0 : ℂ) R := by + intro w hw + have hw' := hrK hw + change dist w 0 ≤ r at hw' + change dist w 0 ≤ R + dsimp [R] + have : r ≤ max r 0 := le_max_left r 0 + linarith + let U : Set ℂ := {w | R < ‖w‖} + have hSphere : IsPathConnected (Metric.sphere (0 : ℂ) 1) := by + apply isPathConnected_sphere (E := ℂ) + · rw [Complex.rank_real_complex] + norm_num + · norm_num + have hHalf : IsPathConnected (Set.Ioi R : Set ℝ) := by + apply Convex.isPathConnected (convex_Ioi R) + exact ⟨R + 1, by simp⟩ + let radial : ℂ × ℝ → ℂ := fun v => v.2 • v.1 + have hradial_cont : Continuous radial := by + dsimp [radial] + fun_prop + have hDomain : IsPathConnected + (Metric.sphere (0 : ℂ) 1 ×ˢ Set.Ioi R) := hSphere.prod hHalf + have hRadialImage : radial '' + (Metric.sphere (0 : ℂ) 1 ×ˢ Set.Ioi R) = U := CircleComponentProof.hRadialImage r hRpos + have hU : IsPathConnected U := by + rw [← hRadialImage] + exact hDomain.image hradial_cont + have hKnotU : K ⊆ Uᶜ := by + intro w hw + have hball := hKball hw + change dist w 0 ≤ R at hball + change ¬ R < ‖w‖ + simpa [dist_zero_right] using hball + let aInf : ℂ := (R + 1 : ℝ) + have haInfU : aInf ∈ U := by + change R < ‖((R + 1 : ℝ) : ℂ)‖ + calc + R < R + 1 := by linarith + _ = |R + 1| := (abs_of_pos (by linarith : 0 < R + 1)).symm + _ = ‖((R + 1 : ℝ) : ℂ)‖ := (RCLike.norm_ofReal _).symm + let CInf : Set ℂ := connectedComponentIn T aInf + have hUsubT : U ⊆ T := by + intro w hw + change w ∉ K + intro hwK + exact hKnotU hwK hw + have hUcomponent : U ⊆ CInf := by + exact hU.isConnected.isPreconnected.subset_connectedComponentIn haInfU hUsubT + have boundedComponent (w : ℂ) (hw : w ∈ T) + (hneq : connectedComponentIn T w ≠ CInf) : + Bornology.IsBounded (connectedComponentIn T w) := CircleComponentProof.boundedComponent e r + hUcomponent w hw hneq + have hKimage : K = h '' Set.range e := by + ext w + constructor + · rintro ⟨t, rfl⟩ + exact ⟨e t, ⟨t, rfl⟩, rfl⟩ + · rintro ⟨v, ⟨t, rfl⟩, rfl⟩ + exact ⟨t, rfl⟩ + let S : Set (Real × Real) := (Set.range e)ᶜ + have hImageS : h '' S = T := by + change h '' S = Kᶜ + rw [hKimage] + change h '' (Set.range e)ᶜ = (h '' Set.range e)ᶜ + exact h.image_compl (Set.range e) + have hSymmImageT : h.symm '' T = S := by + change h.symm '' Kᶜ = S + rw [hKimage] + change h.symm '' (h '' Set.range e)ᶜ = (Set.range e)ᶜ + rw [← h.image_compl (Set.range e), Set.image_image] + simp + have hcomp_pull (u v : Real × Real) (hu : u ∈ S) (hv : v ∈ S) + (hcmp : connectedComponentIn T (h u) = connectedComponentIn T (h v)) : + connectedComponentIn S u = connectedComponentIn S v := CircleComponentProof.hcomp_pull e + hImageS hSymmImageT u v hu hv hcmp + have hcomp_push (u v : Real × Real) (hu : u ∈ S) (hv : v ∈ S) + (hcmp : connectedComponentIn S u = connectedComponentIn S v) : + connectedComponentIn T (h u) = connectedComponentIn T (h v) := + CircleComponentProof.hcomp_push e hImageS u v hu hv hcmp + have hxS : x ∈ S := hx + have hyS : y ∈ S := hy + have hzS : z ∈ S := hz + have hxT : h x ∈ T := by rw [← hImageS]; exact Set.mem_image_of_mem h hxS + have hyT : h y ∈ T := by rw [← hImageS]; exact Set.mem_image_of_mem h hyS + have hzT : h z ∈ T := by rw [← hImageS]; exact Set.mem_image_of_mem h hzS + have final_of (u v : Real × Real) (hu : u ∈ S) (hv : v ∈ S) + (hcmp : connectedComponentIn T (h u) = connectedComponentIn T (h v)) : + connectedComponentIn S u = connectedComponentIn S v := hcomp_pull u v hu hv hcmp + have hKne : K.Nonempty := ⟨ec 1, ⟨1, rfl⟩⟩ + have impossible_pair (p q : ℂ) (hp : p ∈ T) (hq : q ∈ T) + (hne : connectedComponentIn T p ≠ connectedComponentIn T q) + (hpBound : Bornology.IsBounded (connectedComponentIn T p)) + (hqBound : Bornology.IsBounded (connectedComponentIn T q)) : False := + CircleComponentProof.impossible_pair e he hKcompact hKne p q hp hq hne hpBound hqBound + by_cases hxy : connectedComponentIn S x = connectedComponentIn S y + · exact Or.inl hxy + · by_cases hyz : connectedComponentIn S y = connectedComponentIn S z + · exact Or.inr (Or.inl hyz) + · by_cases hxz : connectedComponentIn S x = connectedComponentIn S z + · exact Or.inr (Or.inr hxz) + · have hxyNe : connectedComponentIn T (h x) ≠ connectedComponentIn T (h y) := by + intro heq + exact hxy (hcomp_pull x y hxS hyS heq) + have hyzNe : connectedComponentIn T (h y) ≠ connectedComponentIn T (h z) := by + intro heq + exact hyz (hcomp_pull y z hyS hzS heq) + have hxzNe : connectedComponentIn T (h x) ≠ connectedComponentIn T (h z) := by + intro heq + exact hxz (hcomp_pull x z hxS hzS heq) + by_cases hxInf : connectedComponentIn T (h x) = CInf + · have hyInf : connectedComponentIn T (h y) ≠ CInf := by + intro heq + exact hxyNe (hxInf.trans heq.symm) + have hzInf : connectedComponentIn T (h z) ≠ CInf := by + intro heq + exact hxzNe (hxInf.trans heq.symm) + exact (impossible_pair (h y) (h z) hyT hzT hyzNe + (boundedComponent (h y) hyT hyInf) (boundedComponent (h z) hzT hzInf)).elim + · by_cases hyInf : connectedComponentIn T (h y) = CInf + · have hzInf : connectedComponentIn T (h z) ≠ CInf := by + intro heq + exact hyzNe (hyInf.trans heq.symm) + exact (impossible_pair (h x) (h z) hxT hzT hxzNe + (boundedComponent (h x) hxT hxInf) (boundedComponent (h z) hzT hzInf)).elim + · exact (impossible_pair (h x) (h y) hxT hyT hxyNe + (boundedComponent (h x) hxT hxInf) (boundedComponent (h y) hyT hyInf)).elim + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean new file mode 100644 index 0000000000..ed10e4778a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean @@ -0,0 +1,1815 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3821T1LoopIndex +public import LeanPool.ApollonianSuperharmonic.P3821T1AngularIncrementLaws +public import Mathlib.Topology.Connected.LocallyConnected +public import Mathlib.Topology.MetricSpace.Bounded +public import Mathlib.Topology.MetricSpace.Thickening +public import Mathlib.Analysis.Convex.PathConnected +public import Mathlib.Analysis.Normed.Module.Connected +public import Mathlib.GroupTheory.Perm.Cycle.Concrete +public import Mathlib.GroupTheory.Perm.Cycle.Factors +public import Mathlib.Algebra.BigOperators.Group.Finset.Basic +public import Mathlib.Data.List.Chain +public import Mathlib.Basic.Real.Basic +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import Mathlib.Data.Fin.VecNotation +public import Mathlib.Algebra.BigOperators.Fin +public import Mathlib.Algebra.BigOperators.Field +public import LeanPool.ApollonianSuperharmonic.P3821T1LoopIndexLaws +public import LeanPool.ApollonianSuperharmonic.GridStepLogLiftDelta +public import Mathlib.Analysis.Normed.Group.Bounded +public import LeanPool.ApollonianSuperharmonic.GridCellCenter +public import Mathlib.Topology.Algebra.Order.Floor +public import Mathlib.Order.Interval.Set.Infinite +public import Mathlib.Analysis.Complex.Norm +public import Mathlib.Analysis.Complex.Basic + +-- [TABLET NODE: P3821T1ComponentContours] + +/-! +# P3821T1ComponentContours + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ComponentContoursProof + +private theorem loop_of_path : + ∀ (f : C((↑unitInterval : Type), ℂ)), (f : (↑unitInterval : Type) → ℂ) (0 : (↑unitInterval : + Type)) = (f : (↑unitInterval : Type) → ℂ) (1 : (↑unitInterval : Type)) → ∃ (g : C(Circle, + ℂ)), (∀ (t : (↑unitInterval : Type)), (g : Circle → ℂ) ((Circle.exp : ℝ → Circle) ((2 : + ℝ) * Real.pi * (↑t : ℝ))) = (f : (↑unitInterval : Type) → ℂ) t) ∧ Set.range (⇑g : Circle + → ℂ) ⊆ Set.range (⇑f : (↑unitInterval : Type) → ℂ) := by + classical + intro f hf + let e : unitInterval → Circle := fun t => Circle.exp (2 * Real.pi * (t : ℝ)) + have he : Continuous e := by fun_prop + have hsurj : Function.Surjective e := by + intro z + let a : ℝ := if 0 ≤ Complex.arg z then Complex.arg z else Complex.arg z + 2 * Real.pi + have ha : 0 ≤ a ∧ a ≤ 2 * Real.pi := by + dsimp [a] + split_ifs with hz + · constructor + · exact hz + · linarith [Complex.arg_le_pi (z : ℂ), Real.pi_pos] + · constructor + · linarith [Complex.neg_pi_lt_arg (z : ℂ), Real.pi_pos] + · linarith + refine ⟨⟨a / (2 * Real.pi), ⟨div_nonneg ha.1 (by positivity), + (div_le_one (by positivity)).mpr ha.2⟩⟩, ?_⟩ + change Circle.exp (2 * Real.pi * (a / (2 * Real.pi))) = z + rw [mul_div_cancel₀ _ (by positivity : (2 * Real.pi : ℝ) ≠ 0)] + dsimp [a] + split_ifs + · exact Circle.exp_arg z + · rw [Circle.exp_add, Circle.exp_two_pi, mul_one] + exact Circle.exp_arg z + have hquot : Topology.IsQuotientMap e := he.isClosedMap.isQuotientMap he hsurj + have hfiber : ∀ x y, e x = e y → f x = f y := by + intro x y hxy + obtain ⟨n, hn⟩ := Circle.exp_eq_exp.mp hxy + have hdiff : (x : ℝ) - (y : ℝ) = (n : ℝ) := by + nlinarith [Real.pi_pos] + have hnlo : -1 ≤ n := by exact_mod_cast (by linarith [x.2.1, y.2.2] : (-1 : ℝ) ≤ n) + have hnhi : n ≤ 1 := by exact_mod_cast (by linarith [x.2.2, y.2.1] : (n : ℝ) ≤ 1) + have hcases : n = -1 ∨ n = 0 ∨ n = 1 := by omega + rcases hcases with rfl | rfl | rfl + · have hx : x = 0 := Subtype.ext (by change (x : ℝ) = 0; norm_num at hdiff; linarith [x.2.1, + y.2.2]) + have hy : y = 1 := Subtype.ext (by change (y : ℝ) = 1; norm_num at hdiff; linarith [x.2.1, + y.2.2]) + simpa [hx, hy] using hf + · congr 1 + apply Subtype.ext + norm_num at hdiff + linarith + · have hx : x = 1 := Subtype.ext (by change (x : ℝ) = 1; norm_num at hdiff; linarith [x.2.2, + y.2.1]) + have hy : y = 0 := Subtype.ext (by change (y : ℝ) = 0; norm_num at hdiff; linarith [x.2.2, + y.2.1]) + simpa [hx, hy] using hf.symm + let g : Circle → ℂ := fun z => f (Classical.choose (hsurj z)) + have hcomp : g ∘ e = f := by + funext t + apply hfiber + exact Classical.choose_spec (hsurj (e t)) + have hg : Continuous g := hquot.continuous_iff.mpr (by rw [hcomp]; exact f.continuous) + refine ⟨⟨g, hg⟩, ?_, ?_⟩ + · exact fun t => congrFun hcomp t + · rintro z ⟨w, rfl⟩ + exact ⟨Classical.choose (hsurj w), rfl⟩ + +private theorem grid_edge_avoids : + ∀ (r : GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), FourNeighborAdjacent a b → ∀ + (t : (↑unitInterval : Type)), (Path.segment ((GaussianInt.toComplex : GaussianInt → ℂ) a) + ((GaussianInt.toComplex : GaussianInt → ℂ) b) : (↑unitInterval : Type) → ℂ) t ≠ + GridCellCenter r := by + classical + intro r a b hab t ht + have hhalf (m n : ℤ) : (m : ℝ) ≠ (n : ℝ) + 1 / 2 := by + intro he + have he' : ((2 * (m - n) : ℤ) : ℝ) = 1 := by push_cast; linarith + have : 2 * (m - n) = 1 := by exact_mod_cast he' + omega + rcases hab with rfl | rfl | rfl | rfl + · have hi := congrArg Complex.im ht + simp? [Path.segment_apply, AffineMap.lineMap_apply, GridCellCenter, + Complex.real_smul, Complex.mul_im] at hi + rw [← GaussianInt.intCast_im a, ← GaussianInt.intCast_im r] at hi + exact hhalf a.im r.im (by linarith) + · have hi := congrArg Complex.im ht + simp? [Path.segment_apply, AffineMap.lineMap_apply, GridCellCenter, + Complex.real_smul, Complex.mul_im] at hi + rw [← GaussianInt.intCast_im a, ← GaussianInt.intCast_im r] at hi + exact hhalf a.im r.im (by linarith) + · have hi := congrArg Complex.re ht + simp? [Path.segment_apply, AffineMap.lineMap_apply, GridCellCenter, + Complex.real_smul, Complex.mul_re] at hi + rw [← GaussianInt.intCast_re a, ← GaussianInt.intCast_re r] at hi + exact hhalf a.re r.re (by linarith) + · have hi := congrArg Complex.re ht + simp? [Path.segment_apply, AffineMap.lineMap_apply, GridCellCenter, + Complex.real_smul, Complex.mul_re] at hi + rw [← GaussianInt.intCast_re a, ← GaussianInt.intCast_re r] at hi + exact hhalf a.re r.re (by linarith) + +private theorem grid_edge_increment : + (∀ (r : GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → + (∀ t : unitInterval, Path.segment (a : ℂ) (b : ℂ) t ≠ GridCellCenter r)) → (∀ (r : + GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), FourNeighborAdjacent a b → + P3821T1AngularIncrement (Path.segment ((GaussianInt.toComplex : GaussianInt → ℂ) a) + ((GaussianInt.toComplex : GaussianInt → ℂ) b)).toContinuousMap (GridCellCenter r) = + (Complex.log ((GaussianInt.toComplex : GaussianInt → ℂ) b - GridCellCenter r)).im - + (Complex.log ((GaussianInt.toComplex : GaussianInt → ℂ) a - GridCellCenter r)).im - (2 : + ℝ) * Real.pi * (↑(if b = a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ a.im = r.im ∧ a.re ≤ r.re then (1 : ℤ) + else if b = a - ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ b.im = r.im ∧ a.re ≤ r.re then (-1 : ℤ) else (0 : + ℤ)) : ℝ)) := by + classical + intro grid_edge_avoids r a b hab + let g := (Path.segment (a : ℂ) (b : ℂ)).toContinuousMap + obtain ⟨theta, ht, hind, _⟩ := P3821T1AngularIncrementLaws.1 g (GridCellCenter r) + (grid_edge_avoids r a b hab) + let L : C(unitInterval, ℂ) := + ⟨fun t => (Real.log ‖g t - GridCellCenter r‖ : ℂ) + (theta t : ℂ) * Complex.I, + by + apply Continuous.add + · exact Complex.continuous_ofReal.comp + ((g.continuous.sub continuous_const).norm.log + (fun t => norm_ne_zero_iff.mpr + (sub_ne_zero.mpr (grid_edge_avoids r a b hab t)))) + · fun_prop⟩ + have hL (t : unitInterval) : Complex.exp (L t) = + (1 - (t : ℝ)) * ((a : ℂ) - GridCellCenter r) + + (t : ℝ) * ((b : ℂ) - GridCellCenter r) := by + change Complex.exp ((Real.log ‖g t - GridCellCenter r‖ : ℂ) + + (theta t : ℂ) * Complex.I) = _ + have hpos : 0 < ‖g t - GridCellCenter r‖ := + norm_pos_iff.mpr (sub_ne_zero.mpr (grid_edge_avoids r a b hab t)) + rw [Complex.exp_add, ← Complex.ofReal_exp, Real.exp_log hpos, ht t] + have hnorm : (‖g t - GridCellCenter r‖ : ℂ) ≠ 0 := + Complex.ofReal_ne_zero.mpr (ne_of_gt hpos) + rw [mul_div_cancel₀ _ hnorm] + simp only [g, Path.coe_toContinuousMap, Path.segment_apply, + AffineMap.lineMap_apply, vsub_eq_sub, vadd_eq_add, Complex.real_smul] + ring + have hdelta := congrArg Complex.im + (GridStepLogLiftDelta r a b hab L L.continuous hL) + have htheta := hind theta ht + simp only [Complex.sub_im, L, ContinuousMap.coe_mk, Complex.add_im, + Complex.ofReal_im, Complex.mul_im, Complex.ofReal_re, Complex.I_im, + Complex.I_re, mul_one, mul_zero, add_zero, zero_add] at hdelta + convert hdelta using 1 + · exact htheta.symm + · split_ifs <;> norm_num + +private theorem concatenate_paths : + ∀ {E : Type}, ∀ (source : E → ℂ), ∀ (target : E → ℂ), ∀ (edge : (e : E) → Path (source e) + (target e)), ∀ (e : E), ∀ (b : E), ∀ (l : List E), (e :: l).getLast? = some b → + List.IsChain (fun (a b : E) => target a = source b) (e :: l) → ∃ (γ : Path (source e) + (target b)), (∀ (t : (↑unitInterval : Type)), ∃ d ∈ e :: l, ∃ (s : (↑unitInterval : + Type)), (γ : (↑unitInterval : Type) → ℂ) t = (edge d : (↑unitInterval : Type) → ℂ) s) ∧ ∀ + (r : ℂ), (∀ d ∈ e :: l, ∀ (s : (↑unitInterval : Type)), (edge d : (↑unitInterval : Type) + → ℂ) s ≠ r) → P3821T1AngularIncrement γ.toContinuousMap r = (List.map (fun (d : E) => + P3821T1AngularIncrement (edge d).toContinuousMap r) (e :: l)).sum := by + classical + intro E source target edge e b l hlast hc + induction l generalizing e with + | nil => + simp only [List.getLast?_singleton, Option.some.injEq] at hlast + subst b + refine ⟨edge e, ?_, ?_⟩ + · intro t + exact ⟨e, by simp, t, rfl⟩ + · intro r hr + simp + | cons d l ih => + obtain ⟨hed, htail⟩ := List.isChain_cons_cons.mp hc + obtain ⟨γ, hγ, hsum⟩ := ih d + (by simpa only [List.getLast?_cons_cons] using hlast) htail + let γ' : Path (target e) (target b) := + γ.cast hed rfl + refine ⟨(edge e).trans γ', ?_, ?_⟩ + · intro t + rw [Path.trans_apply] + split_ifs + · exact ⟨e, by simp, _, rfl⟩ + · obtain ⟨a, ha, s, hs⟩ := hγ _ + exact ⟨a, List.mem_cons_of_mem _ ha, s, hs⟩ + · intro r hr + have heAvoid : ∀ t, edge e t ≠ r := fun t => hr e (by simp) t + have hγAvoid : ∀ t, γ' t ≠ r := by + intro t + obtain ⟨a, ha, s, hs⟩ := hγ t + change γ t ≠ r + rw [hs] + exact hr a (List.mem_cons_of_mem _ ha) s + rw [P3821T1AngularIncrementLaws.2.1 _ _ _ _ (edge e) γ' heAvoid hγAvoid] + change P3821T1AngularIncrement (edge e).toContinuousMap r + + P3821T1AngularIncrement γ.toContinuousMap r = _ + rw [hsum r (fun a ha => hr a (List.mem_cons_of_mem _ ha))] + simp + +private theorem loop_of_edges : + (∀ (f : C(unitInterval, ℂ)), (f 0 = f 1) → (∃ g : C(Circle, ℂ), (∀ t : unitInterval, g + (Circle.exp (2 * Real.pi * (t : ℝ))) = f t) ∧ Set.range g ⊆ Set.range f)) → ((∀ + {E : Type}, ∀ (source : E → ℂ), ∀ (target : E → ℂ), ∀ (edge : ∀ e, Path (source e) + (target e)), ∀ (e : E), ∀ (b : E), ∀ (l : List E), ((e :: l).getLast? = some b) → + ((List.IsChain (fun a b => target a = source b) (e :: l)) → (∃ γ : Path (source e) + (target b), (∀ t, ∃ d ∈ e :: l, ∃ s, γ t = edge d s) ∧ (∀ r : ℂ, (∀ d ∈ e :: l, ∀ s, edge + d s ≠ r) → P3821T1AngularIncrement γ.toContinuousMap r = ((e :: l).map (fun d => + P3821T1AngularIncrement (edge d).toContinuousMap r)).sum)))) → (∀ {E : Type}, ∀ + [DecidableEq E], ∀ (source : E → ℂ), ∀ (target : E → ℂ), ∀ (edge : (e : E) → Path + (source + e) (target e)), ∀ (l : List E), l.Nodup → l ≠ [] → (∀ (e : E), ∀ (he : e ∈ l), target e = + source (l.next e he)) → ∃ (g : C(Circle, ℂ)), (∀ (z : Circle), ∃ e ∈ l, ∃ (t : + (↑unitInterval : Type)), (g : Circle → ℂ) z = (edge e : (↑unitInterval : Type) → ℂ) t) ∧ + ∀ (r : ℂ), (∀ e ∈ l, ∀ (t : (↑unitInterval : Type)), (edge e : (↑unitInterval : Type) → + ℂ) t ≠ r) → P3821T1LoopIndex g r = (List.map (fun (e : E) => P3821T1AngularIncrement + (edge e).toContinuousMap r) l).sum / ((2 : ℝ) * Real.pi))) := by + classical + intro loop_of_path concatenate_paths E typeclassInstance0 source target edge l hl hne hnext + have hchain : List.IsChain (fun a b => target a = source b) l := by + rw [List.isChain_iff_getElem] + intro i hi + have hn := hnext l[i] (List.getElem_mem (by omega)) + simpa only [List.next_getElem l hl i (by omega), Nat.mod_eq_of_lt hi] using hn + have hclose : target (l.getLast hne) = source (l.head hne) := by + have hn := hnext (l.getLast hne) (List.getLast_mem hne) + rwa [List.next_getLast_eq_head l hne hl] at hn + cases l with + | nil => exact (hne rfl).elim + | cons e l => + obtain ⟨γ, hγ, hsum⟩ := concatenate_paths source target edge e + ((e :: l).getLast hne) l + (List.getLast?_eq_getLast_of_ne_nil hne) hchain + have hclosed : γ.toContinuousMap 0 = γ.toContinuousMap 1 := by + simp only [Path.coe_toContinuousMap, Path.source, Path.target] + exact hclose.symm + obtain ⟨g, hg, hrange⟩ := loop_of_path γ.toContinuousMap hclosed + refine ⟨g, ?_, ?_⟩ + · intro z + obtain ⟨t, ht⟩ := hrange ⟨z, rfl⟩ + obtain ⟨d, hd, s, hs⟩ := hγ t + exact ⟨d, hd, s, ht.symm.trans hs⟩ + · intro r hr + unfold P3821T1LoopIndex + have hmaps : g.comp ⟨fun t : unitInterval => Circle.exp + (2 * Real.pi * (t : ℝ)), by fun_prop⟩ = γ.toContinuousMap := by + ext t + exact hg t + rw [hmaps, hsum r hr] + +private theorem cycles_of_perm : + ∀ {E : Type}, ∀ [Fintype E], ∀ [DecidableEq E], ∀ (σ : Equiv.Perm E), (∀ (e : E), (σ : E → E) + e ≠ e) → ∃ (n : ℕ) (l : Fin n → List E), (∀ (j : Fin n), (l j).Nodup ∧ l + j ≠ [] ∧ ∀ (e : E), ∀ (he : e ∈ l j), (l j).next e he = (σ : E → E) e) ∧ ∀ (f : E → ℝ), ∑ + j : Fin n, (List.map f (l j)).sum = ∑ e : E, f e := by + classical + intro E typeclassInstance0 typeclassInstance1 σ hσ + classical + let J := {c : Equiv.Perm E // c ∈ σ.cycleFactorsFinset} + have hnon (c : J) : c.val.support.Nonempty := + (Equiv.Perm.mem_cycleFactorsFinset_iff.mp c.property).1.nonempty_support + let base (c : J) : E := Classical.choose (hnon c) + have hb (c : J) : base c ∈ c.val.support := Classical.choose_spec (hnon c) + let L (c : J) : List E := σ.toList (base c) + have hcycle (c : J) : c.val = σ.cycleOf (base c) := + Equiv.Perm.cycle_is_cycleOf (hb c) c.property + have hL (c : J) : (L c).toFinset = c.val.support := by + ext e + simp only [L, List.mem_toFinset, Equiv.Perm.mem_toList_iff, + hcycle c, Equiv.Perm.mem_support_cycleOf_iff] + have hprop (c : J) : (L c).Nodup ∧ L c ≠ [] ∧ + ∀ e (he : e ∈ L c), (L c).next e he = σ e := by + refine ⟨σ.nodup_toList _, ?_, ?_⟩ + · exact fun hnil => (hσ (base c)) + (Equiv.Perm.notMem_support.mp (σ.toList_eq_nil_iff.mp hnil)) + · exact fun e he => σ.next_toList_eq_apply (base c) e he + have hcover : σ.cycleFactorsFinset.biUnion Equiv.Perm.support = Finset.univ := by + ext e + simp only [Finset.mem_biUnion, Finset.mem_univ, iff_true] + exact Equiv.Perm.mem_support_iff_mem_support_of_mem_cycleFactorsFinset.mp + (Equiv.Perm.mem_support.mpr (hσ e)) + have hdisj : (σ.cycleFactorsFinset : Set (Equiv.Perm E)).PairwiseDisjoint + Equiv.Perm.support := by + intro c hc d hd hcd + exact (σ.cycleFactorsFinset_pairwise_disjoint hc hd hcd).disjoint_support + have hsum (f : E → ℝ) : ∑ c : J, ((L c).map f).sum = ∑ e, f e := by + have hlist (l : List E) (hl : l.Nodup) : (l.map f).sum = ∑ e ∈ l.toFinset, f e := by + induction l with + | nil => simp + | cons e l ih => + simp only [List.nodup_cons] at hl + simp [List.toFinset_cons, ih hl.2, hl.1] + calc + ∑ c : J, ((L c).map f).sum = ∑ c : J, ∑ e ∈ c.val.support, f e := by + apply Finset.sum_congr rfl + intro c _ + rw [hlist _ (hprop c).1, hL c] + _ = ∑ c ∈ σ.cycleFactorsFinset, ∑ e ∈ c.support, f e := by + exact (Finset.sum_subtype σ.cycleFactorsFinset (fun _ => Iff.rfl) + (fun c => ∑ e ∈ c.support, f e)).symm + _ = ∑ e, f e := by rw [← Finset.sum_biUnion hdisj, hcover] + let eqv : Fin (Fintype.card J) ≃ J := (Fintype.equivFin J).symm + refine ⟨Fintype.card J, fun j => L (eqv j), fun j => hprop (eqv j), ?_⟩ + intro f + exact (Fintype.sum_equiv eqv _ _ (fun _ => rfl)).trans (hsum f) + +private theorem grid_boundary_sum : + let corner (u : GaussianInt) : Fin 4 → GaussianInt := + ![u, u + 1, u + 1 + ⟨0, 1⟩, u + ⟨0, 1⟩] + let neighbor (u : GaussianInt) : Fin 4 → GaussianInt := + ![u - ⟨0, 1⟩, u + 1, u + ⟨0, 1⟩, u - 1] + (∀ (u : GaussianInt), ∀ (k : Fin 4), neighbor (neighbor u k) (k + 2) = u ∧ corner (neighbor u + k) (k + 2) = corner u (k + 1) ∧ corner (neighbor u k) ((k + 2) + 1) = corner u k) → ((∀ + (u : GaussianInt), ∀ (k : Fin 4), FourNeighborAdjacent (corner u k) (corner u (k + + 1))) → + (∀ (D : Finset GaussianInt), ∀ (f : GaussianInt → GaussianInt → ℝ), (∀ (a : LatticeCell), + ∀ (b : LatticeCell), FourNeighborAdjacent a b → f b a = -f a b) → ∑ e : + { e : ↥D × Fin (4 : ℕ) // neighbor (↑e.1 : GaussianInt) e.2 ∉ D }, f (corner (↑(↑e : ↥D × + Fin (4 : ℕ)).1 : GaussianInt) (↑e : ↥D × Fin (4 : ℕ)).2) (corner (↑(↑e : ↥D × Fin (4 : + ℕ)).1 : GaussianInt) ((↑e : ↥D × Fin (4 : ℕ)).2 + (1 : Fin (4 : ℕ)))) = ∑ u ∈ D, (f u (u + + (1 : GaussianInt)) + f (u + (1 : GaussianInt)) (u + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : + ℤ)⟩) + f (u + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) (u + ⟨(0 : ℤ), (1 : ℤ)⟩) + f (u + + ⟨(0 : ℤ), (1 : ℤ)⟩) u))) := by + classical + intro corner neighbor dart_reverse dart_adjacent D f hanti + classical + let A := D × Fin 4 + let I := {e : A // neighbor e.1.val e.2 ∈ D} + let rev : I → I := fun e => + ⟨(⟨neighbor e.val.1.val e.val.2, e.property⟩, e.val.2 + 2), by + change neighbor (neighbor e.val.1.val e.val.2) (e.val.2 + 2) ∈ D + rw [(dart_reverse _ _).1] + exact e.val.1.property⟩ + have hrev : Function.Involutive rev := by + intro e + apply Subtype.ext + apply Prod.ext + · apply Subtype.ext + exact (dart_reverse _ _).1 + · change (e.val.2 + 2) + 2 = e.val.2 + have hk (k : Fin 4) : (k + 2) + 2 = k := by fin_cases k <;> rfl + exact hk _ + let ρ : Equiv.Perm I := ⟨rev, rev, hrev, hrev⟩ + let F : A → ℝ := fun e => f (corner e.1.val e.2) (corner e.1.val (e.2 + 1)) + have hantiI (e : I) : F (ρ e).val = -F e.val := by + change f (corner (neighbor e.val.1.val e.val.2) (e.val.2 + 2)) + (corner (neighbor e.val.1.val e.val.2) ((e.val.2 + 2) + 1)) = + -f (corner e.val.1.val e.val.2) (corner e.val.1.val (e.val.2 + 1)) + rw [(dart_reverse _ _).2.1, (dart_reverse _ _).2.2] + exact hanti _ _ (dart_adjacent _ _) + have hsumI : (∑ e : I, F e.val) = 0 := by + have heq := Fintype.sum_equiv ρ (fun e => F e.val) (fun e => -F e.val) + (fun e => by rw [hantiI, neg_neg]) + rw [Finset.sum_neg_distrib] at heq + linarith + have hsplit := Fintype.sum_subtype_add_sum_subtype + (fun e : A => neighbor e.1.val e.2 ∈ D) F + rw [hsumI, zero_add] at hsplit + change (∑ e : {e : A // neighbor e.1.val e.2 ∉ D}, F e.val) = _ + rw [hsplit, Fintype.sum_prod_type] + have hfour (u : GaussianInt) : + (∑ k : Fin 4, f (corner u k) (corner u (k + 1))) = + f u (u + 1) + f (u + 1) (u + 1 + ⟨0, 1⟩) + + f (u + 1 + ⟨0, 1⟩) (u + ⟨0, 1⟩) + f (u + ⟨0, 1⟩) u := by + simp [Fin.sum_univ_succ, corner, add_assoc] + simp only [F, hfour] + exact (Finset.sum_subtype D (fun _ => Iff.rfl) (fun u => + f u (u + 1) + f (u + 1) (u + 1 + ⟨0, 1⟩) + + f (u + 1 + ⟨0, 1⟩) (u + ⟨0, 1⟩) + f (u + ⟨0, 1⟩) u)).symm + +private theorem square_step : + let rayStep (r a b : GaussianInt) : ℤ := + if b = a + ⟨0, 1⟩ ∧ a.im = r.im ∧ a.re ≤ r.re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = r.im ∧ a.re ≤ r.re then -1 + else 0 + ∀ (r : GaussianInt), ∀ (u : GaussianInt), rayStep r u (u + (1 : GaussianInt)) + rayStep r (u + + (1 : GaussianInt)) (u + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) + rayStep r (u + (1 : + GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) (u + ⟨(0 : ℤ), (1 : ℤ)⟩) + rayStep r (u + ⟨(0 : ℤ), (1 + : ℤ)⟩) u = if u = r then (-1 : ℤ) else (0 : ℤ) := by + classical + intro rayStep r u + by_cases him : u.im = r.im + · by_cases hre : u.re = r.re + · have hue : u = r := Zsqrtd.ext hre him + simp [rayStep, Zsqrtd.ext_iff, hue] + · simp [rayStep, Zsqrtd.ext_iff, him, hre] + omega + · simp [rayStep, Zsqrtd.ext_iff, him] + omega + +private theorem square_increment : + (∀ (r : GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → + (P3821T1AngularIncrement (Path.segment (a : ℂ) (b : ℂ)).toContinuousMap (GridCellCenter + r) = (Complex.log ((b : ℂ) - GridCellCenter r)).im - (Complex.log ((a : ℂ) - + GridCellCenter r)).im - 2 * Real.pi * (if b = a + ⟨0, 1⟩ ∧ a.im = r.im ∧ a.re ≤ r.re then + (1 : ℤ) else if b = a - ⟨0, 1⟩ ∧ b.im = r.im ∧ a.re ≤ r.re then (-1 : ℤ) else 0))) → ( + let corner (u : GaussianInt) : Fin 4 → GaussianInt := + ![u, u + 1, u + 1 + ⟨0, 1⟩, u + ⟨0, 1⟩] + (∀ (u : GaussianInt), ∀ (k : Fin 4), FourNeighborAdjacent (corner u k) (corner u (k + 1))) → ( + let rayStep (r a b : GaussianInt) : ℤ := + if b = a + ⟨0, 1⟩ ∧ a.im = r.im ∧ a.re ≤ r.re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = r.im ∧ a.re ≤ r.re then -1 + else 0 + (∀ (r : GaussianInt), ∀ (u : GaussianInt), rayStep r u (u + 1) + rayStep r (u + 1) (u + 1 + + ⟨0, 1⟩) + rayStep r (u + 1 + ⟨0, 1⟩) (u + ⟨0, 1⟩) + rayStep r (u + ⟨0, 1⟩) u = if u = r + then -1 else 0) → (∀ (r : GaussianInt), ∀ (u : GaussianInt), ∑ k : Fin (4 : ℕ), + P3821T1AngularIncrement (Path.segment ((GaussianInt.toComplex : GaussianInt → ℂ) + (corner u k)) ((GaussianInt.toComplex : GaussianInt → ℂ) (corner u (k + (1 : Fin (4 : + ℕ)))))).toContinuousMap (GridCellCenter r) = (2 : ℝ) * Real.pi * if u = r then (1 : ℝ) + else (0 : ℝ)))) := by + classical + intro grid_edge_increment corner dart_adjacent rayStep square_step r u + let inc (a b : GaussianInt) := P3821T1AngularIncrement + (Path.segment (a : ℂ) (b : ℂ)).toContinuousMap (GridCellCenter r) + have hinc (a b : GaussianInt) (hab : FourNeighborAdjacent a b) : + inc a b = (Complex.log ((b : ℂ) - GridCellCenter r)).im - + (Complex.log ((a : ℂ) - GridCellCenter r)).im - 2 * Real.pi * (rayStep r a b : ℝ) := + grid_edge_increment r a b hab + have hfour : (∑ k : Fin 4, inc (corner u k) (corner u (k + 1))) = + inc u (u + 1) + inc (u + 1) (u + 1 + ⟨0, 1⟩) + + inc (u + 1 + ⟨0, 1⟩) (u + ⟨0, 1⟩) + inc (u + ⟨0, 1⟩) u := by + simp [Fin.sum_univ_succ, corner, add_assoc] + change (∑ k : Fin 4, inc (corner u k) (corner u (k + 1))) = _ + rw [hfour] + calc + _ = -(2 * Real.pi) * ((rayStep r u (u + 1) + + rayStep r (u + 1) (u + 1 + ⟨0, 1⟩) + + rayStep r (u + 1 + ⟨0, 1⟩) (u + ⟨0, 1⟩) + + rayStep r (u + ⟨0, 1⟩) u : ℤ) : ℝ) := by + have ha : FourNeighborAdjacent u (u + 1) := dart_adjacent u 0 + have hb : FourNeighborAdjacent (u + 1) (u + 1 + ⟨0, 1⟩) := dart_adjacent u 1 + have hc : FourNeighborAdjacent (u + 1 + ⟨0, 1⟩) (u + ⟨0, 1⟩) := dart_adjacent u 2 + have hd : FourNeighborAdjacent (u + ⟨0, 1⟩) u := dart_adjacent u 3 + rw [hinc _ _ ha, hinc _ _ hb, hinc _ _ hc, hinc _ _ hd] + push_cast + ring + _ = _ := by rw [square_step]; split_ifs <;> norm_num + +private theorem grid_contours : + (∀ (r : GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → + (∀ t : unitInterval, Path.segment (a : ℂ) (b : ℂ) t ≠ GridCellCenter r)) → ((∀ + {E : Type}, ∀ [DecidableEq E], ∀ (source : E → ℂ), ∀ (target : E → ℂ), ∀ (edge : ∀ e, + Path (source e) (target e)), ∀ (l : List E), (l.Nodup) → ((l ≠ []) → ((∀ e, ∀ (he : e ∈ + l), target e = source (l.next e he)) → (∃ g : C(Circle, ℂ), (∀ z, ∃ e ∈ l, ∃ t, g z = + edge e t) ∧ (∀ r : ℂ, (∀ e ∈ l, ∀ t, edge e t ≠ r) → P3821T1LoopIndex g r = (l.map (fun + e => P3821T1AngularIncrement (edge e).toContinuousMap r)).sum / (2 * Real.pi)))))) → + ((∀ {E : Type}, ∀ [Fintype E], ∀ [DecidableEq E], ∀ (σ : Equiv.Perm E), (∀ e, σ e ≠ e) → + (∃ n : ℕ, ∃ l : Fin n → List E, (∀ j, (l j).Nodup ∧ (l j) ≠ [] ∧ ∀ e, ∀ (he : e ∈ l j), + (l j).next e he = σ e) ∧ (∀ f : E → ℝ, ∑ j, ((l j).map f).sum = ∑ e, f e))) → ((∀ + {E : Type}, ∀ {V : Type}, ∀ [Fintype E], ∀ [DecidableEq E], ∀ [DecidableEq V], ∀ + (source : E → V), ∀ (target : E → V), (∀ v, Fintype.card {e // target e = v} = + Fintype.card + {e // source e = v}) → (∃ σ : Equiv.Perm E, ∀ e, source (σ e) = target e)) → ( + let corner (u : GaussianInt) : Fin 4 → GaussianInt := + ![u, u + 1, u + 1 + ⟨0, 1⟩, u + ⟨0, 1⟩] + let neighbor (u : GaussianInt) : Fin 4 → GaussianInt := + ![u - ⟨0, 1⟩, u + 1, u + ⟨0, 1⟩, u - 1] + (∀ (u : GaussianInt), ∀ (k : Fin 4), FourNeighborAdjacent (corner u k) (corner u (k + 1))) → + ((∀ (D : Finset GaussianInt), ∀ (f : GaussianInt → GaussianInt → ℝ), (∀ a, ∀ b, + FourNeighborAdjacent a b → f b a = -f a b) → ((∑ e : + {e : D × Fin 4 // neighbor e.1.val e.2 ∉ D}, f (corner e.val.1.val e.val.2) (corner + e.val.1.val (e.val.2 + 1))) = ∑ u ∈ D, (f u (u + 1) + f (u + 1) (u + 1 + ⟨0, 1⟩) + f (u + + 1 + ⟨0, 1⟩) (u + ⟨0, 1⟩) + f (u + ⟨0, 1⟩) u))) → ((∀ (r : GaussianInt), ∀ (u : + GaussianInt), (∑ k : Fin 4, P3821T1AngularIncrement (Path.segment (corner u k : ℂ) + (corner u (k + 1) : ℂ)).toContinuousMap (GridCellCenter r)) = 2 * Real.pi * (if u = r + then 1 else 0)) → (∀ (D : Finset GaussianInt), ∃ (n : ℕ) (g : Fin n → C(Circle, ℂ)), (∀ + (j : Fin n), ∀ (z : Circle), ∃ u ∈ D, ∃ (k : Fin (4 : ℕ)), neighbor u k ∉ D ∧ ∃ (t : + (↑unitInterval : Type)), (g j : Circle → ℂ) z = (Path.segment ((GaussianInt.toComplex : + GaussianInt → ℂ) (corner u k)) ((GaussianInt.toComplex : GaussianInt → ℂ) (corner u (k + + (1 : Fin (4 : ℕ))))) : (↑unitInterval : Type) → ℂ) t) ∧ ∀ (r : GaussianInt), ∑ j : Fin n, + P3821T1LoopIndex (g j) (GridCellCenter r) = if r ∈ D then (1 : ℝ) else (0 : ℝ)))))))) + := by + classical + intro grid_edge_avoids loop_of_edges cycles_of_perm balance_permutation corner neighbor + dart_adjacent grid_boundary_sum square_increment D + classical + let E := {e : D × Fin 4 // neighbor e.1.val e.2 ∉ D} + let src : E → GaussianInt := fun e => corner e.val.1.val e.val.2 + let dst : E → GaussianInt := fun e => corner e.val.1.val (e.val.2 + 1) + have hadj (e : E) : FourNeighborAdjacent (src e) (dst e) := dart_adjacent _ _ + have hneq (e : E) : src e ≠ dst e := by + have h := hadj e + rcases h with h | h | h | h <;> + rw [h] <;> simp [Zsqrtd.ext_iff] <;> omega + have hbalance (v : GaussianInt) : + Fintype.card {e : E // dst e = v} = Fintype.card {e : E // src e = v} := by + let f (a b : GaussianInt) : ℝ := (if a = v then 1 else 0) - (if b = v then 1 else 0) + have hs := grid_boundary_sum D f (fun a b _ => by dsimp [f]; ring) + have hzero : (∑ u ∈ D, (f u (u + 1) + f (u + 1) (u + 1 + ⟨0, 1⟩) + + f (u + 1 + ⟨0, 1⟩) (u + ⟨0, 1⟩) + f (u + ⟨0, 1⟩) u)) = 0 := by + apply Finset.sum_eq_zero + intro u hu + dsimp [f] + ring + rw [hzero] at hs + change (∑ e : E, ((if src e = v then (1 : ℝ) else 0) - + (if dst e = v then 1 else 0))) = 0 at hs + rw [Finset.sum_sub_distrib, Finset.sum_boole, Finset.sum_boole] at hs + rw [Fintype.card_subtype, Fintype.card_subtype] + exact_mod_cast (by linarith [hs] : + ((Finset.univ.filter (fun e : E => dst e = v)).card : ℝ) = + (Finset.univ.filter (fun e : E => src e = v)).card) + obtain ⟨σ, hσ⟩ := balance_permutation src dst hbalance + have hσne (e : E) : σ e ≠ e := by + intro h + apply hneq e + simpa [h] using hσ e + obtain ⟨n, l, hl, hsum⟩ := cycles_of_perm σ hσne + let edge (e : E) : Path (src e : ℂ) (dst e : ℂ) := Path.segment _ _ + have hex (j : Fin n) : + ∃ g : C(Circle, ℂ), + (∀ z, ∃ e ∈ l j, ∃ t, g z = edge e t) ∧ + (∀ r : ℂ, (∀ e ∈ l j, ∀ t, edge e t ≠ r) → + P3821T1LoopIndex g r = ((l j).map (fun e => + P3821T1AngularIncrement (edge e).toContinuousMap r)).sum / + (2 * Real.pi)) := by + apply loop_of_edges (fun e => (src e : ℂ)) (fun e => (dst e : ℂ)) edge + (l j) (hl j).1 (hl j).2.1 + intro e he + rw [(hl j).2.2 e he] + exact congrArg GaussianInt.toComplex (hσ e).symm + choose g hg hi using hex + refine ⟨n, g, ?_, ?_⟩ + · intro j z + obtain ⟨e, he, t, ht⟩ := hg j z + exact ⟨e.val.1.val, e.val.1.property, e.val.2, e.property, t, ht⟩ + · intro r + let inc (a b : GaussianInt) := P3821T1AngularIncrement + (Path.segment (a : ℂ) (b : ℂ)).toContinuousMap (GridCellCenter r) + have hindices (j : Fin n) : + P3821T1LoopIndex (g j) (GridCellCenter r) = + ((l j).map (fun e => inc (src e) (dst e))).sum / (2 * Real.pi) := + hi j _ (fun e _ => grid_edge_avoids r _ _ (hadj e)) + have hanti (a b : GaussianInt) (hab : FourNeighborAdjacent a b) : + inc b a = -inc a b := by + have hh := P3821T1AngularIncrementLaws.2.2 (a : ℂ) (b : ℂ) + (GridCellCenter r) (Path.segment _ _) (grid_edge_avoids r a b hab) + simpa only [inc, Path.segment_symm] using hh + have hledger := grid_boundary_sum D inc hanti + have hsquare (u : GaussianInt) : + inc u (u + 1) + inc (u + 1) (u + 1 + ⟨0, 1⟩) + + inc (u + 1 + ⟨0, 1⟩) (u + ⟨0, 1⟩) + inc (u + ⟨0, 1⟩) u = + 2 * Real.pi * (if u = r then 1 else 0) := by + have h := square_increment r u + simpa only [Fin.sum_univ_four, corner, Matrix.cons_val, + Fin.reduceFinMk, Fin.reduceAdd] using h + calc + ∑ j, P3821T1LoopIndex (g j) (GridCellCenter r) = + (∑ e : E, inc (src e) (dst e)) / (2 * Real.pi) := by + simp only [hindices, ← Finset.sum_div] + rw [hsum] + _ = (∑ u ∈ D, 2 * Real.pi * (if u = r then 1 else 0)) / + (2 * Real.pi) := by + rw [hledger] + congr 1 + apply Finset.sum_congr rfl + exact fun u _ => hsquare u + _ = if r ∈ D then 1 else 0 := by + simp only [mul_ite, mul_one, mul_zero, Finset.sum_ite_eq'] + split_ifs <;> simp [Real.pi_ne_zero] + +private theorem box_dist : + let box (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) ≤ z.re ∧ z.re ≤ (u.re : ℝ) + 1 ∧ + (u.im : ℝ) ≤ z.im ∧ z.im ≤ (u.im : ℝ) + 1 + (∀ (u : GaussianInt), (GridCellCenter u).re = (u.re : ℝ) + 1 / 2) → ((∀ (u : GaussianInt), + (GridCellCenter u).im = (u.im : ℝ) + 1 / 2) → (∀ (u : GaussianInt), ∀ (z : ℂ), box u z → + ‖z - GridCellCenter u‖ ≤ (1 : ℝ))) := by + classical + intro box center_re center_im u z hz + have hr : |(z - GridCellCenter u).re| ≤ 1 / 2 := by + rw [Complex.sub_re, center_re, abs_le] + dsimp [box] at hz + constructor <;> linarith [hz.1, hz.2.1] + have hi : |(z - GridCellCenter u).im| ≤ 1 / 2 := by + rw [Complex.sub_im, center_im, abs_le] + dsimp [box] at hz + constructor <;> linarith [hz.2.2.1, hz.2.2.2] + exact (Complex.norm_le_abs_re_add_abs_im _).trans (by linarith) + +private theorem edge_box : + let corner (u : GaussianInt) : Fin 4 → GaussianInt := + ![u, u + 1, u + 1 + ⟨0, 1⟩, u + ⟨0, 1⟩] + let neighbor (u : GaussianInt) : Fin 4 → GaussianInt := + ![u - ⟨0, 1⟩, u + 1, u + ⟨0, 1⟩, u - 1] + let box (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) ≤ z.re ∧ z.re ≤ (u.re : ℝ) + 1 ∧ + (u.im : ℝ) ≤ z.im ∧ z.im ≤ (u.im : ℝ) + 1 + ∀ (u : GaussianInt), ∀ (k : Fin (4 : ℕ)), ∀ (t : (↑unitInterval : Type)), box u + ((Path.segment ((GaussianInt.toComplex : GaussianInt → ℂ) (corner u k)) + ((GaussianInt.toComplex : GaussianInt → ℂ) (corner u (k + (1 : Fin (4 : ℕ))))) : + (↑unitInterval : Type) → ℂ) t) ∧ box (neighbor u k) ((Path.segment + ((GaussianInt.toComplex : GaussianInt → ℂ) (corner u k)) ((GaussianInt.toComplex : + GaussianInt → ℂ) (corner u (k + (1 : Fin (4 : ℕ))))) : (↑unitInterval : Type) → ℂ) t) := by + classical + intro corner neighbor box u k t + change box u ((t : ℝ) • ((corner u (k + 1) : ℂ) - (corner u k : ℂ)) + (corner u k : ℂ)) ∧ + box (neighbor u k) ((t : ℝ) • ((corner u (k + 1) : ℂ) - (corner u k : ℂ)) + (corner u k : ℂ)) + fin_cases k <;> + simp only [corner, neighbor, Fin.reduceFinMk, Fin.reduceAdd, Matrix.cons_val, + box, Complex.real_smul, Complex.add_re, Complex.sub_re, + Complex.mul_re, Complex.add_im, Complex.sub_im, Complex.mul_im, + Complex.ofReal_re, Complex.ofReal_im, zero_mul, add_zero, sub_zero, + ← GaussianInt.intCast_re, ← GaussianInt.intCast_im, Zsqrtd.re_add, + Zsqrtd.im_add, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, + Int.cast_add, Int.cast_sub, Int.cast_one] + all_goals repeat' apply And.intro + all_goals nlinarith [t.2.1, t.2.2] + +private theorem shift_exists : + ∀ (a : ℝ), ∀ (b : ℝ), ∃ (s : ℝ), (0 : ℝ) < s ∧ s < (1 : ℝ) ∧ (∀ (n : ℤ), a - s ≠ (↑n : ℝ)) ∧ + ∀ (n : ℤ), b - s ≠ (↑n : ℝ) := by + classical + intro a b + obtain ⟨s, hs, hnot⟩ := (Set.Ioo_infinite (by norm_num : (0 : ℝ) < 1)).exists_notMem_finset + ({Int.fract a, Int.fract b} : Finset ℝ) + simp only [Finset.mem_insert, Finset.mem_singleton, not_or] at hnot + refine ⟨s, hs.1, hs.2, ?_, ?_⟩ + · intro n hn + exact hnot.1 (Int.fract_eq_iff.mpr ⟨hs.1.le, hs.2, n, hn⟩).symm + · intro n hn + exact hnot.2 (Int.fract_eq_iff.mpr ⟨hs.1.le, hs.2, n, hn⟩).symm + +private theorem segment_hits : + ∀ (K : Set ℂ), ∀ (p : ℂ), ∀ (a : ℂ), ∀ (b : ℂ), a ∈ connectedComponentIn Kᶜ p → b ∉ + connectedComponentIn Kᶜ p → ∃ (t : (↑unitInterval : Type)), (Path.segment a b : + (↑unitInterval : Type) → ℂ) t ∈ K := by + classical + intro K p a b ha hb + by_contra h + have hav : Set.range (Path.segment a b) ⊆ Kᶜ := by + rintro z ⟨t, rfl⟩ + exact fun hz => h ⟨t, hz⟩ + have hcomp := (isPreconnected_range (Path.segment a b).continuous).subset_connectedComponentIn + (Path.segment a b).source_mem_range hav + have hbm : b ∈ connectedComponentIn Kᶜ a := hcomp (Path.segment a b).target_mem_range + rw [← connectedComponentIn_eq ha] at hbm + exact hb hbm + +private theorem finite_centers : + (∀ (u : GaussianInt), (GridCellCenter u).re = (u.re : ℝ) + 1 / 2) → ((∀ (u : GaussianInt), + (GridCellCenter u).im = (u.im : ℝ) + 1 / 2) → (∀ (U : Set ℂ), Bornology.IsBounded U → ∀ + (h : ℝ), (0 : ℝ) < h → ∀ (o : ℂ), {u : GaussianInt | (↑h : ℂ) * GridCellCenter u + o ∈ + U}.Finite)) := by + classical + intro center_re center_im U hU h hh o + obtain ⟨R, hR⟩ := hU.exists_norm_le + obtain ⟨M, hM⟩ := exists_nat_gt ((R + ‖o‖) / h + 1) + let B : Set (ℤ × ℤ) := Set.Icc (-(M : ℤ)) M ×ˢ Set.Icc (-(M : ℤ)) M + have hB : B.Finite := (Set.finite_Icc _ _).prod (Set.finite_Icc _ _) + have hinj : Function.Injective (fun u : GaussianInt => (u.re, u.im)) := by + intro a b he + exact Zsqrtd.ext (congrArg Prod.fst he) (congrArg Prod.snd he) + apply (hB.preimage hinj.injOn).subset + intro u hu + have hnorm : h * ‖GridCellCenter u‖ ≤ R + ‖o‖ := by + have hhNorm : ‖(h : ℂ)‖ = h := by rw [Complex.norm_real, Real.norm_eq_abs, abs_of_pos hh] + calc + h * ‖GridCellCenter u‖ = ‖(h : ℂ) * GridCellCenter u‖ := by rw [norm_mul, hhNorm] + _ = ‖((h : ℂ) * GridCellCenter u + o) - o‖ := by congr 1; ring + _ ≤ ‖(h : ℂ) * GridCellCenter u + o‖ + ‖o‖ := norm_sub_le _ _ + _ ≤ R + ‖o‖ := by linarith [hR _ hu] + have hnormM : ‖GridCellCenter u‖ + 1 < M := by + have hl : ‖GridCellCenter u‖ ≤ (R + ‖o‖) / h := + (le_div_iff₀ hh).mpr (by nlinarith [hnorm]) + linarith + have hr := abs_le.mp (Complex.abs_re_le_norm (GridCellCenter u)) + have hi := abs_le.mp (Complex.abs_im_le_norm (GridCellCenter u)) + rw [center_re] at hr + rw [center_im] at hi + change (-(M : ℤ) ≤ u.re ∧ u.re ≤ M) ∧ (-(M : ℤ) ≤ u.im ∧ u.im ≤ M) + have hbounds : (-(M : ℝ) ≤ (u.re : ℝ) ∧ (u.re : ℝ) ≤ M) ∧ + (-(M : ℝ) ≤ (u.im : ℝ) ∧ (u.im : ℝ) ≤ M) := by + constructor <;> constructor <;> linarith [hr.1, hr.2, hi.1, hi.2] + exact_mod_cast hbounds + +private theorem hrp : + ∀ (p : ℂ), ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + (0 < h) → (∀ (s : ℝ), (∀ (n : ℤ), p.re / h - s ≠ (↑n : ℝ)) → (∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + let rp : ℂ := (p - o) / (h : ℂ) + ∀ n : ℤ, rp.re ≠ n)) := by + classical + intro p η εp εq h hh s hspr t o rp n hn + have : p.re / h - s = n := by + dsimp [rp, o] at hn ⊢ + simp only [Complex.div_re, Complex.sub_re, Complex.add_re, Complex.mul_re, + Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, + mul_zero, zero_mul, sub_zero, add_zero] at hn + simp only [Complex.normSq_ofReal] at hn + field_simp [ne_of_gt hh] at hn ⊢ + nlinarith + exact hspr n this + +private theorem hip : + ∀ (p : ℂ), ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + (0 < h) → (∀ (s : ℝ), ∀ (t : ℝ), (∀ (n : ℤ), p.im / h - t ≠ (↑n : ℝ)) → ( + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + let rp : ℂ := (p - o) / (h : ℂ) + ∀ n : ℤ, rp.im ≠ n)) := by + classical + intro p η εp εq h hh s t htsp o rp n hn + have : p.im / h - t = n := by + dsimp [rp, o] at hn ⊢ + simp only [Complex.div_im, Complex.sub_im, Complex.add_im, Complex.mul_im, + Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, + mul_zero, add_zero] at hn + simp only [Complex.normSq_ofReal] at hn + field_simp [ne_of_gt hh] at hn ⊢ + nlinarith + exact htsp n this + +private theorem hrq : + ∀ (q : ℂ), ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + (0 < h) → (∀ (s : ℝ), (∀ (n : ℤ), q.re / h - s ≠ (↑n : ℝ)) → (∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + let rq : ℂ := (q - o) / (h : ℂ) + ∀ n : ℤ, rq.re ≠ n)) := by + classical + intro q η εp εq h hh s hspq t o rq n hn + have : q.re / h - s = n := by + dsimp [rq, o] at hn ⊢ + simp only [Complex.div_re, Complex.sub_re, Complex.add_re, Complex.mul_re, + Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, + mul_zero, zero_mul, sub_zero, add_zero] at hn + simp only [Complex.normSq_ofReal] at hn + field_simp [ne_of_gt hh] at hn ⊢ + nlinarith + exact hspq n this + +private theorem hiq : + ∀ (q : ℂ), ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + (0 < h) → (∀ (s : ℝ), ∀ (t : ℝ), (∀ (n : ℤ), q.im / h - t ≠ (↑n : ℝ)) → ( + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + let rq : ℂ := (q - o) / (h : ℂ) + ∀ n : ℤ, rq.im ≠ n)) := by + classical + intro q η εp εq h hh s t htq o rq n hn + have : q.im / h - t = n := by + dsimp [rq, o] at hn ⊢ + simp only [Complex.div_im, Complex.sub_im, Complex.add_im, Complex.mul_im, + Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, + mul_zero, add_zero] at hn + simp only [Complex.normSq_ofReal] at hn + field_simp [ne_of_gt hh] at hn ⊢ + nlinarith + exact htq n this + +private theorem hpclose : + ∀ (p : ℂ), + let openbox (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) < z.re ∧ z.re < (u.re : ℝ) + 1 ∧ + (u.im : ℝ) < z.im ∧ z.im < (u.im : ℝ) + 1 + ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + (0 < h) → (∀ (s : ℝ), ∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + let rp : ℂ := (p - o) / (h : ℂ) + ∀ (up : GaussianInt), (openbox up rp) → ((∀ (u : GaussianInt), ∀ (z : ℂ), (openbox u z) → (‖z + - GridCellCenter u‖ ≤ 1)) → (‖p - ((h : ℂ) * GridCellCenter up + o)‖ ≤ h))) := by + classical + intro p openbox η εp εq h hh s t o rp up hup close_in_cell + have hp_eq : p = (h : ℂ) * rp + o := by + dsimp [rp] + rw [mul_div_cancel₀ (p - o) (by exact_mod_cast hh.ne')] + ring + have heq : p - ((h : ℂ) * GridCellCenter up + o) = + (h : ℂ) * (rp - GridCellCenter up) := by rw [hp_eq]; ring + rw [heq, norm_mul] + have hnorm : ‖(h : ℂ)‖ = h := by rw [Complex.norm_real, Real.norm_eq_abs, abs_of_pos hh] + rw [hnorm] + calc + h * ‖rp - GridCellCenter up‖ ≤ h * 1 := mul_le_mul_of_nonneg_left + (close_in_cell up rp hup) hh.le + _ = h := mul_one h + +private theorem hqclose : + ∀ (q : ℂ), + let openbox (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) < z.re ∧ z.re < (u.re : ℝ) + 1 ∧ + (u.im : ℝ) < z.im ∧ z.im < (u.im : ℝ) + 1 + ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + (0 < h) → (∀ (s : ℝ), ∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + let rq : ℂ := (q - o) / (h : ℂ) + ∀ (uq : GaussianInt), (openbox uq rq) → ((∀ (u : GaussianInt), ∀ (z : ℂ), (openbox u z) → (‖z + - GridCellCenter u‖ ≤ 1)) → (‖q - ((h : ℂ) * GridCellCenter uq + o)‖ ≤ h))) := by + classical + intro q openbox η εp εq h hh s t o rq uq huq close_in_cell + have hq_eq : q = (h : ℂ) * rq + o := by + dsimp [rq] + rw [mul_div_cancel₀ (q - o) (by exact_mod_cast hh.ne')] + ring + have heq : q - ((h : ℂ) * GridCellCenter uq + o) = + (h : ℂ) * (rq - GridCellCenter uq) := by rw [hq_eq]; ring + rw [heq, norm_mul] + have hnorm : ‖(h : ℂ)‖ = h := by rw [Complex.norm_real, Real.norm_eq_abs, abs_of_pos hh] + rw [hnorm] + calc + h * ‖rq - GridCellCenter uq‖ ≤ h * 1 := mul_le_mul_of_nonneg_left + (close_in_cell uq rq huq) hh.le + _ = h := mul_one h + +private theorem hpcenter_comp : + ∀ (K : Set ℂ), (∀ (p : ℂ), ∀ (η : ℝ), ∀ (εp : ℝ), (Metric.ball p εp ⊆ Kᶜ) → (∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + (h < εp) → (∀ (s : ℝ), ∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + ∀ (up : GaussianInt), (‖p - ((h : ℂ) * GridCellCenter up + o)‖ ≤ h) → ((∀ (a : ℂ), ∀ (b : ℂ), + (‖b - a‖ ≤ h) → (∀ (v : unitInterval), ∀ (ε : ℝ), (h < ε) → (‖Path.segment a b v - a‖ < + ε))) → ((h : ℂ) * GridCellCenter up + o ∈ connectedComponentIn Kᶜ p))))) := by + classical + intro K p η εp hballp εq h h2p s t o up hpclose segment_ball + have hpath : Set.range (Path.segment p ((h : ℂ) * GridCellCenter up + o)) ⊆ Kᶜ := by + rintro z ⟨v, rfl⟩ + have hreal : (v : ℝ) ∈ Set.Icc 0 1 := v.2 + apply hballp + apply Metric.mem_ball.mpr + rw [dist_eq_norm] + exact segment_ball p ((h : ℂ) * GridCellCenter up + o) + (by simpa [norm_sub_rev] using hpclose) v εp h2p + have hc := (isPreconnected_range (Path.segment p ((h : ℂ) * GridCellCenter up + + o)).continuous).subset_connectedComponentIn + (Path.segment p _).source_mem_range hpath + exact hc (Path.segment p _).target_mem_range + +private theorem hqcenter_comp : + ∀ (K : Set ℂ), (∀ (q : ℂ), ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), (Metric.ball q εq ⊆ Kᶜ) → ( + let h : ℝ := min η (min εp εq) / 10 + (h < εq) → (∀ (s : ℝ), ∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + ∀ (uq : GaussianInt), (‖q - ((h : ℂ) * GridCellCenter uq + o)‖ ≤ h) → ((∀ (a : ℂ), ∀ (b : ℂ), + (‖b - a‖ ≤ h) → (∀ (v : unitInterval), ∀ (ε : ℝ), (h < ε) → (‖Path.segment a b v - a‖ < + ε))) → ((h : ℂ) * GridCellCenter uq + o ∈ connectedComponentIn Kᶜ q))))) := by + classical + intro K q η εp εq hballq h h2q s t o uq hqclose segment_ball + have hpath : Set.range (Path.segment q ((h : ℂ) * GridCellCenter uq + o)) ⊆ Kᶜ := by + rintro z ⟨v, rfl⟩ + have hreal : (v : ℝ) ∈ Set.Icc 0 1 := v.2 + apply hballq + apply Metric.mem_ball.mpr + rw [dist_eq_norm] + exact segment_ball q ((h : ℂ) * GridCellCenter uq + o) + (by simpa [norm_sub_rev] using hqclose) v εq h2q + have hc := (isPreconnected_range (Path.segment q ((h : ℂ) * GridCellCenter uq + + o)).continuous).subset_connectedComponentIn + (Path.segment q _).source_mem_range hpath + exact hc (Path.segment q _).target_mem_range + +private theorem similarity_index : + ∀ (a : ℝ), (0 < a) → (∀ (c : ℂ), ∀ (r : ℂ), ∀ (f : C(Circle, ℂ)), (∀ z, f z ≠ r) → + (P3821T1LoopIndex ⟨fun z => (a : ℂ) * f z + c, (continuous_const.mul f.continuous).add + continuous_const⟩ ((a : ℂ) * r + c) = P3821T1LoopIndex f r)) := by + classical + intro a ha c r f hf + let q₀ : C(unitInterval, Circle) := + ⟨fun v => Circle.exp (2 * Real.pi * (v : ℝ)), by fun_prop⟩ + let f₀ : C(unitInterval, ℂ) := f.comp q₀ + let f₁ : C(unitInterval, ℂ) := + (⟨fun z => (a : ℂ) * f z + c, (continuous_const.mul f.continuous).add continuous_const⟩ : + C(Circle, ℂ)).comp q₀ + have hf₀ : ∀ v, f₀ v ≠ r := fun v => hf (q₀ v) + obtain ⟨θ, hθ, hθind, _⟩ := P3821T1AngularIncrementLaws.1 f₀ r hf₀ + have hav : ∀ v, f₁ v ≠ (a : ℂ) * r + c := by + intro v hv + have heq : f₁ v - ((a : ℂ) * r + c) = (a : ℂ) * (f₀ v - r) := by + dsimp [f₀, f₁] + ring + rw [hv] at heq + have heq' : (a : ℂ) * (f₀ v - r) = 0 := by simpa using heq.symm + have : (a : ℂ) = 0 ∨ f₀ v - r = 0 := mul_eq_zero.mp heq' + rcases this with hzero | hzero + · exact (Complex.ofReal_ne_zero.mpr ha.ne') hzero + · exact hf₀ v (sub_eq_zero.mp hzero) + have haNorm : ‖(a : ℂ)‖ = a := by + rw [Complex.norm_real, Real.norm_eq_abs, abs_of_pos ha] + have hlift : ∀ v, Complex.exp ((θ v : ℂ) * Complex.I) = + (f₁ v - ((a : ℂ) * r + c)) / + (‖f₁ v - ((a : ℂ) * r + c)‖ : ℂ) := by + intro v + have hvec : f₁ v - ((a : ℂ) * r + c) = (a : ℂ) * (f₀ v - r) := by + dsimp [f₀, f₁] + ring + rw [hvec, norm_mul, haNorm] + have hnorm : ‖f₀ v - r‖ ≠ 0 := norm_ne_zero_iff.mpr (sub_ne_zero.mpr (hf₀ v)) + have hrat : + (a : ℂ) * (f₀ v - r) / ((a * ‖f₀ v - r‖ : ℝ) : ℂ) = + (f₀ v - r) / (‖f₀ v - r‖ : ℂ) := by + field_simp [ne_of_gt ha, hnorm] + push_cast + ring + rw [hrat] + exact hθ v + obtain ⟨_, _, hθ₁ind, _⟩ := P3821T1AngularIncrementLaws.1 f₁ ((a : ℂ) * r + c) hav + change P3821T1AngularIncrement f₁ ((a : ℂ) * r + c) / (2 * Real.pi) = + P3821T1AngularIncrement f₀ r / (2 * Real.pi) + rw [← hθ₁ind θ hlift, ← hθind θ hθ] + +private theorem edge_not_openbox : + let corner (u : GaussianInt) : Fin 4 → GaussianInt := + ![u, u + 1, u + 1 + ⟨0, 1⟩, u + ⟨0, 1⟩] + let openbox (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) < z.re ∧ z.re < (u.re : ℝ) + 1 ∧ + (u.im : ℝ) < z.im ∧ z.im < (u.im : ℝ) + 1 + (∀ (a : ℂ), ∀ (b : ℂ), ∀ (t : unitInterval), (Path.segment a b t).re = (1 - (t : ℝ)) * a.re + + (t : ℝ) * b.re) → ((∀ (a : ℂ), ∀ (b : ℂ), ∀ (t : unitInterval), (Path.segment a b t).im = + (1 - (t : ℝ)) * a.im + (t : ℝ) * b.im) → (∀ (a : GaussianInt), ∀ (k : Fin (4 : ℕ)), ∀ (v + : GaussianInt), ∀ (t₀ : (↑unitInterval : Type)), openbox v ((Path.segment + ((GaussianInt.toComplex : GaussianInt → ℂ) (corner a k)) ((GaussianInt.toComplex : + GaussianInt → ℂ) (corner a (k + (1 : Fin (4 : ℕ))))) : (↑unitInterval : Type) → ℂ) t₀) → + False)) := by + classical + intro corner openbox segment_re segment_im a k v t₀ hv + change (v.re : ℝ) < _ ∧ _ < (v.re : ℝ) + 1 ∧ + (v.im : ℝ) < _ ∧ _ < (v.im : ℝ) + 1 at hv + fin_cases k + · have h1 : (v.im : ℝ) < (a.im : ℝ) := by + have hx := hv.2.2.1 + rw [segment_im] at hx + simp? [corner] at hx + rw [← GaussianInt.intCast_im v, ← GaussianInt.intCast_im a] at hx + nlinarith [t₀.2.1, t₀.2.2] + have h2 : (a.im : ℝ) < (v.im : ℝ) + 1 := by + have hx := hv.2.2.2 + rw [segment_im] at hx + simp? [corner] at hx + rw [← GaussianInt.intCast_im a, ← GaussianInt.intCast_im v] at hx + nlinarith [t₀.2.1, t₀.2.2] + have h1' : v.im < a.im := by exact_mod_cast h1 + have h2' : a.im < v.im + 1 := by exact_mod_cast h2 + omega + · have h1 : (v.re : ℝ) < (a.re : ℝ) + 1 := by + have hx := hv.1 + rw [segment_re] at hx + simp? [corner] at hx + rw [← GaussianInt.intCast_re v, ← GaussianInt.intCast_re a] at hx + nlinarith [t₀.2.1, t₀.2.2] + have h2 : (a.re : ℝ) + 1 < (v.re : ℝ) + 1 := by + have hx := hv.2.1 + rw [segment_re] at hx + simp? [corner] at hx + rw [← GaussianInt.intCast_re a, ← GaussianInt.intCast_re v] at hx + nlinarith [t₀.2.1, t₀.2.2] + have h1' : v.re < a.re + 1 := by exact_mod_cast h1 + have h2' : a.re + 1 < v.re + 1 := by exact_mod_cast h2 + omega + · have h1 : (v.im : ℝ) < (a.im : ℝ) + 1 := by + have hx := hv.2.2.1 + rw [segment_im] at hx + simp? [corner] at hx + rw [← GaussianInt.intCast_im v, ← GaussianInt.intCast_im a] at hx + nlinarith [t₀.2.1, t₀.2.2] + have h2 : (a.im : ℝ) + 1 < (v.im : ℝ) + 1 := by + have hx := hv.2.2.2 + rw [segment_im] at hx + simp? [corner] at hx + rw [← GaussianInt.intCast_im a, ← GaussianInt.intCast_im v] at hx + nlinarith [t₀.2.1, t₀.2.2] + have h1' : v.im < a.im + 1 := by exact_mod_cast h1 + have h2' : a.im + 1 < v.im + 1 := by exact_mod_cast h2 + omega + · have h1 : (v.re : ℝ) < (a.re : ℝ) := by + have hx := hv.1 + rw [segment_re] at hx + simp? [corner] at hx + rw [← GaussianInt.intCast_re v, ← GaussianInt.intCast_re a] at hx + nlinarith [t₀.2.1, t₀.2.2] + have h2 : (a.re : ℝ) < (v.re : ℝ) + 1 := by + have hx := hv.2.1 + rw [segment_re] at hx + simp? [corner] at hx + rw [← GaussianInt.intCast_re a, ← GaussianInt.intCast_re v] at hx + nlinarith [t₀.2.1, t₀.2.2] + have h1' : v.re < a.re := by exact_mod_cast h1 + have h2' : a.re < v.re + 1 := by exact_mod_cast h2 + omega + +private theorem open_convex_bounds : + ∀ (x : ℝ), ∀ (y : ℝ), ∀ (lo : ℝ), ∀ (hi : ℝ), ∀ (s : ℝ), lo < x → lo < y → x < hi → y < hi → + (0 : ℝ) ≤ s → s ≤ (1 : ℝ) → lo < ((1 : ℝ) - s) * x + s * y ∧ ((1 : ℝ) - s) * x + s * y < + hi := by + classical + intro x y lo hi s hxlo hylo hxhi hyhi hs0 hs1 + constructor + · by_cases hs : s = 0 + · simpa [hs] using hxlo + · by_cases hs' : s = 1 + · simpa [hs'] using hylo + · have hspos : 0 < s := lt_of_le_of_ne hs0 (Ne.symm hs) + have hslt : s < 1 := lt_of_le_of_ne hs1 hs' + have h1pos : 0 < 1 - s := sub_pos.mpr hslt + have hleft := mul_pos h1pos (sub_pos.mpr hxlo) + have hright := mul_pos hspos (sub_pos.mpr hylo) + have hsum := add_pos hleft hright + have heq : (1 - s) * x + s * y - lo = (1 - s) * (x - lo) + s * (y - lo) := by ring + have hpositive : 0 < (1 - s) * x + s * y - lo := by rw [heq]; exact hsum + linarith + · by_cases hs : s = 0 + · simpa [hs] using hxhi + · by_cases hs' : s = 1 + · simpa [hs'] using hyhi + · have hspos : 0 < s := lt_of_le_of_ne hs0 (Ne.symm hs) + have hslt : s < 1 := lt_of_le_of_ne hs1 hs' + have h1pos : 0 < 1 - s := sub_pos.mpr hslt + have hleft := mul_pos h1pos (sub_pos.mpr hxhi) + have hright := mul_pos hspos (sub_pos.mpr hyhi) + have hsum := add_pos hleft hright + have heq : hi - ((1 - s) * x + s * y) = + (1 - s) * (hi - x) + s * (hi - y) := by ring + have hpositive : 0 < hi - ((1 - s) * x + s * y) := by rw [heq]; exact hsum + linarith + +private theorem open_segment : + let openbox (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) < z.re ∧ z.re < (u.re : ℝ) + 1 ∧ + (u.im : ℝ) < z.im ∧ z.im < (u.im : ℝ) + 1 + (∀ (u : GaussianInt), (GridCellCenter u).re = (u.re : ℝ) + 1 / 2) → ((∀ (u : GaussianInt), + (GridCellCenter u).im = (u.im : ℝ) + 1 / 2) → ((∀ (a : ℂ), ∀ (b : ℂ), ∀ (t : + unitInterval), (Path.segment a b t).re = (1 - (t : ℝ)) * a.re + (t : ℝ) * b.re) → ((∀ (a + : ℂ), ∀ (b : ℂ), ∀ (t : unitInterval), (Path.segment a b t).im = (1 - (t : ℝ)) * a.im + + (t : ℝ) * b.im) → ((∀ (u : GaussianInt), openbox u (GridCellCenter u)) → ((∀ (x : ℝ), ∀ + (y : ℝ), ∀ (lo : ℝ), ∀ (hi : ℝ), ∀ (s : ℝ), (lo < x) → ((lo < y) → ((x < hi) → ((y < hi) + → ((0 ≤ s) → ((s ≤ 1) → (lo < (1 - s) * x + s * y ∧ (1 - s) * x + s * y < hi))))))) → (∀ + (u : GaussianInt), ∀ (r : ℂ), openbox u r → ∀ (v : (↑unitInterval : Type)), openbox u + ((Path.segment r (GridCellCenter u) : (↑unitInterval : Type) → ℂ) v))))))) := by + classical + intro openbox center_re center_im segment_re segment_im center_open open_convex_bounds u r hr v + have hc := center_open u + change (u.re : ℝ) < (Path.segment r (GridCellCenter u) v).re ∧ + (Path.segment r (GridCellCenter u) v).re < (u.re : ℝ) + 1 ∧ + (u.im : ℝ) < (Path.segment r (GridCellCenter u) v).im ∧ + (Path.segment r (GridCellCenter u) v).im < (u.im : ℝ) + 1 + rw [segment_re, segment_im, center_re, center_im] + exact ⟨(by simpa [center_re] using (open_convex_bounds r.re (GridCellCenter u).re (u.re : ℝ) + ((u.re : ℝ) + 1) (v : ℝ) + hr.1 hc.1 hr.2.1 hc.2.1 v.2.1 v.2.2).1), + (by simpa [center_re] using (open_convex_bounds r.re (GridCellCenter u).re (u.re : ℝ) ((u.re + : ℝ) + 1) (v : ℝ) + hr.1 hc.1 hr.2.1 hc.2.1 v.2.1 v.2.2).2), + (by simpa [center_im] using (open_convex_bounds r.im (GridCellCenter u).im (u.im : ℝ) ((u.im + : ℝ) + 1) (v : ℝ) + hr.2.2.1 hc.2.2.1 hr.2.2.2 hc.2.2.2 v.2.1 v.2.2).1), + (by simpa [center_im] using (open_convex_bounds r.im (GridCellCenter u).im (u.im : ℝ) ((u.im + : ℝ) + 1) (v : ℝ) + hr.2.2.1 hc.2.2.1 hr.2.2.2 hc.2.2.2 v.2.1 v.2.2).2)⟩ + +private theorem cell_index : + let openbox (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) < z.re ∧ z.re < (u.re : ℝ) + 1 ∧ + (u.im : ℝ) < z.im ∧ z.im < (u.im : ℝ) + 1 + (∀ (u : GaussianInt), openbox u (GridCellCenter u)) → ((∀ (a : ℝ), (0 < a) → (∀ (c : ℂ), ∀ (r + : ℂ), ∀ (f : C(Circle, ℂ)), (∀ z, f z ≠ r) → (P3821T1LoopIndex ⟨fun z => (a : ℂ) * f z + + c, (continuous_const.mul f.continuous).add continuous_const⟩ ((a : ℂ) * r + c) = + P3821T1LoopIndex f r))) → (∀ (n : ℕ), ∀ (loops : Fin n → C(Circle, ℂ)), (∀ (u : + GaussianInt), ∀ (r : ℂ), (openbox u r) → (∀ (j : Fin n), ∀ z, loops j z ≠ r)) → ((∀ + (u : GaussianInt), ∀ (r : ℂ), (openbox u r) → (∀ (v : unitInterval), openbox u + (Path.segment r + (GridCellCenter u) v))) → (∀ (u : GaussianInt), ∀ (r : ℂ), openbox u r → ∀ (j : Fin n), + P3821T1LoopIndex (loops j) r = P3821T1LoopIndex (loops j) (GridCellCenter u))))) + := by + classical + intro openbox center_open similarity_index n loops hloop_open_avoid open_segment u r hr j + let H : C(unitInterval × Circle, ℂ) := + ⟨fun x => loops j x.2 - Path.segment r (GridCellCenter u) x.1, + (loops j).continuous.comp continuous_snd |>.sub + ((Path.segment r (GridCellCenter u)).continuous.comp continuous_fst)⟩ + have havoid : ∀ s z, H (s, z) ≠ 0 := by + intro s z hz + have hloop := hloop_open_avoid u (Path.segment r (GridCellCenter u) s) + (open_segment u r hr s) j z + apply hloop + dsimp [H] at hz + exact sub_eq_zero.mp hz + have hhom := P3821T1LoopIndexLaws.2.2 H 0 havoid + have hleft : + P3821T1LoopIndex + ⟨fun z => H (⟨0, by norm_num⟩, z), H.continuous.comp (continuous_const.prodMk + continuous_id)⟩ 0 = + P3821T1LoopIndex (loops j) r := by + have hloop0 : + (⟨fun z => H (⟨0, by norm_num⟩, z), H.continuous.comp (continuous_const.prodMk + continuous_id)⟩ : C(Circle, ℂ)) = + ⟨fun z => loops j z - r, (loops j).continuous.sub continuous_const⟩ := by + ext z + simp [H] + rw [hloop0] + simpa [sub_eq_add_neg] using similarity_index 1 one_pos (-r) r (loops j) (hloop_open_avoid u + r hr j) + have hright : + P3821T1LoopIndex + ⟨fun z => H (⟨1, by norm_num⟩, z), H.continuous.comp (continuous_const.prodMk + continuous_id)⟩ 0 = + P3821T1LoopIndex (loops j) (GridCellCenter u) := by + have hloop1 : + (⟨fun z => H (⟨1, by norm_num⟩, z), H.continuous.comp (continuous_const.prodMk + continuous_id)⟩ : C(Circle, ℂ)) = + ⟨fun z => loops j z - GridCellCenter u, (loops j).continuous.sub continuous_const⟩ := by + ext z + simp [H] + rw [hloop1] + simpa [sub_eq_add_neg] using similarity_index 1 one_pos (-(GridCellCenter u)) (GridCellCenter u) + (loops j) (hloop_open_avoid u (GridCellCenter u) (center_open u) j) + exact hleft.symm.trans (hhom.trans hright) + +private theorem scaled_edge_in_V : + ∀ (K : Set ℂ), ∀ (N : Set ℂ), ∀ (p : ℂ), ∀ (q : ℂ), ∀ (hb : Bornology.IsBounded + (connectedComponentIn Kᶜ p)), + let corner (u : GaussianInt) : Fin 4 → GaussianInt := + ![u, u + 1, u + 1 + ⟨0, 1⟩, u + ⟨0, 1⟩] + let neighbor (u : GaussianInt) : Fin 4 → GaussianInt := + ![u - ⟨0, 1⟩, u + 1, u + ⟨0, 1⟩, u - 1] + let box (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) ≤ z.re ∧ z.re ≤ (u.re : ℝ) + 1 ∧ + (u.im : ℝ) ≤ z.im ∧ z.im ≤ (u.im : ℝ) + 1 + (∀ (u : GaussianInt), ∀ (z : ℂ), (box u z) → (‖z - GridCellCenter u‖ ≤ 1)) → ((∀ (u : + GaussianInt), ∀ (k : Fin 4), ‖GridCellCenter (neighbor u k) - GridCellCenter u‖ ≤ 1) → + ((∀ (u : GaussianInt), ∀ (k : Fin 4), ∀ (t : unitInterval), box u (Path.segment (corner u + k : ℂ) (corner u (k + 1) : ℂ) t) ∧ box (neighbor u k) (Path.segment (corner u k : ℂ) + (corner u (k + 1) : ℂ) t)) → ((∀ (K : Set ℂ), ∀ (p : ℂ), ∀ (a : ℂ), ∀ (b : ℂ), (a ∈ + connectedComponentIn Kᶜ p) → ((b ∉ connectedComponentIn Kᶜ p) → (∃ t : unitInterval, + Path.segment a b t ∈ K))) → (∀ (finite_centers : ∀ (U : Set ℂ), (Bornology.IsBounded U) → + (∀ (h : ℝ), (0 < h) → (∀ (o : ℂ), {u : GaussianInt | (h : ℂ) * GridCellCenter u + o ∈ + U}.Finite))), + let V := N ∩ ({p, q} : Set ℂ)ᶜ + ∀ (η : ℝ), ((0 : ℝ) < η) → ((Metric.thickening η K ⊆ V) → (∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + ∀ (hh : 0 < h), (3 * h < η) → (∀ (s : ℝ), ∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + let D : Finset GaussianInt := (finite_centers (connectedComponentIn Kᶜ p) hb h hh o).toFinset + (∀ (u : GaussianInt), u ∈ D ↔ (h : ℂ) * GridCellCenter u + o ∈ connectedComponentIn Kᶜ p) → + (∀ (a : GaussianInt), ∀ (k : Fin (4 : ℕ)), ∀ (t₀ : (↑unitInterval : Type)), a ∈ D → + neighbor a k ∉ D → (↑h : ℂ) * (Path.segment ((GaussianInt.toComplex : GaussianInt → ℂ) + (corner a k)) ((GaussianInt.toComplex : GaussianInt → ℂ) (corner a (k + (1 : Fin (4 : + ℕ))))) : (↑unitInterval : Type) → ℂ) t₀ + o ∈ V)))))))) := by + classical + intro K N p q hb corner neighbor box box_dist neighbor_dist edge_box segment_hits + finite_centers V η hη hcollar εp εq h hh h3 s t o D hmemD a k t₀ ha hk + let A : ℂ := (h : ℂ) * GridCellCenter a + o + let B : ℂ := (h : ℂ) * GridCellCenter (neighbor a k) + o + let e : ℂ := Path.segment (corner a k : ℂ) (corner a (k + 1) : ℂ) t₀ + have hA : A ∈ connectedComponentIn Kᶜ p := (hmemD a).1 ha + have hB : B ∉ connectedComponentIn Kᶜ p := by + intro hB + exact hk ((hmemD (neighbor a k)).2 hB) + obtain ⟨v, hvK⟩ := segment_hits K p A B hA hB + have hnorm : ‖(h : ℂ)‖ = h := by rw [Complex.norm_real, Real.norm_eq_abs, abs_of_pos hh] + have he : ‖(h : ℂ) * e + o - A‖ ≤ h := by + have hbox := (edge_box a k t₀).1 + have hdist := box_dist a e hbox + have heq : (h : ℂ) * e + o - A = (h : ℂ) * (e - GridCellCenter a) := by + dsimp [A] + ring + rw [heq, norm_mul, hnorm] + calc + h * ‖e - GridCellCenter a‖ ≤ h * 1 := mul_le_mul_of_nonneg_left hdist hh.le + _ = h := mul_one h + have hAB : ‖B - A‖ ≤ h := by + have hd := neighbor_dist a k + have heq : B - A = (h : ℂ) * + (GridCellCenter (neighbor a k) - GridCellCenter a) := by + dsimp [A, B] + ring + rw [heq, norm_mul, hnorm] + calc + h * ‖GridCellCenter (neighbor a k) - GridCellCenter a‖ ≤ h * 1 := + mul_le_mul_of_nonneg_left hd hh.le + _ = h := mul_one h + let w : ℂ := Path.segment A B v + have hwA : ‖w - A‖ ≤ h := by + change ‖(v : ℝ) • (B - A) + A - A‖ ≤ h + rw [add_sub_cancel_right, norm_smul, Real.norm_eq_abs, abs_of_nonneg v.2.1] + calc + (v : ℝ) * ‖B - A‖ ≤ 1 * ‖B - A‖ := mul_le_mul_of_nonneg_right v.2.2 (norm_nonneg _) + _ ≤ h := by simpa using hAB + have hnear : ‖(h : ℂ) * e + o - w‖ ≤ 2 * h := by + calc + ‖(h : ℂ) * e + o - w‖ = ‖((h : ℂ) * e + o - A) - (w - A)‖ := by congr 1; ring + _ ≤ ‖(h : ℂ) * e + o - A‖ + ‖w - A‖ := norm_sub_le _ _ + _ ≤ h + h := add_le_add he hwA + _ = 2 * h := (two_mul h).symm + have h2eta : 2 * h < η := + (mul_lt_mul_of_pos_right (by norm_num : (2 : ℝ) < 3) hh).trans h3 + have hnearK : ‖(h : ℂ) * e + o - Path.segment A B v‖ < η := by + exact lt_of_le_of_lt hnear h2eta + have hthick : (h : ℂ) * e + o ∈ Metric.thickening η K := by + apply (Metric.mem_thickening_iff_exists_edist_lt (δ := η) K _).2 + refine ⟨Path.segment A B v, hvK, ?_⟩ + rw [edist_dist, dist_eq_norm] + exact (ENNReal.ofReal_lt_ofReal_iff hη).mpr hnearK + exact hcollar hthick + +private theorem hsumAt1198 : + ∀ (p : ℂ), + let openbox (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) < z.re ∧ z.re < (u.re : ℝ) + 1 ∧ + (u.im : ℝ) < z.im ∧ z.im < (u.im : ℝ) + 1 + ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + ∀ (s : ℝ), ∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + let rp : ℂ := (p - o) / (h : ℂ) + ∀ (up : GaussianInt), (openbox up rp) → (∀ (n : ℕ), ∀ (loops : Fin n → C(Circle, ℂ)), + let g : Fin n → C(Circle, ℂ) := fun j => + ⟨fun z => (h : ℂ) * loops j z + o, (continuous_const.mul (loops j).continuous).add + continuous_const⟩ + (∀ (j : Fin n), ∀ (r : ℂ), (∀ z, loops j z ≠ r) → (P3821T1LoopIndex (g j) ((h : ℂ) * r + o) + = P3821T1LoopIndex (loops j) r)) → ((∀ (u : GaussianInt), ∀ (r : ℂ), (openbox u r) → (∀ + (j : Fin n), ∀ z, loops j z ≠ r)) → ((∀ (u : GaussianInt), ∀ (r : ℂ), (openbox u r) → + (∀ (j : Fin n), P3821T1LoopIndex (loops j) r = P3821T1LoopIndex (loops j) + (GridCellCenter u))) → (((h : ℂ) * rp + o = p) → ((∑ j, P3821T1LoopIndex (g j) p) = ∑ + j, P3821T1LoopIndex (loops j) (GridCellCenter up)))))) := by + classical + intro p openbox η εp εq h s t o rp up hup n loops g hscaled_index hloop_open_avoid cell_index + hpgrid + apply Finset.sum_congr rfl + intro j hj + calc + P3821T1LoopIndex (g j) p = + P3821T1LoopIndex (g j) ((h : ℂ) * rp + o) := by + exact congrArg (P3821T1LoopIndex (g j)) hpgrid.symm + _ = P3821T1LoopIndex (loops j) rp := + hscaled_index j rp (hloop_open_avoid up rp hup j) + _ = P3821T1LoopIndex (loops j) (GridCellCenter up) := + cell_index up rp hup j + +private theorem hsumAt1214 : + ∀ (q : ℂ), + let openbox (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) < z.re ∧ z.re < (u.re : ℝ) + 1 ∧ + (u.im : ℝ) < z.im ∧ z.im < (u.im : ℝ) + 1 + ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + ∀ (s : ℝ), ∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + let rq : ℂ := (q - o) / (h : ℂ) + ∀ (uq : GaussianInt), (openbox uq rq) → (∀ (n : ℕ), ∀ (loops : Fin n → C(Circle, ℂ)), + let g : Fin n → C(Circle, ℂ) := fun j => + ⟨fun z => (h : ℂ) * loops j z + o, (continuous_const.mul (loops j).continuous).add + continuous_const⟩ + (∀ (j : Fin n), ∀ (r : ℂ), (∀ z, loops j z ≠ r) → (P3821T1LoopIndex (g j) ((h : ℂ) * r + o) + = P3821T1LoopIndex (loops j) r)) → ((∀ (u : GaussianInt), ∀ (r : ℂ), (openbox u r) → (∀ + (j : Fin n), ∀ z, loops j z ≠ r)) → ((∀ (u : GaussianInt), ∀ (r : ℂ), (openbox u r) → + (∀ (j : Fin n), P3821T1LoopIndex (loops j) r = P3821T1LoopIndex (loops j) + (GridCellCenter u))) → (((h : ℂ) * rq + o = q) → ((∑ j, P3821T1LoopIndex (g j) q) = ∑ + j, P3821T1LoopIndex (loops j) (GridCellCenter uq)))))) := by + classical + intro q openbox η εp εq h s t o rq uq huq n loops g hscaled_index hloop_open_avoid cell_index + hqgrid + apply Finset.sum_congr rfl + intro j hj + calc + P3821T1LoopIndex (g j) q = + P3821T1LoopIndex (g j) ((h : ℂ) * rq + o) := by + exact congrArg (P3821T1LoopIndex (g j)) hqgrid.symm + _ = P3821T1LoopIndex (loops j) rq := + hscaled_index j rq (hloop_open_avoid uq rq huq j) + _ = P3821T1LoopIndex (loops j) (GridCellCenter uq) := + cell_index uq rq huq j + +end ComponentContoursProof + +namespace ComponentContourDetails + +private theorem balance_permutation : + ∀ {E : Type}, ∀ {V : Type}, ∀ [Fintype E], ∀ [DecidableEq V], ∀ (source : E → + V), ∀ (target : E → V), (∀ (v : V), Fintype.card { e : E // target e = v } = Fintype.card + { e : E // source e = v }) → ∃ (σ : Equiv.Perm E), ∀ (e : E), source ((σ : E → E) e) = + target e := by + classical + intro E V typeclassInstance0 typeclassInstance2 source target hbalance + classical + let fibers (v : V) : {e // target e = v} ≃ {e // source e = v} := + Fintype.equivOfCardEq (hbalance v) + exact ⟨Equiv.ofFiberEquiv fibers, Equiv.ofFiberEquiv_map fibers⟩ + +private theorem dart_reverse : + let corner (u : GaussianInt) : Fin 4 → GaussianInt := + ![u, u + 1, u + 1 + ⟨0, 1⟩, u + ⟨0, 1⟩] + let neighbor (u : GaussianInt) : Fin 4 → GaussianInt := + ![u - ⟨0, 1⟩, u + 1, u + ⟨0, 1⟩, u - 1] + ∀ (u : GaussianInt), ∀ (k : Fin (4 : ℕ)), neighbor (neighbor u k) (k + (2 : Fin (4 : ℕ))) = u + ∧ corner (neighbor u k) (k + (2 : Fin (4 : ℕ))) = corner u (k + (1 : Fin (4 : ℕ))) ∧ + corner (neighbor u k) (k + (2 : Fin (4 : ℕ)) + (1 : Fin (4 : ℕ))) = corner u k := by + classical + intro corner neighbor u k + fin_cases k <;> simp [corner, neighbor, Zsqrtd.ext_iff] + +private theorem dart_adjacent : + let corner (u : GaussianInt) : Fin 4 → GaussianInt := + ![u, u + 1, u + 1 + ⟨0, 1⟩, u + ⟨0, 1⟩] + ∀ (u : GaussianInt), ∀ (k : Fin (4 : ℕ)), FourNeighborAdjacent (corner u k) (corner u (k + (1 + : Fin (4 : ℕ)))) := by + classical + intro corner u k + fin_cases k <;> simp [FourNeighborAdjacent, corner, Zsqrtd.ext_iff] + +private theorem neighbor_dist : + let neighbor (u : GaussianInt) : Fin 4 → GaussianInt := + ![u - ⟨0, 1⟩, u + 1, u + ⟨0, 1⟩, u - 1] + (∀ (u : GaussianInt), (GridCellCenter u).re = (u.re : ℝ) + 1 / 2) → ((∀ (u : GaussianInt), + (GridCellCenter u).im = (u.im : ℝ) + 1 / 2) → (∀ (u : GaussianInt), ∀ (k : Fin (4 : ℕ)), + ‖GridCellCenter (neighbor u k) - GridCellCenter u‖ ≤ (1 : ℝ))) := by + classical + intro neighbor center_re center_im u k + apply (Complex.norm_le_abs_re_add_abs_im _).trans + rw [Complex.sub_re, Complex.sub_im, center_re, center_re, center_im, center_im] + fin_cases k <;> simp [neighbor] + +private theorem segment_re : + ∀ (a : ℂ), ∀ (b : ℂ), ∀ (t : (↑unitInterval : Type)), ((Path.segment a b : (↑unitInterval : + Type) → ℂ) t).re = ((1 : ℝ) - (↑t : ℝ)) * a.re + (↑t : ℝ) * b.re := by + classical + intro a b t + change (((t : ℝ) • (b - a) + a) : ℂ).re = _ + simp only [Complex.real_smul, Complex.add_re, Complex.mul_re, Complex.sub_re, + Complex.ofReal_re, Complex.ofReal_im, zero_mul, sub_zero] + ring + +private theorem segment_im : + ∀ (a : ℂ), ∀ (b : ℂ), ∀ (t : (↑unitInterval : Type)), ((Path.segment a b : (↑unitInterval : + Type) → ℂ) t).im = ((1 : ℝ) - (↑t : ℝ)) * a.im + (↑t : ℝ) * b.im := by + classical + intro a b t + change (((t : ℝ) • (b - a) + a) : ℂ).im = _ + simp only [Complex.real_smul, Complex.add_im, Complex.mul_im, Complex.sub_im, + Complex.ofReal_re, Complex.ofReal_im, zero_mul, add_zero] + ring + +private theorem cell_exists : + let openbox (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) < z.re ∧ z.re < (u.re : ℝ) + 1 ∧ + (u.im : ℝ) < z.im ∧ z.im < (u.im : ℝ) + 1 + ∀ (z : ℂ), (∀ (n : ℤ), z.re ≠ (↑n : ℝ)) → (∀ (n : ℤ), z.im ≠ (↑n : ℝ)) → ∃ (u : GaussianInt), + openbox u z := by + classical + intro openbox z hr hi + refine ⟨⟨Int.floor z.re, Int.floor z.im⟩, ?_⟩ + refine ⟨lt_of_le_of_ne (Int.floor_le _) (Ne.symm (hr _)), Int.lt_floor_add_one _, + lt_of_le_of_ne (Int.floor_le _) (Ne.symm (hi _)), Int.lt_floor_add_one _⟩ + +private theorem hKne : + ∀ (K : Set ℂ), ∀ (p : ℂ), ∀ (q : ℂ), (connectedComponentIn Kᶜ p ≠ connectedComponentIn Kᶜ q) + → (K.Nonempty) := by + classical + intro K p q hne + by_contra h + apply hne + simp only [(Set.not_nonempty_iff_eq_empty.mp h), Set.compl_empty] + rw [isPreconnected_univ.connectedComponentIn (Set.mem_univ p), + isPreconnected_univ.connectedComponentIn (Set.mem_univ q)] + +private theorem hKV : + ∀ (K : Set ℂ), ∀ (N : Set ℂ), (K ⊆ N) → (∀ (p : ℂ), ∀ (q : ℂ), (p ∈ Kᶜ) → ((q ∈ Kᶜ) → + ((connectedComponentIn Kᶜ p ≠ connectedComponentIn Kᶜ q) → ((Bornology.IsBounded + (connectedComponentIn Kᶜ p)) → ( + let V := N ∩ ({p, q} : Set ℂ)ᶜ + (IsOpen V) → (K ⊆ V)))))) := by + classical + intro K N hKN p q hp hq hne hb V hV z hz + refine ⟨hKN hz, ?_⟩ + simp only [Set.mem_compl_iff, Set.mem_insert_iff, Set.mem_singleton_iff] + rintro (rfl | rfl) + · exact hp hz + · exact hq hz + +private theorem h3 : + ∀ (η : ℝ), ((0 : ℝ) < η) → (∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + 3 * h < η) := by + classical + intro η hη εp εq h + dsimp [h] + nlinarith [min_le_left η (min εp εq)] + +private theorem h2p : + ∀ (η : ℝ), ∀ (εp : ℝ), (εp > (0 : ℝ)) → (∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + h < εp) := by + classical + intro η εp hεp εq h + dsimp [h] + nlinarith [le_trans (min_le_right η (min εp εq)) (min_le_left εp εq)] + +private theorem h2q : + ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), (εq > (0 : ℝ)) → ( + let h : ℝ := min η (min εp εq) / 10 + h < εq) := by + classical + intro η εp εq hεq h + dsimp [h] + nlinarith [le_trans (min_le_right η (min εp εq)) (min_le_right εp εq)] + +private theorem center_open : + let openbox (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) < z.re ∧ z.re < (u.re : ℝ) + 1 ∧ + (u.im : ℝ) < z.im ∧ z.im < (u.im : ℝ) + 1 + (∀ (u : GaussianInt), (GridCellCenter u).re = (u.re : ℝ) + 1 / 2) → ((∀ (u : GaussianInt), + (GridCellCenter u).im = (u.im : ℝ) + 1 / 2) → (∀ (s : ℝ), ((0 : ℝ) < s) → ((s < (1 : ℝ)) + → (∀ (u : GaussianInt), openbox u (GridCellCenter u))))) := by + classical + intro openbox center_re center_im s hs0 hs1 u + simp only [openbox, center_re, center_im] + constructor + · linarith + · constructor + · linarith + · constructor <;> linarith + +private theorem segment_ball : + ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + ∀ (a : ℂ), ∀ (b : ℂ), ‖b - a‖ ≤ h → ∀ (v : (↑unitInterval : Type)), ∀ (ε : ℝ), h < ε → + ‖(Path.segment a b : (↑unitInterval : Type) → ℂ) v - a‖ < ε := by + classical + intro η εp εq h a b hab v ε hε + change ‖(v : ℝ) • (b - a) + a - a‖ < ε + rw [add_sub_cancel_right, norm_smul, Real.norm_eq_abs, abs_of_nonneg v.2.1] + calc + (v : ℝ) * ‖b - a‖ ≤ 1 * ‖b - a‖ := mul_le_mul_of_nonneg_right v.2.2 (norm_nonneg _) + _ ≤ h := by simpa using hab + _ < ε := hε + +private theorem hq_not_pcomp : + ∀ (K : Set ℂ), ∀ (p : ℂ), ∀ (q : ℂ), (connectedComponentIn Kᶜ p ≠ connectedComponentIn Kᶜ q) → ( + let openbox (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) < z.re ∧ z.re < (u.re : ℝ) + 1 ∧ + (u.im : ℝ) < z.im ∧ z.im < (u.im : ℝ) + 1 + ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), (Metric.ball q εq ⊆ Kᶜ) → ( + let h : ℝ := min η (min εp εq) / 10 + (0 < h) → ((h < εq) → (∀ (s : ℝ), ∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + let rq : ℂ := (q - o) / (h : ℂ) + ∀ (uq : GaussianInt), (openbox uq rq) → ((∀ (u : GaussianInt), ∀ (z : ℂ), (openbox u z) → (‖z + - GridCellCenter u‖ ≤ 1)) → ((∀ (a : ℂ), ∀ (b : ℂ), (‖b - a‖ ≤ h) → (∀ (v : + unitInterval), ∀ (ε : ℝ), (h < ε) → (‖Path.segment a b v - a‖ < ε))) → ((h : ℂ) * + GridCellCenter uq + o ∉ connectedComponentIn Kᶜ p))))))) := by + classical + intro K p q hne openbox η εp εq hballq h hh h2q s t o rq uq huq close_in_cell segment_ball hqmem + have e1 := connectedComponentIn_eq hqmem + have e2 := connectedComponentIn_eq (ComponentContoursProof.hqcenter_comp K q η εp εq hballq h2q + s t uq (ComponentContoursProof.hqclose q η εp εq hh s t uq huq close_in_cell) segment_ball) + exact hne (e1.trans e2.symm) + +private theorem hmemD : + ∀ (K : Set ℂ), ∀ (p : ℂ), ∀ (hb : Bornology.IsBounded (connectedComponentIn Kᶜ p)), ∀ + (finite_centers : ∀ (U : Set ℂ), (Bornology.IsBounded U) → (∀ (h : ℝ), (0 < h) → (∀ (o : + ℂ), {u : GaussianInt | (h : ℂ) * GridCellCenter u + o ∈ U}.Finite))), ∀ (η : ℝ), ∀ (εp : + ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + ∀ (hh : 0 < h), (∀ (s : ℝ), ∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + let D : Finset GaussianInt := (finite_centers (connectedComponentIn Kᶜ p) hb h hh o).toFinset + ∀ (u : GaussianInt), u ∈ D ↔ (↑h : ℂ) * GridCellCenter u + o ∈ connectedComponentIn Kᶜ p) := by + classical + intro K p hb finite_centers η εp εq h hh s t o D u + simp [D] + +private theorem huqD : + ∀ (K : Set ℂ), ∀ (p : ℂ), ∀ (hb : Bornology.IsBounded (connectedComponentIn Kᶜ p)), ∀ + (finite_centers : ∀ (U : Set ℂ), (Bornology.IsBounded U) → (∀ (h : ℝ), (0 < h) → (∀ (o : + ℂ), {u : GaussianInt | (h : ℂ) * GridCellCenter u + o ∈ U}.Finite))), ∀ (η : ℝ), ∀ (εp : + ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + ∀ (hh : 0 < h), (∀ (s : ℝ), ∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + ∀ (uq : GaussianInt), ((h : ℂ) * GridCellCenter uq + o ∉ connectedComponentIn Kᶜ p) → ( + let D : Finset GaussianInt := (finite_centers (connectedComponentIn Kᶜ p) hb h hh o).toFinset + (∀ (u : GaussianInt), u ∈ D ↔ (h : ℂ) * GridCellCenter u + o ∈ connectedComponentIn Kᶜ p) → + (uq ∉ D))) := by + classical + intro K p hb finite_centers η εp εq h hh s t o uq hq_not_pcomp D hmemD hu + exact hq_not_pcomp ((hmemD uq).1 hu) + +private theorem hscaled_index : + ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + (0 < h) → (∀ (s : ℝ), ∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + (∀ (a : ℝ), (0 < a) → (∀ (c : ℂ), ∀ (r : ℂ), ∀ (f : C(Circle, ℂ)), (∀ z, f z ≠ r) → + (P3821T1LoopIndex ⟨fun z => (a : ℂ) * f z + c, (continuous_const.mul f.continuous).add + continuous_const⟩ ((a : ℂ) * r + c) = P3821T1LoopIndex f r))) → (∀ (n : ℕ), ∀ (loops : + Fin n → C(Circle, ℂ)), + let g : Fin n → C(Circle, ℂ) := fun j => + ⟨fun z => (h : ℂ) * loops j z + o, (continuous_const.mul (loops j).continuous).add + continuous_const⟩ + ∀ (j : Fin n), ∀ (r : ℂ), (∀ (z : Circle), (loops j : Circle → ℂ) z ≠ r) → P3821T1LoopIndex + (g j) ((↑h : ℂ) * r + o) = P3821T1LoopIndex (loops j) r)) := by + classical + intro η εp εq h hh s t o similarity_index n loops g j r hr + simpa [g, o] using similarity_index h hh o r (loops j) hr + +private theorem hloop_open_avoid : + ∀ (K : Set ℂ), ∀ (p : ℂ), ∀ (hb : Bornology.IsBounded (connectedComponentIn Kᶜ p)), + let openbox (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) < z.re ∧ z.re < (u.re : ℝ) + 1 ∧ + (u.im : ℝ) < z.im ∧ z.im < (u.im : ℝ) + 1 + (∀ (a : ℂ), ∀ (b : ℂ), ∀ (t : unitInterval), (Path.segment a b t).re = (1 - (t : ℝ)) * a.re + + (t : ℝ) * b.re) → ((∀ (a : ℂ), ∀ (b : ℂ), ∀ (t : unitInterval), (Path.segment a b t).im = + (1 - (t : ℝ)) * a.im + (t : ℝ) * b.im) → (∀ (finite_centers : ∀ (U : Set ℂ), + (Bornology.IsBounded U) → (∀ (h : ℝ), (0 < h) → (∀ (o : ℂ), {u : GaussianInt | (h : ℂ) * + GridCellCenter u + o ∈ U}.Finite))), ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + ∀ (hh : 0 < h), (∀ (s : ℝ), ∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + let D : Finset GaussianInt := (finite_centers (connectedComponentIn Kᶜ p) hb h hh o).toFinset + ∀ (n : ℕ), ∀ (loops : Fin n → C(Circle, ℂ)), (∀ (j : Fin n), ∀ (z : Circle), ∃ u ∈ D, ∃ (k : + Fin (4 : ℕ)), (fun (u : GaussianInt) => ![u - ⟨(0 : ℤ), (1 : ℤ)⟩, u + (1 : GaussianInt), + u + ⟨(0 : ℤ), (1 : ℤ)⟩, u - (1 : GaussianInt)]) u k ∉ D ∧ ∃ (t : (↑unitInterval : Type)), + (loops j : Circle → ℂ) z = (Path.segment ((GaussianInt.toComplex : GaussianInt → ℂ) ((fun + (u : GaussianInt) => ![u, u + (1 : GaussianInt), u + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : + ℤ)⟩, u + ⟨(0 : ℤ), (1 : ℤ)⟩]) u k)) ((GaussianInt.toComplex : GaussianInt → ℂ) ((fun (u : + GaussianInt) => ![u, u + (1 : GaussianInt), u + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩, u + + ⟨(0 : ℤ), (1 : ℤ)⟩]) u (k + (1 : Fin (4 : ℕ))))) : (↑unitInterval : Type) → ℂ) t) → (∀ + (u : GaussianInt), ∀ (r : ℂ), openbox u r → ∀ (j : Fin n), ∀ (z : Circle), (loops j : + Circle → ℂ) z ≠ r)))) := by + classical + intro K p hb openbox segment_re segment_im finite_centers η εp εq h hh s t o D n loops htrace u + r hr j z heq + obtain ⟨a, ha, k, hk, t₀, ht⟩ := htrace j z + apply (ComponentContoursProof.edge_not_openbox segment_re segment_im) a k u t₀ + rw [← ht, heq] + exact hr + +private theorem hpgrid : + ∀ (p : ℂ), ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + ∀ (s : ℝ), ∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + let rp : ℂ := (p - o) / (h : ℂ) + ((h : ℂ) ≠ 0) → ((h : ℂ) * rp + o = p) := by + classical + intro p η εp εq h s t o rp hdenom + have hcancel : (h : ℂ) * ((p - o) / (h : ℂ)) = p - o := + mul_div_cancel₀ (p - o) hdenom + change (h : ℂ) * ((p - o) / (h : ℂ)) + o = p + calc + _ = (p - o) + o := congrArg (fun z : ℂ => z + o) hcancel + _ = p := sub_add_cancel p o + +private theorem hqgrid : + ∀ (q : ℂ), ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + ∀ (s : ℝ), ∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + let rq : ℂ := (q - o) / (h : ℂ) + ((h : ℂ) ≠ 0) → ((h : ℂ) * rq + o = q) := by + classical + intro q η εp εq h s t o rq hdenom + have hcancel : (h : ℂ) * ((q - o) / (h : ℂ)) = q - o := + mul_div_cancel₀ (q - o) hdenom + change (h : ℂ) * ((q - o) / (h : ℂ)) + o = q + calc + _ = (q - o) + o := congrArg (fun z : ℂ => z + o) hcancel + _ = q := sub_add_cancel q o + +private theorem hpoint : + let corner (u : GaussianInt) : Fin 4 → GaussianInt := + ![u, u + 1, u + 1 + ⟨0, 1⟩, u + ⟨0, 1⟩] + ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), + let h : ℝ := min η (min εp εq) / 10 + ∀ (s : ℝ), ∀ (t : ℝ), + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + ∀ (n : ℕ), ∀ (loops : Fin n → C(Circle, ℂ)), + let g : Fin n → C(Circle, ℂ) := fun j => + ⟨fun z => (h : ℂ) * loops j z + o, (continuous_const.mul (loops j).continuous).add + continuous_const⟩ + ∀ (j : Fin n), ∀ (z : Circle), ∀ (a : GaussianInt), ∀ (k : Fin (4 : ℕ)), ∀ (t₀ : + (↑unitInterval : Type)), ((loops j : Circle → ℂ) z = (Path.segment + ((GaussianInt.toComplex : GaussianInt → ℂ) ((fun (u : GaussianInt) => ![u, u + (1 : + GaussianInt), u + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩, u + ⟨(0 : ℤ), (1 : ℤ)⟩]) a k)) + ((GaussianInt.toComplex : GaussianInt → ℂ) ((fun (u : GaussianInt) => ![u, u + (1 : + GaussianInt), u + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩, u + ⟨(0 : ℤ), (1 : ℤ)⟩]) a (k + + (1 : Fin (4 : ℕ))))) : (↑unitInterval : Type) → ℂ) t₀) → (g j z = (h : ℂ) * Path.segment + (corner a k : ℂ) (corner a (k + 1) : ℂ) t₀ + o) := by + classical + intro corner η εp εq h s t o n loops g j z a k t₀ ht + dsimp [g] + rw [ht] + +end ComponentContourDetails + +theorem P3821T1ComponentContours (K N : Set ℂ) (hK : IsCompact K) + (hN : IsOpen N) (hKN : K ⊆ N) (p q : ℂ) + (hp : p ∈ Kᶜ) (hq : q ∈ Kᶜ) + (hne : connectedComponentIn Kᶜ p ≠ connectedComponentIn Kᶜ q) + (hb : Bornology.IsBounded (connectedComponentIn Kᶜ p)) : + ∃ n : ℕ, ∃ g : Fin n → C(Circle, ℂ), + (∀ i, Set.range (g i) ⊆ N) ∧ + (∀ i z, g i z ≠ p ∧ g i z ≠ q) ∧ + (∑ i, P3821T1LoopIndex (g i) p) = 1 ∧ + (∑ i, P3821T1LoopIndex (g i) q) = 0 := by +-- BODY + classical + have grid_edge_avoids (r a b : GaussianInt) (hab : FourNeighborAdjacent a b) : + ∀ t : unitInterval, Path.segment (a : ℂ) (b : ℂ) t ≠ GridCellCenter r := + ComponentContoursProof.grid_edge_avoids r a b hab + have balance_permutation {E V : Type} [Fintype E] [DecidableEq E] [DecidableEq V] + (source target : E → V) + (hbalance : ∀ v, Fintype.card {e // target e = v} = + Fintype.card {e // source e = v}) : + ∃ σ : Equiv.Perm E, ∀ e, source (σ e) = target e := + ComponentContourDetails.balance_permutation (E := E) (V := V) source target hbalance + let corner (u : GaussianInt) : Fin 4 → GaussianInt := + ![u, u + 1, u + 1 + ⟨0, 1⟩, u + ⟨0, 1⟩] + let neighbor (u : GaussianInt) : Fin 4 → GaussianInt := + ![u - ⟨0, 1⟩, u + 1, u + ⟨0, 1⟩, u - 1] + have dart_reverse (u : GaussianInt) (k : Fin 4) : + neighbor (neighbor u k) (k + 2) = u ∧ + corner (neighbor u k) (k + 2) = corner u (k + 1) ∧ + corner (neighbor u k) ((k + 2) + 1) = corner u k := ComponentContourDetails.dart_reverse u k + have dart_adjacent (u : GaussianInt) (k : Fin 4) : + FourNeighborAdjacent (corner u k) (corner u (k + 1)) := + ComponentContourDetails.dart_adjacent u k + let rayStep (r a b : GaussianInt) : ℤ := + if b = a + ⟨0, 1⟩ ∧ a.im = r.im ∧ a.re ≤ r.re then 1 + else if b = a - ⟨0, 1⟩ ∧ b.im = r.im ∧ a.re ≤ r.re then -1 + else 0 + let box (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) ≤ z.re ∧ z.re ≤ (u.re : ℝ) + 1 ∧ + (u.im : ℝ) ≤ z.im ∧ z.im ≤ (u.im : ℝ) + 1 + let openbox (u : GaussianInt) (z : ℂ) : Prop := + (u.re : ℝ) < z.re ∧ z.re < (u.re : ℝ) + 1 ∧ + (u.im : ℝ) < z.im ∧ z.im < (u.im : ℝ) + 1 + have center_re (u : GaussianInt) : (GridCellCenter u).re = (u.re : ℝ) + 1 / 2 := by + simp [GridCellCenter] + have center_im (u : GaussianInt) : (GridCellCenter u).im = (u.im : ℝ) + 1 / 2 := by + simp [GridCellCenter] + have box_dist (u : GaussianInt) (z : ℂ) (hz : box u z) : ‖z - GridCellCenter u‖ ≤ 1 := + ComponentContoursProof.box_dist center_re center_im u z hz + have neighbor_dist (u : GaussianInt) (k : Fin 4) : + ‖GridCellCenter (neighbor u k) - GridCellCenter u‖ ≤ 1 := + ComponentContourDetails.neighbor_dist center_re center_im u k + have segment_re (a b : ℂ) (t : unitInterval) : + (Path.segment a b t).re = (1 - (t : ℝ)) * a.re + (t : ℝ) * b.re := + ComponentContourDetails.segment_re a b t + have segment_im (a b : ℂ) (t : unitInterval) : + (Path.segment a b t).im = (1 - (t : ℝ)) * a.im + (t : ℝ) * b.im := + ComponentContourDetails.segment_im a b t + have shift_exists (a b : ℝ) : ∃ s : ℝ, 0 < s ∧ s < 1 ∧ + (∀ n : ℤ, a - s ≠ n) ∧ (∀ n : ℤ, b - s ≠ n) := ComponentContoursProof.shift_exists a b + have cell_exists (z : ℂ) (hr : ∀ n : ℤ, z.re ≠ n) (hi : ∀ n : ℤ, z.im ≠ n) : + ∃ u : GaussianInt, openbox u z := ComponentContourDetails.cell_exists z hr hi + have finite_centers (U : Set ℂ) (hU : Bornology.IsBounded U) + (h : ℝ) (hh : 0 < h) (o : ℂ) : + {u : GaussianInt | (h : ℂ) * GridCellCenter u + o ∈ U}.Finite := + ComponentContoursProof.finite_centers center_re center_im U hU h hh o + have hKne : K.Nonempty := ComponentContourDetails.hKne K p q hne + let V := N ∩ ({p, q} : Set ℂ)ᶜ + have hV : IsOpen V := hN.inter + (isClosed_singleton.union isClosed_singleton).isOpen_compl + have hKV : K ⊆ V := ComponentContourDetails.hKV K N hKN p q hp hq hne hb hV + obtain ⟨η, hη, hcollar⟩ := hK.exists_thickening_subset_open hV hKV + obtain ⟨εp, hεp, hballp⟩ := Metric.isOpen_iff.mp hK.isClosed.isOpen_compl p hp + obtain ⟨εq, hεq, hballq⟩ := Metric.isOpen_iff.mp hK.isClosed.isOpen_compl q hq + let h : ℝ := min η (min εp εq) / 10 + have hh : 0 < h := by dsimp [h]; positivity + have h3 : 3 * h < η := ComponentContourDetails.h3 η hη εp εq + have h2p : h < εp := ComponentContourDetails.h2p η εp hεp εq + have h2q : h < εq := ComponentContourDetails.h2q η εp εq hεq + obtain ⟨s, hs0, hs1, hspr, hspq⟩ := shift_exists (p.re / h) (q.re / h) + obtain ⟨t, ht0, ht1, htsp, htq⟩ := shift_exists (p.im / h) (q.im / h) + let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I + let rp : ℂ := (p - o) / (h : ℂ) + let rq : ℂ := (q - o) / (h : ℂ) + obtain ⟨up, hup⟩ := cell_exists rp (ComponentContoursProof.hrp p η εp εq hh s hspr t) + (ComponentContoursProof.hip p η εp εq hh s t htsp) + obtain ⟨uq, huq⟩ := cell_exists rq (ComponentContoursProof.hrq q η εp εq hh s hspq t) + (ComponentContoursProof.hiq q η εp εq hh s t htq) + have box_of_open (u : GaussianInt) (z : ℂ) (hz : openbox u z) : box u z := by + exact ⟨hz.1.le, hz.2.1.le, hz.2.2.1.le, hz.2.2.2.le⟩ + have center_open (u : GaussianInt) : openbox u (GridCellCenter u) := + ComponentContourDetails.center_open center_re center_im s hs0 hs1 u + have close_in_cell (u : GaussianInt) (z : ℂ) (hz : openbox u z) : + ‖z - GridCellCenter u‖ ≤ 1 := box_dist u z (box_of_open u z hz) + have segment_ball (a b : ℂ) (hab : ‖b - a‖ ≤ h) (v : unitInterval) + (ε : ℝ) (hε : h < ε) : ‖Path.segment a b v - a‖ < ε := ComponentContourDetails.segment_ball + η εp εq a b hab v ε hε + have hq_not_pcomp : (h : ℂ) * GridCellCenter uq + o ∉ connectedComponentIn Kᶜ p := + ComponentContourDetails.hq_not_pcomp K p q hne η εp εq hballq hh h2q s t uq huq + close_in_cell segment_ball + let D : Finset GaussianInt := (finite_centers (connectedComponentIn Kᶜ p) hb h hh o).toFinset + have hmemD (u : GaussianInt) : u ∈ D ↔ (h : ℂ) * GridCellCenter u + o ∈ connectedComponentIn Kᶜ + p := ComponentContourDetails.hmemD K p hb finite_centers η εp εq hh s t u + have hupD : up ∈ D := hmemD up |>.2 (ComponentContoursProof.hpcenter_comp K p η εp hballp εq + h2p s t up (ComponentContoursProof.hpclose p η εp εq hh s t up hup close_in_cell) + segment_ball) + have huqD : uq ∉ D := ComponentContourDetails.huqD K p hb finite_centers η εp εq hh s t uq + hq_not_pcomp hmemD + have similarity_index (a : ℝ) (ha : 0 < a) (c r : ℂ) (f : C(Circle, ℂ)) + (hf : ∀ z, f z ≠ r) : + P3821T1LoopIndex + ⟨fun z => (a : ℂ) * f z + c, (continuous_const.mul f.continuous).add continuous_const⟩ + ((a : ℂ) * r + c) = P3821T1LoopIndex f r := ComponentContoursProof.similarity_index a + ha c r f hf + obtain ⟨n, loops, htrace, hgrididx⟩ := (ComponentContoursProof.grid_contours grid_edge_avoids + (ComponentContoursProof.loop_of_edges (ComponentContoursProof.loop_of_path) + (ComponentContoursProof.concatenate_paths)) (ComponentContoursProof.cycles_of_perm) + balance_permutation dart_adjacent (ComponentContoursProof.grid_boundary_sum dart_reverse + dart_adjacent) (ComponentContoursProof.square_increment + (ComponentContoursProof.grid_edge_increment grid_edge_avoids) dart_adjacent + (ComponentContoursProof.square_step))) D + let g : Fin n → C(Circle, ℂ) := fun j => + ⟨fun z => (h : ℂ) * loops j z + o, (continuous_const.mul (loops j).continuous).add + continuous_const⟩ + have hscaled_index (j : Fin n) (r : ℂ) (hr : ∀ z, loops j z ≠ r) : + P3821T1LoopIndex (g j) ((h : ℂ) * r + o) = + P3821T1LoopIndex (loops j) r := ComponentContourDetails.hscaled_index η εp εq hh s t + similarity_index n loops j r hr + have hloop_open_avoid (u : GaussianInt) (r : ℂ) (hr : openbox u r) (j : Fin n) : + ∀ z, loops j z ≠ r := ComponentContourDetails.hloop_open_avoid K p hb segment_re segment_im + finite_centers η εp εq hh s t n loops htrace u r hr j + have cell_index (u : GaussianInt) (r : ℂ) (hr : openbox u r) (j : Fin n) : + P3821T1LoopIndex (loops j) r = P3821T1LoopIndex (loops j) (GridCellCenter u) := + ComponentContoursProof.cell_index center_open similarity_index n loops hloop_open_avoid + (ComponentContoursProof.open_segment center_re center_im segment_re segment_im + center_open (ComponentContoursProof.open_convex_bounds)) u r hr j + have scaled_edge_in_V (a : GaussianInt) (k : Fin 4) (t₀ : unitInterval) + (ha : a ∈ D) (hk : neighbor a k ∉ D) : + (h : ℂ) * Path.segment (corner a k : ℂ) (corner a (k + 1) : ℂ) t₀ + o ∈ V := + ComponentContoursProof.scaled_edge_in_V K N p q hb box_dist neighbor_dist + (ComponentContoursProof.edge_box) + (ComponentContoursProof.segment_hits) finite_centers η hη hcollar εp εq hh h3 s t hmemD + a k t₀ ha hk + have hdenom : (h : ℂ) ≠ 0 := Complex.ofReal_ne_zero.mpr hh.ne' + have hpgrid : (h : ℂ) * rp + o = p := ComponentContourDetails.hpgrid p η εp εq s t hdenom + have hqgrid : (h : ℂ) * rq + o = q := ComponentContourDetails.hqgrid q η εp εq s t hdenom + refine ⟨n, g, ?_, ?_, ?_, ?_⟩ + · intro j + rintro x ⟨z, rfl⟩ + obtain ⟨a, ha, k, hk, t₀, ht⟩ := htrace j z + have hVx : (h : ℂ) * Path.segment (corner a k : ℂ) (corner a (k + 1) : ℂ) t₀ + o ∈ V := + scaled_edge_in_V a k t₀ ha hk + have : g j z = (h : ℂ) * Path.segment (corner a k : ℂ) (corner a (k + 1) : ℂ) t₀ + o := by + dsimp [g] + rw [ht] + rw [this] + exact hVx.1 + · intro j z + obtain ⟨a, ha, k, hk, t₀, ht⟩ := htrace j z + have hVx : (h : ℂ) * Path.segment (corner a k : ℂ) (corner a (k + 1) : ℂ) t₀ + o ∈ V := + scaled_edge_in_V a k t₀ ha hk + have hpoint : g j z = (h : ℂ) * Path.segment (corner a k : ℂ) (corner a (k + 1) : ℂ) t₀ + o + := ComponentContourDetails.hpoint η εp εq s t n loops j z a k t₀ ht + rw [hpoint] + have hnot := hVx.2 + simp only [Set.mem_compl_iff, Set.mem_insert_iff, Set.mem_singleton_iff, not_or] at hnot + exact hnot + · have hsum : (∑ j, P3821T1LoopIndex (g j) p) = + ∑ j, P3821T1LoopIndex (loops j) (GridCellCenter up) := + ComponentContoursProof.hsumAt1198 p η εp εq s t up hup n loops hscaled_index + hloop_open_avoid cell_index hpgrid + rw [hsum] + have hidx := hgrididx up + rw [ite_eq_left hupD] at hidx + exact hidx + · have hsum : (∑ j, P3821T1LoopIndex (g j) q) = + ∑ j, P3821T1LoopIndex (loops j) (GridCellCenter uq) := + ComponentContoursProof.hsumAt1214 q η εp εq s t uq huq n loops hscaled_index + hloop_open_avoid cell_index hqgrid + rw [hsum] + have hidx := hgrididx uq + rw [ite_eq_right huqD] at hidx + exact hidx + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean new file mode 100644 index 0000000000..5e3da1bb66 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean @@ -0,0 +1,1227 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Analysis.SpecialFunctions.Complex.Circle +public import Mathlib.Topology.ContinuousMap.Basic +public import Mathlib.Topology.UniformSpace.HeineCantor +public import Mathlib.Topology.MetricSpace.Pseudo.Basic +public import Mathlib.Algebra.BigOperators.Field +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: P3821T1ControlledNeighborhood] + +/-! +# P3821T1ControlledNeighborhood + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ControlledNeighborhoodConstruction + +private noncomputable abbrev f (e : C(Circle, ℂ)) (he : Function.Injective e) : Circle ≃ + Set.range e := by + classical + exact Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + +private theorem hf (e : C(Circle, ℂ)) (he : Function.Injective e) : Continuous (f e he) := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + change (Continuous f) + change Continuous (fun x : Circle => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) + exact Continuous.subtype_mk e.continuous (fun x => ⟨x, rfl⟩) + +private noncomputable abbrev ψ (e : C(Circle, ℂ)) (he : Function.Injective e) : Set.range e → + Circle := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + exact fun x => f.symm x + +private theorem hψc (e : C(Circle, ℂ)) (he : Function.Injective e) : Continuous (ψ e he) := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + have hf : Continuous f := hf e he + let ψ : Set.range e → Circle := f.symm + change (Continuous ψ) + exact hf.continuous_symm_of_equiv_compact_to_t2 + +private theorem hψleft (e : C(Circle, ℂ)) (he : Function.Injective e) : Function.LeftInverse (ψ e + he) (fun x : Circle => ⟨e x, ⟨x, rfl⟩⟩) := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + change (Function.LeftInverse ψ (fun x : Circle => ⟨e x, ⟨x, rfl⟩⟩)) + intro x + exact f.symm_apply_apply x + +private noncomputable abbrev u (e : C(Circle, ℂ)) (he : Function.Injective e) : Set.range e → ℂ + := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + exact fun k => (ψ k : ℂ) + +private theorem hu (e : C(Circle, ℂ)) (he : Function.Injective e) : Continuous (u e he) := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + have hf : Continuous f := hf e he + let ψ : Set.range e → Circle := f.symm + have hψc : Continuous ψ := hψc e he + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + change (Continuous u) + exact continuous_subtype_val.comp hψc + +private theorem heUC (e : C(Circle, ℂ)) : UniformContinuous e := by + classical + exact CompactSpace.uniformContinuous_of_continuous e.continuous + +private noncomputable abbrev δ (δ₀ : ℝ) := by + classical + exact min (δ₀ / 4) (1 / 8) + +private theorem hδpos (δ₀ : ℝ) (hδ₀ : δ₀ > 0) : 0 < (δ δ₀) := by + classical + let δ := min (δ₀ / 4) (1 / 8) + change (0 < δ) + dsimp [δ]; positivity + +private theorem hδlt (δ₀ : ℝ) (hδ₀ : δ₀ > 0) : (δ δ₀) < 1 / 4 := by + classical + let δ := min (δ₀ / 4) (1 / 8) + have hδpos : 0 < δ := hδpos δ₀ hδ₀ + change (δ < 1 / 4) + dsimp [δ] + have : min (δ₀ / 4) (1 / 8) ≤ 1 / 8 := min_le_right _ _ + linarith + +private theorem hKcompact (e : C(Circle, ℂ)) : IsCompact (Set.range e) := by + classical + exact isCompact_range e.continuous + +private theorem hψUC (e : C(Circle, ℂ)) (he : Function.Injective e) : UniformContinuous (u e he) + := by + classical + let : CompactSpace (Set.range e) := + isCompact_iff_compactSpace.mp (isCompact_range e.continuous) + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + have hf : Continuous f := hf e he + let ψ : Set.range e → Circle := f.symm + have hψc : Continuous ψ := hψc e he + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + have hu : Continuous u := hu e he + change (UniformContinuous u) + exact CompactSpace.uniformContinuous_of_continuous hu + +private noncomputable abbrev r (eps : ℝ) (η : ℝ) := by + classical + exact min (η / 8) (eps / 8) + +private theorem hrpos (eps : ℝ) (heps : 0 < eps) (η : ℝ) (hη : η > 0) : 0 < (r eps η) := by + classical + let r := min (η / 8) (eps / 8) + change (0 < r) + dsimp [r]; positivity + +private theorem hrerr (eps : ℝ) (heps : 0 < eps) (η : ℝ) (hη : η > 0) : 2 * (r eps η) < eps / 2 + := by + classical + let r := min (η / 8) (eps / 8) + have hrpos : 0 < r := hrpos eps heps η hη + change (2 * r < eps / 2) + dsimp [r] + have hle : min (η / 8) (eps / 8) ≤ eps / 8 := min_le_right _ _ + linarith + +private theorem heclose (e : C(Circle, ℂ)) (eps : ℝ) (δ₀ : ℝ) (hδ : ∀ ⦃a b : Circle⦄, dist a b < + δ₀ → dist (e a) (e b) < eps / 2) (hδ₀ : δ₀ > 0) : ∀ u v : Circle, dist u v < 2 * (δ δ₀) → + dist (e u) (e v) < eps / 2 := by + classical + let δ := min (δ₀ / 4) (1 / 8) + have hδpos : 0 < δ := hδpos δ₀ hδ₀ + change (∀ u v : Circle, dist u v < 2 * δ → dist (e u) (e v) < eps / 2) + intro u v huv + apply hδ + have hle : δ ≤ δ₀ / 4 := by dsimp [δ]; exact min_le_left _ _ + linarith + +private theorem hψclose (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) + (δ₀ : ℝ) (η : ℝ) (hη : η > 0) (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) + a) ((u e he) b) < (δ δ₀)) : ∀ k l : Set.range e, dist k l < 4 * (r eps η) → + dist (((ψ e he) k : Circle) : ℂ) (((ψ e he) l : Circle) : ℂ) < (δ δ₀) := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + let δ := min (δ₀ / 4) (1 / 8) + let r := min (η / 8) (eps / 8) + have hrpos : 0 < r := hrpos eps heps η hη + change (∀ k l : Set.range e, dist k l < 4 * r → + dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ) + intro k l hkl + apply hηψ + have hle : r ≤ η / 8 := by dsimp [r]; exact min_le_left _ _ + linarith + +private theorem hKcompact' (e : C(Circle, ℂ)) : IsCompact (Set.range e) := by + classical + exact isCompact_range e.continuous + +private noncomputable abbrev F (e : C(Circle, ℂ)) (S : Set ↑(Set.range ⇑e)) (hSf : S.Finite) : + Finset (Set.range e) := by + classical + exact hSf.toFinset + +private theorem hFS (e : C(Circle, ℂ)) (S : Set ↑(Set.range ⇑e)) (hSf : S.Finite) : ((F e S hSf) + : Set (Set.range e)) = S := by + classical + let F : Finset (Set.range e) := hSf.toFinset + change ((F : Set (Set.range e)) = S) + ext c; simp [F] + +private theorem hFsub (e : C(Circle, ℂ)) (S : Set ↑(Set.range ⇑e)) (hSf : S.Finite) : ((F e S + hSf) : Set (Set.range e)) ⊆ Set.univ := by + classical + let F : Finset (Set.range e) := hSf.toFinset + change ((F : Set (Set.range e)) ⊆ Set.univ) + simp + +private theorem hcover' (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : + S.Finite) (hcover : Set.univ ⊆ ⋃ x ∈ S, Metric.ball x (r eps η)) : (Set.univ : Set (Set.range + e)) ⊆ + ⋃ c ∈ ((F e S hSf) : Set (Set.range e)), Metric.ball c (r eps η) := by + classical + let r := min (η / 8) (eps / 8) + let F : Finset (Set.range e) := hSf.toFinset + have hFS : (F : Set (Set.range e)) = S := hFS e S hSf + change ((Set.univ : Set (Set.range e)) ⊆ + ⋃ c ∈ (F : Set (Set.range e)), Metric.ball c r) + simpa [hFS] using hcover + +private noncomputable abbrev w (e : C(Circle, ℂ)) (eps : ℝ) (η : ℝ) : Set.range e → ℂ → ℝ := by + classical + let r := min (η / 8) (eps / 8) + exact fun c z => max 0 (2 * r - dist z (c : ℂ)) + +private noncomputable abbrev W (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) + (hSf : S.Finite) : ℂ → ℝ := by + classical + let r := min (η / 8) (eps / 8) + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + exact fun z => ∑ c ∈ F, w c z + +private theorem hw_cont (e : C(Circle, ℂ)) (eps : ℝ) (η : ℝ) (c : Set.range e) : Continuous ((w e + eps η) c) := by + classical + let r := min (η / 8) (eps / 8) + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + change (Continuous (w c)) + dsimp [w] + fun_prop + +private theorem hW_cont (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : + S.Finite) : Continuous (W e eps S η hSf) := by + classical + let r := min (η / 8) (eps / 8) + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + have hw_cont (c : Set.range e) : Continuous (w c) := hw_cont e eps η c + change (Continuous W) + dsimp [W] + exact continuous_finsetSum F (fun c hc => hw_cont c) + +private noncomputable abbrev N (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) + (hSf : S.Finite) : Set ℂ := by + classical + let r := min (η / 8) (eps / 8) + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + exact {z | 0 < W z} + +private theorem hNopen (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : + S.Finite) : IsOpen (N e eps S η hSf) := by + classical + let r := min (η / 8) (eps / 8) + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + have hw_cont (c : Set.range e) : Continuous (w c) := hw_cont e eps η c + have hW_cont : Continuous W := hW_cont e eps S η hSf + let N : Set ℂ := {z | 0 < W z} + dsimp only [ControlledNeighborhoodConstruction.N] at * + change (IsOpen N) + exact isOpen_lt continuous_const hW_cont + +private theorem hKN (e : C(Circle, ℂ)) (eps : ℝ) (heps : 0 < eps) (S : Set ↑(Set.range ⇑e)) (η : + ℝ) (hSf : S.Finite) (hcover : Set.univ ⊆ ⋃ x ∈ S, Metric.ball x (r eps η)) (hη : η > 0) : + Set.range e ⊆ (N e eps S η hSf) := by + classical + let r := min (η / 8) (eps / 8) + have hrpos : 0 < r := hrpos eps heps η hη + let F : Finset (Set.range e) := hSf.toFinset + have hFS : (F : Set (Set.range e)) = S := hFS e S hSf + have hcover' : (Set.univ : Set (Set.range e)) ⊆ + ⋃ c ∈ (F : Set (Set.range e)), Metric.ball c r := hcover' e eps S η hSf hcover + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + let N : Set ℂ := {z | 0 < W z} + dsimp only [ControlledNeighborhoodConstruction.N] at * + change (Set.range e ⊆ N) + intro z hz + obtain ⟨c, hcF, hzc⟩ := + Set.mem_iUnion₂.mp (hcover' (Set.mem_univ (⟨z, hz⟩ : Set.range e))) + have hpositive : 0 < w c z := by + dsimp [w] + change dist (⟨z, hz⟩ : Set.range e) c < r at hzc + have hzc' : dist z (c : ℂ) < r := hzc + have : 0 < 2 * r - dist z (c : ℂ) := by linarith + exact lt_of_lt_of_le this (le_max_right _ _) + have hsum : w c z ≤ W z := by + dsimp [W] + have hcF' : c ∈ F := by simpa using hcF + simpa [w] using (Finset.single_le_sum (s := F) + (fun j hj => le_max_left 0 (2 * r - dist z (j : ℂ))) (a := c) hcF') + change 0 < W z + linarith + +private theorem hW_N (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : + S.Finite) : Continuous (fun z : (N e eps S η hSf) => (W e eps S η hSf) (z : ℂ)) := by + classical + let r := min (η / 8) (eps / 8) + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + have hw_cont (c : Set.range e) : Continuous (w c) := hw_cont e eps η c + have hW_cont : Continuous W := hW_cont e eps S η hSf + let N : Set ℂ := {z | 0 < W z} + dsimp only [ControlledNeighborhoodConstruction.N] at * + change (Continuous (fun z : N => W (z : ℂ))) + exact hW_cont.comp continuous_subtype_val + +private noncomputable abbrev a (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) + (hSf : S.Finite) : (N e eps S η hSf) → Set.range e → ℝ := by + classical + let r := min (η / 8) (eps / 8) + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + let N : Set ℂ := {z | 0 < W z} + dsimp only [ControlledNeighborhoodConstruction.N] at * + change (N → Set.range e → ℝ) + exact fun z c => w c (z : ℂ) / W (z : ℂ) + +private theorem ha_cont (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : + S.Finite) (c : Set.range e) : Continuous (fun z : (N e eps S η hSf) => (a e eps S η hSf) z c) + := by + classical + let r := min (η / 8) (eps / 8) + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + have hw_cont (c : Set.range e) : Continuous (w c) := hw_cont e eps η c + have hW_cont : Continuous W := hW_cont e eps S η hSf + let N : Set ℂ := {z | 0 < W z} + have hW_N : Continuous (fun z : N => W (z : ℂ)) := hW_N e eps S η hSf + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + dsimp only [ControlledNeighborhoodConstruction.N] at * + change (Continuous (fun z : N => a z c)) + dsimp [a] + exact (hw_cont c).comp continuous_subtype_val |>.div hW_N (fun z => ne_of_gt z.property) + +private noncomputable abbrev v (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (S : Set + ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) : (N e eps S η hSf) → ℂ := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + let r := min (η / 8) (eps / 8) + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + let N : Set ℂ := {z | 0 < W z} + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + dsimp only [ControlledNeighborhoodConstruction.N] at * + change (N → ℂ) + exact fun z => ∑ c ∈ F, (a z c : ℂ) * u c + +private theorem hv_cont (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (S : Set + ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) : Continuous (v e he eps S η hSf) := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + let r := min (η / 8) (eps / 8) + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + have hw_cont (c : Set.range e) : Continuous (w c) := hw_cont e eps η c + have hW_cont : Continuous W := hW_cont e eps S η hSf + let N : Set ℂ := {z | 0 < W z} + have hW_N : Continuous (fun z : N => W (z : ℂ)) := hW_N e eps S η hSf + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + have ha_cont (c : Set.range e) : Continuous (fun z : N => a z c) := ha_cont e eps S η hSf c + let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c + change (Continuous v) + dsimp [v] + apply continuous_finsetSum + intro c hc + have hac := ha_cont c + fun_prop + +private theorem hactive (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : + S.Finite) (z : (N e eps S η hSf)) : ∃ i ∈ (F e S hSf), 0 < (w e eps η) i (z : ℂ) := by + classical + let r := min (η / 8) (eps / 8) + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + let N : Set ℂ := {z | 0 < W z} + dsimp only [ControlledNeighborhoodConstruction.N] at * + change (∃ i ∈ F, 0 < w i (z : ℂ)) + by_contra h + push Not at h + have hsum : (∑ c ∈ F, w c (z : ℂ)) ≤ 0 := + Finset.sum_nonpos (fun c hc => h c hc) + have hWle : W (z : ℂ) ≤ 0 := by simpa [W] using hsum + have hz : 0 < W (z : ℂ) := z.property + linarith + +private theorem hw_active_dist (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) + (hSf : S.Finite) (z : (N e eps S η hSf)) (c : Set.range e) (hc : 0 < (w e eps η) c (z : ℂ)) : + dist (z : ℂ) (c : ℂ) < 2 * (r eps η) := by + classical + let r := min (η / 8) (eps / 8) + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + let N : Set ℂ := {z | 0 < W z} + dsimp only [ControlledNeighborhoodConstruction.N] at * + change (dist (z : ℂ) (c : ℂ) < 2 * r) + change 0 < max 0 (2 * r - dist (z : ℂ) (c : ℂ)) at hc + exact sub_pos.mp ((lt_max_iff.mp hc).resolve_left (lt_irrefl 0)) + +private theorem hψmap (e : C(Circle, ℂ)) (he : Function.Injective e) (c : Set.range e) : e ((ψ e + he) c) = c := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + have hψleft : Function.LeftInverse ψ (fun x : Circle => ⟨e x, ⟨x, rfl⟩⟩) := hψleft e he + change (e (ψ c) = c) + rcases c with ⟨k, ⟨x, hx⟩⟩ + subst k + have hh := hψleft x + change ψ ⟨e x, ⟨x, rfl⟩⟩ = x at hh + rw [hh] + +private theorem ha_nonneg (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : + S.Finite) (z : (N e eps S η hSf)) (c : Set.range e) : 0 ≤ (a e eps S η hSf) z c := by + classical + let r := min (η / 8) (eps / 8) + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + let N : Set ℂ := {z | 0 < W z} + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + change (0 ≤ a z c) + apply div_nonneg + · exact le_max_left 0 _ + · exact le_of_lt z.property + +private theorem hsum_a (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : + S.Finite) (z : (N e eps S η hSf)) : (∑ c ∈ (F e S hSf), (a e eps S η hSf) z c) = 1 := by + classical + let r := min (η / 8) (eps / 8) + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + let N : Set ℂ := {z | 0 < W z} + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + change ((∑ c ∈ F, a z c) = 1) + rw [← Finset.sum_div] + rw [show (∑ c ∈ F, w c (z : ℂ)) = W (z : ℂ) by rfl] + exact div_self z.property.ne' + +private theorem hv_close (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < + eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) + (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) (z + : (N e eps S η hSf)) (i : Set.range e) (hi : i ∈ (F e S hSf)) + (hwi : 0 < (w e eps η) i (z : ℂ)) : ‖(v e he eps S η hSf) z - (u e he) i‖ < (δ δ₀) := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + let δ := min (δ₀ / 4) (1 / 8) + have hδpos : 0 < δ := hδpos δ₀ hδ₀ + let r := min (η / 8) (eps / 8) + have hrpos : 0 < r := hrpos eps heps η hη + have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → + dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + let N : Set ℂ := {z | 0 < W z} + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c + have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : + dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc + have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c + have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z + dsimp only [ControlledNeighborhoodConstruction.N] at * + change (‖v z - u i‖ < δ) + have hsumC : (∑ c ∈ F, (a z c : ℂ)) = 1 := by + exact_mod_cast hsum_a z + have hsumConst : (∑ c ∈ F, (a z c : ℂ) * u i) = u i := by + calc + (∑ c ∈ F, (a z c : ℂ) * u i) = + (∑ c ∈ F, (a z c : ℂ)) * u i := by rw [Finset.sum_mul] + _ = u i := by rw [hsumC]; simp [u] + have hdiff : v z - u i = ∑ c ∈ F, (a z c : ℂ) * (u c - u i) := by + change (∑ c ∈ F, (a z c : ℂ) * u c) - u i = _ + calc + (∑ c ∈ F, (a z c : ℂ) * u c) - u i = + (∑ c ∈ F, (a z c : ℂ) * u c) - + (∑ c ∈ F, (a z c : ℂ) * u i) := by rw [hsumConst] + _ = ∑ c ∈ F, + ((a z c : ℂ) * u c - (a z c : ℂ) * u i) := by + rw [← Finset.sum_sub_distrib] + _ = ∑ c ∈ F, (a z c : ℂ) * (u c - u i) := by + apply Finset.sum_congr rfl + intro c hc + ring + have hterm_le (c : Set.range e) (hc : c ∈ F) : + ‖(a z c : ℂ) * (u c - u i)‖ ≤ a z c * δ := by + by_cases hactivec : 0 < w c (z : ℂ) + · have hci_ambient : dist (c : ℂ) (i : ℂ) < 4 * r := by + have hcz := hw_active_dist z c hactivec + have hiz := hw_active_dist z i hwi + calc + dist (c : ℂ) (i : ℂ) ≤ dist (c : ℂ) (z : ℂ) + dist (z : ℂ) (i : ℂ) := + dist_triangle _ _ _ + _ = dist (z : ℂ) (c : ℂ) + dist (z : ℂ) (i : ℂ) := by + rw [dist_comm (c : ℂ) z] + _ < 4 * r := by linarith + have hci : dist c i < 4 * r := by + simpa [Subtype.dist_eq] using hci_ambient + have hpsi : dist ((ψ c : Circle) : ℂ) ((ψ i : Circle) : ℂ) < δ := + hψclose c i hci + have hnorm : ‖u c - u i‖ < δ := by simpa [dist_eq_norm, u] using hpsi + have hnorma : ‖(a z c : ℂ)‖ = a z c := by + calc + ‖(a z c : ℂ)‖ = |a z c| := RCLike.norm_ofReal _ + _ = a z c := abs_of_nonneg (ha_nonneg z c) + rw [norm_mul, hnorma] + exact mul_le_mul_of_nonneg_left hnorm.le (ha_nonneg z c) + · have hzero : w c (z : ℂ) = 0 := by + apply le_antisymm + · exact le_of_not_gt hactivec + · dsimp [w] + exact le_max_left 0 _ + have hazero : a z c = 0 := by simp [a, hzero] + simp [hazero] + have hterm_strict : + ‖(a z i : ℂ) * (u i - u i)‖ < a z i * δ := by + have hai : 0 < a z i := div_pos hwi z.property + simp [hδpos, hai] + have hsum_strict : + (∑ c ∈ F, ‖(a z c : ℂ) * (u c - u i)‖) < + ∑ c ∈ F, a z c * δ := + Finset.sum_lt_sum hterm_le ⟨i, hi, hterm_strict⟩ + calc + ‖v z - u i‖ ≤ + ∑ c ∈ F, ‖(a z c : ℂ) * (u c - u i)‖ := by + rw [hdiff] + exact norm_sum_le _ _ + _ < ∑ c ∈ F, a z c * δ := hsum_strict + _ = δ := by rw [← Finset.sum_mul, hsum_a z]; ring + +private theorem hunit (e : C(Circle, ℂ)) (he : Function.Injective e) (c : Set.range e) : ‖(u e + he) c‖ = 1 := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + change (‖u c‖ = 1) + dsimp [u] + exact Circle.norm_coe (ψ c) + +private theorem hv_lower (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < + eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) + (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) (z + : (N e eps S η hSf)) : 1 - (δ δ₀) < ‖(v e he eps S η hSf) z‖ := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + let δ := min (δ₀ / 4) (1 / 8) + have hδpos : 0 < δ := hδpos δ₀ hδ₀ + let r := min (η / 8) (eps / 8) + have hrpos : 0 < r := hrpos eps heps η hη + have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → + dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + let N : Set ℂ := {z | 0 < W z} + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c + have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z + have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : + dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc + have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c + have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z + have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) + (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + i hi hwi + have hunit (c : Set.range e) : ‖u c‖ = 1 := hunit e he c + change (1 - δ < ‖v z‖) + obtain ⟨i, hi, hwi⟩ := hactive z + have hnear := hv_close z i hi hwi + have hrev : ‖u i - v z‖ = ‖v z - u i‖ := by + rw [show u i - v z = -(v z - u i) by ring, norm_neg] + have htri : 1 ≤ ‖v z - u i‖ + ‖v z‖ := by + calc + 1 = ‖u i‖ := (hunit i).symm + _ = ‖(u i - v z) + v z‖ := by congr 1; abel + _ ≤ ‖u i - v z‖ + ‖v z‖ := norm_add_le _ _ + _ = ‖v z - u i‖ + ‖v z‖ := by rw [hrev] + linarith + +private theorem hv_pos (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) + (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) (hηψ + : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) (z : (N + e eps S η hSf)) : 0 < ‖(v e he eps S η hSf) z‖ := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + let δ := min (δ₀ / 4) (1 / 8) + have hδpos : 0 < δ := hδpos δ₀ hδ₀ + have hδlt : δ < 1 / 4 := hδlt δ₀ hδ₀ + let r := min (η / 8) (eps / 8) + have hrpos : 0 < r := hrpos eps heps η hη + have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → + dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + let N : Set ℂ := {z | 0 < W z} + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c + have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z + have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : + dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc + have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c + have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z + have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) + (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + i hi hwi + have hunit (c : Set.range e) : ‖u c‖ = 1 := hunit e he c + have hv_lower (z : N) : 1 - δ < ‖v z‖ := hv_lower e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + change (0 < ‖v z‖) + have hδbound : δ < 1 := by linarith [hδlt] + linarith [hv_lower z] + +private noncomputable abbrev p (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (S : Set + ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) : (N e eps S η hSf) → ℂ := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + let r := min (η / 8) (eps / 8) + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + let N : Set ℂ := {z | 0 < W z} + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c + dsimp only [ControlledNeighborhoodConstruction.N] at * + change (N → ℂ) + exact fun z => v z / (‖v z‖ : ℂ) + +private theorem hp_norm (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) + (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) (hηψ + : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) (z : (N + e eps S η hSf)) : ‖(p e he eps S η hSf) z‖ = 1 := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + let δ := min (δ₀ / 4) (1 / 8) + have hδpos : 0 < δ := hδpos δ₀ hδ₀ + have hδlt : δ < 1 / 4 := hδlt δ₀ hδ₀ + let r := min (η / 8) (eps / 8) + have hrpos : 0 < r := hrpos eps heps η hη + have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → + dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + let N : Set ℂ := {z | 0 < W z} + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c + have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z + have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : + dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc + have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c + have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z + have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) + (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + i hi hwi + have hunit (c : Set.range e) : ‖u c‖ = 1 := hunit e he c + have hv_lower (z : N) : 1 - δ < ‖v z‖ := hv_lower e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + have hv_pos (z : N) : 0 < ‖v z‖ := hv_pos e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + let p : N → ℂ := fun z => v z / (‖v z‖ : ℂ) + change (‖p z‖ = 1) + dsimp [p] + have hden : ‖(‖v z‖ : ℂ)‖ = ‖v z‖ := by + calc + ‖(‖v z‖ : ℂ)‖ = |‖v z‖| := RCLike.norm_ofReal _ + _ = ‖v z‖ := abs_of_nonneg (norm_nonneg _) + rw [norm_div, hden] + exact div_self (ne_of_gt (hv_pos z)) + +private noncomputable abbrev phiVal (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) + (heps : 0 < eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) + (hδ₀ : δ₀ > 0) (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) + b) < (δ δ₀)) : (N e eps S η hSf) → Circle := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + let δ := min (δ₀ / 4) (1 / 8) + have hδpos : 0 < δ := hδpos δ₀ hδ₀ + have hδlt : δ < 1 / 4 := hδlt δ₀ hδ₀ + let r := min (η / 8) (eps / 8) + have hrpos : 0 < r := hrpos eps heps η hη + have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → + dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + let N : Set ℂ := {z | 0 < W z} + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c + have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z + have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : + dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc + have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c + have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z + have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) + (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + i hi hwi + have hunit (c : Set.range e) : ‖u c‖ = 1 := hunit e he c + have hv_lower (z : N) : 1 - δ < ‖v z‖ := hv_lower e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + have hv_pos (z : N) : 0 < ‖v z‖ := hv_pos e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + let p : N → ℂ := fun z => v z / (‖v z‖ : ℂ) + have hp_norm (z : N) : ‖p z‖ = 1 := hp_norm e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + dsimp only [ControlledNeighborhoodConstruction.N] at * + change (N → Circle) + exact fun z => ⟨p z, (mem_sphere_zero_iff_norm).2 (hp_norm z)⟩ + +private theorem hp_cont (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) + (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) (hηψ + : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) : + Continuous (p e he eps S η hSf) := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + let δ := min (δ₀ / 4) (1 / 8) + have hδpos : 0 < δ := hδpos δ₀ hδ₀ + have hδlt : δ < 1 / 4 := hδlt δ₀ hδ₀ + let r := min (η / 8) (eps / 8) + have hrpos : 0 < r := hrpos eps heps η hη + have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → + dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + have hw_cont (c : Set.range e) : Continuous (w c) := hw_cont e eps η c + have hW_cont : Continuous W := hW_cont e eps S η hSf + let N : Set ℂ := {z | 0 < W z} + have hW_N : Continuous (fun z : N => W (z : ℂ)) := hW_N e eps S η hSf + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + have ha_cont (c : Set.range e) : Continuous (fun z : N => a z c) := ha_cont e eps S η hSf c + let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c + have hv_cont : Continuous v := hv_cont e he eps S η hSf + have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z + have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : + dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc + have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c + have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z + have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) + (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + i hi hwi + have hunit (c : Set.range e) : ‖u c‖ = 1 := hunit e he c + have hv_lower (z : N) : 1 - δ < ‖v z‖ := hv_lower e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + have hv_pos (z : N) : 0 < ‖v z‖ := hv_pos e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + let p : N → ℂ := fun z => v z / (‖v z‖ : ℂ) + change (Continuous p) + dsimp [p] + have hden : Continuous (fun z : N => (‖v z‖ : ℂ)) := by fun_prop + apply hv_cont.div hden + intro z + exact_mod_cast (ne_of_gt (hv_pos z)) + +private theorem hphiVal_cont (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < + eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) + (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) : + Continuous (phiVal e he eps heps S δ₀ η hSf hη hδ₀ hηψ) := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + let δ := min (δ₀ / 4) (1 / 8) + have hδpos : 0 < δ := hδpos δ₀ hδ₀ + have hδlt : δ < 1 / 4 := hδlt δ₀ hδ₀ + let r := min (η / 8) (eps / 8) + have hrpos : 0 < r := hrpos eps heps η hη + have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → + dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + have hw_cont (c : Set.range e) : Continuous (w c) := hw_cont e eps η c + have hW_cont : Continuous W := hW_cont e eps S η hSf + let N : Set ℂ := {z | 0 < W z} + have hW_N : Continuous (fun z : N => W (z : ℂ)) := hW_N e eps S η hSf + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + have ha_cont (c : Set.range e) : Continuous (fun z : N => a z c) := ha_cont e eps S η hSf c + let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c + have hv_cont : Continuous v := hv_cont e he eps S η hSf + have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z + have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : + dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc + have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c + have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z + have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) + (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + i hi hwi + have hunit (c : Set.range e) : ‖u c‖ = 1 := hunit e he c + have hv_lower (z : N) : 1 - δ < ‖v z‖ := hv_lower e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + have hv_pos (z : N) : 0 < ‖v z‖ := hv_pos e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + let p : N → ℂ := fun z => v z / (‖v z‖ : ℂ) + have hp_norm (z : N) : ‖p z‖ = 1 := hp_norm e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + let phiVal : N → Circle := fun z => ⟨p z, (mem_sphere_zero_iff_norm).2 (hp_norm z)⟩ + have hp_cont : Continuous p := hp_cont e he eps heps S δ₀ η hSf hη hδ₀ hηψ + change (Continuous phiVal) + dsimp [phiVal] + exact Continuous.subtype_mk hp_cont (fun z => (mem_sphere_zero_iff_norm).2 (hp_norm z)) + +private theorem norm_normalize (x : ℂ) (hx : 0 < ‖x‖) : + ‖x / (‖x‖ : ℂ) - x‖ = |1 - ‖x‖| := by + classical + have hcast : (1 / (‖x‖ : ℂ) - 1) = ((1 / ‖x‖ - 1 : ℝ) : ℂ) := by + push_cast + ring + have hnormcast : ‖((1 / ‖x‖ - 1 : ℝ) : ℂ)‖ = |1 / ‖x‖ - 1| := + RCLike.norm_ofReal _ + calc + ‖x / (‖x‖ : ℂ) - x‖ = ‖x * (1 / (‖x‖ : ℂ) - 1)‖ := by + congr 1 + field_simp + _ = ‖x‖ * |1 / ‖x‖ - 1| := by + rw [norm_mul, hcast, hnormcast] + _ = |1 - ‖x‖| := by + rw [show 1 / ‖x‖ - 1 = (1 - ‖x‖) / ‖x‖ by field_simp] + rw [abs_div, abs_of_pos hx] + field_simp + +private theorem hphi_near (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < + eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) + (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) (z + : (N e eps S η hSf)) : ∀ i ∈ (F e S hSf), 0 < (w e eps η) i (z : ℂ) → + ‖(p e he eps S η hSf) z - (u e he) i‖ < 2 * (δ δ₀) := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + let δ := min (δ₀ / 4) (1 / 8) + have hδpos : 0 < δ := hδpos δ₀ hδ₀ + have hδlt : δ < 1 / 4 := hδlt δ₀ hδ₀ + let r := min (η / 8) (eps / 8) + have hrpos : 0 < r := hrpos eps heps η hη + have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → + dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + let N : Set ℂ := {z | 0 < W z} + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c + have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z + have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : + dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc + have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c + have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z + have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) + (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + i hi hwi + have hunit (c : Set.range e) : ‖u c‖ = 1 := hunit e he c + have hv_lower (z : N) : 1 - δ < ‖v z‖ := hv_lower e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + have hv_pos (z : N) : 0 < ‖v z‖ := hv_pos e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + let p : N → ℂ := fun z => v z / (‖v z‖ : ℂ) + have norm_normalize (x : ℂ) (hx : 0 < ‖x‖) : + ‖x / (‖x‖ : ℂ) - x‖ = |1 - ‖x‖| := norm_normalize x hx + dsimp only [ControlledNeighborhoodConstruction.N] at * + change (∀ i ∈ F, 0 < w i (z : ℂ) → + ‖p z - u i‖ < 2 * δ) + intro i hi hwi + have hnear := hv_close z i hi hwi + have hshift := norm_normalize (v z) (hv_pos z) + have hnormdiff : |1 - ‖v z‖| ≤ ‖v z - u i‖ := by + calc + |1 - ‖v z‖| = |‖v z‖ - 1| := abs_sub_comm _ _ + _ = |‖v z‖ - ‖u i‖| := by rw [hunit i] + _ ≤ ‖v z - u i‖ := abs_norm_sub_norm_le _ _ + have htri : ‖p z - u i‖ ≤ ‖p z - v z‖ + ‖v z - u i‖ := by + calc + ‖p z - u i‖ = ‖(p z - v z) + (v z - u i)‖ := by congr 1; abel + _ ≤ ‖p z - v z‖ + ‖v z - u i‖ := norm_add_le _ _ + have hshift' : ‖p z - v z‖ = |1 - ‖v z‖| := by + simpa [p] using hshift + linarith + +private theorem hphi_circle_close (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps + : 0 < eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ + > 0) (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ + δ₀)) (z : (N e eps S η hSf)) (i : Set.range e) (hi : i ∈ (F e S hSf)) + (hwi : 0 < (w e eps η) i (z : ℂ)) : dist ((phiVal e he eps heps S δ₀ η hSf hη hδ₀ hηψ) z) + ((ψ e he) i) < 2 * (δ δ₀) := by + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let ψ : Set.range e → Circle := f.symm + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + let δ := min (δ₀ / 4) (1 / 8) + have hδpos : 0 < δ := hδpos δ₀ hδ₀ + have hδlt : δ < 1 / 4 := hδlt δ₀ hδ₀ + let r := min (η / 8) (eps / 8) + have hrpos : 0 < r := hrpos eps heps η hη + have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → + dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ + let F : Finset (Set.range e) := hSf.toFinset + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + let N : Set ℂ := {z | 0 < W z} + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c + have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z + have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : + dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc + have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c + have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z + have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) + (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + i hi hwi + have hunit (c : Set.range e) : ‖u c‖ = 1 := hunit e he c + have hv_lower (z : N) : 1 - δ < ‖v z‖ := hv_lower e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + have hv_pos (z : N) : 0 < ‖v z‖ := hv_pos e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + let p : N → ℂ := fun z => v z / (‖v z‖ : ℂ) + have hp_norm (z : N) : ‖p z‖ = 1 := hp_norm e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + let phiVal : N → Circle := fun z => ⟨p z, (mem_sphere_zero_iff_norm).2 (hp_norm z)⟩ + have norm_normalize (x : ℂ) (hx : 0 < ‖x‖) : + ‖x / (‖x‖ : ℂ) - x‖ = |1 - ‖x‖| := norm_normalize x hx + have hphi_near (z : N) : ∀ i ∈ F, 0 < w i (z : ℂ) → + ‖p z - u i‖ < 2 * δ := hphi_near e he eps heps S δ₀ η hSf hη hδ₀ hηψ z + dsimp only [ControlledNeighborhoodConstruction.N] at * + change (dist (phiVal z) (ψ i) < 2 * δ) + have h := hphi_near z i hi hwi + have hIso : Isometry ((↑) : Circle → ℂ) := isometry_subtype_coe + calc + dist (phiVal z) (ψ i) = dist ((phiVal z : Circle) : ℂ) ((ψ i : Circle) : ℂ) := + (hIso.dist_eq (phiVal z) (ψ i)).symm + _ = dist (p z) (u i) := by rfl + _ = ‖p z - u i‖ := dist_eq_norm _ _ + _ < 2 * δ := h + +end ControlledNeighborhoodConstruction + +theorem P3821T1ControlledNeighborhood (e : C(Circle, ℂ)) + (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) : + ∃ N : Set ℂ, IsOpen N ∧ Set.range e ⊆ N ∧ + ∃ phi : C(N, Circle), ∀ z : N, ‖e (phi z) - (z : ℂ)‖ < eps := by +-- BODY + classical + let f : Circle ≃ Set.range e := Equiv.ofBijective + (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by + constructor + · intro x y h + apply he + exact congrArg Subtype.val h + · rintro ⟨z, x, rfl⟩ + exact ⟨x, rfl⟩) + let : T2Space (Set.range e) := inferInstance + have hf : Continuous f := ControlledNeighborhoodConstruction.hf e he + let ψ : Set.range e → Circle := f.symm + have hψc : Continuous ψ := ControlledNeighborhoodConstruction.hψc e he + have hψleft : Function.LeftInverse ψ (fun x : Circle => ⟨e x, ⟨x, rfl⟩⟩) := + ControlledNeighborhoodConstruction.hψleft e he + let u : Set.range e → ℂ := fun k => (ψ k : ℂ) + have hu : Continuous u := ControlledNeighborhoodConstruction.hu e he + have heUC : UniformContinuous e := ControlledNeighborhoodConstruction.heUC e + obtain ⟨δ₀, hδ₀, hδ⟩ := Metric.uniformContinuous_iff.mp heUC (eps / 2) (half_pos heps) + let δ := min (δ₀ / 4) (1 / 8) + have hδpos : 0 < δ := ControlledNeighborhoodConstruction.hδpos δ₀ hδ₀ + have hδlt : δ < 1 / 4 := ControlledNeighborhoodConstruction.hδlt δ₀ hδ₀ + have hKcompact : IsCompact (Set.range e) := ControlledNeighborhoodConstruction.hKcompact e + let : CompactSpace (Set.range e) := isCompact_iff_compactSpace.mp hKcompact + have hψUC : UniformContinuous u := ControlledNeighborhoodConstruction.hψUC e he + obtain ⟨η, hη, hηψ⟩ := Metric.uniformContinuous_iff.mp hψUC δ hδpos + let r := min (η / 8) (eps / 8) + have hrpos : 0 < r := ControlledNeighborhoodConstruction.hrpos eps heps η hη + have hrerr : 2 * r < eps / 2 := ControlledNeighborhoodConstruction.hrerr eps heps η hη + have heclose : ∀ u v : Circle, dist u v < 2 * δ → dist (e u) (e v) < eps / 2 := + ControlledNeighborhoodConstruction.heclose e eps δ₀ hδ hδ₀ + have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → + dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := + ControlledNeighborhoodConstruction.hψclose e he eps heps δ₀ η hη hηψ + have hKcompact' : IsCompact (Set.range e) := ControlledNeighborhoodConstruction.hKcompact' e + let : CompactSpace (Set.range e) := isCompact_iff_compactSpace.mp hKcompact' + obtain ⟨S, hSsub, hSf, hcover⟩ := + (isCompact_univ : IsCompact (Set.univ : Set (Set.range e))).finite_cover_balls + (X := Set.range e) hrpos + let F : Finset (Set.range e) := hSf.toFinset + have hFS : (F : Set (Set.range e)) = S := ControlledNeighborhoodConstruction.hFS e S hSf + have hFsub : (F : Set (Set.range e)) ⊆ Set.univ := ControlledNeighborhoodConstruction.hFsub e S + hSf + have hcover' : (Set.univ : Set (Set.range e)) ⊆ + ⋃ c ∈ (F : Set (Set.range e)), Metric.ball c r := + ControlledNeighborhoodConstruction.hcover' e eps S η hSf hcover + let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) + let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z + have hw_cont (c : Set.range e) : Continuous (w c) := ControlledNeighborhoodConstruction.hw_cont + e eps η c + have hW_cont : Continuous W := ControlledNeighborhoodConstruction.hW_cont e eps S η hSf + let N : Set ℂ := {z | 0 < W z} + have hNopen : IsOpen N := ControlledNeighborhoodConstruction.hNopen e eps S η hSf + have hKN : Set.range e ⊆ N := ControlledNeighborhoodConstruction.hKN e eps heps S η hSf hcover hη + have hW_N : Continuous (fun z : N => W (z : ℂ)) := ControlledNeighborhoodConstruction.hW_N e + eps S η hSf + let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) + have ha_cont (c : Set.range e) : Continuous (fun z : N => a z c) := + ControlledNeighborhoodConstruction.ha_cont e eps S η hSf c + let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c + have hv_cont : Continuous v := ControlledNeighborhoodConstruction.hv_cont e he eps S η hSf + have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := ControlledNeighborhoodConstruction.hactive e + eps S η hSf z + have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : + dist (z : ℂ) (c : ℂ) < 2 * r := ControlledNeighborhoodConstruction.hw_active_dist e eps S η + hSf z c hc + have hψmap (c : Set.range e) : e (ψ c) = c := ControlledNeighborhoodConstruction.hψmap e he c + have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := + ControlledNeighborhoodConstruction.ha_nonneg e eps S η hSf z c + have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := ControlledNeighborhoodConstruction.hsum_a e eps S + η hSf z + have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) + (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := ControlledNeighborhoodConstruction.hv_close e + he eps heps S δ₀ η hSf hη hδ₀ hηψ z i hi hwi + have hunit (c : Set.range e) : ‖u c‖ = 1 := ControlledNeighborhoodConstruction.hunit e he c + have hv_lower (z : N) : 1 - δ < ‖v z‖ := ControlledNeighborhoodConstruction.hv_lower e he eps + heps S δ₀ η hSf hη hδ₀ hηψ z + have hv_pos (z : N) : 0 < ‖v z‖ := ControlledNeighborhoodConstruction.hv_pos e he eps heps S δ₀ + η hSf hη hδ₀ hηψ z + let p : N → ℂ := fun z => v z / (‖v z‖ : ℂ) + have hp_norm (z : N) : ‖p z‖ = 1 := ControlledNeighborhoodConstruction.hp_norm e he eps heps S + δ₀ η hSf hη hδ₀ hηψ z + let phiVal : N → Circle := fun z => ⟨p z, (mem_sphere_zero_iff_norm).2 (hp_norm z)⟩ + have hp_cont : Continuous p := ControlledNeighborhoodConstruction.hp_cont e he eps heps S δ₀ η + hSf hη hδ₀ hηψ + have hphiVal_cont : Continuous phiVal := ControlledNeighborhoodConstruction.hphiVal_cont e he + eps heps S δ₀ η hSf hη hδ₀ hηψ + have norm_normalize (x : ℂ) (hx : 0 < ‖x‖) : + ‖x / (‖x‖ : ℂ) - x‖ = |1 - ‖x‖| := ControlledNeighborhoodConstruction.norm_normalize x hx + have hphi_near (z : N) : ∀ i ∈ F, 0 < w i (z : ℂ) → + ‖p z - u i‖ < 2 * δ := ControlledNeighborhoodConstruction.hphi_near e he eps heps S δ₀ η + hSf hη hδ₀ hηψ z + have hphi_circle_close (z : N) (i : Set.range e) (hi : i ∈ F) + (hwi : 0 < w i (z : ℂ)) : dist (phiVal z) (ψ i) < 2 * δ := + ControlledNeighborhoodConstruction.hphi_circle_close e he eps heps S δ₀ η hSf hη hδ₀ + hηψ z i hi hwi + refine ⟨N, hNopen, hKN, ⟨⟨phiVal, hphiVal_cont⟩, ?_⟩⟩ + intro z + obtain ⟨i, hi, hwi⟩ := hactive z + have hcircle := hphi_circle_close z i hi hwi + have hecurve := heclose (phiVal z) (ψ i) hcircle + have hecenter : e (ψ i) = (i : ℂ) := hψmap i + have hzcenter : dist (z : ℂ) (i : ℂ) < 2 * r := hw_active_dist z i hwi + calc + ‖e (phiVal z) - (z : ℂ)‖ = dist (e (phiVal z)) (z : ℂ) := (dist_eq_norm _ _).symm + _ ≤ dist (e (phiVal z)) (i : ℂ) + dist (i : ℂ) (z : ℂ) := dist_triangle _ _ _ + _ < eps := by + rw [hecenter] at hecurve + have hzcenter' : dist (i : ℂ) (z : ℂ) < 2 * r := by simpa [dist_comm] using hzcenter + linarith [hecurve, hzcenter', hrerr] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndex.lean b/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndex.lean new file mode 100644 index 0000000000..9a43011c7d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndex.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3821T1AngularIncrement + +-- [TABLET NODE: P3821T1LoopIndex] + +/-! +# P3821T1LoopIndex + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Write $\mathbb S^1=\{z\in\mathbb C:|z|=1\}$ and +$q(t)=e^{2\pi\mathrm i t}$. For a continuous map +$g:\mathbb S^1\to\mathbb C$ define the real-valued loop index by +$$ + I(g,p)=\operatorname{P3821\_T1\_LoopIndex}(g,p) + =\frac{\operatorname{P3821\_T1\_AngularIncrement}(g\circ q,p)}{2\pi}. +$$ +The definition applies even when $p$ is on the loop. Its integrality and +the usual index laws are asserted only when the loop avoids $p$. +For a circle-valued map $\alpha$, its angular degree means +$I(\iota\circ\alpha,0)$, where $\iota:\mathbb S^1\hookrightarrow\mathbb C$. +-/ +noncomputable def P3821T1LoopIndex (g : C(Circle, ℂ)) (p : ℂ) : ℝ := +-- BODY + P3821T1AngularIncrement + (g.comp ⟨fun t : unitInterval => Circle.exp (2 * Real.pi * (t : ℝ)), + by fun_prop⟩) p / (2 * Real.pi) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndexLaws.lean b/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndexLaws.lean new file mode 100644 index 0000000000..344a0a43d3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndexLaws.lean @@ -0,0 +1,629 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3821T1LoopIndex +public import LeanPool.ApollonianSuperharmonic.P3821T1AngularIncrementLaws +public import Mathlib.Topology.Algebra.Order.Floor + +-- [TABLET NODE: P3821T1LoopIndexLaws] + +/-! +# P3821T1LoopIndexLaws + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace LoopIndexProof + +private theorem integralIndex : + (∀ (g : C((↑unitInterval : Type), ℂ)), ∀ (p : ℂ), (∀ (t : (↑unitInterval : Type)), (g : + (↑unitInterval : Type) → ℂ) t ≠ p) → ∃ (theta : C((↑unitInterval : Type), ℝ)), (∀ (t : + (↑unitInterval : Type)), Complex.exp ((↑((theta : (↑unitInterval : Type) → ℝ) t) : ℂ) * + Complex.I) = ((g : (↑unitInterval : Type) → ℂ) t - p) / (↑‖(g : (↑unitInterval : Type) → + ℂ) t - p‖ : ℂ)) ∧ (∀ (eta : C((↑unitInterval : Type), ℝ)), (∀ (t : (↑unitInterval : + Type)), Complex.exp ((↑((eta : (↑unitInterval : Type) → ℝ) t) : ℂ) * Complex.I) = ((g : + (↑unitInterval : Type) → ℂ) t - p) / (↑‖(g : (↑unitInterval : Type) → ℂ) t - p‖ : ℂ)) → + (eta : (↑unitInterval : Type) → ℝ) ⟨(1 : ℝ), (by norm_num)⟩ - + (eta : (↑unitInterval : Type) → ℝ) ⟨(0 : ℝ), (by norm_num)⟩ = + P3821T1AngularIncrement g p) ∧ ((g : (↑unitInterval : Type) → ℂ) ⟨(0 : ℝ), + (by norm_num)⟩ = (g : (↑unitInterval : Type) → ℂ) ⟨(1 : ℝ), + (by norm_num)⟩ → ∃ (n : ℤ), P3821T1AngularIncrement g p = (2 : + ℝ) * Real.pi * (↑n : ℝ))) → ((∀ (g : C(Circle, ℂ)), ∀ (p : ℂ), (∀ z, g z ≠ p) → + ∃ n : ℤ, P3821T1LoopIndex g p = n)) := by + classical + intro hlift + let q : C(unitInterval, Circle) := + ⟨fun t => Circle.exp (2 * Real.pi * (t : ℝ)), by fun_prop⟩ + intro g p hg + let γ : C(unitInterval, ℂ) := g.comp q + have havoid : ∀ t, γ t ≠ p := fun t => hg (q t) + have hclose : γ 0 = γ 1 := by + change g (q 0) = g (q 1) + congr 1 + apply Circle.ext + simp only [q, ContinuousMap.coe_mk, Circle.coe_exp] + norm_num + obtain ⟨_, _, _, hclosed⟩ := hlift γ p havoid + obtain ⟨n, hn⟩ := hclosed hclose + refine ⟨n, ?_⟩ + change P3821T1AngularIncrement γ p / (2 * Real.pi) = (n : ℝ) + rw [hn] + have hpi : (2 * Real.pi : ℝ) ≠ 0 := by positivity + field_simp + +private theorem compositionIndex : + (∀ (g : C((↑unitInterval : Type), ℂ)), ∀ (p : ℂ), (∀ (t : (↑unitInterval : Type)), (g : + (↑unitInterval : Type) → ℂ) t ≠ p) → ∃ (theta : C((↑unitInterval : Type), ℝ)), (∀ (t : + (↑unitInterval : Type)), Complex.exp ((↑((theta : (↑unitInterval : Type) → ℝ) t) : ℂ) * + Complex.I) = ((g : (↑unitInterval : Type) → ℂ) t - p) / (↑‖(g : (↑unitInterval : Type) → + ℂ) t - p‖ : ℂ)) ∧ (∀ (eta : C((↑unitInterval : Type), ℝ)), (∀ (t : (↑unitInterval : + Type)), Complex.exp ((↑((eta : (↑unitInterval : Type) → ℝ) t) : ℂ) * Complex.I) = ((g : + (↑unitInterval : Type) → ℂ) t - p) / (↑‖(g : (↑unitInterval : Type) → ℂ) t - p‖ : ℂ)) → + (eta : (↑unitInterval : Type) → ℝ) ⟨(1 : ℝ), (by norm_num)⟩ - + (eta : (↑unitInterval : Type) → ℝ) ⟨(0 : ℝ), (by norm_num)⟩ = + P3821T1AngularIncrement g p) ∧ ((g : (↑unitInterval : Type) → ℂ) ⟨(0 : ℝ), + (by norm_num)⟩ = (g : (↑unitInterval : Type) → ℂ) ⟨(1 : ℝ), + (by norm_num)⟩ → ∃ (n : ℤ), P3821T1AngularIncrement g p = (2 : + ℝ) * Real.pi * (↑n : ℝ))) → ((∀ (g : C(Circle, ℂ)), ∀ (alpha : C(Circle, Circle)), ∀ (p : + ℂ), (∀ z, g z ≠ p) → + P3821T1LoopIndex (g.comp alpha) p = + P3821T1LoopIndex + ((⟨fun z : Circle => (z : ℂ), continuous_subtype_val⟩ : + C(Circle, ℂ)).comp alpha) 0 * + P3821T1LoopIndex g p)) := by + classical + intro hlift + let q : C(unitInterval, Circle) := + ⟨fun t => Circle.exp (2 * Real.pi * (t : ℝ)), by fun_prop⟩ + intro g alpha p hg + let γ : C(unitInterval, ℂ) := g.comp q + have havoid : ∀ t, γ t ≠ p := fun t => hg (q t) + obtain ⟨theta, htheta, hthetaInd, hthetaClosed⟩ := hlift γ p havoid + have hqclose : q 0 = q 1 := by + apply Circle.ext + simp only [q, ContinuousMap.coe_mk, Circle.coe_exp] + norm_num + have hclose : γ 0 = γ 1 := by + change g (q 0) = g (q 1) + exact congrArg g hqclose + obtain ⟨m, hm⟩ := hthetaClosed hclose + have hthetaDiff : theta 1 - theta 0 = 2 * Real.pi * (m : ℝ) := by + calc + theta 1 - theta 0 = P3821T1AngularIncrement γ p := by + simpa using hthetaInd theta htheta + _ = 2 * Real.pi * (m : ℝ) := hm + let c : ℝ := 2 * Real.pi * (m : ℝ) + let clamp01 : ℝ → ℝ := fun x => min 1 (max 0 x) + have hmaxCont : Continuous (fun x : ℝ => max 0 x) := + continuous_max.comp (continuous_const.prodMk continuous_id) + have hclampCont : Continuous clamp01 := by + exact continuous_min.comp (continuous_const.prodMk hmaxCont) + have hclampBounds (x : ℝ) : clamp01 x ∈ Set.Icc (0 : ℝ) 1 := by + constructor + · exact le_min (by norm_num) (le_max_left _ _) + · exact min_le_left _ _ + let f : ℝ → ℝ := fun x => theta ⟨clamp01 x, hclampBounds x⟩ - c * clamp01 x + have hfCont : Continuous f := by + apply Continuous.sub + · exact theta.continuous.comp (Continuous.subtype_mk hclampCont hclampBounds) + · exact continuous_const.mul hclampCont + have hfEnds : f 0 = f 1 := by + have h0 : clamp01 0 = 0 := by simp [clamp01] + have h1 : clamp01 1 = 1 := by simp [clamp01] + simp only [f, h0, h1] + change theta ⟨0, by norm_num⟩ - c * 0 = theta ⟨1, by norm_num⟩ - c * 1 + dsimp [c] + linarith [hthetaDiff] + let Θ : C(ℝ, ℝ) := + ⟨fun x => f (Int.fract x) + c * x, + (ContinuousOn.comp_fract'' hfCont.continuousOn hfEnds).add + (continuous_const.mul continuous_id)⟩ + have hThetaShift (x : ℝ) (k : ℤ) : + Θ (x + (k : ℝ)) = Θ x + c * (k : ℝ) := by + simp only [Θ, ContinuousMap.coe_mk, Int.fract_add_intCast] + ring + have hThetaOn (x : unitInterval) : Θ (x : ℝ) = theta x := by + by_cases hx : (x : ℝ) = 1 + · rw [show x = (1 : unitInterval) from Subtype.ext hx] + have hfract1 : Int.fract (1 : ℝ) = 0 := by norm_num [Int.fract] + change f (Int.fract (1 : ℝ)) + c * 1 = theta (1 : unitInterval) + rw [hfract1] + have hclamp0 : clamp01 0 = 0 := by simp [clamp01] + simp only [f, hclamp0] + simp only [mul_zero, sub_zero, mul_one] + change theta ⟨0, by norm_num⟩ + c = theta ⟨1, by norm_num⟩ + dsimp [c] + linarith [hthetaDiff] + have hxlt : (x : ℝ) < 1 := lt_of_le_of_ne x.2.2 hx + have hfract : Int.fract (x : ℝ) = (x : ℝ) := + Int.fract_eq_self.2 ⟨x.2.1, hxlt⟩ + have hclamp : clamp01 (x : ℝ) = (x : ℝ) := by + simp [clamp01, x.2.1, le_of_lt hxlt] + simp only [Θ, ContinuousMap.coe_mk, hfract, f, hclamp] + ring + let aLoop : C(unitInterval, ℂ) := + ⟨fun t => (alpha (q t) : ℂ), by fun_prop⟩ + have haAvoid : ∀ t, aLoop t ≠ 0 := by + intro t hzero + have := congrArg (fun z : ℂ => ‖z‖) hzero + change ‖(alpha (q t) : ℂ)‖ = ‖(0 : ℂ)‖ at this + rw [Circle.norm_coe, norm_zero] at this + exact one_ne_zero this + obtain ⟨a, ha, haInd, haClosed⟩ := hlift aLoop 0 haAvoid + have haClose : aLoop 0 = aLoop 1 := by + change (alpha (q 0) : ℂ) = (alpha (q 1) : ℂ) + exact congrArg (fun z : Circle => (alpha z : ℂ)) hqclose + obtain ⟨d, hd⟩ := haClosed haClose + have haDiff : a 1 - a 0 = 2 * Real.pi * (d : ℝ) := by + calc + a 1 - a 0 = P3821T1AngularIncrement aLoop 0 := by + simpa using haInd a ha + _ = 2 * Real.pi * (d : ℝ) := hd + have hidxG : P3821T1LoopIndex g p = (m : ℝ) := by + change P3821T1AngularIncrement γ p / (2 * Real.pi) = (m : ℝ) + rw [hm] + field_simp + let j : C(Circle, ℂ) := ⟨fun z => (z : ℂ), continuous_subtype_val⟩ + have hidxAlpha : P3821T1LoopIndex (j.comp alpha) 0 = (d : ℝ) := by + change P3821T1AngularIncrement aLoop 0 / (2 * Real.pi) = (d : ℝ) + rw [hd] + field_simp + let xMap : C(unitInterval, ℝ) := + ⟨fun t => a t / (2 * Real.pi), by fun_prop⟩ + let fracPoint (t : unitInterval) : unitInterval := + ⟨Int.fract (xMap t), Int.fract_nonneg _, (Int.fract_lt_one _).le⟩ + have hpi : (2 * Real.pi : ℝ) ≠ 0 := by positivity + have hax (t : unitInterval) : a t = 2 * Real.pi * xMap t := by + dsimp [xMap] + field_simp + have hfractFloor (t : unitInterval) : + xMap t = Int.fract (xMap t) + (Int.floor (xMap t) : ℝ) := + (Int.fract_add_floor (xMap t)).symm + have hqalpha (t : unitInterval) : q (fracPoint t) = alpha (q t) := by + have haCircle : Circle.exp (a t) = alpha (q t) := by + apply Circle.ext + have ha' : Complex.exp ((a t : ℂ) * Complex.I) = (alpha (q t) : ℂ) := by + simpa only [aLoop, ContinuousMap.coe_mk, sub_zero, Circle.norm_coe, + Complex.ofReal_one, div_one] using ha t + simpa only [Circle.coe_exp] using ha' + calc + q (fracPoint t) = Circle.exp (2 * Real.pi * Int.fract (xMap t)) := by + rfl + _ = Circle.exp (2 * Real.pi * Int.fract (xMap t) + + 2 * Real.pi * (Int.floor (xMap t) : ℝ)) := by + calc + _ = Circle.exp (2 * Real.pi * Int.fract (xMap t)) * 1 := by simp + _ = Circle.exp (2 * Real.pi * Int.fract (xMap t)) * + Circle.exp (2 * Real.pi * (Int.floor (xMap t) : ℝ)) := by + rw [Circle.exp_two_pi_mul_int] + _ = Circle.exp (2 * Real.pi * Int.fract (xMap t) + + 2 * Real.pi * (Int.floor (xMap t) : ℝ)) := by rw [Circle.exp_add] + _ = Circle.exp (a t) := by + congr 1 + calc + 2 * Real.pi * Int.fract (xMap t) + 2 * Real.pi * (Int.floor (xMap t) : ℝ) = + 2 * Real.pi * (Int.fract (xMap t) + (Int.floor (xMap t) : ℝ)) := by ring + _ = 2 * Real.pi * xMap t := by rw [← hfractFloor t] + _ = a t := (hax t).symm + _ = alpha (q t) := haCircle + let eta : C(unitInterval, ℝ) := Θ.comp xMap + have heta (t : unitInterval) : + Complex.exp ((eta t : ℂ) * Complex.I) = + (g (alpha (q t)) - p) / (‖g (alpha (q t)) - p‖ : ℂ) := by + let k := Int.floor (xMap t) + have hThetaVal : Θ (xMap t) = theta (fracPoint t) + c * (k : ℝ) := by + calc + Θ (xMap t) = Θ (Int.fract (xMap t) + (k : ℝ)) := by + exact congrArg Θ (hfractFloor t) + _ = Θ (Int.fract (xMap t)) + c * (k : ℝ) := hThetaShift _ _ + _ = theta (fracPoint t) + c * (k : ℝ) := by + change Θ (fracPoint t : ℝ) + c * (k : ℝ) = _ + rw [hThetaOn] + have hc : c * (k : ℝ) = 2 * Real.pi * ((m * k : ℤ) : ℝ) := by + dsimp [c] + push_cast + ring + have hcircle : Circle.exp (Θ (xMap t)) = Circle.exp (theta (fracPoint t)) := by + rw [hThetaVal, Circle.exp_add, hc, Circle.exp_two_pi_mul_int, mul_one] + have hcomplex : Complex.exp ((Θ (xMap t) : ℂ) * Complex.I) = + Complex.exp ((theta (fracPoint t) : ℂ) * Complex.I) := by + have := congrArg (fun z : Circle => (z : ℂ)) hcircle + simpa only [Circle.coe_exp] using this + rw [show eta t = Θ (xMap t) from rfl, hcomplex, htheta (fracPoint t)] + rw [show γ (fracPoint t) = g (alpha (q t)) by + change g (q (fracPoint t)) = g (alpha (q t)) + rw [hqalpha t]] + have hetaAll : ∀ t, Complex.exp ((eta t : ℂ) * Complex.I) = + (((g.comp alpha).comp q t) - p) / + (‖((g.comp alpha).comp q t) - p‖ : ℂ) := by + intro t + simpa only [ContinuousMap.comp_apply] using heta t + have hcompAvoid : ∀ t, ((g.comp alpha).comp q) t ≠ p := by + intro t + exact hg (alpha (q t)) + obtain ⟨_, _, hcompInd, _⟩ := hlift ((g.comp alpha).comp q) p hcompAvoid + have hEndShift : xMap 1 = xMap 0 + (d : ℝ) := by + dsimp [xMap] + field_simp + nlinarith [haDiff] + have hetaDiff : eta 1 - eta 0 = c * (d : ℝ) := by + change Θ (xMap 1) - Θ (xMap 0) = _ + rw [hEndShift, hThetaShift] + dsimp [c] + ring + have hcompInc : + P3821T1AngularIncrement ((g.comp alpha).comp q) p = eta 1 - eta 0 := by + exact (hcompInd eta hetaAll).symm + have hidxComp : P3821T1LoopIndex (g.comp alpha) p = (m : ℝ) * (d : ℝ) := by + change P3821T1AngularIncrement ((g.comp alpha).comp q) p / + (2 * Real.pi) = (m : ℝ) * (d : ℝ) + rw [hcompInc, hetaDiff] + dsimp [c] + field_simp + change P3821T1LoopIndex (g.comp alpha) p = + P3821T1LoopIndex (j.comp alpha) 0 * P3821T1LoopIndex g p + rw [hidxComp, hidxAlpha, hidxG] + ring + +namespace HomotopyIndexProof + +private theorem hlocal : + (∀ (g : C((↑unitInterval : Type), ℂ)), ∀ (p : ℂ), (∀ (t : (↑unitInterval : Type)), (g : + (↑unitInterval : Type) → ℂ) t ≠ p) → ∃ (theta : C((↑unitInterval : Type), ℝ)), (∀ (t : + (↑unitInterval : Type)), Complex.exp ((↑((theta : (↑unitInterval : Type) → ℝ) t) : ℂ) * + Complex.I) = ((g : (↑unitInterval : Type) → ℂ) t - p) / (↑‖(g : (↑unitInterval : Type) → + ℂ) t - p‖ : ℂ)) ∧ (∀ (eta : C((↑unitInterval : Type), ℝ)), (∀ (t : (↑unitInterval : + Type)), Complex.exp ((↑((eta : (↑unitInterval : Type) → ℝ) t) : ℂ) * Complex.I) = ((g : + (↑unitInterval : Type) → ℂ) t - p) / (↑‖(g : (↑unitInterval : Type) → ℂ) t - p‖ : ℂ)) → + (eta : (↑unitInterval : Type) → ℝ) ⟨(1 : ℝ), by norm_num⟩ - (eta : (↑unitInterval : Type) + → ℝ) ⟨(0 + : ℝ), by norm_num⟩ = P3821T1AngularIncrement g p) ∧ ((g : (↑unitInterval : Type) → ℂ) + ⟨(0 : ℝ), + by norm_num⟩ = (g : (↑unitInterval : Type) → ℂ) ⟨(1 : ℝ), by norm_num⟩ → ∃ (n : ℤ), + P3821T1AngularIncrement + g p = (2 : ℝ) * Real.pi * (↑n : ℝ))) → ( + ∀ (H : C((↑unitInterval : Type) × Circle, ℂ)), ∀ (p : ℂ), (∀ (s : (↑unitInterval : Type)), ∀ + (z : Circle), (H : (↑unitInterval : Type) × Circle → ℂ) (s, z) ≠ p) → (∀ (avoid : ∀ (x : + unitInterval × Circle), H x ≠ p), + let normed : C(unitInterval × Circle, ℂ) := + ⟨fun x => (H x - p) / (‖H x - p‖ : ℂ), by + apply Continuous.div + · exact H.continuous.sub continuous_const + · exact Complex.continuous_ofReal.comp (H.continuous.sub continuous_const).norm + · intro x + exact Complex.ofReal_ne_zero.mpr + (norm_ne_zero_iff.mpr (sub_ne_zero.mpr (avoid x)))⟩ + (∀ (x : unitInterval × Circle), ‖normed x‖ = 1) → ((UniformContinuous normed) → ( + let loopAt : unitInterval → C(Circle, ℂ) := fun s => + ⟨fun z => H (s, z), by fun_prop⟩ + let indexAt (s : unitInterval) : ℝ := P3821T1LoopIndex (loopAt s) p + ∀ (s0 : unitInterval), ∃ δ > 0, ∀ s, dist s s0 < δ → indexAt s = indexAt s0)))) := by + classical + intro hlift H p hH avoid normed hnormed hUC loopAt indexAt s0 + let q : C(unitInterval, Circle) := + ⟨fun t => Circle.exp (2 * Real.pi * (t : ℝ)), by fun_prop⟩ + obtain ⟨δ, hδ, hmod⟩ := (Metric.uniformContinuous_iff.mp hUC) 1 zero_lt_one + refine ⟨δ, hδ, ?_⟩ + intro s hs + let ratio (z : Circle) : ℂ := normed (s, z) / normed (s0, z) + have hclose (z : Circle) : dist (normed (s, z)) (normed (s0, z)) < 1 := by + have hprod : dist (s, z) (s0, z) < δ := by simpa [Prod.dist_eq] using hs + exact hmod hprod + have hratioNorm (z : Circle) : ‖ratio z‖ = 1 := by + simp [ratio, hnormed] + have hratioNear (z : Circle) : ‖ratio z - 1‖ < 1 := by + have hden : normed (s0, z) ≠ 0 := by + intro hz + have := congrArg (fun w : ℂ => ‖w‖) hz + rw [hnormed] at this + norm_num at this + have heq : ratio z - 1 = (normed (s, z) - normed (s0, z)) / normed (s0, z) := by + dsimp [ratio] + field_simp + rw [heq, norm_div, hnormed] + simpa [dist_eq_norm] using hclose z + have hratioRe (z : Circle) : 0 < (ratio z).re := by + have hb := Complex.abs_re_le_norm (ratio z - 1) + have hb' : |(ratio z).re - 1| < 1 := by + have := lt_of_le_of_lt hb (hratioNear z) + simpa using this + rcases abs_lt.mp hb' with ⟨hlo, hhi⟩ + have hre : (ratio z).re - 1 > -1 := by linarith + linarith + have hratioCont : Continuous ratio := by + apply Continuous.div + · exact normed.continuous.comp (continuous_const.prodMk continuous_id) + · exact normed.continuous.comp (continuous_const.prodMk continuous_id) + · intro z hz + have := congrArg (fun w : ℂ => ‖w‖) hz + rw [hnormed] at this + norm_num at this + have hslit (z : Circle) : ratio z ∈ Complex.slitPlane := by + exact Complex.mem_slitPlane_iff_not_le_zero.mpr + (Complex.not_le_zero_iff.mpr (Or.inl (hratioRe z))) + let argRatio : C(Circle, ℝ) := + ⟨fun z => Complex.arg (ratio z), + continuousOn_univ.mp (Complex.continuousOn_arg.comp hratioCont.continuousOn + (by intro z hz; exact hslit z))⟩ + have hargLift (z : Circle) : + Complex.exp ((argRatio z : ℂ) * Complex.I) = ratio z := by + have h := Complex.norm_mul_exp_arg_mul_I (ratio z) + simpa [argRatio, hratioNorm z] using h + let path0 : C(unitInterval, ℂ) := ⟨fun t => H (s0, q t), by fun_prop⟩ + let pathS : C(unitInterval, ℂ) := ⟨fun t => H (s, q t), by fun_prop⟩ + have hAvoid0 : ∀ t, path0 t ≠ p := fun t => hH s0 (q t) + have hAvoidS : ∀ t, pathS t ≠ p := fun t => hH s (q t) + obtain ⟨theta0, htheta0, hind0, _⟩ := hlift path0 p hAvoid0 + obtain ⟨_, _, hindS, _⟩ := hlift pathS p hAvoidS + let argLoop : C(unitInterval, ℝ) := argRatio.comp q + let eta : C(unitInterval, ℝ) := + ⟨fun t => theta0 t + argLoop t, theta0.continuous.add argLoop.continuous⟩ + have heta (t : unitInterval) : + Complex.exp ((eta t : ℂ) * Complex.I) = + (pathS t - p) / (‖pathS t - p‖ : ℂ) := by + have hratio := hargLift (q t) + have hbase := htheta0 t + have hu0 : normed (s0, q t) = + (path0 t - p) / (‖path0 t - p‖ : ℂ) := by rfl + have hus : normed (s, q t) = + (pathS t - p) / (‖pathS t - p‖ : ℂ) := by rfl + have hmul : ratio (q t) * normed (s0, q t) = normed (s, q t) := by + have hne : normed (s0, q t) ≠ 0 := by + intro hz + have := congrArg (fun w : ℂ => ‖w‖) hz + rw [hnormed] at this + norm_num at this + change (normed (s, q t) / normed (s0, q t)) * normed (s0, q t) = _ + exact div_mul_cancel₀ _ hne + have hmul' : normed (s0, q t) * ratio (q t) = normed (s, q t) := by + rw [mul_comm, hmul] + dsimp [eta, argLoop] + rw [Complex.ofReal_add, add_mul, Complex.exp_add, hratio, hbase] + rw [← hu0, ← hus, hmul'] + have hqends : q 0 = q 1 := by + apply Circle.ext + simp only [q, ContinuousMap.coe_mk, Circle.coe_exp] + norm_num + have hargEnds : argLoop 0 = argLoop 1 := by + change argRatio (q 0) = argRatio (q 1) + rw [hqends] + have hetaEnds : eta 1 - eta 0 = theta0 1 - theta0 0 := by + dsimp [eta] + rw [hargEnds] + ring + have hinc : P3821T1AngularIncrement pathS p = + P3821T1AngularIncrement path0 p := by + calc + P3821T1AngularIncrement pathS p = eta 1 - eta 0 := + (hindS eta heta).symm + _ = theta0 1 - theta0 0 := hetaEnds + _ = P3821T1AngularIncrement path0 p := hind0 theta0 htheta0 + change P3821T1AngularIncrement ((loopAt s).comp q) p / (2 * Real.pi) = + P3821T1AngularIncrement ((loopAt s0).comp q) p / (2 * Real.pi) + rw [show (loopAt s).comp q = pathS by ext t; rfl, + show (loopAt s0).comp q = path0 by ext t; rfl, hinc] + +private theorem hnoLT : + ∀ (H : C((↑unitInterval : Type) × Circle, ℂ)), ∀ (p : ℂ), + let loopAt : unitInterval → C(Circle, ℂ) := fun s => + ⟨fun z => H (s, z), by fun_prop⟩ + let indexAt (s : unitInterval) : ℝ := P3821T1LoopIndex (loopAt s) p + (∀ (s : unitInterval), ∃ n : ℤ, indexAt s = (n : ℝ)) → ( + let f : unitInterval → ℝ := indexAt + (Continuous f) → ((∀ (n : ℤ), ∀ (s : unitInterval), f s ≠ (n : ℝ) + 1 / 2) → ( + let zero : unitInterval := ⟨0, by norm_num, by norm_num⟩ + let one : unitInterval := ⟨1, by norm_num, by norm_num⟩ + (IsPreconnected (Set.univ : Set unitInterval)) → (¬ f zero < f one)))) := by + classical + intro H p loopAt indexAt indexAt_int f hfCont hnotMid zero one hpc hlt + obtain ⟨n0, hn0⟩ := indexAt_int zero + obtain ⟨n1, hn1⟩ := indexAt_int one + change f zero = (n0 : ℝ) at hn0 + change f one = (n1 : ℝ) at hn1 + rw [hn0, hn1] at hlt + have hnlt : n0 < n1 := by + exact_mod_cast hlt + have hstep : n0 + 1 ≤ n1 := by omega + have hstepR : (n0 : ℝ) + 1 ≤ (n1 : ℝ) := by exact_mod_cast hstep + have hfx : (n0 : ℝ) + 1 / 2 < f one := by + rw [hn1] + linarith + have hall := IsPreconnected.lt_of_ne (s := (Set.univ : Set unitInterval)) + (f := f) (b := (n0 : ℝ) + 1 / 2) hpc hfCont.continuousOn + (fun s _ => hnotMid n0 s) + (Exists.intro one (And.intro (Set.mem_univ one) hfx)) (Set.mem_univ zero) + rw [hn0] at hall + linarith + +private theorem hnoGT : + ∀ (H : C((↑unitInterval : Type) × Circle, ℂ)), ∀ (p : ℂ), + let loopAt : unitInterval → C(Circle, ℂ) := fun s => + ⟨fun z => H (s, z), by fun_prop⟩ + let indexAt (s : unitInterval) : ℝ := P3821T1LoopIndex (loopAt s) p + (∀ (s : unitInterval), ∃ n : ℤ, indexAt s = (n : ℝ)) → ( + let f : unitInterval → ℝ := indexAt + (Continuous f) → ((∀ (n : ℤ), ∀ (s : unitInterval), f s ≠ (n : ℝ) + 1 / 2) → ( + let zero : unitInterval := ⟨0, by norm_num, by norm_num⟩ + let one : unitInterval := ⟨1, by norm_num, by norm_num⟩ + (IsPreconnected (Set.univ : Set unitInterval)) → (¬ f one < f zero)))) := by + classical + intro H p loopAt indexAt indexAt_int f hfCont hnotMid zero one hpc hgt + obtain ⟨n0, hn0⟩ := indexAt_int zero + obtain ⟨n1, hn1⟩ := indexAt_int one + change f zero = (n0 : ℝ) at hn0 + change f one = (n1 : ℝ) at hn1 + rw [hn0, hn1] at hgt + have hnlt : n1 < n0 := by + exact_mod_cast hgt + have hstep : n1 + 1 ≤ n0 := by omega + have hstepR : (n1 : ℝ) + 1 ≤ (n0 : ℝ) := by exact_mod_cast hstep + have hfx : (n1 : ℝ) + 1 / 2 < f zero := by + rw [hn0] + linarith + have hall := IsPreconnected.lt_of_ne (s := (Set.univ : Set unitInterval)) + (f := f) (b := (n1 : ℝ) + 1 / 2) hpc hfCont.continuousOn + (fun s _ => hnotMid n1 s) + (Exists.intro zero (And.intro (Set.mem_univ zero) hfx)) (Set.mem_univ one) + rw [hn1] at hall + linarith + +end HomotopyIndexProof + +private theorem homotopyIndex : + (∀ (g : C((↑unitInterval : Type), ℂ)), ∀ (p : ℂ), (∀ (t : (↑unitInterval : Type)), (g : + (↑unitInterval : Type) → ℂ) t ≠ p) → ∃ (theta : C((↑unitInterval : Type), ℝ)), (∀ (t : + (↑unitInterval : Type)), Complex.exp ((↑((theta : (↑unitInterval : Type) → ℝ) t) : ℂ) * + Complex.I) = ((g : (↑unitInterval : Type) → ℂ) t - p) / (↑‖(g : (↑unitInterval : Type) → + ℂ) t - p‖ : ℂ)) ∧ (∀ (eta : C((↑unitInterval : Type), ℝ)), (∀ (t : (↑unitInterval : + Type)), Complex.exp ((↑((eta : (↑unitInterval : Type) → ℝ) t) : ℂ) * Complex.I) = ((g : + (↑unitInterval : Type) → ℂ) t - p) / (↑‖(g : (↑unitInterval : Type) → ℂ) t - p‖ : ℂ)) → + (eta : (↑unitInterval : Type) → ℝ) ⟨(1 : ℝ), (by norm_num)⟩ - + (eta : (↑unitInterval : Type) → ℝ) ⟨(0 : ℝ), (by norm_num)⟩ = + P3821T1AngularIncrement g p) ∧ ((g : (↑unitInterval : Type) → ℂ) ⟨(0 : ℝ), + (by norm_num)⟩ = (g : (↑unitInterval : Type) → ℂ) ⟨(1 : ℝ), + (by norm_num)⟩ → ∃ (n : ℤ), P3821T1AngularIncrement g p = (2 : + ℝ) * Real.pi * (↑n : ℝ))) → ((∀ (H : C(unitInterval × Circle, ℂ)), ∀ (p : ℂ), (∀ s z, H + (s, z) ≠ p) → + P3821T1LoopIndex + ⟨fun z => H (⟨0, by norm_num⟩, z), by fun_prop⟩ p = + P3821T1LoopIndex + ⟨fun z => H (⟨1, by norm_num⟩, z), by fun_prop⟩ p)) := by + classical + intro hlift + let q : C(unitInterval, Circle) := + ⟨fun t => Circle.exp (2 * Real.pi * (t : ℝ)), by fun_prop⟩ + intro H p hH + let avoid (x : unitInterval × Circle) : H x ≠ p := hH x.1 x.2 + let normed : C(unitInterval × Circle, ℂ) := + ⟨fun x => (H x - p) / (‖H x - p‖ : ℂ), by + apply Continuous.div + · exact H.continuous.sub continuous_const + · exact Complex.continuous_ofReal.comp (H.continuous.sub continuous_const).norm + · intro x + exact Complex.ofReal_ne_zero.mpr + (norm_ne_zero_iff.mpr (sub_ne_zero.mpr (avoid x)))⟩ + have hnormed (x : unitInterval × Circle) : ‖normed x‖ = 1 := by + change ‖(H x - p) / (‖H x - p‖ : ℂ)‖ = 1 + simp only [norm_div, Complex.norm_real, Real.norm_eq_abs, abs_norm] + exact div_self (norm_ne_zero_iff.mpr (sub_ne_zero.mpr (avoid x))) + have hUC : UniformContinuous normed := + CompactSpace.uniformContinuous_of_continuous normed.continuous + let loopAt : unitInterval → C(Circle, ℂ) := fun s => + ⟨fun z => H (s, z), by fun_prop⟩ + let indexAt (s : unitInterval) : ℝ := P3821T1LoopIndex (loopAt s) p + have indexAt_int (s : unitInterval) : ∃ n : ℤ, indexAt s = (n : ℝ) := by + let pathS : C(unitInterval, ℂ) := ⟨fun t => H (s, q t), by fun_prop⟩ + obtain ⟨thetaS, _, _, hclosedS⟩ := hlift + pathS p (fun t => hH s (q t)) + have hqcloseS : q 0 = q 1 := by + apply Circle.ext + simp only [q, ContinuousMap.coe_mk, Circle.coe_exp] + norm_num + have hcloseS : pathS 0 = pathS 1 := + congrArg (fun z : Circle => H (s, z)) hqcloseS + obtain ⟨n, hn⟩ := hclosedS hcloseS + refine ⟨n, ?_⟩ + change P3821T1AngularIncrement ((loopAt s).comp q) p / + (2 * Real.pi) = (n : ℝ) + rw [show (loopAt s).comp q = pathS by ext t; rfl] + rw [hn] + field_simp + have hlocal (s0 : unitInterval) : + ∃ δ > 0, ∀ s, dist s s0 < δ → indexAt s = indexAt s0 := HomotopyIndexProof.hlocal hlift H p + hH avoid hnormed hUC s0 + let f : unitInterval → ℝ := indexAt + have hfCont : Continuous f := by + rw [continuous_iff_continuousAt] + intro s0 + obtain ⟨δ, hδ, hl⟩ := hlocal s0 + change Filter.Tendsto f (nhds s0) (nhds (f s0)) + have hc : Filter.Tendsto (fun _ : unitInterval => f s0) + (nhds s0) (nhds (f s0)) := tendsto_const_nhds + have heq : (fun _ : unitInterval => f s0) =ᶠ[nhds s0] f := by + filter_upwards [Metric.ball_mem_nhds s0 hδ] with s hs + exact (hl s hs).symm + exact (Filter.tendsto_congr' heq).mp hc + have hfractIndex (s : unitInterval) : Int.fract (f s) = 0 := by + obtain ⟨n, hn⟩ := indexAt_int s + change f s = (n : ℝ) at hn + rw [hn] + simp + have hfractHalf (n : ℤ) : Int.fract ((n : ℝ) + 1 / 2) = 1 / 2 := by + rw [Int.fract_intCast_add] + norm_num [Int.fract] + have hnotMid (n : ℤ) (s : unitInterval) : f s ≠ (n : ℝ) + 1 / 2 := by + intro heq + have hzero := hfractIndex s + have hfrac := congrArg Int.fract heq + rw [hzero, hfractHalf] at hfrac + norm_num at hfrac + let zero : unitInterval := ⟨0, by norm_num, by norm_num⟩ + let one : unitInterval := ⟨1, by norm_num, by norm_num⟩ + have hpc : IsPreconnected (Set.univ : Set unitInterval) := + PreconnectedSpace.isPreconnected_univ + have hnoLT : ¬ f zero < f one := HomotopyIndexProof.hnoLT H p indexAt_int hfCont hnotMid hpc + have hnoGT : ¬ f one < f zero := HomotopyIndexProof.hnoGT H p indexAt_int hfCont hnotMid hpc + have hends : f zero = f one := by + rcases lt_trichotomy (f zero) (f one) with hlt | heq | hgt + · exact (hnoLT hlt).elim + · exact heq + · exact (hnoGT hgt).elim + change P3821T1LoopIndex (loopAt zero) p = + P3821T1LoopIndex (loopAt one) p + exact hends + +end LoopIndexProof + +theorem P3821T1LoopIndexLaws : + (∀ (g : C(Circle, ℂ)) (p : ℂ), (∀ z, g z ≠ p) → + ∃ n : ℤ, P3821T1LoopIndex g p = n) ∧ + (∀ (g : C(Circle, ℂ)) (alpha : C(Circle, Circle)) (p : ℂ), + (∀ z, g z ≠ p) → + P3821T1LoopIndex (g.comp alpha) p = + P3821T1LoopIndex + ((⟨fun z : Circle => (z : ℂ), continuous_subtype_val⟩ : + C(Circle, ℂ)).comp alpha) 0 * + P3821T1LoopIndex g p) ∧ + (∀ (H : C(unitInterval × Circle, ℂ)) (p : ℂ), + (∀ s z, H (s, z) ≠ p) → + P3821T1LoopIndex + ⟨fun z => H (⟨0, by norm_num⟩, z), by fun_prop⟩ p = + P3821T1LoopIndex + ⟨fun z => H (⟨1, by norm_num⟩, z), by fun_prop⟩ p) := by +-- BODY + classical + let q : C(unitInterval, Circle) := + ⟨fun t => Circle.exp (2 * Real.pi * (t : ℝ)), by fun_prop⟩ + rcases P3821T1AngularIncrementLaws with ⟨hlift, _, _⟩ + have integralIndex : + (∀ (g : C(Circle, ℂ)) (p : ℂ), (∀ z, g z ≠ p) → + ∃ n : ℤ, P3821T1LoopIndex g p = n) := LoopIndexProof.integralIndex hlift + have compositionIndex : + (∀ (g : C(Circle, ℂ)) (alpha : C(Circle, Circle)) (p : ℂ), + (∀ z, g z ≠ p) → + P3821T1LoopIndex (g.comp alpha) p = + P3821T1LoopIndex + ((⟨fun z : Circle => (z : ℂ), continuous_subtype_val⟩ : + C(Circle, ℂ)).comp alpha) 0 * + P3821T1LoopIndex g p) := LoopIndexProof.compositionIndex hlift + have homotopyIndex : + (∀ (H : C(unitInterval × Circle, ℂ)) (p : ℂ), + (∀ s z, H (s, z) ≠ p) → + P3821T1LoopIndex + ⟨fun z => H (⟨0, by norm_num⟩, z), by fun_prop⟩ p = + P3821T1LoopIndex + ⟨fun z => H (⟨1, by norm_num⟩, z), by fun_prop⟩ p) := LoopIndexProof.homotopyIndex hlift + exact ⟨integralIndex, compositionIndex, homotopyIndex⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean new file mode 100644 index 0000000000..dab34c9dfc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean @@ -0,0 +1,877 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation +public import Mathlib.Analysis.SpecialFunctions.Complex.Circle + +-- [TABLET NODE: P3821T1ThreeArcCircle] + +/-! +# P3821T1ThreeArcCircle + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ThreeArcCircleLemmas + +private theorem hq₀ : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (h₀ : (↑(Set.Icc (0 : ℝ) + 1) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + Continuous q₀ := by + classical + intro ι P a b h₀ clamp q₀ + dsimp [q₀, clamp] + fun_prop + +private theorem hq₁ : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₁ : (↑(Set.Icc (0 : ℝ) + 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + Continuous q₁ := by + classical + intro ι P b c h₁ clamp q₁ + dsimp [q₁, clamp] + fun_prop + +private theorem hq₂ : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (c : ι), ∀ (h₂ : (↑(Set.Icc (0 : ℝ) + 1) : Type) ≃ₜ (↑(P.edgeArc c a) : Type)), + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + Continuous q₂ := by + classical + intro ι P a c h₂ clamp q₂ + dsimp [q₂, clamp] + fun_prop + +private theorem hmid : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₁ : + (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ((↑((h₁ : (↑(Set.Icc (0 : ℝ) + 1) : Type) → (↑(P.edgeArc b c) : Type)) ⟨1, (by norm_num)⟩) : ℝ × ℝ) = P.position c) → ∀ + (h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc c a) : Type)), ((↑((h₂ : (↑(Set.Icc + (0 : ℝ) 1) : Type) → (↑(P.edgeArc c a) : Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position + c) → + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + (Continuous q₁) → (Continuous q₂) → + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + Continuous mid := by + classical + intro ι P a b c h₁ h₁c h₂ h₂c clamp q₁ q₂ hq₁ hq₂ mid + apply continuous_if_le continuous_id continuous_const hq₁.continuousOn hq₂.continuousOn + intro x hx + have hx' : x = 2 := hx + subst x + have hleft : clamp (2 - 1) = ⟨1, by norm_num⟩ := by + apply Subtype.ext + norm_num [clamp] + have hright : clamp (2 - 2) = ⟨0, by norm_num⟩ := by + apply Subtype.ext + norm_num [clamp] + simp only [q₁, q₂, hleft, hright] + exact h₁c.trans h₂c.symm + +private theorem hf : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₀ : + (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ((↑((h₀ : (↑(Set.Icc (0 : ℝ) + 1) : Type) → (↑(P.edgeArc a b) : Type)) ⟨1, (by norm_num)⟩) : ℝ × ℝ) = P.position b) → ∀ + (h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ((↑((h₁ : (↑(Set.Icc + (0 : ℝ) 1) : Type) → (↑(P.edgeArc b c) : Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position + b) → ∀ (h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc c a) : Type)), + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + (Continuous q₀) → + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + (Continuous mid) → + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + Continuous f := by + classical + intro ι P a b c h₀ h₀b h₁ h₁b h₂ clamp q₀ q₁ q₂ hq₀ mid hmid f + apply continuous_if_le continuous_id continuous_const hq₀.continuousOn hmid.continuousOn + intro x hx + have hx' : x = 1 := hx + subst x + have hleft : clamp 1 = ⟨1, by norm_num⟩ := by + apply Subtype.ext + norm_num [clamp] + have hright : clamp (1 - 1) = ⟨0, by norm_num⟩ := by + apply Subtype.ext + norm_num [clamp] + simp only [mid, + ite_eq_left (by norm_num : (1 : ℝ) ≤ 2), q₀, q₁, hleft, hright] + exact h₀b.trans h₁b.symm + +private theorem hf0 : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₀ : + (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ((↑((h₀ : (↑(Set.Icc (0 : ℝ) + 1) : Type) → (↑(P.edgeArc a b) : Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position a) → ∀ + (h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ∀ (h₂ : (↑(Set.Icc (0 + : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc c a) : Type)), ((↑((h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) → + (↑(P.edgeArc c a) : Type)) ⟨1, (by norm_num)⟩) : ℝ × ℝ) = P.position a) → + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + f 0 = f 3 := by + classical + intro ι P a b c h₀ h₀a h₁ h₂ h₂a clamp q₀ q₁ q₂ mid f + have hleft : clamp 0 = ⟨0, by norm_num⟩ := by + apply Subtype.ext + norm_num [clamp] + have hright : clamp (3 - 2) = ⟨1, by norm_num⟩ := by + apply Subtype.ext + norm_num [clamp] + simp only [f, ite_eq_left (by norm_num : (0 : ℝ) ≤ 1), + ite_eq_right (by norm_num : ¬ (3 : ℝ) ≤ 1), mid, + ite_eq_right (by norm_num : ¬ (3 : ℝ) ≤ 2), q₀, q₂, hright, hleft] + exact h₀a.trans h₂a.symm + +private theorem hℓc : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₀ : + (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ∀ (h₁ : (↑(Set.Icc (0 : ℝ) + 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ∀ (h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ + (↑(P.edgeArc c a) : Type)), + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + (Continuous f) → (f 0 = f 3) → ∀ [this : Fact (0 < (3 : ℝ))], + let ℓ : AddCircle (3 : ℝ) → Real × Real := AddCircle.liftIco 3 0 f + Continuous ℓ := by + classical + intro ι P a b c h₀ h₁ h₂ clamp q₀ q₁ q₂ mid f hf hf0 this ℓ + apply AddCircle.liftIco_zero_continuous hf0 + exact hf.continuousOn + +private theorem clamp_eq_self : + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + ∀ (x : ℝ), ∀ (hx : x ∈ Set.Icc (0 : ℝ) 1), clamp x = ⟨x, hx⟩ := by + classical + intro clamp x hx + apply Subtype.ext + simp [clamp, hx.1, hx.2] + +private theorem fseg₀ : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₀ : + (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ∀ (h₁ : (↑(Set.Icc (0 : ℝ) + 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ∀ (h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ + (↑(P.edgeArc c a) : Type)), + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + (∀ (x : ℝ), ∀ (hx : x ∈ Set.Icc (0 : ℝ) 1), clamp x = ⟨x, hx⟩) → ∀ (x : ℝ), ∀ (hx : 0 ≤ x), ∀ + (h₁x : x ≤ 1), f x = (h₀ ⟨x, ⟨hx, h₁x⟩⟩ : P.edgeArc a b) := by + classical + intro ι P a b c h₀ h₁ h₂ clamp q₀ q₁ q₂ mid f clamp_eq_self x hx h₁x + simp [f, q₀, ite_eq_left h₁x, clamp_eq_self x ⟨hx, h₁x⟩] + +private theorem fseg₁ : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₀ : + (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ∀ (h₁ : (↑(Set.Icc (0 : ℝ) + 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ∀ (h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ + (↑(P.edgeArc c a) : Type)), + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + (∀ (x : ℝ), ∀ (hx : x ∈ Set.Icc (0 : ℝ) 1), clamp x = ⟨x, hx⟩) → ∀ (x : ℝ), ∀ (h₁x : 1 < x), + ∀ (h₂x : x ≤ 2), f x = (h₁ ⟨x - 1, ⟨by linarith [h₁x], by linarith [h₂x]⟩⟩ : P.edgeArc b + c) := by + classical + intro ι P a b c h₀ h₁ h₂ clamp q₀ q₁ q₂ mid f clamp_eq_self x h₁x h₂x + have hc : clamp (x - 1) = ⟨x - 1, ⟨by linarith, by linarith⟩⟩ := + clamp_eq_self (x - 1) ⟨by linarith, by linarith⟩ + simp [f, mid, q₁, not_le.mpr h₁x, ite_eq_left h₂x, hc] + +private theorem fseg₂ : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₀ : + (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ∀ (h₁ : (↑(Set.Icc (0 : ℝ) + 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ∀ (h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ + (↑(P.edgeArc c a) : Type)), + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + (∀ (x : ℝ), ∀ (hx : x ∈ Set.Icc (0 : ℝ) 1), clamp x = ⟨x, hx⟩) → ∀ (x : ℝ), ∀ (h₂x : 2 < x), + ∀ (h₃x : x < 3), f x = (h₂ ⟨x - 2, ⟨by linarith [h₂x], by linarith [h₃x]⟩⟩ : P.edgeArc c + a) := by + classical + intro ι P a b c h₀ h₁ h₂ clamp q₀ q₁ q₂ mid f clamp_eq_self x h₂x h₃x + have hc : clamp (x - 2) = ⟨x - 2, ⟨by linarith, by linarith⟩⟩ := + clamp_eq_self (x - 2) ⟨by linarith, by linarith⟩ + simp [f, mid, q₂, not_le.mpr (by linarith : 1 < x), + not_le.mpr h₂x, hc] + +private theorem hint₀₁ : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), (a ≠ b) → (b ≠ + c) → (c ≠ a) → (P.adjacent a b) → (P.adjacent b c) → ∀ (h₀ : (↑(Set.Icc (0 : ℝ) 1) : + Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ((↑((h₀ : (↑(Set.Icc (0 : ℝ) 1) : Type) → + (↑(P.edgeArc a b) : Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position a) → ((↑((h₀ : + (↑(Set.Icc (0 : ℝ) 1) : Type) → (↑(P.edgeArc a b) : Type)) ⟨1, (by norm_num)⟩) : ℝ × ℝ) = + P.position b) → ∀ (h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), + ((↑((h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) → (↑(P.edgeArc b c) : Type)) ⟨0, (by norm_num)⟩) + : ℝ × ℝ) = P.position b) → ((↑((h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) → (↑(P.edgeArc b c) : + Type)) ⟨1, (by norm_num)⟩) : ℝ × ℝ) = P.position c) → ∀ (h₂ : (↑(Set.Icc (0 : ℝ) 1) : + Type) ≃ₜ (↑(P.edgeArc c a) : Type)), + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + (Continuous q₀) → (Continuous q₁) → + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + (Continuous mid) → + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + (Continuous f) → (f 0 = f 3) → ∀ [this : Fact (0 < (3 : ℝ))], + let ℓ : AddCircle (3 : ℝ) → Real × Real := AddCircle.liftIco 3 0 f + (Continuous ℓ) → (∀ (x : ℝ), ∀ (hx : 0 ≤ x), ∀ (h₁x : x ≤ 1), f x = (h₀ ⟨x, ⟨hx, h₁x⟩⟩ : + P.edgeArc a b)) → (∀ (x : ℝ), ∀ (h₁x : 1 < x), ∀ (h₂x : x ≤ 2), f x = (h₁ ⟨x - 1, ⟨by + linarith [h₁x], by linarith [h₂x]⟩⟩ : P.edgeArc b c)) → (∀ (x : ℝ), ∀ (h₂x : 2 < x), ∀ + (h₃x : x < 3), f x = (h₂ ⟨x - 2, ⟨by linarith [h₂x], by linarith [h₃x]⟩⟩ : P.edgeArc c + a)) → P.edgeArc a b ∩ P.edgeArc b c = {P.position b} := by + classical + intro ι P a b c hab hbc hca eab ebc h₀ h₀a h₀b h₁ h₁b h₁c h₂ clamp q₀ q₁ q₂ hq₀ hq₁ mid hmid f + hf hf0 this ℓ hℓc fseg₀ fseg₁ fseg₂ + have hne : ({a, b} : Set ι) ≠ {b, c} := by + intro hh + have ha : a ∈ ({b, c} : Set ι) := by rw [← hh]; simp + simp [hab, hca.symm] at ha + have hcommon : ({a, b} : Set ι) ∩ {b, c} = {b} := by + ext x + simp only [Set.mem_inter_iff, Set.mem_insert_iff, Set.mem_singleton_iff] + constructor + · rintro ⟨h, k⟩ + rcases h with h | h + · subst x + rcases k with k | k + · exact (hab k).elim + · exact (hca k.symm).elim + · subst x + rfl + · rintro rfl + simp + rw [P.arc_intersections a b b c eab ebc hne] + rw [hcommon] + simp + +private theorem hint₁₂ : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), (a ≠ b) → (b ≠ + c) → (c ≠ a) → (P.adjacent b c) → (P.adjacent c a) → ∀ (h₀ : (↑(Set.Icc (0 : ℝ) 1) : + Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ∀ (h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ + (↑(P.edgeArc b c) : Type)), ((↑((h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) → (↑(P.edgeArc b c) : + Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position b) → ((↑((h₁ : (↑(Set.Icc (0 : ℝ) 1) : + Type) → (↑(P.edgeArc b c) : Type)) ⟨1, (by norm_num)⟩) : ℝ × ℝ) = P.position c) → ∀ (h₂ : + (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc c a) : Type)), ((↑((h₂ : (↑(Set.Icc (0 + : ℝ) + 1) : Type) → (↑(P.edgeArc c a) : Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position c) → + ((↑((h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) → (↑(P.edgeArc c a) : Type)) ⟨1, (by norm_num)⟩) + : ℝ × ℝ) = P.position a) → + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + (Continuous q₁) → (Continuous q₂) → + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + (Continuous mid) → + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + (Continuous f) → (f 0 = f 3) → ∀ [this : Fact (0 < (3 : ℝ))], + let ℓ : AddCircle (3 : ℝ) → Real × Real := AddCircle.liftIco 3 0 f + (Continuous ℓ) → (∀ (x : ℝ), ∀ (hx : 0 ≤ x), ∀ (h₁x : x ≤ 1), f x = (h₀ ⟨x, ⟨hx, h₁x⟩⟩ : + P.edgeArc a b)) → (∀ (x : ℝ), ∀ (h₁x : 1 < x), ∀ (h₂x : x ≤ 2), f x = (h₁ ⟨x - 1, ⟨by + linarith [h₁x], by linarith [h₂x]⟩⟩ : P.edgeArc b c)) → (∀ (x : ℝ), ∀ (h₂x : 2 < x), ∀ + (h₃x : x < 3), f x = (h₂ ⟨x - 2, ⟨by linarith [h₂x], by linarith [h₃x]⟩⟩ : P.edgeArc c + a)) → (P.edgeArc a b ∩ P.edgeArc b c = {P.position b}) → P.edgeArc b c ∩ P.edgeArc c a = + {P.position c} := by + classical + intro ι P a b c hab hbc hca ebc eca h₀ h₁ h₁b h₁c h₂ h₂c h₂a clamp q₀ q₁ q₂ hq₁ hq₂ mid hmid f + hf hf0 this ℓ hℓc fseg₀ fseg₁ fseg₂ hint₀₁ + have hne : ({b, c} : Set ι) ≠ {c, a} := by + intro hh + have hb : b ∈ ({c, a} : Set ι) := by rw [← hh]; simp + simp [hbc, hab.symm] at hb + have hcommon : ({b, c} : Set ι) ∩ {c, a} = {c} := by + ext x + simp only [Set.mem_inter_iff, Set.mem_insert_iff, Set.mem_singleton_iff] + constructor + · rintro ⟨h, k⟩ + rcases h with h | h + · subst x + rcases k with k | k + · exact (hbc k).elim + · exact (hab k.symm).elim + · subst x + rfl + · rintro rfl + simp + rw [P.arc_intersections b c c a ebc eca hne] + rw [hcommon] + simp + +private theorem hint₂₀ : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), (a ≠ b) → (b ≠ + c) → (c ≠ a) → (P.adjacent a b) → (P.adjacent c a) → ∀ (h₀ : (↑(Set.Icc (0 : ℝ) 1) : + Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ((↑((h₀ : (↑(Set.Icc (0 : ℝ) 1) : Type) → + (↑(P.edgeArc a b) : Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position a) → ((↑((h₀ : + (↑(Set.Icc (0 : ℝ) 1) : Type) → (↑(P.edgeArc a b) : Type)) ⟨1, (by norm_num)⟩) : ℝ × ℝ) = + P.position b) → ∀ (h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ∀ + (h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc c a) : Type)), ((↑((h₂ : (↑(Set.Icc + (0 : ℝ) 1) : Type) → (↑(P.edgeArc c a) : Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position + c) → ((↑((h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) → (↑(P.edgeArc c a) : Type)) ⟨1, (by + norm_num)⟩) : ℝ × ℝ) = P.position a) → + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + (Continuous q₀) → (Continuous q₂) → + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + (Continuous mid) → + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + (Continuous f) → (f 0 = f 3) → ∀ [this : Fact (0 < (3 : ℝ))], + let ℓ : AddCircle (3 : ℝ) → Real × Real := AddCircle.liftIco 3 0 f + (Continuous ℓ) → (∀ (x : ℝ), ∀ (hx : 0 ≤ x), ∀ (h₁x : x ≤ 1), f x = (h₀ ⟨x, ⟨hx, h₁x⟩⟩ : + P.edgeArc a b)) → (∀ (x : ℝ), ∀ (h₁x : 1 < x), ∀ (h₂x : x ≤ 2), f x = (h₁ ⟨x - 1, ⟨by + linarith [h₁x], by linarith [h₂x]⟩⟩ : P.edgeArc b c)) → (∀ (x : ℝ), ∀ (h₂x : 2 < x), ∀ + (h₃x : x < 3), f x = (h₂ ⟨x - 2, ⟨by linarith [h₂x], by linarith [h₃x]⟩⟩ : P.edgeArc c + a)) → (P.edgeArc a b ∩ P.edgeArc b c = {P.position b}) → (P.edgeArc b c ∩ P.edgeArc c a = + {P.position c}) → P.edgeArc c a ∩ P.edgeArc a b = {P.position a} := by + classical + intro ι P a b c hab hbc hca eab eca h₀ h₀a h₀b h₁ h₂ h₂c h₂a clamp q₀ q₁ q₂ hq₀ hq₂ mid hmid f + hf hf0 this ℓ hℓc fseg₀ fseg₁ fseg₂ hint₀₁ hint₁₂ + have hne : ({c, a} : Set ι) ≠ {a, b} := by + intro hh + have hc : c ∈ ({a, b} : Set ι) := by rw [← hh]; simp + simp [hca, hbc.symm] at hc + have hcommon : ({c, a} : Set ι) ∩ {a, b} = {a} := by + ext x + simp only [Set.mem_inter_iff, Set.mem_insert_iff, Set.mem_singleton_iff] + constructor + · rintro ⟨h, k⟩ + rcases h with h | h + · subst x + rcases k with k | k + · exact (hca k).elim + · exact (hbc k.symm).elim + · subst x + rfl + · rintro rfl + simp + rw [P.arc_intersections c a a b eca eab hne] + rw [hcommon] + simp + +private theorem cross₀₁ : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₀ : + (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ((↑((h₀ : (↑(Set.Icc (0 : ℝ) + 1) : Type) → (↑(P.edgeArc a b) : Type)) ⟨1, (by norm_num)⟩) : ℝ × ℝ) = P.position b) → ∀ + (h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ((↑((h₁ : (↑(Set.Icc + (0 : ℝ) 1) : Type) → (↑(P.edgeArc b c) : Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position + b) → ∀ (h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc c a) : Type)), + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + (∀ (x : ℝ), ∀ (hx : 0 ≤ x), ∀ (h₁x : x ≤ 1), f x = (h₀ ⟨x, ⟨hx, h₁x⟩⟩ : P.edgeArc a b)) → (∀ + (x : ℝ), ∀ (h₁x : 1 < x), ∀ (h₂x : x ≤ 2), f x = (h₁ ⟨x - 1, ⟨by linarith [h₁x], by + linarith [h₂x]⟩⟩ : P.edgeArc b c)) → (P.edgeArc a b ∩ P.edgeArc b c = {P.position b}) → ∀ + {x : ℝ}, ∀ {y : ℝ}, (0 ≤ x) → (x ≤ 1) → (1 < y) → (y ≤ 2) → (f x = f y) → x = y := by + classical + intro ι P a b c h₀ h₀b h₁ h₁b h₂ clamp q₀ q₁ q₂ mid f fseg₀ fseg₁ hint₀₁ x y hx₀ hx₁ hy₁ hy₂ hxy + rw [fseg₀ x hx₀ hx₁, fseg₁ y hy₁ hy₂] at hxy + let u : Set.Icc (0 : ℝ) 1 := ⟨x, ⟨hx₀, hx₁⟩⟩ + let v : Set.Icc (0 : ℝ) 1 := ⟨y - 1, ⟨by linarith, by linarith⟩⟩ + have hmem₀ : ((h₀ u : P.edgeArc a b) : Real × Real) ∈ P.edgeArc a b := (h₀ u).property + have hmem₁ : ((h₁ v : P.edgeArc b c) : Real × Real) ∈ P.edgeArc b c := (h₁ v).property + have hmem : ((h₀ u : P.edgeArc a b) : Real × Real) ∈ + P.edgeArc a b ∩ P.edgeArc b c := ⟨hmem₀, hxy ▸ hmem₁⟩ + have hpos : ((h₀ u : P.edgeArc a b) : Real × Real) = P.position b := by + have hm : ((h₀ u : P.edgeArc a b) : Real × Real) ∈ + ({P.position b} : Set (Real × Real)) := by + rw [← hint₀₁] + exact hmem + simpa using hm + have hu : u = ⟨1, by norm_num⟩ := by + apply h₀.injective + apply Subtype.ext + exact hpos.trans h₀b.symm + have hv : v = ⟨0, by norm_num⟩ := by + apply h₁.injective + apply Subtype.ext + exact hxy.symm.trans hpos |>.trans h₁b.symm + have hx : x = 1 := congrArg Subtype.val hu + have hy : y - 1 = 0 := congrArg Subtype.val hv + linarith + +private theorem cross₁₂ : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₀ : + (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ∀ (h₁ : (↑(Set.Icc (0 : ℝ) + 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ((↑((h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) → + (↑(P.edgeArc b c) : Type)) ⟨1, (by norm_num)⟩) : ℝ × ℝ) = P.position c) → ∀ (h₂ : + (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc c a) : Type)), ((↑((h₂ : (↑(Set.Icc (0 + : ℝ) + 1) : Type) → (↑(P.edgeArc c a) : Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position c) → + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + (∀ (x : ℝ), ∀ (h₁x : 1 < x), ∀ (h₂x : x ≤ 2), f x = (h₁ ⟨x - 1, ⟨by linarith [h₁x], by + linarith [h₂x]⟩⟩ : P.edgeArc b c)) → (∀ (x : ℝ), ∀ (h₂x : 2 < x), ∀ (h₃x : x < 3), f x = + (h₂ ⟨x - 2, ⟨by linarith [h₂x], by linarith [h₃x]⟩⟩ : P.edgeArc c a)) → (P.edgeArc b c ∩ + P.edgeArc c a = {P.position c}) → ∀ {x : ℝ}, ∀ {y : ℝ}, (1 < x) → (x ≤ 2) → (2 < y) → (y + < 3) → (f x = f y) → x = y := by + classical + intro ι P a b c h₀ h₁ h₁c h₂ h₂c clamp q₀ q₁ q₂ mid f fseg₁ fseg₂ hint₁₂ x y hx₁ hx₂ hy₂ hy₃ hxy + rw [fseg₁ x hx₁ hx₂, fseg₂ y hy₂ hy₃] at hxy + let u : Set.Icc (0 : ℝ) 1 := ⟨x - 1, ⟨by linarith, by linarith⟩⟩ + let v : Set.Icc (0 : ℝ) 1 := ⟨y - 2, ⟨by linarith, by linarith⟩⟩ + have hmem₁ : ((h₁ u : P.edgeArc b c) : Real × Real) ∈ P.edgeArc b c := (h₁ u).property + have hmem₂ : ((h₂ v : P.edgeArc c a) : Real × Real) ∈ P.edgeArc c a := (h₂ v).property + have hmem : ((h₁ u : P.edgeArc b c) : Real × Real) ∈ + P.edgeArc b c ∩ P.edgeArc c a := ⟨hmem₁, hxy ▸ hmem₂⟩ + have hpos : ((h₁ u : P.edgeArc b c) : Real × Real) = P.position c := by + have hm : ((h₁ u : P.edgeArc b c) : Real × Real) ∈ + ({P.position c} : Set (Real × Real)) := by + rw [← hint₁₂] + exact hmem + simpa using hm + have hu : u = ⟨1, by norm_num⟩ := by + apply h₁.injective + apply Subtype.ext + exact hpos.trans h₁c.symm + have hv : v = ⟨0, by norm_num⟩ := by + apply h₂.injective + apply Subtype.ext + exact hxy.symm.trans hpos |>.trans h₂c.symm + have hx : x - 1 = 1 := congrArg Subtype.val hu + have hy : y - 2 = 0 := congrArg Subtype.val hv + linarith + +private theorem cross₀₂ : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₀ : + (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ((↑((h₀ : (↑(Set.Icc (0 : ℝ) + 1) : Type) → (↑(P.edgeArc a b) : Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position a) → ∀ + (h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ∀ (h₂ : (↑(Set.Icc (0 + : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc c a) : Type)), ((↑((h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) → + (↑(P.edgeArc c a) : Type)) ⟨1, (by norm_num)⟩) : ℝ × ℝ) = P.position a) → + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + (∀ (x : ℝ), ∀ (hx : 0 ≤ x), ∀ (h₁x : x ≤ 1), f x = (h₀ ⟨x, ⟨hx, h₁x⟩⟩ : P.edgeArc a b)) → (∀ + (x : ℝ), ∀ (h₂x : 2 < x), ∀ (h₃x : x < 3), f x = (h₂ ⟨x - 2, ⟨by linarith [h₂x], by + linarith [h₃x]⟩⟩ : P.edgeArc c a)) → (P.edgeArc c a ∩ P.edgeArc a b = {P.position a}) → ∀ + {x : ℝ}, ∀ {y : ℝ}, (0 ≤ x) → (x ≤ 1) → (2 < y) → (y < 3) → (f x = f y) → False := by + classical + intro ι P a b c h₀ h₀a h₁ h₂ h₂a clamp q₀ q₁ q₂ mid f fseg₀ fseg₂ hint₂₀ x y hx₀ hx₁ hy₂ hy₃ hxy + rw [fseg₀ x hx₀ hx₁, fseg₂ y hy₂ hy₃] at hxy + let u : Set.Icc (0 : ℝ) 1 := ⟨x, ⟨hx₀, hx₁⟩⟩ + let v : Set.Icc (0 : ℝ) 1 := ⟨y - 2, ⟨by linarith, by linarith⟩⟩ + have hmem₀ : ((h₀ u : P.edgeArc a b) : Real × Real) ∈ P.edgeArc a b := (h₀ u).property + have hmem₂ : ((h₂ v : P.edgeArc c a) : Real × Real) ∈ P.edgeArc c a := (h₂ v).property + have hmem : ((h₀ u : P.edgeArc a b) : Real × Real) ∈ + P.edgeArc a b ∩ P.edgeArc c a := ⟨hmem₀, hxy ▸ hmem₂⟩ + have hpos : ((h₀ u : P.edgeArc a b) : Real × Real) = P.position a := by + have hm : ((h₀ u : P.edgeArc a b) : Real × Real) ∈ + ({P.position a} : Set (Real × Real)) := by + rw [← hint₂₀] + exact ⟨hxy ▸ hmem₂, hmem₀⟩ + simpa using hm + have hu : u = ⟨0, by norm_num⟩ := by + apply h₀.injective + apply Subtype.ext + exact hpos.trans h₀a.symm + have hx : x = 0 := congrArg Subtype.val hu + have hv : v = ⟨1, by norm_num⟩ := by + apply h₂.injective + apply Subtype.ext + exact hxy.symm.trans hpos |>.trans h₂a.symm + have hy : y - 2 = 1 := congrArg Subtype.val hv + linarith + +private theorem hf_inj : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₀ : + (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ∀ (h₁ : (↑(Set.Icc (0 : ℝ) + 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ∀ (h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ + (↑(P.edgeArc c a) : Type)), + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + (∀ (x : ℝ), ∀ (hx : 0 ≤ x), ∀ (h₁x : x ≤ 1), f x = (h₀ ⟨x, ⟨hx, h₁x⟩⟩ : P.edgeArc a b)) → (∀ + (x : ℝ), ∀ (h₁x : 1 < x), ∀ (h₂x : x ≤ 2), f x = (h₁ ⟨x - 1, ⟨by linarith [h₁x], by + linarith [h₂x]⟩⟩ : P.edgeArc b c)) → (∀ (x : ℝ), ∀ (h₂x : 2 < x), ∀ (h₃x : x < 3), f x = + (h₂ ⟨x - 2, ⟨by linarith [h₂x], by linarith [h₃x]⟩⟩ : P.edgeArc c a)) → (∀ {x : ℝ}, ∀ {y + : ℝ}, (0 ≤ x) → (x ≤ 1) → (1 < y) → (y ≤ 2) → (f x = f y) → x = y) → (∀ {x : ℝ}, ∀ {y + : ℝ}, (1 < x) → (x ≤ 2) → (2 < y) → (y < 3) → (f x = f y) → x = y) → (∀ {x : ℝ}, ∀ {y + : ℝ}, (0 ≤ x) → (x ≤ 1) → (2 < y) → (y < 3) → (f x = f y) → False) → ∀ x y : ℝ, x ∈ + Set.Ico (0 + : ℝ) 3 → y ∈ Set.Ico 0 3 → + f x = f y → x = y := by + classical + intro ι P a b c h₀ h₁ h₂ clamp q₀ q₁ q₂ mid f fseg₀ fseg₁ fseg₂ cross₀₁ cross₁₂ cross₀₂ x y hx + hy hxy + rcases hx with ⟨hx₀, hx₃⟩ + rcases hy with ⟨hy₀, hy₃⟩ + by_cases hx₁ : x ≤ 1 + · by_cases hy₁ : y ≤ 1 + · rw [fseg₀ x hx₀ hx₁, fseg₀ y hy₀ hy₁] at hxy + have heq : (⟨x, ⟨hx₀, hx₁⟩⟩ : Set.Icc (0 : ℝ) 1) = ⟨y, ⟨hy₀, hy₁⟩⟩ := by + apply h₀.injective + exact Subtype.ext hxy + exact congrArg Subtype.val heq + · by_cases hy₂ : y ≤ 2 + · exact cross₀₁ hx₀ hx₁ (by linarith) hy₂ hxy + · exact cross₀₂ hx₀ hx₁ (by linarith) hy₃ hxy |>.elim + · by_cases hx₂ : x ≤ 2 + · by_cases hy₁ : y ≤ 1 + · have h := cross₀₁ hy₀ hy₁ (by linarith) hx₂ hxy.symm + exact h.symm + · by_cases hy₂ : y ≤ 2 + · rw [fseg₁ x (by linarith) hx₂, fseg₁ y (by linarith) hy₂] at hxy + have heq : (⟨x - 1, ⟨by linarith, by linarith⟩⟩ : Set.Icc (0 : ℝ) 1) = + ⟨y - 1, ⟨by linarith, by linarith⟩⟩ := by + apply h₁.injective + exact Subtype.ext hxy + have hv := congrArg Subtype.val heq + linarith + · exact cross₁₂ (by linarith) hx₂ (by linarith) hy₃ hxy + · by_cases hy₁ : y ≤ 1 + · exact (cross₀₂ hy₀ hy₁ (by linarith) hx₃ hxy.symm).elim + · by_cases hy₂ : y ≤ 2 + · have h := cross₁₂ (by linarith) hy₂ (by linarith) hx₃ hxy.symm + exact h.symm + · rw [fseg₂ x (by linarith) hx₃, fseg₂ y (by linarith) hy₃] at hxy + have heq : (⟨x - 2, ⟨by linarith, by linarith⟩⟩ : Set.Icc (0 : ℝ) 1) = + ⟨y - 2, ⟨by linarith, by linarith⟩⟩ := by + apply h₂.injective + exact Subtype.ext hxy + have hv := congrArg Subtype.val heq + linarith + +private theorem lift_eq : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₀ : + (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ∀ (h₁ : (↑(Set.Icc (0 : ℝ) + 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ∀ (h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ + (↑(P.edgeArc c a) : Type)), + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + ∀ [this : Fact (0 < (3 : ℝ))], + let ℓ : AddCircle (3 : ℝ) → Real × Real := AddCircle.liftIco 3 0 f + ∀ (x : ℝ), (x ∈ Set.Ico (0 : ℝ) 3) → ℓ (x : AddCircle (3 : ℝ)) = f x := by + classical + intro ι P a b c h₀ h₁ h₂ clamp q₀ q₁ q₂ mid f this ℓ x hx + dsimp [ℓ] + apply AddCircle.liftIco_coe_apply + simpa using hx + +end ThreeArcCircleLemmas + +namespace ThreeArcCircleRange + +private theorem hrangeℓ : + ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₀ : + (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ((↑((h₀ : (↑(Set.Icc + (0 : ℝ) (1 : ℝ)) : Type) → (↑(P.edgeArc a b) : Type)) ⟨(0 : ℝ), + (by norm_num)⟩) : ℝ × ℝ) = P.position a) → ((↑((h₀ : (↑(Set.Icc (0 : ℝ) (1 + : ℝ)) : Type) → (↑(P.edgeArc a b) : Type)) ⟨(1 : ℝ), (by norm_num)⟩) : ℝ × + ℝ) = P.position b) → ∀ (h₁ : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) ≃ₜ (↑(P.edgeArc b c) : + Type)), ((↑((h₁ : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → (↑(P.edgeArc b c) : Type)) ⟨(0 : + ℝ), (by norm_num)⟩) : ℝ × ℝ) = P.position b) → ((↑((h₁ : (↑(Set.Icc (0 : ℝ) + (1 : ℝ)) : Type) → (↑(P.edgeArc b c) : Type)) ⟨(1 : ℝ), (by norm_num)⟩) : ℝ + × ℝ) = P.position c) → ∀ (h₂ : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) ≃ₜ (↑(P.edgeArc c a) : + Type)), ((↑((h₂ : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → (↑(P.edgeArc c a) : Type)) ⟨(0 : + ℝ), (by norm_num)⟩) : ℝ × ℝ) = P.position c) → ((↑((h₂ : (↑(Set.Icc (0 : ℝ) + (1 : ℝ)) : Type) → (↑(P.edgeArc c a) : Type)) ⟨(1 : ℝ), (by norm_num)⟩) : ℝ + × ℝ) = P.position a) → + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + ∀ [this : Fact ((0 : ℝ) < (3 : ℝ))], + let ℓ : AddCircle (3 : ℝ) → Real × Real := AddCircle.liftIco 3 0 f + (∀ (x : ℝ), ∀ (hx : 0 ≤ x), ∀ (h₁x : x ≤ 1), f x = (h₀ ⟨x, ⟨hx, h₁x⟩⟩ : P.edgeArc a b)) → (∀ + (x : ℝ), ∀ (h₁x : 1 < x), ∀ (h₂x : x ≤ 2), f x = (h₁ ⟨x - 1, ⟨by linarith [h₁x], by + linarith [h₂x]⟩⟩ : P.edgeArc b c)) → (∀ (x : ℝ), ∀ (h₂x : 2 < x), ∀ (h₃x : x < 3), f x = + (h₂ ⟨x - 2, ⟨by linarith [h₂x], by linarith [h₃x]⟩⟩ : P.edgeArc c a)) → (∀ (x : ℝ), (x ∈ + Set.Ico (0 : ℝ) 3) → ℓ (x : AddCircle (3 : ℝ)) = f x) → Set.range ℓ = + P.edgeArc a b ∪ P.edgeArc b c ∪ P.edgeArc c a := by + classical + intro ι P a b c h₀ h₀a h₀b h₁ h₁b h₁c h₂ h₂c h₂a clamp q₀ q₁ q₂ mid f this ℓ fseg₀ fseg₁ fseg₂ + lift_eq + ext z + constructor + · rintro ⟨y, rfl⟩ + let u := AddCircle.equivIco (3 : ℝ) 0 y + have hu : (u : ℝ) ∈ Set.Ico (0 : ℝ) 3 := by simpa using u.property + have hy : ℓ y = f (u : ℝ) := by + rw [← AddCircle.coe_equivIco (p := (3 : ℝ)) (a := (0 : ℝ)) (y := y)] + exact lift_eq (u : ℝ) hu + rw [hy] + by_cases hu₁ : (u : ℝ) ≤ 1 + · rw [fseg₀ (u : ℝ) u.property.1 hu₁] + exact Or.inl (Or.inl (h₀ _).property) + · by_cases hu₂ : (u : ℝ) ≤ 2 + · rw [fseg₁ (u : ℝ) (by linarith) hu₂] + exact Or.inl (Or.inr (h₁ _).property) + · rw [fseg₂ (u : ℝ) (by linarith) hu.2] + exact Or.inr (h₂ _).property + · intro hz + simp only [Set.mem_union] at hz + rcases hz with (hz | hz) | hz + · obtain ⟨t, ht⟩ := h₀.surjective ⟨z, hz⟩ + refine ⟨(t : ℝ), ?_⟩ + have htIco : (t : ℝ) ∈ Set.Ico (0 : ℝ) 3 := + ⟨t.property.1, by linarith [t.property.2]⟩ + rw [lift_eq (t : ℝ) htIco] + rw [fseg₀ (t : ℝ) (by linarith [t.property.1]) (by linarith [t.property.2])] + simpa using congrArg Subtype.val ht + · obtain ⟨t, ht⟩ := h₁.surjective ⟨z, hz⟩ + by_cases ht0 : (t : ℝ) = 0 + · have hzv : z = P.position b := by + have ht' : t = ⟨0, by norm_num⟩ := Subtype.ext ht0 + have ht'' := ht + rw [ht'] at ht'' + have := congrArg Subtype.val ht'' + rw [h₁b] at this + exact this.symm + refine ⟨(1 : ℝ), ?_⟩ + rw [lift_eq 1 (by norm_num)] + rw [fseg₀ 1 (by norm_num) (by norm_num)] + change ((h₀ (1 : Set.Icc (0 : ℝ) 1) : P.edgeArc a b) : Real × Real) = z + exact h₀b.trans hzv.symm + · have htpos : 0 < (t : ℝ) := lt_of_le_of_ne t.property.1 (Ne.symm ht0) + let x := (t : ℝ) + 1 + refine ⟨x, ?_⟩ + have hx₁ : 1 < x := by dsimp [x]; linarith + have hx₂ : x ≤ 2 := by dsimp [x]; linarith [t.property.2] + rw [lift_eq x (by constructor <;> dsimp [x] <;> linarith [t.property.1, t.property.2])] + rw [fseg₁ x hx₁ hx₂] + have hparam : (⟨x - 1, by constructor <;> linarith⟩ : Set.Icc (0 : ℝ) 1) = t := by + apply Subtype.ext + dsimp [x] + ring + rw [hparam] + simpa using congrArg Subtype.val ht + · obtain ⟨t, ht⟩ := h₂.surjective ⟨z, hz⟩ + by_cases ht0 : (t : ℝ) = 0 + · have hzv : z = P.position c := by + have ht' : t = ⟨0, by norm_num⟩ := Subtype.ext ht0 + have ht'' := ht + rw [ht'] at ht'' + have := congrArg Subtype.val ht'' + rw [h₂c] at this + exact this.symm + refine ⟨(2 : ℝ), ?_⟩ + rw [lift_eq 2 (by norm_num)] + rw [fseg₁ 2 (by norm_num) (by norm_num)] + have hparam : (⟨(2 : ℝ) - 1, by norm_num⟩ : Set.Icc (0 : ℝ) 1) = + ⟨1, by norm_num⟩ := by apply Subtype.ext; norm_num + rw [hparam] + simpa [hzv] using h₁c + · by_cases ht1 : (t : ℝ) = 1 + · have hzv : z = P.position a := by + have ht' : t = ⟨1, by norm_num⟩ := Subtype.ext ht1 + have ht'' := ht + rw [ht'] at ht'' + have := congrArg Subtype.val ht'' + rw [h₂a] at this + exact this.symm + refine ⟨(0 : ℝ), ?_⟩ + rw [lift_eq 0 (by norm_num)] + rw [fseg₀ 0 (by norm_num) (by norm_num)] + change ((h₀ (0 : Set.Icc (0 : ℝ) 1) : P.edgeArc a b) : Real × Real) = z + exact h₀a.trans hzv.symm + · have htpos : 0 < (t : ℝ) := lt_of_le_of_ne t.property.1 (Ne.symm ht0) + have htne : (t : ℝ) ≠ 1 := ht1 + have htlt : (t : ℝ) < 1 := lt_of_le_of_ne t.property.2 htne + let x := (t : ℝ) + 2 + refine ⟨x, ?_⟩ + have hx₂ : 2 < x := by dsimp [x]; linarith + have hx₃ : x < 3 := by dsimp [x]; linarith + rw [lift_eq x (by constructor <;> dsimp [x] <;> linarith [t.property.1, + t.property.2])] + rw [fseg₂ x hx₂ hx₃] + have hparam : (⟨x - 2, by constructor <;> linarith⟩ : Set.Icc (0 : ℝ) 1) = t := by + apply Subtype.ext + dsimp [x] + ring + rw [hparam] + simpa using congrArg Subtype.val ht + +end ThreeArcCircleRange + +theorem P3821T1ThreeArcCircle {ι : Type} (P : PlaneTriangulation ι) + (a b c : ι) (hab : a ≠ b) (hbc : b ≠ c) (hca : c ≠ a) + (eab : P.adjacent a b) (ebc : P.adjacent b c) (eca : P.adjacent c a) : + ∃ e : C(Circle, Real × Real), Function.Injective e ∧ + Set.range e = P.edgeArc a b ∪ P.edgeArc b c ∪ P.edgeArc c a := by +-- BODY + obtain ⟨h₀, h₀a, h₀b⟩ := P.arc_homeomorph a b eab + obtain ⟨h₁, h₁b, h₁c⟩ := P.arc_homeomorph b c ebc + obtain ⟨h₂, h₂c, h₂a⟩ := P.arc_homeomorph c a eca + let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := + ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ + let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) + let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) + let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) + have hq₀ : Continuous q₀ := ThreeArcCircleLemmas.hq₀ ι P a b h₀ + have hq₁ : Continuous q₁ := ThreeArcCircleLemmas.hq₁ ι P b c h₁ + have hq₂ : Continuous q₂ := ThreeArcCircleLemmas.hq₂ ι P a c h₂ + let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x + have hmid : Continuous mid := ThreeArcCircleLemmas.hmid ι P a b c h₁ h₁c h₂ h₂c hq₁ hq₂ + let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x + have hf : Continuous f := ThreeArcCircleLemmas.hf ι P a b c h₀ h₀b h₁ h₁b h₂ hq₀ hmid + have hf0 : f 0 = f 3 := ThreeArcCircleLemmas.hf0 ι P a b c h₀ h₀a h₁ h₂ h₂a + let : Fact (0 < (3 : ℝ)) := ⟨by norm_num⟩ + let ℓ : AddCircle (3 : ℝ) → Real × Real := AddCircle.liftIco 3 0 f + have hℓc : Continuous ℓ := ThreeArcCircleLemmas.hℓc ι P a b c h₀ h₁ h₂ hf hf0 (this := this) + have clamp_eq_self (x : ℝ) (hx : x ∈ Set.Icc (0 : ℝ) 1) : + clamp x = ⟨x, hx⟩ := ThreeArcCircleLemmas.clamp_eq_self x hx + have fseg₀ (x : ℝ) (hx : 0 ≤ x) (h₁x : x ≤ 1) : + f x = (h₀ ⟨x, ⟨hx, h₁x⟩⟩ : P.edgeArc a b) := ThreeArcCircleLemmas.fseg₀ ι P a b c h₀ h₁ h₂ + clamp_eq_self x hx h₁x + have fseg₁ (x : ℝ) (h₁x : 1 < x) (h₂x : x ≤ 2) : + f x = (h₁ ⟨x - 1, ⟨by linarith [h₁x], by linarith [h₂x]⟩⟩ : P.edgeArc b c) := + ThreeArcCircleLemmas.fseg₁ ι P a b c h₀ h₁ h₂ clamp_eq_self x h₁x h₂x + have fseg₂ (x : ℝ) (h₂x : 2 < x) (h₃x : x < 3) : + f x = (h₂ ⟨x - 2, ⟨by linarith [h₂x], by linarith [h₃x]⟩⟩ : P.edgeArc c a) := + ThreeArcCircleLemmas.fseg₂ ι P a b c h₀ h₁ h₂ clamp_eq_self x h₂x h₃x + have hint₀₁ : P.edgeArc a b ∩ P.edgeArc b c = {P.position b} := ThreeArcCircleLemmas.hint₀₁ ι P + a b c hab hbc hca eab ebc h₀ h₀a h₀b h₁ h₁b h₁c h₂ hq₀ hq₁ hmid hf hf0 (this := this) hℓc + fseg₀ fseg₁ fseg₂ + have hint₁₂ : P.edgeArc b c ∩ P.edgeArc c a = {P.position c} := ThreeArcCircleLemmas.hint₁₂ ι P + a b c hab hbc hca ebc eca h₀ h₁ h₁b h₁c h₂ h₂c h₂a hq₁ hq₂ hmid hf hf0 (this := this) hℓc + fseg₀ fseg₁ fseg₂ hint₀₁ + have hint₂₀ : P.edgeArc c a ∩ P.edgeArc a b = {P.position a} := ThreeArcCircleLemmas.hint₂₀ ι P + a b c hab hbc hca eab eca h₀ h₀a h₀b h₁ h₂ h₂c h₂a hq₀ hq₂ hmid hf hf0 (this := this) hℓc + fseg₀ fseg₁ fseg₂ hint₀₁ hint₁₂ + have cross₀₁ {x y : ℝ} (hx₀ : 0 ≤ x) (hx₁ : x ≤ 1) + (hy₁ : 1 < y) (hy₂ : y ≤ 2) (hxy : f x = f y) : x = y := ThreeArcCircleLemmas.cross₀₁ ι P a + b c h₀ h₀b h₁ h₁b h₂ fseg₀ fseg₁ hint₀₁ (x := x) (y := y) hx₀ hx₁ hy₁ hy₂ hxy + have cross₁₂ {x y : ℝ} (hx₁ : 1 < x) (hx₂ : x ≤ 2) + (hy₂ : 2 < y) (hy₃ : y < 3) (hxy : f x = f y) : x = y := ThreeArcCircleLemmas.cross₁₂ ι P a + b c h₀ h₁ h₁c h₂ h₂c fseg₁ fseg₂ hint₁₂ (x := x) (y := y) hx₁ hx₂ hy₂ hy₃ hxy + have cross₀₂ {x y : ℝ} (hx₀ : 0 ≤ x) (hx₁ : x ≤ 1) + (hy₂ : 2 < y) (hy₃ : y < 3) (hxy : f x = f y) : False := ThreeArcCircleLemmas.cross₀₂ ι P a + b c h₀ h₀a h₁ h₂ h₂a fseg₀ fseg₂ hint₂₀ (x := x) (y := y) hx₀ hx₁ hy₂ hy₃ hxy + have hf_inj : ∀ x y : ℝ, x ∈ Set.Ico (0 : ℝ) 3 → y ∈ Set.Ico 0 3 → + f x = f y → x = y := ThreeArcCircleLemmas.hf_inj ι P a b c h₀ h₁ h₂ fseg₀ fseg₁ fseg₂ + cross₀₁ cross₁₂ cross₀₂ + have lift_eq (x : ℝ) (hx : x ∈ Set.Ico (0 : ℝ) 3) : + ℓ (x : AddCircle (3 : ℝ)) = f x := ThreeArcCircleLemmas.lift_eq ι P a b c h₀ h₁ h₂ (this := + this) x hx + let e : Circle → Real × Real := ℓ ∘ (AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm + refine ⟨⟨e, ?_⟩, ?_, ?_⟩ + · exact hℓc.comp (AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm.continuous + · intro x y hxy + change ℓ ((AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm x) = + ℓ ((AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm y) at hxy + let u := AddCircle.equivIco (3 : ℝ) 0 + ((AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm x) + let v := AddCircle.equivIco (3 : ℝ) 0 + ((AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm y) + have hu : (u : AddCircle (3 : ℝ)) = + (AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm x := by + simp [u] + have hv : (v : AddCircle (3 : ℝ)) = + (AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm y := by + simp [v] + have hfu : ℓ ((AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm x) = f u := by + rw [← hu] + exact AddCircle.liftIco_coe_apply u.property + have hfv : ℓ ((AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm y) = f v := by + rw [← hv] + exact AddCircle.liftIco_coe_apply v.property + have hu' : (u : ℝ) ∈ Set.Ico (0 : ℝ) 3 := by simpa using u.property + have hv' : (v : ℝ) ∈ Set.Ico (0 : ℝ) 3 := by simpa using v.property + have huv : (u : ℝ) = (v : ℝ) := + hf_inj (u : ℝ) (v : ℝ) hu' hv' (by rw [← hfu, ← hfv]; exact hxy) + have huv' : u = v := by + apply Subtype.ext + exact huv + apply (AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm.injective + calc + (AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm x = u := hu.symm + _ = (v : AddCircle (3 : ℝ)) := congrArg + (fun z : Set.Ico (0 : ℝ) (0 + 3) => (z : AddCircle (3 : ℝ))) huv' + _ = (AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm y := hv + · have hrangeℓ : Set.range ℓ = + P.edgeArc a b ∪ P.edgeArc b c ∪ P.edgeArc c a := ThreeArcCircleRange.hrangeℓ ι P a b c h₀ + h₀a h₀b h₁ h₁b h₁c h₂ h₂c h₂a (this := this) fseg₀ fseg₁ fseg₂ lift_eq + ext z + constructor + · rintro ⟨x, rfl⟩ + have hx : ℓ ((AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm x) ∈ + P.edgeArc a b ∪ P.edgeArc b c ∪ P.edgeArc c a := by + rw [← hrangeℓ] + exact ⟨_, rfl⟩ + exact hx + · intro hz + have hz' : z ∈ Set.range ℓ := by rw [hrangeℓ]; exact hz + rcases hz' with ⟨y, hy⟩ + refine ⟨(AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)) y, ?_⟩ + change ℓ ((AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm + ((AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)) y)) = z + simpa using hy + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3832T1ChamberOverlap.lean b/LeanPool/ApollonianSuperharmonic/P3832T1ChamberOverlap.lean new file mode 100644 index 0000000000..a893f00103 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3832T1ChamberOverlap.lean @@ -0,0 +1,427 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Basic.Real.Basic +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P3832T1ChamberOverlap] + +/-! +# P3832T1ChamberOverlap + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ChamberOverlap + +private def sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set (Fin 3 → ℝ) := fun i j k => + {s | s j ≤ s i ∧ s k ≤ s j} +private abbrev SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} +private def sectorI : SectorOrder → Fin 3 := fun o => o.1.1 +private def sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 +private def sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 +private def sectorCh (o : SectorOrder) := sectorChamber (sectorI o) (sectorJ o) (sectorK o) + +private theorem sectorIndexCover (o : SectorOrder) (n : Fin 3) : + n = sectorI o ∨ n = sectorJ o ∨ n = sectorK o := by + classical + let t : Finset (Fin 3) := {sectorI o, sectorJ o, sectorK o} + have hcard : t.card = Fintype.card (Fin 3) := by + simp [t, sectorI, sectorJ, sectorK, o.2.1, o.2.2.1, o.2.2.2] + have huniv := Finset.eq_univ_of_card t hcard + have hn : n ∈ t := by rw [huniv]; simp + simpa [t] using hn + +private theorem sectorOrdersTie (s : (Fin 3 → ℝ)) (o o' : SectorOrder) + (ho : s ∈ sectorCh o) (ho' : s ∈ sectorCh o') : + o = o' ∨ s (sectorI o) = s (sectorJ o) ∨ s (sectorJ o) = s (sectorK o) := by + classical + by_cases heq : o = o' + · exact Or.inl heq + · by_cases ht : s (sectorI o) = s (sectorJ o) + · exact Or.inr (Or.inl ht) + · by_cases hb : s (sectorJ o) = s (sectorK o) + · exact Or.inr (Or.inr hb) + · have hji : s (sectorJ o) < s (sectorI o) := + lt_of_le_of_ne ho.1 (Ne.symm ht) + have hkj : s (sectorK o) < s (sectorJ o) := + lt_of_le_of_ne ho.2 (Ne.symm hb) + have hmax : s (sectorI o) = s (sectorI o') := by + apply le_antisymm + · rcases sectorIndexCover o' (sectorI o) with h | h | h + · rw [h] + · rw [h]; exact ho'.1 + · rw [h]; exact ho'.2.trans ho'.1 + · rcases sectorIndexCover o (sectorI o') with h | h | h + · rw [h] + · rw [h]; exact ho.1 + · rw [h]; exact ho.2.trans ho.1 + have hii' : sectorI o' = sectorI o := by + rcases sectorIndexCover o (sectorI o') with h | h | h + · exact h + · have hx : s (sectorI o) = s (sectorJ o) := by + rw [h] at hmax + exact hmax + exact False.elim ((ne_of_gt hji) hx) + · have hx : s (sectorI o) = s (sectorK o) := by + rw [h] at hmax + exact hmax + exact False.elim ((ne_of_gt (hkj.trans hji)) hx) + have hj'ne : sectorJ o' ≠ sectorI o := by + rw [← hii']; exact o'.2.1.symm + have hj' : sectorJ o' = sectorJ o := by + rcases sectorIndexCover o (sectorJ o') with h | h | h + · exact False.elim (hj'ne h) + · exact h + · have hk'j : sectorK o' = sectorJ o := by + rcases sectorIndexCover o (sectorK o') with hI | hJ | hK + · have : sectorI o' = sectorK o' := hii'.trans hI.symm + exact False.elim (o'.2.2.1 this) + · exact hJ + · have : sectorJ o' = sectorK o' := h.trans hK.symm + exact False.elim (o'.2.2.2 this) + have hbad : s (sectorJ o) ≤ s (sectorK o) := by + simpa [h, hk'j] using ho'.2 + exact False.elim ((not_le_of_gt hkj) hbad) + have hk'neI : sectorK o' ≠ sectorI o := by + rw [← hii']; exact o'.2.2.1.symm + have hk'neJ : sectorK o' ≠ sectorJ o := by + rw [← hj']; exact o'.2.2.2.symm + have hk' : sectorK o' = sectorK o := by + rcases sectorIndexCover o (sectorK o') with h | h | h + · exact False.elim (hk'neI h) + · exact False.elim (hk'neJ h) + · exact h + left + apply Subtype.ext + change (sectorI o, (sectorJ o, sectorK o)) = + (sectorI o', (sectorJ o', sectorK o')) + exact Prod.ext hii'.symm (Prod.ext hj'.symm hk'.symm) + +private theorem sectorOrderedBetaTop (s : (Fin 3 → ℝ)) (o o' : SectorOrder) + (ho : s ∈ sectorCh o) (ho' : s ∈ sectorCh o') + (ht : s (sectorI o) = s (sectorJ o)) : + 2 * (s (sectorJ o)-s (sectorK o))= + 2 * (s (sectorJ o')-s (sectorK o')) := by + classical + fin_cases o <;> fin_cases o' + all_goals simp only [sectorCh,sectorChamber,sectorI,sectorJ,sectorK, + Set.mem_ofPred_eq] at ho ho' ht + all_goals dsimp only [sectorI, sectorJ, sectorK] at ho ho' ht ⊢ + all_goals linarith + +private theorem sectorOrderedRBottom (s : (Fin 3 → ℝ)) (o o' : SectorOrder) + (ho : s ∈ sectorCh o) (ho' : s ∈ sectorCh o') + (ht : s (sectorJ o) = s (sectorK o)) : + 2 * (s (sectorJ o)-s (sectorK o)) + 3 * s (sectorK o)= + 2 * (s (sectorJ o')-s (sectorK o')) + 3 * s (sectorK o') := by + classical + let i := sectorI o + let j := sectorJ o + let k := sectorK o + let i' := sectorI o' + let j' := sectorJ o' + let k' := sectorK o' + have hij : s j ≤ s i := ho.1 + have hik : s k ≤ s j := ho.2 + have hi'j' : s j' ≤ s i' := ho'.1 + have hi'k' : s k' ≤ s j' := ho'.2 + have hmax : s i = s i' := by + apply le_antisymm + · rcases sectorIndexCover o' i with h | h | h + · simp [i', h] + · simpa [j', h] using hi'j' + · simpa [k', j', h] using hi'k'.trans hi'j' + · rcases sectorIndexCover o i' with h | h | h + · simp [i, h] + · simpa [j, h] using hij + · simpa [k, j, h] using hik.trans hij + have hminj : s j' = s k := by + by_cases heq : s i = s k + · have hiall : ∀ n, s n = s k := by + intro n + rcases sectorIndexCover o n with h | h | h + · rw [h]; exact heq + · rw [h]; exact ht + · rw [h] + exact hiall j' + · have hlt : s k < s i := lt_of_le_of_ne (hik.trans hij) (Ne.symm heq) + have hii' : i' = i := by + rcases sectorIndexCover o i' with h | h | h + · exact h + · exfalso + have heqik : s i = s k := by + simpa only [i', h, ht] using hmax + exact (ne_of_gt hlt) heqik + · exfalso + have heqik : s i = s k := by + simpa only [i', h, ht] using hmax + exact (ne_of_gt hlt) heqik + have hj'ne : j' ≠ i := by rw [← hii']; exact o'.2.1.symm + rcases sectorIndexCover o j' with h | h | h + · exact False.elim (hj'ne h) + · rw [h]; exact ht + · rw [h] + have hmink : s k' = s k := by + by_cases heq : s i = s k + · have hiall : ∀ n, s n = s k := by + intro n + rcases sectorIndexCover o n with h | h | h + · rw [h]; exact heq + · rw [h]; exact ht + · rw [h] + exact hiall k' + · have hlt : s k < s i := lt_of_le_of_ne (hik.trans hij) (Ne.symm heq) + have hii' : i' = i := by + rcases sectorIndexCover o i' with h | h | h + · exact h + · exfalso + have hx : s i = s k := by simpa only [i', h, ht] using hmax + exact (ne_of_gt hlt) hx + · exfalso + have hx : s i = s k := by simpa only [i', h, ht] using hmax + exact (ne_of_gt hlt) hx + have hk'ne : k' ≠ i := by rw [← hii']; exact o'.2.2.1.symm + rcases sectorIndexCover o k' with h | h | h + · exact False.elim (hk'ne h) + · rw [h]; exact ht + · rw [h] + rw [hminj, hmink, ht] + +private theorem sectorBottomSameTop (s : (Fin 3 → ℝ)) (o o' : SectorOrder) + (ho : s ∈ sectorCh o) (ho' : s ∈ sectorCh o') + (ht : s (sectorJ o) = s (sectorK o)) : + sectorI o = sectorI o' ∨ + (s (sectorI o) = s (sectorJ o) ∧ s (sectorJ o) = s (sectorK o)) := by + classical + have hmax : s (sectorI o) = s (sectorI o') := by + apply le_antisymm + · rcases sectorIndexCover o' (sectorI o) with h | h | h + · rw [h] + · rw [h]; exact ho'.1 + · rw [h]; exact ho'.2.trans ho'.1 + · rcases sectorIndexCover o (sectorI o') with h | h | h + · rw [h] + · rw [h]; exact ho.1 + · rw [h]; exact ho.2.trans ho.1 + by_cases heq : s (sectorI o) = s (sectorK o) + · right + constructor + · exact heq.trans ht.symm + · exact ht + · left + have hlt : s (sectorK o) z.1.1) hxy + have hmul : (x.1 : ℝ) * x.2 = (y.1 : ℝ) * y.2 := + congrArg (fun z : SectorCone => (z.1.2 : ℝ)) hxy + by_cases hr : (x.1 : ℝ) = 0 + · have hx : x.1 = ⟨0, by norm_num [SectorInterval]⟩ := Subtype.ext hr + have hy : y.1 = ⟨0, by norm_num [SectorInterval]⟩ := hfirst.symm.trans hx + calc + g x = g (⟨0, by norm_num [SectorInterval]⟩, x.2) := congrArg g (Prod.ext hx rfl) + _ = c := hzero _ + _ = g (⟨0, by norm_num [SectorInterval]⟩, y.2) := (hzero _).symm + _ = g y := congrArg g (Prod.ext hy.symm rfl) + · have ht : x.2 = y.2 := by + apply Subtype.ext + rw [← hfirst] at hmul + exact mul_left_cancel₀ hr hmul + exact congrArg g (Prod.ext hfirst ht) + let q : C(SectorInterval × SectorInterval, SectorCone) := + ⟨sectorCollapse, sectorCollapse_continuous⟩ + have hq : Topology.IsQuotientMap q := + Topology.IsQuotientMap.of_surjective_continuous + sectorCollapse_surjective sectorCollapse_continuous + have hfactor : Function.FactorsThrough g q := hf + refine ⟨hq.lift g hfactor, ?_⟩ + intro z + exact congrArg (fun f : C(SectorInterval × SectorInterval, Y) => f z) + (hq.lift_comp g hfactor) + exact ⟨sectorCollapse_surjective, sectorConeDescent⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3832T1ConeCollapse.lean b/LeanPool/ApollonianSuperharmonic/P3832T1ConeCollapse.lean new file mode 100644 index 0000000000..e59c52f834 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3832T1ConeCollapse.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Topology.Instances.Real.Lemmas + +-- [TABLET NODE: P3832T1ConeCollapse] + +/-! +# P3832T1ConeCollapse + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $I=[0,1]$ and let +$K=\{(r,b)\in I^2:b\leq r\}$, both with their subspace topologies. +The collapsed-cone projection is +$$ +q:I^2\longrightarrow K,\qquad q(r,t)=(r,rt). +$$ +This is well-defined because $0\leq rt\leq r\leq1$. +It identifies the entire side $\{0\}\times I$ with the cone vertex. +-/ +def P3832T1ConeCollapse : + Set.Icc (0 : ℝ) 1 × Set.Icc (0 : ℝ) 1 → + {z : Set.Icc (0 : ℝ) 1 × Set.Icc (0 : ℝ) 1 // (z.2 : ℝ) ≤ z.1} := +-- BODY + fun z => + ⟨⟨z.1, ⟨(z.1 : ℝ) * z.2, + mul_nonneg z.1.2.1 z.2.2.1, + (mul_le_mul_of_nonneg_left z.2.2.2 z.1.2.1).trans (by simpa using z.1.2.2)⟩⟩, + by simpa using mul_le_mul_of_nonneg_left z.2.2.2 z.1.2.1⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3832T1FiniteClosedCoverPasting.lean b/LeanPool/ApollonianSuperharmonic/P3832T1FiniteClosedCoverPasting.lean new file mode 100644 index 0000000000..dc3175b719 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3832T1FiniteClosedCoverPasting.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Topology.ContinuousMap.Basic +public import Mathlib.Topology.LocallyFinite + +-- [TABLET NODE: P3832T1FiniteClosedCoverPasting] + +/-! +# P3832T1FiniteClosedCoverPasting + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3832T1FiniteClosedCoverPasting {κ X Y : Type*} + [Finite κ] [TopologicalSpace X] [TopologicalSpace Y] + (S : κ → Set X) (hclosed : ∀ i, IsClosed (S i)) + (hcover : ∀ x : X, ∃ i, x ∈ S i) + (φ : ∀ i, C(S i, Y)) + (hagree : ∀ i j x (hi : x ∈ S i) (hj : x ∈ S j), + φ i ⟨x, hi⟩ = φ j ⟨x, hj⟩) : + ∃ F : C(X, Y), ∀ i x (hi : x ∈ S i), F x = φ i ⟨x, hi⟩ := by +-- BODY + classical + let F : X→(Y) := fun x => φ (Classical.choose (hcover x)) + ⟨x,Classical.choose_spec (hcover x)⟩ + have hF (i : κ) (x : X) (hi : x ∈ S i) : F x=φ i ⟨x,hi⟩ := by + unfold F + exact hagree (Classical.choose (hcover x)) i x + (Classical.choose_spec (hcover x)) hi + have hcont (i : κ) : ContinuousOn F (S i) := by + rw [continuousOn_iff_continuous_domRestrict] + apply Continuous.congr (φ i).continuous + intro x + exact (hF i x.1 x.2).symm + have hunion : (⋃ i, S i)=Set.univ := by + ext x + simp only [Set.mem_iUnion,Set.mem_univ,iff_true] + exact hcover x + have hglobal : ContinuousOn F Set.univ := by + rw [← hunion] + exact (locallyFinite_of_finite S).continuousOn_iUnion hclosed hcont + refine ⟨⟨F,continuousOn_univ.1 hglobal⟩,?_⟩ + exact hF + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3861T1ExtraArcLocalization.lean b/LeanPool/ApollonianSuperharmonic/P3861T1ExtraArcLocalization.lean new file mode 100644 index 0000000000..018e14a81f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3861T1ExtraArcLocalization.lean @@ -0,0 +1,186 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3861T1FacialDomains +public import LeanPool.ApollonianSuperharmonic.P3767T1BarrierRegionMaximal +public import LeanPool.ApollonianSuperharmonic.P3767T1VertexEdgeIncidence +public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry +public import LeanPool.ApollonianSuperharmonic.P3889T1ExactRadialStar +public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectors +public import LeanPool.ApollonianSuperharmonic.P3889T1FaceGapCoverage + +-- [TABLET NODE: P3861T1ExtraArcLocalization] + +/-! +# P3861T1ExtraArcLocalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3861T1ExtraArcLocalization : + ∀ {ι : Type}, ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), (Pairwise (fun f g : P.plane.Face => Disjoint + (F.region f) (F.region g))) → (∀ (a : ι), ∀ (b : ι), ∀ (g : Set.Icc (0 : Real) 1 → Real × + Real), (Continuous g) → ((Function.Injective g) → ((g ⟨0, by norm_num⟩ = + D.position a) → ((g ⟨1, by norm_num⟩ = D.position b) → ((∀ t : Set.Icc (0 : Real) 1, 0 < (t + : Real) → (t : Real) < 1 → + g t ∉ Set.range D.position ∪ + {p | ∃ c d, P.plane.adjacent c d ∧ p ∈ D.edgeArc c d}) → (∃ f : P.plane.Face, + (∃ i, P.plane.faceVertex f i = a) ∧ + (∃ i, P.plane.faceVertex f i = b) ∧ + ∀ t : Set.Icc (0 : Real) 1, 0 < (t : Real) → (t : Real) < 1 → + g t ∈ F.region f)))))) := by + intro ι P D F hd a b g hc hi h0 h1 ha +-- BODY + classical + let : Nontrivial ι := (P3776T1FixedGeometry P.toPeriodicTileCore).1 + have hposition_edge_endpoint (v c d : ι) (hcd : P.plane.adjacent c d) + (hv : D.position v ∈ D.edgeArc c d) : v = c ∨ v = d := by + obtain ⟨z, hvz⟩ := (P3767T1VertexEdgeIncidence P.plane v).1 + have hvzContact : P3723T1EdgeContact P v z := by + exact ⟨by intro h; subst z; exact P.plane.adjacent_irreflexive v hvz, + P.adjacent_has_common_edge v z hvz⟩ + have hcdContact : P3723T1EdgeContact P c d := by + exact ⟨by intro h; subst d; exact P.plane.adjacent_irreflexive c hcd, + P.adjacent_has_common_edge c d hcd⟩ + have hvz' : D.position v ∈ D.edgeArc v z := by + obtain ⟨h, h0, _⟩ := D.edgeArc_homeomorph v z hvzContact + rw [← h0] + exact (h ⟨0, by norm_num⟩).property + by_cases heq : ({v, z} : Set ι) = {c, d} + · have hmem : v ∈ ({c, d} : Set ι) := heq ▸ (by simp) + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hmem + · have hmem : D.position v ∈ + D.position '' (({v, z} : Set ι) ∩ ({c, d} : Set ι)) := by + rw [← D.edgeArc_intersections v z c d hvzContact hcdContact heq] + exact ⟨hvz', hv⟩ + obtain ⟨w, hw, hpos⟩ := hmem + have hwv : w = v := D.position_injective hpos + subst w + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hw.2 + have hfrontier_trace (f : P.plane.Face) : + frontier (F.region f) ⊆ Set.range D.position ∪ + {p | ∃ c d, P.plane.adjacent c d ∧ p ∈ D.edgeArc c d} := by + rw [F.region_frontier] + rintro x ((hx | hx) | hx) + · exact Or.inr ⟨_, _, P.plane.face_edges f 0 1 (by decide), hx⟩ + · exact Or.inr ⟨_, _, P.plane.face_edges f 1 2 (by decide), hx⟩ + · exact Or.inr ⟨_, _, P.plane.face_edges f 2 0 (by decide), hx⟩ + have hfrontier_position_incident (f : P.plane.Face) (v : ι) + (hv : D.position v ∈ frontier (F.region f)) : + ∃ i, P.plane.faceVertex f i = v := by + rw [F.region_frontier] at hv + rcases hv with (hv | hv) | hv + · have hend := hposition_edge_endpoint v _ _ + (P.plane.face_edges f 0 1 (by decide)) hv + rcases hend with h | h + · exact ⟨0, h.symm⟩ + · exact ⟨1, h.symm⟩ + · have hend := hposition_edge_endpoint v _ _ + (P.plane.face_edges f 1 2 (by decide)) hv + rcases hend with h | h + · exact ⟨1, h.symm⟩ + · exact ⟨2, h.symm⟩ + · have hend := hposition_edge_endpoint v _ _ + (P.plane.face_edges f 2 0 (by decide)) hv + rcases hend with h | h + · exact ⟨2, h.symm⟩ + · exact ⟨0, h.symm⟩ + let s : Set (Set.Icc (0 : Real) 1) := + Set.Ioo (⟨0, by norm_num⟩ : Set.Icc (0 : Real) 1) ⟨1, by norm_num⟩ + have hAconnected : IsPreconnected (g '' s) := by + exact isPreconnected_Ioo.image g hc.continuousOn + have hAavoid : Disjoint (g '' s) + (Set.range D.position ∪ + {p | ∃ c d, P.plane.adjacent c d ∧ p ∈ D.edgeArc c d}) := by + apply Set.disjoint_left.mpr + rintro x ⟨t, ht, rfl⟩ hx + have ht' : 0 < (t : Real) ∧ (t : Real) < 1 := by + exact ⟨lt_of_le_of_lt (by norm_num : (0 : Real) ≤ 0) ht.1, + lt_of_lt_of_le ht.2 (by norm_num : (1 : Real) ≤ 1)⟩ + exact ha t ht'.1 ht'.2 hx + have hzero_mem : (⟨0, by norm_num⟩ : Set.Icc (0 : Real) 1) ∈ closure s := by + rw [show s = Set.Ioo (⟨0, by norm_num⟩ : Set.Icc (0 : Real) 1) + ⟨1, by norm_num⟩ from rfl, closure_Ioo (by norm_num)] + simp + have hone_mem : (⟨1, by norm_num⟩ : Set.Icc (0 : Real) 1) ∈ closure s := by + rw [show s = Set.Ioo (⟨0, by norm_num⟩ : Set.Icc (0 : Real) 1) + ⟨1, by norm_num⟩ from rfl, closure_Ioo (by norm_num)] + simp + have hconditional (f : P.plane.Face) (hmeet : (g '' s ∩ F.region f).Nonempty) : + (∃ i, P.plane.faceVertex f i = a) ∧ + (∃ i, P.plane.faceVertex f i = b) ∧ + ∀ t : Set.Icc (0 : Real) 1, 0 < (t : Real) → (t : Real) < 1 → + g t ∈ F.region f := by + have hAsub : g '' s ⊆ F.region f := by + apply P3767T1BarrierRegionMaximal (F.region f) + (Set.range D.position ∪ + {p | ∃ c d, P.plane.adjacent c d ∧ p ∈ D.edgeArc c d}) + (g '' s) (F.region_open f) (hfrontier_trace f) hAconnected hAavoid hmeet + have hclosure0 : D.position a ∈ closure (F.region f) := by + have h := mem_closure_image hc.continuousAt hzero_mem + rw [h0] at h + exact (closure_mono hAsub) h + have hclosure1 : D.position b ∈ closure (F.region f) := by + have h := mem_closure_image hc.continuousAt hone_mem + rw [h1] at h + exact (closure_mono hAsub) h + have hnot0 : D.position a ∉ F.region f := by + intro hx + exact (Set.disjoint_left.mp (F.region_avoids_trace f)) hx (Or.inl ⟨a, rfl⟩) + have hnot1 : D.position b ∉ F.region f := by + intro hx + exact (Set.disjoint_left.mp (F.region_avoids_trace f)) hx (Or.inl ⟨b, rfl⟩) + have hfront0 : D.position a ∈ frontier (F.region f) := by + rw [frontier, (F.region_open f).interior_eq] + exact ⟨hclosure0, hnot0⟩ + have hfront1 : D.position b ∈ frontier (F.region f) := by + rw [frontier, (F.region_open f).interior_eq] + exact ⟨hclosure1, hnot1⟩ + refine ⟨hfrontier_position_incident f a hfront0, + hfrontier_position_incident f b hfront1, ?_⟩ + intro t ht0 ht1 + have hts : t ∈ s := by + change (0 : Real) < (t : Real) ∧ (t : Real) < 1 + exact ⟨ht0, ht1⟩ + exact hAsub ⟨t, hts, rfl⟩ + obtain ⟨r, hr, u, hunit, hinj, hedge, hforeign, htrace⟩ := + P3889T1ExactRadialStar P D a + have hsectors (c d : ι) (hc : P.plane.adjacent a c) + (hd : P.plane.adjacent a d) (hne : c ≠ d) : + Nonempty (P3889T1TwoRaySectorDecomposition + (D.position a) r (u c) (u d)) := by + apply P3889T1TwoRaySectors (D.position a) r (u c) (u d) hr + (hunit c hc) (hunit d hd) + intro heq + exact hne (hinj c d hc hd heq) + have hcover := P3889T1FaceGapCoverage P D F hd a r hr u + hunit hinj hedge hforeign htrace hsectors + have hstart : ∃ f : P.plane.Face, (g '' s ∩ F.region f).Nonempty := by + have hcl : D.position a ∈ closure (g '' s) := by + have h := mem_closure_image hc.continuousAt hzero_mem + simpa only [h0] using h + obtain ⟨p, hpA, hpdist⟩ := Metric.mem_closure_iff.mp hcl r hr + have hpB : p ∈ Metric.ball (D.position a) r := by + simpa only [Metric.mem_ball, dist_comm] using hpdist + have hpavoid : p ∉ Set.range D.position ∪ + {q | ∃ c d, P.plane.adjacent c d ∧ q ∈ D.edgeArc c d} := + fun hp => Set.disjoint_left.mp hAavoid hpA hp + obtain ⟨f, _, hpf⟩ := hcover p hpB hpavoid + exact ⟨f, p, hpA, hpf⟩ + obtain ⟨f, hmeet⟩ := hstart + obtain ⟨haFace, hbFace, hcontain⟩ := hconditional f hmeet + exact ⟨f, haFace, hbFace, hcontain⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3861T1FacialDomains.lean b/LeanPool/ApollonianSuperharmonic/P3861T1FacialDomains.lean new file mode 100644 index 0000000000..68f689e2dc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3861T1FacialDomains.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting + +-- [TABLET NODE: P3861T1FacialDomains] + +/-! +# P3861T1FacialDomains + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a periodic complex $P$ and an all-contact drawing +$D$ as in `P3723T1AllContactRouting`, put +$$ + \mathcal T=\{D(a):a\in\iota\}\ \cup\! + \bigcup_{a\sim_P b}D.\mathrm{edgeArc}(a,b),\qquad + J_f=D_{f_0f_1}\cup D_{f_1f_2}\cup D_{f_2f_0}. +$$ +A facial-domain record consists of a set $U_f$ for every fixed face +label, closedness of $\mathcal T$, and the following laws: $U_f$ is +nonempty, open, connected and bounded, avoids $\mathcal T$, and has +frontier exactly $J_f$. The exterior $(\overline{U_f})^c$ is connected +and has the same frontier $J_f$. No face orientation, pairwise disjointness +between these domains, or extra-contact exclusion is part of this +record. The drawing and all three arcs are the supplied literal ones. +-/ +structure P3861T1FacialDomains {ι : Type} (P : PeriodicTileComplex ι) + (D : P3723T1AllContactRouting P) where +-- BODY + /-- The bounded complementary region attached to each fixed face label. -/ + region : P.plane.Face → Set (Real × Real) + trace_closed : IsClosed (Set.range D.position ∪ + {p | ∃ a b, P.plane.adjacent a b ∧ p ∈ D.edgeArc a b}) + region_open : ∀ f, IsOpen (region f) + region_connected : ∀ f, IsConnected (region f) + region_bounded : ∀ f, Bornology.IsBounded (region f) + region_avoids_trace : ∀ f, Disjoint (region f) + (Set.range D.position ∪ {p | ∃ a b, P.plane.adjacent a b ∧ p ∈ D.edgeArc a b}) + region_frontier : ∀ f, frontier (region f) = + D.edgeArc (P.plane.faceVertex f 0) (P.plane.faceVertex f 1) ∪ + D.edgeArc (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) ∪ + D.edgeArc (P.plane.faceVertex f 2) (P.plane.faceVertex f 0) + exterior_connected : ∀ f, IsConnected (closure (region f))ᶜ + exterior_frontier : ∀ f, + frontier (closure (region f))ᶜ = frontier (region f) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean b/LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean new file mode 100644 index 0000000000..159645f3c3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean @@ -0,0 +1,1009 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry +public import LeanPool.ApollonianSuperharmonic.P3821T1ThreeArcCircle +public import LeanPool.ApollonianSuperharmonic.P3821T1CircleComponentBound + +-- [TABLET NODE: P3861T1FixedFacialDeletion] + +/-! +# P3861T1FixedFacialDeletion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FacialDeletionProof + +private theorem hCcompact : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let C (f : P.plane.Face) := frontier (U f) + (∀ (f : P.plane.Face), C f = P.plane.edgeArc (P.plane.faceVertex f 0) (P.plane.faceVertex + f 1) ∪ P.plane.edgeArc (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) ∪ + P.plane.edgeArc (P.plane.faceVertex f 2) (P.plane.faceVertex f 0)) → (∀ (f : + P.plane.Face), IsCompact (C f)) ) := by + classical + intro ι P U C hfront f + rw [hfront f] + have hacomp (a b : ι) (hab : P.plane.adjacent a b) : + IsCompact (P.plane.edgeArc a b) := by + obtain ⟨e, _, _⟩ := P.plane.arc_homeomorph a b hab + have himage : Set.range (fun x : Set.Icc (0 : Real) 1 => + ((e x : P.plane.edgeArc a b) : Real × Real)) = P.plane.edgeArc a b := by + ext x + constructor + · rintro ⟨t, rfl⟩ + exact (e t).property + · intro hx + exact ⟨e.symm ⟨x, hx⟩, by simp⟩ + rw [← himage] + exact isCompact_range (continuous_subtype_val.comp e.continuous) + exact ((hacomp _ _ (P.plane.face_edges f 0 1 (by decide))).union + (hacomp _ _ (P.plane.face_edges f 1 2 (by decide)))).union + (hacomp _ _ (P.plane.face_edges f 2 0 (by decide))) + +private theorem hWnonempty : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let W (f : P.plane.Face) := (closure (U f))ᶜ + (Nontrivial ι ∧ (∀ (f : P.plane.Face), IsCompact (closure (P.plane.faceRegion f))) ∧ (∀ + (K : Set (ℝ × ℝ)), IsCompact K → {f : P.plane.Face | (K ∩ closure (P.plane.faceRegion + f)).Nonempty}.Finite) ∧ (∀ (x : ℝ × ℝ), ∃ (f : P.plane.Face), x ∈ closure + (P.plane.faceRegion f)) ∧ (∀ (a : ι), IsOpen (P3776T1OpenStar P a) ∧ IsCompact + (closure (P3776T1OpenStar P a))) ∧ (∀ (x : ℝ × ℝ), ∃ (a : ι), x ∈ P3776T1OpenStar + P a) ∧ (∀ (u : ↥P.lattice), ∀ (a : ι), P3776T1OpenStar P (P.shift u a) = (fun (x : + ℝ × ℝ) => x + GaussianRealPoint (↑u : GaussianInt)) '' P3776T1OpenStar P a) ∧ ∀ (u + : ↥P.lattice), ∀ (v : ↥P.lattice), ∀ (a : ι), P.shift u a = P.shift v a → u = v) → (∀ + (f : P.plane.Face), (W f).Nonempty) ) := by + classical + intro ι P U W hgeom f + have hb := (hgeom.2.1 f).isBounded + by_contra hn + have hclosure : closure (U f) = Set.univ := by + apply Set.eq_univ_iff_forall.mpr + intro x + by_contra hx + apply hn + exact ⟨x, by simpa [W] using hx⟩ + have hbound : Bornology.IsBounded (Set.univ : Set (Real × Real)) := by + rw [← hclosure] + exact hb + exact (NormedSpace.unbounded_univ ℝ (Real × Real)) hbound + +private theorem hWpartition : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let C (f : P.plane.Face) := frontier (U f) + let W (f : P.plane.Face) := (closure (U f))ᶜ + ∀ (f : P.plane.Face), (C f)ᶜ = U f ∪ W f ) := by + classical + intro ι P U C W f + ext x + constructor + · intro hx + by_cases hu : x ∈ U f + · exact Or.inl hu + · right + change x ∉ closure (U f) + intro hcl + have hfrontier : x ∈ frontier (U f) := by + rw [frontier_eq_closure_inter_closure] + refine ⟨hcl, ?_⟩ + exact subset_closure hu + exact hx hfrontier + · rintro (hu | hw) + · apply Set.disjoint_left.mp ((disjoint_frontier_iff_isOpen.mpr + (P.plane.region_open f)).symm) hu + · intro hxC + exact hw (frontier_subset_closure hxC) + +private theorem hUsub : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let C (f : P.plane.Face) := frontier (U f) + ∀ (f : P.plane.Face), U f ⊆ (C f)ᶜ ) := by + classical + intro ι P U C f x hx + exact Set.disjoint_left.mp ((disjoint_frontier_iff_isOpen.mpr + (P.plane.region_open f)).symm) hx + +private theorem hcomponentU : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let C (f : P.plane.Face) := frontier (U f) + (∀ (f : P.plane.Face), ∀ (V : Set (ℝ × ℝ)), IsPreconnected V → Disjoint V (frontier + (P.plane.faceRegion f)) → (V ∩ P.plane.faceRegion f).Nonempty → V ⊆ + P.plane.faceRegion f) → ((∀ (f : P.plane.Face), U f ⊆ (C f)ᶜ) → (∀ (f : + P.plane.Face), ∀ x ∈ U f, connectedComponentIn (C f)ᶜ x = U f)) ) := by + classical + intro ι P U C hbarrier hUsub f x hx + have hcompSub : connectedComponentIn (C f)ᶜ x ⊆ U f := by + apply hbarrier f _ isPreconnected_connectedComponentIn + · apply Set.disjoint_left.mpr + intro y hy hyC + exact connectedComponentIn_subset (C f)ᶜ x hy hyC + · exact ⟨x, mem_connectedComponentIn (hUsub f hx), hx⟩ + have hUcomp : U f ⊆ connectedComponentIn (C f)ᶜ x := by + exact (P.plane.region_connected f).isPreconnected.subset_connectedComponentIn hx + (hUsub f) + exact Set.Subset.antisymm hcompSub hUcomp + +private theorem hWconnected : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let C (f : P.plane.Face) := frontier (U f) + let W (f : P.plane.Face) := (closure (U f))ᶜ + (∀ (f : P.plane.Face), C f = P.plane.edgeArc (P.plane.faceVertex f 0) (P.plane.faceVertex + f 1) ∪ P.plane.edgeArc (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) ∪ + P.plane.edgeArc (P.plane.faceVertex f 2) (P.plane.faceVertex f 0)) → ((∀ (f : + P.plane.Face), (W f).Nonempty) → ((∀ (f : P.plane.Face), (C f)ᶜ = U f ∪ W f) → ((∀ (f + : P.plane.Face), U f ⊆ (C f)ᶜ) → ((∀ (f : P.plane.Face), ∀ (x : Real × Real), (x ∈ U + f) → (connectedComponentIn (C f)ᶜ x = U f)) → (∀ (f : P.plane.Face), IsConnected (W + f)))))) ) := by + classical + intro ι P U C W hfront hWnonempty hWpartition hUsub hcomponentU f + obtain ⟨e, he, hE⟩ := P3821T1ThreeArcCircle P.plane + (P.plane.faceVertex f 0) (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) + (fun h => by have hh := P.plane.face_vertices_distinct f h; norm_num at hh) + (fun h => by + have hh := P.plane.face_vertices_distinct f h + exact (by decide : (1 : Fin 3) ≠ 2) hh) + (fun h => by + have hh := P.plane.face_vertices_distinct f h + exact (by decide : (2 : Fin 3) ≠ 0) hh) + (P.plane.face_edges f 0 1 (by decide)) + (P.plane.face_edges f 1 2 (by decide)) + (P.plane.face_edges f 2 0 (by decide)) + have hErange : Set.range e = C f := by rw [hfront f]; exact hE + obtain ⟨r, hr⟩ := (P.plane.region_connected f).nonempty + obtain ⟨x, hx⟩ := hWnonempty f + have hrC : r ∈ (C f)ᶜ := hUsub f hr + have hxC : x ∈ (C f)ᶜ := by + rw [hWpartition f] + exact Or.inr hx + have hcompR (y : Real × Real) (hy : y ∈ W f) : + connectedComponentIn (C f)ᶜ r ≠ connectedComponentIn (C f)ᶜ y := by + intro heq + have hyR : y ∈ U f := by + have hy' : y ∈ connectedComponentIn (C f)ᶜ r := by + rw [heq] + exact mem_connectedComponentIn (by + rw [hWpartition f] + exact Or.inr hy) + rw [← hcomponentU f r hr] + exact hy' + exact hy (subset_closure hyR) + have hsame (y z : Real × Real) (hy : y ∈ W f) (hz : z ∈ W f) : + connectedComponentIn (C f)ᶜ y = connectedComponentIn (C f)ᶜ z := by + have hyC : y ∈ (C f)ᶜ := by rw [hWpartition f]; exact Or.inr hy + have hzC : z ∈ (C f)ᶜ := by rw [hWpartition f]; exact Or.inr hz + have hyE : y ∈ (Set.range e)ᶜ := by rw [hErange]; exact hyC + have hzE : z ∈ (Set.range e)ᶜ := by rw [hErange]; exact hzC + have hrE : r ∈ (Set.range e)ᶜ := by rw [hErange]; exact hrC + have hb₀ := P3821T1CircleComponentBound e he r y z hrE hyE hzE + have hb : connectedComponentIn (C f)ᶜ r = connectedComponentIn (C f)ᶜ y ∨ + connectedComponentIn (C f)ᶜ y = connectedComponentIn (C f)ᶜ z ∨ + connectedComponentIn (C f)ᶜ r = connectedComponentIn (C f)ᶜ z := by + simpa only [hErange] using hb₀ + rcases hb with h | h | h + · exact (hcompR y hy h).elim + · exact h + · exact (hcompR z hz h).elim + have hxComponent : connectedComponentIn (C f)ᶜ x = W f := by + apply Set.Subset.antisymm + · intro y hy + have hyC : y ∈ (C f)ᶜ := connectedComponentIn_subset (C f)ᶜ x hy + rw [hWpartition f] at hyC + rcases hyC with hyU | hyW + · have hxy : connectedComponentIn (C f)ᶜ x = + connectedComponentIn (C f)ᶜ y := connectedComponentIn_eq hy + have hxmem : x ∈ connectedComponentIn (C f)ᶜ x := + mem_connectedComponentIn hxC + rw [hxy, hcomponentU f y hyU] at hxmem + exact (hx (subset_closure hxmem)).elim + · exact hyW + · intro y hy + have hxy := hsame x y hx hy + rw [hxy] + exact mem_connectedComponentIn (by + rw [hWpartition f] + exact Or.inr hy) + rw [← hxComponent] + exact isConnected_connectedComponentIn_iff.mpr hxC + +private theorem hWunbounded : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let W (f : P.plane.Face) := (closure (U f))ᶜ + (Nontrivial ι ∧ (∀ (f : P.plane.Face), IsCompact (closure (P.plane.faceRegion f))) ∧ (∀ + (K : Set (ℝ × ℝ)), IsCompact K → {f : P.plane.Face | (K ∩ closure (P.plane.faceRegion + f)).Nonempty}.Finite) ∧ (∀ (x : ℝ × ℝ), ∃ (f : P.plane.Face), x ∈ closure + (P.plane.faceRegion f)) ∧ (∀ (a : ι), IsOpen (P3776T1OpenStar P a) ∧ IsCompact + (closure (P3776T1OpenStar P a))) ∧ (∀ (x : ℝ × ℝ), ∃ (a : ι), x ∈ P3776T1OpenStar + P a) ∧ (∀ (u : ↥P.lattice), ∀ (a : ι), P3776T1OpenStar P (P.shift u a) = (fun (x : + ℝ × ℝ) => x + GaussianRealPoint (↑u : GaussianInt)) '' P3776T1OpenStar P a) ∧ ∀ (u + : ↥P.lattice), ∀ (v : ↥P.lattice), ∀ (a : ι), P.shift u a = P.shift v a → u = v) → (∀ + (f : P.plane.Face), ¬Bornology.IsBounded (W f)) ) := by + classical + intro ι P U W hgeom f hWb + have hUnion : Bornology.IsBounded (closure (U f) ∪ W f) := + (hgeom.2.1 f).isBounded.union hWb + have heq : closure (U f) ∪ W f = Set.univ := by + ext x + simp [W] + rw [heq] at hUnion + exact (NormedSpace.unbounded_univ ℝ (Real × Real)) hUnion + +private theorem hboundaryEq : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let C (f : P.plane.Face) := frontier (U f) + (∀ (f : P.plane.Face), C f = P.plane.edgeArc (P.plane.faceVertex f 0) (P.plane.faceVertex + f 1) ∪ P.plane.edgeArc (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) ∪ + P.plane.edgeArc (P.plane.faceVertex f 2) (P.plane.faceVertex f 0)) → (∀ (f : + P.plane.Face), ∀ (g : P.plane.Face), Set.range (P.plane.faceVertex f) = Set.range + (P.plane.faceVertex g) → C f = C g) ) := by + classical + intro ι P U C hfront f g hv + have hidx : ∀ i : Fin 3, ∃ j : Fin 3, + P.plane.faceVertex f j = P.plane.faceVertex g i := by + intro i + have hi : P.plane.faceVertex g i ∈ Set.range (P.plane.faceVertex f) := by + rw [hv] + exact ⟨i, rfl⟩ + exact Set.mem_range.mp hi + choose k hk using hidx + have hedgeSub (h : P.plane.Face) (i j : Fin 3) (hij : i ≠ j) : + P.plane.edgeArc (P.plane.faceVertex h i) (P.plane.faceVertex h j) ⊆ C h := by + intro x hx + rw [hfront h] + fin_cases i <;> fin_cases j <;> dsimp at * + all_goals try exact (hij rfl).elim + all_goals first + | exact Or.inl (Or.inl hx) + | exact Or.inl (Or.inr hx) + | exact Or.inr hx + | rw [P.plane.arc_symmetric] at hx + first + | exact Or.inl (Or.inl hx) + | exact Or.inl (Or.inr hx) + | exact Or.inr hx + have hsub (hsrc hdst : P.plane.Face) + (hK : Set.range (P.plane.faceVertex hsrc) = + Set.range (P.plane.faceVertex hdst)) : C hsrc ⊆ C hdst := by + intro x hx + rw [hfront hsrc] at hx + have hidx' : ∀ i : Fin 3, ∃ j : Fin 3, + P.plane.faceVertex hdst j = P.plane.faceVertex hsrc i := by + intro i + have hi : P.plane.faceVertex hsrc i ∈ Set.range (P.plane.faceVertex hdst) := by + rw [← hK] + exact ⟨i, rfl⟩ + exact Set.mem_range.mp hi + choose l hl using hidx' + have hEdge (i j : Fin 3) (hij : i ≠ j) + (hijx : x ∈ P.plane.edgeArc (P.plane.faceVertex hsrc i) + (P.plane.faceVertex hsrc j)) : x ∈ C hdst := by + have hne : l i ≠ l j := by + intro heq + have heqv : P.plane.faceVertex hsrc i = P.plane.faceVertex hsrc j := by + calc + P.plane.faceVertex hsrc i = P.plane.faceVertex hdst (l i) := (hl i).symm + _ = P.plane.faceVertex hdst (l j) := congrArg _ heq + _ = P.plane.faceVertex hsrc j := hl j + exact hij (P.plane.face_vertices_distinct hsrc heqv) + have hijx' : x ∈ P.plane.edgeArc (P.plane.faceVertex hdst (l i)) + (P.plane.faceVertex hdst (l j)) := by + simpa only [hl i, hl j] using hijx + exact hedgeSub hdst (l i) (l j) hne hijx' + rcases hx with (hx | hx) | hx + · exact hEdge 0 1 (by decide) hx + · exact hEdge 1 2 (by decide) hx + · exact hEdge 2 0 (by decide) hx + apply Set.Subset.antisymm + · exact hsub f g hv + · exact hsub g f hv.symm + +private theorem hinj : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let C (f : P.plane.Face) := frontier (U f) + let W (f : P.plane.Face) := (closure (U f))ᶜ + (Nontrivial ι ∧ (∀ (f : P.plane.Face), IsCompact (closure (P.plane.faceRegion f))) ∧ (∀ + (K : Set (ℝ × ℝ)), IsCompact K → {f : P.plane.Face | (K ∩ closure (P.plane.faceRegion + f)).Nonempty}.Finite) ∧ (∀ (x : ℝ × ℝ), ∃ (f : P.plane.Face), x ∈ closure + (P.plane.faceRegion f)) ∧ (∀ (a : ι), IsOpen (P3776T1OpenStar P a) ∧ IsCompact + (closure (P3776T1OpenStar P a))) ∧ (∀ (x : ℝ × ℝ), ∃ (a : ι), x ∈ P3776T1OpenStar + P a) ∧ (∀ (u : ↥P.lattice), ∀ (a : ι), P3776T1OpenStar P (P.shift u a) = (fun (x : + ℝ × ℝ) => x + GaussianRealPoint (↑u : GaussianInt)) '' P3776T1OpenStar P a) ∧ ∀ (u + : ↥P.lattice), ∀ (v : ↥P.lattice), ∀ (a : ι), P.shift u a = P.shift v a → u = v) → + ((∀ (f : P.plane.Face), ∀ (V : Set (ℝ × ℝ)), IsPreconnected V → Disjoint V (frontier + (P.plane.faceRegion f)) → (V ∩ P.plane.faceRegion f).Nonempty → V ⊆ + P.plane.faceRegion f) → ((∀ (f : P.plane.Face), Disjoint (P3767T1FixedTrace + P.plane) (U f)) → ((∀ (f : P.plane.Face), C f ⊆ P3767T1FixedTrace P.plane) → ((∀ (f + : P.plane.Face), IsConnected (W f)) → ((∀ (f : P.plane.Face), ¬ Bornology.IsBounded + (W f)) → ((∀ (f : P.plane.Face), ∀ (g : P.plane.Face), (Set.range (P.plane.faceVertex + f) = Set.range (P.plane.faceVertex g)) → (C f = C g)) → (Function.Injective (fun f : + P.plane.Face => Set.range (P.plane.faceVertex f))))))))) ) := by + classical + intro ι P U C W hgeom hbarrier havoid hCtrace hWconnected hWunbounded hboundaryEq f g hv + by_contra hne + have hCfCg : C f = C g := hboundaryEq f g hv + have hRgW : U g ⊆ W f := by + intro x hx + have hnotRf : x ∉ U f := by + intro hxf + exact Set.disjoint_left.mp (P.plane.region_disjoint hne).symm hx hxf + have hnotCf : x ∉ C f := by + intro hxf + exact Set.disjoint_left.mp (havoid g) (hCtrace f hxf) hx + intro hxcl + rw [closure_eq_self_union_frontier] at hxcl + rcases hxcl with hxR | hxC + · exact hnotRf hxR + · exact hnotCf hxC + have hWg : W f ⊆ U g := by + apply hbarrier g (W f) (hWconnected f).isPreconnected + · apply Set.disjoint_left.mpr + intro x hxW hxC + have hxCf : x ∈ C f := hCfCg.symm ▸ hxC + exact hxW (frontier_subset_closure hxCf) + · obtain ⟨x, hx⟩ := (P.plane.region_connected g).nonempty + exact ⟨x, hRgW hx, hx⟩ + have heq : W f = U g := Set.Subset.antisymm hWg hRgW + have hboundG : Bornology.IsBounded (U g) := + (hgeom.2.1 g).isBounded.subset subset_closure + exact hWunbounded f (heq ▸ hboundG) + +private theorem hendpoints : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (a : ι), ∀ (b : ι), P.plane.adjacent a b → + P.plane.position a ∈ P.plane.edgeArc a b ∧ P.plane.position b ∈ P.plane.edgeArc a b ) + := by + classical + intro ι P a b hab + obtain ⟨e, hzero, hone⟩ := P.plane.arc_homeomorph a b hab + constructor + · rw [← hzero] + exact (e ⟨0, by norm_num⟩).property + · rw [← hone] + exact (e ⟨1, by norm_num⟩).property + +private theorem hvertexC : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let C (f : P.plane.Face) := frontier (U f) + ∀ [ Nontrivial ι], (∀ (f : P.plane.Face), C f = P.plane.edgeArc (P.plane.faceVertex + f 0) (P.plane.faceVertex f 1) ∪ P.plane.edgeArc (P.plane.faceVertex f 1) + (P.plane.faceVertex f 2) ∪ P.plane.edgeArc (P.plane.faceVertex f 2) + (P.plane.faceVertex f 0)) → (∀ (f : P.plane.Face), (∀ (a : ι), ∀ (b : ι), + (P.plane.adjacent a b) → (P.plane.position a ∈ P.plane.edgeArc a b ∧ P.plane.position + b ∈ P.plane.edgeArc a b)) → ( + let A : Set ι := Set.range (P.plane.faceVertex f) + ∀ (w : ι), P.plane.position w ∈ C f ↔ w ∈ A)) ) := by + classical + intro ι P U C this hfront f hendpoints A w + constructor + · intro hw + rw [hfront f] at hw + rcases hw with (hw | hw) | hw + · rcases (P3767T1VertexEdgeIncidence P.plane w).2 _ _ + (P.plane.face_edges f 0 1 (by decide)) hw with h | h + · exact ⟨0, h.symm⟩ + · exact ⟨1, h.symm⟩ + · rcases (P3767T1VertexEdgeIncidence P.plane w).2 _ _ + (P.plane.face_edges f 1 2 (by decide)) hw with h | h + · exact ⟨1, h.symm⟩ + · exact ⟨2, h.symm⟩ + · rcases (P3767T1VertexEdgeIncidence P.plane w).2 _ _ + (P.plane.face_edges f 2 0 (by decide)) hw with h | h + · exact ⟨2, h.symm⟩ + · exact ⟨0, h.symm⟩ + · rintro ⟨i, rfl⟩ + fin_cases i + · rw [hfront f] + exact Or.inl (Or.inl + ((hendpoints _ _ (P.plane.face_edges f 0 1 (by decide))).1)) + · rw [hfront f] + exact Or.inl (Or.inr + ((hendpoints _ _ (P.plane.face_edges f 1 2 (by decide))).1)) + · rw [hfront f] + exact Or.inr + ((hendpoints _ _ (P.plane.face_edges f 2 0 (by decide))).1) + +private theorem hedgeTri : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let C (f : P.plane.Face) := frontier (U f) + (∀ (f : P.plane.Face), C f = P.plane.edgeArc (P.plane.faceVertex f 0) (P.plane.faceVertex + f 1) ∪ P.plane.edgeArc (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) ∪ + P.plane.edgeArc (P.plane.faceVertex f 2) (P.plane.faceVertex f 0)) → (∀ (f : + P.plane.Face), ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), i ≠ j → P.plane.edgeArc + (P.plane.faceVertex f i) (P.plane.faceVertex f j) ⊆ C f) ) := by + classical + intro ι P U C hfront f i j hij x hx + rw [hfront f] + fin_cases i <;> fin_cases j <;> dsimp at * + all_goals try exact (hij rfl).elim + all_goals first + | exact Or.inl (Or.inl hx) + | exact Or.inl (Or.inr hx) + | exact Or.inr hx + | rw [P.plane.arc_symmetric] at hx + first + | exact Or.inl (Or.inl hx) + | exact Or.inl (Or.inr hx) + | exact Or.inr hx + +private theorem hstarIntersect : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + ∀ [ Nontrivial ι], (∀ (f : P.plane.Face), Disjoint (P3767T1FixedTrace P.plane) (U + f)) → (∀ (u : ι), ∀ (v : ι), u ≠ v → ∀ x ∈ P3776T1OpenStar P u, x ∈ + P3776T1OpenStar P v → P.plane.adjacent u v) ) := by + classical + intro ι P U this havoid u v huv x hu hv + change x = P.plane.position u ∨ + (∃ c, P.plane.adjacent u c ∧ x ∈ P.plane.edgeArc u c ∧ + x ≠ P.plane.position u ∧ x ≠ P.plane.position c) ∨ + ∃ g, (∃ i, P.plane.faceVertex g i = u) ∧ x ∈ U g at hu + change x = P.plane.position v ∨ + (∃ c, P.plane.adjacent v c ∧ x ∈ P.plane.edgeArc v c ∧ + x ≠ P.plane.position v ∧ x ≠ P.plane.position c) ∨ + ∃ g, (∃ i, P.plane.faceVertex g i = v) ∧ x ∈ U g at hv + have hposTrace (w : ι) : P.plane.position w ∈ P3767T1FixedTrace P.plane := + Or.inl ⟨w, rfl⟩ + rcases hu with hxu | ⟨c, huc, hxuArc, hxun, hxc⟩ | ⟨g, hgu, hxg⟩ + · rcases hv with hxv | ⟨d, hvd, hxvArc, hxvn, hxd⟩ | ⟨g, hgv, hxg⟩ + · exact (huv (P.plane.position_injective (hxu.symm.trans hxv))).elim + · have hvtx := (P3767T1VertexEdgeIncidence P.plane u).2 v d hvd + (hxu ▸ hxvArc) + rcases hvtx with h | h + · exact (huv h).elim + · exact (hxd (hxu.trans (congrArg P.plane.position h))).elim + · exact (Set.disjoint_left.mp (havoid g) (hposTrace u) (hxu ▸ hxg)).elim + · rcases hv with hxv | ⟨d, hvd, hxvArc, hxvn, hxd⟩ | ⟨g, hgv, hxg⟩ + · have hvtx := (P3767T1VertexEdgeIncidence P.plane v).2 u c huc + (hxv.symm ▸ hxuArc) + rcases hvtx with h | h + · exact (huv h.symm).elim + · exact (hxc (hxv.trans (congrArg P.plane.position h))).elim + · by_cases hend : ({u, c} : Set ι) = {v, d} + · have humem : u ∈ ({v, d} : Set ι) := by rw [← hend]; simp + rcases Set.mem_insert_iff.mp humem with h | h + · exact (huv h).elim + · have hdu : d = u := (Set.mem_singleton_iff.mp h).symm + have hvu : P.plane.adjacent v u := hdu ▸ hvd + exact (P.plane.adjacent_symmetric u v).mpr hvu + · have hboth := P.plane.arc_intersections u c v d huc hvd hend + have hxin : x ∈ P.plane.position '' (({u, c} : Set ι) ∩ {v, d}) := by + rw [← hboth] + exact ⟨hxuArc, hxvArc⟩ + obtain ⟨w, hw, hxw⟩ := hxin + rcases Set.mem_insert_iff.mp hw.1 with h | h + · subst w + exact (hxun (hxw.symm)).elim + · subst w + exact (hxc (hxw.symm)).elim + · exact (Set.disjoint_left.mp (havoid g) + (Or.inr ⟨u, c, huc, hxuArc⟩) hxg).elim + · rcases hv with hxv | ⟨d, hvd, hxvArc, hxvn, hxd⟩ | ⟨h, hvh, hxh⟩ + · exact (Set.disjoint_left.mp (havoid g) (hposTrace v) (hxv ▸ hxg)).elim + · exact (Set.disjoint_left.mp (havoid g) + (Or.inr ⟨v, d, hvd, hxvArc⟩) hxg).elim + · have hface : g = h := by + by_contra hne + exact Set.disjoint_left.mp (P.plane.region_disjoint hne) hxg hxh + subst h + obtain ⟨i, hi⟩ := hgu + obtain ⟨j, hj⟩ := hvh + have hij : i ≠ j := by + intro hij + exact huv (hi.symm.trans (hij ▸ hj)) + simpa only [hi, hj] using P.plane.face_edges g i j hij + +private theorem hstarCoverW : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let C (f : P.plane.Face) := frontier (U f) + let W (f : P.plane.Face) := (closure (U f))ᶜ + (Function.Injective (fun f : P.plane.Face => Set.range (P.plane.faceVertex f))) → (∀ (f : + P.plane.Face), + let A : Set ι := Set.range (P.plane.faceVertex f) + (∀ (w : ι), P.plane.position w ∈ C f ↔ w ∈ A) → ((∀ (i : Fin 3), ∀ (j : Fin 3), (i ≠ j) → + (P.plane.edgeArc (P.plane.faceVertex f i) (P.plane.faceVertex f j) ⊆ C f)) → (∀ x ∈ W + f, ∃ v ∉ A, x ∈ P3776T1OpenStar P v))) ) := by + classical + intro ι P U C W hinj f A hvertexC hedgeTri x hxW + have hcover : x ∈ Set.range P.plane.position ∪ + {p | ∃ u v, P.plane.adjacent u v ∧ p ∈ P.plane.edgeArc u v} ∪ + {p | ∃ g, p ∈ U g} := by + rw [P.plane.plane_cover] + exact Set.mem_univ x + rcases hcover with (⟨u, rfl⟩ | ⟨u, v, huv, hxarc⟩) | ⟨g, hxg⟩ + · have huA : u ∉ A := by + intro huA + exact hxW (frontier_subset_closure (hvertexC u |>.2 huA)) + exact ⟨u, huA, Or.inl rfl⟩ + · by_cases hxu : x = P.plane.position u + · have huA : u ∉ A := by + intro huA + exact hxW (frontier_subset_closure (hxu ▸ hvertexC u |>.2 huA)) + exact ⟨u, huA, Or.inl hxu⟩ + · by_cases hxv : x = P.plane.position v + · have hvA : v ∉ A := by + intro hvA + exact hxW (frontier_subset_closure (hxv ▸ hvertexC v |>.2 hvA)) + exact ⟨v, hvA, Or.inl hxv⟩ + · by_cases huA : u ∈ A + · by_cases hvA : v ∈ A + · change u ∈ Set.range (P.plane.faceVertex f) at huA + change v ∈ Set.range (P.plane.faceVertex f) at hvA + obtain ⟨i, hi⟩ := huA + obtain ⟨j, hj⟩ := hvA + have hij : i ≠ j := by + intro hij + have huv' : u = v := by + calc + u = P.plane.faceVertex f i := hi.symm + _ = P.plane.faceVertex f j := congrArg (P.plane.faceVertex f) hij + _ = v := hj + exact P.plane.adjacent_irreflexive u (huv' ▸ huv) + have hxarc' : x ∈ P.plane.edgeArc + (P.plane.faceVertex f i) (P.plane.faceVertex f j) := by + rw [hi, hj] + exact hxarc + exact (hxW (frontier_subset_closure (hedgeTri i j hij hxarc'))).elim + · exact ⟨v, hvA, Or.inr (Or.inl ⟨u, + (P.plane.adjacent_symmetric v u).2 huv, by + rw [P.plane.arc_symmetric] + exact hxarc, hxv, hxu⟩)⟩ + · exact ⟨u, huA, Or.inr (Or.inl ⟨v, huv, hxarc, hxu, hxv⟩)⟩ + · have hsome : ∃ i : Fin 3, P.plane.faceVertex g i ∉ A := by + by_contra hnone + have hall : ∀ i : Fin 3, P.plane.faceVertex g i ∈ A := by + intro i + by_contra hi + exact hnone ⟨i, hi⟩ + have hidx : ∀ i : Fin 3, ∃ j : Fin 3, + P.plane.faceVertex f j = P.plane.faceVertex g i := by + intro i + have hiA := hall i + change P.plane.faceVertex g i ∈ Set.range (P.plane.faceVertex f) at hiA + have hi : P.plane.faceVertex g i ∈ Set.range (P.plane.faceVertex f) := hiA + exact Set.mem_range.mp hi + choose k hk using hidx + have hkinj : Function.Injective k := by + intro i j hij + apply P.plane.face_vertices_distinct g + calc + P.plane.faceVertex g i = P.plane.faceVertex f (k i) := (hk i).symm + _ = P.plane.faceVertex f (k j) := congrArg (P.plane.faceVertex f) hij + _ = P.plane.faceVertex g j := hk j + have hksurj : Function.Surjective k := Finite.surjective_of_injective hkinj + have hfg : Set.range (P.plane.faceVertex f) = Set.range (P.plane.faceVertex g) := by + apply Set.Subset.antisymm + · intro x hx + obtain ⟨i, rfl⟩ := Set.mem_range.mp hx + obtain ⟨j, hji⟩ := hksurj i + refine ⟨j, ?_⟩ + calc + P.plane.faceVertex g j = P.plane.faceVertex f (k j) := (hk j).symm + _ = P.plane.faceVertex f i := congrArg (P.plane.faceVertex f) hji + · intro x hx + obtain ⟨i, rfl⟩ := Set.mem_range.mp hx + exact ⟨k i, hk i⟩ + have hfg' := hinj hfg + subst g + exact hxW (subset_closure hxg) + obtain ⟨i, hi⟩ := hsome + exact ⟨P.plane.faceVertex g i, hi, Or.inr (Or.inr ⟨g, ⟨i, rfl⟩, hxg⟩)⟩ + +private theorem hSopen : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), (Nontrivial ι ∧ (∀ (f : P.plane.Face), + IsCompact (closure (P.plane.faceRegion f))) ∧ (∀ (K : Set (ℝ × ℝ)), IsCompact K → {f + : P.plane.Face | (K ∩ closure (P.plane.faceRegion f)).Nonempty}.Finite) ∧ (∀ (x : ℝ × + ℝ), ∃ (f : P.plane.Face), x ∈ closure (P.plane.faceRegion f)) ∧ (∀ (a : ι), IsOpen + (P3776T1OpenStar P a) ∧ IsCompact (closure (P3776T1OpenStar P a))) ∧ (∀ (x : ℝ × + ℝ), ∃ (a : ι), x ∈ P3776T1OpenStar P a) ∧ (∀ (u : ↥P.lattice), ∀ (a : ι), + P3776T1OpenStar P (P.shift u a) = (fun (x : ℝ × ℝ) => x + GaussianRealPoint (↑u : + GaussianInt)) '' P3776T1OpenStar P a) ∧ ∀ (u : ↥P.lattice), ∀ (v : ↥P.lattice), ∀ + (a : ι), P.shift u a = P.shift v a → u = v) → (∀ (f : P.plane.Face), ∀ (a : ι), + let A : Set ι := Set.range (P.plane.faceVertex f) + let AdjOut : ι → ι → Prop := fun x y => P.plane.adjacent x y ∧ y ∉ A + let Reach (v : ι) : Prop := Relation.ReflTransGen AdjOut a v + let B : Set ι := {v | Reach v} + ∀ (S : Set (ℝ × ℝ)), S = ⋃ v ∈ B, P3776T1OpenStar P v → IsOpen S) ) := by + classical + intro ι P hgeom f a A AdjOut Reach B S hS + rw [hS] + apply isOpen_iUnion + intro v + apply isOpen_iUnion + intro hv + exact (hgeom.2.2.2.2.1 v).1 + +private theorem hTopen : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), (Nontrivial ι ∧ (∀ (f : P.plane.Face), + IsCompact (closure (P.plane.faceRegion f))) ∧ (∀ (K : Set (ℝ × ℝ)), IsCompact K → {f + : P.plane.Face | (K ∩ closure (P.plane.faceRegion f)).Nonempty}.Finite) ∧ (∀ (x : ℝ × + ℝ), ∃ (f : P.plane.Face), x ∈ closure (P.plane.faceRegion f)) ∧ (∀ (a : ι), IsOpen + (P3776T1OpenStar P a) ∧ IsCompact (closure (P3776T1OpenStar P a))) ∧ (∀ (x : ℝ × + ℝ), ∃ (a : ι), x ∈ P3776T1OpenStar P a) ∧ (∀ (u : ↥P.lattice), ∀ (a : ι), + P3776T1OpenStar P (P.shift u a) = (fun (x : ℝ × ℝ) => x + GaussianRealPoint (↑u : + GaussianInt)) '' P3776T1OpenStar P a) ∧ ∀ (u : ↥P.lattice), ∀ (v : ↥P.lattice), ∀ + (a : ι), P.shift u a = P.shift v a → u = v) → (∀ (f : P.plane.Face), ∀ (a : ι), + let A : Set ι := Set.range (P.plane.faceVertex f) + let AdjOut : ι → ι → Prop := fun x y => P.plane.adjacent x y ∧ y ∉ A + let Reach (v : ι) : Prop := Relation.ReflTransGen AdjOut a v + let B : Set ι := {v | Reach v} + let T : Set (Real × Real) := + ⋃ v ∈ {v : ι | v ∉ A ∧ v ∉ B}, P3776T1OpenStar P v + IsOpen T) ) := by + classical + intro ι P hgeom f a A AdjOut Reach B T + apply isOpen_iUnion + intro v + apply isOpen_iUnion + intro hv + exact (hgeom.2.2.2.2.1 v).1 + +private theorem hST : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (f : P.plane.Face), ∀ (a : ι), + let A : Set ι := Set.range (P.plane.faceVertex f) + (∀ (u : ι), ∀ (v : ι), (u ≠ v) → (∀ (x : Real × Real), (x ∈ P3776T1OpenStar P u) → ((x + ∈ P3776T1OpenStar P v) → (P.plane.adjacent u v)))) → ( + let AdjOut : ι → ι → Prop := fun x y => P.plane.adjacent x y ∧ y ∉ A + let Reach (v : ι) : Prop := Relation.ReflTransGen AdjOut a v + let B : Set ι := {v | Reach v} + let S : Set (Real × Real) := ⋃ v ∈ B, P3776T1OpenStar P v + let T : Set (Real × Real) := + ⋃ v ∈ {v : ι | v ∉ A ∧ v ∉ B}, P3776T1OpenStar P v + Disjoint S T) ) := by + classical + intro ι P f a A hstarIntersect AdjOut Reach B S T + apply Set.disjoint_left.mpr + intro x hxS hxT + obtain ⟨u, huB, hxu⟩ := Set.mem_iUnion₂.mp hxS + obtain ⟨v, hvMem, hxv⟩ := Set.mem_iUnion₂.mp hxT + rcases hvMem with ⟨hvA, hvB⟩ + by_cases huv : u = v + · exact hvB (huv ▸ huB) + · have hadj := hstarIntersect u v huv x hxu hxv + have hvReach : v ∈ B := by + change Reach v + exact Relation.ReflTransGen.tail huB ⟨hadj, hvA⟩ + exact hvB hvReach + +private theorem hWcover : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let W (f : P.plane.Face) := (closure (U f))ᶜ + ∀ (f : P.plane.Face), ∀ (a : ι), + let A : Set ι := Set.range (P.plane.faceVertex f) + (∀ (x : Real × Real), (x ∈ W f) → (∃ v ∉ A, x ∈ P3776T1OpenStar P v)) → ( + let AdjOut : ι → ι → Prop := fun x y => P.plane.adjacent x y ∧ y ∉ A + let Reach (v : ι) : Prop := Relation.ReflTransGen AdjOut a v + let B : Set ι := {v | Reach v} + let S : Set (Real × Real) := ⋃ v ∈ B, P3776T1OpenStar P v + let T : Set (Real × Real) := + ⋃ v ∈ {v : ι | v ∉ A ∧ v ∉ B}, P3776T1OpenStar P v + W f ⊆ S ∪ T) ) := by + classical + intro ι P U W f a A hstarCoverW AdjOut Reach B S T x hx + obtain ⟨v, hvA, hxv⟩ := hstarCoverW x hx + by_cases hvB : v ∈ B + · left + change x ∈ ⋃ u : ι, ⋃ _ : u ∈ B, P3776T1OpenStar P u + exact Set.mem_iUnion₂.mpr ⟨v, hvB, hxv⟩ + · right + change x ∈ ⋃ u : ι, ⋃ _ : u ∈ {v : ι | v ∉ A ∧ v ∉ B}, + P3776T1OpenStar P u + exact Set.mem_iUnion₂.mpr ⟨v, ⟨hvA, hvB⟩, hxv⟩ + +private theorem haW : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let C (f : P.plane.Face) := frontier (U f) + let W (f : P.plane.Face) := (closure (U f))ᶜ + (∀ (f : P.plane.Face), Disjoint (P3767T1FixedTrace P.plane) (U f)) → (∀ (f : + P.plane.Face), ∀ (a : ι), (a ∉ Set.range (P.plane.faceVertex f)) → ( + let A : Set ι := Set.range (P.plane.faceVertex f) + (∀ (w : ι), P.plane.position w ∈ C f ↔ w ∈ A) → (P.plane.position a ∈ W f))) ) := by + classical + intro ι P U C W havoid f a ha A hvertexC + have hnotU : P.plane.position a ∉ U f := by + intro h + exact Set.disjoint_left.mp (havoid f) (Or.inl ⟨a, rfl⟩) h + have hnotC : P.plane.position a ∉ C f := by + intro h + exact ha (hvertexC a |>.1 h) + intro hcl + rw [closure_eq_self_union_frontier] at hcl + rcases hcl with h | h + · exact hnotU h + · exact hnotC h + +private theorem haS : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (f : P.plane.Face), ∀ (a : ι), + let A : Set ι := Set.range (P.plane.faceVertex f) + let AdjOut : ι → ι → Prop := fun x y => P.plane.adjacent x y ∧ y ∉ A + let Reach (v : ι) : Prop := Relation.ReflTransGen AdjOut a v + let B : Set ι := {v | Reach v} + (a ∈ B) → ( + let S : Set (Real × Real) := ⋃ v ∈ B, P3776T1OpenStar P v + P.plane.position a ∈ S) ) := by + classical + intro ι P f a A AdjOut Reach B haB S + change P.plane.position a ∈ ⋃ u : ι, ⋃ _ : u ∈ B, P3776T1OpenStar P u + exact Set.mem_iUnion₂.mpr ⟨a, haB, Or.inl rfl⟩ + +private theorem hWS : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let W (f : P.plane.Face) := (closure (U f))ᶜ + (∀ (f : P.plane.Face), IsConnected (W f)) → (∀ (f : P.plane.Face), ∀ (a : ι), + let A : Set ι := Set.range (P.plane.faceVertex f) + let AdjOut : ι → ι → Prop := fun x y => P.plane.adjacent x y ∧ y ∉ A + let Reach (v : ι) : Prop := Relation.ReflTransGen AdjOut a v + let B : Set ι := {v | Reach v} + let S : Set (Real × Real) := ⋃ v ∈ B, P3776T1OpenStar P v + let T : Set (Real × Real) := + ⋃ v ∈ {v : ι | v ∉ A ∧ v ∉ B}, P3776T1OpenStar P v + (IsOpen S) → ((IsOpen T) → ((Disjoint S T) → ((W f ⊆ S ∪ T) → ((P.plane.position a ∈ W f) + → ((P.plane.position a ∈ S) → (W f ⊆ S))))))) ) := by + classical + intro ι P U W hWconnected f a A AdjOut Reach B S T hSopen' hTopen hST hWcover haW haS + have hsep := (isPreconnected_iff_subset_of_disjoint.mp + (hWconnected f).isPreconnected) S T hSopen' hTopen hWcover + (by + ext x + simp only [Set.mem_inter_iff, Set.mem_empty_iff_false, iff_false] + rintro ⟨_, ⟨hxS, hxT⟩⟩ + exact Set.disjoint_left.mp hST hxS hxT) + rcases hsep with hS | hT + · exact hS + · have haT := hT haW + exact (Set.disjoint_left.mp hST haS haT).elim + +private theorem hpositionW : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let C (f : P.plane.Face) := frontier (U f) + let W (f : P.plane.Face) := (closure (U f))ᶜ + (∀ (f : P.plane.Face), Disjoint (P3767T1FixedTrace P.plane) (U f)) → (∀ (f : + P.plane.Face), + let A : Set ι := Set.range (P.plane.faceVertex f) + (∀ (w : ι), P.plane.position w ∈ C f ↔ w ∈ A) → (∀ v ∉ A, P.plane.position v ∈ W f)) ) := by + classical + intro ι P U C W havoid f A hvertexC v hvA + have hnotU : P.plane.position v ∉ U f := by + intro h + exact Set.disjoint_left.mp (havoid f) (Or.inl ⟨v, rfl⟩) h + have hnotC : P.plane.position v ∉ C f := by + intro h + exact hvA (hvertexC v |>.1 h) + intro hcl + rw [closure_eq_self_union_frontier] at hcl + rcases hcl with h | h + · exact hnotU h + · exact hnotC h + +private theorem hReachAll : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), + let U (f : P.plane.Face) := P.plane.faceRegion f + let W (f : P.plane.Face) := (closure (U f))ᶜ + ∀ (f : P.plane.Face), ∀ (a : ι), + let A : Set ι := Set.range (P.plane.faceVertex f) + (∀ (u : ι), ∀ (v : ι), (u ≠ v) → (∀ (x : Real × Real), (x ∈ P3776T1OpenStar P u) → ((x + ∈ P3776T1OpenStar P v) → (P.plane.adjacent u v)))) → ( + let AdjOut : ι → ι → Prop := fun x y => P.plane.adjacent x y ∧ y ∉ A + let Reach (v : ι) : Prop := Relation.ReflTransGen AdjOut a v + let B : Set ι := {v | Reach v} + let S : Set (Real × Real) := ⋃ v ∈ B, P3776T1OpenStar P v + (W f ⊆ S) → ((∀ (v : ι), (v ∉ A) → (P.plane.position v ∈ W f)) → (∀ v ∉ A, v ∈ B))) ) := by + classical + intro ι P U W f a A hstarIntersect AdjOut Reach B S hWS hpositionW v hvA + have hvW := hpositionW v hvA + have hvS := hWS hvW + obtain ⟨u, uB, hvStar⟩ := Set.mem_iUnion₂.mp hvS + by_cases huv : u = v + · exact huv ▸ uB + · have hadj := hstarIntersect u v huv (P.plane.position v) hvStar (Or.inl rfl) + change Reach v + exact Relation.ReflTransGen.tail uB ⟨hadj, hvA⟩ + +private theorem hchain : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (f : P.plane.Face), + let A : Set ι := Set.range (P.plane.faceVertex f) + let AdjOut : ι → ι → Prop := fun x y => P.plane.adjacent x y ∧ y ∉ A + ∀ (p : List ι), (List.IsChain AdjOut p) → (∀ (x : ι), ∀ (y : ι), ∀ (l₁ : List ι), ∀ (l₂ : + List ι), (p = l₁ ++ x :: y :: l₂) → (List.IsChain AdjOut (l₁ ++ x :: y :: l₂))) ) := by + classical + intro ι P f A AdjOut p hpchain x y l₁ l₂ heq + rw [← heq] + exact hpchain + +end FacialDeletionProof + +theorem P3861T1FixedFacialDeletion {ι : Type} (P : PeriodicTileCore ι) : + Function.Injective (fun f : P.plane.Face => Set.range (P.plane.faceVertex f)) ∧ + ∀ f : P.plane.Face, ∀ a b : ι, + a ∉ Set.range (P.plane.faceVertex f) → + b ∉ Set.range (P.plane.faceVertex f) → + ∃ p : List ι, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ x ∈ p, x ∉ Set.range (P.plane.faceVertex f)) ∧ + ∀ x y : ι, ∀ l₁ l₂ : List ι, + p = l₁ ++ x :: y :: l₂ → P.plane.adjacent x y := by +-- BODY + classical + let U (f : P.plane.Face) := P.plane.faceRegion f + let C (f : P.plane.Face) := frontier (U f) + let W (f : P.plane.Face) := (closure (U f))ᶜ + have hgeom := P3776T1FixedGeometry P + let : Nontrivial ι := hgeom.1 + have htrace := P3767T1FixedFaceComponents P.plane + have hbarrier := htrace.2.1 + have havoid (f : P.plane.Face) : + Disjoint (P3767T1FixedTrace P.plane) (U f) := htrace.1 f |>.1 + have hfront (f : P.plane.Face) : + C f = P.plane.edgeArc (P.plane.faceVertex f 0) (P.plane.faceVertex f 1) ∪ + P.plane.edgeArc (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) ∪ + P.plane.edgeArc (P.plane.faceVertex f 2) (P.plane.faceVertex f 0) := + P.plane.face_boundary f + have hCtrace (f : P.plane.Face) : C f ⊆ P3767T1FixedTrace P.plane := + htrace.1 f |>.2 + have hCcompact (f : P.plane.Face) := FacialDeletionProof.hCcompact ι P hfront f + have hWopen (f : P.plane.Face) : IsOpen (W f) := isClosed_closure.isOpen_compl + have hWnonempty (f : P.plane.Face) := FacialDeletionProof.hWnonempty ι P hgeom f + have hWpartition (f : P.plane.Face) := FacialDeletionProof.hWpartition ι P f + have hUsub (f : P.plane.Face) := FacialDeletionProof.hUsub ι P f + have hcomponentU (f : P.plane.Face) (x : Real × Real) + (hx : x ∈ U f) := FacialDeletionProof.hcomponentU ι P hbarrier hUsub f x hx + have hWconnected (f : P.plane.Face) := FacialDeletionProof.hWconnected ι P hfront hWnonempty + hWpartition hUsub hcomponentU f + have hWunbounded (f : P.plane.Face) := FacialDeletionProof.hWunbounded ι P hgeom f + have hboundaryEq (f g : P.plane.Face) + (hv : Set.range (P.plane.faceVertex f) = Set.range (P.plane.faceVertex g)) := + FacialDeletionProof.hboundaryEq ι P hfront f g hv + have hinj := FacialDeletionProof.hinj ι P hgeom hbarrier havoid hCtrace hWconnected hWunbounded + hboundaryEq + refine ⟨hinj, ?_⟩ + intro f a b ha hb + have hendpoints (a b : ι) (hab : P.plane.adjacent a b) := FacialDeletionProof.hendpoints ι P a + b hab + let A : Set ι := Set.range (P.plane.faceVertex f) + have hvertexC (w : ι) := FacialDeletionProof.hvertexC ι P hfront f hendpoints w + have hedgeTri (i j : Fin 3) (hij : i ≠ j) := FacialDeletionProof.hedgeTri ι P hfront f i j hij + have hstarIntersect (u v : ι) (huv : u ≠ v) (x : Real × Real) + (hu : x ∈ P3776T1OpenStar P u) (hv : x ∈ P3776T1OpenStar P v) := + FacialDeletionProof.hstarIntersect ι P havoid u v huv x hu hv + have hstarCoverW (x : Real × Real) (hxW : x ∈ W f) := FacialDeletionProof.hstarCoverW ι P hinj + f hvertexC hedgeTri x hxW + let AdjOut : ι → ι → Prop := fun x y => P.plane.adjacent x y ∧ y ∉ A + let Reach (v : ι) : Prop := Relation.ReflTransGen AdjOut a v + let B : Set ι := {v | Reach v} + have haB : a ∈ B := Relation.ReflTransGen.refl + have hSopen (S : Set (Real × Real)) + (hS : S = ⋃ v ∈ B, P3776T1OpenStar P v) := FacialDeletionProof.hSopen ι P hgeom f a S hS + let S : Set (Real × Real) := ⋃ v ∈ B, P3776T1OpenStar P v + let T : Set (Real × Real) := + ⋃ v ∈ {v : ι | v ∉ A ∧ v ∉ B}, P3776T1OpenStar P v + have hSopen' : IsOpen S := hSopen S rfl + have hTopen := FacialDeletionProof.hTopen ι P hgeom f a + have hST := FacialDeletionProof.hST ι P f a hstarIntersect + have hWcover := FacialDeletionProof.hWcover ι P f a hstarCoverW + have haW := FacialDeletionProof.haW ι P havoid f a ha hvertexC + have haS := FacialDeletionProof.haS ι P f a haB + have hWS := FacialDeletionProof.hWS ι P hWconnected f a hSopen' hTopen hST hWcover haW haS + have hpositionW (v : ι) (hvA : v ∉ A) := FacialDeletionProof.hpositionW ι P havoid f hvertexC v + hvA + have hReachAll (v : ι) (hvA : v ∉ A) := FacialDeletionProof.hReachAll ι P f a hstarIntersect + hWS hpositionW v hvA + have hpath : Relation.ReflTransGen AdjOut a b := by + exact hReachAll b hb + obtain ⟨p, hpne, hpchain, hphead, hplast⟩ := + List.exists_isChain_ne_nil_of_relationReflTransGen hpath + refine ⟨p, ?_, ?_, ?_, ?_⟩ + · calc + p.head? = some (p.head hpne) := List.head?_eq_some_head hpne + _ = some a := congrArg some hphead + · calc + p.getLast? = some (p.getLast hpne) := List.getLast?_eq_getLast_of_ne_nil hpne + _ = some b := congrArg some hplast + · intro x hx + have hall := hpchain.induction (fun z => z ∉ A) p + (fun {u v} huv hu => huv.2) + (by + intro hne + simpa [A, hphead] using ha) x hx + exact hall + · intro x y l₁ l₂ heq + have hchain := FacialDeletionProof.hchain ι P f p hpchain x y l₁ l₂ heq + exact (List.isChain_append_cons_cons.mp hchain).2.1.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3861T1RealPolygonDomains.lean b/LeanPool/ApollonianSuperharmonic/P3861T1RealPolygonDomains.lean new file mode 100644 index 0000000000..848b1e3ca4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3861T1RealPolygonDomains.lean @@ -0,0 +1,697 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundaryReduction +public import LeanPool.ApollonianSuperharmonic.P3475T1PolygonTriangleConstruction +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundaryRestoration +public import LeanPool.ApollonianSuperharmonic.P3475T1PolygonalSeparation +public import Mathlib.Topology.MetricSpace.Lipschitz +public import Mathlib.Topology.MetricSpace.Contracting +public import Mathlib.Analysis.Normed.Affine.AddTorsor +public import Mathlib.Topology.Order.Compact + +-- [TABLET NODE: P3861T1RealPolygonDomains] + +/-! +# P3861T1RealPolygonDomains + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RealPolygonGeometry + +open Set AffineMap + +private theorem angle : + (by + classical + exact + ∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), ∀ (c : ℝ × ℝ), (a ≠ b) → ((a ≠ c) → ((segment ℝ a b ∩ + segment ℝ a c ⊆ {a}) → (∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, s + + t ≤ K * dist (lineMap a b s) (lineMap a c t)))) ) := by + classical + intro a b c hab hac hi + have hpos : ∀ z ∈ Icc (0 : ℝ) 1, + 0 < ‖z • (b - a) - (1 - z) • (c - a)‖ := by + intro z hz + apply norm_pos_iff.mpr + intro heq + have heq' : z • (b - a) = (1 - z) • (c - a) := sub_eq_zero.mp heq + have hm : lineMap a b z ∈ segment ℝ a b ∩ segment ℝ a c := by + constructor + · exact lineMap_mem_segment ℝ _ _ hz + · have hh : lineMap a b z = lineMap a c (1 - z) := by + simpa only [lineMap_apply, vsub_eq_sub, vadd_eq_add] using + congrArg (fun x : ℝ × ℝ => x + a) heq' + rw [hh] + exact lineMap_mem_segment ℝ _ _ ⟨by linarith [hz.2], by linarith [hz.1]⟩ + have ha : lineMap a b z = a := hi hm + have hz0 : z = 0 := (lineMap_injective ℝ hab) (by simpa using ha) + have hc0 : (1 - z) • (c - a) = 0 := by simpa [hz0] using heq'.symm + have hz1 : z = 1 := by + rcases smul_eq_zero.mp hc0 with hh | hh + · linarith + · exact False.elim (hac (sub_eq_zero.mp hh).symm) + linarith + obtain ⟨ε, hε, hmin⟩ := isCompact_Icc.exists_forall_le' + (f := fun z : ℝ => ‖z • (b - a) - (1 - z) • (c - a)‖) + (by fun_prop) hpos + refine ⟨ε⁻¹, inv_nonneg.mpr hε.le, ?_⟩ + intro s hs t ht + by_cases hst : s + t = 0 + · simp only [hst] + exact mul_nonneg (inv_nonneg.mpr hε.le) dist_nonneg + have hstpos : 0 < s + t := lt_of_le_of_ne (add_nonneg hs.1 ht.1) (Ne.symm hst) + have hz : s / (s + t) ∈ Icc (0 : ℝ) 1 := + ⟨div_nonneg hs.1 hstpos.le, (div_le_one hstpos).mpr (by linarith [ht.1])⟩ + have hscale : + s • (b - a) - t • (c - a) = + (s + t) • ((s / (s + t)) • (b - a) - (1 - s / (s + t)) • (c - a)) := by + have h₁ : (s + t) * (s / (s + t)) = s := by field_simp + have h₂ : (s + t) * (1 - s / (s + t)) = t := by field_simp; ring + conv_rhs => rw [smul_sub, smul_smul, smul_smul] + rw [h₁, h₂] + have hd : dist (lineMap a b s) (lineMap a c t) = + (s + t) * ‖(s / (s + t)) • (b - a) - (1 - s / (s + t)) • (c - a)‖ := by + rw [dist_eq_norm] + have hh : lineMap a b s - lineMap a c t = s • (b - a) - t • (c - a) := by + simp only [lineMap_apply, vsub_eq_sub, vadd_eq_add] + abel + rw [hh, hscale, norm_smul, Real.norm_eq_abs, abs_of_pos hstpos] + rw [hd] + calc + s + t = ε⁻¹ * ((s + t) * ε) := by field_simp + _ ≤ _ := by gcongr; exact hmin _ hz + +private theorem shared : + (by + classical + exact + (∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), ∀ (c : ℝ × ℝ), (a ≠ b) → ((a ≠ c) → ((segment ℝ a b ∩ + segment ℝ a c ⊆ {a}) → (∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, s + + t ≤ K * dist (lineMap a b s) (lineMap a c t))))) → (∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), ∀ + (c : ℝ × ℝ), (a ≠ b) → ((a ≠ c) → ((segment ℝ a b ∩ segment ℝ a c ⊆ {a}) → (∀ (f : (ℝ + × ℝ) → ℝ), ∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, dist (lineMap + (f a) (f b) s) (lineMap (f a) (f c) t) ≤ K * dist (lineMap a b s) (lineMap a c t))))) + ) := by + classical + intro angle a b c hab hac hi f + obtain ⟨A, hA, hbound⟩ := angle a b c hab hac hi + let D := dist (f a) (f b) + dist (f a) (f c) + have hD : 0 ≤ D := add_nonneg dist_nonneg dist_nonneg + refine ⟨A * D, mul_nonneg hA hD, ?_⟩ + intro s hs t ht + calc + _ ≤ dist (lineMap (f a) (f b) s) (f a) + + dist (f a) (lineMap (f a) (f c) t) := dist_triangle _ _ _ + _ = s * dist (f a) (f b) + t * dist (f a) (f c) := by + rw [dist_lineMap_left, dist_left_lineMap] + simp only [Real.norm_eq_abs, abs_of_nonneg hs.1, abs_of_nonneg ht.1] + _ ≤ (s + t) * D := by + dsimp [D] + nlinarith [mul_nonneg hs.1 (dist_nonneg (x := f a) (y := f c)), + mul_nonneg ht.1 (dist_nonneg (x := f a) (y := f b))] + _ ≤ (A * dist (lineMap a b s) (lineMap a c t)) * D := + mul_le_mul_of_nonneg_right (hbound s hs t ht) hD + _ = _ := by ring + +private theorem same : + (by + classical + exact + ∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), (a ≠ b) → (∀ (f : (ℝ × ℝ) → ℝ), ∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc + (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, dist (lineMap (f a) (f b) s) (lineMap (f a) (f b) t) + ≤ K * dist (lineMap a b s) (lineMap a b t)) ) := by + classical + intro a b hab f + have hpos : 0 < dist a b := dist_pos.mpr hab + refine ⟨dist (f a) (f b) / dist a b, div_nonneg dist_nonneg hpos.le, ?_⟩ + intro s hs t ht + rw [dist_lineMap_lineMap, dist_lineMap_lineMap] + exact le_of_eq (by field_simp) + +private theorem separate : + (by + classical + exact + ∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), ∀ (c : ℝ × ℝ), ∀ (d : ℝ × ℝ), (Disjoint (segment ℝ a b) + (segment ℝ c d)) → (∀ (f : (ℝ × ℝ) → ℝ), ∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ + Icc (0 : ℝ) 1, dist (lineMap (f a) (f b) s) (lineMap (f c) (f d) t) ≤ K * dist + (lineMap a b s) (lineMap c d t)) ) := by + classical + intro a b c d hi f + have hpos : ∀ z ∈ (Icc (0 : ℝ) 1 ×ˢ Icc (0 : ℝ) 1), + 0 < dist (lineMap a b z.1) (lineMap c d z.2) := by + intro z hz + apply dist_pos.mpr + intro h + exact Set.disjoint_left.mp hi (lineMap_mem_segment ℝ _ _ hz.1) + (h ▸ lineMap_mem_segment ℝ _ _ hz.2) + obtain ⟨ε, hε, hmin⟩ := (isCompact_Icc.prod isCompact_Icc).exists_forall_le' + (f := fun z : ℝ × ℝ => dist (lineMap a b z.1) (lineMap c d z.2)) + (by fun_prop) hpos + let D := dist (f a) (f b) + dist (f a) (f c) + dist (f c) (f d) + have hD : 0 ≤ D := add_nonneg (add_nonneg dist_nonneg dist_nonneg) dist_nonneg + refine ⟨D / ε, div_nonneg hD hε.le, ?_⟩ + intro s hs t ht + have hbound : dist (lineMap (f a) (f b) s) (lineMap (f c) (f d) t) ≤ D := by + calc + _ ≤ dist (lineMap (f a) (f b) s) (f a) + dist (f a) (f c) + + dist (f c) (lineMap (f c) (f d) t) := dist_triangle4 _ _ _ _ + _ = s * dist (f a) (f b) + dist (f a) (f c) + t * dist (f c) (f d) := by + rw [dist_lineMap_left, dist_left_lineMap] + simp only [Real.norm_eq_abs, abs_of_nonneg hs.1, abs_of_nonneg ht.1] + _ ≤ D := by + dsimp [D] + nlinarith [mul_nonneg (sub_nonneg.mpr hs.2) (dist_nonneg (x := f a) (y := f b)), + mul_nonneg (sub_nonneg.mpr ht.2) (dist_nonneg (x := f c) (y := f d))] + calc + _ ≤ D := hbound + _ = (D / ε) * ε := by field_simp + _ ≤ _ := mul_le_mul_of_nonneg_left (hmin (s, t) ⟨hs, ht⟩) (div_nonneg hD hε.le) + +private theorem first : + (by + classical + exact + (∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), ∀ (c : ℝ × ℝ), (a ≠ b) → ((a ≠ c) → ((segment ℝ a b ∩ + segment ℝ a c ⊆ {a}) → (∀ (f : (ℝ × ℝ) → ℝ), ∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ + t ∈ Icc (0 : ℝ) 1, dist (lineMap (f a) (f b) s) (lineMap (f a) (f c) t) ≤ K * dist + (lineMap a b s) (lineMap a c t))))) → ((∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), (a ≠ b) → (∀ (f + : (ℝ × ℝ) → ℝ), ∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, dist + (lineMap (f a) (f b) s) (lineMap (f a) (f b) t) ≤ K * dist (lineMap a b s) (lineMap a + b t))) → (∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), ∀ (c : ℝ × ℝ), (a ≠ b) → ((a ≠ c) → ((∀ x ∈ + segment ℝ a b ∩ segment ℝ a c, + (x = a ∨ x = b) ∧ (x = a ∨ x = c)) → (∀ (f : (ℝ × ℝ) → ℝ), ∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc + (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, dist (lineMap (f a) (f b) s) (lineMap (f a) (f c) + t) ≤ K * dist (lineMap a b s) (lineMap a c t)))))) ) := by + classical + intro shared same a b c hab hac hi f + by_cases hbc : b = c + · subst c + exact same a b hab f + apply shared a b c hab hac ?_ f + intro x hx + rcases hi x hx with ⟨h₁, h₂⟩ + rcases h₁ with rfl | rfl + · rfl + · rcases h₂ with h | h + · exact h + · exact False.elim (hbc h) + +private theorem reverse_left : + (by + classical + exact + ∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), ∀ (c : ℝ × ℝ), ∀ (d : ℝ × ℝ), ∀ (f : (ℝ × ℝ) → ℝ), (∃ K : + ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, + dist (lineMap (f a) (f b) s) (lineMap (f c) (f d) t) ≤ + K * dist (lineMap a b s) (lineMap c d t)) → (∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, + ∀ t ∈ Icc (0 : ℝ) 1, dist (lineMap (f b) (f a) s) (lineMap (f c) (f d) t) ≤ K * + dist (lineMap b a s) (lineMap c d t)) ) := by + classical + intro a b c d f h + obtain ⟨K, hK, hb⟩ := h + refine ⟨K, hK, fun s hs t ht => ?_⟩ + simpa only [lineMap_apply_one_sub] using + hb (1 - s) ⟨by linarith [hs.2], by linarith [hs.1]⟩ t ht + +private theorem reverse_right : + (by + classical + exact + ∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), ∀ (c : ℝ × ℝ), ∀ (d : ℝ × ℝ), ∀ (f : (ℝ × ℝ) → ℝ), (∃ K : + ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, + dist (lineMap (f a) (f b) s) (lineMap (f c) (f d) t) ≤ + K * dist (lineMap a b s) (lineMap c d t)) → (∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, + ∀ t ∈ Icc (0 : ℝ) 1, dist (lineMap (f a) (f b) s) (lineMap (f d) (f c) t) ≤ K * + dist (lineMap a b s) (lineMap d c t)) ) := by + classical + intro a b c d f h + obtain ⟨K, hK, hb⟩ := h + refine ⟨K, hK, fun s hs t ht => ?_⟩ + simpa only [lineMap_apply_one_sub] using + hb s hs (1 - t) ⟨by linarith [ht.2], by linarith [ht.1]⟩ + +private theorem pair_bound : + (by + classical + exact + (∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), ∀ (c : ℝ × ℝ), ∀ (d : ℝ × ℝ), (Disjoint (segment ℝ a b) + (segment ℝ c d)) → (∀ (f : (ℝ × ℝ) → ℝ), ∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ + Icc (0 : ℝ) 1, dist (lineMap (f a) (f b) s) (lineMap (f c) (f d) t) ≤ K * dist + (lineMap a b s) (lineMap c d t))) → ((∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), ∀ (c : ℝ × ℝ), (a + ≠ b) → ((a ≠ c) → ((∀ x ∈ segment ℝ a b ∩ segment ℝ a c, (x = a ∨ x = b) ∧ (x = a ∨ x + = c)) → (∀ (f : (ℝ × ℝ) → ℝ), ∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) + 1, dist (lineMap (f a) (f b) s) (lineMap (f a) (f c) t) ≤ K * dist (lineMap a b s) + (lineMap a c t))))) → ((∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), ∀ (c : ℝ × ℝ), ∀ (d : ℝ × ℝ), ∀ + (f : (ℝ × ℝ) → ℝ), (∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, dist + (lineMap (f a) (f b) s) (lineMap (f c) (f d) t) ≤ K * dist (lineMap a b s) (lineMap c + d t)) → (∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, dist (lineMap (f + b) (f a) s) (lineMap (f c) (f d) t) ≤ K * dist (lineMap b a s) (lineMap c d t))) → + ((∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), ∀ (c : ℝ × ℝ), ∀ (d : ℝ × ℝ), ∀ (f : (ℝ × ℝ) → ℝ), (∃ + K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, dist (lineMap (f a) (f b) s) + (lineMap (f c) (f d) t) ≤ K * dist (lineMap a b s) (lineMap c d t)) → (∃ K : ℝ, 0 ≤ K + ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, dist (lineMap (f a) (f b) s) (lineMap (f + d) (f c) t) ≤ K * dist (lineMap a b s) (lineMap d c t))) → (∀ (a : ℝ × ℝ), ∀ (b : ℝ × + ℝ), ∀ (c : ℝ × ℝ), ∀ (d : ℝ × ℝ), (a ≠ b) → ((c ≠ d) → ((∀ x ∈ segment ℝ a b ∩ + segment ℝ c d, + (x = a ∨ x = b) ∧ (x = c ∨ x = d)) → (∀ (f : (ℝ × ℝ) → ℝ), ∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc + (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, dist (lineMap (f a) (f b) s) (lineMap (f c) (f d) + t) ≤ K * dist (lineMap a b s) (lineMap c d t)))))))) ) := by + classical + intro separate first reverse_left reverse_right a b c d hab hcd hi f + by_cases hac : a = c + · subst c + exact first a b d hab hcd hi f + by_cases had : a = d + · subst d + apply reverse_right a b a c f + apply first a b c hab hcd.symm + intro x hx + have hh := hi x (by simpa only [segment_symm ℝ a c] using hx) + exact ⟨hh.1, hh.2.symm⟩ + by_cases hbc : b = c + · subst c + apply reverse_left b a b d f + apply first b a d hab.symm hcd + intro x hx + have hh := hi x (by simpa only [segment_symm ℝ b a] using hx) + exact ⟨hh.1.symm, hh.2⟩ + by_cases hbd : b = d + · subst d + apply reverse_left b a c b f + apply reverse_right b a b c f + apply first b a c hab.symm hcd.symm + intro x hx + have hh := hi x (by simpa only [segment_symm ℝ b a, segment_symm ℝ b c] using hx) + exact ⟨hh.1.symm, hh.2.symm⟩ + apply separate a b c d ?_ f + rw [Set.disjoint_left] + intro x hx hy + rcases hi x ⟨hx, hy⟩ with ⟨h₁, h₂⟩ + rcases h₁ with rfl | rfl <;> rcases h₂ with h | h + · exact hac h + · exact had h + · exact hbc h + · exact hbd h + +private theorem boundary_extension : + (by + classical + exact + (∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), (a ≠ b) → (∀ (f : (ℝ × ℝ) → ℝ), ∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc + (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, dist (lineMap (f a) (f b) s) (lineMap (f a) (f b) t) + ≤ K * dist (lineMap a b s) (lineMap a b t))) → ((∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), ∀ (c : + ℝ × ℝ), ∀ (d : ℝ × ℝ), (a ≠ b) → ((c ≠ d) → ((∀ x ∈ segment ℝ a b ∩ segment ℝ c d, (x + = a ∨ x = b) ∧ (x = c ∨ x = d)) → (∀ (f : (ℝ × ℝ) → ℝ), ∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 + : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, dist (lineMap (f a) (f b) s) (lineMap (f c) (f d) t) ≤ K + * dist (lineMap a b s) (lineMap c d t))))) → (∀ {n : ℕ}, ∀ (p : Fin (n + 3) → ℝ × ℝ), + (Function.Injective p) → ((∀ i j : Fin (n + 3), i ≠ j → + segment ℝ (p i) (p (i + 1)) ∩ segment ℝ (p j) (p (j + 1)) = + {x | (x = p i ∨ x = p (i + 1)) ∧ (x = p j ∨ x = p (j + 1))}) → (∀ (f : (ℝ × ℝ) → + ℝ), ∃ (K : NNReal) (g : (ℝ × ℝ) → ℝ), LipschitzWith K g ∧ ∀ i, ∀ (t : ℝ), t ∈ + Icc (0 : ℝ) 1 → g (lineMap (p i) (p (i + 1)) t) = lineMap (f (p i)) (f (p (i + + 1))) t)))) ) := by + classical + intro same pair_bound n p hi he f + classical + have hne : ∀ i : Fin (n + 3), p i ≠ p (i + 1) := by + intro i hh + simpa using (hi hh).symm + have hb : ∀ i j : Fin (n + 3), ∃ K : ℝ, 0 ≤ K ∧ + ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, + dist (lineMap (f (p i)) (f (p (i + 1))) s) + (lineMap (f (p j)) (f (p (j + 1))) t) ≤ + K * dist (lineMap (p i) (p (i + 1)) s) (lineMap (p j) (p (j + 1)) t) := by + intro i j + by_cases hij : i = j + · subst j + exact same _ _ (hne i) f + apply pair_bound _ _ _ _ (hne i) (hne j) ?_ f + intro x hx + simpa only [he i j hij, Set.mem_ofPred] using hx + choose B hB hbound using hb + let K : NNReal := ⟨∑ i, ∑ j, B i j, Finset.sum_nonneg (fun i _ => + Finset.sum_nonneg (fun j _ => hB i j))⟩ + have hBK : ∀ i j, B i j ≤ (K : ℝ) := by + intro i j + exact le_trans (Finset.single_le_sum (fun j _ => hB i j) (Finset.mem_univ j)) + (Finset.single_le_sum (fun i _ => Finset.sum_nonneg (fun j _ => hB i j)) (Finset.mem_univ i)) + let C := ⋃ i, segment ℝ (p i) (p (i + 1)) + have hrep : ∀ x ∈ C, ∃ i, ∃ t ∈ Icc (0 : ℝ) 1, + lineMap (p i) (p (i + 1)) t = x := by + intro x hx + obtain ⟨i, hi⟩ := mem_iUnion.mp hx + rw [segment_eq_image_lineMap] at hi + obtain ⟨t, ht, heq⟩ := hi + exact ⟨i, t, ht, heq⟩ + let g₀ : (ℝ × ℝ) → ℝ := fun x => if hx : x ∈ C then + lineMap (f (p (hrep x hx).choose)) (f (p ((hrep x hx).choose + 1))) + (hrep x hx).choose_spec.choose else 0 + have hg₀ : ∀ x ∈ C, ∃ i, ∃ t ∈ Icc (0 : ℝ) 1, + lineMap (p i) (p (i + 1)) t = x ∧ + g₀ x = lineMap (f (p i)) (f (p (i + 1))) t := by + intro x hx + refine ⟨(hrep x hx).choose, (hrep x hx).choose_spec.choose, + (hrep x hx).choose_spec.choose_spec.1, + (hrep x hx).choose_spec.choose_spec.2, ?_⟩ + simp only [g₀, dite_eq_left hx] + have hlip : LipschitzOnWith K g₀ C := by + apply LipschitzOnWith.of_dist_le_mul + intro x hx y hy + obtain ⟨i, s, hs, rfl, hsval⟩ := hg₀ x hx + obtain ⟨j, t, ht, rfl, htval⟩ := hg₀ y hy + rw [hsval, htval] + exact (hbound i j s hs t ht).trans (mul_le_mul_of_nonneg_right (hBK i j) dist_nonneg) + obtain ⟨g, hg, hgeq⟩ := hlip.extend_real + refine ⟨K, g, hg, ?_⟩ + intro i t ht + have hx : lineMap (p i) (p (i + 1)) t ∈ C := + mem_iUnion.mpr ⟨i, lineMap_mem_segment ℝ _ _ ht⟩ + rw [← hgeq hx] + obtain ⟨j, s, hs, heq, hval⟩ := hg₀ _ hx + rw [hval] + apply dist_le_zero.mp + have hh := hbound j i s hs t ht + rw [heq, dist_self, mul_zero] at hh + exact hh + +private theorem perturbation : + (by + classical + exact + ∀ (F : (ℝ × ℝ) → (ℝ × ℝ)), (LipschitzWith (1 / 2) F) → (∃ H : (ℝ × ℝ) ≃ₜ (ℝ × ℝ), (∀ x, H + x = x + F x) ∧ LipschitzWith (3 / 2) H ∧ AntilipschitzWith 2 H) ) := by + classical + intro F hF + classical + let h : (ℝ × ℝ) → (ℝ × ℝ) := fun x => x + F x + have hlip : LipschitzWith (3 / 2) h := by + apply LipschitzWith.of_dist_le_mul + intro x y + have hh : dist (h x) (h y) ≤ dist x y + dist (F x) (F y) := dist_add_add_le _ _ _ _ + have hb := hF.dist_le_mul x y + norm_num at hb ⊢ + linarith + have hanti : AntilipschitzWith 2 h := by + apply AntilipschitzWith.of_le_mul_dist + intro x y + have hh : dist x y ≤ dist (h x) (h y) + dist (F x) (F y) := by + calc + _ = dist (h x - F x) (h y - F y) := by simp only [h, add_sub_cancel_right] + _ ≤ _ := dist_sub_sub_le _ _ _ _ + have hb := hF.dist_le_mul x y + norm_num at hb ⊢ + linarith + have hsurj : Function.Surjective h := by + intro y + let g : (ℝ × ℝ) → (ℝ × ℝ) := fun x => y - F x + have hg : ContractingWith (1 / 2) g := by + refine ⟨by norm_num, ?_⟩ + simpa only [zero_add] using (LipschitzWith.const y).sub hF + refine ⟨hg.fixedPoint, ?_⟩ + have hfix : y - F (hg.fixedPoint) = hg.fixedPoint := hg.fixedPoint_isFixedPt + exact eq_sub_iff_add_eq.mp hfix.symm + let e := Equiv.ofBijective h ⟨hanti.injective, hsurj⟩ + let H : (ℝ × ℝ) ≃ₜ (ℝ × ℝ) := e.toHomeomorphOfIsInducing (hanti.isInducing hlip.continuous) + exact ⟨H, fun _ => rfl, hlip, hanti⟩ + +private theorem rationalize : + (by + classical + exact + (∀ {n : ℕ}, ∀ (p : Fin (n + 3) → ℝ × ℝ), (Function.Injective p) → ((∀ i j : Fin (n + 3), + i ≠ j → segment ℝ (p i) (p (i + 1)) ∩ segment ℝ (p j) (p (j + 1)) = {x | (x = p i ∨ x + = p (i + 1)) ∧ (x = p j ∨ x = p (j + 1))}) → (∀ (f : (ℝ × ℝ) → ℝ), ∃ (K : NNReal) (g + : (ℝ × ℝ) → ℝ), LipschitzWith K g ∧ ∀ i, ∀ (t : ℝ), t ∈ Icc (0 : ℝ) 1 → g (lineMap (p + i) (p (i + 1)) t) = lineMap (f (p i)) (f (p (i + 1))) t))) → ((∀ (F : (ℝ × ℝ) → (ℝ × + ℝ)), (LipschitzWith (1 / 2) F) → (∃ H : (ℝ × ℝ) ≃ₜ (ℝ × ℝ), (∀ x, H x = x + F x) ∧ + LipschitzWith (3 / 2) H ∧ AntilipschitzWith 2 H)) → (∀ {n : ℕ}, ∀ (p : Fin (n + 3) → + ℝ × ℝ), (Function.Injective p) → ((∀ i j : Fin (n + 3), i ≠ j → + segment ℝ (p i) (p (i + 1)) ∩ segment ℝ (p j) (p (j + 1)) = + {x | (x = p i ∨ x = p (i + 1)) ∧ (x = p j ∨ x = p (j + 1))}) → (∃ (H : (ℝ × ℝ) ≃ₜ + (ℝ × ℝ)) (r : Fin (n + 3) → ℝ × ℝ), (∀ i, ∃ a b : ℚ, r i = ((a : ℝ), (b : ℝ))) + ∧ LipschitzWith (3 / 2) H ∧ AntilipschitzWith 2 H ∧ (∀ i, H (p i) = r i) ∧ (∀ + i, H '' segment ℝ (p i) (p (i + 1)) = segment ℝ (r i) (r (i + 1))))))) ) := by + classical + intro boundary_extension perturbation n p hi he + classical + have hhats : ∀ k : Fin (n + 3), ∃ (K : NNReal) (g : (ℝ × ℝ) → ℝ), + LipschitzWith K g ∧ ∀ i (t : ℝ), t ∈ Icc (0 : ℝ) 1 → + g (lineMap (p i) (p (i + 1)) t) = + lineMap (if i = k then 1 else 0 : ℝ) (if i + 1 = k then 1 else 0) t := by + intro k + simpa only [hi.eq_iff] using + boundary_extension p hi he (fun x => if x = p k then (1 : ℝ) else 0) + choose K g hg hval using hhats + let S : ℝ := ∑ k, (K k : ℝ) + have hS : 0 ≤ S := Finset.sum_nonneg (fun _ _ => NNReal.coe_nonneg _) + let δ : ℝ := (2 * (S + 1))⁻¹ + have hδ : 0 < δ := inv_pos.mpr (by positivity) + have hδS : δ * S ≤ (1 / 2 : ℝ) := by + have hh : δ * (S + 1) = (1 / 2 : ℝ) := by + dsimp [δ] + field_simp + nlinarith + have hr : ∀ i : Fin (n + 3), ∃ a b : ℚ, + ‖((a : ℝ), (b : ℝ)) - p i‖ ≤ δ := by + intro i + obtain ⟨a, ha₁, ha₂⟩ := exists_rat_btwn (show (p i).1 - δ < (p i).1 + δ by linarith) + obtain ⟨b, hb₁, hb₂⟩ := exists_rat_btwn (show (p i).2 - δ < (p i).2 + δ by linarith) + refine ⟨a, b, ?_⟩ + rw [Prod.norm_def, max_le_iff] + constructor <;> change |(_ : ℝ) - _| ≤ δ <;> rw [abs_le] <;> constructor <;> linarith + choose a b hr using hr + let r : Fin (n + 3) → ℝ × ℝ := fun i => ((a i : ℝ), (b i : ℝ)) + let d := fun i => r i - p i + let F : (ℝ × ℝ) → ℝ × ℝ := fun x => ∑ k, g k x • d k + have hF : LipschitzWith (1 / 2) F := by + apply LipschitzWith.of_dist_le_mul + intro x y + calc + dist (F x) (F y) = ‖∑ k, (g k x - g k y) • d k‖ := by + rw [dist_eq_norm] + simp only [F, ← Finset.sum_sub_distrib, sub_smul] + _ ≤ ∑ k, ‖(g k x - g k y) • d k‖ := norm_sum_le _ _ + _ ≤ ∑ k, ((K k : ℝ) * dist x y) * δ := by + apply Finset.sum_le_sum + intro k hk + rw [norm_smul, ← dist_eq_norm] + exact mul_le_mul ((hg k).dist_le_mul x y) (hr k) + (norm_nonneg _) (mul_nonneg (NNReal.coe_nonneg _) dist_nonneg) + _ = (δ * S) * dist x y := by + rw [← Finset.sum_mul, ← Finset.sum_mul] + dsimp [S] + ring + _ ≤ (1 / 2 : NNReal) * dist x y := by + change _ ≤ (1 / 2 : ℝ) * dist x y + exact mul_le_mul_of_nonneg_right hδS dist_nonneg + obtain ⟨H, hH, hlip, hanti⟩ := perturbation F hF + have hFedge : ∀ i (t : ℝ), t ∈ Icc (0 : ℝ) 1 → + F (lineMap (p i) (p (i + 1)) t) = lineMap (d i) (d (i + 1)) t := by + intro i t ht + simp only [F] + simp_rw [hval _ i t ht] + simp only [lineMap_apply, vsub_eq_sub, vadd_eq_add] + simp only [smul_eq_mul, mul_sub] + simp only [sub_smul, add_smul, Finset.sum_add_distrib, Finset.sum_sub_distrib, + mul_ite, mul_one, mul_zero, ite_smul, zero_smul, smul_sub] + simp [Finset.sum_ite_eq] + have hHedge : ∀ i (t : ℝ), t ∈ Icc (0 : ℝ) 1 → + H (lineMap (p i) (p (i + 1)) t) = lineMap (r i) (r (i + 1)) t := by + intro i t ht + rw [hH, hFedge i t ht] + simp only [lineMap_apply, vsub_eq_sub, vadd_eq_add, d] + module + refine ⟨H, r, fun i => ⟨a i, b i, rfl⟩, hlip, hanti, ?_, ?_⟩ + · intro i + simpa using hHedge i 0 ⟨le_rfl, zero_le_one⟩ + · intro i + rw [segment_eq_image_lineMap, segment_eq_image_lineMap, ← Set.image_comp] + apply Set.image_congr + intro t ht + exact hHedge i t ht + +private theorem hrinj : + (by + classical + exact + ∀ (n : Nat), ∀ (p : Fin (n + 3) → Real × Real), (Function.Injective p) → (∀ (H : ℝ × ℝ ≃ₜ + ℝ × ℝ), ∀ (r : Fin (n + (3 : ℕ)) → ℝ × ℝ), (∀ (i : Fin (n + (3 : ℕ))), (H : ℝ × ℝ → ℝ + × ℝ) (p i) = r i) → (Function.Injective r)) ) := by + classical + intro n p hi H r hvert i j hh + apply hi + apply H.injective + simpa only [hvert] using hh + +private theorem hredge : + (by + classical + exact + ∀ (n : Nat), ∀ (p : Fin (n + 3) → Real × Real), (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + + (3 : ℕ))), i ≠ j → segment ℝ (p i) (p (i + (1 : Fin (n + (3 : ℕ))))) ∩ segment ℝ (p + j) (p (j + (1 : Fin (n + (3 : ℕ))))) = {x : ℝ × ℝ | (x = p i ∨ x = p (i + (1 : Fin (n + + (3 : ℕ))))) ∧ (x = p j ∨ x = p (j + (1 : Fin (n + (3 : ℕ)))))}) → (∀ (H : ℝ × ℝ ≃ₜ + ℝ × ℝ), ∀ (r : Fin (n + (3 : ℕ)) → ℝ × ℝ), (∀ (i : Fin (n + (3 : ℕ))), (H : ℝ × ℝ → ℝ + × ℝ) (p i) = r i) → ((∀ (i : Fin (n + (3 : ℕ))), (⇑H : ℝ × ℝ → ℝ × ℝ) '' segment ℝ (p + i) (p (i + (1 : Fin (n + (3 : ℕ))))) = segment ℝ (r i) (r (i + (1 : Fin (n + (3 : + ℕ)))))) → (∀ i j : Fin (n + 3), i ≠ j → segment ℝ (r i) (r (i + 1)) ∩ segment ℝ (r j) + (r (j + 1)) = {x | (x = r i ∨ x = r (i + 1)) ∧ (x = r j ∨ x = r (j + 1))}))) ) := by + classical + intro n p he H r hvert hedge i j hij + rw [← hedge i, ← hedge j, ← Set.image_inter H.injective, he i j hij] + ext x + constructor + · rintro ⟨y, ⟨hy₁, hy₂⟩, rfl⟩ + constructor + · rcases hy₁ with rfl | rfl + · exact Or.inl (hvert i) + · exact Or.inr (hvert (i + 1)) + · rcases hy₂ with rfl | rfl + · exact Or.inl (hvert j) + · exact Or.inr (hvert (j + 1)) + · rintro ⟨hx₁, hx₂⟩ + refine ⟨H.symm x, ⟨?_, ?_⟩, H.apply_symm_apply x⟩ + · rcases hx₁ with h | h + · exact Or.inl (by rw [h, ← hvert i, H.symm_apply_apply]) + · exact Or.inr (by rw [h, ← hvert (i + 1), H.symm_apply_apply]) + · rcases hx₂ with h | h + · exact Or.inl (by rw [h, ← hvert j, H.symm_apply_apply]) + · exact Or.inr (by rw [h, ← hvert (j + 1), H.symm_apply_apply]) + +private theorem hcarrier : + (by + classical + exact + ∀ (n : Nat), ∀ (p : Fin (n + 3) → Real × Real), ∀ (H : ℝ × ℝ ≃ₜ ℝ × ℝ), ∀ (r : Fin (n + + (3 : ℕ)) → ℝ × ℝ), ∀ (hr : ∀ (i : Fin (n + (3 : ℕ))), ∃ (a : ℚ) (b : ℚ), r i = ((↑a : + ℝ), (↑b : ℝ))), (∀ (i : Fin (n + (3 : ℕ))), (⇑H : ℝ × ℝ → ℝ × ℝ) '' segment ℝ (p i) + (p (i + (1 : Fin (n + (3 : ℕ))))) = segment ℝ (r i) (r (i + (1 : Fin (n + (3 : + ℕ)))))) → (∀ (hrinj : Function.Injective r), ∀ (hredge : ∀ i j : Fin (n + 3), i ≠ j → + segment ℝ (r i) (r (i + 1)) ∩ segment ℝ (r j) (r (j + 1)) = {x | (x = r i ∨ x = r (i + + 1)) ∧ (x = r j ∨ x = r (j + 1))}), + let q₀ : P3381T1PolygonBoundary n := ⟨r, hr, hrinj, hredge⟩ + ∀ (m : ℕ), ∀ (q : P3381T1PolygonBoundary m), (P3475T1BoundarySubdivision q q₀) → (H + '' (⋃ i, segment ℝ (p i) (p (i + 1))) = ⋃ i, segment ℝ (q.vertex i) (q.vertex (i + + 1)))) ) := by + classical + intro n p H r hr hedge hrinj hredge q₀ m q s + rw [Set.image_iUnion] + simp_rw [hedge] + exact s.carrier_eq + +private theorem hpre : + (by + classical + exact + ∀ (n : Nat), ∀ (p : Fin (n + 3) → Real × Real), ∀ (H : ℝ × ℝ ≃ₜ ℝ × ℝ), ∀ (m : ℕ), ∀ (q : + P3381T1PolygonBoundary m), (H '' (⋃ i, segment ℝ (p i) (p (i + 1))) = ⋃ i, segment + ℝ (q.vertex i) (q.vertex (i + 1))) → (H ⁻¹' (⋃ i, segment ℝ (q.vertex i) (q.vertex (i + + 1))) = ⋃ i, segment ℝ (p i) (p (i + 1))) ) := by + classical + intro n p H m q hcarrier + rw [← hcarrier, Set.preimage_image_eq _ H.injective] + +end RealPolygonGeometry + +theorem P3861T1RealPolygonDomains {n : Nat} + (p : Fin (n + 3) → Real × Real) (hi : Function.Injective p) + (he : ∀ i j : Fin (n + 3), i ≠ j → + segment Real (p i) (p (i + 1)) ∩ segment Real (p j) (p (j + 1)) = + {x | (x = p i ∨ x = p (i + 1)) ∧ + (x = p j ∨ x = p (j + 1))}) : + let C := ⋃ i, segment Real (p i) (p (i + 1)) + ∃ U V : Set (Real × Real), + IsOpen U ∧ IsConnected U ∧ Bornology.IsBounded U ∧ + IsOpen V ∧ IsConnected V ∧ ¬ Bornology.IsBounded V ∧ + Disjoint U V ∧ U ∪ V = Cᶜ ∧ + frontier U = C ∧ frontier V = C := by +-- BODY + exact (open Set AffineMap in by + classical + -- A positive angular bound also covers opposite collinear incident edges. + have angle (a b c : ℝ × ℝ) (hab : a ≠ b) (hac : a ≠ c) + (hi : segment ℝ a b ∩ segment ℝ a c ⊆ {a}) := RealPolygonGeometry.angle a b c hab hac hi + have shared (a b c : ℝ × ℝ) (hab : a ≠ b) (hac : a ≠ c) + (hi : segment ℝ a b ∩ segment ℝ a c ⊆ {a}) (f : (ℝ × ℝ) → ℝ) := + RealPolygonGeometry.shared angle a b c hab hac hi f + have same (a b : ℝ × ℝ) (hab : a ≠ b) (f : (ℝ × ℝ) → ℝ) := RealPolygonGeometry.same a b hab f + have separate (a b c d : ℝ × ℝ) + (hi : Disjoint (segment ℝ a b) (segment ℝ c d)) (f : (ℝ × ℝ) → ℝ) := + RealPolygonGeometry.separate a b c d hi f + have first (a b c : ℝ × ℝ) (hab : a ≠ b) (hac : a ≠ c) + (hi : ∀ x ∈ segment ℝ a b ∩ segment ℝ a c, + (x = a ∨ x = b) ∧ (x = a ∨ x = c)) (f : (ℝ × ℝ) → ℝ) := RealPolygonGeometry.first + shared same a b c hab hac hi f + have reverse_left (a b c d : ℝ × ℝ) (f : (ℝ × ℝ) → ℝ) + (h : ∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, + dist (lineMap (f a) (f b) s) (lineMap (f c) (f d) t) ≤ + K * dist (lineMap a b s) (lineMap c d t)) := RealPolygonGeometry.reverse_left a b c d + f h + have reverse_right (a b c d : ℝ × ℝ) (f : (ℝ × ℝ) → ℝ) + (h : ∃ K : ℝ, 0 ≤ K ∧ ∀ s ∈ Icc (0 : ℝ) 1, ∀ t ∈ Icc (0 : ℝ) 1, + dist (lineMap (f a) (f b) s) (lineMap (f c) (f d) t) ≤ + K * dist (lineMap a b s) (lineMap c d t)) := RealPolygonGeometry.reverse_right a b c + d f h + have pair_bound (a b c d : ℝ × ℝ) (hab : a ≠ b) (hcd : c ≠ d) + (hi : ∀ x ∈ segment ℝ a b ∩ segment ℝ c d, + (x = a ∨ x = b) ∧ (x = c ∨ x = d)) (f : (ℝ × ℝ) → ℝ) := RealPolygonGeometry.pair_bound + separate first reverse_left reverse_right a b c d hab hcd hi f + -- Pairwise estimates make interpolation independent of the chosen edge. + have boundary_extension {n : ℕ} (p : Fin (n + 3) → ℝ × ℝ) + (hi : Function.Injective p) + (he : ∀ i j : Fin (n + 3), i ≠ j → + segment ℝ (p i) (p (i + 1)) ∩ segment ℝ (p j) (p (j + 1)) = + {x | (x = p i ∨ x = p (i + 1)) ∧ (x = p j ∨ x = p (j + 1))}) + (f : (ℝ × ℝ) → ℝ) := RealPolygonGeometry.boundary_extension same pair_bound (n := n) p hi + he f + -- The inverse is obtained by solving x = y - F x by contraction. + have perturbation (F : (ℝ × ℝ) → (ℝ × ℝ)) (hF : LipschitzWith (1 / 2) F) := + RealPolygonGeometry.perturbation F hF + -- Extend the vertex weights first, then choose sufficiently small displacements. + have rationalize {n : ℕ} (p : Fin (n + 3) → ℝ × ℝ) + (hi : Function.Injective p) + (he : ∀ i j : Fin (n + 3), i ≠ j → + segment ℝ (p i) (p (i + 1)) ∩ segment ℝ (p j) (p (j + 1)) = + {x | (x = p i ∨ x = p (i + 1)) ∧ (x = p j ∨ x = p (j + 1))}) := + RealPolygonGeometry.rationalize boundary_extension perturbation (n := n) p hi he + dsimp only + obtain ⟨H, r, hr, hlip, hanti, hvert, hedge⟩ := rationalize p hi he + have hrinj := RealPolygonGeometry.hrinj n p hi H r hvert + have hredge := RealPolygonGeometry.hredge n p he H r hvert hedge + -- Reduction preserves the whole carrier, including straight subdivision vertices. + let q₀ : P3381T1PolygonBoundary n := ⟨r, hr, hrinj, hredge⟩ + obtain ⟨m, q, ⟨s⟩, hcorner⟩ := P3475T1BoundaryReduction q₀ + obtain ⟨X, K, ⟨t⟩⟩ := P3475T1PolygonTriangleConstruction q hcorner + obtain ⟨U, V, hoU, hcU, hbU, hoV, hcV, hbV, hd, hu, hfU, hfV, _⟩ := + P3475T1PolygonalSeparation q X K t + have hcarrier := RealPolygonGeometry.hcarrier n p H r hr hedge hrinj hredge m q s + have hpre : H ⁻¹' (⋃ i, segment ℝ (q.vertex i) (q.vertex (i + 1))) = + ⋃ i, segment ℝ (p i) (p (i + 1)) := RealPolygonGeometry.hpre n p H m q hcarrier + refine ⟨H ⁻¹' U, H ⁻¹' V, hoU.preimage H.continuous, + H.isConnected_preimage.mpr hcU, hanti.isBounded_preimage hbU, + hoV.preimage H.continuous, H.isConnected_preimage.mpr hcV, ?_, + hd.preimage H, ?_, ?_, ?_⟩ + · intro hb + apply hbV + have hh := hlip.isBounded_image hb + rwa [Set.image_preimage_eq _ H.surjective] at hh + · rw [← Set.preimage_union, hu, Set.preimage_compl, hpre] + · rw [← H.preimage_frontier, hfU, hpre] + · rw [← H.preimage_frontier, hfV, hpre] + ) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3861T1RoutedFaceOrientation.lean b/LeanPool/ApollonianSuperharmonic/P3861T1RoutedFaceOrientation.lean new file mode 100644 index 0000000000..7e62b15b45 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3861T1RoutedFaceOrientation.lean @@ -0,0 +1,410 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3861T1FacialDomains +public import LeanPool.ApollonianSuperharmonic.P3861T1FixedFacialDeletion +public import LeanPool.ApollonianSuperharmonic.PlaneFaceOrientation +public import LeanPool.ApollonianSuperharmonic.P3767T1BarrierRegionMaximal +public import LeanPool.ApollonianSuperharmonic.P3934T1PolygonalSidePropagation +public import LeanPool.ApollonianSuperharmonic.P3934T1ArcSideComparison + +-- [TABLET NODE: P3861T1RoutedFaceOrientation] + +/-! +# P3861T1RoutedFaceOrientation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RoutedOrientationProof + +private theorem endpoints : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), (∀ (a + : ι), ∀ (b : ι), (P.plane.adjacent a b) → (P3723T1EdgeContact P a b)) → (∀ (a : ι), + ∀ (b : ι), (P.plane.adjacent a b) → (D.position a ∈ D.edgeArc a b ∧ D.position b ∈ + D.edgeArc a b)) ) := by + classical + intro ι P D contact a b hab + obtain ⟨g, _, _, hr, h0, h1, _⟩ := D.edgeArc_parameterization a b (contact a b hab) + rw [← hr] + exact ⟨⟨⟨0, by norm_num⟩, h0⟩, ⟨⟨1, by norm_num⟩, h1⟩⟩ + +private theorem position_on_arc : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ + [Nontrivial ι], (∀ (a : ι), ∀ (b : ι), (P.plane.adjacent a b) → + (P3723T1EdgeContact P a b)) → ((∀ (a : ι), ∀ (b : ι), (P.plane.adjacent a b) → + (D.position a ∈ D.edgeArc a b ∧ D.position b ∈ D.edgeArc a b)) → (∀ (w : ι), ∀ (a : + ι), ∀ (b : ι), (P.plane.adjacent a b) → ((D.position w ∈ D.edgeArc a b) → (w = a ∨ w + = b)))) ) := by + classical + intro ι P D this contact endpoints w a b hab hw + obtain ⟨z, hwz⟩ := (P3767T1VertexEdgeIncidence P.plane w).1 + by_cases heq : ({w, z} : Set ι) = {a, b} + · have hm : w ∈ ({a, b} : Set ι) := heq ▸ (by simp) + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hm + · have hm : D.position w ∈ D.position '' (({w, z} : Set ι) ∩ {a, b}) := by + rw [← D.edgeArc_intersections w z a b (contact w z hwz) (contact a b hab) heq] + exact ⟨(endpoints w z hwz).1, hw⟩ + obtain ⟨v, hv, hvw⟩ := hm + have hvw' : v = w := D.position_injective hvw + subst v + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hv.2 + +private theorem front_trace : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (f : P.plane.Face), frontier (F.region f) ⊆ Set.range + D.position ∪ {p | ∃ a b, P.plane.adjacent a b ∧ p ∈ D.edgeArc a b} ) := by + classical + intro ι P D F f x hx + rw [F.region_frontier] at hx + rcases hx with (hx | hx) | hx + · exact Or.inr ⟨_, _, P.plane.face_edges f 0 1 (by decide), hx⟩ + · exact Or.inr ⟨_, _, P.plane.face_edges f 1 2 (by decide), hx⟩ + · exact Or.inr ⟨_, _, P.plane.face_edges f 2 0 (by decide), hx⟩ + +private theorem front_positions : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), (∀ (a : ι), ∀ (b : ι), (P.plane.adjacent a b) → + (D.position a ∈ D.edgeArc a b ∧ D.position b ∈ D.edgeArc a b)) → ((∀ (w : ι), ∀ (a : + ι), ∀ (b : ι), (P.plane.adjacent a b) → ((D.position w ∈ D.edgeArc a b) → (w = a ∨ w + = b))) → (∀ (f : P.plane.Face), ∀ (w : ι), D.position w ∈ frontier (F.region f) ↔ w ∈ + Set.range (P.plane.faceVertex f))) ) := by + classical + intro ι P D F endpoints position_on_arc f w + rw [F.region_frontier] + constructor + · rintro ((hw | hw) | hw) + · rcases position_on_arc w _ _ (P.plane.face_edges f 0 1 (by decide)) hw with h | h + · exact ⟨0, h.symm⟩ + · exact ⟨1, h.symm⟩ + · rcases position_on_arc w _ _ (P.plane.face_edges f 1 2 (by decide)) hw with h | h + · exact ⟨1, h.symm⟩ + · exact ⟨2, h.symm⟩ + · rcases position_on_arc w _ _ (P.plane.face_edges f 2 0 (by decide)) hw with h | h + · exact ⟨2, h.symm⟩ + · exact ⟨0, h.symm⟩ + · rintro ⟨i, rfl⟩ + fin_cases i + · exact Or.inl (Or.inl (endpoints _ _ (P.plane.face_edges f 0 1 (by decide))).1) + · exact Or.inl (Or.inr (endpoints _ _ (P.plane.face_edges f 1 2 (by decide))).1) + · exact Or.inr (endpoints _ _ (P.plane.face_edges f 2 0 (by decide))).1 + +private theorem disjoint_from_labels : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), (∀ (f : P.plane.Face), frontier (F.region f) ⊆ Set.range + D.position ∪ {p | ∃ a b, P.plane.adjacent a b ∧ p ∈ D.edgeArc a b}) → ((∀ (f : + P.plane.Face), ∀ (w : ι), D.position w ∈ frontier (F.region f) ↔ w ∈ Set.range + (P.plane.faceVertex f)) → (Function.Injective (fun f : P.plane.Face => Set.range + (P.plane.faceVertex f)) → Pairwise (fun f g : P.plane.Face => Disjoint (F.region f) + (F.region g)))) ) := by + classical + intro ι P D F front_trace front_positions hinj f g hne + apply Set.disjoint_left.mpr + intro x hxf hxg + have sub (f g : P.plane.Face) (hx : (F.region g ∩ F.region f).Nonempty) : + F.region g ⊆ F.region f := + P3767T1BarrierRegionMaximal _ _ _ (F.region_open f) (front_trace f) + (F.region_connected g).isPreconnected (F.region_avoids_trace g) hx + have heq : F.region f = F.region g := + Set.Subset.antisymm (sub g f ⟨x, hxf, hxg⟩) (sub f g ⟨x, hxg, hxf⟩) + apply hne + apply hinj + ext w + rw [← front_positions f w, ← front_positions g w, heq] + +private theorem face_sides : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), (∀ (a : ι), ∀ (b : ι), (P.plane.adjacent a b) → + (P3723T1EdgeContact P a b)) → (∀ (f : P.plane.Face), ∃ e : Bool, ∀ k : Fin 3, + P3934T1ArcSide (F.region f) (D.edgeArc (P.plane.faceVertex f k) (P.plane.faceVertex + f (k + 1))) (D.position (P.plane.faceVertex f k)) (D.position (P.plane.faceVertex f + (k + 1))) e) ) := by + classical + intro ι P D F contact f + have hp (k : Fin 3) := D.edgeArc_parameterization + (P.plane.faceVertex f k) (P.plane.faceVertex f (k + 1)) + (contact _ _ (P.plane.face_edges f k (k + 1) (by omega))) + choose g hc hi hr h0 h1 hs using hp + let s (k : Fin 3) := Classical.choice (hs k) + have hjoin (k : Fin 3) : g k ⟨1, by norm_num⟩ = g (k + 1) ⟨0, by norm_num⟩ := by + rw [h1, h0] + have hv : Function.Injective (fun k => g k ⟨0, by norm_num⟩) := by + intro k l h + dsimp only at h + rw [h0, h0] at h + exact P.plane.face_vertices_distinct f (D.position_injective h) + have pair_ne (k l : Fin 3) (hkl : k ≠ l) : + ({P.plane.faceVertex f k, P.plane.faceVertex f (k + 1)} : Set ι) ≠ + {P.plane.faceVertex f l, P.plane.faceVertex f (l + 1)} := by + intro heq + have hk : P.plane.faceVertex f k ∈ + ({P.plane.faceVertex f l, P.plane.faceVertex f (l + 1)} : Set ι) := + heq ▸ (by simp) + have hk' : P.plane.faceVertex f (k + 1) ∈ + ({P.plane.faceVertex f l, P.plane.faceVertex f (l + 1)} : Set ι) := + heq ▸ (by simp) + have hidx : k = l ∨ k = l + 1 := by + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff, + (P.plane.face_vertices_distinct f).eq_iff] using hk + have hidx' : k + 1 = l ∨ k + 1 = l + 1 := by + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff, + (P.plane.face_vertices_distinct f).eq_iff] using hk' + fin_cases k <;> fin_cases l <;> simp_all + have hinter (k l : Fin 3) (hkl : k ≠ l) : + Set.range (g k) ∩ Set.range (g l) ⊆ + {q | (q = g k ⟨0, by norm_num⟩ ∨ q = g k ⟨1, by norm_num⟩) ∧ + (q = g l ⟨0, by norm_num⟩ ∨ q = g l ⟨1, by norm_num⟩)} := by + intro q hq + rw [hr k, hr l, D.edgeArc_intersections _ _ _ _ + (contact _ _ (P.plane.face_edges f k (k + 1) (by omega))) + (contact _ _ (P.plane.face_edges f l (l + 1) (by omega))) (pair_ne k l hkl)] at hq + obtain ⟨w, hw, rfl⟩ := hq + simp only [Set.mem_inter_iff, Set.mem_insert_iff, Set.mem_singleton_iff] at hw + simpa only [Set.mem_ofPred_eq, h0, h1, D.position_injective.eq_iff] using hw + have hf : frontier (F.region f) = ⋃ k, Set.range (g k) := by + rw [F.region_frontier] + ext q + simp only [Set.mem_union, Set.mem_iUnion, hr] + constructor + · rintro ((h | h) | h) + · exact ⟨0, h⟩ + · exact ⟨1, h⟩ + · exact ⟨2, h⟩ + · rintro ⟨k, h⟩ + fin_cases k + · exact Or.inl (Or.inl h) + · exact Or.inl (Or.inr h) + · exact Or.inr h + obtain ⟨e, he⟩ := P3934T1PolygonalSidePropagation g s hc hi hjoin hv hinter + (F.region f) (F.region_open f) hf (F.exterior_frontier f) + refine ⟨e, fun k => ?_⟩ + exact ⟨g k, hc k, hi k, hr k, h0 k, h1 k, s k, (he k).1⟩ + +private theorem reverse : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ + {U : Set (Real × Real)}, ∀ {a : ι}, ∀ {b : ι}, ∀ {e : Bool}, (P3934T1ArcSide U + (D.edgeArc a b) (D.position a) (D.position b) e) → (P3934T1ArcSide U (D.edgeArc b + a) (D.position b) (D.position a) (!e)) ) := by + classical + intro ι P D U a b e h + rw [← D.edgeArc_symmetric a b] + exact (P3934T1ArcSideComparison U U _ _ _ e e).1 h + +private theorem any_side : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (c : P.plane.Face → Bool), (∀ (f : P.plane.Face), ∀ (k + : Fin (3 : ℕ)), P3934T1ArcSide (F.region f) (D.edgeArc (P.plane.faceVertex f k) + (P.plane.faceVertex f (k + (1 : Fin (3 : ℕ))))) (D.position (P.plane.faceVertex f k)) + (D.position (P.plane.faceVertex f (k + (1 : Fin (3 : ℕ))))) (c f)) → ((∀ + {U : Set (Real × Real)}, ∀ {a : ι}, ∀ {b : ι}, ∀ {e : Bool}, (P3934T1ArcSide U + (D.edgeArc a b) (D.position a) (D.position b) e) → (P3934T1ArcSide U (D.edgeArc b + a) (D.position b) (D.position a) (!e))) → (∀ (f : P.plane.Face), ∀ (a : ι), ∀ (b : + ι), (P.plane.adjacent a b) → (((∃ i, P.plane.faceVertex f i = a) ∧ (∃ i, + P.plane.faceVertex f i = b)) → (∃ e : Bool, P3934T1ArcSide (F.region f) (D.edgeArc + a b) (D.position a) (D.position b) e)))) ) := by + classical + intro ι P D F c hc reverse f a b hab hf + obtain ⟨⟨i, rfl⟩, ⟨j, rfl⟩⟩ := hf + have hij : i ≠ j := by + intro h + subst j + exact P.plane.adjacent_irreflexive _ hab + fin_cases i <;> fin_cases j + all_goals first + | exact (hij rfl).elim + | exact ⟨c f, by simpa using hc f 0⟩ + | exact ⟨c f, by simpa using hc f 1⟩ + | exact ⟨c f, by simpa using hc f 2⟩ + | exact ⟨!(c f), by simpa using reverse (hc f 0)⟩ + | exact ⟨!(c f), by simpa using reverse (hc f 1)⟩ + | exact ⟨!(c f), by simpa using reverse (hc f 2)⟩ + +private theorem left_exists : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), (Pairwise fun (f g : P.plane.Face) => Disjoint (F.region + f) (F.region g)) → ((∀ (f : P.plane.Face), ∀ (a : ι), ∀ (b : ι), (P.plane.adjacent a + b) → (((∃ i, P.plane.faceVertex f i = a) ∧ (∃ i, P.plane.faceVertex f i = b)) → (∃ e + : Bool, P3934T1ArcSide (F.region f) (D.edgeArc a b) (D.position a) (D.position b) + e))) → (∀ (a : ι), ∀ (b : ι), (P.plane.adjacent a b) → (∃ f : P.plane.Face, ((∃ i, + P.plane.faceVertex f i = a) ∧ (∃ i, P.plane.faceVertex f i = b)) ∧ P3934T1ArcSide + (F.region f) (D.edgeArc a b) (D.position a) (D.position b) true))) ) := by + classical + intro ι P D F hdis any_side a b hab + obtain ⟨f, g, hfg, hf, hg, _⟩ := P.plane.every_edge_two_faces a b hab + obtain ⟨e, he⟩ := any_side f a b hab hf + obtain ⟨d, hd⟩ := any_side g a b hab hg + have hed := (P3934T1ArcSideComparison (F.region f) (F.region g) _ _ _ e d).2.2 + (hdis hfg) he hd + cases e <;> cases d + · exact (hed rfl).elim + · exact ⟨g, hg, hd⟩ + · exact ⟨f, hf, he⟩ + · exact (hed rfl).elim + +private theorem left_spec : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (left_exists : ∀ (a : ι), ∀ (b : ι), (P.plane.adjacent + a b) → (∃ f : P.plane.Face, ((∃ i, P.plane.faceVertex f i = a) ∧ (∃ i, + P.plane.faceVertex f i = b)) ∧ P3934T1ArcSide (F.region f) (D.edgeArc a b) + (D.position a) (D.position b) true)), ∀ (f₀ : P.plane.Face), + let L (a b : ι) : P.plane.Face := if h : P.plane.adjacent a b then + Classical.choose (left_exists a b h) else f₀ + ∀ (a : ι), ∀ (b : ι), (P.plane.adjacent a b) → (((∃ i, P.plane.faceVertex (L a b) i = a) + ∧ (∃ i, P.plane.faceVertex (L a b) i = b)) ∧ P3934T1ArcSide (F.region (L a b)) + (D.edgeArc a b) (D.position a) (D.position b) true) ) := by + classical + intro ι P D F left_exists f₀ L a b h + dsimp only [L] + rw [dite_eq_left h] + exact Classical.choose_spec (left_exists a b h) + +private theorem identify : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), (Pairwise fun (f g : P.plane.Face) => Disjoint (F.region + f) (F.region g)) → (∀ (left_exists : ∀ (a : ι), ∀ (b : ι), (P.plane.adjacent a b) → + (∃ f : P.plane.Face, ((∃ i, P.plane.faceVertex f i = a) ∧ (∃ i, P.plane.faceVertex f + i = b)) ∧ P3934T1ArcSide (F.region f) (D.edgeArc a b) (D.position a) (D.position b) + true)), ∀ (f₀ : P.plane.Face), + let L (a b : ι) : P.plane.Face := if h : P.plane.adjacent a b then + Classical.choose (left_exists a b h) else f₀ + (∀ (a : ι), ∀ (b : ι), (P.plane.adjacent a b) → (((∃ i, P.plane.faceVertex (L a b) i = a) + ∧ (∃ i, P.plane.faceVertex (L a b) i = b)) ∧ P3934T1ArcSide (F.region (L a b)) + (D.edgeArc a b) (D.position a) (D.position b) true)) → (∀ (f : P.plane.Face), ∀ (a : + ι), ∀ (b : ι), (P.plane.adjacent a b) → ((P3934T1ArcSide (F.region f) (D.edgeArc a b) + (D.position a) (D.position b) true) → (L a b = f)))) ) := by + classical + intro ι P D F hdis left_exists f₀ L left_spec f a b hab h + by_contra hne + exact ((P3934T1ArcSideComparison (F.region (L a b)) (F.region f) _ _ _ + true true).2.2 (hdis hne) (left_spec a b hab).2 h) rfl + +end RoutedOrientationProof + +theorem P3861T1RoutedFaceOrientation {ι : Type} (P : PeriodicTileComplex ι) + (D : P3723T1AllContactRouting P) (F : P3861T1FacialDomains P D) : + Pairwise (fun f g : P.plane.Face => Disjoint (F.region f) (F.region g)) ∧ + Nonempty (PlaneFaceOrientation P.plane) := by +-- BODY + classical + let : Nontrivial ι := (P3776T1FixedGeometry P.toPeriodicTileCore).1 + have contact (a b : ι) (hab : P.plane.adjacent a b) : + P3723T1EdgeContact P a b := + ⟨fun h => P.plane.adjacent_irreflexive a (h ▸ hab), + P.adjacent_has_common_edge a b hab⟩ + have endpoints (a b : ι) (hab : P.plane.adjacent a b) := RoutedOrientationProof.endpoints ι P D + contact a b hab + have position_on_arc (w a b : ι) (hab : P.plane.adjacent a b) + (hw : D.position w ∈ D.edgeArc a b) := RoutedOrientationProof.position_on_arc ι P D + contact endpoints w a b hab hw + have front_trace (f : P.plane.Face) := RoutedOrientationProof.front_trace ι P D F f + have front_positions (f : P.plane.Face) (w : ι) := RoutedOrientationProof.front_positions ι P D + F endpoints position_on_arc f w + have disjoint_from_labels := RoutedOrientationProof.disjoint_from_labels ι P D F front_trace + front_positions + have hdis := disjoint_from_labels (P3861T1FixedFacialDeletion P.toPeriodicTileCore).1 + refine ⟨hdis, ?_⟩ + have face_sides (f : P.plane.Face) := RoutedOrientationProof.face_sides ι P D F contact f + choose c hc using face_sides + have reverse {U : Set (Real × Real)} {a b : ι} {e : Bool} + (h : P3934T1ArcSide U (D.edgeArc a b) (D.position a) (D.position b) e) : + P3934T1ArcSide U (D.edgeArc b a) (D.position b) (D.position a) (!e) := + RoutedOrientationProof.reverse ι P D (U := U) (a := a) (b := b) (e := e) h + have any_side (f : P.plane.Face) (a b : ι) (hab : P.plane.adjacent a b) + (hf : (∃ i, P.plane.faceVertex f i = a) ∧ (∃ i, P.plane.faceVertex f i = b)) := + RoutedOrientationProof.any_side ι P D F c hc reverse f a b hab hf + have left_exists (a b : ι) (hab : P.plane.adjacent a b) := RoutedOrientationProof.left_exists ι + P D F hdis any_side a b hab + obtain ⟨a⟩ := (inferInstance : Nonempty ι) + obtain ⟨b, hab⟩ := (P3767T1VertexEdgeIncidence P.plane a).1 + obtain ⟨f₀, _⟩ := left_exists a b hab + let L (a b : ι) : P.plane.Face := if h : P.plane.adjacent a b then + Classical.choose (left_exists a b h) else f₀ + have left_spec (a b : ι) (h : P.plane.adjacent a b) : + ((∃ i, P.plane.faceVertex (L a b) i = a) ∧ + (∃ i, P.plane.faceVertex (L a b) i = b)) ∧ + P3934T1ArcSide (F.region (L a b)) (D.edgeArc a b) + (D.position a) (D.position b) true := RoutedOrientationProof.left_spec ι P D F + left_exists f₀ a b h + have identify (f : P.plane.Face) (a b : ι) (hab : P.plane.adjacent a b) + (h : P3934T1ArcSide (F.region f) (D.edgeArc a b) + (D.position a) (D.position b) true) : L a b = f := RoutedOrientationProof.identify ι P D + F hdis left_exists f₀ left_spec f a b hab h + refine ⟨{ leftFace := L + left_incident := fun a b h => (left_spec a b h).1 + opposite_sides := ?_ + sides_exhaust_faces := ?_ + coherently_oriented := ?_ }⟩ + · intro a b hab heq + have hba := (P.plane.adjacent_symmetric a b).mp hab + have hr := reverse (left_spec b a hba).2 + rw [← heq] at hr + have hfalse := (P3934T1ArcSideComparison (F.region (L a b)) + (F.region (L a b)) _ _ _ true false).2.1 (left_spec a b hab).2 hr + exact Bool.noConfusion hfalse + · intro a b hab f hf + obtain ⟨e, he⟩ := any_side f a b hab hf + cases e + · right + exact (identify f b a ((P.plane.adjacent_symmetric a b).mp hab) + (reverse he)).symm + · exact Or.inl (identify f a b hab he).symm + · intro f + have adj (i j : Fin 3) (h : i ≠ j) := P.plane.face_edges f i j h + cases he : c f + · refine ⟨Equiv.swap (1 : Fin 3) 2, ?_, ?_, ?_⟩ + · simpa [Equiv.swap_apply_def] using identify f _ _ (adj 0 2 (by decide)) (by + simpa [he] using reverse (hc f 2)) + · simpa using identify f _ _ (adj 2 1 (by decide)) (by + simpa [he] using reverse (hc f 1)) + · simpa [Equiv.swap_apply_def] using identify f _ _ (adj 1 0 (by decide)) (by + simpa [he] using reverse (hc f 0)) + · refine ⟨Equiv.refl _, ?_, ?_, ?_⟩ + · exact identify f _ _ (adj 0 1 (by decide)) (by simpa [he] using hc f 0) + · exact identify f _ _ (adj 1 2 (by decide)) (by simpa [he] using hc f 1) + · exact identify f _ _ (adj 2 0 (by decide)) (by simpa [he] using hc f 2) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3861T1RoutedFacialDomains.lean b/LeanPool/ApollonianSuperharmonic/P3861T1RoutedFacialDomains.lean new file mode 100644 index 0000000000..7a85c422ea --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3861T1RoutedFacialDomains.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3861T1FacialDomains +public import LeanPool.ApollonianSuperharmonic.P3861T1FixedFacialDeletion +public import LeanPool.ApollonianSuperharmonic.P3861T1RealPolygonDomains +public import LeanPool.ApollonianSuperharmonic.P3913T1RoutedFaceSubdivision +public import LeanPool.ApollonianSuperharmonic.P3913T1OffFaceExterior +public import LeanPool.ApollonianSuperharmonic.P3913T1RoutedArcExterior +public import LeanPool.ApollonianSuperharmonic.P3913T1RoutedTraceClosed + +-- [TABLET NODE: P3861T1RoutedFacialDomains] + +/-! +# P3861T1RoutedFacialDomains + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3861T1RoutedFacialDomains {ι : Type} (P : PeriodicTileComplex ι) + (D : P3723T1AllContactRouting P) : + Nonempty (P3861T1FacialDomains P D) := by +-- BODY + classical + let J (f : P.plane.Face) : Set (Real × Real) := + D.edgeArc (P.plane.faceVertex f 0) (P.plane.faceVertex f 1) ∪ + D.edgeArc (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) ∪ + D.edgeArc (P.plane.faceVertex f 2) (P.plane.faceVertex f 0) + have polygons (f : P.plane.Face) : + ∃ (n : Nat) (p : Fin (n + 3) → Real × Real), + Function.Injective p ∧ + (∀ i j : Fin (n + 3), i ≠ j → + segment Real (p i) (p (i + 1)) ∩ segment Real (p j) (p (j + 1)) = + {x | (x = p i ∨ x = p (i + 1)) ∧ + (x = p j ∨ x = p (j + 1))}) ∧ + (⋃ i, segment Real (p i) (p (i + 1))) = J f := by + have contact (a b : ι) (hab : P.plane.adjacent a b) : + P3723T1EdgeContact P a b := + ⟨(fun e => P.plane.adjacent_irreflexive a (e.symm ▸ hab)), + P.adjacent_has_common_edge a b hab⟩ + have params (k : Fin 3) := D.edgeArc_parameterization + (P.plane.faceVertex f k) (P.plane.faceVertex f (k + 1)) + (contact _ _ (P.plane.face_edges f k (k + 1) (by fin_cases k <;> decide))) + choose g hc hi hr h0 h1 hs using params + let s (k : Fin 3) := Classical.choice (hs k) + obtain ⟨n, p, _, hinj, hedge, hcarrier, _⟩ := + P3913T1RoutedFaceSubdivision P D f g hc hi hr h0 h1 s + exact ⟨n, p, hinj, hedge, hcarrier⟩ + have separated (f : P.plane.Face) : + ∃ U V : Set (Real × Real), + IsOpen U ∧ IsConnected U ∧ Bornology.IsBounded U ∧ + IsOpen V ∧ IsConnected V ∧ ¬ Bornology.IsBounded V ∧ + Disjoint U V ∧ U ∪ V = (J f)ᶜ ∧ + frontier U = J f ∧ frontier V = J f := by + obtain ⟨n, p, hi, he, hJ⟩ := polygons f + have hs := P3861T1RealPolygonDomains p hi he + dsimp only at hs + rw [hJ] at hs + exact hs + choose U V hUo hUc hUb hVo hVc hVb hd hp hUf hVf using separated + have avoidance_from_deletion : + (∀ f : P.plane.Face, ∀ a b : ι, + a ∉ Set.range (P.plane.faceVertex f) → + b ∉ Set.range (P.plane.faceVertex f) → + ∃ p : List ι, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ x ∈ p, x ∉ Set.range (P.plane.faceVertex f)) ∧ + ∀ x y : ι, ∀ l₁ l₂ : List ι, + p = l₁ ++ x :: y :: l₂ → P.plane.adjacent x y) → + ∀ f, Disjoint (U f) (Set.range D.position ∪ + {p | ∃ a b, P.plane.adjacent a b ∧ p ∈ D.edgeArc a b}) := by + intro hdelete f + have hout := (P3913T1OffFaceExterior P D f (U f) (V f) + (hUo f) (hVo f) (hUb f) (hd f) (hp f) (hdelete f)).2 + obtain ⟨hpos, _, harc⟩ := P3913T1RoutedArcExterior P D f (U f) (V f) + (hUo f) (hVo f) (hd f) (hp f) hout + have hmissJ : Disjoint (U f) (J f) := by + apply Set.disjoint_left.mpr + intro x hx hxJ + have hcomp : x ∈ (J f)ᶜ := by + rw [← hp f] + exact Or.inl hx + exact hcomp hxJ + have hmiss : Disjoint (U f) (J f ∪ V f) := hmissJ.union_right (hd f) + apply Set.disjoint_left.mpr + intro x hx htrace + apply Set.disjoint_left.mp hmiss hx + rcases htrace with h | ⟨a, b, hab, hx⟩ + · exact hpos h + · exact harc a b hab hx + have havoid := avoidance_from_deletion + (P3861T1FixedFacialDeletion P.toPeriodicTileCore).2 + have exterior (f : P.plane.Face) : (closure (U f))ᶜ = V f := by + rw [closure_eq_self_union_frontier, hUf f] + apply Set.Subset.antisymm + · intro x hx + have hnot : x ∉ U f ∧ x ∉ J f := by + simpa only [Set.mem_compl_iff, Set.mem_union, not_or] using hx + have hUV : x ∈ U f ∪ V f := by + rw [hp f] + exact hnot.2 + exact hUV.resolve_left hnot.1 + · intro x hx + have hnotU : x ∉ U f := fun hu => Set.disjoint_left.mp (hd f) hu hx + have hnotJ : x ∉ J f := by + have hUV : x ∈ U f ∪ V f := Or.inr hx + rw [hp f] at hUV + exact hUV + exact fun h => h.elim hnotU hnotJ + refine ⟨{ + region := U + trace_closed := ?_ + region_open := hUo + region_connected := hUc + region_bounded := hUb + region_avoids_trace := havoid + region_frontier := hUf + exterior_connected := ?_ + exterior_frontier := ?_ + }⟩ + · exact P3913T1RoutedTraceClosed P D + · intro f + rw [exterior] + exact hVc f + · intro f + rw [exterior, hVf, hUf] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean b/LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean new file mode 100644 index 0000000000..f1539e1e81 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean @@ -0,0 +1,634 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting +public import LeanPool.ApollonianSuperharmonic.P3767T1VertexEdgeIncidence +public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry +public import Mathlib.Analysis.Normed.MulAction + +-- [TABLET NODE: P3889T1ExactRadialStar] + +/-! +# P3889T1ExactRadialStar + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RadialStarProof + +private theorem hposition_arc_endpoint : + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ + [Nontrivial ι], (∀ (c : ι), ∀ (d : ι), (P.plane.adjacent c d) → (P3723T1EdgeContact P c + d)) → (∀ (v : ι), ∀ (c : ι), ∀ (d : ι), P3723T1EdgeContact P c d → D.position v ∈ + D.edgeArc c d → v = c ∨ v = d) := by + classical + intro ι P D this hadj_contact v c d hcd hv + obtain ⟨w, hvw⟩ := (P3767T1VertexEdgeIncidence P.plane v).1 + have hvwContact := hadj_contact v w hvw + have hstart : D.position v ∈ D.edgeArc v w := by + obtain ⟨g, _, _, hrange, hg0, _, _⟩ := D.edgeArc_parameterization v w hvwContact + rw [← hrange, ← hg0] + exact ⟨⟨0, by norm_num⟩, rfl⟩ + by_cases heq : ({v, w} : Set ι) = {c, d} + · have hvmem : v ∈ ({c, d} : Set ι) := heq ▸ (by simp) + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hvmem + · have hmem : D.position v ∈ D.position '' (({v, w} : Set ι) ∩ {c, d}) := by + rw [← D.edgeArc_intersections v w c d hvwContact hcd heq] + exact ⟨hstart, hv⟩ + obtain ⟨z, hz, hzpos⟩ := hmem + have hzv : z = v := D.position_injective hzpos + subst z + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hz.2 + +private theorem hlocal : + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : ι), + (∀ (c : ι), ∀ (d : ι), (P.plane.adjacent c d) → (P3723T1EdgeContact P c d)) → (∀ (c : + ι), P.plane.adjacent a c → ∃ (u : ℝ × ℝ), ‖u‖ = (1 : ℝ) ∧ ∃ ε > (0 : ℝ), D.edgeArc a c ∩ + Metric.ball (D.position a) ε = Metric.ball (D.position a) ε ∩ {p : ℝ × ℝ | ∃ (t : ℝ), (0 + : ℝ) ≤ t ∧ p = D.position a + t • u}) := by + classical + intro ι P D a hadj_contact c hac + obtain ⟨g, hcont, hinj, hrange, hg0, _, ⟨cert⟩⟩ := + D.edgeArc_parameterization a c (hadj_contact a c hac) + let i : Fin cert.count := ⟨0, cert.positive⟩ + let τ := cert.time i.succ + have hτ : 0 < τ := by + have hi : i.castSucc < i.succ := by + change (0 : Nat) < 1 + omega + have := cert.strict hi + simpa [τ, i, cert.start] using this + have htime0 : cert.time i.castSucc = 0 := by + have hi : i.castSucc = (0 : Fin (cert.count + 1)) := by ext; rfl + rw [hi, cert.start] + obtain ⟨A, B, hseg⟩ := cert.affine_on i + let σ := τ / 2 + have hσ : 0 < σ ∧ σ < τ := by dsimp [σ]; constructor <;> linarith + let s0 : Set.Icc (0 : Real) 1 := ⟨0, by norm_num⟩ + have hτle : τ ≤ 1 := by + dsimp [τ] + calc + cert.time i.succ ≤ cert.time (Fin.last cert.count) := + cert.strict.monotone (Fin.le_last _) + _ = 1 := cert.finish + let sσ : Set.Icc (0 : Real) 1 := ⟨σ, le_of_lt hσ.1, le_trans (le_of_lt hσ.2) hτle⟩ + have hlo0 : cert.time i.castSucc ≤ (s0 : Real) := by rw [htime0] + have hhi0 : (s0 : Real) ≤ cert.time i.succ := by + change 0 ≤ cert.time i.succ + exact le_of_lt hτ + have hseg0 : g s0 = A := by simpa [s0] using hseg s0 hlo0 hhi0 + have hA : A = D.position a := hseg0.symm.trans hg0 + have hlosigma : cert.time i.castSucc ≤ (sσ : Real) := by + rw [htime0] + exact le_of_lt hσ.1 + have hhisigma : (sσ : Real) ≤ cert.time i.succ := le_of_lt hσ.2 + have hsegsigma : g sσ = D.position a + σ • B := by + simpa [sσ] using (hseg sσ hlosigma hhisigma).trans (by rw [hA]) + have hB : B ≠ 0 := by + intro hzero + have hsame : g sσ = g s0 := by + rw [hsegsigma, hzero, smul_zero, add_zero] + exact (hseg0.trans hA).symm + have : sσ = s0 := hinj (by simpa [s0] using hsame) + have : σ = 0 := congrArg (fun s : Set.Icc (0 : Real) 1 => (s : Real)) this + linarith [hσ.1] + let u : Real × Real := ‖B‖⁻¹ • B + have hnorm : ‖u‖ = 1 := by + change ‖‖B‖⁻¹ • B‖ = 1 + rw [norm_smul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr (norm_pos_iff.mpr hB))] + exact inv_mul_cancel₀ (norm_ne_zero_iff.mpr hB) + let tail : Set (Set.Icc (0 : Real) 1) := {s | σ ≤ (s : Real)} + have htailclosed : IsClosed tail := by + dsimp [tail] + exact isClosed_Ici.preimage continuous_subtype_val + have htailparam : IsCompact tail := + isCompact_univ.of_isClosed_subset htailclosed (by intro s hs; trivial) + have htail : IsCompact (g '' tail) := htailparam.image hcont + have hxnot : D.position a ∉ g '' tail := by + rintro ⟨s, hs, hgs⟩ + have heq : s = s0 := hinj (by simpa [s0] using hgs.trans hg0.symm) + rw [heq] at hs + exact (not_lt_of_ge hs) hσ.1 + obtain ⟨ε₀, hε₀, hball₀⟩ := (Metric.isOpen_iff.mp htail.isClosed.isOpen_compl) + (D.position a) hxnot + let ε := min ε₀ (σ * ‖B‖) / 2 + have hlenpos : 0 < σ * ‖B‖ := mul_pos hσ.1 (norm_pos_iff.mpr hB) + have hε : 0 < ε := by dsimp [ε]; positivity + have hεδ : ε < ε₀ := by dsimp [ε]; have := min_le_left ε₀ (σ * ‖B‖); linarith + have hεlen : ε < σ * ‖B‖ := by dsimp [ε]; have := min_le_right ε₀ (σ * ‖B‖); linarith + have hball : Metric.ball (D.position a) ε ⊆ (g '' tail)ᶜ := by + exact (Metric.ball_subset_ball (le_of_lt hεδ)).trans hball₀ + refine ⟨u, hnorm, ε, hε, ?_⟩ + -- The two inclusions use the first affine segment and the omitted compact tail. + ext p + constructor + · rintro ⟨hpArc, hpBall⟩ + rw [← hrange] at hpArc + obtain ⟨s, hsrep⟩ := hpArc + by_cases hs : σ ≤ (s : Real) + · exact False.elim (hball hpBall ⟨s, hs, hsrep⟩) + · have hsσ : (s : Real) < σ := lt_of_not_ge hs + have hlos : cert.time i.castSucc ≤ (s : Real) := by + rw [htime0] + exact s.property.1 + have hhis : (s : Real) ≤ cert.time i.succ := by + change (s : Real) ≤ τ + exact le_of_lt (hsσ.trans hσ.2) + have hseg_s : g s = D.position a + (s : Real) • B := by + rw [hseg s hlos hhis, hA] + have hscale : (s : Real) • B = ((s : Real) * ‖B‖) • u := by + dsimp [u] + rw [smul_smul] + congr 1 + field_simp + refine ⟨hpBall, ?_⟩ + refine ⟨(s : Real) * ‖B‖, + mul_nonneg s.property.1 (norm_nonneg _), ?_⟩ + calc + p = g s := hsrep.symm + _ = D.position a + (s : Real) • B := hseg_s + _ = D.position a + ((s : Real) * ‖B‖) • u := by rw [hscale] + · rintro ⟨hpBall, t, ht, rfl⟩ + have htbound : t < ε := by + have hdist : dist (D.position a + t • u) (D.position a) = t := by + rw [dist_eq_norm] + simp [norm_smul, Real.norm_eq_abs, abs_of_nonneg ht, hnorm] + simpa [Metric.mem_ball, hdist] using hpBall + let s : Set.Icc (0 : Real) 1 := ⟨t / ‖B‖, by + constructor + · exact div_nonneg ht (norm_nonneg _) + · have hlen : ε < σ * ‖B‖ := hεlen + have hnB : 0 < ‖B‖ := norm_pos_iff.mpr hB + apply (div_le_iff₀ hnB).2 + nlinarith [htbound, hlen] + ⟩ + have hlo_s : cert.time i.castSucc ≤ (s : Real) := by + rw [htime0] + exact div_nonneg ht (norm_nonneg _) + have hlen : ε < σ * ‖B‖ := hεlen + have hquot : t / ‖B‖ < σ := (div_lt_iff₀ (norm_pos_iff.mpr hB)).2 (by nlinarith [htbound, hlen]) + have hhi_s : (s : Real) ≤ cert.time i.succ := by + change t / ‖B‖ ≤ τ + exact (le_of_lt hquot).trans (le_of_lt hσ.2) + have hseg_s : g s = D.position a + (s : Real) • B := by + rw [hseg s hlo_s hhi_s, hA] + have hscale : (t / ‖B‖) • B = t • u := by + dsimp [u] + rw [smul_smul] + congr 1 + have hsval : g s = D.position a + t • u := by + calc + g s = D.position a + (s : Real) • B := hseg_s + _ = D.position a + t • u := by rw [hscale] + have hgsArc : g s ∈ D.edgeArc a c := by + rw [← hrange] + exact ⟨s, rfl⟩ + have hgsBall : g s ∈ Metric.ball (D.position a) ε := by + simpa [hsval] using hpBall + exact ⟨hsval ▸ hgsArc, hsval ▸ hgsBall⟩ + +private theorem finiteLower : + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : ι), + ∀ (hlocal : ∀ (c : ι), (P.plane.adjacent a c) → (∃ u : Real × Real, ‖u‖ = 1 ∧ ∃ ε > 0, + D.edgeArc a c ∩ Metric.ball (D.position a) ε = Metric.ball (D.position a) ε ∩ {p | ∃ t : + Real, 0 ≤ t ∧ p = D.position a + t • u})), + let localEps (c : ι) (hc : P.plane.adjacent a c) : Real := + Classical.choose (Classical.choose_spec (hlocal c hc)).2 + let eps (c : ι) : Real := @dite Real (P.plane.adjacent a c) (Classical.propDecidable _) + (fun hc => localEps c hc) (fun _ => 1) + ∀ s : Finset ι, (∀ c ∈ s, 0 < eps c) → ∃ q : Real, 0 < q ∧ ∀ c ∈ s, q < eps c := by + classical + intro ι P D a hlocal localEps eps s + induction s using Finset.induction_on with + | empty => + intro _ + exact ⟨1, by norm_num, by simp⟩ + | @insert c s hcs ih => + intro hpos + obtain ⟨q, hq, hqsmall⟩ := ih (by + intro d hd + exact hpos d (Finset.mem_insert_of_mem hd)) + let q' := min q (eps c) / 2 + have hcur : 0 < eps c := hpos c (Finset.mem_insert_self c s) + have hq' : 0 < q' := by + dsimp [q'] + positivity + refine ⟨q', hq', ?_⟩ + intro d hd + rcases Finset.mem_insert.mp hd with hdc | hd + · have hdc' : d = c := hdc + subst d + dsimp [q'] + have hm := min_le_right q (eps c) + linarith + · dsimp [q'] + have hm := min_le_left q (eps c) + have := hqsmall d hd + linarith + +private theorem localRay : + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : ι), + ∀ (hlocal : ∀ (c : ι), (P.plane.adjacent a c) → (∃ u : Real × Real, ‖u‖ = 1 ∧ ∃ ε > 0, + D.edgeArc a c ∩ Metric.ball (D.position a) ε = Metric.ball (D.position a) ε ∩ {p | ∃ t : + Real, 0 ≤ t ∧ p = D.position a + t • u})), + let localU (c : ι) (hc : P.plane.adjacent a c) : Real × Real := + Classical.choose (hlocal c hc) + let localEps (c : ι) (hc : P.plane.adjacent a c) : Real := + Classical.choose (Classical.choose_spec (hlocal c hc)).2 + (∀ (c : ι), ∀ (hc : P.plane.adjacent a c), ‖localU c hc‖ = 1 ∧ 0 < localEps c hc ∧ D.edgeArc + a c ∩ Metric.ball (D.position a) (localEps c hc) = Metric.ball (D.position a) (localEps c + hc) ∩ {p | ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • localU c hc}) → ( + let u : ι → Real × Real := fun c => + @dite (Real × Real) (P.plane.adjacent a c) (Classical.propDecidable _) + (fun hc => localU c hc) (fun _ => 0) + ∀ (c : ι), ∀ (hc : P.plane.adjacent a c), ∀ (q : ℝ), (0 : ℝ) < q → q < localEps c hc → + D.edgeArc a c ∩ Metric.ball (D.position a) q = Metric.ball (D.position a) q ∩ {p : ℝ × ℝ + | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ p = D.position a + t • u c}) := by + classical + intro ι P D a hlocal localU localEps localSpec u c hc q hq0 hq + have heq := (localSpec c hc).2.2 + have hball : Metric.ball (D.position a) q ⊆ + Metric.ball (D.position a) (localEps c hc) := + Metric.ball_subset_ball (le_of_lt hq) + ext p + constructor + · rintro ⟨hpa, hpb⟩ + have hbig : p ∈ Metric.ball (D.position a) (localEps c hc) := hball hpb + have hray : p ∈ {p | ∃ t : Real, 0 ≤ t ∧ + p = D.position a + t • localU c hc} := by + have : p ∈ D.edgeArc a c ∩ Metric.ball (D.position a) (localEps c hc) := ⟨hpa, hbig⟩ + rw [heq] at this + exact this.2 + rcases hray with ⟨t, ht, hp⟩ + exact ⟨hpb, t, ht, by simpa [u, hc] using hp⟩ + · rintro ⟨hpb, t, ht, hp⟩ + have hbig : p ∈ Metric.ball (D.position a) (localEps c hc) := hball hpb + have hray : p ∈ {p | ∃ t : Real, 0 ≤ t ∧ + p = D.position a + t • localU c hc} := by + exact ⟨t, ht, by simpa [u, hc] using hp⟩ + have : p ∈ Metric.ball (D.position a) (localEps c hc) ∩ + {p | ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • localU c hc} := ⟨hbig, hray⟩ + rw [← heq] at this + exact ⟨this.1, hpb⟩ + +private theorem hforeign : + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : ι), + (∀ (c : ι), ∀ (d : ι), (P.plane.adjacent c d) → (P3723T1EdgeContact P c d)) → (∀ (rN : ℝ), + let Q : Set (Real × Real) := Metric.closedBall (D.position a) 1 + let E : Set (ι × ι) := {e | P3723T1EdgeContact P e.1 e.2 ∧ + (D.edgeArc e.1 e.2 ∩ Q).Nonempty} + let E0 : Set (ι × ι) := {e | e ∈ E ∧ e.1 ≠ a ∧ e.2 ≠ a} + let A : Set (Real × Real) := ⋃ e ∈ E0, D.edgeArc e.1 e.2 + ∀ (rF0 : ℝ), (Metric.ball (D.position a) rF0 ⊆ Aᶜ) → ( + let r : Real := min rN (min rF0 1) / 2 + (r < rF0) → ((r < 1) → (∀ (c : ι), ∀ (d : ι), P.plane.adjacent c d → c ≠ a → d ≠ a → Disjoint + (D.edgeArc c d) (Metric.ball (D.position a) r))))) := by + classical + intro ι P D a hadj_contact rN Q E E0 A rF0 hballF r hrFlt hrlt1 c d hcd hca hda + apply Set.disjoint_left.mpr + intro p hpArc hpBall + have hpdist : dist p (D.position a) < r := Metric.mem_ball.mp hpBall + have hpQ : p ∈ Q := by + apply Metric.mem_closedBall.mpr + exact le_of_lt (hpdist.trans hrlt1) + have hcontact := hadj_contact c d hcd + have he : (c, d) ∈ E := by + change P3723T1EdgeContact P c d ∧ (D.edgeArc c d ∩ Q).Nonempty + exact ⟨hcontact, ⟨p, ⟨hpArc, hpQ⟩⟩⟩ + have hpA : p ∈ A := by + change p ∈ ⋃ e : ι × ι, ⋃ (_ : e ∈ E0), D.edgeArc e.1 e.2 + exact Set.mem_iUnion.mpr ⟨(c, d), Set.mem_iUnion.mpr + ⟨⟨he, hca, hda⟩, hpArc⟩⟩ + have hpAF : p ∈ Aᶜ := hballF (Metric.mem_ball.mpr (hpdist.trans hrFlt)) + exact hpAF hpA + +private theorem hu_injective : + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : ι), + (∀ (c : ι), ∀ (d : ι), (P.plane.adjacent c d) → (P3723T1EdgeContact P c d)) → (∀ + (hlocal : ∀ (c : ι), (P.plane.adjacent a c) → (∃ u : Real × Real, ‖u‖ = 1 ∧ ∃ ε > 0, + D.edgeArc a c ∩ Metric.ball (D.position a) ε = Metric.ball (D.position a) ε ∩ {p | ∃ t : + Real, 0 ≤ t ∧ p = D.position a + t • u})), + let localU (c : ι) (hc : P.plane.adjacent a c) : Real × Real := + Classical.choose (hlocal c hc) + let localEps (c : ι) (hc : P.plane.adjacent a c) : Real := + Classical.choose (Classical.choose_spec (hlocal c hc)).2 + ∀ (rN : ℝ), + let u : ι → Real × Real := fun c => + @dite (Real × Real) (P.plane.adjacent a c) (Classical.propDecidable _) + (fun hc => localU c hc) (fun _ => 0) + (∀ (c : ι), (P.plane.adjacent a c) → (‖u c‖ = 1)) → ((∀ (c : ι), ∀ (hc : P.plane.adjacent a + c), ∀ (q : Real), (0 < q) → ((q < localEps c hc) → (D.edgeArc a c ∩ Metric.ball + (D.position a) q = Metric.ball (D.position a) q ∩ {p | ∃ t : Real, 0 ≤ t ∧ p = D.position + a + t • u c}))) → (∀ (rF0 : ℝ), + let r : Real := min rN (min rF0 1) / 2 + (0 < r) → ((∀ (c : ι), ∀ (hc : P.plane.adjacent a c), r < localEps c hc) → (∀ c, ∀ d, + P.plane.adjacent a c → P.plane.adjacent a d → u c = u d → c = d))))) := by + classical + intro ι P D a hadj_contact hlocal localU localEps rN u u_norm localRay rF0 r hr hr_local c d + hac had hdirs + by_contra hne + have hca : c ≠ a := by + intro h + subst c + exact P.plane.adjacent_irreflexive a hac + have hda : d ≠ a := by + intro h + subst d + exact P.plane.adjacent_irreflexive a had + let p := D.position a + (r / 2) • u c + have hhalf : 0 < r / 2 := by linarith + have hpnorm : ‖(r / 2) • u c‖ = r / 2 := by + rw [norm_smul, Real.norm_eq_abs, abs_of_pos hhalf, u_norm c hac] + ring + have hpball : p ∈ Metric.ball (D.position a) r := by + rw [Metric.mem_ball, dist_eq_norm] + dsimp [p] + simp [hpnorm] + linarith + have hrayc : p ∈ {p | ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • u c} := + ⟨r / 2, le_of_lt hhalf, rfl⟩ + have hrayd : p ∈ {p | ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • u d} := by + simpa [hdirs] using hrayc + have hAc : p ∈ D.edgeArc a c := by + have hmem : p ∈ D.edgeArc a c ∩ Metric.ball (D.position a) r := by + rw [localRay c hac r hr (hr_local c hac)] + exact ⟨hpball, hrayc⟩ + exact hmem.1 + have hAd : p ∈ D.edgeArc a d := by + have hmem : p ∈ D.edgeArc a d ∩ Metric.ball (D.position a) r := by + rw [localRay d had r hr (hr_local d had)] + exact ⟨hpball, hrayd⟩ + exact hmem.1 + have hsetne : ({a, c} : Set ι) ≠ {a, d} := by + intro hsets + have hmem : d ∈ ({a, c} : Set ι) := hsets.symm ▸ (by simp) + have : d = c := by simpa [hda] using hmem + exact hne this.symm + have hint := D.edgeArc_intersections a c a d + (hadj_contact a c hac) (hadj_contact a d had) hsetne + have hpimage : p ∈ D.position '' (({a, c} : Set ι) ∩ {a, d}) := by + rw [← hint] + exact ⟨hAc, hAd⟩ + obtain ⟨v, hv, hvp⟩ := hpimage + have hva : v = a := by + have hv1 : v = a ∨ v = c := by simpa using hv.1 + have hv2 : v = a ∨ v = d := by simpa using hv.2 + rcases hv1 with h | h + · exact h + · rcases hv2 with h' | h' + · exact h' + · exact (hne (h.symm.trans h')).elim + subst v + have : p = D.position a := hvp.symm + have hzero : (r / 2) • u c = 0 := by + have hsub := congrArg (fun x : Real × Real => x - D.position a) this + simpa [p] using hsub + have hnormzero := congrArg (fun x : Real × Real => ‖x‖) hzero + rw [hpnorm, norm_zero] at hnormzero + linarith + +private theorem vertexRay : + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : ι), + ∀ [Nontrivial ι], ∀ (hlocal : ∀ (c : ι), (P.plane.adjacent a c) → (∃ u : Real × Real, ‖u‖ + = 1 ∧ ∃ ε > 0, D.edgeArc a c ∩ Metric.ball (D.position a) ε = Metric.ball (D.position a) + ε ∩ {p | ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • u})), + let localU (c : ι) (hc : P.plane.adjacent a c) : Real × Real := + Classical.choose (hlocal c hc) + let localEps (c : ι) (hc : P.plane.adjacent a c) : Real := + Classical.choose (Classical.choose_spec (hlocal c hc)).2 + ∀ (rN : ℝ), + let u : ι → Real × Real := fun c => + @dite (Real × Real) (P.plane.adjacent a c) (Classical.propDecidable _) + (fun hc => localU c hc) (fun _ => 0) + (∀ (c : ι), ∀ (hc : P.plane.adjacent a c), ∀ (q : Real), (0 < q) → ((q < localEps c hc) → + (D.edgeArc a c ∩ Metric.ball (D.position a) q = Metric.ball (D.position a) q ∩ {p | ∃ t : + Real, 0 ≤ t ∧ p = D.position a + t • u c}))) → (∀ (rF0 : ℝ), + let r : Real := min rN (min rF0 1) / 2 + (0 < r) → ((∀ (c : ι), ∀ (hc : P.plane.adjacent a c), r < localEps c hc) → ((∀ (c : ι), ∀ (d + : ι), (P.plane.adjacent c d) → ((c ≠ a) → ((d ≠ a) → (Disjoint (D.edgeArc c d) + (Metric.ball (D.position a) r))))) → ((∀ (v : ι), ∀ (w : ι), (P.plane.adjacent v w) → + (D.position v ∈ D.edgeArc v w)) → (∀ (v : ι), D.position v ∈ Metric.ball (D.position a) r + → ∃ (c : ι), P.plane.adjacent a c ∧ ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ D.position v = D.position a + + t • u c))))) := by + classical + intro ι P D a this hlocal localU localEps rN u localRay rF0 r hr hr_local hforeign vertexArc v + hvball + by_cases hva : v = a + · subst v + obtain ⟨c, hac⟩ := (P3767T1VertexEdgeIncidence P.plane a).1 + exact ⟨c, hac, 0, le_rfl, by simp⟩ + · obtain ⟨w, hvw⟩ := (P3767T1VertexEdgeIncidence P.plane v).1 + have hvArc := vertexArc v w hvw + by_cases hwa : w = a + · subst w + have haw : P.plane.adjacent a v := (P.plane.adjacent_symmetric v a).mp hvw + have harc : D.position v ∈ D.edgeArc a v := by + rw [D.edgeArc_symmetric v a] at hvArc + exact hvArc + have hmem : D.position v ∈ D.edgeArc a v ∩ Metric.ball (D.position a) r := + ⟨harc, hvball⟩ + rw [localRay v haw r hr (hr_local v haw)] at hmem + rcases hmem.2 with ⟨t, ht, hp⟩ + exact ⟨v, haw, t, ht, hp⟩ + · have hfalse := (Set.disjoint_left.mp + (hforeign v w hvw hva hwa)) hvArc hvball + exact False.elim hfalse + +end RadialStarProof + +theorem P3889T1ExactRadialStar {ι : Type} (P : PeriodicTileComplex ι) + (D : P3723T1AllContactRouting P) (a : ι) : + ∃ r : Real, 0 < r ∧ ∃ u : ι → Real × Real, + (∀ c, P.plane.adjacent a c → ‖u c‖ = 1) ∧ + (∀ c d, P.plane.adjacent a c → P.plane.adjacent a d → + u c = u d → c = d) ∧ + (∀ c, P.plane.adjacent a c → + D.edgeArc a c ∩ Metric.ball (D.position a) r = + Metric.ball (D.position a) r ∩ + {p | ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • u c}) ∧ + (∀ c d, P.plane.adjacent c d → c ≠ a → d ≠ a → + Disjoint (D.edgeArc c d) (Metric.ball (D.position a) r)) ∧ + ((Set.range D.position ∪ + {p | ∃ c d, P.plane.adjacent c d ∧ p ∈ D.edgeArc c d}) ∩ + Metric.ball (D.position a) r = + Metric.ball (D.position a) r ∩ + {p | ∃ c, P.plane.adjacent a c ∧ + ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • u c}) := by +-- BODY + classical + let : Nontrivial ι := P3776T1FixedGeometry P.toPeriodicTileCore |>.1 + have hadj_contact (c d : ι) (hcd : P.plane.adjacent c d) : + P3723T1EdgeContact P c d := by + refine ⟨?_, P.adjacent_has_common_edge c d hcd⟩ + intro h + subst d + exact P.plane.adjacent_irreflexive c hcd + have hposition_arc_endpoint (v c d : ι) (hcd : P3723T1EdgeContact P c d) + (hv : D.position v ∈ D.edgeArc c d) : v = c ∨ v = d := + RadialStarProof.hposition_arc_endpoint ι P D hadj_contact v c d hcd hv + have hincident_position (c : ι) (hac : P.plane.adjacent a c) : + D.position a ∈ D.edgeArc a c := by + obtain ⟨g, _, _, hrange, hg0, _, _⟩ := D.edgeArc_parameterization a c (hadj_contact a c hac) + rw [← hrange] + rw [← hg0] + exact ⟨⟨0, by norm_num⟩, rfl⟩ + have hlocal (c : ι) (hac : P.plane.adjacent a c) : + ∃ u : Real × Real, ‖u‖ = 1 ∧ ∃ ε > 0, + D.edgeArc a c ∩ Metric.ball (D.position a) ε = + Metric.ball (D.position a) ε ∩ + {p | ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • u} := RadialStarProof.hlocal ι P D a + hadj_contact c hac + have hNfin : Set.Finite {c : ι | P.plane.adjacent a c} := P.plane.locally_finite a + let localU (c : ι) (hc : P.plane.adjacent a c) : Real × Real := + Classical.choose (hlocal c hc) + let localEps (c : ι) (hc : P.plane.adjacent a c) : Real := + Classical.choose (Classical.choose_spec (hlocal c hc)).2 + have localSpec (c : ι) (hc : P.plane.adjacent a c) : + ‖localU c hc‖ = 1 ∧ 0 < localEps c hc ∧ + D.edgeArc a c ∩ Metric.ball (D.position a) (localEps c hc) = + Metric.ball (D.position a) (localEps c hc) ∩ + {p | ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • localU c hc} := by + dsimp [localU, localEps] + have hs := Classical.choose_spec (hlocal c hc) + have he := Classical.choose_spec hs.2 + exact ⟨hs.1, he.1, he.2⟩ + let eps (c : ι) : Real := @dite Real (P.plane.adjacent a c) (Classical.propDecidable _) + (fun hc => localEps c hc) (fun _ => 1) + have finiteLower : ∀ s : Finset ι, + (∀ c ∈ s, 0 < eps c) → + ∃ q : Real, 0 < q ∧ ∀ c ∈ s, q < eps c := RadialStarProof.finiteLower ι P D a hlocal + let SN := hNfin.toFinset + obtain ⟨rN, hrN, hrNsmall⟩ := finiteLower SN (by + intro c hc + have hca : P.plane.adjacent a c := (Set.Finite.mem_toFinset hNfin).mp hc + simpa [eps, hca] using (localSpec c hca).2.1) + let u : ι → Real × Real := fun c => + @dite (Real × Real) (P.plane.adjacent a c) (Classical.propDecidable _) + (fun hc => localU c hc) (fun _ => 0) + have u_norm (c : ι) (hc : P.plane.adjacent a c) : ‖u c‖ = 1 := by + simp [u, hc, localSpec c hc] + have localRay (c : ι) (hc : P.plane.adjacent a c) (q : Real) + (hq0 : 0 < q) (hq : q < localEps c hc) : + D.edgeArc a c ∩ Metric.ball (D.position a) q = + Metric.ball (D.position a) q ∩ + {p | ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • u c} := RadialStarProof.localRay ι P D + a hlocal localSpec c hc q hq0 hq + have edgeCompact (c d : ι) (hcd : P3723T1EdgeContact P c d) : + IsCompact (D.edgeArc c d) := by + obtain ⟨g, hg, _, hrange, _, _, _⟩ := D.edgeArc_parameterization c d hcd + let : CompactSpace (Set.Icc (0 : Real) 1) := inferInstance + rw [← hrange] + exact isCompact_range hg + let Q : Set (Real × Real) := Metric.closedBall (D.position a) 1 + have hQ : IsCompact Q := by dsimp [Q]; exact isCompact_closedBall _ _ + let E : Set (ι × ι) := {e | P3723T1EdgeContact P e.1 e.2 ∧ + (D.edgeArc e.1 e.2 ∩ Q).Nonempty} + have hE : E.Finite := by + dsimp [E, Q] + exact D.compact_local_finiteness _ (isCompact_closedBall _ _) + let E0 : Set (ι × ι) := {e | e ∈ E ∧ e.1 ≠ a ∧ e.2 ≠ a} + have hE0 : E0.Finite := hE.subset (by intro e he; exact he.1) + let A : Set (Real × Real) := ⋃ e ∈ E0, D.edgeArc e.1 e.2 + have hAcompact : IsCompact A := by + dsimp [A] + apply hE0.isCompact_biUnion + intro e he + exact edgeCompact e.1 e.2 he.1.1 + have hxA : D.position a ∉ A := by + change D.position a ∉ ⋃ e : ι × ι, ⋃ (_ : e ∈ E0), D.edgeArc e.1 e.2 + intro hx + obtain ⟨e, he⟩ := Set.mem_iUnion.mp hx + obtain ⟨he0, hx⟩ := Set.mem_iUnion.mp he + have hend := hposition_arc_endpoint a e.1 e.2 he0.1.1 hx + rcases hend with h | h + · exact he0.2.1 h.symm + · exact he0.2.2 h.symm + obtain ⟨rF0, hrF0, hballF0⟩ := + (Metric.isOpen_iff.mp hAcompact.isClosed.isOpen_compl) (D.position a) hxA + have hballF : Metric.ball (D.position a) rF0 ⊆ Aᶜ := hballF0 + have hrF0pos : 0 < rF0 := hrF0 + let r : Real := min rN (min rF0 1) / 2 + have hr : 0 < r := by dsimp [r]; positivity + have hrNlt : r < rN := by dsimp [r]; have := min_le_left rN (min rF0 1); linarith + have hrFlt : r < rF0 := by + dsimp [r] + have hmin := min_le_right rN (min rF0 1) + have hmin2 := min_le_left rF0 1 + linarith + have hrlt1 : r < 1 := by + dsimp [r] + have hmin := min_le_right rN (min rF0 1) + have hmin2 := min_le_right rF0 1 + linarith + have hr_local (c : ι) (hc : P.plane.adjacent a c) : r < localEps c hc := by + have hcS : c ∈ SN := (Set.Finite.mem_toFinset hNfin).mpr hc + have hsmall := hrNsmall c hcS + simpa [eps, hc] using hrNlt.trans hsmall + have hforeign (c d : ι) (hcd : P.plane.adjacent c d) + (hca : c ≠ a) (hda : d ≠ a) : + Disjoint (D.edgeArc c d) (Metric.ball (D.position a) r) := RadialStarProof.hforeign ι P D a + hadj_contact rN rF0 hballF hrFlt hrlt1 c d hcd hca hda + have hu_injective : ∀ c d, P.plane.adjacent a c → P.plane.adjacent a d → + u c = u d → c = d := RadialStarProof.hu_injective ι P D a hadj_contact hlocal rN u_norm + localRay rF0 hr hr_local + have vertexArc (v w : ι) (hvw : P.plane.adjacent v w) : + D.position v ∈ D.edgeArc v w := by + obtain ⟨g, _, _, hrange, hg0, _, _⟩ := + D.edgeArc_parameterization v w (hadj_contact v w hvw) + rw [← hrange, ← hg0] + exact ⟨⟨0, by norm_num⟩, rfl⟩ + have vertexRay (v : ι) (hvball : D.position v ∈ Metric.ball (D.position a) r) : + ∃ c, P.plane.adjacent a c ∧ ∃ t : Real, 0 ≤ t ∧ + D.position v = D.position a + t • u c := RadialStarProof.vertexRay ι P D a hlocal rN + localRay rF0 hr hr_local hforeign vertexArc v hvball + refine ⟨r, hr, u, u_norm, hu_injective, ?_, hforeign, ?_⟩ + · intro c hac + exact localRay c hac r hr (hr_local c hac) + · ext p + constructor + · rintro ⟨hpTrace, hpBall⟩ + rcases hpTrace with ⟨v, hvp⟩ | ⟨c, d, hcd, hpArc⟩ + · have hvball : D.position v ∈ Metric.ball (D.position a) r := hvp ▸ hpBall + obtain ⟨c, hac, t, ht, hpos⟩ := vertexRay v hvball + refine ⟨hpBall, c, hac, t, ht, ?_⟩ + exact hvp.symm.trans hpos + · by_cases hca : c = a + · subst c + have hI : p ∈ D.edgeArc a d ∩ Metric.ball (D.position a) r := ⟨hpArc, hpBall⟩ + rw [localRay d hcd r hr (hr_local d hcd)] at hI + rcases hI.2 with ⟨t, ht, hp⟩ + exact ⟨hpBall, d, hcd, t, ht, hp⟩ + · by_cases hda : d = a + · subst d + have had : P.plane.adjacent a c := (P.plane.adjacent_symmetric c a).mp hcd + have hI : p ∈ D.edgeArc a c ∩ Metric.ball (D.position a) r := by + have hs : D.edgeArc c a = D.edgeArc a c := D.edgeArc_symmetric c a + simpa [hs] using And.intro hpArc hpBall + rw [localRay c had r hr (hr_local c had)] at hI + rcases hI.2 with ⟨t, ht, hp⟩ + exact ⟨hpBall, c, had, t, ht, hp⟩ + · have hfalse := (Set.disjoint_left.mp (hforeign c d hcd hca hda)) hpArc hpBall + exact False.elim hfalse + · rintro ⟨hpBall, c, hac, t, ht, hp⟩ + have hrayBall : D.position a + t • u c ∈ Metric.ball (D.position a) r := by + rw [← hp] + exact hpBall + have hI : D.position a + t • u c ∈ + D.edgeArc a c ∩ Metric.ball (D.position a) r := by + rw [localRay c hac r hr (hr_local c hac)] + exact ⟨hrayBall, ⟨t, ht, rfl⟩⟩ + have hpArc : p ∈ D.edgeArc a c := by rw [hp]; exact hI.1 + exact ⟨Or.inr ⟨a, c, hac, hpArc⟩, hpBall⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean new file mode 100644 index 0000000000..dce2fb4d87 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean @@ -0,0 +1,2123 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3861T1FacialDomains +public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectorDecomposition +public import LeanPool.ApollonianSuperharmonic.P3767T1BarrierRegionMaximal +public import LeanPool.ApollonianSuperharmonic.P3767T1VertexEdgeIncidence +public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry +public import Mathlib.Analysis.Normed.Module.Connected +public import Mathlib.LinearAlgebra.Dimension.Constructions + +-- [TABLET NODE: P3889T1FaceGapCoverage] + +/-! +# P3889T1FaceGapCoverage + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FaceGapProof + +private theorem hfrontTrace : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), + let T := Set.range D.position ∪ + {q | ∃ c d, P.plane.adjacent c d ∧ q ∈ D.edgeArc c d} + ∀ (f : P.plane.Face), frontier (F.region f) ⊆ T ) := by + classical + intro ι P D F T f + rw [F.region_frontier] + rintro q ((hq | hq) | hq) + · exact Or.inr ⟨_, _, P.plane.face_edges f 0 1 (by decide), hq⟩ + · exact Or.inr ⟨_, _, P.plane.face_edges f 1 2 (by decide), hq⟩ + · exact Or.inr ⟨_, _, P.plane.face_edges f 2 0 (by decide), hq⟩ + +private theorem hfaceFrontier : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), (∀ (c : ι), ∀ (d : ι), + P.plane.adjacent c d → c ≠ a → d ≠ a → Disjoint (D.edgeArc c d) (Metric.ball + (D.position a) r)) → ( + let x := D.position a + let B := Metric.ball x r + ∀ (f : P.plane.Face), ∀ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = a → ∃ (c : ι) (d : + ι), c ≠ a ∧ d ≠ a ∧ c ≠ d ∧ P.plane.adjacent a c ∧ P.plane.adjacent a d ∧ (∃ (j : Fin + (3 : ℕ)), P.plane.faceVertex f j = c) ∧ (∃ (j : Fin (3 : ℕ)), P.plane.faceVertex f j + = d) ∧ frontier (F.region f) ∩ B = (D.edgeArc a c ∪ D.edgeArc a d) ∩ B) ) := by + classical + intro ι P D F a r hforeign x B f i hi + have hinj := P.plane.face_vertices_distinct f + have hvertex_ne (j : Fin 3) (hji : j ≠ i) : + P.plane.faceVertex f j ≠ a := by + intro h + exact hji (hinj (h.trans hi.symm)) + fin_cases i + · refine ⟨P.plane.faceVertex f 1, P.plane.faceVertex f 2, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · exact hvertex_ne 1 (by decide) + · exact hvertex_ne 2 (by decide) + · exact hinj.ne (by decide) + · rw [← hi]; exact P.plane.face_edges f 0 1 (by decide) + · rw [← hi]; exact P.plane.face_edges f 0 2 (by decide) + · exact ⟨1, rfl⟩ + · exact ⟨2, rfl⟩ + · rw [← hi, F.region_frontier, + D.edgeArc_symmetric (P.plane.faceVertex f 2) (P.plane.faceVertex f 0)] + have h12 : Disjoint (D.edgeArc (P.plane.faceVertex f 1) + (P.plane.faceVertex f 2)) B := by + apply hforeign _ _ (P.plane.face_edges f 1 2 (by decide)) + · exact hvertex_ne 1 (by decide) + · exact hvertex_ne 2 (by decide) + ext q + simp only [Set.mem_inter_iff, Set.mem_union] + constructor + · rintro ⟨(h01 | h12q) | h20, hqB⟩ + · exact ⟨Or.inl h01, hqB⟩ + · exact (Set.disjoint_left.mp h12 h12q hqB).elim + · exact ⟨Or.inr h20, hqB⟩ + · rintro ⟨h01 | h20, hqB⟩ + · exact ⟨Or.inl (Or.inl h01), hqB⟩ + · exact ⟨Or.inr h20, hqB⟩ + · refine ⟨P.plane.faceVertex f 0, P.plane.faceVertex f 2, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · exact hvertex_ne 0 (by decide) + · exact hvertex_ne 2 (by decide) + · exact hinj.ne (by decide) + · rw [← hi]; exact P.plane.face_edges f 1 0 (by decide) + · rw [← hi]; exact P.plane.face_edges f 1 2 (by decide) + · exact ⟨0, rfl⟩ + · exact ⟨2, rfl⟩ + · rw [← hi, F.region_frontier, + D.edgeArc_symmetric (P.plane.faceVertex f 0) (P.plane.faceVertex f 1)] + have h02 : Disjoint (D.edgeArc (P.plane.faceVertex f 2) + (P.plane.faceVertex f 0)) B := by + apply hforeign _ _ (P.plane.face_edges f 2 0 (by decide)) + · exact hvertex_ne 2 (by decide) + · exact hvertex_ne 0 (by decide) + ext q + simp only [Set.mem_inter_iff, Set.mem_union] + constructor + · rintro ⟨(h01 | h12) | h20, hqB⟩ + · exact ⟨Or.inl h01, hqB⟩ + · exact ⟨Or.inr h12, hqB⟩ + · exact (Set.disjoint_left.mp h02 h20 hqB).elim + · rintro ⟨h01 | h12, hqB⟩ + · exact ⟨Or.inl (Or.inl h01), hqB⟩ + · exact ⟨Or.inl (Or.inr h12), hqB⟩ + · refine ⟨P.plane.faceVertex f 0, P.plane.faceVertex f 1, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · exact hvertex_ne 0 (by decide) + · exact hvertex_ne 1 (by decide) + · exact hinj.ne (by decide) + · rw [← hi]; exact P.plane.face_edges f 2 0 (by decide) + · rw [← hi]; exact P.plane.face_edges f 2 1 (by decide) + · exact ⟨0, rfl⟩ + · exact ⟨1, rfl⟩ + · rw [← hi, F.region_frontier, + D.edgeArc_symmetric (P.plane.faceVertex f 1) (P.plane.faceVertex f 2)] + have h01 : Disjoint (D.edgeArc (P.plane.faceVertex f 0) + (P.plane.faceVertex f 1)) B := by + apply hforeign _ _ (P.plane.face_edges f 0 1 (by decide)) + · exact hvertex_ne 0 (by decide) + · exact hvertex_ne 1 (by decide) + ext q + simp only [Set.mem_inter_iff, Set.mem_union] + constructor + · rintro ⟨(h01q | h12) | h20, hqB⟩ + · exact (Set.disjoint_left.mp h01 h01q hqB).elim + · exact ⟨Or.inr h12, hqB⟩ + · exact ⟨Or.inl h20, hqB⟩ + · rintro ⟨h20 | h12, hqB⟩ + · exact ⟨Or.inr h20, hqB⟩ + · exact ⟨Or.inl (Or.inr h12), hqB⟩ + +private theorem hpNotRays : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : + ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), ((Set.range D.position ∪ {p : ℝ × ℝ | ∃ (c : ι) (d + : ι), P.plane.adjacent c d ∧ p ∈ D.edgeArc c d}) ∩ Metric.ball (D.position a) r = + Metric.ball (D.position a) r ∩ {p : ℝ × ℝ | ∃ (c : ι), P.plane.adjacent a c ∧ ∃ (t : + ℝ), (0 : ℝ) ≤ t ∧ p = D.position a + t • u c}) → (∀ (p : ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + let T := Set.range D.position ∪ + {q | ∃ c d, P.plane.adjacent c d ∧ q ∈ D.edgeArc c d} + (p ∉ T) → (p ∉ B ∩ {q | ∃ c, P.plane.adjacent a c ∧ ∃ t : Real, 0 ≤ t ∧ q = x + t • u + c})) ) := by + classical + intro ι P D a r u htrace p x B T hpNotT h + have hpTrace : p ∈ (Set.range D.position ∪ + {q | ∃ c d, P.plane.adjacent c d ∧ q ∈ D.edgeArc c d}) ∩ + Metric.ball (D.position a) r := by + change p ∈ Metric.ball (D.position a) r ∩ + {q | ∃ c, P.plane.adjacent a c ∧ + ∃ t : Real, 0 ≤ t ∧ q = D.position a + t • u c} at h + rw [htrace] + exact h + apply hpNotT + change p ∈ Set.range D.position ∪ + {q | ∃ c d, P.plane.adjacent c d ∧ q ∈ D.edgeArc c d} + exact hpTrace.1 + +private theorem hpNotRay : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : + ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), ∀ (p : ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + (p ∈ B) → ((p ∉ B ∩ {q | ∃ c, P.plane.adjacent a c ∧ ∃ t : Real, 0 ≤ t ∧ q = x + t • u + c}) → (∀ (c : ι), P.plane.adjacent a c → p ∉ {q : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ q + = x + t • u c})) ) := by + classical + intro ι P D a r u p x B hpB hpNotRays c hac h + apply hpNotRays + refine ⟨hpB, c, hac, ?_⟩ + simpa [x] using h + +private theorem hincidentSectorData : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), (∀ (c : ι), + P.plane.adjacent a c → D.edgeArc a c ∩ Metric.ball (D.position a) r = Metric.ball + (D.position a) r ∩ {p : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ p = D.position a + t • u c}) + → ((∀ (c : ι), ∀ (d : ι), P.plane.adjacent a c → P.plane.adjacent a d → c ≠ d → + Nonempty (P3889T1TwoRaySectorDecomposition (D.position a) r (u c) (u d))) → ( + let x := D.position a + let B := Metric.ball x r + (∀ (f : P.plane.Face), ∀ (i : Fin 3), (P.plane.faceVertex f i = a) → (∃ c d, c ≠ a ∧ d ≠ + a ∧ c ≠ d ∧ P.plane.adjacent a c ∧ P.plane.adjacent a d ∧ (∃ j, P.plane.faceVertex f + j = c) ∧ (∃ j, P.plane.faceVertex f j = d) ∧ frontier (F.region f) ∩ B = (D.edgeArc a + c ∪ D.edgeArc a d) ∩ B)) → (∀ (f : P.plane.Face), ∀ (i : Fin (3 : ℕ)), + P.plane.faceVertex f i = a → ∃ (c : ι) (d : ι), c ≠ a ∧ d ≠ a ∧ c ≠ d ∧ + P.plane.adjacent a c ∧ P.plane.adjacent a d ∧ (∃ (j : Fin (3 : ℕ)), + P.plane.faceVertex f j = c) ∧ (∃ (j : Fin (3 : ℕ)), P.plane.faceVertex f j = d) ∧ + frontier (F.region f) ∩ B = B ∩ {q : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ q = x + t • u + c} ∪ B ∩ {q : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ q = x + t • u d} ∧ Nonempty + (P3889T1TwoRaySectorDecomposition x r (u c) (u d))))) ) := by + classical + intro ι P D F a r u hedge hsectors x B hfaceFrontier f i hi + obtain ⟨c, d, hca, hda, hcd, hac, had, hci, hdi, hfront⟩ := hfaceFrontier f i hi + obtain ⟨S⟩ := hsectors c d hac had hcd + refine ⟨c, d, hca, hda, hcd, hac, had, hci, hdi, ?_, ⟨S⟩⟩ + rw [hfront, Set.union_inter_distrib_right, hedge c hac, hedge d had] + +private theorem hxray : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : + ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (c : ι), (x ∈ B) → (x ∈ (B ∩ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c})) ) := by + classical + intro ι P D a r u x B c hxB + refine ⟨hxB, 0, le_rfl, ?_⟩ + simp + +private theorem hxfront : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), (frontier (F.region f) ∩ B = B ∩ {q : ℝ × ℝ | + ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ q = x + t • u c} ∪ B ∩ {q : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ + q = x + t • u d}) → ( + let U := F.region f + (x ∈ (B ∩ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c})) → (x ∈ frontier U)) ) := by + classical + intro ι P D F a r u x B f c d hfront U hxray + have hx' : x ∈ frontier U ∩ B := by rw [hfront]; exact Or.inl hxray + exact hx'.1 + +private theorem rayFront : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), (frontier (F.region f) ∩ B = B ∩ {q : ℝ × ℝ | + ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ q = x + t • u c} ∪ B ∩ {q : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ + q = x + t • u d}) → ( + let U := F.region f + ∀ q ∈ B, q ∈ {q : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ q = x + t • u c} ∪ {q : ℝ × ℝ | ∃ (t : + ℝ), (0 : ℝ) ≤ t ∧ q = x + t • u d} → q ∈ frontier U) ) := by + classical + intro ι P D F a r u x B f c d hfront U q hqB hqRay + have heq := congrArg (fun s : Set (Real × Real) => q ∈ s) hfront + have hq' : q ∈ frontier U ∩ B := by + apply heq.mpr + rcases hqRay with hqRay | hqRay + · exact Or.inl ⟨hqB, hqRay⟩ + · exact Or.inr ⟨hqB, hqRay⟩ + exact hq'.1 + +private theorem hmeetU : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ((0 : ℝ) < r) → ( + let x := D.position a + let B := Metric.ball x r + ∀ (f : P.plane.Face), + let U := F.region f + (x ∈ frontier U) → ((B ∩ U).Nonempty)) ) := by + classical + intro ι P D F a r hr x B f U hxfront + have hxcl : x ∈ closure U := frontier_subset_closure hxfront + obtain ⟨q, hq⟩ := (mem_closure_iff_nhds.mp hxcl) B + (Metric.ball_mem_nhds x hr) + exact ⟨q, hq⟩ + +private theorem hxfrontV : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), + let x := D.position a + ∀ (f : P.plane.Face), + let U := F.region f + let V := (closure U)ᶜ + (x ∈ frontier U) → (x ∈ frontier V) ) := by + classical + intro ι P D F a x f U V hxfront + rw [F.exterior_frontier] + exact hxfront + +private theorem hmeetV : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ((0 : ℝ) < r) → ( + let x := D.position a + let B := Metric.ball x r + ∀ (f : P.plane.Face), + let U := F.region f + let V := (closure U)ᶜ + (x ∈ frontier V) → ((B ∩ V).Nonempty)) ) := by + classical + intro ι P D F a r hr x B f U V hxfrontV + have hxcl : x ∈ closure V := frontier_subset_closure hxfrontV + obtain ⟨q, hq⟩ := (mem_closure_iff_nhds.mp hxcl) B + (Metric.ball_mem_nhds x hr) + exact ⟨q, hq⟩ + +private theorem hLsub : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : + ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (c : ι), ∀ (d : ι), ∀ (S : P3889T1TwoRaySectorDecomposition x r (u c) (u d)), S.left + ⊆ B \ ({q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t + • u d}) ) := by + classical + intro ι P D a r u x B c d S + rw [← S.cover] + exact Set.subset_union_left + +private theorem hRsub : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : + ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (c : ι), ∀ (d : ι), ∀ (S : P3889T1TwoRaySectorDecomposition x r (u c) (u d)), S.right + ⊆ B \ ({q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t + • u d}) ) := by + classical + intro ι P D a r u x B c d S + rw [← S.cover] + exact Set.subset_union_right + +private theorem hLavoid : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), (frontier (F.region f) ∩ B = B ∩ {q : ℝ × ℝ | + ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ q = x + t • u c} ∪ B ∩ {q : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ + q = x + t • u d}) → (∀ (S : P3889T1TwoRaySectorDecomposition x r (u c) (u d)), + let U := F.region f + (S.left ⊆ B \ ({q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ {q | ∃ t : Real, 0 ≤ t ∧ q = x + + t • u d})) → (Disjoint S.left (frontier U))) ) := by + classical + intro ι P D F a r u x B f c d hfront S U hLsub + apply Set.disjoint_left.mpr + intro q hq hqf + have hqB := (hLsub hq).1 + have hqRay : q ∈ ({q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ + {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u d}) := by + have hq' : (q ∈ B ∩ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c}) ∨ + (q ∈ B ∩ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u d}) := by + have heq := congrArg (fun s : Set (Real × Real) => q ∈ s) hfront + simpa only [Set.mem_union, Set.mem_inter_iff] using heq.mp ⟨hqf, hqB⟩ + rcases hq' with hq' | hq' + · exact Or.inl hq'.2 + · exact Or.inr hq'.2 + exact (hLsub hq).2 hqRay + +private theorem hRavoid : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), (frontier (F.region f) ∩ B = B ∩ {q : ℝ × ℝ | + ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ q = x + t • u c} ∪ B ∩ {q : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ + q = x + t • u d}) → (∀ (S : P3889T1TwoRaySectorDecomposition x r (u c) (u d)), + let U := F.region f + (S.right ⊆ B \ ({q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ {q | ∃ t : Real, 0 ≤ t ∧ q = + x + t • u d})) → (Disjoint S.right (frontier U))) ) := by + classical + intro ι P D F a r u x B f c d hfront S U hRsub + apply Set.disjoint_left.mpr + intro q hq hqf + have hqB := (hRsub hq).1 + have hqRay : q ∈ ({q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ + {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u d}) := by + have hq' : (q ∈ B ∩ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c}) ∨ + (q ∈ B ∩ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u d}) := by + have heq := congrArg (fun s : Set (Real × Real) => q ∈ s) hfront + simpa only [Set.mem_union, Set.mem_inter_iff] using heq.mp ⟨hqf, hqB⟩ + rcases hq' with hq' | hq' + · exact Or.inl hq'.2 + · exact Or.inr hq'.2 + exact (hRsub hq).2 hqRay + +private theorem hLavoidV : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), ∀ (S : P3889T1TwoRaySectorDecomposition x r + (u c) (u d)), + let U := F.region f + let V := (closure U)ᶜ + (Disjoint S.left (frontier U)) → (Disjoint S.left (frontier V)) ) := by + classical + intro ι P D F a r u x f c d S U V hLavoid + rw [F.exterior_frontier] + exact hLavoid + +private theorem hRavoidV : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), ∀ (S : P3889T1TwoRaySectorDecomposition x r + (u c) (u d)), + let U := F.region f + let V := (closure U)ᶜ + (Disjoint S.right (frontier U)) → (Disjoint S.right (frontier V)) ) := by + classical + intro ι P D F a r u x f c d S U V hRavoid + rw [F.exterior_frontier] + exact hRavoid + +private theorem hUV : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (f : P.plane.Face), + let U := F.region f + let V := (closure U)ᶜ + Disjoint U V ) := by + classical + intro ι P D F f U V + apply Set.disjoint_left.mpr + intro q hqU hqV + exact hqV (subset_closure hqU) + +private theorem hLpart : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), ∀ (S : P3889T1TwoRaySectorDecomposition x r + (u c) (u d)), + let U := F.region f + let V := (closure U)ᶜ + (Disjoint S.left (frontier U)) → ((IsOpen U) → (S.left ⊆ U ∪ V)) ) := by + classical + intro ι P D F a r u x f c d S U V hLavoid hUopen q hq + by_cases hqU : q ∈ U + · exact Or.inl hqU + · right + by_contra hqV + have hqcl : q ∈ closure U := by simpa [V] using hqV + have hqf : q ∈ frontier U := by + rw [frontier, hUopen.interior_eq] + exact ⟨hqcl, hqU⟩ + exact (Set.disjoint_left.mp hLavoid hq hqf).elim + +private theorem hRpart : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), ∀ (S : P3889T1TwoRaySectorDecomposition x r + (u c) (u d)), + let U := F.region f + let V := (closure U)ᶜ + (Disjoint S.right (frontier U)) → ((IsOpen U) → (S.right ⊆ U ∪ V)) ) := by + classical + intro ι P D F a r u x f c d S U V hRavoid hUopen q hq + by_cases hqU : q ∈ U + · exact Or.inl hqU + · right + by_contra hqV + have hqcl : q ∈ closure U := by simpa [V] using hqV + have hqf : q ∈ frontier U := by + rw [frontier, hUopen.interior_eq] + exact ⟨hqcl, hqU⟩ + exact (Set.disjoint_left.mp hRavoid hq hqf).elim + +private theorem hLchoice : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), ∀ (S : P3889T1TwoRaySectorDecomposition x r + (u c) (u d)), + let U := F.region f + let V := (closure U)ᶜ + (Disjoint S.left (frontier U)) → ((Disjoint S.left (frontier V)) → ((IsOpen U) → ((S.left + ⊆ U ∪ V) → (S.left ⊆ U ∨ S.left ⊆ V)))) ) := by + classical + intro ι P D F a r u x f c d S U V hLavoid hLavoidV hUopen hLpart + by_cases hm : (S.left ∩ U).Nonempty + · exact Or.inl (P3767T1BarrierRegionMaximal U (frontier U) S.left + hUopen subset_rfl S.left_connected.isPreconnected hLavoid hm) + · right + obtain ⟨q, hqL⟩ := S.left_connected.nonempty + have hqV : q ∈ V := by + rcases hLpart hqL with hqU | hqV + · exact (hm ⟨q, hqL, hqU⟩).elim + · exact hqV + exact P3767T1BarrierRegionMaximal V (frontier V) S.left + isClosed_closure.isOpen_compl subset_rfl S.left_connected.isPreconnected hLavoidV + ⟨q, hqL, hqV⟩ + +private theorem hRchoice : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), ∀ (S : P3889T1TwoRaySectorDecomposition x r + (u c) (u d)), + let U := F.region f + let V := (closure U)ᶜ + (Disjoint S.right (frontier U)) → ((Disjoint S.right (frontier V)) → ((IsOpen U) → + ((S.right ⊆ U ∪ V) → (S.right ⊆ U ∨ S.right ⊆ V)))) ) := by + classical + intro ι P D F a r u x f c d S U V hRavoid hRavoidV hUopen hRpart + by_cases hm : (S.right ∩ U).Nonempty + · exact Or.inl (P3767T1BarrierRegionMaximal U (frontier U) S.right + hUopen subset_rfl S.right_connected.isPreconnected hRavoid hm) + · right + obtain ⟨q, hqR⟩ := S.right_connected.nonempty + have hqV : q ∈ V := by + rcases hRpart hqR with hqU | hqV + · exact (hm ⟨q, hqR, hqU⟩).elim + · exact hqV + exact P3767T1BarrierRegionMaximal V (frontier V) S.right + isClosed_closure.isOpen_compl subset_rfl S.right_connected.isPreconnected hRavoidV + ⟨q, hqR, hqV⟩ + +private theorem hnotUU : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), ∀ (S : P3889T1TwoRaySectorDecomposition x r + (u c) (u d)), + let U := F.region f + let V := (closure U)ᶜ + (∀ (q : Real × Real), (q ∈ B) → ((q ∈ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ {q | ∃ + t : Real, 0 ≤ t ∧ q = x + t • u d}) → (q ∈ frontier U))) → (((B ∩ V).Nonempty) → (¬ + (S.left ⊆ U ∧ S.right ⊆ U))) ) := by + classical + intro ι P D F a r u x B f c d S U V rayFront hmeetV + rintro ⟨hL, hR⟩ + obtain ⟨q, ⟨hqB, hqV⟩⟩ := hmeetV + have hqNotRay : q ∉ ({q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ + {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u d}) := by + intro hqRay + have hqf : q ∈ frontier U := rayFront q hqB hqRay + have hqcl : q ∈ closure U := frontier_subset_closure hqf + exact hqV hqcl + have hqsec : q ∈ S.left ∪ S.right := by + rw [S.cover] + exact ⟨hqB, hqNotRay⟩ + rcases hqsec with hqL | hqR + · exact hqV (subset_closure (hL hqL)) + · exact hqV (subset_closure (hR hqR)) + +private theorem hnotVV : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), ∀ (S : P3889T1TwoRaySectorDecomposition x r + (u c) (u d)), + let U := F.region f + let V := (closure U)ᶜ + (∀ (q : Real × Real), (q ∈ B) → ((q ∈ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ {q | ∃ + t : Real, 0 ≤ t ∧ q = x + t • u d}) → (q ∈ frontier U))) → (((B ∩ U).Nonempty) → + ((IsOpen U) → ((Disjoint U V) → (¬ (S.left ⊆ V ∧ S.right ⊆ V))))) ) := by + classical + intro ι P D F a r u x B f c d S U V rayFront hmeetU hUopen hUV + rintro ⟨hL, hR⟩ + obtain ⟨q, ⟨hqB, hqU⟩⟩ := hmeetU + have hqNotRay : q ∉ ({q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ + {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u d}) := by + intro hqRay + have hqf : q ∈ frontier U := rayFront q hqB hqRay + have hqnotU : q ∉ U := by + intro hqU' + have : q ∈ frontier U := hqf + rw [frontier, hUopen.interior_eq] at this + exact this.2 hqU' + exact hqnotU hqU + have hqsec : q ∈ S.left ∪ S.right := by + rw [S.cover] + exact ⟨hqB, hqNotRay⟩ + rcases hqsec with hqL | hqR + · exact (Set.disjoint_left.mp hUV hqU (hL hqL)) + · exact (Set.disjoint_left.mp hUV hqU (hR hqR)) + +private theorem hfill : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), ∀ (S : P3889T1TwoRaySectorDecomposition x r + (u c) (u d)), + let U := F.region f + let V := (closure U)ᶜ + (S.left ⊆ U ∨ S.left ⊆ V) → ((S.right ⊆ U ∨ S.right ⊆ V) → ((¬ (S.left ⊆ U ∧ S.right ⊆ + U)) → ((¬ (S.left ⊆ V ∧ S.right ⊆ V)) → ((S.left ⊆ U ∧ S.right ⊆ V) ∨ (S.right ⊆ U ∧ + S.left ⊆ V))))) ) := by + classical + intro ι P D F a r u x f c d S U V hLchoice hRchoice hnotUU hnotVV + rcases hLchoice with hL | hL <;> rcases hRchoice with hR | hR + · exact (hnotUU ⟨hL, hR⟩).elim + · exact Or.inl ⟨hL, hR⟩ + · exact Or.inr ⟨hR, hL⟩ + · exact (hnotVV ⟨hL, hR⟩).elim + +private theorem hqNotRayAt457 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), + let U := F.region f + (∀ (q : Real × Real), (q ∈ B) → ((q ∈ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ {q | ∃ + t : Real, 0 ≤ t ∧ q = x + t • u d}) → (q ∈ frontier U))) → ((IsOpen U) → (∀ (q : ℝ × + ℝ), (q ∈ F.region f ∩ B) → (q ∉ ({q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ {q | ∃ t + : Real, 0 ≤ t ∧ q = x + t • u d})))) ) := by + classical + intro ι P D F a r u x B f c d U rayFront hUopen q hq hqRay + have hqf : q ∈ frontier U := rayFront q hq.2 hqRay + have hqnotU : q ∉ U := by + intro hqU + have : q ∈ frontier U := hqf + rw [frontier, hUopen.interior_eq] at this + exact this.2 hqU + exact hqnotU hq.1 + +private theorem hqsecAt467 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), ∀ (S : P3889T1TwoRaySectorDecomposition x r + (u c) (u d)), ∀ (q : ℝ × ℝ), (q ∈ F.region f ∩ B) → ((q ∉ ({q | ∃ t : Real, 0 ≤ t ∧ q + = x + t • u c} ∪ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u d})) → (q ∈ S.left ∪ + S.right)) ) := by + classical + intro ι P D F a r u x B f c d S q hq hqNotRay + rw [S.cover] + exact ⟨hq.2, hqNotRay⟩ + +private theorem hqNotRayAt479 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), + let U := F.region f + (∀ (q : Real × Real), (q ∈ B) → ((q ∈ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ {q | ∃ + t : Real, 0 ≤ t ∧ q = x + t • u d}) → (q ∈ frontier U))) → ((IsOpen U) → (∀ (q : ℝ × + ℝ), (q ∈ F.region f ∩ B) → (q ∉ ({q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ {q | ∃ t + : Real, 0 ≤ t ∧ q = x + t • u d})))) ) := by + classical + intro ι P D F a r u x B f c d U rayFront hUopen q hq hqRay + have hqf : q ∈ frontier U := rayFront q hq.2 hqRay + have hqnotU : q ∉ U := by + intro hqU + have : q ∈ frontier U := hqf + rw [frontier, hUopen.interior_eq] at this + exact this.2 hqU + exact hqnotU hq.1 + +private theorem hqsecAt489 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), ∀ (S : P3889T1TwoRaySectorDecomposition x r + (u c) (u d)), ∀ (q : ℝ × ℝ), (q ∈ F.region f ∩ B) → ((q ∉ ({q | ∃ t : Real, 0 ≤ t ∧ q + = x + t • u c} ∪ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u d})) → (q ∈ S.left ∪ + S.right)) ) := by + classical + intro ι P D F a r u x B f c d S q hq hqNotRay + rw [S.cover] + exact ⟨hq.2, hqNotRay⟩ + +private theorem hrho : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : + ι), ∀ (p : ℝ × ℝ), + let x := D.position a + let T := Set.range D.position ∪ + {q | ∃ c d, P.plane.adjacent c d ∧ q ∈ D.edgeArc c d} + (p ∉ T) → ( + let rho : Real := ‖p - x‖ + 0 < rho) ) := by + classical + intro ι P D a p x T hpNotT rho + apply norm_pos_iff.mpr + intro hpx + apply hpNotT + left + have hpEq : p = x := sub_eq_zero.mp hpx + exact ⟨a, by simpa [x] using hpEq.symm⟩ + +private theorem hrho' : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : + ι), ∀ (r : ℝ), ∀ (p : ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + (p ∈ B) → ( + let rho : Real := ‖p - x‖ + rho < r) ) := by + classical + intro ι P D a r p x B hpB rho + have hpdist : dist p x < r := by simpa [B, Metric.mem_ball] using hpB + simpa [rho, dist_eq_norm] using hpdist + +private theorem hfinitePick : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), + let N : Set ι := {c | P.plane.adjacent a c} + (N.Finite) → ( + let Nsub := {c : ι // P.plane.adjacent a c} + let first (c : Nsub) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) + let second (c : Nsub) : P.plane.Face := + Classical.choose (Classical.choose_spec + (P.plane.every_edge_two_faces a c.1 c.2)) + let facePick : Nsub × Fin 2 → P.plane.Face := fun z => + if z.2 = 0 then first z.1 else second z.1 + (Set.range facePick).Finite) ) := by + classical + intro ι P a N hNfinite Nsub first second facePick + let : Finite Nsub := hNfinite.to_subtype + exact Set.finite_range facePick + +private theorem hIfinite : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), + let I : Set P.plane.Face := {f | ∃ i, P.plane.faceVertex f i = a} + let Nsub := {c : ι // P.plane.adjacent a c} + let first (c : Nsub) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) + let second (c : Nsub) : P.plane.Face := + Classical.choose (Classical.choose_spec + (P.plane.every_edge_two_faces a c.1 c.2)) + let facePick : Nsub × Fin 2 → P.plane.Face := fun z => + if z.2 = 0 then first z.1 else second z.1 + ((Set.range facePick).Finite) → (I.Finite) ) := by + classical + intro ι P a I Nsub first second facePick hfinitePick + apply hfinitePick.subset + intro f hf + change f ∈ I at hf + obtain ⟨i, hi⟩ := hf + obtain ⟨j, hji⟩ := exists_ne i + have hac : P.plane.adjacent a (P.plane.faceVertex f j) := by + rw [← hi] + exact P.plane.face_edges f i j hji.symm + let c : Nsub := ⟨P.plane.faceVertex f j, hac⟩ + have hspec := Classical.choose_spec (Classical.choose_spec + (P.plane.every_edge_two_faces a c.1 c.2)) + obtain ⟨hne, ⟨hf₀a, hf₀c⟩, ⟨hf₁a, hf₁c⟩, hexhaust⟩ := hspec + have hcase := hexhaust f ⟨⟨i, hi⟩, ⟨j, rfl⟩⟩ + rcases hcase with hEq | hEq + · refine ⟨(c, 0), ?_⟩ + simpa [facePick, first] using hEq.symm + · refine ⟨(c, 1), ?_⟩ + simpa [facePick, second] using hEq.symm + +private theorem faceOtherMatch : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (g : P.plane.Face), ∀ (j : Fin + (3 : ℕ)), P.plane.faceVertex g j = a → ∀ (e : ι), (∃ (k : Fin (3 : ℕ)), + P.plane.faceVertex g k = e) → e ≠ a → ∀ (c : ι), ∀ (d : ι), c ≠ a → d ≠ a → c ≠ d → + (∃ (k : Fin (3 : ℕ)), P.plane.faceVertex g k = c) → (∃ (k : Fin (3 : ℕ)), + P.plane.faceVertex g k = d) → e = c ∨ e = d ) := by + classical + intro ι P a g j hj e he hea c d hca hda hcd hc hd + obtain ⟨k, hk⟩ := he + obtain ⟨l, hl⟩ := hc + obtain ⟨m, hm⟩ := hd + have hkj : k ≠ j := by + intro h + apply hea + calc + e = P.plane.faceVertex g k := hk.symm + _ = P.plane.faceVertex g j := congrArg (P.plane.faceVertex g) h + _ = a := hj + have hlj : l ≠ j := by + intro h + apply hca + calc + c = P.plane.faceVertex g l := hl.symm + _ = P.plane.faceVertex g j := congrArg (P.plane.faceVertex g) h + _ = a := hj + have hmj : m ≠ j := by + intro h + apply hda + calc + d = P.plane.faceVertex g m := hm.symm + _ = P.plane.faceVertex g j := congrArg (P.plane.faceVertex g) h + _ = a := hj + have hlm : l ≠ m := by + intro h + apply hcd + calc + c = P.plane.faceVertex g l := hl.symm + _ = P.plane.faceVertex g m := congrArg (P.plane.faceVertex g) h + _ = d := hm + have hkj' : k.val ≠ j.val := fun h => hkj (Fin.ext h) + have hlj' : l.val ≠ j.val := fun h => hlj (Fin.ext h) + have hmj' : m.val ≠ j.val := fun h => hmj (Fin.ext h) + have hlm' : l.val ≠ m.val := fun h => hlm (Fin.ext h) + have hidx : k.val = l.val ∨ k.val = m.val := by omega + rcases hidx with h | h + · left + calc + e = P.plane.faceVertex g k := hk.symm + _ = P.plane.faceVertex g l := congrArg (P.plane.faceVertex g) (Fin.ext h) + _ = c := hl + · right + calc + e = P.plane.faceVertex g k := hk.symm + _ = P.plane.faceVertex g m := congrArg (P.plane.faceVertex g) (Fin.ext h) + _ = d := hm + +private theorem hzB : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : + ι), ∀ (r : ℝ), ∀ (p : ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + let rho : Real := ‖p - x‖ + (rho < r) → (∀ (z : ℝ × ℝ), (z ∈ Metric.sphere x rho) → (z ∈ B)) ) := by + classical + intro ι P D a r p x B rho hrho' z hzS + have hzdist : dist z x = rho := by + simpa [dist_eq_norm] using hzS + change dist z x < r + rw [hzdist] + exact hrho' + +private theorem hzRays : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (z : ℝ × ℝ), ∀ (f : P.plane.Face), (z ∈ frontier (F.region f)) → ((z ∈ B) → (∀ (c : ι), + ∀ (d : ι), (frontier (F.region f) ∩ B = B ∩ {q : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ q = + x + t • u c} ∪ B ∩ {q : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ q = x + t • u d}) → ((z ∈ B + ∩ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c}) ∨ (z ∈ B ∩ {q | ∃ t : Real, 0 ≤ t ∧ q = + x + t • u d})))) ) := by + classical + intro ι P D F a r u x B z f hzfront hzB c d hfront + have heq := congrArg (fun s : Set (Real × Real) => z ∈ s) hfront + simpa only [Set.mem_union, Set.mem_inter_iff] using heq.mp ⟨hzfront, hzB⟩ + +private theorem localSide : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + (∀ (f : P.plane.Face), ∀ (i : Fin 3), (P.plane.faceVertex f i = a) → (∃ c d, c ≠ a ∧ d ≠ + a ∧ c ≠ d ∧ P.plane.adjacent a c ∧ P.plane.adjacent a d ∧ (∃ j, P.plane.faceVertex f + j = c) ∧ (∃ j, P.plane.faceVertex f j = d) ∧ ∃ S : P3889T1TwoRaySectorDecomposition + x r (u c) (u d), F.region f ∩ B = S.left ∨ F.region f ∩ B = S.right)) → ((∀ (g : + P.plane.Face), ∀ (j : Fin 3), (P.plane.faceVertex g j = a) → (∀ (e : ι), (∃ k, + P.plane.faceVertex g k = e) → ((e ≠ a) → (∀ (c : ι), ∀ (d : ι), (c ≠ a) → ((d ≠ a) → + ((c ≠ d) → ((∃ k, P.plane.faceVertex g k = c) → ((∃ k, P.plane.faceVertex g k = d) → + (e = c ∨ e = d))))))))) → (∀ (z : ℝ × ℝ), ∀ (g : P.plane.Face), ∀ (j : Fin (3 : ℕ)), + P.plane.faceVertex g j = a → ∀ (e : ι), (∃ (k : Fin (3 : ℕ)), P.plane.faceVertex g k + = e) → e ≠ a → ∀ (t : ℝ), (0 : ℝ) < t → t < r → z = x + t • u e → ∃ δ > (0 : ℝ), + Metric.ball z δ ⊆ B ∧ ((∀ q ∈ Metric.ball z δ, (0 : ℝ) < (u e).1 * (q.2 - z.2) - (u + e).2 * (q.1 - z.1) → q ∈ F.region g) ∨ ∀ q ∈ Metric.ball z δ, (u e).1 * (q.2 - z.2) - + (u e).2 * (q.1 - z.1) < (0 : ℝ) → q ∈ F.region g))) ) := by + classical + intro ι P D F a r u x B hfaceFillsSector faceOtherMatch z g j hj e he hea t ht htr hzeq + obtain ⟨c', d', hca', hda', hcd', hac', had', hc'i, hd'i, + S', hfill'⟩ := hfaceFillsSector g j hj + have hmatch := faceOtherMatch g j hj e he hea c' d' hca' hda' hcd' hc'i hd'i + rcases hmatch with heq | heq + · obtain ⟨δ, hδ, hballB, hsides⟩ := + S'.sides (u e) (Or.inl (congrArg u heq)) t ht htr + rcases hsides with ⟨hLp, hRn⟩ | ⟨hRp, hLn⟩ + · refine ⟨δ, hδ, ?_, ?_⟩ + · simpa [hzeq] using hballB + · rcases hfill' with hfill | hfill + · left + intro q hq hsign + have hq' : q ∈ S'.left ∩ Metric.ball (x + t • u e) δ := by + rw [hLp] + exact ⟨by simpa [hzeq] using hq, by simpa [hzeq] using hsign⟩ + have hqU : q ∈ F.region g ∩ B := by rw [hfill]; exact hq'.1 + exact hqU.1 + · right + intro q hq hsign + have hq' : q ∈ S'.right ∩ Metric.ball (x + t • u e) δ := by + rw [hRn] + exact ⟨by simpa [hzeq] using hq, by simpa [hzeq] using hsign⟩ + have hqU : q ∈ F.region g ∩ B := by rw [hfill]; exact hq'.1 + exact hqU.1 + · refine ⟨δ, hδ, ?_, ?_⟩ + · simpa [hzeq] using hballB + · rcases hfill' with hfill | hfill + · right + intro q hq hsign + have hq' : q ∈ S'.left ∩ Metric.ball (x + t • u e) δ := by + rw [hLn] + exact ⟨by simpa [hzeq] using hq, by simpa [hzeq] using hsign⟩ + have hqU : q ∈ F.region g ∩ B := by rw [hfill]; exact hq'.1 + exact hqU.1 + · left + intro q hq hsign + have hq' : q ∈ S'.right ∩ Metric.ball (x + t • u e) δ := by + rw [hRp] + exact ⟨by simpa [hzeq] using hq, by simpa [hzeq] using hsign⟩ + have hqU : q ∈ F.region g ∩ B := by rw [hfill]; exact hq'.1 + exact hqU.1 + · obtain ⟨δ, hδ, hballB, hsides⟩ := + S'.sides (u e) (Or.inr (congrArg u heq)) t ht htr + rcases hsides with ⟨hLp, hRn⟩ | ⟨hRp, hLn⟩ + · refine ⟨δ, hδ, ?_, ?_⟩ + · simpa [hzeq] using hballB + · rcases hfill' with hfill | hfill + · left + intro q hq hsign + have hq' : q ∈ S'.left ∩ Metric.ball (x + t • u e) δ := by + rw [hLp] + exact ⟨by simpa [hzeq] using hq, by simpa [hzeq] using hsign⟩ + have hqU : q ∈ F.region g ∩ B := by rw [hfill]; exact hq'.1 + exact hqU.1 + · right + intro q hq hsign + have hq' : q ∈ S'.right ∩ Metric.ball (x + t • u e) δ := by + rw [hRn] + exact ⟨by simpa [hzeq] using hq, by simpa [hzeq] using hsign⟩ + have hqU : q ∈ F.region g ∩ B := by rw [hfill]; exact hq'.1 + exact hqU.1 + · refine ⟨δ, hδ, ?_, ?_⟩ + · simpa [hzeq] using hballB + · rcases hfill' with hfill | hfill + · right + intro q hq hsign + have hq' : q ∈ S'.left ∩ Metric.ball (x + t • u e) δ := by + rw [hLn] + exact ⟨by simpa [hzeq] using hq, by simpa [hzeq] using hsign⟩ + have hqU : q ∈ F.region g ∩ B := by rw [hfill]; exact hq'.1 + exact hqU.1 + · left + intro q hq hsign + have hq' : q ∈ S'.right ∩ Metric.ball (x + t • u e) δ := by + rw [hRp] + exact ⟨by simpa [hzeq] using hq, by simpa [hzeq] using hsign⟩ + have hqU : q ∈ F.region g ∩ B := by rw [hfill]; exact hq'.1 + exact hqU.1 + +private theorem hfg : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), (ι) → ( + let Nsub := {c : ι // P.plane.adjacent a c} + let first (c : Nsub) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) + let second (c : Nsub) : P.plane.Face := + Classical.choose (Classical.choose_spec + (P.plane.every_edge_two_faces a c.1 c.2)) + ∀ (f : P.plane.Face), ∀ (e : ι), ∀ (hae : P.plane.adjacent a e), + let en : Nsub := ⟨e, hae⟩ + let f0 := first en + let f1 := second en + (f0 ≠ f1) → ( + let g := if f = f0 then f1 else f0 + f ≠ g))) := by + classical + intro ι P a c Nsub first second f e hae en f0 f1 hne g + dsimp [g] + split_ifs with h + · intro hEq + exact hne (h.symm.trans hEq) + · exact h + +private theorem hgI : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), (ι) → ( + let Nsub := {c : ι // P.plane.adjacent a c} + let first (c : Nsub) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) + let second (c : Nsub) : P.plane.Face := + Classical.choose (Classical.choose_spec + (P.plane.every_edge_two_faces a c.1 c.2)) + ∀ (f : P.plane.Face), ∀ (e : ι), ∀ (hae : P.plane.adjacent a e), + let en : Nsub := ⟨e, hae⟩ + let f0 := first en + let f1 := second en + (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (f0) i = a) → ((∃ (i : Fin (3 : + ℕ)), P.plane.faceVertex (f1) i = a) → ( + let g := if f = f0 then f1 else f0 + ∃ j, P.plane.faceVertex g j = a)))) := by + classical + intro ι P a c Nsub first second f e hae en f0 f1 hf0a hf1a g + dsimp [g] + split_ifs with h + · exact hf1a + · exact hf0a + +private theorem hgE : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), (ι) → ( + let Nsub := {c : ι // P.plane.adjacent a c} + let first (c : Nsub) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) + let second (c : Nsub) : P.plane.Face := + Classical.choose (Classical.choose_spec + (P.plane.every_edge_two_faces a c.1 c.2)) + ∀ (f : P.plane.Face), ∀ (e : ι), ∀ (hae : P.plane.adjacent a e), + let en : Nsub := ⟨e, hae⟩ + let f0 := first en + let f1 := second en + (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (f0) i = e) → ((∃ (i : Fin (3 : + ℕ)), P.plane.faceVertex (f1) i = e) → ( + let g := if f = f0 then f1 else f0 + ∃ j, P.plane.faceVertex g j = e)))) := by + classical + intro ι P a c Nsub first second f e hae en f0 f1 hf0e hf1e g + dsimp [g] + split_ifs with h + · exact hf1e + · exact hf0e + +private theorem heps₁ : + (by + classical + exact + ∀ (t : ℝ), ∀ (δ₁ : ℝ), (δ₁ > (0 : ℝ)) → (∀ (δ₂ : ℝ), + let eps := min δ₁ (min δ₂ t) / 2 + eps < δ₁) ) := by + classical + intro t δ₁ hδ₁ δ₂ eps + have hmin : min δ₁ (min δ₂ t) ≤ δ₁ := min_le_left _ _ + dsimp [eps] + linarith [hδ₁] + +private theorem heps₂ : + (by + classical + exact + ∀ (t : ℝ), ∀ (δ₁ : ℝ), ∀ (δ₂ : ℝ), (δ₂ > (0 : ℝ)) → ( + let eps := min δ₁ (min δ₂ t) / 2 + eps < δ₂) ) := by + classical + intro t δ₁ δ₂ hδ₂ eps + have hmin : min δ₁ (min δ₂ t) ≤ δ₂ := le_trans (min_le_right _ _) (min_le_left _ _) + dsimp [eps] + linarith [hδ₂] + +private theorem hepst : + (by + classical + exact + ∀ (t : ℝ), ((0 : ℝ) < t) → (∀ (δ₁ : ℝ), ∀ (δ₂ : ℝ), + let eps := min δ₁ (min δ₂ t) / 2 + eps < t) ) := by + classical + intro t ht δ₁ δ₂ eps + have hmin : min δ₁ (min δ₂ t) ≤ t := le_trans (min_le_right _ _) (min_le_right _ _) + dsimp [eps] + linarith [ht] + +private theorem hball₁' : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : + ι), ∀ (r : ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (z : ℝ × ℝ), ∀ (t : ℝ), ∀ (δ₁ : ℝ), (Metric.ball z δ₁ ⊆ B) → (∀ (δ₂ : ℝ), + let eps := min δ₁ (min δ₂ t) / 2 + (eps < δ₁) → (Metric.ball z eps ⊆ B)) ) := by + classical + intro ι P D a r x B z t δ₁ hball₁ δ₂ eps heps₁ q hq + exact hball₁ (Metric.ball_subset_ball (le_of_lt heps₁) hq) + +private theorem hball₂' : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : + ι), ∀ (r : ℝ), + let x := D.position a + let B := Metric.ball x r + ∀ (z : ℝ × ℝ), ∀ (t : ℝ), ∀ (δ₁ : ℝ), ∀ (δ₂ : ℝ), (Metric.ball z δ₂ ⊆ B) → ( + let eps := min δ₁ (min δ₂ t) / 2 + (eps < δ₂) → (Metric.ball z eps ⊆ B)) ) := by + classical + intro ι P D a r x B z t δ₁ δ₂ hball₂ eps heps₂ q hq + exact hball₂ (Metric.ball_subset_ball (le_of_lt heps₂) hq) + +private theorem hzeroK : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), (∀ (c : ι), + P.plane.adjacent a c → ‖u c‖ = (1 : ℝ)) → ( + let x := D.position a + let B := Metric.ball x r + (∀ (f : P.plane.Face), ∀ (i : Fin 3), (P.plane.faceVertex f i = a) → (∃ c d, c ≠ a ∧ d ≠ + a ∧ c ≠ d ∧ P.plane.adjacent a c ∧ P.plane.adjacent a d ∧ (∃ j, P.plane.faceVertex f + j = c) ∧ (∃ j, P.plane.faceVertex f j = d) ∧ frontier (F.region f) ∩ B = (B ∩ {q | ∃ + t : Real, 0 ≤ t ∧ q = x + t • u c}) ∪ (B ∩ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u d}) + ∧ Nonempty (P3889T1TwoRaySectorDecomposition x r (u c) (u d)))) → ( + let I : Set P.plane.Face := {f | ∃ i, P.plane.faceVertex f i = a} + ∀ (c : ι), + let Nsub := {c : ι // P.plane.adjacent a c} + let first (c : Nsub) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) + let second (c : Nsub) : P.plane.Face := + Classical.choose (Classical.choose_spec + (P.plane.every_edge_two_faces a c.1 c.2)) + (∀ (g : P.plane.Face), ∀ (j : Fin 3), (P.plane.faceVertex g j = a) → (∀ (e : ι), (∃ k, + P.plane.faceVertex g k = e) → ((e ≠ a) → (∀ (c : ι), ∀ (d : ι), (c ≠ a) → ((d ≠ a) → + ((c ≠ d) → ((∃ k, P.plane.faceVertex g k = c) → ((∃ k, P.plane.faceVertex g k = d) → + (e = c ∨ e = d))))))))) → (∀ (f : P.plane.Face), + let K : Set (Real × Real) := ⋃ f ∈ I, closure (F.region f) + ∀ (z : ℝ × ℝ), ∀ (i : Fin (3 : ℕ)), (P.plane.faceVertex f i = a) → (∀ (e : ι), (∃ (k : + Fin (3 : ℕ)), P.plane.faceVertex f k = e) → ((e ≠ a) → (∀ (hae : P.plane.adjacent a + e), ∀ (t : ℝ), (z = x + t • u e) → ( + let en : Nsub := ⟨e, hae⟩ + let f0 := first en + let f1 := second en + let g := if f = f0 then f1 else f0 + (∃ j, P.plane.faceVertex g j = e) → (∀ (j : Fin (3 : ℕ)), (P.plane.faceVertex g j = a) → + (∀ (δ₁ : ℝ), ∀ (δ₂ : ℝ), + let eps := min δ₁ (min δ₂ t) / 2 + (eps < t) → ((Metric.ball z eps ⊆ B) → (∀ q ∈ Metric.ball z eps, (u e).1 * (q.2 - z.2) - + (u e).2 * (q.1 - z.1) = 0 → q ∈ K))))))))))) ) := by + classical + intro ι P D F a r u hunit x B hincidentSectorData I c Nsub first second faceOtherMatch f K z i + hi e he hea hae t hzeq en f0 f1 g hgE j hj δ₁ δ₂ eps hepst hball₁' q hq hdet + have hu : u e ≠ 0 := by + intro heq + have := hunit e hae + rw [heq, norm_zero] at this + norm_num at this + have hvec : ∃ lam : Real, q - z = lam • u e := by + by_cases hu1 : (u e).1 = 0 + · have hu2 : (u e).2 ≠ 0 := by + intro h + apply hu + ext <;> assumption + have hq1 : q.1 - z.1 = 0 := by + rw [hu1] at hdet + have hmul : (u e).2 * (q.1 - z.1) = 0 := by nlinarith [hdet] + exact (mul_eq_zero.mp hmul).resolve_left hu2 + refine ⟨(q.2 - z.2) / (u e).2, ?_⟩ + ext <;> simp [hu1, hq1] + field_simp [hu2] + · refine ⟨(q.1 - z.1) / (u e).1, ?_⟩ + ext + · simp + field_simp [hu1] + · simp + field_simp [hu1] + nlinarith [hdet] + obtain ⟨lam, hvec_eq⟩ := hvec + have hLamNorm : ‖q - z‖ = |lam| := by + rw [hvec_eq, norm_smul, hunit e hae, Real.norm_eq_abs] + ring + have hLamLt : |lam| < t := by + have hdist : dist q z < eps := by + simpa [Metric.mem_ball] using hq + rw [dist_eq_norm] at hdist + rw [hLamNorm] at hdist + exact hdist.trans hepst + let s := t + lam + have hs : 0 < s := by + dsimp [s] + have := (abs_lt.mp hLamLt).1 + linarith + have hqeq : q = x + s • u e := by + calc + q = z + (q - z) := by abel + _ = (x + t • u e) + lam • u e := by rw [hvec_eq, hzeq] + _ = x + s • u e := by dsimp [s]; module + obtain ⟨cf, df, hcf, hdf, hcdf, hacf, hadf, hcfi, hdfi, hfrontF⟩ := + hincidentSectorData f i hi + have hfrontF := hfrontF.1 + have hmatchF := faceOtherMatch f i hi e he hea cf df hcf hdf hcdf hcfi hdfi + have hqBF : q ∈ B := hball₁' hq + have hqrayF : (q ∈ B ∩ {q | ∃ s : Real, 0 ≤ s ∧ q = x + s • u cf}) ∨ + (q ∈ B ∩ {q | ∃ s : Real, 0 ≤ s ∧ q = x + s • u df}) := by + rcases hmatchF with hce | hde + · left + refine ⟨hqBF, s, le_of_lt hs, ?_⟩ + simpa [hce] using hqeq + · right + refine ⟨hqBF, s, le_of_lt hs, ?_⟩ + simpa [hde] using hqeq + have hqfrontF : q ∈ frontier (F.region f) := by + have heq := congrArg (fun S : Set (Real × Real) => q ∈ S) hfrontF + have hmem : q ∈ frontier (F.region f) ∩ B := by + apply heq.mpr + simpa only [Set.mem_union, Set.mem_inter_iff] using hqrayF + exact hmem.1 + obtain ⟨cg, dg, hcg, hdg, hcdg, hacg, hadg, hcgi, hdgi, hfrontG⟩ := + hincidentSectorData g j hj + have hfrontG := hfrontG.1 + have hmatchG := faceOtherMatch g j hj e hgE hea cg dg hcg hdg hcdg hcgi hdgi + have hqrayG : (q ∈ B ∩ {q | ∃ s : Real, 0 ≤ s ∧ q = x + s • u cg}) ∨ + (q ∈ B ∩ {q | ∃ s : Real, 0 ≤ s ∧ q = x + s • u dg}) := by + rcases hmatchG with hce | hde + · left + refine ⟨hqBF, s, le_of_lt hs, ?_⟩ + simpa [hce] using hqeq + · right + refine ⟨hqBF, s, le_of_lt hs, ?_⟩ + simpa [hde] using hqeq + have hqfrontG : q ∈ frontier (F.region g) := by + have heq := congrArg (fun S : Set (Real × Real) => q ∈ S) hfrontG + have hmem : q ∈ frontier (F.region g) ∩ B := by + apply heq.mpr + simpa only [Set.mem_union, Set.mem_inter_iff] using hqrayG + exact hmem.1 + exact Set.mem_iUnion₂.mpr ⟨f, ⟨i, hi⟩, frontier_subset_closure hqfrontF⟩ + +private theorem memK : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), + let I : Set P.plane.Face := {f | ∃ i, P.plane.faceVertex f i = a} + (P.plane.Face) → ( + let K : Set (Real × Real) := ⋃ f ∈ I, closure (F.region f) + ∀ (g : P.plane.Face), ∀ (j : Fin (3 : ℕ)), P.plane.faceVertex g j = a → ∀ q ∈ F.region g, + q ∈ K)) := by + classical + intro ι P D F a I f K g j hj q hq + exact Set.mem_iUnion₂.mpr ⟨g, ⟨j, hj⟩, subset_closure hq⟩ + +private theorem build : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (u : ι → ℝ × ℝ), + let I : Set P.plane.Face := {f | ∃ i, P.plane.faceVertex f i = a} + ∀ (c : ι), + let Nsub := {c : ι // P.plane.adjacent a c} + let first (c : Nsub) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) + let second (c : Nsub) : P.plane.Face := + Classical.choose (Classical.choose_spec + (P.plane.every_edge_two_faces a c.1 c.2)) + ∀ (f : P.plane.Face), + let K : Set (Real × Real) := ⋃ f ∈ I, closure (F.region f) + ∀ (z : ℝ × ℝ), ∀ (i : Fin (3 : ℕ)), (P.plane.faceVertex f i = a) → (∀ (e : ι), ∀ (hae : + P.plane.adjacent a e), ∀ (t : ℝ), + let en : Nsub := ⟨e, hae⟩ + let f0 := first en + let f1 := second en + let g := if f = f0 then f1 else f0 + ∀ (j : Fin (3 : ℕ)), (P.plane.faceVertex g j = a) → (∀ (δ₁ : ℝ), ∀ (δ₂ : ℝ), + let eps := min δ₁ (min δ₂ t) / 2 + (∀ q ∈ Metric.ball z eps, (u e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) = 0 → q ∈ K) → + ((∀ (g : P.plane.Face), ∀ (j : Fin 3), (P.plane.faceVertex g j = a) → (∀ (q : Real × + Real), (q ∈ F.region g) → (q ∈ K))) → ((∀ q ∈ Metric.ball z eps, (0 : ℝ) < (u e).1 * + (q.2 - z.2) - (u e).2 * (q.1 - z.1) → q ∈ F.region f) → (∀ q ∈ Metric.ball z eps, (u + e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) < (0 : ℝ) → q ∈ F.region g) → Metric.ball + z eps ⊆ K)))) ) := by + classical + intro ι P D F a u I c Nsub first second f K z i hi e hae t en f0 f1 g j hj δ₁ δ₂ eps hzeroK + memK hpos hneg q hq + by_cases hqpos : 0 < (u e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) + · exact memK f i hi q (hpos q hq hqpos) + · by_cases hqneg : (u e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) < 0 + · exact memK g j hj q (hneg q hq hqneg) + · have hqzero : (u e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) = 0 := by + linarith + exact hzeroK q hq hqzero + +private theorem huAt878 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (u : ι → ℝ × ℝ), (∀ (c : ι), + P.plane.adjacent a c → ‖u c‖ = (1 : ℝ)) → (∀ (e : ι), (P.plane.adjacent a e) → (u e ≠ + 0)) ) := by + classical + intro ι P a u hunit e hae heq + have h := hunit e hae + rw [heq, norm_zero] at h + norm_num at h + +private theorem hsumAt883 : + (by + classical + exact + ∀ (ι : Type), ∀ (u : ι → ℝ × ℝ), ∀ (e : ι), (u e ≠ 0) → (0 < (u e).1 ^ 2 + (u e).2 ^ 2) ) + := by + classical + intro ι u e hu + have hne : (u e).1 ^ 2 + (u e).2 ^ 2 ≠ 0 := by + intro hs + have h1 : (u e).1 = 0 := by nlinarith [sq_nonneg (u e).1, sq_nonneg (u e).2] + have h2 : (u e).2 = 0 := by nlinarith [sq_nonneg (u e).1, sq_nonneg (u e).2] + exact hu (by ext <;> assumption) + have hnonneg : 0 ≤ (u e).1 ^ 2 + (u e).2 ^ 2 := + add_nonneg (sq_nonneg _) (sq_nonneg _) + exact lt_of_le_of_ne hnonneg (Ne.symm hne) + +private theorem hqplus1 : + (by + classical + exact + ∀ (ι : Type), ∀ (u : ι → ℝ × ℝ), ∀ (z : ℝ × ℝ), ∀ (e : ι), ∀ (t : ℝ), ∀ (δ₁ : ℝ), ∀ (δ₂ : + ℝ), + let eps := min δ₁ (min δ₂ t) / 2 + (0 < eps) → ((eps < δ₁) → ( + let v : Real × Real := (-(u e).2, (u e).1) + (‖v‖ = 1) → ( + let qplus := z + eps • v + qplus ∈ Metric.ball z δ₁))) ) := by + classical + intro ι u z e t δ₁ δ₂ eps heps heps₁ v hvnorm qplus + have hdist : dist qplus z = eps := by + dsimp [qplus] + rw [dist_eq_norm] + simp [norm_smul, Real.norm_eq_abs, abs_of_pos heps, hvnorm] + change dist qplus z < δ₁ + rw [hdist] + exact heps₁ + +private theorem hqplus2 : + (by + classical + exact + ∀ (ι : Type), ∀ (u : ι → ℝ × ℝ), ∀ (z : ℝ × ℝ), ∀ (e : ι), ∀ (t : ℝ), ∀ (δ₁ : ℝ), ∀ (δ₂ : + ℝ), + let eps := min δ₁ (min δ₂ t) / 2 + (0 < eps) → ((eps < δ₂) → ( + let v : Real × Real := (-(u e).2, (u e).1) + (‖v‖ = 1) → ( + let qplus := z + eps • v + qplus ∈ Metric.ball z δ₂))) ) := by + classical + intro ι u z e t δ₁ δ₂ eps heps heps₂ v hvnorm qplus + have hdist : dist qplus z = eps := by + dsimp [qplus] + rw [dist_eq_norm] + simp [norm_smul, Real.norm_eq_abs, abs_of_pos heps, hvnorm] + change dist qplus z < δ₂ + rw [hdist] + exact heps₂ + +private theorem hdetplus : + (by + classical + exact + ∀ (ι : Type), ∀ (u : ι → ℝ × ℝ), ∀ (z : ℝ × ℝ), ∀ (e : ι), ∀ (t : ℝ), ∀ (δ₁ : ℝ), ∀ (δ₂ : + ℝ), + let eps := min δ₁ (min δ₂ t) / 2 + (0 < eps) → ( + let v : Real × Real := (-(u e).2, (u e).1) + (0 < (u e).1 ^ 2 + (u e).2 ^ 2) → ( + let qplus := z + eps • v + 0 < (u e).1 * (qplus.2 - z.2) - (u e).2 * (qplus.1 - z.1))) ) := by + classical + intro ι u z e t δ₁ δ₂ eps heps v hsum qplus + have heq : (u e).1 * (qplus.2 - z.2) - (u e).2 * (qplus.1 - z.1) = + eps * ((u e).1 ^ 2 + (u e).2 ^ 2) := by + simp [qplus, v] + ring + rw [heq] + exact mul_pos heps hsum + +private theorem huAt935 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (u : ι → ℝ × ℝ), (∀ (c : ι), + P.plane.adjacent a c → ‖u c‖ = (1 : ℝ)) → (∀ (e : ι), (P.plane.adjacent a e) → (u e ≠ + 0)) ) := by + classical + intro ι P a u hunit e hae heq + have h := hunit e hae + rw [heq, norm_zero] at h + norm_num at h + +private theorem hsumAt940 : + (by + classical + exact + ∀ (ι : Type), ∀ (u : ι → ℝ × ℝ), ∀ (e : ι), (u e ≠ 0) → (0 < (u e).1 ^ 2 + (u e).2 ^ 2) ) + := by + classical + intro ι u e hu + have hne : (u e).1 ^ 2 + (u e).2 ^ 2 ≠ 0 := by + intro hs + have h1 : (u e).1 = 0 := by nlinarith [sq_nonneg (u e).1, sq_nonneg (u e).2] + have h2 : (u e).2 = 0 := by nlinarith [sq_nonneg (u e).1, sq_nonneg (u e).2] + exact hu (by ext <;> assumption) + have hnonneg : 0 ≤ (u e).1 ^ 2 + (u e).2 ^ 2 := + add_nonneg (sq_nonneg _) (sq_nonneg _) + exact lt_of_le_of_ne hnonneg (Ne.symm hne) + +private theorem hqminus1 : + (by + classical + exact + ∀ (ι : Type), ∀ (u : ι → ℝ × ℝ), ∀ (z : ℝ × ℝ), ∀ (e : ι), ∀ (t : ℝ), ∀ (δ₁ : ℝ), ∀ (δ₂ : + ℝ), + let eps := min δ₁ (min δ₂ t) / 2 + (0 < eps) → ((eps < δ₁) → ( + let v : Real × Real := (-(u e).2, (u e).1) + (‖v‖ = 1) → ( + let qminus := z + eps • (-v) + qminus ∈ Metric.ball z δ₁))) ) := by + classical + intro ι u z e t δ₁ δ₂ eps heps heps₁ v hvnorm qminus + have hdist : dist qminus z = eps := by + dsimp [qminus] + rw [dist_eq_norm] + simp [norm_smul, Real.norm_eq_abs, abs_of_pos heps, hvnorm] + change dist qminus z < δ₁ + rw [hdist] + exact heps₁ + +private theorem hqminus2 : + (by + classical + exact + ∀ (ι : Type), ∀ (u : ι → ℝ × ℝ), ∀ (z : ℝ × ℝ), ∀ (e : ι), ∀ (t : ℝ), ∀ (δ₁ : ℝ), ∀ (δ₂ : + ℝ), + let eps := min δ₁ (min δ₂ t) / 2 + (0 < eps) → ((eps < δ₂) → ( + let v : Real × Real := (-(u e).2, (u e).1) + (‖v‖ = 1) → ( + let qminus := z + eps • (-v) + qminus ∈ Metric.ball z δ₂))) ) := by + classical + intro ι u z e t δ₁ δ₂ eps heps heps₂ v hvnorm qminus + have hdist : dist qminus z = eps := by + dsimp [qminus] + rw [dist_eq_norm] + simp [norm_smul, Real.norm_eq_abs, abs_of_pos heps, hvnorm] + change dist qminus z < δ₂ + rw [hdist] + exact heps₂ + +private theorem hdetminus : + (by + classical + exact + ∀ (ι : Type), ∀ (u : ι → ℝ × ℝ), ∀ (z : ℝ × ℝ), ∀ (e : ι), ∀ (t : ℝ), ∀ (δ₁ : ℝ), ∀ (δ₂ : + ℝ), + let eps := min δ₁ (min δ₂ t) / 2 + (0 < eps) → ( + let v : Real × Real := (-(u e).2, (u e).1) + (0 < (u e).1 ^ 2 + (u e).2 ^ 2) → ( + let qminus := z + eps • (-v) + (u e).1 * (qminus.2 - z.2) - (u e).2 * (qminus.1 - z.1) < 0)) ) := by + classical + intro ι u z e t δ₁ δ₂ eps heps v hsum qminus + have heq : (u e).1 * (qminus.2 - z.2) - (u e).2 * (qminus.1 - z.1) = + -eps * ((u e).1 ^ 2 + (u e).2 ^ 2) := by + simp [qminus, v] + ring + rw [heq] + nlinarith [heps, hsum] + +private theorem hnormAt978 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (u : ι → ℝ × ℝ), (∀ (c : ι), + P.plane.adjacent a c → ‖u c‖ = (1 : ℝ)) → (∀ (c : ι), (P.plane.adjacent a c) → (∀ (t + : ℝ), ((0 : ℝ) ≤ t) → (‖t • u c‖ = t))) ) := by + classical + intro ι P a u hunit c hac t ht0 + rw [norm_smul, hunit c hac, Real.norm_eq_abs, abs_of_nonneg ht0] + ring + +private theorem hdistAt981 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : + ι), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + ∀ (z : ℝ × ℝ), ∀ (c : ι), ∀ (t : ℝ), (z = x + t • u c) → ((‖t • u c‖ = t) → (dist z x = + t)) ) := by + classical + intro ι P D a u x z c t hzeq hnorm + have : dist x z = t := by + rw [dist_eq_norm, hzeq] + have hsub : x - (x + t • u c) = -(t • u c) := by abel + rw [hsub, norm_neg, hnorm] + simpa [dist_comm] using this + +private theorem ht'At987 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : + ι), ∀ (p : ℝ × ℝ), + let x := D.position a + let rho : Real := ‖p - x‖ + ∀ (z : ℝ × ℝ), (z ∈ Metric.sphere x rho) → (∀ (t : ℝ), (dist z x = t) → (t = rho)) ) := by + classical + intro ι P D a p x rho z hzS t hdist + calc t = dist z x := hdist.symm + _ = rho := by simpa [Metric.mem_sphere, dist_eq_norm] using hzS + +private theorem hnormAt994 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (u : ι → ℝ × ℝ), (∀ (c : ι), + P.plane.adjacent a c → ‖u c‖ = (1 : ℝ)) → (∀ (d : ι), (P.plane.adjacent a d) → (∀ (t + : ℝ), ((0 : ℝ) ≤ t) → (‖t • u d‖ = t))) ) := by + classical + intro ι P a u hunit d had t ht0 + rw [norm_smul, hunit d had, Real.norm_eq_abs, abs_of_nonneg ht0] + ring + +private theorem hdistAt997 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : + ι), ∀ (u : ι → ℝ × ℝ), + let x := D.position a + ∀ (z : ℝ × ℝ), ∀ (d : ι), ∀ (t : ℝ), (z = x + t • u d) → ((‖t • u d‖ = t) → (dist z x = + t)) ) := by + classical + intro ι P D a u x z d t hzeq hnorm + have : dist x z = t := by + rw [dist_eq_norm, hzeq] + have hsub : x - (x + t • u d) = -(t • u d) := by abel + rw [hsub, norm_neg, hnorm] + simpa [dist_comm] using this + +private theorem ht'At1003 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : + ι), ∀ (p : ℝ × ℝ), + let x := D.position a + let rho : Real := ‖p - x‖ + ∀ (z : ℝ × ℝ), (z ∈ Metric.sphere x rho) → (∀ (t : ℝ), (dist z x = t) → (t = rho)) ) := by + classical + intro ι P D a p x rho z hzS t hdist + calc t = dist z x := hdist.symm + _ = rho := by simpa [Metric.mem_sphere, dist_eq_norm] using hzS + +private theorem hSphereConnected : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : + ι), ∀ (p : ℝ × ℝ), + let x := D.position a + let rho : Real := ‖p - x‖ + (0 < rho) → (IsConnected (Metric.sphere x rho)) ) := by + classical + intro ι P D a p x rho hrho + have hrank : 1 < Module.rank Real (Real × Real) := by + rw [rank_prod'] + norm_num [Module.rank_self] + exact isConnected_sphere hrank x (le_of_lt hrho) + +private theorem hAopen : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (p : ℝ × ℝ), + let x := D.position a + let rho : Real := ‖p - x‖ + let I : Set P.plane.Face := {f | ∃ i, P.plane.faceVertex f i = a} + let K : Set (Real × Real) := ⋃ f ∈ I, closure (F.region f) + (∀ (z : Real × Real), (z ∈ Metric.sphere x rho) → ((z ∈ K) → (∃ δ > 0, Metric.ball z δ ⊆ + K))) → (IsOpen ((Subtype.val : Metric.sphere x rho → Real × Real) ⁻¹' K)) ) := by + classical + intro ι P D F a p x rho I K hKlocal + apply Metric.isOpen_iff.mpr + intro z hz + obtain ⟨δ, hδ, hball⟩ := hKlocal z z.property hz + refine ⟨δ, hδ, ?_⟩ + intro w hw + change (w : Real × Real) ∈ K + apply hball + simpa [Subtype.dist_eq, Metric.mem_ball] using hw + +private theorem hAnonempty : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), (∀ (c : ι), + P.plane.adjacent a c → ‖u c‖ = (1 : ℝ)) → (∀ (p : ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + (∀ (f : P.plane.Face), ∀ (i : Fin 3), (P.plane.faceVertex f i = a) → (∃ c d, c ≠ a ∧ d ≠ + a ∧ c ≠ d ∧ P.plane.adjacent a c ∧ P.plane.adjacent a d ∧ (∃ j, P.plane.faceVertex f + j = c) ∧ (∃ j, P.plane.faceVertex f j = d) ∧ frontier (F.region f) ∩ B = (B ∩ {q | ∃ + t : Real, 0 ≤ t ∧ q = x + t • u c}) ∪ (B ∩ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u d}) + ∧ Nonempty (P3889T1TwoRaySectorDecomposition x r (u c) (u d)))) → ( + let rho : Real := ‖p - x‖ + (0 < rho) → ((rho < r) → ( + let I : Set P.plane.Face := {f | ∃ i, P.plane.faceVertex f i = a} + let K : Set (Real × Real) := ⋃ f ∈ I, closure (F.region f) + ((Subtype.val : Metric.sphere x rho → Real × Real) ⁻¹' K).Nonempty)))) ) := by + classical + intro ι P D F a r u hunit p x B hincidentSectorData rho hrho hrho' I K + let Nsub := {c : ι // P.plane.adjacent a c} + let first (c : Nsub) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) + let : Nontrivial ι := (P3776T1FixedGeometry P.toPeriodicTileCore).1 + obtain ⟨c, hac⟩ := (P3767T1VertexEdgeIncidence P.plane a).1 + let c' : Nsub := ⟨c, hac⟩ + let f := first c' + have hspec := Classical.choose_spec (Classical.choose_spec + (P.plane.every_edge_two_faces a c hac)) + obtain ⟨_, ⟨hfa, hfc⟩, _, _⟩ := hspec + obtain ⟨i, hi⟩ := hfa + obtain ⟨d, _, _, _, _, had, _, _, _, hfront, _⟩ := hincidentSectorData f i hi + let q := x + rho • u d + have hqB : q ∈ B := by + have hnorm : ‖rho • u d‖ = rho := by + rw [norm_smul, hunit d had, Real.norm_eq_abs, abs_of_pos hrho] + ring + have hdist : dist x q = rho := by + simp [q, dist_eq_norm, hnorm] + change dist q x < r + rw [dist_comm, hdist] + exact hrho' + have hqSphere : q ∈ Metric.sphere x rho := by + have hnorm : ‖rho • u d‖ = rho := by + rw [norm_smul, hunit d had, Real.norm_eq_abs, abs_of_pos hrho] + ring + simp [q, hnorm] + have hqfront : q ∈ frontier (F.region f) := by + have hqray : q ∈ B ∩ {y | ∃ t : Real, 0 ≤ t ∧ y = x + t • u d} := by + refine ⟨hqB, rho, le_of_lt hrho, ?_⟩ + rfl + have hq' : q ∈ frontier (F.region f) ∩ B := by + rw [hfront] + exact Or.inl hqray + exact hq'.1 + have hqK : q ∈ K := by + exact Set.mem_iUnion₂.mpr ⟨f, ⟨i, hi⟩, frontier_subset_closure hqfront⟩ + exact ⟨⟨q, hqSphere⟩, hqK⟩ + +private theorem hAall : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (p : ℝ × ℝ), + let x := D.position a + let rho : Real := ‖p - x‖ + let I : Set P.plane.Face := {f | ∃ i, P.plane.faceVertex f i = a} + let K : Set (Real × Real) := ⋃ f ∈ I, closure (F.region f) + (IsConnected (Metric.sphere x rho)) → ((IsOpen ((Subtype.val : Metric.sphere x rho → Real + × Real) ⁻¹' K)) → (∀ [IsClosed ((Subtype.val : Metric.sphere x rho → Real + × Real) ⁻¹' K)], (((Subtype.val : Metric.sphere x rho → Real × Real) ⁻¹' K).Nonempty) + → ((Subtype.val : Metric.sphere x rho → Real × Real) ⁻¹' K = Set.univ))) ) := by + classical + intro ι P D F a p x rho I K hSphereConnected hAopen hAclosed hAnonempty + have hconn : ConnectedSpace (Metric.sphere x rho) := Subtype.connectedSpace hSphereConnected + obtain hempty | hall := (connectedSpace_iff_clopen.mp hconn).2 _ ⟨hAclosed, hAopen⟩ + · exact (hAnonempty.ne_empty hempty).elim + · exact hall + +private theorem hpK : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (p : ℝ × ℝ), + let x := D.position a + let rho : Real := ‖p - x‖ + (p ∈ Metric.sphere x rho) → ( + let I : Set P.plane.Face := {f | ∃ i, P.plane.faceVertex f i = a} + let K : Set (Real × Real) := ⋃ f ∈ I, closure (F.region f) + ((Subtype.val : Metric.sphere x rho → Real × Real) ⁻¹' K = Set.univ) → (p ∈ K)) ) := by + classical + intro ι P D F a p x rho hpSphere I K hAall + have : (⟨p, hpSphere⟩ : Metric.sphere x rho) ∈ + (Subtype.val : Metric.sphere x rho → Real × Real) ⁻¹' K := by + rw [hAall] + trivial + exact this + +private theorem hpRegion : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (p : ℝ × ℝ), + let T := Set.range D.position ∪ + {q | ∃ c d, P.plane.adjacent c d ∧ q ∈ D.edgeArc c d} + (∀ (f : P.plane.Face), frontier (F.region f) ⊆ T) → ((p ∉ T) → (∀ (f : P.plane.Face), (p + ∈ closure (F.region f)) → (p ∈ F.region f))) ) := by + classical + intro ι P D F p T hfrontTrace hpNotT f hpc + rw [closure_eq_self_union_frontier] at hpc + rcases hpc with hpr | hpf + · exact hpr + · have hpTrace : p ∈ T := hfrontTrace f hpf + exact (hpNotT hpTrace).elim + +end FaceGapProof + +namespace FaceGapSectorGeometry + +private theorem hfaceFillsSector : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ((0 : ℝ) < r) → (∀ (u : ι → ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + (∀ (f : P.plane.Face), ∀ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = a → ∃ (c : ι) (d : + ι), c ≠ a ∧ d ≠ a ∧ c ≠ d ∧ P.plane.adjacent a c ∧ P.plane.adjacent a d ∧ (∃ (j : Fin + (3 : ℕ)), P.plane.faceVertex f j = c) ∧ (∃ (j : Fin (3 : ℕ)), P.plane.faceVertex f j + = d) ∧ frontier (F.region f) ∩ Metric.ball (D.position a) r = Metric.ball (D.position + a) r ∩ {q : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ q = D.position a + t • u c} ∪ + Metric.ball (D.position a) r ∩ {q : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ q = D.position a + + t • u d} ∧ Nonempty (P3889T1TwoRaySectorDecomposition (D.position a) r (u c) (u + d))) → (∀ (f : P.plane.Face), ∀ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = a → ∃ (c + : ι) (d : ι), c ≠ a ∧ d ≠ a ∧ c ≠ d ∧ P.plane.adjacent a c ∧ P.plane.adjacent a d ∧ + (∃ (j : Fin (3 : ℕ)), P.plane.faceVertex f j = c) ∧ (∃ (j : Fin (3 : ℕ)), + P.plane.faceVertex f j = d) ∧ ∃ (S : P3889T1TwoRaySectorDecomposition x r (u c) (u + d)), F.region f ∩ B = S.left ∨ F.region f ∩ B = S.right)) ) := by + classical + intro ι P D F a r hr u x B hincidentSectorData f i hi + obtain ⟨c, d, hca, hda, hcd, hac, had, hci, hdi, hfront, ⟨S⟩⟩ := + hincidentSectorData f i hi + let U := F.region f + let V := (closure U)ᶜ + have hxB : x ∈ B := by simp [B, Metric.mem_ball_self hr] + have hxfront := FaceGapProof.hxfront ι P D F a r u f c d hfront (FaceGapProof.hxray ι P D a r + u c hxB) + have rayFront (q : Real × Real) (hqB : q ∈ B) + (hqRay : q ∈ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ + {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u d}) := FaceGapProof.rayFront ι + P D F a r u f c d hfront q hqB hqRay + have hLsub := FaceGapProof.hLsub ι P D a r u c d S + have hRsub := FaceGapProof.hRsub ι P D a r u c d S + have hLavoid := FaceGapProof.hLavoid ι P D F a r u f c d + hfront S hLsub + have hRavoid := FaceGapProof.hRavoid ι P D F a r u f c d + hfront S hRsub + have hUopen : IsOpen U := F.region_open f + have hUV := FaceGapProof.hUV ι P D F f + have hfill := FaceGapProof.hfill ι P D F a r u f c d S (FaceGapProof.hLchoice ι P D F a r u f + c d S hLavoid (FaceGapProof.hLavoidV ι P D F a r u f c d S hLavoid) hUopen + (FaceGapProof.hLpart ι P D F a r u f c d S hLavoid hUopen)) (FaceGapProof.hRchoice ι P D + F a r u f c d S hRavoid (FaceGapProof.hRavoidV ι P D F a r u f c d S hRavoid) hUopen + (FaceGapProof.hRpart ι P D F a r u f c d S hRavoid hUopen)) + (FaceGapProof.hnotUU ι P D F a r u f c d S rayFront (FaceGapProof.hmeetV ι P D F a r + hr f (FaceGapProof.hxfrontV ι P D F a f hxfront))) (FaceGapProof.hnotVV ι P D F a + r u f c d S rayFront (FaceGapProof.hmeetU ι P D F a r hr f hxfront) hUopen hUV) + refine ⟨c, d, hca, hda, hcd, hac, had, hci, hdi, S, ?_⟩ + rcases hfill with ⟨hL, hR⟩ | ⟨hR, hL⟩ + · left + ext q + constructor + · intro hq + have hqNotRay := FaceGapProof.hqNotRayAt457 ι P D F a r + u f c d rayFront hUopen q hq + have hqsec := FaceGapProof.hqsecAt467 ι P D F a r u f c d S q hq + hqNotRay + rcases hqsec with hqL | hqR + · exact hqL + · exact ((Set.disjoint_left.mp hUV) hq.1 (hR hqR)).elim + · intro hq + exact ⟨hL hq, (hLsub hq).1⟩ + · right + ext q + constructor + · intro hq + have hqNotRay := FaceGapProof.hqNotRayAt479 ι P D F a r + u f c d rayFront hUopen q hq + have hqsec := FaceGapProof.hqsecAt489 ι P D F a r u f c d S q hq + hqNotRay + rcases hqsec with hqL | hqR + · exact ((Set.disjoint_left.mp hUV) hq.1 (hL hqL)).elim + · exact hqR + · intro hq + exact ⟨hR hq, (hRsub hq).1⟩ + +private theorem hKlocal : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), (Pairwise fun (f g : P.plane.Face) => Disjoint (F.region + f) (F.region g)) → (∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), (∀ (c : ι), + P.plane.adjacent a c → ‖u c‖ = (1 : ℝ)) → (∀ (p : ℝ × ℝ), + let x := D.position a + let B := Metric.ball x r + (∀ (f : P.plane.Face), ∀ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = a → ∃ (c : ι) (d : + ι), c ≠ a ∧ d ≠ a ∧ c ≠ d ∧ P.plane.adjacent a c ∧ P.plane.adjacent a d ∧ (∃ (j : Fin + (3 : ℕ)), P.plane.faceVertex f j = c) ∧ (∃ (j : Fin (3 : ℕ)), P.plane.faceVertex f j + = d) ∧ frontier (F.region f) ∩ Metric.ball (D.position a) r = Metric.ball (D.position + a) r ∩ {q : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ q = D.position a + t • u c} ∪ + Metric.ball (D.position a) r ∩ {q : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ q = D.position a + + t • u d} ∧ Nonempty (P3889T1TwoRaySectorDecomposition (D.position a) r (u c) (u + d))) → ((∀ (f : P.plane.Face), ∀ (i : Fin 3), (P.plane.faceVertex f i = a) → (∃ c d, + c ≠ a ∧ d ≠ a ∧ c ≠ d ∧ P.plane.adjacent a c ∧ P.plane.adjacent a d ∧ (∃ j, + P.plane.faceVertex f j = c) ∧ (∃ j, P.plane.faceVertex f j = d) ∧ ∃ S : + P3889T1TwoRaySectorDecomposition x r (u c) (u d), F.region f ∩ B = S.left ∨ + F.region f ∩ B = S.right)) → ( + let rho : Real := ‖p - x‖ + ( + let rho := ‖p - D.position a‖; (0 : ℝ) < rho) → (( + let rho := ‖p - D.position a‖; rho < r) → ( + let I : Set P.plane.Face := {f | ∃ i, P.plane.faceVertex f i = a} + (∀ (g : P.plane.Face), ∀ (j : Fin (3 : ℕ)), P.plane.faceVertex g j = a → ∀ (e : ι), (∃ (k + : Fin (3 : ℕ)), P.plane.faceVertex g k = e) → e ≠ a → ∀ (c : ι), ∀ (d : ι), c ≠ a → d + ≠ a → c ≠ d → (∃ (k : Fin (3 : ℕ)), P.plane.faceVertex g k = c) → (∃ (k : Fin (3 : + ℕ)), P.plane.faceVertex g k = d) → e = c ∨ e = d) → ( + let K : Set (Real × Real) := ⋃ f ∈ I, closure (F.region f) + ∀ z ∈ Metric.sphere x rho, z ∈ K → ∃ δ > (0 : ℝ), Metric.ball z δ ⊆ K))))))) ) := by + classical + intro ι P D F hd a r u hunit p x B hincidentSectorData hfaceFillsSector rho hrho hrho' I + faceOtherMatch K z hzS hzK + let Nsub := {c : ι // P.plane.adjacent a c} + let first (c : Nsub) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) + let second (c : Nsub) : P.plane.Face := + Classical.choose (Classical.choose_spec + (P.plane.every_edge_two_faces a c.1 c.2)) + obtain ⟨f, hfI, hzcl⟩ := Set.mem_iUnion₂.mp hzK + obtain ⟨i, hi⟩ := hfI + rw [closure_eq_self_union_frontier] at hzcl + rcases hzcl with hzreg | hzfront + · obtain ⟨δ, hδ, hball⟩ := Metric.isOpen_iff.mp (F.region_open f) z hzreg + refine ⟨δ, hδ, ?_⟩ + intro q hq + exact Set.mem_iUnion₂.mpr ⟨f, ⟨i, hi⟩, subset_closure (hball hq)⟩ + · have hzB : z ∈ B := FaceGapProof.hzB ι P D a r p hrho' z hzS + obtain ⟨c, d, hca, hda, hcd, hac, had, hci, hdi, hfront, _⟩ := + hincidentSectorData f i hi + have hzRays := FaceGapProof.hzRays ι P D F a r + u z f hzfront hzB c d hfront + have localSide (g : P.plane.Face) (j : Fin 3) + (hj : P.plane.faceVertex g j = a) (e : ι) + (he : ∃ k, P.plane.faceVertex g k = e) (hea : e ≠ a) + (t : Real) (ht : 0 < t) (htr : t < r) + (hzeq : z = x + t • u e) := FaceGapProof.localSide ι P D F a r u hfaceFillsSector + faceOtherMatch z g j hj e he hea t ht htr hzeq + have finishRay (e : ι) (he : ∃ k, P.plane.faceVertex f k = e) + (hea : e ≠ a) (hae : P.plane.adjacent a e) + (t : Real) (ht : 0 < t) (htr : t < r) + (hzeq : z = x + t • u e) : + ∃ δ > 0, Metric.ball z δ ⊆ K := by + let en : Nsub := ⟨e, hae⟩ + let f0 := first en + let f1 := second en + obtain ⟨hne, hf0, hf1, hexhaust⟩ := (Classical.choose_spec (Classical.choose_spec + (P.plane.every_edge_two_faces a e hae))) + obtain ⟨hf0a, hf0e⟩ := hf0 + obtain ⟨hf1a, hf1e⟩ := hf1 + have hcase := hexhaust f ⟨⟨i, hi⟩, he⟩ + let g := if f = f0 then f1 else f0 + have hfg := FaceGapProof.hfg ι P a c f e hae hne + have hgE := FaceGapProof.hgE ι P a c f e hae hf0e hf1e + obtain ⟨j, hj⟩ := (FaceGapProof.hgI ι P a c f e hae hf0a hf1a) + obtain ⟨δ₁, hδ₁, hball₁, hside₁⟩ := + localSide f i hi e he hea t ht htr hzeq + obtain ⟨δ₂, hδ₂, hball₂, hside₂⟩ := + localSide g j hj e hgE hea t ht htr hzeq + let eps := min δ₁ (min δ₂ t) / 2 + have heps : 0 < eps := by dsimp [eps]; positivity + have heps₁ := FaceGapProof.heps₁ t δ₁ hδ₁ δ₂ + have heps₂ := FaceGapProof.heps₂ t δ₁ δ₂ hδ₂ + have hball₂' := FaceGapProof.hball₂' ι P D a r z t δ₁ δ₂ hball₂ + heps₂ + have hzeroK := FaceGapProof.hzeroK ι P + D F a r u hunit hincidentSectorData c faceOtherMatch f z i hi e he hea hae t hzeq + hgE j hj δ₁ δ₂ (FaceGapProof.hepst t ht δ₁ δ₂) (FaceGapProof.hball₁' ι P D a r z + t δ₁ hball₁ δ₂ heps₁) + have memK (g : P.plane.Face) (j : Fin 3) + (hj : P.plane.faceVertex g j = a) (q : Real × Real) + (hq : q ∈ F.region g) := FaceGapProof.memK ι P D F a f g j hj q hq + rcases hside₁ with hpos₁ | hneg₁ <;> rcases hside₂ with hpos₂ | hneg₂ + · exfalso + let v : Real × Real := (-(u e).2, (u e).1) + have hvnorm : ‖v‖ = 1 := by + simpa [v, Prod.norm_def, Real.norm_eq_abs, max_comm] using hunit e hae + have hu := FaceGapProof.huAt878 ι P a u hunit e hae + have hsum := FaceGapProof.hsumAt883 ι u e hu + let qplus := z + eps • v + have hdetplus := FaceGapProof.hdetplus + ι u z e t δ₁ δ₂ heps hsum + exact (Set.disjoint_left.mp (hd hfg) (hpos₁ qplus (FaceGapProof.hqplus1 ι u z e t δ₁ δ₂ + heps heps₁ hvnorm) hdetplus) + (hpos₂ qplus (FaceGapProof.hqplus2 ι u z e t δ₁ δ₂ heps heps₂ hvnorm) hdetplus)) + · refine ⟨eps, heps, (FaceGapProof.build ι P D F a u c f z i hi e hae t j hj δ₁ δ₂ hzeroK + memK) ?_ ?_⟩ + · intro q hq hqpos + exact hpos₁ q (Metric.ball_subset_ball (le_of_lt heps₁) hq) hqpos + · intro q hq hqneg + exact hneg₂ q (Metric.ball_subset_ball (le_of_lt heps₂) hq) hqneg + · refine ⟨eps, heps, ?_⟩ + intro q hq + by_cases hqpos : 0 < (u e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) + · exact memK g j hj q (hpos₂ q (Metric.ball_subset_ball (le_of_lt heps₂) hq) hqpos) + · by_cases hqneg : (u e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) < 0 + · exact memK f i hi q (hneg₁ q (Metric.ball_subset_ball (le_of_lt heps₁) hq) hqneg) + · exact hzeroK q hq (by linarith) + · exfalso + let v : Real × Real := (-(u e).2, (u e).1) + have hvnorm : ‖v‖ = 1 := by + simpa [v, Prod.norm_def, Real.norm_eq_abs, max_comm] using hunit e hae + have hu := FaceGapProof.huAt935 ι P a u hunit e hae + have hsum := FaceGapProof.hsumAt940 ι u e hu + let qminus := z + eps • (-v) + have hdetminus := FaceGapProof.hdetminus ι u z e t δ₁ δ₂ heps hsum + exact (Set.disjoint_left.mp (hd hfg) (hneg₁ qminus (FaceGapProof.hqminus1 ι u z e t δ₁ + δ₂ heps heps₁ hvnorm) hdetminus) + (hneg₂ qminus (FaceGapProof.hqminus2 ι u z e t δ₁ δ₂ heps heps₂ hvnorm) hdetminus)) + rcases hzRays with hzc | hzd + · obtain ⟨t, ht0, hzeq⟩ := hzc.2 + have hnorm := FaceGapProof.hnormAt978 ι P a u hunit c hac t ht0 + have hdist := FaceGapProof.hdistAt981 ι P D a u z c t hzeq hnorm + have ht' := FaceGapProof.ht'At987 ι P D a p z hzS t hdist + have htpos : 0 < t := by rw [ht']; exact hrho + have htr : t < r := by rw [ht']; exact hrho' + exact finishRay c hci hca hac t htpos htr hzeq + · obtain ⟨t, ht0, hzeq⟩ := hzd.2 + have hnorm := FaceGapProof.hnormAt994 ι P a u hunit d had t ht0 + have hdist := FaceGapProof.hdistAt997 ι P D a u z d t hzeq hnorm + have ht' := FaceGapProof.ht'At1003 ι P D a p z hzS t hdist + have htpos : 0 < t := by rw [ht']; exact hrho + have htr : t < r := by rw [ht']; exact hrho' + exact finishRay d hdi hda had t htpos htr hzeq + +end FaceGapSectorGeometry + +theorem P3889T1FaceGapCoverage : + ∀ {ι : Type}, ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), (Pairwise (fun f g : P.plane.Face => Disjoint (F.region f) + (F.region g))) → (∀ (a : ι), ∀ (r : Real), (0 < r) → (∀ (u : ι → Real × Real), (∀ c, + P.plane.adjacent a c → ‖u c‖ = 1) → ((∀ c, ∀ d, P.plane.adjacent a c → P.plane.adjacent a + d → + u c = u d → c = d) → ((∀ c, P.plane.adjacent a c → + D.edgeArc a c ∩ Metric.ball (D.position a) r = + Metric.ball (D.position a) r ∩ + {p | ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • u c}) → ((∀ c, ∀ d, P.plane.adjacent c + d → c ≠ a → d ≠ a → + Disjoint (D.edgeArc c d) (Metric.ball (D.position a) r)) → (((Set.range D.position ∪ + {p | ∃ c d, P.plane.adjacent c d ∧ p ∈ D.edgeArc c d}) ∩ + Metric.ball (D.position a) r = + Metric.ball (D.position a) r ∩ + {p | ∃ c, P.plane.adjacent a c ∧ + ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • u c}) → ((∀ c, ∀ d, P.plane.adjacent a c → + P.plane.adjacent a d → c ≠ d → + Nonempty (P3889T1TwoRaySectorDecomposition + (D.position a) r (u c) (u d))) → (∀ p ∈ Metric.ball (D.position a) r, + p ∉ Set.range D.position ∪ + {q | ∃ c d, P.plane.adjacent c d ∧ q ∈ D.edgeArc c d} → + ∃ f : P.plane.Face, (∃ i, P.plane.faceVertex f i = a) ∧ p ∈ F.region f)))))))) := by + intro ι P D F hd a r hr u hunit hinj hedge hforeign htrace hsectors +-- BODY + classical + intro p hp hnot + let x := D.position a + let B := Metric.ball x r + let T := Set.range D.position ∪ + {q | ∃ c d, P.plane.adjacent c d ∧ q ∈ D.edgeArc c d} + have hpB : p ∈ B := hp + have hpNotT : p ∉ T := hnot + have hpNotRay (c : ι) (hac : P.plane.adjacent a c) := FaceGapProof.hpNotRay ι P D a r u p hpB + (FaceGapProof.hpNotRays ι P D a r u htrace p hpNotT) c hac + let N : Set ι := {c | P.plane.adjacent a c} + have hincidentSectorData (f : P.plane.Face) (i : Fin 3) + (hi : P.plane.faceVertex f i = a) := FaceGapProof.hincidentSectorData ι P D F a r u hedge + hsectors (FaceGapProof.hfaceFrontier ι P D F a r hforeign) f i hi + have hfaceFillsSector (f : P.plane.Face) (i : Fin 3) + (hi : P.plane.faceVertex f i = a) : + ∃ c d, c ≠ a ∧ d ≠ a ∧ c ≠ d ∧ P.plane.adjacent a c ∧ + P.plane.adjacent a d ∧ (∃ j, P.plane.faceVertex f j = c) ∧ + (∃ j, P.plane.faceVertex f j = d) ∧ + ∃ S : P3889T1TwoRaySectorDecomposition x r (u c) (u d), + F.region f ∩ B = S.left ∨ F.region f ∩ B = S.right := + FaceGapSectorGeometry.hfaceFillsSector ι P D F a r hr u hincidentSectorData f i hi + let rho : Real := ‖p - x‖ + have hrho := FaceGapProof.hrho ι P D a p hpNotT + have hrho' := FaceGapProof.hrho' ι P D a r p hpB + have hpSphere : p ∈ Metric.sphere x rho := by + simp [rho] + let I : Set P.plane.Face := {f | ∃ i, P.plane.faceVertex f i = a} + let Nsub := {c : ι // P.plane.adjacent a c} + let first (c : Nsub) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) + let second (c : Nsub) : P.plane.Face := + Classical.choose (Classical.choose_spec + (P.plane.every_edge_two_faces a c.1 c.2)) + let facePick : Nsub × Fin 2 → P.plane.Face := fun z => + if z.2 = 0 then first z.1 else second z.1 + have faceOtherMatch (g : P.plane.Face) (j : Fin 3) + (hj : P.plane.faceVertex g j = a) (e : ι) + (he : ∃ k, P.plane.faceVertex g k = e) (hea : e ≠ a) + (c d : ι) (hca : c ≠ a) (hda : d ≠ a) (hcd : c ≠ d) + (hc : ∃ k, P.plane.faceVertex g k = c) + (hd : ∃ k, P.plane.faceVertex g k = d) := FaceGapProof.faceOtherMatch ι P a + g j hj e he hea c d hca hda hcd hc hd + let K : Set (Real × Real) := ⋃ f ∈ I, closure (F.region f) + have hKclosed : IsClosed K := by + exact (FaceGapProof.hIfinite ι P a (FaceGapProof.hfinitePick ι P a (P.plane.locally_finite + a))).isClosed_biUnion (fun f _ => isClosed_closure) + have hKlocal (z : Real × Real) (hzS : z ∈ Metric.sphere x rho) + (hzK : z ∈ K) : ∃ δ > 0, Metric.ball z δ ⊆ K := FaceGapSectorGeometry.hKlocal ι P D F hd a + r u hunit p hincidentSectorData hfaceFillsSector hrho hrho' faceOtherMatch z hzS hzK + have hSnonempty : (Metric.sphere x rho).Nonempty := by + exact ⟨p, hpSphere⟩ + have hAclosed : IsClosed ((Subtype.val : Metric.sphere x rho → Real × Real) ⁻¹' K) := + hKclosed.preimage continuous_subtype_val + obtain ⟨f, hfI, hpc⟩ := Set.mem_iUnion₂.mp (FaceGapProof.hpK ι P D F a p hpSphere + (FaceGapProof.hAall ι P D F a p (FaceGapProof.hSphereConnected ι P D a p hrho) + (FaceGapProof.hAopen ι P D F a p hKlocal) (FaceGapProof.hAnonempty ι P D F a r u hunit p + hincidentSectorData hrho hrho'))) + exact ⟨f, hfI, (FaceGapProof.hpRegion ι P D F p (FaceGapProof.hfrontTrace ι P D F) hpNotT f hpc)⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectorDecomposition.lean b/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectorDecomposition.lean new file mode 100644 index 0000000000..2f5f9ace81 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectorDecomposition.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Normed.Module.Basic +public import Mathlib.Topology.Connected.Basic + +-- [TABLET NODE: P3889T1TwoRaySectorDecomposition] + +/-! +# P3889T1TwoRaySectorDecomposition + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $x,u,v\in\mathbb R^2$ and $r\in\mathbb R$, put +$B=B(x,r)$, $R_w=\{x+tw:t\geq0\}$ and +$[w,h]=w_1h_2-w_2h_1$. A two-ray sector decomposition consists of +two nonempty connected open plane sets $L,R$, disjoint from one +another, with +$$ + L\cup R=B\setminus(R_u\cup R_v). +$$ +For each $w\in\{u,v\}$ and $00$ with $B(z,\delta)\subseteq B$ such that +$L\cap B(z,\delta)$ and $R\cap B(z,\delta)$ are, in either order, +the two sets +$$ + \{q\in B(z,\delta):[w,q-z]>0\},\qquad + \{q\in B(z,\delta):[w,q-z]<0\}. +$$ +Balls use the product norm $\|(s,t)\|=\max(|s|,|t|)$, as does +the Lean plane $\mathbb R\times\mathbb R$. +-/ +structure P3889T1TwoRaySectorDecomposition + (x : Real × Real) (r : Real) (u v : Real × Real) where +-- BODY + /-- One connected open component of the ball with the two rays removed. -/ + left : Set (Real × Real) + /-- The other connected open component, disjoint from the first. -/ + right : Set (Real × Real) + left_open : IsOpen left + right_open : IsOpen right + left_connected : IsConnected left + right_connected : IsConnected right + disjoint : Disjoint left right + cover : left ∪ right = Metric.ball x r \ + ({p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v}) + sides : ∀ w : Real × Real, (w = u ∨ w = v) → + ∀ t : Real, 0 < t → t < r → + let z := x + t • w + ∃ δ : Real, 0 < δ ∧ Metric.ball z δ ⊆ Metric.ball x r ∧ + ((left ∩ Metric.ball z δ = + {q | q ∈ Metric.ball z δ ∧ + 0 < w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1)} ∧ + right ∩ Metric.ball z δ = + {q | q ∈ Metric.ball z δ ∧ + w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1) < 0}) ∨ + (right ∩ Metric.ball z δ = + {q | q ∈ Metric.ball z δ ∧ + 0 < w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1)} ∧ + left ∩ Metric.ball z δ = + {q | q ∈ Metric.ball z δ ∧ + w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1) < 0})) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean b/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean new file mode 100644 index 0000000000..5e0449a4e3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean @@ -0,0 +1,1215 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectorDecomposition +public import Mathlib.Analysis.Convex.PathConnected +public import Mathlib.Analysis.Normed.Module.Convex +public import Mathlib.Tactic.FieldSimp +public import Mathlib.Tactic.FunProp +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Positivity +public import Mathlib.Tactic.Push +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P3889T1TwoRaySectors] + +/-! +# P3889T1TwoRaySectors + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TwoRaySectorsProof + +private theorem huOrig : + ∀ (u : Real × Real), (‖u‖ = 1) → ( + let uOrig := u + ‖uOrig‖ = 1) := by + classical + intro u hu uOrig + exact hu + +private theorem hvOrig : + ∀ (v : Real × Real), (‖v‖ = 1) → ( + let vOrig := v + ‖vOrig‖ = 1) := by + classical + intro v hv vOrig + exact hv + +end TwoRaySectorsProof + +namespace TwoRaySectorGeometry + +private theorem hscalar : + ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + let dOrig := det uOrig vOrig + (dOrig = (0 : ℝ)) → ((u.1 ≠ 0 ∨ u.2 ≠ 0) → (∃ k : Real, v = k • u)) := by + classical + intro u v det uOrig vOrig dOrig hd hcoord + have hdet0 : u.1 * v.2 - u.2 * v.1 = 0 := hd + rcases hcoord with h1 | h2 + · refine ⟨v.1 / u.1, ?_⟩ + ext + · simp [div_eq_mul_inv, h1] + · dsimp + field_simp + nlinarith [hdet0] + · refine ⟨v.2 / u.2, ?_⟩ + ext + · dsimp + field_simp + nlinarith [hdet0, h2] + · simp [div_eq_mul_inv, h2] + +private theorem hLconvAt193 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), + let det : (Real × Real) → (Real × + Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let L : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + Convex ℝ L := by + classical + intro x r u det A L p hp q' hq a b ha hb hab + rcases hp with ⟨hpball, hpA⟩ + rcases hq with ⟨hqball, hqA⟩ + have hb' : b = 1-a := by linarith + subst b + refine ⟨(convex_ball x r) hpball hqball ha (by positivity) (by linarith), ?_⟩ + have hcomb : A (a • p + (1-a) • q') = a*A p + (1-a)*A q' := by + dsimp [A, det] + ring + change 0 < A (a • p + (1-a) • q') + rw [hcomb] + by_cases ha0 : a=0 + · subst a + simpa using hqA + · have hap : 0 a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let R : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + Convex ℝ R := by + classical + intro x r u det A R p hp q' hq a b ha hb hab + rcases hp with ⟨hpball, hpA⟩ + rcases hq with ⟨hqball, hqA⟩ + have hb' : b = 1-a := by linarith + subst b + refine ⟨(convex_ball x r) hpball hqball ha (by positivity) (by linarith), ?_⟩ + have hcomb : A (a • p + (1-a) • q') = a*A p + (1-a)*A q' := by + dsimp [A, det] + ring + change A (a • p + (1-a) • q') < 0 + rw [hcomb] + by_cases hb0 : 1-a=0 + · have haone : a=1 := by linarith + simpa [haone, hb0] using hpA + · have hbp : 0<1-a := lt_of_le_of_ne hb (Ne.symm hb0) + exact add_neg_of_nonpos_of_neg (mul_nonpos_of_nonneg_of_nonpos ha + (le_of_lt hpA)) (mul_neg_of_pos_of_neg hbp hqA) + +private theorem hcol : + ∀ (u : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - + a.2 * b.1 + (u.1 ≠ 0 ∨ u.2 ≠ 0) → (∀ (y : Real × Real), (det u y = 0) → (∃ k : Real, y = k • u)) := by + classical + intro u det hcoord y hy + rcases hcoord with h1 | h2 + · refine ⟨y.1 / u.1, ?_⟩ + ext + · simp [h1] + · dsimp + field_simp + nlinarith [hy] + · have hdet : u.1 * y.2 - u.2 * y.1 = 0 := by simpa [det] using hy + refine ⟨y.2 / u.2, ?_⟩ + ext + · dsimp + field_simp [h2] + nlinarith [hdet] + · simp [h2] + +private theorem hcoverAt299 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 + (v = -u) → ( + let A : (Real × Real) → Real := fun p => det u (p - x) + let L : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + let R : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + (∀ (y : Real × Real), (det u y = 0) → (∃ k : Real, y = k • u)) → ((∀ (t : Real), A (x+t•u)=0) + → ((∀ (t : Real), A (x+t•v)=0) → (L ∪ R = Metric.ball x r \ + ({p | ∃ t : Real, 0 ≤ t ∧ p=x+t•u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p=x+t•v}))))) := by + classical + intro x r u v det hvneg A L R hcol hAu hAv + ext p + constructor + · intro hp + have hpball : p∈Metric.ball x r := by + rcases hp with hpL | hpR + · change p∈Metric.ball x r ∧ 0 a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let L : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + ∀ (t : ℝ), + let z : Real × Real := x+t•u + ∀ (δ : ℝ), (Metric.ball z δ ⊆ Metric.ball x r) → ((∀ (q : Real × Real), A q = + u.1*(q.2-z.2)-u.2*(q.1-z.1)) → (L∩Metric.ball z δ = + {q | q∈Metric.ball z δ ∧ 0 a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let R : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + ∀ (t : ℝ), + let z : Real × Real := x+t•u + ∀ (δ : ℝ), (Metric.ball z δ ⊆ Metric.ball x r) → ((∀ (q : Real × Real), A q = + u.1*(q.2-z.2)-u.2*(q.1-z.1)) → (R∩Metric.ball z δ = + {q | q∈Metric.ball z δ ∧ u.1*(q.2-z.2)-u.2*(q.1-z.1)<0})) := by + classical + intro x r u det A R t z δ hδsub hshift + ext q + constructor + · rintro ⟨hqR,hqδ⟩ + change q∈Metric.ball x r ∧ A q<0 at hqR + exact ⟨hqδ,by rw [← hshift]; exact hqR.2⟩ + · rintro ⟨hqδ,hdet⟩ + refine ⟨?_,hqδ⟩ + change q∈Metric.ball x r ∧ A q<0 + exact ⟨hδsub hqδ,by rw [hshift]; exact hdet⟩ + +private theorem hrightAt407 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let R : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + ∀ (t : ℝ), + let z : Real × Real := x+t•v + ∀ (δ : ℝ), (Metric.ball z δ ⊆ Metric.ball x r) → ((∀ (q : Real × Real), A q = + -(v.1*(q.2-z.2)-v.2*(q.1-z.1))) → (R∩Metric.ball z δ = + {q | q∈Metric.ball z δ ∧ 0 a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let L : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + ∀ (t : ℝ), + let z : Real × Real := x+t•v + ∀ (δ : ℝ), (Metric.ball z δ ⊆ Metric.ball x r) → ((∀ (q : Real × Real), A q = + -(v.1*(q.2-z.2)-v.2*(q.1-z.1))) → (L∩Metric.ball z δ = + {q | q∈Metric.ball z δ ∧ v.1*(q.2-z.2)-v.2*(q.1-z.1)<0})) := by + classical + intro x r u v det A L t z δ hδsub hshift + ext q + constructor + · rintro ⟨hqL,hqδ⟩ + change q∈Metric.ball x r ∧ 0 a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + let dOrig := det uOrig vOrig + (¬dOrig = (0 : ℝ)) → ( + let positiveFirstDirection := if 0 < dOrig then uOrig else vOrig + let positiveSecondDirection := if 0 < dOrig then vOrig else uOrig + let d := det positiveFirstDirection positiveSecondDirection + 0 < d) := by + classical + intro u v det uOrig vOrig dOrig hd positiveFirstDirection positiveSecondDirection d + change 0 < det (if 0 < dOrig then uOrig else vOrig) + (if 0 < dOrig then vOrig else uOrig) + by_cases hpos : 0 < dOrig + · simp only [ite_eq_left hpos] + change 0 < dOrig + exact hpos + · have hneg : dOrig < 0 := lt_of_le_of_ne (le_of_not_gt hpos) hd + have hrev : det vOrig uOrig = -dOrig := by dsimp [dOrig, det]; ring + simp only [ite_eq_right hpos] + rw [hrev] + exact neg_pos.mpr hneg + +private theorem hLconvAt510 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + let dOrig := det uOrig vOrig + let positiveFirstDirection := if 0 < dOrig then uOrig else vOrig + let positiveSecondDirection := if 0 < dOrig then vOrig else uOrig + let A : (Real × Real) → Real := fun p => det positiveFirstDirection (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) positiveSecondDirection + let L : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + Convex ℝ L := by + classical + intro x r u v det uOrig vOrig dOrig positiveFirstDirection positiveSecondDirection A B L p hp + q' hq' a b ha hb hab + rcases hp with ⟨⟨hpball, hpA⟩, hpB⟩ + rcases hq' with ⟨⟨hqball', hqA'⟩, hqB'⟩ + have hb' : b = 1 - a := by linarith + subst b + refine ⟨⟨(convex_ball x r) hpball hqball' ha (by positivity) (by linarith), ?_⟩, ?_⟩ + · have hcomb : A (a • p + (1-a) • q') = a * A p + (1-a) * A q' := by + dsimp [A, det] + ring + change 0 < A (a • p + (1-a) • q') + rw [hcomb] + by_cases ha0 : a = 0 + · subst a + simpa using hqA' + · have hap : 0 < a := lt_of_le_of_ne ha (Ne.symm ha0) + exact add_pos_of_pos_of_nonneg (mul_pos hap hpA) + (mul_nonneg (by positivity) (le_of_lt hqA')) + · have hcomb : B (a • p + (1-a) • q') = a * B p + (1-a) * B q' := by + dsimp [B, det] + ring + change 0 < B (a • p + (1-a) • q') + rw [hcomb] + by_cases ha0 : a = 0 + · subst a + simpa using hqB' + · have hap : 0 < a := lt_of_le_of_ne ha (Ne.symm ha0) + exact add_pos_of_pos_of_nonneg (mul_pos hap hpB) + (mul_nonneg (by positivity) (le_of_lt hqB')) + +private theorem hCconv : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + let dOrig := det uOrig vOrig + let positiveFirstDirection := if 0 < dOrig then uOrig else vOrig + let A : (Real × Real) → Real := fun p => det positiveFirstDirection (p - x) + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + Convex ℝ C := by + classical + intro x r u v det uOrig vOrig dOrig positiveFirstDirection A C p hp q' hq' a b ha hb hab + rcases hp with ⟨hpball, hpA⟩ + rcases hq' with ⟨hqball', hqA'⟩ + have hb' : b = 1 - a := by linarith + subst b + refine ⟨(convex_ball x r) hpball hqball' ha (by positivity) (by linarith), ?_⟩ + have hcomb : A (a • p + (1-a) • q') = a * A p + (1-a) * A q' := by + dsimp [A, det] + ring + change A (a • p + (1-a) • q') < 0 + rw [hcomb] + by_cases hb0 : 1 - a = 0 + · have haone : a = 1 := by linarith + simpa [haone, hb0] using hpA + · have hbp : 0 < 1 - a := lt_of_le_of_ne hb (Ne.symm hb0) + exact add_neg_of_nonpos_of_neg (mul_nonpos_of_nonneg_of_nonpos ha + (le_of_lt hpA)) (mul_neg_of_pos_of_neg hbp hqA') + +private theorem hDconv : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + let dOrig := det uOrig vOrig + let positiveSecondDirection := if 0 < dOrig then vOrig else uOrig + let B : (Real × Real) → Real := fun p => det (p - x) positiveSecondDirection + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + Convex ℝ D := by + classical + intro x r u v det uOrig vOrig dOrig positiveSecondDirection B D p hp q' hq' a b ha hb hab + rcases hp with ⟨hpball, hpB⟩ + rcases hq' with ⟨hqball', hqB'⟩ + have hb' : b = 1 - a := by linarith + subst b + refine ⟨(convex_ball x r) hpball hqball' ha (by positivity) (by linarith), ?_⟩ + have hcomb : B (a • p + (1-a) • q') = a * B p + (1-a) * B q' := by + dsimp [B, det] + ring + change B (a • p + (1-a) • q') < 0 + rw [hcomb] + by_cases hb0 : 1 - a = 0 + · have haone : a = 1 := by linarith + simpa [haone, hb0] using hpB + · have hbp : 0 < 1 - a := lt_of_le_of_ne hb (Ne.symm hb0) + exact add_neg_of_nonpos_of_neg (mul_nonpos_of_nonneg_of_nonpos ha + (le_of_lt hpB)) (mul_neg_of_pos_of_neg hbp hqB') + +private theorem hdisAt619 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + let dOrig := det uOrig vOrig + let positiveFirstDirection := if 0 < dOrig then uOrig else vOrig + let positiveSecondDirection := if 0 < dOrig then vOrig else uOrig + let A : (Real × Real) → Real := fun p => det positiveFirstDirection (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) positiveSecondDirection + let L : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let R : Set (Real × Real) := C ∪ D + Disjoint L R := by + classical + intro x r u v det uOrig vOrig dOrig positiveFirstDirection positiveSecondDirection A B L C D R + apply Set.disjoint_left.mpr + intro p hpL hpR + change p ∈ Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} at hpL + change p ∈ C ∪ D at hpR + rcases hpL with ⟨⟨_, hpa⟩, hpb⟩ + rcases hpR with hpC | hpD + · change p ∈ Metric.ball x r ∧ A p < 0 at hpC + exact (not_lt_of_ge (le_of_lt hpa)) hpC.2 + · change p ∈ Metric.ball x r ∧ B p < 0 at hpD + exact (not_lt_of_ge (le_of_lt hpb)) hpD.2 + +private theorem hcoverAlias : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + let dOrig := det uOrig vOrig + let positiveFirstDirection := if 0 < dOrig then uOrig else vOrig + let positiveSecondDirection := if 0 < dOrig then vOrig else uOrig + let d := det positiveFirstDirection positiveSecondDirection + (0 < d) → ( + let A : (Real × Real) → Real := fun p => det positiveFirstDirection (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) positiveSecondDirection + let L : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let R : Set (Real × Real) := C ∪ D + (∀ (y : Real × Real), d • y = det y positiveSecondDirection • positiveFirstDirection + det + positiveFirstDirection y • positiveSecondDirection) → ((∀ (t : Real), A (x + t • + positiveFirstDirection) = 0) → ((∀ (t : Real), B (x + t • positiveFirstDirection) = t * + d) → ((∀ (t : Real), A (x + t • positiveSecondDirection) = t * d) → ((∀ (t : Real), B (x + + t • positiveSecondDirection) = 0) → (L ∪ R = Metric.ball x r \ + ({p | ∃ t : Real, 0 ≤ t ∧ p = x + t • positiveFirstDirection} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • positiveSecondDirection}))))))) := by + classical + intro x r u v det uOrig vOrig dOrig positiveFirstDirection positiveSecondDirection d hdpos A B + L C D R hdetid hAu hBu hAv hBv + ext p + constructor + · intro hp + have hpball : p ∈ Metric.ball x r := by + rcases hp with hpL | hpR + · change p ∈ Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} at hpL + exact hpL.1.1 + · change p ∈ C ∪ D at hpR + rcases hpR with hpC | hpD + · change p ∈ Metric.ball x r ∧ A p < 0 at hpC + exact hpC.1 + · change p ∈ Metric.ball x r ∧ B p < 0 at hpD + exact hpD.1 + refine ⟨hpball, ?_⟩ + intro hray + rcases hray with huRay | hvRay + · rcases huRay with ⟨t, ht, rfl⟩ + have hzero := hAu t + have hnonneg := mul_nonneg ht (le_of_lt hdpos) + have hdetnonneg : 0 ≤ B (x + t • positiveFirstDirection) := by rw [hBu]; exact hnonneg + rcases hp with hpL | hpR + · change x + t • positiveFirstDirection ∈ Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + at hpL + have hpA' : 0 < A (x + t • positiveFirstDirection) := hpL.1.2 + rw [hzero] at hpA' + exact (lt_irrefl 0) hpA' + · change x + t • positiveFirstDirection ∈ C ∪ D at hpR + rcases hpR with hpC | hpD + · change x + t • positiveFirstDirection ∈ Metric.ball x r ∧ A (x + t • + positiveFirstDirection) < 0 at hpC + exact (not_lt_of_ge (le_of_eq hzero.symm)) hpC.2 + · change x + t • positiveFirstDirection ∈ Metric.ball x r ∧ B (x + t • + positiveFirstDirection) < 0 at hpD + exact (not_lt_of_ge hdetnonneg) hpD.2 + · rcases hvRay with ⟨t, ht, rfl⟩ + have hzero := hBv t + have hnonneg := mul_nonneg ht (le_of_lt hdpos) + have hdetnonneg : 0 ≤ A (x + t • positiveSecondDirection) := by rw [hAv]; exact hnonneg + rcases hp with hpL | hpR + · change x + t • positiveSecondDirection ∈ Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + at hpL + have hpB' : 0 < B (x + t • positiveSecondDirection) := hpL.2 + rw [hzero] at hpB' + exact (lt_irrefl 0) hpB' + · change x + t • positiveSecondDirection ∈ C ∪ D at hpR + rcases hpR with hpC | hpD + · change x + t • positiveSecondDirection ∈ Metric.ball x r ∧ A (x + t • + positiveSecondDirection) < 0 at hpC + exact (not_lt_of_ge hdetnonneg) hpC.2 + · change x + t • positiveSecondDirection ∈ Metric.ball x r ∧ B (x + t • + positiveSecondDirection) < 0 at hpD + exact (not_lt_of_ge (le_of_eq hzero.symm)) hpD.2 + · rintro ⟨hpball, hnotray⟩ + by_cases hpa : A p < 0 + · right + left + exact ⟨hpball, hpa⟩ + · by_cases hpb : B p < 0 + · right + right + exact ⟨hpball, hpb⟩ + · have hpa0 : 0 ≤ A p := le_of_not_gt hpa + have hpb0 : 0 ≤ B p := le_of_not_gt hpb + have hyid := hdetid (p - x) + have hrep : p - x = (B p / d) • positiveFirstDirection + (A p / d) • + positiveSecondDirection := by + have hdne : d ≠ 0 := ne_of_gt hdpos + have hmul := congrArg (fun y : Real × Real => d⁻¹ • y) hyid + calc + p - x = d⁻¹ • (d • (p - x)) := by simp [smul_smul, hdne] + _ = d⁻¹ • (B p • positiveFirstDirection + A p • positiveSecondDirection) := hmul + _ = (B p / d) • positiveFirstDirection + (A p / d) • positiveSecondDirection := by + simp [smul_add, smul_smul, div_eq_mul_inv, mul_comm] + by_cases hpaEq : A p = 0 + · have hray : p = x + (B p / d) • positiveFirstDirection := by + calc + p = x + (p - x) := by simp + _ = x + ((B p / d) • positiveFirstDirection + (A p / d) • + positiveSecondDirection) := by rw [hrep] + _ = x + (B p / d) • positiveFirstDirection := by + rw [hpaEq] + simp only [zero_div, zero_smul, add_zero] + apply False.elim (hnotray (Or.inl ⟨B p / d, div_nonneg hpb0 (le_of_lt hdpos), hray⟩)) + · by_cases hpbEq : B p = 0 + · have hray : p = x + (A p / d) • positiveSecondDirection := by + calc + p = x + (p - x) := by simp + _ = x + ((B p / d) • positiveFirstDirection + (A p / d) • + positiveSecondDirection) := by rw [hrep] + _ = x + (A p / d) • positiveSecondDirection := by + rw [hpbEq] + simp only [zero_div, zero_smul, zero_add] + exact False.elim (hnotray (Or.inr ⟨A p / d, div_nonneg hpa0 (le_of_lt hdpos), + hray⟩)) + · have hpaPos : 0 < A p := lt_of_le_of_ne hpa0 (Ne.symm hpaEq) + have hpbPos : 0 < B p := lt_of_le_of_ne hpb0 (Ne.symm hpbEq) + left + exact ⟨⟨hpball, hpaPos⟩, hpbPos⟩ + +private theorem hcoverAt724 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + let dOrig := det uOrig vOrig + let positiveFirstDirection := if 0 < dOrig then uOrig else vOrig + let positiveSecondDirection := if 0 < dOrig then vOrig else uOrig + let A : (Real × Real) → Real := fun p => det positiveFirstDirection (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) positiveSecondDirection + let L : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let R : Set (Real × Real) := C ∪ D + (L ∪ R = Metric.ball x r \ ({p | ∃ t : Real, 0 ≤ t ∧ p = x + t • positiveFirstDirection} ∪ {p + | ∃ t : Real, 0 ≤ t ∧ p = x + t • positiveSecondDirection})) → (L ∪ R = Metric.ball x r \ + ({p | ∃ t : Real, 0 ≤ t ∧ p = x + t • uOrig} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • vOrig})) := by + classical + intro x r u v det uOrig vOrig dOrig positiveFirstDirection positiveSecondDirection A B L C D R + hcoverAlias + have hrays : + ({p | ∃ t : Real, 0 ≤ t ∧ p = x + t • positiveFirstDirection} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • positiveSecondDirection}) = + ({p | ∃ t : Real, 0 ≤ t ∧ p = x + t • uOrig} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • vOrig}) := by + have horder : (positiveFirstDirection = uOrig ∧ positiveSecondDirection = vOrig) ∨ + (positiveFirstDirection = vOrig ∧ positiveSecondDirection = uOrig) := by + by_cases hpos : 0 < dOrig + · left + constructor <;> dsimp [positiveFirstDirection, positiveSecondDirection] <;> simp [hpos] + · right + constructor <;> dsimp [positiveFirstDirection, positiveSecondDirection] <;> simp [hpos] + rcases horder with ⟨huv1, hvv1⟩ | ⟨huv1, hvv1⟩ + · rw [huv1, hvv1] + · rw [huv1, hvv1, Set.union_comm] + rw [hcoverAlias, hrays] + +private theorem hwAlias : + ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + let dOrig := det uOrig vOrig + let positiveFirstDirection := if 0 < dOrig then uOrig else vOrig + let positiveSecondDirection := if 0 < dOrig then vOrig else uOrig + ∀ (w : ℝ × ℝ), (w = u ∨ w = v) → (w = positiveFirstDirection ∨ w = positiveSecondDirection) + := by + classical + intro u v det uOrig vOrig dOrig positiveFirstDirection positiveSecondDirection w hw + rcases hw with h | h + · by_cases hpos : 0 < dOrig + · have huEq : positiveFirstDirection = uOrig := by dsimp [positiveFirstDirection]; simp [hpos] + have h : w = uOrig := by simpa [uOrig] using h + left + rw [huEq] + exact h + · have hvEq : positiveSecondDirection = uOrig := by dsimp [positiveSecondDirection]; simp [hpos] + have h : w = uOrig := by simpa [uOrig] using h + right + rw [hvEq] + exact h + · by_cases hpos : 0 < dOrig + · have hvEq : positiveSecondDirection = vOrig := by dsimp [positiveSecondDirection]; simp [hpos] + have h : w = vOrig := by simpa [vOrig] using h + right + rw [hvEq] + exact h + · have huEq : positiveFirstDirection = vOrig := by dsimp [positiveFirstDirection]; simp [hpos] + have h : w = vOrig := by simpa [vOrig] using h + left + rw [huEq] + exact h + +private theorem hleftAt789 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + let dOrig := det uOrig vOrig + let positiveFirstDirection := if 0 < dOrig then uOrig else vOrig + let positiveSecondDirection := if 0 < dOrig then vOrig else uOrig + let A : (Real × Real) → Real := fun p => det positiveFirstDirection (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) positiveSecondDirection + let L : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + ∀ (t : ℝ), + let z : Real × Real := x + t • positiveFirstDirection + ∀ (δ : ℝ), (Metric.ball z δ ⊆ Metric.ball x r ∩ {p : ℝ × ℝ | (0 : ℝ) < B p}) → ((∀ (q : Real + × Real), A q = positiveFirstDirection.1 * (q.2 - z.2) - positiveFirstDirection.2 * (q.1 - + z.1)) → (L ∩ Metric.ball z δ = + {q | q ∈ Metric.ball z δ ∧ + 0 < positiveFirstDirection.1 * (q.2 - z.2) - positiveFirstDirection.2 * (q.1 - z.1)})) := by + classical + intro x r u v det uOrig vOrig dOrig positiveFirstDirection positiveSecondDirection A B L t z δ + hδsub hAshift + ext q + constructor + · rintro ⟨hqL, hqδ⟩ + change q ∈ Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} at hqL + have hqN := hδsub hqδ + exact ⟨hqδ, by rw [← hAshift]; exact hqL.1.2⟩ + · rintro ⟨hqδ, hdet⟩ + have hqN := hδsub hqδ + refine ⟨?_, hqδ⟩ + change q ∈ Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + exact ⟨⟨hqN.1, by change 0 < A q; rw [hAshift]; exact hdet⟩, hqN.2⟩ + +private theorem hrightAt803 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + let dOrig := det uOrig vOrig + let positiveFirstDirection := if 0 < dOrig then uOrig else vOrig + let positiveSecondDirection := if 0 < dOrig then vOrig else uOrig + let A : (Real × Real) → Real := fun p => det positiveFirstDirection (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) positiveSecondDirection + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let R : Set (Real × Real) := C ∪ D + ∀ (t : ℝ), + let z : Real × Real := x + t • positiveFirstDirection + ∀ (δ : ℝ), (Metric.ball z δ ⊆ Metric.ball x r ∩ {p : ℝ × ℝ | (0 : ℝ) < B p}) → ((∀ (q : Real + × Real), A q = positiveFirstDirection.1 * (q.2 - z.2) - positiveFirstDirection.2 * (q.1 - + z.1)) → (R ∩ Metric.ball z δ = + {q | q ∈ Metric.ball z δ ∧ + positiveFirstDirection.1 * (q.2 - z.2) - positiveFirstDirection.2 * (q.1 - z.1) < 0})) := by + classical + intro x r u v det uOrig vOrig dOrig positiveFirstDirection positiveSecondDirection A B C D R t + z δ hδsub hAshift + ext q + constructor + · rintro ⟨hqR, hqδ⟩ + have hqN := hδsub hqδ + change q ∈ C ∪ D at hqR + rcases hqR with hqC | hqD + · change q ∈ Metric.ball x r ∧ A q < 0 at hqC + exact ⟨hqδ, by rw [← hAshift]; exact hqC.2⟩ + · change q ∈ Metric.ball x r ∧ B q < 0 at hqD + exact False.elim ((not_lt_of_ge (le_of_lt hqN.2)) hqD.2) + · rintro ⟨hqδ, hdet⟩ + have hqN := hδsub hqδ + refine ⟨?_, hqδ⟩ + change q ∈ C ∪ D + left + change q ∈ Metric.ball x r ∧ A q < 0 + exact ⟨hqN.1, by rw [hAshift]; exact hdet⟩ + +private theorem hrightAt842 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + let dOrig := det uOrig vOrig + let positiveFirstDirection := if 0 < dOrig then uOrig else vOrig + let positiveSecondDirection := if 0 < dOrig then vOrig else uOrig + let A : (Real × Real) → Real := fun p => det positiveFirstDirection (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) positiveSecondDirection + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let R : Set (Real × Real) := C ∪ D + ∀ (t : ℝ), + let z : Real × Real := x + t • positiveSecondDirection + ∀ (δ : ℝ), (Metric.ball z δ ⊆ Metric.ball x r ∩ {p : ℝ × ℝ | (0 : ℝ) < A p}) → ((∀ (q : Real + × Real), B q = -(positiveSecondDirection.1 * (q.2 - z.2) - positiveSecondDirection.2 * + (q.1 - z.1))) → (R ∩ Metric.ball z δ = + {q | q ∈ Metric.ball z δ ∧ + 0 < positiveSecondDirection.1 * (q.2 - z.2) - positiveSecondDirection.2 * (q.1 - z.1)})) + := by + classical + intro x r u v det uOrig vOrig dOrig positiveFirstDirection positiveSecondDirection A B C D R t + z δ hδsub hBshift + ext q + constructor + · rintro ⟨hqR, hqδ⟩ + have hqN := hδsub hqδ + change q ∈ C ∪ D at hqR + rcases hqR with hqC | hqD + · change q ∈ Metric.ball x r ∧ A q < 0 at hqC + exact False.elim ((not_lt_of_ge (le_of_lt hqN.2)) hqC.2) + · change q ∈ Metric.ball x r ∧ B q < 0 at hqD + refine ⟨hqδ, ?_⟩ + have hDval : B q < 0 := hqD.2 + rw [hBshift] at hDval + linarith [hDval] + · rintro ⟨hqδ, hdet⟩ + have hqN := hδsub hqδ + refine ⟨?_, hqδ⟩ + change q ∈ C ∪ D + right + change q ∈ Metric.ball x r ∧ B q < 0 + refine ⟨hqN.1, ?_⟩ + rw [hBshift] + linarith + +private theorem hleftAt868 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + let dOrig := det uOrig vOrig + let positiveFirstDirection := if 0 < dOrig then uOrig else vOrig + let positiveSecondDirection := if 0 < dOrig then vOrig else uOrig + let A : (Real × Real) → Real := fun p => det positiveFirstDirection (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) positiveSecondDirection + let L : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + ∀ (t : ℝ), + let z : Real × Real := x + t • positiveSecondDirection + ∀ (δ : ℝ), (Metric.ball z δ ⊆ Metric.ball x r ∩ {p : ℝ × ℝ | (0 : ℝ) < A p}) → ((∀ (q : Real + × Real), B q = -(positiveSecondDirection.1 * (q.2 - z.2) - positiveSecondDirection.2 * + (q.1 - z.1))) → (L ∩ Metric.ball z δ = + {q | q ∈ Metric.ball z δ ∧ + positiveSecondDirection.1 * (q.2 - z.2) - positiveSecondDirection.2 * (q.1 - z.1) < 0})) + := by + classical + intro x r u v det uOrig vOrig dOrig positiveFirstDirection positiveSecondDirection A B L t z δ + hδsub hBshift + ext q + constructor + · rintro ⟨hqL, hqδ⟩ + have hqN := hδsub hqδ + change q ∈ Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} at hqL + refine ⟨hqδ, ?_⟩ + have hLval : 0 < B q := hqL.2 + rw [hBshift] at hLval + linarith [hLval] + · rintro ⟨hqδ, hdet⟩ + have hqN := hδsub hqδ + refine ⟨?_, hqδ⟩ + change q ∈ Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + refine ⟨⟨hqN.1, hqN.2⟩, ?_⟩ + change 0 < B q + rw [hBshift] + linarith + +end TwoRaySectorGeometry + +namespace TwoRayCasesProof + +private theorem degenerateCase : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), (0 < r) → ((‖u‖ + = 1) → ((‖v‖ = 1) → ((u ≠ v) → ( + let det : (Real × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + let dOrig := det uOrig vOrig + (dOrig = 0) → (Nonempty (P3889T1TwoRaySectorDecomposition x r u v)))))) := by + classical + intro x r u v hr hu hv huv det uOrig vOrig dOrig hd + have hdet0 : u.1 * v.2 - u.2 * v.1 = 0 := by + simpa [dOrig, det, uOrig, vOrig] using hd + have hu0 : u ≠ (0, 0) := by + intro h + rw [h] at hu + norm_num at hu + have hcoord : u.1 ≠ 0 ∨ u.2 ≠ 0 := by + by_contra h + push Not at h + apply hu0 + ext + · exact h.1 + · exact h.2 + have hscalar := TwoRaySectorGeometry.hscalar u v hd hcoord + obtain ⟨k, hk⟩ := hscalar + have hkabs : |k| = 1 := by + have hvnorm := hv + rw [hk, norm_smul, Real.norm_eq_abs, hu] at hvnorm + nlinarith + have hk2 : k^2 = 1 := by nlinarith [sq_abs k] + have hfactor : (k-1)*(k+1)=0 := by nlinarith [hk2] + rcases mul_eq_zero.mp hfactor with hkone | hkminus + · have hkone' : k = 1 := by linarith + have : v = u := by rw [hk, hkone']; simp + exact False.elim (huv this.symm) + · have hkminus' : k = -1 := by linarith + have hvneg : v = -u := by rw [hk, hkminus']; simp + let A : (Real × Real) → Real := fun p => det u (p - x) + let L : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + let R : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + have hAcont : Continuous A := by + dsimp [A, det] + fun_prop + have hLopen : IsOpen L := by + dsimp [L] + exact Metric.isOpen_ball.inter (isOpen_Ioi.preimage hAcont) + have hRopen : IsOpen R := by + dsimp [R] + exact Metric.isOpen_ball.inter (isOpen_Iio.preimage hAcont) + have hLconv := TwoRaySectorGeometry.hLconvAt193 x r u + have hRconv := TwoRaySectorGeometry.hRconv x r u + let j : Real × Real := (-u.2, u.1) + have hsqpos : 0 < u.1^2 + u.2^2 := by + by_contra h + have hle : u.1^2 + u.2^2 ≤ 0 := le_of_not_gt h + have h1 : u.1 = 0 := by nlinarith [sq_nonneg u.1, sq_nonneg u.2] + have h2 : u.2 = 0 := by nlinarith [sq_nonneg u.1, sq_nonneg u.2] + apply hu0 + ext <;> simp [h1, h2] + have hjdet : det u j = u.1^2 + u.2^2 := by dsimp [j, det]; ring + have hjnorm : ‖j‖ = 1 := by + dsimp [j] + simpa [Prod.norm_def, Real.norm_eq_abs, max_comm] using hu + let qpos : Real × Real := x + (r/4) • j + let qneg : Real × Real := x - (r/4) • j + have hqposball : qpos ∈ Metric.ball x r := by + change dist qpos x < r + rw [dist_eq_norm] + have heq : qpos-x=(r/4)•j := by simp [qpos] + rw [heq, norm_smul, Real.norm_eq_abs, abs_of_pos (by positivity : 0 a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + (‖uOrig‖ = 1) → ((‖vOrig‖ = 1) → ( + let dOrig := det uOrig vOrig + (dOrig ≠ 0) → (Nonempty (P3889T1TwoRaySectorDecomposition x r u v))))) := by + classical + intro x r u v hr det uOrig vOrig huOrig hvOrig dOrig hd + let positiveFirstDirection := if 0 < dOrig then uOrig else vOrig + let positiveSecondDirection := if 0 < dOrig then vOrig else uOrig + let d := det positiveFirstDirection positiveSecondDirection + have hu : ‖positiveFirstDirection‖ = 1 := by + dsimp [positiveFirstDirection] + split_ifs with h + · exact huOrig + · exact hvOrig + have hv : ‖positiveSecondDirection‖ = 1 := by + dsimp [positiveSecondDirection] + split_ifs with h + · exact hvOrig + · exact huOrig + have hdpos := TwoRaySectorGeometry.hdpos u v hd + let A : (Real × Real) → Real := fun p => det positiveFirstDirection (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) positiveSecondDirection + let L : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let R : Set (Real × Real) := C ∪ D + have hdetid (y : Real × Real) : d • y = det y positiveSecondDirection • + positiveFirstDirection + det positiveFirstDirection y • positiveSecondDirection := by + apply Prod.ext <;> simp [d, det, smul_eq_mul] <;> ring + have hAcont : Continuous A := by + dsimp [A, det] + fun_prop + have hBcont : Continuous B := by + dsimp [B, det] + fun_prop + have hballAopen : IsOpen (Metric.ball x r ∩ {p | 0 < A p}) := + Metric.isOpen_ball.inter (isOpen_Ioi.preimage hAcont) + have hballBopen : IsOpen (Metric.ball x r ∩ {p | 0 < B p}) := + Metric.isOpen_ball.inter (isOpen_Ioi.preimage hBcont) + have hLopen : IsOpen L := by + dsimp [L] + exact hballAopen.inter (isOpen_Ioi.preimage hBcont) + have hCopen : IsOpen C := by + dsimp [C] + exact Metric.isOpen_ball.inter (isOpen_Iio.preimage hAcont) + have hDopen : IsOpen D := by + dsimp [D] + exact Metric.isOpen_ball.inter (isOpen_Iio.preimage hBcont) + have hRopen : IsOpen R := by + dsimp [R] + exact hCopen.union hDopen + have huplusnorm : ‖positiveFirstDirection + positiveSecondDirection‖ ≤ 2 := by + calc ‖positiveFirstDirection + positiveSecondDirection‖ ≤ ‖positiveFirstDirection‖ + + ‖positiveSecondDirection‖ := norm_add_le _ _ + _ = 2 := by rw [hu, hv]; norm_num + have hr4 : 0 < r / 4 := by positivity + let q : Real × Real := x + (r / 4) • (positiveFirstDirection + positiveSecondDirection) + have hqball : q ∈ Metric.ball x r := by + change dist q x < r + rw [dist_eq_norm] + have hbound : ‖(r / 4) • (positiveFirstDirection + positiveSecondDirection)‖ ≤ r / 2 := by + rw [norm_smul, Real.norm_eq_abs, abs_of_pos (by positivity : 0 < r / 4)] + nlinarith [huplusnorm] + have hxq : q - x = (r / 4) • (positiveFirstDirection + positiveSecondDirection) := by simp [q] + rw [hxq] + exact lt_of_le_of_lt hbound (by linarith) + have hqA : 0 < A q := by + dsimp [A, q, det] + simp [] + nlinarith [hdpos, hu] + have hqB : 0 < B q := by + dsimp [B, q, det] + simp [] + nlinarith [hdpos, hv] + have hLne : L.Nonempty := ⟨q, ⟨⟨hqball, hqA⟩, hqB⟩⟩ + have hLconv := TwoRaySectorGeometry.hLconvAt510 x r u v + have hLconn : IsConnected L := hLconv.isConnected hLne + have hCconv := TwoRaySectorGeometry.hCconv x r u v + have hDconv := TwoRaySectorGeometry.hDconv x r u v + let qneg : Real × Real := x - (r / 4) • (positiveFirstDirection + positiveSecondDirection) + have hqnegball : qneg ∈ Metric.ball x r := by + change dist qneg x < r + rw [dist_eq_norm] + have hbound : ‖(r / 4) • (positiveFirstDirection + positiveSecondDirection)‖ ≤ r / 2 := by + rw [norm_smul, Real.norm_eq_abs, abs_of_pos (by positivity : 0 < r / 4)] + nlinarith [huplusnorm] + have hxq : qneg - x = -((r / 4) • (positiveFirstDirection + positiveSecondDirection)) := by + simp [qneg, sub_eq_add_neg] + rw [hxq, norm_neg] + exact lt_of_le_of_lt hbound (by linarith) + have hqnegA : A qneg < 0 := by + dsimp [A, qneg, det] + simp [] + nlinarith [hdpos] + have hqnegB : B qneg < 0 := by + dsimp [B, qneg, det] + simp [] + nlinarith [hdpos] + have hCne : C.Nonempty := ⟨qneg, ⟨hqnegball, hqnegA⟩⟩ + have hDne : D.Nonempty := ⟨qneg, ⟨hqnegball, hqnegB⟩⟩ + have hCconn : IsConnected C := hCconv.isConnected hCne + have hDconn : IsConnected D := hDconv.isConnected hDne + have hCD : (C ∩ D).Nonempty := ⟨qneg, + ⟨⟨hqnegball, hqnegA⟩, ⟨hqnegball, hqnegB⟩⟩⟩ + have hRconn : IsConnected R := by + dsimp [R] + exact IsConnected.union hCD hCconn hDconn + have hAu (t : Real) : A (x + t • positiveFirstDirection) = 0 := by + dsimp [A, det] + simp [] + ring + have hBu (t : Real) : B (x + t • positiveFirstDirection) = t * d := by + dsimp [B, det, d] + simp [] + ring + have hAv (t : Real) : A (x + t • positiveSecondDirection) = t * d := by + dsimp [A, det, d] + simp [] + ring + have hBv (t : Real) : B (x + t • positiveSecondDirection) = 0 := by + dsimp [B, det] + simp [] + ring + have hdis := TwoRaySectorGeometry.hdisAt619 x r u v + have hcoverAlias := TwoRaySectorGeometry.hcoverAlias x r u v hdpos hdetid hAu hBu hAv hBv + have hcover := TwoRaySectorGeometry.hcoverAt724 x r u v + hcoverAlias + refine ⟨⟨L, R, hLopen, hRopen, hLconn, hRconn, hdis, hcover, ?_⟩⟩ + intro w hw t ht htr + dsimp + have hwAlias := TwoRaySectorGeometry.hwAlias u v w hw + rcases hwAlias with hwu | hwv + · rw [hwu] + let z : Real × Real := x + t • positiveFirstDirection + have hztball : z ∈ Metric.ball x r := by + change dist z x < r + rw [dist_eq_norm] + have heq : z - x = t • positiveFirstDirection := by simp [z] + rw [heq, norm_smul, Real.norm_eq_abs, abs_of_pos ht, hu] + nlinarith + have hBz : 0 < B z := by + dsimp [z] + rw [hBu] + exact mul_pos ht hdpos + have hNopen : IsOpen (Metric.ball x r ∩ {p | 0 < B p}) := hballBopen + obtain ⟨δ, hδ, hδsub⟩ := Metric.mem_nhds_iff.mp + (hNopen.mem_nhds ⟨hztball, hBz⟩) + have hAshift (q : Real × Real) : A q = + positiveFirstDirection.1 * (q.2 - z.2) - positiveFirstDirection.2 * (q.1 - z.1) := by + dsimp [A, det, z] + ring + have hleft : L ∩ Metric.ball z δ = + {q | q ∈ Metric.ball z δ ∧ + 0 < positiveFirstDirection.1 * (q.2 - z.2) - positiveFirstDirection.2 * (q.1 - z.1)} := + TwoRaySectorGeometry.hleftAt789 x r u v t δ hδsub hAshift + have hright : R ∩ Metric.ball z δ = + {q | q ∈ Metric.ball z δ ∧ + positiveFirstDirection.1 * (q.2 - z.2) - positiveFirstDirection.2 * (q.1 - z.1) < 0} := + TwoRaySectorGeometry.hrightAt803 x r u v t δ hδsub hAshift + exact ⟨δ, hδ, fun q hq => (hδsub hq).1, Or.inl ⟨hleft, hright⟩⟩ + · rw [hwv] + let z : Real × Real := x + t • positiveSecondDirection + have hztball : z ∈ Metric.ball x r := by + change dist z x < r + rw [dist_eq_norm] + have heq : z - x = t • positiveSecondDirection := by simp [z] + rw [heq, norm_smul, Real.norm_eq_abs, abs_of_pos ht, hv] + simpa only [mul_one] using htr + have hAz : 0 < A z := by + dsimp [z] + rw [hAv] + exact mul_pos ht hdpos + have hNopen : IsOpen (Metric.ball x r ∩ {p | 0 < A p}) := hballAopen + obtain ⟨δ, hδ, hδsub⟩ := Metric.mem_nhds_iff.mp + (hNopen.mem_nhds ⟨hztball, hAz⟩) + have hBshift (q : Real × Real) : B q = -(positiveSecondDirection.1 * (q.2 - z.2) - + positiveSecondDirection.2 * (q.1 - z.1)) := by + dsimp [B, det, z] + ring + have hright : R ∩ Metric.ball z δ = + {q | q ∈ Metric.ball z δ ∧ + 0 < positiveSecondDirection.1 * (q.2 - z.2) - positiveSecondDirection.2 * (q.1 - z.1)} := + TwoRaySectorGeometry.hrightAt842 x r u v t δ hδsub hBshift + have hleft : L ∩ Metric.ball z δ = + {q | q ∈ Metric.ball z δ ∧ + positiveSecondDirection.1 * (q.2 - z.2) - positiveSecondDirection.2 * (q.1 - z.1) < 0} := + TwoRaySectorGeometry.hleftAt868 x r u v t δ hδsub hBshift + exact ⟨δ, hδ, fun q hq => (hδsub hq).1, Or.inr ⟨hright, hleft⟩⟩ + +end TwoRayCasesProof + +theorem P3889T1TwoRaySectors (x : Real × Real) (r : Real) + (u v : Real × Real) (hr : 0 < r) (hu : ‖u‖ = 1) (hv : ‖v‖ = 1) + (huv : u ≠ v) : Nonempty (P3889T1TwoRaySectorDecomposition x r u v) := by +-- BODY + let det : (Real × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 + let uOrig := u + let vOrig := v + have huOrig : ‖uOrig‖ = 1 := TwoRaySectorsProof.huOrig u hu + have hvOrig : ‖vOrig‖ = 1 := TwoRaySectorsProof.hvOrig v hv + let dOrig := det uOrig vOrig + have degenerateCase (hd : dOrig = 0) : Nonempty (P3889T1TwoRaySectorDecomposition x r u v) := + TwoRayCasesProof.degenerateCase x r u v hr hu hv huv hd + have nondegenerateCase (hd : dOrig ≠ 0) : Nonempty (P3889T1TwoRaySectorDecomposition x r u v) + := TwoRayCasesProof.nondegenerateCase x r u v hr huOrig hvOrig hd + by_cases hd : dOrig = 0 + · exact degenerateCase hd + · exact nondegenerateCase hd + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3913T1OffFaceExterior.lean b/LeanPool/ApollonianSuperharmonic/P3913T1OffFaceExterior.lean new file mode 100644 index 0000000000..4214c950b3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3913T1OffFaceExterior.lean @@ -0,0 +1,187 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting +public import LeanPool.ApollonianSuperharmonic.P3767T1VertexEdgeIncidence +public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry +public import LeanPool.ApollonianSuperharmonic.P3913T1PeriodicPositionUnbounded + +-- [TABLET NODE: P3913T1OffFaceExterior] + +/-! +# P3913T1OffFaceExterior + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3913T1OffFaceExterior {ι : Type} (P : PeriodicTileComplex ι) + (D : P3723T1AllContactRouting P) (f : P.plane.Face) + (U V : Set (Real × Real)) (hU : IsOpen U) (hV : IsOpen V) + (hb : Bornology.IsBounded U) (hd : Disjoint U V) + (hp : U ∪ V = (D.edgeArc (P.plane.faceVertex f 0) (P.plane.faceVertex f 1) ∪ + D.edgeArc (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) ∪ + D.edgeArc (P.plane.faceVertex f 2) (P.plane.faceVertex f 0))ᶜ) + (hdelete : ∀ a b : ι, + a ∉ Set.range (P.plane.faceVertex f) → + b ∉ Set.range (P.plane.faceVertex f) → + ∃ p : List ι, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ x ∈ p, x ∉ Set.range (P.plane.faceVertex f)) ∧ + ∀ x y : ι, ∀ l₁ l₂ : List ι, + p = l₁ ++ x :: y :: l₂ → P.plane.adjacent x y) : + (¬ Bornology.IsBounded + (D.position '' (Set.range (P.plane.faceVertex f))ᶜ)) ∧ + ∀ a, a ∉ Set.range (P.plane.faceVertex f) → D.position a ∈ V := by +-- BODY + classical + let : Nontrivial ι := (P3776T1FixedGeometry P.toPeriodicTileCore).1 + let A := Set.range (P.plane.faceVertex f) + let J := D.edgeArc (P.plane.faceVertex f 0) (P.plane.faceVertex f 1) ∪ + D.edgeArc (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) ∪ + D.edgeArc (P.plane.faceVertex f 2) (P.plane.faceVertex f 0) + have contact (a b : ι) (h : P.plane.adjacent a b) : + P3723T1EdgeContact P a b := + ⟨(fun e => P.plane.adjacent_irreflexive a (e.symm ▸ h)), + P.adjacent_has_common_edge a b h⟩ + have vertex_on_edge (x a b : ι) (hab : P.plane.adjacent a b) + (hx : D.position x ∈ D.edgeArc a b) : x = a ∨ x = b := by + obtain ⟨y, hxy⟩ := (P3767T1VertexEdgeIncidence P.plane x).1 + obtain ⟨g, h0, _⟩ := D.edgeArc_homeomorph x y (contact x y hxy) + have hxpos : D.position x ∈ D.edgeArc x y := by + rw [← h0] + exact (g ⟨0, by norm_num⟩).property + by_cases heq : ({x, y} : Set ι) = {a, b} + · have hm : x ∈ ({a, b} : Set ι) := heq ▸ (by simp) + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hm + · have hm : D.position x ∈ D.position '' (({x, y} : Set ι) ∩ {a, b}) := by + rw [← D.edgeArc_intersections x y a b (contact x y hxy) + (contact a b hab) heq] + exact ⟨hxpos, hx⟩ + obtain ⟨z, hz, hzx⟩ := hm + have hzx' : z = x := D.position_injective hzx + subst z + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hz.2 + have vertex_miss (x : ι) (hx : x ∉ A) : D.position x ∉ J := by + intro hxJ + rcases hxJ with (hxJ | hxJ) | hxJ + · rcases vertex_on_edge x _ _ (P.plane.face_edges f 0 1 (by decide)) hxJ with h | h + · exact hx ⟨0, h.symm⟩ + · exact hx ⟨1, h.symm⟩ + · rcases vertex_on_edge x _ _ (P.plane.face_edges f 1 2 (by decide)) hxJ with h | h + · exact hx ⟨1, h.symm⟩ + · exact hx ⟨2, h.symm⟩ + · rcases vertex_on_edge x _ _ (P.plane.face_edges f 2 0 (by decide)) hxJ with h | h + · exact hx ⟨2, h.symm⟩ + · exact hx ⟨0, h.symm⟩ + have edge_miss (a b : ι) (hab : P.plane.adjacent a b) (ha : a ∉ A) (hb : b ∉ A) : + Disjoint (D.edgeArc a b) J := by + have pair_miss (i j : Fin 3) : + Disjoint ({a, b} : Set ι) + ({P.plane.faceVertex f i, P.plane.faceVertex f j} : Set ι) := by + apply Set.disjoint_left.mpr + intro z hz hz' + have hzA : z ∈ A := by + rcases Set.mem_insert_iff.mp hz' with h | h + · exact ⟨i, h.symm⟩ + · exact ⟨j, (Set.mem_singleton_iff.mp h).symm⟩ + rcases Set.mem_insert_iff.mp hz with h | h + · exact ha (h ▸ hzA) + · exact hb ((Set.mem_singleton_iff.mp h) ▸ hzA) + have misses (i j : Fin 3) (hij : i ≠ j) : + Disjoint (D.edgeArc a b) + (D.edgeArc (P.plane.faceVertex f i) (P.plane.faceVertex f j)) := by + have hne : ({a, b} : Set ι) ≠ + {P.plane.faceVertex f i, P.plane.faceVertex f j} := by + intro heq + have hleft : a ∈ ({a, b} : Set ι) := by simp + have hright : a ∈ + ({P.plane.faceVertex f i, P.plane.faceVertex f j} : Set ι) := heq ▸ hleft + exact Set.disjoint_left.mp (pair_miss i j) hleft hright + apply Set.disjoint_left.mpr + intro z hz hz' + have hm : z ∈ D.position '' (({a, b} : Set ι) ∩ + {P.plane.faceVertex f i, P.plane.faceVertex f j}) := by + rw [← D.edgeArc_intersections a b _ _ (contact a b hab) + (contact _ _ (P.plane.face_edges f i j hij)) hne] + exact ⟨hz, hz'⟩ + obtain ⟨w, hw, _⟩ := hm + exact Set.disjoint_left.mp (pair_miss i j) hw.1 hw.2 + apply Set.disjoint_left.mpr + intro z hz hzJ + rcases hzJ with (hzJ | hzJ) | hzJ + · exact Set.disjoint_left.mp (misses 0 1 (by decide)) hz hzJ + · exact Set.disjoint_left.mp (misses 1 2 (by decide)) hz hzJ + · exact Set.disjoint_left.mp (misses 2 0 (by decide)) hz hzJ + have adjacent_same (a b : ι) (ha : a ∉ A) (hb : b ∉ A) + (hab : P.plane.adjacent a b) : D.position a ∈ U ↔ D.position b ∈ U := by + obtain ⟨g, hg, _, hr, h0, h1, _⟩ := D.edgeArc_parameterization a b (contact a b hab) + let : ConnectedSpace (Set.Icc (0 : Real) 1) := + isConnected_iff_connectedSpace.mp (isConnected_Icc (by norm_num)) + have hpre : IsPreconnected (D.edgeArc a b) := hr ▸ isPreconnected_range hg + have hsub : D.edgeArc a b ⊆ U ∪ V := by + intro z hz + rw [hp] + exact fun hzJ => Set.disjoint_left.mp (edge_miss a b hab ha hb) hz hzJ + have hposa : D.position a ∈ D.edgeArc a b := h0 ▸ hr ▸ Set.mem_range_self _ + have hposb : D.position b ∈ D.edgeArc a b := h1 ▸ hr ▸ Set.mem_range_self _ + rcases hpre.subset_or_subset hU hV hd hsub with h | h + · exact ⟨fun _ => h hposb, fun _ => h hposa⟩ + · constructor + · intro hu + exact (Set.disjoint_left.mp hd hu (h hposa)).elim + · intro hu + exact (Set.disjoint_left.mp hd hu (h hposb)).elim + have walk_same (l : List ι) + (hv : ∀ x ∈ l, x ∉ A) + (he : ∀ x y : ι, ∀ l₁ l₂ : List ι, + l = l₁ ++ x :: y :: l₂ → P.plane.adjacent x y) : + ∀ a b, l.head? = some a → l.getLast? = some b → + (D.position a ∈ U ↔ D.position b ∈ U) := by + induction l with + | nil => intro a b h; simp at h + | cons x xs ih => + intro a b hhead hlast + have hxa : x = a := by simpa using hhead + subst a + cases xs with + | nil => + have hxb : x = b := by simpa using hlast + subst b + rfl + | cons y ys => + have htail := ih (fun z hz => hv z (by simp [hz])) + (fun u v l₁ l₂ h => he u v (x :: l₁) l₂ (by simp [h])) + y b rfl (by simpa using hlast) + exact (adjacent_same x y (hv x (by simp)) (hv y (by simp)) + (he x y [] ys rfl)).trans htail + have same (a b : ι) (ha : a ∉ A) (hb : b ∉ A) : + D.position a ∈ U ↔ D.position b ∈ U := by + obtain ⟨l, hhead, hlast, hv, he⟩ := hdelete a b ha hb + exact walk_same l hv he a b hhead hlast + have hnb : ¬ Bornology.IsBounded (D.position '' Aᶜ) := + P3913T1PeriodicPositionUnbounded P D A (Set.finite_range _) + refine ⟨hnb, ?_⟩ + intro a ha + have hnU : D.position a ∉ U := by + intro haU + apply hnb + apply hb.subset + rintro z ⟨b, hbA, rfl⟩ + exact (same a b ha hbA).mp haU + have hUV : D.position a ∈ U ∪ V := by + rw [hp] + exact vertex_miss a ha + exact hUV.resolve_left hnU + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3913T1PeriodicPositionUnbounded.lean b/LeanPool/ApollonianSuperharmonic/P3913T1PeriodicPositionUnbounded.lean new file mode 100644 index 0000000000..3a6c6886f5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3913T1PeriodicPositionUnbounded.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting +public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry + +-- [TABLET NODE: P3913T1PeriodicPositionUnbounded] + +/-! +# P3913T1PeriodicPositionUnbounded + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3913T1PeriodicPositionUnbounded {ι : Type} (P : PeriodicTileComplex ι) + (D : P3723T1AllContactRouting P) (F : Set ι) (hF : F.Finite) : + ¬ Bornology.IsBounded (D.position '' Fᶜ) := by +-- BODY + classical + let : Nontrivial ι := (P3776T1FixedGeometry P.toPeriodicTileCore).1 + have nonzero_period : ∃ u : P.lattice, u ≠ 0 := by + by_contra hz + have hallzero : ∀ u : P.lattice, u = 0 := by simpa using hz + have hrep : ∀ z : GaussianInt, z ∈ P.latticeReps := by + intro z + obtain ⟨r, ⟨hr, hzr⟩, _⟩ := P.lattice_full_rank z + have heq : z - r = 0 := congrArg Subtype.val (hallzero ⟨z - r, hzr⟩) + simpa [sub_eq_zero.mp heq] using hr + have hinj : Function.Injective (fun n : Nat => (n : GaussianInt)) := Nat.cast_injective + have hfinite := P.latticeReps.finite_toSet.preimage hinj.injOn + have hall : (fun n : Nat => (n : GaussianInt)) ⁻¹' + (P.latticeReps : Set GaussianInt) = Set.univ := by + ext n + simp [hrep] + rw [hall] at hfinite + exact Set.infinite_univ hfinite + obtain ⟨u, hu⟩ := nonzero_period + let v := GaussianRealPoint (u : GaussianInt) + have hv : v ≠ (0, 0) := by + intro h + apply hu + apply Subtype.ext + apply Zsqrtd.ext + · have hr := congrArg Prod.fst h + have hr' : (((u : GaussianInt).re : Int) : Real) = 0 := by + simpa [v, GaussianRealPoint] using hr + exact_mod_cast hr' + · have hi := congrArg Prod.snd h + have hi' : (((u : GaussianInt).im : Int) : Real) = 0 := by + simpa [v, GaussianRealPoint] using hi + exact_mod_cast hi' + have coord : ∃ q : (Real × Real) → Real, + q v ≠ 0 ∧ + (∀ x y, q (x + y) = q x + q y) ∧ + (∀ (n : Nat) x, q (n • x) = (n : Real) * q x) ∧ + ∀ x, |q x| ≤ ‖x‖ := by + by_cases h : v.1 ≠ 0 + · exact ⟨Prod.fst, h, fun _ _ => rfl, + by intros; simp, fun x => by simpa using norm_fst_le x⟩ + · have h' : v.2 ≠ 0 := by + intro hzero + exact hv (Prod.ext (not_ne_iff.mp h) hzero) + exact ⟨Prod.snd, h', fun _ _ => rfl, + by intros; simp, fun x => by simpa using norm_snd_le x⟩ + obtain ⟨q, hq, hadd, hsmul, hnorm⟩ := coord + intro hb + have hall : Bornology.IsBounded (Set.range D.position) := by + apply ((hF.image D.position).isBounded.union hb).subset + rintro x ⟨a, rfl⟩ + by_cases ha : a ∈ F + · exact Or.inl ⟨a, ha, rfl⟩ + · exact Or.inr ⟨a, ha, rfl⟩ + obtain ⟨B, _, hB⟩ := hall.exists_pos_norm_le + obtain ⟨a⟩ := (inferInstance : Nonempty ι) + have hc : 0 < |q v| := abs_pos.mpr hq + obtain ⟨n, hn⟩ := exists_nat_gt ((B + |q (D.position a)|) / |q v|) + have hlarge : B + |q (D.position a)| < (n : Real) * |q v| := + (div_lt_iff₀ hc).mp hn + have hpos : D.position (P.shift (n • u) a) = D.position a + n • v := by + rw [D.position_periodic] + congr 1 + ext <;> simp [v, GaussianRealPoint] + have hrev : (n : Real) * |q v| ≤ + |q (D.position a) + (n : Real) * q v| + |q (D.position a)| := by + calc + (n : Real) * |q v| = |(n : Real) * q v| := by + have hnabs : |(n : Real)| = (n : Real) := abs_of_nonneg (Nat.cast_nonneg n) + rw [abs_mul, hnabs] + _ = |(q (D.position a) + (n : Real) * q v) - q (D.position a)| := by + congr 1 + ring + _ ≤ _ := abs_sub _ _ + have hcoord : |q (D.position a) + (n : Real) * q v| ≤ B := by + have hh := (hnorm (D.position (P.shift (n • u) a))).trans + (hB _ (Set.mem_range_self _)) + simpa only [hpos, hadd, hsmul] using hh + linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedArcExterior.lean b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedArcExterior.lean new file mode 100644 index 0000000000..7249f92841 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedArcExterior.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting +public import Mathlib.Topology.Order.DenselyOrdered +public import Mathlib.Tactic.FinCases + +-- [TABLET NODE: P3913T1RoutedArcExterior] + +/-! +# P3913T1RoutedArcExterior + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3913T1RoutedArcExterior {ι : Type} (P : PeriodicTileComplex ι) + (D : P3723T1AllContactRouting P) (f : P.plane.Face) + (U V : Set (Real × Real)) (hU : IsOpen U) (hV : IsOpen V) + (hd : Disjoint U V) + (hp : U ∪ V = (D.edgeArc (P.plane.faceVertex f 0) (P.plane.faceVertex f 1) ∪ + D.edgeArc (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) ∪ + D.edgeArc (P.plane.faceVertex f 2) (P.plane.faceVertex f 0))ᶜ) + (hout : ∀ a, a ∉ Set.range (P.plane.faceVertex f) → D.position a ∈ V) : + let J := D.edgeArc (P.plane.faceVertex f 0) (P.plane.faceVertex f 1) ∪ + D.edgeArc (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) ∪ + D.edgeArc (P.plane.faceVertex f 2) (P.plane.faceVertex f 0) + (Set.range D.position ⊆ J ∪ V) ∧ + (∀ a b, P.plane.adjacent a b → + (a ∉ Set.range (P.plane.faceVertex f) ∨ + b ∉ Set.range (P.plane.faceVertex f)) → + D.edgeArc a b \ {D.position a, D.position b} ⊆ V) ∧ + ∀ a b, P.plane.adjacent a b → D.edgeArc a b ⊆ J ∪ V := by +-- BODY + classical + dsimp only + let J := D.edgeArc (P.plane.faceVertex f 0) (P.plane.faceVertex f 1) ∪ + D.edgeArc (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) ∪ + D.edgeArc (P.plane.faceVertex f 2) (P.plane.faceVertex f 0) + have contact (a b : ι) (hab : P.plane.adjacent a b) : + P3723T1EdgeContact P a b := + ⟨(fun e => P.plane.adjacent_irreflexive a (e.symm ▸ hab)), + P.adjacent_has_common_edge a b hab⟩ + have faceArc_sub (i j : Fin 3) (hij : i ≠ j) : + D.edgeArc (P.plane.faceVertex f i) (P.plane.faceVertex f j) ⊆ J := by + intro x hx + fin_cases i <;> fin_cases j <;> dsimp [J] at * + all_goals try exact (hij rfl).elim + all_goals first + | exact Or.inl (Or.inl hx) + | exact Or.inl (Or.inr hx) + | exact Or.inr hx + | rw [D.edgeArc_symmetric] at hx + first + | exact Or.inl (Or.inl hx) + | exact Or.inl (Or.inr hx) + | exact Or.inr hx + have facePos (i : Fin 3) : D.position (P.plane.faceVertex f i) ∈ J := by + have hi : i ≠ i + 1 := by fin_cases i <;> decide + obtain ⟨e, he, _⟩ := D.edgeArc_homeomorph _ _ + (contact _ _ (P.plane.face_edges f i (i + 1) hi)) + apply faceArc_sub i (i + 1) hi + rw [← he] + exact (e ⟨0, by norm_num⟩).property + have pos : Set.range D.position ⊆ J ∪ V := by + rintro x ⟨a, rfl⟩ + by_cases ha : a ∈ Set.range (P.plane.faceVertex f) + · obtain ⟨i, rfl⟩ := ha + exact Or.inl (facePos i) + · exact Or.inr (hout a ha) + have pair_mem (x : ι) (i j : Fin 3) + (hx : x ∈ ({P.plane.faceVertex f i, P.plane.faceVertex f j} : Set ι)) : + x ∈ Set.range (P.plane.faceVertex f) := by + rcases Set.mem_insert_iff.mp hx with h | h + · exact ⟨i, h.symm⟩ + · exact ⟨j, (Set.mem_singleton_iff.mp h).symm⟩ + have openArc (a b : ι) (hab : P.plane.adjacent a b) + (ha : a ∉ Set.range (P.plane.faceVertex f) ∨ + b ∉ Set.range (P.plane.faceVertex f)) : + D.edgeArc a b \ {D.position a, D.position b} ⊆ V := by + let H := D.edgeArc a b \ {D.position a, D.position b} + have hmiss : Disjoint H J := by + have misses (i j : Fin 3) (hij : i ≠ j) : + Disjoint H (D.edgeArc (P.plane.faceVertex f i) (P.plane.faceVertex f j)) := by + have hne : ({a, b} : Set ι) ≠ + {P.plane.faceVertex f i, P.plane.faceVertex f j} := by + intro heq + rcases ha with ha | hb + · apply ha + exact pair_mem a i j (heq ▸ (by simp)) + · apply hb + exact pair_mem b i j (heq ▸ (by simp)) + apply Set.disjoint_left.mpr + intro x hx hy + have hxint : x ∈ D.position '' (({a, b} : Set ι) ∩ + {P.plane.faceVertex f i, P.plane.faceVertex f j}) := by + rw [← D.edgeArc_intersections a b _ _ (contact a b hab) + (contact _ _ (P.plane.face_edges f i j hij)) hne] + exact ⟨hx.1, hy⟩ + obtain ⟨w, hw, hwx⟩ := hxint + apply hx.2 + rcases Set.mem_insert_iff.mp hw.1 with hw | hw + · simp [← hwx, hw] + · simp [← hwx, Set.mem_singleton_iff.mp hw] + apply Set.disjoint_left.mpr + intro x hx hxJ + rcases hxJ with (hxJ | hxJ) | hxJ + · exact Set.disjoint_left.mp (misses 0 1 (by decide)) hx hxJ + · exact Set.disjoint_left.mp (misses 1 2 (by decide)) hx hxJ + · exact Set.disjoint_left.mp (misses 2 0 (by decide)) hx hxJ + obtain ⟨g, hg, hgi, hgr, hg0, hg1, _⟩ := + D.edgeArc_parameterization a b (contact a b hab) + let t0 : Set.Icc (0 : Real) 1 := ⟨0, by norm_num⟩ + let t1 : Set.Icc (0 : Real) 1 := ⟨1, by norm_num⟩ + have hne : t0 ≠ t1 := by + intro h + have hh := congrArg Subtype.val h + norm_num [t0, t1] at hh + have hrange : g '' Set.Ioo t0 t1 = H := by + ext x + constructor + · rintro ⟨t, ht, rfl⟩ + refine ⟨hgr ▸ Set.mem_range_self t, ?_⟩ + intro hx + rcases Set.mem_insert_iff.mp hx with hx | hx + · have heq : t = t0 := hgi (hx.trans hg0.symm) + exact (ne_of_gt ht.1) heq + · have heq : t = t1 := hgi ((Set.mem_singleton_iff.mp hx).trans hg1.symm) + exact (ne_of_lt ht.2) heq + · intro hx + obtain ⟨t, rfl⟩ := hgr.symm ▸ hx.1 + refine ⟨t, ⟨?_, ?_⟩, rfl⟩ + · apply lt_of_le_of_ne t.property.1 + intro heq + have heq' : t0 = t := Subtype.ext heq + exact hx.2 (by simp [← heq', t0, hg0]) + · apply lt_of_le_of_ne t.property.2 + intro heq + have heq' : t = t1 := Subtype.ext heq + exact hx.2 (by simp [heq', t1, hg1]) + have hpre : IsPreconnected H := by + rw [← hrange] + exact isPreconnected_Ioo.image g hg.continuousOn + have hsub : H ⊆ U ∪ V := by + intro x hx + rw [hp] + exact fun hxJ => Set.disjoint_left.mp hmiss hx hxJ + have hcl (t : Set.Icc (0 : Real) 1) : g t ∈ closure H := by + rw [← hrange] + apply mem_closure_image hg.continuousAt + rw [closure_Ioo hne] + exact t.property + have hmeet : (H ∩ V).Nonempty := by + have he : g t0 ∈ V ∨ g t1 ∈ V := by + rcases ha with ha | hb + · exact Or.inl (hg0.symm ▸ hout a ha) + · exact Or.inr (hg1.symm ▸ hout b hb) + rcases he with he | he + · obtain ⟨x, hxV, hxH⟩ := (mem_closure_iff.mp (hcl t0)) V hV he + exact ⟨x, hxH, hxV⟩ + · obtain ⟨x, hxV, hxH⟩ := (mem_closure_iff.mp (hcl t1)) V hV he + exact ⟨x, hxH, hxV⟩ + exact hpre.subset_right_of_subset_union hU hV hd hsub hmeet + refine ⟨pos, openArc, ?_⟩ + intro a b hab x hx + by_cases ha : a ∈ Set.range (P.plane.faceVertex f) + · by_cases hb : b ∈ Set.range (P.plane.faceVertex f) + · obtain ⟨i, rfl⟩ := ha + obtain ⟨j, rfl⟩ := hb + have hij : i ≠ j := by + intro heq + subst j + exact P.plane.adjacent_irreflexive _ hab + exact Or.inl (faceArc_sub i j hij hx) + · by_cases hend : x ∈ ({D.position a, D.position b} : Set (Real × Real)) + · rcases Set.mem_insert_iff.mp hend with h | h + · exact pos ⟨a, h.symm⟩ + · exact pos ⟨b, (Set.mem_singleton_iff.mp h).symm⟩ + · exact Or.inr (openArc a b hab (Or.inr hb) ⟨hx, hend⟩) + · by_cases hend : x ∈ ({D.position a, D.position b} : Set (Real × Real)) + · rcases Set.mem_insert_iff.mp hend with h | h + · exact pos ⟨a, h.symm⟩ + · exact pos ⟨b, (Set.mem_singleton_iff.mp h).symm⟩ + · exact Or.inr (openArc a b hab (Or.inl ha) ⟨hx, hend⟩) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean new file mode 100644 index 0000000000..f121999617 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean @@ -0,0 +1,2062 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting +public import Mathlib.Algebra.BigOperators.Group.Finset.Basic + +-- [TABLET NODE: P3913T1RoutedFaceSubdivision] + +/-! +# P3913T1RoutedFaceSubdivision + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RoutedSubdivisionProof + +private theorem piece_range : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), + Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + ∀ (k : Fin 3), ∀ (r : Fin ((s k).count)), Set.range (fun t : Set.Icc ((s k).time + r.castSucc) ((s k).time r.succ) => + g k ⟨t.1, by + constructor + · exact (τ k r.castSucc).property.1.trans t.property.1 + · exact t.property.2.trans (τ k r.succ).property.2⟩) = + segment Real (w k r.castSucc) (w k r.succ))) := by + classical + intro g hi s τ w k r + let t0 := (s k).time r.castSucc + let t1 := (s k).time r.succ + have hlt : t0 < t1 := (s k).strict Fin.castSucc_lt_succ + let lo := τ k r.castSucc + let hi := τ k r.succ + obtain ⟨A, B, hA⟩ := (s k).affine_on r + have affine (t : Set.Icc t0 t1) : + g k ⟨t.1, by + constructor + · exact lo.property.1.trans t.property.1 + · exact t.property.2.trans hi.property.2⟩ = A + t.1 • B := + hA _ t.property.1 t.property.2 + have affine0 : w k r.castSucc = A + t0 • B := by + exact hA lo (by rfl) hlt.le + have affine1 : w k r.succ = A + t1 • B := by + exact hA hi hlt.le (by rfl) + rw [segment_eq_image] + ext x + constructor + · rintro ⟨t, rfl⟩ + let u := (t.1 - t0) / (t1 - t0) + have hu0 : 0 ≤ u := by + dsimp [u] + apply div_nonneg _ (sub_nonneg.mpr hlt.le) + linarith [t.property.1] + have hu1 : u ≤ 1 := by + dsimp [u] + rw [div_le_one (sub_pos.mpr hlt)] + linarith [t.property.2] + refine ⟨u, ⟨hu0, hu1⟩, ?_⟩ + have hrel : u * (t1 - t0) = t.1 - t0 := by + dsimp [u] + exact div_mul_cancel₀ _ (sub_ne_zero.mpr (ne_of_gt hlt)) + have hlin : t.1 = (1 - u) * t0 + u * t1 := by nlinarith [hrel] + change (1 - u) • w k r.castSucc + u • w k r.succ = + g k ⟨t.1, by + constructor + · exact lo.property.1.trans t.property.1 + · exact t.property.2.trans hi.property.2⟩ + rw [affine t, affine0, affine1, hlin] + ext <;> simp [smul_eq_mul] <;> ring + · rintro ⟨u, hu, hx⟩ + let t : Set.Icc t0 t1 := ⟨t0 + u * (t1 - t0), by + constructor <;> nlinarith [hu.1, hu.2, hlt] + ⟩ + refine ⟨t, ?_⟩ + change g k ⟨t.1, by + constructor + · exact lo.property.1.trans t.property.1 + · exact t.property.2.trans hi.property.2⟩ = x + rw [affine t] + have heq : t.1 = (1 - u) * t0 + u * t1 := by + dsimp [t] + ring + rw [heq] + have hmid : A + ((1 - u) * t0 + u * t1) • B = + (1 - u) • (A + t0 • B) + u • (A + t1 • B) := by + ext <;> simp [smul_eq_mul] <;> ring + rw [hmid, ← affine0, ← affine1] + change (fun θ => (1 - θ) • w k r.castSucc + θ • w k r.succ) u = x + exact hx + +private theorem join : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f + : P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + (∀ (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((∀ (k : Fin (3 : ℕ)), g k ⟨(0 : + ℝ), (by norm_num)⟩ = D.position (P.plane.faceVertex f k)) → ((∀ (k : Fin (3 : ℕ)), g + k ⟨(1 : ℝ), (by norm_num)⟩ = D.position (P.plane.faceVertex f (k + + (1 : Fin (3 : ℕ))))) → (∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization + (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + ∀ (k : Fin (3 : ℕ)), w k (Fin.last (s k).count) = w (k + (1 : Fin (3 : ℕ))) (0 : Fin ((s + (k + (1 : Fin (3 : ℕ)))).count + (1 : ℕ))))))) := by + classical + intro ι P D f g hi h0 h1 s τ w k + have hlast : τ k (Fin.last (s k).count) = ⟨1, by norm_num⟩ := by + apply Subtype.ext + simp [τ, (s k).finish] + have hfirst : τ (k + 1) 0 = ⟨0, by norm_num⟩ := by + apply Subtype.ext + simp [τ, (s (k + 1)).start] + simp only [w, hlast, hfirst] + exact (h1 k).trans (h0 (k + 1)).symm + +private theorem retained : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), + Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let n := M - 3 + ∀ (hM : n + 3 = M), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases + (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases + (fun i : Fin m1 => w 1 i.castSucc) + (fun i : Fin m2 => w 2 i.castSucc)) + let p : Fin (n + 3) → Real × Real := fun i => q (Fin.cast hM i) + (∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc) → ((∀ (i : Fin m1), q + (Fin.natAdd m0 (Fin.castAdd m2 i)) = w 1 i.castSucc) → ((∀ (i : Fin m2), q + (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc) → ((∀ (i : Fin M), p (Fin.cast + hM.symm i) = q i) → ((∀ (k : Fin 3), w k (Fin.last (s k).count) = w (k + 1) 0) → (∀ + (k : Fin (3 : ℕ)), ∀ (i : Fin ((s k).count + (1 : ℕ))), w k i ∈ Set.range p))))))) := by + classical + intro g hi s m0 m1 m2 M n hM τ w q p q0 q1 q2 p_at join k i + fin_cases k + · refine Fin.lastCases ?_ ?_ i + · let j : Fin m1 := ⟨0, (s 1).positive⟩ + have hj : j.castSucc = (0 : Fin (m1 + 1)) := by + apply Fin.ext + rfl + refine ⟨Fin.cast hM.symm (Fin.natAdd m0 (Fin.castAdd m2 j)), ?_⟩ + rw [p_at, q1] + rw [hj] + exact (join 0).symm + · intro r + refine ⟨Fin.cast hM.symm (Fin.castAdd (m1 + m2) r), ?_⟩ + rw [p_at, q0] + rfl + · refine Fin.lastCases ?_ ?_ i + · let j : Fin m2 := ⟨0, (s 2).positive⟩ + have hj : j.castSucc = (0 : Fin (m2 + 1)) := by + apply Fin.ext + rfl + refine ⟨Fin.cast hM.symm (Fin.natAdd m0 (Fin.natAdd m1 j)), ?_⟩ + rw [p_at, q2] + rw [hj] + exact (join 1).symm + · intro r + refine ⟨Fin.cast hM.symm (Fin.natAdd m0 (Fin.castAdd m2 r)), ?_⟩ + rw [p_at, q1] + rfl + · refine Fin.lastCases ?_ ?_ i + · let j : Fin m0 := ⟨0, (s 0).positive⟩ + have hj : j.castSucc = (0 : Fin (m0 + 1)) := by + apply Fin.ext + rfl + refine ⟨Fin.cast hM.symm (Fin.castAdd (m1 + m2) j), ?_⟩ + rw [p_at, q0] + rw [hj] + exact (join 2).symm + · intro r + refine ⟨Fin.cast hM.symm (Fin.natAdd m0 (Fin.natAdd m1 r)), ?_⟩ + rw [p_at, q2] + rfl + +private theorem pair_ne : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (f : P.plane.Face), ∀ (g : Fin (3 : ℕ) → + (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ((k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)) → ( + let v : Fin 3 → ι := P.plane.faceVertex f + ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), i ≠ j → ({v i, v (i + (1 : Fin (3 : ℕ)))} : Set + ι) ≠ {v j, v (j + (1 : Fin (3 : ℕ)))}) + ) := by + classical + intro ι P f g s v i j hij he + rw [Set.pair_eq_pair_iff] at he + rcases he with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ + · exact hij (P.plane.face_vertices_distinct f h₁) + · have hleft : i = j + 1 := P.plane.face_vertices_distinct f h₁ + have hright : i + 1 = j := P.plane.face_vertices_distinct f h₂ + fin_cases i <;> fin_cases j + all_goals omega + +private theorem w_ne_finish : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ + (k : Fin (3 : ℕ)), Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ (k : Fin 3), w k (Fin.last (s k).count) = D.position (v (k + 1))) → (∀ (k : Fin (3 : + ℕ)), ∀ (i : Fin (s k).count), w k i.castSucc ≠ D.position (v (k + (1 : Fin (3 : + ℕ))))))) := by + classical + intro ι P D f g hi s τ w v w_finish k i h + have hg : g k (τ k i.castSucc) = g k (τ k (Fin.last (s k).count)) := + h.trans (w_finish k).symm + have ht := hi k hg + have htime := congrArg Subtype.val ht + have hidx : i.castSucc = Fin.last (s k).count := (s k).strict.injective htime + have hv := congrArg Fin.val hidx + simp at hv + omega + +private theorem q_injective : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), + Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases + (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases + (fun i : Fin m1 => w 1 i.castSucc) + (fun i : Fin m2 => w 2 i.castSucc)) + (∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc) → ((∀ (i : Fin m1), q + (Fin.natAdd m0 (Fin.castAdd m2 i)) = w 1 i.castSucc) → ((∀ (i : Fin m2), q + (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc) → ((∀ (i : Fin m0), ∀ (j : Fin + m1), (w 0 i.castSucc = w 1 j.castSucc) → (False)) → ((∀ (i : Fin m1), ∀ (j : Fin m2), + (w 1 i.castSucc = w 2 j.castSucc) → (False)) → ((∀ (i : Fin m0), ∀ (j : Fin m2), (w 0 + i.castSucc = w 2 j.castSucc) → (False)) → ((∀ (k : Fin 3), Function.Injective (fun i + : Fin (s k).count => w k i.castSucc)) → (Function.Injective q))))))))) := by + classical + intro g hi s m0 m1 m2 M τ w q q0 q1 q2 no_cross01 no_cross12 no_cross02 w_block_injective a b hab + revert b + refine Fin.addCases ?_ ?_ a + · intro i b + refine Fin.addCases ?_ ?_ b + · intro j h + have h' : w 0 i.castSucc = w 0 j.castSucc := by simpa only [q0] using h + exact congrArg (Fin.castAdd (m1 + m2)) (w_block_injective 0 h') + · intro r + refine Fin.addCases ?_ ?_ r + · intro j h + have h' : w 0 i.castSucc = w 1 j.castSucc := by simpa only [q0, q1] using h + exact (no_cross01 i j h').elim + · intro j h + have h' : w 0 i.castSucc = w 2 j.castSucc := by simpa only [q0, q2] using h + exact (no_cross02 i j h').elim + · intro r b + refine Fin.addCases ?_ ?_ b + · intro i h + revert h + refine Fin.addCases ?_ ?_ r + · intro j h + have h'' : w 1 j.castSucc = w 0 i.castSucc := by + simpa only [q1, q0] using h + exact (no_cross01 i j h''.symm).elim + · intro j h + have h'' : w 2 j.castSucc = w 0 i.castSucc := by + simpa only [q2, q0] using h + exact (no_cross02 i j h''.symm).elim + · intro r' h + revert h + refine Fin.addCases ?_ ?_ r' + · intro j h + revert h + refine Fin.addCases ?_ ?_ r + · intro i h + have h' : w 1 i.castSucc = w 1 j.castSucc := by + simpa only [q1] using h + exact congrArg (fun z : Fin m1 => Fin.natAdd m0 (Fin.castAdd m2 z)) + (w_block_injective 1 h') + · intro i h + have h' : w 2 i.castSucc = w 1 j.castSucc := by + simpa only [q2, q1] using h + exact (no_cross12 j i h'.symm).elim + · intro j h + revert h + refine Fin.addCases ?_ ?_ r + · intro i h + have h' : w 1 i.castSucc = w 2 j.castSucc := by + simpa only [q1, q2] using h + exact (no_cross12 i j h').elim + · intro i h + have h' : w 2 i.castSucc = w 2 j.castSucc := by + simpa only [q2] using h + exact congrArg (fun z : Fin m2 => Fin.natAdd m0 (Fin.natAdd m1 z)) + (w_block_injective 2 h') + +private theorem finite_interval_cover : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ((k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)) → (∀ N, ∀ (a : Fin (N + 1) → Real), + StrictMono a → ∀ x, a 0 ≤ x → x ≤ a (Fin.last N) → 0 < N → ∃ r : Fin N, a r.castSucc + ≤ x ∧ x ≤ a r.succ) + ) := by + classical + intro g s N + induction N with + | zero => + intro a ha x hlo hhi hpos + omega + | succ N ih => + intro a ha x hlo hhi hpos + by_cases hN : N = 0 + · subst N + by_cases hfirst : x ≤ a 1 + · exact ⟨0, by simpa using hlo, hfirst⟩ + · have hlt : a 1 < x := lt_of_not_ge hfirst + have hlast : Fin.last 1 = (1 : Fin 2) := by ext; rfl + rw [hlast] at hhi + exact False.elim ((not_lt_of_ge hhi) hlt) + · have hNpos : 0 < N := Nat.pos_of_ne_zero hN + by_cases hfirst : x ≤ a 1 + · refine ⟨0, ?_, hfirst⟩ + simpa using hlo + · let tail : Fin (N + 1) → Real := fun i => a i.succ + have htail : StrictMono tail := fun i j hij => ha (Fin.succ_lt_succ_iff.mpr hij) + have hlo' : tail 0 ≤ x := by + dsimp [tail] + exact le_of_lt (lt_of_not_ge hfirst) + have hhi' : x ≤ tail (Fin.last N) := by + simpa [tail] using hhi + obtain ⟨r, hr₀, hr₁⟩ := ih tail htail x hlo' hhi' hNpos + refine ⟨r.succ, ?_, ?_⟩ + · simpa using hr₀ + · simpa using hr₁ + +private theorem arc_covered : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ + (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((∀ (k : Fin (3 : ℕ)), Set.range (g k) + = D.edgeArc (P.plane.faceVertex f k) (P.plane.faceVertex f (k + (1 : Fin (3 : ℕ))))) + → (∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + (∀ (k : Fin 3), ∀ (r : Fin ((s k).count)), Set.range (fun t : Set.Icc ((s k).time + r.castSucc) ((s k).time r.succ) => + g k ⟨t.1, by + constructor + · exact (τ k r.castSucc).property.1.trans t.property.1 + · exact t.property.2.trans (τ k r.succ).property.2⟩) = + segment Real (w k r.castSucc) (w k r.succ)) → ( + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ N, ∀ (a : Fin (N + 1) → Real), StrictMono a → ∀ x, a 0 ≤ x → x ≤ a (Fin.last N) → 0 < + N → ∃ r : Fin N, a r.castSucc ≤ x ∧ x ≤ a r.succ) → (∀ (k : Fin (3 : ℕ)), D.edgeArc + (v k) (v (k + (1 : Fin (3 : ℕ)))) = ⋃ (r : Fin (s k).count), segment ℝ (w k + r.castSucc) (w k r.succ)))))) := by + classical + intro ι P D f g hi hr s τ w piece_range v finite_interval_cover k + rw [← hr k] + ext x + constructor + · rintro ⟨t, rfl⟩ + have hlo : (s k).time 0 ≤ (t : Real) := by + rw [(s k).start] + exact t.property.1 + have hhi : (t : Real) ≤ (s k).time (Fin.last (s k).count) := by + rw [(s k).finish] + exact t.property.2 + obtain ⟨r, hlo, hhi⟩ := finite_interval_cover (s k).count (s k).time + (s k).strict (t : Real) hlo hhi (s k).positive + refine Set.mem_iUnion.mpr ⟨r, ?_⟩ + rw [← piece_range k r] + exact ⟨⟨t, ⟨hlo, hhi⟩⟩, rfl⟩ + · intro hx + obtain ⟨r, hx⟩ := Set.mem_iUnion.mp hx + rw [← piece_range k r] at hx + obtain ⟨t, ht⟩ := Set.mem_range.mp hx + refine ⟨⟨t, by + constructor + · exact (τ k r.castSucc).property.1.trans t.property.1 + · exact t.property.2.trans (τ k r.succ).property.2⟩, ?_⟩ + simpa using ht + +private theorem q_step : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), + Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let n := M - 3 + (n + 3 = M) → ( + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases + (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases + (fun i : Fin m1 => w 1 i.castSucc) + (fun i : Fin m2 => w 2 i.castSucc)) + (∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc) → ((∀ (i : Fin m1), q + (Fin.natAdd m0 (Fin.castAdd m2 i)) = w 1 i.castSucc) → ((∀ (i : Fin m2), q + (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc) → ((∀ (k : Fin 3), w k (Fin.last + (s k).count) = w (k + 1) 0) → ( + ∀ (a : Fin M), ∀ (ha : (↑a : ℕ) + (1 : ℕ) < M), ∃ (k : Fin (3 : ℕ)) (r : Fin (s + k).count), q a = w k r.castSucc ∧ q ⟨(↑a : ℕ) + (1 : ℕ), ha⟩ = w k r.succ))))))) := by + classical + intro g hi s m0 m1 m2 M n hM τ w q q0 q1 q2 join a ha + let b0 (i : Fin m0) : Fin M := Fin.castAdd (m1 + m2) i + let b1 (i : Fin m1) : Fin M := Fin.natAdd m0 (Fin.castAdd m2 i) + let b2 (i : Fin m2) : Fin M := Fin.natAdd m0 (Fin.natAdd m1 i) + revert ha + refine Fin.addCases ?_ ?_ a + · intro r ha + by_cases hr : r.val + 1 < m0 + · let r' : Fin m0 := ⟨r.val + 1, hr⟩ + have hindex : ⟨(b0 r).val + 1, ha⟩ = b0 r' := by + apply Fin.ext + change r.val + 1 = r'.val + rfl + have htime : r.succ = r'.castSucc := by + apply Fin.ext + simp [r'] + refine ⟨0, r, ?_, ?_⟩ + · simpa [b0] using q0 r + · rw [hindex] + simpa [b0, htime] using q0 r' + · have hlt : r.val < m0 := by simp [m0] + have hr' : r.val + 1 = m0 := by omega + let j : Fin m1 := ⟨0, (s 1).positive⟩ + have hindex : ⟨(b0 r).val + 1, ha⟩ = b1 j := by + apply Fin.ext + simp [b0, b1, hr', j] + have htime : r.succ = Fin.last m0 := by + apply Fin.ext + simp [hr'] + refine ⟨0, r, ?_, ?_⟩ + · simpa [b0] using q0 r + · rw [hindex, q1, htime] + simpa [j] using (join 0).symm + · intro r ha + revert ha + refine Fin.addCases ?_ ?_ r + · intro i ha + by_cases hi' : i.val + 1 < m1 + · let i' : Fin m1 := ⟨i.val + 1, hi'⟩ + have hindex : ⟨(b1 i).val + 1, ha⟩ = b1 i' := by + apply Fin.ext + change m0 + i.val + 1 = m0 + i'.val + simp [i']; omega + have htime : i.succ = i'.castSucc := by + apply Fin.ext + simp [i'] + refine ⟨1, i, ?_, ?_⟩ + · simpa [b1] using q1 i + · rw [hindex] + simpa [b1, htime] using q1 i' + · have hi'' : i.val + 1 = m1 := by omega + let j : Fin m2 := ⟨0, (s 2).positive⟩ + have hindex : ⟨(b1 i).val + 1, ha⟩ = b2 j := by + apply Fin.ext + simp [b1, b2, j] + omega + have htime : i.succ = Fin.last m1 := by + apply Fin.ext + simp [hi''] + refine ⟨1, i, ?_, ?_⟩ + · simpa [b1] using q1 i + · rw [hindex, q2, htime] + simpa [j] using (join 1).symm + · intro i ha + by_cases hi' : i.val + 1 < m2 + · let i' : Fin m2 := ⟨i.val + 1, hi'⟩ + have hindex : ⟨(b2 i).val + 1, ha⟩ = b2 i' := by + apply Fin.ext + change m0 + (m1 + i.val) + 1 = m0 + (m1 + i'.val) + simp [i']; omega + have htime : i.succ = i'.castSucc := by + apply Fin.ext + simp [i'] + refine ⟨2, i, ?_, ?_⟩ + · simpa [b2] using q2 i + · rw [hindex] + simpa [b2, htime] using q2 i' + · have hi'' : i.val + 1 = m2 := by omega + have hval : (b2 i).val + 1 = m0 + (m1 + m2) := by + change m0 + (m1 + i.val) + 1 = m0 + (m1 + m2) + omega + have ha' : (b2 i).val + 1 < m0 + (m1 + m2) := by + exact ha + omega + +private theorem p_edge_piece : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), + Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let n := M - 3 + ∀ (hM : n + 3 = M), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases + (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases + (fun i : Fin m1 => w 1 i.castSucc) + (fun i : Fin m2 => w 2 i.castSucc)) + let p : Fin (n + 3) → Real × Real := fun i => q (Fin.cast hM i) + (∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc) → ((∀ (i : Fin m2), q + (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc) → ((∀ (k : Fin 3), w k (Fin.last + (s k).count) = w (k + 1) 0) → ( + (∀ (a : Fin M), ∀ (ha : a.val + 1 < M), ∃ k : Fin 3, ∃ r : Fin (s k).count, q a = w k + r.castSucc ∧ q ⟨a.val + 1, ha⟩ = w k r.succ) → (∀ (i : Fin (n + (3 : ℕ))), ∃ (k : Fin + (3 : ℕ)) (r : Fin (s k).count), p i = w k r.castSucc ∧ p (i + (1 : Fin (n + (3 : + ℕ)))) = w k r.succ)))))) := by + classical + intro g hi s m0 m1 m2 M n hM τ w q p q0 q2 join q_step i + let b0 (i : Fin m0) : Fin M := Fin.castAdd (m1 + m2) i + let b2 (i : Fin m2) : Fin M := Fin.natAdd m0 (Fin.natAdd m1 i) + refine Fin.lastCases ?_ ?_ i + · have hm2 : 0 < m2 := (s 2).positive + let r : Fin m2 := ⟨m2 - 1, by omega⟩ + have hr : r.val + 1 = m2 := by simp [r]; omega + have hindex : Fin.cast hM (Fin.last (n + 2)) = b2 r := by + apply Fin.ext + change n + 2 = m0 + (m1 + (m2 - 1)) + omega + have hnext : Fin.last (n + 2) + 1 = (0 : Fin (n + 3)) := by + apply Fin.ext + simp [] + have hleft : p (Fin.last (n + 2)) = w 2 r.castSucc := by + change q (Fin.cast hM (Fin.last (n + 2))) = _ + rw [hindex, q2] + have hright : p (Fin.last (n + 2) + 1) = w 2 r.succ := by + rw [hnext] + have hrLast : r.succ = Fin.last m2 := by + apply Fin.ext + simp [hr] + let z : Fin (n + 3) := ⟨0, by omega⟩ + let zM : Fin M := ⟨0, by omega⟩ + change q (Fin.cast hM z) = w 2 r.succ + have hz : Fin.cast hM z = zM := by + apply Fin.ext + rfl + have hm0 : 0 < m0 := (s 0).positive + let z0 : Fin m0 := ⟨0, by omega⟩ + have hz0 : zM = b0 z0 := by + apply Fin.ext + rfl + have hzstart : z0.castSucc = (⟨0, by omega⟩ : Fin (m0 + 1)) := by + apply Fin.ext + rfl + rw [hz, hz0, q0, hzstart, hrLast] + exact (join 2).symm + exact ⟨2, r, hleft, hright⟩ + · intro j + let a : Fin M := Fin.cast hM j.castSucc + have ha : a.val + 1 < M := by + change j.val + 1 < M + have hj := j.isLt + omega + obtain ⟨k, r, hleft, hright⟩ := q_step a ha + have hnext : Fin.cast hM (j.castSucc + 1) = ⟨a.val + 1, ha⟩ := by + apply Fin.ext + simp [a] + have hp0 : p j.castSucc = q a := by + simp [p, a] + have hp1 : p (j.castSucc + 1) = q ⟨a.val + 1, ha⟩ := by + change q (Fin.cast hM (j.castSucc + 1)) = _ + rw [hnext] + exact ⟨k, r, hp0.trans hleft, hp1.trans hright⟩ + +private theorem block_edge : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), + Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let n := M - 3 + ∀ (hM : n + 3 = M), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases + (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases + (fun i : Fin m1 => w 1 i.castSucc) + (fun i : Fin m2 => w 2 i.castSucc)) + let p : Fin (n + 3) → Real × Real := fun i => q (Fin.cast hM i) + (∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc) → ((∀ (i : Fin m1), q + (Fin.natAdd m0 (Fin.castAdd m2 i)) = w 1 i.castSucc) → ((∀ (i : Fin m2), q + (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc) → ((∀ (k : Fin 3), w k (Fin.last + (s k).count) = w (k + 1) 0) → ( + (∀ (i : Fin (n + 3)), (i.val + 1 < n + 3) → ((i + 1).val = i.val + 1)) → (∀ (k : Fin (3 : + ℕ)), ∀ (r : Fin (s k).count), ∃ (i : Fin (n + (3 : ℕ))), p i = w k r.castSucc ∧ p (i + + (1 : Fin (n + (3 : ℕ)))) = w k r.succ))))))) := by + classical + intro g hi s m0 m1 m2 M n hM τ w q p q0 q1 q2 join fin_succ_val k r + let b0 (i : Fin m0) : Fin M := Fin.castAdd (m1 + m2) i + let b1 (i : Fin m1) : Fin M := Fin.natAdd m0 (Fin.castAdd m2 i) + let b2 (i : Fin m2) : Fin M := Fin.natAdd m0 (Fin.natAdd m1 i) + fin_cases k + · by_cases hr : r.val + 1 < m0 + · let r' : Fin m0 := ⟨r.val + 1, hr⟩ + let i : Fin (n + 3) := Fin.cast hM.symm (b0 r) + have hnext : Fin.cast hM (i + 1) = b0 r' := by + apply Fin.ext + simp [i, b0, r', Fin.val_add] + omega + refine ⟨i, ?_, ?_⟩ + · simpa [i, p, b0] using q0 r + · change q (Fin.cast hM (i + 1)) = _ + rw [hnext, q0] + have ht : r.succ = r'.castSucc := by + apply Fin.ext + simp [r'] + simp [ht] + · have hlt : r.val < m0 := by simp [m0] + have hr' : r.val + 1 = m0 := by omega + have hm1 : 0 < m1 := (s 1).positive + let j : Fin m1 := ⟨0, by omega⟩ + let i : Fin (n + 3) := Fin.cast hM.symm (b0 r) + have hval : i.val = r.val := by simp [i, b0] + have hbound : i.val + 1 < n + 3 := by + have hboundM : i.val + 1 < M := by + change i.val + 1 < m0 + (m1 + m2) + rw [hval] + omega + omega + have hnext : Fin.cast hM (i + 1) = b1 j := by + apply Fin.ext + simp only [Fin.val_cast] + rw [fin_succ_val i hbound] + simp [i, b0, b1, j, hr'] + have ht : r.succ = Fin.last m0 := by + apply Fin.ext + simp [hr'] + refine ⟨i, ?_, ?_⟩ + · simpa [i, p, b0] using q0 r + · change q (Fin.cast hM (i + 1)) = _ + rw [hnext, q1] + rw [ht] + simpa [j] using (join 0).symm + · by_cases hr : r.val + 1 < m1 + · let r' : Fin m1 := ⟨r.val + 1, hr⟩ + let i : Fin (n + 3) := Fin.cast hM.symm (b1 r) + have hval : i.val = m0 + r.val := by simp [i, b1] + have hbound : i.val + 1 < n + 3 := by + have hboundM : i.val + 1 < M := by + change i.val + 1 < m0 + (m1 + m2) + rw [hval] + omega + omega + have hnext : Fin.cast hM (i + 1) = b1 r' := by + apply Fin.ext + simp only [Fin.val_cast] + rw [fin_succ_val i hbound] + simp [i, b1, r']; omega + refine ⟨i, ?_, ?_⟩ + · simpa [i, p, b1] using q1 r + · change q (Fin.cast hM (i + 1)) = _ + rw [hnext, q1] + have ht : r.succ = r'.castSucc := by + apply Fin.ext + simp [r'] + simp [ht] + · have hlt : r.val < m1 := by simp [m1] + have hr' : r.val + 1 = m1 := by omega + have hm2 : 0 < m2 := (s 2).positive + let j : Fin m2 := ⟨0, by omega⟩ + let i : Fin (n + 3) := Fin.cast hM.symm (b1 r) + have hval : i.val = m0 + r.val := by simp [i, b1] + have hbound : i.val + 1 < n + 3 := by + have hboundM : i.val + 1 < M := by + change i.val + 1 < m0 + (m1 + m2) + rw [hval] + omega + omega + have hnext : Fin.cast hM (i + 1) = b2 j := by + apply Fin.ext + simp only [Fin.val_cast] + rw [fin_succ_val i hbound] + simp [i, b1, b2, j]; omega + have ht : r.succ = Fin.last m1 := by + apply Fin.ext + simp [hr'] + refine ⟨i, ?_, ?_⟩ + · simpa [i, p, b1] using q1 r + · change q (Fin.cast hM (i + 1)) = _ + rw [hnext, q2] + rw [ht] + simpa [j] using (join 1).symm + · by_cases hr : r.val + 1 < m2 + · let r' : Fin m2 := ⟨r.val + 1, hr⟩ + let i : Fin (n + 3) := Fin.cast hM.symm (b2 r) + have hval : i.val = m0 + (m1 + r.val) := by simp [i, b2] + have hbound : i.val + 1 < n + 3 := by + have hboundM : i.val + 1 < M := by + change i.val + 1 < m0 + (m1 + m2) + rw [hval] + omega + omega + have hnext : Fin.cast hM (i + 1) = b2 r' := by + apply Fin.ext + simp only [Fin.val_cast] + rw [fin_succ_val i hbound] + simp [i, b2, r']; omega + refine ⟨i, ?_, ?_⟩ + · simpa [i, p, b2] using q2 r + · change q (Fin.cast hM (i + 1)) = _ + rw [hnext, q2] + have ht : r.succ = r'.castSucc := by + apply Fin.ext + simp [r'] + simp [ht] + · have hlt : r.val < m2 := by simp [m2] + have hr' : r.val + 1 = m2 := by omega + let i : Fin (n + 3) := Fin.cast hM.symm (b2 r) + have hval : i.val = m0 + (m1 + r.val) := by simp [i, b2] + have hlast : i = Fin.last (n + 2) := by + apply Fin.ext + change i.val = (Fin.last (n + 2)).val + simp? + rw [hval] + omega + have hnext : i + 1 = (⟨0, by omega⟩ : Fin (n + 3)) := by + rw [hlast] + apply Fin.ext + simp [] + have ht : r.succ = Fin.last m2 := by + apply Fin.ext + simp [hr'] + refine ⟨i, ?_, ?_⟩ + · simpa [i, p, b2] using q2 r + · rw [hnext] + change q (Fin.cast hM (⟨0, by omega⟩ : Fin (n + 3))) = w 2 r.succ + have hm0 : 0 < m0 := (s 0).positive + let z0 : Fin m0 := ⟨0, by omega⟩ + have hz : Fin.cast hM (⟨0, by omega⟩ : Fin (n + 3)) = b0 z0 := by + apply Fin.ext + rfl + rw [hz, q0] + have hzstart : z0.castSucc = (⟨0, by omega⟩ : Fin (m0 + 1)) := by + apply Fin.ext + rfl + rw [hzstart, ht] + exact (join 2).symm + +private theorem edge_union : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), + Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let n := M - 3 + ∀ (hM : n + 3 = M), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases + (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases + (fun i : Fin m1 => w 1 i.castSucc) + (fun i : Fin m2 => w 2 i.castSucc)) + let p : Fin (n + 3) → Real × Real := fun i => q (Fin.cast hM i) + (∀ (i : Fin (n + 3)), ∃ k : Fin 3, ∃ r : Fin (s k).count, p i = w k r.castSucc ∧ p (i + + 1) = w k r.succ) → ((∀ (k : Fin 3), ∀ (r : Fin (s k).count), ∃ i : Fin (n + 3), p i = + w k r.castSucc ∧ p (i + 1) = w k r.succ) → ((⋃ i : Fin (n + 3), segment Real (p i) (p + (i + 1))) = ⋃ k : Fin 3, ⋃ r : Fin (s k).count, segment Real (w k r.castSucc) (w k + r.succ))))) := by + classical + intro g hi s m0 m1 m2 M n hM τ w q p p_edge_piece block_edge + ext x + simp only [Set.mem_iUnion] + constructor + · rintro ⟨i, hx⟩ + obtain ⟨k, r, hleft, hright⟩ := p_edge_piece i + exact ⟨k, r, by simpa [hleft, hright] using hx⟩ + · rintro ⟨k, r, hx⟩ + obtain ⟨i, hleft, hright⟩ := block_edge k r + exact ⟨i, by rw [hleft, hright]; exact hx⟩ + +private theorem piece_arc_union : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ + (k : Fin (3 : ℕ)), Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ (k : Fin 3), D.edgeArc (v k) (v (k + 1)) = ⋃ r : Fin (s k).count, segment Real (w k + r.castSucc) (w k r.succ)) → ((⋃ k : Fin 3, ⋃ r : Fin (s k).count, segment Real (w k + r.castSucc) (w k r.succ)) = ⋃ k : Fin 3, D.edgeArc (v k) (v (k + 1))))) := by + classical + intro ι P D f g hi s τ w v arc_covered + ext x + simp only [Set.mem_iUnion] + constructor + · rintro ⟨k, r, hx⟩ + exact ⟨k, (arc_covered k).symm ▸ Set.mem_iUnion.mpr ⟨r, hx⟩⟩ + · rintro ⟨k, hx⟩ + rw [arc_covered k] at hx + obtain ⟨r, hx⟩ := Set.mem_iUnion.mp hx + exact ⟨k, r, hx⟩ + +private theorem arc_union : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), + let v : Fin 3 → ι := P.plane.faceVertex f + (⋃ k : Fin 3, D.edgeArc (v k) (v (k + 1))) = D.edgeArc (v 0) (v 1) ∪ D.edgeArc (v 1) (v + 2) ∪ D.edgeArc (v 2) (v 0) + ) := by + classical + intro ι P D f v + ext x + simp only [Set.mem_iUnion, Set.mem_union] + constructor + · rintro ⟨k, hx⟩ + fin_cases k + · exact Or.inl (Or.inl (by simpa using hx)) + · exact Or.inl (Or.inr (by simpa using hx)) + · exact Or.inr (by simpa using hx) + · intro hx + rcases hx with hx | hx + · rcases hx with hx | hx + · exact ⟨0, by simpa using hx⟩ + · exact ⟨1, by simpa using hx⟩ + · exact ⟨2, by simpa using hx⟩ + +private theorem piece_start_corner : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f + : P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + (∀ (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((∀ (k : Fin (3 : ℕ)), g k ⟨(0 : + ℝ), (by norm_num)⟩ = D.position (P.plane.faceVertex f k)) → (∀ (s : (k : Fin + (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + (∀ (k : Fin 3), ∀ (r : Fin ((s k).count)), Set.range (fun t : Set.Icc ((s k).time + r.castSucc) ((s k).time r.succ) => + g k ⟨t.1, by + constructor + · exact (τ k r.castSucc).property.1.trans t.property.1 + · exact t.property.2.trans (τ k r.succ).property.2⟩) = + segment Real (w k r.castSucc) (w k r.succ)) → ( + let v : Fin 3 → ι := P.plane.faceVertex f + ∀ (k : Fin (3 : ℕ)), ∀ (r : Fin (s k).count), ∀ x ∈ segment ℝ (w k r.castSucc) (w k + r.succ), x = D.position (v k) → x = w k r.castSucc ∨ x = w k r.succ)))) := by + classical + intro ι P D f g hi h0 s τ w piece_range v k r x hx hc + rw [← piece_range k r] at hx + obtain ⟨t, ht⟩ := Set.mem_range.mp hx + let u : Set.Icc (0 : Real) 1 := ⟨t.1, + (τ k r.castSucc).property.1.trans t.property.1, + t.property.2.trans (τ k r.succ).property.2⟩ + have htu : g k u = x := by simpa [u] using ht + have hzero : g k ⟨0, by norm_num⟩ = x := (h0 k).trans hc.symm + have hu0 : (u : Real) = 0 := by + have heq := hi k (htu.trans hzero.symm) + exact congrArg Subtype.val heq + have ht0 : (s k).time r.castSucc = 0 := by + have hmono := (s k).strict.monotone (Fin.zero_le r.castSucc) + rw [(s k).start] at hmono + have hle : (s k).time r.castSucc ≤ 0 := by + have htleft : (s k).time r.castSucc ≤ (u : Real) := by + exact t.property.1 + rw [hu0] at htleft + exact htleft + exact le_antisymm hle hmono + have huτ : u = τ k r.castSucc := by + apply Subtype.ext + exact hu0.trans ht0.symm + rw [huτ] at htu + left + change x = g k (τ k r.castSucc) + exact htu.symm + +private theorem piece_finish_corner : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f + : P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + (∀ (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((∀ (k : Fin (3 : ℕ)), g k ⟨(1 : + ℝ), (by norm_num)⟩ = D.position (P.plane.faceVertex f (k + (1 : Fin (3 : + ℕ))))) → (∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + (∀ (k : Fin 3), ∀ (r : Fin ((s k).count)), Set.range (fun t : Set.Icc ((s k).time + r.castSucc) ((s k).time r.succ) => + g k ⟨t.1, by + constructor + · exact (τ k r.castSucc).property.1.trans t.property.1 + · exact t.property.2.trans (τ k r.succ).property.2⟩) = + segment Real (w k r.castSucc) (w k r.succ)) → ( + let v : Fin 3 → ι := P.plane.faceVertex f + ∀ (k : Fin (3 : ℕ)), ∀ (r : Fin (s k).count), ∀ x ∈ segment ℝ (w k r.castSucc) (w k + r.succ), x = D.position (v (k + (1 : Fin (3 : ℕ)))) → x = w k r.castSucc ∨ x = w k + r.succ)))) := by + classical + intro ι P D f g hi h1 s τ w piece_range v k r x hx hc + rw [← piece_range k r] at hx + obtain ⟨t, ht⟩ := Set.mem_range.mp hx + let u : Set.Icc (0 : Real) 1 := ⟨t.1, + (τ k r.castSucc).property.1.trans t.property.1, + t.property.2.trans (τ k r.succ).property.2⟩ + have htu : g k u = x := by simpa [u] using ht + have hone : g k ⟨1, by norm_num⟩ = x := (h1 k).trans hc.symm + have hu1 : (u : Real) = 1 := by + have heq := hi k (htu.trans hone.symm) + exact congrArg Subtype.val heq + have ht1 : (s k).time r.succ = 1 := by + have hmono := (s k).strict.monotone (Fin.le_last r.succ) + rw [(s k).finish] at hmono + have hle : 1 ≤ (s k).time r.succ := by + have htright : (u : Real) ≤ (s k).time r.succ := by exact t.property.2 + rw [hu1] at htright + exact htright + exact le_antisymm hmono hle + have huτ : u = τ k r.succ := by + apply Subtype.ext + exact hu1.trans ht1.symm + rw [huτ] at htu + right + change x = g k (τ k r.succ) + exact htu.symm + +private theorem piece_overlap_forward : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), + Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + (∀ (k : Fin 3), ∀ (r : Fin ((s k).count)), Set.range (fun t : Set.Icc ((s k).time + r.castSucc) ((s k).time r.succ) => + g k ⟨t.1, by + constructor + · exact (τ k r.castSucc).property.1.trans t.property.1 + · exact t.property.2.trans (τ k r.succ).property.2⟩) = + segment Real (w k r.castSucc) (w k r.succ)) → (∀ (k : Fin (3 : ℕ)), ∀ (r : Fin (s + k).count), ∀ (r' : Fin (s k).count), (↑r : ℕ) < (↑r' : ℕ) → ∀ x ∈ segment ℝ (w k + r.castSucc) (w k r.succ), x ∈ segment ℝ (w k r'.castSucc) (w k r'.succ) → (x = w + k r.castSucc ∨ x = w k r.succ) ∧ (x = w k r'.castSucc ∨ x = w k r'.succ)))) := by + classical + intro g hi s τ w piece_range k r r' hlt x hx hx' + obtain ⟨t, ht⟩ := Set.mem_range.mp ((piece_range k r).symm ▸ hx) + obtain ⟨t', ht'⟩ := Set.mem_range.mp ((piece_range k r').symm ▸ hx') + let u : Set.Icc (0 : Real) 1 := ⟨t.1, + (τ k r.castSucc).property.1.trans t.property.1, + t.property.2.trans (τ k r.succ).property.2⟩ + let u' : Set.Icc (0 : Real) 1 := ⟨t'.1, + (τ k r'.castSucc).property.1.trans t'.property.1, + t'.property.2.trans (τ k r'.succ).property.2⟩ + have htu : g k u = x := by simpa [u] using ht + have htu' : g k u' = x := by simpa [u'] using ht' + have hparam : (u : Real) = (u' : Real) := by + have heq := hi k (htu.trans htu'.symm) + exact congrArg Subtype.val heq + have hidx : r.succ ≤ r'.castSucc := by + apply Fin.le_iff_val_le_val.mpr + simp + omega + have hmono := (s k).strict.monotone hidx + have hback : (s k).time r'.castSucc ≤ (s k).time r.succ := by + calc + (s k).time r'.castSucc ≤ (u' : Real) := t'.property.1 + _ = (u : Real) := hparam.symm + _ ≤ (s k).time r.succ := t.property.2 + have htime : (s k).time r.succ = (s k).time r'.castSucc := le_antisymm hmono hback + have hindices : r.succ = r'.castSucc := (s k).strict.injective htime + have hu : (u : Real) = (s k).time r.succ := by + apply le_antisymm t.property.2 + calc + (s k).time r.succ = (s k).time r'.castSucc := htime + _ ≤ (u' : Real) := t'.property.1 + _ = (u : Real) := hparam.symm + have hu' : (u' : Real) = (s k).time r'.castSucc := by + exact hparam.symm.trans (hu.trans htime) + have huτ : u = τ k r.succ := by + apply Subtype.ext + exact hu + have hu'τ : u' = τ k r'.castSucc := by + apply Subtype.ext + exact hu' + rw [huτ] at htu + rw [hu'τ] at htu' + refine ⟨Or.inr ?_, Or.inl ?_⟩ + · change x = g k (τ k r.succ) + exact htu.symm + · change x = g k (τ k r'.castSucc) + exact htu'.symm + +private theorem piece_overlap : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), + Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + (∀ (k : Fin 3), ∀ (r : Fin (s k).count), ∀ (r' : Fin (s k).count), (r.val < r'.val) → (∀ + (x : Real × Real), (x ∈ segment Real (w k r.castSucc) (w k r.succ)) → ((x ∈ segment + Real (w k r'.castSucc) (w k r'.succ)) → ((x = w k r.castSucc ∨ x = w k r.succ) ∧ (x = + w k r'.castSucc ∨ x = w k r'.succ))))) → (∀ (k : Fin (3 : ℕ)), ∀ (r : Fin (s + k).count), ∀ (r' : Fin (s k).count), r ≠ r' → ∀ x ∈ segment ℝ (w k r.castSucc) (w k + r.succ), x ∈ segment ℝ (w k r'.castSucc) (w k r'.succ) → (x = w k r.castSucc ∨ x = w + k r.succ) ∧ (x = w k r'.castSucc ∨ x = w k r'.succ)))) := by + classical + intro g hi s τ w piece_overlap_forward k r r' hne x hx hx' + have hvne : r.val ≠ r'.val := by + intro hv + apply hne + exact Fin.ext hv + rcases lt_or_gt_of_ne hvne with hlt | hgt + · exact piece_overlap_forward k r r' hlt x hx hx' + · have h := piece_overlap_forward k r' r hgt x hx' hx + exact ⟨h.2, h.1⟩ + +end RoutedSubdivisionProof + +namespace RoutedFaceDetails + +private theorem hM : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (s : (k : Fin (3 : + ℕ)) → P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + ((∑ k : Fin 3, (s k).count) = M) → ( + let n := M - 3 + n + 3 = M) ) := by + classical + intro g s m0 m1 m2 M hsum n + dsimp [n] + have hpos : 3 ≤ M := by + dsimp [M, m0, m1, m2] + have h0 := (s 0).positive + have h1 := (s 1).positive + have h2 := (s 2).positive + omega + omega + +private theorem q0 : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 + : ℕ)), Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases + (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases + (fun i : Fin m1 => w 1 i.castSucc) + (fun i : Fin m2 => w 2 i.castSucc)) + ∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w (0 : Fin (3 : ℕ)) i.castSucc)) := by + classical + intro g hi s m0 m1 m2 M τ w q i + simp [q] + +private theorem q1 : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 + : ℕ)), Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases + (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases + (fun i : Fin m1 => w 1 i.castSucc) + (fun i : Fin m2 => w 2 i.castSucc)) + ∀ (i : Fin m1), q (Fin.natAdd m0 (Fin.castAdd m2 i)) = w (1 : Fin (3 : ℕ)) i.castSucc)) + := by + classical + intro g hi s m0 m1 m2 M τ w q i + simp [q] + +private theorem q2 : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 + : ℕ)), Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases + (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases + (fun i : Fin m1 => w 1 i.castSucc) + (fun i : Fin m2 => w 2 i.castSucc)) + ∀ (i : Fin m2), q (Fin.natAdd m0 (Fin.natAdd m1 i)) = w (2 : Fin (3 : ℕ)) i.castSucc)) := by + classical + intro g hi s m0 m1 m2 M τ w q i + simp [q] + +private theorem cyc_ne : + (by + classical + exact + ∀ i : Fin 3, i ≠ i + 1 ) := by + classical + intro i + fin_cases i <;> decide + +private theorem faceContact : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (f : P.plane.Face), + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ i : Fin 3, i ≠ i + 1) → (∀ (i : Fin (3 : ℕ)), P3723T1EdgeContact P (v i) (v (i + (1 + : Fin (3 : ℕ))))) ) := by + classical + intro ι P f v cyc_ne i + refine ⟨?_, P.adjacent_has_common_edge _ _ ?_⟩ + · intro he + exact cyc_ne i (P.plane.face_vertices_distinct f he) + · exact P.plane.face_edges f i (i + 1) (cyc_ne i) + +private theorem arc_inter : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ (i : Fin 3), ∀ (j : Fin 3), (i ≠ j) → (({v i, v (i + 1)} : Set ι) ≠ {v j, v (j + 1)})) + → ((∀ (i : Fin 3), P3723T1EdgeContact P (v i) (v (i + 1))) → (∀ (i : Fin (3 : ℕ)), + ∀ (j : Fin (3 : ℕ)), i ≠ j → D.edgeArc (v i) (v (i + (1 : Fin (3 : ℕ)))) ∩ D.edgeArc + (v j) (v (j + (1 : Fin (3 : ℕ)))) = D.position '' ({v i, v (i + (1 : Fin (3 : ℕ)))} ∩ + {v j, v (j + (1 : Fin (3 : ℕ)))}))) ) := by + classical + intro ι P D f v pair_ne faceContact i j hij + exact D.edgeArc_intersections _ _ _ _ (faceContact i) (faceContact j) + (pair_ne i j hij) + +private theorem v_distinct : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (f : P.plane.Face), + let v : Fin 3 → ι := P.plane.faceVertex f + ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), i ≠ j → v i ≠ v j ) := by + classical + intro ι P f v i j hij h + exact hij (P.plane.face_vertices_distinct f h) + +private theorem pair_inter : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (f : P.plane.Face), + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ (i : Fin 3), ∀ (j : Fin 3), (i ≠ j) → (v i ≠ v j)) → (∀ (i : Fin (3 : ℕ)), ∀ (j : Fin + (3 : ℕ)), i ≠ j → ({v i, v (i + (1 : Fin (3 : ℕ)))} : Set ι) ∩ ({v j, + v (j + (1 : Fin (3 : ℕ)))} : Set ι) + = {v (if i + (1 : Fin (3 : ℕ)) = j then j else i)}) ) := by + classical + intro ι P f v v_distinct i j hij + fin_cases i <;> fin_cases j <;> try contradiction + all_goals + ext x + simp only [v, Set.mem_inter_iff, Set.mem_insert_iff, Set.mem_singleton_iff] + all_goals grind + +private theorem arc_inter_singleton : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ (i : Fin 3), ∀ (j : Fin 3), (i ≠ j) → (D.edgeArc (v i) (v (i + 1)) ∩ D.edgeArc (v j) + (v (j + 1)) = D.position '' (({v i, v (i + 1)} : Set ι) ∩ {v j, v (j + 1)}))) → ((∀ + (i : Fin 3), ∀ (j : Fin 3), (i ≠ j) → (({v i, v (i + 1)} : Set ι) ∩ {v j, v (j + 1)} + = {v (if i + 1 = j then j else i)})) → (∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), i ≠ + j → D.edgeArc (v i) (v (i + (1 : Fin (3 : ℕ)))) ∩ D.edgeArc (v j) (v (j + (1 : Fin (3 + : ℕ)))) = {D.position (v (if i + (1 : Fin (3 : ℕ)) = j then j else i))})) ) := by + classical + intro ι P D f v arc_inter pair_inter i j hij + rw [arc_inter _ _ hij, pair_inter i j hij] + simp + +private theorem w_arc : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ + (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((∀ (k : Fin (3 : ℕ)), Set.range (g k) + = D.edgeArc (P.plane.faceVertex f k) (P.plane.faceVertex f (k + (1 : + Fin (3 : ℕ))))) → (∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let v : Fin 3 → ι := P.plane.faceVertex f + ∀ (k : Fin (3 : ℕ)), ∀ (i : Fin ((s k).count + (1 : ℕ))), w k i ∈ D.edgeArc (v k) (v (k + + (1 : Fin (3 : ℕ))))))) := by + classical + intro ι P D f g hi hr s τ w v k i + rw [← hr k] + exact ⟨τ k i, rfl⟩ + +private theorem w_before_end : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 + : ℕ)), Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + ∀ (k : Fin (3 : ℕ)), ∀ (i : Fin (s k).count), (↑(τ k i.castSucc) : ℝ) < (1 : ℝ))) := by + classical + intro g hi s τ k i + have hidx : i.castSucc < Fin.last (s k).count := by + apply Fin.mk_lt_mk.mpr + simp + have ht := (s k).strict hidx + rw [(s k).finish] at ht + exact ht + +private theorem w_finish : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ + (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((∀ (k : Fin (3 : ℕ)), g + k ⟨(1 : ℝ), (by norm_num)⟩ = D.position (P.plane.faceVertex + f (k + (1 : Fin (3 : ℕ))))) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let v : Fin 3 → ι := P.plane.faceVertex f + ∀ (k : Fin (3 : ℕ)), w k (Fin.last (s k).count) = D.position (v (k + (1 : Fin (3 : + ℕ))))))) := by + classical + intro ι P D f g hi h1 s τ w v k + have he : τ k (Fin.last (s k).count) = ⟨1, by norm_num⟩ := by + apply Subtype.ext + simp [τ, (s k).finish] + simpa [w, he] using h1 k + +private theorem w_start : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ + (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((∀ (k : Fin (3 : ℕ)), g + k ⟨(0 : ℝ), (by norm_num)⟩ = D.position (P.plane.faceVertex + f k)) → (∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let v : Fin 3 → ι := P.plane.faceVertex f + ∀ (k : Fin (3 : ℕ)), w k (0 : Fin ((s k).count + (1 : ℕ))) = D.position (v k)))) := by + classical + intro ι P D f g hi h0 s τ w v k + have he : τ k 0 = ⟨0, by norm_num⟩ := by + apply Subtype.ext + simp [τ, (s k).start] + simpa [w, he] using h0 k + +private theorem arc01 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ (i : Fin 3), ∀ (j : Fin 3), (i ≠ j) → (D.edgeArc (v i) (v (i + 1)) ∩ D.edgeArc (v j) + (v (j + 1)) = {D.position (v (if i + 1 = j then j else i))})) → (D.edgeArc (v 0) (v + 1) ∩ D.edgeArc (v 1) (v 2) = {D.position (v 1)}) ) := by + classical + intro ι P D f v arc_inter_singleton + simpa [v] using arc_inter_singleton 0 1 (by decide) + +private theorem arc12 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ (i : Fin 3), ∀ (j : Fin 3), (i ≠ j) → (D.edgeArc (v i) (v (i + 1)) ∩ D.edgeArc (v j) + (v (j + 1)) = {D.position (v (if i + 1 = j then j else i))})) → (D.edgeArc (v 1) (v + 2) ∩ D.edgeArc (v 2) (v 0) = {D.position (v 2)}) ) := by + classical + intro ι P D f v arc_inter_singleton + simpa [v] using arc_inter_singleton 1 2 (by decide) + +private theorem arc20 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ (i : Fin 3), ∀ (j : Fin 3), (i ≠ j) → (D.edgeArc (v i) (v (i + 1)) ∩ D.edgeArc (v j) + (v (j + 1)) = {D.position (v (if i + 1 = j then j else i))})) → (D.edgeArc (v 2) (v + 0) ∩ D.edgeArc (v 0) (v 1) = {D.position (v 0)}) ) := by + classical + intro ι P D f v arc_inter_singleton + simpa [v] using arc_inter_singleton 2 0 (by decide) + +private theorem no_cross01 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ + (hi : ∀ (k : Fin (3 : ℕ)), Function.Injective (g k)), ∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ (k : Fin 3), ∀ (i : Fin ((s k).count + 1)), w k i ∈ D.edgeArc (v k) (v (k + 1))) → ((∀ + (k : Fin 3), ∀ (i : Fin (s k).count), w k i.castSucc ≠ D.position (v (k + 1))) → + ((D.edgeArc (v 0) (v 1) ∩ D.edgeArc (v 1) (v 2) = {D.position (v 1)}) → (∀ (i : Fin + m0), ∀ (j : Fin m1), w (0 : Fin (3 : ℕ)) i.castSucc = w (1 : Fin (3 : ℕ)) j.castSucc + → False))) ) := by + classical + intro ι P D f g hi s m0 m1 τ w v w_arc w_ne_finish arc01 i j h + have hx : w 0 i.castSucc ∈ D.edgeArc (v 0) (v 1) ∩ D.edgeArc (v 1) (v 2) := + ⟨w_arc 0 i.castSucc, h ▸ w_arc 1 j.castSucc⟩ + rw [arc01] at hx + have heq : w 0 i.castSucc = D.position (v 1) := by simpa using hx + exact w_ne_finish 0 i (by simpa [v] using heq) + +private theorem no_cross12 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ + (hi : ∀ (k : Fin (3 : ℕ)), Function.Injective (g k)), ∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let m1 := (s 1).count + let m2 := (s 2).count + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ (k : Fin 3), ∀ (i : Fin ((s k).count + 1)), w k i ∈ D.edgeArc (v k) (v (k + 1))) → ((∀ + (k : Fin 3), ∀ (i : Fin (s k).count), w k i.castSucc ≠ D.position (v (k + 1))) → + ((D.edgeArc (v 1) (v 2) ∩ D.edgeArc (v 2) (v 0) = {D.position (v 2)}) → (∀ (i : Fin + m1), ∀ (j : Fin m2), w (1 : Fin (3 : ℕ)) i.castSucc = w (2 : Fin (3 : ℕ)) j.castSucc + → False))) ) := by + classical + intro ι P D f g hi s m1 m2 τ w v w_arc w_ne_finish arc12 i j h + have hx : w 1 i.castSucc ∈ D.edgeArc (v 1) (v 2) ∩ D.edgeArc (v 2) (v 0) := + ⟨w_arc 1 i.castSucc, h ▸ w_arc 2 j.castSucc⟩ + rw [arc12] at hx + have heq : w 1 i.castSucc = D.position (v 2) := by simpa using hx + exact w_ne_finish 1 i (by simpa [v] using heq) + +private theorem no_cross02 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ + (hi : ∀ (k : Fin (3 : ℕ)), Function.Injective (g k)), ∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m2 := (s 2).count + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ (k : Fin 3), ∀ (i : Fin ((s k).count + 1)), w k i ∈ D.edgeArc (v k) (v (k + 1))) → ((∀ + (k : Fin 3), ∀ (i : Fin (s k).count), w k i.castSucc ≠ D.position (v (k + 1))) → + ((D.edgeArc (v 2) (v 0) ∩ D.edgeArc (v 0) (v 1) = {D.position (v 0)}) → (∀ (i : Fin + m0), ∀ (j : Fin m2), w (0 : Fin (3 : ℕ)) i.castSucc = w (2 : Fin (3 : ℕ)) j.castSucc + → False))) ) := by + classical + intro ι P D f g hi s m0 m2 τ w v w_arc w_ne_finish arc20 i j h + have hx : w 2 j.castSucc ∈ D.edgeArc (v 2) (v 0) ∩ D.edgeArc (v 0) (v 1) := + ⟨w_arc 2 j.castSucc, h.symm ▸ w_arc 0 i.castSucc⟩ + rw [arc20] at hx + have heq : w 2 j.castSucc = D.position (v 0) := by simpa using hx + exact w_ne_finish 2 j (by simpa [v] using heq) + +private theorem w_block_injective : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 + : ℕ)), Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + ∀ (k : Fin (3 : ℕ)), Function.Injective fun (i : Fin (s k).count) => w k i.castSucc)) := by + classical + intro g hi s τ w k i j h + have ht := hi k h + have htime := congrArg Subtype.val ht + have hidx : i.castSucc = j.castSucc := (s k).strict.injective htime + exact Fin.castSucc_injective _ hidx + +private theorem fin_succ_val : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (s : (k : Fin (3 : + ℕ)) → P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let n := M - 3 + ∀ (i : Fin (n + (3 : ℕ))), (↑i : ℕ) + (1 : ℕ) < n + (3 : ℕ) → (↑(i + (1 : Fin (n + (3 : + ℕ)))) : ℕ) = (↑i : ℕ) + (1 : ℕ) ) := by + classical + intro g s m0 m1 m2 M n i h + simp [Fin.val_add, Nat.mod_eq_of_lt h] + +private theorem piece_subset_arc : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ + (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((∀ (k : Fin (3 : ℕ)), Set.range (g k) + = D.edgeArc (P.plane.faceVertex f k) (P.plane.faceVertex f (k + (1 : + Fin (3 : ℕ))))) → (∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + (∀ (k : Fin 3), ∀ (r : Fin ((s k).count)), Set.range (fun t : Set.Icc ((s k).time + r.castSucc) ((s k).time r.succ) => + g k ⟨t.1, by + constructor + · exact (τ k r.castSucc).property.1.trans t.property.1 + · exact t.property.2.trans (τ k r.succ).property.2⟩) = + segment Real (w k r.castSucc) (w k r.succ)) → ( + let v : Fin 3 → ι := P.plane.faceVertex f + ∀ (k : Fin (3 : ℕ)), ∀ (r : Fin (s k).count), segment ℝ (w k r.castSucc) (w k r.succ) ⊆ + D.edgeArc (v k) (v (k + (1 : Fin (3 : ℕ)))))))) := by + classical + intro ι P D f g hi hr s τ w piece_range v k r x hx + rw [← piece_range k r] at hx + obtain ⟨t, ht⟩ := Set.mem_range.mp hx + rw [← hr k] + refine ⟨⟨t.1, ⟨(τ k r.castSucc).property.1.trans t.property.1, + t.property.2.trans (τ k r.succ).property.2⟩⟩, ?_⟩ + simpa using ht + +private theorem p_injective : + (by + classical + exact + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 + : ℕ)), Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → + P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let n := M - 3 + ∀ (hM : n + 3 = M), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases + (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases + (fun i : Fin m1 => w 1 i.castSucc) + (fun i : Fin m2 => w 2 i.castSucc)) + let p : Fin (n + 3) → Real × Real := fun i => q (Fin.cast hM i) + (Function.Injective q) → (Function.Injective p))) := by + classical + intro g hi s m0 m1 m2 M n hM τ w q p q_injective i j hij + apply Fin.cast_injective hM + apply q_injective + simpa [p] using hij + +private theorem endpoint_mem : + (by + classical + exact + ∀ (a : ℝ × ℝ), ∀ (b : ℝ × ℝ), ∀ (x : ℝ × ℝ), x = a ∨ x = b → x ∈ segment ℝ a b ) := by + classical + intro a b x h + rcases h with h | h + · subst x + exact left_mem_segment Real a b + · subst x + exact right_mem_segment Real a b + +private theorem hxpos : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ (i : Fin 3), ∀ (j : Fin 3), (i ≠ j) → (D.edgeArc (v i) (v (i + 1)) ∩ D.edgeArc (v j) + (v (j + 1)) = D.position '' (({v i, v (i + 1)} : Set ι) ∩ {v j, v (j + 1)}))) → (∀ (x + : ℝ × ℝ), ∀ (k : Fin (3 : ℕ)), ∀ (l : Fin (3 : ℕ)), (¬k = l) → ((x ∈ D.edgeArc (v k) + (v (k + 1)) ∩ D.edgeArc (v l) (v (l + 1))) → (x ∈ D.position '' ({v k, v (k + 1)} ∩ + {v l, v (l + 1)})))) ) := by + classical + intro ι P D f v arc_inter x k l hkl hxarc + rw [← arc_inter k l hkl] + exact hxarc + +private theorem hxi : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ + (k : Fin (3 : ℕ)), Function.Injective (g k)) → (∀ (k : Fin (3 : ℕ)), ∀ (s : (k + : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ (k : Fin 3), ∀ (r : Fin (s k).count), ∀ (x : Real × Real), (x ∈ segment Real (w k + r.castSucc) (w k r.succ)) → ((x = D.position (v k)) → (x = w k r.castSucc ∨ x = w k + r.succ))) → ((∀ (k : Fin 3), ∀ (r : Fin (s k).count), ∀ (x : Real × Real), (x ∈ + segment Real (w k r.castSucc) (w k r.succ)) → ((x = D.position (v (k + 1))) → (x = w + k r.castSucc ∨ x = w k r.succ))) → (∀ (x : ℝ × ℝ), ∀ (r : Fin (s k).count), (x ∈ + segment ℝ (w k r.castSucc) (w k r.succ)) → (∀ (u : ι), (D.position u = x) → ((u = v k + ∨ u = v (k + (1 : Fin (3 : ℕ)))) → (x = w k r.castSucc ∨ x = w k r.succ))))))) := by + classical + intro ι P D f g hi k s τ w v piece_start_corner piece_finish_corner x r hx1 u hux huk + rcases huk with huk | huk + · apply piece_start_corner k r x hx1 + exact hux.symm.trans (congrArg D.position huk) + · apply piece_finish_corner k r x hx1 + exact hux.symm.trans (congrArg D.position huk) + +private theorem hxj : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ + (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((Fin (3 : ℕ)) → (∀ (s : (k + : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ (k : Fin 3), ∀ (r : Fin (s k).count), ∀ (x : Real × Real), (x ∈ segment Real (w k + r.castSucc) (w k r.succ)) → ((x = D.position (v k)) → (x = w k r.castSucc ∨ x = w k + r.succ))) → ((∀ (k : Fin 3), ∀ (r : Fin (s k).count), ∀ (x : Real × Real), (x ∈ + segment Real (w k r.castSucc) (w k r.succ)) → ((x = D.position (v (k + 1))) → (x = w + k r.castSucc ∨ x = w k r.succ))) → (∀ (x : ℝ × ℝ), ∀ (l : Fin (3 : ℕ)), ∀ (r' : Fin + (s l).count), (x ∈ segment ℝ (w l r'.castSucc) (w l r'.succ)) → (∀ (u : ι), + (D.position u = x) → ((u = v l ∨ u = v (l + (1 : Fin (3 : ℕ)))) → (x = w l + r'.castSucc ∨ x = w l r'.succ)))))))) := by + classical + intro ι P D f g hi k s τ w v piece_start_corner piece_finish_corner x l r' hx2 u hux hul + rcases hul with hul | hul + · apply piece_start_corner l r' x hx2 + exact hux.symm.trans (congrArg D.position hul) + · apply piece_finish_corner l r' x hx2 + exact hux.symm.trans (congrArg D.position hul) + +end RoutedFaceDetails + +theorem P3913T1RoutedFaceSubdivision : + ∀ {ι : Type}, ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : + P.plane.Face), ∀ (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real), (∀ k, Continuous (g + k)) → ((∀ k, Function.Injective (g k)) → ((∀ k, Set.range (g k) = + D.edgeArc (P.plane.faceVertex f k) (P.plane.faceVertex f (k + 1))) → ((∀ k, g k ⟨0, + by norm_num⟩ = D.position (P.plane.faceVertex f k)) → ((∀ k, g k ⟨1, by norm_num⟩ = + D.position (P.plane.faceVertex f (k + 1))) → (∀ (s : ∀ k, + P3723T1PolygonalParameterization (g k)), ∃ (n : Nat) (p : Fin (n + 3) → Real × + Real), + n + 3 = ∑ k : Fin 3, (s k).count ∧ + Function.Injective p ∧ + (∀ i j : Fin (n + 3), i ≠ j → + segment Real (p i) (p (i + 1)) ∩ segment Real (p j) (p (j + 1)) = + {x | (x = p i ∨ x = p (i + 1)) ∧ + (x = p j ∨ x = p (j + 1))}) ∧ + (⋃ i, segment Real (p i) (p (i + 1))) = + D.edgeArc (P.plane.faceVertex f 0) (P.plane.faceVertex f 1) ∪ + D.edgeArc (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) ∪ + D.edgeArc (P.plane.faceVertex f 2) (P.plane.faceVertex f 0) ∧ + (∀ k, ∀ (i : Fin ((s k).count + 1)), ∃ t : Set.Icc (0 : Real) 1, + (t : Real) = (s k).time i ∧ g k t ∈ Set.range p)))))) := by + intro ι P D f g hc hi hr h0 h1 s +-- BODY + classical + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + have hsum : (∑ k : Fin 3, (s k).count) = M := by + simp [Fin.sum_univ_succ, M, m0, m1, m2] + let n := M - 3 + have hM := RoutedFaceDetails.hM g s hsum + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases + (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases + (fun i : Fin m1 => w 1 i.castSucc) + (fun i : Fin m2 => w 2 i.castSucc)) + let p : Fin (n + 3) → Real × Real := fun i => q (Fin.cast hM i) + have piece_range (k : Fin 3) (r : Fin ((s k).count)) : + Set.range (fun t : Set.Icc ((s k).time r.castSucc) ((s k).time r.succ) => + g k ⟨t.1, by + constructor + · exact (τ k r.castSucc).property.1.trans t.property.1 + · exact t.property.2.trans (τ k r.succ).property.2⟩) = + segment Real (w k r.castSucc) (w k r.succ) := RoutedSubdivisionProof.piece_range g hi s k r + have q0 (i : Fin m0) := RoutedFaceDetails.q0 g hi s i + have q1 (i : Fin m1) := RoutedFaceDetails.q1 g hi s i + have q2 (i : Fin m2) := RoutedFaceDetails.q2 g hi s i + have p_at (i : Fin M) : p (Fin.cast hM.symm i) = q i := by + simp [p] + have join (k : Fin 3) : + w k (Fin.last (s k).count) = w (k + 1) 0 := RoutedSubdivisionProof.join ι P D f g hi h0 h1 s k + let v : Fin 3 → ι := P.plane.faceVertex f + have arc_inter (i j : Fin 3) (hij : i ≠ j) := RoutedFaceDetails.arc_inter ι P D f + (RoutedSubdivisionProof.pair_ne ι P f g s) + (RoutedFaceDetails.faceContact ι P f (RoutedFaceDetails.cyc_ne)) i j hij + have v_distinct (i j : Fin 3) (hij : i ≠ j) := RoutedFaceDetails.v_distinct ι P f i + j hij + have v01 : v 0 ≠ v 1 := v_distinct 0 1 (by decide) + have v02 : v 0 ≠ v 2 := v_distinct 0 2 (by decide) + have v12 : v 1 ≠ v 2 := v_distinct 1 2 (by decide) + have arc_inter_singleton (i j : Fin 3) (hij : i ≠ j) := RoutedFaceDetails.arc_inter_singleton ι + P D f arc_inter (RoutedFaceDetails.pair_inter ι P f v_distinct) i j hij + have w_arc (k : Fin 3) (i : Fin ((s k).count + 1)) := RoutedFaceDetails.w_arc ι P D f g hi hr s + k i + have w_before_end (k : Fin 3) (i : Fin (s k).count) := RoutedFaceDetails.w_before_end g hi s k i + have w_start (k : Fin 3) := RoutedFaceDetails.w_start ι P D f g hi + h0 s k + have w_ne_finish (k : Fin 3) (i : Fin (s k).count) : + w k i.castSucc ≠ D.position (v (k + 1)) := RoutedSubdivisionProof.w_ne_finish ι P D f g hi + s (RoutedFaceDetails.w_finish ι P D f g hi h1 s) k i + have q_injective : Function.Injective q := RoutedSubdivisionProof.q_injective g hi s q0 q1 q2 + (RoutedFaceDetails.no_cross01 ι P D f g hi s w_arc w_ne_finish (RoutedFaceDetails.arc01 ι P + D f arc_inter_singleton)) (RoutedFaceDetails.no_cross12 ι P D f g hi s w_arc + w_ne_finish (RoutedFaceDetails.arc12 ι P D f arc_inter_singleton)) + (RoutedFaceDetails.no_cross02 ι P D f g hi s w_arc w_ne_finish (RoutedFaceDetails.arc20 + ι P D f arc_inter_singleton)) (RoutedFaceDetails.w_block_injective g hi s) + let b0 (i : Fin m0) : Fin M := Fin.castAdd (m1 + m2) i + let b1 (i : Fin m1) : Fin M := Fin.natAdd m0 (Fin.castAdd m2 i) + let b2 (i : Fin m2) : Fin M := Fin.natAdd m0 (Fin.natAdd m1 i) + have hM' : n + 3 = m0 + (m1 + m2) := by simpa [M] using hM + have p_edge_piece (i : Fin (n + 3)) : + ∃ k : Fin 3, ∃ r : Fin (s k).count, + p i = w k r.castSucc ∧ p (i + 1) = w k r.succ := RoutedSubdivisionProof.p_edge_piece g hi + s hM q0 q2 join (RoutedSubdivisionProof.q_step g hi s hM q0 q1 q2 join) i + have piece_subset_arc (k : Fin 3) (r : Fin (s k).count) := RoutedFaceDetails.piece_subset_arc ι + P D f g hi hr s piece_range k r + have piece_start_corner (k : Fin 3) (r : Fin (s k).count) (x : Real × Real) + (hx : x ∈ segment Real (w k r.castSucc) (w k r.succ)) + (hc : x = D.position (v k)) : + x = w k r.castSucc ∨ x = w k r.succ := RoutedSubdivisionProof.piece_start_corner ι P D f g + hi h0 s piece_range k r x hx hc + have piece_finish_corner (k : Fin 3) (r : Fin (s k).count) (x : Real × Real) + (hx : x ∈ segment Real (w k r.castSucc) (w k r.succ)) + (hc : x = D.position (v (k + 1))) : + x = w k r.castSucc ∨ x = w k r.succ := RoutedSubdivisionProof.piece_finish_corner ι P D f g + hi h1 s piece_range k r x hx hc + have endpoint_mem (a b x : Real × Real) (h : x = a ∨ x = b) := RoutedFaceDetails.endpoint_mem a + b x h + refine ⟨n, p, ?_, ?_, ?_, ?_, ?_⟩ + · simpa [hsum] + · intro i j hij + apply Fin.cast_injective hM + apply q_injective + simpa [p] using hij + · intro i j hij + ext x + constructor + · intro hx + rcases hx with ⟨hx1, hx2⟩ + obtain ⟨k, r, hli, hri⟩ := p_edge_piece i + obtain ⟨l, r', hlj, hrj⟩ := p_edge_piece j + rw [hli, hri] at hx1 + rw [hlj, hrj] at hx2 + by_cases hkl : k = l + · subst l + by_cases hrr : r = r' + · subst r' + have hpi : p i = p j := hli.trans hlj.symm + exact (hij ((RoutedFaceDetails.p_injective g hi s hM q_injective) hpi)).elim + · have hend := (RoutedSubdivisionProof.piece_overlap g hi s + (RoutedSubdivisionProof.piece_overlap_forward g hi s piece_range)) k r r' hrr x hx1 hx2 + simpa [hli, hri, hlj, hrj] using hend + · have hxarc : + x ∈ D.edgeArc (v k) (v (k + 1)) ∩ D.edgeArc (v l) (v (l + 1)) := + ⟨piece_subset_arc k r hx1, piece_subset_arc l r' hx2⟩ + obtain ⟨u, hu, hux⟩ := (RoutedFaceDetails.hxpos ι P D f arc_inter x k l hkl hxarc) + rcases hu with ⟨huk, hul⟩ + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at huk hul + have hxi := RoutedFaceDetails.hxi ι P D f g hi k s + piece_start_corner piece_finish_corner x r hx1 u hux huk + have hxj := RoutedFaceDetails.hxj ι P D f g hi k + s piece_start_corner piece_finish_corner x l r' hx2 u hux hul + simpa [hli, hri, hlj, hrj] using And.intro hxi hxj + · intro hx + rcases hx with ⟨hxi, hxj⟩ + exact ⟨endpoint_mem (p i) (p (i + 1)) x hxi, + endpoint_mem (p j) (p (j + 1)) x hxj⟩ + · calc + (⋃ i : Fin (n + 3), segment Real (p i) (p (i + 1))) = + ⋃ k : Fin 3, ⋃ r : Fin (s k).count, + segment Real (w k r.castSucc) (w k r.succ) := (RoutedSubdivisionProof.edge_union g hi + s hM p_edge_piece (RoutedSubdivisionProof.block_edge g hi s hM q0 q1 q2 join + (RoutedFaceDetails.fin_succ_val g s))) + _ = ⋃ k : Fin 3, D.edgeArc (v k) (v (k + 1)) := (RoutedSubdivisionProof.piece_arc_union ι P + D f g hi s (RoutedSubdivisionProof.arc_covered ι P D f g hi hr s piece_range + (RoutedSubdivisionProof.finite_interval_cover g s))) + _ = D.edgeArc (v 0) (v 1) ∪ D.edgeArc (v 1) (v 2) ∪ + D.edgeArc (v 2) (v 0) := (RoutedSubdivisionProof.arc_union ι P D f) + · intro k i + refine ⟨τ k i, rfl, ?_⟩ + exact (RoutedSubdivisionProof.retained g hi s hM q0 q1 q2 p_at join) k i + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedTraceClosed.lean b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedTraceClosed.lean new file mode 100644 index 0000000000..ed2e5065a2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedTraceClosed.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting +public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry +public import LeanPool.ApollonianSuperharmonic.P3767T1VertexEdgeIncidence + +-- [TABLET NODE: P3913T1RoutedTraceClosed] + +/-! +# P3913T1RoutedTraceClosed + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3913T1RoutedTraceClosed {ι : Type} (P : PeriodicTileComplex ι) + (D : P3723T1AllContactRouting P) : + IsClosed (Set.range D.position ∪ + {p | ∃ a b, P.plane.adjacent a b ∧ p ∈ D.edgeArc a b}) := by +-- BODY + classical + let : Nontrivial ι := (P3776T1FixedGeometry P.toPeriodicTileCore).1 + have contact (a b : ι) (h : P.plane.adjacent a b) : + P3723T1EdgeContact P a b := by + exact ⟨(show a ≠ b from fun e => P.plane.adjacent_irreflexive a (e.symm ▸ h)), + P.adjacent_has_common_edge a b h⟩ + let E := {e : ι × ι // P.plane.adjacent e.1 e.2} + let A : E → Set (Real × Real) := fun e => D.edgeArc e.val.1 e.val.2 + have compact (e : E) : IsCompact (A e) := by + obtain ⟨g, hg, _, hr, _⟩ := D.edgeArc_parameterization _ _ (contact _ _ e.property) + rw [show A e = Set.range g from hr.symm] + exact isCompact_range hg + have locally_finite : LocallyFinite A := by + intro x + refine ⟨Metric.closedBall x 1, Metric.closedBall_mem_nhds x (by norm_num), ?_⟩ + apply ((D.compact_local_finiteness _ (isCompact_closedBall x 1)).preimage + (show Function.Injective (fun e : E => e.val) from Subtype.val_injective).injOn).subset + rintro e ⟨z, hza, hzb⟩ + exact ⟨contact _ _ e.property, z, hza, hzb⟩ + have closed_union : IsClosed (Set.iUnion A) := + locally_finite.isClosed_iUnion (fun e => (compact e).isClosed) + have trace_eq : Set.range D.position ∪ + {p | ∃ a b, P.plane.adjacent a b ∧ p ∈ D.edgeArc a b} = Set.iUnion A := by + ext x + constructor + · rintro (⟨a, rfl⟩ | ⟨a, b, hab, hx⟩) + · obtain ⟨b, hab⟩ := (P3767T1VertexEdgeIncidence P.plane a).1 + obtain ⟨h, h0, _⟩ := D.edgeArc_homeomorph a b (contact a b hab) + apply Set.mem_iUnion.mpr + refine ⟨⟨(a, b), hab⟩, ?_⟩ + change D.position a ∈ D.edgeArc a b + rw [← h0] + exact (h ⟨0, by norm_num⟩).property + · exact Set.mem_iUnion.mpr ⟨⟨(a, b), hab⟩, hx⟩ + · intro hx + obtain ⟨e, he⟩ := Set.mem_iUnion.mp hx + exact Or.inr ⟨e.val.1, e.val.2, e.property, he⟩ + rw [trace_eq] + exact closed_union + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSide.lean b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSide.lean new file mode 100644 index 0000000000..a2cf95ebc6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSide.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3934T1PolygonalSide + +-- [TABLET NODE: P3934T1ArcSide] + +/-! +# P3934T1ArcSide + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The predicate $\operatorname{ArcSide}(U,S,a,b,e)$ means that there +exists a continuous injective map $g:[0,1]\to\mathbb R^2$ with image +$S$, $g(0)=a$, $g(1)=b$, and a +`P3723T1PolygonalParameterization` $s$ of $g$ for which +$\operatorname{PolySide}(U,g,s,e)$ holds in the sense of +`P3934T1PolygonalSide`. +-/ +def P3934T1ArcSide (U S : Set (Real × Real)) (a b : Real × Real) + (e : Bool) : Prop := +-- BODY + ∃ g : Set.Icc (0 : Real) 1 → Real × Real, + Continuous g ∧ Function.Injective g ∧ Set.range g = S ∧ + g ⟨0, by norm_num⟩ = a ∧ g ⟨1, by norm_num⟩ = b ∧ + ∃ s : P3723T1PolygonalParameterization g, + P3934T1PolygonalSide U g s e + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean new file mode 100644 index 0000000000..667d5c760d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean @@ -0,0 +1,1211 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3934T1ArcSide + +-- [TABLET NODE: P3934T1ArcSideComparison] + +/-! +# P3934T1ArcSideComparison + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ArcComparisonGeometry + +private theorem reverseLocal : + (∀ (k : Bool), ∀ (x : Real), (if k then 0 < x else x < 0) ↔ (if !k then 0 < -x else -x < 0)) + → (∀ (W : Set (Real × Real)), ∀ (z : Real × Real), ∀ (B : Real × Real), ∀ (k : Bool), + P3934T1LocalSide W z B k → P3934T1LocalSide W z (-B) (!k)) := by + classical + intro negSign W z B k h + rcases h with ⟨r, hr, heq⟩ + refine ⟨r, hr, ?_⟩ + apply Set.ext + intro q + change q ∈ W ∩ Metric.ball z r ↔ q ∈ Metric.ball z r ∧ _ + rw [heq] + simp only [Set.mem_ofPred_eq] + have hd : (-B).1 * (q.2 - z.2) - (-B).2 * (q.1 - z.1) = + -(B.1 * (q.2 - z.2) - B.2 * (q.1 - z.1)) := by + rw [Prod.fst_neg, Prod.snd_neg] + ring + rw [hd] + apply and_congr_right + intro _ + exact negSign k (B.1 * (q.2 - z.2) - B.2 * (q.1 - z.1)) + +private theorem hscale : + ∀ (S : Set (Real × Real)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : + (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization + g), ∀ (q : P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ + (hhrange : Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ + ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ + (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ + let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ + ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), + let GH := + Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont + let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont + let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm + let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ + let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ + ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time + j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ + let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ + let c : Real := min (phi α : Real) (β : Real) + ∀ (hcpos : 0 < c), ((c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), + let r1 : Set.Icc (0 : Real) 1 + := ⟨c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + ((r1 : Real) < (r2 : Real)) → ( + let xL : Set.Icc (0 : Real) 1 := phi.symm r1 + let xR : Set.Icc (0 : Real) 1 := phi.symm r2 + ∀ (Bg : ℝ × ℝ), ∀ (Bh : ℝ × ℝ), (((xR : Real) - (xL : Real)) • Bg = ((r2 : Real) - (r1 : + Real)) • Bh) → ( + let scale : Real := ((xR : Real) - (xL : Real)) / ((r2 : Real) - (r1 : + Real)) + Bh = scale • Bg)))) := by + classical + intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he + hgfun_cont hhfun_cont GH HH phi i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_b hc_le_one r1 r2 + hr12 xL xR Bg Bh hvel scale + have hfst := congrArg Prod.fst hvel + have hsnd := congrArg Prod.snd hvel + change ((xR : Real) - (xL : Real)) * Bg.1 = + ((r2 : Real) - (r1 : Real)) * Bh.1 at hfst + change ((xR : Real) - (xL : Real)) * Bg.2 = + ((r2 : Real) - (r1 : Real)) * Bh.2 at hsnd + have hden : (r2 : Real) - (r1 : Real) ≠ 0 := ne_of_gt (sub_pos.mpr hr12) + apply Prod.ext + · change Bh.1 = scale * Bg.1 + dsimp [scale] + calc + Bh.1 = (((r2 : Real) - (r1 : Real)) * Bh.1) / ((r2 : Real) - (r1 : Real)) := by + field_simp + _ = (((xR : Real) - (xL : Real)) * Bg.1) / ((r2 : Real) - (r1 : Real)) := by rw [← hfst] + _ = (((xR : Real) - (xL : Real)) / ((r2 : Real) - (r1 : Real))) * Bg.1 := by ring + · change Bh.2 = scale * Bg.2 + dsimp [scale] + calc + Bh.2 = (((r2 : Real) - (r1 : Real)) * Bh.2) / ((r2 : Real) - (r1 : Real)) := by + field_simp + _ = (((xR : Real) - (xL : Real)) * Bg.2) / ((r2 : Real) - (r1 : Real)) := by rw [← hsnd] + _ = (((xR : Real) - (xL : Real)) / ((r2 : Real) - (r1 : Real))) * Bg.2 := by ring + +private theorem localResult : + ∀ (S : Set (Real × Real)), ∀ (e : Bool), ∀ (d : Bool), ∀ (U₁ : Set (ℝ × ℝ)), ∀ (U₂ : Set (ℝ × + ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : + ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : + P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), + (P3934T1PolygonalSide U₁ g p e) → (∀ (hhrange : Set.range h = S), + (P3934T1PolygonalSide U₂ h q d) → ( + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ + ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ + (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ + let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ + ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), + let GH := + Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont + let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont + let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm + let i0 : Fin p.count := ⟨0, p.positive⟩ + let j0 : Fin q.count := ⟨0, q.positive⟩ + let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ + let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ + ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time + j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ + let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ + let c : Real := min (phi α : Real) (β : Real) + ∀ (hcpos : 0 < c), ((c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), + let r1 : Set.Icc (0 : Real) 1 + := ⟨c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + let xL : Set.Icc (0 : Real) 1 := phi.symm r1 + let xR : Set.Icc (0 : Real) 1 := phi.symm r2 + ∀ (Bg : ℝ × ℝ), (Bg ≠ (0 : ℝ × ℝ)) → ((∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), p.time + i0.castSucc < (↑t : ℝ) → (↑t : ℝ) < p.time i0.succ → P3934T1LocalSide U₁ (g t) Bg e) → + (∀ (Bh : ℝ × ℝ), (∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), q.time j0.castSucc < (↑t : + ℝ) → (↑t : ℝ) < q.time j0.succ → P3934T1LocalSide U₂ (h t) Bh d) → ( + let scale : Real := + ((xR : Real) - (xL : Real)) / ((r2 : Real) - (r1 : Real)) + (0 < scale) → ((Bh = scale • Bg) → ( + let z : Real × Real := g xL + (P3934T1LocalSide U₁ z Bg e) → ((P3934T1LocalSide U₂ z Bh d) → ((U₁ = U₂ → e = d) ∧ + (Disjoint U₁ U₂ → e ≠ d)))))))))))) := by + classical + intro S e d U₁ U₂ g h p q hgrange hps hhrange hqs gfun hfun hgfun_inj hhfun_inj hgfun_surj + hhfun_surj ge he hgfun_cont hhfun_cont GH HH phi i0 j0 i1 j1 hpi hqj hpi1 hqj1 α β c hcpos + hc_le_b hc_le_one r1 r2 xL xR Bg hBg hgside Bh hhside scale hscale_pos hscale z hlocG hlocH + rcases hlocG with ⟨r, hr, hEqU⟩ + rcases hlocH with ⟨s, hs, hEqV⟩ + let v : Real × Real := (-Bg.2, Bg.1) + obtain ⟨eps, heps, hbound⟩ := exists_pos_mul_lt (lt_min hr hs) ‖v‖ + have hbound' : eps * ‖v‖ < min r s := by simpa [mul_comm] using hbound + let qplus : Real × Real := z + eps • v + let qminus : Real × Real := z - eps • v + have hdistPlus : dist qplus z = eps * ‖v‖ := by + rw [dist_eq_norm] + simp [qplus, norm_smul, Real.norm_eq_abs, abs_of_pos heps] + have hdistMinus : dist qminus z = eps * ‖v‖ := by + rw [dist_eq_norm] + simp [qminus, norm_smul, Real.norm_eq_abs, abs_of_pos heps] + have hballPlusU : qplus ∈ Metric.ball z r := by + change dist qplus z < r + rw [hdistPlus] + exact lt_of_lt_of_le hbound' (min_le_left r s) + have hballPlusV : qplus ∈ Metric.ball z s := by + change dist qplus z < s + rw [hdistPlus] + exact lt_of_lt_of_le hbound' (min_le_right r s) + have hballMinusU : qminus ∈ Metric.ball z r := by + change dist qminus z < r + rw [hdistMinus] + exact lt_of_lt_of_le hbound' (min_le_left r s) + have hballMinusV : qminus ∈ Metric.ball z s := by + change dist qminus z < s + rw [hdistMinus] + exact lt_of_lt_of_le hbound' (min_le_right r s) + have hsum : 0 < Bg.1 ^ 2 + Bg.2 ^ 2 := by + have hc : Bg.1 ≠ 0 ∨ Bg.2 ≠ 0 := by + by_contra hh + push Not at hh + apply hBg + ext <;> simp [hh.1, hh.2] + rcases hc with hc | hc + · have hp := sq_pos_of_ne_zero hc + nlinarith [sq_nonneg Bg.2] + · have hp := sq_pos_of_ne_zero hc + nlinarith [sq_nonneg Bg.1] + have hdetPlus : Bg.1 * (qplus.2 - z.2) - Bg.2 * (qplus.1 - z.1) = + eps * (Bg.1 ^ 2 + Bg.2 ^ 2) := by + simp [qplus, v] + ring + have hdetMinus : Bg.1 * (qminus.2 - z.2) - Bg.2 * (qminus.1 - z.1) = + -(eps * (Bg.1 ^ 2 + Bg.2 ^ 2)) := by + simp [qminus, v] + ring + have hdetPlusPos : 0 < Bg.1 * (qplus.2 - z.2) - Bg.2 * (qplus.1 - z.1) := by + rw [hdetPlus] + exact mul_pos heps hsum + have hdetMinusNeg : Bg.1 * (qminus.2 - z.2) - Bg.2 * (qminus.1 - z.1) < 0 := by + rw [hdetMinus] + nlinarith [mul_pos heps hsum] + have hdetScalePlus : Bh.1 * (qplus.2 - z.2) - Bh.2 * (qplus.1 - z.1) = + scale * (Bg.1 * (qplus.2 - z.2) - Bg.2 * (qplus.1 - z.1)) := by + rw [hscale] + change scale * Bg.1 * (qplus.2 - z.2) - scale * Bg.2 * (qplus.1 - z.1) = _ + ring + have hdetScaleMinus : Bh.1 * (qminus.2 - z.2) - Bh.2 * (qminus.1 - z.1) = + scale * (Bg.1 * (qminus.2 - z.2) - Bg.2 * (qminus.1 - z.1)) := by + rw [hscale] + change scale * Bg.1 * (qminus.2 - z.2) - scale * Bg.2 * (qminus.1 - z.1) = _ + ring + have hdetVPlus : 0 < Bh.1 * (qplus.2 - z.2) - Bh.2 * (qplus.1 - z.1) := by + rw [hdetScalePlus] + exact mul_pos hscale_pos hdetPlusPos + have hdetVMinus : Bh.1 * (qminus.2 - z.2) - Bh.2 * (qminus.1 - z.1) < 0 := by + rw [hdetScaleMinus] + exact mul_neg_of_pos_of_neg hscale_pos hdetMinusNeg + have sideMem {W : Set (Real × Real)} {w b : Real × Real} {k : Bool} {R : Real} + (heq : W ∩ Metric.ball w R = + {x | x ∈ Metric.ball w R ∧ + if k then 0 < b.1 * (x.2 - w.2) - b.2 * (x.1 - w.1) + else b.1 * (x.2 - w.2) - b.2 * (x.1 - w.1) < 0}) + (x : Real × Real) (hx : x ∈ Metric.ball w R) : + x ∈ W ↔ if k then 0 < b.1 * (x.2 - w.2) - b.2 * (x.1 - w.1) + else b.1 * (x.2 - w.2) - b.2 * (x.1 - w.1) < 0 := by + have hm := congrArg (fun T : Set (Real × Real) => x ∈ T) heq + simp only [Set.mem_inter_iff, Set.mem_ofPred_eq] at hm + simpa [hx] using hm + have hplusU : qplus ∈ U₁ ↔ + (if e then 0 < Bg.1 * (qplus.2 - z.2) - Bg.2 * (qplus.1 - z.1) + else Bg.1 * (qplus.2 - z.2) - Bg.2 * (qplus.1 - z.1) < 0) := by + exact sideMem hEqU qplus hballPlusU + have hminusU : qminus ∈ U₁ ↔ + (if e then 0 < Bg.1 * (qminus.2 - z.2) - Bg.2 * (qminus.1 - z.1) + else Bg.1 * (qminus.2 - z.2) - Bg.2 * (qminus.1 - z.1) < 0) := by + exact sideMem hEqU qminus hballMinusU + have hplusV : qplus ∈ U₂ ↔ + (if d then 0 < Bh.1 * (qplus.2 - z.2) - Bh.2 * (qplus.1 - z.1) + else Bh.1 * (qplus.2 - z.2) - Bh.2 * (qplus.1 - z.1) < 0) := by + exact sideMem hEqV qplus hballPlusV + have hminusV : qminus ∈ U₂ ↔ + (if d then 0 < Bh.1 * (qminus.2 - z.2) - Bh.2 * (qminus.1 - z.1) + else Bh.1 * (qminus.2 - z.2) - Bh.2 * (qminus.1 - z.1) < 0) := by + exact sideMem hEqV qminus hballMinusV + constructor + · intro hset + subst U₂ + cases e <;> cases d + · rfl + · have hm : qplus ∈ U₁ := (hplusV).2 (by simp [hdetVPlus]) + have hn : qplus ∉ U₁ := by + intro hh + have hh' := (hplusU).1 hh + simp at hh' + linarith [hdetPlusPos] + exact False.elim (hn hm) + · have hm : qplus ∈ U₁ := (hplusU).2 (by simp [hdetPlusPos]) + have hn : qplus ∉ U₁ := by + intro hh + have hh' := (hplusV).1 hh + simp at hh' + linarith [hdetVPlus] + exact False.elim (hn hm) + · rfl + · intro hdisj heq + subst d + cases e + · have hu : qminus ∈ U₁ := (hminusU).2 (by simp [hdetMinusNeg]) + have hv : qminus ∈ U₂ := (hminusV).2 (by simp [hdetVMinus]) + exact (Set.disjoint_left.mp hdisj) hu hv + · have hu : qplus ∈ U₁ := (hplusU).2 (by simp [hdetPlusPos]) + have hv : qplus ∈ U₂ := (hplusV).2 (by simp [hdetVPlus]) + exact (Set.disjoint_left.mp hdisj) hu hv + +private theorem grange : + ∀ (S : Set (Real × Real)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (Set.range g + = S) → ( + let flip : Set.Icc (0 : Real) 1 → Set.Icc (0 : Real) 1 := fun t => + ⟨1 - (t : Real), ⟨sub_nonneg.mpr t.2.2, sub_le_self 1 t.2.1⟩⟩ + ∀ (flip_invol : Function.Involutive flip), ∀ (flip_cont : Continuous flip), + let flipEquiv : + Set.Icc (0 : Real) 1 ≃ Set.Icc (0 : Real) 1 := + { toFun := flip + invFun := flip + left_inv := flip_invol + right_inv := flip_invol } + let flipHomeo := Continuous.homeoOfEquivCompactToT2 (f := flipEquiv) flip_cont + let gr : Set.Icc (0 : Real) 1 → Real × Real := fun t => g (flipHomeo t) + Set.range gr = S) := by + classical + intro S g hgrange flip flip_invol flip_cont flipEquiv flipHomeo gr + apply Set.ext + intro z + constructor + · rintro ⟨t, rfl⟩ + rw [← hgrange] + exact ⟨flipHomeo t, rfl⟩ + · intro hz + rw [← hgrange] at hz + rcases hz with ⟨t, rfl⟩ + refine ⟨flipHomeo.symm t, ?_⟩ + change g (flipHomeo (flipHomeo.symm t)) = g t + simp + +private theorem hsr : + ∀ (U : Set (Real × Real)), ∀ (e : Bool), (∀ (W : Set (Real × Real)), ∀ (z : Real × Real), ∀ + (B : Real × Real), ∀ (k : Bool), P3934T1LocalSide W z B k → P3934T1LocalSide W z (-B) + (!k)) → (∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (s : + P3723T1PolygonalParameterization g), (P3934T1PolygonalSide U g s e) → ( + let flip : + Set.Icc (0 : Real) 1 → Set.Icc (0 : Real) 1 := fun t => + ⟨1 - (t : Real), ⟨sub_nonneg.mpr t.2.2, sub_le_self 1 t.2.1⟩⟩ + ∀ (flip_invol : Function.Involutive flip), ∀ (flip_cont : Continuous flip), + let flipEquiv : + Set.Icc (0 : Real) 1 ≃ Set.Icc (0 : Real) 1 := + { toFun := flip + invFun := flip + left_inv := flip_invol + right_inv := flip_invol } + let flipHomeo := Continuous.homeoOfEquivCompactToT2 (f := flipEquiv) flip_cont + ∀ (flipHomeo_apply : ∀ (t : Set.Icc (0 : Real) 1), flipHomeo t = flip t), + let gr : Set.Icc (0 + : Real) 1 → Real × Real := fun t => g (flipHomeo t) + let sr : P3723T1PolygonalParameterization gr := by + refine ⟨s.count, s.positive, fun i => 1 - s.time i.rev, ?_, ?_, ?_, ?_⟩ + · intro i j hij + have hrev : j.rev < i.rev := by + have := (Fin.rev_lt_iff (i := j) (j := i.rev)).2 (by simpa using hij) + simpa using this + exact sub_lt_sub_left (s.strict hrev) 1 + · simp [Fin.rev_zero, s.finish] + · simp [Fin.rev_last, s.start] + · intro i + let j : Fin s.count := i.rev + obtain ⟨A, B, hA⟩ := s.affine_on j + refine ⟨A + B, -B, ?_⟩ + intro t hlow hupp + have hlow' : s.time j.castSucc ≤ 1 - (t : Real) := by + have hj : j.castSucc = i.succ.rev := by + apply Fin.ext + simp [j, Fin.rev_succ] + rw [hj] + exact (le_sub_iff_add_le).2 (by + simpa [add_comm] using (le_sub_iff_add_le).1 hupp) + have hupp' : 1 - (t : Real) ≤ s.time j.succ := by + have hj : j.succ = i.castSucc.rev := by + apply Fin.ext + simp [j, Fin.rev_castSucc] + rw [hj] + exact (sub_le_iff_le_add).2 (by + simpa [add_comm] using (sub_le_iff_le_add).1 hlow) + let u : Set.Icc (0 : Real) 1 := ⟨1 - (t : Real), ⟨sub_nonneg.mpr t.2.2, sub_le_self 1 + t.2.1⟩⟩ + have hseg' := hA u hlow' hupp' + change g (flipHomeo t) = _ + rw [flipHomeo_apply] + have hu' : u = flip t := by apply Subtype.ext; rfl + rw [hu'] at hseg' + rw [hseg'] + apply Prod.ext + · change A.1 + (1 - (t : Real)) * B.1 = A.1 + B.1 + (t : Real) * (-B.1) + ring + · change A.2 + (1 - (t : Real)) * B.2 = A.2 + B.2 + (t : Real) * (-B.2) + ring + P3934T1PolygonalSide U gr sr (!e))) := by + classical + intro U e reverseLocal g s hs flip flip_invol flip_cont flipEquiv flipHomeo flipHomeo_apply gr + sr i + let j : Fin s.count := i.rev + obtain ⟨A, B, hB, hseg, hside⟩ := hs j + refine ⟨A + B, -B, ?_, ?_, ?_⟩ + · intro h + exact (neg_ne_zero.mpr hB) h + · intro t hlow hupp + have hlow' : s.time j.castSucc ≤ 1 - (t : Real) := by + have hj : j.castSucc = i.succ.rev := by + simpa only [j] using (Fin.rev_succ i).symm + change (t : Real) ≤ 1 - s.time i.succ.rev at hupp + have htime : s.time j.castSucc = s.time i.succ.rev := congrArg s.time hj + have ht : (t : Real) ≤ 1 - s.time j.castSucc := by rw [htime]; exact hupp + apply (le_sub_iff_add_le).2 + rw [add_comm] + exact (le_sub_iff_add_le).1 ht + have hupp' : 1 - (t : Real) ≤ s.time j.succ := by + have hj : j.succ = i.castSucc.rev := by + simpa only [j] using (Fin.rev_castSucc i).symm + change 1 - s.time i.castSucc.rev ≤ (t : Real) at hlow + have htime : s.time j.succ = s.time i.castSucc.rev := congrArg s.time hj + have ht : 1 - s.time j.succ ≤ (t : Real) := by rw [htime]; exact hlow + apply (sub_le_iff_le_add).2 + rw [add_comm] + exact (sub_le_iff_le_add).1 ht + let u : Set.Icc (0 : Real) 1 := ⟨1 - (t : Real), ⟨sub_nonneg.mpr t.2.2, sub_le_self 1 t.2.1⟩⟩ + have hloc := hseg u hlow' hupp' + change g (flipHomeo t) = _ + rw [flipHomeo_apply] + have hu' : u = flip t := by apply Subtype.ext; rfl + rw [hu'] at hloc + rw [hloc] + apply Prod.ext + · change A.1 + (1 - (t : Real)) * B.1 = A.1 + B.1 + (t : Real) * (-B.1) + ring + · change A.2 + (1 - (t : Real)) * B.2 = A.2 + B.2 + (t : Real) * (-B.2) + ring + · intro t hlow hupp + have hlow' : s.time j.castSucc < 1 - (t : Real) := by + have hj : j.castSucc = i.succ.rev := by + simpa only [j] using (Fin.rev_succ i).symm + have hsrtime : sr.time i.succ = 1 - s.time i.succ.rev := rfl + rw [hsrtime, ← hj] at hupp + have ht : (t : Real) < 1 - s.time j.castSucc := hupp + apply (lt_sub_iff_add_lt).2 + rw [add_comm] + exact (lt_sub_iff_add_lt).1 ht + have hupp' : 1 - (t : Real) < s.time j.succ := by + have hj : j.succ = i.castSucc.rev := by + simpa only [j] using (Fin.rev_castSucc i).symm + have hsrtime : sr.time i.castSucc = 1 - s.time i.castSucc.rev := rfl + rw [hsrtime, ← hj] at hlow + have ht : 1 - s.time j.succ < (t : Real) := hlow + apply (sub_lt_iff_lt_add).2 + rw [add_comm] + exact (sub_lt_iff_lt_add).1 ht + let u : Set.Icc (0 : Real) 1 := ⟨1 - (t : Real), ⟨sub_nonneg.mpr t.2.2, sub_le_self 1 t.2.1⟩⟩ + have hloc := hside u hlow' hupp' + have hneg := reverseLocal U (g u) B e hloc + have hflip : flipHomeo t = u := by apply Subtype.ext; rfl + change P3934T1LocalSide U (g (flipHomeo t)) (-B) (!e) + rw [hflip] + exact hneg + +end ArcComparisonGeometry + +namespace ArcComparisonMainProof + +private theorem negSign : + ∀ (k : Bool), ∀ (x : Real), (if k then 0 < x else x < 0) ↔ + (if !k then 0 < -x else -x < 0) := by + classical + intro k x + cases k <;> simp [Bool.not] + +private theorem reverseLocal : + (∀ (k : Bool), ∀ (x : Real), (if k then 0 < x else x < 0) ↔ (if !k then 0 < -x else -x < 0)) + → (∀ (W : Set (ℝ × ℝ)), ∀ (z : ℝ × ℝ), ∀ (B : ℝ × ℝ), ∀ (k : Bool), P3934T1LocalSide W + z B k → P3934T1LocalSide W z (-B) !k) := by + classical + intro negSign + exact ArcComparisonGeometry.reverseLocal negSign + +namespace ArcComparisonCoreFacts + +private theorem hgfun_surj : + ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (hgrange : + Set.range g = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ + Function.Surjective gfun := by + classical + intro S g hgrange gfun z + have hz : (z : Real × Real) ∈ Set.range g := by + rw [hgrange] + exact z.property + rcases hz with ⟨x, hx⟩ + refine ⟨x, ?_⟩ + apply Subtype.ext + exact hx + +private theorem hhfun_surj : + ∀ (S : Set (ℝ × ℝ)), ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (hhrange : + Set.range h = S), + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ + Function.Surjective hfun := by + classical + intro S h hhrange hfun z + have hz : (z : Real × Real) ∈ Set.range h := by + rw [hhrange] + exact z.property + rcases hz with ⟨x, hx⟩ + refine ⟨x, ?_⟩ + apply Subtype.ext + exact hx + +private theorem hphi_mono : + ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (hgrange : Set.range g = S), ∀ (hhrange : Set.range + h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ + ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ + (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ + let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ + ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), + let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont + let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont + let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm + let x0 : Set.Icc (0 : Real) 1 := ⟨0, by norm_num⟩ + let x1 : Set.Icc (0 : Real) 1 := ⟨1, by norm_num⟩ + (phi x0 = x0) → ((phi x1 = x1) → (StrictMono phi)) := by + classical + intro S g h hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he + hgfun_cont hhfun_cont GH HH phi x0 x1 hphi0 hphi1 + rcases phi.continuous.strictMono_of_inj phi.injective with hm | hm + · exact hm + · have h01 : x0 < x1 := by norm_num [x0, x1] + have := hm h01 + rw [hphi0, hphi1] at this + have hle : x0 ≤ x1 := by norm_num [x0, x1] + exact False.elim ((not_lt_of_ge hle) this) + +private theorem hx0L : + ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : + P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : + Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ + ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ + (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ + let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ + ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), + let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont + let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont + let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm + let x0 : Set.Icc (0 : Real) 1 := ⟨0, by norm_num⟩ + (phi x0 = x0) → ((StrictMono phi) → ( + let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ + let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ + ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time + j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ + let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ + let c : Real := min (phi α : Real) (β : Real) + ∀ (hcpos : 0 < c), (c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), + let r1 : Set.Icc (0 : Real) 1 := ⟨c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + (0 < (r1 : Real)) → ( + let xL : Set.Icc (0 : Real) 1 := phi.symm r1 + (phi xL = r1) → (x0 < xL))))) := by + classical + intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he + hgfun_cont hhfun_cont GH HH phi x0 hphi0 hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos + hc_le_b hc_le_one r1 hr1pos xL hφL + by_contra hh + have hle : xL ≤ x0 := le_of_not_gt hh + have hm := hphi_mono.monotone hle + rw [hφL, hphi0] at hm + have h0r : x0 < r1 := by exact_mod_cast hr1pos + exact (not_le_of_gt h0r) hm + +private theorem hx0R : + ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : + P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : + Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ + ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ + (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ + let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ + ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), + let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont + let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont + let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm + let x0 : Set.Icc (0 : Real) 1 := ⟨0, by norm_num⟩ + (phi x0 = x0) → ((StrictMono phi) → ( + let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ + let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ + ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time + j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ + let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ + let c : Real := min (phi α : Real) (β : Real) + ∀ (hcpos : 0 < c), (c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), + let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + (0 < (r2 : Real)) → ( + let xR : Set.Icc (0 : Real) 1 := phi.symm r2 + (phi xR = r2) → (x0 < xR))))) := by + classical + intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he + hgfun_cont hhfun_cont GH HH phi x0 hphi0 hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos + hc_le_b hc_le_one r2 hr2pos xR hφR + by_contra hh + have hle : xR ≤ x0 := le_of_not_gt hh + have hm := hphi_mono.monotone hle + rw [hφR, hphi0] at hm + have h0r : x0 < r2 := by exact_mod_cast hr2pos + exact (not_le_of_gt h0r) hm + +private theorem hxLa : + ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : + P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : + Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ + ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ + (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ + let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ + ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), + let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont + let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont + let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm + (StrictMono phi) → ( + let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ + let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ + ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time + j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ + let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ + let c : Real := min (phi α : Real) (β : Real) + ∀ (hcpos : 0 < c), (c ≤ (phi α : Real)) → ((c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), + let r1 : Set.Icc (0 : Real) 1 := ⟨c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + (0 < (r1 : Real)) → (((r1 : Real) < (r2 : Real)) → (((r2 : Real) < c) → ( + let xL : Set.Icc (0 : Real) 1 := phi.symm r1 + (phi xL = r1) → (xL < α))))))) := by + classical + intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he + hgfun_cont hhfun_cont GH HH phi hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_a + hc_le_b hc_le_one r1 r2 hr1pos hr12 hr2c xL hφL + by_contra hh + have hle : α ≤ xL := le_of_not_gt hh + have hm := hphi_mono.monotone hle + rw [hφL] at hm + have hr1c : (r1 : Real) < c := by dsimp [r1]; linarith [hcpos] + have hrc : (r1 : Real) < (phi α : Real) := lt_of_lt_of_le hr1c hc_le_a + have hrc' : r1 < phi α := by exact_mod_cast hrc + exact (not_le_of_gt hrc') hm + +private theorem hxRa : + ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : + P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : + Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ + ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ + (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ + let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ + ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), + let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont + let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont + let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm + (StrictMono phi) → ( + let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ + let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ + ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time + j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ + let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ + let c : Real := min (phi α : Real) (β : Real) + ∀ (hcpos : 0 < c), (c ≤ (phi α : Real)) → ((c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), + let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + ((r2 : Real) < c) → ( + let xR : Set.Icc (0 : Real) 1 := phi.symm r2 + (phi xR = r2) → (xR < α))))) := by + classical + intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he + hgfun_cont hhfun_cont GH HH phi hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_a + hc_le_b hc_le_one r2 hr2c xR hφR + by_contra hh + have hle : α ≤ xR := le_of_not_gt hh + have hm := hphi_mono.monotone hle + rw [hφR] at hm + have hrc : (r2 : Real) < (phi α : Real) := lt_of_lt_of_le hr2c hc_le_a + have hrc' : r2 < phi α := by exact_mod_cast hrc + exact (not_le_of_gt hrc') hm + +private theorem hxLR : + ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : + P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : + Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ + ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ + (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ + let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ + ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), + let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont + let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont + let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm + (StrictMono phi) → ( + let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ + let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ + ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time + j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ + let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ + let c : Real := min (phi α : Real) (β : Real) + ∀ (hcpos : 0 < c), (c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), + let r1 : Set.Icc (0 : Real) 1 := ⟨c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + ((r1 : Real) < (r2 : Real)) → ( + let xL : Set.Icc (0 : Real) 1 := phi.symm r1 + let xR : Set.Icc (0 : Real) 1 := phi.symm r2 + (phi xL = r1) → ((phi xR = r2) → (xL < xR))))) := by + classical + intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he + hgfun_cont hhfun_cont GH HH phi hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_b + hc_le_one r1 r2 hr12 xL xR hφL hφR + by_contra hh + have hle : xR ≤ xL := le_of_not_gt hh + have hm := hphi_mono.monotone hle + rw [hφR, hφL] at hm + have hlt : r1 < r2 := by exact_mod_cast hr12 + exact (not_le_of_gt hlt) hm + +private theorem hEqL : + ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : + P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : + Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ + ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ + (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ + let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ + ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), + let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont + let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont + let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm + (∀ (x : Set.Icc (0 : Real) 1), h (phi x) = g x) → ( + let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ + let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ + ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time + j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ + let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ + let c : Real := min (phi α : Real) (β : Real) + ∀ (hcpos : 0 < c), (c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), + let r1 : Set.Icc (0 : Real) 1 := ⟨c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + let xL : Set.Icc (0 : Real) 1 := phi.symm r1 + (phi xL = r1) → (∀ (Ag : ℝ × ℝ), ∀ (Bg : ℝ × ℝ), ∀ (Ah : ℝ × ℝ), ∀ (Bh : ℝ × ℝ), (g xL = Ag + + (↑xL : ℝ) • Bg) → ((h r1 = Ah + (↑r1 : ℝ) • Bh) → (Ag + (xL : Real) • Bg = Ah + (r1 : + Real) • Bh))))) := by + classical + intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he + hgfun_cont hhfun_cont GH HH phi hrel i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_b hc_le_one + r1 xL hφL Ag Bg Ah Bh hgL hhL + calc + Ag + (xL : Real) • Bg = g xL := hgL.symm + _ = h (phi xL) := (hrel xL).symm + _ = h r1 := by rw [hφL] + _ = Ah + (r1 : Real) • Bh := hhL + +private theorem hEqR : + ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : + P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : + Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ + ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ + (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ + let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ + ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), + let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont + let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont + let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm + (∀ (x : Set.Icc (0 : Real) 1), h (phi x) = g x) → ( + let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ + let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ + ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time + j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ + let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ + let c : Real := min (phi α : Real) (β : Real) + ∀ (hcpos : 0 < c), (c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), + let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + let xR : Set.Icc (0 : Real) 1 := phi.symm r2 + (phi xR = r2) → (∀ (Ag : ℝ × ℝ), ∀ (Bg : ℝ × ℝ), ∀ (Ah : ℝ × ℝ), ∀ (Bh : ℝ × ℝ), (g xR = Ag + + (↑xR : ℝ) • Bg) → ((h r2 = Ah + (↑r2 : ℝ) • Bh) → (Ag + (xR : Real) • Bg = Ah + (r2 : + Real) • Bh))))) := by + classical + intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he + hgfun_cont hhfun_cont GH HH phi hrel i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_b hc_le_one + r2 xR hφR Ag Bg Ah Bh hgR hhR + calc + Ag + (xR : Real) • Bg = g xR := hgR.symm + _ = h (phi xR) := (hrel xR).symm + _ = h r2 := by rw [hφR] + _ = Ah + (r2 : Real) • Bh := hhR + +private theorem hvel : + ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : + P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : + Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ + ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ + (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ + let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ + ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), + let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont + let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont + let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm + let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ + let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ + ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time + j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ + let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ + let c : Real := min (phi α : Real) (β : Real) + ∀ (hcpos : 0 < c), (c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), + let r1 : Set.Icc (0 : Real) 1 := ⟨c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + let xL : Set.Icc (0 : Real) 1 := phi.symm r1 + let xR : Set.Icc (0 : Real) 1 := phi.symm r2 + ∀ (Ag : ℝ × ℝ), ∀ (Bg : ℝ × ℝ), ∀ (Ah : ℝ × ℝ), ∀ (Bh : ℝ × ℝ), (Ag + (xL : Real) • Bg = Ah + + (r1 : Real) • Bh) → ((Ag + (xR : Real) • Bg = Ah + (r2 : Real) • Bh) → (((xR : Real) - + (xL : Real)) • Bg = ((r2 : Real) - (r1 : Real)) • Bh))) := by + classical + intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he + hgfun_cont hhfun_cont GH HH phi i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_b hc_le_one r1 r2 + xL xR Ag Bg Ah Bh hEqL hEqR + calc + ((xR : Real) - (xL : Real)) • Bg = + (Ag + (xR : Real) • Bg) - (Ag + (xL : Real) • Bg) := by module + _ = (Ah + (r2 : Real) • Bh) - (Ah + (r1 : Real) • Bh) := by rw [hEqR, hEqL] + _ = ((r2 : Real) - (r1 : Real)) • Bh := by module + +end ArcComparisonCoreFacts + +private theorem compareCore : + ∀ (S : Set (Real × Real)), ∀ (a : Real × Real), ∀ (b : Real × Real), ∀ (e : Bool), ∀ (d : + Bool), ∀ (U₁ : Set (Real × Real)), ∀ (U₂ : Set (Real × Real)), ∀ (g : Set.Icc (0 : Real) + 1 → Real × Real), ∀ (h : Set.Icc (0 : Real) 1 → Real × Real), ∀ (p : + P3723T1PolygonalParameterization g), ∀ (q : P3723T1PolygonalParameterization h), + Continuous g → Function.Injective g → Set.range g = S → + g ⟨0, by norm_num⟩ = a → g ⟨1, by norm_num⟩ = b → + P3934T1PolygonalSide U₁ g p e → + Continuous h → Function.Injective h → Set.range h = S → + h ⟨0, by norm_num⟩ = a → h ⟨1, by norm_num⟩ = b → + P3934T1PolygonalSide U₂ h q d → + (U₁ = U₂ → e = d) ∧ (Disjoint U₁ U₂ → e ≠ d) := by + classical + intro S a b e d U₁ U₂ g h p q hgcont hginj hgrange hga hgb hps hhcont hhinj hhrange hha hhb hqs + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ + have hgfun_inj : Function.Injective gfun := by + intro x y hxy + apply hginj + exact congrArg Subtype.val hxy + have hhfun_inj : Function.Injective hfun := by + intro x y hxy + apply hhinj + exact congrArg Subtype.val hxy + have hgfun_surj : Function.Surjective gfun := ArcComparisonCoreFacts.hgfun_surj S g hgrange + have hhfun_surj : Function.Surjective hfun := ArcComparisonCoreFacts.hhfun_surj S h hhrange + let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ + let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ + have hgfun_cont : Continuous gfun := by + apply Continuous.subtype_mk + exact hgcont + have hhfun_cont : Continuous hfun := by + apply Continuous.subtype_mk + exact hhcont + let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont + let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont + let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm + have hGH (x : Set.Icc (0 : Real) 1) : GH x = gfun x := by rfl + have hHH (x : Set.Icc (0 : Real) 1) : HH x = hfun x := by rfl + have hrel (x : Set.Icc (0 : Real) 1) : h (phi x) = g x := by + have hm : HH (phi x) = GH x := by simp [phi] + have hv := congrArg Subtype.val hm + rw [hHH, hGH] at hv + exact hv + let x0 : Set.Icc (0 : Real) 1 := ⟨0, by norm_num⟩ + let x1 : Set.Icc (0 : Real) 1 := ⟨1, by norm_num⟩ + have hphi0 : phi x0 = x0 := by + apply hhinj + rw [hrel, hga, hha] + have hphi1 : phi x1 = x1 := by + apply hhinj + rw [hrel, hgb, hhb] + have hphi_mono : StrictMono phi := ArcComparisonCoreFacts.hphi_mono S g h hgrange hhrange + hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi0 hphi1 + let i0 : Fin p.count := ⟨0, p.positive⟩ + let j0 : Fin q.count := ⟨0, q.positive⟩ + let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ + let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ + have hi01 : (0 : Fin (p.count + 1)) < i1 := by + change (0 : Nat) < 1 + norm_num + have hj01 : (0 : Fin (q.count + 1)) < j1 := by + change (0 : Nat) < 1 + norm_num + have hpstart : p.time (0 : Fin (p.count + 1)) = 0 := p.start + have hqstart : q.time (0 : Fin (q.count + 1)) = 0 := q.start + have hpi : 0 < p.time i1 := by rw [← hpstart]; exact p.strict hi01 + have hqj : 0 < q.time j1 := by rw [← hqstart]; exact q.strict hj01 + have hpi1 : p.time i1 ≤ 1 := by + rw [← p.finish] + exact p.strict.monotone (Fin.le_last i1) + have hqj1 : q.time j1 ≤ 1 := by + rw [← q.finish] + exact q.strict.monotone (Fin.le_last j1) + let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ + let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ + have hx0a : x0 < α := by exact_mod_cast hpi + have hφa : x0 < phi α := by + have := hphi_mono hx0a + simpa [hphi0] using this + have hx0b : x0 < β := by exact_mod_cast hqj + let c : Real := min (phi α : Real) (β : Real) + have hcpos : 0 < c := by + dsimp [c] + exact lt_min (by exact_mod_cast hφa) (by exact_mod_cast hx0b) + have hc_le_a : c ≤ (phi α : Real) := min_le_left _ _ + have hc_le_b : c ≤ (β : Real) := min_le_right _ _ + have hc_le_one : c ≤ 1 := (hc_le_a.trans (phi α).property.2) + let r1 : Set.Icc (0 : Real) 1 := ⟨c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + have hr1pos : 0 < (r1 : Real) := by dsimp [r1]; linarith + have hr2pos : 0 < (r2 : Real) := by dsimp [r2]; linarith + have hr12 : (r1 : Real) < (r2 : Real) := by dsimp [r1, r2]; linarith + have hr2c : (r2 : Real) < c := by dsimp [r2]; linarith + let xL : Set.Icc (0 : Real) 1 := phi.symm r1 + let xR : Set.Icc (0 : Real) 1 := phi.symm r2 + have hφL : phi xL = r1 := by simp [xL] + have hφR : phi xR = r2 := by simp [xR] + have hx0L : x0 < xL := ArcComparisonCoreFacts.hx0L S g h p q hgrange hhrange hgfun_inj + hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi0 hphi_mono hpi hqj hpi1 hqj1 + hcpos hc_le_b hc_le_one hr1pos hφL + have hx0R : x0 < xR := ArcComparisonCoreFacts.hx0R S g h p q hgrange hhrange hgfun_inj + hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi0 hphi_mono hpi hqj hpi1 hqj1 + hcpos hc_le_b hc_le_one hr2pos hφR + have hxLa : xL < α := ArcComparisonCoreFacts.hxLa S g h p q hgrange hhrange hgfun_inj hhfun_inj + hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi_mono hpi hqj hpi1 hqj1 hcpos hc_le_a + hc_le_b hc_le_one hr1pos hr12 hr2c hφL + have hxRa : xR < α := ArcComparisonCoreFacts.hxRa S g h p q hgrange hhrange hgfun_inj hhfun_inj + hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi_mono hpi hqj hpi1 hqj1 hcpos hc_le_a + hc_le_b hc_le_one hr2c hφR + have hxLR : xL < xR := ArcComparisonCoreFacts.hxLR S g h p q hgrange hhrange hgfun_inj + hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi_mono hpi hqj hpi1 hqj1 hcpos + hc_le_b hc_le_one hr12 hφL hφR + have hu1β : r1 < β := by + have h : (r1 : Real) < (β : Real) := lt_of_lt_of_le (by dsimp [r1]; linarith [hcpos]) hc_le_b + exact_mod_cast h + have hu2β : r2 < β := by + have h : (r2 : Real) < (β : Real) := lt_of_lt_of_le hr2c hc_le_b + exact_mod_cast h + have hplowL : p.time i0.castSucc ≤ (xL : Real) := by + rw [show i0.castSucc = (0 : Fin (p.count + 1)) by rfl, hpstart] + exact xL.property.1 + have hplowR : p.time i0.castSucc ≤ (xR : Real) := by + rw [show i0.castSucc = (0 : Fin (p.count + 1)) by rfl, hpstart] + exact xR.property.1 + have hiSucc : i0.succ = i1 := by apply Fin.ext; rfl + have hiCast : i0.castSucc = (0 : Fin (p.count + 1)) := by apply Fin.ext; rfl + have hjSucc : j0.succ = j1 := by apply Fin.ext; rfl + have hjCast : j0.castSucc = (0 : Fin (q.count + 1)) := by apply Fin.ext; rfl + have hpupL : (xL : Real) ≤ p.time i0.succ := by + rw [hiSucc] + exact_mod_cast hxLa.le + have hpupR : (xR : Real) ≤ p.time i0.succ := by + rw [hiSucc] + exact_mod_cast hxRa.le + have hqLow1 : q.time j0.castSucc ≤ (r1 : Real) := by + rw [hjCast, hqstart] + exact r1.property.1 + have hqLow2 : q.time j0.castSucc ≤ (r2 : Real) := by + rw [hjCast, hqstart] + exact r2.property.1 + have hqUp1 : (r1 : Real) ≤ q.time j0.succ := by + rw [hjSucc] + exact hu1β.le + have hqUp2 : (r2 : Real) ≤ q.time j0.succ := by + rw [hjSucc] + exact hu2β.le + obtain ⟨Ag, Bg, hBg, hgline, hgside⟩ := hps i0 + obtain ⟨Ah, Bh, hBh, hhline, hhside⟩ := hqs j0 + have hgL := hgline xL hplowL hpupL + have hgR := hgline xR hplowR hpupR + have hhL := hhline r1 hqLow1 hqUp1 + have hhR := hhline r2 hqLow2 hqUp2 + have hEqL : Ag + (xL : Real) • Bg = Ah + (r1 : Real) • Bh := ArcComparisonCoreFacts.hEqL S g h + p q hgrange hhrange hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hrel + hpi hqj hpi1 hqj1 hcpos hc_le_b hc_le_one hφL Ag Bg Ah Bh hgL hhL + have hEqR : Ag + (xR : Real) • Bg = Ah + (r2 : Real) • Bh := ArcComparisonCoreFacts.hEqR S g h + p q hgrange hhrange hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hrel + hpi hqj hpi1 hqj1 hcpos hc_le_b hc_le_one hφR Ag Bg Ah Bh hgR hhR + have hvel : ((xR : Real) - (xL : Real)) • Bg = ((r2 : Real) - (r1 : Real)) • Bh := + ArcComparisonCoreFacts.hvel S g h p q hgrange hhrange hgfun_inj hhfun_inj hgfun_surj + hhfun_surj hgfun_cont hhfun_cont hpi hqj hpi1 hqj1 hcpos hc_le_b hc_le_one Ag Bg Ah Bh hEqL + hEqR + let scale : Real := ((xR : Real) - (xL : Real)) / ((r2 : Real) - (r1 : Real)) + have hscale_pos : 0 < scale := by + dsimp [scale] + exact div_pos (sub_pos.mpr (by exact_mod_cast hxLR)) (sub_pos.mpr hr12) + have hscale := ArcComparisonGeometry.hscale S g h p q hgrange hhrange + hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hpi hqj hpi1 hqj1 hcpos + hc_le_b hc_le_one hr12 Bg Bh hvel + let z : Real × Real := g xL + have hplowLstrict : p.time i0.castSucc < (xL : Real) := by + rw [hiCast, hpstart] + exact_mod_cast hx0L + have hpupLstrict : (xL : Real) < p.time i0.succ := by + rw [hiSucc] + exact_mod_cast hxLa + have hqLow1strict : q.time j0.castSucc < (r1 : Real) := by + rw [hjCast, hqstart] + exact_mod_cast hr1pos + have hqUp1strict : (r1 : Real) < q.time j0.succ := by + rw [hjSucc] + exact hu1β + have hlocG : P3934T1LocalSide U₁ z Bg e := by + change P3934T1LocalSide U₁ (g xL) Bg e + exact hgside xL hplowLstrict hpupLstrict + have hlocH : P3934T1LocalSide U₂ z Bh d := by + have hh := hhside r1 hqLow1strict hqUp1strict + have hz : h r1 = g xL := by rw [← hφL, hrel] + rw [hz] at hh + change P3934T1LocalSide U₂ (g xL) Bh d at hh + exact hh + have localResult := ArcComparisonGeometry.localResult S e d U₁ U₂ g h p q hgrange hps hhrange + hqs hgfun_inj + hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hpi hqj hpi1 hqj1 hcpos hc_le_b + hc_le_one Bg hBg hgside Bh hhside hscale_pos hscale hlocG hlocH + exact localResult + +end ArcComparisonMainProof + +theorem P3934T1ArcSideComparison (U V S : Set (Real × Real)) + (a b : Real × Real) (e d : Bool) : + (P3934T1ArcSide U S a b e → P3934T1ArcSide U S b a (!e)) ∧ + (P3934T1ArcSide U S a b e → P3934T1ArcSide U S a b d → e = d) ∧ + (Disjoint U V → P3934T1ArcSide U S a b e → + P3934T1ArcSide V S a b d → e ≠ d) := by +-- BODY + have negSign (k : Bool) (x : Real) : + (if k then 0 < x else x < 0) ↔ + (if !k then 0 < -x else -x < 0) := ArcComparisonMainProof.negSign k x + have reverseLocal := ArcComparisonMainProof.reverseLocal negSign + have compareCore : ∀ (U₁ U₂ : Set (Real × Real)) + (g h : Set.Icc (0 : Real) 1 → Real × Real) + (p : P3723T1PolygonalParameterization g) + (q : P3723T1PolygonalParameterization h), + Continuous g → Function.Injective g → Set.range g = S → + g ⟨0, by norm_num⟩ = a → g ⟨1, by norm_num⟩ = b → + P3934T1PolygonalSide U₁ g p e → + Continuous h → Function.Injective h → Set.range h = S → + h ⟨0, by norm_num⟩ = a → h ⟨1, by norm_num⟩ = b → + P3934T1PolygonalSide U₂ h q d → + (U₁ = U₂ → e = d) ∧ (Disjoint U₁ U₂ → e ≠ d) := ArcComparisonMainProof.compareCore S a b e d + constructor + · intro h + rcases h with ⟨g, hgcont, hginj, hgrange, hga, hgb, s, hs⟩ + let flip : Set.Icc (0 : Real) 1 → Set.Icc (0 : Real) 1 := fun t => + ⟨1 - (t : Real), ⟨sub_nonneg.mpr t.2.2, sub_le_self 1 t.2.1⟩⟩ + have flip_invol : Function.Involutive flip := by + intro t + apply Subtype.ext + exact sub_sub_cancel 1 (t : Real) + have flip_cont : Continuous flip := by + dsimp [flip] + apply Continuous.subtype_mk + exact continuous_const.sub continuous_subtype_val + let flipEquiv : Set.Icc (0 : Real) 1 ≃ Set.Icc (0 : Real) 1 := + { toFun := flip + invFun := flip + left_inv := flip_invol + right_inv := flip_invol } + let flipHomeo := Continuous.homeoOfEquivCompactToT2 (f := flipEquiv) flip_cont + have flipHomeo_apply (t : Set.Icc (0 : Real) 1) : flipHomeo t = flip t := rfl + let gr : Set.Icc (0 : Real) 1 → Real × Real := fun t => g (flipHomeo t) + have grcont : Continuous gr := hgcont.comp flipHomeo.continuous + have grinj : Function.Injective gr := by + intro x y hxy + apply flipHomeo.injective + exact hginj hxy + have grange := ArcComparisonGeometry.grange S g hgrange flip_invol flip_cont + let r0 : Set.Icc (0 : Real) 1 := ⟨0, by norm_num⟩ + let r1 : Set.Icc (0 : Real) 1 := ⟨1, by norm_num⟩ + have flip0 : flipHomeo r0 = r1 := by + apply Subtype.ext + change 1 - (0 : Real) = 1 + norm_num + have flip1 : flipHomeo r1 = r0 := by + apply Subtype.ext + change 1 - (1 : Real) = 0 + norm_num + have hga' : gr ⟨0, by norm_num⟩ = b := by + change g (flipHomeo r0) = b + rw [flip0] + exact hgb + have hgb' : gr ⟨1, by norm_num⟩ = a := by + change g (flipHomeo r1) = a + rw [flip1] + exact hga + let sr : P3723T1PolygonalParameterization gr := by + refine ⟨s.count, s.positive, fun i => 1 - s.time i.rev, ?_, ?_, ?_, ?_⟩ + · intro i j hij + have hrev : j.rev < i.rev := by + have := (Fin.rev_lt_iff (i := j) (j := i.rev)).2 (by simpa using hij) + simpa using this + exact sub_lt_sub_left (s.strict hrev) 1 + · simp [Fin.rev_zero, s.finish] + · simp [Fin.rev_last, s.start] + · intro i + let j : Fin s.count := i.rev + obtain ⟨A, B, hA⟩ := s.affine_on j + refine ⟨A + B, -B, ?_⟩ + intro t hlow hupp + have hlow' : s.time j.castSucc ≤ 1 - (t : Real) := by + have hj : j.castSucc = i.succ.rev := by + apply Fin.ext + simp [j, Fin.rev_succ] + rw [hj] + exact (le_sub_iff_add_le).2 (by + simpa [add_comm] using (le_sub_iff_add_le).1 hupp) + have hupp' : 1 - (t : Real) ≤ s.time j.succ := by + have hj : j.succ = i.castSucc.rev := by + apply Fin.ext + simp [j, Fin.rev_castSucc] + rw [hj] + exact (sub_le_iff_le_add).2 (by + simpa [add_comm] using (sub_le_iff_le_add).1 hlow) + let u : Set.Icc (0 : Real) 1 := ⟨1 - (t : Real), ⟨sub_nonneg.mpr t.2.2, sub_le_self 1 + t.2.1⟩⟩ + have hseg' := hA u hlow' hupp' + change g (flipHomeo t) = _ + rw [flipHomeo_apply] + have hu' : u = flip t := by apply Subtype.ext; rfl + rw [hu'] at hseg' + rw [hseg'] + apply Prod.ext + · change A.1 + (1 - (t : Real)) * B.1 = A.1 + B.1 + (t : Real) * (-B.1) + ring + · change A.2 + (1 - (t : Real)) * B.2 = A.2 + B.2 + (t : Real) * (-B.2) + ring + have hsr := ArcComparisonGeometry.hsr U e reverseLocal + g s hs flip_invol flip_cont flipHomeo_apply + refine ⟨gr, grcont, grinj, grange, hga', hgb', sr, ?_⟩ + exact hsr + · constructor + · intro hU hV + rcases hU with ⟨g, hgcont, hginj, hgrange, hga, hgb, p, hps⟩ + rcases hV with ⟨h, hhcont, hhinj, hhrange, hha, hhb, q, hqs⟩ + exact (compareCore U U g h p q hgcont hginj hgrange hga hgb hps + hhcont hhinj hhrange hha hhb hqs).1 rfl + · intro hdisj hU hV + rcases hU with ⟨g, hgcont, hginj, hgrange, hga, hgb, p, hps⟩ + rcases hV with ⟨h, hhcont, hhinj, hhrange, hha, hhb, q, hqs⟩ + exact (compareCore U V g h p q hgcont hginj hgrange hga hgb hps + hhcont hhinj hhrange hha hhb hqs).2 hdisj + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1LocalSide.lean b/LeanPool/ApollonianSuperharmonic/P3934T1LocalSide.lean new file mode 100644 index 0000000000..d314c0b7a5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3934T1LocalSide.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Normed.Module.Basic + +-- [TABLET NODE: P3934T1LocalSide] + +/-! +# P3934T1LocalSide + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a plane set $U$, a point $z$, a vector $w$, and a Boolean $e$, +write $\operatorname{Side}(U,z,w,e)$ if some $r>0$ satisfies +$$ + U\cap B(z,r)=\{q\in B(z,r):[w,q-z]>0\}\quad(e=\mathrm{true}), +$$ +and the same equation with $[w,q-z]<0$ if $e=\mathrm{false}$. +Here $[w,h]=w_1h_2-w_2h_1$ and balls use the product norm. +-/ +def P3934T1LocalSide (U : Set (Real × Real)) (z w : Real × Real) + (positive : Bool) : Prop := +-- BODY + ∃ r : Real, 0 < r ∧ U ∩ Metric.ball z r = + {q | q ∈ Metric.ball z r ∧ + if positive then 0 < w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1) + else w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1) < 0} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSide.lean b/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSide.lean new file mode 100644 index 0000000000..b825a8bc34 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSide.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3934T1LocalSide +public import LeanPool.ApollonianSuperharmonic.P3723T1PolygonalParameterization + +-- [TABLET NODE: P3934T1PolygonalSide] + +/-! +# P3934T1PolygonalSide + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $s$ be a `P3723T1PolygonalParameterization` of $g$, +with strictly increasing subdivision times $t_i$. +The predicate $\operatorname{PolySide}(U,g,s,e)$ means that for every +piece $i$ there are $A_i,B_i\in\mathbb R^2$ with $B_i\ne0$ such that +$g(t)=A_i+tB_i$ throughout $[t_i,t_{i+1}]$, and +$\operatorname{Side}(U,g(t),B_i,e)$ for every $t_i hpieces l) + have hKclosed : IsClosed K := hKcompact.isClosed + have hpoint : g k t ∉ K := by + intro hz + change g k t ∈ ⋃ l : Fin 3, g l '' (if l = k then bad else Set.univ) at hz + obtain ⟨l, hl⟩ := Set.mem_iUnion.mp hz + by_cases hkl : l = k + · subst l + exact hbadpoint (by simpa using hl) + · obtain ⟨a, ha, hga⟩ := hl + have hq : g k t ∈ Set.range (g k) ∩ Set.range (g l) := by + refine ⟨⟨t, rfl⟩, ?_⟩ + exact ⟨a, hga⟩ + obtain ⟨hendk, hendl⟩ := hinter k l (Ne.symm hkl) hq + rcases hendk with hendk | hendk + · have hteq : t = ⟨0, by norm_num⟩ := hi k (by simpa using hendk) + have htpos : 0 < (t : Real) := lt_of_le_of_lt + (by rw [← (s k).start]; exact (s k).strict.monotone (Fin.zero_le _)) htlo + have htval : (t : Real) = 0 := congrArg Subtype.val hteq + linarith + · have hteq : t = ⟨1, by norm_num⟩ := hi k (by simpa using hendk) + have htlt : (t : Real) < 1 := lt_of_lt_of_le hthi (by + calc (s k).time i.succ ≤ (s k).time (Fin.last (s k).count) := + (s k).strict.monotone (Fin.le_last _) + _ = 1 := (s k).finish) + have htval : (t : Real) = 1 := congrArg Subtype.val hteq + linarith + obtain ⟨r, hr, hdis⟩ := avoidClosed K hKclosed (g k t) hpoint + refine ⟨r, hr, ?_⟩ + intro l a ha + have hnotK : g l a ∉ K := by + intro hm + exact (Set.disjoint_left.mp hdis ha) hm + by_cases hl : l = k + · subst l + refine ⟨rfl, ?_, ?_⟩ + · by_contra h + have hmem : g k a ∈ K := by + change g k a ∈ ⋃ l : Fin 3, g l '' (if l = k then bad else Set.univ) + apply Set.mem_iUnion.mpr + refine ⟨k, ?_⟩ + simp only [] + exact ⟨a, Set.mem_ofPred_eq.mpr (Or.inl (le_of_not_gt h)), rfl⟩ + exact hnotK hmem + · by_contra h + have hmem : g k a ∈ K := by + change g k a ∈ ⋃ l : Fin 3, g l '' (if l = k then bad else Set.univ) + apply Set.mem_iUnion.mpr + refine ⟨k, ?_⟩ + simp only [] + exact ⟨a, Set.mem_ofPred_eq.mpr (Or.inr (le_of_not_gt h)), rfl⟩ + exact hnotK hmem + · have hmem : g l a ∈ K := by + change g l a ∈ ⋃ j : Fin 3, g j '' (if j = k then bad else Set.univ) + apply Set.mem_iUnion.mpr + refine ⟨l, ?_⟩ + rw [ite_eq_right hl, Set.image_univ] + exact ⟨a, rfl⟩ + exact (hnotK hmem).elim + +private theorem scaleLocalSide : + (by + classical + exact + ∀ (W : Set (ℝ × ℝ)), ∀ (z : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (c : ℝ), ∀ (e : Bool), (0 : ℝ) < c → + P3934T1LocalSide W z w e → P3934T1LocalSide W z (c • w) e ) := by + classical + intro W z w c e hc hside + obtain ⟨r, hr, heq⟩ := hside + refine ⟨r, hr, ?_⟩ + have hdet (q : Real × Real) : + (c • w).1 * (q.2 - z.2) - (c • w).2 * (q.1 - z.1) = + c * (w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1)) := by + simp only [Prod.smul_fst, Prod.smul_snd] + ring + ext q + rw [heq] + simp only [Set.mem_ofPred_eq] + rw [hdet q] + constructor + · rintro ⟨hq, hs⟩ + refine ⟨hq, ?_⟩ + cases e <;> simp at hs ⊢ <;> + nlinarith [hc] + · rintro ⟨hq, hs⟩ + refine ⟨hq, ?_⟩ + cases e <;> simp at hs ⊢ <;> + nlinarith [hc] + +private theorem straightFrontierRays : + (by + classical + exact + ∀ (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real), ∀ (s : ∀ k, + P3723T1PolygonalParameterization (g k)), ∀ (U : Set (Real × Real)), (frontier U = ⋃ + (k : Fin (3 : ℕ)), Set.range (g k)) → ((∀ (k : Fin 3), ∀ (i : Fin (s k).count), ∀ (t + : Set.Icc (0 : Real) 1), ((s k).time i.castSucc < (t : Real)) → (((t : Real) < (s + k).time i.succ) → (∃ r : Real, 0 < r ∧ ∀ l, ∀ (a : Set.Icc (0 : Real) 1), g l a ∈ + Metric.ball (g k t) r → l = k ∧ (s k).time i.castSucc < (a : Real) ∧ (a : Real) < (s + k).time i.succ))) → (∀ (k : Fin (3 : ℕ)), ∀ (i : Fin (s k).count), ∀ (A : ℝ × ℝ), ∀ + (B : ℝ × ℝ), B ≠ (0 : ℝ × ℝ) → (∀ (a : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (s + k).time i.castSucc ≤ (↑a : ℝ) → (↑a : ℝ) ≤ (s k).time i.succ → g k a = A + (↑a : ℝ) • + B) → ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (s k).time i.castSucc < (↑t : ℝ) → + (↑t : ℝ) < (s k).time i.succ → ∃ (r : ℝ), (0 : ℝ) < r ∧ frontier U ∩ Metric.ball (g k + t) r = ({q : ℝ × ℝ | ∃ (a : ℝ), (0 : ℝ) ≤ a ∧ q = g k t + a • ‖B‖⁻¹ • B} ∪ {q : ℝ × ℝ + | ∃ (a : ℝ), (0 : ℝ) ≤ a ∧ q = g k t - a • ‖B‖⁻¹ • B}) ∩ Metric.ball (g k t) r)) ) := by + classical + intro g s U hf isolatePiece k i A B hB hline t htlo hthi + obtain ⟨r, hr, hisolate⟩ := isolatePiece k i t htlo hthi + let n : Real := ‖B‖ + have hn : 0 < n := by + dsimp [n] + exact norm_pos_iff.mpr hB + let d : Real × Real := n⁻¹ • B + have hBdecomp : B = n • d := by + dsimp [d] + rw [smul_smul] + simp [n, hn.ne'] + have hd : ‖d‖ = 1 := by + dsimp [d] + rw [norm_smul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr hn)] + change n⁻¹ * n = 1 + exact inv_mul_cancel₀ hn.ne' + have hlineT := hline t (le_of_lt htlo) (le_of_lt hthi) + have hfirst : 0 ≤ (s k).time i.castSucc := by + calc + 0 = (s k).time 0 := (s k).start.symm + _ ≤ (s k).time i.castSucc := (s k).strict.monotone (Fin.zero_le _) + have hlast : (s k).time i.succ ≤ 1 := by + calc + (s k).time i.succ ≤ (s k).time (Fin.last (s k).count) := + (s k).strict.monotone (Fin.le_last _) + _ = 1 := (s k).finish + let R : Real := min r (min (((t : Real) - (s k).time i.castSucc) * n) + (((s k).time i.succ - (t : Real)) * n)) + have hR : 0 < R := by + dsimp [R] + exact lt_min hr (lt_min (mul_pos (by linarith) hn) + (mul_pos (by linarith) hn)) + have hRiso : R ≤ r := min_le_left _ _ + have hRleft : R ≤ ((t : Real) - (s k).time i.castSucc) * n := + (min_le_right _ _).trans (min_le_left _ _) + have hRright : R ≤ ((s k).time i.succ - (t : Real)) * n := + (min_le_right _ _).trans (min_le_right _ _) + refine ⟨R, hR, ?_⟩ + ext q + constructor + · rintro ⟨hqfront, hqball⟩ + have hqball' : q ∈ Metric.ball (g k t) r := + Metric.ball_subset_ball hRiso hqball + have hqRays : q ∈ + {q | ∃ a : Real, 0 ≤ a ∧ q = g k t + a • d} ∪ + {q | ∃ a : Real, 0 ≤ a ∧ q = g k t - a • d} := by + rw [hf] at hqfront + obtain ⟨l, hl⟩ := Set.mem_iUnion.mp hqfront + obtain ⟨a, hga⟩ := hl + have hgaBall : g l a ∈ Metric.ball (g k t) r := by rw [hga]; exact hqball' + obtain ⟨hlk, haLo, haHi⟩ := hisolate l a hgaBall + have hgaK : g k a = q := by simpa [hlk] using hga + have hlineA := hline a (le_of_lt haLo) (le_of_lt haHi) + have hdiff : q = g k t + ((a : Real) - (t : Real)) • B := by + rw [← hgaK, hlineA, hlineT] + ext <;> simp [smul_eq_mul] <;> ring + have hdiff' : q = g k t + (((a : Real) - (t : Real)) * n) • d := by + rw [hdiff, hBdecomp, smul_smul] + by_cases hc : 0 ≤ ((a : Real) - (t : Real)) * n + · left + exact ⟨_, hc, by simpa [n, d] using hdiff'⟩ + · right + have hneg : ((a : Real) - (t : Real)) * n < 0 := lt_of_not_ge hc + refine ⟨-(((a : Real) - (t : Real)) * n), neg_nonneg.mpr hneg.le, ?_⟩ + have hvec : -((-(((a : Real) - (t : Real)) * n)) • d) = + (((a : Real) - (t : Real)) * n) • d := by + ext <;> simp [d, Prod.smul_fst, Prod.smul_snd] + calc + q = g k t + (((a : Real) - (t : Real)) * n) • d := hdiff' + _ = g k t - (-(((a : Real) - (t : Real)) * n)) • d := by + rw [← hvec] + simp [sub_eq_add_neg] + exact ⟨hqRays, hqball⟩ + · rintro ⟨hqRays, hqball⟩ + refine ⟨?_, hqball⟩ + rcases hqRays with hplus | hminus + · obtain ⟨a, ha, hqa⟩ := hplus + have hsmall : a < R := by + have hdist := Metric.mem_ball.mp hqball + have hqa' : q = g k t + a • d := by simpa [n, d] using hqa + rw [hqa', dist_eq_norm] at hdist + simp only [add_sub_cancel_left, norm_smul, Real.norm_eq_abs, + abs_of_nonneg ha, hd, mul_one] at hdist + nlinarith [hdist] + have hdelta : a / n < (s k).time i.succ - (t : Real) := by + apply (div_lt_iff₀ hn).2 + exact lt_of_lt_of_le hsmall hRright + have hparam : (t : Real) + a / n < (s k).time i.succ := by linarith + have hparamlo : (s k).time i.castSucc ≤ (t : Real) + a / n := by + have hdiv : 0 ≤ a / n := div_nonneg ha hn.le + linarith [htlo, hdiv] + have hparam0 : 0 ≤ (t : Real) + a / n := by + have hdiv : 0 ≤ a / n := div_nonneg ha hn.le + linarith [hfirst, htlo, hdiv] + have hparam1 : (t : Real) + a / n ≤ 1 := + le_of_lt (hparam.trans_le hlast) + let b : Set.Icc (0 : Real) 1 := ⟨(t : Real) + a / n, ⟨hparam0, hparam1⟩⟩ + have hlineB := hline b hparamlo (le_of_lt hparam) + have hmove : (a / n) • B = a • d := by + rw [hBdecomp, smul_smul] + congr 1 + field_simp [hn.ne'] + have hgb : g k b = q := by + calc + g k b = A + ((t : Real) + a / n) • B := hlineB + _ = (A + (t : Real) • B) + (a / n) • B := by + ext <;> simp [smul_eq_mul] <;> ring + _ = g k t + a • d := by rw [hlineT, hmove] + _ = q := hqa.symm + rw [hf] + exact Set.mem_iUnion.mpr ⟨k, ⟨b, hgb⟩⟩ + · obtain ⟨a, ha, hqa⟩ := hminus + have hsmall : a < R := by + have hdist := Metric.mem_ball.mp hqball + have hqa' : q = g k t - a • d := by simpa [n, d] using hqa + rw [dist_eq_norm] at hdist + have hdiff : q - g k t = -(a • d) := by rw [hqa']; simp + rw [hdiff, norm_neg, norm_smul, Real.norm_eq_abs, + abs_of_nonneg ha, hd, mul_one] at hdist + simpa only [mul_one] using hdist + have hdelta : a / n < (t : Real) - (s k).time i.castSucc := by + apply (div_lt_iff₀ hn).2 + exact lt_of_lt_of_le hsmall hRleft + have hparam : (s k).time i.castSucc < (t : Real) - a / n := by linarith + have hparamhi : (t : Real) - a / n ≤ (s k).time i.succ := by + have hdiv : 0 ≤ a / n := div_nonneg ha hn.le + linarith [hthi, hdiv] + have hparam0 : 0 ≤ (t : Real) - a / n := by linarith [hfirst, hparam] + have hparam1 : (t : Real) - a / n ≤ 1 := hparamhi.trans hlast + let b : Set.Icc (0 : Real) 1 := ⟨(t : Real) - a / n, ⟨hparam0, hparam1⟩⟩ + have hlineB := hline b (le_of_lt hparam) hparamhi + have hmove : (a / n) • B = a • d := by + rw [hBdecomp, smul_smul] + congr 1 + field_simp [hn.ne'] + have hgb : g k b = q := by + calc + g k b = A + ((t : Real) - a / n) • B := hlineB + _ = (A + (t : Real) • B) - (a / n) • B := by + ext <;> simp [smul_eq_mul, sub_eq_add_neg] <;> ring + _ = g k t - a • d := by rw [hlineT, hmove] + _ = q := hqa.symm + rw [hf] + exact Set.mem_iUnion.mpr ⟨k, ⟨b, hgb⟩⟩ + +private theorem straightSideAt : + (by + classical + exact + ∀ (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real), ∀ (s : ∀ k, + P3723T1PolygonalParameterization (g k)), ∀ (U : Set (Real × Real)), (IsOpen U) → + ((frontier (closure U)ᶜ = frontier U) → ((∀ (k : Fin 3), ∀ (i : Fin (s k).count), ∀ + (A : Real × Real), ∀ (B : Real × Real), (B ≠ 0) → ((∀ a : Set.Icc (0 : Real) 1, (s + k).time i.castSucc ≤ (a : Real) → (a : Real) ≤ (s k).time i.succ → g k a = A + (a : + Real) • B) → (∀ (t : Set.Icc (0 : Real) 1), ((s k).time i.castSucc < (t : Real)) → + (((t : Real) < (s k).time i.succ) → (∃ r : Real, 0 < r ∧ frontier U ∩ Metric.ball (g + k t) r = ({q | ∃ a : Real, 0 ≤ a ∧ q = g k t + a • (‖B‖⁻¹ • B)} ∪ {q | ∃ a : Real, 0 + ≤ a ∧ q = g k t - a • (‖B‖⁻¹ • B)}) ∩ Metric.ball (g k t) r))))) → (∀ (k : Fin (3 : + ℕ)), ∀ (i : Fin (s k).count), ∀ (A : ℝ × ℝ), ∀ (B : ℝ × ℝ), B ≠ (0 : ℝ × ℝ) → (∀ (a : + (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (s k).time i.castSucc ≤ (↑a : ℝ) → (↑a : ℝ) ≤ + (s k).time i.succ → g k a = A + (↑a : ℝ) • B) → ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : + Type)), (s k).time i.castSucc < (↑t : ℝ) → (↑t : ℝ) < (s k).time i.succ → ∃ (e : + Bool), P3934T1LocalSide U (g k t) B e ∧ P3934T1LocalSide (closure U)ᶜ (g k t) B + !e))) ) := by + classical + intro g s U hU he straightFrontierRays k i A B hB hline t htlo hthi + obtain ⟨r, hr, hchart⟩ := straightFrontierRays k i A B hB hline t htlo hthi + exact P5667T1StraightFrontierLocalSides U hU he (g k t) B hB r hr hchart + +private theorem sideMove : + (by + classical + exact + ∀ (W : Set (ℝ × ℝ)), ∀ (z : ℝ × ℝ), ∀ (z' : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (e : Bool), (∃ (c : + ℝ), z' = z + c • w) → ∀ (hside : P3934T1LocalSide W z w e), dist z' z < + Classical.choose hside → P3934T1LocalSide W z' w e ) := by + classical + intro W z z' w e hshift hside hclose + let r := Classical.choose hside + have hspec := Classical.choose_spec hside + obtain ⟨hr, heq⟩ := hspec + have hdist : dist z' z < r := hclose + let δ := r - dist z' z + have hδ : 0 < δ := sub_pos.mpr hdist + have hsmall (q : Real × Real) (hq : q ∈ Metric.ball z' δ) : + q ∈ Metric.ball z r := by + rw [Metric.mem_ball] at hq ⊢ + calc + dist q z ≤ dist q z' + dist z' z := dist_triangle _ _ _ + _ < δ + dist z' z := add_lt_add_left hq _ + _ = r := by dsimp [δ]; ring + have hdet (q : Real × Real) : + w.1 * (q.2 - z'.2) - w.2 * (q.1 - z'.1) = + w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1) := by + obtain ⟨c, hc⟩ := hshift + rw [hc] + simp [Prod.smul_fst, Prod.smul_snd] + ring + refine ⟨δ, hδ, ?_⟩ + ext q + simp only [Set.mem_inter_iff, Set.mem_ofPred_eq] + constructor + · rintro ⟨hW, hq⟩ + have hmem : q ∈ W ∩ Metric.ball z r := ⟨hW, hsmall q hq⟩ + rw [heq] at hmem + rcases hmem with ⟨_, hsign⟩ + refine ⟨hq, ?_⟩ + simpa only [hdet q] using hsign + · rintro ⟨hq, hsign⟩ + have hsign' : (if e then + 0 < w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1) else + w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1) < 0) := by + simpa only [hdet q] using hsign + have hmem : q ∈ Metric.ball z r ∧ (if e then + 0 < w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1) else + w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1) < 0) := + ⟨hsmall q hq, hsign'⟩ + have hmem' : q ∈ W ∩ Metric.ball z r := heq.symm ▸ hmem + exact ⟨hmem'.1, hq⟩ + +private theorem sideSignsDisjoint : + (by + classical + exact + ∀ (W : Set (ℝ × ℝ)), ∀ (z : ℝ × ℝ), ∀ (w : ℝ × ℝ), w ≠ (0 : ℝ × ℝ) → P3934T1LocalSide W + z w true → P3934T1LocalSide W z w false → False ) := by + classical + intro W z w hw hpos hneg + obtain ⟨r₁, hr₁, heq₁⟩ := hpos + obtain ⟨r₂, hr₂, heq₂⟩ := hneg + let j : Real × Real := (-w.2, w.1) + have hnormj : ‖j‖ = ‖w‖ := by + dsimp [j] + simp [Prod.norm_def, Real.norm_eq_abs, max_comm] + have hj : 0 < ‖j‖ := by + rw [hnormj] + exact norm_pos_iff.mpr hw + have hsq : 0 < w.1 ^ 2 + w.2 ^ 2 := by + rcases (show w.1 ≠ 0 ∨ w.2 ≠ 0 from by + by_contra h + push Not at h + apply hw + ext <;> simp [h.1, h.2]) with h | h + · exact add_pos_of_pos_of_nonneg (sq_pos_of_ne_zero h) (sq_nonneg _) + · exact add_pos_of_nonneg_of_pos (sq_nonneg _) (sq_pos_of_ne_zero h) + let m := min r₁ r₂ + let ε := m / (2 * ‖j‖) + let q := z + ε • j + have hm : 0 < m := lt_min hr₁ hr₂ + have hε : 0 < ε := div_pos hm (by positivity) + have hdist : dist q z = ε * ‖j‖ := by + rw [dist_eq_norm] + have hdiff : q - z = ε • j := by simp [q] + rw [hdiff, norm_smul, Real.norm_eq_abs, abs_of_pos hε] + have hdistHalf : ε * ‖j‖ = m / 2 := by + dsimp [ε] + field_simp [hj.ne'] + have hsmall₁ : dist q z < r₁ := by + rw [hdist] + rw [hdistHalf] + have hm₁ : m ≤ r₁ := min_le_left _ _ + linarith [hm] + have hsmall₂ : dist q z < r₂ := by + rw [hdist] + rw [hdistHalf] + have hm₂ : m ≤ r₂ := min_le_right _ _ + linarith [hm] + have hD : w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1) > 0 := by + dsimp [q, j] + simp [] + nlinarith [hsq, hε] + have hq₁ : q ∈ Metric.ball z r₁ := by rw [Metric.mem_ball]; exact hsmall₁ + have hq₂ : q ∈ Metric.ball z r₂ := by rw [Metric.mem_ball]; exact hsmall₂ + have hmem₁ : q ∈ W ∩ Metric.ball z r₁ := by + rw [heq₁] + simp only [Set.mem_ofPred_eq] + exact ⟨hq₁, hD⟩ + have hmem₂ : q ∈ W ∩ Metric.ball z r₂ := ⟨hmem₁.1, hq₂⟩ + rw [heq₂] at hmem₂ + simp only [Set.mem_ofPred_eq] at hmem₂ + exact (not_lt_of_ge (le_of_lt hD)) hmem₂.2 + +private theorem pieceConstant : + (by + classical + exact + ∀ (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real), ∀ (s : ∀ k, + P3723T1PolygonalParameterization (g k)), ∀ (U : Set (Real × Real)), (∀ (k : Fin 3), + ∀ (i : Fin (s k).count), ∀ (A : Real × Real), ∀ (B : Real × Real), (B ≠ 0) → ((∀ a : + Set.Icc (0 : Real) 1, (s k).time i.castSucc ≤ (a : Real) → (a : Real) ≤ (s k).time + i.succ → g k a = A + (a : Real) • B) → (∀ (t : Set.Icc (0 : Real) 1), ((s k).time + i.castSucc < (t : Real)) → (((t : Real) < (s k).time i.succ) → (∃ e : Bool, + P3934T1LocalSide U (g k t) B e ∧ P3934T1LocalSide (closure U)ᶜ (g k t) B + (!e)))))) → ((∀ (W : Set (Real × Real)), ∀ (z : Real × Real), ∀ (z' : Real × Real), ∀ + (w : Real × Real), ∀ (e : Bool), (∃ c : Real, z' = z + c • w) → (∀ (hside : + P3934T1LocalSide W z w e), (dist z' z < Classical.choose hside) → + (P3934T1LocalSide W z' w e))) → ((∀ (W : Set (Real × Real)), ∀ (z : Real × Real), ∀ + (w : Real × Real), (w ≠ 0) → ((P3934T1LocalSide W z w true) → ((P3934T1LocalSide + W z w false) → (False)))) → (∀ (k : Fin (3 : ℕ)), ∀ (i : Fin (s k).count), ∀ (A : ℝ × + ℝ), ∀ (B : ℝ × ℝ), B ≠ (0 : ℝ × ℝ) → (∀ (a : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (s + k).time i.castSucc ≤ (↑a : ℝ) → (↑a : ℝ) ≤ (s k).time i.succ → g k a = A + (↑a : ℝ) • + B) → ∃ (e : Bool), ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (s k).time i.castSucc + < (↑t : ℝ) → (↑t : ℝ) < (s k).time i.succ → P3934T1LocalSide U (g k t) B e ∧ + P3934T1LocalSide (closure U)ᶜ (g k t) B !e))) ) := by + classical + intro g s U straightSideAt sideMove sideSignsDisjoint k i A B hB hline + classical + let a : Set.Icc (0 : Real) 1 := ⟨(s k).time i.castSucc, by + constructor + · have hzero : 0 ≤ (s k).time 0 := by rw [(s k).start] + exact hzero.trans ((s k).strict.monotone (Fin.zero_le _)) + · calc (s k).time i.castSucc ≤ (s k).time (Fin.last (s k).count) := + (s k).strict.monotone (Fin.le_last _) + _ = 1 := (s k).finish⟩ + let b : Set.Icc (0 : Real) 1 := ⟨(s k).time i.succ, by + constructor + · calc 0 ≤ (s k).time 0 := by rw [(s k).start] + _ ≤ (s k).time i.succ := (s k).strict.monotone (Fin.zero_le _) + · have hl : i.succ ≤ Fin.last (s k).count := Fin.le_last _ + calc (s k).time i.succ ≤ (s k).time (Fin.last (s k).count) := (s k).strict.monotone hl + _ = 1 := (s k).finish⟩ + have hab : a < b := by + change (s k).time i.castSucc < (s k).time i.succ + exact (s k).strict Fin.castSucc_lt_succ + let I := Set.Ioo a b + let param (x : I) : Set.Icc (0 : Real) 1 := x.1 + let point (t : Set.Icc (0 : Real) 1) + (htlo : (s k).time i.castSucc < (t : Real)) + (hthi : (t : Real) < (s k).time i.succ) : I := + ⟨t, by + constructor + · change (a : Real) < (t : Real) + exact htlo + · change (t : Real) < (b : Real) + exact hthi⟩ + have paramBounds (x : I) : + (s k).time i.castSucc < (param x : Real) ∧ + (param x : Real) < (s k).time i.succ := by + constructor + · change (a : Real) < (x.1 : Real) + exact x.2.1 + · change (x.1 : Real) < (b : Real) + exact x.2.2 + let pos : Set I := {x | P3934T1LocalSide U (g k (param x)) B true} + let neg : Set I := {x | P3934T1LocalSide U (g k (param x)) B false} + have hhn : 0 < ‖B‖ := norm_pos_iff.mpr hB + have hposOpen : IsOpen pos := by + rw [Metric.isOpen_iff] + intro x hx + change P3934T1LocalSide U (g k (param x)) B true at hx + let ρ := Classical.choose hx + have hρ : 0 < ρ := (Classical.choose_spec hx).1 + let ε := ρ / (2 * ‖B‖) + have hε : 0 < ε := div_pos hρ (by positivity) + refine ⟨ε, hε, ?_⟩ + intro y hy + change P3934T1LocalSide U (g k (param y)) B true + have hyval : |(param y : Real) - (param x : Real)| < ε := by + have hyreal : dist (param y : Real) (param x : Real) < ε := by + exact_mod_cast hy + simpa [Real.dist_eq] using hyreal + have hshift : g k (param y) = g k (param x) + + ((param y : Real) - (param x : Real)) • B := by + have hly := hline (param y) (le_of_lt (paramBounds y).1) (le_of_lt (paramBounds y).2) + have hlx := hline (param x) (le_of_lt (paramBounds x).1) (le_of_lt (paramBounds x).2) + rw [hly, hlx] + ext <;> simp [smul_eq_mul] <;> ring + have hdist : dist (g k (param y)) (g k (param x)) < ρ := by + rw [dist_eq_norm, hshift, add_sub_cancel_left, norm_smul, Real.norm_eq_abs] + calc + |(param y : Real) - (param x : Real)| * ‖B‖ < ε * ‖B‖ := + mul_lt_mul_of_pos_right hyval hhn + _ = ρ / 2 := by dsimp [ε]; field_simp + _ < ρ := by linarith + exact sideMove U (g k (param x)) (g k (param y)) B true ⟨_, hshift⟩ hx hdist + have hnegOpen : IsOpen neg := by + rw [Metric.isOpen_iff] + intro x hx + change P3934T1LocalSide U (g k (param x)) B false at hx + let ρ := Classical.choose hx + have hρ : 0 < ρ := (Classical.choose_spec hx).1 + let ε := ρ / (2 * ‖B‖) + have hε : 0 < ε := div_pos hρ (by positivity) + refine ⟨ε, hε, ?_⟩ + intro y hy + change P3934T1LocalSide U (g k (param y)) B false + have hyval : |(param y : Real) - (param x : Real)| < ε := by + have hyreal : dist (param y : Real) (param x : Real) < ε := by + exact_mod_cast hy + simpa [Real.dist_eq] using hyreal + have hshift : g k (param y) = g k (param x) + + ((param y : Real) - (param x : Real)) • B := by + have hly := hline (param y) (le_of_lt (paramBounds y).1) (le_of_lt (paramBounds y).2) + have hlx := hline (param x) (le_of_lt (paramBounds x).1) (le_of_lt (paramBounds x).2) + rw [hly, hlx] + ext <;> simp [smul_eq_mul] <;> ring + have hdist : dist (g k (param y)) (g k (param x)) < ρ := by + rw [dist_eq_norm, hshift, add_sub_cancel_left, norm_smul, Real.norm_eq_abs] + calc + |(param y : Real) - (param x : Real)| * ‖B‖ < ε * ‖B‖ := + mul_lt_mul_of_pos_right hyval hhn + _ = ρ / 2 := by dsimp [ε]; field_simp + _ < ρ := by linarith + exact sideMove U (g k (param x)) (g k (param y)) B false ⟨_, hshift⟩ hx hdist + have hdis : Disjoint pos neg := by + apply Set.disjoint_left.mpr + intro x hx hn + change P3934T1LocalSide U (g k (param x)) B true at hx + change P3934T1LocalSide U (g k (param x)) B false at hn + exact sideSignsDisjoint U (g k (param x)) B hB hx hn + have hcover : (Set.univ : Set I) ⊆ pos ∪ neg := by + intro x _ + obtain ⟨e, hUside, hVside⟩ := straightSideAt k i A B hB hline + (param x) (paramBounds x).1 (paramBounds x).2 + cases e <;> simp [pos, neg, param, hUside] + let : PreconnectedSpace I := Subtype.preconnectedSpace isPreconnected_Ioo + have hconn : IsPreconnected (Set.univ : Set I) := isPreconnected_univ + by_cases hp : ((Set.univ : Set I) ∩ pos).Nonempty + · have hconst : (Set.univ : Set I) ⊆ pos := + hconn.subset_left_of_subset_union hposOpen hnegOpen hdis hcover hp + refine ⟨true, ?_⟩ + intro t htlo hthi + let x := point t htlo hthi + have hUside : P3934T1LocalSide U (g k t) B true := by + have := hconst (Set.mem_univ x) + simpa [pos, param, x, point] using this + obtain ⟨e, hU', hV'⟩ := straightSideAt k i A B hB hline + t htlo hthi + cases e + · exact False.elim (sideSignsDisjoint U (g k t) B hB hUside hU') + · exact ⟨hUside, hV'⟩ + · have hconst : (Set.univ : Set I) ⊆ neg := by + intro x _ + rcases hcover (Set.mem_univ x) with hp' | hn' + · exact (hp ⟨x, Set.mem_univ x, hp'⟩).elim + · exact hn' + refine ⟨false, ?_⟩ + intro t htlo hthi + let x := point t htlo hthi + have hUside : P3934T1LocalSide U (g k t) B false := by + have := hconst (Set.mem_univ x) + simpa [neg, param, x, point] using this + obtain ⟨e, hU', hV'⟩ := straightSideAt k i A B hB hline + t htlo hthi + cases e + · exact ⟨hUside, hV'⟩ + · exact False.elim (sideSignsDisjoint U (g k t) B hB hU' hUside) + +private theorem interiorIsolate : + (by + classical + exact + ∀ (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real), ∀ (s : ∀ k, + P3723T1PolygonalParameterization (g k)), (∀ (k : Fin (3 : ℕ)), Function.Injective + (g k)) → ((∀ (k : Fin (3 : ℕ)), ∀ (l : Fin (3 : ℕ)), k ≠ + l → Set.range (g k) ∩ Set.range (g l) ⊆ {q : ℝ × ℝ | (q = g k ⟨(0 : ℝ), + (by norm_num)⟩ ∨ q = g k ⟨(1 : ℝ), + (by norm_num)⟩) ∧ (q = g l ⟨(0 : ℝ), + (by norm_num)⟩ ∨ q = g l ⟨(1 : ℝ), + (by norm_num)⟩)}) → ((∀ (k : Fin 3), IsCompact (Set.range (g k))) → ((∀ (k : Fin 3), + ∀ (S : Set (Set.Icc (0 + : Real) 1)), (IsClosed S) → (IsCompact (g k '' S))) → ((∀ (K : Set + (Real × Real)), (IsClosed K) → (∀ (z : Real × Real), (z ∉ K) → (∃ r : Real, 0 < r ∧ + Disjoint (Metric.ball z r) K))) → (∀ (k : Fin 3), ∀ (i : Fin (s k).count), ∀ (hnxt : + i.val + 1 < (s k).count), ∃ r : Real, 0 < r ∧ ∀ l, ∀ (a : Set.Icc (0 : Real) 1), g l + a ∈ Metric.ball (g k ⟨(s k).time i.succ, by + constructor + · have hzero : 0 ≤ (s k).time 0 := by rw [(s k).start] + exact hzero.trans ((s k).strict.monotone (Fin.zero_le _)) + · calc (s k).time i.succ ≤ (s k).time (Fin.last (s k).count) := + (s k).strict.monotone (Fin.le_last _) + _ = 1 := (s k).finish⟩) r → + l = k ∧ (s k).time i.castSucc < (a : Real) ∧ + (a : Real) < (s k).time + (⟨i.val + 2, by omega⟩ : Fin ((s k).count + 1)))))))) := by + classical + intro g s hi hinter compactRange compactImage avoidClosed k i hnxt + classical + let j : Fin (s k).count := ⟨i.val + 1, hnxt⟩ + have hjcast : j.castSucc = i.succ := by ext; rfl + let p : Set.Icc (0 : Real) 1 := ⟨(s k).time i.succ, by + constructor + · have hzero : 0 ≤ (s k).time 0 := by rw [(s k).start] + exact hzero.trans ((s k).strict.monotone (Fin.zero_le _)) + · calc (s k).time i.succ ≤ (s k).time (Fin.last (s k).count) := + (s k).strict.monotone (Fin.le_last _) + _ = 1 := (s k).finish⟩ + have hlow : (s k).time i.castSucc < (p : Real) := + (s k).strict Fin.castSucc_lt_succ + have hhigh : (p : Real) < (s k).time j.succ := by + change (s k).time i.succ < (s k).time j.succ + rw [← hjcast] + exact (s k).strict Fin.castSucc_lt_succ + let bad : Set (Set.Icc (0 : Real) 1) := + {a | (a : Real) ≤ (s k).time i.castSucc ∨ + (s k).time j.succ ≤ (a : Real)} + have hbad : IsClosed bad := by + have hEq : badᶜ = Subtype.val ⁻¹' Set.Ioo + ((s k).time i.castSucc) ((s k).time j.succ) := by + ext a + simp [bad, Set.mem_Ioo, not_or, not_le] + rw [← isOpen_compl_iff, hEq] + exact isOpen_Ioo.preimage continuous_subtype_val + have hbadpoint : g k p ∉ g k '' bad := by + rintro ⟨a, ha, hga⟩ + have hEq : a = p := hi k (by rw [hga]) + subst a + change (p : Real) ≤ (s k).time i.castSucc ∨ + (s k).time j.succ ≤ (p : Real) at ha + rcases ha with ha | ha + · exact (not_le_of_gt hlow) ha + · exact (not_le_of_gt hhigh) ha + let K : Set (Real × Real) := + ⋃ l : Fin 3, g l '' (if l = k then bad else Set.univ) + have hKcompact : IsCompact K := by + have hpieces : ∀ l : Fin 3, IsCompact + (g l '' (if l = k then bad else Set.univ)) := by + intro l + by_cases hl : l = k + · subst l + simpa [bad] using compactImage k bad hbad + · rw [ite_eq_right hl, Set.image_univ] + exact compactRange l + simpa [K] using (Set.toFinite (Set.univ : Set (Fin 3))).isCompact_biUnion + (fun l _ => hpieces l) + have hpoint : g k p ∉ K := by + intro hz + change g k p ∈ ⋃ l : Fin 3, g l '' (if l = k then bad else Set.univ) at hz + obtain ⟨l, hl⟩ := Set.mem_iUnion.mp hz + by_cases hkl : l = k + · subst l + exact hbadpoint (by simpa using hl) + · obtain ⟨a, ha, hga⟩ := hl + have hq : g k p ∈ Set.range (g k) ∩ Set.range (g l) := by + refine ⟨⟨p, rfl⟩, ?_⟩ + exact ⟨a, hga⟩ + obtain ⟨hendk, _⟩ := hinter k l (Ne.symm hkl) hq + have hp0 : 0 < (p : Real) := lt_of_le_of_lt + (by rw [← (s k).start]; exact (s k).strict.monotone (Fin.zero_le _)) hlow + have hp1 : (p : Real) < 1 := lt_of_lt_of_le hhigh (by + calc (s k).time j.succ ≤ (s k).time (Fin.last (s k).count) := + (s k).strict.monotone (Fin.le_last _) + _ = 1 := (s k).finish) + rcases hendk with hstart | hend + · have hpEq : p = ⟨0, by norm_num⟩ := hi k (by simpa using hstart) + have := congrArg Subtype.val hpEq + change (p : Real) = 0 at this + linarith + · have hpEq : p = ⟨1, by norm_num⟩ := hi k (by simpa using hend) + have := congrArg Subtype.val hpEq + change (p : Real) = 1 at this + linarith + obtain ⟨r, hr, hdis⟩ := avoidClosed K hKcompact.isClosed (g k p) hpoint + refine ⟨r, hr, ?_⟩ + intro l a ha + have hnotK : g l a ∉ K := by + intro hm + exact (Set.disjoint_left.mp hdis ha) hm + by_cases hl : l = k + · subst l + refine ⟨rfl, ?_, ?_⟩ + · by_contra h + have hmem : g k a ∈ K := by + change g k a ∈ ⋃ l : Fin 3, g l '' (if l = k then bad else Set.univ) + apply Set.mem_iUnion.mpr + refine ⟨k, ?_⟩ + simp only [] + exact ⟨a, Set.mem_ofPred_eq.mpr (Or.inl (le_of_not_gt h)), rfl⟩ + exact hnotK hmem + · by_contra h + have hmem : g k a ∈ K := by + change g k a ∈ ⋃ l : Fin 3, g l '' (if l = k then bad else Set.univ) + apply Set.mem_iUnion.mpr + refine ⟨k, ?_⟩ + simp only [] + exact ⟨a, Set.mem_ofPred_eq.mpr (Or.inr (le_of_not_gt h)), rfl⟩ + exact hnotK hmem + · have hmem : g l a ∈ K := by + change g l a ∈ ⋃ q : Fin 3, g q '' (if q = k then bad else Set.univ) + apply Set.mem_iUnion.mpr + refine ⟨l, ?_⟩ + rw [ite_eq_right hl, Set.image_univ] + exact ⟨a, rfl⟩ + exact (hnotK hmem).elim + +private theorem sideBoolEq : + (by + classical + exact + (∀ (W : Set (Real × Real)), ∀ (z : Real × Real), ∀ (w : Real × Real), (w ≠ 0) → + ((P3934T1LocalSide W z w true) → ((P3934T1LocalSide W z w false) → (False)))) → + (∀ (W : Set (ℝ × ℝ)), ∀ (z : ℝ × ℝ), ∀ (w : ℝ × ℝ), w ≠ (0 : ℝ × ℝ) → ∀ (e : Bool), ∀ + (f : Bool), P3934T1LocalSide W z w e → P3934T1LocalSide W z w f → e = f) ) := by + classical + intro sideSignsDisjoint W z w hw e f he hf + cases e <;> cases f + · rfl + · exact False.elim (sideSignsDisjoint W z w hw hf he) + · exact False.elim (sideSignsDisjoint W z w hw he hf) + · rfl + +private theorem cornerAgree : + (by + classical + exact + ∀ (U : Set (Real × Real)), (∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v + : Real × Real), (0 < r) → ((‖u‖ = 1) → ((‖v‖ = 1) → ((u ≠ v) → ((x ∈ frontier U) → + ((frontier U ∩ Metric.ball x r = ({p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ {p | ∃ t + : Real, 0 ≤ t ∧ p = x + t • v}) ∩ Metric.ball x r) → (∃ e : Bool, ∀ t : Real, 0 < t → + t < r → P3934T1LocalSide U (x + t • u) (-u) e ∧ P3934T1LocalSide U (x + t • v) v + e ∧ P3934T1LocalSide (closure U)ᶜ (x + t • u) (-u) (!e) ∧ P3934T1LocalSide + (closure U)ᶜ (x + t • v) v (!e)))))))) → ((∀ (W : Set (Real × Real)), ∀ (z : Real × + Real), ∀ (w : Real × Real), ∀ (c : Real), ∀ (e : Bool), (0 < c) → + ((P3934T1LocalSide W z w e) → (P3934T1LocalSide W z (c • w) e))) → ((∀ (W : Set + (Real × Real)), ∀ (z : Real × Real), ∀ (w : Real × Real), (w ≠ 0) → (∀ (e : Bool), ∀ + (f : Bool), (P3934T1LocalSide W z w e) → ((P3934T1LocalSide W z w f) → (e = f)))) + → (∀ (x : ℝ × ℝ), ∀ (B₁ : ℝ × ℝ), ∀ (B₂ : ℝ × ℝ), B₁ ≠ (0 : ℝ × ℝ) → B₂ ≠ (0 : ℝ × ℝ) + → ∀ (a : ℝ), ∀ (b : ℝ), ∀ (R : ℝ), (0 : ℝ) < a → (0 : ℝ) < b → (0 : ℝ) < R → ∀ (e₁ : + Bool), ∀ (e₂ : Bool), (∀ (t : ℝ), (0 : ℝ) ≤ t → t ≤ a → x - t • B₁ ∈ frontier U) → (∀ + (t : ℝ), (0 : ℝ) ≤ t → t ≤ b → x + t • B₂ ∈ frontier U) → (∀ (t : ℝ), (0 : ℝ) < t → t + < a → P3934T1LocalSide U (x - t • B₁) B₁ e₁) → (∀ (t : ℝ), (0 : ℝ) < t → t < b → + P3934T1LocalSide U (x + t • B₂) B₂ e₂) → (∀ (t₁ : ℝ), ∀ (t₂ : ℝ), (0 : ℝ) < t₁ → t₁ + < a → (0 : ℝ) < t₂ → t₂ < b → x - t₁ • B₁ ≠ x + t₂ • B₂) → (∀ q ∈ frontier U, q ∈ + Metric.ball x R → (∃ (t : ℝ), (0 : ℝ) ≤ t ∧ t ≤ a ∧ q = x - t • B₁) ∨ ∃ (t : ℝ), (0 : + ℝ) ≤ t ∧ t ≤ b ∧ q = x + t • B₂) → e₁ = e₂))) ) := by + classical + intro U bend scaleLocalSide sideBoolEq x B₁ B₂ hB₁ hB₂ a b R ha hb hR e₁ e₂ back forward + backSide forwardSide apart near + let n₁ := ‖B₁‖ + let n₂ := ‖B₂‖ + have hn₁ : 0 < n₁ := norm_pos_iff.mpr hB₁ + have hn₂ : 0 < n₂ := norm_pos_iff.mpr hB₂ + let u := -(n₁⁻¹ • B₁) + let v := n₂⁻¹ • B₂ + have hu : ‖u‖ = 1 := by + dsimp [u] + rw [norm_neg, norm_smul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr hn₁)] + exact inv_mul_cancel₀ hn₁.ne' + have hv' : ‖v‖ = 1 := by + dsimp [v] + rw [norm_smul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr hn₂)] + exact inv_mul_cancel₀ hn₂.ne' + have move₁ (t : Real) : x + t • u = x - (t / n₁) • B₁ := by + simp [u, div_eq_mul_inv, smul_smul, sub_eq_add_neg] + have move₂ (t : Real) : x + t • v = x + (t / n₂) • B₂ := by + simp [v, div_eq_mul_inv, smul_smul] + have decomp₁ : n₁ • (-u) = B₁ := by + simp [u, smul_smul, hn₁.ne'] + have decomp₂ : n₂ • v = B₂ := by + simp [v, smul_smul, hn₂.ne'] + let r := min R (min (a * n₁) (b * n₂)) + have hr : 0 < r := lt_min hR (lt_min (mul_pos ha hn₁) (mul_pos hb hn₂)) + have hrR : r ≤ R := min_le_left _ _ + have hra : r ≤ a * n₁ := (min_le_right _ _).trans (min_le_left _ _) + have hrb : r ≤ b * n₂ := (min_le_right _ _).trans (min_le_right _ _) + have bounds₁ (t : Real) (ht : 0 < t) (htr : t < r) : + 0 < t / n₁ ∧ t / n₁ < a := + ⟨div_pos ht hn₁, (div_lt_iff₀ hn₁).2 (htr.trans_le hra)⟩ + have bounds₂ (t : Real) (ht : 0 < t) (htr : t < r) : + 0 < t / n₂ ∧ t / n₂ < b := + ⟨div_pos ht hn₂, (div_lt_iff₀ hn₂).2 (htr.trans_le hrb)⟩ + have hhalf : 0 < r / 2 ∧ r / 2 < r := ⟨by positivity, by linarith only [hr]⟩ + have huv : u ≠ v := by + intro h + have h₁ := bounds₁ (r / 2) hhalf.1 hhalf.2 + have h₂ := bounds₂ (r / 2) hhalf.1 hhalf.2 + apply apart (r / 2 / n₁) (r / 2 / n₂) h₁.1 h₁.2 h₂.1 h₂.2 + rw [← move₁, ← move₂, h] + have chart : frontier U ∩ Metric.ball x r = + ({q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u} ∪ + {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • v}) ∩ Metric.ball x r := by + ext q + constructor + · rintro ⟨hq, hball⟩ + refine ⟨?_, hball⟩ + rcases near q hq (Metric.ball_subset_ball hrR hball) with + ⟨t, ht, _, heq⟩ | ⟨t, ht, _, heq⟩ + · left + refine ⟨t * n₁, mul_nonneg ht hn₁.le, ?_⟩ + rw [move₁, mul_div_cancel_right₀ t hn₁.ne'] + exact heq + · right + refine ⟨t * n₂, mul_nonneg ht hn₂.le, ?_⟩ + rw [move₂, mul_div_cancel_right₀ t hn₂.ne'] + exact heq + · rintro ⟨(⟨t, ht, rfl⟩ | ⟨t, ht, rfl⟩), hball⟩ + · have htr : t < r := by + simpa only [Metric.mem_ball, dist_eq_norm, add_sub_cancel_left, norm_smul, + Real.norm_eq_abs, abs_of_nonneg ht, hu, mul_one] using hball + refine ⟨?_, hball⟩ + rw [move₁] + exact back (t / n₁) (div_nonneg ht hn₁.le) + ((div_lt_iff₀ hn₁).2 (htr.trans_le hra)).le + · have htr : t < r := by + simpa only [Metric.mem_ball, dist_eq_norm, add_sub_cancel_left, norm_smul, + Real.norm_eq_abs, abs_of_nonneg ht, hv', mul_one] using hball + refine ⟨?_, hball⟩ + rw [move₂] + exact forward (t / n₂) (div_nonneg ht hn₂.le) + ((div_lt_iff₀ hn₂).2 (htr.trans_le hrb)).le + have hx : x ∈ frontier U := by simpa using back 0 le_rfl ha.le + obtain ⟨e, hs⟩ := bend x r u v hr hu hv' huv hx chart + have hc := hs (r / 2) hhalf.1 hhalf.2 + have h₁ := bounds₁ (r / 2) hhalf.1 hhalf.2 + have h₂ := bounds₂ (r / 2) hhalf.1 hhalf.2 + have hp₁ : P3934T1LocalSide U (x + (r / 2) • u) B₁ e₁ := by + rw [move₁] + exact backSide _ h₁.1 h₁.2 + have hp₂ : P3934T1LocalSide U (x + (r / 2) • v) B₂ e₂ := by + rw [move₂] + exact forwardSide _ h₂.1 h₂.2 + have hc₁ := scaleLocalSide U (x + (r / 2) • u) (-u) n₁ e hn₁ hc.1 + have hc₂ := scaleLocalSide U (x + (r / 2) • v) v n₂ e hn₂ hc.2.1 + rw [decomp₁] at hc₁ + rw [decomp₂] at hc₂ + exact (sideBoolEq U _ B₁ hB₁ e₁ e hp₁ hc₁).trans + (sideBoolEq U _ B₂ hB₂ e₂ e hp₂ hc₂).symm + +private theorem pieceSide : + (by + classical + exact + ∀ (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real), ∀ (s : ∀ k, + P3723T1PolygonalParameterization (g k)), ∀ (U : Set (Real × Real)), (∀ (k : Fin 3), + ∀ (i : Fin (s k).count), ∃ A B : Real × Real, B ≠ 0 ∧ ∀ t : Set.Icc (0 : Real) 1, (s + k).time i.castSucc ≤ (t : Real) → (t : Real) ≤ (s k).time i.succ → g k t = A + (t : + Real) • B) → ((∀ (k : Fin 3), ∀ (i : Fin (s k).count), ∀ (A : Real × Real), ∀ (B : + Real × Real), (B ≠ 0) → ((∀ a : Set.Icc (0 : Real) 1, (s k).time i.castSucc ≤ (a : + Real) → (a : Real) ≤ (s k).time i.succ → g k a = A + (a : Real) • B) → (∃ e : Bool, ∀ + t : Set.Icc (0 : Real) 1, (s k).time i.castSucc < (t : Real) → (t : Real) < (s + k).time i.succ → P3934T1LocalSide U (g k t) B e ∧ P3934T1LocalSide (closure U)ᶜ + (g k t) B (!e)))) → (∀ (k : Fin (3 : ℕ)), ∀ (i : Fin (s k).count), ∃ (d : (ℝ × ℝ) × + (ℝ × ℝ) × Bool), d.2.1 ≠ (0 : ℝ × ℝ) ∧ (∀ (a : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), + (s k).time i.castSucc ≤ (↑a : ℝ) → (↑a : ℝ) ≤ (s k).time i.succ → g k a = d.1 + (↑a : + ℝ) • d.2.1) ∧ ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (s k).time i.castSucc < + (↑t : ℝ) → (↑t : ℝ) < (s k).time i.succ → P3934T1LocalSide U (g k t) d.2.1 d.2.2 ∧ + P3934T1LocalSide (closure U)ᶜ (g k t) d.2.1 !d.2.2)) ) := by + classical + intro g s U pieceData pieceConstant k i + obtain ⟨A, B, hB, hline⟩ := pieceData k i + obtain ⟨e, hs⟩ := pieceConstant k i A B hB hline + exact ⟨(A, (B, e)), hB, hline, hs⟩ + +private theorem chosenSpec : + (by + classical + exact + ∀ (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real), ∀ (s : ∀ k, + P3723T1PolygonalParameterization (g k)), ∀ (U : Set (Real × Real)), ∀ (pieceSide : + ∀ (k : Fin 3), ∀ (i : Fin (s k).count), ∃ d : (Real × Real) × ((Real × Real) × Bool), + d.2.1 ≠ 0 ∧ (∀ a : Set.Icc (0 : Real) 1, (s k).time i.castSucc ≤ (a : Real) → (a : + Real) ≤ (s k).time i.succ → g k a = d.1 + (a : Real) • d.2.1) ∧ (∀ t : Set.Icc (0 : + Real) 1, (s k).time i.castSucc < (t : Real) → (t : Real) < (s k).time i.succ → + P3934T1LocalSide U (g k t) d.2.1 d.2.2 ∧ P3934T1LocalSide (closure U)ᶜ (g k t) + d.2.1 (!d.2.2))), + let sideInfo (k : Fin 3) (i : Fin (s k).count) := Classical.choose (pieceSide k i) + let chosenA (k : Fin 3) (i : Fin (s k).count) := (sideInfo k i).1 + let chosenAB (k : Fin 3) (i : Fin (s k).count) := (sideInfo k i).2.1 + let pieceSign (k : Fin 3) (i : Fin (s k).count) : Bool := (sideInfo k i).2.2 + ∀ (k : Fin (3 : ℕ)), ∀ (i : Fin (s k).count), chosenAB k i ≠ (0 : ℝ × ℝ) ∧ (∀ (a : + (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (s k).time i.castSucc ≤ (↑a : ℝ) → (↑a : ℝ) ≤ + (s k).time i.succ → g k a = chosenA k i + (↑a : ℝ) • chosenAB k i) ∧ ∀ (t : + (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (s k).time i.castSucc < (↑t : ℝ) → (↑t : ℝ) < + (s k).time i.succ → P3934T1LocalSide U (g k t) (chosenAB k i) (pieceSign k i) ∧ + P3934T1LocalSide (closure U)ᶜ (g k t) (chosenAB k i) !pieceSign k i ) := by + classical + intro g s U pieceSide sideInfo chosenA chosenAB pieceSign k i + exact Classical.choose_spec (pieceSide k i) + +private theorem vertexLabels : + (by + classical + exact + ∀ (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real), ∀ (s : ∀ k, + P3723T1PolygonalParameterization (g k)), ∀ (U : Set (Real × Real)), (frontier U = ⋃ + (k : Fin (3 : ℕ)), Set.range (g k)) → ((∀ (x : Real × Real), ∀ (B₁ : Real × Real), ∀ + (B₂ : Real × Real), (B₁ ≠ 0) → ((B₂ ≠ 0) → (∀ (a : Real), ∀ (b : Real), ∀ (R : Real), + (0 < a) → ((0 < b) → ((0 < R) → (∀ (e₁ : Bool), ∀ (e₂ : Bool), (∀ t : Real, 0 ≤ t → t + ≤ a → x - t • B₁ ∈ frontier U) → ((∀ t : Real, 0 ≤ t → t ≤ b → x + t • B₂ ∈ frontier + U) → ((∀ t : Real, 0 < t → t < a → P3934T1LocalSide U (x - t • B₁) B₁ e₁) → ((∀ t : + Real, 0 < t → t < b → P3934T1LocalSide U (x + t • B₂) B₂ e₂) → ((∀ t₁ t₂ : Real, 0 + < t₁ → t₁ < a → 0 < t₂ → t₂ < b → x - t₁ • B₁ ≠ x + t₂ • B₂) → ((∀ q ∈ frontier U, q + ∈ Metric.ball x R → (∃ t : Real, 0 ≤ t ∧ t ≤ a ∧ q = x - t • B₁) ∨ (∃ t : Real, 0 ≤ t + ∧ t ≤ b ∧ q = x + t • B₂)) → (e₁ = e₂)))))))))))) → (∀ (pieceSide : ∀ (k : Fin 3), ∀ + (i : Fin (s k).count), ∃ d : (Real × Real) × ((Real × Real) × Bool), d.2.1 ≠ 0 ∧ (∀ a + : Set.Icc (0 : Real) 1, (s k).time i.castSucc ≤ (a : Real) → (a : Real) ≤ (s k).time + i.succ → g k a = d.1 + (a : Real) • d.2.1) ∧ (∀ t : Set.Icc (0 : Real) 1, (s k).time + i.castSucc < (t : Real) → (t : Real) < (s k).time i.succ → P3934T1LocalSide U (g k + t) d.2.1 d.2.2 ∧ P3934T1LocalSide (closure U)ᶜ (g k t) d.2.1 (!d.2.2))), + let sideInfo (k : Fin 3) (i : Fin (s k).count) := Classical.choose (pieceSide k i) + let chosenA (k : Fin 3) (i : Fin (s k).count) := (sideInfo k i).1 + let chosenAB (k : Fin 3) (i : Fin (s k).count) := (sideInfo k i).2.1 + let pieceSign (k : Fin 3) (i : Fin (s k).count) : Bool := (sideInfo k i).2.2 + (∀ (k : Fin 3), ∀ (i : Fin (s k).count), chosenAB k i ≠ 0 ∧ (∀ a : Set.Icc (0 : Real) 1, + (s k).time i.castSucc ≤ (a : Real) → (a : Real) ≤ (s k).time i.succ → g k a = chosenA + k i + (a : Real) • chosenAB k i) ∧ (∀ t : Set.Icc (0 : Real) 1, (s k).time i.castSucc + < (t : Real) → (t : Real) < (s k).time i.succ → P3934T1LocalSide U (g k t) + (chosenAB k i) (pieceSign k i) ∧ P3934T1LocalSide (closure U)ᶜ (g k t) (chosenAB k + i) (!pieceSign k i))) → (∀ (k : Fin (3 : ℕ)), ∀ (l : Fin (3 : ℕ)), ∀ (i : Fin (s + k).count), ∀ (j : Fin (s l).count), ∀ (p : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (q + : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (s k).time i.succ = (↑p : ℝ) → (s l).time + j.castSucc = (↑q : ℝ) → g k p = g l q → (∀ (t₁ : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : + Type)), ∀ (t₂ : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (s k).time i.castSucc < (↑t₁ : + ℝ) → (↑t₁ : ℝ) < (↑p : ℝ) → (↑q : ℝ) < (↑t₂ : ℝ) → (↑t₂ : ℝ) < (s l).time j.succ → g + k t₁ ≠ g l t₂) → ∀ (R : ℝ), (0 : ℝ) < R → (∀ (m : Fin (3 : ℕ)), ∀ (t : (↑(Set.Icc (0 + : ℝ) (1 : ℝ)) : Type)), g m t ∈ Metric.ball (g k p) R → m = k ∧ (s k).time i.castSucc + ≤ (↑t : ℝ) ∧ (↑t : ℝ) ≤ (↑p : ℝ) ∨ m = l ∧ (↑q : ℝ) ≤ (↑t : ℝ) ∧ (↑t : ℝ) ≤ (s + l).time j.succ) → pieceSign k i = pieceSign l j))) ) := by + classical + intro g s U hf cornerAgree pieceSide sideInfo chosenA chosenAB pieceSign chosenSpec k l i j p q + hp hq hcenter apart R hR near + let a := (p : Real) - (s k).time i.castSucc + let b := (s l).time j.succ - (q : Real) + have ha : 0 < a := sub_pos.mpr (by rw [← hp]; exact (s k).strict Fin.castSucc_lt_succ) + have hb : 0 < b := sub_pos.mpr (by rw [← hq]; exact (s l).strict Fin.castSucc_lt_succ) + have hlo : 0 ≤ (s k).time i.castSucc := by + rw [← (s k).start] + exact (s k).strict.monotone (Fin.zero_le _) + have hhi : (s l).time j.succ ≤ 1 := by + rw [← (s l).finish] + exact (s l).strict.monotone (Fin.le_last _) + let left (t : Real) (ht : 0 ≤ t) (hta : t ≤ a) : Set.Icc (0 : Real) 1 := + ⟨(p : Real) - t, by constructor <;> dsimp [a] at hta <;> linarith only [hta, ht, hlo, p.2.2]⟩ + let right (t : Real) (ht : 0 ≤ t) (htb : t ≤ b) : Set.Icc (0 : Real) 1 := + ⟨(q : Real) + t, by constructor <;> dsimp [b] at htb <;> linarith only [htb, ht, hhi, q.2.1]⟩ + have leftBounds (t : Real) (ht : 0 ≤ t) (hta : t ≤ a) : + (s k).time i.castSucc ≤ (left t ht hta : Real) ∧ + (left t ht hta : Real) ≤ (p : Real) := by + dsimp [left, a] at * + constructor <;> linarith only [hta, ht] + have rightBounds (t : Real) (ht : 0 ≤ t) (htb : t ≤ b) : + (q : Real) ≤ (right t ht htb : Real) ∧ + (right t ht htb : Real) ≤ (s l).time j.succ := by + dsimp [right, b] at * + constructor <;> linarith only [htb, ht] + have center₁ := (chosenSpec k i).2.1 p (by linarith only [ha]) (by rw [hp]) + have center₂ := (chosenSpec l j).2.1 q (by rw [hq]) (by linarith only [hb]) + have move₁ (t : Real) (ht : 0 ≤ t) (hta : t ≤ a) : + g k (left t ht hta) = g k p - t • chosenAB k i := by + rw [(chosenSpec k i).2.1 _ (leftBounds t ht hta).1 + (by rw [hp]; exact (leftBounds t ht hta).2), center₁] + dsimp [left] + module + have move₂ (t : Real) (ht : 0 ≤ t) (htb : t ≤ b) : + g l (right t ht htb) = g k p + t • chosenAB l j := by + rw [(chosenSpec l j).2.1 _ (by rw [hq]; exact (rightBounds t ht htb).1) + (rightBounds t ht htb).2, hcenter, center₂] + dsimp [right] + module + apply cornerAgree (g k p) (chosenAB k i) (chosenAB l j) + (chosenSpec k i).1 (chosenSpec l j).1 a b R ha hb hR + (pieceSign k i) (pieceSign l j) + · intro t ht hta + rw [← move₁ t ht hta, hf] + exact Set.mem_iUnion.mpr ⟨k, ⟨left t ht hta, rfl⟩⟩ + · intro t ht htb + rw [← move₂ t ht htb, hf] + exact Set.mem_iUnion.mpr ⟨l, ⟨right t ht htb, rfl⟩⟩ + · intro t ht hta + rw [← move₁ t ht.le hta.le] + apply ((chosenSpec k i).2.2 _ ?_ ?_).1 + · change (s k).time i.castSucc < (p : Real) - t + dsimp [a] at hta + linarith only [hta] + · rw [hp] + change (p : Real) - t < (p : Real) + linarith only [ht] + · intro t ht htb + rw [← move₂ t ht.le htb.le] + apply ((chosenSpec l j).2.2 _ ?_ ?_).1 + · rw [hq] + change (q : Real) < (q : Real) + t + linarith only [ht] + · change (q : Real) + t < (s l).time j.succ + dsimp [b] at htb + linarith only [htb] + · intro t₁ t₂ ht₁ ht₁a ht₂ ht₂b + rw [← move₁ t₁ ht₁.le ht₁a.le, ← move₂ t₂ ht₂.le ht₂b.le] + apply apart + · change (s k).time i.castSucc < (p : Real) - t₁ + dsimp [a] at ht₁a + linarith only [ht₁a] + · change (p : Real) - t₁ < (p : Real) + linarith only [ht₁] + · change (q : Real) < (q : Real) + t₂ + linarith only [ht₂] + · change (q : Real) + t₂ < (s l).time j.succ + dsimp [b] at ht₂b + linarith only [ht₂b] + · intro z hz hzball + rw [hf] at hz + obtain ⟨m, t, hmt⟩ := Set.mem_iUnion.mp hz + have hball : g m t ∈ Metric.ball (g k p) R := by rw [hmt]; exact hzball + rcases near m t hball with ⟨hm, hlo, hhi⟩ | ⟨hm, hlo, hhi⟩ + · subst m + left + refine ⟨(p : Real) - (t : Real), sub_nonneg.mpr hhi, ?_, ?_⟩ + · dsimp [a] + linarith only [hlo] + · rw [← hmt, (chosenSpec k i).2.1 t hlo (by rw [hp]; exact hhi), center₁] + module + · subst m + right + refine ⟨(t : Real) - (q : Real), sub_nonneg.mpr hlo, ?_, ?_⟩ + · dsimp [b] + linarith only [hhi] + · rw [← hmt, (chosenSpec l j).2.1 t (by rw [hq]; exact hlo) hhi, + hcenter, center₂] + module + +private theorem interiorSignAgree : + (by + classical + exact + ∀ (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real), ∀ (s : ∀ k, + P3723T1PolygonalParameterization (g k)), (∀ (k : Fin (3 : ℕ)), Function.Injective + (g k)) → (∀ (U : Set (Real × Real)), (∀ (k : Fin 3), ∀ (i : Fin (s + k).count), ∀ (hnxt : i.val + 1 < (s k).count), ∃ r : Real, 0 < r ∧ ∀ l, ∀ (a : + Set.Icc (0 : Real) 1), g l a ∈ Metric.ball (g k ⟨(s k).time i.succ, by + constructor + · have hzero : 0 ≤ (s k).time 0 := by rw [(s k).start] + exact hzero.trans ((s k).strict.monotone (Fin.zero_le _)) + · calc (s k).time i.succ ≤ (s k).time (Fin.last (s k).count) := + (s k).strict.monotone (Fin.le_last _) + _ = 1 := (s k).finish⟩) r → + l = k ∧ (s k).time i.castSucc < (a : Real) ∧ + (a : Real) < (s k).time + (⟨i.val + 2, by omega⟩ : Fin ((s k).count + 1))) → (∀ (pieceSide : ∀ (k : Fin + 3), ∀ (i : Fin (s k).count), ∃ d : (Real × Real) × ((Real × Real) × Bool), + d.2.1 ≠ 0 ∧ (∀ a : Set.Icc (0 : Real) 1, (s k).time i.castSucc ≤ (a : Real) + → (a : Real) ≤ (s k).time i.succ → g k a = d.1 + (a : Real) • d.2.1) ∧ (∀ t + : Set.Icc (0 : Real) 1, (s k).time i.castSucc < (t : Real) → (t : Real) < + (s k).time i.succ → P3934T1LocalSide U (g k t) d.2.1 d.2.2 ∧ + P3934T1LocalSide (closure U)ᶜ (g k t) d.2.1 (!d.2.2))), + let sideInfo (k : Fin 3) (i : Fin (s k).count) := Classical.choose (pieceSide k i) + let pieceSign (k : Fin 3) (i : Fin (s k).count) : Bool := (sideInfo k i).2.2 + (∀ (k : Fin 3), ∀ (l : Fin 3), ∀ (i : Fin (s k).count), ∀ (j : Fin (s l).count), ∀ (p : + Set.Icc (0 : Real) 1), ∀ (q : Set.Icc (0 : Real) 1), ((s k).time i.succ = (p : Real)) + → (((s l).time j.castSucc = (q : Real)) → ((g k p = g l q) → ((∀ t₁ t₂ : Set.Icc (0 : + Real) 1, (s k).time i.castSucc < (t₁ : Real) → (t₁ : Real) < (p : Real) → (q : Real) + < (t₂ : Real) → (t₂ : Real) < (s l).time j.succ → g k t₁ ≠ g l t₂) → (∀ (R : Real), + (0 < R) → ((∀ m, ∀ (t : Set.Icc (0 : Real) 1), g m t ∈ Metric.ball (g k p) R → (m + = k + ∧ (s k).time i.castSucc ≤ (t : Real) ∧ (t : Real) ≤ (p : Real)) ∨ (m = l ∧ (q : Real) + ≤ (t : Real) ∧ (t : Real) ≤ (s l).time j.succ)) → (pieceSign k i = pieceSign l + j))))))) → (∀ (k : Fin (3 : ℕ)), ∀ (i : Fin (s k).count), ∀ (hnxt : (↑i : ℕ) + (1 : + ℕ) < (s k).count), pieceSign k i = pieceSign k ⟨(↑i : ℕ) + (1 : ℕ), hnxt⟩)))) := by + classical + intro g s hi U interiorIsolate pieceSide sideInfo pieceSign vertexLabels k i hnxt + let j : Fin (s k).count := ⟨i.val + 1, hnxt⟩ + have hj : j.castSucc = i.succ := by ext; rfl + have hj₂ : j.succ = (⟨i.val + 2, by omega⟩ : Fin ((s k).count + 1)) := by + ext + change i.val + 1 + 1 = i.val + 2 + omega + let p : Set.Icc (0 : Real) 1 := ⟨(s k).time i.succ, by + constructor + · rw [← (s k).start] + exact (s k).strict.monotone (Fin.zero_le _) + · rw [← (s k).finish] + exact (s k).strict.monotone (Fin.le_last _)⟩ + obtain ⟨R, hR, hiso⟩ := interiorIsolate k i hnxt + apply vertexLabels k k i j p p rfl (by rw [hj]) rfl ?_ R hR ?_ + · intro t₁ t₂ _ ht₁ ht₂ _ h + have heq := congrArg Subtype.val (hi k h) + linarith only [ht₁, ht₂, heq] + · intro m t ht + obtain ⟨rfl, hlo, hhi⟩ := hiso m t ht + by_cases htp : (t : Real) ≤ (p : Real) + · exact Or.inl ⟨rfl, hlo.le, htp⟩ + · exact Or.inr ⟨rfl, (le_of_not_ge htp), by simpa [hj₂] using hhi.le⟩ + +private theorem signChain : + (by + classical + exact + ∀ (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real), ∀ (s : ∀ k, + P3723T1PolygonalParameterization (g k)), ∀ (U : Set (Real × Real)), ∀ (pieceSide : + ∀ (k : Fin 3), ∀ (i : Fin (s k).count), ∃ d : (Real × Real) × ((Real × Real) × Bool), + d.2.1 ≠ 0 ∧ (∀ a : Set.Icc (0 : Real) 1, (s k).time i.castSucc ≤ (a : Real) → (a : + Real) ≤ (s k).time i.succ → g k a = d.1 + (a : Real) • d.2.1) ∧ (∀ t : Set.Icc (0 : + Real) 1, (s k).time i.castSucc < (t : Real) → (t : Real) < (s k).time i.succ → + P3934T1LocalSide U (g k t) d.2.1 d.2.2 ∧ P3934T1LocalSide (closure U)ᶜ (g k t) + d.2.1 (!d.2.2))), + let sideInfo (k : Fin 3) (i : Fin (s k).count) := Classical.choose (pieceSide k i) + let pieceSign (k : Fin 3) (i : Fin (s k).count) : Bool := (sideInfo k i).2.2 + (∀ (k : Fin 3), ∀ (i : Fin (s k).count), ∀ (hnxt : i.val + 1 < (s k).count), pieceSign k + i = pieceSign k ⟨i.val + 1, hnxt⟩) → (∀ (k : Fin 3), ∀ n, ∀ (hn : n < (s k).count), + pieceSign k ⟨n, hn⟩ = pieceSign k ⟨0, (s k).positive⟩) ) := by + classical + intro g s U pieceSide sideInfo pieceSign interiorSignAgree k n + induction n with + | zero => + intro _ + rfl + | succ n ih => + intro hn + have hn' : n < (s k).count := by omega + let i : Fin (s k).count := ⟨n, hn'⟩ + let j : Fin (s k).count := ⟨n + 1, hn⟩ + have hij : i.val + 1 < (s k).count := by simpa [i] using hn + have hji : j = ⟨i.val + 1, hij⟩ := by apply Fin.ext; rfl + calc + pieceSign k j = pieceSign k i := by + rw [hji] + exact (interiorSignAgree k i hij).symm + _ = pieceSign k ⟨0, (s k).positive⟩ := ih hn' + +private theorem isolateNeighborhood : + (by + classical + exact + ∀ (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real), (∀ (k : Fin 3), ∀ (S : Set (Set.Icc + (0 : Real) 1)), (IsClosed S) → (IsCompact (g k '' S))) → ((∀ (K : Set (Real × Real)), + (IsClosed K) → (∀ (z : Real × Real), (z ∉ K) → (∃ r : Real, 0 < r ∧ Disjoint + (Metric.ball z r) K))) → (∀ (x : ℝ × ℝ), ∀ (O : Fin (3 : ℕ) → Set (↑(Set.Icc (0 : ℝ) + (1 : ℝ)) : Type)), (∀ (k : Fin (3 : ℕ)), IsOpen (O k)) → (∀ (k : Fin (3 : ℕ)), ∀ (t : + (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), g k t = x → t ∈ O k) → ∃ (R : ℝ), (0 : ℝ) < R ∧ + ∀ (k : Fin (3 : ℕ)), ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), g k t ∈ Metric.ball + x R → t ∈ O k)) ) := by + classical + intro g compactImage avoidClosed x O hO hx + let K := ⋃ k : Fin 3, g k '' (O k)ᶜ + have hK : IsCompact K := by + simpa [K] using (Set.toFinite (Set.univ : Set (Fin 3))).isCompact_biUnion + (fun k _ => compactImage k (O k)ᶜ (hO k).isClosed_compl) + have hxK : x ∉ K := by + intro h + obtain ⟨k, t, ht, hgt⟩ := Set.mem_iUnion.mp h + exact ht (hx k t hgt) + obtain ⟨R, hR, hdis⟩ := avoidClosed K hK.isClosed x hxK + refine ⟨R, hR, ?_⟩ + intro k t ht + by_contra h + have hm : g k t ∈ K := Set.mem_iUnion.mpr ⟨k, ⟨t, h, rfl⟩⟩ + exact Set.disjoint_left.mp hdis ht hm + +private theorem joinPreimage : + (by + classical + exact + ∀ (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real), (∀ (k : Fin (3 : ℕ)), + Function.Injective (g k)) → ((∀ (k : Fin (3 : ℕ)), g k ⟨(1 : ℝ), + (by norm_num)⟩ = g (k + (1 : Fin (3 : ℕ))) ⟨(0 : ℝ), + (by norm_num)⟩) → ((Function.Injective fun (k : Fin + (3 : ℕ)) => g k ⟨(0 : ℝ), (by norm_num)⟩) → ((∀ (k : Fin (3 : ℕ)), ∀ (l : Fin (3 : + ℕ)), k ≠ l → Set.range (g k) ∩ Set.range (g l) ⊆ + {q : ℝ × ℝ | (q = g k ⟨(0 : ℝ), (by norm_num)⟩ ∨ q = g k + ⟨(1 : ℝ), (by norm_num)⟩) ∧ (q = g l ⟨(0 : ℝ), + (by norm_num)⟩ ∨ q = g l ⟨(1 : ℝ), + (by norm_num)⟩)}) → (∀ (k : Fin 3), ∀ (l : Fin 3), ∀ (t : Set.Icc (0 : Real) 1), (g l + t = g k ⟨1, by norm_num⟩) → ((l = k ∧ t = ⟨1, + by norm_num⟩) ∨ + (l = k + 1 ∧ t = ⟨0, by norm_num⟩))))))) := by + classical + intro g hi hjoin hv hinter k l t ht + by_cases hl : l = k + · subst l + exact Or.inl ⟨rfl, hi k ht⟩ + have hm : g k ⟨1, by norm_num⟩ ∈ Set.range (g k) ∩ Set.range (g l) := + ⟨⟨⟨1, by norm_num⟩, rfl⟩, ⟨t, ht⟩⟩ + obtain ⟨_, hend⟩ := hinter k l (Ne.symm hl) hm + rcases hend with hstart | hfinish + · have hindex : l = k + 1 := hv (hstart.symm.trans (hjoin k)) + exact Or.inr ⟨hindex, hi l (ht.trans hstart)⟩ + · have hindex : l + 1 = k + 1 := + hv ((hjoin l).symm.trans (hfinish.symm.trans (hjoin k))) + exact False.elim (hl (add_right_cancel hindex)) + +private theorem joinSignAgree : + (by + classical + exact + ∀ (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real), ∀ (s : ∀ k, + P3723T1PolygonalParameterization (g k)), ∀ (hi : ∀ (k : Fin (3 : ℕ)), + Function.Injective (g k)), ∀ (hjoin : ∀ (k : Fin (3 : ℕ)), g k ⟨(1 : ℝ), + (by norm_num)⟩ = g (k + (1 : Fin (3 : ℕ))) ⟨(0 : ℝ), + (by norm_num)⟩), ∀ (hinter : ∀ (k : Fin (3 : ℕ)), ∀ (l : Fin (3 : ℕ)), k ≠ l → + Set.range (g k) ∩ Set.range (g l) ⊆ {q : ℝ × ℝ | (q = g k ⟨(0 : + ℝ), (by norm_num)⟩ ∨ q = g k ⟨(1 : ℝ), + (by norm_num)⟩) ∧ (q = g l ⟨(0 : ℝ), + (by norm_num)⟩ ∨ q = g l ⟨(1 : ℝ), + (by norm_num)⟩)}), ∀ (U : Set (Real × Real)), ∀ (pieceSide : ∀ (k : Fin 3), ∀ (i : + Fin (s k).count), ∃ d : (Real × Real) × ((Real × + Real) × Bool), d.2.1 ≠ 0 ∧ (∀ a : Set.Icc (0 : Real) 1, (s k).time i.castSucc ≤ (a : + Real) → (a : Real) ≤ (s k).time i.succ → g k a = d.1 + (a : Real) • d.2.1) ∧ (∀ t : + Set.Icc (0 : Real) 1, (s k).time i.castSucc < (t : Real) → (t : Real) < (s k).time + i.succ → P3934T1LocalSide U (g k t) d.2.1 d.2.2 ∧ P3934T1LocalSide (closure U)ᶜ + (g k t) d.2.1 (!d.2.2))), + let sideInfo (k : Fin 3) (i : Fin (s k).count) := Classical.choose (pieceSide k i) + let pieceSign (k : Fin 3) (i : Fin (s k).count) : Bool := (sideInfo k i).2.2 + ∀ (vertexLabels : ∀ (k : Fin 3), ∀ (l : Fin 3), ∀ (i : Fin (s k).count), ∀ (j : Fin (s + l).count), ∀ (p : Set.Icc (0 : Real) 1), ∀ (q : Set.Icc (0 : Real) 1), ((s k).time + i.succ = (p : Real)) → (((s l).time j.castSucc = (q : Real)) → ((g k p = g l q) → ((∀ + t₁ t₂ : Set.Icc (0 : Real) 1, (s k).time i.castSucc < (t₁ : Real) → (t₁ : Real) < (p + : Real) → (q : Real) < (t₂ : Real) → (t₂ : Real) < (s l).time j.succ → g k t₁ ≠ g l + t₂) → (∀ (R : Real), (0 < R) → ((∀ m, ∀ (t : Set.Icc (0 : Real) 1), g m t ∈ + Metric.ball (g k p) R → (m = k ∧ (s k).time i.castSucc ≤ (t : Real) ∧ (t : Real) ≤ (p + : Real)) ∨ (m = l ∧ (q : Real) ≤ (t : Real) ∧ (t : Real) ≤ (s l).time j.succ)) → + (pieceSign k i = pieceSign l j))))))), ∀ (isolateNeighborhood : ∀ (x : Real × Real), + ∀ (O : Fin 3 → Set (Set.Icc (0 : Real) 1)), (∀ k, IsOpen (O k)) → ((∀ k, ∀ t, g k + t = + x → t ∈ O k) → (∃ R : Real, 0 < R ∧ ∀ k, ∀ t, g k t ∈ Metric.ball x R → t ∈ O k))), ∀ + (next_ne : ∀ (k : Fin 3), k + 1 ≠ k), ∀ (joinPreimage : ∀ (k : Fin 3), ∀ (l : Fin + 3), ∀ (t : Set.Icc (0 : Real) 1), (g l t = g k ⟨1, by norm_num⟩) → ((l = k ∧ t = ⟨1, + by norm_num⟩) ∨ + (l = k + 1 ∧ t = ⟨0, by norm_num⟩))), + let first (k : Fin 3) : Fin (s k).count := ⟨0, (s k).positive⟩ + let last (k : Fin 3) : Fin (s k).count := + ⟨(s k).count - 1, by have := (s k).positive; omega⟩ + ∀ (k : Fin (3 : ℕ)), pieceSign k (last k) = pieceSign (k + (1 : Fin (3 : ℕ))) (first (k + + (1 : Fin (3 : ℕ))))) := by + classical + intro g s hi hjoin hinter U pieceSide sideInfo pieceSign vertexLabels isolateNeighborhood + next_ne joinPreimage first last k + let i := last k + let j := first (k + 1) + have hiLast : i.succ = Fin.last (s k).count := by + apply Fin.ext + change (s k).count - 1 + 1 = (s k).count + have := (s k).positive + omega + have hjZero : j.castSucc = (0 : Fin ((s (k + 1)).count + 1)) := rfl + have hp : (s k).time i.succ = 1 := by rw [hiLast, (s k).finish] + have hq : (s (k + 1)).time j.castSucc = 0 := by rw [hjZero, (s (k + 1)).start] + have hgaplo : (s k).time i.castSucc < 1 := by + rw [← hp] + exact (s k).strict Fin.castSucc_lt_succ + have hgaphigh : 0 < (s (k + 1)).time j.succ := by + rw [← hq] + exact (s (k + 1)).strict Fin.castSucc_lt_succ + let O : Fin 3 → Set (Set.Icc (0 : Real) 1) := fun l => + if l = k then {t | (s k).time i.castSucc < (t : Real)} + else if l = k + 1 then {t | (t : Real) < (s (k + 1)).time j.succ} + else ∅ + have hO (l : Fin 3) : IsOpen (O l) := by + dsimp [O] + split_ifs + · exact isOpen_Ioi.preimage continuous_subtype_val + · exact isOpen_Iio.preimage continuous_subtype_val + · exact isOpen_empty + have hat (l : Fin 3) (t : Set.Icc (0 : Real) 1) + (ht : g l t = g k ⟨1, by norm_num⟩) : t ∈ O l := by + rcases joinPreimage k l t ht with ⟨hl, ht⟩ | ⟨hl, ht⟩ + · subst l + subst t + simpa only [O, ite_eq_left rfl, Set.mem_ofPred_eq] using hgaplo + · subst l + subst t + simpa [O, next_ne k] using hgaphigh + obtain ⟨R, hR, hiso⟩ := isolateNeighborhood (g k ⟨1, by norm_num⟩) O hO hat + apply vertexLabels k (k + 1) i j ⟨1, by norm_num⟩ ⟨0, by norm_num⟩ + hp hq (hjoin k) ?_ R hR ?_ + · intro t₁ t₂ htlo hthi _ _ heq + have hm : g k t₁ ∈ Set.range (g k) ∩ Set.range (g (k + 1)) := + ⟨⟨t₁, rfl⟩, ⟨t₂, heq.symm⟩⟩ + obtain ⟨hend, _⟩ := hinter k (k + 1) (Ne.symm (next_ne k)) hm + have hlo : 0 ≤ (s k).time i.castSucc := by + rw [← (s k).start] + exact (s k).strict.monotone (Fin.zero_le _) + rcases hend with hend | hend + · have hval := congrArg Subtype.val (hi k hend) + change (t₁ : Real) = 0 at hval + linarith only [hlo, htlo, hval] + · have hval := congrArg Subtype.val (hi k hend) + change (t₁ : Real) = 1 at hval + change (t₁ : Real) < 1 at hthi + linarith only [hthi, hval] + · intro m t ht + have hmt := hiso m t ht + by_cases hm : m = k + · left + refine ⟨hm, ?_, t.2.2⟩ + exact (show (s k).time i.castSucc < (t : Real) from + by simpa only [O, ite_eq_left hm, Set.mem_ofPred_eq] using hmt).le + · by_cases hm' : m = k + 1 + · right + refine ⟨hm', t.2.1, ?_⟩ + exact (show (t : Real) < (s (k + 1)).time j.succ from + by simpa only [O, ite_eq_right hm, ite_eq_left hm', Set.mem_ofPred_eq] using hmt).le + · simp only [O, ite_eq_right hm, ite_eq_right hm', Set.mem_empty_iff_false] at hmt + +private theorem arcAgree : + (by + classical + exact + ∀ (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real), ∀ (s : ∀ k, + P3723T1PolygonalParameterization (g k)), ∀ (U : Set (Real × Real)), ∀ (pieceSide : + ∀ (k : Fin 3), ∀ (i : Fin (s k).count), ∃ d : (Real × Real) × ((Real × Real) × Bool), + d.2.1 ≠ 0 ∧ (∀ a : Set.Icc (0 : Real) 1, (s k).time i.castSucc ≤ (a : Real) → (a : + Real) ≤ (s k).time i.succ → g k a = d.1 + (a : Real) • d.2.1) ∧ (∀ t : Set.Icc (0 : + Real) 1, (s k).time i.castSucc < (t : Real) → (t : Real) < (s k).time i.succ → + P3934T1LocalSide U (g k t) d.2.1 d.2.2 ∧ P3934T1LocalSide (closure U)ᶜ (g k t) + d.2.1 (!d.2.2))), + let sideInfo (k : Fin 3) (i : Fin (s k).count) := Classical.choose (pieceSide k i) + let pieceSign (k : Fin 3) (i : Fin (s k).count) : Bool := (sideInfo k i).2.2 + ∀ (signChain : ∀ (k : Fin 3), ∀ n, ∀ (hn : n < (s k).count), pieceSign k ⟨n, hn⟩ = + pieceSign k ⟨0, (s k).positive⟩), + let first (k : Fin 3) : Fin (s k).count := ⟨0, (s k).positive⟩ + let last (k : Fin 3) : Fin (s k).count := + ⟨(s k).count - 1, by have := (s k).positive; omega⟩ + (∀ (k : Fin 3), pieceSign k (last k) = pieceSign (k + 1) (first (k + 1))) → (∀ (k : Fin + (3 : ℕ)), pieceSign k (first k) = pieceSign (k + (1 : Fin (3 : ℕ))) (first (k + (1 : + Fin (3 : ℕ))))) ) := by + classical + intro g s U pieceSide sideInfo pieceSign signChain first last joinSignAgree k + exact (signChain k (last k).val (last k).isLt).symm.trans (joinSignAgree k) + +private theorem allArc : + (by + classical + exact + ∀ (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real), ∀ (s : ∀ k, + P3723T1PolygonalParameterization (g k)), ∀ (U : Set (Real × Real)), ∀ (pieceSide : + ∀ (k : Fin 3), ∀ (i : Fin (s k).count), ∃ d : (Real × Real) × ((Real × Real) × Bool), + d.2.1 ≠ 0 ∧ (∀ a : Set.Icc (0 : Real) 1, (s k).time i.castSucc ≤ (a : Real) → (a : + Real) ≤ (s k).time i.succ → g k a = d.1 + (a : Real) • d.2.1) ∧ (∀ t : Set.Icc (0 : + Real) 1, (s k).time i.castSucc < (t : Real) → (t : Real) < (s k).time i.succ → + P3934T1LocalSide U (g k t) d.2.1 d.2.2 ∧ P3934T1LocalSide (closure U)ᶜ (g k t) + d.2.1 (!d.2.2))), + let sideInfo (k : Fin 3) (i : Fin (s k).count) := Classical.choose (pieceSide k i) + let pieceSign (k : Fin 3) (i : Fin (s k).count) : Bool := (sideInfo k i).2.2 + let first (k : Fin 3) : Fin (s k).count := ⟨0, (s k).positive⟩ + (∀ (k : Fin 3), pieceSign k (first k) = pieceSign (k + 1) (first (k + 1))) → (∀ (k : Fin + (3 : ℕ)), pieceSign k (first k) = pieceSign (0 : Fin (3 : ℕ)) (first (0 : Fin (3 : + ℕ)))) ) := by + classical + intro g s U pieceSide sideInfo pieceSign first arcAgree k + fin_cases k + · rfl + · exact (arcAgree 0).symm + · exact arcAgree 2 + +end PolygonSidePropagation + +theorem P3934T1PolygonalSidePropagation + (g : Fin 3 → Set.Icc (0 : Real) 1 → Real × Real) + (s : ∀ k, P3723T1PolygonalParameterization (g k)) + (hc : ∀ k, Continuous (g k)) (hi : ∀ k, Function.Injective (g k)) + (hjoin : ∀ k, g k ⟨1, by norm_num⟩ = g (k + 1) ⟨0, by norm_num⟩) + (hv : Function.Injective (fun k => g k ⟨0, by norm_num⟩)) + (hinter : ∀ k l, k ≠ l → Set.range (g k) ∩ Set.range (g l) ⊆ + {q | (q = g k ⟨0, by norm_num⟩ ∨ q = g k ⟨1, by norm_num⟩) ∧ + (q = g l ⟨0, by norm_num⟩ ∨ q = g l ⟨1, by norm_num⟩)}) + (U : Set (Real × Real)) (hU : IsOpen U) + (hf : frontier U = ⋃ k, Set.range (g k)) + (he : frontier (closure U)ᶜ = frontier U) : + ∃ e : Bool, ∀ k, + P3934T1PolygonalSide U (g k) (s k) e ∧ + P3934T1PolygonalSide (closure U)ᶜ (g k) (s k) (!e) := by +-- BODY + have transfer (W : Set (Real × Real)) (x : Real × Real) (r : Real) (C : Set (Real × Real)) + (z w : Real × Real) (e : Bool) (hz : z ∈ Metric.ball x r) + (heq : W ∩ Metric.ball x r = C) (hside : P3934T1LocalSide C z w e) := + PolygonSidePropagation.transfer W x r C z w e hz heq hside + have bend (x : Real × Real) (r : Real) (u v : Real × Real) + (hr : 0 < r) (hu : ‖u‖ = 1) (hv : ‖v‖ = 1) (hne : u ≠ v) + (hx : x ∈ frontier U) + (hchart : frontier U ∩ Metric.ball x r = + ({p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v}) ∩ Metric.ball x r) := + PolygonSidePropagation.bend U hU he transfer x r u v hr hu hv hne hx hchart + have pieceData (k : Fin 3) (i : Fin (s k).count) := PolygonSidePropagation.pieceData g s hi k i + have compactRange (k : Fin 3) := PolygonSidePropagation.compactRange g hc k + have compactImage (k : Fin 3) (S : Set (Set.Icc (0 : Real) 1)) + (hS : IsClosed S) : IsCompact (g k '' S) := + (isCompact_univ.of_isClosed_subset hS (Set.subset_univ _)).image (hc k) + have avoidClosed (K : Set (Real × Real)) (hK : IsClosed K) + (z : Real × Real) (hz : z ∉ K) := PolygonSidePropagation.avoidClosed K hK z hz + have isolatePiece (k : Fin 3) (i : Fin (s k).count) + (t : Set.Icc (0 : Real) 1) + (htlo : (s k).time i.castSucc < (t : Real)) + (hthi : (t : Real) < (s k).time i.succ) := PolygonSidePropagation.isolatePiece g s hi + hinter compactRange compactImage avoidClosed k i t htlo hthi + have scaleLocalSide (W : Set (Real × Real)) (z w : Real × Real) + (c : Real) (e : Bool) (hc : 0 < c) + (hside : P3934T1LocalSide W z w e) := PolygonSidePropagation.scaleLocalSide W z w c e hc + hside + have straightFrontierRays (k : Fin 3) (i : Fin (s k).count) + (A B : Real × Real) (hB : B ≠ 0) + (hline : ∀ a : Set.Icc (0 : Real) 1, + (s k).time i.castSucc ≤ (a : Real) → + (a : Real) ≤ (s k).time i.succ → g k a = A + (a : Real) • B) + (t : Set.Icc (0 : Real) 1) + (htlo : (s k).time i.castSucc < (t : Real)) + (hthi : (t : Real) < (s k).time i.succ) := PolygonSidePropagation.straightFrontierRays g s + U hf isolatePiece k i A B hB hline t htlo hthi + have straightSideAt (k : Fin 3) (i : Fin (s k).count) + (A B : Real × Real) (hB : B ≠ 0) + (hline : ∀ a : Set.Icc (0 : Real) 1, + (s k).time i.castSucc ≤ (a : Real) → + (a : Real) ≤ (s k).time i.succ → g k a = A + (a : Real) • B) + (t : Set.Icc (0 : Real) 1) + (htlo : (s k).time i.castSucc < (t : Real)) + (hthi : (t : Real) < (s k).time i.succ) := PolygonSidePropagation.straightSideAt g s U hU + he straightFrontierRays k i A B hB hline t htlo hthi + have sideMove (W : Set (Real × Real)) (z z' w : Real × Real) (e : Bool) + (hshift : ∃ c : Real, z' = z + c • w) + (hside : P3934T1LocalSide W z w e) + (hclose : dist z' z < Classical.choose hside) := PolygonSidePropagation.sideMove W z z' w e + hshift hside hclose + have sideSignsDisjoint (W : Set (Real × Real)) (z w : Real × Real) + (hw : w ≠ 0) + (hpos : P3934T1LocalSide W z w true) + (hneg : P3934T1LocalSide W z w false) := PolygonSidePropagation.sideSignsDisjoint W z w + hw hpos hneg + have pieceConstant (k : Fin 3) (i : Fin (s k).count) + (A B : Real × Real) (hB : B ≠ 0) + (hline : ∀ a : Set.Icc (0 : Real) 1, + (s k).time i.castSucc ≤ (a : Real) → + (a : Real) ≤ (s k).time i.succ → g k a = A + (a : Real) • B) := + PolygonSidePropagation.pieceConstant g s U straightSideAt sideMove sideSignsDisjoint + k i A B hB hline + have interiorIsolate (k : Fin 3) (i : Fin (s k).count) + (hnxt : i.val + 1 < (s k).count) := PolygonSidePropagation.interiorIsolate g s hi hinter + compactRange compactImage avoidClosed k i hnxt + have sideBoolEq (W : Set (Real × Real)) (z w : Real × Real) + (hw : w ≠ 0) (e f : Bool) + (he : P3934T1LocalSide W z w e) + (hf : P3934T1LocalSide W z w f) := PolygonSidePropagation.sideBoolEq sideSignsDisjoint W + z w hw e f he hf + have cornerAgree (x B₁ B₂ : Real × Real) (hB₁ : B₁ ≠ 0) (hB₂ : B₂ ≠ 0) + (a b R : Real) (ha : 0 < a) (hb : 0 < b) (hR : 0 < R) + (e₁ e₂ : Bool) + (back : ∀ t : Real, 0 ≤ t → t ≤ a → x - t • B₁ ∈ frontier U) + (forward : ∀ t : Real, 0 ≤ t → t ≤ b → x + t • B₂ ∈ frontier U) + (backSide : ∀ t : Real, 0 < t → t < a → + P3934T1LocalSide U (x - t • B₁) B₁ e₁) + (forwardSide : ∀ t : Real, 0 < t → t < b → + P3934T1LocalSide U (x + t • B₂) B₂ e₂) + (apart : ∀ t₁ t₂ : Real, 0 < t₁ → t₁ < a → 0 < t₂ → t₂ < b → + x - t₁ • B₁ ≠ x + t₂ • B₂) + (near : ∀ q ∈ frontier U, q ∈ Metric.ball x R → + (∃ t : Real, 0 ≤ t ∧ t ≤ a ∧ q = x - t • B₁) ∨ + (∃ t : Real, 0 ≤ t ∧ t ≤ b ∧ q = x + t • B₂)) := PolygonSidePropagation.cornerAgree U + bend scaleLocalSide sideBoolEq x B₁ B₂ hB₁ hB₂ a b R ha hb hR e₁ e₂ back forward + backSide forwardSide apart near + have pieceSide (k : Fin 3) (i : Fin (s k).count) := PolygonSidePropagation.pieceSide g s U + pieceData pieceConstant k i + let sideInfo (k : Fin 3) (i : Fin (s k).count) := Classical.choose (pieceSide k i) + let chosenA (k : Fin 3) (i : Fin (s k).count) := (sideInfo k i).1 + let chosenAB (k : Fin 3) (i : Fin (s k).count) := (sideInfo k i).2.1 + let pieceSign (k : Fin 3) (i : Fin (s k).count) : Bool := (sideInfo k i).2.2 + have chosenSpec (k : Fin 3) (i : Fin (s k).count) : + chosenAB k i ≠ 0 ∧ + (∀ a : Set.Icc (0 : Real) 1, + (s k).time i.castSucc ≤ (a : Real) → + (a : Real) ≤ (s k).time i.succ → + g k a = chosenA k i + (a : Real) • chosenAB k i) ∧ + (∀ t : Set.Icc (0 : Real) 1, + (s k).time i.castSucc < (t : Real) → + (t : Real) < (s k).time i.succ → + P3934T1LocalSide U (g k t) (chosenAB k i) (pieceSign k i) ∧ + P3934T1LocalSide (closure U)ᶜ (g k t) (chosenAB k i) (!pieceSign k i)) := + PolygonSidePropagation.chosenSpec g s U pieceSide k i + have vertexLabels (k l : Fin 3) (i : Fin (s k).count) (j : Fin (s l).count) + (p q : Set.Icc (0 : Real) 1) + (hp : (s k).time i.succ = (p : Real)) + (hq : (s l).time j.castSucc = (q : Real)) + (hcenter : g k p = g l q) + (apart : ∀ t₁ t₂ : Set.Icc (0 : Real) 1, + (s k).time i.castSucc < (t₁ : Real) → (t₁ : Real) < (p : Real) → + (q : Real) < (t₂ : Real) → (t₂ : Real) < (s l).time j.succ → + g k t₁ ≠ g l t₂) + (R : Real) (hR : 0 < R) + (near : ∀ m (t : Set.Icc (0 : Real) 1), + g m t ∈ Metric.ball (g k p) R → + (m = k ∧ (s k).time i.castSucc ≤ (t : Real) ∧ (t : Real) ≤ (p : Real)) ∨ + (m = l ∧ (q : Real) ≤ (t : Real) ∧ (t : Real) ≤ (s l).time j.succ)) := + PolygonSidePropagation.vertexLabels g s U hf cornerAgree pieceSide chosenSpec k l i j + p q hp hq hcenter apart R hR near + have interiorSignAgree (k : Fin 3) (i : Fin (s k).count) + (hnxt : i.val + 1 < (s k).count) := PolygonSidePropagation.interiorSignAgree g s hi U + interiorIsolate pieceSide vertexLabels k i hnxt + have signChain (k : Fin 3) := PolygonSidePropagation.signChain g s U pieceSide interiorSignAgree k + have isolateNeighborhood (x : Real × Real) + (O : Fin 3 → Set (Set.Icc (0 : Real) 1)) + (hO : ∀ k, IsOpen (O k)) + (hx : ∀ k t, g k t = x → t ∈ O k) := PolygonSidePropagation.isolateNeighborhood g + compactImage avoidClosed x O hO hx + have next_ne (k : Fin 3) : k + 1 ≠ k := by + fin_cases k <;> decide + have joinPreimage (k l : Fin 3) (t : Set.Icc (0 : Real) 1) + (ht : g l t = g k ⟨1, by norm_num⟩) := PolygonSidePropagation.joinPreimage g hi hjoin hv + hinter k l t ht + let first (k : Fin 3) : Fin (s k).count := ⟨0, (s k).positive⟩ + let last (k : Fin 3) : Fin (s k).count := + ⟨(s k).count - 1, by have := (s k).positive; omega⟩ + have joinSignAgree (k : Fin 3) := PolygonSidePropagation.joinSignAgree g s hi hjoin hinter U + pieceSide vertexLabels isolateNeighborhood next_ne joinPreimage k + have arcAgree (k : Fin 3) := PolygonSidePropagation.arcAgree g s U pieceSide signChain + joinSignAgree k + have allArc (k : Fin 3) := PolygonSidePropagation.allArc g s U pieceSide arcAgree k + have allPieces (k : Fin 3) (i : Fin (s k).count) : + pieceSign k i = pieceSign 0 (first 0) := + (signChain k i.val i.isLt).trans (allArc k) + refine ⟨pieceSign 0 (first 0), ?_⟩ + intro k + constructor + · intro i + refine ⟨chosenA k i, chosenAB k i, (chosenSpec k i).1, (chosenSpec k i).2.1, ?_⟩ + intro t hlo hhi + simpa only [allPieces k i] using ((chosenSpec k i).2.2 t hlo hhi).1 + · intro i + refine ⟨chosenA k i, chosenAB k i, (chosenSpec k i).1, (chosenSpec k i).2.1, ?_⟩ + intro t hlo hhi + simpa only [allPieces k i] using ((chosenSpec k i).2.2 t hlo hhi).2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean b/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean new file mode 100644 index 0000000000..6bcf943ce3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean @@ -0,0 +1,2444 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectorDecomposition +public import LeanPool.ApollonianSuperharmonic.P3934T1LocalSide +public import Mathlib.Analysis.Convex.PathConnected +public import Mathlib.Analysis.Normed.Module.Convex +public import Mathlib.Tactic.FunProp + +-- [TABLET NODE: P3934T1SectorContinuation] + +/-! +# P3934T1SectorContinuation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SectorContinuationGeometry + +private theorem hdet_cases : + ∀ (u : Real × Real), ∀ (v : Real × Real), (‖u‖ = 1) → ((‖v‖ = 1) → ((u ≠ v) → ( + let det : + (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + (u.1 ≠ 0 ∨ u.2 ≠ 0) → (det u v ≠ 0 ∨ v = -u)))) := by + classical + intro u v hu hv huv det hcoord + by_cases hd : det u v ≠ 0 + · exact Or.inl hd + · right + have hdet0 : u.1 * v.2 - u.2 * v.1 = 0 := by + simpa [det] using hd + have hscalar : ∃ k : Real, v = k • u := by + rcases hcoord with h1 | h2 + · refine ⟨v.1 / u.1, ?_⟩ + apply Prod.ext + · simp [div_eq_mul_inv, h1] + · dsimp + field_simp + nlinarith [hdet0] + · refine ⟨v.2 / u.2, ?_⟩ + apply Prod.ext + · dsimp + field_simp [h2] + nlinarith [hdet0] + · simp [div_eq_mul_inv, h2] + obtain ⟨k, hk⟩ := hscalar + have hkabs : |k| = 1 := by + have hvnorm := hv + rw [hk, norm_smul, Real.norm_eq_abs, hu] at hvnorm + nlinarith + have hk2 : k ^ 2 = 1 := by nlinarith [sq_abs k] + have hfactor : (k - 1) * (k + 1) = 0 := by nlinarith [hk2] + rcases mul_eq_zero.mp hfactor with hkone | hkminus + · have hkone' : k = 1 := by linarith + have huv' : v = u := by rw [hk, hkone']; simp + exact False.elim (huv huv'.symm) + · have hkminus' : k = -1 := by linarith + rw [hk, hkminus'] + simp + +private theorem hrep : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → + (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + (0 < d') → ( + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + (∀ (y : Real × Real), d' • y = B (x + y) • a + A (x + y) • b) → (∀ (p : Real × Real), p - x = + (B p / d') • a + (A p / d') • b)) := by + classical + intro x u v det d a b d' hdpos A B hdetid p + have hy := hdetid (p - x) + have hy' : d' • (p - x) = B p • a + A p • b := by simpa using hy + have hd' : d' ≠ 0 := ne_of_gt hdpos + have hmul := congrArg (fun y : Real × Real => d'⁻¹ • y) hy' + calc + p - x = d'⁻¹ • (d' • (p - x)) := by simp [smul_smul, hd'] + _ = d'⁻¹ • (B p • a + A p • b) := hmul + _ = (B p / d') • a + (A p / d') • b := by + simp [smul_add, smul_smul, div_eq_mul_inv, mul_comm] + +private theorem hC₁conv : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + Convex ℝ C₁ := by + classical + intro x r u v det d a b A B C₁ p hp q hq α β hα hβ hsum + rcases hp with ⟨⟨hpball, hpA⟩, hpB⟩ + rcases hq with ⟨⟨hqball, hqA⟩, hqB⟩ + have hβ' : β = 1 - α := by linarith + subst β + refine ⟨⟨(convex_ball x r) hpball hqball hα (by positivity) (by linarith), ?_⟩, ?_⟩ + · have hcomb : A (α • p + (1 - α) • q) = α * A p + (1 - α) * A q := by + dsimp [A, det] + ring + change 0 < A (α • p + (1 - α) • q) + rw [hcomb] + by_cases hα0 : α = 0 + · subst α + simpa using hqA + · have hαpos : 0 < α := lt_of_le_of_ne hα (Ne.symm hα0) + exact add_pos_of_pos_of_nonneg (mul_pos hαpos hpA) + (mul_nonneg (by positivity) (le_of_lt hqA)) + · have hcomb : B (α • p + (1 - α) • q) = α * B p + (1 - α) * B q := by + dsimp [B, det] + ring + change 0 < B (α • p + (1 - α) • q) + rw [hcomb] + by_cases hα0 : α = 0 + · subst α + simpa using hqB + · have hαpos : 0 < α := lt_of_le_of_ne hα (Ne.symm hα0) + exact add_pos_of_pos_of_nonneg (mul_pos hαpos hpB) + (mul_nonneg (by positivity) (le_of_lt hqB)) + +private theorem hCconv : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let A : (Real × Real) → Real := fun p => det a (p - x) + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + Convex ℝ C := by + classical + intro x r u v det d a A C p hp q hq α β hα hβ hsum + rcases hp with ⟨hpball, hpA⟩ + rcases hq with ⟨hqball, hqA⟩ + have hβ' : β = 1 - α := by linarith + subst β + refine ⟨(convex_ball x r) hpball hqball hα (by positivity) (by linarith), ?_⟩ + have hcomb : A (α • p + (1 - α) • q) = α * A p + (1 - α) * A q := by + dsimp [A, det] + ring + change A (α • p + (1 - α) • q) < 0 + rw [hcomb] + by_cases hβ0 : 1 - α = 0 + · have hαone : α = 1 := by linarith + simpa [hαone, hβ0] using hpA + · have hβpos : 0 < 1 - α := lt_of_le_of_ne (by linarith) (Ne.symm hβ0) + exact add_neg_of_nonpos_of_neg + (mul_nonpos_of_nonneg_of_nonpos hα (le_of_lt hpA)) + (mul_neg_of_pos_of_neg hβpos hqA) + +private theorem hDconv : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let b : Real × Real := if 0 < d then v else u + let B : (Real × Real) → Real := fun p => det (p - x) b + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + Convex ℝ D := by + classical + intro x r u v det d b B D p hp q hq α β hα hβ hsum + rcases hp with ⟨hpball, hpB⟩ + rcases hq with ⟨hqball, hqB⟩ + have hβ' : β = 1 - α := by linarith + subst β + refine ⟨(convex_ball x r) hpball hqball hα (by positivity) (by linarith), ?_⟩ + have hcomb : B (α • p + (1 - α) • q) = α * B p + (1 - α) * B q := by + dsimp [B, det] + ring + change B (α • p + (1 - α) • q) < 0 + rw [hcomb] + by_cases hβ0 : 1 - α = 0 + · have hαone : α = 1 := by linarith + simpa [hαone, hβ0] using hpB + · have hβpos : 0 < 1 - α := lt_of_le_of_ne (by linarith) (Ne.symm hβ0) + exact add_neg_of_nonpos_of_neg + (mul_nonpos_of_nonneg_of_nonpos hα (le_of_lt hpB)) + (mul_neg_of_pos_of_neg hβpos hqB) + +private theorem hRayShape : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → + (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + (0 < d') → ( + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + ((a = u ∧ b = v) ∨ (a = v ∧ b = u)) → ((∀ (t : Real), A (x + t • a) = 0) → ((∀ (t : Real), B + (x + t • a) = t * d') → ((∀ (t : Real), A (x + t • b) = t * d') → ((∀ (t : Real), B (x + + t • b) = 0) → ( + let Rays : Set (Real × Real) := + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} + ∀ (p : Real × Real), (p ∈ Rays) → ((A p = 0 ∧ 0 ≤ B p) ∨ (B p = 0 ∧ 0 ≤ A + p)))))))) := by + classical + intro x u v det d a b d' hdpos A B horder hAa hBa hAb hBb Rays p hp + change p ∈ {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} at hp + rcases hp with hp | hp + · rcases hp with ⟨t, ht, rfl⟩ + rcases horder with ⟨haEq, hbEq⟩ | ⟨haEq, hbEq⟩ + · have h1 : A (x + t • u) = 0 := by simpa [haEq] using hAa t + have h2 : B (x + t • u) = t * d' := by simpa [haEq] using hBa t + left + exact ⟨h1, by rw [h2]; exact mul_nonneg ht (le_of_lt hdpos)⟩ + · have h1 : B (x + t • u) = 0 := by simpa [hbEq] using hBb t + have h2 : A (x + t • u) = t * d' := by simpa [hbEq] using hAb t + right + exact ⟨h1, by rw [h2]; exact mul_nonneg ht (le_of_lt hdpos)⟩ + · rcases hp with ⟨t, ht, rfl⟩ + rcases horder with ⟨haEq, hbEq⟩ | ⟨haEq, hbEq⟩ + · have h1 : B (x + t • v) = 0 := by simpa [hbEq] using hBb t + have h2 : A (x + t • v) = t * d' := by simpa [hbEq] using hAb t + right + exact ⟨h1, by rw [h2]; exact mul_nonneg ht (le_of_lt hdpos)⟩ + · have h1 : A (x + t • v) = 0 := by simpa [haEq] using hAa t + have h2 : B (x + t • v) = t * d' := by simpa [haEq] using hBa t + left + exact ⟨h1, by rw [h2]; exact mul_nonneg ht (le_of_lt hdpos)⟩ + +private theorem hEsubsetAt411 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → + Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + (0 < d') → ( + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let C₂ : Set (Real × Real) := C ∪ D + (∀ (k : Real), (0 ≤ k) → (x + k • a ∈ ({p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ {p | ∃ t : + Real, 0 ≤ t ∧ p = x + t • v}))) → ((∀ (k : Real), (0 ≤ k) → (x + k • b ∈ ({p | ∃ t : + Real, 0 ≤ t ∧ p = x + t • u} ∪ {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v}))) → ((∀ (p : Real + × Real), (A p = 0) → (p = x + (B p / d') • a)) → ((∀ (p : Real × Real), (B p = 0) → (p = + x + (A p / d') • b)) → ( + E.left ∪ E.right ⊆ C₁ ∪ C₂))))) := by + classical + intro x r u v E det d a b d' hdpos A B C₁ C D C₂ haRay hbRay hAzero hBzero + let Rays : Set (Real × Real) := + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} + intro p hp + have hpout : p ∈ Metric.ball x r \ Rays := by + rw [E.cover] at hp + simpa [Rays] using hp + rcases hpout with ⟨hpball, hnotray⟩ + by_cases hAneg : A p < 0 + · exact Or.inr (Or.inl ⟨hpball, hAneg⟩) + · by_cases hBneg : B p < 0 + · exact Or.inr (Or.inr ⟨hpball, hBneg⟩) + · have hAnonneg : 0 ≤ A p := le_of_not_gt hAneg + have hBnonneg : 0 ≤ B p := le_of_not_gt hBneg + by_cases hA0 : A p = 0 + · have hkray : 0 ≤ B p / d' := div_nonneg hBnonneg (le_of_lt hdpos) + have hray := haRay (B p / d') hkray + rw [← hAzero p hA0] at hray + exact (hnotray hray).elim + · by_cases hB0 : B p = 0 + · have hkray : 0 ≤ A p / d' := div_nonneg hAnonneg (le_of_lt hdpos) + have hray := hbRay (A p / d') hkray + rw [← hBzero p hB0] at hray + exact (hnotray hray).elim + · have hApos : 0 < A p := lt_of_le_of_ne hAnonneg (Ne.symm hA0) + have hBpos : 0 < B p := lt_of_le_of_ne hBnonneg (Ne.symm hB0) + exact Or.inl ⟨⟨hpball, hApos⟩, hBpos⟩ + +private theorem hdisAt436 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let C₂ : Set (Real × Real) := C ∪ D + Disjoint C₁ C₂ := by + classical + intro x r u v det d a b A B C₁ C D C₂ + apply Set.disjoint_left.mpr + intro p hp₁ hp₂ + have hpA : 0 < A p := hp₁.1.2 + have hpB : 0 < B p := hp₁.2 + rcases hp₂ with hpC | hpD + · rcases hpC with ⟨_, hpC⟩ + exact (not_lt_of_ge (le_of_lt hpA)) hpC + · rcases hpD with ⟨_, hpD⟩ + exact (not_lt_of_ge (le_of_lt hpB)) hpD + +private theorem classify : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let C₂ : Set (Real × Real) := C ∪ D + (IsOpen C₁) → ((IsOpen C₂) → ((Disjoint C₁ C₂) → (∀ (S : Set (Real × Real)), (IsConnected S) + → ((S ⊆ C₁ ∪ C₂) → (S ⊆ C₁ ∨ S ⊆ C₂))))) := by + classical + intro x r u v det d a b A B C₁ C D C₂ hC₁open hC₂open hdis S hS hsub + by_cases hm : (S ∩ C₁).Nonempty + · left + exact hS.isPreconnected.subset_left_of_subset_union + hC₁open hC₂open hdis hsub hm + · right + intro p hp + rcases hsub hp with hp₁ | hp₂ + · exact (hm ⟨p, hp, hp₁⟩).elim + · exact hp₂ + +private theorem hC₂off : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let C₂ : Set (Real × Real) := C ∪ D + let Rays : Set (Real × Real) := + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} + (∀ (p : Real × Real), (p ∈ Rays) → ((A p = 0 ∧ 0 ≤ B p) ∨ (B p = 0 ∧ 0 ≤ A p))) → (C₂ ⊆ + Metric.ball x r \ Rays) := by + classical + intro x r u v det d a b A B C D C₂ Rays hRayShape p hp + rcases hp with hpC | hpD + · rcases hpC with ⟨hpball, hAneg⟩ + change A p < 0 at hAneg + refine ⟨hpball, ?_⟩ + intro hpr + have hz := hRayShape p hpr + rcases hz with ⟨hA0, _⟩ | ⟨hB0, hApos⟩ + · exact (ne_of_lt hAneg) hA0 + · exact (not_lt_of_ge hApos) hAneg + · rcases hpD with ⟨hpball, hBneg⟩ + change B p < 0 at hBneg + refine ⟨hpball, ?_⟩ + intro hpr + have hz := hRayShape p hpr + rcases hz with ⟨hA0, hBnonneg⟩ | ⟨hB0, _⟩ + · exact (not_lt_of_ge hBnonneg) hBneg + · exact (ne_of_lt hBneg) hB0 + +private theorem horderComponentsAt496 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → + Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let C₂ : Set (Real × Real) := C ∪ D + let qpos : Real × Real := x + (r / 4) • (a + b) + let qneg : Real × Real := x - (r / 4) • (a + b) + (Disjoint C₁ C₂) → ((qpos ∈ E.left ∪ E.right) → ((qneg ∈ E.left ∪ E.right) → ((qpos ∈ C₁) → + ((qneg ∈ C₂) → ((E.left ⊆ C₁ ∨ E.left ⊆ C₂) → ((E.right ⊆ C₁ ∨ E.right ⊆ C₂) → ((E.left ⊆ + C₁ ∧ E.right ⊆ C₂) ∨ (E.left ⊆ C₂ ∧ E.right ⊆ C₁)))))))) := by + classical + intro x r u v E det d a b A B C₁ C D C₂ qpos qneg hdis hqposE hqnegE hqposC₁ hqnegC₂ hleftCases + hrightCases + rcases hleftCases with hL₁ | hL₂ + · rcases hrightCases with hR₁ | hR₂ + · rcases hqnegE with hqL | hqR + · exact False.elim ((Set.disjoint_left.mp hdis (hL₁ hqL) hqnegC₂).elim) + · exact False.elim ((Set.disjoint_left.mp hdis (hR₁ hqR) hqnegC₂).elim) + · exact Or.inl ⟨hL₁, hR₂⟩ + · rcases hrightCases with hR₁ | hR₂ + · exact Or.inr ⟨hL₂, hR₁⟩ + · rcases hqposE with hqL | hqR + · exact False.elim ((Set.disjoint_left.mp hdis hqposC₁ (hL₂ hqL)).elim) + · exact False.elim ((Set.disjoint_left.mp hdis hqposC₁ (hR₂ hqR)).elim) + +private theorem hcomponentEqAt509 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → + Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let C₂ : Set (Real × Real) := C ∪ D + let Rays : Set (Real × Real) := + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} + (Disjoint C₁ C₂) → ((C₁ ⊆ Metric.ball x r \ Rays) → ((C₂ ⊆ Metric.ball x r \ Rays) → + (((E.left ⊆ C₁ ∧ E.right ⊆ C₂) ∨ (E.left ⊆ C₂ ∧ E.right ⊆ C₁)) → ((E.left = C₁ ∧ E.right + = C₂) ∨ (E.left = C₂ ∧ E.right = C₁))))) := by + classical + intro x r u v E det d a b A B C₁ C D C₂ Rays hdis hC₁off hC₂off horderComponents + rcases horderComponents with ⟨hL, hR⟩ | ⟨hL, hR⟩ + · left + constructor + · apply Set.Subset.antisymm hL + intro p hp + have hpE : p ∈ E.left ∪ E.right := by rw [E.cover]; exact hC₁off hp + exact hpE.elim (fun hpL => hpL) fun hpR => + (Set.disjoint_left.mp hdis hp (hR hpR)).elim + · apply Set.Subset.antisymm hR + intro p hp + have hpE : p ∈ E.left ∪ E.right := by rw [E.cover]; exact hC₂off hp + exact hpE.elim (fun hpL => + (Set.disjoint_left.mp hdis (hL hpL) hp).elim) fun hpR => hpR + · right + constructor + · apply Set.Subset.antisymm hL + intro p hp + have hpE : p ∈ E.left ∪ E.right := by rw [E.cover]; exact hC₂off hp + exact hpE.elim (fun hpL => hpL) fun hpR => + (Set.disjoint_left.mp hdis (hR hpR) hp).elim + · apply Set.Subset.antisymm hR + intro p hp + have hpE : p ∈ E.left ∪ E.right := by rw [E.cover]; exact hC₁off hp + exact hpE.elim (fun hpL => + (Set.disjoint_left.mp hdis hp (hL hpL)).elim) fun hpR => hpR + +private theorem sampleA : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + (0 < d') → ((‖a‖ = 1) → ( + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let C₂ : Set (Real × Real) := C ∪ D + (Continuous B) → ((∀ (t : Real), B (x + t • a) = t * d') → (∀ (t : Real), ∀ (δ : Real), (0 < + t) → ((0 < δ) → ((Metric.ball (x + t • a) δ ⊆ Metric.ball x r) → (∃ qpos' qneg', qpos' ∈ + Metric.ball (x + t • a) δ ∧ + qneg' ∈ Metric.ball (x + t • a) δ ∧ qpos' ∈ C₁ ∧ qneg' ∈ C₂ ∧ + 0 < det a (qpos' - (x + t • a)) ∧ + det a (qneg' - (x + t • a)) < 0))))))) := by + classical + intro x r u v det d a b d' hdpos ha A B C₁ C D C₂ hBcont hBa t δ ht hδ hball + let z := x + t • a + have hBz : 0 < B z := by rw [show B z = t * d' by simpa [z] using hBa t]; exact mul_pos ht hdpos + have hWopen : IsOpen {q : Real × Real | 0 < B q} := isOpen_Ioi.preimage hBcont + obtain ⟨η, hη, hηsub⟩ := Metric.mem_nhds_iff.mp (hWopen.mem_nhds hBz) + let ε := min δ η / 2 + have hε : 0 < ε := by dsimp [ε]; positivity + have hεδ : ε < δ := by dsimp [ε]; have := min_le_left δ η; linarith + have hεη : ε < η := by dsimp [ε]; have := min_le_right δ η; linarith + let j : Real × Real := (-a.2, a.1) + have hjnorm : ‖j‖ = 1 := by + dsimp [j] + simpa [Prod.norm_def, Real.norm_eq_abs, max_comm] using ha + have haNe : a ≠ (0, 0) := by + intro h + rw [h] at ha + norm_num at ha + have hsq : 0 < a.1 ^ 2 + a.2 ^ 2 := by + by_contra h + have hle : a.1 ^ 2 + a.2 ^ 2 ≤ 0 := le_of_not_gt h + have h1sq : a.1 ^ 2 = 0 := by nlinarith only [hle, sq_nonneg a.2] + have h2sq : a.2 ^ 2 = 0 := by nlinarith only [hle, sq_nonneg a.1] + have h1 : a.1 = 0 := by nlinarith only [h1sq] + have h2 : a.2 = 0 := by nlinarith only [h2sq] + exact haNe (Prod.ext h1 h2) + let qplus' := z + ε • j + let qminus' := z - ε • j + have hqplusBall : qplus' ∈ Metric.ball z δ := by + change dist qplus' z < δ + rw [dist_eq_norm] + have heq : qplus' - z = ε • j := by simp [qplus'] + rw [heq, norm_smul, Real.norm_eq_abs, abs_of_pos hε, hjnorm] + simpa using hεδ + have hqminusBall : qminus' ∈ Metric.ball z δ := by + change dist qminus' z < δ + rw [dist_eq_norm] + have heq : qminus' - z = -(ε • j) := by simp [qminus', sub_eq_add_neg] + rw [heq, norm_neg, norm_smul, Real.norm_eq_abs, abs_of_pos hε, hjnorm] + simpa using hεδ + have hqplusB : 0 < B qplus' := hηsub (by + change dist qplus' z < η + rw [dist_eq_norm] + have heq : qplus' - z = ε • j := by simp [qplus'] + rw [heq, norm_smul, Real.norm_eq_abs, abs_of_pos hε, hjnorm] + simpa using hεη) + have hqminusB : 0 < B qminus' := hηsub (by + change dist qminus' z < η + rw [dist_eq_norm] + have heq : qminus' - z = -(ε • j) := by simp [qminus', sub_eq_add_neg] + rw [heq, norm_neg, norm_smul, Real.norm_eq_abs, abs_of_pos hε, hjnorm] + simpa using hεη) + have hAplus : A qplus' = ε * (a.1 ^ 2 + a.2 ^ 2) := by + dsimp [A, qplus', z, j, det] + ring + have hAminus : A qminus' = -(ε * (a.1 ^ 2 + a.2 ^ 2)) := by + dsimp [A, qminus', z, j, det] + ring + have hshift (q : Real × Real) : A q = det a (q - z) := by + dsimp [A, z, det] + ring + have hdetplus : 0 < det a (qplus' - z) := by + rw [← hshift, hAplus] + exact mul_pos hε hsq + have hdetminus : det a (qminus' - z) < 0 := by + rw [← hshift, hAminus] + exact neg_neg_of_pos (mul_pos hε hsq) + have hqplusX : qplus' ∈ Metric.ball x r := hball hqplusBall + have hqminusX : qminus' ∈ Metric.ball x r := hball hqminusBall + have hAplusPos : 0 < A qplus' := by rw [hAplus]; exact mul_pos hε hsq + have hAminusNeg : A qminus' < 0 := by rw [hAminus]; exact neg_neg_of_pos (mul_pos hε hsq) + exact ⟨qplus', qminus', hqplusBall, hqminusBall, + ⟨⟨hqplusX, hAplusPos⟩, hqplusB⟩, + Or.inl ⟨hqminusX, hAminusNeg⟩, hdetplus, hdetminus⟩ + +private theorem sampleB : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + (0 < d') → ((‖b‖ = 1) → ( + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let C₂ : Set (Real × Real) := C ∪ D + (Continuous A) → ((∀ (t : Real), A (x + t • b) = t * d') → (∀ (t : Real), ∀ (δ : Real), (0 < + t) → ((0 < δ) → ((Metric.ball (x + t • b) δ ⊆ Metric.ball x r) → (∃ qpos' qneg', qpos' ∈ + Metric.ball (x + t • b) δ ∧ + qneg' ∈ Metric.ball (x + t • b) δ ∧ qpos' ∈ C₂ ∧ qneg' ∈ C₁ ∧ + 0 < det b (qpos' - (x + t • b)) ∧ + det b (qneg' - (x + t • b)) < 0))))))) := by + classical + intro x r u v det d a b d' hdpos hb A B C₁ C D C₂ hAcont hAb t δ ht hδ hball + let z := x + t • b + have hAz : 0 < A z := by rw [show A z = t * d' by simpa [z] using hAb t]; exact mul_pos ht hdpos + have hWopen : IsOpen {q : Real × Real | 0 < A q} := isOpen_Ioi.preimage hAcont + obtain ⟨η, hη, hηsub⟩ := Metric.mem_nhds_iff.mp (hWopen.mem_nhds hAz) + let ε := min δ η / 2 + have hε : 0 < ε := by dsimp [ε]; positivity + have hεδ : ε < δ := by dsimp [ε]; have := min_le_left δ η; linarith + have hεη : ε < η := by dsimp [ε]; have := min_le_right δ η; linarith + let j : Real × Real := (-b.2, b.1) + have hjnorm : ‖j‖ = 1 := by + dsimp [j] + simpa [Prod.norm_def, Real.norm_eq_abs, max_comm] using hb + have hbNe : b ≠ (0, 0) := by + intro h + rw [h] at hb + norm_num at hb + have hsq : 0 < b.1 ^ 2 + b.2 ^ 2 := by + by_contra h + have hle : b.1 ^ 2 + b.2 ^ 2 ≤ 0 := le_of_not_gt h + have h1sq : b.1 ^ 2 = 0 := by nlinarith only [hle, sq_nonneg b.2] + have h2sq : b.2 ^ 2 = 0 := by nlinarith only [hle, sq_nonneg b.1] + have h1 : b.1 = 0 := by nlinarith only [h1sq] + have h2 : b.2 = 0 := by nlinarith only [h2sq] + exact hbNe (Prod.ext h1 h2) + let qplus' := z + ε • j + let qminus' := z - ε • j + have hqplusBall : qplus' ∈ Metric.ball z δ := by + change dist qplus' z < δ + rw [dist_eq_norm] + have heq : qplus' - z = ε • j := by simp [qplus'] + rw [heq, norm_smul, Real.norm_eq_abs, abs_of_pos hε, hjnorm] + simpa using hεδ + have hqminusBall : qminus' ∈ Metric.ball z δ := by + change dist qminus' z < δ + rw [dist_eq_norm] + have heq : qminus' - z = -(ε • j) := by simp [qminus', sub_eq_add_neg] + rw [heq, norm_neg, norm_smul, Real.norm_eq_abs, abs_of_pos hε, hjnorm] + simpa using hεδ + have hqplusA : 0 < A qplus' := hηsub (by + change dist qplus' z < η + rw [dist_eq_norm] + have heq : qplus' - z = ε • j := by simp [qplus'] + rw [heq, norm_smul, Real.norm_eq_abs, abs_of_pos hε, hjnorm] + simpa using hεη) + have hqminusA : 0 < A qminus' := hηsub (by + change dist qminus' z < η + rw [dist_eq_norm] + have heq : qminus' - z = -(ε • j) := by simp [qminus', sub_eq_add_neg] + rw [heq, norm_neg, norm_smul, Real.norm_eq_abs, abs_of_pos hε, hjnorm] + simpa using hεη) + have hBplus : B qplus' = -(ε * (b.1 ^ 2 + b.2 ^ 2)) := by + dsimp [B, qplus', z, j, det] + ring + have hBminus : B qminus' = ε * (b.1 ^ 2 + b.2 ^ 2) := by + dsimp [B, qminus', z, j, det] + ring + have hshift (q : Real × Real) : B q = -det b (q - z) := by + dsimp [B, z, det] + ring + have hdetplus : 0 < det b (qplus' - z) := by + have heq : det b (qplus' - z) = -B qplus' := by linarith [hshift qplus'] + rw [heq, hBplus] + nlinarith [mul_pos hε hsq] + have hdetminus : det b (qminus' - z) < 0 := by + have heq : det b (qminus' - z) = -B qminus' := by linarith [hshift qminus'] + rw [heq, hBminus] + exact neg_neg_of_pos (mul_pos hε hsq) + have hqplusX : qplus' ∈ Metric.ball x r := hball hqplusBall + have hqminusX : qminus' ∈ Metric.ball x r := hball hqminusBall + have hBplusNeg : B qplus' < 0 := by rw [hBplus]; exact neg_neg_of_pos (mul_pos hε hsq) + have hBminusPos : 0 < B qminus' := by rw [hBminus]; exact mul_pos hε hsq + exact ⟨qplus', qminus', hqplusBall, hqminusBall, + Or.inr ⟨hqplusX, hBplusNeg⟩, + ⟨⟨hqminusX, hqminusA⟩, hBminusPos⟩, hdetplus, hdetminus⟩ + +private theorem aLocalC₁ : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → + Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let C₂ : Set (Real × Real) := C ∪ D + (∀ (t : Real), ∀ (δ : Real), (0 < t) → ((0 < δ) → ((Metric.ball (x + t • a) δ ⊆ Metric.ball x + r) → (∃ qpos' qneg', qpos' ∈ Metric.ball (x + t • a) δ ∧ qneg' ∈ Metric.ball (x + t • a) + δ ∧ qpos' ∈ C₁ ∧ qneg' ∈ C₂ ∧ 0 < det a (qpos' - (x + t • a)) ∧ det a (qneg' - (x + t • + a)) < 0)))) → ((a = u ∨ a = v) → (∀ (t : Real), (0 < t) → ((t < r) → ((E.left = C₁) → + (P3934T1LocalSide E.left (x + t • a) a true ∧ + P3934T1LocalSide E.right (x + t • a) a false))))) := by + classical + intro x r u v E det d a b A B C₁ C D C₂ sampleA haRayEq t ht htr hL + obtain ⟨δ, hδ, hball, hcases⟩ := E.sides a haRayEq t ht htr + obtain ⟨qp, qn, hqpδ, hqnδ, hqpC₁, hqnC₂, hqpdet, hqndet⟩ := + sampleA t δ ht hδ hball + rcases hcases with ⟨hLp, hRn⟩ | ⟨hRp, hLn⟩ + · exact ⟨⟨δ, hδ, hLp⟩, ⟨δ, hδ, hRn⟩⟩ + · have hqleft : qp ∈ E.left ∩ Metric.ball (x + t • a) δ := by + constructor + · rw [hL] + exact hqpC₁ + · exact hqpδ + rw [hLn] at hqleft + rcases hqleft with ⟨_, hbad⟩ + exact False.elim ((not_lt_of_ge (le_of_lt hqpdet)) hbad) + +private theorem aLocalC₂ : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → + Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let C₂ : Set (Real × Real) := C ∪ D + (∀ (t : Real), ∀ (δ : Real), (0 < t) → ((0 < δ) → ((Metric.ball (x + t • a) δ ⊆ Metric.ball x + r) → (∃ qpos' qneg', qpos' ∈ Metric.ball (x + t • a) δ ∧ qneg' ∈ Metric.ball (x + t • a) + δ ∧ qpos' ∈ C₁ ∧ qneg' ∈ C₂ ∧ 0 < det a (qpos' - (x + t • a)) ∧ det a (qneg' - (x + t • + a)) < 0)))) → ((a = u ∨ a = v) → (∀ (t : Real), (0 < t) → ((t < r) → ((E.left = C₂) → + (P3934T1LocalSide E.left (x + t • a) a false ∧ + P3934T1LocalSide E.right (x + t • a) a true))))) := by + classical + intro x r u v E det d a b A B C₁ C D C₂ sampleA haRayEq t ht htr hL + obtain ⟨δ, hδ, hball, hcases⟩ := E.sides a haRayEq t ht htr + obtain ⟨qp, qn, hqpδ, hqnδ, hqpC₁, hqnC₂, hqpdet, hqndet⟩ := + sampleA t δ ht hδ hball + rcases hcases with ⟨hLp, hRn⟩ | ⟨hRp, hLn⟩ + · have hqleft : qn ∈ E.left ∩ Metric.ball (x + t • a) δ := by + constructor + · rw [hL] + exact hqnC₂ + · exact hqnδ + rw [hLp] at hqleft + rcases hqleft with ⟨_, hbad⟩ + exact False.elim ((not_lt_of_ge (le_of_lt hqndet)) hbad) + · exact ⟨⟨δ, hδ, hLn⟩, ⟨δ, hδ, hRp⟩⟩ + +private theorem bLocalC₁ : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → + Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let C₂ : Set (Real × Real) := C ∪ D + (∀ (t : Real), ∀ (δ : Real), (0 < t) → ((0 < δ) → ((Metric.ball (x + t • b) δ ⊆ Metric.ball x + r) → (∃ qpos' qneg', qpos' ∈ Metric.ball (x + t • b) δ ∧ qneg' ∈ Metric.ball (x + t • b) + δ ∧ qpos' ∈ C₂ ∧ qneg' ∈ C₁ ∧ 0 < det b (qpos' - (x + t • b)) ∧ det b (qneg' - (x + t • + b)) < 0)))) → ((b = u ∨ b = v) → (∀ (t : Real), (0 < t) → ((t < r) → ((E.left = C₁) → + (P3934T1LocalSide E.left (x + t • b) b false ∧ + P3934T1LocalSide E.right (x + t • b) b true))))) := by + classical + intro x r u v E det d a b A B C₁ C D C₂ sampleB hbRayEq t ht htr hL + obtain ⟨δ, hδ, hball, hcases⟩ := E.sides b hbRayEq t ht htr + obtain ⟨qp, qn, hqpδ, hqnδ, hqpC₂, hqnC₁, hqpdet, hqndet⟩ := + sampleB t δ ht hδ hball + rcases hcases with ⟨hLp, hRn⟩ | ⟨hRp, hLn⟩ + · have hqleft : qn ∈ E.left ∩ Metric.ball (x + t • b) δ := by + constructor + · rw [hL] + exact hqnC₁ + · exact hqnδ + rw [hLp] at hqleft + rcases hqleft with ⟨_, hbad⟩ + exact False.elim ((not_lt_of_ge (le_of_lt hqndet)) hbad) + · exact ⟨⟨δ, hδ, hLn⟩, ⟨δ, hδ, hRp⟩⟩ + +private theorem bLocalC₂ : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → + Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let C₂ : Set (Real × Real) := C ∪ D + (∀ (t : Real), ∀ (δ : Real), (0 < t) → ((0 < δ) → ((Metric.ball (x + t • b) δ ⊆ Metric.ball x + r) → (∃ qpos' qneg', qpos' ∈ Metric.ball (x + t • b) δ ∧ qneg' ∈ Metric.ball (x + t • b) + δ ∧ qpos' ∈ C₂ ∧ qneg' ∈ C₁ ∧ 0 < det b (qpos' - (x + t • b)) ∧ det b (qneg' - (x + t • + b)) < 0)))) → ((b = u ∨ b = v) → (∀ (t : Real), (0 < t) → ((t < r) → ((E.left = C₂) → + (P3934T1LocalSide E.left (x + t • b) b true ∧ + P3934T1LocalSide E.right (x + t • b) b false))))) := by + classical + intro x r u v E det d a b A B C₁ C D C₂ sampleB hbRayEq t ht htr hL + obtain ⟨δ, hδ, hball, hcases⟩ := E.sides b hbRayEq t ht htr + obtain ⟨qp, qn, hqpδ, hqnδ, hqpC₂, hqnC₁, hqpdet, hqndet⟩ := + sampleB t δ ht hδ hball + rcases hcases with ⟨hLp, hRn⟩ | ⟨hRp, hLn⟩ + · exact ⟨⟨δ, hδ, hLp⟩, ⟨δ, hδ, hRn⟩⟩ + · have hqleft : qp ∈ E.left ∩ Metric.ball (x + t • b) δ := by + constructor + · rw [hL] + exact hqpC₂ + · exact hqpδ + rw [hLn] at hqleft + rcases hqleft with ⟨_, hbad⟩ + exact False.elim ((not_lt_of_ge (le_of_lt hqpdet)) hbad) + +private theorem flipSide : + ∀ (U : Set (Real × Real)), ∀ (z : Real × Real), ∀ (w : Real × Real), ∀ (e : Bool), + (P3934T1LocalSide U z w e) → (P3934T1LocalSide U z (-w) (!e)) := by + classical + intro U z w e h + rcases h with ⟨ρ, hρ, heq⟩ + dsimp [P3934T1LocalSide] at heq ⊢ + let f := fun q : Real × Real => + w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1) + let g := fun q : Real × Real => + (-w).1 * (q.2 - z.2) - (-w).2 * (q.1 - z.1) + have hfg (q : Real × Real) : g q = -f q := by + dsimp [f, g] + simp + ring + cases e with + | false => + refine ⟨ρ, hρ, ?_⟩ + calc + U ∩ Metric.ball z ρ = {q | q ∈ Metric.ball z ρ ∧ f q < 0} := by + simpa [f] using heq + _ = {q | q ∈ Metric.ball z ρ ∧ 0 < g q} := by + ext q + simp only [Set.mem_ofPred_eq] + constructor + · rintro ⟨hb, hf⟩ + exact ⟨hb, by rw [hfg]; linarith⟩ + · rintro ⟨hb, hg⟩ + exact ⟨hb, by rw [hfg] at hg; linarith⟩ + | true => + refine ⟨ρ, hρ, ?_⟩ + calc + U ∩ Metric.ball z ρ = {q | q ∈ Metric.ball z ρ ∧ 0 < f q} := by + simpa [f] using heq + _ = {q | q ∈ Metric.ball z ρ ∧ g q < 0} := by + ext q + simp only [Set.mem_ofPred_eq] + constructor + · rintro ⟨hb, hf⟩ + exact ⟨hb, by rw [hfg]; linarith⟩ + · rintro ⟨hb, hg⟩ + exact ⟨hb, by rw [hfg] at hg; linarith⟩ + +private theorem hform : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), (‖u‖ = 1) → ((u + ≠ v) → ((P3889T1TwoRaySectorDecomposition x r u v) → ( + let det : (Real × Real) → (Real × + Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + (u ≠ (0, 0)) → ((u.1 ≠ 0 ∨ u.2 ≠ 0) → ((v = -u) → ( + let A : (Real × Real) → Real := fun p => + det u (p - x) + ∀ (w : Real × Real), (w = u ∨ w = v) → (∀ (t : Real), ∀ (q : Real × Real), -u.1 * (q.2 - (x.2 + + t * w.2)) - + -u.2 * (q.1 - (x.1 + t * w.1)) = -A q))))))) := by + classical + intro x r u v hu huv E det hu_ne hcoord hvneg A w hw t q + rcases hw with rfl | hwv + · dsimp [A, det] + ring + · rw [hwv, hvneg] + dsimp [A, det] + ring + +private theorem hlocalP : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let P : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + (∀ (w : Real × Real), (w = u ∨ w = v) → (∀ (t : Real), ∀ (q : Real × Real), -u.1 * (q.2 - + (x.2 + t * w.2)) - -u.2 * (q.1 - (x.1 + t * w.1)) = -A q)) → ((∀ (t : Real), (t < r) → (0 + < r - t)) → ((∀ (w : Real × Real), (‖w‖ = 1) → (∀ (t : Real), (0 < t) → ((t < r) → + (Metric.ball (x + t • w) (r - t) ⊆ Metric.ball x r)))) → (∀ (w : Real × Real), (w = u ∨ w + = v) → ((‖w‖ = 1) → (∀ (t : Real), (0 < t) → ((t < r) → (P3934T1LocalSide P (x + t • w) + (-u) false))))))) := by + classical + intro x r u v det A P hform hdelta hball w hw hwNorm t ht htr + refine ⟨r - t, hdelta t htr, ?_⟩ + dsimp [P] + ext q + simp only [Set.mem_inter_iff, Set.mem_ofPred_eq] + constructor + · rintro ⟨⟨hbx, hA⟩, hq⟩ + exact ⟨hq, by rw [hform w hw t q]; linarith⟩ + · rintro ⟨hq, hformq⟩ + exact ⟨⟨hball w hwNorm t ht htr hq, by + rw [hform w hw t q] at hformq + linarith⟩, hq⟩ + +private theorem hlocalN : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let N : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + (∀ (w : Real × Real), (w = u ∨ w = v) → (∀ (t : Real), ∀ (q : Real × Real), -u.1 * (q.2 - + (x.2 + t * w.2)) - -u.2 * (q.1 - (x.1 + t * w.1)) = -A q)) → ((∀ (t : Real), (t < r) → (0 + < r - t)) → ((∀ (w : Real × Real), (‖w‖ = 1) → (∀ (t : Real), (0 < t) → ((t < r) → + (Metric.ball (x + t • w) (r - t) ⊆ Metric.ball x r)))) → (∀ (w : Real × Real), (w = u ∨ w + = v) → ((‖w‖ = 1) → (∀ (t : Real), (0 < t) → ((t < r) → (P3934T1LocalSide N (x + t • w) + (-u) true))))))) := by + classical + intro x r u v det A N hform hdelta hball w hw hwNorm t ht htr + refine ⟨r - t, hdelta t htr, ?_⟩ + dsimp [N] + ext q + simp only [Set.mem_inter_iff, Set.mem_ofPred_eq] + constructor + · rintro ⟨⟨hbx, hA⟩, hq⟩ + exact ⟨hq, by rw [hform w hw t q]; linarith⟩ + · rintro ⟨hq, hformq⟩ + exact ⟨⟨hball w hwNorm t ht htr hq, by + rw [hform w hw t q] at hformq + linarith⟩, hq⟩ + +private theorem hcol : + ∀ (u : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + (u.1 ≠ 0 ∨ u.2 ≠ 0) → (∀ (y : Real × Real), (det u y = 0) → (∃ k : Real, y = k • u)) := by + classical + intro u det hcoord y hy + rcases hcoord with h1 | h2 + · refine ⟨y.1 / u.1, ?_⟩ + apply Prod.ext + · simp [div_eq_mul_inv, h1] + · have hy' : u.1 * y.2 - u.2 * y.1 = 0 := by simpa [det] using hy + dsimp + field_simp + nlinarith only [hy'] + · refine ⟨y.2 / u.2, ?_⟩ + apply Prod.ext + · have hy' : u.1 * y.2 - u.2 * y.1 = 0 := by simpa [det] using hy + dsimp + field_simp [h2] + nlinarith only [hy'] + · simp [div_eq_mul_inv, h2] + +private theorem hzeroRay : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → + (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + (v = -u) → ( + let A : (Real × Real) → Real := fun p => det u (p - x) + let Rays : Set (Real × Real) := + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} + (∀ (y : Real × Real), (det u y = 0) → (∃ k : Real, y = k • u)) → (∀ (p : Real × Real), (A p = + 0) → (p ∈ Rays))) := by + classical + intro x u v det hvneg A Rays hcol p hp + have hy : det u (p - x) = 0 := by simpa [A] using hp + obtain ⟨k, hk⟩ := hcol (p - x) hy + have hpEq : p = x + k • u := by + calc + p = x + (p - x) := by simp + _ = x + k • u := by rw [hk] + by_cases hk0 : 0 ≤ k + · exact Or.inl ⟨k, hk0, hpEq⟩ + · have hkneg : k < 0 := lt_of_not_ge hk0 + have hmul : (-k) • v = k • u := by rw [hvneg]; simp + have hpEq' : p = x + (-k) • v := by rw [hpEq, ← hmul] + exact Or.inr ⟨-k, le_of_lt (neg_pos.mpr hkneg), hpEq'⟩ + +private theorem hPoff : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let P : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + let Rays : Set (Real × Real) := + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} + (∀ (p : Real × Real), (p ∈ Rays) → (A p = 0)) → (P ⊆ Metric.ball x r \ Rays) := by + classical + intro x r u v det A P Rays hRayAzero p hp + change p ∈ Metric.ball x r ∧ 0 < A p at hp + change p ∈ Metric.ball x r ∧ p ∉ Rays + refine ⟨hp.1, ?_⟩ + intro hpr + have hzero := hRayAzero p hpr + have hpA : 0 < A p := hp.2 + rw [hzero] at hpA + exact (lt_irrefl 0) hpA + +private theorem hNoff : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real + × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let N : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let Rays : Set (Real × Real) := + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} + (∀ (p : Real × Real), (p ∈ Rays) → (A p = 0)) → (N ⊆ Metric.ball x r \ Rays) := by + classical + intro x r u v det A N Rays hRayAzero p hp + change p ∈ Metric.ball x r ∧ A p < 0 at hp + change p ∈ Metric.ball x r ∧ p ∉ Rays + refine ⟨hp.1, ?_⟩ + intro hpr + have hzero := hRayAzero p hpr + have hpA : A p < 0 := hp.2 + rw [hzero] at hpA + exact (lt_irrefl 0) hpA + +private theorem hEsubsetAt1063 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → + Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let P : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + let N : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let Rays : Set (Real × Real) := + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} + (∀ (p : Real × Real), (A p = 0) → (p ∈ Rays)) → (E.left ∪ E.right ⊆ P ∪ N) := by + classical + intro x r u v E det A P N Rays hzeroRay p hp + change p ∈ P ∨ p ∈ N + have hpout : p ∈ Metric.ball x r \ Rays := by + rw [← E.cover] + exact hp + rcases hpout with ⟨hpball, hnotray⟩ + by_cases hAneg : A p < 0 + · right + change p ∈ Metric.ball x r ∧ A p < 0 + exact ⟨hpball, hAneg⟩ + · by_cases hA0 : A p = 0 + · exact False.elim (hnotray (hzeroRay p hA0)) + · left + change p ∈ Metric.ball x r ∧ 0 < A p + exact ⟨hpball, + lt_of_le_of_ne (le_of_not_gt hAneg) (Ne.symm hA0)⟩ + +private theorem horderComponentsAt1092 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → + Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let P : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + let N : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + (IsOpen P) → ((IsOpen N) → ( + let j : Real × Real := (-u.2, u.1) + let qpos : Real × Real := x + (r / 4) • j + let qneg : Real × Real := x - (r / 4) • j + (Disjoint P N) → ((E.left ∪ E.right ⊆ P ∪ N) → ((qpos ∈ E.left ∪ E.right) → ((qneg ∈ E.left ∪ + E.right) → ((qpos ∈ P) → ((qneg ∈ N) → ((E.left ⊆ P ∧ E.right ⊆ N) ∨ (E.left ⊆ N ∧ + E.right ⊆ P))))))))) := by + classical + intro x r u v E det A P N hPopen hNopen j qpos qneg hdis hEsubset hqposE hqnegE hqposP hqnegN + rcases hqposE with hqL | hqR + · have hL : E.left ⊆ P := by + exact E.left_connected.isPreconnected.subset_left_of_subset_union + hPopen hNopen hdis (fun p hp => hEsubset (Or.inl hp)) + ⟨qpos, hqL, hqposP⟩ + have hqnegR : qneg ∈ E.right := by + rcases hqnegE with hqnegL | hqnegR + · exact (Set.disjoint_left.mp hdis (hL hqnegL) hqnegN).elim + · exact hqnegR + have hR : E.right ⊆ N := by + exact E.right_connected.isPreconnected.subset_right_of_subset_union + hPopen hNopen hdis (fun p hp => hEsubset (Or.inr hp)) + ⟨qneg, hqnegR, hqnegN⟩ + exact Or.inl ⟨hL, hR⟩ + · have hR : E.right ⊆ P := by + exact E.right_connected.isPreconnected.subset_left_of_subset_union + hPopen hNopen hdis (fun p hp => hEsubset (Or.inr hp)) + ⟨qpos, hqR, hqposP⟩ + have hqnegL : qneg ∈ E.left := by + rcases hqnegE with hqnegL | hqnegR + · exact hqnegL + · exact (Set.disjoint_left.mp hdis (hR hqnegR) hqnegN).elim + have hL : E.left ⊆ N := by + exact E.left_connected.isPreconnected.subset_right_of_subset_union + hPopen hNopen hdis (fun p hp => hEsubset (Or.inl hp)) + ⟨qneg, hqnegL, hqnegN⟩ + exact Or.inr ⟨hL, hR⟩ + +private theorem hEqPN : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → + Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let P : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + let N : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + (Disjoint P N) → ( + let Rays : Set (Real × Real) := + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} + (P ⊆ Metric.ball x r \ Rays) → ((N ⊆ Metric.ball x r \ Rays) → ((E.left ⊆ P) → ((E.right ⊆ N) + → (E.left = P ∧ E.right = N))))) := by + classical + intro x r u v E det A P N hdis Rays hPoff hNoff hL hR + constructor + · apply Set.Subset.antisymm hL + intro p hp + have hpE : p ∈ E.left ∪ E.right := by + rw [E.cover] + exact hPoff hp + exact hpE.elim (fun h => h) fun h => + (Set.disjoint_left.mp hdis hp (hR h)).elim + · apply Set.Subset.antisymm hR + intro p hp + have hpE : p ∈ E.left ∪ E.right := by + rw [E.cover] + exact hNoff hp + exact hpE.elim (fun h => + (Set.disjoint_left.mp hdis (hL h) hp).elim) fun h => h + +private theorem hEqNP : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → + Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let P : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + let N : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + (Disjoint P N) → ( + let Rays : Set (Real × Real) := + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} + (P ⊆ Metric.ball x r \ Rays) → ((N ⊆ Metric.ball x r \ Rays) → ((E.left ⊆ N) → ((E.right ⊆ P) + → (E.left = N ∧ E.right = P))))) := by + classical + intro x r u v E det A P N hdis Rays hPoff hNoff hL hR + constructor + · apply Set.Subset.antisymm hL + intro p hp + have hpE : p ∈ E.left ∪ E.right := by + rw [E.cover] + exact hNoff hp + exact hpE.elim (fun h => h) fun h => + (Set.disjoint_left.mp hdis (hR h) hp).elim + · apply Set.Subset.antisymm hR + intro p hp + have hpE : p ∈ E.left ∪ E.right := by + rw [E.cover] + exact hPoff hp + exact hpE.elim (fun h => + (Set.disjoint_left.mp hdis hp (hL h)).elim) fun h => h + +end SectorContinuationGeometry + +namespace SectorContinuationFacts + +private theorem hu_ne : + ∀ (u : Real × Real), (‖u‖ = 1) → (u ≠ (0, 0)) := by + classical + intro u hu h + rw [h] at hu + norm_num at hu + +private theorem hcoord : + ∀ (u : Real × Real), (u ≠ (0, 0)) → (u.1 ≠ 0 ∨ u.2 ≠ 0) := by + classical + intro u hu_ne + by_contra h + push Not at h + exact hu_ne (Prod.ext h.1 h.2) + +private theorem hdpos : + ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + (d ≠ 0) → ( + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + 0 < d') := by + classical + intro u v det d hd a b d' + by_cases hpos : 0 < d + · simp [d', a, b, hpos, d, det] + · have hneg : d < 0 := lt_of_le_of_ne (le_of_not_gt hpos) hd + have hrev : det v u = -d := by dsimp [d, det]; ring + simp only [d', a, b, ite_eq_right hpos] + rw [hrev] + linarith + +private theorem hdetid : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + ∀ (y : Real × Real), d' • y = B (x + y) • a + A (x + y) • b := by + classical + intro x u v det d a b d' A B y + apply Prod.ext <;> simp [A, B, d', det, smul_eq_mul] <;> ring + +private theorem hAcontAt1316 : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let A : (Real × Real) → Real := fun p => det a (p - x) + Continuous A := by + classical + intro x u v det d a A + dsimp [A, det] + fun_prop + +private theorem hBcont : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let b : Real × Real := if 0 < d then v else u + let B : (Real × Real) → Real := fun p => det (p - x) b + Continuous B := by + classical + intro x u v det d b B + dsimp [B, det] + fun_prop + +private theorem hC₁open : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + (Continuous A) → ((Continuous B) → (IsOpen C₁)) := by + classical + intro x r u v det d a b A B C₁ hAcont hBcont + dsimp [C₁] + exact (Metric.isOpen_ball.inter (isOpen_Ioi.preimage hAcont)).inter + (isOpen_Ioi.preimage hBcont) + +private theorem hCopen : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let A : (Real × Real) → Real := fun p => det a (p - x) + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + (Continuous A) → (IsOpen C) := by + classical + intro x r u v det d a A C hAcont + dsimp [C] + exact Metric.isOpen_ball.inter (isOpen_Iio.preimage hAcont) + +private theorem hDopen : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let b : Real × Real := if 0 < d then v else u + let B : (Real × Real) → Real := fun p => det (p - x) b + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + (Continuous B) → (IsOpen D) := by + classical + intro x r u v det d b B D hBcont + dsimp [D] + exact Metric.isOpen_ball.inter (isOpen_Iio.preimage hBcont) + +private theorem hC₂open : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let C₂ : Set (Real × Real) := C ∪ D + (IsOpen C) → ((IsOpen D) → (IsOpen C₂)) := by + classical + intro x r u v det d a b A B C D C₂ hCopen hDopen + dsimp [C₂] + exact hCopen.union hDopen + +private theorem hsumNorm : + ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + (‖a‖ = 1) → ((‖b‖ = 1) → (‖a + b‖ ≤ 2)) := by + classical + intro u v det d a b ha hb + calc + ‖a + b‖ ≤ ‖a‖ + ‖b‖ := norm_add_le _ _ + _ = 2 := by rw [ha, hb]; norm_num + +private theorem hqposballAt1344 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), (0 < r) → ( + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + (‖a + b‖ ≤ 2) → ((0 < r / 4) → ( + let qpos : Real × Real := x + (r / 4) • (a + b) + qpos ∈ Metric.ball x r))) := by + classical + intro x r u v hr det d a b hsumNorm hr4 qpos + change dist qpos x < r + rw [dist_eq_norm] + have hbound : ‖(r / 4) • (a + b)‖ ≤ r / 2 := by + rw [norm_smul, Real.norm_eq_abs, abs_of_pos hr4] + nlinarith [hsumNorm] + have hdiff : qpos - x = (r / 4) • (a + b) := by simp [qpos] + rw [hdiff] + linarith + +private theorem hAqposAt1353 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + let A : (Real × Real) → Real := fun p => det a (p - x) + let qpos : Real × Real := x + (r / 4) • (a + b) + A qpos = (r / 4) * d' := by + classical + intro x r u v det d a b d' A qpos + dsimp [A, qpos, det, d'] + ring + +private theorem hBqpos : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + let B : (Real × Real) → Real := fun p => det (p - x) b + let qpos : Real × Real := x + (r / 4) • (a + b) + B qpos = (r / 4) * d' := by + classical + intro x r u v det d a b d' B qpos + dsimp [B, qpos, det, d'] + ring + +private theorem hqnegbAt1364 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), (0 < r) → ( + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + (‖a + b‖ ≤ 2) → ((0 < r / 4) → ( + let qneg : Real × Real := x - (r / 4) • (a + b) + qneg ∈ Metric.ball x r))) := by + classical + intro x r u v hr det d a b hsumNorm hr4 qneg + change dist qneg x < r + rw [dist_eq_norm] + have hbound : ‖(r / 4) • (a + b)‖ ≤ r / 2 := by + rw [norm_smul, Real.norm_eq_abs, abs_of_pos hr4] + nlinarith [hsumNorm] + have hdiff : qneg - x = -((r / 4) • (a + b)) := by simp [qneg, sub_eq_add_neg] + rw [hdiff, norm_neg] + linarith + +private theorem hAqnegAt1373 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + let A : (Real × Real) → Real := fun p => det a (p - x) + let qneg : Real × Real := x - (r / 4) • (a + b) + A qneg = -(r / 4) * d' := by + classical + intro x r u v det d a b d' A qneg + dsimp [A, qneg, det, d'] + ring + +private theorem hBqneg : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + let B : (Real × Real) → Real := fun p => det (p - x) b + let qneg : Real × Real := x - (r / 4) • (a + b) + B qneg = -(r / 4) * d' := by + classical + intro x r u v det d a b d' B qneg + dsimp [B, qneg, det, d'] + ring + +private theorem hqnegAAt1379 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + let A : (Real × Real) → Real := fun p => det a (p - x) + let qpos : Real × Real := x + (r / 4) • (a + b) + (A qpos = (r / 4) * d') → ((0 < A qpos) → ( + let qneg : Real × Real := x - (r / 4) • (a + b) + (A qneg = -(r / 4) * d') → (A qneg < 0))) := by + classical + intro x r u v det d a b d' A qpos hAqpos hqposA qneg hAqneg + rw [hAqneg] + nlinarith [hqposA] + +private theorem hqnegB : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let qpos : Real × Real := x + (r / 4) • (a + b) + (A qpos = (r / 4) * d') → ((0 < A qpos) → ( + let qneg : Real × Real := x - (r / 4) • (a + b) + (B qneg = -(r / 4) * d') → (B qneg < 0))) := by + classical + intro x r u v det d a b d' A B qpos hAqpos hqposA qneg hBqneg + rw [hBqneg] + nlinarith [hqposA] + +private theorem hC₂conn : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let C₂ : Set (Real × Real) := C ∪ D + ((C ∩ D).Nonempty) → ((IsConnected C) → ((IsConnected D) → (IsConnected C₂))) := by + classical + intro x r u v det d a b A B C D C₂ hCDne hCconn hDconn + dsimp [C₂] + exact IsConnected.union hCDne hCconn hDconn + +private theorem horder : + ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + (a = u ∧ b = v) ∨ (a = v ∧ b = u) := by + classical + intro u v det d a b + by_cases hpos : 0 < d + · left + constructor <;> simp [a, b, hpos] + · right + constructor <;> simp [a, b, hpos] + +private theorem haRay : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + ((a = u ∧ b = v) ∨ (a = v ∧ b = u)) → (∀ (k : Real), (0 ≤ k) → (x + k • a ∈ ({p | ∃ t : Real, + 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v}))) := by + classical + intro x u v det d a b horder k hk + rcases horder with ⟨haEq, hbEq⟩ | ⟨haEq, hbEq⟩ + · rw [haEq] + exact Or.inl ⟨k, hk, rfl⟩ + · rw [haEq] + exact Or.inr ⟨k, hk, rfl⟩ + +private theorem hbRay : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + ((a = u ∧ b = v) ∨ (a = v ∧ b = u)) → (∀ (k : Real), (0 ≤ k) → (x + k • b ∈ ({p | ∃ t : Real, + 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v}))) := by + classical + intro x u v det d a b horder k hk + rcases horder with ⟨haEq, hbEq⟩ | ⟨haEq, hbEq⟩ + · rw [hbEq] + exact Or.inr ⟨k, hk, rfl⟩ + · rw [hbEq] + exact Or.inl ⟨k, hk, rfl⟩ + +private theorem hAa : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let A : (Real × Real) → Real := fun p => det a (p - x) + ∀ (t : Real), A (x + t • a) = 0 := by + classical + intro x u v det d a A t + dsimp [A, det] + ring + +private theorem hBa : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + let B : (Real × Real) → Real := fun p => det (p - x) b + ∀ (t : Real), B (x + t • a) = t * d' := by + classical + intro x u v det d a b d' B t + dsimp [B, det, d'] + ring + +private theorem hAb : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + let A : (Real × Real) → Real := fun p => det a (p - x) + ∀ (t : Real), A (x + t • b) = t * d' := by + classical + intro x u v det d a b d' A t + dsimp [A, det, d'] + ring + +private theorem hBb : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let b : Real × Real := if 0 < d then v else u + let B : (Real × Real) → Real := fun p => det (p - x) b + ∀ (t : Real), B (x + t • b) = 0 := by + classical + intro x u v det d b B t + dsimp [B, det] + ring + +private theorem hAzero : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + (∀ (p : ℝ × ℝ), p - x = (B p / d') • a + (A p / d') • b) → (∀ (p : Real × Real), (A p = 0) → + (p = x + (B p / d') • a)) := by + classical + intro x u v det d a b d' A B hrep p hAp + calc + p = x + (p - x) := by simp + _ = x + ((B p / d') • a + (A p / d') • b) := by rw [hrep] + _ = x + (B p / d') • a := by rw [hAp]; simp + +private theorem hBzero : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + (∀ (p : ℝ × ℝ), p - x = (B p / d') • a + (A p / d') • b) → (∀ (p : Real × Real), (B p = 0) → + (p = x + (A p / d') • b)) := by + classical + intro x u v det d a b d' A B hrep p hBp + calc + p = x + (p - x) := by simp + _ = x + ((B p / d') • a + (A p / d') • b) := by rw [hrep] + _ = x + (A p / d') • b := by rw [hBp]; simp + +private theorem hC₁off : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let Rays : Set (Real × Real) := + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} + (∀ p ∈ Rays, A p = (0 : ℝ) ∧ (0 : ℝ) ≤ B p ∨ B p = (0 : ℝ) ∧ (0 : ℝ) ≤ A p) → (C₁ ⊆ + Metric.ball x r \ Rays) := by + classical + intro x r u v det d a b A B C₁ Rays hRayShape p hp + refine ⟨hp.1.1, ?_⟩ + intro hpr + have hz := hRayShape p hpr + rcases hz with ⟨hA0, _⟩ | ⟨hB0, _⟩ + · exact (ne_of_gt hp.1.2) hA0 + · exact (ne_of_gt hp.2) hB0 + +private theorem hqposEAt1461 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let qpos : Real × Real := x + (r / 4) • (a + b) + (qpos ∈ Metric.ball x r) → ((0 < A qpos) → ((0 < B qpos) → ( + let Rays : Set (Real × Real) := + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} + (C₁ ⊆ Metric.ball x r \ Rays) → (qpos ∈ E.left ∪ E.right)))) := by + classical + intro x r u v E det d a b A B C₁ qpos hqposball hqposA hqposB Rays hC₁off + rw [E.cover] + exact hC₁off ⟨⟨hqposball, hqposA⟩, hqposB⟩ + +private theorem hqnegEAt1464 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let A : (Real × Real) → Real := fun p => det a (p - x) + let qneg : Real × Real := x - (r / 4) • (a + b) + (qneg ∈ Metric.ball x r) → ((A qneg < 0) → ((Metric.ball x r ∩ {p : ℝ × ℝ | (fun (p : ℝ × ℝ) + => (fun (a b : ℝ × ℝ) => a.1 * b.2 - a.2 * b.1) (if (0 : ℝ) < (fun (a b : ℝ × ℝ) => a.1 * + b.2 - a.2 * b.1) u v then u else v) (p - x)) p < (0 : ℝ)} ∪ Metric.ball x r ∩ {p : ℝ × ℝ + | (fun (p : ℝ × ℝ) => (fun (a b : ℝ × ℝ) => a.1 * b.2 - a.2 * b.1) (p - x) (if (0 : ℝ) < + (fun (a b : ℝ × ℝ) => a.1 * b.2 - a.2 * b.1) u v then v else u)) p < (0 : ℝ)} ⊆ + Metric.ball x r \ ({p : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ p = x + t • u} ∪ {p : ℝ × ℝ | ∃ + (t : ℝ), (0 : ℝ) ≤ t ∧ p = x + t • v})) → (qneg ∈ E.left ∪ E.right))) := by + classical + intro x r u v E det d a b A qneg hqnegb hqnegA hC₂off + rw [E.cover] + exact hC₂off (Or.inl ⟨hqnegb, hqnegA⟩) + +private theorem haRayEq : + ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + ((a = u ∧ b = v) ∨ (a = v ∧ b = u)) → (a = u ∨ a = v) := by + classical + intro u v det d a b horder + rcases horder with ⟨haEq, hbEq⟩ | ⟨haEq, hbEq⟩ + · exact Or.inl haEq + · exact Or.inr haEq + +private theorem hbRayEq : + ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let d := det u v + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + ((a = u ∧ b = v) ∨ (a = v ∧ b = u)) → (b = u ∨ b = v) := by + classical + intro u v det d a b horder + rcases horder with ⟨haEq, hbEq⟩ | ⟨haEq, hbEq⟩ + · exact Or.inr hbEq + · exact Or.inl hbEq + +private theorem hdist : + ∀ (x : Real × Real), ∀ (w : Real × Real), (‖w‖ = 1) → (∀ (t : Real), (0 < t) → (dist (x + t • + w) x = t)) := by + classical + intro x w hw t ht + rw [dist_eq_norm] + have hsub : x + t • w - x = t • w := by abel + rw [hsub, norm_smul, Real.norm_eq_abs, abs_of_pos ht, hw] + ring + +private theorem hball : + ∀ (x : Real × Real), ∀ (r : Real), (∀ (w : Real × Real), (‖w‖ = 1) → (∀ (t : Real), (0 < t) → + (dist (x + t • w) x = t))) → (∀ (w : Real × Real), (‖w‖ = 1) → (∀ (t : Real), (0 < t) → + ((t < r) → (Metric.ball (x + t • w) (r - t) ⊆ Metric.ball x r)))) := by + classical + intro x r hdist w hw t ht htr + apply Metric.ball_subset_ball' + rw [hdist w hw t ht] + exact le_of_eq (sub_add_cancel r t) + +private theorem hAcontAt1604 : + ∀ (x : Real × Real), ∀ (u : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + Continuous A := by + classical + intro x u det A + dsimp [A, det] + fun_prop + +private theorem hPopen : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let P : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + (Continuous A) → (IsOpen P) := by + classical + intro x r u det A P hAcont + dsimp [P] + exact Metric.isOpen_ball.inter (isOpen_Ioi.preimage hAcont) + +private theorem hNopen : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let N : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + (Continuous A) → (IsOpen N) := by + classical + intro x r u det A N hAcont + dsimp [N] + exact Metric.isOpen_ball.inter (isOpen_Iio.preimage hAcont) + +private theorem hPconv : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let P : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + Convex ℝ P := by + classical + intro x r u det A P + let f : (Real × Real) →ᵃ[Real] Real := { + toFun := A + linear := { + toFun := fun y => det u y + map_add' := by + intro y z + dsimp [det] + ring + map_smul' := by + intro c y + dsimp [det] + ring + } + map_vadd' := by + intro p y + dsimp [A, det] + ring + } + change Convex ℝ (Metric.ball x r ∩ f ⁻¹' Set.Ioi 0) + exact (convex_ball x r).inter ((convex_Ioi 0).affine_preimage f) + +private theorem hNconv : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let N : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + Convex ℝ N := by + classical + intro x r u det A N + let f : (Real × Real) →ᵃ[Real] Real := { + toFun := A + linear := { + toFun := fun y => det u y + map_add' := by + intro y z + dsimp [det] + ring + map_smul' := by + intro c y + dsimp [det] + ring + } + map_vadd' := by + intro p y + dsimp [A, det] + ring + } + change Convex ℝ (Metric.ball x r ∩ f ⁻¹' Set.Iio 0) + exact (convex_ball x r).inter ((convex_Iio 0).affine_preimage f) + +private theorem hsqpos : + ∀ (u : Real × Real), (u ≠ (0, 0)) → (0 < u.1 ^ 2 + u.2 ^ 2) := by + classical + intro u hu0 + by_contra h + have hle : u.1 ^ 2 + u.2 ^ 2 ≤ 0 := le_of_not_gt h + have h1sq : u.1 ^ 2 = 0 := by nlinarith only [hle, sq_nonneg u.2] + have h2sq : u.2 ^ 2 = 0 := by nlinarith only [hle, sq_nonneg u.1] + have h1 : u.1 = 0 := by nlinarith only [h1sq] + have h2 : u.2 = 0 := by nlinarith only [h2sq] + exact hu0 (Prod.ext h1 h2) + +private theorem hjnorm : + ∀ (u : Real × Real), (‖u‖ = 1) → ( + let j : Real × Real := (-u.2, u.1) + ‖j‖ = 1) := by + classical + intro u hu j + dsimp [j] + simpa [Prod.norm_def, Real.norm_eq_abs, max_comm] using hu + +private theorem hqposballAt1653 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), (0 < r) → ( + let j : Real × Real := (-u.2, u.1) + (‖j‖ = 1) → ((0 < r / 4) → ( + let qpos : Real × Real := x + (r / 4) • j + qpos ∈ Metric.ball x r))) := by + classical + intro x r u hr j hjnorm hr4 qpos + change dist qpos x < r + rw [dist_eq_norm] + have heq : qpos - x = (r / 4) • j := by simp [qpos] + rw [heq, norm_smul, Real.norm_eq_abs, abs_of_pos hr4, hjnorm] + nlinarith only [hr] + +private theorem hqnegbAt1659 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), (0 < r) → ( + let j : Real × Real := (-u.2, u.1) + (‖j‖ = 1) → ((0 < r / 4) → ( + let qneg : Real × Real := x - (r / 4) • j + qneg ∈ Metric.ball x r))) := by + classical + intro x r u hr j hjnorm hr4 qneg + change dist qneg x < r + rw [dist_eq_norm] + have heq : qneg - x = -((r / 4) • j) := by simp [qneg, sub_eq_add_neg] + rw [heq, norm_neg, norm_smul, Real.norm_eq_abs, abs_of_pos hr4, hjnorm] + nlinarith only [hr] + +private theorem hAqposAt1665 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let j : Real × Real := (-u.2, u.1) + let qpos : Real × Real := x + (r / 4) • j + A qpos = (r / 4) * (u.1 ^ 2 + u.2 ^ 2) := by + classical + intro x r u det A j qpos + dsimp [A, qpos, j, det] + ring + +private theorem hAqnegAt1668 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let j : Real × Real := (-u.2, u.1) + let qneg : Real × Real := x - (r / 4) • j + A qneg = -(r / 4) * (u.1 ^ 2 + u.2 ^ 2) := by + classical + intro x r u det A j qneg + dsimp [A, qneg, j, det] + ring + +private theorem hqnegAAt1672 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + (0 < u.1 ^ 2 + u.2 ^ 2) → ( + let j : Real × Real := (-u.2, u.1) + (0 < r / 4) → ( + let qneg : Real × Real := x - (r / 4) • j + (A qneg = -(r / 4) * (u.1 ^ 2 + u.2 ^ 2)) → (A qneg < 0))) := by + classical + intro x r u det A hsqpos j hr4 qneg hAqneg + rw [hAqneg] + nlinarith only [mul_pos hr4 hsqpos] + +private theorem hdisAt1679 : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let P : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + let N : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + Disjoint P N := by + classical + intro x r u det A P N + apply Set.disjoint_left.mpr + intro p hp hn + have hpA : 0 < A p := hp.2 + have hnA : A p < 0 := hn.2 + exact (not_lt_of_ge (le_of_lt hpA)) hnA + +private theorem hAonU : + ∀ (x : Real × Real), ∀ (u : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + ∀ (t : Real), A (x + t • u) = 0 := by + classical + intro x u det A t + dsimp [A, det] + simp + ring + +private theorem hAonV : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + (v = -u) → ( + let A : (Real × Real) → Real := fun p => det u (p - x) + ∀ (t : Real), A (x + t • v) = 0) := by + classical + intro x u v det hvneg A t + rw [hvneg] + dsimp [A, det] + simp + ring + +private theorem hRayAzero : + ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let Rays : Set (Real × Real) := + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} + (∀ (t : Real), A (x + t • u) = 0) → ((∀ (t : Real), A (x + t • v) = 0) → (∀ (p : Real × + Real), (p ∈ Rays) → (A p = 0))) := by + classical + intro x u v det A Rays hAonU hAonV p hp + change (∃ t : Real, 0 ≤ t ∧ p = x + t • u) ∨ + (∃ t : Real, 0 ≤ t ∧ p = x + t • v) at hp + rcases hp with ⟨t, ht, rfl⟩ | ⟨t, ht, rfl⟩ + · exact hAonU t + · exact hAonV t + +private theorem hPtoE : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let P : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + (Metric.ball x r ∩ {p : ℝ × ℝ | (0 : ℝ) < (fun (p : ℝ × ℝ) => (fun (a b : ℝ × ℝ) => a.1 * b.2 + - a.2 * b.1) u (p - x)) p} ⊆ Metric.ball x r \ ({p : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ p = + x + t • u} ∪ {p : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ p = x + t • v})) → (P ⊆ E.left ∪ + E.right) := by + classical + intro x r u v E det A P hPoff p hp + exact E.cover.symm ▸ hPoff hp + +private theorem hNtoE : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let N : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + (Metric.ball x r ∩ {p : ℝ × ℝ | (fun (p : ℝ × ℝ) => (fun (a b : ℝ × ℝ) => a.1 * b.2 - a.2 * + b.1) u (p - x)) p < (0 : ℝ)} ⊆ Metric.ball x r \ ({p : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ p + = x + t • u} ∪ {p : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ p = x + t • v})) → (N ⊆ E.left ∪ + E.right) := by + classical + intro x r u v E det A N hNoff p hp + exact E.cover.symm ▸ hNoff hp + +private theorem hcomponentEq : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), ∀ (E : + P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let P : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + let N : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + (E.left ⊆ P ∧ E.right ⊆ N ∨ E.left ⊆ N ∧ E.right ⊆ P) → ((E.left ⊆ P → E.right ⊆ N → E.left = + P ∧ E.right = N) → ((E.left ⊆ N → E.right ⊆ P → E.left = N ∧ E.right = P) → ((E.left = P + ∧ E.right = N) ∨ (E.left = N ∧ E.right = P)))) := by + classical + intro x r u v E det A P N horderComponents hEqPN hEqNP + apply Or.elim horderComponents + · rintro ⟨hL, hR⟩ + exact Or.inl (hEqPN hL hR) + · rintro ⟨hL, hR⟩ + exact Or.inr (hEqNP hL hR) + +end SectorContinuationFacts + +namespace SectorContinuationCases + +private theorem nondegenerateContinuation : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), (0 < r) → ((‖u‖ + = 1) → ((‖v‖ = 1) → (∀ (E : P3889T1TwoRaySectorDecomposition x r u v), + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + (det u v ≠ 0) → (∃ e : Bool, ∀ t : Real, 0 < t → t < r → + P3934T1LocalSide E.left (x + t • u) (-u) e ∧ + P3934T1LocalSide E.left (x + t • v) v e ∧ + P3934T1LocalSide E.right (x + t • u) (-u) (!e) ∧ + P3934T1LocalSide E.right (x + t • v) v (!e))))) := by + classical + intro x r u v hr hu hv E det hnonzero + let d := det u v + have hd : d ≠ 0 := hnonzero + let a : Real × Real := if 0 < d then u else v + let b : Real × Real := if 0 < d then v else u + let d' := det a b + have hdpos := SectorContinuationFacts.hdpos u v hd + have ha : ‖a‖ = 1 := by dsimp [a]; split_ifs <;> assumption + have hb : ‖b‖ = 1 := by dsimp [b]; split_ifs <;> assumption + let A : (Real × Real) → Real := fun p => det a (p - x) + let B : (Real × Real) → Real := fun p => det (p - x) b + have hdetid (y : Real × Real) := SectorContinuationFacts.hdetid x u v y + have hrep (p : Real × Real) : + p - x = (B p / d') • a + (A p / d') • b := SectorContinuationGeometry.hrep x u v hdpos + hdetid p + let C₁ : Set (Real × Real) := + Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} + let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} + let C₂ : Set (Real × Real) := C ∪ D + have hAcont := SectorContinuationFacts.hAcontAt1316 x u v + have hBcont := SectorContinuationFacts.hBcont x u v + have hC₁open := SectorContinuationFacts.hC₁open x r u v hAcont hBcont + have hCopen := SectorContinuationFacts.hCopen x r u v hAcont + have hDopen := SectorContinuationFacts.hDopen x r u v hBcont + have hC₂open := SectorContinuationFacts.hC₂open x r u v hCopen hDopen + have hC₁conv := SectorContinuationGeometry.hC₁conv x r u v + have hCconv := SectorContinuationGeometry.hCconv x r u v + have hDconv := SectorContinuationGeometry.hDconv x r u v + have hsumNorm := SectorContinuationFacts.hsumNorm u v ha hb + have hr4 : 0 < r / 4 := by positivity + let qpos : Real × Real := x + (r / 4) • (a + b) + have hqposball := SectorContinuationFacts.hqposballAt1344 x r u v hr + hsumNorm hr4 + have hAqpos : A qpos = (r / 4) * d' := SectorContinuationFacts.hAqposAt1353 x r u v + have hBqpos : B qpos = (r / 4) * d' := SectorContinuationFacts.hBqpos x r u v + have hqposA : 0 < A qpos := by rw [hAqpos]; positivity + have hqposB : 0 < B qpos := by rw [hBqpos]; positivity + have hC₁ne : C₁.Nonempty := ⟨qpos, ⟨⟨hqposball, hqposA⟩, hqposB⟩⟩ + have hC₁conn : IsConnected C₁ := hC₁conv.isConnected hC₁ne + let qneg : Real × Real := x - (r / 4) • (a + b) + have hqnegb := SectorContinuationFacts.hqnegbAt1364 x r u v hr + hsumNorm hr4 + have hAqneg := SectorContinuationFacts.hAqnegAt1373 x r u v + have hBqneg := SectorContinuationFacts.hBqneg x r u v + have hqnegA := SectorContinuationFacts.hqnegAAt1379 x r u v hAqpos hqposA hAqneg + have hqnegB := SectorContinuationFacts.hqnegB x r u v hAqpos hqposA hBqneg + have hCne : C.Nonempty := ⟨qneg, ⟨hqnegb, hqnegA⟩⟩ + have hDne : D.Nonempty := ⟨qneg, ⟨hqnegb, hqnegB⟩⟩ + have hCDne : (C ∩ D).Nonempty := ⟨qneg, ⟨⟨hqnegb, hqnegA⟩, ⟨hqnegb, hqnegB⟩⟩⟩ + have hCconn : IsConnected C := hCconv.isConnected hCne + have hDconn : IsConnected D := hDconv.isConnected hDne + have hC₂conn := SectorContinuationFacts.hC₂conn x r u v hCDne hCconn hDconn + have horder := SectorContinuationFacts.horder u v + have haRay (k : Real) (hk : 0 ≤ k) := SectorContinuationFacts.haRay x u v horder k hk + have hbRay (k : Real) (hk : 0 ≤ k) := SectorContinuationFacts.hbRay x u v horder k hk + have hAa (t : Real) := SectorContinuationFacts.hAa x u v t + have hBa (t : Real) := SectorContinuationFacts.hBa x u v t + have hAb (t : Real) := SectorContinuationFacts.hAb x u v t + have hBb (t : Real) := SectorContinuationFacts.hBb x u v t + have hAzero (p : Real × Real) (hAp : A p = 0) := SectorContinuationFacts.hAzero x u v hrep p hAp + have hBzero (p : Real × Real) (hBp : B p = 0) := SectorContinuationFacts.hBzero x u v hrep p hBp + let Rays : Set (Real × Real) := + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} + have hRayShape (p : Real × Real) (hp : p ∈ Rays) : + (A p = 0 ∧ 0 ≤ B p) ∨ (B p = 0 ∧ 0 ≤ A p) := SectorContinuationGeometry.hRayShape x u v + hdpos horder hAa hBa hAb hBb p hp + have hEsubset := SectorContinuationGeometry.hEsubsetAt411 x r + u v E hdpos haRay hbRay hAzero hBzero + have hdis := SectorContinuationGeometry.hdisAt436 x r u v + have classify (S : Set (Real × Real)) (hS : IsConnected S) + (hsub : S ⊆ C₁ ∪ C₂) : S ⊆ C₁ ∨ S ⊆ C₂ := SectorContinuationGeometry.classify x r u v + hC₁open hC₂open hdis S hS hsub + have hC₁off := SectorContinuationFacts.hC₁off x r u v hRayShape + have hC₂off := SectorContinuationGeometry.hC₂off x r u v + hRayShape + have hqposE := SectorContinuationFacts.hqposEAt1461 x r u v E + hqposball hqposA hqposB hC₁off + have hqnegE := SectorContinuationFacts.hqnegEAt1464 x r u v E + hqnegb hqnegA hC₂off + have hqposC₁ : qpos ∈ C₁ := ⟨⟨hqposball, hqposA⟩, hqposB⟩ + have hqnegC₂ : qneg ∈ C₂ := Or.inl ⟨hqnegb, hqnegA⟩ + have hleftCases := classify E.left E.left_connected + (fun p hp => hEsubset (Or.inl hp)) + have hrightCases := classify E.right E.right_connected + (fun p hp => hEsubset (Or.inr hp)) + have horderComponents : + (E.left ⊆ C₁ ∧ E.right ⊆ C₂) ∨ (E.left ⊆ C₂ ∧ E.right ⊆ C₁) := + SectorContinuationGeometry.horderComponentsAt496 x r u v E hdis hqposE hqnegE hqposC₁ + hqnegC₂ hleftCases hrightCases + have hcomponentEq : + (E.left = C₁ ∧ E.right = C₂) ∨ (E.left = C₂ ∧ E.right = C₁) := + SectorContinuationGeometry.hcomponentEqAt509 x r u v E hdis hC₁off hC₂off horderComponents + have sampleA (t δ : Real) (ht : 0 < t) (hδ : 0 < δ) + (hball : Metric.ball (x + t • a) δ ⊆ Metric.ball x r) : + ∃ qpos' qneg', qpos' ∈ Metric.ball (x + t • a) δ ∧ + qneg' ∈ Metric.ball (x + t • a) δ ∧ qpos' ∈ C₁ ∧ qneg' ∈ C₂ ∧ + 0 < det a (qpos' - (x + t • a)) ∧ + det a (qneg' - (x + t • a)) < 0 := SectorContinuationGeometry.sampleA x r u v hdpos ha + hBcont hBa t δ ht hδ hball + have sampleB (t δ : Real) (ht : 0 < t) (hδ : 0 < δ) + (hball : Metric.ball (x + t • b) δ ⊆ Metric.ball x r) : + ∃ qpos' qneg', qpos' ∈ Metric.ball (x + t • b) δ ∧ + qneg' ∈ Metric.ball (x + t • b) δ ∧ qpos' ∈ C₂ ∧ qneg' ∈ C₁ ∧ + 0 < det b (qpos' - (x + t • b)) ∧ + det b (qneg' - (x + t • b)) < 0 := SectorContinuationGeometry.sampleB x r u v hdpos hb + hAcont hAb t δ ht hδ hball + have haRayEq := SectorContinuationFacts.haRayEq u v horder + have hbRayEq := SectorContinuationFacts.hbRayEq u v horder + have aLocalC₁ (t : Real) (ht : 0 < t) (htr : t < r) + (hL : E.left = C₁) : + P3934T1LocalSide E.left (x + t • a) a true ∧ + P3934T1LocalSide E.right (x + t • a) a false := SectorContinuationGeometry.aLocalC₁ x r + u v E sampleA haRayEq t ht htr hL + have aLocalC₂ (t : Real) (ht : 0 < t) (htr : t < r) + (hL : E.left = C₂) : + P3934T1LocalSide E.left (x + t • a) a false ∧ + P3934T1LocalSide E.right (x + t • a) a true := SectorContinuationGeometry.aLocalC₂ x r + u v E sampleA haRayEq t ht htr hL + have bLocalC₁ (t : Real) (ht : 0 < t) (htr : t < r) + (hL : E.left = C₁) : + P3934T1LocalSide E.left (x + t • b) b false ∧ + P3934T1LocalSide E.right (x + t • b) b true := SectorContinuationGeometry.bLocalC₁ x r + u v E sampleB hbRayEq t ht htr hL + have bLocalC₂ (t : Real) (ht : 0 < t) (htr : t < r) + (hL : E.left = C₂) : + P3934T1LocalSide E.left (x + t • b) b true ∧ + P3934T1LocalSide E.right (x + t • b) b false := SectorContinuationGeometry.bLocalC₂ x r + u v E sampleB hbRayEq t ht htr hL + have flipSide (U : Set (Real × Real)) (z w : Real × Real) (e : Bool) + (h : P3934T1LocalSide U z w e) : + P3934T1LocalSide U z (-w) (!e) := SectorContinuationGeometry.flipSide U z w e h + rcases hcomponentEq with ⟨hL, hR⟩ | ⟨hL, hR⟩ + · by_cases hpos : 0 < d + · have haEq : a = u := by simp [a, hpos] + have hbEq : b = v := by simp [b, hpos] + refine ⟨false, ?_⟩ + intro t ht htr + have ⟨hLa, hRa⟩ := aLocalC₁ t ht htr hL + have ⟨hLb, hRb⟩ := bLocalC₁ t ht htr hL + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa [haEq] using flipSide E.left (x + t • a) a true hLa + · simpa [hbEq] using hLb + · simpa [haEq] using flipSide E.right (x + t • a) a false hRa + · simpa [hbEq] using hRb + · have hneg : d < 0 := lt_of_le_of_ne (le_of_not_gt hpos) hd + have haEq : a = v := by simp [a, hpos] + have hbEq : b = u := by simp [b, hpos] + refine ⟨true, ?_⟩ + intro t ht htr + have ⟨hLa, hRa⟩ := aLocalC₁ t ht htr hL + have ⟨hLb, hRb⟩ := bLocalC₁ t ht htr hL + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa [hbEq] using flipSide E.left (x + t • b) b false hLb + · simpa [haEq] using hLa + · simpa [hbEq] using flipSide E.right (x + t • b) b true hRb + · simpa [haEq] using hRa + · by_cases hpos : 0 < d + · have haEq : a = u := by simp [a, hpos] + have hbEq : b = v := by simp [b, hpos] + refine ⟨true, ?_⟩ + intro t ht htr + have ⟨hLa, hRa⟩ := aLocalC₂ t ht htr hL + have ⟨hLb, hRb⟩ := bLocalC₂ t ht htr hL + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa [haEq] using flipSide E.left (x + t • a) a false hLa + · simpa [hbEq] using hLb + · simpa [haEq] using flipSide E.right (x + t • a) a true hRa + · simpa [hbEq] using hRb + · have hneg : d < 0 := lt_of_le_of_ne (le_of_not_gt hpos) hd + have haEq : a = v := by simp [a, hpos] + have hbEq : b = u := by simp [b, hpos] + refine ⟨false, ?_⟩ + intro t ht htr + have ⟨hLa, hRa⟩ := aLocalC₂ t ht htr hL + have ⟨hLb, hRb⟩ := bLocalC₂ t ht htr hL + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa [hbEq] using flipSide E.left (x + t • b) b true hLb + · simpa [haEq] using hLa + · simpa [hbEq] using flipSide E.right (x + t • b) b false hRb + · simpa [haEq] using hRa + +private theorem oppositeContinuation : + ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), (0 < r) → ((‖u‖ + = 1) → ((‖v‖ = 1) → ((u ≠ v) → (∀ (E : P3889T1TwoRaySectorDecomposition x r u v), + (u ≠ ((0 : ℝ), (0 : ℝ))) → ((u.1 ≠ (0 : ℝ) ∨ u.2 ≠ (0 : ℝ)) → ((v = -u) → (∃ e : Bool, ∀ t : + Real, 0 < t → t < r → + P3934T1LocalSide E.left (x + t • u) (-u) e ∧ + P3934T1LocalSide E.left (x + t • v) v e ∧ + P3934T1LocalSide E.right (x + t • u) (-u) (!e) ∧ + P3934T1LocalSide E.right (x + t • v) v (!e)))))))) := by + classical + intro x r u v hr hu hv huv E hu_ne hcoord hvneg + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + let A : (Real × Real) → Real := fun p => det u (p - x) + let P : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} + let N : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} + have hform (w : Real × Real) (hw : w = u ∨ w = v) + (t : Real) (q : Real × Real) : + -u.1 * (q.2 - (x.2 + t * w.2)) - + -u.2 * (q.1 - (x.1 + t * w.1)) = -A q := SectorContinuationGeometry.hform x r u v hu huv + E hu_ne hcoord hvneg w hw t q + have hdist (w : Real × Real) (hw : ‖w‖ = 1) (t : Real) + (ht : 0 < t) := SectorContinuationFacts.hdist x w hw t ht + have hdelta (t : Real) (htr : t < r) : 0 < r - t := by + exact sub_pos.mpr htr + have hball (w : Real × Real) (hw : ‖w‖ = 1) (t : Real) + (ht : 0 < t) (htr : t < r) := SectorContinuationFacts.hball x r + hdist w hw t ht htr + have hlocalP (w : Real × Real) (hw : w = u ∨ w = v) + (hwNorm : ‖w‖ = 1) (t : Real) (ht : 0 < t) (htr : t < r) : + P3934T1LocalSide P (x + t • w) (-u) false := SectorContinuationGeometry.hlocalP x r u v + hform hdelta hball w hw hwNorm t ht htr + have hlocalN (w : Real × Real) (hw : w = u ∨ w = v) + (hwNorm : ‖w‖ = 1) (t : Real) (ht : 0 < t) (htr : t < r) : + P3934T1LocalSide N (x + t • w) (-u) true := SectorContinuationGeometry.hlocalN x r u v + hform hdelta hball w hw hwNorm t ht htr + have hAcont := SectorContinuationFacts.hAcontAt1604 x u + have hPopen := SectorContinuationFacts.hPopen x r u hAcont + have hNopen := SectorContinuationFacts.hNopen x r u hAcont + let f : (Real × Real) →ᵃ[Real] Real := { + toFun := A + linear := { + toFun := fun y => det u y + map_add' := by + intro y z + dsimp [det] + ring + map_smul' := by + intro c y + dsimp [det] + ring + } + map_vadd' := by + intro p y + dsimp [A, det] + ring + } + have hPconv := SectorContinuationFacts.hPconv x r u + have hNconv := SectorContinuationFacts.hNconv x r u + have hu0 : u ≠ (0, 0) := hu_ne + have hsqpos := SectorContinuationFacts.hsqpos u hu0 + let j : Real × Real := (-u.2, u.1) + have hjnorm := SectorContinuationFacts.hjnorm u hu + have hr4 : 0 < r / 4 := by positivity + let qpos : Real × Real := x + (r / 4) • j + let qneg : Real × Real := x - (r / 4) • j + have hqposball := SectorContinuationFacts.hqposballAt1653 x r u hr + hjnorm hr4 + have hqnegb := SectorContinuationFacts.hqnegbAt1659 x r u hr hjnorm hr4 + have hAqpos : A qpos = (r / 4) * (u.1 ^ 2 + u.2 ^ 2) := SectorContinuationFacts.hAqposAt1665 + x r u + have hAqneg := SectorContinuationFacts.hAqnegAt1668 + x r u + have hqposA : 0 < A qpos := by rw [hAqpos]; exact mul_pos hr4 hsqpos + have hqnegA := SectorContinuationFacts.hqnegAAt1672 x r u hsqpos hr4 hAqneg + have hPne : P.Nonempty := ⟨qpos, hqposball, hqposA⟩ + have hNne : N.Nonempty := ⟨qneg, hqnegb, hqnegA⟩ + have hPconn : IsConnected P := hPconv.isConnected hPne + have hNconn : IsConnected N := hNconv.isConnected hNne + have hdis := SectorContinuationFacts.hdisAt1679 x r u + let Rays : Set (Real × Real) := + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v} + have hcol (y : Real × Real) (hy : det u y = 0) : + ∃ k : Real, y = k • u := SectorContinuationGeometry.hcol u hcoord y hy + have hzeroRay (p : Real × Real) (hp : A p = 0) := SectorContinuationGeometry.hzeroRay x u v + hvneg hcol p hp + have hAonU (t : Real) := SectorContinuationFacts.hAonU x u t + have hAonV (t : Real) := SectorContinuationFacts.hAonV x u v hvneg t + have hRayAzero (p : Real × Real) (hp : p ∈ Rays) := SectorContinuationFacts.hRayAzero x u v + hAonU hAonV p hp + have hPoff := SectorContinuationGeometry.hPoff x r u v hRayAzero + have hNoff := SectorContinuationGeometry.hNoff x r u v hRayAzero + have hEsubset := SectorContinuationGeometry.hEsubsetAt1063 x r u + v E hzeroRay + have hPtoE := SectorContinuationFacts.hPtoE x r u v E hPoff + have hNtoE := SectorContinuationFacts.hNtoE x r u v E hNoff + have hqposE : qpos ∈ E.left ∪ E.right := by + exact hPtoE ⟨hqposball, hqposA⟩ + have hqnegE : qneg ∈ E.left ∪ E.right := by + exact hNtoE ⟨hqnegb, hqnegA⟩ + have hqposP : qpos ∈ P := ⟨hqposball, hqposA⟩ + have hqnegN : qneg ∈ N := ⟨hqnegb, hqnegA⟩ + have horderComponents : + (E.left ⊆ P ∧ E.right ⊆ N) ∨ (E.left ⊆ N ∧ E.right ⊆ P) := + SectorContinuationGeometry.horderComponentsAt1092 x r u v E hPopen hNopen hdis hEsubset + hqposE hqnegE hqposP hqnegN + have hEqPN (hL : E.left ⊆ P) (hR : E.right ⊆ N) : + E.left = P ∧ E.right = N := SectorContinuationGeometry.hEqPN x r u v E hdis hPoff hNoff hL hR + have hEqNP (hL : E.left ⊆ N) (hR : E.right ⊆ P) : + E.left = N ∧ E.right = P := SectorContinuationGeometry.hEqNP x r u v E hdis hPoff hNoff hL hR + have hcomponentEq := SectorContinuationFacts.hcomponentEq x r u v E horderComponents hEqPN hEqNP + rcases hcomponentEq with ⟨hL, hR⟩ | ⟨hL, hR⟩ + · refine ⟨false, ?_⟩ + intro t ht htr + have huSide := hlocalP u (Or.inl rfl) hu t ht htr + have hvSide := hlocalP v (Or.inr rfl) hv t ht htr + have huSideN := hlocalN u (Or.inl rfl) hu t ht htr + have hvSideN := hlocalN v (Or.inr rfl) hv t ht htr + refine ⟨?_, ?_, ?_, ?_⟩ + · rw [hL] + exact huSide + · rw [hL] + rw [← hvneg] at hvSide + exact hvSide + · rw [hR] + exact huSideN + · rw [hR] + rw [← hvneg] at hvSideN + exact hvSideN + · refine ⟨true, ?_⟩ + intro t ht htr + have huSide := hlocalN u (Or.inl rfl) hu t ht htr + have hvSide := hlocalN v (Or.inr rfl) hv t ht htr + have huSideP := hlocalP u (Or.inl rfl) hu t ht htr + have hvSideP := hlocalP v (Or.inr rfl) hv t ht htr + refine ⟨?_, ?_, ?_, ?_⟩ + · rw [hL] + exact huSide + · rw [hL] + rw [← hvneg] at hvSide + exact hvSide + · rw [hR] + exact huSideP + · rw [hR] + rw [← hvneg] at hvSideP + exact hvSideP + +end SectorContinuationCases + +theorem P3934T1SectorContinuation (x : Real × Real) (r : Real) + (u v : Real × Real) (hr : 0 < r) (hu : ‖u‖ = 1) (hv : ‖v‖ = 1) + (huv : u ≠ v) (E : P3889T1TwoRaySectorDecomposition x r u v) : + ∃ e : Bool, ∀ t : Real, 0 < t → t < r → + P3934T1LocalSide E.left (x + t • u) (-u) e ∧ + P3934T1LocalSide E.left (x + t • v) v e ∧ + P3934T1LocalSide E.right (x + t • u) (-u) (!e) ∧ + P3934T1LocalSide E.right (x + t • v) v (!e) := by +-- BODY + let det : (Real × Real) → (Real × Real) → Real := + fun a b => a.1 * b.2 - a.2 * b.1 + have hu_ne := SectorContinuationFacts.hu_ne u hu + have hcoord := SectorContinuationFacts.hcoord u hu_ne + have hdet_cases := SectorContinuationGeometry.hdet_cases u v hu hv huv + hcoord + have nondegenerateContinuation (hnonzero : det u v ≠ 0) : + ∃ e : Bool, ∀ t : Real, 0 < t → t < r → + P3934T1LocalSide E.left (x + t • u) (-u) e ∧ + P3934T1LocalSide E.left (x + t • v) v e ∧ + P3934T1LocalSide E.right (x + t • u) (-u) (!e) ∧ + P3934T1LocalSide E.right (x + t • v) v (!e) := + SectorContinuationCases.nondegenerateContinuation x r u v hr hu hv E hnonzero + have oppositeContinuation (hvneg : v = -u) : + ∃ e : Bool, ∀ t : Real, 0 < t → t < r → + P3934T1LocalSide E.left (x + t • u) (-u) e ∧ + P3934T1LocalSide E.left (x + t • v) v e ∧ + P3934T1LocalSide E.right (x + t • u) (-u) (!e) ∧ + P3934T1LocalSide E.right (x + t • v) v (!e) := + SectorContinuationCases.oppositeContinuation x r u v hr hu hv huv E hu_ne hcoord hvneg + exact hdet_cases.elim nondegenerateContinuation oppositeContinuation + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1SectorSelection.lean b/LeanPool/ApollonianSuperharmonic/P3934T1SectorSelection.lean new file mode 100644 index 0000000000..61406e3207 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3934T1SectorSelection.lean @@ -0,0 +1,123 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectorDecomposition +public import Mathlib.Topology.MetricSpace.Pseudo.Defs + +-- [TABLET NODE: P3934T1SectorSelection] + +/-! +# P3934T1SectorSelection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3934T1SectorSelection (U : Set (Real × Real)) + (x : Real × Real) (r : Real) (u v : Real × Real) + (E : P3889T1TwoRaySectorDecomposition x r u v) + (hr : 0 < r) (hU : IsOpen U) + (hx : x ∈ frontier U) (hV : frontier (closure U)ᶜ = frontier U) + (hchart : frontier U ∩ Metric.ball x r = + ({p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ + {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • v}) ∩ Metric.ball x r) : + (U ∩ Metric.ball x r = E.left ∧ (closure U)ᶜ ∩ Metric.ball x r = E.right) ∨ + (U ∩ Metric.ball x r = E.right ∧ (closure U)ᶜ ∩ Metric.ball x r = E.left) := by +-- BODY + let V := (closure U)ᶜ + let B := Metric.ball x r + have hUV : Disjoint U V := Set.disjoint_left.mpr (fun _ hu hv => hv (subset_closure hu)) + have partition : (frontier U)ᶜ = U ∪ V := by + ext q + rw [frontier, hU.interior_eq] + simp only [Set.mem_compl_iff, Set.mem_sdiff, Set.mem_union, V] + constructor + · intro h + by_cases hq : q ∈ U + · exact Or.inl hq + · exact Or.inr (fun hc => h ⟨hc, hq⟩) + · rintro (hu | hv) ⟨hc, hn⟩ + · exact hn hu + · exact hv hc + have cover : E.left ∪ E.right = (U ∪ V) ∩ B := by + rw [← partition, E.cover] + ext q + constructor + · rintro ⟨hb, hn⟩ + refine ⟨?_, hb⟩ + intro hf + have hm : q ∈ frontier U ∩ Metric.ball x r := ⟨hf, hb⟩ + rw [hchart] at hm + exact hn hm.1 + · rintro ⟨hf, hb⟩ + refine ⟨hb, ?_⟩ + intro hn + have hm : q ∈ frontier U ∩ Metric.ball x r := by + rw [hchart] + exact ⟨hn, hb⟩ + exact hf hm.1 + have classify (C : Set (Real × Real)) (hC : IsConnected C) + (hsub : C ⊆ E.left ∪ E.right) : C ⊆ U ∨ C ⊆ V := by + have hs : C ⊆ U ∪ V := by + intro q hq + have hm := hsub hq + rw [cover] at hm + exact hm.1 + by_cases hm : (C ∩ U).Nonempty + · exact Or.inl (hC.isPreconnected.subset_left_of_subset_union hU + isClosed_closure.isOpen_compl hUV hs hm) + · right + intro q hq + rcases hs hq with hu | hv + · exact (hm ⟨q, hq, hu⟩).elim + · exact hv + have meet (W : Set (Real × Real)) (hw : x ∈ closure W) : (W ∩ B).Nonempty := by + obtain ⟨q, hq, hd⟩ := Metric.mem_closure_iff.mp hw r hr + exact ⟨q, hq, by simpa only [B, Metric.mem_ball, dist_comm] using hd⟩ + have hUm := meet U (frontier_subset_closure hx) + have hVm := meet V (frontier_subset_closure (hV.symm ▸ hx)) + have equations (C D : Set (Real × Real)) + (hc : C ∪ D = (U ∪ V) ∩ B) (hCU : C ⊆ U) (hDV : D ⊆ V) : + U ∩ B = C ∧ V ∩ B = D := by + constructor + · apply Set.Subset.antisymm + · intro q hq + have hm : q ∈ C ∪ D := hc.symm ▸ ⟨Or.inl hq.1, hq.2⟩ + rcases hm with hC | hD + · exact hC + · exact (Set.disjoint_left.mp hUV hq.1 (hDV hD)).elim + · intro q hq + have hm : q ∈ (U ∪ V) ∩ B := hc ▸ (Or.inl hq : q ∈ C ∪ D) + exact ⟨hCU hq, hm.2⟩ + · apply Set.Subset.antisymm + · intro q hq + have hm : q ∈ C ∪ D := hc.symm ▸ ⟨Or.inr hq.1, hq.2⟩ + rcases hm with hC | hD + · exact (Set.disjoint_left.mp hUV (hCU hC) hq.1).elim + · exact hD + · intro q hq + have hm : q ∈ (U ∪ V) ∩ B := hc ▸ (Or.inr hq : q ∈ C ∪ D) + exact ⟨hDV hq, hm.2⟩ + rcases classify E.left E.left_connected Set.subset_union_left with hLU | hLV + · rcases classify E.right E.right_connected Set.subset_union_right with hRU | hRV + · obtain ⟨q, hqV, hqB⟩ := hVm + have hm : q ∈ E.left ∪ E.right := cover.symm ▸ ⟨Or.inr hqV, hqB⟩ + exact (Set.disjoint_left.mp hUV (hm.elim (fun h => hLU h) (fun h => hRU h)) hqV).elim + · exact Or.inl (equations E.left E.right cover hLU hRV) + · rcases classify E.right E.right_connected Set.subset_union_right with hRU | hRV + · exact Or.inr (equations E.right E.left (by rw [Set.union_comm, cover]) hRU hLV) + · obtain ⟨q, hqU, hqB⟩ := hUm + have hm : q ∈ E.left ∪ E.right := cover.symm ▸ ⟨Or.inl hqU, hqB⟩ + exact (Set.disjoint_left.mp hUV hqU (hm.elim (fun h => hLV h) (fun h => hRV h))).elim + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1DeletedPairExteriorConnected.lean b/LeanPool/ApollonianSuperharmonic/P3963T1DeletedPairExteriorConnected.lean new file mode 100644 index 0000000000..2ade4b1ecf --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3963T1DeletedPairExteriorConnected.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.P3350T1GraphCellUnionConnected + +-- [TABLET NODE: P3963T1DeletedPairExteriorConnected] + +/-! +# P3963T1DeletedPairExteriorConnected + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3963T1DeletedPairExteriorConnected {ι : Type} + (P : PeriodicTileComplex ι) (a b : ι) : + FourNeighborConnected + ((↑((P.tile a).cells ∪ (P.tile b).cells) : Set LatticeCell)ᶜ) := by +-- BODY + classical + have hindexed := PeriodicTileIndexedMultiplicityOne P + let D : Finset ι := {a, b} + have hcard : D.card < 3 := by + have h := Finset.card_insert_le a ({b} : Finset ι) + simp only [Finset.card_singleton] at h + dsimp [D] + omega + have hunion : {x : LatticeCell | ∃ c ∈ (D : Set ι)ᶜ, + x ∈ (P.tile c).cells} = + ((↑((P.tile a).cells ∪ (P.tile b).cells) : Set LatticeCell)ᶜ) := by + ext x + constructor + · rintro ⟨c, hc, hxc⟩ hx + have hcab : c ≠ a ∧ c ≠ b := by simpa [D] using hc + simp only [Finset.mem_coe, Finset.mem_union] at hx + rcases hx with hxa | hxb + · exact hcab.1 ((hindexed x).unique hxc hxa) + · exact hcab.2 ((hindexed x).unique hxc hxb) + · intro hx + obtain ⟨c, hxc, _⟩ := hindexed x + refine ⟨c, ?_, hxc⟩ + have hca : c ≠ a := by + intro heq + exact hx (by simp [← heq, hxc]) + have hcb : c ≠ b := by + intro heq + exact hx (by simp [← heq, hxc]) + simpa [D] using And.intro hca hcb + have hnonempty : ((D : Set ι)ᶜ).Nonempty := by + let : Infinite LatticeCell := by + apply Infinite.of_injective (fun n : Nat => (n : GaussianInt)) + intro m n h + have hh := congrArg Zsqrtd.re h + norm_num at hh ⊢ + omega + obtain ⟨x, hx⟩ := ((P.tile a).cells ∪ (P.tile b).cells).exists_notMem + have hx' : x ∈ ((↑((P.tile a).cells ∪ (P.tile b).cells) : + Set LatticeCell)ᶜ) := hx + rw [← hunion] at hx' + obtain ⟨c, hc, _⟩ := hx' + exact ⟨c, hc⟩ + rw [← hunion] + exact P3350T1GraphCellUnionConnected P.plane.adjacent + P.plane.adjacent_irreflexive P.tile (D : Set ι)ᶜ hnonempty + (fun c _ => (LatticeTileGridStructure _ (P.tiles_are_disks c)).1) + (by + intro c _ d _ hcd + exact Finset.disjoint_left.mpr + (fun x hxc hxd => hcd ((hindexed x).unique hxc hxd))) + (fun c _ d _ _ hcd => P.adjacent_has_common_edge c d hcd) + (P.plane.three_connected D hcard) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1EdgeFreeDiskCorners.lean b/LeanPool/ApollonianSuperharmonic/P3963T1EdgeFreeDiskCorners.lean new file mode 100644 index 0000000000..efa19cc8e3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3963T1EdgeFreeDiskCorners.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.P3963T1ExteriorMixedCycleObstruction +public import LeanPool.ApollonianSuperharmonic.P3963T1MixedBoundaryCycle + +-- [TABLET NODE: P3963T1EdgeFreeDiskCorners] + +/-! +# P3963T1EdgeFreeDiskCorners + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3963T1EdgeFreeDiskCorners (U V : ProtoTile) + (hU : LatticeTile U) (hV : LatticeTile V) + (hdisjoint : Disjoint U.cells V.cells) + (hedge : ¬ (FootprintEdges U ∩ FootprintEdges V).Nonempty) + (houtside : FourNeighborConnected + ((↑(U.cells ∪ V.cells) : Set LatticeCell)ᶜ)) : + (FootprintVertices U ∩ FootprintVertices V).Subsingleton := by +-- BODY + classical + have hgU := LatticeTileGridStructure U hU + have hgV := LatticeTileGridStructure V hV + have rawIncident (T : ProtoTile) (hne : T.cells.Nonempty) + (x : GaussianInt) (hx : x ∈ FootprintVertices T) : + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells := by + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hx + obtain ⟨c, hc, h | h | h | h⟩ := hx + · exact ⟨0, by simpa [LatticeVertexIncidentCell, h] using hc⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell, h] using hc⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell, h] using hc⟩ + · exact ⟨2, by simpa [LatticeVertexIncidentCell, h, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] using hc⟩ + have hrawBoundary : FootprintVertices U ∩ FootprintVertices V ⊆ + BoundaryFootprintVertices U ∩ BoundaryFootprintVertices V := by + rintro x ⟨hxU, hxV⟩ + obtain ⟨jU, hjU⟩ := rawIncident U hgU.1.1 x hxU + obtain ⟨jV, hjV⟩ := rawIncident V hgV.1.1 x hxV + exact ⟨P3161T2IncidentBoundary U x ⟨jU, hjU⟩ + ⟨jV, fun h => Finset.disjoint_left.mp hdisjoint h hjV⟩, + P3161T2IncidentBoundary V x ⟨jV, hjV⟩ + ⟨jU, fun h => Finset.disjoint_left.mp hdisjoint hjU h⟩⟩ + have boundaryFootprint (T : ProtoTile) : + BoundaryFootprintEdges T ⊆ FootprintEdges T := by + rintro e ⟨z, ⟨rfl, hz⟩ | ⟨rfl, hz⟩⟩ + · rcases hz with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [Zsqrtd.ext_iff] + · rcases hz with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + have hboundaryDisjoint : + Disjoint (BoundaryFootprintEdges U) (BoundaryFootprintEdges V) := by + apply Set.disjoint_left.mpr + intro e heU heV + exact hedge ⟨e, boundaryFootprint U heU, boundaryFootprint V heV⟩ + by_contra hmultiple + have hboundaryMultiple : + ¬ (BoundaryFootprintVertices U ∩ BoundaryFootprintVertices V).Subsingleton := by + intro h + apply hmultiple + intro x hx y hy + exact h (hrawBoundary hx) (hrawBoundary hy) + obtain ⟨W, F, x, e, f, hcycle, hsubset, hxe, hxf, he, hf⟩ := + P3963T1MixedBoundaryCycle _ _ _ _ hgU.2.2 hgV.2.2 + hboundaryDisjoint hboundaryMultiple + apply P3963T1ExteriorMixedCycleObstruction U V hdisjoint hedge houtside + W F hcycle _ x e f hxe hxf + ⟨he.1, boundaryFootprint U he.2⟩ ⟨hf.1, boundaryFootprint V hf.2⟩ + intro g hg + rcases hsubset hg with hgU | hgV + · exact Or.inl (boundaryFootprint U hgU) + · exact Or.inr (boundaryFootprint V hgV) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean new file mode 100644 index 0000000000..c337a605ca --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean @@ -0,0 +1,2247 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycleSubgraphDegreeTwo + +-- [TABLET NODE: P3963T1ExteriorMixedCycleObstruction] + +/-! +# P3963T1ExteriorMixedCycleObstruction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ExteriorMixedCycleProof + +private theorem hadj : + ∀ (p : List GaussianInt), ((4 : ℕ) ≤ p.length) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), + ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ → + FourNeighborAdjacent a b) → (∀ a, ∀ b, (a, b) ∈ p.zip p.tail → FourNeighborAdjacent a b)) + := by + classical + intro p hlen hsteps a b hab + rw [List.mem_iff_getElem] at hab + rcases hab with ⟨i, hi, hab⟩ + have hi' : i < p.tail.length := by simpa [List.length_zip] using hi + have hip : i + 1 < p.length := by + simp only [List.length_tail] at hi' + omega + rw [List.getElem_zip, List.getElem_tail] at hab + injection hab with ha hb + have hdecomp : p = p.take i ++ p[i] :: p[i + 1] :: p.drop (i + 2) := by + calc + p = p.take i ++ p.drop i := (List.take_append_drop i p).symm + _ = p.take i ++ p[i] :: p.drop (i + 1) := by + rw [List.drop_eq_getElem_cons (by omega)] + _ = p.take i ++ p[i] :: p[i + 1] :: p.drop (i + 2) := by + rw [List.drop_eq_getElem_cons hip] + have hs := hsteps (p[i]) (p[i + 1]) (p.take i) (p.drop (i + 2)) hdecomp + simpa [ha, hb] using hs + +private theorem incident : + ∀ (x : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + ∀ (T : ProtoTile), ∀ (g : Finset GaussianInt), x ∈ g → g ∈ FootprintEdges T → ∃ q ∈ T.cells, + q = c0 ∨ q = c1 ∨ q = c2 ∨ q = c3 := by + classical + intro x c0 c1 c2 c3 T g hxg hg + simp only [FootprintEdges, Set.mem_ofPred_eq] at hg + rcases hg with ⟨z, hz, hshape⟩ + rcases hshape with hshape | hshape | hshape | hshape + · have hxg' : x = z ∨ x = z + 1 := by simpa [hshape] using hxg + rcases hxg' with h | h + · subst z + exact ⟨x, hz, Or.inl (by simp [c0])⟩ + · have hzEq : z = x - 1 := by + calc + z = (z + 1) - 1 := by ring + _ = x - 1 := by rw [← h] + rw [hzEq] at hz + exact ⟨x - 1, hz, Or.inr (Or.inl (by simp [c1]))⟩ + · have hxg' : x = z ∨ x = z + ⟨0, 1⟩ := by simpa [hshape] using hxg + rcases hxg' with h | h + · subst z + exact ⟨x, hz, Or.inl (by simp [c0])⟩ + · have hzEq : z = x - ⟨0, 1⟩ := by + calc + z = (z + ⟨0, 1⟩) - ⟨0, 1⟩ := by ring + _ = x - ⟨0, 1⟩ := by rw [← h] + rw [hzEq] at hz + exact ⟨x - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr (by simp [c3])))⟩ + · have hxg' : x = z + 1 ∨ x = z + 1 + ⟨0, 1⟩ := by simpa [hshape] using hxg + rcases hxg' with h | h + · have hzEq : z = x - 1 := by + calc + z = (z + 1) - 1 := by ring + _ = x - 1 := by rw [← h] + rw [hzEq] at hz + exact ⟨x - 1, hz, Or.inr (Or.inl (by simp [c1]))⟩ + · have hzEq : z = x - 1 - ⟨0, 1⟩ := by + calc + z = (z + 1 + ⟨0, 1⟩) - 1 - ⟨0, 1⟩ := by ring + _ = x - 1 - ⟨0, 1⟩ := by rw [← h] + rw [hzEq] at hz + exact ⟨x - 1 - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inl (by simp [c2])))⟩ + · have hxg' : x = z + ⟨0, 1⟩ ∨ x = z + 1 + ⟨0, 1⟩ := by simpa [hshape] using hxg + rcases hxg' with h | h + · have hzEq : z = x - ⟨0, 1⟩ := by + calc + z = (z + ⟨0, 1⟩) - ⟨0, 1⟩ := by ring + _ = x - ⟨0, 1⟩ := by rw [← h] + rw [hzEq] at hz + exact ⟨x - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr (by simp [c3])))⟩ + · have hzEq : z = x - 1 - ⟨0, 1⟩ := by + calc + z = (z + 1 + ⟨0, 1⟩) - 1 - ⟨0, 1⟩ := by ring + _ = x - 1 - ⟨0, 1⟩ := by rw [← h] + rw [hzEq] at hz + exact ⟨x - 1 - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inl (by simp [c2])))⟩ + +private theorem hpattern : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (∃ q ∈ U.cells, q = c0 ∨ q = c1 ∨ q = c2 ∨ q = c3) → ((∃ q ∈ V.cells, q = c0 ∨ q = c1 ∨ q = + c2 ∨ q = c3) → ((¬ (c0 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ c0 ∈ V.cells)) → + ((¬ (c1 ∈ U.cells ∧ c2 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c2 ∈ + U.cells ∧ c3 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ c2 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ c0 ∈ + V.cells)) → ((¬ (c0 ∈ U.cells ∧ c3 ∈ V.cells)) → ((¬ (c0 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ + (c1 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c2 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ + c3 ∈ V.cells)) → ((c0 ∈ U.cells ∧ c2 ∈ V.cells) ∨ (c2 ∈ U.cells ∧ c0 ∈ V.cells) ∨ (c1 ∈ + U.cells ∧ c3 ∈ V.cells) ∨ (c3 ∈ U.cells ∧ c1 ∈ V.cells))))))))))))))) := by + classical + intro U V x c0 c1 c2 c3 hOccU hOccV no01 no10 no12 no21 no23 no32 no30 no03 noSame0 noSame1 + noSame2 noSame3 + obtain ⟨a, haU, haCase⟩ := hOccU + obtain ⟨b, hbV, hbCase⟩ := hOccV + rcases haCase with ha0 | ha1 | ha2 | ha3 <;> + rcases hbCase with hb0 | hb1 | hb2 | hb3 + all_goals + subst a + subst b + first + | exact False.elim (noSame0 ⟨haU, hbV⟩) + | exact False.elim (noSame1 ⟨haU, hbV⟩) + | exact False.elim (noSame2 ⟨haU, hbV⟩) + | exact False.elim (noSame3 ⟨haU, hbV⟩) + | exact False.elim (no01 ⟨haU, hbV⟩) + | exact False.elim (no10 ⟨haU, hbV⟩) + | exact False.elim (no12 ⟨haU, hbV⟩) + | exact False.elim (no21 ⟨haU, hbV⟩) + | exact False.elim (no23 ⟨haU, hbV⟩) + | exact False.elim (no32 ⟨haU, hbV⟩) + | exact False.elim (no30 ⟨haU, hbV⟩) + | exact False.elim (no03 ⟨haU, hbV⟩) + | exact Or.inl ⟨haU, hbV⟩ + | exact Or.inr (Or.inl ⟨haU, hbV⟩) + | exact Or.inr (Or.inr (Or.inl ⟨haU, hbV⟩)) + | exact Or.inr (Or.inr (Or.inr ⟨haU, hbV⟩)) + +private theorem hExteriorPair : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (¬ (c0 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ + c2 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c3 ∈ V.cells)) + → ((¬ (c3 ∈ U.cells ∧ c2 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c0 ∈ + U.cells ∧ c3 ∈ V.cells)) → (((c0 ∈ U.cells ∧ c2 ∈ V.cells) ∨ (c2 ∈ U.cells ∧ c0 ∈ + V.cells) ∨ (c1 ∈ U.cells ∧ c3 ∈ V.cells) ∨ (c3 ∈ U.cells ∧ c1 ∈ V.cells)) → ((∀ (q : + GaussianInt), (q ∉ U.cells) → ((q ∉ V.cells) → (q ∈ (↑(U.cells ∪ V.cells) : Set + GaussianInt)ᶜ))) → ((c1 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ ∧ c3 ∈ (↑(U.cells ∪ + V.cells) : Set GaussianInt)ᶜ) ∨ (c0 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ ∧ c2 ∈ + (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ))))))))))) := by + classical + intro U V x c0 c1 c2 c3 no01 no10 no12 no21 no23 no32 no30 no03 hpattern inExterior + rcases hpattern with ⟨hu0, hv2⟩ | ⟨hu2, hv0⟩ | ⟨hu1, hv3⟩ | ⟨hu3, hv1⟩ + · left + constructor + · apply inExterior + · intro h; exact no12 ⟨h, hv2⟩ + · intro h; exact no01 ⟨hu0, h⟩ + · apply inExterior + · intro h; exact no32 ⟨h, hv2⟩ + · intro h; exact no03 ⟨hu0, h⟩ + · left + constructor + · apply inExterior + · intro h; exact no10 ⟨h, hv0⟩ + · intro h; exact no21 ⟨hu2, h⟩ + · apply inExterior + · intro h; exact no30 ⟨h, hv0⟩ + · intro h; exact no23 ⟨hu2, h⟩ + · right + constructor + · apply inExterior + · intro h; exact no03 ⟨h, hv3⟩ + · intro h; exact no10 ⟨hu1, h⟩ + · apply inExterior + · intro h; exact no23 ⟨h, hv3⟩ + · intro h; exact no12 ⟨hu1, h⟩ + · right + constructor + · apply inExterior + · intro h; exact no01 ⟨h, hv1⟩ + · intro h; exact no30 ⟨hu3, h⟩ + · apply inExterior + · intro h; exact no21 ⟨h, hv1⟩ + · intro h; exact no32 ⟨hu3, h⟩ + +private theorem adjNe : + (List GaussianInt) → (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, FourNeighborAdjacent a b → a + ≠ b) := by + classical + intro p a b hab heq + subst b + rcases hab with h | h | h | h + · have hr := congrArg Zsqrtd.re h + simp at hr + · have hr := congrArg Zsqrtd.re h + simp at hr + omega + · have hi := congrArg Zsqrtd.im h + simp at hi + · have hi := congrArg Zsqrtd.im h + simp at hi + omega + +private theorem pairCases : + ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : GaussianInt), ({a, b} : + Finset GaussianInt) = {c, d} → c ≠ d → a = c ∧ b = d ∨ a = d ∧ b = c := by + classical + intro a b c d hpair hcd + have ha : a = c ∨ a = d := by + have hmem : a ∈ ({c, d} : Finset GaussianInt) := by rw [← hpair]; simp + simpa only [Finset.mem_insert, Finset.mem_singleton] using hmem + have hb : b = c ∨ b = d := by + have hmem : b ∈ ({c, d} : Finset GaussianInt) := by rw [← hpair]; simp + simpa only [Finset.mem_insert, Finset.mem_singleton] using hmem + rcases ha with hac | had + · subst a + rcases hb with hbc | hbd + · subst b + have hmem : d ∈ ({c, d} : Finset GaussianInt) := by simp + rw [← hpair] at hmem + simp only [Finset.mem_insert, Finset.mem_singleton] at hmem + rcases hmem with h | h + · exact False.elim (hcd h.symm) + · exact False.elim (hcd h.symm) + · subst b + exact Or.inl ⟨rfl, rfl⟩ + · subst a + rcases hb with hbc | hbd + · subst b + exact Or.inr ⟨rfl, rfl⟩ + · subst b + have hmem : c ∈ ({c, d} : Finset GaussianInt) := by simp + rw [← hpair] at hmem + simp only [Finset.mem_insert, Finset.mem_singleton] at hmem + rcases hmem with h | h + · exact False.elim (hcd h) + · exact False.elim (hcd h) + +private theorem adjacentMemZip : + ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), (a, b) ∈ (l₁ ++ a :: b :: l₂).zip (l₁ ++ a :: b :: l₂).tail := by + classical + intro l₁ l₂ a b + induction l₁ with + | nil => simp + | cons z l ih => + cases l with + | nil => simp + | cons z' l => + simp only [List.cons_append, List.tail_cons, List.zip_cons_cons, + List.mem_cons] + exact Or.inr ih + +private theorem supportedRay : + ∀ (x : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : GaussianInt), (a = c) + → ((b = d) → (({a, b} : Finset GaussianInt) = {c, d}))) → (∀ (T : ProtoTile), ∀ (g : + Finset GaussianInt), x ∈ g → g ∈ FootprintEdges T → ∃ q ∈ T.cells, q = c0 ∧ (g = {x, + x + ⟨(0 : ℤ), (1 : ℤ)⟩} ∨ g = {x, x + (1 : GaussianInt)}) ∨ q = c1 ∧ (g = {x, + x + ⟨(0 : ℤ), (1 : ℤ)⟩} ∨ g = {x - (1 : GaussianInt), x}) ∨ q = c2 ∧ (g = + {x - (1 : GaussianInt), x} ∨ g = {x - ⟨(0 : ℤ), (1 : ℤ)⟩, x}) ∨ q = c3 ∧ (g = + {x - ⟨(0 : ℤ), (1 : ℤ)⟩, x} ∨ g = {x, x + (1 : GaussianInt)})) := by + classical + intro x c0 c1 c2 c3 pairEq T g hxg hg + simp only [FootprintEdges, Set.mem_ofPred_eq] at hg + rcases hg with ⟨z, hz, hshape⟩ + rcases hshape with hshape | hshape | hshape | hshape + · have hxg' : x = z ∨ x = z + 1 := by simpa [hshape] using hxg + rcases hxg' with h | h + · subst z + refine ⟨x, hz, Or.inl ⟨by simp [c0], Or.inr ?_⟩⟩ + exact hshape + · have hzEq : z = x - 1 := by + calc + z = (z + 1) - 1 := by ring + _ = x - 1 := by rw [← h] + rw [hzEq] at hz + refine ⟨x - 1, hz, Or.inr (Or.inl ?_)⟩ + refine ⟨by simp [c1], Or.inr ?_⟩ + calc + g = {z, z + 1} := hshape + _ = {x - 1, x} := pairEq z (z + 1) (x - 1) x hzEq (by rw [hzEq]; ring) + · have hxg' : x = z ∨ x = z + ⟨0, 1⟩ := by simpa [hshape] using hxg + rcases hxg' with h | h + · subst z + refine ⟨x, hz, Or.inl ⟨by simp [c0], Or.inl ?_⟩⟩ + exact hshape + · have hzEq : z = x - ⟨0, 1⟩ := by + calc + z = (z + ⟨0, 1⟩) - ⟨0, 1⟩ := by ring + _ = x - ⟨0, 1⟩ := by rw [← h] + rw [hzEq] at hz + refine ⟨x - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + refine ⟨by simp [c3], Or.inl ?_⟩ + calc + g = {z, z + ⟨0, 1⟩} := hshape + _ = {x - ⟨0, 1⟩, x} := pairEq z (z + ⟨0, 1⟩) + (x - ⟨0, 1⟩) x hzEq (by rw [hzEq]; ring) + · have hxg' : x = z + 1 ∨ x = z + 1 + ⟨0, 1⟩ := by simpa [hshape] using hxg + rcases hxg' with h | h + · have hzEq : z = x - 1 := by + calc + z = (z + 1) - 1 := by ring + _ = x - 1 := by rw [← h] + rw [hzEq] at hz + refine ⟨x - 1, hz, Or.inr (Or.inl ⟨by simp [c1], Or.inl ?_⟩)⟩ + calc + g = {z + 1, z + 1 + ⟨0, 1⟩} := hshape + _ = {x, x + ⟨0, 1⟩} := pairEq (z + 1) (z + 1 + ⟨0, 1⟩) + x (x + ⟨0, 1⟩) (by rw [hzEq]; ring) (by rw [hzEq]; ring) + · have hzEq : z = x - 1 - ⟨0, 1⟩ := by + calc + z = (z + 1 + ⟨0, 1⟩) - 1 - ⟨0, 1⟩ := by ring + _ = x - 1 - ⟨0, 1⟩ := by rw [← h] + rw [hzEq] at hz + refine ⟨x - 1 - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inl ⟨by simp [c2], Or.inr ?_⟩))⟩ + calc + g = {z + 1, z + 1 + ⟨0, 1⟩} := hshape + _ = {x - ⟨0, 1⟩, x} := pairEq (z + 1) (z + 1 + ⟨0, 1⟩) + (x - ⟨0, 1⟩) x (by rw [hzEq]; ring) (by rw [hzEq]; ring) + · have hxg' : x = z + ⟨0, 1⟩ ∨ x = z + 1 + ⟨0, 1⟩ := by simpa [hshape] using hxg + rcases hxg' with h | h + · have hzEq : z = x - ⟨0, 1⟩ := by + calc + z = (z + ⟨0, 1⟩) - ⟨0, 1⟩ := by ring + _ = x - ⟨0, 1⟩ := by rw [← h] + rw [hzEq] at hz + refine ⟨x - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr ⟨by simp [c3], Or.inr ?_⟩))⟩ + calc + g = {z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} := hshape + _ = {x, x + 1} := pairEq (z + ⟨0, 1⟩) (z + 1 + ⟨0, 1⟩) + x (x + 1) (by rw [hzEq]; ring) (by rw [hzEq]; ring) + · have hzEq : z = x - 1 - ⟨0, 1⟩ := by + calc + z = (z + 1 + ⟨0, 1⟩) - 1 - ⟨0, 1⟩ := by ring + _ = x - 1 - ⟨0, 1⟩ := by rw [← h] + rw [hzEq] at hz + refine ⟨x - 1 - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inl ⟨by simp [c2], Or.inl ?_⟩))⟩ + calc + g = {z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} := hshape + _ = {x - 1, x} := pairEq (z + ⟨0, 1⟩) (z + 1 + ⟨0, 1⟩) + (x - 1) x (by rw [hzEq]; ring) (by rw [hzEq]; ring) + +private theorem cyclicPair : + ∀ (F : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), (p.head? = some u) → ((p.getLast? = some v) → ((FourNeighborAdjacent v u) → + ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List + GaussianInt), p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → ((∀ (e : Finset + GaussianInt), e ∈ F ↔ e = {v, u} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (( + let cyclicEdges := p.zip p.tail ++ [(v, u)]; + ∀ (q : LatticeCell), ((q + (1 : LatticeCell), q + + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges ∧ (q + (1 : LatticeCell) + ⟨(0 : + ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell)) ∉ cyclicEdges → GridRayCrossingIndex (q + (1 : + LatticeCell)) p = GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell), q + (1 : + LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 + : ℤ)⟩, q + (1 : LatticeCell)) ∈ cyclicEdges → (GridRayCrossingIndex (q + (1 : + LatticeCell)) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ)) ∧ ((q + (1 : LatticeCell) + + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges ∧ (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges → GridRayCrossingIndex (q + ⟨(0 : + ℤ), (1 : ℤ)⟩) p = GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : + ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : + LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges → (GridRayCrossingIndex (q + ⟨(0 : ℤ), + (1 : ℤ)⟩) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ))) → ((∀ (g : Finset + GaussianInt), (g ∈ F) → (g = {v, u} ∨ ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ g = {a, b})) + → ((∀ {a : GaussianInt}, ∀ {b : GaussianInt}, (FourNeighborAdjacent a b) → (a ≠ b)) → ((∀ + (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : GaussianInt), (({a, + b} : Finset GaussianInt) = {c, d}) → ((c ≠ d) → ((a = c ∧ b = d) ∨ (a = d ∧ b = c)))) → + ((∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), (a, b) ∈ (l₁ ++ a :: b :: l₂).zip (l₁ ++ a :: b :: l₂).tail) → (∀ (a : + GaussianInt), ∀ (b : GaussianInt), {a, b} ∈ F → (a, b) ∈ p.zip p.tail ++ [(v, u)] ∨ (b, + a) ∈ p.zip p.tail ++ [(v, u)])))))))))) := by + classical + intro F p u v hhead hlast hclose hsteps hedges hcross hcycleEdge adjNe pairCases adjacentMemZip + a b hab + rcases hcycleEdge {a, b} hab with hclosing | ⟨c, d, l₁, l₂, hdecomp, hpair⟩ + · have hmatch := pairCases a b v u hclosing (adjNe hclose) + rcases hmatch with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · left + simp + · right + simp + · have hstep := hsteps c d l₁ l₂ hdecomp + have hmatch := pairCases a b c d hpair (adjNe hstep) + have hmem : (c, d) ∈ p.zip p.tail := by + rw [hdecomp] + exact adjacentMemZip l₁ l₂ c d + rcases hmatch with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact Or.inl (List.mem_append.mpr (Or.inl hmem)) + · exact Or.inr (List.mem_append.mpr (Or.inl hmem)) + +private theorem edgeEndpointInW : + ∀ (W : Set GaussianInt), ∀ (F : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (u : + GaussianInt), ∀ (v : GaussianInt), (∀ (g : Finset GaussianInt), (g ∈ F) → (g = {v, u} ∨ ∃ + a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ g = {a, b})) → ((u ∈ p) → ((v ∈ p) → ((∀ (z : + GaussianInt), (z ∈ p) → (z ∈ W)) → (∀ g ∈ F, ∀ z ∈ g, z ∈ W)))) := by + classical + intro W F p u v hcycleEdge huMem hvMem vertexInW g hg z hz + rcases hcycleEdge g hg with hclosing | ⟨a, b, l₁, l₂, hdecomp, hpair⟩ + · have hz' : z ∈ ({v, u} : Finset GaussianInt) := by rw [← hclosing]; exact hz + simp only [Finset.mem_insert, Finset.mem_singleton] at hz' + rcases hz' with hzv | hzu + · subst z; exact vertexInW v hvMem + · subst z; exact vertexInW u huMem + · have hz' : z ∈ ({a, b} : Finset GaussianInt) := by rw [← hpair]; exact hz + simp only [Finset.mem_insert, Finset.mem_singleton] at hz' + rcases hz' with hza | hzb + · apply vertexInW + subst z + rw [hdecomp] + simp + · apply vertexInW + subst z + rw [hdecomp] + simp + +private theorem noThreeNeighbors : + ∀ (W : Set GaussianInt), ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (p : List + GaussianInt), ∀ (u : GaussianInt), ∀ (v : GaussianInt), (p.Nodup) → (((4 : ℕ) ≤ p.length) + → ((p.head? = some u) → ((p.getLast? = some v) → ((W = (↑p.toFinset : Set GaussianInt)) → + ((FourNeighborAdjacent v u) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List + GaussianInt), ∀ (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a + b) → ((∀ (e : Finset GaussianInt), e ∈ F ↔ e = {v, u} ∨ ∃ (a : GaussianInt) (b : + GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e + = {a, b}) → ((∀ (g : Finset GaussianInt), (g ∈ F) → (∀ (z : GaussianInt), (z ∈ g) → (z ∈ + W))) → ((W.Finite) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), {x, + a} ∈ F → {x, b} ∈ F → {x, c} ∈ F → x ≠ a → x ≠ b → x ≠ c → a ≠ b → a ≠ c → b ≠ c → + False)))))))))) := by + classical + intro W F x p u v hnodup hlen hhead hlast hvertices hclose hsteps hedges edgeEndpointInW + hWfinite a b c hab hbc hcc hxa hxb hxc hab' hac' hbc' + let E : Set (Finset GaussianInt) := F + let X : Set GaussianInt := + {z | ∃ edge ∈ E, z ∈ edge} + have hXsubset : X ⊆ W := by + intro z hz + rcases hz with ⟨edge, hedge, hze⟩ + exact edgeEndpointInW edge hedge z hze + let : Finite (Subtype X) := (hWfinite.subset hXsubset).to_subtype + have hEsub : E ⊆ F := by intro edge hedge; exact hedge + have hXends : X = {z | ∃ edge ∈ E, z ∈ edge} := rfl + have hcycle' : SimpleGridCycle W F := by + exact ⟨p, u, v, hnodup, hlen, hhead, hlast, hvertices, + hclose, hsteps, hedges⟩ + have hdegree := SimpleGridCycleSubgraphDegreeTwo X W E F hcycle' + hXsubset hEsub + let G : SimpleGraph X := SimpleGraph.fromRel fun s t => + ({s.1, t.1} : Finset GaussianInt) ∈ E + have hxX : x ∈ X := ⟨{x, a}, hab, by simp⟩ + let xX : X := ⟨x, hxX⟩ + have haX : a ∈ X := ⟨{x, a}, hab, by simp⟩ + have hbX : b ∈ X := ⟨{x, b}, hbc, by simp⟩ + have hcX : c ∈ X := ⟨{x, c}, hcc, by simp⟩ + let aX : X := ⟨a, haX⟩ + let bX : X := ⟨b, hbX⟩ + let cX : X := ⟨c, hcX⟩ + have hdegreeX : Set.ncard (G.neighborSet xX) ≤ 2 := by + exact hdegree xX + have hmemA : aX ∈ G.neighborSet xX := by + rw [SimpleGraph.mem_neighborSet] + apply (SimpleGraph.fromRel_adj _ _ _).mpr + refine ⟨?_, Or.inl ?_⟩ + · intro h + exact hxa (congrArg Subtype.val h) + · change ({x, a} : Finset GaussianInt) ∈ E + exact hab + have hmemB : bX ∈ G.neighborSet xX := by + rw [SimpleGraph.mem_neighborSet] + apply (SimpleGraph.fromRel_adj _ _ _).mpr + refine ⟨?_, Or.inl ?_⟩ + · intro h + exact hxb (congrArg Subtype.val h) + · change ({x, b} : Finset GaussianInt) ∈ E + exact hbc + have hmemC : cX ∈ G.neighborSet xX := by + rw [SimpleGraph.mem_neighborSet] + apply (SimpleGraph.fromRel_adj _ _ _).mpr + refine ⟨?_, Or.inl ?_⟩ + · intro h + exact hxc (congrArg Subtype.val h) + · change ({x, c} : Finset GaussianInt) ∈ E + exact hcc + have habX : aX ≠ bX := by + intro h + exact hab' (congrArg Subtype.val h) + have hacX : aX ≠ cX := by + intro h + exact hac' (congrArg Subtype.val h) + have hbcX : bX ≠ cX := by + intro h + exact hbc' (congrArg Subtype.val h) + let S : Finset X := {aX, bX, cX} + have hSsubset : (S : Set X) ⊆ G.neighborSet xX := by + intro z hz + have hz' : z = aX ∨ z = bX ∨ z = cX := by + simpa [S, Finset.mem_insert, Finset.mem_singleton] using hz + rcases hz' with rfl | rfl | rfl + · exact hmemA + · exact hmemB + · exact hmemC + have hScard : (S : Set X).ncard = 3 := by + rw [Set.ncard_coe_finset] + simp [S, habX, hacX, hbcX] + have hfiniteX : Finite (Subtype X) := (hWfinite.subset hXsubset).to_subtype + let : Finite (Subtype X) := hfiniteX + have hle : (S : Set X).ncard ≤ (G.neighborSet xX).ncard := + Set.ncard_mono (α := Subtype X) hSsubset + rw [hScard] at hle + omega + +private theorem exteriorNoTile : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ q ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ, q ∉ + U.cells ∧ q ∉ V.cells := by + classical + intro U V q hq + have hn : q ∉ (↑(U.cells ∪ V.cells) : Set GaussianInt) := by simpa using hq + constructor + · intro hqU + apply hn + change q ∈ (U.cells ∪ V.cells : Finset GaussianInt) + exact Finset.mem_union.mpr (Or.inl hqU) + · intro hqV + apply hn + change q ∈ (U.cells ∪ V.cells : Finset GaussianInt) + exact Finset.mem_union.mpr (Or.inr hqV) + +private theorem rayAt0 : + ∀ (x : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (∀ (T : ProtoTile), ∀ (g : Finset GaussianInt), (x ∈ g) → ((g ∈ FootprintEdges T) → (∃ q ∈ + T.cells, (q = c0 ∧ (g = {x, x + ⟨0, 1⟩} ∨ g = {x, x + 1})) ∨ (q = c1 ∧ (g = {x, x + ⟨0, + 1⟩} ∨ g = {x - 1, x})) ∨ (q = c2 ∧ (g = {x - 1, x} ∨ g = {x - ⟨0, 1⟩, x})) ∨ (q = c3 ∧ (g + = {x - ⟨0, 1⟩, x} ∨ g = {x, x + 1}))))) → (∀ (T : ProtoTile), ∀ (g : Finset GaussianInt), + x ∈ g → g ∈ FootprintEdges T → c1 ∉ T.cells → c2 ∉ T.cells → c3 ∉ T.cells → g = {x, + x + ⟨(0 : ℤ), (1 : ℤ)⟩} ∨ g = {x, x + (1 : GaussianInt)}) := by + classical + intro x c0 c1 c2 c3 supportedRay T g hxg hg h1 h2 h3 + rcases supportedRay T g hxg hg with ⟨q, hq, hcase⟩ + rcases hcase with ⟨hq0, hr⟩ | ⟨hq1, hr⟩ | ⟨hq2, hr⟩ | ⟨hq3, hr⟩ + · exact hr + · exact False.elim (h1 (by rw [← hq1]; exact hq)) + · exact False.elim (h2 (by rw [← hq2]; exact hq)) + · exact False.elim (h3 (by rw [← hq3]; exact hq)) + +private theorem rayAt1 : + ∀ (x : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (∀ (T : ProtoTile), ∀ (g : Finset GaussianInt), (x ∈ g) → ((g ∈ FootprintEdges T) → (∃ q ∈ + T.cells, (q = c0 ∧ (g = {x, x + ⟨0, 1⟩} ∨ g = {x, x + 1})) ∨ (q = c1 ∧ (g = {x, x + ⟨0, + 1⟩} ∨ g = {x - 1, x})) ∨ (q = c2 ∧ (g = {x - 1, x} ∨ g = {x - ⟨0, 1⟩, x})) ∨ (q = c3 ∧ (g + = {x - ⟨0, 1⟩, x} ∨ g = {x, x + 1}))))) → (∀ (T : ProtoTile), ∀ (g : Finset GaussianInt), + x ∈ g → g ∈ FootprintEdges T → c0 ∉ T.cells → c2 ∉ T.cells → c3 ∉ T.cells → g = {x, + x + ⟨(0 : ℤ), (1 : ℤ)⟩} ∨ g = {x - (1 : GaussianInt), x}) := by + classical + intro x c0 c1 c2 c3 supportedRay T g hxg hg h0 h2 h3 + rcases supportedRay T g hxg hg with ⟨q, hq, hcase⟩ + rcases hcase with ⟨hq0, hr⟩ | ⟨hq1, hr⟩ | ⟨hq2, hr⟩ | ⟨hq3, hr⟩ + · exact False.elim (h0 (by rw [← hq0]; exact hq)) + · exact hr + · exact False.elim (h2 (by rw [← hq2]; exact hq)) + · exact False.elim (h3 (by rw [← hq3]; exact hq)) + +private theorem rayAt2 : + ∀ (x : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (∀ (T : ProtoTile), ∀ (g : Finset GaussianInt), (x ∈ g) → ((g ∈ FootprintEdges T) → (∃ q ∈ + T.cells, (q = c0 ∧ (g = {x, x + ⟨0, 1⟩} ∨ g = {x, x + 1})) ∨ (q = c1 ∧ (g = {x, x + ⟨0, + 1⟩} ∨ g = {x - 1, x})) ∨ (q = c2 ∧ (g = {x - 1, x} ∨ g = {x - ⟨0, 1⟩, x})) ∨ (q = c3 ∧ (g + = {x - ⟨0, 1⟩, x} ∨ g = {x, x + 1}))))) → (∀ (T : ProtoTile), ∀ (g : Finset GaussianInt), + x ∈ g → g ∈ FootprintEdges T → c0 ∉ T.cells → c1 ∉ T.cells → c3 ∉ T.cells → g = + {x - (1 : GaussianInt), x} ∨ g = {x - ⟨(0 : ℤ), (1 : ℤ)⟩, x}) := by + classical + intro x c0 c1 c2 c3 supportedRay T g hxg hg h0 h1 h3 + rcases supportedRay T g hxg hg with ⟨q, hq, hcase⟩ + rcases hcase with ⟨hq0, hr⟩ | ⟨hq1, hr⟩ | ⟨hq2, hr⟩ | ⟨hq3, hr⟩ + · exact False.elim (h0 (by rw [← hq0]; exact hq)) + · exact False.elim (h1 (by rw [← hq1]; exact hq)) + · exact hr + · exact False.elim (h3 (by rw [← hq3]; exact hq)) + +private theorem rayAt3 : + ∀ (x : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (∀ (T : ProtoTile), ∀ (g : Finset GaussianInt), (x ∈ g) → ((g ∈ FootprintEdges T) → (∃ q ∈ + T.cells, (q = c0 ∧ (g = {x, x + ⟨0, 1⟩} ∨ g = {x, x + 1})) ∨ (q = c1 ∧ (g = {x, x + ⟨0, + 1⟩} ∨ g = {x - 1, x})) ∨ (q = c2 ∧ (g = {x - 1, x} ∨ g = {x - ⟨0, 1⟩, x})) ∨ (q = c3 ∧ (g + = {x - ⟨0, 1⟩, x} ∨ g = {x, x + 1}))))) → (∀ (T : ProtoTile), ∀ (g : Finset GaussianInt), + x ∈ g → g ∈ FootprintEdges T → c0 ∉ T.cells → c1 ∉ T.cells → c2 ∉ T.cells → g = + {x - ⟨(0 : ℤ), (1 : ℤ)⟩, x} ∨ g = {x, x + (1 : GaussianInt)}) := by + classical + intro x c0 c1 c2 c3 supportedRay T g hxg hg h0 h1 h2 + rcases supportedRay T g hxg hg with ⟨q, hq, hcase⟩ + rcases hcase with ⟨hq0, hr⟩ | ⟨hq1, hr⟩ | ⟨hq2, hr⟩ | ⟨hq3, hr⟩ + · exact False.elim (h0 (by rw [← hq0]; exact hq)) + · exact False.elim (h1 (by rw [← hq1]; exact hq)) + · exact False.elim (h2 (by rw [← hq2]; exact hq)) + · exact hr + +private theorem hsectorRay : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), ∀ (e : Finset GaussianInt), ∀ (f : + Finset GaussianInt), (x ∈ e) → ((x ∈ f) → ((e ∈ FootprintEdges U) → ((f ∈ FootprintEdges + V) → ( + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (¬ (c0 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ + c2 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c3 ∈ V.cells)) + → ((¬ (c3 ∈ U.cells ∧ c2 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c0 ∈ + U.cells ∧ c3 ∈ V.cells)) → ((¬ (c0 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ c1 ∈ + V.cells)) → ((¬ (c2 ∈ U.cells ∧ c2 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ c3 ∈ V.cells)) → + (((c0 ∈ U.cells ∧ c2 ∈ V.cells) ∨ (c2 ∈ U.cells ∧ c0 ∈ V.cells) ∨ (c1 ∈ U.cells ∧ c3 ∈ + V.cells) ∨ (c3 ∈ U.cells ∧ c1 ∈ V.cells)) → ((∀ (T : ProtoTile), ∀ (g : Finset + GaussianInt), (x ∈ g) → ((g ∈ FootprintEdges T) → ((c1 ∉ T.cells) → ((c2 ∉ T.cells) → + ((c3 ∉ T.cells) → (g = {x, x + ⟨0, 1⟩} ∨ g = {x, x + 1})))))) → ((∀ (T : ProtoTile), ∀ (g + : Finset GaussianInt), (x ∈ g) → ((g ∈ FootprintEdges T) → ((c0 ∉ T.cells) → ((c2 ∉ + T.cells) → ((c3 ∉ T.cells) → (g = {x, x + ⟨0, 1⟩} ∨ g = {x - 1, x})))))) → ((∀ (T : + ProtoTile), ∀ (g : Finset GaussianInt), (x ∈ g) → ((g ∈ FootprintEdges T) → ((c0 ∉ + T.cells) → ((c1 ∉ T.cells) → ((c3 ∉ T.cells) → (g = {x - 1, x} ∨ g = {x - ⟨0, 1⟩, + x})))))) → ((∀ (T : ProtoTile), ∀ (g : Finset GaussianInt), (x ∈ g) → ((g ∈ + FootprintEdges T) → ((c0 ∉ T.cells) → ((c1 ∉ T.cells) → ((c2 ∉ T.cells) → (g = {x - ⟨0, + 1⟩, x} ∨ g = {x, x + 1})))))) → ((c0 ∈ U.cells ∧ c2 ∈ V.cells ∧ (e = {x, x + ⟨0, 1⟩} ∨ e + = {x, x + 1}) ∧ (f = {x - ⟨0, 1⟩, x} ∨ f = {x - 1, x})) ∨ (c2 ∈ U.cells ∧ c0 ∈ V.cells ∧ + (e = {x - 1, x} ∨ e = {x - ⟨0, 1⟩, x}) ∧ (f = {x, x + ⟨0, 1⟩} ∨ f = {x, x + 1})) ∨ (c1 ∈ + U.cells ∧ c3 ∈ V.cells ∧ (e = {x, x + ⟨0, 1⟩} ∨ e = {x - 1, x}) ∧ (f = {x - ⟨0, 1⟩, x} ∨ + f = {x, x + 1})) ∨ (c3 ∈ U.cells ∧ c1 ∈ V.cells ∧ (e = {x - ⟨0, 1⟩, x} ∨ e = {x, x + 1}) + ∧ (f = {x, x + ⟨0, 1⟩} ∨ f = {x - 1, x}))))))))))))))))))))))) := by + classical + intro U V x e f hxe hxf hUedge hVedge c0 c1 c2 c3 no01 no10 no12 no21 no23 no32 no30 no03 + noSame0 noSame1 noSame2 noSame3 hpattern rayAt0 rayAt1 rayAt2 rayAt3 + rcases hpattern with hpat | hpat | hpat | hpat + · rcases hpat with ⟨hU0, hV2⟩ + have hU1 : c1 ∉ U.cells := by intro h; exact no12 ⟨h, hV2⟩ + have hU2 : c2 ∉ U.cells := by intro h; exact noSame2 ⟨h, hV2⟩ + have hU3 : c3 ∉ U.cells := by intro h; exact no32 ⟨h, hV2⟩ + have hV0 : c0 ∉ V.cells := by intro h; exact noSame0 ⟨hU0, h⟩ + have hV1 : c1 ∉ V.cells := by intro h; exact no01 ⟨hU0, h⟩ + have hV3 : c3 ∉ V.cells := by intro h; exact no03 ⟨hU0, h⟩ + refine Or.inl ⟨hU0, hV2, ?_, ?_⟩ + · exact rayAt0 U e hxe hUedge hU1 hU2 hU3 + · exact (rayAt2 V f hxf hVedge hV0 hV1 hV3).symm + · rcases hpat with ⟨hU2, hV0⟩ + have hU0 : c0 ∉ U.cells := by intro h; exact noSame0 ⟨h, hV0⟩ + have hU1 : c1 ∉ U.cells := by intro h; exact no10 ⟨h, hV0⟩ + have hU3 : c3 ∉ U.cells := by intro h; exact no30 ⟨h, hV0⟩ + have hV1 : c1 ∉ V.cells := by intro h; exact no21 ⟨hU2, h⟩ + have hV2 : c2 ∉ V.cells := by intro h; exact noSame2 ⟨hU2, h⟩ + have hV3 : c3 ∉ V.cells := by intro h; exact no23 ⟨hU2, h⟩ + refine Or.inr (Or.inl ⟨hU2, hV0, ?_, ?_⟩) + · exact rayAt2 U e hxe hUedge hU0 hU1 hU3 + · exact rayAt0 V f hxf hVedge hV1 hV2 hV3 + · rcases hpat with ⟨hU1, hV3⟩ + have hU0 : c0 ∉ U.cells := by intro h; exact no03 ⟨h, hV3⟩ + have hU2 : c2 ∉ U.cells := by intro h; exact no23 ⟨h, hV3⟩ + have hU3 : c3 ∉ U.cells := by intro h; exact noSame3 ⟨h, hV3⟩ + have hV0 : c0 ∉ V.cells := by intro h; exact no10 ⟨hU1, h⟩ + have hV1 : c1 ∉ V.cells := by intro h; exact noSame1 ⟨hU1, h⟩ + have hV2 : c2 ∉ V.cells := by intro h; exact no12 ⟨hU1, h⟩ + refine Or.inr (Or.inr (Or.inl ⟨hU1, hV3, ?_, ?_⟩)) + · exact rayAt1 U e hxe hUedge hU0 hU2 hU3 + · exact rayAt3 V f hxf hVedge hV0 hV1 hV2 + · rcases hpat with ⟨hU3, hV1⟩ + have hU0 : c0 ∉ U.cells := by intro h; exact no01 ⟨h, hV1⟩ + have hU1 : c1 ∉ U.cells := by intro h; exact noSame1 ⟨h, hV1⟩ + have hU2 : c2 ∉ U.cells := by intro h; exact no21 ⟨h, hV1⟩ + have hV0 : c0 ∉ V.cells := by intro h; exact no30 ⟨hU3, h⟩ + have hV2 : c2 ∉ V.cells := by intro h; exact no32 ⟨hU3, h⟩ + have hV3 : c3 ∉ V.cells := by intro h; exact noSame3 ⟨hU3, h⟩ + refine Or.inr (Or.inr (Or.inr ⟨hU3, hV1, ?_, ?_⟩)) + · exact rayAt3 U e hxe hUedge hU0 hU1 hU2 + · exact rayAt1 V f hxf hVedge hV0 hV2 hV3 + +private theorem noExtra : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), + ∀ (e : Finset GaussianInt), ∀ (f : Finset GaussianInt), (e ∈ F ∩ FootprintEdges U) → ((f + ∈ F ∩ FootprintEdges V) → ( + let dir : Fin 4 → GaussianInt := fun i => + match i.val with + | 0 => x + ⟨0, 1⟩ + | 1 => x + 1 + | 2 => x - ⟨0, 1⟩ + | _ => x - 1 + (∀ (i : Fin 4), ∀ (j : Fin 4), ∀ (k : Fin 4), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → ((({x, dir i} : + Finset GaussianInt) ∈ F) → ((({x, dir j} : Finset GaussianInt) ∈ F) → ((({x, dir k} : + Finset GaussianInt) ∈ F) → (False))))))) → (∀ g ∈ F, ∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : + ℕ)), ∀ (k : Fin (4 : ℕ)), i ≠ j → i ≠ k → j ≠ k → e = {x, dir i} ∨ e = {dir i, x} → f = + {x, dir j} ∨ f = {dir j, x} → g = {x, dir k} ∨ g = {dir k, x} → False))) := by + classical + intro U V F x e f he hf dir noThreeDir g hg i j k hij hik hjk hea hfb hgc + have ha : ({x, dir i} : Finset GaussianInt) ∈ F := by + rcases hea with h | h + · rw [h.symm]; exact he.1 + · have h' : ({x, dir i} : Finset GaussianInt) = e := by + rw [Finset.pair_comm] + exact h.symm + rw [h'] + exact he.1 + have hb : ({x, dir j} : Finset GaussianInt) ∈ F := by + rcases hfb with h | h + · rw [h.symm]; exact hf.1 + · have h' : ({x, dir j} : Finset GaussianInt) = f := by + rw [Finset.pair_comm] + exact h.symm + rw [h'] + exact hf.1 + have hc : ({x, dir k} : Finset GaussianInt) ∈ F := by + rcases hgc with h | h + · rw [h.symm]; exact hg + · have h' : ({x, dir k} : Finset GaussianInt) = g := by + rw [Finset.pair_comm] + exact h.symm + rw [h'] + exact hg + exact noThreeDir i j k hij hik hjk ha hb hc + +private theorem cyclicToEdge : + ∀ (F : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), ((4 : ℕ) ≤ p.length) → ((p.head? = some u) → ((p.getLast? = some v) → + ((FourNeighborAdjacent v u) → ((∀ (e : Finset GaussianInt), e ∈ F ↔ e = {v, u} ∨ ∃ (a : + GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ + a :: b :: l₂ ∧ e = {a, b}) → (( + let cyclicEdges := p.zip p.tail ++ [(v, u)]; + ∀ (q : LatticeCell), ((q + (1 : LatticeCell), q + + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ + cyclicEdges ∧ (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell)) ∉ + cyclicEdges → GridRayCrossingIndex (q + (1 : LatticeCell)) p = GridRayCrossingIndex q p) + ∧ ((q + (1 : LatticeCell), q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ (q + + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell)) ∈ cyclicEdges → + (GridRayCrossingIndex (q + (1 : LatticeCell)) p - GridRayCrossingIndex q p).natAbs = (1 : + ℕ)) ∧ ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges + ∧ (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges → + GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) p = GridRayCrossingIndex q p) ∧ ((q + (1 : + LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ (q + ⟨(0 : ℤ), + (1 : ℤ)⟩, q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges → + (GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) p - GridRayCrossingIndex q p).natAbs = (1 + : ℕ))) → ((∀ (g : Finset GaussianInt), (g ∈ F) → (g = {v, u} ∨ ∃ a b l₁ l₂, p = l₁ ++ a + :: b :: l₂ ∧ g = {a, b})) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, b} : Finset + GaussianInt) ∈ F) → ((a, b) ∈ (p.zip p.tail) ++ [(v, u)] ∨ (b, a) ∈ (p.zip p.tail) ++ + [(v, u)])) → ((u ∈ p) → ((v ∈ p) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), (a, b) ∈ + p.zip p.tail ++ [(v, u)] → {a, b} ∈ F)))))))))) := by + classical + intro F p u v hlen hhead hlast hclose hedges hcross hcycleEdge cyclicPair huMem hvMem a b hab + rcases List.mem_append.mp hab with h | h + · rw [List.mem_iff_getElem] at h + rcases h with ⟨i, hi, hpair⟩ + have hi' : i + 1 < p.length := by + simp [List.length_zip] at hi + omega + rw [List.getElem_zip, List.getElem_tail] at hpair + injection hpair with ha hb + let l₁ := p.take i + let l₂ := p.drop (i + 2) + have hdecomp : p = l₁ ++ p[i] :: p[i + 1] :: l₂ := by + dsimp [l₁, l₂] + calc + p = p.take i ++ p.drop i := (List.take_append_drop i p).symm + _ = p.take i ++ p[i] :: p.drop (i + 1) := by + rw [List.drop_eq_getElem_cons (by omega)] + _ = p.take i ++ p[i] :: p[i + 1] :: p.drop (i + 2) := by + rw [List.drop_eq_getElem_cons hi'] + subst a + subst b + exact (hedges _).mpr (Or.inr ⟨p[i], p[i + 1], l₁, l₂, hdecomp, rfl⟩) + · simp only [List.mem_singleton] at h + rcases Prod.mk.inj h with ⟨rfl, rfl⟩ + exact (hedges _).mpr (Or.inl rfl) + +private theorem exterior13A : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (¬ (c0 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ c2 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ + c2 ∈ V.cells)) → ((¬ (c0 ∈ U.cells ∧ c3 ∈ V.cells)) → ((∀ (q : GaussianInt), (q ∉ + U.cells) → ((q ∉ V.cells) → (q ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ))) → (c0 ∈ + U.cells → c2 ∈ V.cells → c1 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ ∧ c3 ∈ (↑(U.cells + ∪ V.cells) : Set GaussianInt)ᶜ))))) := by + classical + intro U V x c0 c1 c2 c3 no01 no12 no32 no03 inExterior hu0 hv2 + constructor + · apply inExterior + · intro h; exact no12 ⟨h, hv2⟩ + · intro h; exact no01 ⟨hu0, h⟩ + · apply inExterior + · intro h; exact no32 ⟨h, hv2⟩ + · intro h; exact no03 ⟨hu0, h⟩ + +private theorem exterior13B : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (¬ (c1 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ + c3 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ c0 ∈ V.cells)) → ((∀ (q : GaussianInt), (q ∉ + U.cells) → ((q ∉ V.cells) → (q ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ))) → (c2 ∈ + U.cells → c0 ∈ V.cells → c1 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ ∧ c3 ∈ (↑(U.cells + ∪ V.cells) : Set GaussianInt)ᶜ))))) := by + classical + intro U V x c0 c1 c2 c3 no10 no21 no23 no30 inExterior hu2 hv0 + constructor + · apply inExterior + · intro h; exact no10 ⟨h, hv0⟩ + · intro h; exact no21 ⟨hu2, h⟩ + · apply inExterior + · intro h; exact no30 ⟨h, hv0⟩ + · intro h; exact no23 ⟨hu2, h⟩ + +private theorem exterior02A : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (¬ (c1 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ c2 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ + c3 ∈ V.cells)) → ((¬ (c0 ∈ U.cells ∧ c3 ∈ V.cells)) → ((∀ (q : GaussianInt), (q ∉ + U.cells) → ((q ∉ V.cells) → (q ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ))) → (c1 ∈ + U.cells → c3 ∈ V.cells → c0 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ ∧ c2 ∈ (↑(U.cells + ∪ V.cells) : Set GaussianInt)ᶜ))))) := by + classical + intro U V x c0 c1 c2 c3 no10 no12 no23 no03 inExterior hu1 hv3 + constructor + · apply inExterior + · intro h; exact no03 ⟨h, hv3⟩ + · intro h; exact no10 ⟨hu1, h⟩ + · apply inExterior + · intro h; exact no23 ⟨h, hv3⟩ + · intro h; exact no12 ⟨hu1, h⟩ + +private theorem exterior02B : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (¬ (c0 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ + c2 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ c0 ∈ V.cells)) → ((∀ (q : GaussianInt), (q ∉ + U.cells) → ((q ∉ V.cells) → (q ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ))) → (c3 ∈ + U.cells → c1 ∈ V.cells → c0 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ ∧ c2 ∈ (↑(U.cells + ∪ V.cells) : Set GaussianInt)ᶜ))))) := by + classical + intro U V x c0 c1 c2 c3 no01 no21 no32 no30 inExterior hu3 hv1 + constructor + · apply inExterior + · intro h; exact no01 ⟨h, hv1⟩ + · intro h; exact no30 ⟨hu3, h⟩ + · apply inExterior + · intro h; exact no21 ⟨h, hv1⟩ + · intro h; exact no32 ⟨hu3, h⟩ + +private theorem hEeqAt936 : + ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (p : List GaussianInt), ∀ (u : + GaussianInt), ∀ (v : GaussianInt), + let c0 : GaussianInt := x + let c3 : GaussianInt := x - ⟨0, 1⟩ + (∀ (a : GaussianInt), ∀ (b : GaussianInt), ((a, b) ∈ p.zip p.tail ++ [(v, u)]) → (({a, b} : + Finset GaussianInt) ∈ F)) → ( + let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p + (∀ (q : GaussianInt), ((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ (q + ⟨0, 1⟩, + q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)]) → (GridRayCrossingIndex (q + ⟨0, 1⟩) p = + GridRayCrossingIndex q p)) → ((c3 + ⟨0, 1⟩ = x) → ((({x, x + 1} : Finset GaussianInt) ∉ + F) → (I c0 = I c3)))) := by + classical + intro F x p u v c0 c3 cyclicToEdge I crossNorthEq c3i hEabsent + have hnc : + (c3 + 1 + ⟨0, 1⟩, c3 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ + (c3 + ⟨0, 1⟩, c3 + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] := by + constructor + · intro h + apply hEabsent + convert cyclicToEdge _ _ h using 1; simp [c3, Finset.pair_comm]; ring + · intro h + apply hEabsent + convert cyclicToEdge _ _ h using 1; simp [c3, Finset.pair_comm]; ring + have h := crossNorthEq c3 hnc + simpa [I, c0, c3, c3i] using h + +private theorem hNeqAt966 : + ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (p : List GaussianInt), ∀ (u : + GaussianInt), ∀ (v : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + (∀ (a : GaussianInt), ∀ (b : GaussianInt), ((a, b) ∈ p.zip p.tail ++ [(v, u)]) → (({a, b} : + Finset GaussianInt) ∈ F)) → ( + let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p + (∀ (q : GaussianInt), ((q + 1, q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ (q + 1 + ⟨0, 1⟩, + q + 1) ∉ p.zip p.tail ++ [(v, u)]) → (GridRayCrossingIndex (q + 1) p = + GridRayCrossingIndex q p)) → ((c1 + 1 = x) → ((({x, x + ⟨0, 1⟩} : Finset GaussianInt) ∉ + F) → (I c0 = I c1)))) := by + classical + intro F x p u v c0 c1 cyclicToEdge I crossEastEq c1add hNabsent + have hnc : + (c1 + 1, c1 + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ + (c1 + 1 + ⟨0, 1⟩, c1 + 1) ∉ p.zip p.tail ++ [(v, u)] := by + constructor + · intro h + apply hNabsent + convert cyclicToEdge _ _ h using 1; simp [c1, Finset.pair_comm] + · intro h + apply hNabsent + convert cyclicToEdge _ _ h using 1; simp [c1, Finset.pair_comm] + have h := crossEastEq c1 hnc + simpa [I, c0, c1, c1add] using h + +private theorem hSeqAt999 : + ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (p : List GaussianInt), ∀ (u : + GaussianInt), ∀ (v : GaussianInt), + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (∀ (a : GaussianInt), ∀ (b : GaussianInt), ((a, b) ∈ p.zip p.tail ++ [(v, u)]) → (({a, b} : + Finset GaussianInt) ∈ F)) → ( + let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p + (∀ (q : GaussianInt), ((q + 1, q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ (q + 1 + ⟨0, 1⟩, + q + 1) ∉ p.zip p.tail ++ [(v, u)]) → (GridRayCrossingIndex (q + 1) p = + GridRayCrossingIndex q p)) → ((c2 + 1 = x - ⟨0, 1⟩) → ((({x - ⟨0, 1⟩, x} : Finset + GaussianInt) ∉ F) → (I c3 = I c2)))) := by + classical + intro F x p u v c2 c3 cyclicToEdge I crossEastEq c2add hSabsent + have c2addi : c2 + 1 + ⟨0, 1⟩ = x := by dsimp [c2]; ring + have hnc : + (c2 + 1, c2 + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ + (c2 + 1 + ⟨0, 1⟩, c2 + 1) ∉ p.zip p.tail ++ [(v, u)] := by + constructor + · intro h + apply hSabsent + convert cyclicToEdge _ _ h using 1; simp [c2]; ring + · intro h + apply hSabsent + simpa [c2, c2add, c2addi, Finset.pair_comm] using cyclicToEdge _ _ h + have h := crossEastEq c2 hnc + simpa [I, c2, c3, c2add] using h + +private theorem hWeqAt1029 : + ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (p : List GaussianInt), ∀ (u : + GaussianInt), ∀ (v : GaussianInt), + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + (∀ (a : GaussianInt), ∀ (b : GaussianInt), ((a, b) ∈ p.zip p.tail ++ [(v, u)]) → (({a, b} : + Finset GaussianInt) ∈ F)) → ( + let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p + (∀ (q : GaussianInt), ((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ (q + ⟨0, 1⟩, + q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)]) → (GridRayCrossingIndex (q + ⟨0, 1⟩) p = + GridRayCrossingIndex q p)) → ((c2 + 1 + ⟨0, 1⟩ = x) → ((c2 + ⟨0, 1⟩ = x - 1) → ((({x - 1, + x} : Finset GaussianInt) ∉ F) → (I c1 = I c2))))) := by + classical + intro F x p u v c1 c2 cyclicToEdge I crossNorthEq c2addi c2i hWabsent + have hnc : + (c2 + 1 + ⟨0, 1⟩, c2 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ + (c2 + ⟨0, 1⟩, c2 + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] := by + constructor + · intro h + apply hWabsent + simpa [c2, c2addi, c2i, Finset.pair_comm] using cyclicToEdge _ _ h + · intro h + apply hWabsent + convert cyclicToEdge _ _ h using 1; simp [c2]; ring + have h := crossNorthEq c2 hnc + simpa [I, c1, c2, c2i] using h + +private theorem hWeqAt1062 : + ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (p : List GaussianInt), ∀ (u : + GaussianInt), ∀ (v : GaussianInt), + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + (∀ (a : GaussianInt), ∀ (b : GaussianInt), ((a, b) ∈ p.zip p.tail ++ [(v, u)]) → (({a, b} : + Finset GaussianInt) ∈ F)) → ( + let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p + (∀ (q : GaussianInt), ((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ (q + ⟨0, 1⟩, + q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)]) → (GridRayCrossingIndex (q + ⟨0, 1⟩) p = + GridRayCrossingIndex q p)) → ((c2 + 1 + ⟨0, 1⟩ = x) → ((c2 + ⟨0, 1⟩ = x - 1) → ((({x - 1, + x} : Finset GaussianInt) ∉ F) → (I c1 = I c2))))) := by + classical + intro F x p u v c1 c2 cyclicToEdge I crossNorthEq c2addi c2i hWabsent + have hnc : + (c2 + 1 + ⟨0, 1⟩, c2 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ + (c2 + ⟨0, 1⟩, c2 + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] := by + constructor + · intro h + apply hWabsent + simpa [c2, c2addi, c2i, Finset.pair_comm] using cyclicToEdge _ _ h + · intro h + apply hWabsent + convert cyclicToEdge _ _ h using 1; simp [c2]; ring + have h := crossNorthEq c2 hnc + simpa [I, c1, c2, c2i] using h + +private theorem hNeqAt1093 : + ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (p : List GaussianInt), ∀ (u : + GaussianInt), ∀ (v : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + (∀ (a : GaussianInt), ∀ (b : GaussianInt), ((a, b) ∈ p.zip p.tail ++ [(v, u)]) → (({a, b} : + Finset GaussianInt) ∈ F)) → ( + let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p + (∀ (q : GaussianInt), ((q + 1, q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ (q + 1 + ⟨0, 1⟩, + q + 1) ∉ p.zip p.tail ++ [(v, u)]) → (GridRayCrossingIndex (q + 1) p = + GridRayCrossingIndex q p)) → ((c1 + 1 = x) → ((({x, x + ⟨0, 1⟩} : Finset GaussianInt) ∉ + F) → (I c0 = I c1)))) := by + classical + intro F x p u v c0 c1 cyclicToEdge I crossEastEq c1add hNabsent + have hnc : + (c1 + 1, c1 + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ + (c1 + 1 + ⟨0, 1⟩, c1 + 1) ∉ p.zip p.tail ++ [(v, u)] := by + constructor + · intro h + apply hNabsent + convert cyclicToEdge _ _ h using 1; simp [c1] + · intro h + apply hNabsent + convert cyclicToEdge _ _ h using 1; simp [c1, Finset.pair_comm] + have h := crossEastEq c1 hnc + simpa [I, c0, c1, c1add] using h + +private theorem hEeqAt1127 : + ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (p : List GaussianInt), ∀ (u : + GaussianInt), ∀ (v : GaussianInt), + let c0 : GaussianInt := x + let c3 : GaussianInt := x - ⟨0, 1⟩ + (∀ (a : GaussianInt), ∀ (b : GaussianInt), ((a, b) ∈ p.zip p.tail ++ [(v, u)]) → (({a, b} : + Finset GaussianInt) ∈ F)) → ( + let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p + (∀ (q : GaussianInt), ((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ (q + ⟨0, 1⟩, + q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)]) → (GridRayCrossingIndex (q + ⟨0, 1⟩) p = + GridRayCrossingIndex q p)) → ((c3 + ⟨0, 1⟩ = x) → ((({x, x + 1} : Finset GaussianInt) ∉ + F) → (I c0 = I c3)))) := by + classical + intro F x p u v c0 c3 cyclicToEdge I crossNorthEq c3i hEabsent + have hnc : + (c3 + 1 + ⟨0, 1⟩, c3 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ + (c3 + ⟨0, 1⟩, c3 + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] := by + constructor + · intro h + apply hEabsent + convert cyclicToEdge _ _ h using 1; simp [c3, Finset.pair_comm]; ring + · intro h + apply hEabsent + convert cyclicToEdge _ _ h using 1; simp [c3, Finset.pair_comm]; ring + have h := crossNorthEq c3 hnc + simpa [I, c0, c3, c3i] using h + +private theorem hSeqAt1158 : + ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (p : List GaussianInt), ∀ (u : + GaussianInt), ∀ (v : GaussianInt), + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (∀ (a : GaussianInt), ∀ (b : GaussianInt), ((a, b) ∈ p.zip p.tail ++ [(v, u)]) → (({a, b} : + Finset GaussianInt) ∈ F)) → ( + let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p + (∀ (q : GaussianInt), ((q + 1, q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ (q + 1 + ⟨0, 1⟩, + q + 1) ∉ p.zip p.tail ++ [(v, u)]) → (GridRayCrossingIndex (q + 1) p = + GridRayCrossingIndex q p)) → ((c2 + 1 = x - ⟨0, 1⟩) → ((({x - ⟨0, 1⟩, x} : Finset + GaussianInt) ∉ F) → (I c3 = I c2)))) := by + classical + intro F x p u v c2 c3 cyclicToEdge I crossEastEq c2add hSabsent + have c2addi : c2 + 1 + ⟨0, 1⟩ = x := by dsimp [c2]; ring + have hnc : + (c2 + 1, c2 + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ + (c2 + 1 + ⟨0, 1⟩, c2 + 1) ∉ p.zip p.tail ++ [(v, u)] := by + constructor + · intro h + apply hSabsent + convert cyclicToEdge _ _ h using 1; simp [c2]; ring + · intro h + apply hSabsent + simpa [c2, c2add, c2addi, Finset.pair_comm] using cyclicToEdge _ _ h + have h := crossEastEq c2 hnc + simpa [I, c2, c3, c2add] using h + +private theorem verticalSupport : + (List GaussianInt) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : + GaussianInt), (({a, b} : Finset GaussianInt) = {c, d}) → ((c ≠ d) → ((a = c ∧ b = d) ∨ (a + = d ∧ b = c)))) → (∀ (T : ProtoTile), ∀ (q : GaussianInt), {q, q + ⟨(0 : ℤ), (1 : ℤ)⟩} ∈ + FootprintEdges T → q ∈ T.cells ∨ q - (1 : GaussianInt) ∈ T.cells)) := by + classical + intro p pairCases T q h + rw [FootprintEdges] at h + simp only [Set.mem_ofPred_eq] at h + rcases h with ⟨z, hz, hshape⟩ + have hqd : q ≠ q + ⟨0, 1⟩ := by + intro heq + have hi := congrArg Zsqrtd.im heq + simp at hi + rcases hshape with hbot | hleft | hright | htop + · rcases pairCases z (z + 1) q (q + ⟨0, 1⟩) hbot.symm hqd with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ + · subst z + have hi := congrArg Zsqrtd.im h₂ + simp at hi + · subst z + have hi := congrArg Zsqrtd.im h₂ + simp at hi + · rcases pairCases z (z + ⟨0, 1⟩) q (q + ⟨0, 1⟩) hleft.symm hqd with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ + · subst z + exact Or.inl hz + · subst z + have hi := congrArg Zsqrtd.im h₂ + simp at hi; omega + · rcases pairCases (z + 1) (z + 1 + ⟨0, 1⟩) q (q + ⟨0, 1⟩) hright.symm hqd with ⟨h₁, h₂⟩ | ⟨h₁, + h₂⟩ + · have hzeq : z = q - 1 := by calc + z = (z + 1) - 1 := by ring + _ = q - 1 := by rw [h₁] + rw [hzeq] at hz + exact Or.inr hz + · have hi₁ := congrArg Zsqrtd.im h₁ + have hi₂ := congrArg Zsqrtd.im h₂ + have hr₁ := congrArg Zsqrtd.re h₁ + have hr₂ := congrArg Zsqrtd.re h₂ + simp at hi₁ hi₂; omega + · rcases pairCases (z + ⟨0, 1⟩) (z + 1 + ⟨0, 1⟩) q (q + ⟨0, 1⟩) htop.symm hqd with ⟨h₁, h₂⟩ | + ⟨h₁, h₂⟩ + · have hr₁ := congrArg Zsqrtd.re h₁ + have hr₂ := congrArg Zsqrtd.re h₂ + simp at hr₁ hr₂; omega + · have hr₁ := congrArg Zsqrtd.re h₁ + have hr₂ := congrArg Zsqrtd.re h₂ + simp at hr₁ hr₂; omega + +private theorem horizontalSupport : + (List GaussianInt) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : + GaussianInt), (({a, b} : Finset GaussianInt) = {c, d}) → ((c ≠ d) → ((a = c ∧ b = d) ∨ (a + = d ∧ b = c)))) → (∀ (T : ProtoTile), ∀ (q : GaussianInt), {q, q + (1 : GaussianInt)} ∈ + FootprintEdges T → q ∈ T.cells ∨ q - ⟨(0 : ℤ), (1 : ℤ)⟩ ∈ T.cells)) := by + classical + intro p pairCases T q h + rw [FootprintEdges] at h + simp only [Set.mem_ofPred_eq] at h + rcases h with ⟨z, hz, hshape⟩ + have hqd : q ≠ q + 1 := by + intro heq + have hr := congrArg Zsqrtd.re heq + simp at hr + rcases hshape with hbot | hleft | hright | htop + · rcases pairCases z (z + 1) q (q + 1) hbot.symm hqd with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ + · subst z + exact Or.inl hz + · subst z + have hr := congrArg Zsqrtd.re h₂ + simp at hr; omega + · rcases pairCases z (z + ⟨0, 1⟩) q (q + 1) hleft.symm hqd with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ + · subst z + have hi := congrArg Zsqrtd.im h₂ + simp at hi + · subst z + have hi := congrArg Zsqrtd.im h₂ + simp at hi + · rcases pairCases (z + 1) (z + 1 + ⟨0, 1⟩) q (q + 1) hright.symm hqd with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ + · have hi₁ := congrArg Zsqrtd.im h₁ + have hi₂ := congrArg Zsqrtd.im h₂ + have hr₁ := congrArg Zsqrtd.re h₁ + have hr₂ := congrArg Zsqrtd.re h₂ + simp at hi₁ hi₂ hr₁ hr₂; omega + · have hi₁ := congrArg Zsqrtd.im h₁ + have hi₂ := congrArg Zsqrtd.im h₂ + simp at hi₁ hi₂; omega + · rcases pairCases (z + ⟨0, 1⟩) (z + 1 + ⟨0, 1⟩) q (q + 1) htop.symm hqd with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ + · have hzeq : z = q - ⟨0, 1⟩ := by calc + z = (z + ⟨0, 1⟩) - ⟨0, 1⟩ := by ring + _ = q - ⟨0, 1⟩ := by rw [h₁] + rw [hzeq] at hz + exact Or.inr hz + · have hr₁ := congrArg Zsqrtd.re h₁ + have hr₂ := congrArg Zsqrtd.re h₂ + simp at hr₁ hr₂; omega + +private theorem verticalNoF : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (F : Set (Finset GaussianInt)), (F ⊆ FootprintEdges U + ∪ FootprintEdges V) → ((∀ (q : GaussianInt), (q ∈ (↑(U.cells ∪ V.cells) : Set + GaussianInt)ᶜ) → (q ∉ U.cells ∧ q ∉ V.cells)) → ((∀ (T : ProtoTile), ∀ (q : GaussianInt), + (({q, q + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges T) → (q ∈ T.cells ∨ q - 1 ∈ + T.cells)) → (∀ q ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ, q - (1 : GaussianInt) ∈ + (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ → {q, q + ⟨(0 : ℤ), (1 : ℤ)⟩} ∉ F))) := by + classical + intro U V F hsubset exteriorNoTile verticalSupport q hq hq' hF + rcases hsubset hF with hU | hV + · rcases verticalSupport U q hU with hqU | hqU' + · exact (exteriorNoTile q hq).1 hqU + · exact (exteriorNoTile (q - 1) hq').1 hqU' + · rcases verticalSupport V q hV with hqV | hqV' + · exact (exteriorNoTile q hq).2 hqV + · exact (exteriorNoTile (q - 1) hq').2 hqV' + +private theorem horizontalNoF : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (F : Set (Finset GaussianInt)), (F ⊆ FootprintEdges U + ∪ FootprintEdges V) → ((∀ (q : GaussianInt), (q ∈ (↑(U.cells ∪ V.cells) : Set + GaussianInt)ᶜ) → (q ∉ U.cells ∧ q ∉ V.cells)) → ((∀ (T : ProtoTile), ∀ (q : GaussianInt), + (({q, q + 1} : Finset GaussianInt) ∈ FootprintEdges T) → (q ∈ T.cells ∨ q - ⟨0, 1⟩ ∈ + T.cells)) → (∀ q ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ, q - ⟨(0 : ℤ), (1 : ℤ)⟩ ∈ + (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ → {q, q + (1 : GaussianInt)} ∉ F))) := by + classical + intro U V F hsubset exteriorNoTile horizontalSupport q hq hq' hF + rcases hsubset hF with hU | hV + · rcases horizontalSupport U q hU with hqU | hqU' + · exact (exteriorNoTile q hq).1 hqU + · exact (exteriorNoTile (q - ⟨0, 1⟩) hq').1 hqU' + · rcases horizontalSupport V q hV with hqV | hqV' + · exact (exteriorNoTile q hq).2 hqV + · exact (exteriorNoTile (q - ⟨0, 1⟩) hq').2 hqV' + + +end ExteriorMixedCycleProof + +namespace ExteriorCycleDetails + +private theorem hsectorRay : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), ∀ (e : Finset GaussianInt), ∀ (f : + Finset GaussianInt), (x ∈ e) → ((x ∈ f) → ((e ∈ FootprintEdges U) → ((f ∈ FootprintEdges + V) → ( + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (¬ (c0 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ + c2 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c3 ∈ V.cells)) + → ((¬ (c3 ∈ U.cells ∧ c2 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c0 ∈ + U.cells ∧ c3 ∈ V.cells)) → ((¬ (c0 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ c1 ∈ + V.cells)) → ((¬ (c2 ∈ U.cells ∧ c2 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ c3 ∈ V.cells)) → + (((c0 ∈ U.cells ∧ c2 ∈ V.cells) ∨ (c2 ∈ U.cells ∧ c0 ∈ V.cells) ∨ (c1 ∈ U.cells ∧ c3 ∈ + V.cells) ∨ (c3 ∈ U.cells ∧ c1 ∈ V.cells)) → ((∀ (T : ProtoTile), ∀ (g : Finset + GaussianInt), (x ∈ g) → ((g ∈ FootprintEdges T) → ((c1 ∉ T.cells) → ((c2 ∉ T.cells) → + ((c3 ∉ T.cells) → (g = {x, x + ⟨0, 1⟩} ∨ g = {x, x + 1})))))) → ((∀ (T : ProtoTile), ∀ (g + : Finset GaussianInt), (x ∈ g) → ((g ∈ FootprintEdges T) → ((c0 ∉ T.cells) → ((c2 ∉ + T.cells) → ((c3 ∉ T.cells) → (g = {x, x + ⟨0, 1⟩} ∨ g = {x - 1, x})))))) → ((∀ (T : + ProtoTile), ∀ (g : Finset GaussianInt), (x ∈ g) → ((g ∈ FootprintEdges T) → ((c0 ∉ + T.cells) → ((c1 ∉ T.cells) → ((c3 ∉ T.cells) → (g = {x - 1, x} ∨ g = {x - ⟨0, 1⟩, + x})))))) → ((∀ (T : ProtoTile), ∀ (g : Finset GaussianInt), (x ∈ g) → ((g ∈ + FootprintEdges T) → ((c0 ∉ T.cells) → ((c1 ∉ T.cells) → ((c2 ∉ T.cells) → (g = {x - ⟨0, + 1⟩, x} ∨ g = {x, x + 1})))))) → ((c0 ∈ U.cells ∧ c2 ∈ V.cells ∧ (e = {x, x + ⟨0, 1⟩} ∨ e + = {x, x + 1}) ∧ (f = {x - ⟨0, 1⟩, x} ∨ f = {x - 1, x})) ∨ (c2 ∈ U.cells ∧ c0 ∈ V.cells ∧ + (e = {x - 1, x} ∨ e = {x - ⟨0, 1⟩, x}) ∧ (f = {x, x + ⟨0, 1⟩} ∨ f = {x, x + 1})) ∨ (c1 ∈ + U.cells ∧ c3 ∈ V.cells ∧ (e = {x, x + ⟨0, 1⟩} ∨ e = {x - 1, x}) ∧ (f = {x - ⟨0, 1⟩, x} ∨ + f = {x, x + 1})) ∨ (c3 ∈ U.cells ∧ c1 ∈ V.cells ∧ (e = {x - ⟨0, 1⟩, x} ∨ e = {x, x + 1}) + ∧ (f = {x, x + ⟨0, 1⟩} ∨ f = {x - 1, x}))))))))))))))))))))))) := by + classical + intro U V x e f hxe hxf hUedge hVedge c0 c1 c2 c3 no01 no10 no12 no21 no23 no32 no30 no03 + noSame0 noSame1 noSame2 noSame3 hpattern rayAt0 rayAt1 rayAt2 rayAt3 + exact ExteriorMixedCycleProof.hsectorRay U V x e f + hxe hxf hUedge hVedge no01 no10 no12 no21 no23 no32 no30 no03 noSame0 noSame1 noSame2 + noSame3 hpattern rayAt0 rayAt1 rayAt2 rayAt3 + +private theorem indexAdjacentExterior : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (F : Set (Finset GaussianInt)), ∀ (p : List + GaussianInt), ∀ (u : GaussianInt), ∀ (v : GaussianInt), (∀ (a : GaussianInt), ∀ (b : + GaussianInt), ((a, b) ∈ p.zip p.tail ++ [(v, u)]) → (({a, b} : Finset GaussianInt) ∈ + F)) → ( + let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p + (∀ (q : GaussianInt), ((q + 1, q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ (q + 1 + ⟨0, 1⟩, + q + 1) ∉ p.zip p.tail ++ [(v, u)]) → (GridRayCrossingIndex (q + 1) p = + GridRayCrossingIndex q p)) → ((∀ (q : GaussianInt), ((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∉ p.zip + p.tail ++ [(v, u)] ∧ (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)]) → + (GridRayCrossingIndex (q + ⟨0, 1⟩) p = GridRayCrossingIndex q p)) → ((∀ (q : + GaussianInt), (q ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ) → ((q - 1 ∈ (↑(U.cells ∪ + V.cells) : Set GaussianInt)ᶜ) → (({q, q + ⟨0, 1⟩} : Finset GaussianInt) ∉ F))) → ((∀ (q : + GaussianInt), (q ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ) → ((q - ⟨0, 1⟩ ∈ + (↑(U.cells + ∪ V.cells) : Set GaussianInt)ᶜ) → (({q, q + 1} : Finset GaussianInt) ∉ F))) → (∀ (a : + GaussianInt), ∀ (b : GaussianInt), a ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ → b ∈ + (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ → FourNeighborAdjacent a b → I a = I b))))) := by + classical + intro U V F p u v cyclicToEdge I crossEastEq crossNorthEq verticalNoF horizontalNoF a b ha hb hab + rcases hab with hab | hab | hab | hab + · subst b + have hn := verticalNoF (a + 1) hb (by simpa using ha) + have hnc : + (a + 1, a + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ + (a + 1 + ⟨0, 1⟩, a + 1) ∉ p.zip p.tail ++ [(v, u)] := by + constructor + · intro h + exact hn (by convert cyclicToEdge _ _ h using 1 ) + · intro h + exact hn (by convert cyclicToEdge _ _ h using 1; simp [Finset.pair_comm] ) + have h := crossEastEq a hnc + simpa only [I] using h.symm + · have hb' : b + 1 = a := by rw [hab]; ring + subst b + have hn := verticalNoF a ha (by simpa using hb) + have hnc : + (a - 1 + 1, a - 1 + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ + (a - 1 + 1 + ⟨0, 1⟩, a - 1 + 1) ∉ p.zip p.tail ++ [(v, u)] := by + constructor + · intro h + have h' : (a, a + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)] := by + convert h using 1; congr 1 <;> ring + exact hn (cyclicToEdge _ _ h') + · intro h + exact hn (by convert cyclicToEdge _ _ h using 1; simp [Finset.pair_comm] ) + have h := crossEastEq (a - 1) hnc + have hq : a - 1 + 1 = a := by ring + change GridRayCrossingIndex ((a - 1) + 1) p = GridRayCrossingIndex (a - 1) p at h + rw [hq] at h + simpa only [I] using h + · subst b + have hn := horizontalNoF (a + ⟨0, 1⟩) hb (by simpa using ha) + have hnc : + (a + 1 + ⟨0, 1⟩, a + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ + (a + ⟨0, 1⟩, a + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] := by + constructor + · intro h + exact hn (by convert cyclicToEdge _ _ h using 1; simp [Finset.pair_comm]; ring) + · intro h + exact hn (by convert cyclicToEdge _ _ h using 1; simp [Finset.pair_comm]; ring) + have h := crossNorthEq a hnc + simpa only [I] using h.symm + · have hbCell : a - ⟨0, 1⟩ ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ := by + rw [← hab] + exact hb + have hn := horizontalNoF a ha hbCell + have hnc : + (a + 1, a) ∉ p.zip p.tail ++ [(v, u)] ∧ + (a, a + 1) ∉ p.zip p.tail ++ [(v, u)] := by + constructor + · intro h + exact hn (by convert cyclicToEdge _ _ h using 1; simp [Finset.pair_comm] ) + · intro h + exact hn (by convert cyclicToEdge _ _ h using 1 ) + have hnc' : + (b + 1 + ⟨0, 1⟩, b + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ + (b + ⟨0, 1⟩, b + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] := by + convert hnc using 1 <;> rw [hab] <;> simp <;> ring + have h := crossNorthEq b hnc' + have hq : b + ⟨0, 1⟩ = a := by rw [hab]; ring + change GridRayCrossingIndex (b + ⟨0, 1⟩) p = GridRayCrossingIndex b p at h + rw [hq] at h + simpa only [I] using h + +private theorem walkConst : + ∀ (S : Set GaussianInt), ∀ (J : GaussianInt → ℤ), (∀ (a : GaussianInt), ∀ (b : GaussianInt), + a ∈ S → b ∈ S → FourNeighborAdjacent a b → J a = J b) → ∀ (walk : List GaussianInt), ∀ + (start : GaussianInt), ∀ (finish : GaussianInt), walk.head? = some start → walk.getLast? + = some finish → (∀ z ∈ walk, z ∈ S) → (∀ (a : LatticeCell), ∀ (b : LatticeCell), ∀ (l₁ : + List LatticeCell), ∀ (l₂ : List LatticeCell), walk = l₁ ++ a :: b :: l₂ → + FourNeighborAdjacent a b) → J start = J finish := by + classical + intro S J step walk + induction walk with + | nil => + intro start finish hh + simp at hh + | cons a tail ih => + intro start finish hh hl hv hs + have hstart : start = a := by + have h' : a = start := by simpa using hh + exact h'.symm + cases tail with + | nil => + simp at hh hl + subst start + subst finish + rfl + | cons b rest => + have hab : FourNeighborAdjacent a b := hs a b [] rest (by simp) + have htailLast : (b :: rest).getLast? = some finish := by simpa using hl + have htailVerts : ∀ z ∈ b :: rest, z ∈ S := by + intro z hz + exact hv z (by simp [hz]) + have htailSteps : ∀ c d l₁ l₂, + b :: rest = l₁ ++ c :: d :: l₂ → FourNeighborAdjacent c d := by + intro c d l₁ l₂ hdec + have hdec' : a :: b :: rest = (a :: l₁) ++ c :: d :: l₂ := by + simpa using congrArg (List.cons a) hdec + exact hs c d (a :: l₁) l₂ hdec' + have hfirst := step a b (hv a (by simp)) (hv b (by simp)) hab + have htail := ih b finish rfl htailLast htailVerts htailSteps + subst start + exact hfirst.trans htail + +end ExteriorCycleDetails + +namespace ExteriorIndexCases + +private theorem hmixed : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), (¬(FootprintEdges U ∩ FootprintEdges V).Nonempty) → (∀ + (F : Set (Finset GaussianInt)), ∀ (e : Finset GaussianInt), ∀ (f : Finset GaussianInt), + (e ∈ F ∩ FootprintEdges U) → ((f ∈ F ∩ FootprintEdges V) → (e ≠ f))) := by + classical + intro U V hedge F e f he hf hef + apply hedge + exact ⟨e, ⟨he.2, by simpa [hef] using hf.2⟩⟩ + +private theorem pairEq : + ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : GaussianInt), a = c → b + = d → ({a, b} : Finset GaussianInt) = {c, d} := by + classical + intro a b c d ha hb + subst c + subst d + rfl + +private theorem edgeLeft : + ∀ (T : ProtoTile), ∀ q ∈ T.cells, {q, q + ⟨(0 : ℤ), (1 : ℤ)⟩} ∈ FootprintEdges T := by + classical + intro T q hq + rw [FootprintEdges] + exact ⟨q, hq, Or.inr (Or.inl rfl)⟩ + +private theorem edgeBottom : + ∀ (T : ProtoTile), ∀ q ∈ T.cells, {q, q + (1 : GaussianInt)} ∈ FootprintEdges T := by + classical + intro T q hq + rw [FootprintEdges] + exact ⟨q, hq, Or.inl rfl⟩ + +private theorem edgeRight : + ∀ (T : ProtoTile), ∀ q ∈ T.cells, {q + (1 : GaussianInt), q + (1 : GaussianInt) + ⟨(0 : ℤ), + (1 : ℤ)⟩} ∈ FootprintEdges T := by + classical + intro T q hq + rw [FootprintEdges] + exact ⟨q, hq, Or.inr (Or.inr (Or.inl rfl))⟩ + +private theorem edgeTop : + ∀ (T : ProtoTile), ∀ q ∈ T.cells, {q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : GaussianInt) + ⟨(0 : ℤ), + (1 : ℤ)⟩} ∈ FootprintEdges T := by + classical + intro T q hq + rw [FootprintEdges] + exact ⟨q, hq, Or.inr (Or.inr (Or.inr rfl))⟩ + +private theorem no01 : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), (¬(FootprintEdges U ∩ FootprintEdges V).Nonempty) → (∀ + (x : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + (∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ T.cells) → (({q, q + ⟨0, 1⟩} : Finset + GaussianInt) ∈ FootprintEdges T)) → ((∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ + T.cells) → (({q + 1, q + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges T)) → (¬ (c0 + ∈ U.cells ∧ c1 ∈ V.cells)))) := by + classical + intro U V hedge x c0 c1 edgeLeft edgeRight + rintro ⟨hu, hv⟩ + apply hedge + exact ⟨{x, x + ⟨0, 1⟩}, ⟨by simpa [c0] using edgeLeft U c0 hu, + by simpa [c1] using edgeRight V c1 hv⟩⟩ + +private theorem no10 : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), (¬(FootprintEdges U ∩ FootprintEdges V).Nonempty) → (∀ + (x : GaussianInt), + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + (∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ T.cells) → (({q, q + ⟨0, 1⟩} : Finset + GaussianInt) ∈ FootprintEdges T)) → ((∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ + T.cells) → (({q + 1, q + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges T)) → (¬ (c1 + ∈ U.cells ∧ c0 ∈ V.cells)))) := by + classical + intro U V hedge x c0 c1 edgeLeft edgeRight + rintro ⟨hu, hv⟩ + apply hedge + exact ⟨{x, x + ⟨0, 1⟩}, ⟨by simpa [c1] using edgeRight U c1 hu, + by simpa [c0] using edgeLeft V c0 hv⟩⟩ + +private theorem no12 : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), (¬(FootprintEdges U ∩ FootprintEdges V).Nonempty) → (∀ + (x : GaussianInt), + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + (∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ T.cells) → (({q, q + 1} : Finset GaussianInt) ∈ + FootprintEdges T)) → ((∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ T.cells) → (({q + ⟨0, + 1⟩, q + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges T)) → (¬ (c1 ∈ U.cells ∧ c2 ∈ + V.cells)))) := by + classical + intro U V hedge x c1 c2 edgeBottom edgeTop + rintro ⟨hu, hv⟩ + apply hedge + exact ⟨{x - 1, x}, ⟨by simpa [c1] using edgeBottom U c1 hu, + by convert edgeTop V c2 hv using 1; simp [c2]; ring⟩⟩ + +private theorem no21 : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), (¬(FootprintEdges U ∩ FootprintEdges V).Nonempty) → (∀ + (x : GaussianInt), + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + (∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ T.cells) → (({q, q + 1} : Finset GaussianInt) ∈ + FootprintEdges T)) → ((∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ T.cells) → (({q + ⟨0, + 1⟩, q + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges T)) → (¬ (c2 ∈ U.cells ∧ c1 ∈ + V.cells)))) := by + classical + intro U V hedge x c1 c2 edgeBottom edgeTop + rintro ⟨hu, hv⟩ + apply hedge + exact ⟨{x - 1, x}, ⟨by convert edgeTop U c2 hu using 1; simp [c2]; ring, + by simpa [c1] using edgeBottom V c1 hv⟩⟩ + +private theorem no23 : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), (¬(FootprintEdges U ∩ FootprintEdges V).Nonempty) → (∀ + (x : GaussianInt), + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ T.cells) → (({q, q + ⟨0, 1⟩} : Finset + GaussianInt) ∈ FootprintEdges T)) → ((∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ + T.cells) → (({q + 1, q + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges T)) → (¬ (c2 + ∈ U.cells ∧ c3 ∈ V.cells)))) := by + classical + intro U V hedge x c2 c3 edgeLeft edgeRight + rintro ⟨hu, hv⟩ + apply hedge + exact ⟨{x - ⟨0, 1⟩, x}, ⟨by convert edgeRight U c2 hu using 1; simp [c2]; ring, + by simpa [c3] using edgeLeft V c3 hv⟩⟩ + +private theorem no32 : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), (¬(FootprintEdges U ∩ FootprintEdges V).Nonempty) → (∀ + (x : GaussianInt), + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ T.cells) → (({q, q + ⟨0, 1⟩} : Finset + GaussianInt) ∈ FootprintEdges T)) → ((∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ + T.cells) → (({q + 1, q + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges T)) → (¬ (c3 + ∈ U.cells ∧ c2 ∈ V.cells)))) := by + classical + intro U V hedge x c2 c3 edgeLeft edgeRight + rintro ⟨hu, hv⟩ + apply hedge + exact ⟨{x - ⟨0, 1⟩, x}, ⟨by simpa [c3] using edgeLeft U c3 hu, + by convert edgeRight V c2 hv using 1; simp [c2]; ring⟩⟩ + +private theorem no30 : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), (¬(FootprintEdges U ∩ FootprintEdges V).Nonempty) → (∀ + (x : GaussianInt), + let c0 : GaussianInt := x + let c3 : GaussianInt := x - ⟨0, 1⟩ + (∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ T.cells) → (({q, q + 1} : Finset GaussianInt) ∈ + FootprintEdges T)) → ((∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ T.cells) → (({q + ⟨0, + 1⟩, q + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges T)) → (¬ (c3 ∈ U.cells ∧ c0 ∈ + V.cells)))) := by + classical + intro U V hedge x c0 c3 edgeBottom edgeTop + rintro ⟨hu, hv⟩ + apply hedge + exact ⟨{x, x + 1}, ⟨by convert edgeTop U c3 hu using 1; simp [c3]; ring, + by simpa [c0] using edgeBottom V c0 hv⟩⟩ + +private theorem no03 : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), (¬(FootprintEdges U ∩ FootprintEdges V).Nonempty) → (∀ + (x : GaussianInt), + let c0 : GaussianInt := x + let c3 : GaussianInt := x - ⟨0, 1⟩ + (∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ T.cells) → (({q, q + 1} : Finset GaussianInt) ∈ + FootprintEdges T)) → ((∀ (T : ProtoTile), ∀ (q : GaussianInt), (q ∈ T.cells) → (({q + ⟨0, + 1⟩, q + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges T)) → (¬ (c0 ∈ U.cells ∧ c3 ∈ + V.cells)))) := by + classical + intro U V hedge x c0 c3 edgeBottom edgeTop + rintro ⟨hu, hv⟩ + apply hedge + exact ⟨{x, x + 1}, ⟨by simpa [c0] using edgeBottom U c0 hu, + by convert edgeTop V c3 hv using 1; simp [c3]; ring⟩⟩ + +private theorem noSame0 : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), + let c0 : GaussianInt := x + (∀ (q : GaussianInt), (q ∈ U.cells) → ((q ∈ V.cells) → (False))) → (¬ (c0 ∈ U.cells ∧ c0 ∈ + V.cells)) := by + classical + intro U V x c0 hcellDisjoint + rintro ⟨hu, hv⟩ + exact hcellDisjoint c0 hu hv + +private theorem noSame1 : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), + let c1 : GaussianInt := x - 1 + (∀ (q : GaussianInt), (q ∈ U.cells) → ((q ∈ V.cells) → (False))) → (¬ (c1 ∈ U.cells ∧ c1 ∈ + V.cells)) := by + classical + intro U V x c1 hcellDisjoint + rintro ⟨hu, hv⟩ + exact hcellDisjoint c1 hu hv + +private theorem noSame2 : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + (∀ (q : GaussianInt), (q ∈ U.cells) → ((q ∈ V.cells) → (False))) → (¬ (c2 ∈ U.cells ∧ c2 ∈ + V.cells)) := by + classical + intro U V x c2 hcellDisjoint + rintro ⟨hu, hv⟩ + exact hcellDisjoint c2 hu hv + +private theorem noSame3 : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), + let c3 : GaussianInt := x - ⟨0, 1⟩ + (∀ (q : GaussianInt), (q ∈ U.cells) → ((q ∈ V.cells) → (False))) → (¬ (c3 ∈ U.cells ∧ c3 ∈ + V.cells)) := by + classical + intro U V x c3 hcellDisjoint + rintro ⟨hu, hv⟩ + exact hcellDisjoint c3 hu hv + +private theorem inExterior : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ q ∉ U.cells, q ∉ V.cells → q ∈ (↑(U.cells ∪ V.cells) + : Set GaussianInt)ᶜ := by + classical + intro U V q hu hv + change q ∉ U.cells ∪ V.cells + intro h + rcases Finset.mem_union.mp h with h | h + · exact hu h + · exact hv h + +private theorem hpne : + ∀ (p : List GaussianInt), ((4 : ℕ) ≤ p.length) → (p ≠ []) := by + classical + intro p hlen h + simp [h] at hlen + +private theorem huMem : + ∀ (W : Set GaussianInt), ∀ (F : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (u : + GaussianInt), ∀ (v : GaussianInt), (p.Nodup) → (((4 : ℕ) ≤ p.length) → ((p.head? = some + u) → ((p.getLast? = some v) → ((W = (↑p.toFinset : Set GaussianInt)) → ((∀ (a : + GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), + p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → ((∀ (e : Finset GaussianInt), e ∈ F + ↔ e = {v, u} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List + GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((3 ≤ p.length) → (( + let cyclicEdges := p.zip p.tail ++ [(v, u)]; + ∀ (q : LatticeCell), ((q + (1 : LatticeCell), q + (1 : + LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges ∧ (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 + : ℤ)⟩, q + (1 : LatticeCell)) ∉ cyclicEdges → GridRayCrossingIndex (q + (1 : + LatticeCell)) p = GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell), q + (1 : + LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 + : ℤ)⟩, q + (1 : LatticeCell)) ∈ cyclicEdges → (GridRayCrossingIndex (q + (1 : + LatticeCell)) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ)) ∧ ((q + (1 : LatticeCell) + + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges ∧ (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges → GridRayCrossingIndex (q + ⟨(0 : + ℤ), (1 : ℤ)⟩) p = GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : + ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : + LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges → (GridRayCrossingIndex (q + ⟨(0 : ℤ), + (1 : ℤ)⟩) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ))) → ((∀ (g : Finset + GaussianInt), (g ∈ F) → (g = {v, u} ∨ ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ g = {a, b})) + → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, b} : Finset GaussianInt) ∈ F) → ((a, + b) ∈ (p.zip p.tail) ++ [(v, u)] ∨ (b, a) ∈ (p.zip p.tail) ++ [(v, u)])) → ((p ≠ []) → (u + ∈ p)))))))))))) := by + classical + intro W F p u v hnodup hlen hhead hlast hvertices hsteps hedges hlen3 hcross hcycleEdge + cyclicPair hpne + rcases (List.head?_eq_some_iff.mp hhead) with ⟨l, rfl⟩ + simp + +private theorem hvMem : + ∀ (W : Set GaussianInt), ∀ (F : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (u : + GaussianInt), ∀ (v : GaussianInt), (p.Nodup) → (((4 : ℕ) ≤ p.length) → ((p.head? = some + u) → ((p.getLast? = some v) → ((W = (↑p.toFinset : Set GaussianInt)) → ((∀ (a : + GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), + p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → ((∀ (e : Finset GaussianInt), e ∈ F + ↔ e = {v, u} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List + GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((3 ≤ p.length) → (( + let cyclicEdges := p.zip p.tail ++ [(v, u)]; + ∀ (q : LatticeCell), ((q + (1 : LatticeCell), q + (1 : + LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges ∧ (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 + : ℤ)⟩, q + (1 : LatticeCell)) ∉ cyclicEdges → GridRayCrossingIndex (q + (1 : + LatticeCell)) p = GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell), q + (1 : + LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 + : ℤ)⟩, q + (1 : LatticeCell)) ∈ cyclicEdges → (GridRayCrossingIndex (q + (1 : + LatticeCell)) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ)) ∧ ((q + (1 : LatticeCell) + + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges ∧ (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges → GridRayCrossingIndex (q + ⟨(0 : + ℤ), (1 : ℤ)⟩) p = GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : + ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : + LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges → (GridRayCrossingIndex (q + ⟨(0 : ℤ), + (1 : ℤ)⟩) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ))) → ((∀ (g : Finset + GaussianInt), (g ∈ F) → (g = {v, u} ∨ ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ g = {a, b})) + → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, b} : Finset GaussianInt) ∈ F) → ((a, + b) ∈ (p.zip p.tail) ++ [(v, u)] ∨ (b, a) ∈ (p.zip p.tail) ++ [(v, u)])) → ((p ≠ []) → ((u + ∈ p) → (v ∈ p))))))))))))) := by + classical + intro W F p u v hnodup hlen hhead hlast hvertices hsteps hedges hlen3 hcross hcycleEdge + cyclicPair hpne huMem + rcases (List.getLast?_eq_some_iff.mp hlast) with ⟨l, rfl⟩ + simp + +private theorem vertexInW : + ∀ (W : Set GaussianInt), ∀ (p : List GaussianInt), (W = (↑p.toFinset : Set GaussianInt)) → (∀ + z ∈ p, z ∈ W) := by + classical + intro W p hvertices z hz + rw [hvertices] + change z ∈ p.toFinset + exact List.mem_toFinset.mpr hz + +private theorem hWfinite : + ∀ (W : Set GaussianInt), ∀ (p : List GaussianInt), (W = (↑p.toFinset : Set GaussianInt)) → + (W.Finite) := by + classical + intro W p hvertices + rw [hvertices] + exact Finset.finite_toSet _ + +private def directionOffset : Fin 4 → GaussianInt := + ![⟨0, 1⟩, 1, -⟨0, 1⟩, -1] + +private theorem dirInj : + ∀ (x : GaussianInt), (List GaussianInt) → ( + let dir : Fin 4 → GaussianInt := fun i => + match i.val with + | 0 => x + ⟨0, 1⟩ + | 1 => x + 1 + | 2 => x - ⟨0, 1⟩ + | _ => x - 1 + Function.Injective dir) := by + classical + intro x p dir + have hdir : dir = fun j => x + directionOffset j := by + funext j + fin_cases j + · rfl + · rfl + · exact sub_eq_add_neg x _ + · exact sub_eq_add_neg x _ + have hinjective : Function.Injective directionOffset := by + intro i j h + fin_cases i <;> fin_cases j + all_goals first + | rfl + | norm_num [directionOffset, Zsqrtd.ext_iff] at h + intro i j hij + rw [hdir] at hij + exact hinjective (add_left_cancel hij) + +private theorem dirNeX : + ∀ (x : GaussianInt), (List GaussianInt) → ( + let dir : Fin 4 → GaussianInt := fun i => + match i.val with + | 0 => x + ⟨0, 1⟩ + | 1 => x + 1 + | 2 => x - ⟨0, 1⟩ + | _ => x - 1 + ∀ (i : Fin (4 : ℕ)), x ≠ dir i) := by + classical + intro x p dir + have hdir : dir = fun j => x + directionOffset j := by + funext j + fin_cases j + · rfl + · rfl + · exact sub_eq_add_neg x _ + · exact sub_eq_add_neg x _ + have hnonzero : ∀ j, directionOffset j ≠ 0 := by + intro j + fin_cases j <;> norm_num [directionOffset, Zsqrtd.ext_iff] + intro i hi + rw [hdir] at hi + exact hnonzero i (add_left_cancel ((add_zero x).trans hi)).symm + +private theorem noThreeDir : + ∀ (W : Set GaussianInt), ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (p : List + GaussianInt), ∀ (u : GaussianInt), ∀ (v : GaussianInt), (p.Nodup) → (((4 : ℕ) ≤ p.length) + → ((p.head? = some u) → ((p.getLast? = some v) → ((W = (↑p.toFinset : Set GaussianInt)) → + ((FourNeighborAdjacent v u) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List + GaussianInt), ∀ (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a + b) → ((∀ (e : Finset GaussianInt), e ∈ F ↔ e = {v, u} ∨ ∃ (a : GaussianInt) (b : + GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e + = {a, b}) → ((∀ (g : Finset GaussianInt), (g ∈ F) → (g = {v, u} ∨ ∃ a b l₁ l₂, p = l₁ ++ + a :: b :: l₂ ∧ g = {a, b})) → ((u ∈ p) → ((v ∈ p) → ((∀ (z : GaussianInt), (z ∈ p) → (z ∈ + W)) → ((W.Finite) → ( + let dir : Fin 4 → GaussianInt := fun i => + match i.val with + | 0 => x + ⟨0, 1⟩ + | 1 => x + 1 + | 2 => x - ⟨0, 1⟩ + | _ => x - 1 + (Function.Injective dir) → ((∀ (i : Fin 4), x ≠ dir i) → (∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 + : ℕ)), ∀ (k : Fin (4 : ℕ)), i ≠ j → i ≠ k → j ≠ k → {x, dir i} ∈ F → {x, dir j} ∈ F → {x, + dir k} ∈ F → False))))))))))))))) := by + classical + intro W F x p u v hnodup hlen hhead hlast hvertices hclose hsteps hedges hcycleEdge huMem hvMem + vertexInW hWfinite dir dirInj dirNeX i j k hij hik hjk ha hb hc + apply (ExteriorMixedCycleProof.noThreeNeighbors W F x p u v hnodup hlen hhead hlast hvertices + hclose hsteps hedges (ExteriorMixedCycleProof.edgeEndpointInW W F p u v hcycleEdge huMem + hvMem vertexInW) hWfinite) (dir i) (dir j) (dir k) ha hb hc + (dirNeX i) (dirNeX j) (dirNeX k) + (fun h => hij (dirInj h)) (fun h => hik (dirInj h)) + (fun h => hjk (dirInj h)) + +private theorem hindexDiff : + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), + ∀ (e : Finset GaussianInt), ∀ (f : Finset GaussianInt), (x ∈ e) → ((x ∈ f) → ((e ∈ F ∩ + FootprintEdges U) → (∀ (p : List GaussianInt), ∀ (u : GaussianInt), ∀ (v : GaussianInt), + (e ∈ FootprintEdges U) → ((f ∈ FootprintEdges V) → ( + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + (¬ (c0 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ + c2 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c3 ∈ V.cells)) + → ((¬ (c3 ∈ U.cells ∧ c2 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c0 ∈ + U.cells ∧ c3 ∈ V.cells)) → ((¬ (c0 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ c1 ∈ + V.cells)) → ((¬ (c2 ∈ U.cells ∧ c2 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ c3 ∈ V.cells)) → + (((c0 ∈ U.cells ∧ c2 ∈ V.cells) ∨ (c2 ∈ U.cells ∧ c0 ∈ V.cells) ∨ (c1 ∈ U.cells ∧ c3 ∈ + V.cells) ∨ (c3 ∈ U.cells ∧ c1 ∈ V.cells)) → ((∀ (q : GaussianInt), (q ∉ U.cells) → ((q ∉ + V.cells) → (q ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ))) → ((∀ (T : ProtoTile), ∀ (g + : Finset GaussianInt), (x ∈ g) → ((g ∈ FootprintEdges T) → (∃ q ∈ T.cells, (q = c0 ∧ (g = + {x, x + ⟨0, 1⟩} ∨ g = {x, x + 1})) ∨ (q = c1 ∧ (g = {x, x + ⟨0, 1⟩} ∨ g = {x - 1, x})) ∨ + (q = c2 ∧ (g = {x - 1, x} ∨ g = {x - ⟨0, 1⟩, x})) ∨ (q = c3 ∧ (g = {x - ⟨0, 1⟩, x} ∨ g = + {x, x + 1}))))) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, b} : Finset + GaussianInt) ∈ F) → ((a, b) ∈ (p.zip p.tail) ++ [(v, u)] ∨ (b, a) ∈ (p.zip p.tail) ++ + [(v, u)])) → ( + let dir : Fin 4 → GaussianInt := fun i => + match i.val with + | 0 => x + ⟨0, 1⟩ + | 1 => x + 1 + | 2 => x - ⟨0, 1⟩ + | _ => x - 1 + (∀ (g : Finset GaussianInt), (g ∈ F) → (∀ (i : Fin 4), ∀ (j : Fin 4), ∀ (k : Fin 4), (i ≠ j) + → ((i ≠ k) → ((j ≠ k) → ((e = {x, dir i} ∨ e = {dir i, x}) → ((f = {x, dir j} ∨ f = + {dir j, x}) → ((g = {x, dir k} ∨ g = {dir k, x}) → (False)))))))) → ((∀ (a : + GaussianInt), ∀ (b : GaussianInt), ((a, b) ∈ p.zip p.tail ++ [(v, u)]) → (({a, b} : + Finset GaussianInt) ∈ F)) → ( + let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p + (∀ (q : GaussianInt), ((q + 1, q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ (q + 1 + ⟨0, 1⟩, + q + 1) ∉ p.zip p.tail ++ [(v, u)]) → (GridRayCrossingIndex (q + 1) p = + GridRayCrossingIndex q p)) → ((∀ (q : GaussianInt), ((q + 1, q + 1 + ⟨0, 1⟩) ∈ p.zip + p.tail ++ [(v, u)] ∨ (q + 1 + ⟨0, 1⟩, q + 1) ∈ p.zip p.tail ++ [(v, u)]) → + ((GridRayCrossingIndex (q + 1) p - GridRayCrossingIndex q p).natAbs = 1)) → ((∀ (q : + GaussianInt), ((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ (q + ⟨0, 1⟩, q + + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)]) → (GridRayCrossingIndex (q + ⟨0, 1⟩) p = + GridRayCrossingIndex q p)) → ((∀ (q : GaussianInt), ((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∈ p.zip + p.tail ++ [(v, u)] ∨ (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)]) → + ((GridRayCrossingIndex (q + ⟨0, 1⟩) p - GridRayCrossingIndex q p).natAbs = 1)) → ((c1 + 1 + = x) → ((c2 + 1 = x - ⟨0, 1⟩) → ((c2 + 1 + ⟨0, 1⟩ = x) → ((c2 + ⟨0, 1⟩ = x - 1) → ((c3 + + ⟨0, 1⟩ = x) → ((c3 + 1 + ⟨0, 1⟩ = x + 1) → (((c1 ∈ (↑(U.cells ∪ V.cells) : Set + GaussianInt)ᶜ ∧ c3 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ) ∧ (I c1 - I c3).natAbs = + 1) ∨ ((c0 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ ∧ c2 ∈ (↑(U.cells ∪ V.cells) : Set + GaussianInt)ᶜ) ∧ (I c0 - I c2).natAbs = 1)))))))))))))))))))))))))))))))))) := by + classical + intro U V F x e f hxe hxf he p u v hUedge hVedge c0 c1 c2 c3 no01 no10 no12 no21 no23 no32 no30 + no03 noSame0 noSame1 noSame2 noSame3 hpattern inExterior supportedRay cyclicPair dir + noExtra cyclicToEdge I crossEastEq crossEastJump crossNorthEq crossNorthJump c1add c2add + c2addi c2i c3i c3addi + let nDir : Fin 4 := 0 + let eDir : Fin 4 := 1 + let sDir : Fin 4 := 2 + let wDir : Fin 4 := 3 + have c1addi : c1 + 1 + ⟨0, 1⟩ = x + ⟨0, 1⟩ := by dsimp [c1]; ring + rcases (ExteriorCycleDetails.hsectorRay U V x e f hxe hxf hUedge hVedge no01 no10 no12 no21 + no23 no32 no30 no03 noSame0 noSame1 noSame2 noSame3 hpattern + (ExteriorMixedCycleProof.rayAt0 x supportedRay) (ExteriorMixedCycleProof.rayAt1 x + supportedRay) (ExteriorMixedCycleProof.rayAt2 x supportedRay) + (ExteriorMixedCycleProof.rayAt3 x supportedRay)) with h0 | h1 | h2 | h3 + · rcases h0 with ⟨hu0, hv2, heRay, hfRay⟩ + have hexterior := (ExteriorMixedCycleProof.exterior13A U V x no01 no12 no32 no03 inExterior) + hu0 hv2 + rcases heRay with heN | heE + · have hEabsent : ({x, x + 1} : Finset GaussianInt) ∉ F := by + intro hg + rcases hfRay with hfS | hfW + · exact noExtra _ hg nDir sDir eDir (by decide) (by decide) (by decide) + (Or.inl heN) (Or.inr hfS) (Or.inl rfl) + · exact noExtra _ hg nDir wDir eDir (by decide) (by decide) (by decide) + (Or.inl heN) (Or.inr hfW) (Or.inl rfl) + have hNcyc := cyclicPair x (x + ⟨0, 1⟩) (by simpa [heN] using he.1) + have hNjump : (I c0 - I c1).natAbs = 1 := by + have hc : (c1 + 1, c1 + 1 + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)] ∨ + (c1 + 1 + ⟨0, 1⟩, c1 + 1) ∈ p.zip p.tail ++ [(v, u)] := by + simpa [c1, c1add, c1addi] using hNcyc + have h := crossEastJump c1 hc + simpa [I, c0, c1, c1add] using h + have hEeq : I c0 = I c3 := ExteriorMixedCycleProof.hEeqAt936 F x p u v cyclicToEdge + crossNorthEq c3i hEabsent + have hneg : I c1 - I c3 = -(I c0 - I c1) := by rw [hEeq]; ring + refine Or.inl ⟨hexterior, ?_⟩ + rw [hneg, Int.natAbs_neg, hNjump] + · have hNabsent : ({x, x + ⟨0, 1⟩} : Finset GaussianInt) ∉ F := by + intro hg + rcases hfRay with hfS | hfW + · exact noExtra _ hg eDir sDir nDir (by decide) (by decide) (by decide) + (Or.inl heE) (Or.inr hfS) (Or.inl rfl) + · exact noExtra _ hg eDir wDir nDir (by decide) (by decide) (by decide) + (Or.inl heE) (Or.inr hfW) (Or.inl rfl) + have hEcyc := cyclicPair x (x + 1) (by simpa [heE] using he.1) + have hEjump : (I c0 - I c3).natAbs = 1 := by + have hc : (c3 + 1 + ⟨0, 1⟩, c3 + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)] ∨ + (c3 + ⟨0, 1⟩, c3 + 1 + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)] := by + simpa [c3, c3i, c3addi] using Or.symm hEcyc + have h := crossNorthJump c3 hc + simpa [I, c0, c3, c3i] using h + have hNeq : I c0 = I c1 := ExteriorMixedCycleProof.hNeqAt966 F x p u v cyclicToEdge + crossEastEq c1add hNabsent + refine Or.inl ⟨hexterior, ?_⟩ + rw [← hNeq] + exact hEjump + · rcases h1 with ⟨hu2, hv0, heRay, hfRay⟩ + have hexterior := (ExteriorMixedCycleProof.exterior13B U V x no10 no21 no23 no30 inExterior) + hu2 hv0 + rcases heRay with heW | heS + · have hSabsent : ({x - ⟨0, 1⟩, x} : Finset GaussianInt) ∉ F := by + intro hg + rcases hfRay with hfN | hfE + · exact noExtra _ hg wDir nDir sDir (by decide) (by decide) (by decide) + (Or.inr heW) (Or.inl hfN) (Or.inr rfl) + · exact noExtra _ hg wDir eDir sDir (by decide) (by decide) (by decide) + (Or.inr heW) (Or.inl hfE) (Or.inr rfl) + have hWcyc := cyclicPair (x - 1) x (by simpa [heW] using he.1) + have hWjump : (I c1 - I c2).natAbs = 1 := by + have hc : (c2 + 1 + ⟨0, 1⟩, c2 + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)] ∨ + (c2 + ⟨0, 1⟩, c2 + 1 + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)] := by + simpa [c2, c2addi, c2i] using Or.symm hWcyc + have h := crossNorthJump c2 hc + simpa [I, c1, c2, c2i] using h + have hSeq : I c3 = I c2 := ExteriorMixedCycleProof.hSeqAt999 F x p u v cyclicToEdge + crossEastEq c2add hSabsent + refine Or.inl ⟨hexterior, ?_⟩ + rw [hSeq] + exact hWjump + · have hWabsent : ({x - 1, x} : Finset GaussianInt) ∉ F := by + intro hg + rcases hfRay with hfN | hfE + · exact noExtra _ hg sDir nDir wDir (by decide) (by decide) (by decide) + (Or.inr heS) (Or.inl hfN) (Or.inr rfl) + · exact noExtra _ hg sDir eDir wDir (by decide) (by decide) (by decide) + (Or.inr heS) (Or.inl hfE) (Or.inr rfl) + have hScyc := cyclicPair (x - ⟨0, 1⟩) x (by simpa [heS] using he.1) + have hSjump : (I c3 - I c2).natAbs = 1 := by + have hc : (c2 + 1, c2 + 1 + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)] ∨ + (c2 + 1 + ⟨0, 1⟩, c2 + 1) ∈ p.zip p.tail ++ [(v, u)] := by + simpa [c2, c2add] using hScyc + have h := crossEastJump c2 hc + simpa [I, c2, c3, c2add] using h + have hWeq : I c1 = I c2 := ExteriorMixedCycleProof.hWeqAt1029 F x p u v cyclicToEdge + crossNorthEq c2addi c2i hWabsent + have hneg : I c1 - I c3 = -(I c3 - I c2) := by rw [hWeq]; ring + refine Or.inl ⟨hexterior, ?_⟩ + rw [hneg, Int.natAbs_neg, hSjump] + · rcases h2 with ⟨hu1, hv3, heRay, hfRay⟩ + have hexterior := (ExteriorMixedCycleProof.exterior02A U V x no10 no12 no23 no03 inExterior) + hu1 hv3 + rcases heRay with heN | heW + · have hWabsent : ({x - 1, x} : Finset GaussianInt) ∉ F := by + intro hg + rcases hfRay with hfS | hfE + · exact noExtra _ hg nDir sDir wDir (by decide) (by decide) (by decide) + (Or.inl heN) (Or.inr hfS) (Or.inr rfl) + · exact noExtra _ hg nDir eDir wDir (by decide) (by decide) (by decide) + (Or.inl heN) (Or.inl hfE) (Or.inr rfl) + have hNcyc := cyclicPair x (x + ⟨0, 1⟩) (by simpa [heN] using he.1) + have hNjump : (I c0 - I c1).natAbs = 1 := by + have hc : (c1 + 1, c1 + 1 + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)] ∨ + (c1 + 1 + ⟨0, 1⟩, c1 + 1) ∈ p.zip p.tail ++ [(v, u)] := by + simpa [c1, c1add, c1addi] using hNcyc + have h := crossEastJump c1 hc + simpa [I, c0, c1, c1add] using h + have hWeq : I c1 = I c2 := ExteriorMixedCycleProof.hWeqAt1062 F x p u v cyclicToEdge + crossNorthEq c2addi c2i hWabsent + refine Or.inr ⟨hexterior, ?_⟩ + have hneg : I c0 - I c2 = I c0 - I c1 := by rw [hWeq] + rw [hneg] + exact hNjump + · have hNabsent : ({x, x + ⟨0, 1⟩} : Finset GaussianInt) ∉ F := by + intro hg + rcases hfRay with hfS | hfE + · exact noExtra _ hg wDir sDir nDir (by decide) (by decide) (by decide) + (Or.inr heW) (Or.inr hfS) (Or.inl rfl) + · exact noExtra _ hg wDir eDir nDir (by decide) (by decide) (by decide) + (Or.inr heW) (Or.inl hfE) (Or.inl rfl) + have hWcyc := cyclicPair (x - 1) x (by simpa [heW] using he.1) + have hWjump : (I c1 - I c2).natAbs = 1 := by + have hc : (c2 + 1 + ⟨0, 1⟩, c2 + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)] ∨ + (c2 + ⟨0, 1⟩, c2 + 1 + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)] := by + simpa [c2, c2addi, c2i] using Or.symm hWcyc + have h := crossNorthJump c2 hc + simpa [I, c1, c2, c2i] using h + have hNeq : I c0 = I c1 := ExteriorMixedCycleProof.hNeqAt1093 F x p u v cyclicToEdge + crossEastEq c1add hNabsent + refine Or.inr ⟨hexterior, ?_⟩ + have hEq : I c0 - I c2 = I c1 - I c2 := by rw [hNeq] + rw [hEq] + exact hWjump + · rcases h3 with ⟨hu3, hv1, heRay, hfRay⟩ + have hexterior := (ExteriorMixedCycleProof.exterior02B U V x no01 no21 no32 no30 inExterior) + hu3 hv1 + rcases heRay with heS | heE + · have hEabsent : ({x, x + 1} : Finset GaussianInt) ∉ F := by + intro hg + rcases hfRay with hfN | hfW + · exact noExtra _ hg sDir nDir eDir (by decide) (by decide) (by decide) + (Or.inr heS) (Or.inl hfN) (Or.inl rfl) + · exact noExtra _ hg sDir wDir eDir (by decide) (by decide) (by decide) + (Or.inr heS) (Or.inr hfW) (Or.inl rfl) + have hScyc := cyclicPair (x - ⟨0, 1⟩) x (by simpa [heS] using he.1) + have hSjump : (I c3 - I c2).natAbs = 1 := by + have hc : (c2 + 1, c2 + 1 + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)] ∨ + (c2 + 1 + ⟨0, 1⟩, c2 + 1) ∈ p.zip p.tail ++ [(v, u)] := by + simpa [c2, c2add] using hScyc + have h := crossEastJump c2 hc + simpa [I, c2, c3, c2add] using h + have hEeq : I c0 = I c3 := ExteriorMixedCycleProof.hEeqAt1127 F x p u v cyclicToEdge + crossNorthEq c3i hEabsent + refine Or.inr ⟨hexterior, ?_⟩ + have hEq : I c0 - I c2 = I c3 - I c2 := by rw [hEeq] + rw [hEq] + exact hSjump + · have hSabsent : ({x - ⟨0, 1⟩, x} : Finset GaussianInt) ∉ F := by + intro hg + rcases hfRay with hfN | hfW + · exact noExtra _ hg eDir nDir sDir (by decide) (by decide) (by decide) + (Or.inl heE) (Or.inl hfN) (Or.inr rfl) + · exact noExtra _ hg eDir wDir sDir (by decide) (by decide) (by decide) + (Or.inl heE) (Or.inr hfW) (Or.inr rfl) + have hEcyc := cyclicPair x (x + 1) (by simpa [heE] using he.1) + have hEjump : (I c0 - I c3).natAbs = 1 := by + have hc : (c3 + 1 + ⟨0, 1⟩, c3 + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)] ∨ + (c3 + ⟨0, 1⟩, c3 + 1 + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)] := by + simpa [c3, c3i, c3addi] using Or.symm hEcyc + have h := crossNorthJump c3 hc + simpa [I, c0, c3, c3i] using h + have hSeq : I c3 = I c2 := ExteriorMixedCycleProof.hSeqAt1158 F x p u v cyclicToEdge + crossEastEq c2add hSabsent + refine Or.inr ⟨hexterior, ?_⟩ + have hEq : I c0 - I c2 = I c0 - I c3 := by rw [hSeq] + rw [hEq] + exact hEjump + +end ExteriorIndexCases + +theorem P3963T1ExteriorMixedCycleObstruction + (U V : ProtoTile) + (hdisjoint : Disjoint U.cells V.cells) + (hedge : ¬ (FootprintEdges U ∩ FootprintEdges V).Nonempty) + (houtside : FourNeighborConnected + ((↑(U.cells ∪ V.cells) : Set LatticeCell)ᶜ)) + (W : Set GaussianInt) (F : Set (Finset GaussianInt)) + (hcycle : SimpleGridCycle W F) + (hsubset : F ⊆ FootprintEdges U ∪ FootprintEdges V) + (x : GaussianInt) (e f : Finset GaussianInt) + (hxe : x ∈ e) (hxf : x ∈ f) + (he : e ∈ F ∩ FootprintEdges U) + (hf : f ∈ F ∩ FootprintEdges V) : False := by +-- BODY + rcases hcycle with ⟨p, u, v, hnodup, hlen, hhead, hlast, hvertices, + hclose, hsteps, hedges⟩ + have hlen3 : 3 ≤ p.length := by omega + have hcross := GridRayCrossingIndexAdjacentCell p u v hhead hlast hnodup + hlen3 (ExteriorMixedCycleProof.hadj p hlen hsteps) hclose + have hmixed : e ≠ f := ExteriorIndexCases.hmixed U V hedge F e f he hf + have hUedge : e ∈ FootprintEdges U := he.2 + have hVedge : f ∈ FootprintEdges V := hf.2 + have hcycleEdge (g : Finset GaussianInt) (hg : g ∈ F) : + g = {v, u} ∨ ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ g = {a, b} := + (hedges g).mp hg + let c0 : GaussianInt := x + let c1 : GaussianInt := x - 1 + let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ + let c3 : GaussianInt := x - ⟨0, 1⟩ + have pairEq (a b c d : GaussianInt) (ha : a = c) (hb : b = d) : + ({a, b} : Finset GaussianInt) = {c, d} := ExteriorIndexCases.pairEq a b c d ha hb + have incident (T : ProtoTile) (g : Finset GaussianInt) + (hxg : x ∈ g) (hg : g ∈ FootprintEdges T) : + ∃ q ∈ T.cells, q = c0 ∨ q = c1 ∨ q = c2 ∨ q = c3 := ExteriorMixedCycleProof.incident x T g + hxg hg + have hOccU := incident U e hxe hUedge + have hOccV := incident V f hxf hVedge + have edgeLeft (T : ProtoTile) (q : GaussianInt) (hq : q ∈ T.cells) : + ({q, q + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges T := ExteriorIndexCases.edgeLeft T + q hq + have edgeBottom (T : ProtoTile) (q : GaussianInt) (hq : q ∈ T.cells) : + ({q, q + 1} : Finset GaussianInt) ∈ FootprintEdges T := ExteriorIndexCases.edgeBottom T q hq + have edgeRight (T : ProtoTile) (q : GaussianInt) (hq : q ∈ T.cells) : + ({q + 1, q + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges T := + ExteriorIndexCases.edgeRight T q hq + have edgeTop (T : ProtoTile) (q : GaussianInt) (hq : q ∈ T.cells) : + ({q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges T := + ExteriorIndexCases.edgeTop T q hq + have no01 : ¬ (c0 ∈ U.cells ∧ c1 ∈ V.cells) := ExteriorIndexCases.no01 U V hedge x edgeLeft + edgeRight + have no10 : ¬ (c1 ∈ U.cells ∧ c0 ∈ V.cells) := ExteriorIndexCases.no10 U V hedge x edgeLeft + edgeRight + have no12 : ¬ (c1 ∈ U.cells ∧ c2 ∈ V.cells) := ExteriorIndexCases.no12 U V hedge x edgeBottom + edgeTop + have no21 : ¬ (c2 ∈ U.cells ∧ c1 ∈ V.cells) := ExteriorIndexCases.no21 U V hedge x edgeBottom + edgeTop + have no23 : ¬ (c2 ∈ U.cells ∧ c3 ∈ V.cells) := ExteriorIndexCases.no23 U V hedge x edgeLeft + edgeRight + have no32 : ¬ (c3 ∈ U.cells ∧ c2 ∈ V.cells) := ExteriorIndexCases.no32 U V hedge x edgeLeft + edgeRight + have no30 : ¬ (c3 ∈ U.cells ∧ c0 ∈ V.cells) := ExteriorIndexCases.no30 U V hedge x edgeBottom + edgeTop + have no03 : ¬ (c0 ∈ U.cells ∧ c3 ∈ V.cells) := ExteriorIndexCases.no03 U V hedge x edgeBottom + edgeTop + have hcellDisjoint (q : GaussianInt) (hu : q ∈ U.cells) + (hv : q ∈ V.cells) : False := (Finset.disjoint_left.mp hdisjoint) hu hv + have noSame0 : ¬ (c0 ∈ U.cells ∧ c0 ∈ V.cells) := ExteriorIndexCases.noSame0 U V x hcellDisjoint + have noSame1 : ¬ (c1 ∈ U.cells ∧ c1 ∈ V.cells) := ExteriorIndexCases.noSame1 U V x hcellDisjoint + have noSame2 : ¬ (c2 ∈ U.cells ∧ c2 ∈ V.cells) := ExteriorIndexCases.noSame2 U V x hcellDisjoint + have noSame3 : ¬ (c3 ∈ U.cells ∧ c3 ∈ V.cells) := ExteriorIndexCases.noSame3 U V x hcellDisjoint + have hpattern : + (c0 ∈ U.cells ∧ c2 ∈ V.cells) ∨ (c2 ∈ U.cells ∧ c0 ∈ V.cells) ∨ + (c1 ∈ U.cells ∧ c3 ∈ V.cells) ∨ (c3 ∈ U.cells ∧ c1 ∈ V.cells) := + ExteriorMixedCycleProof.hpattern U V x hOccU hOccV no01 no10 no12 no21 no23 no32 no30 + no03 noSame0 noSame1 noSame2 noSame3 + have inExterior (q : GaussianInt) (hu : q ∉ U.cells) + (hv : q ∉ V.cells) : q ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ := + ExteriorIndexCases.inExterior U V q hu hv + have hExteriorPair : + (c1 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ ∧ + c3 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ) ∨ + (c0 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ ∧ + c2 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ) := ExteriorMixedCycleProof.hExteriorPair + U V x no01 no10 no12 no21 no23 no32 no30 no03 hpattern inExterior + have pairCases (a b c d : GaussianInt) + (hpair : ({a, b} : Finset GaussianInt) = {c, d}) (hcd : c ≠ d) : + (a = c ∧ b = d) ∨ (a = d ∧ b = c) := ExteriorMixedCycleProof.pairCases a b c d hpair hcd + have supportedRay (T : ProtoTile) (g : Finset GaussianInt) + (hxg : x ∈ g) (hg : g ∈ FootprintEdges T) : + ∃ q ∈ T.cells, + (q = c0 ∧ (g = {x, x + ⟨0, 1⟩} ∨ g = {x, x + 1})) ∨ + (q = c1 ∧ (g = {x, x + ⟨0, 1⟩} ∨ g = {x - 1, x})) ∨ + (q = c2 ∧ (g = {x - 1, x} ∨ g = {x - ⟨0, 1⟩, x})) ∨ + (q = c3 ∧ (g = {x - ⟨0, 1⟩, x} ∨ g = {x, x + 1})) := ExteriorMixedCycleProof.supportedRay + x pairEq T g hxg hg + have cyclicPair (a b : GaussianInt) (hab : ({a, b} : Finset GaussianInt) ∈ F) : + (a, b) ∈ (p.zip p.tail) ++ [(v, u)] ∨ + (b, a) ∈ (p.zip p.tail) ++ [(v, u)] := ExteriorMixedCycleProof.cyclicPair F p u v hhead + hlast hclose hsteps hedges hcross hcycleEdge (ExteriorMixedCycleProof.adjNe p) + pairCases (ExteriorMixedCycleProof.adjacentMemZip) a b hab + have hpne : p ≠ [] := ExteriorIndexCases.hpne p hlen + have huMem : u ∈ p := ExteriorIndexCases.huMem W F p u v hnodup hlen hhead hlast hvertices + hsteps hedges hlen3 hcross hcycleEdge cyclicPair hpne + have hvMem : v ∈ p := ExteriorIndexCases.hvMem W F p u v hnodup hlen hhead hlast hvertices + hsteps hedges hlen3 hcross hcycleEdge cyclicPair hpne huMem + have vertexInW (z : GaussianInt) (hz : z ∈ p) : z ∈ W := ExteriorIndexCases.vertexInW W p + hvertices z hz + have hWfinite : W.Finite := ExteriorIndexCases.hWfinite W p hvertices + have exteriorNoTile (q : GaussianInt) + (hq : q ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ) : + q ∉ U.cells ∧ q ∉ V.cells := ExteriorMixedCycleProof.exteriorNoTile U V q hq + let dir : Fin 4 → GaussianInt := fun i => + match i.val with + | 0 => x + ⟨0, 1⟩ + | 1 => x + 1 + | 2 => x - ⟨0, 1⟩ + | _ => x - 1 + let nDir : Fin 4 := 0 + let eDir : Fin 4 := 1 + let sDir : Fin 4 := 2 + let wDir : Fin 4 := 3 + have dirInj : Function.Injective dir := ExteriorIndexCases.dirInj x p + have dirNeX (i : Fin 4) : x ≠ dir i := ExteriorIndexCases.dirNeX x p i + have noThreeDir (i j k : Fin 4) + (hij : i ≠ j) (hik : i ≠ k) (hjk : j ≠ k) + (ha : ({x, dir i} : Finset GaussianInt) ∈ F) + (hb : ({x, dir j} : Finset GaussianInt) ∈ F) + (hc : ({x, dir k} : Finset GaussianInt) ∈ F) : False := ExteriorIndexCases.noThreeDir W F x + p u v hnodup hlen hhead hlast hvertices hclose hsteps hedges hcycleEdge huMem hvMem + vertexInW hWfinite dirInj dirNeX i j k hij hik hjk ha hb hc + have noExtra (g : Finset GaussianInt) (hg : g ∈ F) + (i j k : Fin 4) (hij : i ≠ j) (hik : i ≠ k) (hjk : j ≠ k) + (hea : e = {x, dir i} ∨ e = {dir i, x}) + (hfb : f = {x, dir j} ∨ f = {dir j, x}) + (hgc : g = {x, dir k} ∨ g = {dir k, x}) : False := ExteriorMixedCycleProof.noExtra U V F x + e f he hf noThreeDir g hg i j k hij hik hjk hea hfb hgc + have cyclicToEdge (a b : GaussianInt) + (hab : (a, b) ∈ p.zip p.tail ++ [(v, u)]) : + ({a, b} : Finset GaussianInt) ∈ F := ExteriorMixedCycleProof.cyclicToEdge F p u v hlen + hhead hlast hclose hedges hcross hcycleEdge cyclicPair huMem hvMem a b hab + let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p + have crossEastEq (q : GaussianInt) + (hnc : (q + 1, q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ + (q + 1 + ⟨0, 1⟩, q + 1) ∉ p.zip p.tail ++ [(v, u)]) : + GridRayCrossingIndex (q + 1) p = GridRayCrossingIndex q p := + (hcross q).1 hnc + have crossEastJump (q : GaussianInt) + (hcyc : (q + 1, q + 1 + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)] ∨ + (q + 1 + ⟨0, 1⟩, q + 1) ∈ p.zip p.tail ++ [(v, u)]) : + (GridRayCrossingIndex (q + 1) p - GridRayCrossingIndex q p).natAbs = 1 := + (hcross q).2.1 hcyc + have crossNorthEq (q : GaussianInt) + (hnc : (q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ + (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)]) : + GridRayCrossingIndex (q + ⟨0, 1⟩) p = GridRayCrossingIndex q p := + (hcross q).2.2.1 hnc + have crossNorthJump (q : GaussianInt) + (hcyc : (q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)] ∨ + (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) ∈ p.zip p.tail ++ [(v, u)]) : + (GridRayCrossingIndex (q + ⟨0, 1⟩) p - GridRayCrossingIndex q p).natAbs = 1 := + (hcross q).2.2.2 hcyc + have c1add : c1 + 1 = x := by dsimp [c1]; ring + have c1addi : c1 + 1 + ⟨0, 1⟩ = x + ⟨0, 1⟩ := by dsimp [c1]; ring + have c2add : c2 + 1 = x - ⟨0, 1⟩ := by dsimp [c2]; ring + have c2addi : c2 + 1 + ⟨0, 1⟩ = x := by dsimp [c2]; ring + have c2i : c2 + ⟨0, 1⟩ = x - 1 := by dsimp [c2]; ring + have c3i : c3 + ⟨0, 1⟩ = x := by dsimp [c3]; ring + have c3addi : c3 + 1 + ⟨0, 1⟩ = x + 1 := by dsimp [c3]; ring + have hindexDiff : + ((c1 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ ∧ + c3 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ) ∧ + (I c1 - I c3).natAbs = 1) ∨ + ((c0 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ ∧ + c2 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ) ∧ + (I c0 - I c2).natAbs = 1) := ExteriorIndexCases.hindexDiff U V F x e f hxe hxf he p u + v hUedge hVedge no01 no10 no12 no21 no23 no32 no30 no03 noSame0 noSame1 noSame2 + noSame3 hpattern inExterior supportedRay cyclicPair noExtra cyclicToEdge + crossEastEq crossEastJump crossNorthEq crossNorthJump c1add c2add c2addi c2i c3i + c3addi + have walkConstExterior := (ExteriorCycleDetails.walkConst) + ((↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ) I (ExteriorCycleDetails.indexAdjacentExterior U V + F p u v cyclicToEdge crossEastEq crossNorthEq (ExteriorMixedCycleProof.verticalNoF U V F + hsubset exteriorNoTile (ExteriorMixedCycleProof.verticalSupport p pairCases)) + (ExteriorMixedCycleProof.horizontalNoF U V F hsubset exteriorNoTile + (ExteriorMixedCycleProof.horizontalSupport p pairCases))) + rcases hindexDiff with ⟨⟨ha, hb⟩, hd⟩ | ⟨⟨ha, hb⟩, hd⟩ + · rcases houtside.2 c1 ha c3 hb with ⟨walk, hh, hl, hv, hs⟩ + have hsame := walkConstExterior walk c1 c3 hh hl hv hs + rw [hsame] at hd + norm_num at hd + · rcases houtside.2 c0 ha c2 hb with ⟨walk, hh, hl, hv, hs⟩ + have hsame := walkConstExterior walk c0 c2 hh hl hv hs + rw [hsame] at hd + norm_num at hd + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean new file mode 100644 index 0000000000..6ffb74760f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean @@ -0,0 +1,1549 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle +public import Mathlib.Data.List.TakeWhile +public import Mathlib.Data.List.Cycle + +-- [TABLET NODE: P3963T1MixedBoundaryCycle] + +/-! +# P3963T1MixedBoundaryCycle + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace MixedBoundaryCycleProof + +private theorem rotate_chain : + ∀ (p : List GaussianInt), ∀ (k : Nat), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (p.head? = + some a) → ((p.getLast? = some b) → ((FourNeighborAdjacent b a) → ((p.IsChain + FourNeighborAdjacent) → ((k < p.length) → ((p.rotate k).IsChain FourNeighborAdjacent))))) + := by + classical + intro p k a b hh ht hc hchain hk + by_cases hz : k = 0 + · simp? [hz] + exact hchain + · have hp : 0 < k := Nat.pos_of_ne_zero hz + rw [List.rotate_eq_drop_append_take (Nat.le_of_lt hk)] + apply List.isChain_append.mpr + refine ⟨hchain.drop k, hchain.take k, ?_⟩ + intro u hu v hv + have hu' : u ∈ p.getLast? := by + simpa only [List.getLast?_drop, ite_eq_right (Nat.not_le_of_gt hk)] using hu + have hv' : v ∈ p.head? := by + simpa only [List.head?_take, ite_eq_right (Nat.ne_of_gt hp)] using hv + simp_all + +private theorem sourceEdgeChain : + ∀ (p : List GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (E : Set (Finset + GaussianInt)), (p.head? = some a) → ((p.getLast? = some b) → ((({b, a} : Finset + GaussianInt) ∈ E) → ((∀ u, ∀ v, ∀ l₁, ∀ l₂, p = l₁ ++ u :: v :: l₂ → ({u, v} : Finset + GaussianInt) + ∈ E) → (Cycle.Chain (fun u v => ({u, v} : Finset GaussianInt) ∈ E) (p : Cycle + GaussianInt))))) := by + classical + intro p a b E hh ht hcloseE hedges + have hsource : p.IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E) := by + rw [List.isChain_iff_forall_rel_of_append_cons_cons] + intro u v l₁ l₂ heq + exact hedges u v l₁ l₂ heq + have hfull : (p ++ [a]).IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E) := by + apply List.IsChain.append hsource (by simp) + intro u hu v hv + have hu' : u = b := by simpa [ht] using hu.symm + have hv' : v = a := by simpa using hv.symm + subst u + subst v + exact hcloseE + obtain ⟨tail, hshape⟩ := (List.head?_eq_some_iff).mp hh + rw [hshape, Cycle.chain_coe_cons] + simpa [hshape] using hfull + +private theorem hc₁x : + ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), (x ∈ p₁) → (∀ (z : GaussianInt), (z ≠ x) → ( + let c₁ := p₁.rotate (p₁.idxOf z) + (c₁.head? = some z) → (x ∈ c₁.tail))) := by + classical + intro p₁ x hx₁ z hzx c₁ hrot₁z + have hmemx : x ∈ c₁ := by + simpa [c₁] using + (List.mem_rotate (l := p₁) (a := x) (n := p₁.idxOf z)).mpr hx₁ + obtain ⟨tl, ht⟩ := (List.head?_eq_some_iff).mp (by simpa [c₁] using hrot₁z) + simp only [c₁] at hmemx + rw [ht] at hmemx + simp only [List.mem_cons] at hmemx + rcases hmemx with h | h + · exact (hzx h.symm).elim + · simpa [c₁, ht] using h + +private theorem hcross : + ∀ (V₁ : Set GaussianInt), ∀ (V₂ : Set GaussianInt), ∀ (E₁ : Set (Finset GaussianInt)), ∀ (E₂ + : Set (Finset GaussianInt)), ∀ (p₁ : List GaussianInt), (V₁ = (↑p₁.toFinset : Set + GaussianInt)) → (∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (x + ∈ V₁ ∩ V₂) → ((x ≠ y) → ((x ∈ p₁) → ((x ∈ p₂) → ((p₁.idxOf x < p₁.length) → ((p₂.idxOf x + < p₂.length) → (((p₁.rotate (p₁.idxOf x)).head? = some x) → (((p₂.rotate (p₂.idxOf + x)).head? = some x) → (((p₂.rotate (p₂.idxOf x)).IsChain FourNeighborAdjacent) → ( + let c₂ := p₂.rotate (p₂.idxOf x) + (y ∈ c₂) → ((c₂.Nodup) → ((y ∈ c₂.tail) → ( + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + let rest₂ := c₂.tail.dropWhile good + (rest₂ ≠ []) → (∀ (z : GaussianInt), ∀ (zs : List GaussianInt), (rest₂ = z :: zs) → ((z ∈ V₁) + → ((c₂.tail.takeWhile good ++ rest₂ = c₂.tail) → ((z ∈ c₂.tail) → ((x ∉ c₂.tail) → ((z ≠ + x) → (((x :: (c₂.tail.takeWhile good ++ [z])).head? = some x) → ( + let c₁ := p₁.rotate (p₁.idxOf z) + (p₁.idxOf z < p₁.length) → ((c₁.head? = some z) → ((c₁ = z :: c₁.tail) → ((x ∈ c₁.tail) → + ((c₁.Nodup) → ( + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + let rest₁ := c₁.tail.dropWhile good₁ + (rest₁ ≠ []) → (∀ (w : GaussianInt), ∀ (ws : List GaussianInt), (rest₁ = w :: ws) → ((w = x) + → ((c₁.tail.takeWhile good₁ ++ rest₁ = c₁.tail) → ((x ∈ (z :: (c₁.tail.takeWhile good₁ ++ + [x])).toFinset) → ( + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + (R.head? = some z) → ((R.getLast? = some x) → ( + let prefix₂ := c₂.tail.takeWhile good + (c₂ = x :: c₂.tail) → ((c₂.tail = prefix₂ ++ z :: zs) → ( + let prefix₁ := c₁.tail.takeWhile good₁ + (c₁.IsChain FourNeighborAdjacent) → (((p₂ : Cycle GaussianInt) = (c₂ : Cycle GaussianInt)) → + ((Cycle.Chain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₂) (c₂ : Cycle GaussianInt)) → + (((x :: (c₂.tail ++ [x])).IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₂)) → + (((p₁ : Cycle GaussianInt) = (c₁ : Cycle GaussianInt)) → ((Cycle.Chain (fun u v => ({u, + v} : Finset GaussianInt) ∈ E₁) (c₁ : Cycle GaussianInt)) → (((z :: (c₁.tail ++ + [z])).IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁)) → ( + let Q := x :: (prefix₂ ++ [z]) + (Q.getLast? = some z) → ((Q = List.take (prefix₂.length + 2) (x :: (c₂.tail ++ [x]))) → + ((Q.IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₂)) → ((c₁.tail = prefix₁ ++ x + :: ws) → ((R = List.take (prefix₁.length + 2) (z :: (c₁.tail ++ [z]))) → ((R.IsChain (fun + u v => ({u, v} : Finset GaussianInt) ∈ E₁)) → ((R.tail.IsChain (fun u v => ({u, v} : + Finset GaussianInt) ∈ E₁)) → ((∀ v ∈ R.tail.head?, ({z, v} : Finset GaussianInt) ∈ E₁) → ( + let edgeRel (u v : GaussianInt) : Prop := + ({u, v} : Finset GaussianInt) ∈ E₁ ∪ E₂ + (Q.IsChain edgeRel) → ((R.tail.IsChain edgeRel) → (((Q ++ R.tail).IsChain edgeRel) → ((Q = + c₂.take (prefix₂.length + 2)) → ((Q.IsChain FourNeighborAdjacent) → ((R = c₁.take + (prefix₁.length + 2)) → ((R.IsChain FourNeighborAdjacent) → ((Q.Nodup) → ((prefix₁.Nodup) + → ((x ∉ prefix₁) → ((z ∉ prefix₁) → (∀ v ∈ Q, ∀ w ∈ prefix₁, v ≠ + w))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) := by + classical + intro V₁ V₂ E₁ E₂ p₁ hV₁ p₂ x y hx hxy hx₁ hx₂ hidx₁x hidx₂x hrot₁x hrot₂x hc₂chain c₂ hc₂y + hc₂nodup hc₂tail good rest₂ hrest₂ne z zs hrest₂ hzV₁ hdecomp₂ hzTail hxNotTail hzx hq2head + c₁ hidx₁z hrot₁z hc₁shape hc₁x hc₁nodup good₁ rest₁ hrest₁ne w ws hrest₁ hwx hdecomp₁ hxR R + hRhead hRlast prefix₂ hc₂shape hdecomp₂' prefix₁ hc₁chain hp₂cycleeq hc₂edgeCycle + hc₂edgeChain hp₁cycleeq hc₁edgeCycle hc₁edgeChain Q hQlast hQedgePrefix hQedge hdecomp₁' + hRedgePrefix hRedge hRtailE₁ hRstepE₁ edgeRel hQunion hRtailUnion hPplusUnion hQprefix + hQchain hRprefix hRchain hQnodup hprefix₁nodup hxnotprefix₁ hznotprefix₁ v hv w hw heq + subst w + have hwgood := List.mem_takeWhile_imp hw + have hwV₁ : v ∈ V₁ := by + have hvtail : v ∈ c₁.tail := List.takeWhile_subset good₁ hw + have hvc₁ : v ∈ c₁ := by + rw [hc₁shape] + exact List.mem_cons_of_mem z hvtail + have hvp₁ : v ∈ p₁ := + (List.mem_rotate (l := p₁) (a := v) (n := p₁.idxOf z)).mp hvc₁ + rw [hV₁] + exact List.mem_toFinset.mpr hvp₁ + simp? [Q] at hv + rcases hv with rfl | hv | rfl + · exact hxnotprefix₁ hw + · have hvnot : v ∉ V₁ := by + have hgood := List.mem_takeWhile_imp hv + simpa [good] using hgood + exact hvnot hwV₁ + · exact hznotprefix₁ hw + +private theorem parityStep : + let parity (u : GaussianInt) : ZMod 2 := (u.re : ZMod 2) + (u.im : ZMod 2) + ∀ {u : GaussianInt}, ∀ {w : GaussianInt}, (FourNeighborAdjacent u w) → (parity w = parity u + + 1) := by + classical + intro parity u w h + have hneg : (-1 : ZMod 2) = 1 := by decide + rcases h with h | h | h | h + · rw [h] + simp [parity, Zsqrtd.re_add, Zsqrtd.im_add] + ring + · rw [h] + simp [parity, Zsqrtd.re_sub, Zsqrtd.im_sub] + ring_nf + rw [hneg] + · rw [h] + simp [parity, Zsqrtd.re_add, Zsqrtd.im_add] + ring + · rw [h] + simp [parity, Zsqrtd.re_sub, Zsqrtd.im_sub] + ring_nf + rw [hneg] + +private theorem hpNotTwo : + ∀ (V₁ : Set GaussianInt), ∀ (E₁ : Set (Finset GaussianInt)), ∀ (E₂ : Set (Finset + GaussianInt)), (Disjoint E₁ E₂) → (∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), + ∀ (x : GaussianInt), (GaussianInt) → ( + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + (Q.IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₂)) → ((R.IsChain (fun u v => ({u, v} + : Finset GaussianInt) ∈ E₁)) → ( + let p := Q ++ prefix₁ + p.length ≠ 2))))) := by + classical + intro V₁ E₁ E₂ hdisjoint p₁ p₂ x y c₂ good z c₁ good₁ w R prefix₂ prefix₁ Q hQedge hRedge p hlen + have hlenparts : Q.length + prefix₁.length = 2 := by simpa [p, List.length_append] using hlen + have hQlen : Q.length = prefix₂.length + 2 := by simp [Q] + have hpref₂ : prefix₂ = [] := by + have : prefix₂.length = 0 := by omega + exact List.eq_nil_iff_length_eq_zero.mpr this + have hpref₁ : prefix₁ = [] := by + have : prefix₁.length = 0 := by omega + exact List.eq_nil_iff_length_eq_zero.mpr this + have hQeq : Q = [x, z] := by simp [Q, hpref₂] + have hReq : R = [z, x] := by simp [R, prefix₁, hpref₁] + have he₂ : ({x, z} : Finset GaussianInt) ∈ E₂ := by + have hq : ([x, z] : List GaussianInt).IsChain + (fun u w => ({u, w} : Finset GaussianInt) ∈ E₂) := by + simpa [hQeq] using hQedge + simpa using (List.isChain_pair.mp hq) + have he₁ : ({x, z} : Finset GaussianInt) ∈ E₁ := by + have hr : ([z, x] : List GaussianInt).IsChain + (fun u w => ({u, w} : Finset GaussianInt) ∈ E₁) := by + simpa [hReq] using hRedge + simpa [Finset.pair_comm] using (List.isChain_pair.mp hr) + exact (Set.disjoint_left.mp hdisjoint) he₁ he₂ + +private theorem hpNotThree : + ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : + GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + let p := Q ++ prefix₁ + ∀ (hpne : p ≠ []), (FourNeighborAdjacent (p.getLast hpne) x) → ((p.head? = some x) → ( + let parity (u : GaussianInt) : ZMod 2 := (u.re : ZMod 2) + (u.im : ZMod 2) + (∀ {u : GaussianInt}, ∀ {w : GaussianInt}, (FourNeighborAdjacent u w) → (parity w = parity u + + 1)) → ((∀ a, ∀ b, ∀ l₁, ∀ l₂, p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → + (p.length ≠ + 3))))) := by + classical + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p hpne hcloseP hphead parity parityStep + hadjP hlen + obtain ⟨u, w, t, hshape⟩ := List.length_eq_three.mp hlen + have huw : FourNeighborAdjacent u w := hadjP u w [] [t] (by simp [hshape]) + have hwt : FourNeighborAdjacent w t := hadjP w t [u] [] (by simp [hshape]) + have hxu : x = u := by + have hh := hphead + rw [hshape] at hh + exact (Option.some.inj hh).symm + have htu : FourNeighborAdjacent t u := by simpa [hshape, hxu] using hcloseP + have hparity : parity u = parity u + 1 := by + calc + parity u = parity t + 1 := parityStep htu + _ = (parity w + 1) + 1 := by rw [parityStep hwt] + _ = ((parity u + 1) + 1) + 1 := by rw [parityStep huw] + _ = parity u + 1 := by + have h31 : (3 : ZMod 2) = 1 := by decide + ring_nf + rw [h31] + have hzero : (0 : ZMod 2) = 1 := by + have h' : parity u + 0 = parity u + 1 := by simpa only [add_zero] using hparity + exact add_left_cancel h' + norm_num at hzero + +private theorem hlastE₁ : + ∀ (V₁ : Set GaussianInt), ∀ (E₁ : Set (Finset GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (p₂ + : List GaussianInt), ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + (Q.getLast? = some z) → ((R.tail.IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁)) → + ((∀ v ∈ R.tail.head?, ({z, v} : Finset GaussianInt) ∈ E₁) → ( + let p := Q ++ prefix₁ + ∀ (hpne : p ≠ []), (R.tail = prefix₁ ++ [x]) → ( + let v := p.getLast hpne + ({v, x} : Finset GaussianInt) ∈ E₁))))) := by + classical + intro V₁ E₁ p₁ p₂ x c₂ good z c₁ good₁ w R prefix₂ prefix₁ Q hQlast hRtailE₁ hRstepE₁ p hpne + hRtail v + cases hpref : prefix₁ with + | nil => + have hpLast? : p.getLast? = some z := by simpa [p, hpref] using hQlast + have hpLast : p.getLast hpne = z := + (List.getLast_eq_iff_getLast?_eq_some hpne).2 hpLast? + have hxheadR : x ∈ R.tail.head? := by simp [hRtail, hpref] + have h := hRstepE₁ x hxheadR + simpa [v, hpLast, Finset.pair_comm] using h + | cons c cs => + have hpre : prefix₁ ≠ [] := by rw [hpref]; simp + have htailChain : (prefix₁ ++ [x]).IsChain + (fun u w => ({u, w} : Finset GaussianInt) ∈ E₁) := by + simpa [hRtail] using hRtailE₁ + have hlastRel := htailChain.rel_getLast_head_of_append hpre (by simp) + have hpLast : p.getLast hpne = prefix₁.getLast hpre := by + apply (List.getLast_eq_iff_getLast?_eq_some hpne).2 + simpa [p, hpref] using (List.getLast?_eq_some_getLast hpre) + simpa [v, hpLast] using hlastRel + +end MixedBoundaryCycleProof + +namespace MixedCycleDetails + +private theorem hcommon : + ∀ (V₁ : Set GaussianInt), ∀ (V₂ : Set GaussianInt), (¬(V₁ ∩ V₂).Subsingleton) → (∃ x y : + GaussianInt, x ∈ V₁ ∩ V₂ ∧ y ∈ V₁ ∩ V₂ ∧ x ≠ y) := by + classical + intro V₁ V₂ hmultiple + by_contra hn + apply hmultiple + intro x hx y hy + by_contra hxy + exact hn ⟨x, y, hx, hy, hxy⟩ + +private theorem hp₁ne : + ∀ (p₁ : List GaussianInt), ((4 : ℕ) ≤ p₁.length) → (p₁ ≠ []) := by + classical + intro p₁ hlen₁ h + simp [h] at hlen₁ + +private theorem hp₂ne : + ∀ (p₂ : List GaussianInt), ((4 : ℕ) ≤ p₂.length) → (p₂ ≠ []) := by + classical + intro p₂ hlen₂ h + simp [h] at hlen₂ + +private theorem hx₁ : + ∀ (V₁ : Set GaussianInt), ∀ (V₂ : Set GaussianInt), ∀ (p₁ : List GaussianInt), (V₁ = + (↑p₁.toFinset : Set GaussianInt)) → (∀ (x : GaussianInt), (x ∈ V₁ ∩ V₂) → (x ∈ p₁)) := by + classical + intro V₁ V₂ p₁ hV₁ x hx + rw [hV₁] at hx + exact List.mem_toFinset.mp hx.1 + +private theorem hx₂ : + ∀ (V₁ : Set GaussianInt), ∀ (V₂ : Set GaussianInt), ∀ (p₂ : List GaussianInt), (V₂ = + (↑p₂.toFinset : Set GaussianInt)) → (∀ (x : GaussianInt), (x ∈ V₁ ∩ V₂) → (x ∈ p₂)) := by + classical + intro V₁ V₂ p₂ hV₂ x hx + rw [hV₂] at hx + exact List.mem_toFinset.mp hx.2 + +private theorem hy₁ : + ∀ (V₁ : Set GaussianInt), ∀ (V₂ : Set GaussianInt), ∀ (p₁ : List GaussianInt), (V₁ = + (↑p₁.toFinset : Set GaussianInt)) → (∀ (y : GaussianInt), (y ∈ V₁ ∩ V₂) → (y ∈ p₁)) := by + classical + intro V₁ V₂ p₁ hV₁ y hy + rw [hV₁] at hy + exact List.mem_toFinset.mp hy.1 + +private theorem hy₂ : + ∀ (V₁ : Set GaussianInt), ∀ (V₂ : Set GaussianInt), ∀ (p₂ : List GaussianInt), (V₂ = + (↑p₂.toFinset : Set GaussianInt)) → (∀ (y : GaussianInt), (y ∈ V₁ ∩ V₂) → (y ∈ p₂)) := by + classical + intro V₁ V₂ p₂ hV₂ y hy + rw [hV₂] at hy + exact List.mem_toFinset.mp hy.2 + +private theorem hrot₁x : + ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), (x ∈ p₁) → ((p₁.idxOf x < p₁.length) → + ((p₁.rotate (p₁.idxOf x)).head? = some x)) := by + classical + intro p₁ x hx₁ hidx₁x + rw [List.head?_rotate hidx₁x] + exact List.getElem?_idxOf hx₁ + +private theorem hrot₂x : + ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), (x ∈ p₂) → ((p₂.idxOf x < p₂.length) → + ((p₂.rotate (p₂.idxOf x)).head? = some x)) := by + classical + intro p₂ x hx₂ hidx₂x + rw [List.head?_rotate hidx₂x] + exact List.getElem?_idxOf hx₂ + +private theorem cycle_chain : + ∀ (p : List GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (p.head? = some a) → + ((p.getLast? = some b) → ((FourNeighborAdjacent b a) → ((∀ u, ∀ v, ∀ l₁, ∀ l₂, p = l₁ ++ + u :: v :: + l₂ → FourNeighborAdjacent u v) → (p.IsChain FourNeighborAdjacent)))) := by + classical + intro p a b hh ht hc hadj + rw [List.isChain_iff_forall_rel_of_append_cons_cons] + intro u v l₁ l₂ heq + exact hadj u v l₁ l₂ heq + +private theorem takeArc : + ∀ {α : Type}, ∀ (a : α), ∀ (b : α), ∀ (u : List α), ∀ (v : List α), a :: (u ++ [b]) = + List.take (u.length + 2) (a :: (u ++ b :: v)) := by + classical + intro α a b u v + congr 1 + induction u with + | nil => simp + | cons d u ih => simp [ih, Nat.add_assoc] + +private theorem hc₂y : + ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (y ∈ p₂) → ( + let c₂ := p₂.rotate (p₂.idxOf x) + y ∈ c₂) := by + classical + intro p₂ x y hy₂ c₂ + rw [List.mem_rotate] + exact hy₂ + +private theorem hc₂tail : + ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (x ≠ y) → (((p₂.rotate + (p₂.idxOf x)).head? = some x) → ( + let c₂ := p₂.rotate (p₂.idxOf x) + (y ∈ c₂) → (y ∈ c₂.tail))) := by + classical + intro p₂ x y hxy hrot₂x c₂ hc₂y + have hhead : c₂.head? = some x := by simpa [c₂] using hrot₂x + obtain ⟨zs, hshape⟩ := (List.head?_eq_some_iff).mp hhead + rw [hshape] at hc₂y + simp only [List.mem_cons] at hc₂y + rcases hc₂y with h | h + · exact (hxy h.symm).elim + · simpa [hshape] using h + +private theorem hrest₂ne : + ∀ (V₁ : Set GaussianInt), ∀ (V₂ : Set GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : + GaussianInt), ∀ (y : GaussianInt), (y ∈ V₁ ∩ V₂) → ( + let c₂ := p₂.rotate (p₂.idxOf x) + (y ∈ c₂.tail) → ( + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + let rest₂ := c₂.tail.dropWhile good + rest₂ ≠ [])) := by + classical + intro V₁ V₂ p₂ x y hy c₂ hc₂tail good rest₂ he + have hall : ∀ z ∈ c₂.tail, good z := (List.dropWhile_eq_nil_iff).mp he + have hgood := hall y hc₂tail + simp [good, (show y ∈ V₁ from hy.1)] at hgood + +private theorem hzV₁ : + ∀ (V₁ : Set GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + let rest₂ := c₂.tail.dropWhile good + ∀ (z : GaussianInt), ∀ (zs : List GaussianInt), (rest₂ = z :: zs) → (z ∈ V₁) := by + classical + intro V₁ p₂ x c₂ good rest₂ z zs hrest₂ + have hlenrest : 0 < rest₂.length := by rw [hrest₂]; simp + have hnot := List.dropWhile_get_zero_not good c₂.tail (by simpa [rest₂] using hlenrest) + have hznot : ¬ good z := by simpa [rest₂, hrest₂] using hnot + simpa [good] using hznot + +private theorem hzTail : + ∀ (V₁ : Set GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + let rest₂ := c₂.tail.dropWhile good + ∀ (z : GaussianInt), ∀ (zs : List GaussianInt), (rest₂ = z :: zs) → (z ∈ c₂.tail) := by + classical + intro V₁ p₂ x c₂ good rest₂ z zs hrest₂ + have hzRest : z ∈ rest₂ := by rw [hrest₂]; simp + exact (List.dropWhile_subset good hzRest) + +private theorem hxNotTail : + ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), ((p₂.rotate (p₂.idxOf x)).head? = some x) → ( + let c₂ := p₂.rotate (p₂.idxOf x) + (c₂.Nodup) → (x ∉ c₂.tail)) := by + classical + intro p₂ x hrot₂x c₂ hc₂nodup + have hhead : c₂.head? = some x := by simpa [c₂] using hrot₂x + obtain ⟨tl, hshape⟩ := (List.head?_eq_some_iff).mp hhead + have : c₂.Nodup := hc₂nodup + rw [hshape] at this + rw [hshape] + exact (List.nodup_cons.mp this).1 + +private theorem hzx : + ∀ (V₁ : Set GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + let rest₂ := c₂.tail.dropWhile good + ∀ (z : GaussianInt), ∀ (zs : List GaussianInt), (rest₂ = z :: zs) → ((z ∈ V₁) → ((z ∈ + c₂.tail) → ((x ∉ c₂.tail) → (z ≠ x)))) := by + classical + intro V₁ p₂ x c₂ good rest₂ z zs hrest₂ hzV₁ hzTail hxNotTail h + subst z + exact hxNotTail hzTail + +private theorem hrot₁z : + ∀ (p₁ : List GaussianInt), ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + (p₁.idxOf z < p₁.length) → (c₁.head? = some z) := by + classical + intro p₁ z c₁ hidx₁z + rw [show c₁ = p₁.rotate (p₁.idxOf z) by rfl, List.head?_rotate hidx₁z] + exact List.getElem?_idxOf (List.idxOf_lt_length_iff.mp hidx₁z) + +private theorem hc₁shape : + ∀ (p₁ : List GaussianInt), ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + (c₁.head? = some z) → (c₁ = z :: c₁.tail) := by + classical + intro p₁ z c₁ hrot₁z + obtain ⟨tl, ht⟩ := (List.head?_eq_some_iff).mp (by simpa [c₁] using hrot₁z) + simp [c₁, ht] + +private theorem hc₁nodup : + ∀ (p₁ : List GaussianInt), (p₁.Nodup) → (∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + c₁.Nodup) := by + classical + intro p₁ hp₁ z c₁ + simpa [c₁] using + (List.nodup_rotate (l := p₁) (n := p₁.idxOf z)).mpr hp₁ + +private theorem hrest₁ne : + ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + (x ∈ c₁.tail) → ( + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + let rest₁ := c₁.tail.dropWhile good₁ + rest₁ ≠ []) := by + classical + intro p₁ x z c₁ hc₁x good₁ rest₁ he + have hall : ∀ w ∈ c₁.tail, good₁ w := (List.dropWhile_eq_nil_iff).mp (by simpa [rest₁] using he) + have hbad := hall x hc₁x + simp [good₁] at hbad + +private theorem hwx : + ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + let rest₁ := c₁.tail.dropWhile good₁ + ∀ (w : GaussianInt), ∀ (ws : List GaussianInt), (rest₁ = w :: ws) → (w = x) := by + classical + intro p₁ x z c₁ good₁ rest₁ w ws hrest₁ + have hlenrest : 0 < rest₁.length := by rw [hrest₁]; simp + have hnot := List.dropWhile_get_zero_not good₁ c₁.tail (by simpa [rest₁] using hlenrest) + have hwgood : ¬ good₁ w := by simpa [rest₁, hrest₁] using hnot + simpa [good₁] using hwgood + +private theorem hRlast : + ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + R.getLast? = some x) := by + classical + intro p₁ x z c₁ good₁ w R + apply List.getLast?_eq_some_iff.mpr + refine ⟨z :: c₁.tail.takeWhile good₁, ?_⟩ + simp [R] + +private theorem hc₂shape : + ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), ((p₂.rotate (p₂.idxOf x)).head? = some x) → ( + let c₂ := p₂.rotate (p₂.idxOf x) + c₂ = x :: c₂.tail) := by + classical + intro p₂ x hrot₂x c₂ + obtain ⟨tl, ht⟩ := (List.head?_eq_some_iff).mp (by simpa [c₂] using hrot₂x) + simp [c₂, ht] + +private theorem hdecomp₂' : + ∀ (V₁ : Set GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + let rest₂ := c₂.tail.dropWhile good + ∀ (z : GaussianInt), ∀ (zs : List GaussianInt), (rest₂ = z :: zs) → ((c₂.tail.takeWhile good + ++ rest₂ = c₂.tail) → ( + let prefix₂ := c₂.tail.takeWhile good + c₂.tail = prefix₂ ++ z :: zs)) := by + classical + intro V₁ p₂ x c₂ good rest₂ z zs hrest₂ hdecomp₂ prefix₂ + calc + c₂.tail = c₂.tail.takeWhile good ++ rest₂ := hdecomp₂.symm + _ = prefix₂ ++ z :: zs := by simp [prefix₂, hrest₂] + +private theorem sourceE₁ : + ∀ (E₁ : Set (Finset GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (a₁ : GaussianInt), ∀ (b₁ : + GaussianInt), (p₁.head? = some a₁) → ((p₁.getLast? = some b₁) → ((∀ (e : Finset + GaussianInt), e ∈ E₁ ↔ e = {b₁, a₁} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), p₁ = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((∀ (p : + List GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (E : Set (Finset + GaussianInt)), (p.head? = some a) → ((p.getLast? = some b) → ((({b, a} : Finset + GaussianInt) ∈ E) → ((∀ u, ∀ v, ∀ l₁, ∀ l₂, p = l₁ ++ u :: v :: l₂ → ({u, v} : Finset + GaussianInt) + ∈ E) → (Cycle.Chain (fun u v => ({u, v} : Finset GaussianInt) ∈ E) (p : Cycle + GaussianInt)))))) → (Cycle.Chain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁) + (p₁ : Cycle GaussianInt))))) := by + classical + intro E₁ p₁ a₁ b₁ hhead₁ hlast₁ hedge₁ sourceEdgeChain + exact sourceEdgeChain p₁ a₁ b₁ E₁ hhead₁ hlast₁ + ((hedge₁ {b₁, a₁}).mpr (Or.inl rfl)) (by + intro u v l₁ l₂ heq + exact (hedge₁ {u, v}).mpr (Or.inr ⟨u, v, l₁, l₂, heq, rfl⟩)) + +private theorem sourceE₂ : + ∀ (E₂ : Set (Finset GaussianInt)), ∀ (p₂ : List GaussianInt), ∀ (a₂ : GaussianInt), ∀ (b₂ : + GaussianInt), (p₂.head? = some a₂) → ((p₂.getLast? = some b₂) → ((∀ (e : Finset + GaussianInt), e ∈ E₂ ↔ e = {b₂, a₂} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), p₂ = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((∀ (p : + List GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (E : Set (Finset + GaussianInt)), (p.head? = some a) → ((p.getLast? = some b) → ((({b, a} : Finset + GaussianInt) ∈ E) → ((∀ u, ∀ v, ∀ l₁, ∀ l₂, p = l₁ ++ u :: v :: l₂ → ({u, v} : Finset + GaussianInt) + ∈ E) → (Cycle.Chain (fun u v => ({u, v} : Finset GaussianInt) ∈ E) (p : Cycle + GaussianInt)))))) → (Cycle.Chain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₂) + (p₂ : Cycle GaussianInt))))) := by + classical + intro E₂ p₂ a₂ b₂ hhead₂ hlast₂ hedge₂ sourceEdgeChain + exact sourceEdgeChain p₂ a₂ b₂ E₂ hhead₂ hlast₂ + ((hedge₂ {b₂, a₂}).mpr (Or.inl rfl)) (by + intro u v l₁ l₂ heq + exact (hedge₂ {u, v}).mpr (Or.inr ⟨u, v, l₁, l₂, heq, rfl⟩)) + +private theorem hp₂cycleeq : + ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), (p₂.idxOf x < p₂.length) → ( + let c₂ := p₂.rotate (p₂.idxOf x) + (p₂ : Cycle GaussianInt) = (c₂ : Cycle GaussianInt)) := by + classical + intro p₂ x hidx₂x c₂ + apply Cycle.coe_eq_coe.mpr + exact (List.isRotated_iff_mod).2 ⟨p₂.idxOf x, Nat.le_of_lt hidx₂x, rfl⟩ + +private theorem hc₂edgeCycle : + ∀ (E₂ : Set (Finset GaussianInt)), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + (Cycle.Chain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₂) (p₂ : Cycle GaussianInt)) → + (((p₂ : Cycle GaussianInt) = (c₂ : Cycle GaussianInt)) → (Cycle.Chain (fun u v => ({u, v} + : Finset GaussianInt) ∈ E₂) + (c₂ : Cycle GaussianInt))) := by + classical + intro E₂ p₂ x c₂ sourceE₂ hp₂cycleeq + rw [← hp₂cycleeq] + exact sourceE₂ + +private theorem hc₂edgeChain : + ∀ (E₂ : Set (Finset GaussianInt)), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + (c₂ = x :: c₂.tail) → ((Cycle.Chain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₂) (c₂ : + Cycle GaussianInt)) → ((x :: (c₂.tail ++ [x])).IsChain + (fun u v => ({u, v} : Finset GaussianInt) ∈ E₂))) := by + classical + intro E₂ p₂ x c₂ hc₂shape hc₂edgeCycle + rw [hc₂shape] at hc₂edgeCycle + exact (Cycle.chain_coe_cons (fun u v => ({u, v} : Finset GaussianInt) ∈ E₂) + x c₂.tail).mp hc₂edgeCycle + +private theorem hp₁cycleeq : + ∀ (p₁ : List GaussianInt), ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + (p₁.idxOf z < p₁.length) → ((p₁ : Cycle GaussianInt) = (c₁ : Cycle GaussianInt)) := by + classical + intro p₁ z c₁ hidx₁z + apply Cycle.coe_eq_coe.mpr + exact (List.isRotated_iff_mod).2 ⟨p₁.idxOf z, Nat.le_of_lt hidx₁z, rfl⟩ + +private theorem hc₁edgeCycle : + ∀ (E₁ : Set (Finset GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + (Cycle.Chain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁) (p₁ : Cycle GaussianInt)) → + (((p₁ : Cycle GaussianInt) = (c₁ : Cycle GaussianInt)) → (Cycle.Chain (fun u v => ({u, v} + : Finset GaussianInt) ∈ E₁) + (c₁ : Cycle GaussianInt))) := by + classical + intro E₁ p₁ z c₁ sourceE₁ hp₁cycleeq + rw [← hp₁cycleeq] + exact sourceE₁ + +private theorem hc₁edgeChain : + ∀ (E₁ : Set (Finset GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + (c₁ = z :: c₁.tail) → ((Cycle.Chain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁) (c₁ : + Cycle GaussianInt)) → ((z :: (c₁.tail ++ [z])).IsChain + (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁))) := by + classical + intro E₁ p₁ z c₁ hc₁shape hc₁edgeCycle + rw [hc₁shape] at hc₁edgeCycle + exact (Cycle.chain_coe_cons (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁) + z c₁.tail).mp hc₁edgeCycle + +private theorem hQlast : + ∀ (V₁ : Set GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let prefix₂ := c₂.tail.takeWhile good + let Q := x :: (prefix₂ ++ [z]) + Q.getLast? = some z := by + classical + intro V₁ p₂ x c₂ good z prefix₂ Q + apply List.getLast?_eq_some_iff.mpr + refine ⟨x :: prefix₂, ?_⟩ + simp [Q] + +private theorem hQedgePrefix : + ∀ (V₁ : Set GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), (∀ {α : Type}, ∀ (a + : α), ∀ (b : α), ∀ (u : List α), ∀ (v : List α), a :: (u ++ [b]) = List.take (u.length + + 2) (a :: (u ++ b :: v))) → ( + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), ∀ (zs : List GaussianInt), + let prefix₂ := c₂.tail.takeWhile good + (c₂.tail = prefix₂ ++ z :: zs) → ( + let Q := x :: (prefix₂ ++ [z]) + Q = List.take (prefix₂.length + 2) (x :: (c₂.tail ++ [x])))) := by + classical + intro V₁ p₂ x takeArc c₂ good z zs prefix₂ hdecomp₂' Q + calc + Q = x :: (prefix₂ ++ [z]) := rfl + _ = List.take (prefix₂.length + 2) + (x :: (prefix₂ ++ z :: (zs ++ [x]))) := takeArc x z prefix₂ (zs ++ [x]) + _ = List.take (prefix₂.length + 2) (x :: (c₂.tail ++ [x])) := by + rw [hdecomp₂'] + simp [List.append_assoc] + +private theorem hQedge : + ∀ (V₁ : Set GaussianInt), ∀ (E₂ : Set (Finset GaussianInt)), ∀ (p₂ : List GaussianInt), ∀ (x + : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let prefix₂ := c₂.tail.takeWhile good + ((x :: (c₂.tail ++ [x])).IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₂)) → ( + let Q := x :: (prefix₂ ++ [z]) + (Q = List.take (prefix₂.length + 2) (x :: (c₂.tail ++ [x]))) → (Q.IsChain (fun u v => ({u, v} + : Finset GaussianInt) ∈ E₂))) := by + classical + intro V₁ E₂ p₂ x c₂ good z prefix₂ hc₂edgeChain Q hQedgePrefix + rw [hQedgePrefix] + exact hc₂edgeChain.take _ + +private theorem hdecomp₁' : + ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + let rest₁ := c₁.tail.dropWhile good₁ + ∀ (w : GaussianInt), ∀ (ws : List GaussianInt), (rest₁ = w :: ws) → ((w = x) → + ((c₁.tail.takeWhile good₁ ++ rest₁ = c₁.tail) → ( + let prefix₁ := c₁.tail.takeWhile good₁ + c₁.tail = prefix₁ ++ x :: ws))) := by + classical + intro p₁ x z c₁ good₁ rest₁ w ws hrest₁ hwx hdecomp₁ prefix₁ + calc + c₁.tail = c₁.tail.takeWhile good₁ ++ rest₁ := hdecomp₁.symm + _ = prefix₁ ++ x :: ws := by simp [prefix₁, hrest₁, hwx] + +private theorem hRedgePrefix : + ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), (∀ {α : Type}, ∀ (a : α), ∀ (b : α), ∀ (u : + List α), ∀ (v : List α), a :: (u ++ [b]) = List.take (u.length + 2) (a :: (u ++ b :: v))) + → (∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → (∀ (ws : List GaussianInt), + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + let prefix₁ := c₁.tail.takeWhile good₁ + (c₁.tail = prefix₁ ++ x :: ws) → (R = List.take (prefix₁.length + 2) (z :: (c₁.tail ++ + [z]))))) := by + classical + intro p₁ x takeArc z c₁ good₁ w ws R prefix₁ hdecomp₁' + calc + R = z :: (prefix₁ ++ [x]) := rfl + _ = List.take (prefix₁.length + 2) + (z :: (prefix₁ ++ x :: (ws ++ [z]))) := takeArc z x prefix₁ (ws ++ [z]) + _ = List.take (prefix₁.length + 2) (z :: (c₁.tail ++ [z])) := by + rw [hdecomp₁'] + simp [List.append_assoc] + +private theorem hRedge : + ∀ (E₁ : Set (Finset GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : + GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + let prefix₁ := c₁.tail.takeWhile good₁ + ((z :: (c₁.tail ++ [z])).IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁)) → ((R = + List.take (prefix₁.length + 2) (z :: (c₁.tail ++ [z]))) → (R.IsChain (fun u v => ({u, v} + : Finset GaussianInt) ∈ E₁)))) := by + classical + intro E₁ p₁ x z c₁ good₁ w R prefix₁ hc₁edgeChain hRedgePrefix + rw [hRedgePrefix] + exact hc₁edgeChain.take _ + +private theorem hPplusUnion : + ∀ (V₁ : Set GaussianInt), ∀ (E₁ : Set (Finset GaussianInt)), ∀ (E₂ : Set (Finset + GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + let prefix₂ := c₂.tail.takeWhile good + let Q := x :: (prefix₂ ++ [z]) + (Q.getLast? = some z) → ((∀ v ∈ R.tail.head?, ({z, v} : Finset GaussianInt) ∈ E₁) → ( + let edgeRel (u v : GaussianInt) : Prop := + ({u, v} : Finset GaussianInt) ∈ E₁ ∪ E₂ + (Q.IsChain edgeRel) → ((R.tail.IsChain edgeRel) → ((Q ++ R.tail).IsChain edgeRel))))) := by + classical + intro V₁ E₁ E₂ p₁ p₂ x c₂ good z c₁ good₁ w R prefix₂ Q hQlast hRstepE₁ edgeRel hQunion + hRtailUnion + apply List.IsChain.append hQunion hRtailUnion + intro u hu v hv + have hu' : u = z := by simpa [hQlast] using hu.symm + subst u + exact Or.inl (hRstepE₁ v hv) + +private theorem hQprefix : + ∀ (V₁ : Set GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), (∀ {α : Type}, ∀ (a + : α), ∀ (b : α), ∀ (u : List α), ∀ (v : List α), a :: (u ++ [b]) = List.take (u.length + + 2) (a :: (u ++ b :: v))) → ( + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), ∀ (zs : List GaussianInt), + let prefix₂ := c₂.tail.takeWhile good + (c₂ = x :: c₂.tail) → ((c₂.tail = prefix₂ ++ z :: zs) → ( + let Q := x :: (prefix₂ ++ [z]) + Q = c₂.take (prefix₂.length + 2)))) := by + classical + intro V₁ p₂ x takeArc c₂ good z zs prefix₂ hc₂shape hdecomp₂' Q + rw [show Q = x :: (prefix₂ ++ [z]) by rfl, hc₂shape, hdecomp₂'] + exact takeArc x z prefix₂ zs + +private theorem hQchain : + ∀ (V₁ : Set GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), ((p₂.rotate + (p₂.idxOf x)).IsChain FourNeighborAdjacent) → ( + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let prefix₂ := c₂.tail.takeWhile good + let Q := x :: (prefix₂ ++ [z]) + (Q = c₂.take (prefix₂.length + 2)) → (Q.IsChain FourNeighborAdjacent)) := by + classical + intro V₁ p₂ x hc₂chain c₂ good z prefix₂ Q hQprefix + rw [hQprefix] + exact hc₂chain.take _ + +private theorem hRprefix : + ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), (∀ {α : Type}, ∀ (a : α), ∀ (b : α), ∀ (u : + List α), ∀ (v : List α), a :: (u ++ [b]) = List.take (u.length + 2) (a :: (u ++ b :: v))) + → (∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + (c₁ = z :: c₁.tail) → ( + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → (∀ (ws : List GaussianInt), + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + let prefix₁ := c₁.tail.takeWhile good₁ + (c₁.tail = prefix₁ ++ x :: ws) → (R = c₁.take (prefix₁.length + 2))))) := by + classical + intro p₁ x takeArc z c₁ hc₁shape good₁ w ws R prefix₁ hdecomp₁' + rw [show R = z :: (prefix₁ ++ [x]) by rfl, hc₁shape, hdecomp₁'] + exact takeArc z x prefix₁ ws + +private theorem hRchain : + ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + let prefix₁ := c₁.tail.takeWhile good₁ + (c₁.IsChain FourNeighborAdjacent) → ((R = c₁.take (prefix₁.length + 2)) → (R.IsChain + FourNeighborAdjacent))) := by + classical + intro p₁ x z c₁ good₁ w R prefix₁ hc₁chain hRprefix + rw [hRprefix] + exact hc₁chain.take _ + +private theorem hQnodup : + ∀ (V₁ : Set GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + (c₂.Nodup) → ( + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let prefix₂ := c₂.tail.takeWhile good + let Q := x :: (prefix₂ ++ [z]) + (Q = c₂.take (prefix₂.length + 2)) → (Q.Nodup)) := by + classical + intro V₁ p₂ x c₂ hc₂nodup good z prefix₂ Q hQprefix + rw [hQprefix] + exact (List.take_sublist _ c₂).nodup hc₂nodup + +private theorem hxnotprefix₁ : + ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₁ := c₁.tail.takeWhile good₁ + x ∉ prefix₁) := by + classical + intro p₁ x z c₁ good₁ w prefix₁ hxpre + have hxgood := List.mem_takeWhile_imp hxpre + simp [good₁] at hxgood + +private theorem hznotprefix₁ : + ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + (c₁.head? = some z) → ((c₁.Nodup) → ( + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₁ := c₁.tail.takeWhile good₁ + z ∉ prefix₁))) := by + classical + intro p₁ x z c₁ hrot₁z hc₁nodup good₁ w prefix₁ hzpre + have hztail : z ∈ c₁.tail := List.takeWhile_subset good₁ hzpre + have hhead : c₁.head? = some z := by simpa [c₁] using hrot₁z + obtain ⟨tl, hshape⟩ := (List.head?_eq_some_iff).mp hhead + have hnd : (z :: tl).Nodup := by simpa [c₁, hshape] using hc₁nodup + have : z ∉ tl := (List.nodup_cons.mp hnd).1 + rw [hshape] at hztail + exact this hztail + +private theorem hpNodup : + ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : + GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + (Q.Nodup) → ((prefix₁.Nodup) → ((∀ v ∈ Q, ∀ w ∈ prefix₁, v ≠ w) → ((Q ++ prefix₁).Nodup)))) + := by + classical + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q hQnodup hprefix₁nodup hcross + apply List.nodup_append.mpr + exact ⟨hQnodup, hprefix₁nodup, hcross⟩ + +private theorem hpne : + ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : + GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + let p := Q ++ prefix₁ + p ≠ []) := by + classical + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p he + have hxmem : x ∈ p := by simp [p, Q] + rw [he] at hxmem + simp at hxmem + +private theorem hRstep : + ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + (R.IsChain FourNeighborAdjacent) → (∀ v ∈ R.tail.head?, FourNeighborAdjacent z v)) := by + classical + intro p₁ x z c₁ good₁ w R hRchain + have h := (List.isChain_cons.mp hRchain).1 + simpa [R] using h + +private theorem hPplus : + ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : + GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + let prefix₂ := c₂.tail.takeWhile good + let Q := x :: (prefix₂ ++ [z]) + (Q.getLast? = some z) → ((Q.IsChain FourNeighborAdjacent) → ((R.IsChain FourNeighborAdjacent) + → ((∀ v ∈ R.tail.head?, FourNeighborAdjacent z v) → ((Q ++ R.tail).IsChain + FourNeighborAdjacent))))) := by + classical + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w R prefix₂ Q hQlast hQchain hRchain hRstep + apply List.IsChain.append hQchain (List.isChain_cons.mp hRchain).2 + intro u hu v hv + have hu' : u = z := by simpa [hQlast] using hu.symm + subst u + exact hRstep v hv + +private theorem hpChain : + ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : + GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + let p := Q ++ prefix₁ + ((p ++ [x]).IsChain FourNeighborAdjacent) → (p.IsChain FourNeighborAdjacent)) := by + classical + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p hPplusX + have h := hPplusX.left_of_append + simpa using h + +private theorem hcloseP : + ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : + GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + let p := Q ++ prefix₁ + ∀ (hpne : p ≠ []), ((p ++ [x]).IsChain FourNeighborAdjacent) → (FourNeighborAdjacent + (p.getLast hpne) x)) := by + classical + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p hpne hPplusX + have h := hPplusX.rel_getLast_head_of_append hpne (by simp) + simpa using h + +private theorem hpUnionChain : + ∀ (V₁ : Set GaussianInt), ∀ (E₁ : Set (Finset GaussianInt)), ∀ (E₂ : Set (Finset + GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + let edgeRel (u v : GaussianInt) : Prop := + ({u, v} : Finset GaussianInt) ∈ E₁ ∪ E₂ + let p := Q ++ prefix₁ + ((p ++ [x]).IsChain edgeRel) → (p.IsChain edgeRel)) := by + classical + intro V₁ E₁ E₂ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q edgeRel p hpPlusUnion + have h := hpPlusUnion.left_of_append + simpa using h + +private theorem hcloseUnion : + ∀ (V₁ : Set GaussianInt), ∀ (E₁ : Set (Finset GaussianInt)), ∀ (E₂ : Set (Finset + GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + let edgeRel (u v : GaussianInt) : Prop := + ({u, v} : Finset GaussianInt) ∈ E₁ ∪ E₂ + let p := Q ++ prefix₁ + ∀ (hpne : p ≠ []), ((p ++ [x]).IsChain edgeRel) → (edgeRel (p.getLast hpne) x)) := by + classical + intro V₁ E₁ E₂ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q edgeRel p hpne hpPlusUnion + have h := hpPlusUnion.rel_getLast_head_of_append hpne (by simp) + simpa using h + +private theorem hadjUnion : + ∀ (V₁ : Set GaussianInt), ∀ (E₁ : Set (Finset GaussianInt)), ∀ (E₂ : Set (Finset + GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + let edgeRel (u v : GaussianInt) : Prop := + ({u, v} : Finset GaussianInt) ∈ E₁ ∪ E₂ + let p := Q ++ prefix₁ + (p.IsChain edgeRel) → (∀ a, ∀ b, ∀ l₁, ∀ l₂, p = l₁ ++ a :: b :: l₂ → edgeRel a b)) := by + classical + intro V₁ E₁ E₂ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q edgeRel p hpUnionChain + rw [List.isChain_iff_forall_rel_of_append_cons_cons] at hpUnionChain + exact hpUnionChain + +private theorem hadjP : + ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : + GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + let p := Q ++ prefix₁ + (p.IsChain FourNeighborAdjacent) → (∀ a, ∀ b, ∀ l₁, ∀ l₂, p = l₁ ++ a :: b :: l₂ → + FourNeighborAdjacent a b)) := by + classical + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p hpChain + rw [List.isChain_iff_forall_rel_of_append_cons_cons] at hpChain + exact hpChain + +private theorem hpLenTwo : + ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : + GaussianInt), (GaussianInt) → ( + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + let p := Q ++ prefix₁ + 2 ≤ p.length)) := by + classical + intro V₁ p₁ p₂ x y c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p + have hQlen : 2 ≤ Q.length := by simp [Q] + simp [p, List.length_append] + omega + +private theorem hsimple : + ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : + GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + ((Q ++ prefix₁).Nodup) → ( + let p := Q ++ prefix₁ + ∀ (hpne : p ≠ []), (FourNeighborAdjacent (p.getLast hpne) x) → ((p.head? = some x) → + ((p.getLast? = some (p.getLast hpne)) → ( + let v := p.getLast hpne + (∀ a, ∀ b, ∀ l₁, ∀ l₂, p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → ((4 ≤ p.length) → ( + let W : Set GaussianInt := (p.toFinset : Set GaussianInt) + let F : Set (Finset GaussianInt) := {e | e = {v, x} ∨ + ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}} + SimpleGridCycle W F))))))) := by + classical + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q hpNodup p hpne hcloseP hphead hplast v + hadjP hpLength W F + refine ⟨p, x, v, hpNodup, hpLength, hphead, hplast, ?_, hcloseP, ?_, ?_⟩ + · rfl + · exact hadjP + · intro e + simp [F, v, Set.mem_ofPred_eq] + +private theorem hFsubset : + ∀ (V₁ : Set GaussianInt), ∀ (E₁ : Set (Finset GaussianInt)), ∀ (E₂ : Set (Finset + GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + let edgeRel (u v : GaussianInt) : Prop := + ({u, v} : Finset GaussianInt) ∈ E₁ ∪ E₂ + let p := Q ++ prefix₁ + ∀ (hpne : p ≠ []), (edgeRel (p.getLast hpne) x) → ((∀ a, ∀ b, ∀ l₁, ∀ l₂, p = l₁ ++ a :: b :: + l₂ → + edgeRel a b) → ( + let v := p.getLast hpne + let F : Set (Finset GaussianInt) := {e | e = {v, x} ∨ + ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}} + F ⊆ E₁ ∪ E₂))) := by + classical + intro V₁ E₁ E₂ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q edgeRel p hpne hcloseUnion + hadjUnion v F e he + simp only [F, Set.mem_ofPred_eq] at he + rcases he with he | ⟨a, b, l₁, l₂, hp, rfl⟩ + · subst e + simpa [v, edgeRel] using hcloseUnion + · exact hadjUnion a b l₁ l₂ hp + +private theorem hE₂At769 : + ∀ (V₁ : Set GaussianInt), ∀ (E₂ : Set (Finset GaussianInt)), ∀ (p₂ : List GaussianInt), ∀ (x + : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let prefix₂ := c₂.tail.takeWhile good + let Q := x :: (prefix₂ ++ [z]) + (Q.IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₂)) → ((prefix₂ = []) → (({x, z} : + Finset GaussianInt) ∈ E₂)) := by + classical + intro V₁ E₂ p₂ x c₂ good z prefix₂ Q hQedge hpref₂ + have hq : ([x, z] : List GaussianInt).IsChain + (fun u w => ({u, w} : Finset GaussianInt) ∈ E₂) := by + simpa [Q, hpref₂] using hQedge + exact (List.isChain_pair.mp hq) + +private theorem hFfAt774 : + ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : + GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + let p := Q ++ prefix₁ + ∀ (hpne : p ≠ []), + let v := p.getLast hpne + let F : Set (Finset GaussianInt) := {e | e = {v, x} ∨ + ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}} + (prefix₂ = []) → (({x, z} : Finset GaussianInt) ∈ F)) := by + classical + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p hpne v F hpref₂ + simp only [F, Set.mem_ofPred_eq] + right + refine ⟨x, z, [], prefix₁, ?_, rfl⟩ + simp [p, Q, hpref₂] + +private theorem hE₂At785 : + ∀ (V₁ : Set GaussianInt), ∀ (E₂ : Set (Finset GaussianInt)), ∀ (p₂ : List GaussianInt), ∀ (x + : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let prefix₂ := c₂.tail.takeWhile good + let Q := x :: (prefix₂ ++ [z]) + (Q.IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₂)) → (∀ (c : GaussianInt), ∀ (cs : + List GaussianInt), (prefix₂ = c :: cs) → (({x, c} : Finset GaussianInt) ∈ E₂)) := by + classical + intro V₁ E₂ p₂ x c₂ good z prefix₂ Q hQedge c cs hpref₂ + have hq : (x :: c :: (cs ++ [z])).IsChain + (fun u w => ({u, w} : Finset GaussianInt) ∈ E₂) := by + simpa [Q, hpref₂] using hQedge + exact (List.isChain_cons_cons.mp hq).1 + +private theorem hFfAt790 : + ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : + GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + let p := Q ++ prefix₁ + ∀ (hpne : p ≠ []), + let v := p.getLast hpne + let F : Set (Finset GaussianInt) := {e | e = {v, x} ∨ + ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}} + ∀ (c : GaussianInt), ∀ (cs : List GaussianInt), (prefix₂ = c :: cs) → (({x, c} : Finset + GaussianInt) ∈ F)) := by + classical + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p hpne v F c cs hpref₂ + simp only [F, Set.mem_ofPred_eq] + right + refine ⟨x, c, [], (cs ++ [z]) ++ prefix₁, ?_, rfl⟩ + simp [p, Q, hpref₂, List.append_assoc] + +end MixedCycleDetails + +namespace MixedClosingEdges + +private theorem hE₂ : + ∀ (V₁ : Set GaussianInt), ∀ (E₂ : Set (Finset GaussianInt)), ∀ (p₂ : List GaussianInt), ∀ (x + : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let prefix₂ := c₂.tail.takeWhile good + (List.IsChain (fun (u v : GaussianInt) => {u, v} ∈ E₂) (x :: (List.takeWhile (fun (z : + GaussianInt) => @decide (z ∉ V₁) (Classical.propDecidable _)) (p₂.rotate (List.idxOf x + p₂)).tail ++ [z]))) → (({x, + prefix₂.headD z} : Finset GaussianInt) ∈ E₂) := by + classical + intro V₁ E₂ p₂ x c₂ good z prefix₂ hQedge + cases hpref₂ : prefix₂ with + | nil => + simpa only [List.headD] using + MixedCycleDetails.hE₂At769 V₁ E₂ p₂ x z hQedge hpref₂ + | cons c cs => + simpa only [List.headD] using + MixedCycleDetails.hE₂At785 V₁ E₂ p₂ x z hQedge c cs hpref₂ + +private theorem hFf : + ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : + GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + (GaussianInt) → ( + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + let p := Q ++ prefix₁ + ∀ (hpne : p ≠ []), + let v := p.getLast hpne + let F : Set (Finset GaussianInt) := {e | e = {v, x} ∨ + ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}} + ({x, prefix₂.headD z} : Finset GaussianInt) ∈ F) := by + classical + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p hpne v F + cases hpref₂ : prefix₂ with + | nil => + simpa only [List.headD] using + MixedCycleDetails.hFfAt774 V₁ p₁ p₂ x z w hpne hpref₂ + | cons c cs => + simpa only [List.headD] using + MixedCycleDetails.hFfAt790 V₁ p₁ p₂ x z w hpne c cs hpref₂ + +end MixedClosingEdges + +theorem P3963T1MixedBoundaryCycle + (V₁ V₂ : Set GaussianInt) (E₁ E₂ : Set (Finset GaussianInt)) + (h₁ : SimpleGridCycle V₁ E₁) (h₂ : SimpleGridCycle V₂ E₂) + (hdisjoint : Disjoint E₁ E₂) + (hmultiple : ¬ (V₁ ∩ V₂).Subsingleton) : + ∃ (W : Set GaussianInt) (F : Set (Finset GaussianInt)) + (x : GaussianInt) (e f : Finset GaussianInt), + SimpleGridCycle W F ∧ F ⊆ E₁ ∪ E₂ ∧ + x ∈ e ∧ x ∈ f ∧ e ∈ F ∩ E₁ ∧ f ∈ F ∩ E₂ := by +-- BODY + classical + obtain ⟨p₁, a₁, b₁, hp₁, hlen₁, hhead₁, hlast₁, hV₁, hclose₁, + hadj₁, hedge₁⟩ := h₁ + obtain ⟨p₂, a₂, b₂, hp₂, hlen₂, hhead₂, hlast₂, hV₂, hclose₂, + hadj₂, hedge₂⟩ := h₂ + have hcommon := MixedCycleDetails.hcommon V₁ V₂ hmultiple + obtain ⟨x, y, hx, hy, hxy⟩ := hcommon + have hp₁ne := MixedCycleDetails.hp₁ne p₁ hlen₁ + have hp₂ne := MixedCycleDetails.hp₂ne p₂ hlen₂ + have hx₁ := MixedCycleDetails.hx₁ V₁ V₂ p₁ hV₁ x hx + have hx₂ := MixedCycleDetails.hx₂ V₁ V₂ p₂ hV₂ x hx + have hy₁ := MixedCycleDetails.hy₁ V₁ V₂ p₁ hV₁ y hy + have hy₂ := MixedCycleDetails.hy₂ V₁ V₂ p₂ hV₂ y hy + have hidx₁x : p₁.idxOf x < p₁.length := List.idxOf_lt_length_iff.mpr hx₁ + have hidx₁y : p₁.idxOf y < p₁.length := List.idxOf_lt_length_iff.mpr hy₁ + have hidx₂x : p₂.idxOf x < p₂.length := List.idxOf_lt_length_iff.mpr hx₂ + have hidx₂y : p₂.idxOf y < p₂.length := List.idxOf_lt_length_iff.mpr hy₂ + have hrot₁x := MixedCycleDetails.hrot₁x p₁ x hx₁ hidx₁x + have hrot₂x := MixedCycleDetails.hrot₂x p₂ x hx₂ hidx₂x + have cycle_chain (p : List GaussianInt) (a b : GaussianInt) + (hh : p.head? = some a) (ht : p.getLast? = some b) + (hc : FourNeighborAdjacent b a) + (hadj : ∀ u v l₁ l₂, p = l₁ ++ u :: v :: l₂ → FourNeighborAdjacent u v) := + MixedCycleDetails.cycle_chain p a b hh ht hc hadj + have rotate_chain (p : List GaussianInt) (k : Nat) (a b : GaussianInt) + (hh : p.head? = some a) (ht : p.getLast? = some b) + (hc : FourNeighborAdjacent b a) + (hchain : p.IsChain FourNeighborAdjacent) (hk : k < p.length) : + (p.rotate k).IsChain FourNeighborAdjacent := MixedBoundaryCycleProof.rotate_chain p k a b + hh ht hc hchain hk + have takeArc {α : Type} (a b : α) (u v : List α) := MixedCycleDetails.takeArc (α := α) a b u v + have hp₁chain : p₁.IsChain FourNeighborAdjacent := + cycle_chain p₁ a₁ b₁ hhead₁ hlast₁ hclose₁ hadj₁ + have hp₂chain : p₂.IsChain FourNeighborAdjacent := + cycle_chain p₂ a₂ b₂ hhead₂ hlast₂ hclose₂ hadj₂ + have sourceEdgeChain (p : List GaussianInt) (a b : GaussianInt) + (E : Set (Finset GaussianInt)) + (hh : p.head? = some a) (ht : p.getLast? = some b) + (hcloseE : ({b, a} : Finset GaussianInt) ∈ E) + (hedges : ∀ u v l₁ l₂, p = l₁ ++ u :: v :: l₂ → ({u, v} : Finset GaussianInt) ∈ E) : + Cycle.Chain (fun u v => ({u, v} : Finset GaussianInt) ∈ E) (p : Cycle GaussianInt) := + MixedBoundaryCycleProof.sourceEdgeChain p a b E hh ht hcloseE hedges + have hc₂chain : (p₂.rotate (p₂.idxOf x)).IsChain FourNeighborAdjacent := + rotate_chain p₂ (p₂.idxOf x) a₂ b₂ hhead₂ hlast₂ hclose₂ hp₂chain hidx₂x + let c₂ := p₂.rotate (p₂.idxOf x) + have hc₂y := MixedCycleDetails.hc₂y p₂ x y hy₂ + have hc₂nodup : c₂.Nodup := (List.nodup_rotate).2 hp₂ + have hc₂tail := MixedCycleDetails.hc₂tail p₂ x y hxy hrot₂x hc₂y + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + let rest₂ := c₂.tail.dropWhile good + have hrest₂ne := MixedCycleDetails.hrest₂ne V₁ V₂ p₂ x y hy hc₂tail + obtain ⟨z, zs, hrest₂⟩ : ∃ z zs, rest₂ = z :: zs := by + cases h : rest₂ with + | nil => exact (hrest₂ne h).elim + | cons z zs => exact ⟨z, zs, rfl⟩ + have hzV₁ := MixedCycleDetails.hzV₁ V₁ p₂ x z zs hrest₂ + have hdecomp₂ : c₂.tail.takeWhile good ++ rest₂ = c₂.tail := + List.takeWhile_append_dropWhile + have hzTail := MixedCycleDetails.hzTail V₁ p₂ x z zs hrest₂ + have hxNotTail := MixedCycleDetails.hxNotTail p₂ x hrot₂x hc₂nodup + have hzx := MixedCycleDetails.hzx V₁ p₂ x z zs hrest₂ hzV₁ hzTail hxNotTail + have hq2head : (x :: (c₂.tail.takeWhile good ++ [z])).head? = some x := by simp + let c₁ := p₁.rotate (p₁.idxOf z) + have hidx₁z : p₁.idxOf z < p₁.length := + List.idxOf_lt_length_iff.mpr (by rw [hV₁] at hzV₁; exact List.mem_toFinset.mp hzV₁) + have hrot₁z := MixedCycleDetails.hrot₁z p₁ z hidx₁z + have hc₁shape := MixedCycleDetails.hc₁shape p₁ z hrot₁z + have hc₁x : x ∈ c₁.tail := MixedBoundaryCycleProof.hc₁x p₁ x hx₁ z hzx hrot₁z + have hc₁nodup := MixedCycleDetails.hc₁nodup p₁ hp₁ z + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + let rest₁ := c₁.tail.dropWhile good₁ + have hrest₁ne := MixedCycleDetails.hrest₁ne p₁ x z hc₁x + obtain ⟨w, ws, hrest₁⟩ : ∃ w ws, rest₁ = w :: ws := by + cases h : rest₁ with + | nil => exact (hrest₁ne h).elim + | cons w ws => exact ⟨w, ws, rfl⟩ + have hwx := MixedCycleDetails.hwx p₁ x z w ws hrest₁ + have hdecomp₁ : c₁.tail.takeWhile good₁ ++ rest₁ = c₁.tail := + List.takeWhile_append_dropWhile + have hxR : x ∈ (z :: (c₁.tail.takeWhile good₁ ++ [x])).toFinset := by simp + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + have hRhead : R.head? = some z := by simp [R] + have hRlast := MixedCycleDetails.hRlast p₁ x z w + let prefix₂ := c₂.tail.takeWhile good + have hc₂shape := MixedCycleDetails.hc₂shape p₂ x hrot₂x + have hdecomp₂' := MixedCycleDetails.hdecomp₂' V₁ p₂ x z zs + hrest₂ hdecomp₂ + let prefix₁ := c₁.tail.takeWhile good₁ + have hc₁chain : c₁.IsChain FourNeighborAdjacent := + rotate_chain p₁ (p₁.idxOf z) a₁ b₁ hhead₁ hlast₁ hclose₁ hp₁chain hidx₁z + have sourceE₁ := MixedCycleDetails.sourceE₁ E₁ p₁ a₁ b₁ hhead₁ hlast₁ hedge₁ + sourceEdgeChain + have sourceE₂ := MixedCycleDetails.sourceE₂ E₂ p₂ a₂ b₂ hhead₂ hlast₂ hedge₂ + sourceEdgeChain + have hp₂cycleeq := MixedCycleDetails.hp₂cycleeq p₂ x hidx₂x + have hc₂edgeCycle := MixedCycleDetails.hc₂edgeCycle E₂ p₂ x sourceE₂ hp₂cycleeq + have hc₂edgeChain := MixedCycleDetails.hc₂edgeChain E₂ p₂ x + hc₂shape hc₂edgeCycle + have hp₁cycleeq := MixedCycleDetails.hp₁cycleeq p₁ z hidx₁z + have hc₁edgeCycle := MixedCycleDetails.hc₁edgeCycle E₁ p₁ z sourceE₁ hp₁cycleeq + have hc₁edgeChain := MixedCycleDetails.hc₁edgeChain E₁ p₁ z + hc₁shape hc₁edgeCycle + let Q := x :: (prefix₂ ++ [z]) + have hQlast := MixedCycleDetails.hQlast V₁ p₂ x z + have hQedgePrefix := MixedCycleDetails.hQedgePrefix V₁ p₂ x takeArc z zs hdecomp₂' + have hQedge := MixedCycleDetails.hQedge V₁ E₂ p₂ x z hc₂edgeChain hQedgePrefix + have hdecomp₁' := MixedCycleDetails.hdecomp₁' p₁ x z w ws hrest₁ + hwx hdecomp₁ + have hRedgePrefix := MixedCycleDetails.hRedgePrefix p₁ x takeArc z w ws hdecomp₁' + have hRedge : R.IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁) := + MixedCycleDetails.hRedge E₁ p₁ x z w hc₁edgeChain hRedgePrefix + have hRtailE₁ : R.tail.IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁) := by + simpa [R, prefix₁] using (List.isChain_cons.mp hRedge).2 + have hRstepE₁ : ∀ v ∈ R.tail.head?, ({z, v} : Finset GaussianInt) ∈ E₁ := + by simpa [R, prefix₁] using (List.isChain_cons.mp hRedge).1 + let edgeRel (u v : GaussianInt) : Prop := + ({u, v} : Finset GaussianInt) ∈ E₁ ∪ E₂ + have hQunion : Q.IsChain edgeRel := hQedge.imp (by + intro u v huv + exact Or.inr huv) + have hRtailUnion : R.tail.IsChain edgeRel := hRtailE₁.imp (by + intro u v huv + exact Or.inl huv) + have hPplusUnion : (Q ++ R.tail).IsChain edgeRel := MixedCycleDetails.hPplusUnion V₁ E₁ E₂ p₁ + p₂ x z w hQlast hRstepE₁ hQunion hRtailUnion + have hQprefix := MixedCycleDetails.hQprefix V₁ p₂ x takeArc + z zs hc₂shape hdecomp₂' + have hQchain := MixedCycleDetails.hQchain V₁ p₂ x hc₂chain z + hQprefix + have hRprefix := MixedCycleDetails.hRprefix p₁ x takeArc z + hc₁shape w ws hdecomp₁' + have hRchain := MixedCycleDetails.hRchain p₁ x z w hc₁chain + hRprefix + have hQnodup := MixedCycleDetails.hQnodup V₁ p₂ x hc₂nodup z hQprefix + have hprefix₁nodup : prefix₁.Nodup := + (List.takeWhile_sublist good₁).nodup hc₁nodup.tail + have hxnotprefix₁ := MixedCycleDetails.hxnotprefix₁ p₁ x z w + have hznotprefix₁ := MixedCycleDetails.hznotprefix₁ p₁ x z hrot₁z hc₁nodup w + have hcross : ∀ v ∈ Q, ∀ w ∈ prefix₁, v ≠ w := MixedBoundaryCycleProof.hcross V₁ V₂ E₁ E₂ p₁ + hV₁ p₂ x y hx hxy hx₁ hx₂ hidx₁x hidx₂x hrot₁x hrot₂x hc₂chain hc₂y hc₂nodup hc₂tail + hrest₂ne z zs hrest₂ hzV₁ hdecomp₂ hzTail hxNotTail hzx hq2head hidx₁z hrot₁z hc₁shape hc₁x + hc₁nodup hrest₁ne w ws hrest₁ hwx hdecomp₁ hxR hRhead hRlast hc₂shape hdecomp₂' hc₁chain + hp₂cycleeq hc₂edgeCycle hc₂edgeChain hp₁cycleeq hc₁edgeCycle hc₁edgeChain hQlast + hQedgePrefix hQedge hdecomp₁' hRedgePrefix hRedge hRtailE₁ hRstepE₁ hQunion hRtailUnion + hPplusUnion hQprefix hQchain hRprefix hRchain hQnodup hprefix₁nodup hxnotprefix₁ hznotprefix₁ + have hpNodup := MixedCycleDetails.hpNodup V₁ p₁ p₂ x z w hQnodup + hprefix₁nodup hcross + let p := Q ++ prefix₁ + have hpne := MixedCycleDetails.hpne V₁ p₁ p₂ x z w + have hRtail : R.tail = prefix₁ ++ [x] := by simp [R, prefix₁] + have hRstep := MixedCycleDetails.hRstep p₁ x z w + hRchain + have hPplus : (Q ++ R.tail).IsChain FourNeighborAdjacent := MixedCycleDetails.hPplus V₁ p₁ p₂ x + z w hQlast hQchain hRchain hRstep + have hPplusX : (p ++ [x]).IsChain FourNeighborAdjacent := by + simpa [p, hRtail, List.append_assoc] using hPplus + have hpChain := MixedCycleDetails.hpChain V₁ p₁ p₂ x z w hPplusX + have hcloseP := MixedCycleDetails.hcloseP V₁ p₁ p₂ x + z w hpne hPplusX + have hpPlusUnion : (p ++ [x]).IsChain edgeRel := by + simpa [p, R, prefix₁, List.append_assoc] using hPplusUnion + have hpUnionChain := MixedCycleDetails.hpUnionChain V₁ E₁ E₂ p₁ p₂ x z w + hpPlusUnion + have hcloseUnion := MixedCycleDetails.hcloseUnion V₁ E₁ E₂ p₁ p₂ x + z w hpne hpPlusUnion + have hadjUnion := MixedCycleDetails.hadjUnion V₁ E₁ E₂ p₁ p₂ x z w hpUnionChain + have hphead : p.head? = some x := by simp [p, Q] + have hplast : p.getLast? = some (p.getLast hpne) := List.getLast?_eq_some_getLast hpne + let v := p.getLast hpne + let parity (u : GaussianInt) : ZMod 2 := (u.re : ZMod 2) + (u.im : ZMod 2) + have parityStep {u w : GaussianInt} (h : FourNeighborAdjacent u w) : + parity w = parity u + 1 := MixedBoundaryCycleProof.parityStep (u := u) (w := w) h + have hadjP := MixedCycleDetails.hadjP V₁ p₁ p₂ x z w hpChain + have hpLenTwo : 2 ≤ p.length := MixedCycleDetails.hpLenTwo V₁ p₁ p₂ x y z w + have hpNotTwo : p.length ≠ 2 := MixedBoundaryCycleProof.hpNotTwo V₁ E₁ E₂ hdisjoint p₁ p₂ x y z + w hQedge hRedge + have hpNotThree : p.length ≠ 3 := MixedBoundaryCycleProof.hpNotThree V₁ p₁ p₂ x z w hpne + hcloseP hphead parityStep hadjP + have hpLength : 4 ≤ p.length := by omega + let W : Set GaussianInt := (p.toFinset : Set GaussianInt) + let F : Set (Finset GaussianInt) := {e | e = {v, x} ∨ + ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}} + have hsimple := MixedCycleDetails.hsimple V₁ p₁ p₂ x z w hpNodup hpne + hcloseP hphead hplast hadjP hpLength + have hlastE₁ : ({v, x} : Finset GaussianInt) ∈ E₁ := MixedBoundaryCycleProof.hlastE₁ V₁ E₁ p₁ + p₂ x z w hQlast hRtailE₁ hRstepE₁ hpne hRtail + have hwrapF : ({v, x} : Finset GaussianInt) ∈ F := by simp [F] + have hFsubset := MixedCycleDetails.hFsubset V₁ E₁ E₂ p₁ p₂ x z w hpne hcloseUnion + hadjUnion + have hE₂ : ({x, prefix₂.headD z} : Finset GaussianInt) ∈ E₂ := MixedClosingEdges.hE₂ V₁ E₂ p₂ x + z hQedge + have hFf : ({x, prefix₂.headD z} : Finset GaussianInt) ∈ F := MixedClosingEdges.hFf V₁ p₁ p₂ x + z w hpne + exact ⟨W, F, x, {v, x}, {x, prefix₂.headD z}, hsimple, hFsubset, + by simp, by simp, ⟨hwrapF, hlastE₁⟩, ⟨hFf, hE₂⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1AdjacentParentPlacement.lean b/LeanPool/ApollonianSuperharmonic/P3996T1AdjacentParentPlacement.lean new file mode 100644 index 0000000000..9e8b502dda --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3996T1AdjacentParentPlacement.lean @@ -0,0 +1,126 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P3996T1AdjacentParentPlacement] + +/-! +# P3996T1AdjacentParentPlacement + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3996T1AdjacentParentPlacement + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (i : Fin 3) (s : Fin 4) (U : ProtoTile) (hU : BandPrototile (q 0) U) : + ∃ Z : ProtoTile, + BandPrototile (q ((if Even s.val then i - 1 else i + 1).succ)) Z ∧ + TileCentroid Z - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (q 0) (q ((i - 1).succ)) - + BandVectors.1 (q ((i - 1).succ)) (q 0) + else + BandVectors.1 (q ((i + 1).succ)) (q 0) - + BandVectors.1 (q 0) (q ((i + 1).succ)))) := by +-- BODY + have incoming (j : Fin 3) : + BandVectors.1 (q j.succ) (q 0) = + BandVectors.1 (q j.succ) (q ((j + 2).succ)) - + (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (q ((j + 1).succ)) (q j.succ) := by + fin_cases j + · exact (VectorRecursionLaws q hq.1).2.2.1 + · exact (VectorRecursionLaws ![q 0, q 2, q 3, q 1] + (SemiProperQuadruple.rotate hq.1)).2.2.1 + · exact (VectorRecursionLaws ![q 0, q 3, q 1, q 2] + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1))).2.2.1 + have superbasis (j : Fin 3) : + BandVectors.1 (q ((j + 2).succ)) (q ((j + 1).succ)) + + BandVectors.1 (q j.succ) (q ((j + 2).succ)) + + BandVectors.1 (q ((j + 1).succ)) (q j.succ) = 0 := by + have law := (VectorRecursionLaws q hq.1).1 + fin_cases j + · exact law + · change BandVectors.1 (q 1) (q 3) + BandVectors.1 (q 2) (q 1) + + BandVectors.1 (q 3) (q 2) = 0 + simpa only [add_assoc, add_left_comm, add_comm] using law + · change BandVectors.1 (q 2) (q 1) + BandVectors.1 (q 3) (q 2) + + BandVectors.1 (q 1) (q 3) = 0 + simpa only [add_assoc, add_left_comm, add_comm] using law + let j : Fin 3 := if Even s.val then i - 1 else i + 1 + let I : GaussianInt := ⟨0, 1⟩ + let e := BandVectors.1 (q ((j + 2).succ)) (q ((j + 1).succ)) + let x := BandVectors.1 (q j.succ) (q ((j + 2).succ)) + let y := BandVectors.1 (q ((j + 1).succ)) (q j.succ) + let a := BandVectors.1 (q j.succ) (q 0) + have hs : e + x + y = 0 := superbasis j + have ha : a = x - I * y := incoming j + have hf : BandVectors.1 (q 0) (q j.succ) = I * a := + ((VectorRecursionLaws q hq.1).2.2.2.2 hq j).1 + let shift : GaussianInt := match s.val with + | 0 => y + | 1 => a + y + | 2 => -y + | _ => -a - y + let sign : Bool := decide (s.val < 2) + have he : e = -x - y := by + calc e = (e + x + y) - x - y := by ring + _ = -x - y := by rw [hs]; ring + have algebra : + I ^ s.val * (if Even s.val then I * a - a else a - I * a) = + (if sign then (1 : GaussianInt) else -1) * (e - I * e) + 2 * shift := by + fin_cases s <;> norm_num [sign, shift, I, show Even (0 : Nat) from by decide, + show ¬Even (1 : Nat) from by decide, + show Even (2 : Nat) from by decide, + show ¬Even (3 : Nat) from by decide] <;> + simp only [ha, he] <;> apply Zsqrtd.ext <;> simp [I, pow_succ] <;> ring + obtain ⟨S, hS, _⟩ := BandPrototileReindexedDecomposition q hq U hU + refine ⟨TileTranslation (S j sign) shift, + BandPrototileTranslation _ _ shift (hS j sign).1, ?_⟩ + have hc := (hS j sign).2.2 + have target : + (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (q 0) (q ((i - 1).succ)) - + BandVectors.1 (q ((i - 1).succ)) (q 0) + else + BandVectors.1 (q ((i + 1).succ)) (q 0) - + BandVectors.1 (q 0) (q ((i + 1).succ))) = + (if sign then (1 : GaussianInt) else -1) * (e - I * e) + 2 * shift := by + convert algebra using 1 + dsimp [I] + congr 1 + split_ifs with h + · have hj : j = i - 1 := ite_eq_left h + rw [← hj, hf] + · have hj : j = i + 1 := ite_eq_right h + rw [← hj, hf] + rw [target, (TileTranslationFormulas (S j sign) shift).2.2.2.2.1] + change TileCentroid (S j sign) - TileCentroid U = + (if sign = true then (1 : Real) else -1) • + ((1 / 2 : Real) • (GaussianRealPoint e - + (-(GaussianRealPoint e).2, (GaussianRealPoint e).1))) at hc + have hc1 := congrArg Prod.fst hc + have hc2 := congrArg Prod.snd hc + cases hs : sign <;> + simp? [hs, GaussianRealPoint, I] at hc1 hc2 ⊢ <;> + apply Prod.ext <;> simp <;> linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1CenteredQuarterTurnInclusion.lean b/LeanPool/ApollonianSuperharmonic/P3996T1CenteredQuarterTurnInclusion.lean new file mode 100644 index 0000000000..66c9b3fc2d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3996T1CenteredQuarterTurnInclusion.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P3996T1CenteredQuarterTurnInclusion] + +/-! +# P3996T1CenteredQuarterTurnInclusion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P3996T1CenteredQuarterTurnInclusion (T P : ProtoTile) + (hT : QuarterTurnSymmetric T) (hP : QuarterTurnSymmetric P) + (hsub : P.cells ⊆ T.cells) : + ∃ t p : GaussianInt, + GaussianRealPoint t = + ((TileCentroid T).1 + (TileCentroid T).2, + (TileCentroid T).2 - (TileCentroid T).1) ∧ + GaussianRealPoint p = + ((TileCentroid P).1 + (TileCentroid P).2, + (TileCentroid P).2 - (TileCentroid P).1) ∧ + ∀ a : GaussianInt, + (TileTranslation P (a + t - p)).cells ⊆ + (TileTranslation T a).cells ∧ + TileCentroid (TileTranslation P (a + t - p)) - + TileCentroid (TileTranslation T a) = + (-((TileCentroid P - TileCentroid T).2), + (TileCentroid P - TileCentroid T).1) := by +-- BODY + obtain ⟨t, ht, htcells, _⟩ := QuarterTurnSymmetricCenteredTransport T hT + obtain ⟨p, hp, hpcells, _⟩ := QuarterTurnSymmetricCenteredTransport P hP + refine ⟨t, p, ht, hp, ?_⟩ + intro a + constructor + · have hturn : (TileQuarterTurn P).cells ⊆ (TileQuarterTurn T).cells := by + rw [(TileQuarterTurnFormulas P).1, (TileQuarterTurnFormulas T).1] + exact Finset.image_subset_image hsub + rw [(TileTranslationFormulas P (a + t - p)).1, + (TileTranslationFormulas T a).1] + intro y hy + obtain ⟨z, hz, rfl⟩ := Finset.mem_image.mp hy + rw [← hpcells, (TileTranslationFormulas (TileQuarterTurn P) p).1] at hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + have hwt : GaussianTranslation t w ∈ T.cells := by + rw [← htcells, (TileTranslationFormulas (TileQuarterTurn T) t).1] + exact Finset.mem_image.mpr ⟨w, hturn hw, rfl⟩ + exact Finset.mem_image.mpr ⟨GaussianTranslation t w, hwt, by + simp [GaussianTranslation] + abel⟩ + · rw [(TileTranslationFormulas P (a + t - p)).2.2.2.2.1, + (TileTranslationFormulas T a).2.2.2.2.1] + have ht1 := congrArg Prod.fst ht + have ht2 := congrArg Prod.snd ht + have hp1 := congrArg Prod.fst hp + have hp2 := congrArg Prod.snd hp + simp only [GaussianRealPoint] at ht1 ht2 hp1 hp2 + simp only [GaussianInt.intCast_re, GaussianInt.intCast_im] at ht1 ht2 hp1 hp2 + apply Prod.ext <;> simp [Int.cast_add, Int.cast_sub] <;> linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean b/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean new file mode 100644 index 0000000000..72564dcb1f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean @@ -0,0 +1,1308 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3996T1SRowTable +public import LeanPool.ApollonianSuperharmonic.P3045T1RightBoundaryDisplacementAlgebra +public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P3996T1PlacementCompanionBlocks] + +/-! +# P3996T1PlacementCompanionBlocks + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PlacementCompanionGeometry + +private theorem area_of_band : + (by + classical + exact + ∀ (c : CircleCoordinates), ∀ (V : ProtoTile), BandPrototile c V → TileArea V = Int.toNat + c.1 ) := by + classical + intro c V hV + cases hV with + | line w x hw => simp [TileArea] + | unit z x anchor => simp [TileArea] + | @decompose q hq S T hS hcells hfoot hcentroid => + exact (BandTileSimultaneousInduction q hq V + (BandPrototile.decompose hq hS hcells hfoot hcentroid)).2.1 + +private theorem area_cells : + (by + classical + exact + ∀ (V : ProtoTile), ∀ (W : ProtoTile), (V.cells = W.cells) → (TileArea V = TileArea W) ) + := by + classical + intro V W hc + simp [TileArea, hc] + +private theorem selected_area : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + (∀ (V : ProtoTile), ∀ (d : GaussianInt), TileArea (TileTranslation V d) = TileArea V) → + ((∀ (V : ProtoTile), ∀ (W : ProtoTile), (V.cells = W.cells) → (TileArea V = TileArea + W)) → (TileArea (placement.layout.P bundle.selectedSlot bundle.selectedSign) = + TileArea (occurrence placement.exteriorIndex))) ) := by + classical + intro C D T N h k x bundle placement occurrence area_translation area_cells + have first_area (hi : bundle.selectedSlot = placement.rightFirstSlot) + (he : bundle.selectedSign = placement.firstBoundarySign) : + TileArea (placement.layout.P bundle.selectedSlot bundle.selectedSign) = + TileArea (occurrence placement.exteriorIndex) := by + have hP : placement.layout.P bundle.selectedSlot bundle.selectedSign = + placement.layout.P placement.rightFirstSlot placement.firstBoundarySign := + congrArg₂ placement.layout.P hi he + have hpiece : bundle.pieces bundle.selectedSlot bundle.selectedSign = + bundle.pieces placement.rightFirstSlot placement.firstBoundarySign := + congrArg₂ bundle.pieces hi he + calc + TileArea (placement.layout.P bundle.selectedSlot bundle.selectedSign) = + TileArea (placement.layout.P placement.rightFirstSlot placement.firstBoundarySign) := + congrArg TileArea hP + _ = TileArea (bundle.pieces bundle.selectedSlot bundle.selectedSign) := by + calc + _ = TileArea (TileTranslation + (placement.layout.P placement.rightFirstSlot placement.firstBoundarySign) + placement.rightNeighborDisplacement) := (area_translation _ _).symm + _ = TileArea (bundle.pieces placement.rightFirstSlot placement.firstBoundarySign) := + area_cells _ _ placement.first_boundary_cells.symm + _ = _ := congrArg TileArea hpiece.symm + _ = TileArea (occurrence placement.exteriorIndex) := by + apply area_cells + exact placement.selected_exterior_cells + have second_area (hi : bundle.selectedSlot = placement.rightSecondSlot) + (he : bundle.selectedSign = placement.secondBoundarySign) : + TileArea (placement.layout.P bundle.selectedSlot bundle.selectedSign) = + TileArea (occurrence placement.exteriorIndex) := by + have hP : placement.layout.P bundle.selectedSlot bundle.selectedSign = + placement.layout.P placement.rightSecondSlot placement.secondBoundarySign := + congrArg₂ placement.layout.P hi he + have hpiece : bundle.pieces bundle.selectedSlot bundle.selectedSign = + bundle.pieces placement.rightSecondSlot placement.secondBoundarySign := + congrArg₂ bundle.pieces hi he + calc + TileArea (placement.layout.P bundle.selectedSlot bundle.selectedSign) = + TileArea (placement.layout.P placement.rightSecondSlot placement.secondBoundarySign) := + congrArg TileArea hP + _ = TileArea (bundle.pieces bundle.selectedSlot bundle.selectedSign) := by + calc + _ = TileArea (TileTranslation + (placement.layout.P placement.rightSecondSlot placement.secondBoundarySign) + placement.rightNeighborDisplacement) := (area_translation _ _).symm + _ = TileArea (bundle.pieces placement.rightSecondSlot + placement.secondBoundarySign) := + area_cells _ _ placement.second_boundary_cells.symm + _ = _ := congrArg TileArea hpiece.symm + _ = TileArea (occurrence placement.exteriorIndex) := by + apply area_cells + exact placement.selected_exterior_cells + rcases placement.selected_boundary_piece with ⟨hi, he⟩ | ⟨hi, he⟩ + · exact first_area hi he + · exact second_area hi he + +private theorem occurrence_area : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), (∀ (c : CircleCoordinates), ∀ (V : ProtoTile), BandPrototile + c V → TileArea V = Int.toNat c.1) → ( + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + (∀ (V : ProtoTile), ∀ (d : GaussianInt), TileArea (TileTranslation V d) = TileArea V) → + (∀ (idx : PeriodicSubtileIndex), TileArea (occurrence idx) = Int.toNat + (bundle.normalizedPresentation (match idx.label with + | .A | .B => (0 : Fin 3).succ + | .C | .D => (1 : Fin 3).succ + | .E | .F => (2 : Fin 3).succ)).1)) ) := by + classical + intro C D T N h k x bundle placement area_of_band occurrence area_translation idx + have base_area (i : Fin 3) (s : Bool) (d : GaussianInt) : + TileArea (TileTranslation (placement.layout.P i s) d) = + Int.toNat (bundle.normalizedPresentation i.succ).1 := by + rw [area_translation] + exact area_of_band _ _ (placement.layout.outer_occurrence i s).1 + cases idx with + | mk label m n => + cases label <;> simp [occurrence, SubtileOccurrenceInterpretation, base_area] + +private theorem positive_parent : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + (BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection) → (∀ (i : Fin 3), 0 < (bundle.normalizedPresentation + i.succ).1) ) := by + classical + intro C D T N h k x bundle placement i + have hn := (ProperBandCurvatureStructure bundle.normalizedPresentation + bundle.configuration.proper).2.1 i + have hne := bundle.configuration.noLine i.succ + omega + +private theorem strict_parent23 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + (bundle.normalizedPresentation 3).1 < (bundle.normalizedPresentation 2).1 ) := by + classical + intro C D T N h k x bundle + have h := bundle.configuration.secondProper.2 (0 : Fin 3) + simpa [bundle.configuration.secondChild, + bundle.configuration.secondParentOne] using h + +private theorem slot_of_count : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + (BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection) → ((PeriodicSubtileIndex) → ((∀ (i : Fin 3), 0 < + (bundle.normalizedPresentation i.succ).1) → (((bundle.normalizedPresentation 2).1 < + (bundle.normalizedPresentation 1).1) → (((bundle.normalizedPresentation 3).1 < + (bundle.normalizedPresentation 2).1) → (∀ (s : Fin 3), ∀ (i : Fin 3), (Int.toNat + (bundle.normalizedPresentation s.succ).1 = + Int.toNat (bundle.normalizedPresentation i.succ).1) → (s = i)))))) ) := by + classical + intro C D T N h k x bundle placement a positive_parent strict_parent12 strict_parent23 s i hcount + have hn12 : Int.toNat (bundle.normalizedPresentation 2).1 < + Int.toNat (bundle.normalizedPresentation 1).1 := + (Int.toNat_lt_toNat (positive_parent 0)).2 strict_parent12 + have hn23 : Int.toNat (bundle.normalizedPresentation 3).1 < + Int.toNat (bundle.normalizedPresentation 2).1 := + (Int.toNat_lt_toNat (positive_parent 1)).2 strict_parent23 + fin_cases s <;> fin_cases i <;> simp_all <;> omega + +private theorem slot_of_exterior : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), (∀ (c : CircleCoordinates), ∀ (V : ProtoTile), BandPrototile + c V → TileArea V = Int.toNat c.1) → ( + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + (TileArea (placement.layout.P bundle.selectedSlot bundle.selectedSign) = TileArea + (occurrence placement.exteriorIndex)) → ((∀ (s : Fin 3), ∀ (i : Fin 3), (Int.toNat + (bundle.normalizedPresentation s.succ).1 = Int.toNat (bundle.normalizedPresentation + i.succ).1) → (s = i)) → (∀ (i : Fin 3), (TileArea (occurrence placement.exteriorIndex) = + Int.toNat (bundle.normalizedPresentation i.succ).1) → (bundle.selectedSlot = i)))) ) + := by + classical + intro C D T N h k x bundle placement area_of_band occurrence selected_area slot_of_count i harea + apply slot_of_count bundle.selectedSlot i + calc + Int.toNat (bundle.normalizedPresentation bundle.selectedSlot.succ).1 = + TileArea (placement.layout.P bundle.selectedSlot bundle.selectedSign) := + (area_of_band _ _ + (placement.layout.outer_occurrence bundle.selectedSlot bundle.selectedSign).1).symm + _ = TileArea (occurrence placement.exteriorIndex) := selected_area + _ = Int.toNat (bundle.normalizedPresentation i.succ).1 := harea + +private theorem exterior_area : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + (∀ (idx : PeriodicSubtileIndex), TileArea (occurrence idx) = Int.toNat + (bundle.normalizedPresentation (match idx.label with + | .A | .B => (0 : Fin 3).succ + | .C | .D => (1 : Fin 3).succ + | .E | .F => (2 : Fin 3).succ)).1) → ( + let exteriorSlot : Fin 3 := + match placement.exteriorIndex.label with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + TileArea (occurrence placement.exteriorIndex) = Int.toNat (bundle.normalizedPresentation + exteriorSlot.succ).1) ) := by + classical + intro C D T N h k x bundle placement occurrence occurrence_area exteriorSlot + rw [occurrence_area] + cases he : placement.exteriorIndex.label <;> simp [exteriorSlot, he] + +private theorem selected_center : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + let pieceOffset : Real × Real := + GaussianRealPoint + (BandVectors.1 + (bundle.normalizedPresentation ((bundle.selectedSlot + 2).succ)) + (bundle.normalizedPresentation ((bundle.selectedSlot + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 + (bundle.normalizedPresentation ((bundle.selectedSlot + 2).succ)) + (bundle.normalizedPresentation ((bundle.selectedSlot + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 + (bundle.normalizedPresentation ((bundle.selectedSlot + 2).succ)) + (bundle.normalizedPresentation ((bundle.selectedSlot + 1).succ)))).1) + TileCentroid (occurrence placement.exteriorIndex) - TileCentroid bundle.normalizedFixed = + (if bundle.selectedSign = true then (1 : Real) else -1) • ((1 / 2 : Real) • + pieceOffset) + GaussianRealPoint placement.rightNeighborDisplacement ) := by + classical + intro C D T N h k x bundle placement occurrence pieceOffset + obtain ⟨_, _, _, _, hoccCent⟩ := + ProtoTileObservableExtensionality (bundle.pieces bundle.selectedSlot + bundle.selectedSign) (occurrence placement.exteriorIndex) + placement.selected_exterior_cells placement.selected_exterior_empty_anchor + obtain ⟨_, _, _, _, hrootCent⟩ := + ProtoTileObservableExtensionality bundle.normalizedRoot + (TileTranslation bundle.normalizedFixed placement.rightNeighborDisplacement) + placement.right_neighbor_cells placement.right_neighbor_empty_anchor + calc + _ = TileCentroid (bundle.pieces bundle.selectedSlot bundle.selectedSign) - + TileCentroid bundle.normalizedFixed := by rw [hoccCent] + _ = (TileCentroid (bundle.pieces bundle.selectedSlot bundle.selectedSign) - + TileCentroid bundle.normalizedRoot) + + (TileCentroid bundle.normalizedRoot - + TileCentroid bundle.normalizedFixed) := by + ext <;> dsimp <;> ring + _ = (if bundle.selectedSign = true then (1 : Real) else -1) • + ((1 / 2 : Real) • pieceOffset) + + GaussianRealPoint placement.rightNeighborDisplacement := by + rw [bundle.piece_centroid] + rw [hrootCent, (TileTranslationFormulas bundle.normalizedFixed + placement.rightNeighborDisplacement).2.2.2.2.1] + ext <;> dsimp [pieceOffset, GaussianRealPoint, sub_eq_add_neg] <;> ring + +private theorem incoming_nonzero : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), (∀ (i : Fin 3), 0 < + (bundle.normalizedPresentation i.succ).1) → (∀ (i : Fin 3), BandVectors.1 + (bundle.normalizedPresentation i.succ) (bundle.normalizedPresentation 0) ≠ 0) ) := by + classical + intro C D T N h k x bundle positive_parent i + have hij : i.succ ≠ (0 : Fin 4) := by + fin_cases i <;> decide + apply VectorNonvanishing bundle.normalizedPresentation + bundle.configuration.proper.1 i.succ 0 hij + exact Or.inl (positive_parent i) + +private theorem flip_incoming : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (i : Fin 3), + BandVectors.1 (bundle.normalizedPresentation 0) (bundle.normalizedPresentation + i.succ) = (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (bundle.normalizedPresentation + i.succ) (bundle.normalizedPresentation 0) ) := by + classical + intro C D T N h k x bundle i + exact (VectorRecursionLaws bundle.normalizedPresentation + bundle.configuration.proper.1).2.2.2.2 bundle.configuration.proper i |>.1 + +private theorem realPoint_injective : + (by + classical + exact + Function.Injective GaussianRealPoint ) := by + classical + intro v w h + apply Zsqrtd.ext + · have h' := congrArg Prod.fst h + dsimp [GaussianRealPoint] at h' + exact_mod_cast h' + · have h' := congrArg Prod.snd h + dsimp [GaussianRealPoint] at h' + exact_mod_cast h' + +private theorem branchDisplacement_nonzero : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), (∀ (i : Fin 3), + BandVectors.1 (bundle.normalizedPresentation i.succ) (bundle.normalizedPresentation + 0) ≠ 0) → ((Function.Injective GaussianRealPoint) → ( + let I : GaussianInt := ⟨0, 1⟩ + let branchDisplacement (i : Fin 3) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint ((I - 1) * + BandVectors.1 (bundle.normalizedPresentation i.succ) + (bundle.normalizedPresentation 0)) + ∀ (i : Fin 3), branchDisplacement i ≠ (0, 0))) ) := by + classical + intro C D T N h k x bundle incoming_nonzero realPoint_injective I branchDisplacement i hzero + have hpoint : GaussianRealPoint ((I - 1) * + BandVectors.1 (bundle.normalizedPresentation i.succ) + (bundle.normalizedPresentation 0)) = (0, 0) := by + have h' := (smul_eq_zero.mp hzero).resolve_left (by norm_num) + exact h' + have hpoint0 : GaussianRealPoint (0 : GaussianInt) = (0, 0) := by + ext <;> simp [GaussianRealPoint] + have hmul := realPoint_injective + (hpoint.trans hpoint0.symm) + have hI : I - 1 ≠ (0 : GaussianInt) := by + intro hz + have := congrArg (fun z : GaussianInt => z.im) hz + norm_num [I] at this + exact (mul_ne_zero hI (incoming_nonzero i)) hmul + +private theorem four_centers_distinct : + (by + classical + exact + let quarterTurn (p : Real × Real) : Real × Real := (-p.2, p.1) + let branchCenter (E : Real × Real) (b : Fin 4) : Real × Real := + if b = 0 then -E + else if b = 1 then quarterTurn E + else if b = 2 then E + else -quarterTurn E + ∀ (E : Real × Real), (E ≠ (0, 0)) → (∀ (b : Fin 4), ∀ (c : Fin 4), (b ≠ c) → + (branchCenter E b ≠ branchCenter E c)) ) := by + classical + intro quarterTurn branchCenter E hE b c hbc heq + fin_cases b <;> fin_cases c + all_goals + first + | exact (hbc rfl).elim + | simp only [branchCenter, quarterTurn] at heq + have hx := congrArg Prod.fst heq + have hy := congrArg Prod.snd heq + have hzero : E = (0, 0) := by + apply Prod.ext + · dsimp at hx hy ⊢ + linarith + · dsimp at hx hy ⊢ + linarith + exact hE hzero + +private theorem cancel2 : + (by + classical + exact + ∀ (p : Real × Real), ∀ (q : Real × Real), ((2 : Real) • p = (2 : Real) • q) → (p = q) ) + := by + classical + intro p q h + have h' := congrArg (fun v : Real × Real => (1 / 2 : Real) • v) h + rw [smul_smul, smul_smul] at h' + norm_num at h' + exact h' + +private theorem centerAlgFirst : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + let cOff (w : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + let edgeCenter (a : GaussianInt) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint ((I - 1) * a) + (∀ (p : Real × Real), ∀ (q : Real × Real), ((2 : Real) • p = (2 : Real) • q) → (p = q)) → + (∀ (e : GaussianInt), ∀ (d : GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + (b = I * a) → (((1 - I) * e + 2 * d = -I * (a + b)) → (cOff e + GaussianRealPoint d = + -edgeCenter a))) ) := by + classical + intro I cOff edgeCenter cancel2 e d a b hflip halg + have hI2 : I * I = -1 := by ext <;> norm_num [I] + have hNegI2 : -I * I = 1 := by + rw [neg_mul, hI2] + norm_num + have hvec : (1 - I) * e + 2 * d = (1 - I) * a := by + rw [halg, hflip] + have hcoef : -I * (1 + I) = 1 - I := by + calc + -I * (1 + I) = -I + -I * I := by rw [mul_add, mul_one] + _ = 1 - I := by rw [hNegI2]; ring + calc + -I * (a + I * a) = (-I * (1 + I)) * a := by ring + _ = _ := by rw [hcoef] + have hleft : (2 : Real) • (cOff e + GaussianRealPoint d) = + GaussianRealPoint ((1 - I) * e + 2 * d) := by + apply Prod.ext <;> + norm_num [cOff, GaussianRealPoint, I, Prod.smul_mk, + Prod.add_def, Prod.sub_def] <;> ring + have hright : GaussianRealPoint ((1 - I) * a) = + (2 : Real) • (-edgeCenter a) := by + apply Prod.ext <;> + norm_num [edgeCenter, GaussianRealPoint, I, Prod.smul_mk] <;> ring + have hreal := congrArg GaussianRealPoint hvec + exact cancel2 _ _ (hleft.trans (hreal.trans hright)) + +private theorem centerAlgSecond : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + let quarterTurn (p : Real × Real) : Real × Real := (-p.2, p.1) + let cOff (w : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + let edgeCenter (a : GaussianInt) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint ((I - 1) * a) + (∀ (p : Real × Real), ∀ (q : Real × Real), ((2 : Real) • p = (2 : Real) • q) → (p = q)) → + (∀ (e : GaussianInt), ∀ (d : GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + (b = I * a) → ((-(1 - I) * e + 2 * d = -(a + b)) → (-cOff e + GaussianRealPoint d = + quarterTurn (edgeCenter a)))) ) := by + classical + intro I quarterTurn cOff edgeCenter cancel2 e d a b hflip halg + have hvec : -(1 - I) * e + 2 * d = -(1 + I) * a := by + rw [halg, hflip] + ring + have hleft : (2 : Real) • (-cOff e + GaussianRealPoint d) = + GaussianRealPoint (-(1 - I) * e + 2 * d) := by + apply Prod.ext <;> + norm_num [cOff, GaussianRealPoint, I, Prod.smul_mk, + Prod.add_def, Prod.sub_def] <;> ring + have hright : GaussianRealPoint (-(1 + I) * a) = + (2 : Real) • quarterTurn (edgeCenter a) := by + apply Prod.ext <;> + norm_num [edgeCenter, GaussianRealPoint, I, quarterTurn, Prod.smul_mk] <;> ring + have hreal := congrArg GaussianRealPoint hvec + exact cancel2 _ _ (hleft.trans (hreal.trans hright)) + +private theorem gp_neg_any : + (by + classical + exact + ∀ (g : GaussianInt), GaussianRealPoint (-g) = -GaussianRealPoint g ) := by + classical + intro g + ext <;> simp [GaussianRealPoint] + +private theorem first_center : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), (∀ (i : Fin 3), + BandVectors.1 (bundle.normalizedPresentation 0) (bundle.normalizedPresentation + i.succ) = (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (bundle.normalizedPresentation + i.succ) (bundle.normalizedPresentation 0)) → ( + let I : GaussianInt := ⟨0, 1⟩ + let branchDisplacement (i : Fin 3) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint ((I - 1) * + BandVectors.1 (bundle.normalizedPresentation i.succ) + (bundle.normalizedPresentation 0)) + let cOff (w : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + let edgeCenter (a : GaussianInt) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint ((I - 1) * a) + (∀ (e : GaussianInt), ∀ (d : GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (b = + I * a) → (((1 - I) * e + 2 * d = -I * (a + b)) → (cOff e + GaussianRealPoint d = + -edgeCenter a))) → ( + let q := bundle.normalizedPresentation + let o (i : Fin 3) := BandVectors.1 (q 0) (q i.succ) + let e (i : Fin 3) := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let d (i : Fin 3) := cOff (e i) + ∀ (i : Fin 3), d i + GaussianRealPoint (o (i + 2)) = -branchDisplacement i)) ) := by + classical + intro C D T N h k x bundle flip_incoming I branchDisplacement cOff edgeCenter centerAlgFirst q + o e d i + have hcyc : (i = 0 ∧ i + 1 = 1 ∧ i + 2 = 2) ∨ + (i = 1 ∧ i + 1 = 2 ∧ i + 2 = 0) ∨ + (i = 2 ∧ i + 1 = 0 ∧ i + 2 = 1) := by + fin_cases i <;> decide + have halg := (P3045T1RightBoundaryDisplacementAlgebra q + bundle.configuration.proper i (i + 1) (i + 2) hcyc).1 + exact centerAlgFirst _ _ _ _ (flip_incoming i) halg + +private theorem second_center : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), (∀ (i : Fin 3), + BandVectors.1 (bundle.normalizedPresentation 0) (bundle.normalizedPresentation + i.succ) = (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (bundle.normalizedPresentation + i.succ) (bundle.normalizedPresentation 0)) → ( + let I : GaussianInt := ⟨0, 1⟩ + let branchDisplacement (i : Fin 3) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint ((I - 1) * + BandVectors.1 (bundle.normalizedPresentation i.succ) + (bundle.normalizedPresentation 0)) + let quarterTurn (p : Real × Real) : Real × Real := (-p.2, p.1) + let cOff (w : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + let edgeCenter (a : GaussianInt) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint ((I - 1) * a) + (∀ (e : GaussianInt), ∀ (d : GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (b = + I * a) → ((-(1 - I) * e + 2 * d = -(a + b)) → (-cOff e + GaussianRealPoint d = + quarterTurn (edgeCenter a)))) → ( + let q := bundle.normalizedPresentation + let o (i : Fin 3) := BandVectors.1 (q 0) (q i.succ) + let e (i : Fin 3) := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let d (i : Fin 3) := cOff (e i) + ∀ (i : Fin 3), -d i + GaussianRealPoint (o (i + 1)) = quarterTurn (branchDisplacement + i))) ) := by + classical + intro C D T N h k x bundle flip_incoming I branchDisplacement quarterTurn cOff edgeCenter + centerAlgSecond q o e d i + have hcyc : (i + 2 = 0 ∧ i = 1 ∧ i + 1 = 2) ∨ + (i + 2 = 1 ∧ i = 2 ∧ i + 1 = 0) ∨ + (i + 2 = 2 ∧ i = 0 ∧ i + 1 = 1) := by + fin_cases i <;> decide + have halg := (P3045T1RightBoundaryDisplacementAlgebra q + bundle.configuration.proper (i + 2) i (i + 1) hcyc).2.1 + exact centerAlgSecond _ _ _ _ (flip_incoming i) halg + +private theorem cyclic_slots : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), placement.rightSecondSlot = placement.rightFirstSlot + 1 ∧ + placement.rightDirectionSlot = placement.rightFirstSlot + 2 ∧ + placement.rightFirstSlot = placement.rightSecondSlot + 2 ∧ + placement.rightDirectionSlot = placement.rightSecondSlot + 1 ) := by + classical + intro C D T N h k x bundle placement + rcases placement.right_slots_cyclic with ⟨hr, ht, hk⟩ | ⟨hr, ht, hk⟩ | ⟨hr, ht, hk⟩ + all_goals simp [hr, ht, hk] + +private theorem displacement : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let o (i : Fin 3) := BandVectors.1 (q 0) (q i.succ) + placement.rightNeighborDisplacement = if placement.rightNeighborPositive = true then o + placement.rightDirectionSlot else -o placement.rightDirectionSlot ) := by + classical + intro C D T N h k x bundle placement q o + rw [placement.right_neighbor_displacement] + split_ifs <;> simp [o, q] + +private theorem placement_centers : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + let I : GaussianInt := ⟨0, 1⟩ + let branchDisplacement (i : Fin 3) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint ((I - 1) * + BandVectors.1 (bundle.normalizedPresentation i.succ) + (bundle.normalizedPresentation 0)) + let quarterTurn (p : Real × Real) : Real × Real := (-p.2, p.1) + let branchCenter (E : Real × Real) (b : Fin 4) : Real × Real := + if b = 0 then -E + else if b = 1 then quarterTurn E + else if b = 2 then E + else -quarterTurn E + let cOff (w : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + (∀ (g : GaussianInt), GaussianRealPoint (-g) = -GaussianRealPoint g) → ( + let q := bundle.normalizedPresentation + let o (i : Fin 3) := BandVectors.1 (q 0) (q i.succ) + let e (i : Fin 3) := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let d (i : Fin 3) := cOff (e i) + (∀ (i : Fin 3), d i + GaussianRealPoint (o (i + 2)) = -branchDisplacement i) → ((∀ (i : + Fin 3), -d i + GaussianRealPoint (o (i + 1)) = quarterTurn (branchDisplacement i)) → ( + let exteriorCenter := TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed + (exteriorCenter = (if bundle.selectedSign = true then (1 : Real) else -1) • d + bundle.selectedSlot + GaussianRealPoint placement.rightNeighborDisplacement) → + ((placement.rightSecondSlot = placement.rightFirstSlot + 1 ∧ + placement.rightDirectionSlot = placement.rightFirstSlot + 2 ∧ + placement.rightFirstSlot = placement.rightSecondSlot + 2 ∧ + placement.rightDirectionSlot = placement.rightSecondSlot + 1) → + ((placement.rightNeighborDisplacement = if placement.rightNeighborPositive = true + then o placement.rightDirectionSlot else -o placement.rightDirectionSlot) → + ((placement.rightNeighborPositive = true ∧ bundle.selectedSlot = + placement.rightFirstSlot ∧ bundle.selectedSign = true → exteriorCenter = branchCenter + (branchDisplacement bundle.selectedSlot) 0) ∧ (placement.rightNeighborPositive = true + ∧ bundle.selectedSlot = placement.rightSecondSlot ∧ bundle.selectedSign = false → + exteriorCenter = branchCenter (branchDisplacement bundle.selectedSlot) 1) ∧ + (placement.rightNeighborPositive = false ∧ bundle.selectedSlot = + placement.rightFirstSlot ∧ bundle.selectedSign = false → exteriorCenter = + branchCenter (branchDisplacement bundle.selectedSlot) 2) ∧ + (placement.rightNeighborPositive = false ∧ bundle.selectedSlot = + placement.rightSecondSlot ∧ bundle.selectedSign = true → exteriorCenter = + branchCenter (branchDisplacement bundle.selectedSlot) 3))))))) ) := by + classical + intro C D T N h k x bundle placement occurrence I branchDisplacement quarterTurn branchCenter + cOff gp_neg_any q o e d first_center second_center exteriorCenter placement_center + cyclic_slots displacement + refine ⟨?_, ?_, ?_, ?_⟩ + · rintro ⟨hp, hi, hs⟩ + change exteriorCenter = -branchDisplacement bundle.selectedSlot + rw [placement_center, displacement] + simpa only [hs, hp, ite_true, one_smul, hi, cyclic_slots.2.1] using + first_center placement.rightFirstSlot + · rintro ⟨hp, hi, hs⟩ + change exteriorCenter = quarterTurn (branchDisplacement bundle.selectedSlot) + rw [placement_center, displacement] + simpa only [hs, hp, Bool.false_eq_true, ite_false, ite_true, neg_one_smul, hi, + cyclic_slots.2.2.2] using + second_center placement.rightSecondSlot + · rintro ⟨hp, hi, hs⟩ + change exteriorCenter = branchDisplacement bundle.selectedSlot + rw [placement_center, displacement] + simp only [hs, hp, Bool.false_eq_true, ite_false, neg_one_smul, hi, + cyclic_slots.2.1, gp_neg_any] + calc + _ = -(d placement.rightFirstSlot + + GaussianRealPoint (o (placement.rightFirstSlot + 2))) := by abel + _ = _ := by rw [first_center, neg_neg] + · rintro ⟨hp, hi, hs⟩ + change exteriorCenter = -quarterTurn (branchDisplacement bundle.selectedSlot) + rw [placement_center, displacement] + simp only [hs, hp, Bool.false_eq_true, ite_false, ite_true, one_smul, hi, + cyclic_slots.2.2.2, gp_neg_any] + calc + _ = -(-d placement.rightSecondSlot + + GaussianRealPoint (o (placement.rightSecondSlot + 1))) := by abel + _ = _ := by rw [second_center] + +private theorem third_period : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + let o (i : Fin 3) := BandVectors.1 (q 0) (q i.succ) + o 2 = -o 0 - o 1 ) := by + classical + intro C D T N h k x bundle q o + obtain ⟨_, _, _, _, h1, h2, h3, _⟩ := + P3055T1ParentVectorNormalForms q bundle.configuration + change BandVectors.1 (q 0) (q 3) = + -BandVectors.1 (q 0) (q 1) - BandVectors.1 (q 0) (q 2) + rw [h1, h2, h3] + ring + +private theorem gp_add : + (by + classical + exact + ∀ (v : GaussianInt), ∀ (w : GaussianInt), GaussianRealPoint (v + w) = GaussianRealPoint v + + GaussianRealPoint w ) := by + classical + intro v w + ext <;> simp [GaussianRealPoint] + +private theorem parent_center : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let cOff (w : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + let q := bundle.normalizedPresentation + let e (i : Fin 3) := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let d (i : Fin 3) := cOff (e i) + ∀ (i : Fin 3), ∀ (s : Bool), TileCentroid (placement.layout.P i s) = TileCentroid + bundle.normalizedFixed + (if s = true then (1 : Real) else -1) • d i ) := by + classical + intro C D T N h k x bundle placement cOff q e d i s + have hp : TileCentroid (placement.layout.P i s) - TileCentroid bundle.normalizedFixed = + (if s = true then (1 : Real) else -1) • d i := + (placement.layout.outer_occurrence i s).2.2 + rw [sub_eq_iff_eq_add] at hp + exact hp.trans (add_comm _ _) + +private theorem occurrence_center : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + let cOff (w : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + let q := bundle.normalizedPresentation + let e (i : Fin 3) := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let d (i : Fin 3) := cOff (e i) + (∀ (i : Fin 3), ∀ (s : Bool), TileCentroid (placement.layout.P i s) = TileCentroid + bundle.normalizedFixed + (if s = true then (1 : Real) else -1) • d i) → ((∀ (V : + ProtoTile), ∀ (w : GaussianInt), TileCentroid (TileTranslation V w) = TileCentroid V + + GaussianRealPoint w) → (∀ (idx : PeriodicSubtileIndex), TileCentroid (occurrence + idx) - TileCentroid bundle.normalizedFixed = (match idx.label with + | .A => d 0 + | .B => -d 0 + | .C => d 1 + | .D => -d 1 + | .E => d 2 + | .F => -d 2) + GaussianRealPoint + ((idx.first : GaussianInt) * placement.layout.u + (idx.second : GaussianInt) * + placement.layout.v))) ) := by + classical + intro C D T N h k x bundle placement occurrence cOff q e d parent_center translate_center idx + rcases idx with ⟨label, m, n⟩ + cases label <;> + simp only [occurrence, SubtileOccurrenceInterpretation, translate_center, + parent_center, Bool.false_eq_true, ite_false, ite_true, one_smul, neg_one_smul] + all_goals abel + +private theorem raw_centers : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let I : GaussianInt := ⟨0, 1⟩ + let branchDisplacement (i : Fin 3) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint ((I - 1) * + BandVectors.1 (bundle.normalizedPresentation i.succ) + (bundle.normalizedPresentation 0)) + let quarterTurn (p : Real × Real) : Real × Real := (-p.2, p.1) + let branchCenter (E : Real × Real) (b : Fin 4) : Real × Real := + if b = 0 then -E + else if b = 1 then quarterTurn E + else if b = 2 then E + else -quarterTurn E + let cOff (w : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + let q := bundle.normalizedPresentation + let o (i : Fin 3) := BandVectors.1 (q 0) (q i.succ) + let e (i : Fin 3) := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let d (i : Fin 3) := cOff (e i) + (∀ (i : Fin 3), d i + GaussianRealPoint (o (i + 2)) = -branchDisplacement i) → ((∀ (i : + Fin 3), -d i + GaussianRealPoint (o (i + 1)) = quarterTurn (branchDisplacement i)) → + (∀ (i : Fin 3), (d i + GaussianRealPoint (o (i + 2)) = branchCenter + (branchDisplacement i) 0) ∧ (-d i + GaussianRealPoint (o (i + 1)) = branchCenter + (branchDisplacement i) 1) ∧ (-d i - GaussianRealPoint (o (i + 2)) = branchCenter + (branchDisplacement i) 2) ∧ (d i - GaussianRealPoint (o (i + 1)) = branchCenter + (branchDisplacement i) 3))) ) := by + classical + intro C D T N h k x bundle I branchDisplacement quarterTurn branchCenter cOff q o e d + first_center second_center i + refine ⟨first_center i, second_center i, ?_, ?_⟩ + · change -d i - GaussianRealPoint (o (i + 2)) = branchDisplacement i + calc + _ = -(d i + GaussianRealPoint (o (i + 2))) := by abel + _ = _ := by rw [first_center, neg_neg] + · change d i - GaussianRealPoint (o (i + 1)) = + -quarterTurn (branchDisplacement i) + calc + _ = -(-d i + GaussianRealPoint (o (i + 1))) := by abel + _ = _ := by rw [second_center] + +private theorem row_data : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), + ∀ (row : BandOrderedGeneralSelectedContactRow bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedFixed placement.layout + a b), (placement.exteriorIndex = a) → ((placement.centralIndex = b) → (∀ (z : + P3996T1SRowParameters), (P3996T1SRowTable bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedFixed placement.layout + row = some z) → ( + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + let exteriorSlot : Fin 3 := + match placement.exteriorIndex.label with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + (bundle.selectedSlot = exteriorSlot) → ( + let I : GaussianInt := ⟨0, 1⟩ + let branchDisplacement (i : Fin 3) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint ((I - 1) * + BandVectors.1 (bundle.normalizedPresentation i.succ) + (bundle.normalizedPresentation 0)) + let quarterTurn (p : Real × Real) : Real × Real := (-p.2, p.1) + let branchCenter (E : Real × Real) (b : Fin 4) : Real × Real := + if b = 0 then -E + else if b = 1 then quarterTurn E + else if b = 2 then E + else -quarterTurn E + let cOff (w : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + (∀ (g : GaussianInt), GaussianRealPoint (-g) = -GaussianRealPoint g) → ( + let q := bundle.normalizedPresentation + let o (i : Fin 3) := BandVectors.1 (q 0) (q i.succ) + let e (i : Fin 3) := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let d (i : Fin 3) := cOff (e i) + let exteriorCenter := TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed + (placement.layout.u = o 0) → ((placement.layout.v = o 1) → ((o 2 = -o 0 - o 1) → ((∀ (v : + GaussianInt), ∀ (w : GaussianInt), GaussianRealPoint (v + w) = GaussianRealPoint v + + GaussianRealPoint w) → ((∀ (idx : PeriodicSubtileIndex), TileCentroid (occurrence + idx) - TileCentroid bundle.normalizedFixed = (match idx.label with + | .A => d 0 + | .B => -d 0 + | .C => d 1 + | .D => -d 1 + | .E => d 2 + | .F => -d 2) + GaussianRealPoint + ((idx.first : GaussianInt) * placement.layout.u + (idx.second : GaussianInt) * + placement.layout.v)) → ((∀ (i : Fin 3), (d i + GaussianRealPoint (o (i + 2)) = + branchCenter (branchDisplacement i) 0) ∧ (-d i + GaussianRealPoint (o (i + 1)) = + branchCenter (branchDisplacement i) 1) ∧ (-d i - GaussianRealPoint (o (i + 2)) = + branchCenter (branchDisplacement i) 2) ∧ (d i - GaussianRealPoint (o (i + 1)) = + branchCenter (branchDisplacement i) 3)) → (∃ n : Fin 4, exteriorCenter = branchCenter + (branchDisplacement bundle.selectedSlot) n ∧ z.oldShift = if n.val < 2 then -o + bundle.selectedSlot else o bundle.selectedSlot))))))))))) ) := by + classical + intro C D T N h k x bundle placement a b row ha hb z hz occurrence exteriorSlot selected_slot I + branchDisplacement quarterTurn branchCenter cOff gp_neg_any q o e d exteriorCenter period0 + period1 third_period gp_add occurrence_center raw_centers + -- Evaluate the twelve literal exterior occurrences using the shared centers. + cases row <;> simp only [P3996T1SRowTable] at hz <;> cases hz + case positiveS1 => + have hs : bundle.selectedSlot = 0 := by simpa [exteriorSlot, ha] using selected_slot + refine ⟨0, ?_, ?_⟩ + · have hc := (raw_centers 0).1 + simp only [hs] + change TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed = _ + rw [occurrence_center] + simpa [ha, period0, period1, third_period, gp_add, gp_neg_any, + sub_eq_add_neg, neg_add, Fin.add_def] using hc + · simp [hs, period0] + case positiveS2 => + have hs : bundle.selectedSlot = 0 := by simpa [exteriorSlot, ha] using selected_slot + refine ⟨3, ?_, ?_⟩ + · have hc := (raw_centers 0).2.2.2 + simp only [hs] + change TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed = _ + rw [occurrence_center] + simpa [ha, period0, period1, third_period, gp_add, gp_neg_any, + sub_eq_add_neg, neg_add, Fin.add_def] using hc + · simp [hs, period0] + case positiveS3 => + have hs : bundle.selectedSlot = 1 := by simpa [exteriorSlot, ha] using selected_slot + refine ⟨0, ?_, ?_⟩ + · have hc := (raw_centers 1).1 + simp only [hs] + change TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed = _ + rw [occurrence_center] + simpa [ha, period0, period1, third_period, gp_add, gp_neg_any, + sub_eq_add_neg, neg_add, Fin.add_def] using hc + · simp [hs, period1] + case positiveS4 => + have hs : bundle.selectedSlot = 1 := by simpa [exteriorSlot, ha] using selected_slot + refine ⟨3, ?_, ?_⟩ + · have hc := (raw_centers 1).2.2.2 + simp only [hs] + change TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed = _ + rw [occurrence_center] + convert hc using 1 + simp [ha, period0, period1, third_period, gp_add, gp_neg_any, + sub_eq_add_neg, Fin.add_def] + abel + · simp [hs, period1] + case positiveS5 => + have hs : bundle.selectedSlot = 2 := by simpa [exteriorSlot, ha] using selected_slot + refine ⟨0, ?_, ?_⟩ + · have hc := (raw_centers 2).1 + simp only [hs] + change TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed = _ + rw [occurrence_center] + simpa [ha, period0, period1, third_period, gp_add, gp_neg_any, + sub_eq_add_neg, neg_add, Fin.add_def] using hc + · simp [hs, period0, period1, third_period] + abel + case positiveS6 => + have hs : bundle.selectedSlot = 2 := by simpa [exteriorSlot, ha] using selected_slot + refine ⟨3, ?_, ?_⟩ + · have hc := (raw_centers 2).2.2.2 + simp only [hs] + change TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed = _ + rw [occurrence_center] + simpa [ha, period0, period1, third_period, gp_add, gp_neg_any, + sub_eq_add_neg, neg_add, Fin.add_def] using hc + · simp [hs, period0, period1, third_period] + case reflectedS1 => + have hs : bundle.selectedSlot = 0 := by simpa [exteriorSlot, ha] using selected_slot + refine ⟨2, ?_, ?_⟩ + · have hc := (raw_centers 0).2.2.1 + simp only [hs] + change TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed = _ + rw [occurrence_center] + convert hc using 1 + simp [ha, period0, period1, third_period, gp_add, gp_neg_any, sub_eq_add_neg] + abel + · simp [hs, period0] + case reflectedS2 => + have hs : bundle.selectedSlot = 0 := by simpa [exteriorSlot, ha] using selected_slot + refine ⟨1, ?_, ?_⟩ + · have hc := (raw_centers 0).2.1 + simp only [hs] + change TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed = _ + rw [occurrence_center] + simpa [ha, period0, period1, third_period, gp_add, gp_neg_any, + sub_eq_add_neg, neg_add, Fin.add_def] using hc + · simp [hs, period0] + case reflectedS3 => + have hs : bundle.selectedSlot = 1 := by simpa [exteriorSlot, ha] using selected_slot + refine ⟨2, ?_, ?_⟩ + · have hc := (raw_centers 1).2.2.1 + simp only [hs] + change TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed = _ + rw [occurrence_center] + simpa [ha, period0, period1, third_period, gp_add, gp_neg_any, + sub_eq_add_neg, neg_add, Fin.add_def] using hc + · simp [hs, period1] + case reflectedS4 => + have hs : bundle.selectedSlot = 1 := by simpa [exteriorSlot, ha] using selected_slot + refine ⟨1, ?_, ?_⟩ + · have hc := (raw_centers 1).2.1 + simp only [hs] + change TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed = _ + rw [occurrence_center] + simpa [ha, period0, period1, third_period, gp_add, gp_neg_any, + sub_eq_add_neg, neg_add, Fin.add_def] using hc + · simp [hs, period1] + case reflectedS5 => + have hs : bundle.selectedSlot = 2 := by simpa [exteriorSlot, ha] using selected_slot + refine ⟨2, ?_, ?_⟩ + · have hc := (raw_centers 2).2.2.1 + simp only [hs] + change TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed = _ + rw [occurrence_center] + simpa [ha, period0, period1, third_period, gp_add, gp_neg_any, + sub_eq_add_neg, neg_add, Fin.add_def] using hc + · simp [hs, period0, period1, third_period] + case reflectedS6 => + have hs : bundle.selectedSlot = 2 := by simpa [exteriorSlot, ha] using selected_slot + refine ⟨1, ?_, ?_⟩ + · have hc := (raw_centers 2).2.1 + simp only [hs] + change TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed = _ + rw [occurrence_center] + simpa [ha, period0, period1, third_period, gp_add, gp_neg_any, + sub_eq_add_neg, neg_add, Fin.add_def] using hc + · simp [hs, period0, period1, third_period] + abel + +private theorem identify : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + let I : GaussianInt := ⟨0, 1⟩ + let branchDisplacement (i : Fin 3) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint ((I - 1) * + BandVectors.1 (bundle.normalizedPresentation i.succ) + (bundle.normalizedPresentation 0)) + (∀ (i : Fin 3), branchDisplacement i ≠ (0, 0)) → ( + let quarterTurn (p : Real × Real) : Real × Real := (-p.2, p.1) + let branchCenter (E : Real × Real) (b : Fin 4) : Real × Real := + if b = 0 then -E + else if b = 1 then quarterTurn E + else if b = 2 then E + else -quarterTurn E + (∀ (E : Real × Real), (E ≠ (0, 0)) → (∀ (b : Fin 4), ∀ (c : Fin 4), (b ≠ c) → + (branchCenter E b ≠ branchCenter E c))) → ( + let exteriorCenter := TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed + ∀ (n : Fin (4 : ℕ)), (exteriorCenter = branchCenter (branchDisplacement + bundle.selectedSlot) n) → (∀ (m : Fin 4), (exteriorCenter = branchCenter + (branchDisplacement bundle.selectedSlot) m) → (n = m)))) ) := by + classical + intro C D T N h k x bundle placement occurrence I branchDisplacement branchDisplacement_nonzero + quarterTurn branchCenter four_centers_distinct exteriorCenter n hrow m hc + by_contra hne + exact (four_centers_distinct _ (branchDisplacement_nonzero _) n m hne) + (hrow.symm.trans hc) + +end PlacementCompanionGeometry + +theorem P3996T1PlacementCompanionBlocks + (C D : BandCircle) (T N : ProtoTile) (h k : PartialOdometer) + (x : GaussianInt) + (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x) + (placement : BandOrderedGeneralRightPlacement bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction + bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces + bundle.functions bundle.selectedSlot bundle.selectedSign bundle.routedDirection) + (a b : PeriodicSubtileIndex) + (row : BandOrderedGeneralSelectedContactRow bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedFixed + placement.layout a b) + (ha : placement.exteriorIndex = a) (hb : placement.centralIndex = b) + (z : P3996T1SRowParameters) + (hz : P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed placement.layout row = some z) : + let q := bundle.normalizedPresentation + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ bundle.selectedSign = true → + -BandVectors.1 (q 0) (q placement.rightFirstSlot.succ) = z.oldShift) ∧ + (placement.rightNeighborPositive = true ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ bundle.selectedSign = false → + -BandVectors.1 (q 0) (q placement.rightSecondSlot.succ) = z.oldShift) ∧ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightFirstSlot ∧ bundle.selectedSign = false → + BandVectors.1 (q 0) (q placement.rightFirstSlot.succ) = z.oldShift) ∧ + (placement.rightNeighborPositive = false ∧ + bundle.selectedSlot = placement.rightSecondSlot ∧ bundle.selectedSign = true → + BandVectors.1 (q 0) (q placement.rightSecondSlot.succ) = z.oldShift) := by +-- BODY + classical + -- Distinct parent areas identify the selected slot without assuming its sign. + have area_of_band := PlacementCompanionGeometry.area_of_band + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + have area_translation (V : ProtoTile) (d : GaussianInt) : + TileArea (TileTranslation V d) = TileArea V := + (TileDiskAreaCovariance V d).2.2.2.1 + have positive_parent := PlacementCompanionGeometry.positive_parent C D T N h k x bundle placement + have strict_parent12 : + (bundle.normalizedPresentation 2).1 < + (bundle.normalizedPresentation 1).1 := bundle.configuration.order12 + let exteriorSlot : Fin 3 := + match placement.exteriorIndex.label with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + have selected_slot : bundle.selectedSlot = exteriorSlot := + (PlacementCompanionGeometry.slot_of_exterior C D T N h k x bundle placement area_of_band + (PlacementCompanionGeometry.selected_area C D T N h k x bundle placement area_translation + (PlacementCompanionGeometry.area_cells)) (PlacementCompanionGeometry.slot_of_count C D T + N h k x bundle placement a positive_parent strict_parent12 + (PlacementCompanionGeometry.strict_parent23 C D T N h k x bundle))) exteriorSlot + (PlacementCompanionGeometry.exterior_area C D T N h k x bundle placement + (PlacementCompanionGeometry.occurrence_area C D T N h k x bundle placement area_of_band + area_translation)) + let pieceOffset : Real × Real := + GaussianRealPoint + (BandVectors.1 + (bundle.normalizedPresentation ((bundle.selectedSlot + 2).succ)) + (bundle.normalizedPresentation ((bundle.selectedSlot + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 + (bundle.normalizedPresentation ((bundle.selectedSlot + 2).succ)) + (bundle.normalizedPresentation ((bundle.selectedSlot + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 + (bundle.normalizedPresentation ((bundle.selectedSlot + 2).succ)) + (bundle.normalizedPresentation ((bundle.selectedSlot + 1).succ)))).1) + have flip_incoming := PlacementCompanionGeometry.flip_incoming C D T N h k x bundle + let I : GaussianInt := ⟨0, 1⟩ + let branchDisplacement (i : Fin 3) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint ((I - 1) * + BandVectors.1 (bundle.normalizedPresentation i.succ) + (bundle.normalizedPresentation 0)) + have branchDisplacement_nonzero := PlacementCompanionGeometry.branchDisplacement_nonzero C D T + N h k x bundle (PlacementCompanionGeometry.incoming_nonzero C D T N h k x bundle + positive_parent) (PlacementCompanionGeometry.realPoint_injective) + let quarterTurn (p : Real × Real) : Real × Real := (-p.2, p.1) + -- The four possible placement centers are distinct at every parent slot. + let branchCenter (E : Real × Real) (b : Fin 4) : Real × Real := + if b = 0 then -E + else if b = 1 then quarterTurn E + else if b = 2 then E + else -quarterTurn E + have four_centers_distinct := PlacementCompanionGeometry.four_centers_distinct + let cOff (w : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) + let edgeCenter (a : GaussianInt) : Real × Real := + (1 / 2 : Real) • GaussianRealPoint ((I - 1) * a) + have cancel2 := PlacementCompanionGeometry.cancel2 + have gp_neg_any := PlacementCompanionGeometry.gp_neg_any + let q := bundle.normalizedPresentation + let o (i : Fin 3) := BandVectors.1 (q 0) (q i.succ) + let e (i : Fin 3) := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let d (i : Fin 3) := cOff (e i) + have first_center := PlacementCompanionGeometry.first_center C D T N h k x bundle flip_incoming + (PlacementCompanionGeometry.centerAlgFirst cancel2) + have second_center := PlacementCompanionGeometry.second_center C D T N h k x bundle + flip_incoming (PlacementCompanionGeometry.centerAlgSecond cancel2) + let exteriorCenter := TileCentroid (occurrence placement.exteriorIndex) - + TileCentroid bundle.normalizedFixed + have placement_center : exteriorCenter = + (if bundle.selectedSign = true then (1 : Real) else -1) • + d bundle.selectedSlot + GaussianRealPoint placement.rightNeighborDisplacement := + (PlacementCompanionGeometry.selected_center C D T N h k x bundle placement) + have placement_centers := PlacementCompanionGeometry.placement_centers C D T N h k x bundle + placement + gp_neg_any first_center second_center placement_center + (PlacementCompanionGeometry.cyclic_slots C D T N h k x bundle placement) + (PlacementCompanionGeometry.displacement C D T N h k x bundle placement) + have period0 : placement.layout.u = o 0 := placement.layout.period_u + have period1 : placement.layout.v = o 1 := placement.layout.period_v + have translate_center (V : ProtoTile) (w : GaussianInt) : + TileCentroid (TileTranslation V w) = TileCentroid V + GaussianRealPoint w := + (TileTranslationFormulas V w).2.2.2.2.1 + have row_data := PlacementCompanionGeometry.row_data C D T N h k x bundle placement a b row ha + hb z hz + selected_slot gp_neg_any period0 period1 (PlacementCompanionGeometry.third_period C D T + N h k x bundle) (PlacementCompanionGeometry.gp_add) + (PlacementCompanionGeometry.occurrence_center C D T N h k x bundle placement + (PlacementCompanionGeometry.parent_center C D T N h k x bundle placement) + translate_center) (PlacementCompanionGeometry.raw_centers C D T N h k x bundle + first_center second_center) + obtain ⟨n, hrow, hshift⟩ := row_data + have identify := PlacementCompanionGeometry.identify C D T N h k x bundle placement + branchDisplacement_nonzero four_centers_distinct n hrow + refine ⟨?_, ?_, ?_, ?_⟩ + · intro hbranch + have hn := identify 0 (placement_centers.1 hbranch) + have hs : z.oldShift = -o bundle.selectedSlot := by simpa [hn] using hshift + change -o placement.rightFirstSlot = z.oldShift + simpa only [hbranch.2.1] using hs.symm + · intro hbranch + have hn := identify 1 (placement_centers.2.1 hbranch) + have hs : z.oldShift = -o bundle.selectedSlot := by simpa [hn] using hshift + change -o placement.rightSecondSlot = z.oldShift + simpa only [hbranch.2.1] using hs.symm + · intro hbranch + have hn := identify 2 (placement_centers.2.2.1 hbranch) + have hs : z.oldShift = o bundle.selectedSlot := by simpa [hn] using hshift + change o placement.rightFirstSlot = z.oldShift + simpa only [hbranch.2.1] using hs.symm + · intro hbranch + have hn := identify 3 (placement_centers.2.2.2 hbranch) + have hs : z.oldShift = o bundle.selectedSlot := by simpa [hn] using hshift + change o placement.rightSecondSlot = z.oldShift + simpa only [hbranch.2.1] using hs.symm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean b/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean new file mode 100644 index 0000000000..8ded38a1f1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean @@ -0,0 +1,1046 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3996T1SRowTable +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms + +-- [TABLET NODE: P3996T1SRowAlignment] + +/-! +# P3996T1SRowAlignment + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SRowAlignmentGeometry + +private theorem q1pos : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (0 < (q 1).1) ) + := by + classical + intro q cfg + have h12 := cfg.order12 + have h2 := cfg.secondLarge + omega + +private theorem q2pos : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (0 < (q 2).1) ) + := by + classical + intro q cfg + have h2 := cfg.secondLarge + omega + +private theorem q3pos : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (0 < (q 3).1) ) + := by + classical + intro q cfg + have h := (ProperBandCurvatureStructure q cfg.proper).2.1 2 + exact lt_of_le_of_ne h (Ne.symm (cfg.noLine 3)) + +private theorem occA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (m : Int), ∀ (n : Int), BandPrototile (q 1) (SubtileOccurrenceInterpretation + cert.P cert.u cert.v ⟨.A, m, n⟩) ) := by + classical + intro q cfg C T cert m n + simp only [SubtileOccurrenceInterpretation] + exact BandPrototileTranslation _ _ _ (cert.outer_occurrence 0 true).1 + +private theorem occB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (m : Int), ∀ (n : Int), BandPrototile (q 1) (SubtileOccurrenceInterpretation + cert.P cert.u cert.v ⟨.B, m, n⟩) ) := by + classical + intro q cfg C T cert m n + simp only [SubtileOccurrenceInterpretation] + exact BandPrototileTranslation _ _ _ (cert.outer_occurrence 0 false).1 + +private theorem occC : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (m : Int), ∀ (n : Int), BandPrototile (q 2) (SubtileOccurrenceInterpretation + cert.P cert.u cert.v ⟨.C, m, n⟩) ) := by + classical + intro q cfg C T cert m n + simp only [SubtileOccurrenceInterpretation] + exact BandPrototileTranslation _ _ _ (cert.outer_occurrence 1 true).1 + +private theorem occD : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (m : Int), ∀ (n : Int), BandPrototile (q 2) (SubtileOccurrenceInterpretation + cert.P cert.u cert.v ⟨.D, m, n⟩) ) := by + classical + intro q cfg C T cert m n + simp only [SubtileOccurrenceInterpretation] + exact BandPrototileTranslation _ _ _ (cert.outer_occurrence 1 false).1 + +private theorem occE : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (m : Int), ∀ (n : Int), BandPrototile (q 3) (SubtileOccurrenceInterpretation + cert.P cert.u cert.v ⟨.E, m, n⟩) ) := by + classical + intro q cfg C T cert m n + simp only [SubtileOccurrenceInterpretation] + exact BandPrototileTranslation _ _ _ (cert.outer_occurrence 2 true).1 + +private theorem occF : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (m : Int), ∀ (n : Int), BandPrototile (q 3) (SubtileOccurrenceInterpretation + cert.P cert.u cert.v ⟨.F, m, n⟩) ) := by + classical + intro q cfg C T cert m n + simp only [SubtileOccurrenceInterpretation] + exact BandPrototileTranslation _ _ _ (cert.outer_occurrence 2 false).1 + +private theorem cellsTranslate : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (d : GaussianInt), (TileTranslation X d).cells = X.cells.image + (GaussianTranslation d) ) := by + classical + intro X d + exact (TileTranslationFormulas X d).1 + +private theorem anchorTranslate : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (d : GaussianInt), (TileTranslation X d).anchor = + GaussianTranslation d X.anchor ) := by + classical + intro X d + exact (TileTranslationFormulas X d).2.1 + +private theorem centroidTranslate : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (d : GaussianInt), TileCentroid (TileTranslation X d) = + ((TileCentroid X).1 + (d.re : Real), (TileCentroid X).2 + (d.im : Real)) ) := by + classical + intro X d + have h := (TileTranslationFormulas X d).2.2.2.2.1 + simpa [GaussianRealPoint] using h + +private theorem translationCentroidGP : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (d : GaussianInt), TileCentroid (TileTranslation X d) = + ((TileCentroid X).1 + (d.re : Real), (TileCentroid X).2 + (d.im : Real))) → (∀ (X : + ProtoTile), ∀ (d : GaussianInt), TileCentroid (TileTranslation X d) = TileCentroid X + + GaussianRealPoint d) ) := by + classical + intro centroidTranslate X d + rw [centroidTranslate] + ext <;> simp [GaussianRealPoint] + +private theorem composeCells : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (d : GaussianInt), (TileTranslation X d).cells = X.cells.image + (GaussianTranslation d)) → (∀ (X : ProtoTile), ∀ (s : GaussianInt), ∀ (d : + GaussianInt), (TileTranslation (TileTranslation X s) d).cells = (TileTranslation X (s + + d)).cells) ) := by + classical + intro cellsTranslate X s d + rw [cellsTranslate, cellsTranslate, cellsTranslate, Finset.image_image] + congr 1 + funext x + simp [GaussianTranslation] + abel + +private theorem composeCellsEq : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (d : GaussianInt), (TileTranslation X d).cells = X.cells.image + (GaussianTranslation d)) → (∀ (X : ProtoTile), ∀ (s : GaussianInt), ∀ (d : + GaussianInt), ∀ (t : GaussianInt), (s + d = t) → ((TileTranslation (TileTranslation X + s) d).cells = (TileTranslation X t).cells)) ) := by + classical + intro cellsTranslate X s d t h + rw [cellsTranslate, cellsTranslate, cellsTranslate, Finset.image_image] + congr 1 + funext x + simp only [Function.comp_apply, GaussianTranslation] + calc + x + s + d = x + (s + d) := by abel + _ = x + t := by rw [h] + +private theorem composeAnchor : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (s : GaussianInt), ∀ (d : GaussianInt), (TileTranslation + (TileTranslation X s) d).anchor = (TileTranslation X (s + d)).anchor ) := by + classical + intro X s d + simp [TileTranslation, GaussianTranslation] + abel + +private theorem composeAnchorEq : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (s : GaussianInt), ∀ (d : GaussianInt), (TileTranslation + (TileTranslation X s) d).anchor = (TileTranslation X (s + d)).anchor) → (∀ (X : + ProtoTile), ∀ (s : GaussianInt), ∀ (d : GaussianInt), ∀ (t : GaussianInt), (s + d = + t) → ((TileTranslation (TileTranslation X s) d).anchor = (TileTranslation X + t).anchor)) ) := by + classical + intro composeAnchor X s d t h + rw [composeAnchor, h] + +private theorem cI3 : + (by + classical + exact + (GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) ^ 3 = -GaussianInt.toComplex (⟨0, 1⟩ : + GaussianInt) ) := by + classical + norm_num [GaussianInt.toComplex_def] + +private theorem p0plus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let cOff (g : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint g - (-(GaussianRealPoint g).2, (GaussianRealPoint + g).1)) + TileCentroid (cert.P 0 true) - TileCentroid T = cOff (BandVectors.1 (q 3) (q 2)) ) := by + classical + intro q cfg C T cert cOff + simpa [cOff, BandSubtileOccurrence, Fin.add_def, GaussianRealPoint] using + (cert.outer_occurrence 0 true).2.2 + +private theorem p0minus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let cOff (g : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint g - (-(GaussianRealPoint g).2, (GaussianRealPoint + g).1)) + TileCentroid (cert.P 0 false) - TileCentroid T = -cOff (BandVectors.1 (q 3) (q 2)) ) := by + classical + intro q cfg C T cert cOff + simpa [cOff, BandSubtileOccurrence, Fin.add_def, GaussianRealPoint] using + (cert.outer_occurrence 0 false).2.2 + +private theorem p1plus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let cOff (g : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint g - (-(GaussianRealPoint g).2, (GaussianRealPoint + g).1)) + TileCentroid (cert.P 1 true) - TileCentroid T = cOff (BandVectors.1 (q 1) (q 3)) ) := by + classical + intro q cfg C T cert cOff + simpa [cOff, BandSubtileOccurrence, Fin.add_def, GaussianRealPoint] using + (cert.outer_occurrence 1 true).2.2 + +private theorem p1minus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let cOff (g : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint g - (-(GaussianRealPoint g).2, (GaussianRealPoint + g).1)) + TileCentroid (cert.P 1 false) - TileCentroid T = -cOff (BandVectors.1 (q 1) (q 3)) ) := by + classical + intro q cfg C T cert cOff + simpa [cOff, BandSubtileOccurrence, Fin.add_def, GaussianRealPoint] using + (cert.outer_occurrence 1 false).2.2 + +private theorem p0plusAbs : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let cOff (g : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint g - (-(GaussianRealPoint g).2, (GaussianRealPoint + g).1)) + (TileCentroid (cert.P 0 true) - TileCentroid T = cOff (BandVectors.1 (q 3) (q 2))) → + (TileCentroid (cert.P 0 true) = TileCentroid T + cOff (BandVectors.1 (q 3) (q 2))) ) + := by + classical + intro q cfg C T cert cOff p0plus + calc + _ = (TileCentroid (cert.P 0 true) - TileCentroid T) + TileCentroid T := by abel + _ = _ := by rw [p0plus]; exact add_comm _ _ + +private theorem p0minusAbs : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let cOff (g : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint g - (-(GaussianRealPoint g).2, (GaussianRealPoint + g).1)) + (TileCentroid (cert.P 0 false) - TileCentroid T = -cOff (BandVectors.1 (q 3) (q 2))) → + (TileCentroid (cert.P 0 false) = TileCentroid T - cOff (BandVectors.1 (q 3) (q 2))) ) + := by + classical + intro q cfg C T cert cOff p0minus + calc + _ = (TileCentroid (cert.P 0 false) - TileCentroid T) + TileCentroid T := by abel + _ = _ := by rw [p0minus]; abel + +private theorem p1plusAbs : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let cOff (g : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint g - (-(GaussianRealPoint g).2, (GaussianRealPoint + g).1)) + (TileCentroid (cert.P 1 true) - TileCentroid T = cOff (BandVectors.1 (q 1) (q 3))) → + (TileCentroid (cert.P 1 true) = TileCentroid T + cOff (BandVectors.1 (q 1) (q 3))) ) + := by + classical + intro q cfg C T cert cOff p1plus + calc + _ = (TileCentroid (cert.P 1 true) - TileCentroid T) + TileCentroid T := by abel + _ = _ := by rw [p1plus]; exact add_comm _ _ + +private theorem p1minusAbs : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let cOff (g : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint g - (-(GaussianRealPoint g).2, (GaussianRealPoint + g).1)) + (TileCentroid (cert.P 1 false) - TileCentroid T = -cOff (BandVectors.1 (q 1) (q 3))) → + (TileCentroid (cert.P 1 false) = TileCentroid T - cOff (BandVectors.1 (q 1) (q 3))) ) + := by + classical + intro q cfg C T cert cOff p1minus + calc + _ = (TileCentroid (cert.P 1 false) - TileCentroid T) + TileCentroid T := by abel + _ = _ := by rw [p1minus]; abel + +private theorem q13 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let a : GaussianInt := BandVectors.1 (q 2) (q 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : + ℕ))) = (0 : GaussianInt)) → (BandVectors.1 (q 1) (q 3) = -a - w) ) := by + classical + intro q a w qCycle + dsimp [a, w] + linear_combination qCycle + +private theorem q10 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ( + let a : GaussianInt := BandVectors.1 (q 2) (q 1) + let I : GaussianInt := ⟨0, 1⟩ + BandVectors.1 (q 1) (q 0) = BandVectors.1 (q 1) (q 3) - I * a) ) := by + classical + intro q cfg a I + simpa [a, I] using (VectorRecursionLaws q cfg.proper.1).2.2.1 + +private theorem q20 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ( + let a : GaussianInt := BandVectors.1 (q 2) (q 1) + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 2) (q 0) = a - I * w) ) := by + classical + intro q cfg a I w + simpa [a, w, I] using + (VectorRecursionLaws ![q 0, q 2, q 3, q 1] + (SemiProperQuadruple.rotate cfg.proper.1)).2.2.1 + +private theorem certU : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let a : GaussianInt := BandVectors.1 (q 2) (q 1) + let I : GaussianInt := ⟨0, 1⟩ + (I * I = -1) → ( + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (q 1) (q 3) = -a - w) → ((BandVectors.1 (q 1) (q 0) = BandVectors.1 (q 1) + (q 3) - I * a) → ((BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (Fin.succ (0 : Fin (3 : + ℕ)))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (Fin.succ (0 : Fin (3 : + ℕ)))) (q (0 : Fin (4 : ℕ)))) → (cert.u = (1 - I) * a - I * w)))) ) := by + classical + intro q cfg C T cert a I hI2 w q13 q10 qflip1 + calc + cert.u = BandVectors.1 (q 0) (q 1) := cert.period_u + _ = I * BandVectors.1 (q 1) (q 0) := qflip1 + _ = (1 - I) * a - I * w := by + rw [q10, q13] + have hprod : I * (-a - w - I * a) = (1 - I) * a - I * w := by + rw [show I * (-a - w - I * a) = -(I * a) - I * w - (I * I) * a by ring, + hI2] + ring + exact hprod + +private theorem certV : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let a : GaussianInt := BandVectors.1 (q 2) (q 1) + let I : GaussianInt := ⟨0, 1⟩ + (I * I = -1) → ( + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (Fin.succ (1 : Fin (3 : ℕ)))) = (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (q (Fin.succ (1 : Fin (3 : ℕ)))) (q (0 : Fin (4 : + ℕ)))) → ((BandVectors.1 (q 2) (q 0) = a - I * w) → (cert.v = I * a + w))) ) := by + classical + intro q cfg C T cert a I hI2 w qflip2 q20 + calc + cert.v = BandVectors.1 (q 0) (q 2) := cert.period_v + _ = I * BandVectors.1 (q 2) (q 0) := qflip2 + _ = I * a + w := by + rw [q20] + have hprod : I * (a - I * w) = I * a + w := by + rw [show I * (a - I * w) = I * a - (I * I) * w by ring, hI2] + ring + exact hprod + +private theorem rvec2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let a : GaussianInt := BandVectors.1 (q 2) (q 1) + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.1 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor (Fin.succ + (1 : Fin (3 : ℕ)))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 + (cfg.firstPredecessor (Fin.succ (1 : Fin (3 : ℕ)))) (cfg.firstPredecessor (0 : Fin (4 + : ℕ)))) → (BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = I * a) ) + := by + classical + intro q cfg a I rflip1 + calc + _ = I * BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) := rflip1 + _ = I * a := by rw [cfg.firstVectorTwo] + +private theorem rvec3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let a : GaussianInt := BandVectors.1 (q 2) (q 1) + let I : GaussianInt := ⟨0, 1⟩ + (-I * I = 1) → ( + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (q 1) (q 3) = -a - w) → ((BandVectors.1 (cfg.firstPredecessor (0 : Fin (4 + : ℕ))) (cfg.firstPredecessor (Fin.succ (2 : Fin (3 : ℕ)))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.1 (cfg.firstPredecessor (Fin.succ (2 : Fin (3 : ℕ)))) + (cfg.firstPredecessor (0 : Fin (4 : ℕ)))) → (BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0) = I * (a + w)))) ) := by + classical + intro q cfg a I hIinv w q13 rflip2 + have hflip : BandVectors.1 (q 1) (q 3) = + I * BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) := by + rw [← cfg.firstChild, ← cfg.firstParentThree] + exact rflip2 + have h : BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = + -I * BandVectors.1 (q 1) (q 3) := by + calc + _ = (-I * I) * BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) := by + rw [hIinv, one_mul] + _ = -I * (I * BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0)) := by ring + _ = -I * BandVectors.1 (q 1) (q 3) := by rw [← hflip] + rw [h, q13] + have hprod : -I * (-a - w) = I * (a + w) := by + rw [show -I * (-a - w) = I * a + I * w by ring] + ring + exact hprod + +private theorem tvec1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) = I * w ) := by + classical + intro q cfg I w + have tf := (VectorRecursionLaws cfg.secondPredecessor cfg.secondProper.1).2.2.2.2 + cfg.secondProper 0 |>.1 + calc + _ = I * BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) := tf + _ = I * w := by rw [cfg.secondVectorOne] + +private theorem qnormal : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ( + let a : GaussianInt := BandVectors.1 (q 2) (q 1) + let I : GaussianInt := ⟨0, 1⟩ + BandVectors.1 (q 1) (q 2) = I * a) ) := by + classical + intro q cfg a I + have h := P3055T1ParentVectorNormalForms q cfg + dsimp only at h + exact h.2.1 + +private theorem q31 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ( + let a : GaussianInt := BandVectors.1 (q 2) (q 1) + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 3) (q 1) = I * (a + w)) ) := by + classical + intro q cfg a I w + have h := P3055T1ParentVectorNormalForms q cfg + dsimp only at h + exact h.2.2.1 + +private theorem q23 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 2) (q 3) = I * w) ) := by + classical + intro q cfg I w + have h := P3055T1ParentVectorNormalForms q cfg + dsimp only at h + exact h.2.2.2.1 + +end SRowAlignmentGeometry + +namespace SRowCaseAlignment + +private theorem rowAlignment : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (z : + P3996T1SRowParameters), (P3996T1SRowTable q cfg C T cert row = some z) → ((0 < (q + 1).1) → ((0 < (q 2).1) → ((0 < (q 3).1) → ((ProperBandQuadruple cfg.firstPredecessor) + → ((ProperBandQuadruple cfg.secondPredecessor) → ((cfg.firstPredecessor 0 = q 1) → + ((cfg.firstPredecessor 2 = q 2) → ((cfg.firstPredecessor 3 = q 3) → + ((cfg.secondPredecessor 0 = q 2) → ((cfg.secondPredecessor 1 = q 3) → ((∀ (m : Int), + ∀ (n : Int), BandPrototile (q 1) (SubtileOccurrenceInterpretation cert.P cert.u + cert.v ⟨.A, m, n⟩)) → ((∀ (m : Int), ∀ (n : Int), BandPrototile (q 1) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.B, m, n⟩)) → ((∀ (m : Int), ∀ + (n : Int), BandPrototile (q 2) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + ⟨.C, m, n⟩)) → ((∀ (m : Int), ∀ (n : Int), BandPrototile (q 2) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.D, m, n⟩)) → ((∀ (m : Int), ∀ + (n : Int), BandPrototile (q 3) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + ⟨.E, m, n⟩)) → ((∀ (m : Int), ∀ (n : Int), BandPrototile (q 3) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.F, m, n⟩)) → ((∀ (X : + ProtoTile), ∀ (d : GaussianInt), TileCentroid (TileTranslation X d) = TileCentroid X + + GaussianRealPoint d) → ((∀ (X : ProtoTile), ∀ (s : GaussianInt), ∀ (d : + GaussianInt), ∀ (t : GaussianInt), s + d = t → (TileTranslation (TileTranslation X s) + d).cells = (TileTranslation X t).cells) → ((∀ (X : ProtoTile), ∀ (s : GaussianInt), ∀ + (d : GaussianInt), (TileTranslation (TileTranslation X s) d).anchor = + (TileTranslation X (s + d)).anchor) → ((∀ (X : ProtoTile), ∀ (s : GaussianInt), ∀ (d + : GaussianInt), ∀ (t : GaussianInt), (s + d = t) → ((TileTranslation (TileTranslation + X s) d).anchor = (TileTranslation X t).anchor)) → ( + let I : GaussianInt := ⟨0, 1⟩ + ((GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) ^ 2 = -1) → (((GaussianInt.toComplex (⟨0, + 1⟩ : GaussianInt)) ^ 3 = -GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) → ( + let cOff (g : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint g - (-(GaussianRealPoint g).2, (GaussianRealPoint + g).1)) + (TileCentroid (cert.P 0 true) - TileCentroid T = cOff (BandVectors.1 (q 3) (q 2))) → + ((TileCentroid (cert.P 0 false) - TileCentroid T = -cOff (BandVectors.1 (q 3) (q 2))) + → ((TileCentroid (cert.P 1 true) - TileCentroid T = cOff (BandVectors.1 (q 1) (q 3))) + → ((TileCentroid (cert.P 1 false) - TileCentroid T = -cOff (BandVectors.1 (q 1) (q + 3))) → ((TileCentroid (cert.P 0 true) = TileCentroid T + cOff (BandVectors.1 (q 3) (q + 2))) → ((TileCentroid (cert.P 0 false) = TileCentroid T - cOff (BandVectors.1 (q 3) + (q 2))) → ((TileCentroid (cert.P 1 true) = TileCentroid T + cOff (BandVectors.1 (q 1) + (q 3))) → ((TileCentroid (cert.P 1 false) = TileCentroid T - cOff (BandVectors.1 (q + 1) (q 3))) → ( + let edgeVector : GaussianInt := BandVectors.1 (q 2) (q 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (q 1) (q 3) = -edgeVector - w) → ((cert.u = (1 - I) * edgeVector - I * w) + → ((cert.v = I * edgeVector + w) → ((BandVectors.1 (q 1) (q 2) = I * edgeVector) → + ((BandVectors.1 (q 3) (q 1) = I * (edgeVector + w)) → ((BandVectors.1 (q 2) (q 3) = I + * w) → ( + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occurrence z.childIndex + let W := occurrence z.parentIndex + let newRight := TileTranslation V z.rightShift + ProperBandQuadruple z.predecessor ∧ + z.predecessor 0 = q z.childSlot.succ ∧ + BandPrototile (z.predecessor 0) V ∧ + BandPrototile (z.predecessor z.parentSlot.succ) W ∧ + 0 < (z.predecessor 0).1 ∧ + 0 < (z.predecessor z.parentSlot.succ).1 ∧ + (if z.childIsExterior then + z.childIndex = a ∧ z.parentIndex = b + else z.childIndex = b ∧ z.parentIndex = a) ∧ + (newRight.cells = + (TileTranslation (cert.P z.childSlot z.childSign) + (z.childShift + z.rightShift)).cells ∧ + (newRight.cells = ∅ → newRight.anchor = + (TileTranslation (cert.P z.childSlot z.childSign) + (z.childShift + z.rightShift)).anchor)) ∧ + z.rightShift = (⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (if Even z.rotation.val then + BandVectors.1 (z.predecessor 0) (z.predecessor z.parentSlot.succ) + else BandVectors.1 (z.predecessor z.parentSlot.succ) (z.predecessor 0)) ∧ + TileCentroid W - TileCentroid V = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.1 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.1 (z.predecessor 0) (z.predecessor z.parentSlot.succ))) ∧ + TileCentroid newRight - TileCentroid (TileTranslation T z.oldShift) = + (-((TileCentroid (cert.P z.childSlot z.sourceSign) - TileCentroid T).2), + (TileCentroid (cert.P z.childSlot z.sourceSign) - TileCentroid + T).1)))))))))))))))))))))))))))))))))))))) ) := by + classical + intro q cfg C T cert a b row z hz q1pos q2pos q3pos hfp hsp hfc hft hfr hsc hsr occA occB occC + occD occE occF translationCentroidGP composeCellsEq composeAnchor composeAnchorEq I cI2 cI3 + cOff p0plus p0minus p1plus p1minus p0plusAbs p0minusAbs p1plusAbs p1minusAbs edgeVector w + q13 certU certV qnormal q31 q23 + cases row <;> simp only [P3996T1SRowTable] at hz <;> cases hz <;> rename_i presentation + all_goals simp? [SubtileOccurrenceInterpretation, + hfp, hsp, hfc, hft, hfr, hsc, hsr, q1pos, q2pos, q3pos, + certU, certV, p0plus, p0minus, p1plus, p1minus, + cOff, I, GaussianRealPoint] + all_goals refine ⟨?_, ?_, ?_⟩ + case positiveS1.refl.refine_1 => + simpa [SubtileOccurrenceInterpretation, TileTranslation, GaussianTranslation, certU, certV, + I, edgeVector, w] using occA (-1) (-1) + case positiveS1.refl.refine_2 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occC 0 0 + case positiveS2.refl.refine_1 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occA 0 (-1) + case positiveS2.refl.refine_2 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occE 0 0 + case positiveS3.refl.refine_1 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occC 1 0 + case positiveS3.refl.refine_2 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occE 0 0 + case positiveS4.refl.refine_1 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occA 0 0 + case positiveS4.refl.refine_2 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occC 1 1 + case positiveS5.refl.refine_1 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occA 0 0 + case positiveS5.refl.refine_2 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occE 0 1 + case positiveS6.refl.refine_1 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occC 0 0 + case positiveS6.refl.refine_2 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occE (-1) 0 + case reflectedS1.refl.refine_1 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occB 1 1 + case reflectedS1.refl.refine_2 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occD 0 0 + case reflectedS2.refl.refine_1 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occB 0 1 + case reflectedS2.refl.refine_2 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occF 0 0 + case reflectedS3.refl.refine_1 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occD (-1) 0 + case reflectedS3.refl.refine_2 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occF 0 0 + case reflectedS4.refl.refine_1 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occB 0 0 + case reflectedS4.refl.refine_2 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occD (-1) (-1) + case reflectedS5.refl.refine_1 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occB 0 0 + case reflectedS5.refl.refine_2 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occF 0 (-1) + case reflectedS6.refl.refine_1 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occD 0 0 + case reflectedS6.refl.refine_2 => simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, certU, certV, I, edgeVector, w] using occF 1 0 + all_goals constructor + all_goals try constructor + all_goals try first + | (apply composeCellsEq; abel) + | (intro _; apply composeAnchorEq; simp []; abel) + all_goals try norm_num [Even] + all_goals try constructor + case positiveS1.refl.refine_3.right.left => + simpa [SubtileOccurrenceInterpretation, translationCentroidGP, GaussianRealPoint, + Prod.add_def, hfc, hft, hfr, hsc, hsr, certU, certV, I] using + presentation + case positiveS2.refl.refine_3.right.right.left => + simpa [SubtileOccurrenceInterpretation, translationCentroidGP, GaussianRealPoint, + Prod.add_def, hfc, hft, hfr, hsc, hsr, certU, certV, I] using + presentation + case positiveS1.refl.refine_3.right.right => + simp only [translationCentroidGP] + rw [p0plusAbs] + ext <;> simp [GaussianRealPoint, cOff, + qnormal, I] <;> ring + case positiveS2.refl.refine_3.right.right.right => + simp only [translationCentroidGP] + rw [p0plusAbs] + ext <;> simp [GaussianRealPoint, cOff, + q31, cI3, I] <;> ring + case positiveS3.refl.refine_3.right.right => + simp only [translationCentroidGP] + rw [p1plusAbs] + ext <;> simp [GaussianRealPoint, cOff, + q13, q23, I] <;> ring + case positiveS4.refl.refine_3.right.right => + simp only [translationCentroidGP] + rw [p0plusAbs] + ext <;> simp [GaussianRealPoint, cOff, + qnormal, I] <;> ring + case positiveS5.refl.refine_3.right.right.right => + simp only [translationCentroidGP] + rw [p0plusAbs] + ext <;> simp [GaussianRealPoint, cOff, + q31, cI3, I] <;> ring + case positiveS6.refl.refine_3.right.right => + simp only [translationCentroidGP] + rw [p1plusAbs] + ext <;> simp [GaussianRealPoint, cOff, + q13, q23, I] <;> ring + case reflectedS1.refl.refine_3.right.right => + simp only [translationCentroidGP] + rw [p0minusAbs] + ext <;> simp [GaussianRealPoint, cOff, + qnormal, cI2, I] <;> ring + case reflectedS2.refl.refine_3.right.right => + simp only [translationCentroidGP] + rw [p0minusAbs] + ext <;> simp [GaussianRealPoint, cOff, + q31, I] <;> ring + case reflectedS3.refl.refine_3.right.right => + simp only [translationCentroidGP] + rw [p1minusAbs] + ext <;> simp [GaussianRealPoint, cOff, + q13, q23, cI2, I] <;> ring + case reflectedS4.refl.refine_3.right.right => + simp only [translationCentroidGP] + rw [p0minusAbs] + ext <;> simp [GaussianRealPoint, cOff, + qnormal, cI2, I] <;> ring + case reflectedS5.refl.refine_3.right.right => + simp only [translationCentroidGP] + rw [p0minusAbs] + ext <;> simp [GaussianRealPoint, cOff, + q31, I] <;> ring + case reflectedS6.refl.refine_3.right.right => + simp only [translationCentroidGP] + rw [p1minusAbs] + ext <;> simp [GaussianRealPoint, cOff, + q13, q23, cI2, I] <;> ring + all_goals try first + | (intro _; exact composeAnchor _ _ _) + | (intro _; rw [composeAnchor]; simp) + all_goals try (intro x hx; omega) + case positiveS3.refl.refine_3.right.left => + simpa [SubtileOccurrenceInterpretation, translationCentroidGP, GaussianRealPoint, + Prod.add_def, hfc, hft, hfr, hsc, hsr, certU, certV, I] using + presentation + case positiveS4.refl.refine_3.right.left => + simpa [SubtileOccurrenceInterpretation, translationCentroidGP, GaussianRealPoint, + Prod.add_def, hfc, hft, hfr, hsc, hsr, certU, certV, I] using + presentation + case positiveS5.refl.refine_3.right.right.left => + simpa [SubtileOccurrenceInterpretation, translationCentroidGP, GaussianRealPoint, + Prod.add_def, hfc, hft, hfr, hsc, hsr, certU, certV, I] using + presentation + case positiveS6.refl.refine_3.right.left => + simpa [SubtileOccurrenceInterpretation, translationCentroidGP, GaussianRealPoint, + Prod.add_def, hfc, hft, hfr, hsc, hsr, certU, certV, I] using + presentation + case reflectedS1.refl.refine_3.right.left => + simpa [SubtileOccurrenceInterpretation, translationCentroidGP, GaussianRealPoint, + Prod.add_def, hfc, hft, hfr, hsc, hsr, certU, certV, I] using + presentation + case reflectedS2.refl.refine_3.right.left => + simpa [SubtileOccurrenceInterpretation, translationCentroidGP, GaussianRealPoint, + Prod.add_def, hfc, hft, hfr, hsc, hsr, certU, certV, I] using + presentation + case reflectedS3.refl.refine_3.right.left => + simpa [SubtileOccurrenceInterpretation, translationCentroidGP, GaussianRealPoint, + Prod.add_def, hfc, hft, hfr, hsc, hsr, certU, certV, I] using + presentation + case reflectedS4.refl.refine_3.right.left => + simpa [SubtileOccurrenceInterpretation, translationCentroidGP, GaussianRealPoint, + Prod.add_def, hfc, hft, hfr, hsc, hsr, certU, certV, I] using + presentation + case reflectedS5.refl.refine_3.right.left => + simpa [SubtileOccurrenceInterpretation, translationCentroidGP, GaussianRealPoint, + Prod.add_def, hfc, hft, hfr, hsc, hsr, certU, certV, I] using + presentation + case reflectedS6.refl.refine_3.right.left => + simpa [SubtileOccurrenceInterpretation, translationCentroidGP, GaussianRealPoint, + Prod.add_def, hfc, hft, hfr, hsc, hsr, certU, certV, I] using + presentation + +end SRowCaseAlignment + +theorem P3996T1SRowAlignment + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b) + (z : P3996T1SRowParameters) + (hz : P3996T1SRowTable q cfg C T cert row = some z) : + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occurrence z.childIndex + let W := occurrence z.parentIndex + let newRight := TileTranslation V z.rightShift + ProperBandQuadruple z.predecessor ∧ + z.predecessor 0 = q z.childSlot.succ ∧ + BandPrototile (z.predecessor 0) V ∧ + BandPrototile (z.predecessor z.parentSlot.succ) W ∧ + 0 < (z.predecessor 0).1 ∧ + 0 < (z.predecessor z.parentSlot.succ).1 ∧ + (if z.childIsExterior then + z.childIndex = a ∧ z.parentIndex = b + else z.childIndex = b ∧ z.parentIndex = a) ∧ + (newRight.cells = + (TileTranslation (cert.P z.childSlot z.childSign) + (z.childShift + z.rightShift)).cells ∧ + (newRight.cells = ∅ → newRight.anchor = + (TileTranslation (cert.P z.childSlot z.childSign) + (z.childShift + z.rightShift)).anchor)) ∧ + z.rightShift = (⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (if Even z.rotation.val then + BandVectors.1 (z.predecessor 0) (z.predecessor z.parentSlot.succ) + else BandVectors.1 (z.predecessor z.parentSlot.succ) (z.predecessor 0)) ∧ + TileCentroid W - TileCentroid V = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.1 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.1 (z.predecessor 0) (z.predecessor z.parentSlot.succ))) ∧ + TileCentroid newRight - TileCentroid (TileTranslation T z.oldShift) = + (-((TileCentroid (cert.P z.childSlot z.sourceSign) - TileCentroid T).2), + (TileCentroid (cert.P z.childSlot z.sourceSign) - TileCentroid T).1) := by +-- BODY + have q1pos : 0 < (q 1).1 := SRowAlignmentGeometry.q1pos q cfg + have q2pos : 0 < (q 2).1 := SRowAlignmentGeometry.q2pos q cfg + have q3pos : 0 < (q 3).1 := SRowAlignmentGeometry.q3pos q cfg + have hfp : ProperBandQuadruple cfg.firstPredecessor := cfg.firstProper + have hsp : ProperBandQuadruple cfg.secondPredecessor := cfg.secondProper + have hfc : cfg.firstPredecessor 0 = q 1 := cfg.firstChild + have hft : cfg.firstPredecessor 2 = q 2 := cfg.firstParentTwo + have hfr : cfg.firstPredecessor 3 = q 3 := cfg.firstParentThree + have hsc : cfg.secondPredecessor 0 = q 2 := cfg.secondChild + have hsr : cfg.secondPredecessor 1 = q 3 := cfg.secondParentOne + have occA (m n : Int) : BandPrototile (q 1) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.A, m, n⟩) := + SRowAlignmentGeometry.occA q cfg C T cert m n + have occB (m n : Int) : BandPrototile (q 1) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.B, m, n⟩) := + SRowAlignmentGeometry.occB q cfg C T cert m n + have occC (m n : Int) : BandPrototile (q 2) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.C, m, n⟩) := + SRowAlignmentGeometry.occC q cfg C T cert m n + have occD (m n : Int) : BandPrototile (q 2) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.D, m, n⟩) := + SRowAlignmentGeometry.occD q cfg C T cert m n + have occE (m n : Int) : BandPrototile (q 3) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.E, m, n⟩) := + SRowAlignmentGeometry.occE q cfg C T cert m n + have occF (m n : Int) : BandPrototile (q 3) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.F, m, n⟩) := + SRowAlignmentGeometry.occF q cfg C T cert m n + have cellsTranslate := SRowAlignmentGeometry.cellsTranslate + have anchorTranslate := SRowAlignmentGeometry.anchorTranslate + have centroidTranslate := SRowAlignmentGeometry.centroidTranslate + have translationCentroidGP (X : ProtoTile) (d : GaussianInt) : + TileCentroid (TileTranslation X d) = TileCentroid X + GaussianRealPoint d := + SRowAlignmentGeometry.translationCentroidGP centroidTranslate X d + have composeCells := SRowAlignmentGeometry.composeCells cellsTranslate + have composeCellsEq := SRowAlignmentGeometry.composeCellsEq cellsTranslate + have composeAnchor (X : ProtoTile) (s d : GaussianInt) : + (TileTranslation (TileTranslation X s) d).anchor = + (TileTranslation X (s + d)).anchor := SRowAlignmentGeometry.composeAnchor X s d + have composeAnchorEq (X : ProtoTile) (s d t : GaussianInt) (h : s + d = t) : + (TileTranslation (TileTranslation X s) d).anchor = + (TileTranslation X t).anchor := SRowAlignmentGeometry.composeAnchorEq composeAnchor X s d + t h + let I : GaussianInt := ⟨0, 1⟩ + have hI2 : I * I = -1 := by dsimp [I]; apply Zsqrtd.ext <;> norm_num + have hIinv : -I * I = 1 := by rw [show -I * I = -(I * I) by ring, hI2]; norm_num + have cI2 : (GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) ^ 2 = -1 := by + norm_num [GaussianInt.toComplex_def] + have cI3 : (GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) ^ 3 = + -GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt) := SRowAlignmentGeometry.cI3 + let cOff (g : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint g - (-(GaussianRealPoint g).2, (GaussianRealPoint g).1)) + have p0plus : TileCentroid (cert.P 0 true) - TileCentroid T = + cOff (BandVectors.1 (q 3) (q 2)) := SRowAlignmentGeometry.p0plus q cfg C T cert + have p0minus : TileCentroid (cert.P 0 false) - TileCentroid T = + -cOff (BandVectors.1 (q 3) (q 2)) := SRowAlignmentGeometry.p0minus q cfg C T cert + have p1plus : TileCentroid (cert.P 1 true) - TileCentroid T = + cOff (BandVectors.1 (q 1) (q 3)) := SRowAlignmentGeometry.p1plus q cfg C T cert + have p1minus : TileCentroid (cert.P 1 false) - TileCentroid T = + -cOff (BandVectors.1 (q 1) (q 3)) := SRowAlignmentGeometry.p1minus q cfg C T cert + have p0plusAbs : TileCentroid (cert.P 0 true) = + TileCentroid T + cOff (BandVectors.1 (q 3) (q 2)) := SRowAlignmentGeometry.p0plusAbs q cfg + C T cert p0plus + have p0minusAbs : TileCentroid (cert.P 0 false) = + TileCentroid T - cOff (BandVectors.1 (q 3) (q 2)) := SRowAlignmentGeometry.p0minusAbs q cfg + C T cert p0minus + have p1plusAbs : TileCentroid (cert.P 1 true) = + TileCentroid T + cOff (BandVectors.1 (q 1) (q 3)) := SRowAlignmentGeometry.p1plusAbs q cfg + C T cert p1plus + have p1minusAbs : TileCentroid (cert.P 1 false) = + TileCentroid T - cOff (BandVectors.1 (q 1) (q 3)) := SRowAlignmentGeometry.p1minusAbs q cfg + C T cert p1minus + let edgeVector : GaussianInt := BandVectors.1 (q 2) (q 1) + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + have qCycle := (VectorRecursionLaws q cfg.proper.1).1 + have q13 : BandVectors.1 (q 1) (q 3) = -edgeVector - w := SRowAlignmentGeometry.q13 q qCycle + have q10 := SRowAlignmentGeometry.q10 q cfg + have qflip1 := (VectorRecursionLaws q cfg.proper.1).2.2.2.2 cfg.proper 0 |>.1 + have qflip2 := (VectorRecursionLaws q cfg.proper.1).2.2.2.2 cfg.proper 1 |>.1 + have q20 := SRowAlignmentGeometry.q20 q cfg + have certU : cert.u = (1 - I) * edgeVector - I * w := SRowAlignmentGeometry.certU q cfg C T + cert hI2 q13 + q10 qflip1 + have certV : cert.v = I * edgeVector + w := SRowAlignmentGeometry.certV q cfg C T cert hI2 + qflip2 q20 + have rflip1 := (VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).2.2.2.2 + cfg.firstProper 1 |>.1 + have rflip2 := (VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).2.2.2.2 + cfg.firstProper 2 |>.1 + have rvec2 : BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = I * edgeVector := + SRowAlignmentGeometry.rvec2 q cfg rflip1 + have rvec3 : BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = I * (edgeVector + + w) := + SRowAlignmentGeometry.rvec3 q cfg hIinv q13 rflip2 + have tvec1 : BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) = I * w := + SRowAlignmentGeometry.tvec1 q cfg + have qnormal : + BandVectors.1 (q 1) (q 2) = I * edgeVector := SRowAlignmentGeometry.qnormal q cfg + have q31 : BandVectors.1 (q 3) (q 1) = I * (edgeVector + w) := SRowAlignmentGeometry.q31 q cfg + have q23 : BandVectors.1 (q 2) (q 3) = I * w := SRowAlignmentGeometry.q23 q cfg + have rowAlignment : + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occurrence z.childIndex + let W := occurrence z.parentIndex + let newRight := TileTranslation V z.rightShift + ProperBandQuadruple z.predecessor ∧ + z.predecessor 0 = q z.childSlot.succ ∧ + BandPrototile (z.predecessor 0) V ∧ + BandPrototile (z.predecessor z.parentSlot.succ) W ∧ + 0 < (z.predecessor 0).1 ∧ + 0 < (z.predecessor z.parentSlot.succ).1 ∧ + (if z.childIsExterior then + z.childIndex = a ∧ z.parentIndex = b + else z.childIndex = b ∧ z.parentIndex = a) ∧ + (newRight.cells = + (TileTranslation (cert.P z.childSlot z.childSign) + (z.childShift + z.rightShift)).cells ∧ + (newRight.cells = ∅ → newRight.anchor = + (TileTranslation (cert.P z.childSlot z.childSign) + (z.childShift + z.rightShift)).anchor)) ∧ + z.rightShift = (⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (if Even z.rotation.val then + BandVectors.1 (z.predecessor 0) (z.predecessor z.parentSlot.succ) + else BandVectors.1 (z.predecessor z.parentSlot.succ) (z.predecessor 0)) ∧ + TileCentroid W - TileCentroid V = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.1 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.1 (z.predecessor 0) (z.predecessor z.parentSlot.succ))) ∧ + TileCentroid newRight - TileCentroid (TileTranslation T z.oldShift) = + (-((TileCentroid (cert.P z.childSlot z.sourceSign) - TileCentroid T).2), + (TileCentroid (cert.P z.childSlot z.sourceSign) - TileCentroid T).1) := + SRowCaseAlignment.rowAlignment q cfg C T cert a b row z hz q1pos q2pos q3pos hfp + hsp hfc hft hfr hsc hsr occA occB occC occD occE occF translationCentroidGP + composeCellsEq composeAnchor composeAnchorEq cI2 cI3 p0plus p0minus p1plus p1minus + p0plusAbs p0minusAbs p1plusAbs p1minusAbs q13 certU certV qnormal q31 q23 + exact rowAlignment + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1SRowParameters.lean b/LeanPool/ApollonianSuperharmonic/P3996T1SRowParameters.lean new file mode 100644 index 0000000000..78de87ba18 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3996T1SRowParameters.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates + +-- [TABLET NODE: P3996T1SRowParameters] + +/-! +# P3996T1SRowParameters + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A numerical $S$-row entry consists of a child slot $l\in\operatorname{Fin}3$, +a child sign and a source sign, two periodic subtile indices $X,Y$, +a Boolean recording whether $X$ is exterior, a quadruple $p$ of circle +coordinates, a parent slot $m\in\operatorname{Fin}3$, a rotation +$s\in\operatorname{Fin}4$, and three Gaussian integers $b,d,a$. +The last three numbers are respectively the child occurrence shift, the +right displacement, and the old-companion shift. +An entry has no assertions or geometric certificates. +-/ +structure P3996T1SRowParameters where +-- BODY + /-- The selected child slot in the signed decomposition. -/ + childSlot : Fin 3 + /-- The sign of the selected child occurrence. -/ + childSign : Bool + /-- The sign of the source occurrence in the row. -/ + sourceSign : Bool + /-- The literal periodic index of the child occurrence. -/ + childIndex : PeriodicSubtileIndex + /-- The literal periodic index of its parent occurrence. -/ + parentIndex : PeriodicSubtileIndex + /-- Whether the child occurrence occupies the exterior role in this row. -/ + childIsExterior : Bool + /-- The fixed predecessor presentation prescribed by the row. -/ + predecessor : Fin 4 → CircleCoordinates + /-- The parent slot within that predecessor presentation. -/ + parentSlot : Fin 3 + /-- The prescribed quarter-turn index of the child-parent presentation. -/ + rotation : Fin 4 + /-- The translation of the selected child occurrence. -/ + childShift : GaussianInt + /-- The right-neighbor displacement prescribed by the row. -/ + rightShift : GaussianInt + /-- The translation of the old companion occurrence. -/ + oldShift : GaussianInt + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1SRowTable.lean b/LeanPool/ApollonianSuperharmonic/P3996T1SRowTable.lean new file mode 100644 index 0000000000..21391859f3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P3996T1SRowTable.lean @@ -0,0 +1,174 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow +public import LeanPool.ApollonianSuperharmonic.P3996T1SRowParameters + +-- [TABLET NODE: P3996T1SRowTable] + +/-! +# P3996T1SRowTable + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a configuration $q,\mathrm{cfg}$ and layout certificate with periods +$u,v$, the numerical row table is undefined in the six $L$ constructors. +In each $S$ constructor it has the following +`P3996T1SRowParameters` entry. Put +$r=\mathrm{cfg.firstPredecessor}$, $t=\mathrm{cfg.secondPredecessor}$, +$\alpha=v^r_{02}$, $\beta=v^r_{30}$, $\gamma=v^t_{01}$ and $I=\sqrt{-1}$. +Slots in this table are zero-based. The columns are the child slot and +sign, the source sign, the child and parent indices, the exterior flag, +the predecessor, parent slot and rotation, and the three shifts $b,d,a$. +$$ +\begin{array}{c|cc|c|cc|c|ccc|ccc} + &l&\epsilon&f&X&Y&\mathrm{ext}&p&m&s&b&d&a\\ \hline +S_1^+&0&+&-&A_{-1,-1}&C_{0,0}&1&r&1&0&-u-v&\alpha&-u\\ +S_2^+&0&+&+&A_{0,-1}&E_{0,0}&1&r&2&3&-v&I^3\beta&u\\ +S_3^+&1&+&-&C_{1,0}&E_{0,0}&1&t&0&0&u&\gamma&-v\\ +S_4^+&0&+&-&A_{0,0}&C_{1,1}&0&r&1&0&0&\alpha&v\\ +S_5^+&0&+&+&A_{0,0}&E_{0,1}&0&r&2&3&0&I^3\beta&u+v\\ +S_6^+&1&+&-&C_{0,0}&E_{-1,0}&0&t&0&0&0&\gamma&-u-v\\ +S_1^-&0&-&+&B_{1,1}&D_{0,0}&1&r&1&2&u+v&I^2\alpha&u\\ +S_2^-&0&-&-&B_{0,1}&F_{0,0}&1&r&2&1&v&I\beta&-u\\ +S_3^-&1&-&+&D_{-1,0}&F_{0,0}&1&t&0&2&-u&I^2\gamma&v\\ +S_4^-&0&-&+&B_{0,0}&D_{-1,-1}&0&r&1&2&0&I^2\alpha&-v\\ +S_5^-&0&-&-&B_{0,0}&F_{0,-1}&0&r&2&1&0&I\beta&-u-v\\ +S_6^-&1&-&+&D_{0,0}&F_{1,0}&0&t&0&2&0&I^2\gamma&u+v +\end{array} +$$ +-/ +noncomputable def P3996T1SRowTable + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + {a b : PeriodicSubtileIndex} + (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b) : + Option P3996T1SRowParameters := +-- BODY + match row with + | .positiveL1 _ _ => none + | .positiveL2 _ _ => none + | .positiveL3 _ _ => none + | .reflectedL1 _ _ => none + | .reflectedL2 _ _ => none + | .reflectedL3 _ _ => none + | .positiveS1 _ => some { + childSlot := 0, childSign := true, sourceSign := false + childIndex := ⟨.A, -1, -1⟩, parentIndex := ⟨.C, 0, 0⟩ + childIsExterior := true, predecessor := cfg.firstPredecessor + parentSlot := 1, rotation := 0 + childShift := -cert.u - cert.v + rightShift := BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) + oldShift := -cert.u } + | .positiveS2 _ => some { + childSlot := 0, childSign := true, sourceSign := true + childIndex := ⟨.A, 0, -1⟩, parentIndex := ⟨.E, 0, 0⟩ + childIsExterior := true, predecessor := cfg.firstPredecessor + parentSlot := 2, rotation := 3 + childShift := -cert.v + rightShift := (⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0) + oldShift := cert.u } + | .positiveS3 _ => some { + childSlot := 1, childSign := true, sourceSign := false + childIndex := ⟨.C, 1, 0⟩, parentIndex := ⟨.E, 0, 0⟩ + childIsExterior := true, predecessor := cfg.secondPredecessor + parentSlot := 0, rotation := 0 + childShift := cert.u + rightShift := BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) + oldShift := -cert.v } + | .positiveS4 _ => some { + childSlot := 0, childSign := true, sourceSign := false + childIndex := ⟨.A, 0, 0⟩, parentIndex := ⟨.C, 1, 1⟩ + childIsExterior := false, predecessor := cfg.firstPredecessor + parentSlot := 1, rotation := 0 + childShift := 0 + rightShift := BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) + oldShift := cert.v } + | .positiveS5 _ => some { + childSlot := 0, childSign := true, sourceSign := true + childIndex := ⟨.A, 0, 0⟩, parentIndex := ⟨.E, 0, 1⟩ + childIsExterior := false, predecessor := cfg.firstPredecessor + parentSlot := 2, rotation := 3 + childShift := 0 + rightShift := (⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0) + oldShift := cert.u + cert.v } + | .positiveS6 _ => some { + childSlot := 1, childSign := true, sourceSign := false + childIndex := ⟨.C, 0, 0⟩, parentIndex := ⟨.E, -1, 0⟩ + childIsExterior := false, predecessor := cfg.secondPredecessor + parentSlot := 0, rotation := 0 + childShift := 0 + rightShift := BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) + oldShift := -cert.u - cert.v } + | .reflectedS1 _ => some { + childSlot := 0, childSign := false, sourceSign := true + childIndex := ⟨.B, 1, 1⟩, parentIndex := ⟨.D, 0, 0⟩ + childIsExterior := true, predecessor := cfg.firstPredecessor + parentSlot := 1, rotation := 2 + childShift := cert.u + cert.v + rightShift := (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2) + oldShift := cert.u } + | .reflectedS2 _ => some { + childSlot := 0, childSign := false, sourceSign := false + childIndex := ⟨.B, 0, 1⟩, parentIndex := ⟨.F, 0, 0⟩ + childIsExterior := true, predecessor := cfg.firstPredecessor + parentSlot := 2, rotation := 1 + childShift := cert.v + rightShift := (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0) + oldShift := -cert.u } + | .reflectedS3 _ => some { + childSlot := 1, childSign := false, sourceSign := true + childIndex := ⟨.D, -1, 0⟩, parentIndex := ⟨.F, 0, 0⟩ + childIsExterior := true, predecessor := cfg.secondPredecessor + parentSlot := 0, rotation := 2 + childShift := -cert.u + rightShift := (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) + oldShift := cert.v } + | .reflectedS4 _ => some { + childSlot := 0, childSign := false, sourceSign := true + childIndex := ⟨.B, 0, 0⟩, parentIndex := ⟨.D, -1, -1⟩ + childIsExterior := false, predecessor := cfg.firstPredecessor + parentSlot := 1, rotation := 2 + childShift := 0 + rightShift := (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2) + oldShift := -cert.v } + | .reflectedS5 _ => some { + childSlot := 0, childSign := false, sourceSign := false + childIndex := ⟨.B, 0, 0⟩, parentIndex := ⟨.F, 0, -1⟩ + childIsExterior := false, predecessor := cfg.firstPredecessor + parentSlot := 2, rotation := 1 + childShift := 0 + rightShift := (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0) + oldShift := -cert.u - cert.v } + | .reflectedS6 _ => some { + childSlot := 1, childSign := false, sourceSign := true + childIndex := ⟨.D, 0, 0⟩, parentIndex := ⟨.F, 1, 0⟩ + childIsExterior := false, predecessor := cfg.secondPredecessor + parentSlot := 0, rotation := 2 + childShift := 0 + rightShift := (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) + oldShift := cert.u + cert.v } + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1BandQuarterTurn.lean b/LeanPool/ApollonianSuperharmonic/P4055T1BandQuarterTurn.lean new file mode 100644 index 0000000000..304c772f54 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4055T1BandQuarterTurn.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization + +-- [TABLET NODE: P4055T1BandQuarterTurn] + +/-! +# P4055T1BandQuarterTurn + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4055T1BandQuarterTurn (D : CircleCoordinates) (V : ProtoTile) + (hV : BandPrototile D V) : QuarterTurnSymmetric V := by +-- BODY + cases hV with + | line w z hw => + intro p + simp [TileRealization, TileCentroid] + | unit z a anchor => + intro p + have hc : TileCentroid (⟨{a}, anchor⟩ : ProtoTile) = + (((a.re : Int) : Real) + (1 / 2 : Real), + ((a.im : Int) : Real) + (1 / 2 : Real)) := by + simp [TileCentroid] + rw [hc] + rcases p with ⟨px, py⟩ + simp only [TileRealization, Finset.mem_singleton, Set.mem_iUnion] + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor + · rintro ⟨b, rfl, hlo, hhi⟩ + refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> + linarith [hlo.1, hlo.2, hhi.1, hhi.2] + · rintro ⟨b, rfl, hlo, hhi⟩ + refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> + linarith [hlo.1, hlo.2, hhi.1, hhi.2] + | @decompose q hq S V hS hcells hfoot hcent => + exact (BandTileSimultaneousInduction q hq V + (.decompose hq hS hcells hfoot hcent)).2.2.2.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1ExactTripleImage.lean b/LeanPool/ApollonianSuperharmonic/P4055T1ExactTripleImage.lean new file mode 100644 index 0000000000..a5600d001c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4055T1ExactTripleImage.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.P4055T1GridPathImage + +-- [TABLET NODE: P4055T1ExactTripleImage] + +/-! +# P4055T1ExactTripleImage + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4055T1ExactTripleImage + (f : GaussianInt → GaussianInt) (hf : Function.Injective f) + (hstep : ∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (f b = f a + 1 ∨ f b = f a - 1 ∨ + f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) + (A B C A' B' C' : ProtoTile) + (hvA : FootprintVertices A' = f '' FootprintVertices A) + (hvB : FootprintVertices B' = f '' FootprintVertices B) + (hvC : FootprintVertices C' = f '' FootprintVertices C) + (heA : FootprintEdges A' = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges A) + (heB : FootprintEdges B' = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges B) + (heC : FootprintEdges C' = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges C) + (d : ExactTileInterfaceTriple A B C) : + ∃ d' : ExactTileInterfaceTriple A' B' C', + d'.point = f d.point ∧ d'.otherAB = f d.otherAB ∧ + d'.otherBC = f d.otherBC ∧ d'.otherCA = f d.otherCA := by +-- BODY + have hei : Function.Injective (fun e : Finset GaussianInt => e.image f) := + Finset.image_injective hf + have pathAB := P4055T1GridPathImage f hf hstep _ _ _ _ d.pathAB + have pathBC := P4055T1GridPathImage f hf hstep _ _ _ _ d.pathBC + have pathCA := P4055T1GridPathImage f hf hstep _ _ _ _ d.pathCA + have hab : SimpleGridPathBetween + (FootprintVertices A' ∩ FootprintVertices B') + (FootprintEdges A' ∩ FootprintEdges B') (f d.point) (f d.otherAB) := by + simpa only [hvA, hvB, heA, heB, Set.image_inter hf, Set.image_inter hei] using pathAB + have hbc : SimpleGridPathBetween + (FootprintVertices B' ∩ FootprintVertices C') + (FootprintEdges B' ∩ FootprintEdges C') (f d.point) (f d.otherBC) := by + simpa only [hvB, hvC, heB, heC, Set.image_inter hf, Set.image_inter hei] using pathBC + have hca : SimpleGridPathBetween + (FootprintVertices C' ∩ FootprintVertices A') + (FootprintEdges C' ∩ FootprintEdges A') (f d.point) (f d.otherCA) := by + simpa only [hvC, hvA, heC, heA, Set.image_inter hf, Set.image_inter hei] using pathCA + have hu : ∀ z, + z ∈ FootprintVertices A' ∩ FootprintVertices B' ∩ FootprintVertices C' ↔ + z = f d.point := by + intro z + rw [hvA, hvB, hvC, ← Set.image_inter hf, ← Set.image_inter hf] + constructor + · rintro ⟨w, hw, rfl⟩ + exact congrArg f ((d.unique_common w).mp hw) + · rintro rfl + exact ⟨d.point, (d.unique_common d.point).mpr rfl, rfl⟩ + exact ⟨⟨f d.point, f d.otherAB, f d.otherBC, f d.otherCA, + hab, hbc, hca, hu⟩, rfl, rfl, rfl, rfl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1GridPathImage.lean b/LeanPool/ApollonianSuperharmonic/P4055T1GridPathImage.lean new file mode 100644 index 0000000000..c781d0ec25 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4055T1GridPathImage.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween + +-- [TABLET NODE: P4055T1GridPathImage] + +/-! +# P4055T1GridPathImage + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4055T1GridPathImage : ∀ (f : GaussianInt → GaussianInt), + Function.Injective f → + (∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (f b = f a + 1 ∨ f b = f a - 1 ∨ + f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → + ∀ (V : Set GaussianInt) (E : Set (Finset GaussianInt)) (x y : GaussianInt), + SimpleGridPathBetween V E x y → + SimpleGridPathBetween + (f '' V) ((fun e : Finset GaussianInt => e.image f) '' E) + (f x) (f y) := by +-- BODY + intro f fi st V E x y h + rcases h with ⟨p, hn, hl, hh, ht, hv, hs, he⟩ + refine ⟨p.map f, hn.map fi, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simpa using hl + · rw [List.head?_map, hh] + rfl + · rw [List.getLast?_map, ht] + rfl + · rw [hv] + ext z + simp [] + · intro a b l₁ l₂ hmap + have recover : ∀ (q : List GaussianInt), + (∀ a b l₁ l₂, q = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + ∀ a b l₁ l₂, q.map f = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ := by + intro q + induction q with + | nil => intro hs a b l₁ l₂ hm; cases l₁ <;> simp_all + | cons z q ih => + intro hs a b l₁ l₂ hm + cases l₁ with + | nil => + cases q with + | nil => simp_all + | cons w q => + simp? at hm + rw [← hm.1, ← hm.2.1] + exact st z w (hs z w [] q (by simp)) + | cons z' l' => + simp? at hm + apply ih (fun c d k m hcm => hs c d (z :: k) m (by simp [hcm])) + a b l' l₂ hm.2 + exact recover p hs a b l₁ l₂ hmap + · intro e + constructor + · rintro ⟨d, hd, rfl⟩ + rcases (he d).mp hd with ⟨a, b, l₁, l₂, hp, rfl⟩ + refine ⟨f a, f b, l₁.map f, l₂.map f, ?_, ?_⟩ + · simpa using congrArg (List.map f) hp + · simp [Finset.image_insert] + · rintro ⟨a, b, l₁, l₂, hp, heq⟩ + have ha : a ∈ p.map f := by rw [hp]; simp + have hb : b ∈ p.map f := by rw [hp]; simp + rcases List.mem_map.mp ha with ⟨a₀, ha₀, rfl⟩ + rcases List.mem_map.mp hb with ⟨b₀, hb₀, rfl⟩ + have unmap : ∀ (q : List GaussianInt) (k m : List GaussianInt) + (r s : GaussianInt), q.map f = k ++ f r :: f s :: m → + ∃ k₀ m₀, q = k₀ ++ r :: s :: m₀ := by + intro q + induction q with + | nil => intro k m r s h; cases k <;> simp_all + | cons z q ihq => + intro k m r s h + cases k with + | nil => + simp? at h + cases q with + | nil => simp_all + | cons w q => + simp? at h + have hz : z = r := fi h.1 + have hw : w = s := fi h.2.1 + subst r; subst s + exact ⟨[], q, by simp []⟩ + | cons z' k' => + simp? at h + rcases ihq k' m r s h.2 with ⟨k₀, m₀, hm⟩ + exact ⟨z :: k₀, m₀, by simp [hm]⟩ + have hdecomp : ∃ k m, p = k ++ a₀ :: b₀ :: m := by + rcases unmap p l₁ l₂ a₀ b₀ hp with ⟨k, m, hm⟩ + exact ⟨k, m, hm⟩ + rcases hdecomp with ⟨k, m, hm⟩ + refine ⟨{a₀, b₀}, (he {a₀, b₀}).mpr ⟨a₀, b₀, k, m, hm, rfl⟩, ?_⟩ + simpa [Finset.image_insert] using heq.symm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean new file mode 100644 index 0000000000..9424679370 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean @@ -0,0 +1,1581 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMixedAggregatePatches +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P4055T1OrderedGeneralOppositeEndpoints] + +/-! +# P4055T1OrderedGeneralOppositeEndpoints + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +private def pairedEndpointPackage (r : Fin 4 → CircleCoordinates) (T : ProtoTile) + (i : Fin 3) (s : Fin 4) (W Z : ProtoTile) : Prop := + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + let uL := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + ∃ (rightData : ExactTileInterfaceTriple T (TileTranslation T uR) W) + (incomingData : ExactTileInterfaceTriple T (TileTranslation T uL) W) + (t5Data : ExactTileInterfaceTriple T W Z), + rightData.point = t5Data.point ∧ incomingData.point ≠ t5Data.point ∧ + incomingData.otherCA = t5Data.point ∧ rightData.otherCA = incomingData.point ∧ + t5Data.otherAB = incomingData.point + +namespace OppositeEndpointGeometry + +private theorem haUre : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (aU : GaussianInt), (GaussianRealPoint aU = ((TileCentroid U).1 + + (TileCentroid U).2, (TileCentroid U).2 - (TileCentroid U).1)) → ((aU.re : Real) = + (TileCentroid U).1 + (TileCentroid U).2) ) := by + classical + intro U aU haU + have h := congrArg Prod.fst haU + simpa [GaussianRealPoint] using h + +private theorem haUim : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (aU : GaussianInt), (GaussianRealPoint aU = ((TileCentroid U).1 + + (TileCentroid U).2, (TileCentroid U).2 - (TileCentroid U).1)) → ((aU.im : Real) = + (TileCentroid U).2 - (TileCentroid U).1) ) := by + classical + intro U aU haU + have h := congrArg Prod.snd haU + simpa [GaussianRealPoint] using h + +private theorem haWre : + (by + classical + exact + ∀ (W : ProtoTile), ∀ (aW : GaussianInt), (GaussianRealPoint aW = ((TileCentroid W).1 + + (TileCentroid W).2, (TileCentroid W).2 - (TileCentroid W).1)) → ((aW.re : Real) = + (TileCentroid W).1 + (TileCentroid W).2) ) := by + classical + intro W aW haW + have h := congrArg Prod.fst haW + simpa [GaussianRealPoint] using h + +private theorem haWim : + (by + classical + exact + ∀ (W : ProtoTile), ∀ (aW : GaussianInt), (GaussianRealPoint aW = ((TileCentroid W).1 + + (TileCentroid W).2, (TileCentroid W).2 - (TileCentroid W).1)) → ((aW.im : Real) = + (TileCentroid W).2 - (TileCentroid W).1) ) := by + classical + intro W aW haW + have h := congrArg Prod.snd haW + simpa [GaussianRealPoint] using h + +private theorem haZre : + (by + classical + exact + ∀ (Z : ProtoTile), ∀ (aZ : GaussianInt), (GaussianRealPoint aZ = ((TileCentroid Z).1 + + (TileCentroid Z).2, (TileCentroid Z).2 - (TileCentroid Z).1)) → ((aZ.re : Real) = + (TileCentroid Z).1 + (TileCentroid Z).2) ) := by + classical + intro Z aZ haZ + have h := congrArg Prod.fst haZ + simpa [GaussianRealPoint] using h + +private theorem haZim : + (by + classical + exact + ∀ (Z : ProtoTile), ∀ (aZ : GaussianInt), (GaussianRealPoint aZ = ((TileCentroid Z).1 + + (TileCentroid Z).2, (TileCentroid Z).2 - (TileCentroid Z).1)) → ((aZ.im : Real) = + (TileCentroid Z).2 - (TileCentroid Z).1) ) := by + classical + intro Z aZ haZ + have h := congrArg Prod.snd haZ + simpa [GaussianRealPoint] using h + +private theorem hWpCent : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (W : ProtoTile), ∀ (aU : GaussianInt), ∀ (aW : GaussianInt), + let Wp := TileTranslation W (aU - aW) + ((aU.re : Real) = (TileCentroid U).1 + (TileCentroid U).2) → (((aU.im : Real) = + (TileCentroid U).2 - (TileCentroid U).1) → (((aW.re : Real) = (TileCentroid W).1 + + (TileCentroid W).2) → (((aW.im : Real) = (TileCentroid W).2 - (TileCentroid W).1) → + (TileCentroid Wp - TileCentroid U = (-(TileCentroid W - TileCentroid U).2, + (TileCentroid W - TileCentroid U).1))))) ) := by + classical + intro U W aU aW Wp haUre haUim haWre haWim + rw [(TileTranslationFormulas W (aU - aW)).2.2.2.2.1] + ext <;> simp only [] + all_goals simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Int.cast_sub] + all_goals rw [haUre, haUim, haWre, haWim] + all_goals dsimp; ring + +private theorem hZpCent : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (Z : ProtoTile), ∀ (aU : GaussianInt), ∀ (aZ : GaussianInt), + let Zp := TileTranslation Z (aU - aZ) + ((aU.re : Real) = (TileCentroid U).1 + (TileCentroid U).2) → (((aU.im : Real) = + (TileCentroid U).2 - (TileCentroid U).1) → (((aZ.re : Real) = (TileCentroid Z).1 + + (TileCentroid Z).2) → (((aZ.im : Real) = (TileCentroid Z).2 - (TileCentroid Z).1) → + (TileCentroid Zp - TileCentroid U = (-(TileCentroid Z - TileCentroid U).2, + (TileCentroid Z - TileCentroid U).1))))) ) := by + classical + intro U Z aU aZ Zp haUre haUim haZre haZim + rw [(TileTranslationFormulas Z (aU - aZ)).2.2.2.2.1] + ext <;> simp only [] + all_goals simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Int.cast_sub] + all_goals rw [haUre, haUim, haZre, haZim] + all_goals dsimp; ring + +private theorem hWrot : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : + ProtoTile), ∀ (W : ProtoTile), (TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r + i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → ( + let q : GaussianInt := ⟨0, 1⟩ + (-(TileCentroid W - TileCentroid U).2, (TileCentroid W - TileCentroid U).1) = (1 / 2 : + Real) • GaussianRealPoint (q * (q ^ s.val * (BandVectors.1 (r i.succ) (r 0) + + BandVectors.1 (r 0) (r i.succ))))) ) := by + classical + intro r i s U W hWcent q + rw [hWcent] + simp [q, GaussianRealPoint, Zsqrtd.re_mul, Zsqrtd.im_mul]; ring + +private theorem hq2 : + (by + classical + exact + let q : GaussianInt := ⟨0, 1⟩ + q ^ 2 = -1 ) := by + classical + intro q + rw [pow_two] + ext <;> simp [q, Zsqrtd.re_mul, Zsqrtd.im_mul] + +private theorem hq4 : + (by + classical + exact + let q : GaussianInt := ⟨0, 1⟩ + (q ^ 2 = -1) → (q ^ 4 = 1) ) := by + classical + intro q hq2 + calc + q ^ 4 = q ^ 2 * q ^ 2 := by ring + _ = (-1 : GaussianInt) * -1 := by rw [hq2] + _ = 1 := by norm_num + +private theorem hq3 : + (by + classical + exact + let q : GaussianInt := ⟨0, 1⟩ + (q ^ 2 = -1) → (q ^ 3 = -q) ) := by + classical + intro q hq2 + calc + q ^ 3 = q ^ 2 * q := by rw [pow_succ] + _ = (-1 : GaussianInt) * q := by rw [hq2] + _ = -q := by ring + +private theorem hq6 : + (by + classical + exact + let q : GaussianInt := ⟨0, 1⟩ + (q ^ 2 = -1) → (q ^ 6 = -1) ) := by + classical + intro q hq2 + calc + q ^ 6 = (q ^ 2) ^ 3 := by ring + _ = (-1 : GaussianInt) ^ 3 := by rw [hq2] + _ = -1 := by norm_num + +private theorem hq2act : + (by + classical + exact + let q : GaussianInt := ⟨0, 1⟩ + (q ^ 2 = -1) → (∀ (x : GaussianInt), q * (q * x) = -x) ) := by + classical + intro q hq2 x + calc + q * (q * x) = (q * q) * x := by ring + _ = q ^ 2 * x := by rw [pow_two] + _ = -x := by rw [hq2]; ring + +private theorem hq4act : + (by + classical + exact + let q : GaussianInt := ⟨0, 1⟩ + (q ^ 4 = 1) → (∀ (x : GaussianInt), q ^ 4 * x = x) ) := by + classical + intro q hq4 x + rw [hq4] + simp + +private theorem hq6act : + (by + classical + exact + let q : GaussianInt := ⟨0, 1⟩ + (q ^ 6 = -1) → (∀ (x : GaussianInt), q ^ 6 * x = -x) ) := by + classical + intro q hq6 x + rw [hq6] + simp + +private theorem hpower : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : + ProtoTile), ∀ (W : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if (Even s.val) + then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < (r (if + Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → + ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → ((TileCentroid Z - TileCentroid U + = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if + Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : + ℕ))).succ) - BandVectors.1 (r (i - (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) + else BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : ℕ))).succ))) → ( + let q : GaussianInt := ⟨0, 1⟩ + ∀ (aU : GaussianInt), ∀ (aZ : GaussianInt), + let Zp := TileTranslation Z (aU - aZ) + (BandPrototile (r ((if Even s.val then i - 1 else i + 1).succ)) Zp) → (((-(TileCentroid W + - TileCentroid U).2, (TileCentroid W - TileCentroid U).1) = (1 / 2 : Real) • + GaussianRealPoint (q * (q ^ s.val * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 + (r 0) (r i.succ))))) → ( + let t : Fin 4 := s + 1 + (Even t.val ↔ ¬ Even s.val) → ((q ^ 2 = -1) → ((q ^ 4 = 1) → (q ^ t.val = q * q ^ + s.val))))))))) ) := by + classical + intro r i s U W Z hZ hZpos hWcent hZcent q aU aZ Zp hZp hWrot t htpar hq2 hq4 + fin_cases s + · simp [t] + · simp [t, pow_succ] + · change q ^ 3 = q * q ^ 2 + rw [pow_succ, hq2] + simp [] + · change (1 : GaussianInt) = q * q ^ 3 + have h : q * q ^ 3 = q ^ 4 := by + rw [pow_succ] + ring + rw [h, hq4] + +private theorem hWsrc : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : + ProtoTile), ∀ (W : ProtoTile), + let q : GaussianInt := ⟨0, 1⟩ + ∀ (aU : GaussianInt), ∀ (aW : GaussianInt), + let Wp := TileTranslation W (aU - aW) + (TileCentroid Wp - TileCentroid U = (-(TileCentroid W - TileCentroid U).2, (TileCentroid + W - TileCentroid U).1)) → (((-(TileCentroid W - TileCentroid U).2, (TileCentroid W - + TileCentroid U).1) = (1 / 2 : Real) • GaussianRealPoint (q * (q ^ s.val * + (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))))) → ( + let t : Fin 4 := s + 1 + (q ^ t.val = q * q ^ s.val) → (TileCentroid Wp - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint (q ^ t.val * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) + (r i.succ)))))) ) := by + classical + intro r i s U W q aU aW Wp hWpCent hWrot t hpower + rw [hWpCent, hWrot] + congr 1 + rw [hpower] + simp [mul_assoc] + +private theorem hZrot : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : + ProtoTile), ∀ (Z : ProtoTile), (TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if (Even s.val) + then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - + BandVectors.1 (r (i - (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) else + BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - BandVectors.1 + (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : ℕ))).succ))) → ( + let q : GaussianInt := ⟨0, 1⟩ + (-(TileCentroid Z - TileCentroid U).2, (TileCentroid Z - TileCentroid U).1) = (1 / 2 : + Real) • GaussianRealPoint (q * (q ^ s.val * (if Even s.val then BandVectors.1 (r 0) + (r ((i - 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r 0) else BandVectors.1 (r ((i + + 1).succ)) (r 0) - BandVectors.1 (r 0) (r ((i + 1).succ)))))) ) := by + classical + intro r i s U Z hZcent q + rw [hZcent] + by_cases hs : Even s.val + · simp [hs, q, GaussianRealPoint, Zsqrtd.re_mul, Zsqrtd.im_mul]; ring + · simp [hs, q, GaussianRealPoint, Zsqrtd.re_mul, Zsqrtd.im_mul]; ring + +private theorem hZsrc : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : + ProtoTile), ∀ (Z : ProtoTile), + let q : GaussianInt := ⟨0, 1⟩ + ∀ (aU : GaussianInt), ∀ (aZ : GaussianInt), + let Zp := TileTranslation Z (aU - aZ) + (TileCentroid Zp - TileCentroid U = (-(TileCentroid Z - TileCentroid U).2, (TileCentroid + Z - TileCentroid U).1)) → ( + let t : Fin 4 := s + 1 + (Even t.val ↔ ¬ Even s.val) → ((q ^ t.val = q * q ^ s.val) → (((-(TileCentroid Z - + TileCentroid U).2, (TileCentroid Z - TileCentroid U).1) = (1 / 2 : Real) • + GaussianRealPoint (q * (q ^ s.val * (if Even s.val then BandVectors.1 (r 0) (r ((i - + 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r 0) else BandVectors.1 (r ((i + + 1).succ)) (r 0) - BandVectors.1 (r 0) (r ((i + 1).succ)))))) → (TileCentroid Zp - + TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * (if Even t.val then + BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r 0) (r ((i + 1).succ)) else + BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r 0))))))) + ) := by + classical + intro r i s U Z q aU aZ Zp hZpCent t htpar hpower hZrot + rw [hZpCent, hZrot] + have hvectors : q * (q ^ s.val * + (if Even s.val then + BandVectors.1 (r 0) (r ((i - 1).succ)) - + BandVectors.1 (r ((i - 1).succ)) (r 0) + else + BandVectors.1 (r ((i + 1).succ)) (r 0) - + BandVectors.1 (r 0) (r ((i + 1).succ)))) = + q ^ t.val * + (if Even t.val then + BandVectors.1 (r ((i + 1).succ)) (r 0) - + BandVectors.1 (r 0) (r ((i + 1).succ)) + else + BandVectors.1 (r 0) (r ((i - 1).succ)) - + BandVectors.1 (r ((i - 1).succ)) (r 0)) := by + rw [hpower] + by_cases hs : Even s.val + · have ht : ¬ Even t.val := by + intro ht + exact (htpar.mp ht) hs + simp [hs, ht, mul_assoc] + · have ht : Even t.val := htpar.mpr hs + simp [hs, ht, mul_assoc] + rw [hvectors] + +private theorem hZlabel : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), + let t : Fin 4 := s + 1 + (Even t.val ↔ ¬ Even s.val) → ((r ((if Even t.val then i + 1 else i - 1).succ)) = (r ((if + Even s.val then i - 1 else i + 1).succ))) ) := by + classical + intro r i s t htpar + by_cases hs : Even s.val + · have ht : ¬ Even t.val := by + intro ht + exact (htpar.mp ht) hs + simp [hs, ht] + · have ht : Even t.val := htpar.mpr hs + simp [hs, ht] + +private theorem hFf : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : + ProtoTile), ∀ (W : ProtoTile), ∀ (Z : ProtoTile), + let q : GaussianInt := ⟨0, 1⟩ + ∀ (aU : GaussianInt), (GaussianRealPoint aU = ((TileCentroid U).1 + (TileCentroid U).2, + (TileCentroid U).2 - (TileCentroid U).1)) → (((TileTranslation (TileQuarterTurn U) + aU).cells = U.cells) → ((U.cells = ∅ → (TileTranslation (TileQuarterTurn U) + aU).anchor = U.anchor) → ((FootprintVertices (TileTranslation (TileQuarterTurn U) aU) + = FootprintVertices U) → (∀ (aW : GaussianInt), ∀ (aZ : GaussianInt), + let Wp := TileTranslation W (aU - aW) + let Zp := TileTranslation Z (aU - aZ) + (BandPrototile (r i.succ) Wp) → ((BandPrototile (r ((if Even s.val then i - 1 else i + + 1).succ)) Zp) → (((aU.re : Real) = (TileCentroid U).1 + (TileCentroid U).2) → + (((aU.im : Real) = (TileCentroid U).2 - (TileCentroid U).1) → ((TileCentroid Wp - + TileCentroid U = (-(TileCentroid W - TileCentroid U).2, (TileCentroid W - + TileCentroid U).1)) → ((TileCentroid Zp - TileCentroid U = (-(TileCentroid Z - + TileCentroid U).2, (TileCentroid Z - TileCentroid U).1)) → ( + let t : Fin 4 := s + 1 + (TileCentroid Wp - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * + (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ)))) → ((TileCentroid + Zp - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * (if Even t.val + then BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r 0) (r ((i + 1).succ)) + else BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r + 0)))) → (((pairedEndpointPackage r U) i t Wp + Zp) → ( + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + ∀ (x : GaussianInt), f (F x) = x))))))))))))) ) := by + classical + intro r i s U W Z q aU haU hUc hUa hUv aW aZ Wp Zp hWp hZp haUre haUim hWpCent hZpCent t hWsrc + hZsrc sourceData F f x + rcases x with ⟨xr, xi⟩ + rcases aU with ⟨ar, ai⟩ + simp [f, F, GaussianQuarterTurn] + +private theorem hfF : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : + ProtoTile), ∀ (W : ProtoTile), ∀ (Z : ProtoTile), + let q : GaussianInt := ⟨0, 1⟩ + ∀ (aU : GaussianInt), (GaussianRealPoint aU = ((TileCentroid U).1 + (TileCentroid U).2, + (TileCentroid U).2 - (TileCentroid U).1)) → (((TileTranslation (TileQuarterTurn U) + aU).cells = U.cells) → ((U.cells = ∅ → (TileTranslation (TileQuarterTurn U) + aU).anchor = U.anchor) → ((FootprintVertices (TileTranslation (TileQuarterTurn U) aU) + = FootprintVertices U) → (∀ (aW : GaussianInt), ∀ (aZ : GaussianInt), + let Wp := TileTranslation W (aU - aW) + let Zp := TileTranslation Z (aU - aZ) + (BandPrototile (r i.succ) Wp) → ((BandPrototile (r ((if Even s.val then i - 1 else i + + 1).succ)) Zp) → (((aU.re : Real) = (TileCentroid U).1 + (TileCentroid U).2) → + (((aU.im : Real) = (TileCentroid U).2 - (TileCentroid U).1) → ((TileCentroid Wp - + TileCentroid U = (-(TileCentroid W - TileCentroid U).2, (TileCentroid W - + TileCentroid U).1)) → ((TileCentroid Zp - TileCentroid U = (-(TileCentroid Z - + TileCentroid U).2, (TileCentroid Z - TileCentroid U).1)) → ( + let t : Fin 4 := s + 1 + (TileCentroid Wp - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * + (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ)))) → ((TileCentroid + Zp - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * (if Even t.val + then BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r 0) (r ((i + 1).succ)) + else BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r + 0)))) → (((pairedEndpointPackage r U) i t Wp + Zp) → ( + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + (∀ (x : GaussianInt), f (F x) = x) → (∀ (x : GaussianInt), F (f x) = x)))))))))))))) ) := by + classical + intro r i s U W Z q aU haU hUc hUa hUv aW aZ Wp Zp hWp hZp haUre haUim hWpCent hZpCent t hWsrc + hZsrc sourceData F f hFf x + rcases x with ⟨xr, xi⟩ + rcases aU with ⟨ar, ai⟩ + simp [f, F, GaussianQuarterTurn] + +private theorem hf : + (by + classical + exact + ∀ (aU : GaussianInt), + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + (∀ (x : GaussianInt), F (f x) = x) → (Function.Injective f) ) := by + classical + intro aU F f hfF x y h + have := congrArg F h + simpa only [hfF] using this + +private theorem hUedges : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (aU : GaussianInt), ((TileTranslation (TileQuarterTurn U) aU).cells + = U.cells) → (FootprintEdges (TileTranslation (TileQuarterTurn U) aU) = + FootprintEdges U) ) := by + classical + intro U aU hUc + ext e + simp only [FootprintEdges, Set.mem_ofPred_eq, hUc] + +private theorem hWedges : + (by + classical + exact + ∀ (W : ProtoTile), ∀ (aW : GaussianInt), ((TileTranslation (TileQuarterTurn W) aW).cells + = W.cells) → (FootprintEdges (TileTranslation (TileQuarterTurn W) aW) = + FootprintEdges W) ) := by + classical + intro W aW hWc + ext e + simp only [FootprintEdges, Set.mem_ofPred_eq, hWc] + +private theorem hZedges : + (by + classical + exact + ∀ (Z : ProtoTile), ∀ (aZ : GaussianInt), ((TileTranslation (TileQuarterTurn Z) aZ).cells + = Z.cells) → (FootprintEdges (TileTranslation (TileQuarterTurn Z) aZ) = + FootprintEdges Z) ) := by + classical + intro Z aZ hZc + ext e + simp only [FootprintEdges, Set.mem_ofPred_eq, hZc] + +private theorem hFvU : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (aU : GaussianInt), (FootprintVertices (TileTranslation + (TileQuarterTurn U) aU) = FootprintVertices U) → ( + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + FootprintVertices U = F '' FootprintVertices U) ) := by + classical + intro U aU hUv F + conv_lhs => rw [← hUv] + rw [(TileTranslationFormulas (TileQuarterTurn U) aU).2.2.2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.2.2.1] + simp only [Set.image_image] + change (GaussianTranslation aU ∘ GaussianQuarterTurn) '' + FootprintVertices U = F '' FootprintVertices U + congr 1 + +private theorem hFeU : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (aU : GaussianInt), + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + (FootprintEdges (TileTranslation (TileQuarterTurn U) aU) = FootprintEdges U) → + (FootprintEdges U = (fun e : Finset GaussianInt => e.image F) '' FootprintEdges U) ) + := by + classical + intro U aU F hUedges + conv_lhs => rw [← hUedges] + rw [(TileTranslationFormulas (TileQuarterTurn U) aU).2.2.2.2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.2.2.2.1] + simp only [Set.image_image, Finset.image_image] + change (fun e : Finset GaussianInt => e.image + (GaussianTranslation aU ∘ GaussianQuarterTurn)) '' FootprintEdges U = + (fun e : Finset GaussianInt => e.image F) '' FootprintEdges U + congr 1 + +private theorem hFvW : + (by + classical + exact + ∀ (W : ProtoTile), ∀ (aU : GaussianInt), ∀ (aW : GaussianInt), (FootprintVertices + (TileTranslation (TileQuarterTurn W) aW) = FootprintVertices W) → ( + let Wp := TileTranslation W (aU - aW) + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + FootprintVertices Wp = F '' FootprintVertices W) ) := by + classical + intro W aU aW hWv Wp F + rw [(TileTranslationFormulas W (aU - aW)).2.2.2.2.2.1] + conv_lhs => rw [← hWv] + rw [ + (TileTranslationFormulas (TileQuarterTurn W) aW).2.2.2.2.2.1, + (TileQuarterTurnFormulas W).2.2.2.2.2.1] + simp only [Set.image_image] + congr 1 + funext x + simp [F, GaussianTranslation] + +private theorem hFvZ : + (by + classical + exact + ∀ (Z : ProtoTile), ∀ (aU : GaussianInt), ∀ (aZ : GaussianInt), (FootprintVertices + (TileTranslation (TileQuarterTurn Z) aZ) = FootprintVertices Z) → ( + let Zp := TileTranslation Z (aU - aZ) + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + FootprintVertices Zp = F '' FootprintVertices Z) ) := by + classical + intro Z aU aZ hZv Zp F + rw [(TileTranslationFormulas Z (aU - aZ)).2.2.2.2.2.1] + conv_lhs => rw [← hZv] + rw [ + (TileTranslationFormulas (TileQuarterTurn Z) aZ).2.2.2.2.2.1, + (TileQuarterTurnFormulas Z).2.2.2.2.2.1] + simp only [Set.image_image] + congr 1 + funext x + simp [F, GaussianTranslation] + +private theorem hFeW : + (by + classical + exact + ∀ (W : ProtoTile), ∀ (aU : GaussianInt), ∀ (aW : GaussianInt), + let Wp := TileTranslation W (aU - aW) + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + (FootprintEdges (TileTranslation (TileQuarterTurn W) aW) = FootprintEdges W) → + (FootprintEdges Wp = (fun e : Finset GaussianInt => e.image F) '' FootprintEdges W) ) + := by + classical + intro W aU aW Wp F hWedges + rw [(TileTranslationFormulas W (aU - aW)).2.2.2.2.2.2.1] + conv_lhs => rw [← hWedges] + rw [ + (TileTranslationFormulas (TileQuarterTurn W) aW).2.2.2.2.2.2.1, + (TileQuarterTurnFormulas W).2.2.2.2.2.2.1] + simp only [Set.image_image, Finset.image_image] + congr 1 + funext e + ext x + simp [F, GaussianTranslation] + +private theorem hFeZ : + (by + classical + exact + ∀ (Z : ProtoTile), ∀ (aU : GaussianInt), ∀ (aZ : GaussianInt), + let Zp := TileTranslation Z (aU - aZ) + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + (FootprintEdges (TileTranslation (TileQuarterTurn Z) aZ) = FootprintEdges Z) → + (FootprintEdges Zp = (fun e : Finset GaussianInt => e.image F) '' FootprintEdges Z) ) + := by + classical + intro Z aU aZ Zp F hZedges + rw [(TileTranslationFormulas Z (aU - aZ)).2.2.2.2.2.2.1] + conv_lhs => rw [← hZedges] + rw [ + (TileTranslationFormulas (TileQuarterTurn Z) aZ).2.2.2.2.2.2.1, + (TileQuarterTurnFormulas Z).2.2.2.2.2.2.1] + simp only [Set.image_image, Finset.image_image] + congr 1 + funext e + ext x + simp [F, GaussianTranslation] + +private theorem hinvV : + (by + classical + exact + ∀ (aU : GaussianInt), + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + (∀ (x : GaussianInt), f (F x) = x) → (∀ (S : Set GaussianInt), f '' (F '' S) = S) ) := by + classical + intro aU F f hFf S + rw [Set.image_image] + ext x + simp [hFf] + +private theorem hinvE : + (by + classical + exact + ∀ (aU : GaussianInt), + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + (∀ (x : GaussianInt), f (F x) = x) → (∀ (E : Set (Finset GaussianInt)), (fun e : Finset + GaussianInt => e.image f) '' ((fun e : Finset GaussianInt => e.image F) '' E) = E) ) + := by + classical + intro aU F f hFf E + rw [Set.image_image] + simp only [Finset.image_image] + change (fun e : Finset GaussianInt => e.image (f ∘ F)) '' E = E + ext e + simp [Function.comp_def, hFf] + +private theorem hFtranslate : + (by + classical + exact + ∀ (aU : GaussianInt), + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + ∀ (v : GaussianInt), F ∘ GaussianTranslation v = GaussianTranslation (GaussianQuarterTurn + v) ∘ F ) := by + classical + intro aU F v + funext x + ext <;> simp [F, GaussianTranslation, GaussianQuarterTurn] <;> abel + +private theorem hFtranslateE : + (by + classical + exact + ∀ (aU : GaussianInt), + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + (∀ (v : GaussianInt), F ∘ GaussianTranslation v = GaussianTranslation + (GaussianQuarterTurn v) ∘ F) → (∀ (v : GaussianInt), (fun e : Finset GaussianInt => + e.image F) ∘ (fun e : Finset GaussianInt => e.image (GaussianTranslation v)) = (fun e + : Finset GaussianInt => e.image (GaussianTranslation (GaussianQuarterTurn v))) ∘ (fun + e : Finset GaussianInt => e.image F)) ) := by + classical + intro aU F hFtranslate v + funext e + change (e.image (GaussianTranslation v)).image F = + (e.image F).image (GaussianTranslation (GaussianQuarterTurn v)) + rw [Finset.image_image, Finset.image_image] + congr 1 + funext x + exact congrFun (hFtranslate v) x + +private theorem setImageComp : + (by + classical + exact + ∀ {α : Type}, ∀ {β : Type}, ∀ {γ : Type}, ∀ (g : β → γ), ∀ (h : α → β), ∀ (S : Set α), g + '' (h '' S) = (g ∘ h) '' S ) := by + classical + intro α β γ g h S + ext x + simp [] + +private theorem hFchildV : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (aU : GaussianInt), + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + (FootprintVertices U = F '' FootprintVertices U) → ((∀ (v : GaussianInt), F ∘ + GaussianTranslation v = GaussianTranslation (GaussianQuarterTurn v) ∘ F) → ((∀ + {α : Type}, ∀ {β : Type}, ∀ {γ : Type}, ∀ (g : β → γ), ∀ (h : α → β), ∀ (S : Set α), + g '' (h '' S) = (g ∘ h) '' S) → (∀ (v : GaussianInt), FootprintVertices + (TileTranslation U (GaussianQuarterTurn v)) = F '' FootprintVertices (TileTranslation + U v)))) ) := by + classical + intro U aU F hFvU hFtranslate setImageComp v + rw [(TileTranslationFormulas U (GaussianQuarterTurn v)).2.2.2.2.2.1, + (TileTranslationFormulas U v).2.2.2.2.2.1] + calc + GaussianTranslation (GaussianQuarterTurn v) '' FootprintVertices U = + GaussianTranslation (GaussianQuarterTurn v) '' + (F '' FootprintVertices U) := + congrArg (fun S : Set GaussianInt => + GaussianTranslation (GaussianQuarterTurn v) '' S) hFvU + _ = (GaussianTranslation (GaussianQuarterTurn v) ∘ F) '' + FootprintVertices U := setImageComp _ _ _ + _ = (F ∘ GaussianTranslation v) '' FootprintVertices U := by + exact congrArg (fun g : GaussianInt → GaussianInt => + g '' FootprintVertices U) (hFtranslate v).symm + _ = F '' (GaussianTranslation v '' FootprintVertices U) := by + exact (setImageComp F (GaussianTranslation v) _).symm + +private theorem hFchildE : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (aU : GaussianInt), + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + (FootprintEdges U = (fun e : Finset GaussianInt => e.image F) '' FootprintEdges U) → ((∀ + (v : GaussianInt), (fun e : Finset GaussianInt => e.image F) ∘ (fun e : Finset + GaussianInt => e.image (GaussianTranslation v)) = (fun e : Finset GaussianInt => + e.image (GaussianTranslation (GaussianQuarterTurn v))) ∘ (fun e : Finset GaussianInt + => e.image F)) → ((∀ {α : Type}, ∀ {β : Type}, ∀ {γ : Type}, ∀ (g : β → γ), ∀ (h : α + → β), ∀ (S : Set α), g '' (h '' S) = (g ∘ h) '' S) → (∀ (v : GaussianInt), + FootprintEdges (TileTranslation U (GaussianQuarterTurn v)) = (fun e : Finset + GaussianInt => e.image F) '' FootprintEdges (TileTranslation U v)))) ) := by + classical + intro U aU F hFeU hFtranslateE setImageComp v + rw [(TileTranslationFormulas U (GaussianQuarterTurn v)).2.2.2.2.2.2.1, + (TileTranslationFormulas U v).2.2.2.2.2.2.1] + calc + (fun e : Finset GaussianInt => e.image + (GaussianTranslation (GaussianQuarterTurn v))) '' FootprintEdges U = + (fun e => e.image (GaussianTranslation (GaussianQuarterTurn v))) '' + ((fun e => e.image F) '' FootprintEdges U) := + congrArg (fun E : Set (Finset GaussianInt) => + (fun e => e.image (GaussianTranslation (GaussianQuarterTurn v))) '' E) hFeU + _ = ((fun e => e.image (GaussianTranslation (GaussianQuarterTurn v))) ∘ + (fun e => e.image F)) '' FootprintEdges U := + setImageComp _ _ _ + _ = ((fun e => e.image F) ∘ + (fun e => e.image (GaussianTranslation v))) '' FootprintEdges U := by + exact congrArg (fun g : Finset GaussianInt → Finset GaussianInt => + g '' FootprintEdges U) (hFtranslateE v).symm + _ = (fun e => e.image F) '' + ((fun e => e.image (GaussianTranslation v)) '' FootprintEdges U) := by + exact (setImageComp (fun e : Finset GaussianInt => e.image F) + (fun e : Finset GaussianInt => e.image (GaussianTranslation v)) + (FootprintEdges U)).symm + +private theorem hQq3 : + (by + classical + exact + let q3 : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) + ∀ (x : GaussianInt), GaussianQuarterTurn (q3 x) = x ) := by + classical + intro q3 x + rcases x with ⟨xr, xi⟩ + simp [q3, GaussianQuarterTurn] + +private theorem hbaseV : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (aU : GaussianInt), + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + (FootprintVertices U = F '' FootprintVertices U) → ((∀ (S : Set GaussianInt), f '' (F '' + S) = S) → (FootprintVertices U = f '' FootprintVertices U)) ) := by + classical + intro U aU F f hFvU hinvV + calc + FootprintVertices U = f '' (F '' FootprintVertices U) := + (hinvV _).symm + _ = f '' FootprintVertices U := by rw [← hFvU] + +private theorem hbaseE : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (aU : GaussianInt), + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + (FootprintEdges U = (fun e : Finset GaussianInt => e.image F) '' FootprintEdges U) → ((∀ + (E : Set (Finset GaussianInt)), (fun e : Finset GaussianInt => e.image f) '' ((fun e + : Finset GaussianInt => e.image F) '' E) = E) → (FootprintEdges U = (fun e : Finset + GaussianInt => e.image f) '' FootprintEdges U)) ) := by + classical + intro U aU F f hFeU hinvE + calc + FootprintEdges U = (fun e : Finset GaussianInt => e.image f) '' + ((fun e : Finset GaussianInt => e.image F) '' FootprintEdges U) := + (hinvE _).symm + _ = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges U := by + rw [← hFeU] + +private theorem hparentWV : + (by + classical + exact + ∀ (W : ProtoTile), ∀ (aU : GaussianInt), ∀ (aW : GaussianInt), + let Wp := TileTranslation W (aU - aW) + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + (FootprintVertices Wp = F '' FootprintVertices W) → ((∀ (S : Set GaussianInt), f '' (F '' + S) = S) → (FootprintVertices W = f '' FootprintVertices Wp)) ) := by + classical + intro W aU aW Wp F f hFvW hinvV + calc + FootprintVertices W = f '' (F '' FootprintVertices W) := + (hinvV _).symm + _ = f '' FootprintVertices Wp := by rw [hFvW] + +private theorem hparentZV : + (by + classical + exact + ∀ (Z : ProtoTile), ∀ (aU : GaussianInt), ∀ (aZ : GaussianInt), + let Zp := TileTranslation Z (aU - aZ) + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + (FootprintVertices Zp = F '' FootprintVertices Z) → ((∀ (S : Set GaussianInt), f '' (F '' + S) = S) → (FootprintVertices Z = f '' FootprintVertices Zp)) ) := by + classical + intro Z aU aZ Zp F f hFvZ hinvV + calc + FootprintVertices Z = f '' (F '' FootprintVertices Z) := + (hinvV _).symm + _ = f '' FootprintVertices Zp := by rw [hFvZ] + +private theorem hparentWE : + (by + classical + exact + ∀ (W : ProtoTile), ∀ (aU : GaussianInt), ∀ (aW : GaussianInt), + let Wp := TileTranslation W (aU - aW) + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + (FootprintEdges Wp = (fun e : Finset GaussianInt => e.image F) '' FootprintEdges W) → ((∀ + (E : Set (Finset GaussianInt)), (fun e : Finset GaussianInt => e.image f) '' ((fun e + : Finset GaussianInt => e.image F) '' E) = E) → (FootprintEdges W = (fun e : Finset + GaussianInt => e.image f) '' FootprintEdges Wp)) ) := by + classical + intro W aU aW Wp F f hFeW hinvE + calc + FootprintEdges W = (fun e : Finset GaussianInt => e.image f) '' + ((fun e : Finset GaussianInt => e.image F) '' FootprintEdges W) := + (hinvE _).symm + _ = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges Wp := by + rw [hFeW] + +private theorem hparentZE : + (by + classical + exact + ∀ (Z : ProtoTile), ∀ (aU : GaussianInt), ∀ (aZ : GaussianInt), + let Zp := TileTranslation Z (aU - aZ) + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + (FootprintEdges Zp = (fun e : Finset GaussianInt => e.image F) '' FootprintEdges Z) → ((∀ + (E : Set (Finset GaussianInt)), (fun e : Finset GaussianInt => e.image f) '' ((fun e + : Finset GaussianInt => e.image F) '' E) = E) → (FootprintEdges Z = (fun e : Finset + GaussianInt => e.image f) '' FootprintEdges Zp)) ) := by + classical + intro Z aU aZ Zp F f hFeZ hinvE + calc + FootprintEdges Z = (fun e : Finset GaussianInt => e.image f) '' + ((fun e : Finset GaussianInt => e.image F) '' FootprintEdges Z) := + (hinvE _).symm + _ = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges Zp := by + rw [hFeZ] + +private theorem hchildV : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (aU : GaussianInt), + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + (∀ (S : Set GaussianInt), f '' (F '' S) = S) → ((∀ (v : GaussianInt), FootprintVertices + (TileTranslation U (GaussianQuarterTurn v)) = F '' FootprintVertices (TileTranslation + U v)) → ( + let q3 : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) + (∀ (x : GaussianInt), GaussianQuarterTurn (q3 x) = x) → (∀ (v : GaussianInt), + FootprintVertices (TileTranslation U (q3 v)) = f '' FootprintVertices + (TileTranslation U v)))) ) := by + classical + intro U aU F f hinvV hFchildV q3 hQq3 v + calc + FootprintVertices (TileTranslation U (q3 v)) = + f '' (F '' FootprintVertices (TileTranslation U (q3 v))) := + (hinvV _).symm + _ = f '' FootprintVertices (TileTranslation U v) := by + rw [← hFchildV (q3 v), hQq3] + +private theorem hchildE : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (aU : GaussianInt), + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + (∀ (E : Set (Finset GaussianInt)), (fun e : Finset GaussianInt => e.image f) '' ((fun e : + Finset GaussianInt => e.image F) '' E) = E) → ((∀ (v : GaussianInt), FootprintEdges + (TileTranslation U (GaussianQuarterTurn v)) = (fun e : Finset GaussianInt => e.image + F) '' FootprintEdges (TileTranslation U v)) → ( + let q3 : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) + (∀ (x : GaussianInt), GaussianQuarterTurn (q3 x) = x) → (∀ (v : GaussianInt), + FootprintEdges (TileTranslation U (q3 v)) = (fun e : Finset GaussianInt => e.image f) + '' FootprintEdges (TileTranslation U v)))) ) := by + classical + intro U aU F f hinvE hFchildE q3 hQq3 v + calc + FootprintEdges (TileTranslation U (q3 v)) = + (fun e : Finset GaussianInt => e.image f) '' + ((fun e : Finset GaussianInt => e.image F) '' + FootprintEdges (TileTranslation U (q3 v))) := + (hinvE _).symm + _ = (fun e : Finset GaussianInt => e.image f) '' + FootprintEdges (TileTranslation U v) := by + rw [← hFchildE (q3 v), hQq3] + +private theorem notEven1 : + (by + classical + exact + (Fin (4 : ℕ) → CircleCoordinates) → ((Fin (3 : ℕ)) → ((Fin (4 : ℕ)) → (¬ Even (1 : + Nat)))) ) := by + classical + intro r i s + rintro ⟨n, hn⟩ + omega + +private theorem notEven3 : + (by + classical + exact + (Fin (4 : ℕ) → CircleCoordinates) → ((Fin (3 : ℕ)) → ((Fin (4 : ℕ)) → (¬ Even (3 : + Nat)))) ) := by + classical + intro r i s + rintro ⟨n, hn⟩ + omega + +private theorem hq3mul : + (by + classical + exact + let q : GaussianInt := ⟨0, 1⟩ + (q ^ 3 = -q) → ( + let q3 : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) + ∀ (x : GaussianInt), q3 x = q ^ 3 * x) ) := by + classical + intro q hq3 q3 x + rcases x with ⟨xr, xi⟩ + rw [hq3] + ext <;> simp [q3, q, GaussianQuarterTurn, Zsqrtd.re_mul, + Zsqrtd.im_mul] + +private theorem hdispR : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : + ProtoTile), ∀ (W : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if (Even s.val) + then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < (r (if + Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → + ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → ((TileCentroid Z - TileCentroid U + = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if + Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : + ℕ))).succ) - BandVectors.1 (r (i - (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) + else BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : ℕ))).succ))) → ( + let q : GaussianInt := ⟨0, 1⟩ + ∀ (aU : GaussianInt), ∀ (aW : GaussianInt), ∀ (aZ : GaussianInt), + let Wp := TileTranslation W (aU - aW) + let Zp := TileTranslation Z (aU - aZ) + (BandPrototile (r ((if Even s.val then i - 1 else i + 1).succ)) Zp) → (((-(TileCentroid W + - TileCentroid U).2, (TileCentroid W - TileCentroid U).1) = (1 / 2 : Real) • + GaussianRealPoint (q * (q ^ s.val * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 + (r 0) (r i.succ))))) → ( + let t : Fin 4 := s + 1 + (Even t.val ↔ ¬ Even s.val) → ((q ^ 2 = -1) → ((q ^ 3 = -q) → ((∀ (x : GaussianInt), q * + (q * x) = -x) → ((q ^ t.val = q * q ^ s.val) → ((TileCentroid Wp - TileCentroid U = + (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * (BandVectors.1 (r i.succ) (r 0) + + BandVectors.1 (r 0) (r i.succ)))) → (((-(TileCentroid Z - TileCentroid U).2, + (TileCentroid Z - TileCentroid U).1) = (1 / 2 : Real) • GaussianRealPoint (q * (q ^ + s.val * (if Even s.val then BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r + ((i - 1).succ)) (r 0) else BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r + 0) (r ((i + 1).succ)))))) → ((TileCentroid Zp - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint (q ^ t.val * (if Even t.val then BandVectors.1 (r ((i + 1).succ)) + (r 0) - BandVectors.1 (r 0) (r ((i + 1).succ)) else BandVectors.1 (r 0) (r ((i - + 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r 0)))) → (((r ((if Even t.val then i + + 1 else i - 1).succ)) = (r ((if Even s.val then i - 1 else i + 1).succ))) → ( + let uL : GaussianInt := q ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + ((pairedEndpointPackage r U) i t Wp + Zp) → ( + let q3 : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) + let vR : GaussianInt := q ^ t.val * + (if Even t.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + (Even (0 : Nat)) → ((Even (2 : Nat)) → ((¬ Even (1 : Nat)) → ((¬ Even (3 : Nat)) → ((∀ (x + : GaussianInt), q3 x = q ^ 3 * x) → (q3 vR = uL))))))))))))))))))))) ) := by + classical + intro r i s U W Z hZ hZpos hWcent hZcent q aU aW aZ Wp Zp hZp hWrot t htpar hq2 hq3 hq2act + hpower hWsrc hZrot hZsrc hZlabel uL sourceData q3 vR even0 even2 notEven1 notEven3 hq3mul + let uR : GaussianInt := q ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + rw [hq3mul] + fin_cases s <;> simp [vR, uL, t, + even0, even2, notEven1, notEven3, hq2, hq3] <;> + try simp [hq2act] + +private theorem hdispL : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : + ProtoTile), ∀ (W : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if (Even s.val) + then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < (r (if + Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → + ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → ((TileCentroid Z - TileCentroid U + = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if + Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : + ℕ))).succ) - BandVectors.1 (r (i - (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) + else BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : ℕ))).succ))) → ( + let q : GaussianInt := ⟨0, 1⟩ + ∀ (aU : GaussianInt), ∀ (aW : GaussianInt), ∀ (aZ : GaussianInt), + let Wp := TileTranslation W (aU - aW) + let Zp := TileTranslation Z (aU - aZ) + (BandPrototile (r ((if Even s.val then i - 1 else i + 1).succ)) Zp) → (((-(TileCentroid W + - TileCentroid U).2, (TileCentroid W - TileCentroid U).1) = (1 / 2 : Real) • + GaussianRealPoint (q * (q ^ s.val * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 + (r 0) (r i.succ))))) → ( + let t : Fin 4 := s + 1 + (Even t.val ↔ ¬ Even s.val) → ((q ^ 2 = -1) → ((q ^ 3 = -q) → ((∀ (x : GaussianInt), q * + (q * x) = -x) → ((q ^ t.val = q * q ^ s.val) → ((TileCentroid Wp - TileCentroid U = + (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * (BandVectors.1 (r i.succ) (r 0) + + BandVectors.1 (r 0) (r i.succ)))) → (((-(TileCentroid Z - TileCentroid U).2, + (TileCentroid Z - TileCentroid U).1) = (1 / 2 : Real) • GaussianRealPoint (q * (q ^ + s.val * (if Even s.val then BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r + ((i - 1).succ)) (r 0) else BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r + 0) (r ((i + 1).succ)))))) → ((TileCentroid Zp - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint (q ^ t.val * (if Even t.val then BandVectors.1 (r ((i + 1).succ)) + (r 0) - BandVectors.1 (r 0) (r ((i + 1).succ)) else BandVectors.1 (r 0) (r ((i - + 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r 0)))) → (((r ((if Even t.val then i + + 1 else i - 1).succ)) = (r ((if Even s.val then i - 1 else i + 1).succ))) → ( + let uR : GaussianInt := q ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + let uL : GaussianInt := q ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + ((pairedEndpointPackage r U) i t Wp + Zp) → ( + let q3 : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) + let vR : GaussianInt := q ^ t.val * + (if Even t.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + let vL : GaussianInt := q ^ t.val * + (if Even t.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + (Even (0 : Nat)) → ((Even (2 : Nat)) → ((¬ Even (1 : Nat)) → ((¬ Even (3 : Nat)) → ((∀ (x + : GaussianInt), q3 x = q ^ 3 * x) → ((q3 vR = uL) → (q3 vL = uR)))))))))))))))))))))) + ) := by + classical + intro r i s U W Z hZ hZpos hWcent hZcent q aU aW aZ Wp Zp hZp hWrot t htpar hq2 hq3 hq2act + hpower hWsrc hZrot hZsrc hZlabel uR uL sourceData q3 vR vL even0 even2 notEven1 notEven3 + hq3mul hdispR + rw [hq3mul] + fin_cases s <;> simp [vL, uR, t, + even0, even2, notEven1, notEven3, hq2, hq3] <;> + try simp [hq2act] + +private theorem hstep : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : + ProtoTile), ∀ (W : ProtoTile), ∀ (Z : ProtoTile), + let q : GaussianInt := ⟨0, 1⟩ + ∀ (aU : GaussianInt), (GaussianRealPoint aU = ((TileCentroid U).1 + (TileCentroid U).2, + (TileCentroid U).2 - (TileCentroid U).1)) → (((TileTranslation (TileQuarterTurn U) + aU).cells = U.cells) → ((U.cells = ∅ → (TileTranslation (TileQuarterTurn U) + aU).anchor = U.anchor) → ((FootprintVertices (TileTranslation (TileQuarterTurn U) aU) + = FootprintVertices U) → (∀ (aW : GaussianInt), ∀ (aZ : GaussianInt), + let Wp := TileTranslation W (aU - aW) + let Zp := TileTranslation Z (aU - aZ) + (BandPrototile (r i.succ) Wp) → ((BandPrototile (r ((if Even s.val then i - 1 else i + + 1).succ)) Zp) → (((aU.re : Real) = (TileCentroid U).1 + (TileCentroid U).2) → + (((aU.im : Real) = (TileCentroid U).2 - (TileCentroid U).1) → ((TileCentroid Wp - + TileCentroid U = (-(TileCentroid W - TileCentroid U).2, (TileCentroid W - + TileCentroid U).1)) → ((TileCentroid Zp - TileCentroid U = (-(TileCentroid Z - + TileCentroid U).2, (TileCentroid Z - TileCentroid U).1)) → ( + let t : Fin 4 := s + 1 + (TileCentroid Wp - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * + (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ)))) → ((TileCentroid + Zp - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * (if Even t.val + then BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r 0) (r ((i + 1).succ)) + else BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r + 0)))) → ( + ((pairedEndpointPackage r U) i t Wp + Zp) → ( + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + (∀ (x : GaussianInt), f (F x) = x) → ((∀ (x : GaussianInt), F (f x) = x) → + ((Function.Injective f) → ((FootprintEdges (TileTranslation (TileQuarterTurn U) aU) = + FootprintEdges U) → ((FootprintVertices U = F '' FootprintVertices U) → + ((FootprintEdges U = (fun e : Finset GaussianInt => e.image F) '' FootprintEdges U) → + ((FootprintVertices Wp = F '' FootprintVertices W) → ((FootprintVertices Zp = F '' + FootprintVertices Z) → ((FootprintEdges Wp = (fun e : Finset GaussianInt => e.image + F) '' FootprintEdges W) → ((FootprintEdges Zp = (fun e : Finset GaussianInt => + e.image F) '' FootprintEdges Z) → ((∀ (S : Set GaussianInt), f '' (F '' S) = S) → ((∀ + (E : Set (Finset GaussianInt)), (fun e : Finset GaussianInt => e.image f) '' ((fun e + : Finset GaussianInt => e.image F) '' E) = E) → ((∀ (v : GaussianInt), F ∘ + GaussianTranslation v = GaussianTranslation (GaussianQuarterTurn v) ∘ F) → ((∀ (v : + GaussianInt), (fun e : Finset GaussianInt => e.image F) ∘ (fun e : Finset GaussianInt + => e.image (GaussianTranslation v)) = (fun e : Finset GaussianInt => e.image + (GaussianTranslation (GaussianQuarterTurn v))) ∘ (fun e : Finset GaussianInt => + e.image F)) → ((∀ (v : GaussianInt), FootprintVertices (TileTranslation U + (GaussianQuarterTurn v)) = F '' FootprintVertices (TileTranslation U v)) → ((∀ (v : + GaussianInt), FootprintEdges (TileTranslation U (GaussianQuarterTurn v)) = (fun e : + Finset GaussianInt => e.image F) '' FootprintEdges (TileTranslation U v)) → ( + let q3 : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) + (FootprintVertices U = f '' FootprintVertices U) → ((FootprintEdges U = (fun e : Finset + GaussianInt => e.image f) '' FootprintEdges U) → ((FootprintVertices W = f '' + FootprintVertices Wp) → ((FootprintVertices Z = f '' FootprintVertices Zp) → + ((FootprintEdges W = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges Wp) + → ((FootprintEdges Z = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges + Zp) → ((∀ (v : GaussianInt), FootprintVertices (TileTranslation U (q3 v)) = f '' + FootprintVertices (TileTranslation U v)) → ((∀ (v : GaussianInt), FootprintEdges + (TileTranslation U (q3 v)) = (fun e : Finset GaussianInt => e.image f) '' + FootprintEdges (TileTranslation U v)) → (∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 + ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → (f b = f a + 1 ∨ f b = f a - 1 ∨ f b = f a + ⟨0, + 1⟩ ∨ f b = f a - ⟨0, 1⟩)))))))))))))))))))))))))))))))))))))) ) := by + classical + intro r i s U W Z q aU haU hUc hUa hUv aW aZ Wp Zp hWp hZp haUre haUim hWpCent hZpCent t hWsrc + hZsrc sourceData F f hFf hfF hf hUedges hFvU hFeU hFvW hFvZ hFeW hFeZ hinvV hinvE + hFtranslate hFtranslateE hFchildV hFchildE q3 hbaseV hbaseE hparentWV hparentZV hparentWE + hparentZE hchildV hchildE a b hab + let uR : GaussianInt := q ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + let uL : GaussianInt := q ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + rcases hab with h | h | h | h + · subst b + right + right + right + rcases a with ⟨ar, ai⟩ + rcases aU with ⟨ur, ui⟩ + ext <;> simp [f, GaussianQuarterTurn]; omega + · subst b + right + right + left + rcases a with ⟨ar, ai⟩ + rcases aU with ⟨ur, ui⟩ + ext <;> simp [f, GaussianQuarterTurn]; omega + · subst b + left + rcases a with ⟨ar, ai⟩ + rcases aU with ⟨ur, ui⟩ + ext <;> simp [f, GaussianQuarterTurn]; omega + · subst b + right + left + rcases a with ⟨ar, ai⟩ + rcases aU with ⟨ur, ui⟩ + ext <;> simp [f, GaussianQuarterTurn]; omega + +private theorem hchildVR : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : + ProtoTile), + let q : GaussianInt := ⟨0, 1⟩ + ∀ (aU : GaussianInt), + let t : Fin 4 := s + 1 + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + let q3 : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) + (∀ (v : GaussianInt), FootprintVertices (TileTranslation U (q3 v)) = f '' + FootprintVertices (TileTranslation U v)) → ( + let vR : GaussianInt := q ^ t.val * + (if Even t.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + let uL : GaussianInt := q ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + (q3 vR = uL) → (FootprintVertices (TileTranslation U uL) = f '' FootprintVertices + (TileTranslation U vR))) ) := by + classical + intro r i s U q aU t f q3 hchildV vR uL hdispR + simpa [hdispR] using hchildV vR + +private theorem hchildER : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : + ProtoTile), + let q : GaussianInt := ⟨0, 1⟩ + ∀ (aU : GaussianInt), + let t : Fin 4 := s + 1 + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + let q3 : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) + (∀ (v : GaussianInt), FootprintEdges (TileTranslation U (q3 v)) = (fun e : Finset + GaussianInt => e.image f) '' FootprintEdges (TileTranslation U v)) → ( + let vR : GaussianInt := q ^ t.val * + (if Even t.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + let uL : GaussianInt := q ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + (q3 vR = uL) → (FootprintEdges (TileTranslation U uL) = (fun e : Finset GaussianInt => + e.image f) '' FootprintEdges (TileTranslation U vR))) ) := by + classical + intro r i s U q aU t f q3 hchildE vR uL hdispR + simpa [hdispR] using hchildE vR + +private theorem hchildVI : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : + ProtoTile), + let q : GaussianInt := ⟨0, 1⟩ + ∀ (aU : GaussianInt), + let t : Fin 4 := s + 1 + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + let q3 : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) + (∀ (v : GaussianInt), FootprintVertices (TileTranslation U (q3 v)) = f '' + FootprintVertices (TileTranslation U v)) → ( + let vL : GaussianInt := q ^ t.val * + (if Even t.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + let uR : GaussianInt := q ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + (q3 vL = uR) → (FootprintVertices (TileTranslation U uR) = f '' FootprintVertices + (TileTranslation U vL))) ) := by + classical + intro r i s U q aU t f q3 hchildV vL uR hdispL + simpa [hdispL] using hchildV vL + +private theorem hchildEI : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : + ProtoTile), + let q : GaussianInt := ⟨0, 1⟩ + ∀ (aU : GaussianInt), + let t : Fin 4 := s + 1 + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + let q3 : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) + (∀ (v : GaussianInt), FootprintEdges (TileTranslation U (q3 v)) = (fun e : Finset + GaussianInt => e.image f) '' FootprintEdges (TileTranslation U v)) → ( + let vL : GaussianInt := q ^ t.val * + (if Even t.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + let uR : GaussianInt := q ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + (q3 vL = uR) → (FootprintEdges (TileTranslation U uR) = (fun e : Finset GaussianInt => + e.image f) '' FootprintEdges (TileTranslation U vL))) ) := by + classical + intro r i s U q aU t f q3 hchildE vL uR hdispL + simpa [hdispL] using hchildE vL + +end OppositeEndpointGeometry + +theorem P4055T1OrderedGeneralOppositeEndpoints : + ∀ (r : Fin 4 → CircleCoordinates), (ProperBandQuadruple r) → (∀ (cfg : + BandOrderedGeneralConfiguration r), ∀ (C₀ : BandCircle), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ + (U : ProtoTile), ∀ (W : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r 0) U) → + ((BandPrototile (r i.succ) W) → ((BandPrototile + (r ((if Even s.val then i - 1 else i + 1).succ)) Z) → ((0 < (r 0).1) → ((0 < (r i.succ).1) + → ((0 < (r ((if Even s.val then i - 1 else i + 1).succ)).1) → ((TileCentroid W - + TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (r i.succ) (r 0) + + BandVectors.1 (r 0) (r i.succ)))) → ((TileCentroid Z - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (r 0) (r ((i - 1).succ)) - + BandVectors.1 (r ((i - 1).succ)) (r 0) + else + BandVectors.1 (r ((i + 1).succ)) (r 0) - + BandVectors.1 (r 0) (r ((i + 1).succ))))) → ((BandOrderedGeneralLayoutCertificate r + cfg C₀ U) → ((QuarterTurnSymmetric U) → ((QuarterTurnSymmetric W) → + ((QuarterTurnSymmetric Z) → ( + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + let uL := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + ∃ rightData : ExactTileInterfaceTriple U (TileTranslation U uR) W, + ∃ incomingData : ExactTileInterfaceTriple U (TileTranslation U uL) W, + ∃ adjacentData : ExactTileInterfaceTriple U W Z, + rightData.point ≠ incomingData.point ∧ + adjacentData.point = incomingData.point ∧ + rightData.otherCA = incomingData.point ∧ + incomingData.otherCA = rightData.point ∧ + adjacentData.otherAB = rightData.point))))))))))))) := by + intro r hproper cfg C₀ i s U W Z hU hW hZ hUpos hWpos hZpos hWcent hZcent cert hsymU hsymW hsymZ +-- BODY + classical + let q : GaussianInt := ⟨0, 1⟩ + obtain ⟨aU, haU, hUc, hUa, hUv, _⟩ := + (QuarterTurnSymmetricCenteredTransport U) hsymU + obtain ⟨aW, haW, hWc, hWa, hWv, _⟩ := + (QuarterTurnSymmetricCenteredTransport W) hsymW + obtain ⟨aZ, haZ, hZc, hZa, hZv, _⟩ := + (QuarterTurnSymmetricCenteredTransport Z) hsymZ + let Wp := TileTranslation W (aU - aW) + let Zp := TileTranslation Z (aU - aZ) + have hWp : BandPrototile (r i.succ) Wp := + BandPrototileTranslation _ _ _ hW + have hZp : BandPrototile + (r ((if Even s.val then i - 1 else i + 1).succ)) Zp := + BandPrototileTranslation _ _ _ hZ + have haUre := OppositeEndpointGeometry.haUre U aU haU + have haUim := OppositeEndpointGeometry.haUim U aU haU + have hWpCent := OppositeEndpointGeometry.hWpCent U W aU aW haUre + haUim (OppositeEndpointGeometry.haWre W aW haW) (OppositeEndpointGeometry.haWim W aW + haW) + have hZpCent := OppositeEndpointGeometry.hZpCent U Z aU aZ haUre + haUim (OppositeEndpointGeometry.haZre Z aZ haZ) (OppositeEndpointGeometry.haZim Z aZ + haZ) + have hWrot := OppositeEndpointGeometry.hWrot r i s U W hWcent + let t : Fin 4 := s + 1 + have htpar : Even t.val ↔ ¬ Even s.val := by + fin_cases s <;> decide + have hq2 := OppositeEndpointGeometry.hq2 + have hq4 := OppositeEndpointGeometry.hq4 hq2 + have hq3 := OppositeEndpointGeometry.hq3 hq2 + have hq2act := OppositeEndpointGeometry.hq2act hq2 + have hq4act := OppositeEndpointGeometry.hq4act hq4 + have hq6act := OppositeEndpointGeometry.hq6act (OppositeEndpointGeometry.hq6 hq2) + have hpower := OppositeEndpointGeometry.hpower r i s U W Z hZ hZpos + hWcent hZcent aU aZ hZp hWrot htpar hq2 hq4 + have hWsrc : TileCentroid Wp - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint (q ^ t.val * + (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))) := + OppositeEndpointGeometry.hWsrc r i s U W aU aW hWpCent hWrot hpower + have hZrot := OppositeEndpointGeometry.hZrot r i s U Z + hZcent + have hZsrc : TileCentroid Zp - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint (q ^ t.val * + (if Even t.val then + BandVectors.1 (r ((i + 1).succ)) (r 0) - + BandVectors.1 (r 0) (r ((i + 1).succ)) + else + BandVectors.1 (r 0) (r ((i - 1).succ)) - + BandVectors.1 (r ((i - 1).succ)) (r 0))) := OppositeEndpointGeometry.hZsrc r i s U Z + aU aZ hZpCent htpar hpower hZrot + have hZlabel : + (r ((if Even t.val then i + 1 else i - 1).succ)) = + (r ((if Even s.val then i - 1 else i + 1).succ)) := OppositeEndpointGeometry.hZlabel r i + s htpar + have sourceData := + (BandOrderedGeneralMixedAggregatePatches r cfg C₀ U cert hsymU).2.2 + i t Wp Zp hWp (by rw [hZlabel]; exact hZp) hWsrc hZsrc + let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) + have hFf := OppositeEndpointGeometry.hFf r i s U W Z aU haU hUc hUa hUv aW aZ hWp hZp haUre + haUim hWpCent hZpCent hWsrc hZsrc sourceData + have hfF := OppositeEndpointGeometry.hfF r i s U W Z aU haU hUc hUa hUv aW aZ hWp hZp haUre + haUim hWpCent hZpCent hWsrc hZsrc sourceData hFf + have hf := OppositeEndpointGeometry.hf aU hfF + have hUedges := OppositeEndpointGeometry.hUedges U aU hUc + have hFvU := OppositeEndpointGeometry.hFvU U + aU hUv + have hFeU := OppositeEndpointGeometry.hFeU U aU hUedges + have hFvW := OppositeEndpointGeometry.hFvW W + aU aW hWv + have hFvZ := OppositeEndpointGeometry.hFvZ Z + aU aZ hZv + have hFeW := OppositeEndpointGeometry.hFeW W aU aW (OppositeEndpointGeometry.hWedges W aW hWc) + have hFeZ := OppositeEndpointGeometry.hFeZ Z aU aZ (OppositeEndpointGeometry.hZedges Z aZ hZc) + have hinvV := OppositeEndpointGeometry.hinvV aU hFf + have hinvE := OppositeEndpointGeometry.hinvE aU hFf + have hFtranslate := OppositeEndpointGeometry.hFtranslate aU + have hFtranslateE := OppositeEndpointGeometry.hFtranslateE aU hFtranslate + have setImageComp {α β γ : Type} (g : β → γ) (h : α → β) + (S : Set α) := OppositeEndpointGeometry.setImageComp (α := + α) (β := β) (γ := γ) g h S + have hFchildV := OppositeEndpointGeometry.hFchildV U aU hFvU hFtranslate setImageComp + have hFchildE := OppositeEndpointGeometry.hFchildE U aU hFeU hFtranslateE setImageComp + let q3 : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) + have hQq3 := OppositeEndpointGeometry.hQq3 + have hbaseV := OppositeEndpointGeometry.hbaseV + U aU hFvU hinvV + have hbaseE := OppositeEndpointGeometry.hbaseE U aU hFeU hinvE + have hparentWV := OppositeEndpointGeometry.hparentWV W aU aW hFvW hinvV + have hparentZV := OppositeEndpointGeometry.hparentZV Z aU aZ hFvZ hinvV + have hparentWE := OppositeEndpointGeometry.hparentWE W aU aW hFeW hinvE + have hparentZE := OppositeEndpointGeometry.hparentZE Z aU aZ hFeZ hinvE + have hchildV := OppositeEndpointGeometry.hchildV U aU hinvV hFchildV hQq3 + have hchildE := OppositeEndpointGeometry.hchildE U aU hinvE hFchildE hQq3 + let vR : GaussianInt := q ^ t.val * + (if Even t.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + let vL : GaussianInt := q ^ t.val * + (if Even t.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + let uR : GaussianInt := q ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) + let uL : GaussianInt := q ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ)) + have even0 : Even (0 : Nat) := ⟨0, rfl⟩ + have even2 : Even (2 : Nat) := ⟨1, by omega⟩ + have notEven1 := OppositeEndpointGeometry.notEven1 r i s + have notEven3 := OppositeEndpointGeometry.notEven3 r i s + have hq3mul := OppositeEndpointGeometry.hq3mul hq3 + have hdispR := OppositeEndpointGeometry.hdispR r i s U W Z hZ hZpos hWcent hZcent + aU aW aZ hZp hWrot htpar hq2 hq3 hq2act hpower hWsrc hZrot hZsrc hZlabel sourceData even0 + even2 notEven1 notEven3 hq3mul + have hdispL := OppositeEndpointGeometry.hdispL r i s U W Z hZ hZpos hWcent hZcent + aU aW aZ hZp hWrot htpar hq2 hq3 hq2act hpower hWsrc hZrot hZsrc hZlabel sourceData even0 + even2 notEven1 notEven3 hq3mul hdispR + have hstep := OppositeEndpointGeometry.hstep r i s U W Z aU + haU hUc hUa hUv aW aZ hWp hZp haUre haUim hWpCent hZpCent hWsrc hZsrc sourceData hFf + hfF hf hUedges hFvU hFeU hFvW hFvZ hFeW hFeZ hinvV hinvE hFtranslate hFtranslateE + hFchildV hFchildE hbaseV hbaseE hparentWV hparentZV hparentWE hparentZE hchildV hchildE + rcases sourceData with ⟨Rsrc, Isrc, Asrc, hRsrc, hIneq, hICA, hRCA, hAAB⟩ + have hchildVR := OppositeEndpointGeometry.hchildVR r i s U + aU hchildV hdispR + have hchildER := OppositeEndpointGeometry.hchildER r i s U aU + hchildE hdispR + have hchildVI := OppositeEndpointGeometry.hchildVI r i s U + aU hchildV hdispL + have hchildEI := OppositeEndpointGeometry.hchildEI r i s U aU + hchildE hdispL + obtain ⟨R, hRpoint, _, _, hRca⟩ := P4055T1ExactTripleImage + f hf hstep U (TileTranslation U vL) Wp U (TileTranslation U uR) W + hbaseV hchildVI hparentWV hbaseE hchildEI hparentWE Isrc + obtain ⟨I, hIpoint, _, _, hIca⟩ := P4055T1ExactTripleImage + f hf hstep U (TileTranslation U vR) Wp U (TileTranslation U uL) W + hbaseV hchildVR hparentWV hbaseE hchildER hparentWE Rsrc + obtain ⟨A, hApoint, hAab, _, _⟩ := P4055T1ExactTripleImage + f hf hstep U Wp Zp U W Z + hbaseV hparentWV hparentZV hbaseE hparentWE hparentZE Asrc + -- The centered turns provide integral shifts; their cell equations are + -- used below only through observable images, never as record equalities. + refine ⟨R, I, A, ?_, ?_, ?_, ?_, ?_⟩ + · intro he + apply hIneq + apply hf + calc + f Isrc.point = R.point := hRpoint.symm + _ = I.point := he + _ = f Rsrc.point := hIpoint + _ = f Asrc.point := congrArg f hRsrc + · calc + A.point = f Asrc.point := hApoint + _ = f Rsrc.point := congrArg f hRsrc.symm + _ = I.point := hIpoint.symm + · calc + R.otherCA = f Isrc.otherCA := hRca + _ = f Asrc.point := congrArg f hICA + _ = f Rsrc.point := congrArg f hRsrc.symm + _ = I.point := hIpoint.symm + · calc + I.otherCA = f Rsrc.otherCA := hIca + _ = f Isrc.point := congrArg f hRCA + _ = R.point := hRpoint.symm + · calc + A.otherAB = f Asrc.otherAB := hAab + _ = f Isrc.point := congrArg f hAAB + _ = R.point := hRpoint.symm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1PackingGridEquivalence.lean b/LeanPool/ApollonianSuperharmonic/P4055T1PackingGridEquivalence.lean new file mode 100644 index 0000000000..5de60dacec --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4055T1PackingGridEquivalence.lean @@ -0,0 +1,154 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction + +-- [TABLET NODE: P4055T1PackingGridEquivalence] + +/-! +# P4055T1PackingGridEquivalence + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4055T1PackingGridEquivalence (g : BandPackingSymmetry) : + ∃ f : GaussianInt ≃ GaussianInt, + (∀ z, f z = BandPackingSymmetryVectorAction g z) ∧ + (∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (f b = f a + 1 ∨ f b = f a - 1 ∨ + f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) ∧ + (∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (f.symm b = f.symm a + 1 ∨ f.symm b = f.symm a - 1 ∨ + f.symm b = f.symm a + ⟨0, 1⟩ ∨ f.symm b = f.symm a - ⟨0, 1⟩)) := by +-- BODY + have steps : ∀ g (a b : GaussianInt), + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a + 1 ∨ + BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a - 1 ∨ + BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a + ⟨0, 1⟩ ∨ + BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a - ⟨0, 1⟩) := by + intro h + induction h with + | identity => intro a b q; simpa [BandPackingSymmetryVectorAction] using q + | shift w => intro a b q; simpa [BandPackingSymmetryVectorAction] using q + | negate => + intro a b q + rcases q with q | q | q | q <;> subst b + · right; right; left; apply Zsqrtd.ext <;> + simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] + · right; right; right; apply Zsqrtd.ext <;> + simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] + · right; left; apply Zsqrtd.ext <;> + simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn]; omega + · left; apply Zsqrtd.ext <;> + simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn]; omega + | conjugate => + intro a b q + rcases q with q | q | q | q <;> subst b + · right; left; apply Zsqrtd.ext <;> + simp [BandPackingSymmetryVectorAction, GaussianReflection]; omega + · left; apply Zsqrtd.ext <;> + simp [BandPackingSymmetryVectorAction, GaussianReflection]; omega + · right; right; left; apply Zsqrtd.ext <;> + simp [BandPackingSymmetryVectorAction, GaussianReflection] + · right; right; right; apply Zsqrtd.ext <;> + simp [BandPackingSymmetryVectorAction, GaussianReflection] + | comp h k ih ihk => + intro a b q + simpa [BandPackingSymmetryVectorAction] using + ih _ _ (ihk a b q) + let inverseMap : BandPackingSymmetry → GaussianInt → GaussianInt := + BandPackingSymmetry.rec (motive := fun _ => GaussianInt → GaussianInt) + id (fun z => ⟨z.im, -z.re⟩) (fun z => ⟨-z.re, z.im⟩) + (fun _ => id) (fun _ _ ih ihk => ihk ∘ ih) + have inverseLeft : ∀ h z, + inverseMap h (BandPackingSymmetryVectorAction h z) = z := by + intro h + induction h with + | identity => intro z; unfold inverseMap; rfl + | shift w => intro z; unfold inverseMap; rfl + | negate => intro z; unfold inverseMap; apply Zsqrtd.ext <;> simp + [BandPackingSymmetryVectorAction, GaussianQuarterTurn] + | conjugate => intro z; unfold inverseMap; apply Zsqrtd.ext <;> simp + [BandPackingSymmetryVectorAction, GaussianReflection] + | comp h k ih ihk => + intro z + have map_comp : inverseMap (h.comp k) = inverseMap k ∘ inverseMap h := by rfl + rw [map_comp] + change inverseMap k (inverseMap h + (BandPackingSymmetryVectorAction h + (BandPackingSymmetryVectorAction k z))) = z + rw [ih, ihk] + have inverseRight : ∀ h z, + BandPackingSymmetryVectorAction h (inverseMap h z) = z := by + intro h + induction h with + | identity => intro z; unfold inverseMap; rfl + | shift w => intro z; unfold inverseMap; rfl + | negate => intro z; unfold inverseMap; apply Zsqrtd.ext <;> simp + [BandPackingSymmetryVectorAction, GaussianQuarterTurn] + | conjugate => intro z; unfold inverseMap; apply Zsqrtd.ext <;> simp + [BandPackingSymmetryVectorAction, GaussianReflection] + | comp h k ih ihk => + intro z + have map_comp : inverseMap (h.comp k) = inverseMap k ∘ inverseMap h := by rfl + rw [map_comp] + change BandPackingSymmetryVectorAction h + (BandPackingSymmetryVectorAction k (inverseMap k (inverseMap h z))) = z + rw [ihk, ih] + have inverseSteps : ∀ (sym : BandPackingSymmetry) (a b : GaussianInt), + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (inverseMap sym b = inverseMap sym a + 1 ∨ + inverseMap sym b = inverseMap sym a - 1 ∨ + inverseMap sym b = inverseMap sym a + ⟨0, 1⟩ ∨ + inverseMap sym b = inverseMap sym a - ⟨0, 1⟩) := by + intro sym + induction sym with + | identity => intro a b q; simpa [inverseMap] using q + | shift w => intro a b q; simpa [inverseMap] using q + | negate => + intro a b q + rcases q with q | q | q | q <;> subst b + · right; right; right; apply Zsqrtd.ext <;> + simp [inverseMap]; omega + · right; right; left; apply Zsqrtd.ext <;> + simp [inverseMap]; omega + · left; apply Zsqrtd.ext <;> + simp [inverseMap] + · right; left; apply Zsqrtd.ext <;> + simp [inverseMap] + | conjugate => + intro a b q + rcases q with q | q | q | q <;> subst b + · right; left; apply Zsqrtd.ext <;> simp [inverseMap]; omega + · left; apply Zsqrtd.ext <;> simp [inverseMap]; omega + · right; right; left; apply Zsqrtd.ext <;> simp [inverseMap] + · right; right; right; apply Zsqrtd.ext <;> simp [inverseMap] + | comp h k ih ihk => + intro a b q + simpa [inverseMap, Function.comp_def] using ihk _ _ (ih a b q) + let f : GaussianInt ≃ GaussianInt := + { toFun := BandPackingSymmetryVectorAction g + invFun := inverseMap g + left_inv := inverseLeft g + right_inv := inverseRight g } + exact ⟨f, fun _ => rfl, steps g, inverseSteps g⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean new file mode 100644 index 0000000000..b33cf5e37a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean @@ -0,0 +1,2232 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P4055T1PlacementNormalization] + +/-! +# P4055T1PlacementNormalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PlacementNormalizationProof + +private theorem hq : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), (ProperBandQuadruple r) → (∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ProperBandQuadruple q) ) := by + classical + intro r hproper a q + fin_cases a + · convert hproper using 1; funext x; fin_cases x <;> rfl + · have rotated := SemiProperQuadruple.rotate hproper.1 + have properRotated : ProperBandQuadruple ![r 0, r 2, r 3, r 1] := by + refine ⟨rotated, ?_⟩ + intro j + fin_cases j + · simpa using hproper.2 (1 : Fin 3) + · simpa using hproper.2 (2 : Fin 3) + · simpa using hproper.2 (0 : Fin 3) + simpa [q] using properRotated + · have rotated := SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate hproper.1) + have properRotated : ProperBandQuadruple ![r 0, r 3, r 1, r 2] := by + refine ⟨rotated, ?_⟩ + intro j + fin_cases j + · simpa using hproper.2 (2 : Fin 3) + · simpa using hproper.2 (0 : Fin 3) + · simpa using hproper.2 (1 : Fin 3) + simpa [q] using properRotated + +private theorem hU' : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (U : ProtoTile), (BandPrototile (r (0 : Fin (4 : + ℕ))) U) → (∀ (a : Fin 3), ∀ (g : BandPackingSymmetry), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), (BandPackingSymmetryReversesOrientation g' = + BandPackingSymmetryReversesOrientation g) → ( + let qg := BandPackingSymmetryQuadrupleAction g' q + ((∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction g' C).1 = C.1) ∧ (∀ (C : + CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T ↔ BandPrototile + (BandPackingSymmetryCircleAction g' C) (BandPackingSymmetryTileAction g' T)) ∧ ∀ (q : + Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ProperBandQuadruple q → BandPrototile (q (0 : Fin (4 : ℕ))) T → (∀ (i : + Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : + LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → + let sigma := fun (i : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g' = true + then -i else i; ∃ (negative : Bool) (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool) (S' + : Fin (3 : ℕ) → Bool → ProtoTile), BandPackingSymmetryScopedPhase g' q negative ∧ (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) + = (sigma i, s ^^ negative)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : + ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × + Bool) (i, s)).2 = BandPackingSymmetryTileAction g' (S i s)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction g' q) + (BandPackingSymmetryTileAction g' T) i s (S' i s)) ∧ ∀ (x : LatticeCell), x ∈ + (BandPackingSymmetryTileAction g' T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S' + i s).cells) → (BandPrototile (qg 0) (BandPackingSymmetryTileAction g' U)))) ) := by + classical + intro r U hU a g q g' horientg qg htileCov + simpa [qg, q, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, horientg] using + (htileCov.2.1 (r 0) U).mp hU + +private theorem hWlabel : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r i.succ) W) → ((BandPrototile (r + (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → + (((0 : ℤ) < (r i.succ).1) → (((0 : ℤ) < (r (if Even (↑s : ℕ) then i - (1 : Fin (3 : + ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → ((TileCentroid W - TileCentroid U = (1 / 2 + : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * + (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r i.succ)))) → ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 + (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - BandVectors.1 (r (i - (1 : + Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) else BandVectors.1 (r (i + (1 : Fin (3 : + ℕ))).succ) (r (0 : Fin (4 : ℕ))) - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : + Fin (3 : ℕ))).succ))) → (∀ (a : Fin 3), ∀ (g : BandPackingSymmetry), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + (ProperBandQuadruple q) → (∀ (negative : Bool), (BandPackingSymmetryScopedPhase g q + negative) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : + Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 + : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g r negative) → + ((∀ (t : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : + ℕ)) = q (2 : Fin (4 : ℕ)) → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → + BandPackingSymmetryScopedPhase g t negative) → (∀ (g' : BandPackingSymmetry), + (BandPackingSymmetryScopedPhase g' q false) → ((∀ (r : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) + → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : + ℕ)) → BandPackingSymmetryScopedPhase g' r false) → ((∀ (t : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) + → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g' t + false) → ( + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + (ProperBandQuadruple qg) → ((BandPrototile (qg 0) (BandPackingSymmetryTileAction g' U)) → + (qg k.succ = BandPackingSymmetryCircleAction g' (r i.succ)))))))))))))))) ) := by + classical + intro r i s U W Z hW hZ hWpos hZpos hWcent hZcent a g q hq negative hphase hphase1 hphase2 g' + hfalse hfalse1 hfalse2 qg k hproperG hU' + dsimp [qg, k, q, BandPackingSymmetryQuadrupleAction] + cases ho : BandPackingSymmetryReversesOrientation g' <;> + fin_cases a <;> fin_cases i <;> + simp [] + +private theorem cyclicIndex : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (U : ProtoTile), ∀ (a : Fin 3), ∀ (g + : BandPackingSymmetry), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + (ProperBandQuadruple q) → (∀ (negative : Bool), (BandPackingSymmetryScopedPhase g q + negative) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : + Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 + : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g r negative) → + ((∀ (t : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : + ℕ)) = q (2 : Fin (4 : ℕ)) → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → + BandPackingSymmetryScopedPhase g t negative) → (∀ (g' : BandPackingSymmetry), + (BandPackingSymmetryScopedPhase g' q false) → ((∀ (r : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) + → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : + ℕ)) → BandPackingSymmetryScopedPhase g' r false) → ((∀ (t : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) + → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g' t + false) → ( + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + (ProperBandQuadruple qg) → ((BandPrototile (qg 0) (BandPackingSymmetryTileAction g' U)) → + ((qg k.succ = BandPackingSymmetryCircleAction g' (r i.succ)) → (∀ (j₀ : Fin 3), q + j₀.succ = r (a + j₀).succ)))))))))) ) := by + classical + intro r i U a g q hq negative hphase hphase1 hphase2 g' hfalse hfalse1 hfalse2 qg k hproperG + hU' hWlabel j₀ + dsimp [q] + fin_cases a <;> fin_cases j₀ <;> rfl + +private theorem actionParent : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + ∀ (j₀ : Fin 3), qg j₀.succ = BandPackingSymmetryCircleAction g' (q ((if + BandPackingSymmetryReversesOrientation g' then -j₀ else j₀).succ)) ) := by + classical + intro r a q g' qg j₀ + cases ho : BandPackingSymmetryReversesOrientation g' <;> + fin_cases j₀ <;> + simp [qg, q, BandPackingSymmetryQuadrupleAction, ho, + ] + +private theorem hW' : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (W : ProtoTile), (BandPrototile (r + i.succ) W) → (∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + ((∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction g' C).1 = C.1) ∧ (∀ (C : + CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T ↔ BandPrototile + (BandPackingSymmetryCircleAction g' C) (BandPackingSymmetryTileAction g' T)) ∧ ∀ (q : + Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ProperBandQuadruple q → BandPrototile (q (0 : Fin (4 : ℕ))) T → (∀ (i : + Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : + LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → + let sigma := fun (i : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g' = true + then -i else i; ∃ (negative : Bool) (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool) (S' + : Fin (3 : ℕ) → Bool → ProtoTile), BandPackingSymmetryScopedPhase g' q negative ∧ (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) + = (sigma i, s ^^ negative)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : + ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × + Bool) (i, s)).2 = BandPackingSymmetryTileAction g' (S i s)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction g' q) + (BandPackingSymmetryTileAction g' T) i s (S' i s)) ∧ ∀ (x : LatticeCell), x ∈ + (BandPackingSymmetryTileAction g' T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S' + i s).cells) → ((qg k.succ = BandPackingSymmetryCircleAction g' (r i.succ)) → + (BandPrototile (qg k.succ) (BandPackingSymmetryTileAction g' W)))) ) := by + classical + intro r i W hW a q g' qg k htileCov hWlabel + rw [hWlabel] + exact (htileCov.2.1 (r i.succ) W).mp hW + +private theorem hparent : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + (∀ (j₀ : Fin 3), q j₀.succ = r (a + j₀).succ) → ((∀ (j₀ : Fin 3), qg j₀.succ = + BandPackingSymmetryCircleAction g' (q ((if BandPackingSymmetryReversesOrientation g' + then -j₀ else j₀).succ))) → ( + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + ∀ (m : Fin 3), qg (sigma m).succ = BandPackingSymmetryCircleAction g' (r (a + m).succ))) + ) := by + classical + intro r a q g' qg cyclicIndex actionParent sigma m + rw [actionParent] + cases ho : BandPackingSymmetryReversesOrientation g' <;> + simp [sigma, ho, cyclicIndex] + +private theorem hparentAction : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + (∀ (m : Fin 3), qg (sigma m).succ = BandPackingSymmetryCircleAction g' (r (a + m).succ)) + → (∀ (m : Fin 3), BandPackingSymmetryQuadrupleAction g' q (if + BandPackingSymmetryReversesOrientation g' then -m else m).succ = + BandPackingSymmetryCircleAction g' (r (a + m).succ)) ) := by + classical + intro r a q g' qg sigma hparent m + simpa [qg, sigma] using hparent m + +private theorem hrootAction : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + (qg 0 = BandPackingSymmetryCircleAction g' (r 0)) → (BandPackingSymmetryQuadrupleAction + g' q 0 = BandPackingSymmetryCircleAction g' (r 0)) ) := by + classical + intro r a q g' qg hrootLabel + simpa [qg] using hrootLabel + +private theorem hphaseForward : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), (BandPackingSymmetryScopedPhase g' q false) → ( + let qg := BandPackingSymmetryQuadrupleAction g' q + (∀ (j₀ : Fin 3), q j₀.succ = r (a + j₀).succ) → ((qg 0 = BandPackingSymmetryCircleAction + g' (r 0)) → ( + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + (∀ (m : Fin 3), qg (sigma m).succ = BandPackingSymmetryCircleAction g' (r (a + m).succ)) + → ((∀ (m : Fin 3), BandPackingSymmetryQuadrupleAction g' q (if + BandPackingSymmetryReversesOrientation g' then -m else m).succ = + BandPackingSymmetryCircleAction g' (r (a + m).succ)) → + ((BandPackingSymmetryQuadrupleAction g' q 0 = BandPackingSymmetryCircleAction g' (r + 0)) → (∀ (m : Fin 3), BandVectors.1 (qg (sigma m).succ) (qg 0) = + BandPackingSymmetryVectorAction g' (BandVectors.1 (r (a + m).succ) (r 0)))))))) ) := by + classical + intro r a q g' hfalse qg cyclicIndex hrootLabel sigma hparent hparentAction hrootAction m + have hp := (hfalse m).1 + dsimp [BandPackingSymmetryScopedPhase] at hp + rw [hparentAction m, hrootAction, cyclicIndex m] at hp + rw [hparent m, hrootLabel] + simpa [q] using hp + +private theorem hphaseBackward : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), (BandPackingSymmetryScopedPhase g' q false) → ( + let qg := BandPackingSymmetryQuadrupleAction g' q + (∀ (j₀ : Fin 3), q j₀.succ = r (a + j₀).succ) → ((qg 0 = BandPackingSymmetryCircleAction + g' (r 0)) → ( + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + (∀ (m : Fin 3), qg (sigma m).succ = BandPackingSymmetryCircleAction g' (r (a + m).succ)) + → ((∀ (m : Fin 3), BandPackingSymmetryQuadrupleAction g' q (if + BandPackingSymmetryReversesOrientation g' then -m else m).succ = + BandPackingSymmetryCircleAction g' (r (a + m).succ)) → + ((BandPackingSymmetryQuadrupleAction g' q 0 = BandPackingSymmetryCircleAction g' (r + 0)) → (∀ (m : Fin 3), BandVectors.1 (qg 0) (qg (sigma m).succ) = (if + BandPackingSymmetryReversesOrientation g' then -BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r (a + m).succ)) else BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r (a + m).succ))))))))) ) := by + classical + intro r a q g' hfalse qg cyclicIndex hrootLabel sigma hparent hparentAction hrootAction m + have hp := (hfalse m).2.1 + dsimp [BandPackingSymmetryScopedPhase] at hp + rw [hparentAction m, hrootAction, cyclicIndex m] at hp + rw [hparent m, hrootLabel] + simpa [q] using hp + +private theorem hvectorForward : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + (∀ (x : Fin 3), ∀ (y : Fin 3), x + (y - x) = y) → ( + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + (∀ (m : Fin 3), BandVectors.1 (qg (sigma m).succ) (qg 0) = + BandPackingSymmetryVectorAction g' (BandVectors.1 (r (a + m).succ) (r 0))) → ((sigma + (i - a) = k) → (BandVectors.1 (qg k.succ) (qg 0) = BandPackingSymmetryVectorAction g' + (BandVectors.1 (r i.succ) (r 0))))) ) := by + classical + intro r i a q g' qg k cyclicCancel sigma hphaseForward hk + simpa [hk, cyclicCancel] using hphaseForward (i - a) + +private theorem hvectorBackward : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + (∀ (x : Fin 3), ∀ (y : Fin 3), x + (y - x) = y) → ( + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + (∀ (m : Fin 3), BandVectors.1 (qg 0) (qg (sigma m).succ) = (if + BandPackingSymmetryReversesOrientation g' then -BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r (a + m).succ)) else BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r (a + m).succ)))) → ((sigma (i - a) = k) → (BandVectors.1 (qg + 0) (qg k.succ) = (if BandPackingSymmetryReversesOrientation g' then + -BandPackingSymmetryVectorAction g' (BandVectors.1 (r 0) (r i.succ)) else + BandPackingSymmetryVectorAction g' (BandVectors.1 (r 0) (r i.succ)))))) ) := by + classical + intro r i a q g' qg k cyclicCancel sigma hphaseBackward hk + simpa [hk, cyclicCancel] using hphaseBackward (i - a) + +private theorem notEvenOne : + (by + classical + exact + (Fin 4 → CircleCoordinates) → ((Fin 3) → ((Fin 4) → ((Fin 3) → ((BandPackingSymmetry) → + (¬ Even 1))))) ) := by + classical + intro r i s a g' + rintro ⟨n, hn⟩ + omega + +private theorem notEvenThree : + (by + classical + exact + (Fin 4 → CircleCoordinates) → ((Fin 3) → ((Fin 4) → ((Fin 3) → ((BandPackingSymmetry) → + (¬ Even 3))))) ) := by + classical + intro r i s a g' + rintro ⟨n, hn⟩ + omega + +private theorem hnegVal : + (by + classical + exact + ∀ (s₀ : Fin 4), ((-s₀ - 1 : Fin 4) : Nat) = (3 - s₀.val) % 4 ) := by + classical + intro s₀ + fin_cases s₀ <;> decide +kernel + +private theorem iiCancel : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (ii ^ 2 = -1) → (∀ (x : GaussianInt), ii * x - ii ^ 2 * x = ii * x + x) ) := by + classical + intro ii iiSq x + rw [iiSq] + ring + +private theorem iiCancelLiteral : + (by + classical + exact + ((⟨0, 1⟩ : GaussianInt) ^ 2 = -1) → (∀ (x : GaussianInt), (⟨0, 1⟩ : GaussianInt) * x - + (⟨0, 1⟩ : GaussianInt) ^ 2 * x = (⟨0, 1⟩ : GaussianInt) * x + x) ) := by + classical + intro iiSqLiteral x + rw [iiSqLiteral] + ring + +private theorem iiSquareMul : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (ii * ii = -1) → (∀ (x : GaussianInt), ii * (ii * x) = -x) ) := by + classical + intro ii iiMul x + rw [← mul_assoc, iiMul] + simp + +private theorem iiNegSquareMul : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (∀ (x : GaussianInt), ii * (ii * x) = -x) → (∀ (x : GaussianInt), (-ii) * (ii * x) = x) ) + := by + classical + intro ii iiSquareMul x + calc + (-ii) * (ii * x) = -(ii * (ii * x)) := by rw [neg_mul] + _ = -(-x) := by rw [iiSquareMul] + _ = x := by simp + +private theorem iiCaseA : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (ii ^ 2 = -1) → (∀ (x : GaussianInt), -(ii * x) + x = -(ii * x) - ii ^ 2 * x) ) := by + classical + intro ii iiSq x + rw [iiSq] + ring + +private theorem iiCaseB : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (ii ^ 2 = -1) → (∀ (x : GaussianInt), -(ii * x) + ii ^ 2 * x = -(ii * x) - x) ) := by + classical + intro ii iiSq x + rw [iiSq] + ring + +private theorem iiCaseC : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (ii ^ 2 = -1) → (∀ (x : GaussianInt), -x + x * ii = x * ii + x * ii ^ 2) ) := by + classical + intro ii iiSq x + rw [iiSq] + ring + +private theorem iiCaseA' : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (∀ (x : GaussianInt), (-ii) * (ii * x) = x) → (∀ (x : GaussianInt), x - ii * x = -ii * (x + + ii * x)) ) := by + classical + intro ii iiNegSquareMul x + rw [mul_add, neg_mul, iiNegSquareMul] + ring + +private theorem iiCaseB' : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (∀ (x : GaussianInt), (-ii) * (ii * x) = x) → (∀ (x : GaussianInt), -ii * (x - ii * x) = + -(x + ii * x)) ) := by + classical + intro ii iiNegSquareMul x + rw [mul_sub, neg_mul, iiNegSquareMul, neg_add] + ring + +private theorem iiCaseC' : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (∀ (x : GaussianInt), ii * (ii * x) = -x) → (∀ (x : GaussianInt), -(x - ii * x) = ii * (x + + ii * x)) ) := by + classical + intro ii iiSquareMul x + rw [neg_sub, mul_add, iiSquareMul] + ring + +private theorem iiCaseD' : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (∀ (x : GaussianInt), ii * (ii * x) = -x) → (∀ (x : GaussianInt), ii * (x - ii * x) = x + + ii * x) ) := by + classical + intro ii iiSquareMul x + rw [mul_sub, iiSquareMul] + ring + +private theorem iiCaseE : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (ii ^ 2 = -1) → (∀ (x : GaussianInt), ii * x + ii ^ 2 * x = ii * x - x) ) := by + classical + intro ii iiSq x + rw [iiSq] + ring + +private theorem iiZCaseA : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (∀ (x : GaussianInt), (-ii) * (ii * x) = x) → (∀ (x : GaussianInt), -(ii * x) - x = -ii * + (x - ii * x)) ) := by + classical + intro ii iiNegSquareMul x + rw [mul_sub, neg_mul, iiNegSquareMul] + +private theorem iiZCaseB : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (∀ (x : GaussianInt), (-ii) * (ii * x) = x) → (∀ (x : GaussianInt), -ii * (x + ii * x) = + -1 * (ii * x - x)) ) := by + classical + intro ii iiNegSquareMul x + rw [mul_add, neg_mul, iiNegSquareMul] + simp only [neg_one_mul, neg_sub] + ring + +private theorem iiZCaseC : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (∀ (x : GaussianInt), ii * (ii * x) = -x) → (∀ (x : GaussianInt), -(-(ii * x) - x) = ii * + (x - ii * x)) ) := by + classical + intro ii iiSquareMul x + simp only [neg_sub, mul_sub, iiSquareMul] + ring + +private theorem iiZCaseD : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (∀ (x : GaussianInt), ii * (ii * x) = -x) → (∀ (x : GaussianInt), ii * (x + ii * x) = ii + * x - x) ) := by + classical + intro ii iiSquareMul x + rw [mul_add, iiSquareMul] + ring + +private theorem iiCube : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (ii ^ 2 = -1) → (ii ^ 3 = -ii) ) := by + classical + intro ii iiSq + rw [pow_succ, iiSq] + simp + +private theorem iiFourth : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (ii * ii = -1) → ((ii ^ 3 = -ii) → (ii ^ 4 = 1)) ) := by + classical + intro ii iiMul iiCube + rw [show 4 = 3 + 1 by rfl, pow_succ, iiCube] + calc + -ii * ii = -(ii * ii) := by ring + _ = -(-1) := by rw [iiMul] + _ = 1 := by norm_num + +private theorem negIiSq : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (ii * ii = -1) → ((-ii) ^ 2 = -1) ) := by + classical + intro ii iiMul + rw [pow_two] + calc + (-ii) * (-ii) = ii * ii := by ring + _ = -1 := iiMul + +private theorem negIiCube : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + ((-ii) ^ 2 = -1) → ((-ii) ^ 3 = ii) ) := by + classical + intro ii negIiSq + rw [show 3 = 2 + 1 by rfl, pow_succ, negIiSq] + simp + +private theorem ladd : + (by + classical + exact + ∀ (g₀ : BandPackingSymmetry), ∀ (x : GaussianInt), ∀ (y : GaussianInt), + BandPackingSymmetryVectorAction g₀ (x + y) = BandPackingSymmetryVectorAction g₀ x + + BandPackingSymmetryVectorAction g₀ y ) := by + classical + intro g₀ x y + induction g₀ generalizing x y with + | identity => rfl + | negate => ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn]; abel + | conjugate => ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection]; abel + | shift w => rfl + | comp g₁ g₂ ih₁ ih₂ => + simp [BandPackingSymmetryVectorAction, ih₁, ih₂] + +private theorem lneg : + (by + classical + exact + ∀ (g₀ : BandPackingSymmetry), ∀ (x : GaussianInt), BandPackingSymmetryVectorAction g₀ + (-x) = -BandPackingSymmetryVectorAction g₀ x ) := by + classical + intro g₀ x + induction g₀ generalizing x with + | identity => rfl + | negate => ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] + | conjugate => ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] + | shift w => rfl + | comp g₁ g₂ ih₁ ih₂ => simp [BandPackingSymmetryVectorAction, ih₁, ih₂] + +private theorem lquarter : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (∀ (g₀ : BandPackingSymmetry), ∀ (x : GaussianInt), BandPackingSymmetryVectorAction g₀ + (-x) = -BandPackingSymmetryVectorAction g₀ x) → (∀ (g₀ : BandPackingSymmetry), ∀ (x : + GaussianInt), BandPackingSymmetryVectorAction g₀ (ii * x) = if + BandPackingSymmetryReversesOrientation g₀ then -ii * BandPackingSymmetryVectorAction + g₀ x else ii * BandPackingSymmetryVectorAction g₀ x) ) := by + classical + intro ii lneg g₀ x + induction g₀ generalizing x with + | identity => simp [BandPackingSymmetryVectorAction, + BandPackingSymmetryReversesOrientation, ii] + | negate => ext <;> simp [BandPackingSymmetryVectorAction, + BandPackingSymmetryReversesOrientation, GaussianQuarterTurn, ii] + | conjugate => + ext <;> simp [BandPackingSymmetryVectorAction, + BandPackingSymmetryReversesOrientation, GaussianReflection, + ii] + | shift w => rfl + | comp g₁ g₂ ih₁ ih₂ => + change BandPackingSymmetryVectorAction g₁ + (BandPackingSymmetryVectorAction g₂ (ii * x)) = + if xor (BandPackingSymmetryReversesOrientation g₁) + (BandPackingSymmetryReversesOrientation g₂) then + -ii * BandPackingSymmetryVectorAction g₁ + (BandPackingSymmetryVectorAction g₂ x) + else ii * BandPackingSymmetryVectorAction g₁ + (BandPackingSymmetryVectorAction g₂ x) + rw [ih₂] + cases h₁ : BandPackingSymmetryReversesOrientation g₁ <;> + cases h₂ : BandPackingSymmetryReversesOrientation g₂ <;> + simp [h₁, + ih₁, lneg] + +private theorem lpow : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (∀ (g₀ : BandPackingSymmetry), ∀ (x : GaussianInt), BandPackingSymmetryVectorAction g₀ + (ii * x) = if BandPackingSymmetryReversesOrientation g₀ then -ii * + BandPackingSymmetryVectorAction g₀ x else ii * BandPackingSymmetryVectorAction g₀ x) + → (∀ (g₀ : BandPackingSymmetry), ∀ (n : Nat), ∀ (x : GaussianInt), + BandPackingSymmetryVectorAction g₀ (ii ^ n * x) = (if + BandPackingSymmetryReversesOrientation g₀ then (-ii) ^ n else ii ^ n) * + BandPackingSymmetryVectorAction g₀ x) ) := by + classical + intro ii lquarter g₀ n x + induction n with + | zero => simp + | succ n ih => + rw [pow_succ', mul_assoc, lquarter, ih] + by_cases ho : BandPackingSymmetryReversesOrientation g₀ <;> + simp [ho, pow_succ, mul_assoc]; ring + +private theorem hbackEqual : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + (BandVectors.1 (qg k.succ) (qg 0) = BandPackingSymmetryVectorAction g' (BandVectors.1 (r + i.succ) (r 0))) → ((BandVectors.1 (qg 0) (qg k.succ) = (if + BandPackingSymmetryReversesOrientation g' then -BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r i.succ)) else BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r i.succ)))) → ( + let ii : GaussianInt := ⟨0, 1⟩ + (∀ (g₀ : BandPackingSymmetry), ∀ (x : GaussianInt), BandPackingSymmetryVectorAction g₀ + (ii * x) = if BandPackingSymmetryReversesOrientation g₀ then -ii * + BandPackingSymmetryVectorAction g₀ x else ii * BandPackingSymmetryVectorAction g₀ x) + → ((BandVectors.1 (r 0) (r i.succ) = ii * BandVectors.1 (r i.succ) (r 0)) → + (BandVectors.1 (qg 0) (qg k.succ) = ii * BandVectors.1 (qg k.succ) (qg 0))))) ) := by + classical + intro r i a q g' qg k hvectorForward hvectorBackward ii lquarter hflip + rw [hvectorBackward, hvectorForward, hflip] + cases ho : BandPackingSymmetryReversesOrientation g' <;> + simp [ho, lquarter, ii] + +private theorem hdispW : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if Even (↑s : ℕ) then i - (1 : + Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < (r (if Even (↑s : ℕ) + then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → ((TileCentroid W - + TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : + Fin (4 : ℕ))) (r i.succ)))) → ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) + then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - + BandVectors.1 (r (i - (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) else + BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - BandVectors.1 + (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : ℕ))).succ))) → (∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + (BandVectors.1 (qg k.succ) (qg 0) = BandPackingSymmetryVectorAction g' (BandVectors.1 (r + i.succ) (r 0))) → ((BandVectors.1 (qg 0) (qg k.succ) = (if + BandPackingSymmetryReversesOrientation g' then -BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r i.succ)) else BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r i.succ)))) → ((∀ (s₀ : Fin 4), ((-s₀ - 1 : Fin 4) : Nat) = (3 + - s₀.val) % 4) → ( + let ii : GaussianInt := ⟨0, 1⟩ + (ii ^ 2 = -1) → ((∀ (x : GaussianInt), x - ii * x = -ii * (x + ii * x)) → ((∀ (x : + GaussianInt), -ii * (x - ii * x) = -(x + ii * x)) → ((∀ (x : GaussianInt), -(x - ii * + x) = ii * (x + ii * x)) → ((∀ (x : GaussianInt), ii * (x - ii * x) = x + ii * x) → + ((ii ^ 3 = -ii) → (((-ii) ^ 2 = -1) → (((-ii) ^ 3 = ii) → ((∀ (g₀ : + BandPackingSymmetry), ∀ (x : GaussianInt), ∀ (y : GaussianInt), + BandPackingSymmetryVectorAction g₀ (x + y) = BandPackingSymmetryVectorAction g₀ x + + BandPackingSymmetryVectorAction g₀ y) → ((∀ (g₀ : BandPackingSymmetry), ∀ (n : Nat), + ∀ (x : GaussianInt), BandPackingSymmetryVectorAction g₀ (ii ^ n * x) = (if + BandPackingSymmetryReversesOrientation g₀ then (-ii) ^ n else ii ^ n) * + BandPackingSymmetryVectorAction g₀ x) → ( + let vR := BandVectors.1 (r i.succ) (r 0) + let vL := BandVectors.1 (r 0) (r i.succ) + let vR' := BandVectors.1 (qg k.succ) (qg 0) + let vL' := BandVectors.1 (qg 0) (qg k.succ) + (vL' = ii * vR') → ( + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + BandPackingSymmetryVectorAction g' (ii ^ s.val * (vR + vL)) = ii ^ t.val * (vR' + + vL'))))))))))))))))))) ) := by + classical + intro r i s U W Z hZ hZpos hWcent hZcent a q g' qg k hvectorForward hvectorBackward hnegVal ii + iiSq iiCaseA' iiCaseB' iiCaseC' iiCaseD' iiCube negIiSq negIiCube ladd lpow vR vL vR' vL' + hbackEq' t + have hvecR : BandPackingSymmetryVectorAction g' vR = vR' := by + simpa [vR, vR'] using hvectorForward.symm + have hvecL : BandPackingSymmetryVectorAction g' vL = + if BandPackingSymmetryReversesOrientation g' then -vL' else vL' := by + cases ho : BandPackingSymmetryReversesOrientation g' + · have hb := hvectorBackward + simp [ho] at hb + exact hb.symm + · have hb := hvectorBackward + simp [ho] at hb + have hn := congrArg (fun z : GaussianInt => -z) hb.symm + simpa using hn + have hsum : BandPackingSymmetryVectorAction g' (vR + vL) = + if BandPackingSymmetryReversesOrientation g' then vR' - vL' + else vR' + vL' := by + rw [ladd, hvecR, hvecL] + cases BandPackingSymmetryReversesOrientation g' <;> simp; abel + rw [lpow, hsum] + cases ho : BandPackingSymmetryReversesOrientation g' <;> + fin_cases s <;> + simp only [t, ho, hbackEq', hnegVal, ↓reduceIte, + Bool.false_eq_true] <;> + (try rw [iiSq]) <;> + (try simp only [Nat.reduceSub, Nat.reduceMod]) <;> + (try simp only [iiCube, negIiSq, negIiCube, + pow_zero, pow_one, one_mul, neg_one_mul]) + all_goals first + | exact iiCaseA' vR' + | exact iiCaseB' vR' + | exact iiCaseC' vR' + | exact iiCaseD' vR' + + + + + +private theorem quarterParity : + (by + classical + exact + (Even 0) → ((Even 2) → ((¬ Even 1) → ((¬ Even 3) → (∀ (s₀ : Fin 4), Even ((-s₀ - 1).val) + ↔ ¬ Even s₀.val)))) ) := by + classical + intro evenZero evenTwo notEvenOne notEvenThree s₀ + fin_cases s₀ + · change Even 3 ↔ ¬ Even 0 + exact ⟨fun h _ => (notEvenThree h).elim, fun h => (h evenZero).elim⟩ + · change Even 2 ↔ ¬ Even 1 + exact ⟨fun _ => notEvenOne, fun _ => evenTwo⟩ + · change Even 1 ↔ ¬ Even 2 + exact ⟨fun h => (notEvenOne h).elim, fun h => (h evenTwo).elim⟩ + · change Even 0 ↔ ¬ Even 3 + exact ⟨fun _ => notEvenThree, fun _ => evenZero⟩ + +private theorem reversedAdjacent : + (by + classical + exact + (∀ (s₀ : Fin 4), Even ((-s₀ - 1).val) ↔ ¬ Even s₀.val) → (∀ (a₀ : Fin 3), ∀ (i₀ : Fin 3), + ∀ (s₀ : Fin 4), (if Even ((-s₀ - 1).val) then -(i₀ - a₀) - 1 else -(i₀ - a₀) + 1) = + -((if Even s₀.val then i₀ - 1 else i₀ + 1) - a₀)) ) := by + classical + intro quarterParity a₀ i₀ s₀ + have hp := quarterParity s₀ + by_cases h : Even s₀.val + · have hn : ¬ Even (-s₀ - 1).val := by + intro ht + exact (hp.mp ht) h + simp? [h, hn]; fin_cases a₀ <;> fin_cases i₀ <;> decide +kernel + · have he : Even (-s₀ - 1).val := hp.mpr h + simp? [h, he]; fin_cases a₀ <;> fin_cases i₀ <;> decide +kernel + +private theorem normalizedAdjacent : + (by + classical + exact + (∀ (a₀ : Fin 3), ∀ (i₀ : Fin 3), ∀ (s₀ : Fin 4), (if Even ((-s₀ - 1).val) then -(i₀ - a₀) + - 1 else -(i₀ - a₀) + 1) = -((if Even s₀.val then i₀ - 1 else i₀ + 1) - a₀)) → (∀ + (rev : Bool), ∀ (a₀ : Fin 3), ∀ (i₀ : Fin 3), ∀ (s₀ : Fin 4), + let k₀ := if rev then -(i₀ - a₀) else i₀ - a₀ + let t₀ := if rev then -s₀ - 1 else s₀ + (if Even t₀.val then k₀ - 1 else k₀ + 1) = + if rev then -((if Even s₀.val then i₀ - 1 else i₀ + 1) - a₀) + else (if Even s₀.val then i₀ - 1 else i₀ + 1) - a₀) ) := by + classical + intro reversedAdjacent rev a₀ i₀ s₀ + cases rev + · simp only [Bool.false_eq_true, ↓reduceIte] + by_cases h : Even s₀.val + · simp? [h]; fin_cases a₀ <;> fin_cases i₀ <;> + fin_cases s₀ <;> decide +kernel + · simp? [h]; fin_cases a₀ <;> fin_cases i₀ <;> + fin_cases s₀ <;> decide +kernel + · simp only [↓reduceIte] + exact reversedAdjacent a₀ i₀ s₀ + +private theorem hZindex : + (by + classical + exact + ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin 3), ∀ (g' : BandPackingSymmetry), + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + (∀ (rev : Bool), ∀ (a₀ : Fin 3), ∀ (i₀ : Fin 3), ∀ (s₀ : Fin 4), + let k₀ := if rev then -(i₀ - a₀) else i₀ - a₀ + let t₀ := if rev then -s₀ - 1 else s₀ + (if Even t₀.val then k₀ - 1 else k₀ + 1) = + if rev then -((if Even s₀.val then i₀ - 1 else i₀ + 1) - a₀) + else (if Even s₀.val then i₀ - 1 else i₀ + 1) - a₀) → ((if Even t.val then k - 1 else + k + 1) = if BandPackingSymmetryReversesOrientation g' then -((if Even s.val then + i - 1 else i + 1) - a) else (if Even s.val then i - 1 else i + 1) - a) ) := by + classical + intro i s a g' k t normalizedAdjacent + exact normalizedAdjacent (BandPackingSymmetryReversesOrientation g') a i s + +private theorem hZparentIndex : + (by + classical + exact + ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin 3), ∀ (g' : BandPackingSymmetry), + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + ((if Even t.val then k - 1 else k + 1) = if BandPackingSymmetryReversesOrientation g' + then -((if Even s.val then i - 1 else i + 1) - a) else (if Even s.val then i - 1 else + i + 1) - a) → ( + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + (if BandPackingSymmetryReversesOrientation g' then -j else j) = (if Even s.val then i - 1 + else i + 1) - a) ) := by + classical + intro i s a g' k t hZindex j + cases ho : BandPackingSymmetryReversesOrientation g' + · simpa [j, ho] using hZindex + · have hneg := congrArg (fun x : Fin 3 => -x) hZindex + simpa [j, ho] using hneg + +private theorem hZcircle : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + (∀ (j₀ : Fin 3), q j₀.succ = r (a + j₀).succ) → ((∀ (x : Fin 3), ∀ (y : Fin 3), x + (y - + x) = y) → ( + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + ((if BandPackingSymmetryReversesOrientation g' then -j else j) = (if Even s.val then i - + 1 else i + 1) - a) → (q ((if BandPackingSymmetryReversesOrientation g' then -j else + j).succ) = r ((if Even s.val then i - 1 else i + 1).succ)))) ) := by + classical + intro r i s a q g' k cyclicIndex cyclicCancel t j hZparentIndex + rw [hZparentIndex, cyclicIndex, cyclicCancel] + +private theorem hZlabel : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + (∀ (j₀ : Fin 3), qg j₀.succ = BandPackingSymmetryCircleAction g' (q ((if + BandPackingSymmetryReversesOrientation g' then -j₀ else j₀).succ))) → ( + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + (q ((if BandPackingSymmetryReversesOrientation g' then -j else j).succ) = r ((if Even + s.val then i - 1 else i + 1).succ)) → (qg j.succ = BandPackingSymmetryCircleAction g' + (r ((if Even s.val then i - 1 else i + 1).succ)))) ) := by + classical + intro r i s a q g' qg k actionParent t j hZcircle + rw [actionParent] + rw [hZcircle] + +private theorem hZrel : + (by + classical + exact + ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin 3), ∀ (g' : BandPackingSymmetry), + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + ((if BandPackingSymmetryReversesOrientation g' then -j else j) = (if Even s.val then i - + 1 else i + 1) - a) → ( + let adj : Fin 3 := if Even s.val then i - 1 else i + 1 + let mZ : Fin 3 := adj - a + (if BandPackingSymmetryReversesOrientation g' then -j else j) = mZ) ) := by + classical + intro i s a g' k t j hZparentIndex adj mZ + simpa [mZ, adj] using hZparentIndex + +private theorem hZsigma : + (by + classical + exact + ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin 3), ∀ (g' : BandPackingSymmetry), + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + let adj : Fin 3 := if Even s.val then i - 1 else i + 1 + let mZ : Fin 3 := adj - a + ((if BandPackingSymmetryReversesOrientation g' then -j else j) = mZ) → ((if + BandPackingSymmetryReversesOrientation g' then -mZ else mZ) = j) ) := by + classical + intro i s a g' k t j adj mZ hZrel + cases ho : BandPackingSymmetryReversesOrientation g' + · simpa [ho] using hZrel.symm + · have hn := congrArg (fun x : Fin 3 => -x) hZrel + have h' : j = -mZ := by simpa [ho] using hn + exact h'.symm + +private theorem hZphaseForward : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + (∀ (x : Fin 3), ∀ (y : Fin 3), x + (y - x) = y) → ( + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + (∀ (m : Fin 3), BandVectors.1 (qg (sigma m).succ) (qg 0) = + BandPackingSymmetryVectorAction g' (BandVectors.1 (r (a + m).succ) (r 0))) → ( + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + let adj : Fin 3 := if Even s.val then i - 1 else i + 1 + let mZ : Fin 3 := adj - a + (sigma mZ = j) → (BandVectors.1 (qg j.succ) (qg 0) = BandPackingSymmetryVectorAction g' + (BandVectors.1 (r adj.succ) (r 0))))) ) := by + classical + intro r i s a q g' qg k cyclicCancel sigma hphaseForward t j adj mZ hZsigma' + have h := hphaseForward mZ + rw [hZsigma', show a + mZ = adj from cyclicCancel a adj] at h + exact h + +private theorem hZphaseBackward : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + (∀ (x : Fin 3), ∀ (y : Fin 3), x + (y - x) = y) → ( + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + (∀ (m : Fin 3), BandVectors.1 (qg 0) (qg (sigma m).succ) = (if + BandPackingSymmetryReversesOrientation g' then -BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r (a + m).succ)) else BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r (a + m).succ)))) → ( + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + let adj : Fin 3 := if Even s.val then i - 1 else i + 1 + let mZ : Fin 3 := adj - a + (sigma mZ = j) → (BandVectors.1 (qg 0) (qg j.succ) = if + BandPackingSymmetryReversesOrientation g' then -BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r adj.succ)) else BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r adj.succ))))) ) := by + classical + intro r i s a q g' qg k cyclicCancel sigma hphaseBackward t j adj mZ hZsigma' + have h := hphaseBackward mZ + rw [hZsigma', show a + mZ = adj from cyclicCancel a adj] at h + exact h + +private theorem hZactionForward : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + let adj : Fin 3 := if Even s.val then i - 1 else i + 1 + (BandVectors.1 (qg j.succ) (qg 0) = BandPackingSymmetryVectorAction g' (BandVectors.1 (r + adj.succ) (r 0))) → ( + let xZ := BandVectors.1 (r adj.succ) (r 0) + let xZ' := BandVectors.1 (qg j.succ) (qg 0) + BandPackingSymmetryVectorAction g' xZ = xZ') ) := by + classical + intro r i s a q g' qg k t j adj hZphaseForward xZ xZ' + simpa [xZ, xZ'] using hZphaseForward.symm + +private theorem hZactionBackward : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + let adj : Fin 3 := if Even s.val then i - 1 else i + 1 + (BandVectors.1 (qg 0) (qg j.succ) = if BandPackingSymmetryReversesOrientation g' then + -BandPackingSymmetryVectorAction g' (BandVectors.1 (r 0) (r adj.succ)) else + BandPackingSymmetryVectorAction g' (BandVectors.1 (r 0) (r adj.succ))) → ( + let yZ := BandVectors.1 (r 0) (r adj.succ) + let yZ' := BandVectors.1 (qg 0) (qg j.succ) + BandPackingSymmetryVectorAction g' yZ = if BandPackingSymmetryReversesOrientation g' then + -yZ' else yZ') ) := by + classical + intro r i s a q g' qg k t j adj hZphaseBackward yZ yZ' + cases ho : BandPackingSymmetryReversesOrientation g' + · have hb := hZphaseBackward + simp [ho] at hb + exact hb.symm + · have hb := hZphaseBackward + simp [ho] at hb + have hn := congrArg (fun z : GaussianInt => -z) hb.symm + simpa using hn + +private theorem hZsourceAction : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + (∀ (g₀ : BandPackingSymmetry), ∀ (x : GaussianInt), ∀ (y : GaussianInt), + BandPackingSymmetryVectorAction g₀ (x + y) = BandPackingSymmetryVectorAction g₀ x + + BandPackingSymmetryVectorAction g₀ y) → ((∀ (g₀ : BandPackingSymmetry), ∀ (x : + GaussianInt), BandPackingSymmetryVectorAction g₀ (-x) = + -BandPackingSymmetryVectorAction g₀ x) → ( + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + let adj : Fin 3 := if Even s.val then i - 1 else i + 1 + let xZ := BandVectors.1 (r adj.succ) (r 0) + let yZ := BandVectors.1 (r 0) (r adj.succ) + let xZ' := BandVectors.1 (qg j.succ) (qg 0) + let yZ' := BandVectors.1 (qg 0) (qg j.succ) + (BandPackingSymmetryVectorAction g' xZ = xZ') → ((BandPackingSymmetryVectorAction g' yZ = + if BandPackingSymmetryReversesOrientation g' then -yZ' else yZ') → + (BandPackingSymmetryVectorAction g' (if Even s.val then yZ - xZ else xZ - yZ) = if + Even s.val then (if BandPackingSymmetryReversesOrientation g' then -yZ' - xZ' else + yZ' - xZ') else (if BandPackingSymmetryReversesOrientation g' then xZ' + yZ' else xZ' + - yZ'))))) ) := by + classical + intro r i s a q g' qg k ladd lneg t j adj xZ yZ xZ' yZ' hZactionForward hZactionBackward + by_cases he : Even s.val <;> + cases ho : BandPackingSymmetryReversesOrientation g' <;> + simp [he, ho, sub_eq_add_neg, ladd, lneg, + hZactionForward, hZactionBackward] + +private theorem hZvec : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if Even (↑s : ℕ) then i - (1 : + Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < (r (if Even (↑s : ℕ) + then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → ((TileCentroid W - + TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : + Fin (4 : ℕ))) (r i.succ)))) → ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) + then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - + BandVectors.1 (r (i - (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) else + BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - BandVectors.1 + (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : ℕ))).succ))) → (∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + (Even 0) → ((Even 2) → ((¬ Even 1) → ((¬ Even 3) → ((∀ (s₀ : Fin 4), ((-s₀ - 1 : Fin 4) : + Nat) = (3 - s₀.val) % 4) → ( + let ii : GaussianInt := ⟨0, 1⟩ + (ii * ii = -1) → ((∀ (x : GaussianInt), -(ii * x) - x = -ii * (x - ii * x)) → ((∀ (x : + GaussianInt), -ii * (x + ii * x) = -1 * (ii * x - x)) → ((∀ (x : GaussianInt), -(-(ii + * x) - x) = ii * (x - ii * x)) → ((∀ (x : GaussianInt), ii * (x + ii * x) = ii * x - + x) → ((ii ^ 3 = -ii) → (((-ii) ^ 2 = -1) → (((-ii) ^ 3 = ii) → ((∀ (g₀ : + BandPackingSymmetry), ∀ (n : Nat), ∀ (x : GaussianInt), + BandPackingSymmetryVectorAction g₀ (ii ^ n * x) = (if + BandPackingSymmetryReversesOrientation g₀ then (-ii) ^ n else ii ^ n) * + BandPackingSymmetryVectorAction g₀ x) → ( + let vR := BandVectors.1 (r i.succ) (r 0) + let vL := BandVectors.1 (r 0) (r i.succ) + let vR' := BandVectors.1 (qg k.succ) (qg 0) + let vL' := BandVectors.1 (qg 0) (qg k.succ) + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + (BandPackingSymmetryVectorAction g' (ii ^ s.val * (vR + vL)) = ii ^ t.val * (vR' + vL')) + → (((if Even t.val then k - 1 else k + 1) = if BandPackingSymmetryReversesOrientation + g' then -((if Even s.val then i - 1 else i + 1) - a) else (if Even s.val then i - 1 + else i + 1) - a) → ( + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + ((if BandPackingSymmetryReversesOrientation g' then -j else j) = (if Even s.val then i - + 1 else i + 1) - a) → ((q ((if BandPackingSymmetryReversesOrientation g' then -j else + j).succ) = r ((if Even s.val then i - 1 else i + 1).succ)) → ((qg j.succ = + BandPackingSymmetryCircleAction g' (r ((if Even s.val then i - 1 else i + 1).succ))) → ( + let adj : Fin 3 := if Even s.val then i - 1 else i + 1 + let mZ : Fin 3 := adj - a + ((if BandPackingSymmetryReversesOrientation g' then -j else j) = mZ) → (((if + BandPackingSymmetryReversesOrientation g' then -mZ else mZ) = j) → ((sigma mZ = j) → + ((BandVectors.1 (qg j.succ) (qg 0) = BandPackingSymmetryVectorAction g' + (BandVectors.1 (r adj.succ) (r 0))) → ((BandVectors.1 (qg 0) (qg j.succ) = if + BandPackingSymmetryReversesOrientation g' then -BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r adj.succ)) else BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r adj.succ))) → ( + let xZ := BandVectors.1 (r adj.succ) (r 0) + let yZ := BandVectors.1 (r 0) (r adj.succ) + let xZ' := BandVectors.1 (qg j.succ) (qg 0) + let yZ' := BandVectors.1 (qg 0) (qg j.succ) + (yZ' = ii * xZ') → ((BandPackingSymmetryVectorAction g' xZ = xZ') → + ((BandPackingSymmetryVectorAction g' yZ = if BandPackingSymmetryReversesOrientation + g' then -yZ' else yZ') → ((BandPackingSymmetryVectorAction g' (if Even s.val then yZ + - xZ else xZ - yZ) = if Even s.val then (if BandPackingSymmetryReversesOrientation g' + then -yZ' - xZ' else yZ' - xZ') else (if BandPackingSymmetryReversesOrientation g' + then xZ' + yZ' else xZ' - yZ')) → (BandPackingSymmetryVectorAction g' (ii ^ s.val * + (if Even s.val then yZ - xZ else xZ - yZ)) = ii ^ t.val * (if Even t.val then yZ' - + xZ' else xZ' - yZ'))))))))))))))))))))))))))))))))) ) := by + classical + intro r i s U W Z hZ hZpos hWcent hZcent a q g' qg k sigma evenZero evenTwo notEvenOne + notEvenThree hnegVal ii iiMul iiZCaseA iiZCaseB iiZCaseC iiZCaseD iiCube negIiSq negIiCube + lpow vR vL vR' vL' t hdispW hZindex j hZparentIndex hZcircle hZlabel adj mZ hZrel hZsigma + hZsigma' hZphaseForward hZphaseBackward xZ yZ xZ' yZ' hZflip hZactionForward + hZactionBackward hZsourceAction + rw [lpow, hZsourceAction] + cases ho : BandPackingSymmetryReversesOrientation g' <;> + fin_cases s <;> + simp only [t, ho, hZflip, hnegVal, ↓reduceIte, + Bool.false_eq_true, + evenZero, evenTwo, notEvenOne, notEvenThree, + Nat.reduceSub, Nat.reduceMod] <;> + simp only [iiCube, negIiSq, negIiCube, + pow_zero, pow_one, one_mul, neg_one_mul] <;> + (try simp only [pow_two, iiMul]) + all_goals first + | exact iiZCaseA xZ' + | exact iiZCaseB xZ' + | exact iiZCaseC xZ' + | exact iiZCaseD xZ' + +private theorem hZ' : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (Z : ProtoTile), + (BandPrototile (r (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : + ℕ))).succ) Z) → (∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + ((∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction g' C).1 = C.1) ∧ (∀ (C : + CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T ↔ BandPrototile + (BandPackingSymmetryCircleAction g' C) (BandPackingSymmetryTileAction g' T)) ∧ ∀ (q : + Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ProperBandQuadruple q → BandPrototile (q (0 : Fin (4 : ℕ))) T → (∀ (i : + Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : + LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → + let sigma := fun (i : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g' = true + then -i else i; ∃ (negative : Bool) (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool) (S' + : Fin (3 : ℕ) → Bool → ProtoTile), BandPackingSymmetryScopedPhase g' q negative ∧ (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) + = (sigma i, s ^^ negative)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : + ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × + Bool) (i, s)).2 = BandPackingSymmetryTileAction g' (S i s)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction g' q) + (BandPackingSymmetryTileAction g' T) i s (S' i s)) ∧ ∀ (x : LatticeCell), x ∈ + (BandPackingSymmetryTileAction g' T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S' + i s).cells) → ( + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + (qg j.succ = BandPackingSymmetryCircleAction g' (r ((if Even s.val then i - 1 else i + + 1).succ))) → (BandPrototile (qg j.succ) (BandPackingSymmetryTileAction g' Z)))) ) := by + classical + intro r i s Z hZ a q g' qg k htileCov t j hZlabel + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + rw [hZlabel] + exact (htileCov.2.1 + (r ((if Even s.val then i - 1 else i + 1).succ)) Z).mp hZ + +private theorem hUpos' : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ((0 : ℤ) < (r (0 : Fin (4 : ℕ))).1) → (∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + ((∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction g' C).1 = C.1) ∧ (∀ (C : + CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T ↔ BandPrototile + (BandPackingSymmetryCircleAction g' C) (BandPackingSymmetryTileAction g' T)) ∧ ∀ (q : + Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ProperBandQuadruple q → BandPrototile (q (0 : Fin (4 : ℕ))) T → (∀ (i : + Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : + LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → + let sigma := fun (i : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g' = true + then -i else i; ∃ (negative : Bool) (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool) (S' + : Fin (3 : ℕ) → Bool → ProtoTile), BandPackingSymmetryScopedPhase g' q negative ∧ (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) + = (sigma i, s ^^ negative)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : + ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × + Bool) (i, s)).2 = BandPackingSymmetryTileAction g' (S i s)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction g' q) + (BandPackingSymmetryTileAction g' T) i s (S' i s)) ∧ ∀ (x : LatticeCell), x ∈ + (BandPackingSymmetryTileAction g' T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S' + i s).cells) → ((qg 0 = BandPackingSymmetryCircleAction g' (r 0)) → (0 < (qg 0).1))) ) + := by + classical + intro r hUpos a q g' qg htileCov hrootLabel + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + rw [hrootLabel, htileCov.1] + exact hUpos + +private theorem hWpos' : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ((0 : ℤ) < (r i.succ).1) → (∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + ((∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction g' C).1 = C.1) ∧ (∀ (C : + CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T ↔ BandPrototile + (BandPackingSymmetryCircleAction g' C) (BandPackingSymmetryTileAction g' T)) ∧ ∀ (q : + Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ProperBandQuadruple q → BandPrototile (q (0 : Fin (4 : ℕ))) T → (∀ (i : + Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : + LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → + let sigma := fun (i : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g' = true + then -i else i; ∃ (negative : Bool) (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool) (S' + : Fin (3 : ℕ) → Bool → ProtoTile), BandPackingSymmetryScopedPhase g' q negative ∧ (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) + = (sigma i, s ^^ negative)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : + ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × + Bool) (i, s)).2 = BandPackingSymmetryTileAction g' (S i s)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction g' q) + (BandPackingSymmetryTileAction g' T) i s (S' i s)) ∧ ∀ (x : LatticeCell), x ∈ + (BandPackingSymmetryTileAction g' T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S' + i s).cells) → ((qg k.succ = BandPackingSymmetryCircleAction g' (r i.succ)) → (0 < (qg + k.succ).1))) ) := by + classical + intro r i hWpos a q g' qg k htileCov hWlabel + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + rw [hWlabel, htileCov.1] + exact hWpos + +private theorem hZpos' : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ((0 : ℤ) < (r (if Even + (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → (∀ (a : + Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + ((∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction g' C).1 = C.1) ∧ (∀ (C : + CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T ↔ BandPrototile + (BandPackingSymmetryCircleAction g' C) (BandPackingSymmetryTileAction g' T)) ∧ ∀ (q : + Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ProperBandQuadruple q → BandPrototile (q (0 : Fin (4 : ℕ))) T → (∀ (i : + Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : + LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → + let sigma := fun (i : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g' = true + then -i else i; ∃ (negative : Bool) (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool) (S' + : Fin (3 : ℕ) → Bool → ProtoTile), BandPackingSymmetryScopedPhase g' q negative ∧ (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) + = (sigma i, s ^^ negative)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : + ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × + Bool) (i, s)).2 = BandPackingSymmetryTileAction g' (S i s)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction g' q) + (BandPackingSymmetryTileAction g' T) i s (S' i s)) ∧ ∀ (x : LatticeCell), x ∈ + (BandPackingSymmetryTileAction g' T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S' + i s).cells) → ( + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + (qg j.succ = BandPackingSymmetryCircleAction g' (r ((if Even s.val then i - 1 else i + + 1).succ))) → (0 < (qg j.succ).1))) ) := by + classical + intro r i s hZpos a q g' qg k htileCov t j hZlabel + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + rw [hZlabel, htileCov.1] + exact hZpos + +private theorem rsub : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (g₀ : BandPackingSymmetry), ∀ (p : Real × Real), ∀ (q₀ : Real × Real), R g₀ (p - q₀) = + R g₀ p - R g₀ q₀ ) := by + classical + intro R g₀ p q₀ + induction g₀ generalizing p q₀ with + | identity => rfl + | negate => ext <;> simp [R]; ring + | conjugate => ext <;> simp [R]; ring + | shift w => rfl + | comp g₁ g₂ ih₁ ih₂ => simp [R, ih₁, ih₂] + +private theorem rsmul : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (g₀ : BandPackingSymmetry), ∀ (c : Real), ∀ (p : Real × Real), R g₀ (c • p) = c • R g₀ + p ) := by + classical + intro R g₀ c p + induction g₀ generalizing c p with + | identity => rfl + | negate => ext <;> simp [R] + | conjugate => ext <;> simp [R] + | shift w => rfl + | comp g₁ g₂ ih₁ ih₂ => simp [R, ih₁, ih₂] + +private theorem rpoint : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (g₀ : BandPackingSymmetry), ∀ (v : GaussianInt), R g₀ (GaussianRealPoint v) = + GaussianRealPoint (BandPackingSymmetryVectorAction g₀ v) ) := by + classical + intro R g₀ v + induction g₀ generalizing v with + | identity => rfl + | negate => simp [R, BandPackingSymmetryVectorAction, GaussianRealPoint, + GaussianQuarterTurn] + | conjugate => simp [R, BandPackingSymmetryVectorAction, GaussianRealPoint, + GaussianReflection] + | shift w => rfl + | comp g₁ g₂ ih₁ ih₂ => + simp [R, BandPackingSymmetryVectorAction, ih₁, ih₂] + +private theorem rcentroid : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (g₀ : BandPackingSymmetry), ∀ (T₀ : ProtoTile), TileCentroid + (BandPackingSymmetryTileAction g₀ T₀) = R g₀ (TileCentroid T₀) ) := by + classical + intro R g₀ T₀ + induction g₀ generalizing T₀ with + | identity => rfl + | shift w => rfl + | negate => exact (TileQuarterTurnFormulas T₀).2.2.2.2.1 + | conjugate => + simp [BandPackingSymmetryTileAction, R, + (TileQuarterTurnFormulas _).2.2.2.2.1, + (TileReflectionFormulas _).2.2.2.2.1] + | comp g₁ g₂ ih₁ ih₂ => + simp [BandPackingSymmetryTileAction, R, ih₁, ih₂] + +private theorem hWcent' : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), (TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : + Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → (∀ (g' : + BandPackingSymmetry), + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + (∀ (g₀ : BandPackingSymmetry), ∀ (p : Real × Real), ∀ (q₀ : Real × Real), R g₀ (p - q₀) = + R g₀ p - R g₀ q₀) → ((∀ (g₀ : BandPackingSymmetry), ∀ (c : Real), ∀ (p : Real × + Real), R g₀ (c • p) = c • R g₀ p) → ((∀ (g₀ : BandPackingSymmetry), ∀ (v : + GaussianInt), R g₀ (GaussianRealPoint v) = GaussianRealPoint + (BandPackingSymmetryVectorAction g₀ v)) → ((∀ (g₀ : BandPackingSymmetry), ∀ (T₀ : + ProtoTile), TileCentroid (BandPackingSymmetryTileAction g₀ T₀) = R g₀ (TileCentroid + T₀)) → (TileCentroid (BandPackingSymmetryTileAction g' W) - TileCentroid + (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • GaussianRealPoint + (BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val * (BandVectors.1 + (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))))))))) ) := by + classical + intro r i s U W hWcent g' R rsub rsmul rpoint rcentroid + rw [rcentroid, rcentroid, ← rsub, ← rpoint, ← rsmul] + exact congrArg (R g') hWcent + +private theorem hZcent' : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (Z + : ProtoTile), (TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 + (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - BandVectors.1 (r (i - (1 : + Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) else BandVectors.1 (r (i + (1 : Fin (3 : + ℕ))).succ) (r (0 : Fin (4 : ℕ))) - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : + Fin (3 : ℕ))).succ))) → (∀ (g' : BandPackingSymmetry), + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + (∀ (g₀ : BandPackingSymmetry), ∀ (p : Real × Real), ∀ (q₀ : Real × Real), R g₀ (p - q₀) = + R g₀ p - R g₀ q₀) → ((∀ (g₀ : BandPackingSymmetry), ∀ (c : Real), ∀ (p : Real × + Real), R g₀ (c • p) = c • R g₀ p) → ((∀ (g₀ : BandPackingSymmetry), ∀ (v : + GaussianInt), R g₀ (GaussianRealPoint v) = GaussianRealPoint + (BandPackingSymmetryVectorAction g₀ v)) → ((∀ (g₀ : BandPackingSymmetry), ∀ (T₀ : + ProtoTile), TileCentroid (BandPackingSymmetryTileAction g₀ T₀) = R g₀ (TileCentroid + T₀)) → (TileCentroid (BandPackingSymmetryTileAction g' Z) - TileCentroid + (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • GaussianRealPoint + (BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val * (if Even s.val + then BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r 0) + else BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r 0) (r ((i + + 1).succ)))))))))) ) := by + classical + intro r i s U Z hZcent g' R rsub rsmul rpoint rcentroid + rw [rcentroid, rcentroid, ← rsub, ← rpoint, ← rsmul] + exact congrArg (R g') hZcent + +private theorem hWvec : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let ii : GaussianInt := ⟨0, 1⟩ + let vR := BandVectors.1 (r i.succ) (r 0) + let vL := BandVectors.1 (r 0) (r i.succ) + let vR' := BandVectors.1 (qg k.succ) (qg 0) + let vL' := BandVectors.1 (qg 0) (qg k.succ) + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + (BandPackingSymmetryVectorAction g' (ii ^ s.val * (vR + vL)) = ii ^ t.val * (vR' + vL')) + → (BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))) = ii ^ t.val * + (BandVectors.1 (qg k.succ) (qg 0) + BandVectors.1 (qg 0) (qg k.succ))) ) := by + classical + intro r i s a q g' qg k ii vR vL vR' vL' t hdispW + simpa [ii, vR, vL, vR', vL'] using hdispW + +private theorem hWcentNorm : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let ii : GaussianInt := ⟨0, 1⟩ + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + (TileCentroid (BandPackingSymmetryTileAction g' W) - TileCentroid + (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • GaussianRealPoint + (BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val * (BandVectors.1 + (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))))) → + ((BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val * (BandVectors.1 + (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))) = ii ^ t.val * (BandVectors.1 (qg + k.succ) (qg 0) + BandVectors.1 (qg 0) (qg k.succ))) → (TileCentroid + (BandPackingSymmetryTileAction g' W) - TileCentroid (BandPackingSymmetryTileAction g' + U) = (1 / 2 : Real) • GaussianRealPoint (ii ^ t.val * (BandVectors.1 (qg k.succ) (qg + 0) + BandVectors.1 (qg 0) (qg k.succ))))) ) := by + classical + intro r i s U W a q g' qg k ii t hWcent' hWvec + rw [hWvec] at hWcent' + exact hWcent' + +private theorem hZvec' : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let ii : GaussianInt := ⟨0, 1⟩ + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + let adj : Fin 3 := if Even s.val then i - 1 else i + 1 + let xZ := BandVectors.1 (r adj.succ) (r 0) + let yZ := BandVectors.1 (r 0) (r adj.succ) + let xZ' := BandVectors.1 (qg j.succ) (qg 0) + let yZ' := BandVectors.1 (qg 0) (qg j.succ) + (BandPackingSymmetryVectorAction g' (ii ^ s.val * (if Even s.val then yZ - xZ else xZ - + yZ)) = ii ^ t.val * (if Even t.val then yZ' - xZ' else xZ' - yZ')) → + (BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val * (if Even s.val + then BandVectors.1 (r 0) (r adj.succ) - BandVectors.1 (r adj.succ) (r 0) else + BandVectors.1 (r adj.succ) (r 0) - BandVectors.1 (r 0) (r adj.succ))) = ii ^ t.val * + (if Even t.val then BandVectors.1 (qg 0) (qg j.succ) - BandVectors.1 (qg j.succ) (qg + 0) else BandVectors.1 (qg j.succ) (qg 0) - BandVectors.1 (qg 0) (qg j.succ))) ) := by + classical + intro r i s a q g' qg k ii t j adj xZ yZ xZ' yZ' hZvec + simpa [ii, adj, xZ, yZ, xZ', yZ'] using hZvec + +private theorem hZcentNorm : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (Z + : ProtoTile), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let ii : GaussianInt := ⟨0, 1⟩ + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + let adj : Fin 3 := if Even s.val then i - 1 else i + 1 + let xZ := BandVectors.1 (r adj.succ) (r 0) + let yZ := BandVectors.1 (r 0) (r adj.succ) + let xZ' := BandVectors.1 (qg j.succ) (qg 0) + let yZ' := BandVectors.1 (qg 0) (qg j.succ) + (BandPackingSymmetryVectorAction g' (ii ^ s.val * (if Even s.val then yZ - xZ else xZ - + yZ)) = ii ^ t.val * (if Even t.val then yZ' - xZ' else xZ' - yZ')) → ((TileCentroid + (BandPackingSymmetryTileAction g' Z) - TileCentroid (BandPackingSymmetryTileAction g' + U) = (1 / 2 : Real) • GaussianRealPoint (BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ + : GaussianInt) ^ s.val * (if Even s.val then BandVectors.1 (r 0) (r ((i - 1).succ)) - + BandVectors.1 (r ((i - 1).succ)) (r 0) else BandVectors.1 (r ((i + 1).succ)) (r 0) - + BandVectors.1 (r 0) (r ((i + 1).succ)))))) → (TileCentroid + (BandPackingSymmetryTileAction g' Z) - TileCentroid (BandPackingSymmetryTileAction g' + U) = (1 / 2 : Real) • GaussianRealPoint (ii ^ t.val * (if Even t.val then + BandVectors.1 (qg 0) (qg j.succ) - BandVectors.1 (qg j.succ) (qg 0) else + BandVectors.1 (qg j.succ) (qg 0) - BandVectors.1 (qg 0) (qg j.succ))))) ) := by + classical + intro r i s U Z a q g' qg k ii t j adj xZ yZ xZ' yZ' hZvec hZcent' + have hZvec'' : BandPackingSymmetryVectorAction g' + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (r 0) (r ((i - 1).succ)) - + BandVectors.1 (r ((i - 1).succ)) (r 0) + else + BandVectors.1 (r ((i + 1).succ)) (r 0) - + BandVectors.1 (r 0) (r ((i + 1).succ)))) = + ii ^ t.val * (if Even t.val then + BandVectors.1 (qg 0) (qg j.succ) - BandVectors.1 (qg j.succ) (qg 0) + else BandVectors.1 (qg j.succ) (qg 0) - BandVectors.1 (qg 0) (qg j.succ)) := by + by_cases he : Even s.val + · simpa [he, adj, ii, xZ, yZ, xZ', yZ'] using hZvec + · simpa [he, adj, ii, xZ, yZ, xZ', yZ'] using hZvec + rw [hZvec''] at hZcent' + simpa [adj] using hZcent' + +private theorem hvL : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + (BandVectors.1 (qg 0) (qg k.succ) = (if BandPackingSymmetryReversesOrientation g' then + -BandPackingSymmetryVectorAction g' (BandVectors.1 (r 0) (r i.succ)) else + BandPackingSymmetryVectorAction g' (BandVectors.1 (r 0) (r i.succ)))) → ( + let vL := BandVectors.1 (r 0) (r i.succ) + let vL' := BandVectors.1 (qg 0) (qg k.succ) + BandPackingSymmetryVectorAction g' vL = if BandPackingSymmetryReversesOrientation g' then + -vL' else vL') ) := by + classical + intro r i a q g' qg k hvectorBackward vL vL' + cases ho : BandPackingSymmetryReversesOrientation g' + · simpa [ho, vL, vL'] using hvectorBackward.symm + · have h := congrArg (fun z : GaussianInt => -z) hvectorBackward.symm + simpa [ho, vL, vL'] using h + +private theorem hdR : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if Even (↑s : ℕ) then i - (1 : + Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < (r (if Even (↑s : ℕ) + then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → ((TileCentroid W - + TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : + Fin (4 : ℕ))) (r i.succ)))) → ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) + then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - + BandVectors.1 (r (i - (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) else + BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - BandVectors.1 + (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : ℕ))).succ))) → (∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + (Even 0) → ((Even 2) → ((¬ Even 1) → ((¬ Even 3) → ((∀ (s₀ : Fin 4), ((-s₀ - 1 : Fin 4) : + Nat) = (3 - s₀.val) % 4) → ( + let ii : GaussianInt := ⟨0, 1⟩ + (ii ^ 2 = -1) → ((ii ^ 3 = -ii) → (((-ii) ^ 2 = -1) → (((-ii) ^ 3 = ii) → ((∀ (g₀ : + BandPackingSymmetry), ∀ (n : Nat), ∀ (x : GaussianInt), + BandPackingSymmetryVectorAction g₀ (ii ^ n * x) = (if + BandPackingSymmetryReversesOrientation g₀ then (-ii) ^ n else ii ^ n) * + BandPackingSymmetryVectorAction g₀ x) → ( + let vR := BandVectors.1 (r i.succ) (r 0) + let vL := BandVectors.1 (r 0) (r i.succ) + let vR' := BandVectors.1 (qg k.succ) (qg 0) + let vL' := BandVectors.1 (qg 0) (qg k.succ) + (vL' = ii * vR') → ( + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + (BandPackingSymmetryVectorAction g' (ii ^ s.val * (vR + vL)) = ii ^ t.val * (vR' + vL')) + → (((if Even t.val then k - 1 else k + 1) = if BandPackingSymmetryReversesOrientation + g' then -((if Even s.val then i - 1 else i + 1) - a) else (if Even s.val then i - 1 + else i + 1) - a) → ( + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + ((if BandPackingSymmetryReversesOrientation g' then -j else j) = (if Even s.val then i - + 1 else i + 1) - a) → ((q ((if BandPackingSymmetryReversesOrientation g' then -j else + j).succ) = r ((if Even s.val then i - 1 else i + 1).succ)) → ((qg j.succ = + BandPackingSymmetryCircleAction g' (r ((if Even s.val then i - 1 else i + 1).succ))) → ( + let adj : Fin 3 := if Even s.val then i - 1 else i + 1 + let mZ : Fin 3 := adj - a + ((if BandPackingSymmetryReversesOrientation g' then -j else j) = mZ) → (((if + BandPackingSymmetryReversesOrientation g' then -mZ else mZ) = j) → ((sigma mZ = j) → + ((BandVectors.1 (qg j.succ) (qg 0) = BandPackingSymmetryVectorAction g' + (BandVectors.1 (r adj.succ) (r 0))) → ((BandVectors.1 (qg 0) (qg j.succ) = if + BandPackingSymmetryReversesOrientation g' then -BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r adj.succ)) else BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r adj.succ))) → ( + let xZ := BandVectors.1 (r adj.succ) (r 0) + let yZ := BandVectors.1 (r 0) (r adj.succ) + let xZ' := BandVectors.1 (qg j.succ) (qg 0) + let yZ' := BandVectors.1 (qg 0) (qg j.succ) + (yZ' = ii * xZ') → ((BandPackingSymmetryVectorAction g' xZ = xZ') → + ((BandPackingSymmetryVectorAction g' yZ = if BandPackingSymmetryReversesOrientation + g' then -yZ' else yZ') → ((BandPackingSymmetryVectorAction g' (if Even s.val then yZ + - xZ else xZ - yZ) = if Even s.val then (if BandPackingSymmetryReversesOrientation g' + then -yZ' - xZ' else yZ' - xZ') else (if BandPackingSymmetryReversesOrientation g' + then xZ' + yZ' else xZ' - yZ')) → ((BandPackingSymmetryVectorAction g' (ii ^ s.val * + (if Even s.val then yZ - xZ else xZ - yZ)) = ii ^ t.val * (if Even t.val then yZ' - + xZ' else xZ' - yZ')) → ((BandPrototile (qg j.succ) (BandPackingSymmetryTileAction g' + Z)) → ((0 < (qg j.succ).1) → ((TileCentroid (BandPackingSymmetryTileAction g' W) - + TileCentroid (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • + GaussianRealPoint (BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val + * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))))) → + ((TileCentroid (BandPackingSymmetryTileAction g' Z) - TileCentroid + (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • GaussianRealPoint + (BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val * (if Even s.val + then BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r 0) + else BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r 0) (r ((i + + 1).succ)))))) → ((BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val + * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))) = ii ^ t.val * + (BandVectors.1 (qg k.succ) (qg 0) + BandVectors.1 (qg 0) (qg k.succ))) → + ((TileCentroid (BandPackingSymmetryTileAction g' W) - TileCentroid + (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • GaussianRealPoint (ii ^ t.val + * (BandVectors.1 (qg k.succ) (qg 0) + BandVectors.1 (qg 0) (qg k.succ)))) → + ((BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val * (if Even s.val + then BandVectors.1 (r 0) (r adj.succ) - BandVectors.1 (r adj.succ) (r 0) else + BandVectors.1 (r adj.succ) (r 0) - BandVectors.1 (r 0) (r adj.succ))) = ii ^ t.val * + (if Even t.val then BandVectors.1 (qg 0) (qg j.succ) - BandVectors.1 (qg j.succ) (qg + 0) else BandVectors.1 (qg j.succ) (qg 0) - BandVectors.1 (qg 0) (qg j.succ))) → + ((TileCentroid (BandPackingSymmetryTileAction g' Z) - TileCentroid + (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • GaussianRealPoint (ii ^ t.val + * (if Even t.val then BandVectors.1 (qg 0) (qg j.succ) - BandVectors.1 (qg j.succ) + (qg 0) else BandVectors.1 (qg j.succ) (qg 0) - BandVectors.1 (qg 0) (qg j.succ)))) → + ((BandPackingSymmetryVectorAction g' vR = vR') → ((BandPackingSymmetryVectorAction g' + vL = if BandPackingSymmetryReversesOrientation g' then -vL' else vL') → + (BandPackingSymmetryVectorAction g' (ii ^ s.val * (if Even s.val then vL else vR)) = + ii ^ t.val * (if Even t.val then vL' else + vR'))))))))))))))))))))))))))))))))))))))))) ) := by + classical + intro r i s U W Z hZ hZpos hWcent hZcent a q g' qg k sigma evenZero evenTwo notEvenOne + notEvenThree hnegVal ii iiSq iiCube negIiSq negIiCube lpow vR vL vR' vL' hbackEq' t hdispW + hZindex j hZparentIndex hZcircle hZlabel adj mZ hZrel hZsigma hZsigma' hZphaseForward + hZphaseBackward xZ yZ xZ' yZ' hZflip hZactionForward hZactionBackward hZsourceAction hZvec + hZ' hZpos' hWcent' hZcent' hWvec hWcentNorm hZvec' hZcentNorm hvR hvL + rw [lpow] + cases ho : BandPackingSymmetryReversesOrientation g' <;> fin_cases s <;> + simp [t, ho, evenZero, evenTwo, notEvenOne, notEvenThree, + hvR, hvL, hbackEq', hnegVal, iiSq, iiCube, negIiSq, negIiCube]; + + +private theorem hdL : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W + : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if Even (↑s : ℕ) then i - (1 : + Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < (r (if Even (↑s : ℕ) + then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → ((TileCentroid W - + TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : + Fin (4 : ℕ))) (r i.succ)))) → ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) + then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - + BandVectors.1 (r (i - (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) else + BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - BandVectors.1 + (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : ℕ))).succ))) → (∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + (Even 0) → ((Even 2) → ((¬ Even 1) → ((¬ Even 3) → ((∀ (s₀ : Fin 4), ((-s₀ - 1 : Fin 4) : + Nat) = (3 - s₀.val) % 4) → ( + let ii : GaussianInt := ⟨0, 1⟩ + (ii ^ 2 = -1) → ((ii ^ 3 = -ii) → (((-ii) ^ 2 = -1) → (((-ii) ^ 3 = ii) → ((∀ (g₀ : + BandPackingSymmetry), ∀ (n : Nat), ∀ (x : GaussianInt), + BandPackingSymmetryVectorAction g₀ (ii ^ n * x) = (if + BandPackingSymmetryReversesOrientation g₀ then (-ii) ^ n else ii ^ n) * + BandPackingSymmetryVectorAction g₀ x) → ( + let vR := BandVectors.1 (r i.succ) (r 0) + let vL := BandVectors.1 (r 0) (r i.succ) + let vR' := BandVectors.1 (qg k.succ) (qg 0) + let vL' := BandVectors.1 (qg 0) (qg k.succ) + (vL' = ii * vR') → ( + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + (BandPackingSymmetryVectorAction g' (ii ^ s.val * (vR + vL)) = ii ^ t.val * (vR' + vL')) + → (((if Even t.val then k - 1 else k + 1) = if BandPackingSymmetryReversesOrientation + g' then -((if Even s.val then i - 1 else i + 1) - a) else (if Even s.val then i - 1 + else i + 1) - a) → ( + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + ((if BandPackingSymmetryReversesOrientation g' then -j else j) = (if Even s.val then i - + 1 else i + 1) - a) → ((q ((if BandPackingSymmetryReversesOrientation g' then -j else + j).succ) = r ((if Even s.val then i - 1 else i + 1).succ)) → ((qg j.succ = + BandPackingSymmetryCircleAction g' (r ((if Even s.val then i - 1 else i + 1).succ))) → ( + let adj : Fin 3 := if Even s.val then i - 1 else i + 1 + let mZ : Fin 3 := adj - a + ((if BandPackingSymmetryReversesOrientation g' then -j else j) = mZ) → (((if + BandPackingSymmetryReversesOrientation g' then -mZ else mZ) = j) → ((sigma mZ = j) → + ((BandVectors.1 (qg j.succ) (qg 0) = BandPackingSymmetryVectorAction g' + (BandVectors.1 (r adj.succ) (r 0))) → ((BandVectors.1 (qg 0) (qg j.succ) = if + BandPackingSymmetryReversesOrientation g' then -BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r adj.succ)) else BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r adj.succ))) → ( + let xZ := BandVectors.1 (r adj.succ) (r 0) + let yZ := BandVectors.1 (r 0) (r adj.succ) + let xZ' := BandVectors.1 (qg j.succ) (qg 0) + let yZ' := BandVectors.1 (qg 0) (qg j.succ) + (yZ' = ii * xZ') → ((BandPackingSymmetryVectorAction g' xZ = xZ') → + ((BandPackingSymmetryVectorAction g' yZ = if BandPackingSymmetryReversesOrientation + g' then -yZ' else yZ') → ((BandPackingSymmetryVectorAction g' (if Even s.val then yZ + - xZ else xZ - yZ) = if Even s.val then (if BandPackingSymmetryReversesOrientation g' + then -yZ' - xZ' else yZ' - xZ') else (if BandPackingSymmetryReversesOrientation g' + then xZ' + yZ' else xZ' - yZ')) → ((BandPackingSymmetryVectorAction g' (ii ^ s.val * + (if Even s.val then yZ - xZ else xZ - yZ)) = ii ^ t.val * (if Even t.val then yZ' - + xZ' else xZ' - yZ')) → ((BandPrototile (qg j.succ) (BandPackingSymmetryTileAction g' + Z)) → ((0 < (qg j.succ).1) → ((TileCentroid (BandPackingSymmetryTileAction g' W) - + TileCentroid (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • + GaussianRealPoint (BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val + * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))))) → + ((TileCentroid (BandPackingSymmetryTileAction g' Z) - TileCentroid + (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • GaussianRealPoint + (BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val * (if Even s.val + then BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r 0) + else BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r 0) (r ((i + + 1).succ)))))) → ((BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val + * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))) = ii ^ t.val * + (BandVectors.1 (qg k.succ) (qg 0) + BandVectors.1 (qg 0) (qg k.succ))) → + ((TileCentroid (BandPackingSymmetryTileAction g' W) - TileCentroid + (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • GaussianRealPoint (ii ^ t.val + * (BandVectors.1 (qg k.succ) (qg 0) + BandVectors.1 (qg 0) (qg k.succ)))) → + ((BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val * (if Even s.val + then BandVectors.1 (r 0) (r adj.succ) - BandVectors.1 (r adj.succ) (r 0) else + BandVectors.1 (r adj.succ) (r 0) - BandVectors.1 (r 0) (r adj.succ))) = ii ^ t.val * + (if Even t.val then BandVectors.1 (qg 0) (qg j.succ) - BandVectors.1 (qg j.succ) (qg + 0) else BandVectors.1 (qg j.succ) (qg 0) - BandVectors.1 (qg 0) (qg j.succ))) → + ((TileCentroid (BandPackingSymmetryTileAction g' Z) - TileCentroid + (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • GaussianRealPoint (ii ^ t.val + * (if Even t.val then BandVectors.1 (qg 0) (qg j.succ) - BandVectors.1 (qg j.succ) + (qg 0) else BandVectors.1 (qg j.succ) (qg 0) - BandVectors.1 (qg 0) (qg j.succ)))) → + ((BandPackingSymmetryVectorAction g' vR = vR') → ((BandPackingSymmetryVectorAction g' + vL = if BandPackingSymmetryReversesOrientation g' then -vL' else vL') → + ((BandPackingSymmetryVectorAction g' (ii ^ s.val * (if Even s.val then vL else vR)) = + ii ^ t.val * (if Even t.val then vL' else vR')) → (BandPackingSymmetryVectorAction g' + (ii ^ s.val * (if Even s.val then vR else vL)) = ii ^ t.val * (if Even t.val then vR' + else vL')))))))))))))))))))))))))))))))))))))))))) ) := by + classical + intro r i s U W Z hZ hZpos hWcent hZcent a q g' qg k sigma evenZero evenTwo notEvenOne + notEvenThree hnegVal ii iiSq iiCube negIiSq negIiCube lpow vR vL vR' vL' hbackEq' t hdispW + hZindex j hZparentIndex hZcircle hZlabel adj mZ hZrel hZsigma hZsigma' hZphaseForward + hZphaseBackward xZ yZ xZ' yZ' hZflip hZactionForward hZactionBackward hZsourceAction hZvec + hZ' hZpos' hWcent' hZcent' hWvec hWcentNorm hZvec' hZcentNorm hvR hvL hdR + rw [lpow] + cases ho : BandPackingSymmetryReversesOrientation g' <;> fin_cases s <;> + simp [t, ho, evenZero, evenTwo, notEvenOne, notEvenThree, + hvR, hvL, hbackEq', hnegVal, iiSq, iiCube, negIiSq, negIiCube] <;> + ring_nf <;> simp only [iiSq, neg_one_mul, neg_neg]; ring + +end PlacementNormalizationProof + +theorem P4055T1PlacementNormalization + (r : Fin 4 → CircleCoordinates) (hproper : ProperBandQuadruple r) + (i : Fin 3) (s : Fin 4) (U W Z : ProtoTile) + (hU : BandPrototile (r 0) U) + (hW : BandPrototile (r i.succ) W) + (hZ : BandPrototile + (r ((if Even s.val then i - 1 else i + 1).succ)) Z) + (hUpos : 0 < (r 0).1) (hWpos : 0 < (r i.succ).1) + (hZpos : 0 < (r ((if Even s.val then i - 1 else i + 1).succ)).1) + (hWcent : TileCentroid W - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (r i.succ) (r 0) + + BandVectors.1 (r 0) (r i.succ)))) + (hZcent : TileCentroid Z - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (r 0) (r ((i - 1).succ)) - + BandVectors.1 (r ((i - 1).succ)) (r 0) + else + BandVectors.1 (r ((i + 1).succ)) (r 0) - + BandVectors.1 (r 0) (r ((i + 1).succ))))) + (a : Fin 3) (g : BandPackingSymmetry) : + ∃ g' : BandPackingSymmetry, + (∀ p, BandPackingSymmetryQuadrupleAction g' p = + BandPackingSymmetryQuadrupleAction g p) ∧ + let qg := BandPackingSymmetryQuadrupleAction g' + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + let U' := BandPackingSymmetryTileAction g' U + let W' := BandPackingSymmetryTileAction g' W + let Z' := BandPackingSymmetryTileAction g' Z + let ii : GaussianInt := ⟨0, 1⟩ + ProperBandQuadruple qg ∧ + BandPrototile (qg 0) U' ∧ BandPrototile (qg k.succ) W' ∧ + BandPrototile (qg j.succ) Z' ∧ + 0 < (qg 0).1 ∧ 0 < (qg k.succ).1 ∧ 0 < (qg j.succ).1 ∧ + TileCentroid W' - TileCentroid U' = (1 / 2 : Real) • + GaussianRealPoint (ii ^ t.val * + (BandVectors.1 (qg k.succ) (qg 0) + BandVectors.1 (qg 0) (qg k.succ))) ∧ + TileCentroid Z' - TileCentroid U' = (1 / 2 : Real) • + GaussianRealPoint (ii ^ t.val * (if Even t.val then + BandVectors.1 (qg 0) (qg j.succ) - BandVectors.1 (qg j.succ) (qg 0) + else BandVectors.1 (qg j.succ) (qg 0) - BandVectors.1 (qg 0) (qg j.succ))) ∧ + BandPackingSymmetryVectorAction g' + (ii ^ s.val * (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0))) = + ii ^ t.val * (if Even t.val then BandVectors.1 (qg 0) (qg k.succ) + else BandVectors.1 (qg k.succ) (qg 0)) ∧ + BandPackingSymmetryVectorAction g' + (ii ^ s.val * (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ))) = + ii ^ t.val * (if Even t.val then BandVectors.1 (qg k.succ) (qg 0) + else BandVectors.1 (qg 0) (qg k.succ)) := by +-- BODY + classical + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + have hq := PlacementNormalizationProof.hq r hproper a + have hprojective := BandPackingSymmetryProjectiveVectorCovariance g q hq + dsimp at hprojective + rcases hprojective with ⟨negative, hphase, hphase1, hphase2, hcircle, + horient', hquad, hvec, g', hglift, hcircle', horientg, hquadg, hfalse, + hfalse1, hfalse2⟩ + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' + then -(i - a) else i - a + have hproperG : ProperBandQuadruple qg := + BandPackingSymmetryProperCovariance g' q hq + have htileCov := BandPackingSymmetryCovariance g' + let U' : ProtoTile := BandPackingSymmetryTileAction g' U + let W' : ProtoTile := BandPackingSymmetryTileAction g' W + let Z' : ProtoTile := BandPackingSymmetryTileAction g' Z + have hU' := PlacementNormalizationProof.hU' r U hU a g g' horientg htileCov + have hWlabel := PlacementNormalizationProof.hWlabel r i s U W Z hW hZ hWpos hZpos hWcent hZcent + a g hq negative hphase hphase1 hphase2 g' hfalse hfalse1 hfalse2 hproperG hU' + have cyclicIndex (j₀ : Fin 3) := PlacementNormalizationProof.cyclicIndex r i U a g hq negative + hphase hphase1 hphase2 g' hfalse hfalse1 hfalse2 hproperG hU' hWlabel j₀ + have cyclicCancel (x y : Fin 3) : x + (y - x) = y := by + fin_cases x <;> fin_cases y <;> decide +kernel + have actionParent (j₀ : Fin 3) := PlacementNormalizationProof.actionParent r a g' j₀ + have hrootLabel : qg 0 = BandPackingSymmetryCircleAction g' (r 0) := by + simp [qg, q, BandPackingSymmetryQuadrupleAction] + have hW' := PlacementNormalizationProof.hW' r i W hW a g' htileCov hWlabel + let sigma : Fin 3 → Fin 3 := fun m => + if BandPackingSymmetryReversesOrientation g' then -m else m + have hparent (m : Fin 3) := PlacementNormalizationProof.hparent r a g' cyclicIndex actionParent m + have hparentAction (m : Fin 3) := PlacementNormalizationProof.hparentAction r a g' hparent m + have hrootAction := PlacementNormalizationProof.hrootAction r a g' hrootLabel + have hphaseForward (m : Fin 3) := PlacementNormalizationProof.hphaseForward r a g' hfalse + cyclicIndex hrootLabel hparent hparentAction hrootAction m + have hphaseBackward (m : Fin 3) := PlacementNormalizationProof.hphaseBackward r a g' hfalse + cyclicIndex hrootLabel hparent hparentAction hrootAction m + have hk : sigma (i - a) = k := by rfl + have hvectorForward : + BandVectors.1 (qg k.succ) (qg 0) = + BandPackingSymmetryVectorAction g' + (BandVectors.1 (r i.succ) (r 0)) := PlacementNormalizationProof.hvectorForward r i a g' + cyclicCancel hphaseForward hk + have hvectorBackward := PlacementNormalizationProof.hvectorBackward r i a g' cyclicCancel + hphaseBackward hk + have evenZero : Even 0 := ⟨0, by decide⟩ + have evenTwo : Even 2 := ⟨1, by decide⟩ + have notEvenOne := PlacementNormalizationProof.notEvenOne r i s a g' + have notEvenThree := PlacementNormalizationProof.notEvenThree r i s a g' + have hnegVal (s₀ : Fin 4) := PlacementNormalizationProof.hnegVal s₀ + let ii : GaussianInt := ⟨0, 1⟩ + have iiSq : ii ^ 2 = -1 := by decide +kernel + have iiSqLiteral : (⟨0, 1⟩ : GaussianInt) ^ 2 = -1 := by decide +kernel + have iiMul : ii * ii = -1 := by simpa [pow_two] using iiSq + have iiCancel (x : GaussianInt) := PlacementNormalizationProof.iiCancel iiSq x + have iiCancelLiteral (x : GaussianInt) := PlacementNormalizationProof.iiCancelLiteral + iiSqLiteral x + have iiSquareMul (x : GaussianInt) := PlacementNormalizationProof.iiSquareMul iiMul x + have iiNegSquareMul (x : GaussianInt) := PlacementNormalizationProof.iiNegSquareMul iiSquareMul x + have iiCaseA (x : GaussianInt) := PlacementNormalizationProof.iiCaseA iiSq x + have iiCaseB (x : GaussianInt) := PlacementNormalizationProof.iiCaseB iiSq x + have iiCaseC (x : GaussianInt) := PlacementNormalizationProof.iiCaseC iiSq x + have iiCaseA' (x : GaussianInt) := PlacementNormalizationProof.iiCaseA' iiNegSquareMul x + have iiCaseB' (x : GaussianInt) := PlacementNormalizationProof.iiCaseB' iiNegSquareMul x + have iiCaseC' (x : GaussianInt) := PlacementNormalizationProof.iiCaseC' iiSquareMul x + have iiCaseD' (x : GaussianInt) := PlacementNormalizationProof.iiCaseD' iiSquareMul x + have iiCaseE (x : GaussianInt) := PlacementNormalizationProof.iiCaseE iiSq x + have iiZCaseA (x : GaussianInt) := PlacementNormalizationProof.iiZCaseA iiNegSquareMul x + have iiZCaseB (x : GaussianInt) := PlacementNormalizationProof.iiZCaseB iiNegSquareMul x + have iiZCaseC (x : GaussianInt) := PlacementNormalizationProof.iiZCaseC iiSquareMul x + have iiZCaseD (x : GaussianInt) := PlacementNormalizationProof.iiZCaseD iiSquareMul x + have iiCube := PlacementNormalizationProof.iiCube iiSq + have iiFourth := PlacementNormalizationProof.iiFourth iiMul iiCube + have negIiSq := PlacementNormalizationProof.negIiSq iiMul + have negIiCube := PlacementNormalizationProof.negIiCube negIiSq + have ladd (g₀ : BandPackingSymmetry) (x y : GaussianInt) := PlacementNormalizationProof.ladd g₀ + x y + have lneg (g₀ : BandPackingSymmetry) (x : GaussianInt) := PlacementNormalizationProof.lneg g₀ x + have lquarter (g₀ : BandPackingSymmetry) (x : GaussianInt) := + PlacementNormalizationProof.lquarter lneg g₀ x + have lpow (g₀ : BandPackingSymmetry) (n : Nat) (x : GaussianInt) := + PlacementNormalizationProof.lpow lquarter g₀ n x + have hflip : BandVectors.1 (r 0) (r i.succ) = + ii * BandVectors.1 (r i.succ) (r 0) := + ((VectorRecursionLaws r hproper.1).2.2.2.2 hproper i).1 + have hbackEqual : BandVectors.1 (qg 0) (qg k.succ) = + ii * BandVectors.1 (qg k.succ) (qg 0) := PlacementNormalizationProof.hbackEqual r i a g' + hvectorForward hvectorBackward lquarter hflip + let vR := BandVectors.1 (r i.succ) (r 0) + let vL := BandVectors.1 (r 0) (r i.succ) + let vR' := BandVectors.1 (qg k.succ) (qg 0) + let vL' := BandVectors.1 (qg 0) (qg k.succ) + have hbackEq' : vL' = ii * vR' := by + simpa [vR', vL'] using hbackEqual + let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' + then -s - 1 else s + have hdispW := PlacementNormalizationProof.hdispW r i s U W Z hZ hZpos hWcent hZcent a g' + hvectorForward hvectorBackward hnegVal iiSq iiCaseA' iiCaseB' iiCaseC' iiCaseD' iiCube + negIiSq negIiCube ladd lpow hbackEq' + have quarterParity (s₀ : Fin 4) := PlacementNormalizationProof.quarterParity evenZero evenTwo + notEvenOne notEvenThree s₀ + have reversedAdjacent (a₀ i₀ : Fin 3) (s₀ : Fin 4) := + PlacementNormalizationProof.reversedAdjacent quarterParity a₀ i₀ s₀ + have normalizedAdjacent (rev : Bool) (a₀ i₀ : Fin 3) (s₀ : Fin 4) := + PlacementNormalizationProof.normalizedAdjacent reversedAdjacent rev a₀ i₀ s₀ + have hZindex := PlacementNormalizationProof.hZindex i s a g' normalizedAdjacent + let j : Fin 3 := if Even t.val then k - 1 else k + 1 + have hZparentIndex := PlacementNormalizationProof.hZparentIndex i s a g' hZindex + have hZcircle := PlacementNormalizationProof.hZcircle r i s a g' cyclicIndex cyclicCancel + hZparentIndex + have hZlabel := PlacementNormalizationProof.hZlabel r i s a g' actionParent hZcircle + let adj : Fin 3 := if Even s.val then i - 1 else i + 1 + let mZ : Fin 3 := adj - a + have hZrel := PlacementNormalizationProof.hZrel i s a g' hZparentIndex + have hZsigma : + (if BandPackingSymmetryReversesOrientation g' then -mZ else mZ) = j := + PlacementNormalizationProof.hZsigma i s a g' hZrel + have hZsigma' : sigma mZ = j := by + simpa [sigma] using hZsigma + have hZphaseForward := PlacementNormalizationProof.hZphaseForward r i s a g' cyclicCancel + hphaseForward hZsigma' + have hZphaseBackward := PlacementNormalizationProof.hZphaseBackward r i s a g' cyclicCancel + hphaseBackward hZsigma' + let xZ := BandVectors.1 (r adj.succ) (r 0) + let yZ := BandVectors.1 (r 0) (r adj.succ) + let xZ' := BandVectors.1 (qg j.succ) (qg 0) + let yZ' := BandVectors.1 (qg 0) (qg j.succ) + have hZflip : yZ' = ii * xZ' := + ((VectorRecursionLaws qg hproperG.1).2.2.2.2 hproperG j).1 + have hZactionForward := PlacementNormalizationProof.hZactionForward r i s a g' hZphaseForward + have hZactionBackward := PlacementNormalizationProof.hZactionBackward r i s a g' hZphaseBackward + have hZsourceAction := PlacementNormalizationProof.hZsourceAction r i s a g' ladd lneg + hZactionForward hZactionBackward + have hZvec := PlacementNormalizationProof.hZvec r i s U W Z hZ hZpos hWcent hZcent a g' + evenZero evenTwo notEvenOne notEvenThree hnegVal iiMul iiZCaseA iiZCaseB iiZCaseC iiZCaseD + iiCube negIiSq negIiCube lpow hdispW hZindex hZparentIndex hZcircle hZlabel hZrel hZsigma + hZsigma' hZphaseForward hZphaseBackward hZflip hZactionForward hZactionBackward hZsourceAction + have hZ' := PlacementNormalizationProof.hZ' r i s Z hZ a g' htileCov hZlabel + have hUpos' := PlacementNormalizationProof.hUpos' r hUpos a g' htileCov hrootLabel + have hWpos' := PlacementNormalizationProof.hWpos' r i hWpos a g' htileCov hWlabel + have hZpos' := PlacementNormalizationProof.hZpos' r i s hZpos a g' htileCov hZlabel + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + have rsub (g₀ : BandPackingSymmetry) (p q₀ : Real × Real) := PlacementNormalizationProof.rsub + g₀ p q₀ + have rsmul (g₀ : BandPackingSymmetry) (c : Real) (p : Real × Real) := + PlacementNormalizationProof.rsmul g₀ c p + have rpoint (g₀ : BandPackingSymmetry) (v : GaussianInt) := PlacementNormalizationProof.rpoint + g₀ v + have rcentroid (g₀ : BandPackingSymmetry) (T₀ : ProtoTile) := + PlacementNormalizationProof.rcentroid g₀ T₀ + have hWcent' := PlacementNormalizationProof.hWcent' r i s U W hWcent g' rsub rsmul rpoint + rcentroid + have hZcent' := PlacementNormalizationProof.hZcent' r i s U Z hZcent g' rsub rsmul rpoint + rcentroid + have hWvec := PlacementNormalizationProof.hWvec r i s a g' hdispW + have hWcentNorm := PlacementNormalizationProof.hWcentNorm r i s U W a g' hWcent' hWvec + have hZvec' := PlacementNormalizationProof.hZvec' r i s a g' hZvec + have hZcentNorm := PlacementNormalizationProof.hZcentNorm r i s U Z a g' hZvec hZcent' + have hvR : BandPackingSymmetryVectorAction g' vR = vR' := by + simpa [vR, vR'] using hvectorForward.symm + have hvL := PlacementNormalizationProof.hvL r i a g' hvectorBackward + have hdR := PlacementNormalizationProof.hdR r i s U W Z hZ hZpos hWcent hZcent a g' evenZero + evenTwo notEvenOne notEvenThree hnegVal iiSq iiCube negIiSq negIiCube lpow hbackEq' hdispW + hZindex hZparentIndex hZcircle hZlabel hZrel hZsigma hZsigma' hZphaseForward + hZphaseBackward hZflip hZactionForward hZactionBackward hZsourceAction hZvec hZ' hZpos' + hWcent' hZcent' hWvec hWcentNorm hZvec' hZcentNorm hvR hvL + have hdL := PlacementNormalizationProof.hdL r i s U W Z hZ hZpos hWcent hZcent a g' evenZero + evenTwo notEvenOne notEvenThree hnegVal iiSq iiCube negIiSq negIiCube lpow hbackEq' hdispW + hZindex hZparentIndex hZcircle hZlabel hZrel hZsigma hZsigma' hZphaseForward + hZphaseBackward hZflip hZactionForward hZactionBackward hZsourceAction hZvec hZ' hZpos' + hWcent' hZcent' hWvec hWcentNorm hZvec' hZcentNorm hvR hvL hdR + exact ⟨g', hquadg, hproperG, hU', hW', hZ', hUpos', hWpos', hZpos', + hWcentNorm, hZcentNorm, hdR, hdL⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean b/LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean new file mode 100644 index 0000000000..bac3b4aaeb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean @@ -0,0 +1,352 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P4062T1CanonicalSupport] + +/-! +# P4062T1CanonicalSupport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CanonicalSupport + +private theorem hcellCoord (q : Nat) (z : GaussianInt) : + z ∈ FordCellDomain q ↔ + 0 ≤ z.re ∧ z.re < (q : Int) ∧ + 0 ≤ z.im ∧ z.im < (q : Int) := by + classical + constructor + · intro hz + change z ∈ ((Finset.range q).product (Finset.range q)).image + (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) at hz + rcases Finset.mem_image.mp hz with ⟨a, ha, heq⟩ + have hab := Finset.mem_product.mp ha + rcases a with ⟨m, n⟩ + have hm := Finset.mem_range.mp hab.1 + have hn := Finset.mem_range.mp hab.2 + have hre : z.re = (m : Int) := by + have hh := congrArg (fun w : GaussianInt => w.re) heq + simpa using hh.symm + have him : z.im = (n : Int) := by + have hh := congrArg (fun w : GaussianInt => w.im) heq + simpa using hh.symm + simp [hre, him, hm, hn] + · rintro ⟨hzr, hzr', hzi, hzi'⟩ + let m := z.re.toNat + let n := z.im.toNat + have hmcast : (m : Int) = z.re := Int.toNat_of_nonneg hzr + have hncast : (n : Int) = z.im := Int.toNat_of_nonneg hzi + have hm : m < q := by + exact_mod_cast (show (m : Int) < q by omega) + have hn : n < q := by + exact_mod_cast (show (n : Int) < q by omega) + apply Finset.mem_image.mpr + refine ⟨(m, n), Finset.mem_product.mpr + ⟨Finset.mem_range.mpr hm, Finset.mem_range.mpr hn⟩, ?_⟩ + apply Zsqrtd.ext <;> simp [hmcast, hncast] + +private theorem hfootSquare (q : Nat) (hqpos : 0 < q) : + FootprintVertices (FordTile q) = FordVertexDomain q := by + classical + have hc : (FordTile q).cells.Nonempty := by + refine ⟨⟨0, 0⟩, ?_⟩ + simp? [FordTile, FordCellDomain] + exact hqpos + ext x + simp only [FootprintVertices, ite_eq_left hc, FordVertexDomain, + Set.mem_ofPred_eq] + simp only [FordTile, FordCellDomain, Finset.mem_image, + ] + constructor + · rintro ⟨z, ⟨a, ha, hz⟩, hcorner⟩ + rcases a with ⟨m, n⟩ + have hab := Finset.mem_product.mp ha + have hm := Finset.mem_range.mp hab.1 + have hn := Finset.mem_range.mp hab.2 + have hre : z.re = (m : Int) := by + have hh := congrArg (fun w : GaussianInt => w.re) hz + simpa using hh.symm + have him : z.im = (n : Int) := by + have hh := congrArg (fun w : GaussianInt => w.im) hz + simpa using hh.symm + rcases hcorner with rfl | rfl | rfl | rfl + all_goals simp only [Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, + Zsqrtd.im_one, hre, him] at * + all_goals omega + · intro hx + rcases hx with ⟨hxre0, hxreq, hxim0, hximq⟩ + let m := min x.re.toNat (q - 1) + let n := min x.im.toNat (q - 1) + have hcastre : (x.re.toNat : Int) = x.re := Int.toNat_of_nonneg hxre0 + have hcastim : (x.im.toNat : Int) = x.im := Int.toNat_of_nonneg hxim0 + have hmlt : m < q := by dsimp [m]; omega + have hnlt : n < q := by dsimp [n]; omega + have hmcase : (m : Int) = x.re ∨ (m : Int) + 1 = x.re := by + by_cases h : x.re.toNat ≤ q - 1 + · left + dsimp [m] + rw [Nat.min_eq_left h, hcastre] + · right + have hqle : (x.re.toNat : Int) ≤ q := by omega + have hqminus : (q - 1 : Int) < x.re.toNat := by omega + have hxeq : x.re = q := by omega + have hmin : min x.re.toNat (q - 1) = q - 1 := by omega + dsimp [m] + rw [hmin, hxeq] + omega + have hncase : (n : Int) = x.im ∨ (n : Int) + 1 = x.im := by + by_cases h : x.im.toNat ≤ q - 1 + · left + dsimp [n] + rw [Nat.min_eq_left h, hcastim] + · right + have hqle : (x.im.toNat : Int) ≤ q := by omega + have hqminus : (q - 1 : Int) < x.im.toNat := by omega + have hxeq : x.im = q := by omega + have hmin : min x.im.toNat (q - 1) = q - 1 := by omega + dsimp [n] + rw [hmin, hxeq] + omega + let z : GaussianInt := ⟨m, n⟩ + have hzmem : z ∈ FordCellDomain q := by + apply Finset.mem_image.mpr + refine ⟨(m, n), Finset.mem_product.mpr + ⟨Finset.mem_range.mpr hmlt, Finset.mem_range.mpr hnlt⟩, ?_⟩ + rfl + have hxcorner : x = z ∨ x = z + 1 ∨ + x = z + ⟨0, 1⟩ ∨ x = z + 1 + ⟨0, 1⟩ := by + rcases hmcase with hm | hm <;> rcases hncase with hn | hn + · left + apply Zsqrtd.ext <;> simp [z, hm, hn] + · right; right; left + apply Zsqrtd.ext <;> simp [z, hm, hn] + · right; left + apply Zsqrtd.ext <;> simp [z, hm, hn] + · right; right; right + apply Zsqrtd.ext <;> simp [z, hm, hn] + refine ⟨z, ?_, hxcorner⟩ + simpa [FordTile, FordCellDomain] using hzmem + +private theorem hFcells (q : Nat) (hqpos : 0 < q) : (FordTile q).cells.Nonempty := by + classical + refine ⟨⟨0, 0⟩, ?_⟩ + simp? [FordTile, FordCellDomain] + exact hqpos + +private theorem hcellTiles (q : Nat) (z : GaussianInt) : + z ∈ (FordTile q).cells ↔ + 0 ≤ z.re ∧ z.re < (q : Int) ∧ + 0 ≤ z.im ∧ z.im < (q : Int) := by + classical + have hcellCoord (z : GaussianInt) : + z ∈ FordCellDomain q ↔ + 0 ≤ z.re ∧ z.re < (q : Int) ∧ + 0 ≤ z.im ∧ z.im < (q : Int) := hcellCoord q z + change z ∈ FordCellDomain q ↔ _ + exact hcellCoord z + +private theorem hhoriz (q : Nat) (z : GaussianInt) : + ((z ∈ (FordTile q).cells ∧ z - ⟨0, 1⟩ ∉ (FordTile q).cells) ∨ + (z ∉ (FordTile q).cells ∧ z - ⟨0, 1⟩ ∈ (FordTile q).cells)) ↔ + 0 ≤ z.re ∧ z.re < (q : Int) ∧ + (z.im = 0 ∨ z.im = q) := by + classical + have hcellTiles (z : GaussianInt) : + z ∈ (FordTile q).cells ↔ + 0 ≤ z.re ∧ z.re < (q : Int) ∧ + 0 ≤ z.im ∧ z.im < (q : Int) := hcellTiles q z + rw [hcellTiles z, hcellTiles (z - ⟨0, 1⟩)] + simp + omega + +private theorem hvert (q : Nat) (z : GaussianInt) : + ((z ∈ (FordTile q).cells ∧ z - 1 ∉ (FordTile q).cells) ∨ + (z ∉ (FordTile q).cells ∧ z - 1 ∈ (FordTile q).cells)) ↔ + 0 ≤ z.im ∧ z.im < (q : Int) ∧ + (z.re = 0 ∨ z.re = q) := by + classical + have hcellTiles (z : GaussianInt) : + z ∈ (FordTile q).cells ↔ + 0 ≤ z.re ∧ z.re < (q : Int) ∧ + 0 ≤ z.im ∧ z.im < (q : Int) := hcellTiles q z + rw [hcellTiles z, hcellTiles (z - 1)] + simp + omega + +private theorem hboundarySquare (q : Nat) (hqpos : 0 < q) : + BoundaryFootprintVertices (FordTile q) = + {x | 0 ≤ x.re ∧ x.re ≤ (q : Int) ∧ + 0 ≤ x.im ∧ x.im ≤ (q : Int) ∧ + (x.re = 0 ∨ x.re = (q : Int) ∨ + x.im = 0 ∨ x.im = (q : Int))} := by + classical + have hFcells : (FordTile q).cells.Nonempty := hFcells q hqpos + have hhoriz (z : GaussianInt) : + ((z ∈ (FordTile q).cells ∧ z - ⟨0, 1⟩ ∉ (FordTile q).cells) ∨ + (z ∉ (FordTile q).cells ∧ z - ⟨0, 1⟩ ∈ (FordTile q).cells)) ↔ + 0 ≤ z.re ∧ z.re < (q : Int) ∧ + (z.im = 0 ∨ z.im = q) := hhoriz q z + have hvert (z : GaussianInt) : + ((z ∈ (FordTile q).cells ∧ z - 1 ∉ (FordTile q).cells) ∨ + (z ∉ (FordTile q).cells ∧ z - 1 ∈ (FordTile q).cells)) ↔ + 0 ≤ z.im ∧ z.im < (q : Int) ∧ + (z.re = 0 ∨ z.re = q) := hvert q z + ext x + constructor + · intro hx + change 0 ≤ x.re ∧ x.re ≤ (q : Int) ∧ + 0 ≤ x.im ∧ x.im ≤ (q : Int) ∧ + (x.re = 0 ∨ x.re = (q : Int) ∨ + x.im = 0 ∨ x.im = (q : Int)) + simp only [BoundaryFootprintVertices, ite_eq_left hFcells, + Set.mem_ofPred_eq] at hx + rcases hx with ⟨e, he, hxe⟩ + change ∃ z, (e = {z, z + 1} ∧ + ((z ∈ (FordTile q).cells ∧ z - ⟨0, 1⟩ ∉ (FordTile q).cells) ∨ + (z ∉ (FordTile q).cells ∧ z - ⟨0, 1⟩ ∈ (FordTile q).cells))) ∨ + (e = {z, z + ⟨0, 1⟩} ∧ + ((z ∈ (FordTile q).cells ∧ z - 1 ∉ (FordTile q).cells) ∨ + (z ∉ (FordTile q).cells ∧ z - 1 ∈ (FordTile q).cells))) at he + rcases he with ⟨z, hz⟩ + rcases hz with ⟨rfl, hxor⟩ | ⟨rfl, hxor⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + have hside := (hhoriz z).mp hxor + rcases hside with ⟨hzr, hzru, hside⟩ + rcases hxe with hxe | hxe + · have hr := congrArg (fun w : GaussianInt => w.re) hxe + have hi := congrArg (fun w : GaussianInt => w.im) hxe + rw [hr, hi] + rcases hside with hside | hside <;> omega + · have hr := congrArg (fun w : GaussianInt => w.re) hxe + have hi := congrArg (fun w : GaussianInt => w.im) hxe + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, + Zsqrtd.im_one] at hr hi + rw [hr, hi] + rcases hside with hside | hside <;> omega + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + have hside := (hvert z).mp hxor + rcases hside with ⟨hzi, hziu, hside⟩ + rcases hxe with hxe | hxe + · have hr := congrArg (fun w : GaussianInt => w.re) hxe + have hi := congrArg (fun w : GaussianInt => w.im) hxe + simp only [hr, hi] + rcases hside with hside | hside <;> omega + · have hr := congrArg (fun w : GaussianInt => w.re) hxe + have hi := congrArg (fun w : GaussianInt => w.im) hxe + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] at hr hi + rw [hr, hi] + rcases hside with hside | hside <;> omega + · rintro ⟨hxre0, hxreq, hxim0, hximq, hside⟩ + have hhorizontal (hs : x.im = 0 ∨ x.im = q) : + ∃ e, e ∈ BoundaryFootprintEdges (FordTile q) ∧ x ∈ e := by + by_cases hlt : x.re < q + · let z := x + have hcond : 0 ≤ z.re ∧ z.re < q ∧ + (z.im = 0 ∨ z.im = q) := by simpa [z] using And.intro hxre0 (And.intro hlt hs) + refine ⟨{z, z + 1}, ?_, ?_⟩ + · change ∃ w, _ + exact ⟨z, Or.inl ⟨rfl, (hhoriz z).mpr hcond⟩⟩ + · simp [z] + · have hxeq : x.re = q := by omega + let z := x - 1 + have hcond : 0 ≤ z.re ∧ z.re < q ∧ + (z.im = 0 ∨ z.im = q) := by + simpa [z, hxeq] using And.intro (show 0 ≤ x.re - 1 by omega) + (And.intro (show x.re - 1 < q by omega) (by simp [hs])) + refine ⟨{z, z + 1}, ?_, ?_⟩ + · change ∃ w, _ + exact ⟨z, Or.inl ⟨rfl, (hhoriz z).mpr hcond⟩⟩ + · simp [z] + have hvertical (hs : x.re = 0 ∨ x.re = q) : + ∃ e, e ∈ BoundaryFootprintEdges (FordTile q) ∧ x ∈ e := by + by_cases hlt : x.im < q + · let z := x + have hcond : 0 ≤ z.im ∧ z.im < q ∧ + (z.re = 0 ∨ z.re = q) := by simpa [z] using And.intro hxim0 (And.intro hlt hs) + refine ⟨{z, z + ⟨0, 1⟩}, ?_, ?_⟩ + · change ∃ w, _ + exact ⟨z, Or.inr ⟨rfl, (hvert z).mpr hcond⟩⟩ + · simp [z] + · have hxeq : x.im = q := by omega + let z := x - ⟨0, 1⟩ + have hcond : 0 ≤ z.im ∧ z.im < q ∧ + (z.re = 0 ∨ z.re = q) := by + simpa [z, hxeq] using And.intro (show 0 ≤ x.im - 1 by omega) + (And.intro (show x.im - 1 < q by omega) (by simp [hs])) + refine ⟨{z, z + ⟨0, 1⟩}, ?_, ?_⟩ + · change ∃ w, _ + exact ⟨z, Or.inr ⟨rfl, (hvert z).mpr hcond⟩⟩ + · simp [z] + simp only [BoundaryFootprintVertices, ite_eq_left hFcells, + Set.mem_ofPred_eq] + rcases hside with hside | hside | hside | hside + · obtain ⟨e, he, hx⟩ := hvertical (Or.inl hside) + exact ⟨e, he, hx⟩ + · obtain ⟨e, he, hx⟩ := hvertical (Or.inr hside) + exact ⟨e, he, hx⟩ + · obtain ⟨e, he, hx⟩ := hhorizontal (Or.inl hside) + exact ⟨e, he, hx⟩ + · obtain ⟨e, he, hx⟩ := hhorizontal (Or.inr hside) + exact ⟨e, he, hx⟩ + +end CanonicalSupport + +theorem P4062T1CanonicalSupport (q : Nat) (hqpos : 0 < q) : + FootprintVertices (FordTile q) = FordVertexDomain q ∧ + BoundaryFootprintVertices (FordTile q) = + {x | 0 ≤ x.re ∧ x.re ≤ (q : Int) ∧ + 0 ≤ x.im ∧ x.im ≤ (q : Int) ∧ + (x.re = 0 ∨ x.re = (q : Int) ∨ x.im = 0 ∨ x.im = (q : Int))} := by +-- BODY + classical + have hcellCoord (z : GaussianInt) : + z ∈ FordCellDomain q ↔ + 0 ≤ z.re ∧ z.re < (q : Int) ∧ + 0 ≤ z.im ∧ z.im < (q : Int) := CanonicalSupport.hcellCoord q z + have hfootSquare : + FootprintVertices (FordTile q) = FordVertexDomain q := CanonicalSupport.hfootSquare q hqpos + have hFcells : (FordTile q).cells.Nonempty := CanonicalSupport.hFcells q hqpos + have hcellTiles (z : GaussianInt) : + z ∈ (FordTile q).cells ↔ + 0 ≤ z.re ∧ z.re < (q : Int) ∧ + 0 ≤ z.im ∧ z.im < (q : Int) := CanonicalSupport.hcellTiles q z + have hhoriz (z : GaussianInt) : + ((z ∈ (FordTile q).cells ∧ z - ⟨0, 1⟩ ∉ (FordTile q).cells) ∨ + (z ∉ (FordTile q).cells ∧ z - ⟨0, 1⟩ ∈ (FordTile q).cells)) ↔ + 0 ≤ z.re ∧ z.re < (q : Int) ∧ + (z.im = 0 ∨ z.im = q) := CanonicalSupport.hhoriz q z + have hvert (z : GaussianInt) : + ((z ∈ (FordTile q).cells ∧ z - 1 ∉ (FordTile q).cells) ∨ + (z ∉ (FordTile q).cells ∧ z - 1 ∈ (FordTile q).cells)) ↔ + 0 ≤ z.im ∧ z.im < (q : Int) ∧ + (z.re = 0 ∨ z.re = q) := CanonicalSupport.hvert q z + have hboundarySquare : + BoundaryFootprintVertices (FordTile q) = + {x | 0 ≤ x.re ∧ x.re ≤ (q : Int) ∧ + 0 ≤ x.im ∧ x.im ≤ (q : Int) ∧ + (x.re = 0 ∨ x.re = (q : Int) ∨ + x.im = 0 ∨ x.im = (q : Int))} := CanonicalSupport.hboundarySquare q hqpos + exact ⟨hfootSquare, hboundarySquare⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean new file mode 100644 index 0000000000..94229c2403 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean @@ -0,0 +1,550 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4062T1RecursiveInteriors +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent + +-- [TABLET NODE: P4062T1InteriorGeometry] + +/-! +# P4062T1InteriorGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace InteriorGeometryProof + +private theorem hsum : + ∀ (P : FordFareyParameter), P.q = P.q₁ + P.q₂ := by + classical + intro P + exact P.sum_q + +private theorem hq1pos : + ∀ (P : FordFareyParameter), (2 < P.q) → ((P.q = P.q₁ + P.q₂) → (0 < P.q₁)) := by + classical + intro P hP hsum + by_contra h + have hz : P.q₁ = 0 := Nat.eq_zero_of_not_pos h + have hd := P.det₁ + rw [hz] at hd + simp only [Nat.cast_zero, zero_mul] at hd + have hqint : 2 < (P.q : Int) := by exact_mod_cast hP + by_cases hp : P.p₁ ≤ 0 + · have hqnonneg : 0 ≤ (P.q : Int) := by omega + have : P.p₁ * (P.q : Int) ≤ 0 := mul_nonpos_of_nonpos_of_nonneg hp hqnonneg + omega + · have hp' : 1 ≤ P.p₁ := by omega + nlinarith + +private theorem squareCoordinates : + ∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ + 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ + 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 := by + classical + intro q x + unfold P4062T1InteriorSquare + constructor + · intro hx + obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hx + obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab + exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, + (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ + · intro h + exact Finset.mem_image.mpr ⟨(x.re, x.im), + Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨h.1, h.2.1⟩, + Finset.mem_Icc.mpr h.2.2⟩, by cases x; rfl⟩ + +private theorem coord0 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : + Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → (∀ (x : GaussianInt), (x ∈ A 0) → (1 ≤ x.re + ∧ x.re ≤ (P.q₁ : Int)-1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q₁ : Int)-1)) := by + classical + intro P A squareCoordinates x hx + simpa [A, P4062T1RecursiveInteriors] using (squareCoordinates P.q₁ x).mp hx + +private theorem coord1 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (P.q = P.q₁ + P.q₂) → ((∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ + x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → (∀ (x : GaussianInt), (x + ∈ A 1) → ((P.q₂ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + (P.q₂ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1))) := by + classical + intro P A hsum squareCoordinates x hx + dsimp [A, P4062T1RecursiveInteriors] at hx + obtain ⟨z, hz, rfl⟩ := Finset.mem_image.mp hx + have hb := (squareCoordinates P.q₁ z).mp hz + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at * + constructor <;> omega + +private theorem coord2 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (P.q = P.q₁ + P.q₂) → ((∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ + x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → (∀ (x : GaussianInt), (x + ∈ A 2) → ((P.q₁ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q₂ : Int)-1))) := by + classical + intro P A hsum squareCoordinates x hx + dsimp [A, P4062T1RecursiveInteriors] at hx + obtain ⟨z, hz, rfl⟩ := Finset.mem_image.mp hx + have hb := (squareCoordinates P.q₂ z).mp hz + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at * + constructor <;> omega + +private theorem coord3 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (P.q = P.q₁ + P.q₂) → ((∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ + x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → (∀ (x : GaussianInt), (x + ∈ A 3) → (1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 ∧ + (P.q₁ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1))) := by + classical + intro P A hsum squareCoordinates x hx + dsimp [A, P4062T1RecursiveInteriors] at hx + obtain ⟨z, hz, rfl⟩ := Finset.mem_image.mp hx + have hb := (squareCoordinates P.q₂ z).mp hz + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at * + constructor <;> omega + +private theorem mem0 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : + Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → ((∀ (x : GaussianInt), (x ∈ A 0) → (1 ≤ + x.re ∧ x.re ≤ (P.q₁ : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (P.q₁ : Int)-1)) → (∀ (x : GaussianInt), + x ∈ A 0 ↔ + 1 ≤ x.re ∧ x.re ≤ (P.q₁ : Int)-1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q₁ : Int)-1)) := by + classical + intro P A squareCoordinates coord0 x + constructor + · exact coord0 x + · intro h + exact (squareCoordinates P.q₁ x).mpr h + +private theorem mem1 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (P.q = P.q₁ + P.q₂) → ((∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ + x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → ((∀ (x : GaussianInt), + (x ∈ A 1) → ((P.q₂ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ (P.q₂ : Int)+1 ≤ x.im ∧ x.im + ≤ (P.q : Int)-1)) → (∀ (x : GaussianInt), x ∈ A 1 ↔ + (P.q₂ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + (P.q₂ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1))) := by + classical + intro P A hsum squareCoordinates coord1 x + constructor + · exact coord1 x + · intro h + apply Finset.mem_image.mpr + refine ⟨x - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩, ?_, ?_⟩ + · apply (squareCoordinates P.q₁ _).mpr + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + constructor <;> omega + · ext <;> simp [ + ] + +private theorem mem2 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (P.q = P.q₁ + P.q₂) → ((∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ + x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → ((∀ (x : GaussianInt), + (x ∈ A 2) → ((P.q₁ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (P.q₂ : + Int)-1)) → (∀ (x : GaussianInt), x ∈ A 2 ↔ + (P.q₁ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q₂ : Int)-1))) := by + classical + intro P A hsum squareCoordinates coord2 x + constructor + · exact coord2 x + · intro h + apply Finset.mem_image.mpr + refine ⟨x - ⟨(P.q₁ : Int), 0⟩, ?_, ?_⟩ + · apply (squareCoordinates P.q₂ _).mpr + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + constructor <;> omega + · ext <;> simp [ + ] + +private theorem mem3 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (P.q = P.q₁ + P.q₂) → ((∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ + x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → ((∀ (x : GaussianInt), + (x ∈ A 3) → (1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 ∧ (P.q₁ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : + Int)-1)) → (∀ (x : GaussianInt), x ∈ A 3 ↔ + 1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 ∧ + (P.q₁ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1))) := by + classical + intro P A hsum squareCoordinates coord3 x + constructor + · exact coord3 x + · intro h + apply Finset.mem_image.mpr + refine ⟨x - ⟨0, (P.q₁ : Int)⟩, ?_, ?_⟩ + · apply (squareCoordinates P.q₂ _).mpr + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + constructor <;> omega + · ext <;> simp [ + ] + +private theorem bounds : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (∀ (x : GaussianInt), (x ∈ A 0) → (1 ≤ x.re ∧ x.re ≤ (P.q₁ : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (P.q₁ + : Int)-1)) → ((∀ (x : GaussianInt), (x ∈ A 1) → ((P.q₂ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : + Int)-1 ∧ (P.q₂ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1)) → ((∀ (x : GaussianInt), (x ∈ A + 2) → ((P.q₁ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (P.q₂ : Int)-1)) → + ((∀ (x : GaussianInt), (x ∈ A 3) → (1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 ∧ (P.q₁ : Int)+1 ≤ + x.im ∧ x.im ≤ (P.q : Int)-1)) → (∀ (i : Fin 4), ∀ (x : GaussianInt), (x ∈ A i) → ((i = 0 + → 1 ≤ x.re ∧ x.re ≤ (P.q₁ : Int)-1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q₁ : Int)-1) ∧ + (i = 1 → (P.q₂ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + (P.q₂ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1) ∧ + (i = 2 → (P.q₁ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q₂ : Int)-1) ∧ + (i = 3 → 1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 ∧ + (P.q₁ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1)))))) := by + classical + intro P A coord0 coord1 coord2 coord3 i x hx + constructor + · intro hi + subst i + exact coord0 x hx + constructor + · intro hi + subst i + exact coord1 x hx + constructor + · intro hi + subst i + exact coord2 x hx + · intro hi + subst i + exact coord3 x hx + +private theorem adjacentCoordinates : + ∀ (x : GaussianInt), ∀ (y : GaussianInt), (FourNeighborAdjacent x y) → ((x.re = y.re ∧ (y.im + = x.im+1 ∨ x.im = y.im+1)) ∨ + (x.im = y.im ∧ (y.re = x.re+1 ∨ x.re = y.re+1))) := by + classical + intro x y h + rcases h with h | h | h | h + · subst y + simp [Zsqrtd.re_add, Zsqrtd.im_add] + · subst y + simp [Zsqrtd.re_sub, Zsqrtd.im_sub] + · subst y + simp [Zsqrtd.re_add, Zsqrtd.im_add] + · subst y + simp [Zsqrtd.re_sub, Zsqrtd.im_sub] + +private theorem adjacentSymm : + ∀ (x : GaussianInt), ∀ (y : GaussianInt), (FourNeighborAdjacent x y) → (FourNeighborAdjacent + y x) := by + classical + intro x y h + rcases h with h | h | h | h <;> subst y <;> + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + +private theorem separate01 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (P.q = P.q₁ + P.q₂) → ((∀ (x : GaussianInt), x ∈ A 0 ↔ 1 ≤ x.re ∧ x.re ≤ (P.q₁ : Int)-1 ∧ 1 ≤ + x.im ∧ x.im ≤ (P.q₁ : Int)-1) → ((∀ (x : GaussianInt), x ∈ A 1 ↔ (P.q₂ : Int)+1 ≤ x.re ∧ + x.re ≤ (P.q : Int)-1 ∧ (P.q₂ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1) → ((∀ (x : + GaussianInt), ∀ (y : GaussianInt), (FourNeighborAdjacent x y) → ((x.re = y.re ∧ (y.im = + x.im+1 ∨ x.im = y.im+1)) ∨ (x.im = y.im ∧ (y.re = x.re+1 ∨ x.re = y.re+1)))) → (∀ (x : + GaussianInt), ∀ (y : GaussianInt), (x ∈ A 0) → ((x ∉ A 1) → ((y ∈ A 1) → ((y ∉ A 0) → + ((FourNeighborAdjacent x y) → (False))))))))) := by + classical + intro P A hsum mem0 mem1 adjacentCoordinates x y hx hxn hy hyn hxy + have bx := mem0 x |>.mp hx + have byy := mem1 y |>.mp hy + have hn1 : ¬ ((P.q₂ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + (P.q₂ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1) := by + intro h + exact hxn ((mem1 x).mpr h) + have hn0 : ¬ (1 ≤ y.re ∧ y.re ≤ (P.q₁ : Int)-1 ∧ + 1 ≤ y.im ∧ y.im ≤ (P.q₁ : Int)-1) := by + intro h + exact hyn ((mem0 y).mpr h) + by_cases hle : P.q₁ ≤ P.q₂ + · rcases adjacentCoordinates x y hxy with ⟨hre, hs⟩ | ⟨him, hs⟩ <;> omega + · have hgt : P.q₂ < P.q₁ := by omega + have hxsmall : x.re ≤ P.q₂ ∨ x.im ≤ P.q₂ := by + by_contra h + push Not at h + apply hn1 + exact ⟨by omega, by omega, by omega, by omega⟩ + have hylarge : P.q₁ ≤ y.re ∨ P.q₁ ≤ y.im := by + by_contra h + push Not at h + apply hn0 + exact ⟨by omega, by omega, by omega, by omega⟩ + rcases adjacentCoordinates x y hxy with ⟨hre, hs⟩ | ⟨him, hs⟩ + all_goals rcases hxsmall with hxsmall | hxsmall <;> + rcases hylarge with hylarge | hylarge <;> omega + +private theorem separate23 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (P.q = P.q₁ + P.q₂) → ((0 < P.q₁) → ((∀ (x : GaussianInt), x ∈ A 2 ↔ (P.q₁ : Int)+1 ≤ x.re ∧ + x.re ≤ (P.q : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (P.q₂ : Int)-1) → ((∀ (x : GaussianInt), x ∈ A 3 + ↔ 1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 ∧ (P.q₁ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1) → ((∀ + (x : GaussianInt), ∀ (y : GaussianInt), (FourNeighborAdjacent x y) → ((x.re = y.re ∧ + (y.im = x.im+1 ∨ x.im = y.im+1)) ∨ (x.im = y.im ∧ (y.re = x.re+1 ∨ x.re = y.re+1)))) → (∀ + (x : GaussianInt), ∀ (y : GaussianInt), (x ∈ A 2) → ((x ∉ A 3) → ((y ∈ A 3) → ((y ∉ A 2) + → ((FourNeighborAdjacent x y) → (False)))))))))) := by + classical + intro P A hsum hq1pos mem2 mem3 adjacentCoordinates x y hx hxn hy hyn hxy + have bx := mem2 x |>.mp hx + have byy := mem3 y |>.mp hy + have hn3 : ¬ (1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 ∧ + (P.q₁ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1) := by + intro h + exact hxn ((mem3 x).mpr h) + have hn2 : ¬ ((P.q₁ : Int)+1 ≤ y.re ∧ y.re ≤ (P.q : Int)-1 ∧ + 1 ≤ y.im ∧ y.im ≤ (P.q₂ : Int)-1) := by + intro h + exact hyn ((mem2 y).mpr h) + by_cases hle : P.q₂ ≤ P.q₁ + · rcases adjacentCoordinates x y hxy with ⟨hre, hs⟩ | ⟨him, hs⟩ <;> omega + · have hgt : P.q₁ < P.q₂ := by omega + have hxout : P.q₂ ≤ x.re ∨ x.im ≤ P.q₁ := by + by_contra h + push Not at h + apply hn3 + exact ⟨by omega, by omega, by omega, by omega⟩ + have hyout : y.re ≤ P.q₁ ∨ P.q₂ ≤ y.im := by + by_contra h + push Not at h + apply hn2 + exact ⟨by omega, by omega, by omega, by omega⟩ + rcases adjacentCoordinates x y hxy with ⟨hre, hs⟩ | ⟨him, hs⟩ + all_goals rcases hxout with hxout | hxout <;> + rcases hyout with hyout | hyout <;> omega + +private theorem crossNo : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (∀ (x : GaussianInt), x ∈ A 0 ↔ 1 ≤ x.re ∧ x.re ≤ (P.q₁ : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (P.q₁ : + Int)-1) → ((∀ (x : GaussianInt), x ∈ A 1 ↔ (P.q₂ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + (P.q₂ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1) → ((∀ (x : GaussianInt), x ∈ A 2 ↔ (P.q₁ : + Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (P.q₂ : Int)-1) → ((∀ (x : + GaussianInt), x ∈ A 3 ↔ 1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 ∧ (P.q₁ : Int)+1 ≤ x.im ∧ x.im ≤ + (P.q : Int)-1) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (FourNeighborAdjacent x y) → + ((x.re = y.re ∧ (y.im = x.im+1 ∨ x.im = y.im+1)) ∨ (x.im = y.im ∧ (y.re = x.re+1 ∨ x.re = + y.re+1)))) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), (x ∈ A 0 ∨ x ∈ A 1) → ((y ∈ A 2 ∨ + y ∈ A 3) → ((FourNeighborAdjacent x y) → (False)))))))) := by + classical + intro P A mem0 mem1 mem2 mem3 adjacentCoordinates x y hx hy hxy + rcases hx with hx | hx <;> rcases hy with hy | hy + · have bx := mem0 x |>.mp hx + have byy := mem2 y |>.mp hy + rcases adjacentCoordinates x y hxy with ⟨hre, hs⟩ | ⟨him, hs⟩ <;> omega + · have bx := mem0 x |>.mp hx + have byy := mem3 y |>.mp hy + rcases adjacentCoordinates x y hxy with ⟨hre, hs⟩ | ⟨him, hs⟩ <;> omega + · have bx := mem1 x |>.mp hx + have byy := mem2 y |>.mp hy + rcases adjacentCoordinates x y hxy with ⟨hre, hs⟩ | ⟨him, hs⟩ <;> omega + · have bx := mem1 x |>.mp hx + have byy := mem3 y |>.mp hy + rcases adjacentCoordinates x y hxy with ⟨hre, hs⟩ | ⟨him, hs⟩ <;> omega + +end InteriorGeometryProof + +theorem P4062T1InteriorGeometry (P : FordFareyParameter) + (hP : 2 < P.q) : + let A := P4062T1RecursiveInteriors P + (∀ i, A i ⊆ P4062T1InteriorSquare P.q) ∧ + (∀ i j, ∀ x ∈ A i, x ∉ A j → ∀ y ∈ A j, y ∉ A i → + ¬ FourNeighborAdjacent x y) ∧ + Disjoint (A 0 ∪ A 1) (A 2 ∪ A 3) ∧ + (∀ x ∈ A 0 ∪ A 1, ∀ y ∈ A 2 ∪ A 3, + ¬ FourNeighborAdjacent x y) ∧ + (P.q₂ < P.q₁ → A 2 ∩ A 3 = ∅) ∧ + (P.q₁ < P.q₂ → A 0 ∩ A 1 = ∅) := by +-- BODY + classical + let A := P4062T1RecursiveInteriors P + have hsum : P.q = P.q₁ + P.q₂ := InteriorGeometryProof.hsum P + have hq1pos : 0 < P.q₁ := InteriorGeometryProof.hq1pos P hP hsum + have squareCoordinates (q : Nat) (x : GaussianInt) : + x ∈ P4062T1InteriorSquare q ↔ + 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ + 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 := InteriorGeometryProof.squareCoordinates q x + have coord0 (x : GaussianInt) (hx : x ∈ A 0) : + 1 ≤ x.re ∧ x.re ≤ (P.q₁ : Int)-1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q₁ : Int)-1 := InteriorGeometryProof.coord0 P squareCoordinates x hx + have coord1 (x : GaussianInt) (hx : x ∈ A 1) : + (P.q₂ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + (P.q₂ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1 := InteriorGeometryProof.coord1 P hsum + squareCoordinates x hx + have coord2 (x : GaussianInt) (hx : x ∈ A 2) : + (P.q₁ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q₂ : Int)-1 := InteriorGeometryProof.coord2 P hsum squareCoordinates x hx + have coord3 (x : GaussianInt) (hx : x ∈ A 3) : + 1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 ∧ + (P.q₁ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1 := InteriorGeometryProof.coord3 P hsum + squareCoordinates x hx + have mem0 (x : GaussianInt) : x ∈ A 0 ↔ + 1 ≤ x.re ∧ x.re ≤ (P.q₁ : Int)-1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q₁ : Int)-1 := InteriorGeometryProof.mem0 P squareCoordinates coord0 x + have mem1 (x : GaussianInt) : x ∈ A 1 ↔ + (P.q₂ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + (P.q₂ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1 := InteriorGeometryProof.mem1 P hsum + squareCoordinates coord1 x + have mem2 (x : GaussianInt) : x ∈ A 2 ↔ + (P.q₁ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q₂ : Int)-1 := InteriorGeometryProof.mem2 P hsum squareCoordinates + coord2 x + have mem3 (x : GaussianInt) : x ∈ A 3 ↔ + 1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 ∧ + (P.q₁ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1 := InteriorGeometryProof.mem3 P hsum + squareCoordinates coord3 x + have bounds (i : Fin 4) (x : GaussianInt) (hx : x ∈ A i) : + (i = 0 → 1 ≤ x.re ∧ x.re ≤ (P.q₁ : Int)-1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q₁ : Int)-1) ∧ + (i = 1 → (P.q₂ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + (P.q₂ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1) ∧ + (i = 2 → (P.q₁ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q₂ : Int)-1) ∧ + (i = 3 → 1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 ∧ + (P.q₁ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1) := InteriorGeometryProof.bounds P coord0 + coord1 coord2 coord3 i x hx + have adjacentCoordinates (x y : GaussianInt) (h : FourNeighborAdjacent x y) : + (x.re = y.re ∧ (y.im = x.im+1 ∨ x.im = y.im+1)) ∨ + (x.im = y.im ∧ (y.re = x.re+1 ∨ x.re = y.re+1)) := + InteriorGeometryProof.adjacentCoordinates x y h + have adjacentSymm (x y : GaussianInt) (h : FourNeighborAdjacent x y) : + FourNeighborAdjacent y x := InteriorGeometryProof.adjacentSymm x y h + have separate01 (x y : GaussianInt) (hx : x ∈ A 0) (hxn : x ∉ A 1) + (hy : y ∈ A 1) (hyn : y ∉ A 0) (hxy : FourNeighborAdjacent x y) : False := + InteriorGeometryProof.separate01 P hsum mem0 mem1 adjacentCoordinates x y hx hxn hy hyn + hxy + have separate23 (x y : GaussianInt) (hx : x ∈ A 2) (hxn : x ∉ A 3) + (hy : y ∈ A 3) (hyn : y ∉ A 2) (hxy : FourNeighborAdjacent x y) : False := + InteriorGeometryProof.separate23 P hsum hq1pos mem2 mem3 adjacentCoordinates x y hx hxn + hy hyn hxy + have crossNo (x y : GaussianInt) (hx : x ∈ A 0 ∨ x ∈ A 1) + (hy : y ∈ A 2 ∨ y ∈ A 3) (hxy : FourNeighborAdjacent x y) : False := + InteriorGeometryProof.crossNo P mem0 mem1 mem2 mem3 adjacentCoordinates x y hx hy hxy + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro i x hx + have hcoord : 1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1 := by + by_cases hi0 : i = 0 + · subst i + have h := coord0 x hx + exact ⟨h.1, by omega, h.2.2.1, by omega⟩ + by_cases hi1 : i = 1 + · subst i + have h := coord1 x hx + exact ⟨by omega, h.2.1, by omega, h.2.2.2⟩ + by_cases hi2 : i = 2 + · subst i + have h := coord2 x hx + exact ⟨by omega, h.2.1, h.2.2.1, by omega⟩ + · have hi3 : i = 3 := by omega + subst i + have h := coord3 x hx + exact ⟨h.1, by omega, by omega, h.2.2.2⟩ + exact (squareCoordinates P.q x).mpr hcoord + · intro i j x hx hxnot y hy hynot hadj + have hi : i = 0 ∨ i = 1 ∨ i = 2 ∨ i = 3 := by fin_cases i <;> simp + rcases hi with rfl | rfl | rfl | rfl + · have hj : j = 0 ∨ j = 1 ∨ j = 2 ∨ j = 3 := by fin_cases j <;> simp + rcases hj with rfl | rfl | rfl | rfl + · exact hxnot hx + · exact separate01 x y hx hxnot hy hynot hadj + · exact crossNo x y (Or.inl hx) (Or.inl hy) hadj + · exact crossNo x y (Or.inl hx) (Or.inr hy) hadj + · have hj : j = 0 ∨ j = 1 ∨ j = 2 ∨ j = 3 := by fin_cases j <;> simp + rcases hj with rfl | rfl | rfl | rfl + · exact separate01 y x hy hynot hx hxnot (adjacentSymm x y hadj) + · exact hxnot hx + · exact crossNo x y (Or.inr hx) (Or.inl hy) hadj + · exact crossNo x y (Or.inr hx) (Or.inr hy) hadj + · have hj : j = 0 ∨ j = 1 ∨ j = 2 ∨ j = 3 := by fin_cases j <;> simp + rcases hj with rfl | rfl | rfl | rfl + · exact False.elim (crossNo y x (Or.inl hy) (Or.inl hx) + (adjacentSymm x y hadj)) + · exact False.elim (crossNo y x (Or.inr hy) (Or.inl hx) + (adjacentSymm x y hadj)) + · exact hxnot hx + · exact separate23 x y hx hxnot hy hynot hadj + · have hj : j = 0 ∨ j = 1 ∨ j = 2 ∨ j = 3 := by fin_cases j <;> simp + rcases hj with rfl | rfl | rfl | rfl + · exact False.elim (crossNo y x (Or.inl hy) (Or.inr hx) + (adjacentSymm x y hadj)) + · exact False.elim (crossNo y x (Or.inr hy) (Or.inr hx) + (adjacentSymm x y hadj)) + · exact separate23 y x hy hynot hx hxnot (adjacentSymm x y hadj) + · exact hxnot hx + · apply Finset.disjoint_left.mpr + intro x hx hy + rcases Finset.mem_union.mp hx with hx | hx + · rcases Finset.mem_union.mp hy with hy | hy + · have bx := mem0 x |>.mp hx + have byy := mem2 x |>.mp hy + omega + · have bx := mem0 x |>.mp hx + have byy := mem3 x |>.mp hy + omega + · rcases Finset.mem_union.mp hy with hy | hy + · have bx := mem1 x |>.mp hx + have byy := mem2 x |>.mp hy + omega + · have bx := mem1 x |>.mp hx + have byy := mem3 x |>.mp hy + omega + · intro x hx y hy hadj + rcases Finset.mem_union.mp hx with hx | hx + · rcases Finset.mem_union.mp hy with hy | hy + · exact crossNo x y (Or.inl hx) (Or.inl hy) hadj + · exact crossNo x y (Or.inl hx) (Or.inr hy) hadj + · rcases Finset.mem_union.mp hy with hy | hy + · exact crossNo x y (Or.inr hx) (Or.inl hy) hadj + · exact crossNo x y (Or.inr hx) (Or.inr hy) hadj + · intro h + change A 2 ∩ A 3 = ∅ + ext x + simp only [Finset.mem_inter, Finset.notMem_empty] + constructor + · rintro ⟨hx2, hx3⟩ + have b2 := mem2 x |>.mp hx2 + have b3 := mem3 x |>.mp hx3 + omega + · intro h + cases h + · intro h + change A 0 ∩ A 1 = ∅ + ext x + simp only [Finset.mem_inter, Finset.notMem_empty] + constructor + · rintro ⟨hx0, hx1⟩ + have b0 := mem0 x |>.mp hx0 + have b1 := mem1 x |>.mp hx1 + omega + · intro h + cases h + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1InteriorSquare.lean b/LeanPool/ApollonianSuperharmonic/P4062T1InteriorSquare.lean new file mode 100644 index 0000000000..04d3250b52 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4062T1InteriorSquare.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import Mathlib.Data.Int.Interval + +-- [TABLET NODE: P4062T1InteriorSquare] + +/-! +# P4062T1InteriorSquare + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For an integer denominator $q\geq0$, let $D_q$ be the finite set of lattice +vertices $(a,b)$ with $1\leq a,b\leq q-1$. +-/ +def P4062T1InteriorSquare (q : Nat) : Finset GaussianInt := +-- BODY + ((Finset.Icc (1 : Int) ((q : Int) - 1)).product + (Finset.Icc (1 : Int) ((q : Int) - 1))).image + (fun a => (⟨a.1, a.2⟩ : GaussianInt)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean b/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean new file mode 100644 index 0000000000..cf200409f7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean @@ -0,0 +1,543 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport +public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorSquare + +-- [TABLET NODE: P4062T1LiteralReduction] + +/-! +# P4062T1LiteralReduction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace LiteralReductionGeometry + +private theorem squareCoordinates : + (by + classical + exact + ∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : + Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 ) := by + classical + intro q x + unfold P4062T1InteriorSquare + constructor + · intro hx + obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hx + obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab + exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, + (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ + · intro h + exact Finset.mem_image.mpr ⟨(x.re, x.im), + Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨h.1, h.2.1⟩, + Finset.mem_Icc.mpr h.2.2⟩, by cases x; rfl⟩ + +private theorem hcurv : + (by + classical + exact + ∀ (P : FordFareyParameter), 0 < (FordCircleCoordinate P.p P.q).1 ) := by + classical + intro P + change (0 : ℤ) < ((P.q * P.q : Nat) : ℤ) + exact_mod_cast Nat.mul_pos P.q_pos P.q_pos + +private theorem hFcells : + (by + classical + exact + ∀ (P : FordFareyParameter), (FordTile P.q).cells.Nonempty ) := by + classical + intro P + refine ⟨⟨0, 0⟩, ?_⟩ + simp? [FordTile, FordCellDomain] + exact P.q_pos + +private theorem hTcells : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (u : GaussianInt), (T.cells = (TileTranslation (FordTile P.q) + u).cells ∧ (T.cells = ∅ → T.anchor = (TileTranslation (FordTile P.q) u).anchor) ∧ ∃ + (a : GaussianInt) (b : ℤ), (∀ (x : GaussianInt), x ∈ h.domain ↔ x - u ∈ k.domain) ∧ ∀ + x ∈ h.domain, h.value x = k.value (x - u) + a.re * x.re + a.im * x.im + b) → + (((FordTile P.q).cells.Nonempty) → (T.cells.Nonempty)) ) := by + classical + intro P T h k u htrans hFcells + rw [htrans.1] + simpa [TileTranslation] using hFcells.image (GaussianTranslation u) + +private theorem hboundaryTransport : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (u : GaussianInt), (T.cells = (TileTranslation (FordTile P.q) + u).cells ∧ (T.cells = ∅ → T.anchor = (TileTranslation (FordTile P.q) u).anchor) ∧ ∃ + (a : GaussianInt) (b : ℤ), (∀ (x : GaussianInt), x ∈ h.domain ↔ x - u ∈ k.domain) ∧ ∀ + x ∈ h.domain, h.value x = k.value (x - u) + a.re * x.re + a.im * x.im + b) → + (((TileTranslation (FordTile P.q) u).cells.Nonempty) → (BoundaryFootprintVertices T = + GaussianTranslation u '' BoundaryFootprintVertices (FordTile P.q))) ) := by + classical + intro P T h k u htrans htranslatedCells + have heq : BoundaryFootprintVertices T = + BoundaryFootprintVertices (TileTranslation (FordTile P.q) u) := by + simp [BoundaryFootprintVertices, BoundaryFootprintEdges, + htranslatedCells, htrans.1] + exact heq.trans + (TileTranslationFormulas (FordTile P.q) u).2.2.2.2.2.2.2.1 + +private theorem hboundaryPoint : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), + (BoundaryFootprintVertices T = GaussianTranslation u '' BoundaryFootprintVertices + (FordTile P.q)) → (∀ (x : GaussianInt), x ∈ BoundaryFootprintVertices T ↔ x - u ∈ + BoundaryFootprintVertices (FordTile P.q)) ) := by + classical + intro P T u hboundaryTransport x + rw [hboundaryTransport] + simp only [Set.mem_image] + constructor + · rintro ⟨y, hy, heq⟩ + have heq' : y + u = x := by simpa [GaussianTranslation] using heq + rw [← heq'] + simpa using hy + · intro hy + refine ⟨x - u, hy, ?_⟩ + simp [GaussianTranslation] + +private theorem hstrictTranslation : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (u : GaussianInt), (∀ (x : GaussianInt), x ∈ h.domain ↔ x - u ∈ + k.domain) → ((∀ (x : GaussianInt), x ∈ BoundaryFootprintVertices T ↔ x - u ∈ + BoundaryFootprintVertices (FordTile P.q)) → (h.domain.filter (fun x => @decide (x ∉ + BoundaryFootprintVertices T) (Classical.propDecidable _)) = (k.domain.filter (fun y + => @decide (y ∉ BoundaryFootprintVertices (FordTile P.q)) (Classical.propDecidable + _))).image (GaussianTranslation u))) ) := by + classical + intro P T h k u hdomshift hboundaryPoint + classical + ext x + simp only [Finset.mem_filter, Finset.mem_image] + constructor + · rintro ⟨hxdom, hxnot⟩ + have hyDom := (hdomshift x).mp hxdom + have hxnot' : x ∉ BoundaryFootprintVertices T := + @of_decide_eq_true _ (Classical.propDecidable _) hxnot + have hyNot : x - u ∉ BoundaryFootprintVertices (FordTile P.q) := by + intro hyb + exact hxnot' ((hboundaryPoint x).2 hyb) + refine ⟨x - u, ⟨hyDom, ?_⟩, ?_⟩ + · simp [hyNot] + · simp [GaussianTranslation] + · rintro ⟨y, ⟨hydom, hynot⟩, heq⟩ + have heq' : y + u = x := by simpa [GaussianTranslation] using heq + have hnot : y ∉ BoundaryFootprintVertices (FordTile P.q) := + @of_decide_eq_true _ (Classical.propDecidable _) hynot + have hxdom : x ∈ h.domain := by + apply (hdomshift x).mpr + have hxy : x - u = y := by calc + x - u = (y + u) - u := by rw [heq'] + _ = y := by abel + rw [hxy] + exact hydom + have hxnot : x ∉ BoundaryFootprintVertices T := by + intro hxb + have hyb := (hboundaryPoint x).mp hxb + have hxy : x - u = y := by calc + x - u = (y + u) - u := by rw [heq'] + _ = y := by abel + exact hnot (hxy ▸ hyb) + exact ⟨hxdom, by simp [hxnot]⟩ + +private theorem hstrictBounds : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (k : PartialOdometer), ((↑k.domain : Set GaussianInt) = + FordVertexDomain P.q) → ((0 < P.q) → ((BoundaryFootprintVertices (FordTile P.q) = {x + : GaussianInt | (0 : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q : + ℤ) ∧ (x.re = (0 : ℤ) ∨ x.re = (↑P.q : ℤ) ∨ x.im = (0 : ℤ) ∨ x.im = (↑P.q : ℤ))}) → (∀ + (y : GaussianInt), (y ∈ k.domain) → ((y ∉ BoundaryFootprintVertices (FordTile P.q)) → + (1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ 1 ≤ y.im ∧ y.im ≤ (P.q : Int) - 1))))) ) := by + classical + intro P k hkdom hqpos hboundarySquare y hy hynot + have hybox : 0 ≤ y.re ∧ y.re ≤ (P.q : Int) ∧ + 0 ≤ y.im ∧ y.im ≤ (P.q : Int) := by + have hy' : y ∈ FordVertexDomain P.q := by + have hset : y ∈ (k.domain : Set GaussianInt) := hy + rw [hkdom] at hset + exact hset + simpa [FordVertexDomain] using hy' + rw [hboundarySquare] at hynot + simp only [Set.mem_ofPred_eq] at hynot + omega + +private theorem hDcoords : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (u : GaussianInt), (h.domain.filter (fun x => @decide (x ∉ + BoundaryFootprintVertices T) (Classical.propDecidable _)) = (k.domain.filter (fun y + => @decide (y ∉ BoundaryFootprintVertices (FordTile P.q)) (Classical.propDecidable + _))).image (GaussianTranslation u)) → ((∀ (y : GaussianInt), (y ∈ k.domain) → ((y ∉ + BoundaryFootprintVertices (FordTile P.q)) → (1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ 1 ≤ + y.im ∧ y.im ≤ (P.q : Int) - 1))) → (∀ x, x ∈ h.domain.filter (fun x => @decide (x ∉ + BoundaryFootprintVertices T) (Classical.propDecidable _)) → 1 ≤ (x - u).re ∧ (x - + u).re ≤ (P.q : Int) - 1 ∧ 1 ≤ (x - u).im ∧ (x - u).im ≤ (P.q : Int) - 1)) ) := by + classical + intro P T h k u hstrictTranslation hstrictBounds x hx + rw [hstrictTranslation] at hx + rcases Finset.mem_image.mp hx with ⟨y, hy, heq⟩ + rcases Finset.mem_filter.mp hy with ⟨hydom, hynot⟩ + have hynot' : y ∉ BoundaryFootprintVertices (FordTile P.q) := + @of_decide_eq_true _ (Classical.propDecidable _) hynot + have hbounds := hstrictBounds y hydom hynot' + have heq' : y + u = x := by simpa [GaussianTranslation] using heq + have hxy : x - u = y := by calc + x - u = (y + u) - u := by rw [heq'] + _ = y := by abel + rw [hxy] + exact hbounds + +private theorem hcanonicalFoot : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (k : PartialOdometer), ((↑k.domain : Set GaussianInt) = + FordVertexDomain P.q) → (∀ (y : GaussianInt), (0 ≤ y.re) → ((y.re ≤ (P.q : Int)) → + ((0 ≤ y.im) → ((y.im ≤ (P.q : Int)) → (y ∈ k.domain))))) ) := by + classical + intro P k hkdom y hy hy' hz hz' + have hbox : y ∈ FordVertexDomain P.q := by + simp? [FordVertexDomain] + exact ⟨hy, hy', hz, hz'⟩ + have hset : y ∈ (k.domain : Set GaussianInt) := by + rw [hkdom] + exact hbox + exact hset + +private theorem hcanonicalDomain : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (k : PartialOdometer), (∀ (y : GaussianInt), (0 ≤ y.re) → + ((y.re ≤ (P.q : Int)) → ((0 ≤ y.im) → ((y.im ≤ (P.q : Int)) → (y ∈ k.domain))))) → (∀ + (y : GaussianInt), (1 ≤ y.re) → ((y.re ≤ (P.q : Int) - 1) → ((1 ≤ y.im) → ((y.im ≤ + (P.q : Int) - 1) → (y ∈ k.domain))))) ) := by + classical + intro P k hcanonicalFoot y hy hy' hz hz' + apply hcanonicalFoot y <;> omega + +private theorem hstencilDomain : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (u : GaussianInt), (∀ (x : GaussianInt), x ∈ h.domain ↔ x - u ∈ + k.domain) → ((∀ x, x ∈ h.domain.filter (fun x => @decide (x ∉ + BoundaryFootprintVertices T) (Classical.propDecidable _)) → 1 ≤ (x - u).re ∧ (x - + u).re ≤ (P.q : Int) - 1 ∧ 1 ≤ (x - u).im ∧ (x - u).im ≤ (P.q : Int) - 1) → ((∀ (y : + GaussianInt), (0 ≤ y.re) → ((y.re ≤ (P.q : Int)) → ((0 ≤ y.im) → ((y.im ≤ (P.q : + Int)) → (y ∈ k.domain))))) → (∀ (x : GaussianInt), (x ∈ h.domain.filter (fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _))) → (x ∈ + h.domain ∧ x - 1 ∈ h.domain ∧ x + 1 ∈ h.domain ∧ x - ⟨0, 1⟩ ∈ h.domain ∧ x + ⟨0, + 1⟩ ∈ h.domain)))) ) := by + classical + intro P T h k u hdomshift hDcoords hcanonicalFoot x hx + have hcoord := hDcoords x hx + rcases hcoord with ⟨hr, hr', hi, hi'⟩ + let y := x - u + have hyr : 1 ≤ y.re := by simpa [y] using hr + have hyr' : y.re ≤ (P.q : Int) - 1 := by simpa [y] using hr' + have hyi : 1 ≤ y.im := by simpa [y] using hi + have hyi' : y.im ≤ (P.q : Int) - 1 := by simpa [y] using hi' + have hrePlus : (y + 1).re = y.re + 1 := by simp + have hreMinus : (y - 1).re = y.re - 1 := by simp + have himPlus : (y + ⟨0, 1⟩).im = y.im + 1 := by simp + have himMinus : (y - ⟨0, 1⟩).im = y.im - 1 := by simp + have hreSamePlus : (y + 1).im = y.im := by simp + have hreSameMinus : (y - 1).im = y.im := by simp + have himSamePlus : (y + ⟨0, 1⟩).re = y.re := by simp + have himSameMinus : (y - ⟨0, 1⟩).re = y.re := by simp + have hy : x - u ∈ k.domain := by + exact (hdomshift x).mp (Finset.mem_filter.mp hx).1 + have hEast : 0 ≤ (y + 1).re ∧ (y + 1).re ≤ (P.q : Int) ∧ + 0 ≤ (y + 1).im ∧ (y + 1).im ≤ (P.q : Int) := by + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, + Zsqrtd.im_one] + omega + have hWest : 0 ≤ (y - 1).re ∧ (y - 1).re ≤ (P.q : Int) ∧ + 0 ≤ (y - 1).im ∧ (y - 1).im ≤ (P.q : Int) := by + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, + Zsqrtd.im_one] + omega + have hNorth : 0 ≤ (y + ⟨0, 1⟩).re ∧ + (y + ⟨0, 1⟩).re ≤ (P.q : Int) ∧ + 0 ≤ (y + ⟨0, 1⟩).im ∧ (y + ⟨0, 1⟩).im ≤ (P.q : Int) := by + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] + omega + have hSouth : 0 ≤ (y - ⟨0, 1⟩).re ∧ + (y - ⟨0, 1⟩).re ≤ (P.q : Int) ∧ + 0 ≤ (y - ⟨0, 1⟩).im ∧ (y - ⟨0, 1⟩).im ≤ (P.q : Int) := by + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, + ] + omega + refine ⟨(hdomshift x).mpr hy, ?_, ?_, ?_, ?_⟩ + · apply (hdomshift (x - 1)).mpr + have hz := hcanonicalFoot (y - 1) hWest.1 hWest.2.1 + hWest.2.2.1 hWest.2.2.2 + simpa only [show x - 1 - u = (x - u) - 1 by abel] using hz + · apply (hdomshift (x + 1)).mpr + have hz := hcanonicalFoot (y + 1) hEast.1 hEast.2.1 + hEast.2.2.1 hEast.2.2.2 + simpa only [show x + 1 - u = (x - u) + 1 by abel] using hz + · apply (hdomshift (x - ⟨0, 1⟩)).mpr + have hz := hcanonicalFoot (y - ⟨0, 1⟩) hSouth.1 hSouth.2.1 + hSouth.2.2.1 hSouth.2.2.2 + simpa only [show x - ⟨0, 1⟩ - u = + (x - u) - ⟨0, 1⟩ by abel] using hz + · apply (hdomshift (x + ⟨0, 1⟩)).mpr + have hz := hcanonicalFoot (y + ⟨0, 1⟩) hNorth.1 hNorth.2.1 + hNorth.2.2.1 hNorth.2.2.2 + simpa only [show x + ⟨0, 1⟩ - u = + (x - u) + ⟨0, 1⟩ by abel] using hz + +private theorem hlapshift : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (h : PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (k + : PartialOdometer), (∀ x ∈ k.domain, k.value x = FordOdometer P x) → (∀ (u : + GaussianInt), ∀ (a : GaussianInt), ∀ (b : ℤ), (∀ (x : GaussianInt), x ∈ h.domain ↔ x + - u ∈ k.domain) → ((∀ x ∈ h.domain, h.value x = k.value (x - u) + a.re * x.re + a.im + * x.im + b) → (∀ (c : ℤ), (∀ x ∈ h.domain, g x = h.value x + c) → (∀ (x : + GaussianInt), (x ∈ h.domain) → ((x - 1 ∈ h.domain) → ((x + 1 ∈ h.domain) → ((x - ⟨0, + 1⟩ ∈ h.domain) → ((x + ⟨0, 1⟩ ∈ h.domain) → (FourNeighborLaplacian g x = + FourNeighborLaplacian (FordOdometer P) (x - u)))))))))) ) := by + classical + intro P h g k hkval u a b hdomshift hvalueshift c hextval x hx hxm hxp hym hyp + have hg0 : g x = FordOdometer P (x - u) + + a.re * x.re + a.im * x.im + b + c := by + rw [hextval x hx, hvalueshift x hx, + hkval (x - u) ((hdomshift x).mp hx)] + have hgm : g (x - 1) = FordOdometer P ((x - u) - 1) + + a.re * (x - 1).re + a.im * (x - 1).im + b + c := by + rw [hextval (x - 1) hxm, hvalueshift (x - 1) hxm, + hkval (x - 1 - u) ((hdomshift (x - 1)).mp hxm)] + congr 1 + · congr 1 + abel + have hgp : g (x + 1) = FordOdometer P ((x - u) + 1) + + a.re * (x + 1).re + a.im * (x + 1).im + b + c := by + rw [hextval (x + 1) hxp, hvalueshift (x + 1) hxp, + hkval (x + 1 - u) ((hdomshift (x + 1)).mp hxp)] + congr 1 + · congr 1 + abel + have hgi : g (x - ⟨0, 1⟩) = + FordOdometer P ((x - u) - ⟨0, 1⟩) + + a.re * (x - ⟨0, 1⟩).re + a.im * (x - ⟨0, 1⟩).im + b + c := by + rw [hextval (x - ⟨0, 1⟩) hym, + hvalueshift (x - ⟨0, 1⟩) hym, + hkval (x - ⟨0, 1⟩ - u) + ((hdomshift (x - ⟨0, 1⟩)).mp hym)] + congr 1 + · congr 1 + abel + have hgo : g (x + ⟨0, 1⟩) = + FordOdometer P ((x - u) + ⟨0, 1⟩) + + a.re * (x + ⟨0, 1⟩).re + a.im * (x + ⟨0, 1⟩).im + b + c := by + rw [hextval (x + ⟨0, 1⟩) hyp, + hvalueshift (x + ⟨0, 1⟩) hyp, + hkval (x + ⟨0, 1⟩ - u) + ((hdomshift (x + ⟨0, 1⟩)).mp hyp)] + congr 1 + · congr 1 + abel + rw [FourNeighborLaplacian, hgm, hgp, hgi, hgo, hg0, + FourNeighborLaplacian] + rw [show x - u - 1 = (x - u) - 1 by abel, + show x - u + 1 = (x - u) + 1 by abel, + show x - u - ⟨0, 1⟩ = (x - u) - ⟨0, 1⟩ by rfl, + show x - u + ⟨0, 1⟩ = (x - u) + ⟨0, 1⟩ by rfl] + simp + ring + +private theorem hDcanCoords : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (k : PartialOdometer), (BoundaryFootprintVertices (FordTile + P.q) = {x : GaussianInt | (0 : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ x.im ∧ x.im + ≤ (↑P.q : ℤ) ∧ (x.re = (0 : ℤ) ∨ x.re = (↑P.q : ℤ) ∨ x.im = (0 : ℤ) ∨ x.im = (↑P.q : + ℤ))}) → ((∀ (y : GaussianInt), (y ∈ k.domain) → ((y ∉ BoundaryFootprintVertices + (FordTile P.q)) → (1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ 1 ≤ y.im ∧ y.im ≤ (P.q : Int) + - 1))) → ((∀ (y : GaussianInt), (1 ≤ y.re) → ((y.re ≤ (P.q : Int) - 1) → ((1 ≤ y.im) + → ((y.im ≤ (P.q : Int) - 1) → (y ∈ k.domain))))) → ( + let Dcan := k.domain.filter (fun y => + @decide (y ∉ BoundaryFootprintVertices (FordTile P.q)) + (Classical.propDecidable _)) + ∀ (y : GaussianInt), y ∈ Dcan ↔ 1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ 1 ≤ y.im ∧ y.im ≤ + (P.q : Int) - 1))) ) := by + classical + intro P k hboundarySquare hstrictBounds hcanonicalDomain Dcan y + constructor + · intro hy + rcases Finset.mem_filter.mp hy with ⟨hydom, hnotdec⟩ + have hnot : y ∉ BoundaryFootprintVertices (FordTile P.q) := + @of_decide_eq_true _ (Classical.propDecidable _) hnotdec + exact hstrictBounds y hydom hnot + · rintro ⟨hy0, hy1, hz0, hz1⟩ + have hydom := hcanonicalDomain y hy0 hy1 hz0 hz1 + have hnot : y ∉ BoundaryFootprintVertices (FordTile P.q) := by + rw [hboundarySquare] + simp only [Set.mem_ofPred_eq] + omega + refine Finset.mem_filter.mpr ⟨hydom, ?_⟩ + exact (@decide_eq_true_eq (y ∉ BoundaryFootprintVertices (FordTile P.q)) + (Classical.propDecidable _)).mpr hnot + +private theorem heqAt410 : + (by + classical + exact + ∀ (P : FordFareyParameter), (∀ (q : Nat), ∀ (x : GaussianInt), x ∈ + P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : + Int) - 1) → (∀ (k : PartialOdometer), + let Dcan := k.domain.filter (fun y => + @decide (y ∉ BoundaryFootprintVertices (FordTile P.q)) + (Classical.propDecidable _)) + (∀ (y : GaussianInt), y ∈ Dcan ↔ 1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ 1 ≤ y.im ∧ y.im ≤ + (P.q : Int) - 1) → (Dcan = P4062T1InteriorSquare P.q)) ) := by + classical + intro P squareCoordinates k Dcan hDcanCoords + ext x + exact (hDcanCoords x).trans (squareCoordinates P.q x).symm + +end LiteralReductionGeometry + +theorem P4062T1LiteralReduction : + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (g : + IntegerLatticeFunction), (BandPrototile (FordCircleCoordinate P.p P.q) T) → + ((TileOdometer (FordCircleCoordinate P.p P.q) T h) → (((h.domain : Set GaussianInt) = + FootprintVertices T) → ((GlobalOdometerExtends g h) → ( + let D := h.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _) + ∃ u : GaussianInt, + D = (P4062T1InteriorSquare P.q).image (fun x => x+u) ∧ + ∀ x ∈ D, FourNeighborLaplacian g x = + FourNeighborLaplacian (FordOdometer P) (x-u))))) := by + intro P T h g hT hodo hdom hext +-- BODY + classical + have squareCoordinates (q : Nat) (x : GaussianInt) : + x ∈ P4062T1InteriorSquare q ↔ + 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ + 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 := LiteralReductionGeometry.squareCoordinates q x + obtain ⟨k, hkodo, hkdom, hkval⟩ := FordTileOdometerRestriction P + have hcurv : 0 < (FordCircleCoordinate P.p P.q).1 := LiteralReductionGeometry.hcurv P + obtain ⟨u, htrans, _⟩ := + TileOdometerTranslationUniqueness (FordCircleCoordinate P.p P.q) + T (FordTile P.q) h k hcurv hodo hkodo + obtain ⟨a, b, hdomshift, hvalueshift⟩ := htrans.2.2 + obtain ⟨c, hextval⟩ := hext + have hqpos : 0 < P.q := P.q_pos + obtain ⟨hfootSquare, hboundarySquare⟩ := P4062T1CanonicalSupport P.q P.q_pos + have hFcells : (FordTile P.q).cells.Nonempty := LiteralReductionGeometry.hFcells P + have hTcells : T.cells.Nonempty := LiteralReductionGeometry.hTcells P T h k u htrans hFcells + have htranslatedCells : (TileTranslation (FordTile P.q) u).cells.Nonempty := by + simpa [TileTranslation] using hFcells.image (GaussianTranslation u) + have hboundaryTransport : + BoundaryFootprintVertices T = + GaussianTranslation u '' BoundaryFootprintVertices (FordTile P.q) := + LiteralReductionGeometry.hboundaryTransport P T h k u htrans htranslatedCells + have hboundaryPoint (x : GaussianInt) : + x ∈ BoundaryFootprintVertices T ↔ + x - u ∈ BoundaryFootprintVertices (FordTile P.q) := + LiteralReductionGeometry.hboundaryPoint P T u hboundaryTransport x + have hstrictTranslation : + h.domain.filter (fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _)) = + (k.domain.filter (fun y => + @decide (y ∉ BoundaryFootprintVertices (FordTile P.q)) + (Classical.propDecidable _))).image (GaussianTranslation u) := + LiteralReductionGeometry.hstrictTranslation P T h k u hdomshift hboundaryPoint + have hstrictBounds (y : GaussianInt) (hy : y ∈ k.domain) + (hynot : y ∉ BoundaryFootprintVertices (FordTile P.q)) : + 1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ + 1 ≤ y.im ∧ y.im ≤ (P.q : Int) - 1 := LiteralReductionGeometry.hstrictBounds P k hkdom + hqpos hboundarySquare y hy hynot + have hDcoords : ∀ x, x ∈ h.domain.filter (fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _)) → + 1 ≤ (x - u).re ∧ (x - u).re ≤ (P.q : Int) - 1 ∧ + 1 ≤ (x - u).im ∧ (x - u).im ≤ (P.q : Int) - 1 := LiteralReductionGeometry.hDcoords P T h + k u hstrictTranslation hstrictBounds + have hcanonicalFoot (y : GaussianInt) + (hy : 0 ≤ y.re) (hy' : y.re ≤ (P.q : Int)) + (hz : 0 ≤ y.im) (hz' : y.im ≤ (P.q : Int)) : + y ∈ k.domain := LiteralReductionGeometry.hcanonicalFoot P k hkdom y hy hy' hz hz' + have hcanonicalDomain (y : GaussianInt) + (hy : 1 ≤ y.re) (hy' : y.re ≤ (P.q : Int) - 1) + (hz : 1 ≤ y.im) (hz' : y.im ≤ (P.q : Int) - 1) : + y ∈ k.domain := LiteralReductionGeometry.hcanonicalDomain P k hcanonicalFoot y hy hy' hz hz' + have hstencilDomain (x : GaussianInt) + (hx : x ∈ h.domain.filter (fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _))) : + x ∈ h.domain ∧ x - 1 ∈ h.domain ∧ x + 1 ∈ h.domain ∧ + x - ⟨0, 1⟩ ∈ h.domain ∧ x + ⟨0, 1⟩ ∈ h.domain := LiteralReductionGeometry.hstencilDomain + P T h k u hdomshift hDcoords hcanonicalFoot x hx + have hlapshift (x : GaussianInt) (hx : x ∈ h.domain) + (hxm : x - 1 ∈ h.domain) (hxp : x + 1 ∈ h.domain) + (hym : x - ⟨0, 1⟩ ∈ h.domain) + (hyp : x + ⟨0, 1⟩ ∈ h.domain) : + FourNeighborLaplacian g x = + FourNeighborLaplacian (FordOdometer P) (x - u) := LiteralReductionGeometry.hlapshift P h + g k hkval u a b hdomshift hvalueshift c hextval x hx hxm hxp hym hyp + let Dcan := k.domain.filter (fun y => + @decide (y ∉ BoundaryFootprintVertices (FordTile P.q)) + (Classical.propDecidable _)) + have hDcanCoords (y : GaussianInt) : + y ∈ Dcan ↔ + 1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ + 1 ≤ y.im ∧ y.im ≤ (P.q : Int) - 1 := LiteralReductionGeometry.hDcanCoords P k + hboundarySquare hstrictBounds hcanonicalDomain y + let Dact := h.domain.filter (fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _)) + have himage : Dact = Dcan.image (GaussianTranslation u) := hstrictTranslation + have heq : Dcan = P4062T1InteriorSquare P.q := LiteralReductionGeometry.heqAt410 P + squareCoordinates k hDcanCoords + refine ⟨u, ?_, ?_⟩ + · change Dact = _ + rw [himage, heq] + rfl + · intro x hx + have hs := hstencilDomain x hx + exact hlapshift x hs.1 hs.2.1 hs.2.2.1 hs.2.2.2.1 hs.2.2.2.2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1OrientationTransport.lean b/LeanPool/ApollonianSuperharmonic/P4062T1OrientationTransport.lean new file mode 100644 index 0000000000..e20e41aaab --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4062T1OrientationTransport.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation + +-- [TABLET NODE: P4062T1OrientationTransport] + +/-! +# P4062T1OrientationTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4062T1OrientationTransport + (D E : Finset GaussianInt) (σ τ : GaussianInt → Int) + (u : GaussianInt) (hE : E = D.image (fun x => x + u)) + (hσ : ∀ x ∈ E, τ x = σ (x - u)) + (o : AcyclicIndegreeOrientation D σ) : + ∃ t : AcyclicIndegreeOrientation E τ, + (∀ x y, t.edge x y ↔ o.edge (x-u) (y-u)) ∧ + ∀ x, t.rank x = o.rank (x-u) := by +-- BODY + classical + have hm (x : GaussianInt) : x ∈ E ↔ x-u ∈ D := by + rw [hE] + constructor + · rintro hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx + simpa using hy + · intro hx + exact Finset.mem_image.mpr ⟨x-u, hx, by simp⟩ + have ha (x y : GaussianInt) : + FourNeighborAdjacent (x-u) (y-u) ↔ FourNeighborAdjacent x y := by + have cancel (a b v : GaussianInt) (h : a-u = b-u+v) : a=b+v := by + have he := congrArg (fun z => z+u) h + convert he using 1 <;> abel + unfold FourNeighborAdjacent + constructor <;> intro h + · rcases h with h | h | h | h + · left; exact cancel y x 1 h + · right; left + have he := cancel y x (-1) (by simpa only [sub_eq_add_neg] using h) + simpa only [sub_eq_add_neg] using he + · right; right; left; exact cancel y x ⟨0, 1⟩ h + · right; right; right + have he := cancel y x (-⟨0, 1⟩) (by simpa only [sub_eq_add_neg] using h) + simpa only [sub_eq_add_neg] using he + · rcases h with h | h | h | h + · left; rw [h]; abel + · right; left; rw [h]; abel + · right; right; left; rw [h]; abel + · right; right; right; rw [h]; abel + let t : AcyclicIndegreeOrientation E τ := { + edge := fun x y => o.edge (x-u) (y-u) + edge_decidable := fun x y => o.edge_decidable (x-u) (y-u) + rank := fun x => o.rank (x-u) + supported := by + intro x y he + obtain ⟨hx, hy, hxy⟩ := o.supported _ _ he + exact ⟨(hm x).mpr hx, (hm y).mpr hy, (ha x y).mp hxy⟩ + oriented := by + intro x hx y hy hxy + exact o.oriented _ ((hm x).mp hx) _ ((hm y).mp hy) ((ha x y).mpr hxy) + increasing := by intro x y he; exact o.increasing _ _ he + indegree := by + intro x hx + have hc : (E.filter (fun y => @decide (o.edge (y-u) (x-u)) + (o.edge_decidable (y-u) (x-u)))).card = + (D.filter (fun y => @decide (o.edge y (x-u)) + (o.edge_decidable y (x-u)))).card := by + apply Finset.card_bij (fun y _ => y-u) + · intro y hy + simp only [Finset.mem_filter, decide_eq_true_eq] at hy ⊢ + exact ⟨(hm y).mp hy.1, hy.2⟩ + · intro y hy z hz he + have he' := congrArg (fun w => w+u) he + simpa using he' + · intro z hz + simp only [Finset.mem_filter, decide_eq_true_eq] at hz + refine ⟨z+u, Finset.mem_filter.mpr ⟨(hm _).mpr (by simpa using hz.1), + by simpa using hz.2⟩, by simp⟩ + rw [hc, hσ x hx] + exact o.indegree (x-u) ((hm x).mp hx) } + exact ⟨t, fun _ _ => Iff.rfl, fun _ => rfl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean new file mode 100644 index 0000000000..4934e182e6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean @@ -0,0 +1,1141 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4062T1ParentalRestriction +public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist + +-- [TABLET NODE: P4062T1OverlapDescent] + +/-! +# P4062T1OverlapDescent + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OverlapDescentDetails + +private theorem squareCoordinates : + (by + classical + exact + ∀ (q : ℕ), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ (1 : ℤ) ≤ x.re ∧ x.re ≤ + (↑q : ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑q : ℤ) - (1 : ℤ) ) := by + classical + intro q x + unfold P4062T1InteriorSquare + constructor + · intro hx + obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hx + obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab + exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, + (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ + · intro h + exact Finset.mem_image.mpr ⟨(x.re, x.im), + Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨h.1, h.2.1⟩, + Finset.mem_Icc.mpr h.2.2⟩, by cases x; rfl⟩ + +private theorem hcrossdet : + (by + classical + exact + ∀ (P : FordFareyParameter), P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1 ) := by + classical + intro P + have hd := P.det₁ + have hsumI : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q + rw [hsumI, P.sum_p] at hd + nlinarith only [hd] + +private theorem hpos₁ : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (FordFareyParameter) → (((2 : ℕ) + < P.q) → ((P₁.q = P.q₁) → ((P.q = P.q₁ + P.q₂) → (0 < P.q₁)))) ) := by + classical + intro P P₁ P₂ hP hq₁ hsum + by_contra hn + have hz : P.q₁ = 0 := by omega + have hd : (P.q : Int) ∣ (1 : Int) := by + refine ⟨P.p₁, ?_⟩ + have h := P.det₁ + rw [hz] at h + have hm : P.p₁ * (P.q : Int) = 1 := by simpa using h + calc 1 = P.p₁ * (P.q : Int) := hm.symm + _ = (P.q : Int) * P.p₁ := by ring + have hq : 2 < (P.q : Int) := by exact_mod_cast hP + have hl := Int.le_of_dvd (by norm_num : (0 : Int) < 1) hd + omega + +private theorem hred₁ : + (by + classical + exact + ∀ (P : FordFareyParameter), (P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1) → + (Nat.Coprime P.q₁ P.p₁.natAbs ∧ Nat.Coprime P.q₂ P.p₂.natAbs) ) := by + classical + intro P hcrossdet + have h₁ : IsCoprime (P.q₁ : Int) P.p₁ := + ⟨-P.p₂, (P.q₂ : Int), by nlinarith only [hcrossdet]⟩ + have h₂ : IsCoprime (P.q₂ : Int) P.p₂ := + ⟨P.p₁, -(P.q₁ : Int), by nlinarith only [hcrossdet]⟩ + exact ⟨by simpa using Int.isCoprime_iff_nat_coprime.mp h₁, + by simpa using Int.isCoprime_iff_nat_coprime.mp h₂⟩ + +private theorem hrec₀' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (∀ x ∈ + FordRecursiveVertexDomains P (0 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique + P₁ x) → (∀ x, x ∈ FordRecursiveVertexDomains P 0 → FordOdometer P x = FordOdometer P₁ + x) ) := by + classical + intro P P₁ hrec₀ x hx + simpa [FordOdometer] using hrec₀ x hx + +private theorem hrec₁' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (∀ x ∈ + FordRecursiveVertexDomains P (1 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique + P₁ (x - ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (↑P.q₂ : ℤ) + + (1 : ℤ)) → (∀ x, x ∈ FordRecursiveVertexDomains P 1 → FordOdometer P x = + FordOdometer P₁ (x - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩) + P.p₂ * x.re + P.p₂ * x.im - P.p₂ + * (P.q₂ : Int) + 1) ) := by + classical + intro P P₁ hrec₁ x hx + simpa [FordOdometer] using hrec₁ x hx + +private theorem hrec₂' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (P₂ : FordFareyParameter), (∀ x ∈ + FordRecursiveVertexDomains P (2 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique + P₂ (x - ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩) + P.p₁ * x.im) → (∀ x, x ∈ FordRecursiveVertexDomains + P 2 → FordOdometer P x = FordOdometer P₂ (x - ⟨(P.q₁ : Int), 0⟩) + P.p₁ * x.im) ) := by + classical + intro P P₂ hrec₂ x hx + simpa [FordOdometer] using hrec₂ x hx + +private theorem hrec₃' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (P₂ : FordFareyParameter), (∀ x ∈ + FordRecursiveVertexDomains P (3 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique + P₂ (x - ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩) + P.p₁ * x.re) → (∀ x, x ∈ FordRecursiveVertexDomains + P 3 → FordOdometer P x = FordOdometer P₂ (x - ⟨0, (P.q₁ : Int)⟩) + P.p₁ * x.re) ) := by + classical + intro P P₂ hrec₃ x hx + simpa [FordOdometer] using hrec₃ x hx + +private theorem hlapAffine : + (by + classical + exact + ∀ (f : GaussianInt → ℤ), ∀ (f' : GaussianInt → ℤ), ∀ (x : GaussianInt), ∀ (t : + GaussianInt), ∀ (A : ℤ), ∀ (B : ℤ), ∀ (C : ℤ), f x = f' (x - t) + A * x.re + B * x.im + + C → f (x - (1 : GaussianInt)) = f' (x - t - (1 : GaussianInt)) + A * (x - (1 : + GaussianInt)).re + B * (x - (1 : GaussianInt)).im + C → f (x + (1 : GaussianInt)) = + f' (x - t + (1 : GaussianInt)) + A * (x + (1 : GaussianInt)).re + B * (x + (1 : + GaussianInt)).im + C → f (x - ⟨(0 : ℤ), (1 : ℤ)⟩) = f' (x - t - ⟨(0 : ℤ), (1 : ℤ)⟩) + + A * (x - ⟨(0 : ℤ), (1 : ℤ)⟩).re + B * (x - ⟨(0 : ℤ), (1 : ℤ)⟩).im + C → f (x + ⟨(0 : + ℤ), (1 : ℤ)⟩) = f' (x - t + ⟨(0 : ℤ), (1 : ℤ)⟩) + A * (x + ⟨(0 : ℤ), (1 : ℤ)⟩).re + B + * (x + ⟨(0 : ℤ), (1 : ℤ)⟩).im + C → FourNeighborLaplacian f x = FourNeighborLaplacian + f' (x - t) ) := by + classical + intro f f' x t A B C h0 hm hp hmi hpi + rw [FourNeighborLaplacian, hm, hp, hmi, hpi, h0, + FourNeighborLaplacian] + rw [show x - t - 1 = (x - t) - 1 by abel, + show x - t + 1 = (x - t) + 1 by abel, + show x - t - ⟨0, 1⟩ = (x - t) - ⟨0, 1⟩ by rfl, + show x - t + ⟨0, 1⟩ = (x - t) + ⟨0, 1⟩ by rfl] + simp + ring + +private theorem hrec0Member : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (z : GaussianInt), (0 : ℤ) ≤ z.re → z.re ≤ (↑P.q₁ : ℤ) → (0 + : ℤ) ≤ z.im → z.im ≤ (↑P.q₁ : ℤ) → z ∈ FordRecursiveVertexDomains P (0 : Fin (4 : ℕ)) + ) := by + classical + intro P z a b c d + change 0 ≤ z.re ∧ z.re ≤ (P.q₁ : Int) ∧ + 0 ≤ z.im ∧ z.im ≤ (P.q₁ : Int) + exact ⟨a, b, c, d⟩ + +private theorem hrec1Member : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (z : GaussianInt), (↑P.q₂ : ℤ) ≤ z.re → z.re ≤ (↑P.q : ℤ) → + (↑P.q₂ : ℤ) ≤ z.im → z.im ≤ (↑P.q : ℤ) → z ∈ FordRecursiveVertexDomains P (1 : Fin (4 + : ℕ)) ) := by + classical + intro P z a b c d + change (P.q₂ : Int) ≤ z.re ∧ z.re ≤ (P.q : Int) ∧ + (P.q₂ : Int) ≤ z.im ∧ z.im ≤ (P.q : Int) + exact ⟨a, b, c, d⟩ + +private theorem hrec2Member : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (z : GaussianInt), (↑P.q₁ : ℤ) ≤ z.re → z.re ≤ (↑P.q : ℤ) → + (0 : ℤ) ≤ z.im → z.im ≤ (↑P.q₂ : ℤ) → z ∈ FordRecursiveVertexDomains P (2 : Fin (4 : + ℕ)) ) := by + classical + intro P z a b c d + change (P.q₁ : Int) ≤ z.re ∧ z.re ≤ (P.q : Int) ∧ + 0 ≤ z.im ∧ z.im ≤ (P.q₂ : Int) + exact ⟨a, b, c, d⟩ + +private theorem hrec3Member : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (z : GaussianInt), (0 : ℤ) ≤ z.re → z.re ≤ (↑P.q₂ : ℤ) → + (↑P.q₁ : ℤ) ≤ z.im → z.im ≤ (↑P.q : ℤ) → z ∈ FordRecursiveVertexDomains P (3 : Fin (4 + : ℕ)) ) := by + classical + intro P z a b c d + change 0 ≤ z.re ∧ z.re ≤ (P.q₂ : Int) ∧ + (P.q₁ : Int) ≤ z.im ∧ z.im ≤ (P.q : Int) + exact ⟨a, b, c, d⟩ + +private theorem hdetdiffAt260 : + (by + classical + exact + ∀ (P : FordFareyParameter), (FordFareyParameter) → ((FordFareyParameter) → ((P.p₁ * (P.q₂ + : Int) - P.p₂ * (P.q₁ : Int) = 1) → ((P.q₂ < P.q₁) → ((P.p₁-P.p₂) * (P.q₁ : Int) - + ((P.q₁-P.q₂ : Nat) : Int) * P.p₁ = 1)))) ) := by + classical + intro P P₁ P₂ hcrossdet horder + rw [Nat.cast_sub (by omega : P.q₂ ≤ P.q₁)] + nlinarith only [hcrossdet] + +private theorem hcopAt264 : + (by + classical + exact + ∀ (P : FordFareyParameter), (FordFareyParameter) → ((FordFareyParameter) → ((P.p₁ * (P.q₂ + : Int) - P.p₂ * (P.q₁ : Int) = 1) → ((P.q₂ < P.q₁) → (Nat.Coprime (P.q₁-P.q₂) + (P.p₁-P.p₂).natAbs)))) ) := by + classical + intro P P₁ P₂ hcrossdet horder + have hc : IsCoprime ((P.q₁-P.q₂ : Nat) : Int) (P.p₁-P.p₂) := by + have hx : (P.p₁-P.p₂) * (P.q₂ : Int) - + P.p₂ * ((P.q₁-P.q₂ : Nat) : Int) = 1 := by + rw [Nat.cast_sub (by omega : P.q₂ ≤ P.q₁)] + nlinarith only [hcrossdet] + exact ⟨-P.p₂, P.q₂, by nlinarith only [hx]⟩ + simpa using Int.isCoprime_iff_nat_coprime.mp hc + +private theorem hparAt293 : + (by + classical + exact + ∀ (P : FordFareyParameter), (FordFareyParameter) → ((FordFareyParameter) → (∀ (hP : (2 : + ℕ) < P.q), ∀ (hsum : P.q = P.q₁ + P.q₂), ∀ (hcrossdet : P.p₁ * (P.q₂ : + Int) - P.p₂ * (P.q₁ : Int) = 1), ∀ (hpos₁ : 0 < P.q₁), ∀ (hpos₂ : 0 < P.q₂), ∀ + (horder : P.q₂ < P.q₁), ∀ (hdlt : P.q₁ - P.q₂ < P.q), ∀ (hdetdiff : (P.p₁-P.p₂) * + (P.q₁ : Int) - ((P.q₁-P.q₂ : Nat) : Int) * P.p₁ = 1), ∀ (H : FordFareyParameter), ∀ + (hHq : H.q = P.q₁ - P.q₂), ∀ (hredParent : Nat.Coprime P.q₁ P.p₁.natAbs), + let Q : FordFareyParameter := by + have hdet₂ : P.p₂ * (P.q₁ : Int) - + (P.q₂ : Int) * P.p₁ = -1 := by nlinarith only [hcrossdet] + refine FordFareyParameter.mk P.p₁ P.q₁ hpos₁ hredParent + (P.p₁-P.p₂) (P.q₁-P.q₂) P.p₂ P.q₂ ?_ ?_ ?_ ?_ ?_ ?_ ?_ + · ring + · omega + · exact hdetdiff + · exact hdet₂ + · omega + · exact hpos₂ + · intro hu + have : P.q₁ = 1 := by simpa using hu + omega + Q.p₁ = P.p₁-P.p₂ ∧ Q.q₁ = P.q₁-P.q₂ ∧ Q.p₂ = P.p₂ ∧ Q.q₂ = P.q₂))) := by + classical + intro P P₁ P₂ hP hsum hcrossdet hpos₁ hpos₂ horder hdlt hdetdiff H hHq hredParent Q + exact ⟨rfl, rfl, rfl, rfl⟩ + +private theorem hch₀' : + (by + classical + exact + ∀ (P₁ : FordFareyParameter), ∀ (H : FordFareyParameter), (∀ x ∈ + FordRecursiveVertexDomains P₁ (0 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P₁ x = Classical.choose FordOdometerFamilyExistsUnique + H x) → (∀ y, y ∈ FordRecursiveVertexDomains P₁ 0 → FordOdometer P₁ y = FordOdometer H + y) ) := by + classical + intro P₁ H hch₀ y hy + simpa [FordOdometer] using hch₀ y hy + +private theorem hch₁' : + (by + classical + exact + ∀ (P₁ : FordFareyParameter), ∀ (H : FordFareyParameter), (∀ x ∈ + FordRecursiveVertexDomains P₁ (1 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P₁ x = Classical.choose FordOdometerFamilyExistsUnique + H (x - ⟨(↑P₁.q₂ : ℤ), (↑P₁.q₂ : ℤ)⟩) + P₁.p₂ * x.re + P₁.p₂ * x.im - P₁.p₂ * (↑P₁.q₂ + : ℤ) + (1 : ℤ)) → (∀ z, z ∈ FordRecursiveVertexDomains P₁ 1 → FordOdometer P₁ z = + FordOdometer H (z-⟨(P₁.q₂ : Int), (P₁.q₂ : Int)⟩) + P₁.p₂*z.re + P₁.p₂*z.im - + P₁.p₂*(P₁.q₂ : Int)+1) ) := by + classical + intro P₁ H hch₁ z hz + simpa [FordOdometer] using hch₁ z hz + +private theorem hcoordsAt312 : + (by + classical + exact + ∀ (P : FordFareyParameter), (FordFareyParameter) → ((FordFareyParameter) → (((2 : ℕ) < + P.q) → ((∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ + x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → ((P.q = P.q₁ + P.q₂) → + ((P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1) → ((0 < P.q₁) → ((0 < P.q₂) → (∀ (hr + : Fin (4 : ℕ) → Finset GaussianInt), (hr 0 = P4062T1InteriorSquare P.q₁) → ((hr 1 = + (P4062T1InteriorSquare P.q₁).image (fun y => y+⟨(P.q₂ : Int),(P.q₂ : Int)⟩)) → + ((P.q₂ < P.q₁) → ((P.q₁ - P.q₂ < P.q) → (((P.p₁-P.p₂) * (P.q₁ : Int) - ((P.q₁-P.q₂ : + Nat) : Int) * P.p₁ = 1) → (∀ (H : FordFareyParameter), (H.q = P.q₁ - P.q₂) → + ((Nat.Coprime P.q₁ P.p₁.natAbs) → ((FordFareyParameter) → (∀ x ∈ hr (0 : Fin (4 : ℕ)) + ∩ hr (1 : Fin (4 : ℕ)), (↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q₁ : ℤ) - (1 : ℤ) ∧ + (↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₁ : ℤ) - (1 : ℤ))))))))))))))))) ) := by + classical + intro P P₁ P₂ hP squareCoordinates hsum hcrossdet hpos₁ hpos₂ hr hA0 hA1 horder hdlt hdetdiff H + hHq hredParent R x hx + rcases Finset.mem_inter.mp hx with ⟨h0,h1⟩ + rw [hA0] at h0 + have b0 := (squareCoordinates P.q₁ x).mp h0 + rw [hA1] at h1 + obtain ⟨y, hy, hxy⟩ := Finset.mem_image.mp h1 + have by' := (squareCoordinates P.q₁ y).mp hy + have hxy' : x = y + ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ := hxy.symm + rcases b0 with ⟨b0r,b0r',b0i,b0i'⟩ + rcases by' with ⟨byr,byr',byi,byi'⟩ + subst x + simp only [Zsqrtd.re_add, Zsqrtd.im_add] + exact ⟨by omega, by omega, by omega, by omega⟩ + +private theorem htargetAt327 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (FordFareyParameter) → (((2 : ℕ) + < P.q) → ((P₁.q = P.q₁) → (∀ (hsum : P.q = P.q₁ + P.q₂), ∀ (hcrossdet : P.p₁ * (P.q₂ + : Int) - P.p₂ * (P.q₁ : Int) = 1), ∀ (hpos₁ : 0 < P.q₁), ∀ (hpos₂ : 0 < P.q₂), (∀ x, + x ∈ FordRecursiveVertexDomains P 0 → + FordOdometer P x = FordOdometer P₁ x) → ((∀ x, x ∈ + FordRecursiveVertexDomains P 1 → FordOdometer P x = FordOdometer P₁ (x - ⟨(P.q₂ : + Int), (P.q₂ : Int)⟩) + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (P.q₂ : Int) + 1) → ((∀ (f + : GaussianInt → Int), ∀ (f' : GaussianInt → Int), ∀ (x : GaussianInt), ∀ (t : + GaussianInt), ∀ (A : Int), ∀ (B : Int), ∀ (C : Int), (f x = f' + (x - t) + A * x.re + B * x.im + C) → ((f (x - 1) = f' ((x - t) - 1) + A * (x - 1).re + + B * (x - 1).im + C) → ((f (x + 1) = f' ((x - t) + 1) + A * (x + 1).re + B * (x + + 1).im + C) → ((f (x - ⟨0, 1⟩) = f' ((x - t) - ⟨0, 1⟩) + A * (x - ⟨0, 1⟩).re + B * (x + - ⟨0, 1⟩).im + C) → ((f (x + ⟨0, 1⟩) = f' ((x - t) + ⟨0, 1⟩) + A * (x + ⟨0, 1⟩).re + + B * (x + ⟨0, 1⟩).im + C) → (FourNeighborLaplacian f x = FourNeighborLaplacian f' (x - + t))))))) → ((∀ (z : GaussianInt), (0 ≤ z.re) → ((z.re ≤ (P.q₁ : Int)) → + ((0 ≤ z.im) → ((z.im ≤ (P.q₁ : Int)) → (z ∈ FordRecursiveVertexDomains P 0))))) → ((∀ + (z : GaussianInt), ((P.q₂ : Int) ≤ z.re) → ((z.re ≤ (P.q : Int)) → + (((P.q₂ : Int) ≤ z.im) → ((z.im ≤ (P.q : Int)) → (z ∈ FordRecursiveVertexDomains P + 1))))) → (∀ (hr : Fin (4 : ℕ) → Finset GaussianInt), ∀ (horder : P.q₂ < P.q₁), ∀ + (hdlt : P.q₁ - P.q₂ < P.q), ∀ (hdetdiff : (P.p₁-P.p₂) * (P.q₁ : Int) - + ((P.q₁-P.q₂ : Nat) : + Int) * P.p₁ = 1), ∀ (H : FordFareyParameter), ∀ (hHq : H.q = P.q₁ - P.q₂), ∀ + (hredParent : Nat.Coprime P.q₁ P.p₁.natAbs), + let Q : FordFareyParameter := by + have hdet₂ : P.p₂ * (P.q₁ : Int) - + (P.q₂ : Int) * P.p₁ = -1 := by nlinarith only [hcrossdet] + refine FordFareyParameter.mk P.p₁ P.q₁ hpos₁ hredParent + (P.p₁-P.p₂) (P.q₁-P.q₂) P.p₂ P.q₂ ?_ ?_ ?_ ?_ ?_ ?_ ?_ + · ring + · omega + · exact hdetdiff + · exact hdet₂ + · omega + · exact hpos₂ + · intro hu + have : P.q₁ = 1 := by simpa using hu + omega + ∀ (R : FordFareyParameter), (R.p = P.p₁ ∧ R.q = P.q₁) → ((Q.p₁ = P.p₁-P.p₂ ∧ Q.q₁ = + P.q₁-P.q₂ ∧ Q.p₂ = P.p₂ ∧ Q.q₂ = P.q₂) → ((P₁.p₁ = P.p₁-P.p₂ ∧ P₁.q₁ = P.q₁-P.q₂ ∧ + P₁.p₂ = P.p₂ ∧ P₁.q₂ = P.q₂) → ((∀ y, y ∈ FordRecursiveVertexDomains P₁ 0 → + FordOdometer P₁ y = FordOdometer H y) → ((∀ z, z ∈ FordRecursiveVertexDomains P₁ 1 → + FordOdometer P₁ z = FordOdometer H (z-⟨(P₁.q₂ : Int), (P₁.q₂ : Int)⟩) + P₁.p₂*z.re + + P₁.p₂*z.im - P₁.p₂*(P₁.q₂ : Int)+1) → ((∀ (x : GaussianInt), (x ∈ hr 0 ∩ hr 1) → + ((P.q₂ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q₁ : Int)-1 ∧ (P.q₂ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q₁ + : Int)-1)) → (∀ x ∈ hr 0 ∩ hr 1, FourNeighborLaplacian (FordOdometer P) x = + FourNeighborLaplacian (FordOdometer H) (x-⟨(P.q₂ : Int), (P.q₂ : + Int)⟩)))))))))))))))) := by + classical + intro P P₁ P₂ hP hq₁ hsum hcrossdet hpos₁ hpos₂ hrec₀' hrec₁' hlapAffine hrec0Member + hrec1Member hr horder hdlt hdetdiff H hHq hredParent Q R hR hpar hparP hch₀' hch₁' hcoords + x hx + have hb := hcoords x hx + have hpt (z : GaussianInt) (hzr : (P.q₂ : Int) ≤ z.re) + (hzr' : z.re ≤ (P.q₁ : Int)) (hzi : (P.q₂ : Int) ≤ z.im) + (hzi' : z.im ≤ (P.q₁ : Int)) : + FordOdometer P z = FordOdometer H + (z-⟨(P.q₂ : Int), (P.q₂ : Int)⟩) + + P.p₂*z.re + P.p₂*z.im - P.p₂*(P.q₂ : Int)+1 := by + have hz0 := hrec0Member z (by omega) (by omega) (by omega) (by omega) + have hz1 : z ∈ FordRecursiveVertexDomains P 1 := by + apply hrec1Member z hzr ?_ hzi ?_ + · have hs : (P.q₁ : Int) + P.q₂ = P.q := by exact_mod_cast P.sum_q.symm + omega + · have hs : (P.q₁ : Int) + P.q₂ = P.q := by exact_mod_cast P.sum_q.symm + omega + have hy0 : z-⟨(P.q₂ : Int), (P.q₂ : Int)⟩ ∈ + FordRecursiveVertexDomains P₁ 0 := by + change 0 ≤ (z-⟨(P.q₂ : Int),(P.q₂ : Int)⟩).re ∧ + (z-⟨(P.q₂ : Int),(P.q₂ : Int)⟩).re ≤ (P₁.q₁ : Int) ∧ + 0 ≤ (z-⟨(P.q₂ : Int),(P.q₂ : Int)⟩).im ∧ + (z-⟨(P.q₂ : Int),(P.q₂ : Int)⟩).im ≤ (P₁.q₁ : Int) + rw [hparP.2.1] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, + ] + constructor <;> omega + have hzchild1 : z ∈ FordRecursiveVertexDomains P₁ 1 := by + change (P₁.q₂ : Int) ≤ z.re ∧ z.re ≤ (P₁.q : Int) ∧ + (P₁.q₂ : Int) ≤ z.im ∧ z.im ≤ (P₁.q : Int) + rw [hparP.2.2.2, hq₁] + exact ⟨by omega, by omega, by omega, by omega⟩ + have houter0 := hrec₀' z hz0 + have houter1 := hrec₁' z hz1 + have hchild0 := hch₀' (z-⟨(P.q₂ : Int),(P.q₂ : Int)⟩) hy0 + have hchild1 := hch₁' z hzchild1 + have hshift : z-⟨(P.q₂ : Int),(P.q₂ : Int)⟩ = + z-⟨(P₁.q₂ : Int),(P₁.q₂ : Int)⟩ := by rw [hparP.2.2.2] + rw [← hshift, hparP.2.2.1, hparP.2.2.2] at hchild1 + calc + FordOdometer P z = FordOdometer P₁ z := houter0 + _ = FordOdometer H (z-⟨(P.q₂ : Int),(P.q₂ : Int)⟩) + + P.p₂*z.re + P.p₂*z.im - P.p₂*(P.q₂ : Int)+1 := by + convert hchild1 using 1 + have ht := hlapAffine (FordOdometer P) (FordOdometer H) x + ⟨(P.q₂ : Int),(P.q₂ : Int)⟩ P.p₂ P.p₂ + (-P.p₂*(P.q₂ : Int)+1) + apply ht + · convert hpt x (by omega) (by omega) (by omega) (by omega) using 1; ring + · convert hpt (x-1) (by + simp only [Zsqrtd.re_sub, Zsqrtd.re_one] + omega) + (by + simp only [Zsqrtd.re_sub, Zsqrtd.re_one] + omega) + (by + simp only [Zsqrtd.im_sub, Zsqrtd.im_one] + omega) + (by + simp only [Zsqrtd.im_sub, Zsqrtd.im_one] + omega) using 1; ring + · convert hpt (x+1) (by + simp only [Zsqrtd.re_add, Zsqrtd.re_one] + omega) + (by + simp only [Zsqrtd.re_add, Zsqrtd.re_one] + omega) + (by + simp only [Zsqrtd.im_add, Zsqrtd.im_one] + omega) + (by + simp only [Zsqrtd.im_add, Zsqrtd.im_one] + omega) using 1; ring + · convert hpt (x-⟨0,1⟩) (by + simp only [Zsqrtd.re_sub] + omega) + (by + simp only [Zsqrtd.re_sub] + omega) + (by + simp only [Zsqrtd.im_sub] + omega) + (by + simp only [Zsqrtd.im_sub] + omega) using 1; ring + · convert hpt (x+⟨0,1⟩) (by + simp only [Zsqrtd.re_add] + omega) + (by + simp only [Zsqrtd.re_add] + omega) + (by + simp only [Zsqrtd.im_add] + omega) + (by + simp only [Zsqrtd.im_add] + omega) using 1; ring + +private theorem hyAt433 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (FordFareyParameter) → (∀ (hP : + (2 : ℕ) < P.q), (∀ (q : Nat), ∀ (x : GaussianInt), x ∈ + P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : + Int) - 1) → (∀ (hsum : P.q = P.q₁ + P.q₂), ∀ (hcrossdet : P.p₁ * (P.q₂ : Int) - P.p₂ * + (P.q₁ : Int) = 1), ∀ (hpos₁ : 0 < P.q₁), ∀ (hpos₂ : 0 < P.q₂), ∀ (horder : P.q₂ < + P.q₁), ∀ (hdlt : P.q₁ - P.q₂ < P.q), ∀ (hdetdiff : (P.p₁-P.p₂) * (P.q₁ : Int) - + ((P.q₁-P.q₂ : Nat) : Int) * P.p₁ = 1), ∀ (H : FordFareyParameter), ∀ (hHq : H.q = + P.q₁ - P.q₂), ∀ (hredParent : Nat.Coprime P.q₁ P.p₁.natAbs), + let Q : FordFareyParameter := by + have hdet₂ : P.p₂ * (P.q₁ : Int) - + (P.q₂ : Int) * P.p₁ = -1 := by nlinarith only [hcrossdet] + refine FordFareyParameter.mk P.p₁ P.q₁ hpos₁ hredParent + (P.p₁-P.p₂) (P.q₁-P.q₂) P.p₂ P.q₂ ?_ ?_ ?_ ?_ ?_ ?_ ?_ + · ring + · omega + · exact hdetdiff + · exact hdet₂ + · omega + · exact hpos₂ + · intro hu + have : P.q₁ = 1 := by simpa using hu + omega + ∀ (R : FordFareyParameter), (R.p = P.p₁ ∧ R.q = P.q₁) → ((Q.p₁ = P.p₁-P.p₂ ∧ Q.q₁ = + P.q₁-P.q₂ ∧ Q.p₂ = P.p₂ ∧ Q.q₂ = P.q₂) → ((P₁.p₁ = P.p₁-P.p₂ ∧ P₁.q₁ = P.q₁-P.q₂ ∧ + P₁.p₂ = P.p₂ ∧ P₁.q₂ = P.q₂) → (∀ (x : GaussianInt), ((↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.re ∧ + x.re ≤ (↑P.q₁ : ℤ) - (1 : ℤ) ∧ (↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₁ : ℤ) - (1 + : ℤ)) → ( + let y : GaussianInt := x-⟨(P.q₂ : Int),(P.q₂ : Int)⟩ + y ∈ P4062T1InteriorSquare (P.q₁-P.q₂)))))))) := by + classical + intro P P₁ P₂ hP squareCoordinates hsum hcrossdet hpos₁ hpos₂ horder hdlt hdetdiff H hHq + hredParent Q R hR hpar hparP x hc y + apply (squareCoordinates (P.q₁-P.q₂) y).mpr + dsimp [y] + rw [Nat.cast_sub (by omega : P.q₂ ≤ P.q₁)] + exact ⟨by omega, by omega, by omega, by omega⟩ + +private theorem hcastAt445 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (FordFareyParameter) → (∀ (hP : + (2 : ℕ) < P.q), ∀ (hsum : P.q = P.q₁ + P.q₂), ∀ (hcrossdet : P.p₁ * (P.q₂ : + Int) - P.p₂ * (P.q₁ : Int) = 1), ∀ (hpos₁ : 0 < P.q₁), ∀ (hpos₂ : 0 < P.q₂), ∀ + (horder : P.q₂ < P.q₁), ∀ (hdlt : P.q₁ - P.q₂ < P.q), ∀ (hdetdiff : (P.p₁-P.p₂) * + (P.q₁ : Int) - ((P.q₁-P.q₂ : Nat) : Int) * P.p₁ = 1), ∀ (H : FordFareyParameter), ∀ + (hHq : H.q = P.q₁ - P.q₂), ∀ (hredParent : Nat.Coprime P.q₁ P.p₁.natAbs), + let Q : FordFareyParameter := by + have hdet₂ : P.p₂ * (P.q₁ : Int) - + (P.q₂ : Int) * P.p₁ = -1 := by nlinarith only [hcrossdet] + refine FordFareyParameter.mk P.p₁ P.q₁ hpos₁ hredParent + (P.p₁-P.p₂) (P.q₁-P.q₂) P.p₂ P.q₂ ?_ ?_ ?_ ?_ ?_ ?_ ?_ + · ring + · omega + · exact hdetdiff + · exact hdet₂ + · omega + · exact hpos₂ + · intro hu + have : P.q₁ = 1 := by simpa using hu + omega + ∀ (R : FordFareyParameter), (R.p = P.p₁ ∧ R.q = P.q₁) → ((Q.p₁ = P.p₁-P.p₂ ∧ Q.q₁ = + P.q₁-P.q₂ ∧ Q.p₂ = P.p₂ ∧ Q.q₂ = P.q₂) → ((P₁.p₁ = P.p₁-P.p₂ ∧ P₁.q₁ = P.q₁-P.q₂ ∧ + P₁.p₂ = P.p₂ ∧ P₁.q₂ = P.q₂) → ((GaussianInt) → ((H.q : Int) = (P.q₁ : + Int)-P.q₂)))))) := by + classical + intro P P₁ P₂ hP hsum hcrossdet hpos₁ hpos₂ horder hdlt hdetdiff H hHq hredParent Q R hR hpar + hparP y + calc + (H.q : Int) = ((P.q₁-P.q₂ : Nat) : Int) := by exact_mod_cast hHq + _ = (P.q₁ : Int)-P.q₂ := by + rw [Nat.cast_sub (by omega : P.q₂ ≤ P.q₁)] + +private theorem hdetdiffAt465 : + (by + classical + exact + ∀ (P : FordFareyParameter), (FordFareyParameter) → ((FordFareyParameter) → ((P.p₁ * (P.q₂ + : Int) - P.p₂ * (P.q₁ : Int) = 1) → ((P.q₁ < P.q₂) → ((P.p₂-P.p₁) * (P.q₂ : Int) - + ((P.q₂-P.q₁ : Nat) : Int) * P.p₂ = -1)))) ) := by + classical + intro P P₁ P₂ hcrossdet horder + rw [Nat.cast_sub (by omega : P.q₁ ≤ P.q₂)] + nlinarith only [hcrossdet] + +private theorem hcopAt469 : + (by + classical + exact + ∀ (P : FordFareyParameter), (FordFareyParameter) → ((FordFareyParameter) → ((P.p₁ * (P.q₂ + : Int) - P.p₂ * (P.q₁ : Int) = 1) → ((P.q₁ < P.q₂) → (Nat.Coprime (P.q₂-P.q₁) + (P.p₂-P.p₁).natAbs)))) ) := by + classical + intro P P₁ P₂ hcrossdet horder + have hc : IsCoprime ((P.q₂-P.q₁ : Nat) : Int) (P.p₂-P.p₁) := by + have hx : P.p₁ * ((P.q₂-P.q₁ : Nat) : Int) - + (P.q₁ : Int) * (P.p₂-P.p₁) = 1 := by + rw [Nat.cast_sub (by omega : P.q₁ ≤ P.q₂)] + nlinarith only [hcrossdet] + exact ⟨P.p₁, -(P.q₁ : Int), by nlinarith only [hx]⟩ + simpa using Int.isCoprime_iff_nat_coprime.mp hc + +private theorem hparAt498 : + (by + classical + exact + ∀ (P : FordFareyParameter), (FordFareyParameter) → (∀ (P₂ : FordFareyParameter), ∀ (hP : + (2 : ℕ) < P.q), ∀ (hsum : P.q = P.q₁ + P.q₂), ∀ (hcrossdet : P.p₁ * (P.q₂ : + Int) - P.p₂ * (P.q₁ : Int) = 1), ∀ (hpos₂ : 0 < P.q₂), ∀ (horder : P.q₁ < P.q₂), ∀ + (hdiff : 0 < P.q₂ - P.q₁), ∀ (hdetdiff : (P.p₂-P.p₁) * (P.q₂ : Int) - ((P.q₂-P.q₁ : + Nat) : Int) * P.p₂ = -1), ∀ (H : FordFareyParameter), ∀ (hHq : H.q = P.q₂ - P.q₁), ∀ + (hredParent : Nat.Coprime P.q₂ P.p₂.natAbs), + let Q : FordFareyParameter := by + have hdet₁ : P.p₁ * (P.q₂ : Int) - + (P.q₁ : Int) * P.p₂ = 1 := by nlinarith [hcrossdet] + refine FordFareyParameter.mk P.p₂ P.q₂ hpos₂ hredParent + P.p₁ P.q₁ (P.p₂-P.p₁) (P.q₂-P.q₁) ?_ ?_ ?_ ?_ ?_ ?_ ?_ + · ring + · omega + · exact hdet₁ + · exact hdetdiff + · omega + · omega + · intro hu + have : P.q₂ = 1 := by simpa using hu + omega + (Q = P₂) → (P₂.p₁ = P.p₁ ∧ P₂.q₁ = P.q₁ ∧ P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁))) := by + classical + intro P P₁ P₂ hP hsum hcrossdet hpos₂ horder hdiff hdetdiff H hHq hredParent Q hQeq + simpa [hQeq] using (show Q.p₁ = P.p₁ ∧ Q.q₁ = P.q₁ ∧ + Q.p₂ = P.p₂-P.p₁ ∧ Q.q₂ = P.q₂-P.q₁ from ⟨rfl,rfl,rfl,rfl⟩) + +private theorem hch₃' : + (by + classical + exact + ∀ (P₂ : FordFareyParameter), ∀ (H : FordFareyParameter), (∀ x ∈ + FordRecursiveVertexDomains P₂ (3 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P₂ x = Classical.choose FordOdometerFamilyExistsUnique + H (x - ⟨(0 : ℤ), (↑P₂.q₁ : ℤ)⟩) + P₂.p₁ * x.re) → (∀ z, z ∈ + FordRecursiveVertexDomains P₂ 3 → FordOdometer P₂ z = FordOdometer H (z-⟨0,(P₂.q₁ : + Int)⟩) + P₂.p₁*z.re) ) := by + classical + intro P₂ H hch₃ z hz + simpa [FordOdometer] using hch₃ z hz + +private theorem hcoordsAt511 : + (by + classical + exact + ∀ (P : FordFareyParameter), (FordFareyParameter) → (∀ (P₂ : FordFareyParameter), (∀ (q : + Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : + Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → (∀ (hr : Fin (4 : ℕ) → Finset + GaussianInt), (hr 2 = (P4062T1InteriorSquare P.q₂).image (fun y => y+⟨(P.q₁ : + Int),0⟩)) → ((hr 3 = (P4062T1InteriorSquare P.q₂).image (fun y => y+⟨0,(P.q₁ : + Int)⟩)) → ((FordFareyParameter) → (∀ (R : FordFareyParameter), (R.p = P.p₂ ∧ R.q = + P.q₂) → ((P₂.p₁ = P.p₁ ∧ P₂.q₁ = P.q₁ ∧ P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁) → (∀ x + ∈ hr (2 : Fin (4 : ℕ)) ∩ hr (3 : Fin (4 : ℕ)), (↑P.q₁ : ℤ) + (1 : ℤ) ≤ x.re ∧ x.re ≤ + (↑P.q₂ : ℤ) - (1 : ℤ) ∧ (↑P.q₁ : ℤ) + (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₂ : ℤ) - (1 : + ℤ)))))))) ) := by + classical + intro P P₁ P₂ squareCoordinates hr hA2 hA3 H R hR hpar x hx + rcases Finset.mem_inter.mp hx with ⟨h2,h3⟩ + rw [hA2] at h2 + rw [hA3] at h3 + obtain ⟨y, hy, hxy⟩ := Finset.mem_image.mp h2 + obtain ⟨z, hz, hxz⟩ := Finset.mem_image.mp h3 + have by' := (squareCoordinates P.q₂ y).mp hy + have bz' := (squareCoordinates P.q₂ z).mp hz + have hxy' : x = y+⟨(P.q₁ : Int),0⟩ := hxy.symm + have hxz' : x = z+⟨0,(P.q₁ : Int)⟩ := hxz.symm + subst x + rcases by' with ⟨yr,yr',yi,yi'⟩ + rcases bz' with ⟨zr,zr',zi,zi'⟩ + have hrel := hxz' + have hrelR : y.re + (P.q₁ : Int) = z.re := by + have hh := congrArg Zsqrtd.re hrel + simpa only [Zsqrtd.re_add, Zsqrtd.re_zero, add_zero] using hh + have hrelI : y.im = z.im + (P.q₁ : Int) := by + have hh := congrArg Zsqrtd.im hrel + calc + y.im = y.im + 0 := by ring + _ = z.im + (P.q₁ : Int) := by simpa only [Zsqrtd.im_add, + Zsqrtd.im_zero, add_zero] using hh + have hreX : (y+⟨(P.q₁ : Int),0⟩).re = y.re + P.q₁ := by + simp only [Zsqrtd.re_add] + have himX : (y+⟨(P.q₁ : Int),0⟩).im = y.im := by + simp only [Zsqrtd.im_add, add_zero] + rw [hreX, himX] + exact ⟨by omega, by omega, by omega, by omega⟩ + +private theorem htargetAt542 : + (by + classical + exact + ∀ (P : FordFareyParameter), (FordFareyParameter) → (∀ (P₂ : FordFareyParameter), (P₂.q = + P.q₂) → ((P.q = P.q₁ + P.q₂) → ((P.q₂ < P.q) → ((∀ x, x ∈ FordRecursiveVertexDomains + P 2 → FordOdometer P x = FordOdometer P₂ (x - ⟨(P.q₁ : Int), 0⟩) + P.p₁ * x.im) → ((∀ + (f : GaussianInt → Int), ∀ (f' : GaussianInt → Int), ∀ (x : GaussianInt), ∀ (t : + GaussianInt), ∀ (A : Int), ∀ (B : Int), ∀ (C : Int), (f x = f' (x - t) + A * x.re + B + * x.im + C) → ((f (x - 1) = f' ((x - t) - 1) + A * (x - 1).re + B * (x - 1).im + C) → + ((f (x + 1) = f' ((x - t) + 1) + A * (x + 1).re + B * (x + 1).im + C) → ((f (x - ⟨0, + 1⟩) = f' ((x - t) - ⟨0, 1⟩) + A * (x - ⟨0, 1⟩).re + B * (x - ⟨0, 1⟩).im + C) → ((f (x + + ⟨0, 1⟩) = f' ((x - t) + ⟨0, 1⟩) + A * (x + ⟨0, 1⟩).re + B * (x + ⟨0, 1⟩).im + C) → + (FourNeighborLaplacian f x = FourNeighborLaplacian f' (x - t))))))) → ((∀ (z : + GaussianInt), ((P.q₁ : Int) ≤ z.re) → ((z.re ≤ (P.q : Int)) → ((0 ≤ z.im) → ((z.im ≤ + (P.q₂ : Int)) → (z ∈ FordRecursiveVertexDomains P 2))))) → (∀ (hr : Fin (4 : ℕ) → + Finset GaussianInt), (P.q₁ < P.q₂) → (∀ (H : FordFareyParameter), (H.q = P.q₂ - P.q₁) + → (∀ (R : FordFareyParameter), (R.p = P.p₂ ∧ R.q = P.q₂) → ((P₂.p₁ = P.p₁ ∧ P₂.q₁ = + P.q₁ ∧ P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁) → ((∀ z, z ∈ FordRecursiveVertexDomains + P₂ 3 → FordOdometer P₂ z = FordOdometer H (z-⟨0,(P₂.q₁ : Int)⟩) + P₂.p₁*z.re) → ((∀ + (x : GaussianInt), (x ∈ hr 2 ∩ hr 3) → ((P.q₁ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 + ∧ (P.q₁ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q₂ : Int)-1)) → (∀ x ∈ hr 2 ∩ hr 3, + FourNeighborLaplacian (FordOdometer P) x = FourNeighborLaplacian (FordOdometer H) + (x-⟨(P.q₁ : Int),(P.q₁ : Int)⟩)))))))))))))) ) := by + classical + intro P P₁ P₂ hq₂ hsum hlt₂ hrec₂' hlapAffine hrec2Member hr horder H hHq R hR hpar hch₃' + hcoords x hx + have hb := hcoords x hx + have hpt (z : GaussianInt) (hzr : (P.q₁ : Int) ≤ z.re) + (hzr' : z.re ≤ (P.q₂ : Int)) (hzi : (P.q₁ : Int) ≤ z.im) + (hzi' : z.im ≤ (P.q₂ : Int)) : + FordOdometer P z = FordOdometer H + (z-⟨(P.q₁ : Int),(P.q₁ : Int)⟩) + + P.p₁*z.re + P.p₁*z.im - P.p₁*(P.q₁ : Int) := by + have hz2 : z ∈ FordRecursiveVertexDomains P 2 := by + apply hrec2Member z hzr ?_ ?_ hzi' + · have hs : (P.q₁ : Int)+P.q₂=P.q := by exact_mod_cast P.sum_q.symm + omega + · omega + have hv2 : z-⟨(P.q₁ : Int),0⟩ ∈ FordRecursiveVertexDomains P₂ 3 := by + change 0 ≤ (z-⟨(P.q₁ : Int),0⟩).re ∧ + (z-⟨(P.q₁ : Int),0⟩).re ≤ (P₂.q₂ : Int) ∧ + (P₂.q₁ : Int) ≤ (z-⟨(P.q₁ : Int),0⟩).im ∧ + (z-⟨(P.q₁ : Int),0⟩).im ≤ (P₂.q : Int) + rw [hpar.2.2.2, hpar.2.1, hq₂] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, + ] + constructor <;> omega + have houter := hrec₂' z hz2 + have hinner := hch₃' (z-⟨(P.q₁ : Int),0⟩) hv2 + rw [hpar.1, hpar.2.1] at hinner + calc + FordOdometer P z = FordOdometer P₂ (z-⟨(P.q₁ : Int),0⟩) + + P.p₁*z.im := houter + _ = FordOdometer H (z-⟨(P.q₁ : Int),(P.q₁ : Int)⟩) + + P.p₁*z.re + P.p₁*z.im - P.p₁*(P.q₁ : Int) := by + rw [hinner] + have harg : z-⟨(P.q₁ : Int),0⟩-⟨0,(P.q₁ : Int)⟩ = + z-⟨(P.q₁ : Int),(P.q₁ : Int)⟩ := by + ext <;> simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, + ] <;> ring + rw [harg] + simp only [Zsqrtd.re_sub] + ring + have ht := hlapAffine (FordOdometer P) (FordOdometer H) x + ⟨(P.q₁ : Int),(P.q₁ : Int)⟩ P.p₁ P.p₁ + (-P.p₁*(P.q₁ : Int)) + apply ht + · convert hpt x (by omega) (by omega) (by omega) (by omega) using 1; ring + · convert hpt (x-1) (by + simp only [Zsqrtd.re_sub, Zsqrtd.re_one] + omega) + (by + simp only [Zsqrtd.re_sub, Zsqrtd.re_one] + omega) + (by + simp only [Zsqrtd.im_sub, Zsqrtd.im_one] + omega) + (by + simp only [Zsqrtd.im_sub, Zsqrtd.im_one] + omega) using 1; ring + · convert hpt (x+1) (by + simp only [Zsqrtd.re_add, Zsqrtd.re_one] + omega) + (by + simp only [Zsqrtd.re_add, Zsqrtd.re_one] + omega) + (by + simp only [Zsqrtd.im_add, Zsqrtd.im_one] + omega) + (by + simp only [Zsqrtd.im_add, Zsqrtd.im_one] + omega) using 1; ring + · convert hpt (x-⟨0,1⟩) (by + simp only [Zsqrtd.re_sub] + omega) + (by + simp only [Zsqrtd.re_sub] + omega) + (by + simp only [Zsqrtd.im_sub] + omega) + (by + simp only [Zsqrtd.im_sub] + omega) using 1; ring + · convert hpt (x+⟨0,1⟩) (by + simp only [Zsqrtd.re_add] + omega) + (by + simp only [Zsqrtd.re_add] + omega) + (by + simp only [Zsqrtd.im_add] + omega) + (by + simp only [Zsqrtd.im_add] + omega) using 1; ring + +private theorem hyAt644 : + (by + classical + exact + ∀ (P : FordFareyParameter), (FordFareyParameter) → (∀ (P₂ : FordFareyParameter), (∀ (q : + Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : + Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → ((P.q₁ < P.q₂) → ((FordFareyParameter) + → (∀ (R : FordFareyParameter), (R.p = P.p₂ ∧ R.q = P.q₂) → ((P₂.p₁ = P.p₁ ∧ P₂.q₁ = + P.q₁ ∧ P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁) → (∀ (x : GaussianInt), ((↑P.q₁ : ℤ) + + (1 : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q₂ : ℤ) - (1 : ℤ) ∧ (↑P.q₁ : ℤ) + (1 : ℤ) ≤ x.im ∧ x.im ≤ + (↑P.q₂ : ℤ) - (1 : ℤ)) → ( + let y : GaussianInt := x-⟨(P.q₁ : Int),(P.q₁ : Int)⟩ + y ∈ P4062T1InteriorSquare (P.q₂-P.q₁)))))))) ) := by + classical + intro P P₁ P₂ squareCoordinates horder H R hR hpar x hc y + apply (squareCoordinates (P.q₂-P.q₁) y).mpr + dsimp [y] + rw [Nat.cast_sub (by omega : P.q₁ ≤ P.q₂)] + exact ⟨by omega, by omega, by omega, by omega⟩ + +private theorem hcastAt656 : + (by + classical + exact + ∀ (P : FordFareyParameter), (FordFareyParameter) → (∀ (P₂ : FordFareyParameter), (P.q₁ < + P.q₂) → (∀ (H : FordFareyParameter), (H.q = P.q₂ - P.q₁) → (∀ (R : + FordFareyParameter), (R.p = P.p₂ ∧ R.q = P.q₂) → ((P₂.p₁ = P.p₁ ∧ P₂.q₁ = P.q₁ ∧ + P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁) → ((GaussianInt) → ((H.q : Int) = (P.q₂ : + Int)-P.q₁)))))) ) := by + classical + intro P P₁ P₂ horder H hHq R hR hpar y + calc + (H.q : Int) = ((P.q₂-P.q₁ : Nat) : Int) := by exact_mod_cast hHq + _ = (P.q₂ : Int)-P.q₁ := by + rw [Nat.cast_sub (by omega : P.q₁ ≤ P.q₂)] + +private theorem hu : + (by + classical + exact + ∀ (P : FordFareyParameter), (FordFareyParameter) → (∀ (P₂ : FordFareyParameter), (∀ (q : + Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : + Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → ((P.q = P.q₁ + P.q₂) → ((P.q₂ - P.q₁ < + P.q) → (∀ (H : FordFareyParameter), (H.q = P.q₂ - P.q₁) → (∀ (R : + FordFareyParameter), (R.p = P.p₂ ∧ R.q = P.q₂) → ((P₂.p₁ = P.p₁ ∧ P₂.q₁ = P.q₁ ∧ + P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁) → (∀ (y : GaussianInt), ((1 : ℤ) ≤ y.re ∧ y.re + ≤ (↑H.q : ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ y.im ∧ y.im ≤ (↑H.q : ℤ) - (1 : ℤ)) → (((H.q : + Int) = (P.q₂ : Int)-P.q₁) → (y+⟨0,(P.q₁ : Int)⟩ ∈ P4062T1InteriorSquare + P.q₂))))))))) ) := by + classical + intro P P₁ P₂ squareCoordinates hsum hdlt H hHq R hR hpar y hyc hcast + apply (squareCoordinates P.q₂ _).mpr + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] + exact ⟨by omega, by omega, by omega, by omega⟩ + +private theorem hv : + (by + classical + exact + ∀ (P : FordFareyParameter), (FordFareyParameter) → (∀ (P₂ : FordFareyParameter), (∀ (q : + Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : + Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → ((P.q = P.q₁ + P.q₂) → ((P.q₂ - P.q₁ < + P.q) → (∀ (H : FordFareyParameter), (H.q = P.q₂ - P.q₁) → (∀ (R : + FordFareyParameter), (R.p = P.p₂ ∧ R.q = P.q₂) → ((P₂.p₁ = P.p₁ ∧ P₂.q₁ = P.q₁ ∧ + P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁) → (∀ (y : GaussianInt), ((1 : ℤ) ≤ y.re ∧ y.re + ≤ (↑H.q : ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ y.im ∧ y.im ≤ (↑H.q : ℤ) - (1 : ℤ)) → (((H.q : + Int) = (P.q₂ : Int)-P.q₁) → (y+⟨(P.q₁ : Int),0⟩ ∈ P4062T1InteriorSquare + P.q₂))))))))) ) := by + classical + intro P P₁ P₂ squareCoordinates hsum hdlt H hHq R hR hpar y hyc hcast + apply (squareCoordinates P.q₂ _).mpr + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] + exact ⟨by omega, by omega, by omega, by omega⟩ + +private theorem hmem2 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (hr : Fin (4 : ℕ) → Finset GaussianInt), (hr 2 = + (P4062T1InteriorSquare P.q₂).image (fun y => y+⟨(P.q₁ : Int),0⟩)) → (∀ (y : + GaussianInt), (y+⟨0,(P.q₁ : Int)⟩ ∈ P4062T1InteriorSquare P.q₂) → (y+⟨(P.q₁ : + Int),(P.q₁ : Int)⟩ ∈ hr 2)) ) := by + classical + intro P hr hA2 y hu + rw [hA2] + apply Finset.mem_image.mpr + refine ⟨y+⟨0,(P.q₁ : Int)⟩, hu, ?_⟩ + ext <;> simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] <;> ring + +private theorem hmem3 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (hr : Fin (4 : ℕ) → Finset GaussianInt), (hr 3 = + (P4062T1InteriorSquare P.q₂).image (fun y => y+⟨0,(P.q₁ : Int)⟩)) → (∀ (y : + GaussianInt), (y+⟨(P.q₁ : Int),0⟩ ∈ P4062T1InteriorSquare P.q₂) → (y+⟨(P.q₁ : + Int),(P.q₁ : Int)⟩ ∈ hr 3)) ) := by + classical + intro P hr hA3 y hv + rw [hA3] + apply Finset.mem_image.mpr + refine ⟨y+⟨(P.q₁ : Int),0⟩, hv, ?_⟩ + ext <;> simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] <;> ring + +end OverlapDescentDetails + +theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) + (hP : 2 < P.q) + (hp₁ : P₁.p = P.p₁) (hq₁ : P₁.q = P.q₁) + (hp₂ : P₂.p = P.p₂) (hq₂ : P₂.q = P.q₂) : + let A := P4062T1RecursiveInteriors P + (P.q₂ < P.q₁ → ∃ H : FordFareyParameter, + H.p = P.p₁-P.p₂ ∧ H.q = P.q₁-P.q₂ ∧ H.q < P.q ∧ + P₁.p₁ = P.p₁-P.p₂ ∧ P₁.q₁ = P.q₁-P.q₂ ∧ + P₁.p₂ = P.p₂ ∧ P₁.q₂ = P.q₂ ∧ + A 0 ∩ A 1 = (P4062T1InteriorSquare H.q).image + (fun x => x+⟨(P.q₂ : Int), (P.q₂ : Int)⟩) ∧ + ∀ x ∈ A 0 ∩ A 1, + FourNeighborLaplacian (FordOdometer P) x = + FourNeighborLaplacian (FordOdometer H) + (x-⟨(P.q₂ : Int), (P.q₂ : Int)⟩)) ∧ + (P.q₁ < P.q₂ → ∃ H : FordFareyParameter, + H.p = P.p₂-P.p₁ ∧ H.q = P.q₂-P.q₁ ∧ H.q < P.q ∧ + P₂.p₁ = P.p₁ ∧ P₂.q₁ = P.q₁ ∧ + P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁ ∧ + A 2 ∩ A 3 = (P4062T1InteriorSquare H.q).image + (fun x => x+⟨(P.q₁ : Int), (P.q₁ : Int)⟩) ∧ + ∀ x ∈ A 2 ∩ A 3, + FourNeighborLaplacian (FordOdometer P) x = + FourNeighborLaplacian (FordOdometer H) + (x-⟨(P.q₁ : Int), (P.q₁ : Int)⟩)) := by +-- BODY + classical + have squareCoordinates (q : Nat) (x : GaussianInt) := OverlapDescentDetails.squareCoordinates q x + have hsum : P.q = P.q₁ + P.q₂ := P.sum_q + have hcrossdet := OverlapDescentDetails.hcrossdet P + have hpos₁ := OverlapDescentDetails.hpos₁ P P₁ P₂ hP hq₁ hsum + have hpos₂ : 0 < P.q₂ := P.q₂_pos + have hlt₁ : P.q₁ < P.q := P.q₁_lt + have hlt₂ : P.q₂ < P.q := by omega + have hred₁ := OverlapDescentDetails.hred₁ P hcrossdet + obtain ⟨_, _, _, _, _, hfamilyRec⟩ := + (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + have hrec := hfamilyRec P P₁ P₂ (by omega) hp₁ hq₁ hp₂ hq₂ + rcases hrec with ⟨hrec₀, hrec₁, hrec₂, hrec₃⟩ + have hrec₀' := OverlapDescentDetails.hrec₀' P P₁ hrec₀ + have hrec₁' := OverlapDescentDetails.hrec₁' P + P₁ hrec₁ + have hrec₂' := OverlapDescentDetails.hrec₂' P P₂ hrec₂ + have hrec₃' := OverlapDescentDetails.hrec₃' P P₂ hrec₃ + have hlapAffine (f f' : GaussianInt → Int) (x t : GaussianInt) + (A B C : Int) + (h0 : f x = f' (x - t) + A * x.re + B * x.im + C) + (hm : f (x - 1) = f' ((x - t) - 1) + A * (x - 1).re + + B * (x - 1).im + C) + (hp : f (x + 1) = f' ((x - t) + 1) + A * (x + 1).re + + B * (x + 1).im + C) + (hmi : f (x - ⟨0, 1⟩) = f' ((x - t) - ⟨0, 1⟩) + + A * (x - ⟨0, 1⟩).re + B * (x - ⟨0, 1⟩).im + C) + (hpi : f (x + ⟨0, 1⟩) = f' ((x - t) + ⟨0, 1⟩) + + A * (x + ⟨0, 1⟩).re + B * (x + ⟨0, 1⟩).im + C) := OverlapDescentDetails.hlapAffine f f' x + t A B C h0 hm hp hmi hpi + have hrec0Member (z : GaussianInt) + (a : 0 ≤ z.re) (b : z.re ≤ (P.q₁ : Int)) + (c : 0 ≤ z.im) (d : z.im ≤ (P.q₁ : Int)) := OverlapDescentDetails.hrec0Member P z a b c d + have hrec1Member (z : GaussianInt) + (a : (P.q₂ : Int) ≤ z.re) (b : z.re ≤ (P.q : Int)) + (c : (P.q₂ : Int) ≤ z.im) (d : z.im ≤ (P.q : Int)) := OverlapDescentDetails.hrec1Member P z + a b c d + have hrec2Member (z : GaussianInt) + (a : (P.q₁ : Int) ≤ z.re) (b : z.re ≤ (P.q : Int)) + (c : 0 ≤ z.im) (d : z.im ≤ (P.q₂ : Int)) := OverlapDescentDetails.hrec2Member P z a b c d + have hrec3Member (z : GaussianInt) + (a : 0 ≤ z.re) (b : z.re ≤ (P.q₂ : Int)) + (c : (P.q₁ : Int) ≤ z.im) (d : z.im ≤ (P.q : Int)) := OverlapDescentDetails.hrec3Member P z + a b c d + intro hr + have hA0 : hr 0 = P4062T1InteriorSquare P.q₁ := by rfl + have hA1 : hr 1 = (P4062T1InteriorSquare P.q₁).image + (fun y => y+⟨(P.q₂ : Int),(P.q₂ : Int)⟩) := by rfl + have hA2 : hr 2 = (P4062T1InteriorSquare P.q₂).image + (fun y => y+⟨(P.q₁ : Int),0⟩) := by rfl + have hA3 : hr 3 = (P4062T1InteriorSquare P.q₂).image + (fun y => y+⟨0,(P.q₁ : Int)⟩) := by rfl + constructor + · intro horder + have hdiff : 0 < P.q₁ - P.q₂ := by omega + have hdlt : P.q₁ - P.q₂ < P.q := by omega + have hdetdiff := OverlapDescentDetails.hdetdiffAt260 P P₁ P₂ + hcrossdet horder + have hcop := OverlapDescentDetails.hcopAt264 P + P₁ P₂ hcrossdet horder + obtain ⟨H, ⟨hHp,hHq⟩, _⟩ := + FordFareyParentsExist (P.p₁-P.p₂) (P.q₁-P.q₂) hdiff hcop + have hredParent : Nat.Coprime P.q₁ P.p₁.natAbs := hred₁.1 + let Q : FordFareyParameter := by + have hdet₂ : P.p₂ * (P.q₁ : Int) - + (P.q₂ : Int) * P.p₁ = -1 := by nlinarith only [hcrossdet] + refine FordFareyParameter.mk P.p₁ P.q₁ hpos₁ hredParent + (P.p₁-P.p₂) (P.q₁-P.q₂) P.p₂ P.q₂ ?_ ?_ ?_ ?_ ?_ ?_ ?_ + · ring + · omega + · exact hdetdiff + · exact hdet₂ + · omega + · exact hpos₂ + · intro hu + have : P.q₁ = 1 := by simpa using hu + omega + obtain ⟨R, hR, hRuniq⟩ := + FordFareyParentsExist P.p₁ P.q₁ hpos₁ hredParent + have hQeq : Q = P₁ := by + exact (hRuniq Q ⟨rfl, rfl⟩).trans (hRuniq P₁ ⟨hp₁, hq₁⟩).symm + have hpar : Q.p₁ = P.p₁-P.p₂ ∧ Q.q₁ = P.q₁-P.q₂ ∧ + Q.p₂ = P.p₂ ∧ Q.q₂ = P.q₂ := OverlapDescentDetails.hparAt293 P P₁ P₂ hP hsum hcrossdet + hpos₁ hpos₂ horder hdlt hdetdiff H hHq hredParent + have hparP : P₁.p₁ = P.p₁-P.p₂ ∧ P₁.q₁ = P.q₁-P.q₂ ∧ + P₁.p₂ = P.p₂ ∧ P₁.q₂ = P.q₂ := by simpa [hQeq] using hpar + have hchildRec := hfamilyRec P₁ H P₂ (by rw [hq₁]; omega) + (hHp.trans hparP.1.symm) (hHq.trans hparP.2.1.symm) + (hp₂.trans hparP.2.2.1.symm) (hq₂.trans hparP.2.2.2.symm) + rcases hchildRec with ⟨hch₀, hch₁, _, _⟩ + have hch₀' := OverlapDescentDetails.hch₀' P₁ H hch₀ + have hch₁' := OverlapDescentDetails.hch₁' P₁ H hch₁ + have hcoords (x : GaussianInt) (hx : x ∈ hr 0 ∩ hr 1) := OverlapDescentDetails.hcoordsAt312 P P₁ + P₂ hP squareCoordinates hsum hcrossdet hpos₁ hpos₂ hr hA0 hA1 horder hdlt hdetdiff H + hHq hredParent R x hx + have htarget := OverlapDescentDetails.htargetAt327 P P₁ P₂ hP hq₁ + hsum hcrossdet hpos₁ hpos₂ hrec₀' hrec₁' hlapAffine hrec0Member hrec1Member hr + horder hdlt hdetdiff H hHq hredParent R hR hpar hparP hch₀' hch₁' hcoords + refine ⟨H, hHp, hHq, by simpa [hHq] using hdlt, hparP.1, hparP.2.1, + hparP.2.2.1, hparP.2.2.2, ?_, htarget⟩ + ext x + constructor + · intro hx + have hc := hcoords x hx + let y : GaussianInt := x-⟨(P.q₂ : Int),(P.q₂ : Int)⟩ + have hy := OverlapDescentDetails.hyAt433 P P₁ P₂ + hP squareCoordinates hsum hcrossdet hpos₁ hpos₂ horder hdlt hdetdiff H hHq hredParent R + hR hpar hparP x hc + refine Finset.mem_image.mpr ⟨y, ?_, ?_⟩ + · simpa [hHq] using hy + · dsimp [y] + exact sub_add_cancel x ⟨(P.q₂ : Int),(P.q₂ : Int)⟩ + · intro hx + obtain ⟨y, hy, hxy⟩ := Finset.mem_image.mp hx + have hyc := (squareCoordinates H.q y).mp hy + have hcast := OverlapDescentDetails.hcastAt445 P P₁ P₂ hP + hsum hcrossdet hpos₁ hpos₂ horder hdlt hdetdiff H hHq hredParent R hR hpar hparP y + subst x + apply Finset.mem_inter.mpr + constructor + · apply (squareCoordinates P.q₁ _).mpr + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] + exact ⟨by omega, by omega, by omega, by omega⟩ + · apply Finset.mem_image.mpr + refine ⟨y, ?_, rfl⟩ + apply (squareCoordinates P.q₁ y).mpr + rw [hcast] at hyc + exact ⟨hyc.1, by omega, hyc.2.2.1, by omega⟩ + · intro horder + have hdiff : 0 < P.q₂ - P.q₁ := by omega + have hdlt : P.q₂ - P.q₁ < P.q := by omega + have hdetdiff := OverlapDescentDetails.hdetdiffAt465 P P₁ P₂ + hcrossdet horder + have hcop := OverlapDescentDetails.hcopAt469 P + P₁ P₂ hcrossdet horder + obtain ⟨H, ⟨hHp,hHq⟩, _⟩ := + FordFareyParentsExist (P.p₂-P.p₁) (P.q₂-P.q₁) hdiff hcop + have hredParent : Nat.Coprime P.q₂ P.p₂.natAbs := hred₁.2 + let Q : FordFareyParameter := by + have hdet₁ : P.p₁ * (P.q₂ : Int) - + (P.q₁ : Int) * P.p₂ = 1 := by nlinarith [hcrossdet] + refine FordFareyParameter.mk P.p₂ P.q₂ hpos₂ hredParent + P.p₁ P.q₁ (P.p₂-P.p₁) (P.q₂-P.q₁) ?_ ?_ ?_ ?_ ?_ ?_ ?_ + · ring + · omega + · exact hdet₁ + · exact hdetdiff + · omega + · omega + · intro hu + have : P.q₂ = 1 := by simpa using hu + omega + obtain ⟨R, hR, hRuniq⟩ := + FordFareyParentsExist P.p₂ P.q₂ hpos₂ hredParent + have hQeq : Q = P₂ := by + exact (hRuniq Q ⟨rfl, rfl⟩).trans (hRuniq P₂ ⟨hp₂, hq₂⟩).symm + have hpar : P₂.p₁ = P.p₁ ∧ P₂.q₁ = P.q₁ ∧ + P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁ := OverlapDescentDetails.hparAt498 P P₁ P₂ hP hsum + hcrossdet hpos₂ horder hdiff hdetdiff H hHq hredParent hQeq + have hchildRec := hfamilyRec P₂ P₁ H (by rw [hq₂]; omega) + (hp₁.trans hpar.1.symm) (hq₁.trans hpar.2.1.symm) + (hHp.trans hpar.2.2.1.symm) (hHq.trans hpar.2.2.2.symm) + rcases hchildRec with ⟨_, _, hch₂, hch₃⟩ + have hch₃' := OverlapDescentDetails.hch₃' P₂ H hch₃ + have hcoords (x : GaussianInt) (hx : x ∈ hr 2 ∩ hr 3) := OverlapDescentDetails.hcoordsAt511 P P₁ + P₂ squareCoordinates hr hA2 hA3 H R hR hpar x hx + have htarget := OverlapDescentDetails.htargetAt542 P P₁ P₂ hq₂ + hsum hlt₂ hrec₂' hlapAffine hrec2Member hr horder H hHq R hR hpar hch₃' hcoords + refine ⟨H, hHp, hHq, by simpa [hHq] using hdlt, + hpar.1, hpar.2.1, hpar.2.2.1, hpar.2.2.2, ?_, htarget⟩ + ext x + constructor + · intro hx + have hc := hcoords x hx + let y : GaussianInt := x-⟨(P.q₁ : Int),(P.q₁ : Int)⟩ + have hy := OverlapDescentDetails.hyAt644 P P₁ P₂ + squareCoordinates horder H R hR hpar x hc + refine Finset.mem_image.mpr ⟨y, ?_, ?_⟩ + · simpa [hHq] using hy + · dsimp [y] + exact sub_add_cancel x ⟨(P.q₁ : Int),(P.q₁ : Int)⟩ + · intro hx + obtain ⟨y, hy, hxy⟩ := Finset.mem_image.mp hx + have hyc := (squareCoordinates H.q y).mp hy + have hcast := OverlapDescentDetails.hcastAt656 P P₁ P₂ + horder H hHq R hR hpar y + have hsmall := hyc + rw [hcast] at hsmall + have hu := OverlapDescentDetails.hu P + P₁ P₂ squareCoordinates hsum hdlt H hHq R hR hpar y hyc hcast + have hv := OverlapDescentDetails.hv P + P₁ P₂ squareCoordinates hsum hdlt H hHq R hR hpar y hyc hcast + have hmem2 := OverlapDescentDetails.hmem2 P hr hA2 y hu + have hmem3 := OverlapDescentDetails.hmem3 P hr hA3 y hv + exact Finset.mem_inter.mpr + ⟨by simpa [hxy] using hmem2, by simpa [hxy] using hmem3⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1ParentGluing.lean b/LeanPool/ApollonianSuperharmonic/P4062T1ParentGluing.lean new file mode 100644 index 0000000000..49bb5e497d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4062T1ParentGluing.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorGeometry +public import LeanPool.ApollonianSuperharmonic.P4062T1ZeroIncoming +public import LeanPool.ApollonianSuperharmonic.ParentalOrientationGluing + +-- [TABLET NODE: P4062T1ParentGluing] + +/-! +# P4062T1ParentGluing + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4062T1ParentGluing (P : FordFareyParameter) (hP : 2 < P.q) + (σ : GaussianInt → Int) + (o : ∀ i, AcyclicIndegreeOrientation (P4062T1RecursiveInteriors P i) σ) + (t₀ : AcyclicIndegreeOrientation + (P4062T1RecursiveInteriors P 0 ∩ P4062T1RecursiveInteriors P 1) σ) + (t₂ : AcyclicIndegreeOrientation + (P4062T1RecursiveInteriors P 2 ∩ P4062T1RecursiveInteriors P 3) σ) : + ∃ t : AcyclicIndegreeOrientation + ((P4062T1RecursiveInteriors P 0 ∪ P4062T1RecursiveInteriors P 1) ∪ + (P4062T1RecursiveInteriors P 2 ∪ P4062T1RecursiveInteriors P 3)) σ, + ∀ i, ∀ x ∈ P4062T1RecursiveInteriors P i, + ∀ y ∈ P4062T1RecursiveInteriors P i, + t.edge x y ↔ (o i).edge x y := by +-- BODY + classical + let A := P4062T1RecursiveInteriors P + obtain ⟨hsub, hcross, hdis, hsep, hempty₂, hempty₀⟩ := + P4062T1InteriorGeometry P hP + have closed (i j : Fin 4) + (t : AcyclicIndegreeOrientation (A i ∩ A j) σ) : + ∀ x ∈ A i ∩ A j, ∀ y ∈ A i, (o i).edge y x → y ∈ A j := by + intro x hx y hy he + have hc := P4062T1ZeroIncoming (A i) (A i ∩ A j) σ + Finset.inter_subset_left (o i) t x hx y hy he + exact (Finset.mem_inter.mp hc).2 + obtain ⟨a, ha₀, ha₁⟩ := ParentalOrientationGluing (A 0) (A 1) σ + (o 0) (o 1) (hcross 0 1) (closed 0 1 t₀) + (by simpa only [Finset.inter_comm] using + (closed 1 0 (by simpa only [Finset.inter_comm] using t₀))) + obtain ⟨b, hb₂, hb₃⟩ := ParentalOrientationGluing (A 2) (A 3) σ + (o 2) (o 3) (hcross 2 3) (closed 2 3 t₂) + (by simpa only [Finset.inter_comm] using + (closed 3 2 (by simpa only [Finset.inter_comm] using t₂))) + have hi : (A 0 ∪ A 1) ∩ (A 2 ∪ A 3) = ∅ := + Finset.disjoint_iff_inter_eq_empty.mp hdis + obtain ⟨t, ht₀, ht₂⟩ := ParentalOrientationGluing _ _ σ a b + (by intro x hx _ y hy _; exact hsep x hx y hy) + (by intro x hx; rw [hi] at hx; simp at hx) + (by intro x hx; rw [hi] at hx; simp at hx) + refine ⟨t, ?_⟩ + intro i x hx y hy + fin_cases i + · exact (ht₀ x (Finset.mem_union_left _ hx) y (Finset.mem_union_left _ hy)).trans + (ha₀ x hx y hy) + · exact (ht₀ x (Finset.mem_union_right _ hx) y (Finset.mem_union_right _ hy)).trans + (ha₁ x hx y hy) + · exact (ht₂ x (Finset.mem_union_left _ hx) y (Finset.mem_union_left _ hy)).trans + (hb₂ x hx y hy) + · exact (ht₂ x (Finset.mem_union_right _ hx) y (Finset.mem_union_right _ hy)).trans + (hb₃ x hx y hy) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean new file mode 100644 index 0000000000..76a1e1be53 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean @@ -0,0 +1,518 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4062T1RecursiveInteriors +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import Mathlib.RingTheory.Int.Basic + +-- [TABLET NODE: P4062T1ParentalRestriction] + +/-! +# P4062T1ParentalRestriction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ParentalRestrictionProof + +private theorem squareCoordinates : + ∀ (q : ℕ), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ (1 : ℤ) ≤ x.re ∧ x.re ≤ (↑q : + ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑q : ℤ) - (1 : ℤ) := by + classical + intro q x + unfold P4062T1InteriorSquare + constructor + · intro hx + obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hx + obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab + exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, + (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ + · intro h + exact Finset.mem_image.mpr ⟨(x.re, x.im), + Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨h.1, h.2.1⟩, + Finset.mem_Icc.mpr h.2.2⟩, by cases x; rfl⟩ + +private theorem hparent₁pos : + ∀ (P : FordFareyParameter), ((2 : ℕ) < P.q) → ((P.q = P.q₁ + P.q₂) → (1 < P.q → 0 < P.q₁)) := by + classical + intro P hP hsum hbig + by_contra hn + have hz : P.q₁ = 0 := by omega + have hdvd : (P.q : Int) ∣ (1 : Int) := by + refine ⟨P.p₁, ?_⟩ + have hdet := P.det₁ + rw [hz] at hdet + have hmul : P.p₁ * (P.q : Int) = 1 := by simpa using hdet + calc + 1 = P.p₁ * (P.q : Int) := hmul.symm + _ = (P.q : Int) * P.p₁ := by ring + have hqint : 1 < (P.q : Int) := by exact_mod_cast hbig + have hle := Int.le_of_dvd (by norm_num : (0 : Int) < 1) hdvd + omega + +private theorem hparents : + ∀ (P : FordFareyParameter), (1 < P.q → 0 < P.q₁) → ((Nat.Coprime P.q₁ P.p₁.natAbs ∧ + Nat.Coprime P.q₂ P.p₂.natAbs) → (1 < P.q → ∃ P₁ P₂ : FordFareyParameter, P₁.p = P.p₁ ∧ + P₁.q = P.q₁ ∧ P₂.p = P.p₂ ∧ P₂.q = P.q₂)) := by + classical + intro P hparent₁pos hcoparents hbig + obtain ⟨P₁, ⟨hp₁, hq₁⟩, _⟩ := + FordFareyParentsExist P.p₁ P.q₁ (hparent₁pos hbig) hcoparents.1 + obtain ⟨P₂, ⟨hp₂, hq₂⟩, _⟩ := + FordFareyParentsExist P.p₂ P.q₂ P.q₂_pos hcoparents.2 + exact ⟨P₁, P₂, hp₁, hq₁, hp₂, hq₂⟩ + +private theorem hrecursive : + ∀ (P : FordFareyParameter), (1 < P.q → ∃ P₁ P₂ : FordFareyParameter, P₁.p = P.p₁ ∧ P₁.q = + P.q₁ ∧ P₂.p = P.p₂ ∧ P₂.q = P.q₂) → ((∀ (P : FordFareyParameter), ∀ (P₁ : + FordFareyParameter), ∀ (P₂ : FordFareyParameter), (1 : ℕ) < P.q → P₁.p = P.p₁ → P₁.q = + P.q₁ → P₂.p = P.p₂ → P₂.q = P.q₂ → (∀ x ∈ FordRecursiveVertexDomains P (0 : Fin (4 : ℕ)), + Classical.choose FordOdometerFamilyExistsUnique P x = Classical.choose + FordOdometerFamilyExistsUnique P₁ x) ∧ (∀ x ∈ FordRecursiveVertexDomains P (1 : Fin (4 : + ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = Classical.choose + FordOdometerFamilyExistsUnique P₁ (x - ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) + P.p₂ * x.re + P.p₂ * + x.im - P.p₂ * (↑P.q₂ : ℤ) + (1 : ℤ)) ∧ (∀ x ∈ FordRecursiveVertexDomains P (2 : Fin (4 : + ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = Classical.choose + FordOdometerFamilyExistsUnique P₂ (x - ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩) + P.p₁ * x.im) ∧ ∀ x ∈ + FordRecursiveVertexDomains P (3 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique P₂ + (x - ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩) + P.p₁ * x.re) → (1 < P.q → ∃ P₁ P₂ : FordFareyParameter, + P₁.p = P.p₁ ∧ P₁.q = P.q₁ ∧ P₂.p = P.p₂ ∧ P₂.q = P.q₂ ∧ (∀ x, x ∈ + FordRecursiveVertexDomains P 0 → FordOdometer P x = FordOdometer P₁ x) ∧ (∀ x, x ∈ + FordRecursiveVertexDomains P 1 → FordOdometer P x = FordOdometer P₁ (x - ⟨(P.q₂ : Int), + (P.q₂ : Int)⟩) + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (P.q₂ : Int) + 1) ∧ (∀ x, x ∈ + FordRecursiveVertexDomains P 2 → FordOdometer P x = FordOdometer P₂ (x - ⟨(P.q₁ : Int), + 0⟩) + P.p₁ * x.im) ∧ (∀ x, x ∈ FordRecursiveVertexDomains P 3 → FordOdometer P x = + FordOdometer P₂ (x - ⟨0, (P.q₁ : Int)⟩) + P.p₁ * x.re))) := by + classical + intro P hparents hrec hbig + rcases hparents hbig with ⟨P₁, P₂, hp₁, hq₁, hp₂, hq₂⟩ + obtain ⟨rec₀, rec₁, rec₂, rec₃⟩ := + hrec P P₁ P₂ hbig hp₁ hq₁ hp₂ hq₂ + refine ⟨P₁, P₂, hp₁, hq₁, hp₂, hq₂, ?_, ?_, ?_, ?_⟩ + · intro x hx + simpa [FordOdometer] using rec₀ x hx + · intro x hx + simpa [FordOdometer] using rec₁ x hx + · intro x hx + simpa [FordOdometer] using rec₂ x hx + · intro x hx + simpa [FordOdometer] using rec₃ x hx + +private theorem hlapAffine : + ∀ (f : GaussianInt → ℤ), ∀ (f' : GaussianInt → ℤ), ∀ (x : GaussianInt), ∀ (t : GaussianInt), + ∀ (A : ℤ), ∀ (B : ℤ), ∀ (C : ℤ), f x = f' (x - t) + A * x.re + B * x.im + C → f (x - (1 : + GaussianInt)) = f' (x - t - (1 : GaussianInt)) + A * (x - (1 : GaussianInt)).re + B * (x + - (1 : GaussianInt)).im + C → f (x + (1 : GaussianInt)) = f' (x - t + (1 : GaussianInt)) + + A * (x + (1 : GaussianInt)).re + B * (x + (1 : GaussianInt)).im + C → f (x - ⟨(0 : ℤ), + (1 : ℤ)⟩) = f' (x - t - ⟨(0 : ℤ), (1 : ℤ)⟩) + A * (x - ⟨(0 : ℤ), (1 : ℤ)⟩).re + B * (x - + ⟨(0 : ℤ), (1 : ℤ)⟩).im + C → f (x + ⟨(0 : ℤ), (1 : ℤ)⟩) = f' (x - t + ⟨(0 : ℤ), (1 : ℤ)⟩) + + A * (x + ⟨(0 : ℤ), (1 : ℤ)⟩).re + B * (x + ⟨(0 : ℤ), (1 : ℤ)⟩).im + C → + FourNeighborLaplacian f x = FourNeighborLaplacian f' (x - t) := by + classical + intro f f' x t A B C h0 hm hp hmi hpi + rw [FourNeighborLaplacian, hm, hp, hmi, hpi, h0, + FourNeighborLaplacian] + rw [show x - t - 1 = (x - t) - 1 by abel, + show x - t + 1 = (x - t) + 1 by abel, + show x - t - ⟨0, 1⟩ = (x - t) - ⟨0, 1⟩ by rfl, + show x - t + ⟨0, 1⟩ = (x - t) + ⟨0, 1⟩ by rfl] + simp + ring + +private theorem hchild0Lap : + ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (FordFareyParameter) → ((P₁.q = + P.q₁) → ((∀ x ∈ FordRecursiveVertexDomains P (0 : Fin (4 : ℕ)), FordOdometer P x = + FordOdometer P₁ x) → ((∀ (z : GaussianInt), (0 ≤ z.re) → ((z.re ≤ (P.q₁ : Int)) → ((0 ≤ + z.im) → ((z.im ≤ (P.q₁ : Int)) → (z ∈ FordRecursiveVertexDomains P 0))))) → (∀ (x : + GaussianInt), (1 : ℤ) ≤ x.re → x.re ≤ (↑P.q₁ : ℤ) - (1 : ℤ) → (1 : ℤ) ≤ x.im → x.im ≤ + (↑P.q₁ : ℤ) - (1 : ℤ) → FourNeighborLaplacian (FordOdometer P) x = FourNeighborLaplacian + (FordOdometer P₁) x)))) := by + classical + intro P P₁ P₂ hq₁ hrec₀ hrec0Member x hxr hxr' hxi hxi' + have hmem : + x ∈ FordRecursiveVertexDomains P 0 ∧ + x - 1 ∈ FordRecursiveVertexDomains P 0 ∧ + x + 1 ∈ FordRecursiveVertexDomains P 0 ∧ + x - ⟨0, 1⟩ ∈ FordRecursiveVertexDomains P 0 ∧ + x + ⟨0, 1⟩ ∈ FordRecursiveVertexDomains P 0 := by + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · exact hrec0Member x (by omega) (by omega) (by omega) (by omega) + · apply hrec0Member (x - 1) <;> + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, + Zsqrtd.im_one] <;> omega + · apply hrec0Member (x + 1) <;> + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, + Zsqrtd.im_one] <;> omega + · apply hrec0Member (x - ⟨0, 1⟩) <;> + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, + ] <;> omega + · apply hrec0Member (x + ⟨0, 1⟩) <;> + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] <;> omega + unfold FourNeighborLaplacian + rw [hrec₀ x hmem.1, hrec₀ (x - 1) hmem.2.1, + hrec₀ (x + 1) hmem.2.2.1, + hrec₀ (x - ⟨0, 1⟩) hmem.2.2.2.1, + hrec₀ (x + ⟨0, 1⟩) hmem.2.2.2.2] + +private theorem hchild1Lap : + ∀ (P : FordFareyParameter), (P.q = P.q₁ + P.q₂) → (∀ (P₁ : FordFareyParameter), ∀ (P₂ : + FordFareyParameter), (P₁.q = P.q₁) → ((P₂.q = P.q₂) → ((∀ x ∈ FordRecursiveVertexDomains + P (1 : Fin (4 : ℕ)), FordOdometer P x = FordOdometer P₁ (x - ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) + + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (↑P.q₂ : ℤ) + (1 : ℤ)) → ((∀ (f : GaussianInt → + Int), ∀ (f' : GaussianInt → Int), ∀ (x : GaussianInt), ∀ (t : GaussianInt), ∀ (A : Int), + ∀ (B : Int), ∀ (C : Int), (f x = f' (x - t) + A * x.re + B * x.im + C) → ((f (x - 1) + = f' + ((x - t) - 1) + A * (x - 1).re + B * (x - 1).im + C) → ((f (x + 1) = f' ((x - t) + 1) + A + * (x + 1).re + B * (x + 1).im + C) → ((f (x - ⟨0, 1⟩) = f' ((x - t) - ⟨0, 1⟩) + A * (x - + ⟨0, 1⟩).re + B * (x - ⟨0, 1⟩).im + C) → ((f (x + ⟨0, 1⟩) = f' ((x - t) + ⟨0, 1⟩) + A * (x + + ⟨0, 1⟩).re + B * (x + ⟨0, 1⟩).im + C) → (FourNeighborLaplacian f x = + FourNeighborLaplacian f' (x - t))))))) → ((∀ (z : GaussianInt), ((P.q₂ : Int) ≤ z.re) → + ((z.re ≤ (P.q : Int)) → (((P.q₂ : Int) ≤ z.im) → ((z.im ≤ (P.q : Int)) → (z ∈ + FordRecursiveVertexDomains P 1))))) → (∀ (x : GaussianInt), (↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.re + → x.re ≤ (↑P.q : ℤ) - (1 : ℤ) → (↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.im → x.im ≤ (↑P.q : ℤ) - (1 : + ℤ) → FourNeighborLaplacian (FordOdometer P) x = FourNeighborLaplacian (FordOdometer P₁) + (x - ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩))))))) := by + classical + intro P hsum P₁ P₂ hq₁ hq₂ hrec₁ hlapAffine hrec1Member x hxr hxr' hxi hxi' + have hmem : + x ∈ FordRecursiveVertexDomains P 1 ∧ + x - 1 ∈ FordRecursiveVertexDomains P 1 ∧ + x + 1 ∈ FordRecursiveVertexDomains P 1 ∧ + x - ⟨0, 1⟩ ∈ FordRecursiveVertexDomains P 1 ∧ + x + ⟨0, 1⟩ ∈ FordRecursiveVertexDomains P 1 := by + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · exact hrec1Member x (by omega) (by omega) (by omega) (by omega) + · apply hrec1Member (x - 1) <;> + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, + Zsqrtd.im_one] <;> omega + · apply hrec1Member (x + 1) <;> + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, + Zsqrtd.im_one] <;> omega + · apply hrec1Member (x - ⟨0, 1⟩) <;> + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, + ] <;> omega + · apply hrec1Member (x + ⟨0, 1⟩) <;> + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] <;> omega + apply hlapAffine (FordOdometer P) (FordOdometer P₁) x + ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ P.p₂ P.p₂ + (-P.p₂ * (P.q₂ : Int) + 1) + · convert hrec₁ x hmem.1 using 1; ring + · convert hrec₁ (x - 1) hmem.2.1 using 1; ring + · convert hrec₁ (x + 1) hmem.2.2.1 using 1; ring + · convert hrec₁ (x - ⟨0, 1⟩) hmem.2.2.2.1 using 1; ring + · convert hrec₁ (x + ⟨0, 1⟩) hmem.2.2.2.2 using 1; ring + +private theorem hchild2Lap : + ∀ (P : FordFareyParameter), (P.q = P.q₁ + P.q₂) → (∀ (P₁ : FordFareyParameter), ∀ (P₂ : + FordFareyParameter), (P₁.q = P.q₁) → ((P₂.q = P.q₂) → ((∀ x ∈ FordRecursiveVertexDomains + P (2 : Fin (4 : ℕ)), FordOdometer P x = FordOdometer P₂ (x - ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩) + + P.p₁ * x.im) → ((∀ (f : GaussianInt → Int), ∀ (f' : GaussianInt → Int), ∀ (x : + GaussianInt), ∀ (t : GaussianInt), ∀ (A : Int), ∀ (B : Int), ∀ (C : Int), (f x = f' (x - + t) + A * x.re + B * x.im + C) → ((f (x - 1) = f' ((x - t) - 1) + A * (x - 1).re + B * (x + - 1).im + C) → ((f (x + 1) = f' ((x - t) + 1) + A * (x + 1).re + B * (x + 1).im + C) → + ((f (x - ⟨0, 1⟩) = f' ((x - t) - ⟨0, 1⟩) + A * (x - ⟨0, 1⟩).re + B * (x - ⟨0, 1⟩).im + C) + → ((f (x + ⟨0, 1⟩) = f' ((x - t) + ⟨0, 1⟩) + A * (x + ⟨0, 1⟩).re + B * (x + ⟨0, 1⟩).im + + C) → (FourNeighborLaplacian f x = FourNeighborLaplacian f' (x - t))))))) → ((∀ (z : + GaussianInt), ((P.q₁ : Int) ≤ z.re) → ((z.re ≤ (P.q : Int)) → ((0 ≤ z.im) → ((z.im ≤ + (P.q₂ : Int)) → (z ∈ FordRecursiveVertexDomains P 2))))) → (∀ (x : GaussianInt), (↑P.q₁ : + ℤ) + (1 : ℤ) ≤ x.re → x.re ≤ (↑P.q : ℤ) - (1 : ℤ) → (1 : ℤ) ≤ x.im → x.im ≤ (↑P.q₂ : ℤ) - + (1 : ℤ) → FourNeighborLaplacian (FordOdometer P) x = FourNeighborLaplacian (FordOdometer + P₂) (x - ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩))))))) := by + classical + intro P hsum P₁ P₂ hq₁ hq₂ hrec₂ hlapAffine hrec2Member x hxr hxr' hxi hxi' + have hmem : + x ∈ FordRecursiveVertexDomains P 2 ∧ + x - 1 ∈ FordRecursiveVertexDomains P 2 ∧ + x + 1 ∈ FordRecursiveVertexDomains P 2 ∧ + x - ⟨0, 1⟩ ∈ FordRecursiveVertexDomains P 2 ∧ + x + ⟨0, 1⟩ ∈ FordRecursiveVertexDomains P 2 := by + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · exact hrec2Member x (by omega) (by omega) (by omega) (by omega) + · apply hrec2Member (x - 1) <;> + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, + Zsqrtd.im_one] <;> omega + · apply hrec2Member (x + 1) <;> + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, + Zsqrtd.im_one] <;> omega + · apply hrec2Member (x - ⟨0, 1⟩) <;> + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, + ] <;> omega + · apply hrec2Member (x + ⟨0, 1⟩) <;> + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] <;> omega + apply hlapAffine (FordOdometer P) (FordOdometer P₂) x + ⟨(P.q₁ : Int), 0⟩ 0 P.p₁ 0 + · convert hrec₂ x hmem.1 using 1; ring + · convert hrec₂ (x - 1) hmem.2.1 using 1; ring + · convert hrec₂ (x + 1) hmem.2.2.1 using 1; ring + · convert hrec₂ (x - ⟨0, 1⟩) hmem.2.2.2.1 using 1; ring + · convert hrec₂ (x + ⟨0, 1⟩) hmem.2.2.2.2 using 1; ring + +private theorem hchild3Lap : + ∀ (P : FordFareyParameter), (P.q = P.q₁ + P.q₂) → (∀ (P₁ : FordFareyParameter), ∀ (P₂ : + FordFareyParameter), (P₁.q = P.q₁) → ((P₂.q = P.q₂) → ((∀ x ∈ FordRecursiveVertexDomains + P (3 : Fin (4 : ℕ)), FordOdometer P x = FordOdometer P₂ (x - ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩) + + P.p₁ * x.re) → ((∀ (f : GaussianInt → Int), ∀ (f' : GaussianInt → Int), ∀ (x : + GaussianInt), ∀ (t : GaussianInt), ∀ (A : Int), ∀ (B : Int), ∀ (C : Int), (f x = f' (x - + t) + A * x.re + B * x.im + C) → ((f (x - 1) = f' ((x - t) - 1) + A * (x - 1).re + B * (x + - 1).im + C) → ((f (x + 1) = f' ((x - t) + 1) + A * (x + 1).re + B * (x + 1).im + C) → + ((f (x - ⟨0, 1⟩) = f' ((x - t) - ⟨0, 1⟩) + A * (x - ⟨0, 1⟩).re + B * (x - ⟨0, 1⟩).im + C) + → ((f (x + ⟨0, 1⟩) = f' ((x - t) + ⟨0, 1⟩) + A * (x + ⟨0, 1⟩).re + B * (x + ⟨0, 1⟩).im + + C) → (FourNeighborLaplacian f x = FourNeighborLaplacian f' (x - t))))))) → ((∀ (z : + GaussianInt), (0 ≤ z.re) → ((z.re ≤ (P.q₂ : Int)) → (((P.q₁ : Int) ≤ z.im) → ((z.im ≤ + (P.q : Int)) → (z ∈ FordRecursiveVertexDomains P 3))))) → (∀ (x : GaussianInt), (1 : ℤ) ≤ + x.re → x.re ≤ (↑P.q₂ : ℤ) - (1 : ℤ) → (↑P.q₁ : ℤ) + (1 : ℤ) ≤ x.im → x.im ≤ (↑P.q : ℤ) - + (1 : ℤ) → FourNeighborLaplacian (FordOdometer P) x = FourNeighborLaplacian (FordOdometer + P₂) (x - ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩))))))) := by + classical + intro P hsum P₁ P₂ hq₁ hq₂ hrec₃ hlapAffine hrec3Member x hxr hxr' hxi hxi' + have hmem : + x ∈ FordRecursiveVertexDomains P 3 ∧ + x - 1 ∈ FordRecursiveVertexDomains P 3 ∧ + x + 1 ∈ FordRecursiveVertexDomains P 3 ∧ + x - ⟨0, 1⟩ ∈ FordRecursiveVertexDomains P 3 ∧ + x + ⟨0, 1⟩ ∈ FordRecursiveVertexDomains P 3 := by + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · exact hrec3Member x (by omega) (by omega) (by omega) (by omega) + · apply hrec3Member (x - 1) <;> + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, + Zsqrtd.im_one] <;> omega + · apply hrec3Member (x + 1) <;> + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, + Zsqrtd.im_one] <;> omega + · apply hrec3Member (x - ⟨0, 1⟩) <;> + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, + ] <;> omega + · apply hrec3Member (x + ⟨0, 1⟩) <;> + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] <;> omega + apply hlapAffine (FordOdometer P) (FordOdometer P₂) x + ⟨0, (P.q₁ : Int)⟩ P.p₁ 0 0 + · convert hrec₃ x hmem.1 using 1; ring + · convert hrec₃ (x - 1) hmem.2.1 using 1; ring + · convert hrec₃ (x + 1) hmem.2.2.1 using 1; ring + · convert hrec₃ (x - ⟨0, 1⟩) hmem.2.2.2.1 using 1; ring + · convert hrec₃ (x + ⟨0, 1⟩) hmem.2.2.2.2 using 1; ring + +end ParentalRestrictionProof + +theorem P4062T1ParentalRestriction (P : FordFareyParameter) + (hP : 2 < P.q) : + ∃ P₁ P₂ : FordFareyParameter, + P₁.p = P.p₁ ∧ P₁.q = P.q₁ ∧ P₂.p = P.p₂ ∧ P₂.q = P.q₂ ∧ + P₁.q < P.q ∧ P₂.q < P.q ∧ P.q₁ ≠ P.q₂ ∧ + ∀ i : Fin 4, + let R := if i.val < 2 then P₁ else P₂ + let u : GaussianInt := + ![0, ⟨(P.q₂ : Int), (P.q₂ : Int)⟩, + ⟨(P.q₁ : Int), 0⟩, ⟨0, (P.q₁ : Int)⟩] i + P4062T1RecursiveInteriors P i = + (P4062T1InteriorSquare R.q).image (fun x => x+u) ∧ + ∀ x ∈ P4062T1RecursiveInteriors P i, + FourNeighborLaplacian (FordOdometer P) x = + FourNeighborLaplacian (FordOdometer R) (x-u) := by +-- BODY + classical + have squareCoordinates (q : Nat) (x : GaussianInt) : + x ∈ P4062T1InteriorSquare q ↔ + 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ + 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 := ParentalRestrictionProof.squareCoordinates q x + have hqpos : 0 < P.q := P.q_pos + have hsum : P.q = P.q₁ + P.q₂ := P.sum_q + have hparent₁ : P.q₁ < P.q := P.q₁_lt + have hcrossdet : P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1 := by + have hdet := P.det₁ + have hsumI : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q + rw [hsumI, P.sum_p] at hdet + nlinarith only [hdet] + have hparent₁pos : 1 < P.q → 0 < P.q₁ := ParentalRestrictionProof.hparent₁pos P hP hsum + have hparent₂lt : 1 < P.q → P.q₂ < P.q := by + intro hbig + have hpos := hparent₁pos hbig + omega + have hcoparents : + Nat.Coprime P.q₁ P.p₁.natAbs ∧ Nat.Coprime P.q₂ P.p₂.natAbs := by + have h₁ : IsCoprime (P.q₁ : Int) P.p₁ := + ⟨-P.p₂, (P.q₂ : Int), by nlinarith only [hcrossdet]⟩ + have h₂ : IsCoprime (P.q₂ : Int) P.p₂ := + ⟨P.p₁, -(P.q₁ : Int), by nlinarith only [hcrossdet]⟩ + exact ⟨by simpa using Int.isCoprime_iff_nat_coprime.mp h₁, + by simpa using Int.isCoprime_iff_nat_coprime.mp h₂⟩ + have hparents : 1 < P.q → + ∃ P₁ P₂ : FordFareyParameter, + P₁.p = P.p₁ ∧ P₁.q = P.q₁ ∧ + P₂.p = P.p₂ ∧ P₂.q = P.q₂ := ParentalRestrictionProof.hparents P hparent₁pos hcoparents + obtain ⟨hbase, hbdy, hneg, hpos, hneg₂, hrec⟩ := + (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + have hrecursive : 1 < P.q → + ∃ P₁ P₂ : FordFareyParameter, + P₁.p = P.p₁ ∧ P₁.q = P.q₁ ∧ + P₂.p = P.p₂ ∧ P₂.q = P.q₂ ∧ + (∀ x, x ∈ FordRecursiveVertexDomains P 0 → + FordOdometer P x = FordOdometer P₁ x) ∧ + (∀ x, x ∈ FordRecursiveVertexDomains P 1 → + FordOdometer P x = FordOdometer P₁ + (x - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩) + + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (P.q₂ : Int) + 1) ∧ + (∀ x, x ∈ FordRecursiveVertexDomains P 2 → + FordOdometer P x = FordOdometer P₂ + (x - ⟨(P.q₁ : Int), 0⟩) + P.p₁ * x.im) ∧ + (∀ x, x ∈ FordRecursiveVertexDomains P 3 → + FordOdometer P x = FordOdometer P₂ + (x - ⟨0, (P.q₁ : Int)⟩) + P.p₁ * x.re) := ParentalRestrictionProof.hrecursive P + hparents hrec + have hbig : 1 < P.q := by omega + rcases hrecursive hbig with + ⟨P₁, P₂, hp₁, hq₁, hp₂, hq₂, hrec₀, hrec₁, hrec₂, hrec₃⟩ + have hlapAffine (f f' : GaussianInt → Int) + (x t : GaussianInt) (A B C : Int) + (h0 : f x = f' (x - t) + A * x.re + B * x.im + C) + (hm : f (x - 1) = f' ((x - t) - 1) + + A * (x - 1).re + B * (x - 1).im + C) + (hp : f (x + 1) = f' ((x - t) + 1) + + A * (x + 1).re + B * (x + 1).im + C) + (hmi : f (x - ⟨0, 1⟩) = f' ((x - t) - ⟨0, 1⟩) + + A * (x - ⟨0, 1⟩).re + B * (x - ⟨0, 1⟩).im + C) + (hpi : f (x + ⟨0, 1⟩) = f' ((x - t) + ⟨0, 1⟩) + + A * (x + ⟨0, 1⟩).re + B * (x + ⟨0, 1⟩).im + C) : + FourNeighborLaplacian f x = FourNeighborLaplacian f' (x - t) := + ParentalRestrictionProof.hlapAffine f f' x t A B C h0 hm hp hmi hpi + have hrec0Member (z : GaussianInt) + (hzr : 0 ≤ z.re) (hzr' : z.re ≤ (P.q₁ : Int)) + (hzi : 0 ≤ z.im) (hzi' : z.im ≤ (P.q₁ : Int)) : + z ∈ FordRecursiveVertexDomains P 0 := by + change 0 ≤ z.re ∧ z.re ≤ (P.q₁ : Int) ∧ + 0 ≤ z.im ∧ z.im ≤ (P.q₁ : Int) + exact ⟨hzr, hzr', hzi, hzi'⟩ + have hchild0Lap (x : GaussianInt) + (hxr : 1 ≤ x.re) (hxr' : x.re ≤ (P.q₁ : Int) - 1) + (hxi : 1 ≤ x.im) (hxi' : x.im ≤ (P.q₁ : Int) - 1) : + FourNeighborLaplacian (FordOdometer P) x = + FourNeighborLaplacian (FordOdometer P₁) x := ParentalRestrictionProof.hchild0Lap P P₁ P₂ + hq₁ hrec₀ hrec0Member x hxr hxr' hxi hxi' + have hrec1Member (z : GaussianInt) + (hzr : (P.q₂ : Int) ≤ z.re) (hzr' : z.re ≤ (P.q : Int)) + (hzi : (P.q₂ : Int) ≤ z.im) (hzi' : z.im ≤ (P.q : Int)) : + z ∈ FordRecursiveVertexDomains P 1 := by + change (P.q₂ : Int) ≤ z.re ∧ z.re ≤ (P.q : Int) ∧ + (P.q₂ : Int) ≤ z.im ∧ z.im ≤ (P.q : Int) + exact ⟨hzr, hzr', hzi, hzi'⟩ + have hchild1Lap (x : GaussianInt) + (hxr : (P.q₂ : Int) + 1 ≤ x.re) + (hxr' : x.re ≤ (P.q : Int) - 1) + (hxi : (P.q₂ : Int) + 1 ≤ x.im) + (hxi' : x.im ≤ (P.q : Int) - 1) : + FourNeighborLaplacian (FordOdometer P) x = + FourNeighborLaplacian (FordOdometer P₁) + (x - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩) := ParentalRestrictionProof.hchild1Lap P hsum P₁ P₂ + hq₁ hq₂ hrec₁ hlapAffine hrec1Member x hxr hxr' hxi hxi' + have hrec2Member (z : GaussianInt) + (hzr : (P.q₁ : Int) ≤ z.re) (hzr' : z.re ≤ (P.q : Int)) + (hzi : 0 ≤ z.im) (hzi' : z.im ≤ (P.q₂ : Int)) : + z ∈ FordRecursiveVertexDomains P 2 := by + change (P.q₁ : Int) ≤ z.re ∧ z.re ≤ (P.q : Int) ∧ + 0 ≤ z.im ∧ z.im ≤ (P.q₂ : Int) + exact ⟨hzr, hzr', hzi, hzi'⟩ + have hchild2Lap (x : GaussianInt) + (hxr : (P.q₁ : Int) + 1 ≤ x.re) + (hxr' : x.re ≤ (P.q : Int) - 1) + (hxi : 1 ≤ x.im) + (hxi' : x.im ≤ (P.q₂ : Int) - 1) : + FourNeighborLaplacian (FordOdometer P) x = + FourNeighborLaplacian (FordOdometer P₂) + (x - ⟨(P.q₁ : Int), 0⟩) := ParentalRestrictionProof.hchild2Lap P hsum P₁ P₂ hq₁ hq₂ + hrec₂ hlapAffine hrec2Member x hxr hxr' hxi hxi' + have hrec3Member (z : GaussianInt) + (hzr : 0 ≤ z.re) (hzr' : z.re ≤ (P.q₂ : Int)) + (hzi : (P.q₁ : Int) ≤ z.im) (hzi' : z.im ≤ (P.q : Int)) : + z ∈ FordRecursiveVertexDomains P 3 := by + change 0 ≤ z.re ∧ z.re ≤ (P.q₂ : Int) ∧ + (P.q₁ : Int) ≤ z.im ∧ z.im ≤ (P.q : Int) + exact ⟨hzr, hzr', hzi, hzi'⟩ + have hchild3Lap (x : GaussianInt) + (hxr : 1 ≤ x.re) (hxr' : x.re ≤ (P.q₂ : Int) - 1) + (hxi : (P.q₁ : Int) + 1 ≤ x.im) + (hxi' : x.im ≤ (P.q : Int) - 1) : + FourNeighborLaplacian (FordOdometer P) x = + FourNeighborLaplacian (FordOdometer P₂) + (x - ⟨0, (P.q₁ : Int)⟩) := ParentalRestrictionProof.hchild3Lap P hsum P₁ P₂ hq₁ hq₂ + hrec₃ hlapAffine hrec3Member x hxr hxr' hxi hxi' + have hne : P.q₁ ≠ P.q₂ := by + intro he + have hd : (P.q₁ : Int) ∣ (1 : Int) := by + refine ⟨P.p₁-P.p₂, ?_⟩ + rw [← he] at hcrossdet + nlinarith only [hcrossdet] + have hb := Int.le_of_dvd (by norm_num : (0 : Int) < 1) hd + have hp := P.q₂_pos + omega + refine ⟨P₁, P₂, hp₁, hq₁, hp₂, hq₂, ?_, ?_, hne, ?_⟩ + · rw [hq₁] + exact P.q₁_lt + · rw [hq₂] + exact hparent₂lt hbig + · intro i + fin_cases i + · change P4062T1InteriorSquare P.q₁ = + (P4062T1InteriorSquare P₁.q).image (fun x => x+0) ∧ + ∀ x ∈ P4062T1InteriorSquare P.q₁, + FourNeighborLaplacian (FordOdometer P) x = + FourNeighborLaplacian (FordOdometer P₁) (x-0) + constructor + · simp [hq₁] + · intro x hx + have hb := (squareCoordinates P.q₁ x).mp hx + simpa using hchild0Lap x hb.1 hb.2.1 hb.2.2.1 hb.2.2.2 + · change (P4062T1InteriorSquare P.q₁).image + (fun x => x+⟨(P.q₂ : Int), (P.q₂ : Int)⟩) = + (P4062T1InteriorSquare P₁.q).image + (fun x => x+⟨(P.q₂ : Int), (P.q₂ : Int)⟩) ∧ _ + constructor + · rw [hq₁] + · intro x hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx + have hb := (squareCoordinates P.q₁ y).mp hy + apply hchild1Lap + all_goals simp only [Zsqrtd.re_add, Zsqrtd.im_add] + all_goals omega + · change (P4062T1InteriorSquare P.q₂).image + (fun x => x+⟨(P.q₁ : Int), 0⟩) = + (P4062T1InteriorSquare P₂.q).image + (fun x => x+⟨(P.q₁ : Int), 0⟩) ∧ _ + constructor + · rw [hq₂] + · intro x hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx + have hb := (squareCoordinates P.q₂ y).mp hy + apply hchild2Lap + all_goals simp only [Zsqrtd.re_add, Zsqrtd.im_add, add_zero] + all_goals omega + · change (P4062T1InteriorSquare P.q₂).image + (fun x => x+⟨0, (P.q₁ : Int)⟩) = + (P4062T1InteriorSquare P₂.q).image + (fun x => x+⟨0, (P.q₁ : Int)⟩) ∧ _ + constructor + · rw [hq₂] + · intro x hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx + have hb := (squareCoordinates P.q₂ y).mp hy + apply hchild3Lap + all_goals simp only [Zsqrtd.re_add, Zsqrtd.im_add, add_zero] + all_goals omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1RankedAttachment.lean b/LeanPool/ApollonianSuperharmonic/P4062T1RankedAttachment.lean new file mode 100644 index 0000000000..c895284912 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4062T1RankedAttachment.lean @@ -0,0 +1,178 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation +public import Mathlib.Order.Interval.Finset.Nat + +/-! +# P4062T1RankedAttachment + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + + +-- [TABLET NODE: P4062T1RankedAttachment] +theorem P4062T1RankedAttachment (D E : Finset GaussianInt) + (σ : GaussianInt → Int) (d : GaussianInt → Nat) + (hE : E ⊆ D) (o : AcyclicIndegreeOrientation E σ) + (hres : ∀ x ∈ D \ E, + ((@Finset.filter GaussianInt (fun y => FourNeighborAdjacent y x) + (fun _ => Classical.propDecidable _) E).card : Int) + + ((@Finset.filter GaussianInt (fun y => FourNeighborAdjacent y x ∧ d y < d x) + (fun _ => Classical.propDecidable _) (D \ E)).card : Int) + = σ x) + (hstrict : ∀ x ∈ D \ E, ∀ y ∈ D \ E, + FourNeighborAdjacent x y → d x ≠ d y) : + ∃ t : AcyclicIndegreeOrientation D σ, + (∀ x ∈ E, ∀ y ∈ E, t.edge x y ↔ o.edge x y) ∧ + (∀ x ∈ E, ∀ y ∈ D \ E, FourNeighborAdjacent x y → t.edge x y) ∧ + (∀ x ∈ D \ E, ∀ y ∈ D \ E, + t.edge x y ↔ FourNeighborAdjacent x y ∧ d x < d y) ∧ + (∀ x ∈ E, t.rank x = o.rank x) ∧ + ∀ x ∈ D \ E, t.rank x = E.sup o.rank + 1 + d x := by +-- BODY + classical + let W := D \ E + let M := E.sup o.rank + let edge : GaussianInt → GaussianInt → Prop := fun x y => + o.edge x y ∨ (x ∈ E ∧ y ∈ W ∧ FourNeighborAdjacent x y) ∨ + (x ∈ W ∧ y ∈ W ∧ FourNeighborAdjacent x y ∧ d x < d y) + let rank : GaussianInt → Nat := fun x => if x ∈ E then o.rank x else M+1+d x + have symm (x y : GaussianInt) (h : FourNeighborAdjacent x y) : + FourNeighborAdjacent y x := by + rcases h with h | h | h | h <;> subst y <;> simp [FourNeighborAdjacent] + have notW (x : GaussianInt) (hx : x ∈ E) : x ∉ W := by + intro h + exact (Finset.mem_sdiff.mp h).2 hx + have support : ∀ x y, edge x y → x ∈ D ∧ y ∈ D ∧ FourNeighborAdjacent x y := by + intro x y he + rcases he with he | ⟨hx, hy, ha⟩ | ⟨hx, hy, ha, hd⟩ + · have hs := o.supported x y he + exact ⟨hE hs.1, hE hs.2.1, hs.2.2⟩ + · exact ⟨hE hx, (Finset.mem_sdiff.mp hy).1, ha⟩ + · exact ⟨(Finset.mem_sdiff.mp hx).1, (Finset.mem_sdiff.mp hy).1, ha⟩ + have oriented : ∀ x ∈ D, ∀ y ∈ D, FourNeighborAdjacent x y → + (edge x y ∧ ¬ edge y x) ∨ (edge y x ∧ ¬ edge x y) := by + intro x hx y hy ha + by_cases hxE : x ∈ E <;> by_cases hyE : y ∈ E + · simpa [edge, notW x hxE, notW y hyE] using o.oriented x hxE y hyE ha + · have hyW : y ∈ W := Finset.mem_sdiff.mpr ⟨hy, hyE⟩ + have ho : ¬ o.edge x y := fun h => hyE (o.supported x y h).2.1 + have hr : ¬ o.edge y x := fun h => hyE (o.supported y x h).1 + simp [edge, hxE, hyE, notW x hxE, hyW, ha, ho, hr] + · have hxW : x ∈ W := Finset.mem_sdiff.mpr ⟨hx, hxE⟩ + have ho : ¬ o.edge x y := fun h => hxE (o.supported x y h).1 + have hr : ¬ o.edge y x := fun h => hxE (o.supported y x h).2.1 + simp [edge, hxE, hyE, hxW, notW y hyE, symm x y ha, ho, hr] + · have hxW : x ∈ W := Finset.mem_sdiff.mpr ⟨hx, hxE⟩ + have hyW : y ∈ W := Finset.mem_sdiff.mpr ⟨hy, hyE⟩ + have ho : ¬ o.edge x y := fun h => hxE (o.supported x y h).1 + have hr : ¬ o.edge y x := fun h => hyE (o.supported y x h).1 + rcases lt_or_gt_of_ne (hstrict x hxW y hyW ha) with hd | hd + · simp [edge, hxE, hyE, hxW, hyW, ho, hr, ha, hd, Nat.not_lt_of_ge hd.le] + · simp [edge, hxE, hyE, hxW, hyW, ho, hr, symm x y ha, hd, + Nat.not_lt_of_ge hd.le] + have increasing : ∀ x y, edge x y → rank x < rank y := by + intro x y he + rcases he with he | ⟨hx, hy, ha⟩ | ⟨hx, hy, ha, hd⟩ + · have hs := o.supported x y he + simpa only [rank, ite_eq_left hs.1, ite_eq_left hs.2.1] using o.increasing x y he + · have hyE := (Finset.mem_sdiff.mp hy).2 + have hb : o.rank x ≤ M := Finset.le_sup hx + simp only [rank, ite_eq_left hx, ite_eq_right hyE] + omega + · have hxE := (Finset.mem_sdiff.mp hx).2 + have hyE := (Finset.mem_sdiff.mp hy).2 + simp only [rank, ite_eq_right hxE, ite_eq_right hyE] + omega + let t : AcyclicIndegreeOrientation D σ := { + edge := edge + edge_decidable := fun _ _ => Classical.propDecidable _ + rank := rank + supported := support + oriented := oriented + increasing := increasing + indegree := by + intro x hx + simp only [decide_eq_true_eq] + by_cases hxE : x ∈ E + · have hf : D.filter (fun y => edge y x) = E.filter (fun y => o.edge y x) := by + ext y + constructor + · intro hy + have he := (Finset.mem_filter.mp hy).2 + rcases he with he | ⟨hyE, hxW, ha⟩ | ⟨hyW, hxW, ha, hd⟩ + · exact Finset.mem_filter.mpr ⟨(o.supported y x he).1, he⟩ + · exact (notW x hxE hxW).elim + · exact (notW x hxE hxW).elim + · intro hy + have hp := Finset.mem_filter.mp hy + exact Finset.mem_filter.mpr ⟨hE hp.1, Or.inl hp.2⟩ + rw [hf] + simpa only [decide_eq_true_eq] using o.indegree x hxE + · have hxW : x ∈ W := Finset.mem_sdiff.mpr ⟨hx, hxE⟩ + let N := E.filter (fun y => FourNeighborAdjacent y x) + let L := W.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x) + have hd : Disjoint N L := by + apply Finset.disjoint_left.mpr + intro y hy hz + exact (Finset.mem_sdiff.mp (Finset.mem_filter.mp hz).1).2 + (Finset.mem_filter.mp hy).1 + have hf : D.filter (fun y => edge y x) = N ∪ L := by + ext y + constructor + · intro hy + have he := (Finset.mem_filter.mp hy).2 + rcases he with he | ⟨hyE, hxW, ha⟩ | ⟨hyW, hxW, ha, hdy⟩ + · exact (hxE (o.supported y x he).2.1).elim + · exact Finset.mem_union_left _ (Finset.mem_filter.mpr ⟨hyE, ha⟩) + · exact Finset.mem_union_right _ (Finset.mem_filter.mpr ⟨hyW, ha, hdy⟩) + · intro hy + rcases Finset.mem_union.mp hy with hy | hy + · have hp := Finset.mem_filter.mp hy + exact Finset.mem_filter.mpr + ⟨hE hp.1, Or.inr (Or.inl ⟨hp.1, hxW, hp.2⟩)⟩ + · have hp := Finset.mem_filter.mp hy + exact Finset.mem_filter.mpr + ⟨(Finset.mem_sdiff.mp hp.1).1, Or.inr (Or.inr ⟨hp.1, hxW, hp.2⟩)⟩ + rw [hf, Finset.card_union_of_disjoint hd, Nat.cast_add] + have hN : N = @Finset.filter GaussianInt (fun y => FourNeighborAdjacent y x) + (fun _ => Classical.propDecidable _) E := by + ext y + simp only [N, Finset.mem_filter] + have hL : L = @Finset.filter GaussianInt + (fun y => FourNeighborAdjacent y x ∧ d y < d x) + (fun _ => Classical.propDecidable _) (D \ E) := by + ext y + simp only [L, W, Finset.mem_filter] + rw [hN, hL] + exact hres x hxW } + refine ⟨t, ?_, ?_, ?_, ?_, ?_⟩ + · intro x hx y hy + simp [t, edge, notW x hx, notW y hy] + · intro x hx y hy ha + exact Or.inr (Or.inl ⟨hx, hy, ha⟩) + · intro x hx y hy + have hxE := (Finset.mem_sdiff.mp hx).2 + have hyE := (Finset.mem_sdiff.mp hy).2 + have ho : ¬ o.edge x y := fun h => hxE (o.supported x y h).1 + have hxW : x ∈ W := hx + have hyW : y ∈ W := hy + simp [t, edge, hxE, ho, hxW, hyW] + · intro x hx + simp [t, rank, hx] + · intro x hx + simp [t, rank, M, (Finset.mem_sdiff.mp hx).2] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1RecursiveInteriors.lean b/LeanPool/ApollonianSuperharmonic/P4062T1RecursiveInteriors.lean new file mode 100644 index 0000000000..5463b080a0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4062T1RecursiveInteriors.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorSquare +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter + +-- [TABLET NODE: P4062T1RecursiveInteriors] + +/-! +# P4062T1RecursiveInteriors + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a Ford parameter write $r=q_1$, $s=q_2$. Its four strict recursive +interiors, indexed $0,1,2,3$, are respectively +$A_0=D_r$, $A_1=(s,s)+D_r$, $A_2=(r,0)+D_s$, and $A_3=(0,r)+D_s$. +Here $D_d$ is the interior lattice square of denominator $d$. +-/ +def P4062T1RecursiveInteriors (P : FordFareyParameter) : + Fin 4 → Finset GaussianInt := +-- BODY + ![P4062T1InteriorSquare P.q₁, + (P4062T1InteriorSquare P.q₁).image + (fun x => x + ⟨(P.q₂ : Int), (P.q₂ : Int)⟩), + (P4062T1InteriorSquare P.q₂).image + (fun x => x + ⟨(P.q₁ : Int), 0⟩), + (P4062T1InteriorSquare P.q₂).image + (fun x => x + ⟨0, (P.q₁ : Int)⟩)] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1RemainderGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4062T1RemainderGeometry.lean new file mode 100644 index 0000000000..9346dd992c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4062T1RemainderGeometry.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderPaths +public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorGeometry +public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable +public import LeanPool.ApollonianSuperharmonic.P4112T1PathGeometry +public import LeanPool.ApollonianSuperharmonic.P4112T1BoundaryMultiplicity +public import LeanPool.ApollonianSuperharmonic.P4112T1ParentalNeighbors +public import LeanPool.ApollonianSuperharmonic.P4112T1LowerNeighbors +public import Mathlib.Data.Nat.Dist + +/-! +# P4062T1RemainderGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +-- [TABLET NODE: P4062T1RemainderGeometry] +theorem P4062T1RemainderGeometry (P : FordFareyParameter) (hP : 2 < P.q) : + (by + classical + exact + let A := P4062T1RecursiveInteriors P + let E := (A 0 ∪ A 1) ∪ (A 2 ∪ A 3) + let W := P4062T1InteriorSquare P.q \ E + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + E ⊆ P4062T1InteriorSquare P.q ∧ + W = (B 0).1 ∪ (B 1).1 ∧ Disjoint (B 0).1 (B 1).1 ∧ + (∀ x ∈ (B 0).1, ∀ y ∈ (B 1).1, ¬ FourNeighborAdjacent x y) ∧ + (∀ j, ∀ x ∈ (B j).1, ∀ y ∈ (B j).1, + FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1) ∧ + (∀ j, ∀ x ∈ (B j).1, + (E.filter (fun y => FourNeighborAdjacent y x)).card = 2 ∧ + FordBoundaryMultiplicity P x = (if x = (B j).2 then 3 else 2) ∧ + ((B j).1.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = + (if x = (B j).2 then 0 else 1)) ∧ + (∀ x ∈ W, + ((E.filter (fun y => FourNeighborAdjacent y x)).card : Int) + + ((W.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card : Int) = + 2 + FourNeighborLaplacian (FordOdometer P) x) ∧ + (∀ x ∈ W, ∀ y ∈ W, FourNeighborAdjacent x y → d x ≠ d y) + ) := by +-- BODY + classical + intro A E W B d + obtain ⟨hW, hdisjoint, hcross, hedge⟩ := P4112T1PathGeometry P hP + have hparent := P4112T1ParentalNeighbors P hP + have hboundary := P4112T1BoundaryMultiplicity P hP + change W = (B 0).1 ∪ (B 1).1 at hW + change (∀ j, ∀ x ∈ (B j).1, ∀ y ∈ (B j).1, + FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1) at hedge + change (∀ j, ∀ x ∈ (B j).1, + (E.filter (fun y => FourNeighborAdjacent y x)).card = 2) at hparent + change (∀ j, ∀ x ∈ (B j).1, + FordBoundaryMultiplicity P x = (if x = (B j).2 then 3 else 2)) at hboundary + have hlower : (∀ j, ∀ x ∈ (B j).1, + ((B j).1.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = + (if x = (B j).2 then 0 else 1)) := by + intro j x hx + convert (P4112T1LowerNeighbors P hP) j x hx using 1; + congr 2; ext y; + by_cases hy : y ∈ (B 0).1 <;> + by_cases hxx : x ∈ (B 0).1 <;> + simp [d, B, hy, hxx] + have hA := (P4062T1InteriorGeometry P hP).1 + have hE : E ⊆ P4062T1InteriorSquare P.q := by + intro x hx + rcases Finset.mem_union.mp hx with hx | hx + · rcases Finset.mem_union.mp hx with hx | hx + · exact hA 0 hx + · exact hA 1 hx + · rcases Finset.mem_union.mp hx with hx | hx + · exact hA 2 hx + · exact hA 3 hx + have adjacent_symm {x y : GaussianInt} (h : FourNeighborAdjacent x y) : + FourNeighborAdjacent y x := by + rcases h with h | h | h | h <;> subst y <;> simp [FourNeighborAdjacent] + have path_subset (j : Fin 2) : (B j).1 ⊆ W := by + intro x hx + rw [hW] + fin_cases j + · exact Finset.mem_union.mpr (Or.inl hx) + · exact Finset.mem_union.mpr (Or.inr hx) + have select_path (x : GaussianInt) (hx : x ∈ W) : + ∃ j : Fin 2, x ∈ (B j).1 := by + rw [hW] at hx + rcases Finset.mem_union.mp hx with hx | hx + · exact ⟨0, hx⟩ + · exact ⟨1, hx⟩ + have same_path (j : Fin 2) (x : GaussianInt) (hx : x ∈ (B j).1) + (y : GaussianInt) (hy : y ∈ W) (hyx : FourNeighborAdjacent y x) : + y ∈ (B j).1 := by + rw [hW] at hy + fin_cases j + · rcases Finset.mem_union.mp hy with hy | hy + · exact hy + · exact False.elim (hcross x hx y hy (adjacent_symm hyx)) + · rcases Finset.mem_union.mp hy with hy | hy + · exact False.elim (hcross y hy x hx hyx) + · exact hy + have lower_filter (j : Fin 2) (x : GaussianInt) (hx : x ∈ (B j).1) : + W.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x) = + (B j).1.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x) := by + ext y + simp only [Finset.mem_filter] + constructor + · rintro ⟨hy, hadj, hd⟩ + exact ⟨same_path j x hx y hy hadj, hadj, hd⟩ + · rintro ⟨hy, hadj, hd⟩ + exact ⟨path_subset j hy, hadj, hd⟩ + have square_bounds (x : GaussianInt) (hx : x ∈ P4062T1InteriorSquare P.q) : + 1 ≤ x.re ∧ x.re ≤ (P.q : Int) - 1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q : Int) - 1 := by + unfold P4062T1InteriorSquare at hx + obtain ⟨⟨u, v⟩, huv, rfl⟩ := Finset.mem_image.mp hx + obtain ⟨hu, hv⟩ := Finset.mem_product.mp huv + exact ⟨(Finset.mem_Icc.mp hu).1, (Finset.mem_Icc.mp hu).2, + (Finset.mem_Icc.mp hv).1, (Finset.mem_Icc.mp hv).2⟩ + refine ⟨hE, hW, hdisjoint, hcross, hedge, ?_, ?_, ?_⟩ + · intro j x hx + exact ⟨hparent j x hx, hboundary j x hx, hlower j x hx⟩ + · intro x hx + obtain ⟨j, hxj⟩ := select_path x hx + have hb := square_bounds x (Finset.mem_sdiff.mp hx).1 + have ht := (FordLaplacianTable P).2.2 (by omega) x + hb.1 hb.2.1 hb.2.2.1 hb.2.2.2 + have hm := hboundary j x hxj + have hl := hlower j x hxj + rw [hparent j x hxj, lower_filter j x hxj, hl] + by_cases hr : x = (B j).2 + · have hm3 : FordBoundaryMultiplicity P x = 3 := by + simpa only [ite_eq_left hr] using hm + rw [ite_eq_left hr, ht.2.1 hm3] + norm_num + · have hm2 : FordBoundaryMultiplicity P x = 2 := by + simpa only [ite_eq_right hr] using hm + rw [ite_eq_right hr, ht.1 hm2] + norm_num + · intro x hx y hy hxy + obtain ⟨j, hxj⟩ := select_path x hx + have hyj := same_path j x hxj y hy (adjacent_symm hxy) + have hd := ((hedge j x hxj y hyj).mp hxy).2 + intro heq + rw [heq, Nat.dist_self] at hd + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1RemainderPaths.lean b/LeanPool/ApollonianSuperharmonic/P4062T1RemainderPaths.lean new file mode 100644 index 0000000000..f54d2bba71 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4062T1RemainderPaths.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4062T1RecursiveInteriors + +-- [TABLET NODE: P4062T1RemainderPaths] + +/-! +# P4062T1RemainderPaths + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a Ford parameter write $r=q_1,s=q_2,q=r+s$. The following two +rooted lattice sets $(W_0,a_0),(W_1,a_1)$ are subsets of $D_q$. +If $r>s$, set +$$ +\begin{array}{ll} +W_0=\{(r,y):1\leq y\leq s\}\cup\{(x,s):r\leq x + (x.re = (P.q₁ : Int) ∧ x.im ≤ (P.q₂ : Int)) ∨ + (x.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ x.re)), + ⟨(P.q₁ : Int), (P.q₂ : Int)⟩), + ((P4062T1InteriorSquare P.q).filter (fun x => + (x.im = (P.q₁ : Int) ∧ x.re ≤ (P.q₂ : Int)) ∨ + (x.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ x.im)), + ⟨(P.q₂ : Int), (P.q₁ : Int)⟩)] + else + ![((P4062T1InteriorSquare P.q).filter (fun x => + (x.re = (P.q₁ : Int) ∧ x.im ≤ (P.q₁ : Int)) ∨ + (x.im = (P.q₁ : Int) ∧ x.re ≤ (P.q₁ : Int))), + ⟨(P.q₁ : Int), (P.q₁ : Int)⟩), + ((P4062T1InteriorSquare P.q).filter (fun x => + (x.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ x.im) ∨ + (x.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ x.re)), + ⟨(P.q₂ : Int), (P.q₂ : Int)⟩)] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1ZeroIncoming.lean b/LeanPool/ApollonianSuperharmonic/P4062T1ZeroIncoming.lean new file mode 100644 index 0000000000..fb1f0c0c81 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4062T1ZeroIncoming.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation +public import Mathlib.Algebra.BigOperators.Group.Finset.Basic + +-- [TABLET NODE: P4062T1ZeroIncoming] + +/-! +# P4062T1ZeroIncoming + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4062T1ZeroIncoming (D I : Finset GaussianInt) + (σ : GaussianInt → Int) (hI : I ⊆ D) + (o : AcyclicIndegreeOrientation D σ) + (t : AcyclicIndegreeOrientation I σ) : + ∀ x ∈ I, ∀ y ∈ D, o.edge y x → y ∈ I := by +-- BODY + classical + have symm (x y : GaussianInt) (h : FourNeighborAdjacent x y) : + FourNeighborAdjacent y x := by + rcases h with h | h | h | h <;> subst y <;> + simp [FourNeighborAdjacent] + have directed_count (S : Finset GaussianInt) (hS : I ⊆ S) + (a : AcyclicIndegreeOrientation S σ) : + 2 * ((I.product I).filter (fun e => a.edge e.1 e.2)).card = + ((I.product I).filter (fun e => FourNeighborAdjacent e.1 e.2)).card := by + let C := (I.product I).filter (fun e => a.edge e.1 e.2) + let R := (I.product I).filter (fun e => a.edge e.2 e.1) + have hcard : C.card = R.card := by + apply Finset.card_bij (fun e _ => e.swap) + · intro e he + simp only [C, R, Finset.product_eq_sprod, Finset.mem_filter, + Finset.mem_product, Prod.fst_swap, Prod.snd_swap] at he ⊢ + exact ⟨⟨he.1.2, he.1.1⟩, he.2⟩ + · intro e he f hf h + exact Prod.swap_injective h + · intro e he + refine ⟨e.swap, ?_, by simp⟩ + simp only [C, R, Finset.product_eq_sprod, Finset.mem_filter, + Finset.mem_product, Prod.fst_swap, Prod.snd_swap] at he ⊢ + exact ⟨⟨he.1.2, he.1.1⟩, he.2⟩ + have hdis : Disjoint C R := by + apply Finset.disjoint_left.mpr + intro e he hr + have h := (Finset.mem_filter.mp he).2 + have k := (Finset.mem_filter.mp hr).2 + exact Nat.lt_asymm (a.increasing _ _ h) (a.increasing _ _ k) + have hun : C ∪ R = + (I.product I).filter (fun e => FourNeighborAdjacent e.1 e.2) := by + ext e + simp only [C, R, Finset.mem_union, Finset.mem_filter] + constructor + · rintro (⟨he, h⟩ | ⟨he, h⟩) + · exact ⟨he, (a.supported _ _ h).2.2⟩ + · exact ⟨he, symm _ _ (a.supported _ _ h).2.2⟩ + · rintro ⟨he, hadj⟩ + have hp := Finset.mem_product.mp he + rcases a.oriented _ (hS hp.1) _ (hS hp.2) hadj with h | h + · exact Or.inl ⟨he, h.1⟩ + · exact Or.inr ⟨he, h.1⟩ + have hc := Finset.card_union_of_disjoint hdis + rw [hun, ← hcard] at hc + dsimp only [C] at hc + omega + have totals (S T : Finset GaussianInt) (r : GaussianInt → GaussianInt → Prop) : + ((S.product T).filter (fun e => r e.1 e.2)).card = + ∑ x ∈ T, (S.filter (fun y => r y x)).card := by + simp_rw [Finset.card_eq_sum_ones, Finset.sum_filter] + rw [Finset.product_eq_sprod, Finset.sum_product, Finset.sum_comm] + let B := (D.product I).filter (fun e => o.edge e.1 e.2) + let C := (I.product I).filter (fun e => o.edge e.1 e.2) + let F := (I.product I).filter (fun e => t.edge e.1 e.2) + have hBC : C ⊆ B := by + intro e he + have h := Finset.mem_filter.mp he + have hp := Finset.mem_product.mp h.1 + exact Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨hI hp.1, hp.2⟩, h.2⟩ + have hBF : B.card = F.card := by + rw [show B.card = _ from totals D I o.edge, + show F.card = _ from totals I I t.edge] + apply Finset.sum_congr rfl + intro x hx + have ho := o.indegree x (hI hx) + have ht := t.indegree x hx + have he : ((D.filter (fun y => o.edge y x)).card : Int) = + ((I.filter (fun y => t.edge y x)).card : Int) := by + simpa only [decide_eq_true_eq] using ho.trans ht.symm + exact_mod_cast he + have hCF : C.card = F.card := by + have hc := directed_count D hI o + have hf := directed_count I (fun _ h => h) t + dsimp only [C, F] + omega + have hEq : C = B := Finset.eq_of_subset_of_card_le hBC (by omega) + intro x hx y hy he + have hm : (y,x) ∈ B := Finset.mem_filter.mpr + ⟨Finset.mem_product.mpr ⟨hy, hx⟩, he⟩ + rw [← hEq] at hm + exact (Finset.mem_product.mp (Finset.mem_filter.mp hm).1).1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4085T1FordIncomingNormalization.lean b/LeanPool/ApollonianSuperharmonic/P4085T1FordIncomingNormalization.lean new file mode 100644 index 0000000000..854cd9209f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4085T1FordIncomingNormalization.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.P4085T1RestrictedAdaptedActions + +-- [TABLET NODE: P4085T1FordIncomingNormalization] + +/-! +# P4085T1FordIncomingNormalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4085T1FordIncomingNormalization + (r : Fin 4 → CircleCoordinates) (hproper : ProperBandQuadruple r) + (hline : ∃ j : Fin 4, (r j).1 = 0) + (i : Fin 3) (s : Fin 4) (U W : ProtoTile) + (hU : BandPrototile (r 0) U) (hW : BandPrototile (r i.succ) W) + (hUpos : 0 < (r 0).1) (hWpos : 0 < (r i.succ).1) + (hcent : TileCentroid W - TileCentroid U = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ)))) : + ∃ (a : Fin 3) (g : BandPackingSymmetry) (P : FordFareyParameter), + 1 < P.q ∧ + let k : Fin 3 := i - a + let q := FordRecursiveQuadruple P + BandPackingSymmetryQuadrupleAction g + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] = q ∧ + q k.succ = BandPackingSymmetryCircleAction g (r i.succ) ∧ + BandPrototile (q 0) (BandPackingSymmetryTileAction g U) ∧ + BandPrototile (q k.succ) (BandPackingSymmetryTileAction g W) ∧ + 0 < (q 0).1 ∧ 0 < (q k.succ).1 ∧ + TileCentroid (BandPackingSymmetryTileAction g W) - + TileCentroid (BandPackingSymmetryTileAction g U) = + (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q k.succ) (q 0) + BandVectors.1 (q 0) (q k.succ))) ∧ + BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ))) = + (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q k.succ) (q 0) + else BandVectors.1 (q 0) (q k.succ)) := by +-- BODY + obtain ⟨a, g₀, P, hP, hg₀, hw, _, heq⟩ := FordRegimeConverse r hproper hline + let p : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + have hp : ProperBandQuadruple p := by + fin_cases a + · convert hproper using 1; funext x; fin_cases x <;> rfl + · refine ⟨SemiProperQuadruple.rotate hproper.1, ?_⟩ + intro j + fin_cases j + · simpa [p] using hproper.2 (1 : Fin 3) + · simpa [p] using hproper.2 (2 : Fin 3) + · simpa [p] using hproper.2 (0 : Fin 3) + · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hproper.1), ?_⟩ + intro j + fin_cases j + · simpa [p] using hproper.2 (2 : Fin 3) + · simpa [p] using hproper.2 (0 : Fin 3) + · simpa [p] using hproper.2 (1 : Fin 3) + have projective := BandPackingSymmetryProjectiveVectorCovariance g₀ p hp + dsimp only at projective + rcases projective with ⟨_, _, _, _, _, _, _, _, g, hlift, _, hpar, hquad, hphase, _, _⟩ + have hg : BandPackingSymmetryReversesOrientation g = false := hpar.trans hg₀ + obtain ⟨m, _, hvector, hcentroid⟩ := + P4085T1RestrictedAdaptedActions g₀ g hw hlift + have hadd (x y : GaussianInt) : + BandPackingSymmetryVectorAction g (x + y) = + BandPackingSymmetryVectorAction g x + BandPackingSymmetryVectorAction g y := by + simp only [hvector, mul_add] + have hcomm (x : GaussianInt) : + BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val * x) = + (⟨0, 1⟩ : GaussianInt) ^ s.val * BandPackingSymmetryVectorAction g x := by + simp only [hvector] + ring + let k : Fin 3 := i - a + let q := FordRecursiveQuadruple P + have hnormal : BandPackingSymmetryQuadrupleAction g p = q := (hquad p).trans heq + have hroot : q 0 = BandPackingSymmetryCircleAction g (r 0) := by + rw [← hnormal] + rfl + have hparent : q k.succ = BandPackingSymmetryCircleAction g (r i.succ) := by + rw [← hnormal] + fin_cases a <;> fin_cases i <;> + simp [k, p, BandPackingSymmetryQuadrupleAction, hg] + have hpk : p k.succ = r i.succ := by + fin_cases a <;> fin_cases i <;> rfl + have hforward : BandVectors.1 (q k.succ) (q 0) = + BandPackingSymmetryVectorAction g (BandVectors.1 (r i.succ) (r 0)) := by + have h := (hphase k).1 + simpa only [BandPackingSymmetryScopedPhase, hg, Bool.false_eq_true, + ite_false, one_mul, hnormal, hpk, p, Matrix.cons_val_zero] using h + have hbackward : BandVectors.1 (q 0) (q k.succ) = + BandPackingSymmetryVectorAction g (BandVectors.1 (r 0) (r i.succ)) := by + have h := (hphase k).2.1 + simpa only [BandPackingSymmetryScopedPhase, hg, Bool.false_eq_true, + ite_false, one_mul, hnormal, hpk, p, Matrix.cons_val_zero] using h + have hc := hcentroid U W _ hcent + rw [hcomm, hadd, ← hforward, ← hbackward] at hc + have hdisp : BandPackingSymmetryVectorAction g + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r i.succ) (r 0) + else BandVectors.1 (r 0) (r i.succ))) = + (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q k.succ) (q 0) + else BandVectors.1 (q 0) (q k.succ)) := by + rw [hcomm] + split_ifs <;> simp only [← hforward, ← hbackward] + have cov := BandPackingSymmetryCovariance g + refine ⟨a, g, P, hP, hnormal, hparent, ?_, ?_, ?_, ?_, hc, hdisp⟩ + · change BandPrototile (q 0) _ + rw [hroot] + exact (cov.2.1 _ _).mp hU + · change BandPrototile (q k.succ) _ + rw [hparent] + exact (cov.2.1 _ _).mp hW + · change 0 < (q 0).1 + rw [hroot, cov.1] + exact hUpos + · change 0 < (q k.succ).1 + rw [hparent, cov.1] + exact hWpos + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4085T1MinusTouching.lean b/LeanPool/ApollonianSuperharmonic/P4085T1MinusTouching.lean new file mode 100644 index 0000000000..c5afe8eb23 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4085T1MinusTouching.lean @@ -0,0 +1,211 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations + +-- [TABLET NODE: P4085T1MinusTouching] + +/-! +# P4085T1MinusTouching + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4085T1MinusTouching (U W : ProtoTile) (y : GaussianInt) + (hU : QuarterTurnSymmetric U) (hW : QuarterTurnSymmetric W) + (hcent : TileCentroid W - TileCentroid U = + (1 / 2 : Real) • GaussianRealPoint (y - GaussianQuarterTurn y)) + (hplus : TouchingTriple U (TileTranslation U y) + (TileTranslation W (GaussianQuarterTurn y))) : + TouchingTriple U (TileTranslation U y) W := by +-- BODY + have shift_add (T : ProtoTile) (a b : GaussianInt) : + TileTranslation (TileTranslation T a) b = TileTranslation T (a + b) := by + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · simp only [TileTranslation, Finset.image_image, Function.comp_def] + congr 1 + funext z + simp only [GaussianTranslation, add_assoc] + · change (anchor + a) + b = anchor + (a + b) + exact add_assoc _ _ _ + have turn_shift (T : ProtoTile) (a : GaussianInt) : + TileQuarterTurn (TileTranslation T a) = + TileTranslation (TileQuarterTurn T) (GaussianQuarterTurn a) := by + cases T with + | mk cells anchor => + have hm : (fun z : GaussianInt => GaussianQuarterTurn (z + a) - 1) = + (fun z : GaussianInt => GaussianQuarterTurn z - 1 + GaussianQuarterTurn a) := by + funext z + ext <;> simp [GaussianQuarterTurn]; ring + apply congrArg₂ ProtoTile.mk + · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, + Finset.image_image, Function.comp_def, hm] + · ext <;> simp [TileQuarterTurn, TileTranslation, + GaussianTranslation, GaussianQuarterTurn, add_comm] + have half_shift (T : ProtoTile) (a : GaussianInt) : + TileQuarterTurn (TileQuarterTurn (TileTranslation T a)) = + TileTranslation (TileQuarterTurn (TileQuarterTurn T)) (-a) := by + rw [turn_shift, turn_shift] + congr 1 + -- Compose two centered turns, retaining cells and empty-case anchors only. + have half (T : ProtoTile) (hT : QuarterTurnSymmetric T) : + ∃ b : GaussianInt, + GaussianRealPoint b = (2 * (TileCentroid T).1, 2 * (TileCentroid T).2) ∧ + (TileTranslation (TileQuarterTurn (TileQuarterTurn T)) b).cells = T.cells ∧ + (T.cells = ∅ → + (TileTranslation (TileQuarterTurn (TileQuarterTurn T)) b).anchor = T.anchor) := by + obtain ⟨u, hu, hc, ha, _, _⟩ := QuarterTurnSymmetricCenteredTransport T hT + let b := GaussianQuarterTurn u + u + have heq : TileTranslation (TileQuarterTurn + (TileTranslation (TileQuarterTurn T) u)) u = + TileTranslation (TileQuarterTurn (TileQuarterTurn T)) b := by + rw [turn_shift, shift_add] + refine ⟨b, ?_, ?_, ?_⟩ + · have h₁ := congrArg Prod.fst hu + have h₂ := congrArg Prod.snd hu + simp [GaussianRealPoint, GaussianQuarterTurn, b] at h₁ h₂ ⊢ + constructor <;> linarith + · rw [← heq] + change ((TileTranslation (TileQuarterTurn T) u).cells.image + (fun z => GaussianQuarterTurn z - 1)).image (GaussianTranslation u) = T.cells + rw [hc] + exact hc + · intro ht + rw [← heq] + change GaussianTranslation u (GaussianQuarterTurn + (TileTranslation (TileQuarterTurn T) u).anchor) = T.anchor + rw [ha ht] + exact ha ht + have translated_same (A B : ProtoTile) (a : GaussianInt) + (hc : A.cells = B.cells) (ha : A.cells = ∅ → A.anchor = B.anchor) : + (TileTranslation A a).cells = (TileTranslation B a).cells ∧ + ((TileTranslation A a).cells = ∅ → + (TileTranslation A a).anchor = (TileTranslation B a).anchor) := by + constructor + · exact congrArg (Finset.image (GaussianTranslation a)) hc + · intro he + exact congrArg (GaussianTranslation a) + (ha ((TileTranslationFormulas A a).2.2.1.mp he)) + have pair_same (A B A' B' : ProtoTile) + (hA : A.cells = A'.cells) (hB : B.cells = B'.cells) + (ha : A.cells = ∅ → A.anchor = A'.anchor) + (hb : B.cells = ∅ → B.anchor = B'.anchor) : + TileTouching A B ↔ TileTouching A' B' := by + have oa := ProtoTileObservableExtensionality A A' hA ha + have ob := ProtoTileObservableExtensionality B B' hB hb + have va := oa.2.1 + have vb := ob.2.1 + have ea := oa.2.2.1 + have eb := ob.2.2.1 + constructor + · rintro (h | ⟨he, hm⟩ | ⟨he, hm⟩) + · left + simpa only [← hA, ← hB, ← va, ← vb, ← ea, ← eb] using h + · right; left + exact ⟨hA ▸ he, by simpa only [← va, ← vb, ← ha he] using hm⟩ + · right; right + exact ⟨hB ▸ he, by simpa only [← va, ← vb, ← hb he] using hm⟩ + · rintro (h | ⟨he, hm⟩ | ⟨he, hm⟩) + · left + simpa only [hA, hB, va, vb, ea, eb] using h + · right; left + have he' : A.cells = ∅ := hA.trans he + exact ⟨he', by simpa only [va, vb, ha he'] using hm⟩ + · right; right + have he' : B.cells = ∅ := hB.trans he + exact ⟨he', by simpa only [va, vb, hb he'] using hm⟩ + have triple_same (A B C A' B' C' : ProtoTile) + (hA : A.cells = A'.cells) (hB : B.cells = B'.cells) + (hC : C.cells = C'.cells) + (ha : A.cells = ∅ → A.anchor = A'.anchor) + (hb : B.cells = ∅ → B.anchor = B'.anchor) + (hc : C.cells = ∅ → C.anchor = C'.anchor) : + TouchingTriple A B C ↔ TouchingTriple A' B' C' := by + unfold TouchingTriple + rw [pair_same A B A' B' hA hB ha hb, + pair_same B C B' C' hB hC hb hc, pair_same C A C' A' hC hA hc ha, + (ProtoTileObservableExtensionality A A' hA ha).2.1, + (ProtoTileObservableExtensionality B B' hB hb).2.1, + (ProtoTileObservableExtensionality C C' hC hc).2.1] + obtain ⟨bU, hbU, hcU, haU⟩ := half U hU + obtain ⟨bW, hbW, hcW, haW⟩ := half W hW + have hdiff : bW = bU + y - GaussianQuarterTurn y := by + have u₁ := congrArg Prod.fst hbU + have u₂ := congrArg Prod.snd hbU + have w₁ := congrArg Prod.fst hbW + have w₂ := congrArg Prod.snd hbW + have d₁ := congrArg Prod.fst hcent + have d₂ := congrArg Prod.snd hcent + change (bU.re : Real) = 2 * (TileCentroid U).1 at u₁ + change (bU.im : Real) = 2 * (TileCentroid U).2 at u₂ + change (bW.re : Real) = 2 * (TileCentroid W).1 at w₁ + change (bW.im : Real) = 2 * (TileCentroid W).2 at w₂ + change (TileCentroid W).1 - (TileCentroid U).1 = + (1 / 2 : Real) * ((y - GaussianQuarterTurn y).re : Real) at d₁ + change (TileCentroid W).2 - (TileCentroid U).2 = + (1 / 2 : Real) * ((y - GaussianQuarterTurn y).im : Real) at d₂ + simp only [GaussianQuarterTurn, Zsqrtd.re_sub, Zsqrtd.im_sub, + Int.cast_sub, sub_neg_eq_add, Int.cast_add] at d₁ d₂ + have re : (bW.re : Real) = (bU.re : Real) + (y.re : Real) + (y.im : Real) := by linarith + have im : (bW.im : Real) = (bU.im : Real) + (y.im : Real) - (y.re : Real) := by linarith + apply Zsqrtd.ext + · change bW.re = bU.re + y.re - -y.im + rw [sub_neg_eq_add] + exact_mod_cast re + · change bW.im = bU.im + y.im - y.re + exact_mod_cast im + let H := fun T => TileTranslation (TileQuarterTurn (TileQuarterTurn T)) (bU + y) + have eU : H U = TileTranslation + (TileTranslation (TileQuarterTurn (TileQuarterTurn U)) bU) y := by + rw [shift_add] + have eM : H (TileTranslation U y) = + TileTranslation (TileQuarterTurn (TileQuarterTurn U)) bU := by + dsimp [H] + rw [half_shift, shift_add] + congr 1 + abel + have eW : H (TileTranslation W (GaussianQuarterTurn y)) = + TileTranslation (TileQuarterTurn (TileQuarterTurn W)) bW := by + dsimp [H] + rw [half_shift, shift_add, hdiff] + congr 1 + abel + have certU := translated_same _ U y hcU (fun he => haU (hcU.symm.trans he)) + have certM : (H (TileTranslation U y)).cells = U.cells ∧ + ((H (TileTranslation U y)).cells = ∅ → + (H (TileTranslation U y)).anchor = U.anchor) := by + rw [eM] + exact ⟨hcU, fun he => haU (hcU.symm.trans he)⟩ + have certW : (H (TileTranslation W (GaussianQuarterTurn y))).cells = W.cells ∧ + ((H (TileTranslation W (GaussianQuarterTurn y))).cells = ∅ → + (H (TileTranslation W (GaussianQuarterTurn y))).anchor = W.anchor) := by + rw [eW] + exact ⟨hcW, fun he => haW (hcW.symm.trans he)⟩ + rw [← eU] at certU + have h₁ := (TouchingTripleCovariance U (TileTranslation U y) + (TileTranslation W (GaussianQuarterTurn y)) 0).2.1.mp hplus + have h₂ := (TouchingTripleCovariance _ _ _ 0).2.1.mp h₁ + have h₃ := (TouchingTripleCovariance _ _ _ (bU + y)).1.mp h₂ + have hs := (triple_same (H U) (H (TileTranslation U y)) + (H (TileTranslation W (GaussianQuarterTurn y))) (TileTranslation U y) U W + certU.1 certM.1 certW.1 certU.2 certM.2 certW.2).mp h₃ + exact ((TouchingTriplePermutations _ _ _).mp hs).2.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4085T1RestrictedAdaptedActions.lean b/LeanPool/ApollonianSuperharmonic/P4085T1RestrictedAdaptedActions.lean new file mode 100644 index 0000000000..1413b5f5d9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4085T1RestrictedAdaptedActions.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas + +-- [TABLET NODE: P4085T1RestrictedAdaptedActions] + +/-! +# P4085T1RestrictedAdaptedActions + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4085T1RestrictedAdaptedActions + (g g' : BandPackingSymmetry) + (hg : ∃ w : GaussianInt, g = .shift w ∨ g = .comp (.shift w) .negate) + (hlift : g' = g ∨ g' = .comp (.comp .negate .negate) g) : + ∃ m : Fin 4, + (∀ T, BandPackingSymmetryTileAction g' T = (TileQuarterTurn^[m.val]) T) ∧ + (∀ z, BandPackingSymmetryVectorAction g' z = + (⟨0, 1⟩ : GaussianInt) ^ m.val * z) ∧ + (∀ (U W : ProtoTile) (z : GaussianInt), + TileCentroid W - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint z → + TileCentroid (BandPackingSymmetryTileAction g' W) - + TileCentroid (BandPackingSymmetryTileAction g' U) = + (1 / 2 : Real) • GaussianRealPoint (BandPackingSymmetryVectorAction g' z)) := by +-- BODY + rcases hg with ⟨w, rfl | rfl⟩ <;> rcases hlift with rfl | rfl + · refine ⟨0, ?_, ?_, ?_⟩ + · intro T; rfl + · intro z; simp [BandPackingSymmetryVectorAction] + · intro U W z h; exact h + · refine ⟨2, ?_, ?_, ?_⟩ + · intro T; rfl + · intro z + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn, pow_succ] + · intro U W z h + change TileCentroid (TileQuarterTurn (TileQuarterTurn W)) - + TileCentroid (TileQuarterTurn (TileQuarterTurn U)) = _ + rw [(TileQuarterTurnFormulas (TileQuarterTurn W)).2.2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn U)).2.2.2.2.1, + (TileQuarterTurnFormulas W).2.2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.2.1] + have h₁ := congrArg Prod.fst h + have h₂ := congrArg Prod.snd h + simp [BandPackingSymmetryVectorAction, GaussianRealPoint, + GaussianQuarterTurn] at h₁ h₂ ⊢ + constructor <;> linarith + · refine ⟨1, ?_, ?_, ?_⟩ + · intro T; rfl + · intro z + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] + · intro U W z h + change TileCentroid (TileQuarterTurn W) - TileCentroid (TileQuarterTurn U) = _ + rw [(TileQuarterTurnFormulas W).2.2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.2.1] + have h₁ := congrArg Prod.fst h + have h₂ := congrArg Prod.snd h + simp [BandPackingSymmetryVectorAction, GaussianRealPoint, + GaussianQuarterTurn] at h₁ h₂ ⊢ + constructor <;> linarith + · refine ⟨3, ?_, ?_, ?_⟩ + · intro T; rfl + · intro z + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn, pow_succ] + · intro U W z h + change TileCentroid (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn W))) - + TileCentroid (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn U))) = _ + rw [(TileQuarterTurnFormulas (TileQuarterTurn (TileQuarterTurn W))).2.2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn (TileQuarterTurn U))).2.2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn W)).2.2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn U)).2.2.2.2.1, + (TileQuarterTurnFormulas W).2.2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.2.1] + have h₁ := congrArg Prod.fst h + have h₂ := congrArg Prod.snd h + simp [BandPackingSymmetryVectorAction, GaussianRealPoint, + GaussianQuarterTurn] at h₁ h₂ ⊢ + constructor <;> linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1BoundaryMultiplicity.lean b/LeanPool/ApollonianSuperharmonic/P4112T1BoundaryMultiplicity.lean new file mode 100644 index 0000000000..039bc7ea8f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4112T1BoundaryMultiplicity.lean @@ -0,0 +1,210 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderPaths +public import LeanPool.ApollonianSuperharmonic.FordBoundaryMultiplicity + +/-! +# P4112T1BoundaryMultiplicity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + + +-- [TABLET NODE: P4112T1BoundaryMultiplicity] +theorem P4112T1BoundaryMultiplicity (P : FordFareyParameter) (hP : 2 < P.q) : + let B := P4062T1RemainderPaths P + ∀ j, ∀ x ∈ (B j).1, + FordBoundaryMultiplicity P x = (if x = (B j).2 then 3 else 2) := by +-- BODY + classical + have rectangle_boundary (l r b t : Int) (z : GaussianInt) : + z ∈ LatticeVertexBoundary {w : GaussianInt | + l ≤ w.re ∧ w.re ≤ r ∧ b ≤ w.im ∧ w.im ≤ t} ↔ + (l ≤ z.re ∧ z.re ≤ r ∧ b ≤ z.im ∧ z.im ≤ t) ∧ + (z.re = l ∨ z.re = r ∨ z.im = b ∨ z.im = t) := by + constructor + · rintro ⟨hz, y, hy, hyr, hyi⟩ + change l ≤ z.re ∧ z.re ≤ r ∧ b ≤ z.im ∧ z.im ≤ t at hz + change ¬ (l ≤ y.re ∧ y.re ≤ r ∧ b ≤ y.im ∧ y.im ≤ t) at hy + exact ⟨hz, by omega⟩ + · rintro ⟨hz, he⟩ + refine ⟨hz, ?_⟩ + rcases he with he | he | he | he + · refine ⟨⟨z.re - 1, z.im⟩, ?_, ?_, ?_⟩ <;> + simp only [Set.mem_ofPred_eq] <;> omega + · refine ⟨⟨z.re + 1, z.im⟩, ?_, ?_, ?_⟩ <;> + simp only [Set.mem_ofPred_eq] <;> omega + · refine ⟨⟨z.re, z.im - 1⟩, ?_, ?_, ?_⟩ <;> + simp only [Set.mem_ofPred_eq] <;> omega + · refine ⟨⟨z.re, z.im + 1⟩, ?_, ?_, ?_⟩ <;> + simp only [Set.mem_ofPred_eq] <;> omega + intro B j x hx + change x ∈ (P4062T1RemainderPaths P j).1 at hx + change FordBoundaryMultiplicity P x = + (if x = (P4062T1RemainderPaths P j).2 then 3 else 2) + have hrpos : 0 < P.q₁ := by + by_contra h + have hzero : P.q₁ = 0 := by omega + have hq : (P.q : Int) = (P.q₂ : Int) := by + rw [P.sum_q, hzero] + simp + have hqNat := P.sum_q + rw [hzero] at hqNat + have hqlarge : 2 < P.q₂ := by omega + have hdet := P.det₁ + rw [hq] at hdet + rw [hzero] at hdet + have hprod : P.p₁ * (P.q₂ : Int) = 1 := by simpa using hdet + have hdiv : (P.q₂ : Int) ∣ 1 := ⟨P.p₁, by + rw [Int.mul_comm] + exact hprod.symm⟩ + have hunit := Int.eq_one_of_dvd_one (by omega) hdiv + have : P.q₂ = 1 := by exact_mod_cast hunit + omega + have hq : (P.q : Int) = (P.q₁ : Int) + P.q₂ := by + exact_mod_cast P.sum_q + have hcross : P.p₁ * (P.q₂ : Int) - P.p₂ * P.q₁ = 1 := by + calc + P.p₁ * (P.q₂ : Int) - P.p₂ * P.q₁ = + P.p₁ * (P.q : Int) - P.q₁ * P.p := by + rw [P.sum_q, P.sum_p] + push_cast + ring + _ = 1 := P.det₁ + have hneq : P.q₁ ≠ P.q₂ := by + intro heq + have hq1 : P.q₁ = 1 := by + have hd : (P.p₁ - P.p₂) * (P.q₁ : Int) = 1 := by + rw [heq] at hcross + nlinarith [hcross] + have hdiv : (P.q₁ : Int) ∣ 1 := ⟨P.p₁ - P.p₂, by + rw [Int.mul_comm] + exact hd.symm⟩ + have hunit := Int.eq_one_of_dvd_one (by omega) hdiv + exact_mod_cast hunit + have hqNat := P.sum_q + have hqtwo : P.q = 2 := by omega + omega + have b0 : x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) ↔ + (0 : Int) ≤ x.re ∧ x.re ≤ P.q₁ ∧ (0 : Int) ≤ x.im ∧ x.im ≤ P.q₁ ∧ + (x.re = 0 ∨ x.re = P.q₁ ∨ x.im = 0 ∨ x.im = P.q₁) := by + change x ∈ LatticeVertexBoundary {z : GaussianInt | + 0 ≤ z.re ∧ z.re ≤ P.q₁ ∧ 0 ≤ z.im ∧ z.im ≤ P.q₁} ↔ _ + rw [rectangle_boundary] + simp only [and_assoc] + have b1 : x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) ↔ + (P.q₂ : Int) ≤ x.re ∧ x.re ≤ P.q ∧ P.q₂ ≤ x.im ∧ x.im ≤ P.q ∧ + (x.re = P.q₂ ∨ x.re = P.q ∨ x.im = P.q₂ ∨ x.im = P.q) := by + change x ∈ LatticeVertexBoundary {z : GaussianInt | + P.q₂ ≤ z.re ∧ z.re ≤ P.q ∧ P.q₂ ≤ z.im ∧ z.im ≤ P.q} ↔ _ + rw [rectangle_boundary] + simp only [and_assoc] + have b2 : x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) ↔ + (P.q₁ : Int) ≤ x.re ∧ x.re ≤ P.q ∧ (0 : Int) ≤ x.im ∧ x.im ≤ P.q₂ ∧ + (x.re = P.q₁ ∨ x.re = P.q ∨ x.im = 0 ∨ x.im = P.q₂) := by + change x ∈ LatticeVertexBoundary {z : GaussianInt | + P.q₁ ≤ z.re ∧ z.re ≤ P.q ∧ 0 ≤ z.im ∧ z.im ≤ P.q₂} ↔ _ + rw [rectangle_boundary] + simp only [and_assoc] + have b3 : x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) ↔ + (0 : Int) ≤ x.re ∧ x.re ≤ P.q₂ ∧ P.q₁ ≤ x.im ∧ x.im ≤ P.q ∧ + (x.re = 0 ∨ x.re = P.q₂ ∨ x.im = P.q₁ ∨ x.im = P.q) := by + change x ∈ LatticeVertexBoundary {z : GaussianInt | + 0 ≤ z.re ∧ z.re ≤ P.q₂ ∧ P.q₁ ≤ z.im ∧ z.im ≤ P.q} ↔ _ + rw [rectangle_boundary] + simp only [and_assoc] + have count : FordBoundaryMultiplicity P x = + (if (0 : Int) ≤ x.re ∧ x.re ≤ P.q₁ ∧ 0 ≤ x.im ∧ x.im ≤ P.q₁ ∧ + (x.re = 0 ∨ x.re = P.q₁ ∨ x.im = 0 ∨ x.im = P.q₁) then 1 else 0) + + (if (P.q₂ : Int) ≤ x.re ∧ x.re ≤ P.q ∧ P.q₂ ≤ x.im ∧ x.im ≤ P.q ∧ + (x.re = P.q₂ ∨ x.re = P.q ∨ x.im = P.q₂ ∨ x.im = P.q) then 1 else 0) + + (if (P.q₁ : Int) ≤ x.re ∧ x.re ≤ P.q ∧ 0 ≤ x.im ∧ x.im ≤ P.q₂ ∧ + (x.re = P.q₁ ∨ x.re = P.q ∨ x.im = 0 ∨ x.im = P.q₂) then 1 else 0) + + (if 0 ≤ x.re ∧ x.re ≤ P.q₂ ∧ P.q₁ ≤ x.im ∧ x.im ≤ P.q ∧ + (x.re = 0 ∨ x.re = P.q₂ ∨ x.im = P.q₁ ∨ x.im = P.q) then 1 else 0) := by + simp only [FordBoundaryMultiplicity, Finset.card_filter, + Fin.sum_univ_succ, Fin.sum_univ_zero, add_zero] + change (if x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) then 1 else 0) + + ((if x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) then 1 else 0) + + ((if x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) then 1 else 0) + + (if x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) then 1 else 0))) = _ + simp only [b0, b1, b2, b3] + omega + rw [count] + by_cases hlt : P.q₂ < P.q₁ + · fin_cases j + · simp only [P4062T1RemainderPaths, hlt] at ⊢ + have hle : P.q₂ ≤ P.q₁ := Nat.le_of_lt hlt + simp? [P4062T1RemainderPaths, P4062T1InteriorSquare, hlt] at hx + rcases hx with ⟨⟨a, b, hmem, heq⟩, hp⟩ + rcases hmem with ⟨⟨ha1, ha2⟩, hb1, hb2⟩ + subst x + simp? at hp + by_cases hroot : (⟨a, b⟩ : GaussianInt) = ⟨(P.q₁ : Int), (P.q₂ : Int)⟩ + · simp? at hroot + rcases hroot with ⟨rfl, rfl⟩ + simp_all [] + · rcases hp with hp | hp <;> rcases hp with ⟨h1, h2⟩ <;> + simp_all [] <;> + split_ifs <;> omega + · simp only [P4062T1RemainderPaths, hlt] at ⊢ + have hle : P.q₂ ≤ P.q₁ := Nat.le_of_lt hlt + simp? [P4062T1RemainderPaths, P4062T1InteriorSquare, hlt] at hx + rcases hx with ⟨⟨a, b, hmem, heq⟩, hp⟩ + rcases hmem with ⟨⟨ha1, ha2⟩, hb1, hb2⟩ + subst x + simp? at hp + by_cases hroot : (⟨a, b⟩ : GaussianInt) = ⟨(P.q₂ : Int), (P.q₁ : Int)⟩ + · simp? at hroot + rcases hroot with ⟨rfl, rfl⟩ + simp_all [] + · rcases hp with hp | hp <;> rcases hp with ⟨h1, h2⟩ <;> + simp_all [] <;> + split_ifs <;> omega + · fin_cases j + · simp only [P4062T1RemainderPaths, hlt] at ⊢ + have hleNat : P.q₁ ≤ P.q₂ := Nat.le_of_not_gt hlt + have hlt' : P.q₁ < P.q₂ := Nat.lt_of_le_of_ne hleNat hneq + have hle : P.q₁ ≤ P.q₂ := Nat.le_of_lt hlt' + simp? [P4062T1RemainderPaths, P4062T1InteriorSquare, hlt] at hx + rcases hx with ⟨⟨a, b, hmem, heq⟩, hp⟩ + rcases hmem with ⟨⟨ha1, ha2⟩, hb1, hb2⟩ + subst x + simp? at hp + by_cases hroot : (⟨a, b⟩ : GaussianInt) = ⟨(P.q₁ : Int), (P.q₁ : Int)⟩ + · simp? at hroot + rcases hroot with ⟨rfl, rfl⟩ + simp_all [] + · rcases hp with hp | hp <;> rcases hp with ⟨h1, h2⟩ <;> + simp_all [] <;> + split_ifs <;> omega + · simp only [P4062T1RemainderPaths, hlt] at ⊢ + have hleNat : P.q₁ ≤ P.q₂ := Nat.le_of_not_gt hlt + have hlt' : P.q₁ < P.q₂ := Nat.lt_of_le_of_ne hleNat hneq + have hle : P.q₁ ≤ P.q₂ := Nat.le_of_lt hlt' + simp? [P4062T1RemainderPaths, P4062T1InteriorSquare, hlt] at hx + rcases hx with ⟨⟨a, b, hmem, heq⟩, hp⟩ + rcases hmem with ⟨⟨ha1, ha2⟩, hb1, hb2⟩ + subst x + simp? at hp + by_cases hroot : (⟨a, b⟩ : GaussianInt) = ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ + · simp? at hroot + rcases hroot with ⟨rfl, rfl⟩ + simp_all [] + · rcases hp with hp | hp <;> rcases hp with ⟨h1, h2⟩ <;> + simp_all [] <;> + split_ifs <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean new file mode 100644 index 0000000000..ff6fcec594 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean @@ -0,0 +1,1742 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4112T1PathGeometry + +/-! +# P4112T1LowerNeighbors + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + + +-- [TABLET NODE: P4112T1LowerNeighbors] +namespace LowerNeighborGeometry + +private theorem hq1pos : + (by + classical + exact + ∀ (P : FordFareyParameter), ((2 : ℕ) < P.q) → (0 < P.q₁) + ) := by + classical + intro P hP + by_contra h + have hz : P.q₁ = 0 := by omega + have hd := P.det₁ + rw [hz] at hd + simp only [Nat.cast_zero, zero_mul] at hd + have hqint : 2 < (P.q : Int) := by exact_mod_cast hP + by_cases hp : P.p₁ ≤ 0 + · have hqnonneg : 0 ≤ (P.q : Int) := by omega + have : P.p₁ * (P.q : Int) ≤ 0 := mul_nonpos_of_nonpos_of_nonneg hp hqnonneg + omega + · have hp' : 1 ≤ P.p₁ := by omega + nlinarith + +private theorem hneq : + (by + classical + exact + ∀ (P : FordFareyParameter), ((2 : ℕ) < P.q) → ((0 < P.q₁) → ((P.p₁ * (P.q₂ : Int) - (P.q₁ + : Int) * P.p₂ = 1) → ((P.q = P.q₁ + P.q₂) → (P.q₁ ≠ P.q₂)))) + ) := by + classical + intro P hP hq1pos hcross hsum heq + have hm : (P.q₁ : Int) * (P.p₁ - P.p₂) = 1 := by + rw [heq] at hcross + nlinarith [hcross] + have hd : (P.q₁ : Int) ∣ 1 := ⟨P.p₁ - P.p₂, hm.symm⟩ + have hu : (P.q₁ : Int) = 1 := + Int.eq_one_of_dvd_one (by exact_mod_cast (Nat.zero_le P.q₁)) hd + have hsum := P.sum_q + omega + +private theorem squareCoordinates : + (by + classical + exact + ∀ (q : ℕ), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare q ↔ (1 : ℤ) ≤ z.re ∧ z.re ≤ + (↑q : ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ z.im ∧ z.im ≤ (↑q : ℤ) - (1 : ℤ) + ) := by + classical + intro q z + unfold P4062T1InteriorSquare + constructor + · intro hz + obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hz + obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab + exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, + (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ + · rintro ⟨ha, ha', hb, hb'⟩ + exact Finset.mem_image.mpr ⟨(z.re, z.im), + Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨ha, ha'⟩, + Finset.mem_Icc.mpr ⟨hb, hb'⟩⟩, by cases z; rfl⟩ + +private theorem natAbs_form : + (by + classical + exact + (FordFareyParameter) → (∀ (z : ℤ), z.natAbs = if z ≤ (0 : ℤ) then (-z).toNat else z.toNat) + ) := by + classical + intro P z + by_cases hz : z ≤ 0 + · rw [ite_eq_left hz] + have hc : (z.natAbs : Int) = -z := Int.ofNat_natAbs_of_nonpos hz + have ht : ((-z).toNat : Int) = -z := Int.toNat_of_nonneg (by omega) + exact_mod_cast hc.trans ht.symm + · rw [ite_eq_right hz] + have hz' : 0 ≤ z := by omega + have hc : (z.natAbs : Int) = z := Int.natAbs_of_nonneg hz' + have ht : (z.toNat : Int) = z := Int.toNat_of_nonneg hz' + exact_mod_cast hc.trans ht.symm + +private theorem d_on_path : + (by + classical + exact ∀ (P : FordFareyParameter), (2 < P.q) → + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) + (B 0).2 (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs + ∀ (j : Fin 2) (z : GaussianInt), z ∈ (B j).1 → + d z = (z.re - (B j).2.re).natAbs + (z.im - (B j).2.im).natAbs + ) := by + classical + intro P hP B d j z hz + have hgeom := P4112T1PathGeometry P hP + fin_cases j + · change z ∈ (P4062T1RemainderPaths P 0).1 at hz + simp [d, B, hz] + · change z ∈ (P4062T1RemainderPaths P 1).1 at hz + have hdisj := hgeom.2.1 + have hnot : z ∉ (B 0).1 := by + intro hz0 + exact Finset.disjoint_left.mp hdisj hz0 hz + simp [d, B, hnot] + +private theorem neighbor_filter : + (by + classical + exact + ∀ (S : Finset GaussianInt), ∀ (x : GaussianInt), ∀ (ρ : GaussianInt → ℕ), ({y ∈ S | + FourNeighborAdjacent y x ∧ ρ y < ρ x} : Finset GaussianInt) = ({y ∈ + {x + (1 : GaussianInt), x - (1 : GaussianInt), x + ⟨(0 : ℤ), (1 : ℤ)⟩, x - ⟨(0 : ℤ), + (1 : ℤ)⟩} | y ∈ S ∧ ρ y < ρ x} : Finset GaussianInt) + ) := by + classical + intro S x ρ + ext y + simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] + constructor + · rintro ⟨hy, hadj, hdist⟩ + refine ⟨?_, ⟨hy, hdist⟩⟩ + rcases hadj with h | h | h | h + · right; left + rw [h] + simp + · left + rw [h] + simp + · right; right; right + rw [h] + simp + · right; right; left + rw [h] + simp + · rintro ⟨hycan, ⟨hy, hdist⟩⟩ + refine ⟨hy, ?_, hdist⟩ + rcases hycan with hy | hy | hy | hy <;> subst y <;> + simp [FourNeighborAdjacent] + +private theorem count_eq : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) + (B 0).2 (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + (∀ (j : Fin 2), ∀ (z : GaussianInt), (z ∈ (B j).1) → (d z = (z.re-(B j).2.re).natAbs + + (z.im-(B j).2.im).natAbs)) → ((∀ (S : Finset GaussianInt), ∀ (x : GaussianInt), ∀ (ρ + : GaussianInt → Nat), S.filter (fun y => FourNeighborAdjacent y x ∧ ρ y < ρ x) = + ({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ S + ∧ ρ y < ρ x)) → ( + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (j : Fin (2 : ℕ)), ∀ x ∈ (B j).1, ({y ∈ (B j).1 | FourNeighborAdjacent y x ∧ d y < d x} + : Finset GaussianInt).card = ({y ∈ {x + (1 : GaussianInt), x - (1 : GaussianInt), + x + ⟨(0 : ℤ), (1 : ℤ)⟩, x - ⟨(0 : ℤ), (1 : ℤ)⟩} | y ∈ (B j).1 ∧ rootDist j y < + rootDist j x} : Finset GaussianInt).card)) + ) := by + classical + intro P B d d_on_path neighbor_filter rootDist j x hx + have hcongr : + (B j).1.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x) = + (B j).1.filter (fun y => FourNeighborAdjacent y x ∧ + rootDist j y < rootDist j x) := by + apply Finset.filter_congr + intro y hy + rw [d_on_path j y hy, d_on_path j x hx] + rw [hcongr, neighbor_filter] + +private theorem root_candidate_empty : + (by + classical + exact + (FordFareyParameter) → (∀ (S : Finset GaussianInt), ∀ (ρ : GaussianInt → ℕ), ∀ (x : + GaussianInt), ρ x = (0 : ℕ) → ({y ∈ {x + (1 : GaussianInt), x - (1 : GaussianInt), + x + ⟨(0 : ℤ), (1 : ℤ)⟩, x - ⟨(0 : ℤ), (1 : ℤ)⟩} | y ∈ S ∧ ρ y < ρ x} : Finset + GaussianInt) = ∅) + ) := by + classical + intro P S ρ x hz + ext y + simp only [Finset.mem_filter, Finset.notMem_empty] + constructor + · rintro ⟨_, _, hlt⟩ + rw [hz] at hlt + omega + · intro h + contradiction + +private theorem hpredAt281 : + (by + classical + exact + ∀ (P : FordFareyParameter), (0 < P.q₁) → ((P.q = P.q₁ + P.q₂) → ((∀ (q : Nat), ∀ (z : + GaussianInt), z ∈ P4062T1InteriorSquare q ↔ 1 ≤ z.re ∧ z.re ≤ (q : Int)-1 ∧ 1 ≤ + z.im ∧ z.im ≤ (q : Int)-1) → (∀ (x : GaussianInt), (P.q₂ < P.q₁) → ((x.re = (↑P.q₁ : + ℤ) ∧ x.im ≤ (↑P.q₂ : ℤ)) → ((x.re = (P.q₁ : Int)) → ((1 ≤ x.im) → ((x.im < (P.q₂ : + Int)) → (x + ⟨0, 1⟩ ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : + Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re)))))))))) + ) := by + classical + intro P hq1pos hsum squareCoordinates x horder harm hr hlo hhi + apply Finset.mem_filter.mpr + constructor + · apply (squareCoordinates P.q (x + ⟨0, 1⟩)).mpr + simp only [Zsqrtd.re_add, Zsqrtd.im_add] + norm_num + constructor <;> omega + · left + constructor + · simp [Zsqrtd.re_add, hr] + · simp [Zsqrtd.im_add] + omega + +private theorem hpredDistAt295 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), ((B (0 : Fin (2 : ℕ))).2 = ⟨(↑P.q₁ : ℤ), (↑P.q₂ : ℤ)⟩) → ((x.re = + (P.q₁ : Int)) → ((x.im < (P.q₂ : Int)) → (rootDist 0 (x + ⟨0, 1⟩) < rootDist 0 x))) + ) := by + classical + intro P B rootDist x hb0root hr hhi + have ha : 0 ≤ (P.q₂ : Int) - (x.im + 1) := by omega + have hab : (P.q₂ : Int) - (x.im + 1) < (P.q₂ : Int) - x.im := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + have hrev1 : x.im + 1 - (P.q₂ : Int) = -((P.q₂ : Int) - (x.im + 1)) := by omega + have hrev2 : x.im - (P.q₂ : Int) = -((P.q₂ : Int) - x.im) := by omega + simp only [rootDist, hb0root, Zsqrtd.re_add, Zsqrtd.im_add, hr] + simp only [Int.add_zero, sub_self, Int.natAbs_zero, zero_add] + rw [hrev1, Int.natAbs_neg, hrev2, Int.natAbs_neg] + exact hn + +private theorem hnotRightAt305 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.re = (P.q₁ : Int)) → ((x.im < (P.q₂ : + Int)) → (x + 1 ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) + ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re)))) + ) := by + classical + intro P x hr hhi hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.re_add, hr] at hz + · simp [Zsqrtd.im_add] at hz + omega + +private theorem hnotLeftAt315 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.re = (P.q₁ : Int)) → ((x.im < (P.q₂ : + Int)) → (x - 1 ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) + ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re)))) + ) := by + classical + intro P x hr hhi hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.re_sub, hr] at hz + · simp [Zsqrtd.im_sub] at hz + omega + +private theorem hnotPredAt325 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), ((B (0 : Fin (2 : ℕ))).2 = ⟨(↑P.q₁ : ℤ), (↑P.q₂ : ℤ)⟩) → ((x.re = + (P.q₁ : Int)) → ((x.im < (P.q₂ : Int)) → (¬ rootDist 0 (x - ⟨0, 1⟩) < rootDist 0 x))) + ) := by + classical + intro P B rootDist x hb0root hr hhi + have ha : 0 ≤ (P.q₂ : Int) - x.im := by omega + have hab : (P.q₂ : Int) - x.im < (P.q₂ : Int) - (x.im - 1) := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + have hn' : rootDist 0 x < rootDist 0 (x - ⟨0, 1⟩) := by + have hrev1 : x.im - (P.q₂ : Int) = -((P.q₂ : Int) - x.im) := by omega + have hrev2 : x.im - 1 - (P.q₂ : Int) = + -((P.q₂ : Int) - (x.im - 1)) := by omega + simp only [rootDist, hb0root, Zsqrtd.re_sub, Zsqrtd.im_sub, hr] + simp only [Int.sub_zero, sub_self, Int.natAbs_zero, zero_add] + rw [hrev1, Int.natAbs_neg, hrev2, Int.natAbs_neg] + exact hn + omega + +private theorem hsetAt338 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), (x + ⟨0, 1⟩ ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = + (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re))) → + ((rootDist 0 (x + ⟨0, 1⟩) < rootDist 0 x) → ((x + 1 ∉ (P4062T1InteriorSquare + P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : + Int) ∧ (P.q₁ : Int) ≤ z.re))) → ((x - 1 ∉ (P4062T1InteriorSquare P.q).filter (fun z + => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) + ≤ z.re))) → ((¬ rootDist 0 (x - ⟨0, 1⟩) < rootDist 0 x) → ((({x + 1, x - 1, x + ⟨0, + 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare + P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : + Int) ∧ (P.q₁ : Int) ≤ z.re)) ∧ rootDist 0 y < rootDist 0 x)) = {x + ⟨0, 1⟩}))))) + ) := by + classical + intro P B rootDist x hpred hpredDist hnotRight hnotLeft hnotPred + ext y + simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] + constructor + · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ + · subst y + exact (hnotRight (Finset.mem_filter.mpr hmem)).elim + · subst y + exact (hnotLeft (Finset.mem_filter.mpr hmem)).elim + · exact hy + · subst y + exact (hnotPred hdist).elim + · intro hy + subst y + exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ + +private theorem hpredAt376 : + (by + classical + exact + ∀ (P : FordFareyParameter), (0 < P.q₁) → ((P.q = P.q₁ + P.q₂) → ((∀ (q : Nat), ∀ (z : + GaussianInt), z ∈ P4062T1InteriorSquare q ↔ 1 ≤ z.re ∧ z.re ≤ (q : Int)-1 ∧ 1 ≤ + z.im ∧ z.im ≤ (q : Int)-1) → (∀ (x : GaussianInt), (x.im = (↑P.q₂ : ℤ) ∧ (↑P.q₁ : ℤ) + ≤ x.re) → ((x.im = (P.q₂ : Int)) → ((x.re < (P.q : Int)) → (((P.q₁ : Int) < x.re) → + (x - 1 ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ + (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re))))))))) + ) := by + classical + intro P hq1pos hsum squareCoordinates x harm hr hhi hgt + apply Finset.mem_filter.mpr + constructor + · apply (squareCoordinates P.q (x - 1)).mpr + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + norm_num + constructor <;> omega + · right + constructor + · simp [Zsqrtd.im_sub, hr] + · simp [Zsqrtd.re_sub] + omega + +private theorem hnotRightAt398 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), ((B (0 : Fin (2 : ℕ))).2 = ⟨(↑P.q₁ : ℤ), (↑P.q₂ : ℤ)⟩) → ((x.im = + (P.q₂ : Int)) → (((P.q₁ : Int) < x.re) → (¬ rootDist 0 (x + 1) < rootDist 0 x))) + ) := by + classical + intro P B rootDist x hb0root hr hgt + have ha : 0 ≤ x.re - (P.q₁ : Int) := by omega + have hab : x.re - (P.q₁ : Int) < x.re + 1 - (P.q₁ : Int) := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + have hn' : rootDist 0 x < rootDist 0 (x + 1) := by + simp only [rootDist, hb0root, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, hr] + simp only [Int.add_zero, sub_self, + Int.natAbs_zero] + exact hn + omega + +private theorem hnotUpAt409 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.im = (P.q₂ : Int)) → (((P.q₁ : Int) < + x.re) → (x + ⟨0, 1⟩ ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : + Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re)))) + ) := by + classical + intro P x hr hgt hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.re_add] at hz + omega + · simp [Zsqrtd.im_add, hr] at hz + +private theorem hnotDownAt419 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.im = (P.q₂ : Int)) → (((P.q₁ : Int) < + x.re) → (x - ⟨0, 1⟩ ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : + Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re)))) + ) := by + classical + intro P x hr hgt hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.re_sub] at hz + omega + · simp [Zsqrtd.im_sub, hr] at hz + +private theorem hsetAt429 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), (x - 1 ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = + (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re))) → + ((rootDist 0 (x - 1) < rootDist 0 x) → ((¬ rootDist 0 (x + 1) < rootDist 0 x) → ((x + + ⟨0, 1⟩ ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ + (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re))) → ((x - ⟨0, 1⟩ ∉ + (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : + Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re))) → ((({x + 1, x - 1, x + ⟨0, 1⟩, + x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare + P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : + Int) ∧ (P.q₁ : Int) ≤ z.re)) ∧ rootDist 0 y < rootDist 0 x)) = {x - 1}))))) + ) := by + classical + intro P B rootDist x hpred hpredDist hnotRight hnotUp hnotDown + ext y + simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] + constructor + · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ + · subst y + exact (hnotRight hdist).elim + · exact hy + · subst y + exact (hnotUp (Finset.mem_filter.mpr hmem)).elim + · subst y + exact (hnotDown (Finset.mem_filter.mpr hmem)).elim + · intro hy + subst y + exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ + +private theorem hpredAt476 : + (by + classical + exact + ∀ (P : FordFareyParameter), (0 < P.q₁) → ((P.q = P.q₁ + P.q₂) → ((∀ (q : Nat), ∀ (z : + GaussianInt), z ∈ P4062T1InteriorSquare q ↔ 1 ≤ z.re ∧ z.re ≤ (q : Int)-1 ∧ 1 ≤ + z.im ∧ z.im ≤ (q : Int)-1) → (∀ (x : GaussianInt), (P.q₁ < P.q₂) → ((x.re = (↑P.q₁ : + ℤ) ∧ x.im ≤ (↑P.q₁ : ℤ)) → ((x.re = (P.q₁ : Int)) → ((1 ≤ x.im) → ((x.im < (P.q₁ : + Int)) → (x + ⟨0, 1⟩ ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : + Int) ∧ z.im ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int))))))))))) + ) := by + classical + intro P hq1pos hsum squareCoordinates x horder' harm hr hlo hhi + apply Finset.mem_filter.mpr + constructor + · apply (squareCoordinates P.q (x + ⟨0, 1⟩)).mpr + simp only [Zsqrtd.re_add, Zsqrtd.im_add] + norm_num + constructor <;> omega + · left + constructor + · simp [Zsqrtd.re_add, hr] + · simp [Zsqrtd.im_add] + omega + +private theorem hpredDistAt490 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), ((B (0 : Fin (2 : ℕ))).2 = ⟨(↑P.q₁ : ℤ), (↑P.q₁ : ℤ)⟩) → ((x.re = + (↑P.q₁ : ℤ) ∧ x.im ≤ (↑P.q₁ : ℤ)) → ((x.re = (P.q₁ : Int)) → ((x.im < (P.q₁ : Int)) → + (rootDist 0 (x + ⟨0, 1⟩) < rootDist 0 x)))) + ) := by + classical + intro P B rootDist x hb0root harm hr hhi + have ha : 0 ≤ (P.q₁ : Int) - (x.im + 1) := by omega + have hab : (P.q₁ : Int) - (x.im + 1) < (P.q₁ : Int) - x.im := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + have hrev1 : x.im + 1 - (P.q₁ : Int) = -((P.q₁ : Int) - (x.im + 1)) := by omega + have hrev2 : x.im - (P.q₁ : Int) = -((P.q₁ : Int) - x.im) := by omega + simp only [rootDist, hb0root, Zsqrtd.re_add, Zsqrtd.im_add, + hr] + simp only [Int.add_zero, sub_self, Int.natAbs_zero, zero_add] + rw [hrev1, Int.natAbs_neg, hrev2, Int.natAbs_neg] + exact hn + +private theorem hnotRightAt501 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.re = (↑P.q₁ : ℤ) ∧ x.im ≤ (↑P.q₁ : + ℤ)) → ((x.re = (P.q₁ : Int)) → ((x.im < (P.q₁ : Int)) → (x + 1 ∉ + (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : + Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))))) + ) := by + classical + intro P x harm hr hhi hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.re_add, hr] at hz + · simp [Zsqrtd.im_add] at hz + omega + +private theorem hnotLeftAt511 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.re = (↑P.q₁ : ℤ) ∧ x.im ≤ (↑P.q₁ : + ℤ)) → ((x.re = (P.q₁ : Int)) → ((x.im < (P.q₁ : Int)) → (x - 1 ∉ + (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : + Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))))) + ) := by + classical + intro P x harm hr hhi hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.re_sub, hr] at hz + · simp [Zsqrtd.im_sub] at hz + omega + +private theorem hnotPredAt521 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), ((B (0 : Fin (2 : ℕ))).2 = ⟨(↑P.q₁ : ℤ), (↑P.q₁ : ℤ)⟩) → ((x.re = + (↑P.q₁ : ℤ) ∧ x.im ≤ (↑P.q₁ : ℤ)) → ((x.re = (P.q₁ : Int)) → ((x.im < (P.q₁ : Int)) → + (¬ rootDist 0 (x - ⟨0, 1⟩) < rootDist 0 x)))) + ) := by + classical + intro P B rootDist x hb0root harm hr hhi + have ha : 0 ≤ (P.q₁ : Int) - x.im := by omega + have hab : (P.q₁ : Int) - x.im < (P.q₁ : Int) - (x.im - 1) := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + have hrev1 : x.im - (P.q₁ : Int) = -((P.q₁ : Int) - x.im) := by omega + have hrev2 : x.im - 1 - (P.q₁ : Int) = + -((P.q₁ : Int) - (x.im - 1)) := by omega + have hn' : rootDist 0 x < rootDist 0 (x - ⟨0, 1⟩) := by + simp only [rootDist, hb0root, Zsqrtd.re_sub, Zsqrtd.im_sub, + hr] + simp only [Int.sub_zero, sub_self, Int.natAbs_zero, zero_add] + rw [hrev1, Int.natAbs_neg, hrev2, Int.natAbs_neg] + exact hn + omega + +private theorem hsetAt535 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), (x + ⟨0, 1⟩ ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = + (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))) → + ((rootDist 0 (x + ⟨0, 1⟩) < rootDist 0 x) → ((x + 1 ∉ (P4062T1InteriorSquare + P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : + Int) ∧ z.re ≤ (P.q₁ : Int)))) → ((x - 1 ∉ (P4062T1InteriorSquare P.q).filter (fun z + => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ + : Int)))) → ((¬ rootDist 0 (x - ⟨0, 1⟩) < rootDist 0 x) → ((({x + 1, x - 1, x + ⟨0, + 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare + P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : + Int) ∧ z.re ≤ (P.q₁ : Int))) ∧ rootDist 0 y < rootDist 0 x)) = {x + ⟨0, 1⟩}))))) + ) := by + classical + intro P B rootDist x hpred hpredDist hnotRight hnotLeft hnotPred + ext y + simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] + constructor + · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ + · subst y + exact (hnotRight (Finset.mem_filter.mpr hmem)).elim + · subst y + exact (hnotLeft (Finset.mem_filter.mpr hmem)).elim + · exact hy + · subst y + exact (hnotPred hdist).elim + · intro hy + subst y + exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ + +private theorem hpredAt570 : + (by + classical + exact + ∀ (P : FordFareyParameter), (0 < P.q₁) → ((P.q = P.q₁ + P.q₂) → ((∀ (q : Nat), ∀ (z : + GaussianInt), z ∈ P4062T1InteriorSquare q ↔ 1 ≤ z.re ∧ z.re ≤ (q : Int)-1 ∧ 1 ≤ + z.im ∧ z.im ≤ (q : Int)-1) → (∀ (x : GaussianInt), (P.q₁ < P.q₂) → ((x.im = (↑P.q₁ : + ℤ) ∧ x.re ≤ (↑P.q₁ : ℤ)) → ((x.im = (P.q₁ : Int)) → ((1 ≤ x.re) → ((x.re < (P.q₁ : + Int)) → (x + 1 ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) + ∧ z.im ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int))))))))))) + ) := by + classical + intro P hq1pos hsum squareCoordinates x horder' harm hr hlo hhi + apply Finset.mem_filter.mpr + constructor + · apply (squareCoordinates P.q (x + 1)).mpr + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one] + constructor <;> omega + · right + constructor + · simp [Zsqrtd.im_add, hr] + · simp [Zsqrtd.re_add, Zsqrtd.re_one] + omega + +private theorem hpredDistAt583 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), ((B (0 : Fin (2 : ℕ))).2 = ⟨(↑P.q₁ : ℤ), (↑P.q₁ : ℤ)⟩) → ((x.im = + (↑P.q₁ : ℤ) ∧ x.re ≤ (↑P.q₁ : ℤ)) → ((x.im = (P.q₁ : Int)) → ((x.re < (P.q₁ : Int)) → + (rootDist 0 (x + 1) < rootDist 0 x)))) + ) := by + classical + intro P B rootDist x hb0root harm hr hhi + have ha : 0 ≤ (P.q₁ : Int) - (x.re + 1) := by omega + have hab : (P.q₁ : Int) - (x.re + 1) < (P.q₁ : Int) - x.re := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + have hrev1 : x.re + 1 - (P.q₁ : Int) = -((P.q₁ : Int) - (x.re + 1)) := by omega + have hrev2 : x.re - (P.q₁ : Int) = -((P.q₁ : Int) - x.re) := by omega + simp only [rootDist, hb0root, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, hr] + simp only [Int.add_zero, sub_self, Int.natAbs_zero] + rw [hrev1, Int.natAbs_neg, hrev2, Int.natAbs_neg] + exact hn + +private theorem hnotLeftAt594 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), ((B (0 : Fin (2 : ℕ))).2 = ⟨(↑P.q₁ : ℤ), (↑P.q₁ : ℤ)⟩) → ((x.im = + (↑P.q₁ : ℤ) ∧ x.re ≤ (↑P.q₁ : ℤ)) → ((x.im = (P.q₁ : Int)) → ((x.re < (P.q₁ : Int)) → + (¬ rootDist 0 (x - 1) < rootDist 0 x)))) + ) := by + classical + intro P B rootDist x hb0root harm hr hhi + have ha : 0 ≤ (P.q₁ : Int) - x.re := by omega + have hab : (P.q₁ : Int) - x.re < (P.q₁ : Int) - (x.re - 1) := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + have hrev1 : x.re - (P.q₁ : Int) = -((P.q₁ : Int) - x.re) := by omega + have hrev2 : x.re - 1 - (P.q₁ : Int) = + -((P.q₁ : Int) - (x.re - 1)) := by omega + have hn' : rootDist 0 x < rootDist 0 (x - 1) := by + simp only [rootDist, hb0root, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_one, Zsqrtd.im_one, hr] + simp only [Int.sub_zero, sub_self, Int.natAbs_zero] + rw [hrev1, Int.natAbs_neg, hrev2, Int.natAbs_neg] + exact hn + omega + +private theorem hnotUpAt608 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.im = (↑P.q₁ : ℤ) ∧ x.re ≤ (↑P.q₁ : + ℤ)) → ((x.im = (P.q₁ : Int)) → ((x.re < (P.q₁ : Int)) → (x + ⟨0, 1⟩ ∉ + (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : + Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))))) + ) := by + classical + intro P x harm hr hhi hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.re_add] at hz + omega + · simp [Zsqrtd.im_add, hr] at hz + +private theorem hnotDownAt618 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.im = (↑P.q₁ : ℤ) ∧ x.re ≤ (↑P.q₁ : + ℤ)) → ((x.im = (P.q₁ : Int)) → ((x.re < (P.q₁ : Int)) → (x - ⟨0, 1⟩ ∉ + (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : + Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))))) + ) := by + classical + intro P x harm hr hhi hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.re_sub] at hz + omega + · simp [Zsqrtd.im_sub, hr] at hz + +private theorem hsetAt628 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), (x + 1 ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = + (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))) → + ((rootDist 0 (x + 1) < rootDist 0 x) → ((¬ rootDist 0 (x - 1) < rootDist 0 x) → ((x + + ⟨0, 1⟩ ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ + (P.q₁ : Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))) → ((x - ⟨0, 1⟩ ∉ + (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : + Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))) → ((({x + 1, x - 1, x + ⟨0, 1⟩, + x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare + P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : + Int) ∧ z.re ≤ (P.q₁ : Int))) ∧ rootDist 0 y < rootDist 0 x)) = {x + 1}))))) + ) := by + classical + intro P B rootDist x hpred hpredDist hnotLeft hnotUp hnotDown + ext y + simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] + constructor + · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ + · exact hy + · subst y + exact (hnotLeft hdist).elim + · subst y + exact (hnotUp (Finset.mem_filter.mpr hmem)).elim + · subst y + exact (hnotDown (Finset.mem_filter.mpr hmem)).elim + · intro hy + subst y + exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ + +private theorem hpredAt680 : + (by + classical + exact + ∀ (P : FordFareyParameter), (0 < P.q₁) → ((P.q = P.q₁ + P.q₂) → ((∀ (q : Nat), ∀ (z : + GaussianInt), z ∈ P4062T1InteriorSquare q ↔ 1 ≤ z.re ∧ z.re ≤ (q : Int)-1 ∧ 1 ≤ + z.im ∧ z.im ≤ (q : Int)-1) → (∀ (x : GaussianInt), (P.q₂ < P.q₁) → ((x.im = (↑P.q₁ : + ℤ) ∧ x.re ≤ (↑P.q₂ : ℤ)) → ((x.im = (P.q₁ : Int)) → ((1 ≤ x.re) → ((x.re < (P.q₂ : + Int)) → (x + 1 ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : Int) + ∧ z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im)))))))))) + ) := by + classical + intro P hq1pos hsum squareCoordinates x horder harm hr hlo hhi + apply Finset.mem_filter.mpr + constructor + · apply (squareCoordinates P.q (x + 1)).mpr + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one] + constructor <;> omega + · left + constructor + · simp [Zsqrtd.im_add, hr] + · simp [Zsqrtd.re_add, Zsqrtd.re_one] + omega + +private theorem hpredDistAt693 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), ((B (1 : Fin (2 : ℕ))).2 = ⟨(↑P.q₂ : ℤ), (↑P.q₁ : ℤ)⟩) → ((x.im = + (P.q₁ : Int)) → ((x.re < (P.q₂ : Int)) → (rootDist 1 (x + 1) < rootDist 1 x))) + ) := by + classical + intro P B rootDist x hb1root hr hhi + have ha : 0 ≤ (P.q₂ : Int) - (x.re + 1) := by omega + have hab : (P.q₂ : Int) - (x.re + 1) < (P.q₂ : Int) - x.re := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + have hrev1 : x.re + 1 - (P.q₂ : Int) = -((P.q₂ : Int) - (x.re + 1)) := by omega + have hrev2 : x.re - (P.q₂ : Int) = -((P.q₂ : Int) - x.re) := by omega + simp only [rootDist, hb1root, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, hr] + simp only [Int.add_zero, sub_self, Int.natAbs_zero] + rw [hrev1, Int.natAbs_neg, hrev2, Int.natAbs_neg] + exact hn + +private theorem hnotLeftAt704 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), ((B (1 : Fin (2 : ℕ))).2 = ⟨(↑P.q₂ : ℤ), (↑P.q₁ : ℤ)⟩) → ((x.im = + (P.q₁ : Int)) → ((x.re < (P.q₂ : Int)) → (¬ rootDist 1 (x - 1) < rootDist 1 x))) + ) := by + classical + intro P B rootDist x hb1root hr hhi + have ha : 0 ≤ (P.q₂ : Int) - x.re := by omega + have hab : (P.q₂ : Int) - x.re < (P.q₂ : Int) - (x.re - 1) := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + have hrev1 : x.re - (P.q₂ : Int) = -((P.q₂ : Int) - x.re) := by omega + have hrev2 : x.re - 1 - (P.q₂ : Int) = + -((P.q₂ : Int) - (x.re - 1)) := by omega + have hn' : rootDist 1 x < rootDist 1 (x - 1) := by + simp only [rootDist, hb1root, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_one, Zsqrtd.im_one, hr] + simp only [Int.sub_zero, sub_self, Int.natAbs_zero] + rw [hrev1, Int.natAbs_neg, hrev2, Int.natAbs_neg] + exact hn + omega + +private theorem hnotUpAt718 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.im = (P.q₁ : Int)) → ((x.re < (P.q₂ : + Int)) → (x + ⟨0, 1⟩ ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : + Int) ∧ z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im)))) + ) := by + classical + intro P x hr hhi hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.im_add, hr] at hz + · simp [Zsqrtd.re_add] at hz + omega + +private theorem hnotDownAt728 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.im = (P.q₁ : Int)) → ((x.re < (P.q₂ : + Int)) → (x - ⟨0, 1⟩ ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : + Int) ∧ z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im)))) + ) := by + classical + intro P x hr hhi hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.im_sub, hr] at hz + · simp [Zsqrtd.re_sub] at hz + omega + +private theorem hsetAt738 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), (x + 1 ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.im = + (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im))) → + ((rootDist 1 (x + 1) < rootDist 1 x) → ((¬ rootDist 1 (x - 1) < rootDist 1 x) → ((x + + ⟨0, 1⟩ ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ z.re ≤ + (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im))) → ((x - ⟨0, 1⟩ ∉ + (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : + Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im))) → ((({x + 1, x - 1, x + ⟨0, 1⟩, + x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare + P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : + Int) ∧ (P.q₁ : Int) ≤ z.im)) ∧ rootDist 1 y < rootDist 1 x)) = {x + 1}))))) + ) := by + classical + intro P B rootDist x hpred hpredDist hnotLeft hnotUp hnotDown + ext y + simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] + constructor + · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ + · exact hy + · subst y + exact (hnotLeft hdist).elim + · subst y + exact (hnotUp (Finset.mem_filter.mpr hmem)).elim + · subst y + exact (hnotDown (Finset.mem_filter.mpr hmem)).elim + · intro hy + subst y + exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ + +private theorem hpredAt775 : + (by + classical + exact + ∀ (P : FordFareyParameter), (0 < P.q₁) → ((P.q = P.q₁ + P.q₂) → ((∀ (q : Nat), ∀ (z : + GaussianInt), z ∈ P4062T1InteriorSquare q ↔ 1 ≤ z.re ∧ z.re ≤ (q : Int)-1 ∧ 1 ≤ + z.im ∧ z.im ≤ (q : Int)-1) → (∀ (x : GaussianInt), (x.re = (↑P.q₂ : ℤ) ∧ (↑P.q₁ : ℤ) + ≤ x.im) → ((x.re = (P.q₂ : Int)) → (((P.q₁ : Int) < x.im) → ((x.im < (P.q : Int)) → + (x - ⟨0, 1⟩ ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ + z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im))))))))) + ) := by + classical + intro P hq1pos hsum squareCoordinates x harm hr hlo hhi + apply Finset.mem_filter.mpr + constructor + · apply (squareCoordinates P.q (x - ⟨0, 1⟩)).mpr + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + norm_num + constructor <;> omega + · right + constructor + · simp [Zsqrtd.re_sub, hr] + · simp [Zsqrtd.im_sub] + omega + +private theorem hnotUpAt797 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), ((B (1 : Fin (2 : ℕ))).2 = ⟨(↑P.q₂ : ℤ), (↑P.q₁ : ℤ)⟩) → ((x.re = + (P.q₂ : Int)) → (((P.q₁ : Int) < x.im) → (¬ rootDist 1 (x + ⟨0, 1⟩) < rootDist 1 x))) + ) := by + classical + intro P B rootDist x hb1root hr hlo + have ha : 0 ≤ x.im - (P.q₁ : Int) := by omega + have hab : x.im - (P.q₁ : Int) < x.im + 1 - (P.q₁ : Int) := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + have hn' : rootDist 1 x < rootDist 1 (x + ⟨0, 1⟩) := by + simp only [rootDist, hb1root, Zsqrtd.re_add, Zsqrtd.im_add, hr, + ] + simp only [Int.add_zero, sub_self, Int.natAbs_zero, zero_add] + exact hn + omega + +private theorem hnotRightAt807 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.re = (↑P.q₂ : ℤ) ∧ (↑P.q₁ : ℤ) ≤ + x.im) → ((x.re = (P.q₂ : Int)) → (x + 1 ∉ (P4062T1InteriorSquare P.q).filter (fun z + => (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) + ≤ z.im)))) + ) := by + classical + intro P x harm hr hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.im_add, hr] at hz + · simp [Zsqrtd.re_add] at hz + omega + +private theorem hnotLeftAt817 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.re = (↑P.q₂ : ℤ) ∧ (↑P.q₁ : ℤ) ≤ + x.im) → ((x.re = (P.q₂ : Int)) → (((P.q₁ : Int) < x.im) → (x - 1 ∉ + (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : + Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im))))) + ) := by + classical + intro P x harm hr hlo hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.im_sub, hr] at hz + omega + · simp [Zsqrtd.re_sub] at hz + omega + +private theorem hsetAt828 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), (x - ⟨0, 1⟩ ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.im = + (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im))) → + ((rootDist 1 (x - ⟨0, 1⟩) < rootDist 1 x) → ((¬ rootDist 1 (x + ⟨0, 1⟩) < rootDist 1 + x) → ((x + 1 ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ + z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im))) → ((x - 1 ∉ + (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : + Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im))) → ((({x + 1, x - 1, x + ⟨0, 1⟩, + x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare + P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : + Int) ∧ (P.q₁ : Int) ≤ z.im)) ∧ rootDist 1 y < rootDist 1 x)) = {x - ⟨0, 1⟩}))))) + ) := by + classical + intro P B rootDist x hpred hpredDist hnotUp hnotRight hnotLeft + ext y + simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] + constructor + · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ + · subst y + exact (hnotRight (Finset.mem_filter.mpr hmem)).elim + · subst y + exact (hnotLeft (Finset.mem_filter.mpr hmem)).elim + · subst y + exact (hnotUp hdist).elim + · exact hy + · intro hy + subst y + exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ + +private theorem hpredAt877 : + (by + classical + exact + ∀ (P : FordFareyParameter), ((2 : ℕ) < P.q) → ((0 < P.q₁) → ((P.q = P.q₁ + P.q₂) → ((∀ (q + : Nat), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare q ↔ 1 ≤ z.re ∧ z.re ≤ (q : + Int)-1 ∧ 1 ≤ z.im ∧ z.im ≤ (q : Int)-1) → (∀ (x : GaussianInt), (P.q₁ < P.q₂) → + ((x.re = (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ x.im) → ((x.re = (P.q₂ : Int)) → (((P.q₂ : Int) + < x.im) → ((x.im < (P.q : Int)) → (x - ⟨0, 1⟩ ∈ (P4062T1InteriorSquare P.q).filter + (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ + : Int) ≤ z.re))))))))))) + ) := by + classical + intro P hP hq1pos hsum squareCoordinates x horder' harm hr hlo hhi + apply Finset.mem_filter.mpr + constructor + · apply (squareCoordinates P.q (x - ⟨0, 1⟩)).mpr + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + norm_num + constructor <;> omega + · left + constructor + · simp [Zsqrtd.re_sub, hr] + · simp [Zsqrtd.im_sub] + omega + +private theorem hnotUpAt899 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), ((B (1 : Fin (2 : ℕ))).2 = ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) → ((x.re = + (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ x.im) → ((x.re = (P.q₂ : Int)) → (((P.q₂ : Int) < x.im) → + (¬ rootDist 1 (x + ⟨0, 1⟩) < rootDist 1 x)))) + ) := by + classical + intro P B rootDist x hb1root harm hr hlo + have ha : 0 ≤ x.im - (P.q₂ : Int) := by omega + have hab : x.im - (P.q₂ : Int) < x.im + 1 - (P.q₂ : Int) := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + have hn' : rootDist 1 x < rootDist 1 (x + ⟨0, 1⟩) := by + simp only [rootDist, hb1root, Zsqrtd.re_add, Zsqrtd.im_add, + hr] + simp only [Int.add_zero, sub_self, Int.natAbs_zero, zero_add] + exact hn + omega + +private theorem hnotRightAt909 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.re = (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ + x.im) → ((x.re = (P.q₂ : Int)) → (((P.q₂ : Int) < x.im) → (x + 1 ∉ + (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ + z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))))) + ) := by + classical + intro P x harm hr hlo hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.re_add, hr] at hz + · simp [Zsqrtd.im_add] at hz + omega + +private theorem hnotLeftAt919 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.re = (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ + x.im) → ((x.re = (P.q₂ : Int)) → (((P.q₂ : Int) < x.im) → (x - 1 ∉ + (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ + z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))))) + ) := by + classical + intro P x harm hr hlo hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.re_sub, hr] at hz + · simp [Zsqrtd.im_sub] at hz + omega + +private theorem hsetAt929 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), (x - ⟨0, 1⟩ ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = + (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))) → + ((rootDist 1 (x - ⟨0, 1⟩) < rootDist 1 x) → ((¬ rootDist 1 (x + ⟨0, 1⟩) < rootDist 1 + x) → ((x + 1 ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ + (P.q₂ : Int) ≤ z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))) → ((x - 1 ∉ + (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ + z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))) → ((({x + 1, x - 1, x + ⟨0, 1⟩, + x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare + P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.im) ∨ (z.im = (P.q₂ : + Int) ∧ (P.q₂ : Int) ≤ z.re)) ∧ rootDist 1 y < rootDist 1 x)) = {x - ⟨0, 1⟩}))))) + ) := by + classical + intro P B rootDist x hpred hpredDist hnotUp hnotRight hnotLeft + ext y + simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] + constructor + · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ + · subst y + exact (hnotRight (Finset.mem_filter.mpr hmem)).elim + · subst y + exact (hnotLeft (Finset.mem_filter.mpr hmem)).elim + · subst y + exact (hnotUp hdist).elim + · exact hy + · intro hy + subst y + exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ + +private theorem hpredAt966 : + (by + classical + exact + ∀ (P : FordFareyParameter), ((2 : ℕ) < P.q) → ((0 < P.q₁) → ((P.q = P.q₁ + P.q₂) → ((∀ (q + : Nat), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare q ↔ 1 ≤ z.re ∧ z.re ≤ (q : + Int)-1 ∧ 1 ≤ z.im ∧ z.im ≤ (q : Int)-1) → (∀ (x : GaussianInt), (P.q₁ < P.q₂) → + ((x.im = (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ x.re) → ((x.im = (P.q₂ : Int)) → (((P.q₂ : Int) + < x.re) → ((x.re < (P.q : Int)) → (x - 1 ∈ (P4062T1InteriorSquare P.q).filter (fun + z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : + Int) ≤ z.re))))))))))) + ) := by + classical + intro P hP hq1pos hsum squareCoordinates x horder' harm hr hlo hhi + apply Finset.mem_filter.mpr + constructor + · apply (squareCoordinates P.q (x - 1)).mpr + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + constructor <;> omega + · right + constructor + · simp [Zsqrtd.im_sub, hr] + · simp [Zsqrtd.re_sub, Zsqrtd.re_one] + omega + +private theorem hnotRightAt987 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), ((B (1 : Fin (2 : ℕ))).2 = ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) → ((x.im = + (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ x.re) → ((x.im = (P.q₂ : Int)) → (((P.q₂ : Int) < x.re) → + (¬ rootDist 1 (x + 1) < rootDist 1 x)))) + ) := by + classical + intro P B rootDist x hb1root harm hr hlo + have ha : 0 ≤ x.re - (P.q₂ : Int) := by omega + have hab : x.re - (P.q₂ : Int) < x.re + 1 - (P.q₂ : Int) := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + have hn' : rootDist 1 x < rootDist 1 (x + 1) := by + simp only [rootDist, hb1root, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, hr] + simp only [Int.add_zero, sub_self, Int.natAbs_zero] + exact hn + omega + +private theorem hnotUpAt997 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.im = (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ + x.re) → ((x.im = (P.q₂ : Int)) → (((P.q₂ : Int) < x.re) → (x + ⟨0, 1⟩ ∉ + (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ + z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))))) + ) := by + classical + intro P x harm hr hlo hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.re_add, hr] at hz + omega + · simp [Zsqrtd.im_add] at hz + omega + +private theorem hnotDownAt1008 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.im = (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ + x.re) → ((x.im = (P.q₂ : Int)) → (x - ⟨0, 1⟩ ∉ (P4062T1InteriorSquare P.q).filter + (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ + : Int) ≤ z.re)))) + ) := by + classical + intro P x harm hr hz + simp only [Finset.mem_filter] at hz + rcases hz with ⟨_, hz | hz⟩ + · simp [Zsqrtd.re_sub, hr] at hz + · simp [Zsqrtd.im_sub] at hz + omega + +private theorem hsetAt1018 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + ∀ (x : GaussianInt), (x - 1 ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = + (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))) → + ((rootDist 1 (x - 1) < rootDist 1 x) → ((¬ rootDist 1 (x + 1) < rootDist 1 x) → ((x + + ⟨0, 1⟩ ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ + : Int) ≤ z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))) → ((x - ⟨0, 1⟩ ∉ + (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ + z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))) → ((({x + 1, x - 1, x + ⟨0, 1⟩, + x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare + P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.im) ∨ (z.im = (P.q₂ : + Int) ∧ (P.q₂ : Int) ≤ z.re)) ∧ rootDist 1 y < rootDist 1 x)) = {x - 1}))))) + ) := by + classical + intro P B rootDist x hpred hpredDist hnotRight hnotUp hnotDown + ext y + simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] + constructor + · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ + · subst y + exact (hnotRight hdist).elim + · exact hy + · subst y + exact (hnotUp (Finset.mem_filter.mpr hmem)).elim + · subst y + exact (hnotDown (Finset.mem_filter.mpr hmem)).elim + · intro hy + subst y + exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ + +end LowerNeighborGeometry + +namespace LowerOrderCases + +private theorem firstPathAscendingCount : + (by + classical + exact + ∀ (P : FordFareyParameter), ((0 : ℕ) < P.q₁) → ((P.q = P.q₁ + P.q₂) → ( + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) + (B 0).2 (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + (∀ (q : ℕ), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare q ↔ (1 : ℤ) ≤ z.re ∧ z.re ≤ + (↑q : ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ z.im ∧ z.im ≤ (↑q : ℤ) - (1 : ℤ)) → ( + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + (∀ (j : Fin 2), ∀ (x : GaussianInt), (x ∈ (B j).1) → (((B j).1.filter (fun y => + FourNeighborAdjacent y x ∧ d y < d x)).card = + (({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ (B j).1 ∧ rootDist j y < rootDist j x)).card)) → ((∀ (S : Finset + GaussianInt), ∀ (ρ : GaussianInt → ℕ), ∀ (x : GaussianInt), ρ x = (0 : ℕ) → ({y ∈ + {x + (1 : GaussianInt), x - (1 : GaussianInt), x + ⟨(0 : ℤ), (1 : ℤ)⟩, + x - ⟨(0 : ℤ), (1 : ℤ)⟩} | y ∈ S ∧ ρ y < ρ x} : Finset GaussianInt) = ∅) → (∀ (x : + GaussianInt), (x ∈ (P4062T1RemainderPaths P (0 : Fin (2 : ℕ))).1) → ((x ∈ (B + 0).1) → ((P.q₂ < P.q₁) → (((B (0 : Fin 2)).1.filter (fun y => FourNeighborAdjacent + y x ∧ d y < d x)).card = (if x = (B (0 : Fin 2)).2 then 0 else 1)))))))))) := by + classical + intro P hq1pos hsum B d squareCoordinates rootDist count_eq root_candidate_empty x hx hxB horder + have hb0 : (B 0).1 = (P4062T1InteriorSquare P.q).filter + (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ + (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re)) := by + simp [B, P4062T1RemainderPaths, horder] + have hb0root : (B 0).2 = (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) := by + simp [B, P4062T1RemainderPaths, horder] + have hxOrig := hxB + rw [hb0] at hxB + simp only [Finset.mem_filter] at hxB + rw [count_eq 0 x hxOrig, hb0] + rcases hxB with ⟨hsq, harm | harm⟩ + · by_cases hroot : x = (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) + · subst x + have hzero : rootDist 0 (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) = 0 := by + simp [rootDist, hb0root] + rw [root_candidate_empty _ (rootDist 0) _ hzero] + simp [hb0root] + · have hr : x.re = (P.q₁ : Int) := harm.1 + have hlo : 1 ≤ x.im := (squareCoordinates P.q x).mp hsq |>.2.2.1 + have hhi : x.im < (P.q₂ : Int) := by + have := harm.2 + by_contra hn + have : (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) = x := by + ext <;> simp [hr]; omega + exact hroot this.symm + have hpred := LowerNeighborGeometry.hpredAt281 + P hq1pos hsum squareCoordinates x horder harm hr hlo hhi + have hpredDist := LowerNeighborGeometry.hpredDistAt295 P x hb0root hr hhi + have hnotRight := LowerNeighborGeometry.hnotRightAt305 P x hr hhi + have hnotLeft := LowerNeighborGeometry.hnotLeftAt315 P x hr hhi + have hnotPred := LowerNeighborGeometry.hnotPredAt325 P x hb0root hr hhi + have hset := LowerNeighborGeometry.hsetAt338 P x hpred hpredDist hnotRight hnotLeft + hnotPred + rw [hset] + simp [hb0root, hroot] + · by_cases hroot : x = (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) + · subst x + have hzero : rootDist 0 (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) = 0 := by + simp [rootDist, hb0root] + rw [root_candidate_empty _ (rootDist 0) _ hzero] + simp [hb0root] + · have hr : x.im = (P.q₂ : Int) := harm.1 + have hlo : (P.q₁ : Int) ≤ x.re := harm.2 + have hhi : x.re < (P.q : Int) := by + have hsquare := (squareCoordinates P.q x).mp hsq + omega + have hgt : (P.q₁ : Int) < x.re := by + by_contra hn + have : x = (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) := by + ext <;> simp [hr]; omega + exact hroot this + have hpred := LowerNeighborGeometry.hpredAt376 + P hq1pos hsum squareCoordinates x harm hr hhi hgt + have hpredDist : rootDist 0 (x - 1) < rootDist 0 x := by + have ha : 0 ≤ x.re - 1 - (P.q₁ : Int) := by omega + have hab : x.re - 1 - (P.q₁ : Int) < x.re - (P.q₁ : Int) := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + simp only [rootDist, hb0root, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_one, Zsqrtd.im_one, hr] + simp only [Int.sub_zero, sub_self, Int.natAbs_zero] + exact hn + have hnotRight := LowerNeighborGeometry.hnotRightAt398 P x hb0root hr hgt + have hnotUp := LowerNeighborGeometry.hnotUpAt409 P x hr hgt + have hnotDown := LowerNeighborGeometry.hnotDownAt419 P x hr hgt + have hset := LowerNeighborGeometry.hsetAt429 P + x hpred hpredDist hnotRight hnotUp hnotDown + rw [hset] + simp [hb0root, hroot] + +private theorem firstPathDescendingCount : + (by + classical + exact + ∀ (P : FordFareyParameter), ((0 : ℕ) < P.q₁) → ((P.q = P.q₁ + P.q₂) → ((P.q₁ ≠ P.q₂) → ( + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) + (B 0).2 (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + (∀ (q : ℕ), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare q ↔ (1 : ℤ) ≤ z.re ∧ z.re ≤ + (↑q : ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ z.im ∧ z.im ≤ (↑q : ℤ) - (1 : ℤ)) → ( + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + (∀ (j : Fin 2), ∀ (x : GaussianInt), (x ∈ (B j).1) → (((B j).1.filter (fun y => + FourNeighborAdjacent y x ∧ d y < d x)).card = + (({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ (B j).1 ∧ rootDist j y < rootDist j x)).card)) → ((∀ (S : Finset + GaussianInt), ∀ (ρ : GaussianInt → ℕ), ∀ (x : GaussianInt), ρ x = (0 : ℕ) → ({y ∈ + {x + (1 : GaussianInt), x - (1 : GaussianInt), x + ⟨(0 : ℤ), (1 : ℤ)⟩, + x - ⟨(0 : ℤ), (1 : ℤ)⟩} | y ∈ S ∧ ρ y < ρ x} : Finset GaussianInt) = ∅) → (∀ (x : + GaussianInt), (x ∈ (P4062T1RemainderPaths P (0 : Fin (2 : ℕ))).1) → ((x ∈ (B + 0).1) → ((¬P.q₂ < P.q₁) → (((B (0 : Fin 2)).1.filter (fun y => FourNeighborAdjacent + y x ∧ d y < d x)).card = (if x = (B (0 : Fin 2)).2 then 0 else 1))))))))))) := by + classical + intro P hq1pos hsum hneq B d squareCoordinates rootDist count_eq root_candidate_empty x hx hxB + horder + have horder' : P.q₁ < P.q₂ := by omega + have hb0 : (B 0).1 = (P4062T1InteriorSquare P.q).filter + (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int)) ∨ + (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int))) := by + simp [B, P4062T1RemainderPaths, horder] + have hb0root : (B 0).2 = (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) := by + simp [B, P4062T1RemainderPaths, horder] + have hxOrig := hxB + rw [hb0] at hxB + simp only [Finset.mem_filter] at hxB + rw [count_eq 0 x hxOrig, hb0] + rcases hxB with ⟨hsq, harm | harm⟩ + · by_cases hroot : x = (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) + · subst x + have hzero : rootDist 0 (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) = 0 := by + simp [rootDist, hb0root] + rw [root_candidate_empty _ (rootDist 0) _ hzero] + simp [hb0root] + · have hr : x.re = (P.q₁ : Int) := harm.1 + have hlo : 1 ≤ x.im := (squareCoordinates P.q x).mp hsq |>.2.2.1 + have hhi : x.im < (P.q₁ : Int) := by + by_contra hn + have : (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) = x := by + ext <;> simp [hr]; omega + exact hroot this.symm + have hpred := LowerNeighborGeometry.hpredAt476 + P hq1pos hsum squareCoordinates x horder' harm hr hlo hhi + have hpredDist := LowerNeighborGeometry.hpredDistAt490 P x hb0root harm hr hhi + have hnotRight := LowerNeighborGeometry.hnotRightAt501 P x harm hr hhi + have hnotLeft := LowerNeighborGeometry.hnotLeftAt511 P x harm hr hhi + have hnotPred := LowerNeighborGeometry.hnotPredAt521 P x hb0root harm hr hhi + have hset := LowerNeighborGeometry.hsetAt535 P x hpred hpredDist hnotRight hnotLeft + hnotPred + rw [hset] + simp [hb0root, hroot] + · by_cases hroot : x = (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) + · subst x + have hzero : rootDist 0 (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) = 0 := by + simp [rootDist, hb0root] + rw [root_candidate_empty _ (rootDist 0) _ hzero] + simp [hb0root] + · have hr : x.im = (P.q₁ : Int) := harm.1 + have hlo : 1 ≤ x.re := (squareCoordinates P.q x).mp hsq |>.1 + have hhi : x.re < (P.q₁ : Int) := by + by_contra hn + have : x = (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) := by + ext <;> simp [hr]; omega + exact hroot this + have hpred := LowerNeighborGeometry.hpredAt570 + P hq1pos hsum squareCoordinates x horder' harm hr hlo hhi + have hpredDist := LowerNeighborGeometry.hpredDistAt583 P x hb0root harm hr hhi + have hnotLeft := LowerNeighborGeometry.hnotLeftAt594 P x hb0root harm hr hhi + have hnotUp := LowerNeighborGeometry.hnotUpAt608 P x harm hr hhi + have hnotDown := LowerNeighborGeometry.hnotDownAt618 P x harm hr hhi + have hset := LowerNeighborGeometry.hsetAt628 P + x hpred hpredDist hnotLeft hnotUp hnotDown + rw [hset] + simp [hb0root, hroot] + +private theorem secondPathAscendingCount : + (by + classical + exact + ∀ (P : FordFareyParameter), ((0 : ℕ) < P.q₁) → ((P.q = P.q₁ + P.q₂) → ( + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) + (B 0).2 (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + (∀ (q : ℕ), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare q ↔ (1 : ℤ) ≤ z.re ∧ z.re ≤ + (↑q : ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ z.im ∧ z.im ≤ (↑q : ℤ) - (1 : ℤ)) → ( + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + (∀ (j : Fin 2), ∀ (x : GaussianInt), (x ∈ (B j).1) → (((B j).1.filter (fun y => + FourNeighborAdjacent y x ∧ d y < d x)).card = + (({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ (B j).1 ∧ rootDist j y < rootDist j x)).card)) → ((∀ (S : Finset + GaussianInt), ∀ (ρ : GaussianInt → ℕ), ∀ (x : GaussianInt), ρ x = (0 : ℕ) → ({y ∈ + {x + (1 : GaussianInt), x - (1 : GaussianInt), x + ⟨(0 : ℤ), (1 : ℤ)⟩, + x - ⟨(0 : ℤ), (1 : ℤ)⟩} | y ∈ S ∧ ρ y < ρ x} : Finset GaussianInt) = ∅) → (∀ (x : + GaussianInt), (x ∈ (P4062T1RemainderPaths P (1 : Fin (2 : ℕ))).1) → ((x ∈ (B + 1).1) → ((P.q₂ < P.q₁) → (((B (1 : Fin 2)).1.filter (fun y => FourNeighborAdjacent + y x ∧ d y < d x)).card = (if x = (B (1 : Fin 2)).2 then 0 else 1)))))))))) := by + classical + intro P hq1pos hsum B d squareCoordinates rootDist count_eq root_candidate_empty x hx hxB horder + have hb1 : (B 1).1 = (P4062T1InteriorSquare P.q).filter + (fun z => (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : Int)) ∨ + (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im)) := by + simp [B, P4062T1RemainderPaths, horder] + have hb1root : (B 1).2 = (⟨(P.q₂ : Int), (P.q₁ : Int)⟩ : GaussianInt) := by + simp [B, P4062T1RemainderPaths, horder] + have hxOrig := hxB + rw [hb1] at hxB + simp only [Finset.mem_filter] at hxB + rw [count_eq 1 x hxOrig, hb1] + rcases hxB with ⟨hsq, harm | harm⟩ + · by_cases hroot : x = (⟨(P.q₂ : Int), (P.q₁ : Int)⟩ : GaussianInt) + · subst x + have hzero : rootDist 1 (⟨(P.q₂ : Int), (P.q₁ : Int)⟩ : GaussianInt) = 0 := by + simp [rootDist, hb1root] + rw [root_candidate_empty _ (rootDist 1) _ hzero] + simp [hb1root] + · have hr : x.im = (P.q₁ : Int) := harm.1 + have hlo : 1 ≤ x.re := (squareCoordinates P.q x).mp hsq |>.1 + have hhi : x.re < (P.q₂ : Int) := by + by_contra hn + have : x = (⟨(P.q₂ : Int), (P.q₁ : Int)⟩ : GaussianInt) := by + ext <;> simp [hr]; omega + exact hroot this + have hpred := LowerNeighborGeometry.hpredAt680 + P hq1pos hsum squareCoordinates x horder harm hr hlo hhi + have hpredDist := LowerNeighborGeometry.hpredDistAt693 P x hb1root hr hhi + have hnotLeft := LowerNeighborGeometry.hnotLeftAt704 P x hb1root hr hhi + have hnotUp := LowerNeighborGeometry.hnotUpAt718 P x hr hhi + have hnotDown := LowerNeighborGeometry.hnotDownAt728 P x hr hhi + have hset := LowerNeighborGeometry.hsetAt738 P + x hpred hpredDist hnotLeft hnotUp hnotDown + rw [hset] + simp [hb1root, hroot] + · by_cases hroot : x = (⟨(P.q₂ : Int), (P.q₁ : Int)⟩ : GaussianInt) + · subst x + have hzero : rootDist 1 (⟨(P.q₂ : Int), (P.q₁ : Int)⟩ : GaussianInt) = 0 := by + simp [rootDist, hb1root] + rw [root_candidate_empty _ (rootDist 1) _ hzero] + simp [hb1root] + · have hr : x.re = (P.q₂ : Int) := harm.1 + have hlo : (P.q₁ : Int) < x.im := by + by_contra hn + have : x = (⟨(P.q₂ : Int), (P.q₁ : Int)⟩ : GaussianInt) := by + ext <;> simp [hr]; omega + exact hroot this + have hhi : x.im < (P.q : Int) := by + have hsquare := (squareCoordinates P.q x).mp hsq + omega + have hpred := LowerNeighborGeometry.hpredAt775 + P hq1pos hsum squareCoordinates x harm hr hlo hhi + have hpredDist : rootDist 1 (x - ⟨0, 1⟩) < rootDist 1 x := by + have ha : 0 ≤ x.im - 1 - (P.q₁ : Int) := by omega + have hab : x.im - 1 - (P.q₁ : Int) < x.im - (P.q₁ : Int) := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + simp only [rootDist, hb1root, Zsqrtd.re_sub, Zsqrtd.im_sub, hr, + ] + simp only [Int.sub_zero, sub_self, Int.natAbs_zero, zero_add] + exact hn + have hnotUp := LowerNeighborGeometry.hnotUpAt797 P x hb1root hr hlo + have hnotRight := LowerNeighborGeometry.hnotRightAt807 P x harm hr + have hnotLeft := LowerNeighborGeometry.hnotLeftAt817 P x harm hr hlo + have hset := LowerNeighborGeometry.hsetAt828 P x hpred hpredDist hnotUp hnotRight + hnotLeft + rw [hset] + simp [hb1root, hroot] + +private theorem secondPathDescendingCount : + (by + classical + exact + ∀ (P : FordFareyParameter), ((2 : ℕ) < P.q) → (((0 : ℕ) < P.q₁) → ((P.q = P.q₁ + P.q₂) → + ((P.q₁ ≠ P.q₂) → ( + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) + (B 0).2 (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + (∀ (q : ℕ), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare q ↔ (1 : ℤ) ≤ z.re ∧ z.re ≤ + (↑q : ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ z.im ∧ z.im ≤ (↑q : ℤ) - (1 : ℤ)) → ( + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + (∀ (j : Fin 2), ∀ (x : GaussianInt), (x ∈ (B j).1) → (((B j).1.filter (fun y => + FourNeighborAdjacent y x ∧ d y < d x)).card = + (({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ (B j).1 ∧ rootDist j y < rootDist j x)).card)) → ((∀ (S : Finset + GaussianInt), ∀ (ρ : GaussianInt → ℕ), ∀ (x : GaussianInt), ρ x = (0 : ℕ) → ({y ∈ + {x + (1 : GaussianInt), x - (1 : GaussianInt), x + ⟨(0 : ℤ), (1 : ℤ)⟩, + x - ⟨(0 : ℤ), (1 : ℤ)⟩} | y ∈ S ∧ ρ y < ρ x} : Finset GaussianInt) = ∅) → (∀ (x : + GaussianInt), (x ∈ (P4062T1RemainderPaths P (1 : Fin (2 : ℕ))).1) → ((x ∈ (B + 1).1) → ((¬P.q₂ < P.q₁) → (((B (1 : Fin 2)).1.filter (fun y => FourNeighborAdjacent + y x ∧ d y < d x)).card = (if x = (B (1 : Fin 2)).2 then 0 else 1)))))))))))) := by + classical + intro P hP hq1pos hsum hneq B d squareCoordinates rootDist count_eq root_candidate_empty x hx + hxB horder + have horder' : P.q₁ < P.q₂ := by omega + have hb1 : (B 1).1 = (P4062T1InteriorSquare P.q).filter + (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.im) ∨ + (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re)) := by + simp [B, P4062T1RemainderPaths, horder] + have hb1root : (B 1).2 = (⟨(P.q₂ : Int), (P.q₂ : Int)⟩ : GaussianInt) := by + simp [B, P4062T1RemainderPaths, horder] + have hxOrig := hxB + rw [hb1] at hxB + simp only [Finset.mem_filter] at hxB + rw [count_eq 1 x hxOrig, hb1] + rcases hxB with ⟨hsq, harm | harm⟩ + · by_cases hroot : x = (⟨(P.q₂ : Int), (P.q₂ : Int)⟩ : GaussianInt) + · subst x + have hzero : rootDist 1 (⟨(P.q₂ : Int), (P.q₂ : Int)⟩ : GaussianInt) = 0 := by + simp [rootDist, hb1root] + rw [root_candidate_empty _ (rootDist 1) _ hzero] + simp [hb1root] + · have hr : x.re = (P.q₂ : Int) := harm.1 + have hlo : (P.q₂ : Int) < x.im := by + by_contra hn + have : x = (⟨(P.q₂ : Int), (P.q₂ : Int)⟩ : GaussianInt) := by + ext <;> simp [hr]; omega + exact hroot this + have hhi : x.im < (P.q : Int) := by + have hsquare := (squareCoordinates P.q x).mp hsq + omega + have hpred := LowerNeighborGeometry.hpredAt877 + P hP hq1pos hsum squareCoordinates x horder' harm hr hlo hhi + have hpredDist : rootDist 1 (x - ⟨0, 1⟩) < rootDist 1 x := by + have ha : 0 ≤ x.im - 1 - (P.q₂ : Int) := by omega + have hab : x.im - 1 - (P.q₂ : Int) < x.im - (P.q₂ : Int) := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + simp only [rootDist, hb1root, Zsqrtd.re_sub, Zsqrtd.im_sub, + hr] + simp only [Int.sub_zero, sub_self, Int.natAbs_zero, zero_add] + exact hn + have hnotUp := LowerNeighborGeometry.hnotUpAt899 P x hb1root harm hr hlo + have hnotRight := LowerNeighborGeometry.hnotRightAt909 P x harm hr hlo + have hnotLeft := LowerNeighborGeometry.hnotLeftAt919 P x harm hr hlo + have hset := LowerNeighborGeometry.hsetAt929 P x hpred hpredDist hnotUp hnotRight + hnotLeft + rw [hset] + simp [hb1root, hroot] + · by_cases hroot : x = (⟨(P.q₂ : Int), (P.q₂ : Int)⟩ : GaussianInt) + · subst x + have hzero : rootDist 1 (⟨(P.q₂ : Int), (P.q₂ : Int)⟩ : GaussianInt) = 0 := by + simp [rootDist, hb1root] + rw [root_candidate_empty _ (rootDist 1) _ hzero] + simp [hb1root] + · have hr : x.im = (P.q₂ : Int) := harm.1 + have hlo : (P.q₂ : Int) < x.re := by + by_contra hn + have : x = (⟨(P.q₂ : Int), (P.q₂ : Int)⟩ : GaussianInt) := by + ext <;> simp [hr]; omega + exact hroot this + have hhi : x.re < (P.q : Int) := by + have hsquare := (squareCoordinates P.q x).mp hsq + omega + have hpred := LowerNeighborGeometry.hpredAt966 + P hP hq1pos hsum squareCoordinates x horder' harm hr hlo hhi + have hpredDist : rootDist 1 (x - 1) < rootDist 1 x := by + have ha : 0 ≤ x.re - 1 - (P.q₂ : Int) := by omega + have hab : x.re - 1 - (P.q₂ : Int) < x.re - (P.q₂ : Int) := by omega + have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab + simp only [rootDist, hb1root, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_one, Zsqrtd.im_one, hr] + simp only [Int.sub_zero, sub_self, Int.natAbs_zero] + exact hn + have hnotRight := LowerNeighborGeometry.hnotRightAt987 P x hb1root harm hr hlo + have hnotUp := LowerNeighborGeometry.hnotUpAt997 P x harm hr hlo + have hnotDown := LowerNeighborGeometry.hnotDownAt1008 P x harm hr + have hset := LowerNeighborGeometry.hsetAt1018 P + x hpred hpredDist hnotRight hnotUp hnotDown + rw [hset] + simp [hb1root, hroot] + +end LowerOrderCases + +theorem P4112T1LowerNeighbors (P : FordFareyParameter) (hP : 2 < P.q) : + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) + (B 0).2 (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + ∀ j, ∀ x ∈ (B j).1, + (@Finset.filter GaussianInt (fun y => FourNeighborAdjacent y x ∧ d y < d x) + (fun _ => Classical.propDecidable _) (B j).1).card = + (if x = (B j).2 then 0 else 1) := by +-- BODY + classical + have hgeom := P4112T1PathGeometry P hP + have hq1pos := LowerNeighborGeometry.hq1pos P hP + have hcross : P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 := by + have h1 : P.p₁ * ((P.q₁ + P.q₂ : Nat) : Int) - + (P.q₁ : Int) * (P.p₁ + P.p₂) = 1 := by + simpa [P.sum_q, P.sum_p] using P.det₁ + norm_num [Nat.cast_add] at h1 + nlinarith [h1] + have hsum : P.q = P.q₁ + P.q₂ := P.sum_q + have hsumInt : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by + exact_mod_cast hsum + have hneq := LowerNeighborGeometry.hneq P hP hq1pos hcross hsum + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) + (B 0).2 (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + simp only [] + change ∀ j, ∀ x ∈ (B j).1, + ((B j).1.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = + (if x = (B j).2 then 0 else 1) + have squareCoordinates (q : Nat) (z : GaussianInt) := LowerNeighborGeometry.squareCoordinates q z + have natAbs_form (z : Int) := LowerNeighborGeometry.natAbs_form P z + have d_on_path (j : Fin 2) (z : GaussianInt) (hz : z ∈ (B j).1) := + LowerNeighborGeometry.d_on_path P hP j z hz + have neighbor_filter (S : Finset GaussianInt) (x : GaussianInt) + (ρ : GaussianInt → Nat) := LowerNeighborGeometry.neighbor_filter S x ρ + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs + have count_eq (j : Fin 2) (x : GaussianInt) (hx : x ∈ (B j).1) := + LowerNeighborGeometry.count_eq P d_on_path neighbor_filter j x hx + have root_candidate_empty (S : Finset GaussianInt) (ρ : GaussianInt → Nat) + (x : GaussianInt) (hz : ρ x = 0) := LowerNeighborGeometry.root_candidate_empty P S ρ x hz + intro j + fin_cases j + · intro x hx + change ((B 0).1.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = + (if x = (B 0).2 then 0 else 1) at ⊢ + change x ∈ (P4062T1RemainderPaths P 0).1 at hx + have hxB : x ∈ (B 0).1 := hx + by_cases horder : P.q₂ < P.q₁ + · have firstPathAscendingCount : + ((B (0 : Fin 2)).1.filter + (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = + (if x = (B (0 : Fin 2)).2 then 0 else 1) := LowerOrderCases.firstPathAscendingCount P + hq1pos hsum squareCoordinates count_eq root_candidate_empty x hx hxB horder + exact firstPathAscendingCount + · have firstPathDescendingCount : + ((B (0 : Fin 2)).1.filter + (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = + (if x = (B (0 : Fin 2)).2 then 0 else 1) := LowerOrderCases.firstPathDescendingCount P + hq1pos hsum hneq squareCoordinates count_eq root_candidate_empty x hx hxB horder + exact firstPathDescendingCount + · intro x hx + change ((B 1).1.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = + (if x = (B 1).2 then 0 else 1) at ⊢ + change x ∈ (P4062T1RemainderPaths P 1).1 at hx + have hxB : x ∈ (B 1).1 := hx + by_cases horder : P.q₂ < P.q₁ + · have secondPathAscendingCount : + ((B (1 : Fin 2)).1.filter + (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = + (if x = (B (1 : Fin 2)).2 then 0 else 1) := LowerOrderCases.secondPathAscendingCount P + hq1pos hsum squareCoordinates count_eq root_candidate_empty x hx hxB horder + exact secondPathAscendingCount + · have secondPathDescendingCount : + ((B (1 : Fin 2)).1.filter + (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = + (if x = (B (1 : Fin 2)).2 then 0 else 1) := LowerOrderCases.secondPathDescendingCount P + hP hq1pos hsum hneq squareCoordinates count_eq root_candidate_empty x hx hxB horder + exact secondPathDescendingCount +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean new file mode 100644 index 0000000000..64ea5cd4f5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean @@ -0,0 +1,976 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderPaths +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent + +/-! +# P4112T1ParentalNeighbors + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- Classical decidability for four-neighbor adjacency on the Gaussian integer lattice. -/ +@[instance_reducible] noncomputable def fourNeighborDecidability + (x y : GaussianInt) : Decidable (FourNeighborAdjacent x y) := by + classical + infer_instance + +attribute [local instance] fourNeighborDecidability + + +-- [TABLET NODE: P4112T1ParentalNeighbors] +namespace ParentalNeighborLemmas + +private theorem adjacent_comm : + ∀ (x : GaussianInt), ∀ (y : GaussianInt), FourNeighborAdjacent x y ↔ FourNeighborAdjacent y x + := by + classical + intro x y + constructor + · intro h + rcases h with h | h | h | h <;> subst y <;> simp [FourNeighborAdjacent] + · intro h + rcases h with h | h | h | h <;> subst x <;> simp [FourNeighborAdjacent] + +private theorem neighbor_filter : + (∀ (x : GaussianInt), ∀ (y : GaussianInt), FourNeighborAdjacent x y ↔ FourNeighborAdjacent y + x) → (∀ (S : Finset GaussianInt), ∀ (x : GaussianInt), S.filter (fun y => + FourNeighborAdjacent y x) = + ({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ S)) := by + classical + intro adjacent_comm S x + ext y + rw [Finset.mem_filter, Finset.mem_filter] + rw [Finset.mem_insert, Finset.mem_insert, Finset.mem_insert, Finset.mem_singleton] + rw [adjacent_comm y x] + unfold FourNeighborAdjacent + tauto + +private theorem q1pos : + ∀ (P : FordFareyParameter), (2 < P.q) → (0 < P.q₁) := by + classical + intro P hP + by_contra hz + have hz : P.q₁ = 0 := by omega + have hd := P.det₁ + rw [hz] at hd + simp only [Nat.cast_zero, zero_mul] at hd + have hqint : 2 < (P.q : Int) := by exact_mod_cast hP + by_cases hp : P.p₁ ≤ 0 + · have hqnonneg : 0 ≤ (P.q : Int) := by omega + have : P.p₁ * (P.q : Int) ≤ 0 := mul_nonpos_of_nonpos_of_nonneg hp hqnonneg + omega + · have hp' : 1 ≤ P.p₁ := by omega + nlinarith + +private theorem q2posI : + ∀ (P : FordFareyParameter), 0 < (P.q₂ : Int) := by + classical + intro P + exact_mod_cast P.q₂_pos + +private theorem cross : + ∀ (P : FordFareyParameter), P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 := by + classical + intro P + have h1 : P.p₁ * ((P.q₁ + P.q₂ : Nat) : Int) - + (P.q₁ : Int) * (P.p₁ + P.p₂) = 1 := by + simpa [P.sum_q, P.sum_p] using P.det₁ + norm_num [Nat.cast_add] at h1 + nlinarith [h1] + +private theorem hsumN : + ∀ (P : FordFareyParameter), P.q = P.q₁ + P.q₂ := by + classical + intro P + exact P.sum_q + +private theorem unequal : + ∀ (P : FordFareyParameter), (2 < P.q) → ((0 < (P.q₂ : Int)) → ((P.p₁ * (P.q₂ : Int) - (P.q₁ : + Int) * P.p₂ = 1) → ((P.q = P.q₁ + P.q₂) → (P.q₁ ≠ P.q₂)))) := by + classical + intro P hP q2posI cross hsumN heq + have hm : (P.q₁ : Int) * (P.p₁ - P.p₂) = 1 := by + have hc := cross + rw [heq] at hc + nlinarith [hc] + have hd : (P.q₁ : Int) ∣ 1 := ⟨P.p₁ - P.p₂, hm.symm⟩ + have hu : (P.q₁ : Int) = 1 := + Int.eq_one_of_dvd_one (by exact_mod_cast (Nat.zero_le P.q₁)) hd + have hq1 : P.q₁ = 1 := by exact_mod_cast hu + have hq2 : P.q₂ = 1 := by omega + have hq : P.q = 2 := by omega + have hqgt : 2 < P.q := by exact_mod_cast hP + omega + +private theorem hsum : + ∀ (P : FordFareyParameter), (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by + classical + intro P + exact_mod_cast P.sum_q + +private theorem squareCoordinates : + ∀ (n : Nat), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare n ↔ + 1 ≤ z.re ∧ z.re ≤ (n : Int) - 1 ∧ + 1 ≤ z.im ∧ z.im ≤ (n : Int) - 1 := by + classical + intro n z + unfold P4062T1InteriorSquare + constructor + · intro hz + obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hz + obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab + exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, + (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ + · intro hz + exact Finset.mem_image.mpr ⟨(z.re, z.im), + Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨hz.1, hz.2.1⟩, + Finset.mem_Icc.mpr hz.2.2⟩, by cases z; rfl⟩ + +private theorem mem0 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (∀ (n : Nat), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare n ↔ 1 ≤ z.re ∧ z.re ≤ (n : + Int) - 1 ∧ 1 ≤ z.im ∧ z.im ≤ (n : Int) - 1) → (∀ (z : GaussianInt), z ∈ A 0 ↔ + 1 ≤ z.re ∧ z.re ≤ (P.q₁ : Int)-1 ∧ + 1 ≤ z.im ∧ z.im ≤ (P.q₁ : Int)-1) := by + classical + intro P A squareCoordinates z + simpa [A, P4062T1RecursiveInteriors] using (squareCoordinates P.q₁ z) + +private theorem mem1 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (P.q = P.q₁ + P.q₂) → ((∀ (n : Nat), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare n ↔ 1 ≤ + z.re ∧ z.re ≤ (n : Int) - 1 ∧ 1 ≤ z.im ∧ z.im ≤ (n : Int) - 1) → (∀ (z : GaussianInt), z + ∈ A 1 ↔ + (P.q₂ : Int)+1 ≤ z.re ∧ z.re ≤ (P.q : Int)-1 ∧ + (P.q₂ : Int)+1 ≤ z.im ∧ z.im ≤ (P.q : Int)-1)) := by + classical + intro P A hsumN squareCoordinates z + dsimp [A, P4062T1RecursiveInteriors] + constructor + · intro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + have hb := (squareCoordinates P.q₁ w).mp hw + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at * + constructor <;> omega + · intro hz + apply Finset.mem_image.mpr + refine ⟨z - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩, ?_, ?_⟩ + · apply (squareCoordinates P.q₁ _).mpr + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + constructor <;> omega + · ext <;> simp [] + +private theorem mem2 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (P.q = P.q₁ + P.q₂) → ((∀ (n : Nat), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare n ↔ 1 ≤ + z.re ∧ z.re ≤ (n : Int) - 1 ∧ 1 ≤ z.im ∧ z.im ≤ (n : Int) - 1) → (∀ (z : GaussianInt), z + ∈ A 2 ↔ + (P.q₁ : Int)+1 ≤ z.re ∧ z.re ≤ (P.q : Int)-1 ∧ + 1 ≤ z.im ∧ z.im ≤ (P.q₂ : Int)-1)) := by + classical + intro P A hsumN squareCoordinates z + dsimp [A, P4062T1RecursiveInteriors] + constructor + · intro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + have hb := (squareCoordinates P.q₂ w).mp hw + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at * + constructor <;> omega + · intro hz + apply Finset.mem_image.mpr + refine ⟨z - ⟨(P.q₁ : Int), 0⟩, ?_, ?_⟩ + · apply (squareCoordinates P.q₂ _).mpr + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + constructor <;> omega + · ext <;> simp [] + +private theorem mem3 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + (P.q = P.q₁ + P.q₂) → ((∀ (n : Nat), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare n ↔ 1 ≤ + z.re ∧ z.re ≤ (n : Int) - 1 ∧ 1 ≤ z.im ∧ z.im ≤ (n : Int) - 1) → (∀ (z : GaussianInt), z + ∈ A 3 ↔ + 1 ≤ z.re ∧ z.re ≤ (P.q₂ : Int)-1 ∧ + (P.q₁ : Int)+1 ≤ z.im ∧ z.im ≤ (P.q : Int)-1)) := by + classical + intro P A hsumN squareCoordinates z + dsimp [A, P4062T1RecursiveInteriors] + constructor + · intro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + have hb := (squareCoordinates P.q₂ w).mp hw + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at * + constructor <;> omega + · intro hz + apply Finset.mem_image.mpr + refine ⟨z - ⟨0, (P.q₁ : Int)⟩, ?_, ?_⟩ + · apply (squareCoordinates P.q₂ _).mpr + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + constructor <;> omega + · ext <;> simp [] + +private theorem hmem : + ∀ (P : FordFareyParameter), (2 < P.q) → ( + let A := P4062T1RecursiveInteriors P + let E := (A 0 ∪ A 1) ∪ (A 2 ∪ A 3) + (0 < P.q₁) → ((0 < (P.q₂ : Int)) → ((P.q = P.q₁ + P.q₂) → ((∀ (z : GaussianInt), z ∈ A 0 ↔ 1 + ≤ z.re ∧ z.re ≤ (P.q₁ : Int)-1 ∧ 1 ≤ z.im ∧ z.im ≤ (P.q₁ : Int)-1) → ((∀ (z : + GaussianInt), z ∈ A 1 ↔ (P.q₂ : Int)+1 ≤ z.re ∧ z.re ≤ (P.q : Int)-1 ∧ (P.q₂ : Int)+1 ≤ + z.im ∧ z.im ≤ (P.q : Int)-1) → ((∀ (z : GaussianInt), z ∈ A 2 ↔ (P.q₁ : Int)+1 ≤ z.re ∧ + z.re ≤ (P.q : Int)-1 ∧ 1 ≤ z.im ∧ z.im ≤ (P.q₂ : Int)-1) → ((∀ (z : GaussianInt), z ∈ A 3 + ↔ 1 ≤ z.re ∧ z.re ≤ (P.q₂ : Int)-1 ∧ (P.q₁ : Int)+1 ≤ z.im ∧ z.im ≤ (P.q : Int)-1) → (∀ + (a : Int), ∀ (b : Int), (⟨a, b⟩ : GaussianInt) ∈ E ↔ + (1 ≤ a ∧ a < P.q₁ ∧ 1 ≤ b ∧ b < P.q₁) ∨ + (P.q₂ < a ∧ a < P.q ∧ P.q₂ < b ∧ b < P.q) ∨ + (P.q₁ < a ∧ a < P.q ∧ 1 ≤ b ∧ b < P.q₂) ∨ + (1 ≤ a ∧ a < P.q₂ ∧ P.q₁ < b ∧ b < P.q))))))))) := by + classical + intro P hP A E q1pos q2posI hsumN mem0 mem1 mem2 mem3 a b + dsimp [E] + simp only [Finset.mem_union, mem0, mem1, mem2, mem3] + constructor <;> intro hz <;> omega + +private theorem transpose_involutive : + let transpose (z : GaussianInt) : GaussianInt := ⟨z.im, z.re⟩ + ∀ (z : GaussianInt), transpose (transpose z) = z := by + classical + intro transpose z + cases z + rfl + +private theorem transpose_mem : + ∀ (P : FordFareyParameter), (2 < P.q) → ( + let A := P4062T1RecursiveInteriors P + let E := (A 0 ∪ A 1) ∪ (A 2 ∪ A 3) + (0 < P.q₁) → ((0 < (P.q₂ : Int)) → ((P.q = P.q₁ + P.q₂) → ((∀ (a : Int), ∀ (b : Int), (⟨a, b⟩ + : GaussianInt) ∈ E ↔ (1 ≤ a ∧ a < P.q₁ ∧ 1 ≤ b ∧ b < P.q₁) ∨ (P.q₂ < a ∧ a < P.q ∧ P.q₂ < + b ∧ b < P.q) ∨ (P.q₁ < a ∧ a < P.q ∧ 1 ≤ b ∧ b < P.q₂) ∨ (1 ≤ a ∧ a < P.q₂ ∧ P.q₁ < b ∧ b + < P.q)) → ( + let transpose (z : GaussianInt) : GaussianInt := ⟨z.im, z.re⟩ + ∀ (z : GaussianInt), z ∈ E ↔ transpose z ∈ E))))) := by + classical + intro P hP A E q1pos q2posI hsumN hmem transpose z + cases z with + | mk a b => + dsimp [transpose] + simp only [hmem] + constructor <;> intro hz <;> omega + +private theorem transpose_candidate : + (FordFareyParameter) → ( + let candidate (z : GaussianInt) : Finset GaussianInt := + {z + 1, z - 1, z + ⟨0, 1⟩, z - ⟨0, 1⟩} + let transpose (z : GaussianInt) : GaussianInt := ⟨z.im, z.re⟩ + ∀ (x : GaussianInt), ∀ (z : GaussianInt), z ∈ candidate x ↔ transpose z ∈ candidate + (transpose x)) := by + classical + intro P candidate transpose x z + cases x with + | mk a b => + cases z with + | mk c d => + simp [candidate, transpose, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, + Zsqrtd.ext_iff] + omega + +private theorem transpose_filter_card : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + let E := (A 0 ∪ A 1) ∪ (A 2 ∪ A 3) + let candidate (z : GaussianInt) : Finset GaussianInt := + {z + 1, z - 1, z + ⟨0, 1⟩, z - ⟨0, 1⟩} + let transpose (z : GaussianInt) : GaussianInt := ⟨z.im, z.re⟩ + (∀ (z : GaussianInt), transpose (transpose z) = z) → ((∀ (z : GaussianInt), z ∈ E ↔ transpose + z ∈ E) → ((∀ (x : GaussianInt), ∀ (z : GaussianInt), z ∈ candidate x ↔ transpose z ∈ + candidate (transpose x)) → (∀ (x : GaussianInt), (Finset.filter (fun z => z ∈ E) + (candidate x)).card = + (Finset.filter (fun z => z ∈ E) (candidate (transpose x))).card))) := by + classical + intro P A E candidate transpose transpose_involutive transpose_mem transpose_candidate x + apply Finset.card_bij (fun z hz => transpose z) + · intro z hz + rcases Finset.mem_filter.mp hz with ⟨hzC, hzE⟩ + exact Finset.mem_filter.mpr + ⟨(transpose_candidate x z).mp hzC, (transpose_mem z).mp hzE⟩ + · intro z hz w hw h + have := congrArg transpose h + simpa [transpose_involutive] using this + · intro z hz + rcases Finset.mem_filter.mp hz with ⟨hzC, hzE⟩ + refine ⟨transpose z, Finset.mem_filter.mpr ⟨?_, ?_⟩, ?_⟩ + · exact (transpose_candidate (transpose x) z).mp hzC + · exact (transpose_mem z).mp hzE + · simp [transpose_involutive] + +private theorem rowRVertical : + ∀ (P : FordFareyParameter), (2 < P.q) → ( + let A := P4062T1RecursiveInteriors P + let E := (A 0 ∪ A 1) ∪ (A 2 ∪ A 3) + (0 < P.q₁) → ((0 < (P.q₂ : Int)) → ((P.q = P.q₁ + P.q₂) → ((∀ (a : Int), ∀ (b : Int), (⟨a, b⟩ + : GaussianInt) ∈ E ↔ (1 ≤ a ∧ a < P.q₁ ∧ 1 ≤ b ∧ b < P.q₁) ∨ (P.q₂ < a ∧ a < P.q ∧ P.q₂ < + b ∧ b < P.q) ∨ (P.q₁ < a ∧ a < P.q ∧ 1 ≤ b ∧ b < P.q₂) ∨ (1 ≤ a ∧ a < P.q₂ ∧ P.q₁ < b ∧ b + < P.q)) → (∀ (u : Int), ∀ (v : Int), (1 ≤ u ∧ u ≤ (P.q : Int)-1 ∧ + 1 ≤ v ∧ v ≤ (P.q : Int)-1) → ((u = P.q₁ ∧ v ≤ P.q₂) → ((P.q₂ < + P.q₁) → ((({(⟨u, v⟩ : GaussianInt) + 1, ⟨u, v⟩ - 1, + ⟨u, v⟩ + ⟨0, 1⟩, ⟨u, v⟩ - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ E)).card = 2)))))))) := by + classical + intro P hP A E q1pos q2posI hsumN hmem u v hb hl ho + rcases hl with ⟨rfl, hv⟩ + by_cases hroot : v = P.q₂ + · subst v + have hleft0 : (⟨(P.q₁ : Int)-1, (P.q₂ : Int)⟩ : GaussianInt) ∈ E := by + apply (hmem _ _).2 + left + constructor <;> omega + have hup0 : (⟨(P.q₁ : Int), (P.q₂ : Int)+1⟩ : GaussianInt) ∈ E := by + apply (hmem _ _).2 + right + left + constructor <;> omega + have hright0 : (⟨(P.q₁ : Int)+1, (P.q₂ : Int)⟩ : GaussianInt) ∉ E := by + intro hz + have hz' := (hmem _ _).1 hz + omega + have hdown0 : (⟨(P.q₁ : Int), (P.q₂ : Int)-1⟩ : GaussianInt) ∉ E := by + intro hz + have hz' := (hmem _ _).1 hz + omega + have hleft : ((⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) - 1) ∈ E := by + rw [show (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) - 1 = + ⟨(P.q₁ : Int)-1, (P.q₂ : Int)⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] + exact hleft0 + have hup : ((⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) + ⟨0, 1⟩) ∈ E := by + rw [show (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) + ⟨0, 1⟩ = + ⟨(P.q₁ : Int), (P.q₂ : Int)+1⟩ by ext <;> simp []] + exact hup0 + have hright : ((⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) + 1) ∉ E := by + rw [show (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) + 1 = + ⟨(P.q₁ : Int)+1, (P.q₂ : Int)⟩ by ext <;> simp [Zsqrtd.re_add, Zsqrtd.im_add]] + exact hright0 + have hdown : ((⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) - ⟨0, 1⟩) ∉ E := by + rw [show (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) - ⟨0, 1⟩ = + ⟨(P.q₁ : Int), (P.q₂ : Int)-1⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] + exact hdown0 + have hne : ((⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) - 1) ≠ + (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ + ⟨0, 1⟩) := by + intro he + have hr := congrArg (fun z : GaussianInt => z.re) he + simp only [Zsqrtd.re_sub, Zsqrtd.re_add, Zsqrtd.re_one] at hr + omega + have hne' : (⟨(P.q₁ : Int)-1, (P.q₂ : Int)⟩ : GaussianInt) ≠ + ⟨(P.q₁ : Int), (P.q₂ : Int)+1⟩ := by + intro he + have hr := congrArg (fun z : GaussianInt => z.re) he + simp at hr + simp [Finset.filter_insert, Finset.filter_singleton, + hleft, hright, hdown, hup0, + Zsqrtd.ext_iff] + · have hvlt : v < P.q₂ := by omega + have hleft0 : (⟨(P.q₁ : Int)-1, v⟩ : GaussianInt) ∈ E := by + apply (hmem _ _).2 + left + constructor <;> omega + have hright0 : (⟨(P.q₁ : Int)+1, v⟩ : GaussianInt) ∈ E := by + apply (hmem _ _).2 + right + right + left + constructor <;> omega + have hup0 : (⟨(P.q₁ : Int), v+1⟩ : GaussianInt) ∉ E := by + intro hz + have hz' := (hmem _ _).1 hz + omega + have hdown0 : (⟨(P.q₁ : Int), v-1⟩ : GaussianInt) ∉ E := by + intro hz + have hz' := (hmem _ _).1 hz + omega + have hleft : ((⟨(P.q₁ : Int), v⟩ : GaussianInt) - 1) ∈ E := by + rw [show (⟨(P.q₁ : Int), v⟩ : GaussianInt) - 1 = + ⟨(P.q₁ : Int)-1, v⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] + exact hleft0 + have hright : ((⟨(P.q₁ : Int), v⟩ : GaussianInt) + 1) ∈ E := by + rw [show (⟨(P.q₁ : Int), v⟩ : GaussianInt) + 1 = + ⟨(P.q₁ : Int)+1, v⟩ by ext <;> simp [Zsqrtd.re_add, Zsqrtd.im_add]] + exact hright0 + have hup : ((⟨(P.q₁ : Int), v⟩ : GaussianInt) + ⟨0, 1⟩) ∉ E := by + rw [show (⟨(P.q₁ : Int), v⟩ : GaussianInt) + ⟨0, 1⟩ = + ⟨(P.q₁ : Int), v+1⟩ by ext <;> simp []] + exact hup0 + have hdown : ((⟨(P.q₁ : Int), v⟩ : GaussianInt) - ⟨0, 1⟩) ∉ E := by + rw [show (⟨(P.q₁ : Int), v⟩ : GaussianInt) - ⟨0, 1⟩ = + ⟨(P.q₁ : Int), v-1⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] + exact hdown0 + have hne : (⟨(P.q₁ : Int)-1, v⟩ : GaussianInt) ≠ + ⟨(P.q₁ : Int)+1, v⟩ := by + intro he + have hr := congrArg (fun z : GaussianInt => z.re) he + simp at hr + omega + have hne' : ((⟨(P.q₁ : Int), v⟩ : GaussianInt) + 1) ≠ + (⟨(P.q₁ : Int), v⟩ - 1) := by + intro he + have hr := congrArg (fun z : GaussianInt => z.re) he + simp at hr + omega + simp [Finset.filter_insert, Finset.filter_singleton, + hleft, hright, hdown, hup0, + hne'] + +private theorem rowR : + ∀ (P : FordFareyParameter), (2 < P.q) → ( + let A := P4062T1RecursiveInteriors P + let E := (A 0 ∪ A 1) ∪ (A 2 ∪ A 3) + (0 < P.q₁) → ((0 < (P.q₂ : Int)) → ((P.q = P.q₁ + P.q₂) → ((∀ (a : Int), ∀ (b : Int), (⟨a, b⟩ + : GaussianInt) ∈ E ↔ (1 ≤ a ∧ a < P.q₁ ∧ 1 ≤ b ∧ b < P.q₁) ∨ (P.q₂ < a ∧ a < P.q ∧ P.q₂ < + b ∧ b < P.q) ∨ (P.q₁ < a ∧ a < P.q ∧ 1 ≤ b ∧ b < P.q₂) ∨ (1 ≤ a ∧ a < P.q₂ ∧ P.q₁ < b ∧ b + < P.q)) → (∀ (u : Int), ∀ (v : Int), (1 ≤ u ∧ u ≤ (P.q : Int)-1 ∧ + 1 ≤ v ∧ v ≤ (P.q : Int)-1) → (((u = P.q₁ ∧ v ≤ P.q₂) ∨ (v = P.q₂ ∧ P.q₁ ≤ u)) → ((P.q₂ < + P.q₁) → ((({(⟨u, v⟩ : GaussianInt) + 1, ⟨u, v⟩ - 1, + ⟨u, v⟩ + ⟨0, 1⟩, ⟨u, v⟩ - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ E)).card = 2)))))))) := by + classical + intro P hP A E q1pos q2posI hsumN hmem u v hb hl ho + rcases hl with ⟨rfl, hv⟩ | ⟨rfl, hu⟩ + · exact rowRVertical P hP q1pos q2posI hsumN hmem _ v hb ⟨rfl, hv⟩ ho + · by_cases hroot : u = P.q₁ + · subst u + have hleft0 : (⟨(P.q₁ : Int)-1, (P.q₂ : Int)⟩ : GaussianInt) ∈ E := by + apply (hmem _ _).2 + left + constructor <;> omega + have hup0 : (⟨(P.q₁ : Int), (P.q₂ : Int)+1⟩ : GaussianInt) ∈ E := by + apply (hmem _ _).2 + right + left + constructor <;> omega + have hright0 : (⟨(P.q₁ : Int)+1, (P.q₂ : Int)⟩ : GaussianInt) ∉ E := by + intro hz + have hz' := (hmem _ _).1 hz + omega + have hdown0 : (⟨(P.q₁ : Int), (P.q₂ : Int)-1⟩ : GaussianInt) ∉ E := by + intro hz + have hz' := (hmem _ _).1 hz + omega + have hleft : ((⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) - 1) ∈ E := by + rw [show (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) - 1 = + ⟨(P.q₁ : Int)-1, (P.q₂ : Int)⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] + exact hleft0 + have hup : ((⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) + ⟨0, 1⟩) ∈ E := by + rw [show (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) + ⟨0, 1⟩ = + ⟨(P.q₁ : Int), (P.q₂ : Int)+1⟩ by ext <;> simp []] + exact hup0 + have hright : ((⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) + 1) ∉ E := by + rw [show (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) + 1 = + ⟨(P.q₁ : Int)+1, (P.q₂ : Int)⟩ by ext <;> simp [Zsqrtd.re_add, Zsqrtd.im_add]] + exact hright0 + have hdown : ((⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) - ⟨0, 1⟩) ∉ E := by + rw [show (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) - ⟨0, 1⟩ = + ⟨(P.q₁ : Int), (P.q₂ : Int)-1⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] + exact hdown0 + have hne : ((⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) - 1) ≠ + (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ + ⟨0, 1⟩) := by + intro he + have hr := congrArg (fun z : GaussianInt => z.re) he + simp only [Zsqrtd.re_sub, Zsqrtd.re_add, Zsqrtd.re_one] at hr + omega + have hne' : (⟨(P.q₁ : Int)-1, (P.q₂ : Int)⟩ : GaussianInt) ≠ + ⟨(P.q₁ : Int), (P.q₂ : Int)+1⟩ := by + intro he + have hr := congrArg (fun z : GaussianInt => z.re) he + simp at hr + have hneDirect : ((⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) - 1) ≠ + ⟨(P.q₁ : Int), (P.q₂ : Int)+1⟩ := by + intro he + have hr := congrArg (fun z : GaussianInt => z.re) he + simp at hr + simp [Finset.filter_insert, Finset.filter_singleton, + hleft, hright, hdown, hup0, + hneDirect] + · have hult : P.q₁ < u := by omega + have hdown0 : (⟨u, (P.q₂ : Int)-1⟩ : GaussianInt) ∈ E := by + apply (hmem _ _).2 + right + right + left + constructor <;> omega + have hup0 : (⟨u, (P.q₂ : Int)+1⟩ : GaussianInt) ∈ E := by + apply (hmem _ _).2 + right + left + constructor <;> omega + have hleft0 : (⟨u-1, (P.q₂ : Int)⟩ : GaussianInt) ∉ E := by + intro hz + have hz' := (hmem _ _).1 hz + omega + have hright0 : (⟨u+1, (P.q₂ : Int)⟩ : GaussianInt) ∉ E := by + intro hz + have hz' := (hmem _ _).1 hz + omega + have hdown : ((⟨u, (P.q₂ : Int)⟩ : GaussianInt) - ⟨0, 1⟩) ∈ E := by + rw [show (⟨u, (P.q₂ : Int)⟩ : GaussianInt) - ⟨0, 1⟩ = + ⟨u, (P.q₂ : Int)-1⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] + exact hdown0 + have hup : ((⟨u, (P.q₂ : Int)⟩ : GaussianInt) + ⟨0, 1⟩) ∈ E := by + rw [show (⟨u, (P.q₂ : Int)⟩ : GaussianInt) + ⟨0, 1⟩ = + ⟨u, (P.q₂ : Int)+1⟩ by ext <;> simp []] + exact hup0 + have hleft : ((⟨u, (P.q₂ : Int)⟩ : GaussianInt) - 1) ∉ E := by + rw [show (⟨u, (P.q₂ : Int)⟩ : GaussianInt) - 1 = + ⟨u-1, (P.q₂ : Int)⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] + exact hleft0 + have hright : ((⟨u, (P.q₂ : Int)⟩ : GaussianInt) + 1) ∉ E := by + rw [show (⟨u, (P.q₂ : Int)⟩ : GaussianInt) + 1 = + ⟨u+1, (P.q₂ : Int)⟩ by ext <;> simp [Zsqrtd.re_add, Zsqrtd.im_add]] + exact hright0 + have hne : (⟨u, (P.q₂ : Int)-1⟩ : GaussianInt) ≠ + ⟨u, (P.q₂ : Int)+1⟩ := by + intro he + have hi := congrArg (fun z : GaussianInt => z.im) he + simp at hi + omega + have hne' : ((⟨u, (P.q₂ : Int)⟩ : GaussianInt) + ⟨0, 1⟩) ≠ + (⟨u, (P.q₂ : Int)⟩ - ⟨0, 1⟩) := by + intro he + have hi := congrArg (fun z : GaussianInt => z.im) he + simp at hi + omega + have hneDirect : (⟨u, (P.q₂ : Int)+1⟩ : GaussianInt) ≠ + ((⟨u, (P.q₂ : Int)⟩ : GaussianInt) - ⟨0, 1⟩) := by + intro he + have hi := congrArg (fun z : GaussianInt => z.im) he + simp at hi + omega + simp [Finset.filter_insert, Finset.filter_singleton, + hleft, hright, hdown, hup0, + hneDirect] + +private theorem rowSmallRoot : + ∀ (P : FordFareyParameter), (2 < P.q) → ( + let A := P4062T1RecursiveInteriors P + let E := (A 0 ∪ A 1) ∪ (A 2 ∪ A 3) + (0 < P.q₁) → ((0 < (P.q₂ : Int)) → ((P.q = P.q₁ + P.q₂) → ((∀ (a : Int), ∀ (b : Int), (⟨a, b⟩ + : GaussianInt) ∈ E ↔ (1 ≤ a ∧ a < P.q₁ ∧ 1 ≤ b ∧ b < P.q₁) ∨ (P.q₂ < a ∧ a < P.q ∧ P.q₂ < + b ∧ b < P.q) ∨ (P.q₁ < a ∧ a < P.q ∧ 1 ≤ b ∧ b < P.q₂) ∨ (1 ≤ a ∧ a < P.q₂ ∧ P.q₁ < b ∧ b + < P.q)) → ( + let candidate (z : GaussianInt) : Finset GaussianInt := + {z + 1, z - 1, z + ⟨0, 1⟩, z - ⟨0, 1⟩} + (P.q₁ < P.q₂) → ((Finset.filter (fun z => z ∈ E) (candidate ⟨(P.q₁ : Int), (P.q₁ : + Int)⟩)).card = 2)))))) := by + classical + intro P hP A E q1pos q2posI hsumN hmem candidate ho + have hright0 : (⟨(P.q₁ : Int)+1, (P.q₁ : Int)⟩ : GaussianInt) ∈ E := by + apply (hmem _ _).2 + right + right + left + constructor <;> omega + have hup0 : (⟨(P.q₁ : Int), (P.q₁ : Int)+1⟩ : GaussianInt) ∈ E := by + apply (hmem _ _).2 + right + right + right + constructor <;> omega + have hleft0 : (⟨(P.q₁ : Int)-1, (P.q₁ : Int)⟩ : GaussianInt) ∉ E := by + intro hz + have hz' := (hmem _ _).1 hz + omega + have hdown0 : (⟨(P.q₁ : Int), (P.q₁ : Int)-1⟩ : GaussianInt) ∉ E := by + intro hz + have hz' := (hmem _ _).1 hz + omega + have hright : ((⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) + 1) ∈ E := by + rw [show (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) + 1 = + ⟨(P.q₁ : Int)+1, (P.q₁ : Int)⟩ by ext <;> simp [Zsqrtd.re_add, Zsqrtd.im_add]] + exact hright0 + have hup : ((⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) + ⟨0, 1⟩) ∈ E := by + rw [show (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) + ⟨0, 1⟩ = + ⟨(P.q₁ : Int), (P.q₁ : Int)+1⟩ by ext <;> simp []] + exact hup0 + have hleft : ((⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) - 1) ∉ E := by + rw [show (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) - 1 = + ⟨(P.q₁ : Int)-1, (P.q₁ : Int)⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] + exact hleft0 + have hdown : ((⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) - ⟨0, 1⟩) ∉ E := by + rw [show (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) - ⟨0, 1⟩ = + ⟨(P.q₁ : Int), (P.q₁ : Int)-1⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] + exact hdown0 + have hne : (⟨(P.q₁ : Int)+1, (P.q₁ : Int)⟩ : GaussianInt) ≠ + ⟨(P.q₁ : Int), (P.q₁ : Int)+1⟩ := by + intro he + have hr := congrArg (fun z : GaussianInt => z.re) he + simp at hr + have hne' : ((⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) + 1) ≠ + ((⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) + ⟨0, 1⟩) := by + intro he + have hr := congrArg (fun z : GaussianInt => z.re) he + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr + omega + have hneDirect : ((⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) + 1) ≠ + ⟨(P.q₁ : Int), (P.q₁ : Int)+1⟩ := by + intro he + have hr := congrArg (fun z : GaussianInt => z.re) he + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr + omega + simp [candidate, Finset.filter_insert, Finset.filter_singleton, + hleft, hright, hdown, hup0, hneDirect] + +private theorem rowSmall : + ∀ (P : FordFareyParameter), (2 < P.q) → ( + let A := P4062T1RecursiveInteriors P + let E := (A 0 ∪ A 1) ∪ (A 2 ∪ A 3) + (0 < P.q₁) → ((0 < (P.q₂ : Int)) → ((P.q = P.q₁ + P.q₂) → ((∀ (a : Int), ∀ (b : Int), (⟨a, b⟩ + : GaussianInt) ∈ E ↔ (1 ≤ a ∧ a < P.q₁ ∧ 1 ≤ b ∧ b < P.q₁) ∨ (P.q₂ < a ∧ a < P.q ∧ P.q₂ < + b ∧ b < P.q) ∨ (P.q₁ < a ∧ a < P.q ∧ 1 ≤ b ∧ b < P.q₂) ∨ (1 ≤ a ∧ a < P.q₂ ∧ P.q₁ < b ∧ b + < P.q)) → ( + let candidate (z : GaussianInt) : Finset GaussianInt := + {z + 1, z - 1, z + ⟨0, 1⟩, z - ⟨0, 1⟩} + ((P.q₁ < P.q₂) → ((Finset.filter (fun z => z ∈ E) (candidate ⟨(P.q₁ : Int), (P.q₁ : + Int)⟩)).card = 2)) → (∀ (u : Int), ∀ (v : Int), (1 ≤ u ∧ u ≤ (P.q : Int)-1 ∧ + 1 ≤ v ∧ v ≤ (P.q : Int)-1) → (((u = P.q₁ ∧ v ≤ P.q₁) ∨ (v = P.q₁ ∧ u ≤ P.q₁)) → ((P.q₁ < + P.q₂) → ((Finset.filter (fun z => z ∈ E) (candidate ⟨u, v⟩)).card = 2))))))))) := by + classical + intro P hP A E q1pos q2posI hsumN hmem candidate rowSmallRoot u v hb hl ho + rcases hl with ⟨rfl, hv⟩ | ⟨rfl, hu⟩ + · by_cases hroot : v = P.q₁ + · subst v + exact rowSmallRoot ho + · have hvlt : v < P.q₁ := by omega + have hleft0 : (⟨(P.q₁ : Int)-1, v⟩ : GaussianInt) ∈ E := by + apply (hmem _ _).2 + left + constructor <;> omega + have hright0 : (⟨(P.q₁ : Int)+1, v⟩ : GaussianInt) ∈ E := by + apply (hmem _ _).2 + right + right + left + constructor <;> omega + have hup0 : (⟨(P.q₁ : Int), v+1⟩ : GaussianInt) ∉ E := by + intro hz + have hz' := (hmem _ _).1 hz + omega + have hdown0 : (⟨(P.q₁ : Int), v-1⟩ : GaussianInt) ∉ E := by + intro hz + have hz' := (hmem _ _).1 hz + omega + have hleft : ((⟨(P.q₁ : Int), v⟩ : GaussianInt) - 1) ∈ E := by + rw [show (⟨(P.q₁ : Int), v⟩ : GaussianInt) - 1 = + ⟨(P.q₁ : Int)-1, v⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] + exact hleft0 + have hright : ((⟨(P.q₁ : Int), v⟩ : GaussianInt) + 1) ∈ E := by + rw [show (⟨(P.q₁ : Int), v⟩ : GaussianInt) + 1 = + ⟨(P.q₁ : Int)+1, v⟩ by ext <;> simp [Zsqrtd.re_add, Zsqrtd.im_add]] + exact hright0 + have hup : ((⟨(P.q₁ : Int), v⟩ : GaussianInt) + ⟨0, 1⟩) ∉ E := by + rw [show (⟨(P.q₁ : Int), v⟩ : GaussianInt) + ⟨0, 1⟩ = + ⟨(P.q₁ : Int), v+1⟩ by ext <;> simp []] + exact hup0 + have hdown : ((⟨(P.q₁ : Int), v⟩ : GaussianInt) - ⟨0, 1⟩) ∉ E := by + rw [show (⟨(P.q₁ : Int), v⟩ : GaussianInt) - ⟨0, 1⟩ = + ⟨(P.q₁ : Int), v-1⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] + exact hdown0 + have hne : ((⟨(P.q₁ : Int), v⟩ : GaussianInt) + 1) ≠ + (⟨(P.q₁ : Int), v⟩ - 1) := by + intro he + have hr := congrArg (fun z : GaussianInt => z.re) he + simp at hr + omega + simp [candidate, Finset.filter_insert, Finset.filter_singleton, + hleft, hright, hdown, hup0, hne] + · by_cases hroot : u = P.q₁ + · subst u + exact rowSmallRoot ho + · have hult : u < P.q₁ := by omega + have hdown0 : (⟨u, (P.q₁ : Int)-1⟩ : GaussianInt) ∈ E := by + apply (hmem _ _).2 + left + constructor <;> omega + have hup0 : (⟨u, (P.q₁ : Int)+1⟩ : GaussianInt) ∈ E := by + apply (hmem _ _).2 + right + right + right + constructor <;> omega + have hleft0 : (⟨u-1, (P.q₁ : Int)⟩ : GaussianInt) ∉ E := by + intro hz + have hz' := (hmem _ _).1 hz + omega + have hright0 : (⟨u+1, (P.q₁ : Int)⟩ : GaussianInt) ∉ E := by + intro hz + have hz' := (hmem _ _).1 hz + omega + have hdown : ((⟨u, (P.q₁ : Int)⟩ : GaussianInt) - ⟨0, 1⟩) ∈ E := by + rw [show (⟨u, (P.q₁ : Int)⟩ : GaussianInt) - ⟨0, 1⟩ = + ⟨u, (P.q₁ : Int)-1⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] + exact hdown0 + have hup : ((⟨u, (P.q₁ : Int)⟩ : GaussianInt) + ⟨0, 1⟩) ∈ E := by + rw [show (⟨u, (P.q₁ : Int)⟩ : GaussianInt) + ⟨0, 1⟩ = + ⟨u, (P.q₁ : Int)+1⟩ by ext <;> simp []] + exact hup0 + have hleft : ((⟨u, (P.q₁ : Int)⟩ : GaussianInt) - 1) ∉ E := by + rw [show (⟨u, (P.q₁ : Int)⟩ : GaussianInt) - 1 = + ⟨u-1, (P.q₁ : Int)⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] + exact hleft0 + have hright : ((⟨u, (P.q₁ : Int)⟩ : GaussianInt) + 1) ∉ E := by + rw [show (⟨u, (P.q₁ : Int)⟩ : GaussianInt) + 1 = + ⟨u+1, (P.q₁ : Int)⟩ by ext <;> simp [Zsqrtd.re_add, Zsqrtd.im_add]] + exact hright0 + have hne : (⟨u, (P.q₁ : Int)-1⟩ : GaussianInt) ≠ + ⟨u, (P.q₁ : Int)+1⟩ := by + intro he + have hi := congrArg (fun z : GaussianInt => z.im) he + simp at hi + omega + have hne' : ((⟨u, (P.q₁ : Int)⟩ : GaussianInt) + ⟨0, 1⟩) ≠ + (⟨u, (P.q₁ : Int)⟩ - ⟨0, 1⟩) := by + intro he + have hi := congrArg (fun z : GaussianInt => z.im) he + simp only [Zsqrtd.im_add, Zsqrtd.im_sub] at hi + omega + have hneDirect : (⟨u, (P.q₁ : Int)+1⟩ : GaussianInt) ≠ + ((⟨u, (P.q₁ : Int)⟩ : GaussianInt) - ⟨0, 1⟩) := by + intro he + have hi := congrArg (fun z : GaussianInt => z.im) he + simp only [Zsqrtd.im_sub] at hi + omega + simp [candidate, Finset.filter_insert, Finset.filter_singleton, + hleft, hright, hdown, hup0, hneDirect] + +private theorem reflect_involutive : + ∀ (P : FordFareyParameter), ((P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int)) → ( + let reflect (z : GaussianInt) : GaussianInt := + ⟨(P.q : Int) - z.re, (P.q : Int) - z.im⟩ + ∀ (z : GaussianInt), reflect (reflect z) = z) := by + classical + intro P hsum reflect z + cases z + simp [reflect, hsum] + +private theorem reflect_mem : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + let E := (A 0 ∪ A 1) ∪ (A 2 ∪ A 3) + (0 < P.q₁) → ((0 < (P.q₂ : Int)) → ((P.q = P.q₁ + P.q₂) → ((∀ (a : Int), ∀ (b : Int), (⟨a, b⟩ + : GaussianInt) ∈ E ↔ (1 ≤ a ∧ a < P.q₁ ∧ 1 ≤ b ∧ b < P.q₁) ∨ (P.q₂ < a ∧ a < P.q ∧ P.q₂ < + b ∧ b < P.q) ∨ (P.q₁ < a ∧ a < P.q ∧ 1 ≤ b ∧ b < P.q₂) ∨ (1 ≤ a ∧ a < P.q₂ ∧ P.q₁ < b ∧ b + < P.q)) → ( + let reflect (z : GaussianInt) : GaussianInt := + ⟨(P.q : Int) - z.re, (P.q : Int) - z.im⟩ + ∀ (z : GaussianInt), z ∈ E ↔ reflect z ∈ E)))) := by + classical + intro P A E q1pos q2posI hsumN hmem reflect z + cases z with + | mk a b => + dsimp [reflect] + simp only [hmem] + constructor <;> intro hz <;> rcases hz with hz | hz | hz | hz <;> omega + +private theorem reflect_candidate : + ∀ (P : FordFareyParameter), + let candidate (z : GaussianInt) : Finset GaussianInt := + {z + 1, z - 1, z + ⟨0, 1⟩, z - ⟨0, 1⟩} + let reflect (z : GaussianInt) : GaussianInt := + ⟨(P.q : Int) - z.re, (P.q : Int) - z.im⟩ + ∀ (x : GaussianInt), ∀ (z : GaussianInt), z ∈ candidate x ↔ reflect z ∈ candidate (reflect x) + := by + classical + intro P candidate reflect x z + cases x with + | mk a b => + cases z with + | mk c d => + simp [candidate, reflect, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, + Zsqrtd.ext_iff] + omega + +private theorem reflect_filter_card : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + let E := (A 0 ∪ A 1) ∪ (A 2 ∪ A 3) + let candidate (z : GaussianInt) : Finset GaussianInt := + {z + 1, z - 1, z + ⟨0, 1⟩, z - ⟨0, 1⟩} + let reflect (z : GaussianInt) : GaussianInt := + ⟨(P.q : Int) - z.re, (P.q : Int) - z.im⟩ + (∀ (z : GaussianInt), reflect (reflect z) = z) → ((∀ (z : GaussianInt), z ∈ E ↔ reflect z ∈ + E) → ((∀ (x : GaussianInt), ∀ (z : GaussianInt), z ∈ candidate x ↔ reflect z ∈ candidate + (reflect x)) → (∀ (x : GaussianInt), (Finset.filter (fun z => z ∈ E) (candidate x)).card = + (Finset.filter (fun z => z ∈ E) (candidate (reflect x))).card))) := by + classical + intro P A E candidate reflect reflect_involutive reflect_mem reflect_candidate x + apply Finset.card_bij (fun z hz => reflect z) + · intro z hz + rcases Finset.mem_filter.mp hz with ⟨hzC, hzE⟩ + exact Finset.mem_filter.mpr + ⟨(reflect_candidate x z).mp hzC, (reflect_mem z).mp hzE⟩ + · intro z hz w hw h + have := congrArg reflect h + simpa [reflect_involutive] using this + · intro z hz + rcases Finset.mem_filter.mp hz with ⟨hzC, hzE⟩ + refine ⟨reflect z, Finset.mem_filter.mpr ⟨?_, ?_⟩, ?_⟩ + · simpa [reflect_involutive] using (reflect_candidate (reflect x) z).mp hzC + · exact (reflect_mem z).mp hzE + · simp [reflect_involutive] + +end ParentalNeighborLemmas + +theorem P4112T1ParentalNeighbors (P : FordFareyParameter) (hP : 2 < P.q) : + let A := P4062T1RecursiveInteriors P + let E := (A 0 ∪ A 1) ∪ (A 2 ∪ A 3) + let B := P4062T1RemainderPaths P + ∀ j, ∀ x ∈ (B j).1, + (E.filter (fun y => FourNeighborAdjacent y x)).card = 2 := by +-- BODY + classical + have adjacent_comm (x y : GaussianInt) : + FourNeighborAdjacent x y ↔ FourNeighborAdjacent y x := ParentalNeighborLemmas.adjacent_comm + x y + have neighbor_filter (S : Finset GaussianInt) (x : GaussianInt) : + S.filter (fun y => FourNeighborAdjacent y x) = + ({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ S) := ParentalNeighborLemmas.neighbor_filter adjacent_comm S x + let A := P4062T1RecursiveInteriors P + let E := (A 0 ∪ A 1) ∪ (A 2 ∪ A 3) + let B := P4062T1RemainderPaths P + change ∀ j, ∀ x ∈ (B j).1, + (E.filter (fun y => FourNeighborAdjacent y x)).card = 2 + intro j x hx + rw [neighbor_filter] + have q1pos : 0 < P.q₁ := ParentalNeighborLemmas.q1pos P hP + have q2posI : 0 < (P.q₂ : Int) := ParentalNeighborLemmas.q2posI P + have cross : P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 := ParentalNeighborLemmas.cross P + have hsumN := ParentalNeighborLemmas.hsumN P + have unequal : P.q₁ ≠ P.q₂ := ParentalNeighborLemmas.unequal P hP q2posI cross hsumN + have hsum : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := ParentalNeighborLemmas.hsum P + have squareCoordinates (n : Nat) (z : GaussianInt) : + z ∈ P4062T1InteriorSquare n ↔ + 1 ≤ z.re ∧ z.re ≤ (n : Int) - 1 ∧ + 1 ≤ z.im ∧ z.im ≤ (n : Int) - 1 := ParentalNeighborLemmas.squareCoordinates n z + have mem0 (z : GaussianInt) : z ∈ A 0 ↔ + 1 ≤ z.re ∧ z.re ≤ (P.q₁ : Int)-1 ∧ + 1 ≤ z.im ∧ z.im ≤ (P.q₁ : Int)-1 := ParentalNeighborLemmas.mem0 P squareCoordinates z + have mem1 (z : GaussianInt) : z ∈ A 1 ↔ + (P.q₂ : Int)+1 ≤ z.re ∧ z.re ≤ (P.q : Int)-1 ∧ + (P.q₂ : Int)+1 ≤ z.im ∧ z.im ≤ (P.q : Int)-1 := ParentalNeighborLemmas.mem1 P hsumN + squareCoordinates z + have mem2 (z : GaussianInt) : z ∈ A 2 ↔ + (P.q₁ : Int)+1 ≤ z.re ∧ z.re ≤ (P.q : Int)-1 ∧ + 1 ≤ z.im ∧ z.im ≤ (P.q₂ : Int)-1 := ParentalNeighborLemmas.mem2 P hsumN squareCoordinates z + have mem3 (z : GaussianInt) : z ∈ A 3 ↔ + 1 ≤ z.re ∧ z.re ≤ (P.q₂ : Int)-1 ∧ + (P.q₁ : Int)+1 ≤ z.im ∧ z.im ≤ (P.q : Int)-1 := ParentalNeighborLemmas.mem3 P hsumN + squareCoordinates z + have hmem (a b : Int) : (⟨a, b⟩ : GaussianInt) ∈ E ↔ + (1 ≤ a ∧ a < P.q₁ ∧ 1 ≤ b ∧ b < P.q₁) ∨ + (P.q₂ < a ∧ a < P.q ∧ P.q₂ < b ∧ b < P.q) ∨ + (P.q₁ < a ∧ a < P.q ∧ 1 ≤ b ∧ b < P.q₂) ∨ + (1 ≤ a ∧ a < P.q₂ ∧ P.q₁ < b ∧ b < P.q) := ParentalNeighborLemmas.hmem P hP q1pos q2posI + hsumN mem0 mem1 mem2 mem3 a b + let candidate (z : GaussianInt) : Finset GaussianInt := + {z + 1, z - 1, z + ⟨0, 1⟩, z - ⟨0, 1⟩} + let transpose (z : GaussianInt) : GaussianInt := ⟨z.im, z.re⟩ + have transpose_involutive (z : GaussianInt) : transpose (transpose z) = z := + ParentalNeighborLemmas.transpose_involutive z + have transpose_mem (z : GaussianInt) : z ∈ E ↔ transpose z ∈ E := + ParentalNeighborLemmas.transpose_mem P hP q1pos q2posI hsumN hmem z + have transpose_candidate (x z : GaussianInt) : + z ∈ candidate x ↔ transpose z ∈ candidate (transpose x) := + ParentalNeighborLemmas.transpose_candidate P x z + have transpose_filter_card (x : GaussianInt) : + (Finset.filter (fun z => z ∈ E) (candidate x)).card = + (Finset.filter (fun z => z ∈ E) (candidate (transpose x))).card := + ParentalNeighborLemmas.transpose_filter_card P transpose_involutive transpose_mem + transpose_candidate x + have rowR (u v : Int) (hb : 1 ≤ u ∧ u ≤ (P.q : Int)-1 ∧ + 1 ≤ v ∧ v ≤ (P.q : Int)-1) + (hl : (u = P.q₁ ∧ v ≤ P.q₂) ∨ (v = P.q₂ ∧ P.q₁ ≤ u)) + (ho : P.q₂ < P.q₁) : + (({(⟨u, v⟩ : GaussianInt) + 1, ⟨u, v⟩ - 1, + ⟨u, v⟩ + ⟨0, 1⟩, ⟨u, v⟩ - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ E)).card = 2 := ParentalNeighborLemmas.rowR P hP q1pos q2posI hsumN hmem + u v hb hl ho + have rowSmallRoot (ho : P.q₁ < P.q₂) : + (Finset.filter (fun z => z ∈ E) (candidate ⟨(P.q₁ : Int), (P.q₁ : Int)⟩)).card = 2 := + ParentalNeighborLemmas.rowSmallRoot P hP q1pos q2posI hsumN hmem ho + have rowSmall (u v : Int) (hb : 1 ≤ u ∧ u ≤ (P.q : Int)-1 ∧ + 1 ≤ v ∧ v ≤ (P.q : Int)-1) + (hl : (u = P.q₁ ∧ v ≤ P.q₁) ∨ (v = P.q₁ ∧ u ≤ P.q₁)) + (ho : P.q₁ < P.q₂) : + (Finset.filter (fun z => z ∈ E) (candidate ⟨u, v⟩)).card = 2 := + ParentalNeighborLemmas.rowSmall P hP q1pos q2posI hsumN hmem rowSmallRoot u v hb hl ho + let reflect (z : GaussianInt) : GaussianInt := + ⟨(P.q : Int) - z.re, (P.q : Int) - z.im⟩ + have reflect_involutive (z : GaussianInt) : reflect (reflect z) = z := + ParentalNeighborLemmas.reflect_involutive P hsum z + have reflect_mem (z : GaussianInt) : z ∈ E ↔ reflect z ∈ E := + ParentalNeighborLemmas.reflect_mem P q1pos q2posI hsumN hmem z + have reflect_candidate (x z : GaussianInt) : + z ∈ candidate x ↔ reflect z ∈ candidate (reflect x) := + ParentalNeighborLemmas.reflect_candidate P x z + have reflect_filter_card (x : GaussianInt) : + (Finset.filter (fun z => z ∈ E) (candidate x)).card = + (Finset.filter (fun z => z ∈ E) (candidate (reflect x))).card := + ParentalNeighborLemmas.reflect_filter_card P reflect_involutive reflect_mem + reflect_candidate x + dsimp [B] at hx + fin_cases j + · rcases x with ⟨u, v⟩ + by_cases h : P.q₂ < P.q₁ + · simp? [P4062T1RemainderPaths, h, Finset.mem_filter] at hx + rcases hx with ⟨hxbox, hxline⟩ + have hb := (squareCoordinates P.q ⟨u, v⟩).mp hxbox + exact rowR u v hb hxline h + · simp? [P4062T1RemainderPaths, h, Finset.mem_filter] at hx + rcases hx with ⟨hxbox, hxline⟩ + have hb := (squareCoordinates P.q ⟨u, v⟩).mp hxbox + have ho : P.q₁ < P.q₂ := by omega + exact rowSmall u v hb hxline ho + · rcases x with ⟨u, v⟩ + by_cases h : P.q₂ < P.q₁ + · simp? [P4062T1RemainderPaths, h, Finset.mem_filter] at hx + rcases hx with ⟨hxbox, hxline⟩ + have hb := (squareCoordinates P.q ⟨u, v⟩).mp hxbox + have hb' : 1 ≤ v ∧ v ≤ (P.q : Int)-1 ∧ 1 ≤ u ∧ u ≤ (P.q : Int)-1 := + ⟨hb.2.2.1, hb.2.2.2, hb.1, hb.2.1⟩ + rw [transpose_filter_card] + exact rowR v u hb' hxline h + · simp? [P4062T1RemainderPaths, h, Finset.mem_filter] at hx + rcases hx with ⟨hxbox, hxline⟩ + have hb := (squareCoordinates P.q ⟨u, v⟩).mp hxbox + have ho : P.q₁ < P.q₂ := by omega + have hb' : 1 ≤ (P.q : Int)-u ∧ (P.q : Int)-u ≤ (P.q : Int)-1 ∧ + 1 ≤ (P.q : Int)-v ∧ (P.q : Int)-v ≤ (P.q : Int)-1 := by + change 1 ≤ u ∧ u ≤ (P.q : Int)-1 ∧ 1 ≤ v ∧ v ≤ (P.q : Int)-1 at hb + rcases hb with ⟨hu1, hu2, hv1, hv2⟩ + constructor <;> omega + have hl : ((P.q : Int)-u = P.q₁ ∧ (P.q : Int)-v ≤ P.q₁) ∨ + ((P.q : Int)-v = P.q₁ ∧ (P.q : Int)-u ≤ P.q₁) := by + rcases hxline with ⟨hu, hv⟩ | ⟨hv, hu⟩ + · left + constructor <;> omega + · right + constructor <;> omega + rw [reflect_filter_card] + exact rowSmall ((P.q : Int)-u) ((P.q : Int)-v) hb' hl ho + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean new file mode 100644 index 0000000000..16c116b351 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean @@ -0,0 +1,1499 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderPaths +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import Mathlib.Data.Nat.Dist + +/-! +# P4112T1PathGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + + +-- [TABLET NODE: P4112T1PathGeometry] +namespace PathGeometryProof + +private theorem hsum : + ∀ (P : FordFareyParameter), P.q = P.q₁ + P.q₂ := by + classical + intro P + exact P.sum_q + +private theorem hs : + ∀ (P : FordFareyParameter), + let s := P.q₂ + 0 < s := by + classical + intro P s + exact P.q₂_pos + +private theorem hr : + ∀ (P : FordFareyParameter), (2 < P.q) → ( + let r := P.q₁ + (P.q = P.q₁ + P.q₂) → (0 < r)) := by + classical + intro P hP r hsum + by_contra hn + have hr0 : r = 0 := Nat.eq_zero_of_not_pos hn + have hzero : P.q₁ = 0 := hr0 + have hd := P.det₁ + rw [hzero] at hd + simp only [Nat.cast_zero, zero_mul] at hd + have hqint : 2 < (P.q : Int) := by exact_mod_cast hP + by_cases hp : P.p₁ ≤ 0 + · have hqnonneg : 0 ≤ (P.q : Int) := by omega + have : P.p₁ * (P.q : Int) ≤ 0 := mul_nonpos_of_nonpos_of_nonneg hp hqnonneg + omega + · have hp' : 1 ≤ P.p₁ := by omega + nlinarith + +private theorem hrs : + ∀ (P : FordFareyParameter), (2 < P.q) → ( + let r := P.q₁ + let s := P.q₂ + (P.q = P.q₁ + P.q₂) → (r ≠ s)) := by + classical + intro P hP r s hsum heq + have hqeq : P.q = r + r := by + have hrs' : P.q₁ = P.q₂ := by simpa [r,s] using heq + simpa [r, hrs'] using hsum + have hqcast : (P.q : Int) = (r : Int) + (r : Int) := by exact_mod_cast hqeq + have hq1cast : (P.q₁ : Int) = (r : Int) := by rfl + have hq2cast : (P.q₂ : Int) = (r : Int) := by + have hrs' : P.q₁ = P.q₂ := by simpa [r,s] using heq + exact_mod_cast hrs'.symm + have hd : (P.p₁ - P.p₂) * (r : Int) = 1 := by + have h1 := P.det₁ + have h2 := P.det₂ + rw [hqcast, hq1cast] at h1 + rw [hqcast, hq2cast] at h2 + nlinarith + have hrint2 : 2 ≤ (r : Int) := by + have hqint : 2 < (P.q : Int) := by exact_mod_cast hP + rw [hqeq] at hqint + push_cast at hqint + omega + by_cases hc : P.p₁ - P.p₂ ≤ 0 + · have hcprod : (P.p₁-P.p₂) * (r:Int) ≤ 0 := + mul_nonpos_of_nonpos_of_nonneg hc (by omega) + omega + · have hc' : 1 ≤ P.p₁ - P.p₂ := by omega + have hprod : 2 ≤ (P.p₁-P.p₂) * (r:Int) := by + calc + 2 = 1 * 2 := by norm_num + _ ≤ (P.p₁-P.p₂) * (r:Int) := by + exact mul_le_mul hc' hrint2 (by norm_num) (by omega) + omega + +private theorem horder : + ∀ (P : FordFareyParameter), + let r := P.q₁ + let s := P.q₂ + (r ≠ s) → (r < s ∨ s < r) := by + classical + intro P r s hrs + exact lt_or_gt_of_ne hrs + +private theorem hsumInt : + ∀ (P : FordFareyParameter), + let r := P.q₁ + let s := P.q₂ + (P.q = P.q₁ + P.q₂) → ((P.q : Int) = (r : Int) + (s : Int)) := by + classical + intro P r s hsum + exact_mod_cast hsum + +private theorem squareCoordinates : + ∀ (n : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare n ↔ + 1 ≤ x.re ∧ x.re ≤ (n : Int)-1 ∧ + 1 ≤ x.im ∧ x.im ≤ (n : Int)-1 := by + classical + intro n x + unfold P4062T1InteriorSquare + constructor + · intro hx + obtain ⟨⟨a,b⟩, hab, rfl⟩ := Finset.mem_image.mp hx + obtain ⟨ha,hb⟩ := Finset.mem_product.mp hab + exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, + (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ + · intro h + exact Finset.mem_image.mpr ⟨(x.re,x.im), + Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨h.1,h.2.1⟩, + Finset.mem_Icc.mpr h.2.2⟩, by cases x; rfl⟩ + +private theorem mem0 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + let r := P.q₁ + (∀ (n : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare n ↔ 1 ≤ x.re ∧ x.re ≤ (n : + Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (n : Int)-1) → (∀ (x : GaussianInt), x ∈ A 0 ↔ + 1 ≤ x.re ∧ x.re ≤ (r : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (r : Int)-1) := by + classical + intro P A r squareCoordinates x + simpa [A,r,P4062T1RecursiveInteriors] using (squareCoordinates r x) + +private theorem mem1 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + let s := P.q₂ + (P.q = P.q₁ + P.q₂) → ((∀ (n : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare n ↔ 1 ≤ + x.re ∧ x.re ≤ (n : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (n : Int)-1) → (∀ (x : GaussianInt), x ∈ A 1 ↔ + (s : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + (s : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1)) := by + classical + intro P A s hsum squareCoordinates x + let r := P.q₁ + constructor + · intro hx + dsimp [A,r,s,P4062T1RecursiveInteriors] at hx + obtain ⟨z,hz,rfl⟩ := Finset.mem_image.mp hx + have hz' := (squareCoordinates P.q₁ z).mp hz + simp only [Zsqrtd.re_add,Zsqrtd.im_add] + have hq2 : (P.q₂ : Int) = (s : Int) := by rfl + constructor <;> omega + · intro hx + apply Finset.mem_image.mpr + refine ⟨x-⟨(s:Int),(s:Int)⟩, ?_, ?_⟩ + · apply (squareCoordinates r _).mpr + simp only [Zsqrtd.re_sub,Zsqrtd.im_sub] + have hq2 : (P.q₂ : Int) = (s : Int) := by rfl + constructor <;> omega + · ext <;> simp [Zsqrtd.re_add,Zsqrtd.im_add,Zsqrtd.re_sub,Zsqrtd.im_sub] <;> omega + +private theorem mem2 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + let r := P.q₁ + let s := P.q₂ + (P.q = P.q₁ + P.q₂) → ((∀ (n : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare n ↔ 1 ≤ + x.re ∧ x.re ≤ (n : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (n : Int)-1) → (∀ (x : GaussianInt), x ∈ A 2 ↔ + (r : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ + 1 ≤ x.im ∧ x.im ≤ (s : Int)-1)) := by + classical + intro P A r s hsum squareCoordinates x + constructor + · intro hx + dsimp [A,r,s,P4062T1RecursiveInteriors] at hx + obtain ⟨z,hz,rfl⟩ := Finset.mem_image.mp hx + have hz' := (squareCoordinates P.q₂ z).mp hz + simp only [Zsqrtd.re_add,Zsqrtd.im_add] + have hq1 : (P.q₁ : Int) = (r : Int) := by rfl + constructor <;> omega + · intro hx + apply Finset.mem_image.mpr + refine ⟨x-⟨(r:Int),0⟩, ?_, ?_⟩ + · apply (squareCoordinates s _).mpr + simp only [Zsqrtd.re_sub,Zsqrtd.im_sub] + have hq1 : (P.q₁ : Int) = (r : Int) := by rfl + constructor <;> omega + · ext <;> simp [Zsqrtd.re_add,Zsqrtd.im_add,Zsqrtd.re_sub,Zsqrtd.im_sub]; omega + +private theorem mem3 : + ∀ (P : FordFareyParameter), + let A := P4062T1RecursiveInteriors P + let r := P.q₁ + let s := P.q₂ + (P.q = P.q₁ + P.q₂) → ((∀ (n : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare n ↔ 1 ≤ + x.re ∧ x.re ≤ (n : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (n : Int)-1) → (∀ (x : GaussianInt), x ∈ A 3 ↔ + 1 ≤ x.re ∧ x.re ≤ (s : Int)-1 ∧ + (r : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1)) := by + classical + intro P A r s hsum squareCoordinates x + constructor + · intro hx + dsimp [A,r,s,P4062T1RecursiveInteriors] at hx + obtain ⟨z,hz,rfl⟩ := Finset.mem_image.mp hx + have hz' := (squareCoordinates P.q₂ z).mp hz + simp only [Zsqrtd.re_add,Zsqrtd.im_add] + have hq1 : (P.q₁ : Int) = (r : Int) := by rfl + constructor <;> omega + · intro hx + apply Finset.mem_image.mpr + refine ⟨x-⟨0,(r:Int)⟩, ?_, ?_⟩ + · apply (squareCoordinates s _).mpr + simp only [Zsqrtd.re_sub,Zsqrtd.im_sub] + have hq1 : (P.q₁ : Int) = (r : Int) := by rfl + constructor <;> omega + · ext <;> simp [Zsqrtd.re_add,Zsqrtd.im_add,Zsqrtd.re_sub,Zsqrtd.im_sub]; omega + +private theorem memB0Large : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let r := P.q₁ + let s := P.q₂ + (P.q = P.q₁ + P.q₂) → ((0 < s) → ((0 < r) → ((∀ (n : Nat), ∀ (x : GaussianInt), x ∈ + P4062T1InteriorSquare n ↔ 1 ≤ x.re ∧ x.re ≤ (n : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (n : + Int)-1) → (∀ (x : GaussianInt), (s < r) → (x ∈ (B 0).1 ↔ + (x.re = (r:Int) ∧ 1 ≤ x.im ∧ x.im ≤ (s:Int)) ∨ + (x.im = (s:Int) ∧ (r:Int) ≤ x.re ∧ x.re ≤ (P.q:Int)-1)))))) := by + classical + intro P B r s hsum hs hr squareCoordinates x hlarge + change P.q₂ < P.q₁ at hlarge + simp? [B, P4062T1RemainderPaths, hlarge, Finset.mem_filter] + rw [squareCoordinates] + omega + +private theorem memB1Large : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let r := P.q₁ + let s := P.q₂ + (P.q = P.q₁ + P.q₂) → ((0 < s) → ((0 < r) → ((∀ (n : Nat), ∀ (x : GaussianInt), x ∈ + P4062T1InteriorSquare n ↔ 1 ≤ x.re ∧ x.re ≤ (n : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (n : + Int)-1) → (∀ (x : GaussianInt), (s < r) → (x ∈ (B 1).1 ↔ + (x.im = (r:Int) ∧ 1 ≤ x.re ∧ x.re ≤ (s:Int)) ∨ + (x.re = (s:Int) ∧ (r:Int) ≤ x.im ∧ x.im ≤ (P.q:Int)-1)))))) := by + classical + intro P B r s hsum hs hr squareCoordinates x hlarge + change P.q₂ < P.q₁ at hlarge + simp? [B, P4062T1RemainderPaths, hlarge, Finset.mem_filter] + rw [squareCoordinates] + omega + +private theorem memB0Small : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let r := P.q₁ + let s := P.q₂ + (P.q = P.q₁ + P.q₂) → ((0 < s) → ((0 < r) → ((∀ (n : Nat), ∀ (x : GaussianInt), x ∈ + P4062T1InteriorSquare n ↔ 1 ≤ x.re ∧ x.re ≤ (n : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (n : + Int)-1) → (∀ (x : GaussianInt), (r < s) → (x ∈ (B 0).1 ↔ + (x.re = (r:Int) ∧ 1 ≤ x.im ∧ x.im ≤ (r:Int)) ∨ + (x.im = (r:Int) ∧ 1 ≤ x.re ∧ x.re ≤ (r:Int))))))) := by + classical + intro P B r s hsum hs hr squareCoordinates x hsmall + change P.q₁ < P.q₂ at hsmall + have hfalse : ¬ P.q₂ < P.q₁ := by omega + simp? [B, P4062T1RemainderPaths, hfalse, Finset.mem_filter] + rw [squareCoordinates] + omega + +private theorem memB1Small : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let r := P.q₁ + let s := P.q₂ + (P.q = P.q₁ + P.q₂) → ((0 < s) → ((0 < r) → ((∀ (n : Nat), ∀ (x : GaussianInt), x ∈ + P4062T1InteriorSquare n ↔ 1 ≤ x.re ∧ x.re ≤ (n : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (n : + Int)-1) → (∀ (x : GaussianInt), (r < s) → (x ∈ (B 1).1 ↔ + (x.re = (s:Int) ∧ (s:Int) ≤ x.im ∧ x.im ≤ (P.q:Int)-1) ∨ + (x.im = (s:Int) ∧ (s:Int) ≤ x.re ∧ x.re ≤ (P.q:Int)-1)))))) := by + classical + intro P B r s hsum hs hr squareCoordinates x hsmall + change P.q₁ < P.q₂ at hsmall + have hfalse : ¬ P.q₂ < P.q₁ := by omega + simp? [B, P4062T1RemainderPaths, hfalse, Finset.mem_filter] + rw [squareCoordinates] + omega + +private theorem partition : + ∀ (P : FordFareyParameter), (2 < P.q) → ( + let A := P4062T1RecursiveInteriors P + let E := (A 0 ∪ A 1) ∪ (A 2 ∪ A 3) + let W := P4062T1InteriorSquare P.q \ E + let B := P4062T1RemainderPaths P + let r := P.q₁ + let s := P.q₂ + (P.q = P.q₁ + P.q₂) → ((0 < s) → ((0 < r) → ((r < s ∨ s < r) → ((∀ (n : Nat), ∀ (x : + GaussianInt), x ∈ P4062T1InteriorSquare n ↔ 1 ≤ x.re ∧ x.re ≤ (n : Int)-1 ∧ 1 ≤ x.im ∧ + x.im ≤ (n : Int)-1) → ((∀ (x : GaussianInt), x ∈ A 0 ↔ 1 ≤ x.re ∧ x.re ≤ (r : Int)-1 ∧ 1 + ≤ x.im ∧ x.im ≤ (r : Int)-1) → ((∀ (x : GaussianInt), x ∈ A 1 ↔ (s : Int)+1 ≤ x.re ∧ x.re + ≤ (P.q : Int)-1 ∧ (s : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1) → ((∀ (x : GaussianInt), x ∈ + A 2 ↔ (r : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (s : Int)-1) → ((∀ (x + : GaussianInt), x ∈ A 3 ↔ 1 ≤ x.re ∧ x.re ≤ (s : Int)-1 ∧ (r : Int)+1 ≤ x.im ∧ x.im ≤ + (P.q : Int)-1) → ((∀ (x : GaussianInt), (s < r) → (x ∈ (B 0).1 ↔ (x.re = (r:Int) ∧ 1 ≤ + x.im ∧ x.im ≤ (s:Int)) ∨ (x.im = (s:Int) ∧ (r:Int) ≤ x.re ∧ x.re ≤ (P.q:Int)-1))) → ((∀ + (x : GaussianInt), (s < r) → (x ∈ (B 1).1 ↔ (x.im = (r:Int) ∧ 1 ≤ x.re ∧ x.re ≤ (s:Int)) + ∨ (x.re = (s:Int) ∧ (r:Int) ≤ x.im ∧ x.im ≤ (P.q:Int)-1))) → ((∀ (x : GaussianInt), (r < + s) → (x ∈ (B 0).1 ↔ (x.re = (r:Int) ∧ 1 ≤ x.im ∧ x.im ≤ (r:Int)) ∨ (x.im = (r:Int) ∧ 1 ≤ + x.re ∧ x.re ≤ (r:Int)))) → ((∀ (x : GaussianInt), (r < s) → (x ∈ (B 1).1 ↔ (x.re = + (s:Int) ∧ (s:Int) ≤ x.im ∧ x.im ≤ (P.q:Int)-1) ∨ (x.im = (s:Int) ∧ (s:Int) ≤ x.re ∧ x.re + ≤ (P.q:Int)-1))) → (W = (B 0).1 ∪ (B 1).1)))))))))))))) := by + classical + intro P hP A E W B r s hsum hs hr horder squareCoordinates mem0 mem1 mem2 mem3 memB0Large + memB1Large memB0Small memB1Small + ext x + simp only [W, Finset.mem_sdiff] + simp only [E, A, Finset.mem_union, not_or] + rw [squareCoordinates, mem0, mem1, mem2, mem3] + rcases horder with hsmall | hlarge + · rw [memB0Small x (by omega), memB1Small x (by omega)] + constructor <;> intro h <;> omega + · rw [memB0Large x (by omega), memB1Large x (by omega)] + constructor <;> intro h <;> omega + +private theorem hdisj : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let r := P.q₁ + let s := P.q₂ + (r < s ∨ s < r) → ((∀ (x : GaussianInt), (s < r) → (x ∈ (B 0).1 ↔ (x.re = (r:Int) ∧ 1 ≤ x.im + ∧ x.im ≤ (s:Int)) ∨ (x.im = (s:Int) ∧ (r:Int) ≤ x.re ∧ x.re ≤ (P.q:Int)-1))) → ((∀ (x : + GaussianInt), (s < r) → (x ∈ (B 1).1 ↔ (x.im = (r:Int) ∧ 1 ≤ x.re ∧ x.re ≤ (s:Int)) ∨ + (x.re = (s:Int) ∧ (r:Int) ≤ x.im ∧ x.im ≤ (P.q:Int)-1))) → ((∀ (x : GaussianInt), (r < s) + → (x ∈ (B 0).1 ↔ (x.re = (r:Int) ∧ 1 ≤ x.im ∧ x.im ≤ (r:Int)) ∨ (x.im = (r:Int) ∧ 1 ≤ + x.re ∧ x.re ≤ (r:Int)))) → ((∀ (x : GaussianInt), (r < s) → (x ∈ (B 1).1 ↔ (x.re = + (s:Int) ∧ (s:Int) ≤ x.im ∧ x.im ≤ (P.q:Int)-1) ∨ (x.im = (s:Int) ∧ (s:Int) ≤ x.re ∧ x.re + ≤ (P.q:Int)-1))) → (Disjoint (B 0).1 (B 1).1))))) := by + classical + intro P B r s horder memB0Large memB1Large memB0Small memB1Small + apply Finset.disjoint_left.mpr + intro x hx hy + rcases horder with hsmall | hlarge + · rw [memB0Small x (by omega)] at hx + rw [memB1Small x (by omega)] at hy + rcases hx with ⟨hrx,hxl,hxh⟩ | ⟨hxi,hxl,hxh⟩ <;> + rcases hy with ⟨hry,hyl,hyh⟩ | ⟨hyi,hyl,hyh⟩ <;> omega + · rw [memB0Large x (by omega)] at hx + rw [memB1Large x (by omega)] at hy + rcases hx with ⟨hrx,hxl,hxh⟩ | ⟨hxi,hxl,hxh⟩ <;> + rcases hy with ⟨hry,hyl,hyh⟩ | ⟨hyi,hyl,hyh⟩ <;> omega + +private theorem hcross : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let r := P.q₁ + let s := P.q₂ + (r < s ∨ s < r) → ((∀ (x : GaussianInt), (s < r) → (x ∈ (B 0).1 ↔ (x.re = (r:Int) ∧ 1 ≤ x.im + ∧ x.im ≤ (s:Int)) ∨ (x.im = (s:Int) ∧ (r:Int) ≤ x.re ∧ x.re ≤ (P.q:Int)-1))) → ((∀ (x : + GaussianInt), (s < r) → (x ∈ (B 1).1 ↔ (x.im = (r:Int) ∧ 1 ≤ x.re ∧ x.re ≤ (s:Int)) ∨ + (x.re = (s:Int) ∧ (r:Int) ≤ x.im ∧ x.im ≤ (P.q:Int)-1))) → ((∀ (x : GaussianInt), (r < s) + → (x ∈ (B 0).1 ↔ (x.re = (r:Int) ∧ 1 ≤ x.im ∧ x.im ≤ (r:Int)) ∨ (x.im = (r:Int) ∧ 1 ≤ + x.re ∧ x.re ≤ (r:Int)))) → ((∀ (x : GaussianInt), (r < s) → (x ∈ (B 1).1 ↔ (x.re = + (s:Int) ∧ (s:Int) ≤ x.im ∧ x.im ≤ (P.q:Int)-1) ∨ (x.im = (s:Int) ∧ (s:Int) ≤ x.re ∧ x.re + ≤ (P.q:Int)-1))) → (∀ x ∈ (B 0).1, ∀ y ∈ (B 1).1, ¬ FourNeighborAdjacent x y))))) := by + classical + intro P B r s horder memB0Large memB1Large memB0Small memB1Small x hx y hy hadj + rcases horder with hsmall | hlarge + · rw [memB0Small x (by omega)] at hx + rw [memB1Small y (by omega)] at hy + simp only [FourNeighborAdjacent, + ] at hadj + rcases hx with ⟨hxr,hxl,hxh⟩ | ⟨hxi,hxl,hxh⟩ <;> + rcases hy with ⟨hys,hyl,hyh⟩ | ⟨hyi,hyl,hyh⟩ <;> + rcases hadj with h | h | h | h <;> + have hre := congrArg (fun z : GaussianInt => z.re) h <;> + have him := congrArg (fun z : GaussianInt => z.im) h <;> + simp [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_one, Zsqrtd.im_one] at hre him <;> omega + · rw [memB0Large x (by omega)] at hx + rw [memB1Large y (by omega)] at hy + simp only [FourNeighborAdjacent, + ] at hadj + rcases hx with ⟨hxr,hxl,hxh⟩ | ⟨hys,hxl,hxh⟩ <;> + rcases hy with ⟨hyr,hyl,hyh⟩ | ⟨hxs,hyl,hyh⟩ <;> + rcases hadj with h | h | h | h <;> + have hre := congrArg (fun z : GaussianInt => z.re) h <;> + have him := congrArg (fun z : GaussianInt => z.im) h <;> + simp [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_one, Zsqrtd.im_one] at hre him <;> omega + +private theorem natAbsToNat : + ∀ (z : Int), (0 ≤ z) → (z.natAbs = z.toNat) := by + classical + intro z hz + have h₁ := Int.natAbs_of_nonneg hz + have h₂ := Int.toNat_of_nonneg hz + have hn : (z.natAbs : Int) = z.toNat := h₁.trans h₂.symm + exact_mod_cast hn + +private theorem natAbsDist : + (FordFareyParameter) → ((∀ (z : Int), (0 ≤ z) → (z.natAbs = z.toNat)) → (∀ (a : Int), ∀ (b : + Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat)))) := by + classical + intro P natAbsToNat a b ha hb + by_cases hab : a ≤ b + · have habs : (a-b).natAbs = (b-a).toNat := by + have h₁ := Int.natAbs_of_nonneg (a := b-a) (by omega) + have h₂ := Int.toNat_of_nonneg (by omega : 0 ≤ b-a) + have hn : ((b-a).natAbs : Int) = (b-a).toNat := h₁.trans h₂.symm + have hn' : (b-a).natAbs = (b-a).toNat := by exact_mod_cast hn + rw [show a-b = -(b-a) by omega, Int.natAbs_neg] + exact hn' + rw [habs] + have hac : (a.toNat : Int) = a := Int.toNat_of_nonneg ha + have hbc : (b.toNat : Int) = b := Int.toNat_of_nonneg hb + simp [Nat.dist] + omega + · have hba : b ≤ a := by omega + have habs : (a-b).natAbs = (a-b).toNat := natAbsToNat _ (by omega) + rw [habs] + have hac : (a.toNat : Int) = a := Int.toNat_of_nonneg ha + have hbc : (b.toNat : Int) = b := Int.toNat_of_nonneg hb + simp [Nat.dist] + omega + +private theorem distDistDown : + (FordFareyParameter) → (∀ (a : Nat), ∀ (b : Nat), ∀ (c : Nat), (a ≤ c) → ((b ≤ c) → (Nat.dist + (Nat.dist a c) (Nat.dist b c) = Nat.dist a b))) := by + classical + intro P a b c ha hb + simp [Nat.dist] + omega + +private theorem distDistUp : + (FordFareyParameter) → (∀ (a : Nat), ∀ (b : Nat), ∀ (c : Nat), (c ≤ a) → ((c ≤ b) → (Nat.dist + (Nat.dist a c) (Nat.dist b c) = Nat.dist a b))) := by + classical + intro P a b c ha hb + simp [Nat.dist] + omega + +private theorem natDistOneInt : + (FordFareyParameter) → (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → (Nat.dist a.toNat + b.toNat = 1 ↔ a = b+1 ∨ b = a+1))) := by + classical + intro P a b ha hb + have hac : (a.toNat : Int) = a := Int.toNat_of_nonneg ha + have hbc : (b.toNat : Int) = b := Int.toNat_of_nonneg hb + simp [Nat.dist] + omega + +private theorem adjacentVertical : + (FordFareyParameter) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.re = y.re) → + (FourNeighborAdjacent x y ↔ x.im = y.im+1 ∨ y.im = x.im+1)) := by + classical + intro P x y hfix + simp [FourNeighborAdjacent, Zsqrtd.ext_iff, hfix]; omega + +private theorem adjacentHorizontal : + (FordFareyParameter) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im = y.im) → + (FourNeighborAdjacent x y ↔ x.re = y.re+1 ∨ y.re = x.re+1)) := by + classical + intro P x y hfix + simp [FourNeighborAdjacent, Zsqrtd.ext_iff, hfix]; omega + +private theorem lineVertical : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → (Nat.dist a.toNat b.toNat = 1 ↔ a = b+1 ∨ b = + a+1))) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.re = y.re) → + (FourNeighborAdjacent x y ↔ x.im = y.im+1 ∨ y.im = x.im+1)) → (∀ (x : GaussianInt), ∀ (y + : GaussianInt), (x.re = y.re) → ((0 ≤ x.im) → ((0 ≤ y.im) → ((Nat.dist (d x) (d y) = + Nat.dist x.im.toNat y.im.toNat) → (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)))))) := by + classical + intro P B d natDistOneInt adjacentVertical x y hfix hnx hny hlevel + rw [adjacentVertical x y hfix] + constructor + · intro ha + refine ⟨Or.inl hfix, ?_⟩ + rw [hlevel] + exact (natDistOneInt x.im y.im hnx hny).2 ha + · rintro ⟨_, hd⟩ + rw [hlevel] at hd + exact (natDistOneInt x.im y.im hnx hny).1 hd + +private theorem lineHorizontal : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → (Nat.dist a.toNat b.toNat = 1 ↔ a = b+1 ∨ b = + a+1))) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im = y.im) → + (FourNeighborAdjacent x y ↔ x.re = y.re+1 ∨ y.re = x.re+1)) → (∀ (x : GaussianInt), ∀ (y + : GaussianInt), (x.im = y.im) → ((0 ≤ x.re) → ((0 ≤ y.re) → ((Nat.dist (d x) (d y) = + Nat.dist x.re.toNat y.re.toNat) → (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)))))) := by + classical + intro P B d natDistOneInt adjacentHorizontal x y hfix hnx hny hlevel + rw [adjacentHorizontal x y hfix] + constructor + · intro ha + refine ⟨Or.inr hfix, ?_⟩ + rw [hlevel] + exact (natDistOneInt x.re y.re hnx hny).2 ha + · rintro ⟨_, hd⟩ + rw [hlevel] at hd + exact (natDistOneInt x.re y.re hnx hny).1 hd + +private theorem dLarge0Root : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (s < r) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (d x = (x.re-(r:Int)).natAbs + + (x.im-(s:Int)).natAbs)) := by + classical + intro P B d r s hlarge x hx + have hroot : (B 0).2 = (⟨(r:Int),(s:Int)⟩ : GaussianInt) := by + simp [B, P4062T1RemainderPaths, r, s, hlarge] + dsimp [d] + rw [ite_eq_left hx, hroot] + +private theorem dLarge1Root : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (Disjoint (B 0).1 (B 1).1) → ((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = + (x.re-(s:Int)).natAbs + (x.im-(r:Int)).natAbs))) := by + classical + intro P B d r s hdisj hlarge x hx + have hnot : x ∉ (B 0).1 := by + intro hx0 + exact (Finset.disjoint_left.mp hdisj) hx0 hx + have hroot : (B 1).2 = (⟨(s:Int),(r:Int)⟩ : GaussianInt) := by + simp [B, P4062T1RemainderPaths, r, s, hlarge] + dsimp [d] + rw [ite_eq_right hnot, hroot] + +private theorem dSmall0Root : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (r < s) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (d x = (x.re-(r:Int)).natAbs + + (x.im-(r:Int)).natAbs)) := by + classical + intro P B d r s hsmall x hx + have hfalse : ¬ P.q₂ < P.q₁ := by omega + have hroot : (B 0).2 = (⟨(r:Int),(r:Int)⟩ : GaussianInt) := by + simp [B, P4062T1RemainderPaths, r, hfalse] + dsimp [d] + rw [ite_eq_left hx, hroot] + +private theorem dSmall1Root : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (Disjoint (B 0).1 (B 1).1) → ((r < s) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = + (x.re-(s:Int)).natAbs + (x.im-(s:Int)).natAbs))) := by + classical + intro P B d r s hdisj hsmall x hx + have hnot : x ∉ (B 0).1 := by + intro hx0 + exact (Finset.disjoint_left.mp hdisj) hx0 hx + have hfalse : ¬ P.q₂ < P.q₁ := by omega + have hroot : (B 1).2 = (⟨(s:Int),(s:Int)⟩ : GaussianInt) := by + simp [B, P4062T1RemainderPaths, s, hfalse] + dsimp [d] + rw [ite_eq_right hnot, hroot] + +private theorem dLarge0V : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → + (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (d x = (x.re-(r:Int)).natAbs + + (x.im-(s:Int)).natAbs))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → ((x.re = + (r:Int)) → ((0 ≤ x.im) → ((x.im ≤ (s:Int)) → (d x = Nat.dist x.im.toNat s))))))) := by + classical + intro P B d r s natAbsDist dLarge0Root hlarge x hx hcoord hpos hbound + rw [dLarge0Root hlarge x hx, hcoord] + simp only [sub_self, Int.natAbs_zero, zero_add] + simpa using (natAbsDist x.im (s:Int) hpos (by exact_mod_cast (Nat.zero_le s))) + +private theorem dLarge0H : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → + (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (d x = (x.re-(r:Int)).natAbs + + (x.im-(s:Int)).natAbs))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → ((x.im = + (s:Int)) → ((0 ≤ x.re) → (((r:Int) ≤ x.re) → (d x = Nat.dist x.re.toNat r))))))) := by + classical + intro P B d r s natAbsDist dLarge0Root hlarge x hx hcoord hpos hbound + rw [dLarge0Root hlarge x hx, hcoord] + simp only [sub_self, Int.natAbs_zero, add_zero] + simpa using (natAbsDist x.re (r:Int) hpos (by exact_mod_cast (Nat.zero_le r))) + +private theorem dLarge1V : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → + (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = (x.re-(s:Int)).natAbs + + (x.im-(r:Int)).natAbs))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → ((x.im = + (r:Int)) → ((0 ≤ x.re) → ((x.re ≤ (s:Int)) → (d x = Nat.dist x.re.toNat s))))))) := by + classical + intro P B d r s natAbsDist dLarge1Root hlarge x hx hcoord hpos hbound + rw [dLarge1Root hlarge x hx, hcoord] + simp only [sub_self, Int.natAbs_zero] + simpa using (natAbsDist x.re (s:Int) hpos (by exact_mod_cast (Nat.zero_le s))) + +private theorem dLarge1H : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → + (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = (x.re-(s:Int)).natAbs + + (x.im-(r:Int)).natAbs))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → ((x.re = + (s:Int)) → ((0 ≤ x.im) → (((r:Int) ≤ x.im) → (d x = Nat.dist x.im.toNat r))))))) := by + classical + intro P B d r s natAbsDist dLarge1Root hlarge x hx hcoord hpos hbound + rw [dLarge1Root hlarge x hx, hcoord] + simp only [sub_self, Int.natAbs_zero] + simpa using (natAbsDist x.im (r:Int) hpos (by exact_mod_cast (Nat.zero_le r))) + +private theorem dSmall0V : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → + (((r < s) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (d x = (x.re-(r:Int)).natAbs + + (x.im-(r:Int)).natAbs))) → ((r < s) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → ((x.re = + (r:Int)) → ((0 ≤ x.im) → ((x.im ≤ (r:Int)) → (d x = Nat.dist x.im.toNat r))))))) := by + classical + intro P B d r s natAbsDist dSmall0Root hsmall x hx hcoord hpos hbound + rw [dSmall0Root hsmall x hx, hcoord] + simp only [sub_self, Int.natAbs_zero, zero_add] + simpa using (natAbsDist x.im (r:Int) hpos (by exact_mod_cast (Nat.zero_le r))) + +private theorem dSmall0H : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → + (((r < s) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (d x = (x.re-(r:Int)).natAbs + + (x.im-(r:Int)).natAbs))) → ((r < s) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → ((x.im = + (r:Int)) → ((0 ≤ x.re) → ((x.re ≤ (r:Int)) → (d x = Nat.dist x.re.toNat r))))))) := by + classical + intro P B d r s natAbsDist dSmall0Root hsmall x hx hcoord hpos hbound + rw [dSmall0Root hsmall x hx, hcoord] + simp only [sub_self, Int.natAbs_zero, add_zero] + simpa using (natAbsDist x.re (r:Int) hpos (by exact_mod_cast (Nat.zero_le r))) + +private theorem dSmall1V : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → + (((r < s) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = (x.re-(s:Int)).natAbs + + (x.im-(s:Int)).natAbs))) → ((r < s) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → ((x.re = + (s:Int)) → ((0 ≤ x.im) → (((s:Int) ≤ x.im) → (d x = Nat.dist x.im.toNat s))))))) := by + classical + intro P B d r s natAbsDist dSmall1Root hsmall x hx hcoord hpos hbound + rw [dSmall1Root hsmall x hx, hcoord] + simp only [sub_self, Int.natAbs_zero, zero_add] + simpa using (natAbsDist x.im (s:Int) hpos (by exact_mod_cast (Nat.zero_le s))) + +private theorem dSmall1H : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → + (((r < s) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = (x.re-(s:Int)).natAbs + + (x.im-(s:Int)).natAbs))) → ((r < s) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → ((x.im = + (s:Int)) → ((0 ≤ x.re) → (((s:Int) ≤ x.re) → (d x = Nat.dist x.re.toNat s))))))) := by + classical + intro P B d r s natAbsDist dSmall1Root hsmall x hx hcoord hpos hbound + rw [dSmall1Root hsmall x hx, hcoord] + simp only [sub_self, Int.natAbs_zero, add_zero] + simpa using (natAbsDist x.re (s:Int) hpos (by exact_mod_cast (Nat.zero_le s))) + +private theorem dLarge0Nat : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (P.q = P.q₁ + P.q₂) → ((0 < s) → ((0 < r) → ((∀ (x : GaussianInt), (s < r) → (x ∈ (B 0).1 ↔ + (x.re = (r:Int) ∧ 1 ≤ x.im ∧ x.im ≤ (s:Int)) ∨ (x.im = (s:Int) ∧ (r:Int) ≤ x.re ∧ x.re ≤ + (P.q:Int)-1))) → ((∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = + Nat.dist a.toNat b.toNat))) → (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (d x = + (x.re-(r:Int)).natAbs + (x.im-(s:Int)).natAbs))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ + (B 0).1) → (d x = Nat.dist x.re.toNat r + Nat.dist x.im.toNat s)))))))) := by + classical + intro P B d r s hsum hs hr memB0Large natAbsDist dLarge0Root hlarge x hx + rw [dLarge0Root hlarge x hx] + have hxchar := (memB0Large x hlarge).mp hx + have hre := natAbsDist x.re (r:Int) (by rcases hxchar with h | h <;> omega) + (by exact_mod_cast (Nat.zero_le r)) + have him := natAbsDist x.im (s:Int) (by rcases hxchar with h | h <;> omega) + (by exact_mod_cast (Nat.zero_le s)) + simpa using congrArg₂ (· + ·) hre him + +private theorem dLarge1Nat : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (0 < s) → ((0 < r) → ((∀ (x : GaussianInt), (s < r) → (x ∈ (B 1).1 ↔ (x.im = (r:Int) ∧ 1 ≤ + x.re ∧ x.re ≤ (s:Int)) ∨ (x.re = (s:Int) ∧ (r:Int) ≤ x.im ∧ x.im ≤ (P.q:Int)-1))) → ((∀ + (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) + → (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = (x.re-(s:Int)).natAbs + + (x.im-(r:Int)).natAbs))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = + Nat.dist x.re.toNat s + Nat.dist x.im.toNat r))))))) := by + classical + intro P B d r s hs hr memB1Large natAbsDist dLarge1Root hlarge x hx + rw [dLarge1Root hlarge x hx] + have hxchar := (memB1Large x hlarge).mp hx + have hre := natAbsDist x.re (s:Int) (by rcases hxchar with h | h <;> omega) + (by exact_mod_cast (Nat.zero_le s)) + have him := natAbsDist x.im (r:Int) (by rcases hxchar with h | h <;> omega) + (by exact_mod_cast (Nat.zero_le r)) + simpa using congrArg₂ (· + ·) hre him + +private theorem dSmall0Nat : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (0 < r) → ((∀ (x : GaussianInt), (r < s) → (x ∈ (B 0).1 ↔ (x.re = (r:Int) ∧ 1 ≤ x.im ∧ x.im ≤ + (r:Int)) ∨ (x.im = (r:Int) ∧ 1 ≤ x.re ∧ x.re ≤ (r:Int)))) → ((∀ (a : Int), ∀ (b : Int), + (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → (((r < s) → (∀ (x + : GaussianInt), (x ∈ (B 0).1) → (d x = (x.re-(r:Int)).natAbs + + (x.im-(r:Int)).natAbs))) → + ((r < s) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (d x = Nat.dist x.re.toNat r + Nat.dist + x.im.toNat r)))))) := by + classical + intro P B d r s hr memB0Small natAbsDist dSmall0Root hsmall x hx + rw [dSmall0Root hsmall x hx] + have hxchar := (memB0Small x hsmall).mp hx + have hre := natAbsDist x.re (r:Int) (by rcases hxchar with h | h <;> omega) + (by exact_mod_cast (Nat.zero_le r)) + have him := natAbsDist x.im (r:Int) (by rcases hxchar with h | h <;> omega) + (by exact_mod_cast (Nat.zero_le r)) + simpa using congrArg₂ (· + ·) hre him + +private theorem dSmall1Nat : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (P.q = P.q₁ + P.q₂) → ((0 < s) → ((∀ (x : GaussianInt), (r < s) → (x ∈ (B 1).1 ↔ (x.re = + (s:Int) ∧ (s:Int) ≤ x.im ∧ x.im ≤ (P.q:Int)-1) ∨ (x.im = (s:Int) ∧ (s:Int) ≤ x.re ∧ x.re + ≤ (P.q:Int)-1))) → ((∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = + Nat.dist a.toNat b.toNat))) → (((r < s) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = + (x.re-(s:Int)).natAbs + (x.im-(s:Int)).natAbs))) → ((r < s) → (∀ (x : GaussianInt), (x ∈ + (B 1).1) → (d x = Nat.dist x.re.toNat s + Nat.dist x.im.toNat s))))))) := by + classical + intro P B d r s hsum hs memB1Small natAbsDist dSmall1Root hsmall x hx + rw [dSmall1Root hsmall x hx] + have hxchar := (memB1Small x hsmall).mp hx + have hre := natAbsDist x.re (s:Int) (by rcases hxchar with h | h <;> omega) + (by exact_mod_cast (Nat.zero_le s)) + have him := natAbsDist x.im (s:Int) (by rcases hxchar with h | h <;> omega) + (by exact_mod_cast (Nat.zero_le s)) + simpa using congrArg₂ (· + ·) hre him + +private theorem adjacentCoordinates : + ∀ (x : GaussianInt), ∀ (y : GaussianInt), (FourNeighborAdjacent x y) → (x.re = y.re ∨ x.im = + y.im) := by + classical + intro x y ha + rcases ha with h | h | h | h + · right + have him := congrArg (fun z : GaussianInt => z.im) h + simpa only [Zsqrtd.im_add, Zsqrtd.im_one, Zsqrtd.im_zero, add_zero] using him.symm + · right + have him := congrArg (fun z : GaussianInt => z.im) h + simpa only [Zsqrtd.im_sub, Zsqrtd.im_one, Zsqrtd.im_zero, sub_zero] using him.symm + · left + have hre := congrArg (fun z : GaussianInt => z.re) h + simpa only [Zsqrtd.re_add, Zsqrtd.re_zero, add_zero] using hre.symm + · left + have hre := congrArg (fun z : GaussianInt => z.re) h + simpa only [Zsqrtd.re_sub, Zsqrtd.re_zero, sub_zero] using hre.symm + +private theorem adjacentSymm : + ∀ {x : GaussianInt}, ∀ {y : GaussianInt}, (FourNeighborAdjacent x y) → (FourNeighborAdjacent + y x) := by + classical + intro x y ha + rcases ha with ha | ha | ha | ha + · right; left; rw [ha]; simp + · left; rw [ha]; simp + · right; right; right; rw [ha]; simp + · right; right; left; rw [ha]; simp + +private theorem cornerVH : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + (∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.re = y.re) → ((0 ≤ x.im) → ((0 ≤ y.im) → + ((Nat.dist (d x) (d y) = Nat.dist x.im.toNat y.im.toNat) → (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1))))) → ((∀ (x : GaussianInt), ∀ (y + : GaussianInt), (x.im = y.im) → ((0 ≤ x.re) → ((0 ≤ y.re) → ((Nat.dist (d x) (d y) = + Nat.dist x.re.toNat y.re.toNat) → (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) + ∧ Nat.dist (d x) (d y) = 1))))) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), + (FourNeighborAdjacent x y) → (x.re = y.re ∨ x.im = y.im)) → (∀ (a : Nat), ∀ (b : + Nat), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.re = (a:Int)) → ((y.im = (b:Int)) + → ((d x = + Nat.dist x.im.toNat b) → ((d y = Nat.dist y.re.toNat a) → ((0 ≤ x.re) → ((0 ≤ x.im) → ((0 + ≤ y.re) → ((0 ≤ y.im) → (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1))))))))))) := by + classical + intro P B d lineVertical lineHorizontal adjacentCoordinates a b x y hxr hyi dVx dHy hxre hxim + hyre hyim + by_cases hR : x.re = y.re + · have hyreRoot : y.re = (a:Int) := by omega + have hcastY : y.re.toNat = a := by + have hcast : (y.re.toNat : Int) = (a:Int) := by + rw [Int.toNat_of_nonneg hyre, hyreRoot] + exact_mod_cast hcast + have hyimRoot : y.im.toNat = b := by + have hcast : (y.im.toNat : Int) = (b:Int) := by + rw [Int.toNat_of_nonneg hyim, hyi] + exact_mod_cast hcast + have hlevel : Nat.dist (d x) (d y) = Nat.dist x.im.toNat y.im.toNat := by + rw [dVx, dHy, hcastY, hyimRoot] + simp [Nat.dist] + exact lineVertical x y hR hxim hyim hlevel + · by_cases hI : x.im = y.im + · have hximRoot : x.im.toNat = b := by + have hroot : x.im = (b:Int) := by omega + have hcast : (x.im.toNat : Int) = (b:Int) := by + rw [Int.toNat_of_nonneg hxim, hroot] + exact_mod_cast hcast + have hxreRoot : x.re.toNat = a := by + have hcast : (x.re.toNat : Int) = (a:Int) := by + rw [Int.toNat_of_nonneg hxre, hxr] + exact_mod_cast hcast + have hlevel : Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat := by + rw [dVx, dHy, hximRoot, hxreRoot] + simp [Nat.dist]; omega + exact lineHorizontal x y hI hxre hyre hlevel + · have hcoord : ¬ (x.re = y.re ∨ x.im = y.im) := by simp [hR, hI] + have hadj : ¬ FourNeighborAdjacent x y := by + intro h + exact hcoord (adjacentCoordinates x y h) + constructor + · intro h + exact False.elim (hadj h) + · intro h + exact False.elim (hcoord h.1) + +private theorem cornerHV : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + (∀ {x : GaussianInt}, ∀ {y : GaussianInt}, (FourNeighborAdjacent x y) → (FourNeighborAdjacent + y x)) → ((∀ (a : Nat), ∀ (b : Nat), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.re = + (a:Int)) → ((y.im = (b:Int)) → ((d x = Nat.dist x.im.toNat b) → ((d y = Nat.dist + y.re.toNat a) → ((0 ≤ x.re) → ((0 ≤ x.im) → ((0 ≤ y.re) → ((0 ≤ y.im) → + (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = + 1))))))))) → (∀ (a : Nat), ∀ (b : Nat), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im = + (b:Int)) → ((y.re = (a:Int)) → ((d x = Nat.dist x.re.toNat a) → ((d y = Nat.dist + y.im.toNat b) → ((0 ≤ x.re) → ((0 ≤ x.im) → ((0 ≤ y.re) → ((0 ≤ y.im) → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)))))))))) := by + classical + intro P B d adjacentSymm cornerVH a b x y hxi hyr dHx dVy hxre hxim hyre hyim + have h := cornerVH a b y x hyr hxi dVy dHx hyre hyim hxre hxim + constructor + · intro hadj + have hrhs := h.mp (adjacentSymm hadj) + refine ⟨?_, ?_⟩ + · rcases hrhs.1 with hh | hh + · exact Or.inl hh.symm + · exact Or.inr hh.symm + · exact (Nat.dist_comm _ _).trans hrhs.2 + · rintro ⟨hcoord, hdist⟩ + have hcoord' : y.re = x.re ∨ y.im = x.im := by + rcases hcoord with hh | hh + · exact Or.inl hh.symm + · exact Or.inr hh.symm + have hdist' : Nat.dist (d y) (d x) = 1 := by + exact (Nat.dist_comm _ _).symm.trans hdist + exact adjacentSymm (h.mpr ⟨hcoord', hdist'⟩) + +end PathGeometryProof + +namespace PathAdjacencyProof + +private theorem smallZeroNeighbors : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + ((0 : ℕ) < P.q₁) → ((∀ (x : GaussianInt), r < s → (x ∈ (P4062T1RemainderPaths P (0 : Fin (2 + : ℕ))).1 ↔ x.re = (↑P.q₁ : ℤ) ∧ (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₁ : ℤ) ∨ x.im = (↑P.q₁ : ℤ) + ∧ (1 : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q₁ : ℤ))) → ((∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), a ≤ c → b ≤ + c → (a.dist c).dist (b.dist c) = a.dist b) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), + (x.re = y.re) → ((0 ≤ x.im) → ((0 ≤ y.im) → ((Nat.dist (d x) (d y) = Nat.dist x.im.toNat + y.im.toNat) → (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d + y) = 1))))) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im = y.im) → ((0 ≤ x.re) → + ((0 ≤ y.re) → ((Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat) → + (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1))))) → + (((r < s) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → ((x.re = (r:Int)) → ((0 ≤ x.im) → + ((x.im ≤ (r:Int)) → (d x = Nat.dist x.im.toNat r)))))) → (((r < s) → (∀ (x : + GaussianInt), (x ∈ (B 0).1) → ((x.im = (r:Int)) → ((0 ≤ x.re) → ((x.re ≤ (r:Int)) → (d x + = Nat.dist x.re.toNat r)))))) → ((∀ (a : Nat), ∀ (b : Nat), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), (x.re = (a:Int)) → ((y.im = (b:Int)) → ((d x = Nat.dist x.im.toNat b) → ((d + y = Nat.dist y.re.toNat a) → ((0 ≤ x.re) → ((0 ≤ x.im) → ((0 ≤ y.re) → ((0 ≤ y.im) → + (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = + 1))))))))) → ((∀ (a : Nat), ∀ (b : Nat), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im + = (b:Int)) → ((y.re = (a:Int)) → ((d x = Nat.dist x.re.toNat a) → ((d y = Nat.dist + y.im.toNat b) → ((0 ≤ x.re) → ((0 ≤ x.im) → ((0 ≤ y.re) → ((0 ≤ y.im) → + (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = + 1))))))))) → ((r < s) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (∀ (y : GaussianInt), (y ∈ + (B 0).1) → (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)))))))))))) := by + classical + intro P B d r s hr memB0Small distDistDown lineVertical lineHorizontal dSmall0V dSmall0H + cornerVH cornerHV hsmall x hx y hy + have hxB : x ∈ (B 0).1 := by simpa using hx + have hyB : y ∈ (B 0).1 := by simpa using hy + have hxChar := (memB0Small x hsmall).mp hxB + have hyChar := (memB0Small y hsmall).mp hyB + rcases hxChar with hxV | hxH + · rcases hyChar with hyV | hyH + · rcases hxV with ⟨hxr,hxlo,hxhi⟩ + rcases hyV with ⟨hyr,hylo,hyhi⟩ + have dx := dSmall0V hsmall x hxB hxr (by omega) hxhi + have dy := dSmall0V hsmall y hyB hyr (by omega) hyhi + have hxn : x.im.toNat ≤ r := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ x.im) + omega + have hyn : y.im.toNat ≤ r := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ y.im) + omega + have hlevel : Nat.dist (d x) (d y) = Nat.dist x.im.toNat y.im.toNat := by + rw [dx, dy] + exact distDistDown _ _ _ hxn hyn + exact lineVertical x y (by omega) (by omega) (by omega) hlevel + · rcases hxV with ⟨hxr,hxlo,hxhi⟩ + rcases hyH with ⟨hyi,hylo,hyhi⟩ + have dx := dSmall0V hsmall x hxB hxr (by omega) hxhi + have dy := dSmall0H hsmall y hyB hyi (by omega) hyhi + exact cornerVH r r x y hxr hyi dx dy (by omega) (by omega) (by omega) (by omega) + · rcases hyChar with hyV | hyH + · rcases hxH with ⟨hxi,hxlo,hxhi⟩ + rcases hyV with ⟨hyr,hylo,hyhi⟩ + have dx := dSmall0H hsmall x hxB hxi (by omega) hxhi + have dy := dSmall0V hsmall y hyB hyr (by omega) hyhi + exact cornerHV r r x y hxi hyr dx dy (by omega) (by omega) (by omega) (by omega) + · rcases hxH with ⟨hxi,hxlo,hxhi⟩ + rcases hyH with ⟨hyi,hylo,hyhi⟩ + have dx := dSmall0H hsmall x hxB hxi (by omega) hxhi + have dy := dSmall0H hsmall y hyB hyi (by omega) hyhi + have hxn : x.re.toNat ≤ r := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ x.re) + omega + have hyn : y.re.toNat ≤ r := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ y.re) + omega + have hlevel : Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat := by + rw [dx, dy] + exact distDistDown _ _ _ hxn hyn + exact lineHorizontal x y (by omega) (by omega) (by omega) hlevel + +private theorem smallOneNeighbors : + ∀ (P : FordFareyParameter), + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (P.q = P.q₁ + P.q₂) → ((have s := P.q₂; (0 : ℕ) < s) → ((∀ (x : GaussianInt), r < s → (x ∈ + (P4062T1RemainderPaths P (1 : Fin (2 : ℕ))).1 ↔ x.re = (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ x.im + ∧ x.im ≤ (↑P.q : ℤ) - (1 : ℤ) ∨ x.im = (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q : + ℤ) - (1 : ℤ))) → ((∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), c ≤ a → c ≤ b → (a.dist c).dist + (b.dist c) = a.dist b) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.re = y.re) → ((0 + ≤ x.im) → ((0 ≤ y.im) → ((Nat.dist (d x) (d y) = Nat.dist x.im.toNat y.im.toNat) → + (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1))))) → + ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im = y.im) → ((0 ≤ x.re) → ((0 ≤ y.re) → + ((Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat) → (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1))))) → (((r < s) → (∀ (x : + GaussianInt), (x ∈ (B 1).1) → ((x.re = (s:Int)) → ((0 ≤ x.im) → (((s:Int) ≤ x.im) → (d x + = Nat.dist x.im.toNat s)))))) → (((r < s) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → ((x.im + = (s:Int)) → ((0 ≤ x.re) → (((s:Int) ≤ x.re) → (d x = Nat.dist x.re.toNat s)))))) → ((∀ + (a : Nat), ∀ (b : Nat), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.re = (a:Int)) → + ((y.im = (b:Int)) → ((d x = Nat.dist x.im.toNat b) → ((d y = Nat.dist y.re.toNat a) → ((0 + ≤ x.re) → ((0 ≤ x.im) → ((0 ≤ y.re) → ((0 ≤ y.im) → (FourNeighborAdjacent x y ↔ (x.re = + y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1))))))))) → ((∀ (a : Nat), ∀ (b : Nat), ∀ + (x : GaussianInt), ∀ (y : GaussianInt), (x.im = (b:Int)) → ((y.re = (a:Int)) → ((d x = + Nat.dist x.re.toNat a) → ((d y = Nat.dist y.im.toNat b) → ((0 ≤ x.re) → ((0 ≤ x.im) → ((0 + ≤ y.re) → ((0 ≤ y.im) → (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ + Nat.dist (d x) (d y) = 1))))))))) → ((r < s) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (∀ + (y : GaussianInt), (y ∈ (B 1).1) → (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1))))))))))))) := by + classical + intro P B d r s hsum hs memB1Small distDistUp lineVertical lineHorizontal dSmall1V dSmall1H + cornerVH cornerHV hsmall x hx y hy + have hxB : x ∈ (B 1).1 := by simpa using hx + have hyB : y ∈ (B 1).1 := by simpa using hy + have hxChar := (memB1Small x hsmall).mp hxB + have hyChar := (memB1Small y hsmall).mp hyB + rcases hxChar with hxV | hxH + · rcases hyChar with hyV | hyH + · rcases hxV with ⟨hxr,hxlo,hxhi⟩ + rcases hyV with ⟨hyr,hylo,hyhi⟩ + have dx := dSmall1V hsmall x hxB hxr (by omega) hxlo + have dy := dSmall1V hsmall y hyB hyr (by omega) hylo + have hxn : s ≤ x.im.toNat := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ x.im) + omega + have hyn : s ≤ y.im.toNat := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ y.im) + omega + have hlevel : Nat.dist (d x) (d y) = Nat.dist x.im.toNat y.im.toNat := by + rw [dx, dy] + exact distDistUp _ _ _ hxn hyn + exact lineVertical x y (by omega) (by omega) (by omega) hlevel + · rcases hxV with ⟨hxr,hxlo,hxhi⟩ + rcases hyH with ⟨hyi,hylo,hyhi⟩ + have dx := dSmall1V hsmall x hxB hxr (by omega) hxlo + have dy := dSmall1H hsmall y hyB hyi (by omega) hylo + exact cornerVH s s x y hxr hyi dx dy (by omega) (by omega) (by omega) (by omega) + · rcases hyChar with hyV | hyH + · rcases hxH with ⟨hxi,hxlo,hxhi⟩ + rcases hyV with ⟨hyr,hylo,hyhi⟩ + have dx := dSmall1H hsmall x hxB hxi (by omega) hxlo + have dy := dSmall1V hsmall y hyB hyr (by omega) hylo + exact cornerHV s s x y hxi hyr dx dy (by omega) (by omega) (by omega) (by omega) + · rcases hxH with ⟨hxi,hxlo,hxhi⟩ + rcases hyH with ⟨hyi,hylo,hyhi⟩ + have dx := dSmall1H hsmall x hxB hxi (by omega) hxlo + have dy := dSmall1H hsmall y hyB hyi (by omega) hylo + have hxn : s ≤ x.re.toNat := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ x.re) + omega + have hyn : s ≤ y.re.toNat := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ y.re) + omega + have hlevel : Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat := by + rw [dx, dy] + exact distDistUp _ _ _ hxn hyn + exact lineHorizontal x y (by omega) (by omega) (by omega) hlevel + +private theorem largeZeroNeighbors : + ∀ (P : FordFareyParameter), (2 < P.q) → ( + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (P.q = P.q₁ + P.q₂) → ((have s := P.q₂; (0 : ℕ) < s) → (((0 : ℕ) < P.q₁) → ((∀ (x : + GaussianInt), s < r → (x ∈ (P4062T1RemainderPaths P (0 : Fin (2 : ℕ))).1 ↔ x.re = + (↑P.q₁ : ℤ) ∧ (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₂ : ℤ) ∨ x.im = (↑P.q₂ : ℤ) ∧ (↑P.q₁ : ℤ) ≤ + x.re ∧ x.re ≤ (↑P.q : ℤ) - (1 : ℤ))) → ((∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), a ≤ c → b ≤ c → + (a.dist c).dist (b.dist c) = a.dist b) → ((∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), c ≤ a → c ≤ b + → (a.dist c).dist (b.dist c) = a.dist b) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), + (x.re = y.re) → ((0 ≤ x.im) → ((0 ≤ y.im) → ((Nat.dist (d x) (d y) = Nat.dist x.im.toNat + y.im.toNat) → (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d + y) = 1))))) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im = y.im) → ((0 ≤ x.re) → + ((0 ≤ y.re) → ((Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat) → + (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1))))) → + (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → ((x.re = (r:Int)) → ((0 ≤ x.im) → + ((x.im ≤ (s:Int)) → (d x = Nat.dist x.im.toNat s)))))) → (((s < r) → (∀ (x : + GaussianInt), (x ∈ (B 0).1) → ((x.im = (s:Int)) → ((0 ≤ x.re) → (((r:Int) ≤ x.re) → (d x + = Nat.dist x.re.toNat r)))))) → ((∀ (a : Nat), ∀ (b : Nat), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), (x.re = (a:Int)) → ((y.im = (b:Int)) → ((d x = Nat.dist x.im.toNat b) → ((d + y = Nat.dist y.re.toNat a) → ((0 ≤ x.re) → ((0 ≤ x.im) → ((0 ≤ y.re) → ((0 ≤ y.im) → + (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = + 1))))))))) → ((∀ (a : Nat), ∀ (b : Nat), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im + = (b:Int)) → ((y.re = (a:Int)) → ((d x = Nat.dist x.re.toNat a) → ((d y = Nat.dist + y.im.toNat b) → ((0 ≤ x.re) → ((0 ≤ x.im) → ((0 ≤ y.re) → ((0 ≤ y.im) → + (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = + 1))))))))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (∀ (y : GaussianInt), (y ∈ + (B 0).1) → (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)))))))))))))))) := by + classical + intro P hP B d r s hsum hs hr memB0Large distDistDown distDistUp lineVertical lineHorizontal + dLarge0V dLarge0H cornerVH cornerHV hlarge x hx y hy + have hxB : x ∈ (B 0).1 := by simpa using hx + have hyB : y ∈ (B 0).1 := by simpa using hy + have hxChar := (memB0Large x hlarge).mp hxB + have hyChar := (memB0Large y hlarge).mp hyB + rcases hxChar with hxV | hxH + · rcases hyChar with hyV | hyH + · rcases hxV with ⟨hxr,hxlo,hxhi⟩ + rcases hyV with ⟨hyr,hylo,hyhi⟩ + have dx := dLarge0V hlarge x hxB hxr (by omega) hxhi + have dy := dLarge0V hlarge y hyB hyr (by omega) hyhi + have hxn : x.im.toNat ≤ s := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ x.im) + omega + have hyn : y.im.toNat ≤ s := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ y.im) + omega + have hlevel : Nat.dist (d x) (d y) = Nat.dist x.im.toNat y.im.toNat := by + rw [dx, dy] + exact distDistDown _ _ _ hxn hyn + exact lineVertical x y (by omega) (by omega) (by omega) hlevel + · rcases hxV with ⟨hxr,hxlo,hxhi⟩ + rcases hyH with ⟨hyi,hylo,hyhi⟩ + have dx := dLarge0V hlarge x hxB hxr (by omega) hxhi + have dy := dLarge0H hlarge y hyB hyi (by omega) hylo + exact cornerVH r s x y hxr hyi dx dy (by omega) (by omega) (by omega) (by omega) + · rcases hyChar with hyV | hyH + · rcases hxH with ⟨hxi,hxlo,hxhi⟩ + rcases hyV with ⟨hyr,hylo,hyhi⟩ + have dx := dLarge0H hlarge x hxB hxi (by omega) hxlo + have dy := dLarge0V hlarge y hyB hyr (by omega) hyhi + exact cornerHV r s x y hxi hyr dx dy (by omega) (by omega) (by omega) (by omega) + · rcases hxH with ⟨hxi,hxlo,hxhi⟩ + rcases hyH with ⟨hyi,hylo,hyhi⟩ + have dx := dLarge0H hlarge x hxB hxi (by omega) hxlo + have dy := dLarge0H hlarge y hyB hyi (by omega) hylo + have hxn : r ≤ x.re.toNat := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ x.re) + omega + have hyn : r ≤ y.re.toNat := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ y.re) + omega + have hlevel : Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat := by + rw [dx, dy] + exact distDistUp _ _ _ hxn hyn + exact lineHorizontal x y (by omega) (by omega) (by omega) hlevel + +private theorem largeOneNeighbors : + ∀ (P : FordFareyParameter), (2 < P.q) → ( + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + let r := P.q₁ + let s := P.q₂ + (P.q = P.q₁ + P.q₂) → ((have s := P.q₂; (0 : ℕ) < s) → (((0 : ℕ) < P.q₁) → ((∀ (x : + GaussianInt), s < r → (x ∈ (P4062T1RemainderPaths P (1 : Fin (2 : ℕ))).1 ↔ x.im = + (↑P.q₁ : ℤ) ∧ (1 : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q₂ : ℤ) ∨ x.re = (↑P.q₂ : ℤ) ∧ (↑P.q₁ : ℤ) ≤ + x.im ∧ x.im ≤ (↑P.q : ℤ) - (1 : ℤ))) → ((∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), a ≤ c → b ≤ c → + (a.dist c).dist (b.dist c) = a.dist b) → ((∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), c ≤ a → c ≤ b + → (a.dist c).dist (b.dist c) = a.dist b) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), + (x.re = y.re) → ((0 ≤ x.im) → ((0 ≤ y.im) → ((Nat.dist (d x) (d y) = Nat.dist x.im.toNat + y.im.toNat) → (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d + y) = 1))))) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im = y.im) → ((0 ≤ x.re) → + ((0 ≤ y.re) → ((Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat) → + (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1))))) → + (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → ((x.im = (r:Int)) → ((0 ≤ x.re) → + ((x.re ≤ (s:Int)) → (d x = Nat.dist x.re.toNat s)))))) → (((s < r) → (∀ (x : + GaussianInt), (x ∈ (B 1).1) → ((x.re = (s:Int)) → ((0 ≤ x.im) → (((r:Int) ≤ x.im) → (d x + = Nat.dist x.im.toNat r)))))) → ((∀ (a : Nat), ∀ (b : Nat), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), (x.re = (a:Int)) → ((y.im = (b:Int)) → ((d x = Nat.dist x.im.toNat b) → ((d + y = Nat.dist y.re.toNat a) → ((0 ≤ x.re) → ((0 ≤ x.im) → ((0 ≤ y.re) → ((0 ≤ y.im) → + (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = + 1))))))))) → ((∀ (a : Nat), ∀ (b : Nat), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im + = (b:Int)) → ((y.re = (a:Int)) → ((d x = Nat.dist x.re.toNat a) → ((d y = Nat.dist + y.im.toNat b) → ((0 ≤ x.re) → ((0 ≤ x.im) → ((0 ≤ y.re) → ((0 ≤ y.im) → + (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = + 1))))))))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (∀ (y : GaussianInt), (y ∈ + (B 1).1) → (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)))))))))))))))) := by + classical + intro P hP B d r s hsum hs hr memB1Large distDistDown distDistUp lineVertical lineHorizontal + dLarge1V dLarge1H cornerVH cornerHV hlarge x hx y hy + have hxB : x ∈ (B 1).1 := by simpa using hx + have hyB : y ∈ (B 1).1 := by simpa using hy + have hxChar := (memB1Large x hlarge).mp hxB + have hyChar := (memB1Large y hlarge).mp hyB + rcases hxChar with hxV | hxH + · rcases hyChar with hyV | hyH + · rcases hxV with ⟨hxi,hxlo,hxhi⟩ + rcases hyV with ⟨hyi,hylo,hyhi⟩ + have dx := dLarge1V hlarge x hxB hxi (by omega) hxhi + have dy := dLarge1V hlarge y hyB hyi (by omega) hyhi + have hxn : x.re.toNat ≤ s := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ x.re) + omega + have hyn : y.re.toNat ≤ s := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ y.re) + omega + have hlevel : Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat := by + rw [dx, dy] + exact distDistDown _ _ _ hxn hyn + exact lineHorizontal x y (by omega) (by omega) (by omega) hlevel + · rcases hxV with ⟨hxi,hxlo,hxhi⟩ + rcases hyH with ⟨hyr,hylo,hyhi⟩ + have dx := dLarge1V hlarge x hxB hxi (by omega) hxhi + have dy := dLarge1H hlarge y hyB hyr (by omega) hylo + exact cornerHV s r x y hxi hyr dx dy (by omega) (by omega) (by omega) (by omega) + · rcases hyChar with hyV | hyH + · rcases hxH with ⟨hxr,hxlo,hxhi⟩ + rcases hyV with ⟨hyi,hylo,hyhi⟩ + have dx := dLarge1H hlarge x hxB hxr (by omega) hxlo + have dy := dLarge1V hlarge y hyB hyi (by omega) hyhi + exact cornerVH s r x y hxr hyi dx dy (by omega) (by omega) (by omega) (by omega) + · rcases hxH with ⟨hxr,hxlo,hxhi⟩ + rcases hyH with ⟨hyr,hylo,hyhi⟩ + have dx := dLarge1H hlarge x hxB hxr (by omega) hxlo + have dy := dLarge1H hlarge y hyB hyr (by omega) hylo + have hxn : r ≤ x.im.toNat := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ x.im) + omega + have hyn : r ≤ y.im.toNat := by + have hc := Int.toNat_of_nonneg (by omega : 0 ≤ y.im) + omega + have hlevel : Nat.dist (d x) (d y) = Nat.dist x.im.toNat y.im.toNat := by + rw [dx, dy] + exact distDistUp _ _ _ hxn hyn + exact lineVertical x y (by omega) (by omega) (by omega) hlevel + +end PathAdjacencyProof + +theorem P4112T1PathGeometry (P : FordFareyParameter) (hP : 2 < P.q) : + let A := P4062T1RecursiveInteriors P + let E := (A 0 ∪ A 1) ∪ (A 2 ∪ A 3) + let W := P4062T1InteriorSquare P.q \ E + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + W = (B 0).1 ∪ (B 1).1 ∧ Disjoint (B 0).1 (B 1).1 ∧ + (∀ x ∈ (B 0).1, ∀ y ∈ (B 1).1, ¬ FourNeighborAdjacent x y) ∧ + (∀ j, ∀ x ∈ (B j).1, ∀ y ∈ (B j).1, + FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1) := by +-- BODY + classical + let A := P4062T1RecursiveInteriors P + let E := (A 0 ∪ A 1) ∪ (A 2 ∪ A 3) + let W := P4062T1InteriorSquare P.q \ E + let B := P4062T1RemainderPaths P + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re-a.re).natAbs + (x.im-a.im).natAbs + change W = (B 0).1 ∪ (B 1).1 ∧ Disjoint (B 0).1 (B 1).1 ∧ + (∀ x ∈ (B 0).1, ∀ y ∈ (B 1).1, ¬ FourNeighborAdjacent x y) ∧ + (∀ j, ∀ x ∈ (B j).1, ∀ y ∈ (B j).1, + FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1) + let r := P.q₁ + let s := P.q₂ + have hsum := PathGeometryProof.hsum P + have hs := PathGeometryProof.hs P + have hr := PathGeometryProof.hr P hP hsum + have hrs := PathGeometryProof.hrs P hP hsum + have horder := PathGeometryProof.horder P hrs + have hsumInt := PathGeometryProof.hsumInt P hsum + have squareCoordinates (n : Nat) (x : GaussianInt) := PathGeometryProof.squareCoordinates n x + have mem0 (x : GaussianInt) := PathGeometryProof.mem0 P + squareCoordinates x + have mem1 (x : GaussianInt) := PathGeometryProof.mem1 P hsum squareCoordinates x + have mem2 (x : GaussianInt) := PathGeometryProof.mem2 P hsum squareCoordinates x + have mem3 (x : GaussianInt) := PathGeometryProof.mem3 P hsum squareCoordinates x + have memB0Large (x : GaussianInt) (hlarge : s < r) := PathGeometryProof.memB0Large P + hsum hs hr squareCoordinates x hlarge + have memB1Large (x : GaussianInt) (hlarge : s < r) := PathGeometryProof.memB1Large P + hsum hs hr squareCoordinates x hlarge + have memB0Small (x : GaussianInt) (hsmall : r < s) := PathGeometryProof.memB0Small P hsum hs hr + squareCoordinates x hsmall + have memB1Small (x : GaussianInt) (hsmall : r < s) := PathGeometryProof.memB1Small P + hsum hs hr squareCoordinates x hsmall + have partition := PathGeometryProof.partition P hP hsum hs hr horder + squareCoordinates mem0 mem1 mem2 mem3 memB0Large memB1Large memB0Small memB1Small + have hdisj := PathGeometryProof.hdisj P horder memB0Large memB1Large + memB0Small memB1Small + have hcross := PathGeometryProof.hcross P horder memB0Large memB1Large memB0Small memB1Small + have natAbsToNat (z : Int) (hz : 0 ≤ z) := PathGeometryProof.natAbsToNat z hz + have natAbsDist (a b : Int) (ha : 0 ≤ a) (hb : 0 ≤ b) := PathGeometryProof.natAbsDist P + natAbsToNat a b + ha hb + have distDistDown (a b c : Nat) (ha : a ≤ c) (hb : b ≤ c) := PathGeometryProof.distDistDown P a + b c ha hb + have distDistUp (a b c : Nat) (ha : c ≤ a) (hb : c ≤ b) := PathGeometryProof.distDistUp P a b + c ha hb + have natDistOneInt (a b : Int) (ha : 0 ≤ a) (hb : 0 ≤ b) := PathGeometryProof.natDistOneInt P a b + ha hb + have adjacentVertical (x y : GaussianInt) (hfix : x.re = y.re) := + PathGeometryProof.adjacentVertical P x y hfix + have adjacentHorizontal (x y : GaussianInt) (hfix : x.im = y.im) := + PathGeometryProof.adjacentHorizontal P x y hfix + have lineVertical (x y : GaussianInt) (hfix : x.re = y.re) + (hnx : 0 ≤ x.im) (hny : 0 ≤ y.im) + (hlevel : Nat.dist (d x) (d y) = Nat.dist x.im.toNat y.im.toNat) : + FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1 := PathGeometryProof.lineVertical + P natDistOneInt adjacentVertical x y hfix hnx hny hlevel + have lineHorizontal (x y : GaussianInt) (hfix : x.im = y.im) + (hnx : 0 ≤ x.re) (hny : 0 ≤ y.re) + (hlevel : Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat) : + FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1 := + PathGeometryProof.lineHorizontal P natDistOneInt adjacentHorizontal x y hfix hnx hny + hlevel + have dLarge0Root (hlarge : s < r) (x : GaussianInt) + (hx : x ∈ (B 0).1) : + d x = (x.re-(r:Int)).natAbs + (x.im-(s:Int)).natAbs := PathGeometryProof.dLarge0Root P + hlarge x hx + have dLarge1Root (hlarge : s < r) (x : GaussianInt) + (hx : x ∈ (B 1).1) : + d x = (x.re-(s:Int)).natAbs + (x.im-(r:Int)).natAbs := PathGeometryProof.dLarge1Root P + hdisj hlarge x hx + have dSmall0Root (hsmall : r < s) (x : GaussianInt) + (hx : x ∈ (B 0).1) : + d x = (x.re-(r:Int)).natAbs + (x.im-(r:Int)).natAbs := PathGeometryProof.dSmall0Root P + hsmall x hx + have dSmall1Root (hsmall : r < s) (x : GaussianInt) + (hx : x ∈ (B 1).1) : + d x = (x.re-(s:Int)).natAbs + (x.im-(s:Int)).natAbs := PathGeometryProof.dSmall1Root P + hdisj hsmall x hx + have dLarge0V (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 0).1) + (hcoord : x.re = (r:Int)) (hpos : 0 ≤ x.im) (hbound : x.im ≤ (s:Int)) : + d x = Nat.dist x.im.toNat s := PathGeometryProof.dLarge0V P natAbsDist dLarge0Root hlarge x + hx hcoord hpos hbound + have dLarge0H (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 0).1) + (hcoord : x.im = (s:Int)) (hpos : 0 ≤ x.re) (hbound : (r:Int) ≤ x.re) : + d x = Nat.dist x.re.toNat r := PathGeometryProof.dLarge0H P natAbsDist dLarge0Root hlarge x + hx hcoord hpos hbound + have dLarge1V (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 1).1) + (hcoord : x.im = (r:Int)) (hpos : 0 ≤ x.re) (hbound : x.re ≤ (s:Int)) : + d x = Nat.dist x.re.toNat s := PathGeometryProof.dLarge1V P natAbsDist dLarge1Root hlarge x + hx hcoord hpos hbound + have dLarge1H (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 1).1) + (hcoord : x.re = (s:Int)) (hpos : 0 ≤ x.im) (hbound : (r:Int) ≤ x.im) : + d x = Nat.dist x.im.toNat r := PathGeometryProof.dLarge1H P natAbsDist dLarge1Root hlarge x + hx hcoord hpos hbound + have dSmall0V (hsmall : r < s) (x : GaussianInt) (hx : x ∈ (B 0).1) + (hcoord : x.re = (r:Int)) (hpos : 0 ≤ x.im) (hbound : x.im ≤ (r:Int)) : + d x = Nat.dist x.im.toNat r := PathGeometryProof.dSmall0V P natAbsDist dSmall0Root hsmall x + hx hcoord hpos hbound + have dSmall0H (hsmall : r < s) (x : GaussianInt) (hx : x ∈ (B 0).1) + (hcoord : x.im = (r:Int)) (hpos : 0 ≤ x.re) (hbound : x.re ≤ (r:Int)) : + d x = Nat.dist x.re.toNat r := PathGeometryProof.dSmall0H P natAbsDist dSmall0Root hsmall x + hx hcoord hpos hbound + have dSmall1V (hsmall : r < s) (x : GaussianInt) (hx : x ∈ (B 1).1) + (hcoord : x.re = (s:Int)) (hpos : 0 ≤ x.im) (hbound : (s:Int) ≤ x.im) : + d x = Nat.dist x.im.toNat s := PathGeometryProof.dSmall1V P natAbsDist dSmall1Root hsmall x + hx hcoord hpos hbound + have dSmall1H (hsmall : r < s) (x : GaussianInt) (hx : x ∈ (B 1).1) + (hcoord : x.im = (s:Int)) (hpos : 0 ≤ x.re) (hbound : (s:Int) ≤ x.re) : + d x = Nat.dist x.re.toNat s := PathGeometryProof.dSmall1H P natAbsDist dSmall1Root hsmall x + hx hcoord hpos hbound + have dLarge0Nat (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 0).1) : + d x = Nat.dist x.re.toNat r + Nat.dist x.im.toNat s := PathGeometryProof.dLarge0Nat P hsum + hs hr memB0Large natAbsDist dLarge0Root hlarge x hx + have dLarge1Nat (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 1).1) : + d x = Nat.dist x.re.toNat s + Nat.dist x.im.toNat r := PathGeometryProof.dLarge1Nat P hs hr + memB1Large natAbsDist dLarge1Root hlarge x hx + have dSmall0Nat (hsmall : r < s) (x : GaussianInt) (hx : x ∈ (B 0).1) : + d x = Nat.dist x.re.toNat r + Nat.dist x.im.toNat r := PathGeometryProof.dSmall0Nat P hr + memB0Small natAbsDist dSmall0Root hsmall x hx + have dSmall1Nat (hsmall : r < s) (x : GaussianInt) (hx : x ∈ (B 1).1) : + d x = Nat.dist x.re.toNat s + Nat.dist x.im.toNat s := PathGeometryProof.dSmall1Nat P hsum + hs memB1Small natAbsDist dSmall1Root hsmall x hx + have adjacentCoordinates (x y : GaussianInt) (ha : FourNeighborAdjacent x y) := + PathGeometryProof.adjacentCoordinates x y ha + have adjacentSymm {x y : GaussianInt} (ha : FourNeighborAdjacent x y) := + PathGeometryProof.adjacentSymm (x := x) (y := y) ha + have cornerVH (a b : Nat) (x y : GaussianInt) + (hxr : x.re = (a:Int)) (hyi : y.im = (b:Int)) + (dVx : d x = Nat.dist x.im.toNat b) + (dHy : d y = Nat.dist y.re.toNat a) + (hxre : 0 ≤ x.re) (hxim : 0 ≤ x.im) + (hyre : 0 ≤ y.re) (hyim : 0 ≤ y.im) : + FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1 := PathGeometryProof.cornerVH P + lineVertical lineHorizontal adjacentCoordinates a b x y hxr hyi dVx dHy hxre hxim + hyre hyim + have cornerHV (a b : Nat) (x y : GaussianInt) + (hxi : x.im = (b:Int)) (hyr : y.re = (a:Int)) + (dHx : d x = Nat.dist x.re.toNat a) + (dVy : d y = Nat.dist y.im.toNat b) + (hxre : 0 ≤ x.re) (hxim : 0 ≤ x.im) + (hyre : 0 ≤ y.re) (hyim : 0 ≤ y.im) : + FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1 := PathGeometryProof.cornerHV P + adjacentSymm cornerVH a b x y hxi hyr dHx dVy hxre hxim hyre hyim + have smallZeroNeighbors (hsmall : r < s) (x : GaussianInt) (hx : x ∈ (B 0).1) + (y : GaussianInt) (hy : y ∈ (B 0).1) : + FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1 := + PathAdjacencyProof.smallZeroNeighbors P hr memB0Small distDistDown lineVertical + lineHorizontal dSmall0V dSmall0H cornerVH cornerHV hsmall x hx y hy + have smallOneNeighbors (hsmall : r < s) (x : GaussianInt) (hx : x ∈ (B 1).1) + (y : GaussianInt) (hy : y ∈ (B 1).1) : + FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1 := + PathAdjacencyProof.smallOneNeighbors P hsum hs memB1Small distDistUp lineVertical + lineHorizontal dSmall1V dSmall1H cornerVH cornerHV hsmall x hx y hy + have largeZeroNeighbors (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 0).1) + (y : GaussianInt) (hy : y ∈ (B 0).1) : + FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1 := + PathAdjacencyProof.largeZeroNeighbors P hP hsum hs hr memB0Large distDistDown + distDistUp lineVertical lineHorizontal dLarge0V dLarge0H cornerVH cornerHV hlarge x + hx y hy + have largeOneNeighbors (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 1).1) + (y : GaussianInt) (hy : y ∈ (B 1).1) : + FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1 := + PathAdjacencyProof.largeOneNeighbors P hP hsum hs hr memB1Large distDistDown + distDistUp lineVertical lineHorizontal dLarge1V dLarge1H cornerVH cornerHV hlarge x + hx y hy + refine ⟨partition, hdisj, hcross, ?_⟩ + intro j x hx y hy + rcases horder with hsmall | hlarge + · fin_cases j + · exact smallZeroNeighbors hsmall x hx y hy + · exact smallOneNeighbors hsmall x hx y hy + · fin_cases j + · exact largeZeroNeighbors hlarge x hx y hy + · exact largeOneNeighbors hlarge x hx y hy + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1AffineComparison.lean b/LeanPool/ApollonianSuperharmonic/P4120T1AffineComparison.lean new file mode 100644 index 0000000000..b09a85f7e7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4120T1AffineComparison.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import Mathlib.Tactic.Abel + +-- [TABLET NODE: P4120T1AffineComparison] + +/-! +# P4120T1AffineComparison + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4120T1AffineComparison + (C : CircleCoordinates) (T U : ProtoTile) (h k : PartialOdometer) + (g f : IntegerLatticeFunction) (hC : 0 < C.1) + (hodo : TileOdometer C T h) (kodo : TileOdometer C U k) + (hext : GlobalOdometerExtends g h) + (hf : ∀ z, z ∈ k.domain → k.value z = f z) + (x : GaussianInt) (hx : x ∈ FootprintVertices T) + (hxb : x ∉ BoundaryFootprintVertices T) : + ∃ u : GaussianInt, + T.cells = (TileTranslation U u).cells ∧ + (T.cells = ∅ → T.anchor = (TileTranslation U u).anchor) ∧ + FourNeighborLaplacian g x = FourNeighborLaplacian f (x - u) := by +-- BODY + classical + obtain ⟨u, ⟨hcell, hanchor, a, b, hdom, hvalue⟩, _⟩ := + TileOdometerTranslationUniqueness C T U h k hC hodo kodo + obtain ⟨c, hc⟩ := hext + have hne : T.cells.Nonempty := by + by_contra hn + simp only [FootprintVertices, ite_eq_right hn, Set.mem_singleton_iff] at hx + apply hxb + simp [BoundaryFootprintVertices, hn, hx] + have hsome : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells := by + rw [FootprintVertices, ite_eq_left hne] at hx + rcases hx with ⟨y, hy, rfl | rfl | rfl | rfl⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using hy⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hy⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hy⟩ + · refine ⟨2, ?_⟩ + simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hy + have hall : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells := by + intro j + by_contra hj + exact hxb (P3161T2IncidentBoundary T x hsome ⟨j, hj⟩) + have cells : x ∈ T.cells ∧ x - 1 ∈ T.cells ∧ + x - ⟨0, 1⟩ ∈ T.cells ∧ x - 1 - ⟨0, 1⟩ ∈ T.cells := + ⟨by simpa [LatticeVertexIncidentCell] using hall 0, + by simpa [LatticeVertexIncidentCell] using hall 1, + by simpa [LatticeVertexIncidentCell] using hall 3, + by simpa [LatticeVertexIncidentCell] using hall 2⟩ + have value (z : GaussianInt) (hz : z ∈ FootprintVertices T) : + g z = f (z - u) + a.re * z.re + a.im * z.im + b + c := by + have hzh : z ∈ h.domain := by + change z ∈ (h.domain : Set GaussianInt) + rw [PositiveCurvatureTileOdometerDomain C T h hC hodo] + exact hz + rw [hc z hzh, hvalue z hzh, hf (z - u) ((hdom z).mp hzh)] + have right_mem : x + 1 ∈ FootprintVertices T := by + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + exact ⟨x, cells.1, Or.inr (Or.inl rfl)⟩ + have left_mem : x - 1 ∈ FootprintVertices T := by + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + exact ⟨x - 1, cells.2.1, Or.inl rfl⟩ + have up_mem : x + ⟨0, 1⟩ ∈ FootprintVertices T := by + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + exact ⟨x, cells.1, Or.inr (Or.inr (Or.inl rfl))⟩ + have down_mem : x - ⟨0, 1⟩ ∈ FootprintVertices T := by + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + exact ⟨x - ⟨0, 1⟩, cells.2.2.1, Or.inl rfl⟩ + refine ⟨u, hcell, hanchor, ?_⟩ + simp only [FourNeighborLaplacian, value _ right_mem, value _ left_mem, + value _ up_mem, value _ down_mem, value _ hx] + have r : x + 1 - u = x - u + 1 := by abel + have l : x - 1 - u = x - u - 1 := by abel + have t : x + ⟨0, 1⟩ - u = x - u + ⟨0, 1⟩ := by abel + have d : x - ⟨0, 1⟩ - u = x - u - ⟨0, 1⟩ := by abel + rw [r, l, t, d] + simp; ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1DiamondGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4120T1DiamondGeometry.lean new file mode 100644 index 0000000000..c55ba6776a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4120T1DiamondGeometry.lean @@ -0,0 +1,217 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondBoundaryLedger +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCentroid + +-- [TABLET NODE: P4120T1DiamondGeometry] + +/-! +# P4120T1DiamondGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4120T1DiamondGeometry + (K : DiamondParameter) (hK : 1 < K.1) + (T : ProtoTile) (S : Fin 3 → Bool → ProtoTile) (u : GaussianInt) + (hcells : T.cells = (TileTranslation (DiamondTile K.1) u).cells) + (hanchor : T.cells = ∅ → T.anchor = (TileTranslation (DiamondTile K.1) u).anchor) + (hS : ∀ i s, BandSubtileOccurrence (DiamondRecursiveQuadruple K) T i s (S i s)) + (x : GaussianInt) (hx : x ∈ FootprintVertices T) + (hxb : x ∉ BoundaryFootprintVertices T) : + let y := x - u + let k := Nat.card {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} + (k = 2 → y ∈ DiamondVertexDomains K true ∧ Even (y.re + y.im) ∧ + (y.re = 0 ↔ GaussianRealPoint x = TileCentroid T) ∧ + (GaussianRealPoint x = TileCentroid T ↔ K.1 = 2)) ∧ + k ≠ 3 ∧ + (k = 4 → y ∈ DiamondVertexDomains K true ∧ ¬ Even (y.re + y.im) ∧ + y.re ≠ 0 ∧ GaussianRealPoint x ≠ TileCentroid T) ∧ + ((k = 2 ∨ k = 3 ∨ k = 4) ∨ + ∃ i : Fin 3, ∃ s : Bool, + 0 < ((DiamondRecursiveQuadruple K) i.succ).1 ∧ + x ∈ FootprintVertices (S i s) ∧ x ∉ BoundaryFootprintVertices (S i s)) := by +-- BODY + classical + let y := x - u + let k := Nat.card {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} + have translated_mem (A : Set GaussianInt) : + x ∈ GaussianTranslation u '' A ↔ y ∈ A := by + constructor + · rintro ⟨z, hz, heq⟩ + have hyz : y = z := by dsimp [y]; rw [← heq]; simp [GaussianTranslation] + simpa [hyz] using hz + · intro hy + exact ⟨y, hy, sub_add_cancel x u⟩ + have rootObs := ProtoTileObservableExtensionality T + (TileTranslation (DiamondTile K.1) u) hcells hanchor + have hyFoot : y ∈ FootprintVertices (DiamondTile K.1) := by + apply (translated_mem _).mp + rw [← (TileTranslationFormulas (DiamondTile K.1) u).2.2.2.2.2.1, + ← rootObs.1] + exact hx + have hyNo : y ∉ BoundaryFootprintVertices (DiamondTile K.1) := by + intro hy + apply hxb + rw [rootObs.2.1, (TileTranslationFormulas (DiamondTile K.1) u).2.2.2.2.2.2.2.1] + exact (translated_mem _).mpr hy + have incidence := P4194T1DiamondVertexIncidence K.1 K.2 y + have rootCells : ∀ j : Fin 4, LatticeVertexIncidentCell y j ∈ DiamondCellDomain K.1 := by + intro j + by_contra hj + exact hyNo (incidence.2.mpr ⟨incidence.1.mp hyFoot, j, hj⟩) + obtain ⟨_, C, hCocc, _, h00, h01, h10, h11, h2f, h2t⟩ := + DiamondTileRecursiveIdentification K + have childObs : ∀ i s, + FootprintVertices (S i s) = FootprintVertices (TileTranslation (C i s) u) ∧ + BoundaryFootprintVertices (S i s) = + BoundaryFootprintVertices (TileTranslation (C i s) u) := by + intro i s + have hs := hS i s + have hc := (BandSubtileOccurrenceTranslation + (DiamondRecursiveQuadruple K) (DiamondTile K.1) (C i s) i s u).mp (hCocc i s) + have hcent : TileCentroid (S i s) = TileCentroid (TileTranslation (C i s) u) := by + have hoff := hs.2.2.trans hc.2.2.symm + calc + TileCentroid (S i s) = + (TileCentroid (S i s) - TileCentroid T) + TileCentroid T := by abel + _ = (TileCentroid (TileTranslation (C i s) u) - + TileCentroid (TileTranslation (DiamondTile K.1) u)) + + TileCentroid (TileTranslation (DiamondTile K.1) u) := by + rw [hoff, rootObs.2.2.2.2] + _ = TileCentroid (TileTranslation (C i s) u) := by abel + obtain ⟨heq, ha⟩ := BandPrototileCentroidUnique + ((DiamondRecursiveQuadruple K) i.succ) (S i s) + (TileTranslation (C i s) u) hs.1 hc.1 hcent + have obs := ProtoTileObservableExtensionality (S i s) (TileTranslation (C i s) u) heq ha + exact ⟨obs.1, obs.2.1⟩ + have childFoot (i : Fin 3) (s : Bool) : + x ∈ FootprintVertices (S i s) ↔ y ∈ FootprintVertices (C i s) := by + rw [(childObs i s).1, (TileTranslationFormulas (C i s) u).2.2.2.2.2.1] + exact translated_mem _ + have childBd (i : Fin 3) (s : Bool) : + x ∈ BoundaryFootprintVertices (S i s) ↔ y ∈ BoundaryFootprintVertices (C i s) := by + rw [(childObs i s).2, (TileTranslationFormulas (C i s) u).2.2.2.2.2.2.2.1] + exact translated_mem _ + have hcount : k = Nat.card {a : Fin 3 × Bool // + y ∈ BoundaryFootprintVertices (C a.1 a.2)} := by + apply Nat.card_congr + refine { + toFun := fun a => ⟨a.1, (childBd a.1.1 a.1.2).mp a.2⟩ + invFun := fun a => ⟨a.1, (childBd a.1.1 a.1.2).mpr a.2⟩ + left_inv := ?_ + right_inv := ?_ } + · intro a + rfl + · intro a + rfl + obtain ⟨htwo, hthree, hfour, _, _, hdes⟩ := + P4194T1DiamondBoundaryLedger K.1 hK C h00 h01 h10 h11 h2f h2t y rootCells + rw [← hcount] at htwo hthree hfour hdes + have hcent : TileCentroid T = ((u.re : Real), (K.1 : Real) + (u.im : Real)) := by + rw [rootObs.2.2.2.2, (TileTranslationFormulas (DiamondTile K.1) u).2.2.2.2.1, + P4194T1DiamondCentroid K.1 K.2] + simp only [zero_add] + have hxr : x.re = y.re + u.re := by dsimp [y]; simp + have hxi : x.im = y.im + u.im := by dsimp [y]; simp + have pointCent : GaussianRealPoint x = TileCentroid T ↔ + y.re = 0 ∧ y.im = (K.1 : Int) := by + rw [hcent] + simp only [GaussianRealPoint, Prod.mk.injEq] + constructor + · rintro ⟨hr, hi⟩ + have hr' : x.re = u.re := by exact_mod_cast hr + have hi' : x.im = (K.1 : Int) + u.im := by exact_mod_cast hi + constructor <;> omega + · rintro ⟨hr, hi⟩ + have hr' : x.re = u.re := by omega + have hi' : x.im = (K.1 : Int) + u.im := by omega + constructor + · exact_mod_cast hr' + · exact_mod_cast hi' + have inner (hb : y.im = (K.1 : Int)) + (ha : y.re = (K.1 : Int) - 2 ∨ y.re = -((K.1 : Int) - 2) ∨ + y.re = (K.1 : Int) - 1 ∨ y.re = -((K.1 : Int) - 1)) : + y ∈ DiamondVertexDomains K true := by + change Int.natAbs y.re + Int.natAbs (y.im - (K.1 : Int)) ≤ K.1 - 1 + rw [hb, sub_self, Int.natAbs_zero, Nat.add_zero] + rcases ha with ha | ha | ha | ha <;> rw [ha] <;> omega + refine ⟨?_, hthree, ?_, ?_⟩ + · intro hk + obtain ⟨hb, ha⟩ := htwo.mp hk + have heven : Even (y.re + y.im) := by + rcases ha with ha | ha + · exact ⟨(K.1 : Int) - 1, by rw [ha, hb]; omega⟩ + · exact ⟨1, by rw [ha, hb]; omega⟩ + have hz : y.re = 0 ↔ K.1 = 2 := by + rcases ha with ha | ha <;> rw [ha] <;> omega + have hc : GaussianRealPoint x = TileCentroid T ↔ y.re = 0 := by + rw [pointCent] + exact ⟨fun h => h.1, fun h => ⟨h, hb⟩⟩ + exact ⟨inner hb (ha.elim Or.inl (fun h => Or.inr (Or.inl h))), heven, + hc.symm, hc.trans hz⟩ + · intro hk + obtain ⟨hb, ha⟩ := hfour.mp hk + have hodd : ¬ Even (y.re + y.im) := by + rintro ⟨j, hj⟩ + rcases ha with ha | ha <;> rw [ha, hb] at hj <;> omega + have hnonzero : y.re ≠ 0 := by + rcases ha with ha | ha <;> rw [ha] <;> omega + exact ⟨inner hb (Or.inr (Or.inr ha)), hodd, hnonzero, + fun h => hnonzero (pointCent.mp h).1⟩ + · rcases hdes with (hk | hk) | ⟨s, hall⟩ + · exact Or.inl (Or.inl hk) + · exact Or.inl (Or.inr (Or.inr hk)) + · have hne : (C 2 s).cells.Nonempty := ⟨_, hall 0⟩ + have hf : y ∈ FootprintVertices (C 2 s) := by + rw [FootprintVertices, ite_eq_left hne] + exact ⟨y, hall 0, Or.inl rfl⟩ + have hn : y ∉ BoundaryFootprintVertices (C 2 s) := by + intro hb + simp only [BoundaryFootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hb + rcases hb with ⟨e, ⟨w, he⟩, hy⟩ + rcases he with ⟨rfl, hw⟩ | ⟨rfl, hw⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hy + rcases hy with hy | hy + · rcases hw with ⟨_, ho⟩ | ⟨ho, _⟩ + · exact ho (by simpa [LatticeVertexIncidentCell, hy] using hall 3) + · exact ho (by simpa [LatticeVertexIncidentCell, hy] using hall 0) + · rcases hw with ⟨_, ho⟩ | ⟨ho, _⟩ + · exact ho (by simpa [LatticeVertexIncidentCell, hy] using hall 2) + · exact ho (by simpa [LatticeVertexIncidentCell, hy] using hall 1) + · simp only [Finset.mem_insert, Finset.mem_singleton] at hy + rcases hy with hy | hy + · rcases hw with ⟨_, ho⟩ | ⟨ho, _⟩ + · exact ho (by simpa [LatticeVertexIncidentCell, hy] using hall 1) + · exact ho (by simpa [LatticeVertexIncidentCell, hy] using hall 0) + · rcases hw with ⟨_, ho⟩ | ⟨ho, _⟩ + · exact ho (by simpa [LatticeVertexIncidentCell, hy, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hall 2) + · exact ho (by simpa [LatticeVertexIncidentCell, hy] using hall 3) + have hpos : 0 < ((DiamondRecursiveQuadruple K) (Fin.succ 2)).1 := by + change (0 : Int) < ((2 * (K.1 - 1) * K.1 : Nat) : Int) + have hKm : 0 < K.1 - 1 := by omega + have hNat : 0 < 2 * (K.1 - 1) * K.1 := + Nat.mul_pos (Nat.mul_pos (by decide) hKm) K.2 + exact_mod_cast hNat + exact Or.inr ⟨2, s, hpos, (childFoot 2 s).mpr hf, + fun hb => hn ((childBd 2 s).mp hb)⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean new file mode 100644 index 0000000000..289b04eb7c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean @@ -0,0 +1,1714 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.FordBoundaryMultiplicity +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport + +-- [TABLET NODE: P4120T1FordGeometry] + +/-! +# P4120T1FordGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FordTileGeometry + +private theorem hneAt131 : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ + BoundaryFootprintVertices T) → (T.cells.Nonempty)) ) := by + classical + intro T x hx hxb + by_contra hn + simp only [FootprintVertices, ite_eq_right hn, Set.mem_singleton_iff] at hx + apply hxb + simp [BoundaryFootprintVertices, hn, hx] + +private theorem hsome : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ + BoundaryFootprintVertices T) → ((T.cells.Nonempty) → (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T.cells))) ) := by + classical + intro T x hx hxb hne + rw [FootprintVertices, ite_eq_left hne] at hx + rcases hx with ⟨y, hy, rfl | rfl | rfl | rfl⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using hy⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hy⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hy⟩ + · refine ⟨2, ?_⟩ + simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hy + +private theorem cells : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∉ BoundaryFootprintVertices T) → ((∃ j : Fin + 4, LatticeVertexIncidentCell x j ∈ T.cells) → (∀ j : Fin 4, LatticeVertexIncidentCell + x j ∈ T.cells)) ) := by + classical + intro T x hxb hsome j + by_contra hj + exact hxb (P3161T2IncidentBoundary T x hsome ⟨j, hj⟩) + +private theorem cellCanonical : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), (T.cells = + (TileTranslation (FordTile P.q) u).cells) → (∀ (z : GaussianInt), z ∈ T.cells ↔ z - u + ∈ (FordTile P.q).cells) ) := by + classical + intro P T u hcells z + rw [hcells, (TileTranslationFormulas (FordTile P.q) u).1] + rw [Finset.mem_image] + constructor + · rintro ⟨a, ha, he⟩ + have he' : a = z - u := by + rw [← he] + dsimp [GaussianTranslation] + abel + simpa [he'] using ha + · intro hz + exact ⟨z - u, hz, by dsimp [GaussianTranslation]; abel⟩ + +private theorem squareCell : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (z : GaussianInt), z ∈ (FordTile P.q).cells ↔ (0 : ℤ) ≤ + z.re ∧ z.re < (↑P.q : ℤ) ∧ (0 : ℤ) ≤ z.im ∧ z.im < (↑P.q : ℤ) ) := by + classical + intro P z + change z ∈ FordCellDomain P.q ↔ _ + change z ∈ ((Finset.range P.q).product (Finset.range P.q)).image + (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) ↔ _ + rw [Finset.mem_image] + constructor + · rintro ⟨⟨a, b⟩, hab, hz⟩ + have hab := Finset.mem_product.mp hab + have ha := Finset.mem_range.mp hab.1 + have hb := Finset.mem_range.mp hab.2 + have hre : z.re = (a : Int) := by + have hh := congrArg (fun w : GaussianInt => w.re) hz + simpa using hh.symm + have him : z.im = (b : Int) := by + have hh := congrArg (fun w : GaussianInt => w.im) hz + simpa using hh.symm + rw [hre, him] + exact ⟨by exact_mod_cast (Nat.zero_le a), + by exact_mod_cast ha, + by exact_mod_cast (Nat.zero_le b), + by exact_mod_cast hb⟩ + · rintro ⟨hr, hrq, hi, hiq⟩ + let a := z.re.toNat + let b := z.im.toNat + have ha : (a : Int) = z.re := Int.toNat_of_nonneg hr + have hb : (b : Int) = z.im := Int.toNat_of_nonneg hi + have haq : a < P.q := by exact_mod_cast (show (a : Int) < P.q by omega) + have hbq : b < P.q := by exact_mod_cast (show (b : Int) < P.q by omega) + refine ⟨(a, b), Finset.mem_product.mpr + ⟨Finset.mem_range.mpr haq, Finset.mem_range.mpr hbq⟩, ?_⟩ + apply Zsqrtd.ext <;> simp [ha, hb] + +private theorem hbounds : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (x : GaussianInt), + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) → ( + let y : GaussianInt := x - u + (∀ (z : GaussianInt), z ∈ T.cells ↔ z - u ∈ (FordTile P.q).cells) → ((∀ (z : + GaussianInt), z ∈ (FordTile P.q).cells ↔ 0 ≤ z.re ∧ z.re < (P.q : Int) ∧ 0 ≤ z.im ∧ + z.im < (P.q : Int)) → (1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ 1 ≤ y.im ∧ y.im ≤ (P.q : + Int) - 1)))) := by + classical + intro P T u x cells y cellCanonical squareCell + have c0 := (cellCanonical x).mp (by simpa [LatticeVertexIncidentCell] using cells 0) + have c1 := (cellCanonical (x - 1)).mp (by simpa [LatticeVertexIncidentCell] using cells 1) + have c2 := (cellCanonical (x - 1 - ⟨0, 1⟩)).mp + (by simpa [LatticeVertexIncidentCell] using cells 2) + have c3 := (cellCanonical (x - ⟨0, 1⟩)).mp + (by simpa [LatticeVertexIncidentCell] using cells 3) + rw [squareCell] at c0 c1 c2 c3 + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, + Zsqrtd.im_one] at c0 c1 c2 c3 + dsimp [y] + omega + +private theorem fordCentroid : + (by + classical + exact + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((GaussianInt) → ((GaussianInt) → + (TileCentroid (FordTile P.q) = ((P.q : Real) / 2, (P.q : Real) / 2)))) ) := by + classical + intro P hP u x + let domain : Finset GaussianInt := + (Finset.range P.q).product (Finset.range P.q) |>.image + (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) + have hneDomain : domain.Nonempty := by + refine ⟨⟨0, 0⟩, ?_⟩ + apply Finset.mem_image.mpr + exact ⟨(0, 0), by simp [P.q_pos], rfl⟩ + have hinj : Set.InjOn + (fun a : ℕ × ℕ => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) + ↑((Finset.range P.q).product (Finset.range P.q)) := by + intro a ha b hb hab + apply Prod.ext + · have h := congrArg Zsqrtd.re hab + change (a.1 : Int) = (b.1 : Int) at h + exact_mod_cast h + · have h := congrArg Zsqrtd.im hab + change (a.2 : Int) = (b.2 : Int) at h + exact_mod_cast h + have hcard : domain.card = P.q * P.q := by + calc + domain.card = ((Finset.range P.q).product (Finset.range P.q)).card := by + dsimp [domain] + exact Finset.card_image_iff.mpr hinj + _ = P.q * P.q := by simp + have hsumRe : domain.sum (fun z : GaussianInt => z.re) = + (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 * (P.q : Int) := by + have hrange : (Finset.range P.q).sum (fun n => (n : Int)) = + (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + simp? [domain, Finset.sum_product] + conv_lhs => rw [← Finset.mul_sum (Finset.range P.q) + (fun n => (n : Int)) (P.q : Int)] + rw [hrange] + ring + have hsumIm : domain.sum (fun z : GaussianInt => z.im) = + (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 * (P.q : Int) := by + have hrange : (Finset.range P.q).sum (fun n => (n : Int)) = + (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + simp? [domain, Finset.sum_product] + rw [hrange] + ring + change (if domain.Nonempty then + ((↑(domain.sum (fun z : GaussianInt => z.re) : Int) / + ↑domain.card + (1 / 2 : Real)), + (↑(domain.sum (fun z : GaussianInt => z.im) : Int) / + ↑domain.card + (1 / 2 : Real))) else _) = _ + rw [ite_eq_left hneDomain, hcard, hsumRe, hsumIm] + have hqcast : ((P.q - 1 : Nat) : Int) = (P.q : Int) - 1 := by omega + rw [hqcast] + norm_num + field_simp + have arithmetic := Finset.sum_range_id_mul_two P.q + have rangeSum : (Finset.range P.q).sum (fun n => (n : Int)) = + (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + have arithmeticCast : + ((Finset.range P.q).sum (fun n => (n : Int))) * 2 = + (P.q : Int) * ((P.q - 1 : Nat) : Int) := by + rw [← Nat.cast_sum] + exact_mod_cast arithmetic + rw [rangeSum] at arithmeticCast + rw [hqcast] at arithmeticCast + have natIdentity : P.q * (P.q - 1) / 2 * 2 + P.q = P.q * P.q := by + rw [← Finset.sum_range_id P.q] + rw [Finset.sum_range_id_mul_two] + have hprod : P.q ≤ P.q * P.q := by nlinarith + rw [Nat.mul_sub_left_distrib] + simp only [Nat.mul_one] + rw [Nat.sub_add_cancel hprod] + norm_num [Int.subNatNat, pow_two] + have hreal : + (((P.q : Int) * ((P.q : Int) - 1) / 2 : Int) : Real) * 2 = + (((P.q : Int) * ((P.q : Int) - 1) : Int) : Real) := by + exact_mod_cast arithmeticCast + rw [hreal] + push_cast + ring + +private theorem hparentCentroid : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : + GaussianInt), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence + (FordRecursiveQuadruple P) T i s (S i s)) → (∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), + (FootprintVertices T = FootprintVertices (TileTranslation (FordTile P.q) u) ∧ + BoundaryFootprintVertices T = BoundaryFootprintVertices (TileTranslation (FordTile + P.q) u) ∧ BoundaryFootprintEdges T = BoundaryFootprintEdges (TileTranslation + (FordTile P.q) u) ∧ TileRealization T = TileRealization (TileTranslation (FordTile + P.q) u) ∧ TileCentroid T = TileCentroid (TileTranslation (FordTile P.q) u)) → ((∀ (i + : Fin 3), ∀ (s : Bool), BandSubtileOccurrence (FordRecursiveQuadruple P) + (TileTranslation (FordTile P.q) u) i s (TileTranslation (Sc i s) u)) → (∀ (i : Fin (3 + : ℕ)), ∀ (s : Bool), TileCentroid (S i s) = TileCentroid (TileTranslation (Sc i s) + u)))) ) := by + classical + intro P T S u hS Sc hrootObs hScTranslated i s + have hs := (hS i s).2.2 + have hc := (hScTranslated i s).2.2 + have hoff : TileCentroid (S i s) - TileCentroid T = + TileCentroid (TileTranslation (Sc i s) u) - + TileCentroid (TileTranslation (FordTile P.q) u) := hs.trans hc.symm + calc + TileCentroid (S i s) = + (TileCentroid (S i s) - TileCentroid T) + TileCentroid T := by + ext <;> simp [sub_eq_add_neg, add_comm] + _ = (TileCentroid (TileTranslation (Sc i s) u) - + TileCentroid (TileTranslation (FordTile P.q) u)) + TileCentroid T := by + rw [hoff] + _ = TileCentroid (TileTranslation (Sc i s) u) := by + rw [hrootObs.2.2.2.2] + ext <;> simp [sub_eq_add_neg, add_comm, add_left_comm] + +private theorem hparentObs : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : + GaussianInt), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence + (FordRecursiveQuadruple P) T i s (S i s)) → (∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin 3), ∀ (s : Bool), BandSubtileOccurrence (FordRecursiveQuadruple P) + (TileTranslation (FordTile P.q) u) i s (TileTranslation (Sc i s) u)) → ((∀ (i : Fin + 3), ∀ (s : Bool), TileCentroid (S i s) = TileCentroid (TileTranslation (Sc i s) u)) → + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), FootprintVertices (S i s) = FootprintVertices + (TileTranslation (Sc i s) u) ∧ BoundaryFootprintVertices (S i s) = + BoundaryFootprintVertices (TileTranslation (Sc i s) u)))) ) := by + classical + intro P T S u hS Sc hScTranslated hparentCentroid i s + have heq := BandPrototileCentroidUnique _ _ _ (hS i s).1 + (hScTranslated i s).1 (hparentCentroid i s) + have obs := ProtoTileObservableExtensionality (S i s) + (TileTranslation (Sc i s) u) heq.1 heq.2 + exact ⟨obs.1, obs.2.1⟩ + +private theorem hparentCells : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : + GaussianInt), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence + (FordRecursiveQuadruple P) T i s (S i s)) → (∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin 3), ∀ (s : Bool), BandSubtileOccurrence (FordRecursiveQuadruple P) + (TileTranslation (FordTile P.q) u) i s (TileTranslation (Sc i s) u)) → ((∀ (i : Fin + 3), ∀ (s : Bool), TileCentroid (S i s) = TileCentroid (TileTranslation (Sc i s) u)) → + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (S i s).cells = (TileTranslation (Sc i s) + u).cells))) ) := by + classical + intro P T S u hS Sc hScTranslated hparentCentroid i s + exact (BandPrototileCentroidUnique _ _ _ (hS i s).1 + (hScTranslated i s).1 (hparentCentroid i s)).1 + +private theorem hrpos : + (by + classical + exact + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((GaussianInt) → ((GaussianInt) → (0 < + P.q₁))) ) := by + classical + intro P hP u x + by_contra hn + have hz : P.q₁ = 0 := by omega + have hqint : 1 < (P.q : Int) := by exact_mod_cast hP + have hdet := P.det₁ + rw [hz] at hdet + have hdiv : (P.q : Int) ∣ 1 := by + refine ⟨P.p₁, ?_⟩ + simpa [mul_comm] using hdet.symm + have hu := Int.eq_one_of_dvd_one (by omega : (0 : Int) ≤ P.q) hdiv + have : P.q = 1 := by exact_mod_cast hu + omega + +private theorem rectBoundary : + (by + classical + exact + (FordFareyParameter) → ((GaussianInt) → ((GaussianInt) → (∀ (l : ℤ), ∀ (r : ℤ), ∀ (b : + ℤ), ∀ (t : ℤ), ∀ (z : GaussianInt), z ∈ LatticeVertexBoundary {w : GaussianInt | l ≤ + w.re ∧ w.re ≤ r ∧ b ≤ w.im ∧ w.im ≤ t} ↔ (l ≤ z.re ∧ z.re ≤ r ∧ b ≤ z.im ∧ z.im ≤ t) + ∧ (z.re = l ∨ z.re = r ∨ z.im = b ∨ z.im = t)))) ) := by + classical + intro P u x l r b t z + constructor + · rintro ⟨hz, w, hw, hre, him⟩ + refine ⟨hz, ?_⟩ + change l ≤ z.re ∧ z.re ≤ r ∧ b ≤ z.im ∧ z.im ≤ t at hz + change ¬(l ≤ w.re ∧ w.re ≤ r ∧ b ≤ w.im ∧ w.im ≤ t) at hw + omega + · rintro ⟨hz, he⟩ + refine ⟨hz, ?_⟩ + rcases he with he | he | he | he + · refine ⟨⟨z.re - 1, z.im⟩, ?_, ?_, ?_⟩ <;> + simp only [Set.mem_ofPred_eq] <;> omega + · refine ⟨⟨z.re + 1, z.im⟩, ?_, ?_, ?_⟩ <;> + simp only [Set.mem_ofPred_eq] <;> omega + · refine ⟨⟨z.re, z.im - 1⟩, ?_, ?_, ?_⟩ <;> + simp only [Set.mem_ofPred_eq] <;> omega + · refine ⟨⟨z.re, z.im + 1⟩, ?_, ?_, ?_⟩ <;> + simp only [Set.mem_ofPred_eq] <;> omega + +private theorem boundaryTranslation : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), z ∈ + BoundaryFootprintVertices (TileTranslation A v) ↔ z - v ∈ BoundaryFootprintVertices A + ) := by + classical + intro A v z + rw [(TileTranslationFormulas A v).2.2.2.2.2.2.2.1] + constructor + · rintro ⟨w, hw, he⟩ + have he' : w = z - v := by + rw [← he] + dsimp [GaussianTranslation] + abel + simpa [he'] using hw + · intro hz + exact ⟨z - v, hz, by dsimp [GaussianTranslation]; abel⟩ + +private theorem footprintTranslation : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), z ∈ FootprintVertices + (TileTranslation A v) ↔ z - v ∈ FootprintVertices A ) := by + classical + intro A v z + rw [(TileTranslationFormulas A v).2.2.2.2.2.1] + constructor + · rintro ⟨w, hw, he⟩ + have he' : w = z - v := by + rw [← he] + dsimp [GaussianTranslation] + abel + simpa [he'] using hw + · intro hz + exact ⟨z - v, hz, by dsimp [GaussianTranslation]; abel⟩ + +private theorem hSc00 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), ((Sc (0 : Fin (3 : + ℕ)) true).cells = (FordTile P.q₁).cells) → ((0 < P.q₁) → (BoundaryFootprintVertices + (Sc 0 true) = BoundaryFootprintVertices (FordTile P.q₁))) ) := by + classical + intro P Sc h00 hrpos + have hne : (FordTile P.q₁).cells.Nonempty := by + refine ⟨⟨0, 0⟩, ?_⟩ + simp? [FordTile, FordCellDomain] + exact hrpos + have ha : (Sc 0 true).cells = ∅ → + (Sc 0 true).anchor = (FordTile P.q₁).anchor := by + intro he + have hempty : (FordTile P.q₁).cells = ∅ := h00.symm.trans he + exact False.elim ((Finset.nonempty_iff_ne_empty.mp hne) hempty) + exact (ProtoTileObservableExtensionality _ _ h00 ha).2.1 + +private theorem hSc01 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), ((Sc (0 : Fin (3 : + ℕ)) false).cells = (TileTranslation (FordTile P.q₁) ⟨(↑P.q₂ : ℤ), (↑P.q₂ : + ℤ)⟩).cells) → ((0 < P.q₁) → (BoundaryFootprintVertices (Sc 0 false) = + BoundaryFootprintVertices (TileTranslation (FordTile P.q₁) ⟨(P.q₂ : Int), (P.q₂ : + Int)⟩))) ) := by + classical + intro P Sc h01 hrpos + have hbase : (FordTile P.q₁).cells.Nonempty := by + exact ⟨⟨0, 0⟩, by simp [FordTile, FordCellDomain, hrpos]⟩ + have hne : (TileTranslation (FordTile P.q₁) + ⟨(P.q₂ : Int), (P.q₂ : Int)⟩).cells.Nonempty := by + by_contra hn + have he := Finset.not_nonempty_iff_eq_empty.mp hn + rw [(TileTranslationFormulas _ _).2.2.1] at he + exact (Finset.nonempty_iff_ne_empty.mp hbase) he + have ha : (Sc 0 false).cells = ∅ → + (Sc 0 false).anchor = + (TileTranslation (FordTile P.q₁) + ⟨(P.q₂ : Int), (P.q₂ : Int)⟩).anchor := by + intro he + have hempty := h01.symm.trans he + exact False.elim ((Finset.nonempty_iff_ne_empty.mp hne) hempty) + exact (ProtoTileObservableExtensionality _ _ h01 ha).2.1 + +private theorem hSc10 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), ((Sc (1 : Fin (3 : + ℕ)) true).cells = (TileTranslation (FordTile P.q₂) ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩).cells) → + (BoundaryFootprintVertices (Sc 1 true) = BoundaryFootprintVertices (TileTranslation + (FordTile P.q₂) ⟨(P.q₁ : Int), 0⟩)) ) := by + classical + intro P Sc h10 + have hbase : (FordTile P.q₂).cells.Nonempty := by + exact ⟨⟨0, 0⟩, by simp [FordTile, FordCellDomain, P.q₂_pos]⟩ + have hne : (TileTranslation (FordTile P.q₂) + ⟨(P.q₁ : Int), 0⟩).cells.Nonempty := by + by_contra hn + have he := Finset.not_nonempty_iff_eq_empty.mp hn + rw [(TileTranslationFormulas _ _).2.2.1] at he + exact (Finset.nonempty_iff_ne_empty.mp hbase) he + have ha : (Sc 1 true).cells = ∅ → + (Sc 1 true).anchor = + (TileTranslation (FordTile P.q₂) ⟨(P.q₁ : Int), 0⟩).anchor := by + intro he + have hempty := h10.symm.trans he + exact False.elim ((Finset.nonempty_iff_ne_empty.mp hne) hempty) + exact (ProtoTileObservableExtensionality _ _ h10 ha).2.1 + +private theorem hSc11 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), ((Sc (1 : Fin (3 : + ℕ)) false).cells = (TileTranslation (FordTile P.q₂) ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩).cells) → + (BoundaryFootprintVertices (Sc 1 false) = BoundaryFootprintVertices (TileTranslation + (FordTile P.q₂) ⟨0, (P.q₁ : Int)⟩)) ) := by + classical + intro P Sc h11 + have hbase : (FordTile P.q₂).cells.Nonempty := by + exact ⟨⟨0, 0⟩, by simp [FordTile, FordCellDomain, P.q₂_pos]⟩ + have hne : (TileTranslation (FordTile P.q₂) + ⟨0, (P.q₁ : Int)⟩).cells.Nonempty := by + by_contra hn + have he := Finset.not_nonempty_iff_eq_empty.mp hn + rw [(TileTranslationFormulas _ _).2.2.1] at he + exact (Finset.nonempty_iff_ne_empty.mp hbase) he + have ha : (Sc 1 false).cells = ∅ → + (Sc 1 false).anchor = + (TileTranslation (FordTile P.q₂) ⟨0, (P.q₁ : Int)⟩).anchor := by + intro he + have hempty := h11.symm.trans he + exact False.elim ((Finset.nonempty_iff_ne_empty.mp hne) hempty) + exact (ProtoTileObservableExtensionality _ _ h11 ha).2.1 + +private theorem hSc00Foot : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), ((Sc (0 : Fin (3 : + ℕ)) true).cells = (FordTile P.q₁).cells) → ((0 < P.q₁) → (FootprintVertices (Sc 0 + true) = FootprintVertices (FordTile P.q₁))) ) := by + classical + intro P Sc h00 hrpos + have hne : (FordTile P.q₁).cells.Nonempty := + ⟨⟨0, 0⟩, by simp [FordTile, FordCellDomain, hrpos]⟩ + have ha : (Sc 0 true).cells = ∅ → + (Sc 0 true).anchor = (FordTile P.q₁).anchor := by + intro he + have hempty := h00.symm.trans he + exact False.elim ((Finset.nonempty_iff_ne_empty.mp hne) hempty) + exact (ProtoTileObservableExtensionality _ _ h00 ha).1 + +private theorem hSc01Foot : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), ((Sc (0 : Fin (3 : + ℕ)) false).cells = (TileTranslation (FordTile P.q₁) ⟨(↑P.q₂ : ℤ), (↑P.q₂ : + ℤ)⟩).cells) → ((0 < P.q₁) → (FootprintVertices (Sc 0 false) = FootprintVertices + (TileTranslation (FordTile P.q₁) ⟨(P.q₂ : Int), (P.q₂ : Int)⟩))) ) := by + classical + intro P Sc h01 hrpos + have hbase : (FordTile P.q₁).cells.Nonempty := + ⟨⟨0, 0⟩, by simp [FordTile, FordCellDomain, hrpos]⟩ + have hne : (TileTranslation (FordTile P.q₁) + ⟨(P.q₂ : Int), (P.q₂ : Int)⟩).cells.Nonempty := by + by_contra hn + have he := Finset.not_nonempty_iff_eq_empty.mp hn + rw [(TileTranslationFormulas _ _).2.2.1] at he + exact (Finset.nonempty_iff_ne_empty.mp hbase) he + have ha : (Sc 0 false).cells = ∅ → + (Sc 0 false).anchor = + (TileTranslation (FordTile P.q₁) + ⟨(P.q₂ : Int), (P.q₂ : Int)⟩).anchor := by + intro he + have hempty := h01.symm.trans he + exact False.elim ((Finset.nonempty_iff_ne_empty.mp hne) hempty) + exact (ProtoTileObservableExtensionality _ _ h01 ha).1 + +private theorem hSc10Foot : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), ((Sc (1 : Fin (3 : + ℕ)) true).cells = (TileTranslation (FordTile P.q₂) ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩).cells) → + (FootprintVertices (Sc 1 true) = FootprintVertices (TileTranslation (FordTile P.q₂) + ⟨(P.q₁ : Int), 0⟩)) ) := by + classical + intro P Sc h10 + have hbase : (FordTile P.q₂).cells.Nonempty := + ⟨⟨0, 0⟩, by simp [FordTile, FordCellDomain, P.q₂_pos]⟩ + have hne : (TileTranslation (FordTile P.q₂) + ⟨(P.q₁ : Int), 0⟩).cells.Nonempty := by + by_contra hn + have he := Finset.not_nonempty_iff_eq_empty.mp hn + rw [(TileTranslationFormulas _ _).2.2.1] at he + exact (Finset.nonempty_iff_ne_empty.mp hbase) he + have ha : (Sc 1 true).cells = ∅ → + (Sc 1 true).anchor = + (TileTranslation (FordTile P.q₂) ⟨(P.q₁ : Int), 0⟩).anchor := by + intro he + have hempty := h10.symm.trans he + exact False.elim ((Finset.nonempty_iff_ne_empty.mp hne) hempty) + exact (ProtoTileObservableExtensionality _ _ h10 ha).1 + +private theorem hSc11Foot : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), ((Sc (1 : Fin (3 : + ℕ)) false).cells = (TileTranslation (FordTile P.q₂) ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩).cells) → + (FootprintVertices (Sc 1 false) = FootprintVertices (TileTranslation (FordTile P.q₂) + ⟨0, (P.q₁ : Int)⟩)) ) := by + classical + intro P Sc h11 + have hbase : (FordTile P.q₂).cells.Nonempty := + ⟨⟨0, 0⟩, by simp [FordTile, FordCellDomain, P.q₂_pos]⟩ + have hne : (TileTranslation (FordTile P.q₂) + ⟨0, (P.q₁ : Int)⟩).cells.Nonempty := by + by_contra hn + have he := Finset.not_nonempty_iff_eq_empty.mp hn + rw [(TileTranslationFormulas _ _).2.2.1] at he + exact (Finset.nonempty_iff_ne_empty.mp hbase) he + have ha : (Sc 1 false).cells = ∅ → + (Sc 1 false).anchor = + (TileTranslation (FordTile P.q₂) ⟨0, (P.q₁ : Int)⟩).anchor := by + intro he + have hempty := h11.symm.trans he + exact False.elim ((Finset.nonempty_iff_ne_empty.mp hne) hempty) + exact (ProtoTileObservableExtensionality _ _ h11 ha).1 + +private theorem foot0 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : + GaussianInt), + let y : GaussianInt := x - u + ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices + (S i s) = FootprintVertices (TileTranslation (Sc i s) u) ∧ BoundaryFootprintVertices + (S i s) = BoundaryFootprintVertices (TileTranslation (Sc i s) u)) → ((0 < P.q₁) → ((∀ + (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), z ∈ FootprintVertices + (TileTranslation A v) ↔ z - v ∈ FootprintVertices A) → ((FootprintVertices (Sc 0 + true) = FootprintVertices (FordTile P.q₁)) → (x ∈ FootprintVertices (S 0 true) ↔ 0 ≤ + y.re ∧ y.re ≤ P.q₁ ∧ 0 ≤ y.im ∧ y.im ≤ P.q₁)))) ) := by + classical + intro P S u x y Sc hparentObs hrpos footprintTranslation hSc00Foot + rw [(hparentObs 0 true).1, footprintTranslation, hSc00Foot, + (P4062T1CanonicalSupport P.q₁ hrpos).1] + dsimp [FordVertexDomain, y] + rfl + +private theorem foot1 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : + GaussianInt), + let y : GaussianInt := x - u + ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices + (S i s) = FootprintVertices (TileTranslation (Sc i s) u) ∧ BoundaryFootprintVertices + (S i s) = BoundaryFootprintVertices (TileTranslation (Sc i s) u)) → ((0 < P.q₁) → + (((P.q : Int) = P.q₁ + P.q₂) → ((∀ (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : + GaussianInt), z ∈ FootprintVertices (TileTranslation A v) ↔ z - v ∈ FootprintVertices + A) → ((FootprintVertices (Sc 0 false) = FootprintVertices (TileTranslation (FordTile + P.q₁) ⟨(P.q₂ : Int), (P.q₂ : Int)⟩)) → (x ∈ FootprintVertices (S 0 false) ↔ P.q₂ ≤ + y.re ∧ y.re ≤ P.q ∧ P.q₂ ≤ y.im ∧ y.im ≤ P.q))))) ) := by + classical + intro P S u x y Sc hparentObs hrpos hqsum footprintTranslation hSc01Foot + rw [(hparentObs 0 false).1, footprintTranslation, hSc01Foot, + footprintTranslation, (P4062T1CanonicalSupport P.q₁ hrpos).1] + dsimp [FordVertexDomain, y] + omega + +private theorem foot2 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : + GaussianInt), + let y : GaussianInt := x - u + ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices + (S i s) = FootprintVertices (TileTranslation (Sc i s) u) ∧ BoundaryFootprintVertices + (S i s) = BoundaryFootprintVertices (TileTranslation (Sc i s) u)) → (((P.q : Int) = + P.q₁ + P.q₂) → ((∀ (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), z ∈ + FootprintVertices (TileTranslation A v) ↔ z - v ∈ FootprintVertices A) → + ((FootprintVertices (Sc 1 true) = FootprintVertices (TileTranslation (FordTile P.q₂) + ⟨(P.q₁ : Int), 0⟩)) → (x ∈ FootprintVertices (S 1 true) ↔ P.q₁ ≤ y.re ∧ y.re ≤ P.q ∧ + 0 ≤ y.im ∧ y.im ≤ P.q₂)))) ) := by + classical + intro P S u x y Sc hparentObs hqsum footprintTranslation hSc10Foot + rw [(hparentObs 1 true).1, footprintTranslation, hSc10Foot, + footprintTranslation, (P4062T1CanonicalSupport P.q₂ P.q₂_pos).1] + dsimp [FordVertexDomain, y] + omega + +private theorem foot3 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : + GaussianInt), + let y : GaussianInt := x - u + ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices + (S i s) = FootprintVertices (TileTranslation (Sc i s) u) ∧ BoundaryFootprintVertices + (S i s) = BoundaryFootprintVertices (TileTranslation (Sc i s) u)) → (((P.q : Int) = + P.q₁ + P.q₂) → ((∀ (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), z ∈ + FootprintVertices (TileTranslation A v) ↔ z - v ∈ FootprintVertices A) → + ((FootprintVertices (Sc 1 false) = FootprintVertices (TileTranslation (FordTile P.q₂) + ⟨0, (P.q₁ : Int)⟩)) → (x ∈ FootprintVertices (S 1 false) ↔ 0 ≤ y.re ∧ y.re ≤ P.q₂ ∧ + P.q₁ ≤ y.im ∧ y.im ≤ P.q)))) ) := by + classical + intro P S u x y Sc hparentObs hqsum footprintTranslation hSc11Foot + rw [(hparentObs 1 false).1, footprintTranslation, hSc11Foot, + footprintTranslation, (P4062T1CanonicalSupport P.q₂ P.q₂_pos).1] + dsimp [FordVertexDomain, y] + omega + +private theorem squareBoundary : + (by + classical + exact + ∀ (n : ℕ), (0 : ℕ) < n → ∀ (z : GaussianInt), z ∈ BoundaryFootprintVertices (FordTile n) + ↔ (0 : ℤ) ≤ z.re ∧ z.re ≤ (↑n : ℤ) ∧ (0 : ℤ) ≤ z.im ∧ z.im ≤ (↑n : ℤ) ∧ (z.re = (0 : + ℤ) ∨ z.re = (↑n : ℤ) ∨ z.im = (0 : ℤ) ∨ z.im = (↑n : ℤ)) ) := by + classical + intro n hn z + have hb := (P4062T1CanonicalSupport n hn).2 + rw [hb] + simp only [Set.mem_ofPred_eq] + +private theorem domain0 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (u : GaussianInt), ∀ (x : GaussianInt), + let y : GaussianInt := x - u + (∀ (l : Int), ∀ (r : Int), ∀ (b : Int), ∀ (t : Int), ∀ (z : GaussianInt), z ∈ + LatticeVertexBoundary {w : GaussianInt | l ≤ w.re ∧ w.re ≤ r ∧ b ≤ w.im ∧ w.im ≤ t} ↔ + (l ≤ z.re ∧ z.re ≤ r ∧ b ≤ z.im ∧ z.im ≤ t) ∧ (z.re = l ∨ z.re = r ∨ z.im = b ∨ z.im + = t)) → (y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) ↔ (0 : Int) ≤ + y.re ∧ y.re ≤ P.q₁ ∧ 0 ≤ y.im ∧ y.im ≤ P.q₁ ∧ (y.re = 0 ∨ y.re = P.q₁ ∨ y.im = 0 ∨ + y.im = P.q₁)) ) := by + classical + intro P u x y rectBoundary + change y ∈ LatticeVertexBoundary {z : GaussianInt | + 0 ≤ z.re ∧ z.re ≤ P.q₁ ∧ 0 ≤ z.im ∧ z.im ≤ P.q₁} ↔ _ + rw [rectBoundary] + simp only [and_assoc] + +private theorem domain1 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (u : GaussianInt), ∀ (x : GaussianInt), + let y : GaussianInt := x - u + (∀ (l : Int), ∀ (r : Int), ∀ (b : Int), ∀ (t : Int), ∀ (z : GaussianInt), z ∈ + LatticeVertexBoundary {w : GaussianInt | l ≤ w.re ∧ w.re ≤ r ∧ b ≤ w.im ∧ w.im ≤ t} ↔ + (l ≤ z.re ∧ z.re ≤ r ∧ b ≤ z.im ∧ z.im ≤ t) ∧ (z.re = l ∨ z.re = r ∨ z.im = b ∨ z.im + = t)) → (y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) ↔ (P.q₂ : Int) ≤ + y.re ∧ y.re ≤ P.q ∧ P.q₂ ≤ y.im ∧ y.im ≤ P.q ∧ (y.re = P.q₂ ∨ y.re = P.q ∨ y.im = + P.q₂ ∨ y.im = P.q)) ) := by + classical + intro P u x y rectBoundary + change y ∈ LatticeVertexBoundary {z : GaussianInt | + P.q₂ ≤ z.re ∧ z.re ≤ P.q ∧ P.q₂ ≤ z.im ∧ z.im ≤ P.q} ↔ _ + rw [rectBoundary] + simp only [and_assoc] + +private theorem domain2 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (u : GaussianInt), ∀ (x : GaussianInt), + let y : GaussianInt := x - u + (∀ (l : Int), ∀ (r : Int), ∀ (b : Int), ∀ (t : Int), ∀ (z : GaussianInt), z ∈ + LatticeVertexBoundary {w : GaussianInt | l ≤ w.re ∧ w.re ≤ r ∧ b ≤ w.im ∧ w.im ≤ t} ↔ + (l ≤ z.re ∧ z.re ≤ r ∧ b ≤ z.im ∧ z.im ≤ t) ∧ (z.re = l ∨ z.re = r ∨ z.im = b ∨ z.im + = t)) → (y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) ↔ P.q₁ ≤ y.re ∧ + y.re ≤ P.q ∧ (0 : Int) ≤ y.im ∧ y.im ≤ P.q₂ ∧ (y.re = P.q₁ ∨ y.re = P.q ∨ y.im = 0 ∨ + y.im = P.q₂)) ) := by + classical + intro P u x y rectBoundary + change y ∈ LatticeVertexBoundary {z : GaussianInt | + P.q₁ ≤ z.re ∧ z.re ≤ P.q ∧ 0 ≤ z.im ∧ z.im ≤ P.q₂} ↔ _ + rw [rectBoundary] + simp only [and_assoc] + +private theorem domain3 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (u : GaussianInt), ∀ (x : GaussianInt), + let y : GaussianInt := x - u + (∀ (l : Int), ∀ (r : Int), ∀ (b : Int), ∀ (t : Int), ∀ (z : GaussianInt), z ∈ + LatticeVertexBoundary {w : GaussianInt | l ≤ w.re ∧ w.re ≤ r ∧ b ≤ w.im ∧ w.im ≤ t} ↔ + (l ≤ z.re ∧ z.re ≤ r ∧ b ≤ z.im ∧ z.im ≤ t) ∧ (z.re = l ∨ z.re = r ∨ z.im = b ∨ z.im + = t)) → (y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) ↔ (0 : Int) ≤ + y.re ∧ y.re ≤ P.q₂ ∧ P.q₁ ≤ y.im ∧ y.im ≤ P.q ∧ (y.re = 0 ∨ y.re = P.q₂ ∨ y.im = P.q₁ + ∨ y.im = P.q)) ) := by + classical + intro P u x y rectBoundary + change y ∈ LatticeVertexBoundary {z : GaussianInt | + 0 ≤ z.re ∧ z.re ≤ P.q₂ ∧ P.q₁ ≤ z.im ∧ z.im ≤ P.q} ↔ _ + rw [rectBoundary] + simp only [and_assoc] + +private theorem label0 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : + GaussianInt), + let y : GaussianInt := x - u + ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices + (S i s) = FootprintVertices (TileTranslation (Sc i s) u) ∧ BoundaryFootprintVertices + (S i s) = BoundaryFootprintVertices (TileTranslation (Sc i s) u)) → ((0 < P.q₁) → ((∀ + (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), z ∈ + BoundaryFootprintVertices (TileTranslation A v) ↔ z - v ∈ BoundaryFootprintVertices + A) → ((BoundaryFootprintVertices (Sc 0 true) = BoundaryFootprintVertices (FordTile + P.q₁)) → ((∀ (n : Nat), (0 < n) → (∀ (z : GaussianInt), z ∈ BoundaryFootprintVertices + (FordTile n) ↔ 0 ≤ z.re ∧ z.re ≤ (n : Int) ∧ 0 ≤ z.im ∧ z.im ≤ (n : Int) ∧ (z.re = 0 + ∨ z.re = n ∨ z.im = 0 ∨ z.im = n))) → ((y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 0) ↔ (0 : Int) ≤ y.re ∧ y.re ≤ P.q₁ ∧ 0 ≤ y.im ∧ y.im ≤ + P.q₁ ∧ (y.re = 0 ∨ y.re = P.q₁ ∨ y.im = 0 ∨ y.im = P.q₁)) → (x ∈ + BoundaryFootprintVertices (S 0 true) ↔ y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 0))))))) ) := by + classical + intro P S u x y Sc hparentObs hrpos boundaryTranslation hSc00 squareBoundary domain0 + rw [(hparentObs 0 true).2, boundaryTranslation, hSc00] + rw [squareBoundary P.q₁ hrpos] + dsimp [y] + rw [domain0] + exact Iff.rfl + +private theorem label1 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : + GaussianInt), + let y : GaussianInt := x - u + ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices + (S i s) = FootprintVertices (TileTranslation (Sc i s) u) ∧ BoundaryFootprintVertices + (S i s) = BoundaryFootprintVertices (TileTranslation (Sc i s) u)) → ((0 < P.q₁) → + (((P.q : Int) = P.q₁ + P.q₂) → ((∀ (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : + GaussianInt), z ∈ BoundaryFootprintVertices (TileTranslation A v) ↔ z - v ∈ + BoundaryFootprintVertices A) → ((BoundaryFootprintVertices (Sc 0 false) = + BoundaryFootprintVertices (TileTranslation (FordTile P.q₁) ⟨(P.q₂ : Int), (P.q₂ : + Int)⟩)) → ((∀ (n : Nat), (0 < n) → (∀ (z : GaussianInt), z ∈ + BoundaryFootprintVertices (FordTile n) ↔ 0 ≤ z.re ∧ z.re ≤ (n : Int) ∧ 0 ≤ z.im ∧ + z.im ≤ (n : Int) ∧ (z.re = 0 ∨ z.re = n ∨ z.im = 0 ∨ z.im = n))) → ((y ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 1) ↔ (P.q₂ : Int) ≤ y.re ∧ y.re ≤ + P.q ∧ P.q₂ ≤ y.im ∧ y.im ≤ P.q ∧ (y.re = P.q₂ ∨ y.re = P.q ∨ y.im = P.q₂ ∨ y.im = + P.q)) → (x ∈ BoundaryFootprintVertices (S 0 false) ↔ y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 1)))))))) ) := by + classical + intro P S u x y Sc hparentObs hrpos hqsum boundaryTranslation hSc01 squareBoundary domain1 + rw [(hparentObs 0 false).2, boundaryTranslation, hSc01] + rw [boundaryTranslation, squareBoundary P.q₁ hrpos] + rw [domain1] + dsimp [y] + omega + +private theorem label2 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : + GaussianInt), + let y : GaussianInt := x - u + ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices + (S i s) = FootprintVertices (TileTranslation (Sc i s) u) ∧ BoundaryFootprintVertices + (S i s) = BoundaryFootprintVertices (TileTranslation (Sc i s) u)) → (((P.q₂ : Int) > + 0) → (((P.q : Int) = P.q₁ + P.q₂) → ((∀ (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : + GaussianInt), z ∈ BoundaryFootprintVertices (TileTranslation A v) ↔ z - v ∈ + BoundaryFootprintVertices A) → ((BoundaryFootprintVertices (Sc 1 true) = + BoundaryFootprintVertices (TileTranslation (FordTile P.q₂) ⟨(P.q₁ : Int), 0⟩)) → ((∀ + (n : Nat), (0 < n) → (∀ (z : GaussianInt), z ∈ BoundaryFootprintVertices (FordTile n) + ↔ 0 ≤ z.re ∧ z.re ≤ (n : Int) ∧ 0 ≤ z.im ∧ z.im ≤ (n : Int) ∧ (z.re = 0 ∨ z.re = n ∨ + z.im = 0 ∨ z.im = n))) → ((y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) + ↔ P.q₁ ≤ y.re ∧ y.re ≤ P.q ∧ (0 : Int) ≤ y.im ∧ y.im ≤ P.q₂ ∧ (y.re = P.q₁ ∨ y.re = + P.q ∨ y.im = 0 ∨ y.im = P.q₂)) → (x ∈ BoundaryFootprintVertices (S 1 true) ↔ y ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 2)))))))) ) := by + classical + intro P S u x y Sc hparentObs ht hqsum boundaryTranslation hSc10 squareBoundary domain2 + rw [(hparentObs 1 true).2, boundaryTranslation, hSc10] + rw [boundaryTranslation, squareBoundary P.q₂ P.q₂_pos] + rw [domain2] + dsimp [y] + omega + +private theorem label3 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : + GaussianInt), + let y : GaussianInt := x - u + ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices + (S i s) = FootprintVertices (TileTranslation (Sc i s) u) ∧ BoundaryFootprintVertices + (S i s) = BoundaryFootprintVertices (TileTranslation (Sc i s) u)) → (((P.q₂ : Int) > + 0) → (((P.q : Int) = P.q₁ + P.q₂) → ((∀ (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : + GaussianInt), z ∈ BoundaryFootprintVertices (TileTranslation A v) ↔ z - v ∈ + BoundaryFootprintVertices A) → ((BoundaryFootprintVertices (Sc 1 false) = + BoundaryFootprintVertices (TileTranslation (FordTile P.q₂) ⟨0, (P.q₁ : Int)⟩)) → ((∀ + (n : Nat), (0 < n) → (∀ (z : GaussianInt), z ∈ BoundaryFootprintVertices (FordTile n) + ↔ 0 ≤ z.re ∧ z.re ≤ (n : Int) ∧ 0 ≤ z.im ∧ z.im ≤ (n : Int) ∧ (z.re = 0 ∨ z.re = n ∨ + z.im = 0 ∨ z.im = n))) → ((y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) + ↔ (0 : Int) ≤ y.re ∧ y.re ≤ P.q₂ ∧ P.q₁ ≤ y.im ∧ y.im ≤ P.q ∧ (y.re = 0 ∨ y.re = P.q₂ + ∨ y.im = P.q₁ ∨ y.im = P.q)) → (x ∈ BoundaryFootprintVertices (S 1 false) ↔ y ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 3)))))))) ) := by + classical + intro P S u x y Sc hparentObs ht hqsum boundaryTranslation hSc11 squareBoundary domain3 + rw [(hparentObs 1 false).2, boundaryTranslation, hSc11] + rw [boundaryTranslation, squareBoundary P.q₂ P.q₂_pos] + rw [domain3] + dsimp [y] + omega + +private theorem lineTrue : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : + GaussianInt), + let y : GaussianInt := x - u + (1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ 1 ≤ y.im ∧ y.im ≤ (P.q : Int) - 1) → (∀ (Sc : Fin (3 + : ℕ) → Bool → ProtoTile), ((Sc (2 : Fin (3 : ℕ)) true).cells = ∅) → (((Sc (2 : Fin (3 + : ℕ)) true).anchor = ⟨(↑P.q₂ : ℤ), (↑P.q : ℤ)⟩) → ((∀ (i : Fin 3), ∀ (s : Bool), + FootprintVertices (S i s) = FootprintVertices (TileTranslation (Sc i s) u) ∧ + BoundaryFootprintVertices (S i s) = BoundaryFootprintVertices (TileTranslation (Sc i + s) u)) → (((P.q : Int) = P.q₁ + P.q₂) → ((∀ (A : ProtoTile), ∀ (v : GaussianInt), ∀ + (z : GaussianInt), z ∈ BoundaryFootprintVertices (TileTranslation A v) ↔ z - v ∈ + BoundaryFootprintVertices A) → (x ∉ BoundaryFootprintVertices (S 2 true))))))) ) := by + classical + intro P S u x y hbounds Sc h20 h20a hparentObs hqsum boundaryTranslation + rw [(hparentObs 2 true).2, boundaryTranslation] + simp only [BoundaryFootprintVertices, h20, Finset.not_nonempty_iff_eq_empty, + ite_eq_right, Set.mem_singleton_iff, h20a] + intro he + have him : (x - u).im = (P.q : Int) := by + simpa using congrArg (fun z : GaussianInt => z.im) he + have hi : (x - u).im ≤ (P.q : Int) - 1 := by + simpa [y] using hbounds.2.2.2 + omega + +private theorem lineFalse : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : + GaussianInt), + let y : GaussianInt := x - u + (1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ 1 ≤ y.im ∧ y.im ≤ (P.q : Int) - 1) → (∀ (Sc : Fin (3 + : ℕ) → Bool → ProtoTile), ((Sc (2 : Fin (3 : ℕ)) false).cells = ∅) → (((Sc (2 : Fin + (3 : ℕ)) false).anchor = ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩) → ((∀ (i : Fin 3), ∀ (s : Bool), + FootprintVertices (S i s) = FootprintVertices (TileTranslation (Sc i s) u) ∧ + BoundaryFootprintVertices (S i s) = BoundaryFootprintVertices (TileTranslation (Sc i + s) u)) → ((∀ (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), z ∈ + BoundaryFootprintVertices (TileTranslation A v) ↔ z - v ∈ BoundaryFootprintVertices + A) → (x ∉ BoundaryFootprintVertices (S 2 false)))))) ) := by + classical + intro P S u x y hbounds Sc h21 h21a hparentObs boundaryTranslation + rw [(hparentObs 2 false).2, boundaryTranslation] + simp only [BoundaryFootprintVertices, h21, Finset.not_nonempty_iff_eq_empty, + ite_eq_right, Set.mem_singleton_iff, h21a] + intro he + have him : (x - u).im = 0 := by + simpa using congrArg (fun z : GaussianInt => z.im) he + have hi : 1 ≤ (x - u).im := by simpa [y] using hbounds.2.2.1 + omega + +private theorem hcardSix : + (by + classical + exact + ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (x : GaussianInt), Nat.card + {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} = (if x ∈ + BoundaryFootprintVertices (S 0 true) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 0 false) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 1 true) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 1 false) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 2 true) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 2 false) then 1 else 0) ) := by + classical + intro S x + classical + rw [Nat.card_eq_fintype_card, Fintype.card_subtype] + change (Finset.univ.filter fun a : Fin 3 × Bool => + x ∈ BoundaryFootprintVertices (S a.1 a.2)).card = _ + simp only [Finset.card_filter] + rw [← Finset.univ_product_univ, Finset.sum_product] + simp only [Fintype.sum_bool, Fin.sum_univ_succ, Fin.sum_univ_zero, + add_zero, + Fin.succ_zero_eq_one, Fin.succ_one_eq_two] + ring + +private theorem hcardFour : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (u : GaussianInt), ∀ (x : GaussianInt), + let y : GaussianInt := x - u + FordBoundaryMultiplicity P y = Nat.card + {i : Fin 4 // y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P i)} ) := by + classical + intro P u x y + classical + unfold FordBoundaryMultiplicity + rw [Nat.card_eq_fintype_card, Fintype.card_subtype] + +private theorem hcardFourFormula : + (by + classical + exact + ∀ (P : FordFareyParameter), (Fin 3 → Bool → ProtoTile) → (∀ (u : GaussianInt), ∀ (x : + GaussianInt), + let y : GaussianInt := x - u + FordBoundaryMultiplicity P y = (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains + P 0) then 1 else 0) + (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) + then 1 else 0) + (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) then + 1 else 0) + (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) then 1 + else 0)) ) := by + classical + intro P S u x y + classical + unfold FordBoundaryMultiplicity + simp only [Finset.card_filter, Fin.sum_univ_succ, Fin.sum_univ_zero, add_zero] + change (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) then 1 else 0) + + ((if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) then 1 else 0) + + ((if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) then 1 else 0) + + (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) then 1 else 0))) = _ + omega + +private theorem hcount : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : + GaussianInt), + let y : GaussianInt := x - u + (x ∈ BoundaryFootprintVertices (S 0 true) ↔ y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 0)) → ((x ∈ BoundaryFootprintVertices (S 0 false) ↔ y ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 1)) → ((x ∈ + BoundaryFootprintVertices (S 1 true) ↔ y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 2)) → ((x ∈ BoundaryFootprintVertices (S 1 false) ↔ y ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 3)) → ((x ∉ + BoundaryFootprintVertices (S 2 true)) → ((x ∉ BoundaryFootprintVertices (S 2 false)) + → ((Nat.card {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} = (if x + ∈ BoundaryFootprintVertices (S 0 true) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 0 false) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 1 true) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 1 false) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 2 true) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 2 false) then 1 else 0)) → ((FordBoundaryMultiplicity P + y = (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) then 1 else 0) + + (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) then 1 else 0) + (if y + ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) then 1 else 0) + (if y ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 3) then 1 else 0)) → (Nat.card + {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} = + FordBoundaryMultiplicity P y)))))))) ) := by + classical + intro P S u x y label0 label1 label2 label3 lineTrue lineFalse hcardSix hcardFourFormula + rw [hcardSix, hcardFourFormula] + rw [label0, label1, label2, label3] + simp only [ite_eq_right lineTrue, ite_eq_right lineFalse] + omega + +private theorem rootCentroid : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), (TileCentroid + (FordTile P.q) = ((P.q : Real) / 2, (P.q : Real) / 2)) → ((FootprintVertices T = + FootprintVertices (TileTranslation (FordTile P.q) u) ∧ BoundaryFootprintVertices T = + BoundaryFootprintVertices (TileTranslation (FordTile P.q) u) ∧ BoundaryFootprintEdges + T = BoundaryFootprintEdges (TileTranslation (FordTile P.q) u) ∧ TileRealization T = + TileRealization (TileTranslation (FordTile P.q) u) ∧ TileCentroid T = TileCentroid + (TileTranslation (FordTile P.q) u)) → (TileCentroid T = ((P.q : Real) / 2 + (u.re : + Real), (P.q : Real) / 2 + (u.im : Real)))) ) := by + classical + intro P T u fordCentroid hrootObs + rw [hrootObs.2.2.2.2, + (TileTranslationFormulas (FordTile P.q) u).2.2.2.2.1, + fordCentroid] + +private theorem centerCoords : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (x : GaussianInt), + let y : GaussianInt := x - u + (TileCentroid T = ((P.q : Real) / 2 + (u.re : Real), (P.q : Real) / 2 + (u.im : Real))) → + (GaussianRealPoint x = TileCentroid T → (↑y.re : ℝ) = (↑P.q : ℝ) / (2 : ℝ) ∧ (↑y.im : + ℝ) = (↑P.q : ℝ) / (2 : ℝ)) ) := by + classical + intro P T u x y rootCentroid hc + rw [rootCentroid] at hc + dsimp [GaussianRealPoint] at hc + have hr := congrArg Prod.fst hc + have hi := congrArg Prod.snd hc + constructor + · dsimp [y] + push_cast at hr ⊢ + linarith + · dsimp [y] + push_cast at hi ⊢ + linarith + +private theorem centerTwice : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (x : GaussianInt), + let y : GaussianInt := x - u + ((GaussianRealPoint x = TileCentroid T) → (((y.re : Int) : Real) = (P.q : Real) / 2 ∧ + ((y.im : Int) : Real) = (P.q : Real) / 2)) → (GaussianRealPoint x = TileCentroid T → + (2 : ℤ) * y.re = (↑P.q : ℤ) ∧ (2 : ℤ) * y.im = (↑P.q : ℤ)) ) := by + classical + intro P T u x y centerCoords hc + obtain ⟨hrc, hic⟩ := centerCoords hc + constructor + · have he : ((2 * y.re : Int) : Real) = (P.q : Real) := by + push_cast + linarith + exact_mod_cast he + · have he : ((2 * y.im : Int) : Real) = (P.q : Real) := by + push_cast + linarith + exact_mod_cast he + +private theorem noCenteredCountTwo : + (by + classical + exact + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → (∀ (T : ProtoTile), (Fin 3 → Bool → + ProtoTile) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), + let y : GaussianInt := x - u + (1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ 1 ≤ y.im ∧ y.im ≤ (P.q : Int) - 1) → ((0 < P.q₁) → + (((P.q : Int) = P.q₁ + P.q₂) → ((y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 0) ↔ (0 : Int) ≤ y.re ∧ y.re ≤ P.q₁ ∧ 0 ≤ y.im ∧ y.im ≤ + P.q₁ ∧ (y.re = 0 ∨ y.re = P.q₁ ∨ y.im = 0 ∨ y.im = P.q₁)) → ((y ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 1) ↔ (P.q₂ : Int) ≤ y.re ∧ y.re ≤ + P.q ∧ P.q₂ ≤ y.im ∧ y.im ≤ P.q ∧ (y.re = P.q₂ ∨ y.re = P.q ∨ y.im = P.q₂ ∨ y.im = + P.q)) → ((y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) ↔ P.q₁ ≤ y.re ∧ + y.re ≤ P.q ∧ (0 : Int) ≤ y.im ∧ y.im ≤ P.q₂ ∧ (y.re = P.q₁ ∨ y.re = P.q ∨ y.im = 0 ∨ + y.im = P.q₂)) → ((y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) ↔ (0 : + Int) ≤ y.re ∧ y.re ≤ P.q₂ ∧ P.q₁ ≤ y.im ∧ y.im ≤ P.q ∧ (y.re = 0 ∨ y.re = P.q₂ ∨ y.im + = P.q₁ ∨ y.im = P.q)) → ((FordBoundaryMultiplicity P y = (if y ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 0) then 1 else 0) + (if y ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 1) then 1 else 0) + (if y ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 2) then 1 else 0) + (if y ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 3) then 1 else 0)) → + (((GaussianRealPoint x = TileCentroid T) → (2 * y.re = (P.q : Int) ∧ 2 * y.im = (P.q + : Int))) → (GaussianRealPoint x = TileCentroid T → FordBoundaryMultiplicity P y ≠ (2 + : ℕ)))))))))))) ) := by + classical + intro P hP T S u x y hbounds hrpos hqsum domain0 domain1 domain2 domain3 hcardFourFormula + centerTwice hc + obtain ⟨h2re, h2im⟩ := centerTwice hc + by_cases heq : P.q₁ = P.q₂ + · have d0 : y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) := by + apply domain0.mpr + refine ⟨by omega, by omega, by omega, by omega, ?_⟩ + exact Or.inr (Or.inl (by omega)) + have d1 : y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) := by + apply domain1.mpr + refine ⟨by omega, by omega, by omega, by omega, ?_⟩ + exact Or.inl (by omega) + have d2 : y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) := by + apply domain2.mpr + refine ⟨by omega, by omega, by omega, by omega, ?_⟩ + exact Or.inl (by omega) + have d3 : y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) := by + apply domain3.mpr + refine ⟨by omega, by omega, by omega, by omega, ?_⟩ + exact Or.inr (Or.inr (Or.inl (by omega))) + intro hm + rw [hcardFourFormula] at hm + simp [d0, d1, d2, d3] at hm + · have nd0 : y ∉ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) := by + intro hd + rcases domain0.mp hd with ⟨_, _, _, _, hside⟩ + rcases hside with h | h | h | h <;> omega + have nd1 : y ∉ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) := by + intro hd + rcases domain1.mp hd with ⟨_, _, _, _, hside⟩ + rcases hside with h | h | h | h <;> omega + have nd2 : y ∉ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) := by + intro hd + rcases domain2.mp hd with ⟨_, _, _, _, hside⟩ + rcases hside with h | h | h | h <;> omega + have nd3 : y ∉ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) := by + intro hd + rcases domain3.mp hd with ⟨_, _, _, _, hside⟩ + rcases hside with h | h | h | h <;> omega + intro hm + rw [hcardFourFormula] at hm + simp only [ite_eq_right nd0, ite_eq_right nd1, ite_eq_right nd2, ite_eq_right nd3] at hm + norm_num at hm + +private theorem countFourConclusion : + (by + classical + exact + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → (∀ (T : ProtoTile), ∀ (S : Fin 3 → Bool → + ProtoTile), ∀ (u : GaussianInt), ∀ (x : GaussianInt), + let y : GaussianInt := x - u + ((P.q : Int) = P.q₁ + P.q₂) → ((y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P + 0) ↔ (0 : Int) ≤ y.re ∧ y.re ≤ P.q₁ ∧ 0 ≤ y.im ∧ y.im ≤ P.q₁ ∧ (y.re = 0 ∨ y.re = + P.q₁ ∨ y.im = 0 ∨ y.im = P.q₁)) → ((y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 1) ↔ (P.q₂ : Int) ≤ y.re ∧ y.re ≤ P.q ∧ P.q₂ ≤ y.im ∧ + y.im ≤ P.q ∧ (y.re = P.q₂ ∨ y.re = P.q ∨ y.im = P.q₂ ∨ y.im = P.q)) → ((y ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 2) ↔ P.q₁ ≤ y.re ∧ y.re ≤ P.q ∧ + (0 : Int) ≤ y.im ∧ y.im ≤ P.q₂ ∧ (y.re = P.q₁ ∨ y.re = P.q ∨ y.im = 0 ∨ y.im = P.q₂)) + → ((y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) ↔ (0 : Int) ≤ y.re ∧ + y.re ≤ P.q₂ ∧ P.q₁ ≤ y.im ∧ y.im ≤ P.q ∧ (y.re = 0 ∨ y.re = P.q₂ ∨ y.im = P.q₁ ∨ y.im + = P.q)) → ((FordBoundaryMultiplicity P y = (if y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 0) then 1 else 0) + (if y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 1) then 1 else 0) + (if y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 2) then 1 else 0) + (if y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 3) then 1 else 0)) → ((Nat.card + {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} = + FordBoundaryMultiplicity P y) → ((TileCentroid T = ((P.q : Real) / 2 + (u.re : Real), + (P.q : Real) / 2 + (u.im : Real))) → (Nat.card + { a : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2) } = (4 : ℕ) → + P.q = (2 : ℕ) ∧ GaussianRealPoint x = TileCentroid T))))))))) ) := by + classical + intro P hP T S u x y hqsum domain0 domain1 domain2 domain3 hcardFourFormula hcount rootCentroid hk + have hm : FordBoundaryMultiplicity P y = 4 := hcount.symm.trans hk + have d0 : y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) := by + by_contra hn + rw [hcardFourFormula] at hm + simp only [ite_eq_right hn] at hm + split_ifs at hm <;> omega + have d1 : y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) := by + by_contra hn + rw [hcardFourFormula] at hm + simp only [ite_eq_right hn] at hm + split_ifs at hm <;> omega + have d2 : y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) := by + by_contra hn + rw [hcardFourFormula] at hm + simp only [ite_eq_right hn] at hm + split_ifs at hm <;> omega + have d3 : y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) := by + by_contra hn + rw [hcardFourFormula] at hm + simp only [ite_eq_right hn] at hm + split_ifs at hm; omega + rcases domain0.mp d0 with ⟨_, h0r, _, h0i, _⟩ + rcases domain1.mp d1 with ⟨h1r, _, h1i, _, _⟩ + rcases domain2.mp d2 with ⟨h2r, _, _, h2i, _⟩ + rcases domain3.mp d3 with ⟨_, h3r, h3i, _, _⟩ + have heq : P.q₁ = P.q₂ := by + apply Nat.le_antisymm + · exact_mod_cast (le_trans (show (P.q₁ : Int) ≤ y.im by omega) h2i) + · exact_mod_cast (le_trans (show (P.q₂ : Int) ≤ y.re by omega) h0r) + have hqeq : (P.q : Int) = 2 * (P.q₁ : Int) := by + have hs : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by + exact_mod_cast P.sum_q + have heq' : (P.q₁ : Int) = (P.q₂ : Int) := by exact_mod_cast heq + rw [heq'] at hs + nlinarith [hs] + have hdet := P.det₁ + have hp := P.sum_p + have hprod : (P.q₁ : Int) * (P.p₁ - P.p₂) = 1 := by + rw [hp, hqeq] at hdet + calc + (P.q₁ : Int) * (P.p₁ - P.p₂) = + P.p₁ * (2 * P.q₁) - P.q₁ * (P.p₁ + P.p₂) := by ring + _ = 1 := by simpa [mul_comm, mul_left_comm, mul_assoc] using hdet + have hdiv : (P.q₁ : Int) ∣ 1 := ⟨P.p₁ - P.p₂, hprod.symm⟩ + have hroneInt := Int.eq_one_of_dvd_one (by omega : (0 : Int) ≤ P.q₁) hdiv + have hrone : P.q₁ = 1 := by exact_mod_cast hroneInt + have hqone : P.q = 2 := by omega + have hyre : y.re = 1 := by omega + have hyim : y.im = 1 := by omega + have hxre : x.re = u.re + 1 := by + have h := congrArg (fun z : GaussianInt => z.re) (show x - u = y by rfl) + simp only [Zsqrtd.re_sub] at h + rw [hyre] at h + omega + have hxim : x.im = u.im + 1 := by + have h := congrArg (fun z : GaussianInt => z.im) (show x - u = y by rfl) + simp only [Zsqrtd.im_sub] at h + rw [hyim] at h + omega + refine ⟨hqone, ?_⟩ + rw [rootCentroid, hqone] + norm_num + apply Prod.ext + · dsimp [GaussianRealPoint] + have hr : (x.re : Real) = (u.re : Real) + 1 := by exact_mod_cast hxre + simpa only [GaussianInt.intCast_re, add_comm] using hr + · dsimp [GaussianRealPoint] + have hi : (x.im : Real) = (u.im : Real) + 1 := by exact_mod_cast hxim + simpa only [GaussianInt.intCast_im, add_comm] using hi + +private theorem incidentFootprint : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (R : ProtoTile), ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x + j ∈ R.cells → x ∈ FootprintVertices R ) := by + classical + intro x R j hc + have hneR : R.cells.Nonempty := ⟨_, hc⟩ + simp only [FootprintVertices, ite_eq_left hneR] + refine ⟨LatticeVertexIncidentCell x j, hc, ?_⟩ + fin_cases j + · exact Or.inl rfl + · exact Or.inr (Or.inl (by simp [LatticeVertexIncidentCell])) + · exact Or.inr (Or.inr (Or.inr (by + simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm]))) + · exact Or.inr (Or.inr (Or.inl (by simp [LatticeVertexIncidentCell]))) + +private theorem noBoundaryFour : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : + GaussianInt), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ + BoundaryFootprintVertices T) → ((∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T.cells) → ((∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) → ( + let y : GaussianInt := x - u + (1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ 1 ≤ y.im ∧ y.im ≤ (P.q : Int) - 1) → ((x ∈ + FootprintVertices (S 0 true) ↔ 0 ≤ y.re ∧ y.re ≤ P.q₁ ∧ 0 ≤ y.im ∧ y.im ≤ P.q₁) → ((x + ∈ FootprintVertices (S 0 false) ↔ P.q₂ ≤ y.re ∧ y.re ≤ P.q ∧ P.q₂ ≤ y.im ∧ y.im ≤ + P.q) → ((x ∈ FootprintVertices (S 1 true) ↔ P.q₁ ≤ y.re ∧ y.re ≤ P.q ∧ 0 ≤ y.im ∧ + y.im ≤ P.q₂) → ((x ∈ FootprintVertices (S 1 false) ↔ 0 ≤ y.re ∧ y.re ≤ P.q₂ ∧ P.q₁ ≤ + y.im ∧ y.im ≤ P.q) → ((y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) ↔ + (0 : Int) ≤ y.re ∧ y.re ≤ P.q₁ ∧ 0 ≤ y.im ∧ y.im ≤ P.q₁ ∧ (y.re = 0 ∨ y.re = P.q₁ ∨ + y.im = 0 ∨ y.im = P.q₁)) → ((y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P + 1) ↔ (P.q₂ : Int) ≤ y.re ∧ y.re ≤ P.q ∧ P.q₂ ≤ y.im ∧ y.im ≤ P.q ∧ (y.re = P.q₂ ∨ + y.re = P.q ∨ y.im = P.q₂ ∨ y.im = P.q)) → ((y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 2) ↔ P.q₁ ≤ y.re ∧ y.re ≤ P.q ∧ (0 : Int) ≤ y.im ∧ y.im + ≤ P.q₂ ∧ (y.re = P.q₁ ∨ y.re = P.q ∨ y.im = 0 ∨ y.im = P.q₂)) → ((y ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 3) ↔ (0 : Int) ≤ y.re ∧ y.re ≤ + P.q₂ ∧ P.q₁ ≤ y.im ∧ y.im ≤ P.q ∧ (y.re = 0 ∨ y.re = P.q₂ ∨ y.im = P.q₁ ∨ y.im = + P.q)) → ((x ∈ BoundaryFootprintVertices (S 0 true) ↔ y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 0)) → ((x ∈ BoundaryFootprintVertices (S 0 false) ↔ y ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 1)) → ((x ∈ + BoundaryFootprintVertices (S 1 true) ↔ y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 2)) → ((x ∈ BoundaryFootprintVertices (S 1 false) ↔ y ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P 3)) → ((x ∉ + BoundaryFootprintVertices (S 2 true)) → ((x ∉ BoundaryFootprintVertices (S 2 false)) + → ((Nat.card {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} = (if x + ∈ BoundaryFootprintVertices (S 0 true) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 0 false) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 1 true) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 1 false) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 2 true) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 2 false) then 1 else 0)) → ((FordBoundaryMultiplicity P + y = Nat.card + {i : Fin 4 // y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P i)}) → + ((FordBoundaryMultiplicity P y = (if y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 0) then 1 else 0) + (if y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 1) then 1 else 0) + (if y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 2) then 1 else 0) + (if y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 3) then 1 else 0)) → ((Nat.card + {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} = + FordBoundaryMultiplicity P y) → (((GaussianRealPoint x = TileCentroid T) → (((y.re : + Int) : Real) = (P.q : Real) / 2 ∧ ((y.im : Int) : Real) = (P.q : Real) / 2)) → + (((GaussianRealPoint x = TileCentroid T) → (2 * y.re = (P.q : Int) ∧ 2 * y.im = (P.q + : Int))) → (((GaussianRealPoint x = TileCentroid T) → (FordBoundaryMultiplicity P y ≠ + 2)) → (((Nat.card {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} = + 4) → (P.q = 2 ∧ GaussianRealPoint x = TileCentroid T)) → ((∀ (R : ProtoTile), ∀ (j : + Fin 4), (LatticeVertexIncidentCell x j ∈ R.cells) → (x ∈ FootprintVertices R)) → + (∀ (R : ProtoTile), (∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ + R.cells) → x ∉ + BoundaryFootprintVertices R))))))))))))))))))))))))))))) := by + classical + intro P T S u x hx hxb hsome cells y hbounds foot0 foot1 foot2 foot3 domain0 domain1 domain2 + domain3 label0 label1 label2 label3 lineTrue lineFalse hcardSix hcardFour hcardFourFormula + hcount centerCoords centerTwice noCenteredCountTwo countFourConclusion incidentFootprint R + hall + have hneR : R.cells.Nonempty := ⟨_, hall 0⟩ + intro hx + simp only [BoundaryFootprintVertices, ite_eq_left hneR, + Set.mem_ofPred_eq] at hx + rcases hx with ⟨e, he, hxe⟩ + change ∃ z : GaussianInt, + (e = {z, z + 1} ∧ + ((z ∈ R.cells ∧ z - ⟨0, 1⟩ ∉ R.cells) ∨ + (z ∉ R.cells ∧ z - ⟨0, 1⟩ ∈ R.cells))) ∨ + (e = {z, z + ⟨0, 1⟩} ∧ + ((z ∈ R.cells ∧ z - 1 ∉ R.cells) ∨ + (z ∉ R.cells ∧ z - 1 ∈ R.cells))) at he + rcases he with ⟨z, hz⟩ + rcases hz with ⟨rfl, htog⟩ | ⟨rfl, htog⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hxe with hxe | hxe + · subst x + have h0 : z ∈ R.cells := by + simpa [LatticeVertexIncidentCell] using hall 0 + have h3 : z - ⟨0, 1⟩ ∈ R.cells := by + simpa [LatticeVertexIncidentCell] using hall 3 + rcases htog with ⟨hz, hn⟩ | ⟨hn, hz⟩ + · exact hn h3 + · exact hn h0 + · have heq : x = z + 1 := hxe + subst x + have h1 : z ∈ R.cells := by + simpa [LatticeVertexIncidentCell] using hall 1 + have h2 : z - ⟨0, 1⟩ ∈ R.cells := by + simpa [LatticeVertexIncidentCell] using hall 2 + rcases htog with ⟨hz, hn⟩ | ⟨hn, hz⟩ + · exact hn h2 + · exact hn h1 + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hxe with hxe | hxe + · subst x + have h0 : z ∈ R.cells := by + simpa [LatticeVertexIncidentCell] using hall 0 + have h1 : z - 1 ∈ R.cells := by + simpa [LatticeVertexIncidentCell] using hall 1 + rcases htog with ⟨hz, hn⟩ | ⟨hn, hz⟩ + · exact hn h1 + · exact hn h0 + · have heq : x = z + ⟨0, 1⟩ := hxe + subst x + have h3 : z ∈ R.cells := by + simpa [LatticeVertexIncidentCell] using hall 3 + have h2 : z - 1 ∈ R.cells := by + simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hall 2 + rcases htog with ⟨hz, hn⟩ | ⟨hn, hz⟩ + · exact hn h2 + · exact hn h3 + +private theorem incidentOwner : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : + GaussianInt), ∀ (x : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell + x j ∈ T.cells) → ((∀ (z : GaussianInt), z ∈ T.cells ↔ z - u ∈ (FordTile P.q).cells) → + (∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (x : LatticeCell), x ∈ (FordTile + P.q).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (Sc i s).cells) → ((∀ (i : Fin 3), ∀ + (s : Bool), (S i s).cells = (TileTranslation (Sc i s) u).cells) → (∀ (j : Fin (4 : + ℕ)), ∃ (a : Fin (3 : ℕ) × Bool), LatticeVertexIncidentCell x j ∈ (S a.1 + a.2).cells))))) := by + classical + intro P T S u x cells cellCanonical Sc hcover hparentCells j + have hc := (cellCanonical (LatticeVertexIncidentCell x j)).mp (cells j) + obtain ⟨i, s, hs⟩ := (hcover (LatticeVertexIncidentCell x j - u)).mp hc + refine ⟨(i, s), ?_⟩ + rw [hparentCells i s, (TileTranslationFormulas (Sc i s) u).1] + apply Finset.mem_image.mpr + refine ⟨LatticeVertexIncidentCell x j - u, hs, ?_⟩ + dsimp [GaussianTranslation] + abel + +private theorem twoBoundaryCount : + (by + classical + exact + ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (x : GaussianInt), ∀ (a : Fin (3 : ℕ) × Bool), ∀ (b : + Fin (3 : ℕ) × Bool), a ≠ b → x ∈ BoundaryFootprintVertices (S a.1 a.2) → x ∈ + BoundaryFootprintVertices (S b.1 b.2) → (2 : ℕ) ≤ Nat.card + { c : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (S c.1 c.2) } ) := by + classical + intro S x a b hab ha hb + classical + let A := {c : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (S c.1 c.2)} + let f : Fin 2 → A := fun j => + if j = 0 then ⟨a, ha⟩ else ⟨b, hb⟩ + have hf : Function.Injective f := by + intro i j he + fin_cases i + · fin_cases j + · rfl + · have hv := congrArg Subtype.val he + have hv' : a = b := by simpa [f] using hv + exact False.elim (hab hv') + · fin_cases j + · have hv := congrArg Subtype.val he + have hv' : b = a := by simpa [f] using hv + exact False.elim (hab hv'.symm) + · rfl + rw [Nat.card_eq_fintype_card] + simpa [A] using Fintype.card_le_of_injective f hf + +private theorem multiplicityBound : + (by + classical + exact + ∀ (P : FordFareyParameter), (Fin 3 → Bool → ProtoTile) → (∀ (u : GaussianInt), ∀ (x : + GaussianInt), + let y : GaussianInt := x - u + (FordBoundaryMultiplicity P y = (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains + P 0) then 1 else 0) + (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) + then 1 else 0) + (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) then + 1 else 0) + (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) then 1 + else 0)) → (FordBoundaryMultiplicity P y ≤ 4)) ) := by + classical + intro P S u x y hcardFourFormula + rw [hcardFourFormula] + split_ifs <;> omega + +private theorem descent : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : + GaussianInt), + let y : GaussianInt := x - u + ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), ((Sc (2 : Fin (3 : ℕ)) true).cells = ∅) → (((Sc + (2 : Fin (3 : ℕ)) false).cells = ∅) → ((∀ (i : Fin 3), ∀ (s : Bool), (S i s).cells = + (TileTranslation (Sc i s) u).cells) → ((0 < P.q₁) → ((Nat.card + {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} = (if x ∈ + BoundaryFootprintVertices (S 0 true) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 0 false) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 1 true) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 1 false) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 2 true) then 1 else 0) + (if x ∈ + BoundaryFootprintVertices (S 2 false) then 1 else 0)) → ((FordBoundaryMultiplicity P + y = Nat.card + {i : Fin 4 // y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P i)}) → + ((FordBoundaryMultiplicity P y = (if y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 0) then 1 else 0) + (if y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 1) then 1 else 0) + (if y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 2) then 1 else 0) + (if y ∈ LatticeVertexBoundary + (FordRecursiveVertexDomains P 3) then 1 else 0)) → ((Nat.card + {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} = + FordBoundaryMultiplicity P y) → ((∀ (R : ProtoTile), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ R.cells) → (x ∈ FootprintVertices R)) → ((∀ (R : + ProtoTile), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ R.cells) → (x ∉ + BoundaryFootprintVertices R)) → ((∀ (j : Fin 4), ∃ a : Fin 3 × Bool, + LatticeVertexIncidentCell x j ∈ (S a.1 a.2).cells) → ((∀ (a : Fin 3 × Bool), ∀ (b : + Fin 3 × Bool), (a ≠ b) → ((x ∈ BoundaryFootprintVertices (S a.1 a.2)) → ((x ∈ + BoundaryFootprintVertices (S b.1 b.2)) → (2 ≤ Nat.card + {c : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S c.1 c.2)})))) → + ((FordBoundaryMultiplicity P y ≤ 4) → (¬(Nat.card + { a : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2) } = (2 : ℕ) ∨ + Nat.card { a : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2) } = (3 + : ℕ) ∨ Nat.card + { a : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2) } = (4 : ℕ)) → + ∃ (i : Fin (3 : ℕ)) (s : Bool), (0 : ℤ) < (FordRecursiveQuadruple P i.succ).1 ∧ x ∈ + FootprintVertices (S i s) ∧ x ∉ BoundaryFootprintVertices (S i s)))))))))))))) ) := by + classical + intro P S u x y Sc h20 h21 hparentCells hrpos hcardSix hcardFour hcardFourFormula hcount + incidentFootprint noBoundaryFour incidentOwner twoBoundaryCount multiplicityBound hno + have hkle : Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (S a.1 a.2)} ≤ 1 := by + have hmax : Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (S a.1 a.2)} ≤ 4 := by + calc + Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (S a.1 a.2)} = FordBoundaryMultiplicity P y := hcount + _ ≤ 4 := multiplicityBound + omega + obtain ⟨a, haCell⟩ := incidentOwner 0 + have findInteriorOwner : ∃ b : Fin 3 × Bool, ∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (S b.1 b.2).cells ∧ + x ∉ BoundaryFootprintVertices (S b.1 b.2) := by + by_cases hbd : x ∈ BoundaryFootprintVertices (S a.1 a.2) + · by_cases hall : ∀ j : Fin 4, ∀ b : Fin 3 × Bool, + LatticeVertexIncidentCell x j ∈ (S b.1 b.2).cells → b = a + · have hAll : ∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (S a.1 a.2).cells := by + intro j + obtain ⟨b, hb⟩ := incidentOwner j + have heq := hall j b hb + simpa [heq] using hb + exact False.elim ((noBoundaryFour (S a.1 a.2) hAll) hbd) + · push Not at hall + obtain ⟨j, b, hbcell, hba⟩ := hall + have hab : a ≠ b := hba.symm + have hnotb : x ∉ BoundaryFootprintVertices (S b.1 b.2) := by + intro hb + have htwo := twoBoundaryCount a b hab hbd hb + omega + exact ⟨b, j, hbcell, hnotb⟩ + · exact ⟨a, 0, haCell, hbd⟩ + obtain ⟨b, j, hbcell, hnotb⟩ := findInteriorOwner + have hfoot := incidentFootprint (S b.1 b.2) j hbcell + rcases b with ⟨i, s⟩ + fin_cases i + · refine ⟨0, s, ?_, hfoot, hnotb⟩ + by_cases hz : P.q₁ = 0 + · omega + · simp [FordRecursiveQuadruple, FordCircleCoordinate, hz] + · refine ⟨1, s, ?_, hfoot, hnotb⟩ + simp [FordRecursiveQuadruple, FordCircleCoordinate, P.q₂_pos] + · have hscEmpty : (Sc 2 s).cells = ∅ := by + cases s <;> assumption + have hparentEmpty : (S 2 s).cells = ∅ := by + rw [hparentCells 2 s, (TileTranslationFormulas (Sc 2 s) u).1, hscEmpty] + simp + simp [hparentEmpty] at hbcell + +end FordTileGeometry + +theorem P4120T1FordGeometry + (P : FordFareyParameter) (hP : 1 < P.q) + (T : ProtoTile) (S : Fin 3 → Bool → ProtoTile) (u : GaussianInt) + (hcells : T.cells = (TileTranslation (FordTile P.q) u).cells) + (hanchor : T.cells = ∅ → T.anchor = (TileTranslation (FordTile P.q) u).anchor) + (hS : ∀ i s, BandSubtileOccurrence (FordRecursiveQuadruple P) T i s (S i s)) + (x : GaussianInt) (hx : x ∈ FootprintVertices T) + (hxb : x ∉ BoundaryFootprintVertices T) : + let y := x - u + let k := Nat.card {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} + (1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ + 1 ≤ y.im ∧ y.im ≤ (P.q : Int) - 1) ∧ + k = FordBoundaryMultiplicity P y ∧ + (k = 2 → GaussianRealPoint x ≠ TileCentroid T) ∧ + (k = 4 → P.q = 2 ∧ GaussianRealPoint x = TileCentroid T) ∧ + ((k = 2 ∨ k = 3 ∨ k = 4) ∨ + ∃ i : Fin 3, ∃ s : Bool, + 0 < ((FordRecursiveQuadruple P) i.succ).1 ∧ + x ∈ FootprintVertices (S i s) ∧ x ∉ BoundaryFootprintVertices (S i s)) := by +-- BODY + classical + have hne := FordTileGeometry.hneAt131 T x hx hxb + have hsome := FordTileGeometry.hsome T x hx hxb hne + have cells := FordTileGeometry.cells T x hxb hsome + let y : GaussianInt := x - u + have cellCanonical (z : GaussianInt) := FordTileGeometry.cellCanonical P T u hcells z + have squareCell (z : GaussianInt) := FordTileGeometry.squareCell P z + have hbounds := FordTileGeometry.hbounds P T u x cells cellCanonical squareCell + have fordCentroid := FordTileGeometry.fordCentroid P hP u x + obtain ⟨_, _, hrec⟩ := FordTileRecursiveIdentification P + obtain ⟨_, ⟨Sc, hSc, hcover, h00, h01, h10, h11, h20, h20a, h21, h21a⟩⟩ := + hrec hP + have hrootObs := ProtoTileObservableExtensionality T + (TileTranslation (FordTile P.q) u) hcells hanchor + have hScTranslated (i : Fin 3) (s : Bool) : + BandSubtileOccurrence (FordRecursiveQuadruple P) + (TileTranslation (FordTile P.q) u) i s + (TileTranslation (Sc i s) u) := + (BandSubtileOccurrenceTranslation (FordRecursiveQuadruple P) + (FordTile P.q) (Sc i s) i s u).mp (hSc i s) + have hparentCentroid (i : Fin 3) (s : Bool) := FordTileGeometry.hparentCentroid P T S u hS Sc + hrootObs hScTranslated i s + have hparentObs (i : Fin 3) (s : Bool) := FordTileGeometry.hparentObs P T S u hS Sc + hScTranslated hparentCentroid i s + have hparentCells (i : Fin 3) (s : Bool) := FordTileGeometry.hparentCells P T S u hS Sc + hScTranslated hparentCentroid i s + have hrpos := FordTileGeometry.hrpos P hP u x + have hr : (P.q₁ : Int) > 0 := by exact_mod_cast hrpos + have ht : (P.q₂ : Int) > 0 := by exact_mod_cast P.q₂_pos + have hqsum : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q + have rectBoundary (l r b t : Int) (z : GaussianInt) := FordTileGeometry.rectBoundary P u x l r + b t z + have boundaryTranslation (A : ProtoTile) (v z : GaussianInt) := + FordTileGeometry.boundaryTranslation A v z + have footprintTranslation (A : ProtoTile) (v z : GaussianInt) := + FordTileGeometry.footprintTranslation A v z + have hSc00 := FordTileGeometry.hSc00 P Sc h00 hrpos + have hSc01 := FordTileGeometry.hSc01 P Sc h01 hrpos + have hSc10 := FordTileGeometry.hSc10 P Sc h10 + have hSc11 := FordTileGeometry.hSc11 P Sc h11 + have hSc00Foot := FordTileGeometry.hSc00Foot P Sc h00 hrpos + have hSc01Foot := FordTileGeometry.hSc01Foot P Sc h01 hrpos + have hSc10Foot := FordTileGeometry.hSc10Foot P Sc h10 + have hSc11Foot := FordTileGeometry.hSc11Foot P Sc h11 + have foot0 := FordTileGeometry.foot0 P S u x Sc hparentObs hrpos footprintTranslation hSc00Foot + have foot1 := FordTileGeometry.foot1 P S u x Sc hparentObs hrpos hqsum footprintTranslation + hSc01Foot + have foot2 := FordTileGeometry.foot2 P S u x Sc hparentObs hqsum footprintTranslation hSc10Foot + have foot3 := FordTileGeometry.foot3 P S u x Sc hparentObs hqsum footprintTranslation hSc11Foot + have squareBoundary (n : Nat) (hn : 0 < n) (z : GaussianInt) := FordTileGeometry.squareBoundary + n hn z + have domain0 := FordTileGeometry.domain0 P u x rectBoundary + have domain1 := FordTileGeometry.domain1 P u x rectBoundary + have domain2 := FordTileGeometry.domain2 P u x rectBoundary + have domain3 := FordTileGeometry.domain3 P u x rectBoundary + have label0 := FordTileGeometry.label0 P S u x Sc hparentObs hrpos boundaryTranslation hSc00 + squareBoundary domain0 + have label1 := FordTileGeometry.label1 P S u x Sc hparentObs hrpos hqsum boundaryTranslation + hSc01 squareBoundary domain1 + have label2 := FordTileGeometry.label2 P S u x Sc hparentObs ht hqsum boundaryTranslation hSc10 + squareBoundary domain2 + have label3 := FordTileGeometry.label3 P S u x Sc hparentObs ht hqsum boundaryTranslation hSc11 + squareBoundary domain3 + have lineTrue := FordTileGeometry.lineTrue P S u x hbounds Sc h20 h20a hparentObs hqsum + boundaryTranslation + have lineFalse := FordTileGeometry.lineFalse P S u x hbounds Sc h21 h21a hparentObs + boundaryTranslation + have hcardSix := FordTileGeometry.hcardSix S x + have hcardFour := FordTileGeometry.hcardFour P u x + have hcardFourFormula := FordTileGeometry.hcardFourFormula P S u x + have hcount := FordTileGeometry.hcount P S u x label0 label1 label2 label3 lineTrue lineFalse + hcardSix hcardFourFormula + have rootCentroid := FordTileGeometry.rootCentroid P T u fordCentroid hrootObs + have centerCoords (hc : GaussianRealPoint x = TileCentroid T) := FordTileGeometry.centerCoords + P T u x rootCentroid hc + have centerTwice (hc : GaussianRealPoint x = TileCentroid T) := FordTileGeometry.centerTwice P + T u x centerCoords hc + have noCenteredCountTwo (hc : GaussianRealPoint x = TileCentroid T) := + FordTileGeometry.noCenteredCountTwo P hP T S u x hbounds hrpos hqsum domain0 domain1 + domain2 domain3 hcardFourFormula centerTwice hc + have countFourConclusion (hk : Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (S a.1 a.2)} = 4) := FordTileGeometry.countFourConclusion P + hP T S u x hqsum domain0 domain1 domain2 domain3 hcardFourFormula hcount rootCentroid hk + have incidentFootprint (R : ProtoTile) (j : Fin 4) + (hc : LatticeVertexIncidentCell x j ∈ R.cells) := FordTileGeometry.incidentFootprint x R j hc + have noBoundaryFour (R : ProtoTile) + (hall : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ R.cells) := + FordTileGeometry.noBoundaryFour P T S u x hx hxb hsome cells hbounds foot0 foot1 foot2 + foot3 domain0 domain1 domain2 domain3 label0 label1 label2 label3 lineTrue lineFalse + hcardSix hcardFour hcardFourFormula hcount centerCoords centerTwice noCenteredCountTwo + countFourConclusion incidentFootprint R hall + have incidentOwner (j : Fin 4) := FordTileGeometry.incidentOwner P T S u x cells cellCanonical + Sc hcover hparentCells j + have twoBoundaryCount (a b : Fin 3 × Bool) (hab : a ≠ b) + (ha : x ∈ BoundaryFootprintVertices (S a.1 a.2)) + (hb : x ∈ BoundaryFootprintVertices (S b.1 b.2)) := FordTileGeometry.twoBoundaryCount S x a + b hab ha hb + have multiplicityBound := FordTileGeometry.multiplicityBound P S u x hcardFourFormula + have descent (hno : ¬ (Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (S a.1 a.2)} = 2 ∨ + Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (S a.1 a.2)} = 3 ∨ + Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (S a.1 a.2)} = 4)) := FordTileGeometry.descent P S u x Sc + h20 h21 hparentCells hrpos hcardSix hcardFour hcardFourFormula hcount + incidentFootprint noBoundaryFour incidentOwner twoBoundaryCount multiplicityBound hno + refine ⟨hbounds, hcount, ?_, ?_, ?_⟩ + · intro hk hc + exact noCenteredCountTwo hc (hcount.symm.trans hk) + · exact countFourConclusion + · by_cases hk : Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (S a.1 a.2)} = 2 ∨ + Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (S a.1 a.2)} = 3 ∨ + Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (S a.1 a.2)} = 4 + · exact Or.inl hk + · exact Or.inr (descent hk) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean new file mode 100644 index 0000000000..b5315cf87c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean @@ -0,0 +1,1651 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidenceZeroOppositeChord +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure + +-- [TABLET NODE: P4120T1GeneralDescent] + +/-! +# P4120T1GeneralDescent + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace GeneralDescentGeometry + +private theorem hneAt129 : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ + BoundaryFootprintVertices T) → (T.cells.Nonempty)) ) := by + classical + intro T x hx hxb + by_contra hn + simp only [FootprintVertices, ite_eq_right hn, Set.mem_singleton_iff] at hx + apply hxb + simp [BoundaryFootprintVertices, hn, hx] + +private theorem hsome : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ + BoundaryFootprintVertices T) → ((T.cells.Nonempty) → (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T.cells))) ) := by + classical + intro T x hx hxb hne + rw [FootprintVertices, ite_eq_left hne] at hx + rcases hx with ⟨y, hy, rfl | rfl | rfl | rfl⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using hy⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hy⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hy⟩ + · refine ⟨2, ?_⟩ + simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hy + +private theorem cells : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∉ BoundaryFootprintVertices T) → ((∃ j : Fin + 4, LatticeVertexIncidentCell x j ∈ T.cells) → (∀ j : Fin 4, LatticeVertexIncidentCell + x j ∈ T.cells)) ) := by + classical + intro T x hxb hsome j + by_contra hj + exact hxb (P3161T2IncidentBoundary T x hsome ⟨j, hj⟩) + +private theorem hpos : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (((0 : ℤ) < (q + (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin (3 + : ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) + → (∀ i : Fin 3, Bool → 0 < (q i.succ).1)) ) := by + classical + intro q cfg hcurv i s + have hn := hcurv.2.1 i + have hne0 := cfg.noLine i.succ + by_contra h + have hle : (q i.succ).1 ≤ 0 := le_of_not_gt h + have heq : (q i.succ).1 = 0 := le_antisymm hle hn + exact hne0 heq + +private theorem hOsub : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), cert.O.cells ⊆ (cert.P 0 false).cells ) := by + classical + intro q cfg C T cert z hz + rw [cert.precursor_cells] at hz + exact (cert.minus_union z).mpr ⟨0, true, hz⟩ + +private theorem tile_zero : + (by + classical + exact + ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by + classical + intro U + cases U + have hz : GaussianTranslation 0 = id := by + funext z + simp [GaussianTranslation] + simp [TileTranslation, hz, Finset.image_id] + +private theorem modified_cell_owner : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (cert.O.cells ⊆ (cert.P 0 false).cells) → (∀ (c : LatticeCell), (c ∈ T.cells) → + (∃ a : PeriodicSubtileIndex, a.first = 0 ∧ a.second = 0 ∧ c ∈ (cert.modified.tile + a).cells)) ) := by + classical + intro q cfg C T cert hOsub c hc + obtain ⟨i, s, hP⟩ := (cert.outer_union c).mp hc + cases i using Fin.cases with + | zero => + cases s + · refine ⟨⟨.B, 0, 0⟩, rfl, rfl, ?_⟩ + rw [cert.modified_tile] + simpa [ModifiedSubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation] using hP + · by_cases hO : c ∈ cert.O.cells + · refine ⟨⟨.B, 0, 0⟩, rfl, rfl, ?_⟩ + rw [cert.modified_tile] + simpa [ModifiedSubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation] using hOsub hO + · refine ⟨⟨.A, 0, 0⟩, rfl, rfl, ?_⟩ + rw [cert.modified_tile] + simpa [ModifiedSubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, TileCellComplement] using + (Finset.mem_sdiff.mpr ⟨hP, hO⟩) + | succ i => + cases i using Fin.cases with + | zero => + cases s + · refine ⟨⟨.D, 0, 0⟩, rfl, rfl, ?_⟩ + rw [cert.modified_tile] + simpa [ModifiedSubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation] using hP + · refine ⟨⟨.C, 0, 0⟩, rfl, rfl, ?_⟩ + rw [cert.modified_tile] + simpa [ModifiedSubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation] using hP + | succ i => + cases i using Fin.cases with + | zero => + cases s + · refine ⟨⟨.F, 0, 0⟩, rfl, rfl, ?_⟩ + rw [cert.modified_tile] + simpa [ModifiedSubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation] using hP + · refine ⟨⟨.E, 0, 0⟩, rfl, rfl, ?_⟩ + rw [cert.modified_tile] + simpa [ModifiedSubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation] using hP + | succ i => exact Fin.elim0 i + +private theorem incident_footprint : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (j : Fin 4), ∀ (U : ProtoTile), (LatticeVertexIncidentCell x j ∈ + U.cells) → (x ∈ FootprintVertices U) ) := by + classical + intro x j U hc + have hn : U.cells.Nonempty := ⟨LatticeVertexIncidentCell x j, hc⟩ + rw [FootprintVertices, ite_eq_left hn] + refine ⟨LatticeVertexIncidentCell x j, hc, ?_⟩ + fin_cases j <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] + +private theorem cell_edge_vleft : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ({z, z + I} ∈ FootprintEdges U) ) + := by + classical + intro I U z hz + simp only [FootprintEdges, Set.mem_ofPred_eq] + refine ⟨z, hz, ?_⟩ + exact Or.inr (Or.inl rfl) + +private theorem cell_edge_vright : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ({z + 1, z + 1 + I} ∈ + FootprintEdges U) ) := by + classical + intro I U z hz + simp only [FootprintEdges, Set.mem_ofPred_eq] + refine ⟨z, hz, ?_⟩ + exact Or.inr (Or.inr (Or.inl rfl)) + +private theorem cell_edge_hbottom : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ({z, z + 1} ∈ FootprintEdges U) ) + := by + classical + intro U z hz + simp only [FootprintEdges, Set.mem_ofPred_eq] + exact ⟨z, hz, Or.inl rfl⟩ + +private theorem cell_edge_htop : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ({z + I, z + 1 + I} ∈ + FootprintEdges U) ) := by + classical + intro I U z hz + simp only [FootprintEdges, Set.mem_ofPred_eq] + refine ⟨z, hz, ?_⟩ + exact Or.inr (Or.inr (Or.inr rfl)) + +private theorem edge_support : + (by + classical + exact + ∀ (x : GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + ∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges U) → ((x ∈ e) → (∃ j : + Fin 4, LatticeVertexIncidentCell x j ∈ U.cells ∧ ((e = {x, x + I} ∧ (j = 0 ∨ j = 1)) + ∨ (e = {x - 1, x} ∧ (j = 1 ∨ j = 2)) ∨ (e = {x - I, x} ∧ (j = 2 ∨ j = 3)) ∨ (e = {x, + x + 1} ∧ (j = 3 ∨ j = 0))))) ) := by + classical + intro x I U e he hxedge + simp only [FootprintEdges, Set.mem_ofPred_eq] at he + rcases he with ⟨z, hz, hedge⟩ + rcases hedge with hedge | hedge | hedge | hedge + · subst e + simp only [Finset.mem_insert, Finset.mem_singleton] at hxedge + rcases hxedge with hxz | hxz + · subst z + refine ⟨0, ?_, ?_⟩ + · simpa [LatticeVertexIncidentCell] using hz + · exact Or.inr (Or.inr (Or.inr ⟨rfl, Or.inr rfl⟩)) + · have hz' : z = x - 1 := by calc + z = (z + 1) - 1 := by abel + _ = x - 1 := by rw [hxz] + subst z + refine ⟨1, ?_, ?_⟩ + · simpa [LatticeVertexIncidentCell] using hz + · refine Or.inr (Or.inl ⟨?_, Or.inl rfl⟩) + simp + · subst e + simp only [Finset.mem_insert, Finset.mem_singleton] at hxedge + rcases hxedge with hxz | hxz + · subst z + refine ⟨0, ?_, ?_⟩ + · simpa [LatticeVertexIncidentCell] using hz + · exact Or.inl ⟨rfl, Or.inl rfl⟩ + · have hz' : z = x - I := by calc + z = (z + I) - I := by abel + _ = x - I := by rw [hxz] + subst z + refine ⟨3, ?_, ?_⟩ + · simpa [LatticeVertexIncidentCell, I] using hz + · refine Or.inr (Or.inr (Or.inl ⟨?_, Or.inr rfl⟩)) + simp [I, add_comm] + · subst e + simp only [Finset.mem_insert, Finset.mem_singleton] at hxedge + rcases hxedge with hxz | hxz + · have hz' : z = x - 1 := by calc + z = (z + 1) - 1 := by abel + _ = x - 1 := by rw [hxz] + subst z + refine ⟨1, ?_, ?_⟩ + · simpa [LatticeVertexIncidentCell] using hz + · refine Or.inl ⟨?_, Or.inr rfl⟩ + simp [I, add_comm] + · have hz' : z = x - 1 - I := by calc + z = (z + 1 + I) - 1 - I := by abel + _ = x - 1 - I := by rw [hxz] + subst z + refine ⟨2, ?_, ?_⟩ + · simpa [LatticeVertexIncidentCell, I, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hz + · refine Or.inr (Or.inr (Or.inl ⟨?_, Or.inl rfl⟩)) + have h1 : (x - 1 - I) + 1 = x - I := by abel + rw [h1] + simp [I, sub_eq_add_neg, add_comm, add_left_comm] + · subst e + simp only [Finset.mem_insert, Finset.mem_singleton] at hxedge + rcases hxedge with hxz | hxz + · have hz' : z = x - I := by calc + z = (z + I) - I := by abel + _ = x - I := by rw [hxz] + subst z + refine ⟨3, ?_, ?_⟩ + · simpa [LatticeVertexIncidentCell, I] using hz + · refine Or.inr (Or.inr (Or.inr ⟨?_, Or.inl rfl⟩)) + simp [I, add_comm, add_left_comm] + · have hz' : z = x - 1 - I := by calc + z = (z + 1 + I) - 1 - I := by abel + _ = x - 1 - I := by rw [hxz] + subst z + refine ⟨2, ?_, ?_⟩ + · simpa [LatticeVertexIncidentCell, I, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hz + · refine Or.inr (Or.inl ⟨?_, Or.inr rfl⟩) + simp [I, add_comm, add_left_comm] + +private theorem boundary_edge_is_footprint : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + (∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ({z, z + I} ∈ FootprintEdges U)) + → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ({z + 1, z + 1 + I} ∈ + FootprintEdges U)) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ({z, + z + 1} ∈ FootprintEdges U)) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) + → ({z + I, z + 1 + I} ∈ FootprintEdges U)) → (∀ (U : ProtoTile), ∀ (e : Finset + GaussianInt), (e ∈ BoundaryFootprintEdges U) → (e ∈ FootprintEdges U))))) ) := by + classical + intro I cell_edge_vleft cell_edge_vright cell_edge_hbottom cell_edge_htop U e he + rcases he with ⟨z, ⟨rfl, hside⟩ | ⟨rfl, hside⟩⟩ + · rcases hside with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact cell_edge_hbottom U z hz + · have hz' := cell_edge_htop U (z - I) hz + simpa [I, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hz' + · rcases hside with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact cell_edge_vleft U z hz + · have hz' := cell_edge_vright U (z - 1) hz + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hz' + +private theorem parent_boundary_incident_cell : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + (∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges U) → ((x ∈ e) → (∃ j + : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells ∧ ((e = {x, x + I} ∧ (j = 0 ∨ j = + 1)) ∨ (e = {x - 1, x} ∧ (j = 1 ∨ j = 2)) ∨ (e = {x - I, x} ∧ (j = 2 ∨ j = 3)) ∨ (e = + {x, x + 1} ∧ (j = 3 ∨ j = 0)))))) → ((∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), + (e ∈ BoundaryFootprintEdges U) → (e ∈ FootprintEdges U)) → ((∀ (i : Fin 3), ∀ (s : + Bool), (cert.P i s).cells.Nonempty) → (∀ (i : Fin 3), ∀ (s : Bool), (x ∈ + BoundaryFootprintVertices (cert.P i s)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j + ∈ (cert.P i s).cells)))) ) := by + classical + intro q cfg C T cert x I edge_support boundary_edge_is_footprint parent_cells_nonempty i s hB + simp only [BoundaryFootprintVertices, ite_eq_left (parent_cells_nonempty i s), + Set.mem_ofPred_eq] at hB + rcases hB with ⟨e, he, hxe⟩ + obtain ⟨j, hj, _⟩ := edge_support (cert.P i s) e + (boundary_edge_is_footprint _ _ he) hxe + exact ⟨j, hj⟩ + +private theorem all_incident_not_boundary : + (by + classical + exact + ∀ (x : GaussianInt), + ∀ (U : ProtoTile), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells) → ((x ∈ + BoundaryFootprintVertices U) → (False)) ) := by + classical + intro x U hall hB + let I : GaussianInt := ⟨0, 1⟩ + have hne : U.cells.Nonempty := ⟨LatticeVertexIncidentCell x 0, hall 0⟩ + simp only [BoundaryFootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hB + rcases hB with ⟨e, he, hxe⟩ + rcases he with ⟨z, ⟨rfl, hs⟩ | ⟨rfl, hs⟩⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hxe with hxz | hxz + · subst z + rcases hs with ⟨_, hmiss⟩ | ⟨hmiss, _⟩ + · exact hmiss (by simpa [LatticeVertexIncidentCell, I] using hall 3) + · exact hmiss (by simpa [LatticeVertexIncidentCell] using hall 0) + · have hz : z = x - 1 := by calc + z = (z + 1) - 1 := by abel + _ = x - 1 := by rw [hxz] + subst z + rcases hs with ⟨_, hmiss⟩ | ⟨hmiss, _⟩ + · exact hmiss (by simpa [LatticeVertexIncidentCell, I, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hall 2) + · exact hmiss (by simpa [LatticeVertexIncidentCell] using hall 1) + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hxe with hxz | hxz + · subst z + rcases hs with ⟨_, hmiss⟩ | ⟨hmiss, _⟩ + · exact hmiss (by simpa [LatticeVertexIncidentCell] using hall 1) + · exact hmiss (by simpa [LatticeVertexIncidentCell] using hall 0) + · have hz : z = x - I := by calc + z = (z + I) - I := by abel + _ = x - I := by rw [hxz] + subst z + rcases hs with ⟨_, hmiss⟩ | ⟨hmiss, _⟩ + · exact hmiss (by simpa [LatticeVertexIncidentCell, I, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hall 2) + · exact hmiss (by simpa [LatticeVertexIncidentCell, I] using hall 3) + +private theorem pair_left_mem : + (by + classical + exact + ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ {d : GaussianInt}, (({a, + b} : Finset GaussianInt) = {c, d}) → (a = c ∨ a = d) ) := by + classical + intro a b c d h + have hm : a ∈ ({a, b} : Finset GaussianInt) := by simp + rw [h] at hm + simpa using hm + +private theorem pair_right_mem : + (by + classical + exact + ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ {d : GaussianInt}, (({a, + b} : Finset GaussianInt) = {c, d}) → (b = c ∨ b = d) ) := by + classical + intro a b c d h + have hm : b ∈ ({a, b} : Finset GaussianInt) := by simp + rw [h] at hm + simpa using hm + +private theorem star01_ne_12 : + (by + classical + exact + ∀ (x : GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ {d : GaussianInt}, + (({a, b} : Finset GaussianInt) = {c, d}) → (b = c ∨ b = d)) → (({x, x + I} : Finset + GaussianInt) ≠ {x - 1, x}) ) := by + classical + intro x I pair_right_mem h + rcases pair_right_mem h with h | h + · have hs : I = -1 := by calc + I = (x + I) - x := by abel + _ = (x - 1) - x := by rw [h] + _ = -1 := by abel + norm_num [I, Zsqrtd.ext_iff] at hs + · have hs : I = 0 := by calc + I = (x + I) - x := by abel + _ = x - x := by rw [h] + _ = 0 := by abel + norm_num [I, Zsqrtd.ext_iff] at hs + +private theorem star01_ne_23 : + (by + classical + exact + ∀ (x : GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ {d : GaussianInt}, + (({a, b} : Finset GaussianInt) = {c, d}) → (b = c ∨ b = d)) → (({x, x + I} : Finset + GaussianInt) ≠ {x - I, x}) ) := by + classical + intro x I pair_right_mem h + rcases pair_right_mem h with h | h + · have hs : I = -I := by calc + I = (x + I) - x := by abel + _ = (x - I) - x := by rw [h] + _ = -I := by abel + norm_num [I, Zsqrtd.ext_iff] at hs + · have hs : I = 0 := by calc + I = (x + I) - x := by abel + _ = x - x := by rw [h] + _ = 0 := by abel + norm_num [I, Zsqrtd.ext_iff] at hs + +private theorem star01_ne_30 : + (by + classical + exact + ∀ (x : GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ {d : GaussianInt}, + (({a, b} : Finset GaussianInt) = {c, d}) → (b = c ∨ b = d)) → (({x, x + I} : Finset + GaussianInt) ≠ {x, x + 1}) ) := by + classical + intro x I pair_right_mem h + rcases pair_right_mem h with h | h + · have hs : I = 0 := by calc + I = (x + I) - x := by abel + _ = x - x := by rw [h] + _ = 0 := by abel + norm_num [I, Zsqrtd.ext_iff] at hs + · have hs : I = 1 := by calc + I = (x + I) - x := by abel + _ = (x + 1) - x := by rw [h] + _ = 1 := by abel + norm_num [I, Zsqrtd.ext_iff] at hs + +private theorem star12_ne_23 : + (by + classical + exact + ∀ (x : GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ {d : GaussianInt}, + (({a, b} : Finset GaussianInt) = {c, d}) → (a = c ∨ a = d)) → (({x - 1, x} : Finset + GaussianInt) ≠ {x - I, x}) ) := by + classical + intro x I pair_left_mem h + rcases pair_left_mem h with h | h + · have hs : I = 1 := by calc + I = x - (x - I) := by abel + _ = x - (x - 1) := by rw [← h] + _ = 1 := by abel + norm_num [I, Zsqrtd.ext_iff] at hs + · have hs : (1 : GaussianInt) = 0 := by calc + 1 = x - (x - 1) := by abel + _ = x - x := by rw [h] + _ = 0 := by abel + norm_num [Zsqrtd.ext_iff] at hs + +private theorem star12_ne_30 : + (by + classical + exact + ∀ (x : GaussianInt), (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ + {d : GaussianInt}, (({a, b} : Finset GaussianInt) = {c, d}) → (a = c ∨ a = d)) → + (({x - 1, x} : Finset GaussianInt) ≠ {x, x + 1}) ) := by + classical + intro x pair_left_mem h + rcases pair_left_mem h with h | h + · have hs : (-1 : GaussianInt) = 0 := by calc + -1 = (x - 1) - x := by abel + _ = x - x := by rw [h] + _ = 0 := by abel + norm_num [Zsqrtd.ext_iff] at hs + · have hs : (-1 : GaussianInt) = 1 := by calc + -1 = (x - 1) - x := by abel + _ = (x + 1) - x := by rw [h] + _ = 1 := by abel + norm_num [Zsqrtd.ext_iff] at hs + +private theorem star23_ne_30 : + (by + classical + exact + ∀ (x : GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ {d : GaussianInt}, + (({a, b} : Finset GaussianInt) = {c, d}) → (a = c ∨ a = d)) → (({x - I, x} : Finset + GaussianInt) ≠ {x, x + 1}) ) := by + classical + intro x I pair_left_mem h + rcases pair_left_mem h with h | h + · have hs : I = 0 := by calc + I = x - (x - I) := by abel + _ = x - x := by rw [h] + _ = 0 := by abel + norm_num [I, Zsqrtd.ext_iff] at hs + · have hs : I = -1 := by calc + I = x - (x - I) := by abel + _ = x - (x + 1) := by rw [h] + _ = -1 := by abel + norm_num [I, Zsqrtd.ext_iff] at hs + +private theorem adjacent_of_edge : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → (∀ (e : + Finset GaussianInt), (e ∈ FootprintEdges (cert.modified.tile a)) → ((e ∈ + FootprintEdges (cert.modified.tile b)) → (cert.modified.plane.adjacent a b))) ) := by + classical + intro q cfg C T cert a b hne e ha hb + have hclass := (PeriodicTileIntersectionClassification cert.modified).1 a b hne + exact hclass.1.mp ⟨e, ha, hb⟩ + +private theorem adj01 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (cells : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T.cells), ∀ (modified_cell_owner : ∀ (c : LatticeCell), (c ∈ T.cells) → (∃ a : + PeriodicSubtileIndex, a.first = 0 ∧ a.second = 0 ∧ c ∈ (cert.modified.tile a).cells)), + let owner : Fin 4 → PeriodicSubtileIndex := fun j => + Classical.choose (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) + let I : GaussianInt := ⟨0, 1⟩ + (∀ (j : Fin 4), (owner j).first = 0 ∧ (owner j).second = 0 ∧ LatticeVertexIncidentCell x + j ∈ (cert.modified.tile (owner j)).cells) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), + (z ∈ U.cells) → ({z, z + I} ∈ FootprintEdges U)) → ((∀ (U : ProtoTile), ∀ (z : + GaussianInt), (z ∈ U.cells) → ({z + 1, z + 1 + I} ∈ FootprintEdges U)) → ((∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → (∀ (e : Finset + GaussianInt), (e ∈ FootprintEdges (cert.modified.tile a)) → ((e ∈ FootprintEdges + (cert.modified.tile b)) → (cert.modified.plane.adjacent a b)))) → ((owner 0 ≠ owner + 1) → (cert.modified.plane.adjacent (owner 0) (owner 1)))))) ) := by + classical + intro q cfg C T cert x cells modified_cell_owner owner I owner_spec cell_edge_vleft + cell_edge_vright adjacent_of_edge hne + apply adjacent_of_edge _ _ hne {x, x + I} + · exact cell_edge_vleft _ x (by + simpa [LatticeVertexIncidentCell] using owner_spec 0 |>.2.2) + · have hbase : LatticeVertexIncidentCell x 1 + 1 = x := by + simp [LatticeVertexIncidentCell] + have hz := cell_edge_vright (cert.modified.tile (owner 1)) + (LatticeVertexIncidentCell x 1) (owner_spec 1 |>.2.2) + simpa [I, hbase, add_assoc, add_comm, add_left_comm] using hz + +private theorem adj12 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (cells : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T.cells), ∀ (modified_cell_owner : ∀ (c : LatticeCell), (c ∈ T.cells) → (∃ a : + PeriodicSubtileIndex, a.first = 0 ∧ a.second = 0 ∧ c ∈ (cert.modified.tile a).cells)), + let owner : Fin 4 → PeriodicSubtileIndex := fun j => + Classical.choose (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) + let I : GaussianInt := ⟨0, 1⟩ + (∀ (j : Fin 4), (owner j).first = 0 ∧ (owner j).second = 0 ∧ LatticeVertexIncidentCell x + j ∈ (cert.modified.tile (owner j)).cells) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), + (z ∈ U.cells) → ({z, z + 1} ∈ FootprintEdges U)) → ((∀ (U : ProtoTile), ∀ (z : + GaussianInt), (z ∈ U.cells) → ({z + I, z + 1 + I} ∈ FootprintEdges U)) → ((∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → (∀ (e : Finset + GaussianInt), (e ∈ FootprintEdges (cert.modified.tile a)) → ((e ∈ FootprintEdges + (cert.modified.tile b)) → (cert.modified.plane.adjacent a b)))) → ((owner 1 ≠ owner + 2) → (cert.modified.plane.adjacent (owner 1) (owner 2)))))) ) := by + classical + intro q cfg C T cert x cells modified_cell_owner owner I owner_spec cell_edge_hbottom + cell_edge_htop adjacent_of_edge hne + apply adjacent_of_edge _ _ hne {x - 1, x} + · have hbase : LatticeVertexIncidentCell x 1 = x - 1 := by + simp [LatticeVertexIncidentCell] + simpa [hbase] using cell_edge_hbottom _ _ (owner_spec 1 |>.2.2) + · have hbase : LatticeVertexIncidentCell x 2 + I = x - 1 := by + simp [LatticeVertexIncidentCell, I, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] + have hz := cell_edge_htop (cert.modified.tile (owner 2)) + (LatticeVertexIncidentCell x 2) (owner_spec 2 |>.2.2) + simpa [I, hbase, add_assoc, add_comm, add_left_comm] using hz + +private theorem adj23 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (cells : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T.cells), ∀ (modified_cell_owner : ∀ (c : LatticeCell), (c ∈ T.cells) → (∃ a : + PeriodicSubtileIndex, a.first = 0 ∧ a.second = 0 ∧ c ∈ (cert.modified.tile a).cells)), + let owner : Fin 4 → PeriodicSubtileIndex := fun j => + Classical.choose (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) + let I : GaussianInt := ⟨0, 1⟩ + (∀ (j : Fin 4), (owner j).first = 0 ∧ (owner j).second = 0 ∧ LatticeVertexIncidentCell x + j ∈ (cert.modified.tile (owner j)).cells) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), + (z ∈ U.cells) → ({z, z + I} ∈ FootprintEdges U)) → ((∀ (U : ProtoTile), ∀ (z : + GaussianInt), (z ∈ U.cells) → ({z + 1, z + 1 + I} ∈ FootprintEdges U)) → ((∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → (∀ (e : Finset + GaussianInt), (e ∈ FootprintEdges (cert.modified.tile a)) → ((e ∈ FootprintEdges + (cert.modified.tile b)) → (cert.modified.plane.adjacent a b)))) → ((owner 2 ≠ owner + 3) → (cert.modified.plane.adjacent (owner 2) (owner 3)))))) ) := by + classical + intro q cfg C T cert x cells modified_cell_owner owner I owner_spec cell_edge_vleft + cell_edge_vright adjacent_of_edge hne + apply adjacent_of_edge _ _ hne {x - I, x} + · have hbase : LatticeVertexIncidentCell x 2 + 1 = x - I := by + simp [LatticeVertexIncidentCell, I, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] + have hz := cell_edge_vright (cert.modified.tile (owner 2)) + (LatticeVertexIncidentCell x 2) (owner_spec 2 |>.2.2) + simpa [I, hbase, add_assoc, add_comm, add_left_comm] using hz + · have hbase : LatticeVertexIncidentCell x 3 = x - I := by + simp [LatticeVertexIncidentCell, I] + simpa [hbase] using cell_edge_vleft _ _ (owner_spec 3 |>.2.2) + +private theorem adj30 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (cells : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T.cells), ∀ (modified_cell_owner : ∀ (c : LatticeCell), (c ∈ T.cells) → (∃ a : + PeriodicSubtileIndex, a.first = 0 ∧ a.second = 0 ∧ c ∈ (cert.modified.tile a).cells)), + let owner : Fin 4 → PeriodicSubtileIndex := fun j => + Classical.choose (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) + let I : GaussianInt := ⟨0, 1⟩ + (∀ (j : Fin 4), (owner j).first = 0 ∧ (owner j).second = 0 ∧ LatticeVertexIncidentCell x + j ∈ (cert.modified.tile (owner j)).cells) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), + (z ∈ U.cells) → ({z, z + 1} ∈ FootprintEdges U)) → ((∀ (U : ProtoTile), ∀ (z : + GaussianInt), (z ∈ U.cells) → ({z + I, z + 1 + I} ∈ FootprintEdges U)) → ((∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → (∀ (e : Finset + GaussianInt), (e ∈ FootprintEdges (cert.modified.tile a)) → ((e ∈ FootprintEdges + (cert.modified.tile b)) → (cert.modified.plane.adjacent a b)))) → ((owner 3 ≠ owner + 0) → (cert.modified.plane.adjacent (owner 3) (owner 0)))))) ) := by + classical + intro q cfg C T cert x cells modified_cell_owner owner I owner_spec cell_edge_hbottom + cell_edge_htop adjacent_of_edge hne + apply adjacent_of_edge _ _ hne {x, x + 1} + · have hbase : LatticeVertexIncidentCell x 3 + I = x := by + simp [LatticeVertexIncidentCell, I] + have hz := cell_edge_htop (cert.modified.tile (owner 3)) + (LatticeVertexIncidentCell x 3) (owner_spec 3 |>.2.2) + simpa [I, hbase, add_assoc, add_comm, add_left_comm] using hz + · exact cell_edge_hbottom _ x (by + simpa [LatticeVertexIncidentCell] using owner_spec 0 |>.2.2) + +private theorem chord_of_four_distinct : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (cells : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T.cells), ∀ (modified_cell_owner : ∀ (c : LatticeCell), (c ∈ T.cells) → (∃ a : + PeriodicSubtileIndex, a.first = 0 ∧ a.second = 0 ∧ c ∈ (cert.modified.tile a).cells)), + let owner : Fin 4 → PeriodicSubtileIndex := fun j => + Classical.choose (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) + (∀ (j : Fin 4), (owner j).first = 0 ∧ (owner j).second = 0 ∧ LatticeVertexIncidentCell x + j ∈ (cert.modified.tile (owner j)).cells) → (((owner 0 ≠ owner 1) → + (cert.modified.plane.adjacent (owner 0) (owner 1))) → (((owner 1 ≠ owner 2) → + (cert.modified.plane.adjacent (owner 1) (owner 2))) → (((owner 2 ≠ owner 3) → + (cert.modified.plane.adjacent (owner 2) (owner 3))) → (((owner 3 ≠ owner 0) → + (cert.modified.plane.adjacent (owner 3) (owner 0))) → ((Function.Injective owner) → + (AllowedSubtileIncidence (owner 0) (owner 2) ∨ AllowedSubtileIncidence (owner 1) + (owner 3))))))) ) := by + classical + intro q cfg C T cert x cells modified_cell_owner owner owner_spec adj01 adj12 adj23 adj30 hinj + have own_ne {i j : Fin 4} (hij : i ≠ j) : owner i ≠ owner j := by + intro he + exact hij (hinj he) + have hab := (cert.modified_adjacency (owner 0) (owner 1)).mp + (adj01 (own_ne (by decide))) + have hbc := (cert.modified_adjacency (owner 1) (owner 2)).mp + (adj12 (own_ne (by decide))) + have hcd := (cert.modified_adjacency (owner 2) (owner 3)).mp + (adj23 (own_ne (by decide))) + have hda := (cert.modified_adjacency (owner 3) (owner 0)).mp + (adj30 (own_ne (by decide))) + exact AllowedSubtileIncidenceZeroOppositeChord + (owner 0) (owner 1) (owner 2) (owner 3) + ⟨owner_spec 0 |>.1, owner_spec 0 |>.2.1⟩ + ⟨owner_spec 2 |>.1, owner_spec 2 |>.2.1⟩ + hab hbc hcd hda + (own_ne (by decide)) (own_ne (by decide)) (own_ne (by decide)) + (own_ne (by decide)) (own_ne (by decide)) (own_ne (by decide)) + +private theorem four_distinct_impossible : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (cells : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T.cells), ∀ (modified_cell_owner : ∀ (c : LatticeCell), (c ∈ T.cells) → (∃ a : + PeriodicSubtileIndex, a.first = 0 ∧ a.second = 0 ∧ c ∈ (cert.modified.tile a).cells)), + let owner : Fin 4 → PeriodicSubtileIndex := fun j => + Classical.choose (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) + let I : GaussianInt := ⟨0, 1⟩ + (∀ (j : Fin 4), (owner j).first = 0 ∧ (owner j).second = 0 ∧ LatticeVertexIncidentCell x + j ∈ (cert.modified.tile (owner j)).cells) → ((∀ (j : Fin 4), ∀ (U : ProtoTile), + (LatticeVertexIncidentCell x j ∈ U.cells) → (x ∈ FootprintVertices U)) → ((∀ (c : + LatticeCell), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (c ∈ + (cert.modified.tile a).cells) → ((c ∈ (cert.modified.tile b).cells) → (a = b))) → ((∀ + (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges U) → ((x ∈ e) → (∃ j + : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells ∧ ((e = {x, x + I} ∧ (j = 0 ∨ j = + 1)) ∨ (e = {x - 1, x} ∧ (j = 1 ∨ j = 2)) ∨ (e = {x - I, x} ∧ (j = 2 ∨ j = 3)) ∨ (e = + {x, x + 1} ∧ (j = 3 ∨ j = 0)))))) → ((({x, x + I} : Finset GaussianInt) ≠ {x - 1, x}) + → ((({x, x + I} : Finset GaussianInt) ≠ {x - I, x}) → ((({x, x + I} : Finset + GaussianInt) ≠ {x, x + 1}) → ((({x - 1, x} : Finset GaussianInt) ≠ {x - I, x}) → + ((({x - 1, x} : Finset GaussianInt) ≠ {x, x + 1}) → ((({x - I, x} : Finset + GaussianInt) ≠ {x, x + 1}) → (((Function.Injective owner) → (AllowedSubtileIncidence + (owner 0) (owner 2) ∨ AllowedSubtileIncidence (owner 1) (owner 3))) → + ((Function.Injective owner) → (False)))))))))))) ) := by + classical + intro q cfg C T cert x cells modified_cell_owner owner I owner_spec incident_footprint + owner_unique edge_support star01_ne_12 star01_ne_23 star01_ne_30 star12_ne_23 star12_ne_30 + star23_ne_30 chord_of_four_distinct hinj + have own_ne {i j : Fin 4} (hij : i ≠ j) : owner i ≠ owner j := by + intro he + exact hij (hinj he) + rcases chord_of_four_distinct hinj with hac | hbd + · have hadj := (cert.modified_adjacency (owner 0) (owner 2)).mpr hac + have hclass := (PeriodicTileIntersectionClassification cert.modified).1 + (owner 0) (owner 2) (own_ne (by decide)) + have hedge := hclass.1.mpr hadj + have hvertices : x ∈ FootprintVertices (cert.modified.tile (owner 0)) ∩ + FootprintVertices (cert.modified.tile (owner 2)) := + ⟨incident_footprint 0 _ (owner_spec 0 |>.2.2), + incident_footprint 2 _ (owner_spec 2 |>.2.2)⟩ + have hcommon : x ∈ CommonFootprintEdgeVertices + (cert.modified.tile (owner 0)) (cert.modified.tile (owner 2)) := by + have heq := (hclass.2.1 hedge).2 + rw [heq] at hvertices + exact hvertices + rcases hcommon with ⟨e, he, hxedge⟩ + rcases he with ⟨hea, hec⟩ + obtain ⟨j, hj, hkind⟩ := edge_support _ e hea hxedge + have howner : owner j = owner 0 := + owner_unique (LatticeVertexIncidentCell x j) (owner j) (owner 0) + (owner_spec j |>.2.2) (by simpa using hj) + have hj0 : j = 0 := hinj howner + subst j + have hleft : e = {x, x + I} ∨ e = {x, x + 1} := by + rcases hkind with h01 | h12 | h23 | h30 + · exact Or.inl h01.1 + · rcases h12.2 with h | h + · exact False.elim ((by decide : (0 : Fin 4) ≠ 1) h) + · exact False.elim ((by decide : (0 : Fin 4) ≠ 2) h) + · rcases h23.2 with h | h + · exact False.elim ((by decide : (0 : Fin 4) ≠ 2) h) + · exact False.elim ((by decide : (0 : Fin 4) ≠ 3) h) + · exact Or.inr h30.1 + obtain ⟨j, hj, hkind⟩ := edge_support _ e hec hxedge + have howner : owner j = owner 2 := + owner_unique (LatticeVertexIncidentCell x j) (owner j) (owner 2) + (owner_spec j |>.2.2) (by simpa using hj) + have hj2 : j = 2 := hinj howner + subst j + have hright : e = {x - 1, x} ∨ e = {x - I, x} := by + rcases hkind with h01 | h12 | h23 | h30 + · rcases h01.2 with h | h + · exact False.elim ((by decide : (2 : Fin 4) ≠ 0) h) + · exact False.elim ((by decide : (2 : Fin 4) ≠ 1) h) + · exact Or.inl h12.1 + · exact Or.inr h23.1 + · rcases h30.2 with h | h + · exact False.elim ((by decide : (2 : Fin 4) ≠ 3) h) + · exact False.elim ((by decide : (2 : Fin 4) ≠ 0) h) + rcases hleft with hl | hl <;> rcases hright with hr | hr + · exact star01_ne_12 (hl.symm.trans hr) + · exact star01_ne_23 (hl.symm.trans hr) + · exact star12_ne_30 (hr.symm.trans hl) + · exact star23_ne_30 (hr.symm.trans hl) + · have hadj := (cert.modified_adjacency (owner 1) (owner 3)).mpr hbd + have hclass := (PeriodicTileIntersectionClassification cert.modified).1 + (owner 1) (owner 3) (own_ne (by decide)) + have hedge := hclass.1.mpr hadj + have hvertices : x ∈ FootprintVertices (cert.modified.tile (owner 1)) ∩ + FootprintVertices (cert.modified.tile (owner 3)) := + ⟨incident_footprint 1 _ (owner_spec 1 |>.2.2), + incident_footprint 3 _ (owner_spec 3 |>.2.2)⟩ + have hcommon : x ∈ CommonFootprintEdgeVertices + (cert.modified.tile (owner 1)) (cert.modified.tile (owner 3)) := by + have heq := (hclass.2.1 hedge).2 + rw [heq] at hvertices + exact hvertices + rcases hcommon with ⟨e, he, hxedge⟩ + rcases he with ⟨hea, hec⟩ + obtain ⟨j, hj, hkind⟩ := edge_support _ e hea hxedge + have howner : owner j = owner 1 := + owner_unique (LatticeVertexIncidentCell x j) (owner j) (owner 1) + (owner_spec j |>.2.2) (by simpa using hj) + have hj1 : j = 1 := hinj howner + subst j + have hleft : e = {x, x + I} ∨ e = {x - 1, x} := by + rcases hkind with h01 | h12 | h23 | h30 + · exact Or.inl h01.1 + · exact Or.inr h12.1 + · rcases h23.2 with h | h + · exact False.elim ((by decide : (1 : Fin 4) ≠ 2) h) + · exact False.elim ((by decide : (1 : Fin 4) ≠ 3) h) + · rcases h30.2 with h | h + · exact False.elim ((by decide : (1 : Fin 4) ≠ 3) h) + · exact False.elim ((by decide : (1 : Fin 4) ≠ 0) h) + obtain ⟨j, hj, hkind⟩ := edge_support _ e hec hxedge + have howner : owner j = owner 3 := + owner_unique (LatticeVertexIncidentCell x j) (owner j) (owner 3) + (owner_spec j |>.2.2) (by simpa using hj) + have hj3 : j = 3 := hinj howner + subst j + have hright : e = {x - I, x} ∨ e = {x, x + 1} := by + rcases hkind with h01 | h12 | h23 | h30 + · rcases h01.2 with h | h + · exact False.elim ((by decide : (3 : Fin 4) ≠ 0) h) + · exact False.elim ((by decide : (3 : Fin 4) ≠ 1) h) + · rcases h12.2 with h | h + · exact False.elim ((by decide : (3 : Fin 4) ≠ 1) h) + · exact False.elim ((by decide : (3 : Fin 4) ≠ 2) h) + · exact Or.inl h23.1 + · exact Or.inr h30.1 + rcases hleft with hl | hl <;> rcases hright with hr | hr + · exact star01_ne_23 (hl.symm.trans hr) + · exact star01_ne_30 (hl.symm.trans hr) + · exact star12_ne_23 (hl.symm.trans hr) + · exact star12_ne_30 (hl.symm.trans hr) + +private theorem modifiedOwnerCard : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (cells : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T.cells), ∀ (modified_cell_owner : ∀ (c : LatticeCell), (c ∈ T.cells) → (∃ a : + PeriodicSubtileIndex, a.first = 0 ∧ a.second = 0 ∧ c ∈ (cert.modified.tile a).cells)), + let owner : Fin 4 → PeriodicSubtileIndex := fun j => + Classical.choose (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) + ((Function.Injective owner) → (False)) → ( + let modifiedOwners : Finset PeriodicSubtileIndex := Finset.univ.image owner + modifiedOwners.card ≤ 3) ) := by + classical + intro q cfg C T cert x cells modified_cell_owner owner four_distinct_impossible modifiedOwners + have hle : modifiedOwners.card ≤ 4 := by + calc + modifiedOwners.card ≤ (Finset.univ : Finset (Fin 4)).card := Finset.card_image_le + _ = 4 := by simp + have hneq : modifiedOwners.card ≠ 4 := by + intro hcard + have hinjOn : Set.InjOn owner (Finset.univ : Finset (Fin 4)) := by + apply (Finset.card_image_iff).mp + simpa [modifiedOwners] using hcard + have hinj : Function.Injective owner := by + intro i j hij + exact hinjOn (by simp) (by simp) hij + exact four_distinct_impossible hinj + omega + +private theorem hnoInterior : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (∀ i : Fin 3, Bool → 0 < (q i.succ).1) → ((¬∃ (i : Fin + (3 : ℕ)) (s : Bool), (0 : ℤ) < (q i.succ).1 ∧ x ∈ FootprintVertices (cert.P i s) ∧ x + ∉ BoundaryFootprintVertices (cert.P i s)) → (∀ (i : Fin 3), ∀ (s : Bool), (x ∈ + FootprintVertices (cert.P i s)) → (x ∈ BoundaryFootprintVertices (cert.P i s)))) ) := by + classical + intro q cfg C T cert x hpos hnoWitness i s hfoot + by_contra hnotbound + exact hnoWitness ⟨i, s, hpos i s, hfoot, hnotbound⟩ + +private theorem another_parent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (∀ (U : ProtoTile), (∀ j : Fin 4, LatticeVertexIncidentCell + x j ∈ U.cells) → ((x ∈ BoundaryFootprintVertices U) → (False))) → (∀ (sourceParent : + ∀ (j : Fin 4), ∃ i : Fin 3, ∃ s : Bool, LatticeVertexIncidentCell x j ∈ (cert.P i + s).cells), + let parentOwner : Fin 4 → Fin 3 × Bool := fun j => + (Classical.choose (sourceParent j), + Classical.choose (Classical.choose_spec (sourceParent j))) + (∀ (j : Fin 4), LatticeVertexIncidentCell x j ∈ (cert.P (parentOwner j).1 (parentOwner + j).2).cells) → ((∀ (j : Fin 4), x ∈ BoundaryFootprintVertices (cert.P (parentOwner + j).1 (parentOwner j).2)) → (∃ j : Fin 4, parentOwner j ≠ parentOwner 0))) ) := by + classical + intro q cfg C T cert x all_incident_not_boundary sourceParent parentOwner parentOwner_spec + parentOwner_boundary + by_contra h + push Not at h + have hall : ∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ + (cert.P (parentOwner 0).1 (parentOwner 0).2).cells := by + intro j + simpa [h j] using parentOwner_spec j + exact all_incident_not_boundary + (cert.P (parentOwner 0).1 (parentOwner 0).2) hall (parentOwner_boundary 0) + +private theorem hp0j : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (sourceParent : ∀ (j : Fin 4), ∃ i : Fin 3, ∃ s : Bool, + LatticeVertexIncidentCell x j ∈ (cert.P i s).cells), + let parentOwner : Fin 4 → Fin 3 × Bool := fun j => + (Classical.choose (sourceParent j), + Classical.choose (Classical.choose_spec (sourceParent j))) + ∀ (parentOwner_boundary : ∀ (j : Fin 4), x ∈ BoundaryFootprintVertices (cert.P + (parentOwner j).1 (parentOwner j).2)), ∀ (j : Fin (4 : ℕ)), (parentOwner j ≠ + parentOwner (0 : Fin (4 : ℕ))) → ( + let BoundaryParents := {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} + let p0 : BoundaryParents := ⟨parentOwner 0, parentOwner_boundary 0⟩ + let pj : BoundaryParents := ⟨parentOwner j, parentOwner_boundary j⟩ + p0 ≠ pj) ) := by + classical + intro q cfg C T cert x sourceParent parentOwner parentOwner_boundary j hj BoundaryParents p0 pj h + exact hj (congrArg Subtype.val h).symm + +private theorem chooseTwo_injective : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (sourceParent : ∀ (j : Fin 4), ∃ i : Fin 3, ∃ s : Bool, + LatticeVertexIncidentCell x j ∈ (cert.P i s).cells), + let parentOwner : Fin 4 → Fin 3 × Bool := fun j => + (Classical.choose (sourceParent j), + Classical.choose (Classical.choose_spec (sourceParent j))) + ∀ (parentOwner_boundary : ∀ (j : Fin 4), x ∈ BoundaryFootprintVertices (cert.P + (parentOwner j).1 (parentOwner j).2)), ∀ (j : Fin (4 : ℕ)), + let BoundaryParents := {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} + let p0 : BoundaryParents := ⟨parentOwner 0, parentOwner_boundary 0⟩ + let pj : BoundaryParents := ⟨parentOwner j, parentOwner_boundary j⟩ + (p0 ≠ pj) → ( + let chooseTwo : Fin 2 → BoundaryParents := fun n => if n = 0 then p0 else pj + Function.Injective chooseTwo) ) := by + classical + intro q cfg C T cert x sourceParent parentOwner parentOwner_boundary j BoundaryParents p0 pj + hp0j chooseTwo m n h + fin_cases m <;> fin_cases n + · rfl + · have heq : p0 = pj := by simpa [chooseTwo] using h + exact (hp0j heq).elim + · have heq : pj = p0 := by simpa [chooseTwo] using h + exact (hp0j heq.symm).elim + · rfl + +private theorem two_le_card : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (sourceParent : ∀ (j : Fin 4), ∃ i : Fin 3, ∃ s : Bool, + LatticeVertexIncidentCell x j ∈ (cert.P i s).cells), + let parentOwner : Fin 4 → Fin 3 × Bool := fun j => + (Classical.choose (sourceParent j), + Classical.choose (Classical.choose_spec (sourceParent j))) + ∀ (parentOwner_boundary : ∀ (j : Fin 4), x ∈ BoundaryFootprintVertices (cert.P + (parentOwner j).1 (parentOwner j).2)), ∀ (j : Fin (4 : ℕ)), + let BoundaryParents := {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} + let p0 : BoundaryParents := ⟨parentOwner 0, parentOwner_boundary 0⟩ + let pj : BoundaryParents := ⟨parentOwner j, parentOwner_boundary j⟩ + let chooseTwo : Fin 2 → BoundaryParents := fun n => if n = 0 then p0 else pj + (Function.Injective chooseTwo) → (2 ≤ Nat.card BoundaryParents) ) := by + classical + intro q cfg C T cert x sourceParent parentOwner parentOwner_boundary j BoundaryParents p0 pj + chooseTwo chooseTwo_injective + have hcard := Fintype.card_le_of_injective chooseTwo chooseTwo_injective + simpa [BoundaryParents] using hcard + +private theorem hOA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), cert.O.cells ⊆ (cert.P 0 true).cells ) := by + classical + intro q cfg C T cert c hc + rw [cert.precursor_eq] at hc + exact (cert.plus_union c).mpr ⟨0, false, hc⟩ + +private theorem modified_cell_parent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let parentOfLabel : SixSubtileLabel → Fin 3 × Bool := fun + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + ∀ (m : PeriodicSubtileIndex), (m.first = 0) → ((m.second = 0) → (∀ (c : GaussianInt), (c + ∈ (cert.modified.tile m).cells) → (c ∈ (cert.P (parentOfLabel m.label).1 + (parentOfLabel m.label).2).cells ∧ (m.label = .A → c ∉ cert.O.cells)))) ) := by + classical + intro q cfg C T cert parentOfLabel m hm1 hm2 c hcell + rcases m with ⟨l, r, t⟩ + have hr : r = 0 := hm1 + have ht : t = 0 := hm2 + subst r + subst t + rw [cert.modified_tile] at hcell + cases l <;> + simpa [parentOfLabel, ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation, TileCellComplement] using hcell + +private theorem parent_label_roundtrip : + (by + classical + exact + let parentOfLabel : SixSubtileLabel → Fin 3 × Bool := fun + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + let labelFromParent : Fin 3 × Bool → SixSubtileLabel := fun + | (0, true) => .A + | (0, false) => .B + | (1, true) => .C + | (1, false) => .D + | (2, true) => .E + | (2, false) => .F + ∀ (p : Fin 3 × Bool), parentOfLabel (labelFromParent p) = p ) := by + classical + intro parentOfLabel labelFromParent p + rcases p with ⟨pi, ps⟩ + fin_cases pi <;> cases ps <;> rfl + +private theorem labelFromParent_injective : + (by + classical + exact + let parentOfLabel : SixSubtileLabel → Fin 3 × Bool := fun + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + let labelFromParent : Fin 3 × Bool → SixSubtileLabel := fun + | (0, true) => .A + | (0, false) => .B + | (1, true) => .C + | (1, false) => .D + | (2, true) => .E + | (2, false) => .F + (∀ (p : Fin 3 × Bool), parentOfLabel (labelFromParent p) = p) → (Function.Injective + labelFromParent) ) := by + classical + intro parentOfLabel labelFromParent parent_label_roundtrip p q hpq + calc + p = parentOfLabel (labelFromParent p) := (parent_label_roundtrip p).symm + _ = parentOfLabel (labelFromParent q) := congrArg parentOfLabel hpq + _ = q := parent_label_roundtrip q + +private theorem originalIndex_parent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (∀ (U : ProtoTile), TileTranslation U 0 = U) → ( + let labelFromParent : Fin 3 × Bool → SixSubtileLabel := fun + | (0, true) => .A + | (0, false) => .B + | (1, true) => .C + | (1, false) => .D + | (2, true) => .E + | (2, false) => .F + let originalIndex : Fin 3 × Bool → PeriodicSubtileIndex := fun p => + ⟨labelFromParent p, 0, 0⟩ + ∀ (p : Fin 3 × Bool), SubtileOccurrenceInterpretation cert.P cert.u cert.v (originalIndex + p) = cert.P p.1 p.2) ) := by + classical + intro q cfg C T cert tile_zero labelFromParent originalIndex p + rcases p with ⟨pi, ps⟩ + have hz := tile_zero (cert.P pi ps) + fin_cases pi <;> cases ps <;> + simpa [originalIndex, labelFromParent, + SubtileOccurrenceInterpretation] using hz + +private theorem original_disjoint : + (by + classical + exact + ∀ (quadruple : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration + quadruple), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ + (cert : BandOrderedGeneralLayoutCertificate quadruple cfg C T), ((∀ (m : ℤ), ∀ (n : ℤ), + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (⟨SixSubtileLabel.A, m, n⟩ : + PeriodicSubtileIndex)).cells ∩ (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (⟨SixSubtileLabel.B, m, n⟩ : PeriodicSubtileIndex)).cells = (TileTranslation cert.O + ((↑m : GaussianInt) * cert.u + (↑n : GaussianInt) * cert.v)).cells) ∧ ∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ¬((a.label = + SixSubtileLabel.A ∧ b.label = SixSubtileLabel.B ∨ a.label = SixSubtileLabel.B ∧ + b.label = SixSubtileLabel.A) ∧ a.first = b.first ∧ a.second = b.second) → Disjoint + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( + let parentOfLabel : SixSubtileLabel → Fin 3 × Bool := fun + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + let labelFromParent : Fin 3 × Bool → SixSubtileLabel := fun + | (0, true) => .A + | (0, false) => .B + | (1, true) => .C + | (1, false) => .D + | (2, true) => .E + | (2, false) => .F + let originalIndex : Fin 3 × Bool → PeriodicSubtileIndex := fun p => + ⟨labelFromParent p, 0, 0⟩ + (∀ (p : Fin 3 × Bool), parentOfLabel (labelFromParent p) = p) → ((Function.Injective + labelFromParent) → ((∀ (p : Fin 3 × Bool), SubtileOccurrenceInterpretation cert.P + cert.u cert.v (originalIndex p) = cert.P p.1 p.2) → (∀ (p : Fin 3 × Bool), ∀ (q : Fin + 3 × Bool), (p ≠ q) → ((¬ (p = (0, true) ∧ q = (0, false) ∨ + p = (0, false) ∧ q = (0, true))) → (Disjoint (cert.P p.1 p.2).cells (cert.P q.1 + q.2).cells)))))) ) := by + classical + intro quadruple cfg C T cert hseparation parentOfLabel labelFromParent originalIndex + parent_label_roundtrip labelFromParent_injective originalIndex_parent p q hpq hexception + have hidx : originalIndex p ≠ originalIndex q := by + intro heq + apply hpq + apply labelFromParent_injective + simpa [originalIndex] using congrArg PeriodicSubtileIndex.label heq + have hnot : ¬(((originalIndex p).label = .A ∧ + (originalIndex q).label = .B ∨ + (originalIndex p).label = .B ∧ (originalIndex q).label = .A) ∧ + (originalIndex p).first = (originalIndex q).first ∧ + (originalIndex p).second = (originalIndex q).second) := by + intro hbad + apply hexception + rcases hbad with ⟨hlabels, _, _⟩ + rcases hlabels with hbad | hbad + · have hp : p = (0, true) := by + calc + p = parentOfLabel (labelFromParent p) := (parent_label_roundtrip p).symm + _ = (0, true) := by simpa using congrArg parentOfLabel (by + simpa [originalIndex] using hbad.1) + have hq : q = (0, false) := by + calc + q = parentOfLabel (labelFromParent q) := (parent_label_roundtrip q).symm + _ = (0, false) := by simpa using congrArg parentOfLabel (by + simpa [originalIndex] using hbad.2) + exact Or.inl ⟨hp, hq⟩ + · have hp : p = (0, false) := by + calc + p = parentOfLabel (labelFromParent p) := (parent_label_roundtrip p).symm + _ = (0, false) := by simpa using congrArg parentOfLabel (by + simpa [originalIndex] using hbad.1) + have hq : q = (0, true) := by + calc + q = parentOfLabel (labelFromParent q) := (parent_label_roundtrip q).symm + _ = (0, true) := by simpa using congrArg parentOfLabel (by + simpa [originalIndex] using hbad.2) + exact Or.inr ⟨hp, hq⟩ + have hdisj := hseparation.2 (originalIndex p) (originalIndex q) hidx + hnot + rw [originalIndex_parent p, originalIndex_parent q] at hdisj + exact hdisj + +private theorem htrans : + (by + classical + exact + GaussianTranslation 0 = id ) := by + classical + funext z + simp [GaussianTranslation] + +private theorem hAB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ((∀ (m : ℤ), ∀ (n : ℤ), (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (⟨SixSubtileLabel.A, m, n⟩ : PeriodicSubtileIndex)).cells ∩ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (⟨SixSubtileLabel.B, m, n⟩ : + PeriodicSubtileIndex)).cells = (TileTranslation cert.O ((↑m : GaussianInt) * cert.u + + (↑n : GaussianInt) * cert.v)).cells) ∧ ∀ (a : PeriodicSubtileIndex), ∀ (b : + PeriodicSubtileIndex), a ≠ b → ¬((a.label = SixSubtileLabel.A ∧ b.label = + SixSubtileLabel.B ∨ a.label = SixSubtileLabel.B ∧ b.label = SixSubtileLabel.A) ∧ + a.first = b.first ∧ a.second = b.second) → Disjoint (SubtileOccurrenceInterpretation + cert.P cert.u cert.v a).cells (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b).cells) → ((GaussianTranslation 0 = id) → ((cert.P 0 true).cells ∩ (cert.P 0 + false).cells = cert.O.cells)) ) := by + classical + intro q cfg C T cert hseparation htrans + simpa [SubtileOccurrenceInterpretation, TileTranslation, htrans] using + hseparation.1 (0 : ℤ) 0 + +private theorem parent_matches_owner : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (cells : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T.cells), ∀ (modified_cell_owner : ∀ (c : LatticeCell), (c ∈ T.cells) → (∃ a : + PeriodicSubtileIndex, a.first = 0 ∧ a.second = 0 ∧ c ∈ (cert.modified.tile a).cells)), + let owner : Fin 4 → PeriodicSubtileIndex := fun j => + Classical.choose (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) + (∀ (j : Fin 4), (owner j).first = 0 ∧ (owner j).second = 0 ∧ LatticeVertexIncidentCell x + j ∈ (cert.modified.tile (owner j)).cells) → (∀ (parent_boundary_incident_cell : ∀ (i + : Fin 3), ∀ (s : Bool), (x ∈ BoundaryFootprintVertices (cert.P i s)) → (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (cert.P i s).cells)), + let BoundaryParents := {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} + let parentOfLabel : SixSubtileLabel → Fin 3 × Bool := fun + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + (∀ (m : PeriodicSubtileIndex), (m.first = 0) → ((m.second = 0) → (∀ (c : GaussianInt), (c + ∈ (cert.modified.tile m).cells) → (c ∈ (cert.P (parentOfLabel m.label).1 + (parentOfLabel m.label).2).cells ∧ (m.label = .A → c ∉ cert.O.cells))))) → ((∀ (p : + Fin 3 × Bool), ∀ (q : Fin 3 × Bool), (p ≠ q) → ((¬ (p = (0, true) ∧ q = (0, false) ∨ + p = (0, false) ∧ q = (0, true))) → (Disjoint (cert.P p.1 p.2).cells (cert.P q.1 + q.2).cells))) → (((cert.P 0 true).cells ∩ (cert.P 0 false).cells = cert.O.cells) → ( + let parentCellIndex : BoundaryParents → Fin 4 := fun p => + Classical.choose (parent_boundary_incident_cell p.1.1 p.1.2 p.2) + (∀ (p : BoundaryParents), LatticeVertexIncidentCell x (parentCellIndex p) ∈ (cert.P p.1.1 + p.1.2).cells) → (∀ (p : BoundaryParents), (p.1 ≠ (0, true)) → (p.1 = parentOfLabel + (owner (parentCellIndex p)).label)))))) ) := by + classical + intro q cfg C T cert x cells modified_cell_owner owner owner_spec parent_boundary_incident_cell + BoundaryParents parentOfLabel modified_cell_parent original_disjoint hAB parentCellIndex + parentCellIndex_spec p hp + let j := parentCellIndex p + let c := LatticeVertexIncidentCell x j + have hcP : c ∈ (cert.P p.1.1 p.1.2).cells := parentCellIndex_spec p + have hcM : c ∈ (cert.modified.tile (owner j)).cells := (owner_spec j).2.2 + have hm := modified_cell_parent (owner j) (owner_spec j).1 + (owner_spec j).2.1 c hcM + let r := parentOfLabel (owner j).label + by_cases hpr : p.1 = r + · exact hpr + · have hexception : ¬ (p.1 = (0, true) ∧ r = (0, false) ∨ + p.1 = (0, false) ∧ r = (0, true)) := by + intro hbad + rcases hbad with hbad | hbad + · exact hp hbad.1 + · have hmlabel : (owner j).label = .A := by + cases hl : (owner j).label <;> + simp [r, parentOfLabel, hl] at hbad ⊢ + have hcO : c ∈ cert.O.cells := by + have hcBoth : c ∈ (cert.P 0 true).cells ∩ + (cert.P 0 false).cells := by + rw [Finset.mem_inter] + constructor + · have hr : parentOfLabel (owner j).label = (0, true) := hbad.2 + simpa [r, hr] using hm.1 + · simpa [hbad.1] using hcP + rw [← hAB] + exact hcBoth + exact hm.2 hmlabel hcO + have hdisj := original_disjoint p.1 r hpr hexception + exact False.elim ((Finset.disjoint_left.mp hdisj) hcP hm.1) + +private theorem parentMap_injective : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (cells : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T.cells), ∀ (modified_cell_owner : ∀ (c : LatticeCell), (c ∈ T.cells) → (∃ a : + PeriodicSubtileIndex, a.first = 0 ∧ a.second = 0 ∧ c ∈ (cert.modified.tile + a).cells)), + let owner : Fin 4 → PeriodicSubtileIndex := fun j => + Classical.choose (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) + ∀ (parent_boundary_incident_cell : ∀ (i : Fin 3), ∀ (s : Bool), (x ∈ + BoundaryFootprintVertices (cert.P i s)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j + ∈ (cert.P i s).cells)), + let modifiedOwners : Finset PeriodicSubtileIndex := + Finset.univ.image owner + (Fin (4 : ℕ)) → ( + let BoundaryParents := {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} + let parentOfLabel : SixSubtileLabel → Fin 3 × Bool := fun + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + let parentCellIndex : BoundaryParents → Fin 4 := fun p => + Classical.choose (parent_boundary_incident_cell p.1.1 p.1.2 p.2) + (∀ (p : BoundaryParents), (p.1 ≠ (0, true)) → (p.1 = parentOfLabel (owner + (parentCellIndex p)).label)) → ( + let ModOwner := {m : PeriodicSubtileIndex // m ∈ modifiedOwners} + let parentMap : BoundaryParents → Sum ModOwner Unit := fun p => + if p.1 = (0, true) then Sum.inr Unit.unit + else + let j := parentCellIndex p + Sum.inl ⟨owner j, Finset.mem_image.mpr ⟨j, Finset.mem_univ _, rfl⟩⟩ + Function.Injective parentMap))) := by + classical + intro q cfg C T cert x cells modified_cell_owner owner parent_boundary_incident_cell + modifiedOwners j BoundaryParents parentOfLabel parentCellIndex parent_matches_owner + ModOwner parentMap p q hpq + by_cases hp : p.1 = (0, true) + · have hq : q.1 = (0, true) := by + by_contra hq + simp [parentMap, hp, hq] at hpq + apply Subtype.ext + exact hp.trans hq.symm + · by_cases hq : q.1 = (0, true) + · simp [parentMap, hp, hq] at hpq + · have heq : owner (parentCellIndex p) = + owner (parentCellIndex q) := by + have hsub : (⟨owner (parentCellIndex p), + Finset.mem_image.mpr ⟨parentCellIndex p, Finset.mem_univ _, rfl⟩⟩ : ModOwner) = + ⟨owner (parentCellIndex q), + Finset.mem_image.mpr ⟨parentCellIndex q, Finset.mem_univ _, rfl⟩⟩ := by + have hsum := hpq + simp? [parentMap, hp, hq] at hsum + exact hsum + exact congrArg Subtype.val hsub + apply Subtype.ext + calc + p.1 = parentOfLabel (owner (parentCellIndex p)).label := + parent_matches_owner p hp + _ = parentOfLabel (owner (parentCellIndex q)).label := by rw [heq] + _ = q.1 := (parent_matches_owner q hq).symm + +private theorem hupper : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (cells : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T.cells), ∀ (modified_cell_owner : ∀ (c : LatticeCell), (c ∈ T.cells) → (∃ a : + PeriodicSubtileIndex, a.first = 0 ∧ a.second = 0 ∧ c ∈ (cert.modified.tile + a).cells)), + let owner : Fin 4 → PeriodicSubtileIndex := fun j => + Classical.choose (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) + ∀ (parent_boundary_incident_cell : ∀ (i : Fin 3), ∀ (s : Bool), (x ∈ + BoundaryFootprintVertices (cert.P i s)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j + ∈ (cert.P i s).cells)), + let modifiedOwners : Finset PeriodicSubtileIndex := + Finset.univ.image owner + (Fin (4 : ℕ)) → ( + let BoundaryParents := {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} + let parentCellIndex : BoundaryParents → Fin 4 := fun p => + Classical.choose (parent_boundary_incident_cell p.1.1 p.1.2 p.2) + let ModOwner := {m : PeriodicSubtileIndex // m ∈ modifiedOwners} + let parentMap : BoundaryParents → Sum ModOwner Unit := fun p => + if p.1 = (0, true) then Sum.inr Unit.unit + else + let j := parentCellIndex p + Sum.inl ⟨owner j, Finset.mem_image.mpr ⟨j, Finset.mem_univ _, rfl⟩⟩ + (Function.Injective parentMap) → (Nat.card BoundaryParents ≤ modifiedOwners.card + 1))) + := by + classical + intro q cfg C T cert x cells modified_cell_owner owner parent_boundary_incident_cell + modifiedOwners j BoundaryParents parentCellIndex ModOwner parentMap parentMap_injective + have hcard := Fintype.card_le_of_injective parentMap parentMap_injective + simpa [BoundaryParents, ModOwner, Nat.card_eq_fintype_card, + Fintype.card_sum] using hcard + +private theorem hbound : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (cells : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T.cells), ∀ (modified_cell_owner : ∀ (c : LatticeCell), (c ∈ T.cells) → (∃ a : + PeriodicSubtileIndex, a.first = 0 ∧ a.second = 0 ∧ c ∈ (cert.modified.tile a).cells)), + let owner : Fin 4 → PeriodicSubtileIndex := fun j => + Classical.choose (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) + let modifiedOwners : Finset PeriodicSubtileIndex := Finset.univ.image owner + (modifiedOwners.card ≤ 3) → ( + let BoundaryParents := {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} + (Nat.card BoundaryParents ≤ modifiedOwners.card + 1) → (Nat.card BoundaryParents ≤ 4)) ) + := by + classical + intro q cfg C T cert x cells modified_cell_owner owner modifiedOwners modifiedOwnerCard + BoundaryParents hupper + have hcard : modifiedOwners.card + 1 ≤ 4 := by omega + omega + +end GeneralDescentGeometry + +theorem P4120T1GeneralDescent + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (x : GaussianInt) (hx : x ∈ FootprintVertices T) + (hxb : x ∉ BoundaryFootprintVertices T) : + let k := Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} + (k = 2 ∨ k = 3 ∨ k = 4) ∨ + ∃ i : Fin 3, ∃ s : Bool, + 0 < (q i.succ).1 ∧ x ∈ FootprintVertices (cert.P i s) ∧ + x ∉ BoundaryFootprintVertices (cert.P i s) := by +-- BODY + classical + have cells := GeneralDescentGeometry.cells T x hxb (GeneralDescentGeometry.hsome T x hx hxb + (GeneralDescentGeometry.hneAt129 T x hx hxb)) + have hcurv := ProperBandCurvatureStructure q cfg.proper + have hOsub := GeneralDescentGeometry.hOsub q cfg C T cert + have modified_cell_owner := GeneralDescentGeometry.modified_cell_owner q cfg C T cert hOsub + let owner : Fin 4 → PeriodicSubtileIndex := fun j => + Classical.choose (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) + let I : GaussianInt := ⟨0, 1⟩ + have owner_spec (j : Fin 4) : (owner j).first = 0 ∧ (owner j).second = 0 ∧ + LatticeVertexIncidentCell x j ∈ (cert.modified.tile (owner j)).cells := + Classical.choose_spec (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) + have incident_footprint := GeneralDescentGeometry.incident_footprint x + have owner_unique (c : LatticeCell) (a b : PeriodicSubtileIndex) + (ha : c ∈ (cert.modified.tile a).cells) (hb : c ∈ (cert.modified.tile b).cells) : + a = b := (cert.partition c).unique (by simpa [cert.modified_tile] using ha) + (by simpa [cert.modified_tile] using hb) + have cell_edge_vleft := GeneralDescentGeometry.cell_edge_vleft + have cell_edge_vright := GeneralDescentGeometry.cell_edge_vright + have cell_edge_hbottom := GeneralDescentGeometry.cell_edge_hbottom + have cell_edge_htop := GeneralDescentGeometry.cell_edge_htop + have edge_support := GeneralDescentGeometry.edge_support x + have parent_cells_nonempty (i : Fin 3) (s : Bool) : + (cert.P i s).cells.Nonempty := + (LatticeTileGridStructure _ (cert.parent_lattice i s)).1.1 + have parent_boundary_incident_cell := GeneralDescentGeometry.parent_boundary_incident_cell q + cfg C T cert x edge_support (GeneralDescentGeometry.boundary_edge_is_footprint + cell_edge_vleft cell_edge_vright cell_edge_hbottom cell_edge_htop) parent_cells_nonempty + have pair_left_mem {a b c d : GaussianInt} + (h : ({a, b} : Finset GaussianInt) = {c, d}) := GeneralDescentGeometry.pair_left_mem (a := + a) (b := b) (c := c) (d := d) h + have pair_right_mem {a b c d : GaussianInt} + (h : ({a, b} : Finset GaussianInt) = {c, d}) := GeneralDescentGeometry.pair_right_mem (a := + a) (b := b) (c := c) (d := d) h + have adjacent_of_edge := GeneralDescentGeometry.adjacent_of_edge q cfg C T cert + let modifiedOwners : Finset PeriodicSubtileIndex := Finset.univ.image owner + change ((Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} = 2 ∨ + Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} = 3 ∨ + Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} = 4) ∨ + (∃ i : Fin 3, ∃ s : Bool, + 0 < (q i.succ).1 ∧ x ∈ FootprintVertices (cert.P i s) ∧ + x ∉ BoundaryFootprintVertices (cert.P i s))) + by_cases hcount : + Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} = 2 ∨ + Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} = 3 ∨ + Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} = 4 + · exact Or.inl hcount + · right + by_contra hnoWitness + have sourceParent (j : Fin 4) : + ∃ i : Fin 3, ∃ s : Bool, + LatticeVertexIncidentCell x j ∈ (cert.P i s).cells := + (cert.outer_union (LatticeVertexIncidentCell x j)).mp (cells j) + let parentOwner : Fin 4 → Fin 3 × Bool := fun j => + (Classical.choose (sourceParent j), + Classical.choose (Classical.choose_spec (sourceParent j))) + have parentOwner_spec (j : Fin 4) : + LatticeVertexIncidentCell x j ∈ + (cert.P (parentOwner j).1 (parentOwner j).2).cells := + Classical.choose_spec (Classical.choose_spec (sourceParent j)) + have parentOwner_boundary (j : Fin 4) : + x ∈ BoundaryFootprintVertices + (cert.P (parentOwner j).1 (parentOwner j).2) := + (GeneralDescentGeometry.hnoInterior q cfg C T cert x (GeneralDescentGeometry.hpos q cfg + hcurv) hnoWitness) _ _ (incident_footprint j _ (parentOwner_spec j)) + have another_parent := GeneralDescentGeometry.another_parent q cfg C T cert x + (GeneralDescentGeometry.all_incident_not_boundary x) sourceParent parentOwner_spec + parentOwner_boundary + rcases another_parent with ⟨j, hj⟩ + let BoundaryParents := {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} + let p0 : BoundaryParents := ⟨parentOwner 0, parentOwner_boundary 0⟩ + let pj : BoundaryParents := ⟨parentOwner j, parentOwner_boundary j⟩ + let chooseTwo : Fin 2 → BoundaryParents := fun n => if n = 0 then p0 else pj + have two_le_card : 2 ≤ Nat.card BoundaryParents := GeneralDescentGeometry.two_le_card q cfg C + T cert x sourceParent parentOwner_boundary j (GeneralDescentGeometry.chooseTwo_injective + q cfg C T cert x sourceParent parentOwner_boundary j (GeneralDescentGeometry.hp0j q + cfg C T cert x sourceParent parentOwner_boundary j hj)) + have hseparation := BandOriginalPairSeparation cert.P cert.O cert.u cert.v + (GeneralDescentGeometry.hOA q cfg C T cert) hOsub cert.partition + let parentOfLabel : SixSubtileLabel → Fin 3 × Bool + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + let labelFromParent : Fin 3 × Bool → SixSubtileLabel + | (0, true) => .A + | (0, false) => .B + | (1, true) => .C + | (1, false) => .D + | (2, true) => .E + | (2, false) => .F + let originalIndex : Fin 3 × Bool → PeriodicSubtileIndex := fun p => + ⟨labelFromParent p, 0, 0⟩ + have parent_label_roundtrip := GeneralDescentGeometry.parent_label_roundtrip + let parentCellIndex : BoundaryParents → Fin 4 := fun p => + Classical.choose (parent_boundary_incident_cell p.1.1 p.1.2 p.2) + have parentCellIndex_spec (p : BoundaryParents) : + LatticeVertexIncidentCell x (parentCellIndex p) ∈ + (cert.P p.1.1 p.1.2).cells := + Classical.choose_spec (parent_boundary_incident_cell p.1.1 p.1.2 p.2) + let ModOwner := {m : PeriodicSubtileIndex // m ∈ modifiedOwners} + let parentMap : BoundaryParents → Sum ModOwner Unit := fun p => + if p.1 = (0, true) then Sum.inr Unit.unit + else + let j := parentCellIndex p + Sum.inl ⟨owner j, Finset.mem_image.mpr ⟨j, Finset.mem_univ _, rfl⟩⟩ + have hbound : Nat.card BoundaryParents ≤ 4 := GeneralDescentGeometry.hbound q cfg C T cert x + cells modified_cell_owner + (GeneralDescentGeometry.modifiedOwnerCard q cfg C T cert x cells modified_cell_owner + (GeneralDescentGeometry.four_distinct_impossible q cfg C T cert x cells + modified_cell_owner owner_spec incident_footprint owner_unique edge_support + (GeneralDescentGeometry.star01_ne_12 x pair_right_mem) + (GeneralDescentGeometry.star01_ne_23 x pair_right_mem) + (GeneralDescentGeometry.star01_ne_30 x pair_right_mem) + (GeneralDescentGeometry.star12_ne_23 x pair_left_mem) + (GeneralDescentGeometry.star12_ne_30 x pair_left_mem) + (GeneralDescentGeometry.star23_ne_30 x pair_left_mem) + (GeneralDescentGeometry.chord_of_four_distinct q cfg C T cert x cells + modified_cell_owner owner_spec (GeneralDescentGeometry.adj01 q cfg C T cert x cells + modified_cell_owner owner_spec cell_edge_vleft cell_edge_vright adjacent_of_edge) + (GeneralDescentGeometry.adj12 q cfg C T cert x cells modified_cell_owner owner_spec + cell_edge_hbottom cell_edge_htop adjacent_of_edge) (GeneralDescentGeometry.adj23 q + cfg C T cert x cells modified_cell_owner owner_spec cell_edge_vleft cell_edge_vright + adjacent_of_edge) (GeneralDescentGeometry.adj30 q cfg C T cert x cells + modified_cell_owner owner_spec cell_edge_hbottom cell_edge_htop adjacent_of_edge)))) + (GeneralDescentGeometry.hupper q cfg C T cert x cells modified_cell_owner + parent_boundary_incident_cell j (GeneralDescentGeometry.parentMap_injective q cfg C T + cert x cells modified_cell_owner parent_boundary_incident_cell j + (GeneralDescentGeometry.parent_matches_owner q cfg C T cert x cells + modified_cell_owner owner_spec parent_boundary_incident_cell + (GeneralDescentGeometry.modified_cell_parent q cfg C T cert) + (GeneralDescentGeometry.original_disjoint q cfg C T cert hseparation + parent_label_roundtrip (GeneralDescentGeometry.labelFromParent_injective + parent_label_roundtrip) (GeneralDescentGeometry.originalIndex_parent q cfg C T cert + (GeneralDescentGeometry.tile_zero))) (GeneralDescentGeometry.hAB q cfg C T cert + hseparation (GeneralDescentGeometry.htrans)) parentCellIndex_spec))) + have hlower : 2 ≤ Nat.card BoundaryParents := by + simpa [BoundaryParents] using two_le_card + have hk : Nat.card BoundaryParents = 2 ∨ Nat.card BoundaryParents = 3 ∨ + Nat.card BoundaryParents = 4 := by omega + exact hcount (by simpa [BoundaryParents] using hk) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralRowData.lean b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralRowData.lean new file mode 100644 index 0000000000..94c3455aa1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralRowData.lean @@ -0,0 +1,140 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition + +-- [TABLET NODE: P4120T1GeneralRowData] + +/-! +# P4120T1GeneralRowData + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4120T1GeneralRowData + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (h : PartialOdometer) (g : IntegerLatticeFunction) + (hodo : TileOdometer (q 0) T h) (hext : GlobalOdometerExtends g h) : + ∃ (P : Fin 3 → Bool → ProtoTile) (r : Fin 3 → Bool → PartialOdometer) + (Q S : Fin 3 → Bool → ProtoTile) + (u v : Fin 3 → Bool → PartialOdometer), + BandOrderedGeneralOdometerRowData q cfg C T cert h P r Q S u v g := by +-- BODY + obtain ⟨P, r, hPband, hP, hPcells, hPfoot, hPcent, hPdom, + hPvalue, hPcompat, hPslope⟩ := + TileOdometerReindexedDecomposition q cfg.proper T h + (by linarith [cfg.childLarge]) hodo + have hfirst : 1 < (cfg.firstPredecessor 0).1 := by + rw [cfg.firstChild] + linarith [cfg.order12, cfg.secondLarge] + have hQroot : TileOdometer (cfg.firstPredecessor 0) (P 0 true) (r 0 true) := by + rw [cfg.firstChild] + exact hP 0 true + have hSroot : TileOdometer (cfg.firstPredecessor 0) (P 0 false) (r 0 false) := by + rw [cfg.firstChild] + exact hP 0 false + obtain ⟨Q, u, hQband, hQ, hQcells, hQfoot, hQcent, hQdom, + hQvalue, hQcompat, hQslope⟩ := + TileOdometerReindexedDecomposition cfg.firstPredecessor cfg.firstProper + (P 0 true) (r 0 true) hfirst hQroot + obtain ⟨S, v, hSband, hS, hScells, hSfoot, hScent, hSdom, + hSvalue, hScompat, hSslope⟩ := + TileOdometerReindexedDecomposition cfg.firstPredecessor cfg.firstProper + (P 0 false) (r 0 false) hfirst hSroot + obtain ⟨c, hc⟩ := hext + have extP : ∀ i s z, z ∈ (r i s).domain → g z = (r i s).value z + c := by + intro i s z hz + rw [hc z ((hPdom z).mpr ⟨i, s, hz⟩), hPvalue i s z hz] + have extQ : ∀ i s z, z ∈ (u i s).domain → g z = (u i s).value z + c := by + intro i s z hz + rw [extP 0 true z ((hQdom z).mpr ⟨i, s, hz⟩), hQvalue i s z hz] + have extS : ∀ i s z, z ∈ (v i s).domain → g z = (v i s).value z + c := by + intro i s z hz + rw [extP 0 false z ((hSdom z).mpr ⟨i, s, hz⟩), hSvalue i s z hz] + have compare (D : CircleCoordinates) (U V : ProtoTile) + (hU : BandPrototile D U) (hV : BandPrototile D V) + (hcent : TileCentroid U = TileCentroid V) : + U.cells = V.cells ∧ FootprintVertices U = FootprintVertices V ∧ + BoundaryFootprintVertices U = BoundaryFootprintVertices V ∧ + TileCentroid U = TileCentroid V := by + obtain ⟨hcell, hanchor⟩ := BandPrototileCentroidUnique D U V hU hV hcent + have obs := ProtoTileObservableExtensionality U V hcell hanchor + exact ⟨hcell, obs.1, obs.2.1, hcent⟩ + have obsP : ∀ i s, + (P i s).cells = (cert.P i s).cells ∧ + FootprintVertices (P i s) = FootprintVertices (cert.P i s) ∧ + BoundaryFootprintVertices (P i s) = BoundaryFootprintVertices (cert.P i s) ∧ + TileCentroid (P i s) = TileCentroid (cert.P i s) := by + intro i s + apply compare _ _ _ (TileOdometerBandPrototile _ _ _ (hP i s)) + (cert.outer_occurrence i s).1 + exact sub_left_injective ((hPcent i s).trans (cert.outer_occurrence i s).2.2.symm) + have obsQ : ∀ i s, + (Q i s).cells = (cert.Q i s).cells ∧ + FootprintVertices (Q i s) = FootprintVertices (cert.Q i s) ∧ + BoundaryFootprintVertices (Q i s) = BoundaryFootprintVertices (cert.Q i s) ∧ + TileCentroid (Q i s) = TileCentroid (cert.Q i s) := by + intro i s + apply compare _ _ _ (TileOdometerBandPrototile _ _ _ (hQ i s)) + (cert.plus_occurrence i s).1 + have hh := hQcent i s + rw [(obsP 0 true).2.2.2] at hh + exact sub_left_injective (hh.trans (cert.plus_occurrence i s).2.2.symm) + have obsS : ∀ i s, + (S i s).cells = (cert.S i s).cells ∧ + FootprintVertices (S i s) = FootprintVertices (cert.S i s) ∧ + BoundaryFootprintVertices (S i s) = BoundaryFootprintVertices (cert.S i s) ∧ + TileCentroid (S i s) = TileCentroid (cert.S i s) := by + intro i s + apply compare _ _ _ (TileOdometerBandPrototile _ _ _ (hS i s)) + (cert.minus_occurrence i s).1 + have hh := hScent i s + rw [(obsP 0 false).2.2.2] at hh + exact sub_left_injective (hh.trans (cert.minus_occurrence i s).2.2.symm) + refine ⟨P, r, Q, S, u, v, ?_⟩ + refine { + hroot := hodo, hPband := hPband, hP := hP, hPcells := hPcells, + hPfoot := hPfoot, hPcent := hPcent, hPdom := hPdom, + hPvalue := hPvalue, hPcompat := hPcompat, hPslope := hPslope, + hQroot := hQroot, hSroot := hSroot, hQband := hQband, hSband := hSband, + hQ := hQ, hS := hS, hQcells := hQcells, hScells := hScells, + hQfoot := hQfoot, hSfoot := hSfoot, hQcent := hQcent, hScent := hScent, + hQdom := hQdom, hSdom := hSdom, hQvalue := hQvalue, hSvalue := hSvalue, + hQcompat := hQcompat, hScompat := hScompat, hQslope := hQslope, + hSslope := hSslope, hextP := fun i s => ⟨c, extP i s⟩, + hextQ := fun i s => ⟨c, extQ i s⟩, hextS := fun i s => ⟨c, extS i s⟩, + hcompat := ?_, hobsP := obsP, hobsQ := obsQ, hobsS := obsS } + intro a b ha hb + have common : ∀ a : PartialOdometer, + (∃ i s, a = r i s ∨ a = u i s ∨ a = v i s) → + ∀ z, z ∈ a.domain → g z = a.value z + c := by + intro a ha + rcases ha with ⟨i, s, rfl | rfl | rfl⟩ + · exact extP i s + · exact extQ i s + · exact extS i s + right + refine ⟨0, ?_⟩ + intro z hza hzb + have ha' := common a ha z hza + have hb' := common b hb z hzb + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1RootNormalization.lean b/LeanPool/ApollonianSuperharmonic/P4120T1RootNormalization.lean new file mode 100644 index 0000000000..fd4d238fc7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4120T1RootNormalization.lean @@ -0,0 +1,703 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import LeanPool.ApollonianSuperharmonic.BandParentRotationOccurrenceCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryGlobalOdometerTransport +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas + +-- [TABLET NODE: P4120T1RootNormalization] + +/-! +# P4120T1RootNormalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RootNormalizationGeometry + +private theorem hroot' : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), (BandPrototile (q (0 : Fin (4 : + ℕ))) T) → (∀ (a : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + let q' := BandPackingSymmetryQuadrupleAction s qa + let T' := BandPackingSymmetryTileAction s T + BandPrototile (q' 0) T') ) := by + classical + intro q T hT a s qa q' T' + have hb := (BandPackingSymmetryCovariance s).2.1 (qa 0) T + have ht := hb.mp hT + simpa [q', T', BandPackingSymmetryQuadrupleAction] using ht + +private theorem hodo' : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), + (TileOdometer (q (0 : Fin (4 : ℕ))) T h) → (∀ (a : Fin (3 : ℕ)), ∀ (s : + BandPackingSymmetry), + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + let q' := BandPackingSymmetryQuadrupleAction s qa + let T' := BandPackingSymmetryTileAction s T + let h' := BandPackingSymmetryPartialOdometerAction s h + TileOdometer (q' 0) T' h') ) := by + classical + intro q T h hodo a s qa q' T' h' + have ho := (BandPackingSymmetryTileOdometerCovariance s (q 0) T h hodo).1 + simpa [qa, q', T', h', BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryPartialOdometerAction] using ho + +private theorem geom : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (r : BandPackingSymmetry), ∀ U : ProtoTile, FootprintVertices + (BandPackingSymmetryTileAction r U) = BandPackingSymmetryVectorAction r '' + FootprintVertices U ∧ BoundaryFootprintVertices (BandPackingSymmetryTileAction r U) = + BandPackingSymmetryVectorAction r '' BoundaryFootprintVertices U ∧ TileCentroid + (BandPackingSymmetryTileAction r U) = R r (TileCentroid U) ) := by + classical + intro R r U + induction r generalizing U with + | identity => simp [R, BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + | negate => + rcases TileQuarterTurnFormulas U with ⟨_, _, _, _, hc, hf, _, hb, _⟩ + have hmap : GaussianQuarterTurn = + BandPackingSymmetryVectorAction .negate := by + funext z + rfl + rw [BandPackingSymmetryTileAction, hf, hb, hc, hmap] + exact ⟨rfl, rfl, by simp [R]⟩ + | conjugate => + rcases TileReflectionFormulas U with ⟨_, _, _, _, hc0, hf0, _, hb0, _⟩ + rcases TileQuarterTurnFormulas (TileReflection U) with + ⟨_, _, _, _, hc1, hf1, _, hb1, _⟩ + rcases TileQuarterTurnFormulas (TileQuarterTurn (TileReflection U)) with + ⟨_, _, _, _, hc2, hf2, _, hb2, _⟩ + have hmap : (fun z => GaussianQuarterTurn (GaussianQuarterTurn + (GaussianReflection z))) = + BandPackingSymmetryVectorAction .conjugate := by + funext z + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn, + GaussianReflection] + constructor + · rw [BandPackingSymmetryTileAction, hf2, hf1, hf0, + Set.image_image, Set.image_image, hmap] + constructor + · rw [BandPackingSymmetryTileAction, hb2, hb1, hb0, + Set.image_image, Set.image_image, hmap] + · change TileCentroid + (TileQuarterTurn (TileQuarterTurn (TileReflection U))) = _ + rw [hc2, hc1, hc0] + simp [R] + | shift w => simp [R, BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + | comp g h ihg ihh => + have hg := ihg (BandPackingSymmetryTileAction h U) + have hh := ihh U + rcases hg with ⟨hgf, hgb, hgc⟩ + rcases hh with ⟨hhf, hhb, hhc⟩ + constructor + · simp [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction, Set.image_image, + hgf, hhf] + constructor + · simp [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction, Set.image_image, + hgb, hhb] + · simp [BandPackingSymmetryTileAction, R, hgc, hhc] + +private theorem hinj : + (by + classical + exact + ∀ (r : BandPackingSymmetry), Function.Injective (BandPackingSymmetryVectorAction r) ) := by + classical + intro r + induction r with + | identity => intro x y hxy; exact hxy + | negate => + intro x y hxy + change GaussianQuarterTurn x = GaussianQuarterTurn y at hxy + have hh := congrArg GaussianQuarterTurn hxy + rcases x with ⟨xr, xi⟩ + rcases y with ⟨yr, yi⟩ + simp [GaussianQuarterTurn] at hh ⊢ + omega + | conjugate => + intro x y hxy + change -GaussianReflection x = -GaussianReflection y at hxy + have hn : GaussianReflection x = GaussianReflection y := neg_injective hxy + have hh := congrArg GaussianReflection hn + rcases x with ⟨xr, xi⟩ + rcases y with ⟨yr, yi⟩ + simp [GaussianReflection] at hh ⊢ + omega + | shift w => intro x y hxy; exact hxy + | comp r t ihr iht => + intro x y hxy + exact iht (ihr hxy) + +private theorem rinj : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (r : BandPackingSymmetry), Function.Injective (R r) ) := by + classical + intro R r + induction r with + | identity => intro x y hxy; exact hxy + | negate => + intro x y hxy + change (-x.2, x.1) = (-y.2, y.1) at hxy + exact Prod.ext (by simpa using congrArg Prod.snd hxy) + (by simpa using congrArg Prod.fst hxy) + | conjugate => + intro x y hxy + change (-x.1, x.2) = (-y.1, y.2) at hxy + exact Prod.ext (by simpa using congrArg Prod.fst hxy) + (by simpa using congrArg Prod.snd hxy) + | shift w => intro x y hxy; exact hxy + | comp r t ihr iht => + intro x y hxy + exact iht (ihr hxy) + +private theorem rpoint : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + ∀ (r : BandPackingSymmetry), ∀ (z : GaussianInt), R r (GaussianRealPoint z) = + GaussianRealPoint (BandPackingSymmetryVectorAction r z) ) := by + classical + intro R r z + induction r generalizing z with + | identity => rfl + | negate => simp [R, BandPackingSymmetryVectorAction, GaussianRealPoint, + GaussianQuarterTurn] + | conjugate => simp [R, BandPackingSymmetryVectorAction, GaussianRealPoint, + GaussianReflection] + | shift w => rfl + | comp r t ihr iht => simp [R, BandPackingSymmetryVectorAction, ihr, iht] + +private theorem hidx : + (by + classical + exact + ∀ (a : Fin (3 : ℕ)), ∀ (i : Fin 3), a + (i - a) = i ) := by + classical + intro a i + apply Fin.ext + simp + +private theorem he : + (by + classical + exact + ∀ (a : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), ∀ (d : Bool), ∀ (e₁ : Fin (3 : ℕ) × + Bool ≃ Fin (3 : ℕ) × Bool), (∀ (i : Fin (3 : ℕ)), ∀ (s_1 : Bool), (e₁ : Fin + (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s_1) = ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation s = true then -i else i) i, s_1 ^^ d)) → ( + let shift : (Fin 3 × Bool) ≃ (Fin 3 × Bool) := + { toFun := fun p => (p.1 - a, p.2) + invFun := fun p => (p.1 + a, p.2) + left_inv := by + rintro ⟨i, t⟩ + apply Prod.ext + · apply Fin.ext + simp + · rfl + right_inv := by + rintro ⟨i, t⟩ + apply Prod.ext + · apply Fin.ext + simp + · rfl } + let e : (Fin 3 × Bool) ≃ (Fin 3 × Bool) := shift.trans e₁ + ∀ (i : Fin 3), ∀ (t : Bool), e (i, t) = ((if BandPackingSymmetryReversesOrientation s + then -(i - a) else i - a), xor t d))) := by + classical + intro a s d e₁ he₁ shift e i t + simp [e, shift, Equiv.trans_apply, he₁] + +private theorem hSact : + (by + classical + exact + ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (a : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), + let Sa : Fin 3 → Bool → ProtoTile := fun i t => S (a + i) t + ∀ (e₁ : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (S' : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s_1 : Bool), S' ((e₁ : Fin (3 : ℕ) × + Bool → Fin (3 : ℕ) × Bool) (i, s_1)).1 ((e₁ : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × + Bool) (i, s_1)).2 = BandPackingSymmetryTileAction s (Sa i s_1)) → ( + let shift : (Fin 3 × Bool) ≃ (Fin 3 × Bool) := + { toFun := fun p => (p.1 - a, p.2) + invFun := fun p => (p.1 + a, p.2) + left_inv := by + rintro ⟨i, t⟩ + apply Prod.ext + · apply Fin.ext + simp + · rfl + right_inv := by + rintro ⟨i, t⟩ + apply Prod.ext + · apply Fin.ext + simp + · rfl } + let e : (Fin 3 × Bool) ≃ (Fin 3 × Bool) := shift.trans e₁ + (∀ (i : Fin 3), a + (i - a) = i) → (∀ (i : Fin 3), ∀ (t : Bool), S' (e (i, t)).1 (e (i, + t)).2 = BandPackingSymmetryTileAction s (S i t)))) := by + classical + intro S a s Sa e₁ S' hS₁ shift e hidx i t + rw [show (e (i, t)).1 = (e₁ (i - a, t)).1 by rfl, + show (e (i, t)).2 = (e₁ (i - a, t)).2 by rfl] + rw [hS₁] + congr 1 + dsimp [Sa] + rw [hidx] + +private theorem hparent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (a : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + let q' := BandPackingSymmetryQuadrupleAction s qa + ∀ (j : Fin 3), q' (if BandPackingSymmetryReversesOrientation s then -j else j).succ = + BandPackingSymmetryCircleAction s (qa j.succ) ) := by + classical + intro q a s qa q' j + have hn1 : -(1 : Fin 3) = 2 := rfl + have hn2 : -(2 : Fin 3) = 1 := rfl + cases hr : BandPackingSymmetryReversesOrientation s <;> fin_cases j <;> + simp [q', qa, BandPackingSymmetryQuadrupleAction, hr, hn1, hn2] + +private theorem hcurvature : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (a : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + (∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction s C).1 = C.1) → ( + let q' := BandPackingSymmetryQuadrupleAction s qa + ∀ (d : Bool), ∀ (e₁ : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), + let shift : (Fin 3 × Bool) ≃ (Fin 3 × Bool) := + { toFun := fun p => (p.1 - a, p.2) + invFun := fun p => (p.1 + a, p.2) + left_inv := by + rintro ⟨i, t⟩ + apply Prod.ext + · apply Fin.ext + simp + · rfl + right_inv := by + rintro ⟨i, t⟩ + apply Prod.ext + · apply Fin.ext + simp + · rfl } + let e : (Fin 3 × Bool) ≃ (Fin 3 × Bool) := shift.trans e₁ + (∀ (i : Fin 3), a + (i - a) = i) → ((∀ (i : Fin 3), ∀ (t : Bool), e (i, t) = ((if + BandPackingSymmetryReversesOrientation s then -(i - a) else i - a), xor t d)) → ((∀ + (j : Fin 3), q' (if BandPackingSymmetryReversesOrientation s then -j else j).succ = + BandPackingSymmetryCircleAction s (qa j.succ)) → ((∀ (j : Fin 3), qa j.succ = q (a + + j).succ) → (∀ (i : Fin 3), ∀ (t : Bool), (q' (e (i, t)).1.succ).1 = (q + i.succ).1)))))) := by + classical + intro q a s qa hcureq q' d e₁ shift e hidx he hparent hqaIdx i t + rw [he, hparent, hcureq] + rw [hqaIdx, hidx] + +private theorem himage : + (by + classical + exact + ∀ (s : BandPackingSymmetry), (∀ (r : BandPackingSymmetry), Function.Injective + (BandPackingSymmetryVectorAction r)) → (∀ (z : GaussianInt), ∀ (A : Set GaussianInt), + (BandPackingSymmetryVectorAction s z ∈ BandPackingSymmetryVectorAction s '' A) ↔ z ∈ + A) ) := by + classical + intro s hinj z A + constructor + · rintro ⟨y, hy, hzy⟩ + have : y = z := hinj s hzy + simpa [this] using hy + · intro hz + exact ⟨z, hz, rfl⟩ + +private theorem hx' : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → (∀ (s : + BandPackingSymmetry), + let T' := BandPackingSymmetryTileAction s T + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + (∀ (U : ProtoTile), FootprintVertices (BandPackingSymmetryTileAction s U) = + BandPackingSymmetryVectorAction s '' FootprintVertices U ∧ BoundaryFootprintVertices + (BandPackingSymmetryTileAction s U) = BandPackingSymmetryVectorAction s '' + BoundaryFootprintVertices U ∧ TileCentroid (BandPackingSymmetryTileAction s U) = R s + (TileCentroid U)) → ((∀ (z : GaussianInt), ∀ (A : Set GaussianInt), + (BandPackingSymmetryVectorAction s z ∈ BandPackingSymmetryVectorAction s '' A) ↔ z ∈ + A) → ( + let x' := BandPackingSymmetryVectorAction s x + x' ∈ FootprintVertices T'))) ) := by + classical + intro T x hx s T' R hgeom himage x' + rw [(hgeom T).1] + exact (himage x (FootprintVertices T)).2 hx + +private theorem hxb' : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∉ BoundaryFootprintVertices T) → (∀ (s : + BandPackingSymmetry), + let T' := BandPackingSymmetryTileAction s T + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + (∀ (U : ProtoTile), FootprintVertices (BandPackingSymmetryTileAction s U) = + BandPackingSymmetryVectorAction s '' FootprintVertices U ∧ BoundaryFootprintVertices + (BandPackingSymmetryTileAction s U) = BandPackingSymmetryVectorAction s '' + BoundaryFootprintVertices U ∧ TileCentroid (BandPackingSymmetryTileAction s U) = R s + (TileCentroid U)) → ((∀ (z : GaussianInt), ∀ (A : Set GaussianInt), + (BandPackingSymmetryVectorAction s z ∈ BandPackingSymmetryVectorAction s '' A) ↔ z ∈ + A) → ( + let x' := BandPackingSymmetryVectorAction s x + x' ∉ BoundaryFootprintVertices T'))) ) := by + classical + intro T x hxb s T' R hgeom himage x' + rw [(hgeom T).2.1] + intro hh + exact hxb ((himage x (BoundaryFootprintVertices T)).1 hh) + +private theorem hfp : + (by + classical + exact + ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (x : GaussianInt), ∀ (a : Fin (3 : ℕ)), ∀ (s : + BandPackingSymmetry), ∀ (e₁ : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (S' : Fin + (3 : ℕ) → Bool → ProtoTile), + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + (∀ (U : ProtoTile), FootprintVertices (BandPackingSymmetryTileAction s U) = + BandPackingSymmetryVectorAction s '' FootprintVertices U ∧ BoundaryFootprintVertices + (BandPackingSymmetryTileAction s U) = BandPackingSymmetryVectorAction s '' + BoundaryFootprintVertices U ∧ TileCentroid (BandPackingSymmetryTileAction s U) = R s + (TileCentroid U)) → ( + let shift : (Fin 3 × Bool) ≃ (Fin 3 × Bool) := + { toFun := fun p => (p.1 - a, p.2) + invFun := fun p => (p.1 + a, p.2) + left_inv := by + rintro ⟨i, t⟩ + apply Prod.ext + · apply Fin.ext + simp + · rfl + right_inv := by + rintro ⟨i, t⟩ + apply Prod.ext + · apply Fin.ext + simp + · rfl } + let e : (Fin 3 × Bool) ≃ (Fin 3 × Bool) := shift.trans e₁ + (∀ (i : Fin 3), ∀ (t : Bool), S' (e (i, t)).1 (e (i, t)).2 = + BandPackingSymmetryTileAction s (S i t)) → ((∀ (z : GaussianInt), ∀ (A : Set + GaussianInt), (BandPackingSymmetryVectorAction s z ∈ BandPackingSymmetryVectorAction + s '' A) ↔ z ∈ A) → ( + let x' := BandPackingSymmetryVectorAction s x + ∀ (i : Fin 3), ∀ (t : Bool), (x' ∈ FootprintVertices (S' (e (i, t)).1 (e (i, t)).2)) ↔ x + ∈ FootprintVertices (S i t))))) := by + classical + intro S x a s e₁ S' R hgeom shift e hSact himage x' i t + rw [hSact, (hgeom (S i t)).1] + exact himage x _ + +private theorem hbd : + (by + classical + exact + ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (x : GaussianInt), ∀ (a : Fin (3 : ℕ)), ∀ (s : + BandPackingSymmetry), ∀ (e₁ : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (S' : Fin + (3 : ℕ) → Bool → ProtoTile), + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + (∀ (U : ProtoTile), FootprintVertices (BandPackingSymmetryTileAction s U) = + BandPackingSymmetryVectorAction s '' FootprintVertices U ∧ BoundaryFootprintVertices + (BandPackingSymmetryTileAction s U) = BandPackingSymmetryVectorAction s '' + BoundaryFootprintVertices U ∧ TileCentroid (BandPackingSymmetryTileAction s U) = R s + (TileCentroid U)) → ( + let shift : (Fin 3 × Bool) ≃ (Fin 3 × Bool) := + { toFun := fun p => (p.1 - a, p.2) + invFun := fun p => (p.1 + a, p.2) + left_inv := by + rintro ⟨i, t⟩ + apply Prod.ext + · apply Fin.ext + simp + · rfl + right_inv := by + rintro ⟨i, t⟩ + apply Prod.ext + · apply Fin.ext + simp + · rfl } + let e : (Fin 3 × Bool) ≃ (Fin 3 × Bool) := shift.trans e₁ + (∀ (i : Fin 3), ∀ (t : Bool), S' (e (i, t)).1 (e (i, t)).2 = + BandPackingSymmetryTileAction s (S i t)) → ((∀ (z : GaussianInt), ∀ (A : Set + GaussianInt), (BandPackingSymmetryVectorAction s z ∈ BandPackingSymmetryVectorAction + s '' A) ↔ z ∈ A) → ( + let x' := BandPackingSymmetryVectorAction s x + ∀ (i : Fin 3), ∀ (t : Bool), (x' ∈ BoundaryFootprintVertices (S' (e (i, t)).1 (e (i, + t)).2)) ↔ x ∈ BoundaryFootprintVertices (S i t))))) := by + classical + intro S x a s e₁ S' R hgeom shift e hSact himage x' i t + rw [hSact, (hgeom (S i t)).2.1] + exact himage x _ + +private theorem hcent : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (s : BandPackingSymmetry), + let T' := BandPackingSymmetryTileAction s T + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + (∀ (U : ProtoTile), FootprintVertices (BandPackingSymmetryTileAction s U) = + BandPackingSymmetryVectorAction s '' FootprintVertices U ∧ BoundaryFootprintVertices + (BandPackingSymmetryTileAction s U) = BandPackingSymmetryVectorAction s '' + BoundaryFootprintVertices U ∧ TileCentroid (BandPackingSymmetryTileAction s U) = R s + (TileCentroid U)) → ((∀ (r : BandPackingSymmetry), Function.Injective (R r)) → ((∀ (r + : BandPackingSymmetry), ∀ (z : GaussianInt), R r (GaussianRealPoint z) = + GaussianRealPoint (BandPackingSymmetryVectorAction r z)) → ( + let x' := BandPackingSymmetryVectorAction s x + (GaussianRealPoint x' = TileCentroid T') ↔ (GaussianRealPoint x = TileCentroid T)))) ) := by + classical + intro T x s T' R hgeom rinj rpoint x' + change (GaussianRealPoint (BandPackingSymmetryVectorAction s x) = + TileCentroid (BandPackingSymmetryTileAction s T)) ↔ _ + rw [← rpoint s x, (hgeom T).2.2] + constructor + · intro hh + exact rinj s hh + · intro hh + exact congrArg (R s) hh + +private theorem hcard : + (by + classical + exact + ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (x : GaussianInt), ∀ (a : Fin (3 : ℕ)), ∀ (s : + BandPackingSymmetry), ∀ (e₁ : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (S' : Fin + (3 : ℕ) → Bool → ProtoTile), + let shift : (Fin 3 × Bool) ≃ (Fin 3 × Bool) := + { toFun := fun p => (p.1 - a, p.2) + invFun := fun p => (p.1 + a, p.2) + left_inv := by + rintro ⟨i, t⟩ + apply Prod.ext + · apply Fin.ext + simp + · rfl + right_inv := by + rintro ⟨i, t⟩ + apply Prod.ext + · apply Fin.ext + simp + · rfl } + let e : (Fin 3 × Bool) ≃ (Fin 3 × Bool) := shift.trans e₁ + let x' := BandPackingSymmetryVectorAction s x + (∀ (i : Fin 3), ∀ (t : Bool), (x' ∈ BoundaryFootprintVertices (S' (e (i, t)).1 (e (i, + t)).2)) ↔ x ∈ BoundaryFootprintVertices (S i t)) → (Nat.card + {b : Fin 3 × Bool // x' ∈ BoundaryFootprintVertices (S' b.1 b.2)} = Nat.card + {b : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S b.1 b.2)}) ) := by + classical + intro S x a s e₁ S' shift e x' hbd + let A : Type := {b : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (S b.1 b.2)} + let B : Type := {b : Fin 3 × Bool // + x' ∈ BoundaryFootprintVertices (S' b.1 b.2)} + let eb : A ≃ B := + { toFun := fun b => ⟨e b.1, by + have hb := (hbd b.1.1 b.1.2) + simpa using hb.mpr b.2⟩ + invFun := fun b => ⟨e.symm b.1, by + have hb := hbd (e.symm b.1).1 (e.symm b.1).2 + have hmem : x' ∈ BoundaryFootprintVertices + (S' (e (e.symm b.1)).1 (e (e.symm b.1)).2) := by + simpa only [e.apply_symm_apply] using b.2 + exact hb.mp hmem⟩ + left_inv := by intro b; apply Subtype.ext; simp + right_inv := by intro b; apply Subtype.ext; simp } + exact Nat.card_congr eb.symm + +end RootNormalizationGeometry + +theorem P4120T1RootNormalization + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (T : ProtoTile) (S : Fin 3 → Bool → ProtoTile) + (h : PartialOdometer) (g : IntegerLatticeFunction) + (hT : BandPrototile (q 0) T) (hodo : TileOdometer (q 0) T h) + (hext : GlobalOdometerExtends g h) + (hS : ∀ i s, BandSubtileOccurrence q T i s (S i s)) + (hcells : ∀ z, z ∈ T.cells ↔ ∃ i s, z ∈ (S i s).cells) + (x : GaussianInt) (hx : x ∈ FootprintVertices T) + (hxb : x ∉ BoundaryFootprintVertices T) : + ∃ (q' : Fin 4 → CircleCoordinates) (T' : ProtoTile) + (S' : Fin 3 → Bool → ProtoTile) (h' : PartialOdometer) + (g' : IntegerLatticeFunction) (x' : GaussianInt) + (e : (Fin 3 × Bool) ≃ (Fin 3 × Bool)), + ProperBandQuadruple q' ∧ BandPrototile (q' 0) T' ∧ + TileOdometer (q' 0) T' h' ∧ GlobalOdometerExtends g' h' ∧ + (∀ i s, BandSubtileOccurrence q' T' i s (S' i s)) ∧ + (∀ z, z ∈ T'.cells ↔ ∃ i s, z ∈ (S' i s).cells) ∧ + x' ∈ FootprintVertices T' ∧ x' ∉ BoundaryFootprintVertices T' ∧ + (∀ a : Fin 3 × Bool, + (q' (e a).1.succ).1 = (q a.1.succ).1 ∧ + (x' ∈ FootprintVertices (S' (e a).1 (e a).2) ↔ + x ∈ FootprintVertices (S a.1 a.2)) ∧ + (x' ∈ BoundaryFootprintVertices (S' (e a).1 (e a).2) ↔ + x ∈ BoundaryFootprintVertices (S a.1 a.2))) ∧ + Nat.card {a : Fin 3 × Bool // x' ∈ BoundaryFootprintVertices (S' a.1 a.2)} = + Nat.card {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} ∧ + (GaussianRealPoint x' = TileCentroid T' ↔ + GaussianRealPoint x = TileCentroid T) ∧ + FourNeighborLaplacian g' x' = FourNeighborLaplacian g x ∧ + ((∃ P : FordFareyParameter, 1 < P.q ∧ q' = FordRecursiveQuadruple P) ∨ + (∃ K : DiamondParameter, 1 < K.1 ∧ q' = DiamondRecursiveQuadruple K) ∨ + Nonempty (BandOrderedGeneralConfiguration q')) := by +-- BODY + classical + obtain ⟨a, s, hclass⟩ := BandRegimeClassification q hq + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + let Sa : Fin 3 → Bool → ProtoTile := fun i t => S (a + i) t + have hrot := BandParentRotationOccurrenceCovariance q hq a T hT S hS hcells + have hqa : ProperBandQuadruple qa := by simpa [qa] using hrot.1 + have hSa : ∀ i t, BandSubtileOccurrence qa T i t (Sa i t) := by + simpa [qa, Sa] using hrot.2.1 + have hcellSa : ∀ z, z ∈ T.cells ↔ ∃ i t, z ∈ (Sa i t).cells := by + simpa [Sa] using hrot.2.2 + have hclass' := hclass + change Xor + (∃ P : FordFareyParameter, + 1 < P.q ∧ BandPackingSymmetryQuadrupleAction s qa = FordRecursiveQuadruple P) + (Xor + (∃ K : DiamondParameter, + 1 < K.1 ∧ BandPackingSymmetryQuadrupleAction s qa = DiamondRecursiveQuadruple K) + (Nonempty (BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction s qa)))) at hclass' + have hcureq (C : CircleCoordinates) : + (BandPackingSymmetryCircleAction s C).1 = C.1 := + (BandPackingSymmetryCovariance s).1 C + let q' := BandPackingSymmetryQuadrupleAction s qa + let T' := BandPackingSymmetryTileAction s T + let h' := BandPackingSymmetryPartialOdometerAction s h + have hproper' : ProperBandQuadruple q' := by + simpa [q'] using BandPackingSymmetryProperCovariance s qa hqa + have hroot' := RootNormalizationGeometry.hroot' q T hT a s + have hcov := (BandPackingSymmetryCovariance s).2.2 qa T Sa + hqa hT hSa hcellSa + obtain ⟨d, e₁, S', hd, he₁, hS₁, hocc', hcell'⟩ := hcov + have hodo' := RootNormalizationGeometry.hodo' q T h hodo a s + obtain ⟨g', hext', hlap⟩ := + BandPackingSymmetryGlobalOdometerTransport s g h x hext + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) + (fun _ _ f k p => f (k p)) + have geom (r : BandPackingSymmetry) := RootNormalizationGeometry.geom r + have hgeom := geom s + have hinj (r : BandPackingSymmetry) := RootNormalizationGeometry.hinj r + have rinj (r : BandPackingSymmetry) := RootNormalizationGeometry.rinj r + have rpoint (r : BandPackingSymmetry) (z : GaussianInt) := RootNormalizationGeometry.rpoint r z + let shift : (Fin 3 × Bool) ≃ (Fin 3 × Bool) := + { toFun := fun p => (p.1 - a, p.2) + invFun := fun p => (p.1 + a, p.2) + left_inv := by + rintro ⟨i, t⟩ + apply Prod.ext + · apply Fin.ext + simp + · rfl + right_inv := by + rintro ⟨i, t⟩ + apply Prod.ext + · apply Fin.ext + simp + · rfl } + let e : (Fin 3 × Bool) ≃ (Fin 3 × Bool) := shift.trans e₁ + have hidx (i : Fin 3) := RootNormalizationGeometry.hidx a i + have he (i : Fin 3) (t : Bool) := RootNormalizationGeometry.he a s d e₁ he₁ i t + have hSact (i : Fin 3) (t : Bool) := RootNormalizationGeometry.hSact S a s e₁ S' hS₁ hidx i t + have hparent (j : Fin 3) := RootNormalizationGeometry.hparent q a s j + have hqaIdx (j : Fin 3) : qa j.succ = q (a + j).succ := by + fin_cases j <;> simp [qa] + have hcurvature (i : Fin 3) (t : Bool) := RootNormalizationGeometry.hcurvature q a s hcureq d + e₁ hidx he hparent hqaIdx i t + have himage (z : GaussianInt) (A : Set GaussianInt) := RootNormalizationGeometry.himage s hinj z A + let x' := BandPackingSymmetryVectorAction s x + have hx' := RootNormalizationGeometry.hx' T x hx s hgeom himage + have hxb' := RootNormalizationGeometry.hxb' T x hxb s hgeom himage + have hfp (i : Fin 3) (t : Bool) := RootNormalizationGeometry.hfp S x a s e₁ S' hgeom hSact + himage i t + have hbd (i : Fin 3) (t : Bool) := RootNormalizationGeometry.hbd S x a s e₁ S' hgeom hSact + himage i t + have hcent := RootNormalizationGeometry.hcent T x s hgeom rinj rpoint + have hcard := RootNormalizationGeometry.hcard S x a s e₁ S' hbd + refine ⟨q', T', S', h', g', x', e, + hproper', hroot', hodo', hext', hocc', ?_, hx', hxb', ?_, hcard, + hcent, ?_, ?_⟩ + · intro z + exact hcell' z + · intro b + refine ⟨hcurvature b.1 b.2, hfp b.1 b.2, hbd b.1 b.2⟩ + · exact hlap + · rcases hclass' with ⟨hF, _⟩ | ⟨hrest, _⟩ + · exact Or.inl (by simpa [q'] using hF) + · rcases hrest with ⟨hD, _⟩ | ⟨hG, _⟩ + · exact Or.inr (Or.inl (by simpa [q'] using hD)) + · exact Or.inr (Or.inr hG) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1AncestorCells.lean b/LeanPool/ApollonianSuperharmonic/P4158T1AncestorCells.lean new file mode 100644 index 0000000000..a4b2b291cc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4158T1AncestorCells.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorTile +public import LeanPool.ApollonianSuperharmonic.BandPrototileReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique + +-- [TABLET NODE: P4158T1AncestorCells] + +/-! +# P4158T1AncestorCells + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4158T1AncestorCells + (C D : CircleCoordinates) (U T : ProtoTile) + (h : AncestorTile C D U T) : U.cells ⊆ T.cells := by +-- BODY + change Relation.ReflTransGen _ (C, U) (D, T) at h + generalize hCU : (C, U) = X at h + generalize hDT : (D, T) = Y at h + have hcells : X.2.cells ⊆ Y.2.cells := by + clear hCU hDT + induction h using Relation.ReflTransGen.trans_induction_on with + | refl X => exact Finset.Subset.refl _ + | @single X Y hstep => + obtain ⟨q, i, s, hq, hY, hX, hTY, hUX, _, hcent⟩ := hstep + obtain ⟨S, hS, hcover⟩ := BandPrototileReindexedDecomposition q hq Y.2 + (by simpa only [hY] using hTY) + have hinner : BandPrototile (q i.succ) X.2 := by + simpa only [hX] using hUX + have hsame : X.2.cells = (S i s).cells := + (BandPrototileCentroidUnique (q i.succ) X.2 (S i s) hinner + (hS i s).1 (by + have heq := hcent.trans (hS i s).2.2.symm + simpa only [sub_add_cancel] using + congrArg (fun p => p + TileCentroid Y.2) heq)).1 + intro z hz + exact (hcover z).2 ⟨i, s, hsame ▸ hz⟩ + | trans _ _ hfirst hsecond => exact Finset.Subset.trans hfirst hsecond + simpa only [← hCU, ← hDT] using hcells + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean new file mode 100644 index 0000000000..5b858af3d6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean @@ -0,0 +1,2509 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.TileString +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.AffineTriangularNoFourfoldCellOwners +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne + +-- [TABLET NODE: P4158T1EdgeSectorSelection] + +/-! +# P4158T1EdgeSectorSelection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace EdgeSectorGeometry + +private theorem regular_index : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (base : ProtoTile), ∀ (PP : PeriodicTileComplex ↥(TilingLattice + Ci)), (∀ (a : ↥(TilingLattice Ci)), PP.tile a = TileTranslation base (↑a : + GaussianInt)) → (∀ (U : ProtoTile), (U ∈ RegularTileFamily base (TilingLattice Ci)) → + (∃ a : TilingLattice Ci, PP.tile a = U)) ) := by + classical + intro Ci base PP htiles U hU + change ∃ v ∈ TilingLattice Ci, U = TileTranslation base v at hU + rcases hU with ⟨v, hv, hEq⟩ + refine ⟨⟨v, hv⟩, ?_⟩ + calc + PP.tile ⟨v, hv⟩ = TileTranslation base v := htiles ⟨v, hv⟩ + _ = U := hEq.symm + +private theorem pair_eq_iff : + (by + classical + exact + ∀ {α : Type}, ∀ [DecidableEq α], ∀ (a : α), ∀ (b : α), ∀ (c : α), ∀ (d : α), (a ≠ b) → + ((c ≠ d) → (({a, b} : Finset α) = {c, d} ↔ (a = c ∧ b = d) ∨ (a = d ∧ b = c))) ) := by + classical + intro α typeclassInstance0 a b c d hab hcd + constructor + · intro h + have ha : a = c ∨ a = d := by + have hh := congrArg (fun s : Finset α => a ∈ s) h + simpa using hh + rcases ha with hac | had + · subst c + have hmem : b ∈ ({a, d} : Finset α) := by + have hb : b ∈ ({a, b} : Finset α) := by simp + rw [h] at hb + simpa only [Finset.mem_insert, Finset.mem_singleton] using hb + have hmem' : b = a ∨ b = d := by + simpa only [Finset.mem_insert, Finset.mem_singleton] using hmem + have hbd : b = d := by + rcases hmem' with hba | hbd + · exact False.elim (hab hba.symm) + · exact hbd + exact Or.inl ⟨rfl, hbd⟩ + · subst d + have hmem : b ∈ ({c, a} : Finset α) := by + have hb : b ∈ ({a, b} : Finset α) := by simp + rw [h] at hb + simpa only [Finset.mem_insert, Finset.mem_singleton] using hb + have hmem' : b = c ∨ b = a := by + simpa only [Finset.mem_insert, Finset.mem_singleton] using hmem + have hbc : b = c := by + rcases hmem' with hbc | hba + · exact hbc + · exact False.elim (hab hba.symm) + exact Or.inr ⟨rfl, hbc⟩ + · rintro (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩) + · rfl + · ext w + simp [or_comm] + +private theorem vertical_edge_cells : + (by + classical + exact + (∀ {α : Type}, ∀ [DecidableEq α], ∀ (a : α), ∀ (b : α), ∀ (c : α), ∀ (d : α), (a ≠ b) → + ((c ≠ d) → (({a, b} : Finset α) = {c, d} ↔ (a = c ∧ b = d) ∨ (a = d ∧ b = c)))) → (∀ + (W : ProtoTile), ∀ (w : GaussianInt), ({w, w + ⟨0, 1⟩} ∈ FootprintEdges W) → (w ∈ + W.cells ∨ w - 1 ∈ W.cells)) ) := by + classical + intro pair_eq_iff W w he + simp only [FootprintEdges, Set.mem_ofPred_eq] at he + obtain ⟨y, hy, hshape⟩ := he + let v : GaussianInt := ⟨0, 1⟩ + have hv0 : v ≠ 0 := by decide + have hv1 : v ≠ 1 := by decide + have hvm1 : v ≠ -1 := by decide + have hvv : v + v ≠ 0 := by decide + have htarget : w ≠ w + v := by + intro hh + have hh' : w + 0 = w + v := by simpa using hh + have hh' : (0 : GaussianInt) = v := add_left_cancel hh' + exact hv0 hh'.symm + rcases hshape with h | h | h | h + · have hsource : y ≠ y + 1 := by + intro hh + have hh' := congrArg Zsqrtd.re hh + norm_num at hh' + have hp := (pair_eq_iff w (w+v) y (y+1) htarget hsource).mp h + rcases hp with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · have hv : v = 1 := by + calc + v = (w + v) - w := by abel + _ = (y + 1) - y := by rw [h2, h1] + _ = 1 := by abel + exact (hv1 hv).elim + · have hv : v = -1 := by + calc + v = (w + v) - w := by abel + _ = y - (y + 1) := by rw [h2, h1] + _ = -1 := by abel + exact (hvm1 hv).elim + · have hsource : y ≠ y + v := by + intro hh + have hh' := congrArg Zsqrtd.im hh + norm_num [v] at hh' + have hp := (pair_eq_iff w (w+v) y (y+v) htarget hsource).mp h + rcases hp with ⟨h1, _⟩ | ⟨h1, h2⟩ + · left + simpa [h1] using hy + · have hsum : v + v = 0 := by + have hh : y + v + v = y := by + calc + y + v + v = w + v := by rw [h1] + _ = y := h2 + have hh' : y + (v + v) = y + 0 := by simpa [add_assoc] using hh + exact add_left_cancel hh' + exact (hvv hsum).elim + · have hsource : y + 1 ≠ y + 1 + v := by + intro hh + have hh' := congrArg Zsqrtd.im hh + norm_num [v] at hh' + have hp := (pair_eq_iff w (w+v) (y+1) (y+1+v) htarget hsource).mp h + rcases hp with ⟨h1, _⟩ | ⟨h1, h2⟩ + · right + have hyz : y = w - 1 := by + calc + y = (y + 1) - 1 := by abel + _ = w - 1 := by rw [h1] + simpa [hyz] using hy + · have hsum : v + v = 0 := by + have hh : (y + 1) + v + v = y + 1 := by + calc + (y + 1) + v + v = w + v := by rw [h1] + _ = y + 1 := h2 + have hh' : (y + 1) + (v + v) = (y + 1) + 0 := by + simpa [add_assoc] using hh + exact add_left_cancel hh' + exact (hvv hsum).elim + · have hsource : y + v ≠ y + 1 + v := by + intro hh + have hh' := congrArg Zsqrtd.re hh + norm_num [v] at hh' + have hp := (pair_eq_iff w (w+v) (y+v) (y+1+v) htarget hsource).mp h + rcases hp with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · have hv : v = 1 := by + calc + v = (w + v) - w := by abel + _ = (y + 1 + v) - (y + v) := by rw [h2, h1] + _ = 1 := by abel + exact (hv1 hv).elim + · have hv : v = -1 := by + calc + v = (w + v) - w := by abel + _ = (y + v) - (y + 1 + v) := by rw [h2, h1] + _ = -1 := by abel + exact (hvm1 hv).elim + +private theorem translated_ford_bounds : + (by + classical + exact + (FordFareyParameter) → ((BandCircle) → ((Fin (3 : ℕ)) → ((GaussianInt) → ((GaussianInt) → + (∀ (n : Nat), ∀ (w : GaussianInt), ∀ (c : GaussianInt), (c ∈ (TileTranslation + (FordTile n) w).cells) → (0 ≤ (c-w).re ∧ (c-w).re < n ∧ 0 ≤ (c-w).im ∧ (c-w).im < + n)))))) ) := by + classical + intro P Ci i u x n w c hc + change c ∈ (FordCellDomain n).image (GaussianTranslation w) at hc + obtain ⟨t, ht, htc⟩ := Finset.mem_image.mp hc + change t ∈ FordCellDomain n at ht + change t + w = c at htc + simp only [FordCellDomain, Finset.mem_image] at ht + obtain ⟨a, ha, hat⟩ := ht + obtain ⟨ha₁, ha₂⟩ := Finset.mem_product.mp ha + simp only [Finset.mem_range] at ha₁ ha₂ + have ht_eq : (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt) = t := hat + have hcw : c - w = t := by rw [← htc]; abel + have hr : (c-w).re = (a.1 : Int) := by rw [hcw, ← ht_eq] + have hi : (c-w).im = (a.2 : Int) := by rw [hcw, ← ht_eq] + constructor + · rw [hr]; omega + constructor + · rw [hr]; exact_mod_cast ha₁ + constructor + · rw [hi]; omega + · rw [hi]; exact_mod_cast ha₂ + +private theorem translated_ford_cell : + (by + classical + exact + ∀ (n : Nat), ∀ (a : Nat), ∀ (b : Nat), ∀ (w : GaussianInt), (a < n) → ((b < n) → (w + + (⟨(a : Int), (b : Int)⟩ : GaussianInt) ∈ (TileTranslation (FordTile n) w).cells)) ) + := by + classical + intro n a b w ha hb + change w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) ∈ + (FordCellDomain n).image (GaussianTranslation w) + refine Finset.mem_image.mpr ⟨(⟨(a : Int), (b : Int)⟩ : GaussianInt), ?_, ?_⟩ + · unfold FordCellDomain + refine Finset.mem_image.mpr ⟨(a,b), ?_, ?_⟩ + · simp [Finset.mem_product, Finset.mem_range, ha, hb] + · rfl + · simp [GaussianTranslation, add_comm] + +private theorem ford_disjoint_re : + (by + classical + exact + (FordFareyParameter) → ((BandCircle) → ((Fin (3 : ℕ)) → ((GaussianInt) → ((GaussianInt) → + ((∀ (n : Nat), ∀ (w : GaussianInt), ∀ (c : GaussianInt), (c ∈ (TileTranslation + (FordTile n) w).cells) → (0 ≤ (c-w).re ∧ (c-w).re < n ∧ 0 ≤ (c-w).im ∧ (c-w).im < n)) + → (∀ (n : Nat), ∀ (m : Nat), ∀ (w : GaussianInt), ∀ (v : GaussianInt), (w.re + n ≤ + v.re) → (Disjoint (TileTranslation (FordTile n) w).cells (TileTranslation (FordTile + m) v).cells))))))) ) := by + classical + intro P Ci i u x translated_ford_bounds n m w v hgap + apply Finset.disjoint_left.mpr + intro c hcW hcV + have hW := translated_ford_bounds n w c hcW + have hV := translated_ford_bounds m v c hcV + simp [Zsqrtd.re_sub] at hW hV + omega + +private theorem ford_disjoint_im : + (by + classical + exact + (FordFareyParameter) → ((BandCircle) → ((Fin (3 : ℕ)) → ((GaussianInt) → ((GaussianInt) → + ((∀ (n : Nat), ∀ (w : GaussianInt), ∀ (c : GaussianInt), (c ∈ (TileTranslation + (FordTile n) w).cells) → (0 ≤ (c-w).re ∧ (c-w).re < n ∧ 0 ≤ (c-w).im ∧ (c-w).im < n)) + → (∀ (n : Nat), ∀ (m : Nat), ∀ (w : GaussianInt), ∀ (v : GaussianInt), (w.im + n ≤ + v.im) → (Disjoint (TileTranslation (FordTile n) w).cells (TileTranslation (FordTile + m) v).cells))))))) ) := by + classical + intro P Ci i u x translated_ford_bounds n m w v hgap + apply Finset.disjoint_left.mpr + intro c hcW hcV + have hW := translated_ford_bounds n w c hcW + have hV := translated_ford_bounds m v c hcV + simp [Zsqrtd.im_sub] at hW hV + omega + +private theorem q₁pos : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (i : Fin (3 : + ℕ)), (i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → + (((0 : ℕ) < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), + ∀ (h' : PartialOdometer), ∀ (u : GaussianInt), (T'.cells = (TileTranslation (FordTile + P.q) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) + else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) → (∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ + (hs : List PartialOdometer), ∀ (reverseHs : List PartialOdometer), (Rminus.cells = + (TileTranslation (FordTile (if i = (0 : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i + = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (0 : ℤ)⟩ : GaussianInt) else (⟨(0 : ℤ), (↑P.q + : ℤ)⟩ : GaussianInt))).cells) → ((Rplus.cells = (TileTranslation (FordTile (if i = (0 + : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q₂ : + ℤ), (↑P.q : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : GaussianInt))).cells) + → ((∀ (z : GaussianInt), ((z - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else + (0 : ℤ)) → (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (z - u).im + → (z - u).im < (↑P.q : ℤ) → ∃ (U : ProtoTile) (V : ProtoTile) (g : PartialOdometer) + (k : PartialOdometer), U ∈ (List.drop (1 : ℕ) tiles).dropLast ∧ V ∈ (List.drop (1 : + ℕ) reverseTiles).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ (V, k) ∈ reverseTiles.zip + reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 U T g h ∧ AncestorOdometer Ci.1.1 C0.1.1 V + T' k h' ∧ {z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U ∧ {z, + z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (x : GaussianInt), + ((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) → (((if i = (0 : + Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im) → (0 < P.q₁)))))))) ) + := by + classical + intro P C0 Ci i hsmall hrpos T T' h h' u hc' Rminus Rplus tiles reverseTiles hs reverseHs hRm + hRp hedges x hxr hxl + rcases hsmall with ⟨hi, hlt⟩ | ⟨hi, hlt⟩ + · subst i + omega + · subst i + omega + +private theorem lower_lt_q : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (i : Fin (3 : + ℕ)), (i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → + (((0 : ℕ) < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), + ∀ (h' : PartialOdometer), ∀ (u : GaussianInt), (T'.cells = (TileTranslation (FordTile + P.q) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) + else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) → (∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ + (hs : List PartialOdometer), ∀ (reverseHs : List PartialOdometer), (Rminus.cells = + (TileTranslation (FordTile (if i = (0 : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i + = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (0 : ℤ)⟩ : GaussianInt) else (⟨(0 : ℤ), (↑P.q + : ℤ)⟩ : GaussianInt))).cells) → ((Rplus.cells = (TileTranslation (FordTile (if i = (0 + : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q₂ : + ℤ), (↑P.q : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : GaussianInt))).cells) + → ((∀ (z : GaussianInt), ((z - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else + (0 : ℤ)) → (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (z - u).im + → (z - u).im < (↑P.q : ℤ) → ∃ (U : ProtoTile) (V : ProtoTile) (g : PartialOdometer) + (k : PartialOdometer), U ∈ (List.drop (1 : ℕ) tiles).dropLast ∧ V ∈ (List.drop (1 : + ℕ) reverseTiles).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ (V, k) ∈ reverseTiles.zip + reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 U T g h ∧ AncestorOdometer Ci.1.1 C0.1.1 V + T' k h' ∧ {z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U ∧ {z, + z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (x : GaussianInt), + ((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) → (((if i = (0 : + Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im) → (((x - u).im ≤ (↑P.q + : ℤ)) → ((if i = 0 then (P.q₁ : Int) else P.q₂) < P.q))))))))) ) := by + classical + intro P C0 Ci i hsmall hrpos T T' h h' u hc' Rminus Rplus tiles reverseTiles hs reverseHs hRm + hRp hedges x hxr hxl hxu + rcases hsmall with ⟨hi, hlt⟩ | ⟨hi, hlt⟩ + · subst i + have hq : (P.q₁ : Int) + P.q₂ = P.q := by exact_mod_cast P.sum_q.symm + omega + · subst i + have hq : (P.q₁ : Int) + P.q₂ = P.q := by exact_mod_cast P.sum_q.symm + omega + +private theorem z_low : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (u : GaussianInt), ∀ (x : GaussianInt), + let z : GaussianInt := + if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + ((x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x) ) := by + classical + intro P i u x z hlow + change (if (x-u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩) = x + rw [ite_eq_left hlow] + +private theorem z_other : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (u : GaussianInt), ∀ (x : GaussianInt), + let z : GaussianInt := + if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + (¬(x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x - ⟨0, 1⟩) ) := by + classical + intro P i u x z hlow + change (if (x-u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩) = x - ⟨0, 1⟩ + rw [ite_eq_right hlow] + +private theorem z_incident : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (u : GaussianInt), ∀ (x : GaussianInt), + let z : GaussianInt := + if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + (((x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x)) → (((¬(x - u).im = (if + i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x - ⟨0, 1⟩)) → (z = x ∨ z = x - ⟨0, 1⟩)) ) + := by + classical + intro P i u x z z_low z_other + by_cases hlow : (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + · exact Or.inl (z_low hlow) + · exact Or.inr (z_other hlow) + +private theorem hz_re : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (u : GaussianInt), ∀ (x : + GaussianInt), ((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) → ( + let z : GaussianInt := + if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + (((x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x)) → (((¬(x - u).im = (if + i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x - ⟨0, 1⟩)) → ((z - u).re = (if i = 0 + then (P.q : Int) else 0)))) ) := by + classical + intro P i u x hxr z z_low z_other + by_cases hlow : (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + · rw [z_low hlow] + exact hxr + · have hstep : (x - ⟨0, 1⟩ - u).re = (x - u).re := by + simp [Zsqrtd.re_sub] + rw [z_other hlow, hstep] + exact hxr + +private theorem hz_low : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (i : Fin (3 : ℕ)), ∀ (u : GaussianInt), ∀ + (x : GaussianInt), ((if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x + - u).im) → ( + let z : GaussianInt := + if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + (((x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x)) → (((¬(x - u).im = (if + i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x - ⟨0, 1⟩)) → ((if i = 0 then (P.q₁ : + Int) else P.q₂) ≤ (z-u).im)))) ) := by + classical + intro P Ci i u x hxl z z_low z_other + by_cases hlow : (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + · rw [z_low hlow] + exact hxl + · have hstrict : (if i = 0 then (P.q₁ : Int) else P.q₂) < (x-u).im := by + omega + have hstep : (x - ⟨0, 1⟩ - u).im = (x-u).im - 1 := by + simp [Zsqrtd.im_sub] + omega + rw [z_other hlow, hstep] + omega + +private theorem hz_high : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (i : Fin (3 : ℕ)), ∀ (u : GaussianInt), ∀ + (x : GaussianInt), ((x - u).im ≤ (↑P.q : ℤ)) → (((if i = 0 then (P.q₁ : Int) else + P.q₂) < P.q) → ( + let z : GaussianInt := + if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + (((x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x)) → (((¬(x - u).im = (if + i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x - ⟨0, 1⟩)) → ((z-u).im < P.q))))) ) := by + classical + intro P Ci i u x hxu lower_lt_q z z_low z_other + by_cases hlow : (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + · rw [z_low hlow] + simpa [hlow] using lower_lt_q + · have hstep : (x - ⟨0, 1⟩ - u).im = (x-u).im - 1 := by + simp [Zsqrtd.im_sub] + omega + rw [z_other hlow, hstep] + omega + +private theorem U_edge : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin (3 : ℕ)), ∀ (u : + GaussianInt), ∀ (PP : PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), + let z : GaussianInt := + if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + ∀ (U : ProtoTile), ({z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U) → (∀ + (a : ↥(TilingLattice Ci)), (PP.tile a = U) → ({z, z + ⟨0, 1⟩} ∈ FootprintEdges + (PP.tile a))) ) := by + classical + intro P Ci i u PP x z U hEdgeU a hUa + rw [hUa] + exact hEdgeU + +private theorem V_edge : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin (3 : ℕ)), ∀ (u : + GaussianInt), ∀ (PP : PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), + let z : GaussianInt := + if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + ∀ (V : ProtoTile), ({z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ + (b : ↥(TilingLattice Ci)), (PP.tile b = V) → ({z, z + ⟨0, 1⟩} ∈ FootprintEdges + (PP.tile b))) ) := by + classical + intro P Ci i u PP x z V hEdgeV b hVb + rw [hVb] + exact hEdgeV + +private theorem T_bounds : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), (T.cells = + (TileTranslation (FordTile P.q) u).cells) → ((∀ (n : Nat), ∀ (w : GaussianInt), ∀ (c + : GaussianInt), (c ∈ (TileTranslation (FordTile n) w).cells) → (0 ≤ (c-w).re ∧ + (c-w).re < n ∧ 0 ≤ (c-w).im ∧ (c-w).im < n)) → (∀ (c : GaussianInt), (c ∈ T.cells) → + (0 ≤ (c-u).re ∧ (c-u).re < P.q ∧ 0 ≤ (c-u).im ∧ (c-u).im < P.q))) ) := by + classical + intro P T u hc translated_ford_bounds c hcT + have hcT' : c ∈ (TileTranslation (FordTile P.q) u).cells := by + simpa only [hc] using hcT + exact translated_ford_bounds P.q u c hcT' + +private theorem T'_bounds : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), + (T'.cells = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : ℕ)) then + (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : + GaussianInt))).cells) → ((∀ (n : Nat), ∀ (w : GaussianInt), ∀ (c : GaussianInt), (c ∈ + (TileTranslation (FordTile n) w).cells) → (0 ≤ (c-w).re ∧ (c-w).re < n ∧ 0 ≤ (c-w).im + ∧ (c-w).im < n)) → (∀ (c : GaussianInt), (c ∈ T'.cells) → (0 ≤ (c-(u + if i = 0 then + ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : Int)⟩)).re ∧ (c-(u + if i = 0 + then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : Int)⟩)).re < P.q ∧ 0 ≤ + (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : + Int)⟩)).im ∧ (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), + (P.q₂ : Int)⟩)).im < P.q))) ) := by + classical + intro P i T' u hc' translated_ford_bounds c hcT + have hcT' : c ∈ (TileTranslation (FordTile P.q) + (u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ + else ⟨-(P.q : Int), (P.q₂ : Int)⟩)).cells := by + simpa only [hc'] using hcT + exact translated_ford_bounds P.q _ c hcT' + +private theorem indexed_edge : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (i : Fin (3 : + ℕ)), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : + PartialOdometer), ∀ (u : GaussianInt), (Disjoint T.cells T'.cells) → (∀ (orientation + : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ + (tiles : List ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ (hs : List + PartialOdometer), ∀ (reverseHs : List PartialOdometer), (TileString Ci orientation + base Rminus Rplus tiles) → ((TileString Ci orientation base Rplus Rminus + reverseTiles) → ((∀ (U : ProtoTile), ∀ (g : PartialOdometer), (U, g) ∈ tiles.zip hs → + AncestorOdometer Ci.1.1 C0.1.1 U T g h → U.cells ⊆ T.cells) → ((∀ (V : ProtoTile), ∀ + (k : PartialOdometer), (V, k) ∈ reverseTiles.zip reverseHs → AncestorOdometer Ci.1.1 + C0.1.1 V T' k h' → V.cells ⊆ T'.cells) → ((∀ (z : GaussianInt), ((z - u).re = if i = + (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) → (if i = (0 : Fin (3 : ℕ)) then + (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (z - u).im → (z - u).im < (↑P.q : ℤ) → ∃ (U : + ProtoTile) (V : ProtoTile) (g : PartialOdometer) (k : PartialOdometer), U ∈ + (List.drop (1 : ℕ) tiles).dropLast ∧ V ∈ (List.drop (1 : ℕ) reverseTiles).dropLast ∧ + (U, g) ∈ tiles.zip hs ∧ (V, k) ∈ reverseTiles.zip reverseHs ∧ AncestorOdometer Ci.1.1 + C0.1.1 U T g h ∧ AncestorOdometer Ci.1.1 C0.1.1 V T' k h' ∧ {z, z + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U ∧ {z, z + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (PP : PeriodicTileComplex + ↥(TilingLattice Ci)), (∀ (U : ProtoTile), (U ∈ RegularTileFamily base (TilingLattice + Ci)) → (∃ a : TilingLattice Ci, PP.tile a = U)) → ((∀ (W : ProtoTile), ∀ (w : + GaussianInt), ({w, w + ⟨0, 1⟩} ∈ FootprintEdges W) → (w ∈ W.cells ∨ w - 1 ∈ W.cells)) + → (∀ (w : GaussianInt), ((w-u).re = (if i = 0 then (P.q : Int) else 0)) → (((if i = 0 + then (P.q₁ : Int) else P.q₂) ≤ (w-u).im) → (((w-u).im < P.q) → (∃ (aa bb : + TilingLattice Ci) (gg kk : PartialOdometer), aa ≠ bb ∧ (PP.tile aa, gg) ∈ tiles.zip + hs ∧ (PP.tile bb, kk) ∈ reverseTiles.zip reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 + (PP.tile aa) T gg h ∧ AncestorOdometer Ci.1.1 C0.1.1 (PP.tile bb) T' kk h' ∧ {w, + w + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile aa) ∧ {w, w + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile + bb)))))))))))) ) := by + classical + intro P C0 Ci i T T' h h' u hdis orientation base Rminus Rplus tiles reverseTiles hs reverseHs + hf hr hcontain hcontain' hedges PP regular_index vertical_edge_cells w hwre hwl hwu + obtain ⟨UU, VV, gg, kk, _, _, hUzip, hVzip, hUanc, hVanc, hEU, hEV⟩ := + hedges w hwre hwl hwu + have hUlist : UU ∈ tiles := (List.of_mem_zip hUzip).1 + have hVlist : VV ∈ reverseTiles := (List.of_mem_zip hVzip).1 + obtain ⟨aa, haa⟩ := regular_index UU (hf.2.2.2.2.1 UU hUlist) + obtain ⟨bb, hbb⟩ := regular_index VV (hr.2.2.2.2.1 VV hVlist) + have hEU' : {w, w + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile aa) := by + simpa [haa] using hEU + have hEV' : {w, w + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile bb) := by + simpa [hbb] using hEV + have hcell : ∃ c, c ∈ UU.cells := by + rcases vertical_edge_cells UU w hEU with hc | hc + · exact ⟨w, hc⟩ + · exact ⟨w-1, hc⟩ + have hne : aa ≠ bb := by + intro heq + obtain ⟨c, hc⟩ := hcell + have hcaa : c ∈ (PP.tile aa).cells := by simpa [haa] using hc + have hcbb : c ∈ (PP.tile bb).cells := by simpa [heq] using hcaa + have hcv : c ∈ VV.cells := by simpa [hbb] using hcbb + have hcT : c ∈ T.cells := hcontain UU gg hUzip hUanc hc + have hcT' : c ∈ T'.cells := hcontain' VV kk hVzip hVanc hcv + exact (Finset.disjoint_left.mp hdis) + hcT hcT' + exact ⟨aa, bb, gg, kk, hne, by simpa [haa] using hUzip, + by simpa [hbb] using hVzip, by simpa [haa] using hUanc, + by simpa [hbb] using hVanc, hEU', hEV'⟩ + +private theorem cross_ne : + (by + classical + exact + ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : + PartialOdometer), ∀ (h' : PartialOdometer), (Disjoint T.cells T'.cells) → (∀ (tiles : + List ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ (hs : List PartialOdometer), ∀ + (reverseHs : List PartialOdometer), (∀ (U : ProtoTile), ∀ (g : PartialOdometer), (U, + g) ∈ tiles.zip hs → AncestorOdometer Ci.1.1 C0.1.1 U T g h → U.cells ⊆ T.cells) → ((∀ + (V : ProtoTile), ∀ (k : PartialOdometer), (V, k) ∈ reverseTiles.zip reverseHs → + AncestorOdometer Ci.1.1 C0.1.1 V T' k h' → V.cells ⊆ T'.cells) → (∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (ff : TilingLattice Ci), ∀ (bb : + TilingLattice Ci), ∀ (gg : PartialOdometer), ∀ (kk : PartialOdometer), ((PP.tile ff, + gg) ∈ tiles.zip hs) → (((PP.tile bb, kk) ∈ reverseTiles.zip reverseHs) → + ((AncestorOdometer Ci.1.1 C0.1.1 (PP.tile ff) T gg h) → ((AncestorOdometer Ci.1.1 + C0.1.1 (PP.tile bb) T' kk h') → (((PP.tile ff).cells.Nonempty) → (ff ≠ bb)))))))) ) + := by + classical + intro C0 Ci T T' h h' hdis tiles reverseTiles hs reverseHs hcontain hcontain' PP ff bb gg kk + hfz hbz hfa hba hfn heq + obtain ⟨c, hc⟩ := hfn + have hcT : c ∈ T.cells := hcontain (PP.tile ff) gg hfz hfa hc + have hcB : c ∈ (PP.tile bb).cells := by simpa [heq] using hc + have hcT' : c ∈ T'.cells := hcontain' (PP.tile bb) kk hbz hba hcB + exact (Finset.disjoint_left.mp hdis) hcT hcT' + +private theorem forward_support : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (i : Fin (3 : + ℕ)), (i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → (∀ + (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : + PartialOdometer), ∀ (u : GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) (u + + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else + (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) → (∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ + (hs : List PartialOdometer), ∀ (reverseHs : List PartialOdometer), (Rminus.cells = + (TileTranslation (FordTile (if i = (0 : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i + = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (0 : ℤ)⟩ : GaussianInt) else (⟨(0 : ℤ), (↑P.q + : ℤ)⟩ : GaussianInt))).cells) → ((Rplus.cells = (TileTranslation (FordTile (if i = (0 + : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q₂ : + ℤ), (↑P.q : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : GaussianInt))).cells) + → ((∀ (z : GaussianInt), ((z - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else + (0 : ℤ)) → (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (z - u).im + → (z - u).im < (↑P.q : ℤ) → ∃ (U : ProtoTile) (V : ProtoTile) (g : PartialOdometer) + (k : PartialOdometer), U ∈ (List.drop (1 : ℕ) tiles).dropLast ∧ V ∈ (List.drop (1 : + ℕ) reverseTiles).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ (V, k) ∈ reverseTiles.zip + reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 U T g h ∧ AncestorOdometer Ci.1.1 C0.1.1 V + T' k h' ∧ {z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U ∧ {z, + z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ((x - u).re = if i = + (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) → (((if i = (0 : Fin (3 : ℕ)) then + (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im) → ((∀ (W : ProtoTile), ∀ (w : + GaussianInt), ({w, w + ⟨0, 1⟩} ∈ FootprintEdges W) → (w ∈ W.cells ∨ w - 1 ∈ W.cells)) + → (((if i = 0 then (P.q₁ : Int) else P.q₂) < P.q) → ( + let z : GaussianInt := + if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + (((x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x)) → (((¬(x - u).im = (if + i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x - ⟨0, 1⟩)) → ((z = x ∨ z = x - ⟨0, 1⟩) → + (((z - u).re = (if i = 0 then (P.q : Int) else 0)) → (((if i = 0 then (P.q₁ : Int) + else P.q₂) ≤ (z-u).im) → (((z-u).im < P.q) → (∀ (U : ProtoTile), ∀ (V : ProtoTile), + ({z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U) → (({z, + z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (a : ↥(TilingLattice + Ci)), ∀ (b : ↥(TilingLattice Ci)), (PP.tile a = U) → ((U.cells ⊆ T.cells) → (({z, + z + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile a)) → (({z, z + ⟨0, 1⟩} ∈ FootprintEdges + (PP.tile b)) → ((∀ (c : GaussianInt), (c ∈ T.cells) → (0 ≤ (c-u).re ∧ (c-u).re < P.q + ∧ 0 ≤ (c-u).im ∧ (c-u).im < P.q)) → ((∀ (c : GaussianInt), (c ∈ T'.cells) → (0 ≤ + (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : + Int)⟩)).re ∧ (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), + (P.q₂ : Int)⟩)).re < P.q ∧ 0 ≤ (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else + ⟨-(P.q : Int), (P.q₂ : Int)⟩)).im ∧ (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ + else ⟨-(P.q : Int), (P.q₂ : Int)⟩)).im < P.q)) → ((∀ (w : GaussianInt), ((w-u).re = + (if i = 0 then (P.q : Int) else 0)) → (((if i = 0 then (P.q₁ : Int) else P.q₂) ≤ + (w-u).im) → (((w-u).im < P.q) → (∃ (aa bb : TilingLattice Ci) (gg kk : + PartialOdometer), aa ≠ bb ∧ (PP.tile aa, gg) ∈ tiles.zip hs ∧ (PP.tile bb, kk) ∈ + reverseTiles.zip reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 (PP.tile aa) T gg h ∧ + AncestorOdometer Ci.1.1 C0.1.1 (PP.tile bb) T' kk h' ∧ {w, w + ⟨0, 1⟩} ∈ + FootprintEdges (PP.tile aa) ∧ {w, w + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile bb))))) → (∃ + c, c ∈ U.cells ∧ (if i = 0 then c = z - 1 else c = z))))))))))))))))))))))))) ) := by + classical + intro P C0 Ci i hsmall T T' h h' u hc' Rminus Rplus tiles reverseTiles hs reverseHs hRm hRp + hedges PP x hxr hxl vertical_edge_cells lower_lt_q z z_low z_other z_incident hz_re hz_low + hz_high U V hEdgeU hEdgeV a b hUa U_in_T U_edge V_edge T_bounds T'_bounds indexed_edge + have hsup := vertical_edge_cells U z (by simpa [hUa] using U_edge) + rcases hsmall with ⟨hi, hlt⟩ | ⟨hi, hlt⟩ + · subst i + rcases hsup with hleft | hright + · have hb := T_bounds z (U_in_T hleft) + have hzr : (z-u).re = P.q := by simpa using hz_re + have hcontra : P.q < P.q := by simpa [hzr] using hb.2.1 + exact (lt_irrefl P.q hcontra).elim + · exact ⟨z-1, hright, by simp⟩ + · subst i + rcases hsup with hleft | hright + · exact ⟨z, hleft, by simp⟩ + · have hb := T_bounds (z-1) (U_in_T hright) + have hzr : (z-u).re = 0 := by simpa using hz_re + have hzstep : ((z-1)-u).re = (z-u).re - 1 := by + simp [Zsqrtd.re_sub] + omega + have hneg : 0 ≤ -1 := by simpa [hzstep, hzr] using hb.1 + omega + +private theorem reverse_support : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (i : Fin (3 : + ℕ)), (i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → (∀ + (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : + PartialOdometer), ∀ (u : GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) (u + + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else + (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) → (∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ + (hs : List PartialOdometer), ∀ (reverseHs : List PartialOdometer), (Rminus.cells = + (TileTranslation (FordTile (if i = (0 : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i + = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (0 : ℤ)⟩ : GaussianInt) else (⟨(0 : ℤ), (↑P.q + : ℤ)⟩ : GaussianInt))).cells) → ((Rplus.cells = (TileTranslation (FordTile (if i = (0 + : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q₂ : + ℤ), (↑P.q : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : GaussianInt))).cells) + → ((∀ (z : GaussianInt), ((z - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else + (0 : ℤ)) → (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (z - u).im + → (z - u).im < (↑P.q : ℤ) → ∃ (U : ProtoTile) (V : ProtoTile) (g : PartialOdometer) + (k : PartialOdometer), U ∈ (List.drop (1 : ℕ) tiles).dropLast ∧ V ∈ (List.drop (1 : + ℕ) reverseTiles).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ (V, k) ∈ reverseTiles.zip + reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 U T g h ∧ AncestorOdometer Ci.1.1 C0.1.1 V + T' k h' ∧ {z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U ∧ {z, + z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ((x - u).re = if i = + (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) → (((if i = (0 : Fin (3 : ℕ)) then + (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im) → ((∀ (W : ProtoTile), ∀ (w : + GaussianInt), ({w, w + ⟨0, 1⟩} ∈ FootprintEdges W) → (w ∈ W.cells ∨ w - 1 ∈ W.cells)) + → (((if i = 0 then (P.q₁ : Int) else P.q₂) < P.q) → ( + let z : GaussianInt := + if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + (((x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x)) → (((¬(x - u).im = (if + i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x - ⟨0, 1⟩)) → ((z = x ∨ z = x - ⟨0, 1⟩) → + (((z - u).re = (if i = 0 then (P.q : Int) else 0)) → (((if i = 0 then (P.q₁ : Int) + else P.q₂) ≤ (z-u).im) → (((z-u).im < P.q) → (∀ (U : ProtoTile), ∀ (V : ProtoTile), + ({z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U) → (({z, + z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (a : ↥(TilingLattice + Ci)), ∀ (b : ↥(TilingLattice Ci)), (PP.tile b = V) → ((V.cells ⊆ T'.cells) → (({z, + z + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile a)) → (({z, z + ⟨0, 1⟩} ∈ FootprintEdges + (PP.tile b)) → ((∀ (c : GaussianInt), (c ∈ T'.cells) → (0 ≤ (c-(u + if i = 0 then + ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : Int)⟩)).re ∧ (c-(u + if i = 0 + then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : Int)⟩)).re < P.q ∧ 0 ≤ + (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : + Int)⟩)).im ∧ (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), + (P.q₂ : Int)⟩)).im < P.q)) → ((∀ (w : GaussianInt), ((w-u).re = (if i = 0 then (P.q : + Int) else 0)) → (((if i = 0 then (P.q₁ : Int) else P.q₂) ≤ (w-u).im) → (((w-u).im < + P.q) → (∃ (aa bb : TilingLattice Ci) (gg kk : PartialOdometer), aa ≠ bb ∧ (PP.tile + aa, gg) ∈ tiles.zip hs ∧ (PP.tile bb, kk) ∈ reverseTiles.zip reverseHs ∧ + AncestorOdometer Ci.1.1 C0.1.1 (PP.tile aa) T gg h ∧ AncestorOdometer Ci.1.1 C0.1.1 + (PP.tile bb) T' kk h' ∧ {w, w + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile aa) ∧ {w, w + ⟨0, + 1⟩} ∈ FootprintEdges (PP.tile bb))))) → ((∃ c, c ∈ U.cells ∧ (if i = 0 then c = z - 1 + else c = z)) → (∃ c, c ∈ V.cells ∧ (if i = 0 then c = z else c = z - + 1))))))))))))))))))))))))) ) := by + classical + intro P C0 Ci i hsmall T T' h h' u hc' Rminus Rplus tiles reverseTiles hs reverseHs hRm hRp + hedges PP x hxr hxl vertical_edge_cells lower_lt_q z z_low z_other z_incident hz_re hz_low + hz_high U V hEdgeU hEdgeV a b hVb V_in_T' U_edge V_edge T'_bounds indexed_edge forward_support + have hsup := vertical_edge_cells V z (by simpa [hVb] using V_edge) + rcases hsmall with ⟨hi, hlt⟩ | ⟨hi, hlt⟩ + · subst i + rcases hsup with hleft | hright + · exact ⟨z, hleft, by simp⟩ + · have hb := T'_bounds (z-1) (V_in_T' hright) + have hzr : (z-u).re = P.q := by simpa using hz_re + have hzr' : z.re - u.re = P.q := by simpa [Zsqrtd.re_sub] using hzr + have hzstep : ((z-1)-(u+⟨(P.q:Int),(P.q₁:Int)⟩)).re = -1 := by + simp [Zsqrtd.re_sub, Zsqrtd.re_add] + omega + have hneg : 0 ≤ -1 := by simpa [hzstep] using hb.1 + omega + · subst i + rcases hsup with hleft | hright + · have hb := T'_bounds z (V_in_T' hleft) + have hzr : (z-u).re = 0 := by simpa using hz_re + have hzr' : z.re - u.re = 0 := by simpa [Zsqrtd.re_sub] using hzr + have hzstep : (z-(u+⟨-(P.q:Int),(P.q₂:Int)⟩)).re = P.q := by + simp [Zsqrtd.re_sub, Zsqrtd.re_add] + omega + have hlt : P.q < P.q := by simpa [hzstep] using hb.2.1 + omega + · exact ⟨z-1, hright, by simp⟩ + +private theorem hab : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), (Disjoint T.cells T'.cells) → + (∀ (PP : PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), ∀ (a : ↥(TilingLattice Ci)), ∀ (b : ↥(TilingLattice Ci)), (PP.tile a = U) + → ((PP.tile b = V) → ((U.cells ⊆ T.cells) → ((V.cells ⊆ T'.cells) → (∀ (cf : + LatticeCell), (cf ∈ U.cells) → (a ≠ b)))))) ) := by + classical + intro Ci T T' hdis PP U V a b hUa hVb U_in_T V_in_T' cf hcf hab + have hcfA : cf ∈ (PP.tile a).cells := by simpa [hUa] using hcf + have hcfB : cf ∈ (PP.tile b).cells := by simpa [hab] using hcfA + have hcfV : cf ∈ V.cells := by simpa [hVb] using hcfB + exact (Finset.disjoint_left.mp hdis) (U_in_T hcf) (V_in_T' hcfV) + +private theorem internal_solution : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (i : Fin (3 : + ℕ)), (i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → (∀ + (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : + PartialOdometer), ∀ (u : GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) (u + + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else + (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) → (∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ + (hs : List PartialOdometer), ∀ (reverseHs : List PartialOdometer), (Rminus.cells = + (TileTranslation (FordTile (if i = (0 : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i + = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (0 : ℤ)⟩ : GaussianInt) else (⟨(0 : ℤ), (↑P.q + : ℤ)⟩ : GaussianInt))).cells) → ((Rplus.cells = (TileTranslation (FordTile (if i = (0 + : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q₂ : + ℤ), (↑P.q : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : GaussianInt))).cells) + → ((∀ (U : ProtoTile), ∀ (g : PartialOdometer), (U, g) ∈ tiles.zip hs → + AncestorOdometer Ci.1.1 C0.1.1 U T g h → U.cells ⊆ T.cells) → ((∀ (V : ProtoTile), ∀ + (k : PartialOdometer), (V, k) ∈ reverseTiles.zip reverseHs → AncestorOdometer Ci.1.1 + C0.1.1 V T' k h' → V.cells ⊆ T'.cells) → ((∀ (z : GaussianInt), ((z - u).re = if i = + (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) → (if i = (0 : Fin (3 : ℕ)) then + (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (z - u).im → (z - u).im < (↑P.q : ℤ) → ∃ (U : + ProtoTile) (V : ProtoTile) (g : PartialOdometer) (k : PartialOdometer), U ∈ + (List.drop (1 : ℕ) tiles).dropLast ∧ V ∈ (List.drop (1 : ℕ) reverseTiles).dropLast ∧ + (U, g) ∈ tiles.zip hs ∧ (V, k) ∈ reverseTiles.zip reverseHs ∧ AncestorOdometer Ci.1.1 + C0.1.1 U T g h ∧ AncestorOdometer Ci.1.1 C0.1.1 V T' k h' ∧ {z, z + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U ∧ {z, z + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (PP : PeriodicTileComplex + ↥(TilingLattice Ci)), ∀ (tileAt : ℤ × ℤ → ProtoTile), (AffineTriangularComplexChart + PP tileAt) → (∀ (x : GaussianInt), ((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q + : ℤ) else (0 : ℤ)) → (((if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ + (x - u).im) → ((∀ (W : ProtoTile), ∀ (w : GaussianInt), ({w, w + ⟨0, 1⟩} ∈ + FootprintEdges W) → (w ∈ W.cells ∨ w - 1 ∈ W.cells)) → (((if i = 0 then (P.q₁ : Int) + else P.q₂) < P.q) → ( + let z : GaussianInt := + if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + (((x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x)) → (((¬(x - u).im = (if + i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x - ⟨0, 1⟩)) → ((z = x ∨ z = x - ⟨0, 1⟩) → + (((z - u).re = (if i = 0 then (P.q : Int) else 0)) → (((if i = 0 then (P.q₁ : Int) + else P.q₂) ≤ (z-u).im) → (((z-u).im < P.q) → (∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ + (g : PartialOdometer), ∀ (k : PartialOdometer), ({z, z + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U) → (({z, z + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (a : ↥(TilingLattice Ci)), ∀ (b : + ↥(TilingLattice Ci)), (PP.tile a = U) → ((PP.tile b = V) → (({z, z + ⟨0, 1⟩} ∈ + FootprintEdges (PP.tile a)) → (({z, z + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile b)) → ((∀ + (c : GaussianInt), (c ∈ T.cells) → (0 ≤ (c-u).re ∧ (c-u).re < P.q ∧ 0 ≤ (c-u).im ∧ + (c-u).im < P.q)) → ((∀ (c : GaussianInt), (c ∈ T'.cells) → (0 ≤ (c-(u + if i = 0 then + ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : Int)⟩)).re ∧ (c-(u + if i = 0 + then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : Int)⟩)).re < P.q ∧ 0 ≤ + (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : + Int)⟩)).im ∧ (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), + (P.q₂ : Int)⟩)).im < P.q)) → ((∀ (w : GaussianInt), ((w-u).re = (if i = 0 then (P.q : + Int) else 0)) → (((if i = 0 then (P.q₁ : Int) else P.q₂) ≤ (w-u).im) → (((w-u).im < + P.q) → (∃ (aa bb : TilingLattice Ci) (gg kk : PartialOdometer), aa ≠ bb ∧ (PP.tile + aa, gg) ∈ tiles.zip hs ∧ (PP.tile bb, kk) ∈ reverseTiles.zip reverseHs ∧ + AncestorOdometer Ci.1.1 C0.1.1 (PP.tile aa) T gg h ∧ AncestorOdometer Ci.1.1 C0.1.1 + (PP.tile bb) T' kk h' ∧ {w, w + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile aa) ∧ {w, w + ⟨0, + 1⟩} ∈ FootprintEdges (PP.tile bb))))) → ((∀ (ff : TilingLattice Ci), ∀ (bb : + TilingLattice Ci), ∀ (gg : PartialOdometer), ∀ (kk : PartialOdometer), ((PP.tile ff, + gg) ∈ tiles.zip hs) → (((PP.tile bb, kk) ∈ reverseTiles.zip reverseHs) → + ((AncestorOdometer Ci.1.1 C0.1.1 (PP.tile ff) T gg h) → ((AncestorOdometer Ci.1.1 + C0.1.1 (PP.tile bb) T' kk h') → (((PP.tile ff).cells.Nonempty) → (ff ≠ bb)))))) → (∀ + (cf : LatticeCell), (cf ∈ U.cells) → ((if i = (0 : Fin (3 : ℕ)) then cf = z - (1 : + LatticeCell) else cf = z) → (∀ (cb : LatticeCell), (cb ∈ V.cells) → ((if i = (0 : Fin + (3 : ℕ)) then cb = z else cb = z - (1 : LatticeCell)) → ((a ≠ b) → (((PP.tile a, g) ∈ + tiles.zip hs) → (((PP.tile b, k) ∈ reverseTiles.zip reverseHs) → ((AncestorOdometer + Ci.1.1 C0.1.1 (PP.tile a) T g h) → ((AncestorOdometer Ci.1.1 C0.1.1 (PP.tile b) T' k + h') → (((if i = 0 then (P.q₁ : Int) else P.q₂) < (x-u).im) → (((x-u).im < P.q) → (∃ + (aa bb : TilingLattice Ci) (gg kk : PartialOdometer), aa ≠ bb ∧ (PP.tile aa, gg) ∈ + tiles.zip hs ∧ (PP.tile bb, kk) ∈ reverseTiles.zip reverseHs ∧ AncestorOdometer + Ci.1.1 C0.1.1 (PP.tile aa) T gg h ∧ AncestorOdometer Ci.1.1 C0.1.1 (PP.tile bb) T' kk + h' ∧ (∃ w, (w = x ∨ w = x - ⟨0, 1⟩) ∧ {w, w + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile aa) ∧ + {w, w + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile bb)) ∧ ((x ∈ (PP.tile aa).cells ∧ x - 1 - + ⟨0, 1⟩ ∈ (PP.tile bb).cells) ∨ (x - 1 ∈ (PP.tile aa).cells ∧ x - ⟨0, 1⟩ ∈ (PP.tile + bb).cells) ∨ (x - 1 - ⟨0, 1⟩ ∈ (PP.tile aa).cells ∧ x ∈ (PP.tile bb).cells) ∨ (x - + ⟨0, 1⟩ ∈ (PP.tile aa).cells ∧ x - 1 ∈ (PP.tile + bb).cells))))))))))))))))))))))))))))))))))))))))) ) := by + classical + intro P C0 Ci i hsmall T T' h h' u hc' Rminus Rplus tiles reverseTiles hs reverseHs hRm hRp + hcontain hcontain' hedges PP tileAt chart x hxr hxl vertical_edge_cells lower_lt_q z z_low + z_other z_incident hz_re hz_low hz_high U V g k hEdgeU hEdgeV a b hUa hVb U_edge V_edge + T_bounds T'_bounds indexed_edge cross_ne cf hcf hcfSide cb hcb hcbSide hab hAzip hBzip + hAanc hBanc hlower hupper + obtain ⟨ap, bp, gp, kp, habp, hapz, hbpz, hapA, hbpA, hapE, hbpE⟩ := + indexed_edge x hxr (le_of_lt hlower) hupper + have hAroot : (PP.tile ap).cells ⊆ T.cells := hcontain (PP.tile ap) gp hapz hapA + have hBroot : (PP.tile bp).cells ⊆ T'.cells := hcontain' (PP.tile bp) kp hbpz hbpA + have hAat : if i = 0 then x - 1 ∈ (PP.tile ap).cells else + x ∈ (PP.tile ap).cells := by + have hs := vertical_edge_cells (PP.tile ap) x hapE + rcases hsmall with ⟨hi, hlt⟩ | ⟨hi, hlt⟩ + · subst i + rcases hs with hx | hxleft + · have hbnd := T_bounds x (hAroot hx) + have hxq : (x-u).re = P.q := by simpa using hxr + have hbad : P.q < P.q := by simpa [hxq] using hbnd.2.1 + exact (lt_irrefl _ hbad).elim + · exact hxleft + · subst i + rcases hs with hx | hxleft + · exact hx + · have hbnd := T_bounds (x-1) (hAroot hxleft) + have hx0 : (x-u).re = 0 := by simpa using hxr + have hxstep : ((x-1)-u).re = (x-u).re - 1 := by + simp [Zsqrtd.re_sub] + omega + have hbad : 0 ≤ -1 := by simpa [hxstep, hx0] using hbnd.1 + omega + have hBat : if i = 0 then x ∈ (PP.tile bp).cells else + x - 1 ∈ (PP.tile bp).cells := by + have hs := vertical_edge_cells (PP.tile bp) x hbpE + rcases hsmall with ⟨hi, hlt⟩ | ⟨hi, hlt⟩ + · subst i + rcases hs with hx | hxleft + · exact hx + · have hbnd := T'_bounds (x-1) (hBroot hxleft) + have hxq : (x-u).re = P.q := by simpa using hxr + have hxstep : ((x-1)-(u+⟨(P.q:Int),(P.q₁:Int)⟩)).re = -1 := by + simp [Zsqrtd.re_sub, Zsqrtd.re_add] + have hxq' : x.re-u.re=P.q := by simpa [Zsqrtd.re_sub] using hxq + omega + have hbad : 0 ≤ -1 := by simpa [hxstep] using hbnd.1 + omega + · subst i + rcases hs with hx | hxleft + · have hbnd := T'_bounds x (hBroot hx) + have hx0 : (x-u).re = 0 := by simpa using hxr + have hxstep : (x-(u+⟨-(P.q:Int),(P.q₂:Int)⟩)).re = P.q := by + simp [Zsqrtd.re_sub, Zsqrtd.re_add] + have hx0' : x.re-u.re=0 := by simpa [Zsqrtd.re_sub] using hx0 + omega + have hbad : P.q < P.q := by simpa [hxstep] using hbnd.2.1 + exact (lt_irrefl _ hbad).elim + · exact hxleft + have hcfBelow : + (if i = 0 then x - 1 - ⟨0,1⟩ ∈ (PP.tile a).cells + else x - ⟨0,1⟩ ∈ (PP.tile a).cells) := by + rcases hsmall with ⟨hi, hlt⟩ | ⟨hi, hlt⟩ + · subst i + have hside : cf = z - 1 := by simpa using hcfSide + have hbelow : z = x - ⟨0,1⟩ := z_other (by omega) + have hcf' : cf = x - 1 - ⟨0,1⟩ := by rw [hside,hbelow]; abel + have hcfA : cf ∈ (PP.tile a).cells := by simpa [hUa] using hcf + simpa [hcf'] using hcfA + · subst i + have hside : cf = z := by simpa using hcfSide + have hbelow : z = x - ⟨0,1⟩ := z_other (by omega) + have hcf' : cf = x - ⟨0,1⟩ := by rw [hside,hbelow] + have hcfA : cf ∈ (PP.tile a).cells := by simpa [hUa] using hcf + simpa [hcf'] using hcfA + have hcbBelow : + (if i = 0 then x - ⟨0,1⟩ ∈ (PP.tile b).cells + else x - 1 - ⟨0,1⟩ ∈ (PP.tile b).cells) := by + rcases hsmall with ⟨hi, hlt⟩ | ⟨hi, hlt⟩ + · subst i + have hside : cb = z := by simpa using hcbSide + have hbelow : z = x - ⟨0,1⟩ := z_other (by omega) + have hcb' : cb = x - ⟨0,1⟩ := by rw [hside,hbelow] + have hcbB : cb ∈ (PP.tile b).cells := by simpa [hVb] using hcb + simpa [hcb'] using hcbB + · subst i + have hside : cb = z - 1 := by simpa using hcbSide + have hbelow : z = x - ⟨0,1⟩ := z_other (by omega) + have hcb' : cb = x - 1 - ⟨0,1⟩ := by rw [hside,hbelow]; abel + have hcbB : cb ∈ (PP.tile b).cells := by simpa [hVb] using hcb + simpa [hcb'] using hcbB + rcases hsmall with ⟨hi, hlt⟩ | ⟨hi, hlt⟩ + · subst i + have hfour := AffineTriangularNoFourfoldCellOwners PP tileAt chart x + bp ap a b (by simpa using hBat) (by simpa using hAat) + (by simpa using hcfBelow) (by simpa using hcbBelow) + have hcfA : cf ∈ (PP.tile a).cells := by simpa [hUa] using hcf + have hbpNon : (PP.tile bp).cells.Nonempty := ⟨x, by simpa using hBat⟩ + have hapNon : (PP.tile ap).cells.Nonempty := ⟨x-1, by simpa using hAat⟩ + have hrepetition : ap = a ∨ bp = b := by + rcases hfour with h01 | h02 | h03 | h12 | h13 | h23 + · exact False.elim (habp h01.symm) + · have hne := cross_ne a bp g kp hAzip hbpz hAanc hbpA ⟨cf, hcfA⟩ + exact False.elim (hne h02.symm) + · exact Or.inr h03 + · exact Or.inl h12 + · have hne := cross_ne ap b gp k hapz hBzip hapA hBanc hapNon + exact False.elim (hne h13) + · exact False.elim (hab h23) + refine ⟨ap, bp, gp, kp, habp, hapz, hbpz, hapA, hbpA, + ⟨x, Or.inl rfl, hapE, hbpE⟩, ?_⟩ + rcases hrepetition with hfa | hbb + · have hxOpp : x - 1 - ⟨0,1⟩ ∈ (PP.tile ap).cells := by + simpa [hfa] using hcfBelow + exact Or.inr (Or.inr (Or.inl ⟨hxOpp, by simpa using hBat⟩)) + · have hxOpp : x - ⟨0,1⟩ ∈ (PP.tile bp).cells := by + simpa [hbb] using hcbBelow + exact Or.inr (Or.inl ⟨by simpa using hAat, hxOpp⟩) + · subst i + have hfour := AffineTriangularNoFourfoldCellOwners PP tileAt chart x + ap bp b a (by simpa using hAat) (by simpa using hBat) + (by simpa using hcbBelow) (by simpa using hcfBelow) + have hcfA : cf ∈ (PP.tile a).cells := by simpa [hUa] using hcf + have hbpNon : (PP.tile bp).cells.Nonempty := ⟨x-1, by simpa using hBat⟩ + have hapNon : (PP.tile ap).cells.Nonempty := ⟨x, by simpa using hAat⟩ + have hrepetition : ap = a ∨ bp = b := by + rcases hfour with h01 | h02 | h03 | h12 | h13 | h23 + · exact False.elim (habp h01) + · have hne := cross_ne ap b gp k hapz hBzip hapA hBanc hapNon + exact False.elim (hne h02) + · exact Or.inl h03 + · exact Or.inr h12 + · have hne := cross_ne a bp g kp hAzip hbpz hAanc hbpA ⟨cf, hcfA⟩ + exact False.elim (hne h13.symm) + · exact False.elim (hab h23.symm) + refine ⟨ap, bp, gp, kp, habp, hapz, hbpz, hapA, hbpA, + ⟨x, Or.inl rfl, hapE, hbpE⟩, ?_⟩ + rcases hrepetition with hfa | hbb + · have hxOpp : x - ⟨0,1⟩ ∈ (PP.tile ap).cells := by + simpa [hfa] using hcfBelow + exact Or.inr (Or.inr (Or.inr ⟨hxOpp, by simpa using hBat⟩)) + · have hxOpp : x - 1 - ⟨0,1⟩ ∈ (PP.tile bp).cells := by + simpa [hbb] using hcbBelow + exact Or.inl ⟨by simpa using hAat, hxOpp⟩ + +private theorem hxAt721 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), + ((x-u).re = P.q) → (((x-u).im = P.q₁) → (x = u + ⟨(P.q : Int), (P.q₁ : Int)⟩))) ) := by + classical + intro P Ci u x hxre hxim + ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, + Zsqrtd.im_add] at * <;> omega + +private theorem hce : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), (x + = u + ⟨(P.q : Int), (P.q₁ : Int)⟩) → ((((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1) → + (x - ⟨0,1⟩ = (u + ⟨(P.q : Int),0⟩) + ⟨0, ((P.q₁ - 1 : Nat) : Int)⟩))) ) := by + classical + intro P Ci u x hx hnatcast + rw [hx] + ext <;> simp [hnatcast, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_sub, Zsqrtd.im_sub]; omega + +private theorem hEcellAt735 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (u : GaussianInt), ∀ (Rminus : ProtoTile), ∀ (x : + GaussianInt), (Rminus.cells = (TileTranslation (FordTile (if (0 : Fin (3 : ℕ)) = (0 : + Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then + (⟨(↑P.q : ℤ), (0 : ℤ)⟩ : GaussianInt) else (⟨(0 : ℤ), (↑P.q : ℤ)⟩ : + GaussianInt))).cells) → ((x - ⟨0,1⟩ = (u + ⟨(P.q : Int),0⟩) + ⟨0, ((P.q₁ - 1 : Nat) : + Int)⟩) → ((u + (⟨(↑P.q : ℤ), (0 : ℤ)⟩ : GaussianInt) + (⟨(↑(0 : ℕ) : ℤ), (↑(P.q₁ - (1 + : ℕ)) : ℤ)⟩ : GaussianInt) ∈ (TileTranslation (FordTile P.q₁) (u + (⟨(↑P.q : ℤ), (0 : + ℤ)⟩ : GaussianInt))).cells) → (x - ⟨0,1⟩ ∈ Rminus.cells))) ) := by + classical + intro P u Rminus x hRm hce hEtrans + rw [hRm, hce] + exact hEtrans + +private theorem hdisETAt740 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), (T.cells = + (TileTranslation (FordTile P.q) u).cells) → (∀ (Rminus : ProtoTile), (∀ (n : Nat), ∀ + (m : Nat), ∀ (w : GaussianInt), ∀ (v : GaussianInt), (w.re + n ≤ v.re) → (Disjoint + (TileTranslation (FordTile n) w).cells (TileTranslation (FordTile m) v).cells)) → + ((Rminus.cells = (TileTranslation (FordTile (if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) + then P.q₁ else P.q₂)) (u + if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : + ℤ), (0 : ℤ)⟩ : GaussianInt) else (⟨(0 : ℤ), (↑P.q : ℤ)⟩ : GaussianInt))).cells) → + (Disjoint T.cells Rminus.cells))) ) := by + classical + intro P T u hc Rminus ford_disjoint_re hRm + rw [hc, hRm] + apply ford_disjoint_re + simp [Zsqrtd.re_add] + +private theorem hdisET'At744 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), ∀ (Rminus : + ProtoTile), (∀ (n : Nat), ∀ (m : Nat), ∀ (w : GaussianInt), ∀ (v : GaussianInt), + (w.im + n ≤ v.im) → (Disjoint (TileTranslation (FordTile n) w).cells (TileTranslation + (FordTile m) v).cells)) → ((T'.cells = (TileTranslation (FordTile P.q) (u + if (0 : + Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else + (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) → ((Rminus.cells = + (TileTranslation (FordTile (if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then P.q₁ else + P.q₂)) (u + if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (0 : ℤ)⟩ : + GaussianInt) else (⟨(0 : ℤ), (↑P.q : ℤ)⟩ : GaussianInt))).cells) → (Disjoint + Rminus.cells T'.cells))) ) := by + classical + intro P T' u Rminus ford_disjoint_im hc' hRm + rw [hRm, hc'] + apply ford_disjoint_im + simp [Zsqrtd.im_add] + +private theorem he_ne_aAt748 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (U : ProtoTile), ∀ (a : ↥(TilingLattice + Ci)), (PP.tile a = U) → ((U.cells ⊆ T.cells) → (∀ (cf : LatticeCell), (cf ∈ U.cells) + → (∀ (e : ↥(TilingLattice Ci)), (PP.tile e = Rminus) → ((Disjoint T.cells + Rminus.cells) → (e ≠ a))))) ) := by + classical + intro Ci T Rminus PP U a hUa U_in_T cf hcf e he hdisET heq + have hcfA : cf ∈ (PP.tile a).cells := by simpa [hUa] using hcf + have hcfE : cf ∈ Rminus.cells := by + rw [← he] + simpa [heq] using hcfA + exact (Finset.disjoint_left.mp hdisET) (U_in_T hcf) hcfE + +private theorem he_ne_bAt755 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T' : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (V : ProtoTile), ∀ (b : ↥(TilingLattice + Ci)), (PP.tile b = V) → ((V.cells ⊆ T'.cells) → (∀ (cb : LatticeCell), (cb ∈ V.cells) + → (∀ (e : ↥(TilingLattice Ci)), (PP.tile e = Rminus) → ((Disjoint Rminus.cells + T'.cells) → (e ≠ b))))) ) := by + classical + intro Ci T' Rminus PP V b hVb V_in_T' cb hcb e he hdisET' heq + have hcbB : cb ∈ (PP.tile b).cells := by simpa [hVb] using hcb + have hcbE : cb ∈ Rminus.cells := by + rw [← he] + simpa [heq] using hcbB + exact (Finset.disjoint_left.mp hdisET') hcbE (V_in_T' hcb) + +private theorem hmcAt766 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), (x + = u + ⟨(P.q : Int), (P.q₁ : Int)⟩) → ((((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1) → ( + let m : GaussianInt := x - 1 - ⟨0,1⟩ + (((P.q - 1 : Nat) : Int) = (P.q : Int) - 1) → (m = u + ⟨((P.q - 1 : Nat) : Int), ((P.q₁ - + 1 : Nat) : Int)⟩)))) ) := by + classical + intro P Ci u x hx hnatcast m hqcast + ext <;> simp [m, hx, hqcast, hnatcast, Zsqrtd.re_sub, + Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] <;> omega + +private theorem hmTAt772 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), (T.cells = + (TileTranslation (FordTile P.q) u).cells) → (∀ (x : GaussianInt), + let m : GaussianInt := x - 1 - ⟨0,1⟩ + (m = u + ⟨((P.q - 1 : Nat) : Int), ((P.q₁ - 1 : Nat) : Int)⟩) → ((u + (⟨(↑(P.q - (1 : ℕ)) + : ℤ), (↑(P.q₁ - (1 : ℕ)) : ℤ)⟩ : GaussianInt) ∈ (TileTranslation (FordTile P.q) + u).cells) → (m ∈ T.cells))) ) := by + classical + intro P T u hc x m hmc hmTtrans + rw [hc, hmc] + exact hmTtrans + +private theorem hm_notE : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (x : GaussianInt), (Disjoint T.cells + Rminus.cells) → ( + let m : GaussianInt := x - 1 - ⟨0,1⟩ + (m ∈ T.cells) → (m ∉ Rminus.cells)) ) := by + classical + intro T Rminus x hdisET m hmT hmE + exact (Finset.disjoint_left.mp hdisET) hmT hmE + +private theorem ht_ne_eAt779 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (Rminus : ProtoTile), ∀ (PP : PeriodicTileComplex ↥(TilingLattice + Ci)), ∀ (x : GaussianInt), ∀ (e : ↥(TilingLattice Ci)), (PP.tile e = Rminus) → ( + let m : GaussianInt := x - 1 - ⟨0,1⟩ + ∀ (t : ↥(TilingLattice Ci)), (m ∈ (PP.tile t).cells) → ((m ∉ Rminus.cells) → (t ≠ e))) ) + := by + classical + intro Ci Rminus PP x e he m t ht hm_notE hte + have hmt : m ∈ (PP.tile e).cells := by simpa [hte] using ht + have hmE : m ∈ Rminus.cells := by simpa [he] using hmt + exact hm_notE hmE + +private theorem ht_ne_bAt784 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), (Disjoint T.cells T'.cells) → + (∀ (PP : PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (V : + ProtoTile), ∀ (b : ↥(TilingLattice Ci)), (PP.tile b = V) → ((V.cells ⊆ T'.cells) → ( + let m : GaussianInt := x - 1 - ⟨0,1⟩ + (m ∈ T.cells) → (∀ (t : ↥(TilingLattice Ci)), (m ∈ (PP.tile t).cells) → (t ≠ b))))) ) := by + classical + intro Ci T T' hdis PP x V b hVb V_in_T' m hmT t ht htb + have hmb : m ∈ (PP.tile b).cells := by simpa [htb] using ht + have hmV : m ∈ V.cells := by simpa [hVb] using hmb + exact (Finset.disjoint_left.mp hdis) hmT (V_in_T' hmV) + +private theorem hxbAt789 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (u : GaussianInt), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (V : ProtoTile), ∀ + (b : ↥(TilingLattice Ci)), (PP.tile b = V) → (∀ (cb : LatticeCell), (cb ∈ V.cells) → ( + let z : GaussianInt := + if (x - u).im = (if (0 : Fin 3) = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + (((x - u).im = if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : + ℤ)) → z = x) → ((if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then cb = z else cb = z - + (1 : LatticeCell)) → (((x - u).im = if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then + (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) → (x ∈ (PP.tile b).cells))))) ) := by + classical + intro P Ci u PP x V b hVb cb hcb z z_low hcbSide hlow + have hside : cb = x := by simpa [z_low hlow] using hcbSide + have hcb' : cb ∈ (PP.tile b).cells := by simpa [hVb] using hcb + simpa [hside] using hcb' + +private theorem hxaAt793 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (u : GaussianInt), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (U : ProtoTile), ∀ + (a : ↥(TilingLattice Ci)), (PP.tile a = U) → (∀ (cf : LatticeCell), (cf ∈ U.cells) → ( + let z : GaussianInt := + if (x - u).im = (if (0 : Fin 3) = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + (((x - u).im = if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : + ℤ)) → z = x) → ((if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then cf = z - (1 : + LatticeCell) else cf = z) → (((x - u).im = if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) + then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) → (x - 1 ∈ (PP.tile a).cells))))) ) := by + classical + intro P Ci u PP x U a hUa cf hcf z z_low hcfSide hlow + have hside : cf = x - 1 := by simpa [z_low hlow] using hcfSide + have hcf' : cf ∈ (PP.tile a).cells := by simpa [hUa] using hcf + simpa [hside] using hcf' + +private theorem hrepeatAt799 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (a : ↥(TilingLattice Ci)), ∀ (b : ↥(TilingLattice Ci)), (a ≠ b) → + (∀ (e : ↥(TilingLattice Ci)), (e ≠ a) → ((e ≠ b) → (∀ (t : ↥(TilingLattice Ci)), (t ≠ + e) → ((t ≠ b) → ((b = a ∨ b = t ∨ b = e ∨ a = t ∨ a = e ∨ t = e) → (a = t)))))) ) := by + classical + intro Ci a b hab e he_ne_a he_ne_b t ht_ne_e ht_ne_b hfour + rcases hfour with h01 | h02 | h03 | h12 | h13 | h23 + · exact False.elim (hab h01.symm) + · exact False.elim (ht_ne_b h02.symm) + · exact False.elim (he_ne_b h03.symm) + · exact h12 + · exact False.elim (he_ne_a h13.symm) + · exact False.elim (ht_ne_e h23) + +private theorem hxAt816 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), + ((x-u).re = 0) → (((x-u).im = P.q₂) → (x = u + ⟨0, (P.q₂ : Int)⟩))) ) := by + classical + intro P Ci u x hxre hxim + ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, + Zsqrtd.im_add] at * <;> omega + +private theorem hmcAt823 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), (x + = u + ⟨0, (P.q₂ : Int)⟩) → ((((P.q₂ - 1 : Nat) : Int) = (P.q₂ : Int) - 1) → ( + let m : GaussianInt := x - ⟨0,1⟩ + m = u + ⟨0, ((P.q₂ - 1 : Nat) : Int)⟩))) ) := by + classical + intro P Ci u x hx hncast m + ext <;> simp [m, hx, hncast, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_add, Zsqrtd.im_add]; omega + +private theorem hncAt832 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), (x + = u + ⟨0, (P.q₂ : Int)⟩) → ((((P.q₂ - 1 : Nat) : Int) = (P.q₂ : Int) - 1) → ( + let n : GaussianInt := x - 1 - ⟨0,1⟩ + n = (u + ⟨-(P.q₂ : Int),0⟩) + ⟨((P.q₂ - 1 : Nat) : Int), ((P.q₂ - 1 : Nat) : Int)⟩))) ) + := by + classical + intro P Ci u x hx hncast' n + ext <;> simp [n, hx, hncast', Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_add, Zsqrtd.im_add] <;> omega + +private theorem hdisETAt843 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), (T.cells = + (TileTranslation (FordTile P.q) u).cells) → (∀ (Rplus : ProtoTile), (∀ (n : Nat), ∀ + (m : Nat), ∀ (w : GaussianInt), ∀ (v : GaussianInt), (w.re + n ≤ v.re) → (Disjoint + (TileTranslation (FordTile n) w).cells (TileTranslation (FordTile m) v).cells)) → + ((Rplus.cells = (TileTranslation (FordTile (if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) + then P.q₁ else P.q₂)) (u + if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (⟨(↑P.q₂ : + ℤ), (↑P.q : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : GaussianInt))).cells) + → (Disjoint Rplus.cells T.cells))) ) := by + classical + intro P T u hc Rplus ford_disjoint_re hRp + rw [hRp, hc] + apply ford_disjoint_re + simp [Zsqrtd.re_add] + +private theorem hdisET'At847 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), ∀ (Rplus : + ProtoTile), (∀ (n : Nat), ∀ (m : Nat), ∀ (w : GaussianInt), ∀ (v : GaussianInt), + (w.im + n ≤ v.im) → (Disjoint (TileTranslation (FordTile n) w).cells (TileTranslation + (FordTile m) v).cells)) → ((T'.cells = (TileTranslation (FordTile P.q) (u + if (1 : + Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else + (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) → ((Rplus.cells = + (TileTranslation (FordTile (if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then P.q₁ else + P.q₂)) (u + if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (⟨(↑P.q₂ : ℤ), (↑P.q : ℤ)⟩ + : GaussianInt) else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : GaussianInt))).cells) → (Disjoint + Rplus.cells T'.cells))) ) := by + classical + intro P T' u Rplus ford_disjoint_im hc' hRp + rw [hRp, hc'] + apply ford_disjoint_im + simp [Zsqrtd.im_add] + +private theorem he_ne_aAt851 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (U : ProtoTile), ∀ (a : ↥(TilingLattice + Ci)), (PP.tile a = U) → ((U.cells ⊆ T.cells) → (∀ (cf : LatticeCell), (cf ∈ U.cells) + → (∀ (e : ↥(TilingLattice Ci)), (PP.tile e = Rplus) → ((Disjoint Rplus.cells T.cells) + → (e ≠ a))))) ) := by + classical + intro Ci T Rplus PP U a hUa U_in_T cf hcf e he hdisET heq + have hcfA : cf ∈ (PP.tile a).cells := by simpa [hUa] using hcf + have hcfE : cf ∈ Rplus.cells := by + rw [← he] + simpa [heq] using hcfA + exact (Finset.disjoint_left.mp hdisET) hcfE (U_in_T hcf) + +private theorem he_ne_bAt858 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T' : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (V : ProtoTile), ∀ (b : ↥(TilingLattice + Ci)), (PP.tile b = V) → ((V.cells ⊆ T'.cells) → (∀ (cb : LatticeCell), (cb ∈ V.cells) + → (∀ (e : ↥(TilingLattice Ci)), (PP.tile e = Rplus) → ((Disjoint Rplus.cells + T'.cells) → (e ≠ b))))) ) := by + classical + intro Ci T' Rplus PP V b hVb V_in_T' cb hcb e he hdisET' heq + have hcbB : cb ∈ (PP.tile b).cells := by simpa [hVb] using hcb + have hcbE : cb ∈ Rplus.cells := by + rw [← he] + simpa [heq] using hcbB + exact (Finset.disjoint_left.mp hdisET') hcbE (V_in_T' hcb) + +private theorem ht_ne_eAt866 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), + let m : GaussianInt := x - ⟨0,1⟩ + (m ∈ T.cells) → (∀ (e : ↥(TilingLattice Ci)), (PP.tile e = Rplus) → ((Disjoint + Rplus.cells T.cells) → (∀ (t : ↥(TilingLattice Ci)), (m ∈ (PP.tile t).cells) → (t ≠ + e)))) ) := by + classical + intro Ci T Rplus PP x m hmT e he hdisET t ht hte + have hmt : m ∈ (PP.tile e).cells := by simpa [hte] using ht + have hmE : m ∈ Rplus.cells := by simpa [he] using hmt + exact (Finset.disjoint_left.mp hdisET) hmE hmT + +private theorem ht_ne_bAt871 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), (Disjoint T.cells T'.cells) → + (∀ (PP : PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (V : + ProtoTile), ∀ (b : ↥(TilingLattice Ci)), (PP.tile b = V) → ((V.cells ⊆ T'.cells) → ( + let m : GaussianInt := x - ⟨0,1⟩ + (m ∈ T.cells) → (∀ (t : ↥(TilingLattice Ci)), (m ∈ (PP.tile t).cells) → (t ≠ b))))) ) := by + classical + intro Ci T T' hdis PP x V b hVb V_in_T' m hmT t ht htb + have hmb : m ∈ (PP.tile b).cells := by simpa [htb] using ht + have hmV : m ∈ V.cells := by simpa [hVb] using hmb + exact (Finset.disjoint_left.mp hdis) hmT (V_in_T' hmV) + +private theorem hxaAt876 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (u : GaussianInt), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (U : ProtoTile), ∀ + (a : ↥(TilingLattice Ci)), (PP.tile a = U) → (∀ (cf : LatticeCell), (cf ∈ U.cells) → ( + let z : GaussianInt := + if (x - u).im = (if (1 : Fin 3) = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + (((x - u).im = if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : + ℤ)) → z = x) → ((if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then cf = z - (1 : + LatticeCell) else cf = z) → (((x - u).im = if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) + then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) → (x ∈ (PP.tile a).cells))))) ) := by + classical + intro P Ci u PP x U a hUa cf hcf z z_low hcfSide hlow + have hside : cf = x := by simpa [z_low hlow] using hcfSide + have hcf' : cf ∈ (PP.tile a).cells := by simpa [hUa] using hcf + simpa [hside] using hcf' + +private theorem hxbAt880 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (u : GaussianInt), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (V : ProtoTile), ∀ + (b : ↥(TilingLattice Ci)), (PP.tile b = V) → (∀ (cb : LatticeCell), (cb ∈ V.cells) → ( + let z : GaussianInt := + if (x - u).im = (if (1 : Fin 3) = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + (((x - u).im = if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : + ℤ)) → z = x) → ((if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then cb = z else cb = z - + (1 : LatticeCell)) → (((x - u).im = if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then + (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) → (x - 1 ∈ (PP.tile b).cells))))) ) := by + classical + intro P Ci u PP x V b hVb cb hcb z z_low hcbSide hlow + have hside : cb = x - 1 := by simpa [z_low hlow] using hcbSide + have hcb' : cb ∈ (PP.tile b).cells := by simpa [hVb] using hcb + simpa [hside] using hcb' + +private theorem hrepeatAt886 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (a : ↥(TilingLattice Ci)), ∀ (b : ↥(TilingLattice Ci)), (a ≠ b) → + (∀ (e : ↥(TilingLattice Ci)), (e ≠ a) → ((e ≠ b) → (∀ (t : ↥(TilingLattice Ci)), (t ≠ + e) → ((t ≠ b) → ((a = b ∨ a = e ∨ a = t ∨ b = e ∨ b = t ∨ e = t) → (a = t)))))) ) := by + classical + intro Ci a b hab e he_ne_a he_ne_b t ht_ne_e ht_ne_b hfour + rcases hfour with h01 | h02 | h03 | h12 | h13 | h23 + · exact False.elim (hab h01) + · exact False.elim (he_ne_a h02.symm) + · exact h03 + · exact False.elim (he_ne_b h12.symm) + · exact False.elim (ht_ne_b h13.symm) + · exact False.elim (ht_ne_e h23.symm) + +private theorem hxAt909 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (u : GaussianInt), ∀ (x : GaussianInt), (x.re = u.re + P.q) + → ((x.im = u.im + P.q) → (x = u + ⟨(P.q : Int), (P.q : Int)⟩)) ) := by + classical + intro P u x hxre'' hxim'' + ext + · simp only [Zsqrtd.re_add] + omega + · simp only [Zsqrtd.im_add] + omega + +private theorem hncAt920 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (u : GaussianInt), ∀ (x : GaussianInt), (x.re = u.re + P.q) + → ((x.im = u.im + P.q) → ((((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1) → (((P.q₁ : + Int) + P.q₂ = P.q) → ( + let n : GaussianInt := x - 1 + n = (u + ⟨(P.q₂ : Int), (P.q : Int)⟩) + ⟨((P.q₁ - 1 : Nat) : Int), 0⟩)))) ) := by + classical + intro P u x hxre'' hxim'' hq1cast hqsum n + dsimp only [n] + apply Zsqrtd.ext_iff.mpr + constructor + · simp only [Zsqrtd.re_sub, Zsqrtd.re_add, Zsqrtd.re_one] + rw [hxre'', hq1cast] + rw [← hqsum] + ring + · simp only [Zsqrtd.im_sub, Zsqrtd.im_add, Zsqrtd.im_one, + ] + rw [hxim''] + ring + +private theorem hdisETAt940 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), (T.cells = + (TileTranslation (FordTile P.q) u).cells) → (∀ (Rplus : ProtoTile), (∀ (n : Nat), ∀ + (m : Nat), ∀ (w : GaussianInt), ∀ (v : GaussianInt), (w.im + n ≤ v.im) → (Disjoint + (TileTranslation (FordTile n) w).cells (TileTranslation (FordTile m) v).cells)) → + ((Rplus.cells = (TileTranslation (FordTile (if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) + then P.q₁ else P.q₂)) (u + if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (⟨(↑P.q₂ : + ℤ), (↑P.q : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : GaussianInt))).cells) + → (Disjoint T.cells Rplus.cells))) ) := by + classical + intro P T u hc Rplus ford_disjoint_im hRp + rw [hc, hRp] + apply ford_disjoint_im + simp [Zsqrtd.im_add] + +private theorem hdisET'At944 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (T' : ProtoTile), ∀ (u : GaussianInt), ∀ + (Rplus : ProtoTile), (GaussianInt) → ((∀ (n : Nat), ∀ (m : Nat), ∀ (w : GaussianInt), + ∀ (v : GaussianInt), (w.re + n ≤ v.re) → (Disjoint (TileTranslation (FordTile n) + w).cells (TileTranslation (FordTile m) v).cells)) → ((T'.cells = (TileTranslation + (FordTile P.q) (u + if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), + (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) + → ((Rplus.cells = (TileTranslation (FordTile (if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : + ℕ)) then P.q₁ else P.q₂)) (u + if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (⟨(↑P.q₂ + : ℤ), (↑P.q : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : + GaussianInt))).cells) → (((P.q₁ : Int) + P.q₂ = P.q) → (Disjoint Rplus.cells + T'.cells)))))) ) := by + classical + intro P Ci T' u Rplus x ford_disjoint_re hc' hRp hqsum + have hgap : + (u + ⟨(P.q₂ : Int), (P.q : Int)⟩).re + P.q₁ ≤ + (u + ⟨(P.q : Int), (P.q₁ : Int)⟩).re := by + simp only [Zsqrtd.re_add] + rw [← hqsum] + omega + have hford := ford_disjoint_re P.q₁ P.q + (u + ⟨(P.q₂ : Int), (P.q : Int)⟩) + (u + ⟨(P.q : Int), (P.q₁ : Int)⟩) hgap + simpa [hRp, hc'] using hford + +private theorem hq2lt : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (((0 : ℕ) < P.q₁) → ((GaussianInt) → + ((GaussianInt) → ((((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1) → (P.q₂ < P.q))))) ) + := by + classical + intro P Ci hrpos u x hq1cast + rw [P.sum_q] + omega + +private theorem hxroot : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (u : GaussianInt), ∀ (x : GaussianInt), (x = u + ⟨(P.q : + Int), (P.q : Int)⟩) → (((P.q₁ : Int) + P.q₂ = P.q) → (x = (u + ⟨(P.q : Int), (P.q₁ : + Int)⟩) + ⟨0, (P.q₂ : Int)⟩)) ) := by + classical + intro P u x hx hqsum + rw [hx] + apply Zsqrtd.ext_iff.mpr + constructor + · simp [Zsqrtd.re_add] + · simp? [Zsqrtd.im_add] + rw [← hqsum] + ring + +private theorem hxT' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), ∀ (x : GaussianInt), + (T'.cells = (TileTranslation (FordTile P.q) (u + if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : + ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : + GaussianInt))).cells) → ((x = (u + ⟨(P.q : Int), (P.q₁ : Int)⟩) + ⟨0, (P.q₂ : Int)⟩) + → ((u + (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) + (⟨(↑(0 : ℕ) : ℤ), (↑P.q₂ : ℤ)⟩ : + GaussianInt) ∈ (TileTranslation (FordTile P.q) (u + (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : + GaussianInt))).cells) → (x ∈ T'.cells))) ) := by + classical + intro P T' u x hc' hxroot hrootCell + rw [hc'] + simp only [] + simpa [GaussianTranslation, add_comm, hxroot] using hrootCell + +private theorem ht_ne_eAt974 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T' : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (e : ↥(TilingLattice + Ci)), (PP.tile e = Rplus) → ((Disjoint Rplus.cells T'.cells) → ((x ∈ T'.cells) → (∀ + (t : ↥(TilingLattice Ci)), (x ∈ (PP.tile t).cells) → (t ≠ e)))) ) := by + classical + intro Ci T' Rplus PP x e he hdisET' hxT' t ht hte + have hmt : x ∈ (PP.tile e).cells := by simpa [hte] using ht + have hxE : x ∈ Rplus.cells := by simpa [he] using hmt + exact (Finset.disjoint_left.mp hdisET') hxE hxT' + +private theorem ht_ne_aAt979 : + (by + classical + exact + ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : + PartialOdometer), (Disjoint T.cells T'.cells) → (∀ (tiles : List ProtoTile), ∀ (hs : + List PartialOdometer), (∀ (U : ProtoTile), ∀ (g : PartialOdometer), (U, g) ∈ + tiles.zip hs → AncestorOdometer Ci.1.1 C0.1.1 U T g h → U.cells ⊆ T.cells) → (∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (g : + PartialOdometer), ∀ (a : ↥(TilingLattice Ci)), ((PP.tile a, g) ∈ tiles.zip hs) → + ((AncestorOdometer Ci.1.1 C0.1.1 (PP.tile a) T g h) → ((x ∈ T'.cells) → (∀ (t : + ↥(TilingLattice Ci)), (x ∈ (PP.tile t).cells) → (t ≠ a)))))) ) := by + classical + intro C0 Ci T T' h hdis tiles hs hcontain PP x g a hAzip hAanc hxT' t ht hta + have hma : x ∈ (PP.tile a).cells := by simpa [hta] using ht + exact (Finset.disjoint_left.mp hdis) + (hcontain (PP.tile a) g hAzip hAanc hma) hxT' + +private theorem he_ne_aAt984 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (U : ProtoTile), ∀ + (a : ↥(TilingLattice Ci)), (PP.tile a = U) → ((U.cells ⊆ T.cells) → (∀ (cf : + LatticeCell), (cf ∈ U.cells) → ( + let n : GaussianInt := x - 1 + ∀ (e : ↥(TilingLattice Ci)), (PP.tile e = Rplus) → ((n ∈ Rplus.cells) → ((n ∈ (PP.tile + e).cells) → ((Disjoint T.cells Rplus.cells) → (e ≠ a))))))) ) := by + classical + intro Ci T Rplus PP x U a hUa U_in_T cf hcf n e he hEcell hEidx hdisET heq + have hcfA : cf ∈ (PP.tile a).cells := by simpa [hUa] using hcf + have hcfE : cf ∈ Rplus.cells := by + rw [← he] + simpa [heq] using hcfA + have hnA : n ∈ (PP.tile a).cells := by simpa [heq] using hEidx + have hnU : n ∈ U.cells := by simpa [hUa] using hnA + exact (Finset.disjoint_left.mp hdisET) (U_in_T hnU) hEcell + +private theorem he_ne_bAt993 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T' : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (V : ProtoTile), ∀ + (b : ↥(TilingLattice Ci)), (PP.tile b = V) → ((V.cells ⊆ T'.cells) → (∀ (cb : + LatticeCell), (cb ∈ V.cells) → ( + let n : GaussianInt := x - 1 + ∀ (e : ↥(TilingLattice Ci)), (PP.tile e = Rplus) → ((n ∈ Rplus.cells) → ((n ∈ (PP.tile + e).cells) → ((Disjoint Rplus.cells T'.cells) → (e ≠ b))))))) ) := by + classical + intro Ci T' Rplus PP x V b hVb V_in_T' cb hcb n e he hEcell hEidx hdisET' heq + have hcbB : cb ∈ (PP.tile b).cells := by simpa [hVb] using hcb + have hcbE : cb ∈ Rplus.cells := by + rw [← he] + simpa [heq] using hcbB + have hnB : n ∈ (PP.tile b).cells := by simpa [heq] using hEidx + have hnV : n ∈ V.cells := by simpa [hVb] using hnB + exact (Finset.disjoint_left.mp hdisET') hEcell (V_in_T' hnV) + +private theorem hxaAt1002 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (u : GaussianInt), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (U : ProtoTile), ∀ + (a : ↥(TilingLattice Ci)), (PP.tile a = U) → (∀ (cf : LatticeCell), (cf ∈ U.cells) → ( + let z : GaussianInt := + if (x - u).im = (if (0 : Fin 3) = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + ((¬(x - u).im = if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : + ℤ)) → z = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → ((if (0 : Fin (3 : ℕ)) = (0 : Fin + (3 : ℕ)) then cf = z - (1 : LatticeCell) else cf = z) → ((¬(x - u).im = if (0 : Fin + (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) → (x - 1 - ⟨0,1⟩ ∈ + (PP.tile a).cells))))) ) := by + classical + intro P Ci u PP x U a hUa cf hcf z z_other hcfSide hlow + have hside : cf = z - 1 := by simpa using hcfSide + have hside' : cf = x - 1 - ⟨0,1⟩ := by + rw [hside, z_other (by omega)] + abel + have hcf' : cf ∈ (PP.tile a).cells := by simpa [hUa] using hcf + simpa [hside'] using hcf' + +private theorem hxbAt1009 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (u : GaussianInt), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (V : ProtoTile), ∀ + (b : ↥(TilingLattice Ci)), (PP.tile b = V) → (∀ (cb : LatticeCell), (cb ∈ V.cells) → ( + let z : GaussianInt := + if (x - u).im = (if (0 : Fin 3) = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + ((¬(x - u).im = if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : + ℤ)) → z = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → ((if (0 : Fin (3 : ℕ)) = (0 : Fin + (3 : ℕ)) then cb = z else cb = z - (1 : LatticeCell)) → ((¬(x - u).im = if (0 : Fin + (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) → (x - ⟨0,1⟩ ∈ + (PP.tile b).cells))))) ) := by + classical + intro P Ci u PP x V b hVb cb hcb z z_other hcbSide hlow + have hside : cb = z := by simpa using hcbSide + have hside' : cb = x - ⟨0,1⟩ := by rw [hside, z_other (by omega)] + have hcb' : cb ∈ (PP.tile b).cells := by simpa [hVb] using hcb + simpa [hside'] using hcb' + +private theorem hrepeatAt1016 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (a : ↥(TilingLattice Ci)), ∀ (b : ↥(TilingLattice Ci)), (a ≠ b) → + (∀ (e : ↥(TilingLattice Ci)), ∀ (t : ↥(TilingLattice Ci)), (t ≠ e) → ((t ≠ a) → ((e ≠ + a) → ((e ≠ b) → ((t = e ∨ t = a ∨ t = b ∨ e = a ∨ e = b ∨ a = b) → (b = t)))))) ) := by + classical + intro Ci a b hab e t ht_ne_e ht_ne_a he_ne_a he_ne_b hfour + rcases hfour with h01 | h02 | h03 | h12 | h13 | h23 + · exact False.elim (ht_ne_e h01) + · exact False.elim (ht_ne_a h02) + · exact h03.symm + · exact False.elim (he_ne_a h12) + · exact False.elim (he_ne_b h13) + · exact False.elim (hab h23) + +private theorem hxAt1035 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), + (x.re - u.re = 0) → ((x.im = u.im + P.q) → (x = u + ⟨0, (P.q : Int)⟩))) ) := by + classical + intro P Ci u x hxre' hxim'' + ext + · simp only [Zsqrtd.re_add] + omega + · simp only [Zsqrtd.im_add] + omega + +private theorem hq1castAt1045 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (((0 : ℕ) < P.q₁) → (∀ (u : GaussianInt), ∀ (x + : GaussianInt), ((x - u).im = (↑P.q : ℤ)) → ((x.im - u.im = P.q) → (((P.q₁ : Int) + + P.q₂ = P.q) → ((((P.q - 1 : Nat) : Int) = (P.q : Int) - 1) → (((P.q₁ - 1 : Nat) : + Int) = (P.q₁ : Int) - 1)))))) ) := by + classical + intro P Ci hrpos u x htop hxim' hqsum hqcast + exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q₁) + +private theorem hmcAt1049 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), + (x.re = u.re) → ((x.im = u.im + P.q) → (((P.q₁ : Int) + P.q₂ = P.q) → ((((P.q - 1 : + Nat) : Int) = (P.q : Int) - 1) → ( + let m : GaussianInt := x - 1 + m = (u + ⟨-(P.q : Int), (P.q₂ : Int)⟩) + ⟨((P.q - 1 : Nat) : Int), (P.q₁ : Int)⟩))))) ) + := by + classical + intro P Ci u x hxre'' hxim'' hqsum hqcast m + ext + · simp only [m, Zsqrtd.re_sub, Zsqrtd.re_one, + Zsqrtd.re_add] + rw [hxre''] + rw [hqcast] + omega + · simp only [m, Zsqrtd.im_sub, Zsqrtd.im_one, + Zsqrtd.im_add] + rw [hxim''] + rw [← hqsum] + ring + +private theorem hRm1 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (u : GaussianInt), ∀ (Rminus : ProtoTile), (Rminus.cells = + (TileTranslation (FordTile (if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then P.q₁ else + P.q₂)) (u + if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (0 : ℤ)⟩ : + GaussianInt) else (⟨(0 : ℤ), (↑P.q : ℤ)⟩ : GaussianInt))).cells) → (Rminus.cells = + (TileTranslation (FordTile P.q₂) (u + ⟨0, (P.q : Int)⟩)).cells) ) := by + classical + intro P u Rminus hRm + simpa using hRm + +private theorem hc'1 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (T'.cells = + (TileTranslation (FordTile P.q) (u + if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then + (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : + GaussianInt))).cells) → (T'.cells = (TileTranslation (FordTile P.q) (u + ⟨-(P.q : + Int), (P.q₂ : Int)⟩)).cells) ) := by + classical + intro P T' u hc' + simpa using hc' + +private theorem hEcellAt1075 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (u : GaussianInt), ∀ (Rminus : ProtoTile), ∀ (x : + GaussianInt), (x = u + ⟨0, (P.q : Int)⟩) → ((Rminus.cells = (TileTranslation + (FordTile P.q₂) (u + ⟨0, (P.q : Int)⟩)).cells) → ((u + (⟨(0 : ℤ), (↑P.q : ℤ)⟩ : + GaussianInt) + (⟨(↑(0 : ℕ) : ℤ), (↑(0 : ℕ) : ℤ)⟩ : GaussianInt) ∈ (TileTranslation + (FordTile P.q₂) (u + (⟨(0 : ℤ), (↑P.q : ℤ)⟩ : GaussianInt))).cells) → (x ∈ + Rminus.cells))) ) := by + classical + intro P u Rminus x hx hRm1 hEtrans + rw [hRm1, hx] + convert hEtrans using 1; abel + +private theorem hdisETAt1079 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), (T.cells = + (TileTranslation (FordTile P.q) u).cells) → (∀ (Rminus : ProtoTile), (∀ (n : Nat), ∀ + (m : Nat), ∀ (w : GaussianInt), ∀ (v : GaussianInt), (w.im + n ≤ v.im) → (Disjoint + (TileTranslation (FordTile n) w).cells (TileTranslation (FordTile m) v).cells)) → + ((Rminus.cells = (TileTranslation (FordTile P.q₂) (u + ⟨0, (P.q : Int)⟩)).cells) → + (Disjoint Rminus.cells T.cells))) ) := by + classical + intro P T u hc Rminus ford_disjoint_im hRm1 + have htmp : Disjoint T.cells Rminus.cells := by + rw [hc, hRm1] + apply ford_disjoint_im + simp [Zsqrtd.im_add] + simpa [hRm1, hc] using htmp.symm + +private theorem hdisET'At1085 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (T' : ProtoTile), ∀ (u : GaussianInt), ∀ + (Rminus : ProtoTile), (GaussianInt) → ((∀ (n : Nat), ∀ (m : Nat), ∀ (w : + GaussianInt), ∀ (v : GaussianInt), (w.re + n ≤ v.re) → (Disjoint (TileTranslation + (FordTile n) w).cells (TileTranslation (FordTile m) v).cells)) → ((Rminus.cells = + (TileTranslation (FordTile P.q₂) (u + ⟨0, (P.q : Int)⟩)).cells) → ((T'.cells = + (TileTranslation (FordTile P.q) (u + ⟨-(P.q : Int), (P.q₂ : Int)⟩)).cells) → + (Disjoint Rminus.cells T'.cells))))) ) := by + classical + intro P Ci T' u Rminus x ford_disjoint_re hRm1 hc'1 + have hgap : + (u + ⟨-(P.q : Int), (P.q₂ : Int)⟩).re + P.q ≤ + (u + ⟨0, (P.q : Int)⟩).re := by + simp only [Zsqrtd.re_add] + omega + have htmp := ford_disjoint_re P.q P.q₂ + (u + ⟨-(P.q : Int), (P.q₂ : Int)⟩) + (u + ⟨0, (P.q : Int)⟩) hgap + simpa [hRm1, hc'1] using htmp.symm + +private theorem hmT' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), ∀ (x : GaussianInt), + let m : GaussianInt := x - 1 + (m = (u + ⟨-(P.q : Int), (P.q₂ : Int)⟩) + ⟨((P.q - 1 : Nat) : Int), (P.q₁ : Int)⟩) → + ((T'.cells = (TileTranslation (FordTile P.q) (u + ⟨-(P.q : Int), (P.q₂ : + Int)⟩)).cells) → ((u + (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt) + (⟨(↑(P.q - (1 : + ℕ)) : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) ∈ (TileTranslation (FordTile P.q) (u + (⟨-(↑P.q + : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) → (m ∈ T'.cells))) ) := by + classical + intro P T' u x m hmc hc'1 httrans + rw [hc'1] + rw [hmc] + exact httrans + +private theorem ht_ne_eAt1103 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T' : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), + let m : GaussianInt := x - 1 + ∀ (e : ↥(TilingLattice Ci)), (PP.tile e = Rminus) → ((Disjoint Rminus.cells T'.cells) → + ((m ∈ T'.cells) → (∀ (t : ↥(TilingLattice Ci)), (m ∈ (PP.tile t).cells) → (t ≠ e)))) + ) := by + classical + intro Ci T' Rminus PP x m e he hdisET' hmT' t ht hte + have hmt : m ∈ (PP.tile e).cells := by simpa [hte] using ht + have hmE : m ∈ Rminus.cells := by simpa [he] using hmt + exact (Finset.disjoint_left.mp hdisET') hmE hmT' + +private theorem ht_ne_aAt1108 : + (by + classical + exact + ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : + PartialOdometer), (Disjoint T.cells T'.cells) → (∀ (tiles : List ProtoTile), ∀ (hs : + List PartialOdometer), (∀ (U : ProtoTile), ∀ (g : PartialOdometer), (U, g) ∈ + tiles.zip hs → AncestorOdometer Ci.1.1 C0.1.1 U T g h → U.cells ⊆ T.cells) → (∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (g : + PartialOdometer), ∀ (a : ↥(TilingLattice Ci)), ((PP.tile a, g) ∈ tiles.zip hs) → + ((AncestorOdometer Ci.1.1 C0.1.1 (PP.tile a) T g h) → ( + let m : GaussianInt := x - 1 + (m ∈ T'.cells) → (∀ (t : ↥(TilingLattice Ci)), (m ∈ (PP.tile t).cells) → (t ≠ a)))))) ) + := by + classical + intro C0 Ci T T' h hdis tiles hs hcontain PP x g a hAzip hAanc m hmT' t ht hta + have hma : m ∈ (PP.tile a).cells := by simpa [hta] using ht + exact (Finset.disjoint_left.mp hdis) + (hcontain (PP.tile a) g hAzip hAanc hma) hmT' + +private theorem he_ne_aAt1113 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (T : ProtoTile), + ∀ (h : PartialOdometer), ∀ (u : GaussianInt), ∀ (Rminus : ProtoTile), ∀ (tiles : List + ProtoTile), ∀ (hs : List PartialOdometer), (∀ (U : ProtoTile), ∀ (g : + PartialOdometer), (U, g) ∈ tiles.zip hs → AncestorOdometer Ci.1.1 C0.1.1 U T g h → + U.cells ⊆ T.cells) → (∀ (PP : PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : + GaussianInt), ∀ (U : ProtoTile), ∀ (g : PartialOdometer), ∀ (a : ↥(TilingLattice + Ci)), (PP.tile a = U) → (∀ (cf : LatticeCell), (cf ∈ U.cells) → (((PP.tile a, g) ∈ + tiles.zip hs) → ((AncestorOdometer Ci.1.1 C0.1.1 (PP.tile a) T g h) → ( + let z : GaussianInt := + if (x - u).im = (if (1 : Fin 3) = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + ((¬(x - u).im = if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : + ℤ)) → z = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → ((if (1 : Fin (3 : ℕ)) = (0 : Fin + (3 : ℕ)) then cf = z - (1 : LatticeCell) else cf = z) → ((¬(x - u).im = if (1 : Fin + (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) → (∀ (e : + ↥(TilingLattice Ci)), (PP.tile e = Rminus) → ((Disjoint Rminus.cells T.cells) → (e ≠ + a)))))))))) ) := by + classical + intro P C0 Ci T h u Rminus tiles hs hcontain PP x U g a hUa cf hcf hAzip hAanc z z_other + hcfSide hlow e he hdisET heq + have hxa' : x - ⟨0,1⟩ ∈ (PP.tile a).cells := by + have hside : cf = z := by simpa using hcfSide + have hcf' : cf ∈ (PP.tile a).cells := by simpa [hUa] using hcf + simpa [hside, z_other (by omega)] using hcf' + have hxaT : x - ⟨0,1⟩ ∈ T.cells := + hcontain (PP.tile a) g hAzip hAanc hxa' + have hxaE : x - ⟨0,1⟩ ∈ Rminus.cells := by + rw [← he] + simpa [heq] using hxa' + exact (Finset.disjoint_left.mp hdisET) hxaE hxaT + +private theorem he_ne_bAt1125 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (T' : ProtoTile), + ∀ (h' : PartialOdometer), ∀ (u : GaussianInt), ∀ (Rminus : ProtoTile), ∀ + (reverseTiles : List ProtoTile), ∀ (reverseHs : List PartialOdometer), (∀ (V : + ProtoTile), ∀ (k : PartialOdometer), (V, k) ∈ reverseTiles.zip reverseHs → + AncestorOdometer Ci.1.1 C0.1.1 V T' k h' → V.cells ⊆ T'.cells) → (∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (V : ProtoTile), ∀ + (k : PartialOdometer), ∀ (b : ↥(TilingLattice Ci)), (PP.tile b = V) → (∀ (cb : + LatticeCell), (cb ∈ V.cells) → (((PP.tile b, k) ∈ reverseTiles.zip reverseHs) → + ((AncestorOdometer Ci.1.1 C0.1.1 (PP.tile b) T' k h') → ( + let z : GaussianInt := + if (x - u).im = (if (1 : Fin 3) = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + ((¬(x - u).im = if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : + ℤ)) → z = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → ((if (1 : Fin (3 : ℕ)) = (0 : Fin + (3 : ℕ)) then cb = z else cb = z - (1 : LatticeCell)) → ((¬(x - u).im = if (1 : Fin + (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) → (∀ (e : + ↥(TilingLattice Ci)), (PP.tile e = Rminus) → ((Disjoint Rminus.cells T'.cells) → (e ≠ + b)))))))))) ) := by + classical + intro P C0 Ci T' h' u Rminus reverseTiles reverseHs hcontain' PP x V k b hVb cb hcb hBzip hBanc + z z_other hcbSide hlow e he hdisET' heq + have hxb' : x - 1 - ⟨0,1⟩ ∈ (PP.tile b).cells := by + have hside : cb = z - 1 := by simpa using hcbSide + have hcb' : cb ∈ (PP.tile b).cells := by simpa [hVb] using hcb + have hsub : x - ⟨0,1⟩ - 1 = x - 1 - ⟨0,1⟩ := by abel + simpa [hside, z_other (by omega), hsub] using hcb' + have hxbT' : x - 1 - ⟨0,1⟩ ∈ T'.cells := + hcontain' (PP.tile b) k hBzip hBanc hxb' + have hxbE : x - 1 - ⟨0,1⟩ ∈ Rminus.cells := by + rw [← he] + simpa [heq] using hxb' + exact (Finset.disjoint_left.mp hdisET') hxbE hxbT' + +private theorem hxaAt1138 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (u : GaussianInt), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (U : ProtoTile), ∀ + (a : ↥(TilingLattice Ci)), (PP.tile a = U) → (∀ (cf : LatticeCell), (cf ∈ U.cells) → ( + let z : GaussianInt := + if (x - u).im = (if (1 : Fin 3) = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + ((¬(x - u).im = if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : + ℤ)) → z = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → ((if (1 : Fin (3 : ℕ)) = (0 : Fin + (3 : ℕ)) then cf = z - (1 : LatticeCell) else cf = z) → ((¬(x - u).im = if (1 : Fin + (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) → (x - ⟨0,1⟩ ∈ + (PP.tile a).cells))))) ) := by + classical + intro P Ci u PP x U a hUa cf hcf z z_other hcfSide hlow + have hside : cf = z := by simpa using hcfSide + have hcf' : cf ∈ (PP.tile a).cells := by simpa [hUa] using hcf + simpa [hside, z_other (by omega)] using hcf' + +private theorem hxbAt1142 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (u : GaussianInt), ∀ (PP : + PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ∀ (V : ProtoTile), ∀ + (b : ↥(TilingLattice Ci)), (PP.tile b = V) → (∀ (cb : LatticeCell), (cb ∈ V.cells) → ( + let z : GaussianInt := + if (x - u).im = (if (1 : Fin 3) = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + ((¬(x - u).im = if (1 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : + ℤ)) → z = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → ((if (1 : Fin (3 : ℕ)) = (0 : Fin + (3 : ℕ)) then cb = z else cb = z - (1 : LatticeCell)) → ((¬(x - u).im = if (1 : Fin + (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) → (x - 1 - ⟨0,1⟩ ∈ + (PP.tile b).cells))))) ) := by + classical + intro P Ci u PP x V b hVb cb hcb z z_other hcbSide hlow + have hside : cb = z - 1 := by simpa using hcbSide + have hcb' : cb ∈ (PP.tile b).cells := by simpa [hVb] using hcb + have hsub : x - ⟨0,1⟩ - 1 = x - 1 - ⟨0,1⟩ := by abel + simpa [hside, z_other (by omega), hsub] using hcb' + +private theorem hrepeatAt1149 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (a : ↥(TilingLattice Ci)), ∀ (b : ↥(TilingLattice Ci)), (a ≠ b) → + (∀ (e : ↥(TilingLattice Ci)), ∀ (t : ↥(TilingLattice Ci)), (t ≠ e) → ((t ≠ a) → ((e ≠ + a) → ((e ≠ b) → ((e = t ∨ e = b ∨ e = a ∨ t = b ∨ t = a ∨ b = a) → (b = t)))))) ) := by + classical + intro Ci a b hab e t ht_ne_e ht_ne_a he_ne_a he_ne_b hfour + rcases hfour with h01 | h02 | h03 | h12 | h13 | h23 + · exact False.elim (ht_ne_e h01.symm) + · exact False.elim (he_ne_b h02) + · exact False.elim (he_ne_a h03) + · exact h12.symm + · exact False.elim (ht_ne_a h13) + · exact False.elim (hab h23.symm) + +end EdgeSectorGeometry + +namespace EdgeSectorBoundary + +private theorem lowerBoundary : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (i : Fin (3 : + ℕ)), (i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → + (((0 : ℕ) < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), + ∀ (h' : PartialOdometer), ∀ (u : GaussianInt), (T.cells = (TileTranslation (FordTile + P.q) u).cells) → ((T'.cells = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 + : ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ + : GaussianInt))).cells) → ((Disjoint T.cells T'.cells) → (∀ (orientation : Bool), ∀ + (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ (hs : List PartialOdometer), ∀ + (reverseHs : List PartialOdometer), (TileString Ci orientation base Rminus Rplus + tiles) → ((TileString Ci orientation base Rplus Rminus reverseTiles) → ((Rminus.cells + = (TileTranslation (FordTile (if i = (0 : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if + i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (0 : ℤ)⟩ : GaussianInt) else (⟨(0 : ℤ), + (↑P.q : ℤ)⟩ : GaussianInt))).cells) → ((Rplus.cells = (TileTranslation (FordTile (if + i = (0 : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i = (0 : Fin (3 : ℕ)) then + (⟨(↑P.q₂ : ℤ), (↑P.q : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : + GaussianInt))).cells) → ((∀ (z : GaussianInt), ((z - u).re = if i = (0 : Fin (3 : ℕ)) + then (↑P.q : ℤ) else (0 : ℤ)) → (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else + (↑P.q₂ : ℤ)) ≤ (z - u).im → (z - u).im < (↑P.q : ℤ) → ∃ (U : ProtoTile) (V : + ProtoTile) (g : PartialOdometer) (k : PartialOdometer), U ∈ (List.drop (1 : ℕ) + tiles).dropLast ∧ V ∈ (List.drop (1 : ℕ) reverseTiles).dropLast ∧ (U, g) ∈ tiles.zip + hs ∧ (V, k) ∈ reverseTiles.zip reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 U T g h ∧ + AncestorOdometer Ci.1.1 C0.1.1 V T' k h' ∧ {z, z + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U ∧ {z, z + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (PP : PeriodicTileComplex + ↥(TilingLattice Ci)), ∀ (tileAt : ℤ × ℤ → ProtoTile), (AffineTriangularComplexChart + PP tileAt) → (∀ (x : GaussianInt), ((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q + : ℤ) else (0 : ℤ)) → (((if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ + (x - u).im) → ((∀ U ∈ RegularTileFamily base (TilingLattice Ci), ∃ (a : + ↥(TilingLattice Ci)), PP.tile a = U) → ((∀ (n : ℕ), ∀ (a : ℕ), ∀ (b : ℕ), ∀ (w : + GaussianInt), a < n → b < n → w + (⟨(↑a : ℤ), (↑b : ℤ)⟩ : GaussianInt) ∈ + (TileTranslation (FordTile n) w).cells) → ((∀ (n : ℕ), ∀ (m : ℕ), ∀ (w : + GaussianInt), ∀ (v : GaussianInt), w.re + (↑n : ℤ) ≤ v.re → Disjoint (TileTranslation + (FordTile n) w).cells (TileTranslation (FordTile m) v).cells) → ((∀ (n : ℕ), ∀ (m : + ℕ), ∀ (w : GaussianInt), ∀ (v : GaussianInt), w.im + (↑n : ℤ) ≤ v.im → Disjoint + (TileTranslation (FordTile n) w).cells (TileTranslation (FordTile m) v).cells) → (((0 + : ℕ) < P.q₁) → (((if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) < (↑P.q + : ℤ)) → ( + let z : GaussianInt := + if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + (((x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x)) → (( + let z := if (x - u).im = if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ) then + x else x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); (¬(x - u).im = if i = (0 : Fin (3 : + ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) → z = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) + → (((if (x - u).im = if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ) then + x else x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) = x ∨ (if (x - u).im = if i = (0 : Fin + (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ) then x else x - (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → ((((if (x - u).im = if i = + (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ) then x else x - (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt)) - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) + → (((if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ ((if (x - u).im = + if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ) then x else x - (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)) - u).im) → ((((if (x - u).im = if i = (0 : Fin (3 : ℕ)) then + (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ) then x else x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - + u).im < (↑P.q : ℤ)) → (∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (g : PartialOdometer), + ∀ (k : PartialOdometer), ({z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ + FootprintEdges U) → (({z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) + → (∀ (a : ↥(TilingLattice Ci)), ∀ (b : ↥(TilingLattice Ci)), (PP.tile a = U) → + ((PP.tile b = V) → ((U.cells ⊆ T.cells) → ((V.cells ⊆ T'.cells) → (({z, z + ⟨0, 1⟩} ∈ + FootprintEdges (PP.tile a)) → (({z, z + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile b)) → ((∀ c + ∈ T'.cells, (0 : ℤ) ≤ (c - (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : + ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).re ∧ (c - (u + + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q + : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).re < (↑P.q : ℤ) ∧ (0 : ℤ) ≤ (c - (u + if i = (0 : + Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), + (↑P.q₂ : ℤ)⟩ : GaussianInt))).im ∧ (c - (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : + ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).im + < (↑P.q : ℤ)) → ((∀ (w : GaussianInt), ((w - u).re = if i = (0 : Fin (3 : ℕ)) then + (↑P.q : ℤ) else (0 : ℤ)) → (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : + ℤ)) ≤ (w - u).im → (w - u).im < (↑P.q : ℤ) → ∃ (aa : ↥(TilingLattice Ci)) (bb : + ↥(TilingLattice Ci)) (gg : PartialOdometer) (kk : PartialOdometer), aa ≠ bb ∧ + (PP.tile aa, gg) ∈ tiles.zip hs ∧ (PP.tile bb, kk) ∈ reverseTiles.zip reverseHs ∧ + AncestorOdometer Ci.1.1 C0.1.1 (PP.tile aa) T gg h ∧ AncestorOdometer Ci.1.1 C0.1.1 + (PP.tile bb) T' kk h' ∧ {w, w + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges + (PP.tile aa) ∧ {w, w + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges (PP.tile + bb)) → (∀ (cf : LatticeCell), (cf ∈ U.cells) → ((if i = (0 : Fin (3 : ℕ)) then cf = + (if (x - u).im = if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ) then x + else x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - (1 : LatticeCell) else cf = if (x - + u).im = if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ) then x else x - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → (∀ (cb : LatticeCell), (cb ∈ V.cells) → ((if i + = (0 : Fin (3 : ℕ)) then cb = if (x - u).im = if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : + ℤ) else (↑P.q₂ : ℤ) then x else x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) else cb = (if + (x - u).im = if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ) then x else x + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - (1 : LatticeCell)) → ((a ≠ b) → (((PP.tile a, + g) ∈ tiles.zip hs) → (((PP.tile b, k) ∈ reverseTiles.zip reverseHs) → + ((AncestorOdometer Ci.1.1 C0.1.1 (PP.tile a) T g h) → ((AncestorOdometer Ci.1.1 + C0.1.1 (PP.tile b) T' k h') → (((x-u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) → + (∃ (a b : TilingLattice Ci) (g k : PartialOdometer), a ≠ b ∧ (PP.tile a, g) ∈ + tiles.zip hs ∧ (PP.tile b, k) ∈ reverseTiles.zip reverseHs ∧ AncestorOdometer Ci.1.1 + C0.1.1 (PP.tile a) T g h ∧ AncestorOdometer Ci.1.1 C0.1.1 (PP.tile b) T' k h' ∧ (∃ z, + (z = x ∨ z = x - ⟨0, 1⟩) ∧ {z, z + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile a) ∧ {z, z + ⟨0, + 1⟩} ∈ FootprintEdges (PP.tile b)) ∧ ((x ∈ (PP.tile a).cells ∧ x - 1 - ⟨0, 1⟩ ∈ + (PP.tile b).cells) ∨ (x - 1 ∈ (PP.tile a).cells ∧ x - ⟨0, 1⟩ ∈ (PP.tile b).cells) ∨ + (x - 1 - ⟨0, 1⟩ ∈ (PP.tile a).cells ∧ x ∈ (PP.tile b).cells) ∨ (x - ⟨0, 1⟩ ∈ (PP.tile + a).cells ∧ x - 1 ∈ (PP.tile b).cells))))))))))))))))))))))))))))))))))))))))))))))) ) + := by + classical + intro P C0 Ci i hsmall hrpos T T' h h' u hc hc' hdis orientation base Rminus Rplus tiles + reverseTiles hs reverseHs hf hr hRm hRp hedges PP tileAt chart x hxr hxl regular_index + translated_ford_cell ford_disjoint_re ford_disjoint_im q₁pos lower_lt_q z z_low z_other + z_incident hz_re hz_low hz_high U V g k hEdgeU hEdgeV a b hUa hVb U_in_T V_in_T' U_edge + V_edge T'_bounds indexed_edge cf hcf hcfSide cb hcb hcbSide hab hAzip hBzip hAanc hBanc hlow + rcases hsmall with ⟨hi, hlt⟩ | ⟨hi, hlt⟩ + · subst i + have hxre : (x-u).re = P.q := by simpa using hxr + have hxim : (x-u).im = P.q₁ := hlow + have hx := EdgeSectorGeometry.hxAt721 P Ci u x hxre hxim + have hnatcast : ((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1 := by + exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q₁) + have hRmem : Rminus ∈ tiles := List.mem_of_head? hf.2.1 + obtain ⟨e, he⟩ := regular_index Rminus (hf.2.2.2.2.1 Rminus hRmem) + have hEtrans := translated_ford_cell P.q₁ 0 (P.q₁-1) + (u + ⟨(P.q : Int),0⟩) (by omega) (by omega) + have hEcell : x - ⟨0,1⟩ ∈ Rminus.cells := EdgeSectorGeometry.hEcellAt735 P u Rminus x hRm + (EdgeSectorGeometry.hce P Ci u x hx hnatcast) hEtrans + have hEidx : x - ⟨0,1⟩ ∈ (PP.tile e).cells := by + simpa [he] using hEcell + have hdisET := EdgeSectorGeometry.hdisETAt740 P T u hc Rminus ford_disjoint_re hRm + have hdisET' := EdgeSectorGeometry.hdisET'At744 P T' u Rminus ford_disjoint_im hc' hRm + have he_ne_a := EdgeSectorGeometry.he_ne_aAt748 Ci T Rminus PP U a hUa U_in_T cf hcf e he + hdisET + have he_ne_b := EdgeSectorGeometry.he_ne_bAt755 Ci T' Rminus PP V b hVb V_in_T' cb hcb e + he hdisET' + let m : GaussianInt := x - 1 - ⟨0,1⟩ + have hqcast : ((P.q - 1 : Nat) : Int) = (P.q : Int) - 1 := by + exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q) + have hq1leq : P.q₁ ≤ P.q := by omega + have hmc := EdgeSectorGeometry.hmcAt766 P Ci u x hx hnatcast hqcast + have hmTtrans := translated_ford_cell P.q (P.q - 1) (P.q₁ - 1) u + (by omega) (by omega) + have hmT : m ∈ T.cells := EdgeSectorGeometry.hmTAt772 P T u hc x hmc hmTtrans + obtain ⟨t, ht, htuniq⟩ := PeriodicTileIndexedMultiplicityOne PP m + have ht_ne_e := EdgeSectorGeometry.ht_ne_eAt779 Ci Rminus PP x e he t ht + (EdgeSectorGeometry.hm_notE T Rminus x hdisET hmT) + have ht_ne_b := EdgeSectorGeometry.ht_ne_bAt784 Ci T T' hdis PP x V b hVb V_in_T' hmT t ht + have hxb : x ∈ (PP.tile b).cells := EdgeSectorGeometry.hxbAt789 P Ci u PP x V b hVb cb + hcb z_low hcbSide hlow + have hxa := EdgeSectorGeometry.hxaAt793 P Ci u PP x U a hUa cf hcf z_low hcfSide hlow + have hfour := AffineTriangularNoFourfoldCellOwners PP tileAt chart x + b a t e hxb hxa ht hEidx + have hrepeat : a = t := EdgeSectorGeometry.hrepeatAt799 Ci a b hab e he_ne_a he_ne_b t + ht_ne_e ht_ne_b hfour + refine ⟨a, b, g, k, hab, hAzip, hBzip, hAanc, hBanc, + ⟨x, Or.inl rfl, ?_, ?_⟩, ?_⟩ + · simpa [z_low hlow] using U_edge + · simpa [z_low hlow] using V_edge + · have hma : m ∈ (PP.tile a).cells := by simpa [hrepeat] using ht + exact Or.inr (Or.inr (Or.inl ⟨hma, hxb⟩)) + · subst i + have hxre : (x-u).re = 0 := by simpa using hxr + have hxim : (x-u).im = P.q₂ := hlow + have hx := EdgeSectorGeometry.hxAt816 P Ci u x hxre hxim + have hq2pos : 0 < P.q₂ := P.q₂_pos + have hncast : ((P.q₂ - 1 : Nat) : Int) = (P.q₂ : Int) - 1 := by + exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q₂) + let m : GaussianInt := x - ⟨0,1⟩ + have hmc := EdgeSectorGeometry.hmcAt823 P Ci u x hx hncast + have htc : m = u + ⟨0, ((P.q₂ - 1 : Nat) : Int)⟩ := hmc + have hmTtrans := translated_ford_cell P.q 0 (P.q₂ - 1) u + (by omega) (by omega) + have hmT : m ∈ T.cells := by rw [hc, htc]; exact hmTtrans + have hncast' : ((P.q₂ - 1 : Nat) : Int) = (P.q₂ : Int) - 1 := hncast + let n : GaussianInt := x - 1 - ⟨0,1⟩ + have hnc : n = (u + ⟨-(P.q₂ : Int),0⟩) + + ⟨((P.q₂ - 1 : Nat) : Int), ((P.q₂ - 1 : Nat) : Int)⟩ := EdgeSectorGeometry.hncAt832 P + Ci u x hx hncast' + have hRmem : Rplus ∈ reverseTiles := List.mem_of_head? hr.2.1 + obtain ⟨e, he⟩ := regular_index Rplus + (hr.2.2.2.2.1 Rplus hRmem) + have hEtrans := translated_ford_cell P.q₂ (P.q₂ - 1) (P.q₂ - 1) + (u + ⟨-(P.q₂ : Int),0⟩) (by omega) (by omega) + have hEcell : n ∈ Rplus.cells := by rw [hRp, hnc]; exact hEtrans + have hEidx : n ∈ (PP.tile e).cells := by simpa [he] using hEcell + have hdisET := EdgeSectorGeometry.hdisETAt843 P T u hc Rplus ford_disjoint_re hRp + have hdisET' := EdgeSectorGeometry.hdisET'At847 P T' u Rplus ford_disjoint_im hc' hRp + have he_ne_a := EdgeSectorGeometry.he_ne_aAt851 Ci T Rplus PP U a hUa U_in_T cf hcf e he + hdisET + have he_ne_b := EdgeSectorGeometry.he_ne_bAt858 Ci T' Rplus PP V b hVb V_in_T' cb hcb e + he hdisET' + obtain ⟨t, ht, htuniq⟩ := PeriodicTileIndexedMultiplicityOne PP m + have ht_ne_e := EdgeSectorGeometry.ht_ne_eAt866 Ci T Rplus PP x hmT e he hdisET t ht + have ht_ne_b := EdgeSectorGeometry.ht_ne_bAt871 Ci T T' hdis PP x V b hVb V_in_T' hmT t ht + have hxa := EdgeSectorGeometry.hxaAt876 P Ci u PP x U a hUa cf hcf z_low hcfSide hlow + have hxb : x - 1 ∈ (PP.tile b).cells := EdgeSectorGeometry.hxbAt880 P Ci u PP x V b hVb + cb hcb z_low hcbSide hlow + have hfour := AffineTriangularNoFourfoldCellOwners PP tileAt chart x + a b e t hxa hxb hEidx ht + have hrepeat : a = t := EdgeSectorGeometry.hrepeatAt886 Ci a b hab e he_ne_a he_ne_b t + ht_ne_e ht_ne_b hfour + refine ⟨a, b, g, k, hab, hAzip, hBzip, hAanc, hBanc, + ⟨x, Or.inl rfl, ?_, ?_⟩, ?_⟩ + · simpa [z_low hlow] using U_edge + · simpa [z_low hlow] using V_edge + · have hma : m ∈ (PP.tile a).cells := by simpa [hrepeat] using ht + exact Or.inr (Or.inr (Or.inr ⟨hma, hxb⟩)) + +end EdgeSectorBoundary + +theorem P4158T1EdgeSectorSelection : + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (i : Fin 3), ((i = 0 + ∧ P.q₁ < P.q₂) ∨ (i = 1 ∧ P.q₂ < P.q₁)) → ((0 < P.q₁) → ((1 < Ci.1.1.1) → (∀ (T : + ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : PartialOdometer), ∀ (u : + GaussianInt), (T.cells = (TileTranslation (FordTile P.q) u).cells) → ((T'.cells = + (TileTranslation (FordTile P.q) + (u + if i = 0 then ⟨P.q, P.q₁⟩ else ⟨-(P.q : Int), P.q₂⟩)).cells) → ((Disjoint T.cells + T'.cells) → (∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ + (hs : List PartialOdometer), ∀ (reverseHs : List PartialOdometer), (TileString Ci + orientation base Rminus Rplus tiles) → ((TileString Ci orientation base Rplus Rminus + reverseTiles) → ((Rminus.cells = (TileTranslation (FordTile (if i = 0 then P.q₁ else + P.q₂)) + (u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩)).cells) → ((Rplus.cells = (TileTranslation + (FordTile (if i = 0 then P.q₁ else P.q₂)) + (u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩)).cells) → ((∀ U, ∀ g, (U, g) ∈ + tiles.zip hs → + AncestorOdometer Ci.1.1 C0.1.1 U T g h → U.cells ⊆ T.cells) → ((∀ V, ∀ k, (V, k) ∈ + reverseTiles.zip reverseHs → + AncestorOdometer Ci.1.1 C0.1.1 V T' k h' → V.cells ⊆ T'.cells) → ((∀ z : GaussianInt, + (z - u).re = (if i = 0 then (P.q : Int) else 0) → + (if i = 0 then (P.q₁ : Int) else P.q₂) ≤ (z - u).im → + (z - u).im < (P.q : Int) → + ∃ (U V : ProtoTile) (g k : PartialOdometer), + U ∈ (tiles.drop 1).dropLast ∧ V ∈ (reverseTiles.drop 1).dropLast ∧ + (U, g) ∈ tiles.zip hs ∧ (V, k) ∈ reverseTiles.zip reverseHs ∧ + AncestorOdometer Ci.1.1 C0.1.1 U T g h ∧ + AncestorOdometer Ci.1.1 C0.1.1 V T' k h' ∧ + {z, z + ⟨0, 1⟩} ∈ FootprintEdges U ∧ + {z, z + ⟨0, 1⟩} ∈ FootprintEdges V) → (∀ (PP : PeriodicTileComplex (TilingLattice Ci)), + (∀ a, PP.tile a = TileTranslation base (a : GaussianInt)) → (∀ (tileAt : (Int × Int) + → ProtoTile), (AffineTriangularComplexChart PP tileAt) → (∀ (x : GaussianInt), ((x - + u).re = (if i = 0 then (P.q : Int) else 0)) → (((if i = 0 then (P.q₁ : Int) else + P.q₂) ≤ (x - u).im) → (((x - u).im ≤ (P.q : Int)) → (∃ (a b : TilingLattice Ci) (g k + : PartialOdometer), + a ≠ b ∧ (PP.tile a, g) ∈ tiles.zip hs ∧ + (PP.tile b, k) ∈ reverseTiles.zip reverseHs ∧ + AncestorOdometer Ci.1.1 C0.1.1 (PP.tile a) T g h ∧ + AncestorOdometer Ci.1.1 C0.1.1 (PP.tile b) T' k h' ∧ + (∃ z, (z = x ∨ z = x - ⟨0, 1⟩) ∧ + {z, z + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile a) ∧ + {z, z + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile b)) ∧ + ((x ∈ (PP.tile a).cells ∧ x - 1 - ⟨0, 1⟩ ∈ (PP.tile b).cells) ∨ + (x - 1 ∈ (PP.tile a).cells ∧ x - ⟨0, 1⟩ ∈ (PP.tile b).cells) ∨ + (x - 1 - ⟨0, 1⟩ ∈ (PP.tile a).cells ∧ x ∈ (PP.tile b).cells) ∨ + (x - ⟨0, 1⟩ ∈ (PP.tile a).cells ∧ x - 1 ∈ (PP.tile b).cells)))))))))))))))))))) := by + intro P C0 Ci i hsmall hrpos hlarge T T' h h' u hc hc' hdis orientation base Rminus Rplus tiles + reverseTiles hs reverseHs hf hr hRm hRp hcontain hcontain' hedges PP htiles tileAt chart x + hxr hxl hxu +-- BODY + all_goals + classical + have regular_index := EdgeSectorGeometry.regular_index Ci base PP htiles + have same_index_of_cell (c : GaussianInt) (a b : TilingLattice Ci) + (ha : c ∈ (PP.tile a).cells) (hb : c ∈ (PP.tile b).cells) : a = b := + (PeriodicTileIndexedMultiplicityOne PP c).unique ha hb + have vertical_edge_cells := EdgeSectorGeometry.vertical_edge_cells + (EdgeSectorGeometry.pair_eq_iff) + have translated_ford_bounds := EdgeSectorGeometry.translated_ford_bounds P Ci i u x + have translated_ford_cell := EdgeSectorGeometry.translated_ford_cell + have ford_disjoint_re := EdgeSectorGeometry.ford_disjoint_re P Ci i u x translated_ford_bounds + have ford_disjoint_im := EdgeSectorGeometry.ford_disjoint_im P Ci i u x translated_ford_bounds + have q₁pos := EdgeSectorGeometry.q₁pos P C0 Ci i hsmall hrpos T T' h h' u hc' Rminus Rplus + tiles reverseTiles hs reverseHs hRm hRp hedges x hxr hxl + have lower_lt_q := EdgeSectorGeometry.lower_lt_q P C0 Ci i hsmall hrpos T T' h h' u hc' + Rminus Rplus tiles reverseTiles hs reverseHs hRm hRp hedges x hxr hxl hxu + let z : GaussianInt := + if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + then x else x - ⟨0, 1⟩ + have z_low (hlow : (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) : + z = x := EdgeSectorGeometry.z_low P i u x hlow + have z_other := EdgeSectorGeometry.z_other P i u x + have z_incident := EdgeSectorGeometry.z_incident P i u x z_low z_other + have hz_re := EdgeSectorGeometry.hz_re P i u x hxr z_low z_other + have hz_low := EdgeSectorGeometry.hz_low P Ci i u x hxl z_low z_other + have hz_high := EdgeSectorGeometry.hz_high P Ci i u x hxu lower_lt_q z_low z_other + obtain ⟨U, V, g, k, hUint, hVint, hUz, hVk, hAg, hAk, hEdgeU, hEdgeV⟩ := + hedges z hz_re hz_low hz_high + have hUmem : U ∈ tiles := (List.of_mem_zip hUz).1 + have hVmem : V ∈ reverseTiles := (List.of_mem_zip hVk).1 + obtain ⟨a, ha⟩ := regular_index U (hf.2.2.2.2.1 U hUmem) + obtain ⟨b, hb⟩ := regular_index V (hr.2.2.2.2.1 V hVmem) + have hUa : PP.tile a = U := ha + have hVb : PP.tile b = V := hb + have U_in_T : U.cells ⊆ T.cells := hcontain U g hUz hAg + have V_in_T' : V.cells ⊆ T'.cells := hcontain' V k hVk hAk + have U_edge : {z, z + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile a) := EdgeSectorGeometry.U_edge P Ci + i u PP x U hEdgeU a hUa + have V_edge : {z, z + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile b) := EdgeSectorGeometry.V_edge P Ci + i u PP x V hEdgeV b hVb + have T_bounds := EdgeSectorGeometry.T_bounds P T u hc translated_ford_bounds + have T'_bounds := EdgeSectorGeometry.T'_bounds P i T' u hc' translated_ford_bounds + have indexed_edge := EdgeSectorGeometry.indexed_edge P C0 Ci i T T' h h' u hdis orientation + base Rminus Rplus tiles reverseTiles hs reverseHs hf hr hcontain hcontain' hedges PP + regular_index vertical_edge_cells + have forward_support := EdgeSectorGeometry.forward_support P C0 Ci i hsmall T T' h h' u hc' + Rminus Rplus tiles reverseTiles hs reverseHs hRm hRp hedges PP x hxr hxl + vertical_edge_cells lower_lt_q z_low z_other z_incident hz_re hz_low hz_high U V hEdgeU + hEdgeV a b hUa U_in_T U_edge V_edge T_bounds T'_bounds indexed_edge + have reverse_support := EdgeSectorGeometry.reverse_support P C0 Ci i hsmall T T' h h' u hc' + Rminus Rplus tiles reverseTiles hs reverseHs hRm hRp hedges PP x hxr hxl + vertical_edge_cells lower_lt_q z_low z_other z_incident hz_re hz_low hz_high U V hEdgeU + hEdgeV a b hVb V_in_T' U_edge V_edge T'_bounds indexed_edge forward_support + obtain ⟨cf, hcf, hcfSide⟩ := forward_support + obtain ⟨cb, hcb, hcbSide⟩ := reverse_support + have hab := EdgeSectorGeometry.hab Ci T T' hdis PP U V a b hUa hVb U_in_T V_in_T' cf hcf + have hAzip : (PP.tile a, g) ∈ tiles.zip hs := by simpa [hUa] using hUz + have hBzip : (PP.tile b, k) ∈ reverseTiles.zip reverseHs := by + simpa [hVb] using hVk + have hAanc : AncestorOdometer Ci.1.1 C0.1.1 (PP.tile a) T g h := by + simpa [hUa] using hAg + have hBanc : AncestorOdometer Ci.1.1 C0.1.1 (PP.tile b) T' k h' := by + simpa [hVb] using hAk + have lowerBoundary (hlow : (x-u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) : + ∃ (a b : TilingLattice Ci) (g k + : PartialOdometer), + a ≠ b ∧ (PP.tile a, g) ∈ tiles.zip hs ∧ + (PP.tile b, k) ∈ reverseTiles.zip reverseHs ∧ + AncestorOdometer Ci.1.1 C0.1.1 (PP.tile a) T g h ∧ + AncestorOdometer Ci.1.1 C0.1.1 (PP.tile b) T' k h' ∧ + (∃ z, (z = x ∨ z = x - ⟨0, 1⟩) ∧ + {z, z + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile a) ∧ + {z, z + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile b)) ∧ + ((x ∈ (PP.tile a).cells ∧ x - 1 - ⟨0, 1⟩ ∈ (PP.tile b).cells) ∨ + (x - 1 ∈ (PP.tile a).cells ∧ x - ⟨0, 1⟩ ∈ (PP.tile b).cells) ∨ + (x - 1 - ⟨0, 1⟩ ∈ (PP.tile a).cells ∧ x ∈ (PP.tile b).cells) ∨ + (x - ⟨0, 1⟩ ∈ (PP.tile a).cells ∧ x - 1 ∈ (PP.tile b).cells)) := + EdgeSectorBoundary.lowerBoundary P C0 Ci i hsmall hrpos T T' h h' u hc hc' hdis + orientation base Rminus Rplus tiles reverseTiles hs reverseHs hf hr hRm hRp hedges PP + tileAt chart x hxr hxl regular_index translated_ford_cell ford_disjoint_re + ford_disjoint_im q₁pos lower_lt_q z_low z_other z_incident hz_re hz_low hz_high U V g k + hEdgeU hEdgeV a b hUa hVb U_in_T V_in_T' U_edge V_edge T'_bounds indexed_edge cf hcf + hcfSide cb hcb hcbSide hab hAzip hBzip hAanc hBanc hlow + by_cases hlow : (x-u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) + · exact lowerBoundary hlow + · by_cases htop : (x-u).im = P.q + · rcases hsmall with ⟨hi, hlt⟩ | ⟨hi, hlt⟩ + · subst i + have hxre' : x.re - u.re = P.q := by + simpa [Zsqrtd.re_sub] using hxr + have hxim' : x.im - u.im = P.q := by + simpa [Zsqrtd.im_sub] using htop + have hxre'' : x.re = u.re + P.q := by omega + have hxim'' : x.im = u.im + P.q := by omega + have hx := EdgeSectorGeometry.hxAt909 P u x hxre'' hxim'' + have hq1cast : ((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1 := by + exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q₁) + have hqsum : (P.q₁ : Int) + P.q₂ = P.q := by + exact_mod_cast P.sum_q.symm + let n : GaussianInt := x - 1 + have hnc : n = (u + ⟨(P.q₂ : Int), (P.q : Int)⟩) + + ⟨((P.q₁ - 1 : Nat) : Int), 0⟩ := EdgeSectorGeometry.hncAt920 P u x hxre'' hxim'' + hq1cast hqsum + have hRmem : Rplus ∈ tiles := List.mem_of_getLast? hf.2.2.1 + obtain ⟨e, he⟩ := regular_index Rplus + (hf.2.2.2.2.1 Rplus hRmem) + have hEtrans := translated_ford_cell P.q₁ (P.q₁ - 1) 0 + (u + ⟨(P.q₂ : Int), (P.q : Int)⟩) (by omega) (by omega) + have hEcell : n ∈ Rplus.cells := by rw [hRp, hnc]; exact hEtrans + have hEidx : n ∈ (PP.tile e).cells := by simpa [he] using hEcell + have hdisET := EdgeSectorGeometry.hdisETAt940 P T u hc Rplus ford_disjoint_im hRp + have hdisET' := EdgeSectorGeometry.hdisET'At944 P Ci T' u Rplus x ford_disjoint_re hc' + hRp hqsum + have hrootCell := translated_ford_cell P.q 0 P.q₂ + (u + ⟨(P.q : Int), (P.q₁ : Int)⟩) (by omega) (EdgeSectorGeometry.hq2lt P Ci hrpos u x + hq1cast) + have hxT' := EdgeSectorGeometry.hxT' P T' u x hc' (EdgeSectorGeometry.hxroot P u x hx + hqsum) hrootCell + obtain ⟨t, ht, htuniq⟩ := PeriodicTileIndexedMultiplicityOne PP x + have ht_ne_e := EdgeSectorGeometry.ht_ne_eAt974 Ci T' Rplus PP x e he hdisET' hxT' t ht + have ht_ne_a := EdgeSectorGeometry.ht_ne_aAt979 C0 Ci T T' h hdis tiles hs hcontain PP + x g a hAzip hAanc hxT' t ht + have he_ne_a := EdgeSectorGeometry.he_ne_aAt984 Ci T Rplus PP x U a hUa U_in_T cf hcf e + he hEcell hEidx hdisET + have he_ne_b := EdgeSectorGeometry.he_ne_bAt993 Ci T' Rplus PP x V b hVb V_in_T' cb hcb + e he hEcell hEidx hdisET' + have hxa := EdgeSectorGeometry.hxaAt1002 P Ci u PP x U a hUa cf hcf z_other hcfSide hlow + have hxb : x - ⟨0,1⟩ ∈ (PP.tile b).cells := EdgeSectorGeometry.hxbAt1009 P Ci u PP x V + b hVb cb hcb z_other hcbSide hlow + have hfour := AffineTriangularNoFourfoldCellOwners PP tileAt chart x + t e a b ht hEidx hxa hxb + have hrepeat : b = t := EdgeSectorGeometry.hrepeatAt1016 Ci a b hab e t ht_ne_e ht_ne_a + he_ne_a he_ne_b hfour + refine ⟨a, b, g, k, hab, hAzip, hBzip, hAanc, hBanc, + ⟨z, z_incident, U_edge, V_edge⟩, ?_⟩ + have hbx : x ∈ (PP.tile b).cells := by simpa [hrepeat] using ht + exact Or.inr (Or.inr (Or.inl ⟨hxa, hbx⟩)) + · subst i + have hxre' : x.re - u.re = 0 := by + simpa [Zsqrtd.re_sub] using hxr + have hxim' : x.im - u.im = P.q := by + simpa [Zsqrtd.im_sub] using htop + have hxre'' : x.re = u.re := by omega + have hxim'' : x.im = u.im + P.q := by omega + have hx := EdgeSectorGeometry.hxAt1035 P Ci u x hxre' hxim'' + have hqsum : (P.q₁ : Int) + P.q₂ = P.q := by + exact_mod_cast P.sum_q.symm + have hqcast : ((P.q - 1 : Nat) : Int) = (P.q : Int) - 1 := by + exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q) + have hq1cast := EdgeSectorGeometry.hq1castAt1045 P Ci hrpos u x htop hxim' hqsum hqcast + let m : GaussianInt := x - 1 + have hmc := EdgeSectorGeometry.hmcAt1049 P Ci u x hxre'' hxim'' hqsum hqcast + have hRmem : Rminus ∈ tiles := List.mem_of_head? hf.2.1 + obtain ⟨e, he⟩ := regular_index Rminus + (hf.2.2.2.2.1 Rminus hRmem) + have hRm1 := EdgeSectorGeometry.hRm1 P u Rminus hRm + have hc'1 := EdgeSectorGeometry.hc'1 P T' u hc' + have hEtrans := translated_ford_cell P.q₂ 0 0 + (u + ⟨0, (P.q : Int)⟩) P.q₂_pos P.q₂_pos + have hEcell : x ∈ Rminus.cells := EdgeSectorGeometry.hEcellAt1075 P u Rminus x hx hRm1 + hEtrans + have hEidx : x ∈ (PP.tile e).cells := by simpa [he] using hEcell + have hdisET := EdgeSectorGeometry.hdisETAt1079 P T u hc Rminus ford_disjoint_im hRm1 + have hdisET' := EdgeSectorGeometry.hdisET'At1085 P Ci T' u Rminus x ford_disjoint_re + hRm1 hc'1 + have httrans := translated_ford_cell P.q (P.q - 1) P.q₁ + (u + ⟨-(P.q : Int), (P.q₂ : Int)⟩) (by omega) (P.q₁_lt) + have hmT' := EdgeSectorGeometry.hmT' P T' u x hmc hc'1 httrans + obtain ⟨t, ht, htuniq⟩ := PeriodicTileIndexedMultiplicityOne PP m + have ht_ne_e := EdgeSectorGeometry.ht_ne_eAt1103 Ci T' Rminus PP x e he hdisET' hmT' t ht + have ht_ne_a := EdgeSectorGeometry.ht_ne_aAt1108 C0 Ci T T' h hdis tiles hs hcontain PP + x g a hAzip hAanc hmT' t ht + have he_ne_a := EdgeSectorGeometry.he_ne_aAt1113 P C0 Ci T h u Rminus tiles hs hcontain + PP x U g a hUa cf hcf hAzip hAanc z_other hcfSide hlow e he hdisET + have he_ne_b := EdgeSectorGeometry.he_ne_bAt1125 P C0 Ci T' h' u Rminus reverseTiles + reverseHs hcontain' PP x V k b hVb cb hcb hBzip hBanc z_other hcbSide hlow e he + hdisET' + have hxa := EdgeSectorGeometry.hxaAt1138 P Ci u PP x U a hUa cf hcf z_other hcfSide hlow + have hxb : x - 1 - ⟨0,1⟩ ∈ (PP.tile b).cells := EdgeSectorGeometry.hxbAt1142 P Ci u PP + x V b hVb cb hcb z_other hcbSide hlow + have hfour := AffineTriangularNoFourfoldCellOwners PP tileAt chart x + e t b a hEidx ht hxb hxa + have hrepeat : b = t := EdgeSectorGeometry.hrepeatAt1149 Ci a b hab e t ht_ne_e ht_ne_a + he_ne_a he_ne_b hfour + refine ⟨a, b, g, k, hab, hAzip, hBzip, hAanc, hBanc, + ⟨z, z_incident, U_edge, V_edge⟩, ?_⟩ + have hbx : x - 1 ∈ (PP.tile b).cells := by simpa [hrepeat] using ht + exact Or.inr (Or.inr (Or.inr ⟨hxa, hbx⟩)) + · apply (EdgeSectorGeometry.internal_solution P C0 Ci i hsmall T T' h h' u hc' Rminus Rplus + tiles reverseTiles hs reverseHs hRm hRp hcontain hcontain' hedges PP tileAt chart x hxr + hxl vertical_edge_cells lower_lt_q z_low z_other z_incident hz_re hz_low hz_high U V g + k hEdgeU hEdgeV a b hUa hVb U_edge V_edge T_bounds T'_bounds indexed_edge + (EdgeSectorGeometry.cross_ne C0 Ci T T' h h' hdis tiles reverseTiles hs reverseHs + hcontain hcontain' PP) cf hcf hcfSide cb hcb hcbSide hab hAzip hBzip hAanc hBanc) + · omega + · omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean new file mode 100644 index 0000000000..2bbfabea0a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean @@ -0,0 +1,1037 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality + +-- [TABLET NODE: P4158T1LargeFirstRestrictions] + +/-! +# P4158T1LargeFirstRestrictions + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace LargeFirstRestrictions + +private theorem hq1 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((P.q₂ < P.q₁) → (1 < P.q₁)) ) := by + classical + intro P Ci horder + have hq2 := P.q₂_pos + omega + +private theorem hqgt : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((1 < P.q₁) → (1 < P.q)) ) := by + classical + intro P Ci hq1 + have hsum := P.sum_q + have hq2 := P.q₂_pos + omega + +private theorem hroot : + (by + classical + exact + ∀ (P : FordFareyParameter), (1 < P.q) → (1 < (FordRecursiveQuadruple P 0).1) ) := by + classical + intro P hqgt + simp [FordRecursiveQuadruple, FordCircleCoordinate] + nlinarith + +private theorem hATU : + (by + classical + exact + ∀ (P : FordFareyParameter), (ProperBandQuadruple (FordRecursiveQuadruple P)) → (∀ (C0 : + BandCircle), ∀ (Ci : BandCircle), (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)) = + C0.1.1) → ((FordRecursiveQuadruple P (1 : Fin (4 : ℕ)) = Ci.1.1) → (∀ (T : + ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gS : Fin (3 : ℕ) → Bool → + PartialOdometer), (BandPrototile (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) T) → + ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), FootprintVertices (S i s) ⊆ FootprintVertices T) + → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S i s) - TileCentroid T = (if s + = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ))).1))) → ( + let U := S 0 false + let g := gS 0 false + (TileOdometer Ci.1.1 U g) → (AncestorTile Ci.1.1 C0.1.1 U T))))))) ) := by + classical + intro P hq C0 Ci hC0 hCi T S gS hbandT hfoot hcent U g hUg + unfold AncestorTile + apply Relation.ReflTransGen.single + refine ⟨FordRecursiveQuadruple P, 0, false, hq, ?_, ?_, ?_, ?_, hfoot 0 false, ?_⟩ + · exact hC0 + · exact hCi + · exact (by simpa only [← hC0] using hbandT) + · exact TileOdometerBandPrototile _ _ _ hUg + · exact hcent 0 false + +private theorem hATV : + (by + classical + exact + ∀ (P : FordFareyParameter), (ProperBandQuadruple (FordRecursiveQuadruple P)) → (∀ (C0 : + BandCircle), ∀ (Ci : BandCircle), (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)) = + C0.1.1) → ((FordRecursiveQuadruple P (1 : Fin (4 : ℕ)) = Ci.1.1) → (∀ (T' : + ProtoTile), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (kS : Fin (3 : ℕ) → Bool → + PartialOdometer), (BandPrototile (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) T') → + ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), FootprintVertices (S' i s) ⊆ FootprintVertices + T') → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S' i s) - TileCentroid T' = + (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) + (FordRecursiveQuadruple P (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) + (FordRecursiveQuadruple P (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint + (BandVectors.1 (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) + (FordRecursiveQuadruple P (i + (1 : Fin (3 : ℕ))).succ))).1))) → ( + let V := S' 0 true + let k := kS 0 true + (TileOdometer Ci.1.1 V k) → (AncestorTile Ci.1.1 C0.1.1 V T'))))))) ) := by + classical + intro P hq C0 Ci hC0 hCi T' S' kS hbandT' hfoot' hcent' V k hVk + unfold AncestorTile + apply Relation.ReflTransGen.single + refine ⟨FordRecursiveQuadruple P, 0, true, hq, ?_, ?_, ?_, ?_, hfoot' 0 true, ?_⟩ + · exact hC0 + · exact hCi + · exact (by simpa only [← hC0] using hbandT') + · exact TileOdometerBandPrototile _ _ _ hVk + · exact hcent' 0 true + +private theorem hAncU : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)) = C0.1.1) → (∀ (T : ProtoTile), ∀ (h : + PartialOdometer), (TileOdometer C0.1.1 T h) → (∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (gS : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (x : GaussianInt), x ∈ + h.domain ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (gS i s).domain) → ((∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), ∀ x ∈ (gS i s).domain, h.value x = (gS i s).value x) → ( + let U := S 0 false + let g := gS 0 false + (TileOdometer Ci.1.1 U g) → ((0 < Ci.1.1.1) → ((AncestorTile Ci.1.1 C0.1.1 U T) → + (AncestorOdometer Ci.1.1 C0.1.1 U T g h))))))) ) := by + classical + intro P C0 Ci hC0 T h hO S gS hdom hvalue U g hUg hCiPos hATU + refine ⟨by simpa only [← hC0] using hO, hATU, ?_, ?_, ?_⟩ + · exact PositiveCurvatureTileOdometerDomain Ci.1.1 U g hCiPos hUg + · intro y hy + exact (hdom y).mpr ⟨0, false, hy⟩ + · intro y hy + exact (hvalue 0 false y hy).symm + +private theorem hAncV : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)) = C0.1.1) → (∀ (T' : ProtoTile), ∀ (h' : + PartialOdometer), (TileOdometer C0.1.1 T' h') → (∀ (S' : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (kS : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (x : GaussianInt), x ∈ + h'.domain ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (kS i s).domain) → ((∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), ∀ x ∈ (kS i s).domain, h'.value x = (kS i s).value x) → ( + let V := S' 0 true + let k := kS 0 true + (TileOdometer Ci.1.1 V k) → ((0 < Ci.1.1.1) → ((AncestorTile Ci.1.1 C0.1.1 V T') → + (AncestorOdometer Ci.1.1 C0.1.1 V T' k h'))))))) ) := by + classical + intro P C0 Ci hC0 T' h' hO' S' kS hdom' hvalue' V k hVk hCiPos hATV + refine ⟨by simpa only [← hC0] using hO', hATV, ?_, ?_, ?_⟩ + · exact PositiveCurvatureTileOdometerDomain Ci.1.1 V k hCiPos hVk + · intro y hy + exact (hdom' y).mpr ⟨0, true, hy⟩ + · intro y hy + exact (hvalue' 0 true y hy).symm + +private theorem hcross : + (by + classical + exact + ∀ (P : FordFareyParameter), P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 ) := by + classical + intro P + have h := P.det₁ + rw [P.sum_q, P.sum_p] at h + push_cast at h + nlinarith + +private theorem hcop : + (by + classical + exact + ∀ (P : FordFareyParameter), (P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1) → + (Nat.Coprime P.q₁ P.p₁.natAbs) ) := by + classical + intro P hcross + rw [Nat.coprime_iff_gcd_eq_one] + apply Nat.dvd_one.mp + let d := Nat.gcd P.q₁ P.p₁.natAbs + have hdq : d ∣ P.q₁ := Nat.gcd_dvd_left _ _ + have hdp : d ∣ P.p₁.natAbs := Nat.gcd_dvd_right _ _ + have hdq' : (d : Int) ∣ (P.q₁ : Int) := by exact_mod_cast hdq + have hdp' : (d : Int) ∣ P.p₁ := + (Int.dvd_natAbs).mp (by exact_mod_cast hdp) + have hd : (d : Int) ∣ 1 := by + have hm : (d : Int) ∣ P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ := + dvd_sub (dvd_mul_of_dvd_left hdp' _) (dvd_mul_of_dvd_left hdq' _) + simpa [hcross] using hm + have hd1 : (d : Int) = 1 := Int.eq_one_of_dvd_one (by exact_mod_cast (Nat.zero_le d)) hd + have hdNat : d = 1 := by exact_mod_cast hd1 + simpa [d] using hdNat + +private theorem hQchild : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), (FordRecursiveQuadruple P (1 : + Fin (4 : ℕ)) = Ci.1.1) → (∀ (horder : P.q₂ < P.q₁), ∀ (hq1 : 1 < P.q₁), ∀ (hcross : + P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1), ∀ (hcop : Nat.Coprime P.q₁ + P.p₁.natAbs), + let Q : FordFareyParameter := { + p := P.p₁ + q := P.q₁ + q_pos := by omega + reduced := hcop + p₁ := P.p₁ - P.p₂ + q₁ := P.q₁ - P.q₂ + p₂ := P.p₂ + q₂ := P.q₂ + sum_p := by omega + sum_q := by omega + det₁ := by + rw [Nat.cast_sub (by omega)] + nlinarith + det₂ := by + nlinarith + q₁_lt := by + exact Nat.sub_lt (by omega : 0 < P.q₁) P.q₂_pos + q₂_pos := P.q₂_pos + unit_case := by + intro hu + change P.q₁ = 1 at hu + omega } + FordRecursiveQuadruple Q 0 = Ci.1.1)) := by + classical + intro P Ci hCi horder hq1 hcross hcop Q + rw [← hCi] + have hq1nz : P.q₁ ≠ 0 := by omega + simp [FordRecursiveQuadruple, Q, hq1nz] + +private theorem hQbandCi : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (horder : P.q₂ < P.q₁), ∀ (hq1 : 1 < + P.q₁), ∀ (hcross : P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1), ∀ (hcop : + Nat.Coprime P.q₁ P.p₁.natAbs), + let Q : FordFareyParameter := { + p := P.p₁ + q := P.q₁ + q_pos := by omega + reduced := hcop + p₁ := P.p₁ - P.p₂ + q₁ := P.q₁ - P.q₂ + p₂ := P.p₂ + q₂ := P.q₂ + sum_p := by omega + sum_q := by omega + det₁ := by + rw [Nat.cast_sub (by omega)] + nlinarith + det₂ := by + nlinarith + q₁_lt := by + exact Nat.sub_lt (by omega : 0 < P.q₁) P.q₂_pos + q₂_pos := P.q₂_pos + unit_case := by + intro hu + change P.q₁ = 1 at hu + omega } + (FordRecursiveQuadruple Q 0 = Ci.1.1) → ((BandPrototile (FordCircleCoordinate Q.p Q.q) + (FordTile Q.q)) → (BandPrototile Ci.1.1 (FordTile P.q₁))) ) := by + classical + intro P Ci horder hq1 hcross hcop Q hQchild hQband + rw [← hQchild] + exact hQband + +private theorem hvfirst : + (by + classical + exact + ∀ (P : FordFareyParameter), (ProperBandQuadruple (FordRecursiveQuadruple P)) → + ((BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) = ⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩) → ( + let x := BandVectors.1 (FordRecursiveQuadruple P 1) + (FordRecursiveQuadruple P 3) + let y := BandVectors.1 (FordRecursiveQuadruple P 2) + (FordRecursiveQuadruple P 1) + x - (⟨0, 1⟩ : GaussianInt) * y = ⟨P.q, P.q₁⟩)) ) := by + classical + intro P hq hv10 x y + have hh := (VectorRecursionLaws (FordRecursiveQuadruple P) hq.1).2.2.1 + rw [hv10] at hh + simpa [x, y] using hh.symm + +private theorem hvsecond : + (by + classical + exact + ∀ (P : FordFareyParameter), (ProperBandQuadruple (FordRecursiveQuadruple P)) → + ((BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) = ⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩) → ( + let w := BandVectors.1 (FordRecursiveQuadruple P 3) + (FordRecursiveQuadruple P 2) + let y := BandVectors.1 (FordRecursiveQuadruple P 2) + (FordRecursiveQuadruple P 1) + y - (⟨0, 1⟩ : GaussianInt) * w = ⟨-(P.q : Int), P.q₂⟩)) ) := by + classical + intro P hq hv20 w y + have rotated : SemiProperQuadruple + (![FordRecursiveQuadruple P 0, FordRecursiveQuadruple P 2, + FordRecursiveQuadruple P 3, FordRecursiveQuadruple P 1]) := + SemiProperQuadruple.rotate hq.1 + have hh := (VectorRecursionLaws + (![FordRecursiveQuadruple P 0, FordRecursiveQuadruple P 2, + FordRecursiveQuadruple P 3, FordRecursiveQuadruple P 1]) rotated).2.2.1 + have hh' := by simpa using hh + rw [hv20] at hh' + simpa [y, w] using hh'.symm + +private theorem hvsol : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((P.q₂ < P.q₁) → ((1 < P.q₁) → ((P.p₁ * (P.q₂ + : Int) - (P.q₁ : Int) * P.p₂ = 1) → ((Nat.Coprime P.q₁ P.p₁.natAbs) → ( + let w := BandVectors.1 (FordRecursiveQuadruple P 3) + (FordRecursiveQuadruple P 2) + let x := BandVectors.1 (FordRecursiveQuadruple P 1) + (FordRecursiveQuadruple P 3) + let y := BandVectors.1 (FordRecursiveQuadruple P 2) + (FordRecursiveQuadruple P 1) + (w + x + y = 0) → ((x - (⟨0, 1⟩ : GaussianInt) * y = ⟨P.q, P.q₁⟩) → ((y - (⟨0, 1⟩ : + GaussianInt) * w = ⟨-(P.q : Int), P.q₂⟩) → (w = ⟨0, -(P.q₂ : Int)⟩)))))))) ) := by + classical + intro P Ci horder hq1 hcross hcop w x y hvsum hvfirst hvsecond + have solve : ∀ (r s : Int) (w a b : GaussianInt), + w + a + b = 0 → + a - (⟨0, 1⟩ : GaussianInt) * b = ⟨r + s, r⟩ → + b - (⟨0, 1⟩ : GaussianInt) * w = ⟨-(r + s), s⟩ → + w = ⟨0, -s⟩ := by + intro r s w a b hsum hfirst hsecond + have hsre := congrArg (fun z : GaussianInt => z.re) hsum + have hsim := congrArg (fun z : GaussianInt => z.im) hsum + have hfre := congrArg (fun z : GaussianInt => z.re) hfirst + have hfim := congrArg (fun z : GaussianInt => z.im) hfirst + have htre := congrArg (fun z : GaussianInt => z.re) hsecond + have htim := congrArg (fun z : GaussianInt => z.im) hsecond + simp [Zsqrtd.re_mul, Zsqrtd.im_mul] at hsre hsim hfre hfim htre htim + apply Zsqrtd.ext <;> dsimp <;> omega + exact solve P.q₁ P.q₂ w x y hvsum (by + simpa [P.sum_q] using hvfirst) (by + simpa [P.sum_q] using hvsecond) + +private theorem haslope32 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandVectors.2 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) = ⟨-P.p₂, (0 : ℤ)⟩) → (BandVectors.2 + (FordRecursiveQuadruple P 3) (FordRecursiveQuadruple P 2) = -(P.p₂ : GaussianInt)) ) + := by + classical + intro P ha32 + exact ha32 + +private theorem fordCentroid : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((P.q₂ < P.q₁) → ((1 < P.q₁) → ((P.p₁ * (P.q₂ + : Int) - (P.q₁ : Int) * P.p₂ = 1) → ((Nat.Coprime P.q₁ P.p₁.natAbs) → (∀ (n : ℕ), (0 + : ℕ) < n → TileCentroid (FordTile n) = ((↑n : ℝ) / (2 : ℝ), (↑n : ℝ) / (2 : ℝ))))))) + ) := by + classical + intro P Ci horder hq1 hcross hcop n hn + let D : Finset GaussianInt := + (Finset.range n).product (Finset.range n) |>.image + (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) + have hne : D.Nonempty := by + refine ⟨⟨0, 0⟩, ?_⟩ + simp [D, hn] + have hinj : Set.InjOn + (fun a : Nat × Nat => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) + ↑((Finset.range n).product (Finset.range n)) := by + intro a ha b hb hab + apply Prod.ext + · have hh := congrArg (fun z : GaussianInt => z.re) hab + change (a.1 : Int) = b.1 at hh + exact_mod_cast hh + · have hh := congrArg (fun z : GaussianInt => z.im) hab + change (a.2 : Int) = b.2 at hh + exact_mod_cast hh + have hcard : D.card = n * n := by + calc + D.card = ((Finset.range n).product (Finset.range n)).card := by + dsimp [D] + exact Finset.card_image_iff.mpr hinj + _ = n * n := by simp + have hsumR : D.sum (fun z : GaussianInt => z.re) = + (n : Int) * ((n - 1 : Nat) : Int) / 2 * (n : Int) := by + have hrange : (Finset.range n).sum (fun a => (a : Int)) = + (n : Int) * ((n - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + simp? [D, Finset.sum_product] + conv_lhs => rw [← Finset.mul_sum (Finset.range n) + (fun a => (a : Int)) (n : Int)] + rw [hrange] + ring + have hsumI : D.sum (fun z : GaussianInt => z.im) = + (n : Int) * ((n - 1 : Nat) : Int) / 2 * (n : Int) := by + have hrange : (Finset.range n).sum (fun a => (a : Int)) = + (n : Int) * ((n - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + simp? [D, Finset.sum_product] + rw [hrange] + ring + change (if D.Nonempty then + (((D.sum (fun z : GaussianInt => z.re) : Int) : Real) / D.card + 1 / 2, + ((D.sum (fun z : GaussianInt => z.im) : Int) : Real) / D.card + 1 / 2) + else _) = _ + rw [ite_eq_left hne, hcard, hsumR, hsumI] + have hncast : ((n - 1 : Nat) : Int) = (n : Int) - 1 := by omega + rw [hncast] + norm_num + field_simp + have rangeSum : (Finset.range n).sum (fun a => (a : Int)) = + (n : Int) * ((n - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + have arithmeticCast : + ((Finset.range n).sum (fun a => (a : Int))) * 2 = + (n : Int) * ((n - 1 : Nat) : Int) := by + rw [← Nat.cast_sum] + exact_mod_cast Finset.sum_range_id_mul_two n + rw [rangeSum] at arithmeticCast + rw [hncast] at arithmeticCast + have hreal : + ((((n : Int) * ((n : Int) - 1) / 2 : Int) : Real) * 2) = + (((n : Int) * ((n : Int) - 1) : Int) : Real) := by + exact_mod_cast arithmeticCast + rw [hreal] + push_cast + ring + +private theorem rootNonempty : + (by + classical + exact + ∀ (n : ℕ), (0 : ℕ) < n → ∀ (z : GaussianInt), Finset.Nonempty (TileTranslation (FordTile + n) z).cells ) := by + classical + intro n hn z + refine ⟨z, ?_⟩ + rw [(TileTranslationFormulas (FordTile n) z).1] + apply Finset.mem_image.mpr + refine ⟨0, ?_, ?_⟩ + · change (0 : GaussianInt) ∈ FordCellDomain n + unfold FordCellDomain + apply Finset.mem_image.mpr + refine ⟨(0, 0), Finset.mem_product.mpr ⟨by simp [hn], by simp [hn]⟩, ?_⟩ + ext <;> simp + · simp [GaussianTranslation] + +private theorem hrootCent : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), (T.cells = + (TileTranslation (FordTile P.q) u).cells) → ((∀ (n : Nat), (0 < n) → (∀ (z : + GaussianInt), (TileTranslation (FordTile n) z).cells.Nonempty)) → (TileCentroid T = + TileCentroid (TileTranslation (FordTile P.q) u))) ) := by + classical + intro P T u hc rootNonempty + have hne := rootNonempty P.q P.q_pos u + have hanch : T.cells = ∅ → T.anchor = (TileTranslation (FordTile P.q) u).anchor := by + intro he + have he' : (TileTranslation (FordTile P.q) u).cells = ∅ := by rw [← hc, he] + exact False.elim (hne.ne_empty he') + exact (ProtoTileObservableExtensionality T + (TileTranslation (FordTile P.q) u) hc hanch).2.2.2.2 + +private theorem hrootCent' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (T'.cells = + (TileTranslation (FordTile P.q) (u + ⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩)).cells) → ((∀ (n : + Nat), (0 < n) → (∀ (z : GaussianInt), (TileTranslation (FordTile n) + z).cells.Nonempty)) → (TileCentroid T' = TileCentroid (TileTranslation (FordTile P.q) + (u + ⟨P.q, P.q₁⟩)))) ) := by + classical + intro P T' u hc' rootNonempty + let z := u + ⟨P.q, P.q₁⟩ + have hne := rootNonempty P.q P.q_pos z + have hanch : T'.cells = ∅ → T'.anchor = + (TileTranslation (FordTile P.q) z).anchor := by + intro he + have he' : (TileTranslation (FordTile P.q) z).cells = ∅ := by rw [← hc', he] + exact False.elim (hne.ne_empty he') + simpa [z] using (ProtoTileObservableExtensionality T' + (TileTranslation (FordTile P.q) z) hc' hanch).2.2.2.2 + +private theorem hw' : + (by + classical + exact + ∀ (P : FordFareyParameter), + let w := BandVectors.1 (FordRecursiveQuadruple P 3) + (FordRecursiveQuadruple P 2) + (w = ⟨0, -(P.q₂ : Int)⟩) → (BandVectors.1 (FordRecursiveQuadruple P 3) + (FordRecursiveQuadruple P 2) = ⟨0, -(P.q₂ : Int)⟩) ) := by + classical + intro P w hvsol + simpa [w] using hvsol + +private theorem hUoffset : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S i s) - TileCentroid T = (if s = true + then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ))).1))) → ( + let U := S 0 false + let w := BandVectors.1 (FordRecursiveQuadruple P 3) + (FordRecursiveQuadruple P 2) + (w = ⟨0, -(P.q₂ : Int)⟩) → (TileCentroid U - TileCentroid T = ((P.q₂ : Real) / 2, (P.q₂ : + Real) / 2))) ) := by + classical + intro P T S hcent U w hvsol + have hh : TileCentroid U - TileCentroid T = + (-1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint w - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) := by + simpa [U, w] using hcent 0 false + rw [hvsol] at hh + norm_num [GaussianRealPoint] at hh + apply Prod.ext + · have hh := congrArg Prod.fst hh + norm_num at hh ⊢ + linarith + · have hh := congrArg Prod.snd hh + norm_num at hh ⊢ + linarith + +private theorem hVoffset : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S' i s) - TileCentroid T' = (if s = + true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ))).1))) → ( + let V := S' 0 true + let w := BandVectors.1 (FordRecursiveQuadruple P 3) + (FordRecursiveQuadruple P 2) + (w = ⟨0, -(P.q₂ : Int)⟩) → (TileCentroid V - TileCentroid T' = (-((P.q₂ : Real) / 2), + -((P.q₂ : Real) / 2)))) ) := by + classical + intro P T' S' hcent' V w hvsol + have hh : TileCentroid V - TileCentroid T' = + (1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint w - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) := by + simpa [V, w] using hcent' 0 true + rw [hvsol] at hh + norm_num [GaussianRealPoint] at hh + apply Prod.ext + · have hh := congrArg Prod.fst hh + norm_num at hh ⊢ + linarith + · have hh := congrArg Prod.snd hh + norm_num at hh ⊢ + linarith + +private theorem hUCcent : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (u : + GaussianInt), (1 < P.q₁) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let U := S 0 false + (P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1) → ((Nat.Coprime P.q₁ P.p₁.natAbs) → ((∀ + (n : Nat), (0 < n) → (TileCentroid (FordTile n) = ((n : Real) / 2, (n : Real) / 2))) → ( + let Uc := TileTranslation (FordTile P.q₁) (u + ⟨P.q₂, P.q₂⟩) + (TileCentroid T = TileCentroid (TileTranslation (FordTile P.q) u)) → ((TileCentroid U - + TileCentroid T = ((P.q₂ : Real) / 2, (P.q₂ : Real) / 2)) → (TileCentroid U = + TileCentroid Uc)))))))) ) := by + classical + intro P Ci horder T u hq1 S U hcross hcop fordCentroid Uc hrootCent hUoffset + calc + TileCentroid U = (TileCentroid U - TileCentroid T) + TileCentroid T := by abel + _ = ((P.q₂ : Real) / 2, (P.q₂ : Real) / 2) + + TileCentroid (TileTranslation (FordTile P.q) u) := by rw [hUoffset, hrootCent] + _ = TileCentroid Uc := by + rw [(TileTranslationFormulas (FordTile P.q) u).2.2.2.2.1, + (TileTranslationFormulas (FordTile P.q₁) (u + ⟨P.q₂, P.q₂⟩)).2.2.2.2.1, + fordCentroid P.q P.q_pos, fordCentroid P.q₁ (by omega)] + apply Prod.ext <;> simp [P.sum_q] <;> ring + +private theorem hVCcent : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((P.q₂ < P.q₁) → (∀ (T' : ProtoTile), ∀ (u : + GaussianInt), (1 < P.q₁) → (∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), + let V := S' 0 true + (P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1) → ((Nat.Coprime P.q₁ P.p₁.natAbs) → ((∀ + (n : Nat), (0 < n) → (TileCentroid (FordTile n) = ((n : Real) / 2, (n : Real) / 2))) → ( + let Vc := TileTranslation (FordTile P.q₁) (u + ⟨P.q, P.q₁⟩) + (TileCentroid T' = TileCentroid (TileTranslation (FordTile P.q) (u + ⟨P.q, P.q₁⟩))) → + ((TileCentroid V - TileCentroid T' = (-((P.q₂ : Real) / 2), -((P.q₂ : Real) / 2))) → + (TileCentroid V = TileCentroid Vc)))))))) ) := by + classical + intro P Ci horder T' u hq1 S' V hcross hcop fordCentroid Vc hrootCent' hVoffset + calc + TileCentroid V = (TileCentroid V - TileCentroid T') + TileCentroid T' := by abel + _ = (-((P.q₂ : Real) / 2), -((P.q₂ : Real) / 2)) + + TileCentroid (TileTranslation (FordTile P.q) + (u + ⟨P.q, P.q₁⟩)) := by rw [hVoffset, hrootCent'] + _ = TileCentroid Vc := by + rw [(TileTranslationFormulas (FordTile P.q) (u + ⟨P.q, P.q₁⟩)).2.2.2.2.1, + (TileTranslationFormulas (FordTile P.q₁) (u + ⟨P.q, P.q₁⟩)).2.2.2.2.1, + fordCentroid P.q P.q_pos, fordCentroid P.q₁ (by omega)] + apply Prod.ext <;> simp [P.sum_q] <;> ring + +private theorem hcentUV : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((P.q₂ < P.q₁) → (∀ (u : GaussianInt), (1 < + P.q₁) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S' : Fin (3 : ℕ) → Bool → + ProtoTile), + let U := S 0 false + let V := S' 0 true + (P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1) → ((Nat.Coprime P.q₁ P.p₁.natAbs) → ((∀ + (n : Nat), (0 < n) → (TileCentroid (FordTile n) = ((n : Real) / 2, (n : Real) / 2))) → ( + let Uc := TileTranslation (FordTile P.q₁) (u + ⟨P.q₂, P.q₂⟩) + let Vc := TileTranslation (FordTile P.q₁) (u + ⟨P.q, P.q₁⟩) + (TileCentroid U = TileCentroid Uc) → ((TileCentroid V = TileCentroid Vc) → (TileCentroid + V - TileCentroid U = GaussianRealPoint ⟨P.q₁, (P.q₁ : Int) - P.q₂⟩)))))))) ) := by + classical + intro P Ci horder u hq1 S S' U V hcross hcop fordCentroid Uc Vc hUCcent hVCcent + rw [hVCcent, hUCcent, + (TileTranslationFormulas (FordTile P.q₁) (u + ⟨P.q, P.q₁⟩)).2.2.2.2.1, + (TileTranslationFormulas (FordTile P.q₁) (u + ⟨P.q₂, P.q₂⟩)).2.2.2.2.1, + fordCentroid P.q₁ (by omega)] + apply Prod.ext <;> simp [GaussianRealPoint, P.sum_q] + +private theorem hnonzero : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((P.q₂ < P.q₁) → ((1 < P.q₁) → ((P.p₁ * (P.q₂ + : Int) - (P.q₁ : Int) * P.p₂ = 1) → ((Nat.Coprime P.q₁ P.p₁.natAbs) → + ((FordRecursiveQuadruple P 1).1 ≠ 0))))) ) := by + classical + intro P Ci horder hq1 hcross hcop + change (if P.q₁ = 0 then (0, 1) else + FordCircleCoordinate P.p₁ P.q₁).1 ≠ 0 + rw [ite_eq_right (by omega)] + simp [FordCircleCoordinate] + omega + +private theorem hslopeUdata : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (h : PartialOdometer), ∀ (gS : Fin (3 : ℕ) → Bool → + PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (FordRecursiveQuadruple P + i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ × ℝ) (p_i : ℝ × ℝ), PartialOdometerSlope h = some p ∧ + PartialOdometerSlope (gS i s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (FordRecursiveQuadruple P (i + (2 : + Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) + - (↑(BandVectors.2 (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) + (FordRecursiveQuadruple P (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if + s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (FordRecursiveQuadruple P (i + + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + (1 : Fin (3 : ℕ))).succ)).re + : ℝ))) → (((FordRecursiveQuadruple P 1).1 ≠ 0) → (∃ p₀ pU, PartialOdometerSlope h = + some p₀ ∧ PartialOdometerSlope (gS 0 false) = some pU ∧ pU.1 - p₀.1 = (if false = + true then (1 : ℝ) else -1) * (1 / 2) * (((BandVectors.2 (FordRecursiveQuadruple P 3) + (FordRecursiveQuadruple P 2)).re : Int) - ((BandVectors.2 (FordRecursiveQuadruple P + 3) (FordRecursiveQuadruple P 2)).im : Int)) ∧ pU.2 - p₀.2 = (if false = true then (1 + : ℝ) else -1) * (1 / 2) * (((BandVectors.2 (FordRecursiveQuadruple P 3) + (FordRecursiveQuadruple P 2)).im : Int) + ((BandVectors.2 (FordRecursiveQuadruple P + 3) (FordRecursiveQuadruple P 2)).re : Int)))) ) := by + classical + intro P h gS hslope hnonzero + rcases hslope 0 false with hz | h + · exact False.elim (hnonzero hz) + · exact h + +private theorem hdu1' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (p : Real × Real), (BandVectors.2 (FordRecursiveQuadruple P + 3) (FordRecursiveQuadruple P 2) = -(P.p₂ : GaussianInt)) → (∀ (p₀ : ℝ × ℝ), ∀ (pU : ℝ + × ℝ), (pU.1 - p₀.1 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ)))).re : ℝ) - (↑(BandVectors.2 + (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (2 : Fin (4 : + ℕ)))).im : ℝ))) → ((p₀ = p) → ( + let s := pU + s.1 - p.1 = (P.p₂ : Real) / 2))) ) := by + classical + intro P p haslope32 p₀ pU hdu1 hp₀ s + rw [hp₀] at hdu1 + rw [haslope32] at hdu1 + norm_num at hdu1 + dsimp [s] + linarith [hdu1] + +private theorem hdu2' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (p : Real × Real), (BandVectors.2 (FordRecursiveQuadruple P + 3) (FordRecursiveQuadruple P 2) = -(P.p₂ : GaussianInt)) → (∀ (p₀ : ℝ × ℝ), ∀ (pU : ℝ + × ℝ), (pU.2 - p₀.2 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ)))).im : ℝ) + (↑(BandVectors.2 + (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (2 : Fin (4 : + ℕ)))).re : ℝ))) → ((p₀ = p) → ( + let s := pU + s.2 - p.2 = (P.p₂ : Real) / 2))) ) := by + classical + intro P p haslope32 p₀ pU hdu2 hp₀ s + rw [hp₀] at hdu2 + rw [haslope32] at hdu2 + norm_num at hdu2 + dsimp [s] + linarith [hdu2] + +private theorem hslopeVdata : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (h' : PartialOdometer), ∀ (kS : Fin (3 : ℕ) → Bool → + PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (FordRecursiveQuadruple P + i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ × ℝ) (p_i : ℝ × ℝ), PartialOdometerSlope h' = some p ∧ + PartialOdometerSlope (kS i s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (FordRecursiveQuadruple P (i + (2 : + Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) + - (↑(BandVectors.2 (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) + (FordRecursiveQuadruple P (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if + s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (FordRecursiveQuadruple P (i + + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + (1 : Fin (3 : ℕ))).succ)).re + : ℝ))) → (((FordRecursiveQuadruple P 1).1 ≠ 0) → (∃ p₀' pV, PartialOdometerSlope h' = + some p₀' ∧ PartialOdometerSlope (kS 0 true) = some pV ∧ pV.1 - p₀'.1 = (if true = + true then (1 : ℝ) else -1) * (1 / 2) * (((BandVectors.2 (FordRecursiveQuadruple P 3) + (FordRecursiveQuadruple P 2)).re : Int) - ((BandVectors.2 (FordRecursiveQuadruple P + 3) (FordRecursiveQuadruple P 2)).im : Int)) ∧ pV.2 - p₀'.2 = (if true = true then (1 + : ℝ) else -1) * (1 / 2) * (((BandVectors.2 (FordRecursiveQuadruple P 3) + (FordRecursiveQuadruple P 2)).im : Int) + ((BandVectors.2 (FordRecursiveQuadruple P + 3) (FordRecursiveQuadruple P 2)).re : Int)))) ) := by + classical + intro P h' kS hslope' hnonzero + rcases hslope' 0 true with hz | h + · exact False.elim (hnonzero hz) + · exact h + +private theorem hdk1' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (p' : Real × Real), (BandVectors.2 (FordRecursiveQuadruple + P 3) (FordRecursiveQuadruple P 2) = -(P.p₂ : GaussianInt)) → (∀ (p₀' : ℝ × ℝ), ∀ (pV + : ℝ × ℝ), (pV.1 - p₀'.1 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ)))).re : ℝ) - (↑(BandVectors.2 + (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (2 : Fin (4 : + ℕ)))).im : ℝ))) → ((p₀' = p') → ( + let t := pV + t.1 - p'.1 = -((P.p₂ : Real) / 2)))) ) := by + classical + intro P p' haslope32 p₀' pV hdk1 hp₀' t + rw [hp₀'] at hdk1 + rw [haslope32] at hdk1 + norm_num at hdk1 + dsimp [t] + linarith [hdk1] + +private theorem hdk2' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (p' : Real × Real), (BandVectors.2 (FordRecursiveQuadruple + P 3) (FordRecursiveQuadruple P 2) = -(P.p₂ : GaussianInt)) → (∀ (p₀' : ℝ × ℝ), ∀ (pV + : ℝ × ℝ), (pV.2 - p₀'.2 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ)))).im : ℝ) + (↑(BandVectors.2 + (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (2 : Fin (4 : + ℕ)))).re : ℝ))) → ((p₀' = p') → ( + let t := pV + t.2 - p'.2 = -((P.p₂ : Real) / 2)))) ) := by + classical + intro P p' haslope32 p₀' pV hdk2 hp₀' t + rw [hp₀'] at hdk2 + rw [haslope32] at hdk2 + norm_num at hdk2 + dsimp [t] + linarith [hdk2] + +private theorem hsl' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (p : Real × Real), ∀ (p' : Real × Real), (p' - p = + GaussianRealPoint (BandVectors.2 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))))) → ((BandVectors.2 + (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : + ℕ))) = ⟨P.p₁, P.p⟩) → (p' - p = ((P.p₁ : Real), (P.p₁ : Real) + P.p₂))) ) := by + classical + intro P p p' hsl ha10 + rw [ha10] at hsl + simpa [GaussianRealPoint, P.sum_p] using hsl + +private theorem hSlopeDiff : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (p : Real × Real), ∀ (p' : Real × Real), ∀ (pU : ℝ × ℝ), + let s := pU + (s.1 - p.1 = (P.p₂ : Real) / 2) → ((s.2 - p.2 = (P.p₂ : Real) / 2) → (∀ (pV : ℝ × ℝ), + let t := pV + (t.1 - p'.1 = -((P.p₂ : Real) / 2)) → ((t.2 - p'.2 = -((P.p₂ : Real) / 2)) → ((p' - p = + ((P.p₁ : Real), (P.p₁ : Real) + P.p₂)) → (t - s = GaussianRealPoint ⟨P.p₁ - P.p₂, + P.p₁⟩))))) ) := by + classical + intro P p p' pU s hdu1' hdu2' pV t hdk1' hdk2' hsl' + have hu1 := hdu1' + have hu2 := hdu2' + have hv1 := hdk1' + have hv2 := hdk2' + have hsl1 : p'.1 - p.1 = (P.p₁ : Real) := by + have hh := congrArg Prod.fst hsl' + simpa using hh + have hsl2 : p'.2 - p.2 = (P.p₁ : Real) + P.p₂ := by + have hh := congrArg Prod.snd hsl' + simpa using hh + dsimp [s] at hu1 hu2 + dsimp [t] at hv1 hv2 + have hd1 : pV.1 - pU.1 = (P.p₁ : Real) - P.p₂ := by + linarith [hu1, hv1, hsl1] + have hd2 : pV.2 - pU.2 = (P.p₁ : Real) := by + linarith [hu2, hv2, hsl2] + apply Prod.ext + · simpa [GaussianRealPoint, Int.cast_sub] using hd1 + · simpa [GaussianRealPoint] using hd2 + +end LargeFirstRestrictions + +theorem P4158T1LargeFirstRestrictions + (P : FordFareyParameter) (hq : ProperBandQuadruple (FordRecursiveQuadruple P)) + (C0 Ci : BandCircle) + (hC0 : FordRecursiveQuadruple P 0 = C0.1.1) + (hCi : FordRecursiveQuadruple P 1 = Ci.1.1) + (hlarge : 1 < Ci.1.1.1) (horder : P.q₂ < P.q₁) + (T T' : ProtoTile) (h h' : PartialOdometer) + (hO : TileOdometer C0.1.1 T h) (hO' : TileOdometer C0.1.1 T' h') + (p p' : Real × Real) + (hs : PartialOdometerSlope h = some p) + (hs' : PartialOdometerSlope h' = some p') + (hsl : p' - p = GaussianRealPoint + (BandVectors.2 (FordRecursiveQuadruple P 1) (FordRecursiveQuadruple P 0))) + (u : GaussianInt) + (hc : T.cells = (TileTranslation (FordTile P.q) u).cells) + (hc' : T'.cells = (TileTranslation (FordTile P.q) (u + ⟨P.q, P.q₁⟩)).cells) : + ∃ (U V : ProtoTile) (g k : PartialOdometer) (s t : Real × Real) + (Q : FordFareyParameter), + AncestorOdometer Ci.1.1 C0.1.1 U T g h ∧ + AncestorOdometer Ci.1.1 C0.1.1 V T' k h' ∧ + TileOdometer Ci.1.1 U g ∧ TileOdometer Ci.1.1 V k ∧ + PartialOdometerSlope g = some s ∧ PartialOdometerSlope k = some t ∧ + U.cells = (TileTranslation (FordTile P.q₁) (u + ⟨P.q₂, P.q₂⟩)).cells ∧ + V.cells = (TileTranslation (FordTile P.q₁) (u + ⟨P.q, P.q₁⟩)).cells ∧ + TileCentroid V - TileCentroid U = GaussianRealPoint ⟨P.q₁, (P.q₁ : Int) - P.q₂⟩ ∧ + t - s = GaussianRealPoint ⟨P.p₁ - P.p₂, P.p₁⟩ ∧ + Q.q = P.q₁ ∧ Q.q₁ = P.q₁ - P.q₂ ∧ Q.p = P.p₁ ∧ Q.p₁ = P.p₁ - P.p₂ ∧ + FordRecursiveQuadruple Q 0 = Ci.1.1 ∧ 1 < Q.q := by +-- BODY + classical + have hq1 : 1 < P.q₁ := LargeFirstRestrictions.hq1 P Ci horder + have hqgt := LargeFirstRestrictions.hqgt P Ci hq1 + have hroot : 1 < (FordRecursiveQuadruple P 0).1 := LargeFirstRestrictions.hroot P hqgt + have dec := TileOdometerReindexedDecomposition + (FordRecursiveQuadruple P) hq T h hroot (by simpa [hC0] using hO) + have dec' := TileOdometerReindexedDecomposition + (FordRecursiveQuadruple P) hq T' h' hroot (by simpa [hC0] using hO') + rcases dec with ⟨S, gS, hbandT, hsub, hcells, hfoot, hcent, hdom, hvalue, + hcompat, hslope⟩ + rcases dec' with ⟨S', kS, hbandT', hsub', hcells', hfoot', hcent', + hdom', hvalue', hcompat', hslope'⟩ + let U := S 0 false + let V := S' 0 true + let g := gS 0 false + let k := kS 0 true + have hUg : TileOdometer Ci.1.1 U g := by + simpa [U, g, ← hCi] using hsub 0 false + have hVk : TileOdometer Ci.1.1 V k := by + simpa [V, k, ← hCi] using hsub' 0 true + have hCiPos : 0 < Ci.1.1.1 := by omega + have hATU := LargeFirstRestrictions.hATU P hq C0 Ci hC0 hCi T S gS hbandT hfoot hcent hUg + have hATV := LargeFirstRestrictions.hATV P hq C0 Ci hC0 hCi T' S' kS hbandT' hfoot' hcent' hVk + have hAncU := LargeFirstRestrictions.hAncU P C0 Ci hC0 T h hO S gS hdom hvalue hUg hCiPos hATU + have hAncV := LargeFirstRestrictions.hAncV P C0 Ci hC0 T' h' hO' S' kS hdom' hvalue' hVk hCiPos + hATV + have hcross := LargeFirstRestrictions.hcross P + have hcop := LargeFirstRestrictions.hcop P hcross + let Q : FordFareyParameter := { + p := P.p₁ + q := P.q₁ + q_pos := by omega + reduced := hcop + p₁ := P.p₁ - P.p₂ + q₁ := P.q₁ - P.q₂ + p₂ := P.p₂ + q₂ := P.q₂ + sum_p := by omega + sum_q := by omega + det₁ := by + have hh := hcross + rw [Nat.cast_sub (by omega)] + nlinarith + det₂ := by + have hh := hcross + nlinarith + q₁_lt := by + exact Nat.sub_lt (by omega : 0 < P.q₁) P.q₂_pos + q₂_pos := P.q₂_pos + unit_case := by + intro hu + change P.q₁ = 1 at hu + omega } + have hQchild := LargeFirstRestrictions.hQchild P Ci hCi horder hq1 hcross hcop + have hQgt : 1 < Q.q := by simpa [Q] using hq1 + have hQband := (FordTileRecursiveIdentification Q).1 + have hQbandCi := LargeFirstRestrictions.hQbandCi P Ci horder hq1 hcross hcop hQchild hQband + have fcfg := (FordCoordinateConfiguration P).2 hqgt + rcases fcfg with ⟨_, hv10, hv20, _, ha10, _, _, ha32, _⟩ + let w := BandVectors.1 (FordRecursiveQuadruple P 3) + (FordRecursiveQuadruple P 2) + let x := BandVectors.1 (FordRecursiveQuadruple P 1) + (FordRecursiveQuadruple P 3) + let y := BandVectors.1 (FordRecursiveQuadruple P 2) + (FordRecursiveQuadruple P 1) + have hvsum : w + x + y = 0 := (VectorRecursionLaws + (FordRecursiveQuadruple P) hq.1).1 + have hvfirst := LargeFirstRestrictions.hvfirst P hq hv10 + have hvsecond := LargeFirstRestrictions.hvsecond P hq hv20 + have hvsol := LargeFirstRestrictions.hvsol P Ci horder hq1 hcross hcop hvsum hvfirst hvsecond + have haslope32 := LargeFirstRestrictions.haslope32 P ha32 + have fordCentroid (n : Nat) (hn : 0 < n) := LargeFirstRestrictions.fordCentroid P Ci horder hq1 + hcross hcop n hn + let Uc := TileTranslation (FordTile P.q₁) (u + ⟨P.q₂, P.q₂⟩) + let Vc := TileTranslation (FordTile P.q₁) (u + ⟨P.q, P.q₁⟩) + have hUcBand : BandPrototile Ci.1.1 Uc := + BandPrototileTranslation Ci.1.1 (FordTile P.q₁) + (u + ⟨P.q₂, P.q₂⟩) hQbandCi + have hVcBand : BandPrototile Ci.1.1 Vc := + BandPrototileTranslation Ci.1.1 (FordTile P.q₁) + (u + ⟨P.q, P.q₁⟩) hQbandCi + have rootNonempty (n : Nat) (hn : 0 < n) (z : GaussianInt) := + LargeFirstRestrictions.rootNonempty n hn z + have hrootCent := LargeFirstRestrictions.hrootCent P T u hc rootNonempty + have hrootCent' := LargeFirstRestrictions.hrootCent' P T' u hc' rootNonempty + have hw' := LargeFirstRestrictions.hw' P hvsol + have hUoffset := LargeFirstRestrictions.hUoffset P T S hcent hvsol + have hVoffset := LargeFirstRestrictions.hVoffset P T' S' hcent' hvsol + have hUCcent := LargeFirstRestrictions.hUCcent P Ci horder T u hq1 S hcross hcop fordCentroid + hrootCent hUoffset + have hVCcent := LargeFirstRestrictions.hVCcent P Ci horder T' u hq1 S' hcross hcop fordCentroid + hrootCent' hVoffset + have hUcells : U.cells = Uc.cells := + (BandPrototileCentroidUnique Ci.1.1 U Uc + (TileOdometerBandPrototile Ci.1.1 U g hUg) hUcBand hUCcent).1 + have hVcells : V.cells = Vc.cells := + (BandPrototileCentroidUnique Ci.1.1 V Vc + (TileOdometerBandPrototile Ci.1.1 V k hVk) hVcBand hVCcent).1 + have hcentUV := LargeFirstRestrictions.hcentUV P Ci horder u hq1 S S' hcross hcop fordCentroid + hUCcent hVCcent + have hnonzero := LargeFirstRestrictions.hnonzero P Ci horder hq1 hcross hcop + have hslopeUdata := LargeFirstRestrictions.hslopeUdata P h gS hslope hnonzero + obtain ⟨p₀, pU, hsp, hspU, hdu1, hdu2⟩ := hslopeUdata + have hp₀ : p₀ = p := Option.some.inj (hsp.symm.trans hs) + let s := pU + have hslopeU : PartialOdometerSlope g = some s := by + simpa [g, s] using hspU + have hdu1' := LargeFirstRestrictions.hdu1' P p haslope32 p₀ pU hdu1 hp₀ + have hdu2' := LargeFirstRestrictions.hdu2' P p haslope32 p₀ pU hdu2 hp₀ + have hslopeVdata := LargeFirstRestrictions.hslopeVdata P h' kS hslope' hnonzero + obtain ⟨p₀', pV, hsp', hspV, hdk1, hdk2⟩ := hslopeVdata + have hp₀' : p₀' = p' := Option.some.inj (hsp'.symm.trans hs') + let t := pV + have hslopeV : PartialOdometerSlope k = some t := by + simpa [k, t] using hspV + have hdk1' := LargeFirstRestrictions.hdk1' P p' haslope32 p₀' pV hdk1 hp₀' + have hdk2' := LargeFirstRestrictions.hdk2' P p' haslope32 p₀' pV hdk2 hp₀' + have hsl' := LargeFirstRestrictions.hsl' P p p' hsl ha10 + have hSlopeDiff := LargeFirstRestrictions.hSlopeDiff P p p' pU hdu1' hdu2' pV hdk1' hdk2' hsl' + refine ⟨U, V, g, k, s, t, Q, hAncU, hAncV, hUg, hVk, + hslopeU, hslopeV, ?_, ?_, hcentUV, hSlopeDiff, ?_, ?_, ?_, ?_, hQchild, hQgt⟩ + · simpa [Uc] using hUcells + · simpa [Vc] using hVcells + · rfl + · rfl + · rfl + · rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean new file mode 100644 index 0000000000..efc895f106 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean @@ -0,0 +1,1039 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P4158T1LargeSecondRestrictions] + +/-! +# P4158T1LargeSecondRestrictions + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace LargeSecondRestrictions + +private theorem hcurv : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), (FordRecursiveQuadruple P (2 : Fin (4 : + ℕ)) = Ci.1.1) → (((1 : ℤ) < Ci.1.1.1) → ((P.q₁ < P.q₂) → (∀ (T' : ProtoTile), ∀ (u : + GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) (u + ⟨-(↑P.q : ℤ), (↑P.q₂ : + ℤ)⟩)).cells) → (1 < P.q₂)))) ) := by + classical + intro P Ci hCi hlarge horder T' u hc' + have hlarge' : (1 : Int) < (P.q₂ * P.q₂ : Nat) := by + rw [← hCi] at hlarge + simpa [FordRecursiveQuadruple, FordCircleCoordinate] using hlarge + have hnat : 1 < P.q₂ * P.q₂ := by exact_mod_cast hlarge' + have hcast : (1 : Int) < (P.q₂ : Int) * P.q₂ := by exact_mod_cast hnat + by_contra hn + have hle : P.q₂ ≤ 1 := by omega + interval_cases P.q₂ <;> norm_num at hnat + +private theorem hqgt : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((1 < P.q₂) → (1 < P.q)) ) := by + classical + intro P Ci hcurv + have hsum := P.sum_q + omega + +private theorem hq0 : + (by + classical + exact + ∀ (P : FordFareyParameter), (1 < P.q) → (1 < (FordRecursiveQuadruple P 0).1) ) := by + classical + intro P hqgt + have hq0sq : (1 : Int) < (P.q * P.q : Nat) := by + have hqreal : (1 : Int) < P.q := by exact_mod_cast hqgt + have hqcast : (1 : Int) < (P.q : Int) * P.q := by nlinarith + exact_mod_cast hqcast + simpa [FordRecursiveQuadruple, FordCircleCoordinate] using hq0sq + +private theorem hUg : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), (FordRecursiveQuadruple P (2 : Fin (4 : + ℕ)) = Ci.1.1) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gfamily : Fin (3 : ℕ) → + Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer + (FordRecursiveQuadruple P i.succ) (S i s) (gfamily i s)) → ( + let U := S 1 false + let g := gfamily 1 false + TileOdometer Ci.1.1 U g)) ) := by + classical + intro P Ci hCi S gfamily hchild U g + rw [← hCi] + exact hchild 1 false + +private theorem hVk : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), (FordRecursiveQuadruple P (2 : Fin (4 : + ℕ)) = Ci.1.1) → (∀ (S₂ : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (kfamily : Fin (3 : ℕ) → + Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer + (FordRecursiveQuadruple P i.succ) (S₂ i s) (kfamily i s)) → ( + let V := S₂ 1 true + let k := kfamily 1 true + TileOdometer Ci.1.1 V k)) ) := by + classical + intro P Ci hCi S₂ kfamily hchild₂ V k + rw [← hCi] + exact hchild₂ 1 true + +private theorem hcross : + (by + classical + exact + ∀ (P : FordFareyParameter), P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 ) := by + classical + intro P + have hd := P.det₁ + rw [P.sum_q, P.sum_p] at hd + push_cast at hd + nlinarith + +private theorem hcross2 : + (by + classical + exact + ∀ (P : FordFareyParameter), (P.q₁ < P.q₂) → ((P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = + 1) → ((P.p₂ - P.p₁) * (P.q₂ : Int) - ((P.q₂ - P.q₁ : Nat) : Int) * P.p₂ = -1)) ) := by + classical + intro P horder hcross + have hcast : ((P.q₂ - P.q₁ : Nat) : Int) = P.q₂ - P.q₁ := by + exact_mod_cast (Nat.cast_sub horder.le) + rw [hcast] + nlinarith [hcross] + +private theorem hredchild : + (by + classical + exact + ∀ (P : FordFareyParameter), (P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1) → + (Nat.Coprime P.q₂ P.p₂.natAbs) ) := by + classical + intro P hcross + rw [Nat.coprime_iff_gcd_eq_one] + let d := Nat.gcd P.q₂ P.p₂.natAbs + have hdqN : d ∣ P.q₂ := by dsimp [d]; exact Nat.gcd_dvd_left _ _ + have hdpN : d ∣ P.p₂.natAbs := by dsimp [d]; exact Nat.gcd_dvd_right _ _ + have hdq : (d : Int) ∣ (P.q₂ : Int) := by exact_mod_cast hdqN + have hdp' : (d : Int) ∣ P.p₂ := by + apply (Int.dvd_natAbs).mp + exact_mod_cast hdpN + have hd1 : (d : Int) ∣ 1 := by + have hh : (d : Int) ∣ P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ := + dvd_sub (dvd_mul_of_dvd_right hdq P.p₁) + (dvd_mul_of_dvd_right hdp' (P.q₁ : Int)) + simpa [hcross] using hh + have hdint : (d : Int) = 1 := + Int.eq_one_of_dvd_one (by exact_mod_cast (Nat.zero_le d)) hd1 + have hdval : d = 1 := by exact_mod_cast hdint + simp [d, hdval] + +private theorem hfirst : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = ⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩) → + ((BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) = BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (1 : Fin (4 : + ℕ)))) → ( + let a := BandVectors.1 (FordRecursiveQuadruple P 1) (FordRecursiveQuadruple P 3) + let b := BandVectors.1 (FordRecursiveQuadruple P 2) (FordRecursiveQuadruple P 1) + a - (⟨0, 1⟩ : GaussianInt) * b = ⟨(P.q : Int), (P.q₁ : Int)⟩)) ) := by + classical + intro P h10 hrec a b + rw [← hrec] + exact h10 + +private theorem hsecond : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = ⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩) → ( + let w := BandVectors.1 (FordRecursiveQuadruple P 3) (FordRecursiveQuadruple P 2) + let b := BandVectors.1 (FordRecursiveQuadruple P 2) (FordRecursiveQuadruple P 1) + (BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 + : Fin (4 : ℕ))) = BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 + (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (2 : Fin (4 : + ℕ))) ∧ BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) = BandVectors.1 (FordRecursiveQuadruple + P (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : + ℤ)⟩ * BandVectors.1 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple + P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = BandVectors.2 + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (1 : Fin (4 : + ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (FordRecursiveQuadruple P (3 : Fin (4 : + ℕ))) (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) ∧ BandVectors.2 + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (3 : Fin (4 : + ℕ))) = BandVectors.2 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 + (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (2 : Fin (4 : + ℕ)))) → (b - (⟨0, 1⟩ : GaussianInt) * w = ⟨-(P.q : Int), (P.q₂ : Int)⟩)) ) := by + classical + intro P h20 w b hstep + simpa [w, b] using hstep.1.symm.trans h20 + +private theorem hv13 : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ( + let w := BandVectors.1 (FordRecursiveQuadruple P 3) (FordRecursiveQuadruple P 2) + let a := BandVectors.1 (FordRecursiveQuadruple P 1) (FordRecursiveQuadruple P 3) + let b := BandVectors.1 (FordRecursiveQuadruple P 2) (FordRecursiveQuadruple P 1) + (w + a + b = 0) → ((a - (⟨0, 1⟩ : GaussianInt) * b = ⟨(P.q : Int), (P.q₁ : Int)⟩) → ((b - + (⟨0, 1⟩ : GaussianInt) * w = ⟨-(P.q : Int), (P.q₂ : Int)⟩) → (((P.q : Int) = (P.q₁ : + Int) + (P.q₂ : Int)) → (a = ⟨(P.q₁ : Int), 0⟩))))) ) := by + classical + intro P Ci w a b hsum' hfirst hsecond hqsum + have hre := congrArg (fun z : GaussianInt => z.re) hsum' + have him := congrArg (fun z : GaussianInt => z.im) hsum' + have hfre := congrArg (fun z : GaussianInt => z.re) hfirst + have hfim := congrArg (fun z : GaussianInt => z.im) hfirst + have htre := congrArg (fun z : GaussianInt => z.re) hsecond + have htim := congrArg (fun z : GaussianInt => z.im) hsecond + simp [Zsqrtd.re_mul, Zsqrtd.im_mul] at hre him hfre hfim htre htim + have hreA : a.re = P.q₁ := by omega + have himA : a.im = 0 := by omega + apply Zsqrtd.ext <;> assumption + +private theorem hoffU : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S i s) - TileCentroid T = (if s = true + then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ))).1))) → ( + let U := S 1 false + let a := BandVectors.1 (FordRecursiveQuadruple P 1) (FordRecursiveQuadruple P 3) + (a = ⟨(P.q₁ : Int), 0⟩) → (TileCentroid U - TileCentroid T = (-(P.q₁ : Real) / 2, (P.q₁ : + Real) / 2))) ) := by + classical + intro P T S hcent U a hv13 + have h := hcent 1 false + have hvect : BandVectors.1 (FordRecursiveQuadruple P ((1 : Fin 3) + 2).succ) + (FordRecursiveQuadruple P ((1 : Fin 3) + 1).succ) = a := by + change BandVectors.1 (FordRecursiveQuadruple P 1) + (FordRecursiveQuadruple P 3) = a + rfl + rw [hvect, hv13] at h + have hh : TileCentroid (S 1 false) - TileCentroid T = + (-(2⁻¹ * (P.q₁ : Real)), 2⁻¹ * (P.q₁ : Real)) := by + simpa [GaussianRealPoint] using h + calc + TileCentroid U - TileCentroid T = + (-(2⁻¹ * (P.q₁ : Real)), 2⁻¹ * (P.q₁ : Real)) := by simpa [U] using hh + _ = (-(P.q₁ : Real) / 2, (P.q₁ : Real) / 2) := by ext <;> ring + +private theorem hoffV : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (S₂ : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S₂ i s) - TileCentroid T' = (if s = + true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ))).1))) → ( + let V := S₂ 1 true + let a := BandVectors.1 (FordRecursiveQuadruple P 1) (FordRecursiveQuadruple P 3) + (a = ⟨(P.q₁ : Int), 0⟩) → (TileCentroid V - TileCentroid T' = ((P.q₁ : Real) / 2, -(P.q₁ + : Real) / 2))) ) := by + classical + intro P T' S₂ hcent₂ V a hv13 + have h := hcent₂ 1 true + have hvect : BandVectors.1 (FordRecursiveQuadruple P ((1 : Fin 3) + 2).succ) + (FordRecursiveQuadruple P ((1 : Fin 3) + 1).succ) = a := by + change BandVectors.1 (FordRecursiveQuadruple P 1) + (FordRecursiveQuadruple P 3) = a + rfl + rw [hvect, hv13] at h + have hh : TileCentroid (S₂ 1 true) - TileCentroid T' = + (2⁻¹ * (P.q₁ : Real), -(2⁻¹ * (P.q₁ : Real))) := by + simpa [GaussianRealPoint] using h + calc + TileCentroid V - TileCentroid T' = + (2⁻¹ * (P.q₁ : Real), -(2⁻¹ * (P.q₁ : Real))) := by simpa [V] using hh + _ = ((P.q₁ : Real) / 2, -(P.q₁ : Real) / 2) := by ext <;> ring + +private theorem fordCentroid : + (by + classical + exact + (FordFareyParameter) → ((BandCircle) → (∀ (n : ℕ), (0 : ℕ) < n → TileCentroid (FordTile + n) = ((↑n : ℝ) / (2 : ℝ), (↑n : ℝ) / (2 : ℝ)))) ) := by + classical + intro P Ci n hn + let domain : Finset GaussianInt := FordCellDomain n + have hne : domain.Nonempty := by + refine ⟨⟨0, 0⟩, ?_⟩ + apply Finset.mem_image.mpr + exact ⟨(0, 0), Finset.mem_product.mpr ⟨by simpa using hn, by simpa using hn⟩, rfl⟩ + have hinj : Set.InjOn + (fun a : Nat × Nat => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) + ↑((Finset.range n).product (Finset.range n)) := by + intro a ha b hb hab + apply Prod.ext + · have he := congrArg (fun z : GaussianInt => z.re) hab + change (a.1 : Int) = (b.1 : Int) at he + exact_mod_cast he + · have he := congrArg (fun z : GaussianInt => z.im) hab + change (a.2 : Int) = (b.2 : Int) at he + exact_mod_cast he + have hcard : domain.card = n * n := by + calc + domain.card = ((Finset.range n).product (Finset.range n)).card := by + dsimp [domain, FordCellDomain] + exact Finset.card_image_iff.mpr hinj + _ = n * n := by simp + have hsumRe : domain.sum (fun z : GaussianInt => z.re) = + (n : Int) * ((n - 1 : Nat) : Int) / 2 * (n : Int) := by + have hrange : (Finset.range n).sum (fun x => (x : Int)) = + (n : Int) * ((n - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + simp? [domain, FordCellDomain, Finset.sum_product] + conv_lhs => rw [← Finset.mul_sum (Finset.range n) (fun x => (x : Int)) (n : Int)] + rw [hrange] + ring + have hsumIm : domain.sum (fun z : GaussianInt => z.im) = + (n : Int) * ((n - 1 : Nat) : Int) / 2 * (n : Int) := by + have hrange : (Finset.range n).sum (fun x => (x : Int)) = + (n : Int) * ((n - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + simp? [domain, FordCellDomain, Finset.sum_product] + rw [hrange] + ring + change (if domain.Nonempty then + ((↑(domain.sum (fun z : GaussianInt => z.re) : Int) / ↑domain.card + (1 / 2 : Real)), + (↑(domain.sum (fun z : GaussianInt => z.im) : Int) / ↑domain.card + (1 / 2 : Real))) else + _) = _ + rw [ite_eq_left hne, hcard, hsumRe, hsumIm] + norm_num + field_simp + have arith := Finset.sum_range_id_mul_two n + have rangeSum : (Finset.range n).sum (fun x => (x : Int)) = + (n : Int) * ((n - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + have arithCast : ((Finset.range n).sum (fun x => (x : Int))) * 2 = + (n : Int) * ((n - 1 : Nat) : Int) := by + rw [← Nat.cast_sum] + exact_mod_cast arith + rw [rangeSum] at arithCast + have hqcast : ((n - 1 : Nat) : Int) = (n : Int) - 1 := by omega + rw [hqcast] at arithCast + norm_num [Int.subNatNat, pow_two] + have natIdentity : n * (n - 1) / 2 * 2 + n = n * n := by + rw [← Finset.sum_range_id n] + rw [Finset.sum_range_id_mul_two] + rw [Nat.mul_sub_left_distrib] + simp only [Nat.mul_one] + have bound : n ≤ n * n := by + calc + n = n * 1 := by omega + _ ≤ n * n := Nat.mul_le_mul_left n (by omega) + rw [Nat.sub_add_cancel bound] + exact_mod_cast natIdentity + +private theorem rootCentroidEq : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), (T.cells = + (TileTranslation (FordTile P.q) u).cells) → (TileCentroid T = TileCentroid + (TileTranslation (FordTile P.q) u)) ) := by + classical + intro P T u hc + have hneF : (FordTile P.q).cells.Nonempty := by + refine ⟨0, ?_⟩ + apply Finset.mem_image.mpr + exact ⟨(0, 0), Finset.mem_product.mpr ⟨by simpa using P.q_pos, by simpa using P.q_pos⟩, rfl⟩ + have hzero : (0 : GaussianInt) ∈ (FordTile P.q).cells := by + apply Finset.mem_image.mpr + exact ⟨(0, 0), Finset.mem_product.mpr ⟨by simpa using P.q_pos, by simpa using P.q_pos⟩, rfl⟩ + have hneT : T.cells.Nonempty := by + rw [hc, (TileTranslationFormulas _ _).1] + exact ⟨GaussianTranslation u 0, Finset.mem_image.mpr ⟨0, hzero, rfl⟩⟩ + unfold TileCentroid + rw [ite_eq_left hneT, ite_eq_left (by rw [← hc]; exact hneT), hc] + +private theorem rootCentroid : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), (∀ (n : Nat), (0 < n) + → (TileCentroid (FordTile n) = ((n : Real) / 2, (n : Real) / 2))) → ((TileCentroid T + = TileCentroid (TileTranslation (FordTile P.q) u)) → (TileCentroid T = ((u.re : Real) + + (P.q : Real) / 2, (u.im : Real) + (P.q : Real) / 2))) ) := by + classical + intro P T u fordCentroid rootCentroidEq + rw [rootCentroidEq, (TileTranslationFormulas _ _).2.2.2.2.1, + fordCentroid P.q P.q_pos] + ext <;> simp <;> ring + +private theorem rootCentroidEq' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (T'.cells = + (TileTranslation (FordTile P.q) (u + ⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩)).cells) → ( + let v : GaussianInt := u + ⟨-(P.q : Int), P.q₂⟩ + TileCentroid T' = TileCentroid (TileTranslation (FordTile P.q) v)) ) := by + classical + intro P T' u hc' v + have hneF : (FordTile P.q).cells.Nonempty := by + refine ⟨0, ?_⟩ + apply Finset.mem_image.mpr + exact ⟨(0, 0), Finset.mem_product.mpr ⟨by simpa using P.q_pos, by simpa using P.q_pos⟩, rfl⟩ + have hzero : (0 : GaussianInt) ∈ (FordTile P.q).cells := by + apply Finset.mem_image.mpr + exact ⟨(0, 0), Finset.mem_product.mpr ⟨by simpa using P.q_pos, by simpa using P.q_pos⟩, rfl⟩ + have hneT : T'.cells.Nonempty := by + rw [hc', (TileTranslationFormulas _ _).1] + exact ⟨GaussianTranslation v 0, Finset.mem_image.mpr ⟨0, hzero, rfl⟩⟩ + unfold TileCentroid + rw [ite_eq_left hneT, ite_eq_left (by rw [← hc']; exact hneT), hc'] + +private theorem rootCentroid' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (∀ (n : Nat), (0 < + n) → (TileCentroid (FordTile n) = ((n : Real) / 2, (n : Real) / 2))) → ( + let v : GaussianInt := u + ⟨-(P.q : Int), P.q₂⟩ + (TileCentroid T' = TileCentroid (TileTranslation (FordTile P.q) v)) → (TileCentroid T' = + ((u.re : Real) - (P.q : Real) / 2, (u.im : Real) + (P.q₂ : Real) + (P.q : Real) / + 2))) ) := by + classical + intro P T' u fordCentroid v rootCentroidEq' + rw [rootCentroidEq', (TileTranslationFormulas _ _).2.2.2.2.1, + fordCentroid P.q P.q_pos] + simp [v, GaussianInt.intCast_re, GaussianInt.intCast_im, + Int.cast_add, Int.cast_neg, sub_eq_add_neg] + constructor <;> linarith + +private theorem hUcenter : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (S : Fin (3 : ℕ) → + Bool → ProtoTile), + let U := S 1 false + (TileCentroid U - TileCentroid T = (-(P.q₁ : Real) / 2, (P.q₁ : Real) / 2)) → + ((TileCentroid T = ((u.re : Real) + (P.q : Real) / 2, (u.im : Real) + (P.q : Real) / + 2)) → (((P.q : Real) = (P.q₁ : Real) + P.q₂) → (TileCentroid U = ((u.re : Real) + + (P.q₂ : Real) / 2, (u.im : Real) + (P.q₁ : Real) + (P.q₂ : Real) / 2)))) ) := by + classical + intro P T u S U hoffU rootCentroid hqreal + have hu1 := congrArg Prod.fst hoffU + have hu2 := congrArg Prod.snd hoffU + have ht1 := congrArg Prod.fst rootCentroid + have ht2 := congrArg Prod.snd rootCentroid + apply Prod.ext + · dsimp at hu1 ht1 ⊢ + linarith [hqreal] + · dsimp at hu2 ht2 ⊢ + linarith [hqreal] + +private theorem hVcenter : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), ∀ (S₂ : Fin (3 : ℕ) + → Bool → ProtoTile), + let V := S₂ 1 true + (TileCentroid V - TileCentroid T' = ((P.q₁ : Real) / 2, -(P.q₁ : Real) / 2)) → + ((TileCentroid T' = ((u.re : Real) - (P.q : Real) / 2, (u.im : Real) + (P.q₂ : Real) + + (P.q : Real) / 2)) → (((P.q : Real) = (P.q₁ : Real) + P.q₂) → (TileCentroid V = + ((u.re : Real) - (P.q₂ : Real) / 2, (u.im : Real) + 3 * (P.q₂ : Real) / 2)))) ) := by + classical + intro P T' u S₂ V hoffV rootCentroid' hqreal + have hv1 := congrArg Prod.fst hoffV + have hv2 := congrArg Prod.snd hoffV + have ht1 := congrArg Prod.fst rootCentroid' + have ht2 := congrArg Prod.snd rootCentroid' + apply Prod.ext + · dsimp at hv1 ht1 ⊢ + linarith [hqreal] + · dsimp at hv2 ht2 ⊢ + linarith [hqreal] + +private theorem hUcCentroid : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), (1 < P.q₂) → (∀ (S : Fin + (3 : ℕ) → Bool → ProtoTile), + let U := S 1 false + ((P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int)) → ((∀ (n : Nat), (0 < n) → (TileCentroid + (FordTile n) = ((n : Real) / 2, (n : Real) / 2))) → ((TileCentroid U = ((u.re : Real) + + (P.q₂ : Real) / 2, (u.im : Real) + (P.q₁ : Real) + (P.q₂ : Real) / 2)) → ( + let Uc := TileTranslation (FordTile P.q₂) (u + ⟨0, P.q₁⟩) + TileCentroid Uc = TileCentroid U))))) ) := by + classical + intro P Ci u hcurv S U hqsum fordCentroid hUcenter Uc + rw [hUcenter] + rw [(TileTranslationFormulas _ _).2.2.2.2.1, fordCentroid P.q₂ (by omega)] + simp [GaussianInt.intCast_re, GaussianInt.intCast_im] + constructor <;> linarith + +private theorem hVcCentroid : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), (1 < P.q₂) → (∀ (S₂ : + Fin (3 : ℕ) → Bool → ProtoTile), + let V := S₂ 1 true + ((P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int)) → ((∀ (n : Nat), (0 < n) → (TileCentroid + (FordTile n) = ((n : Real) / 2, (n : Real) / 2))) → ((TileCentroid V = ((u.re : Real) + - (P.q₂ : Real) / 2, (u.im : Real) + 3 * (P.q₂ : Real) / 2)) → ( + let Vc := TileTranslation (FordTile P.q₂) (u + ⟨-(P.q₂ : Int), P.q₂⟩) + TileCentroid Vc = TileCentroid V))))) ) := by + classical + intro P Ci u hcurv S₂ V hqsum fordCentroid hVcenter Vc + rw [hVcenter] + rw [(TileTranslationFormulas _ _).2.2.2.2.1, fordCentroid P.q₂ (by omega)] + simp [GaussianInt.intCast_re, GaussianInt.intCast_im] + constructor <;> linarith + +private theorem hQbase : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (horder : P.q₁ < P.q₂), ∀ (hcurv : 1 < + P.q₂), ∀ (hcross : P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1), ∀ (hcross2 : (P.p₂ + - P.p₁) * (P.q₂ : Int) - ((P.q₂ - P.q₁ : Nat) : Int) * P.p₂ = -1), ∀ (hredchild : + Nat.Coprime P.q₂ P.p₂.natAbs), + let Q : FordFareyParameter := { + p := P.p₂ + q := P.q₂ + q_pos := by omega + reduced := hredchild + p₁ := P.p₁ + q₁ := P.q₁ + p₂ := P.p₂ - P.p₁ + q₂ := P.q₂ - P.q₁ + sum_p := by ring + sum_q := by omega + det₁ := by simpa using hcross + det₂ := hcross2 + q₁_lt := horder + q₂_pos := by omega + unit_case := by intro hu; omega + } + (BandPrototile (FordCircleCoordinate Q.p Q.q) (FordTile Q.q) ∧ (Q.q = (1 : ℕ) → FordTile + Q.q = (⟨{(0 : LatticeCell)}, (0 : GaussianInt)⟩ : ProtoTile)) ∧ ((1 : ℕ) < Q.q + → ProperBandQuadruple (FordRecursiveQuadruple Q) ∧ ∃ (S : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence + (FordRecursiveQuadruple Q) (FordTile Q.q) i s (S i s)) ∧ (∀ (x : LatticeCell), x ∈ + (FordTile Q.q).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) ∧ (S (0 : + Fin (3 : ℕ)) true).cells = (FordTile Q.q₁).cells ∧ (S (0 : Fin (3 : ℕ)) false).cells + = (TileTranslation (FordTile Q.q₁) ⟨(↑Q.q₂ : ℤ), (↑Q.q₂ : ℤ)⟩).cells ∧ (S (1 : Fin (3 + : ℕ)) true).cells = (TileTranslation (FordTile Q.q₂) ⟨(↑Q.q₁ : ℤ), (0 : ℤ)⟩).cells ∧ + (S (1 : Fin (3 : ℕ)) false).cells = (TileTranslation (FordTile Q.q₂) ⟨(0 : ℤ), (↑Q.q₁ + : ℤ)⟩).cells ∧ (S (2 : Fin (3 : ℕ)) true).cells = ∅ ∧ (S (2 : Fin (3 : ℕ)) + true).anchor = ⟨(↑Q.q₂ : ℤ), (↑Q.q : ℤ)⟩ ∧ (S (2 : Fin (3 : ℕ)) false).cells = ∅ ∧ (S + (2 : Fin (3 : ℕ)) false).anchor = ⟨(↑Q.q₁ : ℤ), (0 : ℤ)⟩)) → ((FordCircleCoordinate + Q.p Q.q = Ci.1.1) → (BandPrototile Ci.1.1 (FordTile P.q₂))) ) := by + classical + intro P Ci horder hcurv hcross hcross2 hredchild Q hQrec hQcircle + have hbase := hQrec.1 + rw [hQcircle] at hbase + simpa [Q] using hbase + +private theorem hUcBand : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (u : GaussianInt), + let Uc := TileTranslation (FordTile P.q₂) (u + ⟨0, P.q₁⟩) + (BandPrototile Ci.1.1 (FordTile P.q₂)) → (BandPrototile Ci.1.1 Uc) ) := by + classical + intro P Ci u Uc hQbase + simpa [Uc] using BandPrototileTranslation Ci.1.1 (FordTile P.q₂) + (u + ⟨0, P.q₁⟩) hQbase + +private theorem hVcBand : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (u : GaussianInt), + let Vc := TileTranslation (FordTile P.q₂) (u + ⟨-(P.q₂ : Int), P.q₂⟩) + (BandPrototile Ci.1.1 (FordTile P.q₂)) → (BandPrototile Ci.1.1 Vc) ) := by + classical + intro P Ci u Vc hQbase + simpa [Vc] using BandPrototileTranslation Ci.1.1 (FordTile P.q₂) + (u + ⟨-(P.q₂ : Int), P.q₂⟩) hQbase + +private theorem hveca : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandVectors.2 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) = ⟨(0 : ℤ), P.p₁⟩) → (BandVectors.2 + (FordRecursiveQuadruple P ((1 : Fin 3) + 2).succ) (FordRecursiveQuadruple P ((1 : Fin + 3) + 1).succ) = (⟨0, P.p₁⟩ : GaussianInt)) ) := by + classical + intro P ha13 + change BandVectors.2 (FordRecursiveQuadruple P 1) + (FordRecursiveQuadruple P 3) = _ + exact ha13 + +private theorem hcurvNZ : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((FordRecursiveQuadruple P 2).1 ≠ 0) ) := by + classical + intro P Ci + have hpNat : 0 < P.q₂ * P.q₂ := Nat.mul_pos P.q₂_pos P.q₂_pos + have hpInt : (0 : Int) < (P.q₂ * P.q₂ : Nat) := by exact_mod_cast hpNat + have hp : 0 < (FordRecursiveQuadruple P 2).1 := by + simpa [FordRecursiveQuadruple, FordCircleCoordinate] using hpInt + omega + +private theorem hpRootU : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (p : Real × Real), (PartialOdometerSlope h = some p) → (∀ + (pRootU : ℝ × ℝ), (PartialOdometerSlope h = some pRootU) → (pRootU = p)) ) := by + classical + intro h p hs pRootU hrootU + apply Option.some.inj + exact hrootU.symm.trans hs + +private theorem hUoffSlope : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (p : Real × Real), ∀ (pU : ℝ × ℝ), (pU.1 - p.1 = (1 / 2 : + ℝ) * (↑P.p₁ : ℝ)) → ((pU.2 - p.2 = -((1 / 2 : ℝ) * (↑P.p₁ : ℝ))) → (pU.1 - p.1 = + (P.p₁ : Real) / 2 ∧ pU.2 - p.2 = -(P.p₁ : Real) / 2)) ) := by + classical + intro P p pU hxU hyU + constructor <;> linarith + +private theorem hpRootV : + (by + classical + exact + ∀ (h' : PartialOdometer), ∀ (p' : Real × Real), (PartialOdometerSlope h' = some p') → (∀ + (pRootV : ℝ × ℝ), (PartialOdometerSlope h' = some pRootV) → (pRootV = p')) ) := by + classical + intro h' p' hs' pRootV hrootV + apply Option.some.inj + exact hrootV.symm.trans hs' + +private theorem hVoffSlope : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (p' : Real × Real), ∀ (pV : ℝ × ℝ), (pV.1 - p'.1 = -((1 / 2 + : ℝ) * (↑P.p₁ : ℝ))) → ((pV.2 - p'.2 = (1 / 2 : ℝ) * (↑P.p₁ : ℝ)) → (pV.1 - p'.1 = + -(P.p₁ : Real) / 2 ∧ pV.2 - p'.2 = (P.p₁ : Real) / 2)) ) := by + classical + intro P p' pV hxV hyV + constructor <;> linarith + +private theorem hslForm : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (p : Real × Real), ∀ (p' : Real × Real), (p' - p = + GaussianRealPoint (BandVectors.2 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))))) → ((BandVectors.2 + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : + ℕ))) = ⟨P.p₂, -P.p⟩) → (p' - p = ((P.p₂ : Real), -(P.p : Real)))) ) := by + classical + intro P p p' hsl ha20 + rw [ha20] at hsl + simpa [GaussianRealPoint] using hsl + +private theorem hslopediff : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (p : Real × Real), ∀ (p' : Real × Real), ∀ (pU : ℝ × ℝ), + (pU.1 - p.1 = (1 / 2 : ℝ) * (↑P.p₁ : ℝ)) → ((pU.2 - p.2 = -((1 / 2 : ℝ) * (↑P.p₁ : + ℝ))) → ((pU.1 - p.1 = (P.p₁ : Real) / 2 ∧ pU.2 - p.2 = -(P.p₁ : Real) / 2) → (∀ (pV : + ℝ × ℝ), (pV.1 - p'.1 = -((1 / 2 : ℝ) * (↑P.p₁ : ℝ))) → ((pV.2 - p'.2 = (1 / 2 : ℝ) * + (↑P.p₁ : ℝ)) → ((pV.1 - p'.1 = -(P.p₁ : Real) / 2 ∧ pV.2 - p'.2 = (P.p₁ : Real) / 2) + → ((p' - p = ((P.p₂ : Real), -(P.p : Real))) → ( + let s : Real × Real := pU + let t : Real × Real := pV + t - s = GaussianRealPoint ⟨P.p₂ - P.p₁, -P.p₂⟩))))))) ) := by + classical + intro P p p' pU hxU hyU hUoffSlope pV hxV hyV hVoffSlope hslForm s t + apply Prod.ext + · dsimp [s, t] + have := hUoffSlope.1 + have := hVoffSlope.1 + have hp := congrArg Prod.fst hslForm + dsimp at hp + simp [GaussianRealPoint] + linarith + · dsimp [s, t] + have := hUoffSlope.2 + have := hVoffSlope.2 + have hp := congrArg Prod.snd hslForm + dsimp at hp + simp [GaussianRealPoint] + have hpsum : (P.p : Real) = (P.p₁ : Real) + (P.p₂ : Real) := by + exact_mod_cast P.sum_p + linarith + +private theorem hcentdiff : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (u : GaussianInt), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + ∀ (S₂ : Fin (3 : ℕ) → Bool → ProtoTile), + let U := S 1 false + let V := S₂ 1 true + (TileCentroid U = ((u.re : Real) + (P.q₂ : Real) / 2, (u.im : Real) + (P.q₁ : Real) + + (P.q₂ : Real) / 2)) → ((TileCentroid V = ((u.re : Real) - (P.q₂ : Real) / 2, (u.im : + Real) + 3 * (P.q₂ : Real) / 2)) → (TileCentroid V - TileCentroid U = + GaussianRealPoint ⟨-(P.q₂ : Int), (P.q₂ : Int) - P.q₁⟩)) ) := by + classical + intro P u S S₂ U V hUcenter hVcenter + rw [hVcenter, hUcenter] + simp [GaussianRealPoint] + constructor <;> ring + +private theorem hrootpos : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), (FordRecursiveQuadruple P (0 : Fin (4 : + ℕ)) = C0.1.1) → (0 < C0.1.1.1) ) := by + classical + intro P C0 hC0 + rw [← hC0] + have hp : (0 : Int) < (P.q * P.q : Nat) := by + have hqn : 0 < P.q := P.q_pos + exact_mod_cast (Nat.mul_pos hqn hqn) + simpa [FordRecursiveQuadruple, FordCircleCoordinate] using hp + +private theorem hATU : + (by + classical + exact + ∀ (P : FordFareyParameter), (ProperBandQuadruple (FordRecursiveQuadruple P)) → (∀ (C0 : + BandCircle), ∀ (Ci : BandCircle), (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)) = + C0.1.1) → ((FordRecursiveQuadruple P (2 : Fin (4 : ℕ)) = Ci.1.1) → (∀ (T : + ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gfamily : Fin (3 : ℕ) → Bool → + PartialOdometer), (BandPrototile (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) T) → + ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), FootprintVertices (S i s) ⊆ FootprintVertices T) + → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S i s) - TileCentroid T = (if s + = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (i + + (1 : Fin (3 : ℕ))).succ))).1))) → ( + let U := S 1 false + let g := gfamily 1 false + (TileOdometer Ci.1.1 U g) → (AncestorTile Ci.1.1 C0.1.1 U T))))))) ) := by + classical + intro P hq C0 Ci hC0 hCi T S gfamily hband hfoot hcent U g hUg + change Relation.ReflTransGen _ (Ci.1.1, U) (C0.1.1, T) + apply Relation.ReflTransGen.single + refine ⟨FordRecursiveQuadruple P, 1, false, hq, ?_, ?_, + (by simpa [hC0] using hband), TileOdometerBandPrototile Ci.1.1 U g hUg, + hfoot 1 false, hcent 1 false⟩ + · exact hC0 + · exact hCi + +private theorem hATV : + (by + classical + exact + ∀ (P : FordFareyParameter), (ProperBandQuadruple (FordRecursiveQuadruple P)) → (∀ (C0 : + BandCircle), ∀ (Ci : BandCircle), (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)) = + C0.1.1) → ((FordRecursiveQuadruple P (2 : Fin (4 : ℕ)) = Ci.1.1) → (∀ (T' : + ProtoTile), ∀ (S₂ : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (kfamily : Fin (3 : ℕ) → Bool + → PartialOdometer), (BandPrototile (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) T') → + ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), FootprintVertices (S₂ i s) ⊆ FootprintVertices + T') → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S₂ i s) - TileCentroid T' = + (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) + (FordRecursiveQuadruple P (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) + (FordRecursiveQuadruple P (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint + (BandVectors.1 (FordRecursiveQuadruple P (i + (2 : Fin (3 : ℕ))).succ) + (FordRecursiveQuadruple P (i + (1 : Fin (3 : ℕ))).succ))).1))) → ( + let V := S₂ 1 true + let k := kfamily 1 true + (TileOdometer Ci.1.1 V k) → (AncestorTile Ci.1.1 C0.1.1 V T'))))))) ) := by + classical + intro P hq C0 Ci hC0 hCi T' S₂ kfamily hband₂ hfoot₂ hcent₂ V k hVk + change Relation.ReflTransGen _ (Ci.1.1, V) (C0.1.1, T') + apply Relation.ReflTransGen.single + refine ⟨FordRecursiveQuadruple P, 1, true, hq, ?_, ?_, + (by simpa [hC0] using hband₂), TileOdometerBandPrototile Ci.1.1 V k hVk, + hfoot₂ 1 true, hcent₂ 1 true⟩ + · exact hC0 + · exact hCi + +private theorem hAncU : + (by + classical + exact + ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), + (TileOdometer C0.1.1 T h) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gfamily : Fin + (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + FootprintVertices (S i s) ⊆ FootprintVertices T) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), ∀ x ∈ (gfamily i s).domain, h.value x = (gfamily i s).value x) → ( + let U := S 1 false + let g := gfamily 1 false + ((h.domain : Set GaussianInt) = FootprintVertices T) → (((g.domain : Set GaussianInt) = + FootprintVertices U) → ((AncestorTile Ci.1.1 C0.1.1 U T) → (AncestorOdometer Ci.1.1 + C0.1.1 U T g h)))))) ) := by + classical + intro C0 Ci T h hO S gfamily hfoot hvalues U g hrootDom hdomU hATU + refine ⟨hO, hATU, hdomU, ?_, ?_⟩ + · calc + (g.domain : Set GaussianInt) = FootprintVertices U := hdomU + _ ⊆ FootprintVertices T := hfoot 1 false + _ = (h.domain : Set GaussianInt) := hrootDom.symm + · intro x hx + exact (hvalues 1 false x hx).symm + +private theorem hAncV : + (by + classical + exact + ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), + (TileOdometer C0.1.1 T' h') → (∀ (S₂ : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (kfamily : + Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + FootprintVertices (S₂ i s) ⊆ FootprintVertices T') → ((∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), ∀ x ∈ (kfamily i s).domain, h'.value x = (kfamily i s).value x) → ( + let V := S₂ 1 true + let k := kfamily 1 true + ((h'.domain : Set GaussianInt) = FootprintVertices T') → (((k.domain : Set GaussianInt) = + FootprintVertices V) → ((AncestorTile Ci.1.1 C0.1.1 V T') → (AncestorOdometer Ci.1.1 + C0.1.1 V T' k h')))))) ) := by + classical + intro C0 Ci T' h' hO' S₂ kfamily hfoot₂ hvalues₂ V k hrootDom' hdomV hATV + refine ⟨hO', hATV, hdomV, ?_, ?_⟩ + · calc + (k.domain : Set GaussianInt) = FootprintVertices V := hdomV + _ ⊆ FootprintVertices T' := hfoot₂ 1 true + _ = (h'.domain : Set GaussianInt) := hrootDom'.symm + · intro x hx + exact (hvalues₂ 1 true x hx).symm + +end LargeSecondRestrictions + +theorem P4158T1LargeSecondRestrictions + (P : FordFareyParameter) (hq : ProperBandQuadruple (FordRecursiveQuadruple P)) + (C0 Ci : BandCircle) + (hC0 : FordRecursiveQuadruple P 0 = C0.1.1) + (hCi : FordRecursiveQuadruple P 2 = Ci.1.1) + (hlarge : 1 < Ci.1.1.1) (horder : P.q₁ < P.q₂) + (T T' : ProtoTile) (h h' : PartialOdometer) + (hO : TileOdometer C0.1.1 T h) (hO' : TileOdometer C0.1.1 T' h') + (p p' : Real × Real) + (hs : PartialOdometerSlope h = some p) + (hs' : PartialOdometerSlope h' = some p') + (hsl : p' - p = GaussianRealPoint + (BandVectors.2 (FordRecursiveQuadruple P 2) (FordRecursiveQuadruple P 0))) + (u : GaussianInt) + (hc : T.cells = (TileTranslation (FordTile P.q) u).cells) + (hc' : T'.cells = (TileTranslation (FordTile P.q) (u + ⟨-(P.q : Int), P.q₂⟩)).cells) : + ∃ (U V : ProtoTile) (g k : PartialOdometer) (s t : Real × Real) + (Q : FordFareyParameter), + AncestorOdometer Ci.1.1 C0.1.1 U T g h ∧ + AncestorOdometer Ci.1.1 C0.1.1 V T' k h' ∧ + TileOdometer Ci.1.1 U g ∧ TileOdometer Ci.1.1 V k ∧ + PartialOdometerSlope g = some s ∧ PartialOdometerSlope k = some t ∧ + U.cells = (TileTranslation (FordTile P.q₂) (u + ⟨0, P.q₁⟩)).cells ∧ + V.cells = (TileTranslation (FordTile P.q₂) (u + ⟨-(P.q₂ : Int), P.q₂⟩)).cells ∧ + TileCentroid V - TileCentroid U = GaussianRealPoint ⟨-(P.q₂ : Int), (P.q₂ : Int) - P.q₁⟩ ∧ + t - s = GaussianRealPoint ⟨P.p₂ - P.p₁, -P.p₂⟩ ∧ + Q.q = P.q₂ ∧ Q.q₂ = P.q₂ - P.q₁ ∧ Q.p = P.p₂ ∧ Q.p₂ = P.p₂ - P.p₁ ∧ + FordRecursiveQuadruple Q 0 = Ci.1.1 ∧ 1 < Q.q := by +-- BODY + classical + have hcurv := LargeSecondRestrictions.hcurv P Ci hCi hlarge horder T' u hc' + have hqgt := LargeSecondRestrictions.hqgt P Ci hcurv + have hq0 : 1 < (FordRecursiveQuadruple P 0).1 := LargeSecondRestrictions.hq0 P hqgt + have hd := TileOdometerReindexedDecomposition + (FordRecursiveQuadruple P) hq T h hq0 (by simpa [hC0] using hO) + rcases hd with ⟨S, gfamily, hband, hchild, hcells, hfoot, hcent, + hdomains, hvalues, hcompatible, hslope⟩ + have hd' := TileOdometerReindexedDecomposition + (FordRecursiveQuadruple P) hq T' h' hq0 (by simpa [hC0] using hO') + rcases hd' with ⟨S₂, kfamily, hband₂, hchild₂, hcells₂, hfoot₂, hcent₂, + hdomains₂, hvalues₂, hcompatible₂, hslope₂⟩ + let U := S 1 false + let V := S₂ 1 true + let g := gfamily 1 false + let k := kfamily 1 true + have hUg := LargeSecondRestrictions.hUg P Ci hCi S gfamily hchild + have hVk := LargeSecondRestrictions.hVk P Ci hCi S₂ kfamily hchild₂ + have hcross : P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 := LargeSecondRestrictions.hcross P + have hcross2 := LargeSecondRestrictions.hcross2 P horder hcross + have hredchild := LargeSecondRestrictions.hredchild P hcross + let Q : FordFareyParameter := { + p := P.p₂ + q := P.q₂ + q_pos := by omega + reduced := hredchild + p₁ := P.p₁ + q₁ := P.q₁ + p₂ := P.p₂ - P.p₁ + q₂ := P.q₂ - P.q₁ + sum_p := by ring + sum_q := by omega + det₁ := by simpa using hcross + det₂ := hcross2 + q₁_lt := horder + q₂_pos := by omega + unit_case := by intro hu; omega + } + have hvconfig := (FordCoordinateConfiguration P).2 hqgt + rcases hvconfig with ⟨hproper, h10, h20, h30, ha10, ha20, ha30, ha32, ha13⟩ + have vSystem : RecursiveVectorSystem BandVectors := by + simpa [BandVectors] using (Classical.choose_spec RecursiveVectorsExistUnique).1 + rcases vSystem with ⟨_, _, vstep, _⟩ + have vlaws := VectorRecursionLaws (FordRecursiveQuadruple P) hq.1 + rcases vlaws with ⟨hsum, _, hrec, _⟩ + let w := BandVectors.1 (FordRecursiveQuadruple P 3) (FordRecursiveQuadruple P 2) + let a := BandVectors.1 (FordRecursiveQuadruple P 1) (FordRecursiveQuadruple P 3) + let b := BandVectors.1 (FordRecursiveQuadruple P 2) (FordRecursiveQuadruple P 1) + have hsum' : w + a + b = 0 := by simpa [w, a, b] using hsum + have hfirst := LargeSecondRestrictions.hfirst P h10 hrec + have hstep := vstep (FordRecursiveQuadruple P) hq.1 + have hsecond := LargeSecondRestrictions.hsecond P h20 hstep + have hqsum : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by + exact_mod_cast P.sum_q + have hv13 := LargeSecondRestrictions.hv13 P Ci hsum' hfirst hsecond hqsum + have hoffU := LargeSecondRestrictions.hoffU P T S hcent hv13 + have hoffV := LargeSecondRestrictions.hoffV P T' S₂ hcent₂ hv13 + have fordCentroid (n : Nat) (hn : 0 < n) := LargeSecondRestrictions.fordCentroid P Ci n hn + have rootCentroidEq := LargeSecondRestrictions.rootCentroidEq P T u hc + have rootCentroid := LargeSecondRestrictions.rootCentroid P T u fordCentroid rootCentroidEq + let v : GaussianInt := u + ⟨-(P.q : Int), P.q₂⟩ + have rootCentroidEq' := LargeSecondRestrictions.rootCentroidEq' P T' u hc' + have rootCentroid' := LargeSecondRestrictions.rootCentroid' P T' u fordCentroid rootCentroidEq' + have hqreal : (P.q : Real) = (P.q₁ : Real) + P.q₂ := by exact_mod_cast P.sum_q + have hUcenter := LargeSecondRestrictions.hUcenter P T u S hoffU rootCentroid hqreal + have hVcenter := LargeSecondRestrictions.hVcenter P T' u S₂ hoffV rootCentroid' hqreal + let Uc := TileTranslation (FordTile P.q₂) (u + ⟨0, P.q₁⟩) + let Vc := TileTranslation (FordTile P.q₂) (u + ⟨-(P.q₂ : Int), P.q₂⟩) + have hUcCentroid := LargeSecondRestrictions.hUcCentroid P Ci u hcurv S hqsum fordCentroid hUcenter + have hVcCentroid := LargeSecondRestrictions.hVcCentroid P Ci u hcurv S₂ hqsum fordCentroid + hVcenter + have hQrec := FordTileRecursiveIdentification Q + have hQcircle : FordCircleCoordinate Q.p Q.q = Ci.1.1 := by + simpa [FordRecursiveQuadruple, Q] using hCi + have hQbase := LargeSecondRestrictions.hQbase P Ci horder hcurv hcross hcross2 hredchild hQrec + hQcircle + have hUcBand := LargeSecondRestrictions.hUcBand P Ci u hQbase + have hVcBand := LargeSecondRestrictions.hVcBand P Ci u hQbase + have hUcells : U.cells = Uc.cells := + (BandPrototileCentroidUnique Ci.1.1 U Uc + (TileOdometerBandPrototile Ci.1.1 U g hUg) hUcBand hUcCentroid.symm).1 + have hVcells : V.cells = Vc.cells := + (BandPrototileCentroidUnique Ci.1.1 V Vc + (TileOdometerBandPrototile Ci.1.1 V k hVk) hVcBand hVcCentroid.symm).1 + have hveca : BandVectors.2 (FordRecursiveQuadruple P ((1 : Fin 3) + 2).succ) + (FordRecursiveQuadruple P ((1 : Fin 3) + 1).succ) = + (⟨0, P.p₁⟩ : GaussianInt) := LargeSecondRestrictions.hveca P ha13 + have hcurvNZ := LargeSecondRestrictions.hcurvNZ P Ci + obtain hzU | ⟨pRootU, pU, hrootU, hsU, hxU, hyU⟩ := hslope 1 false + · exact (hcurvNZ hzU).elim + have hpRootU := LargeSecondRestrictions.hpRootU h p hs pRootU hrootU + subst pRootU + rw [hveca] at hxU hyU + norm_num at hxU hyU + have hUoffSlope := LargeSecondRestrictions.hUoffSlope P p pU hxU hyU + obtain hzV | ⟨pRootV, pV, hrootV, hsV, hxV, hyV⟩ := hslope₂ 1 true + · exact (hcurvNZ hzV).elim + have hpRootV := LargeSecondRestrictions.hpRootV h' p' hs' pRootV hrootV + subst pRootV + rw [hveca] at hxV hyV + norm_num at hxV hyV + have hVoffSlope := LargeSecondRestrictions.hVoffSlope P p' pV hxV hyV + have hslForm := LargeSecondRestrictions.hslForm P p p' hsl ha20 + let s : Real × Real := pU + let t : Real × Real := pV + have hslopes : PartialOdometerSlope g = some s ∧ PartialOdometerSlope k = some t := by + exact ⟨by simpa [g, s] using hsU, by simpa [k, t] using hsV⟩ + have hslopediff := LargeSecondRestrictions.hslopediff P p p' pU hxU hyU hUoffSlope pV hxV hyV + hVoffSlope hslForm + have hcentdiff := LargeSecondRestrictions.hcentdiff P u S S₂ hUcenter hVcenter + have hrootpos := LargeSecondRestrictions.hrootpos P C0 hC0 + have hrootpos' : 0 < C0.1.1.1 := hrootpos + have hrootDom : (h.domain : Set GaussianInt) = FootprintVertices T := + PositiveCurvatureTileOdometerDomain C0.1.1 T h hrootpos hO + have hrootDom' : (h'.domain : Set GaussianInt) = FootprintVertices T' := + PositiveCurvatureTileOdometerDomain C0.1.1 T' h' hrootpos' hO' + have hchildpos : 0 < Ci.1.1.1 := by omega + have hdomU : (g.domain : Set GaussianInt) = FootprintVertices U := + PositiveCurvatureTileOdometerDomain Ci.1.1 U g hchildpos hUg + have hdomV : (k.domain : Set GaussianInt) = FootprintVertices V := + PositiveCurvatureTileOdometerDomain Ci.1.1 V k hchildpos hVk + have hATU := LargeSecondRestrictions.hATU P hq C0 Ci hC0 hCi T S gfamily hband hfoot hcent hUg + have hATV := LargeSecondRestrictions.hATV P hq C0 Ci hC0 hCi T' S₂ kfamily hband₂ hfoot₂ hcent₂ + hVk + have hAncU := LargeSecondRestrictions.hAncU C0 Ci T h hO S gfamily hfoot hvalues hrootDom hdomU + hATU + have hAncV := LargeSecondRestrictions.hAncV C0 Ci T' h' hO' S₂ kfamily hfoot₂ hvalues₂ + hrootDom' hdomV hATV + refine ⟨U, V, g, k, s, t, Q, hAncU, hAncV, hUg, hVk, + hslopes.1, hslopes.2, ?_, ?_, hcentdiff, hslopediff, + rfl, rfl, rfl, rfl, hQcircle, ?_⟩ + · simpa [Uc] using hUcells + · simpa [Vc] using hVcells + · exact hcurv + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean new file mode 100644 index 0000000000..f38bc9774e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean @@ -0,0 +1,738 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain + +-- [TABLET NODE: P4158T1MatchedFordPair] + +/-! +# P4158T1MatchedFordPair + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace MatchedFordGeometry + +private theorem hidx : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P + i.succ = Ci.1.1) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ((1 : ℤ) < Ci.1.1.1) → + ((TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))))) → (i + ≠ 2))) ) := by + classical + intro P Ci i hCi T T' hlarge hcent hi + subst i + have hc := congrArg (fun x : CircleCoordinates => x.1) hCi + simp [FordRecursiveQuadruple] at hc + linarith + +private theorem hqgt : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P + i.succ = Ci.1.1) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ((1 : ℤ) < Ci.1.1.1) → + ((TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))))) → + ((i ≠ 2) → (1 < P.q)))) ) := by + classical + intro P Ci i hCi T T' hlarge hcent hidx + have hsumq : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by + exact_mod_cast P.sum_q + have hc := congrArg (fun x : CircleCoordinates => x.1) hCi + simp? [FordRecursiveQuadruple, FordCircleCoordinate] at hc + have : 1 < P.q := by + fin_cases i + · simp? [] at hc + split at hc + · norm_num at hc + exact (by omega : False).elim + · have hq : 1 < P.q₁ := by nlinarith [hlarge, hc] + have hqNat : 1 < P.q₁ := by exact_mod_cast hq + omega + · simp? [] at hc + have hq : 1 < P.q₂ := by nlinarith [hlarge, hc] + have hqNat : 1 < P.q₂ := by exact_mod_cast hq + omega + · exact (hidx rfl).elim + exact this + +private theorem hrpos : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((1 < P.q) → (0 < P.q₁)) ) := by + classical + intro P Ci hqgt + by_contra hn + have hz : P.q₁ = 0 := by omega + have hd := P.det₁ + rw [hz] at hd + simp at hd + have hdvd : (P.q : Int) ∣ 1 := ⟨P.p₁, by nlinarith⟩ + have hone : (P.q : Int) = 1 := Int.eq_one_of_dvd_one (by omega) hdvd + exact (by omega : False).elim + +private theorem hneq : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P + i.succ = Ci.1.1) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ((1 : ℤ) < Ci.1.1.1) → + ((TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))))) → + ((i ≠ 2) → ((0 < P.q₁) → ((0 < P.q₂) → (P.q₁ ≠ P.q₂)))))) ) := by + classical + intro P Ci i hCi T T' hlarge hcent hidx hrpos hspos heq + have hcross : P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 := by + have h := P.det₁ + rw [P.sum_q, P.sum_p] at h + push_cast at h + nlinarith + rw [heq] at hcross + have hone : (P.q₁ : Int) ∣ 1 := ⟨P.p₁ - P.p₂, by nlinarith⟩ + have hqone : P.q₁ = 1 := by + have hz := Int.eq_one_of_dvd_one (by exact_mod_cast (Nat.zero_le P.q₁)) hone + exact_mod_cast hz + have hselected : 1 < P.q₁ := by + fin_cases i + · have hc := congrArg (fun x : CircleCoordinates => x.1) hCi + simp? [FordRecursiveQuadruple, FordCircleCoordinate] at hc + split at hc + · norm_num at hc + exact (by omega : False).elim + · have hh : 1 < P.q₁ := by nlinarith [hlarge, hc] + exact hh + · have hc := congrArg (fun x : CircleCoordinates => x.1) hCi + simp? [FordRecursiveQuadruple, FordCircleCoordinate] at hc + have hh : 1 < P.q₂ := by nlinarith [hlarge, hc] + omega + · exact False.elim (hidx rfl) + omega + +private theorem hcurv : + (by + classical + exact + ∀ (P : FordFareyParameter), (0 < P.q) → (0 < (FordCircleCoordinate P.p P.q).1) ) := by + classical + intro P hqpos + change (0 : ℤ) < ((P.q * P.q : Nat) : ℤ) + exact_mod_cast Nat.mul_pos hqpos hqpos + +private theorem hHcircle : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), (FordRecursiveQuadruple P (0 : Fin (4 : + ℕ)) = C0.1.1) → (∀ (H : PartialOdometer), (TileOdometer (FordCircleCoordinate P.p + P.q) (FordTile P.q) H) → (TileOdometer C0.1.1 (FordTile P.q) H)) ) := by + classical + intro P C0 hC0 H hHO + rw [← hC0] + exact hHO + +private theorem hC0pos : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), (FordRecursiveQuadruple P (0 : Fin (4 : + ℕ)) = C0.1.1) → ((0 < P.q) → (0 < C0.1.1.1)) ) := by + classical + intro P C0 hC0 hqpos + have ht : 0 < (FordRecursiveQuadruple P 0).1 := by + change (0 : ℤ) < ((P.q * P.q : Nat) : ℤ) + exact_mod_cast Nat.mul_pos hqpos hqpos + have := congrArg (fun x : CircleCoordinates => x.1) hC0 + simpa only [this] using ht + +private theorem hFnon : + (by + classical + exact + ∀ (P : FordFareyParameter), (0 < P.q) → ((FordTile P.q).cells.Nonempty) ) := by + classical + intro P hqpos + refine ⟨⟨0, 0⟩, ?_⟩ + simp [FordTile, FordCellDomain, hqpos] + +private theorem hTnon : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (H : + PartialOdometer), ∀ (u : GaussianInt), (T.cells = (TileTranslation (FordTile P.q) + u).cells ∧ (T.cells = ∅ → T.anchor = (TileTranslation (FordTile P.q) u).anchor) ∧ ∃ + (a : GaussianInt) (b : ℤ), (∀ (x : GaussianInt), x ∈ h.domain ↔ x - u ∈ H.domain) ∧ ∀ + x ∈ h.domain, h.value x = H.value (x - u) + a.re * x.re + a.im * x.im + b) → + (((FordTile P.q).cells.Nonempty) → (T.cells.Nonempty)) ) := by + classical + intro P T h H u hu hFnon + rw [hu.1] + simpa [TileTranslation] using hFnon.image (GaussianTranslation u) + +private theorem hT'non : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), ∀ (H : + PartialOdometer), ∀ (v : GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) + v).cells ∧ (T'.cells = ∅ → T'.anchor = (TileTranslation (FordTile P.q) v).anchor) ∧ ∃ + (a : GaussianInt) (b : ℤ), (∀ (x : GaussianInt), x ∈ h'.domain ↔ x - v ∈ H.domain) ∧ + ∀ x ∈ h'.domain, h'.value x = H.value (x - v) + a.re * x.re + a.im * x.im + b) → + (((FordTile P.q).cells.Nonempty) → (T'.cells.Nonempty)) ) := by + classical + intro P T' h' H v hv hFnon + rw [hv.1] + simpa [TileTranslation] using hFnon.image (GaussianTranslation v) + +private theorem hcentT : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (H : + PartialOdometer), ∀ (u : GaussianInt), (T.cells = (TileTranslation (FordTile P.q) + u).cells ∧ (T.cells = ∅ → T.anchor = (TileTranslation (FordTile P.q) u).anchor) ∧ ∃ + (a : GaussianInt) (b : ℤ), (∀ (x : GaussianInt), x ∈ h.domain ↔ x - u ∈ H.domain) ∧ ∀ + x ∈ h.domain, h.value x = H.value (x - u) + a.re * x.re + a.im * x.im + b) → + (((FordTile P.q).cells.Nonempty) → ((T.cells.Nonempty) → (TileCentroid T = + TileCentroid (TileTranslation (FordTile P.q) u)))) ) := by + classical + intro P T h H u hu hFnon hTnon + have htn : (TileTranslation (FordTile P.q) u).cells.Nonempty := by + simpa [TileTranslation] using hFnon.image (GaussianTranslation u) + simp only [TileCentroid, ite_eq_left hTnon, ite_eq_left htn] + rw [hu.1] + +private theorem hcentT' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), ∀ (H : + PartialOdometer), ∀ (v : GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) + v).cells ∧ (T'.cells = ∅ → T'.anchor = (TileTranslation (FordTile P.q) v).anchor) ∧ ∃ + (a : GaussianInt) (b : ℤ), (∀ (x : GaussianInt), x ∈ h'.domain ↔ x - v ∈ H.domain) ∧ + ∀ x ∈ h'.domain, h'.value x = H.value (x - v) + a.re * x.re + a.im * x.im + b) → + (((FordTile P.q).cells.Nonempty) → ((T'.cells.Nonempty) → (TileCentroid T' = + TileCentroid (TileTranslation (FordTile P.q) v)))) ) := by + classical + intro P T' h' H v hv hFnon hT'non + have htn : (TileTranslation (FordTile P.q) v).cells.Nonempty := by + simpa [TileTranslation] using hFnon.image (GaussianTranslation v) + simp only [TileCentroid, ite_eq_left hT'non, ite_eq_left htn] + rw [hv.1] + +private theorem hfordcent : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((BandCircle) → ((1 < P.q) → ((0 < P.q) → + (TileCentroid (FordTile P.q) = ((P.q : ℝ) / 2, (P.q : ℝ) / 2))))) ) := by + classical + intro P C0 Ci hqgt hqpos + let domain : Finset GaussianInt := + ((Finset.range P.q).product (Finset.range P.q)).image + (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) + have hneDomain : domain.Nonempty := by + refine ⟨⟨0, 0⟩, ?_⟩ + apply Finset.mem_image.mpr + exact ⟨(0, 0), by simp [hqpos], rfl⟩ + have hinj : Set.InjOn + (fun a : ℕ × ℕ => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) + ↑((Finset.range P.q).product (Finset.range P.q)) := by + intro a ha b hb hab + apply Prod.ext + · have h := congrArg Zsqrtd.re hab + change (a.1 : Int) = (b.1 : Int) at h + exact_mod_cast h + · have h := congrArg Zsqrtd.im hab + change (a.2 : Int) = (b.2 : Int) at h + exact_mod_cast h + have hcard : domain.card = P.q * P.q := by + calc + domain.card = ((Finset.range P.q).product (Finset.range P.q)).card := by + dsimp [domain] + exact Finset.card_image_iff.mpr hinj + _ = P.q * P.q := by simp + have hsum : domain.sum (fun z : GaussianInt => z.re) = + (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 * (P.q : Int) := by + have hrange : (Finset.range P.q).sum (fun n => (n : Int)) = + (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + simp? [domain, Finset.sum_product] + conv_lhs => rw [← Finset.mul_sum (Finset.range P.q) + (fun n => (n : Int)) (P.q : Int)] + rw [hrange] + ring + have hsumIm : domain.sum (fun z : GaussianInt => z.im) = + (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 * (P.q : Int) := by + have hrange : (Finset.range P.q).sum (fun n => (n : Int)) = + (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + simp? [domain, Finset.sum_product] + rw [hrange] + ring + change (if domain.Nonempty then + ((↑(domain.sum (fun z : GaussianInt => z.re) : Int) / + ↑domain.card + (1 / 2 : Real)), + (↑(domain.sum (fun z : GaussianInt => z.im) : Int) / + ↑domain.card + (1 / 2 : Real))) else _) = _ + rw [ite_eq_left hneDomain, hcard, hsum, hsumIm] + have hqcast : ((P.q - 1 : Nat) : Int) = (P.q : Int) - 1 := by omega + rw [hqcast] + norm_num + field_simp + have arithmetic := Finset.sum_range_id_mul_two P.q + have rangeSum : (Finset.range P.q).sum (fun n => (n : Int)) = + (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + have arithmeticCast : + ((Finset.range P.q).sum (fun n => (n : Int))) * 2 = + (P.q : Int) * ((P.q - 1 : Nat) : Int) := by + rw [← Nat.cast_sum] + exact_mod_cast arithmetic + rw [rangeSum] at arithmeticCast + rw [hqcast] at arithmeticCast + have arithmeticReal : + ((((P.q : Int) * ((P.q : Int) - 1) / 2 : Int) : ℝ) * 2) = + (P.q : ℝ) * ((P.q : ℝ) - 1) := by + exact_mod_cast arithmeticCast + norm_num [Int.subNatNat, pow_two] at ⊢ + nlinarith [arithmeticReal] + +private theorem hcentdiff : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), ∀ + (v : GaussianInt), (TileCentroid T = TileCentroid (TileTranslation (FordTile P.q) u)) + → ((TileCentroid T' = TileCentroid (TileTranslation (FordTile P.q) v)) → + (TileCentroid T' - TileCentroid T = GaussianRealPoint (v - u))) ) := by + classical + intro P T T' u v hcentT hcentT' + rw [hcentT, hcentT', (TileTranslationFormulas (FordTile P.q) u).2.2.2.2.1, + (TileTranslationFormulas (FordTile P.q) v).2.2.2.2.1] + simp [GaussianRealPoint] + +private theorem hvec : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P + i.succ = Ci.1.1) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), (TileCentroid T' - + TileCentroid T = GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))))) → ((i ≠ 2) → ((BandVectors.1 + (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : + ℕ))) = (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt)) → ((BandVectors.1 + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : + ℕ))) = (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt)) → (BandVectors.1 + (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P 0) = if i = 0 then ⟨(P.q + : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : Int)⟩))))) ) := by + classical + intro P Ci i hCi T T' hcent hidx hvec0 hvec1 + fin_cases i + · simpa using hvec0 + · simpa using hvec1 + · exact (hidx rfl).elim + +private theorem hshift : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin 3), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), + (TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))))) → (∀ + (u : GaussianInt), ∀ (v : GaussianInt), (TileCentroid T' - TileCentroid T = + GaussianRealPoint (v - u)) → ((BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P 0) = if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q + : Int), (P.q₂ : Int)⟩) → (v - u = if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else + ⟨-(P.q : Int), (P.q₂ : Int)⟩))) ) := by + classical + intro P i T T' hcent u v hcentdiff hvec + have heq : GaussianRealPoint (v-u) = + GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P 0)) := hcentdiff.symm.trans hcent + rw [← hvec] + apply Zsqrtd.ext + · have hh := congrArg Prod.fst heq + simpa [GaussianRealPoint] using (Int.cast_injective hh) + · have hh := congrArg Prod.snd heq + simpa [GaussianRealPoint] using (Int.cast_injective hh) + +private theorem hshift' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin 3), ∀ (u : GaussianInt), ∀ (v : GaussianInt), (v - + u = if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : Int)⟩) → ( + let d : GaussianInt := + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ + else ⟨-(P.q : Int), (P.q₂ : Int)⟩ + v = u + d) ) := by + classical + intro P i u v hshift d + calc + v = (v-u)+u := by abel + _ = d+u := by rw [hshift] + _ = u+d := by abel + +private theorem squareCell : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((BandCircle) → (∀ (z : GaussianInt), z ∈ + (FordTile P.q).cells ↔ 0 ≤ z.re ∧ z.re < (P.q : Int) ∧ 0 ≤ z.im ∧ z.im < (P.q : + Int))) ) := by + classical + intro P C0 Ci z + change z ∈ FordCellDomain P.q ↔ _ + change z ∈ ((Finset.range P.q).product (Finset.range P.q)).image + (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) ↔ _ + rw [Finset.mem_image] + constructor + · rintro ⟨⟨a,b⟩, hab, hz⟩ + have hab := Finset.mem_product.mp hab + have ha := Finset.mem_range.mp hab.1 + have hb := Finset.mem_range.mp hab.2 + have hre : z.re = (a : Int) := by + have hh := congrArg (fun w : GaussianInt => w.re) hz + simpa using hh.symm + have him : z.im = (b : Int) := by + have hh := congrArg (fun w : GaussianInt => w.im) hz + simpa using hh.symm + rw [hre, him] + exact ⟨by exact_mod_cast Nat.zero_le a, by exact_mod_cast ha, + by exact_mod_cast Nat.zero_le b, by exact_mod_cast hb⟩ + · rintro ⟨hr, hrq, hi, hiq⟩ + let a := z.re.toNat + let b := z.im.toNat + have ha : (a : Int) = z.re := Int.toNat_of_nonneg hr + have hb : (b : Int) = z.im := Int.toNat_of_nonneg hi + have haq : a < P.q := by exact_mod_cast (show (a : Int) < P.q by omega) + have hbq : b < P.q := by exact_mod_cast (show (b : Int) < P.q by omega) + refine ⟨(a,b), Finset.mem_product.mpr + ⟨Finset.mem_range.mpr haq, Finset.mem_range.mpr hbq⟩, ?_⟩ + apply Zsqrtd.ext <;> simp [ha, hb] + +private theorem translatedCell : + (by + classical + exact + ∀ (P : FordFareyParameter), (∀ (z : GaussianInt), z ∈ (FordTile P.q).cells ↔ 0 ≤ z.re ∧ + z.re < (P.q : Int) ∧ 0 ≤ z.im ∧ z.im < (P.q : Int)) → (∀ (w : GaussianInt), ∀ (z : + GaussianInt), z ∈ (TileTranslation (FordTile P.q) w).cells ↔ 0 ≤ (z-w).re ∧ (z-w).re + < (P.q : Int) ∧ 0 ≤ (z-w).im ∧ (z-w).im < (P.q : Int)) ) := by + classical + intro P squareCell w z + rw [(TileTranslationFormulas (FordTile P.q) w).1] + rw [Finset.mem_image] + constructor + · rintro ⟨a, ha, hz⟩ + have heq : a+w=z := by simpa [GaussianTranslation] using hz + have hcoords : z-w=a := by rw [← heq]; abel + rw [hcoords] + exact (squareCell a).mp ha + · intro hz + refine ⟨z-w, (squareCell (z-w)).mpr ?_, ?_⟩ + · simpa using hz + · simp [GaussianTranslation] + +private theorem hdisj : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((BandCircle) → (∀ (i : Fin 3), ∀ (T : + ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : PartialOdometer), ∀ + (H : PartialOdometer), ∀ (u : GaussianInt), (T.cells = (TileTranslation (FordTile + P.q) u).cells ∧ (T.cells = ∅ → T.anchor = (TileTranslation (FordTile P.q) u).anchor) + ∧ ∃ (a : GaussianInt) (b : ℤ), (∀ (x : GaussianInt), x ∈ h.domain ↔ x - u ∈ H.domain) + ∧ ∀ x ∈ h.domain, h.value x = H.value (x - u) + a.re * x.re + a.im * x.im + b) → (∀ + (v : GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) v).cells ∧ (T'.cells = + ∅ → T'.anchor = (TileTranslation (FordTile P.q) v).anchor) ∧ ∃ (a : GaussianInt) (b : + ℤ), (∀ (x : GaussianInt), x ∈ h'.domain ↔ x - v ∈ H.domain) ∧ ∀ x ∈ h'.domain, + h'.value x = H.value (x - v) + a.re * x.re + a.im * x.im + b) → ( + let d : GaussianInt := + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ + else ⟨-(P.q : Int), (P.q₂ : Int)⟩ + (v = u + d) → ((∀ (w : GaussianInt), ∀ (z : GaussianInt), z ∈ (TileTranslation (FordTile + P.q) w).cells ↔ 0 ≤ (z-w).re ∧ (z-w).re < (P.q : Int) ∧ 0 ≤ (z-w).im ∧ (z-w).im < + (P.q : Int)) → (Disjoint T.cells T'.cells)))))) ) := by + classical + intro P C0 Ci i T T' h h' H u hu v hv d hshift' translatedCell + rw [hu.1, hv.1] + apply Finset.disjoint_left.mpr + intro x hx hx' + have hleft := (translatedCell u x).mp hx + have hright := (translatedCell v x).mp hx' + have hrel : (x-v).re = (x-u).re-d.re := by + rw [hshift'] + simp + ring + by_cases hi : i = 0 + · simp [d, hi] at hrel hleft hright + omega + · simp [d, hi] at hrel hleft hright + omega + +private theorem hsecond : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin 3), ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), + ∀ (H : PartialOdometer), ∀ (u : GaussianInt), ∀ (v : GaussianInt), (T'.cells = + (TileTranslation (FordTile P.q) v).cells ∧ (T'.cells = ∅ → T'.anchor = + (TileTranslation (FordTile P.q) v).anchor) ∧ ∃ (a : GaussianInt) (b : ℤ), (∀ (x : + GaussianInt), x ∈ h'.domain ↔ x - v ∈ H.domain) ∧ ∀ x ∈ h'.domain, h'.value x = + H.value (x - v) + a.re * x.re + a.im * x.im + b) → ( + let d : GaussianInt := + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ + else ⟨-(P.q : Int), (P.q₂ : Int)⟩ + (v = u + d) → (T'.cells = (TileTranslation (FordTile P.q) (u+d)).cells)) ) := by + classical + intro P i T' h' H u v hv d hshift' + calc + T'.cells = (TileTranslation (FordTile P.q) v).cells := hv.1 + _ = (TileTranslation (FordTile P.q) (u+d)).cells := by rw [hshift'] + +private theorem translatedFootprint : + (by + classical + exact + ∀ (P : FordFareyParameter), ((FordTile P.q).cells.Nonempty) → ((FootprintVertices + (FordTile P.q) = FordVertexDomain P.q) → (∀ (w : GaussianInt), FootprintVertices + (TileTranslation (FordTile P.q) w) = GaussianTranslation w '' FordVertexDomain P.q)) + ) := by + classical + intro P hFnon hFfoot w + have htn : (TileTranslation (FordTile P.q) w).cells.Nonempty := by + simpa [TileTranslation] using hFnon.image (GaussianTranslation w) + calc + FootprintVertices (TileTranslation (FordTile P.q) w) = + GaussianTranslation w '' FootprintVertices (FordTile P.q) := + (TileTranslationFormulas (FordTile P.q) w).2.2.2.2.2.1 + _ = GaussianTranslation w '' FordVertexDomain P.q := by rw [hFfoot] + +private theorem footprintCoord : + (by + classical + exact + ∀ (P : FordFareyParameter), (∀ (w : GaussianInt), FootprintVertices (TileTranslation + (FordTile P.q) w) = GaussianTranslation w '' FordVertexDomain P.q) → (∀ (w : + GaussianInt), ∀ (z : GaussianInt), z ∈ FootprintVertices (TileTranslation (FordTile + P.q) w) ↔ 0 ≤ (z-w).re ∧ (z-w).re ≤ (P.q : Int) ∧ 0 ≤ (z-w).im ∧ (z-w).im ≤ (P.q : + Int)) ) := by + classical + intro P translatedFootprint w z + rw [translatedFootprint w] + simp only [Set.mem_image] + constructor + · rintro ⟨y, hy, heq⟩ + have heq' : y+w=z := by simpa [GaussianTranslation] using heq + have hy' : y ∈ FordVertexDomain P.q := hy + have hz : z-w=y := by rw [← heq']; abel + rw [hz] + simpa [FordVertexDomain] using hy' + · intro hz + refine ⟨z-w, ?_, ?_⟩ + · change 0 ≤ (z-w).re ∧ (z-w).re ≤ (P.q : Int) ∧ + 0 ≤ (z-w).im ∧ (z-w).im ≤ (P.q : Int) + exact hz + · simp [GaussianTranslation] + +private theorem footprintT : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (H : + PartialOdometer), ∀ (u : GaussianInt), (T.cells = (TileTranslation (FordTile P.q) + u).cells ∧ (T.cells = ∅ → T.anchor = (TileTranslation (FordTile P.q) u).anchor) ∧ ∃ + (a : GaussianInt) (b : ℤ), (∀ (x : GaussianInt), x ∈ h.domain ↔ x - u ∈ H.domain) ∧ ∀ + x ∈ h.domain, h.value x = H.value (x - u) + a.re * x.re + a.im * x.im + b) → + (((FordTile P.q).cells.Nonempty) → ((T.cells.Nonempty) → (FootprintVertices T = + FootprintVertices (TileTranslation (FordTile P.q) u)))) ) := by + classical + intro P T h H u hu hFnon hTnon + simp only [FootprintVertices, ite_eq_left hTnon] + have htn : (TileTranslation (FordTile P.q) u).cells.Nonempty := by + simpa [TileTranslation] using hFnon.image (GaussianTranslation u) + simp only [ite_eq_left htn] + rw [hu.1] + +private theorem footprintT' : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), ∀ (H : + PartialOdometer), ∀ (v : GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) + v).cells ∧ (T'.cells = ∅ → T'.anchor = (TileTranslation (FordTile P.q) v).anchor) ∧ ∃ + (a : GaussianInt) (b : ℤ), (∀ (x : GaussianInt), x ∈ h'.domain ↔ x - v ∈ H.domain) ∧ + ∀ x ∈ h'.domain, h'.value x = H.value (x - v) + a.re * x.re + a.im * x.im + b) → + (((FordTile P.q).cells.Nonempty) → ((T'.cells.Nonempty) → (FootprintVertices T' = + FootprintVertices (TileTranslation (FordTile P.q) v)))) ) := by + classical + intro P T' h' H v hv hFnon hT'non + simp only [FootprintVertices, ite_eq_left hT'non] + have htn : (TileTranslation (FordTile P.q) v).cells.Nonempty := by + simpa [TileTranslation] using hFnon.image (GaussianTranslation v) + simp only [ite_eq_left htn] + rw [hv.1] + +private theorem hinter : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((BandCircle) → (∀ (i : Fin 3), ∀ (T : + ProtoTile), ∀ (T' : ProtoTile), (1 < P.q) → ((0 < P.q₁) → ((0 < P.q₂) → (∀ (u : + GaussianInt), ∀ (v : GaussianInt), + let d : GaussianInt := + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ + else ⟨-(P.q : Int), (P.q₂ : Int)⟩ + (v = u + d) → ((∀ (w : GaussianInt), ∀ (z : GaussianInt), z ∈ FootprintVertices + (TileTranslation (FordTile P.q) w) ↔ 0 ≤ (z-w).re ∧ (z-w).re ≤ (P.q : Int) ∧ 0 ≤ + (z-w).im ∧ (z-w).im ≤ (P.q : Int)) → ((FootprintVertices T = FootprintVertices + (TileTranslation (FordTile P.q) u)) → ((FootprintVertices T' = FootprintVertices + (TileTranslation (FordTile P.q) v)) → (∀ x, x ∈ FootprintVertices T ∩ + FootprintVertices T' ↔ (x-u).re = (if i = 0 then (P.q : Int) else 0) ∧ (if i = 0 then + (P.q₁ : Int) else (P.q₂ : Int)) ≤ (x-u).im ∧ (x-u).im ≤ (P.q : Int)))))))))) ) := by + classical + intro P C0 Ci i T T' hqgt hrpos hspos u v d hshift' footprintCoord footprintT footprintT' x + rw [Set.mem_inter_iff, footprintT, footprintT'] + rw [(footprintCoord u x), (footprintCoord v x)] + have hrelRe : (x-v).re = (x-u).re-d.re := by rw [hshift']; simp; ring + have hrelIm : (x-v).im = (x-u).im-d.im := by rw [hshift']; simp; ring + by_cases hi : i = 0 + · simp [d, hi, hrelRe, hrelIm] + omega + · simp [d, hi, hrelRe, hrelIm] + omega + +end MatchedFordGeometry + +theorem P4158T1MatchedFordPair + (P : FordFareyParameter) + (C0 Ci : BandCircle) (i : Fin 3) + (hC0 : FordRecursiveQuadruple P 0 = C0.1.1) + (hCi : FordRecursiveQuadruple P i.succ = Ci.1.1) + (T T' : ProtoTile) (h h' : PartialOdometer) + (hO : TileOdometer C0.1.1 T h) (hO' : TileOdometer C0.1.1 T' h') + (hlarge : 1 < Ci.1.1.1) + (hcent : TileCentroid T' - TileCentroid T = + GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P 0))) : + i ≠ 2 ∧ 1 < P.q ∧ 0 < P.q₁ ∧ P.q₁ ≠ P.q₂ ∧ + ∃ u : GaussianInt, + T.cells = (TileTranslation (FordTile P.q) u).cells ∧ + T'.cells = (TileTranslation (FordTile P.q) + (u + if i = 0 then ⟨P.q, P.q₁⟩ else ⟨-(P.q : Int), P.q₂⟩)).cells ∧ + Disjoint T.cells T'.cells ∧ + (∀ x, x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ + (x - u).re = (if i = 0 then (P.q : Int) else 0) ∧ + (if i = 0 then (P.q₁ : Int) else P.q₂) ≤ (x - u).im ∧ + (x - u).im ≤ (P.q : Int)) := by +-- BODY + classical + have hidx : i ≠ 2 := MatchedFordGeometry.hidx P Ci i hCi T T' hlarge hcent + have hqgt : 1 < P.q := MatchedFordGeometry.hqgt P Ci i hCi T T' hlarge hcent hidx + have hqpos : 0 < P.q := by omega + have hrpos : 0 < P.q₁ := MatchedFordGeometry.hrpos P Ci hqgt + have hspos : 0 < P.q₂ := P.q₂_pos + have hneq : P.q₁ ≠ P.q₂ := MatchedFordGeometry.hneq P Ci i hCi T T' hlarge hcent hidx hrpos hspos + have hcurv : 0 < (FordCircleCoordinate P.p P.q).1 := MatchedFordGeometry.hcurv P hqpos + obtain ⟨H, hHO, hHD, hHV⟩ := FordTileOdometerRestriction P + have hHcircle : TileOdometer C0.1.1 (FordTile P.q) H := MatchedFordGeometry.hHcircle P C0 hC0 H + hHO + have hC0pos : 0 < C0.1.1.1 := MatchedFordGeometry.hC0pos P C0 hC0 hqpos + obtain ⟨u, hu, huuniq⟩ := TileOdometerTranslationUniqueness + C0.1.1 T (FordTile P.q) h H hC0pos hO hHcircle + obtain ⟨v, hv, hvuniq⟩ := TileOdometerTranslationUniqueness + C0.1.1 T' (FordTile P.q) h' H hC0pos hO' hHcircle + obtain ⟨a, b, hud, huv⟩ := hu.2.2 + obtain ⟨a', b', hvd, hvv⟩ := hv.2.2 + have hFnon : (FordTile P.q).cells.Nonempty := MatchedFordGeometry.hFnon P hqpos + have hTnon : T.cells.Nonempty := MatchedFordGeometry.hTnon P T h H u hu hFnon + have hT'non : T'.cells.Nonempty := MatchedFordGeometry.hT'non P T' h' H v hv hFnon + have hcentT : TileCentroid T = TileCentroid (TileTranslation (FordTile P.q) u) := + MatchedFordGeometry.hcentT P T h H u hu hFnon hTnon + have hcentT' : TileCentroid T' = TileCentroid (TileTranslation (FordTile P.q) v) := + MatchedFordGeometry.hcentT' P T' h' H v hv hFnon hT'non + have hfordcent : TileCentroid (FordTile P.q) = + ((P.q : ℝ) / 2, (P.q : ℝ) / 2) := MatchedFordGeometry.hfordcent P C0 Ci hqgt hqpos + have hcentdiff : TileCentroid T' - TileCentroid T = + GaussianRealPoint (v - u) := MatchedFordGeometry.hcentdiff P T T' u v hcentT hcentT' + obtain ⟨_, hconfig⟩ := FordCoordinateConfiguration P + obtain ⟨_, hvec0, hvec1, _, _, _, _, _, _⟩ := hconfig hqgt + have hvec : BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P 0) = + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ + else ⟨-(P.q : Int), (P.q₂ : Int)⟩ := MatchedFordGeometry.hvec P Ci i hCi T T' hcent hidx + hvec0 hvec1 + have hshift : v - u = + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ + else ⟨-(P.q : Int), (P.q₂ : Int)⟩ := MatchedFordGeometry.hshift P i T T' hcent u v + hcentdiff hvec + let d : GaussianInt := + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ + else ⟨-(P.q : Int), (P.q₂ : Int)⟩ + have hshift' : v = u + d := MatchedFordGeometry.hshift' P i u v hshift + have squareCell (z : GaussianInt) : + z ∈ (FordTile P.q).cells ↔ + 0 ≤ z.re ∧ z.re < (P.q : Int) ∧ + 0 ≤ z.im ∧ z.im < (P.q : Int) := MatchedFordGeometry.squareCell P C0 Ci z + have translatedCell (w z : GaussianInt) : + z ∈ (TileTranslation (FordTile P.q) w).cells ↔ + 0 ≤ (z-w).re ∧ (z-w).re < (P.q : Int) ∧ + 0 ≤ (z-w).im ∧ (z-w).im < (P.q : Int) := MatchedFordGeometry.translatedCell P + squareCell w z + have hdisj : Disjoint T.cells T'.cells := MatchedFordGeometry.hdisj P C0 Ci i T T' h h' H u hu + v hv hshift' translatedCell + have hsecond : T'.cells = (TileTranslation (FordTile P.q) (u+d)).cells := + MatchedFordGeometry.hsecond P i T' h' H u v hv hshift' + have hFfoot : FootprintVertices (FordTile P.q) = FordVertexDomain P.q := + (P4062T1CanonicalSupport P.q hqpos).1 + have translatedFootprint (w : GaussianInt) : + FootprintVertices (TileTranslation (FordTile P.q) w) = + GaussianTranslation w '' FordVertexDomain P.q := MatchedFordGeometry.translatedFootprint + P hFnon hFfoot w + have footprintCoord (w z : GaussianInt) : + z ∈ FootprintVertices (TileTranslation (FordTile P.q) w) ↔ + 0 ≤ (z-w).re ∧ (z-w).re ≤ (P.q : Int) ∧ + 0 ≤ (z-w).im ∧ (z-w).im ≤ (P.q : Int) := MatchedFordGeometry.footprintCoord P + translatedFootprint w z + have footprintT : FootprintVertices T = + FootprintVertices (TileTranslation (FordTile P.q) u) := MatchedFordGeometry.footprintT P T + h H u hu hFnon hTnon + have footprintT' : FootprintVertices T' = + FootprintVertices (TileTranslation (FordTile P.q) v) := MatchedFordGeometry.footprintT' P + T' h' H v hv hFnon hT'non + have hinter : ∀ x, x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ + (x-u).re = (if i = 0 then (P.q : Int) else 0) ∧ + (if i = 0 then (P.q₁ : Int) else (P.q₂ : Int)) ≤ (x-u).im ∧ + (x-u).im ≤ (P.q : Int) := MatchedFordGeometry.hinter P C0 Ci i T T' hqgt hrpos hspos u v + hshift' footprintCoord footprintT footprintT' + refine ⟨hidx, hqgt, hrpos, hneq, u, hu.1, ?_, hdisj, ?_⟩ + · simpa [d] using hsecond + · exact hinter + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean new file mode 100644 index 0000000000..6e4581cc8b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean @@ -0,0 +1,1131 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification +public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.OpposingStringInterfacePath +public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas + +-- [TABLET NODE: P4158T1SmallerStringEdges] + +/-! +# P4158T1SmallerStringEdges + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SmallerStringGeometry + +private theorem hqone : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P + i.succ = Ci.1.1) → (((1 : ℤ) < Ci.1.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i + = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : + GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : + ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : + GaussianInt))).cells) → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ + FootprintVertices T' ↔ ((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 + : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ + (x - u).im ≤ (↑P.q : ℤ)) → (∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), + (TileCentroid Rminus - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - TileCentroid T = (1 / 2 + : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → (((P.q : Int) = P.q₁ + + P.q₂) → (1 < P.q)))))))) ) := by + classical + intro P Ci i hCi hlarge hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hsum + by_contra hn + have he : P.q = 1 := by have := P.q_pos; omega + have hunit := P.unit_case he + rcases hsmall with ⟨rfl, hlt⟩ | ⟨rfl, hlt⟩ + · simp? [FordRecursiveQuadruple, hunit.2.1] at hCi + have := congrArg Prod.fst hCi + omega + · have hq2 : P.q₂ = 1 := hunit.2.2.2 + have := congrArg Prod.fst hCi + simp [FordRecursiveQuadruple, FordCircleCoordinate, hq2] at this + omega + +private theorem hrpos : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (((P.q : Int) = P.q₁ + P.q₂) → ((1 < P.q) → (0 + < P.q₁))) ) := by + classical + intro P Ci hsum hqone + by_contra hn + have hz : P.q₁ = 0 := by omega + have hd := P.det₁ + simp [hz] at hd + have hdv : (P.q : Int) ∣ 1 := ⟨P.p₁, by simpa [mul_comm] using hd.symm⟩ + have := Int.eq_one_of_dvd_one (by omega : 0 ≤ (P.q : Int)) hdv + omega + +private theorem hC0pos : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), (FordRecursiveQuadruple P (0 : Fin (4 : + ℕ)) = C0.1.1) → ((1 < P.q) → (0 < C0.1.1.1)) ) := by + classical + intro P C0 hC0 hqone + rw [← hC0] + simp? [FordRecursiveQuadruple, FordCircleCoordinate] + positivity + +private theorem hCicurv : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P + i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ + P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (T'.cells + = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), + (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) + → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ ((x - u).re + = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) + then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ (x - u).im ≤ (↑P.q : ℤ)) → (∀ + (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), (TileCentroid Rminus - TileCentroid T = + (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - + TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + + BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + i.succ))) → ((0 < P.q₁) → ( + let n := if i = 0 then P.q₁ else P.q₂ + (0 < n) → ((n < P.q) → (Ci.1.1.1 = (n : Int) ^ 2))))))))) ) := by + classical + intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hrpos n hnpos hnq + rw [← hCi] + rcases hsmall with ⟨rfl, _⟩ | ⟨rfl, _⟩ + · simp [n, FordRecursiveQuadruple, FordCircleCoordinate, ne_of_gt hrpos, pow_two] + · simp [n, FordRecursiveQuadruple, FordCircleCoordinate, pow_two] + +private theorem hnlarge : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (Ci : BandCircle), ∀ (i : Fin 3), ((1 : ℤ) + < Ci.1.1.1) → ( + let n := if i = 0 then P.q₁ else P.q₂ + (0 < n) → ((Ci.1.1.1 = (n : Int) ^ 2) → (1 < n)))) ) := by + classical + intro P C0 Ci i hlarge n hnpos hCicurv + rw [hCicurv] at hlarge + by_contra hn + have : n = 1 := by omega + simp [this] at hlarge + +private theorem determinantCoprime : + (by + classical + exact + (FordFareyParameter) → ((BandCircle) → ((BandCircle) → ((Fin 3) → (∀ (a : Int), ∀ (b : + Nat), ∀ (d : Nat), ∀ (c : Int), (a * (d : Int) - (b : Int) * c = 1) → (Nat.Coprime b + a.natAbs))))) ) := by + classical + intro P C0 Ci i a b d c hd + rw [Nat.coprime_iff_gcd_eq_one] + apply Nat.dvd_one.mp + let g := Nat.gcd b a.natAbs + have gb : g ∣ b := Nat.gcd_dvd_left _ _ + have ga : g ∣ a.natAbs := Nat.gcd_dvd_right _ _ + have gb' : (g : Int) ∣ (b : Int) := by exact_mod_cast gb + have ga' : (g : Int) ∣ a := (Int.dvd_natAbs).mp (by exact_mod_cast ga) + have gd := dvd_sub (dvd_mul_of_dvd_left ga' (d : Int)) + (dvd_mul_of_dvd_left gb' c) + have gd1 : (g : Int) ∣ 1 := by simpa [hd] using gd + have ge := Int.eq_one_of_dvd_one (by omega : 0 ≤ (g : Int)) gd1 + have gn : g = 1 := by exact_mod_cast ge + simp [g, gn] + +private theorem hFord : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P + i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ + P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (T'.cells + = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), + (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) + → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ ((x - u).re + = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) + then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ (x - u).im ≤ (↑P.q : ℤ)) → (∀ + (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), (TileCentroid Rminus - TileCentroid T = + (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - + TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + + BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + i.succ))) → ((0 < P.q₁) → (((0 : ℕ) < P.q₂) → ( + let n := if i = 0 then P.q₁ else P.q₂ + (0 < n) → ((n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ((∀ (a : Int), ∀ (b : + Nat), ∀ (d : Nat), ∀ (c : Int), (a * (d : Int) - (b : Int) * c = 1) → (Nat.Coprime b + a.natAbs)) → (BandPrototile Ci.1.1 (FordTile n)))))))))))))) ) := by + classical + intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hrpos hspos n hnpos hnq + hCicurv hnlarge determinantCoprime + rcases hsmall with ⟨rfl, _⟩ | ⟨rfl, _⟩ + · obtain ⟨Q, ⟨hpQ, hqQ⟩, _⟩ := FordFareyParentsExist P.p₁ P.q₁ hrpos + (determinantCoprime P.p₁ P.q₁ P.q P.p P.det₁) + have hF := (FordTileRecursiveIdentification Q).1 + rw [hpQ, hqQ] at hF + simpa [n, ← hCi, FordRecursiveQuadruple, ne_of_gt hrpos] using hF + · have hd : (-P.p₂) * (P.q : Int) - (P.q₂ : Int) * (-P.p) = 1 := by + nlinarith [P.det₂] + have hred : Nat.Coprime P.q₂ P.p₂.natAbs := by + simpa using determinantCoprime (-P.p₂) P.q₂ P.q (-P.p) hd + obtain ⟨Q, ⟨hpQ, hqQ⟩, _⟩ := FordFareyParentsExist P.p₂ P.q₂ hspos hred + have hF := (FordTileRecursiveIdentification Q).1 + rw [hpQ, hqQ] at hF + simpa [n, ← hCi, FordRecursiveQuadruple] using hF + +private theorem fordcell : + (by + classical + exact + (FordFareyParameter) → ((BandCircle) → ((BandCircle) → ((Fin 3) → (∀ (m : Nat), ∀ (z : + GaussianInt), z ∈ (FordTile m).cells ↔ 0 ≤ z.re ∧ z.re < m ∧ 0 ≤ z.im ∧ z.im < m)))) + ) := by + classical + intro P C0 Ci i m z + change z ∈ ((Finset.range m).product (Finset.range m)).image + (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) ↔ _ + rw [Finset.mem_image] + constructor + · rintro ⟨⟨j, k⟩, hjk, rfl⟩ + have hjk := Finset.mem_product.mp hjk + simp only [Finset.mem_range] at hjk + dsimp; omega + · rintro ⟨h0, h1, h2, h3⟩ + exact ⟨(z.re.toNat, z.im.toNat), + Finset.mem_product.mpr ⟨Finset.mem_range.mpr (by omega), + Finset.mem_range.mpr (by omega)⟩, + by ext <;> dsimp <;> omega⟩ + +private theorem fordcent : + (by + classical + exact + (FordFareyParameter) → ((BandCircle) → ((BandCircle) → ((Fin 3) → ((∀ (m : Nat), ∀ (z : + GaussianInt), z ∈ (FordTile m).cells ↔ 0 ≤ z.re ∧ z.re < m ∧ 0 ≤ z.im ∧ z.im < m) → + ((∀ (m : Nat), (0 < m) → ((FordTile m).cells.Nonempty)) → (∀ (m : Nat), (0 < m) → + (TileCentroid (FordTile m) = ((m : Real) / 2, (m : Real) / 2)))))))) ) := by + classical + intro P C0 Ci i fordcell fordne m hm + let R := TileTranslation (TileQuarterTurn (FordTile m)) ⟨m, 0⟩ + have hcR : R.cells = (FordTile m).cells := by + ext z + change z ∈ ((FordTile m).cells.image (fun x => GaussianQuarterTurn x - 1)).image + (GaussianTranslation ⟨m, 0⟩) ↔ _ + rw [Finset.image_image, fordcell] + constructor + · rintro hz + rcases Finset.mem_image.mp hz with ⟨x, hx, hz⟩ + have hx := (fordcell m x).mp hx + have hr := congrArg Zsqrtd.re hz + have hi := congrArg Zsqrtd.im hz + dsimp [GaussianTranslation, GaussianQuarterTurn, Function.comp_def] at hr hi + omega + · intro hz + refine Finset.mem_image.mpr ⟨⟨z.im, (m : Int) - 1 - z.re⟩, + (fordcell m _).mpr ?_, ?_⟩ + · dsimp; omega + · ext <;> simp [GaussianTranslation, GaussianQuarterTurn]; omega + have he : TileCentroid R = TileCentroid (FordTile m) := + (ProtoTileObservableExtensionality R (FordTile m) hcR + (by intro he; rw [hcR] at he; exact ((fordne m hm).ne_empty he).elim)).2.2.2.2 + rw [(TileTranslationFormulas _ _).2.2.2.2.1, + (TileQuarterTurnFormulas _).2.2.2.2.1] at he + have h1 := congrArg Prod.fst he + have h2 := congrArg Prod.snd he + apply Prod.ext <;> norm_num at h1 h2 ⊢ <;> linarith + +private theorem transne : + (by + classical + exact + (∀ (m : Nat), (0 < m) → ((FordTile m).cells.Nonempty)) → (∀ (m : Nat), (0 < m) → (∀ (v : + GaussianInt), (TileTranslation (FordTile m) v).cells.Nonempty)) ) := by + classical + intro fordne m hm v + exact (fordne m hm).image _ + +private theorem cellobs : + (by + classical + exact + (∀ (m : Nat), (0 < m) → (∀ (v : GaussianInt), (TileTranslation (FordTile m) + v).cells.Nonempty)) → (∀ (A : ProtoTile), ∀ (m : Nat), (0 < m) → (∀ (v : + GaussianInt), (A.cells = (TileTranslation (FordTile m) v).cells) → (FootprintVertices + A = FootprintVertices (TileTranslation (FordTile m) v) ∧ TileCentroid A = + TileCentroid (TileTranslation (FordTile m) v)))) ) := by + classical + intro transne A m hm v he + have ha : A.cells = ∅ → A.anchor = (TileTranslation (FordTile m) v).anchor := by + intro hempty + exact ((transne m hm v).ne_empty (he.symm.trans hempty)).elim + exact ⟨(ProtoTileObservableExtensionality _ _ he ha).1, + (ProtoTileObservableExtensionality _ _ he ha).2.2.2.2⟩ + +private theorem hcentT : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (u : GaussianInt), (T.cells = + (TileTranslation (FordTile P.q) u).cells) → ((∀ (m : Nat), (0 < m) → (TileCentroid + (FordTile m) = ((m : Real) / 2, (m : Real) / 2))) → ((∀ (A : ProtoTile), ∀ (m : Nat), + (0 < m) → (∀ (v : GaussianInt), (A.cells = (TileTranslation (FordTile m) v).cells) → + (FootprintVertices A = FootprintVertices (TileTranslation (FordTile m) v) ∧ + TileCentroid A = TileCentroid (TileTranslation (FordTile m) v)))) → (TileCentroid T = + ((P.q : Real) / 2 + u.re, (P.q : Real) / 2 + u.im)))) ) := by + classical + intro P T u hc fordcent cellobs + rw [(cellobs T P.q P.q_pos u hc).2, + (TileTranslationFormulas _ _).2.2.2.2.1, fordcent P.q P.q_pos] + +private theorem hcmcand : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P + i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ + P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (T'.cells + = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), + (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) + → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ ((x - u).re + = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) + then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ (x - u).im ≤ (↑P.q : ℤ)) → (∀ + (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), (TileCentroid Rminus - TileCentroid T = + (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - + TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + + BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + i.succ))) → ( + let n := if i = 0 then P.q₁ else P.q₂ + (0 < n) → ((n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ((BandPrototile Ci.1.1 + (FordTile n)) → ((∀ (m : Nat), (0 < m) → (TileCentroid (FordTile m) = ((m : Real) / + 2, (m : Real) / 2))) → ((TileCentroid T = ((P.q : Real) / 2 + u.re, (P.q : Real) / 2 + + u.im)) → ( + let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ + (BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (FordRecursiveQuadruple + P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) → ((ProperBandQuadruple + (FordRecursiveQuadruple P) ∧ BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : + ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : + GaussianInt) ∧ BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : + GaussianInt) ∧ BandVectors.1 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨(0 : ℤ), -(↑P.q : ℤ)⟩ : GaussianInt) + ∧ BandVectors.2 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) = (⟨P.p₁, P.p⟩ : GaussianInt) ∧ BandVectors.2 + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : + ℕ))) = (⟨P.p₂, -P.p⟩ : GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple P (3 : + Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨-P.p, (0 : ℤ)⟩ : + GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) = (⟨-P.p₂, (0 : ℤ)⟩ : GaussianInt) ∧ + BandVectors.2 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + (3 : Fin (4 : ℕ))) = (⟨(0 : ℤ), P.p₁⟩ : GaussianInt)) → (TileCentroid Rminus = + TileCentroid (TileTranslation (FordTile n) vm)))))))))))))))) ) := by + classical + intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp n hnpos hnq hCicurv hnlarge + hFord fordcent hcentT vm hflip hvecs + rw [(TileTranslationFormulas _ _).2.2.2.2.1, fordcent n hnpos] + rw [hflip] at hcm + rcases hsmall with ⟨rfl, _⟩ | ⟨rfl, _⟩ + · simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl] at hcm + rw [hvecs.2.1, hcentT] at hcm + have h1 := congrArg Prod.fst hcm + have h2 := congrArg Prod.snd hcm + dsimp [n, vm, GaussianRealPoint] at * + push_cast at h1 h2 ⊢ + ext <;> dsimp <;> linarith + · simp only [show (1 : Fin 3).succ = (2 : Fin 4) from rfl] at hcm + rw [hvecs.2.2.1, hcentT] at hcm + have h1 := congrArg Prod.fst hcm + have h2 := congrArg Prod.snd hcm + dsimp [n, vm, GaussianRealPoint] at * + push_cast at h1 h2 ⊢ + ext <;> dsimp <;> linarith + +private theorem hcpcand : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P + i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ + P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (T'.cells + = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), + (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) + → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ ((x - u).re + = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) + then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ (x - u).im ≤ (↑P.q : ℤ)) → (∀ + (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), (TileCentroid Rminus - TileCentroid T = + (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - + TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + + BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + i.succ))) → ( + let n := if i = 0 then P.q₁ else P.q₂ + (0 < n) → ((n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ((BandPrototile Ci.1.1 + (FordTile n)) → ((∀ (m : Nat), (0 < m) → (TileCentroid (FordTile m) = ((m : Real) / + 2, (m : Real) / 2))) → ((TileCentroid T = ((P.q : Real) / 2 + u.re, (P.q : Real) / 2 + + u.im)) → ( + let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ + let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩ + (BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (FordRecursiveQuadruple + P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) → ((ProperBandQuadruple + (FordRecursiveQuadruple P) ∧ BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : + ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : + GaussianInt) ∧ BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : + GaussianInt) ∧ BandVectors.1 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨(0 : ℤ), -(↑P.q : ℤ)⟩ : GaussianInt) + ∧ BandVectors.2 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) = (⟨P.p₁, P.p⟩ : GaussianInt) ∧ BandVectors.2 + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : + ℕ))) = (⟨P.p₂, -P.p⟩ : GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple P (3 : + Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨-P.p, (0 : ℤ)⟩ : + GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) = (⟨-P.p₂, (0 : ℤ)⟩ : GaussianInt) ∧ + BandVectors.2 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + (3 : Fin (4 : ℕ))) = (⟨(0 : ℤ), P.p₁⟩ : GaussianInt)) → ((TileCentroid Rminus = + TileCentroid (TileTranslation (FordTile n) vm)) → (TileCentroid Rplus = TileCentroid + (TileTranslation (FordTile n) vp))))))))))))))))) ) := by + classical + intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp n hnpos hnq hCicurv hnlarge + hFord fordcent hcentT vm vp hflip hvecs hcmcand + rw [(TileTranslationFormulas _ _).2.2.2.2.1, fordcent n hnpos] + rw [hflip] at hcp + have hsumR : (P.q : Real) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q + rcases hsmall with ⟨rfl, _⟩ | ⟨rfl, _⟩ + · simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl] at hcp + rw [hvecs.2.1, hcentT] at hcp + have h1 := congrArg Prod.fst hcp + have h2 := congrArg Prod.snd hcp + dsimp [n, vp, GaussianRealPoint] at * + push_cast at h1 h2 ⊢ + ext <;> dsimp <;> linarith + · simp only [show (1 : Fin 3).succ = (2 : Fin 4) from rfl] at hcp + rw [hvecs.2.2.1, hcentT] at hcp + have h1 := congrArg Prod.fst hcp + have h2 := congrArg Prod.snd hcp + dsimp [n, vp, GaussianRealPoint] at * + push_cast at h1 h2 ⊢ + ext <;> dsimp <;> linarith + +private theorem hdelta : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin 3), ∀ (u : GaussianInt), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), + let n := if i = 0 then P.q₁ else P.q₂ + let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ + let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩ + (TileCentroid Rminus = TileCentroid (TileTranslation (FordTile n) vm)) → ((TileCentroid + Rplus = TileCentroid (TileTranslation (FordTile n) vp)) → (TileCentroid Rplus - + TileCentroid Rminus = GaussianRealPoint (vp - vm))) ) := by + classical + intro P i u Rminus Rplus n vm vp hcmcand hcpcand + rw [hcmcand, hcpcand, (TileTranslationFormulas _ _).2.2.2.2.1, + (TileTranslationFormulas _ _).2.2.2.2.1] + ext <;> simp [GaussianRealPoint] + +private theorem hnormdelta : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P + i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ + P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (T'.cells + = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), + (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) + → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ ((x - u).re + = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) + then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ (x - u).im ≤ (↑P.q : ℤ)) → (∀ + (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), (TileCentroid Rminus - TileCentroid T = + (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - + TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + + BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + i.succ))) → (((P.q : Int) = P.q₁ + P.q₂) → ( + let n := if i = 0 then P.q₁ else P.q₂ + (0 < n) → ((n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ((BandPrototile Ci.1.1 + (FordTile n)) → ( + let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ + let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩ + (BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (FordRecursiveQuadruple + P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) → ((TileCentroid Rminus = + TileCentroid (TileTranslation (FordTile n) vm)) → ((TileCentroid Rplus = TileCentroid + (TileTranslation (FordTile n) vp)) → ((Rminus.cells = (TileTranslation (FordTile n) + vm).cells) → ((Rplus.cells = (TileTranslation (FordTile n) vp).cells) → + ((TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint (vp - vm)) → + (Zsqrtd.norm (vp - vm) = (P.q : Int) ^ 2 + (n : Int) ^ 2)))))))))))))))))) ) := by + classical + intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hsum n hnpos hnq hCicurv + hnlarge hFord vm vp hflip hcmcand hcpcand heqm heqp hdelta + rcases hsmall with ⟨rfl, _⟩ | ⟨rfl, _⟩ + · simp [vm, vp, n, Zsqrtd.norm_def] + nlinarith [hsum] + · simp [vm, vp, n, Zsqrtd.norm_def] + ring + +private theorem pointinj : + (by + classical + exact + Function.Injective GaussianRealPoint ) := by + classical + intro x y he + apply Zsqrtd.ext + · have hh := congrArg Prod.fst he + dsimp [GaussianRealPoint] at hh + exact_mod_cast hh + · have hh := congrArg Prod.snd he + dsimp [GaussianRealPoint] at hh + exact_mod_cast hh + +private theorem hRS : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), ((1 : ℤ) < Ci.1.1.1) → (∀ + (u : GaussianInt), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), + let n := if i = 0 then P.q₁ else P.q₂ + (Ci.1.1.1 = (n : Int) ^ 2) → ( + let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ + let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩ + (TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint (vp - vm)) → ((Zsqrtd.norm + (vp - vm) = (P.q : Int) ^ 2 + (n : Int) ^ 2) → ((Function.Injective + GaussianRealPoint) → (Rminus ≠ Rplus))))) ) := by + classical + intro P Ci i hlarge u Rminus Rplus n hCicurv vm vp hdelta hnormdelta pointinj he + have he0 : GaussianRealPoint (vp - vm) = GaussianRealPoint 0 := by + rw [← hdelta, he] + simp [GaussianRealPoint] + rfl + have he0 := pointinj he0 + rw [he0] at hnormdelta + simp only [Zsqrtd.norm_zero] at hnormdelta + have : 0 < (P.q : Int) := by exact_mod_cast P.q_pos + nlinarith + +private theorem hincoming : + (by + classical + exact + ∀ (Ci : BandCircle), (0 < Ci.1.1.1) → (∀ (Q : Fin (4 : ℕ) → CircleCoordinates), + (SemiProperQuadruple Q) → ((Q (0 : Fin (4 : ℕ)) = Ci.1.1) → ((ProperBandQuadruple Q) + → (∀ (j : Fin 3), Zsqrtd.norm (BandVectors.1 (Q j.succ) (Q 0)) = (Q j.succ).1 + + Ci.1.1.1)))) ) := by + classical + intro Ci hCipos Q hQsemi hQ0 hQproper j + have hj : j.succ ≠ (0 : Fin 4) := by + intro he + have := congrArg Fin.val he + simp at this + have hv := (VectorSquareProduct Q hQsemi j.succ 0 hj).1 + have ht := TangencyCoordinateIdentity Q hQsemi j.succ 0 hj + have hs : Zsqrtd.norm (BandVectors.1 (Q j.succ) (Q 0)) ^ 2 = + ((Q j.succ).1 + (Q 0).1) ^ 2 := by + calc + _ = Zsqrtd.norm (BandVectors.1 (Q j.succ) (Q 0) ^ 2) := by + simpa only [pow_two] using (Zsqrtd.norm_mul + (BandVectors.1 (Q j.succ) (Q 0)) + (BandVectors.1 (Q j.succ) (Q 0))).symm + _ = _ := by rw [hv]; exact ht + have hn := GaussianInt.norm_nonneg (BandVectors.1 (Q j.succ) (Q 0)) + have hjpos := (ProperBandCurvatureStructure Q hQproper).2.1 j + rw [← hQ0] at hCipos ⊢ + nlinarith + +private theorem hRmem : + (by + classical + exact + ∀ (Rminus : ProtoTile), ∀ (tiles : List ProtoTile), (tiles.head? = some Rminus) → (Rminus + ∈ tiles) ) := by + classical + intro Rminus tiles hhead + have hopt : Rminus ∈ tiles.head? := by simp [hhead] + rw [List.eq_cons_of_mem_head? hopt] + simp + +private theorem hSmem : + (by + classical + exact + ∀ (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), (tiles.getLast? = some Rplus) → (Rplus + ∈ tiles) ) := by + classical + intro Rplus tiles hlast + have hopt : Rplus ∈ tiles.getLast? := by simp [hlast] + obtain ⟨hne, hget⟩ := List.mem_getLast?_eq_getLast hopt + rw [hget] + exact List.getLast_mem hne + +private theorem hnotouch : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (Ci : BandCircle), ∀ (i : Fin 3), ∀ (u : + GaussianInt), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ + (tiles : List ProtoTile), + let n := if i = 0 then P.q₁ else P.q₂ + (n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ( + let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ + let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩ + (TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint (vp - vm)) → ((Zsqrtd.norm + (vp - vm) = (P.q : Int) ^ 2 + (n : Int) ^ 2) → ((Function.Injective + GaussianRealPoint) → (∀ (Q : Fin (4 : ℕ) → CircleCoordinates), (Q (0 : Fin (4 : ℕ)) = + Ci.1.1) → ((∀ (j : Fin (3 : ℕ)), (Q j.succ).1 < Ci.1.1.1) → ((ProperBandQuadruple Q) + → ((∀ (j : Fin 3), Zsqrtd.norm (BandVectors.1 (Q j.succ) (Q 0)) = (Q j.succ).1 + + Ci.1.1.1) → ((BandPrototile Ci.1.1 base) → ((∀ T ∈ tiles, T ∈ RegularTileFamily base + (TilingLattice Ci)) → ((Rminus ∈ tiles) → ((Rplus ∈ tiles) → (¬ TileTouching Rminus + Rplus))))))))))))))) ) := by + classical + intro P C0 Ci i u base Rminus Rplus tiles n hnq hCicurv hnlarge vm vp hdelta hnormdelta + pointinj Q hQ0 hQless hQproper hincoming hbase hfamily hRmem hSmem htouch + have hbaseQ : BandPrototile (Q 0) base := by simpa [hQ0] using hbase + obtain ⟨j, hj⟩ := (BandRegularTileTouchingClassification Ci Q hQproper hQ0 + base hbaseQ Rminus Rplus (hfamily _ hRmem) (hfamily _ hSmem)).mp htouch + have hnorm : Zsqrtd.norm (vp - vm) = + Zsqrtd.norm (BandVectors.1 (Q j.succ) (Q 0)) := by + rcases hj with hj | hj + · rw [hdelta] at hj + rw [pointinj hj] + · have hj' : GaussianRealPoint (vp - vm) = + GaussianRealPoint (-BandVectors.1 (Q j.succ) (Q 0)) := by + rw [← hdelta, hj] + ext <;> simp [GaussianRealPoint] + rw [pointinj hj', Zsqrtd.norm_neg] + rw [hnormdelta, hincoming] at hnorm + have hless := hQless j + rw [hCicurv] at hnorm hless + have hnqZ : (n : Int) < P.q := by exact_mod_cast hnq + have hnZ : 0 ≤ (n : Int) := by omega + nlinarith + +private theorem hnadj : + (by + classical + exact + ∀ (Ci : BandCircle), ((1 : ℤ) < Ci.1.1.1) → (∀ (orientation : Bool), ∀ (Rminus : + ProtoTile), ∀ (Rplus : ProtoTile), (¬ TileTouching Rminus Rplus) → (¬ (if Ci.1.1.1 = + 1 then ∃ v : GaussianInt, UnitTriangularStep orientation v ∧ TileCentroid Rplus - + TileCentroid Rminus = GaussianRealPoint v else TileTouching Rminus Rplus))) ) := by + classical + intro Ci hlarge orientation Rminus Rplus hnotouch + simpa [ne_of_gt hlarge] using hnotouch + +private theorem ancestorFoot : + (by + classical + exact + ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), (0 < C0.1.1.1) → (∀ (A : ProtoTile), ∀ (root : + ProtoTile), ∀ (g : PartialOdometer), ∀ (f : PartialOdometer), (AncestorOdometer + Ci.1.1 C0.1.1 A root g f) → (FootprintVertices A ⊆ FootprintVertices root)) ) := by + classical + intro C0 Ci hC0pos A root g f ha x hx + rw [← PositiveCurvatureTileOdometerDomain C0.1.1 root f hC0pos ha.1] + apply ha.2.2.2.1 + change x ∈ (g.domain : Set GaussianInt) + rw [ha.2.2.1] + exact hx + +private theorem hwroot : + (by + classical + exact + ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : + PartialOdometer), ∀ (h' : PartialOdometer), ∀ (tiles : List ProtoTile), ∀ + (reverseTiles : List ProtoTile), ∀ (hs : List PartialOdometer), ∀ (reverseHs : List + PartialOdometer), (∀ U ∈ (List.drop (1 : ℕ) tiles).dropLast, ∃ (g : PartialOdometer), + (U, g) ∈ tiles.zip hs ∧ AncestorOdometer Ci.1.1 C0.1.1 U T g h) → ((∀ V ∈ (List.drop + (1 : ℕ) reverseTiles).dropLast, ∃ (k : PartialOdometer), (V, k) ∈ reverseTiles.zip + reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 V T' k h') → (∀ (walk : List GaussianInt), + (∀ x ∈ walk, (∃ a ∈ (List.drop (1 : ℕ) tiles).dropLast, x ∈ FootprintVertices a) ∧ ∃ + b ∈ (List.drop (1 : ℕ) reverseTiles).dropLast, x ∈ FootprintVertices b) → ((∀ (A : + ProtoTile), ∀ (root : ProtoTile), ∀ (g : PartialOdometer), ∀ (f : PartialOdometer), + (AncestorOdometer Ci.1.1 C0.1.1 A root g f) → (FootprintVertices A ⊆ + FootprintVertices root)) → (∀ (x : GaussianInt), (x ∈ walk) → (x ∈ FootprintVertices + T ∩ FootprintVertices T'))))) ) := by + classical + intro C0 Ci T T' h h' tiles reverseTiles hs reverseHs hanc hanc' walk hwvertices ancestorFoot x hx + obtain ⟨⟨A, hA, hxA⟩, ⟨B, hB, hxB⟩⟩ := hwvertices x hx + obtain ⟨g, _, hg⟩ := hanc A hA + obtain ⟨k, _, hk⟩ := hanc' B hB + exact ⟨ancestorFoot A T g h hg hxA, ancestorFoot B T' k h' hk hxB⟩ + +private theorem hwsegment : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (i : Fin 3), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : + GaussianInt), (∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ + ((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) ∧ (if i = (0 : + Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ (x - u).im ≤ (↑P.q : + ℤ)) → ( + let n := if i = 0 then P.q₁ else P.q₂ + ∀ (walk : List GaussianInt), (∀ (x : GaussianInt), (x ∈ walk) → (x ∈ FootprintVertices T + ∩ FootprintVertices T')) → (∀ (x : GaussianInt), (x ∈ walk) → ((x - u).re = (if i = 0 + then (P.q : Int) else 0) ∧ (n : Int) ≤ (x - u).im ∧ (x - u).im ≤ P.q))) ) := by + classical + intro P i T T' u hsegment n walk hwroot x hx + simpa only [n, Nat.cast_ite] using (hsegment x).mp (hwroot x hx) + +private theorem squarefoot : + (by + classical + exact + ∀ (m : Nat), (0 < m) → (∀ (v : GaussianInt), ∀ (x : GaussianInt), x ∈ FootprintVertices + (TileTranslation (FordTile m) v) ↔ 0 ≤ (x - v).re ∧ (x - v).re ≤ m ∧ 0 ≤ (x - v).im ∧ + (x - v).im ≤ m) ) := by + classical + intro m hm v x + rw [(TileTranslationFormulas _ _).2.2.2.2.2.1, + (P4062T1CanonicalSupport m hm).1] + simp only [Set.mem_image, FordVertexDomain, Set.mem_ofPred_eq, GaussianTranslation] + constructor + · rintro ⟨y, hy, rfl⟩ + simpa using hy + · intro hx + exact ⟨x - v, hx, sub_add_cancel x v⟩ + +private theorem hminusheight : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (Ci : BandCircle), ∀ (i : Fin 3), + (FordRecursiveQuadruple P i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ + i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : + GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : + ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : + GaussianInt))).cells) → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ + FootprintVertices T' ↔ ((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 + : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ + (x - u).im ≤ (↑P.q : ℤ)) → (∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), + (TileCentroid Rminus - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - TileCentroid T = (1 / 2 + : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → (((P.q : Int) = P.q₁ + + P.q₂) → ( + let n := if i = 0 then P.q₁ else P.q₂ + (0 < n) → ((n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ((BandPrototile Ci.1.1 + (FordTile n)) → ((∀ (A : ProtoTile), ∀ (m : Nat), (0 < m) → (∀ (v : GaussianInt), + (A.cells = (TileTranslation (FordTile m) v).cells) → (FootprintVertices A = + FootprintVertices (TileTranslation (FordTile m) v) ∧ TileCentroid A = TileCentroid + (TileTranslation (FordTile m) v)))) → ( + let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ + let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩ + (BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (FordRecursiveQuadruple + P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) → ((TileCentroid Rminus = + TileCentroid (TileTranslation (FordTile n) vm)) → ((TileCentroid Rplus = TileCentroid + (TileTranslation (FordTile n) vp)) → ((Rminus.cells = (TileTranslation (FordTile n) + vm).cells) → ((Rplus.cells = (TileTranslation (FordTile n) vp).cells) → + ((TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint (vp - vm)) → + ((Zsqrtd.norm (vp - vm) = (P.q : Int) ^ 2 + (n : Int) ^ 2) → (∀ (walk : List + GaussianInt), (∀ (x : GaussianInt), (x ∈ walk) → ((x - u).re = (if i = 0 then (P.q : + Int) else 0) ∧ (n : Int) ≤ (x - u).im ∧ (x - u).im ≤ P.q)) → ((∀ (m : Nat), (0 < m) → + (∀ (v : GaussianInt), ∀ (x : GaussianInt), x ∈ FootprintVertices (TileTranslation + (FordTile m) v) ↔ 0 ≤ (x - v).re ∧ (x - v).re ≤ m ∧ 0 ≤ (x - v).im ∧ (x - v).im ≤ m)) + → (∀ (x : GaussianInt), (x ∈ walk) → ((x ∈ FootprintVertices Rminus) → ((x - u).im = + if i = 0 then (n : Int) else P.q))))))))))))))))))))))))) ) := by + classical + intro P C0 Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hsum n hnpos hnq hCicurv + hnlarge hFord cellobs vm vp hflip hcmcand hcpcand heqm heqp hdelta hnormdelta walk + hwsegment squarefoot x hx hxm + rw [(cellobs Rminus n hnpos vm heqm).1] at hxm + have hxbox := (squarefoot n hnpos vm x).mp hxm + have hxseg := hwsegment x hx + rcases hsmall with ⟨rfl, _⟩ | ⟨rfl, _⟩ + all_goals simp [n, vm] at hxbox hxseg ⊢; omega + +private theorem hplusheight : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → (∀ (Ci : BandCircle), ∀ (i : Fin 3), + (FordRecursiveQuadruple P i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ + i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : + GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : + ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : + GaussianInt))).cells) → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ + FootprintVertices T' ↔ ((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 + : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ + (x - u).im ≤ (↑P.q : ℤ)) → (∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), + (TileCentroid Rminus - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - TileCentroid T = (1 / 2 + : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple + P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → (((P.q : Int) = P.q₁ + + P.q₂) → ( + let n := if i = 0 then P.q₁ else P.q₂ + (0 < n) → ((n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ((BandPrototile Ci.1.1 + (FordTile n)) → ((∀ (A : ProtoTile), ∀ (m : Nat), (0 < m) → (∀ (v : GaussianInt), + (A.cells = (TileTranslation (FordTile m) v).cells) → (FootprintVertices A = + FootprintVertices (TileTranslation (FordTile m) v) ∧ TileCentroid A = TileCentroid + (TileTranslation (FordTile m) v)))) → ( + let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ + let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩ + (BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P + i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (FordRecursiveQuadruple + P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) → ((TileCentroid Rminus = + TileCentroid (TileTranslation (FordTile n) vm)) → ((TileCentroid Rplus = TileCentroid + (TileTranslation (FordTile n) vp)) → ((Rminus.cells = (TileTranslation (FordTile n) + vm).cells) → ((Rplus.cells = (TileTranslation (FordTile n) vp).cells) → + ((TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint (vp - vm)) → + ((Zsqrtd.norm (vp - vm) = (P.q : Int) ^ 2 + (n : Int) ^ 2) → (∀ (walk : List + GaussianInt), (∀ (x : GaussianInt), (x ∈ walk) → ((x - u).re = (if i = 0 then (P.q : + Int) else 0) ∧ (n : Int) ≤ (x - u).im ∧ (x - u).im ≤ P.q)) → ((∀ (m : Nat), (0 < m) → + (∀ (v : GaussianInt), ∀ (x : GaussianInt), x ∈ FootprintVertices (TileTranslation + (FordTile m) v) ↔ 0 ≤ (x - v).re ∧ (x - v).re ≤ m ∧ 0 ≤ (x - v).im ∧ (x - v).im ≤ m)) + → ((∀ (x : GaussianInt), (x ∈ walk) → ((x ∈ FootprintVertices Rminus) → ((x - u).im = + if i = 0 then (n : Int) else P.q))) → (∀ (x : GaussianInt), (x ∈ walk) → ((x ∈ + FootprintVertices Rplus) → ((x - u).im = if i = 0 then (P.q : Int) else + n)))))))))))))))))))))))))) ) := by + classical + intro P C0 Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hsum n hnpos hnq hCicurv + hnlarge hFord cellobs vm vp hflip hcmcand hcpcand heqm heqp hdelta hnormdelta walk + hwsegment squarefoot hminusheight x hx hxp + rw [(cellobs Rplus n hnpos vp heqp).1] at hxp + have hxbox := (squarefoot n hnpos vp x).mp hxp + have hxseg := hwsegment x hx + rcases hsmall with ⟨rfl, _⟩ | ⟨rfl, _⟩ + all_goals simp [n, vp] at hxbox hxseg ⊢; omega + +private theorem crossing : + (by + classical + exact + ∀ (test : GaussianInt → Prop), ∀ (p : List GaussianInt), (∃ a, p.head? = some a ∧ test a) + → (∃ b, p.getLast? = some b ∧ ¬ test b) → ∃ x y : GaussianInt, ∃ l₁ l₂ : List + GaussianInt, p = l₁ ++ x :: y :: l₂ ∧ test x ∧ ¬ test y ) := by + classical + intro test p + induction p with + | nil => simp + | cons x xs ih => + rintro ⟨a, ha, hta⟩ hlast + have hxa : x = a := Option.some.inj ha + subst a + cases xs with + | nil => + obtain ⟨b, hb, htb⟩ := hlast + have hxb : x = b := Option.some.inj hb + exact (htb (hxb ▸ hta)).elim + | cons y ys => + by_cases hy : test y + · obtain ⟨a, b, l₁, l₂, he, hta', htb⟩ := + ih ⟨y, rfl, hy⟩ (by simpa using hlast) + refine ⟨a, b, x :: l₁, l₂, ?_, hta', htb⟩ + simp only [List.cons_append, he] + · exact ⟨x, y, [], ys, rfl, hta, hy⟩ + +private theorem stepPair : + (by + classical + exact + (FordFareyParameter) → ((BandCircle) → ((BandCircle) → ((Fin 3) → (∀ (u : GaussianInt), ∀ + (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), ((x - u).re = (z - + u).re) → (((y - u).re = (z - u).re) → ((y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → ((((x - u).im ≤ (z - u).im ∧ (z - u).im < (y - + u).im) ∨ + ((y - u).im ≤ (z - u).im ∧ (z - u).im < (x - u).im)) → (({x, y} : Finset GaussianInt) + = {z, z + ⟨0, 1⟩})))))))) ) := by + classical + intro P C0 Ci i u x y z hx hy hstep hcross + simp only [Zsqrtd.re_sub] at hx hy + have hunit : y.im = x.im + 1 ∨ y.im = x.im - 1 := by + rcases hstep with he | he | he | he + · have hh := congrArg Zsqrtd.re he + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hh + omega + · have hh := congrArg Zsqrtd.re he + simp only [Zsqrtd.re_sub, Zsqrtd.re_one] at hh + omega + · left + have hh := congrArg Zsqrtd.im he + simpa using hh + · right + have hh := congrArg Zsqrtd.im he + simpa using hh + simp only [Zsqrtd.im_sub] at hcross + rcases hcross with hc | hc + · have hxz : x = z := by ext <;> omega + have hyz : y = z + ⟨0, 1⟩ := by ext <;> simp only [Zsqrtd.re_add, + Zsqrtd.im_add] <;> omega + rw [hxz, hyz] + · have hyz : y = z := by ext <;> omega + have hxz : x = z + ⟨0, 1⟩ := by ext <;> simp only [Zsqrtd.re_add, + Zsqrtd.im_add] <;> omega + rw [hxz, hyz, Finset.pair_comm] + +private theorem hta : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((BandCircle) → (∀ (i : Fin 3), ∀ (u : + GaussianInt), ((P.q : Int) = P.q₁ + P.q₂) → ( + let n := if i = 0 then P.q₁ else P.q₂ + ∀ (z : GaussianInt), ((z - u).im < (↑P.q : ℤ)) → (((n : Int) ≤ (z - u).im) → (∀ (a : + GaussianInt), (GaussianInt) → (((a - u).im = if i = (0 : Fin (3 : ℕ)) then (↑n : ℤ) + else (↑P.q : ℤ)) → ( + let test := fun x : GaussianInt => + if i = 0 then (x - u).im ≤ (z - u).im else (z - u).im < (x - u).im + test a))))))) ) := by + classical + intro P C0 Ci i u hsum n z hzhi hzlo' a b haheight test + by_cases hi : i = 0 + · simp only [test, ite_eq_left hi] at * + omega + · simp only [test, ite_eq_right hi] at * + omega + +private theorem htb : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandCircle) → ((BandCircle) → (∀ (i : Fin 3), ∀ (u : + GaussianInt), ((P.q : Int) = P.q₁ + P.q₂) → ( + let n := if i = 0 then P.q₁ else P.q₂ + ∀ (z : GaussianInt), ((z - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) + → (((z - u).im < (↑P.q : ℤ)) → (((n : Int) ≤ (z - u).im) → ((GaussianInt) → (∀ (b : + GaussianInt), ((b - u).im = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (↑n : ℤ)) → ( + let test := fun x : GaussianInt => + if i = 0 then (x - u).im ≤ (z - u).im else (z - u).im < (x - u).im + ¬ test b)))))))) ) := by + classical + intro P C0 Ci i u hsum n z hzre hzhi hzlo' a b hbheight test + by_cases hi : i = 0 + · simp only [test, ite_eq_left hi] at * + omega + · simp only [test, ite_eq_right hi] at * + omega + +private theorem hcross : + (by + classical + exact + ∀ (i : Fin 3), ∀ (u : GaussianInt), ∀ (z : GaussianInt), + let test := fun x : GaussianInt => + if i = 0 then (x - u).im ≤ (z - u).im else (z - u).im < (x - u).im + ∀ (x : GaussianInt), ∀ (y : GaussianInt), (test x) → ((¬test y) → (((x - u).im ≤ (z - + u).im ∧ (z - u).im < (y - u).im) ∨ ((y - u).im ≤ (z - u).im ∧ (z - u).im < (x - + u).im))) ) := by + classical + intro i u z test x y htx hty + by_cases hi : i = 0 + · left + simpa only [test, ite_eq_left hi, not_le] using And.intro htx hty + · right + simp only [test, ite_eq_right hi, not_lt] at htx hty + exact ⟨hty, htx⟩ + +end SmallerStringGeometry + +theorem P4158T1SmallerStringEdges + (P : FordFareyParameter) (hq : ProperBandQuadruple (FordRecursiveQuadruple P)) + (C0 Ci : BandCircle) (i : Fin 3) + (hC0 : FordRecursiveQuadruple P 0 = C0.1.1) + (hCi : FordRecursiveQuadruple P i.succ = Ci.1.1) + (hlarge : 1 < Ci.1.1.1) + (hsmall : (i = 0 ∧ P.q₁ < P.q₂) ∨ (i = 1 ∧ P.q₂ < P.q₁)) + (T T' : ProtoTile) (h h' : PartialOdometer) (u : GaussianInt) + (hc : T.cells = (TileTranslation (FordTile P.q) u).cells) + (hc' : T'.cells = (TileTranslation (FordTile P.q) + (u + if i = 0 then ⟨P.q, P.q₁⟩ else ⟨-(P.q : Int), P.q₂⟩)).cells) + (hsegment : ∀ x, x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ + (x - u).re = (if i = 0 then (P.q : Int) else 0) ∧ + (if i = 0 then (P.q₁ : Int) else P.q₂) ≤ (x - u).im ∧ + (x - u).im ≤ (P.q : Int)) + (orientation : Bool) (base Rminus Rplus : ProtoTile) + (tiles reverseTiles : List ProtoTile) (hs reverseHs : List PartialOdometer) + (hf : OdometerStringRespect Ci orientation base Rminus Rplus tiles hs) + (hr : OdometerStringRespect Ci orientation base Rplus Rminus reverseTiles reverseHs) + (hminus hplus : PartialOdometer) + (hOm : TileOdometer Ci.1.1 Rminus hminus) + (hOp : TileOdometer Ci.1.1 Rplus hplus) + (hcm : TileCentroid Rminus - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P 0) - BandVectors.1 (FordRecursiveQuadruple P 0) + (FordRecursiveQuadruple P i.succ))) + (hcp : TileCentroid Rplus - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P 0) + BandVectors.1 (FordRecursiveQuadruple P 0) + (FordRecursiveQuadruple P i.succ))) + (hanc : ∀ U, U ∈ (tiles.drop 1).dropLast → ∃ g, (U, g) ∈ tiles.zip hs ∧ + AncestorOdometer Ci.1.1 C0.1.1 U T g h) + (hanc' : ∀ V, V ∈ (reverseTiles.drop 1).dropLast → ∃ k, + (V, k) ∈ reverseTiles.zip reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 V T' k h') : + Rminus.cells = (TileTranslation (FordTile (if i = 0 then P.q₁ else P.q₂)) + (u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩)).cells ∧ + Rplus.cells = (TileTranslation (FordTile (if i = 0 then P.q₁ else P.q₂)) + (u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩)).cells ∧ + ∀ z : GaussianInt, + (z - u).re = (if i = 0 then (P.q : Int) else 0) → + (if i = 0 then (P.q₁ : Int) else P.q₂) ≤ (z - u).im → + (z - u).im < (P.q : Int) → + ∃ (U V : ProtoTile) (g k : PartialOdometer), + U ∈ (tiles.drop 1).dropLast ∧ V ∈ (reverseTiles.drop 1).dropLast ∧ + (U, g) ∈ tiles.zip hs ∧ (V, k) ∈ reverseTiles.zip reverseHs ∧ + AncestorOdometer Ci.1.1 C0.1.1 U T g h ∧ + AncestorOdometer Ci.1.1 C0.1.1 V T' k h' ∧ + {z, z + ⟨0, 1⟩} ∈ FootprintEdges U ∧ + {z, z + ⟨0, 1⟩} ∈ FootprintEdges V := by +-- BODY + classical + have hsum : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q + have hqone := SmallerStringGeometry.hqone P Ci i hCi hlarge hsmall T T' u hc' hsegment Rminus + Rplus hcm hcp hsum + have hrpos := SmallerStringGeometry.hrpos P Ci hsum hqone + have hspos := P.q₂_pos + let n := if i = 0 then P.q₁ else P.q₂ + have hnpos : 0 < n := by dsimp [n]; split_ifs <;> assumption + have hnq : n < P.q := by dsimp [n]; split_ifs <;> omega + have hCipos : 0 < Ci.1.1.1 := by omega + have hC0pos := SmallerStringGeometry.hC0pos P C0 hC0 hqone + have hCicurv := SmallerStringGeometry.hCicurv P Ci i hCi hsmall T T' u hc' hsegment Rminus + Rplus hcm hcp hrpos hnpos hnq + have hnlarge := SmallerStringGeometry.hnlarge P C0 Ci i hlarge hnpos hCicurv + have hFord := SmallerStringGeometry.hFord P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus + hcm hcp hrpos (P.q₂_pos) hnpos hnq hCicurv hnlarge + (SmallerStringGeometry.determinantCoprime P C0 Ci i) + have fordcell (m : Nat) (z : GaussianInt) : + z ∈ (FordTile m).cells ↔ + 0 ≤ z.re ∧ z.re < m ∧ 0 ≤ z.im ∧ z.im < m := SmallerStringGeometry.fordcell P C0 Ci i m z + have fordne (m : Nat) (hm : 0 < m) : (FordTile m).cells.Nonempty := + ⟨0, (fordcell m 0).mpr (by simp; omega)⟩ + have fordcent := SmallerStringGeometry.fordcent P C0 Ci i fordcell fordne + have cellobs := SmallerStringGeometry.cellobs (SmallerStringGeometry.transne fordne) + have hcentT := SmallerStringGeometry.hcentT P T u hc fordcent cellobs + let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ + let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩ + have hflip := ((VectorRecursionLaws (FordRecursiveQuadruple P) hq.1).2.2.2.2 hq i).1 + have hvecs := (FordCoordinateConfiguration P).2 hqone + have hcmcand := SmallerStringGeometry.hcmcand P Ci i hCi hsmall T T' u hc' hsegment Rminus + Rplus hcm hcp hnpos hnq hCicurv hnlarge hFord fordcent hcentT hflip hvecs + have hcpcand := SmallerStringGeometry.hcpcand P Ci i hCi hsmall T T' u hc' hsegment Rminus + Rplus hcm hcp hnpos hnq hCicurv hnlarge hFord fordcent hcentT hflip hvecs hcmcand + have heqm := (BandPrototileCentroidUnique Ci.1.1 Rminus _ + (TileOdometerBandPrototile _ _ _ hOm) + (BandPrototileTranslation _ _ vm hFord) hcmcand).1 + have heqp := (BandPrototileCentroidUnique Ci.1.1 Rplus _ + (TileOdometerBandPrototile _ _ _ hOp) + (BandPrototileTranslation _ _ vp hFord) hcpcand).1 + have hdelta := SmallerStringGeometry.hdelta P i u Rminus Rplus hcmcand hcpcand + have hnormdelta := SmallerStringGeometry.hnormdelta P Ci i hCi hsmall T T' u hc' hsegment + Rminus Rplus hcm hcp hsum hnpos hnq hCicurv hnlarge hFord hflip hcmcand hcpcand heqm heqp + hdelta + have pointinj := SmallerStringGeometry.pointinj + have hRS := SmallerStringGeometry.hRS P Ci i hlarge u Rminus Rplus hCicurv hdelta hnormdelta + pointinj + obtain ⟨Q, hQsemi, hQ0, hQless, _⟩ : + ∃ Q : Fin 4 → CircleCoordinates, SemiProperQuadruple Q ∧ Q 0 = Ci.1.1 ∧ + (∀ j : Fin 3, (Q j.succ).1 < Ci.1.1.1) ∧ + ∀ Q' : Fin 4 → CircleCoordinates, SemiProperQuadruple Q' → Q' 0 = Ci.1.1 → + (∀ j : Fin 3, (Q' j.succ).1 < Ci.1.1.1) → + ∀ D : CircleCoordinates, (∃ j : Fin 3, Q j.succ = D) ↔ + ∃ j : Fin 3, Q' j.succ = D := by + rcases BandGenealogy Ci with hu | hQ + · omega + · exact hQ + have hQproper : ProperBandQuadruple Q := ⟨hQsemi, by simpa [hQ0] using hQless⟩ + have hincoming := SmallerStringGeometry.hincoming Ci hCipos Q hQsemi hQ0 hQproper + have hft : TileString Ci orientation base Rminus Rplus tiles := hf.1 + obtain ⟨hbase, hhead, hlast, _, hfamily, _, _⟩ := hft + have hnadj := SmallerStringGeometry.hnadj Ci hlarge orientation Rminus Rplus + (SmallerStringGeometry.hnotouch P C0 Ci i u base Rminus Rplus tiles hnq hCicurv hnlarge + hdelta hnormdelta pointinj Q hQ0 hQless hQproper hincoming hbase hfamily + (SmallerStringGeometry.hRmem Rminus tiles hhead) (SmallerStringGeometry.hSmem Rplus tiles + hlast)) + obtain ⟨walk, hwhead, hwlast, hwchain, hwvertices, hwedges⟩ := + OpposingStringInterfacePath Ci orientation base Rminus Rplus hRS hnadj + tiles reverseTiles hf.1 hr.1 + have hwsegment := SmallerStringGeometry.hwsegment P i T T' u hsegment walk + (SmallerStringGeometry.hwroot C0 Ci T T' h h' tiles reverseTiles hs reverseHs hanc hanc' + walk hwvertices (SmallerStringGeometry.ancestorFoot C0 Ci hC0pos)) + have squarefoot := SmallerStringGeometry.squarefoot + have hminusheight := SmallerStringGeometry.hminusheight P C0 Ci i hCi hsmall T T' u hc' + hsegment Rminus Rplus hcm hcp hsum hnpos hnq hCicurv hnlarge hFord cellobs hflip hcmcand + hcpcand heqm heqp hdelta hnormdelta walk hwsegment squarefoot + have hplusheight := SmallerStringGeometry.hplusheight P C0 Ci i hCi hsmall T T' u hc' hsegment + Rminus Rplus hcm hcp hsum hnpos hnq hCicurv hnlarge hFord cellobs hflip hcmcand hcpcand + heqm heqp hdelta hnormdelta walk hwsegment squarefoot hminusheight + have crossing := SmallerStringGeometry.crossing + have stepPair := SmallerStringGeometry.stepPair P C0 Ci i u + refine ⟨heqm, heqp, ?_⟩ + intro z hzre hzlo hzhi + have hzlo' : (n : Int) ≤ (z - u).im := by + simpa only [n, Nat.cast_ite] using hzlo + obtain ⟨a, ha, ham⟩ := hwhead + obtain ⟨b, hb, hbp⟩ := hwlast + have haheight := hminusheight a (List.mem_of_mem_head? (by simp [ha])) ham + have hbheight := hplusheight b (List.mem_of_mem_getLast? (by simp [hb])) hbp + let test := fun x : GaussianInt => + if i = 0 then (x - u).im ≤ (z - u).im else (z - u).im < (x - u).im + have hta := SmallerStringGeometry.hta P C0 Ci i u hsum z hzhi hzlo' a b haheight + have htb := SmallerStringGeometry.htb P C0 Ci i u hsum z hzre hzhi hzlo' a b hbheight + obtain ⟨x, y, l₁, l₂, he, htx, hty⟩ := + crossing test walk ⟨a, ha, hta⟩ ⟨b, hb, htb⟩ + have hxmem : x ∈ walk := by rw [he]; simp + have hymem : y ∈ walk := by rw [he]; simp + have hxre := (hwsegment x hxmem).1 + have hyre := (hwsegment y hymem).1 + have hpair := stepPair x y z (hxre.trans hzre.symm) (hyre.trans hzre.symm) + (List.isChain_iff_forall_rel_of_append_cons_cons.mp hwchain he) (SmallerStringGeometry.hcross + i u z x y htx hty) + obtain ⟨⟨U, hU, hEU⟩, ⟨V, hV, hEV⟩⟩ := hwedges x y l₁ l₂ he + obtain ⟨g, hgzip, hg⟩ := hanc U hU + obtain ⟨k, hkzip, hk⟩ := hanc' V hV + rw [hpair] at hEU hEV + exact ⟨U, V, g, k, hU, hV, hgzip, hkzip, hg, hk, hEU, hEV⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1StringSlopeTelescoping.lean b/LeanPool/ApollonianSuperharmonic/P4158T1StringSlopeTelescoping.lean new file mode 100644 index 0000000000..6c830cf742 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4158T1StringSlopeTelescoping.lean @@ -0,0 +1,167 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect +public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure + +-- [TABLET NODE: P4158T1StringSlopeTelescoping] + +/-! +# P4158T1StringSlopeTelescoping + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4158T1StringSlopeTelescoping + (C : BandCircle) (hlarge : 1 < C.1.1.1) + (orientation : Bool) (base R S : ProtoTile) + (tiles reverseTiles : List ProtoTile) (hs reverseHs : List PartialOdometer) + (hf : OdometerStringRespect C orientation base R S tiles hs) + (hr : OdometerStringRespect C orientation base S R reverseTiles reverseHs) + (hendpoint : PartialOdometer) + (hh : hs.head? = some hendpoint) (hh' : reverseHs.getLast? = some hendpoint) + (U V : ProtoTile) (g k : PartialOdometer) + (hU : (U, g) ∈ tiles.zip hs) (hV : (V, k) ∈ reverseTiles.zip reverseHs) : + ∃ s t : Real × Real, + PartialOdometerSlope g = some s ∧ PartialOdometerSlope k = some t ∧ + t.1 - s.1 = CircleMatrix C 0 0 * ((TileCentroid V).1 - (TileCentroid U).1) + + CircleMatrix C 0 1 * ((TileCentroid V).2 - (TileCentroid U).2) ∧ + t.2 - s.2 = CircleMatrix C 1 0 * ((TileCentroid V).1 - (TileCentroid U).1) + + CircleMatrix C 1 1 * ((TileCentroid V).2 - (TileCentroid U).2) := by +-- BODY + have slopeDefined : ∀ (c : CircleCoordinates) (T : ProtoTile) (f : PartialOdometer), + TileOdometer c T f → 1 < c.1 → ∃ p : Real × Real, PartialOdometerSlope f = some p := by + intro c T f ho hc + induction ho with + | line w z hw hdom => omega + | unit z w T f hT hdom htrans => omega + | @decompose qd hqd S T hs f hT hsub hcells hfoot hcentroid hdom + hvalue hcompat hslope ih => + have facts := ProperBandCurvatureStructure qd hqd + have hp : ∃ i : Fin 3, 0 < (qd i.succ).1 := by + by_cases h0 : 0 < (qd (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (qd (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + have n0 := facts.2.1 (0 : Fin 3) + have n1 := facts.2.1 (1 : Fin 3) + have z0 : (qd (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (qd (1 : Fin 3).succ).1 = 0 := by omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim + obtain ⟨i, hi⟩ := hp + obtain hz | ⟨p, pi, hp, hpi, hpr, hpi'⟩ := hslope i false + · omega + · exact ⟨p, hp⟩ + obtain ⟨s, hsg⟩ := slopeDefined C.1.1 U g (List.forall₂_zip hf.2.1 hU) hlarge + obtain ⟨t, htk⟩ := slopeDefined C.1.1 V k (List.forall₂_zip hr.2.1 hV) hlarge + let slopeVec := fun f : PartialOdometer => + let p := (PartialOdometerSlope f).getD (0, 0) + ![p.1, p.2] + let centroidVec := fun T : ProtoTile => ![(TileCentroid T).1, (TileCentroid T).2] + let invariant := fun X : ProtoTile × PartialOdometer => + slopeVec X.2 - Matrix.mulVec (CircleMatrix C) (centroidVec X.1) + let invRel := fun X Y : ProtoTile × PartialOdometer => invariant X = invariant Y + have invStep : ∀ A B : ProtoTile × PartialOdometer, + LeftLatticeAdjacent C A.1 B.1 A.2 B.2 → invRel A B := by + intro A B hadj + obtain ⟨_, _, p, p', hp, hp', hcase⟩ := hadj + obtain hunit | ⟨q, j, e, hq, hq0, hcent, hpRe, hpIm⟩ := hcase + · omega + have hin := CircleMatrixIncomingVector C q hq.1 hq0 j + let sign : Real := if e = true then 1 else -1 + have hc0 : (TileCentroid B.1).1 - (TileCentroid A.1).1 = + sign * ((BandVectors.1 (q j.succ) (q 0)).re : Real) := by + have hh := congrArg Prod.fst hcent + change _ = (if e = true then (1 : Real) else -1) * + ((BandVectors.1 (q j.succ) (q 0)).re : Real) at hh + exact hh + have hc1 : (TileCentroid B.1).2 - (TileCentroid A.1).2 = + sign * ((BandVectors.1 (q j.succ) (q 0)).im : Real) := by + have hh := congrArg Prod.snd hcent + change _ = (if e = true then (1 : Real) else -1) * + ((BandVectors.1 (q j.succ) (q 0)).im : Real) at hh + exact hh + have hcentVec : centroidVec B.1 - centroidVec A.1 = + sign • ![((BandVectors.1 (q j.succ) (q 0)).re : Real), + ((BandVectors.1 (q j.succ) (q 0)).im : Real)] := by + ext n + fin_cases n + · simpa [centroidVec, sign, smul_eq_mul] using hc0 + · simpa [centroidVec, sign, smul_eq_mul] using hc1 + have hslopeVec : slopeVec B.2 - slopeVec A.2 = + sign • ![((BandVectors.2 (q j.succ) (q 0)).re : Real), + ((BandVectors.2 (q j.succ) (q 0)).im : Real)] := by + ext n + fin_cases n <;> simp [slopeVec, hp, hp', hpRe, hpIm, sign] + have hmain : Matrix.mulVec (CircleMatrix C) (centroidVec B.1 - centroidVec A.1) = + slopeVec B.2 - slopeVec A.2 := by + rw [hcentVec, Matrix.mulVec_smul, hin, hslopeVec] + change invariant A = invariant B + dsimp [invariant] + ext n + fin_cases n + · have heq := congrFun hmain 0 + simp [slopeVec, centroidVec, hp, hp', Matrix.mulVec, + dotProduct, Fin.sum_univ_two] at heq ⊢ + linear_combination heq + · have heq := congrFun hmain 1 + simp [slopeVec, centroidVec, hp, hp', Matrix.mulVec, + dotProduct, Fin.sum_univ_two] at heq ⊢ + linear_combination heq + have hfirstChain : (tiles.zip hs).IsChain invRel := hf.2.2.imp invStep + have hsecondChain : (reverseTiles.zip reverseHs).IsChain invRel := hr.2.2.imp invStep + let : Trans invRel invRel invRel := ⟨by + intro a b c hab hbc + exact hab.trans hbc⟩ + let : Std.Refl invRel := ⟨fun _ => rfl⟩ + have hfirstPairwise := List.isChain_iff_pairwise.mp hfirstChain + have hsecondPairwise := List.isChain_iff_pairwise.mp hsecondChain + obtain ⟨postTiles, hpostTiles⟩ := List.head?_eq_some_iff.mp hf.1.2.1 + obtain ⟨postHs, hpostHs⟩ := List.head?_eq_some_iff.mp hh + have hzipHead : tiles.zip hs = (R, hendpoint) :: postTiles.zip postHs := by + rw [hpostTiles, hpostHs] + rfl + obtain ⟨preTiles, hpreTiles⟩ := List.getLast?_eq_some_iff.mp hr.1.2.2.1 + obtain ⟨preHs, hpreHs⟩ := List.getLast?_eq_some_iff.mp hh' + have hlenPre : preTiles.length = preHs.length := by + have hlen := List.Forall₂.length_eq hr.2.1 + rw [hpreTiles, hpreHs, List.length_append, List.length_singleton, + List.length_append, List.length_singleton] at hlen + omega + have hzipLast : reverseTiles.zip reverseHs = preTiles.zip preHs ++ [(R, hendpoint)] := by + rw [hpreTiles, hpreHs, List.zip_append hlenPre] + simp + have hInvU : invariant (R, hendpoint) = invariant (U, g) := by + rw [hzipHead] at hfirstPairwise hU + simpa using hfirstPairwise.rel_head hU + have hInvV : invariant (V, k) = invariant (R, hendpoint) := by + rw [hzipLast] at hsecondPairwise hV + simpa using hsecondPairwise.rel_getLast hV + have hInvUV : invariant (U, g) = invariant (V, k) := hInvU.symm.trans hInvV.symm + refine ⟨s, t, hsg, htk, ?_, ?_⟩ + · have heq := congrFun hInvUV 0 + change slopeVec g 0 - (CircleMatrix C).mulVec (centroidVec U) 0 = + slopeVec k 0 - (CircleMatrix C).mulVec (centroidVec V) 0 at heq + simp [slopeVec, centroidVec, hsg, htk, Matrix.mulVec, + dotProduct, Fin.sum_univ_two] at heq + linear_combination -heq + · have heq := congrFun hInvUV 1 + change slopeVec g 1 - (CircleMatrix C).mulVec (centroidVec U) 1 = + slopeVec k 1 - (CircleMatrix C).mulVec (centroidVec V) 1 at heq + simp [slopeVec, centroidVec, hsg, htk, Matrix.mulVec, + dotProduct, Fin.sum_univ_two] at heq + linear_combination -heq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean new file mode 100644 index 0000000000..38c22df39b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean @@ -0,0 +1,1037 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P4194T1DiamondBoundaryLedger] + +/-! +# P4194T1DiamondBoundaryLedger + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiamondBoundaryProof + +/-- Classical decidability of membership in a tile's boundary vertices. -/ +@[instance_reducible] noncomputable def boundaryVertexDecidability + (T : ProtoTile) (z : GaussianInt) : Decidable (z ∈ BoundaryFootprintVertices T) := by + classical + infer_instance + +attribute [local instance] boundaryVertexDecidability + +private theorem hrow : + ∀ (m : Nat), ∀ (z : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ + DiamondCellDomain m) → ((1 : ℤ) ≤ z.im ∧ + z.im ≤ (2 : ℤ) * (↑m : ℤ) - (1 : ℤ) ∧ + -(z.im - (1 : ℤ)) ≤ z.re ∧ + z.re ≤ z.im - (1 : ℤ) ∧ -((2 : ℤ) * (↑m : ℤ) - z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * + (↑m : ℤ) - z.im - (1 : ℤ)) := by + classical + intro m z hz + exact (P4194T1DiamondCellRows m z).2.mp hz + +private theorem hm2 : + ∀ (m : Nat), (1 < m) → ((GaussianInt) → (2 ≤ m)) := by + classical + intro m hm z + omega + +private theorem hdesclow : + ∀ (m : Nat), (1 < m) → (∀ (z : GaussianInt), + let b := z.im + ((1 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑m : ℤ) - (1 : ℤ) ∧ -(z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ + z.im - (1 : ℤ) ∧ -((2 : ℤ) * (↑m : ℤ) - z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * (↑m : + ℤ) - z.im - (1 : ℤ)) → ((b < m) → (∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ + DiamondCellDomain (m - 1)))) := by + classical + intro m hm z b hrow hb + apply (P4194T1DiamondCellRows (m - 1) z).2.mpr + rcases hrow with ⟨h1, h2, h3, h4, h5, h6⟩ + constructor + · omega + constructor + · omega + constructor + · omega + constructor + · omega + constructor + · omega + · omega + +private theorem hdeschi : + ∀ (m : Nat), (1 < m) → (∀ (z : GaussianInt), + let b := z.im + ((1 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑m : ℤ) - (1 : ℤ) ∧ -(z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ + z.im - (1 : ℤ) ∧ -((2 : ℤ) * (↑m : ℤ) - z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * (↑m : + ℤ) - z.im - (1 : ℤ)) → (((m : Int) < b) → (∀ j : Fin 4, + LatticeVertexIncidentCell z j ∈ + (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩).cells))) := by + classical + intro m hm z b hrow hb + let w := z - ⟨0, 2⟩ + have hwrow := (P4194T1DiamondCellRows (m - 1) w).2 + have hw : ∀ j : Fin 4, LatticeVertexIncidentCell w j ∈ + DiamondCellDomain (m - 1) := by + apply hwrow.mpr + rcases hrow with ⟨h1, h2, h3, h4, h5, h6⟩ + dsimp [w] + simp [] + omega + have hu := (TileTranslationFormulas (DiamondTile (m - 1)) ⟨0, 2⟩).1 + intro j + rw [hu] + apply Finset.mem_image.mpr + refine ⟨LatticeVertexIncidentCell w j, hw j, ?_⟩ + fin_cases j <;> + simp [GaussianTranslation, LatticeVertexIncidentCell, w, + sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + +private theorem hloFourAtMid : + ∀ (m : Nat), (1 < m) → (∀ (z : GaussianInt), + let a := z.re + let b := z.im + ((1 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑m : ℤ) - (1 : ℤ) ∧ -(z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ + z.im - (1 : ℤ) ∧ -((2 : ℤ) * (↑m : ℤ) - z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * (↑m : + ℤ) - z.im - (1 : ℤ)) → ((b = m) → ((∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ + DiamondCellDomain (m - 1)) ↔ + -(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3))) := by + classical + intro m hm z a b hrow hmid + rw [(P4194T1DiamondCellRows (m - 1) z).2] + rcases hrow with ⟨h1, h2, h3, h4, h5, h6⟩ + omega + +private theorem hsomeLoMid : + ∀ (m : Nat), (1 < m) → (∀ (z : GaussianInt), + let b := z.im + ((1 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑m : ℤ) - (1 : ℤ) ∧ -(z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ + z.im - (1 : ℤ) ∧ -((2 : ℤ) * (↑m : ℤ) - z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * (↑m : + ℤ) - z.im - (1 : ℤ)) → ((b = m) → (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ + DiamondCellDomain (m - 1)))) := by + classical + intro m hm z b hrow hmid + let a := z.re + rcases hrow with ⟨h1, h2, h3, h4, h5, h6⟩ + by_cases ha : a ≤ (m : Int) - 2 + · refine ⟨3, ?_⟩ + have heq : LatticeVertexIncidentCell z 3 = z - ⟨0, 1⟩ := by + simp [LatticeVertexIncidentCell] + rw [heq] + apply (P4194T1DiamondCellRows (m - 1) (z - ⟨0, 1⟩)).1.mpr + simp [] + omega + · refine ⟨2, ?_⟩ + have heq : LatticeVertexIncidentCell z 2 = z - 1 - ⟨0, 1⟩ := by + simp [LatticeVertexIncidentCell] + rw [heq] + apply (P4194T1DiamondCellRows (m - 1) (z - 1 - ⟨0, 1⟩)).1.mpr + simp [] + omega + +private theorem hsomeHiMid : + ∀ (m : Nat), (1 < m) → (∀ (z : GaussianInt), + let b := z.im + ((1 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑m : ℤ) - (1 : ℤ) ∧ -(z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ + z.im - (1 : ℤ) ∧ -((2 : ℤ) * (↑m : ℤ) - z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * (↑m : + ℤ) - z.im - (1 : ℤ)) → ((b = m) → (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ + (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩).cells))) := by + classical + intro m hm z b hrow hmid + let a := z.re + let w := z - ⟨0, 2⟩ + have hu := (TileTranslationFormulas (DiamondTile (m - 1)) ⟨0, 2⟩).1 + rcases hrow with ⟨h1, h2, h3, h4, h5, h6⟩ + by_cases ha : a ≤ (m : Int) - 2 + · have hc : w ∈ DiamondCellDomain (m - 1) := by + apply (P4194T1DiamondCellRows (m - 1) w).1.mpr + simp [w] + omega + refine ⟨0, ?_⟩ + rw [hu] + refine Finset.mem_image.mpr ⟨w, hc, ?_⟩ + simp [GaussianTranslation, LatticeVertexIncidentCell, w] + · have hc : w - 1 ∈ DiamondCellDomain (m - 1) := by + apply (P4194T1DiamondCellRows (m - 1) (w - 1)).1.mpr + simp [w] + omega + refine ⟨1, ?_⟩ + rw [hu] + refine Finset.mem_image.mpr ⟨w - 1, hc, ?_⟩ + simp [GaussianTranslation, LatticeVertexIncidentCell, w, + sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + +private theorem hhiFourAtMid : + ∀ (m : Nat), (1 < m) → (∀ (z : GaussianInt), + let a := z.re + let b := z.im + ((1 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑m : ℤ) - (1 : ℤ) ∧ -(z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ + z.im - (1 : ℤ) ∧ -((2 : ℤ) * (↑m : ℤ) - z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * (↑m : + ℤ) - z.im - (1 : ℤ)) → ((b = m) → ((∀ j : Fin 4, LatticeVertexIncidentCell (z - ⟨0, 2⟩) j ∈ + DiamondCellDomain (m - 1)) ↔ + -(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3))) := by + classical + intro m hm z a b hrow hmid + let w := z - ⟨0, 2⟩ + rw [(P4194T1DiamondCellRows (m - 1) w).2] + rcases hrow with ⟨h1, h2, h3, h4, h5, h6⟩ + simp [w] + omega + +private theorem translationBoundary : + ∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (x : GaussianInt), GaussianTranslation u x ∈ + BoundaryFootprintVertices (TileTranslation T u) ↔ + x ∈ BoundaryFootprintVertices T := by + classical + intro T u x + rcases TileTranslationFormulas T u with ⟨_, _, _, _, _, _, _, hbound, _⟩ + rw [hbound] + simp [GaussianTranslation] + +private theorem translationCell : + ∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (x : GaussianInt), ∀ (j : Fin 4), + LatticeVertexIncidentCell (GaussianTranslation u x) j ∈ + (TileTranslation T u).cells ↔ + LatticeVertexIncidentCell x j ∈ T.cells := by + classical + intro T u x j + have hcalc : LatticeVertexIncidentCell (GaussianTranslation u x) j = + GaussianTranslation u (LatticeVertexIncidentCell x j) := by + fin_cases j <;> + simp [GaussianTranslation, LatticeVertexIncidentCell, + sub_eq_add_neg, add_assoc, add_comm] + rw [(TileTranslationFormulas T u).1, hcalc] + simp only [Finset.mem_image] + constructor + · rintro ⟨y, hy, heq⟩ + have heq' : y = LatticeVertexIncidentCell x j := by + have hh := congrArg (fun q : GaussianInt => q - u) + (by simpa [GaussianTranslation] using heq) + simpa using hh + simpa [heq'] using hy + · intro hy + exact ⟨LatticeVertexIncidentCell x j, hy, rfl⟩ + +private theorem boundaryIffMissing : + ∀ (n : Nat), (0 < n) → (∀ (x : GaussianInt), (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ DiamondCellDomain n) → (x ∈ BoundaryFootprintVertices + (DiamondTile n) ↔ + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ DiamondCellDomain n)) := by + classical + intro n hn x hsome + rw [(P4194T1DiamondVertexIncidence n hn x).2] + exact ⟨fun h => h.2, fun h => ⟨hsome, h⟩⟩ + +private theorem hpredFalseMid : + ∀ (m : Nat), (1 < m) → (∀ (z : GaussianInt), + let a := z.re + let b := z.im + ((b = m) → ((∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ DiamondCellDomain (m - 1)) ↔ -(m : + Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3)) → (((b = m) → (∃ j : Fin 4, LatticeVertexIncidentCell + z j ∈ DiamondCellDomain (m - 1))) → ((∀ (n : Nat), (0 < n) → (∀ (x : GaussianInt), (∃ j : + Fin 4, LatticeVertexIncidentCell x j ∈ DiamondCellDomain n) → (x ∈ + BoundaryFootprintVertices (DiamondTile n) ↔ ∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ + DiamondCellDomain n))) → ((b = m) → (z ∈ BoundaryFootprintVertices (DiamondTile (m - 1)) ↔ + ¬ (-(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3)))))) := by + classical + intro m hm z a b hloFourAtMid hsomeLoMid boundaryIffMissing hmid + have hn : 0 < m - 1 := by omega + rw [boundaryIffMissing (m - 1) hn z (hsomeLoMid hmid)] + rw [← not_forall] + rw [hloFourAtMid hmid] + +private theorem hpredTrueMid : + ∀ (m : Nat), (1 < m) → (∀ (z : GaussianInt), + let a := z.re + let b := z.im + ((b = m) → (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ (TileTranslation (DiamondTile (m - + 1)) ⟨0, 2⟩).cells)) → (((b = m) → ((∀ j : Fin 4, LatticeVertexIncidentCell (z - ⟨0, 2⟩) j + ∈ DiamondCellDomain (m - 1)) ↔ -(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3)) → ((∀ (T : + ProtoTile), ∀ (u : GaussianInt), ∀ (x : GaussianInt), GaussianTranslation u x ∈ + BoundaryFootprintVertices (TileTranslation T u) ↔ x ∈ BoundaryFootprintVertices T) → ((∀ + (T : ProtoTile), ∀ (u : GaussianInt), ∀ (x : GaussianInt), ∀ (j : Fin 4), + LatticeVertexIncidentCell (GaussianTranslation u x) j ∈ (TileTranslation T u).cells ↔ + LatticeVertexIncidentCell x j ∈ T.cells) → ((∀ (n : Nat), (0 < n) → (∀ (x : GaussianInt), + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ DiamondCellDomain n) → (x ∈ + BoundaryFootprintVertices (DiamondTile n) ↔ ∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ + DiamondCellDomain n))) → ((b = m) → (z ∈ BoundaryFootprintVertices + (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩) ↔ + ¬ (-(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3)))))))) := by + classical + intro m hm z a b hsomeHiMid hhiFourAtMid translationBoundary translationCell boundaryIffMissing + hmid + let w := z - ⟨0, 2⟩ + have hshift : GaussianTranslation ⟨0, 2⟩ w = z := by + simp [GaussianTranslation, w] + have hsomeW : ∃ j : Fin 4, LatticeVertexIncidentCell w j ∈ + DiamondCellDomain (m - 1) := by + rcases hsomeHiMid hmid with ⟨j, hj⟩ + have hj' : LatticeVertexIncidentCell + (GaussianTranslation ⟨0, 2⟩ w) j ∈ + (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩).cells := by + simpa [hshift] using hj + exact ⟨j, (translationCell (DiamondTile (m - 1)) ⟨0, 2⟩ w j).mp hj'⟩ + have hmissCore : (∃ j : Fin 4, + LatticeVertexIncidentCell w j ∉ DiamondCellDomain (m - 1)) ↔ + ¬ (-(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3) := by + rw [← not_forall] + rw [hhiFourAtMid hmid] + rw [← hshift, translationBoundary (DiamondTile (m - 1)) ⟨0, 2⟩ w] + rw [boundaryIffMissing (m - 1) (by omega) w hsomeW, hmissCore] + +private theorem unitBoundary : + (Nat) → ((GaussianInt) → (∀ (c : GaussianInt), ∀ (x : GaussianInt), x ∈ + BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) ↔ + x = c ∨ x = c + 1 ∨ x = c + ⟨0, 1⟩ ∨ x = c + 1 + ⟨0, 1⟩)) := by + classical + intro m z c x + classical + have ht : ({c} : Finset GaussianInt).Nonempty := ⟨c, by simp⟩ + have hmissI : c - ⟨0, 1⟩ ∉ ({c} : Finset GaussianInt) := by + simp only [Finset.mem_singleton] + intro he + have him := congrArg Zsqrtd.im he + simp at him + have hmissR : c - 1 ∉ ({c} : Finset GaussianInt) := by + simp only [Finset.mem_singleton] + intro he + have hre := congrArg Zsqrtd.re he + simp at hre + have hbottom : x = c ∨ x = c + 1 → + x ∈ BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) := by + intro hx + rcases hx with hx | hx + · rw [hx] + simp only [BoundaryFootprintVertices, ite_eq_left ht, Set.mem_ofPred_eq] + refine ⟨{c, c + 1}, ?_, by simp⟩ + exact ⟨c, Or.inl ⟨rfl, Or.inl ⟨by simp, hmissI⟩⟩⟩ + · rw [hx] + simp only [BoundaryFootprintVertices, ite_eq_left ht, Set.mem_ofPred_eq] + refine ⟨{c, c + 1}, ?_, by simp⟩ + exact ⟨c, Or.inl ⟨rfl, Or.inl ⟨by simp, hmissI⟩⟩⟩ + have hleft : x = c + ⟨0, 1⟩ → + x ∈ BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) := by + intro hx + rw [hx] + simp only [BoundaryFootprintVertices, ite_eq_left ht, Set.mem_ofPred_eq] + refine ⟨{c, c + ⟨0, 1⟩}, ?_, by simp⟩ + exact ⟨c, Or.inr ⟨rfl, Or.inl ⟨by simp, hmissR⟩⟩⟩ + have htop : x = c + 1 + ⟨0, 1⟩ → + x ∈ BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) := by + intro hx + rw [hx] + simp only [BoundaryFootprintVertices, ite_eq_left ht, Set.mem_ofPred_eq] + refine ⟨{c + ⟨0, 1⟩, c + ⟨0, 1⟩ + 1}, ?_, ?_⟩ + · simp only [BoundaryFootprintEdges, Set.mem_ofPred_eq] + refine ⟨c + ⟨0, 1⟩, Or.inl ⟨rfl, Or.inr ⟨?_, ?_⟩⟩⟩ + · simp [Zsqrtd.ext_iff] + · simp [sub_eq_add_neg, add_assoc] + · simp [add_assoc, add_comm, add_left_comm] + constructor + · intro hx + simp? [BoundaryFootprintVertices, BoundaryFootprintEdges, + Finset.mem_singleton, sub_eq_add_neg, + Zsqrtd.ext_iff] at hx + rcases hx with ⟨e, ⟨w, hEdge⟩, hv⟩ + rcases hEdge with ⟨he, hc⟩ | ⟨he, hc⟩ + · subst e + cases w with + | mk wr wi => + simp_all [Finset.mem_insert, Finset.mem_singleton, + Zsqrtd.ext_iff, sub_eq_add_neg, add_assoc, add_comm] + omega + · subst e + cases w with + | mk wr wi => + simp_all [Finset.mem_insert, Finset.mem_singleton, + Zsqrtd.ext_iff, sub_eq_add_neg, add_assoc, add_comm] + omega + · rintro (hx | hx | hx | hx) + · exact hbottom (Or.inl hx) + · exact hbottom (Or.inr hx) + · exact hleft hx + · exact htop hx + +private theorem hunit00 : + ∀ (m : Nat), ∀ (C : Fin 3 → Bool → ProtoTile), (C 0 true = ⟨{⟨-(m : Int), (m : Int) - 1⟩}, + ⟨-(m : Int), (m : Int) - 1⟩⟩) → (∀ (z : GaussianInt), + let a := z.re + let b := z.im + (∀ (c : GaussianInt), ∀ (x : GaussianInt), x ∈ BoundaryFootprintVertices (⟨{c}, c⟩ : + ProtoTile) ↔ x = c ∨ x = c + 1 ∨ x = c + ⟨0, 1⟩ ∨ x = c + 1 + ⟨0, 1⟩) → (z ∈ + BoundaryFootprintVertices (C 0 true) ↔ + (a = -(m : Int) ∧ b = (m : Int) - 1) ∨ + (a = -(m : Int) + 1 ∧ b = (m : Int) - 1) ∨ + (a = -(m : Int) ∧ b = (m : Int)) ∨ + (a = -(m : Int) + 1 ∧ b = (m : Int)))) := by + classical + intro m C h00 z a b unitBoundary + rw [h00, unitBoundary] + simp [Zsqrtd.ext_iff, Zsqrtd.add_def, a, b] + +private theorem hunit01 : + ∀ (m : Nat), ∀ (C : Fin 3 → Bool → ProtoTile), (C 0 false = ⟨{⟨(m : Int) - 1, (m : Int)⟩}, + ⟨(m : Int) - 1, (m : Int)⟩⟩) → (∀ (z : GaussianInt), + let a := z.re + let b := z.im + (∀ (c : GaussianInt), ∀ (x : GaussianInt), x ∈ BoundaryFootprintVertices (⟨{c}, c⟩ : + ProtoTile) ↔ x = c ∨ x = c + 1 ∨ x = c + ⟨0, 1⟩ ∨ x = c + 1 + ⟨0, 1⟩) → (z ∈ + BoundaryFootprintVertices (C 0 false) ↔ + (a = (m : Int) - 1 ∧ b = (m : Int)) ∨ + (a = (m : Int) ∧ b = (m : Int)) ∨ + (a = (m : Int) - 1 ∧ b = (m : Int) + 1) ∨ + (a = (m : Int) ∧ b = (m : Int) + 1))) := by + classical + intro m C h01 z a b unitBoundary + rw [h01, unitBoundary] + simp [Zsqrtd.ext_iff, Zsqrtd.add_def, a, b] + +private theorem hunit10 : + ∀ (m : Nat), ∀ (C : Fin 3 → Bool → ProtoTile), (C 1 true = ⟨{⟨(m : Int) - 1, (m : Int) - 1⟩}, + ⟨(m : Int) - 1, (m : Int) - 1⟩⟩) → (∀ (z : GaussianInt), + let a := z.re + let b := z.im + (∀ (c : GaussianInt), ∀ (x : GaussianInt), x ∈ BoundaryFootprintVertices (⟨{c}, c⟩ : + ProtoTile) ↔ x = c ∨ x = c + 1 ∨ x = c + ⟨0, 1⟩ ∨ x = c + 1 + ⟨0, 1⟩) → (z ∈ + BoundaryFootprintVertices (C 1 true) ↔ + (a = (m : Int) - 1 ∧ b = (m : Int) - 1) ∨ + (a = (m : Int) ∧ b = (m : Int) - 1) ∨ + (a = (m : Int) - 1 ∧ b = (m : Int)) ∨ + (a = (m : Int) ∧ b = (m : Int)))) := by + classical + intro m C h10 z a b unitBoundary + rw [h10, unitBoundary] + simp [Zsqrtd.ext_iff, Zsqrtd.add_def, a, b] + +private theorem hunit11 : + ∀ (m : Nat), ∀ (C : Fin 3 → Bool → ProtoTile), (C 1 false = ⟨{⟨-(m : Int), (m : Int)⟩}, ⟨-(m + : Int), (m : Int)⟩⟩) → (∀ (z : GaussianInt), + let a := z.re + let b := z.im + (∀ (c : GaussianInt), ∀ (x : GaussianInt), x ∈ BoundaryFootprintVertices (⟨{c}, c⟩ : + ProtoTile) ↔ x = c ∨ x = c + 1 ∨ x = c + ⟨0, 1⟩ ∨ x = c + 1 + ⟨0, 1⟩) → (z ∈ + BoundaryFootprintVertices (C 1 false) ↔ + (a = -(m : Int) ∧ b = (m : Int)) ∨ + (a = -(m : Int) + 1 ∧ b = (m : Int)) ∨ + (a = -(m : Int) ∧ b = (m : Int) + 1) ∨ + (a = -(m : Int) + 1 ∧ b = (m : Int) + 1))) := by + classical + intro m C h11 z a b unitBoundary + rw [h11, unitBoundary] + simp [Zsqrtd.ext_iff, Zsqrtd.add_def, a, b] + +private theorem hunitOff : + ∀ (m : Nat), ∀ (C : Fin 3 → Bool → ProtoTile), ∀ (z : GaussianInt), + let a := z.re + let b := z.im + ((1 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑m : ℤ) - (1 : ℤ) ∧ -(z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ + z.im - (1 : ℤ) ∧ -((2 : ℤ) * (↑m : ℤ) - z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * (↑m : + ℤ) - z.im - (1 : ℤ)) → ((z ∈ BoundaryFootprintVertices (C 0 true) ↔ (a = -(m : Int) ∧ b = + (m : Int) - 1) ∨ (a = -(m : Int) + 1 ∧ b = (m : Int) - 1) ∨ (a = -(m : Int) ∧ b = (m : + Int)) ∨ (a = -(m : Int) + 1 ∧ b = (m : Int))) → ((z ∈ BoundaryFootprintVertices (C 0 + false) ↔ (a = (m : Int) - 1 ∧ b = (m : Int)) ∨ (a = (m : Int) ∧ b = (m : Int)) ∨ (a = (m + : Int) - 1 ∧ b = (m : Int) + 1) ∨ (a = (m : Int) ∧ b = (m : Int) + 1)) → ((z ∈ + BoundaryFootprintVertices (C 1 true) ↔ (a = (m : Int) - 1 ∧ b = (m : Int) - 1) ∨ (a = (m + : Int) ∧ b = (m : Int) - 1) ∨ (a = (m : Int) - 1 ∧ b = (m : Int)) ∨ (a = (m : Int) ∧ b = + (m : Int))) → ((z ∈ BoundaryFootprintVertices (C 1 false) ↔ (a = -(m : Int) ∧ b = (m : + Int)) ∨ (a = -(m : Int) + 1 ∧ b = (m : Int)) ∨ (a = -(m : Int) ∧ b = (m : Int) + 1) ∨ (a + = -(m : Int) + 1 ∧ b = (m : Int) + 1)) → ((b ≠ m) → (z ∉ BoundaryFootprintVertices (C 0 + true) ∧ + z ∉ BoundaryFootprintVertices (C 0 false) ∧ + z ∉ BoundaryFootprintVertices (C 1 true) ∧ + z ∉ BoundaryFootprintVertices (C 1 false))))))) := by + classical + intro m C z a b hrow hunit00 hunit01 hunit10 hunit11 hnot + rcases hrow with ⟨h1, h2, h3, h4, h5, h6⟩ + constructor + · rw [hunit00] + omega + constructor + · rw [hunit01] + omega + constructor + · rw [hunit10] + omega + · rw [hunit11] + omega + +private theorem hpredFalseOff : + ∀ (m : Nat), (1 < m) → (∀ (z : GaussianInt), + let b := z.im + ((b < m) → (∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ DiamondCellDomain (m - 1))) → ((∀ (n + : Nat), (0 < n) → (∀ (x : GaussianInt), (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + DiamondCellDomain n) → (x ∈ BoundaryFootprintVertices (DiamondTile n) ↔ ∃ j : Fin 4, + LatticeVertexIncidentCell x j ∉ DiamondCellDomain n))) → ((b < m) → (z ∉ + BoundaryFootprintVertices (DiamondTile (m - 1)))))) := by + classical + intro m hm z b hdesclow boundaryIffMissing hbelow + have hn : 0 < m - 1 := by omega + have hall := hdesclow hbelow + have hsome : ∃ j : Fin 4, + LatticeVertexIncidentCell z j ∈ DiamondCellDomain (m - 1) := ⟨0, hall 0⟩ + rw [boundaryIffMissing (m - 1) hn z hsome] + rintro ⟨j, hj⟩ + exact hj (hall j) + +private theorem hpredTrueOff : + ∀ (m : Nat), (1 < m) → (∀ (z : GaussianInt), + let b := z.im + (((m : Int) < b) → (∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ (TileTranslation + (DiamondTile (m - 1)) ⟨0, 2⟩).cells)) → ((∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (x : + GaussianInt), GaussianTranslation u x ∈ BoundaryFootprintVertices (TileTranslation T u) ↔ + x ∈ BoundaryFootprintVertices T) → ((∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (x : + GaussianInt), ∀ (j : Fin 4), LatticeVertexIncidentCell (GaussianTranslation u x) j ∈ + (TileTranslation T u).cells ↔ LatticeVertexIncidentCell x j ∈ T.cells) → ((∀ (n : Nat), + (0 < n) → (∀ (x : GaussianInt), (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + DiamondCellDomain n) → (x ∈ BoundaryFootprintVertices (DiamondTile n) ↔ ∃ j : Fin 4, + LatticeVertexIncidentCell x j ∉ DiamondCellDomain n))) → (((m : Int) < b) → (z ∉ + BoundaryFootprintVertices + (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩))))))) := by + classical + intro m hm z b hdeschi translationBoundary translationCell boundaryIffMissing habove + let w := z - ⟨0, 2⟩ + have hshift : GaussianTranslation ⟨0, 2⟩ w = z := by + simp [GaussianTranslation, w] + have hall : ∀ j : Fin 4, + LatticeVertexIncidentCell w j ∈ DiamondCellDomain (m - 1) := by + intro j + have htranslated := hdeschi habove j + have htranslated' : LatticeVertexIncidentCell + (GaussianTranslation ⟨0, 2⟩ w) j ∈ + (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩).cells := by + simpa [hshift] using htranslated + exact (translationCell (DiamondTile (m - 1)) ⟨0, 2⟩ w j).mp htranslated' + have hn : 0 < m - 1 := by omega + have hsome : ∃ j : Fin 4, + LatticeVertexIncidentCell w j ∈ DiamondCellDomain (m - 1) := ⟨0, hall 0⟩ + have hnot : w ∉ BoundaryFootprintVertices (DiamondTile (m - 1)) := by + rw [boundaryIffMissing (m - 1) hn w hsome] + rintro ⟨j, hj⟩ + exact hj (hall j) + intro hz + have hz' : GaussianTranslation ⟨0, 2⟩ w ∈ + BoundaryFootprintVertices (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩) := by + simpa [hshift] using hz + exact hnot ((translationBoundary (DiamondTile (m - 1)) ⟨0, 2⟩ w).mp hz') + +private theorem hpredOff : + ∀ (m : Nat), ∀ (z : GaussianInt), + let b := z.im + ((b < m) → (z ∉ BoundaryFootprintVertices (DiamondTile (m - 1)))) → ((((m : Int) < b) → (z ∉ + BoundaryFootprintVertices (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩))) → ((b ≠ m) → + (z ∉ BoundaryFootprintVertices (DiamondTile (m - 1)) ∨ + z ∉ BoundaryFootprintVertices + (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩)))) := by + classical + intro m z b hpredFalseOff hpredTrueOff hnot + by_cases hbelow : b < m + · exact Or.inl (hpredFalseOff hbelow) + · have habove : (m : Int) < b := by omega + exact Or.inr (hpredTrueOff habove) + +private theorem hmidcore : + ∀ (m : Nat), ∀ (z : GaussianInt), + let a := z.re + (-(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3) ↔ + -((m : Int) - 3) ≤ a ∧ a ≤ (m : Int) - 3 := by + classical + intro m z a + omega + +private theorem hk : + ∀ (C : Fin 3 → Bool → ProtoTile), ∀ (z : GaussianInt), + let k := Nat.card {a : Fin 3 × Bool // + z ∈ BoundaryFootprintVertices (C a.1 a.2)} + k = + (if z ∈ BoundaryFootprintVertices (C 0 true) then 1 else 0) + + (if z ∈ BoundaryFootprintVertices (C 0 false) then 1 else 0) + + (if z ∈ BoundaryFootprintVertices (C 1 true) then 1 else 0) + + (if z ∈ BoundaryFootprintVertices (C 1 false) then 1 else 0) + + (if z ∈ BoundaryFootprintVertices (C 2 true) then 1 else 0) + + (if z ∈ BoundaryFootprintVertices (C 2 false) then 1 else 0) := by + classical + intro C z k + dsimp [k] + simp only [Nat.card_eq_fintype_card, Finset.card_eq_sum_ones, + Fintype.card_subtype, Finset.sum_filter] + rw [Fintype.sum_prod_type] + simp only [Fintype.sum_bool] + rw [Fin.sum_univ_succ, Fin.sum_univ_succ, Fin.sum_univ_succ] + simp + ring + +private theorem hcardOff : + ∀ (m : Nat), ∀ (C : Fin 3 → Bool → ProtoTile), (C 2 false = DiamondTile (m - 1)) → ((C 2 true + = TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩) → (∀ (z : GaussianInt), + let b := z.im + ((b ≠ m) → (z ∉ BoundaryFootprintVertices (C 0 true) ∧ z ∉ BoundaryFootprintVertices (C 0 + false) ∧ z ∉ BoundaryFootprintVertices (C 1 true) ∧ z ∉ BoundaryFootprintVertices (C 1 + false))) → (((b ≠ m) → (z ∉ BoundaryFootprintVertices (DiamondTile (m - 1)) ∨ z ∉ + BoundaryFootprintVertices (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩))) → ( + let k := Nat.card {a : Fin 3 × Bool // + z ∈ BoundaryFootprintVertices (C a.1 a.2)} + (k = (if z ∈ BoundaryFootprintVertices (C 0 true) then 1 else 0) + (if z ∈ + BoundaryFootprintVertices (C 0 false) then 1 else 0) + (if z ∈ BoundaryFootprintVertices + (C 1 true) then 1 else 0) + (if z ∈ BoundaryFootprintVertices (C 1 false) then 1 else 0) + + (if z ∈ BoundaryFootprintVertices (C 2 true) then 1 else 0) + (if z ∈ + BoundaryFootprintVertices (C 2 false) then 1 else 0)) → ((b ≠ m) → (k ≤ 1)))))) := by + classical + intro m C h2f h2t z b hunitOff hpredOff k hk hnot + rw [hk, h2t, h2f] + rcases hunitOff hnot with ⟨hu00, hu01, hu10, hu11⟩ + simp only [hu00, hu01, hu10, hu11] + rcases hpredOff hnot with hp | hp + · simp [hp] + split_ifs <;> omega + · simp [hp] + split_ifs <;> omega + +private theorem hcardMid : + ∀ (m : Nat), (1 < m) → (∀ (C : Fin 3 → Bool → ProtoTile), (C 2 false = DiamondTile (m - 1)) → + ((C 2 true = TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩) → (∀ (z : GaussianInt), + let a := z.re + let b := z.im + ((1 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑m : ℤ) - (1 : ℤ) ∧ -(z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ + z.im - (1 : ℤ) ∧ -((2 : ℤ) * (↑m : ℤ) - z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * (↑m : + ℤ) - z.im - (1 : ℤ)) → (((b = m) → (z ∈ BoundaryFootprintVertices (DiamondTile (m - 1)) ↔ + ¬ (-(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3))) → (((b = m) → (z ∈ BoundaryFootprintVertices + (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩) ↔ ¬ (-(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - + 3))) → ((z ∈ BoundaryFootprintVertices (C 0 true) ↔ (a = -(m : Int) ∧ b = (m : Int) - 1) + ∨ (a = -(m : Int) + 1 ∧ b = (m : Int) - 1) ∨ (a = -(m : Int) ∧ b = (m : Int)) ∨ (a = -(m + : Int) + 1 ∧ b = (m : Int))) → ((z ∈ BoundaryFootprintVertices (C 0 false) ↔ (a = (m : + Int) - 1 ∧ b = (m : Int)) ∨ (a = (m : Int) ∧ b = (m : Int)) ∨ (a = (m : Int) - 1 ∧ b = (m + : Int) + 1) ∨ (a = (m : Int) ∧ b = (m : Int) + 1)) → ((z ∈ BoundaryFootprintVertices (C 1 + true) ↔ (a = (m : Int) - 1 ∧ b = (m : Int) - 1) ∨ (a = (m : Int) ∧ b = (m : Int) - 1) ∨ + (a = (m : Int) - 1 ∧ b = (m : Int)) ∨ (a = (m : Int) ∧ b = (m : Int))) → ((z ∈ + BoundaryFootprintVertices (C 1 false) ↔ (a = -(m : Int) ∧ b = (m : Int)) ∨ (a = -(m : + Int) + 1 ∧ b = (m : Int)) ∨ (a = -(m : Int) ∧ b = (m : Int) + 1) ∨ (a = -(m : Int) + 1 ∧ + b = (m : Int) + 1)) → ( + let k := Nat.card {a : Fin 3 × Bool // + z ∈ BoundaryFootprintVertices (C a.1 a.2)} + (k = (if z ∈ BoundaryFootprintVertices (C 0 true) then 1 else 0) + (if z ∈ + BoundaryFootprintVertices (C 0 false) then 1 else 0) + (if z ∈ BoundaryFootprintVertices + (C 1 true) then 1 else 0) + (if z ∈ BoundaryFootprintVertices (C 1 false) then 1 else 0) + + (if z ∈ BoundaryFootprintVertices (C 2 true) then 1 else 0) + (if z ∈ + BoundaryFootprintVertices (C 2 false) then 1 else 0)) → ((b = m) → (k = 2 * (if a = -(m : + Int) + 1 then 1 else 0) + + 2 * (if a = (m : Int) - 1 then 1 else 0) + + 2 * (if ¬ (-(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3) + then 1 else 0))))))))))))) := by + classical + intro m hm C h2f h2t z a b hrow hpredFalseMid hpredTrueMid hunit00 hunit01 hunit10 hunit11 k hk + hmid + simp only [hk, hunit00, hunit01, hunit10, hunit11] + rw [h2t, h2f] + simp only [hpredTrueMid hmid, hpredFalseMid hmid] + rcases hrow with ⟨h1, h2, h3, h4, h5, h6⟩ + simp [hmid] + split_ifs <;> omega + +private theorem hmidClass : + ∀ (m : Nat), (1 < m) → (∀ (C : Fin 3 → Bool → ProtoTile), ∀ (z : GaussianInt), + let a := z.re + let b := z.im + ((1 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑m : ℤ) - (1 : ℤ) ∧ -(z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ + z.im - (1 : ℤ) ∧ -((2 : ℤ) * (↑m : ℤ) - z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * (↑m : + ℤ) - z.im - (1 : ℤ)) → ( + let k := Nat.card {a : Fin 3 × Bool // + z ∈ BoundaryFootprintVertices (C a.1 a.2)} + ((b = m) → (k = 2 * (if a = -(m : Int) + 1 then 1 else 0) + 2 * (if a = (m : Int) - 1 then 1 + else 0) + 2 * (if ¬ (-(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3) then 1 else 0))) → ((b = m) + → ((k = 2 ↔ a = (m : Int) - 2 ∨ a = -((m : Int) - 2)) ∧ + k ≠ 3 ∧ + (k = 4 ↔ a = (m : Int) - 1 ∨ a = -((m : Int) - 1)) ∧ + (k = 0 ↔ -((m : Int) - 3) ≤ a ∧ a ≤ (m : Int) - 3))))) := by + classical + intro m hm C z a b hrow k hcardMid hmid + rw [hcardMid hmid] + rcases hrow with ⟨h1, h2, h3, h4, h5, h6⟩ + have hmid' : z.im = (m : Int) := by simpa [b] using hmid + rw [hmid'] at h1 h2 h3 h4 h5 h6 + dsimp [a] at * + by_cases hl : z.re = -(m : Int) + 1 + · by_cases hr : z.re = (m : Int) - 1 + · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> + simp? [hl] <;> (try split_ifs) <;> omega + · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> + simp? [hl] <;> (try split_ifs) <;> omega + · by_cases hr : z.re = (m : Int) - 1 + · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> + simp? [hr] <;> (try split_ifs) <;> omega + · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> + simp? [hl, hr, hc] <;> (try split_ifs) <;> omega + +private theorem htwoOff : + ∀ (m : Nat), ∀ (C : Fin 3 → Bool → ProtoTile), ∀ (z : GaussianInt), + let a := z.re + let b := z.im + let k := Nat.card {a : Fin 3 × Bool // + z ∈ BoundaryFootprintVertices (C a.1 a.2)} + (k = (if z ∈ BoundaryFootprintVertices (C 0 true) then 1 else 0) + (if z ∈ + BoundaryFootprintVertices (C 0 false) then 1 else 0) + (if z ∈ BoundaryFootprintVertices + (C 1 true) then 1 else 0) + (if z ∈ BoundaryFootprintVertices (C 1 false) then 1 else 0) + + (if z ∈ BoundaryFootprintVertices (C 2 true) then 1 else 0) + (if z ∈ + BoundaryFootprintVertices (C 2 false) then 1 else 0)) → (((b ≠ m) → (k ≤ 1)) → ((b ≠ m) → + ((k = 2 ↔ b = m ∧ + (a = (m : Int) - 2 ∨ a = -((m : Int) - 2)))))) := by + classical + intro m C z a b k hk hcardOff hnot + constructor + · intro hk2 + have := hcardOff hnot + omega + · intro hh + exact (hnot hh.1).elim + +private theorem hfourOff : + ∀ (m : Nat), ∀ (C : Fin 3 → Bool → ProtoTile), ∀ (z : GaussianInt), + let a := z.re + let b := z.im + let k := Nat.card {a : Fin 3 × Bool // + z ∈ BoundaryFootprintVertices (C a.1 a.2)} + (k = (if z ∈ BoundaryFootprintVertices (C 0 true) then 1 else 0) + (if z ∈ + BoundaryFootprintVertices (C 0 false) then 1 else 0) + (if z ∈ BoundaryFootprintVertices + (C 1 true) then 1 else 0) + (if z ∈ BoundaryFootprintVertices (C 1 false) then 1 else 0) + + (if z ∈ BoundaryFootprintVertices (C 2 true) then 1 else 0) + (if z ∈ + BoundaryFootprintVertices (C 2 false) then 1 else 0)) → (((b ≠ m) → (k ≤ 1)) → ((b ≠ m) → + ((k = 4 ↔ b = m ∧ + (a = (m : Int) - 1 ∨ a = -((m : Int) - 1)))))) := by + classical + intro m C z a b k hk hcardOff hnot + constructor + · intro hk4 + have := hcardOff hnot + omega + · intro hh + exact (hnot hh.1).elim + +private theorem htwo : + ∀ (m : Nat), ∀ (C : Fin 3 → Bool → ProtoTile), ∀ (z : GaussianInt), + let a := z.re + let b := z.im + let k := Nat.card {a : Fin 3 × Bool // + z ∈ BoundaryFootprintVertices (C a.1 a.2)} + ((b = m) → ((k = 2 ↔ a = (m : Int) - 2 ∨ a = -((m : Int) - 2)) ∧ k ≠ 3 ∧ (k = 4 ↔ a = (m : + Int) - 1 ∨ a = -((m : Int) - 1)) ∧ (k = 0 ↔ -((m : Int) - 3) ≤ a ∧ a ≤ (m : Int) - 3))) → + (((b ≠ m) → ((k = 2 ↔ b = m ∧ (a = (m : Int) - 2 ∨ a = -((m : Int) - 2))))) → (k = 2 ↔ b + = m ∧ + (a = (m : Int) - 2 ∨ a = -((m : Int) - 2)))) := by + classical + intro m C z a b k hmidClass htwoOff + by_cases hmid : b = m + · simpa [hmid] using (hmidClass hmid).1 + · exact htwoOff hmid + +private theorem hfour : + ∀ (m : Nat), ∀ (C : Fin 3 → Bool → ProtoTile), ∀ (z : GaussianInt), + let a := z.re + let b := z.im + let k := Nat.card {a : Fin 3 × Bool // + z ∈ BoundaryFootprintVertices (C a.1 a.2)} + ((b = m) → ((k = 2 ↔ a = (m : Int) - 2 ∨ a = -((m : Int) - 2)) ∧ k ≠ 3 ∧ (k = 4 ↔ a = (m : + Int) - 1 ∨ a = -((m : Int) - 1)) ∧ (k = 0 ↔ -((m : Int) - 3) ≤ a ∧ a ≤ (m : Int) - 3))) → + (((b ≠ m) → ((k = 4 ↔ b = m ∧ (a = (m : Int) - 1 ∨ a = -((m : Int) - 1))))) → (k = 4 ↔ b + = m ∧ + (a = (m : Int) - 1 ∨ a = -((m : Int) - 1)))) := by + classical + intro m C z a b k hmidClass hfourOff + by_cases hmid : b = m + · simpa [hmid] using (hmidClass hmid).2.2.1 + · exact hfourOff hmid + +private theorem hnotThree : + ∀ (m : Nat), ∀ (C : Fin 3 → Bool → ProtoTile), ∀ (z : GaussianInt), + let a := z.re + let b := z.im + let k := Nat.card {a : Fin 3 × Bool // + z ∈ BoundaryFootprintVertices (C a.1 a.2)} + (k = (if z ∈ BoundaryFootprintVertices (C 0 true) then 1 else 0) + (if z ∈ + BoundaryFootprintVertices (C 0 false) then 1 else 0) + (if z ∈ BoundaryFootprintVertices + (C 1 true) then 1 else 0) + (if z ∈ BoundaryFootprintVertices (C 1 false) then 1 else 0) + + (if z ∈ BoundaryFootprintVertices (C 2 true) then 1 else 0) + (if z ∈ + BoundaryFootprintVertices (C 2 false) then 1 else 0)) → (((b ≠ m) → (k ≤ 1)) → (((b = m) + → ((k = 2 ↔ a = (m : Int) - 2 ∨ a = -((m : Int) - 2)) ∧ k ≠ 3 ∧ (k = 4 ↔ a = (m : Int) - + 1 ∨ a = -((m : Int) - 1)) ∧ (k = 0 ↔ -((m : Int) - 3) ≤ a ∧ a ≤ (m : Int) - 3))) → (k ≠ + 3))) := by + classical + intro m C z a b k hk hcardOff hmidClass + by_cases hmid : b = m + · exact (hmidClass hmid).2.1 + · have := hcardOff hmid + omega + +private theorem hzeroMid : + ∀ (m : Nat), ∀ (C : Fin 3 → Bool → ProtoTile), ∀ (z : GaussianInt), + let a := z.re + let b := z.im + let k := Nat.card {a : Fin 3 × Bool // + z ∈ BoundaryFootprintVertices (C a.1 a.2)} + ((b = m) → ((k = 2 ↔ a = (m : Int) - 2 ∨ a = -((m : Int) - 2)) ∧ k ≠ 3 ∧ (k = 4 ↔ a = (m : + Int) - 1 ∨ a = -((m : Int) - 1)) ∧ (k = 0 ↔ -((m : Int) - 3) ≤ a ∧ a ≤ (m : Int) - 3))) → + ((b = m) → ((k = 0 ↔ -((m : Int) - 3) ≤ a ∧ a ≤ (m : Int) - 3))) := by + classical + intro m C z a b k hmidClass hmid + exact (hmidClass hmid).2.2.2 + +private theorem hzero : + ∀ (m : Nat), ∀ (C : Fin 3 → Bool → ProtoTile), ∀ (z : GaussianInt), + let a := z.re + let b := z.im + let k := Nat.card {a : Fin 3 × Bool // + z ∈ BoundaryFootprintVertices (C a.1 a.2)} + ((b = m) → ((k = 0 ↔ -((m : Int) - 3) ≤ a ∧ a ≤ (m : Int) - 3))) → (b = m → + (k = 0 ↔ -((m : Int) - 3) ≤ a ∧ a ≤ (m : Int) - 3)) := by + classical + intro m C z a b k hzeroMid hmid + exact hzeroMid hmid + +private theorem hdescent : + ∀ (m : Nat), (1 < m) → (∀ (C : Fin 3 → Bool → ProtoTile), (C 2 false = DiamondTile (m - 1)) → + ((C 2 true = TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩) → (∀ (z : GaussianInt), + let a := z.re + let b := z.im + ((1 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑m : ℤ) - (1 : ℤ) ∧ -(z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ + z.im - (1 : ℤ) ∧ -((2 : ℤ) * (↑m : ℤ) - z.im - (1 : ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * (↑m : + ℤ) - z.im - (1 : ℤ)) → (((b < m) → (∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ + DiamondCellDomain (m - 1))) → ((((m : Int) < b) → (∀ j : Fin 4, LatticeVertexIncidentCell + z j ∈ (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩).cells)) → (((b = m) → ((∀ j : Fin 4, + LatticeVertexIncidentCell z j ∈ DiamondCellDomain (m - 1)) ↔ -(m : Int) + 3 ≤ a ∧ a ≤ (m + : Int) - 3)) → (((-(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3) ↔ -((m : Int) - 3) ≤ a ∧ a ≤ (m + : Int) - 3) → ( + let k := Nat.card {a : Fin 3 × Bool // + z ∈ BoundaryFootprintVertices (C a.1 a.2)} + ((b = m) → (k = 2 * (if a = -(m : Int) + 1 then 1 else 0) + 2 * (if a = (m : Int) - 1 then 1 + else 0) + 2 * (if ¬ (-(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3) then 1 else 0))) → (((b = m) + → ((k = 0 ↔ -((m : Int) - 3) ≤ a ∧ a ≤ (m : Int) - 3))) → ((k = 2 ∨ k = 4) ∨ + ∃ s : Bool, ∀ j : Fin 4, + LatticeVertexIncidentCell z j ∈ (C 2 s).cells)))))))))) := by + classical + intro m hm C h2f h2t z a b hrow hdesclow hdeschi hloFourAtMid hmidcore k hcardMid hzeroMid + by_cases hmid : b = m + · by_cases hlarge : k = 2 ∨ k = 4 + · exact Or.inl hlarge + · have hknot2 : k ≠ 2 := fun h => hlarge (Or.inl h) + have hknot4 : k ≠ 4 := fun h => hlarge (Or.inr h) + have hcore : -((m : Int) - 3) ≤ a ∧ a ≤ (m : Int) - 3 := by + have hzero' := (hzeroMid hmid).2 + by_contra hn + have hnzero : k ≠ 0 := by + intro hzero + exact hn ((hzeroMid hmid).1 hzero) + rcases hrow with ⟨h1, h2, h3, h4, h5, h6⟩ + have hformula := hcardMid hmid + have hmid' : z.im = (m : Int) := by simpa [b] using hmid + rw [hmid'] at h1 h2 h3 h4 h5 h6 + dsimp [a] at * + by_cases hl : z.re = -(m : Int) + 1 + · by_cases hr : z.re = (m : Int) - 1 + · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> + simp? [hl] at hformula <;> (try split_ifs at hformula) <;> omega + · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> + simp? [hl] at hformula <;> (try split_ifs at hformula) <;> omega + · by_cases hr : z.re = (m : Int) - 1 + · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> + simp? [hr] at hformula <;> (try split_ifs at hformula) <;> omega + · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> + simp? [hl, hr, hc] at hformula <;> (try split_ifs at hformula) <;> omega + have hfourlo := (hloFourAtMid hmid).2 ((hmidcore).2 hcore) + refine Or.inr ⟨false, ?_⟩ + intro j + rw [h2f] + exact hfourlo j + · have hbelowOrAbove : b < m ∨ (m : Int) < b := by omega + rcases hbelowOrAbove with hbelow | habove + · refine Or.inr ⟨false, ?_⟩ + intro j + rw [h2f] + exact hdesclow hbelow j + · refine Or.inr ⟨true, ?_⟩ + intro j + rw [h2t] + exact hdeschi habove j + +end DiamondBoundaryProof + +theorem P4194T1DiamondBoundaryLedger + (m : Nat) (hm : 1 < m) (C : Fin 3 → Bool → ProtoTile) + (h00 : C 0 true = ⟨{⟨-(m : Int), (m : Int) - 1⟩}, ⟨-(m : Int), (m : Int) - 1⟩⟩) + (h01 : C 0 false = ⟨{⟨(m : Int) - 1, (m : Int)⟩}, ⟨(m : Int) - 1, (m : Int)⟩⟩) + (h10 : C 1 true = ⟨{⟨(m : Int) - 1, (m : Int) - 1⟩}, ⟨(m : Int) - 1, (m : Int) - 1⟩⟩) + (h11 : C 1 false = ⟨{⟨-(m : Int), (m : Int)⟩}, ⟨-(m : Int), (m : Int)⟩⟩) + (h2f : C 2 false = DiamondTile (m - 1)) + (h2t : C 2 true = TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩) + (z : GaussianInt) + (hz : ∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ DiamondCellDomain m) : + let k := Nat.card {a : Fin 3 × Bool // z ∈ BoundaryFootprintVertices (C a.1 a.2)} + (k = 2 ↔ z.im = (m : Int) ∧ + (z.re = (m : Int) - 2 ∨ z.re = -((m : Int) - 2))) ∧ + k ≠ 3 ∧ + (k = 4 ↔ z.im = (m : Int) ∧ + (z.re = (m : Int) - 1 ∨ z.re = -((m : Int) - 1))) ∧ + (z.im ≠ (m : Int) → k ≤ 1) ∧ + (z.im = (m : Int) → + (k = 0 ↔ -((m : Int) - 3) ≤ z.re ∧ z.re ≤ (m : Int) - 3)) ∧ + ((k = 2 ∨ k = 4) ∨ + ∃ s : Bool, ∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ (C 2 s).cells) := by +-- BODY + classical + let a := z.re + let b := z.im + have hrow := DiamondBoundaryProof.hrow m z hz + have hm2 : 2 ≤ m := DiamondBoundaryProof.hm2 m hm z + have hdesclow (hb : b < m) : + ∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ DiamondCellDomain (m - 1) := + DiamondBoundaryProof.hdesclow m hm z hrow hb + have hdeschi (hb : (m : Int) < b) : + ∀ j : Fin 4, + LatticeVertexIncidentCell z j ∈ + (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩).cells := DiamondBoundaryProof.hdeschi m + hm z hrow hb + have hloFourAtMid (hmid : b = m) : + (∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ DiamondCellDomain (m - 1)) ↔ + -(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3 := DiamondBoundaryProof.hloFourAtMid m hm z hrow hmid + have hsomeLoMid (hmid : b = m) : + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ DiamondCellDomain (m - 1) := + DiamondBoundaryProof.hsomeLoMid m hm z hrow hmid + have hsomeHiMid (hmid : b = m) : + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ + (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩).cells := DiamondBoundaryProof.hsomeHiMid m + hm z hrow hmid + have hhiFourAtMid (hmid : b = m) : + (∀ j : Fin 4, LatticeVertexIncidentCell (z - ⟨0, 2⟩) j ∈ + DiamondCellDomain (m - 1)) ↔ + -(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3 := DiamondBoundaryProof.hhiFourAtMid m hm z hrow hmid + have translationBoundary (T : ProtoTile) (u x : GaussianInt) : + GaussianTranslation u x ∈ BoundaryFootprintVertices (TileTranslation T u) ↔ + x ∈ BoundaryFootprintVertices T := DiamondBoundaryProof.translationBoundary T u x + have translationCell (T : ProtoTile) (u x : GaussianInt) (j : Fin 4) : + LatticeVertexIncidentCell (GaussianTranslation u x) j ∈ + (TileTranslation T u).cells ↔ + LatticeVertexIncidentCell x j ∈ T.cells := DiamondBoundaryProof.translationCell T u x j + have boundaryIffMissing (n : Nat) (hn : 0 < n) (x : GaussianInt) + (hsome : ∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ DiamondCellDomain n) : + x ∈ BoundaryFootprintVertices (DiamondTile n) ↔ + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ DiamondCellDomain n := + DiamondBoundaryProof.boundaryIffMissing n hn x hsome + have hpredFalseMid (hmid : b = m) : + z ∈ BoundaryFootprintVertices (DiamondTile (m - 1)) ↔ + ¬ (-(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3) := DiamondBoundaryProof.hpredFalseMid m hm z + hloFourAtMid hsomeLoMid boundaryIffMissing hmid + have hpredTrueMid (hmid : b = m) : + z ∈ BoundaryFootprintVertices + (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩) ↔ + ¬ (-(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3) := DiamondBoundaryProof.hpredTrueMid m hm z + hsomeHiMid hhiFourAtMid translationBoundary translationCell boundaryIffMissing hmid + have unitBoundary (c x : GaussianInt) : + x ∈ BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) ↔ + x = c ∨ x = c + 1 ∨ x = c + ⟨0, 1⟩ ∨ x = c + 1 + ⟨0, 1⟩ := + DiamondBoundaryProof.unitBoundary m z c x + have hunit00 : z ∈ BoundaryFootprintVertices (C 0 true) ↔ + (a = -(m : Int) ∧ b = (m : Int) - 1) ∨ + (a = -(m : Int) + 1 ∧ b = (m : Int) - 1) ∨ + (a = -(m : Int) ∧ b = (m : Int)) ∨ + (a = -(m : Int) + 1 ∧ b = (m : Int)) := DiamondBoundaryProof.hunit00 m C h00 z unitBoundary + have hunit01 : z ∈ BoundaryFootprintVertices (C 0 false) ↔ + (a = (m : Int) - 1 ∧ b = (m : Int)) ∨ + (a = (m : Int) ∧ b = (m : Int)) ∨ + (a = (m : Int) - 1 ∧ b = (m : Int) + 1) ∨ + (a = (m : Int) ∧ b = (m : Int) + 1) := DiamondBoundaryProof.hunit01 m C h01 z unitBoundary + have hunit10 : z ∈ BoundaryFootprintVertices (C 1 true) ↔ + (a = (m : Int) - 1 ∧ b = (m : Int) - 1) ∨ + (a = (m : Int) ∧ b = (m : Int) - 1) ∨ + (a = (m : Int) - 1 ∧ b = (m : Int)) ∨ + (a = (m : Int) ∧ b = (m : Int)) := DiamondBoundaryProof.hunit10 m C h10 z unitBoundary + have hunit11 : z ∈ BoundaryFootprintVertices (C 1 false) ↔ + (a = -(m : Int) ∧ b = (m : Int)) ∨ + (a = -(m : Int) + 1 ∧ b = (m : Int)) ∨ + (a = -(m : Int) ∧ b = (m : Int) + 1) ∨ + (a = -(m : Int) + 1 ∧ b = (m : Int) + 1) := DiamondBoundaryProof.hunit11 m C h11 z + unitBoundary + have hunitOff (hnot : b ≠ m) : + z ∉ BoundaryFootprintVertices (C 0 true) ∧ + z ∉ BoundaryFootprintVertices (C 0 false) ∧ + z ∉ BoundaryFootprintVertices (C 1 true) ∧ + z ∉ BoundaryFootprintVertices (C 1 false) := DiamondBoundaryProof.hunitOff m C z hrow + hunit00 hunit01 hunit10 hunit11 hnot + have hpredFalseOff (hbelow : b < m) : + z ∉ BoundaryFootprintVertices (DiamondTile (m - 1)) := DiamondBoundaryProof.hpredFalseOff m + hm z hdesclow boundaryIffMissing hbelow + have hpredTrueOff (habove : (m : Int) < b) : + z ∉ BoundaryFootprintVertices + (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩) := DiamondBoundaryProof.hpredTrueOff m hm + z hdeschi translationBoundary translationCell boundaryIffMissing habove + have hpredOff (hnot : b ≠ m) : + z ∉ BoundaryFootprintVertices (DiamondTile (m - 1)) ∨ + z ∉ BoundaryFootprintVertices + (TileTranslation (DiamondTile (m - 1)) ⟨0, 2⟩) := DiamondBoundaryProof.hpredOff m z + hpredFalseOff hpredTrueOff hnot + have hmidcore : + (-(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3) ↔ + -((m : Int) - 3) ≤ a ∧ a ≤ (m : Int) - 3 := DiamondBoundaryProof.hmidcore m z + let k := Nat.card {a : Fin 3 × Bool // + z ∈ BoundaryFootprintVertices (C a.1 a.2)} + have hk : k = + (if z ∈ BoundaryFootprintVertices (C 0 true) then 1 else 0) + + (if z ∈ BoundaryFootprintVertices (C 0 false) then 1 else 0) + + (if z ∈ BoundaryFootprintVertices (C 1 true) then 1 else 0) + + (if z ∈ BoundaryFootprintVertices (C 1 false) then 1 else 0) + + (if z ∈ BoundaryFootprintVertices (C 2 true) then 1 else 0) + + (if z ∈ BoundaryFootprintVertices (C 2 false) then 1 else 0) := DiamondBoundaryProof.hk C z + have hcardOff (hnot : b ≠ m) : k ≤ 1 := DiamondBoundaryProof.hcardOff m C h2f h2t z hunitOff + hpredOff hk hnot + have hcardMid (hmid : b = m) : + k = 2 * (if a = -(m : Int) + 1 then 1 else 0) + + 2 * (if a = (m : Int) - 1 then 1 else 0) + + 2 * (if ¬ (-(m : Int) + 3 ≤ a ∧ a ≤ (m : Int) - 3) + then 1 else 0) := DiamondBoundaryProof.hcardMid m hm C h2f h2t z hrow hpredFalseMid + hpredTrueMid hunit00 hunit01 hunit10 hunit11 hk hmid + have hmidClass (hmid : b = m) : + (k = 2 ↔ a = (m : Int) - 2 ∨ a = -((m : Int) - 2)) ∧ + k ≠ 3 ∧ + (k = 4 ↔ a = (m : Int) - 1 ∨ a = -((m : Int) - 1)) ∧ + (k = 0 ↔ -((m : Int) - 3) ≤ a ∧ a ≤ (m : Int) - 3) := DiamondBoundaryProof.hmidClass m hm C + z hrow hcardMid hmid + have htwoOff (hnot : b ≠ m) : + (k = 2 ↔ b = m ∧ + (a = (m : Int) - 2 ∨ a = -((m : Int) - 2))) := DiamondBoundaryProof.htwoOff m C z hk + hcardOff hnot + have hfourOff (hnot : b ≠ m) : + (k = 4 ↔ b = m ∧ + (a = (m : Int) - 1 ∨ a = -((m : Int) - 1))) := DiamondBoundaryProof.hfourOff m C z hk + hcardOff hnot + have htwo : k = 2 ↔ b = m ∧ + (a = (m : Int) - 2 ∨ a = -((m : Int) - 2)) := DiamondBoundaryProof.htwo m C z hmidClass + htwoOff + have hfour : k = 4 ↔ b = m ∧ + (a = (m : Int) - 1 ∨ a = -((m : Int) - 1)) := DiamondBoundaryProof.hfour m C z hmidClass + hfourOff + have hnotThree : k ≠ 3 := DiamondBoundaryProof.hnotThree m C z hk hcardOff hmidClass + have hzeroMid (hmid : b = m) : + (k = 0 ↔ -((m : Int) - 3) ≤ a ∧ a ≤ (m : Int) - 3) := DiamondBoundaryProof.hzeroMid m C z + hmidClass hmid + have hzero : b = m → + (k = 0 ↔ -((m : Int) - 3) ≤ a ∧ a ≤ (m : Int) - 3) := DiamondBoundaryProof.hzero m C z + hzeroMid + have hdescent : (k = 2 ∨ k = 4) ∨ + ∃ s : Bool, ∀ j : Fin 4, + LatticeVertexIncidentCell z j ∈ (C 2 s).cells := DiamondBoundaryProof.hdescent m hm C h2f + h2t z hrow hdesclow hdeschi hloFourAtMid hmidcore hcardMid hzeroMid + dsimp [a, b] + exact ⟨htwo, hnotThree, hfour, hcardOff, hzero, hdescent⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondCellRows.lean b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondCellRows.lean new file mode 100644 index 0000000000..4c11b43a28 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondCellRows.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.NormNum + +-- [TABLET NODE: P4194T1DiamondCellRows] + +/-! +# P4194T1DiamondCellRows + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4194T1DiamondCellRows (m : Nat) (z : GaussianInt) : + (z ∈ DiamondCellDomain m ↔ + 0 ≤ z.im ∧ z.im < 2 * (m : Int) ∧ + -(z.im + 1) ≤ z.re ∧ z.re < z.im + 1 ∧ + -(2 * (m : Int) - z.im) ≤ z.re ∧ z.re < 2 * (m : Int) - z.im) ∧ + ((∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ DiamondCellDomain m) ↔ + 1 ≤ z.im ∧ z.im ≤ 2 * (m : Int) - 1 ∧ + -(z.im - 1) ≤ z.re ∧ z.re ≤ z.im - 1 ∧ + -(2 * (m : Int) - z.im - 1) ≤ z.re ∧ + z.re ≤ 2 * (m : Int) - z.im - 1) := by +-- BODY + classical + have cell_iff (w : GaussianInt) : w ∈ DiamondCellDomain m ↔ + 0 ≤ w.im ∧ w.im < 2 * (m : Int) ∧ + -(w.im + 1) ≤ w.re ∧ w.re < w.im + 1 ∧ + -(2 * (m : Int) - w.im) ≤ w.re ∧ w.re < 2 * (m : Int) - w.im := by + constructor + · intro hz + simp only [DiamondCellDomain, Finset.mem_biUnion, Finset.mem_range, + Finset.mem_image] at hz + obtain ⟨b, hb, j, hj, heq⟩ := hz + have hre : (j : Int) - (min (b + 1) (2 * m - b) : Nat) = w.re := by + simpa using congrArg Zsqrtd.re heq + have him : (b : Int) = w.im := by + simpa using congrArg Zsqrtd.im heq + have hjI : (j : Int) < 2 * (min (b + 1) (2 * m - b) : Nat) := by + exact_mod_cast hj + have hmin1I : ((min (b + 1) (2 * m - b) : Nat) : Int) ≤ (b : Int) + 1 := by + exact_mod_cast (Nat.min_le_left (b + 1) (2 * m - b)) + have hmin2I : ((min (b + 1) (2 * m - b) : Nat) : Int) ≤ + ((2 * m - b : Nat) : Int) := by + exact_mod_cast (Nat.min_le_right (b + 1) (2 * m - b)) + have hsubcast : ((2 * m - b : Nat) : Int) = 2 * (m : Int) - b := by omega + omega + · rintro ⟨hb0, hb, hlo1, hhi1, hlo2, hhi2⟩ + let b := w.im.toNat + have hbc : (b : Int) = w.im := Int.toNat_of_nonneg hb0 + have hbn : b < 2 * m := by omega + let r := min (b + 1) (2 * m - b) + have hrc : (r : Int) = min (w.im + 1) (2 * (m : Int) - w.im) := by + dsimp [r] + rw [Nat.cast_min] + congr 1 <;> omega + have hrlo : -(r : Int) ≤ w.re := by omega + have hrhi : w.re < (r : Int) := by omega + let j := (w.re + r).toNat + have hjc : (j : Int) = w.re + r := Int.toNat_of_nonneg (by omega) + have hj : j < 2 * r := by omega + simp only [DiamondCellDomain, Finset.mem_biUnion, Finset.mem_range, + Finset.mem_image] + refine ⟨b, hbn, j, hj, ?_⟩ + apply Zsqrtd.ext + · change (j : Int) - (r : Int) = w.re + omega + · exact hbc + refine ⟨cell_iff z, ?_⟩ + have four : (∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ DiamondCellDomain m) ↔ + z ∈ DiamondCellDomain m ∧ z - 1 ∈ DiamondCellDomain m ∧ + z - 1 - ⟨0, 1⟩ ∈ DiamondCellDomain m ∧ z - ⟨0, 1⟩ ∈ DiamondCellDomain m := by + constructor + · intro h + exact ⟨h 0, h 1, h 2, h 3⟩ + · rintro ⟨h0, h1, h2, h3⟩ j + fin_cases j + · exact h0 + · exact h1 + · exact h2 + · exact h3 + rw [four] + simp only [cell_iff] + norm_num + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondCentroid.lean b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondCentroid.lean new file mode 100644 index 0000000000..08e8fcaea1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondCentroid.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P4194T1DiamondCentroid] + +/-! +# P4194T1DiamondCentroid + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4194T1DiamondCentroid (n : Nat) (hn : 0 < n) : + TileCentroid (DiamondTile n) = (0, (n : Real)) := by +-- BODY + let domain := DiamondCellDomain n + have hne : domain.Nonempty := by + refine ⟨0, (P4194T1DiamondCellRows n 0).1.mpr ?_⟩ + norm_num + omega + let reflectX : GaussianInt → GaussianInt := fun z => ⟨-z.re - 1, z.im⟩ + let reflectY : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (n : Int) - 1 - z.im⟩ + have reflectX_mem (z : GaussianInt) (hz : z ∈ domain) : reflectX z ∈ domain := by + apply (P4194T1DiamondCellRows n (reflectX z)).1.mpr + have h := (P4194T1DiamondCellRows n z).1.mp hz + dsimp [reflectX] + omega + have reflectY_mem (z : GaussianInt) (hz : z ∈ domain) : reflectY z ∈ domain := by + apply (P4194T1DiamondCellRows n (reflectY z)).1.mpr + have h := (P4194T1DiamondCellRows n z).1.mp hz + dsimp [reflectY] + omega + have sum_re_reflect : domain.sum (fun z => z.re) = + domain.sum (fun z => (reflectX z).re) := by + apply Finset.sum_bij (fun z _ => reflectX z) + · exact fun z hz => reflectX_mem z hz + · intro z hz w hw heq + apply Zsqrtd.ext + · simp [reflectX] at heq ⊢ + omega + · simp? [reflectX] at heq ⊢ + exact heq.2 + · intro z hz + refine ⟨reflectX z, reflectX_mem z hz, ?_⟩ + apply Zsqrtd.ext <;> simp [reflectX] + · intro z hz + simp [reflectX] + have sum_re_formula : domain.sum (fun z => z.re) * 2 = -(domain.card : Int) := by + have hsum := sum_re_reflect + simp only [reflectX] at hsum + rw [Finset.sum_sub_distrib, Finset.sum_const] at hsum + simp at hsum + linarith + have sum_im_reflect : domain.sum (fun z => z.im) = + domain.sum (fun z => (reflectY z).im) := by + apply Finset.sum_bij (fun z _ => reflectY z) + · exact fun z hz => reflectY_mem z hz + · intro z hz w hw heq + apply Zsqrtd.ext + · simp? [reflectY] at heq ⊢ + exact heq.1 + · simp [reflectY] at heq ⊢ + omega + · intro z hz + refine ⟨reflectY z, reflectY_mem z hz, ?_⟩ + apply Zsqrtd.ext <;> simp [reflectY] + · intro z hz + simp [reflectY] + have sum_im_formula : domain.sum (fun z => z.im) * 2 = + (2 * (n : Int) - 1) * domain.card := by + have hsum := sum_im_reflect + simp only [reflectY] at hsum + rw [Finset.sum_sub_distrib, Finset.sum_const] at hsum + simp at hsum + linarith + change (if domain.Nonempty then + (((domain.sum (fun z => z.re) : Int) : Real) / domain.card + (1 / 2 : Real), + ((domain.sum (fun z => z.im) : Int) : Real) / domain.card + (1 / 2 : Real)) + else _) = _ + rw [ite_eq_left hne] + apply Prod.ext <;> dsimp + · have hc : (0 : Real) < domain.card := by exact_mod_cast hne.card_pos + have hs : ((domain.sum (fun z => z.re) : Int) : Real) * 2 = + -(domain.card : Real) := by exact_mod_cast sum_re_formula + field_simp + linarith + · have hc : (0 : Real) < domain.card := by exact_mod_cast hne.card_pos + have hs : ((domain.sum (fun z => z.im) : Int) : Real) * 2 = + (2 * (n : Real) - 1) * domain.card := by exact_mod_cast sum_im_formula + field_simp + linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondVertexIncidence.lean b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondVertexIncidence.lean new file mode 100644 index 0000000000..6141c72e0b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondVertexIncidence.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary + +-- [TABLET NODE: P4194T1DiamondVertexIncidence] + +/-! +# P4194T1DiamondVertexIncidence + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4194T1DiamondVertexIncidence (n : Nat) (hn : 0 < n) (z : GaussianInt) : + (z ∈ FootprintVertices (DiamondTile n) ↔ + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ DiamondCellDomain n) ∧ + (z ∈ BoundaryFootprintVertices (DiamondTile n) ↔ + (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ DiamondCellDomain n) ∧ + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∉ DiamondCellDomain n) := by +-- BODY + classical + have hne : (DiamondTile n).cells.Nonempty := by + refine ⟨0, (P4194T1DiamondCellRows n 0).1.mpr ?_⟩ + norm_num + omega + have foot : z ∈ FootprintVertices (DiamondTile n) ↔ + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ DiamondCellDomain n := by + rw [FootprintVertices, ite_eq_left hne] + constructor + · rintro ⟨w, hw, rfl | rfl | rfl | rfl⟩ + · exact ⟨0, hw⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell, DiamondTile] using hw⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell, DiamondTile] using hw⟩ + · exact ⟨2, by simpa [LatticeVertexIncidentCell, DiamondTile, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hw⟩ + · rintro ⟨j, hj⟩ + refine ⟨LatticeVertexIncidentCell z j, hj, ?_⟩ + fin_cases j <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] + refine ⟨foot, ?_⟩ + constructor + · intro hb + have pair : (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ (DiamondTile n).cells) ∧ + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∉ (DiamondTile n).cells := by + simp only [BoundaryFootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hb + obtain ⟨e, ⟨w, he⟩, hz⟩ := hb + rcases he with ⟨rfl, hw⟩ | ⟨rfl, hw⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl + · rcases hw with ⟨hi, ho⟩ | ⟨ho, hi⟩ + · exact ⟨⟨0, hi⟩, ⟨3, ho⟩⟩ + · exact ⟨⟨3, hi⟩, ⟨0, ho⟩⟩ + · rcases hw with ⟨hi, ho⟩ | ⟨ho, hi⟩ + · exact ⟨⟨1, by simpa [LatticeVertexIncidentCell] using hi⟩, + ⟨2, by simpa [LatticeVertexIncidentCell] using ho⟩⟩ + · exact ⟨⟨2, by simpa [LatticeVertexIncidentCell] using hi⟩, + ⟨1, by simpa [LatticeVertexIncidentCell] using ho⟩⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl + · rcases hw with ⟨hi, ho⟩ | ⟨ho, hi⟩ + · exact ⟨⟨0, hi⟩, ⟨1, ho⟩⟩ + · exact ⟨⟨1, hi⟩, ⟨0, ho⟩⟩ + · rcases hw with ⟨hi, ho⟩ | ⟨ho, hi⟩ + · exact ⟨⟨3, by simpa [LatticeVertexIncidentCell] using hi⟩, + ⟨2, by simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using ho⟩⟩ + · exact ⟨⟨2, by simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hi⟩, + ⟨3, by simpa [LatticeVertexIncidentCell] using ho⟩⟩ + exact pair + · rintro ⟨hsome, hmissing⟩ + exact P3161T2IncidentBoundary (DiamondTile n) z hsome hmissing + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4207T1DiamondFormula.lean b/LeanPool/ApollonianSuperharmonic/P4207T1DiamondFormula.lean new file mode 100644 index 0000000000..5e10ba7726 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4207T1DiamondFormula.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction + +-- [TABLET NODE: P4207T1DiamondFormula] + +/-! +# P4207T1DiamondFormula + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The integer function $F=\operatorname{P4207\_T1\_DiamondFormula}$ on the Gaussian +lattice is +$$ + F(a,b)=\frac{|a|(|a|-1)}2-\left\lfloor\frac{(a-b)^2}{4}\right\rfloor. +$$ +The first quotient is integral. This is the displayed formula on the +canonical domain in the paper's diamond odometer lemma, considered as a +parameter-independent function on the whole lattice, not as a periodic +extension. +-/ +def P4207T1DiamondFormula : IntegerLatticeFunction := +-- BODY + fun x => (Int.natAbs x.re : Int) * ((Int.natAbs x.re : Int) - 1) / 2 - + (x.re - x.im) ^ 2 / 4 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4207T1FloorArithmetic.lean b/LeanPool/ApollonianSuperharmonic/P4207T1FloorArithmetic.lean new file mode 100644 index 0000000000..50409720d2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4207T1FloorArithmetic.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4207T1DiamondFormula +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P4207T1FloorArithmetic] + +/-! +# P4207T1FloorArithmetic + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4207T1FloorArithmetic : + (∀ n m : Int, (n + 2 * m) ^ 2 / 4 = n ^ 2 / 4 + m * n + m ^ 2) ∧ + (∀ n : Int, (n + 1) ^ 2 / 4 - n ^ 2 / 4 = (n + 1) / 2) ∧ + (∀ x : GaussianInt, + P4207T1DiamondFormula (x + ⟨0, 2⟩) - P4207T1DiamondFormula x = + x.re - x.im - 1) ∧ + (∀ a b : Int, + P4207T1DiamondFormula ⟨a, b + 1⟩ - P4207T1DiamondFormula ⟨a, b⟩ = + (a - b) / 2) ∧ + (∀ a b : Int, + P4207T1DiamondFormula ⟨-a, b⟩ = + P4207T1DiamondFormula ⟨a, b⟩ - a * b) := by +-- BODY + have shift (n m : Int) : (n + 2 * m) ^ 2 / 4 = n ^ 2 / 4 + m * n + m ^ 2 := by + have e : (n + 2 * m) ^ 2 = n ^ 2 + (m * n + m ^ 2) * 4 := by ring + rw [e, Int.add_mul_ediv_right] + · ring + · norm_num + have successive (n : Int) : (n + 1) ^ 2 / 4 - n ^ 2 / 4 = (n + 1) / 2 := by + have hr0 : 0 ≤ n % 2 := Int.emod_nonneg n (by norm_num) + have hr1 : n % 2 < 2 := Int.emod_lt_of_pos n (by norm_num) + have hn : n = n % 2 + 2 * (n / 2) := by omega + have hr : n % 2 = 0 ∨ n % 2 = 1 := by omega + generalize hq : n / 2 = q at * + rcases hr with hr | hr + · have he : n = 0 + 2 * q := by omega + have he' : n + 1 = 1 + 2 * q := by omega + rw [he', shift, he, shift] + norm_num + omega + · have he : n = 1 + 2 * q := by omega + have he' : n + 1 = 0 + 2 * (q + 1) := by omega + rw [he', shift, he, shift] + norm_num + ring + refine ⟨shift, successive, ?_, ?_, ?_⟩ + · intro x + change _ - (_ - (x.re - x.im) ^ 2 / 4) = _ + simp only [P4207T1DiamondFormula, Zsqrtd.re_add, Zsqrtd.im_add, add_zero] + have h := shift (x.re - x.im) (-1) + have he : (x.re - (x.im + 2)) = (x.re - x.im) + 2 * (-1) := by ring + rw [he, h] + ring + · intro a b + have h := successive (a - b - 1) + have he : a - b - 1 + 1 = a - b := by ring + rw [he] at h + simp only [P4207T1DiamondFormula] + have he' : a - (b + 1) = a - b - 1 := by ring + rw [he'] + omega + · intro a b + have h := shift (a - b) b + have he : a - b + 2 * b = a + b := by ring + rw [he] at h + have he' : (-a - b) ^ 2 = (a + b) ^ 2 := by ring + simp only [P4207T1DiamondFormula, Int.natAbs_neg] + rw [he'] + nlinarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4207T1FormulaRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4207T1FormulaRestriction.lean new file mode 100644 index 0000000000..0e2294e84f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4207T1FormulaRestriction.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4207T1DiamondFormula +public import LeanPool.ApollonianSuperharmonic.PartialOdometer +public import LeanPool.ApollonianSuperharmonic.FootprintVertices + +-- [TABLET NODE: P4207T1FormulaRestriction] + +/-! +# P4207T1FormulaRestriction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a prototile $T$, let $V_T$ be the finite union of the four corner sets +of its cells if its cell set is nonempty, and let $V_T=\{T.\mathrm{anchor}\}$ +otherwise. Define the partial odometer +$R(T)=\operatorname{P4207\_T1\_FormulaRestriction}(T)$ to have domain $V_T$ and values +$$ + R(T)(x)= + \begin{cases}\operatorname{P4207\_T1\_DiamondFormula}(x),&x\in V_T,\\ + 0,&x\notin V_T. + \end{cases} +$$ +Thus empty line prototiles retain their singleton function domains. +-/ +noncomputable def P4207T1FormulaRestriction (T : ProtoTile) : PartialOdometer := +-- BODY + let V : Finset GaussianInt := if T.cells.Nonempty then + T.cells.biUnion (fun x => {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) + else {T.anchor} + { domain := V + value := fun x => if x ∈ V then P4207T1DiamondFormula x else 0 + value_outside := by + intro x hx + simp [hx] } + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4207T1ShiftedPredecessor.lean b/LeanPool/ApollonianSuperharmonic/P4207T1ShiftedPredecessor.lean new file mode 100644 index 0000000000..cc69f68097 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4207T1ShiftedPredecessor.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4207T1FormulaRestriction +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas + +-- [TABLET NODE: P4207T1ShiftedPredecessor] + +/-! +# P4207T1ShiftedPredecessor + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4207T1ShiftedPredecessor (n : Nat) : + P4207T1FormulaRestriction (TileTranslation (DiamondTile n) ⟨0, 2⟩) = + PartialOdometerAffineTranslate + (P4207T1FormulaRestriction (DiamondTile n)) ⟨0, 2⟩ ⟨1, -1⟩ 1 := by +-- BODY + classical + let h := P4207T1FormulaRestriction (DiamondTile n) + let k := P4207T1FormulaRestriction (TileTranslation (DiamondTile n) ⟨0, 2⟩) + let l := PartialOdometerAffineTranslate h ⟨0, 2⟩ ⟨1, -1⟩ 1 + have dom (T : ProtoTile) (x : GaussianInt) : + x ∈ (P4207T1FormulaRestriction T).domain ↔ x ∈ FootprintVertices T := by + change x ∈ ((P4207T1FormulaRestriction T).domain : Set GaussianInt) ↔ _ + by_cases h : T.cells.Nonempty <;> + simp [P4207T1FormulaRestriction, FootprintVertices, h] + have value (T : ProtoTile) (x : GaussianInt) + (hx : x ∈ (P4207T1FormulaRestriction T).domain) : + (P4207T1FormulaRestriction T).value x = P4207T1DiamondFormula x := by + change (if x ∈ (P4207T1FormulaRestriction T).domain then _ else 0) = _ + exact ite_eq_left hx + have member (x : GaussianInt) : x ∈ k.domain ↔ x - ⟨0, 2⟩ ∈ h.domain := by + dsimp [k, h] + rw [dom, dom, (TileTranslationFormulas (DiamondTile n) ⟨0, 2⟩).2.2.2.2.2.1] + constructor + · rintro ⟨y, hy, rfl⟩ + simpa [GaussianTranslation] using hy + · intro hx + exact ⟨x - ⟨0, 2⟩, hx, by simp [GaussianTranslation]⟩ + have hd : k.domain = l.domain := by + ext x + exact (member x).trans ((PartialOdometerAffineTranslateFormulas h + ⟨0, 2⟩ ⟨1, -1⟩ 1).2.1 x).symm + have hv : k.value = l.value := by + funext x + by_cases hx : x ∈ k.domain + · have hl : x ∈ l.domain := hd ▸ hx + have hp := (member x).mp hx + rw [value _ x hx] + rw [(PartialOdometerAffineTranslateFormulas h ⟨0, 2⟩ ⟨1, -1⟩ 1).2.2.1 x hl] + rw [value _ (x - ⟨0, 2⟩) hp] + have shift := P4207T1FloorArithmetic.2.2.1 (x - ⟨0, 2⟩) + simp only [sub_add_cancel, Zsqrtd.re_sub, Zsqrtd.im_sub] at shift + dsimp at shift ⊢ + omega + · have hl : x ∉ l.domain := by simpa [← hd] using hx + rw [k.value_outside x hx, l.value_outside x hl] + have extensional (a b : PartialOdometer) (hd : a.domain = b.domain) + (hv : a.value = b.value) : a = b := by + cases a + cases b + simp only at hd hv + cases hd + cases hv + rfl + exact extensional k l hd hv + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4207T1UnitRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4207T1UnitRestrictions.lean new file mode 100644 index 0000000000..ae06fa581f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4207T1UnitRestrictions.lean @@ -0,0 +1,173 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4207T1FormulaRestriction +public import LeanPool.ApollonianSuperharmonic.DiamondParameter +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic +public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer +public import LeanPool.ApollonianSuperharmonic.OdometerTranslation +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import Mathlib.Algebra.Ring.Int.Parity + +-- [TABLET NODE: P4207T1UnitRestrictions] + +/-! +# P4207T1UnitRestrictions + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4207T1UnitRestrictions (K : DiamondParameter) : + let k := (K.1 : Int) + let bases : Fin 2 → Bool → GaussianInt := + ![fun s => if s then ⟨-k, k - 1⟩ else ⟨k - 1, k⟩, + fun s => if s then ⟨k - 1, k - 1⟩ else ⟨-k, k⟩] + let slopes : Fin 2 → Bool → ℝ × ℝ := + ![fun s => if s then (1 / 2, 1 / 2 - (K.1 : Real)) else + ((K.1 : Real) - 1 / 2, -1 / 2), + fun s => if s then ((K.1 : Real) - 1, 0) else (1, -(K.1 : Real))] + ∀ i s, OdometerTranslation + (P4207T1FormulaRestriction ⟨{bases i s}, bases i s⟩) + (CurvatureOneOdometer (if i = 0 then ⟨0, 1⟩ else 0)) ∧ + PartialOdometerSlope + (P4207T1FormulaRestriction ⟨{bases i s}, bases i s⟩) = + some (slopes i s) := by +-- BODY + classical + have square (u : GaussianInt) (d a b c : Int) + (h00 : P4207T1DiamondFormula u = c) + (h10 : P4207T1DiamondFormula (u + 1) = c + a) + (h01 : P4207T1DiamondFormula (u + ⟨0, 1⟩) = c + b) + (h11 : P4207T1DiamondFormula (u + 1 + ⟨0, 1⟩) = c + a + b + d) : + OdometerTranslation (P4207T1FormulaRestriction ⟨{u}, u⟩) + (CurvatureOneOdometer ⟨0, d⟩) ∧ + PartialOdometerSlope (P4207T1FormulaRestriction ⟨{u}, u⟩) = + some ((a : Real) + (d : Real) / 2, (b : Real) + (d : Real) / 2) := by as_aux_lemma => + let h := P4207T1FormulaRestriction ⟨{u}, u⟩ + have hd : h.domain = {u, u + 1, u + ⟨0, 1⟩, u + 1 + ⟨0, 1⟩} := by + simp [h, P4207T1FormulaRestriction] + have value (x : GaussianInt) (hx : x ∈ h.domain) : + h.value x = P4207T1DiamondFormula x := by + change (if x ∈ h.domain then _ else 0) = _ + exact ite_eq_left hx + have v00 : h.value u = c := by + rw [value u (by simp [hd]), h00] + have v10 : h.value (u + 1) = c + a := by + rw [value _ (by simp [hd]), h10] + have v01 : h.value (u + ⟨0, 1⟩) = c + b := by + rw [value _ (by simp [hd]), h01] + have v11 : h.value (u + 1 + ⟨0, 1⟩) = c + a + b + d := by + rw [value _ (by simp [hd]), h11] + have hs : PartialOdometerSquares h = {u} := by + ext y + simp only [PartialOdometerSquares, Finset.mem_filter, hd, + Finset.mem_insert, Finset.mem_singleton, Zsqrtd.ext_iff, + Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one] + norm_num + omega + constructor + · refine ⟨u, ⟨a, b⟩, c - a * u.re - b * u.im, ?_, ?_⟩ + · intro y + change y ∈ h.domain ↔ _ + rw [hd] + simp only [CurvatureOneOdometer, Finset.mem_insert, + Finset.mem_singleton, Zsqrtd.ext_iff, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one, + Zsqrtd.re_zero, Zsqrtd.im_zero] + norm_num + omega + · intro y hy + change h.value y = _ + change y ∈ h.domain at hy + rw [hd] at hy + simp only [Finset.mem_insert, Finset.mem_singleton] at hy + rcases hy with rfl | rfl | rfl | rfl + all_goals simp [CurvatureOneOdometer, v00, v10, v01, v11, Zsqrtd.ext_iff] + all_goals ring + · change PartialOdometerSlope h = _ + simp only [PartialOdometerSlope, hs, Finset.singleton_nonempty, ↓reduceIte, + Finset.sum_singleton, Finset.card_singleton, Nat.cast_one, v00, v10, v01, v11] + push_cast + congr 1; ext <;> ring + dsimp only + intro i s + let n : Int := K.1 + have hn : 1 ≤ n := by have := K.2; dsimp [n]; omega + let A : Int := n * (n - 1) / 2 + let B : Int := (n - 1) * (n - 2) / 2 + let C : Int := n * (n + 1) / 2 + have triangle (t : Int) : 2 * (t * (t - 1) / 2) = t * (t - 1) := by + obtain ⟨r, hr⟩ := Int.even_mul_pred_self t + omega + have hA : 2 * A = n * (n - 1) := triangle n + have hB : 2 * B = (n - 1) * (n - 2) := by + have e : n - 1 - 1 = n - 2 := by ring + simpa only [e] using triangle (n - 1) + have hC : 2 * C = n * (n + 1) := by + have e : (n + 1) * (n + 1 - 1) = n * (n + 1) := by ring + simpa only [e] using triangle (n + 1) + have hn0 : 0 ≤ n := by omega + have hn1 : 0 ≤ n - 1 := by omega + have hnn : -n ≤ 0 := by omega + have hnn1 : -n + 1 ≤ 0 := by omega + have table : + (P4207T1DiamondFormula ⟨-n, n - 1⟩ = -A ∧ + P4207T1DiamondFormula (⟨-n, n - 1⟩ + 1) = -A ∧ + P4207T1DiamondFormula (⟨-n, n - 1⟩ + ⟨0, 1⟩) = -A - n ∧ + P4207T1DiamondFormula (⟨-n, n - 1⟩ + 1 + ⟨0, 1⟩) = -A - n + 1) ∧ + (P4207T1DiamondFormula ⟨n - 1, n⟩ = B ∧ + P4207T1DiamondFormula (⟨n - 1, n⟩ + 1) = A ∧ + P4207T1DiamondFormula (⟨n - 1, n⟩ + ⟨0, 1⟩) = B - 1 ∧ + P4207T1DiamondFormula (⟨n - 1, n⟩ + 1 + ⟨0, 1⟩) = A) ∧ + (P4207T1DiamondFormula ⟨n - 1, n - 1⟩ = B ∧ + P4207T1DiamondFormula (⟨n - 1, n - 1⟩ + 1) = A ∧ + P4207T1DiamondFormula (⟨n - 1, n - 1⟩ + ⟨0, 1⟩) = B ∧ + P4207T1DiamondFormula (⟨n - 1, n - 1⟩ + 1 + ⟨0, 1⟩) = A) ∧ + (P4207T1DiamondFormula ⟨-n, n⟩ = -C ∧ + P4207T1DiamondFormula (⟨-n, n⟩ + 1) = -C + 1 ∧ + P4207T1DiamondFormula (⟨-n, n⟩ + ⟨0, 1⟩) = -C - n ∧ + P4207T1DiamondFormula (⟨-n, n⟩ + 1 + ⟨0, 1⟩) = -C - n + 1) := by as_aux_lemma => + norm_num [P4207T1DiamondFormula, Int.natCast_natAbs, + abs_of_nonneg hn0, abs_of_nonneg hn1, abs_of_nonpos hnn, + abs_of_nonpos hnn1, neg_neg] + dsimp only [A, B, C] at hA hB hC ⊢ + ring_nf at hA hB hC ⊢ + generalize hsquare : n ^ 2 = p at hA hB hC ⊢ + norm_num at hA hB hC ⊢ + omega + have hBA : A - B = n - 1 := by nlinarith only [hA, hB] + fin_cases i <;> cases s + · have row := table.2.1 + have hs := square ⟨n - 1, n⟩ 1 (n - 1) (-1) B row.1 + (by rw [row.2.1]; omega) (by rw [row.2.2.1]; ring) + (by rw [row.2.2.2]; omega) + convert hs using 1 <;> simp [n]; ring + · have row := table.1 + have hs := square ⟨-n, n - 1⟩ 1 0 (-n) (-A) row.1 + (by rw [row.2.1]; ring) (by rw [row.2.2.1]; ring) + (by rw [row.2.2.2]; ring) + convert hs using 1 <;> simp [n]; ring + · have row := table.2.2.2 + have hs := square ⟨-n, n⟩ 0 1 (-n) (-C) row.1 + (by rw [row.2.1] ) (by simpa only [sub_eq_add_neg] using row.2.2.1) + (by rw [row.2.2.2]; ring) + convert hs using 1 <;> simp [n, show (⟨0, 0⟩ : GaussianInt) = 0 from rfl] + · have row := table.2.2.1 + have hs := square ⟨n - 1, n - 1⟩ 0 (n - 1) 0 B row.1 + (by rw [row.2.1]; omega) (by rw [row.2.2.1]; ring) + (by rw [row.2.2.2]; omega) + convert hs using 1 <;> + simp [n, show (⟨0, 0⟩ : GaussianInt) = 0 from rfl] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4210T1FordCellRectangles.lean b/LeanPool/ApollonianSuperharmonic/P4210T1FordCellRectangles.lean new file mode 100644 index 0000000000..e4103d35f5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4210T1FordCellRectangles.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.TileTranslation + +-- [TABLET NODE: P4210T1FordCellRectangles] + +/-! +# P4210T1FordCellRectangles + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4210T1FordCellRectangles (q : Nat) (z : GaussianInt) : + (z ∈ (FordTile q).cells ↔ + 0 ≤ z.re ∧ z.re < (q : Int) ∧ 0 ≤ z.im ∧ z.im < (q : Int)) ∧ + (∀ r s : Nat, q = r + s → + (z ∈ (FordTile q).cells ↔ + z ∈ (FordTile r).cells ∨ + z ∈ (TileTranslation (FordTile r) ⟨(s : Int), (s : Int)⟩).cells ∨ + z ∈ (TileTranslation (FordTile s) ⟨(r : Int), 0⟩).cells ∨ + z ∈ (TileTranslation (FordTile s) ⟨0, (r : Int)⟩).cells)) := by +-- BODY + have coordinates (q : Nat) (z : GaussianInt) : + z ∈ (FordTile q).cells ↔ + 0 ≤ z.re ∧ z.re < (q : Int) ∧ 0 ≤ z.im ∧ z.im < (q : Int) := by + constructor + · intro hz + obtain ⟨⟨m, n⟩, ha, rfl⟩ := Finset.mem_image.mp hz + have hm := Finset.mem_range.mp (Finset.mem_product.mp ha).1 + have hn := Finset.mem_range.mp (Finset.mem_product.mp ha).2 + simp [hm, hn] + · rintro ⟨hr, hrq, hi, hiq⟩ + have hm : z.re.toNat < q := by omega + have hn : z.im.toNat < q := by omega + apply Finset.mem_image.mpr + refine ⟨(z.re.toNat, z.im.toNat), Finset.mem_product.mpr + ⟨Finset.mem_range.mpr hm, Finset.mem_range.mpr hn⟩, ?_⟩ + apply Zsqrtd.ext <;> simp [hr, hi] + have translated_mem (r : Nat) (u z : GaussianInt) : + z ∈ (TileTranslation (FordTile r) u).cells ↔ + z - u ∈ (FordTile r).cells := by + change z ∈ (FordTile r).cells.image (GaussianTranslation u) ↔ _ + constructor + · intro hz + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hy + · intro hz + exact Finset.mem_image.mpr + ⟨z - u, hz, by simp [GaussianTranslation]⟩ + refine ⟨coordinates q z, ?_⟩ + intro r s hq + have hsum : (q : Int) = (r : Int) + (s : Int) := by exact_mod_cast hq + simp only [translated_mem, coordinates, Zsqrtd.re_sub, Zsqrtd.im_sub] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4210T1FordSquareCentroid.lean b/LeanPool/ApollonianSuperharmonic/P4210T1FordSquareCentroid.lean new file mode 100644 index 0000000000..684e9f074f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4210T1FordSquareCentroid.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.TileCentroid + +-- [TABLET NODE: P4210T1FordSquareCentroid] + +/-! +# P4210T1FordSquareCentroid + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4210T1FordSquareCentroid (q : Nat) (hq : 0 < q) : + TileCentroid (FordTile q) = ((q : Real) / 2, (q : Real) / 2) := by +-- BODY + classical + let domain : Finset GaussianInt := FordCellDomain q + have domain_nonempty : domain.Nonempty := by + refine ⟨(⟨(0 : Int), (0 : Int)⟩ : GaussianInt), ?_⟩ + apply Finset.mem_image.mpr + exact ⟨(0, 0), by simpa using hq, rfl⟩ + have domain_injective : Set.InjOn + (fun a : Nat × Nat => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) + ↑((Finset.range q).product (Finset.range q)) := by + intro a ha b hb hab + apply Prod.ext + · have coordinate := congrArg Zsqrtd.re hab + change (a.1 : Int) = (b.1 : Int) at coordinate + exact_mod_cast coordinate + · have coordinate := congrArg Zsqrtd.im hab + change (a.2 : Int) = (b.2 : Int) at coordinate + exact_mod_cast coordinate + have domain_card : domain.card = q * q := by + calc + domain.card = ((Finset.range q).product (Finset.range q)).card := by + dsimp [domain, FordCellDomain] + exact Finset.card_image_iff.mpr domain_injective + _ = q * q := by simp + have range_sum : (Finset.range q).sum (fun x => (x : Int)) = + (q : Int) * ((q - 1 : Nat) : Int) / 2 := by + rw [← Nat.cast_sum] + simp [Finset.sum_range_id] + have domain_re_sum : domain.sum (fun z : GaussianInt => z.re) = + (q : Int) * ((q - 1 : Nat) : Int) / 2 * (q : Int) := by + simp? [domain, FordCellDomain, Finset.sum_product] + conv_lhs => rw [← Finset.mul_sum (Finset.range q) (fun x => (x : Int)) (q : Int)] + rw [range_sum] + ring + have domain_im_sum : domain.sum (fun z : GaussianInt => z.im) = + (q : Int) * ((q - 1 : Nat) : Int) / 2 * (q : Int) := by + simp? [domain, FordCellDomain, Finset.sum_product] + rw [range_sum] + ring + change (if domain.Nonempty then + ((↑(domain.sum (fun z : GaussianInt => z.re) : Int) / + ↑domain.card + (1 / 2 : Real)), + (↑(domain.sum (fun z : GaussianInt => z.im) : Int) / + ↑domain.card + (1 / 2 : Real))) else _) = _ + rw [ite_eq_left domain_nonempty, domain_card, domain_re_sum, domain_im_sum] + norm_num + field_simp + have nat_identity : q * (q - 1) / 2 * 2 + q = q * q := by + rw [← Finset.sum_range_id q, Finset.sum_range_id_mul_two] + rw [Nat.mul_sub_left_distrib] + simp only [Nat.mul_one] + have product_bound : q ≤ q * q := by nlinarith + rw [Nat.sub_add_cancel product_bound] + norm_num [Int.subNatNat, pow_two] + exact_mod_cast nat_identity + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4217T2RectangularBoundarySlope.lean b/LeanPool/ApollonianSuperharmonic/P4217T2RectangularBoundarySlope.lean new file mode 100644 index 0000000000..f73c73f249 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4217T2RectangularBoundarySlope.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope + +-- [TABLET NODE: P4217T2RectangularBoundarySlope] + +/-! +# P4217T2RectangularBoundarySlope + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4217T2RectangularBoundarySlope (h : PartialOdometer) + (m n : Nat) (hm : 0 < m) (hn : 0 < n) (a b : Int) + (hdom : (h.domain : Set GaussianInt) = + {x | 0 ≤ x.re ∧ x.re ≤ (m : Int) ∧ 0 ≤ x.im ∧ x.im ≤ (n : Int)}) + (hleft : ∀ y : Int, 0 ≤ y → y ≤ n → h.value ⟨0, y⟩ = 0) + (hright : ∀ y : Int, 0 ≤ y → y ≤ n → h.value ⟨(m : Int), y⟩ = a * y) + (hbottom : ∀ x : Int, 0 ≤ x → x ≤ m → h.value ⟨x, 0⟩ = 0) + (htop : ∀ x : Int, 0 ≤ x → x ≤ m → h.value ⟨x, (n : Int)⟩ = b * x) : + PartialOdometerSlope h = + some ((a : Real) * n / (2 * m), (b : Real) * m / (2 * n)) := by +-- BODY + classical + let point (p : Nat × Nat) : GaussianInt := ⟨(p.1 : Int), (p.2 : Int)⟩ + let box := (Finset.range m).product (Finset.range n) + have inj : Function.Injective point := by + intro p q hpq + have hr := congrArg (fun z : GaussianInt => z.re) hpq + have hi := congrArg (fun z : GaussianInt => z.im) hpq + apply Prod.ext <;> dsimp [point] at * <;> omega + have mem (x : GaussianInt) : x ∈ h.domain ↔ + 0 ≤ x.re ∧ x.re ≤ (m : Int) ∧ 0 ≤ x.im ∧ x.im ≤ (n : Int) := by + exact Set.ext_iff.mp hdom x + have squares : PartialOdometerSquares h = box.image point := by + ext x + have corners : x ∈ PartialOdometerSquares h ↔ + 0 ≤ x.re ∧ x.re < (m : Int) ∧ 0 ≤ x.im ∧ x.im < (n : Int) := by + simp only [PartialOdometerSquares, Finset.mem_filter, mem, + Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one] + omega + rw [corners] + constructor + · rintro ⟨hr, hrm, hi, hin⟩ + refine Finset.mem_image.mpr ⟨(x.re.toNat, x.im.toNat), ?_, ?_⟩ + · exact Finset.mem_product.mpr ⟨Finset.mem_range.mpr (by omega), + Finset.mem_range.mpr (by omega)⟩ + · apply Zsqrtd.ext <;> simp [point, hr, hi] + · intro hx + obtain ⟨⟨r, t⟩, hrt, rfl⟩ := Finset.mem_image.mp hx + have hr := Finset.mem_range.mp (Finset.mem_product.mp hrt).1 + have ht := Finset.mem_range.mp (Finset.mem_product.mp hrt).2 + dsimp [point] + omega + have card : (PartialOdometerSquares h).card = m * n := by + rw [squares, Finset.card_image_of_injective _ inj] + simp [box] + have nonempty : (PartialOdometerSquares h).Nonempty := by + rw [← Finset.card_pos, card] + exact Nat.mul_pos hm hn + let F (r t : Nat) : Real := h.value ⟨(r : Int), (t : Int)⟩ + have odd (k : Nat) : (∑ j ∈ Finset.range k, (2 * (j : Real) + 1)) = (k : Real)^2 := by + induction k with + | zero => simp + | succ k ih => + rw [Finset.sum_range_succ, ih] + push_cast + ring + have horizontal : + (∑ r ∈ Finset.range m, ∑ t ∈ Finset.range n, + (F (r + 1) t - F r t + F (r + 1) (t + 1) - F r (t + 1))) = + (a : Real) * (n : Real)^2 := by + rw [Finset.sum_comm] + calc + _ = ∑ t ∈ Finset.range n, (a : Real) * (2 * (t : Real) + 1) := by + apply Finset.sum_congr rfl + intro t ht + have ht' := Finset.mem_range.mp ht + have hrow : (∑ r ∈ Finset.range m, + (F (r + 1) t - F r t + F (r + 1) (t + 1) - F r (t + 1))) = + (F m t - F 0 t) + (F m (t + 1) - F 0 (t + 1)) := by + calc + _ = (∑ r ∈ Finset.range m, (F (r + 1) t - F r t)) + + ∑ r ∈ Finset.range m, (F (r + 1) (t + 1) - F r (t + 1)) := by + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro r hr + ring + _ = _ := by + rw [Finset.sum_range_sub (fun r => F r t), + Finset.sum_range_sub (fun r => F r (t + 1))] + rw [hrow] + dsimp [F] + rw [hleft _ (by omega) (by omega), hleft _ (by omega) (by omega), + hright _ (by omega) (by omega), hright _ (by omega) (by omega)] + push_cast + ring + _ = _ := by rw [← Finset.mul_sum, odd] + have vertical : + (∑ r ∈ Finset.range m, ∑ t ∈ Finset.range n, + (F r (t + 1) - F r t + F (r + 1) (t + 1) - F (r + 1) t)) = + (b : Real) * (m : Real)^2 := by + calc + _ = ∑ r ∈ Finset.range m, (b : Real) * (2 * (r : Real) + 1) := by + apply Finset.sum_congr rfl + intro r hr + have hr' := Finset.mem_range.mp hr + have hcol : (∑ t ∈ Finset.range n, + (F r (t + 1) - F r t + F (r + 1) (t + 1) - F (r + 1) t)) = + (F r n - F r 0) + (F (r + 1) n - F (r + 1) 0) := by + calc + _ = (∑ t ∈ Finset.range n, (F r (t + 1) - F r t)) + + ∑ t ∈ Finset.range n, (F (r + 1) (t + 1) - F (r + 1) t) := by + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro t ht + ring + _ = _ := by + rw [Finset.sum_range_sub (fun t => F r t), + Finset.sum_range_sub (fun t => F (r + 1) t)] + rw [hcol] + dsimp [F] + rw [hbottom _ (by omega) (by omega), hbottom _ (by omega) (by omega), + htop _ (by omega) (by omega), htop _ (by omega) (by omega)] + push_cast + ring + _ = _ := by rw [← Finset.mul_sum, odd] + have hsums (f : GaussianInt → Real) : + (∑ x ∈ PartialOdometerSquares h, f x) = + ∑ r ∈ Finset.range m, ∑ t ∈ Finset.range n, f ⟨(r : Int), (t : Int)⟩ := by + rw [squares, Finset.sum_image (fun _ _ _ _ he => inj he)] + exact Finset.sum_product _ _ _ + unfold PartialOdometerSlope + rw [ite_eq_left nonempty, card, hsums, hsums] + have addone (r t : Int) : (⟨r, t⟩ : GaussianInt) + 1 = ⟨r + 1, t⟩ := by + apply Zsqrtd.ext <;> simp + have hhor : (∑ r ∈ Finset.range m, ∑ t ∈ Finset.range n, + ((h.value (⟨(r : Int), (t : Int)⟩ + 1) - h.value ⟨(r : Int), (t : Int)⟩ + + h.value (⟨(r : Int), (t : Int)⟩ + 1 + ⟨0, 1⟩) - + h.value (⟨(r : Int), (t : Int)⟩ + ⟨0, 1⟩) : Int) : Real)) = + (a : Real) * (n : Real)^2 := by + simpa [F, Nat.cast_add, Int.cast_sub, Int.cast_add, addone] using horizontal + have hver : (∑ r ∈ Finset.range m, ∑ t ∈ Finset.range n, + ((h.value (⟨(r : Int), (t : Int)⟩ + ⟨0, 1⟩) - h.value ⟨(r : Int), (t : Int)⟩ + + h.value (⟨(r : Int), (t : Int)⟩ + 1 + ⟨0, 1⟩) - + h.value (⟨(r : Int), (t : Int)⟩ + 1) : Int) : Real)) = + (b : Real) * (m : Real)^2 := by + simpa [F, Nat.cast_add, Int.cast_sub, Int.cast_add, addone] using vertical + rw [hhor, hver] + have hm' : (m : Real) ≠ 0 := by exact_mod_cast hm.ne' + have hn' : (n : Real) ≠ 0 := by exact_mod_cast hn.ne' + congr 2 <;> push_cast <;> field_simp + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4217T2SquareGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4217T2SquareGeometry.lean new file mode 100644 index 0000000000..666ded1798 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4217T2SquareGeometry.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4217T2SquareRestriction +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles + +-- [TABLET NODE: P4217T2SquareGeometry] + +/-! +# P4217T2SquareGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4217T2SquareGeometry (q : Nat) (g : IntegerLatticeFunction) + (hq : 0 < q) : + ((P4217T2SquareRestriction q g).domain : Set GaussianInt) = FordVertexDomain q ∧ + (∀ x, x ∈ (P4217T2SquareRestriction q g).domain → + (P4217T2SquareRestriction q g).value x = g x) ∧ + PartialOdometerSquares (P4217T2SquareRestriction q g) = (FordTile q).cells ∧ + (PartialOdometerSquares (P4217T2SquareRestriction q g)).card = q * q ∧ + (PartialOdometerSquares (P4217T2SquareRestriction q g)).Nonempty := by +-- BODY + classical + have dom (x : GaussianInt) : x ∈ (P4217T2SquareRestriction q g).domain ↔ + x ∈ FordVertexDomain q := by + constructor + · intro hx + obtain ⟨⟨r, t⟩, hrt, rfl⟩ := Finset.mem_image.mp hx + have hr := Finset.mem_range.mp (Finset.mem_product.mp hrt).1 + have ht := Finset.mem_range.mp (Finset.mem_product.mp hrt).2 + change 0 ≤ (r : Int) ∧ (r : Int) ≤ q ∧ 0 ≤ (t : Int) ∧ (t : Int) ≤ q + omega + · rintro ⟨hr, hrq, hi, hiq⟩ + apply Finset.mem_image.mpr + refine ⟨(x.re.toNat, x.im.toNat), ?_, ?_⟩ + · exact Finset.mem_product.mpr ⟨Finset.mem_range.mpr (by omega), + Finset.mem_range.mpr (by omega)⟩ + · apply Zsqrtd.ext <;> simp [hr, hi] + have squares : PartialOdometerSquares (P4217T2SquareRestriction q g) = + (FordTile q).cells := by + ext x + simp only [PartialOdometerSquares, Finset.mem_filter, dom] + rw [(P4210T1FordCellRectangles q x).1] + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_add, + Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one] + omega + have card : (FordTile q).cells.card = q * q := by + change (Finset.image _ ((Finset.range q).product (Finset.range q))).card = _ + rw [Finset.card_image_of_injective] + · simp + · intro a b hab + have hr := congrArg (fun z : GaussianInt => z.re) hab + have hi := congrArg (fun z : GaussianInt => z.im) hab + apply Prod.ext <;> dsimp at * <;> omega + refine ⟨Set.ext dom, ?_, squares, by rw [squares, card], ?_⟩ + · intro x hx + exact ite_eq_left ((dom x).mp hx) + · rw [squares, ← Finset.card_pos, card] + exact Nat.mul_pos hq hq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4217T2SquareRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4217T2SquareRestriction.lean new file mode 100644 index 0000000000..76ae193793 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4217T2SquareRestriction.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PartialOdometer +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain + +-- [TABLET NODE: P4217T2SquareRestriction] + +/-! +# P4217T2SquareRestriction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a nonnegative integer $q$ and an integer lattice function $g$, let +$\operatorname{SqRes}_q(g)$ have domain +$\{(r,t):r,t\in\{0,\ldots,q\}\}$, value $g(x)$ on +$\operatorname{FordVertexDomain}(q)$, and value zero elsewhere. This defines +the partial odometer $\operatorname{SqRes}_q(g)$. +-/ +noncomputable def P4217T2SquareRestriction (q : Nat) + (g : IntegerLatticeFunction) : PartialOdometer := by +-- BODY + classical + exact + { domain := (((Finset.range (q + 1)).product (Finset.range (q + 1))).image + (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt))) + value := fun x => if x ∈ FordVertexDomain q then g x else 0 + value_outside := by + intro x hx + apply ite_eq_right + rintro ⟨hr, hrq, hi, hiq⟩ + apply hx + apply Finset.mem_image.mpr + refine ⟨(x.re.toNat, x.im.toNat), ?_, ?_⟩ + · exact Finset.mem_product.mpr ⟨Finset.mem_range.mpr (by omega), + Finset.mem_range.mpr (by omega)⟩ + · apply Zsqrtd.ext <;> simp [hr, hi] } + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4223T1DiamondRowNumerators.lean b/LeanPool/ApollonianSuperharmonic/P4223T1DiamondRowNumerators.lean new file mode 100644 index 0000000000..4ef493aa22 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4223T1DiamondRowNumerators.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic +public import Mathlib.Algebra.BigOperators.Intervals + +-- [TABLET NODE: P4223T1DiamondRowNumerators] + +/-! +# P4223T1DiamondRowNumerators + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4223T1DiamondRowNumerators (r : Nat) (y : Int) : + (∑ j ∈ Finset.range (2 * r), + let x : GaussianInt := ⟨(j : Int) - (r : Int), y⟩ + P4207T1DiamondFormula (x + 1) - P4207T1DiamondFormula x + + P4207T1DiamondFormula (x + 1 + ⟨0, 1⟩) - + P4207T1DiamondFormula (x + ⟨0, 1⟩)) = (r : Int) * (2 * y + 1) ∧ + (∑ j ∈ Finset.range (2 * r), + let x : GaussianInt := ⟨(j : Int) - (r : Int), y⟩ + P4207T1DiamondFormula (x + ⟨0, 1⟩) - P4207T1DiamondFormula x + + P4207T1DiamondFormula (x + 1 + ⟨0, 1⟩) - + P4207T1DiamondFormula (x + 1)) = -(r : Int) * (2 * y + 1) := by +-- BODY + have add_one (a b : Int) : (⟨a, b⟩ : GaussianInt) + 1 = ⟨a + 1, b⟩ := by + ext <;> simp + have add_i (a b : Int) : (⟨a, b⟩ : GaussianInt) + ⟨0, 1⟩ = ⟨a, b + 1⟩ := by + ext <;> simp + have telescope (t : Int) : + (∑ j ∈ Finset.range (2 * r), + (P4207T1DiamondFormula ⟨(j : Int) - r + 1, t⟩ - + P4207T1DiamondFormula ⟨(j : Int) - r, t⟩)) = (r : Int) * t := by + have h := Finset.sum_range_sub + (fun j : Nat => P4207T1DiamondFormula ⟨(j : Int) - r, t⟩) (2 * r) + simp only [Nat.cast_add, Nat.cast_one, Nat.cast_mul, Nat.cast_ofNat, + Nat.cast_zero, zero_sub] at h + have he : 2 * (r : Int) - r = r := by ring + rw [he, P4207T1FloorArithmetic.2.2.2.2] at h + simp only [show ∀ a : Int, a + 1 - r = a - r + 1 by intro a; ring] at h + linarith + constructor + · calc + _ = (∑ j ∈ Finset.range (2 * r), + (P4207T1DiamondFormula ⟨(j : Int) - r + 1, y⟩ - + P4207T1DiamondFormula ⟨(j : Int) - r, y⟩)) + + ∑ j ∈ Finset.range (2 * r), + (P4207T1DiamondFormula ⟨(j : Int) - r + 1, y + 1⟩ - + P4207T1DiamondFormula ⟨(j : Int) - r, y + 1⟩) := by + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro j hj + change _ - _ + _ - _ = _ + rw [add_one, add_i, add_i] + ring + _ = _ := by rw [telescope, telescope]; ring + · have point (a : Int) : + P4207T1DiamondFormula (⟨a, y⟩ + ⟨0, 1⟩) - + P4207T1DiamondFormula ⟨a, y⟩ + + P4207T1DiamondFormula (⟨a, y⟩ + 1 + ⟨0, 1⟩) - + P4207T1DiamondFormula (⟨a, y⟩ + 1) = a - y := by + have h0 := P4207T1FloorArithmetic.2.2.2.1 a y + have h1 := P4207T1FloorArithmetic.2.2.2.1 (a + 1) y + change _ - _ + _ - _ = _ + rw [add_one, add_i, add_i] + omega + simp only [point] + have total : ∀ n : Nat, + 2 * (∑ j ∈ Finset.range n, ((j : Int) - r - y)) = + (n : Int) * (n - 1) - 2 * n * ((r : Int) + y) := by + intro n + induction n with + | zero => simp + | succ n ih => + rw [Finset.sum_range_succ] + push_cast + nlinarith only [ih] + have ht := total (2 * r) + push_cast at ht + nlinarith only [ht] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1DefinedHalfIntegralSlope.lean b/LeanPool/ApollonianSuperharmonic/P4250T1DefinedHalfIntegralSlope.lean new file mode 100644 index 0000000000..2edcb8b974 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4250T1DefinedHalfIntegralSlope.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn + +-- [TABLET NODE: P4250T1DefinedHalfIntegralSlope] + +/-! +# P4250T1DefinedHalfIntegralSlope + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4250T1DefinedHalfIntegralSlope + (C : CircleCoordinates) (T : ProtoTile) (h : PartialOdometer) + (hC : 0 < C.1) (ho : TileOdometer C T h) : + ∃ (p : Real × Real) (a : GaussianInt), + PartialOdometerSlope h = some p ∧ + (2 : Real) • p = GaussianRealPoint a ∧ T.cells.Nonempty := by +-- BODY + classical + have unitSlope (z : GaussianInt) : PartialOdometerSlope (CurvatureOneOdometer z) = + some (((z.im : Real) / 2), ((z.im : Real) / 2)) := by + have hs : PartialOdometerSquares (CurvatureOneOdometer z) = {0} := by + change PartialOdometerSquares (CurvatureOneOdometer 0) = {0} + decide +kernel + unfold PartialOdometerSlope + rw [hs] + norm_num [CurvatureOneOdometer, Zsqrtd.ext_iff] + induction ho with + | line w x hw h hdom => simp at hC + | unit z x T h hT hdom htrans => + obtain ⟨v, a, b, hd, hv⟩ := htrans + have hdeq : h.domain = + (PartialOdometerAffineTranslate (CurvatureOneOdometer z) v a b).domain := by + ext y + rw [(PartialOdometerAffineTranslateFormulas _ v a b).2.1] + exact hd y + have hveq : h.value = + (PartialOdometerAffineTranslate (CurvatureOneOdometer z) v a b).value := by + funext y + by_cases hy : y ∈ h.domain + · rw [hv y hy, (PartialOdometerAffineTranslateFormulas _ v a b).2.2.1 + y (by rwa [← hdeq])] + · rw [h.value_outside y hy, + (PartialOdometerAffineTranslate _ v a b).value_outside y + (by rwa [← hdeq])] + have heq : h = PartialOdometerAffineTranslate (CurvatureOneOdometer z) v a b := by + cases h + simp only [PartialOdometerAffineTranslate, PartialOdometer.mk.injEq] + exact ⟨hdeq, hveq⟩ + refine ⟨((z.im : Real) / 2 + (a.re : Real), + (z.im : Real) / 2 + (a.im : Real)), + ⟨z.im + 2 * a.re, z.im + 2 * a.im⟩, ?_, ?_, ?_⟩ + · rw [heq, (PartialOdometerAffineTranslateFormulas _ v a b).2.2.2.2.2, + unitSlope] + rfl + · ext <;> simp [GaussianRealPoint] <;> ring + · rw [hT] + simp + | @decompose q hq S T hs h hT hsub hcells hfoot hcentroid hdom hvalue + hcompat hslope ih => + have facts := ProperBandCurvatureStructure q hq + have hpositive : ∃ i : Fin 3, 0 < (q i.succ).1 := by + by_cases h0 : 0 < (q (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (q (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + have hzero0 : (q (0 : Fin 3).succ).1 = 0 := by + have := facts.2.1 0 + omega + have hzero1 : (q (1 : Fin 3).succ).1 = 0 := by + have := facts.2.1 1 + omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 hzero0 hzero1)).elim + obtain ⟨i, hi⟩ := hpositive + obtain ⟨pi, ai, hpi, hai, hne⟩ := ih i true hi + rcases hslope i true with hz | ⟨p, pi', hp, hpi', hreal, himag⟩ + · omega + have heq : pi' = pi := Option.some.inj (hpi'.symm.trans hpi) + subst pi' + let a := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + refine ⟨p, ai - (a + GaussianQuarterTurn a), hp, ?_, ?_⟩ + · have hr := congrArg Prod.fst hai + have hi := congrArg Prod.snd hai + apply Prod.ext + all_goals + simp [GaussianRealPoint, GaussianQuarterTurn, a] at hr hi ⊢ + simp at hreal himag + linarith + · obtain ⟨x, hx⟩ := hne + exact ⟨x, (hcells x).2 ⟨i, true, hx⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1IntegralAffinePlacement.lean b/LeanPool/ApollonianSuperharmonic/P4250T1IntegralAffinePlacement.lean new file mode 100644 index 0000000000..42599c780b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4250T1IntegralAffinePlacement.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas + +-- [TABLET NODE: P4250T1IntegralAffinePlacement] + +/-! +# P4250T1IntegralAffinePlacement + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4250T1IntegralAffinePlacement + (C : CircleCoordinates) (U V : ProtoTile) (h : PartialOdometer) + (p : Real × Real) (a : GaussianInt) (hC : 0 < C.1) + (ho : TileOdometer C U h) (hV : BandPrototile C V) + (hp : PartialOdometerSlope h = some p) : + ∃ k : PartialOdometer, TileOdometer C V k ∧ + PartialOdometerSlope k = some (p + GaussianRealPoint a) := by +-- BODY + obtain ⟨u, hu, _⟩ := BandPrototileTranslationNormalForm C V U hV + (TileOdometerBandPrototile C U h ho) + refine ⟨PartialOdometerAffineTranslate h u a 0, ?_, ?_⟩ + · exact PositiveCurvatureTileOdometerSupportTransport C + (TileTranslation U u) V _ hC + (TileOdometerAffineTranslation C U h u a 0 ho) hV hu.symm + · rw [(PartialOdometerAffineTranslateFormulas h u a 0).2.2.2.2.2, hp] + rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean b/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean new file mode 100644 index 0000000000..81e13df4db --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean @@ -0,0 +1,3409 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4250T1SlopeOffset +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRawSupport +public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.RightSubtileOdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent + +-- [TABLET NODE: P4250T1NestedCompatibility] + +/-! +# P4250T1NestedCompatibility + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace NestedCompatibilityGeometry + +private theorem hroot : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), 1 < + (cfg.firstPredecessor 0).1 ) := by + classical + intro q cfg + rw [cfg.firstChild] + have : (q 2).1 < (q 1).1 := cfg.order12 + have hq2 : 4 ≤ (q 2).1 := cfg.secondLarge + omega + +private theorem alignA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let A := cert.P 0 true + ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (cfg.firstPredecessor i.succ) (U i s) + (k i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (U i s) - TileCentroid A + = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (i : Fin 3), ∀ (s : + Bool), (U i s).cells = (cert.Q i s).cells ∧ ((U i s).cells = ∅ → (U i s).anchor = + (cert.Q i s).anchor) ∧ FootprintVertices (U i s) = FootprintVertices (cert.Q i s))) ) + := by + classical + intro q cfg C T cert A U k hchildA hcentA i s + have hocc := cert.plus_occurrence i s + rcases hocc with ⟨hproto, _, hcent⟩ + have hcent' : TileCentroid (U i s) = TileCentroid (cert.Q i s) := by + -- Both pieces have the same certified centroid displacement from A. + have huc : TileCentroid (U i s) - TileCentroid A = + (if s then (1 : Real) else -1) • + ((1 / 2 : Real) • (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ))) - + (-(GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ)))).2, + (GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ)))).1))) := by + simpa [A] using hcentA i s + have hvc : TileCentroid (cert.Q i s) - TileCentroid A = + (if s then (1 : Real) else -1) • + ((1 / 2 : Real) • (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ))) - + (-(GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ)))).2, + (GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ)))).1))) := by + simpa [A] using hcent + calc + TileCentroid (U i s) = + (TileCentroid (U i s) - TileCentroid A) + TileCentroid A := by + ext <;> simp [sub_eq_add_neg, add_comm, add_left_comm] + _ = (TileCentroid (cert.Q i s) - TileCentroid A) + TileCentroid A := by + rw [huc, hvc] + _ = TileCentroid (cert.Q i s) := by + ext <;> simp [sub_eq_add_neg, add_comm] + have huniq := BandPrototileCentroidUnique (cfg.firstPredecessor i.succ) + (U i s) (cert.Q i s) (TileOdometerBandPrototile _ _ _ (hchildA i s)) + hproto hcent' + exact ⟨huniq.1, huniq.2, + (ProtoTileObservableExtensionality (U i s) (cert.Q i s) huniq.1 + huniq.2).1⟩ + +private theorem alignB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let B := cert.P 0 false + ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (l : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (cfg.firstPredecessor i.succ) (V i s) + (l i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (V i s) - TileCentroid B + = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (i : Fin 3), ∀ (s : + Bool), (V i s).cells = (cert.S i s).cells ∧ ((V i s).cells = ∅ → (V i s).anchor = + (cert.S i s).anchor) ∧ FootprintVertices (V i s) = FootprintVertices (cert.S i s))) ) + := by + classical + intro q cfg C T cert B V l hchildB hcentB i s + obtain ⟨hproto, _, hcent⟩ := cert.minus_occurrence i s + have hcent' : TileCentroid (V i s) = TileCentroid (cert.S i s) := by + have hvc : TileCentroid (V i s) - TileCentroid B = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ))) - + (-(GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ)))).2, + (GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ)))).1))) := by + simpa [B] using hcentB i s + have hsc : TileCentroid (cert.S i s) - TileCentroid B = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ))) - + (-(GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ)))).2, + (GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor ((i + 2).succ)) + (cfg.firstPredecessor ((i + 1).succ)))).1))) := by + simpa [B] using hcent + calc + TileCentroid (V i s) = + (TileCentroid (V i s) - TileCentroid B) + TileCentroid B := by + ext <;> simp [sub_eq_add_neg, add_comm, add_left_comm] + _ = (TileCentroid (cert.S i s) - TileCentroid B) + TileCentroid B := by + rw [hvc, hsc] + _ = TileCentroid (cert.S i s) := by + ext <;> simp [sub_eq_add_neg, add_comm] + have huniq := BandPrototileCentroidUnique (cfg.firstPredecessor i.succ) + (V i s) (cert.S i s) (TileOdometerBandPrototile _ _ _ (hchildB i s)) + hproto hcent' + exact ⟨huniq.1, huniq.2, + (ProtoTileObservableExtensionality (V i s) (cert.S i s) huniq.1 + huniq.2).1⟩ + +private theorem pos2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), 0 < + (cfg.firstPredecessor 2).1 ) := by + classical + intro q cfg + rw [cfg.firstParentTwo] + have := cfg.secondLarge + omega + +private theorem pos3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), 0 < + (cfg.firstPredecessor 3).1 ) := by + classical + intro q cfg + rw [cfg.firstParentThree] + have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 2 + have hne := cfg.noLine 3 + have hnon : 0 ≤ (q 3).1 := by simpa using hn + omega + +private theorem hv21 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let v21 : GaussianInt := BandVectors.1 (q 2) (q 1) + (BandVectors.1 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin + (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : + ℕ))] (3 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), + cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : + Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : + Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin + (4 : ℕ))] (3 : Fin (4 : ℕ))) + BandVectors.1 (![cfg.firstPredecessor (0 : Fin (4 : + ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 + : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin + (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : + GaussianInt) ∧ BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), + cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 + : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin + (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : + Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : + Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin + (4 : ℕ))] (3 : Fin (4 : ℕ))) + BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : + ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 + : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin + (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : + GaussianInt) ∧ BandVectors.1 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), + cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 + : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin + (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : + Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : + Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin + (4 : ℕ))] (3 : Fin (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : + Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : + Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin + (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : + ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 + : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin + (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : + Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : + Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin + (4 : ℕ))] (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : + Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : + Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin + (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple ![cfg.firstPredecessor (0 : Fin + (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : + ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : + Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : + Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin + (4 : ℕ))] j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] + j.succ) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : + ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] + (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), + cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 + : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin + (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), + cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] j.succ) (![cfg.firstPredecessor (0 : Fin (4 : + ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → (v21 = BandVectors.1 + (q 2) (cfg.firstPredecessor 1) - I * w) ) := by + classical + intro q cfg I w v21 hrot + simpa [v21, w, I, cfg.firstChild, cfg.firstParentTwo, + cfg.firstParentThree] using hrot.2.2.1 + +private theorem ha21 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let a21 : GaussianInt := BandVectors.2 (q 2) (q 1) + (BandVectors.1 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin + (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : + ℕ))] (3 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), + cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : + Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : + Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin + (4 : ℕ))] (3 : Fin (4 : ℕ))) + BandVectors.1 (![cfg.firstPredecessor (0 : Fin (4 : + ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 + : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin + (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : + GaussianInt) ∧ BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), + cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 + : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin + (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : + Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : + Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin + (4 : ℕ))] (3 : Fin (4 : ℕ))) + BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : + ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 + : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin + (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : + GaussianInt) ∧ BandVectors.1 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), + cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 + : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin + (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : + Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : + Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin + (4 : ℕ))] (3 : Fin (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : + Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : + Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin + (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : + ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 + : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin + (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : + Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : + Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin + (4 : ℕ))] (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : + Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : + Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin + (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple ![cfg.firstPredecessor (0 : Fin + (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : + ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : + Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : + Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin + (4 : ℕ))] j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 + (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), + cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] + j.succ) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : + ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] + (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), + cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 + : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin + (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), + cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] j.succ) (![cfg.firstPredecessor (0 : Fin (4 : + ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), + cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → (a21 = BandVectors.2 + (q 2) (cfg.firstPredecessor 1) + I * alpha) ) := by + classical + intro q cfg I alpha a21 hrot + simpa [a21, alpha, I, cfg.firstChild, cfg.firstParentTwo, + cfg.firstParentThree] using hrot.2.2.2.1 + +private theorem hX : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let xv : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let v21 : GaussianInt := BandVectors.1 (q 2) (q 1) + (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : + ℕ))) = (0 : GaussianInt)) → ((BandVectors.1 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) + (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + BandVectors.1 (cfg.firstPredecessor (1 : + Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))) + BandVectors.1 + (cfg.firstPredecessor (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = + (0 : GaussianInt)) → ((v21 = BandVectors.1 (q 2) (cfg.firstPredecessor 1) - I * w) → + (xv = -v21 - (1 + I) * w))) ) := by + classical + intro q cfg I w xv v21 hcycV hpredV hv21 + let v13 : GaussianInt := BandVectors.1 (q 1) (q 3) + apply eq_of_sub_eq_zero + have hcyc : w + v13 + v21 = 0 := by simpa [w, v13, v21] using hcycV + have hpred : w + xv + BandVectors.1 (q 2) (cfg.firstPredecessor 1) = 0 := by + simpa [w, xv, cfg.firstParentTwo, cfg.firstParentThree] using hpredV + calc + _ = (w + xv + BandVectors.1 (q 2) (cfg.firstPredecessor 1)) + + (v21 - (BandVectors.1 (q 2) (cfg.firstPredecessor 1) - I * w)) := by ring + _ = 0 := by rw [hpred, hv21]; ring + +private theorem hV13 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let xv : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let v21 : GaussianInt := BandVectors.1 (q 2) (q 1) + let v13 : GaussianInt := BandVectors.1 (q 1) (q 3) + (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : + ℕ))) = (0 : GaussianInt)) → ((xv = -v21 - (1 + I) * w) → (v13 = xv + I * w)) ) := by + classical + intro q cfg I w xv v21 v13 hcycV hX + have hcyc : w + v13 + v21 = 0 := by simpa [w, v13, v21] using hcycV + rw [hX] + dsimp [v13, xv, w, v21] + linear_combination hcyc + +private theorem hXalpha : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let a21 : GaussianInt := BandVectors.2 (q 2) (q 1) + (BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.2 (q (1 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : + ℕ))) = (0 : GaussianInt)) → ((BandVectors.2 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) + (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + BandVectors.2 (cfg.firstPredecessor (1 : + Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))) + BandVectors.2 + (cfg.firstPredecessor (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = + (0 : GaussianInt)) → ((a21 = BandVectors.2 (q 2) (cfg.firstPredecessor 1) + I * + alpha) → (xa = -a21 - (1 - I) * alpha))) ) := by + classical + intro q cfg I alpha xa a21 hcycA hpredA ha21 + let a13 : GaussianInt := BandVectors.2 (q 1) (q 3) + apply eq_of_sub_eq_zero + have hcyc : alpha + a13 + a21 = 0 := by simpa [alpha, a13, a21] using hcycA + have hpred : alpha + xa + BandVectors.2 (q 2) (cfg.firstPredecessor 1) = 0 := by + simpa [alpha, xa, cfg.firstParentTwo, cfg.firstParentThree] using hpredA + calc + _ = (alpha + xa + BandVectors.2 (q 2) (cfg.firstPredecessor 1)) + + (a21 - (BandVectors.2 (q 2) (cfg.firstPredecessor 1) + I * alpha)) := by ring + _ = 0 := by rw [hpred, ha21]; ring + +private theorem hA13 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let a21 : GaussianInt := BandVectors.2 (q 2) (q 1) + let a13 : GaussianInt := BandVectors.2 (q 1) (q 3) + (BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.2 (q (1 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : + ℕ))) = (0 : GaussianInt)) → ((xa = -a21 - (1 - I) * alpha) → (a13 = xa - I * alpha)) + ) := by + classical + intro q cfg I alpha xa a21 a13 hcycA hXalpha + have hcyc : alpha + a13 + a21 = 0 := by simpa [alpha, a13, a21] using hcycA + rw [hXalpha] + dsimp [a13, xa, alpha, a21] + linear_combination hcyc + +private theorem spatialIdentity : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let xv : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let v13 : GaussianInt := BandVectors.1 (q 1) (q 3) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (v13 = xv + I * w) → (spatial v13 - spatial w - spatial xv = GaussianRealPoint (I * w)) ) + := by + classical + intro q cfg I w xv v13 spatial hV13 + rw [hV13] + dsimp [spatial, GaussianRealPoint, I] + ext <;> simp [] <;> ring + +private theorem slopeIdentity : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let a13 : GaussianInt := BandVectors.2 (q 1) (q 3) + (a13 = xa - I * alpha) → (P4250T1SlopeOffset a13 - P4250T1SlopeOffset alpha - + P4250T1SlopeOffset xa = -GaussianRealPoint (I * alpha)) ) := by + classical + intro q cfg I alpha xa a13 hA13 + rw [hA13] + dsimp [P4250T1SlopeOffset, GaussianRealPoint, I] + ext <;> simp [] <;> ring + +private theorem hI2pow : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + (I * I = -1) → (I ^ 2 = -1) ) := by + classical + intro I hI2 + rw [pow_two] + exact hI2 + +private theorem hIneg : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + (I * I = -1) → (I * (-I) = 1) ) := by + classical + intro I hI2 + rw [mul_neg, hI2] + simp + +private theorem hI3neg : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + (I * I = -1) → ((-I : GaussianInt) ^ 3 = I) ) := by + classical + intro I hI2 + have hneg2 : (-I : GaussianInt) * (-I) = -1 := by + rw [neg_mul_neg, hI2] + calc + (-I : GaussianInt) ^ 3 = ((-I) * (-I)) * (-I) := by + simp [pow_succ] + _ = (-1) * (-I) := by rw [hneg2] + _ = I := by simp + +private theorem hI3 : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + (I ^ 2 = -1) → ((I : GaussianInt) ^ 3 = -I) ) := by + classical + intro I hI2pow + calc + I ^ 3 = I ^ 2 * I := by simp [pow_succ] + _ = (-1) * I := by rw [hI2pow] + _ = -I := by simp + +private theorem hnegII : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + (I * I = -1) → ((-I : GaussianInt) * I = 1) ) := by + classical + intro I hI2 + rw [neg_mul, hI2] + simp + +private theorem hcenterQ : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let A := cert.P 0 true + let xv : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + TileCentroid (cert.Q 1 true) - TileCentroid A = spatial xv ) := by + classical + intro q cfg C T cert A xv spatial + simpa [spatial, xv, Fin.add_def, cfg.firstParentThree] using + (cert.plus_occurrence 1 true).2.2 + +private theorem hcenterQT : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let A := cert.P 0 true + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let xv : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (TileCentroid A - TileCentroid T = spatial w) → ((TileCentroid (cert.Q 1 true) - + TileCentroid A = spatial xv) → (TileCentroid (cert.Q 1 true) - TileCentroid T = + spatial xv + spatial w)) ) := by + classical + intro q cfg C T cert A w xv spatial hcenterA hcenterQ + calc + _ = (TileCentroid (cert.Q 1 true) - TileCentroid A) + + (TileCentroid A - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = _ := by rw [hcenterQ, hcenterA] + +private theorem hcenterDelta : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let xv : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let v13 : GaussianInt := BandVectors.1 (q 1) (q 3) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (spatial v13 - spatial w - spatial xv = GaussianRealPoint (I * w)) → ((TileCentroid + (cert.P 1 true) - TileCentroid T = spatial v13) → ((TileCentroid (cert.Q 1 true) - + TileCentroid T = spatial xv + spatial w) → (TileCentroid (cert.P 1 true) - + TileCentroid (cert.Q 1 true) = GaussianRealPoint (I * w)))) ) := by + classical + intro q cfg C T cert I w xv v13 spatial spatialIdentity hcenterP hcenterQT + calc + _ = (TileCentroid (cert.P 1 true) - TileCentroid T) - + (TileCentroid (cert.Q 1 true) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = spatial v13 - spatial w - spatial xv := by + rw [hcenterP, hcenterQT] + ext <;> dsimp <;> ring + _ = GaussianRealPoint (I * w) := spatialIdentity + +private theorem rootSlope : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × + Real), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), PartialOdometerSlope (h i s) = some (s0 + + (if s = true then (1 : ℝ) else (-1 : ℝ)) • P4250T1SlopeOffset (BandVectors.2 (q (i + + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)))) → ( + let a13 : GaussianInt := BandVectors.2 (q 1) (q 3) + PartialOdometerSlope (h 1 true) = some (s0 + P4250T1SlopeOffset a13)) ) := by + classical + intro q h s0 hp a13 + simpa [a13, Fin.add_def] using hp 1 true + +private theorem childSlope : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (h : + Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), PartialOdometerSlope (h i s) = some (s0 + (if s = true then (1 : ℝ) else (-1 : + ℝ)) • P4250T1SlopeOffset (BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 + : Fin (3 : ℕ))).succ)))) → (∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), (cfg.firstPredecessor i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ × ℝ) + (p_i : ℝ × ℝ), PartialOdometerSlope (h (0 : Fin (3 : ℕ)) true) = some p ∧ + PartialOdometerSlope (k i s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin + (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = + true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 + (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin + (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((0 + < (cfg.firstPredecessor 2).1) → ( + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + PartialOdometerSlope (k 1 true) = some (s0 + P4250T1SlopeOffset alpha + + P4250T1SlopeOffset xa)))) ) := by + classical + intro q cfg h s0 hp k hslopeA pos2 alpha xa + rcases hslopeA 1 true with hz | hs + · have hbad : (cfg.firstPredecessor 2).1 = 0 := hz + have : (q 2).1 = 0 := by simpa [cfg.firstParentTwo] using hbad + exact False.elim (by have := cfg.noLine 2; omega) + · rcases hs with ⟨p, pi, hp0, hpi, hreal, himag⟩ + have hp0' : p = s0 + P4250T1SlopeOffset alpha := by + have heq : some p = some (s0 + P4250T1SlopeOffset alpha) := by + simpa [alpha, Fin.add_def] using hp0.symm.trans (hp 0 true) + exact Option.some.inj heq + have hpi' : pi = p + P4250T1SlopeOffset xa := by + apply Prod.ext + · have hreal' : pi.1 - p.1 = + ((xa.re : Real) - (xa.im : Real)) / 2 := by + convert hreal using 1; simp [xa, cfg.firstParentThree]; ring + change pi.1 = p.1 + ((xa.re : Real) - (xa.im : Real)) / 2 + linarith + · have himag' : pi.2 - p.2 = + ((xa.im : Real) + (xa.re : Real)) / 2 := by + convert himag using 1; simp [xa, cfg.firstParentThree]; ring + change pi.2 = p.2 + ((xa.im : Real) + (xa.re : Real)) / 2 + linarith + rw [hpi', hp0'] at hpi + exact hpi + +private theorem slopeDelta : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (s0 : + Real × Real), + let I : GaussianInt := ⟨0, 1⟩ + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let a13 : GaussianInt := BandVectors.2 (q 1) (q 3) + (P4250T1SlopeOffset a13 - P4250T1SlopeOffset alpha - P4250T1SlopeOffset xa = + -GaussianRealPoint (I * alpha)) → ((BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (3 : Fin + (4 : ℕ))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (3 : Fin (4 : ℕ))) + (q (2 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = + -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin + (4 : ℕ)))) → ((s0 + P4250T1SlopeOffset a13) - (s0 + P4250T1SlopeOffset alpha + + P4250T1SlopeOffset xa) = GaussianRealPoint (BandVectors.2 (q 2) (q 3)))) ) := by + classical + intro q cfg s0 I alpha xa a13 slopeIdentity secondFlip + calc + _ = P4250T1SlopeOffset a13 - P4250T1SlopeOffset alpha - + P4250T1SlopeOffset xa := by ext <;> dsimp <;> ring + _ = -GaussianRealPoint (I * alpha) := slopeIdentity + _ = GaussianRealPoint (BandVectors.2 (q 2) (q 3)) := by + rw [secondFlip.2] + dsimp [GaussianRealPoint, I, alpha] + ext <;> simp + +private theorem adjQ2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (cert.P i s) (h i s)) → (∀ (k : Fin (3 : + ℕ) → Bool → PartialOdometer), (TileOdometer (cfg.firstPredecessor 2) (cert.Q 1 true) + (k 1 true)) → ( + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let a13 : GaussianInt := BandVectors.2 (q 1) (q 3) + (TileCentroid (cert.P (1 : Fin (3 : ℕ)) true) - TileCentroid (cert.Q (1 : Fin (3 : ℕ)) + true) = GaussianRealPoint (BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : + ℕ))))) → ((PartialOdometerSlope (h (1 : Fin (3 : ℕ)) true) = some (s0 + + P4250T1SlopeOffset a13)) → ((PartialOdometerSlope (k (1 : Fin (3 : ℕ)) true) = some + (s0 + P4250T1SlopeOffset alpha + P4250T1SlopeOffset xa)) → (((s0 + + P4250T1SlopeOffset a13) - (s0 + P4250T1SlopeOffset alpha + P4250T1SlopeOffset + xa) = GaussianRealPoint (BandVectors.2 (q 2) (q 3))) → (∀ (posRoot2 : 0 < (q 2).1), + let C2 : BandCircle := + ⟨⟨q 2, Or.inl posRoot2, q, cfg.proper.1, 2, rfl⟩, posRoot2⟩ + RightLatticeAdjacent C2 (cert.Q 1 true) (cert.P 1 true) (k 1 true) (h 1 true))))))) ) := by + classical + intro q cfg C T cert h s0 ho k odoQ2 alpha xa a13 hcenterDelta rootSlope childSlope slopeDelta + posRoot2 C2 + refine ⟨?_, ?_, s0 + P4250T1SlopeOffset alpha + + P4250T1SlopeOffset xa, s0 + P4250T1SlopeOffset a13, + childSlope, rootSlope, cfg.secondPredecessor, 0, true, + cfg.secondProper, cfg.secondChild, ?_, ?_, ?_⟩ + · simpa [C2, cfg.firstParentTwo] using odoQ2 + · simpa [C2, cfg.firstParentTwo] using ho 1 true + · simpa [Fin.succ_zero_eq_one, cfg.secondChild, cfg.secondParentOne] using + hcenterDelta + · simpa [cfg.secondChild, cfg.secondParentOne, GaussianRealPoint, + Fin.succ_zero_eq_one] using + congrArg Prod.fst slopeDelta + · simpa [cfg.secondChild, cfg.secondParentOne, GaussianRealPoint, + Fin.succ_zero_eq_one] using + congrArg Prod.snd slopeDelta + +private theorem rawCompatLift : + (by + classical + exact + ∀ (a : PartialOdometer), ∀ (b : PartialOdometer), ∀ (r : PartialOdometer), ∀ (X : + ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ((a.domain : Set GaussianInt) = + FootprintVertices X) → (((b.domain : Set GaussianInt) = FootprintVertices Y) → + (((r.domain : Set GaussianInt) = FootprintVertices Z) → ((∀ x, x ∈ r.domain → a.value + x = r.value x) → ((FootprintVertices X ∩ FootprintVertices Y ⊆ + FootprintVertices Z ∩ FootprintVertices Y) → ((OdometerCompatibility r b) → + (OdometerCompatibility a b)))))) ) := by + classical + intro a b r X Y Z hX hY hZ hrestrict hcover hcompat + rcases hcompat with hd | ⟨c, hc⟩ + · left + apply Set.disjoint_left.mpr + intro x hxa hxb + have hxX : x ∈ FootprintVertices X := (Set.ext_iff.mp hX x).mp hxa + have hxY : x ∈ FootprintVertices Y := (Set.ext_iff.mp hY x).mp hxb + have hxZ : x ∈ FootprintVertices Z := (hcover ⟨hxX, hxY⟩).1 + exact (Set.disjoint_left.mp hd) + ((Set.ext_iff.mp hZ x).mpr hxZ) hxb + · right + refine ⟨c, ?_⟩ + intro x hxa hxb + have hxX : x ∈ FootprintVertices X := (Set.ext_iff.mp hX x).mp hxa + have hxY : x ∈ FootprintVertices Y := (Set.ext_iff.mp hY x).mp hxb + have hxZ : x ∈ FootprintVertices Z := (hcover ⟨hxX, hxY⟩).1 + have hxr : x ∈ r.domain := (Set.ext_iff.mp hZ x).mpr hxZ + have hconst := hc x hxr hxb + rw [(hrestrict x hxr).symm] at hconst + exact hconst + +private theorem hq1pos : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), (1 < + (cfg.firstPredecessor 0).1) → (0 < (q 1).1) ) := by + classical + intro q cfg hroot + exact lt_trans (by norm_num : (0 : Int) < 1) + (by simpa [cfg.firstChild] using hroot) + +private theorem hcenterS : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let B := cert.P 0 false + let xv : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + TileCentroid (cert.S 1 false) - TileCentroid B = -spatial xv ) := by + classical + intro q cfg C T cert B xv spatial + simpa [spatial, xv, Fin.add_def, cfg.firstParentThree] using + (cert.minus_occurrence 1 false).2.2 + +private theorem hcenterPminus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let v13 : GaussianInt := BandVectors.1 (q 1) (q 3) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + TileCentroid (cert.P 1 false) - TileCentroid T = -spatial v13 ) := by + classical + intro q cfg C T cert v13 spatial + simpa [spatial, v13, Fin.add_def] using (cert.outer_occurrence 1 false).2.2 + +private theorem hcenterDeltaMinus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let B := cert.P 0 false + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let xv : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let v13 : GaussianInt := BandVectors.1 (q 1) (q 3) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (spatial v13 - spatial w - spatial xv = GaussianRealPoint (I * w)) → ((BandVectors.1 (q + (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (2 : Fin + (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 + (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → ((TileCentroid B - TileCentroid T = + -spatial w) → ((TileCentroid (cert.S 1 false) - TileCentroid B = -spatial xv) → + ((TileCentroid (cert.P 1 false) - TileCentroid T = -spatial v13) → (TileCentroid + (cert.P 1 false) - TileCentroid (cert.S 1 false) = -GaussianRealPoint (BandVectors.1 + (q 2) (q 3))))))) ) := by + classical + intro q cfg C T cert B I w xv v13 spatial spatialIdentity secondFlip hcenterB hcenterS + hcenterPminus + have hcenterST : TileCentroid (cert.S 1 false) - TileCentroid T = + -spatial xv - spatial w := by + calc + _ = (TileCentroid (cert.S 1 false) - TileCentroid B) + + (TileCentroid B - TileCentroid T) := by ext <;> dsimp <;> ring + _ = _ := by + rw [hcenterS, hcenterB] + ext <;> dsimp <;> ring + calc + _ = (TileCentroid (cert.P 1 false) - TileCentroid T) - + (TileCentroid (cert.S 1 false) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = -spatial v13 + spatial xv + spatial w := by + rw [hcenterPminus, hcenterST] + ext <;> dsimp <;> ring + _ = -GaussianRealPoint (I * w) := by + rw [← spatialIdentity] + ext <;> dsimp <;> ring + _ = -GaussianRealPoint (BandVectors.1 (q 2) (q 3)) := by + rw [← secondFlip.1] + +private theorem childSlopeMinus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (h : + Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), PartialOdometerSlope (h i s) = some (s0 + (if s = true then (1 : ℝ) else (-1 : + ℝ)) • P4250T1SlopeOffset (BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 + : Fin (3 : ℕ))).succ)))) → (∀ (l : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), (cfg.firstPredecessor i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ × ℝ) + (p_i : ℝ × ℝ), PartialOdometerSlope (h (0 : Fin (3 : ℕ)) false) = some p ∧ + PartialOdometerSlope (l i s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin + (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = + true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 + (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin + (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((0 + < (cfg.firstPredecessor 2).1) → ( + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + PartialOdometerSlope (l 1 false) = some (s0 - P4250T1SlopeOffset alpha - + P4250T1SlopeOffset xa)))) ) := by + classical + intro q cfg h s0 hp l hslopeB pos2 alpha xa + rcases hslopeB 1 false with hz | hs + · have hbad : (cfg.firstPredecessor 2).1 = 0 := hz + have : (q 2).1 = 0 := by simpa [cfg.firstParentTwo] using hbad + exact False.elim (by have := cfg.noLine 2; omega) + · rcases hs with ⟨p, pi, hp0, hpi, hreal, himag⟩ + have hp0' : p = s0 - P4250T1SlopeOffset alpha := by + have heq : some p = some (s0 - P4250T1SlopeOffset alpha) := by + simpa [alpha, Fin.add_def, sub_eq_add_neg, smul_eq_mul] using + hp0.symm.trans (hp 0 false) + exact Option.some.inj heq + have hpi' : pi = p - P4250T1SlopeOffset xa := by + apply Prod.ext + · have hreal' : pi.1 - p.1 = + -((xa.re : Real) - (xa.im : Real)) / 2 := by + convert hreal using 1; simp [xa, cfg.firstParentThree]; ring + change pi.1 = p.1 - ((xa.re : Real) - (xa.im : Real)) / 2 + linarith + · have himag' : pi.2 - p.2 = + -((xa.im : Real) + (xa.re : Real)) / 2 := by + convert himag using 1; simp [xa, cfg.firstParentThree]; ring + change pi.2 = p.2 - ((xa.im : Real) + (xa.re : Real)) / 2 + linarith + rw [hpi', hp0'] at hpi + exact hpi + +private theorem rootSlopeMinus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × + Real), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), PartialOdometerSlope (h i s) = some (s0 + + (if s = true then (1 : ℝ) else (-1 : ℝ)) • P4250T1SlopeOffset (BandVectors.2 (q (i + + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)))) → ( + let a13 : GaussianInt := BandVectors.2 (q 1) (q 3) + PartialOdometerSlope (h 1 false) = some (s0 - P4250T1SlopeOffset a13)) ) := by + classical + intro q h s0 hp a13 + simpa [a13, Fin.add_def, sub_eq_add_neg, smul_eq_mul] using hp 1 false + +private theorem slopeIdentityMinus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let a13 : GaussianInt := BandVectors.2 (q 1) (q 3) + (P4250T1SlopeOffset a13 - P4250T1SlopeOffset alpha - P4250T1SlopeOffset xa = + -GaussianRealPoint (I * alpha)) → (P4250T1SlopeOffset alpha + P4250T1SlopeOffset + xa - P4250T1SlopeOffset a13 = GaussianRealPoint (I * alpha)) ) := by + classical + intro q cfg I alpha xa a13 slopeIdentity + calc + _ = -(P4250T1SlopeOffset a13 - P4250T1SlopeOffset alpha - + P4250T1SlopeOffset xa) := by ext <;> dsimp <;> ring + _ = GaussianRealPoint (I * alpha) := by rw [slopeIdentity]; simp + +private theorem slopeDeltaMinus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (s0 : + Real × Real), + let I : GaussianInt := ⟨0, 1⟩ + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let a13 : GaussianInt := BandVectors.2 (q 1) (q 3) + (BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → + ((P4250T1SlopeOffset alpha + P4250T1SlopeOffset xa - P4250T1SlopeOffset a13 = + GaussianRealPoint (I * alpha)) → ((s0 - P4250T1SlopeOffset a13) - (s0 - + P4250T1SlopeOffset alpha - P4250T1SlopeOffset xa) = -GaussianRealPoint + (BandVectors.2 (q 2) (q 3)))) ) := by + classical + intro q cfg s0 I alpha xa a13 secondFlip slopeIdentityMinus + have hflip := secondFlip.2 + calc + _ = P4250T1SlopeOffset alpha + P4250T1SlopeOffset xa - + P4250T1SlopeOffset a13 := by ext <;> dsimp <;> ring + _ = GaussianRealPoint (I * alpha) := slopeIdentityMinus + _ = -GaussianRealPoint (BandVectors.2 (q 2) (q 3)) := by + rw [hflip] + dsimp [GaussianRealPoint, I, alpha] + ext <;> simp + +private theorem adjS2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (cert.P i s) (h i s)) → (∀ (l : Fin (3 : + ℕ) → Bool → PartialOdometer), (TileOdometer (cfg.firstPredecessor 2) (cert.S 1 false) + (l 1 false)) → ( + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let a13 : GaussianInt := BandVectors.2 (q 1) (q 3) + ∀ (posRoot2 : 0 < (q 2).1), + let C2 : BandCircle := + ⟨⟨q 2, Or.inl posRoot2, q, cfg.proper.1, 2, rfl⟩, posRoot2⟩ + (TileCentroid (cert.P 1 false) - TileCentroid (cert.S 1 false) = -GaussianRealPoint + (BandVectors.1 (q 2) (q 3))) → ((PartialOdometerSlope (l 1 false) = some (s0 - + P4250T1SlopeOffset alpha - P4250T1SlopeOffset xa)) → ((PartialOdometerSlope (h 1 + false) = some (s0 - P4250T1SlopeOffset a13)) → (((s0 - P4250T1SlopeOffset a13) - + (s0 - P4250T1SlopeOffset alpha - P4250T1SlopeOffset xa) = -GaussianRealPoint + (BandVectors.2 (q 2) (q 3))) → (RightLatticeAdjacent C2 (cert.S 1 false) (cert.P 1 + false) (l 1 false) (h 1 false))))))) ) := by + classical + intro q cfg C T cert h s0 ho l odoS2 alpha xa a13 posRoot2 C2 hcenterDeltaMinus childSlopeMinus + rootSlopeMinus slopeDeltaMinus + refine ⟨?_, ?_, s0 - P4250T1SlopeOffset alpha - + P4250T1SlopeOffset xa, s0 - P4250T1SlopeOffset a13, + childSlopeMinus, rootSlopeMinus, cfg.secondPredecessor, 0, false, + cfg.secondProper, cfg.secondChild, ?_, ?_, ?_⟩ + · simpa [C2, cfg.firstParentTwo] using odoS2 + · simpa [C2, cfg.firstParentTwo] using ho 1 false + · simpa [Fin.succ_zero_eq_one, cfg.secondChild, cfg.secondParentOne] using + hcenterDeltaMinus + · simpa [cfg.secondChild, cfg.secondParentOne, GaussianRealPoint, + Fin.succ_zero_eq_one] using + congrArg Prod.fst slopeDeltaMinus + · simpa [cfg.secondChild, cfg.secondParentOne, GaussianRealPoint, + Fin.succ_zero_eq_one] using + congrArg Prod.snd slopeDeltaMinus + +private theorem childSlopeS3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (h : + Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), PartialOdometerSlope (h i s) = some (s0 + (if s = true then (1 : ℝ) else (-1 : + ℝ)) • P4250T1SlopeOffset (BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 + : Fin (3 : ℕ))).succ)))) → (∀ (l : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), (cfg.firstPredecessor i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ × ℝ) + (p_i : ℝ × ℝ), PartialOdometerSlope (h (0 : Fin (3 : ℕ)) false) = some p ∧ + PartialOdometerSlope (l i s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin + (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = + true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 + (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin + (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((0 + < (cfg.firstPredecessor 3).1) → ( + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let x2a : GaussianInt := + BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + PartialOdometerSlope (l 2 false) = some (s0 - P4250T1SlopeOffset alpha - + P4250T1SlopeOffset x2a)))) ) := by + classical + intro q cfg h s0 hp l hslopeB pos3 alpha x2a + rcases hslopeB 2 false with hz | hs + · have hbad : (cfg.firstPredecessor 3).1 = 0 := hz + have : (q 3).1 = 0 := by simpa [cfg.firstParentThree] using hbad + exact False.elim (by have := cfg.noLine 3; omega) + · rcases hs with ⟨p, pi, hp0, hpi, hreal, himag⟩ + have hp0' : p = s0 - P4250T1SlopeOffset alpha := by + have heq : some p = some (s0 - P4250T1SlopeOffset alpha) := by + simpa [alpha, Fin.add_def, sub_eq_add_neg, smul_eq_mul] using + hp0.symm.trans (hp 0 false) + exact Option.some.inj heq + have hpi' : pi = p - P4250T1SlopeOffset x2a := by + apply Prod.ext + · have hreal' : pi.1 - p.1 = + -((x2a.re : Real) - (x2a.im : Real)) / 2 := by + convert hreal using 1; + simp [x2a, Fin.add_def]; ring + change pi.1 = p.1 - ((x2a.re : Real) - (x2a.im : Real)) / 2 + linarith + · have himag' : pi.2 - p.2 = + -((x2a.im : Real) + (x2a.re : Real)) / 2 := by + convert himag using 1; + simp [x2a, Fin.add_def]; ring + change pi.2 = p.2 - ((x2a.im : Real) + (x2a.re : Real)) / 2 + linarith + rw [hpi', hp0'] at hpi + exact hpi + +private theorem hcenterS3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let B := cert.P 0 false + ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid + (V i s) - TileCentroid B = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((∀ (i : Fin 3), ∀ (s : + Bool), (V i s).cells = (cert.S i s).cells ∧ ((V i s).cells = ∅ → (V i s).anchor = + (cert.S i s).anchor) ∧ FootprintVertices (V i s) = FootprintVertices (cert.S i s)) → ( + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (TileCentroid B - TileCentroid T = -spatial w) → ( + let x2v : GaussianInt := + BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + TileCentroid (cert.S 2 false) - TileCentroid T = -spatial w - spatial x2v))) ) := by + classical + intro q cfg C T cert B V hcentB alignB w spatial hcenterB x2v + have hsb : TileCentroid (cert.S 2 false) - TileCentroid B = + -spatial x2v := by + have hc := hcentB 2 false + have hc' : TileCentroid (V 2 false) = + TileCentroid (cert.S 2 false) := by + by_cases he : (V 2 false).cells = ∅ + · simp [TileCentroid, (alignB 2 false).1, + (alignB 2 false).2.1 he] + · have hne : (cert.S 2 false).cells.Nonempty := by + rw [← (alignB 2 false).1] + exact Finset.nonempty_iff_ne_empty.mpr he + simp [TileCentroid, (alignB 2 false).1, hne] + have hc'' : TileCentroid (cert.S 2 false) - TileCentroid B = + (if false = true then (1 : Real) else -1) • + ((1 / 2 : Real) • (GaussianRealPoint x2v - + (-(GaussianRealPoint x2v).2, (GaussianRealPoint x2v).1))) := by + simpa [hc', x2v, Fin.add_def] using hc + convert hc'' using 1; ext <;> dsimp [spatial] <;> ring + calc + _ = (TileCentroid (cert.S 2 false) - TileCentroid B) + + (TileCentroid B - TileCentroid T) := by ext <;> dsimp <;> ring + _ = _ := by rw [hsb, hcenterB]; ext <;> dsimp <;> ring + +private theorem crossSpatial : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let xv : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (BandVectors.1 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 + : ℕ))) + BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor + (3 : Fin (4 : ℕ))) + BandVectors.1 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = (0 : GaussianInt)) → ((TileCentroid + (cert.Q 1 true) - TileCentroid T = spatial xv + spatial w) → ( + let x2v : GaussianInt := + BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + (TileCentroid (cert.S 2 false) - TileCentroid T = -spatial w - spatial x2v) → + (TileCentroid (cert.S 2 false) - TileCentroid (cert.Q 1 true) = (1 / 2 : Real) • + GaussianRealPoint ((I : GaussianInt) * (w + I * w))))) ) := by + classical + intro q cfg C T cert I w xv spatial hpredV hcenterQT x2v hcenterS3 + have hsum : w + xv + x2v = 0 := by + simpa [w, xv, x2v, cfg.firstParentTwo, cfg.firstParentThree] using hpredV + have hdelta : (-spatial w - spatial x2v) - + (spatial xv + spatial w) = -spatial w := by + rw [show x2v = -w - xv by linear_combination hsum] + ext <;> simp [spatial, GaussianRealPoint] <;> ring + calc + _ = (TileCentroid (cert.S 2 false) - TileCentroid T) - + (TileCentroid (cert.Q 1 true) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = (-spatial w - spatial x2v) - (spatial xv + spatial w) := by + rw [hcenterS3, hcenterQT] + _ = -spatial w := hdelta + _ = (1 / 2 : Real) • GaussianRealPoint + ((I : GaussianInt) * (w + I * w)) := by + dsimp [spatial, GaussianRealPoint, I] + ext <;> simp [] <;> all_goals ring + +private theorem crossSlope : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (s0 : + Real × Real), + let I : GaussianInt := ⟨0, 1⟩ + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + (BandVectors.2 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 + : ℕ))) + BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor + (3 : Fin (4 : ℕ))) + BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = (0 : GaussianInt)) → ((BandVectors.1 (q (2 + : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (2 : Fin + (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 + (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → ( + let x2a : GaussianInt := + BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + (s0 - P4250T1SlopeOffset alpha - P4250T1SlopeOffset x2a) - (s0 + P4250T1SlopeOffset + alpha + P4250T1SlopeOffset xa) = (1 / 2 : Real) • GaussianRealPoint ((-I : + GaussianInt) * (alpha + BandVectors.2 (q 2) (q 3))))) ) := by + classical + intro q cfg s0 I alpha xa hpredA secondFlip x2a + have hsum : alpha + xa + x2a = 0 := by + simpa [alpha, xa, x2a, cfg.firstParentTwo, cfg.firstParentThree] using hpredA + have hdelta : (-2 : Real) • P4250T1SlopeOffset alpha - + P4250T1SlopeOffset x2a - P4250T1SlopeOffset xa = + -P4250T1SlopeOffset alpha := by + rw [show x2a = -alpha - xa by linear_combination hsum] + ext <;> dsimp [P4250T1SlopeOffset] <;> push_cast <;> ring + calc + _ = (-2 : Real) • P4250T1SlopeOffset alpha - + P4250T1SlopeOffset x2a - P4250T1SlopeOffset xa := by + ext <;> dsimp <;> ring + _ = -P4250T1SlopeOffset alpha := hdelta + _ = (1 / 2 : Real) • GaussianRealPoint + ((-I : GaussianInt) * + (alpha + BandVectors.2 (q 2) (q 3))) := by + rw [secondFlip.2] + dsimp [P4250T1SlopeOffset, GaussianRealPoint, I, alpha] + ext <;> simp <;> ring + +private theorem posRoot3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (0 < (q 3).1) ) + := by + classical + intro q cfg + have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 2 + have hnon : 0 ≤ (q 3).1 := by simpa using hn + have hne := cfg.noLine 3 + omega + +private theorem adjCross1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (s0 : Real × Real), ∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (l : Fin (3 + : ℕ) → Bool → PartialOdometer), (TileOdometer (cfg.firstPredecessor 2) (cert.Q 1 + true) (k 1 true)) → ((TileOdometer (cfg.firstPredecessor 3) (cert.S 2 false) (l 2 + false)) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + (BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → + ((PartialOdometerSlope (k (1 : Fin (3 : ℕ)) true) = some (s0 + P4250T1SlopeOffset + alpha + P4250T1SlopeOffset xa)) → (∀ (posRoot2 : 0 < (q 2).1), + let C2 : BandCircle := + ⟨⟨q 2, Or.inl posRoot2, q, cfg.proper.1, 2, rfl⟩, posRoot2⟩ + let x2a : GaussianInt := + BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + (PartialOdometerSlope (l 2 false) = some (s0 - P4250T1SlopeOffset alpha - + P4250T1SlopeOffset x2a)) → ((TileCentroid (cert.S 2 false) - TileCentroid (cert.Q 1 + true) = (1 / 2 : Real) • GaussianRealPoint ((I : GaussianInt) * (w + I * w))) → (((s0 + - P4250T1SlopeOffset alpha - P4250T1SlopeOffset x2a) - (s0 + P4250T1SlopeOffset + alpha + P4250T1SlopeOffset xa) = (1 / 2 : Real) • GaussianRealPoint ((-I : + GaussianInt) * (alpha + BandVectors.2 (q 2) (q 3)))) → (∀ (posRoot3 : 0 < (q 3).1), + let C3 : BandCircle := + ⟨⟨q 3, Or.inl posRoot3, q, cfg.proper.1, 3, rfl⟩, posRoot3⟩ + SubtileLatticeAdjacent C2 C3 (cert.Q 1 true) (cert.S 2 false) (k 1 true) (l 2 + false)))))))) ) := by + classical + intro q cfg C T cert s0 k l odoQ2 odoS3 I w alpha xa secondFlip childSlope posRoot2 C2 x2a + childSlopeS3 crossSpatial crossSlope posRoot3 C3 + refine ⟨?_, ?_, ⟨s0 + P4250T1SlopeOffset alpha + + P4250T1SlopeOffset xa, + s0 - P4250T1SlopeOffset alpha - + P4250T1SlopeOffset x2a, + childSlope, childSlopeS3, cfg.secondPredecessor, 0, 1, + cfg.secondProper, cfg.secondChild, cfg.secondParentOne, ?_, ?_, ?_⟩⟩ + · simpa [C2, cfg.firstParentTwo] using odoQ2 + · simpa [C3, cfg.firstParentThree] using odoS3 + · simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl, + cfg.secondChild, cfg.secondParentOne] + rw [secondFlip.1] + exact crossSpatial + · simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl, + cfg.secondChild, cfg.secondParentOne] + simpa [pow_one] using congrArg Prod.fst crossSlope + · simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl, + cfg.secondChild, cfg.secondParentOne] + simpa [pow_one] using congrArg Prod.snd crossSlope + +private theorem childSlopeQ3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (h : + Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), PartialOdometerSlope (h i s) = some (s0 + (if s = true then (1 : ℝ) else (-1 : + ℝ)) • P4250T1SlopeOffset (BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 + : Fin (3 : ℕ))).succ)))) → (∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), (cfg.firstPredecessor i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ × ℝ) + (p_i : ℝ × ℝ), PartialOdometerSlope (h (0 : Fin (3 : ℕ)) true) = some p ∧ + PartialOdometerSlope (k i s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin + (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = + true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 + (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin + (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((0 + < (cfg.firstPredecessor 3).1) → ( + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let x2a : GaussianInt := + BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + PartialOdometerSlope (k 2 true) = some (s0 + P4250T1SlopeOffset alpha + + P4250T1SlopeOffset x2a)))) ) := by + classical + intro q cfg h s0 hp k hslopeA pos3 alpha x2a + rcases hslopeA 2 true with hz | hs + · have hbad : (cfg.firstPredecessor 3).1 = 0 := hz + have : (q 3).1 = 0 := by simpa [cfg.firstParentThree] using hbad + exact False.elim (by have := cfg.noLine 3; omega) + · rcases hs with ⟨p, pi, hp0, hpi, hreal, himag⟩ + have hp0' : p = s0 + P4250T1SlopeOffset alpha := by + have heq : some p = some (s0 + P4250T1SlopeOffset alpha) := by + simpa [alpha, Fin.add_def] using hp0.symm.trans (hp 0 true) + exact Option.some.inj heq + have hpi' : pi = p + P4250T1SlopeOffset x2a := by + apply Prod.ext + · have hreal' : pi.1 - p.1 = + ((x2a.re : Real) - (x2a.im : Real)) / 2 := by + convert hreal using 1; + simp [x2a, Fin.add_def]; ring + change pi.1 = p.1 + ((x2a.re : Real) - (x2a.im : Real)) / 2 + linarith + · have himag' : pi.2 - p.2 = + ((x2a.im : Real) + (x2a.re : Real)) / 2 := by + convert himag using 1; + simp [x2a, Fin.add_def]; ring + change pi.2 = p.2 + ((x2a.im : Real) + (x2a.re : Real)) / 2 + linarith + rw [hpi', hp0'] at hpi + exact hpi + +private theorem hcenterQ3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let A := cert.P 0 true + ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid + (U i s) - TileCentroid A = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((∀ (i : Fin 3), ∀ (s : + Bool), (U i s).cells = (cert.Q i s).cells ∧ ((U i s).cells = ∅ → (U i s).anchor = + (cert.Q i s).anchor) ∧ FootprintVertices (U i s) = FootprintVertices (cert.Q i s)) → ( + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (TileCentroid A - TileCentroid T = spatial w) → ( + let x2v : GaussianInt := + BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + TileCentroid (cert.Q 2 true) - TileCentroid T = spatial w + spatial x2v))) ) := by + classical + intro q cfg C T cert A U hcentA alignA w spatial hcenterA x2v + have hqa : TileCentroid (cert.Q 2 true) - TileCentroid A = + spatial x2v := by + have hc := hcentA 2 true + have hc' : TileCentroid (U 2 true) = + TileCentroid (cert.Q 2 true) := by + by_cases he : (U 2 true).cells = ∅ + · simp [TileCentroid, (alignA 2 true).1, + (alignA 2 true).2.1 he] + · have hne : (cert.Q 2 true).cells.Nonempty := by + rw [← (alignA 2 true).1] + exact Finset.nonempty_iff_ne_empty.mpr he + simp [TileCentroid, (alignA 2 true).1, hne] + have hc'' : TileCentroid (cert.Q 2 true) - TileCentroid A = + (1 / 2 : Real) • (GaussianRealPoint x2v - + (-(GaussianRealPoint x2v).2, (GaussianRealPoint x2v).1)) := by + simpa [hc', x2v, Fin.add_def] using hc + convert hc'' using 1 + calc + _ = (TileCentroid (cert.Q 2 true) - TileCentroid A) + + (TileCentroid A - TileCentroid T) := by ext <;> dsimp <;> ring + _ = _ := by rw [hqa, hcenterA]; ext <;> dsimp <;> ring + +private theorem crossSpatial2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let B := cert.P 0 false + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let xv : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (BandVectors.1 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 + : ℕ))) + BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor + (3 : Fin (4 : ℕ))) + BandVectors.1 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = (0 : GaussianInt)) → (((I : GaussianInt) ^ + 3 = -I) → (((-I : GaussianInt) * I = 1) → ((∀ (z : GaussianInt), I * z = ⟨-z.im, + z.re⟩) → ((TileCentroid B - TileCentroid T = -spatial w) → ((TileCentroid (cert.S 1 + false) - TileCentroid B = -spatial xv) → ( + let x2v : GaussianInt := + BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + (TileCentroid (cert.Q 2 true) - TileCentroid T = spatial w + spatial x2v) → (TileCentroid + (cert.Q 2 true) - TileCentroid (cert.S 1 false) = (1 / 2 : Real) • GaussianRealPoint + ((I : GaussianInt) ^ (3 : Nat) * (w + I * w))))))))) ) := by + classical + intro q cfg C T cert B I w xv spatial hpredV hI3 hnegII hIprod hcenterB hcenterS x2v hcenterQ3 + have hcenterS1T : TileCentroid (cert.S 1 false) - TileCentroid T = + -spatial xv - spatial w := by + calc + _ = (TileCentroid (cert.S 1 false) - TileCentroid B) + + (TileCentroid B - TileCentroid T) := by ext <;> dsimp <;> ring + _ = _ := by rw [hcenterS, hcenterB]; ext <;> dsimp <;> ring + have hsum : w + xv + x2v = 0 := by + simpa [w, xv, x2v, cfg.firstParentTwo, cfg.firstParentThree] using hpredV + have hdelta : (spatial w + spatial x2v) - + (-spatial w - spatial xv) = spatial w := by + rw [show x2v = -w - xv by linear_combination hsum] + ext <;> simp [spatial, GaussianRealPoint] <;> ring + calc + _ = (TileCentroid (cert.Q 2 true) - TileCentroid T) - + (TileCentroid (cert.S 1 false) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = (spatial w + spatial x2v) - + (-spatial w - spatial xv) := by + rw [hcenterQ3, hcenterS1T] + ext <;> dsimp <;> ring + _ = spatial w := hdelta + _ = (1 / 2 : Real) • GaussianRealPoint + ((I : GaussianInt) ^ (3 : Nat) * (w + I * w)) := by + have hp : (I : GaussianInt) ^ 3 * (w + I * w) = w - I * w := by + rw [hI3] + calc + (-I) * (w + I * w) = -I * w + ((-I) * I) * w := by + rw [mul_add, ← mul_assoc] + _ = w - I * w := by rw [hnegII]; ring + rw [hp, hIprod w] + dsimp [spatial, GaussianRealPoint] + ext <;> simp + +private theorem crossSlope2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (s0 : + Real × Real), + let I : GaussianInt := ⟨0, 1⟩ + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + (BandVectors.2 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 + : ℕ))) + BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor + (3 : Fin (4 : ℕ))) + BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = (0 : GaussianInt)) → ((BandVectors.1 (q (2 + : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (2 : Fin + (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 + (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → ((I * (-I) = 1) → (((-I : GaussianInt) + ^ 3 = I) → ((∀ (z : GaussianInt), I * z = ⟨-z.im, z.re⟩) → ( + let x2a : GaussianInt := + BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + (s0 + P4250T1SlopeOffset alpha + P4250T1SlopeOffset x2a) - (s0 - P4250T1SlopeOffset + alpha - P4250T1SlopeOffset xa) = (1 / 2 : Real) • GaussianRealPoint (((-I : + GaussianInt) ^ (3 : Nat)) * (alpha + BandVectors.2 (q 2) (q 3)))))))) ) := by + classical + intro q cfg s0 I alpha xa hpredA secondFlip hIneg hI3neg hIprod x2a + have hsum : alpha + xa + x2a = 0 := by + simpa [alpha, xa, x2a, cfg.firstParentTwo, cfg.firstParentThree] using hpredA + have hdelta : (2 : Real) • P4250T1SlopeOffset alpha + + P4250T1SlopeOffset x2a + P4250T1SlopeOffset xa = + P4250T1SlopeOffset alpha := by + rw [show x2a = -alpha - xa by linear_combination hsum] + ext <;> dsimp [P4250T1SlopeOffset] <;> push_cast <;> ring + calc + _ = (2 : Real) • P4250T1SlopeOffset alpha + + P4250T1SlopeOffset x2a + P4250T1SlopeOffset xa := by + ext <;> dsimp <;> ring + _ = P4250T1SlopeOffset alpha := hdelta + _ = (1 / 2 : Real) • GaussianRealPoint + (((-I : GaussianInt) ^ (3 : Nat)) * + (alpha + BandVectors.2 (q 2) (q 3))) := by + rw [secondFlip.2] + have hp : (-I : GaussianInt) ^ 3 * (alpha + (-I) * alpha) = + alpha + I * alpha := by + calc + _ = I * (alpha + (-I) * alpha) := by rw [hI3neg] + _ = I * alpha + (I * (-I)) * alpha := by + rw [mul_add, ← mul_assoc] + _ = alpha + I * alpha := by rw [hIneg]; ring + rw [hp] + have hIa := hIprod alpha + rw [hIa] + ext <;> simp [P4250T1SlopeOffset, GaussianRealPoint] <;> ring + +private theorem adjCross2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (s0 : Real × Real), ∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (l : Fin (3 + : ℕ) → Bool → PartialOdometer), (TileOdometer (cfg.firstPredecessor 2) (cert.S 1 + false) (l 1 false)) → ((TileOdometer (cfg.firstPredecessor 3) (cert.Q 2 true) (k 2 + true)) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + (BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → (∀ + (posRoot2 : 0 < (q 2).1), + let C2 : BandCircle := + ⟨⟨q 2, Or.inl posRoot2, q, cfg.proper.1, 2, rfl⟩, posRoot2⟩ + (PartialOdometerSlope (l 1 false) = some (s0 - P4250T1SlopeOffset alpha - + P4250T1SlopeOffset xa)) → ( + let x2a : GaussianInt := + BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + ∀ (posRoot3 : 0 < (q 3).1), + let C3 : BandCircle := + ⟨⟨q 3, Or.inl posRoot3, q, cfg.proper.1, 3, rfl⟩, posRoot3⟩ + (PartialOdometerSlope (k 2 true) = some (s0 + P4250T1SlopeOffset alpha + + P4250T1SlopeOffset x2a)) → ((TileCentroid (cert.Q 2 true) - TileCentroid (cert.S 1 + false) = (1 / 2 : Real) • GaussianRealPoint ((I : GaussianInt) ^ (3 : Nat) * (w + I * + w))) → (((s0 + P4250T1SlopeOffset alpha + P4250T1SlopeOffset x2a) - (s0 - + P4250T1SlopeOffset alpha - P4250T1SlopeOffset xa) = (1 / 2 : Real) • + GaussianRealPoint (((-I : GaussianInt) ^ (3 : Nat)) * (alpha + BandVectors.2 (q 2) (q + 3)))) → (SubtileLatticeAdjacent C2 C3 (cert.S 1 false) (cert.Q 2 true) (l 1 false) (k + 2 true)))))))) ) := by + classical + intro q cfg C T cert s0 k l odoS2 odoQ3 I w alpha xa secondFlip posRoot2 C2 childSlopeMinus x2a + posRoot3 C3 childSlopeQ3 crossSpatial2 crossSlope2 + refine ⟨?_, ?_, ⟨s0 - P4250T1SlopeOffset alpha - + P4250T1SlopeOffset xa, + s0 + P4250T1SlopeOffset alpha + + P4250T1SlopeOffset x2a, + childSlopeMinus, childSlopeQ3, cfg.secondPredecessor, 0, 3, + cfg.secondProper, cfg.secondChild, cfg.secondParentOne, ?_, ?_, ?_⟩⟩ + · simpa [C2, cfg.firstParentTwo] using odoS2 + · simpa [C3, cfg.firstParentThree] using odoQ3 + · simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl, + cfg.secondChild, cfg.secondParentOne] + rw [secondFlip.1] + exact crossSpatial2 + · simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl, + cfg.secondChild, cfg.secondParentOne] + simpa [pow_one] using congrArg Prod.fst crossSlope2 + · simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl, + cfg.secondChild, cfg.secondParentOne] + simpa [pow_one] using congrArg Prod.snd crossSlope2 + +private theorem propagateConstant : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ {V : Type}, ∀ + (f : V → Int), ∀ (g : V → Int), ∀ (L : Set V), ∀ (O : Set V), ∀ (R : Set V), ∀ (Iset + : Set V), ∀ (c : Int), ∀ (d : Int), ∀ (e : Int), ∀ (xL : V), ∀ (xR : V), (Iset ⊆ L ∪ + O ∪ R) → ((∀ x ∈ L, g x - f x = d) → ((∀ x ∈ O, g x - f x = c) → ((∀ x ∈ R, f x - g x + = e) → ((xL ∈ L ∩ O) → ((xR ∈ R ∩ O) → (∀ x ∈ Iset, g x - f x = c))))))) ) := by + classical + intro q cfg V f g L O R Iset c d e xL xR hcover hL hO hR hxL hxR + have hd : d = c := (hL xL hxL.1).symm.trans (hO xL hxL.2) + have he : -e = c := by + have h1 := hR xR hxR.1 + have h2 := hO xR hxR.2 + omega + intro x hx + rcases hcover hx with (hLx | hOx) | hRx + · rw [hL x hLx, hd] + · exact hO x hOx + · have hr := hR x hRx + omega + +private theorem properLarge : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (r : Fin 4 → + CircleCoordinates), (ProperBandQuadruple r) → (1 < (r 0).1)) ) := by + classical + intro q cfg r hr + have facts := ProperBandCurvatureStructure r hr + have hsome : ∃ i : Fin 3, 0 < (r i.succ).1 := by + by_cases h0 : 0 < (r (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (r (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + by_cases h2 : 0 < (r (2 : Fin 3).succ).1 + · exact ⟨2, h2⟩ + have z0 : (r (0 : Fin 3).succ).1 = 0 := by + have hn := facts.2.1 0 + omega + have z1 : (r (1 : Fin 3).succ).1 = 0 := by + have hn := facts.2.1 1 + omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim + obtain ⟨i, hi⟩ := hsome + have hlt := hr.2 i + omega + +private theorem bandPositiveNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (D : + CircleCoordinates), ∀ (X : ProtoTile), BandPrototile D X → 0 < D.1 → + X.cells.Nonempty) ) := by + classical + intro q cfg D X hX + induction hX with + | line w x hw => intro hp; simp at hp + | unit z x a => intro hp; exact ⟨x, by simp⟩ + | @decompose r hr S X hS hc hf hcent ih => + intro hp + have facts := ProperBandCurvatureStructure r hr + have hsome : ∃ i : Fin 3, 0 < (r i.succ).1 := by + by_cases h0 : 0 < (r (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (r (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + by_cases h2 : 0 < (r (2 : Fin 3).succ).1 + · exact ⟨2, h2⟩ + have z0 : (r (0 : Fin 3).succ).1 = 0 := by + have hn := facts.2.1 0; omega + have z1 : (r (1 : Fin 3).succ).1 = 0 := by + have hn := facts.2.1 1; omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim + obtain ⟨i, hi⟩ := hsome + obtain ⟨x, hx⟩ := ih i true hi + exact ⟨x, (hc x).mpr ⟨i, true, hx⟩⟩ + +private theorem qSCells : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (cert.Q 0 false).cells = (cert.S 0 true).cells ) := by + classical + intro q cfg C T cert + calc + _ = cert.O.cells := by rw [cert.precursor_eq] + _ = _ := cert.precursor_cells + +private theorem qSAnchor : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ((cert.Q 0 false).cells = ∅) → ((cert.Q 0 false).anchor = (cert.S 0 true).anchor) + ) := by + classical + intro q cfg C T cert he + have hOempty : cert.O.cells = ∅ := by rw [cert.precursor_eq]; exact he + calc + _ = cert.O.anchor := by + have h := congrArg ProtoTile.anchor cert.precursor_eq + exact h.symm + _ = (cert.S 0 true).anchor := cert.precursor_anchor hOempty + +private theorem uvCells : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin 3), ∀ (s : Bool), (U i s).cells = (cert.Q i s).cells ∧ ((U i s).cells = ∅ + → (U i s).anchor = (cert.Q i s).anchor) ∧ FootprintVertices (U i s) = + FootprintVertices (cert.Q i s)) → ((∀ (i : Fin 3), ∀ (s : Bool), (V i s).cells = + (cert.S i s).cells ∧ ((V i s).cells = ∅ → (V i s).anchor = (cert.S i s).anchor) ∧ + FootprintVertices (V i s) = FootprintVertices (cert.S i s)) → (((cert.Q 0 + false).cells = (cert.S 0 true).cells) → ((U 0 false).cells = (V 0 true).cells))) ) := by + classical + intro q cfg C T cert U V alignA alignB qSCells + calc + _ = (cert.Q 0 false).cells := (alignA 0 false).1 + _ = (cert.S 0 true).cells := qSCells + _ = (V 0 true).cells := (alignB 0 true).1.symm + +private theorem uvAnchor : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin 3), ∀ (s : Bool), (U i s).cells = (cert.Q i s).cells ∧ ((U i s).cells = ∅ + → (U i s).anchor = (cert.Q i s).anchor) ∧ FootprintVertices (U i s) = + FootprintVertices (cert.Q i s)) → ((∀ (i : Fin 3), ∀ (s : Bool), (V i s).cells = + (cert.S i s).cells ∧ ((V i s).cells = ∅ → (V i s).anchor = (cert.S i s).anchor) ∧ + FootprintVertices (V i s) = FootprintVertices (cert.S i s)) → (((cert.Q 0 + false).cells = (cert.S 0 true).cells) → ((((cert.Q 0 false).cells = ∅) → ((cert.Q 0 + false).anchor = (cert.S 0 true).anchor)) → (((U 0 false).cells = ∅) → ((U 0 + false).anchor = (V 0 true).anchor))))) ) := by + classical + intro q cfg C T cert U V alignA alignB qSCells qSAnchor he + have hq : (cert.Q 0 false).cells = ∅ := by + rw [← (alignA 0 false).1] + exact he + have hs : (cert.S 0 true).cells = ∅ := by rw [← qSCells]; exact hq + have hv : (V 0 true).cells = ∅ := by + rw [(alignB 0 true).1] + exact hs + calc + _ = (cert.Q 0 false).anchor := (alignA 0 false).2.1 he + _ = (cert.S 0 true).anchor := qSAnchor hq + _ = (V 0 true).anchor := ((alignB 0 true).2.1 hv).symm + +private theorem zeroOdometerLine : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((∀ (r : Fin 4 → + CircleCoordinates), (ProperBandQuadruple r) → (1 < (r 0).1)) → (∀ + {D : CircleCoordinates}, ∀ {X : ProtoTile}, ∀ {g : PartialOdometer}, (D.1 = 0) → + ((TileOdometer D X g) → (∃ x, X = ⟨∅, x⟩ ∧ g.domain = {x})))) ) := by + classical + intro q cfg properLarge D X g hD hg + cases hg with + | line w x hw g hdom => exact ⟨x, rfl, hdom⟩ + | unit z x Z g hZ hdom htrans => norm_num at hD + | @decompose r hr S Z hs hZ hfoot hcent hdom hvalue hcompat hslope => + have hlarge := properLarge r hr + omega + +private theorem kline : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (U : + Fin (3 : ℕ) → Bool → ProtoTile), ∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i + : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (cfg.firstPredecessor i.succ) (U i s) (k i + s)) → ((∀ {D : CircleCoordinates}, ∀ {X : ProtoTile}, ∀ {g : PartialOdometer}, (D.1 = + 0) → ((TileOdometer D X g) → (∃ x, X = ⟨∅, x⟩ ∧ g.domain = {x}))) → + (((cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → (∃ x, U 0 false = ⟨∅, x⟩ ∧ + (k 0 false).domain = {x}))) ) := by + classical + intro q cfg U k hchildA zeroOdometerLine hzero + exact zeroOdometerLine hzero (hchildA 0 false) + +private theorem lline : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (V : + Fin (3 : ℕ) → Bool → ProtoTile), ∀ (l : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i + : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (cfg.firstPredecessor i.succ) (V i s) (l i + s)) → ((∀ {D : CircleCoordinates}, ∀ {X : ProtoTile}, ∀ {g : PartialOdometer}, (D.1 = + 0) → ((TileOdometer D X g) → (∃ x, X = ⟨∅, x⟩ ∧ g.domain = {x}))) → + (((cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → (∃ x, V 0 true = ⟨∅, x⟩ ∧ + (l 0 true).domain = {x}))) ) := by + classical + intro q cfg V l hchildB zeroOdometerLine hzero + exact zeroOdometerLine hzero (hchildB 0 true) + +private theorem hxy : + (by + classical + exact + ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), (((U 0 + false).cells = ∅) → ((U 0 false).anchor = (V 0 true).anchor)) → (∀ (xk : + GaussianInt), (U (0 : Fin (3 : ℕ)) false = (⟨∅, xk⟩ : ProtoTile)) → (∀ (xl : + GaussianInt), (V (0 : Fin (3 : ℕ)) true = (⟨∅, xl⟩ : ProtoTile)) → (xk = xl))) ) := by + classical + intro U V uvAnchor xk htileK xl htileL + have he : (U 0 false).cells = ∅ := by simp [htileK] + have ha := uvAnchor he + simpa [htileK, htileL] using ha + +private theorem hcurvpos : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + (¬(cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → (0 < (cfg.firstPredecessor + 1).1) ) := by + classical + intro q cfg hzero + have hn := (ProperBandCurvatureStructure cfg.firstPredecessor + cfg.firstProper).2.1 0 + have hn' : 0 ≤ (cfg.firstPredecessor 1).1 := by simpa using hn + omega + +private theorem kSlope : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (h : + Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), PartialOdometerSlope (h i s) = some (s0 + (if s = true then (1 : ℝ) else (-1 : + ℝ)) • P4250T1SlopeOffset (BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 + : Fin (3 : ℕ))).succ)))) → (∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), (cfg.firstPredecessor i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ × ℝ) + (p_i : ℝ × ℝ), PartialOdometerSlope (h (0 : Fin (3 : ℕ)) true) = some p ∧ + PartialOdometerSlope (k i s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin + (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = + true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 + (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin + (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ( + (¬(cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → (PartialOdometerSlope (k 0 + false) = some s0))) ) := by + classical + intro q cfg h s0 hp k hslopeA hzero + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + rcases hslopeA 0 false with hz | hs + · exact (hzero hz).elim + · rcases hs with ⟨p, pi, hp0, hpi, hreal, himag⟩ + have hp0' : p = s0 + P4250T1SlopeOffset alpha := by + have heq : some p = some (s0 + P4250T1SlopeOffset alpha) := by + simpa [alpha, Fin.add_def, cfg.firstParentThree, + cfg.firstParentTwo] using hp0.symm.trans (hp 0 true) + exact Option.some.inj heq + have hpi' : pi = p - P4250T1SlopeOffset alpha := by + apply Prod.ext + · have hreal' : pi.1 - p.1 = + -((alpha.re : Real) - (alpha.im : Real)) / 2 := by + convert hreal using 1; + simp [alpha, cfg.firstParentThree, + cfg.firstParentTwo]; ring + change pi.1 = p.1 - ((alpha.re : Real) - (alpha.im : Real)) / 2 + linarith + · have himag' : pi.2 - p.2 = + -((alpha.im : Real) + (alpha.re : Real)) / 2 := by + convert himag using 1; + simp [alpha, cfg.firstParentThree, + cfg.firstParentTwo]; ring + change pi.2 = p.2 - ((alpha.im : Real) + (alpha.re : Real)) / 2 + linarith + rw [hpi', hp0'] at hpi + simpa using hpi + +private theorem lSlope : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (h : + Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), PartialOdometerSlope (h i s) = some (s0 + (if s = true then (1 : ℝ) else (-1 : + ℝ)) • P4250T1SlopeOffset (BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 + : Fin (3 : ℕ))).succ)))) → (∀ (l : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), (cfg.firstPredecessor i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ × ℝ) + (p_i : ℝ × ℝ), PartialOdometerSlope (h (0 : Fin (3 : ℕ)) false) = some p ∧ + PartialOdometerSlope (l i s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin + (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = + true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 + (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin + (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ( + (¬(cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → (PartialOdometerSlope (l 0 + true) = some s0))) ) := by + classical + intro q cfg h s0 hp l hslopeB hzero + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + rcases hslopeB 0 true with hz | hs + · exact (hzero hz).elim + · rcases hs with ⟨p, pi, hp0, hpi, hreal, himag⟩ + have hp0' : p = s0 - P4250T1SlopeOffset alpha := by + have heq : some p = some (s0 - P4250T1SlopeOffset alpha) := by + simpa [alpha, Fin.add_def, cfg.firstParentThree, + cfg.firstParentTwo, sub_eq_add_neg, smul_eq_mul] using + hp0.symm.trans (hp 0 false) + exact Option.some.inj heq + have hpi' : pi = p + P4250T1SlopeOffset alpha := by + apply Prod.ext + · have hreal' : pi.1 - p.1 = + ((alpha.re : Real) - (alpha.im : Real)) / 2 := by + convert hreal using 1; + simp [alpha, cfg.firstParentThree, + cfg.firstParentTwo]; ring + change pi.1 = p.1 + ((alpha.re : Real) - (alpha.im : Real)) / 2 + linarith + · have himag' : pi.2 - p.2 = + ((alpha.im : Real) + (alpha.re : Real)) / 2 := by + convert himag using 1; + simp [alpha, cfg.firstParentThree, + cfg.firstParentTwo]; ring + change pi.2 = p.2 + ((alpha.im : Real) + (alpha.re : Real)) / 2 + linarith + rw [hpi', hp0'] at hpi + simpa using hpi + +private theorem hneV : + (by + classical + exact + ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), ((U 0 + false).cells = (V 0 true).cells) → (((U 0 false).cells.Nonempty) → ((V 0 + true).cells.Nonempty)) ) := by + classical + intro U V uvCells hneU + rw [← uvCells] + exact hneU + +private theorem hcentShift : + (by + classical + exact + ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (shift : GaussianInt), ((V 0 + true).cells.Nonempty) → (((V 0 true).cells = (TileTranslation (V 0 true) + shift).cells) → (TileCentroid (V 0 true) = TileCentroid (TileTranslation (V 0 true) + shift))) ) := by + classical + intro V shift hneV hcellShift + have hneTrans : + (TileTranslation (V 0 true) shift).cells.Nonempty := by + rw [(TileTranslationFormulas (V 0 true) shift).1] + exact Finset.image_nonempty.mpr hneV + simp [TileCentroid, hneTrans, hcellShift] + +private theorem hshiftRe : + (by + classical + exact + ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (shift : GaussianInt), (TileCentroid (V (0 : + Fin (3 : ℕ)) true) = ((TileCentroid (V (0 : Fin (3 : ℕ)) true)).1 + (↑shift.re : ℝ), + (TileCentroid (V (0 : Fin (3 : ℕ)) true)).2 + (↑shift.im : ℝ))) → ((shift.re : Real) + = 0) ) := by + classical + intro V shift hcentShift + have hh := congrArg Prod.fst hcentShift + dsimp at hh + linarith + +private theorem hshiftIm : + (by + classical + exact + ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (shift : GaussianInt), (TileCentroid (V (0 : + Fin (3 : ℕ)) true) = ((TileCentroid (V (0 : Fin (3 : ℕ)) true)).1 + (↑shift.re : ℝ), + (TileCentroid (V (0 : Fin (3 : ℕ)) true)).2 + (↑shift.im : ℝ))) → ((shift.im : Real) + = 0) ) := by + classical + intro V shift hcentShift + have hh := congrArg Prod.snd hcentShift + dsimp at hh + linarith + +private theorem hshift : + (by + classical + exact + ∀ (shift : GaussianInt), ((shift.re : Real) = 0) → (((shift.im : Real) = 0) → (shift = + 0)) ) := by + classical + intro shift hshiftRe hshiftIm + apply Zsqrtd.ext + · exact_mod_cast hshiftRe + · exact_mod_cast hshiftIm + +private theorem hdomainEq : + (by + classical + exact + ∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (l : Fin (3 : ℕ) → Bool → + PartialOdometer), ∀ (shift : GaussianInt), ∀ (aa : GaussianInt), ∀ (bb : ℤ), (∀ (x : + GaussianInt), x ∈ (k (0 : Fin (3 : ℕ)) false).domain ↔ x - shift ∈ (l (0 : Fin (3 : + ℕ)) true).domain) → ((shift = 0) → ((k 0 false).domain = + (PartialOdometerAffineTranslate (l 0 true) 0 aa bb).domain)) ) := by + classical + intro k l shift aa bb hdomains hshift + ext x + rw [(PartialOdometerAffineTranslateFormulas + (l 0 true) 0 aa bb).2.1] + simpa [hshift] using hdomains x + +private theorem hvalueEq : + (by + classical + exact + ∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (l : Fin (3 : ℕ) → Bool → + PartialOdometer), ∀ (shift : GaussianInt), ∀ (aa : GaussianInt), ∀ (bb : ℤ), (∀ x ∈ + (k (0 : Fin (3 : ℕ)) false).domain, (k (0 : Fin (3 : ℕ)) false).value x = (l (0 : Fin + (3 : ℕ)) true).value (x - shift) + aa.re * x.re + aa.im * x.im + bb) → ((shift = 0) → + (((k 0 false).domain = (PartialOdometerAffineTranslate (l 0 true) 0 aa bb).domain) → + ((k 0 false).value = (PartialOdometerAffineTranslate (l 0 true) 0 aa bb).value))) ) + := by + classical + intro k l shift aa bb hvalues hshift hdomainEq + funext x + by_cases hx : x ∈ (k 0 false).domain + · have hx' : x ∈ + (PartialOdometerAffineTranslate (l 0 true) 0 aa bb).domain := by + rw [← hdomainEq] + exact hx + rw [hvalues x hx, + (PartialOdometerAffineTranslateFormulas + (l 0 true) 0 aa bb).2.2.1 x hx'] + simp [hshift] + · rw [(k 0 false).value_outside x hx, + (PartialOdometerAffineTranslate (l 0 true) 0 aa bb).value_outside x] + intro hx' + apply hx + rw [hdomainEq] + exact hx' + +private theorem heqAt1131 : + (by + classical + exact + ∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (l : Fin (3 : ℕ) → Bool → + PartialOdometer), ∀ (aa : GaussianInt), ∀ (bb : ℤ), ((k 0 false).domain = + (PartialOdometerAffineTranslate (l 0 true) 0 aa bb).domain) → (((k 0 false).value = + (PartialOdometerAffineTranslate (l 0 true) 0 aa bb).value) → (k 0 false = + PartialOdometerAffineTranslate (l 0 true) 0 aa bb)) ) := by + classical + intro k l aa bb hdomainEq hvalueEq + generalize k 0 false = K at hdomainEq hvalueEq ⊢ + cases K + simp only [PartialOdometerAffineTranslate, PartialOdometer.mk.injEq] + exact ⟨hdomainEq, hvalueEq⟩ + +private theorem hslopeEq : + (by + classical + exact + ∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (l : Fin (3 : ℕ) → Bool → + PartialOdometer), ∀ (aa : GaussianInt), ∀ (bb : ℤ), (k 0 false = + PartialOdometerAffineTranslate (l 0 true) 0 aa bb) → (PartialOdometerSlope (k 0 + false) = ((PartialOdometerSlope (l 0 true)).map (fun p => (p.1 + (aa.re : Real), p.2 + + (aa.im : Real))))) ) := by + classical + intro k l aa bb heq + rw [heq, (PartialOdometerAffineTranslateFormulas + (l 0 true) 0 aa bb).2.2.2.2.2] + +private theorem haaRe : + (by + classical + exact + ∀ (s0 : Real × Real), ∀ (aa : GaussianInt), (s0 = (s0.1 + (aa.re : Real), s0.2 + (aa.im : + Real))) → ((aa.re : Real) = 0) ) := by + classical + intro s0 aa hslopePair + have h := congrArg Prod.fst hslopePair + dsimp at h + linarith + +private theorem haaIm : + (by + classical + exact + ∀ (s0 : Real × Real), ∀ (aa : GaussianInt), (s0 = (s0.1 + (aa.re : Real), s0.2 + (aa.im : + Real))) → ((aa.im : Real) = 0) ) := by + classical + intro s0 aa hslopePair + have h := congrArg Prod.snd hslopePair + dsimp at h + linarith + +private theorem haa : + (by + classical + exact + ∀ (aa : GaussianInt), ((aa.re : Real) = 0) → (((aa.im : Real) = 0) → (aa = 0)) ) := by + classical + intro aa haaRe haaIm + apply Zsqrtd.ext + · exact_mod_cast haaRe + · exact_mod_cast haaIm + +private theorem boundaryRaw : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ BoundaryFootprintVertices X) → (x ∈ + FootprintVertices X) ) := by + classical + intro X x hx + by_cases hne : X.cells.Nonempty + · simp only [BoundaryFootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hx + obtain ⟨e, he, hxe⟩ := hx + have hedge : e ∈ FootprintEdges X := by + rcases he with ⟨z, ⟨rfl, hc⟩ | ⟨rfl, hc⟩⟩ + · rcases hc with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - (⟨0, 1⟩ : GaussianInt), hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [Zsqrtd.ext_iff] + · rcases hc with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + rcases hedge with ⟨c, hc, heq⟩ + rcases heq with h | h | h | h <;> subst e + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + · rcases hxe with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ + · rcases hxe with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · rcases hxe with rfl | rfl + · exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ + · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + · rcases hxe with rfl | rfl + · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + · simpa only [BoundaryFootprintVertices, FootprintVertices, ite_eq_right hne] using hx + +private theorem rootBand : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), (BandOrderedGeneralLayoutCertificate q cfg C T) → + (BandPrototile (q 0) T) ) := by + classical + intro q cfg C T cert + apply BandPrototile.decompose cfg.proper + (fun i s => (cert.outer_occurrence i s).1) + · exact cert.outer_union + · intro i s + exact (cert.outer_occurrence i s).2.1 + · intro i s + exact (cert.outer_occurrence i s).2.2 + +private theorem rootNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let A := cert.P 0 true + (1 < (cfg.firstPredecessor 0).1) → ((BandPrototile (cfg.firstPredecessor (0 : Fin (4 : + ℕ))) A) → ((∀ (D : CircleCoordinates), ∀ (X : ProtoTile), BandPrototile D X → 0 < D.1 + → X.cells.Nonempty) → (T.cells.Nonempty))) ) := by + classical + intro q cfg C T cert A hroot hbandA bandPositiveNonempty + obtain ⟨x, hx⟩ := bandPositiveNonempty (cfg.firstPredecessor 0) A + hbandA (by linarith) + exact ⟨x, (cert.outer_union x).2 ⟨0, true, hx⟩⟩ + +private theorem centerIntegral : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), (BandPrototile (q 0) T) → + ((T.cells.Nonempty) → (∃ u : GaussianInt, (2 : Real) • TileCentroid T = + GaussianRealPoint u)) ) := by + classical + intro q T rootBand rootNonempty + let c := TileCentroid T + let reCells : Finset Int := T.cells.image (fun x => x.re) + let imCells : Finset Int := T.cells.image (fun x => x.im) + have reNe : reCells.Nonempty := Finset.image_nonempty.mpr rootNonempty + have imNe : imCells.Nonempty := Finset.image_nonempty.mpr rootNonempty + have hcentral : CentrallyReflectedAt c T T := + by simpa [c] using BandPrototileCentralSymmetry (q 0) T rootBand + have reflect_mem : ∀ p ∈ TileRealization T, + (2 * c.1 - p.1, 2 * c.2 - p.2) ∈ TileRealization T := by + intro p hp + rw [hcentral] + exact ⟨p, hp, rfl⟩ + have hboundRe : ∀ p ∈ TileRealization T, + (↑(reCells.min' reNe) : Real) ≤ p.1 ∧ + p.1 ≤ (↑(reCells.max' reNe) : Real) + 1 := by + intro p hp + simp only [TileRealization, Set.mem_iUnion] at hp + rcases hp with ⟨x, hx, hpx⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpx + constructor + · have hm := Finset.min'_le reCells x.re + (Finset.mem_image.mpr ⟨x, hx, rfl⟩) + exact le_trans (by exact_mod_cast hm) hpx.1.1 + · have hm := Finset.le_max' reCells x.re + (Finset.mem_image.mpr ⟨x, hx, rfl⟩) + have hm' : (x.re : Real) ≤ (reCells.max' reNe : Real) := by + exact_mod_cast hm + linarith [hpx.2.1, hm'] + have hboundIm : ∀ p ∈ TileRealization T, + (imCells.min' imNe : Real) ≤ p.2 ∧ + p.2 ≤ (imCells.max' imNe : Real) + 1 := by + intro p hp + simp only [TileRealization, Set.mem_iUnion] at hp + rcases hp with ⟨x, hx, hpx⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpx + constructor + · exact le_trans (Int.cast_le.mpr (Finset.min'_le imCells x.im + (Finset.mem_image.mpr ⟨x, hx, rfl⟩))) hpx.1.2 + · have hm := Finset.le_max' imCells x.im + (Finset.mem_image.mpr ⟨x, hx, rfl⟩) + have hm' : (x.im : Real) ≤ (imCells.max' imNe : Real) := by + exact_mod_cast hm + linarith [hpx.2.2, hm'] + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + have centerRe : 2 * c.1 = (reCells.min' reNe : Real) + + reCells.max' reNe + 1 := by + have hmin : ∃ x, x ∈ T.cells ∧ x.re = reCells.min' reNe := by + rcases Finset.mem_image.mp (Finset.min'_mem reCells reNe) with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + have hmax : ∃ x, x ∈ T.cells ∧ x.re = reCells.max' reNe := by + rcases Finset.mem_image.mp (Finset.max'_mem reCells reNe) with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + obtain ⟨xmin, hxmin, hxminre⟩ := hmin + obtain ⟨xmax, hmax, hmaxre⟩ := hmax + have pmin : ((reCells.min' reNe : Real), (xmin.im : Real)) ∈ + TileRealization T := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmin, hxmin, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + exact ⟨⟨by simp [hxminre], by simp []⟩, + ⟨by simp [hxminre], by simp⟩⟩ + have pmax : (((reCells.max' reNe : Int) : Real) + 1, + (xmax.im : Real)) ∈ TileRealization T := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmax, hmax, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + exact ⟨⟨by simp [hmaxre], by simp⟩, + ⟨by simp [hmaxre], by simp⟩⟩ + have bmin := hboundRe _ (reflect_mem _ pmin) + have bmax := hboundRe _ (reflect_mem _ pmax) + dsimp at bmin bmax + norm_num at bmin bmax ⊢ + linarith + have centerIm : 2 * c.2 = (mIm : Real) + MIm + 1 := by + have hmin : ∃ x, x ∈ T.cells ∧ x.im = mIm := by + rcases Finset.mem_image.mp (Finset.min'_mem imCells imNe) with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + have hmax : ∃ x, x ∈ T.cells ∧ x.im = MIm := by + rcases Finset.mem_image.mp (Finset.max'_mem imCells imNe) with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + obtain ⟨xmin, hxmin, hxminim⟩ := hmin + obtain ⟨xmax, hmax, hmaxim⟩ := hmax + have pmin : ((xmin.re : Real), (mIm : Real)) ∈ TileRealization T := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmin, hxmin, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + refine ⟨⟨by simp, ?_⟩, ⟨by simp, ?_⟩⟩ + · simp [hxminim] + · simp [hxminim] + have pmax : ((xmax.re : Real), (MIm : Real) + 1) ∈ + TileRealization T := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmax, hmax, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + refine ⟨⟨by simp, ?_⟩, ⟨by simp, ?_⟩⟩ + · simp [hmaxim] + · simp [hmaxim] + have bmin := hboundIm _ (reflect_mem _ pmin) + have bmax := hboundIm _ (reflect_mem _ pmax) + dsimp at bmin bmax + norm_num at bmin bmax ⊢ + linarith + refine ⟨⟨reCells.min' reNe + reCells.max' reNe + 1, + mIm + MIm + 1⟩, ?_⟩ + apply Prod.ext <;> simp [GaussianRealPoint] <;> + linarith [centerRe, centerIm] + +private theorem reflectedFoot : + (by + classical + exact + ∀ (T : ProtoTile), (∀ (D : CircleCoordinates), ∀ (X : ProtoTile), BandPrototile D X → 0 < + D.1 → X.cells.Nonempty) → (∀ (u : GaussianInt), ((2 : ℝ) • TileCentroid T = + GaussianRealPoint u) → (∀ (D : CircleCoordinates), ∀ (X : ProtoTile), ∀ (Y : + ProtoTile), ∀ (g : PartialOdometer), (TileOdometer D X g) → ((BandPrototile D Y) → + ((0 < D.1) → ((TileCentroid X + TileCentroid Y = + (2 : Real) • TileCentroid T) → (FootprintVertices (TileTranslation (TileHalfTurn X) + u) = FootprintVertices Y)))))) ) := by + classical + intro T bandPositiveNonempty u hu D X Y g hX hY hD hsum + let Z := TileTranslation (TileHalfTurn X) u + have hhalf := (TileOdometerCentralSymmetry D X g hX).1 + have hZodo : TileOdometer D Z + (PartialOdometerAffineTranslate (PartialOdometerHalfTurn g) u 0 0) := + TileOdometerAffineTranslation D (TileHalfTurn X) + (PartialOdometerHalfTurn g) u 0 0 hhalf + have hZband : BandPrototile D Z := + TileOdometerBandPrototile D Z _ hZodo + have hcent : TileCentroid Z = TileCentroid Y := by + rw [(TileTranslationFormulas (TileHalfTurn X) u).2.2.2.2.1, + (TileHalfTurnFormulas X).2.2.2.2.2.2.2.1] + have huRe := congrArg Prod.fst hu + have huIm := congrArg Prod.snd hu + have hsRe := congrArg Prod.fst hsum + have hsIm := congrArg Prod.snd hsum + dsimp [GaussianRealPoint] at huRe huIm + dsimp at hsRe hsIm + apply Prod.ext <;> dsimp <;> linarith + have hcells := (BandPrototileCentroidUnique D Z Y hZband hY hcent).1 + have hXne := bandPositiveNonempty D X + (TileOdometerBandPrototile D X g hX) hD + have hYne := bandPositiveNonempty D Y hY hD + have hZne : Z.cells.Nonempty := by + dsimp [Z] + rw [(TileTranslationFormulas (TileHalfTurn X) u).1] + apply Finset.image_nonempty.mpr + have he : (TileHalfTurn X).cells ≠ ∅ := by + intro h + exact (Finset.nonempty_iff_ne_empty.mp hXne) + ((TileHalfTurnFormulas X).2.2.1.mp h) + exact Finset.nonempty_iff_ne_empty.mpr he + simp only [Z, FootprintVertices, ite_eq_left hYne, hcells] + +private theorem hsumAB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let A := cert.P 0 true + let B := cert.P 0 false + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (TileCentroid A - TileCentroid T = spatial w) → ((TileCentroid B - TileCentroid T = + -spatial w) → (TileCentroid A + TileCentroid B = (2 : Real) • TileCentroid T)) ) := by + classical + intro q cfg C T cert A B w spatial hcenterA hcenterB + have hr := congrArg Prod.fst hcenterA + have hi := congrArg Prod.snd hcenterA + have hr' := congrArg Prod.fst hcenterB + have hi' := congrArg Prod.snd hcenterB + apply Prod.ext <;> dsimp at hr hi hr' hi' ⊢ <;> linarith + +private theorem hsumCD : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let v13 : GaussianInt := BandVectors.1 (q 1) (q 3) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (TileCentroid (cert.P 1 true) - TileCentroid T = spatial v13) → ((TileCentroid (cert.P 1 + false) - TileCentroid T = -spatial v13) → (TileCentroid (cert.P 1 true) + + TileCentroid (cert.P 1 false) = (2 : Real) • TileCentroid T)) ) := by + classical + intro q cfg C T cert v13 spatial hcenterP hcenterPminus + have hr := congrArg Prod.fst hcenterP + have hi := congrArg Prod.snd hcenterP + have hr' := congrArg Prod.fst hcenterPminus + have hi' := congrArg Prod.snd hcenterPminus + apply Prod.ext <;> dsimp at hr hi hr' hi' ⊢ <;> linarith + +private theorem hcenterSTAt1375 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let B := cert.P 0 false + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let xv : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (TileCentroid B - TileCentroid T = -spatial w) → ((TileCentroid (cert.S 1 false) - + TileCentroid B = -spatial xv) → (TileCentroid (cert.S 1 false) - TileCentroid T = + -spatial xv - spatial w)) ) := by + classical + intro q cfg C T cert B w xv spatial hcenterB hcenterS + calc + _ = (TileCentroid (cert.S 1 false) - TileCentroid B) + + (TileCentroid B - TileCentroid T) := by ext <;> dsimp <;> ring + _ = _ := by rw [hcenterS, hcenterB]; rfl + +private theorem hsumQS : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let xv : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (TileCentroid (cert.Q 1 true) - TileCentroid T = spatial xv + spatial w) → ((TileCentroid + (cert.S 1 false) - TileCentroid T = -spatial xv - spatial w) → (TileCentroid (cert.Q + 1 true) + TileCentroid (cert.S 1 false) = (2 : Real) • TileCentroid T)) ) := by + classical + intro q cfg C T cert w xv spatial hcenterQT hcenterST + have hr := congrArg Prod.fst hcenterQT + have hi := congrArg Prod.snd hcenterQT + have hr' := congrArg Prod.fst hcenterST + have hi' := congrArg Prod.snd hcenterST + apply Prod.ext <;> dsimp at hr hi hr' hi' ⊢ <;> linarith + +private theorem reflectedSet : + (by + classical + exact + ∀ (u : GaussianInt), + let refl : GaussianInt → GaussianInt := fun x => GaussianTranslation u (-x) + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (FootprintVertices (TileTranslation (TileHalfTurn + X) u) = + FootprintVertices Y) → (FootprintVertices Y = refl '' FootprintVertices X) ) := by + classical + intro u refl X Y hX + calc + FootprintVertices Y = + FootprintVertices (TileTranslation (TileHalfTurn X) u) := hX.symm + _ = GaussianTranslation u '' FootprintVertices (TileHalfTurn X) := + (TileTranslationFormulas (TileHalfTurn X) u).2.2.2.2.2.1 + _ = GaussianTranslation u '' ((fun x : GaussianInt => -x) '' + FootprintVertices X) := by rw [(TileHalfTurnFormulas X).2.2.2.2.2.2.1] + _ = refl '' FootprintVertices X := by + rw [Set.image_image] + +private theorem reflInjective : + (by + classical + exact + ∀ (u : GaussianInt), + let refl : GaussianInt → GaussianInt := fun x => GaussianTranslation u (-x) + Function.Injective refl ) := by + classical + intro u refl x y hxy + have hneg : -x = -y := by + have := congrArg (fun z : GaussianInt => z - u) hxy + simpa [refl, GaussianTranslation, sub_eq_add_neg, add_assoc] using this + exact neg_injective hneg + +private theorem hrawBD : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let A := cert.P 0 true + let B := cert.P 0 false + (FootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.P (1 : Fin + (3 : ℕ)) true) ⊆ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∩ + FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true)) → (∀ (u : GaussianInt), + let refl : GaussianInt → GaussianInt := fun x => GaussianTranslation u (-x) + (FootprintVertices B = refl '' FootprintVertices A) → ((FootprintVertices (cert.P (1 : + Fin (3 : ℕ)) false) = refl '' FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true)) → + ((FootprintVertices (cert.S (1 : Fin (3 : ℕ)) false) = refl '' FootprintVertices + (cert.Q (1 : Fin (3 : ℕ)) true)) → ((Function.Injective refl) → (FootprintVertices B + ∩ FootprintVertices (cert.P 1 false) ⊆ FootprintVertices (cert.S 1 false) ∩ + FootprintVertices (cert.P 1 false)))))) ) := by + classical + intro q cfg C T cert A B hrawAC u refl reflectedA reflectedC reflectedQ reflInjective x hx + have hxA : x ∈ refl '' FootprintVertices A := by + rw [← reflectedA] + exact hx.1 + have hxC : x ∈ refl '' FootprintVertices (cert.P 1 true) := by + rw [← reflectedC] + exact hx.2 + obtain ⟨a, haA, hax⟩ := hxA + obtain ⟨c, hcC, hcx⟩ := hxC + have hac : a = c := reflInjective (hax.trans hcx.symm) + subst c + have hAC := hrawAC ⟨haA, hcC⟩ + have hxS : x ∈ FootprintVertices (cert.S 1 false) := by + rw [reflectedQ] + exact ⟨a, hAC.1, hax⟩ + exact ⟨hxS, hx.2⟩ + +private theorem oFootU : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), (U i + s).cells = (cert.Q i s).cells ∧ ((U i s).cells = ∅ → (U i s).anchor = (cert.Q i + s).anchor) ∧ FootprintVertices (U i s) = FootprintVertices (cert.Q i s)) → + (FootprintVertices cert.O = FootprintVertices (U 0 false)) ) := by + classical + intro q cfg C T cert U alignA + rw [cert.precursor_eq] + exact (alignA 0 false).2.2.symm + +private theorem oFootV : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), (V i + s).cells = (cert.S i s).cells ∧ ((V i s).cells = ∅ → (V i s).anchor = (cert.S i + s).anchor) ∧ FootprintVertices (V i s) = FootprintVertices (cert.S i s)) → (((cert.Q + 0 false).cells = (cert.S 0 true).cells) → ((((cert.Q 0 false).cells = ∅) → ((cert.Q 0 + false).anchor = (cert.S 0 true).anchor)) → (FootprintVertices cert.O = + FootprintVertices (V 0 true)))) ) := by + classical + intro q cfg C T cert V alignB qSCells qSAnchor + have hobs := ProtoTileObservableExtensionality + (cert.Q 0 false) (cert.S 0 true) qSCells qSAnchor + rw [cert.precursor_eq] + exact hobs.1.trans ((alignB 0 true).2.2.symm) + +private theorem hxLK : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), ((k 1 true).domain = + FootprintVertices (cert.Q 1 true)) → ((∀ (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ + BoundaryFootprintVertices X) → (x ∈ FootprintVertices X)) → (∀ (xL : GaussianInt), + (xL ∈ BoundaryFootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true)) → (xL ∈ ((k 1 + true).domain : Set GaussianInt)))) ) := by + classical + intro q cfg C T cert k hdomQ boundaryRaw xL hxLQ + rw [hdomQ] + exact boundaryRaw _ _ hxLQ + +private theorem hxLS3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (l : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (X : ProtoTile), ∀ (x : + GaussianInt), (x ∈ BoundaryFootprintVertices X) → (x ∈ FootprintVertices X)) → (((l 2 + false).domain = FootprintVertices (cert.S 2 false)) → (∀ (xL : GaussianInt), (xL ∈ + BoundaryFootprintVertices (cert.S (2 : Fin (3 : ℕ)) false)) → (xL ∈ ((l 2 + false).domain : Set GaussianInt)))) ) := by + classical + intro q cfg C T cert l boundaryRaw hdomS3 xL hxLS + rw [hdomS3] + exact boundaryRaw _ _ hxLS + +private theorem hxLK0 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (k : Fin (3 : ℕ) → Bool → + PartialOdometer), ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (l : Fin (3 : ℕ) → Bool → + PartialOdometer), (((k 0 false).domain : Set GaussianInt) = FootprintVertices (U 0 + false) ∧ ((l 0 true).domain : Set GaussianInt) = FootprintVertices (V 0 true) ∧ ((k 0 + false).domain : Set GaussianInt) = ((l 0 true).domain : Set GaussianInt) ∧ ∃ c : Int, + ∀ x, x ∈ (k 0 false).domain → x ∈ (l 0 true).domain → (l 0 true).value x - (k 0 + false).value x = c) → ((∀ (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ + BoundaryFootprintVertices X) → (x ∈ FootprintVertices X)) → ((FootprintVertices + cert.O = FootprintVertices (U 0 false)) → (∀ (xL : GaussianInt), (xL ∈ + BoundaryFootprintVertices cert.O) → (xL ∈ ((k 0 false).domain : Set GaussianInt))))) + ) := by + classical + intro q cfg C T cert U k V l precursorConstant boundaryRaw oFootU xL hxLO + rw [precursorConstant.1] + rw [← oFootU] + exact boundaryRaw _ _ hxLO + +private theorem hxLL0 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (k : Fin (3 : ℕ) → Bool → + PartialOdometer), ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (l : Fin (3 : ℕ) → Bool → + PartialOdometer), (((k 0 false).domain : Set GaussianInt) = FootprintVertices (U 0 + false) ∧ ((l 0 true).domain : Set GaussianInt) = FootprintVertices (V 0 true) ∧ ((k 0 + false).domain : Set GaussianInt) = ((l 0 true).domain : Set GaussianInt) ∧ ∃ c : Int, + ∀ x, x ∈ (k 0 false).domain → x ∈ (l 0 true).domain → (l 0 true).value x - (k 0 + false).value x = c) → ((∀ (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ + BoundaryFootprintVertices X) → (x ∈ FootprintVertices X)) → ((FootprintVertices + cert.O = FootprintVertices (V 0 true)) → (∀ (xL : GaussianInt), (xL ∈ + BoundaryFootprintVertices cert.O) → (xL ∈ ((l 0 true).domain : Set GaussianInt))))) ) + := by + classical + intro q cfg C T cert U k V l precursorConstant boundaryRaw oFootV xL hxLO + rw [precursorConstant.2.1] + rw [← oFootV] + exact boundaryRaw _ _ hxLO + +private theorem hxRK3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (X : ProtoTile), ∀ (x : + GaussianInt), (x ∈ BoundaryFootprintVertices X) → (x ∈ FootprintVertices X)) → (((k 2 + true).domain = FootprintVertices (cert.Q 2 true)) → (∀ (xR : GaussianInt), (xR ∈ + BoundaryFootprintVertices (cert.Q (2 : Fin (3 : ℕ)) true)) → (xR ∈ ((k 2 true).domain + : Set GaussianInt)))) ) := by + classical + intro q cfg C T cert k boundaryRaw hdomQ3 xR hxRQ + rw [hdomQ3] + exact boundaryRaw _ _ hxRQ + +private theorem hxRS2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (l : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (X : ProtoTile), ∀ (x : + GaussianInt), (x ∈ BoundaryFootprintVertices X) → (x ∈ FootprintVertices X)) → (((l 1 + false).domain = FootprintVertices (cert.S 1 false)) → (∀ (xR : GaussianInt), (xR ∈ + BoundaryFootprintVertices (cert.S (1 : Fin (3 : ℕ)) false)) → (xR ∈ ((l 1 + false).domain : Set GaussianInt)))) ) := by + classical + intro q cfg C T cert l boundaryRaw hdomS2 xR hxRS + rw [hdomS2] + exact boundaryRaw _ _ hxRS + +private theorem hxRK0 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (k : Fin (3 : ℕ) → Bool → + PartialOdometer), ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (l : Fin (3 : ℕ) → Bool → + PartialOdometer), (((k 0 false).domain : Set GaussianInt) = FootprintVertices (U 0 + false) ∧ ((l 0 true).domain : Set GaussianInt) = FootprintVertices (V 0 true) ∧ ((k 0 + false).domain : Set GaussianInt) = ((l 0 true).domain : Set GaussianInt) ∧ ∃ c : Int, + ∀ x, x ∈ (k 0 false).domain → x ∈ (l 0 true).domain → (l 0 true).value x - (k 0 + false).value x = c) → ((∀ (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ + BoundaryFootprintVertices X) → (x ∈ FootprintVertices X)) → ((FootprintVertices + cert.O = FootprintVertices (U 0 false)) → (∀ (xR : GaussianInt), (xR ∈ + BoundaryFootprintVertices cert.O) → (xR ∈ ((k 0 false).domain : Set GaussianInt))))) + ) := by + classical + intro q cfg C T cert U k V l precursorConstant boundaryRaw oFootU xR hxRO + rw [precursorConstant.1] + rw [← oFootU] + exact boundaryRaw _ _ hxRO + +private theorem hxRL0 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (k : Fin (3 : ℕ) → Bool → + PartialOdometer), ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (l : Fin (3 : ℕ) → Bool → + PartialOdometer), (((k 0 false).domain : Set GaussianInt) = FootprintVertices (U 0 + false) ∧ ((l 0 true).domain : Set GaussianInt) = FootprintVertices (V 0 true) ∧ ((k 0 + false).domain : Set GaussianInt) = ((l 0 true).domain : Set GaussianInt) ∧ ∃ c : Int, + ∀ x, x ∈ (k 0 false).domain → x ∈ (l 0 true).domain → (l 0 true).value x - (k 0 + false).value x = c) → ((∀ (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ + BoundaryFootprintVertices X) → (x ∈ FootprintVertices X)) → ((FootprintVertices + cert.O = FootprintVertices (V 0 true)) → (∀ (xR : GaussianInt), (xR ∈ + BoundaryFootprintVertices cert.O) → (xR ∈ ((l 0 true).domain : Set GaussianInt))))) ) + := by + classical + intro q cfg C T cert U k V l precursorConstant boundaryRaw oFootV xR hxRO + rw [precursorConstant.2.1] + rw [← oFootV] + exact boundaryRaw _ _ hxRO + +private theorem crossOneConstant : + (by + classical + exact + ∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (l : Fin (3 : ℕ) → Bool → + PartialOdometer), (OdometerCompatibility (k 1 true) (l 2 false)) → (∀ (xL : + GaussianInt), (xL ∈ ((k 1 true).domain : Set GaussianInt)) → ((xL ∈ ((l 2 + false).domain : Set GaussianInt)) → (∃ c : Int, ∀ x, x ∈ (k 1 true).domain → x ∈ (l 2 + false).domain → (l 2 false).value x - (k 1 true).value x = c))) ) := by + classical + intro k l compatCross1 xL hxLK hxLS3 + rcases compatCross1 with hdis | hconst + · exact False.elim ((Set.disjoint_left.mp hdis) hxLK hxLS3) + · exact hconst + +private theorem crossTwoConstant : + (by + classical + exact + ∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (l : Fin (3 : ℕ) → Bool → + PartialOdometer), (OdometerCompatibility (l 1 false) (k 2 true)) → (∀ (xR : + GaussianInt), (xR ∈ ((k 2 true).domain : Set GaussianInt)) → ((xR ∈ ((l 1 + false).domain : Set GaussianInt)) → (∃ c : Int, ∀ x, x ∈ (l 1 false).domain → x ∈ (k + 2 true).domain → (k 2 true).value x - (l 1 false).value x = c))) ) := by + classical + intro k l compatCross2 xR hxRK3 hxRS2 + rcases compatCross2 with hdis | hconst + · exact False.elim ((Set.disjoint_left.mp hdis) hxRS2 hxRK3) + · exact hconst + +private theorem hleftCal : + (by + classical + exact + ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (k i s).domain, (h (0 : Fin (3 : ℕ)) + true).value x = (k i s).value x) → (∀ (l : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (l i s).domain, (h (0 : Fin (3 : ℕ)) + false).value x = (l i s).value x) → (∀ (cO : ℤ), (∀ x ∈ (k (0 : Fin (3 : ℕ)) + false).domain, x ∈ (l (0 : Fin (3 : ℕ)) true).domain → (l (0 : Fin (3 : ℕ)) + true).value x - (k (0 : Fin (3 : ℕ)) false).value x = cO) → (∀ (xL : GaussianInt), + (xL ∈ ((k 1 true).domain : Set GaussianInt)) → ((xL ∈ ((l 2 false).domain : Set + GaussianInt)) → ((xL ∈ ((k 0 false).domain : Set GaussianInt)) → ((xL ∈ ((l 0 + true).domain : Set GaussianInt)) → (∀ (cL : ℤ), (∀ x ∈ (k (1 : Fin (3 : ℕ)) + true).domain, x ∈ (l (2 : Fin (3 : ℕ)) false).domain → (l (2 : Fin (3 : ℕ)) + false).value x - (k (1 : Fin (3 : ℕ)) true).value x = cL) → (cL = cO)))))))) ) := by + classical + intro h k hvalueA l hvalueB cO hcO xL hxLK hxLS3 hxLK0 hxLL0 cL hcL + have hcross := hcL xL hxLK hxLS3 + have hprec := hcO xL hxLK0 hxLL0 + have hvA := hvalueA 1 true xL hxLK + have hvB := hvalueB 2 false xL hxLS3 + have hvA0 := hvalueA 0 false xL hxLK0 + have hvB0 := hvalueB 0 true xL hxLL0 + rw [← hvB, ← hvA] at hcross + rw [← hvB0, ← hvA0] at hprec + linarith + +private theorem hrightCal : + (by + classical + exact + ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (k i s).domain, (h (0 : Fin (3 : ℕ)) + true).value x = (k i s).value x) → (∀ (l : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (l i s).domain, (h (0 : Fin (3 : ℕ)) + false).value x = (l i s).value x) → (∀ (cO : ℤ), (∀ x ∈ (k (0 : Fin (3 : ℕ)) + false).domain, x ∈ (l (0 : Fin (3 : ℕ)) true).domain → (l (0 : Fin (3 : ℕ)) + true).value x - (k (0 : Fin (3 : ℕ)) false).value x = cO) → (∀ (xR : GaussianInt), + (xR ∈ ((k 2 true).domain : Set GaussianInt)) → ((xR ∈ ((l 1 false).domain : Set + GaussianInt)) → ((xR ∈ ((k 0 false).domain : Set GaussianInt)) → ((xR ∈ ((l 0 + true).domain : Set GaussianInt)) → (∀ (cR : ℤ), (∀ x ∈ (l (1 : Fin (3 : ℕ)) + false).domain, x ∈ (k (2 : Fin (3 : ℕ)) true).domain → (k (2 : Fin (3 : ℕ)) + true).value x - (l (1 : Fin (3 : ℕ)) false).value x = cR) → (cR = -cO)))))))) ) := by + classical + intro h k hvalueA l hvalueB cO hcO xR hxRK3 hxRS2 hxRK0 hxRL0 cR hcR + have hcross := hcR xR hxRS2 hxRK3 + have hprec := hcO xR hxRK0 hxRL0 + have hvB := hvalueB 1 false xR hxRS2 + have hvA := hvalueA 2 true xR hxRK3 + have hvA0 := hvalueA 0 false xR hxRK0 + have hvB0 := hvalueB 0 true xR hxRL0 + rw [← hvA, ← hvB] at hcross + rw [← hvB0, ← hvA0] at hprec + linarith + +private theorem compatAB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), + let A := cert.P 0 true + let B := cert.P 0 false + ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (k : Fin (3 : ℕ) → Bool → PartialOdometer), ((h + 0 true).domain = FootprintVertices A) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (k + i s).domain, (h (0 : Fin (3 : ℕ)) true).value x = (k i s).value x) → (∀ (V : Fin (3 : + ℕ) → Bool → ProtoTile), ∀ (l : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 + : ℕ)), ∀ (s : Bool), ∀ x ∈ (l i s).domain, (h (0 : Fin (3 : ℕ)) false).value x = (l i + s).value x) → ((∀ (i : Fin 3), ∀ (s : Bool), (U i s).cells = (cert.Q i s).cells ∧ ((U + i s).cells = ∅ → (U i s).anchor = (cert.Q i s).anchor) ∧ FootprintVertices (U i s) = + FootprintVertices (cert.Q i s)) → (((h 0 false).domain = FootprintVertices B) → (((k + 1 true).domain = FootprintVertices (cert.Q 1 true)) → ((FootprintVertices (cert.P (0 + : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.P (0 : Fin (3 : ℕ)) false) ⊆ + FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.S (2 : + Fin (3 : ℕ)) false) ∪ FootprintVertices (cert.Q (0 : Fin (3 : ℕ)) false) ∪ + FootprintVertices (cert.Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.S (1 : + Fin (3 : ℕ)) false)) → ((∀ {V : Type}, ∀ (f : V → Int), ∀ (g : V → Int), ∀ (L : Set + V), ∀ (O : Set V), ∀ (R : Set V), ∀ (Iset : Set V), ∀ (c : Int), ∀ (d : Int), ∀ (e : + Int), ∀ (xL : V), ∀ (xR : V), (Iset ⊆ L ∪ O ∪ R) → ((∀ x ∈ L, g x - f x = d) → ((∀ x + ∈ O, g x - f x = c) → ((∀ x ∈ R, f x - g x = e) → ((xL ∈ L ∩ O) → ((xR ∈ R ∩ O) → (∀ + x ∈ Iset, g x - f x = c))))))) → ((((k 0 false).domain : Set GaussianInt) = + FootprintVertices (U 0 false) ∧ ((l 0 true).domain : Set GaussianInt) = + FootprintVertices (V 0 true) ∧ ((k 0 false).domain : Set GaussianInt) = ((l 0 + true).domain : Set GaussianInt) ∧ ∃ c : Int, ∀ x, x ∈ (k 0 false).domain → x ∈ (l 0 + true).domain → (l 0 true).value x - (k 0 false).value x = c) → (((l 2 false).domain = + FootprintVertices (cert.S 2 false)) → (((l 1 false).domain = FootprintVertices + (cert.S 1 false)) → (((k 2 true).domain = FootprintVertices (cert.Q 2 true)) → (∀ (cO + : ℤ), (∀ x ∈ (k (0 : Fin (3 : ℕ)) false).domain, x ∈ (l (0 : Fin (3 : ℕ)) + true).domain → (l (0 : Fin (3 : ℕ)) true).value x - (k (0 : Fin (3 : ℕ)) false).value + x = cO) → (∀ (xL : GaussianInt), ∀ (xR : GaussianInt), (xL ∈ ((k 1 true).domain : Set + GaussianInt)) → ((xL ∈ ((l 2 false).domain : Set GaussianInt)) → ((xL ∈ ((k 0 + false).domain : Set GaussianInt)) → ((xR ∈ ((k 2 true).domain : Set GaussianInt)) → + ((xR ∈ ((l 1 false).domain : Set GaussianInt)) → ((xR ∈ ((k 0 false).domain : Set + GaussianInt)) → (∀ (cL : ℤ), (∀ x ∈ (k (1 : Fin (3 : ℕ)) true).domain, x ∈ (l (2 : + Fin (3 : ℕ)) false).domain → (l (2 : Fin (3 : ℕ)) false).value x - (k (1 : Fin (3 : + ℕ)) true).value x = cL) → (∀ (cR : ℤ), (∀ x ∈ (l (1 : Fin (3 : ℕ)) false).domain, x ∈ + (k (2 : Fin (3 : ℕ)) true).domain → (k (2 : Fin (3 : ℕ)) true).value x - (l (1 : Fin + (3 : ℕ)) false).value x = cR) → ((cL = cO) → ((cR = -cO) → (OdometerCompatibility (h + 0 true) (h 0 false)))))))))))))))))))))))) ) := by + classical + intro q cfg C T cert h A B U k hdomA hvalueA V l hvalueB alignA hdomBParent hdomQ hrawAB + propagateConstant precursorConstant hdomS3 hdomS2 hdomQ3 cO hcO xL xR hxLK hxLS3 hxLK0 + hxRK3 hxRS2 hxRK0 cL hcL cR hcR hleftCal hrightCal + right + refine ⟨cO, ?_⟩ + intro x hxA hxB + have hxraw : x ∈ FootprintVertices A ∩ FootprintVertices B := by + exact ⟨by rw [← hdomA]; exact hxA, + by rw [← hdomBParent]; exact hxB⟩ + have hcover : + (↑(h 0 true).domain ∩ ↑(h 0 false).domain : Set GaussianInt) ⊆ + (↑(k 1 true).domain ∩ ↑(l 2 false).domain) ∪ + ↑(k 0 false).domain ∪ + (↑(k 2 true).domain ∩ ↑(l 1 false).domain) := by + intro y hy + have hrawY : y ∈ FootprintVertices A ∩ FootprintVertices B := by + exact ⟨by simpa only [hdomA] using hy.1, + by simpa only [hdomBParent] using hy.2⟩ + have hraw := hrawAB hrawY + change y ∈ (FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.S 2 false)) ∪ FootprintVertices (cert.Q 0 false) ∪ + (FootprintVertices (cert.Q 2 true) ∩ + FootprintVertices (cert.S 1 false)) at hraw + simp only [Set.mem_union, Set.mem_inter_iff] at hraw + rcases hraw with (⟨hLQ, hLS⟩ | hO) | ⟨hRQ, hRS⟩ + · exact Or.inl (Or.inl ⟨by rw [hdomQ]; exact hLQ, + by rw [hdomS3]; exact hLS⟩) + · exact Or.inl (Or.inr (by + have hO' : y ∈ FootprintVertices (U 0 false) := by + rw [(alignA 0 false).2.2] + exact hO + rw [precursorConstant.1] + exact hO')) + · exact Or.inr ⟨by rw [hdomQ3]; exact hRQ, + by rw [hdomS2]; exact hRS⟩ + have hleft : ∀ y, y ∈ ((k 1 true).domain : Set GaussianInt) ∩ + ((l 2 false).domain : Set GaussianInt) → + (h 0 false).value y - (h 0 true).value y = cO := by + intro y hy + have hval := hcL y hy.1 hy.2 + have hvA := hvalueA 1 true y hy.1 + have hvB := hvalueB 2 false y hy.2 + rw [← hvB, ← hvA] at hval + simpa [hleftCal] using hval + have hmiddle : ∀ y, y ∈ ((k 0 false).domain : Set GaussianInt) → + (h 0 false).value y - (h 0 true).value y = cO := by + intro y hy + have hyL : y ∈ ((l 0 true).domain : Set GaussianInt) := by + rw [← precursorConstant.2.2.1] + exact hy + have hval := hcO y hy hyL + have hvA := hvalueA 0 false y hy + have hvB := hvalueB 0 true y hyL + rw [← hvB, ← hvA] at hval + exact hval + have hright : ∀ y, y ∈ ((k 2 true).domain : Set GaussianInt) ∩ + ((l 1 false).domain : Set GaussianInt) → + (h 0 true).value y - (h 0 false).value y = -cO := by + intro y hy + have hval := hcR y hy.2 hy.1 + have hvA := hvalueA 2 true y hy.1 + have hvB := hvalueB 1 false y hy.2 + rw [← hvA, ← hvB] at hval + simpa [hrightCal] using hval + have hxLinter : xL ∈ (((k 1 true).domain : Set GaussianInt) ∩ + ((l 2 false).domain : Set GaussianInt)) ∩ + ((k 0 false).domain : Set GaussianInt) := ⟨⟨hxLK, hxLS3⟩, hxLK0⟩ + have hxRinter : xR ∈ (((k 2 true).domain : Set GaussianInt) ∩ + ((l 1 false).domain : Set GaussianInt)) ∩ + ((k 0 false).domain : Set GaussianInt) := ⟨⟨hxRK3, hxRS2⟩, hxRK0⟩ + have hprop := propagateConstant + (h 0 true).value (h 0 false).value + (↑(k 1 true).domain ∩ ↑(l 2 false).domain) + (↑(k 0 false).domain) + (↑(k 2 true).domain ∩ ↑(l 1 false).domain) + (↑(h 0 true).domain ∩ ↑(h 0 false).domain) + cO cO (-cO) xL xR hcover hleft hmiddle hright hxLinter hxRinter + exact hprop x ⟨hxA, hxB⟩ + +end NestedCompatibilityGeometry + +namespace NestedPrecursorConstant + +private theorem precursorConstant : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (h : + Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), PartialOdometerSlope (h i s) = some (s0 + (if s = true then (1 : ℝ) else (-1 : + ℝ)) • P4250T1SlopeOffset (BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 + : Fin (3 : ℕ))).succ)))) → (∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (k : Fin (3 : + ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer + (cfg.firstPredecessor i.succ) (U i s) (k i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + (cfg.firstPredecessor i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ × ℝ) (p_i : ℝ × ℝ), + PartialOdometerSlope (h (0 : Fin (3 : ℕ)) true) = some p ∧ PartialOdometerSlope (k i + s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) + * ((↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 + (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin (3 : + ℕ))).succ) (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + + (↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (∀ (V : Fin (3 : ℕ) + → Bool → ProtoTile), ∀ (l : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileOdometer (cfg.firstPredecessor i.succ) (V i s) (l i s)) → ((∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), (cfg.firstPredecessor i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ + × ℝ) (p_i : ℝ × ℝ), PartialOdometerSlope (h (0 : Fin (3 : ℕ)) false) = some p ∧ + PartialOdometerSlope (l i s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin + (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) + (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = + true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 + (cfg.firstPredecessor (i + (2 : Fin (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (cfg.firstPredecessor (i + (2 : Fin + (3 : ℕ))).succ) (cfg.firstPredecessor (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((∀ + (D : CircleCoordinates), ∀ (X : ProtoTile), BandPrototile D X → 0 < D.1 → + X.cells.Nonempty) → (((U 0 false).cells = (V 0 true).cells) → ((((U 0 false).cells = + ∅) → ((U 0 false).anchor = (V 0 true).anchor)) → ((FootprintVertices (U (0 : Fin (3 : + ℕ)) false) = FootprintVertices (V (0 : Fin (3 : ℕ)) true) ∧ BoundaryFootprintVertices + (U (0 : Fin (3 : ℕ)) false) = BoundaryFootprintVertices (V (0 : Fin (3 : ℕ)) true) ∧ + BoundaryFootprintEdges (U (0 : Fin (3 : ℕ)) false) = BoundaryFootprintEdges (V (0 : + Fin (3 : ℕ)) true) ∧ TileRealization (U (0 : Fin (3 : ℕ)) false) = TileRealization (V + (0 : Fin (3 : ℕ)) true) ∧ TileCentroid (U (0 : Fin (3 : ℕ)) false) = TileCentroid (V + (0 : Fin (3 : ℕ)) true)) → ((∀ {D : CircleCoordinates}, ∀ {X : ProtoTile}, ∀ + {g : PartialOdometer}, (D.1 = 0) → ((TileOdometer D X g) → (∃ x, X = ⟨∅, x⟩ ∧ + g.domain = {x}))) → (((k 0 false).domain : Set GaussianInt) = FootprintVertices (U 0 + false) ∧ ((l 0 true).domain : Set GaussianInt) = FootprintVertices (V 0 true) ∧ ((k 0 + false).domain : Set GaussianInt) = ((l 0 true).domain : Set GaussianInt) ∧ ∃ c : Int, + ∀ x, x ∈ (k 0 false).domain → x ∈ (l 0 true).domain → (l 0 true).value x - (k 0 + false).value x = c)))))))))) ) := by + classical + intro q cfg h s0 hp U k hchildA hslopeA V l hchildB hslopeB bandPositiveNonempty uvCells + uvAnchor uvObservable zeroOdometerLine + by_cases hzero : (cfg.firstPredecessor 1).1 = 0 + · have kline := NestedCompatibilityGeometry.kline q cfg U k hchildA zeroOdometerLine hzero + have lline := NestedCompatibilityGeometry.lline q cfg V l hchildB zeroOdometerLine hzero + obtain ⟨xk, htileK, hdomK⟩ := kline + obtain ⟨xl, htileL, hdomL⟩ := lline + have hxy := NestedCompatibilityGeometry.hxy U V uvAnchor xk htileK xl htileL + subst xl + refine ⟨?_, ?_, ?_, ⟨(l 0 true).value xk - (k 0 false).value xk, ?_⟩⟩ + · ext x + simp [hdomK, htileK, FootprintVertices] + · ext x + simp [hdomL, htileL, FootprintVertices] + · ext x + simp [hdomK, hdomL] + · intro x hxK hxL + have hx : x = xk := by simpa [hdomK] using hxK + subst x + rfl + · have hcurvpos := NestedCompatibilityGeometry.hcurvpos q cfg hzero + have kSlope : PartialOdometerSlope (k 0 false) = some s0 := + NestedCompatibilityGeometry.kSlope q cfg h s0 hp k hslopeA hzero + have lSlope : PartialOdometerSlope (l 0 true) = some s0 := + NestedCompatibilityGeometry.lSlope q cfg h s0 hp l hslopeB hzero + have hdomK := PositiveCurvatureTileOdometerDomain + (cfg.firstPredecessor 1) (U 0 false) (k 0 false) hcurvpos + (hchildA 0 false) + have hdomL := PositiveCurvatureTileOdometerDomain + (cfg.firstPredecessor 1) (V 0 true) (l 0 true) hcurvpos + (hchildB 0 true) + obtain ⟨shift, ⟨hcellsEq, hanchorEq, aa, bb, hdomains, hvalues⟩, _⟩ := + TileOdometerTranslationUniqueness (cfg.firstPredecessor 1) + (U 0 false) (V 0 true) (k 0 false) (l 0 true) hcurvpos + (hchildA 0 false) (hchildB 0 true) + have hneU : (U 0 false).cells.Nonempty := + bandPositiveNonempty (cfg.firstPredecessor 1) (U 0 false) + (TileOdometerBandPrototile _ _ _ (hchildA 0 false)) hcurvpos + have hcellShift : (V 0 true).cells = + (TileTranslation (V 0 true) shift).cells := + uvCells.symm.trans hcellsEq + have hcentShift : TileCentroid (V 0 true) = + TileCentroid (TileTranslation (V 0 true) shift) := + NestedCompatibilityGeometry.hcentShift V shift (NestedCompatibilityGeometry.hneV U + V uvCells hneU) hcellShift + rw [(TileTranslationFormulas (V 0 true) shift).2.2.2.2.1] + at hcentShift + have hshift : shift = 0 := NestedCompatibilityGeometry.hshift shift + (NestedCompatibilityGeometry.hshiftRe V shift hcentShift) + (NestedCompatibilityGeometry.hshiftIm V shift hcentShift) + have hdomainEq := NestedCompatibilityGeometry.hdomainEq k l shift aa bb hdomains hshift + have hslopeEq : PartialOdometerSlope (k 0 false) = + ((PartialOdometerSlope (l 0 true)).map + (fun p => (p.1 + (aa.re : Real), p.2 + (aa.im : Real)))) := + NestedCompatibilityGeometry.hslopeEq k l aa bb + (NestedCompatibilityGeometry.heqAt1131 k l aa bb hdomainEq + (NestedCompatibilityGeometry.hvalueEq k l shift aa bb hvalues hshift hdomainEq)) + rw [kSlope, lSlope, Option.map_some] at hslopeEq + have hslopePair : + s0 = (s0.1 + (aa.re : Real), s0.2 + (aa.im : Real)) := + Option.some.inj hslopeEq + have haa : aa = 0 := NestedCompatibilityGeometry.haa aa (NestedCompatibilityGeometry.haaRe + s0 aa hslopePair) (NestedCompatibilityGeometry.haaIm s0 aa hslopePair) + refine ⟨?_, ?_, ?_, ⟨-bb, ?_⟩⟩ + · exact hdomK + · exact hdomL + · exact hdomK.trans (uvObservable.1.trans hdomL.symm) + · intro x hxK hxL + have hv := hvalues x hxK + rw [hshift, haa] at hv + have hv' : (k 0 false).value x = (l 0 true).value x + bb := by + simpa using hv + omega + +end NestedPrecursorConstant + +namespace NestedCompatibilityConclusion + +private theorem nestedCompatibilityConclusion : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + TileOdometer (q i.succ) (cert.P i s) (h i s)) → ( + let A := cert.P 0 true + let B := cert.P 0 false + (1 < (cfg.firstPredecessor 0).1) → (∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (k : Fin (3 + : ℕ) → Bool → PartialOdometer), (BandPrototile (cfg.firstPredecessor (0 : Fin (4 : + ℕ))) A) → (((h 0 true).domain = FootprintVertices A) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), ∀ x ∈ (k i s).domain, (h (0 : Fin (3 : ℕ)) true).value x = (k i s).value x) → + (∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (l : Fin (3 : ℕ) → Bool → + PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (l i s).domain, (h (0 : + Fin (3 : ℕ)) false).value x = (l i s).value x) → ((∀ (i : Fin 3), ∀ (s : Bool), (U i + s).cells = (cert.Q i s).cells ∧ ((U i s).cells = ∅ → (U i s).anchor = (cert.Q i + s).anchor) ∧ FootprintVertices (U i s) = FootprintVertices (cert.Q i s)) → ((∀ (i : + Fin 3), ∀ (s : Bool), (V i s).cells = (cert.S i s).cells ∧ ((V i s).cells = ∅ → (V i + s).anchor = (cert.S i s).anchor) ∧ FootprintVertices (V i s) = FootprintVertices + (cert.S i s)) → ((0 < (cfg.firstPredecessor 2).1) → ((0 < (cfg.firstPredecessor 3).1) + → ((TileOdometer (cfg.firstPredecessor 2) (cert.Q 1 true) (k 1 true)) → + ((TileOdometer (cfg.firstPredecessor 2) (cert.S 1 false) (l 1 false)) → + ((TileOdometer (cfg.firstPredecessor 3) (cert.S 2 false) (l 2 false)) → + ((TileOdometer (cfg.firstPredecessor 3) (cert.Q 2 true) (k 2 true)) → ( + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let xv : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let v13 : GaussianInt := BandVectors.1 (q 1) (q 3) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (TileCentroid A - TileCentroid T = spatial w) → ((TileCentroid (cert.P 1 true) - + TileCentroid T = spatial v13) → ((TileCentroid (cert.Q 1 true) - TileCentroid T = + spatial xv + spatial w) → ((∀ (a : PartialOdometer), ∀ (b : PartialOdometer), ∀ (r : + PartialOdometer), ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ((a.domain + : Set GaussianInt) = FootprintVertices X) → (((b.domain : Set GaussianInt) = + FootprintVertices Y) → (((r.domain : Set GaussianInt) = FootprintVertices Z) → ((∀ x, + x ∈ r.domain → a.value x = r.value x) → ((FootprintVertices X ∩ FootprintVertices Y ⊆ + FootprintVertices Z ∩ FootprintVertices Y) → ((OdometerCompatibility r b) → + (OdometerCompatibility a b))))))) → ((0 < (q 1).1) → (((h 0 false).domain = + FootprintVertices B) → (((k 1 true).domain = FootprintVertices (cert.Q 1 true)) → + ((FootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.P (1 : + Fin (3 : ℕ)) true) ⊆ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∩ + FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true)) → ((FootprintVertices (cert.P (0 : + Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.P (0 : Fin (3 : ℕ)) false) ⊆ + FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.S (2 : + Fin (3 : ℕ)) false) ∪ FootprintVertices (cert.Q (0 : Fin (3 : ℕ)) false) ∪ + FootprintVertices (cert.Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.S (1 : + Fin (3 : ℕ)) false)) → ((OdometerCompatibility (h 0 true) (h 1 true)) → + ((TileCentroid B - TileCentroid T = -spatial w) → ((TileCentroid (cert.S 1 false) - + TileCentroid B = -spatial xv) → ((TileCentroid (cert.P 1 false) - TileCentroid T = + -spatial v13) → ((OdometerCompatibility (l 1 false) (h 1 false)) → + ((OdometerCompatibility (k 1 true) (l 2 false)) → ((OdometerCompatibility (l 1 false) + (k 2 true)) → ((∀ {V : Type}, ∀ (f : V → Int), ∀ (g : V → Int), ∀ (L : Set V), ∀ (O : + Set V), ∀ (R : Set V), ∀ (Iset : Set V), ∀ (c : Int), ∀ (d : Int), ∀ (e : Int), ∀ (xL + : V), ∀ (xR : V), (Iset ⊆ L ∪ O ∪ R) → ((∀ x ∈ L, g x - f x = d) → ((∀ x ∈ O, g x - f + x = c) → ((∀ x ∈ R, f x - g x = e) → ((xL ∈ L ∩ O) → ((xR ∈ R ∩ O) → (∀ x ∈ Iset, g x + - f x = c))))))) → ((∀ (D : CircleCoordinates), ∀ (X : ProtoTile), BandPrototile D X + → 0 < D.1 → X.cells.Nonempty) → (((cert.Q 0 false).cells = (cert.S 0 true).cells) → + ((((cert.Q 0 false).cells = ∅) → ((cert.Q 0 false).anchor = (cert.S 0 true).anchor)) + → ((((k 0 false).domain : Set GaussianInt) = FootprintVertices (U 0 false) ∧ ((l 0 + true).domain : Set GaussianInt) = FootprintVertices (V 0 true) ∧ ((k 0 false).domain + : Set GaussianInt) = ((l 0 true).domain : Set GaussianInt) ∧ ∃ c : Int, ∀ x, x ∈ (k 0 + false).domain → x ∈ (l 0 true).domain → (l 0 true).value x - (k 0 false).value x = c) + → (OdometerCompatibility (h 0 true) (h 1 true) ∧ OdometerCompatibility (h 0 false) (h + 1 false) ∧ OdometerCompatibility (h 0 true) (h 0 + false)))))))))))))))))))))))))))))))))))) ) := by + classical + intro q cfg C T cert h ho A B hroot U k hbandA hdomA hvalueA V l hvalueB alignA alignB pos2 + pos3 odoQ2 odoS2 odoS3 odoQ3 w xv v13 spatial hcenterA hcenterP hcenterQT rawCompatLift + hq1pos hdomBParent hdomQ hrawAC hrawAB compatAC hcenterB hcenterS hcenterPminus + compatBDNested compatCross1 compatCross2 propagateConstant bandPositiveNonempty qSCells + qSAnchor precursorConstant + have boundaryRaw := NestedCompatibilityGeometry.boundaryRaw + have centerIntegral := NestedCompatibilityGeometry.centerIntegral q T + (NestedCompatibilityGeometry.rootBand q cfg C T cert) + (NestedCompatibilityGeometry.rootNonempty q cfg C T cert hroot hbandA bandPositiveNonempty) + obtain ⟨u, hu⟩ := centerIntegral + have reflectedFoot := NestedCompatibilityGeometry.reflectedFoot T bandPositiveNonempty u hu + have hsumCD : TileCentroid (cert.P 1 true) + TileCentroid (cert.P 1 false) = + (2 : Real) • TileCentroid T := NestedCompatibilityGeometry.hsumCD q cfg C T cert hcenterP + hcenterPminus + have hreflectAB : FootprintVertices (TileTranslation (TileHalfTurn A) u) = + FootprintVertices B := reflectedFoot (q 1) A B (h 0 true) + (by simpa [A] using ho 0 true) + (TileOdometerBandPrototile _ _ _ (by simpa [B] using ho 0 false)) + hq1pos (NestedCompatibilityGeometry.hsumAB q cfg C T cert hcenterA hcenterB) + have hreflectCD : FootprintVertices + (TileTranslation (TileHalfTurn (cert.P 1 true)) u) = + FootprintVertices (cert.P 1 false) := reflectedFoot (q 2) + (cert.P 1 true) (cert.P 1 false) (h 1 true) + (by simpa using ho 1 true) + (TileOdometerBandPrototile _ _ _ (ho 1 false)) + (by simpa [cfg.firstParentTwo] using pos2) hsumCD + have hreflectQS : FootprintVertices + (TileTranslation (TileHalfTurn (cert.Q 1 true)) u) = + FootprintVertices (cert.S 1 false) := reflectedFoot + (cfg.firstPredecessor 2) (cert.Q 1 true) (cert.S 1 false) + (k 1 true) odoQ2 (TileOdometerBandPrototile _ _ _ odoS2) + pos2 (NestedCompatibilityGeometry.hsumQS q cfg C T cert hcenterQT + (NestedCompatibilityGeometry.hcenterSTAt1375 q cfg C T cert hcenterB hcenterS)) + let refl : GaussianInt → GaussianInt := fun x => GaussianTranslation u (-x) + have reflectedSet := NestedCompatibilityGeometry.reflectedSet u + have reflectedA := reflectedSet A B hreflectAB + have reflectedC := reflectedSet (cert.P 1 true) (cert.P 1 false) hreflectCD + have reflectedQ := reflectedSet (cert.Q 1 true) (cert.S 1 false) hreflectQS + have hdomD : (h 1 false).domain = FootprintVertices (cert.P 1 false) := + PositiveCurvatureTileOdometerDomain (q 2) (cert.P 1 false) (h 1 false) + (by simpa [cfg.firstParentTwo] using pos2) + (by simpa using ho 1 false) + have finishBD (hcompat : OdometerCompatibility (l 1 false) (h 1 false)) : + OdometerCompatibility (h 0 false) (h 1 false) := + rawCompatLift (h 0 false) (h 1 false) (l 1 false) B + (cert.P 1 false) (cert.S 1 false) hdomBParent hdomD + (PositiveCurvatureTileOdometerDomain (cfg.firstPredecessor 2) + (cert.S 1 false) (l 1 false) pos2 odoS2) + (fun x hx => hvalueB 1 false x hx) (NestedCompatibilityGeometry.hrawBD q cfg C T cert + hrawAC u reflectedA reflectedC reflectedQ (NestedCompatibilityGeometry.reflInjective + u)) hcompat + have oFootU := NestedCompatibilityGeometry.oFootU q cfg C T cert U alignA + have oFootV := NestedCompatibilityGeometry.oFootV q cfg C T cert V alignB qSCells qSAnchor + have hdomS3 : (l 2 false).domain = FootprintVertices (cert.S 2 false) := + PositiveCurvatureTileOdometerDomain (cfg.firstPredecessor 3) + (cert.S 2 false) (l 2 false) pos3 odoS3 + have hdomS2 : (l 1 false).domain = FootprintVertices (cert.S 1 false) := + PositiveCurvatureTileOdometerDomain (cfg.firstPredecessor 2) + (cert.S 1 false) (l 1 false) pos2 odoS2 + have hdomQ3 : (k 2 true).domain = FootprintVertices (cert.Q 2 true) := + PositiveCurvatureTileOdometerDomain (cfg.firstPredecessor 3) + (cert.Q 2 true) (k 2 true) pos3 odoQ3 + have precursorValueConstant : ∃ c : Int, ∀ x, + x ∈ (k 0 false).domain → x ∈ (l 0 true).domain → + (l 0 true).value x - (k 0 false).value x = c := precursorConstant.2.2.2 + obtain ⟨cO, hcO⟩ := precursorValueConstant + obtain ⟨xL, hxL, _⟩ := cert.precursor_first.2.2.2 + rcases hxL with ⟨hxLQ, hxLS, hxLO⟩ + obtain ⟨xR, hxR, _⟩ := cert.precursor_second.2.2.2 + rcases hxR with ⟨hxRQ, hxRS, hxRO⟩ + have hxLK := NestedCompatibilityGeometry.hxLK q cfg C T cert k hdomQ boundaryRaw xL hxLQ + have hxLS3 := NestedCompatibilityGeometry.hxLS3 q cfg C T cert l boundaryRaw hdomS3 xL hxLS + have hxLK0 := NestedCompatibilityGeometry.hxLK0 q cfg C T cert U k V l precursorConstant + boundaryRaw oFootU xL hxLO + have hxLL0 := NestedCompatibilityGeometry.hxLL0 q cfg C T cert U k V l precursorConstant + boundaryRaw oFootV xL hxLO + have hxRK3 := NestedCompatibilityGeometry.hxRK3 q cfg C T cert k boundaryRaw hdomQ3 xR hxRQ + have hxRS2 := NestedCompatibilityGeometry.hxRS2 q cfg C T cert l boundaryRaw hdomS2 xR hxRS + have hxRK0 := NestedCompatibilityGeometry.hxRK0 q cfg C T cert U k V l precursorConstant + boundaryRaw oFootU xR hxRO + have hxRL0 := NestedCompatibilityGeometry.hxRL0 q cfg C T cert U k V l precursorConstant + boundaryRaw oFootV xR hxRO + have crossOneConstant := NestedCompatibilityGeometry.crossOneConstant k l compatCross1 xL hxLK + hxLS3 + have crossTwoConstant := NestedCompatibilityGeometry.crossTwoConstant k l compatCross2 xR hxRK3 + hxRS2 + obtain ⟨cL, hcL⟩ := crossOneConstant + obtain ⟨cR, hcR⟩ := crossTwoConstant + refine ⟨compatAC, ?_, ?_⟩ + · exact finishBD compatBDNested + · exact (NestedCompatibilityGeometry.compatAB q cfg C T cert h U k hdomA hvalueA V l hvalueB + alignA hdomBParent hdomQ hrawAB propagateConstant precursorConstant hdomS3 hdomS2 hdomQ3 cO + hcO xL xR hxLK hxLS3 hxLK0 hxRK3 hxRS2 hxRK0 cL hcL cR hcR + (NestedCompatibilityGeometry.hleftCal h k hvalueA l hvalueB cO hcO xL hxLK hxLS3 hxLK0 + hxLL0 cL hcL) (NestedCompatibilityGeometry.hrightCal h k hvalueA l hvalueB cO hcO xR hxRK3 + hxRS2 hxRK0 hxRL0 cR hcR)) + +end NestedCompatibilityConclusion + +theorem P4250T1NestedCompatibility + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (h : Fin 3 → Bool → PartialOdometer) (s0 : Real × Real) + (ho : ∀ i s, TileOdometer (q i.succ) (cert.P i s) (h i s)) + (hp : ∀ i s, PartialOdometerSlope (h i s) = some + (s0 + (if s = true then (1 : Real) else -1) • + P4250T1SlopeOffset + (BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ))))) : + OdometerCompatibility (h 0 true) (h 1 true) ∧ + OdometerCompatibility (h 0 false) (h 1 false) ∧ + OdometerCompatibility (h 0 true) (h 0 false) := by +-- BODY + classical + let A := cert.P 0 true + let B := cert.P 0 false + have hroot : 1 < (cfg.firstPredecessor 0).1 := NestedCompatibilityGeometry.hroot q cfg + obtain ⟨U, k, hbandA, hchildA, hcellsA, hfootA, hcentA, hdomA, + hvalueA, hcompatA, hslopeA⟩ := + TileOdometerReindexedDecomposition cfg.firstPredecessor cfg.firstProper + A (h 0 true) hroot (by simpa [A, cfg.firstChild] using ho 0 true) + obtain ⟨V, l, hbandB, hchildB, hcellsB, hfootB, hcentB, hdomB, + hvalueB, hcompatB, hslopeB⟩ := + TileOdometerReindexedDecomposition cfg.firstPredecessor cfg.firstProper + B (h 0 false) hroot (by simpa [B, cfg.firstChild] using ho 0 false) + have alignA := NestedCompatibilityGeometry.alignA q cfg C T cert U k hchildA hcentA + have alignB := NestedCompatibilityGeometry.alignB q cfg C T cert V l hchildB hcentB + have pos2 : 0 < (cfg.firstPredecessor 2).1 := NestedCompatibilityGeometry.pos2 q cfg + have pos3 := NestedCompatibilityGeometry.pos3 q cfg + have odoQ2 : TileOdometer (cfg.firstPredecessor 2) (cert.Q 1 true) (k 1 true) := + PositiveCurvatureTileOdometerSupportTransport _ _ _ _ pos2 (hchildA 1 true) + (cert.plus_occurrence 1 true).1 (alignA 1 true).1 + have odoS2 : TileOdometer (cfg.firstPredecessor 2) (cert.S 1 false) (l 1 false) := + PositiveCurvatureTileOdometerSupportTransport _ _ _ _ pos2 (hchildB 1 false) + (cert.minus_occurrence 1 false).1 (alignB 1 false).1 + have odoS3 : TileOdometer (cfg.firstPredecessor 3) (cert.S 2 false) (l 2 false) := + PositiveCurvatureTileOdometerSupportTransport _ _ _ _ pos3 (hchildB 2 false) + (cert.minus_occurrence 2 false).1 (alignB 2 false).1 + have odoQ3 : TileOdometer (cfg.firstPredecessor 3) (cert.Q 2 true) (k 2 true) := + PositiveCurvatureTileOdometerSupportTransport _ _ _ _ pos3 (hchildA 2 true) + (cert.plus_occurrence 2 true).1 (alignA 2 true).1 + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (q 3) (q 2) + let xv : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) + let v21 : GaussianInt := BandVectors.1 (q 2) (q 1) + let v13 : GaussianInt := BandVectors.1 (q 1) (q 3) + let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) + let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) + let a21 : GaussianInt := BandVectors.2 (q 2) (q 1) + let a13 : GaussianInt := BandVectors.2 (q 1) (q 3) + let spatial (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + have hcycV := (VectorRecursionLaws q cfg.proper.1).1 + have hcycA := (VectorRecursionLaws q cfg.proper.1).2.1 + have hpredV := (VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).1 + have hpredA := (VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).2.1 + have hrot := VectorRecursionLaws _ + (SemiProperQuadruple.rotate cfg.firstProper.1) + have spatialIdentity := NestedCompatibilityGeometry.spatialIdentity q cfg + (NestedCompatibilityGeometry.hV13 q cfg hcycV (NestedCompatibilityGeometry.hX q cfg hcycV + hpredV (NestedCompatibilityGeometry.hv21 q cfg hrot))) + have slopeIdentity := NestedCompatibilityGeometry.slopeIdentity q cfg + (NestedCompatibilityGeometry.hA13 q cfg hcycA (NestedCompatibilityGeometry.hXalpha q cfg + hcycA hpredA (NestedCompatibilityGeometry.ha21 q cfg hrot))) + have secondFlip := (VectorRecursionLaws cfg.secondPredecessor + cfg.secondProper.1).2.2.2.2 cfg.secondProper 0 + simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl, + cfg.secondChild, cfg.secondParentOne] at secondFlip + have hI2 : I * I = -1 := by + ext <;> norm_num [I] + have hIprod (z : GaussianInt) : I * z = ⟨-z.im, z.re⟩ := by + ext <;> simp [I] + have hcenterA : TileCentroid A - TileCentroid T = spatial w := by + simpa [A, spatial, w, Fin.add_def] using (cert.outer_occurrence 0 true).2.2 + have hcenterP : TileCentroid (cert.P 1 true) - TileCentroid T = spatial v13 := by + simpa [spatial, v13, Fin.add_def] using (cert.outer_occurrence 1 true).2.2 + have hcenterQT := NestedCompatibilityGeometry.hcenterQT q cfg C T cert hcenterA + (NestedCompatibilityGeometry.hcenterQ q cfg C T cert) + have hcenterDelta : TileCentroid (cert.P 1 true) - + TileCentroid (cert.Q 1 true) = GaussianRealPoint (I * w) := + NestedCompatibilityGeometry.hcenterDelta q cfg C T cert spatialIdentity hcenterP hcenterQT + have childSlope := NestedCompatibilityGeometry.childSlope q cfg h s0 hp k hslopeA pos2 + rw [← secondFlip.1] at hcenterDelta + have posRoot2 : 0 < (q 2).1 := by have := cfg.secondLarge; omega + let C2 : BandCircle := + ⟨⟨q 2, Or.inl posRoot2, q, cfg.proper.1, 2, rfl⟩, posRoot2⟩ + have rawCompatLift := NestedCompatibilityGeometry.rawCompatLift + have hq1pos := NestedCompatibilityGeometry.hq1pos q cfg hroot + have hdomA : (h 0 true).domain = FootprintVertices A := + PositiveCurvatureTileOdometerDomain (q 1) A (h 0 true) hq1pos + (by simpa [A] using ho 0 true) + have hdomC : (h 1 true).domain = FootprintVertices (cert.P 1 true) := + PositiveCurvatureTileOdometerDomain (q 2) (cert.P 1 true) (h 1 true) + (by simpa [cfg.firstParentTwo] using pos2) + (by simpa using ho 1 true) + have hdomBParent : (h 0 false).domain = FootprintVertices B := + PositiveCurvatureTileOdometerDomain (q 1) B (h 0 false) hq1pos + (by simpa [B] using ho 0 false) + have hdomQ : (k 1 true).domain = FootprintVertices (cert.Q 1 true) := + PositiveCurvatureTileOdometerDomain (cfg.firstPredecessor 2) + (cert.Q 1 true) (k 1 true) pos2 odoQ2 + have hrawAC := (BandOrderedGeneralRawSupport q cfg C T cert).1 + have hrawAB := (BandOrderedGeneralRawSupport q cfg C T cert).2 + have finishAC (hcompat : OdometerCompatibility (k 1 true) (h 1 true)) : + OdometerCompatibility (h 0 true) (h 1 true) := + rawCompatLift (h 0 true) (h 1 true) (k 1 true) A (cert.P 1 true) + (cert.Q 1 true) hdomA hdomC hdomQ + (fun x hx => hvalueA 1 true x hx) hrawAC hcompat + have compatAC : OdometerCompatibility (h 0 true) (h 1 true) := + finishAC ((RightSubtileOdometerCompatibility.1 C2 (cert.Q 1 true) + (cert.P 1 true) (k 1 true) (h 1 true)) (NestedCompatibilityGeometry.adjQ2 q cfg C T cert h + s0 ho k odoQ2 hcenterDelta (NestedCompatibilityGeometry.rootSlope q h s0 hp) childSlope + (NestedCompatibilityGeometry.slopeDelta q cfg s0 slopeIdentity secondFlip) posRoot2)) + have hcenterB : TileCentroid B - TileCentroid T = -spatial w := by + simpa [B, spatial, w, Fin.add_def] using (cert.outer_occurrence 0 false).2.2 + have hcenterS := NestedCompatibilityGeometry.hcenterS q cfg C T cert + have hcenterPminus := NestedCompatibilityGeometry.hcenterPminus q cfg C T cert + have childSlopeMinus := NestedCompatibilityGeometry.childSlopeMinus q cfg h s0 hp l hslopeB pos2 + have compatBDNested : OdometerCompatibility (l 1 false) (h 1 false) := + (RightSubtileOdometerCompatibility.1 C2 (cert.S 1 false) + (cert.P 1 false) (l 1 false) (h 1 false)) (NestedCompatibilityGeometry.adjS2 q cfg C T cert + h s0 ho l odoS2 posRoot2 (NestedCompatibilityGeometry.hcenterDeltaMinus q cfg C T cert + spatialIdentity secondFlip hcenterB hcenterS hcenterPminus) childSlopeMinus + (NestedCompatibilityGeometry.rootSlopeMinus q h s0 hp) + (NestedCompatibilityGeometry.slopeDeltaMinus q cfg s0 secondFlip + (NestedCompatibilityGeometry.slopeIdentityMinus q cfg slopeIdentity))) + let x2v : GaussianInt := + BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + let x2a : GaussianInt := + BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + have posRoot3 := NestedCompatibilityGeometry.posRoot3 q cfg + let C3 : BandCircle := + ⟨⟨q 3, Or.inl posRoot3, q, cfg.proper.1, 3, rfl⟩, posRoot3⟩ + have compatCross1 : OdometerCompatibility (k 1 true) (l 2 false) := + (RightSubtileOdometerCompatibility.2 C2 C3 + (cert.Q 1 true) (cert.S 2 false) (k 1 true) (l 2 false)) + (NestedCompatibilityGeometry.adjCross1 q cfg C T cert s0 k l odoQ2 odoS3 secondFlip + childSlope posRoot2 (NestedCompatibilityGeometry.childSlopeS3 q cfg h s0 hp l hslopeB + pos3) (NestedCompatibilityGeometry.crossSpatial q cfg C T cert hpredV hcenterQT + (NestedCompatibilityGeometry.hcenterS3 q cfg C T cert V hcentB alignB hcenterB)) + (NestedCompatibilityGeometry.crossSlope q cfg s0 hpredA secondFlip) posRoot3) + have compatCross2 : OdometerCompatibility (l 1 false) (k 2 true) := + (RightSubtileOdometerCompatibility.2 C2 C3 + (cert.S 1 false) (cert.Q 2 true) (l 1 false) (k 2 true)) + (NestedCompatibilityGeometry.adjCross2 q cfg C T cert s0 k l odoS2 odoQ3 secondFlip + posRoot2 childSlopeMinus posRoot3 (NestedCompatibilityGeometry.childSlopeQ3 q cfg h s0 + hp k hslopeA pos3) (NestedCompatibilityGeometry.crossSpatial2 q cfg C T cert hpredV + (NestedCompatibilityGeometry.hI3 (NestedCompatibilityGeometry.hI2pow hI2)) + (NestedCompatibilityGeometry.hnegII hI2) hIprod hcenterB hcenterS + (NestedCompatibilityGeometry.hcenterQ3 q cfg C T cert U hcentA alignA hcenterA)) + (NestedCompatibilityGeometry.crossSlope2 q cfg s0 hpredA secondFlip + (NestedCompatibilityGeometry.hIneg hI2) (NestedCompatibilityGeometry.hI3neg hI2) hIprod)) + have bandPositiveNonempty := NestedCompatibilityGeometry.bandPositiveNonempty q cfg + have qSCells := NestedCompatibilityGeometry.qSCells q cfg C T cert + have qSAnchor := NestedCompatibilityGeometry.qSAnchor q cfg C T cert + have uvCells := NestedCompatibilityGeometry.uvCells q cfg C T cert U V alignA alignB qSCells + have uvAnchor := NestedCompatibilityGeometry.uvAnchor q cfg C T cert U V alignA alignB qSCells + qSAnchor + have uvObservable := ProtoTileObservableExtensionality + (U 0 false) (V 0 true) uvCells uvAnchor + exact (NestedCompatibilityConclusion.nestedCompatibilityConclusion q cfg C T cert h ho hroot U + k hbandA hdomA hvalueA V l hvalueB alignA alignB pos2 pos3 odoQ2 odoS2 odoS3 odoQ3 hcenterA + hcenterP hcenterQT rawCompatLift hq1pos hdomBParent hdomQ hrawAC hrawAB compatAC hcenterB + hcenterS hcenterPminus compatBDNested compatCross1 compatCross2 + (NestedCompatibilityGeometry.propagateConstant q cfg) bandPositiveNonempty qSCells qSAnchor + (NestedPrecursorConstant.precursorConstant q cfg h s0 hp U k hchildA hslopeA V l hchildB + hslopeB bandPositiveNonempty uvCells uvAnchor uvObservable + (NestedCompatibilityGeometry.zeroOdometerLine q cfg + (NestedCompatibilityGeometry.properLarge q cfg)))) + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean b/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean new file mode 100644 index 0000000000..6cbc7b7a16 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean @@ -0,0 +1,1927 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4250T1SlopeOffset +public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.RightSubtileOdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent + +-- [TABLET NODE: P4250T1OrdinaryCompatibility] + +/-! +# P4250T1OrdinaryCompatibility + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OrdinaryCompatibilityGeometry + +private theorem hImul : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + I * I = -1 ) := by + classical + intro I + dsimp [I] + decide + +private theorem hI3 : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + (I ^ 2 = -1) → (I ^ 3 = -I) ) := by + classical + intro I hI2 + rw [pow_succ, hI2] + simp + +private theorem hX : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let U := BandVectors.1 (q 2) (q 1) + let W := BandVectors.1 (q 3) (q 2) + let X := BandVectors.1 (q 1) (q 3) + (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : + ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : + Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin + (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 + : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q + (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → (X = -U - W) ) := by + classical + intro q U W X laws + dsimp [X, U, W] + linear_combination laws.1 + +private theorem hY : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let A := BandVectors.2 (q 2) (q 1) + let B := BandVectors.2 (q 3) (q 2) + let Y := BandVectors.2 (q 1) (q 3) + (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : + ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : + Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin + (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 + : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q + (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → (Y = -A - B) ) := by + classical + intro q A B Y laws + dsimp [Y, A, B] + linear_combination laws.2.1 + +private theorem hpos : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (i : Fin 3), + 0 < (q i.succ).1) ) := by + classical + intro q cfg i + have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 i + have hne := cfg.noLine i.succ + have hn' : 0 ≤ (q i.succ).1 := by simpa using hn + omega + +private theorem occCent : + (by + classical + exact + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + ∀ (r : Fin 4 → CircleCoordinates), ∀ (P : ProtoTile), ∀ (Z : ProtoTile), ∀ (i : Fin 3), ∀ + (e : Bool), (BandSubtileOccurrence r P i e Z) → (TileCentroid Z - TileCentroid P = + (if e then (1 : Real) else -1) • cOff (BandVectors.1 (r ((i + 2).succ)) (r ((i + + 1).succ)))) ) := by + classical + intro cOff r P Z i e ho + change BandPrototile (r i.succ) Z ∧ _ ∧ _ at ho + rcases ho with ⟨_, _, hc⟩ + exact hc + +private theorem slope : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × + Real), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), PartialOdometerSlope (h i s) = some (s0 + + (if s = true then (1 : ℝ) else (-1 : ℝ)) • P4250T1SlopeOffset (BandVectors.2 (q (i + + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)))) → ( + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + ∀ (i : Fin 3), ∀ (e : Bool), PartialOdometerSlope (h i e) = some (s0 + (if e then (1 : + Real) else -1) • sOff (BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ))))) ) := by + classical + intro q h s0 hp sOff i e + simpa [sOff] using hp i e + +private theorem cadd : + (by + classical + exact + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + ∀ (a : GaussianInt), ∀ (b : GaussianInt), cOff (a + b) = cOff a + cOff b ) := by + classical + intro cOff a b + dsimp [cOff, GaussianRealPoint] + ext <;> simp [] <;> ring + +private theorem cneg : + (by + classical + exact + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + ∀ (a : GaussianInt), cOff (-a) = -cOff a ) := by + classical + intro cOff a + dsimp [cOff, GaussianRealPoint] + ext <;> simp [] <;> ring + +private theorem sY : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let A := BandVectors.2 (q 2) (q 1) + let B := BandVectors.2 (q 3) (q 2) + let Y := BandVectors.2 (q 1) (q 3) + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + (Y = -A - B) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), sOff (a + b) = sOff a + sOff + b) → ((∀ (a : GaussianInt), sOff (-a) = -sOff a) → (sOff Y = -sOff A - sOff B))) ) := by + classical + intro q A B Y sOff hY sadd sneg + rw [hY] + have hneg : -A - B = -(A + B) := by abel + rw [hneg, sneg, sadd] + ext <;> simp <;> ring + +private theorem gaussianPointNeg : + (by + classical + exact + ∀ (z : GaussianInt), GaussianRealPoint (-z) = -GaussianRealPoint z ) := by + classical + intro z + ext <;> simp [GaussianRealPoint] + +private theorem hV20 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let U := BandVectors.1 (q 2) (q 1) + BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = U ) := by + classical + intro q cfg U + simp [U, cfg.firstParentTwo, cfg.firstChild] + +private theorem hV21 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let U := BandVectors.1 (q 2) (q 1) + let W := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = U) → (BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = U + I * W) ) := by + classical + intro q cfg I U W hV20 + have hr := (VectorRecursionLaws _ + (SemiProperQuadruple.rotate cfg.firstProper.1)).2.2.1 + have hrot : BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0) = + BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) - + I * W := by + simpa [I, W, cfg.firstParentThree, cfg.firstParentTwo, + cfg.firstChild] using hr + rw [hV20] at hrot + dsimp [U, I, W] at hrot ⊢ + linear_combination -hrot + +private theorem hflip120 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let U := BandVectors.1 (q 2) (q 1) + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = U) → ((BandVectors.1 + (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor (Fin.succ (1 : Fin (3 + : ℕ)))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (cfg.firstPredecessor + (Fin.succ (1 : Fin (3 : ℕ)))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor + (Fin.succ (1 : Fin (3 : ℕ)))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 + (cfg.firstPredecessor (Fin.succ (1 : Fin (3 : ℕ)))) (cfg.firstPredecessor (0 : Fin (4 + : ℕ)))) → (BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = I * U)) + ) := by + classical + intro q cfg I U hV20 hflip12 + have hf := hflip12.1 + change BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = + I * BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) at hf + rw [hV20] at hf + simpa [I, U] using hf + +private theorem hsumV12 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let U := BandVectors.1 (q 2) (q 1) + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = U) → ((BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = I * U) → (BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = (1 + I) * U)) ) := by + classical + intro q cfg I U hV20 hflip120 + rw [hV20, hflip120] + ring + +private theorem hV30 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let U := BandVectors.1 (q 2) (q 1) + let W := BandVectors.1 (q 3) (q 2) + (I * I = -1) → ((BandVectors.1 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) + (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + BandVectors.1 (cfg.firstPredecessor (1 : + Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))) + BandVectors.1 + (cfg.firstPredecessor (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) + (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + BandVectors.2 (cfg.firstPredecessor (1 : + Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))) + BandVectors.2 + (cfg.firstPredecessor (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) + (cfg.firstPredecessor (0 : Fin (4 : ℕ))) = BandVectors.1 (cfg.firstPredecessor (1 : + Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.1 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (cfg.firstPredecessor (1 : + Fin (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) = BandVectors.2 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 + : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple + cfg.firstPredecessor → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (cfg.firstPredecessor (0 : + Fin (4 : ℕ))) (cfg.firstPredecessor j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (cfg.firstPredecessor j.succ) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) + ∧ BandVectors.2 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor + j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (cfg.firstPredecessor + j.succ) (cfg.firstPredecessor (0 : Fin (4 : ℕ))))) → ((BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = U + I * W) → (BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = I * (U + W)))) ) := by + classical + intro q cfg I U W hImul firstLaws hV21 + have hr : BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0) = BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 2) - I * BandVectors.1 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) := by + simpa [I] using (VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate cfg.firstProper.1))).2.2.1 + have hv13 : BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3) = -U - (1 + I) * W := by + have hsum : W + BandVectors.1 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3) + + BandVectors.1 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1) = 0 := by + simpa [W, cfg.firstParentThree, cfg.firstParentTwo] using firstLaws.1 + rw [hV21] at hsum + dsimp [U, W, I] at hsum ⊢ + linear_combination hsum + rw [hr, hv13, cfg.firstParentThree, cfg.firstParentTwo] + dsimp [U, W, I] + linear_combination hImul * W + +private theorem hsumV03 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let U := BandVectors.1 (q 2) (q 1) + let W := BandVectors.1 (q 3) (q 2) + (I * I = -1) → ((BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = I * (U + + W)) → ((BandVectors.1 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) + (cfg.firstPredecessor (Fin.succ (2 : Fin (3 : ℕ)))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.1 (cfg.firstPredecessor (Fin.succ (2 : Fin (3 : ℕ)))) + (cfg.firstPredecessor (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (cfg.firstPredecessor (0 : + Fin (4 : ℕ))) (cfg.firstPredecessor (Fin.succ (2 : Fin (3 : ℕ)))) = -(⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.2 (cfg.firstPredecessor (Fin.succ (2 : Fin (3 : + ℕ)))) (cfg.firstPredecessor (0 : Fin (4 : ℕ)))) → (BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = (1 + I) * (I * (U + W))))) ) := by + classical + intro q cfg I U W hImul hV30 hflip03 + have hf : BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 3) = I * BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) := by + simpa [I] using hflip03.1 + calc + _ = I * (U + W) + I * (I * (U + W)) := by rw [hV30, hf, hV30] + _ = (1 + I) * (I * (U + W)) := by + calc + _ = I * (U + W) + (I * I) * (U + W) := by rw [← mul_assoc] + _ = I * (U + W) + (-1) * (U + W) := by rw [hImul] + _ = (-1 + I) * (U + W) := by ring + _ = (1 + I) * (I * (U + W)) := by + have hp : (1 + I) * I = -1 + I := by + calc + _ = I + I * I := by ring + _ = I + (-1) := by rw [hImul] + _ = -1 + I := by ring + rw [← mul_assoc, hp] + +private theorem hsumVsecond : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let W := BandVectors.1 (q 3) (q 2) + (BandVectors.1 (cfg.secondPredecessor (0 : Fin (4 : ℕ))) (cfg.secondPredecessor (Fin.succ + (0 : Fin (3 : ℕ)))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 + (cfg.secondPredecessor (Fin.succ (0 : Fin (3 : ℕ)))) (cfg.secondPredecessor (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (cfg.secondPredecessor (0 : Fin (4 : ℕ))) + (cfg.secondPredecessor (Fin.succ (0 : Fin (3 : ℕ)))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (cfg.secondPredecessor (Fin.succ (0 : Fin (3 : ℕ)))) + (cfg.secondPredecessor (0 : Fin (4 : ℕ)))) → (BandVectors.1 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = (1 + I) * W) ) := by + classical + intro q cfg I W hflipSecond + have hf : BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = I * BandVectors.1 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) := by + simpa [I] using hflipSecond.1 + calc + _ = BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + + I * BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) := by rw [hf] + _ = (1 + I) * W := by rw [cfg.secondVectorOne]; ring + +private theorem hsumA12 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let A := BandVectors.2 (q 2) (q 1) + (BandVectors.1 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor (Fin.succ + (1 : Fin (3 : ℕ)))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 + (cfg.firstPredecessor (Fin.succ (1 : Fin (3 : ℕ)))) (cfg.firstPredecessor (0 : Fin (4 + : ℕ))) ∧ BandVectors.2 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor + (Fin.succ (1 : Fin (3 : ℕ)))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 + (cfg.firstPredecessor (Fin.succ (1 : Fin (3 : ℕ)))) (cfg.firstPredecessor (0 : Fin (4 + : ℕ)))) → (BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + + BandVectors.2 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = (1 - I) * A) ) := by + classical + intro q cfg I A hflip12 + let B := BandVectors.2 (q 3) (q 2) + have hf := hflip12.2 + change BandVectors.2 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2) = -I * BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) at hf + have hrotA : BandVectors.2 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0) = BandVectors.2 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1) + I * B := by + simpa [I, B, cfg.firstParentThree, cfg.firstParentTwo, + cfg.firstChild] using + (VectorRecursionLaws _ + (SemiProperQuadruple.rotate cfg.firstProper.1)).2.2.2.1 + have hA21 : BandVectors.2 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1) = A - I * B := by + have hbase : BandVectors.2 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0) = A := by + dsimp [A] + rw [← cfg.firstParentTwo, ← cfg.firstChild] + have heq : BandVectors.2 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1) + I * B = A := by + calc + _ = BandVectors.2 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0) := hrotA.symm + _ = A := hbase + linear_combination heq + have hbase : BandVectors.2 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0) = A := by + rw [hrotA, hA21] + dsimp [A, B, I] + ring + rw [hbase] at hf ⊢ + linear_combination hf + +private theorem hsumAsecond : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let B := BandVectors.2 (q 3) (q 2) + (BandVectors.1 (cfg.secondPredecessor (0 : Fin (4 : ℕ))) (cfg.secondPredecessor (Fin.succ + (0 : Fin (3 : ℕ)))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 + (cfg.secondPredecessor (Fin.succ (0 : Fin (3 : ℕ)))) (cfg.secondPredecessor (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (cfg.secondPredecessor (0 : Fin (4 : ℕ))) + (cfg.secondPredecessor (Fin.succ (0 : Fin (3 : ℕ)))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (cfg.secondPredecessor (Fin.succ (0 : Fin (3 : ℕ)))) + (cfg.secondPredecessor (0 : Fin (4 : ℕ)))) → (BandVectors.2 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = (1 - I) * B) ) := by + classical + intro q cfg I B hflipSecond + have hbase : BandVectors.2 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) = B := by + simp [B, cfg.secondParentOne, cfg.secondChild] + have hf : BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = -I * B := by + have hf := hflipSecond.2 + change BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = -I * BandVectors.2 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) at hf + rw [hbase] at hf + exact hf + rw [hbase, hf] + ring + +private theorem hrot2A : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = BandVectors.2 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 2) + I * BandVectors.2 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) ) := by + classical + intro q cfg I + simpa [I] using (VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate cfg.firstProper.1))).2.2.2.1 + +private theorem hrotAglobal : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let B := BandVectors.2 (q 3) (q 2) + BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + I * B ) := by + classical + intro q cfg I B + simpa [I, B, cfg.firstParentThree, cfg.firstParentTwo, + cfg.firstChild] using (VectorRecursionLaws _ + (SemiProperQuadruple.rotate cfg.firstProper.1)).2.2.2.1 + +private theorem hA21global : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let A := BandVectors.2 (q 2) (q 1) + let B := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) = BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) + I * B) → (BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = A - I * B) ) := by + classical + intro q cfg I A B hrotAglobal + have hbase : BandVectors.2 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0) = A := by + dsimp [A] + rw [← cfg.firstParentTwo, ← cfg.firstChild] + have heq : BandVectors.2 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1) + I * B = A := by + calc + _ = BandVectors.2 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0) := hrotAglobal.symm + _ = A := hbase + linear_combination heq + +private theorem hA13 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let A := BandVectors.2 (q 2) (q 1) + let B := BandVectors.2 (q 3) (q 2) + (BandVectors.1 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 + : ℕ))) + BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor + (3 : Fin (4 : ℕ))) + BandVectors.1 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 + (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + + BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin + (4 : ℕ))) + BandVectors.2 (cfg.firstPredecessor (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) = + BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin + (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (cfg.firstPredecessor + (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) = + BandVectors.2 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin + (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (cfg.firstPredecessor + (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple + cfg.firstPredecessor → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (cfg.firstPredecessor (0 : + Fin (4 : ℕ))) (cfg.firstPredecessor j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (cfg.firstPredecessor j.succ) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) + ∧ BandVectors.2 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor + j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (cfg.firstPredecessor + j.succ) (cfg.firstPredecessor (0 : Fin (4 : ℕ))))) → ((BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) = A - I * B) → (BandVectors.2 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -A - (1 - I) * B)) ) := by + classical + intro q cfg I A B firstLaws hA21global + have hsum : B + BandVectors.2 (cfg.firstPredecessor 1) + (cfg.firstPredecessor 3) + + BandVectors.2 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 1) = 0 := by + simpa [B, cfg.firstParentThree, cfg.firstParentTwo] using firstLaws.2.1 + rw [hA21global] at hsum + dsimp [A, B, I] at hsum ⊢ + linear_combination hsum + +private theorem hA30 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let A := BandVectors.2 (q 2) (q 1) + let B := BandVectors.2 (q 3) (q 2) + (I * I = -1) → ((BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = + BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 2) + I * BandVectors.2 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3)) → ((BandVectors.2 + (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) = -A - (1 - I) * B) → + (BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = -I * (A + B)))) ) + := by + classical + intro q cfg I A B hImul hrot2A hA13 + rw [hrot2A, hA13, cfg.firstParentThree, cfg.firstParentTwo] + dsimp [A, B, I] + linear_combination hImul * B + +private theorem hflip03A : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.1 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor (Fin.succ + (2 : Fin (3 : ℕ)))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 + (cfg.firstPredecessor (Fin.succ (2 : Fin (3 : ℕ)))) (cfg.firstPredecessor (0 : Fin (4 + : ℕ))) ∧ BandVectors.2 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor + (Fin.succ (2 : Fin (3 : ℕ)))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 + (cfg.firstPredecessor (Fin.succ (2 : Fin (3 : ℕ)))) (cfg.firstPredecessor (0 : Fin (4 + : ℕ)))) → (BandVectors.2 (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = -I * + BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0)) ) := by + classical + intro q cfg I hflip03 + simpa [I] using hflip03.2 + +private theorem hsumA03 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let I : GaussianInt := ⟨0, 1⟩ + let A := BandVectors.2 (q 2) (q 1) + let B := BandVectors.2 (q 3) (q 2) + (I * I = -1) → ((BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = -I * + (A + B)) → ((BandVectors.2 (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = -I * + BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0)) → (BandVectors.2 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = (1 - I) * (-I * (A + B))))) ) := by + classical + intro q cfg I A B hImul hA30 hflip03A + rw [hA30, hflip03A] + rw [hA30] + calc + _ = -I * (A + B) + ((-I) * (-I)) * (A + B) := by rw [← mul_assoc] + _ = -I * (A + B) + (-1) * (A + B) := by + have hn : (-I : GaussianInt) * (-I) = -1 := by + rw [neg_mul_neg, hImul] + rw [hn] + _ = (-1 - I) * (A + B) := by ring + _ = (1 - I) * (-I * (A + B)) := by + have hp : (1 - I) * (-I) = -1 - I := by + calc + _ = -(I - I * I) := by ring + _ = -(I - (-1)) := by rw [hImul] + _ = -1 - I := by ring + rw [← mul_assoc, hp] + +private theorem hC12 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let I : GaussianInt := ⟨0, 1⟩ + let U := BandVectors.1 (q 2) (q 1) + let W := BandVectors.1 (q 3) (q 2) + let X := BandVectors.1 (q 1) (q 3) + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (X = -U - W) → ((TileCentroid (cert.P 0 true) - TileCentroid T = cOff W) → ((TileCentroid + (cert.P 1 false) - TileCentroid T = -cOff X) → ((BandVectors.1 (cfg.firstPredecessor + 2) (cfg.firstPredecessor 0) + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2) = (1 + I) * U) → (TileCentroid (cert.P 1 false) - + TileCentroid (cert.P 0 true) = (1 / 2 : Real) • GaussianRealPoint (I ^ 3 * + (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2))))))) ) := by + classical + intro q cfg C T cert I U W X cOff hX hc0p hc1m hsumV12 + have ha : TileCentroid (cert.P 1 false) - TileCentroid (cert.P 0 true) = + -cOff X - cOff W := by + calc + _ = (TileCentroid (cert.P 1 false) - TileCentroid T) - + (TileCentroid (cert.P 0 true) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = _ := by rw [hc1m, hc0p] + rw [ha, hX, hsumV12] + dsimp [cOff, GaussianRealPoint, I, U, W] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem hC21 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let I : GaussianInt := ⟨0, 1⟩ + let U := BandVectors.1 (q 2) (q 1) + let W := BandVectors.1 (q 3) (q 2) + let X := BandVectors.1 (q 1) (q 3) + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (X = -U - W) → ((TileCentroid (cert.P 0 false) - TileCentroid T = -cOff W) → + ((TileCentroid (cert.P 1 true) - TileCentroid T = cOff X) → ((BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = (1 + I) * U) → (TileCentroid + (cert.P 1 true) - TileCentroid (cert.P 0 false) = (1 / 2 : Real) • GaussianRealPoint + (I ^ 1 * (BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + + BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2))))))) ) := by + classical + intro q cfg C T cert I U W X cOff hX hc0m hc1p hsumV12 + have ha : TileCentroid (cert.P 1 true) - TileCentroid (cert.P 0 false) = + cOff X + cOff W := by + calc + _ = (TileCentroid (cert.P 1 true) - TileCentroid T) - + (TileCentroid (cert.P 0 false) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = _ := by rw [hc1p, hc0m]; simp + rw [ha, hX, hsumV12] + dsimp [cOff, GaussianRealPoint, I, U, W] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem hC13 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let I : GaussianInt := ⟨0, 1⟩ + let U := BandVectors.1 (q 2) (q 1) + let W := BandVectors.1 (q 3) (q 2) + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (TileCentroid (cert.P 0 true) - TileCentroid T = cOff W) → ((TileCentroid (cert.P 2 + false) - TileCentroid T = -cOff U) → ((BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0) + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 3) = (1 + I) * (I * (U + W))) → (TileCentroid (cert.P 2 false) + - TileCentroid (cert.P 0 true) = (1 / 2 : Real) • GaussianRealPoint (I ^ 0 * + (BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3)))))) ) := by + classical + intro q cfg C T cert I U W cOff hc0p hc2m hsumV03 + have ha : TileCentroid (cert.P 2 false) - TileCentroid (cert.P 0 true) = + -cOff U - cOff W := by + calc + _ = (TileCentroid (cert.P 2 false) - TileCentroid T) - + (TileCentroid (cert.P 0 true) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = _ := by rw [hc2m, hc0p] + rw [ha, hsumV03] + dsimp [cOff, GaussianRealPoint, I, U, W] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem hC31 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let I : GaussianInt := ⟨0, 1⟩ + let U := BandVectors.1 (q 2) (q 1) + let W := BandVectors.1 (q 3) (q 2) + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (TileCentroid (cert.P 0 false) - TileCentroid T = -cOff W) → ((TileCentroid (cert.P 2 + true) - TileCentroid T = cOff U) → ((BandVectors.1 (cfg.firstPredecessor 3) + (cfg.firstPredecessor 0) + BandVectors.1 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 3) = (1 + I) * (I * (U + W))) → (TileCentroid (cert.P 2 true) - + TileCentroid (cert.P 0 false) = (1 / 2 : Real) • GaussianRealPoint (I ^ 2 * + (BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3)))))) ) := by + classical + intro q cfg C T cert I U W cOff hc0m hc2p hsumV03 + have ha : TileCentroid (cert.P 2 true) - TileCentroid (cert.P 0 false) = + cOff U + cOff W := by + calc + _ = (TileCentroid (cert.P 2 true) - TileCentroid T) - + (TileCentroid (cert.P 0 false) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = _ := by rw [hc2p, hc0m]; simp + rw [ha, hsumV03] + dsimp [cOff, GaussianRealPoint, I, U, W] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem hC23 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let I : GaussianInt := ⟨0, 1⟩ + let U := BandVectors.1 (q 2) (q 1) + let W := BandVectors.1 (q 3) (q 2) + let X := BandVectors.1 (q 1) (q 3) + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (X = -U - W) → ((TileCentroid (cert.P 1 true) - TileCentroid T = cOff X) → ((TileCentroid + (cert.P 2 false) - TileCentroid T = -cOff U) → ((BandVectors.1 (cfg.secondPredecessor + 1) (cfg.secondPredecessor 0) + BandVectors.1 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = (1 + I) * W) → (TileCentroid (cert.P 2 false) - + TileCentroid (cert.P 1 true) = (1 / 2 : Real) • GaussianRealPoint (I ^ 3 * + (BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.1 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1))))))) ) := by + classical + intro q cfg C T cert I U W X cOff hX hc1p hc2m hsumVsecond + have ha : TileCentroid (cert.P 2 false) - TileCentroid (cert.P 1 true) = + -cOff U - cOff X := by + calc + _ = (TileCentroid (cert.P 2 false) - TileCentroid T) - + (TileCentroid (cert.P 1 true) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = _ := by rw [hc2m, hc1p] + rw [ha, hX, hsumVsecond] + dsimp [cOff, GaussianRealPoint, I, U, W] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem hC32 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let I : GaussianInt := ⟨0, 1⟩ + let U := BandVectors.1 (q 2) (q 1) + let W := BandVectors.1 (q 3) (q 2) + let X := BandVectors.1 (q 1) (q 3) + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + (X = -U - W) → ((TileCentroid (cert.P 1 false) - TileCentroid T = -cOff X) → + ((TileCentroid (cert.P 2 true) - TileCentroid T = cOff U) → ((BandVectors.1 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.1 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) = (1 + I) * W) → (TileCentroid + (cert.P 2 true) - TileCentroid (cert.P 1 false) = (1 / 2 : Real) • GaussianRealPoint + (I ^ 1 * (BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + + BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1))))))) ) := by + classical + intro q cfg C T cert I U W X cOff hX hc1m hc2p hsumVsecond + have ha : TileCentroid (cert.P 2 true) - TileCentroid (cert.P 1 false) = + cOff U + cOff X := by + calc + _ = (TileCentroid (cert.P 2 true) - TileCentroid T) - + (TileCentroid (cert.P 1 false) - TileCentroid T) := by + ext <;> dsimp <;> ring + _ = _ := by rw [hc2p, hc1m]; simp + rw [ha, hX, hsumVsecond] + dsimp [cOff, GaussianRealPoint, I, U, W] + norm_num [I, GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def, pow_succ]; ring; trivial + +private theorem slopeCoord : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + ∀ (a : GaussianInt), sOff a = (1 / 2 : Real) • GaussianRealPoint ((1 + I) * a) ) := by + classical + intro I sOff a + dsimp [sOff, P4250T1SlopeOffset, GaussianRealPoint, I] + norm_num [GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def]; ring; trivial + +private theorem hnegI3 : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + (I ^ 3 = -I) → ((-I : GaussianInt) ^ 3 = I) ) := by + classical + intro I hI3 + rw [neg_pow, hI3] + norm_num + +private theorem hS12 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (s0 : + Real × Real), + let I : GaussianInt := ⟨0, 1⟩ + let A := BandVectors.2 (q 2) (q 1) + let B := BandVectors.2 (q 3) (q 2) + let Y := BandVectors.2 (q 1) (q 3) + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + (I * I = -1) → ((sOff Y = -sOff A - sOff B) → ((BandVectors.2 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0) + BandVectors.2 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2) = (1 - I) * A) → ((∀ (a : GaussianInt), sOff a = (1 / 2 : + Real) • GaussianRealPoint ((1 + I) * a)) → (((-I : GaussianInt) ^ 3 = I) → ((s0 - + sOff Y) - (s0 + sOff B) = (1 / 2 : Real) • GaussianRealPoint ((-I) ^ 3 * + (BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2)))))))) ) := by + classical + intro q cfg s0 I A B Y sOff hImul sY hsumA12 slopeCoord hnegI3 + have hd : (s0 - sOff Y) - (s0 + sOff B) = sOff A := by + rw [sY] + ext <;> simp <;> ring + rw [hd, hsumA12, slopeCoord] + have hf : (-I) ^ 3 * ((1 - I) * A) = (1 + I) * A := by + rw [hnegI3] + rw [← mul_assoc, show I * (1 - I) = 1 + I by rw [mul_sub, hImul]; ring] + rw [hf] + +private theorem hS21 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (s0 : + Real × Real), + let I : GaussianInt := ⟨0, 1⟩ + let A := BandVectors.2 (q 2) (q 1) + let B := BandVectors.2 (q 3) (q 2) + let Y := BandVectors.2 (q 1) (q 3) + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + (I * I = -1) → ((sOff Y = -sOff A - sOff B) → ((∀ (z : GaussianInt), GaussianRealPoint + (-z) = -GaussianRealPoint z) → ((BandVectors.2 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0) + BandVectors.2 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2) = (1 - I) * A) → ((∀ (a : GaussianInt), sOff a = (1 / 2 : + Real) • GaussianRealPoint ((1 + I) * a)) → ((s0 + sOff Y) - (s0 - sOff B) = (1 / 2 : + Real) • GaussianRealPoint ((-I) ^ 1 * (BandVectors.2 (cfg.firstPredecessor 2) + (cfg.firstPredecessor 0) + BandVectors.2 (cfg.firstPredecessor 0) + (cfg.firstPredecessor 2)))))))) ) := by + classical + intro q cfg s0 I A B Y sOff hImul sY gaussianPointNeg hsumA12 slopeCoord + have hd : (s0 + sOff Y) - (s0 - sOff B) = -sOff A := by + rw [sY] + ext <;> simp + rw [hd, hsumA12, slopeCoord] + have hf : (-I : GaussianInt) ^ 1 * ((1 - I) * A) = -((1 + I) * A) := by + simp only [pow_one, neg_mul] + rw [← mul_assoc, show I * (1 - I) = 1 + I by rw [mul_sub, hImul]; ring] + rw [hf] + rw [gaussianPointNeg] + simp only [smul_neg] + +private theorem hS13 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (s0 : + Real × Real), + let I : GaussianInt := ⟨0, 1⟩ + let A := BandVectors.2 (q 2) (q 1) + let B := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + (∀ (a : GaussianInt), ∀ (b : GaussianInt), sOff (a + b) = sOff a + sOff b) → + ((BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = (1 - I) * (-I * (A + B))) → ((s0 + - sOff A) - (s0 + sOff B) = (1 / 2 : Real) • GaussianRealPoint ((-I) ^ 0 * + (BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3))))) ) := by + classical + intro q cfg s0 I A B sOff sadd hsumA03 + have hd : (s0 - sOff A) - (s0 + sOff B) = -sOff (A + B) := by + rw [sadd] + ext <;> simp <;> ring + rw [hd, hsumA03] + dsimp [sOff, P4250T1SlopeOffset, GaussianRealPoint, I] + norm_num [GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def]; ring; trivial + +private theorem hS31 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (s0 : + Real × Real), + let I : GaussianInt := ⟨0, 1⟩ + let A := BandVectors.2 (q 2) (q 1) + let B := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + (I ^ 2 = -1) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), sOff (a + b) = sOff a + sOff + b) → ((BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + + BandVectors.2 (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = (1 - I) * (-I * (A + + B))) → ((s0 + sOff A) - (s0 - sOff B) = (1 / 2 : Real) • GaussianRealPoint ((-I) ^ + 2 * (BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3)))))) ) := by + classical + intro q cfg s0 I A B sOff hI2 sadd hsumA03 + have hd : (s0 + sOff A) - (s0 - sOff B) = sOff (A + B) := by + rw [sadd] + ext <;> simp + rw [hd, hsumA03] + rw [show (-I : GaussianInt) ^ 2 = -1 by rw [neg_pow, hI2]; norm_num] + dsimp [sOff, P4250T1SlopeOffset, GaussianRealPoint, I] + norm_num [GaussianRealPoint, Prod.smul_mk, Prod.add_def, + Prod.sub_def]; ring; trivial + +private theorem hS23 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (s0 : + Real × Real), + let I : GaussianInt := ⟨0, 1⟩ + let A := BandVectors.2 (q 2) (q 1) + let B := BandVectors.2 (q 3) (q 2) + let Y := BandVectors.2 (q 1) (q 3) + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + (I * I = -1) → ((sOff Y = -sOff A - sOff B) → ((BandVectors.2 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = (1 - I) * B) → ((∀ (a : GaussianInt), sOff a = (1 / 2 : + Real) • GaussianRealPoint ((1 + I) * a)) → (((-I : GaussianInt) ^ 3 = I) → ((s0 - + sOff A) - (s0 + sOff Y) = (1 / 2 : Real) • GaussianRealPoint ((-I) ^ 3 * + (BandVectors.2 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.2 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1)))))))) ) := by + classical + intro q cfg s0 I A B Y sOff hImul sY hsumAsecond slopeCoord hnegI3 + have hd : (s0 - sOff A) - (s0 + sOff Y) = sOff B := by + rw [sY] + ext <;> simp <;> ring + rw [hd, hsumAsecond, slopeCoord] + have hf : (-I) ^ 3 * ((1 - I) * B) = (1 + I) * B := by + rw [hnegI3] + rw [← mul_assoc, show I * (1 - I) = 1 + I by rw [mul_sub, hImul]; ring] + rw [hf] + +private theorem hS32 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (s0 : + Real × Real), + let I : GaussianInt := ⟨0, 1⟩ + let A := BandVectors.2 (q 2) (q 1) + let B := BandVectors.2 (q 3) (q 2) + let Y := BandVectors.2 (q 1) (q 3) + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + (I * I = -1) → ((sOff Y = -sOff A - sOff B) → ((∀ (z : GaussianInt), GaussianRealPoint + (-z) = -GaussianRealPoint z) → ((BandVectors.2 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1) = (1 - I) * B) → ((∀ (a : GaussianInt), sOff a = (1 / 2 : + Real) • GaussianRealPoint ((1 + I) * a)) → ((s0 + sOff A) - (s0 - sOff Y) = (1 / 2 : + Real) • GaussianRealPoint ((-I) ^ 1 * (BandVectors.2 (cfg.secondPredecessor 1) + (cfg.secondPredecessor 0) + BandVectors.2 (cfg.secondPredecessor 0) + (cfg.secondPredecessor 1)))))))) ) := by + classical + intro q cfg s0 I A B Y sOff hImul sY gaussianPointNeg hsumAsecond slopeCoord + have hd : (s0 + sOff A) - (s0 - sOff Y) = -sOff B := by + rw [sY] + ext <;> simp <;> ring + rw [hd, hsumAsecond, slopeCoord] + have hf : (-I : GaussianInt) ^ 1 * ((1 - I) * B) = -((1 + I) * B) := by + simp only [pow_one, neg_mul] + rw [← mul_assoc, show I * (1 - I) = 1 + I by rw [mul_sub, hImul]; ring] + rw [hf] + rw [gaussianPointNeg] + simp only [smul_neg] + +private theorem adjAD : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (cert.P i s) (h i s)) → ( + let I : GaussianInt := ⟨0, 1⟩ + let B := BandVectors.2 (q 3) (q 2) + let Y := BandVectors.2 (q 1) (q 3) + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + ∀ (hpos : ∀ (i : Fin 3), 0 < (q i.succ).1), + let C1 : BandCircle := ⟨⟨q 1, Or.inl (hpos 0), q, cfg.proper.1, 1, rfl⟩, hpos 0⟩ + let C2 : BandCircle := ⟨⟨q 2, Or.inl (hpos 1), q, cfg.proper.1, 2, rfl⟩, hpos 1⟩ + (PartialOdometerSlope (h 0 true) = some (s0 + sOff B)) → ((PartialOdometerSlope (h 1 + false) = some (s0 - sOff Y)) → ((TileCentroid (cert.P 1 false) - TileCentroid (cert.P + 0 true) = (1 / 2 : Real) • GaussianRealPoint (I ^ 3 * (BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2)))) → (((s0 - sOff Y) - (s0 + sOff + B) = (1 / 2 : Real) • GaussianRealPoint ((-I) ^ 3 * (BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2)))) → (SubtileLatticeAdjacent C1 C2 + (cert.P 0 true) (cert.P 1 false) (h 0 true) (h 1 false)))))) ) := by + classical + intro q cfg C T cert h s0 ho I B Y sOff hpos C1 C2 hs0p hs1m hC12 hS12 + refine ⟨?_, ?_, ⟨s0 + sOff B, s0 - sOff Y, ?_, ?_, ?_⟩⟩ + · simpa [C1, cfg.firstChild] using ho 0 true + · simpa [C2, cfg.firstParentTwo] using ho 1 false + · exact hs0p + · exact hs1m + refine ⟨cfg.firstPredecessor, 1, 3, cfg.firstProper, ?_, ?_, hC12, ?_, ?_⟩ + · simpa [C1] using cfg.firstChild + · simpa [C2] using cfg.firstParentTwo + · exact congrArg Prod.fst hS12 + · exact congrArg Prod.snd hS12 + +private theorem adjBC : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (cert.P i s) (h i s)) → ( + let I : GaussianInt := ⟨0, 1⟩ + let B := BandVectors.2 (q 3) (q 2) + let Y := BandVectors.2 (q 1) (q 3) + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + ∀ (hpos : ∀ (i : Fin 3), 0 < (q i.succ).1), + let C1 : BandCircle := ⟨⟨q 1, Or.inl (hpos 0), q, cfg.proper.1, 1, rfl⟩, hpos 0⟩ + let C2 : BandCircle := ⟨⟨q 2, Or.inl (hpos 1), q, cfg.proper.1, 2, rfl⟩, hpos 1⟩ + (PartialOdometerSlope (h 0 false) = some (s0 - sOff B)) → ((PartialOdometerSlope (h 1 + true) = some (s0 + sOff Y)) → ((TileCentroid (cert.P 1 true) - TileCentroid (cert.P 0 + false) = (1 / 2 : Real) • GaussianRealPoint (I ^ 1 * (BandVectors.1 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2)))) → (((s0 + sOff Y) - (s0 - sOff + B) = (1 / 2 : Real) • GaussianRealPoint ((-I) ^ 1 * (BandVectors.2 + (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 2)))) → (SubtileLatticeAdjacent C1 C2 + (cert.P 0 false) (cert.P 1 true) (h 0 false) (h 1 true)))))) ) := by + classical + intro q cfg C T cert h s0 ho I B Y sOff hpos C1 C2 hs0m hs1p hC21 hS21 + refine ⟨?_, ?_, ⟨s0 - sOff B, s0 + sOff Y, ?_, ?_, ?_⟩⟩ + · simpa [C1, cfg.firstChild] using ho 0 false + · simpa [C2, cfg.firstParentTwo] using ho 1 true + · exact hs0m + · exact hs1p + refine ⟨cfg.firstPredecessor, 1, 1, cfg.firstProper, ?_, ?_, hC21, ?_, ?_⟩ + · simpa [C1] using cfg.firstChild + · simpa [C2] using cfg.firstParentTwo + · exact congrArg Prod.fst hS21 + · exact congrArg Prod.snd hS21 + +private theorem adjAF : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (cert.P i s) (h i s)) → ( + let I : GaussianInt := ⟨0, 1⟩ + let A := BandVectors.2 (q 2) (q 1) + let B := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + ∀ (hpos : ∀ (i : Fin 3), 0 < (q i.succ).1), + let C1 : BandCircle := ⟨⟨q 1, Or.inl (hpos 0), q, cfg.proper.1, 1, rfl⟩, hpos 0⟩ + let C3 : BandCircle := ⟨⟨q 3, Or.inl (hpos 2), q, cfg.proper.1, 3, rfl⟩, hpos 2⟩ + (PartialOdometerSlope (h 0 true) = some (s0 + sOff B)) → ((PartialOdometerSlope (h 2 + false) = some (s0 - sOff A)) → ((TileCentroid (cert.P 2 false) - TileCentroid (cert.P + 0 true) = (1 / 2 : Real) • GaussianRealPoint (I ^ 0 * (BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3)))) → (((s0 - sOff A) - (s0 + sOff + B) = (1 / 2 : Real) • GaussianRealPoint ((-I) ^ 0 * (BandVectors.2 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3)))) → (SubtileLatticeAdjacent C1 C3 + (cert.P 0 true) (cert.P 2 false) (h 0 true) (h 2 false)))))) ) := by + classical + intro q cfg C T cert h s0 ho I A B sOff hpos C1 C3 hs0p hs2m hC13 hS13 + refine ⟨?_, ?_, ⟨s0 + sOff B, s0 - sOff A, ?_, ?_, ?_⟩⟩ + · simpa [C1, cfg.firstChild] using ho 0 true + · simpa [C3, cfg.firstParentThree] using ho 2 false + · exact hs0p + · exact hs2m + refine ⟨cfg.firstPredecessor, 2, 0, cfg.firstProper, ?_, ?_, hC13, ?_, ?_⟩ + · simpa [C1] using cfg.firstChild + · simpa [C3] using cfg.firstParentThree + · exact congrArg Prod.fst hS13 + · exact congrArg Prod.snd hS13 + +private theorem adjBE : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (cert.P i s) (h i s)) → ( + let I : GaussianInt := ⟨0, 1⟩ + let A := BandVectors.2 (q 2) (q 1) + let B := BandVectors.2 (q 3) (q 2) + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + ∀ (hpos : ∀ (i : Fin 3), 0 < (q i.succ).1), + let C1 : BandCircle := ⟨⟨q 1, Or.inl (hpos 0), q, cfg.proper.1, 1, rfl⟩, hpos 0⟩ + let C3 : BandCircle := ⟨⟨q 3, Or.inl (hpos 2), q, cfg.proper.1, 3, rfl⟩, hpos 2⟩ + (PartialOdometerSlope (h 0 false) = some (s0 - sOff B)) → ((PartialOdometerSlope (h 2 + true) = some (s0 + sOff A)) → ((TileCentroid (cert.P 2 true) - TileCentroid (cert.P 0 + false) = (1 / 2 : Real) • GaussianRealPoint (I ^ 2 * (BandVectors.1 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.1 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3)))) → (((s0 + sOff A) - (s0 - sOff + B) = (1 / 2 : Real) • GaussianRealPoint ((-I) ^ 2 * (BandVectors.2 + (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + BandVectors.2 + (cfg.firstPredecessor 0) (cfg.firstPredecessor 3)))) → (SubtileLatticeAdjacent C1 C3 + (cert.P 0 false) (cert.P 2 true) (h 0 false) (h 2 true)))))) ) := by + classical + intro q cfg C T cert h s0 ho I A B sOff hpos C1 C3 hs0m hs2p hC31 hS31 + refine ⟨?_, ?_, ⟨s0 - sOff B, s0 + sOff A, ?_, ?_, ?_⟩⟩ + · simpa [C1, cfg.firstChild] using ho 0 false + · simpa [C3, cfg.firstParentThree] using ho 2 true + · exact hs0m + · exact hs2p + refine ⟨cfg.firstPredecessor, 2, 2, cfg.firstProper, ?_, ?_, hC31, ?_, ?_⟩ + · simpa [C1] using cfg.firstChild + · simpa [C3] using cfg.firstParentThree + · exact congrArg Prod.fst hS31 + · exact congrArg Prod.snd hS31 + +private theorem adjCF : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (cert.P i s) (h i s)) → ( + let I : GaussianInt := ⟨0, 1⟩ + let A := BandVectors.2 (q 2) (q 1) + let Y := BandVectors.2 (q 1) (q 3) + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + ∀ (hpos : ∀ (i : Fin 3), 0 < (q i.succ).1), + let C2 : BandCircle := ⟨⟨q 2, Or.inl (hpos 1), q, cfg.proper.1, 2, rfl⟩, hpos 1⟩ + let C3 : BandCircle := ⟨⟨q 3, Or.inl (hpos 2), q, cfg.proper.1, 3, rfl⟩, hpos 2⟩ + (PartialOdometerSlope (h 1 true) = some (s0 + sOff Y)) → ((PartialOdometerSlope (h 2 + false) = some (s0 - sOff A)) → ((TileCentroid (cert.P 2 false) - TileCentroid (cert.P + 1 true) = (1 / 2 : Real) • GaussianRealPoint (I ^ 3 * (BandVectors.1 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.1 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1)))) → (((s0 - sOff A) - (s0 + sOff + Y) = (1 / 2 : Real) • GaussianRealPoint ((-I) ^ 3 * (BandVectors.2 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.2 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1)))) → (SubtileLatticeAdjacent C2 + C3 (cert.P 1 true) (cert.P 2 false) (h 1 true) (h 2 false)))))) ) := by + classical + intro q cfg C T cert h s0 ho I A Y sOff hpos C2 C3 hs1p hs2m hC23 hS23 + refine ⟨?_, ?_, ⟨s0 + sOff Y, s0 - sOff A, ?_, ?_, ?_⟩⟩ + · simpa [C2, cfg.firstParentTwo, cfg.secondChild] using ho 1 true + · simpa [C3, cfg.firstParentThree, cfg.secondParentOne] using ho 2 false + · exact hs1p + · exact hs2m + refine ⟨cfg.secondPredecessor, 0, 3, cfg.secondProper, ?_, ?_, hC23, ?_, ?_⟩ + · simpa [C2] using cfg.secondChild + · simpa [C3] using cfg.secondParentOne + · exact congrArg Prod.fst hS23 + · exact congrArg Prod.snd hS23 + +private theorem adjDE : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (cert.P i s) (h i s)) → ( + let I : GaussianInt := ⟨0, 1⟩ + let A := BandVectors.2 (q 2) (q 1) + let Y := BandVectors.2 (q 1) (q 3) + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + ∀ (hpos : ∀ (i : Fin 3), 0 < (q i.succ).1), + let C2 : BandCircle := ⟨⟨q 2, Or.inl (hpos 1), q, cfg.proper.1, 2, rfl⟩, hpos 1⟩ + let C3 : BandCircle := ⟨⟨q 3, Or.inl (hpos 2), q, cfg.proper.1, 3, rfl⟩, hpos 2⟩ + (PartialOdometerSlope (h 1 false) = some (s0 - sOff Y)) → ((PartialOdometerSlope (h 2 + true) = some (s0 + sOff A)) → ((TileCentroid (cert.P 2 true) - TileCentroid (cert.P 1 + false) = (1 / 2 : Real) • GaussianRealPoint (I ^ 1 * (BandVectors.1 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.1 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1)))) → (((s0 + sOff A) - (s0 - sOff + Y) = (1 / 2 : Real) • GaussianRealPoint ((-I) ^ 1 * (BandVectors.2 + (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + BandVectors.2 + (cfg.secondPredecessor 0) (cfg.secondPredecessor 1)))) → (SubtileLatticeAdjacent C2 + C3 (cert.P 1 false) (cert.P 2 true) (h 1 false) (h 2 true)))))) ) := by + classical + intro q cfg C T cert h s0 ho I A Y sOff hpos C2 C3 hs1m hs2p hC32 hS32 + refine ⟨?_, ?_, ⟨s0 - sOff Y, s0 + sOff A, ?_, ?_, ?_⟩⟩ + · simpa [C2, cfg.firstParentTwo, cfg.secondChild] using ho 1 false + · simpa [C3, cfg.firstParentThree, cfg.secondParentOne] using ho 2 true + · exact hs1m + · exact hs2p + refine ⟨cfg.secondPredecessor, 0, 1, cfg.secondProper, ?_, ?_, hC32, ?_, ?_⟩ + · simpa [C2] using cfg.secondChild + · simpa [C3] using cfg.secondParentOne + · exact congrArg Prod.fst hS32 + · exact congrArg Prod.snd hS32 + +private theorem compatSelf : + (by + classical + exact + ∀ (a : PartialOdometer), OdometerCompatibility a a ) := by + classical + intro a + right + refine ⟨0, ?_⟩ + intro x hx hx' + simp + +private theorem compatSymm : + (by + classical + exact + ∀ {a : PartialOdometer}, ∀ {b : PartialOdometer}, (OdometerCompatibility a b) → + (OdometerCompatibility b a) ) := by + classical + intro a b hab + rcases hab with hdis | ⟨c, hc⟩ + · exact Or.inl hdis.symm + · right + refine ⟨-c, ?_⟩ + intro x hx hx' + have := hc x hx' hx + linarith + +private theorem smallCompat : + (by + classical + exact + ∀ (a : PartialOdometer), ∀ (b : PartialOdometer), (((a.domain : Set GaussianInt) ∩ + (b.domain : Set GaussianInt)).Subsingleton) → (OdometerCompatibility a b) ) := by + classical + intro a b hs + by_cases hn : ((a.domain : Set GaussianInt) ∩ (b.domain : Set GaussianInt)).Nonempty + · rcases hn with ⟨x, ha, hb⟩ + right + refine ⟨b.value x - a.value x, ?_⟩ + intro y hy hy' + have hxy : y = x := hs ⟨hy, hy'⟩ ⟨ha, hb⟩ + subst y + rfl + · left + rw [Set.not_nonempty_iff_eq_empty] at hn + exact Set.disjoint_iff_inter_eq_empty.mpr hn + +private theorem hraw : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ a b : PeriodicSubtileIndex, a ≠ b → (¬ AllowedSubtileIncidence a b → + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b)).Subsingleton) ) := by + classical + intro q cfg C T cert a b hab + exact (BandOriginalOccurrenceIntersectionClassification q cfg C T cert a b hab).2 + +private theorem htransZero : + (by + classical + exact + ∀ (Z : ProtoTile), TileTranslation Z 0 = Z ) := by + classical + intro Z + cases Z with + | mk cells anchor => + change ProtoTile.mk (cells.image (fun x => x + 0)) (GaussianTranslation 0 anchor) = + ProtoTile.mk cells anchor + apply congrArg₂ ProtoTile.mk + · simp [] + · simp [GaussianTranslation] + +private theorem noAE : + (by + classical + exact + let ia : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let ie : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a b) + → (¬ ((a = ia ∧ b = ie) ∨ (a = ie ∧ b = ia))) ) := by + classical + intro ia ie a b hab + induction hab + case symm hab ih => + intro hbad + apply ih + simpa [or_comm, and_comm] using hbad + all_goals + intro hbad + simp [ia, ie] at hbad + all_goals omega + +private theorem noBF : + (by + classical + exact + let ib : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let iff : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a b) + → (¬ ((a = ib ∧ b = iff) ∨ (a = iff ∧ b = ib))) ) := by + classical + intro ib iff a b hab + induction hab + case symm hab ih => + intro hbad + apply ih + simpa [or_comm, and_comm] using hbad + all_goals + intro hbad + simp [ib, iff] at hbad + all_goals omega + +private theorem noCD : + (by + classical + exact + let ic : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let id : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a b) + → (¬ ((a = ic ∧ b = id) ∨ (a = id ∧ b = ic))) ) := by + classical + intro ic id a b hab + induction hab + case symm hab ih => + intro hbad + apply ih + simpa [or_comm, and_comm] using hbad + all_goals + intro hbad + simp [ic, id] at hbad + all_goals omega + +private theorem noEF : + (by + classical + exact + let ie : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + let iff : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a b) + → (¬ ((a = ie ∧ b = iff) ∨ (a = iff ∧ b = ie))) ) := by + classical + intro ie iff a b hab + induction hab + case symm hab ih => + intro hbad + apply ih + simpa [or_comm, and_comm] using hbad + all_goals + intro hbad + simp [ie, iff] at hbad + +private theorem noCE : + (by + classical + exact + let ic : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let ie : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a b) + → (¬ ((a = ic ∧ b = ie) ∨ (a = ie ∧ b = ic))) ) := by + classical + intro ic ie a b hab + induction hab + case symm hab ih => + intro hbad + apply ih + simpa [or_comm, and_comm] using hbad + all_goals + intro hbad + simp [ic, ie] at hbad + all_goals omega + +private theorem noDF : + (by + classical + exact + let id : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + let iff : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a b) + → (¬ ((a = id ∧ b = iff) ∨ (a = iff ∧ b = id))) ) := by + classical + intro id iff a b hab + induction hab + case symm hab ih => + intro hbad + apply ih + simpa [or_comm, and_comm] using hbad + all_goals + intro hbad + simp [id, iff] at hbad + all_goals omega + +private theorem nAE : + (by + classical + exact + let ia : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let ie : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a + b) → (¬ ((a = ia ∧ b = ie) ∨ (a = ie ∧ b = ia)))) → (¬ AllowedSubtileIncidence ia ie) + ) := by + classical + intro ia ie noAE hab + exact noAE ia ie hab (Or.inl ⟨rfl, rfl⟩) + +private theorem nBF : + (by + classical + exact + let ib : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let iff : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a + b) → (¬ ((a = ib ∧ b = iff) ∨ (a = iff ∧ b = ib)))) → (¬ AllowedSubtileIncidence ib + iff) ) := by + classical + intro ib iff noBF hab + exact noBF ib iff hab (Or.inl ⟨rfl, rfl⟩) + +private theorem nCD : + (by + classical + exact + let ic : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let id : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a + b) → (¬ ((a = ic ∧ b = id) ∨ (a = id ∧ b = ic)))) → (¬ AllowedSubtileIncidence ic id) + ) := by + classical + intro ic id noCD hab + exact noCD ic id hab (Or.inl ⟨rfl, rfl⟩) + +private theorem nEF : + (by + classical + exact + let ie : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + let iff : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a + b) → (¬ ((a = ie ∧ b = iff) ∨ (a = iff ∧ b = ie)))) → (¬ AllowedSubtileIncidence ie + iff) ) := by + classical + intro ie iff noEF hab + exact noEF ie iff hab (Or.inl ⟨rfl, rfl⟩) + +private theorem nCE : + (by + classical + exact + let ic : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let ie : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a + b) → (¬ ((a = ic ∧ b = ie) ∨ (a = ie ∧ b = ic)))) → (¬ AllowedSubtileIncidence ic ie) + ) := by + classical + intro ic ie noCE hab + exact noCE ic ie hab (Or.inl ⟨rfl, rfl⟩) + +private theorem nDF : + (by + classical + exact + let id : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + let iff : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (AllowedSubtileIncidence a + b) → (¬ ((a = id ∧ b = iff) ∨ (a = iff ∧ b = id)))) → (¬ AllowedSubtileIncidence id + iff) ) := by + classical + intro id iff noDF hab + exact noDF id iff hab (Or.inl ⟨rfl, rfl⟩) + +private theorem smallAE : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), (∀ (i : Fin 3), ∀ (e : Bool), (h i + e).domain = FootprintVertices (cert.P i e)) → ( + let ia : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let ie : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ia = cert.P 0 true) → + ((SubtileOccurrenceInterpretation cert.P cert.u cert.v ie = cert.P 2 true) → + ((FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v ia) ∩ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v ie) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v ia) ∩ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + ie)).Subsingleton) → ((((h 0 true).domain : Set GaussianInt) ∩ (h 2 + true).domain).Subsingleton)))) ) := by + classical + intro q cfg C T cert h hdomain ia ie occA occE rawAE + rcases rawAE with he | hs + · rw [occA, occE] at he + rw [hdomain 0 true, hdomain 2 true, he] + exact Set.subsingleton_empty + · rw [occA, occE] at hs + simpa [hdomain 0 true, hdomain 2 true] using hs + +private theorem smallBF : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), (∀ (i : Fin 3), ∀ (e : Bool), (h i + e).domain = FootprintVertices (cert.P i e)) → ( + let ib : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let iff : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ib = cert.P 0 false) → + ((SubtileOccurrenceInterpretation cert.P cert.u cert.v iff = cert.P 2 false) → + ((FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v ib) ∩ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v iff) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v ib) ∩ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + iff)).Subsingleton) → ((((h 0 false).domain : Set GaussianInt) ∩ (h 2 + false).domain).Subsingleton)))) ) := by + classical + intro q cfg C T cert h hdomain ib iff occB occF rawBF + rcases rawBF with he | hs + · rw [occB, occF] at he + rw [hdomain 0 false, hdomain 2 false, he] + exact Set.subsingleton_empty + · rw [occB, occF] at hs + simpa [hdomain 0 false, hdomain 2 false] using hs + +private theorem smallCD : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), (∀ (i : Fin 3), ∀ (e : Bool), (h i + e).domain = FootprintVertices (cert.P i e)) → ( + let ic : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let id : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ic = cert.P 1 true) → + ((SubtileOccurrenceInterpretation cert.P cert.u cert.v id = cert.P 1 false) → + ((FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v ic) ∩ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v id) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v ic) ∩ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + id)).Subsingleton) → ((((h 1 true).domain : Set GaussianInt) ∩ (h 1 + false).domain).Subsingleton)))) ) := by + classical + intro q cfg C T cert h hdomain ic id occC occD rawCD + rcases rawCD with he | hs + · rw [occC, occD] at he + rw [hdomain 1 true, hdomain 1 false, he] + exact Set.subsingleton_empty + · rw [occC, occD] at hs + simpa [hdomain 1 true, hdomain 1 false] using hs + +private theorem smallEF : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), (∀ (i : Fin 3), ∀ (e : Bool), (h i + e).domain = FootprintVertices (cert.P i e)) → ( + let ie : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + let iff : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ie = cert.P 2 true) → + ((SubtileOccurrenceInterpretation cert.P cert.u cert.v iff = cert.P 2 false) → + ((FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v ie) ∩ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v iff) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v ie) ∩ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + iff)).Subsingleton) → ((((h 2 true).domain : Set GaussianInt) ∩ (h 2 + false).domain).Subsingleton)))) ) := by + classical + intro q cfg C T cert h hdomain ie iff occE occF rawEF + rcases rawEF with he | hs + · rw [occE, occF] at he + rw [hdomain 2 true, hdomain 2 false, he] + exact Set.subsingleton_empty + · rw [occE, occF] at hs + simpa [hdomain 2 true, hdomain 2 false] using hs + +private theorem smallCE : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), (∀ (i : Fin 3), ∀ (e : Bool), (h i + e).domain = FootprintVertices (cert.P i e)) → ( + let ic : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let ie : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v ic = cert.P 1 true) → + ((SubtileOccurrenceInterpretation cert.P cert.u cert.v ie = cert.P 2 true) → + ((FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v ic) ∩ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v ie) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v ic) ∩ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + ie)).Subsingleton) → ((((h 1 true).domain : Set GaussianInt) ∩ (h 2 + true).domain).Subsingleton)))) ) := by + classical + intro q cfg C T cert h hdomain ic ie occC occE rawCE + rcases rawCE with he | hs + · rw [occC, occE] at he + rw [hdomain 1 true, hdomain 2 true, he] + exact Set.subsingleton_empty + · rw [occC, occE] at hs + simpa [hdomain 1 true, hdomain 2 true] using hs + +private theorem smallDF : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), (∀ (i : Fin 3), ∀ (e : Bool), (h i + e).domain = FootprintVertices (cert.P i e)) → ( + let id : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + let iff : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v id = cert.P 1 false) → + ((SubtileOccurrenceInterpretation cert.P cert.u cert.v iff = cert.P 2 false) → + ((FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v id) ∩ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v iff) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v id) ∩ + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + iff)).Subsingleton) → ((((h 1 false).domain : Set GaussianInt) ∩ (h 2 + false).domain).Subsingleton)))) ) := by + classical + intro q cfg C T cert h hdomain id iff occD occF rawDF + rcases rawDF with he | hs + · rw [occD, occF] at he + rw [hdomain 1 false, hdomain 2 false, he] + exact Set.subsingleton_empty + · rw [occD, occF] at hs + simpa [hdomain 1 false, hdomain 2 false] using hs + +end OrdinaryCompatibilityGeometry + +theorem P4250T1OrdinaryCompatibility + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (h : Fin 3 → Bool → PartialOdometer) (s0 : Real × Real) + (ho : ∀ i s, TileOdometer (q i.succ) (cert.P i s) (h i s)) + (hp : ∀ i s, PartialOdometerSlope (h i s) = some + (s0 + (if s = true then (1 : Real) else -1) • + P4250T1SlopeOffset + (BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ))))) : + ∀ i s j t, + ¬ ((i = 0 ∧ j = 0 ∧ s ≠ t) ∨ + (((i = 0 ∧ j = 1) ∨ (i = 1 ∧ j = 0)) ∧ s = t)) → + OdometerCompatibility (h i s) (h j t) := by +-- BODY + classical + let I : GaussianInt := ⟨0, 1⟩ + let U := BandVectors.1 (q 2) (q 1) + let W := BandVectors.1 (q 3) (q 2) + let A := BandVectors.2 (q 2) (q 1) + let B := BandVectors.2 (q 3) (q 2) + let X := BandVectors.1 (q 1) (q 3) + let Y := BandVectors.2 (q 1) (q 3) + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let sOff (z : GaussianInt) : Real × Real := P4250T1SlopeOffset z + have hImul : I * I = -1 := OrdinaryCompatibilityGeometry.hImul + have hI2 : I ^ 2 = -1 := by rw [pow_two, hImul] + have laws := VectorRecursionLaws q cfg.proper.1 + have firstLaws := VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1 + have secondLaws := VectorRecursionLaws cfg.secondPredecessor cfg.secondProper.1 + have hX := OrdinaryCompatibilityGeometry.hX q laws + have hpos := OrdinaryCompatibilityGeometry.hpos q cfg + let C1 : BandCircle := ⟨⟨q 1, Or.inl (hpos 0), q, cfg.proper.1, 1, rfl⟩, hpos 0⟩ + let C2 : BandCircle := ⟨⟨q 2, Or.inl (hpos 1), q, cfg.proper.1, 2, rfl⟩, hpos 1⟩ + let C3 : BandCircle := ⟨⟨q 3, Or.inl (hpos 2), q, cfg.proper.1, 3, rfl⟩, hpos 2⟩ + have cent (i : Fin 3) (e : Bool) : + TileCentroid (cert.P i e) - TileCentroid T = + (if e then (1 : Real) else -1) • + cOff (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) := + (OrdinaryCompatibilityGeometry.occCent) q T (cert.P i e) i e (cert.outer_occurrence i e) + have hc0p : TileCentroid (cert.P 0 true) - TileCentroid T = cOff W := by + simpa [Fin.add_def, W] using cent 0 true + have hc0m : TileCentroid (cert.P 0 false) - TileCentroid T = -cOff W := by + simpa [Fin.add_def, W] using cent 0 false + have hc1p : TileCentroid (cert.P 1 true) - TileCentroid T = cOff X := by + simpa [Fin.add_def, X] using cent 1 true + have hc1m : TileCentroid (cert.P 1 false) - TileCentroid T = -cOff X := by + simpa [Fin.add_def, X] using cent 1 false + have hc2p : TileCentroid (cert.P 2 true) - TileCentroid T = cOff U := by + simpa [Fin.add_def, U] using cent 2 true + have hc2m : TileCentroid (cert.P 2 false) - TileCentroid T = -cOff U := by + simpa [Fin.add_def, U] using cent 2 false + have slope (i : Fin 3) (e : Bool) : + PartialOdometerSlope (h i e) = some + (s0 + (if e then (1 : Real) else -1) • + sOff (BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)))) := + OrdinaryCompatibilityGeometry.slope q h s0 hp i e + have hs0p : PartialOdometerSlope (h 0 true) = some (s0 + sOff B) := by + simpa [Fin.add_def, B, sOff] using slope 0 true + have hs0m : PartialOdometerSlope (h 0 false) = some (s0 - sOff B) := by + simpa [Fin.add_def, B, sOff, sub_eq_add_neg, smul_eq_mul] using slope 0 false + have hs1p : PartialOdometerSlope (h 1 true) = some (s0 + sOff Y) := by + simpa [Fin.add_def, Y, sOff] using slope 1 true + have hs1m : PartialOdometerSlope (h 1 false) = some (s0 - sOff Y) := by + simpa [Fin.add_def, Y, sOff, sub_eq_add_neg, smul_eq_mul] using slope 1 false + have hs2p : PartialOdometerSlope (h 2 true) = some (s0 + sOff A) := by + simpa [Fin.add_def, A, sOff] using slope 2 true + have hs2m : PartialOdometerSlope (h 2 false) = some (s0 - sOff A) := by + simpa [Fin.add_def, A, sOff, sub_eq_add_neg, smul_eq_mul] using slope 2 false + have cadd := OrdinaryCompatibilityGeometry.cadd + have cneg := OrdinaryCompatibilityGeometry.cneg + have sadd (a b : GaussianInt) : sOff (a + b) = sOff a + sOff b := by + apply Prod.ext <;> simp [sOff, P4250T1SlopeOffset] <;> ring + have sneg (a : GaussianInt) : sOff (-a) = -sOff a := by + apply Prod.ext <;> simp [sOff, P4250T1SlopeOffset] <;> ring + have sY := OrdinaryCompatibilityGeometry.sY q (OrdinaryCompatibilityGeometry.hY q laws) sadd sneg + have gaussianPointNeg := OrdinaryCompatibilityGeometry.gaussianPointNeg + have hV20 := OrdinaryCompatibilityGeometry.hV20 q cfg + have hflip12 := firstLaws.2.2.2.2 cfg.firstProper 1 + have hsumV12 := OrdinaryCompatibilityGeometry.hsumV12 q cfg hV20 + (OrdinaryCompatibilityGeometry.hflip120 q cfg hV20 hflip12) + have hflip03 := firstLaws.2.2.2.2 cfg.firstProper 2 + have hsumV03 := OrdinaryCompatibilityGeometry.hsumV03 q cfg hImul + (OrdinaryCompatibilityGeometry.hV30 q cfg hImul firstLaws + (OrdinaryCompatibilityGeometry.hV21 q cfg hV20)) hflip03 + have hflipSecond := secondLaws.2.2.2.2 cfg.secondProper 0 + have hsumVsecond := OrdinaryCompatibilityGeometry.hsumVsecond q cfg hflipSecond + have hsumA12 := OrdinaryCompatibilityGeometry.hsumA12 q cfg hflip12 + have hsumAsecond := OrdinaryCompatibilityGeometry.hsumAsecond q cfg hflipSecond + have hsumA03 := OrdinaryCompatibilityGeometry.hsumA03 q cfg hImul + (OrdinaryCompatibilityGeometry.hA30 q cfg hImul (OrdinaryCompatibilityGeometry.hrot2A q + cfg) (OrdinaryCompatibilityGeometry.hA13 q cfg firstLaws + (OrdinaryCompatibilityGeometry.hA21global q cfg (OrdinaryCompatibilityGeometry.hrotAglobal + q cfg)))) (OrdinaryCompatibilityGeometry.hflip03A q cfg hflip03) + have slopeCoord := OrdinaryCompatibilityGeometry.slopeCoord + have hnegI3 := OrdinaryCompatibilityGeometry.hnegI3 (OrdinaryCompatibilityGeometry.hI3 hI2) + have dompos (i : Fin 3) : 0 < (q i.succ).1 := hpos i + have circleEq1 : C1.1.1 = q 1 := rfl + have circleEq2 : C2.1.1 = q 2 := rfl + have circleEq3 : C3.1.1 = q 3 := rfl + have compatSelf (a : PartialOdometer) : OdometerCompatibility a a := + OrdinaryCompatibilityGeometry.compatSelf a + have compatSymm {a b : PartialOdometer} (hab : OdometerCompatibility a b) := + OrdinaryCompatibilityGeometry.compatSymm (a := a) (b := b) hab + have smallCompat := OrdinaryCompatibilityGeometry.smallCompat + have ord1 : OdometerCompatibility (h 0 true) (h 1 false) := + (RightSubtileOdometerCompatibility.2 C1 C2 (cert.P 0 true) + (cert.P 1 false) (h 0 true) (h 1 false) (OrdinaryCompatibilityGeometry.adjAD q cfg C T cert + h s0 ho hpos hs0p hs1m (OrdinaryCompatibilityGeometry.hC12 q cfg C T cert hX hc0p hc1m + hsumV12) (OrdinaryCompatibilityGeometry.hS12 q cfg s0 hImul sY hsumA12 slopeCoord + hnegI3))) + have ord2 : OdometerCompatibility (h 0 false) (h 1 true) := + (RightSubtileOdometerCompatibility.2 C1 C2 (cert.P 0 false) + (cert.P 1 true) (h 0 false) (h 1 true) (OrdinaryCompatibilityGeometry.adjBC q cfg C T cert + h s0 ho hpos hs0m hs1p (OrdinaryCompatibilityGeometry.hC21 q cfg C T cert hX hc0m hc1p + hsumV12) (OrdinaryCompatibilityGeometry.hS21 q cfg s0 hImul sY gaussianPointNeg hsumA12 + slopeCoord))) + have ord3 : OdometerCompatibility (h 0 true) (h 2 false) := + (RightSubtileOdometerCompatibility.2 C1 C3 (cert.P 0 true) + (cert.P 2 false) (h 0 true) (h 2 false) (OrdinaryCompatibilityGeometry.adjAF q cfg C T cert + h s0 ho hpos hs0p hs2m (OrdinaryCompatibilityGeometry.hC13 q cfg C T cert hc0p hc2m + hsumV03) (OrdinaryCompatibilityGeometry.hS13 q cfg s0 sadd hsumA03))) + have ord4 : OdometerCompatibility (h 0 false) (h 2 true) := + (RightSubtileOdometerCompatibility.2 C1 C3 (cert.P 0 false) + (cert.P 2 true) (h 0 false) (h 2 true) (OrdinaryCompatibilityGeometry.adjBE q cfg C T cert + h s0 ho hpos hs0m hs2p (OrdinaryCompatibilityGeometry.hC31 q cfg C T cert hc0m hc2p + hsumV03) (OrdinaryCompatibilityGeometry.hS31 q cfg s0 hI2 sadd hsumA03))) + have ord5 : OdometerCompatibility (h 1 true) (h 2 false) := + (RightSubtileOdometerCompatibility.2 C2 C3 (cert.P 1 true) + (cert.P 2 false) (h 1 true) (h 2 false) (OrdinaryCompatibilityGeometry.adjCF q cfg C T cert + h s0 ho hpos hs1p hs2m (OrdinaryCompatibilityGeometry.hC23 q cfg C T cert hX hc1p hc2m + hsumVsecond) (OrdinaryCompatibilityGeometry.hS23 q cfg s0 hImul sY hsumAsecond + slopeCoord hnegI3))) + have ord6 : OdometerCompatibility (h 1 false) (h 2 true) := + (RightSubtileOdometerCompatibility.2 C2 C3 (cert.P 1 false) + (cert.P 2 true) (h 1 false) (h 2 true) (OrdinaryCompatibilityGeometry.adjDE q cfg C T cert + h s0 ho hpos hs1m hs2p (OrdinaryCompatibilityGeometry.hC32 q cfg C T cert hX hc1m hc2p + hsumVsecond) (OrdinaryCompatibilityGeometry.hS32 q cfg s0 hImul sY gaussianPointNeg + hsumAsecond slopeCoord))) + have ord1r : OdometerCompatibility (h 1 false) (h 0 true) := compatSymm ord1 + have ord2r : OdometerCompatibility (h 1 true) (h 0 false) := compatSymm ord2 + have ord3r : OdometerCompatibility (h 2 false) (h 0 true) := compatSymm ord3 + have ord4r : OdometerCompatibility (h 2 true) (h 0 false) := compatSymm ord4 + have ord5r : OdometerCompatibility (h 2 false) (h 1 true) := compatSymm ord5 + have ord6r : OdometerCompatibility (h 2 true) (h 1 false) := compatSymm ord6 + have hraw := OrdinaryCompatibilityGeometry.hraw q cfg C T cert + have hdomain (i : Fin 3) (e : Bool) : + (h i e).domain = FootprintVertices (cert.P i e) := + PositiveCurvatureTileOdometerDomain (q i.succ) (cert.P i e) (h i e) (hpos i) + (ho i e) + have htransZero (Z : ProtoTile) : TileTranslation Z 0 = Z := + OrdinaryCompatibilityGeometry.htransZero Z + let ia : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let ib : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let ic : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let id : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + let ie : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + let iff : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + have occA : SubtileOccurrenceInterpretation cert.P cert.u cert.v ia = cert.P 0 true := by + simp [SubtileOccurrenceInterpretation, ia, htransZero] + have occB : SubtileOccurrenceInterpretation cert.P cert.u cert.v ib = cert.P 0 false := by + simp [SubtileOccurrenceInterpretation, ib, htransZero] + have occC : SubtileOccurrenceInterpretation cert.P cert.u cert.v ic = cert.P 1 true := by + simp [SubtileOccurrenceInterpretation, ic, htransZero] + have occD : SubtileOccurrenceInterpretation cert.P cert.u cert.v id = cert.P 1 false := by + simp [SubtileOccurrenceInterpretation, id, htransZero] + have occE : SubtileOccurrenceInterpretation cert.P cert.u cert.v ie = cert.P 2 true := by + simp [SubtileOccurrenceInterpretation, ie, htransZero] + have occF : SubtileOccurrenceInterpretation cert.P cert.u cert.v iff = cert.P 2 false := by + simp [SubtileOccurrenceInterpretation, iff, htransZero] + have rawAE := hraw ia ie (by decide) (OrdinaryCompatibilityGeometry.nAE + (OrdinaryCompatibilityGeometry.noAE)) + have rawBF := hraw ib iff (by decide) (OrdinaryCompatibilityGeometry.nBF + (OrdinaryCompatibilityGeometry.noBF)) + have rawCD := hraw ic id (by decide) (OrdinaryCompatibilityGeometry.nCD + (OrdinaryCompatibilityGeometry.noCD)) + have rawEF := hraw ie iff (by decide) (OrdinaryCompatibilityGeometry.nEF + (OrdinaryCompatibilityGeometry.noEF)) + have rawCE := hraw ic ie (by decide) (OrdinaryCompatibilityGeometry.nCE + (OrdinaryCompatibilityGeometry.noCE)) + have rawDF := hraw id iff (by decide) (OrdinaryCompatibilityGeometry.nDF + (OrdinaryCompatibilityGeometry.noDF)) + have compatAE := smallCompat (h 0 true) (h 2 true) (OrdinaryCompatibilityGeometry.smallAE q cfg + C T cert h hdomain occA occE rawAE) + have compatBF := smallCompat (h 0 false) (h 2 false) (OrdinaryCompatibilityGeometry.smallBF q + cfg C T cert h hdomain occB occF rawBF) + have compatCD := smallCompat (h 1 true) (h 1 false) (OrdinaryCompatibilityGeometry.smallCD q + cfg C T cert h hdomain occC occD rawCD) + have compatEF := smallCompat (h 2 true) (h 2 false) (OrdinaryCompatibilityGeometry.smallEF q + cfg C T cert h hdomain occE occF rawEF) + have compatCE := smallCompat (h 1 true) (h 2 true) (OrdinaryCompatibilityGeometry.smallCE q cfg + C T cert h hdomain occC occE rawCE) + have compatDF := smallCompat (h 1 false) (h 2 false) (OrdinaryCompatibilityGeometry.smallDF q + cfg C T cert h hdomain occD occF rawDF) + have compatAEr := compatSymm compatAE + have compatBFr := compatSymm compatBF + have compatCDr := compatSymm compatCD + have compatEFr := compatSymm compatEF + have compatCEr := compatSymm compatCE + have compatDFr := compatSymm compatDF + intro i s j t hnot + fin_cases i <;> fin_cases j <;> cases s <;> cases t + all_goals simp at hnot + all_goals first | assumption | exact compatSelf _ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1ParentSlopePhase.lean b/LeanPool/ApollonianSuperharmonic/P4250T1ParentSlopePhase.lean new file mode 100644 index 0000000000..72d4986418 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4250T1ParentSlopePhase.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4250T1SlopeOffset +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn + +-- [TABLET NODE: P4250T1ParentSlopePhase] + +/-! +# P4250T1ParentSlopePhase + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4250T1ParentSlopePhase + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (U : Fin 3 → ProtoTile) (h : Fin 3 → PartialOdometer) + (p : Fin 3 → Real × Real) (a : GaussianInt) + (ho : ∀ i, TileOdometer (q i.succ) (U i) (h i)) + (hp : ∀ i, PartialOdometerSlope (h i) = some (p i)) + (ha : (2 : Real) • p 0 = GaussianRealPoint a) : + ∃ (s0 : Real × Real) (b : GaussianInt) (z : Fin 3 → GaussianInt), + (2 : Real) • s0 = GaussianRealPoint b ∧ + ∀ i, p i = s0 + + P4250T1SlopeOffset + (BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ))) + + GaussianRealPoint (z i) := by +-- BODY + classical + have positive (i : Fin 3) : 0 < (q i.succ).1 := by + have := (ProperBandCurvatureStructure q cfg.proper).2.1 i + have := cfg.noLine i.succ + omega + have compare (i : Fin 3) (V : ProtoTile) (k : PartialOdometer) (pk : Real × Real) + (hk : TileOdometer (q i.succ) V k) (hpk : PartialOdometerSlope k = some pk) : + ∃ z : GaussianInt, p i = pk + GaussianRealPoint z := by + obtain ⟨u, ⟨_, _, a, b, hd, hv⟩, _⟩ := + TileOdometerTranslationUniqueness _ (U i) V (h i) k (positive i) (ho i) hk + have hdeq : (h i).domain = (PartialOdometerAffineTranslate k u a b).domain := by + ext x + rw [(PartialOdometerAffineTranslateFormulas k u a b).2.1] + exact hd x + have hveq : (h i).value = (PartialOdometerAffineTranslate k u a b).value := by + funext x + by_cases hx : x ∈ (h i).domain + · rw [hv x hx, (PartialOdometerAffineTranslateFormulas k u a b).2.2.1 + x (by rwa [← hdeq])] + · rw [(h i).value_outside x hx, + (PartialOdometerAffineTranslate k u a b).value_outside x (by rwa [← hdeq])] + have heq : h i = PartialOdometerAffineTranslate k u a b := by + generalize h i = H at hdeq hveq ⊢ + cases H + simp only [PartialOdometerAffineTranslate, PartialOdometer.mk.injEq] + exact ⟨hdeq, hveq⟩ + have hs := hp i + rw [heq, (PartialOdometerAffineTranslateFormulas k u a b).2.2.2.2.2, hpk] at hs + exact ⟨a, (Option.some.inj hs).symm⟩ + let r := cfg.firstPredecessor + have hr : ProperBandQuadruple r := cfg.firstProper + have hroot : TileOdometer (r 0) (U 0) (h 0) := by + simpa [r, cfg.firstChild] using ho 0 + have hlarge : 1 < (r 0).1 := by + have := cfg.secondLarge + have := cfg.order12 + simp only [r, cfg.firstChild] + omega + obtain ⟨S, k, _, hsub, _, _, _, _, _, _, hslope⟩ := + TileOdometerReindexedDecomposition r hr (U 0) (h 0) hlarge hroot + let w := BandVectors.2 (q 3) (q 2) + let X := BandVectors.2 (r 1) (r 3) + let Y := BandVectors.2 (r 2) (r 1) + have smallSlopes (i : Fin 3) (hi : 0 < (r i.succ).1) : + ∃ pi : Real × Real, PartialOdometerSlope (k i true) = some pi ∧ + pi = p 0 + P4250T1SlopeOffset + (BandVectors.2 (r ((i + 2).succ)) (r ((i + 1).succ))) := by + rcases hslope i true with hz | ⟨p0, pi, hp0, hpi, hx, hy⟩ + · omega + have heq : p0 = p 0 := Option.some.inj (hp0.symm.trans (hp 0)) + subst p0 + refine ⟨pi, hpi, ?_⟩ + apply Prod.ext + all_goals simp [P4250T1SlopeOffset] at hx hy ⊢; linarith + have hpos2 : 0 < (r (1 : Fin 3).succ).1 := by + simpa [r, cfg.firstParentTwo] using positive 1 + have hpos3 : 0 < (r (2 : Fin 3).succ).1 := by + simpa [r, cfg.firstParentThree] using positive 2 + obtain ⟨p2, hp2, heq2⟩ := smallSlopes 1 hpos2 + obtain ⟨p3, hp3, heq3⟩ := smallSlopes 2 hpos3 + have hk2 : TileOdometer (q (1 : Fin 3).succ) (S 1 true) (k 1 true) := by + simpa [r, cfg.firstParentTwo] using hsub 1 true + have hk3 : TileOdometer (q (2 : Fin 3).succ) (S 2 true) (k 2 true) := by + simpa [r, cfg.firstParentThree] using hsub 2 true + obtain ⟨z2, hz2⟩ := compare 1 _ _ p2 hk2 hp2 + obtain ⟨z3, hz3⟩ := compare 2 _ _ p3 hk3 hp3 + change p2 = p 0 + P4250T1SlopeOffset X at heq2 + change p3 = p 0 + P4250T1SlopeOffset Y at heq3 + rw [heq2] at hz2 + rw [heq3] at hz3 + let r1 : Fin 4 → CircleCoordinates := ![r 0, r 2, r 3, r 1] + let r2 : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] + have hr1 : SemiProperQuadruple r1 := hr.1.rotate + have hr2 : SemiProperQuadruple r2 := by + simpa [r1, r2] using hr1.rotate + have incoming2 : BandVectors.2 (r 2) (r 0) = + Y + (⟨0, 1⟩ : GaussianInt) * w := by + simpa [r1, Y, w, r, cfg.firstParentTwo, cfg.firstParentThree] using + (VectorRecursionLaws r1 hr1).2.2.2.1 + have incoming3 : BandVectors.2 (r 3) (r 0) = + w + (⟨0, 1⟩ : GaussianInt) * X := by + simpa [r2, X, w, r, cfg.firstParentTwo, cfg.firstParentThree] using + (VectorRecursionLaws r2 hr2).2.2.2.1 + have hX : BandVectors.2 (q 1) (q 3) = + X - (⟨0, 1⟩ : GaussianInt) * w := by + have flip := ((VectorRecursionLaws r hr.1).2.2.2.2 hr 2).2 + change BandVectors.2 (r 0) (r 3) = + -(⟨0, 1⟩ : GaussianInt) * BandVectors.2 (r 3) (r 0) at flip + rw [incoming3] at flip + have heq : BandVectors.2 (q 1) (q 3) = + -(⟨0, 1⟩ : GaussianInt) * (w + (⟨0, 1⟩ : GaussianInt) * X) := by + simpa [r, cfg.firstChild, cfg.firstParentThree] using flip + rw [heq] + apply Zsqrtd.ext <;> simp <;> ring + have hY : BandVectors.2 (q 2) (q 1) = + Y + (⟨0, 1⟩ : GaussianInt) * w := by + simpa [r, cfg.firstChild, cfg.firstParentTwo] using incoming2 + refine ⟨p 0 - P4250T1SlopeOffset w, + a - (w + GaussianQuarterTurn w), + ![0, z2 + GaussianQuarterTurn w, z3 + w], ?_, ?_⟩ + · have hr := congrArg Prod.fst ha + have hi := congrArg Prod.snd ha + apply Prod.ext + all_goals simp [GaussianRealPoint, GaussianQuarterTurn, + P4250T1SlopeOffset] at hr hi ⊢; linarith + · intro i + fin_cases i + · simp [w, GaussianRealPoint] + · have hr := congrArg Prod.fst hz2 + have hi := congrArg Prod.snd hz2 + apply Prod.ext + all_goals simp [hX, GaussianRealPoint, GaussianQuarterTurn, + P4250T1SlopeOffset] at hr hi ⊢; linarith + · have hr := congrArg Prod.fst hz3 + have hi := congrArg Prod.snd hz3 + apply Prod.ext + all_goals simp [hY, GaussianRealPoint, GaussianQuarterTurn, + P4250T1SlopeOffset] at hr hi ⊢; linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean b/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean new file mode 100644 index 0000000000..616a832331 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean @@ -0,0 +1,1068 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4250T1SlopeOffset +public import LeanPool.ApollonianSuperharmonic.P4250T1DefinedHalfIntegralSlope +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn +public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P4250T1ReflectedGluingSlope] + +/-! +# P4250T1ReflectedGluingSlope + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ReflectedGluingGeometry + +private theorem hpositive : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (0 < (q (0 : Fin + 3).succ).1) ) := by + classical + intro q cfg + have hn := cfg.noLine (1 : Fin 4) + have hp := (ProperBandCurvatureStructure q cfg.proper).2.1 (0 : Fin 3) + have hp' : 0 ≤ (q (1 : Fin 4)).1 := by simpa using hp + change (q (1 : Fin 4)).1 ≠ 0 at hn + change 0 < (q (1 : Fin 4)).1 + omega + +private theorem hpchild : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × + Real), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), PartialOdometerSlope (h i s) = some (s0 + + (if s = true then (1 : ℝ) else (-1 : ℝ)) • P4250T1SlopeOffset (BandVectors.2 (q (i + + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)))) → ( + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (pchild : ℝ × ℝ), (PartialOdometerSlope (h (0 : Fin (3 : ℕ)) true) = some pchild) → + (pchild = s0 + P4250T1SlopeOffset v)) ) := by + classical + intro q h s0 hp i v pchild hchild + have he := hp 0 true + rw [hchild] at he + simpa [i, v] using Option.some.inj he + +private theorem htwo_s0 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (s0 : Real × Real), + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (pchild : ℝ × ℝ), ∀ (ai : GaussianInt), ((2 : ℝ) • pchild = GaussianRealPoint ai) → + ((pchild = s0 + P4250T1SlopeOffset v) → ((2 : Real) • s0 = GaussianRealPoint (ai - + (v + GaussianQuarterTurn v)))) ) := by + classical + intro q s0 i v pchild ai hhalf hpchild + have hcoords := congrArg (fun x : Real × Real => (2 * x.1, 2 * x.2)) hhalf + have hpc := congrArg Prod.fst hpchild + have hpi := congrArg Prod.snd hpchild + apply Prod.ext <;> + simp [GaussianRealPoint, P4250T1SlopeOffset, GaussianQuarterTurn, v] at hcoords hpc hpi ⊢ + <;> + linarith + +private theorem hreflect : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (∀ (i : Fin (3 : ℕ)), + let w := BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ); + let u := GaussianQuarterTurn w - w; (TileTranslation (cert.P i true) u).cells = (cert.P i + false).cells ∧ ((cert.P i true).cells = ∅ → (TileTranslation (cert.P i true) + u).anchor = (cert.P i false).anchor) ∧ FootprintVertices (TileTranslation (cert.P i + true) u) = FootprintVertices (cert.P i false) ∧ TileCentroid (TileTranslation (cert.P + i true) u) = TileCentroid (cert.P i false) ∧ TileArea (cert.P i true) = TileArea + (cert.P i false) ∧ CentrallyReflectedAt (TileCentroid T) (cert.P i true) (cert.P i + false)) → (CentrallyReflectedAt (TileCentroid T) (cert.P 0 true) (cert.P 0 false)) ) + := by + classical + intro q cfg C T cert hturn + rcases hturn 0 with ⟨_, _, _, _, _, hr⟩ + exact hr + +private theorem hcenterIntegral : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (Finset.Nonempty (cert.P (0 : Fin (3 : ℕ)) true).cells) → (∃ u : GaussianInt, (2 + : Real) • TileCentroid T = GaussianRealPoint u) ) := by + classical + intro q cfg C T cert hcells + have hroot : BandPrototile (q 0) T := by + apply BandPrototile.decompose cfg.proper + (fun j s => (cert.outer_occurrence j s).1) + · exact cert.outer_union + · intro j s + exact (cert.outer_occurrence j s).2.1 + · intro j s + exact (cert.outer_occurrence j s).2.2 + have hrootne : T.cells.Nonempty := by + obtain ⟨z, hz⟩ := hcells + exact ⟨z, (cert.outer_union z).2 ⟨0, true, hz⟩⟩ + let c := TileCentroid T + let reCells : Finset Int := T.cells.image (fun x => x.re) + let imCells : Finset Int := T.cells.image (fun x => x.im) + have reNe : reCells.Nonempty := Finset.image_nonempty.mpr hrootne + have imNe : imCells.Nonempty := Finset.image_nonempty.mpr hrootne + have hcentral : CentrallyReflectedAt c T T := + BandPrototileCentralSymmetry (q 0) T hroot + have reflect_mem : ∀ p ∈ TileRealization T, + (2 * c.1 - p.1, 2 * c.2 - p.2) ∈ TileRealization T := by + intro p hp + rw [hcentral] + exact ⟨p, hp, rfl⟩ + have hboundRe : ∀ p ∈ TileRealization T, + (↑(reCells.min' reNe) : Real) ≤ p.1 ∧ + p.1 ≤ (↑(reCells.max' reNe) : Real) + 1 := by + intro p hp + simp only [TileRealization, Set.mem_iUnion] at hp + rcases hp with ⟨x, hx, hpx⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpx + constructor + · have hm := Finset.min'_le reCells x.re + (Finset.mem_image.mpr ⟨x, hx, rfl⟩) + exact le_trans (by exact_mod_cast hm) hpx.1.1 + · have hm := Finset.le_max' reCells x.re + (Finset.mem_image.mpr ⟨x, hx, rfl⟩) + have hm' : (x.re : Real) ≤ (reCells.max' reNe : Real) := by exact_mod_cast hm + linarith [hpx.2.1, hm'] + have hboundIm : ∀ p ∈ TileRealization T, + (imCells.min' imNe : Real) ≤ p.2 ∧ + p.2 ≤ (imCells.max' imNe : Real) + 1 := by + intro p hp + simp only [TileRealization, Set.mem_iUnion] at hp + rcases hp with ⟨x, hx, hpx⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpx + constructor + · exact le_trans (Int.cast_le.mpr (Finset.min'_le imCells x.im + (Finset.mem_image.mpr ⟨x, hx, rfl⟩))) hpx.1.2 + · have hm := Finset.le_max' imCells x.im + (Finset.mem_image.mpr ⟨x, hx, rfl⟩) + have hm' : (x.im : Real) ≤ (imCells.max' imNe : Real) := by exact_mod_cast hm + linarith [hpx.2.2, hm'] + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + have centerRe : 2 * c.1 = (reCells.min' reNe : Real) + reCells.max' reNe + 1 := by + have hmin : ∃ x, x ∈ T.cells ∧ x.re = reCells.min' reNe := by + rcases Finset.mem_image.mp (Finset.min'_mem reCells reNe) with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + have hmax' : ∃ x, x ∈ T.cells ∧ x.re = reCells.max' reNe := by + rcases Finset.mem_image.mp (Finset.max'_mem reCells reNe) with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + obtain ⟨xmin, hxmin, hxminre⟩ := hmin + obtain ⟨xmax, hmax, hmaxre⟩ := hmax' + have pmin : ((reCells.min' reNe : Real), (xmin.im : Real)) ∈ TileRealization T := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmin, hxmin, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + exact ⟨⟨by simp [hxminre], by simp []⟩, + ⟨by simp [hxminre], by simp⟩⟩ + have pmax : (((reCells.max' reNe : Int) : Real) + 1, (xmax.im : Real)) ∈ TileRealization T + := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmax, hmax, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + exact ⟨⟨by simp [hmaxre], by simp⟩, + ⟨by simp [hmaxre], by simp⟩⟩ + have bmin := hboundRe _ (reflect_mem _ pmin) + have bmax := hboundRe _ (reflect_mem _ pmax) + dsimp at bmin bmax + norm_num at bmin bmax ⊢ + linarith + have centerIm : 2 * c.2 = (mIm : Real) + MIm + 1 := by + have hmin : ∃ x, x ∈ T.cells ∧ x.im = mIm := by + rcases Finset.mem_image.mp (Finset.min'_mem imCells imNe) with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + have hmax' : ∃ x, x ∈ T.cells ∧ x.im = MIm := by + rcases Finset.mem_image.mp (Finset.max'_mem imCells imNe) with ⟨x, hx, he⟩ + exact ⟨x, hx, he⟩ + obtain ⟨xmin, hxmin, hxminim⟩ := hmin + obtain ⟨xmax, hmax, hmaxim⟩ := hmax' + have pmin : ((xmin.re : Real), (mIm : Real)) ∈ TileRealization T := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmin, hxmin, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + refine ⟨⟨by simp, ?_⟩, ⟨by simp, ?_⟩⟩ + · simp [hxminim] + · simp [hxminim] + have pmax : ((xmax.re : Real), (MIm : Real) + 1) ∈ TileRealization T := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmax, hmax, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + refine ⟨⟨by simp, ?_⟩, ⟨by simp, ?_⟩⟩ + · simp [hmaxim] + · simp [hmaxim] + have bmin := hboundIm _ (reflect_mem _ pmin) + have bmax := hboundIm _ (reflect_mem _ pmax) + dsimp at bmin bmax + norm_num at bmin bmax ⊢ + linarith + refine ⟨⟨reCells.min' reNe + reCells.max' reNe + 1, + mIm + MIm + 1⟩, ?_⟩ + apply Prod.ext <;> simp [GaussianRealPoint] <;> linarith [centerRe, centerIm] + +private theorem positive : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (j : Fin 3), + 0 < (q j.succ).1) ) := by + classical + intro q cfg j + have hnonneg := (ProperBandCurvatureStructure q cfg.proper).2.1 j + have hne := cfg.noLine j.succ + omega + +private theorem reflectedChild : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (cert.P i s) (h i s)) → ((∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), PartialOdometerSlope (h i s) = some (s0 + (if s = true then (1 : + ℝ) else (-1 : ℝ)) • P4250T1SlopeOffset (BandVectors.2 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)))) → ( + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (ai : GaussianInt), ∀ (u : GaussianInt), ((2 : ℝ) • TileCentroid T = GaussianRealPoint + u) → ( + let a := ai - (v + GaussianQuarterTurn v) + (GaussianRealPoint a = (2 : Real) • s0) → ((∀ (j : Fin 3), 0 < (q j.succ).1) → ( + let reflectedK (j : Fin 3) (s : Bool) : PartialOdometer := + PartialOdometerAffineTranslate + (PartialOdometerHalfTurn (h j (!s))) u a 0 + ∀ (j : Fin 3), ∀ (s : Bool), TileOdometer (q j.succ) (cert.P j s) (reflectedK j s) ∧ + PartialOdometerSlope (reflectedK j s) = some (s0 + (if s = true then (1 : Real) else + -1) • P4250T1SlopeOffset (BandVectors.2 (q ((j + 2).succ)) (q ((j + + 1).succ))))))))) ) := by + classical + intro q cfg C T cert h s0 ho hp i v ai u hu a ha positive reflectedK j s + let U := cert.P j (!s) + let V := cert.P j s + let k := reflectedK j s + have hhalf := (TileOdometerCentralSymmetry (q j.succ) U (h j (!s)) + (ho j (!s))).1 + have hk : TileOdometer (q j.succ) (TileTranslation (TileHalfTurn U) u) k := by + exact TileOdometerAffineTranslation (q j.succ) (TileHalfTurn U) + (PartialOdometerHalfTurn (h j (!s))) u a 0 hhalf + have hUband : BandPrototile (q j.succ) U := + TileOdometerBandPrototile _ _ _ (ho j (!s)) + have hVband : BandPrototile (q j.succ) V := + (cert.outer_occurrence j s).1 + have hcentSum : TileCentroid V + TileCentroid U = + (2 : Real) • TileCentroid T := by + have hvs := (cert.outer_occurrence j s).2.2 + have hus := (cert.outer_occurrence j (!s)).2.2 + cases s <;> apply Prod.ext + all_goals + first + | (have h1 := congrArg Prod.fst hvs + have h2 := congrArg Prod.fst hus + dsimp at h1 h2 ⊢ + linarith) + | (have h1 := congrArg Prod.snd hvs + have h2 := congrArg Prod.snd hus + dsimp at h1 h2 ⊢ + linarith) + have hcent : TileCentroid (TileTranslation (TileHalfTurn U) u) = + TileCentroid V := by + rw [(TileTranslationFormulas (TileHalfTurn U) u).2.2.2.2.1, + (TileHalfTurnFormulas U).2.2.2.2.2.2.2.1] + have hr := congrArg Prod.fst hcentSum + have hi := congrArg Prod.snd hcentSum + have hur := congrArg Prod.fst hu + have hui := congrArg Prod.snd hu + simp? [GaussianRealPoint] at hur hui + rw [← GaussianInt.intCast_re u] at hur + rw [← GaussianInt.intCast_im u] at hui + dsimp at hr hi + apply Prod.ext <;> dsimp <;> linarith + have hsupp := (BandPrototileCentroidUnique (q j.succ) + (TileTranslation (TileHalfTurn U) u) V + (BandPrototileTranslation (q j.succ) (TileHalfTurn U) u + (TileOdometerBandPrototile _ _ _ hhalf)) hVband hcent).1 + have hkV : TileOdometer (q j.succ) V k := by + exact PositiveCurvatureTileOdometerSupportTransport (q j.succ) + (TileTranslation (TileHalfTurn U) u) V k (positive j) hk hVband hsupp + have hare : (a.re : Real) = 2 * s0.1 := by + have hh := congrArg Prod.fst ha + simpa [GaussianRealPoint] using hh + have haim : (a.im : Real) = 2 * s0.2 := by + have hh := congrArg Prod.snd ha + simpa [GaussianRealPoint] using hh + have hsl : PartialOdometerSlope k = some + (s0 + (if s = true then (1 : Real) else -1) • + P4250T1SlopeOffset + (BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ)))) := by + rw [(PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn (h j (!s))) u a 0).2.2.2.2.2, + (PartialOdometerHalfTurnFormulas (h j (!s))).2.2.2.2.2.2, + hp j (!s)] + simp only [Option.map_some] + congr 1 + cases s <;> apply Prod.ext <;> + simp [] at hare haim ⊢ <;> linarith + exact ⟨hkV, hsl⟩ + +private theorem childNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + TileOdometer (q i.succ) (cert.P i s) (h i s)) → ((∀ (j : Fin 3), 0 < (q j.succ).1) → + (∀ (j : Fin 3), ∀ (s : Bool), (cert.P j s).cells.Nonempty)) ) := by + classical + intro q cfg C T cert h ho positive j s + rcases P4250T1DefinedHalfIntegralSlope (q j.succ) (cert.P j s) + (h j s) (positive j) (ho j s) with ⟨p, b, hp, hb, hne⟩ + exact hne + +private theorem rootNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (∀ (j : Fin 3), ∀ (s : Bool), (cert.P j s).cells.Nonempty) → (T.cells.Nonempty) ) + := by + classical + intro q cfg C T cert childNonempty + obtain ⟨z, hz⟩ := childNonempty 0 true + exact ⟨z, (cert.outer_union z).2 ⟨0, true, hz⟩⟩ + +private theorem rootFoot : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (∀ (j : Fin 3), ∀ (s : Bool), (cert.P j s).cells.Nonempty) → ((T.cells.Nonempty) + → (∀ z, z ∈ FootprintVertices T ↔ ∃ j s, z ∈ FootprintVertices (cert.P j s))) ) := by + classical + intro q cfg C T cert childNonempty rootNonempty z + simp only [FootprintVertices, ite_eq_left rootNonempty, Set.mem_ofPred_eq] + constructor + · rintro ⟨x, hx, hcorner⟩ + obtain ⟨j, s, hxchild⟩ := (cert.outer_union x).mp hx + refine ⟨j, s, ?_⟩ + simp only [ite_eq_left (childNonempty j s), Set.mem_ofPred_eq] + exact ⟨x, hxchild, hcorner⟩ + · rintro ⟨j, s, hz⟩ + simp only [ite_eq_left (childNonempty j s), Set.mem_ofPred_eq] at hz + rcases hz with ⟨x, hxchild, hcorner⟩ + exact ⟨x, (cert.outer_union x).2 ⟨j, s, hxchild⟩, hcorner⟩ + +private theorem halfSet : + (by + classical + exact + ∀ (f : PartialOdometer), ((PartialOdometerHalfTurn f).domain : Set GaussianInt) = (fun x + : GaussianInt => -x) '' (f.domain : Set GaussianInt) ) := by + classical + intro f + ext z + simp [PartialOdometerHalfTurn] + +private theorem affineHalfMem : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (ai : GaussianInt), ∀ (u : GaussianInt), + let a := ai - (v + GaussianQuarterTurn v) + ∀ (f : PartialOdometer), ∀ (z : GaussianInt), z ∈ (PartialOdometerAffineTranslate + (PartialOdometerHalfTurn f) u a 0).domain ↔ u - z ∈ f.domain ) := by + classical + intro q i v ai u a f z + rw [(PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn f) u a 0).1] + simp only [Finset.mem_image] + constructor + · rintro ⟨y, hy, he⟩ + have hy' := (PartialOdometerHalfTurnFormulas f).1 y |>.mp hy + have he' : u - z = -y := by + dsimp [GaussianTranslation] at he + rw [← he] + simp [sub_eq_add_neg, add_comm] + simpa [he'] using hy' + · intro hz + refine ⟨z - u, (PartialOdometerHalfTurnFormulas f).1 (z - u) |>.mpr ?_, ?_⟩ + · simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hz + · simp [GaussianTranslation, sub_eq_add_neg, add_comm] + +private theorem reflectedFoot : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (cert.P i s) (h i s)) → ( + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (ai : GaussianInt), ∀ (u : GaussianInt), + let a := ai - (v + GaussianQuarterTurn v) + (∀ (j : Fin 3), 0 < (q j.succ).1) → ( + let reflectedK (j : Fin 3) (s : Bool) : PartialOdometer := + PartialOdometerAffineTranslate + (PartialOdometerHalfTurn (h j (!s))) u a 0 + (∀ (j : Fin 3), ∀ (s : Bool), TileOdometer (q j.succ) (cert.P j s) (reflectedK j s) ∧ + PartialOdometerSlope (reflectedK j s) = some (s0 + (if s = true then (1 : Real) else + -1) • P4250T1SlopeOffset (BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))))) → + ((∀ (f : PartialOdometer), ∀ (z : GaussianInt), z ∈ (PartialOdometerAffineTranslate + (PartialOdometerHalfTurn f) u a 0).domain ↔ u - z ∈ f.domain) → (∀ (j : Fin 3), ∀ (s + : Bool), ∀ (z : GaussianInt), z ∈ FootprintVertices (cert.P j s) ↔ u - z ∈ + FootprintVertices (cert.P j (!s)))))) ) := by + classical + intro q cfg C T cert h s0 ho i v ai u a positive reflectedK reflectedChild affineHalfMem j s z + have hk := reflectedChild j s + let k := reflectedK j s + have hkd := PositiveCurvatureTileOdometerDomain (q j.succ) + (cert.P j s) k (positive j) hk.1 + have hopd := PositiveCurvatureTileOdometerDomain (q j.succ) + (cert.P j (!s)) (h j (!s)) (positive j) (ho j (!s)) + calc + z ∈ FootprintVertices (cert.P j s) ↔ z ∈ (k.domain : Set GaussianInt) := + (Set.ext_iff.mp hkd z).symm + _ ↔ u - z ∈ (h j (!s)).domain := by + dsimp [k, reflectedK] + exact affineHalfMem (h j (!s)) z + _ ↔ u - z ∈ FootprintVertices (cert.P j (!s)) := + Set.ext_iff.mp hopd (u - z) + +private theorem hgsharpdom : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (g : PartialOdometer), ((↑g.domain : Set GaussianInt) = FootprintVertices T) → ( + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (ai : GaussianInt), ∀ (u : GaussianInt), + let a := ai - (v + GaussianQuarterTurn v) + (∀ z, z ∈ FootprintVertices T ↔ ∃ j s, z ∈ FootprintVertices (cert.P j s)) → ((∀ (f : + PartialOdometer), ∀ (z : GaussianInt), z ∈ (PartialOdometerAffineTranslate + (PartialOdometerHalfTurn f) u a 0).domain ↔ u - z ∈ f.domain) → ((∀ (j : Fin 3), ∀ (s + : Bool), ∀ (z : GaussianInt), z ∈ FootprintVertices (cert.P j s) ↔ u - z ∈ + FootprintVertices (cert.P j (!s))) → ( + let gsharp := PartialOdometerAffineTranslate (PartialOdometerHalfTurn g) u a 0 + (gsharp.domain : Set GaussianInt) = FootprintVertices T)))) ) := by + classical + intro q cfg C T cert g hgdom i v ai u a rootFoot affineHalfMem reflectedFoot gsharp + ext z + have hroot : u - z ∈ (g.domain : Set GaussianInt) ↔ z ∈ FootprintVertices T := by + rw [Set.ext_iff.mp hgdom (u - z), rootFoot (u - z), rootFoot z] + constructor + · rintro ⟨j, s, hz⟩ + exact ⟨j, !s, (reflectedFoot j (!s) z).mpr (by simpa using hz)⟩ + · rintro ⟨j, s, hz⟩ + exact ⟨j, !s, (reflectedFoot j s z).mp hz⟩ + simpa [gsharp] using (affineHalfMem g z).trans hroot + +private theorem childOdoConst : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (cert.P i s) (h i s)) → ((∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), PartialOdometerSlope (h i s) = some (s0 + (if s = true then (1 : + ℝ) else (-1 : ℝ)) • P4250T1SlopeOffset (BandVectors.2 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)))) → ( + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (ai : GaussianInt), ∀ (u : GaussianInt), + let a := ai - (v + GaussianQuarterTurn v) + (∀ (j : Fin 3), 0 < (q j.succ).1) → ( + let reflectedK (j : Fin 3) (s : Bool) : PartialOdometer := + PartialOdometerAffineTranslate + (PartialOdometerHalfTurn (h j (!s))) u a 0 + (∀ (j : Fin 3), ∀ (s : Bool), TileOdometer (q j.succ) (cert.P j s) (reflectedK j s) ∧ + PartialOdometerSlope (reflectedK j s) = some (s0 + (if s = true then (1 : Real) else + -1) • P4250T1SlopeOffset (BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))))) → + ((∀ (j : Fin 3), ∀ (s : Bool), (cert.P j s).cells.Nonempty) → (∀ (j : Fin 3), ∀ (s : + Bool), ∃ c : Int, ∀ x, x ∈ (reflectedK j s).domain → (h j s).value x - (reflectedK j + s).value x = c))))) ) := by + classical + intro q cfg C T cert h s0 ho hp i v ai u a positive reflectedK reflectedChild childNonempty j s + let V := cert.P j s + let k := reflectedK j s + obtain ⟨shift, ⟨hcellsEq, _, aa, bb, hdomains, hvalues⟩, _⟩ := + TileOdometerTranslationUniqueness (q j.succ) V V k (h j s) + (positive j) (reflectedChild j s).1 (ho j s) + have hcentEq : TileCentroid V = + TileCentroid (TileTranslation V shift) := by + have hne := childNonempty j s + have htne : (TileTranslation V shift).cells.Nonempty := by + rw [(TileTranslationFormulas V shift).1] + exact Finset.image_nonempty.mpr hne + simp only [TileCentroid, ite_eq_left htne, hcellsEq] + rw [(TileTranslationFormulas V shift).2.2.2.2.1] at hcentEq + have hre : (shift.re : Real) = 0 := by + have hh := congrArg Prod.fst hcentEq + dsimp at hh + linarith + have him : (shift.im : Real) = 0 := by + have hh := congrArg Prod.snd hcentEq + dsimp at hh + linarith + have hshift : shift = 0 := by + apply Zsqrtd.ext + · exact_mod_cast hre + · exact_mod_cast him + have hdeq : k.domain = + (PartialOdometerAffineTranslate (h j s) 0 aa bb).domain := by + ext x + rw [(PartialOdometerAffineTranslateFormulas (h j s) 0 aa bb).2.1] + simpa [hshift] using hdomains x + have hveq : k.value = + (PartialOdometerAffineTranslate (h j s) 0 aa bb).value := by + funext x + by_cases hx : x ∈ k.domain + · have hx' : x ∈ + (PartialOdometerAffineTranslate (h j s) 0 aa bb).domain := by + rw [← hdeq] + exact hx + rw [hvalues x hx, + (PartialOdometerAffineTranslateFormulas (h j s) 0 aa bb).2.2.1 x hx'] + simp [hshift] + · rw [k.value_outside x hx, + (PartialOdometerAffineTranslate (h j s) 0 aa bb).value_outside x] + have hx' : x ∉ + (PartialOdometerAffineTranslate (h j s) 0 aa bb).domain := by + intro hm + apply hx + rw [hdeq] + exact hm + exact hx' + have heq : k = PartialOdometerAffineTranslate (h j s) 0 aa bb := by + generalize k = K at hdeq hveq ⊢ + cases K + simp only [PartialOdometerAffineTranslate, PartialOdometer.mk.injEq] + exact ⟨hdeq, hveq⟩ + have hslopes := (reflectedChild j s).2 + change PartialOdometerSlope k = _ at hslopes + rw [heq, (PartialOdometerAffineTranslateFormulas + (h j s) 0 aa bb).2.2.2.2.2, hp j s] at hslopes + simp only [Option.map_some] at hslopes + have haa : aa = 0 := by + have he := congrArg Prod.fst (Option.some.inj hslopes) + have hi := congrArg Prod.snd (Option.some.inj hslopes) + have hrealr : (aa.re : Real) = 0 := by + simp? [] at he + rw [← GaussianInt.intCast_re aa] at he + linarith + have hreali : (aa.im : Real) = 0 := by + simp? [] at hi + rw [← GaussianInt.intCast_im aa] at hi + linarith + apply Zsqrtd.ext + · exact_mod_cast hrealr + · exact_mod_cast hreali + refine ⟨-bb, ?_⟩ + intro x hx + have hv : k.value x = (h j s).value x + bb := by + simpa [hshift, haa] using hvalues x hx + have hv' : (reflectedK j s).value x = (h j s).value x + bb := by + simpa [k] using hv + rw [hv'] + omega + +private theorem gChildConst : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + TileOdometer (q i.succ) (cert.P i s) (h i s)) → (∀ (g : PartialOdometer), ((↑g.domain + : Set GaussianInt) = FootprintVertices T) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + OdometerCompatibility g (h i s)) → ((∀ (j : Fin 3), 0 < (q j.succ).1) → ((∀ (j : Fin + 3), ∀ (s : Bool), (cert.P j s).cells.Nonempty) → (∀ (j : Fin 3), ∀ (s : Bool), ∃ c : + Int, ∀ x, x ∈ (h j s).domain → g.value x - (h j s).value x = c))))) ) := by + classical + intro q cfg C T cert h ho g hgdom hgcompat positive childNonempty j s + rcases hgcompat j s with hdisj | ⟨c, hc⟩ + · obtain ⟨z, hz⟩ := childNonempty j s + have hzfoot : z ∈ FootprintVertices (cert.P j s) := by + simp? [FootprintVertices, childNonempty j s] + exact ⟨z, hz, Or.inl rfl⟩ + have hdomChild := PositiveCurvatureTileOdometerDomain (q j.succ) + (cert.P j s) (h j s) (positive j) (ho j s) + have hzchild : z ∈ (h j s).domain := + (Set.ext_iff.mp hdomChild z).mpr hzfoot + have hzroot : z ∈ g.domain := by + apply (Set.ext_iff.mp hgdom z).mpr + exact (cert.outer_occurrence j s).2.1 hzfoot + exact False.elim (Set.disjoint_left.mp hdisj hzroot hzchild) + · refine ⟨-c, ?_⟩ + intro x hx + have hxg : x ∈ g.domain := by + apply (Set.ext_iff.mp hgdom x).mpr + exact (cert.outer_occurrence j s).2.1 + ((Set.ext_iff.mp (PositiveCurvatureTileOdometerDomain + (q j.succ) (cert.P j s) (h j s) (positive j) (ho j s)) x).mp hx) + have hv := hc x hxg hx + omega + +private theorem gsharpChildConst : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), ∀ (g : + PartialOdometer), + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (ai : GaussianInt), ∀ (u : GaussianInt), + let a := ai - (v + GaussianQuarterTurn v) + (∀ (j : Fin 3), 0 < (q j.succ).1) → ( + let reflectedK (j : Fin 3) (s : Bool) : PartialOdometer := + PartialOdometerAffineTranslate + (PartialOdometerHalfTurn (h j (!s))) u a 0 + (∀ (j : Fin 3), ∀ (s : Bool), TileOdometer (q j.succ) (cert.P j s) (reflectedK j s) ∧ + PartialOdometerSlope (reflectedK j s) = some (s0 + (if s = true then (1 : Real) else + -1) • P4250T1SlopeOffset (BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))))) → + ((∀ (f : PartialOdometer), ∀ (z : GaussianInt), z ∈ (PartialOdometerAffineTranslate + (PartialOdometerHalfTurn f) u a 0).domain ↔ u - z ∈ f.domain) → ( + let gsharp := PartialOdometerAffineTranslate (PartialOdometerHalfTurn g) u a 0 + ((gsharp.domain : Set GaussianInt) = FootprintVertices T) → ((∀ (j : Fin 3), ∀ (s : + Bool), ∃ c : Int, ∀ x, x ∈ (h j s).domain → g.value x - (h j s).value x = c) → (∀ (j + : Fin 3), ∀ (s : Bool), ∃ c : Int, ∀ x, x ∈ (reflectedK j s).domain → gsharp.value x + - (reflectedK j s).value x = c))))) ) := by + classical + intro q cfg C T cert h s0 g i v ai u a positive reflectedK reflectedChild affineHalfMem gsharp + hgsharpdom gChildConst j s + obtain ⟨c, hc⟩ := gChildConst j (!s) + let k := reflectedK j s + have hkd := PositiveCurvatureTileOdometerDomain (q j.succ) + (cert.P j s) k (positive j) (reflectedChild j s).1 + have hrootChild : FootprintVertices (cert.P j s) ⊆ FootprintVertices T := + (cert.outer_occurrence j s).2.1 + refine ⟨c, ?_⟩ + intro x hx + have hxroot : x ∈ (gsharp.domain : Set GaussianInt) := by + rw [Set.ext_iff.mp hgsharpdom] + exact hrootChild ((Set.ext_iff.mp hkd x).mp hx) + have hy : u - x ∈ (h j (!s)).domain := + (affineHalfMem (h j (!s)) x).mp hx + have hgv := (PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn g) u a 0).2.2.1 x hxroot + have hkv := (PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn (h j (!s))) u a 0).2.2.1 x hx + have hgd := (PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn g) u a 0).2.1 x |>.mp hxroot + have hkd' := (PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn (h j (!s))) u a 0).2.1 x |>.mp hx + have hgv' := (PartialOdometerHalfTurnFormulas g).2.1 (x - u) hgd + have hkv' := (PartialOdometerHalfTurnFormulas (h j (!s))).2.1 + (x - u) hkd' + rw [hgv, hkv, hgv', hkv'] + have hc' := hc (u - x) hy + simp [] at hc' ⊢ + omega + +private theorem sharpCompat : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (s0 : Real × Real), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (cert.P i s) (h i s)) → (∀ (g : + PartialOdometer), + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (ai : GaussianInt), ∀ (u : GaussianInt), + let a := ai - (v + GaussianQuarterTurn v) + (∀ (j : Fin 3), 0 < (q j.succ).1) → ( + let reflectedK (j : Fin 3) (s : Bool) : PartialOdometer := + PartialOdometerAffineTranslate + (PartialOdometerHalfTurn (h j (!s))) u a 0 + (∀ (j : Fin 3), ∀ (s : Bool), TileOdometer (q j.succ) (cert.P j s) (reflectedK j s) ∧ + PartialOdometerSlope (reflectedK j s) = some (s0 + (if s = true then (1 : Real) else + -1) • P4250T1SlopeOffset (BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))))) → ( + let gsharp := PartialOdometerAffineTranslate (PartialOdometerHalfTurn g) u a 0 + (∀ (j : Fin 3), ∀ (s : Bool), ∃ c : Int, ∀ x, x ∈ (reflectedK j s).domain → (h j s).value + x - (reflectedK j s).value x = c) → ((∀ (j : Fin 3), ∀ (s : Bool), ∃ c : Int, ∀ x, x + ∈ (reflectedK j s).domain → gsharp.value x - (reflectedK j s).value x = c) → (∀ j, ∀ + s, OdometerCompatibility gsharp (h j s)))))) ) := by + classical + intro q cfg C T cert h s0 ho g i v ai u a positive reflectedK reflectedChild gsharp + childOdoConst gsharpChildConst j s + obtain ⟨c₁, hc₁⟩ := gsharpChildConst j s + obtain ⟨c₂, hc₂⟩ := childOdoConst j s + have hkd := PositiveCurvatureTileOdometerDomain (q j.succ) + (cert.P j s) (reflectedK j s) (positive j) (reflectedChild j s).1 + have hhd := PositiveCurvatureTileOdometerDomain (q j.succ) + (cert.P j s) (h j s) (positive j) (ho j s) + have hsame : ((reflectedK j s).domain : Set GaussianInt) = + ((h j s).domain : Set GaussianInt) := hkd.trans hhd.symm + right + refine ⟨c₂ - c₁, ?_⟩ + intro x hxg hx + have hxk : x ∈ (reflectedK j s).domain := + (Set.ext_iff.mp hsame.symm x).mp hx + have hleft := hc₂ x hxk + have hright := hc₁ x hxk + omega + +private theorem hdomEq : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (g : PartialOdometer), + ((↑g.domain : Set GaussianInt) = FootprintVertices T) → ( + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (ai : GaussianInt), ∀ (u : GaussianInt), + let a := ai - (v + GaussianQuarterTurn v) + let gsharp := PartialOdometerAffineTranslate (PartialOdometerHalfTurn g) u a 0 + ((gsharp.domain : Set GaussianInt) = FootprintVertices T) → (∀ (c : ℤ), gsharp.domain = + (PartialOdometerAffineTranslate g 0 0 c).domain)) ) := by + classical + intro q T g hgdom i v ai u a gsharp hgsharpdom c + ext x + rw [(PartialOdometerAffineTranslateFormulas g 0 0 c).2.1] + have h1 := Set.ext_iff.mp hgsharpdom x + have h2 := Set.ext_iff.mp hgdom x + simpa using h1.trans h2.symm + +private theorem hvalEq : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (g : PartialOdometer), + ((↑g.domain : Set GaussianInt) = FootprintVertices T) → ( + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (ai : GaussianInt), ∀ (u : GaussianInt), + let a := ai - (v + GaussianQuarterTurn v) + let gsharp := PartialOdometerAffineTranslate (PartialOdometerHalfTurn g) u a 0 + ((gsharp.domain : Set GaussianInt) = FootprintVertices T) → (∀ (c : ℤ), (∀ x ∈ g.domain, + gsharp.value x - g.value x = c) → ((gsharp.domain = (PartialOdometerAffineTranslate g + 0 0 c).domain) → (gsharp.value = (PartialOdometerAffineTranslate g 0 0 c).value)))) ) + := by + classical + intro q T g hgdom i v ai u a gsharp hgsharpdom c hc hdomEq + funext x + by_cases hx : x ∈ g.domain + · have hxsharp : x ∈ gsharp.domain := by + exact (Set.ext_iff.mp (hgsharpdom.trans hgdom.symm) x).mpr hx + have hxt : x ∈ (PartialOdometerAffineTranslate g 0 0 c).domain := by + simpa only [hdomEq] using hxsharp + rw [(PartialOdometerAffineTranslateFormulas g 0 0 c).2.2.1 x hxt] + have hv := hc x hx + simp [] at hv ⊢ + omega + · have hxsharp : x ∉ gsharp.domain := by + intro hmem + apply hx + exact (Set.ext_iff.mp (hgsharpdom.trans hgdom.symm) x).mp hmem + rw [gsharp.value_outside x hxsharp, + (PartialOdometerAffineTranslate g 0 0 c).value_outside x] + intro hmem + apply hx + have hm := (PartialOdometerAffineTranslateFormulas g 0 0 c).2.1 x |>.mp hmem + simpa using hm + +private theorem hsharpEq : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (g : PartialOdometer), + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (ai : GaussianInt), ∀ (u : GaussianInt), + let a := ai - (v + GaussianQuarterTurn v) + let gsharp := PartialOdometerAffineTranslate (PartialOdometerHalfTurn g) u a 0 + ∀ (c : ℤ), (gsharp.domain = (PartialOdometerAffineTranslate g 0 0 c).domain) → + ((gsharp.value = (PartialOdometerAffineTranslate g 0 0 c).value) → (gsharp = + PartialOdometerAffineTranslate g 0 0 c)) ) := by + classical + intro q g i v ai u a gsharp c hdomEq hvalEq + generalize gsharp = G at hdomEq hvalEq ⊢ + cases G + simp only [PartialOdometerAffineTranslate, PartialOdometer.mk.injEq] + exact ⟨hdomEq, hvalEq⟩ + +private theorem hsharpSlope : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (g : PartialOdometer), + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (ai : GaussianInt), ∀ (u : GaussianInt), + let a := ai - (v + GaussianQuarterTurn v) + let gsharp := PartialOdometerAffineTranslate (PartialOdometerHalfTurn g) u a 0 + ∀ (c : ℤ), (gsharp = PartialOdometerAffineTranslate g 0 0 c) → (PartialOdometerSlope + gsharp = PartialOdometerSlope g) ) := by + classical + intro q g i v ai u a gsharp c hsharpEq + rw [hsharpEq, (PartialOdometerAffineTranslateFormulas g 0 0 c).2.2.2.2.2] + simp + +private theorem hchildSquares : + (by + classical + exact + ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (pchild : ℝ × ℝ), (PartialOdometerSlope (h (0 : + Fin (3 : ℕ)) true) = some pchild) → ((PartialOdometerSquares (h 0 true)).Nonempty) ) + := by + classical + intro h pchild hchild + by_contra hn + have hnone : PartialOdometerSlope (h 0 true) = none := by + simp [PartialOdometerSlope, hn] + rw [hnone] at hchild + cases hchild + +private theorem hgchild : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (h : Fin 3 → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + TileOdometer (q i.succ) (cert.P i s) (h i s)) → (∀ (g : PartialOdometer), ((↑g.domain + : Set GaussianInt) = FootprintVertices T) → ((∀ (j : Fin 3), 0 < (q j.succ).1) → ((h + 0 true).domain ⊆ g.domain))) ) := by + classical + intro q cfg C T cert h ho g hgdom positive y hy + apply (Set.ext_iff.mp hgdom y).mpr + have hdomChild := PositiveCurvatureTileOdometerDomain + (q (0 : Fin 3).succ) (cert.P 0 true) (h 0 true) (positive 0) (ho 0 true) + exact (cert.outer_occurrence 0 true).2.1 + ((Set.ext_iff.mp hdomChild y).mp hy) + +private theorem hgSqNonempty : + (by + classical + exact + ∀ (h : Fin 3 → Bool → PartialOdometer), ∀ (g : PartialOdometer), ∀ (x : GaussianInt), (x + ∈ PartialOdometerSquares (h (0 : Fin (3 : ℕ)) true)) → (((h 0 true).domain ⊆ + g.domain) → ((PartialOdometerSquares g).Nonempty)) ) := by + classical + intro h g x hx hgchild + refine ⟨x, ?_⟩ + simp only [PartialOdometerSquares, Finset.mem_filter] at hx ⊢ + rcases hx with ⟨hx0, hx1, hxi, hx1i⟩ + exact ⟨hgchild hx0, hgchild hx1, hgchild hxi, hgchild hx1i⟩ + +private theorem hcov : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (g : PartialOdometer), + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (ai : GaussianInt), ∀ (u : GaussianInt), + let a := ai - (v + GaussianQuarterTurn v) + let gsharp := PartialOdometerAffineTranslate (PartialOdometerHalfTurn g) u a 0 + PartialOdometerSlope gsharp = (PartialOdometerSlope g).map (fun p => (-p.1 + (a.re : + Real), -p.2 + (a.im : Real))) ) := by + classical + intro q g i v ai u a gsharp + rw [(PartialOdometerAffineTranslateFormulas + (PartialOdometerHalfTurn g) u a 0).2.2.2.2.2, + (PartialOdometerHalfTurnFormulas g).2.2.2.2.2.2] + simp only [Option.map_map, Function.comp_def] + +private theorem haRe : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (s0 : Real × Real), + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (ai : GaussianInt), + let a := ai - (v + GaussianQuarterTurn v) + (GaussianRealPoint a = (2 : Real) • s0) → ((a.re : Real) = 2 * s0.1) ) := by + classical + intro q s0 i v ai a ha + have hh := congrArg Prod.fst ha + simpa [GaussianRealPoint] using hh + +private theorem haIm : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (s0 : Real × Real), + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (ai : GaussianInt), + let a := ai - (v + GaussianQuarterTurn v) + (GaussianRealPoint a = (2 : Real) • s0) → ((a.im : Real) = 2 * s0.2) ) := by + classical + intro q s0 i v ai a ha + have hh := congrArg Prod.snd ha + simpa [GaussianRealPoint] using hh + +private theorem hpEq : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (s0 : Real × Real), ∀ (g : PartialOdometer), + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + ∀ (ai : GaussianInt), + let a := ai - (v + GaussianQuarterTurn v) + ∀ (x : GaussianInt), + let p : Real × Real := + ((∑ x ∈ PartialOdometerSquares g, + ((g.value (x + 1) - g.value x + g.value (x + 1 + ⟨0, 1⟩) - + g.value (x + ⟨0, 1⟩) : Int) : Real)) / + (2 * ((PartialOdometerSquares g).card : Real)), + (∑ x ∈ PartialOdometerSquares g, + ((g.value (x + ⟨0, 1⟩) - g.value x + g.value (x + 1 + ⟨0, 1⟩) - + g.value (x + 1) : Int) : Real)) / + (2 * ((PartialOdometerSquares g).card : Real))) + (some p = some (-p.1 + (↑a.re : ℝ), -p.2 + (↑a.im : ℝ))) → (((a.re : Real) = 2 * s0.1) → + (((a.im : Real) = 2 * s0.2) → (p = s0))) ) := by + classical + intro q s0 g i v ai a x p hcov haRe haIm + have hpair := Option.some.inj hcov + apply Prod.ext + · have hh := congrArg Prod.fst hpair + dsimp at hh + linarith [haRe] + · have hh := congrArg Prod.snd hpair + dsimp at hh + linarith [haIm] + +end ReflectedGluingGeometry + +theorem P4250T1ReflectedGluingSlope + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (h : Fin 3 → Bool → PartialOdometer) (s0 : Real × Real) + (ho : ∀ i s, TileOdometer (q i.succ) (cert.P i s) (h i s)) + (hp : ∀ i s, PartialOdometerSlope (h i s) = some + (s0 + (if s = true then (1 : Real) else -1) • + P4250T1SlopeOffset + (BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ))))) + (g : PartialOdometer) + (hgdom : (g.domain : Set GaussianInt) = FootprintVertices T) + (hgcompat : ∀ i s, OdometerCompatibility g (h i s)) + (hunique : ∀ g' : PartialOdometer, + (g'.domain : Set GaussianInt) = FootprintVertices T → + (∀ i s, OdometerCompatibility g' (h i s)) → + ∃ c : Int, ∀ x, x ∈ g.domain → g'.value x - g.value x = c) : + ∃ u a : GaussianInt, + (2 : Real) • TileCentroid T = GaussianRealPoint u ∧ + (2 : Real) • s0 = GaussianRealPoint a ∧ + PartialOdometerSlope g = some s0 := by +-- BODY + classical + let i : Fin 3 := 0 + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + have hpositive := ReflectedGluingGeometry.hpositive q cfg + obtain ⟨pchild, ai, hchild, hhalf, hcells⟩ := + P4250T1DefinedHalfIntegralSlope (q (0 : Fin 3).succ) (cert.P 0 true) + (h 0 true) hpositive (ho 0 true) + have htwo_s0 := ReflectedGluingGeometry.htwo_s0 q s0 pchild ai hhalf + (ReflectedGluingGeometry.hpchild q h s0 hp pchild hchild) + have hturn := BandSignedOccurrenceHalfTurn q (TileCentroid T) cert.P + (fun j s => (cert.outer_occurrence j s).1) + (fun j s => (cert.outer_occurrence j s).2.2) + have hreflect := ReflectedGluingGeometry.hreflect q cfg C T cert hturn + have hcenterIntegral := ReflectedGluingGeometry.hcenterIntegral q cfg C T cert hcells + obtain ⟨u, hu⟩ := hcenterIntegral + let a := ai - (v + GaussianQuarterTurn v) + have ha : GaussianRealPoint a = (2 : Real) • s0 := htwo_s0.symm + have positive := ReflectedGluingGeometry.positive q cfg + let reflectedK (j : Fin 3) (s : Bool) : PartialOdometer := + PartialOdometerAffineTranslate + (PartialOdometerHalfTurn (h j (!s))) u a 0 + have reflectedChild := ReflectedGluingGeometry.reflectedChild q cfg C T cert h s0 ho hp ai u hu + ha positive + have childNonempty := ReflectedGluingGeometry.childNonempty q cfg C T cert h ho positive + have halfSet := ReflectedGluingGeometry.halfSet + have affineHalfMem := ReflectedGluingGeometry.affineHalfMem q ai u + let gsharp := PartialOdometerAffineTranslate (PartialOdometerHalfTurn g) u a 0 + have hgsharpdom := ReflectedGluingGeometry.hgsharpdom q cfg C T cert g hgdom ai u + (ReflectedGluingGeometry.rootFoot q cfg C T cert childNonempty + (ReflectedGluingGeometry.rootNonempty q cfg C T cert childNonempty)) affineHalfMem + (ReflectedGluingGeometry.reflectedFoot q cfg C T cert h s0 ho ai u positive reflectedChild + affineHalfMem) + have sharpCompat := ReflectedGluingGeometry.sharpCompat q cfg C T cert h s0 ho g ai u positive + reflectedChild (ReflectedGluingGeometry.childOdoConst q cfg C T cert h s0 ho hp ai u + positive reflectedChild childNonempty) (ReflectedGluingGeometry.gsharpChildConst q cfg C T + cert h s0 g ai u positive reflectedChild affineHalfMem hgsharpdom + (ReflectedGluingGeometry.gChildConst q cfg C T cert h ho g hgdom hgcompat positive + childNonempty)) + obtain ⟨c, hc⟩ := hunique gsharp hgsharpdom sharpCompat + have hdomEq := ReflectedGluingGeometry.hdomEq q T g hgdom ai u hgsharpdom c + have hsharpSlope : PartialOdometerSlope gsharp = PartialOdometerSlope g := + ReflectedGluingGeometry.hsharpSlope q g ai u c (ReflectedGluingGeometry.hsharpEq q g ai u c + hdomEq (ReflectedGluingGeometry.hvalEq q T g hgdom ai u hgsharpdom c hc hdomEq)) + have hchildSquares := ReflectedGluingGeometry.hchildSquares h pchild hchild + obtain ⟨x, hx⟩ := hchildSquares + have hgSqNonempty : (PartialOdometerSquares g).Nonempty := ReflectedGluingGeometry.hgSqNonempty + h g x hx (ReflectedGluingGeometry.hgchild q cfg C T cert h ho g hgdom positive) + let p : Real × Real := + ((∑ x ∈ PartialOdometerSquares g, + ((g.value (x + 1) - g.value x + g.value (x + 1 + ⟨0, 1⟩) - + g.value (x + ⟨0, 1⟩) : Int) : Real)) / + (2 * ((PartialOdometerSquares g).card : Real)), + (∑ x ∈ PartialOdometerSquares g, + ((g.value (x + ⟨0, 1⟩) - g.value x + g.value (x + 1 + ⟨0, 1⟩) - + g.value (x + 1) : Int) : Real)) / + (2 * ((PartialOdometerSquares g).card : Real))) + have hgslope : PartialOdometerSlope g = some p := by + simp [PartialOdometerSlope, hgSqNonempty, p] + have hcov : PartialOdometerSlope gsharp = + (PartialOdometerSlope g).map (fun p => + (-p.1 + (a.re : Real), -p.2 + (a.im : Real))) := ReflectedGluingGeometry.hcov q g ai u + rw [hsharpSlope, hgslope] at hcov + simp only [Option.map_some] at hcov + have hpEq : p = s0 := ReflectedGluingGeometry.hpEq q s0 g ai x hcov + (ReflectedGluingGeometry.haRe q s0 ai ha) (ReflectedGluingGeometry.haIm q s0 ai ha) + refine ⟨u, a, hu, ha.symm, ?_⟩ + rw [hgslope, hpEq] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1SlopeOffset.lean b/LeanPool/ApollonianSuperharmonic/P4250T1SlopeOffset.lean new file mode 100644 index 0000000000..916a590ed4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4250T1SlopeOffset.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint + +-- [TABLET NODE: P4250T1SlopeOffset] + +/-! +# P4250T1SlopeOffset + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a Gaussian integer $a$, let +$$ + d(a)=\bigl((\Re a-\Im a)/2,(\Im a+\Re a)/2\bigr). +$$ +Thus, identifying the real plane with $\mathbb C$, $d(a)=(a+ia)/2$. +-/ +noncomputable def P4250T1SlopeOffset (a : GaussianInt) : Real × Real := +-- BODY + (((a.re : Real) - (a.im : Real)) / 2, + ((a.im : Real) + (a.re : Real)) / 2) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean b/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean new file mode 100644 index 0000000000..46eae27968 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean @@ -0,0 +1,915 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.RootedFourNeighborForest +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import Mathlib.Combinatorics.SimpleGraph.Acyclic +public import Mathlib.Combinatorics.SimpleGraph.DegreeSum + +-- [TABLET NODE: P4250T2FiniteForestCompletion] + +/-! +# P4250T2FiniteForestCompletion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ForestCompletionLemmas + +private theorem noGridTriangle : + (Finset GaussianInt) → (Finset GaussianInt) → ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z + : GaussianInt), (FourNeighborAdjacent x y) → (FourNeighborAdjacent y z) → + (FourNeighborAdjacent z x) → False := by + classical + intro W R x y z hxy hyz hzx + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] at hxy hyz hzx + omega + +private theorem adjacentSymm : + ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b + a := by + classical + intro a b h + rcases h with h | h | h | h <;> subst b + all_goals simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + +private theorem hHacyclic : + ∀ (W : Finset GaussianInt), (Finset GaussianInt) → (∀ V E, SimpleGridCycle V E → ¬ V ⊆ (W : + Set GaussianInt)) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), + (FourNeighborAdjacent x y) → (FourNeighborAdjacent y z) → (FourNeighborAdjacent z x) → + False) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, + (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), + let H : SimpleGraph GaussianInt := { + Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W + symm := ⟨by + intro x y h + exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ + loopless := ⟨by + intro x h + rcases h.1 with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + H.IsAcyclic := by + classical + intro W R hcycle noGridTriangle adjacentSymm H a c hc + have walkW {u v : GaussianInt} (p : H.Walk u v) (hu : u ∈ W) : + ∀ z ∈ p.support, z ∈ W := by + intro z hz + induction p with + | nil => + simp? [SimpleGraph.Walk.support] at hz + subst z + exact hu + | @cons u v w hadj p ih => + simp only [SimpleGraph.Walk.support_cons, List.mem_cons] at hz + rcases hz with hz | hz + · subst z + exact hadj.2.1 + · exact ih hadj.2.2 hz + cases c with + | nil => simp at hc + | @cons u v w hadj p => + have hp3 : 3 ≤ p.length + 1 := by + simpa using (SimpleGraph.Walk.isCycle_iff_isPath_tail_and_le_length.mp hc).2 + have hp2 : 2 ≤ p.length := by omega + have hlen : p.length ≠ 2 := by + intro heq + have h₁ : H.Adj v (p.getVert 1) := by + simpa using p.adj_getVert_succ (i := 0) (by omega) + have hend : p.getVert 2 = a := by + simpa [heq] using p.getVert_length + have h₂ : H.Adj (p.getVert 1) a := by + simpa [hend] using p.adj_getVert_succ (i := 1) (by omega) + exact noGridTriangle v (p.getVert 1) a h₁.1 h₂.1 hadj.1 + have hp4 : 3 ≤ p.length := by omega + let l : List GaussianInt := p.support + let E : Set (Finset GaussianInt) := {e | e = {a, v} ∨ + ∃ x y l₁ l₂, l = l₁ ++ x :: y :: l₂ ∧ e = {x, y}} + have hsteps {x y : GaussianInt} {l₁ l₂ : List GaussianInt} + (heq : p.support = l₁ ++ x :: y :: l₂) : H.Adj x y := by + have supportAdj : ∀ {s t : GaussianInt} (q : H.Walk s t) + {l₁ l₂ : List GaussianInt} {x y : GaussianInt}, + q.support = l₁ ++ x :: y :: l₂ → H.Adj x y := by + intro s t q + induction q with + | nil => + intro l₁ l₂ x y heq + have hlen := congrArg List.length heq + simp [SimpleGraph.Walk.support] at hlen + omega + | @cons s t r hadj q ih => + intro l₁ l₂ x y heq + cases l₁ with + | nil => + simp only [List.nil_append, SimpleGraph.Walk.support_cons, List.cons.injEq] at heq + rcases heq with ⟨rfl, htail⟩ + have hby : y = t := by + calc + y = q.support.head (by simp) := by simp [htail] + _ = t := by simp + subst y + exact hadj + | cons z zs => + simp only [List.cons_append, SimpleGraph.Walk.support_cons, List.cons.injEq] at heq + rcases heq with ⟨rfl, htail⟩ + exact ih htail + exact supportAdj p heq + have hL : l.Nodup := by + simpa [l] using + (SimpleGraph.Walk.isCycle_iff_isPath_tail_and_le_length.mp hc).1.support_nodup + have hheads : l.head? = some v := by + simp [l, List.head?_eq_some_head, SimpleGraph.Walk.head_support] + have hlast : l.getLast? = some a := by + simp [l, List.getLast?_eq_some_getLast, SimpleGraph.Walk.getLast_support] + have hverts : (l.toFinset : Set GaussianInt) ⊆ W := by + intro z hz + exact walkW p hadj.2.2 z (List.mem_toFinset.mp hz) + exact hcycle (l.toFinset : Set GaussianInt) E + (by + refine ⟨l, v, a, hL, ?_, hheads, hlast, rfl, hadj.1, ?_, ?_⟩ + · simpa [l] using hp4 + · intro x y l₁ l₂ heq + exact (hsteps heq).1 + · intro e + rfl) + hverts + +private theorem finj : + ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ + {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), + let H : SimpleGraph GaussianInt := { + Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W + symm := ⟨by + intro x y h + exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ + loopless := ⟨by + intro x h + rcases h.1 with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + let X := {x : GaussianInt // x ∈ W} + let G : SimpleGraph X := { + Adj := fun x y => FourNeighborAdjacent x.1 y.1 + symm := ⟨by + intro x y h + exact adjacentSymm h⟩ + loopless := ⟨by + intro x h + rcases h with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + let f : G →g H := { + toFun := Subtype.val + map_rel' := by + intro x y h + exact ⟨h, x.2, y.2⟩ + } + Function.Injective f := by + classical + intro W R adjacentSymm H X G f x y h + exact Subtype.ext h + +private theorem hGacyclic : + ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ + {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), + let H : SimpleGraph GaussianInt := { + Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W + symm := ⟨by + intro x y h + exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ + loopless := ⟨by + intro x h + rcases h.1 with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + (H.IsAcyclic) → + let X := {x : GaussianInt // x ∈ W} + let G : SimpleGraph X := { + Adj := fun x y => FourNeighborAdjacent x.1 y.1 + symm := ⟨by + intro x y h + exact adjacentSymm h⟩ + loopless := ⟨by + intro x h + rcases h with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + let f : G →g H := { + toFun := Subtype.val + map_rel' := by + intro x y h + exact ⟨h, x.2, y.2⟩ + } + (Function.Injective f) → G.IsAcyclic := by + classical + intro W R adjacentSymm H hHacyclic X G f finj x c hc + exact hHacyclic (c.map f) (hc.map finj) + +private theorem hPQ : + ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ + {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), + let X := {x : GaussianInt // x ∈ W} + let G : SimpleGraph X := { + Adj := fun x y => FourNeighborAdjacent x.1 y.1 + symm := ⟨by + intro x y h + exact adjacentSymm h⟩ + loopless := ⟨by + intro x h + rcases h with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + letI : DecidableRel FourNeighborAdjacent := fun _ _ => Classical.propDecidable _ + letI : DecidableRel G.Adj := fun _ _ => Classical.propDecidable _ + let P := (W.product W).filter fun e => FourNeighborAdjacent e.1 e.2 + let Q := Finset.univ.filter fun e : X × X => G.Adj e.1 e.2 + P.card = Q.card := by + classical + intro W R adjacentSymm X G P Q + refine Finset.card_bij' (s := P) (t := Q) + (fun e he => (⟨e.1, (Finset.mem_product.mp (Finset.mem_filter.mp he).1).1⟩, + ⟨e.2, (Finset.mem_product.mp (Finset.mem_filter.mp he).1).2⟩)) + (fun q hq => (q.1.1, q.2.1)) ?_ ?_ ?_ ?_ + · intro e he + have he' := Finset.mem_filter.mp he + exact Finset.mem_filter.mpr ⟨Finset.mem_univ _, by simpa [G] using he'.2⟩ + · intro q hq + have hq' := Finset.mem_filter.mp hq + exact Finset.mem_filter.mpr + ⟨Finset.mem_product.mpr ⟨q.1.2, q.2.2⟩, by simpa [G] using hq'.2⟩ + · intro e he + rfl + · intro q hq + apply Prod.ext <;> apply Subtype.ext <;> rfl + +private theorem hordered : + ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ + {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), + let X := {x : GaussianInt // x ∈ W} + let G : SimpleGraph X := { + Adj := fun x y => FourNeighborAdjacent x.1 y.1 + symm := ⟨by + intro x y h + exact adjacentSymm h⟩ + loopless := ⟨by + intro x h + rcases h with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + letI : DecidableRel FourNeighborAdjacent := fun _ _ => Classical.propDecidable _ + letI : DecidableRel G.Adj := fun _ _ => Classical.propDecidable _ + let P := (W.product W).filter fun e => FourNeighborAdjacent e.1 e.2 + let Q := Finset.univ.filter fun e : X × X => G.Adj e.1 e.2 + (P.card = Q.card) → P.card = 2 * G.edgeFinset.card := by + classical + intro W R adjacentSymm X G P Q hPQ + calc + _ = Q.card := hPQ + _ = 2 * G.edgeFinset.card := by simpa [Q] using G.two_mul_card_edgeFinset.symm + +private theorem hdiv : + ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ + {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), + let X := {x : GaussianInt // x ∈ W} + let G : SimpleGraph X := { + Adj := fun x y => FourNeighborAdjacent x.1 y.1 + symm := ⟨by + intro x y h + exact adjacentSymm h⟩ + loopless := ⟨by + intro x h + rcases h with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + letI : DecidableRel FourNeighborAdjacent := fun _ _ => Classical.propDecidable _ + letI : DecidableRel G.Adj := fun _ _ => Classical.propDecidable _ + let P := (W.product W).filter fun e => FourNeighborAdjacent e.1 e.2 + (P.card = 2 * G.edgeFinset.card) → P.card / 2 = G.edgeFinset.card := by + classical + intro W R adjacentSymm X G P hordered + rw [hordered] + simp + +private theorem hcountGraph : + ∀ (W : Finset GaussianInt), ∀ (R : Finset GaussianInt), ((∑ x ∈ W, (1 - if x ∈ R then (1 : ℤ) + else 0)) = ((((W.product W).filter fun e => @decide (FourNeighborAdjacent e.1 e.2) + (Classical.propDecidable _)).card / 2 : ℕ) : ℤ)) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, + ∀ {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), + let X := {x : GaussianInt // x ∈ W} + let G : SimpleGraph X := { + Adj := fun x y => FourNeighborAdjacent x.1 y.1 + symm := ⟨by + intro x y h + exact adjacentSymm h⟩ + loopless := ⟨by + intro x h + rcases h with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + letI : DecidableRel FourNeighborAdjacent := fun _ _ => Classical.propDecidable _ + letI : DecidableRel G.Adj := fun _ _ => Classical.propDecidable _ + let P := (W.product W).filter fun e => FourNeighborAdjacent e.1 e.2 + (P.card / 2 = G.edgeFinset.card) → (∑ x ∈ W, (1 - if x ∈ R then (1 : ℤ) else 0)) = + (G.edgeFinset.card : ℤ) := by + classical + intro W R hcount adjacentSymm X G P hdiv + calc + _ = (↑(P.card / 2) : ℤ) := by + simpa [P, decide_eq_true_eq] using hcount + _ = ↑G.edgeFinset.card := by rw [hdiv] + +private theorem supportAdj : + ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ + {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), + let H : SimpleGraph GaussianInt := { + Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W + symm := ⟨by + intro x y h + exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ + loopless := ⟨by + intro x h + rcases h.1 with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + ∀ {s : GaussianInt}, ∀ {t : GaussianInt}, ∀ (q : H.Walk s t), ∀ {l₁ : List GaussianInt}, ∀ + {l₂ : List GaussianInt}, ∀ {x : GaussianInt}, ∀ {y : GaussianInt}, q.support = l₁ ++ x :: + y :: l₂ → H.Adj x y := by + classical + intro W R adjacentSymm H s t q + induction q with + | nil => + intro l₁ l₂ x y heq + have hlen := congrArg List.length heq + simp [SimpleGraph.Walk.support] at hlen + omega + | @cons s t r hadj q ih => + intro l₁ l₂ x y heq + cases l₁ with + | nil => + simp only [List.nil_append, SimpleGraph.Walk.support_cons, + List.cons.injEq] at heq + rcases heq with ⟨rfl, htail⟩ + have hby : y = t := by + calc + y = q.support.head (by simp) := by simp [htail] + _ = t := by simp + subst y + exact hadj + | cons z zs => + simp only [List.cons_append, SimpleGraph.Walk.support_cons, + List.cons.injEq] at heq + rcases heq with ⟨rfl, htail⟩ + exact ih htail + +private theorem allWalkW : + ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ + {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), + let H : SimpleGraph GaussianInt := { + Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W + symm := ⟨by + intro x y h + exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ + loopless := ⟨by + intro x h + rcases h.1 with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + ∀ {u : GaussianInt}, ∀ {v : GaussianInt}, ∀ (q : H.Walk u v), (u ∈ W) → ∀ z ∈ q.support, z ∈ + W := by + classical + intro W R adjacentSymm H u v q hu z hz + induction q with + | nil => + simp? [SimpleGraph.Walk.support] at hz + subst z + exact hu + | @cons u v w hadj q ih => + simp only [SimpleGraph.Walk.support_cons, List.mem_cons] at hz + rcases hz with hz | hz + · subst z + exact hadj.2.1 + · exact ih hadj.2.2 hz + +private theorem pathToGrid : + ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ + {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), + let H : SimpleGraph GaussianInt := { + Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W + symm := ⟨by + intro x y h + exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ + loopless := ⟨by + intro x h + rcases h.1 with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + (∀ {s : GaussianInt}, ∀ {t : GaussianInt}, ∀ (q : H.Walk s t), ∀ {l₁ : List GaussianInt}, ∀ + {l₂ : List GaussianInt}, ∀ {x : GaussianInt}, ∀ {y : GaussianInt}, q.support = l₁ ++ x :: + y :: l₂ → H.Adj x y) → (∀ {u : GaussianInt}, ∀ {v : GaussianInt}, ∀ (q : H.Walk u v), (u + ∈ W) → ∀ z ∈ q.support, z ∈ W) → ∀ {s : GaussianInt}, ∀ {t : GaussianInt}, ∀ (p : H.Walk + s t), (p.IsPath) → (s ≠ t) → (s ∈ W) → (t ∈ W) → ∃ V E, SimpleGridPathBetween V E s t ∧ V + ⊆ (W : Set GaussianInt) := by + classical + intro W R adjacentSymm H supportAdj allWalkW s t p hp hne hs ht + let l : List GaussianInt := p.support + let E : Set (Finset GaussianInt) := {e | ∃ x y l₁ l₂, + l = l₁ ++ x :: y :: l₂ ∧ e = {x, y}} + have hlen : 2 ≤ l.length := by + have hne : 0 < p.length := by + by_contra hnot + have hz : p.length = 0 := Nat.eq_zero_of_not_pos hnot + have hst : s = t := by + calc + s = p.getVert 0 := by rw [SimpleGraph.Walk.getVert_zero] + _ = t := by simpa [hz] using p.getVert_length + exact hne hst + simpa [l, SimpleGraph.Walk.length_support] using Nat.add_le_add_right hne 1 + have hnodup : l.Nodup := by simpa [l] using hp.support_nodup + have hhead : l.head? = some s := by + simp [l, List.head?_eq_some_head, SimpleGraph.Walk.head_support] + have hlast : l.getLast? = some t := by + simp [l, List.getLast?_eq_some_getLast, SimpleGraph.Walk.getLast_support] + have hV : (l.toFinset : Set GaussianInt) ⊆ (W : Set GaussianInt) := by + intro z hz + exact allWalkW p hs z (List.mem_toFinset.mp hz) + refine ⟨l.toFinset, E, ?_, hV⟩ + refine ⟨l, hnodup, hlen, hhead, hlast, rfl, ?_, ?_⟩ + · intro x y l₁ l₂ heq + exact (supportAdj p heq).1 + · intro e + rfl + +private theorem hrootSeparateGraph : + ∀ (W : Finset GaussianInt), ∀ (R : Finset GaussianInt), (∀ a ∈ R, ∀ b ∈ R, ∀ V E, + SimpleGridPathBetween V E a b → V ⊆ (W : Set GaussianInt) → a = b) → ∀ (adjacentSymm : ∀ + {a : GaussianInt}, ∀ {b : GaussianInt}, (FourNeighborAdjacent a b) → + FourNeighborAdjacent + b a), + let H : SimpleGraph GaussianInt := { + Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W + symm := ⟨by + intro x y h + exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ + loopless := ⟨by + intro x h + rcases h.1 with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + let X := {x : GaussianInt // x ∈ W} + let G : SimpleGraph X := { + Adj := fun x y => FourNeighborAdjacent x.1 y.1 + symm := ⟨by + intro x y h + exact adjacentSymm h⟩ + loopless := ⟨by + intro x h + rcases h with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + let f : G →g H := { + toFun := Subtype.val + map_rel' := by + intro x y h + exact ⟨h, x.2, y.2⟩ + } + (Function.Injective f) → (∀ {s : GaussianInt}, ∀ {t : GaussianInt}, ∀ (p : H.Walk s t), + (p.IsPath) → (s ≠ t) → (s ∈ W) → (t ∈ W) → ∃ V E, SimpleGridPathBetween V E s t ∧ V ⊆ (W + : Set GaussianInt)) → ∀ x : X, x.1 ∈ R → ∀ y : X, y.1 ∈ R → + G.Reachable x y → x.1 = y.1 := by + classical + intro W R hseparate adjacentSymm H X G f finj pathToGrid x hx y hy hxy + by_cases heq : x.1 = y.1 + · exact heq + · obtain ⟨p, hp, hlen⟩ := hxy.exists_path_of_dist + let q := p.map f + have hqpath : q.IsPath := SimpleGraph.Walk.IsPath.map finj hp + obtain ⟨V, E, hgrid, hV⟩ := pathToGrid q hqpath heq x.2 y.2 + exact (heq (hseparate x.1 hx y.1 hy V E hgrid hV)).elim + +private theorem forestCount : + (Finset GaussianInt) → (Finset GaussianInt) → (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, + (FourNeighborAdjacent a b) → FourNeighborAdjacent b a) → ∀ {V : Type}, ∀ [Fintype V], ∀ + (G : SimpleGraph V), ∀ [DecidableRel G.Adj], (G.IsAcyclic) → G.edgeFinset.card + Nat.card + G.ConnectedComponent = Fintype.card V := by + classical + intro W R adjacentSymm V finiteType G adjacencyDecidability hG + classical + let : Fintype G.ConnectedComponent := Fintype.ofFinite _ + have hdegree (c : G.ConnectedComponent) (v : c) : + c.toSimpleGraph.degree v = G.degree v.val := by + calc + _ = (G.induce c.supp).degree v := by + rw [← SimpleGraph.card_neighborSet_eq_degree, ← SimpleGraph.card_neighborSet_eq_degree] + exact Fintype.card_congr (Equiv.refl ↑(c.toSimpleGraph.neighborSet v)) + _ = _ := G.degree_induce_of_neighborSet_subset (s := c.supp) (v := v) + (fun w hw => c.mem_supp_of_adj_mem_supp v.property hw) + have hvertices : (∑ c : G.ConnectedComponent, Fintype.card c) = Fintype.card V := by + change (∑ c : G.ConnectedComponent, Fintype.card {v // G.connectedComponentMk v = c}) = _ + simpa using Fintype.sum_fiberwise G.connectedComponentMk (fun _ => (1 : ℕ)) + have hdegrees : (∑ c : G.ConnectedComponent, ∑ v : c, c.toSimpleGraph.degree v) = + ∑ v : V, G.degree v := by + simp_rw [hdegree] + exact Fintype.sum_fiberwise G.connectedComponentMk (fun v => G.degree v) + have hedges : (∑ c : G.ConnectedComponent, c.toSimpleGraph.edgeFinset.card) = + G.edgeFinset.card := by + have ht : 2 * (∑ c : G.ConnectedComponent, c.toSimpleGraph.edgeFinset.card) = + 2 * G.edgeFinset.card := by + rw [Finset.mul_sum] + simp_rw [← SimpleGraph.sum_degrees_eq_twice_card_edges] + exact hdegrees + omega + have hsum : (∑ c : G.ConnectedComponent, (c.toSimpleGraph.edgeFinset.card + 1)) = + ∑ c : G.ConnectedComponent, Fintype.card c := by + apply Finset.sum_congr rfl + intro c hc + exact (hG.isTree_connectedComponent c).card_edgeFinset + rw [Finset.sum_add_distrib, hedges, hvertices] at hsum + simpa [Nat.card_eq_fintype_card] using hsum + +private theorem forestRooted : + (Finset GaussianInt) → (Finset GaussianInt) → (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, + (FourNeighborAdjacent a b) → FourNeighborAdjacent b a) → (∀ {V : Type}, ∀ [Fintype V], ∀ + (G : SimpleGraph V), ∀ [DecidableRel G.Adj], (G.IsAcyclic) → G.edgeFinset.card + Nat.card + G.ConnectedComponent = Fintype.card V) → ∀ {V : Type}, ∀ [Fintype V], ∀ (G : SimpleGraph + V), ∀ [DecidableRel G.Adj], (G.IsAcyclic) → ∀ (S : Set V), (∀ x ∈ S, ∀ y ∈ S, + G.Reachable x y → x = y) → (G.edgeFinset.card + Nat.card S = Fintype.card V) → ∃ + parent : V → V, ∃ rank : V → ℕ, + (∀ r ∈ S, parent r = r) ∧ + (∀ x, x ∉ S → G.Adj (parent x) x ∧ rank (parent x) < rank x) ∧ + (∀ x, x ∈ S ↔ rank x = 0) ∧ + (∀ x y, G.Adj x y → x = parent y ∨ y = parent x) := by + classical + intro W R adjacentSymm forestCount V finiteType G adjacencyDecidability hG S hsep hnum + classical + let : Fintype G.ConnectedComponent := Fintype.ofFinite _ + have hcard : Fintype.card S = Fintype.card G.ConnectedComponent := by + have hc := forestCount G hG + rw [Nat.card_eq_fintype_card] at hnum hc + omega + let rootMap : S → G.ConnectedComponent := fun r => G.connectedComponentMk r.val + have hinj : Function.Injective rootMap := by + intro x y hxy + apply Subtype.ext + exact hsep x.val x.property y.val y.property (SimpleGraph.ConnectedComponent.exact hxy) + have hsurj : Function.Surjective rootMap := + ((Fintype.bijective_iff_injective_and_card rootMap).mpr ⟨hinj, hcard⟩).2 + have hex : ∀ c : G.ConnectedComponent, ∃ r : c, r.val ∈ S := by + intro c + obtain ⟨r, hr⟩ := hsurj c + exact ⟨⟨r.val, hr⟩, r.property⟩ + choose root hroot using hex + have hrootEq (c : G.ConnectedComponent) (x : c) (hx : x.val ∈ S) : x = root c := by + apply Subtype.ext + exact hsep x.val hx (root c).val (hroot c) + (c.reachable_of_mem_supp x.property (root c).property) + have extract (c : G.ConnectedComponent) : + ∃ parent : c → c, ∃ rank : c → ℕ, + parent (root c) = root c ∧ + (∀ x, x ≠ root c → c.toSimpleGraph.Adj (parent x) x ∧ + rank (parent x) < rank x) ∧ + (∀ x, rank x = 0 ↔ x = root c) ∧ + (∀ x y, c.toSimpleGraph.Adj x y → x = parent y ∨ y = parent x) := by + let T := c.toSimpleGraph + have hacyc : T.IsAcyclic := (hG.isTree_connectedComponent c).isAcyclic + have hreach : ∀ x, T.Reachable (root c) x := + fun x => c.connected_toSimpleGraph.preconnected (root c) x + choose p hp hd using fun x => (hreach x).exists_path_of_dist + let parent : c → c := fun x => (p x).penultimate + let rank : c → ℕ := fun x => (p x).length + refine ⟨parent, rank, ?_, ?_, ?_, ?_⟩ + · have hnil : p (root c) = .nil := by + exact Subtype.mk.inj (hacyc.subsingleton_path (root c) (root c) |>.elim + (Subtype.mk (p (root c)) (hp (root c))) (Subtype.mk .nil SimpleGraph.Walk.IsPath.nil)) + simp [parent, hnil] + · intro x hx + have hnon : ¬ (p x).Nil := SimpleGraph.Walk.not_nil_of_ne (Ne.symm hx) + refine ⟨(p x).adj_penultimate hnon, ?_⟩ + have hpath : p (parent x) = (p x).dropLast := by + exact Subtype.mk.inj (hacyc.subsingleton_path (root c) (parent x) |>.elim + (Subtype.mk (p (parent x)) (hp (parent x))) + (Subtype.mk (p x).dropLast (hp x).dropLast)) + have hlen := (p x).length_dropLast_add_one hnon + change (p (parent x)).length < (p x).length + rw [hpath] + omega + · intro x + change (p x).length = 0 ↔ x = root c + rw [hd x, (hreach x).dist_eq_zero_iff, eq_comm] + · intro x y hxy + by_cases hx : x ∈ (p y).support + · have heq := hacyc.path_concat (hp x) (hp y) hxy hx + left + change x = (p y).penultimate + rw [heq, SimpleGraph.Walk.penultimate_concat] + · have hy := hacyc.mem_support_of_ne_mem_support_of_adj_of_isPath + (hp x) (hp y) hxy hx + have heq := hacyc.path_concat (hp y) (hp x) hxy.symm hy + right + change y = (p x).penultimate + rw [heq, SimpleGraph.Walk.penultimate_concat] + choose pc nc hself hnon hzero hedge using extract + let parentV : V → V := fun x => (pc (G.connectedComponentMk x) ⟨x, rfl⟩).val + let rankV : V → ℕ := fun x => nc (G.connectedComponentMk x) ⟨x, rfl⟩ + have hparentV (c : G.ConnectedComponent) (x : c) : + parentV x.val = (pc c x).val := by + rcases x with ⟨x, hx⟩ + change G.connectedComponentMk x = c at hx + subst c + rfl + have hrankV (c : G.ConnectedComponent) (x : c) : rankV x.val = nc c x := by + rcases x with ⟨x, hx⟩ + change G.connectedComponentMk x = c at hx + subst c + rfl + refine ⟨parentV, rankV, ?_, ?_, ?_, ?_⟩ + · intro r hr + let c := G.connectedComponentMk r + let x : c := ⟨r, rfl⟩ + have he := hrootEq c x hr + change parentV x.val = x.val + rw [hparentV c x, he, hself] + · intro x hx + let c := G.connectedComponentMk x + let v : c := ⟨x, rfl⟩ + have hvr : v ≠ root c := by + intro he + apply hx + change v.val ∈ S + rw [he] + exact hroot c + obtain ⟨ha, hl⟩ := hnon c v hvr + constructor + · change G.Adj (parentV v.val) v.val + rw [hparentV c v] + exact ha + · change rankV (parentV v.val) < rankV v.val + rw [hparentV c v, hrankV c (pc c v), hrankV c v] + exact hl + · intro x + let c := G.connectedComponentMk x + let v : c := ⟨x, rfl⟩ + constructor + · intro hx + change rankV v.val = 0 + rw [hrankV c v] + exact (hzero c v).2 (hrootEq c v hx) + · intro hz + have hz' : nc c v = 0 := by rw [← hrankV c v]; exact hz + have he := (hzero c v).1 hz' + change v.val ∈ S + rw [he] + exact hroot c + · intro x y hxy + let c := G.connectedComponentMk x + let vx : c := ⟨x, rfl⟩ + let vy : c := ⟨y, SimpleGraph.ConnectedComponent.sound hxy.symm.reachable⟩ + obtain h | h := hedge c vx vy hxy + · left + change vx.val = parentV vy.val + rw [hparentV c vy] + exact congrArg Subtype.val h + · right + change vy.val = parentV vx.val + rw [hparentV c vx] + exact congrArg Subtype.val h + +private theorem hsumIndicator : + ∀ (W : Finset GaussianInt), ∀ (R : Finset GaussianInt), (R ⊆ W) → (∑ x ∈ W, (1 - if x ∈ R + then (1 : ℤ) else 0)) = + (W.card : ℤ) - (R.card : ℤ) := by + classical + intro W R hRW + have hfilter : W.filter (fun x => x ∈ R) = R := by + ext x + simp only [Finset.mem_filter] + exact ⟨fun h => h.2, fun h => ⟨hRW h, h⟩⟩ + rw [Finset.sum_sub_distrib, ← Finset.sum_filter, hfilter] + simp + +private theorem hcardS : + ∀ (W : Finset GaussianInt), ∀ (R : Finset GaussianInt), (R ⊆ W) → + let X := {x : GaussianInt // x ∈ W} + let S : Set X := {x | x.val ∈ R} + Nat.card S = R.card := by + classical + intro W R hRW X S + let e : S ≃ {x : GaussianInt // x ∈ R} := { + toFun := fun x => ⟨x.val.val, x.property⟩ + invFun := fun r => ⟨⟨r.val, hRW r.property⟩, r.property⟩ + left_inv := fun _ => rfl + right_inv := fun _ => rfl + } + calc + _ = Nat.card {x : GaussianInt // x ∈ R} := Nat.card_congr e + _ = R.card := by simp [Nat.card_eq_fintype_card] + +private theorem hbudget : + ∀ (W : Finset GaussianInt), ∀ (R : Finset GaussianInt), ((∑ x ∈ W, (1 - if x ∈ R then (1 : ℤ) + else 0)) = ((((W.product W).filter fun e => @decide (FourNeighborAdjacent e.1 e.2) + (Classical.propDecidable _)).card / 2 : ℕ) : ℤ)) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, + ∀ {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), + let X := {x : GaussianInt // x ∈ W} + let G : SimpleGraph X := { + Adj := fun x y => FourNeighborAdjacent x.1 y.1 + symm := ⟨by + intro x y h + exact adjacentSymm h⟩ + loopless := ⟨by + intro x h + rcases h with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + letI : DecidableRel FourNeighborAdjacent := fun _ _ => Classical.propDecidable _ + letI : DecidableRel G.Adj := fun _ _ => Classical.propDecidable _ + let P := (W.product W).filter fun e => FourNeighborAdjacent e.1 e.2 + (P.card / 2 = G.edgeFinset.card) → ((∑ x ∈ W, (1 - if x ∈ R then (1 : ℤ) else 0)) = + (G.edgeFinset.card : ℤ)) → ((∑ x ∈ W, (1 - if x ∈ R then (1 : ℤ) else 0)) = (W.card : ℤ) + - (R.card : ℤ)) → + let S : Set X := {x | x.val ∈ R} + (Nat.card S = R.card) → G.edgeFinset.card + Nat.card S = Fintype.card X := by + classical + intro W R hcount adjacentSymm X G P hdiv hcountGraph hsumIndicator S hcardS + have hc : (W.card : ℤ) - (R.card : ℤ) = (G.edgeFinset.card : ℤ) := + hsumIndicator.symm.trans hcountGraph + have hcardX : Fintype.card X = W.card := by simp [X] + rw [hcardS, hcardX] + omega + +private theorem hparent : + ∀ (W : Finset GaussianInt), + let X := {x : GaussianInt // x ∈ W} + ∀ (p : X → X), + let parent : GaussianInt → GaussianInt := fun x => + if hx : x ∈ W then (p ⟨x, hx⟩).val else x + ∀ (x : X), parent x.val = (p x).val := by + classical + intro W X p parent x + simp [parent, x.property] + +private theorem hrank : + ∀ (W : Finset GaussianInt), + let X := {x : GaussianInt // x ∈ W} + ∀ (depth : X → ℕ), + let rank : GaussianInt → ℕ := fun x => + if hx : x ∈ W then depth ⟨x, hx⟩ else 0 + ∀ (x : X), rank x.val = depth x := by + classical + intro W X depth rank x + simp [rank, x.property] + +end ForestCompletionLemmas + +theorem P4250T2FiniteForestCompletion + (W R : Finset GaussianInt) (hRW : R ⊆ W) + (hcycle : ∀ V E, SimpleGridCycle V E → ¬ V ⊆ (W : Set GaussianInt)) + (hseparate : ∀ a ∈ R, ∀ b ∈ R, ∀ V E, + SimpleGridPathBetween V E a b → V ⊆ (W : Set GaussianInt) → a = b) + (hcount : (∑ x ∈ W, (1 - if x ∈ R then (1 : ℤ) else 0)) = + ((((W.product W).filter fun e => @decide (FourNeighborAdjacent e.1 e.2) + (Classical.propDecidable _)).card / 2 : ℕ) : ℤ)) : + RootedFourNeighborForest W R := by +-- BODY + classical + have noGridTriangle (x y z : GaussianInt) + (hxy : FourNeighborAdjacent x y) + (hyz : FourNeighborAdjacent y z) + (hzx : FourNeighborAdjacent z x) : False := ForestCompletionLemmas.noGridTriangle W R x y z + hxy hyz hzx + have adjacentSymm {a b : GaussianInt} (h : FourNeighborAdjacent a b) : + FourNeighborAdjacent b a := ForestCompletionLemmas.adjacentSymm (a := a) (b := b) h + let H : SimpleGraph GaussianInt := { + Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W + symm := ⟨by + intro x y h + exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ + loopless := ⟨by + intro x h + rcases h.1 with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + have hHacyclic : H.IsAcyclic := ForestCompletionLemmas.hHacyclic W R hcycle noGridTriangle + adjacentSymm + let X := {x : GaussianInt // x ∈ W} + let G : SimpleGraph X := { + Adj := fun x y => FourNeighborAdjacent x.1 y.1 + symm := ⟨by + intro x y h + exact adjacentSymm h⟩ + loopless := ⟨by + intro x h + rcases h with h | h | h | h <;> + simp [Zsqrtd.ext_iff] at h <;> omega⟩ + } + let f : G →g H := { + toFun := Subtype.val + map_rel' := by + intro x y h + exact ⟨h, x.2, y.2⟩ + } + have finj : Function.Injective f := ForestCompletionLemmas.finj W R adjacentSymm + have hGacyclic : G.IsAcyclic := ForestCompletionLemmas.hGacyclic W R adjacentSymm hHacyclic finj + let P := (W.product W).filter fun e => FourNeighborAdjacent e.1 e.2 + let Q := Finset.univ.filter fun e : X × X => G.Adj e.1 e.2 + have hPQ : P.card = Q.card := ForestCompletionLemmas.hPQ W R adjacentSymm + have hordered : P.card = 2 * G.edgeFinset.card := ForestCompletionLemmas.hordered W R + adjacentSymm hPQ + have hdiv : P.card / 2 = G.edgeFinset.card := ForestCompletionLemmas.hdiv W R adjacentSymm + hordered + have hcountGraph : (∑ x ∈ W, (1 - if x ∈ R then (1 : ℤ) else 0)) = + (G.edgeFinset.card : ℤ) := ForestCompletionLemmas.hcountGraph W R hcount adjacentSymm hdiv + have supportAdj : ∀ {s t : GaussianInt} (q : H.Walk s t) + {l₁ l₂ : List GaussianInt} {x y : GaussianInt}, + q.support = l₁ ++ x :: y :: l₂ → H.Adj x y := ForestCompletionLemmas.supportAdj W R + adjacentSymm + have allWalkW {u v : GaussianInt} (q : H.Walk u v) (hu : u ∈ W) : + ∀ z ∈ q.support, z ∈ W := ForestCompletionLemmas.allWalkW W R adjacentSymm (u := u) (v := + v) q hu + have pathToGrid {s t : GaussianInt} (p : H.Walk s t) (hp : p.IsPath) + (hne : s ≠ t) (hs : s ∈ W) (ht : t ∈ W) : + ∃ V E, SimpleGridPathBetween V E s t ∧ V ⊆ (W : Set GaussianInt) := + ForestCompletionLemmas.pathToGrid W R adjacentSymm supportAdj allWalkW (s := s) (t := + t) p hp hne hs ht + have hrootSeparateGraph : ∀ x : X, x.1 ∈ R → ∀ y : X, y.1 ∈ R → + G.Reachable x y → x.1 = y.1 := ForestCompletionLemmas.hrootSeparateGraph W R hseparate + adjacentSymm finj pathToGrid + have forestCount {V : Type} [Fintype V] (G : SimpleGraph V) [DecidableRel G.Adj] + (hG : G.IsAcyclic) : + G.edgeFinset.card + Nat.card G.ConnectedComponent = Fintype.card V := + ForestCompletionLemmas.forestCount W R adjacentSymm (V := V) G hG + have forestRooted {V : Type} [Fintype V] (G : SimpleGraph V) [DecidableRel G.Adj] + (hG : G.IsAcyclic) (S : Set V) + (hsep : ∀ x ∈ S, ∀ y ∈ S, G.Reachable x y → x = y) + (hnum : G.edgeFinset.card + Nat.card S = Fintype.card V) : + ∃ parent : V → V, ∃ rank : V → ℕ, + (∀ r ∈ S, parent r = r) ∧ + (∀ x, x ∉ S → G.Adj (parent x) x ∧ rank (parent x) < rank x) ∧ + (∀ x, x ∈ S ↔ rank x = 0) ∧ + (∀ x y, G.Adj x y → x = parent y ∨ y = parent x) := ForestCompletionLemmas.forestRooted W + R adjacentSymm forestCount (V := V) G hG S hsep hnum + have hsumIndicator : (∑ x ∈ W, (1 - if x ∈ R then (1 : ℤ) else 0)) = + (W.card : ℤ) - (R.card : ℤ) := ForestCompletionLemmas.hsumIndicator W R hRW + let S : Set X := {x | x.val ∈ R} + have hcardS : Nat.card S = R.card := ForestCompletionLemmas.hcardS W R hRW + have hbudget : G.edgeFinset.card + Nat.card S = Fintype.card X := + ForestCompletionLemmas.hbudget W R hcount adjacentSymm hdiv hcountGraph hsumIndicator hcardS + obtain ⟨p, depth, hp, hpar, hzero, hedge⟩ := + forestRooted G hGacyclic S + (by + intro x hx y hy hxy + exact Subtype.ext (hrootSeparateGraph x hx y hy hxy)) + hbudget + let parent : GaussianInt → GaussianInt := fun x => + if hx : x ∈ W then (p ⟨x, hx⟩).val else x + let rank : GaussianInt → ℕ := fun x => + if hx : x ∈ W then depth ⟨x, hx⟩ else 0 + have hparent (x : X) : parent x.val = (p x).val := ForestCompletionLemmas.hparent W p x + have hrank (x : X) : rank x.val = depth x := ForestCompletionLemmas.hrank W depth x + refine ⟨hRW, parent, rank, ?_, ?_, ?_, ?_⟩ + · intro r hr + let x : X := ⟨r, hRW hr⟩ + change parent x.val = x.val + rw [hparent x, hp x hr] + · intro x hx hxr + let v : X := ⟨x, hx⟩ + obtain ⟨ha, hl⟩ := hpar v hxr + refine ⟨?_, ?_, ?_⟩ + · change parent v.val ∈ W + rw [hparent v] + exact (p v).property + · change FourNeighborAdjacent (parent v.val) v.val + rw [hparent v] + exact ha + · change rank (parent v.val) < rank v.val + rw [hparent v, hrank (p v), hrank v] + exact hl + · intro x hx + let v : X := ⟨x, hx⟩ + change v.val ∈ R ↔ rank v.val = 0 + rw [hrank v] + exact hzero v + · intro x hx y hy hxy + let vx : X := ⟨x, hx⟩ + let vy : X := ⟨y, hy⟩ + obtain h | h := hedge vx vy hxy + · left + change vx.val = parent vy.val + rw [hparent vy] + exact congrArg Subtype.val h + · right + change vy.val = parent vx.val + rw [hparent vx] + exact congrArg Subtype.val h + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2IndegreeSubtraction.lean b/LeanPool/ApollonianSuperharmonic/P4250T2IndegreeSubtraction.lean new file mode 100644 index 0000000000..5a78756fca --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4250T2IndegreeSubtraction.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation + +-- [TABLET NODE: P4250T2IndegreeSubtraction] + +/-! +# P4250T2IndegreeSubtraction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4250T2IndegreeSubtraction + (D P : Finset GaussianInt) (σ : GaussianInt → ℤ) + (hPD : P ⊆ D) (hP : Nonempty (AcyclicIndegreeOrientation P σ)) + (htotal : (∑ x ∈ D, σ x) = + ((((D.product D).filter fun e => @decide (FourNeighborAdjacent e.1 e.2) + (Classical.propDecidable _)).card / 2 : ℕ) : ℤ)) : + let W := D \ P + (∑ x ∈ W, (σ x - + ((P.filter fun y => @decide (FourNeighborAdjacent y x) + (Classical.propDecidable _)).card : ℤ))) = + ((((W.product W).filter fun e => @decide (FourNeighborAdjacent e.1 e.2) + (Classical.propDecidable _)).card / 2 : ℕ) : ℤ) := by +-- BODY + classical + let W := D \ P + let count (S T : Finset GaussianInt) (r : GaussianInt → GaussianInt → Prop) : ℤ := + ∑ x ∈ S, ∑ y ∈ T, if r x y then 1 else 0 + have hcard (S T : Finset GaussianInt) (r : GaussianInt → GaussianInt → Prop) : + (((S.product T).filter fun e => r e.1 e.2).card : ℤ) = count S T r := by + simp only [Finset.card_filter, Nat.cast_sum, Nat.cast_ite, Nat.cast_one, + Nat.cast_zero, count] + exact Finset.sum_product' S T (fun x y => if r x y then (1 : ℤ) else 0) + have hswap (S T : Finset GaussianInt) (r : GaussianInt → GaussianInt → Prop) : + count S T (fun x y => r y x) = count T S r := by + exact Finset.sum_comm + have adjacent_symm {x y : GaussianInt} (h : FourNeighborAdjacent x y) : + FourNeighborAdjacent y x := by + rcases h with h | h | h | h <;> subst y + all_goals simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + have adjacent_comm (x y : GaussianInt) : + FourNeighborAdjacent y x ↔ FourNeighborAdjacent x y := + ⟨adjacent_symm, adjacent_symm⟩ + have hcount_symm (S T : Finset GaussianInt) : + count S T FourNeighborAdjacent = count T S FourNeighborAdjacent := by + simpa only [adjacent_comm] using hswap S T FourNeighborAdjacent + -- East and north select exactly one order of each lattice edge. + let positive (x y : GaussianInt) : Prop := + y = x + 1 ∨ y = x + (⟨0, 1⟩ : GaussianInt) + have hpoint (x y : GaussianInt) : + (if FourNeighborAdjacent x y then (1 : ℤ) else 0) = + (if positive x y then 1 else 0) + (if positive y x then 1 else 0) := by + by_cases h : FourNeighborAdjacent x y + · rcases h with h | h | h | h <;> subst y + all_goals simp [positive, FourNeighborAdjacent, Zsqrtd.ext_iff]; omega + · have hpos : ¬ positive x y := by + rintro (hxy | hxy) + · exact h (Or.inl hxy) + · exact h (Or.inr (Or.inr (Or.inl hxy))) + have hrev : ¬ positive y x := by + rintro (hyx | hyx) + · exact h (adjacent_symm (Or.inl hyx)) + · exact h (adjacent_symm (Or.inr (Or.inr (Or.inl hyx)))) + simp only [ite_eq_right h, ite_eq_right hpos, ite_eq_right hrev, add_zero] + have hhalf (S : Finset GaussianInt) : + count S S FourNeighborAdjacent = + 2 * ((((S.product S).filter fun e => FourNeighborAdjacent e.1 e.2).card / + 2 : ℕ) : ℤ) := by + have hsum : count S S FourNeighborAdjacent = + count S S positive + count S S (fun x y => positive y x) := by + dsimp only [count] + simp_rw [hpoint] + rw [Finset.sum_congr rfl (fun x _ => Finset.sum_add_distrib), + Finset.sum_add_distrib] + congr 1 <;> apply Finset.sum_congr rfl <;> intro x _ <;> + apply Finset.sum_congr rfl <;> intro y _ + all_goals split_ifs <;> rfl + rw [hswap S S positive] at hsum + rw [← hcard S S FourNeighborAdjacent, ← hcard S S positive] at hsum + rw [← hcard S S FourNeighborAdjacent] + omega + have hdisjoint : Disjoint P W := by + exact Finset.disjoint_left.mpr (fun x hx hw => (Finset.mem_sdiff.mp hw).2 hx) + have hunion : D = P ∪ W := by + symm + exact Finset.union_sdiff_of_subset hPD + have hsplit (f : GaussianInt → ℤ) : + (∑ x ∈ D, f x) = (∑ x ∈ P, f x) + ∑ x ∈ W, f x := by + rw [hunion, Finset.sum_union hdisjoint] + have hpartition : count D D FourNeighborAdjacent = + count P P FourNeighborAdjacent + count W W FourNeighborAdjacent + + 2 * count P W FourNeighborAdjacent := by + calc + _ = (count P P FourNeighborAdjacent + count P W FourNeighborAdjacent) + + (count W P FourNeighborAdjacent + count W W FourNeighborAdjacent) := by + dsimp only [count] + rw [hsplit] + simp_rw [hsplit, Finset.sum_add_distrib] + _ = _ := by rw [hcount_symm W P]; ring + obtain ⟨o⟩ := hP + have hindegree : (∑ x ∈ P, σ x) = count P P o.edge := by + calc + _ = ∑ x ∈ P, ∑ y ∈ P, if o.edge y x then (1 : ℤ) else 0 := by + apply Finset.sum_congr rfl + intro x hx + have hi := o.indegree x hx + simpa only [Finset.card_filter, decide_eq_true_eq, Nat.cast_sum, + Nat.cast_ite, Nat.cast_one, Nat.cast_zero] using hi.symm + _ = _ := hswap P P o.edge + have horient : count P P FourNeighborAdjacent = 2 * count P P o.edge := by + have hlocal (x : GaussianInt) (hx : x ∈ P) (y : GaussianInt) (hy : y ∈ P) : + (if FourNeighborAdjacent x y then (1 : ℤ) else 0) = + (if o.edge x y then 1 else 0) + (if o.edge y x then 1 else 0) := by + by_cases hxy : FourNeighborAdjacent x y + · rcases o.oriented x hx y hy hxy with h | h + · simp only [ite_eq_left hxy, ite_eq_left h.1, ite_eq_right h.2, add_zero] + · simp only [ite_eq_left hxy, ite_eq_left h.1, ite_eq_right h.2, zero_add] + · have hnot : ¬ o.edge x y := fun h => hxy (o.supported x y h).2.2 + have hnotrev : ¬ o.edge y x := + fun h => hxy (adjacent_symm (o.supported y x h).2.2) + simp only [ite_eq_right hxy, ite_eq_right hnot, ite_eq_right hnotrev, add_zero] + calc + _ = count P P o.edge + count P P (fun x y => o.edge y x) := by + dsimp only [count] + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro x hx + rw [← Finset.sum_add_distrib] + exact Finset.sum_congr rfl (fun y hy => hlocal x hx y hy) + _ = _ := by rw [hswap]; ring + have hcross : + (∑ x ∈ W, ((P.filter fun y => @decide (FourNeighborAdjacent y x) + (Classical.propDecidable _)).card : ℤ)) = count P W FourNeighborAdjacent := by + rw [← hswap W P FourNeighborAdjacent] + simp only [count, Finset.card_filter, decide_eq_true_eq, Nat.cast_sum, + Nat.cast_ite, Nat.cast_one, Nat.cast_zero] + change (∑ x ∈ W, _) = _ + rw [Finset.sum_sub_distrib, hcross] + have hd := hhalf D + have hw := hhalf W + have ht : (∑ x ∈ P, σ x) + (∑ x ∈ W, σ x) = + ((((D.product D).filter fun e => FourNeighborAdjacent e.1 e.2).card / + 2 : ℕ) : ℤ) := by + simpa only [hsplit, decide_eq_true_eq] using htotal + have hfinal : (∑ x ∈ W, σ x) - count P W FourNeighborAdjacent = + ((((W.product W).filter fun e => FourNeighborAdjacent e.1 e.2).card / + 2 : ℕ) : ℤ) := by + linarith + simpa only [decide_eq_true_eq] using hfinal + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean new file mode 100644 index 0000000000..805c2c5bbb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean @@ -0,0 +1,1313 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.TopologicalDiskGridRayCrossingIndexZero + +-- [TABLET NODE: P4250T2InterfaceCycleExclusion] + +/-! +# P4250T2InterfaceCycleExclusion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace InterfaceCycleGeometry + +private theorem path_omits_boundary : + (by + classical + exact + ∀ (U : ProtoTile), (LatticeTile U) → (∀ (Q : Set GaussianInt), ∀ (R : Set (Finset + GaussianInt)), (SimpleGridPath Q R) → (∃ e ∈ BoundaryFootprintEdges U, e ∉ R)) ) := by + classical + intro U hU Q R hR + as_aux_lemma => + have hUne : U.cells.Nonempty := (LatticeTileGridStructure U hU).1.1 + obtain ⟨r, hr, hrl, hrv, hra, hre⟩ := hR + obtain ⟨p, x, y, hp, hpl, hph, hpt, hpv, hpc, hpa, hpe⟩ := + (LatticeTileGridStructure U hU).2.2 + have hpne : p.toFinset.Nonempty := by + obtain ⟨p', hp'⟩ := List.head?_eq_some_iff.mp hph + exact ⟨x, by simp [hp']⟩ + obtain ⟨v, hv, hmin⟩ := p.toFinset.exists_min_image (fun a => r.idxOf a) hpne + have hvU : v ∈ BoundaryFootprintVertices U := by + rw [hpv]; exact hv + have hminU : ∀ w ∈ BoundaryFootprintVertices U, r.idxOf v ≤ r.idxOf w := by + intro w hw + apply hmin w + simpa [hpv] using hw + have degree := BoundaryFootprintVertexDegreeTwo U hUne + (LatticeTileGridStructure U hU).2.1 v hvU + obtain ⟨e, f, hef, heq⟩ := Set.ncard_eq_two.mp degree + have he : e ∈ BoundaryFootprintEdges U ∧ v ∈ e := by + change e ∈ {e | e ∈ BoundaryFootprintEdges U ∧ v ∈ e} + rw [heq]; simp + have hf : f ∈ BoundaryFootprintEdges U ∧ v ∈ f := by + change f ∈ {e | e ∈ BoundaryFootprintEdges U ∧ v ∈ e} + rw [heq]; simp + by_contra hn + have hall : ∀ e ∈ BoundaryFootprintEdges U, e ∈ R := by + simpa only [not_exists, not_and, not_not] using hn + have outgoing : ∀ e ∈ BoundaryFootprintEdges U, v ∈ e → + ∃ w, e = {v, w} ∧ r.idxOf w = r.idxOf v + 1 := by + intro e he hve + obtain ⟨a, b, l₁, l₂, hd, rfl⟩ := (hre e).mp (hall e he) + have haU : a ∈ BoundaryFootprintVertices U := by + rw [BoundaryFootprintVertices, ite_eq_left hUne] + exact ⟨{a, b}, he, by simp⟩ + have hbU : b ∈ BoundaryFootprintVertices U := by + rw [BoundaryFootprintVertices, ite_eq_left hUne] + exact ⟨{a, b}, he, by simp⟩ + have hai : r.idxOf a = l₁.length := by + have hi : l₁.length < r.length := by simp [hd] + have hh := hr.idxOf_getElem l₁.length hi + simpa [hd] using hh + have hbi : r.idxOf b = l₁.length + 1 := by + have hi : l₁.length + 1 < r.length := by simp [hd] + have hh := hr.idxOf_getElem (l₁.length + 1) hi + simpa [hd] using hh + simp only [Finset.mem_insert, Finset.mem_singleton] at hve + rcases hve with rfl | rfl + · exact ⟨b, rfl, by omega⟩ + · have := hminU a haU + omega + obtain ⟨a, hea, hai⟩ := outgoing e he.1 he.2 + obtain ⟨b, hfb, hbi⟩ := outgoing f hf.1 hf.2 + have ha : a ∈ r := by + obtain ⟨c, d, l₁, l₂, hd, hecd⟩ := (hre e).mp (hall e he.1) + have ha : a ∈ ({c, d} : Finset GaussianInt) := by rw [← hecd, hea]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at ha + rcases ha with rfl | rfl <;> rw [hd] <;> simp + have hab : a = b := (List.idxOf_inj ha).mp (by omega) + exact hef (by rw [hea, hfb, hab]) + +private theorem attachment : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (BandPrototile (q (0 : Fin (4 : ℕ))) + T) → ((∀ (U : ProtoTile), (LatticeTile U) → (∀ (Q : Set GaussianInt), ∀ (R : Set + (Finset GaussianInt)), (SimpleGridPath Q R) → (∃ e ∈ BoundaryFootprintEdges U, e ∉ + R))) → (∀ i, ∀ s, ∃ e : Finset GaussianInt, e ∈ BoundaryFootprintEdges (cert.P i s) ∧ + e ∈ BoundaryFootprintEdges T)) ) := by + classical + intro C q cfg T cert hT path_omits_boundary + as_aux_lemma => + intro i s + let U := cert.P i s + let K := TileCellComplement T U + have hcomp := (BandTileSimultaneousInduction q cfg.proper T hT).2.2.1 + cert.P cert.outer_occurrence cert.outer_union i s + rcases hcomp with ⟨hKlat, htouch⟩ + have hUne : U.cells.Nonempty := + (LatticeTileGridStructure U (cert.parent_lattice i s)).1.1 + have hKne : K.cells.Nonempty := (LatticeTileGridStructure K hKlat).1.1 + have hsub : ∀ z ∈ U.cells, z ∈ T.cells := by + intro z hz + exact (cert.outer_union z).mpr ⟨i, s, hz⟩ + have hKmem : ∀ z, z ∈ K.cells ↔ z ∈ T.cells ∧ z ∉ U.cells := by + intro z + exact Finset.mem_sdiff + rcases htouch with hpath | hempty | hempty + · obtain ⟨e, he, hnot⟩ := path_omits_boundary U (cert.parent_lattice i s) + _ _ hpath.2.2.2 + have heK : e ∉ BoundaryFootprintEdges K := fun h => hnot ⟨h, he⟩ + refine ⟨e, he, ?_⟩ + have lift_cells : ∀ a b, + ((a ∈ U.cells ∧ b ∉ U.cells) ∨ (a ∉ U.cells ∧ b ∈ U.cells)) → + ¬ ((a ∈ K.cells ∧ b ∉ K.cells) ∨ (a ∉ K.cells ∧ b ∈ K.cells)) → + ((a ∈ T.cells ∧ b ∉ T.cells) ∨ (a ∉ T.cells ∧ b ∈ T.cells)) := by + intro a b hu hk + simp only [hKmem] at hk + rcases hu with ⟨ha, hb⟩ | ⟨ha, hb⟩ + · have := hsub a ha + clear * - ha hb hk this + tauto + · have := hsub b hb + clear * - ha hb hk this + tauto + rcases he with ⟨z, (⟨hez, hz⟩ | ⟨hez, hz⟩)⟩ + · refine ⟨z, Or.inl ⟨hez, lift_cells z (z - ⟨0, 1⟩) hz ?_⟩⟩ + intro hk + exact heK ⟨z, Or.inl ⟨hez, hk⟩⟩ + · refine ⟨z, Or.inr ⟨hez, lift_cells z (z - 1) hz ?_⟩⟩ + intro hk + exact heK ⟨z, Or.inr ⟨hez, hk⟩⟩ + · exact False.elim ((Finset.nonempty_iff_ne_empty.mp hKne) hempty.1) + · exact False.elim ((Finset.nonempty_iff_ne_empty.mp hUne) hempty.1) + +private theorem hpInDifference : + (by + classical + exact + ∀ (D : Finset GaussianInt), ∀ (P : Finset GaussianInt), ∀ (V : Set GaussianInt), (V ⊆ + (↑(D \ P) : Set GaussianInt)) → (∀ (p : List GaussianInt), (V = (↑p.toFinset : Set + GaussianInt)) → (∀ z, z ∈ p → z ∈ ((D \ P : Finset GaussianInt) : Set GaussianInt))) + ) := by + classical + intro D P V hsub p hV z hz + have hzV : z ∈ V := by + rw [hV] + exact List.mem_toFinset.mpr hz + exact hsub hzV + +private theorem hpInD : + (by + classical + exact + ∀ (D : Finset GaussianInt), ∀ (P : Finset GaussianInt), ∀ (p : List GaussianInt), (∀ z, z + ∈ p → z ∈ ((D \ P : Finset GaussianInt) : Set GaussianInt)) → (∀ z, z ∈ p → z ∈ D) ) + := by + classical + intro D P p hpInDifference z hz + exact (Finset.mem_sdiff.mp (hpInDifference z hz)).1 + +private theorem hpNotP : + (by + classical + exact + ∀ (D : Finset GaussianInt), ∀ (P : Finset GaussianInt), ∀ (p : List GaussianInt), (∀ z, z + ∈ p → z ∈ ((D \ P : Finset GaussianInt) : Set GaussianInt)) → (∀ z, z ∈ p → z ∉ P) ) + := by + classical + intro D P p hpInDifference z hz + exact (Finset.mem_sdiff.mp (hpInDifference z hz)).2 + +private theorem hpInteriorT : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (D : Finset GaussianInt), (∀ (x : GaussianInt), x ∈ D ↔ x ∈ + FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T) → (∀ (p : List GaussianInt), + (∀ z, z ∈ p → z ∈ D) → (∀ z, z ∈ p → z ∈ FootprintVertices T ∧ z ∉ + BoundaryFootprintVertices T)) ) := by + classical + intro T D hD p hpInD z hz + exact (hD z).mp (hpInD z hz) + +private theorem hpParentBoundary : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : + Finset GaussianInt), (∀ (x : GaussianInt), x ∈ P ↔ x ∈ D ∧ ∃ (i : Fin (3 : ℕ)) (s : + Bool), x ∈ FootprintVertices (cert.P i s) ∧ x ∉ BoundaryFootprintVertices (cert.P i + s)) → (∀ (p : List GaussianInt), (∀ z, z ∈ p → z ∈ D) → ((∀ z, z ∈ p → z ∉ P) → (∀ z, + z ∈ p → ∀ i, ∀ s, z ∈ FootprintVertices (cert.P i s) → z ∈ BoundaryFootprintVertices + (cert.P i s)))) ) := by + classical + intro C q cfg T cert D P hP p hpInD hpNotP z hz i s hzFoot + by_contra hzNotBoundary + apply hpNotP z hz + exact (hP z).mpr ⟨hpInD z hz, i, s, hzFoot, hzNotBoundary⟩ + +private theorem vertex_cells : + (by + classical + exact + ∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ (v : GaussianInt), (v ∈ FootprintVertices U) → + ((v ∉ BoundaryFootprintVertices U) → (v ∈ U.cells ∧ v - 1 ∈ U.cells ∧ v - ⟨0, 1⟩ ∈ + U.cells ∧ v - 1 - ⟨0, 1⟩ ∈ U.cells))) ) := by + classical + intro U hne v hv hnb + as_aux_lemma => + have horizontal (z : GaussianInt) (hz : v ∈ ({z, z + 1} : Finset GaussianInt)) : + z ∈ U.cells ↔ z - ⟨0, 1⟩ ∈ U.cells := by + by_contra hh + apply hnb + rw [BoundaryFootprintVertices, ite_eq_left hne] + refine ⟨{z, z + 1}, ⟨z, Or.inl ⟨rfl, ?_⟩⟩, hz⟩ + clear * - hh + tauto + have vertical (z : GaussianInt) + (hz : v ∈ ({z, z + ⟨0, 1⟩} : Finset GaussianInt)) : + z ∈ U.cells ↔ z - 1 ∈ U.cells := by + by_contra hh + have hxor : (z ∈ U.cells ∧ z - 1 ∉ U.cells) ∨ + (z ∉ U.cells ∧ z - 1 ∈ U.cells) := by + by_cases ha : z ∈ U.cells + · exact Or.inl ⟨ha, fun hb => hh ⟨fun _ => hb, fun _ => ha⟩⟩ + · refine Or.inr ⟨ha, ?_⟩ + by_contra hb + exact hh ⟨fun h => (ha h).elim, fun h => (hb h).elim⟩ + have he : ({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges U := by + refine ⟨z, ?_⟩ + exact Or.inr ⟨rfl, hxor⟩ + apply hnb + rw [BoundaryFootprintVertices, ite_eq_left hne] + exact ⟨{z, z + ⟨0, 1⟩}, he, hz⟩ + have h₁ := horizontal v (by simp) + have h₂ := vertical v (by simp) + have h₃ := horizontal (v - 1) (by simp) + have hany : v ∈ U.cells ∨ v - 1 ∈ U.cells ∨ v - ⟨0, 1⟩ ∈ U.cells ∨ + v - 1 - ⟨0, 1⟩ ∈ U.cells := by + rw [FootprintVertices, ite_eq_left hne] at hv + obtain ⟨a, ha, hv⟩ := hv + rcases hv with rfl | rfl | rfl | rfl + · exact Or.inl ha + · exact Or.inr (Or.inl (by simpa using ha)) + · exact Or.inr (Or.inr (Or.inl (by simpa using ha))) + · exact Or.inr (Or.inr (Or.inr (by simpa [sub_sub] using ha))) + have hvc : v ∈ U.cells := by + rcases hany with hh | hh | hh | hh + · exact hh + · exact h₂.mpr hh + · exact h₁.mpr hh + · exact h₂.mpr (h₃.mpr hh) + exact ⟨hvc, h₂.mp hvc, h₁.mp hvc, h₃.mp (h₂.mp hvc)⟩ + +private theorem hpCells : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (p : List GaussianInt), (∀ z, z ∈ p → z ∈ FootprintVertices T ∧ z ∉ + BoundaryFootprintVertices T) → ((T.cells.Nonempty) → ((∀ (U : ProtoTile), + (U.cells.Nonempty) → (∀ (v : GaussianInt), (v ∈ FootprintVertices U) → ((v ∉ + BoundaryFootprintVertices U) → (v ∈ U.cells ∧ v - 1 ∈ U.cells ∧ v - ⟨0, 1⟩ ∈ U.cells + ∧ v - 1 - ⟨0, 1⟩ ∈ U.cells)))) → (∀ z ∈ p, z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - ⟨0, 1⟩ + ∈ T.cells ∧ z - 1 - ⟨0, 1⟩ ∈ T.cells))) ) := by + classical + intro T p hpInteriorT hTne vertex_cells z hz + exact vertex_cells T hTne z (hpInteriorT z hz).1 (hpInteriorT z hz).2 + +private theorem horizontal_interior : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ((z - ⟨0, 1⟩ ∈ U.cells) → + (OpenLatticeEdge z (z + 1) ⊆ interior (TileRealization U))) ) := by + classical + intro U z hz hzs + as_aux_lemma => + let R : Set (Real × Real) := + Set.Ioo (z.re : Real) ((z.re : Real) + 1) ×ˢ + Set.Ioo ((z.im : Real) - 1) ((z.im : Real) + 1) + have hRopen : IsOpen R := isOpen_Ioo.prod isOpen_Ioo + have hRU : R ⊆ TileRealization U := by + intro a ha + rcases ha with ⟨ha₁, ha₂⟩ + by_cases hs : a.2 ≤ (z.im : Real) + · apply Set.mem_iUnion.mpr + refine ⟨z - ⟨0, 1⟩, Set.mem_iUnion.mpr ⟨hzs, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, + Zsqrtd.re_sub, Zsqrtd.im_sub, Int.cast_sub, Int.cast_one, sub_zero] + constructor <;> constructor <;> linarith [ha₁.1, ha₁.2, ha₂.1, ha₂.2] + · apply Set.mem_iUnion.mpr + refine ⟨z, Set.mem_iUnion.mpr ⟨hz, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor <;> constructor <;> linarith [ha₁.1, ha₁.2, ha₂.1, ha₂.2] + intro a ha + apply interior_maximal hRU hRopen + obtain ⟨t, ht₀, ht₁, rfl⟩ := ha + simp [R, GaussianRealPoint] + constructor <;> constructor <;> nlinarith + +private theorem vertical_interior : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ((z - 1 ∈ U.cells) → + (OpenLatticeEdge z (z + ⟨0, 1⟩) ⊆ interior (TileRealization U))) ) := by + classical + intro U z hz hzw + as_aux_lemma => + let R : Set (Real × Real) := + Set.Ioo ((z.re : Real) - 1) ((z.re : Real) + 1) ×ˢ + Set.Ioo (z.im : Real) ((z.im : Real) + 1) + have hRopen : IsOpen R := isOpen_Ioo.prod isOpen_Ioo + have hRU : R ⊆ TileRealization U := by + intro a ha + rcases ha with ⟨ha₁, ha₂⟩ + by_cases hw : a.1 ≤ (z.re : Real) + · apply Set.mem_iUnion.mpr + refine ⟨z - 1, Set.mem_iUnion.mpr ⟨hzw, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, + Int.cast_sub, Int.cast_one, sub_zero] + constructor <;> constructor <;> linarith [ha₁.1, ha₁.2, ha₂.1, ha₂.2] + · apply Set.mem_iUnion.mpr + refine ⟨z, Set.mem_iUnion.mpr ⟨hz, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor <;> constructor <;> linarith [ha₁.1, ha₁.2, ha₂.1, ha₂.2] + intro a ha + apply interior_maximal hRU hRopen + obtain ⟨t, ht₀, ht₁, rfl⟩ := ha + simp [R, GaussianRealPoint] + constructor <;> constructor <;> nlinarith + +private theorem edge_vertices : + (by + classical + exact + ∀ (E : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), (p.head? = some x) → ((p.getLast? = some y) → ((FourNeighborAdjacent y + x) → ((∀ (e : Finset GaussianInt), e ∈ E ↔ e = {y, x} ∨ ∃ (a : GaussianInt) (b : + GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ + ∧ e = {a, b}) → (∀ e ∈ E, ∀ z ∈ e, z ∈ p)))) ) := by + classical + intro E p x y hpHead hpLast hclose hpEdges e he z hz + rcases (hpEdges e).mp he with rfl | ⟨a, b, l₁, l₂, hd, rfl⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl + · exact List.mem_of_getLast? hpLast + · exact List.mem_of_head? hpHead + · simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl <;> rw [hd] <;> simp + +private theorem parent_regular : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (List GaussianInt) → (∀ i, ∀ s, (∀ a, + ∀ b, FourNeighborAdjacent a b → a ∈ BoundaryFootprintVertices (cert.P i s) → b ∈ + BoundaryFootprintVertices (cert.P i s) → ¬ OpenLatticeEdge a b ⊆ interior + (TileRealization (cert.P i s)))) ) := by + classical + intro C q cfg T cert p + as_aux_lemma => + intro i s + have hnonneg := (ProperBandCurvatureStructure q cfg.proper).2.1 i + have hne : (q i.succ).1 ≠ 0 := cfg.noLine i.succ + have hpos : 0 < (q i.succ).1 := by omega + let B : BandCircle := + ⟨⟨q i.succ, ⟨Or.inl hpos, + ⟨q, cfg.proper.1, ⟨i.succ, rfl⟩⟩⟩⟩, hpos⟩ + exact (LatticeEdgeRegularity B (cert.P i s) + (cert.outer_occurrence i s).1 (cert.parent_lattice i s)).1 + +private theorem no_horizontal : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (E : Set (Finset GaussianInt)), ∀ + (p : List GaussianInt), (∀ z, z ∈ p → ∀ i, ∀ s, z ∈ FootprintVertices (cert.P i s) → + z ∈ BoundaryFootprintVertices (cert.P i s)) → ((∀ (U : ProtoTile), ∀ (z : + GaussianInt), (z ∈ U.cells) → ((z - ⟨0, 1⟩ ∈ U.cells) → (OpenLatticeEdge z (z + 1) ⊆ + interior (TileRealization U)))) → ((∀ e ∈ E, ∀ z ∈ e, z ∈ p) → ((∀ i, ∀ s, (∀ a, ∀ b, + FourNeighborAdjacent a b → a ∈ BoundaryFootprintVertices (cert.P i s) → b ∈ + BoundaryFootprintVertices (cert.P i s) → ¬ OpenLatticeEdge a b ⊆ interior + (TileRealization (cert.P i s)))) → (∀ (i s) (z : GaussianInt) + (hz : z ∈ (cert.P i s).cells) (hzs : z - ⟨0, 1⟩ ∈ (cert.P i s).cells), + ({z, z + 1} : Finset GaussianInt) ∉ E)))) ) := by + classical + intro C q cfg T cert E p hpParentBoundary horizontal_interior edge_vertices parent_regular i s + z hz hzs + as_aux_lemma => + intro he + have hne : (cert.P i s).cells.Nonempty := ⟨z, hz⟩ + have ha : z ∈ BoundaryFootprintVertices (cert.P i s) := by + apply hpParentBoundary z (edge_vertices _ he z (by simp)) i s + rw [FootprintVertices, ite_eq_left hne] + exact ⟨z, hz, Or.inl rfl⟩ + have hb : z + 1 ∈ BoundaryFootprintVertices (cert.P i s) := by + apply hpParentBoundary (z + 1) (edge_vertices _ he (z + 1) (by simp)) i s + rw [FootprintVertices, ite_eq_left hne] + exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + exact parent_regular i s z (z + 1) (Or.inl rfl) ha hb + (horizontal_interior (cert.P i s) z hz hzs) + +private theorem no_vertical : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (E : Set (Finset GaussianInt)), ∀ + (p : List GaussianInt), (∀ z, z ∈ p → ∀ i, ∀ s, z ∈ FootprintVertices (cert.P i s) → + z ∈ BoundaryFootprintVertices (cert.P i s)) → ((∀ (U : ProtoTile), ∀ (z : + GaussianInt), (z ∈ U.cells) → ((z - 1 ∈ U.cells) → (OpenLatticeEdge z (z + ⟨0, 1⟩) ⊆ + interior (TileRealization U)))) → ((∀ e ∈ E, ∀ z ∈ e, z ∈ p) → ((∀ i, ∀ s, (∀ a, ∀ b, + FourNeighborAdjacent a b → a ∈ BoundaryFootprintVertices (cert.P i s) → b ∈ + BoundaryFootprintVertices (cert.P i s) → ¬ OpenLatticeEdge a b ⊆ interior + (TileRealization (cert.P i s)))) → (∀ i, ∀ s, ∀ (z : GaussianInt), (z ∈ (cert.P i + s).cells) → ((z - 1 ∈ (cert.P i s).cells) → (({z, z + ⟨0, 1⟩} : Finset + GaussianInt) ∉ E))))))) := by + classical + intro C q cfg T cert E p hpParentBoundary vertical_interior edge_vertices parent_regular i s z + hz hzw + as_aux_lemma => + intro he + have hne : (cert.P i s).cells.Nonempty := ⟨z, hz⟩ + have ha : z ∈ BoundaryFootprintVertices (cert.P i s) := by + apply hpParentBoundary z (edge_vertices _ he z (by simp)) i s + rw [FootprintVertices, ite_eq_left hne] + exact ⟨z, hz, Or.inl rfl⟩ + have hb : z + ⟨0, 1⟩ ∈ BoundaryFootprintVertices (cert.P i s) := by + apply hpParentBoundary (z + ⟨0, 1⟩) + (edge_vertices _ he (z + ⟨0, 1⟩) (by simp)) i s + rw [FootprintVertices, ite_eq_left hne] + exact ⟨z, hz, Or.inr (Or.inr (Or.inl rfl))⟩ + have hadj : FourNeighborAdjacent z (z + ⟨0, 1⟩) := + Or.inr (Or.inr (Or.inl rfl)) + have hnot := parent_regular i s z (z + ⟨0, 1⟩) hadj ha hb + apply hnot + exact vertical_interior (cert.P i s) z hz hzw + +private theorem zip_decomp : + (by + classical + exact + ∀ (r : List GaussianInt), ∀ a, ∀ b, (a, b) ∈ r.zip r.tail → ∃ l₁ l₂, r = l₁ ++ a :: b :: + l₂ ) := by + classical + intro r + induction r with + | nil => simp + | cons c r ih => + cases r with + | nil => simp + | cons d r => + intro a b hab + simp only [List.tail_cons, List.zip_cons_cons, List.mem_cons, + Prod.mk.injEq] at hab + rcases hab with ⟨rfl, rfl⟩ | hab + · exact ⟨[], r, rfl⟩ + · obtain ⟨l₁, l₂, hd⟩ := ih a b hab + exact ⟨c :: l₁, l₂, congrArg (c :: ·) hd⟩ + +private theorem es_edge : + (by + classical + exact + ∀ (E : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), (p.head? = some x) → ((p.getLast? = some y) → ((FourNeighborAdjacent y + x) → ((∀ (e : Finset GaussianInt), e ∈ E ↔ e = {y, x} ∨ ∃ (a : GaussianInt) (b : + GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ + ∧ e = {a, b}) → ((∀ (r : List GaussianInt), ∀ a, ∀ b, (a, b) ∈ r.zip r.tail → ∃ l₁ + l₂, r = l₁ ++ a :: b :: l₂) → ( + let es := (p.zip p.tail) ++ [(y, x)] + ∀ a, ∀ b, (a, b) ∈ es → ({a, b} : Finset GaussianInt) ∈ E))))) ) := by + classical + intro E p x y hpHead hpLast hclose hpEdges zip_decomp es a b hab + simp only [es, List.mem_append, List.mem_singleton, Prod.mk.injEq] at hab + apply (hpEdges _).mpr + rcases hab with hab | ⟨rfl, rfl⟩ + · obtain ⟨l₁, l₂, hd⟩ := zip_decomp p a b hab + exact Or.inr ⟨a, b, l₁, l₂, hd, rfl⟩ + · exact Or.inl rfl + +private theorem hzipAdjacent : + (by + classical + exact + ∀ (p : List GaussianInt), (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List + GaussianInt), ∀ (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ → + FourNeighborAdjacent a b) → ((∀ (r : List GaussianInt), ∀ a, ∀ b, (a, b) ∈ r.zip + r.tail → ∃ l₁ l₂, r = l₁ ++ a :: b :: l₂) → (∀ a, ∀ b, (a, b) ∈ p.zip p.tail → + FourNeighborAdjacent a b)) ) := by + classical + intro p hpAdjacent zip_decomp a b hab + obtain ⟨l₁, l₂, hd⟩ := zip_decomp p a b hab + exact hpAdjacent a b l₁ l₂ hd + +private theorem index_horizontal : + (by + classical + exact + ∀ (E : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), + let es := (p.zip p.tail) ++ [(y, x)] + (∀ a, ∀ b, (a, b) ∈ es → ({a, b} : Finset GaussianInt) ∈ E) → (( + let cyclicEdges := p.zip p.tail ++ [(y, x)]; ∀ (q : LatticeCell), ((q + (1 : + LatticeCell), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ + cyclicEdges ∧ (q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (1 : + LatticeCell)) ∉ cyclicEdges → GridRayCrossingIndex (q + (1 : LatticeCell)) p = + GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell), q + (1 : LatticeCell) + (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt), q + (1 : LatticeCell)) ∈ cyclicEdges → (GridRayCrossingIndex (q + + (1 : LatticeCell)) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ)) ∧ ((q + (1 : + LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ∉ cyclicEdges ∧ (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (1 : + LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ cyclicEdges → + GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p = + GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) + ∈ cyclicEdges → (GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p - + GridRayCrossingIndex q p).natAbs = (1 : ℕ))) → (∀ (z : GaussianInt), (({z, z + 1} : + Finset GaussianInt) ∉ E) → (GridRayCrossingIndex z p = GridRayCrossingIndex (z - ⟨0, + 1⟩) p))) ) := by + classical + intro E p x y es es_edge index_control z he + have hn : z - ⟨0, 1⟩ + 1 + ⟨0, 1⟩ = z + 1 := by abel + have hc := (index_control (z - ⟨0, 1⟩)).2.2.1 + apply (show GridRayCrossingIndex (z - ⟨0, 1⟩ + ⟨0, 1⟩) p = + GridRayCrossingIndex (z - ⟨0, 1⟩) p → _ by simp only [sub_add_cancel]; exact id) + apply hc + constructor <;> intro h + · apply he + simpa only [hn, sub_add_cancel, Finset.pair_comm] using es_edge _ _ h + · apply he + simpa only [hn, sub_add_cancel] using es_edge _ _ h + +private theorem index_vertical : + (by + classical + exact + ∀ (E : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), + let es := (p.zip p.tail) ++ [(y, x)] + (∀ a, ∀ b, (a, b) ∈ es → ({a, b} : Finset GaussianInt) ∈ E) → (( + let cyclicEdges := p.zip p.tail ++ [(y, x)]; ∀ (q : LatticeCell), ((q + (1 : + LatticeCell), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ + cyclicEdges ∧ (q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (1 : + LatticeCell)) ∉ cyclicEdges → GridRayCrossingIndex (q + (1 : LatticeCell)) p = + GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell), q + (1 : LatticeCell) + (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt), q + (1 : LatticeCell)) ∈ cyclicEdges → (GridRayCrossingIndex (q + + (1 : LatticeCell)) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ)) ∧ ((q + (1 : + LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ∉ cyclicEdges ∧ (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (1 : + LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ cyclicEdges → + GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p = + GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) + ∈ cyclicEdges → (GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p - + GridRayCrossingIndex q p).natAbs = (1 : ℕ))) → (∀ (z : GaussianInt), (({z, z + ⟨0, + 1⟩} : Finset GaussianInt) ∉ E) → (GridRayCrossingIndex z p = GridRayCrossingIndex (z + - 1) p))) ) := by + classical + intro E p x y es es_edge index_control z he + have hc := (index_control (z - 1)).1 + apply (show GridRayCrossingIndex (z - 1 + 1) p = + GridRayCrossingIndex (z - 1) p → _ by simp only [sub_add_cancel]; exact id) + apply hc + constructor <;> intro h + · apply he + simpa only [sub_add_cancel] using es_edge _ _ h + · apply he + simpa only [sub_add_cancel, Finset.pair_comm] using es_edge _ _ h + +private theorem parent_step : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (E : Set (Finset GaussianInt)), ∀ + (p : List GaussianInt), (∀ i, ∀ s, ∀ (z : GaussianInt), ∀ (hz : z ∈ (cert.P i + s).cells), ∀ (hzs : z - ⟨0, 1⟩ ∈ (cert.P i s).cells), ({z, z + 1} : Finset + GaussianInt) ∉ E) → ((∀ i, ∀ s, ∀ (z : GaussianInt), (z ∈ (cert.P i s).cells) → ((z - + 1 ∈ (cert.P i + s).cells) → (({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∉ E))) → ((∀ (z : GaussianInt), + (({z, + z + 1} : Finset GaussianInt) ∉ E) → (GridRayCrossingIndex z p = GridRayCrossingIndex + (z - ⟨0, 1⟩) p)) → ((∀ (z : GaussianInt), (({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∉ + E) → (GridRayCrossingIndex z p = GridRayCrossingIndex (z - 1) p)) → (∀ i, ∀ s, ∀ (a : + GaussianInt), ∀ (b : GaussianInt), (a ∈ (cert.P i s).cells) → ((b ∈ (cert.P i + s).cells) → ((FourNeighborAdjacent a b) → (GridRayCrossingIndex a p = + GridRayCrossingIndex b p)))))))) := by + classical + intro C q cfg T cert E p no_horizontal no_vertical index_horizontal index_vertical i s a b ha + hb hab + rcases hab with rfl | rfl | rfl | rfl + · have he := no_vertical i s (a + 1) hb (by simpa using ha) + simpa using (index_vertical (a + 1) he).symm + · exact index_vertical a (no_vertical i s a ha hb) + · have he := no_horizontal i s (a + ⟨0, 1⟩) hb (by simpa using ha) + simpa using (index_horizontal (a + ⟨0, 1⟩) he).symm + · exact index_horizontal a (no_horizontal i s a ha hb) + +private theorem list_end_eq : + (by + classical + exact + ∀ (r : List GaussianInt), ∀ (f : GaussianInt → Int), (∀ a, ∀ b, ∀ l₁, ∀ l₂, r = l₁ ++ a + :: b :: l₂ → f a = f b) → ∀ a, ∀ b, r.head? = some a → r.getLast? = some b → f a = f + b ) := by + classical + intro r f + induction r with + | nil => simp + | cons c r ih => + cases r with + | nil => + intro heq a b hh ht + simp only [List.head?_cons, Option.some.injEq] at hh + simp only [List.getLast?_singleton, Option.some.injEq] at ht + rw [← hh, ← ht] + | cons d r => + intro heq a b hh ht + have hca : c = a := Option.some.inj hh + subst a + have hcd := heq c d [] r rfl + apply hcd.trans + apply ih _ d b rfl (by simpa using ht) + intro u v l₁ l₂ hd + exact heq u v (c :: l₁) l₂ (congrArg (c :: ·) hd) + +private theorem parent_index_eq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (p : List GaussianInt), (∀ i, ∀ s, + ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (cert.P i s).cells) → ((b ∈ (cert.P i + s).cells) → ((FourNeighborAdjacent a b) → (GridRayCrossingIndex a p = + GridRayCrossingIndex b p)))) → ((∀ (r : List GaussianInt), ∀ (f : GaussianInt → Int), + (∀ a, ∀ b, ∀ l₁, ∀ l₂, r = l₁ + ++ a + :: b :: l₂ → f a = f b) → ∀ a, ∀ b, r.head? = some a → r.getLast? = some b → f a = f + b) → (∀ i, ∀ s, ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (cert.P i s).cells) → + ((b ∈ (cert.P i s).cells) → (GridRayCrossingIndex a p = GridRayCrossingIndex b + p))))) := by + classical + intro C q cfg T cert p parent_step list_end_eq i s a b ha hb + obtain ⟨r, hh, ht, hr, hadj⟩ := + (LatticeTileGridStructure (cert.P i s) (cert.parent_lattice i s)).1.2 a ha b hb + apply list_end_eq r (fun c => GridRayCrossingIndex c p) _ a b hh ht + intro u v l₁ l₂ hd + apply parent_step i s u v + · apply hr u + rw [hd]; simp + · apply hr v + rw [hd]; simp + · exact hadj u v l₁ l₂ hd + +private theorem unit_segment : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ U.cells) → ((b ∈ + U.cells) → ((FourNeighborAdjacent a b) → (∀ t : Set.Icc (0 : Real) 1, ((1 - (t : + Real)) * (a.re : Real) + (t : Real) * (b.re : Real), (1 - (t : Real)) * (a.im : Real) + + (t : Real) * (b.im : Real)) ∈ TileRealization U))) ) := by + classical + intro U a b ha hb hab + as_aux_lemma => + intro t + rcases hab with rfl | rfl | rfl | rfl + · apply Set.mem_iUnion.mpr + refine ⟨a, Set.mem_iUnion.mpr ⟨ha, ?_⟩⟩ + simp [ClosedSquareRealization] + constructor <;> constructor <;> nlinarith [t.property.1, t.property.2] + · apply Set.mem_iUnion.mpr + refine ⟨a - 1, Set.mem_iUnion.mpr ⟨hb, ?_⟩⟩ + simp [ClosedSquareRealization] + constructor <;> constructor <;> nlinarith [t.property.1, t.property.2] + · apply Set.mem_iUnion.mpr + refine ⟨a, Set.mem_iUnion.mpr ⟨ha, ?_⟩⟩ + simp [ClosedSquareRealization] + constructor <;> constructor <;> nlinarith [t.property.1, t.property.2] + · apply Set.mem_iUnion.mpr + refine ⟨a - ⟨0, 1⟩, Set.mem_iUnion.mpr ⟨hb, ?_⟩⟩ + simp [ClosedSquareRealization] + constructor <;> constructor <;> nlinarith [t.property.1, t.property.2] + +private theorem cycle_segments : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (E : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (x : + GaussianInt), ∀ (y : GaussianInt), (p.head? = some x) → ((p.getLast? = some y) → + ((FourNeighborAdjacent y x) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : + List GaussianInt), ∀ (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ → + FourNeighborAdjacent a b) → ((∀ (e : Finset GaussianInt), e ∈ E ↔ e = {y, x} ∨ ∃ (a : + GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = + l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((∀ z ∈ p, z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - ⟨0, + 1⟩ ∈ T.cells ∧ z - 1 - ⟨0, 1⟩ ∈ T.cells) → ( + let es := (p.zip p.tail) ++ [(y, x)] + (∀ a, ∀ b, (a, b) ∈ es → ({a, b} : Finset GaussianInt) ∈ E) → (( + let cyclicEdges := p.zip p.tail ++ [(y, x)]; ∀ (q : LatticeCell), ((q + (1 : + LatticeCell), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ + cyclicEdges ∧ (q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (1 : + LatticeCell)) ∉ cyclicEdges → GridRayCrossingIndex (q + (1 : LatticeCell)) p = + GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell), q + (1 : LatticeCell) + (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt), q + (1 : LatticeCell)) ∈ cyclicEdges → (GridRayCrossingIndex (q + + (1 : LatticeCell)) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ)) ∧ ((q + (1 : + LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ∉ cyclicEdges ∧ (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (1 : + LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ cyclicEdges → + GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p = + GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) + ∈ cyclicEdges → (GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p - + GridRayCrossingIndex q p).natAbs = (1 : ℕ))) → ((∀ (U : ProtoTile), ∀ (a : + GaussianInt), ∀ (b : GaussianInt), (a ∈ U.cells) → ((b ∈ U.cells) → + ((FourNeighborAdjacent a b) → (∀ t : Set.Icc (0 : Real) 1, ((1 - (t : Real)) * (a.re + : Real) + (t : Real) * (b.re : Real), (1 - (t : Real)) * (a.im : Real) + (t : Real) * + (b.im : Real)) ∈ TileRealization U)))) → (∀ a b : GaussianInt, ((∃ l₁ l₂ : List + GaussianInt, p = l₁ ++ a :: b :: l₂) ∨ (a = y ∧ b = x)) → ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * (a.re : Real) + (t : Real) * (b.re : Real), (1 - (t : Real)) * + (a.im : Real) + (t : Real) * (b.im : Real)) ∈ TileRealization T))))))))) ) := by + classical + intro T E p x y hpHead hpLast hclose hpAdjacent hpEdges hpCells es es_edge index_control + unit_segment a b hab + rcases hab with ⟨l₁, l₂, hd⟩ | ⟨rfl, rfl⟩ + · have ha : a ∈ p := by rw [hd]; simp + have hb : b ∈ p := by rw [hd]; simp + exact unit_segment T a b (hpCells a ha).1 (hpCells b hb).1 + (hpAdjacent a b l₁ l₂ hd) + · exact unit_segment T a b (hpCells a (List.mem_of_getLast? hpLast)).1 + (hpCells b (List.mem_of_head? hpHead)).1 hclose + +private theorem unoccupied_center_outside : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (c : LatticeCell), (c ∉ T.cells) → ((((c.re : Real) + (1 / 2 : + Real)), ((c.im : Real) + (1 / 2 : Real))) ∉ TileRealization T) ) := by + classical + intro T c hc + as_aux_lemma => + intro hcenter + simp only [TileRealization, Set.mem_iUnion] at hcenter + obtain ⟨w, hw, hcw⟩ := hcenter + simp only [ClosedSquareRealization, Set.mem_Icc] at hcw + have hre_lt : w.re < c.re + 1 := by + exact_mod_cast (show (w.re : Real) < (c.re : Real) + 1 by linarith [hcw.1.1]) + have hre_gt : c.re < w.re + 1 := by + exact_mod_cast (show (c.re : Real) < (w.re : Real) + 1 by linarith [hcw.2.1]) + have him_lt : w.im < c.im + 1 := by + exact_mod_cast (show (w.im : Real) < (c.im : Real) + 1 by linarith [hcw.1.2]) + have him_gt : c.im < w.im + 1 := by + exact_mod_cast (show (c.im : Real) < (w.im : Real) + 1 by linarith [hcw.2.2]) + have hwc : w = c := by apply Zsqrtd.ext <;> omega + exact hc (hwc ▸ hw) + +private theorem outside_zero : + (by + classical + exact + ∀ (T : ProtoTile), (LatticeTile T) → (∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ (y + : GaussianInt), (p.head? = some x) → ((p.getLast? = some y) → ((FourNeighborAdjacent + y x) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : + List GaussianInt), p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → ((∀ a b : + GaussianInt, ((∃ l₁ l₂ : List GaussianInt, p = l₁ ++ a :: b :: l₂) ∨ (a = y ∧ b = x)) + → ∀ t : Set.Icc (0 : Real) 1, ((1 - (t : Real)) * (a.re : Real) + (t : Real) * (b.re + : Real), (1 - (t : Real)) * (a.im : Real) + (t : Real) * (b.im : Real)) ∈ + TileRealization T) → ((∀ (c : LatticeCell), (c ∉ T.cells) → ((((c.re : Real) + (1 / 2 + : Real)), ((c.im : Real) + (1 / 2 : Real))) ∉ TileRealization T)) → (∀ (c : + LatticeCell), (c ∉ T.cells) → (GridRayCrossingIndex c p = 0)))))))) ) := by + classical + intro T hlat p x y hpHead hpLast hclose hpAdjacent cycle_segments unoccupied_center_outside c hc + apply TopologicalDiskGridRayCrossingIndexZero (TileRealization T) hlat c + (unoccupied_center_outside c hc) p x y hpHead hpLast hpAdjacent hclose + exact cycle_segments + +private theorem boundary_not_cycle : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (E : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), (∀ z, z ∈ + p → z ∈ FootprintVertices T ∧ z ∉ BoundaryFootprintVertices T) → ((T.cells.Nonempty) + → ((∀ e ∈ E, ∀ z ∈ e, z ∈ p) → (∀ (e : Finset GaussianInt), (e ∈ + BoundaryFootprintEdges T) → (e ∉ E)))) ) := by + classical + intro T E p hpInteriorT hTne edge_vertices e he heE + have hene : e.Nonempty := by + rcases he with ⟨z, (⟨rfl, _⟩ | ⟨rfl, _⟩)⟩ <;> simp + obtain ⟨z, hz⟩ := hene + apply (hpInteriorT z (edge_vertices e heE z hz)).2 + rw [BoundaryFootprintVertices, ite_eq_left hTne] + exact ⟨e, he, hz⟩ + +private theorem horizontal_unique : + (by + classical + exact + ∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, a + 1} : Finset GaussianInt) = {b, + b + 1}) → (a = b) ) := by + classical + intro a b h + as_aux_lemma => + have ha : a ∈ ({b, b + 1} : Finset GaussianInt) := by rw [← h]; simp + have ha1 : a + 1 ∈ ({b, b + 1} : Finset GaussianInt) := by rw [← h]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at ha ha1 + rcases ha with hab | hab <;> rcases ha1 with ha1b | ha1b + · exact hab + · exact hab + · exfalso + apply_fun Zsqrtd.re at hab ha1b + simp at hab ha1b + omega + · exfalso + apply_fun Zsqrtd.re at hab ha1b + simp at hab ha1b + omega + +private theorem vertical_unique : + (by + classical + exact + ∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, a + ⟨0, 1⟩} : Finset GaussianInt) = {b, + b + ⟨0, 1⟩}) → (a = b) ) := by + classical + intro a b h + as_aux_lemma => + have ha : a ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← h]; simp + have ha1 : a + ⟨0, 1⟩ ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← h]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at ha ha1 + rcases ha with hab | hab <;> rcases ha1 with ha1b | ha1b + · exact hab + · exact hab + · exfalso + apply_fun Zsqrtd.im at hab ha1b + simp at hab ha1b + omega + · exfalso + apply_fun Zsqrtd.im at hab ha1b + simp at hab ha1b + omega + +private theorem horizontal_vertical_ne : + (by + classical + exact + ∀ (a : GaussianInt), ∀ (b : GaussianInt), ({a, a + 1} : Finset GaussianInt) ≠ {b, b + ⟨0, + 1⟩} ) := by + classical + intro a b + as_aux_lemma => + intro h + have ha : a ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← h]; simp + have ha1 : a + 1 ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← h]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at ha ha1 + rcases ha with hab | hab <;> rcases ha1 with ha1b | ha1b + all_goals apply_fun Zsqrtd.re at hab ha1b; simp at hab ha1b; omega + +private theorem horizontal_boundary_cells : + (by + classical + exact + (∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, a + 1} : Finset GaussianInt) = {b, + b + 1}) → (a = b)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ({a, a + 1} : Finset + GaussianInt) ≠ {b, b + ⟨0, 1⟩}) → (∀ (U : ProtoTile), ∀ (z : GaussianInt), (({z, + z + 1} : Finset GaussianInt) ∈ BoundaryFootprintEdges U) → ((z ∈ U.cells ∧ z - ⟨0, 1⟩ + ∉ U.cells) ∨ (z ∉ U.cells ∧ z - ⟨0, 1⟩ ∈ U.cells)))) ) := by + classical + intro horizontal_unique horizontal_vertical_ne U z he + rcases he with ⟨a, (⟨ha, hocc⟩ | ⟨ha, hocc⟩)⟩ + · have haz := horizontal_unique a z ha.symm + simpa [haz] using hocc + · exact False.elim (horizontal_vertical_ne z a ha) + +private theorem vertical_boundary_cells : + (by + classical + exact + (∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, a + ⟨0, 1⟩} : Finset GaussianInt) = {b, + b + ⟨0, 1⟩}) → (a = b)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ({a, a + 1} : + Finset GaussianInt) ≠ {b, b + ⟨0, 1⟩}) → (∀ (U : ProtoTile), ∀ (z : GaussianInt), + (({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges U) → ((z ∈ U.cells ∧ + z - 1 ∉ U.cells) ∨ (z ∉ U.cells ∧ z - 1 ∈ U.cells)))) ) := by + classical + intro vertical_unique horizontal_vertical_ne U z he + rcases he with ⟨a, (⟨ha, hocc⟩ | ⟨ha, hocc⟩)⟩ + · exact False.elim (horizontal_vertical_ne a z ha.symm) + · have haz := vertical_unique a z ha.symm + simpa [haz] using hocc + +private theorem parent_cell_in_outer : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ i, ∀ s, ∀ z, z ∈ (cert.P i s).cells + → z ∈ T.cells ) := by + classical + intro C q cfg T cert i s z hz + exact (cert.outer_union z).mpr ⟨i, s, hz⟩ + +private theorem parent_anchor : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (∀ i, ∀ s, ∃ e : Finset GaussianInt, + e ∈ BoundaryFootprintEdges (cert.P i s) ∧ e ∈ BoundaryFootprintEdges T) → (∀ (E : Set + (Finset GaussianInt)), ∀ (p : List GaussianInt), (∀ (z : GaussianInt), (({z, z + 1} : + Finset GaussianInt) ∉ E) → (GridRayCrossingIndex z p = GridRayCrossingIndex (z - ⟨0, + 1⟩) p)) → ((∀ (z : GaussianInt), (({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∉ E) → + (GridRayCrossingIndex z p = GridRayCrossingIndex (z - 1) p)) → ((∀ (c : LatticeCell), + (c ∉ T.cells) → (GridRayCrossingIndex c p = 0)) → ((∀ (e : Finset GaussianInt), (e ∈ + BoundaryFootprintEdges T) → (e ∉ E)) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), + (({z, z + 1} : Finset GaussianInt) ∈ BoundaryFootprintEdges U) → ((z ∈ U.cells ∧ z - + ⟨0, 1⟩ ∉ U.cells) ∨ (z ∉ U.cells ∧ z - ⟨0, 1⟩ ∈ U.cells))) → ((∀ (U : ProtoTile), ∀ + (z : GaussianInt), (({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges + U) → ((z ∈ U.cells ∧ z - 1 ∉ U.cells) ∨ (z ∉ U.cells ∧ z - 1 ∈ U.cells))) → ((∀ i, ∀ + s, ∀ z, z ∈ (cert.P i s).cells → z ∈ T.cells) → (∀ (i s), + ∃ c ∈ (cert.P i s).cells, GridRayCrossingIndex c p = 0)))))))) ) := by + classical + intro C q cfg T cert attachment E p index_horizontal index_vertical outside_zero + boundary_not_cycle horizontal_boundary_cells vertical_boundary_cells parent_cell_in_outer i s + obtain ⟨e, heU, heT⟩ := attachment i s + have heE := boundary_not_cycle e heT + rcases heU with ⟨z, (⟨rfl, hu⟩ | ⟨rfl, hu⟩)⟩ + · have ht := horizontal_boundary_cells T z heT + have hi := index_horizontal z heE + rcases hu with ⟨hzu, hzsnu⟩ | ⟨hznu, hzsu⟩ + · have hzt := parent_cell_in_outer i s z hzu + have hzsout : z - ⟨0, 1⟩ ∉ T.cells := by + rcases ht with hh | hh + · exact hh.2 + · exact (hh.1 hzt).elim + exact ⟨z, hzu, hi.trans (outside_zero _ hzsout)⟩ + · have hzst := parent_cell_in_outer i s (z - ⟨0, 1⟩) hzsu + have hzout : z ∉ T.cells := by + rcases ht with hh | hh + · exact (hh.2 hzst).elim + · exact hh.1 + exact ⟨z - ⟨0, 1⟩, hzsu, hi.symm.trans (outside_zero _ hzout)⟩ + · have ht := vertical_boundary_cells T z heT + have hi := index_vertical z heE + rcases hu with ⟨hzu, hzwnu⟩ | ⟨hznu, hzwu⟩ + · have hzt := parent_cell_in_outer i s z hzu + have hzwout : z - 1 ∉ T.cells := by + rcases ht with hh | hh + · exact hh.2 + · exact (hh.1 hzt).elim + exact ⟨z, hzu, hi.trans (outside_zero _ hzwout)⟩ + · have hzwt := parent_cell_in_outer i s (z - 1) hzwu + have hzout : z ∉ T.cells := by + rcases ht with hh | hh + · exact (hh.2 hzwt).elim + · exact hh.1 + exact ⟨z - 1, hzwu, hi.symm.trans (outside_zero _ hzout)⟩ + +private theorem parent_zero : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (p : List GaussianInt), (∀ i, ∀ s, + ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (cert.P i s).cells) → ((b ∈ (cert.P i + s).cells) → (GridRayCrossingIndex a p = GridRayCrossingIndex b p))) → ((∀ i, ∀ s, ∃ c + ∈ (cert.P i + s).cells, GridRayCrossingIndex c p = 0) → (∀ i, ∀ s, ∀ (c : LatticeCell), (c ∈ + (cert.P i s).cells) → (GridRayCrossingIndex c p = 0)))) := by + classical + intro C q cfg T cert p parent_index_eq parent_anchor i s c hc + obtain ⟨a, ha, hazero⟩ := parent_anchor i s + exact (parent_index_eq i s c a hc ha).trans hazero + +private theorem outer_zero : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (p : List GaussianInt), (∀ i, ∀ s, + ∀ (c : LatticeCell), (c ∈ (cert.P i s).cells) → (GridRayCrossingIndex c p = 0)) → (∀ + (c : LatticeCell), (c ∈ T.cells) → (GridRayCrossingIndex c p = 0))) := by + classical + intro C q cfg T cert p parent_zero c hc + obtain ⟨i, s, hc⟩ := (cert.outer_union c).mp hc + exact parent_zero i s c hc + +private theorem all_zero : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (p : List GaussianInt), (∀ (c : LatticeCell), (c ∉ T.cells) → + (GridRayCrossingIndex c p = 0)) → ((∀ (c : LatticeCell), (c ∈ T.cells) → + (GridRayCrossingIndex c p = 0)) → (∀ (c : LatticeCell), GridRayCrossingIndex c p = + 0)) ) := by + classical + intro T p outside_zero outer_zero c + by_cases hc : c ∈ T.cells + · exact outer_zero c hc + · exact outside_zero c hc + +private theorem heqAt735 : + (by + classical + exact + ∀ (y : GaussianInt), (y - ⟨0, 1⟩ + ⟨0, 1⟩, y - ⟨0, 1⟩ + 1 + ⟨0, 1⟩) = (y, y + 1) ) := by + classical + intro y + apply Prod.ext <;> dsimp <;> abel + +private theorem hjumpAt738 : + (by + classical + exact + ∀ (p : List GaussianInt), ∀ (y : GaussianInt), + let es := (p.zip p.tail) ++ [(y, y + 1)] + ( + let cyclicEdges := p.zip p.tail ++ [(y, y + (1 : LatticeCell))]; ∀ (q : LatticeCell), ((q + + (1 : LatticeCell), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ + cyclicEdges ∧ (q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (1 : + LatticeCell)) ∉ cyclicEdges → GridRayCrossingIndex (q + (1 : LatticeCell)) p = + GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell), q + (1 : LatticeCell) + (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt), q + (1 : LatticeCell)) ∈ cyclicEdges → (GridRayCrossingIndex (q + + (1 : LatticeCell)) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ)) ∧ ((q + (1 : + LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ∉ cyclicEdges ∧ (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (1 : + LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ cyclicEdges → + GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p = + GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) + ∈ cyclicEdges → (GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p - + GridRayCrossingIndex q p).natAbs = (1 : ℕ))) → (((y, y + (1 : LatticeCell)) ∈ es) → + (((y - ⟨0, 1⟩ + ⟨0, 1⟩, y - ⟨0, 1⟩ + 1 + ⟨0, 1⟩) = (y, y + 1)) → (Int.natAbs + (GridRayCrossingIndex (y - ⟨0, 1⟩ + ⟨0, 1⟩) p - GridRayCrossingIndex (y - ⟨0, 1⟩) p) + = 1))) ) := by + classical + intro p y es index_control hmem heq + apply (index_control (y - ⟨0, 1⟩)).2.2.2 + right + rw [heq] + exact hmem + +private theorem heqAt748 : + (by + classical + exact + ∀ (y : GaussianInt), (y - 1 - ⟨0, 1⟩ + 1 + ⟨0, 1⟩, y - 1 - ⟨0, 1⟩ + ⟨0, 1⟩) = (y, y - 1) + ) := by + classical + intro y + apply Prod.ext <;> dsimp <;> abel + +private theorem hjumpAt751 : + (by + classical + exact + ∀ (p : List GaussianInt), ∀ (y : GaussianInt), + let es := (p.zip p.tail) ++ [(y, y - 1)] + ( + let cyclicEdges := p.zip p.tail ++ [(y, y - (1 : LatticeCell))]; ∀ (q : LatticeCell), ((q + + (1 : LatticeCell), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ + cyclicEdges ∧ (q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (1 : + LatticeCell)) ∉ cyclicEdges → GridRayCrossingIndex (q + (1 : LatticeCell)) p = + GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell), q + (1 : LatticeCell) + (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt), q + (1 : LatticeCell)) ∈ cyclicEdges → (GridRayCrossingIndex (q + + (1 : LatticeCell)) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ)) ∧ ((q + (1 : + LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ∉ cyclicEdges ∧ (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (1 : + LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ cyclicEdges → + GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p = + GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) + ∈ cyclicEdges → (GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p - + GridRayCrossingIndex q p).natAbs = (1 : ℕ))) → (((y, y - (1 : LatticeCell)) ∈ es) → + (((y - 1 - ⟨0, 1⟩ + 1 + ⟨0, 1⟩, y - 1 - ⟨0, 1⟩ + ⟨0, 1⟩) = (y, y - 1)) → (Int.natAbs + (GridRayCrossingIndex (y - 1 - ⟨0, 1⟩ + ⟨0, 1⟩) p - GridRayCrossingIndex (y - 1 - ⟨0, + 1⟩) p) = 1))) ) := by + classical + intro p y es index_control hmem heq + apply (index_control (y - 1 - ⟨0, 1⟩)).2.2.2 + left + rw [heq] + exact hmem + +private theorem hjumpAt763 : + (by + classical + exact + ∀ (p : List GaussianInt), ∀ (y : GaussianInt), + let es := (p.zip p.tail) ++ [(y, y + ⟨0, 1⟩)] + ( + let cyclicEdges := p.zip p.tail ++ [(y, y + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt))]; ∀ (q : + LatticeCell), ((q + (1 : LatticeCell), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ∉ cyclicEdges ∧ (q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt), q + (1 : LatticeCell)) ∉ cyclicEdges → GridRayCrossingIndex (q + (1 : + LatticeCell)) p = GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell), q + (1 : + LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (1 : + LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (1 : LatticeCell)) ∈ + cyclicEdges → (GridRayCrossingIndex (q + (1 : LatticeCell)) p - GridRayCrossingIndex + q p).natAbs = (1 : ℕ)) ∧ ((q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ cyclicEdges ∧ (q + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) + ∉ cyclicEdges → GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p = + GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) + ∈ cyclicEdges → (GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p - + GridRayCrossingIndex q p).natAbs = (1 : ℕ))) → (((y, y + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ∈ es) → (((y - 1 + 1, y - 1 + 1 + ⟨0, 1⟩) = (y, y + ⟨0, 1⟩)) → + (Int.natAbs (GridRayCrossingIndex (y - 1 + 1) p - GridRayCrossingIndex (y - 1) p) = + 1))) ) := by + classical + intro p y es index_control hmem heq + apply (index_control (y - 1)).2.1 + left + rw [heq] + exact hmem + +private theorem heqAt772 : + (by + classical + exact + ∀ (y : GaussianInt), (y - ⟨0, 1⟩ - 1 + 1 + ⟨0, 1⟩, y - ⟨0, 1⟩ - 1 + 1) = (y, y - ⟨0, 1⟩) + ) := by + classical + intro y + apply Prod.ext <;> dsimp <;> abel + +private theorem hjumpAt775 : + (by + classical + exact + ∀ (p : List GaussianInt), ∀ (y : GaussianInt), + let es := (p.zip p.tail) ++ [(y, y - ⟨0, 1⟩)] + ( + let cyclicEdges := p.zip p.tail ++ [(y, y - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt))]; ∀ (q : + LatticeCell), ((q + (1 : LatticeCell), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ∉ cyclicEdges ∧ (q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt), q + (1 : LatticeCell)) ∉ cyclicEdges → GridRayCrossingIndex (q + (1 : + LatticeCell)) p = GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell), q + (1 : + LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (1 : + LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (1 : LatticeCell)) ∈ + cyclicEdges → (GridRayCrossingIndex (q + (1 : LatticeCell)) p - GridRayCrossingIndex + q p).natAbs = (1 : ℕ)) ∧ ((q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ cyclicEdges ∧ (q + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) + ∉ cyclicEdges → GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p = + GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) + ∈ cyclicEdges → (GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p - + GridRayCrossingIndex q p).natAbs = (1 : ℕ))) → (((y, y - (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ∈ es) → (((y - ⟨0, 1⟩ - 1 + 1 + ⟨0, 1⟩, y - ⟨0, 1⟩ - 1 + 1) = (y, y - + ⟨0, 1⟩)) → (Int.natAbs (GridRayCrossingIndex (y - ⟨0, 1⟩ - 1 + 1) p - + GridRayCrossingIndex (y - ⟨0, 1⟩ - 1) p) = 1))) ) := by + classical + intro p y es index_control hmem heq + apply (index_control (y - ⟨0, 1⟩ - 1)).2.1 + right + rw [heq] + exact hmem + +end InterfaceCycleGeometry + +theorem P4250T2InterfaceCycleExclusion + (C : BandCircle) (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (hT : BandPrototile (q 0) T) (hlat : LatticeTile T) + (D P : Finset GaussianInt) + (hD : ∀ x, x ∈ D ↔ + x ∈ FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T) + (hP : ∀ x, x ∈ P ↔ x ∈ D ∧ ∃ i s, + x ∈ FootprintVertices (cert.P i s) ∧ + x ∉ BoundaryFootprintVertices (cert.P i s)) : + (∀ i s, ∃ e : Finset GaussianInt, + e ∈ BoundaryFootprintEdges (cert.P i s) ∧ + e ∈ BoundaryFootprintEdges T) ∧ + ∀ V E, SimpleGridCycle V E → ¬ V ⊆ ((D \ P : Finset GaussianInt) : Set GaussianInt) := by +-- BODY + classical + -- A simple touching path omits an edge of the complete parent boundary. + have attachment := InterfaceCycleGeometry.attachment C q cfg T cert hT + (InterfaceCycleGeometry.path_omits_boundary) + refine ⟨attachment, ?_⟩ + intro V E hcyc hsub + obtain ⟨p, x, y, hpNodup, hpLength, hpHead, hpLast, hV, + hclose, hpAdjacent, hpEdges⟩ := hcyc + have hpInDifference := InterfaceCycleGeometry.hpInDifference D P V hsub p hV + have hpInD := InterfaceCycleGeometry.hpInD D P p hpInDifference + have hpInteriorT := InterfaceCycleGeometry.hpInteriorT T D hD p hpInD + have hpParentBoundary := InterfaceCycleGeometry.hpParentBoundary C q cfg T cert D P hP p hpInD + (InterfaceCycleGeometry.hpNotP D P p hpInDifference) + have hTne : T.cells.Nonempty := (LatticeTileGridStructure T hlat).1.1 + -- Absence of a boundary edge forces all four incident cells to be present. + have edge_vertices := InterfaceCycleGeometry.edge_vertices E p x y hpHead hpLast hclose hpEdges + have parent_regular := InterfaceCycleGeometry.parent_regular C q cfg T cert p + -- A cycle side cannot lie between two cells of one parent. + have zip_decomp := InterfaceCycleGeometry.zip_decomp + let es := (p.zip p.tail) ++ [(y, x)] + have es_edge := InterfaceCycleGeometry.es_edge E p x y hpHead hpLast hclose hpEdges zip_decomp + have index_control := GridRayCrossingIndexAdjacentCell p x y hpHead hpLast + hpNodup (by omega) (InterfaceCycleGeometry.hzipAdjacent p hpAdjacent zip_decomp) hclose + have index_horizontal := InterfaceCycleGeometry.index_horizontal E p x y es_edge index_control + have index_vertical := InterfaceCycleGeometry.index_vertical E p x y es_edge index_control + have outside_zero := InterfaceCycleGeometry.outside_zero T hlat p x y hpHead hpLast hclose + hpAdjacent (InterfaceCycleGeometry.cycle_segments T E p x y hpHead hpLast hclose hpAdjacent + hpEdges (InterfaceCycleGeometry.hpCells T p hpInteriorT hTne + (InterfaceCycleGeometry.vertex_cells)) es_edge index_control + (InterfaceCycleGeometry.unit_segment)) (InterfaceCycleGeometry.unoccupied_center_outside T) + have horizontal_vertical_ne := InterfaceCycleGeometry.horizontal_vertical_ne + -- The common outer side anchors the index throughout each parent. + -- Exact cell coverage transfers these zero values to the entire outer tile. + have all_zero (c : LatticeCell) : GridRayCrossingIndex c p = 0 := + InterfaceCycleGeometry.all_zero T p outside_zero (InterfaceCycleGeometry.outer_zero C q cfg + T cert p (InterfaceCycleGeometry.parent_zero C q cfg T cert p + (InterfaceCycleGeometry.parent_index_eq C q cfg T cert p + (InterfaceCycleGeometry.parent_step C q cfg T cert E p + (InterfaceCycleGeometry.no_horizontal C q cfg T cert E p hpParentBoundary + (InterfaceCycleGeometry.horizontal_interior) edge_vertices parent_regular) + (InterfaceCycleGeometry.no_vertical C q cfg T cert E p hpParentBoundary + (InterfaceCycleGeometry.vertical_interior) edge_vertices parent_regular) index_horizontal + index_vertical) (InterfaceCycleGeometry.list_end_eq)) (InterfaceCycleGeometry.parent_anchor + C q cfg T cert attachment E p index_horizontal index_vertical outside_zero + (InterfaceCycleGeometry.boundary_not_cycle T E p hpInteriorT hTne edge_vertices) + (InterfaceCycleGeometry.horizontal_boundary_cells + (InterfaceCycleGeometry.horizontal_unique) horizontal_vertical_ne) + (InterfaceCycleGeometry.vertical_boundary_cells (InterfaceCycleGeometry.vertical_unique) + horizontal_vertical_ne) (InterfaceCycleGeometry.parent_cell_in_outer C q cfg T cert)))) c + have hmem : (y, x) ∈ es := by simp [es] + clear * - p x y es index_control all_zero hmem hclose + rcases hclose with hclose | hclose | hclose | hclose + · subst x + have heq := InterfaceCycleGeometry.heqAt735 y + have hjump : Int.natAbs + (GridRayCrossingIndex (y - ⟨0, 1⟩ + ⟨0, 1⟩) p - + GridRayCrossingIndex (y - ⟨0, 1⟩) p) = 1 := InterfaceCycleGeometry.hjumpAt738 p y + index_control hmem heq + simp only [all_zero, sub_self, Int.natAbs_zero] at hjump + norm_num at hjump + · subst x + have heq := InterfaceCycleGeometry.heqAt748 y + have hjump : Int.natAbs + (GridRayCrossingIndex (y - 1 - ⟨0, 1⟩ + ⟨0, 1⟩) p - + GridRayCrossingIndex (y - 1 - ⟨0, 1⟩) p) = 1 := InterfaceCycleGeometry.hjumpAt751 p y + index_control hmem heq + simp only [all_zero, sub_self, Int.natAbs_zero] at hjump + norm_num at hjump + · subst x + have heq : (y - 1 + 1, y - 1 + 1 + ⟨0, 1⟩) = (y, y + ⟨0, 1⟩) := by + apply Prod.ext <;> dsimp <;> abel + have hjump : Int.natAbs + (GridRayCrossingIndex (y - 1 + 1) p - GridRayCrossingIndex (y - 1) p) = 1 := + InterfaceCycleGeometry.hjumpAt763 p y index_control hmem heq + simp only [all_zero, sub_self, Int.natAbs_zero] at hjump + norm_num at hjump + · subst x + have heq := InterfaceCycleGeometry.heqAt772 y + have hjump : Int.natAbs + (GridRayCrossingIndex (y - ⟨0, 1⟩ - 1 + 1) p - + GridRayCrossingIndex (y - ⟨0, 1⟩ - 1) p) = 1 := InterfaceCycleGeometry.hjumpAt775 p y + index_control hmem heq + simp only [all_zero, sub_self, Int.natAbs_zero] at hjump + norm_num at hjump + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean new file mode 100644 index 0000000000..76b1c8ccf6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean @@ -0,0 +1,1736 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorStarClassification +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.CurvatureOneTileBase +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance + +-- [TABLET NODE: P4250T2InterfaceNeighborCount] + +/-! +# P4250T2InterfaceNeighborCount + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace InterfaceNeighborGeometry + +private theorem incident_foot : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (z : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell z j ∈ + U.cells) → (z ∈ FootprintVertices U) ) := by + classical + intro U z j hj + as_aux_lemma => + rw [FootprintVertices, ite_eq_left (show U.cells.Nonempty from ⟨_, hj⟩)] + refine ⟨_, hj, ?_⟩ + fin_cases j <;> simp [LatticeVertexIncidentCell, Zsqrtd.ext_iff] + +private theorem foot_incident : + (by + classical + exact + ∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ (z : GaussianInt), (z ∈ FootprintVertices U) → + (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ U.cells)) ) := by + classical + intro U hne z hz + as_aux_lemma => + rw [FootprintVertices, ite_eq_left hne] at hz + rcases hz with ⟨c, hc, rfl | rfl | rfl | rfl⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨2, by simpa [LatticeVertexIncidentCell, sub_sub] using hc⟩ + +private theorem full_iff : + (by + classical + exact + (∀ (U : ProtoTile), ∀ (z : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell z j ∈ + U.cells) → (z ∈ FootprintVertices U)) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ + (z : GaussianInt), (z ∈ FootprintVertices U) → (∃ j : Fin 4, + LatticeVertexIncidentCell z j ∈ U.cells))) → (∀ (U : ProtoTile), ∀ (z : GaussianInt), + (z ∈ FootprintVertices U ∧ z ∉ BoundaryFootprintVertices U) ↔ ∀ j : Fin 4, + LatticeVertexIncidentCell z j ∈ U.cells)) ) := by + classical + intro incident_foot foot_incident U z + as_aux_lemma => + constructor + · rintro ⟨hf, hb⟩ + have hne : U.cells.Nonempty := by + by_contra hn + exact hb (by simpa [FootprintVertices, BoundaryFootprintVertices, hn] using hf) + obtain ⟨j, hj⟩ := foot_incident U hne z hf + intro l + by_contra hl + exact hb (P3161T2IncidentBoundary U z ⟨j, hj⟩ ⟨l, hl⟩) + · intro hall + refine ⟨incident_foot U z 0 (hall 0), ?_⟩ + have hne : U.cells.Nonempty := ⟨_, hall 0⟩ + intro hb + rw [BoundaryFootprintVertices, ite_eq_left hne] at hb + rcases hb with ⟨e, ⟨w, (⟨rfl, hw⟩ | ⟨rfl, hw⟩)⟩, hze⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hze + rcases hze with rfl | rfl + · rcases hw with hw | hw + · exact hw.2 (by simpa [LatticeVertexIncidentCell] using hall 3) + · exact hw.1 (by simpa [LatticeVertexIncidentCell] using hall 0) + · rcases hw with hw | hw + · exact hw.2 (by simpa [LatticeVertexIncidentCell, sub_sub] using hall 2) + · exact hw.1 (by simpa [LatticeVertexIncidentCell] using hall 1) + · simp only [Finset.mem_insert, Finset.mem_singleton] at hze + rcases hze with rfl | rfl + · rcases hw with hw | hw + · exact hw.2 (by simpa [LatticeVertexIncidentCell] using hall 1) + · exact hw.1 (by simpa [LatticeVertexIncidentCell] using hall 0) + · rcases hw with hw | hw + · exact hw.2 (by simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hall 2) + · exact hw.1 (by simpa [LatticeVertexIncidentCell] using hall 3) + +private theorem boundary_foot : + (by + classical + exact + (∀ (U : ProtoTile), ∀ (z : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell z j ∈ + U.cells) → (z ∈ FootprintVertices U)) → (∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ + BoundaryFootprintVertices U) → (z ∈ FootprintVertices U)) ) := by + classical + intro incident_foot U z hz + as_aux_lemma => + by_cases hne : U.cells.Nonempty + · rw [BoundaryFootprintVertices, ite_eq_left hne] at hz + rcases hz with ⟨e, ⟨w, (⟨rfl, hw⟩ | ⟨rfl, hw⟩)⟩, hze⟩ + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hze + · rcases hze with rfl | rfl <;> rcases hw with hw | hw + · exact incident_foot U _ 0 hw.1 + · exact incident_foot U _ 3 (by simpa [LatticeVertexIncidentCell] using hw.2) + · exact incident_foot U (w + 1) 1 (by simpa [LatticeVertexIncidentCell] using hw.1) + · exact incident_foot U (w + 1) 2 (by simpa [LatticeVertexIncidentCell, sub_sub] using + hw.2) + · rcases hze with rfl | rfl <;> rcases hw with hw | hw + · exact incident_foot U _ 0 hw.1 + · exact incident_foot U _ 1 (by simpa [LatticeVertexIncidentCell] using hw.2) + · exact incident_foot U (w + ⟨0, 1⟩) 3 (by simpa [LatticeVertexIncidentCell] using hw.1) + · exact incident_foot U (w + ⟨0, 1⟩) 2 (by simpa [LatticeVertexIncidentCell, + sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hw.2) + · simpa [FootprintVertices, BoundaryFootprintVertices, hne] using hz + +private theorem horizontal_interior : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ((z - ⟨0, 1⟩ ∈ U.cells) → + (OpenLatticeEdge z (z + 1) ⊆ interior (TileRealization U))) ) := by + classical + intro U z hu hl + as_aux_lemma => + let R := Set.Ioo (z.re : ℝ) ((z.re : ℝ) + 1) ×ˢ + Set.Ioo ((z.im : ℝ) - 1) ((z.im : ℝ) + 1) + have hopen : IsOpen R := isOpen_Ioo.prod isOpen_Ioo + have hsub : R ⊆ TileRealization U := by + intro p hp + rcases hp with ⟨⟨hxl, hxu⟩, ⟨hyl, hyu⟩⟩ + by_cases hside : p.2 ≤ (z.im : ℝ) + · apply Set.mem_iUnion.mpr + refine ⟨z - ⟨0, 1⟩, Set.mem_iUnion.mpr ⟨hl, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + norm_num + rw [GaussianInt.toComplex_def₂] + change ((z.re : ℝ) ≤ p.1 ∧ (z.im : ℝ) ≤ p.2 + 1) ∧ + (p.1 ≤ (z.re : ℝ) + 1 ∧ p.2 ≤ (z.im : ℝ)) + constructor <;> constructor <;> linarith + · apply Set.mem_iUnion.mpr + refine ⟨z, Set.mem_iUnion.mpr ⟨hu, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor <;> constructor <;> linarith + intro p hp + apply hopen.subset_interior_iff.mpr hsub + rcases hp with ⟨t, ht0, ht1, rfl⟩ + norm_num [R, GaussianRealPoint, Prod.smul_fst, Prod.smul_snd, smul_eq_mul] + constructor <;> constructor <;> nlinarith + +private theorem vertical_interior : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ((z - 1 ∈ U.cells) → + (OpenLatticeEdge z (z + ⟨0, 1⟩) ⊆ interior (TileRealization U))) ) := by + classical + intro U z hr hl + as_aux_lemma => + let R := Set.Ioo ((z.re : ℝ) - 1) ((z.re : ℝ) + 1) ×ˢ + Set.Ioo (z.im : ℝ) ((z.im : ℝ) + 1) + have hopen : IsOpen R := isOpen_Ioo.prod isOpen_Ioo + have hsub : R ⊆ TileRealization U := by + intro p hp + rcases hp with ⟨⟨hxl, hxu⟩, ⟨hyl, hyu⟩⟩ + by_cases hside : p.1 ≤ (z.re : ℝ) + · apply Set.mem_iUnion.mpr + refine ⟨z - 1, Set.mem_iUnion.mpr ⟨hl, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + norm_num + rw [GaussianInt.toComplex_def₂] + change ((z.re : ℝ) ≤ p.1 + 1 ∧ (z.im : ℝ) ≤ p.2) ∧ + (p.1 ≤ (z.re : ℝ) ∧ p.2 ≤ (z.im : ℝ) + 1) + constructor <;> constructor <;> linarith + · apply Set.mem_iUnion.mpr + refine ⟨z, Set.mem_iUnion.mpr ⟨hr, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor <;> constructor <;> linarith + intro p hp + apply hopen.subset_interior_iff.mpr hsub + rcases hp with ⟨t, ht0, ht1, rfl⟩ + norm_num [R, GaussianRealPoint, Prod.smul_fst, Prod.smul_snd, smul_eq_mul] + constructor <;> constructor <;> nlinarith + +private theorem edge_endpoint : + (by + classical + exact + (∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ((z - ⟨0, 1⟩ ∈ U.cells) → + (OpenLatticeEdge z (z + 1) ⊆ interior (TileRealization U)))) → ((∀ (U : ProtoTile), ∀ + (z : GaussianInt), (z ∈ U.cells) → ((z - 1 ∈ U.cells) → (OpenLatticeEdge z (z + ⟨0, + 1⟩) ⊆ interior (TileRealization U)))) → (∀ (U : ProtoTile), ∀ (z : GaussianInt), ∀ (j + : Fin 4), (∀ a, ∀ b, FourNeighborAdjacent a b → + a ∈ BoundaryFootprintVertices U → b ∈ BoundaryFootprintVertices U → + ¬ OpenLatticeEdge a b ⊆ interior (TileRealization U)) → ((z ∈ + BoundaryFootprintVertices U) → ((LatticeVertexIncidentCell z j ∈ U.cells) → + ((LatticeVertexIncidentCell z (j + 1) ∈ U.cells) → (![z + ⟨0, 1⟩, z - 1, z - ⟨0, + 1⟩, z + 1] j ∉ BoundaryFootprintVertices U)))))) ) := by + classical + intro horizontal_interior vertical_interior U z j hreg hz hj hj' + as_aux_lemma => + intro hy + fin_cases j + all_goals simp? [LatticeVertexIncidentCell] at hj hj' hy + · have he := vertical_interior U z hj hj' + apply hreg z (z + ⟨0, 1⟩) + · exact Or.inr (Or.inr (Or.inl rfl)) + · exact hz + · exact hy + · exact he + · have he := horizontal_interior U (z - 1) hj hj' + exact hreg (z - 1) z (Or.inl (by simp)) hy hz (by simpa using he) + · have he := vertical_interior U (z - ⟨0, 1⟩) hj' + (by simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] using hj) + exact hreg (z - ⟨0, 1⟩) z (Or.inr (Or.inr (Or.inl (by simp)))) hy hz + (by simpa using he) + · exact hreg z (z + 1) (Or.inl rfl) hz hy (horizontal_interior U z hj' hj) + +private theorem hOA : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), cert.O.cells ⊆ (cert.P 0 true).cells + ) := by + classical + intro C q cfg T cert c hc + exact (cert.plus_union c).mpr ⟨0, false, by simpa [← cert.precursor_eq] using hc⟩ + +private theorem hOB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), cert.O.cells ⊆ (cert.P 0 false).cells + ) := by + classical + intro C q cfg T cert c hc + exact (cert.minus_union c).mpr ⟨0, true, by simpa [← cert.precursor_cells] using hc⟩ + +private theorem hAB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ((∀ (m : ℤ), ∀ (n : ℤ), + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (⟨SixSubtileLabel.A, m, n⟩ : + PeriodicSubtileIndex)).cells ∩ (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (⟨SixSubtileLabel.B, m, n⟩ : PeriodicSubtileIndex)).cells = (TileTranslation cert.O + ((↑m : GaussianInt) * cert.u + (↑n : GaussianInt) * cert.v)).cells) ∧ ∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ¬((a.label = + SixSubtileLabel.A ∧ b.label = SixSubtileLabel.B ∨ a.label = SixSubtileLabel.B ∧ + b.label = SixSubtileLabel.A) ∧ a.first = b.first ∧ a.second = b.second) → Disjoint + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ((cert.P 0 + true).cells ∩ (cert.P 0 false).cells = cert.O.cells) ) := by + classical + intro C q cfg T cert hsep + have hzero : GaussianTranslation 0 = id := by funext z; simp [GaussianTranslation] + simpa [SubtileOccurrenceInterpretation, TileTranslation, hzero] using hsep.1 0 0 + +private theorem parentLabel_injective : + (by + classical + exact + let parentLabel (a : Fin 3 × Bool) : SixSubtileLabel := + match a.1.val, a.2 with + | 0, true => .A + | 0, false => .B + | 1, true => .C + | 1, false => .D + | 2, true => .E + | _, _ => .F + Function.Injective parentLabel ) := by + classical + intro parentLabel + rintro ⟨i, s⟩ ⟨j, t⟩ hab + fin_cases i <;> fin_cases j <;> cases s <;> cases t <;> + simp [parentLabel] at hab ⊢ + +private theorem parentOccurrence : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), + let parentLabel (a : Fin 3 × Bool) : SixSubtileLabel := + match a.1.val, a.2 with + | 0, true => .A + | 0, false => .B + | 1, true => .C + | 1, false => .D + | 2, true => .E + | _, _ => .F + let parentIndex (a : Fin 3 × Bool) : PeriodicSubtileIndex := ⟨parentLabel a, 0, 0⟩ + ∀ (a : Fin 3 × Bool), SubtileOccurrenceInterpretation cert.P cert.u cert.v (parentIndex + a) = TileTranslation (cert.P a.1 a.2) 0 ) := by + classical + intro C q cfg T cert parentLabel parentIndex a + rcases a with ⟨i, s⟩ + fin_cases i <;> cases s <;> + simp [parentIndex, parentLabel, SubtileOccurrenceInterpretation] + +private theorem parent_disjoint : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ((∀ (m : ℤ), ∀ (n : ℤ), + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (⟨SixSubtileLabel.A, m, n⟩ : + PeriodicSubtileIndex)).cells ∩ (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (⟨SixSubtileLabel.B, m, n⟩ : PeriodicSubtileIndex)).cells = (TileTranslation cert.O + ((↑m : GaussianInt) * cert.u + (↑n : GaussianInt) * cert.v)).cells) ∧ ∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ¬((a.label = + SixSubtileLabel.A ∧ b.label = SixSubtileLabel.B ∨ a.label = SixSubtileLabel.B ∧ + b.label = SixSubtileLabel.A) ∧ a.first = b.first ∧ a.second = b.second) → Disjoint + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( + let parentLabel (a : Fin 3 × Bool) : SixSubtileLabel := + match a.1.val, a.2 with + | 0, true => .A + | 0, false => .B + | 1, true => .C + | 1, false => .D + | 2, true => .E + | _, _ => .F + (Function.Injective parentLabel) → ( + let parentIndex (a : Fin 3 × Bool) : PeriodicSubtileIndex := ⟨parentLabel a, 0, 0⟩ + (∀ (a : Fin 3 × Bool), SubtileOccurrenceInterpretation cert.P cert.u cert.v (parentIndex + a) = TileTranslation (cert.P a.1 a.2) 0) → (∀ (a : Fin 3 × Bool), ∀ (b : Fin 3 × + Bool), (a ≠ b) → ((¬ (a = (0, true) ∧ b = (0, false) ∨ + a = (0, false) ∧ b = (0, true))) → (Disjoint (cert.P a.1 a.2).cells (cert.P b.1 + b.2).cells))))) ) := by + classical + intro C q cfg T cert hsep parentLabel parentLabel_injective parentIndex parentOccurrence a b + hab hnotAB + as_aux_lemma => + have hidx : parentIndex a ≠ parentIndex b := by + intro he + exact hab (parentLabel_injective (congrArg PeriodicSubtileIndex.label he)) + have hd := hsep.2 (parentIndex a) (parentIndex b) hidx ?_ + · rw [parentOccurrence a, parentOccurrence b] at hd + have hzero : GaussianTranslation 0 = id := by funext z; simp [GaussianTranslation] + simpa [TileTranslation, hzero] using hd + · intro hp + apply hnotAB + rcases hp.1 with hp | hp + · left + constructor + · apply parentLabel_injective + exact hp.1 + · apply parentLabel_injective + exact hp.2 + · right + constructor + · apply parentLabel_injective + exact hp.1 + · apply parentLabel_injective + exact hp.2 + +private theorem parent_unique : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ((cert.P 0 true).cells ∩ (cert.P 0 + false).cells = cert.O.cells) → ((∀ (a : Fin 3 × Bool), ∀ (b : Fin 3 × Bool), (a ≠ b) + → ((¬ (a = (0, true) ∧ b = (0, false) ∨ a = (0, false) ∧ b = (0, true))) → (Disjoint + (cert.P a.1 a.2).cells (cert.P b.1 b.2).cells))) → (∀ (c : LatticeCell), (c ∉ + cert.O.cells) → (∀ (a : Fin 3 × Bool), ∀ (b : Fin 3 × Bool), (c ∈ (cert.P a.1 + a.2).cells) → ((c ∈ (cert.P b.1 b.2).cells) → (a = b))))) ) := by + classical + intro C q cfg T cert hAB parent_disjoint c hc a b ha hb + by_contra hab + by_cases hpair : a = (0, true) ∧ b = (0, false) ∨ + a = (0, false) ∧ b = (0, true) + · apply hc + rw [← hAB] + rcases hpair with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact Finset.mem_inter.mpr ⟨ha, hb⟩ + · exact Finset.mem_inter.mpr ⟨hb, ha⟩ + · exact Finset.disjoint_left.mp (parent_disjoint a b hab hpair) ha hb + +private theorem hchildPos : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (i : + Fin 3), 0 < (q i.succ).1) ) := by + classical + intro q cfg i + have := (ProperBandCurvatureStructure q cfg.proper).2.1 i + have := cfg.noLine i.succ + omega + +private theorem prototile_disk : + (by + classical + exact + ∀ (c : CircleCoordinates), (∃ r : Fin 4 → CircleCoordinates, + SemiProperQuadruple r ∧ ∃ i, r i = c) → (∀ (U : ProtoTile), (BandPrototile c U) → ((0 + < c.1 ∨ U.cells.Nonempty) → (LatticeTile U))) ) := by + classical + intro c hcircle U hU hvalid + as_aux_lemma => + cases hU with + | line w z hw => + rcases hvalid with h | h <;> simp at h + | unit z a anchor => + let E : BandCircle := + ⟨⟨(1, 1 + 2 * z), Or.inl (by norm_num), hcircle⟩, by norm_num⟩ + obtain ⟨V, hV, harea, _⟩ := CurvatureOneTileBase E rfl + obtain ⟨b, hb⟩ := Finset.card_eq_one.mp harea + let V' := TileTranslation V (a - b) + have hV' : LatticeTile V' := (TileDiskAreaCovariance V (a - b)).1.mp hV + have hcells' : V'.cells = {a} := by + simp [V', TileTranslation, hb, GaussianTranslation] + unfold LatticeTile TileRealization at hV' ⊢ + rw [hcells'] at hV' + exact hV' + | @decompose r hr S U hS hcells hfoot hcent => + exact (BandTileSimultaneousInduction r hr U + (.decompose hr hS hcells hfoot hcent)).1 + +private theorem retained_pos : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), (∀ + (i : Fin 3), 0 < (q i.succ).1) → (∀ (i : Fin 3), (i = 1 ∨ i = 2) → (0 < + (cfg.firstPredecessor i.succ).1)) ) := by + classical + intro q cfg hchildPos i hi + rcases hi with rfl | rfl + · simpa [cfg.firstParentTwo] using hchildPos 1 + · simpa [cfg.firstParentThree] using hchildPos 2 + +private theorem no_parent_interior : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : + Finset GaussianInt), (∀ (x : GaussianInt), x ∈ P ↔ x ∈ D ∧ ∃ (i : Fin (3 : ℕ)) (s : + Bool), x ∈ FootprintVertices (cert.P i s) ∧ x ∉ BoundaryFootprintVertices (cert.P i + s)) → (∀ (x : GaussianInt), (x ∈ D) → ((x ∉ P) → (∀ (i : Fin 3), ∀ (s : Bool), (x ∈ + FootprintVertices (cert.P i s)) → (x ∈ BoundaryFootprintVertices (cert.P i s))))) ) + := by + classical + intro C q cfg T cert D P hP x hxD hxP i s hf + by_contra hb + exact hxP ((hP x).mpr ⟨hxD, i, s, hf, hb⟩) + +private theorem no_diagonal : + (by + classical + exact + ∀ (x : GaussianInt), ∀ {α : Type}, ∀ (F : α → ProtoTile), (∀ a, LatticeTile (F a)) → (∀ + (owner : Fin 4 → α), (∀ j, ∀ a, LatticeVertexIncidentCell x j ∈ (F a).cells ↔ owner j + = a) → (¬ (owner 0 = owner 2 ∧ owner 1 ≠ owner 0 ∧ owner 3 ≠ owner 0) ∧ ¬ (owner 1 = + owner 3 ∧ owner 0 ≠ owner 1 ∧ owner 2 ≠ owner 1))) ) := by + classical + intro x α F hF owner hown + as_aux_lemma => + constructor + · rintro ⟨h02, h1, h3⟩ + have hcheck := (LatticeTileGridStructure (F (owner 0)) (hF (owner 0))).2.1 x + apply hcheck + left + have h0 := (hown 0 (owner 0)).mpr rfl + have h2 := (hown 2 (owner 0)).mpr h02.symm + have hn1 : LatticeVertexIncidentCell x 1 ∉ (F (owner 0)).cells := + fun h => h1 ((hown 1 (owner 0)).mp h) + have hn3 : LatticeVertexIncidentCell x 3 ∉ (F (owner 0)).cells := + fun h => h3 ((hown 3 (owner 0)).mp h) + simpa [LatticeVertexIncidentCell] using And.intro h0 ⟨h2, hn1, hn3⟩ + · rintro ⟨h13, h0, h2⟩ + have hcheck := (LatticeTileGridStructure (F (owner 1)) (hF (owner 1))).2.1 x + apply hcheck + right + have h1 := (hown 1 (owner 1)).mpr rfl + have h3 := (hown 3 (owner 1)).mpr h13.symm + have hn0 : LatticeVertexIncidentCell x 0 ∉ (F (owner 1)).cells := + fun h => h0 ((hown 0 (owner 1)).mp h) + have hn2 : LatticeVertexIncidentCell x 2 ∉ (F (owner 1)).cells := + fun h => h2 ((hown 2 (owner 1)).mp h) + simpa [LatticeVertexIncidentCell] using And.intro h1 ⟨h3, hn0, hn2⟩ + +private theorem label_sectors : + (by + classical + exact + ∀ (x : GaussianInt), ∀ {α : Type}, ∀ (F : α → ProtoTile), (∀ a, ∀ b, a ≠ b → Disjoint (F + a).cells (F b).cells) → ((∀ j : Fin 4, ∃ a, LatticeVertexIncidentCell x j ∈ (F + a).cells) → (∃ owner : Fin 4 → α, ∀ j, ∀ a, LatticeVertexIncidentCell x j ∈ (F + a).cells ↔ owner j = a)) ) := by + classical + intro x α F hd hcover + as_aux_lemma => + let owner (j : Fin 4) := Classical.choose (hcover j) + have hs (j) : LatticeVertexIncidentCell x j ∈ (F (owner j)).cells := + Classical.choose_spec (hcover j) + refine ⟨owner, fun j a => ⟨?_, ?_⟩⟩ + · intro ha + by_contra hn + exact Finset.disjoint_left.mp (hd (owner j) a hn) (hs j) ha + · rintro rfl + exact hs j + +private theorem common_parent_iff : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (∀ (a : Fin 3 × Bool), ∀ (b : Fin 3 × + Bool), (a ≠ b) → ((¬ (a = (0, true) ∧ b = (0, false) ∨ a = (0, false) ∧ b = (0, + true))) → (Disjoint (cert.P a.1 a.2).cells (cert.P b.1 b.2).cells))) → (∀ (x : + GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ + LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells) → (∀ (j : Fin 4), (∃ i s, + LatticeVertexIncidentCell x j ∈ (cert.P i s).cells ∧ LatticeVertexIncidentCell x + (j + 1) ∈ (cert.P i s).cells) ↔ (LatticeVertexIncidentCell x j ∈ (cert.P 0 + true).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P 0 true).cells) ∨ + (LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ (cert.P 0 false).cells))) ) := by + classical + intro C q cfg T cert parent_disjoint x hcover j + as_aux_lemma => + constructor + · rintro ⟨i, s, hj, hj'⟩ + by_cases ha : (i, s) = ((0 : Fin 3), true) + · cases ha + exact Or.inl ⟨hj, hj'⟩ + by_cases hb : (i, s) = ((0 : Fin 3), false) + · cases hb + exact Or.inr ⟨hj, hj'⟩ + have hd (b : Fin 3 × Bool) (hba : b = (0, true) ∨ b = (0, false)) : + Disjoint (cert.P i s).cells (cert.P b.1 b.2).cells := by + apply parent_disjoint (i, s) b + · rcases hba with rfl | rfl <;> assumption + · rintro (⟨h, _⟩ | ⟨h, _⟩) + · exact ha h + · exact hb h + rcases hcover j with h | h + · exact (Finset.disjoint_left.mp (hd (0, true) (Or.inl rfl)) hj h).elim + · exact (Finset.disjoint_left.mp (hd (0, false) (Or.inr rfl)) hj h).elim + · rintro (h | h) + · exact ⟨0, true, h⟩ + · exact ⟨0, false, h⟩ + +private theorem shared_cells : + (by + classical + exact + ∀ (x : GaussianInt), + let neighbor : Fin 4 → GaussianInt := ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + ∀ (j : Fin 4), ∃ a b : Fin 4, LatticeVertexIncidentCell x j = LatticeVertexIncidentCell + (neighbor j) a ∧ LatticeVertexIncidentCell x (j + 1) = LatticeVertexIncidentCell + (neighbor j) b ) := by + classical + intro x neighbor j + fin_cases j + · exact ⟨3, 2, by simp [neighbor, LatticeVertexIncidentCell], by + simp [neighbor, LatticeVertexIncidentCell, sub_eq_add_neg, add_comm, add_left_comm, + add_assoc]⟩ + · exact ⟨0, 3, by simp [neighbor, LatticeVertexIncidentCell], by simp [neighbor, + LatticeVertexIncidentCell]⟩ + · exact ⟨1, 0, by simp [neighbor, LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc], by simp [neighbor, LatticeVertexIncidentCell]⟩ + · exact ⟨2, 1, by simp [neighbor, LatticeVertexIncidentCell], by simp [neighbor, + LatticeVertexIncidentCell]⟩ + +private theorem neighbor_bridge : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : + Finset GaussianInt), (∀ (x : GaussianInt), x ∈ D ↔ x ∈ FootprintVertices T ∧ x ∉ + BoundaryFootprintVertices T) → ((∀ (x : GaussianInt), x ∈ P ↔ x ∈ D ∧ ∃ (i : Fin (3 : + ℕ)) (s : Bool), x ∈ FootprintVertices (cert.P i s) ∧ x ∉ BoundaryFootprintVertices + (cert.P i s)) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell z j ∈ U.cells) → (z ∈ FootprintVertices U)) → ((∀ (U : + ProtoTile), ∀ (z : GaussianInt), (z ∈ FootprintVertices U ∧ z ∉ + BoundaryFootprintVertices U) ↔ ∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ U.cells) + → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), ∀ (j : Fin 4), (∀ a, ∀ b, + FourNeighborAdjacent a b → a ∈ BoundaryFootprintVertices U → b ∈ + BoundaryFootprintVertices U → ¬ OpenLatticeEdge a b ⊆ interior (TileRealization U)) → + ((z ∈ BoundaryFootprintVertices U) → ((LatticeVertexIncidentCell z j ∈ U.cells) → + ((LatticeVertexIncidentCell z (j + 1) ∈ U.cells) → (![z + ⟨0, 1⟩, z - 1, z - ⟨0, 1⟩, + z + 1] j ∉ BoundaryFootprintVertices U))))) → ((∀ (i : Fin 3), ∀ (s : Bool), ∀ a, ∀ + b, FourNeighborAdjacent a b → a ∈ BoundaryFootprintVertices (cert.P i s) → b ∈ + BoundaryFootprintVertices (cert.P i s) → ¬ OpenLatticeEdge a b ⊆ interior + (TileRealization (cert.P i s))) → (∀ (x : GaussianInt), (∀ (i : Fin 3), ∀ (s : Bool), + (x ∈ FootprintVertices (cert.P i s)) → (x ∈ BoundaryFootprintVertices (cert.P i s))) → ( + let neighbor : Fin 4 → GaussianInt := ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + (∀ (j : Fin 4), ∃ a b : Fin 4, LatticeVertexIncidentCell x j = LatticeVertexIncidentCell + (neighbor j) a ∧ LatticeVertexIncidentCell x (j + 1) = LatticeVertexIncidentCell + (neighbor j) b) → (∀ (j : Fin 4), neighbor j ∈ P ↔ ∃ i s, LatticeVertexIncidentCell x + j ∈ (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i + s).cells)))))))) ) := by + classical + intro C q cfg T cert D P hD hP incident_foot full_iff edge_endpoint parent_regular x + no_parent_interior neighbor shared_cells j + as_aux_lemma => + obtain ⟨a, b, ha, hb⟩ := shared_cells j + constructor + · intro hp + obtain ⟨_, i, s, hf, hn⟩ := (hP _).mp hp + have hall := (full_iff (cert.P i s) (neighbor j)).mp ⟨hf, hn⟩ + exact ⟨i, s, by rw [ha]; exact hall a, by rw [hb]; exact hall b⟩ + · rintro ⟨i, s, hj, hj'⟩ + have hxf := incident_foot _ x j hj + have hyf := incident_foot (cert.P i s) (neighbor j) a (by rw [← ha]; exact hj) + have hxb := no_parent_interior i s hxf + have hyn : neighbor j ∉ BoundaryFootprintVertices (cert.P i s) := + edge_endpoint (cert.P i s) x j (parent_regular i s) hxb hj hj' + have hyfull := (full_iff (cert.P i s) (neighbor j)).mp ⟨hyf, hyn⟩ + have hyT := (full_iff T (neighbor j)).mpr (fun l => + (cert.outer_union _).mpr ⟨i, s, hyfull l⟩) + exact (hP _).mpr ⟨(hD _).mpr hyT, i, s, hyf, hyn⟩ + +private theorem neighbor_injective : + (by + classical + exact + ∀ (x : GaussianInt), + let neighbor : Fin 4 → GaussianInt := ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + Function.Injective neighbor ) := by + classical + intro x neighbor a b hab + fin_cases a <;> fin_cases b <;> simp [neighbor, Zsqrtd.ext_iff] at hab ⊢ <;> omega + +private theorem neighbor_exhaust : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : + Finset GaussianInt), ∀ (x : GaussianInt), (x ∈ D \ P) → ((x ∈ D) → ((x ∉ P) → ((x ∈ + FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T) → ((∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ T.cells) → ((∀ (i : Fin 3), ∀ (s : Bool), (x ∈ + FootprintVertices (cert.P i s)) → (x ∈ BoundaryFootprintVertices (cert.P i s))) → ((∀ + {α : Type}, ∀ (F : α → ProtoTile), (∀ a, LatticeTile (F a)) → (∀ (owner : Fin 4 → α), + (∀ j, ∀ a, LatticeVertexIncidentCell x j ∈ (F a).cells ↔ owner j = a) → (¬ (owner 0 = + owner 2 ∧ owner 1 ≠ owner 0 ∧ owner 3 ≠ owner 0) ∧ ¬ (owner 1 = owner 3 ∧ owner 0 ≠ + owner 1 ∧ owner 2 ≠ owner 1)))) → ((∀ {α : Type}, ∀ (F : α → ProtoTile), (∀ a, ∀ b, a + ≠ b → Disjoint (F a).cells (F b).cells) → ((∀ j : Fin 4, ∃ a, + LatticeVertexIncidentCell x j ∈ (F a).cells) → (∃ owner : Fin 4 → α, ∀ j, ∀ a, + LatticeVertexIncidentCell x j ∈ (F a).cells ↔ owner j = a))) → (((∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ LatticeVertexIncidentCell x j + ∈ (cert.P 0 false).cells) → (∀ (j : Fin 4), (∃ i s, LatticeVertexIncidentCell x j ∈ + (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells) ↔ + (LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∧ LatticeVertexIncidentCell x + (j + 1) ∈ (cert.P 0 true).cells) ∨ (LatticeVertexIncidentCell x j ∈ (cert.P 0 + false).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P 0 false).cells))) → ( + let neighbor : Fin 4 → GaussianInt := ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + (∀ (j : Fin 4), ∃ a b : Fin 4, LatticeVertexIncidentCell x j = LatticeVertexIncidentCell + (neighbor j) a ∧ LatticeVertexIncidentCell x (j + 1) = LatticeVertexIncidentCell + (neighbor j) b) → ((∀ (j : Fin 4), neighbor j ∈ P ↔ ∃ i s, LatticeVertexIncidentCell + x j ∈ (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells) + → ((Function.Injective neighbor) → ((∀ (j : Fin 4), FourNeighborAdjacent (neighbor j) + x) → (∀ (y : GaussianInt), (FourNeighborAdjacent y x) → (∃ j : Fin 4, neighbor j = + y)))))))))))))) ) := by + classical + intro C q cfg T cert D P x hx hxD hxP hxT hcells no_parent_interior no_diagonal label_sectors + common_parent_iff neighbor shared_cells neighbor_bridge neighbor_injective + neighbor_adjacent y hy + rcases hy with rfl | rfl | rfl | rfl + · exact ⟨1, by simp [neighbor]⟩ + · exact ⟨3, by simp [neighbor]⟩ + · exact ⟨2, by simp [neighbor]⟩ + · exact ⟨0, by simp [neighbor]⟩ + +private theorem neighbor_count : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (P : Finset GaussianInt), ∀ (x : + GaussianInt), + let neighbor : Fin 4 → GaussianInt := ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + (∀ (j : Fin 4), neighbor j ∈ P ↔ ∃ i s, LatticeVertexIncidentCell x j ∈ (cert.P i + s).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells) → + ((Function.Injective neighbor) → ((∀ (j : Fin 4), FourNeighborAdjacent (neighbor j) + x) → ((∀ (y : GaussianInt), (FourNeighborAdjacent y x) → (∃ j : Fin 4, neighbor j = + y)) → ((P.filter fun y => @decide (FourNeighborAdjacent y x) (Classical.propDecidable + _)).card = (Finset.univ.filter fun j : Fin 4 => ∃ i s, LatticeVertexIncidentCell x j + ∈ (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i + s).cells).card)))) ) := by + classical + intro C q cfg T cert P x neighbor neighbor_bridge neighbor_injective neighbor_adjacent + neighbor_exhaust + symm + apply Finset.card_bij (fun j _ => neighbor j) + · intro j hj + exact Finset.mem_filter.mpr ⟨(neighbor_bridge j).mpr (Finset.mem_filter.mp hj).2, + by simpa using neighbor_adjacent j⟩ + · intro j hj l hl he + exact neighbor_injective he + · intro y hy + obtain ⟨j, rfl⟩ := neighbor_exhaust y (by simpa using (Finset.mem_filter.mp hy).2) + exact ⟨j, Finset.mem_filter.mpr ⟨Finset.mem_univ _, + (neighbor_bridge j).mp (Finset.mem_filter.mp hy).1⟩, rfl⟩ + +private theorem hnoO : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : + Finset GaussianInt), (∀ x ∈ D \ P, x ∈ FootprintVertices cert.O ↔ x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((∀ + (U : ProtoTile), ∀ (z : + GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell z j ∈ U.cells) → (z ∈ + FootprintVertices U)) → (∀ (x : GaussianInt), (x ∈ D \ P) → ((x ∉ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (∀ + (j : Fin 4), + LatticeVertexIncidentCell x j ∉ cert.O.cells)))) ) := by + classical + intro C q cfg T cert D P hprecursor incident_foot x hx hnotR j hj + exact hnotR ((hprecursor x hx).mp (incident_foot cert.O x j hj)) + +private theorem owner_exists : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), (∀ (j : Fin (4 : + ℕ)), LatticeVertexIncidentCell x j ∈ T.cells) → (∀ (j : Fin 4), ∃ a : Fin 3 × Bool, + LatticeVertexIncidentCell x j ∈ (cert.P a.1 a.2).cells) ) := by + classical + intro C q cfg T cert x hcells j + obtain ⟨i, s, h⟩ := (cert.outer_union _).mp (hcells j) + exact ⟨(i, s), h⟩ + +private theorem owner_iff : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (∀ (c : LatticeCell), (c ∉ + cert.O.cells) → (∀ (a : Fin 3 × Bool), ∀ (b : Fin 3 × Bool), (c ∈ (cert.P a.1 + a.2).cells) → ((c ∈ (cert.P b.1 b.2).cells) → (a = b)))) → (∀ (x : GaussianInt), (∀ + (j : Fin 4), LatticeVertexIncidentCell x j ∉ cert.O.cells) → (∀ (owner_exists : ∀ (j + : Fin 4), ∃ a : Fin 3 × Bool, LatticeVertexIncidentCell x j ∈ (cert.P a.1 a.2).cells), + let owner (j : Fin 4) : Fin 3 × Bool := Classical.choose (owner_exists j) + (∀ (j : Fin 4), LatticeVertexIncidentCell x j ∈ (cert.P (owner j).1 (owner j).2).cells) → + (∀ (j : Fin 4), ∀ (a : Fin 3 × Bool), LatticeVertexIncidentCell x j ∈ (cert.P a.1 + a.2).cells ↔ owner j = a))) ) := by + classical + intro C q cfg T cert parent_unique x hnoO owner_exists owner owner_spec j a + constructor + · intro ha + exact parent_unique _ (hnoO j) _ _ (owner_spec j) ha + · rintro rfl + exact owner_spec j + +private theorem hboundary : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (∀ (U : ProtoTile), ∀ (z : + GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell z j ∈ U.cells) → (z ∈ + FootprintVertices U)) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ (z : + GaussianInt), (z ∈ FootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell z j + ∈ U.cells))) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ + BoundaryFootprintVertices U) → (z ∈ FootprintVertices U)) → (∀ (x : GaussianInt), (∀ + (i : Fin 3), ∀ (s : Bool), (x ∈ FootprintVertices (cert.P i s)) → (x ∈ + BoundaryFootprintVertices (cert.P i s))) → (∀ (owner_exists : ∀ (j : Fin 4), ∃ a : + Fin 3 × Bool, LatticeVertexIncidentCell x j ∈ (cert.P a.1 a.2).cells), + let owner (j : Fin 4) : Fin 3 × Bool := Classical.choose (owner_exists j) + (∀ (j : Fin 4), LatticeVertexIncidentCell x j ∈ (cert.P (owner j).1 (owner j).2).cells) → + ((∀ (j : Fin 4), ∀ (a : Fin 3 × Bool), LatticeVertexIncidentCell x j ∈ (cert.P a.1 + a.2).cells ↔ owner j = a) → (∀ (a : Fin 3 × Bool), x ∈ BoundaryFootprintVertices + (cert.P a.1 a.2) ↔ a ∈ Finset.univ.image owner)))))) ) := by + classical + intro C q cfg T cert incident_foot foot_incident boundary_foot x no_parent_interior + owner_exists owner owner_spec owner_iff a + constructor + · intro hb + obtain ⟨j, hj⟩ := foot_incident _ + (LatticeTileGridStructure _ (cert.parent_lattice a.1 a.2)).1.1 x + (boundary_foot _ x hb) + exact Finset.mem_image.mpr ⟨j, Finset.mem_univ _, (owner_iff j a).mp hj⟩ + · intro ha + obtain ⟨j, _, rfl⟩ := Finset.mem_image.mp ha + exact no_parent_interior _ _ (incident_foot _ x j (owner_spec j)) + +private theorem hcard : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), ∀ (owner_exists + : ∀ (j : Fin 4), ∃ a : Fin 3 × Bool, LatticeVertexIncidentCell x j ∈ (cert.P a.1 + a.2).cells), + let owner (j : Fin 4) : Fin 3 × Bool := Classical.choose (owner_exists j) + (∀ (a : Fin 3 × Bool), x ∈ BoundaryFootprintVertices (cert.P a.1 a.2) ↔ a ∈ + Finset.univ.image owner) → (Nat.card + {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} = + (Finset.univ.image owner).card) ) := by + classical + intro C q cfg T cert x owner_exists owner hboundary + rw [Nat.card_eq_fintype_card, Fintype.card_subtype] + congr 1 + ext a + simp [hboundary a] + +private theorem hnot_constant : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : + Finset GaussianInt), (∀ (x : GaussianInt), x ∈ P ↔ x ∈ D ∧ ∃ (i : Fin (3 : ℕ)) (s : + Bool), x ∈ FootprintVertices (cert.P i s) ∧ x ∉ BoundaryFootprintVertices (cert.P i + s)) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ FootprintVertices U ∧ z ∉ + BoundaryFootprintVertices U) ↔ ∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ U.cells) + → (∀ (x : GaussianInt), (x ∈ D) → ((x ∉ P) → (∀ (owner_exists : ∀ (j : Fin 4), ∃ a : + Fin 3 × Bool, LatticeVertexIncidentCell x j ∈ (cert.P a.1 a.2).cells), + let owner (j : Fin 4) : Fin 3 × Bool := Classical.choose (owner_exists j) + (∀ (j : Fin 4), ∀ (a : Fin 3 × Bool), LatticeVertexIncidentCell x j ∈ (cert.P a.1 + a.2).cells ↔ owner j = a) → (∃ j, owner j ≠ owner 0))))) ) := by + classical + intro C q cfg T cert D P hP full_iff x hxD hxP owner_exists owner owner_iff + by_contra hn + have hall : ∀ j, owner j = owner 0 := by simpa using hn + have hfull := (full_iff (cert.P (owner 0).1 (owner 0).2) x).mpr + (fun j => (owner_iff j (owner 0)).mpr (hall j)) + exact hxP ((hP x).mpr ⟨hxD, (owner 0).1, (owner 0).2, hfull⟩) + +private theorem finite_countAt614 : + (by + classical + exact + ∀ owner : Fin 4 → Fin 3 × Bool, (¬ (owner 0 = owner 2 ∧ owner 1 ≠ owner 0 ∧ owner 3 ≠ + owner 0) ∧ ¬ (owner 1 = owner 3 ∧ owner 0 ≠ owner 1 ∧ owner 2 ≠ owner 1)) → (∃ j, + owner j ≠ owner 0) → (Finset.univ.filter (fun j : Fin 4 => owner j = owner (j + + 1))).card + (Finset.univ.image owner).card = 4 ) := by + classical + decide +kernel + +private theorem hncount : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (P : Finset GaussianInt), ∀ (x : + GaussianInt), ((P.filter fun y => @decide (FourNeighborAdjacent y x) + (Classical.propDecidable _)).card = (Finset.univ.filter fun j : Fin 4 => ∃ i s, + LatticeVertexIncidentCell x j ∈ (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + + 1) ∈ (cert.P i s).cells).card) → (∀ (owner_exists : ∀ (j : Fin 4), ∃ a : Fin 3 × + Bool, LatticeVertexIncidentCell x j ∈ (cert.P a.1 a.2).cells), + let owner (j : Fin 4) : Fin 3 × Bool := Classical.choose (owner_exists j) + (∀ (j : Fin 4), LatticeVertexIncidentCell x j ∈ (cert.P (owner j).1 (owner j).2).cells) → + ((∀ (j : Fin 4), ∀ (a : Fin 3 × Bool), LatticeVertexIncidentCell x j ∈ (cert.P a.1 + a.2).cells ↔ owner j = a) → ((P.filter fun y => @decide (FourNeighborAdjacent y x) + (Classical.propDecidable _)).card = (Finset.univ.filter (fun j : Fin 4 => owner j = + owner (j + 1))).card))) ) := by + classical + intro C q cfg T cert P x neighbor_count owner_exists owner owner_spec owner_iff + rw [neighbor_count] + congr 1 + ext j + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + constructor + · rintro ⟨i, s, hj, hj'⟩ + exact ((owner_iff j (i, s)).mp hj).trans ((owner_iff (j + 1) (i, s)).mp hj').symm + · intro he + exact ⟨(owner j).1, (owner j).2, owner_spec j, + (owner_iff (j + 1) (owner j)).mpr he.symm⟩ + +private theorem hlow : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), ∀ (owner_exists + : ∀ (j : Fin 4), ∃ a : Fin 3 × Bool, LatticeVertexIncidentCell x j ∈ (cert.P a.1 + a.2).cells), + let owner (j : Fin 4) : Fin 3 × Bool := Classical.choose (owner_exists j) + (∃ j, owner j ≠ owner 0) → (2 ≤ (Finset.univ.image owner).card) ) := by + classical + intro C q cfg T cert x owner_exists owner hnot_constant + obtain ⟨j, hj⟩ := hnot_constant + have hsub : ({owner 0, owner j} : Finset (Fin 3 × Bool)) ⊆ Finset.univ.image owner := by + intro a ha + simp only [Finset.mem_insert, Finset.mem_singleton] at ha + rcases ha with rfl | rfl + · exact Finset.mem_image.mpr ⟨0, Finset.mem_univ _, rfl⟩ + · exact Finset.mem_image.mpr ⟨j, Finset.mem_univ _, rfl⟩ + have := Finset.card_le_card hsub + simpa [Finset.card_pair hj.symm] using this + +private theorem hk23 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (P : Finset GaussianInt), ∀ (x : + GaussianInt), ((P.filter fun y => @decide (FourNeighborAdjacent y x) + (Classical.propDecidable _)).card = (Finset.univ.filter fun j : Fin 4 => ∃ i s, + LatticeVertexIncidentCell x j ∈ (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + + 1) ∈ (cert.P i s).cells).card) → (∀ (owner_exists : ∀ (j : Fin 4), ∃ a : Fin 3 × + Bool, LatticeVertexIncidentCell x j ∈ (cert.P a.1 a.2).cells), + let owner (j : Fin 4) : Fin 3 × Bool := Classical.choose (owner_exists j) + (Nat.card {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} = + (Finset.univ.image owner).card) → (((P.filter fun y => @decide (FourNeighborAdjacent + y x) (Classical.propDecidable _)).card = (Finset.univ.filter (fun j : Fin 4 => owner + j = owner (j + 1))).card) → (( + let k := Nat.card + { is : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) }; (k = + (2 : ℕ) → GaussianRealPoint x ≠ TileCentroid T → BandOrderedGeneralInteriorWebRow + cert x false) ∧ (k = (3 : ℕ) → BandOrderedGeneralInteriorWebRow cert x true ∧ + GaussianRealPoint x ≠ TileCentroid T) ∧ k ≠ (4 : ℕ) ∧ (k = (2 : ℕ) → + GaussianRealPoint x = TileCentroid T → (cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = + (0 : ℤ))) → (((Finset.univ.filter fun j : Fin 4 => owner j = owner (j + 1)).card + + (Finset.image owner Finset.univ).card = (4 : ℕ)) → ((2 ≤ (Finset.univ.image + owner).card) → (Nat.card + {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} = 2 ∨ Nat.card + {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} = 3)))))) ) := by + classical + intro C q cfg T cert P x neighbor_count owner_exists owner hcard hncount hclass hsum hlow + have hk4 := hclass.2.2.1 + omega + +private theorem hzeroAt680 : + (by + classical + exact + ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by + classical + intro U + have hz : GaussianTranslation 0 = id := by funext z; simp [GaussianTranslation] + cases U + simp [TileTranslation, hz, GaussianTranslation] + +private theorem hcoverAt684 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : + Finset GaussianInt), (∀ x ∈ D \ P, x ∈ FootprintVertices cert.O ↔ x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((∀ + (U : ProtoTile), ∀ (z : + GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell z j ∈ U.cells) → (z ∈ + FootprintVertices U)) → (∀ (x : GaussianInt), (x ∈ D \ P) → ((x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((∀ + (U : ProtoTile), + TileTranslation U 0 = U) → (∀ (j : Fin 4), LatticeVertexIncidentCell x j ∈ (cert.P 0 + true).cells ∨ LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells))))) ) := by + classical + intro C q cfg T cert D P hprecursor incident_foot x hx hxR hzero j + have hxO := (hprecursor x hx).mpr hxR + have hc := cert.precursor_isolated 0 0 x (by simpa [hzero] using hxO) + (LatticeVertexIncidentCell x j) + (incident_foot (⟨{LatticeVertexIncidentCell x j}, LatticeVertexIncidentCell x j⟩ : + ProtoTile) + x j (by simp)) + simpa [SubtileOccurrenceInterpretation, hzero] using hc + +private theorem hFdAt697 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ((cert.P 0 true).cells ∩ (cert.P 0 + false).cells = cert.O.cells) → ((cert.O.cells = ∅) → ( + let F : Fin 2 → ProtoTile := ![cert.P 0 true, cert.P 0 false] + ∀ (a : Fin 2), ∀ (b : Fin 2), (a ≠ b) → (Disjoint (F a).cells (F b).cells))) ) := by + classical + intro C q cfg T cert hAB hempty F a b hne + have hd : Disjoint (cert.P 0 true).cells (cert.P 0 false).cells := by + rw [Finset.disjoint_iff_inter_eq_empty, hAB, hempty] + fin_cases a <;> fin_cases b + · exact (hne rfl).elim + · exact hd + · exact hd.symm + · exact (hne rfl).elim + +private theorem hsurjAt709 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), ∀ (jA : Fin (4 : + ℕ)), ∀ (jB : Fin (4 : ℕ)), (LatticeVertexIncidentCell x jA ∈ (cert.P 0 true).cells) → + ((LatticeVertexIncidentCell x jB ∈ (cert.P 0 false).cells) → ( + let F : Fin 2 → ProtoTile := ![cert.P 0 true, cert.P 0 false] + ∀ (owner : Fin (4 : ℕ) → Fin (2 : ℕ)), (∀ (j : Fin (4 : ℕ)), ∀ (a : Fin (2 : ℕ)), + LatticeVertexIncidentCell x j ∈ (F a).cells ↔ owner j = a) → (Function.Surjective + owner))) ) := by + classical + intro C q cfg T cert x jA jB hA hB F owner hown a + fin_cases a + · exact ⟨jA, (hown jA 0).mp hA⟩ + · exact ⟨jB, (hown jB 1).mp hB⟩ + +private theorem hcommonAt714 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), ((∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ LatticeVertexIncidentCell x j + ∈ (cert.P 0 false).cells) → (∀ (j : Fin 4), (∃ i s, LatticeVertexIncidentCell x j ∈ + (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells) ↔ + (LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∧ LatticeVertexIncidentCell x + (j + 1) ∈ (cert.P 0 true).cells) ∨ (LatticeVertexIncidentCell x j ∈ (cert.P 0 + false).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P 0 false).cells))) → ((∀ + (j : Fin 4), LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ + LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells) → ( + let F : Fin 2 → ProtoTile := ![cert.P 0 true, cert.P 0 false] + ∀ (owner : Fin (4 : ℕ) → Fin (2 : ℕ)), (∀ (j : Fin (4 : ℕ)), ∀ (a : Fin (2 : ℕ)), + LatticeVertexIncidentCell x j ∈ (F a).cells ↔ owner j = a) → (∀ (j : Fin 4), (∃ i s, + LatticeVertexIncidentCell x j ∈ (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + + 1) ∈ (cert.P i s).cells) ↔ owner j = owner (j + 1)))) ) := by + classical + intro C q cfg T cert x common_parent_iff hcover F owner hown j + rw [common_parent_iff hcover j] + have hA (j) : LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ↔ owner j = 0 := + hown j 0 + have hB (j) : LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells ↔ owner j = 1 := + hown j 1 + rw [hA, hA, hB, hB] + have hf : ∀ a b : Fin 2, ((a = 0 ∧ b = 0) ∨ (a = 1 ∧ b = 1)) ↔ a = b := by + decide +kernel + exact hf _ _ + +private theorem hsetAt727 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), ∀ (owner : Fin + (4 : ℕ) → Fin (2 : ℕ)), (∀ (j : Fin 4), (∃ i s, LatticeVertexIncidentCell x j ∈ + (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells) ↔ + owner j = owner (j + 1)) → ((Finset.univ.filter fun j : Fin 4 => ∃ i s, + LatticeVertexIncidentCell x j ∈ (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + + 1) ∈ (cert.P i s).cells) = Finset.univ.filter (fun j : Fin 4 => owner j = owner (j + + 1))) ) := by + classical + intro C q cfg T cert x owner hcommon + ext j + simp only [Finset.mem_filter, Finset.mem_univ, true_and, hcommon j] + +private theorem finite_countAt734 : + (by + classical + exact + ∀ owner : Fin 4 → Fin 2, (¬ (owner 0 = owner 2 ∧ owner 1 ≠ owner 0 ∧ owner 3 ≠ owner 0) ∧ + ¬ (owner 1 = owner 3 ∧ owner 0 ≠ owner 1 ∧ owner 2 ≠ owner 1)) → Function.Surjective + owner → (Finset.univ.filter (fun j : Fin 4 => owner j = owner (j + 1))).card = 2 ) := by + classical + decide +kernel + +private theorem hOlat : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (∀ (c : CircleCoordinates), (∃ r : + Fin 4 → CircleCoordinates, SemiProperQuadruple r ∧ ∃ i, r i = c) → (∀ (U : + ProtoTile), (BandPrototile c U) → ((0 < c.1 ∨ U.cells.Nonempty) → (LatticeTile U)))) + → ((cert.O.cells.Nonempty) → (LatticeTile cert.O)) ) := by + classical + intro C q cfg T cert prototile_disk hOne + rw [cert.precursor_eq] + apply prototile_disk _ + ⟨cfg.firstPredecessor, cfg.firstProper.1, (0 : Fin 3).succ, rfl⟩ _ + (cert.plus_occurrence 0 false).1 + exact Or.inr (by simpa [← cert.precursor_eq] using hOne) + +private theorem hFlatAt752 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (LatticeTile cert.O) → ( + let F : Fin 3 → ProtoTile := + ![TileCellComplement (cert.P 0 true) cert.O, + TileCellComplement (cert.P 0 false) cert.O, cert.O] + ∀ (a : Fin 3), LatticeTile (F a)) ) := by + classical + intro C q cfg T cert hOlat F a + fin_cases a + · exact cert.precursor_complement_lattice.1 + · exact cert.precursor_complement_lattice.2 + · exact hOlat + +private theorem hFdAt757 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ((cert.P 0 true).cells ∩ (cert.P 0 + false).cells = cert.O.cells) → ( + let F : Fin 3 → ProtoTile := + ![TileCellComplement (cert.P 0 true) cert.O, + TileCellComplement (cert.P 0 false) cert.O, cert.O] + ∀ (a : Fin 3), ∀ (b : Fin 3), (a ≠ b) → (Disjoint (F a).cells (F b).cells)) ) := by + classical + intro C q cfg T cert hAB F a b hne + apply Finset.disjoint_left.mpr + intro c ha hb + have hcAB : (c ∈ (cert.P 0 true).cells ∧ c ∈ (cert.P 0 false).cells) ↔ + c ∈ cert.O.cells := by rw [← Finset.mem_inter, hAB] + fin_cases a <;> fin_cases b <;> simp? [F, TileCellComplement] at hne ha hb + all_goals + clear * - hcAB ha hb + tauto + +private theorem triple_sectors : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (∀ (U : ProtoTile), ∀ (z : + GaussianInt), (z ∈ BoundaryFootprintVertices U) → (z ∈ FootprintVertices U)) → (∀ (x + : GaussianInt), (LatticeTile cert.O) → ( + let F : Fin 3 → ProtoTile := + ![TileCellComplement (cert.P 0 true) cert.O, + TileCellComplement (cert.P 0 false) cert.O, cert.O] + ∀ (Q : ProtoTile), ∀ (S : ProtoTile), (LatticeTile Q) → ((LatticeTile S) → + ((TouchingTriple Q S cert.O) → ((Q.cells ⊆ (F 0).cells) → ((S.cells ⊆ (F 1).cells) → + ((x ∈ BoundaryFootprintVertices Q ∧ + x ∈ BoundaryFootprintVertices S ∧ x ∈ BoundaryFootprintVertices cert.O) → ((∀ j : Fin + 4, LatticeVertexIncidentCell x j ∈ (F 0).cells ∨ LatticeVertexIncidentCell x j ∈ + (F 1).cells ∨ LatticeVertexIncidentCell x j ∈ (F 2).cells) ∧ (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (F 0).cells) ∧ (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (F 1).cells) ∧ (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (F 2).cells))))))))) ) := by + classical + intro C q cfg T cert boundary_foot x hOlat F Q S hQ hS ht hQc hSc htrans + as_aux_lemma => + have hxraw : x ∈ FootprintVertices Q ∩ FootprintVertices S ∩ FootprintVertices cert.O := + ⟨⟨boundary_foot Q x htrans.1, boundary_foot S x htrans.2.1⟩, + boundary_foot cert.O x htrans.2.2⟩ + obtain ⟨hc, hq, hs, ho, _⟩ := + LocalLatticeInterfaceSectors.1 Q S cert.O x hQ hS hOlat ht hxraw + refine ⟨?_, ?_, ?_, ho⟩ + · intro j + rcases hc j with h | h | h + · exact Or.inl (hQc h) + · exact Or.inr (Or.inl (hSc h)) + · exact Or.inr (Or.inr h) + · obtain ⟨j, hj⟩ := hq + exact ⟨j, hQc hj⟩ + · obtain ⟨j, hj⟩ := hs + exact ⟨j, hSc hj⟩ + +private theorem hsectors : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (∀ (i : Fin 3), ∀ (s : Bool), (i = 1 + ∨ i = 2) → (LatticeTile (cert.Q i s))) → ((∀ (i : Fin 3), ∀ (s : Bool), (i = 1 ∨ i = + 2) → (LatticeTile (cert.S i s))) → (∀ (x : GaussianInt), (x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ( + let F : Fin 3 → ProtoTile := + ![TileCellComplement (cert.P 0 true) cert.O, + TileCellComplement (cert.P 0 false) cert.O, cert.O] + (∀ (Q : ProtoTile), ∀ (S : ProtoTile), (LatticeTile Q) → ((LatticeTile S) → + ((TouchingTriple Q S cert.O) → ((Q.cells ⊆ (F 0).cells) → ((S.cells ⊆ (F 1).cells) → + ((x ∈ BoundaryFootprintVertices Q ∧ x ∈ BoundaryFootprintVertices S ∧ x ∈ + BoundaryFootprintVertices cert.O) → ((∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ (F + 0).cells ∨ LatticeVertexIncidentCell x j ∈ (F 1).cells ∨ LatticeVertexIncidentCell x + j ∈ (F 2).cells) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (F 0).cells) ∧ (∃ j + : Fin 4, LatticeVertexIncidentCell x j ∈ (F 1).cells) ∧ (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (F 2).cells)))))))) → ((∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (F 0).cells ∨ LatticeVertexIncidentCell x j ∈ (F + 1).cells ∨ LatticeVertexIncidentCell x j ∈ (F 2).cells) ∧ (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (F 0).cells) ∧ (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (F 1).cells) ∧ (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (F 2).cells))))) ) := by + classical + intro C q cfg T cert Q_lattice S_lattice x hxR F triple_sectors + rcases Finset.mem_insert.mp hxR with ha | hb + · exact triple_sectors (cert.Q 1 true) (cert.S 2 false) + (Q_lattice 1 true (Or.inl rfl)) (S_lattice 2 false (Or.inr rfl)) + cert.precursor_boundary.first_touching + cert.precursor_boundary.first_plus_child cert.precursor_boundary.first_minus_child + ((cert.precursor_boundary.first_transition x).mpr ha) + · exact triple_sectors (cert.Q 2 true) (cert.S 1 false) + (Q_lattice 2 true (Or.inr rfl)) (S_lattice 1 false (Or.inl rfl)) + cert.precursor_boundary.second_touching + cert.precursor_boundary.second_plus_child cert.precursor_boundary.second_minus_child + ((cert.precursor_boundary.second_transition x).mpr (Finset.mem_singleton.mp hb)) + +private theorem hcoverAt811 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (cert.O.cells ⊆ (cert.P 0 + true).cells) → (∀ (x : GaussianInt), + let F : Fin 3 → ProtoTile := + ![TileCellComplement (cert.P 0 true) cert.O, + TileCellComplement (cert.P 0 false) cert.O, cert.O] + ((∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ (F 0).cells ∨ LatticeVertexIncidentCell x + j ∈ (F 1).cells ∨ LatticeVertexIncidentCell x j ∈ (F 2).cells) ∧ (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (F 0).cells) ∧ (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (F 1).cells) ∧ (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (F 2).cells)) → (∀ (j : Fin 4), + LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ LatticeVertexIncidentCell x j + ∈ (cert.P 0 false).cells)) ) := by + classical + intro C q cfg T cert hOA x F hsectors j + rcases hsectors.1 j with h | h | h + · exact Or.inl (Finset.mem_sdiff.mp h).1 + · exact Or.inr (Finset.mem_sdiff.mp h).1 + · exact Or.inl (hOA h) + +private theorem hsurjAt823 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), + let F : Fin 3 → ProtoTile := + ![TileCellComplement (cert.P 0 true) cert.O, + TileCellComplement (cert.P 0 false) cert.O, cert.O] + ((∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ (F 0).cells ∨ LatticeVertexIncidentCell x + j ∈ (F 1).cells ∨ LatticeVertexIncidentCell x j ∈ (F 2).cells) ∧ (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (F 0).cells) ∧ (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (F 1).cells) ∧ (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (F 2).cells)) → (∀ (owner : Fin (4 : ℕ) → Fin (3 : + ℕ)), (∀ (j : Fin (4 : ℕ)), ∀ (a : Fin (3 : ℕ)), LatticeVertexIncidentCell x j ∈ (F + a).cells ↔ owner j = a) → (Function.Surjective owner)) ) := by + classical + intro C q cfg T cert x F hsectors owner hown a + fin_cases a + · obtain ⟨j, hj⟩ := hsectors.2.1 + exact ⟨j, (hown j 0).mp hj⟩ + · obtain ⟨j, hj⟩ := hsectors.2.2.1 + exact ⟨j, (hown j 1).mp hj⟩ + · obtain ⟨j, hj⟩ := hsectors.2.2.2 + exact ⟨j, (hown j 2).mp hj⟩ + +private theorem hmemA : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (cert.O.cells ⊆ (cert.P 0 + true).cells) → (∀ (x : GaussianInt), + let F : Fin 3 → ProtoTile := + ![TileCellComplement (cert.P 0 true) cert.O, + TileCellComplement (cert.P 0 false) cert.O, cert.O] + ∀ (owner : Fin (4 : ℕ) → Fin (3 : ℕ)), (∀ (j : Fin (4 : ℕ)), ∀ (a : Fin (3 : ℕ)), + LatticeVertexIncidentCell x j ∈ (F a).cells ↔ owner j = a) → (∀ (j : Fin 4), + LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ↔ owner j = 0 ∨ owner j = 2)) ) + := by + classical + intro C q cfg T cert hOA x F owner hown j + constructor + · intro hj + by_cases ho : LatticeVertexIncidentCell x j ∈ cert.O.cells + · exact Or.inr ((hown j 2).mp ho) + · exact Or.inl ((hown j 0).mp (Finset.mem_sdiff.mpr ⟨hj, ho⟩)) + · rintro (h | h) + · exact (Finset.mem_sdiff.mp ((hown j 0).mpr h)).1 + · exact hOA ((hown j 2).mpr h) + +private theorem hmemB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (cert.O.cells ⊆ (cert.P 0 + false).cells) → (∀ (x : GaussianInt), + let F : Fin 3 → ProtoTile := + ![TileCellComplement (cert.P 0 true) cert.O, + TileCellComplement (cert.P 0 false) cert.O, cert.O] + ∀ (owner : Fin (4 : ℕ) → Fin (3 : ℕ)), (∀ (j : Fin (4 : ℕ)), ∀ (a : Fin (3 : ℕ)), + LatticeVertexIncidentCell x j ∈ (F a).cells ↔ owner j = a) → (∀ (j : Fin 4), + LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells ↔ owner j = 1 ∨ owner j = 2)) + ) := by + classical + intro C q cfg T cert hOB x F owner hown j + constructor + · intro hj + by_cases ho : LatticeVertexIncidentCell x j ∈ cert.O.cells + · exact Or.inr ((hown j 2).mp ho) + · exact Or.inl ((hown j 1).mp (Finset.mem_sdiff.mpr ⟨hj, ho⟩)) + · rintro (h | h) + · exact (Finset.mem_sdiff.mp ((hown j 1).mpr h)).1 + · exact hOB ((hown j 2).mpr h) + +private theorem hcommonAt854 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), ((∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ LatticeVertexIncidentCell x j + ∈ (cert.P 0 false).cells) → (∀ (j : Fin 4), (∃ i s, LatticeVertexIncidentCell x j ∈ + (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells) ↔ + (LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∧ LatticeVertexIncidentCell x + (j + 1) ∈ (cert.P 0 true).cells) ∨ (LatticeVertexIncidentCell x j ∈ (cert.P 0 + false).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P 0 false).cells))) → ((∀ + (j : Fin 4), LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ + LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells) → (∀ (owner : Fin (4 : ℕ) → + Fin (3 : ℕ)), (∀ (j : Fin 4), LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ↔ + owner j = 0 ∨ owner j = 2) → ((∀ (j : Fin 4), LatticeVertexIncidentCell x j ∈ (cert.P + 0 false).cells ↔ owner j = 1 ∨ owner j = 2) → (∀ (j : Fin 4), (∃ i s, + LatticeVertexIncidentCell x j ∈ (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + + 1) ∈ (cert.P i s).cells) ↔ owner j = owner (j + 1) ∨ owner j = 2 ∨ owner (j + 1) = + 2)))) ) := by + classical + intro C q cfg T cert x common_parent_iff hcover owner hmemA hmemB j + rw [common_parent_iff hcover j, hmemA, hmemA, hmemB, hmemB] + have hf : ∀ a b : Fin 3, + (((a = 0 ∨ a = 2) ∧ (b = 0 ∨ b = 2)) ∨ + ((a = 1 ∨ a = 2) ∧ (b = 1 ∨ b = 2))) ↔ + a = b ∨ a = 2 ∨ b = 2 := by decide +kernel + exact hf _ _ + +private theorem hsetAt865 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), ∀ (owner : Fin + (4 : ℕ) → Fin (3 : ℕ)), (∀ (j : Fin 4), (∃ i s, LatticeVertexIncidentCell x j ∈ + (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells) ↔ + owner j = owner (j + 1) ∨ owner j = 2 ∨ owner (j + 1) = 2) → ((Finset.univ.filter fun + j : Fin 4 => ∃ i s, LatticeVertexIncidentCell x j ∈ (cert.P i s).cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells) = Finset.univ.filter (fun j + : Fin 4 => owner j = owner (j + 1) ∨ owner j = 2 ∨ owner (j + 1) = 2)) ) := by + classical + intro C q cfg T cert x owner hcommon + ext j + simp only [Finset.mem_filter, Finset.mem_univ, true_and, hcommon j] + +private theorem finite_countAt873 : + (by + classical + exact + ∀ owner : Fin 4 → Fin 3, (¬ (owner 0 = owner 2 ∧ owner 1 ≠ owner 0 ∧ owner 3 ≠ owner 0) ∧ + ¬ (owner 1 = owner 3 ∧ owner 0 ≠ owner 1 ∧ owner 2 ≠ owner 1)) → Function.Surjective + owner → (Finset.univ.filter (fun j : Fin 4 => owner j = owner (j + 1) ∨ owner j = 2 ∨ + owner (j + 1) = 2)).card = 3 ) := by + classical + decide +kernel + +end InterfaceNeighborGeometry + +namespace InterfaceNeighborConclusion + +private theorem rootNeighborCount : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : + Finset GaussianInt), (∀ x ∈ D \ P, x ∈ FootprintVertices cert.O ↔ x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((∀ + (U : ProtoTile), ∀ (z : + GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell z j ∈ U.cells) → (z ∈ + FootprintVertices U)) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ (z : + GaussianInt), (z ∈ FootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell z j + ∈ U.cells))) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ + BoundaryFootprintVertices U) → (z ∈ FootprintVertices U)) → ((cert.O.cells ⊆ (cert.P + 0 true).cells) → ((cert.O.cells ⊆ (cert.P 0 false).cells) → (((cert.P 0 true).cells ∩ + (cert.P 0 false).cells = cert.O.cells) → ((∀ (c : CircleCoordinates), (∃ r : Fin 4 → + CircleCoordinates, SemiProperQuadruple r ∧ ∃ i, r i = c) → (∀ (U : ProtoTile), + (BandPrototile c U) → ((0 < c.1 ∨ U.cells.Nonempty) → (LatticeTile U)))) → ((∀ (i : + Fin 3), ∀ (s : Bool), (i = 1 ∨ i = 2) → (LatticeTile (cert.Q i s))) → ((∀ (i : Fin + 3), ∀ (s : Bool), (i = 1 ∨ i = 2) → (LatticeTile (cert.S i s))) → (∀ (x : + GaussianInt), (x ∈ D \ P) → ((∀ {α : Type}, ∀ (F : α → ProtoTile), (∀ a, LatticeTile + (F a)) → (∀ (owner : Fin 4 → α), (∀ j, ∀ a, LatticeVertexIncidentCell x j ∈ (F + a).cells ↔ owner j = a) → (¬ (owner 0 = owner 2 ∧ owner 1 ≠ owner 0 ∧ owner 3 ≠ owner + 0) ∧ ¬ (owner 1 = owner 3 ∧ owner 0 ≠ owner 1 ∧ owner 2 ≠ owner 1)))) → ((∀ + {α : Type}, ∀ (F : α → ProtoTile), (∀ a, ∀ b, a ≠ b → Disjoint (F a).cells (F + b).cells) → ((∀ j : Fin 4, ∃ a, LatticeVertexIncidentCell x j ∈ (F a).cells) → (∃ + owner : Fin 4 → α, ∀ j, ∀ a, LatticeVertexIncidentCell x j ∈ (F a).cells ↔ owner j = + a))) → (((∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ + LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells) → (∀ (j : Fin 4), (∃ i s, + LatticeVertexIncidentCell x j ∈ (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + + 1) ∈ (cert.P i s).cells) ↔ (LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ (cert.P 0 true).cells) ∨ + (LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells ∧ LatticeVertexIncidentCell x + (j + 1) ∈ (cert.P 0 false).cells))) → (((P.filter fun y => @decide + (FourNeighborAdjacent y x) (Classical.propDecidable _)).card = (Finset.univ.filter + fun j : Fin 4 => ∃ i s, LatticeVertexIncidentCell x j ∈ (cert.P i s).cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells).card) → ((x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → + ((P.filter fun y => @decide + (FourNeighborAdjacent y x) (Classical.propDecidable _)).card = if cert.O.cells = ∅ + then 2 else 3)))))))))))))))) ) := by + classical + intro C q cfg T cert D P hprecursor incident_foot foot_incident boundary_foot hOA hOB hAB + prototile_disk Q_lattice S_lattice x hx no_diagonal label_sectors common_parent_iff + neighbor_count hxR + by_cases hempty : cert.O.cells = ∅ + · rw [ite_eq_left hempty, neighbor_count] + have hbranch := cert.precursor_boundary.branch + rcases hbranch with ⟨hne, _⟩ | hbranch + · exact (Finset.nonempty_iff_ne_empty.mp hne hempty).elim + have hxa : x = cert.precursor_boundary.a := by + simpa [hbranch.2.1] using hxR + have htransition := (cert.precursor_boundary.first_transition x).mpr hxa + have hQlat := Q_lattice 1 true (Or.inl rfl) + have hSlat := S_lattice 2 false (Or.inr rfl) + obtain ⟨jA, hjA⟩ := foot_incident _ (LatticeTileGridStructure _ hQlat).1.1 x + (boundary_foot _ x htransition.1) + obtain ⟨jB, hjB⟩ := foot_incident _ (LatticeTileGridStructure _ hSlat).1.1 x + (boundary_foot _ x htransition.2.1) + have hA : LatticeVertexIncidentCell x jA ∈ (cert.P 0 true).cells := + (Finset.mem_sdiff.mp (cert.precursor_boundary.first_plus_child hjA)).1 + have hB : LatticeVertexIncidentCell x jB ∈ (cert.P 0 false).cells := + (Finset.mem_sdiff.mp (cert.precursor_boundary.first_minus_child hjB)).1 + have hzero (U : ProtoTile) : TileTranslation U 0 = U := + InterfaceNeighborGeometry.hzeroAt680 U + have hcover (j : Fin 4) : + LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ + LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells := + InterfaceNeighborGeometry.hcoverAt684 C q cfg T cert D P hprecursor + incident_foot x hx hxR hzero j + let F : Fin 2 → ProtoTile := ![cert.P 0 true, cert.P 0 false] + have hFlat (a : Fin 2) : LatticeTile (F a) := by + fin_cases a <;> exact cert.parent_lattice _ _ + have hFd (a b : Fin 2) (hne : a ≠ b) : Disjoint (F a).cells (F b).cells := + InterfaceNeighborGeometry.hFdAt697 C q cfg T cert hAB hempty a b hne + obtain ⟨owner, hown⟩ := label_sectors F hFd (fun j => by + rcases hcover j with h | h + · exact ⟨0, h⟩ + · exact ⟨1, h⟩) + have hsurj : Function.Surjective owner := InterfaceNeighborGeometry.hsurjAt709 C q cfg T + cert x jA jB hA hB owner hown + have hcommon (j : Fin 4) : + (∃ i s, LatticeVertexIncidentCell x j ∈ (cert.P i s).cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells) ↔ + owner j = owner (j + 1) := InterfaceNeighborGeometry.hcommonAt714 C q cfg T cert x + common_parent_iff hcover owner hown j + have hset : (Finset.univ.filter fun j : Fin 4 => ∃ i s, + LatticeVertexIncidentCell x j ∈ (cert.P i s).cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells) = + Finset.univ.filter (fun j : Fin 4 => owner j = owner (j + 1)) := + InterfaceNeighborGeometry.hsetAt727 C q cfg T cert x owner hcommon + rw [hset] + have finite_count : ∀ owner : Fin 4 → Fin 2, + (¬ (owner 0 = owner 2 ∧ owner 1 ≠ owner 0 ∧ owner 3 ≠ owner 0) ∧ + ¬ (owner 1 = owner 3 ∧ owner 0 ≠ owner 1 ∧ owner 2 ≠ owner 1)) → + Function.Surjective owner → + (Finset.univ.filter (fun j : Fin 4 => owner j = owner (j + 1))).card = 2 := + InterfaceNeighborGeometry.finite_countAt734 + exact finite_count owner (no_diagonal F hFlat owner hown) hsurj + · rw [ite_eq_right hempty] + have hOne : cert.O.cells.Nonempty := Finset.nonempty_iff_ne_empty.mpr hempty + have hOlat : LatticeTile cert.O := InterfaceNeighborGeometry.hOlat C q cfg T cert + prototile_disk hOne + let F : Fin 3 → ProtoTile := + ![TileCellComplement (cert.P 0 true) cert.O, + TileCellComplement (cert.P 0 false) cert.O, cert.O] + have hFlat (a : Fin 3) : LatticeTile (F a) := InterfaceNeighborGeometry.hFlatAt752 C q + cfg T cert hOlat a + have hFd (a b : Fin 3) (hne : a ≠ b) : Disjoint (F a).cells (F b).cells := + InterfaceNeighborGeometry.hFdAt757 C q cfg T cert hAB a b hne + have triple_sectors (Q S : ProtoTile) (hQ : LatticeTile Q) (hS : LatticeTile S) + (ht : TouchingTriple Q S cert.O) + (hQc : Q.cells ⊆ (F 0).cells) (hSc : S.cells ⊆ (F 1).cells) + (htrans : x ∈ BoundaryFootprintVertices Q ∧ + x ∈ BoundaryFootprintVertices S ∧ x ∈ BoundaryFootprintVertices cert.O) : + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ (F 0).cells ∨ + LatticeVertexIncidentCell x j ∈ (F 1).cells ∨ + LatticeVertexIncidentCell x j ∈ (F 2).cells) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (F 0).cells) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (F 1).cells) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (F 2).cells) := + InterfaceNeighborGeometry.triple_sectors C q cfg T cert boundary_foot x hOlat Q S + hQ hS ht hQc hSc htrans + have hsectors : + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ (F 0).cells ∨ + LatticeVertexIncidentCell x j ∈ (F 1).cells ∨ + LatticeVertexIncidentCell x j ∈ (F 2).cells) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (F 0).cells) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (F 1).cells) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (F 2).cells) := + InterfaceNeighborGeometry.hsectors C q cfg T cert Q_lattice S_lattice x hxR + triple_sectors + have hcover (j : Fin 4) : + LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ + LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells := + InterfaceNeighborGeometry.hcoverAt811 C q cfg T cert hOA x hsectors j + obtain ⟨owner, hown⟩ := label_sectors F hFd (fun j => by + rcases hsectors.1 j with h | h | h + · exact ⟨0, h⟩ + · exact ⟨1, h⟩ + · exact ⟨2, h⟩) + have hsurj : Function.Surjective owner := InterfaceNeighborGeometry.hsurjAt823 C q cfg T + cert x hsectors owner hown + have hmemA (j : Fin 4) : + LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ↔ + owner j = 0 ∨ owner j = 2 := InterfaceNeighborGeometry.hmemA C q cfg T cert hOA x + owner hown j + have hmemB (j : Fin 4) : + LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells ↔ + owner j = 1 ∨ owner j = 2 := InterfaceNeighborGeometry.hmemB C q cfg T cert hOB x + owner hown j + have hcommon (j : Fin 4) : + (∃ i s, LatticeVertexIncidentCell x j ∈ (cert.P i s).cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells) ↔ + owner j = owner (j + 1) ∨ owner j = 2 ∨ owner (j + 1) = 2 := + InterfaceNeighborGeometry.hcommonAt854 C q cfg T cert x common_parent_iff + hcover owner hmemA hmemB j + rw [neighbor_count] + have hset : (Finset.univ.filter fun j : Fin 4 => ∃ i s, + LatticeVertexIncidentCell x j ∈ (cert.P i s).cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells) = + Finset.univ.filter (fun j : Fin 4 => + owner j = owner (j + 1) ∨ owner j = 2 ∨ owner (j + 1) = 2) := + InterfaceNeighborGeometry.hsetAt865 C q cfg T cert x owner hcommon + rw [hset] + have finite_count : ∀ owner : Fin 4 → Fin 3, + (¬ (owner 0 = owner 2 ∧ owner 1 ≠ owner 0 ∧ owner 3 ≠ owner 0) ∧ + ¬ (owner 1 = owner 3 ∧ owner 0 ≠ owner 1 ∧ owner 2 ≠ owner 1)) → + Function.Surjective owner → + (Finset.univ.filter (fun j : Fin 4 => + owner j = owner (j + 1) ∨ owner j = 2 ∨ owner (j + 1) = 2)).card = 3 := + InterfaceNeighborGeometry.finite_countAt873 + exact finite_count owner (no_diagonal F hFlat owner hown) hsurj + +end InterfaceNeighborConclusion + +theorem P4250T2InterfaceNeighborCount : + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (BandPrototile (q 0) T) → ((LatticeTile + T) → (∀ (D : Finset GaussianInt), ∀ (P : Finset GaussianInt), (∀ x, x ∈ D ↔ + x ∈ FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T) → ((∀ x, x ∈ P ↔ x ∈ D ∧ ∃ i s, + x ∈ FootprintVertices (cert.P i s) ∧ + x ∉ BoundaryFootprintVertices (cert.P i s)) → ((∀ x ∈ D \ P, + x ∈ FootprintVertices cert.O ↔ + x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((∀ + x ∈ D \ P, + Nat.card {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2 → + GaussianRealPoint x = TileCentroid T → + x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ( + let W := D \ P + let R : Finset GaussianInt := {cert.precursor_boundary.a, cert.precursor_boundary.b} + ∀ x ∈ W, + let k := Nat.card {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} + let n := (P.filter fun y => @decide (FourNeighborAdjacent y x) + (Classical.propDecidable _)).card + (x ∉ R → n + k = 4 ∧ (k = 2 ∨ k = 3) ∧ + GaussianRealPoint x ≠ TileCentroid T) ∧ + (x ∈ R → n = if cert.O.cells = ∅ then 2 else 3))))))) := by + intro C q cfg T cert hT hlat D P hD hP hprecursor hcentral +-- BODY + classical + exact (by + have incident_foot := InterfaceNeighborGeometry.incident_foot + have foot_incident := InterfaceNeighborGeometry.foot_incident + have full_iff := InterfaceNeighborGeometry.full_iff incident_foot foot_incident + have boundary_foot := InterfaceNeighborGeometry.boundary_foot incident_foot + have hOA := InterfaceNeighborGeometry.hOA C q cfg T cert + have hOB := InterfaceNeighborGeometry.hOB C q cfg T cert + have hsep := BandOriginalPairSeparation cert.P cert.O cert.u cert.v hOA hOB cert.partition + have hAB := InterfaceNeighborGeometry.hAB C q cfg T cert hsep + let parentLabel (a : Fin 3 × Bool) : SixSubtileLabel := + match a.1.val, a.2 with + | 0, true => .A + | 0, false => .B + | 1, true => .C + | 1, false => .D + | 2, true => .E + | _, _ => .F + let parentIndex (a : Fin 3 × Bool) : PeriodicSubtileIndex := ⟨parentLabel a, 0, 0⟩ + have parent_disjoint := InterfaceNeighborGeometry.parent_disjoint C q cfg T cert hsep + (InterfaceNeighborGeometry.parentLabel_injective) + (InterfaceNeighborGeometry.parentOccurrence C q cfg T cert) + have hchildPos := InterfaceNeighborGeometry.hchildPos q cfg + have parent_regular (i : Fin 3) (s : Bool) : + ∀ a b, FourNeighborAdjacent a b → + a ∈ BoundaryFootprintVertices (cert.P i s) → + b ∈ BoundaryFootprintVertices (cert.P i s) → + ¬ OpenLatticeEdge a b ⊆ interior (TileRealization (cert.P i s)) := + (LatticeEdgeRegularity + (⟨⟨q i.succ, Or.inl (hchildPos i), q, cfg.proper.1, i.succ, rfl⟩, + hchildPos i⟩ : BandCircle) + (cert.P i s) (cert.outer_occurrence i s).1 (cert.parent_lattice i s)).1 + have prototile_disk := InterfaceNeighborGeometry.prototile_disk + have retained_pos := InterfaceNeighborGeometry.retained_pos q cfg hchildPos + have Q_lattice (i : Fin 3) (s : Bool) (hi : i = 1 ∨ i = 2) : + LatticeTile (cert.Q i s) := + prototile_disk _ ⟨cfg.firstPredecessor, cfg.firstProper.1, i.succ, rfl⟩ _ + (cert.plus_occurrence i s).1 (Or.inl (retained_pos i hi)) + have S_lattice (i : Fin 3) (s : Bool) (hi : i = 1 ∨ i = 2) : + LatticeTile (cert.S i s) := + prototile_disk _ ⟨cfg.firstPredecessor, cfg.firstProper.1, i.succ, rfl⟩ _ + (cert.minus_occurrence i s).1 (Or.inl (retained_pos i hi)) + dsimp only + intro x hx + have hxD := (Finset.mem_sdiff.mp hx).1 + have hxP := (Finset.mem_sdiff.mp hx).2 + have hxT := (hD x).mp hxD + have hcells := (full_iff T x).mp hxT + have no_parent_interior := InterfaceNeighborGeometry.no_parent_interior C q cfg T cert D P hP + x hxD hxP + have no_diagonal {α : Type} (F : α → ProtoTile) (hF : ∀ a, LatticeTile (F a)) + (owner : Fin 4 → α) + (hown : ∀ j a, LatticeVertexIncidentCell x j ∈ (F a).cells ↔ owner j = a) := + InterfaceNeighborGeometry.no_diagonal x (α := α) F hF owner hown + have label_sectors {α : Type} (F : α → ProtoTile) + (hd : ∀ a b, a ≠ b → Disjoint (F a).cells (F b).cells) + (hcover : ∀ j : Fin 4, ∃ a, LatticeVertexIncidentCell x j ∈ (F a).cells) := + InterfaceNeighborGeometry.label_sectors x (α := α) F hd hcover + have common_parent_iff := InterfaceNeighborGeometry.common_parent_iff C q cfg T cert + parent_disjoint x + let neighbor : Fin 4 → GaussianInt := ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + have shared_cells := InterfaceNeighborGeometry.shared_cells x + -- Each edge is counted precisely when its two incident cells share a parent. + have neighbor_bridge := InterfaceNeighborGeometry.neighbor_bridge C q cfg T cert D P hD hP + incident_foot full_iff (InterfaceNeighborGeometry.edge_endpoint + (InterfaceNeighborGeometry.horizontal_interior) + (InterfaceNeighborGeometry.vertical_interior)) parent_regular x no_parent_interior + shared_cells + have neighbor_injective := InterfaceNeighborGeometry.neighbor_injective x + have neighbor_adjacent (j : Fin 4) : FourNeighborAdjacent (neighbor j) x := by + fin_cases j <;> simp [neighbor, FourNeighborAdjacent] + have neighbor_count := InterfaceNeighborGeometry.neighbor_count C q cfg T cert P x + neighbor_bridge + neighbor_injective neighbor_adjacent (InterfaceNeighborGeometry.neighbor_exhaust C + q cfg T cert D P x hx hxD hxP hxT hcells no_parent_interior no_diagonal + label_sectors common_parent_iff shared_cells neighbor_bridge neighbor_injective + neighbor_adjacent) + constructor + · intro hnotR + have owner_exists := InterfaceNeighborGeometry.owner_exists C q cfg T cert x hcells + let owner (j : Fin 4) : Fin 3 × Bool := Classical.choose (owner_exists j) + have owner_spec (j : Fin 4) : + LatticeVertexIncidentCell x j ∈ (cert.P (owner j).1 (owner j).2).cells := + Classical.choose_spec (owner_exists j) + have owner_iff := InterfaceNeighborGeometry.owner_iff C q cfg T cert + (InterfaceNeighborGeometry.parent_unique C q cfg T cert hAB parent_disjoint) x + (InterfaceNeighborGeometry.hnoO C q cfg T cert D P hprecursor incident_foot x hx hnotR) + owner_exists owner_spec + have hdiag := no_diagonal (fun a : Fin 3 × Bool => cert.P a.1 a.2) + (fun a => cert.parent_lattice a.1 a.2) owner owner_iff + have hcard : Nat.card {a : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} = + (Finset.univ.image owner).card := InterfaceNeighborGeometry.hcard C q cfg T cert x + owner_exists (InterfaceNeighborGeometry.hboundary C q cfg T cert incident_foot + foot_incident boundary_foot x no_parent_interior owner_exists owner_spec owner_iff) + have hnot_constant := InterfaceNeighborGeometry.hnot_constant C q cfg T cert D P hP + full_iff x hxD hxP owner_exists owner_iff + have hncount : (P.filter fun y => @decide (FourNeighborAdjacent y x) + (Classical.propDecidable _)).card = + (Finset.univ.filter (fun j : Fin 4 => owner j = owner (j + 1))).card := + InterfaceNeighborGeometry.hncount C q cfg T cert P x neighbor_count owner_exists + owner_spec owner_iff + have hclass := BandOrderedGeneralInteriorStarClassification q cfg C T cert hlat x hxT.1 hxT.2 + have hsum := (InterfaceNeighborGeometry.finite_countAt614) owner hdiag hnot_constant + have hhigh : (Finset.univ.image owner).card ≤ 4 := by + exact (Finset.card_image_le).trans (by simp) + have hk23 := InterfaceNeighborGeometry.hk23 C q cfg T cert P x neighbor_count owner_exists + hcard hncount hclass hsum (InterfaceNeighborGeometry.hlow C q cfg T cert x owner_exists + hnot_constant) + refine ⟨?_, hk23, ?_⟩ + · rw [hncount, hcard] + exact hsum + · intro hc + rcases hk23 with hk | hk + · exact hnotR (hcentral x hx hk hc) + · exact (hclass.2.1 hk).2 hc + · intro hxR + exact (InterfaceNeighborConclusion.rootNeighborCount C q cfg T cert D P hprecursor + incident_foot foot_incident boundary_foot hOA hOB hAB prototile_disk Q_lattice + S_lattice x hx no_diagonal label_sectors common_parent_iff neighbor_count hxR)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2PrecursorRootSeparation.lean b/LeanPool/ApollonianSuperharmonic/P4250T2PrecursorRootSeparation.lean new file mode 100644 index 0000000000..0d1f715d2b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4250T2PrecursorRootSeparation.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorStarClassification +public import LeanPool.ApollonianSuperharmonic.P4339T1EmptyPrecursorRoots +public import LeanPool.ApollonianSuperharmonic.P4339T1PositivePrecursorRoots +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorArcSeparation + +-- [TABLET NODE: P4250T2PrecursorRootSeparation] + +/-! +# P4250T2PrecursorRootSeparation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4250T2PrecursorRootSeparation + (C : BandCircle) (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (hT : BandPrototile (q 0) T) (hlat : LatticeTile T) + (D P : Finset GaussianInt) + (hD : ∀ x, x ∈ D ↔ + x ∈ FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T) + (hP : ∀ x, x ∈ P ↔ x ∈ D ∧ ∃ i s, + x ∈ FootprintVertices (cert.P i s) ∧ + x ∉ BoundaryFootprintVertices (cert.P i s)) + (hattach : ∀ i s, ∃ e : Finset GaussianInt, + e ∈ BoundaryFootprintEdges (cert.P i s) ∧ + e ∈ BoundaryFootprintEdges T) : + let W := D \ P + let R : Finset GaussianInt := {cert.precursor_boundary.a, cert.precursor_boundary.b} + R ⊆ W ∧ + (∀ x ∈ W, x ∈ FootprintVertices cert.O ↔ x ∈ R) ∧ + (∀ x ∈ R, + Nat.card {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2 ∧ + (GaussianRealPoint x = TileCentroid T ↔ cert.O.cells = ∅)) ∧ + (∀ x ∈ W, + Nat.card {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2 → + GaussianRealPoint x = TileCentroid T → x ∈ R) ∧ + (∀ a ∈ R, ∀ b ∈ R, ∀ V E, + SimpleGridPathBetween V E a b → V ⊆ (W : Set GaussianInt) → a = b) := by +-- BODY + classical + dsimp only + have realPoint_injective : Function.Injective GaussianRealPoint := by + intro u v huv + apply Zsqrtd.ext + · have hr := congrArg Prod.fst huv + change (u.re : Real) = (v.re : Real) at hr + exact_mod_cast hr + · have hi := congrArg Prod.snd huv + change (u.im : Real) = (v.im : Real) at hi + exact_mod_cast hi + by_cases hO : cert.O.cells = ∅ + · obtain ⟨hRW, hroots, hcount⟩ := + P4339T1EmptyPrecursorRoots C q cfg T cert D P hD hP hO + refine ⟨hRW, hroots, ?_, ?_, ?_⟩ + · intro x hx + exact ⟨(hcount x hx).1, iff_of_true (hcount x hx).2 hO⟩ + · intro x _ _ hcentral + have ha : cert.precursor_boundary.a ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + Finset GaussianInt) := by simp + have hxa := realPoint_injective (hcentral.trans (hcount _ ha).2.symm) + simpa only [hxa] using ha + · intro a ha b hb V E _ _ + exact realPoint_injective ((hcount a ha).2.trans (hcount b hb).2.symm) + · have hnonempty : cert.O.cells.Nonempty := Finset.nonempty_iff_ne_empty.mpr hO + obtain ⟨hRW, hroots, hcount⟩ := + P4339T1PositivePrecursorRoots C q cfg T cert hlat D P hD hP hnonempty + refine ⟨hRW, hroots, ?_, ?_, ?_⟩ + · intro x hx + refine ⟨(hcount x hx).1, ?_⟩ + exact ⟨fun hc => ((hcount x hx).2 hc).elim, fun he => (hO he).elim⟩ + · intro x hx hk hcentral + have hxT := (hD x).mp (Finset.mem_sdiff.mp hx).1 + have hzero := (BandOrderedGeneralInteriorStarClassification + q cfg C T cert hlat x hxT.1 hxT.2).2.2.2 hk hcentral + have hsupport := P4339T1PrecursorSupportGeometry C q cfg T cert + exact (hO (hsupport.2.1.mpr hzero)).elim + · exact P4339T1PrecursorArcSeparation + C q cfg T cert hT hlat D P hD hP hattach hnonempty hroots + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean new file mode 100644 index 0000000000..3f474d8ea5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean @@ -0,0 +1,625 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer +public import LeanPool.ApollonianSuperharmonic.TileSubodometerLiteralDecompositionPiece +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P4261T1CentralCoordinates] + +/-! +# P4261T1CentralCoordinates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CentralCoordinateGeometry + +private theorem hcurv₀ : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), (BandOrderedGeneralLayoutCertificate q cfg C₀ T₀) → + (1 < C₀.1.1.1) ) := by + classical + intro q cfg C₀ T₀ cert + have h := cfg.childLarge + rw [cert.child_eq] at h + omega + +private theorem hvector : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : + PartialOdometer), ∀ (q' : Fin (4 : ℕ) → CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ + (hs : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs' : Fin (3 : ℕ) → Bool → + PartialOdometer), (q' i'.succ = C.1.1) → ((T.cells = (S' i' hs).cells) → (((↑h.domain + : Set GaussianInt) = (↑(hs' i' hs).domain : Set GaussianInt)) → ((∀ x ∈ h.domain, + h.value x = (hs' i' hs).value x) → (∀ (r : Fin (3 : ℕ)), (∀ (j : Fin (3 : ℕ)), q' + j.succ = q (j + r).succ) → ( + let j : Fin 3 := i' + r + (q' i'.succ = q j.succ) → (BandVectors.1 (q' ((i' + 2).succ)) (q' ((i' + 1).succ)) = + BandVectors.1 (q ((j + 2).succ)) (q ((j + 1).succ)))))))) ) := by + classical + intro q C T h q' i' hs S' hs' hq'i' hselectedCells hselectedDomain hselectedValue r hrotate j + hparent + rw [hrotate (i' + 2), hrotate (i' + 1)]; dsimp [j]; fin_cases r <;> fin_cases i' <;> rfl + +private theorem hsCent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T₀ : ProtoTile), ∀ (q' : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), TileCentroid (S' j t) - TileCentroid + T₀ = (if t = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q' (j + (2 : Fin (3 : ℕ))).succ) (q' (j + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint (BandVectors.1 (q' (j + (2 : Fin (3 : ℕ))).succ) (q' (j + (1 : + Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q' (j + (2 : Fin (3 : + ℕ))).succ) (q' (j + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (R : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (R i s) - TileCentroid + T₀ = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + (BandVectors.1 (q' ((i' + 2).succ)) (q' ((i' + 1).succ)) = BandVectors.1 (q ((j + + 2).succ)) (q ((j + 1).succ))) → (TileCentroid (S' i' hs) = TileCentroid (R j hs)))) ) + := by + classical + intro q T₀ q' i' hs S' hcent' R hrootCent r j hvector + calc + TileCentroid (S' i' hs) = + (TileCentroid (S' i' hs) - TileCentroid T₀) + TileCentroid T₀ := by abel + _ = (TileCentroid (R j hs) - TileCentroid T₀) + TileCentroid T₀ := by + rw [hcent' i' hs, hrootCent j hs, hvector] + _ = TileCentroid (R j hs) := by abel + +private theorem hbandSelected : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (q' : Fin (4 : ℕ) → CircleCoordinates), ∀ (i' : Fin + (3 : ℕ)), ∀ (hs : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs' : Fin (3 : + ℕ) → Bool → PartialOdometer), (∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), TileOdometer (q' + j.succ) (S' j t) (hs' j t)) → (∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + (q' i'.succ = q j.succ) → (BandPrototile (q j.succ) (S' i' hs))) ) := by + classical + intro q q' i' hs S' hs' hchild' r j hparent + rw [← hparent] + exact TileOdometerBandPrototile _ _ _ (hchild' i' hs) + +private theorem hlayoutCent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (R : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (R i s) - TileCentroid T₀ = (if s = + true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + (BandSubtileOccurrence q T₀ j hs (cert.P j hs)) → (TileCentroid (R j hs) = TileCentroid + (cert.P j hs))) ) := by + classical + intro q cfg C₀ T₀ cert i' hs R hrootCent r j hlayoutOcc + calc + TileCentroid (R j hs) = + (TileCentroid (R j hs) - TileCentroid T₀) + TileCentroid T₀ := by abel + _ = (TileCentroid (cert.P j hs) - TileCentroid T₀) + TileCentroid T₀ := by + rw [hrootCent j hs, hlayoutOcc.2.2] + _ = TileCentroid (cert.P j hs) := by abel + +private theorem hparentNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + (cert.P j hs).cells.Nonempty ) := by + classical + intro q cfg C₀ T₀ cert i' hs r j + rcases cert.parent_lattice j hs with ⟨e⟩ + have hball : (0 : ℝ × ℝ) ∈ Metric.closedBall (0 : ℝ × ℝ) 1 := by + simp + have hreal : (e ⟨(0 : ℝ × ℝ), hball⟩ : ℝ × ℝ) ∈ + TileRealization (cert.P j hs) := (e ⟨0, hball⟩).property + simp only [TileRealization, Set.mem_iUnion] at hreal + rcases hreal with ⟨x, hx, _⟩ + exact ⟨x, hx⟩ + +private theorem hselectedNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (T : ProtoTile), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (S' : Fin (3 : ℕ) → + Bool → ProtoTile), (T.cells = (S' i' hs).cells) → (∀ (R : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + ((S' i' hs).cells = (R j hs).cells) → (((R j hs).cells = (cert.P j hs).cells) → (((cert.P + j hs).cells.Nonempty) → (T.cells.Nonempty)))) ) := by + classical + intro q cfg C₀ T₀ cert T i' hs S' hselectedCells R r j hselectedCellsFresh hlayoutCells + hparentNonempty + rw [hselectedCells, hselectedCellsFresh, hlayoutCells] + exact hparentNonempty + +private theorem hcellsT : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (T : ProtoTile), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (S' : Fin (3 : ℕ) → + Bool → ProtoTile), (T.cells = (S' i' hs).cells) → (∀ (R : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + ((S' i' hs).cells = (R j hs).cells) → (((R j hs).cells = (cert.P j hs).cells) → (T.cells + = (cert.P j hs).cells))) ) := by + classical + intro q cfg C₀ T₀ cert T i' hs S' hselectedCells R r j hselectedCellsFresh hlayoutCells + calc + T.cells = (S' i' hs).cells := hselectedCells + _ = (R j hs).cells := hselectedCellsFresh + _ = (cert.P j hs).cells := hlayoutCells + +private theorem hfootT : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (T : ProtoTile), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + ((cert.P j hs).cells.Nonempty) → ((T.cells.Nonempty) → ((T.cells = (cert.P j hs).cells) → + (FootprintVertices T = FootprintVertices (cert.P j hs)))) ) := by + classical + intro q cfg C₀ T₀ cert T i' hs r j hparentNonempty hselectedNonempty hcellsT + simp only [FootprintVertices, ite_eq_left hselectedNonempty, ite_eq_left hparentNonempty] + rw [hcellsT] + +private theorem hchildPositive : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((BandCircle) → + (∀ (i' : Fin (3 : ℕ)), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + 0 < (q j.succ).1)) ) := by + classical + intro q cfg C₀ i' r j + have hnonneg := (ProperBandCurvatureStructure q cfg.proper).2.1 j + have hne := cfg.noLine j.succ + omega + +private theorem hdomainT : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (C : BandCircle), ∀ + (T : ProtoTile), ∀ (h : PartialOdometer), (TileSubodometer C₀.1.1 C.1.1 T₀ T h₀ h) → + ((h.domain : Set GaussianInt) = FootprintVertices T) ) := by + classical + intro C₀ T₀ h₀ C T h hsub + exact PositiveCurvatureTileOdometerDomain C.1.1 T h C.property + hsub.2.1 + +private theorem hdomainFresh : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (R : Fin (3 : + ℕ) → Bool → ProtoTile), ∀ (rH : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 + : ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (R i s) (rH i s)) → (∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + (0 < (q j.succ).1) → (((rH j hs).domain : Set GaussianInt) = FootprintVertices (R j hs))) + ) := by + classical + intro q i' hs R rH hrootChildren r j hchildPositive + exact PositiveCurvatureTileOdometerDomain (q j.succ) (R j hs) (rH j hs) + hchildPositive (hrootChildren j hs) + +private theorem hdomainSelected : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (q' : Fin (4 : ℕ) → CircleCoordinates), ∀ (i' : Fin + (3 : ℕ)), ∀ (hs : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs' : Fin (3 : + ℕ) → Bool → PartialOdometer), (∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), TileOdometer (q' + j.succ) (S' j t) (hs' j t)) → (∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + (q' i'.succ = q j.succ) → ((0 < (q j.succ).1) → (((hs' i' hs).domain : Set GaussianInt) = + FootprintVertices (S' i' hs)))) ) := by + classical + intro q q' i' hs S' hs' hchild' r j hparent hchildPositive + exact PositiveCurvatureTileOdometerDomain (q j.succ) (S' i' hs) (hs' i' hs) + hchildPositive (by rw [← hparent]; exact hchild' i' hs) + +private theorem hdomainSelFresh : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (hs' : Fin (3 : ℕ) → Bool → PartialOdometer), (T.cells = (S' i' + hs).cells) → (∀ (R : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (rH : Fin (3 : ℕ) → Bool → + PartialOdometer), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + ((S' i' hs).cells = (R j hs).cells) → ((T.cells.Nonempty) → ((((rH j hs).domain : Set + GaussianInt) = FootprintVertices (R j hs)) → ((((hs' i' hs).domain : Set GaussianInt) + = FootprintVertices (S' i' hs)) → (((hs' i' hs).domain : Set GaussianInt) = (rH j + hs).domain))))) ) := by + classical + intro T i' hs S' hs' hselectedCells R rH r j hselectedCellsFresh hselectedNonempty hdomainFresh + hdomainSelected + have hneSelected : (S' i' hs).cells.Nonempty := by + rw [← hselectedCells] + exact hselectedNonempty + have hneFresh : (R j hs).cells.Nonempty := by + rw [← hselectedCellsFresh] + exact hneSelected + rw [hdomainSelected, hdomainFresh] + simp only [FootprintVertices, ite_eq_left hneSelected, ite_eq_left hneFresh] + rw [hselectedCellsFresh] + +private theorem hdomainSuppliedFresh : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (hs' : Fin (3 : ℕ) → Bool + → PartialOdometer), ((↑h.domain : Set GaussianInt) = (↑(hs' i' hs).domain : Set + GaussianInt)) → (∀ (rH : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + (((hs' i' hs).domain : Set GaussianInt) = (rH j hs).domain) → ((h.domain : Set + GaussianInt) = (rH j hs).domain)) ) := by + classical + intro h i' hs hs' hselectedDomain rH r j hdomainSelFresh + calc + (h.domain : Set GaussianInt) = (hs' i' hs).domain := hselectedDomain + _ = (rH j hs).domain := hdomainSelFresh + +private theorem hvalueSuppliedFresh : + (by + classical + exact + ∀ (h₀ : PartialOdometer), ∀ (h : PartialOdometer), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ + (hs' : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), ∀ x + ∈ (hs' j t).domain, h₀.value x = (hs' j t).value x) → (((↑h.domain : Set GaussianInt) + = (↑(hs' i' hs).domain : Set GaussianInt)) → ((∀ x ∈ h.domain, h.value x = (hs' i' + hs).value x) → (∀ (rH : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), ∀ x ∈ (rH i s).domain, h₀.value x = (rH i s).value x) → (∀ (r : Fin (3 + : ℕ)), + let j : Fin 3 := i' + r + ((h.domain : Set GaussianInt) = (rH j hs).domain) → (∀ x, h.value x = (rH j hs).value + x))))) ) := by + classical + intro h₀ h i' hs hs' hvalue' hselectedDomain hselectedValue rH hrootValue r j + hdomainSuppliedFresh x + by_cases hx : x ∈ h.domain + · have hx' : x ∈ (hs' i' hs).domain := by + have hselDomFin : h.domain = (hs' i' hs).domain := + Finset.coe_injective hselectedDomain + rw [hselDomFin] at hx + exact hx + have hv₁ := hselectedValue x hx + have hv₂ := hvalue' i' hs x hx' + have hxFresh : x ∈ (rH j hs).domain := by + have hdomFin : h.domain = (rH j hs).domain := + Finset.coe_injective hdomainSuppliedFresh + rw [hdomFin] at hx + exact hx + have hv₃ := hrootValue j hs x hxFresh + exact hv₁.trans (hv₂.symm.trans hv₃) + · have hxFresh : x ∉ (rH j hs).domain := by + intro hxFresh + exact hx ((Set.ext_iff.mp hdomainSuppliedFresh x).mpr hxFresh) + rw [h.value_outside x hx, (rH j hs).value_outside x hxFresh] + +private theorem hfunEq : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (C : BandCircle), ∀ + (T : ProtoTile), ∀ (h : PartialOdometer), (TileSubodometer C₀.1.1 C.1.1 T₀ T h₀ h) → + (∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (hs' : Fin (3 : ℕ) → Bool → PartialOdometer), + ((↑h.domain : Set GaussianInt) = (↑(hs' i' hs).domain : Set GaussianInt)) → ((∀ x ∈ + h.domain, h.value x = (hs' i' hs).value x) → (∀ (rH : Fin (3 : ℕ) → Bool → + PartialOdometer), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + ((h.domain : Set GaussianInt) = FootprintVertices T) → (((h.domain : Set GaussianInt) = + (rH j hs).domain) → ((∀ x, h.value x = (rH j hs).value x) → (h = rH j hs)))))) ) := by + classical + intro C₀ T₀ h₀ C T h hsub i' hs hs' hselectedDomain hselectedValue rH r j hdomainT + hdomainSuppliedFresh hvalueSuppliedFresh + cases h with + | mk hd hv hout => + have hdomEq : hd = (rH j hs).domain := Finset.coe_injective hdomainSuppliedFresh + have hvalEq : hv = (rH j hs).value := funext hvalueSuppliedFresh + cases hdomEq + cases hvalEq + rfl + +private theorem centralLabel : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), + let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + ∀ (k : Fin 3), ∀ (t : Bool), ∃ l : SixSubtileLabel, slot l = (k, t) ∧ + SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨l, 0, 0⟩ = TileTranslation + (cert.P k t) 0 ) := by + classical + intro q cfg C₀ T₀ cert slot k t + fin_cases k <;> cases t + all_goals first + | refine ⟨.A, And.intro rfl ?_⟩ + | refine ⟨.B, And.intro rfl ?_⟩ + | refine ⟨.C, And.intro rfl ?_⟩ + | refine ⟨.D, And.intro rfl ?_⟩ + | refine ⟨.E, And.intro rfl ?_⟩ + | refine ⟨.F, And.intro rfl ?_⟩ + all_goals simp [SubtileOccurrenceInterpretation] + +private theorem hoccTile : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + ∀ (l : SixSubtileLabel), (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨l, (0 : + ℤ), (0 : ℤ)⟩ = TileTranslation (cert.P j hs) (0 : GaussianInt)) → ( + let b : PeriodicSubtileIndex := ⟨l, 0, 0⟩ + SubtileOccurrenceInterpretation cert.P cert.u cert.v b = cert.P j hs) ) := by + classical + intro q cfg C₀ T₀ cert i' hs r j l hocc b + rw [hocc] + cases cert.P j hs with + | mk cells anchor => + change ProtoTile.mk (cells.image (GaussianTranslation 0)) + (GaussianTranslation 0 anchor) = ProtoTile.mk cells anchor + congr 1 + · ext x + simp [GaussianTranslation] + · simp [GaussianTranslation] + +private theorem hoccCells : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + ∀ (l : SixSubtileLabel), + let b : PeriodicSubtileIndex := ⟨l, 0, 0⟩ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b = cert.P j hs) → + ((SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells = (cert.P j + hs).cells) ) := by + classical + intro q cfg C₀ T₀ cert i' hs r j l b hoccTile + rw [hoccTile] + +private theorem hoccCent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + ∀ (l : SixSubtileLabel), + let b : PeriodicSubtileIndex := ⟨l, 0, 0⟩ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b = cert.P j hs) → (TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) = TileCentroid (cert.P j + hs)) ) := by + classical + intro q cfg C₀ T₀ cert i' hs r j l b hoccTile + rw [hoccTile] + +private theorem hoccFoot : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + ∀ (l : SixSubtileLabel), + let b : PeriodicSubtileIndex := ⟨l, 0, 0⟩ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b = cert.P j hs) → + (FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) = + FootprintVertices (cert.P j hs)) ) := by + classical + intro q cfg C₀ T₀ cert i' hs r j l b hoccTile + rw [hoccTile] + +private theorem hslopeOffset : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + ∀ (p : ℝ × ℝ), ∀ (ps : ℝ × ℝ), (ps.1 - p.1 = (if hs = true then (1 : ℝ) else (-1 : ℝ)) * + (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (j + (2 : Fin (3 : ℕ))).succ) (q (j + (1 : Fin (3 + : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (j + (2 : Fin (3 : ℕ))).succ) (q (j + (1 + : Fin (3 : ℕ))).succ)).im : ℝ))) → ((ps.2 - p.2 = (if hs = true then (1 : ℝ) else (-1 + : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (j + (2 : Fin (3 : ℕ))).succ) (q (j + (1 : + Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (j + (2 : Fin (3 : ℕ))).succ) (q + (j + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (ps - p = (if hs = true then (1 : ℝ) else + -1) • P4250T1SlopeOffset (BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))))) ) + := by + classical + intro q i' hs r j p ps hpx hpy + apply Prod.ext + · change ps.1 - p.1 = (if hs = true then (1 : ℝ) else -1) * + ((((BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))).re : ℝ) - + ((BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))).im : ℝ)) / 2) + rw [hpx] + ring + · change ps.2 - p.2 = (if hs = true then (1 : ℝ) else -1) * + ((((BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))).im : ℝ) + + ((BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))).re : ℝ)) / 2) + rw [hpy] + ring + +end CentralCoordinateGeometry + +theorem P4261T1CentralCoordinates + {q : Fin 4 → CircleCoordinates} {cfg : BandOrderedGeneralConfiguration q} + {C₀ : BandCircle} {T₀ : ProtoTile} + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T₀) + (h₀ : PartialOdometer) (C : BandCircle) (T : ProtoTile) (h : PartialOdometer) + (hsub : TileSubodometer C₀.1.1 C.1.1 T₀ T h₀ h) : + ∃ b : PeriodicSubtileIndex, b.first = 0 ∧ b.second = 0 ∧ + Nonempty (P4261T1PlacedOdometer cert h₀ C T h b) := by +-- BODY + classical + have hroot : TileOdometer C₀.1.1 T₀ h₀ := hsub.1 + have hcurv₀ : 1 < C₀.1.1.1 := CentralCoordinateGeometry.hcurv₀ q cfg C₀ T₀ cert + obtain ⟨q', i', hs, S', hs', hq', hq'₀, hq'i', hband₀, + hchild', hcells', hfoot', hcent', hdom', hvalue', hcompat', hslope', + hselectedCells, hselectedDomain, hselectedValue⟩ := + TileSubodometerLiteralDecompositionPiece C₀ C T₀ T h₀ h + hcurv₀ hsub + obtain ⟨R, rH, hbandRoot, hrootChildren, hrootCells, hrootFoot, + hrootCent, hrootDomain, hrootValue, hrootCompat, hrootSlope⟩ := + TileOdometerReindexedDecomposition q cfg.proper T₀ h₀ + (by simpa [cert.child_eq] using hcurv₀) (by simpa [cert.child_eq] using hroot) + obtain ⟨r, hrotate, _⟩ := + BandPredecessorNoCollision q q' cfg.proper hq' + (by rw [cert.child_eq, hq'₀]) + let j : Fin 3 := i' + r + have hparent : q' i'.succ = q j.succ := by + simpa [j] using hrotate i' + have hvector := CentralCoordinateGeometry.hvector q C T h q' i' hs S' hs' hq'i' hselectedCells + hselectedDomain hselectedValue r hrotate hparent + have hsCent := CentralCoordinateGeometry.hsCent q T₀ q' i' hs S' hcent' R hrootCent r hvector + have hbandSelected := CentralCoordinateGeometry.hbandSelected q q' i' hs S' hs' hchild' r hparent + have hbandFresh : BandPrototile (q j.succ) (R j hs) := + TileOdometerBandPrototile _ _ _ (hrootChildren j hs) + have hselectedCellsFresh : (S' i' hs).cells = (R j hs).cells := + (BandPrototileCentroidUnique (q j.succ) _ _ hbandSelected hbandFresh hsCent).1 + have hlayoutOcc := cert.outer_occurrence j hs + have hbandLayout : BandPrototile (q j.succ) (cert.P j hs) := hlayoutOcc.1 + have hlayoutCent := CentralCoordinateGeometry.hlayoutCent q cfg C₀ T₀ cert i' hs R hrootCent r + hlayoutOcc + have hlayoutCells : (R j hs).cells = (cert.P j hs).cells := + (BandPrototileCentroidUnique (q j.succ) _ _ hbandFresh hbandLayout hlayoutCent).1 + have hparentNonempty : (cert.P j hs).cells.Nonempty := + CentralCoordinateGeometry.hparentNonempty q cfg C₀ T₀ cert i' hs r + have hselectedNonempty := CentralCoordinateGeometry.hselectedNonempty q cfg C₀ T₀ cert T i' hs + S' hselectedCells R r hselectedCellsFresh hlayoutCells hparentNonempty + have hcellsT : T.cells = (cert.P j hs).cells := CentralCoordinateGeometry.hcellsT q cfg C₀ T₀ + cert T i' hs S' hselectedCells R r hselectedCellsFresh hlayoutCells + have hfootT : FootprintVertices T = FootprintVertices (cert.P j hs) := + CentralCoordinateGeometry.hfootT q cfg C₀ T₀ cert T i' hs r hparentNonempty + hselectedNonempty hcellsT + have hchildPositive := CentralCoordinateGeometry.hchildPositive q cfg C₀ i' r + have hdomainT : (h.domain : Set GaussianInt) = FootprintVertices T := + CentralCoordinateGeometry.hdomainT C₀ T₀ h₀ C T h hsub + have hdomainFresh := CentralCoordinateGeometry.hdomainFresh q i' hs R rH hrootChildren r + hchildPositive + have hdomainSelected := CentralCoordinateGeometry.hdomainSelected q q' i' hs S' hs' hchild' r + hparent hchildPositive + have hdomainSelFresh := CentralCoordinateGeometry.hdomainSelFresh T i' hs S' hs' hselectedCells + R rH r hselectedCellsFresh hselectedNonempty hdomainFresh hdomainSelected + have hdomainSuppliedFresh := CentralCoordinateGeometry.hdomainSuppliedFresh h i' hs hs' + hselectedDomain rH r hdomainSelFresh + have hvalueSuppliedFresh := CentralCoordinateGeometry.hvalueSuppliedFresh h₀ h i' hs hs' + hvalue' hselectedDomain hselectedValue rH hrootValue r hdomainSuppliedFresh + have hfunEq : h = rH j hs := CentralCoordinateGeometry.hfunEq C₀ T₀ h₀ C T h hsub i' hs hs' + hselectedDomain hselectedValue rH r hdomainT hdomainSuppliedFresh hvalueSuppliedFresh + let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + have centralLabel := CentralCoordinateGeometry.centralLabel q cfg C₀ T₀ cert + obtain ⟨l, hl, hocc⟩ := centralLabel j hs + let b : PeriodicSubtileIndex := ⟨l, 0, 0⟩ + have hoccTile := CentralCoordinateGeometry.hoccTile q cfg C₀ T₀ cert i' hs r l hocc + have hoccCells : (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells = + (cert.P j hs).cells := CentralCoordinateGeometry.hoccCells q cfg C₀ T₀ cert i' hs r l hoccTile + have hoccCent : TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) = + TileCentroid (cert.P j hs) := CentralCoordinateGeometry.hoccCent q cfg C₀ T₀ cert i' hs r l + hoccTile + have hoccFoot : FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) = + FootprintVertices (cert.P j hs) := CentralCoordinateGeometry.hoccFoot q cfg C₀ T₀ cert i' + hs r l hoccTile + have hrootSlopeData := hrootSlope j hs + have hrootParentPositive : 0 < (q j.succ).1 := hchildPositive + rcases hrootSlopeData with hzero | ⟨p, ps, hp, hps, hpx, hpy⟩ + · omega + have hslopeOffset : ps - p = + (if hs = true then (1 : ℝ) else -1) • + P4250T1SlopeOffset (BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))) := + CentralCoordinateGeometry.hslopeOffset q i' hs r p ps hpx hpy + have hcentroidT : TileCentroid T = TileCentroid (cert.P j hs) := by + simp [TileCentroid, hparentNonempty, hcellsT] + have hlIndex : (slot l).1 = j := congrArg Prod.fst hl + have hlSign : (slot l).2 = hs := congrArg Prod.snd hl + have hCeq : C.1.1 = q j.succ := hq'i'.symm.trans hparent + refine ⟨b, ?_, ?_, ⟨?_⟩⟩ + · simp [b] + · simp [b] + · refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · change C.1.1 = q (slot l).1.succ + simpa only [hlIndex] using hCeq + · exact hsub.2.1 + · rw [hcellsT, hoccCells] + · rw [hcentroidT, hoccCent] + · rw [hdomainT, hfootT, hoccFoot] + · exact p + · exact ps + · exact hp + · simpa [hfunEq] using hps + · change ps - p = + (if (slot l).2 then (1 : ℝ) else -1) • + P4250T1SlopeOffset + (BandVectors.2 (q (((slot l).1 + 2).succ)) + (q (((slot l).1 + 1).succ))) + + GaussianRealPoint + ((b.first : GaussianInt) * BandVectors.2 (q 0) (q 1) + + (b.second : GaussianInt) * BandVectors.2 (q 0) (q 2)) + simp [b, hlIndex, hlSign, hslopeOffset, GaussianRealPoint] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1ContactAdjacency.lean b/LeanPool/ApollonianSuperharmonic/P4261T1ContactAdjacency.lean new file mode 100644 index 0000000000..f3784e1e8e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T1ContactAdjacency.lean @@ -0,0 +1,206 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer +public import LeanPool.ApollonianSuperharmonic.P4261T1ExteriorIndices +public import LeanPool.ApollonianSuperharmonic.P3055T1ExteriorCentralIncidence +public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms +public import LeanPool.ApollonianSuperharmonic.P3055T1SignedCentroidNormalForms +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.P4387T1PlacedCoordinates +public import LeanPool.ApollonianSuperharmonic.P4387T1ParentSlopeNormalForms + + +-- [TABLET NODE: P4261T1ContactAdjacency] + +/-! +# P4261T1ContactAdjacency + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4261T1ContactAdjacency + {q : Fin 4 → CircleCoordinates} {cfg : BandOrderedGeneralConfiguration q} + {C₀ : BandCircle} {T₀ : ProtoTile} + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T₀) + (h₀ : PartialOdometer) + (C D : BandCircle) (T U : ProtoTile) (h f : PartialOdometer) + (a b : PeriodicSubtileIndex) + (ha : a ∈ P4261T1ExteriorIndices) + (hb₁ : b.first = 0) (hb₂ : b.second = 0) + (pa : P4261T1PlacedOdometer cert h₀ C T h a) + (pb : P4261T1PlacedOdometer cert h₀ D U f b) + (hinc : AllowedSubtileIncidence a b) : + (D = C ∧ 1 < C.1.1.1 ∧ LeftLatticeAdjacent C T U h f) ∨ + SubtileLatticeAdjacent C D T U h f ∨ + SubtileLatticeAdjacent D C U T f h := by +-- BODY + classical + have ha' : a = ⟨.A, -1, -1⟩ ∨ + a = ⟨.A, 0, -1⟩ ∨ a = ⟨.C, 1, 0⟩ ∨ a = ⟨.C, 1, 1⟩ ∨ + a = ⟨.E, 0, 1⟩ ∨ a = ⟨.E, -1, 0⟩ ∨ a = ⟨.B, 1, 1⟩ ∨ + a = ⟨.B, 0, 1⟩ ∨ a = ⟨.D, -1, 0⟩ ∨ a = ⟨.D, -1, -1⟩ ∨ + a = ⟨.F, 0, -1⟩ ∨ a = ⟨.F, 1, 0⟩ := by + simpa [P4261T1ExteriorIndices] using ha + have hb' : b = ⟨.A, 0, 0⟩ ∨ b = ⟨.B, 0, 0⟩ ∨ + b = ⟨.C, 0, 0⟩ ∨ b = ⟨.D, 0, 0⟩ ∨ + b = ⟨.E, 0, 0⟩ ∨ b = ⟨.F, 0, 0⟩ := by + cases b with + | mk label first second => + simp only at hb₁ hb₂ + subst first + subst second + cases label <;> simp + have rows := P3055T1ExteriorCentralIncidence a b ha' hb' hinc + have left (r : Fin 4 → CircleCoordinates) (i : Fin 3) (e : Bool) + (hr : ProperBandQuadruple r) (hrC : r 0 = C.1.1) + (hDC : D.1.1 = C.1.1) (large : 1 < C.1.1.1) + (hc : TileCentroid U - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.1 (r i.succ) (r 0))) + (hs : pb.slope - pa.slope = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.2 (r i.succ) (r 0))) : + D = C ∧ 1 < C.1.1.1 ∧ LeftLatticeAdjacent C T U h f := by + have hDC' : D = C := Subtype.ext (Subtype.ext hDC) + refine ⟨hDC', large, pa.odometer, ?_, pa.slope, pb.slope, + pa.function_slope, pb.function_slope, Or.inr ?_⟩ + · simpa only [hDC'] using pb.odometer + · refine ⟨r, i, e, hr, hrC, hc, ?_, ?_⟩ + · cases e <;> simpa [GaussianRealPoint] using congrArg Prod.fst hs + · cases e <;> simpa [GaussianRealPoint] using congrArg Prod.snd hs + have sub {C D : BandCircle} {T U : ProtoTile} {h f : PartialOdometer} + {a b : PeriodicSubtileIndex} + (pa : P4261T1PlacedOdometer cert h₀ C T h a) + (pb : P4261T1PlacedOdometer cert h₀ D U f b) + (r : Fin 4 → CircleCoordinates) (i : Fin 3) (s : Fin 4) + (hr : ProperBandQuadruple r) (hrC : r 0 = C.1.1) + (hrD : r i.succ = D.1.1) + (hc : TileCentroid U - TileCentroid T = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ)))) + (hs : pb.slope - pa.slope = + (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (r i.succ) (r 0) + BandVectors.2 (r 0) (r i.succ)))) : + SubtileLatticeAdjacent C D T U h f := by + exact ⟨pa.odometer, pb.odometer, pa.slope, pb.slope, + pa.function_slope, pb.function_slope, r, i, s, hr, hrC, hrD, hc, + congrArg Prod.fst hs, congrArg Prod.snd hs⟩ + obtain ⟨caV, caA⟩ := P4387T1PlacedCoordinates cert h₀ C T h a pa + obtain ⟨cbV, cbA⟩ := P4387T1PlacedCoordinates cert h₀ D U f b pb + have hroot : pa.rootSlope = pb.rootSlope := + Option.some.inj (pa.root_slope.symm.trans pb.root_slope) + have vf := P3055T1ParentVectorNormalForms q cfg + have af := P4387T1ParentSlopeNormalForms q cfg + dsimp only at caV caA cbV cbA vf af + clear ha ha' hb' hb₁ hb₂ hinc + rcases rows with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | + ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | + ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | + ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | + ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + all_goals + have hC := pa.circle + have hD := pb.circle + dsimp only at hC hD + case' inl => + refine Or.inl (left cfg.firstPredecessor 1 true cfg.firstProper ?_ ?_ ?_ ?_ ?_) + case' inr.inl => + refine Or.inr (Or.inl + (sub pa pb cfg.firstPredecessor 1 0 cfg.firstProper ?_ ?_ ?_ ?_)) + case' inr.inr.inl => + refine Or.inl (left cfg.firstPredecessor 2 true cfg.firstProper ?_ ?_ ?_ ?_ ?_) + case' inr.inr.inr.inl => + refine Or.inr (Or.inl + (sub pa pb cfg.firstPredecessor 2 3 cfg.firstProper ?_ ?_ ?_ ?_)) + case' inr.inr.inr.inr.inl => + refine Or.inl (left cfg.secondPredecessor 0 true cfg.secondProper ?_ ?_ ?_ ?_ ?_) + case' inr.inr.inr.inr.inr.inl => + refine Or.inr (Or.inl + (sub pa pb cfg.secondPredecessor 0 0 cfg.secondProper ?_ ?_ ?_ ?_)) + case' inr.inr.inr.inr.inr.inr.inl => + refine Or.inr (Or.inr + (sub pb pa cfg.firstPredecessor 1 0 cfg.firstProper ?_ ?_ ?_ ?_)) + case' inr.inr.inr.inr.inr.inr.inr.inl => + refine Or.inr (Or.inr + (sub pb pa cfg.firstPredecessor 2 3 cfg.firstProper ?_ ?_ ?_ ?_)) + case' inr.inr.inr.inr.inr.inr.inr.inr.inl => + refine Or.inr (Or.inr + (sub pb pa cfg.secondPredecessor 0 0 cfg.secondProper ?_ ?_ ?_ ?_)) + case' inr.inr.inr.inr.inr.inr.inr.inr.inr.inl => + refine Or.inl (left cfg.firstPredecessor 1 false cfg.firstProper ?_ ?_ ?_ ?_ ?_) + case' inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inl => + refine Or.inr (Or.inl + (sub pa pb cfg.firstPredecessor 1 2 cfg.firstProper ?_ ?_ ?_ ?_)) + case' inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inl => + refine Or.inl (left cfg.firstPredecessor 2 false cfg.firstProper ?_ ?_ ?_ ?_ ?_) + case' inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inl => + refine Or.inr (Or.inl + (sub pa pb cfg.firstPredecessor 2 1 cfg.firstProper ?_ ?_ ?_ ?_)) + case' inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inl => + refine Or.inl (left cfg.secondPredecessor 0 false cfg.secondProper ?_ ?_ ?_ ?_ ?_) + case' inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inl => + refine Or.inr (Or.inl + (sub pa pb cfg.secondPredecessor 0 2 cfg.secondProper ?_ ?_ ?_ ?_)) + case' inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inl => + refine Or.inr (Or.inr + (sub pb pa cfg.firstPredecessor 1 2 cfg.firstProper ?_ ?_ ?_ ?_)) + case' inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inl => + refine Or.inr (Or.inr + (sub pb pa cfg.firstPredecessor 2 1 cfg.firstProper ?_ ?_ ?_ ?_)) + case' inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr.inr => + refine Or.inr (Or.inr + (sub pb pa cfg.secondPredecessor 0 2 cfg.secondProper ?_ ?_ ?_ ?_)) + all_goals + try first + | exact cfg.firstChild.trans hC.symm + | exact cfg.firstChild.trans hD.symm + | exact cfg.secondChild.trans hC.symm + | exact cfg.secondChild.trans hD.symm + | exact cfg.firstParentTwo.trans hC.symm + | exact cfg.firstParentTwo.trans hD.symm + | exact cfg.firstParentThree.trans hC.symm + | exact cfg.firstParentThree.trans hD.symm + | exact cfg.secondParentOne.trans hC.symm + | exact cfg.secondParentOne.trans hD.symm + | exact hD.trans hC.symm + | (have hh : C.1.1.1 = (q 1).1 := congrArg Prod.fst hC + have h₂ := cfg.secondLarge + have h₁ := cfg.order12 + omega) + | (have hh : C.1.1.1 = (q 2).1 := congrArg Prod.fst hC + have h₂ := cfg.secondLarge + omega) + all_goals + try simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl, + show (1 : Fin 3).succ = (2 : Fin 4) from rfl, + show (2 : Fin 3).succ = (3 : Fin 4) from rfl] + try simp only [vf.2.2.2.2.2.2.2.1, vf.2.2.2.2.2.2.2.2.1, + vf.2.2.2.2.2.2.2.2.2, af.2.2.2.2.2.2.2.1, + af.2.2.2.2.2.2.2.2.1, af.2.2.2.2.2.2.2.2.2] + try simp only [cfg.firstChild, cfg.firstParentTwo, cfg.firstParentThree, + cfg.secondChild, cfg.secondParentOne, vf.2.2.1, af.2.2.1] + first | rw [caV, cbV] | rw [caA, cbA, hroot] + apply Prod.ext + all_goals + simp [GaussianRealPoint, pow_succ, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1EdgeExterior.lean b/LeanPool/ApollonianSuperharmonic/P4261T1EdgeExterior.lean new file mode 100644 index 0000000000..f9e50a9f17 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T1EdgeExterior.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4261T1ExteriorIndices +public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.TileTranslation + +-- [TABLET NODE: P4261T1EdgeExterior] + +/-! +# P4261T1EdgeExterior + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4261T1EdgeExterior + {q : Fin 4 → CircleCoordinates} {cfg : BandOrderedGeneralConfiguration q} + {C₀ : BandCircle} {T₀ : ProtoTile} + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T₀) + (T : ProtoTile) (a : PeriodicSubtileIndex) + (hcells : T.cells = + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells) + (ha : a.first ≠ 0 ∨ a.second ≠ 0) + (hedge : (FootprintEdges T ∩ FootprintEdges T₀).Nonempty) : + a ∈ P4261T1ExteriorIndices := by +-- BODY + classical + obtain ⟨edge, heT, he₀⟩ := hedge + obtain ⟨z, hz, hshape⟩ := he₀ + obtain ⟨j, t, hzj⟩ := (cert.outer_union z).1 hz + let label : SixSubtileLabel := + if j = 0 then (if t then .A else .B) + else if j = 1 then (if t then .C else .D) + else (if t then .E else .F) + let b : PeriodicSubtileIndex := ⟨label, 0, 0⟩ + have hzero : GaussianTranslation 0 = id := by + funext z + simp [GaussianTranslation] + have hbcells : (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells = + (cert.P j t).cells := by + fin_cases j <;> cases t <;> + simp [b, label, SubtileOccurrenceInterpretation, TileTranslation, hzero] + have heb : edge ∈ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) := by + exact ⟨z, by rw [hbcells]; exact hzj, hshape⟩ + have hea : edge ∈ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) := by + obtain ⟨w, hw, hside⟩ := heT + exact ⟨w, by rw [← hcells]; exact hw, hside⟩ + have hab : a ≠ b := by + intro heq + have hf : a.first = 0 := by simpa [b] using congrArg PeriodicSubtileIndex.first heq + have hs : a.second = 0 := by simpa [b] using congrArg PeriodicSubtileIndex.second heq + exact ha.elim (fun h => h hf) (fun h => h hs) + have hinc := (BandOriginalOccurrenceIntersectionClassification q cfg C₀ T₀ cert a b hab).1 + ⟨edge, hea, heb⟩ + have ledger (a b : PeriodicSubtileIndex) (h : AllowedSubtileIncidence a b) : + (b.first = 0 → b.second = 0 → (a.first ≠ 0 ∨ a.second ≠ 0) → + a ∈ P4261T1ExteriorIndices) ∧ + (a.first = 0 → a.second = 0 → (b.first ≠ 0 ∨ b.second ≠ 0) → + b ∈ P4261T1ExteriorIndices) := by + induction h with + | symm _ ih => exact ⟨ih.2, ih.1⟩ + | AB m n | AB01 m n | AB11 m n | AC m n | AC11 m n | AD m n + | AE01 m n | AF m n | BC m n | BDm1m1 m n | BD m n | BE m n + | BF0m1 m n | CDm10 m n | CEm10 m n | CF m n | DE m n | DF10 m n => + constructor <;> intro hf hs hn <;> + simp_all [P4261T1ExteriorIndices, PeriodicSubtileIndex.mk.injEq] + all_goals omega + exact (ledger a b hinc).1 rfl rfl ha + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1ExteriorAdjacency.lean b/LeanPool/ApollonianSuperharmonic/P4261T1ExteriorAdjacency.lean new file mode 100644 index 0000000000..95a710ea4b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T1ExteriorAdjacency.lean @@ -0,0 +1,280 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer +public import LeanPool.ApollonianSuperharmonic.P4261T1ExteriorIndices +public import LeanPool.ApollonianSuperharmonic.P3045T1RightBoundaryDisplacementAlgebra +public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms +public import LeanPool.ApollonianSuperharmonic.P3055T1SignedCentroidNormalForms +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P4261T1ExteriorAdjacency] + +/-! +# P4261T1ExteriorAdjacency + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ExteriorAdjacencyGeometry + +private theorem displacement : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (a : + PeriodicSubtileIndex), (a ∈ P4261T1ExteriorIndices) → ( + let slot : Fin 3 × Bool := match a.label with + | .A => (0, true) | .B => (0, false) + | .C => (1, true) | .D => (1, false) + | .E => (2, true) | .F => (2, false) + let i := slot.1 + let ε : GaussianInt := if slot.2 then 1 else -1 + let I : GaussianInt := ⟨0, 1⟩ + ∃ s : Fin 4, + ε * ((1 - I) * BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) + + 2 * ((a.first : GaussianInt) * BandVectors.1 (q 0) (q 1) + + (a.second : GaussianInt) * BandVectors.1 (q 0) (q 2)) = + I ^ s.val * (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ)) ∧ + ε * ((1 + I) * BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ))) + + 2 * ((a.first : GaussianInt) * BandVectors.2 (q 0) (q 1) + + (a.second : GaussianInt) * BandVectors.2 (q 0) (q 2)) = + (-I) ^ s.val * (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))) ) := by + classical + intro q hq a ha + as_aux_lemma => + have sums : + (-BandVectors.1 (q 0) (q 1) - BandVectors.1 (q 0) (q 2) = + BandVectors.1 (q 0) (q 3)) ∧ + (-BandVectors.2 (q 0) (q 1) - BandVectors.2 (q 0) (q 2) = + BandVectors.2 (q 0) (q 3)) := by + as_aux_lemma => + obtain ⟨vs, as, v1, a1, flip⟩ := VectorRecursionLaws q hq.1 + have l2 := VectorRecursionLaws _ (SemiProperQuadruple.rotate hq.1) + have l3 := VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1)) + have v2 : BandVectors.1 (q 2) (q 0) = BandVectors.1 (q 2) (q 1) - + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 3) (q 2) := by + simpa using l2.2.2.1 + have a2 : BandVectors.2 (q 2) (q 0) = BandVectors.2 (q 2) (q 1) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 3) (q 2) := by + simpa using l2.2.2.2.1 + have v3 : BandVectors.1 (q 3) (q 0) = BandVectors.1 (q 3) (q 2) - + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 1) (q 3) := by + simpa using l3.2.2.1 + have a3 : BandVectors.2 (q 3) (q 0) = BandVectors.2 (q 3) (q 2) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 1) (q 3) := by + simpa using l3.2.2.2.1 + have f0 := flip hq 0 + have f1 := flip hq 1 + have f2 := flip hq 2 + simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl] at f0 + simp only [show (1 : Fin 3).succ = (2 : Fin 4) from rfl] at f1 + simp only [show (2 : Fin 3).succ = (3 : Fin 4) from rfl] at f2 + constructor + · apply eq_of_sub_eq_zero + rw [f0.1, f1.1, f2.1, v1, v2, v3] + calc + _ = (-(⟨0, 1⟩ : GaussianInt) + (⟨0, 1⟩ : GaussianInt) ^ 2) * + (BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 1) (q 3) + + BandVectors.1 (q 2) (q 1)) := by ring + _ = 0 := by rw [vs, mul_zero] + · apply eq_of_sub_eq_zero + rw [f0.2, f1.2, f2.2, a1, a2, a3] + calc + _ = ((⟨0, 1⟩ : GaussianInt) + (⟨0, 1⟩ : GaussianInt) ^ 2) * + (BandVectors.2 (q 3) (q 2) + BandVectors.2 (q 1) (q 3) + + BandVectors.2 (q 2) (q 1)) := by ring + _ = 0 := by rw [as, mul_zero] + have I2 : (⟨0, 1⟩ : GaussianInt) ^ 2 = -1 := by decide +kernel + have I3 : (⟨0, 1⟩ : GaussianInt) ^ 3 = -(⟨0, 1⟩ : GaussianInt) := by + rw [pow_succ, I2, neg_one_mul] + have nI3 : (-(⟨0, 1⟩ : GaussianInt)) ^ 3 = (⟨0, 1⟩ : GaussianInt) := by + rw [neg_pow, I3] + norm_num + have nI2 : (-(⟨0, 1⟩ : GaussianInt)) ^ 2 = -1 := by + rw [neg_sq, I2] + obtain ⟨v00, v01, v02, v03, a00, a01, a02, a03, _⟩ := + P3045T1RightBoundaryDisplacementAlgebra q hq 0 1 2 (Or.inl ⟨rfl, rfl, rfl⟩) + obtain ⟨v10, v11, v12, v13, a10, a11, a12, a13, _⟩ := + P3045T1RightBoundaryDisplacementAlgebra q hq 1 2 0 + (Or.inr (Or.inl ⟨rfl, rfl, rfl⟩)) + obtain ⟨v20, v21, v22, v23, a20, a21, a22, a23, _⟩ := + P3045T1RightBoundaryDisplacementAlgebra q hq 2 0 1 + (Or.inr (Or.inr ⟨rfl, rfl, rfl⟩)) + simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl, + show (1 : Fin 3).succ = (2 : Fin 4) from rfl, + show (2 : Fin 3).succ = (3 : Fin 4) from rfl] at v00 v01 v02 v03 a00 a01 a02 a03 + simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl, + show (1 : Fin 3).succ = (2 : Fin 4) from rfl, + show (2 : Fin 3).succ = (3 : Fin 4) from rfl] at v10 v11 v12 v13 a10 a11 a12 a13 + simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl, + show (1 : Fin 3).succ = (2 : Fin 4) from rfl, + show (2 : Fin 3).succ = (3 : Fin 4) from rfl] at v20 v21 v22 v23 a20 a21 a22 a23 + simp only [P4261T1ExteriorIndices, Finset.mem_insert, Finset.mem_singleton] at ha + rcases ha with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + all_goals dsimp only + all_goals simp only [show ((0 : Fin 3) + 2).succ = (3 : Fin 4) from rfl, + show ((0 : Fin 3) + 1).succ = (2 : Fin 4) from rfl, + show ((1 : Fin 3) + 2).succ = (1 : Fin 4) from rfl, + show ((1 : Fin 3) + 1).succ = (3 : Fin 4) from rfl, + show ((2 : Fin 3) + 2).succ = (2 : Fin 4) from rfl, + show ((2 : Fin 3) + 1).succ = (1 : Fin 4) from rfl, + show (0 : Fin 3).succ = (1 : Fin 4) from rfl, + show (1 : Fin 3).succ = (2 : Fin 4) from rfl, + show (2 : Fin 3).succ = (3 : Fin 4) from rfl] + · refine ⟨3, ?_, ?_⟩ + · convert v00 using 1 <;> norm_num [I3, ← sums.1]; ring + · convert a00 using 1 <;> norm_num [nI3, ← sums.2]; ring + · refine ⟨0, ?_, ?_⟩ + · convert v23 using 1 <;> norm_num; ring + · convert a23 using 1 <;> norm_num; ring + · refine ⟨3, ?_, ?_⟩ + · convert v10 using 1 <;> norm_num [I3] + · convert a10 using 1 <;> norm_num [nI3] + · refine ⟨0, ?_, ?_⟩ + · convert v03 using 1 <;> norm_num [← sums.1]; ring + · convert a03 using 1 <;> norm_num [← sums.2]; ring + · refine ⟨3, ?_, ?_⟩ + · convert v20 using 1 <;> norm_num [I3] + · convert a20 using 1 <;> norm_num [nI3] + · refine ⟨0, ?_, ?_⟩ + · convert v13 using 1 <;> norm_num; ring + · convert a13 using 1 <;> norm_num; ring + · refine ⟨1, ?_, ?_⟩ + · convert v02 using 1 <;> norm_num [← sums.1]; ring + · convert a02 using 1 <;> norm_num [← sums.2]; ring + · refine ⟨2, ?_, ?_⟩ + · convert v21 using 1 <;> norm_num [I2]; ring + · convert a21 using 1 <;> norm_num [nI2]; ring + · refine ⟨1, ?_, ?_⟩ + · convert v12 using 1 <;> norm_num; ring + · convert a12 using 1 <;> norm_num; ring + · refine ⟨2, ?_, ?_⟩ + · convert v01 using 1 <;> norm_num [I2, ← sums.1]; ring + · convert a01 using 1 <;> norm_num [nI2, ← sums.2]; ring + · refine ⟨1, ?_, ?_⟩ + · convert v22 using 1 <;> norm_num; ring + · convert a22 using 1 <;> norm_num; ring + · refine ⟨2, ?_, ?_⟩ + · convert v11 using 1 <;> norm_num [I2]; ring + · convert a11 using 1 <;> norm_num [nI2]; ring + +private theorem ht : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (a : PeriodicSubtileIndex), + let slot : Fin 3 × Bool := match a.label with + | .A => (0, true) | .B => (0, false) + | .C => (1, true) | .D => (1, false) + | .E => (2, true) | .F => (2, false) + let i := slot.1 + let pos := slot.2 + let dV := (a.first : GaussianInt) * BandVectors.1 (q 0) (q 1) + + (a.second : GaussianInt) * BandVectors.1 (q 0) (q 2) + SubtileOccurrenceInterpretation cert.P cert.u cert.v a = TileTranslation (cert.P i pos) + dV ) := by + classical + intro q cfg C₀ T₀ cert a slot i pos dV + dsimp only [SubtileOccurrenceInterpretation, i, pos, slot, dV] + rw [cert.period_u, cert.period_v] + cases a.label <;> rfl + +end ExteriorAdjacencyGeometry + +theorem P4261T1ExteriorAdjacency + {q : Fin 4 → CircleCoordinates} {cfg : BandOrderedGeneralConfiguration q} + {C₀ : BandCircle} {T₀ : ProtoTile} + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T₀) + (h₀ : PartialOdometer) (hroot : TileOdometer C₀.1.1 T₀ h₀) + (C : BandCircle) (T : ProtoTile) (h : PartialOdometer) + (a : PeriodicSubtileIndex) (ha : a ∈ P4261T1ExteriorIndices) + (placed : P4261T1PlacedOdometer cert h₀ C T h a) : + SubtileLatticeAdjacent C₀ C T₀ T h₀ h := by +-- BODY + let slot : Fin 3 × Bool := match a.label with + | .A => (0, true) | .B => (0, false) + | .C => (1, true) | .D => (1, false) + | .E => (2, true) | .F => (2, false) + let i := slot.1 + let pos := slot.2 + let w := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let b := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + let dV := (a.first : GaussianInt) * BandVectors.1 (q 0) (q 1) + + (a.second : GaussianInt) * BandVectors.1 (q 0) (q 2) + let dA := (a.first : GaussianInt) * BandVectors.2 (q 0) (q 1) + + (a.second : GaussianInt) * BandVectors.2 (q 0) (q 2) + -- Convert the twelve period indices using the three cyclic displacement calculations. + have displacement (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (a : PeriodicSubtileIndex) (ha : a ∈ P4261T1ExteriorIndices) := + ExteriorAdjacencyGeometry.displacement q hq a ha + obtain ⟨s, hV, hA⟩ := displacement q cfg.proper a ha + change (if pos then (1 : GaussianInt) else -1) * + ((1 - (⟨0, 1⟩ : GaussianInt)) * w) + 2 * dV = + (⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ)) at hV + change (if pos then (1 : GaussianInt) else -1) * + ((1 + (⟨0, 1⟩ : GaussianInt)) * b) + 2 * dA = + (-(⟨0, 1⟩ : GaussianInt)) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)) at hA + have parent : q i.succ = C.1.1 := placed.circle.symm + refine ⟨hroot, placed.odometer, placed.rootSlope, placed.slope, + placed.root_slope, placed.function_slope, q, i, s, + cfg.proper, cert.child_eq, parent, ?_, ?_, ?_⟩ + · have ht : SubtileOccurrenceInterpretation cert.P cert.u cert.v a = + TileTranslation (cert.P i pos) dV := ExteriorAdjacencyGeometry.ht q cfg C₀ T₀ cert a + have hc := placed.centroid + rw [ht, (TileTranslationFormulas (cert.P i pos) dV).2.2.2.2.1] at hc + have ho := (cert.outer_occurrence i pos).2.2 + change TileCentroid (cert.P i pos) - TileCentroid T₀ = + (if pos = true then (1 : Real) else -1) • + ((1 / 2 : Real) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) at ho + have hvx := congrArg (fun z : GaussianInt => (z.re : Real)) hV + have hvy := congrArg (fun z : GaussianInt => (z.im : Real)) hV + have hcx := congrArg Prod.fst hc + have hcy := congrArg Prod.snd hc + have hox := congrArg Prod.fst ho + have hoy := congrArg Prod.snd ho + apply Prod.ext + all_goals + cases hp : pos <;> + simp [hp, GaussianRealPoint] at hvx hvy hcx hcy hox hoy ⊢ <;> + linarith only [hvx, hvy, hcx, hcy, hox, hoy] + · have ho := placed.slope_offset + change placed.slope - placed.rootSlope = + (if pos then (1 : Real) else -1) • P4250T1SlopeOffset b + + GaussianRealPoint dA at ho + have hox := congrArg Prod.fst ho + have hax := congrArg (fun z : GaussianInt => (z.re : Real)) hA + cases hp : pos <;> + simp [hp, GaussianRealPoint, P4250T1SlopeOffset] at hox hax ⊢ <;> + linarith only [hox, hax] + · have ho := placed.slope_offset + change placed.slope - placed.rootSlope = + (if pos then (1 : Real) else -1) • P4250T1SlopeOffset b + + GaussianRealPoint dA at ho + have hoy := congrArg Prod.snd ho + have hay := congrArg (fun z : GaussianInt => (z.im : Real)) hA + cases hp : pos <;> + simp [hp, GaussianRealPoint, P4250T1SlopeOffset] at hoy hay ⊢ <;> + linarith only [hoy, hay] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1ExteriorIndices.lean b/LeanPool/ApollonianSuperharmonic/P4261T1ExteriorIndices.lean new file mode 100644 index 0000000000..96fba73e2a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T1ExteriorIndices.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex + +-- [TABLET NODE: P4261T1ExteriorIndices] + +/-! +# P4261T1ExteriorIndices + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The exterior index set consists of the twelve positions +$$ + A_{-1,-1},A_{0,-1},C_{1,0},C_{1,1},E_{0,1},E_{-1,0}, + B_{1,1},B_{0,1},D_{-1,0},D_{-1,-1},F_{0,-1},F_{1,0}. +$$ +These are the four exterior positions for each parent in the ordered-general +contact calculation, with period coordinates relative to $v_{01},v_{02}$. +-/ +def P4261T1ExteriorIndices : Finset PeriodicSubtileIndex := +-- BODY + {⟨.A, -1, -1⟩, ⟨.A, 0, -1⟩, ⟨.C, 1, 0⟩, ⟨.C, 1, 1⟩, + ⟨.E, 0, 1⟩, ⟨.E, -1, 0⟩, ⟨.B, 1, 1⟩, ⟨.B, 0, 1⟩, + ⟨.D, -1, 0⟩, ⟨.D, -1, -1⟩, ⟨.F, 0, -1⟩, ⟨.F, 1, 0⟩} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1PlacedOdometer.lean b/LeanPool/ApollonianSuperharmonic/P4261T1PlacedOdometer.lean new file mode 100644 index 0000000000..b615f112cd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T1PlacedOdometer.lean @@ -0,0 +1,99 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.SixSubtileLabel +public import LeanPool.ApollonianSuperharmonic.P4250T1SlopeOffset +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileOdometer + +-- [TABLET NODE: P4261T1PlacedOdometer] + +/-! +# P4261T1PlacedOdometer + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Fix an ordered-general layout $\mathcal L$ on $(q,T_0)$ and a partial +odometer $h_0$. A placed odometer at index $a=(X,m,n)$ consists of a +positive band circle $C$, a literal support $T$, and a literal partial +odometer $h$, together with the following certificates. Following the +interpretation in `SixSubtileLabel`, write +$(j,e)=(0,\mathrm{true}),(0,\mathrm{false}),(1,\mathrm{true}), +(1,\mathrm{false}),(2,\mathrm{true}),(2,\mathrm{false})$ +when $X=A,B,C,D,E,F$, respectively. Then +$C=q_{j+1}$, $h$ is a tile odometer for $C$ on $T$, and $T$ has exactly +the cells and centroid of $\operatorname{Occ}_{\mathcal L}(a)$. +Its domain is exactly the raw footprint of that occurrence. There are +defined slopes $p_0=\operatorname{slope}(h_0)$ and +$p=\operatorname{slope}(h)$. Put +$w_j=a(q_{(j+2)+1},q_{(j+1)+1})$, where indices inside parentheses +are in $\mathbb Z/3\mathbb Z$. Then the slope equation is +$$ + p-p_0=\epsilon_e\,\frac12(w_j+i w_j)+m a_{01}+n a_{02}, + \qquad \epsilon_{\mathrm{true}}=1,\quad + \epsilon_{\mathrm{false}}=-1. +$$ +The half-vector is `P4250T1SlopeOffset`. The data retain the +literal function $h$; they do not choose a replacement odometer on the +same cells or require equality of auxiliary anchors of nonempty tiles. +-/ +structure P4261T1PlacedOdometer + {q : Fin 4 → CircleCoordinates} {cfg : BandOrderedGeneralConfiguration q} + {C₀ : BandCircle} {T₀ : ProtoTile} + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T₀) + (h₀ : PartialOdometer) (C : BandCircle) (T : ProtoTile) + (h : PartialOdometer) (a : PeriodicSubtileIndex) where +-- BODY + circle : + let slot : Fin 3 × Bool := match a.label with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + C.1.1 = q slot.1.succ + odometer : TileOdometer C.1.1 T h + cells : T.cells = (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells + centroid : TileCentroid T = + TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) + domain : (h.domain : Set GaussianInt) = + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) + /-- The defined slope of the literal outer odometer. -/ + rootSlope : Real × Real + /-- The defined slope of the odometer placed at the retained periodic index. -/ + slope : Real × Real + root_slope : PartialOdometerSlope h₀ = some rootSlope + function_slope : PartialOdometerSlope h = some slope + slope_offset : + let slot : Fin 3 × Bool := match a.label with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + slope - rootSlope = + (if slot.2 then (1 : Real) else -1) • + P4250T1SlopeOffset + (BandVectors.2 (q ((slot.1 + 2).succ)) + (q ((slot.1 + 1).succ))) + + GaussianRealPoint + ((a.first : GaussianInt) * BandVectors.2 (q 0) (q 1) + + (a.second : GaussianInt) * BandVectors.2 (q 0) (q 2)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean new file mode 100644 index 0000000000..22636c3af8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean @@ -0,0 +1,1117 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer +public import LeanPool.ApollonianSuperharmonic.TileSubodometerLiteralDecompositionPiece +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms +public import LeanPool.ApollonianSuperharmonic.P3055T1SignedCentroidNormalForms +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P4261T1RightCoordinates] + +/-! +# P4261T1RightCoordinates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RightCoordinateGeometry + +private theorem hcurv₀ : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), (BandOrderedGeneralLayoutCertificate q cfg C₀ T₀) → + (1 < C₀.1.1.1) ) := by + classical + intro q cfg C₀ T₀ cert + have hh := cfg.childLarge + rw [cert.child_eq] at hh + omega + +private theorem hvector : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : + PartialOdometer), ∀ (q'' : Fin (4 : ℕ) → CircleCoordinates), ∀ (i'' : Fin (3 : ℕ)), ∀ + (s : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs' : Fin (3 : ℕ) → Bool → + PartialOdometer), (q'' i''.succ = C.1.1) → ((T.cells = (S' i'' s).cells) → + (((↑h.domain : Set GaussianInt) = (↑(hs' i'' s).domain : Set GaussianInt)) → ((∀ x ∈ + h.domain, h.value x = (hs' i'' s).value x) → (∀ (r : Fin (3 : ℕ)), (∀ (j : Fin (3 : + ℕ)), q'' j.succ = q (j + r).succ) → ( + let j : Fin 3 := i'' + r + (q'' i''.succ = q j.succ) → (BandVectors.1 (q'' ((i'' + 2).succ)) (q'' ((i'' + 1).succ)) + = BandVectors.1 (q ((j + 2).succ)) (q ((j + 1).succ)))))))) ) := by + classical + intro q C T h q'' i'' s S' hs' hq''i hselectedCells hselectedDomain hselectedValue r hrotate j + hparent + rw [hrotate (i'' + 2), hrotate (i'' + 1)]; dsimp [j]; fin_cases r <;> fin_cases i'' <;> rfl + +private theorem hslopeVector : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : + PartialOdometer), ∀ (q'' : Fin (4 : ℕ) → CircleCoordinates), ∀ (i'' : Fin (3 : ℕ)), ∀ + (s : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs' : Fin (3 : ℕ) → Bool → + PartialOdometer), (q'' i''.succ = C.1.1) → ((T.cells = (S' i'' s).cells) → + (((↑h.domain : Set GaussianInt) = (↑(hs' i'' s).domain : Set GaussianInt)) → ((∀ x ∈ + h.domain, h.value x = (hs' i'' s).value x) → (∀ (r : Fin (3 : ℕ)), (∀ (j : Fin (3 : + ℕ)), q'' j.succ = q (j + r).succ) → ( + let j : Fin 3 := i'' + r + (q'' i''.succ = q j.succ) → ((BandVectors.1 (q'' ((i'' + 2).succ)) (q'' ((i'' + 1).succ)) + = BandVectors.1 (q ((j + 2).succ)) (q ((j + 1).succ))) → (BandVectors.2 (q'' ((i'' + + 2).succ)) (q'' ((i'' + 1).succ)) = BandVectors.2 (q ((j + 2).succ)) (q ((j + + 1).succ))))))))) ) := by + classical + intro q C T h q'' i'' s S' hs' hq''i hselectedCells hselectedDomain hselectedValue r hrotate j + hparent hvector + rw [hrotate (i'' + 2), hrotate (i'' + 1)]; dsimp [j]; fin_cases r <;> fin_cases i'' <;> rfl + +private theorem hsCent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (N : ProtoTile), ∀ (q'' : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), TileCentroid (S' j t) - TileCentroid + N = (if t = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q'' (j + (2 : Fin (3 : ℕ))).succ) (q'' (j + (1 : Fin (3 : ℕ))).succ)) + - (-(GaussianRealPoint (BandVectors.1 (q'' (j + (2 : Fin (3 : ℕ))).succ) (q'' (j + (1 + : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q'' (j + (2 : Fin (3 : + ℕ))).succ) (q'' (j + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (R : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (R i s) - TileCentroid N + = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + (BandVectors.1 (q'' ((i'' + 2).succ)) (q'' ((i'' + 1).succ)) = BandVectors.1 (q ((j + + 2).succ)) (q ((j + 1).succ))) → (TileCentroid (S' i'' s) = TileCentroid (R j s)))) ) + := by + classical + intro q N q'' i'' s S' hcent' R hrootCent r j hvector + calc + TileCentroid (S' i'' s) = + (TileCentroid (S' i'' s) - TileCentroid N) + TileCentroid N := by abel + _ = (TileCentroid (R j s) - TileCentroid N) + TileCentroid N := by + rw [hcent' i'' s, hrootCent j s, hvector] + _ = TileCentroid (R j s) := by abel + +private theorem hbandSelected : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (q'' : Fin (4 : ℕ) → CircleCoordinates), ∀ (i'' : + Fin (3 : ℕ)), ∀ (s : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs' : Fin (3 + : ℕ) → Bool → PartialOdometer), (∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), TileOdometer (q'' + j.succ) (S' j t) (hs' j t)) → (∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + (q'' i''.succ = q j.succ) → (BandPrototile (q j.succ) (S' i'' s))) ) := by + classical + intro q q'' i'' s S' hs' hchild' r j hparent + rw [← hparent] + exact TileOdometerBandPrototile _ _ _ (hchild' i'' s) + +private theorem hgeom : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (N : ProtoTile), ∀ (pN : ℝ × ℝ), ∀ (p0 : ℝ × ℝ), ∀ (q' : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), (q' (0 : Fin (4 : ℕ)) = + C₀.1.1) → ((TileCentroid T₀ - TileCentroid N = (if e' = true then (1 : ℝ) else (-1 : + ℝ)) • GaussianRealPoint (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' i'.succ))) → ((p0.1 + - pN.1 = (if e' = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (q' (0 : Fin (4 + : ℕ))) (q' i'.succ)).re : ℝ)) → ((p0.2 - pN.2 = (if e' = true then (1 : ℝ) else (-1 : + ℝ)) * (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) (q' i'.succ)).im : ℝ)) → (∀ (ra : Fin + (3 : ℕ)), + let k : Fin 3 := i' + ra + (q' i'.succ = q k.succ) → ( + let μ : Int := if e' = true then -1 else 1 + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 + ( + let V := BandVectors.1; + let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); + let U := V (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let W := V (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); V (q (1 : Fin (4 : ℕ))) (q (3 : + Fin (4 : ℕ))) = -U - W ∧ V (q (1 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = I * U ∧ V (q + (3 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = I * (U + W) ∧ V (q (2 : Fin (4 : ℕ))) (q + (3 : Fin (4 : ℕ))) = I * W ∧ V (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = U - I * + (U + W) ∧ V (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = W + I * U ∧ V (q (0 : Fin + (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = -U - W + I * W ∧ V (cfg.firstPredecessor (2 : Fin + (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) + V (cfg.firstPredecessor (0 : Fin + (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 : ℕ))) = ((1 : GaussianInt) + I) * U ∧ V + (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) + V + (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))) = + (I - (1 : GaussianInt)) * (U + W) ∧ V (cfg.secondPredecessor (1 : Fin (4 : ℕ))) + (cfg.secondPredecessor (0 : Fin (4 : ℕ))) + V (cfg.secondPredecessor (0 : Fin (4 : + ℕ))) (cfg.secondPredecessor (1 : Fin (4 : ℕ))) = ((1 : GaussianInt) + I) * W) → + (GaussianRealPoint ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v) = -((if + e' = true then (1 : ℝ) else -1) • GaussianRealPoint (BandVectors.1 (q' 0) (q' + i'.succ))))))))) ) := by + classical + intro q cfg C₀ T₀ cert N pN p0 q' i' e' hq'0 hcentAdj hslopeAdj1 hslopeAdj2 ra k hAdjChild μ m + n hforms + have hchild : q' i'.succ = q k.succ := hAdjChild + rw [cert.period_u, cert.period_v, hq'0, cert.child_eq, hchild] + have h01 := hforms.2.2.2.2.1 + have h02 := hforms.2.2.2.2.2.1 + have h03 := hforms.2.2.2.2.2.2.1 + dsimp only at hforms h01 h02 h03 + have hsum : BandVectors.1 (q 0) (q 3) = + -BandVectors.1 (q 0) (q 1) - BandVectors.1 (q 0) (q 2) := by + rw [h01, h02, h03] + ring + rw [cert.child_eq] at hsum + have hsumPoint := congrArg GaussianRealPoint hsum + simp [GaussianRealPoint] at hsumPoint + have hkvals : k.val = 0 ∨ k.val = 1 ∨ k.val = 2 := by omega + rcases hkvals with hk | hk | hk + · have : k = 0 := Fin.ext hk + cases e' <;> simp [m, n, μ, GaussianRealPoint, this] + · have : k = 1 := Fin.ext hk + cases e' <;> simp [m, n, μ, GaussianRealPoint, this] + · have : k = 2 := Fin.ext hk + cases e' <;> simp [m, n, μ, GaussianRealPoint, this] <;> + constructor <;> linarith [hsumPoint.1, hsumPoint.2] + +private theorem hNcent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (N : ProtoTile), ∀ (q' : Fin (4 : ℕ) → CircleCoordinates), ∀ (i' : Fin (3 : + ℕ)), ∀ (e' : Bool), (q' (0 : Fin (4 : ℕ)) = C₀.1.1) → ((TileCentroid T₀ - + TileCentroid N = (if e' = true then (1 : ℝ) else (-1 : ℝ)) • GaussianRealPoint + (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' i'.succ))) → (∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra + let μ : Int := if e' = true then -1 else 1 + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 + (GaussianRealPoint ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v) = -((if e' = + true then (1 : ℝ) else -1) • GaussianRealPoint (BandVectors.1 (q' 0) (q' i'.succ)))) + → (TileCentroid N - TileCentroid T₀ = GaussianRealPoint ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v)))) ) := by + classical + intro q cfg C₀ T₀ cert N q' i' e' hq'0 hcentAdj ra k μ m n hgeom + have := hcentAdj + rw [hq'0] at this + rw [hq'0] at hgeom + calc + TileCentroid N - TileCentroid T₀ = -(TileCentroid T₀ - TileCentroid N) := by abel + _ = _ := by rw [this, hgeom] + +private theorem hPshiftCent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), ∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ + (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + ∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra + let μ : Int := if e' = true then -1 else 1 + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 + let shift : GaussianInt := (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v + let Pshift : ProtoTile := TileTranslation (cert.P j s) shift + TileCentroid Pshift = TileCentroid (cert.P j s) + GaussianRealPoint shift ) := by + classical + intro q cfg C₀ T₀ cert i' e' i'' s r j ra k μ m n shift Pshift + have hc := (TileTranslationFormulas (cert.P j s) shift).2.2.2.2.1 + dsimp [Pshift, GaussianRealPoint] + exact hc + +private theorem hlayoutCent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (N : ProtoTile), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), ∀ (i'' : Fin (3 : + ℕ)), ∀ (s : Bool), ∀ (R : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s + : Bool), TileCentroid (R i s) - TileCentroid N = (if s = true then (1 : ℝ) else (-1 : + ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).1))) → (∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + ∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra + let μ : Int := if e' = true then -1 else 1 + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 + (TileCentroid N - TileCentroid T₀ = GaussianRealPoint ((m : GaussianInt) * cert.u + (n : + GaussianInt) * cert.v)) → ((BandSubtileOccurrence q T₀ j s (cert.P j s)) → ( + let shift : GaussianInt := (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v + let Pshift : ProtoTile := TileTranslation (cert.P j s) shift + (TileCentroid Pshift = TileCentroid (cert.P j s) + GaussianRealPoint shift) → + (TileCentroid (R j s) = TileCentroid Pshift)))) ) := by + classical + intro q cfg C₀ T₀ cert N i' e' i'' s R hrootCent r j ra k μ m n hNcent hlayoutOcc shift Pshift + hPshiftCent + calc + TileCentroid (R j s) = + (TileCentroid (R j s) - TileCentroid T₀) + TileCentroid T₀ := by abel + _ = (TileCentroid (cert.P j s) - TileCentroid T₀ + GaussianRealPoint shift) + TileCentroid + T₀ := by + have heq : TileCentroid (R j s) - TileCentroid T₀ = + TileCentroid (cert.P j s) - TileCentroid T₀ + GaussianRealPoint shift := by + calc + TileCentroid (R j s) - TileCentroid T₀ = + (TileCentroid (R j s) - TileCentroid N) + + (TileCentroid N - TileCentroid T₀) := by abel + _ = (TileCentroid (cert.P j s) - TileCentroid T₀ + GaussianRealPoint shift) := by + rw [hrootCent j s, hNcent, hlayoutOcc.2.2] + rw [heq] + _ = TileCentroid Pshift := by rw [hPshiftCent]; abel + +private theorem hparentNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + (cert.P j s).cells.Nonempty ) := by + classical + intro q cfg C₀ T₀ cert i'' s r j + rcases cert.parent_lattice j s with ⟨e⟩ + have hball : (0 : ℝ × ℝ) ∈ Metric.closedBall (0 : ℝ × ℝ) 1 := by simp + have hreal : (e ⟨(0 : ℝ × ℝ), hball⟩ : ℝ × ℝ) ∈ + TileRealization (cert.P j s) := (e ⟨0, hball⟩).property + simp only [TileRealization, Set.mem_iUnion] at hreal + rcases hreal with ⟨x, hx, _⟩ + exact ⟨x, hx⟩ + +private theorem hselectedNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (T : ProtoTile), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), ∀ (i'' : Fin (3 : + ℕ)), ∀ (s : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), (T.cells = (S' i'' + s).cells) → (∀ (R : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + ((S' i'' s).cells = (R j s).cells) → (∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra + let μ : Int := if e' = true then -1 else 1 + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 + let shift : GaussianInt := (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v + let Pshift : ProtoTile := TileTranslation (cert.P j s) shift + ((R j s).cells = Pshift.cells) → (((cert.P j s).cells.Nonempty) → (T.cells.Nonempty)))) ) + := by + classical + intro q cfg C₀ T₀ cert T i' e' i'' s S' hselectedCells R r j hselectedCellsFresh ra k μ m n + shift Pshift hlayoutCells hparentNonempty + rw [hselectedCells, hselectedCellsFresh, hlayoutCells] + have hnonempty : Pshift.cells.Nonempty := by + by_contra he + have hempty : Pshift.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp he + have hsource : (cert.P j s).cells = ∅ := + (TileTranslationFormulas (cert.P j s) shift).2.2.1.mp hempty + rcases hparentNonempty with ⟨x, hx⟩ + rw [hsource] at hx + simp at hx + exact hnonempty + +private theorem hcellsT : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (T : ProtoTile), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), ∀ (i'' : Fin (3 : + ℕ)), ∀ (s : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), (T.cells = (S' i'' + s).cells) → (∀ (R : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + ((S' i'' s).cells = (R j s).cells) → (∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra + let μ : Int := if e' = true then -1 else 1 + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 + let shift : GaussianInt := (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v + let Pshift : ProtoTile := TileTranslation (cert.P j s) shift + ((R j s).cells = Pshift.cells) → (T.cells = Pshift.cells))) ) := by + classical + intro q cfg C₀ T₀ cert T i' e' i'' s S' hselectedCells R r j hselectedCellsFresh ra k μ m n + shift Pshift hlayoutCells + calc T.cells = (S' i'' s).cells := hselectedCells + _ = (R j s).cells := hselectedCellsFresh + _ = Pshift.cells := hlayoutCells + +private theorem hfootT : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (T : ProtoTile), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), ∀ (i'' : Fin (3 : + ℕ)), ∀ (s : Bool), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + ∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra + let μ : Int := if e' = true then -1 else 1 + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 + let shift : GaussianInt := (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v + let Pshift : ProtoTile := TileTranslation (cert.P j s) shift + ((cert.P j s).cells.Nonempty) → ((T.cells.Nonempty) → ((T.cells = Pshift.cells) → + (FootprintVertices T = FootprintVertices Pshift))) ) := by + classical + intro q cfg C₀ T₀ cert T i' e' i'' s r j ra k μ m n shift Pshift hparentNonempty + hselectedNonempty hcellsT + have hshiftNonempty : Pshift.cells.Nonempty := by + by_contra he + have hempty : Pshift.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp he + have hsource : (cert.P j s).cells = ∅ := + (TileTranslationFormulas (cert.P j s) shift).2.2.1.mp hempty + rcases hparentNonempty with ⟨x, hx⟩ + rw [hsource] at hx + simp at hx + simp only [FootprintVertices, ite_eq_left hselectedNonempty, ite_eq_left hshiftNonempty] + rw [hcellsT] + +private theorem hchildPositive : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((BandCircle) → + (∀ (i'' : Fin (3 : ℕ)), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + 0 < (q j.succ).1)) ) := by + classical + intro q cfg C₀ i'' r j + have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 j + have hne := cfg.noLine j.succ + omega + +private theorem hdomainFresh : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (R : Fin (3 : + ℕ) → Bool → ProtoTile), ∀ (rH : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 + : ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (R i s) (rH i s)) → (∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + (0 < (q j.succ).1) → (((rH j s).domain : Set GaussianInt) = FootprintVertices (R j s))) ) + := by + classical + intro q i'' s R rH hrootChildren r j hchildPositive + exact PositiveCurvatureTileOdometerDomain (q j.succ) (R j s) (rH j s) + hchildPositive (hrootChildren j s) + +private theorem hdomainSelected : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (q'' : Fin (4 : ℕ) → CircleCoordinates), ∀ (i'' : + Fin (3 : ℕ)), ∀ (s : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs' : Fin (3 + : ℕ) → Bool → PartialOdometer), (∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), TileOdometer (q'' + j.succ) (S' j t) (hs' j t)) → (∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + (q'' i''.succ = q j.succ) → ((0 < (q j.succ).1) → (((hs' i'' s).domain : Set GaussianInt) + = FootprintVertices (S' i'' s)))) ) := by + classical + intro q q'' i'' s S' hs' hchild' r j hparent hchildPositive + exact PositiveCurvatureTileOdometerDomain (q j.succ) (S' i'' s) (hs' i'' s) + hchildPositive (by rw [← hparent]; exact hchild' i'' s) + +private theorem hdomainSelFresh : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (hs' : Fin (3 : ℕ) → Bool → PartialOdometer), (T.cells = (S' i'' + s).cells) → (∀ (R : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (rH : Fin (3 : ℕ) → Bool → + PartialOdometer), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + ((S' i'' s).cells = (R j s).cells) → ((T.cells.Nonempty) → ((((rH j s).domain : Set + GaussianInt) = FootprintVertices (R j s)) → ((((hs' i'' s).domain : Set GaussianInt) + = FootprintVertices (S' i'' s)) → (((hs' i'' s).domain : Set GaussianInt) = (rH j + s).domain))))) ) := by + classical + intro T i'' s S' hs' hselectedCells R rH r j hselectedCellsFresh hselectedNonempty hdomainFresh + hdomainSelected + have hneSelected : (S' i'' s).cells.Nonempty := by rw [← hselectedCells]; exact + hselectedNonempty + have hneFresh : (R j s).cells.Nonempty := by rw [← hselectedCellsFresh]; exact hneSelected + rw [hdomainSelected, hdomainFresh] + simp only [FootprintVertices, ite_eq_left hneSelected, ite_eq_left hneFresh] + rw [hselectedCellsFresh] + +private theorem hdomainSuppliedFresh : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (hs' : Fin (3 : ℕ) → Bool + → PartialOdometer), ((↑h.domain : Set GaussianInt) = (↑(hs' i'' s).domain : Set + GaussianInt)) → (∀ (rH : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + (((hs' i'' s).domain : Set GaussianInt) = (rH j s).domain) → ((h.domain : Set + GaussianInt) = (rH j s).domain)) ) := by + classical + intro h i'' s hs' hselectedDomain rH r j hdomainSelFresh + calc (h.domain : Set GaussianInt) = (hs' i'' s).domain := hselectedDomain + _ = (rH j s).domain := hdomainSelFresh + +private theorem hvalueSuppliedFresh : + (by + classical + exact + ∀ (hN : PartialOdometer), ∀ (h : PartialOdometer), ∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ + (hs' : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), ∀ x + ∈ (hs' j t).domain, hN.value x = (hs' j t).value x) → (((↑h.domain : Set GaussianInt) + = (↑(hs' i'' s).domain : Set GaussianInt)) → ((∀ x ∈ h.domain, h.value x = (hs' i'' + s).value x) → (∀ (rH : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ + (s : Bool), ∀ x ∈ (rH i s).domain, hN.value x = (rH i s).value x) → (∀ (r : Fin (3 : + ℕ)), + let j : Fin 3 := i'' + r + ((h.domain : Set GaussianInt) = (rH j s).domain) → (∀ x, h.value x = (rH j s).value + x))))) ) := by + classical + intro hN h i'' s hs' hvalue' hselectedDomain hselectedValue rH hrootValue r j + hdomainSuppliedFresh x + by_cases hx : x ∈ h.domain + · have hx' : x ∈ (hs' i'' s).domain := by + have hfin : h.domain = (hs' i'' s).domain := Finset.coe_injective hselectedDomain + rw [hfin] at hx + exact hx + have hv₁ := hselectedValue x hx + have hv₂ := hvalue' i'' s x hx' + have hxFresh : x ∈ (rH j s).domain := by + have hfin : h.domain = (rH j s).domain := Finset.coe_injective hdomainSuppliedFresh + rw [hfin] at hx + exact hx + exact hv₁.trans (hv₂.symm.trans (hrootValue j s x hxFresh)) + · have hxFresh : x ∉ (rH j s).domain := by + intro hxF + exact hx ((Set.ext_iff.mp hdomainSuppliedFresh x).mpr hxF) + rw [h.value_outside x hx, (rH j s).value_outside x hxFresh] + +private theorem hfunEq : + (by + classical + exact + ∀ (C₀ : BandCircle), ∀ (N : ProtoTile), ∀ (hN : PartialOdometer), ∀ (C : BandCircle), ∀ + (T : ProtoTile), ∀ (h : PartialOdometer), (TileSubodometer C₀.1.1 C.1.1 N T hN h) → + (∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (hs' : Fin (3 : ℕ) → Bool → PartialOdometer), + ((↑h.domain : Set GaussianInt) = (↑(hs' i'' s).domain : Set GaussianInt)) → ((∀ x ∈ + h.domain, h.value x = (hs' i'' s).value x) → (∀ (rH : Fin (3 : ℕ) → Bool → + PartialOdometer), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + ((h.domain : Set GaussianInt) = FootprintVertices T) → (((h.domain : Set GaussianInt) = + (rH j s).domain) → ((∀ x, h.value x = (rH j s).value x) → (h = rH j s)))))) ) := by + classical + intro C₀ N hN C T h hsub i'' s hs' hselectedDomain hselectedValue rH r j hdomainT + hdomainSuppliedFresh hvalueSuppliedFresh + cases h with + | mk hd hv hout => + have hdomEq : hd = (rH j s).domain := Finset.coe_injective hdomainSuppliedFresh + have hvalEq : hv = (rH j s).value := funext hvalueSuppliedFresh + cases hdomEq + cases hvalEq + rfl + +private theorem hsumA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (BandVectors.2 + (q 0) (q 3) = -BandVectors.2 (q 0) (q 1) - BandVectors.2 (q 0) (q 2)) ) := by + classical + intro q cfg + have laws := VectorRecursionLaws q cfg.proper.1 + have laws2 := VectorRecursionLaws _ (SemiProperQuadruple.rotate cfg.proper.1) + have laws3 := VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate cfg.proper.1)) + have ha2 : BandVectors.2 (q 2) (q 0) = + BandVectors.2 (q 2) (q 1) + + ({ re := 0, im := 1 } : GaussianInt) * BandVectors.2 (q 3) (q 2) := by + simpa using laws2.2.2.2.1 + have ha3 : BandVectors.2 (q 3) (q 0) = + BandVectors.2 (q 3) (q 2) + + ({ re := 0, im := 1 } : GaussianInt) * BandVectors.2 (q 1) (q 3) := by + simpa using laws3.2.2.2.1 + have f1 := (laws.2.2.2.2 cfg.proper 0).2 + have f2 := (laws.2.2.2.2 cfg.proper 1).2 + have f3 := (laws.2.2.2.2 cfg.proper 2).2 + change BandVectors.2 (q 0) (q 1) = _ at f1 + change BandVectors.2 (q 0) (q 2) = _ at f2 + change BandVectors.2 (q 0) (q 3) = _ at f3 + have hsum := laws.2.1 + have h13 : BandVectors.2 (q 1) (q 3) = + -BandVectors.2 (q 2) (q 1) - BandVectors.2 (q 3) (q 2) := by + apply eq_of_sub_eq_zero + calc + _ = BandVectors.2 (q 3) (q 2) + BandVectors.2 (q 1) (q 3) + + BandVectors.2 (q 2) (q 1) := by ring + _ = 0 := hsum + rw [f1, f2, f3] + change -({ re := 0, im := 1 } : GaussianInt) * BandVectors.2 (q 3) (q 0) = + -(-({ re := 0, im := 1 } : GaussianInt) * BandVectors.2 (q 1) (q 0)) - + -({ re := 0, im := 1 } : GaussianInt) * BandVectors.2 (q 2) (q 0) + rw [laws.2.2.2.1, ha2, ha3, h13] + ring + +private theorem hsumARe : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (((GaussianInt.toComplex : GaussianInt → ℂ) + (BandVectors.2 (q (0 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))))).re = + -((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (q (0 : Fin (4 : ℕ))) (q + (1 : Fin (4 : ℕ))))).re - ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 + (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).re ∧ ((GaussianInt.toComplex : + GaussianInt → ℂ) (BandVectors.2 (q (0 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))))).im = + -((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (q (0 : Fin (4 : ℕ))) (q + (1 : Fin (4 : ℕ))))).im - ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 + (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).im) → ((GaussianInt.toComplex + (BandVectors.2 (q 0) (q 3))).re = -(GaussianInt.toComplex (BandVectors.2 (q 0) (q + 1))).re - (GaussianInt.toComplex (BandVectors.2 (q 0) (q 2))).re) ) := by + classical + intro q hsumAPoint + exact hsumAPoint.1 + +private theorem hsumAIm : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (((GaussianInt.toComplex : GaussianInt → ℂ) + (BandVectors.2 (q (0 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))))).re = + -((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (q (0 : Fin (4 : ℕ))) (q + (1 : Fin (4 : ℕ))))).re - ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 + (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).re ∧ ((GaussianInt.toComplex : + GaussianInt → ℂ) (BandVectors.2 (q (0 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))))).im = + -((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (q (0 : Fin (4 : ℕ))) (q + (1 : Fin (4 : ℕ))))).im - ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 + (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).im) → ((GaussianInt.toComplex + (BandVectors.2 (q 0) (q 3))).im = -(GaussianInt.toComplex (BandVectors.2 (q 0) (q + 1))).im - (GaussianInt.toComplex (BandVectors.2 (q 0) (q 2))).im) ) := by + classical + intro q hsumAPoint + exact hsumAPoint.2 + +private theorem hSlopePeriod : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (N : ProtoTile), ∀ (T : ProtoTile), ∀ (pN : ℝ × ℝ), ∀ (p0 : ℝ × ℝ), ∀ (q' : + Fin (4 : ℕ) → CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), (q' (0 : Fin + (4 : ℕ)) = C₀.1.1) → ((TileCentroid T₀ - TileCentroid N = (if e' = true then (1 : ℝ) + else (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' + i'.succ))) → ((p0.1 - pN.1 = (if e' = true then (1 : ℝ) else (-1 : ℝ)) * + (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) (q' i'.succ)).re : ℝ)) → ((p0.2 - pN.2 = (if + e' = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) (q' + i'.succ)).im : ℝ)) → (∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (R : Fin (3 : ℕ) → Bool + → ProtoTile), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + ∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra + (q' i'.succ = q k.succ) → ( + let μ : Int := if e' = true then -1 else 1 + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 + (GaussianRealPoint ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v) = -((if e' = + true then (1 : ℝ) else -1) • GaussianRealPoint (BandVectors.1 (q' 0) (q' i'.succ)))) + → ((TileCentroid N - TileCentroid T₀ = GaussianRealPoint ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v)) → ( + let shift : GaussianInt := (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v + let Pshift : ProtoTile := TileTranslation (cert.P j s) shift + (BandPrototile (q j.succ) Pshift) → ((TileCentroid Pshift = TileCentroid (cert.P j s) + + GaussianRealPoint shift) → ((TileCentroid (R j s) = TileCentroid Pshift) → (((R j + s).cells = Pshift.cells) → ((T.cells = Pshift.cells) → ((FootprintVertices T = + FootprintVertices Pshift) → (((GaussianInt.toComplex (BandVectors.2 (q 0) (q 3))).re + = -(GaussianInt.toComplex (BandVectors.2 (q 0) (q 1))).re - (GaussianInt.toComplex + (BandVectors.2 (q 0) (q 2))).re) → (((GaussianInt.toComplex (BandVectors.2 (q 0) (q + 3))).im = -(GaussianInt.toComplex (BandVectors.2 (q 0) (q 1))).im - + (GaussianInt.toComplex (BandVectors.2 (q 0) (q 2))).im) → (GaussianRealPoint ((m : + GaussianInt) * BandVectors.2 (q 0) (q 1) + (n : GaussianInt) * BandVectors.2 (q 0) (q + 2)) = -((if e' = true then (1 : ℝ) else -1) • GaussianRealPoint (BandVectors.2 (q' 0) + (q' i'.succ)))))))))))))))))) ) := by + classical + intro q cfg C₀ T₀ cert N T pN p0 q' i' e' hq'0 hcentAdj hslopeAdj1 hslopeAdj2 i'' s R r j ra k + hAdjChild μ m n hgeom hNcent shift Pshift hbandShift hPshiftCent hlayoutCent hlayoutCells + hcellsT hfootT hsumARe hsumAIm + rw [hq'0, cert.child_eq, hAdjChild] + have hkvals : k.val = 0 ∨ k.val = 1 ∨ k.val = 2 := by omega + rcases hkvals with hk | hk | hk + · have hkEq : k = 0 := Fin.ext hk + cases e' <;> simp [m, n, μ, GaussianRealPoint, hkEq] + · have hkEq : k = 1 := Fin.ext hk + cases e' <;> simp [m, n, μ, GaussianRealPoint, hkEq] + · have hkEq : k = 2 := Fin.ext hk + rw [cert.child_eq] at hsumARe hsumAIm + cases e' <;> simp [m, n, μ, GaussianRealPoint, hkEq] <;> + constructor <;> linarith [hsumARe, hsumAIm] + +private theorem hAdjSlope : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (N : ProtoTile), ∀ (T : ProtoTile), ∀ (pN : ℝ × ℝ), ∀ (p0 : ℝ × ℝ), ∀ (q' : + Fin (4 : ℕ) → CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), (q' (0 : Fin + (4 : ℕ)) = C₀.1.1) → ((TileCentroid T₀ - TileCentroid N = (if e' = true then (1 : ℝ) + else (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' + i'.succ))) → ((p0.1 - pN.1 = (if e' = true then (1 : ℝ) else (-1 : ℝ)) * + (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) (q' i'.succ)).re : ℝ)) → ((p0.2 - pN.2 = (if + e' = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) (q' + i'.succ)).im : ℝ)) → (∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (R : Fin (3 : ℕ) → Bool + → ProtoTile), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + ∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra + let μ : Int := if e' = true then -1 else 1 + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 + (GaussianRealPoint ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v) = -((if e' = + true then (1 : ℝ) else -1) • GaussianRealPoint (BandVectors.1 (q' 0) (q' i'.succ)))) + → ((TileCentroid N - TileCentroid T₀ = GaussianRealPoint ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v)) → ( + let shift : GaussianInt := (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v + let Pshift : ProtoTile := TileTranslation (cert.P j s) shift + (BandPrototile (q j.succ) Pshift) → ((TileCentroid Pshift = TileCentroid (cert.P j s) + + GaussianRealPoint shift) → ((TileCentroid (R j s) = TileCentroid Pshift) → (((R j + s).cells = Pshift.cells) → ((T.cells = Pshift.cells) → ((FootprintVertices T = + FootprintVertices Pshift) → ((GaussianRealPoint ((m : GaussianInt) * BandVectors.2 (q + 0) (q 1) + (n : GaussianInt) * BandVectors.2 (q 0) (q 2)) = -((if e' = true then (1 : + ℝ) else -1) • GaussianRealPoint (BandVectors.2 (q' 0) (q' i'.succ)))) → ((pN.1 - + p0.1, pN.2 - p0.2) = -((if e' = true then (1 : ℝ) else -1) • GaussianRealPoint + (BandVectors.2 (q' 0) (q' i'.succ)))))))))))))))) ) := by + classical + intro q cfg C₀ T₀ cert N T pN p0 q' i' e' hq'0 hcentAdj hslopeAdj1 hslopeAdj2 i'' s R r j ra k + μ m n hgeom hNcent shift Pshift hbandShift hPshiftCent hlayoutCent hlayoutCells hcellsT + hfootT hSlopePeriod + rw [hq'0] + apply Prod.ext + · change pN.1 - p0.1 = _ + rw [hq'0] at hslopeAdj1 + cases e' <;> simp [GaussianRealPoint] at hslopeAdj1 ⊢ <;> linarith + · change pN.2 - p0.2 = _ + rw [hq'0] at hslopeAdj2 + cases e' <;> simp [GaussianRealPoint] at hslopeAdj2 ⊢ <;> linarith + +private theorem hSlopeShift : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (pN : ℝ × ℝ), ∀ (p0 : ℝ × ℝ), ∀ (q' : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), ∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra + let μ : Int := if e' = true then -1 else 1 + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 + (GaussianRealPoint ((m : GaussianInt) * BandVectors.2 (q 0) (q 1) + (n : GaussianInt) * + BandVectors.2 (q 0) (q 2)) = -((if e' = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.2 (q' 0) (q' i'.succ)))) → (((pN.1 - p0.1, pN.2 - + p0.2) = -((if e' = true then (1 : ℝ) else -1) • GaussianRealPoint (BandVectors.2 (q' + 0) (q' i'.succ)))) → (GaussianRealPoint ((m : GaussianInt) * BandVectors.2 (q 0) (q + 1) + (n : GaussianInt) * BandVectors.2 (q 0) (q 2)) = (pN.1 - p0.1, pN.2 - p0.2))) ) + := by + classical + intro q pN p0 q' i' e' ra k μ m n hSlopePeriod hAdjSlope + rw [hSlopePeriod, hAdjSlope] + +private theorem hslopeActual : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (rH : Fin (3 : ℕ) → Bool + → PartialOdometer), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + (h = rH j s) → (∀ (ps : ℝ × ℝ), (PartialOdometerSlope (rH j s) = some ps) → + (PartialOdometerSlope h = some ps)) ) := by + classical + intro h i'' s rH r j hfunEq ps hps + rw [hfunEq] + exact hps + +private theorem hslopeOffset : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (pN : ℝ × ℝ), ∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ + (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + ∀ (ps : ℝ × ℝ), (ps.1 - pN.1 = (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (j + (2 : Fin (3 : ℕ))).succ) (q (j + (1 : Fin (3 : + ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (j + (2 : Fin (3 : ℕ))).succ) (q (j + (1 : + Fin (3 : ℕ))).succ)).im : ℝ))) → ((ps.2 - pN.2 = (if s = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (j + (2 : Fin (3 : ℕ))).succ) (q (j + (1 : + Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (j + (2 : Fin (3 : ℕ))).succ) (q + (j + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (ps - pN = (if s = true then (1 : ℝ) else + -1) • P4250T1SlopeOffset (BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))))) ) + := by + classical + intro q pN i'' s r j ps hpx hpy + apply Prod.ext + · change ps.1 - pN.1 = (if s = true then (1 : ℝ) else -1) * + ((((BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))).re : ℝ) - + ((BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))).im : ℝ)) / 2) + rw [hpx] + ring + · change ps.2 - pN.2 = (if s = true then (1 : ℝ) else -1) * + ((((BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))).im : ℝ) + + ((BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))).re : ℝ)) / 2) + rw [hpy] + ring + +private theorem hslopeFinal : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (pN : ℝ × ℝ), ∀ (p0 : ℝ × ℝ), ∀ (i' : Fin (3 : ℕ)), + ∀ (e' : Bool), ∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + ∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra + let μ : Int := if e' = true then -1 else 1 + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 + (GaussianRealPoint ((m : GaussianInt) * BandVectors.2 (q 0) (q 1) + (n : GaussianInt) * + BandVectors.2 (q 0) (q 2)) = (pN.1 - p0.1, pN.2 - p0.2)) → (∀ (ps : ℝ × ℝ), (ps - pN + = (if s = true then (1 : ℝ) else -1) • P4250T1SlopeOffset (BandVectors.2 (q ((j + + 2).succ)) (q ((j + 1).succ)))) → (ps - p0 = (if s = true then (1 : ℝ) else -1) • + P4250T1SlopeOffset (BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))) + + GaussianRealPoint ((m : GaussianInt) * BandVectors.2 (q 0) (q 1) + (n : GaussianInt) + * BandVectors.2 (q 0) (q 2)))) ) := by + classical + intro q pN p0 i' e' i'' s r j ra k μ m n hSlopeShift ps hslopeOffset + calc + ps - p0 = (ps - pN) + (pN - p0) := by ext <;> simp + _ = _ := by rw [hslopeOffset, hSlopeShift]; ext <;> rfl + +private theorem labelExists : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), ∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra + let μ : Int := if e' = true then -1 else 1 + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 + let shift : GaussianInt := (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v + let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + ∀ (kk : Fin 3), ∀ (t : Bool), ∃ l : SixSubtileLabel, slot l = (kk, t) ∧ + SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨l, m, n⟩ = TileTranslation + (cert.P kk t) shift ) := by + classical + intro q cfg C₀ T₀ cert i' e' ra k μ m n shift slot kk t + fin_cases kk <;> cases t + all_goals first + | refine ⟨.A, rfl, ?_⟩ + | refine ⟨.B, rfl, ?_⟩ + | refine ⟨.C, rfl, ?_⟩ + | refine ⟨.D, rfl, ?_⟩ + | refine ⟨.E, rfl, ?_⟩ + | refine ⟨.F, rfl, ?_⟩ + all_goals simp [SubtileOccurrenceInterpretation, shift] + +private theorem hshiftNonemptyAt458 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), ∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ + (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + ∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra + let μ : Int := if e' = true then -1 else 1 + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 + let shift : GaussianInt := (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v + let Pshift : ProtoTile := TileTranslation (cert.P j s) shift + ((cert.P j s).cells.Nonempty) → (Pshift.cells.Nonempty) ) := by + classical + intro q cfg C₀ T₀ cert i' e' i'' s r j ra k μ m n shift Pshift hparentNonempty + by_contra he + have hempty : Pshift.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp he + have hsource : (cert.P j s).cells = ∅ := + (TileTranslationFormulas (cert.P j s) shift).2.2.1.mp hempty + rcases hparentNonempty with ⟨x, hx⟩ + rw [hsource] at hx + simp at hx + +private theorem hmn : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (N : ProtoTile), ∀ (T : ProtoTile), ∀ (pN : ℝ × ℝ), ∀ (p0 : ℝ × ℝ), ∀ (q' : + Fin (4 : ℕ) → CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), (TileCentroid + T₀ - TileCentroid N = (if e' = true then (1 : ℝ) else (-1 : ℝ)) • GaussianRealPoint + (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' i'.succ))) → ((p0.1 - pN.1 = (if e' = true + then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) (q' + i'.succ)).re : ℝ)) → ((p0.2 - pN.2 = (if e' = true then (1 : ℝ) else (-1 : ℝ)) * + (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) (q' i'.succ)).im : ℝ)) → (∀ (i'' : Fin (3 : + ℕ)), ∀ (s : Bool), ∀ (R : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + ∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra + let μ : Int := if e' = true then -1 else 1 + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 + (GaussianRealPoint ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v) = -((if e' = + true then (1 : ℝ) else -1) • GaussianRealPoint (BandVectors.1 (q' 0) (q' i'.succ)))) + → ((TileCentroid N - TileCentroid T₀ = GaussianRealPoint ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v)) → ( + let shift : GaussianInt := (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v + let Pshift : ProtoTile := TileTranslation (cert.P j s) shift + (BandPrototile (q j.succ) Pshift) → ((TileCentroid Pshift = TileCentroid (cert.P j s) + + GaussianRealPoint shift) → ((TileCentroid (R j s) = TileCentroid Pshift) → (((R j + s).cells = Pshift.cells) → ((T.cells = Pshift.cells) → ((FootprintVertices T = + FootprintVertices Pshift) → ((GaussianRealPoint ((m : GaussianInt) * BandVectors.2 (q + 0) (q 1) + (n : GaussianInt) * BandVectors.2 (q 0) (q 2)) = -((if e' = true then (1 : + ℝ) else -1) • GaussianRealPoint (BandVectors.2 (q' 0) (q' i'.succ)))) → (((pN.1 - + p0.1, pN.2 - p0.2) = -((if e' = true then (1 : ℝ) else -1) • GaussianRealPoint + (BandVectors.2 (q' 0) (q' i'.succ)))) → ((GaussianRealPoint ((m : GaussianInt) * + BandVectors.2 (q 0) (q 1) + (n : GaussianInt) * BandVectors.2 (q 0) (q 2)) = (pN.1 - + p0.1, pN.2 - p0.2)) → (∀ (ps : ℝ × ℝ), (ps - p0 = (if s = true then (1 : ℝ) else -1) + • P4250T1SlopeOffset (BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))) + + GaussianRealPoint ((m : GaussianInt) * BandVectors.2 (q 0) (q 1) + (n : GaussianInt) + * BandVectors.2 (q 0) (q 2))) → ( + let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + (∀ (kk : Fin 3), ∀ (t : Bool), ∃ l : SixSubtileLabel, slot l = (kk, t) ∧ + SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨l, m, n⟩ = TileTranslation + (cert.P kk t) shift) → (∀ (l : SixSubtileLabel), (SubtileOccurrenceInterpretation + cert.P cert.u cert.v (⟨l, m, n⟩ : PeriodicSubtileIndex) = TileTranslation (cert.P j + s) shift) → ( + let a : PeriodicSubtileIndex := ⟨l, m, n⟩ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a = Pshift) → + ((Pshift.cells.Nonempty) → ((TileCentroid T = TileCentroid Pshift) → (m ≠ 0 ∨ n ≠ + 0)))))))))))))))))))) ) := by + classical + intro q cfg C₀ T₀ cert N T pN p0 q' i' e' hcentAdj hslopeAdj1 hslopeAdj2 i'' s R r j ra k μ m n + hgeom hNcent shift Pshift hbandShift hPshiftCent hlayoutCent hlayoutCells hcellsT hfootT + hSlopePeriod hAdjSlope hSlopeShift ps hslopeFinal slot labelExists l hocc a hoccTile + hshiftNonempty hcentroidT + have hkvals : k.val = 0 ∨ k.val = 1 ∨ k.val = 2 := by omega + rcases hkvals with hk | hk | hk + · have hh : k = 0 := Fin.ext hk + left + cases e' <;> norm_num [m, μ, hh] + · have hh : k = 1 := Fin.ext hk + right + cases e' <;> norm_num [n, μ, hh] + · have hh : k = 2 := Fin.ext hk + left + have hμ : μ ≠ 0 := by cases e' <;> simp [μ] + have hm : m = -μ := by simp [m, hh] + rw [hm] + exact neg_ne_zero.mpr hμ + +end RightCoordinateGeometry + +theorem P4261T1RightCoordinates + {q : Fin 4 → CircleCoordinates} {cfg : BandOrderedGeneralConfiguration q} + {C₀ : BandCircle} {T₀ : ProtoTile} + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T₀) + (N : ProtoTile) (hN h₀ : PartialOdometer) + (hadj : RightLatticeAdjacent C₀ N T₀ hN h₀) + (C : BandCircle) (T : ProtoTile) (h : PartialOdometer) + (hsub : TileSubodometer C₀.1.1 C.1.1 N T hN h) : + ∃ a : PeriodicSubtileIndex, (a.first ≠ 0 ∨ a.second ≠ 0) ∧ + Nonempty (P4261T1PlacedOdometer cert h₀ C T h a) := by +-- BODY + classical + rcases hadj with ⟨hON, hO0, pN, p0, hpN, hp0, q', i', e', hq', hq'0, + hcentAdj, hslopeAdj1, hslopeAdj2⟩ + have hroot : TileOdometer C₀.1.1 N hN := hON + have hcurv₀ : 1 < C₀.1.1.1 := RightCoordinateGeometry.hcurv₀ q cfg C₀ T₀ cert + obtain ⟨q'', i'', s, S', hs', hproper'', hq''0, hq''i, + hband₀, hchild', hcells', hfoot', hcent', hdom', hvalue', hcompat', hslope', + hselectedCells, hselectedDomain, hselectedValue⟩ := + TileSubodometerLiteralDecompositionPiece C₀ C N T hN h + hcurv₀ hsub + obtain ⟨R, rH, hbandRoot, hrootChildren, hrootCells, hrootFoot, + hrootCent, hrootDomain, hrootValue, hrootCompat, hrootSlope⟩ := + TileOdometerReindexedDecomposition q cfg.proper N hN + (by simpa [cert.child_eq] using hcurv₀) (by simpa [cert.child_eq] using hroot) + obtain ⟨r, hrotate, _⟩ := + BandPredecessorNoCollision q q'' cfg.proper hproper'' + (by rw [cert.child_eq, hq''0]) + let j : Fin 3 := i'' + r + have hparent : q'' i''.succ = q j.succ := by + simpa [j] using hrotate i'' + have hvector := RightCoordinateGeometry.hvector q C T h q'' i'' s S' hs' hq''i hselectedCells + hselectedDomain hselectedValue r hrotate hparent + have hslopeVector := RightCoordinateGeometry.hslopeVector q C T h q'' i'' s S' hs' hq''i + hselectedCells hselectedDomain hselectedValue r hrotate hparent hvector + have hsCent := RightCoordinateGeometry.hsCent q N q'' i'' s S' hcent' R hrootCent r hvector + have hbandSelected := RightCoordinateGeometry.hbandSelected q q'' i'' s S' hs' hchild' r hparent + have hbandFresh : BandPrototile (q j.succ) (R j s) := + TileOdometerBandPrototile _ _ _ (hrootChildren j s) + have hselectedCellsFresh : (S' i'' s).cells = (R j s).cells := + (BandPrototileCentroidUnique (q j.succ) _ _ hbandSelected hbandFresh hsCent).1 + obtain ⟨ra, hrotateA, _⟩ := + BandPredecessorNoCollision q q' cfg.proper hq' + (by rw [cert.child_eq, hq'0]) + let k : Fin 3 := i' + ra + have hAdjChild : q' i'.succ = q k.succ := by simpa [k] using hrotateA i' + let μ : Int := if e' = true then -1 else 1 + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 + have hforms := P3055T1ParentVectorNormalForms q cfg + have hgeom := RightCoordinateGeometry.hgeom q cfg C₀ T₀ cert N pN p0 q' i' e' hq'0 hcentAdj + hslopeAdj1 hslopeAdj2 ra hAdjChild hforms + have hNcent := RightCoordinateGeometry.hNcent q cfg C₀ T₀ cert N q' i' e' hq'0 hcentAdj ra hgeom + have hlayoutOcc := cert.outer_occurrence j s + have hbandLayout : BandPrototile (q j.succ) (cert.P j s) := hlayoutOcc.1 + let shift : GaussianInt := (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v + let Pshift : ProtoTile := TileTranslation (cert.P j s) shift + have hbandShift : BandPrototile (q j.succ) Pshift := + BandPrototileTranslation (q j.succ) (cert.P j s) shift hbandLayout + have hPshiftCent := RightCoordinateGeometry.hPshiftCent q cfg C₀ T₀ cert i' e' i'' s r ra + have hlayoutCent := RightCoordinateGeometry.hlayoutCent q cfg C₀ T₀ cert N i' e' i'' s R + hrootCent r ra hNcent hlayoutOcc hPshiftCent + have hlayoutCells : (R j s).cells = Pshift.cells := + (BandPrototileCentroidUnique (q j.succ) _ _ hbandFresh hbandShift hlayoutCent).1 + have hparentNonempty := RightCoordinateGeometry.hparentNonempty q cfg C₀ T₀ cert i'' s r + have hselectedNonempty := RightCoordinateGeometry.hselectedNonempty q cfg C₀ T₀ cert T i' e' + i'' s S' hselectedCells R r hselectedCellsFresh ra hlayoutCells hparentNonempty + have hcellsT : T.cells = Pshift.cells := RightCoordinateGeometry.hcellsT q cfg C₀ T₀ cert T i' + e' i'' s S' hselectedCells R r hselectedCellsFresh ra hlayoutCells + have hfootT : FootprintVertices T = FootprintVertices Pshift := RightCoordinateGeometry.hfootT + q cfg C₀ T₀ cert T i' e' i'' s r ra hparentNonempty hselectedNonempty hcellsT + have hchildPositive := RightCoordinateGeometry.hchildPositive q cfg C₀ i'' r + have hdomainT : (h.domain : Set GaussianInt) = FootprintVertices T := + PositiveCurvatureTileOdometerDomain C.1.1 T h C.property hsub.2.1 + have hdomainFresh := RightCoordinateGeometry.hdomainFresh q i'' s R rH hrootChildren r + hchildPositive + have hdomainSelected := RightCoordinateGeometry.hdomainSelected q q'' i'' s S' hs' hchild' r + hparent hchildPositive + have hdomainSelFresh := RightCoordinateGeometry.hdomainSelFresh T i'' s S' hs' hselectedCells R + rH r hselectedCellsFresh hselectedNonempty hdomainFresh hdomainSelected + have hdomainSuppliedFresh := RightCoordinateGeometry.hdomainSuppliedFresh h i'' s hs' + hselectedDomain rH r hdomainSelFresh + have hvalueSuppliedFresh := RightCoordinateGeometry.hvalueSuppliedFresh hN h i'' s hs' hvalue' + hselectedDomain hselectedValue rH hrootValue r hdomainSuppliedFresh + have hfunEq := RightCoordinateGeometry.hfunEq C₀ N hN C T h hsub i'' s hs' hselectedDomain + hselectedValue rH r hdomainT hdomainSuppliedFresh hvalueSuppliedFresh + have hsumA := RightCoordinateGeometry.hsumA q cfg + have hsumAPoint := congrArg GaussianRealPoint hsumA + simp? [GaussianRealPoint] at hsumAPoint + have hsumARe := RightCoordinateGeometry.hsumARe q hsumAPoint + have hsumAIm := RightCoordinateGeometry.hsumAIm q hsumAPoint + have hSlopePeriod := RightCoordinateGeometry.hSlopePeriod q cfg C₀ T₀ cert N T pN p0 q' i' e' + hq'0 hcentAdj hslopeAdj1 hslopeAdj2 i'' s R r ra hAdjChild hgeom hNcent hbandShift + hPshiftCent hlayoutCent hlayoutCells hcellsT hfootT hsumARe hsumAIm + have hAdjSlope := RightCoordinateGeometry.hAdjSlope q cfg C₀ T₀ cert N T pN p0 q' i' e' hq'0 + hcentAdj hslopeAdj1 hslopeAdj2 i'' s R r ra hgeom hNcent hbandShift hPshiftCent hlayoutCent + hlayoutCells hcellsT hfootT hSlopePeriod + have hSlopeShift := RightCoordinateGeometry.hSlopeShift q pN p0 q' i' e' ra hSlopePeriod hAdjSlope + rcases hrootSlope j s with hzero | ⟨p, ps, hp, hps, hpx, hpy⟩ + · have hpos := cfg.noLine j.succ + omega + have hpEq : p = pN := Option.some.inj (hp.symm.trans hpN) + subst p + have hslopeActual := RightCoordinateGeometry.hslopeActual h i'' s rH r hfunEq ps hps + have hslopeOffset := RightCoordinateGeometry.hslopeOffset q pN i'' s r ps hpx hpy + have hslopeFinal : ps - p0 = + (if s = true then (1 : ℝ) else -1) • + P4250T1SlopeOffset (BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))) + + GaussianRealPoint ((m : GaussianInt) * BandVectors.2 (q 0) (q 1) + + (n : GaussianInt) * BandVectors.2 (q 0) (q 2)) := RightCoordinateGeometry.hslopeFinal q + pN p0 i' e' i'' s r ra hSlopeShift ps hslopeOffset + let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + have labelExists : ∀ (kk : Fin 3) (t : Bool), + ∃ l : SixSubtileLabel, + slot l = (kk, t) ∧ + SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨l, m, n⟩ = + TileTranslation (cert.P kk t) shift := RightCoordinateGeometry.labelExists q cfg C₀ + T₀ cert i' e' ra + obtain ⟨l, hl, hocc⟩ := labelExists j s + let a : PeriodicSubtileIndex := ⟨l, m, n⟩ + have hoccTile : SubtileOccurrenceInterpretation cert.P cert.u cert.v a = Pshift := by + simpa [a, Pshift] using hocc + have hshiftNonempty : Pshift.cells.Nonempty := RightCoordinateGeometry.hshiftNonemptyAt458 q + cfg C₀ T₀ cert i' e' i'' s r ra hparentNonempty + have hcentroidT : TileCentroid T = TileCentroid Pshift := by + simp [TileCentroid, hshiftNonempty, hcellsT] + have hmn : m ≠ 0 ∨ n ≠ 0 := RightCoordinateGeometry.hmn q cfg C₀ T₀ cert N T pN p0 q' i' e' + hcentAdj hslopeAdj1 hslopeAdj2 i'' s R r ra hgeom hNcent hbandShift hPshiftCent hlayoutCent + hlayoutCells hcellsT hfootT hSlopePeriod hAdjSlope hSlopeShift ps hslopeFinal labelExists l + hocc hoccTile hshiftNonempty hcentroidT + refine ⟨a, ?_, ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩⟩ + · simp only [a] + rcases hmn with hm | hn + · exact Or.inl hm + · exact Or.inr hn + · change C.1.1 = q (slot l).1.succ + have hCeq : C.1.1 = q j.succ := hq''i.symm.trans hparent + simpa only [hl] using hCeq + · exact hsub.2.1 + · rw [hcellsT, hoccTile] + · rw [hcentroidT, hoccTile] + · rw [hdomainT, hfootT, hoccTile] + · exact p0 + · exact ps + · exact hp0 + · exact hslopeActual + · change ps - p0 = + (if (slot l).2 then (1 : ℝ) else -1) • + P4250T1SlopeOffset + (BandVectors.2 (q (((slot l).1 + 2).succ)) (q (((slot l).1 + 1).succ))) + + GaussianRealPoint + ((a.first : GaussianInt) * BandVectors.2 (q 0) (q 1) + + (a.second : GaussianInt) * BandVectors.2 (q 0) (q 2)) + simp [a, hl, hslopeFinal] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean new file mode 100644 index 0000000000..e65b3a08d0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean @@ -0,0 +1,1293 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer +public import LeanPool.ApollonianSuperharmonic.P4261T1ExteriorIndices +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileCanonicalRows +public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms +public import LeanPool.ApollonianSuperharmonic.P3055T1SignedCentroidNormalForms +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P4261T1SubtileCoordinates] + +/-! +# P4261T1SubtileCoordinates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SubtileCoordinateGeometry + +private theorem hsuper : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let edge : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q ((k + 2).succ)) (q ((k + 1).succ)) + (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : + ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : + Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin + (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 + : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q + (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → (edge 0 + edge 1 + + edge 2 = 0) ) := by + classical + intro q edge hvlaws + dsimp [edge] + linear_combination hvlaws.1 + +private theorem hflip : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ( + let incoming : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q k.succ) (q 0) + let outgoing : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q 0) (q k.succ) + (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : + ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : + Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin + (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 + : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q + (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → (∀ k, outgoing k = + (⟨0, 1⟩ : GaussianInt) * incoming k)) ) := by + classical + intro q cfg incoming outgoing hvlaws k + simpa [outgoing, incoming] using (hvlaws.2.2.2.2 cfg.proper k).1 + +private theorem hu : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), + let outgoing : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q 0) (q k.succ) + cert.u = outgoing 0 ) := by + classical + intro q cfg C₀ T₀ cert outgoing + rw [cert.period_u] + rfl + +private theorem hv : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), + let outgoing : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q 0) (q k.succ) + cert.v = outgoing 1 ) := by + classical + intro q cfg C₀ T₀ cert outgoing + rw [cert.period_v] + rfl + +private theorem hcentroidRows : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), + let edge : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q ((k + 2).succ)) (q ((k + 1).succ)) + ∀ k, ∀ e, TileCentroid (cert.P k e) - TileCentroid T₀ = (if e = true then (1 : ℝ) else + -1) • ((1 / 2 : ℝ) • (GaussianRealPoint (edge k) - (-((GaussianRealPoint (edge + k)).2), (GaussianRealPoint (edge k)).1))) ) := by + classical + intro q cfg C₀ T₀ cert edge k e + simpa [edge] using (cert.outer_occurrence k e).2.2 + +private theorem rows : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (i' : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + let edge : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q ((k + 2).succ)) (q ((k + 1).succ)) + let incoming : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q k.succ) (q 0) + let outgoing : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q 0) (q k.succ) + (edge 0 + edge 1 + edge 2 = 0) → ((incoming 0 = edge 1 - (⟨0, 1⟩ : GaussianInt) * edge 2) + → ((incoming 1 = edge 2 - (⟨0, 1⟩ : GaussianInt) * edge 0) → ((incoming 2 = edge 0 - + (⟨0, 1⟩ : GaussianInt) * edge 1) → ((∀ k, outgoing k = (⟨0, 1⟩ : GaussianInt) * + incoming k) → ((cert.u = outgoing 0) → ((cert.v = outgoing 1) → ((∀ k, ∀ e, + TileCentroid (cert.P k e) - TileCentroid T₀ = (if e = true then (1 : ℝ) else -1) • + ((1 / 2 : ℝ) • (GaussianRealPoint (edge k) - (-((GaussianRealPoint (edge k)).2), + (GaussianRealPoint (edge k)).1)))) → ( + let uIndex := if j = (0 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if + s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if j = (1 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : + Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) + else if s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if s = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.E, (-1 : + ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (2 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); + let vIndex := if j = (0 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if + s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if j = (1 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : + Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else + if s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if s = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.A, (-1 : + ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (2 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); + let U := SubtileOccurrenceInterpretation cert.P cert.u cert.v uIndex; + let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v vIndex; TileCentroid U - + TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ^ (↑s : ℕ) * (incoming j + outgoing j)) ∧ TileCentroid V - TileCentroid T₀ = (1 / 2 : + ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : + ℕ) then incoming (j + (1 : Fin (3 : ℕ))) - outgoing (j + (1 : Fin (3 : ℕ))) else + outgoing (j - (1 : Fin (3 : ℕ))) - incoming (j - (1 : Fin (3 : ℕ)))))))))))) ) := by + classical + intro q cfg C₀ T₀ cert i' s r j edge incoming outgoing hsuper hin0 hin1 hin2 hflip hu hv + hcentroidRows + exact BandOrderedGeneralSubtileCanonicalRows + cert.P T₀ cert.u cert.v j s edge incoming outgoing hsuper hin0 hin1 hin2 + hflip hu hv hcentroidRows + +private theorem tableFacts : + (by + classical + exact + let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => + if k = 0 then + if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ + else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ + else if k = 1 then + if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ + else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ + else + if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ + else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ + let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + ∀ (k : Fin 3), ∀ (t : Fin 4), ∀ (b : PeriodicSubtileIndex), (b = makeIndex k t) → (b ∈ + P4261T1ExteriorIndices ∧ (slot b.label).1 = k ∧ (slot b.label).2 = (if b.label = .A + ∨ b.label = .C ∨ b.label = .E then true else false)) ) := by + classical + intro makeIndex slot k t b hb + subst b + fin_cases k <;> fin_cases t <;> + simp [makeIndex, slot, P4261T1ExteriorIndices] + +private theorem hslot : + (by + classical + exact + ∀ (i' : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => + if k = 0 then + if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ + else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ + else if k = 1 then + if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ + else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ + else + if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ + else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ + let a : PeriodicSubtileIndex := makeIndex j s + let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + (a ∈ P4261T1ExteriorIndices ∧ (slot a.label).1 = j ∧ (slot a.label).2 = if a.label = + SixSubtileLabel.A ∨ a.label = SixSubtileLabel.C ∨ a.label = SixSubtileLabel.E then + true else false) → ((slot a.label).1 = j ∧ (slot a.label).2 = (if a.label = .A ∨ + a.label = .C ∨ a.label = .E then true else false)) ) := by + classical + intro i' s r j makeIndex a slot htable + exact ⟨htable.2.1, htable.2.2⟩ + +private theorem hrowCentroid : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (i' : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + let incoming : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q k.succ) (q 0) + let outgoing : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q 0) (q k.succ) + ( + let uIndex := if j = (0 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if + s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if j = (1 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : + Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) + else if s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if s = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.E, (-1 : + ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (2 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); + let vIndex := if j = (0 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if + s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) else if j = (1 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) + then (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : + Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else + if s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) else if s = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.A, (-1 : + ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin (4 : ℕ)) then + (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (2 : Fin + (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else + (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); + let U := SubtileOccurrenceInterpretation cert.P cert.u cert.v uIndex; + let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v vIndex; TileCentroid U - + TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ^ (↑s : ℕ) * (incoming j + outgoing j)) ∧ TileCentroid V - TileCentroid T₀ = (1 / 2 : + ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : + ℕ) then incoming (j + (1 : Fin (3 : ℕ))) - outgoing (j + (1 : Fin (3 : ℕ))) else + outgoing (j - (1 : Fin (3 : ℕ))) - incoming (j - (1 : Fin (3 : ℕ))))) → ( + let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => + if k = 0 then + if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ + else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ + else if k = 1 then + if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ + else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ + else + if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ + else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ + let a : PeriodicSubtileIndex := makeIndex j s + TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * (incoming j + + outgoing j))) ) := by + classical + intro q cfg C₀ T₀ cert i' s r j incoming outgoing rows makeIndex a + simpa [a, j, incoming, outgoing] using rows.1 + +private theorem hsuppliedCentroid : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (T : ProtoTile), ∀ (q' : Fin (4 : ℕ) → CircleCoordinates), ∀ (i' : Fin (3 : + ℕ)), ∀ (s : Fin (4 : ℕ)), (q' (0 : Fin (4 : ℕ)) = C₀.1.1) → ((TileCentroid T - + TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ^ (↑s : ℕ) * (BandVectors.1 (q' i'.succ) (q' (0 : Fin (4 : ℕ))) + BandVectors.1 (q' + (0 : Fin (4 : ℕ))) (q' i'.succ)))) → (∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + (q' i'.succ = q j.succ) → ( + let incoming : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q k.succ) (q 0) + let outgoing : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q 0) (q k.succ) + let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => + if k = 0 then + if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ + else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ + else if k = 1 then + if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ + else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ + else + if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ + else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ + let a : PeriodicSubtileIndex := makeIndex j s + (TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) - TileCentroid T₀ + = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * (incoming j + + outgoing j))) → (TileCentroid T = TileCentroid (SubtileOccurrenceInterpretation + cert.P cert.u cert.v a))))) ) := by + classical + intro q cfg C₀ T₀ cert T q' i' s hq₀ hcent r j hparent incoming outgoing makeIndex a hrowCentroid + have hcent' : TileCentroid T - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (incoming j + outgoing j)) := by + have h := hcent + rw [hparent, hq₀, ← cert.child_eq] at h + simpa [incoming, outgoing, j] using h + calc + TileCentroid T = (TileCentroid T - TileCentroid T₀) + TileCentroid T₀ := by abel + _ = (TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) - + TileCentroid T₀) + TileCentroid T₀ := by rw [hcent', hrowCentroid] + _ = TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) := by abel + +private theorem hparentNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ k, ∀ e, (cert.P k e).cells.Nonempty ) := by + classical + intro q cfg C₀ T₀ cert k e + rcases cert.parent_lattice k e with ⟨realization⟩ + have hball : (0 : ℝ × ℝ) ∈ Metric.closedBall (0 : ℝ × ℝ) 1 := by simp + have hreal : (realization ⟨0, hball⟩ : ℝ × ℝ) ∈ TileRealization (cert.P k e) := + (realization ⟨0, hball⟩).property + simp only [TileRealization, Set.mem_iUnion] at hreal + rcases hreal with ⟨x, hx, _⟩ + exact ⟨x, hx⟩ + +private theorem hbandOcc : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (T : ProtoTile), ∀ (i' : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (r : Fin (3 : + ℕ)), + let j : Fin 3 := i' + r + let incoming : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q k.succ) (q 0) + let outgoing : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q 0) (q k.succ) + let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => + if k = 0 then + if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ + else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ + else if k = 1 then + if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ + else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ + else + if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ + else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ + let a : PeriodicSubtileIndex := makeIndex j s + let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + (a ∈ P4261T1ExteriorIndices ∧ (slot a.label).1 = j ∧ (slot a.label).2 = if a.label = + SixSubtileLabel.A ∨ a.label = SixSubtileLabel.C ∨ a.label = SixSubtileLabel.E then + true else false) → ((a ∈ P4261T1ExteriorIndices) → (((slot a.label).1 = j ∧ (slot + a.label).2 = (if a.label = .A ∨ a.label = .C ∨ a.label = .E then true else false)) → + ((TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) - + TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (incoming j + outgoing j))) → ((TileCentroid T = TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a)) → (BandPrototile (q (slot + a.label).1.succ) (SubtileOccurrenceInterpretation cert.P cert.u cert.v a)))))) ) := by + classical + intro q cfg C₀ T₀ cert T i' s r j incoming outgoing makeIndex a slot htable ha hslot + hrowCentroid hsuppliedCentroid + rcases a with ⟨lab, m, n⟩ + cases lab <;> simp only [SubtileOccurrenceInterpretation, slot] <;> + exact BandPrototileTranslation _ _ _ (cert.outer_occurrence _ _).1 + +private theorem hbandT : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : + PartialOdometer), (TileOdometer C.1.1 T h) → (∀ (q' : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), (q' i'.succ = C.1.1) → (∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + (q' i'.succ = q j.succ) → (BandPrototile (q j.succ) T))) ) := by + classical + intro q C T h hchild q' i' hqi r j hparent + have heq : C.1.1 = q j.succ := hqi.symm.trans hparent + rw [← heq] + exact TileOdometerBandPrototile _ _ _ hchild + +private theorem hcells : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (T : ProtoTile), ∀ (i' : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (r : Fin (3 : + ℕ)), + let j : Fin 3 := i' + r + let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => + if k = 0 then + if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ + else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ + else if k = 1 then + if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ + else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ + else + if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ + else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ + let a : PeriodicSubtileIndex := makeIndex j s + let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + ((slot a.label).1 = j ∧ (slot a.label).2 = (if a.label = .A ∨ a.label = .C ∨ a.label = .E + then true else false)) → ((TileCentroid T = TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a)) → ((BandPrototile (q (slot + a.label).1.succ) (SubtileOccurrenceInterpretation cert.P cert.u cert.v a)) → + ((BandPrototile (q j.succ) T) → (T.cells = (SubtileOccurrenceInterpretation cert.P + cert.u cert.v a).cells)))) ) := by + classical + intro q cfg C₀ T₀ cert T i' s r j makeIndex a slot hslot hsuppliedCentroid hbandOcc hbandT + exact (BandPrototileCentroidUnique (q j.succ) T _ hbandT + (by simpa [hslot.1] using hbandOcc) hsuppliedCentroid).1 + +private theorem hoccNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (T : ProtoTile), ∀ (i' : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (r : Fin (3 : + ℕ)), + let j : Fin 3 := i' + r + let incoming : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q k.succ) (q 0) + let outgoing : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q 0) (q k.succ) + let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => + if k = 0 then + if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ + else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ + else if k = 1 then + if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ + else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ + else + if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ + else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ + let a : PeriodicSubtileIndex := makeIndex j s + let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + (a ∈ P4261T1ExteriorIndices ∧ (slot a.label).1 = j ∧ (slot a.label).2 = if a.label = + SixSubtileLabel.A ∨ a.label = SixSubtileLabel.C ∨ a.label = SixSubtileLabel.E then + true else false) → ((a ∈ P4261T1ExteriorIndices) → (((slot a.label).1 = j ∧ (slot + a.label).2 = (if a.label = .A ∨ a.label = .C ∨ a.label = .E then true else false)) → + ((TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) - + TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (incoming j + outgoing j))) → ((TileCentroid T = TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a)) → ((∀ k, ∀ e, (cert.P k + e).cells.Nonempty) → ((BandPrototile (q (slot a.label).1.succ) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a)) → ((T.cells = + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells) → + ((SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells.Nonempty)))))))) ) := by + classical + intro q cfg C₀ T₀ cert T i' s r j incoming outgoing makeIndex a slot htable ha hslot + hrowCentroid hsuppliedCentroid hparentNonempty hbandOcc hcells + rcases a with ⟨lab, m, n⟩ + cases lab <;> + rcases hparentNonempty _ _ with ⟨x, hx⟩ <;> + refine ⟨GaussianTranslation ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v) x, + ?_⟩ <;> + simpa [SubtileOccurrenceInterpretation, TileTranslation, Finset.mem_image] using + (show ∃ y ∈ (cert.P _ _).cells, + GaussianTranslation ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v) y = + GaussianTranslation ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v) x from + ⟨x, hx, rfl⟩) + +private theorem hfoot : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (T : ProtoTile), ∀ (i' : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (r : Fin (3 : + ℕ)), + let j : Fin 3 := i' + r + let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => + if k = 0 then + if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ + else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ + else if k = 1 then + if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ + else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ + else + if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ + else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ + let a : PeriodicSubtileIndex := makeIndex j s + (T.cells = (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells) → + (((SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells.Nonempty) → + ((T.cells.Nonempty) → (FootprintVertices T = FootprintVertices + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a)))) ) := by + classical + intro q cfg C₀ T₀ cert T i' s r j makeIndex a hcells hoccNonempty hTNonempty + simp only [FootprintVertices, ite_eq_left hTNonempty, ite_eq_left hoccNonempty] + rw [hcells] + +private theorem hdomain : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T₀), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), (TileOdometer + C.1.1 T h) → (∀ (i' : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => + if k = 0 then + if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ + else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ + else if k = 1 then + if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ + else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ + else + if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ + else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ + let a : PeriodicSubtileIndex := makeIndex j s + (FootprintVertices T = FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u + cert.v a)) → ((h.domain : Set GaussianInt) = FootprintVertices + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a))) ) := by + classical + intro q cfg C₀ T₀ cert C T h hchild i' s r j makeIndex a hfoot + calc + (h.domain : Set GaussianInt) = FootprintVertices T := + PositiveCurvatureTileOdometerDomain C.1.1 T h C.property hchild + _ = FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) := hfoot + +private theorem hcircle : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (C : BandCircle), ∀ (q' : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), (q' i'.succ = C.1.1) → + (∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + (q' i'.succ = q j.succ) → ( + let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => + if k = 0 then + if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ + else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ + else if k = 1 then + if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ + else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ + else + if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ + else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ + let a : PeriodicSubtileIndex := makeIndex j s + let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + ((slot a.label).1 = j ∧ (slot a.label).2 = (if a.label = .A ∨ a.label = .C ∨ a.label = .E + then true else false)) → (C.1.1 = q (slot a.label).1.succ))) ) := by + classical + intro q C q' i' s hqi r j hparent makeIndex a slot hslot + rw [hslot.1] + exact hqi.symm.trans hparent + +private theorem hA13 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : + ℕ))) + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q + (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (q (3 : + Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin + (4 : ℕ))) + BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : + GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.2 (q (1 : Fin + (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 + (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple q → ∀ (j : Fin (3 + : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (0 : + Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (q + j.succ) (q (0 : Fin (4 : ℕ))))) → ( + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + BandVectors.2 (q 1) (q 3) = -A - B) ) := by + classical + intro q hvlaws A B + dsimp [A, B] + linear_combination hvlaws.2.1 + +private theorem hA01 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((BandVectors.1 + (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q + (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : + GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : Fin + (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : + ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : + ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 + : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (q 1) (q 3) = -A - B) → (BandVectors.2 (q 0) (q 1) = A + I * (A + B)))) ) + := by + classical + intro q cfg hvlaws I A B hA13 + have hin := hvlaws.2.2.2.1 + have hf := (hvlaws.2.2.2.2 cfg.proper 0).2 + calc + BandVectors.2 (q 0) (q 1) = + -(⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 1) (q 0) := hf + _ = -(⟨0, 1⟩ : GaussianInt) * + (BandVectors.2 (q 1) (q 3) + (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 2) (q 1)) := + by rw [hin] + _ = A + I * (A + B) := by rw [hA13]; dsimp [I, A, B]; ext <;> simp <;> ring + +private theorem hA02 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((BandVectors.1 + (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q + (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : + GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : Fin + (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : + ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : + ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 + : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → ((BandVectors.1 + (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (3 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 (![q (0 : Fin (4 : ℕ)), + q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) + (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (3 : Fin (4 : ℕ))) + BandVectors.1 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), + q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), + q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : + Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : + Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + + BandVectors.2 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 + : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 + : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) + BandVectors.2 (![q (0 : Fin + (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 + : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin + (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : + ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 + : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : + ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (![q (0 : Fin (4 : ℕ)), q + (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![q + (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 + : Fin (4 : ℕ))) ∧ BandVectors.2 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : + Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : + Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = + BandVectors.2 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 + : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 + : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin + (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : Fin + (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), + q (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (![q (0 : Fin (4 : ℕ)), q + (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![q + (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] + j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (![q (0 : Fin (4 : ℕ)), + q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] j.succ) (![q (0 : Fin + (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 + : ℕ))) ∧ BandVectors.2 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin + (4 : ℕ)), q (1 : Fin (4 : ℕ))] j.succ) (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q + (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + BandVectors.2 (q 0) (q 2) = B - I * A))) ) := by + classical + intro q cfg hvlaws hvlaws₂ I A B + have hin := hvlaws₂.2.2.2.1 + have hf := (hvlaws.2.2.2.2 cfg.proper 1).2 + have hin' : BandVectors.2 (q 2) (q 0) = A + I * B := by + simpa [A, B] using hin + calc + BandVectors.2 (q 0) (q 2) = + -(⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 2) (q 0) := hf + _ = -(⟨0, 1⟩ : GaussianInt) * (A + I * B) := by rw [hin'] + _ = B - I * A := by dsimp [I]; ext <;> simp <;> ring + +private theorem hA03 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((BandVectors.1 + (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q + (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : + GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : Fin + (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : + ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : + ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 + : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → ((BandVectors.1 + (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : + ℕ))] (3 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 + : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : + ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 (![![q (0 : Fin (4 : ℕ)), + q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q + (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 + : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 + : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : + Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![![q (0 : + Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin + (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin + (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin + (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin + (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (3 : Fin (4 : + ℕ))) + BandVectors.1 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : + ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : + ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.2 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q + (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q + (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q + (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q + (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 + : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q + (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q + (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q + (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 + : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 + : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 (![![q (0 : Fin + (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 + : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 + : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) + (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : + ℕ))] (3 : Fin (4 : ℕ))) + BandVectors.2 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : + ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : + ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) + = (0 : GaussianInt) ∧ BandVectors.1 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q + (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q + (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q + (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 + : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 + : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : ℕ)), q (2 + : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : + Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin + (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin + (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin + (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 + (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : + ℕ))] (1 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 + : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : + ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q + (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q + (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q + (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q + (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 + : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q + (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q + (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q + (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 + : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 + : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (![![q (0 : Fin + (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 + : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 + : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) + (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : + ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : + ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : + ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (![![q (0 : Fin (4 : ℕ)), q (2 : + Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : + Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin + (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin + (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin + (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![![q (0 : Fin + (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 + : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 + : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) + ∧ (ProperBandQuadruple ![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : + ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (![![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : + ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) + (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : + ℕ))] j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (![![q (0 : Fin (4 + : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : + ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] j.succ) (![![q (0 : + Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin + (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin + (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin + (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin + (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (0 : Fin (4 : + ℕ))) ∧ BandVectors.2 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : + ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : + ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : + ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : + ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : + ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : + ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : + Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : + Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : + Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin + (4 : ℕ))] (1 : Fin (4 : ℕ))] j.succ) (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q + (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q + (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q + (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 + : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 + : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (q 1) (q 3) = -A - B) → (BandVectors.2 (q 0) (q 3) = -A - B - I * B)))) ) + := by + classical + intro q cfg hvlaws hvlaws₃ I A B hA13 + have hin := hvlaws₃.2.2.2.1 + have hf := (hvlaws.2.2.2.2 cfg.proper 2).2 + have hin' : BandVectors.2 (q 3) (q 0) = B + I * (-A - B) := by + simpa [A, B, hA13, add_comm, add_left_comm, add_assoc] using hin + calc + BandVectors.2 (q 0) (q 3) = + -(⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 3) (q 0) := hf + _ = -(⟨0, 1⟩ : GaussianInt) * (B + I * (-A - B)) := by rw [hin'] + _ = -A - B - I * B := by dsimp [I]; ext <;> simp <;> ring + +private theorem hAedgeAux : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (q 1) (q 3) = -A - B) → (∀ (k : Fin 3), BandVectors.2 (q ((k + 2).succ)) + (q ((k + 1).succ)) = (![B, -A - B, A] : Fin 3 → GaussianInt) k) ) := by + classical + intro q A B hA13 k + fin_cases k <;> simp [A, B, hA13] + +private theorem hAroot : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (q 0) (q 1) = A + I * (A + B)) → ((BandVectors.2 (q 0) (q 2) = B - I * A) + → ((BandVectors.2 (q 0) (q 3) = -A - B - I * B) → (∀ k : Fin 3, BandVectors.2 (q 0) + (q k.succ) = (![A + I * (A + B), B - I * A, -A - B - I * B] : Fin 3 → GaussianInt) + k))) ) := by + classical + intro q I A B hA01 hA02 hA03 k + fin_cases k <;> simp [hA01, hA02, hA03] + +private theorem hrowPointAux : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => + if k = 0 then + if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ + else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ + else if k = 1 then + if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ + else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ + else + if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ + else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ + let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + (BandVectors.2 (q 0) (q 1) = A + I * (A + B)) → ((BandVectors.2 (q 0) (q 2) = B - I * A) + → ((∀ (k : Fin 3), BandVectors.2 (q ((k + 2).succ)) (q ((k + 1).succ)) = (![B, -A - + B, A] : Fin 3 → GaussianInt) k) → ((∀ k : Fin 3, BandVectors.2 (q 0) (q k.succ) = + (![A + I * (A + B), B - I * A, -A - B - I * B] : Fin 3 → GaussianInt) k) → (∀ (k : + Fin 3), ∀ (t : Fin 4), (1 / 2 : ℝ) • GaussianRealPoint ((-I) ^ t.val * (I * + BandVectors.2 (q 0) (q k.succ) + BandVectors.2 (q 0) (q k.succ))) = (if (slot + (makeIndex k t).label).2 then (1 : ℝ) else -1) • P4250T1SlopeOffset (BandVectors.2 + (q ((k + 2).succ)) (q ((k + 1).succ))) + GaussianRealPoint (((makeIndex k t).first : + GaussianInt) * BandVectors.2 (q 0) (q 1) + ((makeIndex k t).second : GaussianInt) * + BandVectors.2 (q 0) (q 2)))))) ) := by + classical + intro q makeIndex slot I A B hA01 hA02 hAedgeAux hAroot k t + rw [hAroot k, hAedgeAux k, hA01, hA02] + fin_cases k <;> fin_cases t <;> + simp [makeIndex, slot, A, B, I, GaussianRealPoint, pow_succ, + P4250T1SlopeOffset, -GaussianInt.intCast_re, + -GaussianInt.intCast_im] <;> ring_nf <;> trivial + +private theorem hflipAffine : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((BandVectors.1 + (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q + (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : + GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : Fin + (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : + ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : + ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 + : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + ∀ k : Fin 3, BandVectors.2 (q k.succ) (q 0) = I * BandVectors.2 (q 0) (q k.succ))) ) := by + classical + intro q cfg hvlaws I k + have hf := (hvlaws.2.2.2.2 cfg.proper k).2 + rw [hf] + dsimp [I] + ext <;> simp + +private theorem hslopePair : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (p₀ : ℝ × ℝ), ∀ (pᵢ : ℝ × ℝ), ∀ (i' : Fin (3 : ℕ)), + ∀ (s : Fin (4 : ℕ)), ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + let I : GaussianInt := ⟨0, 1⟩ + (pᵢ.1 - p₀.1 = (2 : ℝ)⁻¹ * (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ + (↑s : ℕ) * (I * BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) + BandVectors.2 (q (0 + : Fin (4 : ℕ))) (q j.succ)))).1) → ((pᵢ.2 - p₀.2 = (2 : ℝ)⁻¹ * (GaussianRealPoint + ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * (I * BandVectors.2 (q (0 : Fin (4 + : ℕ))) (q j.succ) + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ)))).2) → (pᵢ - p₀ = + (1 / 2 : ℝ) • GaussianRealPoint ((-I) ^ s.val * (I * BandVectors.2 (q 0) (q j.succ) + + BandVectors.2 (q 0) (q j.succ))))) ) := by + classical + intro q p₀ pᵢ i' s r j I hs1 hs2 + apply Prod.ext + · simpa only [Prod.fst_sub, Prod.smul_mk, GaussianRealPoint, + smul_eq_mul, one_div] using hs1 + · simpa only [Prod.snd_sub, Prod.smul_mk, GaussianRealPoint, + smul_eq_mul, one_div] using hs2 + +private theorem hrowPoint : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (r : Fin + (3 : ℕ)), + let j : Fin 3 := i' + r + let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => + if k = 0 then + if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ + else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ + else if k = 1 then + if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ + else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ + else + if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ + else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ + let a : PeriodicSubtileIndex := makeIndex j s + let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + let I : GaussianInt := ⟨0, 1⟩ + (∀ (k : Fin 3), ∀ (t : Fin 4), (1 / 2 : ℝ) • GaussianRealPoint ((-I) ^ t.val * (I * + BandVectors.2 (q 0) (q k.succ) + BandVectors.2 (q 0) (q k.succ))) = (if (slot + (makeIndex k t).label).2 then (1 : ℝ) else -1) • P4250T1SlopeOffset (BandVectors.2 + (q ((k + 2).succ)) (q ((k + 1).succ))) + GaussianRealPoint (((makeIndex k t).first : + GaussianInt) * BandVectors.2 (q 0) (q 1) + ((makeIndex k t).second : GaussianInt) * + BandVectors.2 (q 0) (q 2))) → ((1 / 2 : ℝ) • GaussianRealPoint ((-I) ^ s.val * (I * + BandVectors.2 (q 0) (q j.succ) + BandVectors.2 (q 0) (q j.succ))) = (if (slot + a.label).2 then (1 : ℝ) else -1) • P4250T1SlopeOffset (BandVectors.2 (q ((j + + 2).succ)) (q ((j + 1).succ))) + GaussianRealPoint ((a.first : GaussianInt) * + BandVectors.2 (q 0) (q 1) + (a.second : GaussianInt) * BandVectors.2 (q 0) (q 2))) ) + := by + classical + intro q i' s r j makeIndex a slot I hrowPointAux + simpa [a] using hrowPointAux j s + +end SubtileCoordinateGeometry + +theorem P4261T1SubtileCoordinates + {q : Fin 4 → CircleCoordinates} {cfg : BandOrderedGeneralConfiguration q} + {C₀ : BandCircle} {T₀ : ProtoTile} + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T₀) + (h₀ : PartialOdometer) (C : BandCircle) (T : ProtoTile) (h : PartialOdometer) + (hadj : SubtileLatticeAdjacent C₀ C T₀ T h₀ h) : + ∃ a : PeriodicSubtileIndex, a ∈ P4261T1ExteriorIndices ∧ + Nonempty (P4261T1PlacedOdometer cert h₀ C T h a) := by +-- BODY + focus + classical + rcases hadj with ⟨_, hchild, p₀, pᵢ, hp₀, hpᵢ, q', i', s, hproper, + hq₀, hqi, hcent, hslope₁, hslope₂⟩ + obtain ⟨r, hrotate, _⟩ := + BandPredecessorNoCollision q q' cfg.proper hproper (by + rw [cert.child_eq, hq₀]) + let j : Fin 3 := i' + r + have hparent : q' i'.succ = q j.succ := by + simpa [j] using hrotate i' + let edge : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q ((k + 2).succ)) (q ((k + 1).succ)) + let incoming : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q k.succ) (q 0) + let outgoing : Fin 3 → GaussianInt := fun k => + BandVectors.1 (q 0) (q k.succ) + have hvlaws := VectorRecursionLaws q cfg.proper.1 + have hvlaws₂ := VectorRecursionLaws _ (SemiProperQuadruple.rotate cfg.proper.1) + have hvlaws₃ := VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate cfg.proper.1)) + have hsuper := SubtileCoordinateGeometry.hsuper q hvlaws + have hin0 : incoming 0 = edge 1 - (⟨0, 1⟩ : GaussianInt) * edge 2 := by + simpa [incoming, edge] using hvlaws.2.2.1 + have hin1 : incoming 1 = edge 2 - (⟨0, 1⟩ : GaussianInt) * edge 0 := by + simpa [incoming, edge] using hvlaws₂.2.2.1 + have hin2 : incoming 2 = edge 0 - (⟨0, 1⟩ : GaussianInt) * edge 1 := by + simpa [incoming, edge] using hvlaws₃.2.2.1 + have hflip := SubtileCoordinateGeometry.hflip q cfg hvlaws + have hu := SubtileCoordinateGeometry.hu q cfg C₀ T₀ cert + have hv := SubtileCoordinateGeometry.hv q cfg C₀ T₀ cert + have hcentroidRows := SubtileCoordinateGeometry.hcentroidRows q cfg C₀ T₀ cert + have rows := SubtileCoordinateGeometry.rows q cfg C₀ T₀ cert i' s r hsuper hin0 hin1 hin2 + hflip hu hv hcentroidRows + let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => + if k = 0 then + if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ + else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ + else if k = 1 then + if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ + else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ + else + if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ + else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ + let a : PeriodicSubtileIndex := makeIndex j s + let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false) + have tableFacts := SubtileCoordinateGeometry.tableFacts + have htable := tableFacts j s a rfl + have ha := htable.1 + have hslot : (slot a.label).1 = j ∧ (slot a.label).2 = + (if a.label = .A ∨ a.label = .C ∨ a.label = .E then true else false) := + SubtileCoordinateGeometry.hslot i' s r htable + have hrowCentroid := SubtileCoordinateGeometry.hrowCentroid q cfg C₀ T₀ cert i' s r rows + have hsuppliedCentroid := SubtileCoordinateGeometry.hsuppliedCentroid q cfg C₀ T₀ cert T q' + i' s hq₀ hcent r hparent hrowCentroid + have hparentNonempty := SubtileCoordinateGeometry.hparentNonempty q cfg C₀ T₀ cert + have hbandOcc := SubtileCoordinateGeometry.hbandOcc q cfg C₀ T₀ cert T i' s r htable ha hslot + hrowCentroid hsuppliedCentroid + have hbandT := SubtileCoordinateGeometry.hbandT q C T h hchild q' i' hqi r hparent + have hcells : T.cells = (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells := + SubtileCoordinateGeometry.hcells q cfg C₀ T₀ cert T i' s r hslot hsuppliedCentroid + hbandOcc hbandT + have hoccNonempty : + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells.Nonempty := + SubtileCoordinateGeometry.hoccNonempty q cfg C₀ T₀ cert T i' s r htable ha hslot + hrowCentroid hsuppliedCentroid hparentNonempty hbandOcc hcells + have hTNonempty : T.cells.Nonempty := by rw [hcells]; exact hoccNonempty + have hfoot := SubtileCoordinateGeometry.hfoot q cfg C₀ T₀ cert T i' s r hcells hoccNonempty + hTNonempty + have hdomain := SubtileCoordinateGeometry.hdomain q cfg C₀ T₀ cert C T h hchild i' s r hfoot + have hrootSlope : PartialOdometerSlope h₀ = some p₀ := hp₀ + have hfunctionSlope : PartialOdometerSlope h = some pᵢ := hpᵢ + have hcircle := SubtileCoordinateGeometry.hcircle q C q' i' s hqi r hparent hslot + let I : GaussianInt := ⟨0, 1⟩ + let A : GaussianInt := BandVectors.2 (q 2) (q 1) + let B : GaussianInt := BandVectors.2 (q 3) (q 2) + have hA13 := SubtileCoordinateGeometry.hA13 q hvlaws + have hA01 := SubtileCoordinateGeometry.hA01 q cfg hvlaws hA13 + have hA02 := SubtileCoordinateGeometry.hA02 q cfg hvlaws hvlaws₂ + have hA03 := SubtileCoordinateGeometry.hA03 q cfg hvlaws hvlaws₃ hA13 + have hAedgeAux := SubtileCoordinateGeometry.hAedgeAux q hA13 + have hAroot := SubtileCoordinateGeometry.hAroot q hA01 hA02 hA03 + have hrowPointAux := SubtileCoordinateGeometry.hrowPointAux q hA01 hA02 hAedgeAux hAroot + refine ⟨a, ha, ⟨?_⟩⟩ + refine ⟨hcircle, hchild, hcells, hsuppliedCentroid, hdomain, p₀, pᵢ, + hrootSlope, hfunctionSlope, ?_⟩ + have hflipAffine : ∀ k : Fin 3, + BandVectors.2 (q k.succ) (q 0) = + I * BandVectors.2 (q 0) (q k.succ) := SubtileCoordinateGeometry.hflipAffine q cfg hvlaws + have hs1 := by + simpa [hparent, hq₀, cert.child_eq.symm, hflipAffine j] using hslope₁ + have hs2 := by + simpa [hparent, hq₀, cert.child_eq.symm, hflipAffine j] using hslope₂ + have hslopePair := SubtileCoordinateGeometry.hslopePair q p₀ pᵢ i' s r hs1 hs2 + have hrowPoint := SubtileCoordinateGeometry.hrowPoint q i' s r hrowPointAux + change pᵢ - p₀ = + (if (slot a.label).2 then (1 : ℝ) else -1) • + P4250T1SlopeOffset + (BandVectors.2 (q ((slot a.label).1 + 2).succ) + (q ((slot a.label).1 + 1).succ)) + + GaussianRealPoint + ((a.first : GaussianInt) * BandVectors.2 (q 0) (q 1) + + (a.second : GaussianInt) * BandVectors.2 (q 0) (q 2)) + rw [hslot.1] + exact hslopePair.trans hrowPoint + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2AdjacentMatrixSlope.lean b/LeanPool/ApollonianSuperharmonic/P4261T2AdjacentMatrixSlope.lean new file mode 100644 index 0000000000..985fcd5e2a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T2AdjacentMatrixSlope.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector + +-- [TABLET NODE: P4261T2AdjacentMatrixSlope] + +/-! +# P4261T2AdjacentMatrixSlope + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4261T2AdjacentMatrixSlope + (C : BandCircle) (T U : ProtoTile) (h k : PartialOdometer) + (hadj : LeftLatticeAdjacent C T U h k) : + ∃ p r : Real × Real, + PartialOdometerSlope h = some p ∧ PartialOdometerSlope k = some r ∧ + r.1 - p.1 = CircleMatrix C 0 0 * ((TileCentroid U).1 - (TileCentroid T).1) + + CircleMatrix C 0 1 * ((TileCentroid U).2 - (TileCentroid T).2) ∧ + r.2 - p.2 = CircleMatrix C 1 0 * ((TileCentroid U).1 - (TileCentroid T).1) + + CircleMatrix C 1 1 * ((TileCentroid U).2 - (TileCentroid T).2) := by +-- BODY + obtain ⟨_, _, p, r, hp, hr, hcase⟩ := hadj + refine ⟨p, r, hp, hr, ?_⟩ + rcases hcase with ⟨_, o, v, _, hc, hs, ht⟩ | ⟨q, i, e, hq, hC, hc, hs, ht⟩ + · have hc0 := congrArg Prod.fst hc + have hc1 := congrArg Prod.snd hc + change (TileCentroid U).1 - (TileCentroid T).1 = (v.re : Real) at hc0 + change (TileCentroid U).2 - (TileCentroid T).2 = (v.im : Real) at hc1 + exact ⟨by rw [hc0, hc1]; exact hs, by rw [hc0, hc1]; exact ht⟩ + · have hin := CircleMatrixIncomingVector C q hq.1 hC i + have hin0 := congrFun hin 0 + have hin1 := congrFun hin 1 + simp only [Matrix.mulVec, dotProduct, Fin.sum_univ_two, + Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val_fin_one] at hin0 hin1 + have hc0 := congrArg Prod.fst hc + have hc1 := congrArg Prod.snd hc + change (TileCentroid U).1 - (TileCentroid T).1 = + (if e = true then (1 : Real) else -1) * + ((BandVectors.1 (q i.succ) (q 0)).re : Real) at hc0 + change (TileCentroid U).2 - (TileCentroid T).2 = + (if e = true then (1 : Real) else -1) * + ((BandVectors.1 (q i.succ) (q 0)).im : Real) at hc1 + constructor + · rw [hc0, hc1, hs] + linear_combination -(if e = true then (1 : Real) else -1) * hin0 + · rw [hc0, hc1, ht] + linear_combination -(if e = true then (1 : Real) else -1) * hin1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean b/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean new file mode 100644 index 0000000000..b0be6b3bce --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean @@ -0,0 +1,618 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas + +-- [TABLET NODE: P4261T2AncestorSymmetry] + +/-! +# P4261T2AncestorSymmetry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace AncestorSymmetryGeometry + +private theorem hDomain : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (h : + PartialOdometer), ((↑k.domain : Set GaussianInt) = FootprintVertices U) → (((∀ (T : + ProtoTile), LatticeTile T ↔ LatticeTile (BandPackingSymmetryTileAction g T)) ∧ (∀ (T + : ProtoTile), TileArea (BandPackingSymmetryTileAction g T) = TileArea T) ∧ (∀ (T : + ProtoTile), ∀ (U : ProtoTile), BandPackingSymmetryTileAction g (TileCellComplement T + U) = TileCellComplement (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryTileAction g U)) ∧ (∀ (T : ProtoTile), ∀ (U : ProtoTile), + TileTouching T U ↔ TileTouching (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryTileAction g U)) ∧ (∀ (T : ProtoTile), QuarterTurnSymmetric T ↔ + QuarterTurnSymmetric (BandPackingSymmetryTileAction g T)) ∧ (∀ (T : ProtoTile), ∀ (U + : ProtoTile), ∀ (V : ProtoTile), TouchingTriple T U V ↔ TouchingTriple + (BandPackingSymmetryTileAction g T) (BandPackingSymmetryTileAction g U) + (BandPackingSymmetryTileAction g V)) ∧ (∀ (T : ProtoTile), ∀ (v : GaussianInt), + BandPackingSymmetryTileAction g (TileTranslation T v) = TileTranslation + (BandPackingSymmetryTileAction g T) (BandPackingSymmetryVectorAction g v)) ∧ (∀ (T : + ProtoTile), FootprintVertices (BandPackingSymmetryTileAction g T) = + BandPackingSymmetryVectorAction g '' FootprintVertices T) ∧ (∀ (T : ProtoTile), + FootprintEdges (BandPackingSymmetryTileAction g T) = (fun (e : Finset GaussianInt) => + Finset.image (BandPackingSymmetryVectorAction g) e) '' FootprintEdges T) ∧ (∀ (T : + ProtoTile), ∀ (U : ProtoTile), (FootprintVertices T ∩ FootprintVertices + U).Subsingleton ↔ (FootprintVertices (BandPackingSymmetryTileAction g T) ∩ + FootprintVertices (BandPackingSymmetryTileAction g U)).Subsingleton) ∧ ∀ (S : Fin (3 + : ℕ) → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (o : + PeriodicSubtileIndex), BandPackingSymmetryTileAction g + (SubtileOccurrenceInterpretation S u v o) = SubtileOccurrenceInterpretation (fun (i : + Fin (3 : ℕ)) (s : Bool) => BandPackingSymmetryTileAction g (S i s)) + (BandPackingSymmetryVectorAction g u) (BandPackingSymmetryVectorAction g v) o) → + (((↑(BandPackingSymmetryPartialOdometerAction g k).domain : Set GaussianInt) = + BandPackingSymmetryVectorAction g '' (↑k.domain : Set GaussianInt) ∧ + BandPackingSymmetryPartialOdometerAction BandPackingSymmetry.identity k = k ∧ (∀ (w : + GaussianInt), ∀ (x : GaussianInt), x ∈ k.domain → + (BandPackingSymmetryPartialOdometerAction (BandPackingSymmetry.shift w) k).value x = + k.value x + BandPackingShiftPotential w x) ∧ (∀ x ∈ + (BandPackingSymmetryPartialOdometerAction BandPackingSymmetry.negate k).domain, + (BandPackingSymmetryPartialOdometerAction BandPackingSymmetry.negate k).value x = + k.value (-GaussianQuarterTurn x)) ∧ (∀ x ∈ (BandPackingSymmetryPartialOdometerAction + BandPackingSymmetry.conjugate k).domain, (BandPackingSymmetryPartialOdometerAction + BandPackingSymmetry.conjugate k).value x = k.value (-GaussianReflection x)) ∧ (∀ (a : + BandPackingSymmetry), ∀ (b : BandPackingSymmetry), + BandPackingSymmetryPartialOdometerAction (a.comp b) k = + BandPackingSymmetryPartialOdometerAction a (BandPackingSymmetryPartialOdometerAction + b k)) ∧ (OdometerCompatibility (BandPackingSymmetryPartialOdometerAction g k) + (BandPackingSymmetryPartialOdometerAction g h) ↔ OdometerCompatibility k h) ∧ ∀ (T : + ProtoTile), Finset.Nonempty T.cells → PartialOdometerSquares k = T.cells → + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g k) = Option.map + (BandPackingSymmetrySlopeAction g T) (PartialOdometerSlope k)) → + (((BandPackingSymmetryPartialOdometerAction g k).domain : Set GaussianInt) = + FootprintVertices (BandPackingSymmetryTileAction g U)))) ) := by + classical + intro g U k h hDom hFoot hOdo + rw [hOdo.1, hDom, hFoot.2.2.2.2.2.2.2.1] + +private theorem hInclusion : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ (h : PartialOdometer), (k.domain + ⊆ h.domain) → ((BandPackingSymmetryPartialOdometerAction g k).domain ⊆ + (BandPackingSymmetryPartialOdometerAction g h).domain) ) := by + classical + intro g k h hIncl + change ((BandPackingSymmetryPartialOdometerAction g k).domain : Set GaussianInt) ⊆ + ((BandPackingSymmetryPartialOdometerAction g h).domain : Set GaussianInt) + rw [(BandPackingSymmetryPartialOdometerActionFormulas g k h).1, + (BandPackingSymmetryPartialOdometerActionFormulas g h k).1] + exact Set.image_mono hIncl + +private theorem actionForward : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (p : PartialOdometer), ∀ (x : GaussianInt), (x ∈ p.domain) + → (BandPackingSymmetryVectorAction a x ∈ (BandPackingSymmetryPartialOdometerAction a + p).domain) ) := by + classical + intro a p x hx + change BandPackingSymmetryVectorAction a x ∈ + ((BandPackingSymmetryPartialOdometerAction a p).domain : Set GaussianInt) + rw [(BandPackingSymmetryPartialOdometerActionFormulas a p p).1] + exact ⟨x, hx, rfl⟩ + +private theorem literalRestriction : + (by + classical + exact + (∀ (a : BandPackingSymmetry), ∀ (p : PartialOdometer), ∀ (x : GaussianInt), (x ∈ + p.domain) → (BandPackingSymmetryVectorAction a x ∈ + (BandPackingSymmetryPartialOdometerAction a p).domain)) → (∀ (g : + BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ (h : PartialOdometer), (k.domain ⊆ + h.domain) → ((∀ x, x ∈ k.domain → k.value x = h.value x) → (∀ x, x ∈ k.domain → + (BandPackingSymmetryPartialOdometerAction g k).value (BandPackingSymmetryVectorAction + g x) = (BandPackingSymmetryPartialOdometerAction g h).value + (BandPackingSymmetryVectorAction g x)))) ) := by + classical + intro actionForward g k h hsub heq + induction g generalizing k h with + | identity => exact heq + | shift w => + intro x hx + simp only [BandPackingSymmetryVectorAction, + BandPackingSymmetryPartialOdometerAction, hx, hsub hx, ite_eq_left] + rw [heq x hx] + | negate => + intro x hx + have hinv (z : GaussianInt) : + -GaussianQuarterTurn (GaussianQuarterTurn z) = z := by + ext <;> simp [GaussianQuarterTurn] + simp only [BandPackingSymmetryVectorAction, + BandPackingSymmetryPartialOdometerAction, + Finset.mem_image_of_mem GaussianQuarterTurn hx, + Finset.mem_image_of_mem GaussianQuarterTurn (hsub hx), ite_eq_left, hinv] + exact heq x hx + | conjugate => + intro x hx + have hinv (z : GaussianInt) : + -GaussianReflection (-GaussianReflection z) = z := by + ext <;> simp [GaussianReflection] + simp only [BandPackingSymmetryVectorAction, + BandPackingSymmetryPartialOdometerAction, + Finset.mem_image_of_mem (fun z => -GaussianReflection z) hx, + Finset.mem_image_of_mem (fun z => -GaussianReflection z) (hsub hx), ite_eq_left, hinv] + exact heq x hx + | comp a b ia ib => + intro x hx + have hbsub : (BandPackingSymmetryPartialOdometerAction b k).domain ⊆ + (BandPackingSymmetryPartialOdometerAction b h).domain := by + intro y hy + change y ∈ ((BandPackingSymmetryPartialOdometerAction b k).domain : Set GaussianInt) at hy + rw [(BandPackingSymmetryPartialOdometerActionFormulas b k k).1] at hy + obtain ⟨z, hz, rfl⟩ := hy + exact actionForward b h z (hsub hz) + have hbeq : ∀ y, + y ∈ (BandPackingSymmetryPartialOdometerAction b k).domain → + (BandPackingSymmetryPartialOdometerAction b k).value y = + (BandPackingSymmetryPartialOdometerAction b h).value y := by + intro y hy + change y ∈ ((BandPackingSymmetryPartialOdometerAction b k).domain : Set GaussianInt) at hy + rw [(BandPackingSymmetryPartialOdometerActionFormulas b k k).1] at hy + obtain ⟨z, hz, rfl⟩ := hy + exact ib k h hsub heq z hz + exact ia (BandPackingSymmetryPartialOdometerAction b k) + (BandPackingSymmetryPartialOdometerAction b h) hbsub hbeq _ + (actionForward b k x hx) + +private theorem rsub : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) (fun _ _ f k p => f (k p)) + ∀ (a : BandPackingSymmetry), ∀ (p : Real × Real), ∀ (t : Real × Real), R a (p - t) = R a + p - R a t ) := by + classical + intro R a p t + induction a generalizing p t with + | identity => rfl + | negate => ext <;> simp [R]; ring + | conjugate => ext <;> simp [R]; ring + | shift w => rfl + | comp a b ia ib => simp [R, ia, ib] + +private theorem rsmul : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) (fun _ _ f k p => f (k p)) + ∀ (a : BandPackingSymmetry), ∀ (c : Real), ∀ (p : Real × Real), R a (c • p) = c • R a p ) + := by + classical + intro R a c p + induction a generalizing p with + | identity => rfl + | negate => ext <;> simp [R] + | conjugate => ext <;> simp [R] + | shift w => rfl + | comp a b ia ib => simp [R, ia, ib] + +private theorem rneg : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) (fun _ _ f k p => f (k p)) + (∀ (a : BandPackingSymmetry), ∀ (c : Real), ∀ (p : Real × Real), R a (c • p) = c • R a p) + → (∀ (a : BandPackingSymmetry), ∀ (p : Real × Real), R a (-p) = -R a p) ) := by + classical + intro R rsmul a p + simpa using rsmul a (-1) p + +private theorem rminusq : + (by + classical + exact + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) (fun _ _ f k p => f (k p)) + (∀ (a : BandPackingSymmetry), ∀ (p : Real × Real), R a (-p) = -R a p) → (∀ (a : + BandPackingSymmetry), ∀ (p : Real × Real), R a (p.2, -p.1) = -R a (-p.2, p.1)) ) := by + classical + intro R rneg a p + rw [show (p.2, -p.1) = -(-p.2, p.1) by simp, rneg] + +private theorem rpoint : + (by + classical + exact + let L := BandPackingSymmetryVectorAction + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) (fun _ _ f k p => f (k p)) + ∀ (a : BandPackingSymmetry), ∀ (w : GaussianInt), R a (GaussianRealPoint w) = + GaussianRealPoint (L a w) ) := by + classical + intro L R a w + induction a generalizing w with + | identity => rfl + | negate => simp [R, L, BandPackingSymmetryVectorAction, GaussianRealPoint, + GaussianQuarterTurn] + | conjugate => simp [R, L, BandPackingSymmetryVectorAction, GaussianRealPoint, + GaussianReflection] + | shift w => rfl + | comp a b ia ib => simp [R, L, BandPackingSymmetryVectorAction, ia, ib] + +private theorem rq : + (by + classical + exact + let O := BandPackingSymmetryReversesOrientation + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) (fun _ _ f k p => f (k p)) + let J : (Real × Real) → (Real × Real) := fun p => (-p.2, p.1) + (∀ (a : BandPackingSymmetry), ∀ (p : Real × Real), R a (-p) = -R a p) → (∀ (a : + BandPackingSymmetry), ∀ (p : Real × Real), R a (J p) = if O a then -J (R a p) else J + (R a p)) ) := by + classical + intro O R J rneg a p + induction a generalizing p with + | identity => rfl + | negate => simp [R, J, O, BandPackingSymmetryReversesOrientation] + | conjugate => simp [R, J, O, BandPackingSymmetryReversesOrientation] + | shift w => rfl + | comp a b ia ib => + change R a (R b (-p.2, p.1)) = + if xor (O a) (O b) then -(-(R a (R b p)).2, (R a (R b p)).1) + else (-(R a (R b p)).2, (R a (R b p)).1) + rw [ib] + cases ha : O a <;> cases hb : O b + · simp only [Bool.xor_false] + simpa [J, ha] using ia (R b p) + · simp only [Bool.xor_true, ite_true] + rw [rneg, ia] + simp [J, ha] + · simp only [Bool.xor_false, ite_true] + simpa [J, ha] using ia (R b p) + · simp only [Bool.xor_true, ite_true] + rw [rneg, ia] + simp [J, ha] + +private theorem offsetCov : + (by + classical + exact + let L := BandPackingSymmetryVectorAction + let O := BandPackingSymmetryReversesOrientation + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) (fun _ _ f k p => f (k p)) + let J : (Real × Real) → (Real × Real) := fun p => (-p.2, p.1) + let offset : GaussianInt → Real × Real := fun w => + (1 / 2 : Real) • (GaussianRealPoint w - J (GaussianRealPoint w)) + (∀ (a : BandPackingSymmetry), ∀ (p : Real × Real), ∀ (t : Real × Real), R a (p - t) = R a + p - R a t) → ((∀ (a : BandPackingSymmetry), ∀ (c : Real), ∀ (p : Real × Real), R a (c + • p) = c • R a p) → ((∀ (a : BandPackingSymmetry), ∀ (w : GaussianInt), R a + (GaussianRealPoint w) = GaussianRealPoint (L a w)) → ((∀ (a : BandPackingSymmetry), ∀ + (p : Real × Real), R a (J p) = if O a then -J (R a p) else J (R a p)) → (∀ (a : + BandPackingSymmetry), ∀ (w : GaussianInt), R a (offset w) = offset (if O a then + GaussianQuarterTurn (L a w) else L a w))))) ) := by + classical + intro L O R J offset rsub rsmul rpoint rq a w + dsimp [offset] + rw [rsmul, rsub, rq, rpoint] + cases ho : O a <;> ext <;> + simp [GaussianRealPoint, GaussianQuarterTurn, J] <;> ring + +private theorem offsetSign : + (by + classical + exact + let J : (Real × Real) → (Real × Real) := fun p => (-p.2, p.1) + let offset : GaussianInt → Real × Real := fun w => + (1 / 2 : Real) • (GaussianRealPoint w - J (GaussianRealPoint w)) + ∀ (d : Bool), ∀ (w : GaussianInt), offset ((if d then (-1 : GaussianInt) else 1) * w) = + (if d then (-1 : Real) else 1) • offset w ) := by + classical + intro J offset d w + cases d <;> ext <;> simp [offset, GaussianRealPoint, J] <;> ring + +private theorem centroidCov : + (by + classical + exact + let B := BandPackingSymmetryTileAction + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) (fun _ _ f k p => f (k p)) + ∀ (a : BandPackingSymmetry), ∀ (V : ProtoTile), TileCentroid (B a V) = R a (TileCentroid + V) ) := by + classical + intro B R a V + induction a generalizing V with + | identity => rfl + | shift w => rfl + | negate => exact (TileQuarterTurnFormulas V).2.2.2.2.1 + | conjugate => + simp only [B, BandPackingSymmetryTileAction] + rw [(TileQuarterTurnFormulas (TileQuarterTurn (TileReflection V))).2.2.2.2.1, + (TileQuarterTurnFormulas (TileReflection V)).2.2.2.2.1, + (TileReflectionFormulas V).2.2.2.2.1] + simp [R] + | comp a b ia ib => simp [B, R, BandPackingSymmetryTileAction, ia, ib] + +private theorem parentSlot : + (by + classical + exact + let A := BandPackingSymmetryCircleAction + let O := BandPackingSymmetryReversesOrientation + let Q := BandPackingSymmetryQuadrupleAction + ∀ (a : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), Q a q (if + O a then -i else i).succ = A a (q i.succ) ) := by + classical + intro A O Q a q i + have neg1 : -(1 : Fin 3) = 2 := rfl + have neg2 : -(2 : Fin 3) = 1 := rfl + cases ho : O a <;> fin_cases i <;> + simp [Q, A, O, BandPackingSymmetryQuadrupleAction, + ho, neg1, neg2] + +private theorem linkCov : + (by + classical + exact + ∀ (g : BandPackingSymmetry), + let A := BandPackingSymmetryCircleAction + let B := BandPackingSymmetryTileAction + let L := BandPackingSymmetryVectorAction + let O := BandPackingSymmetryReversesOrientation + let Q := BandPackingSymmetryQuadrupleAction + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) (fun _ _ f k p => f (k p)) + let J : (Real × Real) → (Real × Real) := fun p => (-p.2, p.1) + let offset : GaussianInt → Real × Real := fun w => + (1 / 2 : Real) • (GaussianRealPoint w - J (GaussianRealPoint w)) + (∀ (a : BandPackingSymmetry), ∀ (p : Real × Real), ∀ (t : Real × Real), R a (p - t) = R a + p - R a t) → ((∀ (a : BandPackingSymmetry), ∀ (c : Real), ∀ (p : Real × Real), R a (c + • p) = c • R a p) → ((∀ (a : BandPackingSymmetry), ∀ (w : GaussianInt), R a (offset + w) = offset (if O a then GaussianQuarterTurn (L a w) else L a w)) → ((∀ (d : Bool), ∀ + (w : GaussianInt), offset ((if d then (-1 : GaussianInt) else 1) * w) = (if d then + (-1 : Real) else 1) • offset w) → ((∀ (a : BandPackingSymmetry), ∀ (V : ProtoTile), + TileCentroid (B a V) = R a (TileCentroid V)) → ((∀ (a : BandPackingSymmetry), ∀ (q : + Fin 4 → CircleCoordinates), ∀ (i : Fin 3), Q a q (if O a then -i else i).succ = A a + (q i.succ)) → (∀ (X : CircleCoordinates × ProtoTile), ∀ (Y : CircleCoordinates × + ProtoTile), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Bool), + (ProperBandQuadruple q) → ((q 0 = Y.1) → ((q i.succ = X.1) → ((BandPrototile Y.1 Y.2) + → ((BandPrototile X.1 X.2) → ((FootprintVertices X.2 ⊆ FootprintVertices Y.2) → + ((TileCentroid X.2 - TileCentroid Y.2 = + (if s then (1 : Real) else -1) • offset + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)))) → (∃ s', ProperBandQuadruple + (Q g q) ∧ (Q g q) 0 = (A g Y.1) ∧ (Q g q) (if O g then -i else i).succ = A g + X.1 ∧ BandPrototile (A g Y.1) (B g Y.2) ∧ BandPrototile (A g X.1) (B g X.2) ∧ + FootprintVertices (B g X.2) ⊆ FootprintVertices (B g Y.2) ∧ TileCentroid (B g + X.2) - TileCentroid (B g Y.2) = (if s' then (1 : Real) else -1) • offset + (BandVectors.1 ((Q g q) (((if O g then -i else i) + 2).succ)) ((Q g q) (((if O + g then -i else i) + 1).succ)))))))))))))))) ) := by + classical + intro g A B L O Q R J offset rsub rsmul offsetCov offsetSign centroidCov parentSlot X Y q i s + hq hq0 hqi hY hX hfoot hcent + obtain ⟨d, hd, _⟩ := BandPackingSymmetryProjectiveVectorCovariance g q hq + let sigma : Fin 3 → Fin 3 := fun j => if O g then -j else j + let w := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let w' := BandVectors.1 (Q g q ((sigma i + 2).succ)) + (Q g q ((sigma i + 1).succ)) + have hw : w' = (if d then (-1 : GaussianInt) else 1) * + (if O g then GaussianQuarterTurn (L g w) else L g w) := by + have hh := (hd i).2.2 + simpa [w', sigma, Q, O, BandPackingSymmetryQuadrupleAction] using hh + let eps : Real := if d then -1 else 1 + have centroid : TileCentroid (B g X.2) - TileCentroid (B g Y.2) = + (if s then (1 : Real) else -1) • offset + (if O g then GaussianQuarterTurn (L g w) else L g w) := by + rw [centroidCov, centroidCov, ← rsub, hcent, rsmul, offsetCov] + have w'eq : w' = BandVectors.1 (Q g q ((if O g then -i else i) + 2).succ) + (Q g q ((if O g then -i else i) + 1).succ) := by rfl + have sign : (if s then (1 : Real) else -1) * eps = + (if xor s d then (1 : Real) else -1) := by + cases s <;> cases d <;> norm_num [eps] + refine ⟨xor s d, BandPackingSymmetryProperCovariance g q hq, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simpa [Q, BandPackingSymmetryQuadrupleAction] using congrArg (A g) hq0 + · rw [parentSlot] + simp [hqi] + · exact (BandPackingSymmetryCovariance g).2.1 Y.1 Y.2 |>.mp hY + · exact (BandPackingSymmetryCovariance g).2.1 X.1 X.2 |>.mp hX + · rw [(BandPackingSymmetryTilingTransport g).2.2.2.2.2.2.2.1, + (BandPackingSymmetryTilingTransport g).2.2.2.2.2.2.2.1] + exact Set.image_mono hfoot + · rw [← w'eq, hw, offsetSign] + cases s <;> cases d <;> simp [centroid] + +private theorem edgeCov : + (by + classical + exact + ∀ (g : BandPackingSymmetry), + let A := BandPackingSymmetryCircleAction + let B := BandPackingSymmetryTileAction + let O := BandPackingSymmetryReversesOrientation + let Q := BandPackingSymmetryQuadrupleAction + let J : (Real × Real) → (Real × Real) := fun p => (-p.2, p.1) + let offset : GaussianInt → Real × Real := fun w => + (1 / 2 : Real) • (GaussianRealPoint w - J (GaussianRealPoint w)) + (∀ (X : CircleCoordinates × ProtoTile), ∀ (Y : CircleCoordinates × ProtoTile), ∀ (q : Fin + 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Bool), (ProperBandQuadruple q) → ((q 0 + = Y.1) → ((q i.succ = X.1) → ((BandPrototile Y.1 Y.2) → ((BandPrototile X.1 X.2) → + ((FootprintVertices X.2 ⊆ FootprintVertices Y.2) → ((TileCentroid X.2 - TileCentroid + Y.2 = (if s then (1 : Real) else -1) • offset (BandVectors.1 (q ((i + 2).succ)) (q + ((i + 1).succ)))) → (∃ s', ProperBandQuadruple (Q g q) ∧ (Q g q) 0 = (A g Y.1) ∧ (Q g + q) (if O g then -i else i).succ = A g X.1 ∧ BandPrototile (A g Y.1) (B g Y.2) ∧ + BandPrototile (A g X.1) (B g X.2) ∧ FootprintVertices (B g X.2) ⊆ FootprintVertices + (B g Y.2) ∧ TileCentroid (B g X.2) - TileCentroid (B g Y.2) = (if s' then (1 : Real) + else -1) • offset (BandVectors.1 ((Q g q) (((if O g then -i else i) + 2).succ)) ((Q g + q) (((if O g then -i else i) + 1).succ))))))))))) → ( + let F : CircleCoordinates × ProtoTile → CircleCoordinates × ProtoTile := + fun z => (A g z.1, B g z.2) + let Edge : (CircleCoordinates × ProtoTile) → + (CircleCoordinates × ProtoTile) → Prop := fun X Y => + ∃ q : Fin 4 → CircleCoordinates, ∃ i : Fin 3, ∃ s : Bool, + ProperBandQuadruple q ∧ q 0 = Y.1 ∧ q i.succ = X.1 ∧ + BandPrototile Y.1 Y.2 ∧ BandPrototile X.1 X.2 ∧ + FootprintVertices X.2 ⊆ FootprintVertices Y.2 ∧ + TileCentroid X.2 - TileCentroid Y.2 = + (if s then (1 : Real) else -1) • offset + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) + ∀ {X : CircleCoordinates × ProtoTile}, ∀ {Y : CircleCoordinates × ProtoTile}, (Edge X Y) + → (Edge (F X) (F Y))) ) := by + classical + intro g A B O Q J offset linkCov F Edge X Y hedge + rcases hedge with ⟨q, i, s, hq, hq0, hqi, hY, hX, hfoot, hcent⟩ + obtain ⟨s', hq', hq0', hqi', hY', hX', hfoot', hcent'⟩ := + linkCov X Y q i s hq hq0 hqi hY hX hfoot hcent + refine ⟨Q g q, (if O g then -i else i), s', hq', hq0', hqi', + hY', hX', hfoot', ?_⟩ + simpa [F] using hcent' + +private theorem hAnc' : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (C : CircleCoordinates), ∀ (D : CircleCoordinates), ∀ (U : + ProtoTile), ∀ (T : ProtoTile), (AncestorTile C D U T) → ( + let A := BandPackingSymmetryCircleAction + let B := BandPackingSymmetryTileAction + let J : (Real × Real) → (Real × Real) := fun p => (-p.2, p.1) + let offset : GaussianInt → Real × Real := fun w => + (1 / 2 : Real) • (GaussianRealPoint w - J (GaussianRealPoint w)) + let F : CircleCoordinates × ProtoTile → CircleCoordinates × ProtoTile := + fun z => (A g z.1, B g z.2) + let Edge : (CircleCoordinates × ProtoTile) → + (CircleCoordinates × ProtoTile) → Prop := fun X Y => + ∃ q : Fin 4 → CircleCoordinates, ∃ i : Fin 3, ∃ s : Bool, + ProperBandQuadruple q ∧ q 0 = Y.1 ∧ q i.succ = X.1 ∧ + BandPrototile Y.1 Y.2 ∧ BandPrototile X.1 X.2 ∧ + FootprintVertices X.2 ⊆ FootprintVertices Y.2 ∧ + TileCentroid X.2 - TileCentroid Y.2 = + (if s then (1 : Real) else -1) • offset + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) + (∀ {X : CircleCoordinates × ProtoTile}, ∀ {Y : CircleCoordinates × ProtoTile}, (Edge X Y) + → (Edge (F X) (F Y))) → (Relation.ReflTransGen Edge (F (C, U)) (F (D, T)))) ) := by + classical + intro g C D U T hAnc A B J offset F Edge edgeCov + change Relation.ReflTransGen Edge (C, U) (D, T) at hAnc + refine Relation.ReflTransGen.head_induction_on + (motive := fun a _ => Relation.ReflTransGen Edge (F a) (F (D, T))) + hAnc ?_ ?_ + · exact Relation.ReflTransGen.refl + · intro a b hedge hrest ih + exact Relation.ReflTransGen.trans (Relation.ReflTransGen.single (edgeCov hedge)) ih + +end AncestorSymmetryGeometry + +theorem P4261T2AncestorSymmetry + (g : BandPackingSymmetry) (C D : CircleCoordinates) + (U T : ProtoTile) (k h : PartialOdometer) + (ha : AncestorOdometer C D U T k h) : + AncestorOdometer (BandPackingSymmetryCircleAction g C) + (BandPackingSymmetryCircleAction g D) + (BandPackingSymmetryTileAction g U) (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryPartialOdometerAction g k) + (BandPackingSymmetryPartialOdometerAction g h) := by +-- BODY + classical + rcases ha with ⟨hTile, hAnc, hDom, hIncl, hVal⟩ + have hTile' := BandPackingSymmetryTileOdometerCovariance g D T h hTile + have hFoot := BandPackingSymmetryTilingTransport g + have hOdo := BandPackingSymmetryPartialOdometerActionFormulas g k h + have hDomain := AncestorSymmetryGeometry.hDomain g U k h hDom hFoot hOdo + have hInclusion := AncestorSymmetryGeometry.hInclusion g k h hIncl + have actionForward (a : BandPackingSymmetry) (p : PartialOdometer) + (x : GaussianInt) (hx : x ∈ p.domain) := AncestorSymmetryGeometry.actionForward a p x hx + have literalRestriction (g : BandPackingSymmetry) (k h : PartialOdometer) + (hsub : k.domain ⊆ h.domain) + (heq : ∀ x, x ∈ k.domain → k.value x = h.value x) := + AncestorSymmetryGeometry.literalRestriction actionForward g k h hsub heq + let A := BandPackingSymmetryCircleAction + let B := BandPackingSymmetryTileAction + let L := BandPackingSymmetryVectorAction + let O := BandPackingSymmetryReversesOrientation + let Q := BandPackingSymmetryQuadrupleAction + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) (fun _ _ f k p => f (k p)) + let J : (Real × Real) → (Real × Real) := fun p => (-p.2, p.1) + let offset : GaussianInt → Real × Real := fun w => + (1 / 2 : Real) • (GaussianRealPoint w - J (GaussianRealPoint w)) + have rsub (a : BandPackingSymmetry) (p t : Real × Real) := AncestorSymmetryGeometry.rsub a p t + have rsmul (a : BandPackingSymmetry) (c : Real) (p : Real × Real) := + AncestorSymmetryGeometry.rsmul a c p + have rneg (a : BandPackingSymmetry) (p : Real × Real) := AncestorSymmetryGeometry.rneg rsmul a p + have rminusq (a : BandPackingSymmetry) (p : Real × Real) := AncestorSymmetryGeometry.rminusq + rneg a p + have rpoint (a : BandPackingSymmetry) (w : GaussianInt) := AncestorSymmetryGeometry.rpoint a w + have rq (a : BandPackingSymmetry) (p : Real × Real) := AncestorSymmetryGeometry.rq rneg a p + have offsetCov (a : BandPackingSymmetry) (w : GaussianInt) := + AncestorSymmetryGeometry.offsetCov rsub rsmul rpoint rq a w + have offsetSign (d : Bool) (w : GaussianInt) := AncestorSymmetryGeometry.offsetSign d w + have centroidCov (a : BandPackingSymmetry) (V : ProtoTile) := + AncestorSymmetryGeometry.centroidCov a V + have parentSlot (a : BandPackingSymmetry) (q : Fin 4 → CircleCoordinates) + (i : Fin 3) := AncestorSymmetryGeometry.parentSlot a q i + have linkCov (X Y : CircleCoordinates × ProtoTile) + (q : Fin 4 → CircleCoordinates) (i : Fin 3) (s : Bool) + (hq : ProperBandQuadruple q) (hq0 : q 0 = Y.1) + (hqi : q i.succ = X.1) (hY : BandPrototile Y.1 Y.2) + (hX : BandPrototile X.1 X.2) + (hfoot : FootprintVertices X.2 ⊆ FootprintVertices Y.2) + (hcent : TileCentroid X.2 - TileCentroid Y.2 = + (if s then (1 : Real) else -1) • offset + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)))) := + AncestorSymmetryGeometry.linkCov g rsub rsmul offsetCov offsetSign centroidCov + parentSlot X Y q i s hq hq0 hqi hY hX hfoot hcent + refine ⟨hTile'.1, ?_, hDomain, hInclusion, ?_⟩ + · let F : CircleCoordinates × ProtoTile → CircleCoordinates × ProtoTile := + fun z => (A g z.1, B g z.2) + let Edge : (CircleCoordinates × ProtoTile) → + (CircleCoordinates × ProtoTile) → Prop := fun X Y => + ∃ q : Fin 4 → CircleCoordinates, ∃ i : Fin 3, ∃ s : Bool, + ProperBandQuadruple q ∧ q 0 = Y.1 ∧ q i.succ = X.1 ∧ + BandPrototile Y.1 Y.2 ∧ BandPrototile X.1 X.2 ∧ + FootprintVertices X.2 ⊆ FootprintVertices Y.2 ∧ + TileCentroid X.2 - TileCentroid Y.2 = + (if s then (1 : Real) else -1) • offset + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) + have edgeCov {X Y : CircleCoordinates × ProtoTile} (hedge : Edge X Y) := + AncestorSymmetryGeometry.edgeCov g linkCov (X := X) (Y := Y) hedge + have hAnc' := AncestorSymmetryGeometry.hAnc' g C D U T hAnc edgeCov + change AncestorTile (A g C) (A g D) (B g U) (B g T) + change Relation.ReflTransGen Edge (F (C, U)) (F (D, T)) + exact hAnc' + · intro y hy + change y ∈ ((BandPackingSymmetryPartialOdometerAction g k).domain : Set GaussianInt) at hy + rw [(BandPackingSymmetryPartialOdometerActionFormulas g k k).1] at hy + obtain ⟨x, hx, rfl⟩ := hy + exact literalRestriction g k h hIncl hVal x hx + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2DiamondBoundary.lean b/LeanPool/ApollonianSuperharmonic/P4261T2DiamondBoundary.lean new file mode 100644 index 0000000000..330277489d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T2DiamondBoundary.lean @@ -0,0 +1,142 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.DiamondOdometerExistsUnique +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality + +-- [TABLET NODE: P4261T2DiamondBoundary] + +/-! +# P4261T2DiamondBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4261T2DiamondBoundary + (K : DiamondParameter) (C : BandCircle) + (hC : DiamondRecursiveQuadruple K 0 = C.1.1) + (i : Fin 3) (T U : ProtoTile) (h k : PartialOdometer) + (hh : TileOdometer C.1.1 T h) (hk : TileOdometer C.1.1 U k) + (p r : Real × Real) + (hp : PartialOdometerSlope h = some p) (hr : PartialOdometerSlope k = some r) + (hc : TileCentroid U - TileCentroid T = + GaussianRealPoint (BandVectors.1 (DiamondRecursiveQuadruple K i.succ) + (DiamondRecursiveQuadruple K 0))) + (hs : r - p = + GaussianRealPoint (BandVectors.2 (DiamondRecursiveQuadruple K i.succ) + (DiamondRecursiveQuadruple K 0))) : + OdometerCompatibility h k := by +-- BODY + classical + obtain ⟨H, hH, hdomH, hfootH, hsquaresH, hvaluesH, hslopeH⟩ := + DiamondTileOdometerRestriction K + have affine_eq (f l : PartialOdometer) (u a : GaussianInt) (b : Int) + (hd : ∀ x, x ∈ f.domain ↔ x - u ∈ l.domain) + (hv : ∀ x, x ∈ f.domain → f.value x = l.value (x - u) + + a.re * x.re + a.im * x.im + b) : + f = PartialOdometerAffineTranslate l u a b := by + have hh : f.domain = (PartialOdometerAffineTranslate l u a b).domain := by + ext x + rw [(PartialOdometerAffineTranslateFormulas l u a b).2.1] + exact hd x + have vv : f.value = (PartialOdometerAffineTranslate l u a b).value := by + funext x + by_cases hx : x ∈ f.domain + · rw [hv x hx, (PartialOdometerAffineTranslateFormulas l u a b).2.2.1 x + (by rwa [← hh])] + · rw [f.value_outside x hx, + (PartialOdometerAffineTranslate l u a b).value_outside x (by rwa [← hh])] + cases f + simp only [PartialOdometerAffineTranslate, PartialOdometer.mk.injEq] + exact ⟨hh, vv⟩ + obtain ⟨u, ⟨hcells, hanchor, a, b, hdom, hval⟩, _⟩ := + TileOdometerTranslationUniqueness C.1.1 T (DiamondTile K.1) h H C.2 hh + (by simpa only [hC] using hH) + obtain ⟨u', ⟨hcells', hanchor', a', b', hdom', hval'⟩, _⟩ := + TileOdometerTranslationUniqueness C.1.1 U (DiamondTile K.1) k H C.2 hk + (by simpa only [hC] using hH) + have hcentT := (ProtoTileObservableExtensionality T _ hcells hanchor).2.2.2.2 + have hcentU := (ProtoTileObservableExtensionality U _ hcells' hanchor').2.2.2.2 + rw [(TileTranslationFormulas (DiamondTile K.1) u).2.2.2.2.1] at hcentT + rw [(TileTranslationFormulas (DiamondTile K.1) u').2.2.2.2.1] at hcentU + let d := BandVectors.1 (DiamondRecursiveQuadruple K i.succ) (DiamondRecursiveQuadruple K 0) + let A := BandVectors.2 (DiamondRecursiveQuadruple K i.succ) (DiamondRecursiveQuadruple K 0) + have hshift : u' - u = d := by + have hc0 := congrArg Prod.fst hc + have hc1 := congrArg Prod.snd hc + rw [hcentT, hcentU] at hc0 hc1 + apply Zsqrtd.ext + · have he : (u'.re : Real) - (u.re : Real) = (d.re : Real) := by + simpa [d, GaussianRealPoint] using hc0 + exact_mod_cast he + · have he : (u'.im : Real) - (u.im : Real) = (d.im : Real) := by + simpa [d, GaussianRealPoint] using hc1 + exact_mod_cast he + have hpeq : p = ((K.1 : Real) / 2 + (a.re : Real), + -((K.1 : Real) / 2) + (a.im : Real)) := by + have hf := congrArg PartialOdometerSlope (affine_eq h H u a b hdom hval) + rw [hp, (PartialOdometerAffineTranslateFormulas H u a b).2.2.2.2.2, hslopeH] at hf + exact Option.some.inj hf + have hreq : r = ((K.1 : Real) / 2 + (a'.re : Real), + -((K.1 : Real) / 2) + (a'.im : Real)) := by + have hf := congrArg PartialOdometerSlope (affine_eq k H u' a' b' hdom' hval') + rw [hr, (PartialOdometerAffineTranslateFormulas H u' a' b').2.2.2.2.2, hslopeH] at hf + exact Option.some.inj hf + have hare : a'.re = a.re + A.re := by + have he := congrArg Prod.fst hs + rw [hpeq, hreq] at he + have he' : (a'.re : Real) - (a.re : Real) = (A.re : Real) := by + change ((K.1 : Real) / 2 + (a'.re : Real)) - + ((K.1 : Real) / 2 + (a.re : Real)) = (A.re : Real) at he + linarith + exact_mod_cast (show (a'.re : Real) = (a.re : Real) + (A.re : Real) by linarith) + have haim : a'.im = a.im + A.im := by + have he := congrArg Prod.snd hs + rw [hpeq, hreq] at he + have he' : (a'.im : Real) - (a.im : Real) = (A.im : Real) := by + change (-((K.1 : Real) / 2) + (a'.im : Real)) - + (-((K.1 : Real) / 2) + (a.im : Real)) = (A.im : Real) at he + linarith + exact_mod_cast (show (a'.im : Real) = (a.im : Real) + (A.im : Real) by linarith) + let c : Int := ![(K.1 : Int) * (K.1 + 1) / 2, + -((K.1 : Int) * (K.1 + 1) / 2), -((K.1 : Int) * (K.1 - 2))] i + have hcocycle : ∀ z, DiamondOdometer K (z + d) = DiamondOdometer K z + + A.re * z.re + A.im * z.im + c := by + have hG := (Classical.choose_spec (DiamondOdometerExistsUnique K)).1 + change (∀ z, DiamondOdometer K (z + ⟨0, -(2 * K.1 : Int)⟩) = _) ∧ _ at hG + obtain ⟨_, _, hv1, hv2, hv3, ha1, ha2, ha3, _⟩ := DiamondCoordinateConfiguration K + intro z + fin_cases i + · simpa [d, A, c, hv1, ha1, DiamondOdometer, add_assoc] using hG.2.1 z + · simpa [d, A, c, hv2, ha2, DiamondOdometer, sub_eq_add_neg, add_assoc] using hG.2.2.1 z + · simpa [d, A, c, hv3, ha3, DiamondOdometer, sub_eq_add_neg, add_assoc] using hG.1 z + right + refine ⟨A.re * u'.re + A.im * u'.im - c + b' - b, ?_⟩ + intro z hz hz' + have hzH := (hdom z).mp hz + have hzH' := (hdom' z).mp hz' + have he := hcocycle (z - u') + have hpoint : z - u' + d = z - u := by rw [← hshift]; abel + rw [hpoint] at he + rw [hval z hz, hval' z hz', hvaluesH _ hzH, hvaluesH _ hzH', he, + hare, haim] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2InterfacePropagation.lean b/LeanPool/ApollonianSuperharmonic/P4261T2InterfacePropagation.lean new file mode 100644 index 0000000000..cf22bf8350 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T2InterfacePropagation.lean @@ -0,0 +1,96 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4261T2LiteralInterface +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import Mathlib.Data.List.Chain + +-- [TABLET NODE: P4261T2InterfacePropagation] + +/-! +# P4261T2InterfacePropagation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4261T2InterfacePropagation + (D C : BandCircle) (T T' : ProtoTile) (h h' : PartialOdometer) + (hh : TileOdometer C.1.1 T h) (hh' : TileOdometer C.1.1 T' h') + (pkg : P4261T2LiteralInterface D C T T' h h') + (hcompat : ∀ (U V : ProtoTile) (g k : PartialOdometer), + (U, g) ∈ pkg.tiles.zip pkg.functions → + (V, k) ∈ pkg.reverseTiles.zip pkg.reverseFunctions → + (FootprintEdges U ∩ FootprintEdges V).Nonempty → OdometerCompatibility g k) : + OdometerCompatibility h h' := by +-- BODY + classical + have vertex_of_edge : ∀ (U : ProtoTile) (edge : Finset GaussianInt), + edge ∈ FootprintEdges U → ∀ z ∈ edge, z ∈ FootprintVertices U := by + intro U edge he z hz + rcases he with ⟨a, ha, he | he | he | he⟩ + all_goals + rw [he] at hz + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rw [FootprintVertices, ite_eq_left (show U.cells.Nonempty from ⟨a, ha⟩)] + refine ⟨a, ha, ?_⟩ + rcases hz with hz | hz <;> simp [hz] + let diff := fun z : GaussianInt => h'.value z - h.value z + let rel := fun x y : GaussianInt => diff x = diff y + have hchain : pkg.path.IsChain rel := by + apply List.isChain_iff_forall_rel_of_append_cons_cons.mpr + intro x y pre post he + obtain ⟨U, V, g, k, hU, hV, hedge, ha, hb⟩ := pkg.restrictions x y pre post he + have memg : ∀ z, z = x ∨ z = y → z ∈ g.domain := by + intro z hz + change z ∈ (g.domain : Set GaussianInt) + rw [show (g.domain : Set GaussianInt) = FootprintVertices U from ha.2.2.1] + exact vertex_of_edge U {x, y} hedge.1 z (by simpa using hz) + have memk : ∀ z, z = x ∨ z = y → z ∈ k.domain := by + intro z hz + change z ∈ (k.domain : Set GaussianInt) + rw [show (k.domain : Set GaussianInt) = FootprintVertices V from hb.2.2.1] + exact vertex_of_edge V {x, y} hedge.2 z (by simpa using hz) + have hxg := memg x (Or.inl rfl) + have hxk := memk x (Or.inl rfl) + have hyg := memg y (Or.inr rfl) + have hyk := memk y (Or.inr rfl) + rcases hcompat U V g k hU hV ⟨{x, y}, hedge⟩ with hd | ⟨c, hc⟩ + · exact (Set.disjoint_left.mp hd hxg hxk).elim + · change h'.value x - h.value x = h'.value y - h.value y + rw [← ha.2.2.2.2 x hxg, ← hb.2.2.2.2 x hxk, + ← ha.2.2.2.2 y hyg, ← hb.2.2.2.2 y hyk] + exact (hc x hxg hxk).trans (hc y hyg hyk).symm + let : Trans rel rel rel := ⟨by + intro a b c hab hbc + exact hab.trans hbc⟩ + let : Std.Refl rel := ⟨fun _ => rfl⟩ + have hpair := List.isChain_iff_pairwise.mp hchain + have hd := PositiveCurvatureTileOdometerDomain C.1.1 T h C.2 hh + have hd' := PositiveCurvatureTileOdometerDomain C.1.1 T' h' C.2 hh' + cases heq : pkg.path with + | nil => + have hl := pkg.length + simp [heq] at hl + | cons x xs => + right + refine ⟨diff x, ?_⟩ + intro z hz hz' + have hzf : z ∈ FootprintVertices T ∩ FootprintVertices T' := by + exact ⟨by rwa [← hd], by rwa [← hd']⟩ + rw [pkg.vertices] at hzf + have hzl : z ∈ pkg.path := by simpa using hzf + rw [heq] at hpair hzl + exact (hpair.rel_head hzl).symm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2LiteralInterface.lean b/LeanPool/ApollonianSuperharmonic/P4261T2LiteralInterface.lean new file mode 100644 index 0000000000..bad80db23e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T2LiteralInterface.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect +public import LeanPool.ApollonianSuperharmonic.FootprintEdges + +-- [TABLET NODE: P4261T2LiteralInterface] + +/-! +# P4261T2LiteralInterface + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For positive band circles $D,C$, literal supports $T,T'$ and functions +$h,h'$, a literal opposing interface consists of an orientation, a base, +two literal endpoint tiles $R^-,R^+$, forward and reverse tile lists and +function lists, and two functions $h^-,h^+$. The forward list +`OdometerStringRespect`s the string from $R^-$ to $R^+$ and the +reverse list respects the string from $R^+$ to $R^-$ on that same base. +Their head/last functions are respectively $(h^-,h^+)$ and $(h^+,h^-)$. +It also contains a repetition-free vertex list $P$ of length at least two. +Its vertex set is exactly $\operatorname{foot}(T)\cap\operatorname{foot}(T')$; +its consecutive unordered pairs are exactly $E(T)\cap E(T')$. +For each consecutive pair $x,y$ there are literal zipped entries $(U,g)$, +$(V,k)$ in the retained forward and reverse lists such that $\{x,y\}$ +is an actual footprint edge of both supports, and +`AncestorOdometer` holds for $(U,g)$ in $(T,h)$ and for $(V,k)$ +in $(T',h')$, with coordinates $D,C$. In particular these certificates +retain the domain inclusions and the actual restriction value equations. +-/ +structure P4261T2LiteralInterface (D C : BandCircle) + (T T' : ProtoTile) (h h' : PartialOdometer) where +-- BODY + /-- The selected triangular completion used by both oriented tile strings. -/ + orientation : Bool + /-- The common base tile of the regular family containing both strings. -/ + base : ProtoTile + /-- The literal initial endpoint tile of the forward string. -/ + minus : ProtoTile + /-- The literal terminal endpoint tile of the forward string. -/ + plus : ProtoTile + /-- The forward ordered list of tiles along the complete interface. -/ + tiles : List ProtoTile + /-- The reverse oriented tile list on the same regular-family base. -/ + reverseTiles : List ProtoTile + /-- The literal partial odometers assigned to the forward tile list. -/ + functions : List PartialOdometer + /-- The literal partial odometers assigned to the reverse tile list. -/ + reverseFunctions : List PartialOdometer + /-- The partial odometer at the initial endpoint. -/ + hminus : PartialOdometer + /-- The partial odometer at the terminal endpoint. -/ + hplus : PartialOdometer + /-- The nontrivial simple lattice path covering the complete common interface. -/ + path : List GaussianInt + forward : OdometerStringRespect D orientation base minus plus tiles functions + backward : OdometerStringRespect D orientation base plus minus reverseTiles reverseFunctions + head_forward : functions.head? = some hminus + last_forward : functions.getLast? = some hplus + head_backward : reverseFunctions.head? = some hplus + last_backward : reverseFunctions.getLast? = some hminus + nodup : path.Nodup + length : 2 ≤ path.length + vertices : FootprintVertices T ∩ FootprintVertices T' = (path.toFinset : Set GaussianInt) + edges : ∀ edge, edge ∈ FootprintEdges T ∩ FootprintEdges T' ↔ + ∃ x y : GaussianInt, ∃ pre post : List GaussianInt, + path = pre ++ x :: y :: post ∧ edge = {x, y} + restrictions : ∀ x y : GaussianInt, ∀ pre post : List GaussianInt, + path = pre ++ x :: y :: post → + ∃ (U V : ProtoTile) (g k : PartialOdometer), + (U, g) ∈ tiles.zip functions ∧ + (V, k) ∈ reverseTiles.zip reverseFunctions ∧ + {x, y} ∈ FootprintEdges U ∩ FootprintEdges V ∧ + AncestorOdometer D.1.1 C.1.1 U T g h ∧ + AncestorOdometer D.1.1 C.1.1 V T' k h' + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2PairNormalization.lean b/LeanPool/ApollonianSuperharmonic/P4261T2PairNormalization.lean new file mode 100644 index 0000000000..088e95cbf4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T2PairNormalization.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple + +-- [TABLET NODE: P4261T2PairNormalization] + +/-! +# P4261T2PairNormalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4261T2PairNormalization + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (C D : BandCircle) (i : Fin 3) (e : Bool) + (hC : q 0 = C.1.1) (hD : q i.succ = D.1.1) + (T U : ProtoTile) (h k : PartialOdometer) + (hh : TileOdometer C.1.1 T h) (hk : TileOdometer C.1.1 U k) + (p r : Real × Real) + (hp : PartialOdometerSlope h = some p) (hr : PartialOdometerSlope k = some r) + (hc : TileCentroid U - TileCentroid T = + (if e = true then (1 : Real) else -1) • + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) + (hs : r - p = (if e = true then (1 : Real) else -1) • + GaussianRealPoint (BandVectors.2 (q i.succ) (q 0))) : + ∃ (g : BandPackingSymmetry) (qn : Fin 4 → CircleCoordinates) + (Cn Dn : BandCircle) (j : Fin 3) (en : Bool) (pn rn : Real × Real), + ProperBandQuadruple qn ∧ qn 0 = Cn.1.1 ∧ qn j.succ = Dn.1.1 ∧ + Cn.1.1 = BandPackingSymmetryCircleAction g C.1.1 ∧ + Dn.1.1 = BandPackingSymmetryCircleAction g D.1.1 ∧ + Cn.1.1.1 = C.1.1.1 ∧ Dn.1.1.1 = D.1.1.1 ∧ + TileOdometer Cn.1.1 (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryPartialOdometerAction g h) ∧ + TileOdometer Cn.1.1 (BandPackingSymmetryTileAction g U) + (BandPackingSymmetryPartialOdometerAction g k) ∧ + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = some pn ∧ + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g k) = some rn ∧ + TileCentroid (BandPackingSymmetryTileAction g U) - + TileCentroid (BandPackingSymmetryTileAction g T) = + (if en = true then (1 : Real) else -1) • + GaussianRealPoint (BandVectors.1 (qn j.succ) (qn 0)) ∧ + rn - pn = (if en = true then (1 : Real) else -1) • + GaussianRealPoint (BandVectors.2 (qn j.succ) (qn 0)) ∧ + ((∃ P : FordFareyParameter, 1 < P.q ∧ qn = FordRecursiveQuadruple P) ∨ + (∃ K : DiamondParameter, 1 < K.1 ∧ qn = DiamondRecursiveQuadruple K) ∨ + Nonempty (BandOrderedGeneralConfiguration qn)) := by +-- BODY + classical + obtain ⟨a, g, hregime⟩ := BandRegimeClassification q hq + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + have hqa : ProperBandQuadruple qa := by + fin_cases a + · have heq : qa = q := by funext j; fin_cases j <;> rfl + rwa [heq] + · refine ⟨by simpa [qa] using SemiProperQuadruple.rotate hq.1, ?_⟩ + intro j + fin_cases j + · exact hq.2 1 + · exact hq.2 2 + · exact hq.2 0 + · refine ⟨by simpa [qa] using (SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate hq.1)), ?_⟩ + intro j + fin_cases j + · exact hq.2 2 + · exact hq.2 0 + · exact hq.2 1 + have hqa0 : qa 0 = C.1.1 := hC + have hqa00 : qa 0 = q 0 := rfl + have hqai : qa (i - a).succ = q i.succ := by + fin_cases a <;> fin_cases i <;> rfl + have hc' : TileCentroid U - TileCentroid T = + (if e = true then (1 : Real) else -1) • + GaussianRealPoint (BandVectors.1 (qa (i - a).succ) (qa 0)) := by + simpa only [hqai, hqa00] using hc + have hs' : r - p = (if e = true then (1 : Real) else -1) • + GaussianRealPoint (BandVectors.2 (qa (i - a).succ) (qa 0)) := by + simpa only [hqai, hqa00] using hs + obtain ⟨negative, pn, rn, hphase, hTn, hUn, hpn, hrn, hcn, hsn, htn, _⟩ := + LeftLatticeAdjacentPackingSymmetryTransport g qa hqa (i - a) e T U h k p r + (by simpa only [hqa0] using hh) (by simpa only [hqa0] using hk) + hp hr hc' (congrArg Prod.fst hs') (congrArg Prod.snd hs') + let qn := BandPackingSymmetryQuadrupleAction g qa + let j : Fin 3 := if BandPackingSymmetryReversesOrientation g then -(i - a) else i - a + have hqn : ProperBandQuadruple qn := BandPackingSymmetryProperCovariance g qa hqa + have hroot : qn 0 = BandPackingSymmetryCircleAction g C.1.1 := by + simp [qn, BandPackingSymmetryQuadrupleAction, hqa0] + have hparent : qn j.succ = BandPackingSymmetryCircleAction g D.1.1 := by + have hrev : ∀ n : Fin 3, + (if BandPackingSymmetryReversesOrientation g then + -(if BandPackingSymmetryReversesOrientation g then -n else n) + else (if BandPackingSymmetryReversesOrientation g then -n else n)) = n := by + intro n + cases BandPackingSymmetryReversesOrientation g <;> simp + have hidx : ∀ n : Fin 3, qn n.succ = + BandPackingSymmetryCircleAction g + (qa (if BandPackingSymmetryReversesOrientation g then -n else n).succ) := by + intro n + fin_cases n <;> rfl + rw [hidx] + dsimp only [j] + rw [hrev, hqai, hD] + have hrootcurv : (qn 0).1 = C.1.1.1 := by + rw [hroot] + exact (BandPackingSymmetryCovariance g).1 _ + have hparentcurv : (qn j.succ).1 = D.1.1.1 := by + rw [hparent] + exact (BandPackingSymmetryCovariance g).1 _ + have hpC : 0 < (qn 0).1 := by rw [hrootcurv]; exact C.2 + have hpD : 0 < (qn j.succ).1 := by rw [hparentcurv]; exact D.2 + let Cn : BandCircle := ⟨⟨qn 0, + ⟨Or.inl hpC, ⟨qn, hqn.1, 0, rfl⟩⟩⟩, hpC⟩ + let Dn : BandCircle := ⟨⟨qn j.succ, + ⟨Or.inl hpD, ⟨qn, hqn.1, j.succ, rfl⟩⟩⟩, hpD⟩ + refine ⟨g, qn, Cn, Dn, j, xor e negative, pn, rn, hqn, rfl, rfl, + hroot, hparent, hrootcurv, hparentcurv, hTn, hUn, hpn, hrn, hcn, ?_, ?_⟩ + · apply Prod.ext + · exact hsn + · exact htn + · rcases hregime with ⟨hFord, _⟩ | ⟨hother, _⟩ + · exact Or.inl hFord + · rcases hother with ⟨hDiamond, _⟩ | ⟨hGeneral, _⟩ + · exact Or.inr (Or.inl hDiamond) + · exact Or.inr (Or.inr hGeneral) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2RegularEdgeReduction.lean b/LeanPool/ApollonianSuperharmonic/P4261T2RegularEdgeReduction.lean new file mode 100644 index 0000000000..71ddcbc525 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T2RegularEdgeReduction.lean @@ -0,0 +1,168 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4261T2UnitBoundary +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.P4250T1DefinedHalfIntegralSlope +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.RegularTileFamilyTranslationUnique + +-- [TABLET NODE: P4261T2RegularEdgeReduction] + +/-! +# P4261T2RegularEdgeReduction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4261T2RegularEdgeReduction + (C : BandCircle) (base U V : ProtoTile) + (hbase : BandPrototile C.1.1 base) + (hU : U ∈ RegularTileFamily base (TilingLattice C)) + (hV : V ∈ RegularTileFamily base (TilingLattice C)) + (g k : PartialOdometer) (hg : TileOdometer C.1.1 U g) + (hk : TileOdometer C.1.1 V k) + (s t : Real × Real) + (hs : PartialOdometerSlope g = some s) (ht : PartialOdometerSlope k = some t) + (h0 : t.1 - s.1 = CircleMatrix C 0 0 * ((TileCentroid V).1 - (TileCentroid U).1) + + CircleMatrix C 0 1 * ((TileCentroid V).2 - (TileCentroid U).2)) + (h1 : t.2 - s.2 = CircleMatrix C 1 0 * ((TileCentroid V).1 - (TileCentroid U).1) + + CircleMatrix C 1 1 * ((TileCentroid V).2 - (TileCentroid U).2)) + (hedge : (FootprintEdges U ∩ FootprintEdges V).Nonempty) : + OdometerCompatibility g k ∨ LeftLatticeAdjacent C U V g k := by +-- BODY + classical + by_cases hunit : C.1.1.1 = 1 + · exact Or.inl (P4261T2UnitBoundary C hunit U V g k hg hk s t hs ht h0 h1) + by_cases heq : U = V + · subst V + obtain ⟨_, _, _, _, hnonempty⟩ := + P4250T1DefinedHalfIntegralSlope C.1.1 U g C.2 hg + obtain ⟨w, ⟨hcells, hanchor, a, b, hd, hv⟩, _⟩ := + TileOdometerTranslationUniqueness C.1.1 U U g k C.2 hg hk + have hcne : (U.cells.card : Int) ≠ 0 := by + exact_mod_cast Finset.card_ne_zero.mpr hnonempty + have hwre : w.re = 0 := by + have he := congrArg (fun S : Finset GaussianInt => ∑ z ∈ S, z.re) hcells + simp only [TileTranslation] at he + rw [Finset.sum_image (by + intro x hx y hy hxy + exact add_right_cancel hxy)] at he + simp only [GaussianTranslation, Zsqrtd.re_add, Finset.sum_add_distrib, + Finset.sum_const, nsmul_eq_mul] at he + have hz : (U.cells.card : Int) * w.re = 0 := by linarith + exact (mul_eq_zero.mp hz).resolve_left hcne + have hwim : w.im = 0 := by + have he := congrArg (fun S : Finset GaussianInt => ∑ z ∈ S, z.im) hcells + simp only [TileTranslation] at he + rw [Finset.sum_image (by + intro x hx y hy hxy + exact add_right_cancel hxy)] at he + simp only [GaussianTranslation, Zsqrtd.im_add, Finset.sum_add_distrib, + Finset.sum_const, nsmul_eq_mul] at he + have hz : (U.cells.card : Int) * w.im = 0 := by linarith + exact (mul_eq_zero.mp hz).resolve_left hcne + have hw : w = 0 := Zsqrtd.ext hwre hwim + subst w + have hh : g.domain = (PartialOdometerAffineTranslate k 0 a b).domain := by + ext x + rw [(PartialOdometerAffineTranslateFormulas k 0 a b).2.1] + exact hd x + have hvalue : g.value = (PartialOdometerAffineTranslate k 0 a b).value := by + funext x + by_cases hx : x ∈ g.domain + · rw [hv x hx, (PartialOdometerAffineTranslateFormulas k 0 a b).2.2.1 x + (by rwa [← hh])] + · rw [g.value_outside x hx, + (PartialOdometerAffineTranslate k 0 a b).value_outside x (by rwa [← hh])] + have heq : g = PartialOdometerAffineTranslate k 0 a b := by + cases g + simp only [PartialOdometerAffineTranslate, PartialOdometer.mk.injEq] + exact ⟨hh, hvalue⟩ + have hep := congrArg PartialOdometerSlope heq + rw [hs, (PartialOdometerAffineTranslateFormulas k 0 a b).2.2.2.2.2, ht] at hep + have hep' := Option.some.inj hep + have hare : a.re = 0 := by + have he := congrArg Prod.fst hep' + change s.1 = t.1 + (a.re : Real) at he + have hzero : t.1 - s.1 = 0 := by simpa using h0 + exact_mod_cast (show (a.re : Real) = 0 by linarith) + have haim : a.im = 0 := by + have he := congrArg Prod.snd hep' + change s.2 = t.2 + (a.im : Real) at he + have hzero : t.2 - s.2 = 0 := by simpa using h1 + exact_mod_cast (show (a.im : Real) = 0 by linarith) + left + right + refine ⟨-b, ?_⟩ + intro x hx hx' + have hvx := hv x hx + simp only [sub_zero, hare, haim, zero_mul, add_zero] at hvx + omega + obtain ⟨q, hsemi, hqC, hsmall, _⟩ := (BandGenealogy C).resolve_left hunit + have hq : ProperBandQuadruple q := ⟨hsemi, by simpa only [hqC] using hsmall⟩ + obtain ⟨u, hu, _⟩ := RegularTileFamilyTranslationUnique base (TilingLattice C) U hU + obtain ⟨v, hv, _⟩ := RegularTileFamilyTranslationUnique base (TilingLattice C) V hV + obtain ⟨P, _, htiles, hadj, _⟩ := BandRegularTranslatePeriodicComplex C q hq hqC base + (by simpa only [hqC] using hbase) + have hne : u ≠ v := by + intro huv + apply heq + rw [hu, hv, huv] + have hedgeP : (FootprintEdges (P.tile u) ∩ FootprintEdges (P.tile v)).Nonempty := by + simpa only [htiles, ← hu, ← hv] using hedge + have hcontact := ((PeriodicTileIntersectionClassification P).1 u v hne).1.mp hedgeP + have hcent : TileCentroid V - TileCentroid U = + GaussianRealPoint ((v : GaussianInt) - (u : GaussianInt)) := by + rw [hu, hv, (TileTranslationFormulas base v).2.2.2.2.1, + (TileTranslationFormulas base u).2.2.2.2.1] + apply Prod.ext <;> simp [GaussianRealPoint] + have finish (j : Fin 3) (e : Bool) + (hc : TileCentroid V - TileCentroid U = + (if e = true then (1 : Real) else -1) • + GaussianRealPoint (BandVectors.1 (q j.succ) (q 0))) : + LeftLatticeAdjacent C U V g k := by + have hin := CircleMatrixIncomingVector C q hq.1 hqC j + have hin0 := congrFun hin 0 + have hin1 := congrFun hin 1 + simp only [Matrix.mulVec, dotProduct, Fin.sum_univ_two, + Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val_fin_one] at hin0 hin1 + have hc0 := congrArg Prod.fst hc + have hc1 := congrArg Prod.snd hc + change (TileCentroid V).1 - (TileCentroid U).1 = + (if e = true then (1 : Real) else -1) * + ((BandVectors.1 (q j.succ) (q 0)).re : Real) at hc0 + change (TileCentroid V).2 - (TileCentroid U).2 = + (if e = true then (1 : Real) else -1) * + ((BandVectors.1 (q j.succ) (q 0)).im : Real) at hc1 + refine ⟨hg, hk, s, t, hs, ht, Or.inr ⟨q, j, e, hq, hqC, hc, ?_, ?_⟩⟩ + · rw [hc0, hc1] at h0 + linear_combination h0 + (if e = true then (1 : Real) else -1) * hin0 + · rw [hc0, hc1] at h1 + linear_combination h1 + (if e = true then (1 : Real) else -1) * hin1 + right + obtain ⟨j, hj | hj⟩ := (hadj u v).mp hcontact + · apply finish j true + simpa [hj] using hcent + · apply finish j false + simpa [hj, GaussianRealPoint] using hcent + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean new file mode 100644 index 0000000000..005b929677 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean @@ -0,0 +1,1065 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton +public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.CircleMatrix + +-- [TABLET NODE: P4261T2UnitBoundary] + +/-! +# P4261T2UnitBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace UnitBoundaryProof + +private theorem unitForm : + (by + classical + exact + (BandCircle) → (∀ (c : CircleCoordinates), (c.1 = 1) → (∀ (T : ProtoTile), ∀ (h : + PartialOdometer), TileOdometer c T h → ∃ z x, c = (1, 1 + 2 * z) ∧ T.cells = {x} ∧ + (h.domain : Set GaussianInt) = FootprintVertices T ∧ OdometerTranslation h + (CurvatureOneOdometer z))) + ) := by + classical + intro C c hc T h ho + induction ho with + | line w x hw h hdom => simp at hc + | @unit z x T h hT hdom htrans => exact ⟨z, x, rfl, hT, hdom, htrans⟩ + | @decompose q hq S T hs h hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope => + have facts := ProperBandCurvatureStructure q hq + have allzero : ∀ i : Fin 3, (q i.succ).1 = 0 := by + intro i + have hlt := hq.2 i + have hn := facts.2.1 i + omega + have contradiction := facts.2.2 0 1 (allzero 0) (allzero 1) + norm_num at contradiction + +private theorem unitData : + (by + classical + exact + (BandCircle) → (∀ (z : GaussianInt), ∀ (x : GaussianInt), ∀ (T : ProtoTile), ∀ (h : + PartialOdometer), T.cells = {x} → (h.domain : Set GaussianInt) = FootprintVertices T + → OdometerTranslation h (CurvatureOneOdometer z) → ∃ a : GaussianInt, ∃ b : ℤ, h = + PartialOdometerAffineTranslate (CurvatureOneOdometer z) x a b) + ) := by + classical + intro C z x T h hT hdom htrans + obtain ⟨v, a, b, hd, hv⟩ := htrans + have hdomSq : (h.domain : Set GaussianInt) = + {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩} := by + ext y + simp [hdom, FootprintVertices, hT] + have vmem : v ∈ h.domain := by + apply (hd v).mpr + simp [CurvatureOneOdometer] + have v1mem : v + 1 ∈ h.domain := by + apply (hd (v + 1)).mpr + simp [CurvatureOneOdometer] + have vimem : v + ⟨0, 1⟩ ∈ h.domain := by + apply (hd (v + ⟨0, 1⟩)).mpr + simp [CurvatureOneOdometer] + have vmem' : v = x ∨ v = x + 1 ∨ v = x + ⟨0, 1⟩ ∨ + v = x + 1 + ⟨0, 1⟩ := by + change v ∈ (h.domain : Set GaussianInt) at vmem + rw [hdomSq] at vmem + simpa using vmem + have v1mem' : v + 1 = x ∨ v + 1 = x + 1 ∨ + v + 1 = x + ⟨0, 1⟩ ∨ v + 1 = x + 1 + ⟨0, 1⟩ := by + change v + 1 ∈ (h.domain : Set GaussianInt) at v1mem + rw [hdomSq] at v1mem + simpa using v1mem + have vimem' : v + ⟨0, 1⟩ = x ∨ v + ⟨0, 1⟩ = x + 1 ∨ + v + ⟨0, 1⟩ = x + ⟨0, 1⟩ ∨ + v + ⟨0, 1⟩ = x + 1 + ⟨0, 1⟩ := by + change v + ⟨0, 1⟩ ∈ (h.domain : Set GaussianInt) at vimem + rw [hdomSq] at vimem + simpa using vimem + have hvx : v = x := by + have hre : v.re = x.re ∨ v.re = x.re + 1 := by + rcases vmem' with h | h | h | h + · left; exact congrArg Zsqrtd.re h + · right; simpa using congrArg Zsqrtd.re h + · left; simpa using congrArg Zsqrtd.re h + · right; simpa using congrArg Zsqrtd.re h + have hre1 : v.re + 1 = x.re ∨ v.re + 1 = x.re + 1 := by + rcases v1mem' with h | h | h | h + · left; simpa using congrArg Zsqrtd.re h + · right; simpa using congrArg Zsqrtd.re h + · left; simpa using congrArg Zsqrtd.re h + · right; simpa using congrArg Zsqrtd.re h + have him : v.im = x.im ∨ v.im = x.im + 1 := by + rcases vmem' with h | h | h | h + · left; exact congrArg Zsqrtd.im h + · left; simpa using congrArg Zsqrtd.im h + · right; simpa using congrArg Zsqrtd.im h + · right; simpa using congrArg Zsqrtd.im h + have him1 : v.im + 1 = x.im ∨ v.im + 1 = x.im + 1 := by + rcases vimem' with h | h | h | h + · left; simpa using congrArg Zsqrtd.im h + · left; simpa using congrArg Zsqrtd.im h + · right; simpa using congrArg Zsqrtd.im h + · right; simpa using congrArg Zsqrtd.im h + apply Zsqrtd.ext <;> omega + subst v + have hdeq : h.domain = + (PartialOdometerAffineTranslate (CurvatureOneOdometer z) x a b).domain := by + ext y + rw [(PartialOdometerAffineTranslateFormulas _ x a b).2.1] + exact hd y + have hveq : h.value = + (PartialOdometerAffineTranslate (CurvatureOneOdometer z) x a b).value := by + funext y + by_cases hy : y ∈ h.domain + · rw [hv y hy, (PartialOdometerAffineTranslateFormulas _ x a b).2.2.1 + y (by rwa [← hdeq])] + · rw [h.value_outside y hy, + (PartialOdometerAffineTranslate _ x a b).value_outside y + (by rwa [← hdeq])] + refine ⟨a, b, ?_⟩ + cases h + simp only [PartialOdometerAffineTranslate, PartialOdometer.mk.injEq] + exact ⟨hdeq, hveq⟩ + +private theorem hReMem : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (u : LatticeCell), ((h.domain : Set GaussianInt) = {u, u + 1, + u + ⟨0, 1⟩, u + 1 + ⟨0, 1⟩}) → (∀ y ∈ h.domain, y.re = u.re ∨ y.re = u.re + (1 : ℤ)) + ) := by + classical + intro h u hdomSq y hy + change y ∈ (h.domain : Set GaussianInt) at hy + rw [hdomSq] at hy + rcases (by simpa using hy : y = u ∨ y = u + 1 ∨ + y = u + ⟨0, 1⟩ ∨ y = u + 1 + ⟨0, 1⟩) with e | e | e | e + · left; exact congrArg Zsqrtd.re e + · right; simpa using congrArg Zsqrtd.re e + · left; simpa using congrArg Zsqrtd.re e + · right; simpa using congrArg Zsqrtd.re e + +private theorem hImMem : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (u : LatticeCell), ((h.domain : Set GaussianInt) = {u, u + 1, + u + ⟨0, 1⟩, u + 1 + ⟨0, 1⟩}) → (∀ y ∈ h.domain, y.im = u.im ∨ y.im = u.im + (1 : ℤ)) + ) := by + classical + intro h u hdomSq y hy + change y ∈ (h.domain : Set GaussianInt) at hy + rw [hdomSq] at hy + rcases (by simpa using hy : y = u ∨ y = u + 1 ∨ + y = u + ⟨0, 1⟩ ∨ y = u + 1 + ⟨0, 1⟩) with e | e | e | e + · left; exact congrArg Zsqrtd.im e + · left; simpa using congrArg Zsqrtd.im e + · right; simpa using congrArg Zsqrtd.im e + · right; simpa using congrArg Zsqrtd.im e + +private theorem kReMem : + (by + classical + exact + ∀ (k : PartialOdometer), ∀ (v : LatticeCell), ((k.domain : Set GaussianInt) = {v, v + 1, + v + ⟨0, 1⟩, v + 1 + ⟨0, 1⟩}) → (∀ y ∈ k.domain, y.re = v.re ∨ y.re = v.re + (1 : ℤ)) + ) := by + classical + intro k v kdomSq y hy + change y ∈ (k.domain : Set GaussianInt) at hy + rw [kdomSq] at hy + rcases (by simpa using hy : y = v ∨ y = v + 1 ∨ + y = v + ⟨0, 1⟩ ∨ y = v + 1 + ⟨0, 1⟩) with e | e | e | e + · left; exact congrArg Zsqrtd.re e + · right; simpa using congrArg Zsqrtd.re e + · left; simpa using congrArg Zsqrtd.re e + · right; simpa using congrArg Zsqrtd.re e + +private theorem kImMem : + (by + classical + exact + ∀ (k : PartialOdometer), ∀ (v : LatticeCell), ((k.domain : Set GaussianInt) = {v, v + 1, + v + ⟨0, 1⟩, v + 1 + ⟨0, 1⟩}) → (∀ y ∈ k.domain, y.im = v.im ∨ y.im = v.im + (1 : ℤ)) + ) := by + classical + intro k v kdomSq y hy + change y ∈ (k.domain : Set GaussianInt) at hy + rw [kdomSq] at hy + rcases (by simpa using hy : y = v ∨ y = v + 1 ∨ + y = v + ⟨0, 1⟩ ∨ y = v + 1 + ⟨0, 1⟩) with e | e | e | e + · left; exact congrArg Zsqrtd.im e + · left; simpa using congrArg Zsqrtd.im e + · right; simpa using congrArg Zsqrtd.im e + · right; simpa using congrArg Zsqrtd.im e + +private theorem horizontalPositive : + (by + classical + exact + (BandCircle) → (∀ (z : GaussianInt), (LatticeCell) → ((LatticeCell) → ((GaussianInt) → + ((GaussianInt) → (∀ (f : PartialOdometer), ∀ (g : PartialOdometer), ∀ (x : + GaussianInt), ∀ (y : GaussianInt), ∀ (α : GaussianInt), ∀ (β : GaussianInt), ∀ (B : + ℤ), ∀ (D : ℤ), (↑f.domain : Set GaussianInt) = {x, x + (1 : GaussianInt), + x + ⟨(0 : ℤ), (1 : ℤ)⟩, x + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} → (↑g.domain : + Set GaussianInt) = {y, y + (1 : GaussianInt), y + ⟨(0 : ℤ), (1 : ℤ)⟩, + y + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} → (∀ t ∈ f.domain, f.value t = + (CurvatureOneOdometer z).value (t - x) + α.re * t.re + α.im * t.im + B) → (∀ t ∈ + g.domain, g.value t = (CurvatureOneOdometer z).value (t - y) + β.re * t.re + β.im * + t.im + D) → y = x + (1 : GaussianInt) → β.im - α.im = z.im → OdometerCompatibility f + g))))) + ) := by + classical + intro C z u v a a' f g x y α β B D df dg vf vg hstep hcoef + subst y + have fRe (t : GaussianInt) (ht : t ∈ f.domain) : + t.re = x.re ∨ t.re = x.re + 1 := by + change t ∈ (f.domain : Set GaussianInt) at ht + rw [df] at ht + rcases (by simpa using ht : t = x ∨ t = x + 1 ∨ + t = x + ⟨0, 1⟩ ∨ t = x + 1 + ⟨0, 1⟩) with e | e | e | e + · left; exact congrArg Zsqrtd.re e + · right; simpa using congrArg Zsqrtd.re e + · left; simpa using congrArg Zsqrtd.re e + · right; simpa using congrArg Zsqrtd.re e + have fIm (t : GaussianInt) (ht : t ∈ f.domain) : + t.im = x.im ∨ t.im = x.im + 1 := by + change t ∈ (f.domain : Set GaussianInt) at ht + rw [df] at ht + rcases (by simpa using ht : t = x ∨ t = x + 1 ∨ + t = x + ⟨0, 1⟩ ∨ t = x + 1 + ⟨0, 1⟩) with e | e | e | e + · left; exact congrArg Zsqrtd.im e + · left; simpa using congrArg Zsqrtd.im e + · right; simpa using congrArg Zsqrtd.im e + · right; simpa using congrArg Zsqrtd.im e + have gRe (t : GaussianInt) (ht : t ∈ g.domain) : + t.re = x.re + 1 ∨ t.re = x.re + 2 := by + have hm : t.re = (x + 1).re ∨ t.re = (x + 1).re + 1 := by + change t ∈ (g.domain : Set GaussianInt) at ht + rw [dg] at ht + rcases (by simpa using ht : t = x + 1 ∨ t = x + 1 + 1 ∨ + t = x + 1 + ⟨0, 1⟩ ∨ t = x + 1 + 1 + ⟨0, 1⟩) with e | e | e | e + · left; exact congrArg Zsqrtd.re e + · right; simpa using congrArg Zsqrtd.re e + · left; simpa using congrArg Zsqrtd.re e + · right; simpa using congrArg Zsqrtd.re e + rcases hm with hm | hm + · left; simpa [Zsqrtd.add_def] using hm + · right + have hm' : t.re = x.re + 1 + 1 := by simpa [Zsqrtd.add_def] using hm + omega + have gIm (t : GaussianInt) (ht : t ∈ g.domain) : + t.im = x.im ∨ t.im = x.im + 1 := by + have hm : t.im = (x + 1).im ∨ t.im = (x + 1).im + 1 := by + change t ∈ (g.domain : Set GaussianInt) at ht + rw [dg] at ht + rcases (by simpa using ht : t = x + 1 ∨ t = x + 1 + 1 ∨ + t = x + 1 + ⟨0, 1⟩ ∨ t = x + 1 + 1 + ⟨0, 1⟩) with e | e | e | e + · left; exact congrArg Zsqrtd.im e + · left; simpa using congrArg Zsqrtd.im e + · right; simpa using congrArg Zsqrtd.im e + · right; simpa using congrArg Zsqrtd.im e + simpa [Zsqrtd.add_def] using hm + have common : ∀ t, t ∈ f.domain → t ∈ g.domain → + t = x + 1 ∨ t = x + 1 + ⟨0, 1⟩ := by + intro t ht kt + have hre : t.re = (x + 1).re := by + change t.re = x.re + 1 + rcases fRe t ht with h | h <;> rcases gRe t kt with h' | h' <;> omega + rcases fIm t ht with hi | hi <;> rcases gIm t kt with hi' | hi' + · left + apply Zsqrtd.ext + · simpa [Zsqrtd.add_def] using hre + · simpa [Zsqrtd.add_def] using hi + · right + apply Zsqrtd.ext + · simpa [Zsqrtd.add_def] using hre + · simpa [Zsqrtd.add_def] using hi' + · right + exfalso + omega + · right + apply Zsqrtd.ext + · simpa [Zsqrtd.add_def] using hre + · simpa [Zsqrtd.add_def] using hi + have x1f : x + 1 ∈ f.domain := by change x + 1 ∈ (f.domain : Set _); rw [df]; simp + have x1g : x + 1 ∈ g.domain := by change x + 1 ∈ (g.domain : Set _); rw [dg]; simp + have x1if : x + 1 + ⟨0, 1⟩ ∈ f.domain := by + change x + 1 + ⟨0, 1⟩ ∈ (f.domain : Set _); rw [df]; simp + have x1ig : x + 1 + ⟨0, 1⟩ ∈ g.domain := by + change x + 1 + ⟨0, 1⟩ ∈ (g.domain : Set _) + rw [dg] + simp [add_assoc, add_comm, add_left_comm] + have endpoint : g.value (x + 1 + ⟨0, 1⟩) - + f.value (x + 1 + ⟨0, 1⟩) = + g.value (x + 1) - f.value (x + 1) := by + rw [vg _ x1ig, vf _ x1if, vg _ x1g, vf _ x1f] + have h01 : (x + 1) - x = 1 := by abel + have h11 : (x + 1 + ⟨0, 1⟩) - x = 1 + ⟨0, 1⟩ := by abel + have h00 : (x + 1) - (x + 1) = 0 := by simp + have h10 : (x + 1 + ⟨0, 1⟩) - (x + 1) = ⟨0, 1⟩ := by abel + have hcoefMul : x.im * β.im - x.im * α.im = x.im * z.im := by + calc + x.im * β.im - x.im * α.im = x.im * (β.im - α.im) := by ring + _ = x.im * z.im := by rw [hcoef] + simp [CurvatureOneOdometer, h01, h11, h10, + Zsqrtd.ext_iff] + ring_nf at hcoefMul ⊢ + omega + right + refine ⟨g.value (x + 1) - f.value (x + 1), ?_⟩ + intro t ht kt + rcases common t ht kt with rfl | rfl + · rfl + · exact endpoint + +private theorem verticalPositive : + (by + classical + exact + (BandCircle) → (∀ (z : GaussianInt), (LatticeCell) → ((LatticeCell) → ((GaussianInt) → + ((GaussianInt) → (∀ (f : PartialOdometer), ∀ (g : PartialOdometer), ∀ (x : + GaussianInt), ∀ (y : GaussianInt), ∀ (α : GaussianInt), ∀ (β : GaussianInt), ∀ (B : + ℤ), ∀ (D : ℤ), (↑f.domain : Set GaussianInt) = {x, x + (1 : GaussianInt), + x + ⟨(0 : ℤ), (1 : ℤ)⟩, x + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} → (↑g.domain : + Set GaussianInt) = {y, y + (1 : GaussianInt), y + ⟨(0 : ℤ), (1 : ℤ)⟩, + y + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} → (∀ t ∈ f.domain, f.value t = + (CurvatureOneOdometer z).value (t - x) + α.re * t.re + α.im * t.im + B) → (∀ t ∈ + g.domain, g.value t = (CurvatureOneOdometer z).value (t - y) + β.re * t.re + β.im * + t.im + D) → y = x + ⟨(0 : ℤ), (1 : ℤ)⟩ → β.re - α.re = z.im → OdometerCompatibility f + g))))) + ) := by + classical + intro C z u v a a' f g x y α β B D df dg vf vg hstep hcoef + subst y + have fRe (t : GaussianInt) (ht : t ∈ f.domain) : + t.re = x.re ∨ t.re = x.re + 1 := by + change t ∈ (f.domain : Set GaussianInt) at ht + rw [df] at ht + rcases (by simpa using ht : t = x ∨ t = x + 1 ∨ + t = x + ⟨0, 1⟩ ∨ t = x + 1 + ⟨0, 1⟩) with e | e | e | e + · left; exact congrArg Zsqrtd.re e + · right; simpa using congrArg Zsqrtd.re e + · left; simpa using congrArg Zsqrtd.re e + · right; simpa using congrArg Zsqrtd.re e + have fIm (t : GaussianInt) (ht : t ∈ f.domain) : + t.im = x.im ∨ t.im = x.im + 1 := by + change t ∈ (f.domain : Set GaussianInt) at ht + rw [df] at ht + rcases (by simpa using ht : t = x ∨ t = x + 1 ∨ + t = x + ⟨0, 1⟩ ∨ t = x + 1 + ⟨0, 1⟩) with e | e | e | e + · left; exact congrArg Zsqrtd.im e + · left; simpa using congrArg Zsqrtd.im e + · right; simpa using congrArg Zsqrtd.im e + · right; simpa using congrArg Zsqrtd.im e + have gRe (t : GaussianInt) (ht : t ∈ g.domain) : + t.re = x.re ∨ t.re = x.re + 1 := by + have hm : t.re = (x + ⟨0, 1⟩).re ∨ t.re = (x + ⟨0, 1⟩).re + 1 := by + change t ∈ (g.domain : Set GaussianInt) at ht + rw [dg] at ht + rcases (by simpa using ht : t = x + ⟨0, 1⟩ ∨ + t = x + ⟨0, 1⟩ + 1 ∨ t = x + ⟨0, 1⟩ + ⟨0, 1⟩ ∨ + t = x + ⟨0, 1⟩ + 1 + ⟨0, 1⟩) with e | e | e | e + · left; exact congrArg Zsqrtd.re e + · right; simpa using congrArg Zsqrtd.re e + · left; simpa using congrArg Zsqrtd.re e + · right; simpa using congrArg Zsqrtd.re e + simpa [Zsqrtd.add_def] using hm + have gIm (t : GaussianInt) (ht : t ∈ g.domain) : + t.im = x.im + 1 ∨ t.im = x.im + 2 := by + have hm : t.im = (x + ⟨0, 1⟩).im ∨ + t.im = (x + ⟨0, 1⟩).im + 1 := by + change t ∈ (g.domain : Set GaussianInt) at ht + rw [dg] at ht + rcases (by simpa using ht : t = x + ⟨0, 1⟩ ∨ + t = x + ⟨0, 1⟩ + 1 ∨ t = x + ⟨0, 1⟩ + ⟨0, 1⟩ ∨ + t = x + ⟨0, 1⟩ + 1 + ⟨0, 1⟩) with e | e | e | e + · left; exact congrArg Zsqrtd.im e + · left; simpa using congrArg Zsqrtd.im e + · right; simpa using congrArg Zsqrtd.im e + · right; simpa using congrArg Zsqrtd.im e + rcases hm with hm | hm + · left; simpa [Zsqrtd.add_def] using hm + · right + have hm' : t.im = x.im + 1 + 1 := by simpa [Zsqrtd.add_def] using hm + omega + have common : ∀ t, t ∈ f.domain → t ∈ g.domain → + t = x + ⟨0, 1⟩ ∨ t = x + 1 + ⟨0, 1⟩ := by + intro t ht kt + have him : t.im = (x + ⟨0, 1⟩).im := by + change t.im = x.im + 1 + rcases fIm t ht with h | h <;> rcases gIm t kt with h' | h' <;> omega + rcases fRe t ht with hr | hr <;> rcases gRe t kt with hr' | hr' + · left + apply Zsqrtd.ext + · simpa [Zsqrtd.add_def] using hr + · simpa [Zsqrtd.add_def] using him + · right + apply Zsqrtd.ext + · simpa [Zsqrtd.add_def] using hr' + · simpa [Zsqrtd.add_def] using him + · exfalso; omega + · right + apply Zsqrtd.ext + · simpa [Zsqrtd.add_def] using hr + · simpa [Zsqrtd.add_def] using him + have xif : x + ⟨0, 1⟩ ∈ f.domain := by + change x + ⟨0, 1⟩ ∈ (f.domain : Set _); rw [df]; simp + have xig : x + ⟨0, 1⟩ ∈ g.domain := by + change x + ⟨0, 1⟩ ∈ (g.domain : Set _); rw [dg]; simp + have x1if : x + 1 + ⟨0, 1⟩ ∈ f.domain := by + change x + 1 + ⟨0, 1⟩ ∈ (f.domain : Set _); rw [df]; simp + have x1ig : x + 1 + ⟨0, 1⟩ ∈ g.domain := by + change x + 1 + ⟨0, 1⟩ ∈ (g.domain : Set _) + rw [dg] + simp [add_assoc, add_comm, add_left_comm] + have endpoint : g.value (x + 1 + ⟨0, 1⟩) - + f.value (x + 1 + ⟨0, 1⟩) = + g.value (x + ⟨0, 1⟩) - f.value (x + ⟨0, 1⟩) := by + rw [vg _ x1ig, vf _ x1if, vg _ xig, vf _ xif] + have h01 : (x + ⟨0, 1⟩) - x = ⟨0, 1⟩ := by abel + have h11 : (x + 1 + ⟨0, 1⟩) - x = 1 + ⟨0, 1⟩ := by abel + have h00 : (x + ⟨0, 1⟩) - (x + ⟨0, 1⟩) = 0 := by simp + have h10 : (x + 1 + ⟨0, 1⟩) - (x + ⟨0, 1⟩) = 1 := by abel + simp? [CurvatureOneOdometer, h01, h11, h10, + Zsqrtd.ext_iff] + have hcoefMul : x.re * β.re - x.re * α.re = x.re * z.im := by + calc + x.re * β.re - x.re * α.re = x.re * (β.re - α.re) := by ring + _ = x.re * z.im := by rw [hcoef] + ring_nf at hcoefMul ⊢ + omega + right + refine ⟨g.value (x + ⟨0, 1⟩) - f.value (x + ⟨0, 1⟩), ?_⟩ + intro t ht kt + rcases common t ht kt with rfl | rfl + · rfl + · exact endpoint + +private theorem diagonalUnique : + (by + classical + exact + (BandCircle) → (∀ (h : PartialOdometer), ∀ (k : PartialOdometer), (GaussianInt) → (∀ (u : + LatticeCell), ∀ (v : LatticeCell), (GaussianInt) → ((GaussianInt) → ((∀ (y : + GaussianInt), (y ∈ h.domain) → (y.re = u.re ∨ y.re = u.re + 1)) → ((∀ (y : + GaussianInt), (y ∈ h.domain) → (y.im = u.im ∨ y.im = u.im + 1)) → ((∀ (y : + GaussianInt), (y ∈ k.domain) → (y.re = v.re ∨ y.re = v.re + 1)) → ((∀ (y : + GaussianInt), (y ∈ k.domain) → (y.im = v.im ∨ y.im = v.im + 1)) → (v.re - u.re = (-1 + : ℤ) ∨ v.re - u.re = (1 : ℤ) → v.im - u.im = (-1 : ℤ) ∨ v.im - u.im = (1 : ℤ) → ∀ (s + : GaussianInt), ∀ (t : GaussianInt), s ∈ h.domain → s ∈ k.domain → t ∈ h.domain → t ∈ + k.domain → s = t)))))))) + ) := by + classical + intro C h k z u v a a' hReMem hImMem kReMem kImMem hx hy s t hs ks ht kt + have hre : s.re = t.re := by + rcases hx with hx | hx + · rcases hReMem s hs with hs0 | hs1 <;> + rcases kReMem s ks with ks0 | ks1 <;> + rcases hReMem t ht with ht0 | ht1 <;> + rcases kReMem t kt with kt0 | kt1 <;> omega + · rcases hReMem s hs with hs0 | hs1 <;> + rcases kReMem s ks with ks0 | ks1 <;> + rcases hReMem t ht with ht0 | ht1 <;> + rcases kReMem t kt with kt0 | kt1 <;> omega + have him : s.im = t.im := by + rcases hy with hy | hy + · rcases hImMem s hs with hs0 | hs1 <;> + rcases kImMem s ks with ks0 | ks1 <;> + rcases hImMem t ht with ht0 | ht1 <;> + rcases kImMem t kt with kt0 | kt1 <;> omega + · rcases hImMem s hs with hs0 | hs1 <;> + rcases kImMem s ks with ks0 | ks1 <;> + rcases hImMem t ht with ht0 | ht1 <;> + rcases kImMem t kt with kt0 | kt1 <;> omega + apply Zsqrtd.ext <;> assumption + +private theorem compatibilitySymm : + (by + classical + exact + (BandCircle) → ((GaussianInt) → ((LatticeCell) → ((LatticeCell) → ((GaussianInt) → + ((GaussianInt) → (∀ (f : PartialOdometer), ∀ (g : PartialOdometer), + OdometerCompatibility f g → OdometerCompatibility g f)))))) + ) := by + classical + intro C z u v a a' f g hfg + rcases hfg with hdisj | ⟨c, hc⟩ + · apply Or.inl + apply Set.disjoint_left.mpr + intro x hx hy + exact ((Set.disjoint_left.mp hdisj) hy) hx + · right + refine ⟨-c, ?_⟩ + intro x hx hy + have h := hc x hy hx + omega + +end UnitBoundaryProof + +namespace UnitBoundaryDetails + +private theorem hzz : + (by + classical + exact + ∀ (C : BandCircle), ∀ (z : GaussianInt), (C.1.1 = ((1 : ℤ), (1 : GaussianInt) + (2 : + GaussianInt) * z)) → (∀ (z' : + GaussianInt), (C.1.1 = ((1 : ℤ), (1 : + GaussianInt) + (2 : GaussianInt) * z')) → (z = z')) ) := by + classical + intro C z hCz z' hCz' + have hcoord := congrArg Prod.snd (hCz.symm.trans hCz') + have hreal := congrArg Zsqrtd.re hcoord + have himag := congrArg Zsqrtd.im hcoord + simp at hreal himag + apply Zsqrtd.ext <;> omega + +private theorem canonicalSlope : + (by + classical + exact + ∀ (w : GaussianInt), PartialOdometerSlope (CurvatureOneOdometer w) = some ((↑w.im : ℝ) / + (2 : ℝ), (↑w.im : ℝ) / (2 : ℝ)) ) := by + classical + intro w + have hs : PartialOdometerSquares (CurvatureOneOdometer w) = {0} := by + change PartialOdometerSquares (CurvatureOneOdometer 0) = {0} + decide +kernel + unfold PartialOdometerSlope + rw [hs] + norm_num [CurvatureOneOdometer, Zsqrtd.ext_iff] + +private theorem hpform : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (a : GaussianInt), ∀ + (b : ℤ), (h = PartialOdometerAffineTranslate (CurvatureOneOdometer z) u a b) → ((∀ (w + : GaussianInt), PartialOdometerSlope (CurvatureOneOdometer w) = some (((w.im : ℝ) / + 2), ((w.im : ℝ) / 2))) → (PartialOdometerSlope h = some ((z.im : ℝ) / 2 + a.re, (z.im + : ℝ) / 2 + a.im))) ) := by + classical + intro h z u a b hheq canonicalSlope + rw [hheq, (PartialOdometerAffineTranslateFormulas _ u a b).2.2.2.2.2, + canonicalSlope] + rfl + +private theorem hrform : + (by + classical + exact + ∀ (k : PartialOdometer), ∀ (z : GaussianInt), ∀ (v : LatticeCell), ∀ (a' : GaussianInt), + ∀ (b' : ℤ), (k = PartialOdometerAffineTranslate (CurvatureOneOdometer z) v a' b') → + ((∀ (w : GaussianInt), PartialOdometerSlope (CurvatureOneOdometer w) = some (((w.im : + ℝ) / 2), ((w.im : ℝ) / 2))) → (PartialOdometerSlope k = some ((z.im : ℝ) / 2 + a'.re, + (z.im : ℝ) / 2 + a'.im))) ) := by + classical + intro k z v a' b' hkeq canonicalSlope + rw [hkeq, (PartialOdometerAffineTranslateFormulas _ v a' b').2.2.2.2.2, + canonicalSlope] + rfl + +private theorem hmatrix : + (by + classical + exact + ∀ (C : BandCircle), (C.1.1.1 = (1 : ℤ)) → + (CircleMatrix C = + let c : ℝ := C.1.1.1 + let x : ℝ := C.1.1.2.re + let y : ℝ := C.1.1.2.im + (2 * c)⁻¹ • ![![1 + x, y], ![y, 1 - x]]) ) := by + classical + intro C hc + ext i j + fin_cases i <;> fin_cases j <;> + simp [CircleMatrix, BandCircleEuclideanData] + all_goals field_simp + +private theorem hRe : + (by + classical + exact + ∀ (C : BandCircle), ∀ (z : GaussianInt), (C.1.1 = ((1 : ℤ), (1 : GaussianInt) + (2 : + GaussianInt) * z)) → + ((C.1.1.2.re : ℝ) = 1 + 2 * (z.re : ℝ)) ) := by + classical + intro C z hCz + have he := congrArg (fun q : CircleCoordinates => q.2.re) hCz + simp? at he + exact_mod_cast he + +private theorem hIm : + (by + classical + exact + ∀ (C : BandCircle), ∀ (z : GaussianInt), (C.1.1 = ((1 : ℤ), (1 : GaussianInt) + (2 : + GaussianInt) * z)) → + ((C.1.1.2.im : ℝ) = 2 * (z.im : ℝ)) ) := by + classical + intro C z hCz + have he := congrArg (fun q : CircleCoordinates => q.2.im) hCz + simp? at he + exact_mod_cast he + +private theorem hmatrixUnit : + (by + classical + exact + ∀ (C : BandCircle), (C.1.1.1 = (1 : ℤ)) → (∀ + (z : GaussianInt), (CircleMatrix C = + let c : ℝ := C.1.1.1 + let x : ℝ := C.1.1.2.re + let y : ℝ := C.1.1.2.im + (2 * c)⁻¹ • ![![1 + x, y], ![y, 1 - x]]) → (((C.1.1.2.re : ℝ) = 1 + 2 * (z.re : ℝ)) → + (((C.1.1.2.im : ℝ) = 2 * (z.im : ℝ)) → (CircleMatrix C = ![![1 + (z.re : ℝ), (z.im + : ℝ)], ![(z.im : ℝ), -(z.re : ℝ)]])))) ) := by + classical + intro C hc z hmatrix hRe hIm + rw [hmatrix] + dsimp + ext i j + fin_cases i <;> fin_cases j <;> + simp [hc, hRe, hIm]; field_simp; ring + +private theorem hcent : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (V : ProtoTile), V.cells = {x} → TileCentroid V = ((↑x.re : ℝ) + + (1 / 2 : ℝ), (↑x.im : ℝ) + (1 / 2 : ℝ)) ) := by + classical + intro x V hV + simp [TileCentroid, hV] + +private theorem h0Real : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : GaussianInt), ∀ (a' + : GaussianInt), (((↑z.im : ℝ) / (2 : ℝ) + (↑a'.re : ℝ), (↑z.im : ℝ) / (2 : ℝ) + + (↑a'.im : ℝ)).1 - ((↑z.im : ℝ) / (2 : ℝ) + (↑a.re : ℝ), (↑z.im : ℝ) / (2 : ℝ) + + (↑a.im : ℝ)).1 = ![![(1 : ℝ) + (↑z.re : ℝ), (↑z.im : ℝ)], ![(↑z.im : ℝ), -(↑z.re : + ℝ)]] (0 : Fin (2 : ℕ)) (0 : Fin (2 : ℕ)) * (((↑v.re : ℝ) + (1 / 2 : ℝ), (↑v.im : ℝ) + + (1 / 2 : ℝ)).1 - ((↑u.re : ℝ) + (1 / 2 : ℝ), (↑u.im : ℝ) + (1 / 2 : ℝ)).1) + ![![(1 : + ℝ) + (↑z.re : ℝ), (↑z.im : ℝ)], ![(↑z.im : ℝ), -(↑z.re : ℝ)]] (0 : Fin (2 : ℕ)) (1 : + Fin (2 : ℕ)) * (((↑v.re : ℝ) + (1 / 2 : ℝ), (↑v.im : ℝ) + (1 / 2 : ℝ)).2 - ((↑u.re : + ℝ) + (1 / 2 : ℝ), (↑u.im : ℝ) + (1 / 2 : ℝ)).2)) → ((a'.re : ℝ) - a.re = (1 + (z.re : + ℝ)) * ((v.re : ℝ) - u.re) + (z.im : ℝ) * ((v.im : ℝ) - u.im)) ) := by + classical + intro z u v a a' h0 + dsimp at h0 + nlinarith [h0] + +private theorem h1Real : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : GaussianInt), ∀ (a' + : GaussianInt), (((↑z.im : ℝ) / (2 : ℝ) + (↑a'.re : ℝ), (↑z.im : ℝ) / (2 : ℝ) + + (↑a'.im : ℝ)).2 - ((↑z.im : ℝ) / (2 : ℝ) + (↑a.re : ℝ), (↑z.im : ℝ) / (2 : ℝ) + + (↑a.im : ℝ)).2 = ![![(1 : ℝ) + (↑z.re : ℝ), (↑z.im : ℝ)], ![(↑z.im : ℝ), -(↑z.re : + ℝ)]] (1 : Fin (2 : ℕ)) (0 : Fin (2 : ℕ)) * (((↑v.re : ℝ) + (1 / 2 : ℝ), (↑v.im : ℝ) + + (1 / 2 : ℝ)).1 - ((↑u.re : ℝ) + (1 / 2 : ℝ), (↑u.im : ℝ) + (1 / 2 : ℝ)).1) + ![![(1 : + ℝ) + (↑z.re : ℝ), (↑z.im : ℝ)], ![(↑z.im : ℝ), -(↑z.re : ℝ)]] (1 : Fin (2 : ℕ)) (1 : + Fin (2 : ℕ)) * (((↑v.re : ℝ) + (1 / 2 : ℝ), (↑v.im : ℝ) + (1 / 2 : ℝ)).2 - ((↑u.re : + ℝ) + (1 / 2 : ℝ), (↑u.im : ℝ) + (1 / 2 : ℝ)).2)) → ((a'.im : ℝ) - a.im = (z.im : ℝ) * + ((v.re : ℝ) - u.re) - (z.re : ℝ) * ((v.im : ℝ) - u.im)) ) := by + classical + intro z u v a a' h1 + dsimp at h1 + nlinarith [h1] + +private theorem h0Int : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : GaussianInt), ∀ (a' + : GaussianInt), ((a'.re : ℝ) - a.re = (1 + (z.re : ℝ)) * ((v.re : ℝ) - u.re) + (z.im + : ℝ) * ((v.im : ℝ) - u.im)) → (a'.re - a.re = (1 + z.re) * (v.re - u.re) + z.im * + (v.im - u.im)) ) := by + classical + intro z u v a a' h0Real + exact_mod_cast h0Real + +private theorem h1Int : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : GaussianInt), ∀ (a' + : GaussianInt), ((a'.im : ℝ) - a.im = (z.im : ℝ) * ((v.re : ℝ) - u.re) - (z.re : ℝ) * + ((v.im : ℝ) - u.im)) → (a'.im - a.im = z.im * (v.re - u.re) - z.re * (v.im - u.im)) ) + := by + classical + intro z u v a a' h1Real + exact_mod_cast h1Real + +private theorem hdomSq : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (u : LatticeCell), (T.cells = {u}) → + (((↑h.domain : Set GaussianInt) = FootprintVertices T) → ((h.domain : Set + GaussianInt) = {u, u + 1, u + ⟨0, 1⟩, u + 1 + ⟨0, 1⟩})) ) := by + classical + intro T h u hTu hdu + ext y + simp [hdu, FootprintVertices, hTu] + +private theorem kdomSq : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (v : LatticeCell), (U.cells = {v}) → + (((↑k.domain : Set GaussianInt) = FootprintVertices U) → ((k.domain : Set + GaussianInt) = {v, v + 1, v + ⟨0, 1⟩, v + 1 + ⟨0, 1⟩})) ) := by + classical + intro U k v hUv hdu' + ext y + simp [hdu', FootprintVertices, hUv] + +private theorem hval : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (a : GaussianInt), ∀ + (b : ℤ), (h = PartialOdometerAffineTranslate (CurvatureOneOdometer z) u a b) → (∀ y ∈ + h.domain, h.value y = (CurvatureOneOdometer z).value (y - u) + a.re * y.re + a.im * + y.im + b) ) := by + classical + intro h z u a b hheq y hy + rw [hheq] at hy ⊢ + exact (PartialOdometerAffineTranslateFormulas _ u a b).2.2.1 y hy + +private theorem kval : + (by + classical + exact + ∀ (k : PartialOdometer), ∀ (z : GaussianInt), ∀ (v : LatticeCell), ∀ (a' : GaussianInt), + ∀ (b' : ℤ), (k = PartialOdometerAffineTranslate (CurvatureOneOdometer z) v a' b') → + (∀ y ∈ k.domain, k.value y = (CurvatureOneOdometer z).value (y - v) + a'.re * y.re + + a'.im * y.im + b') ) := by + classical + intro k z v a' b' hkeq y hy + rw [hkeq] at hy ⊢ + exact (PartialOdometerAffineTranslateFormulas _ v a' b').2.2.1 y hy + +private theorem overlapBounds : + (by + classical + exact + (BandCircle) → (∀ (h : PartialOdometer), ∀ (k : PartialOdometer), (GaussianInt) → (∀ (u : + LatticeCell), ∀ (v : LatticeCell), (GaussianInt) → ((GaussianInt) → ((∀ (y : + GaussianInt), (y ∈ h.domain) → (y.re = u.re ∨ y.re = u.re + 1)) → ((∀ (y : + GaussianInt), (y ∈ h.domain) → (y.im = u.im ∨ y.im = u.im + 1)) → ((∀ (y : + GaussianInt), (y ∈ k.domain) → (y.re = v.re ∨ y.re = v.re + 1)) → ((∀ (y : + GaussianInt), (y ∈ k.domain) → (y.im = v.im ∨ y.im = v.im + 1)) → (∀ y ∈ h.domain, y + ∈ k.domain → (-1 : ℤ) ≤ v.re - u.re ∧ v.re - u.re ≤ (1 : ℤ) ∧ (-1 : ℤ) ≤ v.im - u.im + ∧ v.im - u.im ≤ (1 : ℤ))))))))) ) := by + classical + intro C h k z u v a a' hReMem hImMem kReMem kImMem y hy ky + rcases hReMem y hy with h0 | h1 <;> rcases kReMem y ky with k0 | k1 <;> + rcases hImMem y hy with hi0 | hi1 <;> rcases kImMem y ky with ki0 | ki1 <;> + omega + +private theorem hcoefAt798 : + (by + classical + exact + (BandCircle) → (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : + GaussianInt), ∀ (a' : GaussianInt), (a'.im - a.im = z.im * (v.re - u.re) - z.re * + (v.im - u.im)) → ((v.re - u.re = (-1 : ℤ)) → ((v.im - u.im = (0 : ℤ)) → (a.im - a'.im + = z.im)))) ) := by + classical + intro C z u v a a' h1Int hx hy + rw [hx, hy] at h1Int + omega + +private theorem hcoefAt810 : + (by + classical + exact + (BandCircle) → (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : + GaussianInt), ∀ (a' : GaussianInt), (a'.re - a.re = (1 + z.re) * (v.re - u.re) + z.im + * (v.im - u.im)) → ((v.re - u.re = (0 : ℤ)) → ((v.im - u.im = (-1 : ℤ)) → (a.re - + a'.re = z.im)))) ) := by + classical + intro C z u v a a' h0Int hx hy + rw [hx, hy] at h0Int + omega + +private theorem hAre : + (by + classical + exact + (BandCircle) → (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : + GaussianInt), ∀ (a' : GaussianInt), (a'.re - a.re = (1 + z.re) * (v.re - u.re) + z.im + * (v.im - u.im)) → ((v.re - u.re = (0 : ℤ)) → ((v.im - u.im = (0 : ℤ)) → (a'.re = + a.re)))) ) := by + classical + intro C z u v a a' h0Int hx hy + rw [hx, hy] at h0Int + omega + +private theorem hAim : + (by + classical + exact + (BandCircle) → (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : + GaussianInt), ∀ (a' : GaussianInt), (a'.im - a.im = z.im * (v.re - u.re) - z.re * + (v.im - u.im)) → ((v.re - u.re = (0 : ℤ)) → ((v.im - u.im = (0 : ℤ)) → (a'.im = + a.im)))) ) := by + classical + intro C z u v a a' h1Int hx hy + rw [hx, hy] at h1Int + omega + +private theorem hcoefAt830 : + (by + classical + exact + (BandCircle) → (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : + GaussianInt), ∀ (a' : GaussianInt), (a'.re - a.re = (1 + z.re) * (v.re - u.re) + z.im + * (v.im - u.im)) → ((v.re - u.re = (0 : ℤ)) → ((v.im - u.im = (1 : ℤ)) → (a'.re - + a.re = z.im)))) ) := by + classical + intro C z u v a a' h0Int hx hy + rw [hx, hy] at h0Int + omega + +private theorem hcoefAt842 : + (by + classical + exact + (BandCircle) → (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : + GaussianInt), ∀ (a' : GaussianInt), (a'.im - a.im = z.im * (v.re - u.re) - z.re * + (v.im - u.im)) → ((v.re - u.re = (1 : ℤ)) → ((v.im - u.im = (0 : ℤ)) → (a'.im - a.im + = z.im)))) ) := by + classical + intro C z u v a a' h1Int hx hy + rw [hx, hy] at h1Int + omega + +end UnitBoundaryDetails + +theorem P4261T2UnitBoundary + (C : BandCircle) (hc : C.1.1.1 = 1) + (T U : ProtoTile) (h k : PartialOdometer) + (hh : TileOdometer C.1.1 T h) (hk : TileOdometer C.1.1 U k) + (p r : Real × Real) + (hp : PartialOdometerSlope h = some p) (hr : PartialOdometerSlope k = some r) + (h0 : r.1 - p.1 = CircleMatrix C 0 0 * ((TileCentroid U).1 - (TileCentroid T).1) + + CircleMatrix C 0 1 * ((TileCentroid U).2 - (TileCentroid T).2)) + (h1 : r.2 - p.2 = CircleMatrix C 1 0 * ((TileCentroid U).1 - (TileCentroid T).1) + + CircleMatrix C 1 1 * ((TileCentroid U).2 - (TileCentroid T).2)) : + OdometerCompatibility h k := by +-- BODY + classical + have unitForm : ∀ (c : CircleCoordinates) (hc : c.1 = 1) + (T : ProtoTile) (h : PartialOdometer), TileOdometer c T h → + ∃ z x, c = (1, 1 + 2 * z) ∧ T.cells = {x} ∧ + (h.domain : Set GaussianInt) = FootprintVertices T ∧ + OdometerTranslation h (CurvatureOneOdometer z) := UnitBoundaryProof.unitForm C + obtain ⟨z, u, hCz, hTu, hdu, hth⟩ := + unitForm C.1.1 hc T h hh + obtain ⟨z', v, hCz', hUv, hdu', hku⟩ := + unitForm C.1.1 hc U k hk + have hzz : z = z' := UnitBoundaryDetails.hzz C z hCz z' hCz' + subst z' + obtain ⟨⟨a, b, hheq⟩, ⟨a', b', hkeq⟩⟩ : + (∃ a : GaussianInt, ∃ b : ℤ, + h = PartialOdometerAffineTranslate (CurvatureOneOdometer z) u a b) ∧ + (∃ a : GaussianInt, ∃ b : ℤ, + k = PartialOdometerAffineTranslate (CurvatureOneOdometer z) v a b) := by + -- The translation is anchored by the least vertex of the four-corner domain. + have unitData : ∀ (x : GaussianInt) (T : ProtoTile) (h : PartialOdometer), + T.cells = {x} → (h.domain : Set GaussianInt) = FootprintVertices T → + OdometerTranslation h (CurvatureOneOdometer z) → + ∃ a : GaussianInt, ∃ b : ℤ, + h = PartialOdometerAffineTranslate (CurvatureOneOdometer z) x a b := + UnitBoundaryProof.unitData C z + exact ⟨unitData u T h hTu hdu hth, + unitData v U k hUv hdu' hku⟩ + have canonicalSlope (w : GaussianInt) : + PartialOdometerSlope (CurvatureOneOdometer w) = + some (((w.im : ℝ) / 2), ((w.im : ℝ) / 2)) := UnitBoundaryDetails.canonicalSlope w + have hpform : PartialOdometerSlope h = + some ((z.im : ℝ) / 2 + a.re, (z.im : ℝ) / 2 + a.im) := UnitBoundaryDetails.hpform h z u a b + hheq canonicalSlope + have hrform : PartialOdometerSlope k = + some ((z.im : ℝ) / 2 + a'.re, (z.im : ℝ) / 2 + a'.im) := UnitBoundaryDetails.hrform k z v + a' b' hkeq canonicalSlope + have hp' : p = ((z.im : ℝ) / 2 + a.re, (z.im : ℝ) / 2 + a.im) := + Option.some.inj (hp.symm.trans hpform) + have hr' : r = ((z.im : ℝ) / 2 + a'.re, (z.im : ℝ) / 2 + a'.im) := + Option.some.inj (hr.symm.trans hrform) + have hmatrix : CircleMatrix C = + let c : ℝ := C.1.1.1 + let x : ℝ := C.1.1.2.re + let y : ℝ := C.1.1.2.im + (2 * c)⁻¹ • ![![1 + x, y], ![y, 1 - x]] := UnitBoundaryDetails.hmatrix C hc + have hRe : (C.1.1.2.re : ℝ) = 1 + 2 * (z.re : ℝ) := UnitBoundaryDetails.hRe C z hCz + have hIm : (C.1.1.2.im : ℝ) = 2 * (z.im : ℝ) := UnitBoundaryDetails.hIm C z hCz + have hmatrixUnit : CircleMatrix C = + ![![1 + (z.re : ℝ), (z.im : ℝ)], + ![(z.im : ℝ), -(z.re : ℝ)]] := UnitBoundaryDetails.hmatrixUnit C hc z hmatrix hRe hIm + have hcent (x : GaussianInt) (V : ProtoTile) (hV : V.cells = {x}) : + TileCentroid V = (((x.re : ℝ) + 1 / 2), ((x.im : ℝ) + 1 / 2)) := UnitBoundaryDetails.hcent + x V hV + rw [hp', hr', hmatrixUnit, + hcent u T hTu, hcent v U hUv] at h0 h1 + have h0Real : (a'.re : ℝ) - a.re = + (1 + (z.re : ℝ)) * ((v.re : ℝ) - u.re) + + (z.im : ℝ) * ((v.im : ℝ) - u.im) := UnitBoundaryDetails.h0Real z u v a a' h0 + have h1Real : (a'.im : ℝ) - a.im = + (z.im : ℝ) * ((v.re : ℝ) - u.re) - + (z.re : ℝ) * ((v.im : ℝ) - u.im) := UnitBoundaryDetails.h1Real z u v a a' h1 + have h0Int : a'.re - a.re = + (1 + z.re) * (v.re - u.re) + z.im * (v.im - u.im) := UnitBoundaryDetails.h0Int z u v a a' + h0Real + have h1Int : a'.im - a.im = + z.im * (v.re - u.re) - z.re * (v.im - u.im) := UnitBoundaryDetails.h1Int z u v a a' h1Real + have hdomSq : (h.domain : Set GaussianInt) = + {u, u + 1, u + ⟨0, 1⟩, u + 1 + ⟨0, 1⟩} := UnitBoundaryDetails.hdomSq T h u hTu hdu + have kdomSq : (k.domain : Set GaussianInt) = + {v, v + 1, v + ⟨0, 1⟩, v + 1 + ⟨0, 1⟩} := UnitBoundaryDetails.kdomSq U k v hUv hdu' + have hval (y : GaussianInt) (hy : y ∈ h.domain) : + h.value y = (CurvatureOneOdometer z).value (y - u) + + a.re * y.re + a.im * y.im + b := UnitBoundaryDetails.hval h z u a b hheq y hy + have kval (y : GaussianInt) (hy : y ∈ k.domain) : + k.value y = (CurvatureOneOdometer z).value (y - v) + + a'.re * y.re + a'.im * y.im + b' := UnitBoundaryDetails.kval k z v a' b' hkeq y hy + have hReMem (y : GaussianInt) (hy : y ∈ h.domain) : + y.re = u.re ∨ y.re = u.re + 1 := UnitBoundaryProof.hReMem h u hdomSq y hy + have hImMem (y : GaussianInt) (hy : y ∈ h.domain) : + y.im = u.im ∨ y.im = u.im + 1 := UnitBoundaryProof.hImMem h u hdomSq y hy + have kReMem (y : GaussianInt) (hy : y ∈ k.domain) : + y.re = v.re ∨ y.re = v.re + 1 := UnitBoundaryProof.kReMem k v kdomSq y hy + have kImMem (y : GaussianInt) (hy : y ∈ k.domain) : + y.im = v.im ∨ y.im = v.im + 1 := UnitBoundaryProof.kImMem k v kdomSq y hy + have overlapBounds (y : GaussianInt) (hy : y ∈ h.domain) (ky : y ∈ k.domain) : + -1 ≤ v.re - u.re ∧ v.re - u.re ≤ 1 ∧ + -1 ≤ v.im - u.im ∧ v.im - u.im ≤ 1 := UnitBoundaryDetails.overlapBounds C h k z u v a a' + hReMem hImMem kReMem kImMem y hy ky + have horizontalPositive (f g : PartialOdometer) (x y α β : GaussianInt) + (B D : ℤ) + (df : (f.domain : Set GaussianInt) = + {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) + (dg : (g.domain : Set GaussianInt) = + {y, y + 1, y + ⟨0, 1⟩, y + 1 + ⟨0, 1⟩}) + (vf : ∀ t, t ∈ f.domain → f.value t = + (CurvatureOneOdometer z).value (t - x) + + α.re * t.re + α.im * t.im + B) + (vg : ∀ t, t ∈ g.domain → g.value t = + (CurvatureOneOdometer z).value (t - y) + + β.re * t.re + β.im * t.im + D) + (hstep : y = x + 1) (hcoef : β.im - α.im = z.im) : + OdometerCompatibility f g := UnitBoundaryProof.horizontalPositive C z u v a a' f g x y α β + B D df dg vf vg hstep hcoef + have verticalPositive (f g : PartialOdometer) (x y α β : GaussianInt) + (B D : ℤ) + (df : (f.domain : Set GaussianInt) = + {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) + (dg : (g.domain : Set GaussianInt) = + {y, y + 1, y + ⟨0, 1⟩, y + 1 + ⟨0, 1⟩}) + (vf : ∀ t, t ∈ f.domain → f.value t = + (CurvatureOneOdometer z).value (t - x) + + α.re * t.re + α.im * t.im + B) + (vg : ∀ t, t ∈ g.domain → g.value t = + (CurvatureOneOdometer z).value (t - y) + + β.re * t.re + β.im * t.im + D) + (hstep : y = x + ⟨0, 1⟩) (hcoef : β.re - α.re = z.im) : + OdometerCompatibility f g := UnitBoundaryProof.verticalPositive C z u v a a' f g x y α β B + D df dg vf vg hstep hcoef + have diagonalUnique + (hx : v.re - u.re = -1 ∨ v.re - u.re = 1) + (hy : v.im - u.im = -1 ∨ v.im - u.im = 1) + (s t : GaussianInt) (hs : s ∈ h.domain) (ks : s ∈ k.domain) + (ht : t ∈ h.domain) (kt : t ∈ k.domain) : s = t := UnitBoundaryProof.diagonalUnique C h k z + u v a a' hReMem hImMem kReMem kImMem hx hy s t hs ks ht kt + have compatibilitySymm (f g : PartialOdometer) : + OdometerCompatibility f g → OdometerCompatibility g f := + UnitBoundaryProof.compatibilitySymm C z u v a a' f g + by_cases hoverlap : ∃ y, y ∈ h.domain ∧ y ∈ k.domain + · obtain ⟨w, wh, wk⟩ := hoverlap + have bounds := overlapBounds w wh wk + rcases bounds with ⟨hre0, hre1, him0, him1⟩ + have hx : v.re - u.re = -1 ∨ v.re - u.re = 0 ∨ v.re - u.re = 1 := by omega + have hy : v.im - u.im = -1 ∨ v.im - u.im = 0 ∨ v.im - u.im = 1 := by omega + rcases hx with hx | hx | hx <;> rcases hy with hy | hy | hy + · right + refine ⟨k.value w - h.value w, ?_⟩ + intro y yh yk + have hEq := diagonalUnique (Or.inl hx) (Or.inl hy) y w yh yk wh wk + rw [hEq] + · have vu : u = v + 1 := by + apply Zsqrtd.ext <;> simp [] <;> omega + have hcoef : a.im - a'.im = z.im := UnitBoundaryDetails.hcoefAt798 C z u v a a' h1Int hx hy + exact compatibilitySymm k h (horizontalPositive k h v u a' a b' b + kdomSq hdomSq kval hval vu hcoef) + · right + refine ⟨k.value w - h.value w, ?_⟩ + intro y yh yk + have hEq := diagonalUnique (Or.inl hx) (Or.inr hy) y w yh yk wh wk + rw [hEq] + · have vu : u = v + ⟨0, 1⟩ := by + apply Zsqrtd.ext <;> simp [] <;> omega + have hcoef : a.re - a'.re = z.im := UnitBoundaryDetails.hcoefAt810 C z u v a a' h0Int hx hy + exact compatibilitySymm k h (verticalPositive k h v u a' a b' b + kdomSq hdomSq kval hval vu hcoef) + · have vu : v = u := by + apply Zsqrtd.ext <;> omega + have hAre : a'.re = a.re := UnitBoundaryDetails.hAre C z u v a a' h0Int hx hy + have hAim : a'.im = a.im := UnitBoundaryDetails.hAim C z u v a a' h1Int hx hy + right + refine ⟨b' - b, ?_⟩ + intro y yh yk + rw [kval y yk, hval y yh, vu, hAre, hAim] + ring + · have vu : v = u + ⟨0, 1⟩ := by + apply Zsqrtd.ext <;> simp [] <;> omega + have hcoef : a'.re - a.re = z.im := UnitBoundaryDetails.hcoefAt830 C z u v a a' h0Int hx hy + exact verticalPositive h k u v a a' b b' + hdomSq kdomSq hval kval vu hcoef + · right + refine ⟨k.value w - h.value w, ?_⟩ + intro y yh yk + have hEq := diagonalUnique (Or.inr hx) (Or.inl hy) y w yh yk wh wk + rw [hEq] + · have vu : v = u + 1 := by + apply Zsqrtd.ext <;> simp [] <;> omega + have hcoef : a'.im - a.im = z.im := UnitBoundaryDetails.hcoefAt842 C z u v a a' h1Int hx hy + exact horizontalPositive h k u v a a' b b' + hdomSq kdomSq hval kval vu hcoef + · right + refine ⟨k.value w - h.value w, ?_⟩ + intro y yh yk + have hEq := diagonalUnique (Or.inr hx) (Or.inr hy) y w yh yk wh wk + rw [hEq] + · left + apply Set.disjoint_left.mpr + intro y hy ky + exact hoverlap ⟨y, hy, ky⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean new file mode 100644 index 0000000000..4a57b45cb5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean @@ -0,0 +1,1414 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4261T2LiteralInterface +public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryOdometerStrings +public import LeanPool.ApollonianSuperharmonic.OpposingStringInterfacePath +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.P4158T1AncestorCells +public import LeanPool.ApollonianSuperharmonic.P4250T1DefinedHalfIntegralSlope +public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance +public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation +public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEndpointPairUnique + +-- [TABLET NODE: P4261T2UnitInterface] + +/-! +# P4261T2UnitInterface + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace UnitInterfaceGeometry + +private theorem hcentMinusQ : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T : ProtoTile), ∀ (Rminus : + ProtoTile), ∀ (q' : Fin (4 : ℕ) → CircleCoordinates), (TileCentroid Rminus - + TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q' i.succ) (q' (0 : + Fin (4 : ℕ))) - BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' i.succ))) → ((q' i.succ = q + i.succ) → ((q' 0 = q 0) → (TileCentroid Rminus - TileCentroid T = (1 / 2 : Real) • + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0) - BandVectors.1 (q 0) (q + i.succ))))) ) := by + classical + intro q i T Rminus q' hcentMinus hqi' hq0' + rw [hqi', hq0'] at hcentMinus + exact hcentMinus + +private theorem hcentPlusQ : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T : ProtoTile), ∀ (Rplus : + ProtoTile), ∀ (q' : Fin (4 : ℕ) → CircleCoordinates), (TileCentroid Rplus - + TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q' i.succ) (q' (0 : + Fin (4 : ℕ))) + BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' i.succ))) → ((q' i.succ = q + i.succ) → ((q' 0 = q 0) → (TileCentroid Rplus - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + GaussianRealPoint + (BandVectors.1 (q 0) (q i.succ)))))) ) := by + classical + intro q i T Rplus q' hcentPlus hqi' hq0' + rw [hqi', hq0'] at hcentPlus + simpa [GaussianRealPoint] using hcentPlus + +private theorem hcentDiff : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T : ProtoTile), ∀ (Rminus : + ProtoTile), ∀ (Rplus : ProtoTile), (TileCentroid Rminus - TileCentroid T = (1 / 2 : + Real) • GaussianRealPoint (BandVectors.1 (q i.succ) (q 0) - BandVectors.1 (q 0) (q + i.succ))) → ((TileCentroid Rplus - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + GaussianRealPoint + (BandVectors.1 (q 0) (q i.succ)))) → (TileCentroid Rplus - TileCentroid Rminus = + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))) ) := by + classical + intro q i T Rminus Rplus hcentMinusQ hcentPlusQ + have hpR : (TileCentroid Rplus).1 - (TileCentroid T).1 = + (1 / 2 : Real) * ((GaussianInt.toComplex (BandVectors.1 (q i.succ) (q 0))).re + + (GaussianInt.toComplex (BandVectors.1 (q 0) (q i.succ))).re) := by + have hp := congrArg Prod.fst hcentPlusQ + simpa [GaussianRealPoint, Prod.smul_mk, Zsqrtd.re_add, + Int.cast_add, Prod.fst_sub] using hp + have hmR : (TileCentroid Rminus).1 - (TileCentroid T).1 = + (1 / 2 : Real) * ((GaussianInt.toComplex (BandVectors.1 (q i.succ) (q 0))).re - + (GaussianInt.toComplex (BandVectors.1 (q 0) (q i.succ))).re) := by + have hm := congrArg Prod.fst hcentMinusQ + simpa [GaussianRealPoint, Prod.smul_mk, Zsqrtd.re_sub, + Int.cast_sub, Prod.fst_sub] using hm + have hpI : (TileCentroid Rplus).2 - (TileCentroid T).2 = + (1 / 2 : Real) * ((GaussianInt.toComplex (BandVectors.1 (q i.succ) (q 0))).im + + (GaussianInt.toComplex (BandVectors.1 (q 0) (q i.succ))).im) := by + have hp := congrArg Prod.snd hcentPlusQ + simpa [GaussianRealPoint, Prod.smul_mk, Zsqrtd.im_add, + Int.cast_add, Prod.snd_sub] using hp + have hmI : (TileCentroid Rminus).2 - (TileCentroid T).2 = + (1 / 2 : Real) * ((GaussianInt.toComplex (BandVectors.1 (q i.succ) (q 0))).im - + (GaussianInt.toComplex (BandVectors.1 (q 0) (q i.succ))).im) := by + have hm := congrArg Prod.snd hcentMinusQ + simpa [GaussianRealPoint, Prod.smul_mk, Zsqrtd.im_sub, + Int.cast_sub, Prod.snd_sub] using hm + apply Prod.ext + · change (TileCentroid Rplus).1 - (TileCentroid Rminus).1 = + (((BandVectors.1 (q 0) (q i.succ)).re : Int) : Real) + simp only [GaussianInt.intCast_re] + linarith + · change (TileCentroid Rplus).2 - (TileCentroid Rminus).2 = + (((BandVectors.1 (q 0) (q i.succ)).im : Int) : Real) + simp only [GaussianInt.intCast_im] + linarith + +private theorem hnormSq : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), + let w : GaussianInt := BandVectors.1 (q 0) (q i.succ) + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) ^ (2 : ℕ) = (q i.succ).1 • (q (0 : Fin (4 + : ℕ))).2 - (q (0 : Fin (4 : ℕ))).1 • (q i.succ).2) → ((Zsqrtd.norm ((q i.succ).1 • (q + (0 : Fin (4 : ℕ))).2 - (q (0 : Fin (4 : ℕ))).1 • (q i.succ).2) = ((q (0 : Fin (4 : + ℕ))).1 + (q i.succ).1) ^ (2 : ℕ)) → (Zsqrtd.norm w ^ 2 = ((q 0).1 + (q i.succ).1) ^ + 2)) ) := by + classical + intro q i w hvector htangent + calc + Zsqrtd.norm w ^ 2 = Zsqrtd.norm (w ^ 2) := by + simp [w, pow_two] + _ = Zsqrtd.norm ((q i.succ).1 • (q 0).2 - + (q 0).1 • (q i.succ).2) := by + change Zsqrtd.norm (BandVectors.1 (q 0) (q i.succ) ^ 2) = _ + rw [hvector] + _ = _ := htangent + +private theorem hcurvSum : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (D : + BandCircle), ∀ (i : Fin 3), (q i.succ = D.1.1) → ((D.1.1.1 = (1 : ℤ)) → (5 < (q 0).1 + + (q i.succ).1))) ) := by + classical + intro q cfg D i hD hunit + rw [hD, hunit] + have hc := cfg.childLarge + omega + +private theorem hnormBig : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), + let w : GaussianInt := BandVectors.1 (q 0) (q i.succ) + (Zsqrtd.norm w ^ 2 = ((q 0).1 + (q i.succ).1) ^ 2) → ((5 < (q 0).1 + (q i.succ).1) → (5 < + Zsqrtd.norm w)) ) := by + classical + intro q i w hnormSq hcurvSum + have hn := GaussianInt.norm_nonneg w + nlinarith [hnormSq, sq_nonneg (Zsqrtd.norm w - 5)] + +private theorem hrealPointInj : + (by + classical + exact + Function.Injective GaussianRealPoint ) := by + classical + intro x y hxy + apply Zsqrtd.ext + · have hr := congrArg Prod.fst hxy + change ((x.re : Int) : Real) = ((y.re : Int) : Real) at hr + exact_mod_cast hr + · have hi := congrArg Prod.snd hxy + change ((x.im : Int) : Real) = ((y.im : Int) : Real) at hi + exact_mod_cast hi + +private theorem hRminusNeRplus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (Rminus : ProtoTile), ∀ (Rplus : + ProtoTile), (TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint + (BandVectors.1 (q 0) (q i.succ))) → ( + let w : GaussianInt := BandVectors.1 (q 0) (q i.succ) + (5 < Zsqrtd.norm w) → ((Function.Injective GaussianRealPoint) → (Rminus ≠ Rplus))) ) := by + classical + intro q i Rminus Rplus hcentDiff w hnormBig hrealPointInj heq + have hz : GaussianRealPoint w = 0 := by + have h := hcentDiff + rw [heq] at h + simpa [w] using h.symm + have hw : w = 0 := by + apply hrealPointInj + simpa [GaussianRealPoint] using hz + rw [hw] at hnormBig + norm_num [Zsqrtd.norm] at hnormBig + +private theorem hunitStepNorm : + (by + classical + exact + ∀ (orientation : Bool), ∀ (z : GaussianInt), (UnitTriangularStep orientation z) → + (Zsqrtd.norm z ≤ 2) ) := by + classical + intro orientation z hz + by_cases ho : orientation + · simp only [UnitTriangularStep, ite_eq_left ho] at hz + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with h | h | h | h | h | h <;> subst z <;> + norm_num [Zsqrtd.norm] + · simp only [UnitTriangularStep, ite_eq_right ho] at hz + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with h | h | h | h | h | h <;> subst z <;> + norm_num [Zsqrtd.norm] + +private theorem hnonadj : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (D : BandCircle), ∀ (i : Fin 3), (D.1.1.1 = (1 : ℤ)) + → (∀ (orientation : Bool), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), + (TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint (BandVectors.1 (q 0) (q + i.succ))) → ( + let w : GaussianInt := BandVectors.1 (q 0) (q i.succ) + (5 < Zsqrtd.norm w) → ((Function.Injective GaussianRealPoint) → ((∀ (z : GaussianInt), + (UnitTriangularStep orientation z) → (Zsqrtd.norm z ≤ 2)) → (¬ (if D.1.1.1 = 1 then ∃ + v : GaussianInt, UnitTriangularStep orientation v ∧ TileCentroid Rplus - TileCentroid + Rminus = GaussianRealPoint v else TileTouching Rminus Rplus)))))) ) := by + classical + intro q D i hunit orientation Rminus Rplus hcentDiff w hnormBig hrealPointInj hunitStepNorm + rw [hunit] + rintro ⟨v, hv, hcent⟩ + have hvEq : v = w := hrealPointInj (hcent.symm.trans hcentDiff) + subst v + have hn := hunitStepNorm w hv + omega + +private theorem htriplePositive : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (D : BandCircle), ∀ (i : Fin 3), (q (0 : Fin (4 : ℕ)) = C.1.1) → ((q + i.succ = D.1.1) → (∀ (T : ProtoTile), ∀ (U : ProtoTile), + (BandOrderedGeneralLayoutCertificate q cfg C T) → ((QuarterTurnSymmetric T) → + ((TileCentroid U - TileCentroid T = GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 + : Fin (4 : ℕ))))) → (∀ (Rplus : ProtoTile), ∀ (q' : Fin (4 : ℕ) → CircleCoordinates), + (q' (0 : Fin (4 : ℕ)) = C.1.1) → ((q' i.succ = D.1.1) → ((TileCentroid Rplus - + TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q' i.succ) (q' (0 : + Fin (4 : ℕ))) + BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' i.succ))) → ((BandPrototile + C.1.1 T) → ((BandPrototile C.1.1 U) → ((BandPrototile D.1.1 Rplus) → + ((Finset.Nonempty U.cells) → (Nonempty (ExactTileInterfaceTriple T U + Rplus))))))))))))) ) := by + classical + intro q cfg C D i hC hD T U cert hsym hc Rplus q' hq0 hqi hcentPlus hTband hUband hRplusBand hUNe + have hcentPlus : TileCentroid Rplus - TileCentroid T = + (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) := by + have hqi' : q' i.succ = q i.succ := hqi.trans hD.symm + have hq0' : q' 0 = q 0 := hq0.trans hC.symm + rw [hqi', hq0'] at hcentPlus + simpa [GaussianRealPoint] using hcentPlus + have hRplusBand' : BandPrototile (q i.succ) Rplus := by + rw [hD] + exact hRplusBand + have hTplus := (BandOrderedGeneralChildInterfaces q cfg C T cert hsym).2.1 + i Rplus hRplusBand' hcentPlus + have htransBand : BandPrototile C.1.1 (TileTranslation T + (BandVectors.1 (q i.succ) (q 0))) := by + exact BandPrototileTranslation _ _ _ hTband + have htransCent : TileCentroid (TileTranslation T + (BandVectors.1 (q i.succ) (q 0))) - TileCentroid T = + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) := by + rw [(TileTranslationFormulas T _).2.2.2.2.1] + exact Prod.ext (by simp [GaussianRealPoint]) (by simp [GaussianRealPoint]) + have htransCent' : TileCentroid (TileTranslation T + (BandVectors.1 (q i.succ) (q 0))) = TileCentroid U := by + have hdifference := htransCent.trans hc.symm + apply Prod.ext + · have hd := congrArg Prod.fst hdifference + change (TileCentroid (TileTranslation T (BandVectors.1 (q i.succ) (q 0)))).1 - + (TileCentroid T).1 = (TileCentroid U).1 - (TileCentroid T).1 at hd + linarith + · have hd := congrArg Prod.snd hdifference + change (TileCentroid (TileTranslation T (BandVectors.1 (q i.succ) (q 0)))).2 - + (TileCentroid T).2 = (TileCentroid U).2 - (TileCentroid T).2 at hd + linarith + obtain ⟨htransCells, htransAnchor⟩ := BandPrototileCentroidUnique C.1.1 + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U htransBand hUband + htransCent' + obtain ⟨E⟩ := hTplus + obtain ⟨E'⟩ := ExactTileInterfaceTripleRetargetMiddle T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U Rplus + htransCells (by + intro hempty + rw [htransCells] at hempty + exact (Finset.Nonempty.ne_empty hUNe hempty).elim) E + exact ⟨E'⟩ + +private theorem hFCellsInvolutive : + (by + classical + exact + (Fin 4 → CircleCoordinates) → ((BandCircle) → ((Fin 3) → (∀ (centerShift : GaussianInt), + let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift + ∀ (X : ProtoTile), (F (F X)).cells = X.cells))) ) := by + classical + intro q D i centerShift F X + have hfun : (GaussianTranslation centerShift ∘ + (fun x : GaussianInt => -x - 1 - (⟨0, 1⟩ : GaussianInt)) ∘ + GaussianTranslation centerShift ∘ + (fun x : GaussianInt => -x - 1 - (⟨0, 1⟩ : GaussianInt))) = id := by + funext z + apply Zsqrtd.ext <;> simp [Function.comp_def, GaussianTranslation] <;> omega + simp only [F, TileTranslationFormulas, TileHalfTurnFormulas, Finset.image_image] + rw [hfun, Finset.image_id] + +private theorem hFCellCongr : + (by + classical + exact + ∀ (centerShift : GaussianInt), + let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift + ∀ {X : ProtoTile}, ∀ {Y : ProtoTile}, (X.cells = Y.cells) → ((F X).cells = (F Y).cells) ) + := by + classical + intro centerShift F X Y hXY + have htX := (TileTranslationFormulas (TileHalfTurn X) centerShift).1 + have htY := (TileTranslationFormulas (TileHalfTurn Y) centerShift).1 + have hhX := (TileHalfTurnFormulas X).1 + have hhY := (TileHalfTurnFormulas Y).1 + rw [htX, htY, hhX, hhY, hXY] + +private theorem hFTCells : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (i : Fin 3), + (q (0 : Fin (4 : ℕ)) = C.1.1) → ((q i.succ = D.1.1) → (∀ (T : ProtoTile), ∀ (U : + ProtoTile), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), (TileOdometer C.1.1 T + h) → ((TileCentroid U - TileCentroid T = GaussianRealPoint (BandVectors.1 (q i.succ) + (q (0 : Fin (4 : ℕ))))) → (∀ (centerShift : GaussianInt), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (a : GaussianInt), ∀ (b : ℤ), ((TileTranslation (TileHalfTurn + Rminus) centerShift).cells = Rplus.cells) → ((k = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a b) → (∀ (q' : Fin (4 : ℕ) → + CircleCoordinates), (q' (0 : Fin (4 : ℕ)) = C.1.1) → ((q' i.succ = D.1.1) → + ((TileCentroid Rminus - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (q' i.succ) (q' (0 : Fin (4 : ℕ))) - BandVectors.1 (q' (0 : Fin (4 : + ℕ))) (q' i.succ))) → ((TileCentroid Rplus - TileCentroid T = (1 / 2 : ℝ) • + GaussianRealPoint (BandVectors.1 (q' i.succ) (q' (0 : Fin (4 : ℕ))) + BandVectors.1 + (q' (0 : Fin (4 : ℕ))) (q' i.succ))) → ((BandPrototile C.1.1 U) → ((Finset.Nonempty + Rplus.cells) → ( + let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift + (F T).cells = U.cells)))))))))))) ) := by + classical + intro q C D i hC hD T U h k hh hc centerShift Rminus Rplus a b hminusCells houterAffine q' hq0 + hqi hcentMinus hcentPlus hUband hRplusNe F + let hbar := PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a b + have hbarO : TileOdometer C.1.1 (F T) hbar := + TileOdometerAffineTranslation C.1.1 (TileHalfTurn T) + (PartialOdometerHalfTurn h) centerShift a b + (TileOdometerCentralSymmetry C.1.1 T h hh).1 + have hFband : BandPrototile C.1.1 (F T) := + TileOdometerBandPrototile C.1.1 (F T) hbar hbarO + have hcentBar : TileCentroid (F T) = TileCentroid U := by + have hcm := hcentMinus + have hcp := hcentPlus + have hqi' : q' i.succ = q i.succ := hqi.trans hD.symm + have hq0' : q' 0 = q 0 := hq0.trans hC.symm + rw [hqi', hq0'] at hcm hcp + have hsum : TileCentroid Rminus + TileCentroid Rplus = + TileCentroid T + TileCentroid T + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) := by + apply Prod.ext + · have hm := congrArg Prod.fst hcm + have hp' := congrArg Prod.fst hcp + simp only [Prod.fst_sub, GaussianRealPoint] at hm hp' + norm_num [Zsqrtd.re_sub, Zsqrtd.re_add, Int.cast_sub, Int.cast_add] at hm hp' + have hc' := congrArg Prod.fst hc + simp only [Prod.fst_sub, GaussianRealPoint] at hc' + simp only [Prod.fst_add, GaussianRealPoint, + GaussianInt.intCast_re] at ⊢ + linarith + · have hm := congrArg Prod.snd hcm + have hp' := congrArg Prod.snd hcp + simp only [Prod.snd_sub, GaussianRealPoint] at hm hp' + norm_num [Zsqrtd.im_sub, Zsqrtd.im_add, Int.cast_sub, Int.cast_add] at hm hp' + have hc' := congrArg Prod.snd hc + simp only [Prod.snd_sub, GaussianRealPoint] at hc' + simp only [Prod.snd_add, GaussianRealPoint, + GaussianInt.intCast_im] at ⊢ + linarith + have hcentFminus : TileCentroid (F Rminus) = TileCentroid Rplus := by + simp [TileCentroid, F, hminusCells, hRplusNe] + have hcentFormula := (TileTranslationFormulas (TileHalfTurn Rminus) centerShift).2.2.2.2.1 + have hhalfFormula := (TileHalfTurnFormulas Rminus).2.2.2.2.2.2.2.1 + rw [hcentFormula, hhalfFormula] at hcentFminus + have hcenterRe : (centerShift.re : Real) = + (TileCentroid Rminus).1 + (TileCentroid Rplus).1 := by + have hh := congrArg Prod.fst hcentFminus + have hs := congrArg Prod.fst hsum + simp only [Prod.fst_add, GaussianRealPoint] at hs + change -(TileCentroid Rminus).1 + (centerShift.re : Real) = + (TileCentroid Rplus).1 at hh + nlinarith + have hcenterIm : (centerShift.im : Real) = + (TileCentroid Rminus).2 + (TileCentroid Rplus).2 := by + have hh := congrArg Prod.snd hcentFminus + have hs := congrArg Prod.snd hsum + simp only [Prod.snd_add, GaussianRealPoint] at hs + change -(TileCentroid Rminus).2 + (centerShift.im : Real) = + (TileCentroid Rplus).2 at hh + nlinarith + rw [(TileTranslationFormulas (TileHalfTurn T) centerShift).2.2.2.2.1, + (TileHalfTurnFormulas T).2.2.2.2.2.2.2.1] + apply Prod.ext + · change -(TileCentroid T).1 + (centerShift.re : Real) = (TileCentroid U).1 + have hs := congrArg Prod.fst hsum + simp only [Prod.fst_add, GaussianRealPoint] at hs + rw [hcenterRe] + have hc' := congrArg Prod.fst hc + simp only [Prod.fst_sub, GaussianRealPoint] at hc' + nlinarith + · change -(TileCentroid T).2 + (centerShift.im : Real) = (TileCentroid U).2 + have hs := congrArg Prod.snd hsum + simp only [Prod.snd_add, GaussianRealPoint] at hs + rw [hcenterIm] + have hc' := congrArg Prod.snd hc + simp only [Prod.snd_sub, GaussianRealPoint] at hc' + nlinarith + obtain ⟨hcells, _⟩ := BandPrototileCentroidUnique C.1.1 (F T) U + hFband hUband hcentBar + exact hcells + +private theorem hFUCells : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (centerShift : GaussianInt), + let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift + (∀ (X : ProtoTile), (F (F X)).cells = X.cells) → ((∀ {X : ProtoTile}, ∀ {Y : ProtoTile}, + (X.cells = Y.cells) → ((F X).cells = (F Y).cells)) → (((F T).cells = U.cells) → ((F + U).cells = T.cells))) ) := by + classical + intro T U centerShift F hFCellsInvolutive hFCellCongr hFTCells + have h := hFCellCongr (X := F T) (Y := U) hFTCells + have h' : T.cells = (F U).cells := by simpa only [hFCellsInvolutive] using h + exact h'.symm + +private theorem hf : + (by + classical + exact + ∀ (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation centerShift (GaussianQuarterTurn (GaussianQuarterTurn z)) + Function.Injective f ) := by + classical + intro centerShift f x y hxy + have hqinj : Function.Injective GaussianQuarterTurn := by + intro u v huv + apply Zsqrtd.ext + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.im) huv + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.re) huv + have hqt : GaussianQuarterTurn (GaussianQuarterTurn x) = + GaussianQuarterTurn (GaussianQuarterTurn y) := by + dsimp [f, GaussianTranslation] at hxy + exact add_right_cancel hxy + exact hqinj (hqinj hqt) + +private theorem hstep : + (by + classical + exact + (Fin 4 → CircleCoordinates) → ((BandCircle) → ((Fin 3) → (∀ (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation centerShift (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ x y : GaussianInt, (y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → (f y = f + x + 1 ∨ f y = f x - 1 ∨ f y = f x + ⟨0, 1⟩ ∨ f y = f x - ⟨0, 1⟩)))) ) := by + classical + intro q D i centerShift f x y hy + rcases hy with hy | hy | hy | hy + all_goals subst y; first + | left; apply Zsqrtd.ext <;> simp [f, GaussianTranslation, GaussianQuarterTurn] <;> omega + | right; left; apply Zsqrtd.ext <;> simp [f, GaussianTranslation, GaussianQuarterTurn] <;> omega + | right; right; left; apply Zsqrtd.ext <;> simp [f, GaussianTranslation, + GaussianQuarterTurn]; omega + | right; right; right; apply Zsqrtd.ext <;> simp [f, GaussianTranslation, + GaussianQuarterTurn]; omega + +private theorem hvertices : + (by + classical + exact + ∀ (centerShift : GaussianInt), + let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation centerShift (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (X : ProtoTile), FootprintVertices (F X) = f '' FootprintVertices X ) := by + classical + intro centerShift F f X + rw [(TileTranslationFormulas (TileHalfTurn X) centerShift).2.2.2.2.2.1, + (TileHalfTurnFormulas X).2.2.2.2.2.2.1] + have hq (z : GaussianInt) : GaussianQuarterTurn (GaussianQuarterTurn z) = -z := by + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + simp only [Set.image_image] + congr 1 + +private theorem hedges : + (by + classical + exact + ∀ (centerShift : GaussianInt), + let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation centerShift (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (X : ProtoTile), FootprintEdges (F X) = (fun e : Finset GaussianInt => e.image f) '' + FootprintEdges X ) := by + classical + intro centerShift F f X + have hquarter : ∀ Y : ProtoTile, + FootprintEdges (TileQuarterTurn Y) = + (fun e : Finset GaussianInt => e.image GaussianQuarterTurn) '' FootprintEdges Y := + fun Y => (TileQuarterTurnFormulas Y).2.2.2.2.2.2.1 + have hhalfEdges : FootprintEdges (TileHalfTurn X) = + (fun e : Finset GaussianInt => e.image (fun z => -z)) '' FootprintEdges X := by + have hcells : (TileHalfTurn X).cells = + (TileQuarterTurn (TileQuarterTurn X)).cells := + (TileHalfTurnFormulas X).2.2.2.2.1 + have heq : FootprintEdges (TileHalfTurn X) = + FootprintEdges (TileQuarterTurn (TileQuarterTurn X)) := by + simp only [FootprintEdges] + rw [hcells] + rw [heq, hquarter, hquarter] + simp only [Set.image_image, Finset.image_image] + congr 1 + rw [(TileTranslationFormulas (TileHalfTurn X) centerShift).2.2.2.2.2.2.1, + hhalfEdges] + simp only [Set.image_image, Finset.image_image] + congr 1 + +private theorem hpositiveImage : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (centerShift : GaussianInt), ∀ (Rplus : ProtoTile), + let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation centerShift (GaussianQuarterTurn (GaussianQuarterTurn z)) + (Function.Injective f) → ((∀ x y : GaussianInt, (y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ + y = x - ⟨0, 1⟩) → (f y = f x + 1 ∨ f y = f x - 1 ∨ f y = f x + ⟨0, 1⟩ ∨ f y = f x - + ⟨0, 1⟩)) → ((∀ (X : ProtoTile), FootprintVertices (F X) = f '' FootprintVertices X) → + ((∀ (X : ProtoTile), FootprintEdges (F X) = (fun e : Finset GaussianInt => e.image f) + '' FootprintEdges X) → (∀ E : ExactTileInterfaceTriple T U Rplus, ∃ E' : + ExactTileInterfaceTriple (F T) (F U) (F Rplus), E'.point = f E.point ∧ E'.otherAB = f + E.otherAB)))) ) := by + classical + intro T U centerShift Rplus F f hf hstep hvertices hedges E + obtain ⟨E', hp, hab, hbc, hca⟩ := P4055T1ExactTripleImage f hf hstep + T U Rplus (F T) (F U) (F Rplus) + (hvertices T) (hvertices U) (hvertices Rplus) + (hedges T) (hedges U) (hedges Rplus) E + exact ⟨E', hp, hab⟩ + +private theorem hnegPath : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (centerShift : GaussianInt), ∀ (Rminus : + ProtoTile), ∀ (Rplus : ProtoTile), + let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift + ∀ (Eimage : ExactTileInterfaceTriple (F T) (F U) (F Rplus)), ∀ (hvFT : FootprintVertices + (F T) = FootprintVertices U), ∀ (hvFU : FootprintVertices (F U) = FootprintVertices + T), ∀ (hvFR : FootprintVertices (F Rplus) = FootprintVertices Rminus), ∀ (heFT : + FootprintEdges (F T) = FootprintEdges U), ∀ (heFU : FootprintEdges (F U) = + FootprintEdges T), ∀ (heFR : FootprintEdges (F Rplus) = FootprintEdges Rminus), + let Enegative : ExactTileInterfaceTriple U T Rminus := { + point := Eimage.point + otherAB := Eimage.otherAB + otherBC := Eimage.otherBC + otherCA := Eimage.otherCA + pathAB := by simpa [hvFT, hvFU, heFT, heFU] using Eimage.pathAB + pathBC := by simpa [hvFU, hvFR, heFU, heFR] using Eimage.pathBC + pathCA := by simpa [hvFR, hvFT, heFR, heFT] using Eimage.pathCA + unique_common := by + intro z + simpa [hvFT, hvFU, hvFR] using Eimage.unique_common z } + SimpleGridPathBetween (FootprintVertices T ∩ FootprintVertices U) (FootprintEdges T ∩ + FootprintEdges U) Enegative.point Enegative.otherAB ) := by + classical + intro T U centerShift Rminus Rplus F Eimage hvFT hvFU hvFR heFT heFU heFR Enegative + simpa [Set.inter_comm] using Enegative.pathAB + +private theorem hposNe : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (Epositive : + ExactTileInterfaceTriple T U Rplus), (SimpleGridPathBetween (FootprintVertices T ∩ + FootprintVertices U) (FootprintEdges T ∩ FootprintEdges U) Epositive.point + Epositive.otherAB) → (Epositive.point ≠ Epositive.otherAB) ) := by + classical + intro T U Rplus Epositive hposPath + rcases hposPath with ⟨path, hnd, hlen, hhead, hlast, _, _, _⟩ + intro heq + have hpne : path ≠ [] := by intro hn; subst path; simp at hlen + have hheadLast : path.head hpne = path.getLast hpne := by + have hh := List.head?_eq_some_head hpne + have hl := List.getLast?_eq_some_getLast hpne + rw [hh] at hhead + rw [hl] at hlast + simp only [Option.some.injEq] at hhead hlast + rw [hhead, hlast, heq] + have hsingle : ∃ z, path = [z] := + (List.Nodup.head_eq_getLast_iff hpne hnd).mp hheadLast + rcases hsingle with ⟨z, rfl⟩ + simp at hlen + +private theorem hfixedUnique : + (by + classical + exact + (Fin 4 → CircleCoordinates) → ((BandCircle) → ((Fin 3) → (∀ (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation centerShift (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (x : GaussianInt), ∀ (y : GaussianInt), (f x = x) → ((f y = y) → (x = y))))) ) := by + classical + intro q D i centerShift f x y hx hy + have hx' := by simpa [f, GaussianTranslation, GaussianQuarterTurn] using hx + have hy' := by simpa [f, GaussianTranslation, GaussianQuarterTurn] using hy + apply Zsqrtd.ext + · have hxr := congrArg (fun z : GaussianInt => z.re) hx' + have hyr := congrArg (fun z : GaussianInt => z.re) hy' + simp only [Zsqrtd.re_add] at hxr hyr + omega + · have hxi := congrArg (fun z : GaussianInt => z.im) hx' + have hyi := congrArg (fun z : GaussianInt => z.im) hy' + simp only [Zsqrtd.im_add] at hxi hyi + omega + +private theorem hpointNotFixed : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (centerShift : GaussianInt), ∀ (Rminus : + ProtoTile), ∀ (Rplus : ProtoTile), + let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation centerShift (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (Epositive : ExactTileInterfaceTriple T U Rplus), ∀ (Eimage : ExactTileInterfaceTriple + (F T) (F U) (F Rplus)), (Eimage.otherAB = f Epositive.otherAB) → (∀ (hvFT : + FootprintVertices (F T) = FootprintVertices U), ∀ (hvFU : FootprintVertices (F U) = + FootprintVertices T), ∀ (hvFR : FootprintVertices (F Rplus) = FootprintVertices + Rminus), ∀ (heFT : FootprintEdges (F T) = FootprintEdges U), ∀ (heFU : FootprintEdges + (F U) = FootprintEdges T), ∀ (heFR : FootprintEdges (F Rplus) = FootprintEdges Rminus), + let Enegative : ExactTileInterfaceTriple U T Rminus := { + point := Eimage.point + otherAB := Eimage.otherAB + otherBC := Eimage.otherBC + otherCA := Eimage.otherCA + pathAB := by simpa [hvFT, hvFU, heFT, heFU] using Eimage.pathAB + pathBC := by simpa [hvFU, hvFR, heFU, heFR] using Eimage.pathBC + pathCA := by simpa [hvFR, hvFT, heFR, heFT] using Eimage.pathCA + unique_common := by + intro z + simpa [hvFT, hvFU, hvFR] using Eimage.unique_common z } + (({Epositive.point, Epositive.otherAB} : Finset GaussianInt) = {Enegative.point, + Enegative.otherAB}) → + ((Epositive.point ≠ Epositive.otherAB) → ((∀ (z : GaussianInt), f (f z) = z) → ((∀ (x + : GaussianInt), ∀ (y : GaussianInt), (f x = x) → ((f y = y) → (x = y))) → (f + Epositive.point ≠ Epositive.point)))))) := by + classical + intro T U centerShift Rminus Rplus F f Epositive Eimage himageAB hvFT hvFU hvFR heFT heFU heFR + Enegative hendpointPair hposNe hinvolutive hfixedUnique hfix + have hfoMem : f Epositive.otherAB ∈ ({Epositive.point, Epositive.otherAB} : Finset GaussianInt) + := by + rw [hendpointPair] + simp [Enegative, himageAB] + rcases Finset.mem_insert.mp hfoMem with hfo | hfo + · have heq : Epositive.otherAB = Epositive.point := by + calc + Epositive.otherAB = f (f Epositive.otherAB) := (hinvolutive _).symm + _ = f Epositive.point := by rw [hfo, hfix] + _ = Epositive.point := hfix + exact hposNe heq.symm + · have hfo' : f Epositive.otherAB = Epositive.otherAB := by simpa using hfo + exact hposNe (hfixedUnique Epositive.point Epositive.otherAB hfix hfo') + +private theorem hnegativePoint : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (centerShift : GaussianInt), ∀ (Rminus : + ProtoTile), ∀ (Rplus : ProtoTile), + let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation centerShift (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (Epositive : ExactTileInterfaceTriple T U Rplus), ∀ (Eimage : ExactTileInterfaceTriple + (F T) (F U) (F Rplus)), (Eimage.point = f Epositive.point) → (∀ (hvFT : + FootprintVertices (F T) = FootprintVertices U), ∀ (hvFU : FootprintVertices (F U) = + FootprintVertices T), ∀ (hvFR : FootprintVertices (F Rplus) = FootprintVertices + Rminus), ∀ (heFT : FootprintEdges (F T) = FootprintEdges U), ∀ (heFU : FootprintEdges + (F U) = FootprintEdges T), ∀ (heFR : FootprintEdges (F Rplus) = FootprintEdges Rminus), + let Enegative : ExactTileInterfaceTriple U T Rminus := { + point := Eimage.point + otherAB := Eimage.otherAB + otherBC := Eimage.otherBC + otherCA := Eimage.otherCA + pathAB := by simpa [hvFT, hvFU, heFT, heFU] using Eimage.pathAB + pathBC := by simpa [hvFU, hvFR, heFU, heFR] using Eimage.pathBC + pathCA := by simpa [hvFR, hvFT, heFR, heFT] using Eimage.pathCA + unique_common := by + intro z + simpa [hvFT, hvFU, hvFR] using Eimage.unique_common z } + (({Epositive.point, Epositive.otherAB} : Finset GaussianInt) = {Enegative.point, + Enegative.otherAB}) → ((f + Epositive.point ≠ Epositive.point) → (Enegative.point = Epositive.otherAB)))) := by + classical + intro T U centerShift Rminus Rplus F f Epositive Eimage himagePoint hvFT hvFU hvFR heFT heFU + heFR Enegative hendpointPair hpointNotFixed + have hm : Enegative.point ∈ ({Epositive.point, Epositive.otherAB} : Finset GaussianInt) := by + have hn : Enegative.point ∈ ({Enegative.point, Enegative.otherAB} : Finset GaussianInt) := + by simp + rw [hendpointPair.symm] at hn + exact hn + rcases Finset.mem_insert.mp hm with hm | hm + · have hfix : f Epositive.point = Epositive.point := by + simpa [Enegative, himagePoint] using hm + exact (hpointNotFixed hfix).elim + · simpa using hm + +private theorem hCpositive : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (C : + BandCircle), (BandCircle) → ((Fin 3) → ((q (0 : Fin (4 : ℕ)) = C.1.1) → (0 < + C.1.1.1)))) ) := by + classical + intro q cfg C D i hC + have hc := cfg.childLarge + rw [hC] at hc + omega + +private theorem hwalkInOuter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (tiles : List ProtoTile), ∀ + (reverseTiles : List ProtoTile), ∀ (functions : List PartialOdometer), ∀ + (reverseFunctions : List PartialOdometer), (∀ T_1 ∈ (List.drop (1 : ℕ) + tiles).dropLast, ∃ (h_1 : PartialOdometer), (T_1, h_1) ∈ tiles.zip functions ∧ + AncestorOdometer D.1.1 C.1.1 T_1 T h_1 h) → ((∀ T ∈ (List.drop (1 : ℕ) + reverseTiles).dropLast, ∃ (h : PartialOdometer), (T, h) ∈ reverseTiles.zip + reverseFunctions ∧ AncestorOdometer D.1.1 C.1.1 T U h k) → (∀ (walk : List + GaussianInt), (∀ x ∈ walk, (∃ a ∈ (List.drop (1 : ℕ) tiles).dropLast, x ∈ + FootprintVertices a) ∧ ∃ b ∈ (List.drop (1 : ℕ) reverseTiles).dropLast, x ∈ + FootprintVertices b) → (((h.domain : Set GaussianInt) = FootprintVertices T) → + (((k.domain : Set GaussianInt) = FootprintVertices U) → (∀ x, x ∈ walk → x ∈ + FootprintVertices T ∩ FootprintVertices U))))) ) := by + classical + intro C D T U h k tiles reverseTiles functions reverseFunctions hrestrictionsForward + hrestrictionsBackward walk hwalkVertices hdomOuterT hdomOuterU x hx + obtain ⟨⟨A, hA, hxA⟩, ⟨B, hB, hxB⟩⟩ := hwalkVertices x hx + obtain ⟨g, hzip, hAnc⟩ := hrestrictionsForward A hA + obtain ⟨kA, hzipA, hAncA⟩ := hrestrictionsBackward B hB + have hxg : x ∈ (g.domain : Set GaussianInt) := + (Set.ext_iff.mp hAnc.2.2.1 x).mpr hxA + have hxk : x ∈ (kA.domain : Set GaussianInt) := + (Set.ext_iff.mp hAncA.2.2.1 x).mpr hxB + have hxh : x ∈ (h.domain : Set GaussianInt) := hAnc.2.2.2.1 hxg + have hxouterT : x ∈ FootprintVertices T := by + rw [← hdomOuterT] + exact hxh + have hxouterK : x ∈ (k.domain : Set GaussianInt) := hAncA.2.2.2.1 hxk + have hxouterU : x ∈ FootprintVertices U := by + rw [← hdomOuterU] + exact hxouterK + exact ⟨hxouterT, hxouterU⟩ + +private theorem edgeAncestor : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ {A : ProtoTile}, ∀ {O : ProtoTile}, ∀ + {g : PartialOdometer}, ∀ {k₀ : PartialOdometer}, (AncestorOdometer D.1.1 C.1.1 A O g + k₀) → (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges A) → (e ∈ FootprintEdges O)) ) + := by + classical + intro C D A O g k₀ hAnc e he + have hcells := P4158T1AncestorCells D.1.1 C.1.1 A O hAnc.2.1 + rcases he with ⟨cell, hcell, hshape⟩ + exact ⟨cell, hcells hcell, hshape⟩ + +private theorem hwalkOuterEdges : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (tiles : List ProtoTile), ∀ + (reverseTiles : List ProtoTile), ∀ (functions : List PartialOdometer), ∀ + (reverseFunctions : List PartialOdometer), (∀ T_1 ∈ (List.drop (1 : ℕ) + tiles).dropLast, ∃ (h_1 : PartialOdometer), (T_1, h_1) ∈ tiles.zip functions ∧ + AncestorOdometer D.1.1 C.1.1 T_1 T h_1 h) → ((∀ T ∈ (List.drop (1 : ℕ) + reverseTiles).dropLast, ∃ (h : PartialOdometer), (T, h) ∈ reverseTiles.zip + reverseFunctions ∧ AncestorOdometer D.1.1 C.1.1 T U h k) → (∀ (walk : List + GaussianInt), (∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ + (l₂ : List GaussianInt), walk = l₁ ++ x :: y :: l₂ → (∃ a ∈ (List.drop (1 : ℕ) + tiles).dropLast, {x, y} ∈ FootprintEdges a) ∧ ∃ b ∈ (List.drop (1 : ℕ) + reverseTiles).dropLast, {x, y} ∈ FootprintEdges b) → ((∀ {A : ProtoTile}, ∀ + {O : ProtoTile}, ∀ {g : PartialOdometer}, ∀ {k₀ : PartialOdometer}, (AncestorOdometer + D.1.1 C.1.1 A O g k₀) → (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges A) → (e ∈ + FootprintEdges O))) → (∀ x y : GaussianInt, ∀ pre post : List GaussianInt, walk = pre + ++ x :: y :: post → {x, y} ∈ FootprintEdges T ∩ FootprintEdges U)))) ) := by + classical + intro C D T U h k tiles reverseTiles functions reverseFunctions hrestrictionsForward + hrestrictionsBackward walk hwalkEdges edgeAncestor x y pre post hsplit + obtain ⟨⟨A, hA, heA⟩, ⟨B, hB, heB⟩⟩ := hwalkEdges x y pre post hsplit + obtain ⟨g, hzip, hAnc⟩ := hrestrictionsForward A hA + obtain ⟨kA, hzipA, hAncA⟩ := hrestrictionsBackward B hB + exact ⟨edgeAncestor hAnc {x, y} heA, edgeAncestor hAncA {x, y} heB⟩ + +private theorem hwalkStart : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (centerShift : GaussianInt), ∀ (Rminus : + ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (reverseTiles : List + ProtoTile), + let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift + ∀ (Eimage : ExactTileInterfaceTriple (F T) (F U) (F Rplus)), ∀ (hvFT : FootprintVertices + (F T) = FootprintVertices U), ∀ (hvFU : FootprintVertices (F U) = FootprintVertices + T), ∀ (hvFR : FootprintVertices (F Rplus) = FootprintVertices Rminus), ∀ (heFT : + FootprintEdges (F T) = FootprintEdges U), ∀ (heFU : FootprintEdges (F U) = + FootprintEdges T), ∀ (heFR : FootprintEdges (F Rplus) = FootprintEdges Rminus), + let Enegative : ExactTileInterfaceTriple U T Rminus := { + point := Eimage.point + otherAB := Eimage.otherAB + otherBC := Eimage.otherBC + otherCA := Eimage.otherCA + pathAB := by simpa [hvFT, hvFU, heFT, heFU] using Eimage.pathAB + pathBC := by simpa [hvFU, hvFR, heFU, heFR] using Eimage.pathBC + pathCA := by simpa [hvFR, hvFT, heFR, heFT] using Eimage.pathCA + unique_common := by + intro z + simpa [hvFT, hvFU, hvFR] using Eimage.unique_common z } + ∀ (walk : List GaussianInt), (∃ (x : GaussianInt), walk.head? = some x ∧ x ∈ + FootprintVertices Rminus) → ((∃ (y : GaussianInt), walk.getLast? = some y ∧ y ∈ + FootprintVertices Rplus) → ((List.IsChain (fun (x y : GaussianInt) => y = x + (1 : + GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) walk) → ((∀ x ∈ walk, (∃ a ∈ (List.drop + (1 : ℕ) tiles).dropLast, x ∈ FootprintVertices a) ∧ ∃ b ∈ (List.drop (1 : ℕ) + reverseTiles).dropLast, x ∈ FootprintVertices b) → ((∀ (x : GaussianInt), ∀ (y : + GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), walk = l₁ ++ x :: + y :: l₂ → (∃ a ∈ (List.drop (1 : ℕ) tiles).dropLast, {x, y} ∈ FootprintEdges a) ∧ ∃ b + ∈ (List.drop (1 : ℕ) reverseTiles).dropLast, {x, y} ∈ FootprintEdges b) → ((∀ x, x ∈ + walk → x ∈ FootprintVertices T ∩ FootprintVertices U) → ((∀ x y : GaussianInt, ∀ pre + post : List GaussianInt, walk = pre ++ x :: y :: post → {x, y} ∈ FootprintEdges T ∩ + FootprintEdges U) → (∃ z, walk.head? = some z ∧ z = Enegative.point))))))) ) := by + classical + intro T U centerShift Rminus Rplus tiles reverseTiles F Eimage hvFT hvFU hvFR heFT heFU heFR + Enegative walk hwalkHead hwalkLast hwalkChain hwalkVertices hwalkEdges hwalkInOuter + hwalkOuterEdges + obtain ⟨z, hzhead, hzR⟩ := hwalkHead + have hmem : z ∈ walk := by + cases walk with + | nil => simp at hzhead + | cons a rest => simp only [List.mem_cons]; left; simpa using hzhead.symm + have houter := hwalkInOuter z hmem + have hcommon : z ∈ FootprintVertices U ∩ FootprintVertices T ∩ + FootprintVertices Rminus := ⟨⟨houter.2, houter.1⟩, hzR⟩ + have hpoint := (Enegative.unique_common z).mp hcommon + exact ⟨z, hzhead, hpoint⟩ + +private theorem hwalkFinish : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (Epositive : + ExactTileInterfaceTriple T U Rplus), ∀ (walk : List GaussianInt), (∃ (y : + GaussianInt), walk.getLast? = some y ∧ y ∈ FootprintVertices Rplus) → ((∀ x, x ∈ walk + → x ∈ FootprintVertices T ∩ FootprintVertices U) → (∃ z, walk.getLast? = some z ∧ z = + Epositive.point)) ) := by + classical + intro T U Rplus Epositive walk hwalkLast hwalkInOuter + obtain ⟨z, hzlast, hzR⟩ := hwalkLast + have hmem : z ∈ walk := List.mem_of_mem_getLast? hzlast + have houter := hwalkInOuter z hmem + have hcommon : z ∈ FootprintVertices T ∩ FootprintVertices U ∩ + FootprintVertices Rplus := ⟨⟨houter.1, houter.2⟩, hzR⟩ + have hpoint := (Epositive.unique_common z).mp hcommon + exact ⟨z, hzlast, hpoint⟩ + +private theorem hpathIndex : + (by + classical + exact + (Fin 4 → CircleCoordinates) → ((BandCircle) → ((BandCircle) → ((Fin 3) → (∀ (T : + ProtoTile), ∀ (U : ProtoTile), ∀ (path : List GaussianInt), (path.Nodup) → ((∀ (e : + Finset GaussianInt), e ∈ FootprintEdges T ∩ FootprintEdges U ↔ ∃ (a : GaussianInt) (b + : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), path = l₁ ++ a :: b + :: l₂ ∧ e = {a, b}) → (∀ a b : GaussianInt, {a, b} ∈ FootprintEdges T ∩ + FootprintEdges U → path.idxOf a + 1 = path.idxOf b ∨ path.idxOf b + 1 = path.idxOf + a)))))) ) := by + classical + intro q C D i T U path hpathNodup hpathEdges a b hab + rcases (hpathEdges {a, b}).mp hab with ⟨c, d, l, r, heq, hedge⟩ + have hnd := hpathNodup + rw [heq, List.nodup_append] at hnd + have hc : c ∉ l := by + intro hc + exact hnd.2.2 c hc c (by simp) rfl + have hd : d ∉ l := by + intro hd + exact hnd.2.2 d hd d (by simp) rfl + have hcd : c ≠ d := by + have hcnot := (List.nodup_cons.mp hnd.2.1).1 + intro h + exact hcnot (by simp [h]) + have hic : path.idxOf c = l.length := by + simp [heq, List.idxOf_append, hc] + have hid : path.idxOf d = l.length + 1 := by + simp [heq, List.idxOf_append, hd, hcd, Nat.add_comm] + have ha : a = c ∨ a = d := by + have : a ∈ ({c, d} : Finset GaussianInt) := by rw [← hedge]; simp + simpa using this + have hb : b = c ∨ b = d := by + have : b ∈ ({c, d} : Finset GaussianInt) := by rw [← hedge]; simp + simpa using this + have habne : a ≠ b := by + intro h + have hcmem : c ∈ ({a, b} : Finset GaussianInt) := by rw [hedge]; simp + have hdmem : d ∈ ({a, b} : Finset GaussianInt) := by rw [hedge]; simp + simp [h] at hcmem hdmem + exact hcd (hcmem.trans hdmem.symm) + rcases ha with rfl | rfl <;> rcases hb with rfl | rfl + · exact False.elim (habne rfl) + · exact Or.inl (by omega) + · exact Or.inr (by omega) + · exact False.elim (habne rfl) + +private theorem hstartIndex : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (Epositive : + ExactTileInterfaceTriple T U Rplus), ∀ (path : List GaussianInt), (path.Nodup) → + ((path.getLast? = some Epositive.otherAB) → (path.idxOf Epositive.otherAB = + path.length - 1)) ) := by + classical + intro T U Rplus Epositive path hpathNodup hpathLast + have hpform : path.dropLast ++ [Epositive.otherAB] = path := + List.dropLast_append_getLast? Epositive.otherAB (by simp [hpathLast]) + have hyabsent : Epositive.otherAB ∉ path.dropLast := by + have hnd := hpathNodup + rw [← hpform, List.nodup_append] at hnd + intro hm + exact hnd.2.2 Epositive.otherAB hm Epositive.otherAB (by simp) rfl + rw [← hpform, List.idxOf_append] + simp [hyabsent] + +private theorem hfinishIndex : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (Epositive : + ExactTileInterfaceTriple T U Rplus), ∀ (path : List GaussianInt), (path.Nodup) → (((2 + : ℕ) ≤ path.length) → ((path.head? = some Epositive.point) → ((path.getLast? = some + Epositive.otherAB) → ((FootprintVertices T ∩ FootprintVertices U = (↑path.toFinset : + Set GaussianInt)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List + GaussianInt), ∀ (l₂ : List GaussianInt), path = l₁ ++ a :: b :: l₂ → b = a + (1 : + GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ∨ b = a - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → ((∀ (e : Finset GaussianInt), e ∈ + FootprintEdges T ∩ FootprintEdges U ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : + List GaussianInt) (l₂ : List GaussianInt), path = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → + ((∀ a b : GaussianInt, {a, b} ∈ FootprintEdges T ∩ FootprintEdges U → path.idxOf a + + 1 = path.idxOf b ∨ path.idxOf b + 1 = path.idxOf a) → ((∀ {a : GaussianInt}, ∀ + {b : GaussianInt}, (a ∈ path) → ((path.idxOf a = path.idxOf b) → (a = b))) → + ((path.idxOf Epositive.otherAB = path.length - 1) → (path.idxOf Epositive.point = + 0)))))))))) ) := by + classical + intro T U Rplus Epositive path hpathNodup hpathLength hpathHead hpathLast hpathVertices + hpathStep hpathEdges hpathIndex hpathIndexInjective hstartIndex + cases path with + | nil => simp at hpathLength + | cons a rest => + simp only [List.head?_cons, Option.some.injEq] at hpathHead + simp [hpathHead] + +private theorem hpathIndexEdge : + (by + classical + exact + ∀ (path : List GaussianInt), (path.Nodup) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ + (pre : List GaussianInt), ∀ (post : List GaussianInt), (path = pre ++ x :: y :: post) + → (path.idxOf x = pre.length ∧ path.idxOf y = pre.length + 1)) ) := by + classical + intro path hpathNodup x y pre post hsplit + have hnd := hpathNodup + rw [hsplit, List.nodup_append] at hnd + have hxnot : x ∉ pre := by + intro hx + exact hnd.2.2 x hx x (by simp) rfl + have hxy : x ≠ y := by + have hxnotTail : x ∉ y :: post := (List.nodup_cons.mp hnd.2.1).1 + simp only [List.mem_cons, not_or] at hxnotTail + exact hxnotTail.1 + have hynot : y ∉ pre := by + intro hy + exact hnd.2.2 y hy y (by simp) rfl + constructor + · simp [hsplit, List.idxOf_append, hxnot] + · simp [hsplit, List.idxOf_append, hynot, hxy, Nat.add_comm] + +private theorem hwalkHeadPos : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (centerShift : GaussianInt), ∀ (Rminus : + ProtoTile), ∀ (Rplus : ProtoTile), + let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift + ∀ (Epositive : ExactTileInterfaceTriple T U Rplus), ∀ (Eimage : ExactTileInterfaceTriple + (F T) (F U) (F Rplus)), ∀ (hvFT : FootprintVertices (F T) = FootprintVertices U), ∀ + (hvFU : FootprintVertices (F U) = FootprintVertices T), ∀ (hvFR : FootprintVertices + (F Rplus) = FootprintVertices Rminus), ∀ (heFT : FootprintEdges (F T) = + FootprintEdges U), ∀ (heFU : FootprintEdges (F U) = FootprintEdges T), ∀ (heFR : + FootprintEdges (F Rplus) = FootprintEdges Rminus), + let Enegative : ExactTileInterfaceTriple U T Rminus := { + point := Eimage.point + otherAB := Eimage.otherAB + otherBC := Eimage.otherBC + otherCA := Eimage.otherCA + pathAB := by simpa [hvFT, hvFU, heFT, heFU] using Eimage.pathAB + pathBC := by simpa [hvFU, hvFR, heFU, heFR] using Eimage.pathBC + pathCA := by simpa [hvFR, hvFT, heFR, heFT] using Eimage.pathCA + unique_common := by + intro z + simpa [hvFT, hvFU, hvFR] using Eimage.unique_common z } + (Enegative.point = Epositive.otherAB) → (∀ (walk : List GaussianInt), (∃ z, walk.head? = + some z ∧ z = Enegative.point) → (walk.head? = some Epositive.otherAB)) ) := by + classical + intro T U centerShift Rminus Rplus F Epositive Eimage hvFT hvFU hvFR heFT heFU heFR Enegative + hnegativePoint walk hwalkStart + obtain ⟨z, hz, hzpoint⟩ := hwalkStart + rw [hzpoint, hnegativePoint] at hz + exact hz + +private theorem hwalkLastPos : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (Epositive : + ExactTileInterfaceTriple T U Rplus), ∀ (walk : List GaussianInt), (∃ z, walk.getLast? + = some z ∧ z = Epositive.point) → (walk.getLast? = some Epositive.point) ) := by + classical + intro T U Rplus Epositive walk hwalkFinish + obtain ⟨z, hz, hzpoint⟩ := hwalkFinish + rw [hzpoint] at hz + exact hz + +private theorem hwalkVertexPath : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (walk : List GaussianInt), (∀ x, x ∈ walk → x ∈ + FootprintVertices T ∩ FootprintVertices U) → (∀ (path : List GaussianInt), + (FootprintVertices T ∩ FootprintVertices U = (↑path.toFinset : Set GaussianInt)) → (∀ + z ∈ walk, z ∈ path)) ) := by + classical + intro T U walk hwalkInOuter path hpathVertices z hz + have hmem : z ∈ FootprintVertices T ∩ FootprintVertices U := hwalkInOuter z hz + have hmem' : z ∈ (path.toFinset : Set GaussianInt) := by + rw [← hpathVertices] + exact hmem + simpa using hmem' + +private theorem hcovered : + (by + classical + exact + (Fin 4 → CircleCoordinates) → ((BandCircle) → ((BandCircle) → ((Fin 3) → (∀ (T : + ProtoTile), ∀ (U : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (Epositive : + ExactTileInterfaceTriple T U Rplus), ∀ (walk : List GaussianInt), (∀ x y : + GaussianInt, ∀ pre post : List GaussianInt, walk = pre ++ x :: y :: post → {x, y} ∈ + FootprintEdges T ∩ FootprintEdges U) → (∀ (path : List GaussianInt), ((2 : ℕ) ≤ + path.length) → ((∀ a b : GaussianInt, {a, b} ∈ FootprintEdges T ∩ FootprintEdges U → + path.idxOf a + 1 = path.idxOf b ∨ path.idxOf b + 1 = path.idxOf a) → ((∀ + {a : GaussianInt}, ∀ {b : GaussianInt}, (a ∈ path) → ((path.idxOf a = path.idxOf b) → + (a = b))) → ((path.idxOf Epositive.otherAB = path.length - 1) → ((path.idxOf + Epositive.point = 0) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (pre : List + GaussianInt), ∀ (post : List GaussianInt), (path = pre ++ x :: y :: post) → + (path.idxOf x = pre.length ∧ path.idxOf y = pre.length + 1)) → ((walk.head? = some + Epositive.otherAB) → ((walk.getLast? = some Epositive.point) → ((∀ z ∈ walk, z ∈ + path) → (∀ x y : GaussianInt, ∀ pre post : List GaussianInt, path = pre ++ x :: y :: + post → ∃ l r : List GaussianInt, ∃ a b : GaussianInt, walk = l ++ a :: b :: r ∧ ({a, + b} : Finset GaussianInt) = {x, y})))))))))))))) ) := by + classical + intro q C D i T U Rplus Epositive walk hwalkOuterEdges path hpathLength hpathIndex + hpathIndexInjective hstartIndex hfinishIndex hpathIndexEdge hwalkHeadPos hwalkLastPos + hwalkVertexPath u v pre post hsplit + have hindices := hpathIndexEdge u v pre post hsplit + have humem : u ∈ path := by rw [hsplit]; simp + have hvmem : v ∈ path := by rw [hsplit]; simp + by_contra hnot + have hnoPair : ∀ a b : GaussianInt, ∀ l r : List GaussianInt, + walk = l ++ a :: b :: r → + ({a, b} : Finset GaussianInt) ≠ {u, v} := by + intro a b l r hw hpair + apply hnot + exact ⟨l, r, a, b, hw, hpair⟩ + have hstartGreater : path.idxOf Epositive.otherAB > pre.length := by + rw [hstartIndex] + have hylt := List.idxOf_lt_length_of_mem hvmem + rw [hindices.2] at hylt + omega + have propagate : ∀ (w : List GaussianInt), + (∀ a b : GaussianInt, ∀ l r : List GaussianInt, + w = l ++ a :: b :: r → {a, b} ∈ FootprintEdges T ∩ FootprintEdges U) → + (∀ a b : GaussianInt, ∀ l r : List GaussianInt, + w = l ++ a :: b :: r → + ({a, b} : Finset GaussianInt) ≠ {u, v}) → + (∀ z ∈ w, z ∈ path) → + (∀ a ∈ w.head?, path.idxOf a > pre.length) → + ∀ b ∈ w.getLast?, path.idxOf b > pre.length := by + intro w + induction w with + | nil => simp + | cons a w ih => + intro hw hno hv ha + cases w with + | nil => simpa using ha a (by simp) + | cons b w => + have hab := hpathIndex a b (hw a b [] w rfl) + have hia : path.idxOf a > pre.length := ha a (by simp) + have hib : path.idxOf b > pre.length := by + by_contra hle + have hbmem : b ∈ path := hv b (by simp) + have hbx : b = u := by + apply hpathIndexInjective hbmem + rw [hindices.1] + omega + have hay : a = v := by + apply hpathIndexInjective (hv a (by simp)) + rw [hindices.2] + omega + subst a + subst b + have hpair : ({v, u} : Finset GaussianInt) = {u, v} := Finset.pair_comm _ _ + exact (hno v u [] w (by simp) hpair) + have hw' : ∀ c d : GaussianInt, ∀ l r : List GaussianInt, + b :: w = l ++ c :: d :: r → + {c, d} ∈ FootprintEdges T ∩ FootprintEdges U := by + intro c d l r h + exact hw c d (a :: l) r (by simp [h, List.cons_append]) + have hno' : ∀ c d : GaussianInt, ∀ l r : List GaussianInt, + b :: w = l ++ c :: d :: r → + ({c, d} : Finset GaussianInt) ≠ {u, v} := by + intro c d l r h + exact hno c d (a :: l) r (by simp [h, List.cons_append]) + have hv' : ∀ z ∈ b :: w, z ∈ path := by + intro z hz + exact hv z (List.mem_cons_of_mem a hz) + simpa using ih hw' hno' hv' (by simpa using hib) + have hlastGreater := propagate walk + (by + intro a b l r hw + exact hwalkOuterEdges a b l r hw) + hnoPair hwalkVertexPath + (by simpa [hwalkHeadPos] using hstartGreater) + Epositive.point (by simp [hwalkLastPos]) + rw [hfinishIndex] at hlastGreater + omega + +private theorem hrestrictions : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (tiles : List ProtoTile), ∀ + (reverseTiles : List ProtoTile), ∀ (functions : List PartialOdometer), ∀ + (reverseFunctions : List PartialOdometer), (∀ T_1 ∈ (List.drop (1 : ℕ) + tiles).dropLast, ∃ (h_1 : PartialOdometer), (T_1, h_1) ∈ tiles.zip functions ∧ + AncestorOdometer D.1.1 C.1.1 T_1 T h_1 h) → ((∀ T ∈ (List.drop (1 : ℕ) + reverseTiles).dropLast, ∃ (h : PartialOdometer), (T, h) ∈ reverseTiles.zip + reverseFunctions ∧ AncestorOdometer D.1.1 C.1.1 T U h k) → (∀ (walk : List + GaussianInt), (∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ + (l₂ : List GaussianInt), walk = l₁ ++ x :: y :: l₂ → (∃ a ∈ (List.drop (1 : ℕ) + tiles).dropLast, {x, y} ∈ FootprintEdges a) ∧ ∃ b ∈ (List.drop (1 : ℕ) + reverseTiles).dropLast, {x, y} ∈ FootprintEdges b) → (∀ (path : List GaussianInt), (∀ + x y : GaussianInt, ∀ pre post : List GaussianInt, path = pre ++ x :: y :: post → ∃ l + r : List GaussianInt, ∃ a b : GaussianInt, walk = l ++ a :: b :: r ∧ ({a, b} : Finset + GaussianInt) = {x, y}) → (∀ x y : GaussianInt, ∀ pre post : List GaussianInt, path = + pre ++ x :: y :: post → ∃ (A B : ProtoTile) (g kA : PartialOdometer), (A, g) ∈ + tiles.zip functions ∧ (B, kA) ∈ reverseTiles.zip reverseFunctions ∧ {x, y} ∈ + FootprintEdges A ∩ FootprintEdges B ∧ AncestorOdometer D.1.1 C.1.1 A T g h ∧ + AncestorOdometer D.1.1 C.1.1 B U kA k)))) ) := by + classical + intro C D T U h k tiles reverseTiles functions reverseFunctions hrestrictionsForward + hrestrictionsBackward walk hwalkEdges path hcovered x y pre post hsplit + obtain ⟨l, r, a₁, b₁, hw, hpairs⟩ := hcovered x y pre post hsplit + obtain ⟨⟨A, hA, heA⟩, ⟨B, hB, heB⟩⟩ := hwalkEdges a₁ b₁ l r hw + obtain ⟨g, hzip, hAnc⟩ := hrestrictionsForward A hA + obtain ⟨kA, hzipA, hAncA⟩ := hrestrictionsBackward B hB + have hedgeA : {x, y} ∈ FootprintEdges A := by + rw [← hpairs] + exact heA + have hedgeB : {x, y} ∈ FootprintEdges B := by + rw [← hpairs] + exact heB + exact ⟨A, B, g, kA, hzip, hzipA, ⟨hedgeA, hedgeB⟩, hAnc, hAncA⟩ + +end UnitInterfaceGeometry + +theorem P4261T2UnitInterface + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C D : BandCircle) (i : Fin 3) + (hC : q 0 = C.1.1) (hD : q i.succ = D.1.1) + (T U : ProtoTile) (h k : PartialOdometer) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (hsym : QuarterTurnSymmetric T) + (hh : TileOdometer C.1.1 T h) (hk : TileOdometer C.1.1 U k) + (hunit : D.1.1.1 = 1) (p r : Real × Real) + (hp : PartialOdometerSlope h = some p) (hr : PartialOdometerSlope k = some r) + (hc : TileCentroid U - TileCentroid T = + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) + (hs : r - p = GaussianRealPoint (BandVectors.2 (q i.succ) (q 0))) : + Nonempty (P4261T2LiteralInterface D C T U h k) := by +-- BODY + classical + have hpositive : 0 < D.1.1.1 := by rw [hunit]; norm_num + have hstrings := OpposingBoundaryOdometerStrings q cfg.proper C D i hC hD T U + h k hh hk hpositive p r hp hr hc hs + obtain ⟨orientation, centerShift, base, Rminus, Rplus, tiles, reverseTiles, + functions, reverseFunctions, hminus, hplus, pminus, pplus, a, b, bminus, + bplus, hboundary, hminusCells, hplusCells, hcellPairs, hreverse, + hforwardRespect, hbackwardRespect, hheadForward, hlastForward, + hheadBackward, hlastBackward, hOminus, hOplus, hsminus, hsplus, + hsminusDiff, hsplusDiff, houterAffine, hplusAffine, hminusAffine, + hrestrictionsForward, hrestrictionsBackward⟩ := hstrings + rcases hboundary with ⟨q', hq', hq0, hqi, _, _, hstring, hcentMinus, + hcentPlus⟩ + have hTband : BandPrototile C.1.1 T := TileOdometerBandPrototile _ _ _ hh + have hUband : BandPrototile C.1.1 U := TileOdometerBandPrototile _ _ _ hk + have hRminusBand : BandPrototile D.1.1 Rminus := + TileOdometerBandPrototile _ _ _ hOminus + have hRplusBand : BandPrototile D.1.1 Rplus := + TileOdometerBandPrototile _ _ _ hOplus + obtain ⟨_, _, _, _, hRminusNe⟩ := + P4250T1DefinedHalfIntegralSlope D.1.1 Rminus hminus + (by rw [hunit]; norm_num) hOminus + obtain ⟨_, _, _, _, hRplusNe⟩ := + P4250T1DefinedHalfIntegralSlope D.1.1 Rplus hplus + (by rw [hunit]; norm_num) hOplus + obtain ⟨_, _, _, _, hTNe⟩ := P4250T1DefinedHalfIntegralSlope C.1.1 T h (by + have hcpos := cfg.childLarge + rw [← hC] + omega) hh + obtain ⟨_, _, _, _, hUNe⟩ := P4250T1DefinedHalfIntegralSlope C.1.1 U k (by + have hcpos := cfg.childLarge + rw [← hC] + omega) hk + have hqi' : q' i.succ = q i.succ := hqi.trans hD.symm + have hq0' : q' 0 = q 0 := hq0.trans hC.symm + have hcentDiff := UnitInterfaceGeometry.hcentDiff q i T Rminus Rplus + (UnitInterfaceGeometry.hcentMinusQ q i T Rminus q' hcentMinus hqi' hq0') + (UnitInterfaceGeometry.hcentPlusQ q i T Rplus q' hcentPlus hqi' hq0') + let w : GaussianInt := BandVectors.1 (q 0) (q i.succ) + have hneq : (0 : Fin 4) ≠ i.succ := (Fin.succ_ne_zero i).symm + have hvector := (VectorSquareProduct q cfg.proper.1 0 i.succ hneq).1 + have htangent := TangencyCoordinateIdentity q cfg.proper.1 0 i.succ hneq + have hnormBig := UnitInterfaceGeometry.hnormBig q i (UnitInterfaceGeometry.hnormSq q i hvector + htangent) (UnitInterfaceGeometry.hcurvSum q cfg D i hD hunit) + have hrealPointInj := UnitInterfaceGeometry.hrealPointInj + have hRminusNeRplus := UnitInterfaceGeometry.hRminusNeRplus q i Rminus Rplus hcentDiff hnormBig + hrealPointInj + have hnonadj := UnitInterfaceGeometry.hnonadj q D i hunit orientation Rminus Rplus hcentDiff + hnormBig hrealPointInj (UnitInterfaceGeometry.hunitStepNorm orientation) + have htriplePositive := UnitInterfaceGeometry.htriplePositive q cfg C D i hC hD T U cert hsym + hc Rplus q' hq0 hqi hcentPlus hTband hUband hRplusBand hUNe + let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift + have hFTCells : (F T).cells = U.cells := UnitInterfaceGeometry.hFTCells q C D i hC hD T U h k + hh hc centerShift Rminus Rplus a b hminusCells houterAffine q' hq0 hqi hcentMinus hcentPlus + hUband hRplusNe + have hFUCells : (F U).cells = T.cells := UnitInterfaceGeometry.hFUCells T U centerShift + (UnitInterfaceGeometry.hFCellsInvolutive q D i centerShift) + (UnitInterfaceGeometry.hFCellCongr centerShift) hFTCells + have hFRplusCells : (F Rplus).cells = Rminus.cells := hplusCells + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation centerShift (GaussianQuarterTurn (GaussianQuarterTurn z)) + have hpositiveImage : ∀ E : ExactTileInterfaceTriple T U Rplus, + ∃ E' : ExactTileInterfaceTriple (F T) (F U) (F Rplus), + E'.point = f E.point ∧ E'.otherAB = f E.otherAB := UnitInterfaceGeometry.hpositiveImage + T U centerShift Rplus + (UnitInterfaceGeometry.hf centerShift) (UnitInterfaceGeometry.hstep q D i centerShift) + (UnitInterfaceGeometry.hvertices centerShift) (UnitInterfaceGeometry.hedges centerShift) + obtain ⟨Epositive⟩ := htriplePositive + obtain ⟨Eimage, himagePoint, himageAB⟩ := hpositiveImage Epositive + have hFNeT : (F T).cells.Nonempty := by rw [hFTCells]; exact hUNe + have hFNeU : (F U).cells.Nonempty := by rw [hFUCells]; exact hTNe + have hFNeRminus : (F Rplus).cells.Nonempty := by rw [hFRplusCells]; exact hRminusNe + have hvFT : FootprintVertices (F T) = FootprintVertices U := by + simp [FootprintVertices, hFTCells, hUNe] + have hvFU : FootprintVertices (F U) = FootprintVertices T := by + simp [FootprintVertices, hFUCells, hTNe] + have hvFR : FootprintVertices (F Rplus) = FootprintVertices Rminus := by + simp [FootprintVertices, hFRplusCells, hRminusNe] + have heFT : FootprintEdges (F T) = FootprintEdges U := by + simp [FootprintEdges, hFTCells] + have heFU : FootprintEdges (F U) = FootprintEdges T := by + simp [FootprintEdges, hFUCells] + have heFR : FootprintEdges (F Rplus) = FootprintEdges Rminus := by + simp [FootprintEdges, hFRplusCells] + let Enegative : ExactTileInterfaceTriple U T Rminus := { + point := Eimage.point + otherAB := Eimage.otherAB + otherBC := Eimage.otherBC + otherCA := Eimage.otherCA + pathAB := by simpa [hvFT, hvFU, heFT, heFU] using Eimage.pathAB + pathBC := by simpa [hvFU, hvFR, heFU, heFR] using Eimage.pathBC + pathCA := by simpa [hvFR, hvFT, heFR, heFT] using Eimage.pathCA + unique_common := by + intro z + simpa [hvFT, hvFU, hvFR] using Eimage.unique_common z } + have hposPath : SimpleGridPathBetween + (FootprintVertices T ∩ FootprintVertices U) + (FootprintEdges T ∩ FootprintEdges U) + Epositive.point Epositive.otherAB := Epositive.pathAB + have hendpointPair := SimpleGridPathEndpointPairUnique hposPath (UnitInterfaceGeometry.hnegPath + T U centerShift Rminus Rplus Eimage hvFT hvFU hvFR heFT heFU heFR) + have hinvolutive (z : GaussianInt) : f (f z) = z := by + apply Zsqrtd.ext <;> simp [f, GaussianTranslation, GaussianQuarterTurn] + have hnegativePoint := UnitInterfaceGeometry.hnegativePoint T U centerShift Rminus Rplus + Epositive Eimage himagePoint hvFT hvFU hvFR heFT heFU heFR hendpointPair + (UnitInterfaceGeometry.hpointNotFixed T U centerShift Rminus Rplus Epositive Eimage + himageAB hvFT hvFU hvFR heFT heFU heFR hendpointPair (UnitInterfaceGeometry.hposNe T U + Rplus Epositive hposPath) hinvolutive (UnitInterfaceGeometry.hfixedUnique q D i centerShift)) + obtain ⟨walk, hwalkHead, hwalkLast, hwalkChain, hwalkVertices, + hwalkEdges⟩ := OpposingStringInterfacePath D orientation base Rminus Rplus + hRminusNeRplus hnonadj tiles reverseTiles hstring hreverse + have hCpositive := UnitInterfaceGeometry.hCpositive q cfg C D i hC + have hdomOuterT : (h.domain : Set GaussianInt) = FootprintVertices T := + PositiveCurvatureTileOdometerDomain C.1.1 T h hCpositive hh + have hdomOuterU : (k.domain : Set GaussianInt) = FootprintVertices U := + PositiveCurvatureTileOdometerDomain C.1.1 U k hCpositive hk + have hwalkInOuter := UnitInterfaceGeometry.hwalkInOuter C D T U h k tiles reverseTiles + functions reverseFunctions hrestrictionsForward hrestrictionsBackward walk hwalkVertices + hdomOuterT hdomOuterU + have hwalkOuterEdges := UnitInterfaceGeometry.hwalkOuterEdges C D T U h k tiles reverseTiles + functions reverseFunctions hrestrictionsForward hrestrictionsBackward walk hwalkEdges + (UnitInterfaceGeometry.edgeAncestor C D) + have hwalkStart := UnitInterfaceGeometry.hwalkStart T U centerShift Rminus Rplus tiles + reverseTiles Eimage hvFT hvFU hvFR heFT heFU heFR walk hwalkHead hwalkLast hwalkChain + hwalkVertices hwalkEdges hwalkInOuter hwalkOuterEdges + have hwalkFinish := UnitInterfaceGeometry.hwalkFinish T U Rplus Epositive walk hwalkLast + hwalkInOuter + obtain ⟨path, hpathNodup, hpathLength, hpathHead, hpathLast, + hpathVertices, hpathStep, hpathEdges⟩ := Epositive.pathAB + have hpathIndex := UnitInterfaceGeometry.hpathIndex q C D i T U path hpathNodup hpathEdges + have hpathIndexInjective {a b : GaussianInt} (ha : a ∈ path) + (hidx : path.idxOf a = path.idxOf b) : a = b := + (List.idxOf_inj ha).mp hidx + have hstartIndex := UnitInterfaceGeometry.hstartIndex T U Rplus Epositive path hpathNodup + hpathLast + exact ⟨{ + orientation := orientation + base := base + minus := Rminus + plus := Rplus + tiles := tiles + reverseTiles := reverseTiles + functions := functions + reverseFunctions := reverseFunctions + hminus := hminus + hplus := hplus + path := path + forward := hforwardRespect + backward := hbackwardRespect + head_forward := hheadForward + last_forward := hlastForward + head_backward := hheadBackward + last_backward := hlastBackward + nodup := hpathNodup + length := hpathLength + vertices := hpathVertices + edges := hpathEdges + restrictions := (UnitInterfaceGeometry.hrestrictions C D T U h k tiles reverseTiles functions + reverseFunctions hrestrictionsForward hrestrictionsBackward walk hwalkEdges path + (UnitInterfaceGeometry.hcovered q C D i T U Rplus Epositive walk hwalkOuterEdges path + hpathLength hpathIndex hpathIndexInjective hstartIndex + (UnitInterfaceGeometry.hfinishIndex T U Rplus Epositive path hpathNodup hpathLength + hpathHead hpathLast hpathVertices hpathStep hpathEdges hpathIndex hpathIndexInjective + hstartIndex) (UnitInterfaceGeometry.hpathIndexEdge path hpathNodup) + (UnitInterfaceGeometry.hwalkHeadPos T U centerShift Rminus Rplus Epositive Eimage hvFT + hvFU hvFR heFT heFU heFR hnegativePoint walk hwalkStart) + (UnitInterfaceGeometry.hwalkLastPos T U Rplus Epositive walk hwalkFinish) + (UnitInterfaceGeometry.hwalkVertexPath T U walk hwalkInOuter path hpathVertices))) + }⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitStringTelescoping.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitStringTelescoping.lean new file mode 100644 index 0000000000..4f47181b26 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitStringTelescoping.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4261T2AdjacentMatrixSlope +public import LeanPool.ApollonianSuperharmonic.P4250T1DefinedHalfIntegralSlope +public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect + +-- [TABLET NODE: P4261T2UnitStringTelescoping] + +/-! +# P4261T2UnitStringTelescoping + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4261T2UnitStringTelescoping + (C : BandCircle) (_hunit : C.1.1.1 = 1) + (orientation : Bool) (base R S : ProtoTile) + (tiles reverseTiles : List ProtoTile) (hs reverseHs : List PartialOdometer) + (hf : OdometerStringRespect C orientation base R S tiles hs) + (hr : OdometerStringRespect C orientation base S R reverseTiles reverseHs) + (hendpoint : PartialOdometer) + (hh : hs.head? = some hendpoint) (hh' : reverseHs.getLast? = some hendpoint) + (U V : ProtoTile) (g k : PartialOdometer) + (hU : (U, g) ∈ tiles.zip hs) (hV : (V, k) ∈ reverseTiles.zip reverseHs) : + ∃ s t : Real × Real, + PartialOdometerSlope g = some s ∧ PartialOdometerSlope k = some t ∧ + t.1 - s.1 = CircleMatrix C 0 0 * ((TileCentroid V).1 - (TileCentroid U).1) + + CircleMatrix C 0 1 * ((TileCentroid V).2 - (TileCentroid U).2) ∧ + t.2 - s.2 = CircleMatrix C 1 0 * ((TileCentroid V).1 - (TileCentroid U).1) + + CircleMatrix C 1 1 * ((TileCentroid V).2 - (TileCentroid U).2) := by +-- BODY + obtain ⟨s, _, hsg, _⟩ := P4250T1DefinedHalfIntegralSlope C.1.1 U g C.2 + (List.forall₂_zip hf.2.1 hU) + obtain ⟨t, _, htk, _⟩ := P4250T1DefinedHalfIntegralSlope C.1.1 V k C.2 + (List.forall₂_zip hr.2.1 hV) + let invariant := fun X : ProtoTile × PartialOdometer => + let p := (PartialOdometerSlope X.2).getD (0, 0) + (p.1 - CircleMatrix C 0 0 * (TileCentroid X.1).1 - + CircleMatrix C 0 1 * (TileCentroid X.1).2, + p.2 - CircleMatrix C 1 0 * (TileCentroid X.1).1 - + CircleMatrix C 1 1 * (TileCentroid X.1).2) + let invRel := fun X Y : ProtoTile × PartialOdometer => invariant X = invariant Y + have invStep : ∀ A B : ProtoTile × PartialOdometer, + LeftLatticeAdjacent C A.1 B.1 A.2 B.2 → invRel A B := by + intro A B hadj + obtain ⟨p, r, hp, hr, h0, h1⟩ := P4261T2AdjacentMatrixSlope C _ _ _ _ hadj + change invariant A = invariant B + apply Prod.ext <;> simp only [invariant, hp, hr, Option.getD_some] + · linear_combination -h0 + · linear_combination -h1 + have hfirstChain : (tiles.zip hs).IsChain invRel := hf.2.2.imp invStep + have hsecondChain : (reverseTiles.zip reverseHs).IsChain invRel := hr.2.2.imp invStep + let : Trans invRel invRel invRel := ⟨by + intro a b c hab hbc + exact hab.trans hbc⟩ + let : Std.Refl invRel := ⟨fun _ => rfl⟩ + have hfirstPairwise := List.isChain_iff_pairwise.mp hfirstChain + have hsecondPairwise := List.isChain_iff_pairwise.mp hsecondChain + obtain ⟨postTiles, hpostTiles⟩ := List.head?_eq_some_iff.mp hf.1.2.1 + obtain ⟨postHs, hpostHs⟩ := List.head?_eq_some_iff.mp hh + have hzipHead : tiles.zip hs = (R, hendpoint) :: postTiles.zip postHs := by + rw [hpostTiles, hpostHs] + rfl + obtain ⟨preTiles, hpreTiles⟩ := List.getLast?_eq_some_iff.mp hr.1.2.2.1 + obtain ⟨preHs, hpreHs⟩ := List.getLast?_eq_some_iff.mp hh' + have hlenPre : preTiles.length = preHs.length := by + have hlen := List.Forall₂.length_eq hr.2.1 + rw [hpreTiles, hpreHs, List.length_append, List.length_singleton, + List.length_append, List.length_singleton] at hlen + omega + have hzipLast : reverseTiles.zip reverseHs = preTiles.zip preHs ++ [(R, hendpoint)] := by + rw [hpreTiles, hpreHs, List.zip_append hlenPre] + simp + have hInvU : invariant (R, hendpoint) = invariant (U, g) := by + rw [hzipHead] at hfirstPairwise hU + simpa using hfirstPairwise.rel_head hU + have hInvV : invariant (V, k) = invariant (R, hendpoint) := by + rw [hzipLast] at hsecondPairwise hV + simpa using hsecondPairwise.rel_getLast hV + have hInvUV := hInvU.symm.trans hInvV.symm + refine ⟨s, t, hsg, htk, ?_, ?_⟩ + · have heq := congrArg Prod.fst hInvUV + simp only [invariant, hsg, htk, Option.getD_some] at heq + linear_combination -heq + · have heq := congrArg Prod.snd hInvUV + simp only [invariant, hsg, htk, Option.getD_some] at heq + linear_combination -heq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4339T1EmptyPrecursorRoots.lean b/LeanPool/ApollonianSuperharmonic/P4339T1EmptyPrecursorRoots.lean new file mode 100644 index 0000000000..98f5edfa13 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4339T1EmptyPrecursorRoots.lean @@ -0,0 +1,216 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary + +-- [TABLET NODE: P4339T1EmptyPrecursorRoots] + +/-! +# P4339T1EmptyPrecursorRoots + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4339T1EmptyPrecursorRoots + (C : BandCircle) (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (D P : Finset GaussianInt) + (hD : ∀ x, x ∈ D ↔ + x ∈ FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T) + (hP : ∀ x, x ∈ P ↔ x ∈ D ∧ ∃ i s, + x ∈ FootprintVertices (cert.P i s) ∧ + x ∉ BoundaryFootprintVertices (cert.P i s)) + (hO : cert.O.cells = ∅) : + let W := D \ P + let R : Finset GaussianInt := {cert.precursor_boundary.a, cert.precursor_boundary.b} + R ⊆ W ∧ + (∀ x ∈ W, x ∈ FootprintVertices cert.O ↔ x ∈ R) ∧ + (∀ x ∈ R, + Nat.card {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2 ∧ + GaussianRealPoint x = TileCentroid T) := by +-- BODY + classical + dsimp only + obtain ⟨hcent, _, _, _, hQ, hS, hpair, hdisjoint⟩ := + P4339T1PrecursorSupportGeometry C q cfg T cert + obtain ⟨hab, hanchor⟩ : cert.precursor_boundary.a = cert.precursor_boundary.b ∧ + cert.precursor_boundary.a = cert.O.anchor := by + rcases cert.precursor_boundary.branch with hp | ⟨_, hab, ha, _⟩ + · exact ((Finset.nonempty_iff_ne_empty.mp hp.1) hO).elim + · exact ⟨hab, ha⟩ + let a := cert.precursor_boundary.a + have hR (x : GaussianInt) : + x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + Finset GaussianInt) ↔ x = a := by + simp [← hab, a] + have hfootO (x : GaussianInt) : x ∈ FootprintVertices cert.O ↔ x = a := by + simp [FootprintVertices, hO, ← hanchor, a] + have hpoint : GaussianRealPoint a = TileCentroid T := by + calc + GaussianRealPoint a = TileCentroid cert.O := by + simp [TileCentroid, hO, GaussianRealPoint, ← hanchor, a] + _ = TileCentroid T := hcent + have raw_incident (U : ProtoTile) (x : GaussianInt) (hn : U.cells.Nonempty) + (hx : x ∈ FootprintVertices U) : + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells := by + as_aux_lemma => + clear * - U x hn hx + rw [FootprintVertices, ite_eq_left hn] at hx + obtain ⟨z, hz, rfl | rfl | rfl | rfl⟩ := hx + · exact ⟨0, hz⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hz⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hz⟩ + · refine ⟨2, ?_⟩ + change z + 1 + ⟨0, 1⟩ - 1 - ⟨0, 1⟩ ∈ U.cells + convert hz using 1; abel + have boundary_incident (U : ProtoTile) (x : GaussianInt) (hn : U.cells.Nonempty) + (hx : x ∈ BoundaryFootprintVertices U) : + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells := by + as_aux_lemma => + clear * - U x hn hx + rw [BoundaryFootprintVertices, ite_eq_left hn] at hx + obtain ⟨e, ⟨z, ⟨rfl, hz⟩ | ⟨rfl, hz⟩⟩, hxe⟩ := hx + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hxe with rfl | rfl <;> rcases hz with hz | hz + · exact ⟨0, hz.1⟩ + · exact ⟨3, hz.2⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hz.1⟩ + · exact ⟨2, by simpa [LatticeVertexIncidentCell] using hz.2⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hxe with rfl | rfl <;> rcases hz with hz | hz + · exact ⟨0, hz.1⟩ + · exact ⟨1, hz.2⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hz.1⟩ + · refine ⟨2, ?_⟩ + convert hz.2 using 1; simp [LatticeVertexIncidentCell, sub_sub] + have full_nonboundary (U : ProtoTile) (x : GaussianInt) + (hall : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells) : + x ∉ BoundaryFootprintVertices U := by + as_aux_lemma => + clear * - U x hall + have hn : U.cells.Nonempty := ⟨x, hall 0⟩ + intro hx + rw [BoundaryFootprintVertices, ite_eq_left hn] at hx + obtain ⟨e, ⟨z, ⟨rfl, hz⟩ | ⟨rfl, hz⟩⟩, hxe⟩ := hx + all_goals + have h0 := hall 0 + have h1 := hall 1 + have h2 := hall 2 + have h3 := hall 3 + simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hxe with rfl | rfl + all_goals + simp [LatticeVertexIncidentCell, sub_eq_add_neg, add_comm, + add_left_comm, add_assoc] at h0 h1 h2 h3 hz + tauto + have trans_zero (U : ProtoTile) : TileTranslation U 0 = U := by + cases U + simp [TileTranslation, GaussianTranslation, show GaussianTranslation 0 = id from + funext (fun z => add_zero z)] + have hallAB : ∀ j : Fin 4, + LatticeVertexIncidentCell a j ∈ (cert.P 0 true).cells ∨ + LatticeVertexIncidentCell a j ∈ (cert.P 0 false).cells := by + intro j + have hcorner : a ∈ FootprintVertices + (⟨{LatticeVertexIncidentCell a j}, LatticeVertexIncidentCell a j⟩ : ProtoTile) := by + rw [FootprintVertices, ite_eq_left (Finset.singleton_nonempty _)] + refine ⟨LatticeVertexIncidentCell a j, by simp, ?_⟩ + fin_cases j <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] + have hisolated := cert.precursor_isolated 0 0 a + (by simpa only [Int.cast_zero, zero_mul, zero_add, trans_zero] using + (hfootO a).mpr rfl) (LatticeVertexIncidentCell a j) hcorner + simpa only [SubtileOccurrenceInterpretation, Int.cast_zero, zero_mul, + zero_add, trans_zero] using hisolated + have hfirst := (cert.precursor_boundary.first_transition a).mpr rfl + obtain ⟨jA, hjA⟩ := boundary_incident _ a hQ hfirst.1 + obtain ⟨jB, hjB⟩ := boundary_incident _ a hS hfirst.2.1 + have hA : LatticeVertexIncidentCell a jA ∈ (cert.P 0 true).cells := + (Finset.mem_sdiff.mp (cert.precursor_boundary.first_plus_child hjA)).1 + have hB : LatticeVertexIncidentCell a jB ∈ (cert.P 0 false).cells := + (Finset.mem_sdiff.mp (cert.precursor_boundary.first_minus_child hjB)).1 + have hAB : Disjoint (cert.P 0 true).cells (cert.P 0 false).cells := + Finset.disjoint_iff_inter_eq_empty.mpr (hpair.trans hO) + have hboundaryA : a ∈ BoundaryFootprintVertices (cert.P 0 true) := + P3161T2IncidentBoundary _ a ⟨jA, hA⟩ + ⟨jB, fun hc => Finset.disjoint_left.mp hAB hc hB⟩ + have hboundaryB : a ∈ BoundaryFootprintVertices (cert.P 0 false) := + P3161T2IncidentBoundary _ a ⟨jB, hB⟩ + ⟨jA, fun hc => Finset.disjoint_left.mp hAB hA hc⟩ + have other_absent (i : Fin 3) (s : Bool) (hi : i ≠ 0) (j : Fin 4) : + LatticeVertexIncidentCell a j ∉ (cert.P i s).cells := by + intro hc + rcases hallAB j with ht | hf + · exact Finset.disjoint_left.mp + (hdisjoint i s 0 true (fun he => hi (congrArg Prod.fst he)) + (fun he => hi he.1)) hc ht + · exact Finset.disjoint_left.mp + (hdisjoint i s 0 false (fun he => hi (congrArg Prod.fst he)) + (fun he => hi he.1)) hc hf + have hboundary (i : Fin 3) (s : Bool) : + a ∈ BoundaryFootprintVertices (cert.P i s) ↔ i = 0 := by + by_cases hi : i = 0 + · subst i + cases s <;> simp only [iff_true] <;> assumption + · refine ⟨fun hb => ?_, fun he => (hi he).elim⟩ + obtain ⟨j, hj⟩ := boundary_incident _ a + (LatticeTileGridStructure _ (cert.parent_lattice i s)).1.1 hb + exact (other_absent i s hi j hj).elim + have hallT (j : Fin 4) : LatticeVertexIncidentCell a j ∈ T.cells := by + rcases hallAB j with ht | hf + · exact (cert.outer_union _).mpr ⟨0, true, ht⟩ + · exact (cert.outer_union _).mpr ⟨0, false, hf⟩ + have hDa : a ∈ D := by + apply (hD a).mpr + refine ⟨?_, full_nonboundary T a hallT⟩ + have h0 : a ∈ T.cells := hallT 0 + rw [FootprintVertices, ite_eq_left ⟨a, h0⟩] + exact ⟨a, h0, Or.inl rfl⟩ + have hnotP : a ∉ P := by + intro hp + obtain ⟨_, i, s, hf, hnb⟩ := (hP a).mp hp + by_cases hi : i = 0 + · exact hnb ((hboundary i s).mpr hi) + · obtain ⟨j, hj⟩ := raw_incident _ a + (LatticeTileGridStructure _ (cert.parent_lattice i s)).1.1 hf + exact other_absent i s hi j hj + have hWa : a ∈ D \ P := Finset.mem_sdiff.mpr ⟨hDa, hnotP⟩ + have hcount : Nat.card {is : Fin 3 × Bool // + a ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2 := by + let e : {is : Fin 3 × Bool // + a ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} ≃ Bool := + { toFun := fun z => z.val.2 + invFun := fun s => ⟨(0, s), (hboundary 0 s).mpr rfl⟩ + left_inv := by + intro z + apply Subtype.ext + apply Prod.ext + · exact ((hboundary z.val.1 z.val.2).mp z.property).symm + · rfl + right_inv := fun _ => rfl } + rw [Nat.card_congr e] + simp + refine ⟨?_, ?_, ?_⟩ + · intro x hx + exact (hR x).mp hx ▸ hWa + · intro x _ + exact (hfootO x).trans (hR x).symm + · intro x hx + obtain rfl := (hR x).mp hx + exact ⟨hcount, hpoint⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean b/LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean new file mode 100644 index 0000000000..7dd124e6f3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean @@ -0,0 +1,868 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorStarClassification +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary + +-- [TABLET NODE: P4339T1PositivePrecursorRoots] + +/-! +# P4339T1PositivePrecursorRoots + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PositivePrecursorGeometry + +private theorem raw_incident : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ FootprintVertices U) → + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells)) ) := by + classical + intro U x hn hx + rw [FootprintVertices, ite_eq_left hn] at hx + obtain ⟨z, hz, rfl | rfl | rfl | rfl⟩ := hx + · exact ⟨0, hz⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hz⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hz⟩ + · refine ⟨2, ?_⟩ + change z + 1 + ⟨0, 1⟩ - 1 - ⟨0, 1⟩ ∈ U.cells + convert hz using 1; abel + +private theorem boundary_incident : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ + BoundaryFootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + U.cells)) ) := by + classical + intro U x hn hx + rw [BoundaryFootprintVertices, ite_eq_left hn] at hx + obtain ⟨e, ⟨z, ⟨rfl, hz⟩ | ⟨rfl, hz⟩⟩, hxe⟩ := hx + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hxe with rfl | rfl <;> rcases hz with hz | hz + · exact ⟨0, hz.1⟩ + · exact ⟨3, hz.2⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hz.1⟩ + · exact ⟨2, by simpa [LatticeVertexIncidentCell] using hz.2⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hxe with rfl | rfl <;> rcases hz with hz | hz + · exact ⟨0, hz.1⟩ + · exact ⟨1, hz.2⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hz.1⟩ + · refine ⟨2, ?_⟩ + convert hz.2 using 1; simp [LatticeVertexIncidentCell, sub_sub] + +private theorem full_nonboundary : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (Finset.Nonempty cert.O.cells) → + ((cert.O.cells = ∅ ↔ (cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → + ((Finset.Nonempty cert.O.cells → LatticeTile cert.O) → (∀ (U : ProtoTile), ∀ (x : + GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells) → (x ∉ + BoundaryFootprintVertices U)))) ) := by + classical + intro C q cfg T cert hO hzero hOlattice U x hall + have hn : U.cells.Nonempty := ⟨x, hall 0⟩ + intro hx + rw [BoundaryFootprintVertices, ite_eq_left hn] at hx + obtain ⟨e, ⟨z, ⟨rfl, hz⟩ | ⟨rfl, hz⟩⟩, hxe⟩ := hx + all_goals + have h0 := hall 0 + have h1 := hall 1 + have h2 := hall 2 + have h3 := hall 3 + simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hxe with rfl | rfl + all_goals + simp [LatticeVertexIncidentCell, sub_eq_add_neg, add_comm, + add_left_comm, add_assoc] at h0 h1 h2 h3 hz + tauto + +private theorem htrans0 : + (by + classical + exact + GaussianTranslation 0 = id ) := by + classical + funext z + exact add_zero z + +private theorem trans_zero : + (by + classical + exact + (GaussianTranslation 0 = id) → (∀ (U : ProtoTile), TileTranslation U 0 = U) ) := by + classical + intro htrans0 U + cases U + simp [TileTranslation, htrans0] + +private theorem hallAB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (∀ (U : ProtoTile), TileTranslation U + 0 = U) → (∀ (x : GaussianInt), (x ∈ FootprintVertices cert.O) → (∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ LatticeVertexIncidentCell x j + ∈ (cert.P 0 false).cells)) ) := by + classical + intro C q cfg T cert trans_zero x hx j + have hcorner : x ∈ FootprintVertices + (⟨{LatticeVertexIncidentCell x j}, LatticeVertexIncidentCell x j⟩ : ProtoTile) := by + rw [FootprintVertices, ite_eq_left (Finset.singleton_nonempty _)] + refine ⟨LatticeVertexIncidentCell x j, by simp, ?_⟩ + fin_cases j <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] + have hisolated := cert.precursor_isolated 0 0 x + (by simpa only [Int.cast_zero, zero_mul, zero_add, trans_zero] using hx) + (LatticeVertexIncidentCell x j) hcorner + simpa only [SubtileOccurrenceInterpretation, Int.cast_zero, zero_mul, + zero_add, trans_zero] using hisolated + +private theorem hallT : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (∀ (x : GaussianInt), (x ∈ + FootprintVertices cert.O) → (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P 0 + true).cells ∨ LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells)) → (∀ (x : + GaussianInt), (x ∈ FootprintVertices cert.O) → (∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T.cells)) ) := by + classical + intro C q cfg T cert hallAB x hx j + rcases hallAB x hx j with hA | hB + · exact (cert.outer_union _).mpr ⟨0, true, hA⟩ + · exact (cert.outer_union _).mpr ⟨0, false, hB⟩ + +private theorem inD : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), (∀ (x : + GaussianInt), x ∈ D ↔ x ∈ FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T) → + ((∀ (U : ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j + ∈ U.cells) → (x ∉ BoundaryFootprintVertices U)) → ((∀ (x : GaussianInt), (x ∈ + FootprintVertices cert.O) → (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells)) → + (∀ (x : GaussianInt), (x ∈ FootprintVertices cert.O) → (x ∈ D)))) ) := by + classical + intro C q cfg T cert D hD full_nonboundary hallT x hx + apply (hD x).mpr + refine ⟨?_, full_nonboundary T x (hallT x hx)⟩ + rw [FootprintVertices, ite_eq_left ⟨x, hallT x hx 0⟩] + exact ⟨x, hallT x hx 0, Or.inl rfl⟩ + +private theorem hOA : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), cert.O.cells ⊆ (cert.P 0 true).cells + ) := by + classical + intro C q cfg T cert z hz + apply (cert.plus_union z).mpr + exact ⟨0, false, by simpa only [← cert.precursor_eq] using hz⟩ + +private theorem hOB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), cert.O.cells ⊆ (cert.P 0 false).cells + ) := by + classical + intro C q cfg T cert z hz + exact (cert.minus_union z).mpr ⟨0, true, by rw [← cert.precursor_cells]; exact hz⟩ + +private theorem incident_footprint : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ + U.cells) → (x ∈ FootprintVertices U) ) := by + classical + intro U x j hj + have hn : U.cells.Nonempty := ⟨_, hj⟩ + rw [FootprintVertices, ite_eq_left hn] + refine ⟨LatticeVertexIncidentCell x j, hj, ?_⟩ + fin_cases j <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] + +private theorem boundary_footprint : + (by + classical + exact + (∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ + BoundaryFootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + U.cells))) → ((∀ (U : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ U.cells) → (x ∈ FootprintVertices U)) → (∀ (U : + ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices + U) → (x ∈ FootprintVertices U)))) ) := by + classical + intro boundary_incident incident_footprint U x hn hb + obtain ⟨j, hj⟩ := boundary_incident U x hn hb + exact incident_footprint U x j hj + +private theorem haPlus : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (plusArc : List GaussianInt), + (plusArc.head? = some cert.precursor_boundary.a) → (cert.precursor_boundary.a ∈ + (plusArc.toFinset : Set GaussianInt)) ) := by + classical + intro C q cfg T cert plusArc hplusHead + have hn : plusArc ≠ [] := by intro h; simp [h] at hplusHead + have heq : plusArc.head hn = cert.precursor_boundary.a := by + have hh := hplusHead + rw [List.head?_eq_some_head hn] at hh + exact Option.some.inj hh + exact List.mem_toFinset.mpr (by simpa [heq] using List.head_mem hn) + +private theorem hbPlus : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (plusArc : List GaussianInt), + (plusArc.getLast? = some cert.precursor_boundary.b) → (cert.precursor_boundary.b ∈ + (plusArc.toFinset : Set GaussianInt)) ) := by + classical + intro C q cfg T cert plusArc hplusLast + have hn : plusArc ≠ [] := by intro h; simp [h] at hplusLast + have heq : plusArc.getLast hn = cert.precursor_boundary.b := by + have hh := hplusLast + rw [List.getLast?_eq_getLast_of_ne_nil hn] at hh + exact Option.some.inj hh + exact List.mem_toFinset.mpr (by simpa [heq] using List.getLast_mem hn) + +private theorem hbMinus : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (minusArc : List GaussianInt), + (minusArc.head? = some cert.precursor_boundary.b) → (cert.precursor_boundary.b ∈ + (minusArc.toFinset : Set GaussianInt)) ) := by + classical + intro C q cfg T cert minusArc hminusHead + have hn : minusArc ≠ [] := by intro h; simp [h] at hminusHead + have heq : minusArc.head hn = cert.precursor_boundary.b := by + have hh := hminusHead + rw [List.head?_eq_some_head hn] at hh + exact Option.some.inj hh + exact List.mem_toFinset.mpr (by simpa [heq] using List.head_mem hn) + +private theorem haMinus : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (minusArc : List GaussianInt), + (minusArc.getLast? = some cert.precursor_boundary.a) → (cert.precursor_boundary.a ∈ + (minusArc.toFinset : Set GaussianInt)) ) := by + classical + intro C q cfg T cert minusArc hminusLast + have hn : minusArc ≠ [] := by intro h; simp [h] at hminusLast + have heq : minusArc.getLast hn = cert.precursor_boundary.a := by + have hh := hminusLast + rw [List.getLast?_eq_getLast_of_ne_nil hn] at hh + exact Option.some.inj hh + exact List.mem_toFinset.mpr (by simpa [heq] using List.getLast_mem hn) + +private theorem arcPlus : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (plusArc : List GaussianInt), + ((↑plusArc.toFinset : Set GaussianInt) = BoundaryFootprintVertices + (TileCellComplement (cert.P (0 : Fin (3 : ℕ)) true) cert.O) ∩ + BoundaryFootprintVertices cert.O) → (∀ (x : GaussianInt), (x ∈ (plusArc.toFinset : + Set GaussianInt)) → (x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 + true) cert.O) ∧ x ∈ BoundaryFootprintVertices cert.O)) ) := by + classical + intro C q cfg T cert plusArc hplusSet x hx + rw [hplusSet] at hx + exact hx + +private theorem arcMinus : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (minusArc : List GaussianInt), + ((↑minusArc.toFinset : Set GaussianInt) = BoundaryFootprintVertices + (TileCellComplement (cert.P (0 : Fin (3 : ℕ)) false) cert.O) ∩ + BoundaryFootprintVertices cert.O) → (∀ (x : GaussianInt), (x ∈ (minusArc.toFinset : + Set GaussianInt)) → (x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 + false) cert.O) ∧ x ∈ BoundaryFootprintVertices cert.O)) ) := by + classical + intro C q cfg T cert minusArc hminusSet x hx + rw [hminusSet] at hx + exact hx + +private theorem hR : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt) ↔ x = + cert.precursor_boundary.a ∨ x = cert.precursor_boundary.b ) := by + classical + intro C q cfg T cert x + simp + +private theorem endpoint_boundaries : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (plusArc : List GaussianInt), ∀ + (minusArc : List GaussianInt), (cert.precursor_boundary.a ∈ (plusArc.toFinset : Set + GaussianInt)) → ((cert.precursor_boundary.b ∈ (plusArc.toFinset : Set GaussianInt)) → + ((cert.precursor_boundary.b ∈ (minusArc.toFinset : Set GaussianInt)) → + ((cert.precursor_boundary.a ∈ (minusArc.toFinset : Set GaussianInt)) → ((∀ (x : + GaussianInt), (x ∈ (plusArc.toFinset : Set GaussianInt)) → (x ∈ + BoundaryFootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∧ x ∈ + BoundaryFootprintVertices cert.O)) → ((∀ (x : GaussianInt), (x ∈ (minusArc.toFinset : + Set GaussianInt)) → (x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 + false) cert.O) ∧ x ∈ BoundaryFootprintVertices cert.O)) → ((∀ (x : GaussianInt), x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt) ↔ x = + cert.precursor_boundary.a ∨ x = cert.precursor_boundary.b) → (∀ (x : GaussianInt), (x + ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (x + ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∧ x ∈ + BoundaryFootprintVertices (TileCellComplement (cert.P 0 false) cert.O) ∧ x ∈ + BoundaryFootprintVertices cert.O)))))))) ) := by + classical + intro C q cfg T cert plusArc minusArc haPlus hbPlus hbMinus haMinus arcPlus arcMinus hR x hxR + rcases (hR x).mp hxR with rfl | rfl + · exact ⟨(arcPlus _ haPlus).1, (arcMinus _ haMinus).1, + (arcPlus _ haPlus).2⟩ + · exact ⟨(arcPlus _ hbPlus).1, (arcMinus _ hbMinus).1, + (arcPlus _ hbPlus).2⟩ + +private theorem hboundaryA : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (Finset.Nonempty cert.O.cells) → + (((cert.P (0 : Fin (3 : ℕ)) true).cells ∩ (cert.P (0 : Fin (3 : ℕ)) false).cells = + cert.O.cells) → ((∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ + FootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells))) → ((∀ + (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ + BoundaryFootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + U.cells))) → ((∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ + BoundaryFootprintVertices U) → (x ∈ FootprintVertices U))) → ((∀ (x : GaussianInt), + (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → + (x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∧ x ∈ + BoundaryFootprintVertices (TileCellComplement (cert.P 0 false) cert.O) ∧ x ∈ + BoundaryFootprintVertices cert.O)) → (((TileCellComplement (cert.P 0 true) + cert.O).cells.Nonempty) → (((TileCellComplement (cert.P 0 false) + cert.O).cells.Nonempty) → (∀ (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, + cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices + (cert.P 0 true)))))))))) ) := by + classical + intro C q cfg T cert hO hpair raw_incident boundary_incident boundary_footprint + endpoint_boundaries hcompA_nonempty hcompB_nonempty x hxR + obtain ⟨hca, hcb, hco⟩ := endpoint_boundaries x hxR + obtain ⟨jA, hjA⟩ := boundary_incident _ x hcompA_nonempty hca + obtain ⟨jB, hjB⟩ := boundary_incident _ x hcompB_nonempty hcb + obtain ⟨jO, hjO⟩ := raw_incident cert.O x hO + (boundary_footprint cert.O x hO hco) + have hAcell : LatticeVertexIncidentCell x jA ∈ (cert.P 0 true).cells := by + exact (Finset.mem_sdiff.mp hjA).1 + have hBcell : LatticeVertexIncidentCell x jB ∈ (cert.P 0 false).cells := by + exact (Finset.mem_sdiff.mp hjB).1 + have hA_missing : LatticeVertexIncidentCell x jB ∉ (cert.P 0 true).cells := by + intro hc + have hi := Finset.mem_inter.mpr ⟨hc, hBcell⟩ + rw [hpair] at hi + exact (Finset.mem_sdiff.mp hjB).2 hi + exact P3161T2IncidentBoundary _ x ⟨jA, hAcell⟩ ⟨jB, hA_missing⟩ + +private theorem hboundaryB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ((cert.P (0 : Fin (3 : ℕ)) + true).cells ∩ (cert.P (0 : Fin (3 : ℕ)) false).cells = cert.O.cells) → ((∀ (U : + ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices + U) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells))) → ((∀ (x : + GaussianInt), (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + GaussianInt)) → (x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 true) + cert.O) ∧ x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 false) cert.O) + ∧ x ∈ BoundaryFootprintVertices cert.O)) → (((TileCellComplement (cert.P 0 true) + cert.O).cells.Nonempty) → (((TileCellComplement (cert.P 0 false) + cert.O).cells.Nonempty) → (∀ (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, + cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices + (cert.P 0 false))))))) ) := by + classical + intro C q cfg T cert hpair boundary_incident endpoint_boundaries hcompA_nonempty + hcompB_nonempty x hxR + obtain ⟨hca, hcb, hco⟩ := endpoint_boundaries x hxR + obtain ⟨jA, hjA⟩ := boundary_incident _ x hcompA_nonempty hca + obtain ⟨jB, hjB⟩ := boundary_incident _ x hcompB_nonempty hcb + have hAcell : LatticeVertexIncidentCell x jA ∈ (cert.P 0 true).cells := + (Finset.mem_sdiff.mp hjA).1 + have hBcell : LatticeVertexIncidentCell x jB ∈ (cert.P 0 false).cells := + (Finset.mem_sdiff.mp hjB).1 + have hB_missing : LatticeVertexIncidentCell x jA ∉ (cert.P 0 false).cells := by + intro hc + have hi := Finset.mem_inter.mpr ⟨hAcell, hc⟩ + rw [hpair] at hi + exact (Finset.mem_sdiff.mp hjA).2 hi + exact P3161T2IncidentBoundary _ x ⟨jB, hBcell⟩ ⟨jA, hB_missing⟩ + +private theorem other_absent : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (Finset.Nonempty cert.O.cells) → ((∀ + (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), (i, s) ≠ (j, t) → + ¬(i = (0 : Fin (3 : ℕ)) ∧ j = (0 : Fin (3 : ℕ))) → Disjoint (cert.P i s).cells + (cert.P j t).cells) → ((∀ (x : GaussianInt), (x ∈ FootprintVertices cert.O) → (∀ j : + Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ + LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells)) → ((∀ (U : ProtoTile), ∀ (x + : GaussianInt), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → (x ∈ + FootprintVertices U))) → ((∀ (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, + cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices + (TileCellComplement (cert.P 0 true) cert.O) ∧ x ∈ BoundaryFootprintVertices + (TileCellComplement (cert.P 0 false) cert.O) ∧ x ∈ BoundaryFootprintVertices cert.O)) + → (∀ (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} + : Finset GaussianInt)) → (∀ (i : Fin 3), ∀ (s : Bool), (i ≠ 0) → (∀ (j : Fin 4), + LatticeVertexIncidentCell x j ∉ (cert.P i s).cells))))))) ) := by + classical + intro C q cfg T cert hO hdisjoint hallAB boundary_footprint endpoint_boundaries x hxR i s hi j hc + obtain ⟨_, _, hco⟩ := endpoint_boundaries x hxR + rcases hallAB x (boundary_footprint cert.O x hO hco) j with hA | hB + · exact Finset.disjoint_left.mp + (hdisjoint i s 0 true (fun he => hi (congrArg Prod.fst he)) + (fun he => hi he.1)) hc hA + · exact Finset.disjoint_left.mp + (hdisjoint i s 0 false (fun he => hi (congrArg Prod.fst he)) + (fun he => hi he.1)) hc hB + +private theorem hboundary : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (∀ (U : ProtoTile), ∀ (x : + GaussianInt), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ U.cells))) → ((∀ (x : GaussianInt), (x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ + BoundaryFootprintVertices (cert.P 0 true))) → ((∀ (x : GaussianInt), (x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ + BoundaryFootprintVertices (cert.P 0 false))) → ((∀ (x : GaussianInt), (x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (∀ + (i : Fin 3), ∀ (s : Bool), (i ≠ 0) → (∀ (j : Fin 4), LatticeVertexIncidentCell x j ∉ + (cert.P i s).cells))) → (∀ (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, + cert.precursor_boundary.b} : Finset GaussianInt)) → (∀ (i : Fin 3), ∀ (s : Bool), x ∈ + BoundaryFootprintVertices (cert.P i s) ↔ i = 0))))) ) := by + classical + intro C q cfg T cert boundary_incident hboundaryA hboundaryB other_absent x hxR i s + by_cases hi : i = 0 + · subst i + cases s + · exact ⟨fun _ => rfl, fun _ => hboundaryB x hxR⟩ + · exact ⟨fun _ => rfl, fun _ => hboundaryA x hxR⟩ + · refine ⟨fun hb => ?_, fun he => (hi he).elim⟩ + obtain ⟨j, hj⟩ := boundary_incident _ x + (LatticeTileGridStructure _ (cert.parent_lattice i s)).1.1 hb + exact (other_absent x hxR i s hi j hj).elim + +private theorem endpoint_inD : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), + (Finset.Nonempty cert.O.cells) → ((∀ (x : GaussianInt), (x ∈ FootprintVertices + cert.O) → (x ∈ D)) → ((∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → + ((x ∈ BoundaryFootprintVertices U) → (x ∈ FootprintVertices U))) → ((∀ (x : + GaussianInt), (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + GaussianInt)) → (x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 true) + cert.O) ∧ x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 false) cert.O) + ∧ x ∈ BoundaryFootprintVertices cert.O)) → (∀ (x : GaussianInt), (x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ + D))))) ) := by + classical + intro C q cfg T cert D hO inD boundary_footprint endpoint_boundaries x hxR + exact inD x (boundary_footprint cert.O x hO (endpoint_boundaries x hxR).2.2) + +private theorem endpoint_notP : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : + Finset GaussianInt), (∀ (x : GaussianInt), x ∈ P ↔ x ∈ D ∧ ∃ (i : Fin (3 : ℕ)) (s : + Bool), x ∈ FootprintVertices (cert.P i s) ∧ x ∉ BoundaryFootprintVertices (cert.P i + s)) → ((∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ + FootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells))) → ((∀ + (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + Finset GaussianInt)) → (∀ (i : Fin 3), ∀ (s : Bool), (i ≠ 0) → (∀ (j : Fin 4), + LatticeVertexIncidentCell x j ∉ (cert.P i s).cells))) → ((∀ (x : GaussianInt), (x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (∀ + (i : Fin 3), ∀ (s : Bool), x ∈ BoundaryFootprintVertices (cert.P i s) ↔ i = 0)) → (∀ + (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + Finset GaussianInt)) → (x ∉ P))))) ) := by + classical + intro C q cfg T cert D P hP raw_incident other_absent hboundary x hxR hp + obtain ⟨_, i, s, hfoot, hnotb⟩ := (hP x).mp hp + by_cases hi : i = 0 + · exact hnotb ((hboundary x hxR i s).mpr hi) + · obtain ⟨j, hj⟩ := raw_incident _ x + (LatticeTileGridStructure _ (cert.parent_lattice i s)).1.1 hfoot + exact (other_absent x hxR i s hi j hj).elim + +private theorem hRsubset : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : + Finset GaussianInt), (∀ (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, + cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ D)) → ((∀ (x : GaussianInt), + (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → + (x ∉ P)) → (({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + GaussianInt) ⊆ D \ P)) ) := by + classical + intro C q cfg T cert D P endpoint_inD endpoint_notP x hx + exact Finset.mem_sdiff.mpr ⟨endpoint_inD x hx, endpoint_notP x hx⟩ + +private theorem hWfoot : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : + Finset GaussianInt), (∀ (x : GaussianInt), x ∈ P ↔ x ∈ D ∧ ∃ (i : Fin (3 : ℕ)) (s : + Bool), x ∈ FootprintVertices (cert.P i s) ∧ x ∉ BoundaryFootprintVertices (cert.P i + s)) → ((Finset.Nonempty cert.O.cells) → ((∀ (U : ProtoTile), ∀ (x : GaussianInt), + (U.cells.Nonempty) → ((x ∈ FootprintVertices U) → (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ U.cells))) → ((∀ (U : ProtoTile), ∀ (x : + GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells) → (x ∉ + BoundaryFootprintVertices U)) → ((∀ (x : GaussianInt), (x ∈ FootprintVertices cert.O) + → (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ + LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells)) → ((cert.O.cells ⊆ (cert.P 0 + true).cells) → ((cert.O.cells ⊆ (cert.P 0 false).cells) → ((∀ (U : ProtoTile), ∀ (x : + GaussianInt), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → (x ∈ + FootprintVertices U))) → (∀ (plusArc : List GaussianInt), ∀ (minusArc : List + GaussianInt), ((↑plusArc.toFinset : Set GaussianInt) = BoundaryFootprintVertices + (TileCellComplement (cert.P (0 : Fin (3 : ℕ)) true) cert.O) ∩ + BoundaryFootprintVertices cert.O) → (((↑minusArc.toFinset : Set GaussianInt) = + BoundaryFootprintVertices (TileCellComplement (cert.P (0 : Fin (3 : ℕ)) false) + cert.O) ∩ BoundaryFootprintVertices cert.O) → ((BoundaryFootprintVertices cert.O = + (↑plusArc.toFinset : Set GaussianInt) ∪ (↑minusArc.toFinset : Set GaussianInt)) → + (((↑plusArc.toFinset : Set GaussianInt) ∩ (↑minusArc.toFinset : Set GaussianInt) = + {cert.precursor_boundary.a, cert.precursor_boundary.b}) → ((∀ (x : GaussianInt), x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt) ↔ x = + cert.precursor_boundary.a ∨ x = cert.precursor_boundary.b) → ((∀ (x : GaussianInt), + (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → + (x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∧ x ∈ + BoundaryFootprintVertices (TileCellComplement (cert.P 0 false) cert.O) ∧ x ∈ + BoundaryFootprintVertices cert.O)) → (∀ x ∈ D \ P, x ∈ FootprintVertices cert.O ↔ x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + GaussianInt))))))))))))))) ) := by + classical + intro C q cfg T cert D P hP hO raw_incident full_nonboundary hallAB hOA hOB boundary_footprint + plusArc minusArc hplusSet hminusSet hunion hinter hR endpoint_boundaries x hxW + have hxD : x ∈ D := (Finset.mem_sdiff.mp hxW).1 + have hxnotP : x ∉ P := (Finset.mem_sdiff.mp hxW).2 + constructor + · intro hxO + have hxOB : x ∈ BoundaryFootprintVertices cert.O := by + by_contra hnotb + obtain ⟨j0, hj0⟩ := raw_incident cert.O x hO hxO + have hallO : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ cert.O.cells := by + intro j + by_contra hj + have hb := P3161T2IncidentBoundary cert.O x ⟨j0, hj0⟩ ⟨j, hj⟩ + exact hnotb hb + have hAinterior : x ∉ BoundaryFootprintVertices (cert.P 0 true) := + full_nonboundary (cert.P 0 true) x (fun j => hOA (hallO j)) + have hAfoot : x ∈ FootprintVertices (cert.P 0 true) := by + rw [FootprintVertices, ite_eq_left ⟨x, hOA (hallO 0)⟩] + exact ⟨x, hOA (hallO 0), Or.inl rfl⟩ + exact hxnotP ((hP x).mpr ⟨hxD, 0, true, hAfoot, hAinterior⟩) + have hxArcs : x ∈ (plusArc.toFinset : Set GaussianInt) ∨ + x ∈ (minusArc.toFinset : Set GaussianInt) := by + have hh := hunion + rw [hh] at hxOB + exact hxOB + rcases hxArcs with hxplus | hxminus + · by_cases hxR : x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt) + · exact hxR + · have hxnotA : x ≠ cert.precursor_boundary.a ∧ + x ≠ cert.precursor_boundary.b := by + simpa [hR] using hxR + have noBcomp (j : Fin 4) : + LatticeVertexIncidentCell x j ∉ + (TileCellComplement (cert.P 0 false) cert.O).cells := by + intro hj + obtain ⟨k, hk⟩ := raw_incident cert.O x hO hxO + have hmiss : LatticeVertexIncidentCell x k ∉ + (TileCellComplement (cert.P 0 false) cert.O).cells := by + change LatticeVertexIncidentCell x k ∉ + (cert.P 0 false).cells \ cert.O.cells + simp [hk] + have hbcomp := P3161T2IncidentBoundary _ x ⟨j, hj⟩ ⟨k, hmiss⟩ + have hxminus : x ∈ (minusArc.toFinset : Set GaussianInt) := by + rw [hminusSet] + exact ⟨hbcomp, hxOB⟩ + have hboth : x ∈ + (plusArc.toFinset : Set GaussianInt) ∩ + (minusArc.toFinset : Set GaussianInt) := + ⟨hxplus, hxminus⟩ + rw [hinter] at hboth + rcases hboth with he | he + · exact hxnotA.1 he + · exact hxnotA.2 he + have hallA : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + (cert.P 0 true).cells := by + intro j + rcases hallAB x hxO j with hA | hB + · exact hA + · by_cases hOcell : LatticeVertexIncidentCell x j ∈ cert.O.cells + · exact hOA hOcell + · have : LatticeVertexIncidentCell x j ∈ + (TileCellComplement (cert.P 0 false) cert.O).cells := by + change LatticeVertexIncidentCell x j ∈ + (cert.P 0 false).cells \ cert.O.cells + exact Finset.mem_sdiff.mpr ⟨hB, hOcell⟩ + exact (noBcomp j this).elim + have hAfoot : x ∈ FootprintVertices (cert.P 0 true) := by + rw [FootprintVertices, ite_eq_left ⟨x, hallA 0⟩] + exact ⟨x, hallA 0, Or.inl rfl⟩ + have hAnotb := full_nonboundary (cert.P 0 true) x hallA + exact (hxnotP ((hP x).mpr ⟨hxD, 0, true, hAfoot, hAnotb⟩)).elim + · by_cases hxR : x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt) + · exact hxR + · have hxnotA : x ≠ cert.precursor_boundary.a ∧ + x ≠ cert.precursor_boundary.b := by + simpa [hR] using hxR + have noAcomp (j : Fin 4) : + LatticeVertexIncidentCell x j ∉ + (TileCellComplement (cert.P 0 true) cert.O).cells := by + intro hj + obtain ⟨k, hk⟩ := raw_incident cert.O x hO hxO + have hmiss : LatticeVertexIncidentCell x k ∉ + (TileCellComplement (cert.P 0 true) cert.O).cells := by + change LatticeVertexIncidentCell x k ∉ + (cert.P 0 true).cells \ cert.O.cells + simp [hk] + have hacomp := P3161T2IncidentBoundary _ x ⟨j, hj⟩ ⟨k, hmiss⟩ + have hxplus : x ∈ (plusArc.toFinset : Set GaussianInt) := by + rw [hplusSet] + exact ⟨hacomp, hxOB⟩ + have hboth : x ∈ + (plusArc.toFinset : Set GaussianInt) ∩ + (minusArc.toFinset : Set GaussianInt) := + ⟨hxplus, hxminus⟩ + rw [hinter] at hboth + rcases hboth with he | he + · exact hxnotA.1 he + · exact hxnotA.2 he + have hallB : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + (cert.P 0 false).cells := by + intro j + rcases hallAB x hxO j with hA | hB + · by_cases hOcell : LatticeVertexIncidentCell x j ∈ cert.O.cells + · exact hOB hOcell + · have : LatticeVertexIncidentCell x j ∈ + (TileCellComplement (cert.P 0 true) cert.O).cells := by + change LatticeVertexIncidentCell x j ∈ + (cert.P 0 true).cells \ cert.O.cells + exact Finset.mem_sdiff.mpr ⟨hA, hOcell⟩ + exact (noAcomp j this).elim + · exact hB + have hBfoot : x ∈ FootprintVertices (cert.P 0 false) := by + rw [FootprintVertices, ite_eq_left ⟨x, hallB 0⟩] + exact ⟨x, hallB 0, Or.inl rfl⟩ + have hBnotb := full_nonboundary (cert.P 0 false) x hallB + exact (hxnotP ((hP x).mpr ⟨hxD, 0, false, hBfoot, hBnotb⟩)).elim + · intro hxR + exact boundary_footprint cert.O x hO (endpoint_boundaries x hxR).2.2 + +private theorem hcount : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (∀ (x : GaussianInt), (x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (∀ + (i : Fin 3), ∀ (s : Bool), x ∈ BoundaryFootprintVertices (cert.P i s) ↔ i = 0)) → (∀ + (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + Finset GaussianInt)) → (Nat.card + {is : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2)) ) := by + classical + intro C q cfg T cert hboundary x hxR + let e : {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} ≃ Bool := + { toFun := fun z => z.val.2 + invFun := fun s => ⟨(0, s), (hboundary x hxR 0 s).mpr rfl⟩ + left_inv := by + intro z + apply Subtype.ext + apply Prod.ext + · exact ((hboundary x hxR z.val.1 z.val.2).mp z.property).symm + · rfl + right_inv := fun _ => rfl } + rw [Nat.card_congr e] + simp + +private theorem hnoncentral : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (LatticeTile T) → (∀ (D : Finset + GaussianInt), (∀ (x : GaussianInt), x ∈ D ↔ x ∈ FootprintVertices T ∧ x ∉ + BoundaryFootprintVertices T) → ((Finset.Nonempty cert.O.cells) → ((cert.O.cells = ∅ ↔ + (cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → ((∀ (x : GaussianInt), (x ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ + D)) → ((∀ (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, + cert.precursor_boundary.b} : Finset GaussianInt)) → (Nat.card + {is : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2)) → (∀ (x + : GaussianInt), (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + GaussianInt)) → (GaussianRealPoint x ≠ TileCentroid T))))))) ) := by + classical + intro C q cfg T cert hlat D hD hO hzero endpoint_inD hcount x hxR + have hxT : x ∈ FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T := + (hD x).mp (endpoint_inD x hxR) + intro hcentral + have hzeroCurv := (BandOrderedGeneralInteriorStarClassification + q cfg C T cert hlat x hxT.1 hxT.2).2.2.2 (hcount x hxR) hcentral + exact ((Finset.nonempty_iff_ne_empty.mp hO) (hzero.mpr hzeroCurv)) + +end PositivePrecursorGeometry + +theorem P4339T1PositivePrecursorRoots + (C : BandCircle) (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (hlat : LatticeTile T) + (D P : Finset GaussianInt) + (hD : ∀ x, x ∈ D ↔ + x ∈ FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T) + (hP : ∀ x, x ∈ P ↔ x ∈ D ∧ ∃ i s, + x ∈ FootprintVertices (cert.P i s) ∧ + x ∉ BoundaryFootprintVertices (cert.P i s)) + (hO : cert.O.cells.Nonempty) : + let W := D \ P + let R : Finset GaussianInt := {cert.precursor_boundary.a, cert.precursor_boundary.b} + R ⊆ W ∧ + (∀ x ∈ W, x ∈ FootprintVertices cert.O ↔ x ∈ R) ∧ + (∀ x ∈ R, + Nat.card {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2 ∧ + GaussianRealPoint x ≠ TileCentroid T) := by +-- BODY + classical + dsimp only + obtain ⟨hcent, hzero, _, hOlattice, _, _, hpair, hdisjoint⟩ := + P4339T1PrecursorSupportGeometry C q cfg T cert + have hAcomp := cert.precursor_complement_lattice.1 + have hBcomp := cert.precursor_complement_lattice.2 + have raw_incident := PositivePrecursorGeometry.raw_incident + have boundary_incident := PositivePrecursorGeometry.boundary_incident + have full_nonboundary := PositivePrecursorGeometry.full_nonboundary C q cfg T cert hO hzero + hOlattice + have hallAB := PositivePrecursorGeometry.hallAB C q cfg T cert + (PositivePrecursorGeometry.trans_zero (PositivePrecursorGeometry.htrans0)) + have inD := PositivePrecursorGeometry.inD C q cfg T cert D hD full_nonboundary + (PositivePrecursorGeometry.hallT C q cfg T cert hallAB) + have hOA := PositivePrecursorGeometry.hOA C q cfg T cert + have hOB := PositivePrecursorGeometry.hOB C q cfg T cert + have boundary_footprint := PositivePrecursorGeometry.boundary_footprint boundary_incident + (PositivePrecursorGeometry.incident_footprint) + have hbranch := cert.precursor_boundary.branch + rcases hbranch with ⟨_, plusArc, minusArc, _, _, hplusHead, hplusLast, + hminusHead, hminusLast, hplusSet, hminusSet, _, _, hunion, hinter, _, _⟩ | hdeg + · have haPlus := PositivePrecursorGeometry.haPlus C q cfg T cert plusArc hplusHead + have hR := PositivePrecursorGeometry.hR C q cfg T cert + have endpoint_boundaries := PositivePrecursorGeometry.endpoint_boundaries C q cfg T cert + plusArc minusArc haPlus (PositivePrecursorGeometry.hbPlus C q cfg T cert plusArc + hplusLast) (PositivePrecursorGeometry.hbMinus C q cfg T cert minusArc hminusHead) + (PositivePrecursorGeometry.haMinus C q cfg T cert minusArc hminusLast) + (PositivePrecursorGeometry.arcPlus C q cfg T cert plusArc hplusSet) + (PositivePrecursorGeometry.arcMinus C q cfg T cert minusArc hminusSet) hR + have hcompA_nonempty : (TileCellComplement (cert.P 0 true) cert.O).cells.Nonempty := + (LatticeTileGridStructure _ hAcomp).1.1 + have hcompB_nonempty : (TileCellComplement (cert.P 0 false) cert.O).cells.Nonempty := + (LatticeTileGridStructure _ hBcomp).1.1 + have other_absent := PositivePrecursorGeometry.other_absent C q cfg T cert hO hdisjoint + hallAB boundary_footprint endpoint_boundaries + have hboundary := PositivePrecursorGeometry.hboundary C q cfg T cert boundary_incident + (PositivePrecursorGeometry.hboundaryA C q cfg T cert hO hpair raw_incident + boundary_incident boundary_footprint endpoint_boundaries hcompA_nonempty hcompB_nonempty) + (PositivePrecursorGeometry.hboundaryB C q cfg T cert hpair boundary_incident + endpoint_boundaries hcompA_nonempty hcompB_nonempty) other_absent + have endpoint_inD := PositivePrecursorGeometry.endpoint_inD C q cfg T cert D hO inD + boundary_footprint endpoint_boundaries + have hcount := PositivePrecursorGeometry.hcount C q cfg T cert hboundary + refine ⟨(PositivePrecursorGeometry.hRsubset C q cfg T cert D P endpoint_inD + (PositivePrecursorGeometry.endpoint_notP C q cfg T cert D P hP raw_incident other_absent + hboundary)), (PositivePrecursorGeometry.hWfoot C q cfg T cert D P hP hO raw_incident + full_nonboundary hallAB hOA hOB boundary_footprint plusArc minusArc hplusSet hminusSet + hunion hinter hR endpoint_boundaries), ?_⟩ + intro x hxR + exact ⟨hcount x hxR, (PositivePrecursorGeometry.hnoncentral C q cfg T cert hlat D hD hO hzero + endpoint_inD hcount) x hxR⟩ + · exact False.elim ((Finset.nonempty_iff_ne_empty.mp hO) hdeg.1) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4339T1PrecursorArcSeparation.lean b/LeanPool/ApollonianSuperharmonic/P4339T1PrecursorArcSeparation.lean new file mode 100644 index 0000000000..f64217b719 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4339T1PrecursorArcSeparation.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell +public import LeanPool.ApollonianSuperharmonic.TopologicalDiskGridRayCrossingIndexZero +public import LeanPool.ApollonianSuperharmonic.P4366T1RemainderOuterAttachments +public import LeanPool.ApollonianSuperharmonic.P4366T1PrecursorPathLoop +public import LeanPool.ApollonianSuperharmonic.P4366T1AttachedRemainderIndexZero + +-- [TABLET NODE: P4339T1PrecursorArcSeparation] + +/-! +# P4339T1PrecursorArcSeparation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4339T1PrecursorArcSeparation : + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (BandPrototile (q 0) T) → ((LatticeTile + T) → (∀ (D : Finset GaussianInt), ∀ (P : Finset GaussianInt), (∀ x, x ∈ D ↔ + x ∈ FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T) → ((∀ x, x ∈ P ↔ x ∈ D ∧ ∃ i s, + x ∈ FootprintVertices (cert.P i s) ∧ + x ∉ BoundaryFootprintVertices (cert.P i s)) → ((∀ i, ∀ s, ∃ e : Finset GaussianInt, + e ∈ BoundaryFootprintEdges (cert.P i s) ∧ + e ∈ BoundaryFootprintEdges T) → ((cert.O.cells.Nonempty) → ((∀ x ∈ D \ P, + x ∈ FootprintVertices cert.O ↔ + x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + Finset GaussianInt)) → ( + let W := D \ P + let R : Finset GaussianInt := {cert.precursor_boundary.a, cert.precursor_boundary.b} + ∀ a ∈ R, ∀ b ∈ R, ∀ V, ∀ E, SimpleGridPathBetween V E a b → V ⊆ (W : Set GaussianInt) → a = + b))))))) := by + intro C q cfg T cert hT hlat D P hD hP hattach hO hroots +-- BODY + classical + dsimp only + intro a ha b hb V E hpath hV + by_contra hab + have hsupport := P4339T1PrecursorSupportGeometry C q cfg T cert + obtain ⟨hFdisk, hcover, hFattach⟩ := + P4366T1RemainderOuterAttachments C q cfg T cert hO (hsupport.2.2.2.1 hO) hattach + obtain ⟨p, x, y, hnodup, hlen, hhead, hlast, hadj, hclose, + hsegments, havoid, hnoncross, z, hcross⟩ := + P4366T1PrecursorPathLoop C q cfg T cert D P hD hP hO hsupport.2.2.1 + hroots a b ha hb hab V E hpath hV + have adjacent_mem_zip (u v : GaussianInt) (l₁ l₂ : List GaussianInt) : + (u, v) ∈ (l₁ ++ u :: v :: l₂).zip (l₁ ++ u :: v :: l₂).tail := by + induction l₁ with + | nil => simp + | cons c l ih => + cases l with + | nil => simp + | cons d l => + simp only [List.cons_append, List.tail_cons, List.zip_cons_cons, + List.mem_cons] + exact Or.inr ih + have houtside (c : GaussianInt) (hc : c ∉ T.cells) : + GridRayCrossingIndex c p = 0 := by + have hcenter : ((c.re : Real) + (1 / 2 : Real), + (c.im : Real) + (1 / 2 : Real)) ∉ TileRealization T := by + intro hm + simp only [TileRealization, Set.mem_iUnion] at hm + obtain ⟨d, hd, hsquare⟩ := hm + change ((d.re : Real) ≤ (c.re : Real) + 1 / 2 ∧ + (d.im : Real) ≤ (c.im : Real) + 1 / 2) ∧ + ((c.re : Real) + 1 / 2 ≤ (d.re : Real) + 1 ∧ + (c.im : Real) + 1 / 2 ≤ (d.im : Real) + 1) at hsquare + have hr₁ : d.re < c.re + 1 := by + have : (d.re : Real) < ((c.re + 1 : Int) : Real) := by + push_cast + linarith [hsquare.1.1] + exact_mod_cast this + have hr₂ : c.re < d.re + 1 := by + have : (c.re : Real) < ((d.re + 1 : Int) : Real) := by + push_cast + linarith [hsquare.2.1] + exact_mod_cast this + have hi₁ : d.im < c.im + 1 := by + have : (d.im : Real) < ((c.im + 1 : Int) : Real) := by + push_cast + linarith [hsquare.1.2] + exact_mod_cast this + have hi₂ : c.im < d.im + 1 := by + have : (c.im : Real) < ((d.im + 1 : Int) : Real) := by + push_cast + linarith [hsquare.2.2] + exact_mod_cast this + have hdc : d = c := Zsqrtd.ext (by omega) (by omega) + exact hc (hdc ▸ hd) + apply TopologicalDiskGridRayCrossingIndexZero (TileRealization T) hlat c hcenter + p x y hhead hlast ?_ hclose ?_ + · intro u v l₁ l₂ heq + apply hadj u v + rw [heq] + exact adjacent_mem_zip u v l₁ l₂ + · intro u v huv t + apply hsegments u v ?_ t + rcases huv with ⟨l₁, l₂, heq⟩ | huv + · left + rw [heq] + exact adjacent_mem_zip u v l₁ l₂ + · exact Or.inr huv + have hinside : ∀ i s, + (P4366T1PrecursorRemainderFamily cert.P cert.O i s).cells ⊆ T.cells := by + intro i s c hc + exact ((hcover c).mpr ⟨i, s, hc⟩).1 + have hzero := P4366T1AttachedRemainderIndexZero T + (P4366T1PrecursorRemainderFamily cert.P cert.O) hFdisk hinside hFattach + p x y hhead hlast hnodup hlen hadj hclose havoid hnoncross houtside + have hremaining (c : GaussianInt) (hc : c ∈ T.cells ∧ c ∉ cert.O.cells) : + GridRayCrossingIndex c p = 0 := by + obtain ⟨i, s, hi⟩ := (hcover c).mp hc + exact hzero i s c hi + have hjump := GridRayCrossingIndexAdjacentCell p x y hhead hlast hnodup hlen + hadj hclose z + rcases hcross with ⟨hz, hz', hedge⟩ | ⟨hz, hz', hedge⟩ + · have hunit := hjump.2.1 hedge + rw [hremaining z hz, hremaining (z + 1) hz'] at hunit + norm_num at hunit + · have hunit := hjump.2.2.2 hedge + rw [hremaining z hz, hremaining (z + ⟨0, 1⟩) hz'] at hunit + norm_num at hunit + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4339T1PrecursorSupportGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4339T1PrecursorSupportGeometry.lean new file mode 100644 index 0000000000..3c3529afb6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4339T1PrecursorSupportGeometry.lean @@ -0,0 +1,174 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.CurvatureOneTileBase +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance + +-- [TABLET NODE: P4339T1PrecursorSupportGeometry] + +/-! +# P4339T1PrecursorSupportGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4339T1PrecursorSupportGeometry + (C : BandCircle) (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) : + TileCentroid cert.O = TileCentroid T ∧ + (cert.O.cells = ∅ ↔ (cfg.firstPredecessor 1).1 = 0) ∧ + BandPrototile (cfg.firstPredecessor 1) cert.O ∧ + (cert.O.cells.Nonempty → LatticeTile cert.O) ∧ + (cert.Q 1 true).cells.Nonempty ∧ + (cert.S 2 false).cells.Nonempty ∧ + (cert.P 0 true).cells ∩ (cert.P 0 false).cells = cert.O.cells ∧ + (∀ (i : Fin 3) (s : Bool) (j : Fin 3) (t : Bool), + (i, s) ≠ (j, t) → ¬ (i = 0 ∧ j = 0) → + Disjoint (cert.P i s).cells (cert.P j t).cells) := by +-- BODY + classical + have hband : BandPrototile (cfg.firstPredecessor 1) cert.O := by + rw [cert.precursor_eq] + exact (cert.plus_occurrence 0 false).1 + have hOA : cert.O.cells ⊆ (cert.P 0 true).cells := by + intro z hz + apply (cert.plus_union z).mpr + exact ⟨0, false, by simpa only [← cert.precursor_eq] using hz⟩ + have hOB : cert.O.cells ⊆ (cert.P 0 false).cells := by + intro z hz + exact (cert.minus_union z).mpr ⟨0, true, by rw [← cert.precursor_cells]; exact hz⟩ + have hseparate := BandOriginalPairSeparation + cert.P cert.O cert.u cert.v hOA hOB cert.partition + have htranslation_zero : GaussianTranslation 0 = id := by + funext z + exact add_zero z + have hpair : (cert.P 0 true).cells ∩ (cert.P 0 false).cells = cert.O.cells := by + simpa [SubtileOccurrenceInterpretation, TileTranslation, htranslation_zero] + using hseparate.1 0 0 + have hcentroid : TileCentroid cert.O = TileCentroid T := by + have hsame : TileCentroid cert.O = TileCentroid (cert.S 0 true) := by + simp only [TileCentroid, ← cert.precursor_cells] + split_ifs with hn + · rfl + · rw [cert.precursor_anchor (Finset.not_nonempty_iff_eq_empty.mp hn)] + have hp := (cert.outer_occurrence 0 true).2.2 + have hm := (cert.outer_occurrence 0 false).2.2 + have hnp := (cert.minus_occurrence 0 true).2.2 + have hnm := (cert.plus_occurrence 0 false).2.2 + rw [← cert.precursor_eq] at hnm + rw [← hsame] at hnp + simp only [Bool.false_eq_true, ↓reduceIte, one_smul, neg_one_smul] at hp hm hnp hnm + apply Prod.ext + · have a := congrArg Prod.fst hp + have b := congrArg Prod.fst hm + have c := congrArg Prod.fst hnp + have d := congrArg Prod.fst hnm + simp only [Prod.fst_sub, Prod.fst_neg] at a b c d + linarith + · have a := congrArg Prod.snd hp + have b := congrArg Prod.snd hm + have c := congrArg Prod.snd hnp + have d := congrArg Prod.snd hnm + simp only [Prod.snd_sub, Prod.snd_neg] at a b c d + linarith + have zero_empty (d : CircleCoordinates) (U : ProtoTile) + (hb : BandPrototile d U) (hz : d.1 = 0) : U.cells = ∅ := by + cases hb with + | line => rfl + | unit => norm_num at hz + | decompose hp _ _ _ _ => + have hpos := (ProperBandCurvatureStructure _ hp).1 + omega + have positive_nonempty (d : CircleCoordinates) (U : ProtoTile) + (hb : BandPrototile d U) (hpos : 0 < d.1) : U.cells.Nonempty := by + cases hb with + | line => norm_num at hpos + | unit => exact Finset.singleton_nonempty _ + | @decompose p hp S V hS hc hf ht => + exact (LatticeTileGridStructure U (BandTileSimultaneousInduction p hp U + (BandPrototile.decompose hp hS hc hf ht)).1).1.1 + have hzero : cert.O.cells = ∅ ↔ (cfg.firstPredecessor 1).1 = 0 := + ⟨cert.precursor_zero_curvature, zero_empty _ _ hband⟩ + have hdisk : cert.O.cells.Nonempty → LatticeTile cert.O := by + have nonempty_disk (d : CircleCoordinates) (U : ProtoTile) + (hb : BandPrototile d U) + (hancestry : ∃ p : Fin 4 → CircleCoordinates, + SemiProperQuadruple p ∧ ∃ j : Fin 4, p j = d) + (hn : U.cells.Nonempty) : LatticeTile U := by + cases hb with + | line => simp at hn + | unit z x anchor => + let B : BandCircle := + ⟨⟨(1, 1 + 2 * z), ⟨Or.inl (by norm_num), hancestry⟩⟩, by norm_num⟩ + obtain ⟨V, hV, harea, _⟩ := CurvatureOneTileBase B rfl + obtain ⟨y, hy⟩ := Finset.card_eq_one.mp harea + have ht := (TileDiskAreaCovariance V (x - y)).1.mp hV + have hcells : (TileTranslation V (x - y)).cells = {x} := by + rw [(TileTranslationFormulas V (x - y)).1, hy] + simp [GaussianTranslation] + change TopologicalDisk (TileRealization _) at ht ⊢ + simpa only [TileRealization, hcells] using ht + | @decompose p hp S V hS hc hf ht => + exact (BandTileSimultaneousInduction p hp U + (BandPrototile.decompose hp hS hc hf ht)).1 + exact nonempty_disk _ _ hband + ⟨cfg.firstPredecessor, cfg.firstProper.1, 1, rfl⟩ + have hQ : (cert.Q 1 true).cells.Nonempty := by + apply positive_nonempty _ _ (cert.plus_occurrence 1 true).1 + change 0 < (cfg.firstPredecessor 2).1 + rw [cfg.firstParentTwo] + have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 1 + change 0 ≤ (q 2).1 at hn + have hz := cfg.noLine 2 + change 0 < (q 2).1 + omega + have hS : (cert.S 2 false).cells.Nonempty := by + apply positive_nonempty _ _ (cert.minus_occurrence 2 false).1 + change 0 < (cfg.firstPredecessor 3).1 + rw [cfg.firstParentThree] + have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 2 + change 0 ≤ (q 3).1 at hn + have hz := cfg.noLine 3 + change 0 < (q 3).1 + omega + refine ⟨hcentroid, hzero, hband, hdisk, hQ, hS, hpair, ?_⟩ + let idx (i : Fin 3) (s : Bool) : PeriodicSubtileIndex := + ⟨if i = 0 then (if s then .A else .B) + else if i = 1 then (if s then .C else .D) + else (if s then .E else .F), 0, 0⟩ + have idx_cells (i : Fin 3) (s : Bool) : + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (idx i s)).cells = + (cert.P i s).cells := by + fin_cases i <;> cases s <;> + simp [idx, SubtileOccurrenceInterpretation, TileTranslation, htranslation_zero] + intro i s j t hne hnot + have hidx : idx i s ≠ idx j t := by + clear * - i s j t hne idx + intro he + apply hne + fin_cases i <;> cases s <;> fin_cases j <;> cases t <;> simp_all [idx] + have hnopair : ¬ (((idx i s).label = .A ∧ (idx j t).label = .B ∨ + (idx i s).label = .B ∧ (idx j t).label = .A) ∧ + (idx i s).first = (idx j t).first ∧ + (idx i s).second = (idx j t).second) := by + clear * - i s j t hnot idx + fin_cases i <;> cases s <;> fin_cases j <;> cases t <;> simp_all [idx] + simpa only [idx_cells] using hseparate.2 (idx i s) (idx j t) hidx hnopair + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4366T1AttachedRemainderIndexZero.lean b/LeanPool/ApollonianSuperharmonic/P4366T1AttachedRemainderIndexZero.lean new file mode 100644 index 0000000000..6bc945dd84 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4366T1AttachedRemainderIndexZero.lean @@ -0,0 +1,220 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure + +-- [TABLET NODE: P4366T1AttachedRemainderIndexZero] + +/-! +# P4366T1AttachedRemainderIndexZero + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4366T1AttachedRemainderIndexZero + (T : ProtoTile) (F : Fin 3 → Bool → ProtoTile) + (hF : ∀ i s, LatticeTile (F i s)) + (hinside : ∀ i s, (F i s).cells ⊆ T.cells) + (hattach : ∀ i s, ∃ e : Finset GaussianInt, + e ∈ BoundaryFootprintEdges (F i s) ∧ e ∈ BoundaryFootprintEdges T) + (p : List GaussianInt) (x y : GaussianInt) + (hhead : p.head? = some x) (hlast : p.getLast? = some y) + (hnodup : p.Nodup) (hlen : 3 ≤ p.length) + (hadj : ∀ a b, (a, b) ∈ p.zip p.tail → FourNeighborAdjacent a b) + (hclose : FourNeighborAdjacent y x) + (havoid : ∀ z ∈ p, z ∉ BoundaryFootprintVertices T) + (hnoncross : let edges := (p.zip p.tail) ++ [(y, x)] + ∀ i s z, + ((z ∈ (F i s).cells ∧ z + 1 ∈ (F i s).cells) → + (z + 1, z + 1 + ⟨0, 1⟩) ∉ edges ∧ + (z + 1 + ⟨0, 1⟩, z + 1) ∉ edges) ∧ + ((z ∈ (F i s).cells ∧ z + ⟨0, 1⟩ ∈ (F i s).cells) → + (z + 1 + ⟨0, 1⟩, z + ⟨0, 1⟩) ∉ edges ∧ + (z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩) ∉ edges)) + (houtside : ∀ z : GaussianInt, z ∉ T.cells → GridRayCrossingIndex z p = 0) : + ∀ i s z, z ∈ (F i s).cells → GridRayCrossingIndex z p = 0 := by +-- BODY + classical + let edges := (p.zip p.tail) ++ [(y, x)] + let I := fun z => GridRayCrossingIndex z p + have hchange := GridRayCrossingIndexAdjacentCell p x y hhead hlast hnodup hlen + hadj hclose + have hTne : T.cells.Nonempty := by + obtain ⟨c, hc⟩ := (LatticeTileGridStructure (F 0 true) (hF 0 true)).1.1 + exact ⟨c, hinside 0 true hc⟩ + have cyclic_first (u v : GaussianInt) (huv : (u, v) ∈ edges) : u ∈ p := by + simp only [edges, List.mem_append, List.mem_singleton] at huv + rcases huv with huv | huv + · exact (List.of_mem_zip huv).1 + · have hu : u = y := congrArg Prod.fst huv + rw [hu] + exact List.mem_of_getLast? hlast + have boundary_absent (u v : GaussianInt) + (he : ({u, v} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) : + (u, v) ∉ edges ∧ (v, u) ∉ edges := by + have hu : u ∈ BoundaryFootprintVertices T := by + rw [BoundaryFootprintVertices, ite_eq_left hTne] + exact ⟨{u, v}, he, by simp⟩ + have hv : v ∈ BoundaryFootprintVertices T := by + rw [BoundaryFootprintVertices, ite_eq_left hTne] + exact ⟨{u, v}, he, by simp⟩ + exact ⟨fun hm => havoid u (cyclic_first u v hm) hu, + fun hm => havoid v (cyclic_first v u hm) hv⟩ + have horizontal_unique (a b : GaussianInt) + (h : {a, a + 1} = ({b, b + 1} : Finset GaussianInt)) : a = b := by + have ha : a ∈ ({b, b + 1} : Finset GaussianInt) := by rw [← h]; simp + have ha1 : a + 1 ∈ ({b, b + 1} : Finset GaussianInt) := by rw [← h]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at ha ha1 + rcases ha with hab | hab <;> rcases ha1 with ha1b | ha1b + · exact hab + · exact hab + · have h₁ := congrArg Zsqrtd.re hab + have h₂ := congrArg Zsqrtd.re ha1b + simp at h₁ h₂ + omega + · have h₁ := congrArg Zsqrtd.re hab + have h₂ := congrArg Zsqrtd.re ha1b + simp at h₁ h₂ + omega + have vertical_unique (a b : GaussianInt) + (h : {a, a + ⟨0, 1⟩} = ({b, b + ⟨0, 1⟩} : Finset GaussianInt)) : a = b := by + have ha : a ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← h]; simp + have ha1 : a + ⟨0, 1⟩ ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← h]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at ha ha1 + rcases ha with hab | hab <;> rcases ha1 with ha1b | ha1b + · exact hab + · exact hab + · have h₁ := congrArg Zsqrtd.im hab + have h₂ := congrArg Zsqrtd.im ha1b + simp at h₁ h₂ + omega + · have h₁ := congrArg Zsqrtd.im hab + have h₂ := congrArg Zsqrtd.im ha1b + simp at h₁ h₂ + omega + have horizontal_vertical_ne (a b : GaussianInt) : + ({a, a + 1} : Finset GaussianInt) ≠ {b, b + ⟨0, 1⟩} := by + intro h + have ha : a ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← h]; simp + have ha1 : a + 1 ∈ ({b, b + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← h]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at ha ha1 + rcases ha with hab | hab <;> rcases ha1 with ha1b | ha1b + all_goals + have h₁ := congrArg Zsqrtd.re hab + have h₂ := congrArg Zsqrtd.re ha1b + simp at h₁ h₂ + omega + have horizontal_boundary (z : GaussianInt) + (he : ({z, z + 1} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) : + (z ∈ T.cells ∧ z - ⟨0, 1⟩ ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - ⟨0, 1⟩ ∈ T.cells) := by + rcases he with ⟨a, ⟨heq, hocc⟩ | ⟨heq, hocc⟩⟩ + · simpa [horizontal_unique a z heq.symm] using hocc + · exact (horizontal_vertical_ne z a heq).elim + have vertical_boundary (z : GaussianInt) + (he : ({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) : + (z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - 1 ∈ T.cells) := by + rcases he with ⟨a, ⟨heq, hocc⟩ | ⟨heq, hocc⟩⟩ + · exact (horizontal_vertical_ne a z heq.symm).elim + · simpa [vertical_unique a z heq.symm] using hocc + have adjacent_equal (i : Fin 3) (s : Bool) (a b : GaussianInt) + (ha : a ∈ (F i s).cells) (hb : b ∈ (F i s).cells) + (hab : FourNeighborAdjacent a b) : I a = I b := by + rcases hab with rfl | rfl | rfl | rfl + · exact ((hchange a).1 ((hnoncross i s a).1 ⟨ha, hb⟩)).symm + · have he : a - 1 + 1 = a := sub_add_cancel a 1 + have ha' : a - 1 + 1 ∈ (F i s).cells := by simpa only [he] using ha + simpa only [I, he] using + (hchange (a - 1)).1 ((hnoncross i s (a - 1)).1 ⟨hb, ha'⟩) + · exact ((hchange a).2.2.1 ((hnoncross i s a).2 ⟨ha, hb⟩)).symm + · have he : a - ⟨0, 1⟩ + ⟨0, 1⟩ = a := sub_add_cancel a _ + have ha' : a - ⟨0, 1⟩ + ⟨0, 1⟩ ∈ (F i s).cells := by + simpa only [he] using ha + simpa only [I, he] using + (hchange (a - ⟨0, 1⟩)).2.2.1 + ((hnoncross i s (a - ⟨0, 1⟩)).2 ⟨hb, ha'⟩) + intro i s c hc + have hconst (a b : GaussianInt) (ha : a ∈ (F i s).cells) + (hb : b ∈ (F i s).cells) : I a = I b := by + obtain ⟨l, hlhead, hllast, hlmem, hlstep⟩ := + (LatticeTileGridStructure (F i s) (hF i s)).1.2 a ha b hb + have along : ∀ (l : List GaussianInt) (a b : GaussianInt), + l.head? = some a → l.getLast? = some b → + (∀ z ∈ l, z ∈ (F i s).cells) → + (∀ u v l₁ l₂, l = l₁ ++ u :: v :: l₂ → FourNeighborAdjacent u v) → + I a = I b := by + intro l + induction l with + | nil => intro a b hh; simp at hh + | cons u l ih => + intro a b hh ht hm hs + simp only [List.head?_cons, Option.some.injEq] at hh + subst a + cases l with + | nil => simpa using congrArg I (Option.some.inj ht) + | cons v l => + have heq := adjacent_equal i s u v (hm u (by simp)) + (hm v (by simp)) (hs u v [] l rfl) + apply heq.trans + apply ih v b rfl (by simpa using ht) + · intro z hz + exact hm z (List.mem_cons_of_mem u hz) + · intro r t l₁ l₂ he + exact hs r t (u :: l₁) l₂ (by simpa using congrArg (u :: ·) he) + exact along l a b hlhead hllast hlmem hlstep + obtain ⟨e, heF, heT⟩ := hattach i s + rcases heF with ⟨z, ⟨rfl, hocc⟩ | ⟨rfl, hocc⟩⟩ + · have hTocc := horizontal_boundary z heT + have hfree := boundary_absent z (z + 1) heT + have hindex : I z = I (z - ⟨0, 1⟩) := by + have he₁ : z - ⟨0, 1⟩ + 1 + ⟨0, 1⟩ = z + 1 := by abel + have he₂ : z - ⟨0, 1⟩ + ⟨0, 1⟩ = z := sub_add_cancel z _ + have hj := (hchange (z - ⟨0, 1⟩)).2.2.1 + simp only [he₁, he₂] at hj + exact hj hfree.symm + rcases hocc with ⟨hz, _⟩ | ⟨_, hz⟩ + · have hout : z - ⟨0, 1⟩ ∉ T.cells := by + rcases hTocc with h | h + · exact h.2 + · exact (h.1 (hinside i s hz)).elim + exact (hconst c z hc hz).trans (hindex.trans (houtside _ hout)) + · have hout : z ∉ T.cells := by + rcases hTocc with h | h + · exact (h.2 (hinside i s hz)).elim + · exact h.1 + exact (hconst c (z - ⟨0, 1⟩) hc hz).trans (hindex.symm.trans (houtside _ hout)) + · have hTocc := vertical_boundary z heT + have hfree := boundary_absent z (z + ⟨0, 1⟩) heT + have hindex : I z = I (z - 1) := by + have he : z - 1 + 1 = z := sub_add_cancel z 1 + have hj := (hchange (z - 1)).1 + simp only [he] at hj + exact hj hfree + rcases hocc with ⟨hz, _⟩ | ⟨_, hz⟩ + · have hout : z - 1 ∉ T.cells := by + rcases hTocc with h | h + · exact h.2 + · exact (h.1 (hinside i s hz)).elim + exact (hconst c z hc hz).trans (hindex.trans (houtside _ hout)) + · have hout : z ∉ T.cells := by + rcases hTocc with h | h + · exact (h.2 (hinside i s hz)).elim + · exact h.1 + exact (hconst c (z - 1) hc hz).trans (hindex.symm.trans (houtside _ hout)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean new file mode 100644 index 0000000000..856fec378f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean @@ -0,0 +1,798 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4366T1PrecursorRemainderFamily +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.P4397T1PathAvoidsPrecursorEdges +public import LeanPool.ApollonianSuperharmonic.P4397T1SimplePathSplicing + +-- [TABLET NODE: P4366T1PrecursorPathLoop] + +/-! +# P4366T1PrecursorPathLoop + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PrecursorLoopGeometry + +private theorem hOA : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ((cert.P (0 : Fin (3 : ℕ)) + true).cells ∩ (cert.P (0 : Fin (3 : ℕ)) false).cells = cert.O.cells) → (cert.O.cells + ⊆ (cert.P 0 true).cells) ) := by + classical + intro C q cfg T cert hpair z hz + exact (Finset.mem_inter.mp (hpair.symm ▸ hz)).1 + +private theorem hOB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ((cert.P (0 : Fin (3 : ℕ)) + true).cells ∩ (cert.P (0 : Fin (3 : ℕ)) false).cells = cert.O.cells) → (cert.O.cells + ⊆ (cert.P 0 false).cells) ) := by + classical + intro C q cfg T cert hpair z hz + exact (Finset.mem_inter.mp (hpair.symm ▸ hz)).2 + +private theorem footprint_mono : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (U' : ProtoTile), (U.cells.Nonempty) → ((U.cells ⊆ U'.cells) → + (FootprintVertices U ⊆ FootprintVertices U')) ) := by + classical + intro U U' hn hsub + rw [FootprintVertices, ite_eq_left hn, FootprintVertices, ite_eq_left (hn.mono hsub)] + rintro x ⟨z, hz, hc⟩ + exact ⟨z, hsub hz, hc⟩ + +private theorem realization_mono : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (U' : ProtoTile), (U.cells ⊆ U'.cells) → (TileRealization U ⊆ + TileRealization U') ) := by + classical + intro U U' hsub x hx + simp only [TileRealization, Set.mem_iUnion] at hx ⊢ + obtain ⟨z, hz, hx⟩ := hx + exact ⟨z, hsub hz, hx⟩ + +private theorem hno : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : + Finset GaussianInt), (∀ (x : GaussianInt), x ∈ P ↔ x ∈ D ∧ ∃ (i : Fin (3 : ℕ)) (s : + Bool), x ∈ FootprintVertices (cert.P i s) ∧ x ∉ BoundaryFootprintVertices (cert.P i + s)) → (∀ (u : GaussianInt), (u ∈ D \ P) → (∀ (v : GaussianInt), (v ∈ D \ P) → + ((FourNeighborAdjacent u v) → (∀ (i : Fin 3), ∀ (s : Bool), (u ∈ FootprintVertices + (cert.P i s)) → ((v ∈ FootprintVertices (cert.P i s)) → (¬ OpenLatticeEdge u v ⊆ + interior (TileRealization (cert.P i s)))))))) ) := by + classical + intro C q cfg T cert D P hP u hu v hv hadj i s huf hvf + have boundary (x : GaussianInt) (hx : x ∈ D \ P) + (hf : x ∈ FootprintVertices (cert.P i s)) : + x ∈ BoundaryFootprintVertices (cert.P i s) := by + by_contra hnb + exact (Finset.mem_sdiff.mp hx).2 ((hP x).mpr + ⟨(Finset.mem_sdiff.mp hx).1, i, s, hf, hnb⟩) + have hpos : 0 < (q i.succ).1 := by + have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 i + have hz := cfg.noLine i.succ + exact lt_of_le_of_ne hn (Ne.symm hz) + let B : BandCircle := + ⟨⟨q i.succ, Or.inl hpos, q, cfg.proper.1, i.succ, rfl⟩, hpos⟩ + exact (LatticeEdgeRegularity B (cert.P i s) + (cert.outer_occurrence i s).1 (cert.parent_lattice i s)).1 + u v hadj (boundary u hu huf) (boundary v hv hvf) + +private theorem Fsub : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), + let F := P4366T1PrecursorRemainderFamily cert.P cert.O + ∀ (i : Fin 3), ∀ (s : Bool), (F i s).cells ⊆ (cert.P i s).cells ) := by + classical + intro C q cfg T cert F i s + dsimp [F, P4366T1PrecursorRemainderFamily] + split_ifs + · exact Finset.sdiff_subset + · exact Finset.Subset.refl _ + +private theorem FnotO : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), + let F := P4366T1PrecursorRemainderFamily cert.P cert.O + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), (i, s) ≠ (j, t) → + ¬(i = (0 : Fin (3 : ℕ)) ∧ j = (0 : Fin (3 : ℕ))) → Disjoint (cert.P i s).cells + (cert.P j t).cells) → ((cert.O.cells ⊆ (cert.P 0 true).cells) → ((∀ (i : Fin 3), ∀ (s + : Bool), (F i s).cells ⊆ (cert.P i s).cells) → (∀ (i : Fin 3), ∀ (s : Bool), ∀ (z : + GaussianInt), (z ∈ (F i s).cells) → (z ∉ cert.O.cells)))) ) := by + classical + intro C q cfg T cert F hdisjoint hOA Fsub i s z hz + by_cases hi : i = 0 + · simpa [F, P4366T1PrecursorRemainderFamily, hi, TileCellComplement] + using (Finset.mem_sdiff.mp (show z ∈ (cert.P i s).cells \ cert.O.cells by + simpa [F, P4366T1PrecursorRemainderFamily, hi, TileCellComplement] using hz)).2 + · intro ho + exact Finset.disjoint_left.mp + (hdisjoint i s 0 true (fun he => hi (congrArg Prod.fst he)) + (fun he => hi he.1)) (Fsub i s hz) (hOA ho) + +private theorem boundary_raw : + (by + classical + exact + ∀ (U : ProtoTile), (U.cells.Nonempty) → (BoundaryFootprintVertices U ⊆ FootprintVertices + U) ) := by + classical + intro U hn x hx + rw [BoundaryFootprintVertices, ite_eq_left hn] at hx + rw [FootprintVertices, ite_eq_left hn] + obtain ⟨e, ⟨z, ⟨rfl, hz⟩ | ⟨rfl, hz⟩⟩, hxe⟩ := hx + all_goals + simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hz with hz | hz + · refine ⟨z, hz.1, ?_⟩ + rcases hxe with rfl | rfl <;> simp + · refine ⟨_, hz.2, ?_⟩ + rcases hxe with rfl | rfl <;> + simp [sub_eq_add_neg, add_comm, add_left_comm, add_assoc] + +private theorem edge_split : + (by + classical + exact + ∀ (l : List GaussianInt), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ((u, v) ∈ l.zip + l.tail) → (∃ l1 l2, l = l1 ++ u :: v :: l2) ) := by + classical + intro l u v he + induction l with + | nil => simp at he + | cons c l ih => + cases l with + | nil => simp at he + | cons d ds => + simp only [List.tail_cons, List.zip_cons_cons, List.mem_cons] at he + rcases he with he | he + · cases he + exact ⟨[], ds, rfl⟩ + · obtain ⟨l1, l2, hl⟩ := ih he + exact ⟨c :: l1, l2, congrArg (List.cons c) hl⟩ + +private theorem boundary_step : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), (({u, v} : Finset + GaussianInt) ∈ BoundaryFootprintEdges U) → (FourNeighborAdjacent u v) ) := by + classical + intro U u v he + obtain ⟨z, ⟨he, _⟩ | ⟨he, _⟩⟩ := he + all_goals + have hs := congrArg (fun e : Finset GaussianInt => (e : Set GaussianInt)) he + simp only [Finset.coe_pair] at hs + rcases Set.pair_eq_pair_iff.mp hs with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + all_goals simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + +private theorem gW : + (by + classical + exact + ∀ (D : Finset GaussianInt), ∀ (P : Finset GaussianInt), ∀ (V : Set GaussianInt), (V ⊆ + (↑(D \ P) : Set GaussianInt)) → (∀ (g : List GaussianInt), (V = (↑g.toFinset : Set + GaussianInt)) → (∀ (z : GaussianInt), (z ∈ g) → (z ∈ D \ P))) ) := by + classical + intro D P V hV g hgv z hz + apply hV + rw [hgv] + simpa using hz + +private theorem gsteps : + (by + classical + exact + (∀ (l : List GaussianInt), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ((u, v) ∈ l.zip + l.tail) → (∃ l1 l2, l = l1 ++ u :: v :: l2)) → (∀ (g : List GaussianInt), (∀ (a : + GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List + GaussianInt), g = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 : + GaussianInt) ∨ b = a + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ b = a - (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt)) → (∀ (u : GaussianInt), ∀ (v : GaussianInt), ((u, v) ∈ g.zip + g.tail) → (FourNeighborAdjacent u v))) ) := by + classical + intro edge_split g hgs u v he + obtain ⟨l1, l2, hl⟩ := edge_split g u v he + exact hgs u v l1 l2 hl + +private theorem gstar : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (D : Finset GaussianInt), ∀ (P : Finset GaussianInt), (∀ (x : + GaussianInt), x ∈ D ↔ x ∈ FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T) → + ((T.cells.Nonempty) → (∀ (g : List GaussianInt), (∀ (z : GaussianInt), (z ∈ g) → (z ∈ + D \ P)) → (∀ (u : GaussianInt), (u ∈ g) → (∀ j : Fin 4, LatticeVertexIncidentCell u j + ∈ T.cells)))) ) := by + classical + intro T D P hD hT g gW u hu + obtain ⟨hx, hnb⟩ := (hD u).mp (Finset.mem_sdiff.mp (gW u hu)).1 + have hs : ∃ k : Fin 4, LatticeVertexIncidentCell u k ∈ T.cells := by + rw [FootprintVertices, ite_eq_left hT] at hx + obtain ⟨z, hz, rfl | rfl | rfl | rfl⟩ := hx + · exact ⟨0, hz⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hz⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hz⟩ + · refine ⟨2, ?_⟩ + convert hz using 1; simp [LatticeVertexIncidentCell, + sub_eq_add_neg, add_comm, add_left_comm, add_assoc] + intro j + by_contra hj + exact hnb (P3161T2IncidentBoundary T u hs ⟨j, hj⟩) + +private theorem ordered : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), (a ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + GaussianInt)) → ((b ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((a + ≠ b) → ((a = + cert.precursor_boundary.a ∧ b = cert.precursor_boundary.b) ∨ (a = + cert.precursor_boundary.b ∧ b = cert.precursor_boundary.a)))) ) := by + classical + intro C q cfg T cert a b ha hb hab + simp only [Finset.mem_insert, Finset.mem_singleton] at ha hb + rcases ha with ha | ha <;> rcases hb with hb | hb + · exact (hab (ha.trans hb.symm)).elim + · exact Or.inl ⟨ha, hb⟩ + · exact Or.inr ⟨ha, hb⟩ + · exact (hab (ha.trans hb.symm)).elim + +private theorem hreflectab : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), (a ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + GaussianInt)) → ((b ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((a + ≠ b) → (∀ (g : List + GaussianInt), (g.head? = some a) → ((g.getLast? = some b) → (((a = + cert.precursor_boundary.a ∧ b = cert.precursor_boundary.b) ∨ (a = + cert.precursor_boundary.b ∧ b = cert.precursor_boundary.a)) → ((GaussianRealPoint + cert.precursor_boundary.b = ((2 : ℝ) * (TileCentroid cert.O).1 - (GaussianRealPoint + cert.precursor_boundary.a).1, (2 : ℝ) * (TileCentroid cert.O).2 - (GaussianRealPoint + cert.precursor_boundary.a).2)) → (GaussianRealPoint b = (2 * (TileCentroid cert.O).1 + - (GaussianRealPoint a).1, 2 * (TileCentroid cert.O).2 - (GaussianRealPoint + a).2)))))))) ) := by + classical + intro C q cfg T cert a b ha hb hab g hga hgb ordered hreflect + rcases ordered with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact hreflect + · apply Prod.ext + · have h := congrArg Prod.fst hreflect + dsimp at h ⊢ + linarith + · have h := congrArg Prod.snd hreflect + dsimp at h ⊢ + linarith + +private theorem roots_ab : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), (a ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + GaussianInt)) → ((b ∈ + ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((a + ≠ b) → (∀ (g : List + GaussianInt), (g.head? = some a) → ((g.getLast? = some b) → (((a = + cert.precursor_boundary.a ∧ b = cert.precursor_boundary.b) ∨ (a = + cert.precursor_boundary.b ∧ b = cert.precursor_boundary.a)) → ((GaussianRealPoint b = + (2 * (TileCentroid cert.O).1 - (GaussianRealPoint a).1, 2 * (TileCentroid cert.O).2 - + (GaussianRealPoint a).2)) → (∀ (z : GaussianInt), (z ∈ ({cert.precursor_boundary.a, + cert.precursor_boundary.b} : + Finset GaussianInt)) → (z = a ∨ z = b)))))))) ) := by + classical + intro C q cfg T cert a b ha hb hab g hga hgb ordered hreflectab z hz + rcases ordered with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · simpa only [Finset.mem_insert, Finset.mem_singleton] using hz + · simpa only [Finset.mem_insert, Finset.mem_singleton, or_comm] using hz + +private theorem arc_props : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (Finset.Nonempty cert.O.cells) → (∀ + (a : GaussianInt), ∀ (b : GaussianInt), (∀ (U : ProtoTile), (U.cells.Nonempty) → + (BoundaryFootprintVertices U ⊆ FootprintVertices U)) → ((∀ (l : List GaussianInt), ∀ + (u : GaussianInt), ∀ (v : GaussianInt), ((u, v) ∈ l.zip l.tail) → (∃ l1 l2, l = l1 ++ + u :: v :: l2)) → (∀ (l : List GaussianInt), (l.Nodup) → ((l.head? = some b) → + ((l.getLast? = some a) → (((l.toFinset : Set GaussianInt) ⊆ BoundaryFootprintVertices + cert.O) → ((∀ u, ∀ v, ∀ l1, ∀ l2, l = l1 ++ u :: v :: l2 → + ({u, v} : Finset GaussianInt) ∈ BoundaryFootprintEdges cert.O) → (∃ k : List + GaussianInt, k.Nodup ∧ k.head? = some b ∧ k.getLast? = some a ∧ (∀ u, ∀ v, (u, v) + ∈ k.zip k.tail → ({u, v} : Finset GaussianInt) ∈ BoundaryFootprintEdges cert.O) ∧ + (∀ z ∈ k, z ∈ FootprintVertices cert.O))))))))) ) := by + classical + intro C q cfg T cert hO a b boundary_raw edge_split l hn hhead hlast hfoot hedge + refine ⟨l, hn, hhead, hlast, ?_, ?_⟩ + · intro u v he + obtain ⟨l1, l2, hl⟩ := edge_split l u v he + exact hedge u v l1 l2 hl + · intro z hz + exact boundary_raw cert.O hO (hfoot (by simpa using hz)) + +private theorem hkl : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), (a ≠ b) → (∀ (k : List GaussianInt), (k.Nodup) → ((k.head? = some b) → + ((k.getLast? = some a) → ((∀ (u : GaussianInt), ∀ (v : GaussianInt), (u, v) ∈ k.zip + k.tail → {u, v} ∈ BoundaryFootprintEdges cert.O) → ((∀ z ∈ k, z ∈ FootprintVertices + cert.O) → (2 ≤ k.length)))))) ) := by + classical + intro C q cfg T cert a b hab k hkn hkb hka hkboundary hkraw + cases k with + | nil => simp at hkb + | cons c l => + cases l with + | nil => simp only [List.head?_cons, List.getLast?_singleton, + Option.some.injEq] at hkb hka + exact (hab (hka.symm.trans hkb)).elim + | cons d ds => simp + +private theorem kedge_raw : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (k : List GaussianInt), (∀ (u : + GaussianInt), ∀ (v : GaussianInt), (u, v) ∈ k.zip k.tail → {u, v} ∈ + BoundaryFootprintEdges cert.O) → ((∀ (u : GaussianInt), ∀ (v : GaussianInt), ((u, v) + ∈ k.zip k.tail) → (FourNeighborAdjacent u v)) → (∀ (u : GaussianInt), ∀ (v : + GaussianInt), ((u, v) ∈ k.zip k.tail) → (({u, v} : Finset GaussianInt) ∈ + FootprintEdges cert.O))) ) := by + classical + intro C q cfg T cert k hkboundary ksteps u v he + obtain ⟨z, w, hs⟩ := P4397T1UnitEdgeCells.1 u v (ksteps u v he) + have hg := P4397T1UnitEdgeCells.2 u v z w hs cert.O + apply hg.1.mpr + rcases hg.2.1.mp (hkboundary u v he) with h | h + · exact Or.inl h.1 + · exact Or.inr h.2 + +private theorem trans_zero : + (by + classical + exact + ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by + classical + intro U + cases U + simp [TileTranslation, GaussianTranslation, show GaussianTranslation 0 = id from + funext (fun z => add_zero z)] + +private theorem kstar : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (∀ (i : Fin 3), ∀ (s : Bool), (cert.P + i s).cells ⊆ T.cells) → (∀ (k : List GaussianInt), (∀ z ∈ k, z ∈ FootprintVertices + cert.O) → ((∀ (U : ProtoTile), TileTranslation U 0 = U) → (∀ (x : GaussianInt), (x ∈ + k) → (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells)))) ) := by + classical + intro C q cfg T cert parent_sub k hkraw trans_zero x hx j + have hcorner : x ∈ FootprintVertices + (⟨{LatticeVertexIncidentCell x j}, LatticeVertexIncidentCell x j⟩ : ProtoTile) := by + rw [FootprintVertices, ite_eq_left (Finset.singleton_nonempty _)] + refine ⟨LatticeVertexIncidentCell x j, by simp, ?_⟩ + fin_cases j <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] + have hiso := cert.precursor_isolated 0 0 x + (by simpa only [Int.cast_zero, zero_mul, zero_add, trans_zero] using hkraw x hx) + (LatticeVertexIncidentCell x j) hcorner + simp only [SubtileOccurrenceInterpretation, Int.cast_zero, zero_mul, + zero_add, trans_zero] at hiso + exact hiso.elim (fun hz => parent_sub 0 true hz) (fun hz => parent_sub 0 false hz) + +private theorem hcycles : + (by + classical + exact + ∀ (g : List GaussianInt), ∀ (k : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), ((g.dropLast ++ k.dropLast).zip (g.dropLast ++ k.dropLast).tail ++ [(y, + x)] = g.zip g.tail ++ k.zip k.tail) → ( + let p := g.dropLast ++ k.dropLast + let edges := (p.zip p.tail) ++ [(y, x)] + ∀ (u : GaussianInt), ∀ (v : GaussianInt), (u, v) ∈ edges ↔ (u, v) ∈ g.zip g.tail ∨ (u, v) + ∈ k.zip k.tail) ) := by + classical + intro g k x y hedges p edges u v + dsimp [edges] + rw [hedges] + exact List.mem_append + +private theorem gsegments : + (by + classical + exact + ∀ (T : ProtoTile), (∀ (l : List GaussianInt), ∀ (u : GaussianInt), ∀ (v : GaussianInt), + ((u, v) ∈ l.zip l.tail) → (u ∈ l ∧ v ∈ l)) → (∀ (g : List GaussianInt), (∀ (u : + GaussianInt), ∀ (v : GaussianInt), ((u, v) ∈ g.zip g.tail) → (FourNeighborAdjacent u + v)) → ((∀ (u : GaussianInt), (u ∈ g) → (∀ j : Fin 4, LatticeVertexIncidentCell u j ∈ + T.cells)) → (∀ (u : GaussianInt), ∀ (v : GaussianInt), ((u, v) ∈ g.zip g.tail) → (∀ t + : Set.Icc (0 : Real) 1, ((1 - (t : Real)) * (u.re : Real) + (t : Real) * (v.re : + Real), (1 - (t : Real)) * (u.im : Real) + (t : Real) * (v.im : Real)) ∈ + TileRealization T)))) ) := by + classical + intro T edge_vertices g gsteps gstar u v he + obtain ⟨z, w, hs⟩ := P4397T1UnitEdgeCells.1 u v (gsteps u v he) + have hg := P4397T1UnitEdgeCells.2 u v z w hs T + exact (hg.2.2.1 (Or.inl (hg.2.2.2.2 + (gstar u (edge_vertices g u v he).1)).1)).2.2 + +private theorem ksegments : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (cert.O.cells ⊆ T.cells) → ((∀ (U : + ProtoTile), ∀ (U' : ProtoTile), (U.cells ⊆ U'.cells) → (TileRealization U ⊆ + TileRealization U')) → (∀ (k : List GaussianInt), (∀ (u : GaussianInt), ∀ (v : + GaussianInt), ((u, v) ∈ k.zip k.tail) → (FourNeighborAdjacent u v)) → ((∀ (u : + GaussianInt), ∀ (v : GaussianInt), ((u, v) ∈ k.zip k.tail) → (({u, v} : Finset + GaussianInt) ∈ FootprintEdges cert.O)) → (∀ (u : GaussianInt), ∀ (v : GaussianInt), + ((u, v) ∈ k.zip k.tail) → (∀ t : Set.Icc (0 : Real) 1, ((1 - (t : Real)) * (u.re : + Real) + (t : Real) * (v.re : Real), (1 - (t : Real)) * (u.im : Real) + (t : Real) * + (v.im : Real)) ∈ TileRealization T))))) ) := by + classical + intro C q cfg T cert hOT realization_mono k ksteps kedge_raw u v he + obtain ⟨z, w, hs⟩ := P4397T1UnitEdgeCells.1 u v (ksteps u v he) + have hg := P4397T1UnitEdgeCells.2 u v z w hs cert.O + exact fun t => realization_mono _ _ hOT + ((hg.2.2.1 (hg.1.mp (kedge_raw u v he))).2.2 t) + +private theorem exclude_pair : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : + Finset GaussianInt), + let F := P4366T1PrecursorRemainderFamily cert.P cert.O + (∀ (u : GaussianInt), (u ∈ D \ P) → (∀ (v : GaussianInt), (v ∈ D \ P) → + ((FourNeighborAdjacent u v) → (∀ (i : Fin 3), ∀ (s : Bool), (u ∈ FootprintVertices + (cert.P i s)) → ((v ∈ FootprintVertices (cert.P i s)) → (¬ OpenLatticeEdge u v ⊆ + interior (TileRealization (cert.P i s)))))))) → ((∀ (i : Fin 3), ∀ (s : Bool), (F i + s).cells ⊆ (cert.P i s).cells) → ((∀ (i : Fin 3), ∀ (s : Bool), ∀ (z : GaussianInt), + (z ∈ (F i s).cells) → (z ∉ cert.O.cells)) → ((∀ (l : List GaussianInt), ∀ (u : + GaussianInt), ∀ (v : GaussianInt), ((u, v) ∈ l.zip l.tail) → (u ∈ l ∧ v ∈ l)) → (∀ (g + : List GaussianInt), (∀ (z : GaussianInt), (z ∈ g) → (z ∈ D \ P)) → ((∀ (u : + GaussianInt), ∀ (v : GaussianInt), ((u, v) ∈ g.zip g.tail) → (FourNeighborAdjacent u + v)) → (∀ (k : List GaussianInt), (∀ (u : GaussianInt), ∀ (v : GaussianInt), ((u, v) ∈ + k.zip k.tail) → (({u, v} : Finset GaussianInt) ∈ FootprintEdges cert.O)) → (∀ (x : + GaussianInt), ∀ (y : GaussianInt), + let p := g.dropLast ++ k.dropLast + let edges := (p.zip p.tail) ++ [(y, x)] + (∀ (u : GaussianInt), ∀ (v : GaussianInt), (u, v) ∈ edges ↔ (u, v) ∈ g.zip g.tail ∨ (u, + v) ∈ k.zip k.tail) → (∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (z : GaussianInt), + ∀ (w : GaussianInt), ((((u = z + 1 ∧ v = z + 1 + ⟨0, 1⟩) ∨ + (v = z + 1 ∧ u = z + 1 + ⟨0, 1⟩)) ∧ w = z + 1 ∨ + ((u = z + 1 + ⟨0, 1⟩ ∧ v = z + ⟨0, 1⟩) ∨ + (v = z + 1 + ⟨0, 1⟩ ∧ u = z + ⟨0, 1⟩)) ∧ w = z + ⟨0, 1⟩)) → (∀ (i : Fin 3), ∀ (s : + Bool), (z ∈ (F i s).cells) → ((w ∈ (F i s).cells) → ((u, v) ∉ edges))))))))))) + ) := by + classical + intro C q cfg T cert D P F hno Fsub FnotO edge_vertices g gW gsteps k kedge_raw x y p edges + hcycles u v z w hs i s hz hw he + have hgeom := P4397T1UnitEdgeCells.2 u v z w hs + rcases (hcycles u v).mp he with hg | hk + · have hp := hgeom (cert.P i s) + have hboth := And.intro (Fsub i s hz) (Fsub i s hw) + have hraw := hp.2.2.1 (Or.inl hboth.1) + have huv := edge_vertices g u v hg + exact hno u (gW u huv.1) v (gW v huv.2) (gsteps u v hg) + i s hraw.1 hraw.2.1 (hp.2.2.2.1 hboth) + · rcases (hgeom cert.O).1.mp (kedge_raw u v hk) with ho | ho + · exact FnotO i s z hz ho + · exact FnotO i s w hw ho + +private theorem he'At460 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), + let F := P4366T1PrecursorRemainderFamily cert.P cert.O + ∀ (g : List GaussianInt), ∀ (k : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), ((g.dropLast ++ k.dropLast).head? = some x) → (((g.dropLast ++ + k.dropLast).getLast? = some y) → (((g.dropLast ++ k.dropLast).zip (g.dropLast ++ + k.dropLast).tail ++ [(y, x)] = g.zip g.tail ++ k.zip k.tail) → ( + let p := g.dropLast ++ k.dropLast + let edges := (p.zip p.tail) ++ [(y, x)] + (∀ (u : GaussianInt), ∀ (v : GaussianInt), (u, v) ∈ edges ↔ (u, v) ∈ g.zip g.tail ∨ (u, + v) ∈ k.zip k.tail) → ((∀ (u : GaussianInt), ∀ (v : GaussianInt), ((u, v) ∈ edges) → + (FourNeighborAdjacent u v)) → ((∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (z : + GaussianInt), ∀ (w : GaussianInt), ((((u = z + 1 ∧ v = z + 1 + ⟨0, 1⟩) ∨ (v = z + 1 ∧ + u = z + 1 + ⟨0, 1⟩)) ∧ w = z + 1 ∨ ((u = z + 1 + ⟨0, 1⟩ ∧ v = z + ⟨0, 1⟩) ∨ (v = z + + 1 + ⟨0, 1⟩ ∧ u = z + ⟨0, 1⟩)) ∧ w = z + ⟨0, 1⟩)) → (∀ (i : Fin 3), ∀ (s : Bool), (z ∈ + (F i s).cells) → ((w ∈ (F i s).cells) → ((u, v) ∉ edges)))) → (∀ (u : GaussianInt), ∀ + (v : GaussianInt), ((u, v) ∈ p.zip p.tail ∨ u = y ∧ v = x) → ((u, v) ∈ edges))))))) ) + := by + classical + intro C q cfg T cert F g k x y hhead hlast hedges p edges hcycles allsteps exclude_pair u v he + rcases he with he | ⟨rfl, rfl⟩ + · simp only [edges, List.mem_append]; exact Or.inl he + · simp [edges] + +private theorem hnone : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (g : List GaussianInt), (∀ (u : + GaussianInt), ∀ (v : GaussianInt), (u, v) ∈ g.zip g.tail → {u, v} ∉ FootprintEdges + cert.O) → (∀ (u : GaussianInt), ∀ (v : GaussianInt), ((u, v) ∈ g.zip g.tail) → (∀ (z + : GaussianInt), ∀ (w : GaussianInt), (∀ (U : ProtoTile), ({u, v} ∈ FootprintEdges U ↔ + z ∈ U.cells ∨ w ∈ U.cells) ∧ ({u, v} ∈ BoundaryFootprintEdges U ↔ z ∈ U.cells ∧ w ∉ + U.cells ∨ z ∉ U.cells ∧ w ∈ U.cells) ∧ (z ∈ U.cells ∨ w ∈ U.cells → u ∈ + FootprintVertices U ∧ v ∈ FootprintVertices U ∧ ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : + Type)), (((1 : ℝ) - (↑t : ℝ)) * (↑u.re : ℝ) + (↑t : ℝ) * (↑v.re : ℝ), ((1 : ℝ) - (↑t + : ℝ)) * (↑u.im : ℝ) + (↑t : ℝ) * (↑v.im : ℝ)) ∈ TileRealization U) ∧ (z ∈ U.cells ∧ w + ∈ U.cells → OpenLatticeEdge u v ⊆ interior (TileRealization U)) ∧ ((∀ (j : Fin (4 : + ℕ)), LatticeVertexIncidentCell u j ∈ U.cells) → z ∈ U.cells ∧ w ∈ U.cells)) → (z ∉ + cert.O.cells ∧ w ∉ cert.O.cells))) ) := by + classical + intro C q cfg T cert g gnoO u v he z w hg + have hn : ¬ (z ∈ cert.O.cells ∨ w ∈ cert.O.cells) := + fun h => gnoO u v he ((hg cert.O).1.mpr h) + exact ⟨fun h => hn (Or.inl h), fun h => hn (Or.inr h)⟩ + +end PrecursorLoopGeometry + +theorem P4366T1PrecursorPathLoop + (C : BandCircle) (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (D P : Finset GaussianInt) + (hD : ∀ x, x ∈ D ↔ + x ∈ FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T) + (hP : ∀ x, x ∈ P ↔ x ∈ D ∧ ∃ i s, + x ∈ FootprintVertices (cert.P i s) ∧ + x ∉ BoundaryFootprintVertices (cert.P i s)) + (hO : cert.O.cells.Nonempty) + (hOband : BandPrototile (cfg.firstPredecessor 1) cert.O) + (hroots : ∀ x ∈ D \ P, + x ∈ FootprintVertices cert.O ↔ + x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + Finset GaussianInt)) + (a b : GaussianInt) + (ha : a ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + Finset GaussianInt)) + (hb : b ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + Finset GaussianInt)) + (hab : a ≠ b) (V : Set GaussianInt) (E : Set (Finset GaussianInt)) + (hpath : SimpleGridPathBetween V E a b) + (hV : V ⊆ (D \ P : Finset GaussianInt)) : + let F := P4366T1PrecursorRemainderFamily cert.P cert.O + ∃ (p : List GaussianInt) (x y : GaussianInt), + p.Nodup ∧ 3 ≤ p.length ∧ p.head? = some x ∧ p.getLast? = some y ∧ + (∀ u v, (u, v) ∈ p.zip p.tail → FourNeighborAdjacent u v) ∧ + FourNeighborAdjacent y x ∧ + (∀ u v, ((u, v) ∈ p.zip p.tail ∨ (u = y ∧ v = x)) → + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * (u.re : Real) + (t : Real) * (v.re : Real), + (1 - (t : Real)) * (u.im : Real) + (t : Real) * (v.im : Real)) ∈ + TileRealization T) ∧ + (∀ z ∈ p, z ∉ BoundaryFootprintVertices T) ∧ + (let edges := (p.zip p.tail) ++ [(y, x)] + (∀ i s z, + ((z ∈ (F i s).cells ∧ z + 1 ∈ (F i s).cells) → + (z + 1, z + 1 + ⟨0, 1⟩) ∉ edges ∧ + (z + 1 + ⟨0, 1⟩, z + 1) ∉ edges) ∧ + ((z ∈ (F i s).cells ∧ z + ⟨0, 1⟩ ∈ (F i s).cells) → + (z + 1 + ⟨0, 1⟩, z + ⟨0, 1⟩) ∉ edges ∧ + (z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩) ∉ edges)) ∧ + (∃ z : GaussianInt, + ((z ∈ T.cells ∧ z ∉ cert.O.cells) ∧ + (z + 1 ∈ T.cells ∧ z + 1 ∉ cert.O.cells) ∧ + ((z + 1, z + 1 + ⟨0, 1⟩) ∈ edges ∨ + (z + 1 + ⟨0, 1⟩, z + 1) ∈ edges)) ∨ + ((z ∈ T.cells ∧ z ∉ cert.O.cells) ∧ + (z + ⟨0, 1⟩ ∈ T.cells ∧ z + ⟨0, 1⟩ ∉ cert.O.cells) ∧ + ((z + 1 + ⟨0, 1⟩, z + ⟨0, 1⟩) ∈ edges ∨ + (z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩) ∈ edges)))) := by +-- BODY + classical + dsimp only + let F := P4366T1PrecursorRemainderFamily cert.P cert.O + obtain ⟨_, _, _, _, _, _, hpair, hdisjoint⟩ := + P4339T1PrecursorSupportGeometry C q cfg T cert + have hOA := PrecursorLoopGeometry.hOA C q cfg T cert hpair + have hOB := PrecursorLoopGeometry.hOB C q cfg T cert hpair + have parent_sub (i : Fin 3) (s : Bool) : (cert.P i s).cells ⊆ T.cells := + fun z hz => (cert.outer_union z).mpr ⟨i, s, hz⟩ + have hOT : cert.O.cells ⊆ T.cells := fun z hz => parent_sub 0 true (hOA hz) + have hT : T.cells.Nonempty := hO.mono hOT + have realization_mono := PrecursorLoopGeometry.realization_mono + have hOfootA := (PrecursorLoopGeometry.footprint_mono) cert.O (cert.P 0 true) hO hOA + have hno := PrecursorLoopGeometry.hno C q cfg T cert D P hP + have Fsub := PrecursorLoopGeometry.Fsub C q cfg T cert + have FnotO := PrecursorLoopGeometry.FnotO C q cfg T cert hdisjoint hOA Fsub + have boundary_raw := PrecursorLoopGeometry.boundary_raw + have edge_split := PrecursorLoopGeometry.edge_split + have edge_vertices (l : List GaussianInt) (u v : GaussianInt) + (he : (u, v) ∈ l.zip l.tail) : u ∈ l ∧ v ∈ l := + ⟨(List.of_mem_zip he).1, List.mem_of_mem_tail (List.of_mem_zip he).2⟩ + have boundary_step := PrecursorLoopGeometry.boundary_step + obtain ⟨g, hgn, hgl, hga, hgb, hgv, hgs, _⟩ := hpath + have gW := PrecursorLoopGeometry.gW D P V hV g hgv + have gsteps := PrecursorLoopGeometry.gsteps edge_split g hgs + have gstar := PrecursorLoopGeometry.gstar T D P hD hT g gW + have ordered := PrecursorLoopGeometry.ordered C q cfg T cert a b ha hb hab + obtain ⟨plusArc, minusArc, hpn, hmn, hph, hpl, hmh, hml, + hpf, hmf, hpe, hme, _, _, hreflect, _⟩ := + (show ∃ plusArc minusArc : List GaussianInt, _ from by + rcases cert.precursor_boundary.branch with hp | hn + · exact hp.2 + · exact ((Finset.nonempty_iff_ne_empty.mp hO) hn.1).elim) + have hreflectab := PrecursorLoopGeometry.hreflectab C q cfg T cert a b ha hb hab g hga hgb + ordered hreflect + have roots_ab := PrecursorLoopGeometry.roots_ab C q cfg T cert a b ha hb hab g hga hgb ordered + hreflectab + have gnoO := P4397T1PathAvoidsPrecursorEdges cert.O (TileCentroid cert.O) + (BandPrototileCentralSymmetry _ _ hOband) a b hab hreflectab + g hgn hga hgb gsteps + (fun z hz hf => roots_ab z ((hroots z (gW z hz)).mp hf)) + (by + intro u v he hu hv hchord + have huv := edge_vertices g u v he + exact hno u (gW u huv.1) v (gW v huv.2) (gsteps u v he) + 0 true (hOfootA hu) (hOfootA hv) + (fun x hx => interior_mono (realization_mono _ _ hOA) (hchord hx))) + obtain ⟨k, hkn, hkb, hka, hkboundary, hkraw⟩ : + ∃ k : List GaussianInt, k.Nodup ∧ k.head? = some b ∧ + k.getLast? = some a ∧ + (∀ u v, (u, v) ∈ k.zip k.tail → + ({u, v} : Finset GaussianInt) ∈ BoundaryFootprintEdges cert.O) ∧ + (∀ z ∈ k, z ∈ FootprintVertices cert.O) := by + have arc_props := PrecursorLoopGeometry.arc_props C q cfg T cert hO a b boundary_raw edge_split + rcases ordered with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact arc_props minusArc hmn hmh hml + (fun z hz => (hmf ▸ hz).2) (fun u v l1 l2 hl => (hme u v l1 l2 hl).2) + · exact arc_props plusArc hpn hph hpl + (fun z hz => (hpf ▸ hz).2) (fun u v l1 l2 hl => (hpe u v l1 l2 hl).2) + have hkl := PrecursorLoopGeometry.hkl C q cfg T cert a b hab k hkn hkb hka hkboundary hkraw + have ksteps (u v : GaussianInt) (he : (u, v) ∈ k.zip k.tail) : + FourNeighborAdjacent u v := boundary_step cert.O u v (hkboundary u v he) + have kedge_raw (u v : GaussianInt) (he : (u, v) ∈ k.zip k.tail) : + ({u, v} : Finset GaussianInt) ∈ FootprintEdges cert.O := PrecursorLoopGeometry.kedge_raw C + q cfg T cert k hkboundary ksteps u v he + have kstar := PrecursorLoopGeometry.kstar C q cfg T cert parent_sub k hkraw + (PrecursorLoopGeometry.trans_zero) + obtain ⟨hnd, hlen, x, y, hhead, hlast, hedges, hmem⟩ := + P4397T1SimplePathSplicing g k a b hgn hkn hgl hkl hga hgb hkb hka + (fun z hzg hzk => roots_ab z ((hroots z (gW z hzg)).mp (hkraw z hzk))) + (by + intro u v he + exact ⟨fun hk => gnoO u v he (kedge_raw u v hk), + fun hk => gnoO u v he (by simpa [Finset.pair_comm] using kedge_raw v u hk)⟩) + let p := g.dropLast ++ k.dropLast + let edges := (p.zip p.tail) ++ [(y, x)] + have hcycles := PrecursorLoopGeometry.hcycles g k x y hedges + have allsteps (u v : GaussianInt) (he : (u, v) ∈ edges) : FourNeighborAdjacent u v := + ((hcycles u v).mp he).elim (gsteps u v) (ksteps u v) + have exclude_pair := PrecursorLoopGeometry.exclude_pair C q cfg T cert D P hno Fsub FnotO + edge_vertices g gW gsteps k kedge_raw x y hcycles + refine ⟨p, x, y, hnd, hlen, hhead, hlast, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro u v he + exact allsteps u v (by simp only [edges, List.mem_append]; exact Or.inl he) + · exact allsteps y x (by simp [edges]) + · intro u v he + have he' := PrecursorLoopGeometry.he'At460 C q cfg T cert g k x y hhead hlast hedges hcycles + allsteps exclude_pair u v he + exact ((hcycles u v).mp he').elim ((PrecursorLoopGeometry.gsegments T edge_vertices g gsteps + gstar) u v) ((PrecursorLoopGeometry.ksegments C q cfg T cert hOT realization_mono k + ksteps kedge_raw) u v) + · intro z hz + rcases hmem z hz with hg | hk + · exact ((hD z).mp (Finset.mem_sdiff.mp (gW z hg)).1).2 + · intro hz + rw [BoundaryFootprintVertices, ite_eq_left hT] at hz + obtain ⟨e, ⟨w, ⟨rfl, hw⟩ | ⟨rfl, hw⟩⟩, hze⟩ := hz + all_goals + have h0 := kstar z hk 0 + have h1 := kstar z hk 1 + have h2 := kstar z hk 2 + have h3 := kstar z hk 3 + simp only [Finset.mem_insert, Finset.mem_singleton] at hze + rcases hze with rfl | rfl + all_goals + simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] at h0 h1 h2 h3 hw + tauto + · intro i s z + constructor + · rintro ⟨hz, hw⟩ + exact ⟨exclude_pair _ _ z (z + 1) (Or.inl ⟨Or.inl ⟨rfl, rfl⟩, rfl⟩) i s hz hw, + exclude_pair _ _ z (z + 1) (Or.inl ⟨Or.inr ⟨rfl, rfl⟩, rfl⟩) i s hz hw⟩ + · rintro ⟨hz, hw⟩ + exact ⟨exclude_pair _ _ z (z + ⟨0, 1⟩) (Or.inr ⟨Or.inl ⟨rfl, rfl⟩, rfl⟩) i s hz hw, + exclude_pair _ _ z (z + ⟨0, 1⟩) (Or.inr ⟨Or.inr ⟨rfl, rfl⟩, rfl⟩) i s hz hw⟩ + · obtain ⟨u, v, he⟩ : ∃ u v, (u, v) ∈ g.zip g.tail := by + cases g with + | nil => simp at hgl + | cons u l => + cases l with + | nil => simp at hgl + | cons v ds => exact ⟨u, v, by simp⟩ + obtain ⟨z, w, hs⟩ := P4397T1UnitEdgeCells.1 u v (gsteps u v he) + have hg := P4397T1UnitEdgeCells.2 u v z w hs + have hboth := (hg T).2.2.2.2 (gstar u (edge_vertices g u v he).1) + have hnone := PrecursorLoopGeometry.hnone C q cfg T cert g gnoO u v he z w hg + have he' : (u, v) ∈ edges := (hcycles u v).mpr (Or.inl he) + refine ⟨z, ?_⟩ + rcases hs with ⟨hs, rfl⟩ | ⟨hs, rfl⟩ + · refine Or.inl ⟨⟨hboth.1, hnone.1⟩, ⟨hboth.2, hnone.2⟩, ?_⟩ + rcases hs with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact Or.inl he' + · exact Or.inr he' + · refine Or.inr ⟨⟨hboth.1, hnone.1⟩, ⟨hboth.2, hnone.2⟩, ?_⟩ + rcases hs with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact Or.inl he' + · exact Or.inr he' + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorRemainderFamily.lean b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorRemainderFamily.lean new file mode 100644 index 0000000000..be1f49f832 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorRemainderFamily.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileCellComplement + +-- [TABLET NODE: P4366T1PrecursorRemainderFamily] + +/-! +# P4366T1PrecursorRemainderFamily + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a signed family $P_i^s$, indexed by $i\in\{0,1,2\}$ and a +Boolean sign $s$, and a prototile $O$, define the signed family $F$ by +$$ + F_i^s=\begin{cases} + \operatorname{TileCellComplement}(P_i^s,O),&i=0,\\ + P_i^s,&i\ne0. + \end{cases} +$$ +Thus only the two largest-parent occurrences have their $O$-cells +deleted. The complements retain the auxiliary anchors of their parents. +-/ +def P4366T1PrecursorRemainderFamily + (P : Fin 3 → Bool → ProtoTile) (O : ProtoTile) : + Fin 3 → Bool → ProtoTile := +-- BODY + fun i s => if i = 0 then TileCellComplement (P i s) O else P i s + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean b/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean new file mode 100644 index 0000000000..d00750d341 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean @@ -0,0 +1,544 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import LeanPool.ApollonianSuperharmonic.P4366T1PrecursorRemainderFamily + +-- [TABLET NODE: P4366T1RemainderOuterAttachments] + +/-! +# P4366T1RemainderOuterAttachments + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RemainderAttachmentGeometry + +private theorem zero_translation : + (by + classical + exact + ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by + classical + intro U + have htranslation : GaussianTranslation 0 = id := by + funext a + exact add_zero a + cases U + simp [TileTranslation, htranslation] + +private theorem isolated : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (∀ (U : ProtoTile), TileTranslation U + 0 = U) → (∀ {x : GaussianInt}, ∀ {a : GaussianInt}, (x ∈ FootprintVertices cert.O) → + ((x = a ∨ x = a + 1 ∨ x = a + ⟨0, 1⟩ ∨ + x = a + 1 + ⟨0, 1⟩) → (a ∈ T.cells))) ) := by + classical + intro C q cfg T cert zero_translation x a hx hxa + have hx' : x ∈ FootprintVertices + (TileTranslation cert.O ((0 : GaussianInt) * cert.u + + (0 : GaussianInt) * cert.v)) := by + simpa only [zero_mul, zero_add, zero_translation] using hx + have hs : x ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) := by + simpa only [FootprintVertices, Finset.singleton_nonempty, ite_true, + Set.mem_ofPred_eq, Finset.mem_singleton, exists_eq_left] using hxa + have hi := cert.precursor_isolated 0 0 x hx' a hs + simp only [SubtileOccurrenceInterpretation, Int.cast_zero, zero_mul, + zero_add, zero_translation] at hi + rcases hi with h | h + · exact (cert.outer_union a).mpr ⟨0, true, h⟩ + · exact (cert.outer_union a).mpr ⟨0, false, h⟩ + +private theorem corner : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (z : GaussianInt), (z ∈ + cert.O.cells) → (∀ (x : GaussianInt), (x = z ∨ x = z + 1 ∨ x = z + ⟨0, 1⟩ ∨ + x = z + 1 + ⟨0, 1⟩) → (x ∈ FootprintVertices cert.O)) ) := by + classical + intro C q cfg T cert z hx x hxa + simpa only [FootprintVertices, ite_eq_left (show cert.O.cells.Nonempty from ⟨z, hx⟩), + Set.mem_ofPred_eq] using (show ∃ a ∈ cert.O.cells, + x = a ∨ x = a + 1 ∨ x = a + ⟨0, 1⟩ ∨ + x = a + 1 + ⟨0, 1⟩ from ⟨z, hx, hxa⟩) + +private theorem hneighbors : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (∀ {x : GaussianInt}, ∀ + {a : GaussianInt}, (x ∈ FootprintVertices cert.O) → ((x = a ∨ x = a + 1 ∨ x = a + ⟨0, + 1⟩ ∨ x = a + 1 + ⟨0, 1⟩) → (a ∈ T.cells))) → ((∀ (z : GaussianInt), (z ∈ + cert.O.cells) → (∀ (x : GaussianInt), (x = z ∨ x = z + 1 ∨ x = z + ⟨0, 1⟩ ∨ x = z + 1 + + ⟨0, 1⟩) → (x ∈ FootprintVertices cert.O))) → (∀ (z : GaussianInt), (z ∈ + cert.O.cells) → (z - ⟨0, 1⟩ ∈ T.cells ∧ z + ⟨0, 1⟩ ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z + + 1 ∈ T.cells))) ) := by + classical + intro C q cfg T cert isolated corner z hz + refine ⟨isolated (corner z hz z (Or.inl rfl)) ?_, + isolated (corner z hz (z + ⟨0, 1⟩) + (Or.inr (Or.inr (Or.inl rfl)))) (Or.inl rfl), + isolated (corner z hz z (Or.inl rfl)) ?_, + isolated (corner z hz (z + 1) (Or.inr (Or.inl rfl))) (Or.inl rfl)⟩ + · exact Or.inr (Or.inr (Or.inl (by simp))) + · exact Or.inr (Or.inl (by simp)) + +private theorem hOsubA : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), cert.O.cells ⊆ (cert.P 0 true).cells + ) := by + classical + intro C q cfg T cert z hz + exact (cert.plus_union z).mpr ⟨0, false, + by simpa only [← cert.precursor_eq] using hz⟩ + +private theorem hOsubB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), cert.O.cells ⊆ (cert.P 0 false).cells + ) := by + classical + intro C q cfg T cert z hz + exact (cert.minus_union z).mpr ⟨0, true, by + rw [← cert.precursor_cells] + exact hz⟩ + +private theorem hcover : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), + let F := P4366T1PrecursorRemainderFamily cert.P cert.O + (cert.O.cells ⊆ (cert.P 0 true).cells) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin + (3 : ℕ)), ∀ (t : Bool), (i, s) ≠ (j, t) → ¬(i = (0 : Fin (3 : ℕ)) ∧ j = (0 : Fin (3 : + ℕ))) → Disjoint (cert.P i s).cells (cert.P j t).cells) → (∀ z, z ∈ T.cells ∧ z ∉ + cert.O.cells ↔ ∃ i s, z ∈ (F i s).cells)) ) := by + classical + intro C q cfg T cert F hOsubA hdisjoint z + constructor + · rintro ⟨hzT, hzO⟩ + obtain ⟨i, s, hzi⟩ := (cert.outer_union z).mp hzT + refine ⟨i, s, ?_⟩ + dsimp [F, P4366T1PrecursorRemainderFamily] + split_ifs with hi + · simp only [TileCellComplement, Finset.mem_sdiff] + exact ⟨hzi, hzO⟩ + · exact hzi + · rintro ⟨i, s, hz⟩ + constructor + · have : z ∈ (cert.P i s).cells := by + change z ∈ (P4366T1PrecursorRemainderFamily cert.P cert.O i s).cells at hz + simp only [P4366T1PrecursorRemainderFamily] at hz + split_ifs at hz with hi + · change z ∈ (cert.P i s).cells \ cert.O.cells at hz + exact (Finset.mem_sdiff.mp hz).1 + · exact hz + exact (cert.outer_union z).mpr ⟨i, s, this⟩ + · intro hzO + have hzP : z ∈ (cert.P i s).cells := by + change z ∈ (P4366T1PrecursorRemainderFamily cert.P cert.O i s).cells at hz + simp only [P4366T1PrecursorRemainderFamily] at hz + split_ifs at hz with hi + · change z ∈ (cert.P i s).cells \ cert.O.cells at hz + exact (Finset.mem_sdiff.mp hz).1 + · exact hz + by_cases hi : i = 0 + · subst i + cases s + · have hz' : z ∈ (cert.P 0 false).cells \ cert.O.cells := by + change z ∈ (P4366T1PrecursorRemainderFamily cert.P cert.O 0 false).cells at hz + exact hz + exact (Finset.mem_sdiff.mp hz').2 hzO + · have hz' : z ∈ (cert.P 0 true).cells \ cert.O.cells := by + change z ∈ (P4366T1PrecursorRemainderFamily cert.P cert.O 0 true).cells at hz + exact hz + exact (Finset.mem_sdiff.mp hz').2 hzO + · have hne : (i, s) ≠ (0, true) := by + intro he + exact hi (congrArg Prod.fst he) + have hdis := hdisjoint i s 0 true hne (by simp [hi]) + exact Finset.disjoint_left.mp hdis hzP (hOsubA hzO) + +private theorem hLattice : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), + let F := P4366T1PrecursorRemainderFamily cert.P cert.O + ∀ i, ∀ s, LatticeTile (F i s) ) := by + classical + intro C q cfg T cert F i s + by_cases hi : i = 0 + · subst i + cases s + · exact cert.precursor_complement_lattice.2 + · exact cert.precursor_complement_lattice.1 + · simpa [F, P4366T1PrecursorRemainderFamily, hi] using cert.parent_lattice i s + +private theorem horiz_unique : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), (({x, x + 1} : Finset GaussianInt) = {y, + y + 1}) → (x = y) ) := by + classical + intro x y h + have hx : x = y ∨ x = y + 1 := by + have : x ∈ ({y, y + 1} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hy : y = x ∨ y = x + 1 := by + have : y ∈ ({x, x + 1} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hx with hxy | hxy + · exact hxy + rcases hy with hyx | hyx + · exact hyx.symm + · exfalso + have hre := congrArg Zsqrtd.re hxy + have hre' := congrArg Zsqrtd.re hyx + norm_num at hre hre' + omega + +private theorem vert_unique : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), (({x, x + (⟨0, 1⟩ : GaussianInt)} : Finset + GaussianInt) = + {y, y + ⟨0, 1⟩}) → (x = y) ) := by + classical + intro x y h + have hx : x = y ∨ x = y + ⟨0, 1⟩ := by + have : x ∈ ({y, y + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hy : y = x ∨ y = x + ⟨0, 1⟩ := by + have : y ∈ ({x, x + (⟨0, 1⟩ : GaussianInt)} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hx with hxy | hxy + · exact hxy + rcases hy with hyx | hyx + · exact hyx.symm + · exfalso + have him := congrArg Zsqrtd.im hxy + have him' := congrArg Zsqrtd.im hyx + simp at him him' + omega + +private theorem horiz_ne_vert : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), ({x, x + 1} : Finset GaussianInt) ≠ {y, + y + (⟨0, 1⟩ : GaussianInt)} ) := by + classical + intro x y h + have hx : x = y ∨ x = y + ⟨0, 1⟩ := by + have : x ∈ ({y, y + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hx1 : x + 1 = y ∨ x + 1 = y + ⟨0, 1⟩ := by + have : x + 1 ∈ ({y, y + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + rcases hx with h1 | h1 <;> rcases hx1 with h2 | h2 + all_goals + have hre := congrArg Zsqrtd.re h1 + have him := congrArg Zsqrtd.im h1 + have hre1 := congrArg Zsqrtd.re h2 + have him1 := congrArg Zsqrtd.im h2 + simp at hre him hre1 him1 + omega + +private theorem sharedEdge : + (by + classical + exact + ∀ (T : ProtoTile), (∀ (x : GaussianInt), ∀ (y : GaussianInt), (({x, x + 1} : Finset + GaussianInt) = {y, y + 1}) → (x = y)) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), + (({x, x + (⟨0, 1⟩ : GaussianInt)} : Finset GaussianInt) = {y, y + ⟨0, 1⟩}) → (x = y)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), ({x, x + 1} : Finset GaussianInt) ≠ {y, + y + (⟨0, 1⟩ : GaussianInt)}) → (∀ (A : ProtoTile), (A.cells ⊆ T.cells) → (∀ (e : + Finset GaussianInt), (e ∈ BoundaryFootprintEdges A) → ((e ∈ BoundaryFootprintEdges T) + → ((∃ z, e = {z, z + 1} ∧ ((z ∈ A.cells ∧ z ∈ T.cells ∧ z - ⟨0, 1⟩ ∉ T.cells) ∨ (z ∉ + A.cells ∧ z - ⟨0, 1⟩ ∈ A.cells ∧ z - ⟨0, 1⟩ ∈ T.cells ∧ z ∉ T.cells))) ∨ (∃ z, e = + {z, z + ⟨0, 1⟩} ∧ ((z ∈ A.cells ∧ z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ (z ∉ A.cells ∧ z - + 1 ∈ A.cells ∧ z - 1 ∈ T.cells ∧ z ∉ T.cells))))))))) ) := by + classical + intro T horiz_unique vert_unique horiz_ne_vert A hsub e heA heT + rcases heA with ⟨x, ⟨rfl, ha⟩ | ⟨rfl, ha⟩⟩ + · rcases heT with ⟨y, ⟨he, ht⟩ | ⟨he, ht⟩⟩ + · have hxy := horiz_unique x y he + subst y + rcases ha with ⟨hax, haxout⟩ | ⟨haxout, hax⟩ + · rcases ht with ⟨htx, htxout⟩ | ⟨htxout, htx⟩ + · exact Or.inl ⟨x, rfl, Or.inl ⟨hax, hsub hax, htxout⟩⟩ + · exact (htxout (hsub hax)).elim + · rcases ht with ⟨htx, htxout⟩ | ⟨htxout, htx⟩ + · exact (htxout (hsub hax)).elim + · exact Or.inl ⟨x, rfl, Or.inr ⟨(by + intro hxA + exact htxout (hsub hxA)), hax, hsub hax, htxout⟩⟩ + · exact (horiz_ne_vert x y he).elim + · rcases heT with ⟨y, ⟨he, ht⟩ | ⟨he, ht⟩⟩ + · exact (horiz_ne_vert y x he.symm).elim + · have hxy := vert_unique x y he + subst y + rcases ha with ⟨hax, haxout⟩ | ⟨haxout, hax⟩ + · rcases ht with ⟨htx, htxout⟩ | ⟨htxout, htx⟩ + · exact Or.inr ⟨x, rfl, Or.inl ⟨hax, hsub hax, htxout⟩⟩ + · exact (htxout (hsub hax)).elim + · rcases ht with ⟨htx, htxout⟩ | ⟨htxout, htx⟩ + · exact (htxout (hsub hax)).elim + · exact Or.inr ⟨x, rfl, Or.inr ⟨(by + intro hxA + exact htxout (hsub hxA)), hax, hsub hax, htxout⟩⟩ + +private theorem outerAttach : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), + let F := P4366T1PrecursorRemainderFamily cert.P cert.O + (∀ (z : GaussianInt), (z ∈ cert.O.cells) → (z - ⟨0, 1⟩ ∈ T.cells ∧ z + ⟨0, 1⟩ ∈ T.cells ∧ + z - 1 ∈ T.cells ∧ z + 1 ∈ T.cells)) → ((∀ (A : ProtoTile), (A.cells ⊆ T.cells) → (∀ + (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges A) → ((e ∈ + BoundaryFootprintEdges T) → ((∃ z, e = {z, z + 1} ∧ ((z ∈ A.cells ∧ z ∈ T.cells ∧ z - + ⟨0, 1⟩ ∉ T.cells) ∨ (z ∉ A.cells ∧ z - ⟨0, 1⟩ ∈ A.cells ∧ z - ⟨0, 1⟩ ∈ T.cells ∧ z ∉ + T.cells))) ∨ (∃ z, e = {z, z + ⟨0, 1⟩} ∧ ((z ∈ A.cells ∧ z ∈ T.cells ∧ z - 1 ∉ + T.cells) ∨ (z ∉ A.cells ∧ z - 1 ∈ A.cells ∧ z - 1 ∈ T.cells ∧ z ∉ T.cells))))))) → (∀ + (i : Fin 3), ∀ (s : Bool), ((cert.P i s).cells ⊆ T.cells) → ((∃ e : Finset GaussianInt, + e ∈ BoundaryFootprintEdges (cert.P i s) ∧ e ∈ BoundaryFootprintEdges T) → (∃ e : + Finset GaussianInt, e ∈ BoundaryFootprintEdges (F i s) ∧ e ∈ + BoundaryFootprintEdges T)))) ) := by + classical + intro C q cfg T cert F hneighbors sharedEdge i s hsub hcommon + by_cases hdel : i = 0 + · subst i + cases s + · obtain ⟨e, heA, heT⟩ := hcommon + have hshared := sharedEdge (cert.P 0 false) hsub e heA heT + rcases hshared with ⟨z, he, hs⟩ | ⟨z, he, hs⟩ + · rcases hs with ⟨hzA, hzT, hout⟩ | ⟨hznotA, hzinA, hzinT, houtT⟩ + · have hznotO : z ∉ cert.O.cells := by + intro hzO + exact hout (hneighbors z hzO).1 + have heF : e ∈ BoundaryFootprintEdges (F 0 false) := by + refine ⟨z, ?_⟩ + refine Or.inl ⟨he, Or.inl ⟨?_, ?_⟩⟩ + · change z ∈ (cert.P 0 false).cells \ cert.O.cells + exact Finset.mem_sdiff.mpr ⟨hzA, hznotO⟩ + · intro hzbad + exact hout (hsub (Finset.mem_sdiff.mp hzbad).1) + exact ⟨e, heF, heT⟩ + · have hznotO : z - ⟨0, 1⟩ ∉ cert.O.cells := by + intro hzO + have hn := (hneighbors (z - ⟨0, 1⟩) hzO).2.1 + exact houtT (by simpa using hn) + have heF : e ∈ BoundaryFootprintEdges (F 0 false) := by + refine ⟨z, ?_⟩ + refine Or.inl ⟨he, Or.inr ⟨?_, ?_⟩⟩ + · intro hzbad + exact hznotA (Finset.mem_sdiff.mp hzbad).1 + · change z - ⟨0, 1⟩ ∈ (cert.P 0 false).cells \ cert.O.cells + exact Finset.mem_sdiff.mpr ⟨hzinA, hznotO⟩ + exact ⟨e, heF, heT⟩ + · rcases hs with ⟨hzA, hzT, hout⟩ | ⟨hznotA, hzinA, hzinT, houtT⟩ + · have hznotO : z ∉ cert.O.cells := by + intro hzO + exact hout (hneighbors z hzO).2.2.1 + have heF : e ∈ BoundaryFootprintEdges (F 0 false) := by + refine ⟨z, ?_⟩ + refine Or.inr ⟨he, Or.inl ⟨?_, ?_⟩⟩ + · change z ∈ (cert.P 0 false).cells \ cert.O.cells + exact Finset.mem_sdiff.mpr ⟨hzA, hznotO⟩ + · intro hzbad + exact hout (hsub (Finset.mem_sdiff.mp hzbad).1) + exact ⟨e, heF, heT⟩ + · have hznotO : z - 1 ∉ cert.O.cells := by + intro hzO + have hn := (hneighbors (z - 1) hzO).2.2.2 + exact houtT (by simpa using hn) + have heF : e ∈ BoundaryFootprintEdges (F 0 false) := by + refine ⟨z, ?_⟩ + refine Or.inr ⟨he, Or.inr ⟨?_, ?_⟩⟩ + · intro hzbad + exact hznotA (Finset.mem_sdiff.mp hzbad).1 + · change z - 1 ∈ (cert.P 0 false).cells \ cert.O.cells + exact Finset.mem_sdiff.mpr ⟨hzinA, hznotO⟩ + exact ⟨e, heF, heT⟩ + · obtain ⟨e, heA, heT⟩ := hcommon + have hshared := sharedEdge (cert.P 0 true) hsub e heA heT + rcases hshared with ⟨z, he, hs⟩ | ⟨z, he, hs⟩ + · rcases hs with ⟨hzA, hzT, hout⟩ | ⟨hznotA, hzinA, hzinT, houtT⟩ + · have hznotO : z ∉ cert.O.cells := by + intro hzO + exact hout (hneighbors z hzO).1 + have heF : e ∈ BoundaryFootprintEdges (F 0 true) := by + refine ⟨z, ?_⟩ + refine Or.inl ⟨he, Or.inl ⟨?_, ?_⟩⟩ + · change z ∈ (cert.P 0 true).cells \ cert.O.cells + exact Finset.mem_sdiff.mpr ⟨hzA, hznotO⟩ + · intro hzbad + exact hout (hsub (Finset.mem_sdiff.mp hzbad).1) + exact ⟨e, heF, heT⟩ + · have hznotO : z - ⟨0, 1⟩ ∉ cert.O.cells := by + intro hzO + have hn := (hneighbors (z - ⟨0, 1⟩) hzO).2.1 + exact houtT (by simpa using hn) + have heF : e ∈ BoundaryFootprintEdges (F 0 true) := by + refine ⟨z, ?_⟩ + refine Or.inl ⟨he, Or.inr ⟨?_, ?_⟩⟩ + · intro hzbad + exact hznotA (Finset.mem_sdiff.mp hzbad).1 + · change z - ⟨0, 1⟩ ∈ (cert.P 0 true).cells \ cert.O.cells + exact Finset.mem_sdiff.mpr ⟨hzinA, hznotO⟩ + exact ⟨e, heF, heT⟩ + · rcases hs with ⟨hzA, hzT, hout⟩ | ⟨hznotA, hzinA, hzinT, houtT⟩ + · have hznotO : z ∉ cert.O.cells := by + intro hzO + exact hout (hneighbors z hzO).2.2.1 + have heF : e ∈ BoundaryFootprintEdges (F 0 true) := by + refine ⟨z, ?_⟩ + refine Or.inr ⟨he, Or.inl ⟨?_, ?_⟩⟩ + · change z ∈ (cert.P 0 true).cells \ cert.O.cells + exact Finset.mem_sdiff.mpr ⟨hzA, hznotO⟩ + · intro hzbad + exact hout (hsub (Finset.mem_sdiff.mp hzbad).1) + exact ⟨e, heF, heT⟩ + · have hznotO : z - 1 ∉ cert.O.cells := by + intro hzO + have hn := (hneighbors (z - 1) hzO).2.2.2 + exact houtT (by simpa using hn) + have heF : e ∈ BoundaryFootprintEdges (F 0 true) := by + refine ⟨z, ?_⟩ + refine Or.inr ⟨he, Or.inr ⟨?_, ?_⟩⟩ + · intro hzbad + exact hznotA (Finset.mem_sdiff.mp hzbad).1 + · change z - 1 ∈ (cert.P 0 true).cells \ cert.O.cells + exact Finset.mem_sdiff.mpr ⟨hzinA, hznotO⟩ + exact ⟨e, heF, heT⟩ + · have h := hcommon + simpa [F, P4366T1PrecursorRemainderFamily, hdel] using h + +end RemainderAttachmentGeometry + +theorem P4366T1RemainderOuterAttachments : + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), (cert.O.cells.Nonempty) → ((LatticeTile + cert.O) → ((∀ i, ∀ s, ∃ e : Finset GaussianInt, + e ∈ BoundaryFootprintEdges (cert.P i s) ∧ + e ∈ BoundaryFootprintEdges T) → ( + let F := P4366T1PrecursorRemainderFamily cert.P cert.O + (∀ i, ∀ s, LatticeTile (F i s)) ∧ + (∀ z, z ∈ T.cells ∧ z ∉ cert.O.cells ↔ + ∃ i s, z ∈ (F i s).cells) ∧ + (∀ i, ∀ s, ∃ e : Finset GaussianInt, + e ∈ BoundaryFootprintEdges (F i s) ∧ + e ∈ BoundaryFootprintEdges T)))) := by + intro C q cfg T cert hO hOdisk hattach +-- BODY + classical + dsimp only + let F := P4366T1PrecursorRemainderFamily cert.P cert.O + have zero_translation (U : ProtoTile) : TileTranslation U 0 = U := + RemainderAttachmentGeometry.zero_translation U + have isolated {x a : GaussianInt} + (hx : x ∈ FootprintVertices cert.O) + (hxa : x = a ∨ x = a + 1 ∨ x = a + ⟨0, 1⟩ ∨ + x = a + 1 + ⟨0, 1⟩) : a ∈ T.cells := RemainderAttachmentGeometry.isolated C q cfg T cert + zero_translation (x := x) (a := a) hx hxa + have corner (z : GaussianInt) + (hx : z ∈ cert.O.cells) (x : GaussianInt) + (hxa : x = z ∨ x = z + 1 ∨ x = z + ⟨0, 1⟩ ∨ + x = z + 1 + ⟨0, 1⟩) : x ∈ FootprintVertices cert.O := RemainderAttachmentGeometry.corner + C q cfg T cert z hx x hxa + have hneighbors (z : GaussianInt) (hz : z ∈ cert.O.cells) : + z - ⟨0, 1⟩ ∈ T.cells ∧ z + ⟨0, 1⟩ ∈ T.cells ∧ + z - 1 ∈ T.cells ∧ z + 1 ∈ T.cells := RemainderAttachmentGeometry.hneighbors C q cfg T + cert isolated corner z hz + have hOsubA : cert.O.cells ⊆ (cert.P 0 true).cells := RemainderAttachmentGeometry.hOsubA C q + cfg T cert + have hOsubB : cert.O.cells ⊆ (cert.P 0 false).cells := RemainderAttachmentGeometry.hOsubB C q + cfg T cert + have hpair := (P4339T1PrecursorSupportGeometry C q cfg T cert).2.2.2.2.2.2.1 + have hdisjoint := (P4339T1PrecursorSupportGeometry C q cfg T cert).2.2.2.2.2.2.2 + have hcover : ∀ z, z ∈ T.cells ∧ z ∉ cert.O.cells ↔ + ∃ i s, z ∈ (F i s).cells := RemainderAttachmentGeometry.hcover C q cfg T cert hOsubA hdisjoint + have hLattice : ∀ i s, LatticeTile (F i s) := RemainderAttachmentGeometry.hLattice C q cfg T cert + have horiz_unique (x y : GaussianInt) + (h : ({x, x + 1} : Finset GaussianInt) = {y, y + 1}) : x = y := + RemainderAttachmentGeometry.horiz_unique x y h + have vert_unique (x y : GaussianInt) + (h : ({x, x + (⟨0, 1⟩ : GaussianInt)} : Finset GaussianInt) = + {y, y + ⟨0, 1⟩}) : x = y := RemainderAttachmentGeometry.vert_unique x y h + have horiz_ne_vert (x y : GaussianInt) : + ({x, x + 1} : Finset GaussianInt) ≠ {y, y + (⟨0, 1⟩ : GaussianInt)} := + RemainderAttachmentGeometry.horiz_ne_vert x y + have sharedEdge (A : ProtoTile) + (hsub : A.cells ⊆ T.cells) (e : Finset GaussianInt) + (heA : e ∈ BoundaryFootprintEdges A) (heT : e ∈ BoundaryFootprintEdges T) : + (∃ z, e = {z, z + 1} ∧ + ((z ∈ A.cells ∧ z ∈ T.cells ∧ z - ⟨0, 1⟩ ∉ T.cells) ∨ + (z ∉ A.cells ∧ z - ⟨0, 1⟩ ∈ A.cells ∧ + z - ⟨0, 1⟩ ∈ T.cells ∧ z ∉ T.cells))) ∨ + (∃ z, e = {z, z + ⟨0, 1⟩} ∧ + ((z ∈ A.cells ∧ z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ + (z ∉ A.cells ∧ z - 1 ∈ A.cells ∧ z - 1 ∈ T.cells ∧ z ∉ T.cells))) := + RemainderAttachmentGeometry.sharedEdge T horiz_unique vert_unique horiz_ne_vert A + hsub e heA heT + have outerAttach (i : Fin 3) (s : Bool) + (hsub : (cert.P i s).cells ⊆ T.cells) + (hcommon : ∃ e : Finset GaussianInt, + e ∈ BoundaryFootprintEdges (cert.P i s) ∧ e ∈ BoundaryFootprintEdges T) : + ∃ e : Finset GaussianInt, + e ∈ BoundaryFootprintEdges (F i s) ∧ e ∈ BoundaryFootprintEdges T := + RemainderAttachmentGeometry.outerAttach C q cfg T cert hneighbors sharedEdge i s hsub + hcommon + refine ⟨hLattice, hcover, ?_⟩ + intro i s + by_cases hi : i = 0 + · subst i + cases s + · exact outerAttach 0 false (by + intro z hz + exact (cert.outer_union z).mpr ⟨0, false, hz⟩) (hattach 0 false) + · exact outerAttach 0 true (by + intro z hz + exact (cert.outer_union z).mpr ⟨0, true, hz⟩) (hattach 0 true) + · exact outerAttach i s (by + intro z hz + exact (cert.outer_union z).mpr ⟨i, s, hz⟩) (hattach i s) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean new file mode 100644 index 0000000000..8b21b7dd68 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean @@ -0,0 +1,1992 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.P5635T1EndpointDiagonalOwnership +public import LeanPool.ApollonianSuperharmonic.AffineTriangularNoFourfoldCellOwners +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleLatticeTouching +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.P4158T1AncestorCells +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge +public import LeanPool.ApollonianSuperharmonic.TileString +public import LeanPool.ApollonianSuperharmonic.P4431T1OwnerTransitionSelector + +-- [TABLET NODE: P4366T2LocalSectors] + +/-! +# P4366T2LocalSectors + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace LocalSectorGeometry + +private theorem regular_index : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (base : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice + Ci)), (∀ (u : ↥(TilingLattice Ci)), P.tile u = TileTranslation base (↑u : + GaussianInt)) → (∀ (W : ProtoTile), (W ∈ RegularTileFamily base (TilingLattice Ci)) → + (∃ a : TilingLattice Ci, P.tile a = W)) ) := by + classical + intro Ci base P htiles W hW + change ∃ v ∈ TilingLattice Ci, W = TileTranslation base v at hW + rcases hW with ⟨v, hv, hW⟩ + refine ⟨⟨v, hv⟩, ?_⟩ + calc + P.tile ⟨v, hv⟩ = TileTranslation base v := htiles ⟨v, hv⟩ + _ = W := hW.symm + +private theorem htiles_lattice : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (base : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple q) → ((BandPrototile (q 0) base) → (∀ (P : PeriodicTileComplex + ↥(TilingLattice Ci)), (∀ (u : ↥(TilingLattice Ci)), P.tile u = TileTranslation base + (↑u : GaussianInt)) → (∀ (a : TilingLattice Ci), LatticeTile (P.tile a)))) ) := by + classical + intro Ci base q hproper hbase' P htiles a + rw [htiles] + exact (TileDiskAreaCovariance base (a : GaussianInt)).1.mp + (BandTileSimultaneousInduction q hproper base hbase').1 + +private theorem neighbor_ne_center : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + ∀ (x : GaussianInt), ∀ (j : Fin 4), neighbor x j ≠ x ) := by + classical + intro neighbor x j + fin_cases j <;> simp [neighbor, Zsqrtd.ext_iff] + +private theorem neighbor_injective : + (by + classical + exact + ∀ (Ci : BandCircle), (List GaussianInt) → ((PeriodicTileComplex ↥(TilingLattice Ci)) → ( + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + ∀ (x : GaussianInt), ∀ {j : Fin 4}, ∀ {k : Fin 4}, (neighbor x j = neighbor x k) → (j = + k))) ) := by + classical + intro Ci path P neighbor x j k h + fin_cases j <;> fin_cases k <;> + simp [neighbor, Zsqrtd.ext_iff] at h ⊢ <;> omega + +private theorem edgeAt_mem : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + ∀ (x : GaussianInt), ∀ (j : Fin 4), x ∈ edgeAt x j ∧ neighbor x j ∈ edgeAt x j ) := by + classical + intro neighbor edgeAt x j + fin_cases j <;> simp [neighbor, edgeAt] + +private theorem edgeAt_eq_pair : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + ∀ (x : GaussianInt), ∀ (j : Fin 4), edgeAt x j = {x, neighbor x j} ) := by + classical + intro neighbor edgeAt x j + fin_cases j <;> simp [edgeAt, neighbor, Finset.pair_comm] + +private theorem edgeAt_injective : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (x : GaussianInt), ∀ (j : Fin 4), neighbor x j ≠ x) → ((∀ (x : GaussianInt), ∀ + {j : Fin 4}, ∀ {k : Fin 4}, (neighbor x j = neighbor x k) → (j = k)) → ((∀ (x : + GaussianInt), ∀ (j : Fin 4), x ∈ edgeAt x j ∧ neighbor x j ∈ edgeAt x j) → (∀ (x : + GaussianInt), ∀ {j : Fin 4}, ∀ {k : Fin 4}, (edgeAt x j = edgeAt x k) → (j = k)))) ) + := by + classical + intro neighbor edgeAt neighbor_ne_center neighbor_injective edgeAt_mem x j k h + have hx := (edgeAt_mem x j).1 + have hn := (edgeAt_mem x j).2 + have hnm : neighbor x j ∈ edgeAt x k := by rw [← h]; exact hn + have hchoices : neighbor x j = x ∨ neighbor x j = neighbor x k := by + fin_cases k + · simpa [edgeAt, neighbor] using hnm + · have hh : neighbor x j = x - 1 ∨ neighbor x j = x := by + simpa [edgeAt, neighbor] using hnm + exact Or.symm hh + · have hh : neighbor x j = x - ⟨0, 1⟩ ∨ neighbor x j = x := by + simpa [edgeAt, neighbor] using hnm + exact Or.symm hh + · simpa [edgeAt, neighbor] using hnm + exact neighbor_injective x (hchoices.resolve_left (neighbor_ne_center x j)) + +private theorem edge_of_sector_cell : + (by + classical + exact + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + ∀ (R : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ + R.cells ∨ + LatticeVertexIncidentCell x (j + 1) ∈ R.cells) → (edgeAt x j ∈ FootprintEdges R) ) := by + classical + intro edgeAt R x j hc + fin_cases j + · rcases hc with h | h + · simpa [edgeAt] using + (show {x, x + ⟨0, 1⟩} ∈ FootprintEdges R from + ⟨x, by simpa [LatticeVertexIncidentCell] using h, + Or.inr (Or.inl rfl)⟩) + · simpa [edgeAt] using + (show {x, x + ⟨0, 1⟩} ∈ FootprintEdges R from + ⟨x - 1, by simpa [LatticeVertexIncidentCell] using h, + Or.inr (Or.inr (Or.inl (by simp [sub_eq_add_neg, + add_comm, add_left_comm])))⟩) + · rcases hc with h | h + · simpa [edgeAt] using + (show {x - 1, x} ∈ FootprintEdges R from + ⟨x - 1, by simpa [LatticeVertexIncidentCell] using h, + Or.inl (by simp [sub_eq_add_neg, add_comm, + add_left_comm])⟩) + · simpa [edgeAt] using + (show {x - 1, x} ∈ FootprintEdges R from + ⟨x - 1 - ⟨0, 1⟩, by simpa [LatticeVertexIncidentCell] using h, + Or.inr (Or.inr (Or.inr (by simp [sub_eq_add_neg, + add_comm, add_left_comm, add_assoc])))⟩) + · rcases hc with h | h + · simpa [edgeAt] using + (show {x - ⟨0, 1⟩, x} ∈ FootprintEdges R from + ⟨x - 1 - ⟨0, 1⟩, by + simpa [LatticeVertexIncidentCell] using h, + Or.inr (Or.inr (Or.inl (by simp [sub_eq_add_neg, + add_comm, add_left_comm, add_assoc])))⟩) + · simpa [edgeAt] using + (show {x - ⟨0, 1⟩, x} ∈ FootprintEdges R from + ⟨x - ⟨0, 1⟩, by + simpa [LatticeVertexIncidentCell] using h, + Or.inr (Or.inl (by simp []))⟩) + · rcases hc with h | h + · simpa [edgeAt] using + (show {x, x + 1} ∈ FootprintEdges R from + ⟨x - ⟨0, 1⟩, by simpa [LatticeVertexIncidentCell] using h, + Or.inr (Or.inr (Or.inr (by simp [sub_eq_add_neg, + add_comm, add_left_comm])))⟩) + · simpa [edgeAt] using + (show {x, x + 1} ∈ FootprintEdges R from + ⟨x, by + simpa [LatticeVertexIncidentCell] using h, + Or.inl rfl⟩) + +private theorem label_T0 : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → + (outerLabel x j = 0) ) := by + classical + intro T0 T0' outerLabel x j hc + simp [outerLabel, hc] + +private theorem label_T0' : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), (Disjoint T0.cells T0'.cells) → ( + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0'.cells) → + (outerLabel x j = 1)) ) := by + classical + intro T0 T0' hdis outerLabel x j hc + have hn : LatticeVertexIncidentCell x j ∉ T0.cells := + Finset.disjoint_left.mp hdis.symm hc + simp [outerLabel, hn, hc] + +private theorem forward_index : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (base : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (hs : List + PartialOdometer), (∀ T ∈ tiles, T ∈ RegularTileFamily base (TilingLattice Ci)) → (∀ + (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (W : ProtoTile), (W ∈ + RegularTileFamily base (TilingLattice Ci)) → (∃ a : TilingLattice Ci, P.tile a = W)) + → (∀ (U : ProtoTile), ∀ (g : PartialOdometer), ((U, g) ∈ tiles.zip hs) → (∃ a : + TilingLattice Ci, P.tile a = U))) ) := by + classical + intro Ci base tiles hs hfamily P regular_index U g hzip + apply regular_index + exact hfamily U (List.of_mem_zip hzip).1 + +private theorem reverse_index : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (base : ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ + (reverseHs : List PartialOdometer), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), + (∀ (W : ProtoTile), (W ∈ RegularTileFamily base (TilingLattice Ci)) → (∃ a : + TilingLattice Ci, P.tile a = W)) → ((∀ T ∈ reverseTiles, T ∈ RegularTileFamily base + (TilingLattice Ci)) → (∀ (V : ProtoTile), ∀ (k : PartialOdometer), ((V, k) ∈ + reverseTiles.zip reverseHs) → (∃ a : TilingLattice Ci, P.tile a = V))) ) := by + classical + intro Ci base reverseTiles reverseHs P regular_index hfamilyR V k hzip + apply regular_index + exact hfamilyR V (List.of_mem_zip hzip).1 + +private theorem index_eq_of_tile_eq : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (a : + TilingLattice Ci), LatticeTile (P.tile a)) → (∀ (a : TilingLattice Ci), ∀ (b : + TilingLattice Ci), (P.tile a = P.tile b) → (a = b)) ) := by + classical + intro Ci P htiles_lattice a b h + obtain ⟨c, hc⟩ := (LatticeTileGridStructure (P.tile a) + (htiles_lattice a)).1.1 + exact (PeriodicTileIndexedMultiplicityOne P c).unique hc (by simpa [h] using hc) + +private theorem owner_mem_iff : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + (∀ (c : GaussianInt), c ∈ (P.tile (owner c)).cells) → ((∀ (c : GaussianInt), ∀ (a : + TilingLattice Ci), (c ∈ (P.tile a).cells) → (owner c = a)) → (∀ (c : GaussianInt), ∀ + (a : TilingLattice Ci), c ∈ (P.tile a).cells ↔ owner c = a)) ) := by + classical + intro Ci P owner owner_cell owner_unique c a + constructor + · exact owner_unique c a + · intro h + simpa [h] using owner_cell c + +private theorem owner_eq_tile : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + (∀ (c : GaussianInt), ∀ (a : TilingLattice Ci), (c ∈ (P.tile a).cells) → (owner c = a)) → + (∀ (c : GaussianInt), ∀ (a : TilingLattice Ci), ∀ (T : ProtoTile), (P.tile a = T) → + ((c ∈ T.cells) → (owner c = a))) ) := by + classical + intro Ci P owner owner_unique c a T hPT hc + apply owner_unique + simpa [hPT] using hc + +private theorem no_fourfold : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (base : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (P + : PeriodicTileComplex ↥(TilingLattice Ci)), ∀ [ Nonempty + (AffineTriangularComplexChart P fun (mn : ℤ × ℤ) => TileTranslation base ((↑mn.1 : + GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑mn.2 : + GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))))], + ∀ (x : GaussianInt), ∀ (a0 : TilingLattice Ci), ∀ (a1 : TilingLattice Ci), ∀ (a2 : + TilingLattice Ci), ∀ (a3 : TilingLattice Ci), (x ∈ (P.tile a0).cells) → ((x - 1 ∈ + (P.tile a1).cells) → ((x - 1 - ⟨0, 1⟩ ∈ (P.tile a2).cells) → ((x - ⟨0, 1⟩ ∈ (P.tile + a3).cells) → (a0 = a1 ∨ a0 = a2 ∨ a0 = a3 ∨ a1 = a2 ∨ a1 = a3 ∨ a2 = a3)))) ) := by + classical + intro Ci base q P hchart x a0 a1 a2 a3 h0 h1 h2 h3 + let tileAt : Int × Int → ProtoTile := fun mn => TileTranslation base + ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (mn.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) + let chart : AffineTriangularComplexChart P tileAt := Classical.choice hchart + exact AffineTriangularNoFourfoldCellOwners P tileAt chart x a0 a1 a2 a3 + h0 h1 h2 h3 + +private theorem owner_no_fourfold : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + (∀ (c : GaussianInt), c ∈ (P.tile (owner c)).cells) → ((∀ (x : GaussianInt), ∀ (a0 : + TilingLattice Ci), ∀ (a1 : TilingLattice Ci), ∀ (a2 : TilingLattice Ci), ∀ (a3 : + TilingLattice Ci), (x ∈ (P.tile a0).cells) → ((x - 1 ∈ (P.tile a1).cells) → ((x - 1 - + ⟨0, 1⟩ ∈ (P.tile a2).cells) → ((x - ⟨0, 1⟩ ∈ (P.tile a3).cells) → (a0 = a1 ∨ a0 = a2 + ∨ a0 = a3 ∨ a1 = a2 ∨ a1 = a3 ∨ a2 = a3))))) → (∀ (x : GaussianInt), owner + (LatticeVertexIncidentCell x 0) = owner (LatticeVertexIncidentCell x 1) ∨ owner + (LatticeVertexIncidentCell x 0) = owner (LatticeVertexIncidentCell x 2) ∨ owner + (LatticeVertexIncidentCell x 0) = owner (LatticeVertexIncidentCell x 3) ∨ owner + (LatticeVertexIncidentCell x 1) = owner (LatticeVertexIncidentCell x 2) ∨ owner + (LatticeVertexIncidentCell x 1) = owner (LatticeVertexIncidentCell x 3) ∨ owner + (LatticeVertexIncidentCell x 2) = owner (LatticeVertexIncidentCell x 3))) ) := by + classical + intro Ci P owner owner_cell no_fourfold x + have h := no_fourfold x (owner (LatticeVertexIncidentCell x 0)) + (owner (LatticeVertexIncidentCell x 1)) + (owner (LatticeVertexIncidentCell x 2)) + (owner (LatticeVertexIncidentCell x 3)) + (owner_cell _) (by simpa [LatticeVertexIncidentCell] using owner_cell (x - 1)) + (by simpa [LatticeVertexIncidentCell] using + owner_cell (x - 1 - ⟨0, 1⟩)) + (by simpa [LatticeVertexIncidentCell] using owner_cell (x - ⟨0, 1⟩)) + simpa [LatticeVertexIncidentCell] using h + +private theorem owner_no_checkerboard : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (a : + TilingLattice Ci), LatticeTile (P.tile a)) → ( + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + (∀ (c : GaussianInt), ∀ (a : TilingLattice Ci), c ∈ (P.tile a).cells ↔ owner c = a) → (∀ + (x : GaussianInt), ∀ (a : TilingLattice Ci), ¬ ((owner (LatticeVertexIncidentCell x + 0) = a ∧ owner (LatticeVertexIncidentCell x 2) = a ∧ owner (LatticeVertexIncidentCell + x 1) ≠ a ∧ owner (LatticeVertexIncidentCell x 3) ≠ a) ∨ (owner + (LatticeVertexIncidentCell x 1) = a ∧ owner (LatticeVertexIncidentCell x 3) = a ∧ + owner (LatticeVertexIncidentCell x 0) ≠ a ∧ owner (LatticeVertexIncidentCell x 2) ≠ + a)))) ) := by + classical + intro Ci P htiles_lattice owner owner_mem_iff x a + have hcheck := (LatticeTileGridStructure (P.tile a) (htiles_lattice a)).2.1 x + simpa [LatticeVertexIncidentCell, owner_mem_iff] using hcheck + +private theorem cross_ne : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), (Disjoint T0.cells + T0'.cells) → (∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (a : TilingLattice + Ci), LatticeTile (P.tile a)) → (∀ (a : TilingLattice Ci), ∀ (b : TilingLattice Ci), + ((P.tile a).cells ⊆ T0.cells) → (((P.tile b).cells ⊆ T0'.cells) → (a ≠ b)))) ) := by + classical + intro Ci T0 T0' hdis P htiles_lattice a b ha hb hab + subst b + obtain ⟨c, hc⟩ := (LatticeTileGridStructure (P.tile a) + (htiles_lattice a)).1.1 + exact (Finset.disjoint_left.mp hdis) (ha hc) (hb hc) + +private theorem indexed_edge_witnesses : + (by + classical + exact + ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (h0 + : PartialOdometer), ∀ (h0' : PartialOdometer), ∀ (tiles : List ProtoTile), ∀ + (reverseTiles : List ProtoTile), ∀ (hs : List PartialOdometer), ∀ (reverseHs : List + PartialOdometer), (Disjoint T0.cells T0'.cells) → (∀ (path : List GaussianInt), (∀ (a + : GaussianInt), ∀ (b : GaussianInt), ∀ (l : List GaussianInt), ∀ (r : List + GaussianInt), path = l ++ a :: b :: r → (∃ (U : ProtoTile) (g : PartialOdometer), U ∈ + (List.drop (1 : ℕ) tiles).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ {a, b} ∈ FootprintEdges + U ∧ AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0) ∧ ∃ (V : ProtoTile) (k : + PartialOdometer), V ∈ (List.drop (1 : ℕ) reverseTiles).dropLast ∧ (V, k) ∈ + reverseTiles.zip reverseHs ∧ {a, b} ∈ FootprintEdges V ∧ AncestorOdometer Ci.1.1 + C0.1.1 V T0' k h0') → (∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (a : + TilingLattice Ci), LatticeTile (P.tile a)) → ((∀ (U : ProtoTile), ∀ (g : + PartialOdometer), ((U, g) ∈ tiles.zip hs) → (∃ a : TilingLattice Ci, P.tile a = U)) → + ((∀ (V : ProtoTile), ∀ (k : PartialOdometer), ((V, k) ∈ reverseTiles.zip reverseHs) → + (∃ a : TilingLattice Ci, P.tile a = V)) → ((∀ (U : ProtoTile), ∀ (T : ProtoTile), ∀ + (g : PartialOdometer), ∀ (h : PartialOdometer), (AncestorOdometer Ci.1.1 C0.1.1 U T g + h) → (U.cells ⊆ T.cells)) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l : List + GaussianInt), ∀ (r : List GaussianInt), (path = l ++ a :: b :: r) → (∃ U V : + ProtoTile, ∃ g k : PartialOdometer, ∃ ia ib : TilingLattice Ci, U ∈ (tiles.drop + 1).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ {a, b} ∈ FootprintEdges U ∧ AncestorOdometer + Ci.1.1 C0.1.1 U T0 g h0 ∧ V ∈ (reverseTiles.drop 1).dropLast ∧ (V, k) ∈ + reverseTiles.zip reverseHs ∧ {a, b} ∈ FootprintEdges V ∧ AncestorOdometer Ci.1.1 + C0.1.1 V T0' k h0' ∧ P.tile ia = U ∧ P.tile ib = V ∧ ia ≠ ib))))))) ) := by + classical + intro C0 Ci T0 T0' h0 h0' tiles reverseTiles hs reverseHs hdis path hedges P htiles_lattice + forward_index reverse_index ancestor_cells a b l r hpathEdge + rcases hedges a b l r hpathEdge with ⟨hfwd, hrev⟩ + rcases hfwd with ⟨U, g, hUint, hzip, hedgeU, hancU⟩ + rcases hrev with ⟨V, k, hVint, hzip', hedgeV, hancV⟩ + obtain ⟨ia, hia⟩ := forward_index U g hzip + obtain ⟨ib, hib⟩ := reverse_index V k hzip' + have hsubU : (P.tile ia).cells ⊆ T0.cells := by + rw [hia] + exact ancestor_cells U T0 g h0 hancU + have hsubV : (P.tile ib).cells ⊆ T0'.cells := by + rw [hib] + exact ancestor_cells V T0' k h0' hancV + have hne : ia ≠ ib := by + intro heq + subst ib + obtain ⟨c, hc⟩ := (LatticeTileGridStructure (P.tile ia) + (htiles_lattice ia)).1.1 + exact (Finset.disjoint_left.mp hdis) (hsubU hc) (hsubV hc) + exact ⟨U, V, g, k, ia, ib, hUint, hzip, hedgeU, hancU, + hVint, hzip', hedgeV, hancV, hia, hib, hne⟩ + +private theorem indexed_transition : + (by + classical + exact + ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (h0 + : PartialOdometer), ∀ (h0' : PartialOdometer), ∀ (tiles : List ProtoTile), ∀ + (reverseTiles : List ProtoTile), ∀ (hs : List PartialOdometer), ∀ (reverseHs : List + PartialOdometer), (Disjoint T0.cells T0'.cells) → (∀ (path : List GaussianInt), ∀ (P + : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (U : ProtoTile), ∀ (T : ProtoTile), ∀ + (g : PartialOdometer), ∀ (h : PartialOdometer), (AncestorOdometer Ci.1.1 C0.1.1 U T g + h) → (U.cells ⊆ T.cells)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l : List + GaussianInt), ∀ (r : List GaussianInt), (path = l ++ a :: b :: r) → (∃ U V : + ProtoTile, ∃ g k : PartialOdometer, ∃ ia ib : TilingLattice Ci, U ∈ (tiles.drop + 1).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ {a, b} ∈ FootprintEdges U ∧ AncestorOdometer + Ci.1.1 C0.1.1 U T0 g h0 ∧ V ∈ (reverseTiles.drop 1).dropLast ∧ (V, k) ∈ + reverseTiles.zip reverseHs ∧ {a, b} ∈ FootprintEdges V ∧ AncestorOdometer Ci.1.1 + C0.1.1 V T0' k h0' ∧ P.tile ia = U ∧ P.tile ib = V ∧ ia ≠ ib)) → (∀ (a : + GaussianInt), ∀ (b : GaussianInt), ∀ (x : GaussianInt), ∀ (l : List GaussianInt), ∀ + (r : List GaussianInt), (path = l ++ a :: b :: r) → ((x = a ∨ x = b) → (∃ U V : + ProtoTile, ∃ g k : PartialOdometer, ∃ ia ib : TilingLattice Ci, ∃ j : Fin 4, ({a, b} + : Finset GaussianInt) = ![{x, x + ⟨0, 1⟩}, {x - 1, x}, {x - ⟨0, 1⟩, x}, {x, x + 1}] j + ∧ U ∈ (tiles.drop 1).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ {a, b} ∈ FootprintEdges U ∧ + AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0 ∧ V ∈ (reverseTiles.drop 1).dropLast ∧ (V, + k) ∈ reverseTiles.zip reverseHs ∧ {a, b} ∈ FootprintEdges V ∧ AncestorOdometer Ci.1.1 + C0.1.1 V T0' k h0' ∧ P.tile ia = U ∧ P.tile ib = V ∧ ia ≠ ib ∧ + (LatticeVertexIncidentCell x j ∈ (P.tile ia).cells ∧ LatticeVertexIncidentCell x (j + + 1) ∈ (P.tile ib).cells ∨ LatticeVertexIncidentCell x j ∈ (P.tile ib).cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ (P.tile ia).cells)))))) ) := by + classical + intro C0 Ci T0 T0' h0 h0' tiles reverseTiles hs reverseHs hdis path P ancestor_cells + indexed_edge_witnesses a b x l r hpathEdge hxedge + obtain ⟨U, V, g, k, ia, ib, hUint, hzip, hedgeU, hancU, + hVint, hzip', hedgeV, hancV, hia, hib, hne⟩ := + indexed_edge_witnesses a b l r hpathEdge + have hsubU : U.cells ⊆ T0.cells := ancestor_cells U T0 g h0 hancU + have hsubV : V.cells ⊆ T0'.cells := ancestor_cells V T0' k h0' hancV + have hdisUV : Disjoint U.cells V.cells := by + apply Finset.disjoint_left.mpr + intro c hcU hcV + exact (Finset.disjoint_left.mp hdis) (hsubU hcU) (hsubV hcV) + have hxe : x ∈ ({a, b} : Finset GaussianInt) := by + rcases hxedge with rfl | rfl <;> simp + obtain ⟨j, hje, htransition⟩ := P3102T2CommonEdgeSectorTransition + U V x {a, b} hdisUV hxe ⟨hedgeU, hedgeV⟩ + rcases htransition with htransition | htransition + · exact ⟨U, V, g, k, ia, ib, j, hje, hUint, hzip, hedgeU, hancU, + hVint, hzip', hedgeV, hancV, hia, hib, hne, + Or.inl ⟨by simpa [hia] using htransition.1, + by simpa [hib] using htransition.2⟩⟩ + · exact ⟨U, V, g, k, ia, ib, j, hje, hUint, hzip, hedgeU, hancU, + hVint, hzip', hedgeV, hancV, hia, hib, hne, + Or.inr ⟨by simpa [hib] using htransition.1, + by simpa [hia] using htransition.2⟩⟩ + +private theorem first_edge_unique : + (by + classical + exact + ∀ (p : List GaussianInt), (p.Nodup) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (rest + : List GaussianInt), (p = x :: y :: rest) → (∀ (e : Finset GaussianInt), (∃ a b : + GaussianInt, ∃ l r : List GaussianInt, + p = l ++ a :: b :: r ∧ e = {a, b}) → ((x ∈ e) → (e = {x, y})))) ) := by + classical + intro p hpNodup x y rest hpath e he hxe + rcases he with ⟨a, b, l, r, hdecomp, heq⟩ + have hmem : x ∈ ({a, b} : Finset GaussianInt) := by simpa [heq] using hxe + have hcases : x = a ∨ x = b := by simpa using hmem + have hsub : [a, b] <:+: p := by + refine ⟨l, r, ?_⟩ + simpa [List.cons_append] using hdecomp.symm + have hne : p ≠ [] := by rw [hpath]; simp + have hhead? : p.head? = some x := by rw [hpath]; simp + have hhead : p.head hne = x := by + simpa [List.head?_eq_some_head hne] using hhead? + have hheadmem : p.head hne ∈ [a, b] := by + rcases hcases with hxa | hxb + · simp [hhead, hxa] + · simp [hhead, hxb] + have hprefix : [a, b] <+: p := + hpNodup.prefix_of_head_mem_of_infix hsub hheadmem + rcases hprefix with ⟨tail, htail⟩ + have hab : p = [a, b] ++ tail := htail.symm + have hform : x :: y :: rest = a :: b :: tail := by + calc + x :: y :: rest = p := hpath.symm + _ = [a, b] ++ tail := hab + _ = a :: b :: tail := rfl + have hxa : x = a := by injection hform + have hyb : y = b := by + have htailEq : y :: rest = b :: tail := by injection hform + injection htailEq + simp [heq, hxa, hyb] + +private theorem reverse_edge_decomp : + (by + classical + exact + ∀ (p : List GaussianInt), ∀ (e : Finset GaussianInt), (∃ a b : GaussianInt, ∃ l r : List + GaussianInt, + p = l ++ a :: b :: r ∧ e = {a, b}) → (∃ a b : GaussianInt, ∃ l r : List GaussianInt, + p.reverse = l ++ a :: b :: r ∧ e = {a, b}) ) := by + classical + intro p e he + rcases he with ⟨a, b, l, r, hdecomp, heq⟩ + refine ⟨b, a, r.reverse, l.reverse, ?_, ?_⟩ + · rw [hdecomp] + simp [List.reverse_append, List.append_assoc] + · simpa [Finset.pair_comm] using heq + +private theorem last_edge_unique : + (by + classical + exact + (∀ (p : List GaussianInt), (p.Nodup) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (rest + : List GaussianInt), (p = x :: y :: rest) → (∀ (e : Finset GaussianInt), (∃ a b : + GaussianInt, ∃ l r : List GaussianInt, p = l ++ a :: b :: r ∧ e = {a, b}) → ((x ∈ e) + → (e = {x, y}))))) → ((∀ (p : List GaussianInt), ∀ (e : Finset GaussianInt), (∃ a b : + GaussianInt, ∃ l r : List GaussianInt, p = l ++ a :: b :: r ∧ e = {a, b}) → (∃ a b : + GaussianInt, ∃ l r : List GaussianInt, p.reverse = l ++ a :: b :: r ∧ e = {a, b})) → + (∀ (p : List GaussianInt), (p.Nodup) → (∀ (x : GaussianInt), ∀ (z : GaussianInt), ∀ + (rest : List GaussianInt), (p = rest ++ z :: x :: []) → (∀ (e : Finset GaussianInt), + (∃ a b : GaussianInt, ∃ l r : List GaussianInt, + p = l ++ a :: b :: r ∧ e = {a, b}) → ((x ∈ e) → (e = {z, x})))))) ) := by + classical + intro first_edge_unique reverse_edge_decomp p hpNodup x z rest hpath e he hxe + have hrevNodup : p.reverse.Nodup := List.nodup_reverse.mpr hpNodup + have hrevPath : p.reverse = x :: z :: rest.reverse := by + rw [hpath] + simp [List.reverse_append] + have hrevDecomp := reverse_edge_decomp p e he + have hresult := first_edge_unique p.reverse hrevNodup x z rest.reverse + hrevPath e hrevDecomp hxe + simpa [Finset.pair_comm] using hresult + +private theorem split_mem : + (by + classical + exact + ∀ (r : List GaussianInt), ∀ (z : GaussianInt), z ∈ r → ∃ l t, r = l ++ z :: t ) := by + classical + intro r z hz + induction r with + | nil => simp at hz + | cons a r ih => + simp only [List.mem_cons] at hz + rcases hz with rfl | hz + · exact ⟨[], r, rfl⟩ + · rcases ih hz with ⟨l, t, ht⟩ + exact ⟨a :: l, t, by simp [ht, List.cons_append]⟩ + +private theorem hsuf : + (by + classical + exact + ∀ (path : List GaussianInt), ∀ (x : GaussianInt), ((2 : ℕ) ≤ path.length) → (∀ (suf : + List GaussianInt), (path = [] ++ x :: suf) → (suf ≠ [])) ) := by + classical + intro path x hlength suf hsplit hnil + subst suf + rw [hsplit] at hlength + simp at hlength + +private theorem hUVAt563 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (a : + TilingLattice Ci), ∀ (b : TilingLattice Ci), (P.tile a = P.tile b) → (a = b)) → (∀ (U + : ProtoTile), ∀ (V : ProtoTile), ∀ (ia : ↥(TilingLattice Ci)), ∀ (ib : + ↥(TilingLattice Ci)), (P.tile ia = U) → ((P.tile ib = V) → ((ia ≠ ib) → (U ≠ V)))) ) + := by + classical + intro Ci P index_eq_of_tile_eq U V ia ib hUidx hVidx hidxne hEq + exact hidxne (index_eq_of_tile_eq ia ib + (hUidx.trans (hEq.trans hVidx.symm))) + +private theorem hpathLast : + (by + classical + exact + ∀ (path : List GaussianInt), ∀ (x : GaussianInt), ∀ (pre : List GaussianInt), (path = pre + ++ [x]) → (∀ (hpre' : pre ≠ []), + let z := pre.getLast hpre' + let pre' := pre.dropLast + (pre' ++ [z] = pre) → (path = pre' ++ z :: x :: [])) ) := by + classical + intro path x pre hsplit hpre' z pre' hpreEq + calc + path = pre ++ x :: [] := hsplit + _ = pre' ++ z :: x :: [] := by rw [← hpreEq]; simp [List.append_assoc] + +private theorem hUVAt597 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (a : + TilingLattice Ci), ∀ (b : TilingLattice Ci), (P.tile a = P.tile b) → (a = b)) → (∀ (U + : ProtoTile), ∀ (V : ProtoTile), ∀ (ia : ↥(TilingLattice Ci)), ∀ (ib : + ↥(TilingLattice Ci)), (P.tile ia = U) → ((P.tile ib = V) → ((ia ≠ ib) → (U ≠ V)))) ) + := by + classical + intro Ci P index_eq_of_tile_eq U V ia ib hUidx hVidx hidxne hEq + exact hidxne (index_eq_of_tile_eq ia ib + (hUidx.trans (hEq.trans hVidx.symm))) + +private theorem hleft : + (by + classical + exact + ∀ (path : List GaussianInt), ∀ (x : GaussianInt), ∀ (pre : List GaussianInt), ∀ (y : + GaussianInt), ∀ (rest : List GaussianInt), (path = pre ++ x :: y :: rest) → (∀ (hpre' + : pre ≠ []), + let z := pre.getLast hpre' + let pre' := pre.dropLast + (pre' ++ [z] = pre) → (path = pre' ++ z :: x :: y :: rest)) ) := by + classical + intro path x pre y rest hsplit hpre' z pre' hpreEq + calc + path = pre ++ x :: y :: rest := hsplit + _ = pre' ++ z :: x :: y :: rest := by rw [← hpreEq]; simp [List.append_assoc] + +private theorem hzx : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (path : List + GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), + (x ∈ path) → ((∀ (y : GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : + GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices T0 ∨ y ∈ FootprintVertices T0') → (∀ (pre + : List GaussianInt), ∀ (y : GaussianInt), ∀ (rest : List GaussianInt), (path = pre ++ + x :: y :: rest) → (∀ (hpre' : pre ≠ []), + let z := pre.getLast hpre' + let pre' := pre.dropLast + (path = pre' ++ z :: x :: y :: rest) → ((path = pre ++ x :: y :: rest) → (∀ (UL : + ProtoTile), ∀ (VL : ProtoTile), ∀ (iaL : ↥(TilingLattice Ci)), ∀ (ibL : + ↥(TilingLattice Ci)), ∀ (jL : Fin (4 : ℕ)), (({z, x} : Finset GaussianInt) = ![{x, x + + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)}, {x - (1 : GaussianInt), x}, {x - (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt), x}, {x, x + (1 : GaussianInt)}] jL) → (({z, x} ∈ + FootprintEdges UL) → (({z, x} ∈ FootprintEdges VL) → ((LatticeVertexIncidentCell x jL + ∈ (P.tile iaL).cells ∧ LatticeVertexIncidentCell x (jL + (1 : Fin (4 : ℕ))) ∈ (P.tile + ibL).cells ∨ LatticeVertexIncidentCell x jL ∈ (P.tile ibL).cells ∧ + LatticeVertexIncidentCell x (jL + (1 : Fin (4 : ℕ))) ∈ (P.tile iaL).cells) → (∀ (UR : + ProtoTile), ∀ (VR : ProtoTile), ∀ (iaR : ↥(TilingLattice Ci)), ∀ (ibR : + ↥(TilingLattice Ci)), ∀ (jR : Fin (4 : ℕ)), (({x, y} : Finset GaussianInt) = ![{x, x + + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)}, {x - (1 : GaussianInt), x}, {x - (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt), x}, {x, x + (1 : GaussianInt)}] jR) → (({x, y} ∈ + FootprintEdges UR) → (({x, y} ∈ FootprintEdges VR) → ((LatticeVertexIncidentCell x jR + ∈ (P.tile iaR).cells ∧ LatticeVertexIncidentCell x (jR + (1 : Fin (4 : ℕ))) ∈ (P.tile + ibR).cells ∨ LatticeVertexIncidentCell x jR ∈ (P.tile ibR).cells ∧ + LatticeVertexIncidentCell x (jR + (1 : Fin (4 : ℕ))) ∈ (P.tile iaR).cells) → (((pre' + ++ z :: x :: y :: rest).Nodup) → (((z :: x :: y :: rest).Nodup) → ((z ∉ x :: y :: + rest) → (z ≠ x)))))))))))))))) ) := by + classical + intro Ci T0 T0' path P x hx hstar pre y rest hsplit hpre' z pre' hleft hright UL VL iaL ibL jL + eL hedgeUL hedgeVL hsectorL UR VR iaR ibR jR eR hedgeUR hedgeVR hsectorR hnodupPath + htailNodup hznot heq + subst x + exact hznot (List.mem_cons_self ..) + +private theorem hzy : + (by + classical + exact + ∀ (path : List GaussianInt), ∀ (x : GaussianInt), ∀ (pre : List GaussianInt), ∀ (y : + GaussianInt), ∀ (rest : List GaussianInt), (path = pre ++ x :: y :: rest) → (∀ (hpre' + : pre ≠ []), + let z := pre.getLast hpre' + let pre' := pre.dropLast + (path = pre' ++ z :: x :: y :: rest) → ((path = pre ++ x :: y :: rest) → (∀ (UR : + ProtoTile), ∀ (VR : ProtoTile), ∀ (jR : Fin (4 : ℕ)), (({x, y} : Finset GaussianInt) + = ![{x, x + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)}, {x - (1 : GaussianInt), x}, {x - (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt), x}, {x, x + (1 : GaussianInt)}] jR) → (({x, y} ∈ + FootprintEdges UR) → (({x, y} ∈ FootprintEdges VR) → (((pre' ++ z :: x :: y :: + rest).Nodup) → (((z :: x :: y :: rest).Nodup) → ((z ∉ x :: y :: rest) → (z ≠ + y))))))))) ) := by + classical + intro path x pre y rest hsplit hpre' z pre' hleft hright UR VR jR eR hedgeUR hedgeVR hnodupPath + htailNodup hznot heq + subst y + exact hznot (List.mem_cons_of_mem x (List.mem_cons_self ..)) + +private theorem hEdgeNe : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (pre : List GaussianInt), ∀ (y : GaussianInt), ∀ (hpre' : pre ≠ []), + let z := pre.getLast hpre' + (z ≠ x) → ((z ≠ y) → (({z, x} : Finset GaussianInt) ≠ {x, y})) ) := by + classical + intro x pre y hpre' z hzx hzy heq + have hzmem : z = x ∨ z = y := by + have : z ∈ ({x, y} : Finset GaussianInt) := by + rw [← heq] + exact Finset.mem_insert.mpr (Or.inl rfl) + simpa only [Finset.mem_insert, Finset.mem_singleton] using this + rcases hzmem with hz | hz + · exact hzx hz + · exact hzy hz + +private theorem hjne : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (pre : List GaussianInt), ∀ (y : GaussianInt), ∀ (hpre' : pre ≠ []), + let z := pre.getLast hpre' + ∀ (jL : Fin (4 : ℕ)), (({z, x} : Finset GaussianInt) = ![{x, x + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)}, + {x - (1 : GaussianInt), x}, {x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), x}, {x, + x + (1 : GaussianInt)}] jL) → (∀ (jR : Fin (4 : ℕ)), (({x, y} : Finset GaussianInt) = + ![{x, x + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)}, {x - (1 : GaussianInt), x}, {x - (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt), x}, {x, x + (1 : GaussianInt)}] jR) → ((z ≠ x) → ((z ≠ y) → + (jL ≠ jR)))) ) := by + classical + intro x pre y hpre' z jL eL jR eR hzx hzy heq + have hedgeEq : ({z, x} : Finset GaussianInt) = {x, y} := by + calc + _ = ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] jL := eL + _ = ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] jR := by rw [heq] + _ = {x, y} := eR.symm + have hzm : z = x ∨ z = y := by + have : z ∈ ({x, y} : Finset GaussianInt) := by + rw [← hedgeEq] + exact Finset.mem_insert.mpr (Or.inl rfl) + simpa only [Finset.mem_insert, Finset.mem_singleton] using this + rcases hzm with h | h + · exact (hzx h).elim + · exact hzy h + +private theorem hidxX : + (by + classical + exact + ∀ (path : List GaussianInt), ∀ (x : GaussianInt), ∀ (pre : List GaussianInt), ∀ (y : + GaussianInt), ∀ (rest : List GaussianInt), ∀ (hpre' : pre ≠ []), + let z := pre.getLast hpre' + let pre' := pre.dropLast + (path = pre' ++ z :: x :: y :: rest) → (((pre' ++ z :: x :: y :: rest).Nodup) → + (path.idxOf x = pre'.length + 1)) ) := by + classical + intro path x pre y rest hpre' z pre' hleft hnodupPath + have hndSplit : + ((pre' ++ [z]) ++ (x :: y :: rest)).Nodup := by + simpa [List.append_assoc] using hnodupPath + have hdisSplit := (List.nodup_append.mp hndSplit).2.2 + have hxnot : x ∉ pre' ++ [z] := by + intro hxmem + exact hdisSplit x hxmem x (List.mem_cons_self ..) rfl + calc + path.idxOf x = + ((pre' ++ [z]) ++ (x :: y :: rest)).idxOf x := by + rw [hleft] + simp [List.append_assoc] + _ = (pre' ++ [z]).length + (x :: y :: rest).idxOf x := + List.idxOf_append_of_notMem hxnot + _ = pre'.length + 1 := by simp + +private theorem hidxY : + (by + classical + exact + ∀ (path : List GaussianInt), ∀ (x : GaussianInt), ∀ (pre : List GaussianInt), ∀ (y : + GaussianInt), ∀ (rest : List GaussianInt), ∀ (hpre' : pre ≠ []), + let z := pre.getLast hpre' + let pre' := pre.dropLast + (path = pre' ++ z :: x :: y :: rest) → (((pre' ++ z :: x :: y :: rest).Nodup) → + (path.idxOf y = pre'.length + 2)) ) := by + classical + intro path x pre y rest hpre' z pre' hleft hnodupPath + have hndSplit : + ((pre' ++ [z, x]) ++ (y :: rest)).Nodup := by + simpa [List.append_assoc] using hnodupPath + have hdisSplit := (List.nodup_append.mp hndSplit).2.2 + have hynot : y ∉ pre' ++ [z, x] := by + intro hymem + exact hdisSplit y hymem y (List.mem_cons_self ..) rfl + calc + path.idxOf y = + ((pre' ++ [z, x]) ++ (y :: rest)).idxOf y := by + rw [hleft] + simp [List.append_assoc] + _ = (pre' ++ [z, x]).length + (y :: rest).idxOf y := + List.idxOf_append_of_notMem hynot + _ = pre'.length + 2 := by simp + +private theorem hidxZ : + (by + classical + exact + ∀ (path : List GaussianInt), ∀ (x : GaussianInt), ∀ (pre : List GaussianInt), ∀ (y : + GaussianInt), ∀ (rest : List GaussianInt), ∀ (hpre' : pre ≠ []), + let z := pre.getLast hpre' + let pre' := pre.dropLast + (path = pre' ++ z :: x :: y :: rest) → (((pre' ++ z :: x :: y :: rest).Nodup) → + (path.idxOf z = pre'.length)) ) := by + classical + intro path x pre y rest hpre' z pre' hleft hnodupPath + have hznot : z ∉ pre' := by + have hndSplit : (pre' ++ z :: x :: y :: rest).Nodup := by + simpa [List.append_assoc] using hnodupPath + have hdisSplit := (List.nodup_append.mp + (by simpa [List.cons_append, List.append_assoc] using hndSplit)).2.2 + intro hzmem + exact hdisSplit z hzmem z (List.mem_cons_self ..) rfl + calc + path.idxOf z = (pre' ++ z :: x :: y :: rest).idxOf z := by + rw [hleft] + _ = pre'.length + (z :: x :: y :: rest).idxOf z := + List.idxOf_append_of_notMem hznot + _ = pre'.length := by simp + +private theorem internal_edge_unique : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (path : List GaussianInt), (PeriodicTileComplex ↥(TilingLattice + Ci)) → (∀ (x : GaussianInt), (path.Nodup) → (∀ (pre : List GaussianInt), ∀ (y : + GaussianInt), ∀ (hpre' : pre ≠ []), + let z := pre.getLast hpre' + let pre' := pre.dropLast + (path.idxOf x = pre'.length + 1) → ((path.idxOf y = pre'.length + 2) → ((path.idxOf z = + pre'.length) → (∀ (e : Finset GaussianInt), (∃ a b l r, path = l ++ a :: b :: r ∧ e = + {a, b}) → ((x ∈ e) → (e = {z, x} ∨ e = {x, y}))))))) ) := by + classical + intro Ci path P x hnodup pre y hpre' z pre' hidxX hidxY hidxZ e he hxe + rcases he with ⟨a, b, l, r, hdecomp, heq⟩ + have hcases : x = a ∨ x = b := by + have : x ∈ ({a, b} : Finset GaussianInt) := by + simpa [heq] using hxe + simpa using this + have hndAB : (l ++ a :: b :: r).Nodup := by + rw [← hdecomp] + exact hnodup + have hndA : (l ++ (a :: b :: r)).Nodup := by + simpa [List.append_assoc] using hndAB + have haNot : a ∉ l := by + have hdis := (List.nodup_append.mp hndA).2.2 + intro hamem + exact hdis a hamem a (List.mem_cons_self ..) rfl + have hndB : ((l ++ [a]) ++ (b :: r)).Nodup := by + simpa [List.append_assoc] using hndAB + have hbNot : b ∉ l ++ [a] := by + have hdis := (List.nodup_append.mp hndB).2.2 + intro hbmem + exact hdis b hbmem b (List.mem_cons_self ..) rfl + have hidxA : path.idxOf a = l.length := by + calc + path.idxOf a = (l ++ a :: b :: r).idxOf a := by rw [hdecomp] + _ = l.length + (a :: b :: r).idxOf a := + List.idxOf_append_of_notMem haNot + _ = l.length := by simp + have hidxB : path.idxOf b = l.length + 1 := by + calc + path.idxOf b = ((l ++ [a]) ++ b :: r).idxOf b := by + rw [hdecomp] + simp [List.append_assoc] + _ = (l ++ [a]).length + (b :: r).idxOf b := + List.idxOf_append_of_notMem hbNot + _ = l.length + 1 := by simp + rcases hcases with hxa | hxb + · subst a + have hlen : l.length = pre'.length + 1 := by + rw [← hidxA, hidxX] + have hby : path.idxOf b = path.idxOf y := by + rw [hidxB, hlen, hidxY] + have hbPath : b ∈ path := by rw [hdecomp]; simp + have hby' : b = y := (List.idxOf_inj (l := path) + (hx := hbPath)).1 hby + simp [heq, hby'] + · subst b + have hlen : l.length + 1 = pre'.length + 1 := by + rw [← hidxB, hidxX] + have hlen' : l.length = pre'.length := by omega + have hza : path.idxOf a = path.idxOf z := by + rw [hidxA, hlen', hidxZ] + have hza' : a = z := (List.idxOf_inj (l := path) + (hx := by rw [hdecomp]; simp)).1 hza + simp [heq, hza'] + +private theorem outer_side_class : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → + (outerLabel x j = 0)) → ((∀ (x : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ T0'.cells) → (outerLabel x j = 1)) → (∀ (x : + GaussianInt), (∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells) → (∀ (j : Fin 4), (outerLabel x j = 0 ∧ + LatticeVertexIncidentCell x j ∈ T0.cells) ∨ (outerLabel x j = 1 ∧ + LatticeVertexIncidentCell x j ∈ T0'.cells)))) ) := by + classical + intro T0 T0' outerLabel label_T0 label_T0' x hsectorOuter j + rcases hsectorOuter j with h0 | h1 + · exact Or.inl ⟨label_T0 x j h0, h0⟩ + · exact Or.inr ⟨label_T0' x j h1, h1⟩ + +private theorem hLaligned : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (P : PeriodicTileComplex + ↥(TilingLattice Ci)), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → + (outerLabel x j = 0)) → ((∀ (x : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ T0'.cells) → (outerLabel x j = 1)) → ( + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + (∀ (c : GaussianInt), ∀ (a : TilingLattice Ci), (c ∈ (P.tile a).cells) → (owner c = a)) → + (∀ (x : GaussianInt), ∀ (UL : ProtoTile), ∀ (VL : ProtoTile), ∀ (iaL : + ↥(TilingLattice Ci)), ∀ (ibL : ↥(TilingLattice Ci)), ∀ (jL : Fin (4 : ℕ)), (P.tile + iaL = UL) → ((P.tile ibL = VL) → ((LatticeVertexIncidentCell x jL ∈ (P.tile + iaL).cells ∧ LatticeVertexIncidentCell x (jL + (1 : Fin (4 : ℕ))) ∈ (P.tile + ibL).cells ∨ LatticeVertexIncidentCell x jL ∈ (P.tile ibL).cells ∧ + LatticeVertexIncidentCell x (jL + (1 : Fin (4 : ℕ))) ∈ (P.tile iaL).cells) → + ((UL.cells ⊆ T0.cells) → ((VL.cells ⊆ T0'.cells) → (((outerLabel x jL = 0 ∧ owner + (LatticeVertexIncidentCell x jL) = iaL) ∧ (outerLabel x (jL + 1) = 1 ∧ owner + (LatticeVertexIncidentCell x (jL + 1)) = ibL)) ∨ ((outerLabel x jL = 1 ∧ owner + (LatticeVertexIncidentCell x jL) = ibL) ∧ (outerLabel x (jL + 1) = 0 ∧ owner + (LatticeVertexIncidentCell x (jL + 1)) = iaL)))))))))) ) := by + classical + intro Ci T0 T0' P outerLabel label_T0 label_T0' owner owner_unique x UL VL iaL ibL jL hULidx + hVLidx hsectorL hULsub hVLsub + rcases hsectorL with h | h + · left + constructor + · exact ⟨label_T0 x jL (hULsub (by simpa [hULidx] using h.1)), + owner_unique _ iaL (by simpa [hULidx] using h.1)⟩ + · exact ⟨label_T0' x (jL + 1) (hVLsub (by simpa [hVLidx] using h.2)), + owner_unique _ ibL (by simpa [hVLidx] using h.2)⟩ + · right + constructor + · exact ⟨label_T0' x jL (hVLsub (by simpa [hVLidx] using h.1)), + owner_unique _ ibL (by simpa [hVLidx] using h.1)⟩ + · exact ⟨label_T0 x (jL + 1) (hULsub (by simpa [hULidx] using h.2)), + owner_unique _ iaL (by simpa [hULidx] using h.2)⟩ + +private theorem hRaligned : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (P : PeriodicTileComplex + ↥(TilingLattice Ci)), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → + (outerLabel x j = 0)) → ((∀ (x : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ T0'.cells) → (outerLabel x j = 1)) → ( + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + (∀ (c : GaussianInt), ∀ (a : TilingLattice Ci), (c ∈ (P.tile a).cells) → (owner c = a)) → + (∀ (x : GaussianInt), ∀ (UR : ProtoTile), ∀ (VR : ProtoTile), ∀ (iaR : + ↥(TilingLattice Ci)), ∀ (ibR : ↥(TilingLattice Ci)), ∀ (jR : Fin (4 : ℕ)), (P.tile + iaR = UR) → ((P.tile ibR = VR) → ((LatticeVertexIncidentCell x jR ∈ (P.tile + iaR).cells ∧ LatticeVertexIncidentCell x (jR + (1 : Fin (4 : ℕ))) ∈ (P.tile + ibR).cells ∨ LatticeVertexIncidentCell x jR ∈ (P.tile ibR).cells ∧ + LatticeVertexIncidentCell x (jR + (1 : Fin (4 : ℕ))) ∈ (P.tile iaR).cells) → + ((UR.cells ⊆ T0.cells) → ((VR.cells ⊆ T0'.cells) → (((outerLabel x jR = 0 ∧ owner + (LatticeVertexIncidentCell x jR) = iaR) ∧ (outerLabel x (jR + 1) = 1 ∧ owner + (LatticeVertexIncidentCell x (jR + 1)) = ibR)) ∨ ((outerLabel x jR = 1 ∧ owner + (LatticeVertexIncidentCell x jR) = ibR) ∧ (outerLabel x (jR + 1) = 0 ∧ owner + (LatticeVertexIncidentCell x (jR + 1)) = iaR)))))))))) ) := by + classical + intro Ci T0 T0' P outerLabel label_T0 label_T0' owner owner_unique x UR VR iaR ibR jR hURidx + hVRidx hsectorR hURsub hVRsub + rcases hsectorR with h | h + · left + constructor + · exact ⟨label_T0 x jR (hURsub (by simpa [hURidx] using h.1)), + owner_unique _ iaR (by simpa [hURidx] using h.1)⟩ + · exact ⟨label_T0' x (jR + 1) (hVRsub (by simpa [hVRidx] using h.2)), + owner_unique _ ibR (by simpa [hVRidx] using h.2)⟩ + · right + constructor + · exact ⟨label_T0' x jR (hVRsub (by simpa [hVRidx] using h.1)), + owner_unique _ ibR (by simpa [hVRidx] using h.1)⟩ + · exact ⟨label_T0 x (jR + 1) (hURsub (by simpa [hURidx] using h.2)), + owner_unique _ iaR (by simpa [hURidx] using h.2)⟩ + +private theorem transition_is_path_edge : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (path : List GaussianInt), + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (x : GaussianInt), ∀ (j : Fin 4), x ∈ edgeAt x j ∧ neighbor x j ∈ edgeAt x j) → ((∀ (x + : GaussianInt), ∀ {j : Fin 4}, ∀ {k : Fin 4}, (edgeAt x j = edgeAt x k) → (j = k)) → + ((∀ (R : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x + j ∈ R.cells ∨ LatticeVertexIncidentCell x (j + 1) ∈ R.cells) → (edgeAt x j ∈ + FootprintEdges R)) → ( + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (x : GaussianInt), (∀ (e : Finset GaussianInt), e ∈ FootprintEdges T0 ∩ FootprintEdges + T0' ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l : List GaussianInt) (r : List + GaussianInt), path = l ++ a :: b :: r ∧ e = {a, b}) → (∀ (pre : List GaussianInt), ∀ + (y : GaussianInt), ∀ (hpre' : pre ≠ []), + let z := pre.getLast hpre' + ∀ (jL : Fin (4 : ℕ)), (({z, x} : Finset GaussianInt) = ![{x, x + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)}, + {x - (1 : GaussianInt), x}, {x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), x}, {x, + x + (1 : GaussianInt)}] jL) → (∀ (jR : Fin (4 : ℕ)), (({x, y} : Finset GaussianInt) = + ![{x, x + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt)}, {x - (1 : GaussianInt), x}, {x - (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt), x}, {x, x + (1 : GaussianInt)}] jR) → ((∀ (e : Finset + GaussianInt), (∃ a b l r, path = l ++ a :: b :: r ∧ e = {a, b}) → ((x ∈ e) → (e = {z, + x} ∨ e = {x, y}))) → ((∀ (j : Fin 4), (outerLabel x j = 0 ∧ LatticeVertexIncidentCell + x j ∈ T0.cells) ∨ (outerLabel x j = 1 ∧ LatticeVertexIncidentCell x j ∈ T0'.cells)) → + (∀ (j : Fin 4), (outerLabel x j ≠ outerLabel x (j + 1)) → (j = jL ∨ j = jR))))))))) ) + := by + classical + intro T0 T0' path neighbor edgeAt edgeAt_mem edgeAt_injective edge_of_sector_cell outerLabel x + hedgesPath pre y hpre' z jL eL jR eR internal_edge_unique outer_side_class j hchange + rcases outer_side_class j with h0 | h1 <;> + rcases outer_side_class (j + 1) with h0' | h1' + · exact False.elim (hchange (h0.1.trans h0'.1.symm)) + · have he0 : edgeAt x j ∈ FootprintEdges T0 := + edge_of_sector_cell T0 x j (Or.inl h0.2) + have he1 : edgeAt x j ∈ FootprintEdges T0' := + edge_of_sector_cell T0' x j (Or.inr h1'.2) + have hpathEdge := (hedgesPath (edgeAt x j)).mp ⟨he0, he1⟩ + rcases internal_edge_unique (edgeAt x j) hpathEdge + (edgeAt_mem x j).1 with hleft | hright + · left + apply edgeAt_injective x + calc + edgeAt x j = {z, x} := hleft + _ = edgeAt x jL := eL + · right + apply edgeAt_injective x + calc + edgeAt x j = {x, y} := hright + _ = edgeAt x jR := eR + · have he0 : edgeAt x j ∈ FootprintEdges T0' := + edge_of_sector_cell T0' x j (Or.inl h1.2) + have he1 : edgeAt x j ∈ FootprintEdges T0 := + edge_of_sector_cell T0 x j (Or.inr h0'.2) + have hpathEdge := (hedgesPath (edgeAt x j)).mp ⟨he1, he0⟩ + rcases internal_edge_unique (edgeAt x j) hpathEdge + (edgeAt_mem x j).1 with hleft | hright + · left + apply edgeAt_injective x + calc + edgeAt x j = {z, x} := hleft + _ = edgeAt x jL := eL + · right + apply edgeAt_injective x + calc + edgeAt x j = {x, y} := hright + _ = edgeAt x jR := eR + · exact False.elim (hchange (h1.1.trans h1'.1.symm)) + +private theorem side_mem_zero : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → + (outerLabel x j = 0)) → (∀ (x : GaussianInt), + let sectorSide : Fin 4 → Bool := fun j => decide (outerLabel x j = 1) + ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → (sectorSide j = false)) ) := by + classical + intro T0 T0' outerLabel label_T0 x sectorSide j hc + simp [sectorSide, label_T0 x j hc] + +private theorem side_mem_one : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0'.cells) → + (outerLabel x j = 1)) → (∀ (x : GaussianInt), + let sectorSide : Fin 4 → Bool := fun j => decide (outerLabel x j = 1) + ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0'.cells) → (sectorSide j = true)) ) := by + classical + intro T0 T0' outerLabel label_T0' x sectorSide j hc + simp [sectorSide, label_T0' x j hc] + +private theorem sector_in_tile : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + (∀ (c : GaussianInt), ∀ (a : TilingLattice Ci), c ∈ (P.tile a).cells ↔ owner c = a) → (∀ + (x : GaussianInt), + let sectorOwner : Fin 4 → TilingLattice Ci := fun j => + owner (LatticeVertexIncidentCell x j) + ∀ (j : Fin 4), ∀ (a : TilingLattice Ci), (sectorOwner j = a) → (LatticeVertexIncidentCell + x j ∈ (P.tile a).cells)) ) := by + classical + intro Ci P owner owner_mem_iff x sectorOwner j a howner + exact (owner_mem_iff (LatticeVertexIncidentCell x j) a).2 howner + +private theorem side_same_T0 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (P : PeriodicTileComplex + ↥(TilingLattice Ci)), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + ∀ (x : GaussianInt), + let sectorOwner : Fin 4 → TilingLattice Ci := fun j => + owner (LatticeVertexIncidentCell x j) + let sectorSide : Fin 4 → Bool := fun j => decide (outerLabel x j = 1) + (∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → (sectorSide j = false)) → + ((∀ (j : Fin 4), ∀ (a : TilingLattice Ci), (sectorOwner j = a) → + (LatticeVertexIncidentCell x j ∈ (P.tile a).cells)) → (∀ (i : Fin 4), ∀ (j : Fin 4), + ∀ (a : TilingLattice Ci), ((P.tile a).cells ⊆ T0.cells) → ((sectorOwner i = a) → + ((sectorOwner j = a) → (sectorSide i = sectorSide j))))) ) := by + classical + intro Ci T0 T0' P outerLabel owner x sectorOwner sectorSide side_mem_zero sector_in_tile i j a + hsub hi hj + rw [side_mem_zero i (hsub (sector_in_tile i a hi)), + side_mem_zero j (hsub (sector_in_tile j a hj))] + +private theorem side_same_T0' : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (P : PeriodicTileComplex + ↥(TilingLattice Ci)), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + ∀ (x : GaussianInt), + let sectorOwner : Fin 4 → TilingLattice Ci := fun j => + owner (LatticeVertexIncidentCell x j) + let sectorSide : Fin 4 → Bool := fun j => decide (outerLabel x j = 1) + (∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0'.cells) → (sectorSide j = true)) → + ((∀ (j : Fin 4), ∀ (a : TilingLattice Ci), (sectorOwner j = a) → + (LatticeVertexIncidentCell x j ∈ (P.tile a).cells)) → (∀ (i : Fin 4), ∀ (j : Fin 4), + ∀ (a : TilingLattice Ci), ((P.tile a).cells ⊆ T0'.cells) → ((sectorOwner i = a) → + ((sectorOwner j = a) → (sectorSide i = sectorSide j))))) ) := by + classical + intro Ci T0 T0' P outerLabel owner x sectorOwner sectorSide side_mem_one sector_in_tile i j a + hsub hi hj + rw [side_mem_one i (hsub (sector_in_tile i a hi)), + side_mem_one j (hsub (sector_in_tile j a hj))] + +private theorem side_consistent_left : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (P : PeriodicTileComplex + ↥(TilingLattice Ci)), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + ∀ (x : GaussianInt), ∀ (UL : ProtoTile), ∀ (VL : ProtoTile), ∀ (iaL : ↥(TilingLattice + Ci)), ∀ (ibL : ↥(TilingLattice Ci)), ∀ (jL : Fin (4 : ℕ)), (P.tile iaL = UL) → + ((P.tile ibL = VL) → (∀ (UR : ProtoTile), ∀ (VR : ProtoTile), ∀ (iaR : + ↥(TilingLattice Ci)), ∀ (ibR : ↥(TilingLattice Ci)), ∀ (jR : Fin (4 : ℕ)), (P.tile + iaR = UR) → ((P.tile ibR = VR) → ((UL.cells ⊆ T0.cells) → ((VL.cells ⊆ T0'.cells) → + ((UR.cells ⊆ T0.cells) → ((VR.cells ⊆ T0'.cells) → ((((outerLabel x jL = 0 ∧ owner + (LatticeVertexIncidentCell x jL) = iaL) ∧ (outerLabel x (jL + 1) = 1 ∧ owner + (LatticeVertexIncidentCell x (jL + 1)) = ibL)) ∨ ((outerLabel x jL = 1 ∧ owner + (LatticeVertexIncidentCell x jL) = ibL) ∧ (outerLabel x (jL + 1) = 0 ∧ owner + (LatticeVertexIncidentCell x (jL + 1)) = iaL))) → ((((outerLabel x jR = 0 ∧ owner + (LatticeVertexIncidentCell x jR) = iaR) ∧ (outerLabel x (jR + 1) = 1 ∧ owner + (LatticeVertexIncidentCell x (jR + 1)) = ibR)) ∨ ((outerLabel x jR = 1 ∧ owner + (LatticeVertexIncidentCell x jR) = ibR) ∧ (outerLabel x (jR + 1) = 0 ∧ owner + (LatticeVertexIncidentCell x (jR + 1)) = iaR))) → ((∀ (j : Fin 4), (outerLabel x j ≠ + outerLabel x (j + 1)) → (j = jL ∨ j = jR)) → ( + let sectorOwner : Fin 4 → TilingLattice Ci := fun j => + owner (LatticeVertexIncidentCell x j) + let sectorSide : Fin 4 → Bool := fun j => decide (outerLabel x j = 1) + (∀ (i : Fin 4), ∀ (j : Fin 4), ∀ (a : TilingLattice Ci), ((P.tile a).cells ⊆ T0.cells) → + ((sectorOwner i = a) → ((sectorOwner j = a) → (sectorSide i = sectorSide j)))) → ((∀ + (i : Fin 4), ∀ (j : Fin 4), ∀ (a : TilingLattice Ci), ((P.tile a).cells ⊆ T0'.cells) + → ((sectorOwner i = a) → ((sectorOwner j = a) → (sectorSide i = sectorSide j)))) → (∀ + i, ∀ k, sectorSide i ≠ sectorSide (i + 1) → sectorOwner k = sectorOwner i → + sectorSide k = sectorSide i))))))))))))) ) := by + classical + intro Ci T0 T0' P outerLabel owner x UL VL iaL ibL jL hULidx hVLidx UR VR iaR ibR jR hURidx + hVRidx hULsub hVLsub hURsub hVRsub hLaligned hRaligned transition_is_path_edge sectorOwner + sectorSide side_same_T0 side_same_T0' i k hchange hsame + have hchange' : outerLabel x i ≠ outerLabel x (i + 1) := by + intro heq + exact hchange (by simp only [sectorSide, heq]) + rcases transition_is_path_edge i hchange' with hi | hi <;> subst i + · rcases hLaligned with h | h + · exact (side_same_T0 jL k iaL + (by simpa only [hULidx] using hULsub) h.1.2 + (hsame.trans h.1.2)).symm + · exact (side_same_T0' jL k ibL + (by simpa only [hVLidx] using hVLsub) h.1.2 + (hsame.trans h.1.2)).symm + · rcases hRaligned with h | h + · exact (side_same_T0 jR k iaR + (by simpa only [hURidx] using hURsub) h.1.2 + (hsame.trans h.1.2)).symm + · exact (side_same_T0' jR k ibR + (by simpa only [hVRidx] using hVRsub) h.1.2 + (hsame.trans h.1.2)).symm + +private theorem side_consistent_right : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (P : PeriodicTileComplex + ↥(TilingLattice Ci)), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + ∀ (x : GaussianInt), ∀ (UL : ProtoTile), ∀ (VL : ProtoTile), ∀ (iaL : ↥(TilingLattice + Ci)), ∀ (ibL : ↥(TilingLattice Ci)), ∀ (jL : Fin (4 : ℕ)), (P.tile iaL = UL) → + ((P.tile ibL = VL) → (∀ (UR : ProtoTile), ∀ (VR : ProtoTile), ∀ (iaR : + ↥(TilingLattice Ci)), ∀ (ibR : ↥(TilingLattice Ci)), ∀ (jR : Fin (4 : ℕ)), (P.tile + iaR = UR) → ((P.tile ibR = VR) → ((UL.cells ⊆ T0.cells) → ((VL.cells ⊆ T0'.cells) → + ((UR.cells ⊆ T0.cells) → ((VR.cells ⊆ T0'.cells) → ((((outerLabel x jL = 0 ∧ owner + (LatticeVertexIncidentCell x jL) = iaL) ∧ (outerLabel x (jL + 1) = 1 ∧ owner + (LatticeVertexIncidentCell x (jL + 1)) = ibL)) ∨ ((outerLabel x jL = 1 ∧ owner + (LatticeVertexIncidentCell x jL) = ibL) ∧ (outerLabel x (jL + 1) = 0 ∧ owner + (LatticeVertexIncidentCell x (jL + 1)) = iaL))) → ((((outerLabel x jR = 0 ∧ owner + (LatticeVertexIncidentCell x jR) = iaR) ∧ (outerLabel x (jR + 1) = 1 ∧ owner + (LatticeVertexIncidentCell x (jR + 1)) = ibR)) ∨ ((outerLabel x jR = 1 ∧ owner + (LatticeVertexIncidentCell x jR) = ibR) ∧ (outerLabel x (jR + 1) = 0 ∧ owner + (LatticeVertexIncidentCell x (jR + 1)) = iaR))) → ((∀ (j : Fin 4), (outerLabel x j ≠ + outerLabel x (j + 1)) → (j = jL ∨ j = jR)) → ( + let sectorOwner : Fin 4 → TilingLattice Ci := fun j => + owner (LatticeVertexIncidentCell x j) + let sectorSide : Fin 4 → Bool := fun j => decide (outerLabel x j = 1) + (∀ (i : Fin 4), ∀ (j : Fin 4), ∀ (a : TilingLattice Ci), ((P.tile a).cells ⊆ T0.cells) → + ((sectorOwner i = a) → ((sectorOwner j = a) → (sectorSide i = sectorSide j)))) → ((∀ + (i : Fin 4), ∀ (j : Fin 4), ∀ (a : TilingLattice Ci), ((P.tile a).cells ⊆ T0'.cells) + → ((sectorOwner i = a) → ((sectorOwner j = a) → (sectorSide i = sectorSide j)))) → (∀ + i, ∀ k, sectorSide i ≠ sectorSide (i + 1) → sectorOwner k = sectorOwner (i + 1) → + sectorSide k = sectorSide (i + 1)))))))))))))) ) := by + classical + intro Ci T0 T0' P outerLabel owner x UL VL iaL ibL jL hULidx hVLidx UR VR iaR ibR jR hURidx + hVRidx hULsub hVLsub hURsub hVRsub hLaligned hRaligned transition_is_path_edge sectorOwner + sectorSide side_same_T0 side_same_T0' i k hchange hsame + have hchange' : outerLabel x i ≠ outerLabel x (i + 1) := by + intro heq + exact hchange (by simp only [sectorSide, heq]) + rcases transition_is_path_edge i hchange' with hi | hi <;> subst i + · rcases hLaligned with h | h + · exact (side_same_T0' (jL + 1) k ibL + (by simpa only [hVLidx] using hVLsub) h.2.2 + (hsame.trans h.2.2)).symm + · exact (side_same_T0 (jL + 1) k iaL + (by simpa only [hULidx] using hULsub) h.2.2 + (hsame.trans h.2.2)).symm + · rcases hRaligned with h | h + · exact (side_same_T0' (jR + 1) k ibR + (by simpa only [hVRidx] using hVRsub) h.2.2 + (hsame.trans h.2.2)).symm + · exact (side_same_T0 (jR + 1) k iaR + (by simpa only [hURidx] using hURsub) h.2.2 + (hsame.trans h.2.2)).symm + +private theorem hownerOpp : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (x : GaussianInt), (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ T0.cells ∧ + LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ T0'.cells) → ( + let sectorSide : Fin 4 → Bool := fun j => decide (outerLabel x j = 1) + (∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → (sectorSide j = false)) → + ((∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0'.cells) → (sectorSide j = true)) + → (sectorSide 0 ≠ sectorSide 2 ∨ sectorSide 1 ≠ sectorSide 3))) ) := by + classical + intro T0 T0' outerLabel x hsectorOpp sectorSide side_mem_zero side_mem_one + rcases hsectorOpp with ⟨j, h0, h1⟩ + have hs0 := side_mem_zero j h0 + have hs1 := side_mem_one (j + 2) h1 + fin_cases j + · exact Or.inl (fun heq => Bool.false_ne_true + (hs0.symm.trans (heq.trans hs1))) + · exact Or.inr (fun heq => Bool.false_ne_true + (hs0.symm.trans (heq.trans hs1))) + · exact Or.inl (fun heq => Bool.false_ne_true + (hs0.symm.trans (heq.symm.trans hs1))) + · exact Or.inr (fun heq => Bool.false_ne_true + (hs0.symm.trans (heq.symm.trans hs1))) + +private theorem diagonal_cells : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + ∀ (x : GaussianInt), + let sectorOwner : Fin 4 → TilingLattice Ci := fun j => + owner (LatticeVertexIncidentCell x j) + (∀ (j : Fin 4), ∀ (a : TilingLattice Ci), (sectorOwner j = a) → + (LatticeVertexIncidentCell x j ∈ (P.tile a).cells)) → (∀ (j : Fin 4), ∀ (U : + ProtoTile), ∀ (V : ProtoTile), ∀ (a : TilingLattice Ci), ∀ (b : TilingLattice Ci), + (P.tile a = U) → ((P.tile b = V) → (((sectorOwner j = a ∧ sectorOwner (j + 1) = b) ∨ + (sectorOwner j = b ∧ sectorOwner (j + 1) = a)) → ((sectorOwner j = sectorOwner (j + 3) ∨ + sectorOwner (j + 1) = sectorOwner (j + 2)) → ((x ∈ U.cells ∧ x - 1 - ⟨0, 1⟩ ∈ + V.cells) ∨ (x ∈ V.cells ∧ x - 1 - ⟨0, 1⟩ ∈ U.cells) ∨ (x - 1 ∈ U.cells ∧ x - ⟨0, + 1⟩ ∈ V.cells) ∨ (x - 1 ∈ V.cells ∧ x - ⟨0, 1⟩ ∈ U.cells)))))) ) := by + classical + intro Ci P owner x sectorOwner sector_in_tile j U V a b hUa hVb haligned hselect + have hd : ∃ t : Fin 4, + (sectorOwner t = a ∧ sectorOwner (t + 2) = b) ∨ + (sectorOwner t = b ∧ sectorOwner (t + 2) = a) := by + rcases hselect with hsame | hsame + · refine ⟨j + 1, ?_⟩ + rcases haligned with h | h + · right + exact ⟨h.2, by simpa only [add_assoc] using hsame.symm.trans h.1⟩ + · left + exact ⟨h.2, by simpa only [add_assoc] using hsame.symm.trans h.1⟩ + · refine ⟨j, ?_⟩ + rcases haligned with h | h + · exact Or.inl ⟨h.1, hsame.symm.trans h.2⟩ + · exact Or.inr ⟨h.1, hsame.symm.trans h.2⟩ + obtain ⟨t, ht⟩ := hd + have hc : + (LatticeVertexIncidentCell x t ∈ U.cells ∧ + LatticeVertexIncidentCell x (t + 2) ∈ V.cells) ∨ + (LatticeVertexIncidentCell x t ∈ V.cells ∧ + LatticeVertexIncidentCell x (t + 2) ∈ U.cells) := by + rcases ht with ht | ht + · exact Or.inl ⟨by simpa only [hUa] using sector_in_tile t a ht.1, + by simpa only [hVb] using sector_in_tile (t + 2) b ht.2⟩ + · exact Or.inr ⟨by simpa only [hVb] using sector_in_tile t b ht.1, + by simpa only [hUa] using sector_in_tile (t + 2) a ht.2⟩ + rcases hc with hc | hc + · fin_cases t + · exact Or.inl (by simpa [LatticeVertexIncidentCell] using hc) + · exact Or.inr (Or.inr (Or.inl + (by simpa [LatticeVertexIncidentCell] using hc))) + · exact Or.inr (Or.inl + (by simpa [LatticeVertexIncidentCell] using ⟨hc.2, hc.1⟩)) + · exact Or.inr (Or.inr (Or.inr + (by simpa [LatticeVertexIncidentCell] using ⟨hc.2, hc.1⟩))) + · fin_cases t + · exact Or.inr (Or.inl (by simpa [LatticeVertexIncidentCell] using hc)) + · exact Or.inr (Or.inr (Or.inr + (by simpa [LatticeVertexIncidentCell] using hc))) + · exact Or.inl + (by simpa [LatticeVertexIncidentCell] using ⟨hc.2, hc.1⟩) + · exact Or.inr (Or.inr (Or.inl + (by simpa [LatticeVertexIncidentCell] using ⟨hc.2, hc.1⟩))) + +private theorem hchange'At1020 : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (x : GaussianInt), + let sectorSide : Fin 4 → Bool := fun j => decide (outerLabel x j = 1) + ∀ (i : Fin (4 : ℕ)), (sectorSide i ≠ sectorSide (i + (1 : Fin (4 : ℕ)))) → (outerLabel x + i ≠ outerLabel x (i + 1)) ) := by + classical + intro T0 T0' outerLabel x sectorSide i hchange heq + exact hchange (by simp only [sectorSide, heq]) + +private theorem hUVAt1027 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (a : + TilingLattice Ci), ∀ (b : TilingLattice Ci), (P.tile a = P.tile b) → (a = b)) → (∀ + (UL : ProtoTile), ∀ (VL : ProtoTile), ∀ (iaL : ↥(TilingLattice Ci)), ∀ (ibL : + ↥(TilingLattice Ci)), (P.tile iaL = UL) → ((P.tile ibL = VL) → ((iaL ≠ ibL) → (UL ≠ + VL)))) ) := by + classical + intro Ci P index_eq_of_tile_eq UL VL iaL ibL hULidx hVLidx hidxLne heq + exact hidxLne (index_eq_of_tile_eq iaL ibL + (hULidx.trans (heq.trans hVLidx.symm))) + +private theorem hUVAt1038 : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (a : + TilingLattice Ci), ∀ (b : TilingLattice Ci), (P.tile a = P.tile b) → (a = b)) → (∀ + (UR : ProtoTile), ∀ (VR : ProtoTile), ∀ (iaR : ↥(TilingLattice Ci)), ∀ (ibR : + ↥(TilingLattice Ci)), (P.tile iaR = UR) → ((P.tile ibR = VR) → ((iaR ≠ ibR) → (UR ≠ + VR)))) ) := by + classical + intro Ci P index_eq_of_tile_eq UR VR iaR ibR hURidx hVRidx hidxRne heq + exact hidxRne (index_eq_of_tile_eq iaR ibR + (hURidx.trans (heq.trans hVRidx.symm))) + +end LocalSectorGeometry + +namespace LocalSectorConclusions + +private theorem initialSector : + (by + classical + exact + ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (h0 + : PartialOdometer), ∀ (h0' : PartialOdometer), ∀ (Rminus : ProtoTile), ∀ (tiles : + List ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ (hs : List PartialOdometer), ∀ + (reverseHs : List PartialOdometer), ∀ (EM : ExactTileInterfaceTriple T0 T0' Rminus), + (LatticeTile T0) → ((LatticeTile T0') → ((LatticeTile Rminus) → ((Disjoint T0.cells + T0'.cells) → ((Disjoint T0.cells Rminus.cells) → ((Disjoint T0'.cells Rminus.cells) → + ((∀ x ∈ FootprintVertices T0, ∀ y ∈ FootprintVertices T0, FourNeighborAdjacent x y → + {x, y} ∈ FootprintEdges T0) → ((∀ x ∈ FootprintVertices T0', ∀ y ∈ FootprintVertices + T0', FourNeighborAdjacent x y → {x, y} ∈ FootprintEdges T0') → (∀ (path : List + GaussianInt), (path.head? = some EM.point) → (∀ (P : PeriodicTileComplex + ↥(TilingLattice Ci)), ∀ (minusIndex : ↥(TilingLattice Ci)), (P.tile minusIndex = + Rminus) → ((∀ (U : ProtoTile), ∀ (T : ProtoTile), ∀ (g : PartialOdometer), ∀ (h : + PartialOdometer), (AncestorOdometer Ci.1.1 C0.1.1 U T g h) → (U.cells ⊆ T.cells)) → ( + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + (∀ (a : TilingLattice Ci), ∀ (b : TilingLattice Ci), (P.tile a = P.tile b) → (a = b)) → + ((∀ (c : GaussianInt), ∀ (a : TilingLattice Ci), c ∈ (P.tile a).cells ↔ owner c = a) + → ((∀ (x : GaussianInt), owner (LatticeVertexIncidentCell x 0) = owner + (LatticeVertexIncidentCell x 1) ∨ owner (LatticeVertexIncidentCell x 0) = owner + (LatticeVertexIncidentCell x 2) ∨ owner (LatticeVertexIncidentCell x 0) = owner + (LatticeVertexIncidentCell x 3) ∨ owner (LatticeVertexIncidentCell x 1) = owner + (LatticeVertexIncidentCell x 2) ∨ owner (LatticeVertexIncidentCell x 1) = owner + (LatticeVertexIncidentCell x 3) ∨ owner (LatticeVertexIncidentCell x 2) = owner + (LatticeVertexIncidentCell x 3)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (x : + GaussianInt), ∀ (l : List GaussianInt), ∀ (r : List GaussianInt), (path = l ++ a :: b + :: r) → ((x = a ∨ x = b) → (∃ U V : ProtoTile, ∃ g k : PartialOdometer, ∃ ia ib : + TilingLattice Ci, ∃ j : Fin 4, ({a, b} : Finset GaussianInt) = ![{x, x + ⟨0, 1⟩}, + {x - 1, x}, {x - ⟨0, 1⟩, x}, {x, x + 1}] j ∧ U ∈ (tiles.drop 1).dropLast ∧ (U, g) ∈ + tiles.zip hs ∧ {a, b} ∈ FootprintEdges U ∧ AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0 ∧ + V ∈ (reverseTiles.drop 1).dropLast ∧ (V, k) ∈ reverseTiles.zip reverseHs ∧ {a, b} ∈ + FootprintEdges V ∧ AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0' ∧ P.tile ia = U ∧ + P.tile ib = V ∧ ia ≠ ib ∧ (LatticeVertexIncidentCell x j ∈ (P.tile ia).cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ (P.tile ib).cells ∨ LatticeVertexIncidentCell x + j ∈ (P.tile ib).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (P.tile ia).cells)))) → + (∀ (x : GaussianInt), (∀ (y : GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x + - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices T0 ∨ y ∈ FootprintVertices T0') → + ((path.Nodup) → (((2 : ℕ) ≤ path.length) → ((∀ (e : Finset GaussianInt), e ∈ + FootprintEdges T0 ∩ FootprintEdges T0' ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l : + List GaussianInt) (r : List GaussianInt), path = l ++ a :: b :: r ∧ e = {a, b}) → ((∀ + (p : List GaussianInt), (p.Nodup) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ + (rest : List GaussianInt), (p = x :: y :: rest) → (∀ (e : Finset GaussianInt), (∃ a b + : GaussianInt, ∃ l r : List GaussianInt, p = l ++ a :: b :: r ∧ e = {a, b}) → ((x ∈ + e) → (e = {x, y}))))) → (∀ (pre : List GaussianInt), ∀ (suf : List GaussianInt), + (path = pre ++ x :: suf) → ((pre = []) → (∃ y : GaussianInt, ∃ U V : ProtoTile, ∃ g k + : PartialOdometer, ((∃ l r : List GaussianInt, path = l ++ x :: y :: r) ∨ (∃ l r : + List GaussianInt, path = l ++ y :: x :: r)) ∧ U ≠ V ∧ {x, y} ∈ FootprintEdges U ∩ + FootprintEdges V ∧ U ∈ (tiles.drop 1).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ + AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0 ∧ V ∈ (reverseTiles.drop 1).dropLast ∧ (V, + k) ∈ reverseTiles.zip reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0' ∧ ((x ∈ + U.cells ∧ x - 1 - ⟨0, 1⟩ ∈ V.cells) ∨ (x ∈ V.cells ∧ x - 1 - ⟨0, 1⟩ ∈ U.cells) ∨ (x - + 1 ∈ U.cells ∧ x - ⟨0, 1⟩ ∈ V.cells) ∨ (x - 1 ∈ V.cells ∧ x - ⟨0, 1⟩ ∈ + U.cells)))))))))))))))))))))))) ) := by + classical + intro C0 Ci T0 T0' h0 h0' Rminus tiles reverseTiles hs reverseHs EM hT hT' hRm hdis hTm hT'm + hreg hreg' path hhead P minusIndex hminusIndex ancestor_cells owner index_eq_of_tile_eq + owner_mem_iff owner_no_fourfold indexed_transition x hstar hnodup hlength hedgesPath + first_edge_unique pre suf hsplit hpre + subst pre + have hsuf := LocalSectorGeometry.hsuf path x hlength suf hsplit + obtain ⟨y, rest, rfl⟩ := List.exists_cons_of_ne_nil hsuf + have hpathEdge : path = [] ++ x :: y :: rest := by simpa using hsplit + have hstart : x = EM.point := by + simpa [hpathEdge] using hhead + rcases indexed_transition x y x [] rest hpathEdge (Or.inl rfl) with + ⟨U, V, g, k, ia, ib, jEdge, hedgeAt, hUint, hzip, hedgeU, + hancU, hVint, hzip', hedgeV, hancV, hUidx, hVidx, hidxne, + hsectorEdge⟩ + have hfinalCells := P5635T1EndpointDiagonalOwnership P owner owner_mem_iff + owner_no_fourfold T0 T0' Rminus U V EM hT hT' hRm hdis hTm hT'm + hreg hreg' minusIndex ia ib hminusIndex hUidx hVidx hidxne + (ancestor_cells U T0 g h0 hancU) (ancestor_cells V T0' k h0' hancV) + x y hstart hstar ⟨hedgeU, hedgeV⟩ (by + intro e hxe he + exact first_edge_unique path hnodup x y rest hpathEdge e + ((hedgesPath e).mp he) hxe) + have hUV : U ≠ V := LocalSectorGeometry.hUVAt563 Ci P index_eq_of_tile_eq U V ia ib hUidx + hVidx hidxne + exact ⟨y, U, V, g, k, Or.inl ⟨[], rest, hpathEdge⟩, + hUV, ⟨hedgeU, hedgeV⟩, hUint, hzip, hancU, + hVint, hzip', hancV, hfinalCells⟩ + +private theorem terminalSector : + (by + classical + exact + ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (h0 + : PartialOdometer), ∀ (h0' : PartialOdometer), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ (hs : List PartialOdometer), ∀ + (reverseHs : List PartialOdometer), ∀ (EP : ExactTileInterfaceTriple T0 T0' Rplus), + (LatticeTile T0) → ((LatticeTile T0') → ((LatticeTile Rplus) → ((Disjoint T0.cells + T0'.cells) → ((Disjoint T0.cells Rplus.cells) → ((Disjoint T0'.cells Rplus.cells) → + ((∀ x ∈ FootprintVertices T0, ∀ y ∈ FootprintVertices T0, FourNeighborAdjacent x y → + {x, y} ∈ FootprintEdges T0) → ((∀ x ∈ FootprintVertices T0', ∀ y ∈ FootprintVertices + T0', FourNeighborAdjacent x y → {x, y} ∈ FootprintEdges T0') → (∀ (path : List + GaussianInt), (path.getLast? = some EP.point) → (∀ (P : PeriodicTileComplex + ↥(TilingLattice Ci)), ∀ (plusIndex : ↥(TilingLattice Ci)), (P.tile plusIndex = Rplus) + → ((∀ (U : ProtoTile), ∀ (T : ProtoTile), ∀ (g : PartialOdometer), ∀ (h : + PartialOdometer), (AncestorOdometer Ci.1.1 C0.1.1 U T g h) → (U.cells ⊆ T.cells)) → ( + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + (∀ (a : TilingLattice Ci), ∀ (b : TilingLattice Ci), (P.tile a = P.tile b) → (a = b)) → + ((∀ (c : GaussianInt), ∀ (a : TilingLattice Ci), c ∈ (P.tile a).cells ↔ owner c = a) + → ((∀ (x : GaussianInt), owner (LatticeVertexIncidentCell x 0) = owner + (LatticeVertexIncidentCell x 1) ∨ owner (LatticeVertexIncidentCell x 0) = owner + (LatticeVertexIncidentCell x 2) ∨ owner (LatticeVertexIncidentCell x 0) = owner + (LatticeVertexIncidentCell x 3) ∨ owner (LatticeVertexIncidentCell x 1) = owner + (LatticeVertexIncidentCell x 2) ∨ owner (LatticeVertexIncidentCell x 1) = owner + (LatticeVertexIncidentCell x 3) ∨ owner (LatticeVertexIncidentCell x 2) = owner + (LatticeVertexIncidentCell x 3)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (x : + GaussianInt), ∀ (l : List GaussianInt), ∀ (r : List GaussianInt), (path = l ++ a :: b + :: r) → ((x = a ∨ x = b) → (∃ U V : ProtoTile, ∃ g k : PartialOdometer, ∃ ia ib : + TilingLattice Ci, ∃ j : Fin 4, ({a, b} : Finset GaussianInt) = ![{x, x + ⟨0, 1⟩}, + {x - 1, x}, {x - ⟨0, 1⟩, x}, {x, x + 1}] j ∧ U ∈ (tiles.drop 1).dropLast ∧ (U, g) ∈ + tiles.zip hs ∧ {a, b} ∈ FootprintEdges U ∧ AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0 ∧ + V ∈ (reverseTiles.drop 1).dropLast ∧ (V, k) ∈ reverseTiles.zip reverseHs ∧ {a, b} ∈ + FootprintEdges V ∧ AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0' ∧ P.tile ia = U ∧ + P.tile ib = V ∧ ia ≠ ib ∧ (LatticeVertexIncidentCell x j ∈ (P.tile ia).cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ (P.tile ib).cells ∨ LatticeVertexIncidentCell x + j ∈ (P.tile ib).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (P.tile ia).cells)))) → + (∀ (x : GaussianInt), (∀ (y : GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x + - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices T0 ∨ y ∈ FootprintVertices T0') → + ((path.Nodup) → ((∀ (e : Finset GaussianInt), e ∈ FootprintEdges T0 ∩ FootprintEdges + T0' ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l : List GaussianInt) (r : List + GaussianInt), path = l ++ a :: b :: r ∧ e = {a, b}) → ((∀ (p : List GaussianInt), + (p.Nodup) → (∀ (x : GaussianInt), ∀ (z : GaussianInt), ∀ (rest : List GaussianInt), + (p = rest ++ z :: x :: []) → (∀ (e : Finset GaussianInt), (∃ a b : GaussianInt, ∃ l r + : List GaussianInt, p = l ++ a :: b :: r ∧ e = {a, b}) → ((x ∈ e) → (e = {z, x}))))) + → (∀ (pre : List GaussianInt), (¬pre = []) → ((path = pre ++ [x]) → (∃ y : + GaussianInt, ∃ U V : ProtoTile, ∃ g k : PartialOdometer, ((∃ l r : List GaussianInt, + path = l ++ x :: y :: r) ∨ (∃ l r : List GaussianInt, path = l ++ y :: x :: r)) ∧ U ≠ + V ∧ {x, y} ∈ FootprintEdges U ∩ FootprintEdges V ∧ U ∈ (tiles.drop 1).dropLast ∧ (U, + g) ∈ tiles.zip hs ∧ AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0 ∧ V ∈ (reverseTiles.drop + 1).dropLast ∧ (V, k) ∈ reverseTiles.zip reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 V + T0' k h0' ∧ ((x ∈ U.cells ∧ x - 1 - ⟨0, 1⟩ ∈ V.cells) ∨ (x ∈ V.cells ∧ x - 1 - ⟨0, 1⟩ + ∈ U.cells) ∨ (x - 1 ∈ U.cells ∧ x - ⟨0, 1⟩ ∈ V.cells) ∨ (x - 1 ∈ V.cells ∧ x - ⟨0, 1⟩ + ∈ U.cells))))))))))))))))))))))) ) := by + classical + intro C0 Ci T0 T0' h0 h0' Rplus tiles reverseTiles hs reverseHs EP hT hT' hRp hdis hTp hT'p + hreg hreg' path hlast P plusIndex hplusIndex ancestor_cells owner index_eq_of_tile_eq + owner_mem_iff owner_no_fourfold indexed_transition x hstar hnodup hedgesPath + last_edge_unique pre hpre hsplit + have hpre' : pre ≠ [] := hpre + let z := pre.getLast hpre' + let pre' := pre.dropLast + have hpreEq : pre' ++ [z] = pre := List.dropLast_append_getLast hpre' + have hpathLast : path = pre' ++ z :: x :: [] := LocalSectorGeometry.hpathLast path x pre + hsplit hpre' hpreEq + have hend : x = EP.point := by + simpa [hsplit] using hlast + rcases indexed_transition z x x pre' [] hpathLast (Or.inr rfl) with + ⟨U, V, g, k, ia, ib, jEdge, hedgeAt, hUint, hzip, hedgeU, + hancU, hVint, hzip', hedgeV, hancV, hUidx, hVidx, hidxne, + hsectorEdge⟩ + have hfinalCells := P5635T1EndpointDiagonalOwnership P owner owner_mem_iff + owner_no_fourfold T0 T0' Rplus U V EP hT hT' hRp hdis hTp hT'p + hreg hreg' plusIndex ia ib hplusIndex hUidx hVidx hidxne + (ancestor_cells U T0 g h0 hancU) (ancestor_cells V T0' k h0' hancV) + x z hend hstar + ⟨by simpa [Finset.pair_comm] using hedgeU, + by simpa [Finset.pair_comm] using hedgeV⟩ (by + intro e hxe he + simpa [Finset.pair_comm] using + last_edge_unique path hnodup x z pre' hpathLast e + ((hedgesPath e).mp he) hxe) + have hUV : U ≠ V := LocalSectorGeometry.hUVAt597 Ci P index_eq_of_tile_eq U V ia ib hUidx + hVidx hidxne + exact ⟨z, U, V, g, k, Or.inr ⟨pre', [], hpathLast⟩, + hUV, ⟨by simpa [Finset.pair_comm] using hedgeU, + by simpa [Finset.pair_comm] using hedgeV⟩, hUint, hzip, hancU, + hVint, hzip', hancV, hfinalCells⟩ + +private theorem interiorSector : + (by + classical + exact + ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (h0 + : PartialOdometer), ∀ (h0' : PartialOdometer), ∀ (tiles : List ProtoTile), ∀ + (reverseTiles : List ProtoTile), ∀ (hs : List PartialOdometer), ∀ (reverseHs : List + PartialOdometer), (LatticeTile T0) → ((LatticeTile T0') → ((Disjoint T0.cells + T0'.cells) → (∀ (path : List GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice + Ci)), + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (x : GaussianInt), ∀ (j : Fin 4), x ∈ edgeAt x j ∧ neighbor x j ∈ edgeAt x j) → ((∀ (x + : GaussianInt), ∀ {j : Fin 4}, ∀ {k : Fin 4}, (edgeAt x j = edgeAt x k) → (j = k)) → + ((∀ (R : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x + j ∈ R.cells ∨ LatticeVertexIncidentCell x (j + 1) ∈ R.cells) → (edgeAt x j ∈ + FootprintEdges R)) → ( + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → + (outerLabel x j = 0)) → ((∀ (x : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ T0'.cells) → (outerLabel x j = 1)) → ((∀ (U : + ProtoTile), ∀ (T : ProtoTile), ∀ (g : PartialOdometer), ∀ (h : PartialOdometer), + (AncestorOdometer Ci.1.1 C0.1.1 U T g h) → (U.cells ⊆ T.cells)) → ( + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + (∀ (c : GaussianInt), ∀ (a : TilingLattice Ci), (c ∈ (P.tile a).cells) → (owner c = a)) → + ((∀ (a : TilingLattice Ci), ∀ (b : TilingLattice Ci), (P.tile a = P.tile b) → (a = + b)) → ((∀ (c : GaussianInt), ∀ (a : TilingLattice Ci), c ∈ (P.tile a).cells ↔ owner c + = a) → ((∀ (x : GaussianInt), owner (LatticeVertexIncidentCell x 0) = owner + (LatticeVertexIncidentCell x 1) ∨ owner (LatticeVertexIncidentCell x 0) = owner + (LatticeVertexIncidentCell x 2) ∨ owner (LatticeVertexIncidentCell x 0) = owner + (LatticeVertexIncidentCell x 3) ∨ owner (LatticeVertexIncidentCell x 1) = owner + (LatticeVertexIncidentCell x 2) ∨ owner (LatticeVertexIncidentCell x 1) = owner + (LatticeVertexIncidentCell x 3) ∨ owner (LatticeVertexIncidentCell x 2) = owner + (LatticeVertexIncidentCell x 3)) → ((∀ (x : GaussianInt), ∀ (a : TilingLattice Ci), ¬ + ((owner (LatticeVertexIncidentCell x 0) = a ∧ owner (LatticeVertexIncidentCell x 2) = + a ∧ owner (LatticeVertexIncidentCell x 1) ≠ a ∧ owner (LatticeVertexIncidentCell x 3) + ≠ a) ∨ (owner (LatticeVertexIncidentCell x 1) = a ∧ owner (LatticeVertexIncidentCell + x 3) = a ∧ owner (LatticeVertexIncidentCell x 0) ≠ a ∧ owner + (LatticeVertexIncidentCell x 2) ≠ a))) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), + ∀ (x : GaussianInt), ∀ (l : List GaussianInt), ∀ (r : List GaussianInt), (path = l ++ + a :: b :: r) → ((x = a ∨ x = b) → (∃ U V : ProtoTile, ∃ g k : PartialOdometer, ∃ ia + ib : TilingLattice Ci, ∃ j : Fin 4, ({a, b} : Finset GaussianInt) = ![{x, x + ⟨0, + 1⟩}, {x - 1, x}, {x - ⟨0, 1⟩, x}, {x, x + 1}] j ∧ U ∈ (tiles.drop 1).dropLast ∧ (U, + g) ∈ tiles.zip hs ∧ {a, b} ∈ FootprintEdges U ∧ AncestorOdometer Ci.1.1 C0.1.1 U T0 g + h0 ∧ V ∈ (reverseTiles.drop 1).dropLast ∧ (V, k) ∈ reverseTiles.zip reverseHs ∧ {a, + b} ∈ FootprintEdges V ∧ AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0' ∧ P.tile ia = U ∧ + P.tile ib = V ∧ ia ≠ ib ∧ (LatticeVertexIncidentCell x j ∈ (P.tile ia).cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ (P.tile ib).cells ∨ LatticeVertexIncidentCell x + j ∈ (P.tile ib).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (P.tile ia).cells)))) → + (∀ (x : GaussianInt), (x ∈ path) → ((∀ (y : GaussianInt), y = x ∨ y = x + (1 : + GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices T0 ∨ y ∈ + FootprintVertices T0') → ((path.Nodup) → ((∀ (e : Finset GaussianInt), e ∈ + FootprintEdges T0 ∩ FootprintEdges T0' ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l : + List GaussianInt) (r : List GaussianInt), path = l ++ a :: b :: r ∧ e = {a, b}) → (∀ + (pre : List GaussianInt), (¬pre = []) → (∀ (y : GaussianInt), ∀ (rest : List + GaussianInt), (path = pre ++ x :: y :: rest) → (∃ y : GaussianInt, ∃ U V : ProtoTile, + ∃ g k : PartialOdometer, ((∃ l r : List GaussianInt, path = l ++ x :: y :: r) ∨ (∃ l + r : List GaussianInt, path = l ++ y :: x :: r)) ∧ U ≠ V ∧ {x, y} ∈ FootprintEdges U ∩ + FootprintEdges V ∧ U ∈ (tiles.drop 1).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ + AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0 ∧ V ∈ (reverseTiles.drop 1).dropLast ∧ (V, + k) ∈ reverseTiles.zip reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0' ∧ ((x ∈ + U.cells ∧ x - 1 - ⟨0, 1⟩ ∈ V.cells) ∨ (x ∈ V.cells ∧ x - 1 - ⟨0, 1⟩ ∈ U.cells) ∨ (x - + 1 ∈ U.cells ∧ x - ⟨0, 1⟩ ∈ V.cells) ∨ (x - 1 ∈ V.cells ∧ x - ⟨0, 1⟩ ∈ + U.cells))))))))))))))))))))))) ) := by + classical + intro C0 Ci T0 T0' h0 h0' tiles reverseTiles hs reverseHs hT hT' hdis path P neighbor edgeAt + edgeAt_mem edgeAt_injective edge_of_sector_cell outerLabel label_T0 label_T0' + ancestor_cells owner owner_unique index_eq_of_tile_eq owner_mem_iff owner_no_fourfold + owner_no_checkerboard indexed_transition x hx hstar hnodup hedgesPath pre hpre y rest hsplit + have hpre' : pre ≠ [] := hpre + let z := pre.getLast hpre' + let pre' := pre.dropLast + have hpreEq : pre' ++ [z] = pre := List.dropLast_append_getLast hpre' + have hleft : path = pre' ++ z :: x :: y :: rest := LocalSectorGeometry.hleft path x pre y + rest hsplit hpre' hpreEq + have hright : path = pre ++ x :: y :: rest := hsplit + have hleftWitness := indexed_transition z x x pre' (y :: rest) + hleft (Or.inr rfl) + have hrightWitness := indexed_transition x y x pre rest hright (Or.inl rfl) + rcases hleftWitness with ⟨UL, VL, gL, kL, iaL, ibL, jL, eL, + hULint, hULzip, hedgeUL, hancUL, hVLint, hVLzip, hedgeVL, + hancVL, hULidx, hVLidx, hidxLne, hsectorL⟩ + rcases hrightWitness with ⟨UR, VR, gR, kR, iaR, ibR, jR, eR, + hURint, hURzip, hedgeUR, hancUR, hVRint, hVRzip, hedgeVR, + hancVR, hURidx, hVRidx, hidxRne, hsectorR⟩ + have hnodupPath : (pre' ++ z :: x :: y :: rest).Nodup := by + simpa [hleft] using hnodup + have htailNodup : (z :: x :: y :: rest).Nodup := + (List.nodup_append.mp hnodupPath).2.1 + have hznot : z ∉ x :: y :: rest := (List.nodup_cons.mp htailNodup).1 + have hzx := LocalSectorGeometry.hzx Ci T0 T0' path P x hx hstar pre y rest hsplit hpre' + hleft hright UL VL iaL ibL jL eL hedgeUL hedgeVL hsectorL UR VR iaR ibR jR eR hedgeUR + hedgeVR hsectorR hnodupPath htailNodup hznot + have hzy := LocalSectorGeometry.hzy path x pre y rest hsplit hpre' hleft hright UR VR jR + eR hedgeUR hedgeVR hnodupPath htailNodup hznot + have hEdgeNe : ({z, x} : Finset GaussianInt) ≠ {x, y} := LocalSectorGeometry.hEdgeNe x + pre y hpre' hzx hzy + have hjne := LocalSectorGeometry.hjne x pre y hpre' jL eL jR eR hzx hzy + have hedgeL : {z, x} ∈ FootprintEdges T0 ∩ FootprintEdges T0' := + (hedgesPath {z, x}).mpr ⟨z, x, pre', y :: rest, hleft, rfl⟩ + have hedgeR : {x, y} ∈ FootprintEdges T0 ∩ FootprintEdges T0' := + (hedgesPath {x, y}).mpr ⟨x, y, pre, rest, hright, rfl⟩ + obtain ⟨hsectorOuter, hsectorOpp⟩ := (LocalLatticeInterfaceSectors.2 + T0 T0' x hT hT' hdis + ⟨{z, x}, {x, y}, hEdgeNe, by simp, by simp, hedgeL, hedgeR⟩) + have hULsub : UL.cells ⊆ T0.cells := + ancestor_cells UL T0 gL h0 hancUL + have hVLsub : VL.cells ⊆ T0'.cells := + ancestor_cells VL T0' kL h0' hancVL + have hURsub : UR.cells ⊆ T0.cells := + ancestor_cells UR T0 gR h0 hancUR + have hVRsub : VR.cells ⊆ T0'.cells := + ancestor_cells VR T0' kR h0' hancVR + have hLaligned := LocalSectorGeometry.hLaligned Ci T0 T0' P label_T0 label_T0' + owner_unique x UL VL iaL ibL jL hULidx hVLidx hsectorL hULsub hVLsub + have hRaligned := LocalSectorGeometry.hRaligned Ci T0 T0' P label_T0 label_T0' + owner_unique x UR VR iaR ibR jR hURidx hVRidx hsectorR hURsub hVRsub + have transition_is_path_edge := LocalSectorGeometry.transition_is_path_edge T0 T0' path + edgeAt_mem edgeAt_injective edge_of_sector_cell x hedgesPath pre y hpre' jL eL jR eR + (LocalSectorGeometry.internal_edge_unique Ci path P x hnodup pre y hpre' + (LocalSectorGeometry.hidxX path x pre y rest hpre' hleft hnodupPath) + (LocalSectorGeometry.hidxY path x pre y rest hpre' hleft hnodupPath) + (LocalSectorGeometry.hidxZ path x pre y rest hpre' hleft hnodupPath)) + (LocalSectorGeometry.outer_side_class T0 T0' label_T0 label_T0' x hsectorOuter) + let sectorOwner : Fin 4 → TilingLattice Ci := fun j => + owner (LatticeVertexIncidentCell x j) + let sectorSide : Fin 4 → Bool := fun j => decide (outerLabel x j = 1) + have side_mem_zero := LocalSectorGeometry.side_mem_zero T0 T0' label_T0 x + have side_mem_one := LocalSectorGeometry.side_mem_one T0 T0' label_T0' x + have sector_in_tile := LocalSectorGeometry.sector_in_tile Ci P owner_mem_iff x + have side_same_T0 := LocalSectorGeometry.side_same_T0 Ci T0 T0' P x side_mem_zero + sector_in_tile + have side_same_T0' := LocalSectorGeometry.side_same_T0' Ci T0 T0' P x side_mem_one + sector_in_tile + have side_consistent_left := LocalSectorGeometry.side_consistent_left Ci T0 T0' P x UL VL + iaL ibL jL hULidx hVLidx UR VR iaR ibR jR hURidx hVRidx hULsub hVLsub hURsub hVRsub + hLaligned hRaligned transition_is_path_edge side_same_T0 side_same_T0' + have side_consistent_right := LocalSectorGeometry.side_consistent_right Ci T0 T0' P x UL + VL iaL ibL jL hULidx hVLidx UR VR iaR ibR jR hURidx hVRidx hULsub hVLsub hURsub + hVRsub hLaligned hRaligned transition_is_path_edge side_same_T0 side_same_T0' + have hownerRepeat := owner_no_fourfold x + have hownerCheckA := owner_no_checkerboard x (sectorOwner 0) + have hownerCheckB := owner_no_checkerboard x (sectorOwner 1) + have hownerOpp := LocalSectorGeometry.hownerOpp T0 T0' x hsectorOpp side_mem_zero + side_mem_one + obtain ⟨i, hchange, hselected⟩ := P4431T1OwnerTransitionSelector + sectorOwner sectorSide side_consistent_left side_consistent_right + hownerRepeat (by + intro hcheck + rcases hcheck with h | h + · exact hownerCheckA (Or.inl ⟨rfl, h.1.symm, h.2.1, h.2.2⟩) + · exact hownerCheckB (Or.inr ⟨rfl, h.1.symm, h.2.1, h.2.2⟩)) + hownerOpp + have diagonal_cells := LocalSectorGeometry.diagonal_cells Ci P x sector_in_tile + have hchange' := LocalSectorGeometry.hchange'At1020 T0 T0' x i hchange + rcases transition_is_path_edge i hchange' with hi | hi <;> subst i + · have hd := diagonal_cells jL UL VL iaL ibL hULidx hVLidx + (hLaligned.imp (fun h => ⟨h.1.2, h.2.2⟩) (fun h => ⟨h.1.2, h.2.2⟩)) + hselected + have hUV : UL ≠ VL := LocalSectorGeometry.hUVAt1027 Ci P index_eq_of_tile_eq UL VL iaL + ibL hULidx hVLidx hidxLne + exact ⟨z, UL, VL, gL, kL, Or.inr ⟨pre', y :: rest, hleft⟩, + hUV, ⟨by simpa only [Finset.pair_comm] using hedgeUL, + by simpa only [Finset.pair_comm] using hedgeVL⟩, + hULint, hULzip, hancUL, hVLint, hVLzip, hancVL, hd⟩ + · have hd := diagonal_cells jR UR VR iaR ibR hURidx hVRidx + (hRaligned.imp (fun h => ⟨h.1.2, h.2.2⟩) (fun h => ⟨h.1.2, h.2.2⟩)) + hselected + have hUV : UR ≠ VR := LocalSectorGeometry.hUVAt1038 Ci P index_eq_of_tile_eq UR VR iaR + ibR hURidx hVRidx hidxRne + exact ⟨y, UR, VR, gR, kR, Or.inl ⟨pre, rest, hright⟩, + hUV, ⟨hedgeUR, hedgeVR⟩, + hURint, hURzip, hancUR, hVRint, hVRzip, hancVR, hd⟩ + +end LocalSectorConclusions + +theorem P4366T2LocalSectors + (C0 Ci : BandCircle) (hlarge : 1 < Ci.1.1.1) + (T0 T0' : ProtoTile) (h0 h0' : PartialOdometer) + (orientation : Bool) (base Rminus Rplus : ProtoTile) + (tiles reverseTiles : List ProtoTile) (hs reverseHs : List PartialOdometer) + (hf : TileString Ci orientation base Rminus Rplus tiles) + (hr : TileString Ci orientation base Rplus Rminus reverseTiles) + (EM : ExactTileInterfaceTriple T0 T0' Rminus) + (EP : ExactTileInterfaceTriple T0 T0' Rplus) + (hT : LatticeTile T0) (hT' : LatticeTile T0') + (hRm : LatticeTile Rminus) (hRp : LatticeTile Rplus) + (hdis : Disjoint T0.cells T0'.cells) + (hTm : Disjoint T0.cells Rminus.cells) + (hT'm : Disjoint T0'.cells Rminus.cells) + (hTp : Disjoint T0.cells Rplus.cells) + (hT'p : Disjoint T0'.cells Rplus.cells) + (hreg : ∀ x, x ∈ FootprintVertices T0 → ∀ y, y ∈ FootprintVertices T0 → + FourNeighborAdjacent x y → {x, y} ∈ FootprintEdges T0) + (hreg' : ∀ x, x ∈ FootprintVertices T0' → ∀ y, y ∈ FootprintVertices T0' → + FourNeighborAdjacent x y → {x, y} ∈ FootprintEdges T0') + (path : List GaussianInt) + (hp : path.Nodup ∧ 2 ≤ path.length ∧ + path.head? = some EM.point ∧ path.getLast? = some EP.point ∧ + FootprintVertices T0 ∩ FootprintVertices T0' = (path.toFinset : Set GaussianInt) ∧ + (∀ a b : GaussianInt, ∀ l r : List GaussianInt, + path = l ++ a :: b :: r → FourNeighborAdjacent a b) ∧ + ∀ e, e ∈ FootprintEdges T0 ∩ FootprintEdges T0' ↔ + ∃ a b : GaussianInt, ∃ l r : List GaussianInt, + path = l ++ a :: b :: r ∧ e = {a, b}) + (hedges : ∀ a b : GaussianInt, ∀ l r : List GaussianInt, + path = l ++ a :: b :: r → + (∃ U g, U ∈ (tiles.drop 1).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ + {a, b} ∈ FootprintEdges U ∧ + AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0) ∧ + (∃ V k, V ∈ (reverseTiles.drop 1).dropLast ∧ + (V, k) ∈ reverseTiles.zip reverseHs ∧ {a, b} ∈ FootprintEdges V ∧ + AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0')) : + ∀ x, x ∈ path → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices T0 ∨ y ∈ FootprintVertices T0') → + ∃ y : GaussianInt, ∃ U V : ProtoTile, ∃ g k : PartialOdometer, + ((∃ l r : List GaussianInt, path = l ++ x :: y :: r) ∨ + (∃ l r : List GaussianInt, path = l ++ y :: x :: r)) ∧ + U ≠ V ∧ {x, y} ∈ FootprintEdges U ∩ FootprintEdges V ∧ + U ∈ (tiles.drop 1).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ + AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0 ∧ + V ∈ (reverseTiles.drop 1).dropLast ∧ + (V, k) ∈ reverseTiles.zip reverseHs ∧ + AncestorOdometer Ci.1.1 C0.1.1 V T0' k h0' ∧ + ((x ∈ U.cells ∧ x - 1 - ⟨0, 1⟩ ∈ V.cells) ∨ + (x ∈ V.cells ∧ x - 1 - ⟨0, 1⟩ ∈ U.cells) ∨ + (x - 1 ∈ U.cells ∧ x - ⟨0, 1⟩ ∈ V.cells) ∨ + (x - 1 ∈ V.cells ∧ x - ⟨0, 1⟩ ∈ U.cells)) := by +-- BODY + classical + rcases hf with ⟨hbase, hhead, hlast, hpair, hfamily, hchain, hheight⟩ + have hgene := BandGenealogy Ci + rcases hgene with hunit | ⟨q, hsemi, hq0, hbelow, hcanonical⟩ + · simp [hunit] at hlarge + · have hbelow' : ∀ j : Fin 3, (q j.succ).1 < (q 0).1 := by + simpa [hq0] using hbelow + have hproper : ProperBandQuadruple q := ⟨hsemi, hbelow'⟩ + have hbase' : BandPrototile (q 0) base := by simpa [hq0] using hbase + obtain ⟨P, hPlattice, htiles, hadjacent, hposition, hvertices, hedgesP, + hfaces, hchart⟩ := BandRegularTranslatePeriodicComplex Ci q hproper hq0 + base hbase' + let tileAt : Int × Int → ProtoTile := fun mn => TileTranslation base + ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (mn.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) + let chart : AffineTriangularComplexChart P tileAt := Classical.choice hchart + have regular_index := LocalSectorGeometry.regular_index Ci base P htiles + have htiles_lattice := LocalSectorGeometry.htiles_lattice Ci base q hproper hbase' P htiles + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + have edgeAt_mem := LocalSectorGeometry.edgeAt_mem + have edgeAt_eq_pair := LocalSectorGeometry.edgeAt_eq_pair + have edgeAt_injective (x : GaussianInt) {j k : Fin 4} + (h : edgeAt x j = edgeAt x k) := LocalSectorGeometry.edgeAt_injective + (LocalSectorGeometry.neighbor_ne_center) (LocalSectorGeometry.neighbor_injective Ci + path P) edgeAt_mem x (j := j) (k := k) h + have edge_of_sector_cell := LocalSectorGeometry.edge_of_sector_cell + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + have label_T0 := LocalSectorGeometry.label_T0 T0 T0' + have label_T0' := LocalSectorGeometry.label_T0' T0 T0' hdis + rcases hr with ⟨hbaseR, hheadR, hlastR, hpairR, hfamilyR, hchainR, hheightR⟩ + have forward_index := LocalSectorGeometry.forward_index Ci base tiles hs hfamily P regular_index + have reverse_index := LocalSectorGeometry.reverse_index Ci base reverseTiles reverseHs P + regular_index hfamilyR + obtain ⟨minusIndex, hminusIndex⟩ := regular_index Rminus + (hfamily Rminus (List.mem_of_head? hhead)) + obtain ⟨plusIndex, hplusIndex⟩ := regular_index Rplus + (hfamily Rplus (List.mem_of_getLast? hlast)) + have ancestor_cells (U T : ProtoTile) (g h : PartialOdometer) + (hanc : AncestorOdometer Ci.1.1 C0.1.1 U T g h) : + U.cells ⊆ T.cells := + P4158T1AncestorCells Ci.1.1 C0.1.1 U T hanc.2.1 + let owner : GaussianInt → TilingLattice Ci := fun c => + Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + have owner_cell (c : GaussianInt) : c ∈ (P.tile (owner c)).cells := + (Classical.choose_spec (PeriodicTileIndexedMultiplicityOne P c)).1 + have owner_unique (c : GaussianInt) (a : TilingLattice Ci) + (hc : c ∈ (P.tile a).cells) : owner c = a := + (PeriodicTileIndexedMultiplicityOne P c).unique (owner_cell c) hc + have index_eq_of_tile_eq := LocalSectorGeometry.index_eq_of_tile_eq Ci P htiles_lattice + have owner_mem_iff := LocalSectorGeometry.owner_mem_iff Ci P owner_cell owner_unique + have owner_eq_tile := LocalSectorGeometry.owner_eq_tile Ci P owner_unique + have owner_no_fourfold := LocalSectorGeometry.owner_no_fourfold Ci P owner_cell + (@LocalSectorGeometry.no_fourfold Ci base q P hchart) + have owner_no_checkerboard := LocalSectorGeometry.owner_no_checkerboard Ci P htiles_lattice + owner_mem_iff + have cross_ne := LocalSectorGeometry.cross_ne Ci T0 T0' hdis P htiles_lattice + have indexed_transition := LocalSectorGeometry.indexed_transition C0 Ci T0 T0' h0 h0' tiles + reverseTiles hs reverseHs hdis path P ancestor_cells + (LocalSectorGeometry.indexed_edge_witnesses C0 Ci T0 T0' h0 h0' tiles reverseTiles hs + reverseHs hdis path hedges P htiles_lattice forward_index reverse_index ancestor_cells) + intro x hx hstar + rcases hp with ⟨hnodup, hlength, hhead, hlast, hvertices, hstep, hedgesPath⟩ + have first_edge_unique := LocalSectorGeometry.first_edge_unique + have last_edge_unique (p : List GaussianInt) (hpNodup : p.Nodup) + (x z : GaussianInt) (rest : List GaussianInt) + (hpath : p = rest ++ z :: x :: []) (e : Finset GaussianInt) + (he : ∃ a b : GaussianInt, ∃ l r : List GaussianInt, + p = l ++ a :: b :: r ∧ e = {a, b}) + (hxe : x ∈ e) := LocalSectorGeometry.last_edge_unique first_edge_unique + (LocalSectorGeometry.reverse_edge_decomp) p hpNodup x z rest hpath e he hxe + have split_mem := LocalSectorGeometry.split_mem + obtain ⟨pre, suf, hsplit⟩ := split_mem path x hx + by_cases hpre : pre = [] + · have initialSector := LocalSectorConclusions.initialSector C0 Ci T0 T0' h0 h0' Rminus tiles + reverseTiles hs reverseHs EM hT hT' hRm hdis hTm hT'm hreg hreg' path hhead P minusIndex + hminusIndex ancestor_cells index_eq_of_tile_eq owner_mem_iff owner_no_fourfold + indexed_transition x hstar hnodup hlength hedgesPath first_edge_unique pre suf hsplit hpre + exact initialSector + · cases suf + · have terminalSector := LocalSectorConclusions.terminalSector C0 Ci T0 T0' h0 h0' Rplus + tiles reverseTiles hs reverseHs EP hT hT' hRp hdis hTp hT'p hreg hreg' path hlast P + plusIndex hplusIndex ancestor_cells index_eq_of_tile_eq owner_mem_iff owner_no_fourfold + indexed_transition x hstar hnodup hedgesPath last_edge_unique pre hpre hsplit + exact terminalSector + · rename_i y rest + exact (LocalSectorConclusions.interiorSector C0 Ci T0 T0' h0 h0' tiles reverseTiles hs + reverseHs hT hT' hdis path P edgeAt_mem edgeAt_injective edge_of_sector_cell label_T0 + label_T0' ancestor_cells owner_unique index_eq_of_tile_eq owner_mem_iff + owner_no_fourfold owner_no_checkerboard indexed_transition x hx hstar hnodup + hedgesPath pre hpre y rest hsplit) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean new file mode 100644 index 0000000000..ab734187d7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean @@ -0,0 +1,1602 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMixedAggregatePatches +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BoundaryString +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleRetargetMiddle +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEndpointPairUnique +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing + +-- [TABLET NODE: P4366T2OuterGeometry] + +/-! +# P4366T2OuterGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OuterGeometry + +private theorem hcurv0 : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C0 : BandCircle), (q (0 : Fin (4 : ℕ)) = C0.1.1) → + (0 < (q 0).1) ) := by + classical + intro q C0 hC0 + rw [hC0] + exact C0.2 + +private theorem hcurvi : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (q i.succ = + Ci.1.1) → (((1 : ℤ) < Ci.1.1.1) → (0 < (q i.succ).1)) ) := by + classical + intro q Ci i hCi hlarge + rw [hCi] + omega + +private theorem positive_nonempty : + (by + classical + exact + (Fin 4 -> CircleCoordinates) → ((BandCircle) → ((Fin 3) → (∀ (D : CircleCoordinates), ∀ + (U : ProtoTile), BandPrototile D U → 0 < D.1 → U.cells.Nonempty))) ) := by + classical + intro q Ci i D U hU + induction hU with + | line w x hw => intro hp; simp at hp + | unit z x a => intro hp; exact ⟨x, by simp⟩ + | @decompose r hr S U hs hc hf' hcent ih => + intro hp + have str := ProperBandCurvatureStructure r hr + have pos : ∃ j : Fin 3, 0 < (r j.succ).1 := by + by_contra hn + push Not at hn + have z0 : (r (0 : Fin 3).succ).1 = 0 := by + have := str.2.1 0 + have h := hn 0 + omega + have z1 : (r (1 : Fin 3).succ).1 = 0 := by + have := str.2.1 1 + have h := hn 1 + omega + exact (by decide : (0 : Fin 3) ≠ 1) (str.2.2 0 1 z0 z1) + obtain ⟨j, hj⟩ := pos + obtain ⟨x, hx⟩ := ih j true hj + exact ⟨x, (hc x).mpr ⟨j, true, hx⟩⟩ + +private theorem hcplus : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (T0 : ProtoTile), ∀ (Rplus : + ProtoTile), ∀ (qf : Fin (4 : ℕ) → CircleCoordinates), (TileCentroid Rplus - + TileCentroid T0 = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (qf i.succ) (qf (0 : + Fin (4 : ℕ))) + BandVectors.1 (qf (0 : Fin (4 : ℕ))) (qf i.succ))) → ((qf 0 = q 0) → + ((qf i.succ = q i.succ) → (TileCentroid Rplus - TileCentroid T0 = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + GaussianRealPoint + (BandVectors.1 (q 0) (q i.succ)))))) ) := by + classical + intro q i T0 Rplus qf hcentplus hvec0 hveci + simpa [hvec0, hveci, GaussianRealPoint] using hcentplus + +private theorem hcentT : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (T0 : ProtoTile), TileCentroid + (TileTranslation T0 (BandVectors.1 (q i.succ) (q 0))) = TileCentroid T0 + + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) ) := by + classical + intro q i T0 + rw [(TileTranslationFormulas T0 (BandVectors.1 (q i.succ) (q 0))).2.2.2.2.1] + ext <;> simp [GaussianRealPoint] + +private theorem hshift : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C0 : BandCircle), ∀ (i : Fin 3), ∀ (T0 : + ProtoTile), ∀ (T0' : ProtoTile), (TileCentroid T0' - TileCentroid T0 = + GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) → ((BandPrototile + C0.1.1 T0) → ((BandPrototile C0.1.1 T0') → ((TileCentroid (TileTranslation T0 + (BandVectors.1 (q i.succ) (q 0))) = TileCentroid T0 + GaussianRealPoint + (BandVectors.1 (q i.succ) (q 0))) → (T0'.cells = (TileTranslation T0 (BandVectors.1 + (q i.succ) (q 0))).cells)))) ) := by + classical + intro q C0 i T0 T0' hcentroid hT0 hT0' hcentT + have htr : BandPrototile C0.1.1 + (TileTranslation T0 (BandVectors.1 (q i.succ) (q 0))) := + BandPrototileTranslation C0.1.1 T0 _ hT0 + have hcentroidEq : TileCentroid T0' = + TileCentroid (TileTranslation T0 (BandVectors.1 (q i.succ) (q 0))) := by + have hh : TileCentroid T0' = + TileCentroid T0 + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) := by + calc + TileCentroid T0' = + (TileCentroid T0' - TileCentroid T0) + TileCentroid T0 := by + ext <;> simp + _ = GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + TileCentroid T0 := by + rw [hcentroid] + _ = TileCentroid T0 + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) := by + ext <;> simp <;> ring + simpa [hcentT] using hh + exact (BandPrototileCentroidUnique C0.1.1 _ _ hT0' htr hcentroidEq).1 + +private theorem hrealShift : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (T0 : ProtoTile), ∀ (T0' : + ProtoTile), (T0'.cells = (TileTranslation T0 (BandVectors.1 (q i.succ) (q 0))).cells) + → (TileRealization T0' = TileRealization (TileTranslation T0 (BandVectors.1 (q + i.succ) (q 0)))) ) := by + classical + intro q i T0 T0' hshift + simp only [TileRealization] + rw [hshift] + +private theorem hlat0' : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (T0 : ProtoTile), ∀ (T0' : + ProtoTile), (LatticeTile (TileTranslation T0 (BandVectors.1 (q i.succ) (q (0 : Fin (4 + : ℕ)))))) → ((TileRealization T0' = TileRealization (TileTranslation T0 + (BandVectors.1 (q i.succ) (q 0)))) → (LatticeTile T0')) ) := by + classical + intro q i T0 T0' hlatTrans hrealShift + rw [show LatticeTile T0' = TopologicalDisk (TileRealization T0') from rfl, + hrealShift] + exact hlatTrans + +private theorem centroid_cells_eq : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), (A.cells.Nonempty) → ((B.cells.Nonempty) → + ((A.cells = B.cells) → (TileCentroid A = TileCentroid B))) ) := by + classical + intro A B hA hB hc + simp [TileCentroid, hB, hc] + +private theorem hFminusne : + (by + classical + exact + ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (centerShift : GaussianInt), + ((TileTranslation (TileHalfTurn Rminus) centerShift).cells = Rplus.cells) → + ((Rplus.cells.Nonempty) → ((TileTranslation (TileHalfTurn Rminus) + centerShift).cells.Nonempty)) ) := by + classical + intro Rminus Rplus centerShift hmc hRpne + rw [hmc] + exact hRpne + +private theorem hFplusne : + (by + classical + exact + ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (centerShift : GaussianInt), + ((TileTranslation (TileHalfTurn Rplus) centerShift).cells = Rminus.cells) → + ((Rminus.cells.Nonempty) → ((TileTranslation (TileHalfTurn Rplus) + centerShift).cells.Nonempty)) ) := by + classical + intro Rminus Rplus centerShift hpc hRmne + rw [hpc] + exact hRmne + +private theorem huCent : + (by + classical + exact + ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (centerShift : GaussianInt), + (TileCentroid (TileTranslation (TileHalfTurn Rminus) centerShift) = TileCentroid + Rplus) → ((TileCentroid (TileHalfTurn Rminus) = (-(TileCentroid Rminus).1, + -(TileCentroid Rminus).2)) → (GaussianRealPoint centerShift = TileCentroid Rminus + + TileCentroid Rplus)) ) := by + classical + intro Rminus Rplus centerShift hcentFminus hcentHalfMinus + have ht := (TileTranslationFormulas (TileHalfTurn Rminus) centerShift).2.2.2.2.1 + rw [hcentHalfMinus] at ht + rw [hcentFminus] at ht + apply Prod.ext + · have hx := congrArg Prod.fst ht + change (TileCentroid Rplus).1 = -(TileCentroid Rminus).1 + + (centerShift.re : Real) at hx + change (centerShift.re : Real) = + (TileCentroid Rminus).1 + (TileCentroid Rplus).1 + linarith + · have hy := congrArg Prod.snd ht + change (TileCentroid Rplus).2 = -(TileCentroid Rminus).2 + + (centerShift.im : Real) at hy + change (centerShift.im : Real) = + (TileCentroid Rminus).2 + (TileCentroid Rplus).2 + linarith + +private theorem hsumCent : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (T0 : ProtoTile), ∀ (Rminus : + ProtoTile), ∀ (Rplus : ProtoTile), ∀ (qf : Fin (4 : ℕ) → CircleCoordinates), + (TileCentroid Rminus - TileCentroid T0 = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (qf i.succ) (qf (0 : Fin (4 : ℕ))) - BandVectors.1 (qf (0 : Fin (4 : + ℕ))) (qf i.succ))) → ((qf 0 = q 0) → ((qf i.succ = q i.succ) → ((TileCentroid Rplus - + TileCentroid T0 = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q + 0)) + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))) → (TileCentroid Rminus + + TileCentroid Rplus = (2 : Real) • TileCentroid T0 + GaussianRealPoint (BandVectors.1 + (q i.succ) (q 0)))))) ) := by + classical + intro q i T0 Rminus Rplus qf hcentminus hvec0 hveci hcplus + have hmin : TileCentroid Rminus - TileCentroid T0 = + (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) := by + simpa [hvec0, hveci, GaussianRealPoint] using hcentminus + have hpl : TileCentroid Rplus - TileCentroid T0 = + (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) := hcplus + have hminx := congrArg Prod.fst hmin + have hminy := congrArg Prod.snd hmin + have hplx := congrArg Prod.fst hpl + have hply := congrArg Prod.snd hpl + simp? [GaussianRealPoint] at hminx hminy hplx hply + apply Prod.ext + · simp only [Prod.fst_add] + simp only [GaussianRealPoint] + rw [GaussianInt.intCast_re (BandVectors.1 (q i.succ) (q 0))] + calc + (TileCentroid Rminus).1 + (TileCentroid Rplus).1 = + ((TileCentroid Rminus).1 - (TileCentroid T0).1) + + ((TileCentroid Rplus).1 - (TileCentroid T0).1) + + 2 * (TileCentroid T0).1 := by ring + _ = (1 / 2 : Real) * + ((GaussianInt.toComplex (BandVectors.1 (q i.succ) (q 0))).re - + (GaussianInt.toComplex (BandVectors.1 (q 0) (q i.succ))).re) + + (1 / 2 : Real) * + ((GaussianInt.toComplex (BandVectors.1 (q i.succ) (q 0))).re + + (GaussianInt.toComplex (BandVectors.1 (q 0) (q i.succ))).re) + + 2 * (TileCentroid T0).1 := by rw [hminx, hplx]; ring + _ = 2 * (TileCentroid T0).1 + + (GaussianInt.toComplex (BandVectors.1 (q i.succ) (q 0))).re := by ring + · simp only [Prod.snd_add] + simp only [GaussianRealPoint] + rw [GaussianInt.intCast_im (BandVectors.1 (q i.succ) (q 0))] + calc + (TileCentroid Rminus).2 + (TileCentroid Rplus).2 = + ((TileCentroid Rminus).2 - (TileCentroid T0).2) + + ((TileCentroid Rplus).2 - (TileCentroid T0).2) + + 2 * (TileCentroid T0).2 := by ring + _ = (1 / 2 : Real) * + ((GaussianInt.toComplex (BandVectors.1 (q i.succ) (q 0))).im - + (GaussianInt.toComplex (BandVectors.1 (q 0) (q i.succ))).im) + + (1 / 2 : Real) * + ((GaussianInt.toComplex (BandVectors.1 (q i.succ) (q 0))).im + + (GaussianInt.toComplex (BandVectors.1 (q 0) (q i.succ))).im) + + 2 * (TileCentroid T0).2 := by rw [hminy, hply]; ring + _ = 2 * (TileCentroid T0).2 + + (GaussianInt.toComplex (BandVectors.1 (q i.succ) (q 0))).im := by ring + +private theorem hFrootCent : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (T0 : ProtoTile), ∀ (T0' : + ProtoTile), (TileCentroid T0' - TileCentroid T0 = GaussianRealPoint (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))))) → (∀ (centerShift : GaussianInt), (GaussianRealPoint + centerShift = (2 : Real) • TileCentroid T0 + GaussianRealPoint (BandVectors.1 (q + i.succ) (q 0))) → (TileCentroid (TileTranslation (TileHalfTurn T0) centerShift) = + TileCentroid T0')) ) := by + classical + intro q i T0 T0' hcentroid centerShift huCenter + rw [(TileTranslationFormulas (TileHalfTurn T0) centerShift).2.2.2.2.1, + (TileHalfTurnFormulas T0).2.2.2.2.2.2.2.1] + have hcx := congrArg Prod.fst hcentroid + have hcy := congrArg Prod.snd hcentroid + have hux := congrArg Prod.fst huCenter + have huy := congrArg Prod.snd huCenter + simp? [GaussianRealPoint] at hcx hcy hux huy + apply Prod.ext + · change -(TileCentroid T0).1 + (centerShift.re : Real) = + (TileCentroid T0').1 + rw [GaussianInt.intCast_re centerShift] at ⊢ + calc + -(TileCentroid T0).1 + (GaussianInt.toComplex centerShift).re = + -(TileCentroid T0).1 + + (2 * (TileCentroid T0).1 + + (GaussianInt.toComplex (BandVectors.1 (q i.succ) (q 0))).re) := by rw [hux] + _ = (TileCentroid T0').1 := by rw [← hcx]; ring + · change -(TileCentroid T0).2 + (centerShift.im : Real) = + (TileCentroid T0').2 + rw [GaussianInt.intCast_im centerShift] at ⊢ + calc + -(TileCentroid T0).2 + (GaussianInt.toComplex centerShift).im = + -(TileCentroid T0).2 + + (2 * (TileCentroid T0).2 + + (GaussianInt.toComplex (BandVectors.1 (q i.succ) (q 0))).im) := by rw [huy] + _ = (TileCentroid T0').2 := by rw [← hcy]; ring + +private theorem hFroot'Cent : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (T0 : ProtoTile), ∀ (T0' : + ProtoTile), (TileCentroid T0' - TileCentroid T0 = GaussianRealPoint (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))))) → (∀ (centerShift : GaussianInt), (GaussianRealPoint + centerShift = (2 : Real) • TileCentroid T0 + GaussianRealPoint (BandVectors.1 (q + i.succ) (q 0))) → (TileCentroid (TileTranslation (TileHalfTurn T0') centerShift) = + TileCentroid T0)) ) := by + classical + intro q i T0 T0' hcentroid centerShift huCenter + rw [(TileTranslationFormulas (TileHalfTurn T0') centerShift).2.2.2.2.1, + (TileHalfTurnFormulas T0').2.2.2.2.2.2.2.1] + have hcx := congrArg Prod.fst hcentroid + have hcy := congrArg Prod.snd hcentroid + have hux := congrArg Prod.fst huCenter + have huy := congrArg Prod.snd huCenter + simp? [GaussianRealPoint] at hcx hcy hux huy + apply Prod.ext + · change -(TileCentroid T0').1 + (centerShift.re : Real) = (TileCentroid T0).1 + rw [GaussianInt.intCast_re centerShift] at ⊢ + calc + -(TileCentroid T0').1 + (GaussianInt.toComplex centerShift).re = + -(TileCentroid T0').1 + + (2 * (TileCentroid T0).1 + + (GaussianInt.toComplex (BandVectors.1 (q i.succ) (q 0))).re) := by rw [hux] + _ = (TileCentroid T0).1 := by linear_combination -hcx + · change -(TileCentroid T0').2 + (centerShift.im : Real) = (TileCentroid T0).2 + rw [GaussianInt.intCast_im centerShift] at ⊢ + calc + -(TileCentroid T0').2 + (GaussianInt.toComplex centerShift).im = + -(TileCentroid T0').2 + + (2 * (TileCentroid T0).2 + + (GaussianInt.toComplex (BandVectors.1 (q i.succ) (q 0))).im) := by rw [huy] + _ = (TileCentroid T0).2 := by linear_combination -hcy + +private theorem finj : + (by + classical + exact + ∀ (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + Function.Injective f ) := by + classical + intro centerShift f x y hxy + apply neg_injective + exact add_right_cancel hxy + +private theorem fstep : + (by + classical + exact + ∀ (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + ∀ (x : GaussianInt), ∀ (y : GaussianInt), (y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x + - ⟨0, 1⟩) → (f y = f x + 1 ∨ f y = f x - 1 ∨ f y = f x + ⟨0, 1⟩ ∨ f y = f x - ⟨0, 1⟩) + ) := by + classical + intro centerShift f x y hxy + rcases hxy with hxy | hxy | hxy | hxy + · right; left; rw [hxy]; simp [f]; abel + · left; rw [hxy]; simp [f]; abel + · right; right; right; rw [hxy]; simp [f]; abel + · right; right; left; rw [hxy]; simp [f]; abel + +private theorem hVertexCov : + (by + classical + exact + ∀ (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + ∀ (X : ProtoTile), FootprintVertices (TileTranslation (TileHalfTurn X) centerShift) = f + '' FootprintVertices X ) := by + classical + intro centerShift f X + rw [(TileTranslationFormulas (TileHalfTurn X) centerShift).2.2.2.2.2.1, + (TileHalfTurnFormulas X).2.2.2.2.2.2.1] + rw [Set.image_image] + have hcomp : (fun z : GaussianInt => GaussianTranslation centerShift (-z)) = f := by + funext z + apply Zsqrtd.ext <;> simp [f, GaussianTranslation] + rw [hcomp] + +private theorem hHalfEdges : + (by + classical + exact + ∀ (X : ProtoTile), FootprintEdges (TileHalfTurn X) = (fun e : Finset GaussianInt => + e.image (fun z => -z)) '' FootprintEdges X ) := by + classical + intro X + calc + FootprintEdges (TileHalfTurn X) = FootprintEdges (TileQuarterTurn (TileQuarterTurn X)) := by + simp only [FootprintEdges] + rw [(TileHalfTurnFormulas X).2.2.2.2.1] + _ = (fun e : Finset GaussianInt => e.image (fun z => -z)) '' FootprintEdges X := by + rw [(TileQuarterTurnFormulas (TileQuarterTurn X)).2.2.2.2.2.2.1, + (TileQuarterTurnFormulas X).2.2.2.2.2.2.1] + have hneg : (fun z : GaussianInt => GaussianQuarterTurn (GaussianQuarterTurn z)) = + (fun z => -z) := by + funext z + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + rw [Set.image_image] + have hfin : (fun e : Finset GaussianInt => + (e.image GaussianQuarterTurn).image GaussianQuarterTurn) = + (fun e => e.image (fun z => -z)) := by + funext e + rw [Finset.image_image] + congr 1 + rw [hfin] + +private theorem hEdgeCov : + (by + classical + exact + ∀ (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + (∀ (X : ProtoTile), FootprintEdges (TileHalfTurn X) = (fun e : Finset GaussianInt => + e.image (fun z => -z)) '' FootprintEdges X) → (∀ (X : ProtoTile), FootprintEdges + (TileTranslation (TileHalfTurn X) centerShift) = (fun e : Finset GaussianInt => + e.image f) '' FootprintEdges X) ) := by + classical + intro centerShift f hHalfEdges X + rw [(TileTranslationFormulas (TileHalfTurn X) centerShift).2.2.2.2.2.2.1, + hHalfEdges] + rw [Set.image_image] + have hfin : (fun e : Finset GaussianInt => + (e.image (fun z => -z)).image (GaussianTranslation centerShift)) = + (fun e => e.image f) := by + funext e + rw [Finset.image_image] + congr 1 + rw [hfin] + +private theorem pathMap : + (by + classical + exact + ∀ (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + (Function.Injective f) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (y = x + 1 ∨ y = x - + 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → (f y = f x + 1 ∨ f y = f x - 1 ∨ f y = f x + + ⟨0, 1⟩ ∨ f y = f x - ⟨0, 1⟩)) → (∀ {V : Set GaussianInt}, ∀ + {E : Set (Finset GaussianInt)}, ∀ {V' : Set GaussianInt}, ∀ + {E' : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ {y : GaussianInt}, (V' = f '' + V) → ((E' = (fun e : Finset GaussianInt => e.image f) '' E) → ((SimpleGridPathBetween + V E x y) → (SimpleGridPathBetween V' E' (f x) (f y)))))) ) := by + classical + intro centerShift f finj fstep V E V' E' x y hV hE P + rcases P with ⟨p, hnodup, hlength, hhead, hlast, hvertices, hsteps, hedges⟩ + let g : GaussianInt → GaussianInt := fun z => -(z - centerShift) + have fg (z : GaussianInt) : f (g z) = z := by + simp [f, g] + have gf (z : GaussianInt) : g (f z) = z := by + simp [f, g] + have hlistInjective : Function.Injective (fun r : List GaussianInt => r.map f) := + List.map_injective_iff.mpr finj + have unmap (a b : GaussianInt) (l1 l2 : List GaussianInt) + (hm : p.map f = l1 ++ a :: b :: l2) : + p = l1.map g ++ g a :: g b :: l2.map g := by + apply hlistInjective + simpa [List.map_append, Function.comp_def, fg] using hm + refine ⟨p.map f, hnodup.map finj, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simpa using hlength + · simp [hhead] + · simp [hlast] + · rw [hV, hvertices] + ext z + simp [] + · intro a b l1 l2 hm + have hpre := unmap a b l1 l2 hm + have hstep0 := hsteps (g a) (g b) (l1.map g) (l2.map g) hpre + simpa [fg a, fg b] using fstep (g a) (g b) hstep0 + · intro e + rw [hE] + simp only [Set.mem_image] + constructor + · rintro ⟨e0, he0, rfl⟩ + rcases (hedges e0).mp he0 with ⟨a, b, l1, l2, hp, heq⟩ + refine ⟨f a, f b, l1.map f, l2.map f, ?_, ?_⟩ + · simp [List.map_append, hp] + · simp [heq] + · rintro ⟨a, b, l1, l2, hm, heq⟩ + have hpre := unmap a b l1 l2 hm + have he0 : ({g a, g b} : Finset GaussianInt) ∈ E := + (hedges _).2 ⟨g a, g b, l1.map g, l2.map g, hpre, rfl⟩ + refine ⟨{g a, g b}, he0, ?_⟩ + rw [heq] + ext z + simp [fg] + +private theorem hVrootNe : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (centerShift : GaussianInt), + (T0'.cells.Nonempty) → (((TileTranslation (TileHalfTurn T0) centerShift).cells = + T0'.cells) → ((TileTranslation (TileHalfTurn T0) centerShift).cells.Nonempty)) ) := by + classical + intro T0 T0' centerShift hT0'ne hFrootCells + rw [hFrootCells] + exact hT0'ne + +private theorem hVroot'Ne : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (centerShift : GaussianInt), + (T0.cells.Nonempty) → (((TileTranslation (TileHalfTurn T0') centerShift).cells = + T0.cells) → ((TileTranslation (TileHalfTurn T0') centerShift).cells.Nonempty)) ) := by + classical + intro T0 T0' centerShift hT0ne hFroot'Cells + rw [hFroot'Cells] + exact hT0ne + +private theorem hVrootEq : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (centerShift : GaussianInt), + (T0'.cells.Nonempty) → (((TileTranslation (TileHalfTurn T0) centerShift).cells = + T0'.cells) → (FootprintVertices T0' = FootprintVertices (TileTranslation + (TileHalfTurn T0) centerShift))) ) := by + classical + intro T0 T0' centerShift hT0'ne hFrootCells + simp [FootprintVertices, hT0'ne, hFrootCells] + +private theorem hVroot'Eq : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (centerShift : GaussianInt), + (T0.cells.Nonempty) → (((TileTranslation (TileHalfTurn T0') centerShift).cells = + T0.cells) → (FootprintVertices T0 = FootprintVertices (TileTranslation (TileHalfTurn + T0') centerShift))) ) := by + classical + intro T0 T0' centerShift hT0ne hFroot'Cells + simp [FootprintVertices, hT0ne, hFroot'Cells] + +private theorem hVplusEq : + (by + classical + exact + ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (centerShift : GaussianInt), + ((TileTranslation (TileHalfTurn Rplus) centerShift).cells = Rminus.cells) → + ((Rminus.cells.Nonempty) → (FootprintVertices Rminus = FootprintVertices + (TileTranslation (TileHalfTurn Rplus) centerShift))) ) := by + classical + intro Rminus Rplus centerShift hpc hRmne + simp [FootprintVertices, hRmne, hpc] + +private theorem hErootEq : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (centerShift : GaussianInt), ((TileTranslation + (TileHalfTurn T0) centerShift).cells = T0'.cells) → (FootprintEdges T0' = + FootprintEdges (TileTranslation (TileHalfTurn T0) centerShift)) ) := by + classical + intro T0 T0' centerShift hFrootCells + simp [FootprintEdges, hFrootCells] + +private theorem hEroot'Eq : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (centerShift : GaussianInt), ((TileTranslation + (TileHalfTurn T0') centerShift).cells = T0.cells) → (FootprintEdges T0 = + FootprintEdges (TileTranslation (TileHalfTurn T0') centerShift)) ) := by + classical + intro T0 T0' centerShift hFroot'Cells + simp [FootprintEdges, hFroot'Cells] + +private theorem hEplusEq : + (by + classical + exact + ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (centerShift : GaussianInt), + ((TileTranslation (TileHalfTurn Rplus) centerShift).cells = Rminus.cells) → + (FootprintEdges Rminus = FootprintEdges (TileTranslation (TileHalfTurn Rplus) + centerShift)) ) := by + classical + intro Rminus Rplus centerShift hpc + simp [FootprintEdges, hpc] + +private theorem heT0 : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + (∀ (X : ProtoTile), FootprintEdges (TileTranslation (TileHalfTurn X) centerShift) = (fun + e : Finset GaussianInt => e.image f) '' FootprintEdges X) → ((FootprintEdges T0' = + FootprintEdges (TileTranslation (TileHalfTurn T0) centerShift)) → (FootprintEdges T0' + = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges T0)) ) := by + classical + intro T0 T0' centerShift f hEdgeCov hErootEq + rw [hErootEq, hEdgeCov] + +private theorem heT0' : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + (∀ (X : ProtoTile), FootprintEdges (TileTranslation (TileHalfTurn X) centerShift) = (fun + e : Finset GaussianInt => e.image f) '' FootprintEdges X) → ((FootprintEdges T0 = + FootprintEdges (TileTranslation (TileHalfTurn T0') centerShift)) → (FootprintEdges T0 + = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges T0')) ) := by + classical + intro T0 T0' centerShift f hEdgeCov hEroot'Eq + rw [hEroot'Eq, hEdgeCov] + +private theorem hePlus : + (by + classical + exact + ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + (∀ (X : ProtoTile), FootprintEdges (TileTranslation (TileHalfTurn X) centerShift) = (fun + e : Finset GaussianInt => e.image f) '' FootprintEdges X) → ((FootprintEdges Rminus = + FootprintEdges (TileTranslation (TileHalfTurn Rplus) centerShift)) → (FootprintEdges + Rminus = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges Rplus)) ) := by + classical + intro Rminus Rplus centerShift f hEdgeCov hEplusEq + rw [hEplusEq, hEdgeCov] + +private theorem vAB : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + (Function.Injective f) → ((FootprintVertices T0' = f '' FootprintVertices T0) → + ((FootprintVertices T0 = f '' FootprintVertices T0') → (FootprintVertices T0 ∩ + FootprintVertices T0' = f '' (FootprintVertices T0 ∩ FootprintVertices T0')))) ) := by + classical + intro T0 T0' centerShift f finj hvT0 hvT0' + calc + _ = FootprintVertices T0' ∩ FootprintVertices T0 := Set.inter_comm _ _ + _ = (f '' FootprintVertices T0) ∩ (f '' FootprintVertices T0') := by + exact congrArg₂ (fun A B : Set GaussianInt => A ∩ B) hvT0 hvT0' + _ = f '' (FootprintVertices T0 ∩ FootprintVertices T0') := (Set.image_inter finj).symm + +private theorem eAB : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + (Function.Injective f) → ((FootprintEdges T0' = (fun e : Finset GaussianInt => e.image f) + '' FootprintEdges T0) → ((FootprintEdges T0 = (fun e : Finset GaussianInt => e.image + f) '' FootprintEdges T0') → (FootprintEdges T0 ∩ FootprintEdges T0' = (fun e : Finset + GaussianInt => e.image f) '' (FootprintEdges T0 ∩ FootprintEdges T0')))) ) := by + classical + intro T0 T0' centerShift f finj heT0 heT0' + calc + _ = FootprintEdges T0' ∩ FootprintEdges T0 := Set.inter_comm _ _ + _ = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges T0 ∩ + (fun e : Finset GaussianInt => e.image f) '' FootprintEdges T0' := by + exact congrArg₂ (fun A B : Set (Finset GaussianInt) => A ∩ B) heT0 heT0' + _ = (fun e : Finset GaussianInt => e.image f) '' + (FootprintEdges T0 ∩ FootprintEdges T0') := + (Set.image_inter (Finset.image_injective finj)).symm + +private theorem vBC : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ + (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + (Function.Injective f) → ((FootprintVertices T0' = f '' FootprintVertices T0) → + ((FootprintVertices Rminus = f '' FootprintVertices Rplus) → (FootprintVertices T0' ∩ + FootprintVertices Rminus = f '' (FootprintVertices Rplus ∩ FootprintVertices T0)))) ) + := by + classical + intro T0 T0' Rminus Rplus centerShift f finj hvT0 hvPlus + calc + _ = FootprintVertices Rminus ∩ FootprintVertices T0' := Set.inter_comm _ _ + _ = (f '' FootprintVertices Rplus) ∩ (f '' FootprintVertices T0) := by + exact congrArg₂ (fun A B : Set GaussianInt => A ∩ B) hvPlus hvT0 + _ = f '' (FootprintVertices Rplus ∩ FootprintVertices T0) := (Set.image_inter finj).symm + +private theorem eBC : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ + (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + (Function.Injective f) → ((FootprintEdges T0' = (fun e : Finset GaussianInt => e.image f) + '' FootprintEdges T0) → ((FootprintEdges Rminus = (fun e : Finset GaussianInt => + e.image f) '' FootprintEdges Rplus) → (FootprintEdges T0' ∩ FootprintEdges Rminus = + (fun e : Finset GaussianInt => e.image f) '' (FootprintEdges Rplus ∩ FootprintEdges + T0)))) ) := by + classical + intro T0 T0' Rminus Rplus centerShift f finj heT0 hePlus + calc + _ = FootprintEdges Rminus ∩ FootprintEdges T0' := Set.inter_comm _ _ + _ = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges Rplus ∩ + (fun e : Finset GaussianInt => e.image f) '' FootprintEdges T0 := by + exact congrArg₂ (fun A B : Set (Finset GaussianInt) => A ∩ B) hePlus heT0 + _ = (fun e : Finset GaussianInt => e.image f) '' + (FootprintEdges Rplus ∩ FootprintEdges T0) := + (Set.image_inter (Finset.image_injective finj)).symm + +private theorem vCA : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ + (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + (Function.Injective f) → ((FootprintVertices T0 = f '' FootprintVertices T0') → + ((FootprintVertices Rminus = f '' FootprintVertices Rplus) → (FootprintVertices + Rminus ∩ FootprintVertices T0 = f '' (FootprintVertices T0' ∩ FootprintVertices + Rplus)))) ) := by + classical + intro T0 T0' Rminus Rplus centerShift f finj hvT0' hvPlus + calc + _ = FootprintVertices T0 ∩ FootprintVertices Rminus := Set.inter_comm _ _ + _ = (f '' FootprintVertices T0') ∩ (f '' FootprintVertices Rplus) := by + exact congrArg₂ (fun A B : Set GaussianInt => A ∩ B) hvT0' hvPlus + _ = f '' (FootprintVertices T0' ∩ FootprintVertices Rplus) := (Set.image_inter finj).symm + +private theorem eCA : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ + (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + (Function.Injective f) → ((FootprintEdges T0 = (fun e : Finset GaussianInt => e.image f) + '' FootprintEdges T0') → ((FootprintEdges Rminus = (fun e : Finset GaussianInt => + e.image f) '' FootprintEdges Rplus) → (FootprintEdges Rminus ∩ FootprintEdges T0 = + (fun e : Finset GaussianInt => e.image f) '' (FootprintEdges T0' ∩ FootprintEdges + Rplus)))) ) := by + classical + intro T0 T0' Rminus Rplus centerShift f finj heT0' hePlus + calc + _ = FootprintEdges T0 ∩ FootprintEdges Rminus := Set.inter_comm _ _ + _ = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges T0' ∩ + (fun e : Finset GaussianInt => e.image f) '' FootprintEdges Rplus := by + exact congrArg₂ (fun A B : Set (Finset GaussianInt) => A ∩ B) heT0' hePlus + _ = (fun e : Finset GaussianInt => e.image f) '' + (FootprintEdges T0' ∩ FootprintEdges Rplus) := + (Set.image_inter (Finset.image_injective finj)).symm + +private theorem hTriple : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ + (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + (Function.Injective f) → ((FootprintVertices Rminus = f '' FootprintVertices Rplus) → + ((FootprintVertices T0 ∩ FootprintVertices T0' = f '' (FootprintVertices T0 ∩ + FootprintVertices T0')) → (FootprintVertices T0 ∩ FootprintVertices T0' ∩ + FootprintVertices Rminus = f '' (FootprintVertices T0 ∩ FootprintVertices T0' ∩ + FootprintVertices Rplus)))) ) := by + classical + intro T0 T0' Rminus Rplus centerShift f finj hvPlus vAB + calc + _ = (f '' (FootprintVertices T0 ∩ FootprintVertices T0')) ∩ + (f '' FootprintVertices Rplus) := + congrArg₂ (fun A B : Set GaussianInt => A ∩ B) vAB hvPlus + _ = f '' (FootprintVertices T0 ∩ FootprintVertices T0' ∩ FootprintVertices Rplus) := + (Set.image_inter finj).symm + +private theorem hunique : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ + (centerShift : GaussianInt), ∀ (Eplus : ExactTileInterfaceTriple T0 T0' Rplus), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + (FootprintVertices T0 ∩ FootprintVertices T0' ∩ FootprintVertices Rminus = f '' + (FootprintVertices T0 ∩ FootprintVertices T0' ∩ FootprintVertices Rplus)) → (∀ x, x ∈ + FootprintVertices T0 ∩ FootprintVertices T0' ∩ FootprintVertices Rminus ↔ x = f + Eplus.point) ) := by + classical + intro T0 T0' Rminus Rplus centerShift Eplus f hTriple x + rw [hTriple] + constructor + · rintro ⟨y, hy, rfl⟩ + have hone := (Eplus.unique_common y).mp hy + simp [hone] + · intro hx + subst x + exact ⟨Eplus.point, (Eplus.unique_common Eplus.point).mpr rfl, rfl⟩ + +private theorem path_endpoints_ne : + (by + classical + exact + ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (x ≠ y) ) := by + classical + intro V E x y P + rcases P with ⟨p, hnodup, hlen, hhead, hlast, _, _, _⟩ + have hpne : p ≠ [] := by + intro hp + subst p + simp at hlen + have hhead' : p.head hpne = x := by + have h := List.head?_eq_some_head hpne + rw [hhead] at h + exact Option.some.inj h.symm + have hlast' : p.getLast hpne = y := by + have h := List.getLast?_eq_some_getLast hpne + rw [hlast] at h + exact Option.some.inj h.symm + intro hxy + have heq : p.head hpne = p.getLast hpne := by + rw [hhead', hlast', hxy] + obtain ⟨z, rfl⟩ := (List.Nodup.head_eq_getLast_iff hpne hnodup).mp heq + simp at hlen + +private theorem hpairCases : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ + (centerShift : GaussianInt), ∀ (Eplus : ExactTileInterfaceTriple T0 T0' Rplus), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + ∀ (pAB : SimpleGridPathBetween (FootprintVertices T0 ∩ FootprintVertices T0') + (FootprintEdges T0 ∩ FootprintEdges T0') (f Eplus.point) (f Eplus.otherAB)), ∀ (pBC : + SimpleGridPathBetween (FootprintVertices T0' ∩ FootprintVertices Rminus) + (FootprintEdges T0' ∩ FootprintEdges Rminus) (f Eplus.point) (f Eplus.otherCA)), ∀ + (pCA : SimpleGridPathBetween (FootprintVertices Rminus ∩ FootprintVertices T0) + (FootprintEdges Rminus ∩ FootprintEdges T0) (f Eplus.point) (f Eplus.otherBC)), ∀ + (hunique : ∀ x, x ∈ FootprintVertices T0 ∩ FootprintVertices T0' ∩ FootprintVertices + Rminus ↔ x = f Eplus.point), + let EM : ExactTileInterfaceTriple T0 T0' Rminus := + { point := f Eplus.point + otherAB := f Eplus.otherAB + otherBC := f Eplus.otherCA + otherCA := f Eplus.otherBC + pathAB := pAB + pathBC := pBC + pathCA := pCA + unique_common := hunique } + (Eplus.point ≠ Eplus.otherAB) → ((({Eplus.point, Eplus.otherAB} : Finset GaussianInt) = + {EM.point, EM.otherAB}) → (Eplus.point = EM.point ∧ Eplus.otherAB = EM.otherAB ∨ + Eplus.point = EM.otherAB ∧ Eplus.otherAB = EM.point)) ) := by + classical + intro T0 T0' Rminus Rplus centerShift Eplus f pAB pBC pCA hunique EM hpt hpair + have hpMem : Eplus.point ∈ ({EM.point, EM.otherAB} : Finset GaussianInt) := by + rw [← hpair] + simp + have htMem : Eplus.otherAB ∈ ({EM.point, EM.otherAB} : Finset GaussianInt) := by + rw [← hpair] + simp + have hpCases : Eplus.point = EM.point ∨ Eplus.point = EM.otherAB := by + simpa using hpMem + have htCases : Eplus.otherAB = EM.point ∨ Eplus.otherAB = EM.otherAB := by + simpa using htMem + rcases hpCases with hp | hp <;> rcases htCases with ht | ht + · exact False.elim (hpt (hp.trans ht.symm)) + · exact Or.inl ⟨hp, ht⟩ + · exact Or.inr ⟨hp, ht⟩ + · exact False.elim (hpt (hp.trans ht.symm)) + +private theorem houterEnds : + (by + classical + exact + (Fin 4 -> CircleCoordinates) → ((BandCircle) → ((Fin 3) → (∀ (T0 : ProtoTile), ∀ (T0' : + ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (centerShift : + GaussianInt), ∀ (Eplus : ExactTileInterfaceTriple T0 T0' Rplus), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + ∀ (pAB : SimpleGridPathBetween (FootprintVertices T0 ∩ FootprintVertices T0') + (FootprintEdges T0 ∩ FootprintEdges T0') (f Eplus.point) (f Eplus.otherAB)), ∀ (pBC : + SimpleGridPathBetween (FootprintVertices T0' ∩ FootprintVertices Rminus) + (FootprintEdges T0' ∩ FootprintEdges Rminus) (f Eplus.point) (f Eplus.otherCA)), ∀ + (pCA : SimpleGridPathBetween (FootprintVertices Rminus ∩ FootprintVertices T0) + (FootprintEdges Rminus ∩ FootprintEdges T0) (f Eplus.point) (f Eplus.otherBC)), ∀ + (hunique : ∀ x, x ∈ FootprintVertices T0 ∩ FootprintVertices T0' ∩ FootprintVertices + Rminus ↔ x = f Eplus.point), + let EM : ExactTileInterfaceTriple T0 T0' Rminus := + { point := f Eplus.point + otherAB := f Eplus.otherAB + otherBC := f Eplus.otherCA + otherCA := f Eplus.otherBC + pathAB := pAB + pathBC := pBC + pathCA := pCA + unique_common := hunique } + (Eplus.point ≠ Eplus.otherAB) → ((Eplus.point = EM.point ∧ Eplus.otherAB = EM.otherAB ∨ + Eplus.point = EM.otherAB ∧ Eplus.otherAB = EM.point) → (f Eplus.point = Eplus.otherAB + ∧ f Eplus.otherAB = Eplus.point))))) ) := by + classical + intro q Ci i T0 T0' Rminus Rplus centerShift Eplus f pAB pBC pCA hunique EM hpt hpairCases + rcases hpairCases with hfix | hswap + · rcases hfix with ⟨hfp, hft⟩ + have hu1 : centerShift = Eplus.point + Eplus.point := by + have hfixed : f Eplus.point = Eplus.point := by simpa [EM] using hfp.symm + dsimp [f] at hfixed + linear_combination hfixed + have hu2 : centerShift = Eplus.otherAB + Eplus.otherAB := by + have hfixed : f Eplus.otherAB = Eplus.otherAB := by simpa [EM] using hft.symm + dsimp [f] at hfixed + linear_combination hfixed + have hdouble : Eplus.point + Eplus.point = + Eplus.otherAB + Eplus.otherAB := hu1.symm.trans hu2 + have heq : Eplus.point = Eplus.otherAB := by + apply Zsqrtd.ext + · have h := congrArg (fun z : GaussianInt => z.re) hdouble + simp at h + omega + · have h := congrArg (fun z : GaussianInt => z.im) hdouble + simp at h + omega + exact (hpt heq).elim + · exact ⟨hswap.2.symm, hswap.1.symm⟩ + +private theorem reversePath : + (by + classical + exact + ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween V E y x) + ) := by + classical + intro V E x y P + rcases P with ⟨p, hnodup, hlength, hhead, hlast, hvertices, hsteps, hedges⟩ + have reverse_decomp (a b : GaussianInt) (l1 l2 : List GaussianInt) + (hr : p.reverse = l1 ++ a :: b :: l2) : + p = l2.reverse ++ b :: a :: l1.reverse := by + have h := congrArg List.reverse hr + simpa [List.reverse_append] using h + have forward_decomp (a b : GaussianInt) (l1 l2 : List GaussianInt) + (hp : p = l1 ++ a :: b :: l2) : + p.reverse = l2.reverse ++ b :: a :: l1.reverse := by + have h := congrArg List.reverse hp + simpa [List.reverse_append] using h + refine ⟨p.reverse, List.nodup_reverse.mpr hnodup, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simpa using hlength + · simpa [hhead] + · simpa [hlast] + · rw [hvertices] + simp + · intro a b l1 l2 hr + have hp := reverse_decomp a b l1 l2 hr + have hstep := hsteps b a l2.reverse l1.reverse hp + rcases hstep with h | h | h | h + · right; left + rw [h] + abel + · left + rw [h] + abel + · right; right; right + rw [h] + abel + · right; right; left + rw [h] + abel + · intro e + constructor + · intro he + rcases (hedges e).1 he with ⟨a, b, l1, l2, hr, heq⟩ + have hp := forward_decomp a b l1 l2 hr + refine ⟨b, a, l2.reverse, l1.reverse, hp, ?_⟩ + simpa [Finset.pair_comm] using heq + · intro he + rcases he with ⟨a, b, l1, l2, hp, heq⟩ + have hporig := reverse_decomp a b l1 l2 hp + exact (hedges e).2 ⟨b, a, l2.reverse, l1.reverse, hporig, by + simpa [Finset.pair_comm] using heq⟩ + +private theorem hOuterPath : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ + (centerShift : GaussianInt), ∀ (Eplus : ExactTileInterfaceTriple T0 T0' Rplus), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + ∀ (pAB : SimpleGridPathBetween (FootprintVertices T0 ∩ FootprintVertices T0') + (FootprintEdges T0 ∩ FootprintEdges T0') (f Eplus.point) (f Eplus.otherAB)), ∀ (pBC : + SimpleGridPathBetween (FootprintVertices T0' ∩ FootprintVertices Rminus) + (FootprintEdges T0' ∩ FootprintEdges Rminus) (f Eplus.point) (f Eplus.otherCA)), ∀ + (pCA : SimpleGridPathBetween (FootprintVertices Rminus ∩ FootprintVertices T0) + (FootprintEdges Rminus ∩ FootprintEdges T0) (f Eplus.point) (f Eplus.otherBC)), ∀ + (hunique : ∀ x, x ∈ FootprintVertices T0 ∩ FootprintVertices T0' ∩ FootprintVertices + Rminus ↔ x = f Eplus.point), + let EM : ExactTileInterfaceTriple T0 T0' Rminus := + { point := f Eplus.point + otherAB := f Eplus.otherAB + otherBC := f Eplus.otherCA + otherCA := f Eplus.otherBC + pathAB := pAB + pathBC := pBC + pathCA := pCA + unique_common := hunique } + (f Eplus.point = Eplus.otherAB ∧ f Eplus.otherAB = Eplus.point) → ((∀ + {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween V E y x)) + → (SimpleGridPathBetween (FootprintVertices T0 ∩ FootprintVertices T0') + (FootprintEdges T0 ∩ FootprintEdges T0') EM.point Eplus.point)) ) := by + classical + intro T0 T0' Rminus Rplus centerShift Eplus f pAB pBC pCA hunique EM houterEnds reversePath + have hrev := reversePath Eplus.pathAB + change SimpleGridPathBetween _ _ (f Eplus.point) Eplus.point + simpa [EM, houterEnds.1] using hrev + +private theorem hlatMinus : + (by + classical + exact + ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (centerShift : GaussianInt), + ((TileTranslation (TileHalfTurn Rplus) centerShift).cells = Rminus.cells) → + ((LatticeTile Rplus) → (LatticeTile Rminus)) ) := by + classical + intro Rminus Rplus centerShift hpc hlatPlus + have hq1 : LatticeTile (TileQuarterTurn Rplus) := + (TileDiskAreaCovariance Rplus 0).2.1.mp hlatPlus + have hq2 : LatticeTile (TileQuarterTurn (TileQuarterTurn Rplus)) := + (TileDiskAreaCovariance (TileQuarterTurn Rplus) 0).2.1.mp hq1 + have hhalf : LatticeTile (TileHalfTurn Rplus) := by + change TopologicalDisk (TileRealization (TileHalfTurn Rplus)) + rw [show TileRealization (TileHalfTurn Rplus) = + TileRealization (TileQuarterTurn (TileQuarterTurn Rplus)) by + simp [TileRealization, (TileHalfTurnFormulas Rplus).2.2.2.2.1]] + exact hq2 + have htrans : LatticeTile (TileTranslation (TileHalfTurn Rplus) centerShift) := + (TileDiskAreaCovariance (TileHalfTurn Rplus) centerShift).1.mp hhalf + have hreal : TileRealization Rminus = + TileRealization (TileTranslation (TileHalfTurn Rplus) centerShift) := by + simp only [TileRealization] + rw [hpc] + rw [show LatticeTile Rminus = TopologicalDisk (TileRealization Rminus) from rfl, + hreal] + exact htrans + +private theorem hcellMap : + (by + classical + exact + ∀ (centerShift : GaussianInt), + let g : GaussianInt → GaussianInt := + fun x => GaussianTranslation centerShift (-x - 1 - ⟨0, 1⟩) + ∀ (A : ProtoTile), (TileTranslation (TileHalfTurn A) centerShift).cells = A.cells.image g + ) := by + classical + intro centerShift g A + rw [(TileTranslationFormulas (TileHalfTurn A) centerShift).1, + (TileHalfTurnFormulas A).1, Finset.image_image] + rfl + +private theorem hdisjoint_image : + (by + classical + exact + ∀ (centerShift : GaussianInt), + let g : GaussianInt → GaussianInt := + fun x => GaussianTranslation centerShift (-x - 1 - ⟨0, 1⟩) + ∀ {A : Finset GaussianInt}, ∀ {B : Finset GaussianInt}, (Disjoint A B) → (Disjoint + (A.image g) (B.image g)) ) := by + classical + intro centerShift g A B hd + have ginj : Function.Injective g := by + intro a b hab + have hn : -a - 1 - ⟨0, 1⟩ = -b - 1 - ⟨0, 1⟩ := by + dsimp [g, GaussianTranslation] at hab + exact add_right_cancel hab + have hn' : -a = -b := by linear_combination hn + exact neg_injective hn' + apply Finset.disjoint_left.mpr + intro z hza hzb + rcases Finset.mem_image.mp hza with ⟨a, ha, rfl⟩ + rcases Finset.mem_image.mp hzb with ⟨b, hb, hab⟩ + exact (Finset.disjoint_left.mp hd) ha (ginj hab ▸ hb) + +private theorem hdisjoint0Minus : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ + (centerShift : GaussianInt), ((TileTranslation (TileHalfTurn Rplus) + centerShift).cells = Rminus.cells) → ((Disjoint T0'.cells Rplus.cells) → + (((TileTranslation (TileHalfTurn T0') centerShift).cells = T0.cells) → ( + let g : GaussianInt → GaussianInt := + fun x => GaussianTranslation centerShift (-x - 1 - ⟨0, 1⟩) + (∀ (A : ProtoTile), (TileTranslation (TileHalfTurn A) centerShift).cells = A.cells.image + g) → ((∀ {A : Finset GaussianInt}, ∀ {B : Finset GaussianInt}, (Disjoint A B) → + (Disjoint (A.image g) (B.image g))) → (Disjoint T0.cells Rminus.cells))))) ) := by + classical + intro T0 T0' Rminus Rplus centerShift hpc hdisjoint0'Plus hFroot'Cells g hcellMap hdisjoint_image + rw [← hFroot'Cells, ← hpc, hcellMap, hcellMap] + exact hdisjoint_image hdisjoint0'Plus + +private theorem hdisjoint0'Minus : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ + (centerShift : GaussianInt), ((TileTranslation (TileHalfTurn Rplus) + centerShift).cells = Rminus.cells) → ((Disjoint T0.cells Rplus.cells) → + (((TileTranslation (TileHalfTurn T0) centerShift).cells = T0'.cells) → ( + let g : GaussianInt → GaussianInt := + fun x => GaussianTranslation centerShift (-x - 1 - ⟨0, 1⟩) + (∀ (A : ProtoTile), (TileTranslation (TileHalfTurn A) centerShift).cells = A.cells.image + g) → ((∀ {A : Finset GaussianInt}, ∀ {B : Finset GaussianInt}, (Disjoint A B) → + (Disjoint (A.image g) (B.image g))) → (Disjoint T0'.cells Rminus.cells))))) ) := by + classical + intro T0 T0' Rminus Rplus centerShift hpc hdisjoint0Plus hFrootCells g hcellMap hdisjoint_image + rw [← hFrootCells, ← hpc, hcellMap, hcellMap] + exact hdisjoint_image hdisjoint0Plus + +private theorem hRminusFamily : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : + ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), (TileString Ci + orientation base Rminus Rplus tiles) → (Rminus ∈ RegularTileFamily base + (TilingLattice Ci)) ) := by + classical + intro Ci orientation base Rminus Rplus tiles hstring + rcases hstring with ⟨_, hhead, _, _, hfam, _, _⟩ + have hmem : Rminus ∈ tiles := by + have heq := List.eq_cons_of_mem_head? (show Rminus ∈ tiles.head? by + simp [hhead]) + rw [heq] + simp + exact hfam Rminus hmem + +private theorem hRplusFamily : + (by + classical + exact + ∀ (Ci : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : + ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), (TileString Ci + orientation base Rminus Rplus tiles) → (Rplus ∈ RegularTileFamily base (TilingLattice + Ci)) ) := by + classical + intro Ci orientation base Rminus Rplus tiles hstring + rcases hstring with ⟨_, _, hlast, _, hfam, _, _⟩ + have hmem : Rplus ∈ tiles := by + have hne : tiles ≠ [] := by + intro he + simp [he] at hlast + have hlast' := List.getLast?_eq_some_getLast hne + rw [hlast] at hlast' + have hmemLast := List.getLast_mem hne + exact (Option.some.inj hlast') ▸ hmemLast + exact hfam Rplus hmem + +private theorem hcentDiff : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (T0 : ProtoTile), ∀ (Rminus : + ProtoTile), ∀ (Rplus : ProtoTile), ∀ (qf : Fin (4 : ℕ) → CircleCoordinates), + (TileCentroid Rminus - TileCentroid T0 = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (qf i.succ) (qf (0 : Fin (4 : ℕ))) - BandVectors.1 (qf (0 : Fin (4 : + ℕ))) (qf i.succ))) → ((qf 0 = q 0) → ((qf i.succ = q i.succ) → ((TileCentroid Rplus - + TileCentroid T0 = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q + 0)) + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))) → (TileCentroid Rplus - + TileCentroid Rminus = GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))))) ) := by + classical + intro q i T0 Rminus Rplus qf hcentminus hvec0 hveci hcplus + have hmin : TileCentroid Rminus - TileCentroid T0 = + (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) := by + simpa [hvec0, hveci, GaussianRealPoint] using hcentminus + have hpl : TileCentroid Rplus - TileCentroid T0 = + (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) := hcplus + calc + TileCentroid Rplus - TileCentroid Rminus = + (TileCentroid Rplus - TileCentroid T0) - + (TileCentroid Rminus - TileCentroid T0) := by ext <;> simp + _ = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) - + (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) := by rw [hpl, hmin] + _ = GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) := by + apply Prod.ext + · have hm := congrArg Prod.fst hmin + have hp := congrArg Prod.fst hpl + simp [GaussianRealPoint] at hm hp ⊢ + ring + · have hm := congrArg Prod.snd hmin + have hp := congrArg Prod.snd hpl + simp [GaussianRealPoint] at hm hp ⊢ + ring + +private theorem hNoTouch : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (q i.succ = + Ci.1.1) → (((1 : ℤ) < Ci.1.1.1) → (∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), (ProperBandQuadruple q) → ((0 < (q 0).1) → ((0 < (q i.succ).1) → + ((BandPrototile Ci.1.1 base) → ((Rminus ∈ RegularTileFamily base (TilingLattice Ci)) + → ((Rplus ∈ RegularTileFamily base (TilingLattice Ci)) → ((TileCentroid Rplus - + TileCentroid Rminus = GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → (¬ + TileTouching Rminus Rplus))))))))) ) := by + classical + intro q Ci i hCi hlarge base Rminus Rplus hproper hcurv0 hcurvi hBandBase hRminusFamily + hRplusFamily hcentDiff htouch + rcases BandGenealogy Ci with hunit | ⟨qb, hsemi, hqb0, hless, _⟩ + · have : Ci.1.1.1 = 1 := hunit + omega + have hproperB : ProperBandQuadruple qb := ⟨hsemi, by + intro j + rw [hqb0] + exact hless j⟩ + have hBandBase' : BandPrototile (qb 0) base := by simpa [hqb0] using hBandBase + have hclassified := (BandRegularTileTouchingClassification Ci qb hproperB + hqb0 base hBandBase' Rminus Rplus hRminusFamily hRplusFamily).mp htouch + have hLengthContradiction (j : Fin 3) + (hcontact : TileCentroid Rplus - TileCentroid Rminus = + GaussianRealPoint (BandVectors.1 (qb j.succ) (qb 0)) ∨ + TileCentroid Rplus - TileCentroid Rminus = + -GaussianRealPoint (BandVectors.1 (qb j.succ) (qb 0))) : False := by + have hinj : Function.Injective GaussianRealPoint := by + intro x y hxy + apply Zsqrtd.ext + · have hx := congrArg Prod.fst hxy + dsimp [GaussianRealPoint] at hx + exact_mod_cast hx + · have hy := congrArg Prod.snd hxy + dsimp [GaussianRealPoint] at hy + exact_mod_cast hy + have hvecEq : Zsqrtd.norm (BandVectors.1 (q 0) (q i.succ)) = + Zsqrtd.norm (BandVectors.1 (qb j.succ) (qb 0)) := by + rcases hcontact with hcontact | hcontact + · have hreal : GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) = + GaussianRealPoint (BandVectors.1 (qb j.succ) (qb 0)) := by + rw [← hcentDiff, hcontact] + have hv := hinj hreal + exact congrArg Zsqrtd.norm hv + · have hreal : GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) = + GaussianRealPoint (-BandVectors.1 (qb j.succ) (qb 0)) := by + rw [← hcentDiff, hcontact] + ext <;> simp [GaussianRealPoint] + have hv := hinj hreal + rw [hv, Zsqrtd.norm_neg] + have hrootNorm := TangencyCoordinateIdentity q hproper.1 0 i.succ + (Fin.succ_ne_zero _).symm + have hchildNorm := TangencyCoordinateIdentity qb hsemi j.succ 0 + (Fin.succ_ne_zero _) + have hrootSq := (VectorSquareProduct q hproper.1 0 i.succ + (Fin.succ_ne_zero _).symm).1 + have hchildSq := (VectorSquareProduct qb hsemi j.succ 0 + (Fin.succ_ne_zero _)).1 + have hrootLen : Zsqrtd.norm (BandVectors.1 (q 0) (q i.succ)) ^ 2 = + ((q i.succ).1 + (q 0).1) ^ 2 := by + calc + _ = Zsqrtd.norm (BandVectors.1 (q 0) (q i.succ)) * + Zsqrtd.norm (BandVectors.1 (q 0) (q i.succ)) := by rw [pow_two] + _ = Zsqrtd.norm (BandVectors.1 (q 0) (q i.succ) * + BandVectors.1 (q 0) (q i.succ)) := (Zsqrtd.norm_mul _ _).symm + _ = Zsqrtd.norm (BandVectors.1 (q 0) (q i.succ) ^ 2) := by rw [pow_two] + _ = Zsqrtd.norm ((q i.succ).1 • (q 0).2 - + (q 0).1 • (q i.succ).2) := by rw [hrootSq] + _ = _ := by simpa [add_comm] using hrootNorm + have hchildLen : Zsqrtd.norm (BandVectors.1 (qb j.succ) (qb 0)) ^ 2 = + ((qb j.succ).1 + (qb 0).1) ^ 2 := by + calc + _ = Zsqrtd.norm (BandVectors.1 (qb j.succ) (qb 0)) * + Zsqrtd.norm (BandVectors.1 (qb j.succ) (qb 0)) := by rw [pow_two] + _ = Zsqrtd.norm (BandVectors.1 (qb j.succ) (qb 0) * + BandVectors.1 (qb j.succ) (qb 0)) := (Zsqrtd.norm_mul _ _).symm + _ = Zsqrtd.norm (BandVectors.1 (qb j.succ) (qb 0) ^ 2) := by rw [pow_two] + _ = Zsqrtd.norm ((qb 0).1 • (qb j.succ).2 - + (qb j.succ).1 • (qb 0).2) := by rw [hchildSq] + _ = _ := hchildNorm + have hcurvEq : ((q i.succ).1 + (q 0).1) ^ 2 = + ((qb j.succ).1 + (qb 0).1) ^ 2 := by + calc + _ = Zsqrtd.norm (BandVectors.1 (q 0) (q i.succ)) ^ 2 := hrootLen.symm + _ = Zsqrtd.norm (BandVectors.1 (qb j.succ) (qb 0)) ^ 2 := by rw [hvecEq] + _ = _ := hchildLen + have hchildLess : (qb j.succ).1 < (q i.succ).1 := by + simpa [hCi] using hless j + have hrootLarger : (qb j.succ).1 + (qb 0).1 < + (q i.succ).1 + (q 0).1 := by + have hqless := hproper.2 i + have hparentEq : (qb 0).1 = (q i.succ).1 := by rw [hqb0, hCi] + omega + have hrootPositive : 0 < (q i.succ).1 + (q 0).1 := by omega + have hchildPositive : 0 < (qb j.succ).1 + (qb 0).1 := by + have hnonneg := (ProperBandCurvatureStructure qb hproperB).2.1 j + have hparentPos : 0 < (qb 0).1 := by simpa [hqb0, hCi] using hcurvi + omega + nlinarith + rcases hclassified with ⟨j, hcontact⟩ + exact hLengthContradiction j hcontact + +private theorem hvecZero : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (Rminus : ProtoTile), ∀ (Rplus : + ProtoTile), (TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint + (BandVectors.1 (q 0) (q i.succ))) → ((TileCentroid Rminus = TileCentroid Rplus) → + (GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) = 0)) ) := by + classical + intro q i Rminus Rplus hcentDiff hcentEq + rw [← hcentDiff] + rw [hcentEq] + ext <;> simp + +private theorem hinjAt979 : + (by + classical + exact + Function.Injective GaussianRealPoint ) := by + classical + intro x y hxy + apply Zsqrtd.ext + · have hx := congrArg Prod.fst hxy + dsimp [GaussianRealPoint] at hx + exact_mod_cast hx + · have hy := congrArg Prod.snd hxy + dsimp [GaussianRealPoint] at hy + exact_mod_cast hy + +private theorem hvZero : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), (GaussianRealPoint (BandVectors.1 (q + 0) (q i.succ)) = 0) → ((Function.Injective GaussianRealPoint) → (BandVectors.1 (q 0) + (q i.succ) = 0)) ) := by + classical + intro q i hvecZero hinj + exact hinj (by + have hz : GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) = + GaussianRealPoint 0 := by simpa [GaussianRealPoint] using hvecZero + exact hz) + +end OuterGeometry + +theorem P4366T2OuterGeometry + (q : Fin 4 -> CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C0 Ci : BandCircle) (i : Fin 3) + (hC0 : q 0 = C0.1.1) (hCi : q i.succ = Ci.1.1) + (T0 T0' : ProtoTile) (h0 h0' : PartialOdometer) + (cert : BandOrderedGeneralLayoutCertificate q cfg C0 T0) + (hsym : QuarterTurnSymmetric T0) + (hO0 : TileOdometer C0.1.1 T0 h0) + (hO0' : TileOdometer C0.1.1 T0' h0') + (hlarge : 1 < Ci.1.1.1) + (hcentroid : TileCentroid T0' - TileCentroid T0 = + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) + (orientation : Bool) (base Rminus Rplus : ProtoTile) + (tiles : List ProtoTile) (centerShift : GaussianInt) + (hf : BoundaryString C0 Ci i orientation T0 base Rminus Rplus tiles) + (hminus hplus : PartialOdometer) + (hOm : TileOdometer Ci.1.1 Rminus hminus) + (hOp : TileOdometer Ci.1.1 Rplus hplus) + (hmc : (TileTranslation (TileHalfTurn Rminus) centerShift).cells = Rplus.cells) + (hpc : (TileTranslation (TileHalfTurn Rplus) centerShift).cells = Rminus.cells) : + ∃ EM : ExactTileInterfaceTriple T0 T0' Rminus, + ∃ EP : ExactTileInterfaceTriple T0 T0' Rplus, + SimpleGridPathBetween (FootprintVertices T0 ∩ FootprintVertices T0') + (FootprintEdges T0 ∩ FootprintEdges T0') EM.point EP.point ∧ + LatticeTile T0 ∧ LatticeTile T0' ∧ + LatticeTile Rminus ∧ LatticeTile Rplus ∧ + Disjoint T0.cells T0'.cells ∧ + Disjoint T0.cells Rminus.cells ∧ Disjoint T0'.cells Rminus.cells ∧ + Disjoint T0.cells Rplus.cells ∧ Disjoint T0'.cells Rplus.cells ∧ + (∀ x, x ∈ FootprintVertices T0 → ∀ y, y ∈ FootprintVertices T0 → + FourNeighborAdjacent x y → {x, y} ∈ FootprintEdges T0) ∧ + (∀ x, x ∈ FootprintVertices T0' → ∀ y, y ∈ FootprintVertices T0' → + FourNeighborAdjacent x y → {x, y} ∈ FootprintEdges T0') ∧ + Rminus ≠ Rplus ∧ ¬ TileTouching Rminus Rplus := by +-- BODY + classical + obtain ⟨qf, hqf, hqf0, hqfi, hT0f, hunitf, hstring, + hcentminus, hcentplus⟩ := hf + have hproper : ProperBandQuadruple q := cfg.proper + have hcurv0 : 0 < (q 0).1 := OuterGeometry.hcurv0 q C0 hC0 + have hcurvi : 0 < (q i.succ).1 := OuterGeometry.hcurvi q Ci i hCi hlarge + have positive_nonempty : ∀ (D : CircleCoordinates) (U : ProtoTile), + BandPrototile D U → 0 < D.1 → U.cells.Nonempty := OuterGeometry.positive_nonempty q Ci i + have hT0 : BandPrototile C0.1.1 T0 := TileOdometerBandPrototile _ _ _ hO0 + have hT0' : BandPrototile C0.1.1 T0' := TileOdometerBandPrototile _ _ _ hO0' + have hRm : BandPrototile Ci.1.1 Rminus := TileOdometerBandPrototile _ _ _ hOm + have hRp : BandPrototile Ci.1.1 Rplus := TileOdometerBandPrototile _ _ _ hOp + have hT0ne : T0.cells.Nonempty := positive_nonempty _ _ hT0 (by rw [← hC0]; exact hcurv0) + have hT0'ne : T0'.cells.Nonempty := positive_nonempty _ _ hT0' (by rw [← hC0]; exact hcurv0) + have hRmne : Rminus.cells.Nonempty := positive_nonempty _ _ hRm (by rw [← hCi]; exact hcurvi) + have hRpne : Rplus.cells.Nonempty := positive_nonempty _ _ hRp (by rw [← hCi]; exact hcurvi) + have hvec0 : qf 0 = q 0 := by rw [hqf0, hC0] + have hveci : qf i.succ = q i.succ := by rw [hqfi, hCi] + have hcplus := OuterGeometry.hcplus q i T0 Rplus qf hcentplus hvec0 hveci + have hcentT := OuterGeometry.hcentT q i T0 + have hpluscent : TileCentroid Rplus - TileCentroid T0 = + (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) := hcplus + have hChild := BandOrderedGeneralChildInterfaces q cfg C0 T0 cert hsym + have hRpq : BandPrototile (q i.succ) Rplus := hCi ▸ hRp + have plusExists := hChild.2.1 i Rplus hRpq hpluscent + rcases plusExists with ⟨Eplus0⟩ + have hshift : T0'.cells = + (TileTranslation T0 (BandVectors.1 (q i.succ) (q 0))).cells := OuterGeometry.hshift q C0 i + T0 T0' hcentroid hT0 hT0' hcentT + have hretarget := ExactTileInterfaceTripleRetargetMiddle T0 + (TileTranslation T0 (BandVectors.1 (q i.succ) (q 0))) T0' Rplus hshift.symm + (by + intro he + have hempty : T0.cells = ∅ := + (TileTranslationFormulas T0 (BandVectors.1 (q i.succ) (q 0))).2.2.1.mp he + exact False.elim (hT0ne.ne_empty hempty)) Eplus0 + rcases hretarget with ⟨Eplus, hpoint, _, _, _⟩ + obtain ⟨AB, BC, CA, ABC, hlat0, hlatTrans, hlatPlus, + hlatAB, hlatBC, hlatCA, hlatABC, hd0Trans, hdTransPlus, + hdPlus0, hUnionAB, hUnionBC, hUnionCA, hUnionABC, + hEdgeAB, hEdgeBC, hEdgeCA⟩ := + (BandOrderedGeneralMixedAggregatePatches q cfg C0 T0 cert hsym).1 + i Rplus hRpq hcplus + have hlat0' := OuterGeometry.hlat0' q i T0 T0' hlatTrans (OuterGeometry.hrealShift q i T0 T0' + hshift) + have hdisjoint0' : Disjoint T0.cells T0'.cells := by + simpa [hshift] using hd0Trans + have hdisjoint0Plus : Disjoint T0.cells Rplus.cells := hdPlus0.symm + have hdisjoint0'Plus : Disjoint T0'.cells Rplus.cells := by + simpa [hshift] using hdTransPlus + have hregular0 := LatticeEdgeRegularity C0 T0 hT0 hlat0 + have hregular0' := LatticeEdgeRegularity C0 T0' hT0' hlat0' + have hregular0_induced := hregular0.2.1 + have hregular0'_induced := hregular0'.2.1 + have centroid_cells_eq := OuterGeometry.centroid_cells_eq + have hFplusne := OuterGeometry.hFplusne Rminus Rplus centerShift hpc hRmne + have hcentFminus : TileCentroid (TileTranslation (TileHalfTurn Rminus) centerShift) = + TileCentroid Rplus := centroid_cells_eq _ _ (OuterGeometry.hFminusne Rminus Rplus + centerShift hmc hRpne) hRpne hmc + have hcentFplus : TileCentroid (TileTranslation (TileHalfTurn Rplus) centerShift) = + TileCentroid Rminus := centroid_cells_eq _ _ hFplusne hRmne hpc + have hcentHalfMinus : TileCentroid (TileHalfTurn Rminus) = + (-(TileCentroid Rminus).1, -(TileCentroid Rminus).2) := + (TileHalfTurnFormulas Rminus).2.2.2.2.2.2.2.1 + have hcentHalfPlus : TileCentroid (TileHalfTurn Rplus) = + (-(TileCentroid Rplus).1, -(TileCentroid Rplus).2) := + (TileHalfTurnFormulas Rplus).2.2.2.2.2.2.2.1 + have huCenter : GaussianRealPoint centerShift = + (2 : Real) • TileCentroid T0 + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) := + (OuterGeometry.huCent Rminus Rplus centerShift hcentFminus hcentHalfMinus).trans + (OuterGeometry.hsumCent q i T0 Rminus Rplus qf hcentminus hvec0 hveci hcplus) + have hOhalf := (TileOdometerCentralSymmetry C0.1.1 T0 h0 hO0).1 + have hOF := TileOdometerAffineTranslation C0.1.1 (TileHalfTurn T0) + (PartialOdometerHalfTurn h0) centerShift 0 0 hOhalf + have hFroot : BandPrototile C0.1.1 (TileTranslation (TileHalfTurn T0) centerShift) := + TileOdometerBandPrototile _ _ _ hOF + have hFrootCells : + (TileTranslation (TileHalfTurn T0) centerShift).cells = T0'.cells := + (BandPrototileCentroidUnique C0.1.1 _ _ hFroot hT0' (OuterGeometry.hFrootCent q i T0 T0' + hcentroid centerShift huCenter)).1 + have hOhalf' := (TileOdometerCentralSymmetry C0.1.1 T0' h0' hO0').1 + have hOF' := TileOdometerAffineTranslation C0.1.1 (TileHalfTurn T0') + (PartialOdometerHalfTurn h0') centerShift 0 0 hOhalf' + have hFroot' : BandPrototile C0.1.1 + (TileTranslation (TileHalfTurn T0') centerShift) := + TileOdometerBandPrototile _ _ _ hOF' + have hFroot'Cells : + (TileTranslation (TileHalfTurn T0') centerShift).cells = T0.cells := + (BandPrototileCentroidUnique C0.1.1 _ _ hFroot' hT0 (OuterGeometry.hFroot'Cent q i T0 T0' + hcentroid centerShift huCenter)).1 + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + have finj := OuterGeometry.finj centerShift + have hVertexCov (X : ProtoTile) : + FootprintVertices (TileTranslation (TileHalfTurn X) centerShift) = + f '' FootprintVertices X := OuterGeometry.hVertexCov centerShift X + have hEdgeCov := OuterGeometry.hEdgeCov centerShift (OuterGeometry.hHalfEdges) + have pathMap {V : Set GaussianInt} {E : Set (Finset GaussianInt)} + {V' : Set GaussianInt} {E' : Set (Finset GaussianInt)} + {x y : GaussianInt} (hV : V' = f '' V) + (hE : E' = (fun e : Finset GaussianInt => e.image f) '' E) + (P : SimpleGridPathBetween V E x y) := OuterGeometry.pathMap centerShift finj + (OuterGeometry.fstep centerShift) (V := V) (E := E) (V' := V') (E' := E') (x := x) (y + := y) hV hE P + have hVrootNe := OuterGeometry.hVrootNe T0 T0' centerShift hT0'ne hFrootCells + have hVroot'Ne := OuterGeometry.hVroot'Ne T0 T0' centerShift hT0ne hFroot'Cells + have hVplusNe : (TileTranslation (TileHalfTurn Rplus) centerShift).cells.Nonempty := hFplusne + have hVrootEq : FootprintVertices T0' = + FootprintVertices (TileTranslation (TileHalfTurn T0) centerShift) := OuterGeometry.hVrootEq + T0 T0' centerShift hT0'ne hFrootCells + have hVroot'Eq : FootprintVertices T0 = + FootprintVertices (TileTranslation (TileHalfTurn T0') centerShift) := + OuterGeometry.hVroot'Eq T0 T0' centerShift hT0ne hFroot'Cells + have hVplusEq : FootprintVertices Rminus = + FootprintVertices (TileTranslation (TileHalfTurn Rplus) centerShift) := + OuterGeometry.hVplusEq Rminus Rplus centerShift hpc hRmne + have hvT0 : FootprintVertices T0' = f '' FootprintVertices T0 := by + rw [hVrootEq, hVertexCov] + have hvT0' : FootprintVertices T0 = f '' FootprintVertices T0' := by + rw [hVroot'Eq, hVertexCov] + have hvPlus : FootprintVertices Rminus = f '' FootprintVertices Rplus := by + rw [hVplusEq, hVertexCov] + have heT0 := OuterGeometry.heT0 T0 T0' centerShift hEdgeCov (OuterGeometry.hErootEq T0 T0' + centerShift hFrootCells) + have heT0' := OuterGeometry.heT0' T0 T0' centerShift hEdgeCov (OuterGeometry.hEroot'Eq T0 T0' + centerShift hFroot'Cells) + have hePlus := OuterGeometry.hePlus Rminus Rplus centerShift hEdgeCov (OuterGeometry.hEplusEq + Rminus Rplus centerShift hpc) + have vAB := OuterGeometry.vAB T0 T0' centerShift finj hvT0 hvT0' + have pAB := pathMap vAB (OuterGeometry.eAB T0 T0' centerShift finj heT0 heT0') Eplus.pathAB + have pBC := pathMap (OuterGeometry.vBC T0 T0' Rminus Rplus centerShift finj hvT0 hvPlus) + (OuterGeometry.eBC T0 T0' Rminus Rplus centerShift finj heT0 hePlus) Eplus.pathCA + have pCA := pathMap (OuterGeometry.vCA T0 T0' Rminus Rplus centerShift finj hvT0' hvPlus) + (OuterGeometry.eCA T0 T0' Rminus Rplus centerShift finj heT0' hePlus) Eplus.pathBC + have hunique := OuterGeometry.hunique T0 T0' Rminus Rplus centerShift Eplus + (OuterGeometry.hTriple T0 T0' Rminus Rplus centerShift finj hvPlus vAB) + let EM : ExactTileInterfaceTriple T0 T0' Rminus := + { point := f Eplus.point + otherAB := f Eplus.otherAB + otherBC := f Eplus.otherCA + otherCA := f Eplus.otherBC + pathAB := pAB + pathBC := pBC + pathCA := pCA + unique_common := hunique } + have hpt : Eplus.point ≠ Eplus.otherAB := (OuterGeometry.path_endpoints_ne) Eplus.pathAB + have hpair : ({Eplus.point, Eplus.otherAB} : Finset GaussianInt) = + {EM.point, EM.otherAB} := + SimpleGridPathEndpointPairUnique Eplus.pathAB EM.pathAB + have hOuterPath := OuterGeometry.hOuterPath T0 T0' Rminus Rplus centerShift Eplus pAB pBC pCA + hunique (OuterGeometry.houterEnds q Ci i T0 T0' Rminus Rplus centerShift Eplus pAB pBC pCA + hunique hpt (OuterGeometry.hpairCases T0 T0' Rminus Rplus centerShift Eplus pAB pBC pCA + hunique hpt hpair)) (OuterGeometry.reversePath) + have hlatMinus := OuterGeometry.hlatMinus Rminus Rplus centerShift hpc hlatPlus + let g : GaussianInt → GaussianInt := + fun x => GaussianTranslation centerShift (-x - 1 - ⟨0, 1⟩) + have hcellMap := OuterGeometry.hcellMap centerShift + have hdisjoint_image {A B : Finset GaussianInt} + (hd : Disjoint A B) := OuterGeometry.hdisjoint_image centerShift (A := A) (B := B) hd + have hdisjoint0Minus := OuterGeometry.hdisjoint0Minus T0 T0' Rminus Rplus centerShift hpc + hdisjoint0'Plus hFroot'Cells hcellMap hdisjoint_image + have hdisjoint0'Minus := OuterGeometry.hdisjoint0'Minus T0 T0' Rminus Rplus centerShift hpc + hdisjoint0Plus hFrootCells hcellMap hdisjoint_image + have hproperBase : ProperBandQuadruple qf := hqf + have hBandBase : BandPrototile Ci.1.1 base := (by + rcases hstring with ⟨hbase, _, _, _, _, _, _⟩ + exact hbase) + have hcentDiff := OuterGeometry.hcentDiff q i T0 Rminus Rplus qf hcentminus hvec0 hveci hcplus + refine ⟨EM, Eplus, hOuterPath, hlat0, hlat0', hlatMinus, hlatPlus, + hdisjoint0', hdisjoint0Minus, hdisjoint0'Minus, hdisjoint0Plus, + hdisjoint0'Plus, hregular0_induced, hregular0'_induced, ?_, (OuterGeometry.hNoTouch q Ci i + hCi hlarge base Rminus Rplus hproper hcurv0 hcurvi hBandBase (OuterGeometry.hRminusFamily + Ci orientation base Rminus Rplus tiles hstring) (OuterGeometry.hRplusFamily Ci + orientation base Rminus Rplus tiles hstring) hcentDiff)⟩ + intro heq + have hcentEq : TileCentroid Rminus = TileCentroid Rplus := by rw [heq] + have hvNonzero := VectorNonvanishing q hproper.1 0 i.succ + (Fin.succ_ne_zero _).symm (Or.inl hcurv0) + exact hvNonzero (OuterGeometry.hvZero q i (OuterGeometry.hvecZero q i Rminus Rplus hcentDiff + hcentEq) (OuterGeometry.hinjAt979)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2WalkExhaustion.lean b/LeanPool/ApollonianSuperharmonic/P4366T2WalkExhaustion.lean new file mode 100644 index 0000000000..c4371a2b7b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4366T2WalkExhaustion.lean @@ -0,0 +1,151 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3161T2PathExhaustion + +-- [TABLET NODE: P4366T2WalkExhaustion] + +/-! +# P4366T2WalkExhaustion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4366T2WalkExhaustion + {V : Set GaussianInt} {E : Set (Finset GaussianInt)} + {x y : GaussianInt} (hpath : SimpleGridPathBetween V E x y) + (walk : List GaussianInt) + (hhead : walk.head? = some x) (hlast : walk.getLast? = some y) + (hedges : ∀ a b : GaussianInt, ∀ l r : List GaussianInt, + walk = l ++ a :: b :: r → {a, b} ∈ E) : + (∀ z ∈ V, z ∈ walk) ∧ + ∀ e ∈ E, ∃ a b : GaussianInt, ∃ l r : List GaussianInt, + walk = l ++ a :: b :: r ∧ e = {a, b} := by +-- BODY + classical + refine ⟨P3161T2PathExhaustion hpath walk hhead hlast hedges, ?_⟩ + rcases hpath with ⟨p, hp, hlen, hx, hy, hV, hsteps, hE⟩ + have hindex : ∀ a b, {a, b} ∈ E → + p.idxOf a + 1 = p.idxOf b ∨ p.idxOf b + 1 = p.idxOf a := by + intro a b hab + rcases (hE {a, b}).mp hab with ⟨c, d, l, r, heq, hedge⟩ + have hnd := hp + rw [heq, List.nodup_append] at hnd + have hc : c ∉ l := by + intro hc + exact hnd.2.2 c hc c (by simp) rfl + have hd : d ∉ l := by + intro hd + exact hnd.2.2 d hd d (by simp) rfl + have hcd : c ≠ d := by + have hcnot := (List.nodup_cons.mp hnd.2.1).1 + intro h + exact hcnot (by simp [h]) + have hic : p.idxOf c = l.length := by + simp [heq, List.idxOf_append, hc] + have hid : p.idxOf d = l.length + 1 := by + simp [heq, List.idxOf_append, hd, hcd, Nat.add_comm] + have ha : a = c ∨ a = d := by + have : a ∈ ({c, d} : Finset GaussianInt) := by rw [← hedge]; simp + simpa using this + have hb : b = c ∨ b = d := by + have : b ∈ ({c, d} : Finset GaussianInt) := by rw [← hedge]; simp + simpa using this + have habne : a ≠ b := by + intro h + have hcmem : c ∈ ({a, b} : Finset GaussianInt) := by rw [hedge]; simp + have hdmem : d ∈ ({a, b} : Finset GaussianInt) := by rw [hedge]; simp + simp [h] at hcmem hdmem + exact hcd (hcmem.trans hdmem.symm) + rcases ha with rfl | rfl <;> rcases hb with rfl | rfl + · exact False.elim (habne rfl) + · exact Or.inl (by omega) + · exact Or.inr (by omega) + · exact False.elim (habne rfl) + have hix : p.idxOf x = 0 := by + cases p with + | nil => simp at hlen + | cons a r => + simp only [List.head?_cons, Option.some.injEq] at hx + simp [hx] + have hpform : p.dropLast ++ [y] = p := + List.dropLast_append_getLast? y (by simp [hy]) + have hyabsent : y ∉ p.dropLast := by + have hnd := hp + rw [← hpform, List.nodup_append] at hnd + intro h + exact hnd.2.2 y h y (by simp) rfl + have hiy : p.idxOf y = p.length - 1 := by + rw [← hpform, List.idxOf_append] + simp [hyabsent] + intro e he + obtain ⟨c, d, l, r, hpEq, heEq⟩ := (hE e).mp he + have hnd := hp + rw [hpEq, List.nodup_append] at hnd + have hcnot : c ∉ l := by + intro hc + exact hnd.2.2 c hc c (by simp) rfl + have hdnot : d ∉ l := by + intro hd + exact hnd.2.2 d hd d (by simp) rfl + have hcd : c ≠ d := by + intro h + exact (List.nodup_cons.mp hnd.2.1).1 (by simp [h]) + have hic : p.idxOf c = l.length := by + simp [hpEq, List.idxOf_append, hcnot] + have hid : p.idxOf d = l.length + 1 := by + simp [hpEq, List.idxOf_append, hdnot, hcd, Nat.add_comm] + have hcmem : c ∈ p := by simp [hpEq] + have hdmem : d ∈ p := by simp [hpEq] + by_contra hmissing + have hnoedge : ∀ a b, ∀ pre post : List GaussianInt, + walk = pre ++ a :: b :: post → ({a, b} : Finset GaussianInt) ≠ e := by + intro a b pre post hw he' + exact hmissing ⟨a, b, pre, post, hw, he'.symm⟩ + have propagate : ∀ (w : List GaussianInt), + (∀ a b, ∀ pre post : List GaussianInt, + w = pre ++ a :: b :: post → {a, b} ∈ E ∧ ({a, b} : Finset GaussianInt) ≠ e) → + (∀ a ∈ w.head?, p.idxOf a ≤ l.length) → + ∀ b ∈ w.getLast?, p.idxOf b ≤ l.length := by + intro w + induction w with + | nil => simp + | cons a w ih => + intro hw ha + cases w with + | nil => simpa using ha + | cons b w => + have hab := hw a b [] w rfl + have hiab := hindex a b hab.1 + have hia : p.idxOf a ≤ l.length := ha a (by simp) + have hib : p.idxOf b ≤ l.length := by + by_contra hgt + have hac : p.idxOf a = p.idxOf c := by omega + have hbd : p.idxOf b = p.idxOf d := by omega + have hac' : a = c := ((List.idxOf_inj hcmem).mp hac.symm).symm + have hbd' : b = d := ((List.idxOf_inj hdmem).mp hbd.symm).symm + exact hab.2 (by simpa [hac', hbd'] using heEq.symm) + have hw' : ∀ c' d', ∀ pre post : List GaussianInt, + b :: w = pre ++ c' :: d' :: post → + {c', d'} ∈ E ∧ ({c', d'} : Finset GaussianInt) ≠ e := by + intro c' d' pre post hw' + exact hw c' d' (a :: pre) post (by simp [hw', List.cons_append]) + simpa using ih hw' (by simpa using hib) + have hylt := propagate walk + (fun a b pre post hw => ⟨hedges a b pre post hw, hnoedge a b pre post hw⟩) + (by simp [hhead, hix]) y (by simp [hlast]) + have hlength : p.length = l.length + 2 + r.length := by simp [hpEq]; omega + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4387T1ParentSlopeNormalForms.lean b/LeanPool/ApollonianSuperharmonic/P4387T1ParentSlopeNormalForms.lean new file mode 100644 index 0000000000..65b447e6d4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4387T1ParentSlopeNormalForms.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P4387T1ParentSlopeNormalForms] + +/-! +# P4387T1ParentSlopeNormalForms + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4387T1ParentSlopeNormalForms + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) : + let A := BandVectors.2 + let J : GaussianInt := -⟨0, 1⟩ + let U := A (q 2) (q 1) + let W := A (q 3) (q 2) + A (q 1) (q 3) = -U - W ∧ + A (q 1) (q 2) = J * U ∧ + A (q 3) (q 1) = J * (U + W) ∧ + A (q 2) (q 3) = J * W ∧ + A (q 0) (q 1) = U - J * (U + W) ∧ + A (q 0) (q 2) = W + J * U ∧ + A (q 0) (q 3) = -U - W + J * W ∧ + A (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) + + A (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = (1 + J) * U ∧ + A (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) + + A (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = (J - 1) * (U + W) ∧ + A (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + + A (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) = (1 + J) * W := by +-- BODY + dsimp only + obtain ⟨_, hsum, _, hin1, flip⟩ := VectorRecursionLaws q cfg.proper.1 + have laws2 := VectorRecursionLaws _ (SemiProperQuadruple.rotate cfg.proper.1) + have laws3 := VectorRecursionLaws _ + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate cfg.proper.1)) + have hin2 : BandVectors.2 (q 2) (q 0) = BandVectors.2 (q 2) (q 1) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 3) (q 2) := by + simpa using laws2.2.2.2.1 + have hin3 : BandVectors.2 (q 3) (q 0) = BandVectors.2 (q 3) (q 2) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 1) (q 3) := by + simpa using laws3.2.2.2.1 + have h13 : BandVectors.2 (q 1) (q 3) = + -BandVectors.2 (q 2) (q 1) - BandVectors.2 (q 3) (q 2) := by + apply eq_of_sub_eq_zero + calc + _ = BandVectors.2 (q 3) (q 2) + BandVectors.2 (q 1) (q 3) + + BandVectors.2 (q 2) (q 1) := by ring + _ = 0 := hsum + have firstFlip := (VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).2.2.2.2 + cfg.firstProper + have secondFlip := (VectorRecursionLaws cfg.secondPredecessor cfg.secondProper.1).2.2.2.2 + cfg.secondProper + have h12 := (firstFlip 1).2 + have hf13 := (firstFlip 2).2 + have h23 := (secondFlip 0).2 + change BandVectors.2 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = + -(⟨0, 1⟩ : GaussianInt) * + BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) at h12 + change BandVectors.2 (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) = + -(⟨0, 1⟩ : GaussianInt) * + BandVectors.2 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) at hf13 + change BandVectors.2 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) = + -(⟨0, 1⟩ : GaussianInt) * + BandVectors.2 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) at h23 + rw [cfg.firstChild, cfg.firstParentTwo] at h12 + rw [cfg.firstChild, cfg.firstParentThree] at hf13 + rw [cfg.secondChild, cfg.secondParentOne] at h23 + have h31 : BandVectors.2 (q 3) (q 1) = + -(⟨0, 1⟩ : GaussianInt) * + (BandVectors.2 (q 2) (q 1) + BandVectors.2 (q 3) (q 2)) := by + calc + _ = (⟨0, 1⟩ : GaussianInt) * + (-(⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 3) (q 1)) := by + ext <;> simp + _ = (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 1) (q 3) := by rw [← hf13] + _ = _ := by rw [h13]; ring + have fout1 := (flip cfg.proper 0).2 + have fout2 := (flip cfg.proper 1).2 + have fout3 := (flip cfg.proper 2).2 + simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl] at fout1 + simp only [show (1 : Fin 3).succ = (2 : Fin 4) from rfl] at fout2 + simp only [show (2 : Fin 3).succ = (3 : Fin 4) from rfl] at fout3 + refine ⟨h13, h12, h31, h23, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [fout1, hin1, h13] + ext <;> simp <;> ring + · rw [fout2, hin2] + ext <;> simp; ring + · rw [fout3, hin3, h13] + ext <;> simp <;> ring + · rw [cfg.firstChild, cfg.firstParentTwo, h12] + ring + · rw [cfg.firstChild, cfg.firstParentThree, h13, h31] + ring + · rw [cfg.secondChild, cfg.secondParentOne, h23] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4387T1PlacedCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4387T1PlacedCoordinates.lean new file mode 100644 index 0000000000..1965c1378c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4387T1PlacedCoordinates.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer +public import LeanPool.ApollonianSuperharmonic.P3055T1SignedCentroidNormalForms +public import LeanPool.ApollonianSuperharmonic.P4387T1ParentSlopeNormalForms +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P4387T1PlacedCoordinates] + +/-! +# P4387T1PlacedCoordinates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4387T1PlacedCoordinates + {q : Fin 4 → CircleCoordinates} {cfg : BandOrderedGeneralConfiguration q} + {C₀ : BandCircle} {T₀ : ProtoTile} + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T₀) + (h₀ : PartialOdometer) (C : BandCircle) (T : ProtoTile) + (h : PartialOdometer) (a : PeriodicSubtileIndex) + (pa : P4261T1PlacedOdometer cert h₀ C T h a) : + let F := fun (J V W : GaussianInt) (x : PeriodicSubtileIndex) => + (1 / 2 : ℝ) • GaussianRealPoint + (match x.label with + | .A => (1 - J) * W | .B => -((1 - J) * W) + | .C => -((1 - J) * (V + W)) | .D => (1 - J) * (V + W) + | .E => (1 - J) * V | .F => -((1 - J) * V)) + + GaussianRealPoint + ((x.first : GaussianInt) * (V - J * (V + W)) + + (x.second : GaussianInt) * (W + J * V)) + TileCentroid T = TileCentroid T₀ + + F ⟨0, 1⟩ (BandVectors.1 (q 2) (q 1)) (BandVectors.1 (q 3) (q 2)) a ∧ + pa.slope = pa.rootSlope + + F (-⟨0, 1⟩) (BandVectors.2 (q 2) (q 1)) (BandVectors.2 (q 3) (q 2)) a := by +-- BODY + dsimp only + have vc := P3055T1SignedCentroidNormalForms q cfg C₀ T₀ cert + have vf := P3055T1ParentVectorNormalForms q cfg + have af := P4387T1ParentSlopeNormalForms q cfg + dsimp only at vc vf af + have translated (X : ProtoTile) (z : GaussianInt) : + TileCentroid (TileTranslation X z) = + TileCentroid X + GaussianRealPoint z := by + rw [(TileTranslationFormulas X z).2.2.2.2.1] + rfl + constructor + · rw [pa.centroid] + cases hl : a.label <;> + simp only [SubtileOccurrenceInterpretation, hl, translated] + all_goals + rw [vc, cert.period_u, cert.period_v, vf.2.2.2.2.1, vf.2.2.2.2.2.1] + apply Prod.ext <;> + simp [GaussianRealPoint, -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> + ring + · have hs := pa.slope_offset + cases hl : a.label <;> simp only [hl] at hs ⊢ + all_goals + simp? [af.1, af.2.2.2.2.1, af.2.2.2.2.2.1] at hs + have h₁ := congrArg Prod.fst hs + have h₂ := congrArg Prod.snd hs + apply Prod.ext + all_goals + simp [P4250T1SlopeOffset, GaussianRealPoint, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] at h₁ h₂ ⊢ + linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4397T1PathAvoidsPrecursorEdges.lean b/LeanPool/ApollonianSuperharmonic/P4397T1PathAvoidsPrecursorEdges.lean new file mode 100644 index 0000000000..92b919e979 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4397T1PathAvoidsPrecursorEdges.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4397T1ReflectedEdgeNotBoundary + +-- [TABLET NODE: P4397T1PathAvoidsPrecursorEdges] + +/-! +# P4397T1PathAvoidsPrecursorEdges + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4397T1PathAvoidsPrecursorEdges : + ∀ (O : ProtoTile), ∀ (c : Real × Real), (CentrallyReflectedAt c O O) → (∀ (a : GaussianInt), + ∀ (b : GaussianInt), (a ≠ b) → ((GaussianRealPoint b = + (2 * c.1 - (GaussianRealPoint a).1, + 2 * c.2 - (GaussianRealPoint a).2)) → (∀ (g : List GaussianInt), (g.Nodup) → ((g.head? = + some a) → ((g.getLast? = some b) → ((∀ u, ∀ v, (u, v) ∈ g.zip g.tail → + FourNeighborAdjacent u v) → ((∀ u ∈ g, u ∈ FootprintVertices O → u = a ∨ u = b) → ((∀ + u, ∀ v, (u, v) ∈ g.zip g.tail → + u ∈ FootprintVertices O → v ∈ FootprintVertices O → + ¬ OpenLatticeEdge u v ⊆ interior (TileRealization O)) → (∀ u, ∀ v, (u, v) ∈ g.zip g.tail → + ({u, v} : Finset GaussianInt) ∉ FootprintEdges O))))))))) := by + intro O c hsym a b hab hreflect g hnd hhead hlast hsteps hroots hnochord +-- BODY + have first_dropLast (l : List GaussianInt) (u v : GaussianInt) + (he : (u, v) ∈ l.zip l.tail) : u ∈ l.dropLast := by + induction l with + | nil => simp at he + | cons x l ih => + cases l with + | nil => simp at he + | cons y ys => + simp only [List.tail_cons, List.zip_cons_cons, List.mem_cons] at he + simp only [List.dropLast_cons_cons, List.mem_cons] + rcases he with he | he + · cases he + exact Or.inl rfl + · exact Or.inr (ih he) + have ha_tail : a ∉ g.tail := by + obtain ⟨l, hl⟩ := List.head?_eq_some_iff.mp hhead + subst g + exact (List.nodup_cons.mp hnd).1 + have hb_dropLast : b ∉ g.dropLast := by + have hl : g.dropLast ++ [b] = g := + List.dropLast_append_getLast? b (by simp [hlast]) + have hn : (g.dropLast ++ [b]).Nodup := hl.symm ▸ hnd + intro hb + exact (List.nodup_append.mp hn).2.2 b hb b (by simp) rfl + intro u v he hfoot + obtain ⟨z, w, hs⟩ := P4397T1UnitEdgeCells.1 u v (hsteps u v he) + have hgeom := P4397T1UnitEdgeCells.2 u v z w hs O + have hsome := hgeom.1.mp hfoot + have hraw := hgeom.2.2.1 hsome + have hua : u = a := by + rcases hroots u (List.of_mem_zip he).1 hraw.1 with hu | hu + · exact hu + · exact (hb_dropLast (hu ▸ first_dropLast g u v he)).elim + have hvb : v = b := by + rcases hroots v (List.mem_of_mem_tail (List.of_mem_zip he).2) hraw.2.1 with hv | hv + · exact (ha_tail (hv ▸ (List.of_mem_zip he).2)).elim + · exact hv + have hnotboth : ¬ (z ∈ O.cells ∧ w ∈ O.cells) := by + intro hb + exact hnochord u v he hraw.1 hraw.2.1 (hgeom.2.2.2.1 hb) + have hboundary : ({u, v} : Finset GaussianInt) ∈ BoundaryFootprintEdges O := by + apply hgeom.2.1.mpr + rcases hsome with hz | hw + · exact Or.inl ⟨hz, fun hw => hnotboth ⟨hz, hw⟩⟩ + · exact Or.inr ⟨fun hz => hnotboth ⟨hz, hw⟩, hw⟩ + subst u + subst v + exact P4397T1ReflectedEdgeNotBoundary O c hsym a b (hsteps a b he) + hreflect hboundary + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4397T1ReflectedEdgeNotBoundary.lean b/LeanPool/ApollonianSuperharmonic/P4397T1ReflectedEdgeNotBoundary.lean new file mode 100644 index 0000000000..03b67d9f74 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4397T1ReflectedEdgeNotBoundary.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells +public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership +public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P4397T1ReflectedEdgeNotBoundary] + +/-! +# P4397T1ReflectedEdgeNotBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4397T1ReflectedEdgeNotBoundary (O : ProtoTile) + (c : Real × Real) (hsym : CentrallyReflectedAt c O O) + (a b : GaussianInt) (hadj : FourNeighborAdjacent a b) + (hreflect : GaussianRealPoint b = + (2 * c.1 - (GaussianRealPoint a).1, + 2 * c.2 - (GaussianRealPoint a).2)) : + ({a, b} : Finset GaussianInt) ∉ BoundaryFootprintEdges O := by +-- BODY + obtain ⟨z, w, hshape⟩ := P4397T1UnitEdgeCells.1 a b hadj + have hgeom := P4397T1UnitEdgeCells.2 a b z w hshape + have hre : (a.re : Real) + (b.re : Real) = 2 * c.1 := by + have h := congrArg Prod.fst hreflect + dsimp [GaussianRealPoint] at h + linarith + have him : (a.im : Real) + (b.im : Real) = 2 * c.2 := by + have h := congrArg Prod.snd hreflect + dsimp [GaussianRealPoint] at h + linarith + have hsum : (z.re : Real) + (w.re : Real) + 1 = 2 * c.1 ∧ + (z.im : Real) + (w.im : Real) + 1 = 2 * c.2 := by + rcases hshape with ⟨(⟨ha, hb⟩ | ⟨hb, ha⟩), hw⟩ | + ⟨(⟨ha, hb⟩ | ⟨hb, ha⟩), hw⟩ + all_goals + subst a + subst b + subst w + norm_num at hre him ⊢ + constructor <;> linarith + have image_center (r s : GaussianInt) + (hr : r ∈ O.cells) + (hrsum : (r.re : Real) + (s.re : Real) + 1 = 2 * c.1) + (hisum : (r.im : Real) + (s.im : Real) + 1 = 2 * c.2) : + s ∈ O.cells := by + apply (P3776T1CellCenterMembership O s).mp + rw [show TileRealization O = + (fun p : Real × Real => (2 * c.1 - p.1, 2 * c.2 - p.2)) '' + TileRealization O from hsym] + refine ⟨GaussianRealPoint r + ((1 / 2, 1 / 2) : Real × Real), + (P3776T1CellCenterMembership O r).mpr hr, ?_⟩ + apply Prod.ext <;> dsimp [GaussianRealPoint] <;> linarith + have heq : z ∈ O.cells ↔ w ∈ O.cells := + ⟨fun hz => image_center z w hz hsum.1 hsum.2, + fun hw => image_center w z hw (by linarith [hsum.1]) (by linarith [hsum.2])⟩ + intro he + rcases (hgeom O).2.1.mp he with ⟨hz, hw⟩ | ⟨hz, hw⟩ + · exact hw (heq.mp hz) + · exact hz (heq.mpr hw) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4397T1SimplePathSplicing.lean b/LeanPool/ApollonianSuperharmonic/P4397T1SimplePathSplicing.lean new file mode 100644 index 0000000000..f922fd574d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4397T1SimplePathSplicing.lean @@ -0,0 +1,107 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Data.List.Zip + +-- [TABLET NODE: P4397T1SimplePathSplicing] + +/-! +# P4397T1SimplePathSplicing + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4397T1SimplePathSplicing {α : Type*} + (g k : List α) (a b : α) + (hg : g.Nodup) (hk : k.Nodup) (hgl : 2 ≤ g.length) (hkl : 2 ≤ k.length) + (hga : g.head? = some a) (hgb : g.getLast? = some b) + (hkb : k.head? = some b) (hka : k.getLast? = some a) + (hmeet : ∀ z, z ∈ g → z ∈ k → z = a ∨ z = b) + (hedge : ∀ u v, (u, v) ∈ g.zip g.tail → + (u, v) ∉ k.zip k.tail ∧ (v, u) ∉ k.zip k.tail) : + let p := g.dropLast ++ k.dropLast + p.Nodup ∧ 3 ≤ p.length ∧ + ∃ x y, p.head? = some x ∧ p.getLast? = some y ∧ + (p.zip p.tail) ++ [(y, x)] = (g.zip g.tail) ++ (k.zip k.tail) ∧ + (∀ z ∈ p, z ∈ g ∨ z ∈ k) := by +-- BODY + have form (l : List α) (u v : α) (hlen : 2 ≤ l.length) + (hh : l.head? = some u) (hl : l.getLast? = some v) : + ∃ m : List α, l = (u :: m) ++ [v] := by + obtain ⟨t, rfl⟩ := List.head?_eq_some_iff.mp hh + have ht : t ≠ [] := by intro he; simp [he] at hlen + have htl : t.getLast? = some v := by + cases t with + | nil => exact (ht rfl).elim + | cons c cs => simpa using hl + obtain ⟨m, hm⟩ := List.getLast?_eq_some_iff.mp htl + exact ⟨m, by simp [hm]⟩ + obtain ⟨m, rfl⟩ := form g a b hgl hga hgb + obtain ⟨n, rfl⟩ := form k b a hkl hkb hka + dsimp only + simp only [List.dropLast_concat] + have hnd : ((a :: m) ++ (b :: n)).Nodup := by + apply (List.nodup_append.mp hg).1.append (List.nodup_append.mp hk).1 + apply List.disjoint_left.mpr + intro z hz hz' + rcases hmeet z (by simp only [List.mem_append]; exact Or.inl hz) + (by simp only [List.mem_append]; exact Or.inl hz') with hza | hzb + · exact (List.nodup_append.mp hk).2.2 z hz' a (by simp) hza + · exact (List.nodup_append.mp hg).2.2 z hz b (by simp) hzb + have hlen : 3 ≤ ((a :: m) ++ (b :: n)).length := by + cases m with + | nil => + cases n with + | nil => exact ((hedge a b (by simp)).2 (by simp)).elim + | cons c cs => simp + | cons c cs => simp; omega + let y := (b :: n).getLast (by simp) + have hy : (b :: n).getLast? = some y := by + exact List.getLast?_eq_some_getLast (by simp) + have hpLast : ((a :: m) ++ (b :: n)).getLast? = some y := by + simp only [List.getLast?_append, hy, Option.some_or] + have close_edges (l : List α) (v u : α) (hl : l.getLast? = some v) : + l.zip (l.tail ++ [u]) = l.zip l.tail ++ [(v, u)] := by + induction l with + | nil => simp at hl + | cons c l ih => + cases l with + | nil => simp only [List.getLast?_singleton, Option.some.injEq] at hl + subst v + rfl + | cons d ds => + have hlast : (d :: ds).getLast? = some v := by simpa using hl + simpa only [List.tail_cons, List.cons_append, List.zip_cons_cons] using + congrArg (List.cons (c, d)) (ih hlast) + have trim_zip (l : List α) (u v : α) : + ((u :: l) ++ [v]).zip (((u :: l) ++ [v]).tail) = + (u :: l).zip (l ++ [v]) := by + simpa only [List.tail_append, List.tail_cons, List.isEmpty_cons, Bool.false_eq_true, + ↓reduceIte, + List.append_nil, List.zip_nil_right] using + (List.zip_append (l₁ := u :: l) (r₁ := [v]) (l₂ := l ++ [v]) (r₂ := []) + (by simp)) + refine ⟨hnd, hlen, a, y, by simp, hpLast, ?_, ?_⟩ + · rw [← close_edges _ y a hpLast, trim_zip m a b, trim_zip n b a] + have ht : (((a :: m) ++ (b :: n)).tail ++ [a]) = + (m ++ [b]) ++ (n ++ [a]) := by simp [List.append_assoc] + rw [ht] + exact List.zip_append (by simp) + · intro z hz + rcases List.mem_append.mp hz with hz | hz + · exact Or.inl (by simp only [List.mem_append]; exact Or.inl hz) + · exact Or.inr (by simp only [List.mem_append]; exact Or.inl hz) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4397T1UnitEdgeCells.lean b/LeanPool/ApollonianSuperharmonic/P4397T1UnitEdgeCells.lean new file mode 100644 index 0000000000..8fcdc91d39 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4397T1UnitEdgeCells.lean @@ -0,0 +1,957 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.OpenLatticeEdge +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell + +-- [TABLET NODE: P4397T1UnitEdgeCells] + +/-! +# P4397T1UnitEdgeCells + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace UnitEdgeCellLemmas + +private theorem hfootV : + (∀ {α : Type}, ∀ [DecidableEq α], ∀ (a : α), ∀ (b : α), ∀ (c : α), ∀ (d : α), (({a, b} : + Finset α) = {c, d}) → (a ≠ b) → (a = c ∧ b = d) ∨ (a = d ∧ b = c)) → ∀ (U : ProtoTile), ∀ + (z : GaussianInt), ({z + 1, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges U ↔ + z ∈ U.cells ∨ z + 1 ∈ U.cells := by + classical + intro pairMatch U z + change (∃ x ∈ U.cells, + ({z + 1, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) = {x, x + 1} ∨ + _ = {x, x + ⟨0, 1⟩} ∨ _ = {x + 1, x + 1 + ⟨0, 1⟩} ∨ + _ = {x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) ↔ _ + constructor + · rintro ⟨x, hx, he | he | he | he⟩ + · have hm := pairMatch x (x + 1) (z + 1) (z + 1 + ⟨0, 1⟩) he.symm (by + intro hh + have h := congrArg Zsqrtd.re hh + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at h + omega) + rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · have hr1 := congrArg Zsqrtd.re h1 + have hr2 := congrArg Zsqrtd.re h2 + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr1 hr2 + omega + · have hi1 := congrArg Zsqrtd.im h1 + have hi2 := congrArg Zsqrtd.im h2 + simp only [Zsqrtd.im_add, Zsqrtd.im_one] at hi1 hi2 + omega + · have hm := pairMatch x (x + ⟨0, 1⟩) (z + 1) (z + 1 + ⟨0, 1⟩) he.symm (by + intro hh + have h := congrArg Zsqrtd.im hh + simp only [Zsqrtd.im_add] at h + omega) + rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · exact Or.inr (h1 ▸ hx) + · have hi1 := congrArg Zsqrtd.im h1 + have hi2 := congrArg Zsqrtd.im h2 + simp only [Zsqrtd.im_add, Zsqrtd.im_one] at hi1 hi2 + omega + · have hm := pairMatch (x + 1) (x + 1 + ⟨0, 1⟩) (z + 1) + (z + 1 + ⟨0, 1⟩) he.symm (by + intro hh + have h := congrArg Zsqrtd.im hh + simp only [Zsqrtd.im_add, Zsqrtd.im_one] at h + omega) + rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · have hbase : x = z := add_right_cancel h1 + exact Or.inl (hbase ▸ hx) + · have hi1 := congrArg Zsqrtd.im h1 + have hi2 := congrArg Zsqrtd.im h2 + simp only [Zsqrtd.im_add, Zsqrtd.im_one] at hi1 hi2 + omega + · have hm := pairMatch (x + ⟨0, 1⟩) (x + 1 + ⟨0, 1⟩) + (z + 1) (z + 1 + ⟨0, 1⟩) he.symm (by + intro hh + have h := congrArg Zsqrtd.re hh + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at h + omega) + rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · have hr1 := congrArg Zsqrtd.re h1 + have hr2 := congrArg Zsqrtd.re h2 + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr1 hr2 + omega + · have hr1 := congrArg Zsqrtd.re h1 + have hr2 := congrArg Zsqrtd.re h2 + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr1 hr2 + omega + · rintro (hz | hw) + · exact ⟨z, hz, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨z + 1, hw, Or.inr (Or.inl rfl)⟩ + +private theorem hboundaryV : + (∀ {α : Type}, ∀ [DecidableEq α], ∀ (a : α), ∀ (b : α), ∀ (c : α), ∀ (d : α), (({a, b} : + Finset α) = {c, d}) → (a ≠ b) → (a = c ∧ b = d) ∨ (a = d ∧ b = c)) → ∀ (U : ProtoTile), ∀ + (z : GaussianInt), ({z + 1, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges U ↔ + (z + 1 ∈ U.cells ∧ z ∉ U.cells) ∨ + (z + 1 ∉ U.cells ∧ z ∈ U.cells) := by + classical + intro pairMatch U z + change (∃ a : GaussianInt, + (({z + 1, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) = {a, a + 1} ∧ + ((a ∈ U.cells ∧ a - ⟨0, 1⟩ ∉ U.cells) ∨ + (a ∉ U.cells ∧ a - ⟨0, 1⟩ ∈ U.cells))) ∨ + (({z + 1, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) = {a, a + ⟨0, 1⟩} ∧ + ((a ∈ U.cells ∧ a - 1 ∉ U.cells) ∨ + (a ∉ U.cells ∧ a - 1 ∈ U.cells)))) ↔ _ + constructor + · rintro ⟨a, he | he⟩ + · rcases he with ⟨he, hx⟩ + have hm := pairMatch a (a + 1) (z + 1) (z + 1 + ⟨0, 1⟩) he.symm (by + intro hh + have h := congrArg Zsqrtd.re hh + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at h + omega) + rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · have hr1 := congrArg Zsqrtd.re h1 + have hr2 := congrArg Zsqrtd.re h2 + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr1 hr2 + omega + · have hi1 := congrArg Zsqrtd.im h1 + have hi2 := congrArg Zsqrtd.im h2 + simp only [Zsqrtd.im_add, Zsqrtd.im_one] at hi1 hi2 + omega + · rcases he with ⟨he, hx⟩ + have hm := pairMatch a (a + ⟨0, 1⟩) (z + 1) (z + 1 + ⟨0, 1⟩) he.symm (by + intro hh + have h := congrArg Zsqrtd.im hh + simp only [Zsqrtd.im_add] at h + omega) + rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · subst a + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hx + · have hi1 := congrArg Zsqrtd.im h1 + have hi2 := congrArg Zsqrtd.im h2 + simp only [Zsqrtd.im_add, Zsqrtd.im_one] at hi1 hi2 + omega + · rintro (hx | hx) + · exact ⟨z + 1, Or.inr ⟨by simp, by simpa [sub_eq_add_neg] using Or.inl hx⟩⟩ + · exact ⟨z + 1, Or.inr ⟨by simp, by simpa [sub_eq_add_neg] using Or.inr hx⟩⟩ + +private theorem hfootH : + (∀ {α : Type}, ∀ [DecidableEq α], ∀ (a : α), ∀ (b : α), ∀ (c : α), ∀ (d : α), (({a, b} : + Finset α) = {c, d}) → (a ≠ b) → (a = c ∧ b = d) ∨ (a = d ∧ b = c)) → ∀ (U : ProtoTile), ∀ + (z : GaussianInt), ({z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges U ↔ + z ∈ U.cells ∨ z + ⟨0, 1⟩ ∈ U.cells := by + classical + intro pairMatch U z + change (∃ x ∈ U.cells, + ({z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) = {x, x + 1} ∨ + _ = {x, x + ⟨0, 1⟩} ∨ _ = {x + 1, x + 1 + ⟨0, 1⟩} ∨ + _ = {x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) ↔ _ + constructor + · rintro ⟨x, hx, he | he | he | he⟩ + · have hm := pairMatch x (x + 1) (z + ⟨0, 1⟩) (z + 1 + ⟨0, 1⟩) he.symm (by + intro hh + have h := congrArg Zsqrtd.re hh + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at h + omega) + rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · exact Or.inr (h1 ▸ hx) + · have hr1 := congrArg Zsqrtd.re h1 + have hr2 := congrArg Zsqrtd.re h2 + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr1 hr2 + omega + · have hm := pairMatch x (x + ⟨0, 1⟩) (z + ⟨0, 1⟩) + (z + 1 + ⟨0, 1⟩) he.symm (by + intro hh + have h := congrArg Zsqrtd.im hh + simp only [Zsqrtd.im_add] at h + omega) + rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · have hr1 := congrArg Zsqrtd.re h1 + have hr2 := congrArg Zsqrtd.re h2 + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr1 hr2 + omega + · have hr1 := congrArg Zsqrtd.re h1 + have hr2 := congrArg Zsqrtd.re h2 + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr1 hr2 + omega + · have hm := pairMatch (x + 1) (x + 1 + ⟨0, 1⟩) + (z + ⟨0, 1⟩) (z + 1 + ⟨0, 1⟩) he.symm (by + intro hh + have h := congrArg Zsqrtd.im hh + simp only [Zsqrtd.im_add, Zsqrtd.im_one] at h + omega) + rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · have hr1 := congrArg Zsqrtd.re h1 + have hr2 := congrArg Zsqrtd.re h2 + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr1 hr2 + omega + · have hr1 := congrArg Zsqrtd.re h1 + have hr2 := congrArg Zsqrtd.re h2 + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr1 hr2 + omega + · have hm := pairMatch (x + ⟨0, 1⟩) (x + 1 + ⟨0, 1⟩) + (z + ⟨0, 1⟩) (z + 1 + ⟨0, 1⟩) he.symm (by + intro hh + have h := congrArg Zsqrtd.re hh + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at h + omega) + rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · have hbase : x = z := add_right_cancel h1 + exact Or.inl (hbase ▸ hx) + · have hr1 := congrArg Zsqrtd.re h1 + have hr2 := congrArg Zsqrtd.re h2 + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr1 hr2 + omega + · rintro (hz | hw) + · exact ⟨z, hz, Or.inr (Or.inr (Or.inr rfl))⟩ + · exact ⟨z + ⟨0, 1⟩, hw, Or.inl (by + ext q + simp [add_assoc, add_comm, add_left_comm])⟩ + +private theorem hboundaryH : + (∀ {α : Type}, ∀ [DecidableEq α], ∀ (a : α), ∀ (b : α), ∀ (c : α), ∀ (d : α), (({a, b} : + Finset α) = {c, d}) → (a ≠ b) → (a = c ∧ b = d) ∨ (a = d ∧ b = c)) → ∀ (U : ProtoTile), ∀ + (z : GaussianInt), ({z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges U ↔ + (z + ⟨0, 1⟩ ∈ U.cells ∧ z ∉ U.cells) ∨ + (z + ⟨0, 1⟩ ∉ U.cells ∧ z ∈ U.cells) := by + classical + intro pairMatch U z + change (∃ a : GaussianInt, + (({z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) = {a, a + 1} ∧ + ((a ∈ U.cells ∧ a - ⟨0, 1⟩ ∉ U.cells) ∨ + (a ∉ U.cells ∧ a - ⟨0, 1⟩ ∈ U.cells))) ∨ + (({z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) = {a, a + ⟨0, 1⟩} ∧ + ((a ∈ U.cells ∧ a - 1 ∉ U.cells) ∨ (a ∉ U.cells ∧ a - 1 ∈ U.cells)))) ↔ _ + constructor + · rintro ⟨a, he | he⟩ + · rcases he with ⟨he, hx⟩ + have hm := pairMatch a (a + 1) (z + ⟨0, 1⟩) + (z + 1 + ⟨0, 1⟩) he.symm (by + intro hh + have h := congrArg Zsqrtd.re hh + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at h + omega) + rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · subst a + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hx + · have hr1 := congrArg Zsqrtd.re h1 + have hr2 := congrArg Zsqrtd.re h2 + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr1 hr2 + omega + · rcases he with ⟨he, hx⟩ + have hm := pairMatch a (a + ⟨0, 1⟩) (z + ⟨0, 1⟩) + (z + 1 + ⟨0, 1⟩) he.symm (by + intro hh + have h := congrArg Zsqrtd.im hh + simp only [Zsqrtd.im_add] at h + omega) + rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · have hr1 := congrArg Zsqrtd.re h1 + have hr2 := congrArg Zsqrtd.re h2 + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr1 hr2 + omega + · have hr1 := congrArg Zsqrtd.re h1 + have hr2 := congrArg Zsqrtd.re h2 + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr1 hr2 + omega + · rintro (hx | hx) + · exact ⟨z + ⟨0, 1⟩, Or.inl ⟨by + ext q + simp [add_assoc, add_comm, add_left_comm], + by simpa [sub_eq_add_neg] using Or.inl hx⟩⟩ + · exact ⟨z + ⟨0, 1⟩, Or.inl ⟨by + ext q + simp [add_assoc, add_comm, add_left_comm], + by simpa [sub_eq_add_neg] using Or.inr hx⟩⟩ + +private theorem hsegV : + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells ∨ z + 1 ∈ U.cells) → ∀ t : Set.Icc (0 : + Real) 1, + ((1 - (t : Real)) * ((z + 1).re : Real) + + (t : Real) * ((z + 1 + ⟨0, 1⟩).re : Real), + (1 - (t : Real)) * ((z + 1).im : Real) + + (t : Real) * ((z + 1 + ⟨0, 1⟩).im : Real)) ∈ TileRealization U := by + classical + intro U z hocc t + rcases hocc with hz | hw + · change _ ∈ ⋃ x ∈ U.cells, ClosedSquareRealization x + apply Set.mem_iUnion.mpr + refine ⟨z, Set.mem_iUnion.mpr ⟨hz, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, + Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one, + Int.cast_add, Int.cast_one, Int.cast_zero] + constructor <;> constructor <;> nlinarith [t.2.1, t.2.2] + · change _ ∈ ⋃ x ∈ U.cells, ClosedSquareRealization x + apply Set.mem_iUnion.mpr + refine ⟨z + 1, Set.mem_iUnion.mpr ⟨hw, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, + Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one, + Int.cast_add, Int.cast_one, Int.cast_zero] + constructor <;> constructor <;> nlinarith [t.2.1, t.2.2] + +private theorem hsegH : + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells ∨ z + ⟨0, 1⟩ ∈ U.cells) → ∀ t : Set.Icc + (0 : Real) 1, + ((1 - (t : Real)) * ((z + 1 + ⟨0, 1⟩).re : Real) + + (t : Real) * ((z + ⟨0, 1⟩).re : Real), + (1 - (t : Real)) * ((z + 1 + ⟨0, 1⟩).im : Real) + + (t : Real) * ((z + ⟨0, 1⟩).im : Real)) ∈ TileRealization U := by + classical + intro U z hocc t + rcases hocc with hz | hw + · change _ ∈ ⋃ x ∈ U.cells, ClosedSquareRealization x + apply Set.mem_iUnion.mpr + refine ⟨z, Set.mem_iUnion.mpr ⟨hz, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, + Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one, + Int.cast_add, Int.cast_one, Int.cast_zero] + constructor <;> constructor <;> nlinarith [t.2.1, t.2.2] + · change _ ∈ ⋃ x ∈ U.cells, ClosedSquareRealization x + apply Set.mem_iUnion.mpr + refine ⟨z + ⟨0, 1⟩, Set.mem_iUnion.mpr ⟨hw, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, + Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one, + Int.cast_add, Int.cast_one, Int.cast_zero] + constructor <;> constructor <;> nlinarith [t.2.1, t.2.2] + +private theorem hinteriorV : + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → (z + 1 ∈ U.cells) → OpenLatticeEdge + (z + 1) (z + 1 + ⟨0, 1⟩) ⊆ interior (TileRealization U) := by + classical + intro U z hz hw + let R : Set (Real × Real) := + Set.Ioo (z.re : Real) ((z.re : Real) + 2) ×ˢ + Set.Ioo (z.im : Real) ((z.im : Real) + 1) + have hRopen : IsOpen R := isOpen_Ioo.prod isOpen_Ioo + have hRU : R ⊆ TileRealization U := by + intro p hp + rcases hp with ⟨hp₁, hp₂⟩ + by_cases hx : p.1 ≤ (z.re : Real) + 1 + · apply Set.mem_iUnion.mpr + refine ⟨z, Set.mem_iUnion.mpr ⟨hz, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, + ] + constructor <;> constructor <;> linarith [hp₁.1, hp₁.2, hp₂.1, hp₂.2] + · apply Set.mem_iUnion.mpr + refine ⟨z + 1, Set.mem_iUnion.mpr ⟨hw, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, + Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one, + Int.cast_add, Int.cast_one, Int.cast_zero] + constructor <;> constructor <;> linarith [hp₁.1, hp₁.2, hp₂.1, hp₂.2] + intro p hp + apply interior_maximal hRU hRopen + obtain ⟨t, ht₀, ht₁, rfl⟩ := hp + simp [R, GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one] + constructor <;> constructor <;> nlinarith + +private theorem hinteriorH : + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → (z + ⟨0, 1⟩ ∈ U.cells) → + OpenLatticeEdge (z + 1 + ⟨0, 1⟩) (z + ⟨0, 1⟩) ⊆ interior (TileRealization U) := by + classical + intro U z hz hw + let R : Set (Real × Real) := + Set.Ioo (z.re : Real) ((z.re : Real) + 1) ×ˢ + Set.Ioo (z.im : Real) ((z.im : Real) + 2) + have hRopen : IsOpen R := isOpen_Ioo.prod isOpen_Ioo + have hRU : R ⊆ TileRealization U := by + intro p hp + rcases hp with ⟨hp₁, hp₂⟩ + by_cases hy : p.2 ≤ (z.im : Real) + 1 + · apply Set.mem_iUnion.mpr + refine ⟨z, Set.mem_iUnion.mpr ⟨hz, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, + ] + constructor <;> constructor <;> linarith [hp₁.1, hp₁.2, hp₂.1, hp₂.2] + · apply Set.mem_iUnion.mpr + refine ⟨z + ⟨0, 1⟩, Set.mem_iUnion.mpr ⟨hw, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, + Zsqrtd.re_add, Zsqrtd.im_add, + Int.cast_add, Int.cast_one, Int.cast_zero] + constructor <;> constructor <;> linarith [hp₁.1, hp₁.2, hp₂.1, hp₂.2] + intro p hp + apply interior_maximal hRU hRopen + obtain ⟨t, ht₀, ht₁, rfl⟩ := hp + simp [R, GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one] + constructor <;> constructor <;> nlinarith + +private theorem hsegVrev : + (∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells ∨ z + 1 ∈ U.cells) → ∀ t : Set.Icc (0 : + Real) 1, ((1 - (t : Real)) * ((z + 1).re : Real) + (t : Real) * ((z + 1 + ⟨0, 1⟩).re : + Real), (1 - (t : Real)) * ((z + 1).im : Real) + (t : Real) * ((z + 1 + ⟨0, 1⟩).im : + Real)) ∈ TileRealization U) → ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells ∨ z + + 1 ∈ U.cells) → ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * ((z + 1 + ⟨0, 1⟩).re : Real) + + (t : Real) * ((z + 1).re : Real), + (1 - (t : Real)) * ((z + 1 + ⟨0, 1⟩).im : Real) + + (t : Real) * ((z + 1).im : Real)) ∈ TileRealization U := by + classical + intro hsegV U z hocc t + let s : Set.Icc (0 : Real) 1 := + ⟨1 - (t : Real), ⟨by linarith [t.2.2], by linarith [t.2.1]⟩⟩ + have hs := hsegV U z hocc s + convert hs using 1; simp [s]; ring_nf; trivial + +private theorem hsegHrev : + (∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells ∨ z + ⟨0, 1⟩ ∈ U.cells) → ∀ t : Set.Icc + (0 : Real) 1, ((1 - (t : Real)) * ((z + 1 + ⟨0, 1⟩).re : Real) + (t : Real) * ((z + ⟨0, + 1⟩).re : Real), (1 - (t : Real)) * ((z + 1 + ⟨0, 1⟩).im : Real) + (t : Real) * ((z + ⟨0, + 1⟩).im : Real)) ∈ TileRealization U) → ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ + U.cells ∨ z + ⟨0, 1⟩ ∈ U.cells) → ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * ((z + ⟨0, 1⟩).re : Real) + + (t : Real) * ((z + 1 + ⟨0, 1⟩).re : Real), + (1 - (t : Real)) * ((z + ⟨0, 1⟩).im : Real) + + (t : Real) * ((z + 1 + ⟨0, 1⟩).im : Real)) ∈ TileRealization U := by + classical + intro hsegH U z hocc t + let s : Set.Icc (0 : Real) 1 := + ⟨1 - (t : Real), ⟨by linarith [t.2.2], by linarith [t.2.1]⟩⟩ + have hs := hsegH U z hocc s + convert hs using 1; simp [s]; ring_nf; trivial + +private theorem edgeSym : + ∀ (x : GaussianInt), ∀ (y : GaussianInt), OpenLatticeEdge x y = OpenLatticeEdge y x := by + classical + intro x y + ext p + constructor + · rintro ⟨t, ht₀, ht₁, hp⟩ + refine ⟨1 - t, by linarith, by linarith, ?_⟩ + rw [hp] + simp [GaussianRealPoint] + constructor <;> ring + · rintro ⟨t, ht₀, ht₁, hp⟩ + refine ⟨1 - t, by linarith, by linarith, ?_⟩ + rw [hp] + simp [GaussianRealPoint] + constructor <;> ring + +private theorem proveV : + (∀ (U : ProtoTile), ∀ (z : GaussianInt), ({z + 1, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + FootprintEdges U ↔ z ∈ U.cells ∨ z + 1 ∈ U.cells) → (∀ (U : ProtoTile), ∀ (z : + GaussianInt), ({z + 1, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges U ↔ + (z + 1 ∈ U.cells ∧ z ∉ U.cells) ∨ (z + 1 ∉ U.cells ∧ z ∈ U.cells)) → (∀ (U : ProtoTile), + ∀ (z : GaussianInt), (z ∈ U.cells ∨ z + 1 ∈ U.cells) → ∀ t : Set.Icc (0 : Real) 1, ((1 - + (t : Real)) * ((z + 1).re : Real) + (t : Real) * ((z + 1 + ⟨0, 1⟩).re : Real), (1 - (t : + Real)) * ((z + 1).im : Real) + (t : Real) * ((z + 1 + ⟨0, 1⟩).im : Real)) ∈ + TileRealization U) → (∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → (z + 1 ∈ + U.cells) → OpenLatticeEdge (z + 1) (z + 1 + ⟨0, 1⟩) ⊆ interior (TileRealization U)) → (∀ + (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells ∨ z + 1 ∈ U.cells) → ∀ t : Set.Icc (0 + : Real) 1, ((1 - (t : Real)) * ((z + 1 + ⟨0, 1⟩).re : Real) + (t : Real) * ((z + 1).re : + Real), (1 - (t : Real)) * ((z + 1 + ⟨0, 1⟩).im : Real) + (t : Real) * ((z + 1).im : + Real)) ∈ TileRealization U) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), OpenLatticeEdge + x y = OpenLatticeEdge y x) → ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (z : + GaussianInt), ∀ (w : GaussianInt), ((a = z + 1 ∧ b = z + 1 + ⟨0, 1⟩) ∨ + (b = z + 1 ∧ a = z + 1 + ⟨0, 1⟩)) → (w = z + 1) → ∀ (U : ProtoTile), ({a, b} ∈ + FootprintEdges U ↔ z ∈ U.cells ∨ w ∈ U.cells) ∧ + ({a, b} ∈ BoundaryFootprintEdges U ↔ + (z ∈ U.cells ∧ w ∉ U.cells) ∨ (z ∉ U.cells ∧ w ∈ U.cells)) ∧ + ((z ∈ U.cells ∨ w ∈ U.cells) → + a ∈ FootprintVertices U ∧ b ∈ FootprintVertices U ∧ + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * (a.re : Real) + (t : Real) * (b.re : Real), + (1 - (t : Real)) * (a.im : Real) + (t : Real) * (b.im : Real)) ∈ + TileRealization U) ∧ + ((z ∈ U.cells ∧ w ∈ U.cells) → + OpenLatticeEdge a b ⊆ interior (TileRealization U)) ∧ + ((∀ j : Fin 4, LatticeVertexIncidentCell a j ∈ U.cells) → + z ∈ U.cells ∧ w ∈ U.cells) := by + classical + intro hfootV hboundaryV hsegV hinteriorV hsegVrev edgeSym a b z w hcase hw U + rcases hcase with ⟨ha, hb⟩ | ⟨hb, ha⟩ + · subst_vars + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · simpa using hfootV U z + · constructor + · intro he + rcases (hboundaryV U z).mp he with ⟨hw, hnz⟩ | ⟨hnw, hz⟩ + · exact Or.inr ⟨hnz, hw⟩ + · exact Or.inl ⟨hz, hnw⟩ + · intro hx + rcases hx with ⟨hz, hnw⟩ | ⟨hnz, hw⟩ + · exact (hboundaryV U z).mpr (Or.inr ⟨hnw, hz⟩) + · exact (hboundaryV U z).mpr (Or.inl ⟨hw, hnz⟩) + · intro hocc + have hne : U.cells.Nonempty := by + rcases hocc with hz | hw + · exact ⟨z, hz⟩ + · exact ⟨z + 1, hw⟩ + constructor + · simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + rcases hocc with hz | hw + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · exact ⟨z + 1, hw, Or.inl rfl⟩ + constructor + · simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + rcases hocc with hz | hw + · exact ⟨z, hz, Or.inr (Or.inr (Or.inr rfl))⟩ + · exact ⟨z + 1, hw, Or.inr (Or.inr (Or.inl rfl))⟩ + · intro t + exact hsegV U z hocc t + · intro hb + exact hinteriorV U z hb.1 hb.2 + · intro hall + constructor + · simpa [LatticeVertexIncidentCell] using hall 1 + · simpa [LatticeVertexIncidentCell] using hall 0 + · subst_vars + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · simpa [Finset.pair_comm] using hfootV U z + · constructor + · intro he + have he' : ({z + 1, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges U := by simpa [Finset.pair_comm] using he + rcases (hboundaryV U z).mp he' with ⟨hw, hnz⟩ | ⟨hnw, hz⟩ + · exact Or.inr ⟨hnz, hw⟩ + · exact Or.inl ⟨hz, hnw⟩ + · intro hx + rcases hx with ⟨hz, hnw⟩ | ⟨hnz, hw⟩ + · simpa [Finset.pair_comm] using (hboundaryV U z).mpr (Or.inr ⟨hnw, hz⟩) + · simpa [Finset.pair_comm] using (hboundaryV U z).mpr (Or.inl ⟨hw, hnz⟩) + · intro hocc + have hne : U.cells.Nonempty := by + rcases hocc with hz | hw + · exact ⟨z, hz⟩ + · exact ⟨z + 1, hw⟩ + constructor + · simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + rcases hocc with hz | hw + · exact ⟨z, hz, Or.inr (Or.inr (Or.inr rfl))⟩ + · exact ⟨z + 1, hw, Or.inr (Or.inr (Or.inl rfl))⟩ + constructor + · simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + rcases hocc with hz | hw + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · exact ⟨z + 1, hw, Or.inl rfl⟩ + · intro t + exact hsegVrev U z hocc t + · intro hb + rw [edgeSym] + exact hinteriorV U z hb.1 hb.2 + · intro hall + constructor + · simpa [LatticeVertexIncidentCell, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hall 2 + · simpa [LatticeVertexIncidentCell, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hall 3 + +private theorem proveH : + (∀ (U : ProtoTile), ∀ (z : GaussianInt), ({z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) + ∈ FootprintEdges U ↔ z ∈ U.cells ∨ z + ⟨0, 1⟩ ∈ U.cells) → (∀ (U : ProtoTile), ∀ (z : + GaussianInt), ({z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges U ↔ (z + ⟨0, 1⟩ ∈ U.cells ∧ z ∉ U.cells) ∨ (z + ⟨0, 1⟩ ∉ U.cells ∧ + z ∈ U.cells)) → (∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells ∨ z + ⟨0, 1⟩ ∈ + U.cells) → ∀ t : Set.Icc (0 : Real) 1, ((1 - (t : Real)) * ((z + 1 + ⟨0, 1⟩).re : Real) + + (t : Real) * ((z + ⟨0, 1⟩).re : Real), (1 - (t : Real)) * ((z + 1 + ⟨0, 1⟩).im : Real) + + (t : Real) * ((z + ⟨0, 1⟩).im : Real)) ∈ TileRealization U) → (∀ (U : ProtoTile), ∀ (z : + GaussianInt), (z ∈ U.cells) → (z + ⟨0, 1⟩ ∈ U.cells) → OpenLatticeEdge (z + 1 + ⟨0, 1⟩) + (z + ⟨0, 1⟩) ⊆ interior (TileRealization U)) → (∀ (U : ProtoTile), ∀ (z : GaussianInt), + (z ∈ U.cells ∨ z + ⟨0, 1⟩ ∈ U.cells) → ∀ t : Set.Icc (0 : Real) 1, ((1 - (t : Real)) * + ((z + ⟨0, 1⟩).re : Real) + (t : Real) * ((z + 1 + ⟨0, 1⟩).re : Real), (1 - (t : Real)) * + ((z + ⟨0, 1⟩).im : Real) + (t : Real) * ((z + 1 + ⟨0, 1⟩).im : Real)) ∈ TileRealization + U) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), OpenLatticeEdge x y = OpenLatticeEdge y + x) → ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (z : GaussianInt), ∀ (w : GaussianInt), + ((a = z + 1 + ⟨0, 1⟩ ∧ b = z + ⟨0, 1⟩) ∨ + (b = z + 1 + ⟨0, 1⟩ ∧ a = z + ⟨0, 1⟩)) → (w = z + ⟨0, 1⟩) → ∀ (U : ProtoTile), ({a, b} ∈ + FootprintEdges U ↔ z ∈ U.cells ∨ w ∈ U.cells) ∧ + ({a, b} ∈ BoundaryFootprintEdges U ↔ + (z ∈ U.cells ∧ w ∉ U.cells) ∨ (z ∉ U.cells ∧ w ∈ U.cells)) ∧ + ((z ∈ U.cells ∨ w ∈ U.cells) → + a ∈ FootprintVertices U ∧ b ∈ FootprintVertices U ∧ + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * (a.re : Real) + (t : Real) * (b.re : Real), + (1 - (t : Real)) * (a.im : Real) + (t : Real) * (b.im : Real)) ∈ + TileRealization U) ∧ + ((z ∈ U.cells ∧ w ∈ U.cells) → + OpenLatticeEdge a b ⊆ interior (TileRealization U)) ∧ + ((∀ j : Fin 4, LatticeVertexIncidentCell a j ∈ U.cells) → + z ∈ U.cells ∧ w ∈ U.cells) := by + classical + intro hfootH hboundaryH hsegH hinteriorH hsegHrev edgeSym a b z w hcase hw U + rcases hcase with ⟨ha, hb⟩ | ⟨hb, ha⟩ + · subst_vars + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · simpa [Finset.pair_comm] using hfootH U z + · constructor + · intro he + have he' : ({z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges U := by simpa [Finset.pair_comm] using he + rcases (hboundaryH U z).mp he' with ⟨hw, hnz⟩ | ⟨hnw, hz⟩ + · exact Or.inr ⟨hnz, hw⟩ + · exact Or.inl ⟨hz, hnw⟩ + · intro hx + rcases hx with ⟨hz, hnw⟩ | ⟨hnz, hw⟩ + · simpa [Finset.pair_comm] using (hboundaryH U z).mpr (Or.inr ⟨hnw, hz⟩) + · simpa [Finset.pair_comm] using (hboundaryH U z).mpr (Or.inl ⟨hw, hnz⟩) + · intro hocc + have hne : U.cells.Nonempty := by + rcases hocc with hz | hw + · exact ⟨z, hz⟩ + · exact ⟨z + ⟨0, 1⟩, hw⟩ + constructor + · simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + rcases hocc with hz | hw + · exact ⟨z, hz, Or.inr (Or.inr (Or.inr rfl))⟩ + · exact ⟨z + ⟨0, 1⟩, hw, Or.inr (Or.inl (by abel))⟩ + constructor + · simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + rcases hocc with hz | hw + · exact ⟨z, hz, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨z + ⟨0, 1⟩, hw, Or.inl rfl⟩ + · intro t + exact hsegH U z hocc t + · intro hb + exact hinteriorH U z hb.1 hb.2 + · intro hall + constructor + · simpa [LatticeVertexIncidentCell, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hall 2 + · simpa [LatticeVertexIncidentCell, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hall 1 + · subst_vars + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · simpa [Finset.pair_comm] using hfootH U z + · constructor + · intro he + have he' : ({z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges U := by simpa [Finset.pair_comm] using he + rcases (hboundaryH U z).mp he' with ⟨hw, hnz⟩ | ⟨hnw, hz⟩ + · exact Or.inr ⟨hnz, hw⟩ + · exact Or.inl ⟨hz, hnw⟩ + · intro hx + rcases hx with ⟨hz, hnw⟩ | ⟨hnz, hw⟩ + · simpa [Finset.pair_comm] using (hboundaryH U z).mpr (Or.inr ⟨hnw, hz⟩) + · simpa [Finset.pair_comm] using (hboundaryH U z).mpr (Or.inl ⟨hw, hnz⟩) + · intro hocc + have hne : U.cells.Nonempty := by + rcases hocc with hz | hw + · exact ⟨z, hz⟩ + · exact ⟨z + ⟨0, 1⟩, hw⟩ + constructor + · simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + rcases hocc with hz | hw + · exact ⟨z, hz, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨z + ⟨0, 1⟩, hw, Or.inl rfl⟩ + constructor + · simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + rcases hocc with hz | hw + · exact ⟨z, hz, Or.inr (Or.inr (Or.inr rfl))⟩ + · exact ⟨z + ⟨0, 1⟩, hw, Or.inr (Or.inl (by abel))⟩ + · intro t + exact hsegHrev U z hocc t + · intro hb + rw [edgeSym] + exact hinteriorH U z hb.1 hb.2 + · intro hall + constructor + · simpa [LatticeVertexIncidentCell, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hall 3 + · simpa [LatticeVertexIncidentCell, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hall 0 + +end UnitEdgeCellLemmas + +theorem P4397T1UnitEdgeCells : + (∀ u v : GaussianInt, FourNeighborAdjacent u v → ∃ z w : GaussianInt, + (((u = z + 1 ∧ v = z + 1 + ⟨0, 1⟩) ∨ + (v = z + 1 ∧ u = z + 1 + ⟨0, 1⟩)) ∧ w = z + 1 ∨ + ((u = z + 1 + ⟨0, 1⟩ ∧ v = z + ⟨0, 1⟩) ∨ + (v = z + 1 + ⟨0, 1⟩ ∧ u = z + ⟨0, 1⟩)) ∧ + w = z + ⟨0, 1⟩)) ∧ + (∀ u v z w : GaussianInt, + (((u = z + 1 ∧ v = z + 1 + ⟨0, 1⟩) ∨ + (v = z + 1 ∧ u = z + 1 + ⟨0, 1⟩)) ∧ w = z + 1 ∨ + ((u = z + 1 + ⟨0, 1⟩ ∧ v = z + ⟨0, 1⟩) ∨ + (v = z + 1 + ⟨0, 1⟩ ∧ u = z + ⟨0, 1⟩)) ∧ + w = z + ⟨0, 1⟩) → + ∀ U : ProtoTile, + ({u, v} ∈ FootprintEdges U ↔ z ∈ U.cells ∨ w ∈ U.cells) ∧ + ({u, v} ∈ BoundaryFootprintEdges U ↔ + (z ∈ U.cells ∧ w ∉ U.cells) ∨ + (z ∉ U.cells ∧ w ∈ U.cells)) ∧ + ((z ∈ U.cells ∨ w ∈ U.cells) → + u ∈ FootprintVertices U ∧ v ∈ FootprintVertices U ∧ + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * (u.re : Real) + (t : Real) * (v.re : Real), + (1 - (t : Real)) * (u.im : Real) + (t : Real) * (v.im : Real)) ∈ + TileRealization U) ∧ + ((z ∈ U.cells ∧ w ∈ U.cells) → + OpenLatticeEdge u v ⊆ interior (TileRealization U)) ∧ + ((∀ j : Fin 4, LatticeVertexIncidentCell u j ∈ U.cells) → + z ∈ U.cells ∧ w ∈ U.cells)) := by +-- BODY + have pairMatch {α : Type} [DecidableEq α] (a b c d : α) + (h : ({a, b} : Finset α) = {c, d}) (hab : a ≠ b) : + (a = c ∧ b = d) ∨ (a = d ∧ b = c) := by + have hacd : a = c ∨ a = d := by + have hm : a ∈ ({c, d} : Finset α) := by rw [← h]; simp + simpa using hm + have hbcd : b = c ∨ b = d := by + have hm : b ∈ ({c, d} : Finset α) := by rw [← h]; simp + simpa using hm + rcases hacd with hac | had + · rcases hbcd with hbc | hbd + · exact False.elim (hab (hac.trans hbc.symm)) + · exact Or.inl ⟨hac, hbd⟩ + · rcases hbcd with hbc | hbd + · exact Or.inr ⟨had, hbc⟩ + · exact False.elim (hab (had.trans hbd.symm)) + constructor + · intro u v huv + change v = u + 1 ∨ v = u - 1 ∨ v = u + ⟨0, 1⟩ ∨ v = u - ⟨0, 1⟩ at huv + rcases huv with h | h | h | h + · refine ⟨u - ⟨0, 1⟩, u, ?_⟩ + right + constructor + · right + constructor + · rw [h] + abel + · abel + · abel + · refine ⟨v - ⟨0, 1⟩, v, ?_⟩ + right + constructor + · left + constructor + · rw [h] + abel + · abel + · abel + · refine ⟨u - 1, u, ?_⟩ + left + constructor + · left + constructor + · abel + · rw [h] + abel + · abel + · refine ⟨v - 1, v, ?_⟩ + left + constructor + · right + constructor + · abel + · rw [h] + abel + · abel + /- + · intro a b z w hform U + rcases hform with ⟨hvert, hw⟩ | ⟨hhoriz, hw⟩ + · rcases hvert with ⟨⟨hu, hv⟩ | ⟨hv, hu⟩⟩ + · subst_vars + constructor + · change ({z + 1, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges U ↔ _ + simp only [FootprintEdges, Set.mem_ofPred_eq] + constructor + · rintro ⟨x, hx, he⟩ + simp only [Finset.insert_eq, Finset.mem_insert, Finset.mem_singleton] at he + rcases he with he | he | he | he + · have : x = z + 1 ∨ x = z + 1 + ⟨0, 1⟩ := by simpa using he + rcases this with rfl | rfl <;> simp [add_assoc, add_comm, add_left_comm] at hx ⊢ + · have : x = z ∨ x = z + 1 + ⟨0, 1⟩ := by simpa using he + rcases this with rfl | rfl <;> simp [add_assoc, add_comm, add_left_comm] at hx ⊢ + · have : x = z + 1 ∨ x = z + 1 + ⟨0, 1⟩ := by simpa using he + rcases this with rfl | rfl <;> simp [add_assoc, add_comm, add_left_comm] at hx ⊢ + · have : x = z ∨ x = z + 1 + ⟨0, 1⟩ := by simpa using he + rcases this with rfl | rfl <;> simp [add_assoc, add_comm, add_left_comm] at hx ⊢ + · rintro (hz | hw) + · refine ⟨z, hz, ?_⟩ <;> simp [add_assoc] + · refine ⟨z + 1, hw, ?_⟩ <;> simp [add_assoc] + constructor + · change ({z + 1, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges U ↔ _ + simp only [BoundaryFootprintEdges, Set.mem_ofPred_eq] + constructor + · rintro ⟨a, ⟨he, hx⟩ | ⟨he, hx⟩⟩ + · simp only [Finset.insert_eq, Finset.mem_insert, Finset.mem_singleton] at he + have ha : a = z + 1 := by simpa using he + subst a + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hx + · simp only [Finset.insert_eq, Finset.mem_insert, Finset.mem_singleton] at he + have : a = z + 1 := by simpa using he + subst a + simp at he + · rintro (⟨hz, hw⟩ | ⟨hz, hw⟩) + · refine ⟨z + 1, Or.inr ⟨by simp, ?_⟩⟩ + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using (show (z + 1 ∈ + U.cells ∧ z + 1 - ⟨0, 1⟩ ∉ U.cells) ∨ _ from Or.inl ⟨hw, by simpa using hz⟩) + · refine ⟨z + 1, Or.inr ⟨by simp, ?_⟩⟩ + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using (show (z + 1 ∈ + U.cells ∧ z + 1 - ⟨0, 1⟩ ∉ U.cells) ∨ _ from Or.inr ⟨by simpa using hw, hz⟩) + constructor + · intro hocc + constructor + · change z + 1 ∈ FootprintVertices U + unfold FootprintVertices + by_cases hne : U.cells.Nonempty + · simp only [ite_eq_left hne] + rcases hocc with hz | hw + · exact ⟨z, hz, Or.inr (Or.inr (Or.inr rfl))⟩ + · exact ⟨z + 1, hw, Or.inl rfl⟩ + · simp [hne] at hocc + · constructor + · change z + 1 + ⟨0, 1⟩ ∈ FootprintVertices U + unfold FootprintVertices + by_cases hne : U.cells.Nonempty + · simp only [ite_eq_left hne] + rcases hocc with hz | hw + · exact ⟨z, hz, Or.inr (Or.inr rfl)⟩ + · exact ⟨z + 1, hw, Or.inr (Or.inr (Or.inr rfl))⟩ + · simp [hne] at hocc + · intro t + intro ht + rcases hocc with hz | hw + · change (1 - (t : Real)) • GaussianRealPoint (z + 1) + (t : Real) • + GaussianRealPoint (z + 1 + ⟨0, 1⟩) ∈ _ at ht + change _ ∈ ⋃ x ∈ U.cells, ClosedSquareRealization x + apply Set.mem_iUnion.mpr + refine ⟨z, Set.mem_iUnion.mpr ⟨hz, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, GaussianRealPoint] + at * + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one, + Int.cast_add, Int.cast_one, Zsqrtd.re_zero, Zsqrtd.im_zero, + Int.cast_zero] at * + rcases t with ⟨t, ht0, ht1⟩ + norm_num at ht0 ht1 + constructor <;> constructor <;> norm_num <;> nlinarith + · change (1 - (t : Real)) • GaussianRealPoint (z + 1) + (t : Real) • + GaussianRealPoint (z + 1 + ⟨0, 1⟩) ∈ _ at ht + change _ ∈ ⋃ x ∈ U.cells, ClosedSquareRealization x + apply Set.mem_iUnion.mpr + refine ⟨z + 1, Set.mem_iUnion.mpr ⟨hw, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, GaussianRealPoint] + at * + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one, + Int.cast_add, Int.cast_one, Zsqrtd.re_zero, Zsqrtd.im_zero, + Int.cast_zero] at * + rcases t with ⟨t, ht0, ht1⟩ + norm_num at ht0 ht1 + constructor <;> constructor <;> norm_num <;> nlinarith + constructor + · intro hboth + placeholder + · intro hall + placeholder + · placeholder + · placeholder + -/ + · intro a b z w hform U + have oneNeImag : (1 : GaussianInt) ≠ ⟨0, 1⟩ := by + intro h + have hr := congrArg Zsqrtd.re h + norm_num at hr + have hfootV (U : ProtoTile) (z : GaussianInt) : + ({z + 1, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges U ↔ + z ∈ U.cells ∨ z + 1 ∈ U.cells := UnitEdgeCellLemmas.hfootV pairMatch U z + have hboundaryV (U : ProtoTile) (z : GaussianInt) : + ({z + 1, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges U ↔ + (z + 1 ∈ U.cells ∧ z ∉ U.cells) ∨ + (z + 1 ∉ U.cells ∧ z ∈ U.cells) := UnitEdgeCellLemmas.hboundaryV pairMatch U z + have hfootH (U : ProtoTile) (z : GaussianInt) : + ({z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges U ↔ + z ∈ U.cells ∨ z + ⟨0, 1⟩ ∈ U.cells := UnitEdgeCellLemmas.hfootH pairMatch U z + have hboundaryH (U : ProtoTile) (z : GaussianInt) : + ({z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges U ↔ + (z + ⟨0, 1⟩ ∈ U.cells ∧ z ∉ U.cells) ∨ + (z + ⟨0, 1⟩ ∉ U.cells ∧ z ∈ U.cells) := UnitEdgeCellLemmas.hboundaryH pairMatch U z + have hsegV (U : ProtoTile) (z : GaussianInt) + (hocc : z ∈ U.cells ∨ z + 1 ∈ U.cells) : + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * ((z + 1).re : Real) + + (t : Real) * ((z + 1 + ⟨0, 1⟩).re : Real), + (1 - (t : Real)) * ((z + 1).im : Real) + + (t : Real) * ((z + 1 + ⟨0, 1⟩).im : Real)) ∈ TileRealization U := + UnitEdgeCellLemmas.hsegV U z hocc + have hsegH (U : ProtoTile) (z : GaussianInt) + (hocc : z ∈ U.cells ∨ z + ⟨0, 1⟩ ∈ U.cells) : + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * ((z + 1 + ⟨0, 1⟩).re : Real) + + (t : Real) * ((z + ⟨0, 1⟩).re : Real), + (1 - (t : Real)) * ((z + 1 + ⟨0, 1⟩).im : Real) + + (t : Real) * ((z + ⟨0, 1⟩).im : Real)) ∈ TileRealization U := + UnitEdgeCellLemmas.hsegH U z hocc + have hinteriorV (U : ProtoTile) (z : GaussianInt) + (hz : z ∈ U.cells) (hw : z + 1 ∈ U.cells) : + OpenLatticeEdge (z + 1) (z + 1 + ⟨0, 1⟩) ⊆ interior (TileRealization U) := + UnitEdgeCellLemmas.hinteriorV U z hz hw + have hinteriorH (U : ProtoTile) (z : GaussianInt) + (hz : z ∈ U.cells) (hw : z + ⟨0, 1⟩ ∈ U.cells) : + OpenLatticeEdge (z + 1 + ⟨0, 1⟩) (z + ⟨0, 1⟩) ⊆ interior (TileRealization U) := + UnitEdgeCellLemmas.hinteriorH U z hz hw + have hsegVrev (U : ProtoTile) (z : GaussianInt) + (hocc : z ∈ U.cells ∨ z + 1 ∈ U.cells) : + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * ((z + 1 + ⟨0, 1⟩).re : Real) + + (t : Real) * ((z + 1).re : Real), + (1 - (t : Real)) * ((z + 1 + ⟨0, 1⟩).im : Real) + + (t : Real) * ((z + 1).im : Real)) ∈ TileRealization U := UnitEdgeCellLemmas.hsegVrev + hsegV U z hocc + have hsegHrev (U : ProtoTile) (z : GaussianInt) + (hocc : z ∈ U.cells ∨ z + ⟨0, 1⟩ ∈ U.cells) : + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * ((z + ⟨0, 1⟩).re : Real) + + (t : Real) * ((z + 1 + ⟨0, 1⟩).re : Real), + (1 - (t : Real)) * ((z + ⟨0, 1⟩).im : Real) + + (t : Real) * ((z + 1 + ⟨0, 1⟩).im : Real)) ∈ TileRealization U := + UnitEdgeCellLemmas.hsegHrev hsegH U z hocc + have edgeSym (x y : GaussianInt) : OpenLatticeEdge x y = OpenLatticeEdge y x := + UnitEdgeCellLemmas.edgeSym x y + have proveV (a b z w : GaussianInt) + (hcase : (a = z + 1 ∧ b = z + 1 + ⟨0, 1⟩) ∨ + (b = z + 1 ∧ a = z + 1 + ⟨0, 1⟩)) + (hw : w = z + 1) (U : ProtoTile) : + ({a, b} ∈ FootprintEdges U ↔ z ∈ U.cells ∨ w ∈ U.cells) ∧ + ({a, b} ∈ BoundaryFootprintEdges U ↔ + (z ∈ U.cells ∧ w ∉ U.cells) ∨ (z ∉ U.cells ∧ w ∈ U.cells)) ∧ + ((z ∈ U.cells ∨ w ∈ U.cells) → + a ∈ FootprintVertices U ∧ b ∈ FootprintVertices U ∧ + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * (a.re : Real) + (t : Real) * (b.re : Real), + (1 - (t : Real)) * (a.im : Real) + (t : Real) * (b.im : Real)) ∈ + TileRealization U) ∧ + ((z ∈ U.cells ∧ w ∈ U.cells) → + OpenLatticeEdge a b ⊆ interior (TileRealization U)) ∧ + ((∀ j : Fin 4, LatticeVertexIncidentCell a j ∈ U.cells) → + z ∈ U.cells ∧ w ∈ U.cells) := UnitEdgeCellLemmas.proveV hfootV hboundaryV hsegV + hinteriorV hsegVrev edgeSym a b z w hcase hw U + have proveH (a b z w : GaussianInt) + (hcase : (a = z + 1 + ⟨0, 1⟩ ∧ b = z + ⟨0, 1⟩) ∨ + (b = z + 1 + ⟨0, 1⟩ ∧ a = z + ⟨0, 1⟩)) + (hw : w = z + ⟨0, 1⟩) (U : ProtoTile) : + ({a, b} ∈ FootprintEdges U ↔ z ∈ U.cells ∨ w ∈ U.cells) ∧ + ({a, b} ∈ BoundaryFootprintEdges U ↔ + (z ∈ U.cells ∧ w ∉ U.cells) ∨ (z ∉ U.cells ∧ w ∈ U.cells)) ∧ + ((z ∈ U.cells ∨ w ∈ U.cells) → + a ∈ FootprintVertices U ∧ b ∈ FootprintVertices U ∧ + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * (a.re : Real) + (t : Real) * (b.re : Real), + (1 - (t : Real)) * (a.im : Real) + (t : Real) * (b.im : Real)) ∈ + TileRealization U) ∧ + ((z ∈ U.cells ∧ w ∈ U.cells) → + OpenLatticeEdge a b ⊆ interior (TileRealization U)) ∧ + ((∀ j : Fin 4, LatticeVertexIncidentCell a j ∈ U.cells) → + z ∈ U.cells ∧ w ∈ U.cells) := UnitEdgeCellLemmas.proveH hfootH hboundaryH hsegH + hinteriorH hsegHrev edgeSym a b z w hcase hw U + rcases hform with ⟨hcase, hw⟩ | ⟨hcase, hw⟩ + · exact proveV a b z w hcase hw U + · exact proveH a b z w hcase hw U + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3EndpointOwnerIndices.lean b/LeanPool/ApollonianSuperharmonic/P4418T3EndpointOwnerIndices.lean new file mode 100644 index 0000000000..79a60fbd0b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4418T3EndpointOwnerIndices.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow + +-- [TABLET NODE: P4418T3EndpointOwnerIndices] + +/-! +# P4418T3EndpointOwnerIndices + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a selected contact row in an ordered-general layout, the ordered pair +of third-owner indices is the following table. The order is a naming +convention only, not an orientation of a previously supplied path. +$$ +\begin{array}{c|cc} +\text{row}&g_0&g_1\\\hline +L_1^+&C_{0,0}&D_{-1,-1}\\ +L_2^+&E_{0,0}&F_{0,-1}\\ +L_3^+&E_{0,0}&F_{1,0}\\ +L_1^-&C_{1,1}&D_{0,0}\\ +L_2^-&E_{0,1}&F_{0,0}\\ +L_3^-&E_{-1,0}&F_{0,0}\\ +S_1^+&B_{0,0}&E_{-1,0}\\ +S_2^+&B_{0,0}&C_{1,0}\\ +S_3^+&A_{0,-1}&D_{0,0}\\ +S_4^+&B_{1,1}&E_{0,1}\\ +S_5^+&B_{0,1}&C_{1,1}\\ +S_6^+&A_{-1,-1}&D_{-1,0}\\ +S_1^-&A_{0,0}&F_{1,0}\\ +S_2^-&A_{0,0}&D_{-1,0}\\ +S_3^-&B_{0,1}&C_{0,0}\\ +S_4^-&A_{-1,-1}&F_{0,-1}\\ +S_5^-&A_{0,-1}&D_{-1,-1}\\ +S_6^-&B_{1,1}&C_{1,0}\\ +\end{array} +$$ +Here $X_{m,n}$ is the original periodic occurrence with label $X$ and +translation $mu+nv$, not its precursor-deleted replacement. +-/ +def P4418T3EndpointOwnerIndices + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b) : PeriodicSubtileIndex × + PeriodicSubtileIndex := +-- BODY + match row with + | .positiveL1 _ _ => (⟨.C, 0, 0⟩, ⟨.D, -1, -1⟩) + | .positiveL2 _ _ => (⟨.E, 0, 0⟩, ⟨.F, 0, -1⟩) + | .positiveL3 _ _ => (⟨.E, 0, 0⟩, ⟨.F, 1, 0⟩) + | .reflectedL1 _ _ => (⟨.C, 1, 1⟩, ⟨.D, 0, 0⟩) + | .reflectedL2 _ _ => (⟨.E, 0, 1⟩, ⟨.F, 0, 0⟩) + | .reflectedL3 _ _ => (⟨.E, -1, 0⟩, ⟨.F, 0, 0⟩) + | .positiveS1 _ => (⟨.B, 0, 0⟩, ⟨.E, -1, 0⟩) + | .positiveS2 _ => (⟨.B, 0, 0⟩, ⟨.C, 1, 0⟩) + | .positiveS3 _ => (⟨.A, 0, -1⟩, ⟨.D, 0, 0⟩) + | .positiveS4 _ => (⟨.B, 1, 1⟩, ⟨.E, 0, 1⟩) + | .positiveS5 _ => (⟨.B, 0, 1⟩, ⟨.C, 1, 1⟩) + | .positiveS6 _ => (⟨.A, -1, -1⟩, ⟨.D, -1, 0⟩) + | .reflectedS1 _ => (⟨.A, 0, 0⟩, ⟨.F, 1, 0⟩) + | .reflectedS2 _ => (⟨.A, 0, 0⟩, ⟨.D, -1, 0⟩) + | .reflectedS3 _ => (⟨.B, 0, 1⟩, ⟨.C, 0, 0⟩) + | .reflectedS4 _ => (⟨.A, -1, -1⟩, ⟨.F, 0, -1⟩) + | .reflectedS5 _ => (⟨.A, 0, -1⟩, ⟨.D, -1, -1⟩) + | .reflectedS6 _ => (⟨.B, 1, 1⟩, ⟨.C, 1, 0⟩) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean b/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean new file mode 100644 index 0000000000..0bce04e66b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean @@ -0,0 +1,818 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4418T3EndpointOwnerIndices +public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceData +public import LeanPool.ApollonianSuperharmonic.P3996T1SRowAlignment +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleLatticeTouching +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEndpointPairUnique +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations + +-- [TABLET NODE: P4418T3NestedCompanionEndpoint] + +/-! +# P4418T3NestedCompanionEndpoint + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +private def nestedOldCoordinates + {q : Fin 4 → CircleCoordinates} {cfg : BandOrderedGeneralConfiguration q} + {C : BandCircle} {T : ProtoTile} + {cert : BandOrderedGeneralLayoutCertificate q cfg C T} + {a b : PeriodicSubtileIndex} + (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b) : Int × Int := + match row with + | .positiveS1 _ => (-1, 0) + | .positiveS2 _ => (1, 0) + | .positiveS3 _ => (0, -1) + | .positiveS4 _ => (0, 1) + | .positiveS5 _ => (1, 1) + | .positiveS6 _ => (-1, -1) + | .reflectedS1 _ => (1, 0) + | .reflectedS2 _ => (-1, 0) + | .reflectedS3 _ => (0, 1) + | .reflectedS4 _ => (0, -1) + | .reflectedS5 _ => (-1, -1) + | .reflectedS6 _ => (1, 1) + | _ => (0, 0) + +namespace NestedCompanionGeometry + +private theorem hpath : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (z : + P3996T1SRowParameters), ∀ (E : ExactTileInterfaceTriple + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.childIndex) (TileTranslation + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.childIndex) z.rightShift) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.parentIndex)), + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occ z.childIndex + let W := occ z.parentIndex + (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex + = b ∧ z.parentIndex = a) → (SimpleGridPathBetween (FootprintVertices V ∩ + FootprintVertices W) (FootprintEdges V ∩ FootprintEdges W) E.point E.otherCA) ) := by + classical + intro q cfg C T cert a b z E occ V W hindices + cases hchild : z.childIsExterior + · have hi := hindices + simp? [hchild] at hi + rcases hi with ⟨hc, hp⟩ + simpa [V, W, occ, SubtileOccurrenceInterpretation, hc, hp, + Set.inter_comm] using E.pathCA + · have hi := hindices + simp? [hchild] at hi + rcases hi with ⟨hc, hp⟩ + simpa [V, W, occ, SubtileOccurrenceInterpretation, hc, hp, + Set.inter_comm] using E.pathCA + +private theorem hdataEndpoints : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : + P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (z : + P3996T1SRowParameters), ∀ (E : ExactTileInterfaceTriple + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.childIndex) (TileTranslation + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.childIndex) z.rightShift) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.parentIndex)), + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occ z.childIndex + let W := occ z.parentIndex + (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex + = b ∧ z.parentIndex = a) → ((SimpleGridPathBetween (FootprintVertices V ∩ + FootprintVertices W) (FootprintEdges V ∩ FootprintEdges W) E.point E.otherCA) → + (({data.first, data.last} : Finset GaussianInt) = ({E.point, E.otherCA} : Finset + GaussianInt))) ) := by + classical + intro q cfg C T cert a b row data z E occ V W hindices hpath + have hpath' : SimpleGridPathBetween + (FootprintVertices (occ a) ∩ FootprintVertices (occ b)) + (FootprintEdges (occ a) ∩ FootprintEdges (occ b)) E.point E.otherCA := by + cases hchild : z.childIsExterior + · have hi := hindices + simp? [hchild] at hi + rcases hi with ⟨hc, hp⟩ + simpa [V, W, occ, hc, hp, Set.inter_comm] using hpath + · have hi := hindices + simp? [hchild] at hi + rcases hi with ⟨hc, hp⟩ + simpa [V, W, occ, hc, hp, Set.inter_comm] using hpath + have hp := SimpleGridPathEndpointPairUnique data.path hpath' + simpa [Finset.pair_comm] using hp + +private theorem hpointPair : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : + P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (z : + P3996T1SRowParameters), ∀ (E : ExactTileInterfaceTriple + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.childIndex) (TileTranslation + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.childIndex) z.rightShift) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.parentIndex)), (({data.first, + data.last} : Finset GaussianInt) = ({E.point, E.otherCA} : Finset GaussianInt)) → + (E.point = data.first ∨ E.point = data.last) ) := by + classical + intro q cfg C T cert a b row data z E hdataEndpoints + have hm : E.point ∈ ({data.first, data.last} : Finset GaussianInt) := by + rw [hdataEndpoints] + simp + simpa using hm + +private theorem hprecursorInMinus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), cert.O.cells ⊆ (cert.P 0 false).cells ) := by + classical + intro q cfg C T cert x hx + rw [cert.precursor_cells] at hx + exact (cert.minus_union x).2 ⟨0, true, hx⟩ + +private theorem originalInBlock : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + (cert.O.cells ⊆ (cert.P 0 false).cells) → (∀ (i : PeriodicSubtileIndex), ∀ (x : + LatticeCell), (x ∈ (occ i).cells) → (x ∈ (TileTranslation T ((i.first : GaussianInt) + * cert.u + (i.second : GaussianInt) * cert.v)).cells)) ) := by + classical + intro q cfg C T cert occ hprecursorInMinus i x hx + cases i with + | mk label m n => + cases label with + | A => + change x ∈ (TileTranslation (cert.P 0 true) + ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells at hx + rw [(TileTranslationFormulas _ _).1] at hx ⊢ + rcases Finset.mem_image.mp hx with ⟨y, hy, rfl⟩ + have hy' : y ∈ (cert.P 0 true).cells := by simpa using hy + by_cases ho : y ∈ cert.O.cells + · have hb : y ∈ (cert.P 0 false).cells := hprecursorInMinus ho + have hbase : y ∈ T.cells := (cert.outer_union y).2 <| by + exact ⟨0, false, hb⟩ + exact Finset.mem_image.mpr ⟨y, hbase, by rfl⟩ + · have hbase : y ∈ T.cells := (cert.outer_union y).2 <| by + exact ⟨0, true, hy' + ⟩ + exact Finset.mem_image.mpr ⟨y, hbase, by rfl⟩ + | B => + change x ∈ (TileTranslation (cert.P 0 false) + ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells at hx + rw [(TileTranslationFormulas _ _).1] at hx ⊢ + rcases Finset.mem_image.mp hx with ⟨y, hy, rfl⟩ + exact Finset.mem_image.mpr ⟨y, (cert.outer_union y).2 ⟨0, false, by simpa using hy⟩, rfl⟩ + | C => + change x ∈ (TileTranslation (cert.P 1 true) + ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells at hx + rw [(TileTranslationFormulas _ _).1] at hx ⊢ + rcases Finset.mem_image.mp hx with ⟨y, hy, rfl⟩ + exact Finset.mem_image.mpr ⟨y, (cert.outer_union y).2 ⟨1, true, by simpa using hy⟩, rfl⟩ + | D => + change x ∈ (TileTranslation (cert.P 1 false) + ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells at hx + rw [(TileTranslationFormulas _ _).1] at hx ⊢ + rcases Finset.mem_image.mp hx with ⟨y, hy, rfl⟩ + exact Finset.mem_image.mpr ⟨y, (cert.outer_union y).2 ⟨1, false, by simpa using hy⟩, rfl⟩ + | E => + change x ∈ (TileTranslation (cert.P 2 true) + ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells at hx + rw [(TileTranslationFormulas _ _).1] at hx ⊢ + rcases Finset.mem_image.mp hx with ⟨y, hy, rfl⟩ + exact Finset.mem_image.mpr ⟨y, (cert.outer_union y).2 ⟨2, true, by simpa using hy⟩, rfl⟩ + | F => + change x ∈ (TileTranslation (cert.P 2 false) + ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells at hx + rw [(TileTranslationFormulas _ _).1] at hx ⊢ + rcases Finset.mem_image.mp hx with ⟨y, hy, rfl⟩ + exact Finset.mem_image.mpr ⟨y, (cert.outer_union y).2 ⟨2, false, by simpa using hy⟩, rfl⟩ + +private theorem hKDisjoint : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (z : P3996T1SRowParameters), ((TileTranslation + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.childIndex) + z.rightShift).cells ⊆ (TileTranslation T z.oldShift).cells) → ( + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occ z.childIndex + let K := TileTranslation V z.rightShift + (∀ (i : PeriodicSubtileIndex), ∀ (x : LatticeCell), (x ∈ (occ i).cells) → (x ∈ + (TileTranslation T ((i.first : GaussianInt) * cert.u + (i.second : GaussianInt) * + cert.v)).cells)) → (∀ (i : PeriodicSubtileIndex), ∀ (r : Int), ∀ (s : Int), + (z.oldShift = (r : GaussianInt) * cert.u + (s : GaussianInt) * cert.v) → (((i.first, + i.second) ≠ (r, s)) → (Disjoint K.cells (occ i).cells)))) ) := by + classical + intro q cfg C T cert z hsub occ V K originalInBlock i r s hshift hneq + rw [Finset.disjoint_left] + intro x hxK hxi + have hbk : x ∈ (TileTranslation T + ((r : GaussianInt) * cert.u + (s : GaussianInt) * cert.v)).cells := by + have hx := hsub hxK + simpa [hshift] using hx + have hbi := originalInBlock i x hxi + have hblocks := (BandOrderedGeneralPeriodicBlockCells q cfg C T cert).2 + i.first i.second r s (by simpa [Prod.mk.injEq] using hneq) + exact (Finset.disjoint_left.mp hblocks) hbi hbk + +private theorem hLV : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + (P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)) → (∀ (z : + P3996T1SRowParameters), + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occ z.childIndex + (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex + = b ∧ z.parentIndex = a) → (LatticeTile V)) ) := by + classical + intro q cfg C T cert a b row data z occ V hindices + cases hchild : z.childIsExterior + · have hi := hindices + simp [hchild] at hi + simpa [V, occ, SubtileOccurrenceInterpretation, hi.1] using data.latticeW + · have hi := hindices + simp [hchild] at hi + simpa [V, occ, SubtileOccurrenceInterpretation, hi.1] using data.latticeV + +private theorem hLW : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + (P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)) → (∀ (z : + P3996T1SRowParameters), + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let W := occ z.parentIndex + (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex + = b ∧ z.parentIndex = a) → (LatticeTile W)) ) := by + classical + intro q cfg C T cert a b row data z occ W hindices + cases hchild : z.childIsExterior + · have hi := hindices + simp [hchild] at hi + simpa [W, occ, SubtileOccurrenceInterpretation, hi.2] using data.latticeV + · have hi := hindices + simp [hchild] at hi + simpa [W, occ, SubtileOccurrenceInterpretation, hi.2] using data.latticeW + +private theorem holdShift : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : + P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (z : + P3996T1SRowParameters), (P3996T1SRowTable q cfg C T cert row = some z) → (∀ (E : + ExactTileInterfaceTriple (SubtileOccurrenceInterpretation cert.P cert.u cert.v + z.childIndex) (TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u cert.v + z.childIndex) z.rightShift) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + z.parentIndex)), ((TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u + cert.v z.childIndex) z.rightShift).cells ⊆ (TileTranslation T z.oldShift).cells) → ( + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occ z.childIndex + let W := occ z.parentIndex + let K := TileTranslation V z.rightShift + (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex + = b ∧ z.parentIndex = a) → ((SimpleGridPathBetween (FootprintVertices V ∩ + FootprintVertices W) (FootprintEdges V ∩ FootprintEdges W) E.point E.otherCA) → + ((({data.first, data.last} : Finset GaussianInt) = ({E.point, E.otherCA} : Finset + GaussianInt)) → ((E.point = data.first ∨ E.point = data.last) → ((∀ (i : + PeriodicSubtileIndex), ∀ (r : Int), ∀ (s : Int), (z.oldShift = (r : GaussianInt) * + cert.u + (s : GaussianInt) * cert.v) → (((i.first, i.second) ≠ (r, s)) → (Disjoint + K.cells (occ i).cells))) → ((LatticeTile V) → ((LatticeTile W) → ((LatticeTile K) → ( + let oldCoords : Int × Int := nestedOldCoordinates row + z.oldShift = (oldCoords.1 : GaussianInt) * cert.u + (oldCoords.2 : GaussianInt) * + cert.v)))))))))) ) := by + classical + intro q cfg C T cert a b row data z hz E hsub occ V W K hindices hpath hdataEndpoints + hpointPair hKDisjoint hLV hLW hLK oldCoords + cases row <;> simp? [P3996T1SRowTable] at hz + all_goals cases hz + all_goals simp [oldCoords, nestedOldCoordinates] + all_goals ring + +private theorem hchildBlockNe : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : + P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (z : + P3996T1SRowParameters), (P3996T1SRowTable q cfg C T cert row = some z) → (∀ (E : + ExactTileInterfaceTriple (SubtileOccurrenceInterpretation cert.P cert.u cert.v + z.childIndex) (TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u cert.v + z.childIndex) z.rightShift) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + z.parentIndex)), ((TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u + cert.v z.childIndex) z.rightShift).cells ⊆ (TileTranslation T z.oldShift).cells) → ( + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occ z.childIndex + let W := occ z.parentIndex + let K := TileTranslation V z.rightShift + (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex + = b ∧ z.parentIndex = a) → ((SimpleGridPathBetween (FootprintVertices V ∩ + FootprintVertices W) (FootprintEdges V ∩ FootprintEdges W) E.point E.otherCA) → + ((({data.first, data.last} : Finset GaussianInt) = ({E.point, E.otherCA} : Finset + GaussianInt)) → ((E.point = data.first ∨ E.point = data.last) → ((∀ (i : + PeriodicSubtileIndex), ∀ (r : Int), ∀ (s : Int), (z.oldShift = (r : GaussianInt) * + cert.u + (s : GaussianInt) * cert.v) → (((i.first, i.second) ≠ (r, s)) → (Disjoint + K.cells (occ i).cells))) → ((LatticeTile V) → ((LatticeTile W) → ((LatticeTile K) → ( + let oldCoords : Int × Int := nestedOldCoordinates row + (z.oldShift = (oldCoords.1 : GaussianInt) * cert.u + (oldCoords.2 : GaussianInt) * + cert.v) → ((z.childIndex.first, z.childIndex.second) ≠ oldCoords))))))))))) ) := by + classical + intro q cfg C T cert a b row data z hz E hsub occ V W K hindices hpath hdataEndpoints + hpointPair hKDisjoint hLV hLW hLK oldCoords holdShift + cases row <;> simp? [P3996T1SRowTable] at hz + all_goals + cases hz + simp [oldCoords, nestedOldCoordinates] + +private theorem hparentBlockNe : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : + P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (z : + P3996T1SRowParameters), (P3996T1SRowTable q cfg C T cert row = some z) → (∀ (E : + ExactTileInterfaceTriple (SubtileOccurrenceInterpretation cert.P cert.u cert.v + z.childIndex) (TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u cert.v + z.childIndex) z.rightShift) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + z.parentIndex)), ((TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u + cert.v z.childIndex) z.rightShift).cells ⊆ (TileTranslation T z.oldShift).cells) → ( + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occ z.childIndex + let W := occ z.parentIndex + let K := TileTranslation V z.rightShift + (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex + = b ∧ z.parentIndex = a) → ((SimpleGridPathBetween (FootprintVertices V ∩ + FootprintVertices W) (FootprintEdges V ∩ FootprintEdges W) E.point E.otherCA) → + ((({data.first, data.last} : Finset GaussianInt) = ({E.point, E.otherCA} : Finset + GaussianInt)) → ((E.point = data.first ∨ E.point = data.last) → ((∀ (i : + PeriodicSubtileIndex), ∀ (r : Int), ∀ (s : Int), (z.oldShift = (r : GaussianInt) * + cert.u + (s : GaussianInt) * cert.v) → (((i.first, i.second) ≠ (r, s)) → (Disjoint + K.cells (occ i).cells))) → ((LatticeTile V) → ((LatticeTile W) → ((LatticeTile K) → ( + let oldCoords : Int × Int := nestedOldCoordinates row + (z.oldShift = (oldCoords.1 : GaussianInt) * cert.u + (oldCoords.2 : GaussianInt) * + cert.v) → (((z.childIndex.first, z.childIndex.second) ≠ oldCoords) → + ((z.parentIndex.first, z.parentIndex.second) ≠ oldCoords)))))))))))) ) := by + classical + intro q cfg C T cert a b row data z hz E hsub occ V W K hindices hpath hdataEndpoints + hpointPair hKDisjoint hLV hLW hLK oldCoords holdShift hchildBlockNe + cases row <;> simp? [P3996T1SRowTable] at hz + all_goals + cases hz + simp [oldCoords, nestedOldCoordinates] + +private theorem hwrongBlockNe : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : + P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (z : + P3996T1SRowParameters), (P3996T1SRowTable q cfg C T cert row = some z) → (∀ (E : + ExactTileInterfaceTriple (SubtileOccurrenceInterpretation cert.P cert.u cert.v + z.childIndex) (TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u cert.v + z.childIndex) z.rightShift) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + z.parentIndex)), ((TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u + cert.v z.childIndex) z.rightShift).cells ⊆ (TileTranslation T z.oldShift).cells) → ( + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occ z.childIndex + let W := occ z.parentIndex + let K := TileTranslation V z.rightShift + (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex + = b ∧ z.parentIndex = a) → ((SimpleGridPathBetween (FootprintVertices V ∩ + FootprintVertices W) (FootprintEdges V ∩ FootprintEdges W) E.point E.otherCA) → + ((({data.first, data.last} : Finset GaussianInt) = ({E.point, E.otherCA} : Finset + GaussianInt)) → ((E.point = data.first ∨ E.point = data.last) → ((∀ (i : + PeriodicSubtileIndex), ∀ (r : Int), ∀ (s : Int), (z.oldShift = (r : GaussianInt) * + cert.u + (s : GaussianInt) * cert.v) → (((i.first, i.second) ≠ (r, s)) → (Disjoint + K.cells (occ i).cells))) → ((LatticeTile V) → ((LatticeTile W) → ((LatticeTile K) → ( + let oldCoords : Int × Int := nestedOldCoordinates row + (z.oldShift = (oldCoords.1 : GaussianInt) * cert.u + (oldCoords.2 : GaussianInt) * + cert.v) → (((z.childIndex.first, z.childIndex.second) ≠ oldCoords) → + (((z.parentIndex.first, z.parentIndex.second) ≠ oldCoords) → ( + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + let wrongOwner := if z.parentSlot = 0 then owners.2 else owners.1 + (wrongOwner.first, wrongOwner.second) ≠ oldCoords))))))))))))) ) := by + classical + intro q cfg C T cert a b row data z hz E hsub occ V W K hindices hpath hdataEndpoints + hpointPair hKDisjoint hLV hLW hLK oldCoords holdShift hchildBlockNe hparentBlockNe owners + wrongOwner + cases row <;> simp? [P3996T1SRowTable] at hz + all_goals + cases hz + simp [wrongOwner, owners, oldCoords, + P4418T3EndpointOwnerIndices, nestedOldCoordinates] + +private theorem hTVW : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + (P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)) → (∀ (z : + P3996T1SRowParameters), + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occ z.childIndex + let W := occ z.parentIndex + let G₀ := occ (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex + = b ∧ z.parentIndex = a) → (TouchingTriple V W G₀)) ) := by + classical + intro q cfg C T cert a b row data z occ V W G₀ hindices + cases hchild : z.childIsExterior + · have hi := hindices + simp [hchild] at hi + have hrev := + (TouchingTriplePermutations (occ a) (occ b) G₀).mp data.touching₀ |>.2.1 + simpa [V, W, G₀, occ, SubtileOccurrenceInterpretation, + hi.1, hi.2] using hrev + · have hi := hindices + simp [hchild] at hi + simpa [V, W, G₀, occ, SubtileOccurrenceInterpretation, + hi.1, hi.2] using data.touching₀ + +private theorem hTVW' : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + (P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)) → (∀ (z : + P3996T1SRowParameters), + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occ z.childIndex + let W := occ z.parentIndex + let G₁ := occ (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 + (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex + = b ∧ z.parentIndex = a) → (TouchingTriple V W G₁)) ) := by + classical + intro q cfg C T cert a b row data z occ V W G₁ hindices + cases hchild : z.childIsExterior + · have hi := hindices + simp [hchild] at hi + have hrev := + (TouchingTriplePermutations (occ a) (occ b) G₁).mp data.touching₁ |>.2.1 + simpa [V, W, G₁, occ, SubtileOccurrenceInterpretation, + hi.1, hi.2] using hrev + · have hi := hindices + simp [hchild] at hi + simpa [V, W, G₁, occ, SubtileOccurrenceInterpretation, + hi.1, hi.2] using data.touching₁ + +private theorem hcommon₀ : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : + P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (z : + P3996T1SRowParameters), + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occ z.childIndex + let W := occ z.parentIndex + let G₀ := occ (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex + = b ∧ z.parentIndex = a) → (data.first ∈ FootprintVertices V ∩ FootprintVertices W ∩ + FootprintVertices G₀) ) := by + classical + intro q cfg C T cert a b row data z occ V W G₀ hindices + cases hchild : z.childIsExterior + · have hi := hindices + simp [hchild] at hi + simpa [V, W, G₀, occ, SubtileOccurrenceInterpretation, + hi.1, hi.2, Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using data.common₀ + · have hi := hindices + simp [hchild] at hi + simpa [V, W, G₀, occ, SubtileOccurrenceInterpretation, + hi.1, hi.2, Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using data.common₀ + +private theorem hcommon₁ : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : + P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (z : + P3996T1SRowParameters), + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occ z.childIndex + let W := occ z.parentIndex + let G₁ := occ (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 + (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex + = b ∧ z.parentIndex = a) → (data.last ∈ FootprintVertices V ∩ FootprintVertices W ∩ + FootprintVertices G₁) ) := by + classical + intro q cfg C T cert a b row data z occ V W G₁ hindices + cases hchild : z.childIsExterior + · have hi := hindices + simp [hchild] at hi + simpa [V, W, G₁, occ, SubtileOccurrenceInterpretation, + hi.1, hi.2, Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using data.common₁ + · have hi := hindices + simp [hchild] at hi + simpa [V, W, G₁, occ, SubtileOccurrenceInterpretation, + hi.1, hi.2, Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using data.common₁ + +private theorem hVW : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + (P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)) → (∀ (z : + P3996T1SRowParameters), + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occ z.childIndex + let W := occ z.parentIndex + (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex + = b ∧ z.parentIndex = a) → (Disjoint V.cells W.cells)) ) := by + classical + intro q cfg C T cert a b row data z occ V W hindices + cases hchild : z.childIsExterior + · have hi := hindices + simp [hchild] at hi + simpa [V, W, occ, SubtileOccurrenceInterpretation, hi.1, hi.2] using + data.disjointVW.symm + · have hi := hindices + simp [hchild] at hi + simpa [V, W, occ, SubtileOccurrenceInterpretation, hi.1, hi.2] using + data.disjointVW + +private theorem hNoWrong : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : + P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (z : + P3996T1SRowParameters), ∀ (E : ExactTileInterfaceTriple + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.childIndex) (TileTranslation + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.childIndex) z.rightShift) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.parentIndex)), + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occ z.childIndex + let W := occ z.parentIndex + let K := TileTranslation V z.rightShift + let G₀ := occ (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + let G₁ := occ (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 + (LatticeTile V) → ((LatticeTile W) → ((LatticeTile K) → ( + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + let wrongOwner := if z.parentSlot = 0 then owners.2 else owners.1 + (Disjoint K.cells V.cells) → ((Disjoint K.cells W.cells) → ((Disjoint K.cells (occ + wrongOwner).cells) → ((TouchingTriple V W G₀) → ((TouchingTriple V W G₁) → + ((data.first ∈ FootprintVertices V ∩ FootprintVertices W ∩ FootprintVertices G₀) → + ((data.last ∈ FootprintVertices V ∩ FootprintVertices W ∩ FootprintVertices G₁) → + ((TouchingTriple V K W) → (E.point ≠ if z.parentSlot = 0 then data.last else + data.first))))))))))) ) := by + classical + intro q cfg C T cert a b row data z E occ V W K G₀ G₁ hLV hLW hLK owners wrongOwner hKV hKW + hKGwrong hTVW hTVW' hcommon₀ hcommon₁ hET + by_cases hslot : z.parentSlot = 0 + · intro heq + have hG : Disjoint K.cells G₁.cells := by + simpa [wrongOwner, owners, hslot, G₁] using hKGwrong + have hsectorData := LocalLatticeInterfaceSectors.1 V W G₁ data.last + hLV hLW data.latticeG₁ hTVW' hcommon₁ + have hpointE := (E.unique_common E.point).2 rfl + have hsectorE := LocalLatticeInterfaceSectors.1 V K W E.point + hLV hLK hLW hET hpointE + obtain ⟨j, hjK⟩ := hsectorE.2.2.1 + have hjData := hsectorData.1 j + simp? [hslot] at heq + rw [← heq] at hjData + rcases hjData with hjV | hjW | hjG + · exact (Finset.disjoint_left.mp hKV) hjK hjV + · exact (Finset.disjoint_left.mp hKW) hjK hjW + · exact (Finset.disjoint_left.mp hG) hjK hjG + · intro heq + have hG : Disjoint K.cells G₀.cells := by + simpa [wrongOwner, owners, hslot, G₀] using hKGwrong + have hsectorData := LocalLatticeInterfaceSectors.1 V W G₀ data.first + hLV hLW data.latticeG₀ hTVW hcommon₀ + have hpointE := (E.unique_common E.point).2 rfl + have hsectorE := LocalLatticeInterfaceSectors.1 V K W E.point + hLV hLK hLW hET hpointE + obtain ⟨j, hjK⟩ := hsectorE.2.2.1 + have hjData := hsectorData.1 j + simp? [hslot] at heq + rw [← heq] at hjData + rcases hjData with hjV | hjW | hjG + · exact (Finset.disjoint_left.mp hKV) hjK hjV + · exact (Finset.disjoint_left.mp hKW) hjK hjW + · exact (Finset.disjoint_left.mp hG) hjK hjG + +end NestedCompanionGeometry + +theorem P4418T3NestedCompanionEndpoint + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b) + (data : P4418T3SelectedInterfaceData + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)) + (z : P3996T1SRowParameters) + (hz : P3996T1SRowTable q cfg C T cert row = some z) + (E : ExactTileInterfaceTriple + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.childIndex) + (TileTranslation + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.childIndex) + z.rightShift) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.parentIndex)) + (hsub : (TileTranslation + (SubtileOccurrenceInterpretation cert.P cert.u cert.v z.childIndex) + z.rightShift).cells ⊆ (TileTranslation T z.oldShift).cells) : + E.point = (if z.parentSlot = 0 then data.first else data.last) := by +-- BODY + classical + let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let V := occ z.childIndex + let W := occ z.parentIndex + let K := TileTranslation V z.rightShift + let G₀ := occ (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + let G₁ := occ (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 + obtain ⟨_, _, _, _, _, _, hindices, _, _⟩ := + P3996T1SRowAlignment q cfg C T cert a b row z hz + have hpath := NestedCompanionGeometry.hpath q cfg C T cert a b z E hindices + have hdataEndpoints := NestedCompanionGeometry.hdataEndpoints q cfg C T cert a b row data z E + hindices hpath + have hpointPair := NestedCompanionGeometry.hpointPair q cfg C T cert a b row data z E + hdataEndpoints + have hprecursorInMinus := NestedCompanionGeometry.hprecursorInMinus q cfg C T cert + have originalInBlock (i : PeriodicSubtileIndex) (x : LatticeCell) + (hx : x ∈ (occ i).cells) := NestedCompanionGeometry.originalInBlock q cfg C T cert + hprecursorInMinus i x hx + have hKDisjoint (i : PeriodicSubtileIndex) (r s : Int) + (hshift : z.oldShift = (r : GaussianInt) * cert.u + (s : GaussianInt) * cert.v) + (hneq : (i.first, i.second) ≠ (r, s)) := NestedCompanionGeometry.hKDisjoint q cfg C T cert + z hsub originalInBlock i r s hshift hneq + have hLV := NestedCompanionGeometry.hLV q cfg C T cert a b row data z hindices + have hLW := NestedCompanionGeometry.hLW q cfg C T cert a b row data z hindices + have hLK : LatticeTile K := + (TileDiskAreaCovariance V z.rightShift).1.mp hLV + let oldCoords : Int × Int := nestedOldCoordinates row + have holdShift := NestedCompanionGeometry.holdShift q cfg C T cert a b row data z hz E hsub + hindices hpath hdataEndpoints hpointPair hKDisjoint hLV hLW hLK + have hchildBlockNe := NestedCompanionGeometry.hchildBlockNe q cfg C T cert a b row data z hz E + hsub hindices hpath hdataEndpoints hpointPair hKDisjoint hLV hLW hLK holdShift + have hparentBlockNe := NestedCompanionGeometry.hparentBlockNe q cfg C T cert a b row data z hz + E hsub hindices hpath hdataEndpoints hpointPair hKDisjoint hLV hLW hLK holdShift hchildBlockNe + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + let wrongOwner := if z.parentSlot = 0 then owners.2 else owners.1 + have hwrongBlockNe := NestedCompanionGeometry.hwrongBlockNe q cfg C T cert a b row data z hz E + hsub hindices hpath hdataEndpoints hpointPair hKDisjoint hLV hLW hLK holdShift + hchildBlockNe hparentBlockNe + have hKV : Disjoint K.cells V.cells := + hKDisjoint z.childIndex oldCoords.1 oldCoords.2 holdShift hchildBlockNe + have hKW : Disjoint K.cells W.cells := + hKDisjoint z.parentIndex oldCoords.1 oldCoords.2 holdShift hparentBlockNe + have hKGwrong : Disjoint K.cells (occ wrongOwner).cells := + hKDisjoint wrongOwner oldCoords.1 oldCoords.2 holdShift hwrongBlockNe + have hTVW := NestedCompanionGeometry.hTVW q cfg C T cert a b row data z hindices + have hTVW' := NestedCompanionGeometry.hTVW' q cfg C T cert a b row data z hindices + have hcommon₀ := NestedCompanionGeometry.hcommon₀ q cfg C T cert a b row data z hindices + have hcommon₁ := NestedCompanionGeometry.hcommon₁ q cfg C T cert a b row data z hindices + have hVW := NestedCompanionGeometry.hVW q cfg C T cert a b row data z hindices + have hET : TouchingTriple V K W := + ExactTileInterfaceTripleLatticeTouching V K W E hLV hLK hLW + hKV.symm hKW hVW.symm + have hNoWrong := NestedCompanionGeometry.hNoWrong q cfg C T cert a b row data z E hLV hLW hLK + hKV hKW hKGwrong hTVW hTVW' hcommon₀ hcommon₁ hET + by_cases hslot : z.parentSlot = 0 + · have hn := hNoWrong + simp? [hslot] at hn + rcases hpointPair with hp | hp + · simpa [hslot] using hp + · exact False.elim (hn hp) + · have hn := hNoWrong + simp? [hslot] at hn + rcases hpointPair with hp | hp + · exact False.elim (hn hp) + · simpa [hslot] using hp + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionGeometry.lean new file mode 100644 index 0000000000..b824dd20b5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionGeometry.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3996T1SRowAlignment +public import LeanPool.ApollonianSuperharmonic.P3996T1AdjacentParentPlacement +public import LeanPool.ApollonianSuperharmonic.P3996T1CenteredQuarterTurnInclusion +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentRightEndpoint +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.TileT2QuarterTurn + +-- [TABLET NODE: P4418T3NestedCompanionGeometry] + +/-! +# P4418T3NestedCompanionGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4418T3NestedCompanionGeometry + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b) + (z : P3996T1SRowParameters) + (hz : P3996T1SRowTable q cfg C T cert row = some z) : + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let newRight := TileTranslation (occurrence z.childIndex) z.rightShift + Nonempty (ExactTileInterfaceTriple + (occurrence z.childIndex) newRight (occurrence z.parentIndex)) ∧ + newRight.cells ⊆ (TileTranslation T z.oldShift).cells ∧ + FootprintVertices newRight ⊆ + FootprintVertices (TileTranslation T z.oldShift) := by +-- BODY + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let newRight := TileTranslation (occurrence z.childIndex) z.rightShift + obtain ⟨hp, hp0, hV, hW, hVpos, hWpos, _, _, hd, hWcent, hcent⟩ := + P3996T1SRowAlignment q cfg C T cert a b row z hz + dsimp only at hV hW hWcent hcent ⊢ + have hExact : Nonempty (ExactTileInterfaceTriple + (occurrence z.childIndex) newRight (occurrence z.parentIndex)) := by + obtain ⟨Z, hZ, hZcent⟩ := P3996T1AdjacentParentPlacement + z.predecessor hp z.parentSlot z.rotation (occurrence z.childIndex) hV + have ep := BandOrientedChildParentRightEndpoint z.predecessor hp + z.parentSlot z.rotation (occurrence z.childIndex) + (occurrence z.parentIndex) Z hV hW hZ hVpos hWpos hWcent hZcent + simpa only [newRight, hd] using ep + have hsubP : (cert.P z.childSlot z.sourceSign).cells ⊆ T.cells := by + intro y hy + exact (cert.outer_union y).mpr ⟨z.childSlot, z.sourceSign, hy⟩ + obtain ⟨t, p, _, _, htransport⟩ := + P3996T1CenteredQuarterTurnInclusion T (cert.P z.childSlot z.sourceSign) + (TileT2QuarterTurn q cfg C T cert) + (cert.parent_quarter_turn z.childSlot z.sourceSign) hsubP + let rotatedPiece := TileTranslation (cert.P z.childSlot z.sourceSign) + (z.oldShift + t - p) + have htransported := htransport z.oldShift + have hnewBand : BandPrototile (q z.childSlot.succ) newRight := by + rw [← hp0] + exact BandPrototileTranslation _ _ z.rightShift hV + have hrotatedBand : BandPrototile (q z.childSlot.succ) rotatedPiece := + BandPrototileTranslation _ _ _ + (cert.outer_occurrence z.childSlot z.sourceSign).1 + have hcentEqual : TileCentroid newRight = TileCentroid rotatedPiece := + sub_left_inj.mp (hcent.trans htransported.2.symm) + have hcells := (BandPrototileCentroidUnique _ _ _ + hnewBand hrotatedBand hcentEqual).1 + have hsub : newRight.cells ⊆ (TileTranslation T z.oldShift).cells := by + rw [hcells] + exact htransported.1 + have hne : newRight.cells.Nonempty := by + obtain ⟨E⟩ := hExact + obtain ⟨path, _, hlen, _, _, _, _, hedges⟩ := E.pathAB + cases path with + | nil => simp at hlen + | cons v tail => + cases tail with + | nil => simp at hlen + | cons w rest => + have he : {v, w} ∈ FootprintEdges (occurrence z.childIndex) ∩ + FootprintEdges newRight := + (hedges {v, w}).mpr ⟨v, w, [], rest, rfl, rfl⟩ + obtain ⟨cell, hcell, _⟩ := he.2 + exact ⟨cell, hcell⟩ + refine ⟨hExact, hsub, ?_⟩ + have hneOld := hne.mono hsub + change FootprintVertices newRight ⊆ FootprintVertices (TileTranslation T z.oldShift) + simp only [FootprintVertices, ite_eq_left hne, ite_eq_left hneOld] + rintro y ⟨cell, hcell, hcorner⟩ + exact ⟨cell, hsub hcell, hcorner⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean b/LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean new file mode 100644 index 0000000000..152c46ff06 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean @@ -0,0 +1,709 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle +public import LeanPool.ApollonianSuperharmonic.P3996T1SRowTable +public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms +public import LeanPool.ApollonianSuperharmonic.P3055T1SignedCentroidNormalForms +public import LeanPool.ApollonianSuperharmonic.P3045T1RightBoundaryDisplacementAlgebra +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing + +-- [TABLET NODE: P4418T3OuterCompanionAlignment] + +/-! +# P4418T3OuterCompanionAlignment + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CompanionAlignmentGeometry + +private theorem area_of_band : + (by + classical + exact + ∀ (c : CircleCoordinates), ∀ (V : ProtoTile), 0 < c.1 → BandPrototile c V → TileArea V = + Int.toNat c.1 ) := by + classical + intro c V hc hV + cases hV with + | line w x hw => simp at hc + | unit z x anchor => simp [TileArea] + | @decompose p hp S V hS hcells hfoot hcentroid => + exact (BandTileSimultaneousInduction p hp V + (BandPrototile.decompose hp hS hcells hfoot hcentroid)).2.1 + +private theorem positive_parent : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + ∀ (j : Fin 3), 0 < (q j.succ).1 ) := by + classical + intro C D T N h k x bundle q j + let cfg := bundle.configuration + have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 j + have hne := cfg.noLine j.succ + change 0 ≤ (q j.succ).1 at hn + change (q j.succ).1 ≠ 0 at hne + omega + +private theorem occurrence_area : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), + let q := bundle.normalizedPresentation + let cert := placement.layout + let slot : PeriodicSubtileIndex → Fin 3 := fun a => + match a.label with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + (∀ (c : CircleCoordinates), ∀ (V : ProtoTile), 0 < c.1 → BandPrototile c V → TileArea V = + Int.toNat c.1) → ((∀ (j : Fin 3), 0 < (q j.succ).1) → (∀ (a : PeriodicSubtileIndex), + TileArea (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) = Int.toNat (q + (slot a).succ).1)) ) := by + classical + intro C D T N h k x bundle placement q cert slot area_of_band positive_parent a + have base_area (j : Fin 3) (b : Bool) (d : GaussianInt) : + TileArea (TileTranslation (cert.P j b) d) = + Int.toNat (q j.succ).1 := by + rw [(TileDiskAreaCovariance _ _).2.2.2.1] + exact area_of_band _ _ (positive_parent j) (cert.outer_occurrence j b).1 + cases a with + | mk label m n => + cases label <;> simp [SubtileOccurrenceInterpretation, slot, base_area] + +private theorem area_eq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), + let q := bundle.normalizedPresentation + let cert := placement.layout + let slot : PeriodicSubtileIndex → Fin 3 := fun a => + match a.label with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + (∀ (a : PeriodicSubtileIndex), TileArea (SubtileOccurrenceInterpretation cert.P cert.u + cert.v a) = Int.toNat (q (slot a).succ).1) → ((TileArea bundle.normalizedFixed = + Int.toNat bundle.normalizedFixedCircle.1.1.1) → (Int.toNat + bundle.normalizedFixedCircle.1.1.1 = Int.toNat (q (slot + placement.exteriorIndex).succ).1)) ) := by + classical + intro C D T N h k x bundle placement q cert slot occurrence_area fixed_area + rw [← fixed_area, ← occurrence_area placement.exteriorIndex] + exact congrArg Finset.card placement.fixed_exterior_cells.symm + +private theorem strict23 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + (q 3).1 < (q 2).1 ) := by + classical + intro C D T N h k x bundle q + let cfg := bundle.configuration + have hp := cfg.secondProper.2 0 + change (cfg.secondPredecessor 1).1 < (cfg.secondPredecessor 0).1 at hp + simpa only [cfg.secondChild, cfg.secondParentOne] using hp + +private theorem parent_area_injective : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (fixedFunction : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h fixedFunction x), + (BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedFixedCircle + bundle.normalizedRoot bundle.normalizedFixed bundle.normalizedRootFunction + bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces bundle.functions + bundle.selectedSlot bundle.selectedSign bundle.routedDirection) → ( + let q := bundle.normalizedPresentation + (∀ (j : Fin 3), 0 < (q j.succ).1) → (((q 3).1 < (q 2).1) → (∀ (j : Fin 3), ∀ (k : Fin 3), + (Int.toNat (q j.succ).1 = Int.toNat (q k.succ).1) → (j = k)))) ) := by + classical + intro C D T N h fixedFunction x bundle placement q positive_parent strict23 j k heq + let cfg := bundle.configuration + have hj := positive_parent j + have hk := positive_parent k + have hc : (q j.succ).1 = (q k.succ).1 := by omega + have h12 : (q 2).1 < (q 1).1 := cfg.order12 + fin_cases j <;> fin_cases k <;> simp_all + all_goals omega + +private theorem parent_eq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), (r i.succ = bundle.normalizedFixedCircle.1.1) → ( + let q := bundle.normalizedPresentation + let slot : PeriodicSubtileIndex → Fin 3 := fun a => + match a.label with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + (Int.toNat bundle.normalizedFixedCircle.1.1.1 = Int.toNat (q (slot + placement.exteriorIndex).succ).1) → ((∀ (j : Fin 3), ∀ (k : Fin 3), (Int.toNat (q + j.succ).1 = Int.toNat (q k.succ).1) → (j = k)) → (∀ (rotation : Fin (3 : ℕ)), (∀ (j : + Fin (3 : ℕ)), r j.succ = q (j + rotation).succ) → (bundle.normalizedFixedCircle.1.1 = + q (slot placement.exteriorIndex).succ)))) ) := by + classical + intro C D T N h k x bundle placement r i hri q slot area_eq parent_area_injective rotation + hrotation + have heq := hrotation i + have hj : i + rotation = slot placement.exteriorIndex := by + apply parent_area_injective + rw [← heq, hri] + exact area_eq + simpa only [hj, hri] using heq + +private theorem presented_centroid : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), (r (0 : Fin (4 : ℕ)) = + bundle.normalizedCircle.1.1) → ((r i.succ = + bundle.normalizedFixedCircle.1.1) → + ((TileCentroid bundle.normalizedFixed - TileCentroid bundle.normalizedRoot = (1 / 2 : + ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * + (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r i.succ)))) → ( + let q := bundle.normalizedPresentation + let cert := placement.layout + let slot : PeriodicSubtileIndex → Fin 3 := fun a => + match a.label with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + (bundle.normalizedFixedCircle.1.1 = q (slot placement.exteriorIndex).succ) → + ((TileCentroid bundle.normalizedFixed = TileCentroid (SubtileOccurrenceInterpretation + cert.P cert.u cert.v placement.exteriorIndex)) → (TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v placement.exteriorIndex) - + TileCentroid bundle.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : + GaussianInt) ^ s.val * (BandVectors.1 (q (slot placement.exteriorIndex).succ) (q 0) + + BandVectors.1 (q 0) (q (slot placement.exteriorIndex).succ)))))))) ) := by + classical + intro C D T N h k x bundle placement r i s hr0 hri hcentroid q cert slot parent_eq fixed_centroid + have root_eq : r 0 = q 0 := hr0.trans bundle.normalized_circle_eq.symm + simpa only [fixed_centroid, root_eq, hri, parent_eq] using hcentroid + +private theorem incoming : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + (∀ (j : Fin 3), BandVectors.1 (q 0) (q j.succ) = (⟨0, 1⟩ : GaussianInt) * BandVectors.1 + (q j.succ) (q 0)) → (∀ (j : Fin 3), BandVectors.1 (q j.succ) (q 0) = -(⟨0, 1⟩ : + GaussianInt) * BandVectors.1 (q 0) (q j.succ)) ) := by + classical + intro C D T N h k x bundle q flip j + rw [flip] + ext <;> simp + +private theorem geometry : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), + let q := bundle.normalizedPresentation + let cert := placement.layout + let slot : PeriodicSubtileIndex → Fin 3 := fun a => + match a.label with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + let turn : PeriodicSubtileIndex → Fin 4 := fun a => + match a.label with + | .A => if a.first = -1 then 3 else 0 + | .B => if a.first = 1 then 1 else 2 + | .C => if a.second = 0 then 3 else 0 + | .D => if a.second = 0 then 1 else 2 + | .E => if a.first = 0 then 3 else 0 + | .F => if a.first = 0 then 1 else 2 + let shift : PeriodicSubtileIndex → GaussianInt := fun a => + match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => if a.second = 0 then -cert.v else cert.v + | .D => if a.second = 0 then cert.v else -cert.v + | .E => if a.first = 0 then cert.u + cert.v else -cert.u - cert.v + | .F => if a.first = 0 then -cert.u - cert.v else cert.u + cert.v + (BandVectors.1 (q 1) (q 0) = -(⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 0) (q 1)) → + ((BandVectors.1 (q 2) (q 0) = -(⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 0) (q 2)) → + ((BandVectors.1 (q 3) (q 0) = -(⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 0) (q 3)) → + ((cert.u = BandVectors.1 (q 0) (q 1)) → ((cert.v = BandVectors.1 (q 0) (q 2)) → + ((BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = BandVectors.1 (q (2 : + Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + (BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) + BandVectors.1 (q (3 : + Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))) → ((BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : + Fin (4 : ℕ))) = BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : + ℕ)))) → ((BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = -BandVectors.1 + (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) - BandVectors.1 (q (3 : Fin (4 : ℕ))) (q + (2 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (3 : Fin + (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → (( + let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); + let U := BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let W := BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); ∀ (j : Fin (3 : ℕ)), + ∀ (s : Bool), TileCentroid (cert.P j s) = TileCentroid bundle.normalizedRoot + (if s + = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • GaussianRealPoint (if j = (0 : Fin + (3 : ℕ)) then ((1 : GaussianInt) - I) * W else if j = (1 : Fin (3 : ℕ)) then -((1 : + GaussianInt) - I) * (U + W) else ((1 : GaussianInt) - I) * U)) → ((∀ (j : Fin 3), ∀ + (b : Bool), ∀ (d : GaussianInt), TileCentroid (TileTranslation (cert.P j b) d) = + TileCentroid (cert.P j b) + GaussianRealPoint d) → (∀ (a : PeriodicSubtileIndex), (a + = ⟨.A, -1, -1⟩ ∨ a = ⟨.A, 0, -1⟩ ∨ + a = ⟨.C, 1, 0⟩ ∨ a = ⟨.C, 1, 1⟩ ∨ + a = ⟨.E, 0, 1⟩ ∨ a = ⟨.E, -1, 0⟩ ∨ + a = ⟨.B, 1, 1⟩ ∨ a = ⟨.B, 0, 1⟩ ∨ + a = ⟨.D, -1, 0⟩ ∨ a = ⟨.D, -1, -1⟩ ∨ + a = ⟨.F, 0, -1⟩ ∨ a = ⟨.F, 1, 0⟩) → ((TileCentroid (SubtileOccurrenceInterpretation + cert.P cert.u cert.v a) - TileCentroid bundle.normalizedRoot = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (turn a).val * (BandVectors.1 (q + (slot a).succ) (q 0) + BandVectors.1 (q 0) (q (slot a).succ)))) ∧ (⟨0, 1⟩ : + GaussianInt) ^ (turn a).val * (if Even (turn a).val then BandVectors.1 (q 0) (q + (slot a).succ) else BandVectors.1 (q (slot a).succ) (q 0)) = shift a))))))))))) ) + := by + classical + intro C D T N h k x bundle placement q cert slot turn shift hin1 hin2 hin3 period_u period_v + hout1 hout2 hout3 signed_centroid translated_centroid a ha + let cfg := bundle.configuration + rcases ha with rfl | rfl | rfl | rfl | rfl | rfl | + rfl | rfl | rfl | rfl | rfl | rfl + all_goals + dsimp only [slot, turn, shift] + norm_num only + try + simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl, + show (1 : Fin 3).succ = (2 : Fin 4) from rfl, + show (2 : Fin 3).succ = (3 : Fin 4) from rfl] + constructor + · simp only [SubtileOccurrenceInterpretation, translated_centroid, + signed_centroid] + simp only [show (0 : Fin 3) ≠ 1 from by decide, + show (1 : Fin 3) ≠ 0 from by decide, + show (2 : Fin 3) ≠ 0 from by decide, + show (2 : Fin 3) ≠ 1 from by decide, ite_true, ite_false] + simp only [hin1, hin2, hin3, period_u, period_v, hout1, hout2, hout3] + ext <;> + norm_num [GaussianRealPoint, pow_succ, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + · simp only [Nat.even_iff] + simp only [ite_true, ite_false, + hin1, hin2, hin3, period_u, period_v, hout1, hout2, hout3] + ext <;> norm_num [pow_succ] <;> ring + +private theorem half_point_injective : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (w : GaussianInt), ((1 / 2 : ℝ) • GaussianRealPoint z = + (1 / 2 : ℝ) • GaussianRealPoint w) → (z = w) ) := by + classical + intro z w heq + have hx := congrArg Prod.fst heq + have hy := congrArg Prod.snd heq + simp only [GaussianRealPoint, Prod.smul_fst, Prod.smul_snd, + smul_eq_mul] at hx hy + apply Zsqrtd.ext + · exact_mod_cast (show (z.re : ℝ) = (w.re : ℝ) by linarith) + · exact_mod_cast (show (z.im : ℝ) = (w.im : ℝ) by linarith) + +private theorem sum_ne : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + (∀ (j : Fin 3), 0 < (q j.succ).1) → ((∀ (j : Fin 3), BandVectors.1 (q 0) (q j.succ) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q 0)) → (∀ (j : Fin 3), + BandVectors.1 (q j.succ) (q 0) + BandVectors.1 (q 0) (q j.succ) ≠ 0)) ) := by + classical + intro C D T N h k x bundle q positive_parent flip j + let cfg := bundle.configuration + have hv := VectorNonvanishing q cfg.proper.1 j.succ 0 + (by exact Fin.succ_ne_zero j) (Or.inl (positive_parent j)) + rw [flip] + convert mul_ne_zero (show (1 + (⟨0, 1⟩ : GaussianInt)) ≠ 0 by decide) hv + using 1; ring + +private theorem turn_injective : + (by + classical + exact + ∀ (a : Fin 4), ∀ (b : Fin 4), ((⟨0, 1⟩ : GaussianInt) ^ a.val = + (⟨0, 1⟩ : GaussianInt) ^ b.val) → (a = b) ) := by + classical + intro a b heq + fin_cases a <;> fin_cases b <;> + norm_num [pow_succ, Zsqrtd.ext_iff] at heq <;> rfl + +private theorem turn_eq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), ∀ (s : Fin (4 : ℕ)), + let q := bundle.normalizedPresentation + let cert := placement.layout + let slot : PeriodicSubtileIndex → Fin 3 := fun a => + match a.label with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + (TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v + placement.exteriorIndex) - TileCentroid bundle.normalizedRoot = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * (BandVectors.1 (q (slot + placement.exteriorIndex).succ) (q 0) + BandVectors.1 (q 0) (q (slot + placement.exteriorIndex).succ)))) → ( + let turn : PeriodicSubtileIndex → Fin 4 := fun a => + match a.label with + | .A => if a.first = -1 then 3 else 0 + | .B => if a.first = 1 then 1 else 2 + | .C => if a.second = 0 then 3 else 0 + | .D => if a.second = 0 then 1 else 2 + | .E => if a.first = 0 then 3 else 0 + | .F => if a.first = 0 then 1 else 2 + (∀ (z : GaussianInt), ∀ (w : GaussianInt), ((1 / 2 : ℝ) • GaussianRealPoint z = (1 / 2 : + ℝ) • GaussianRealPoint w) → (z = w)) → ((∀ (j : Fin 3), BandVectors.1 (q j.succ) (q + 0) + BandVectors.1 (q 0) (q j.succ) ≠ 0) → ((∀ (a : Fin 4), ∀ (b : Fin 4), ((⟨0, 1⟩ : + GaussianInt) ^ a.val = (⟨0, 1⟩ : GaussianInt) ^ b.val) → (a = b)) → ((TileCentroid + (SubtileOccurrenceInterpretation cert.P cert.u cert.v placement.exteriorIndex) - + TileCentroid bundle.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) ^ (↑(turn placement.exteriorIndex) : ℕ) * (BandVectors.1 (q (slot + placement.exteriorIndex).succ) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : + ℕ))) (q (slot placement.exteriorIndex).succ)))) → (s = turn + placement.exteriorIndex))))) ) := by + classical + intro C D T N h k x bundle placement s q cert slot presented_centroid turn half_point_injective + sum_ne turn_injective expected_centroid + apply turn_injective + apply mul_right_cancel₀ (sum_ne (slot placement.exteriorIndex)) + exact half_point_injective _ _ (presented_centroid.symm.trans expected_centroid) + +private theorem shift_eq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), (r (0 : Fin (4 : ℕ)) = + bundle.normalizedCircle.1.1) → ((r i.succ = + bundle.normalizedFixedCircle.1.1) → ( + let q := bundle.normalizedPresentation + let cert := placement.layout + let slot : PeriodicSubtileIndex → Fin 3 := fun a => + match a.label with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + (bundle.normalizedFixedCircle.1.1 = q (slot placement.exteriorIndex).succ) → ( + let turn : PeriodicSubtileIndex → Fin 4 := fun a => + match a.label with + | .A => if a.first = -1 then 3 else 0 + | .B => if a.first = 1 then 1 else 2 + | .C => if a.second = 0 then 3 else 0 + | .D => if a.second = 0 then 1 else 2 + | .E => if a.first = 0 then 3 else 0 + | .F => if a.first = 0 then 1 else 2 + let shift : PeriodicSubtileIndex → GaussianInt := fun a => + match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => if a.second = 0 then -cert.v else cert.v + | .D => if a.second = 0 then cert.v else -cert.v + | .E => if a.first = 0 then cert.u + cert.v else -cert.u - cert.v + | .F => if a.first = 0 then -cert.u - cert.v else cert.u + cert.v + (((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑(turn placement.exteriorIndex) : ℕ) * if Even + (↑(turn placement.exteriorIndex) : ℕ) then BandVectors.1 (q (0 : Fin (4 : ℕ))) (q + (slot placement.exteriorIndex).succ) else BandVectors.1 (q (slot + placement.exteriorIndex).succ) (q (0 : Fin (4 : ℕ)))) = shift + placement.exteriorIndex) → ((s = turn placement.exteriorIndex) → ((⟨0, 1⟩ : + GaussianInt) ^ s.val * (if Even s.val then BandVectors.1 (r 0) (r i.succ) else + BandVectors.1 (r i.succ) (r 0)) = shift placement.exteriorIndex))))) ) := by + classical + intro C D T N h k x bundle placement r i s hr0 hri q cert slot parent_eq turn shift + expected_shift turn_eq + have root_eq : r 0 = q 0 := hr0.trans bundle.normalized_circle_eq.symm + simpa only [turn_eq, root_eq, hri, parent_eq] using expected_shift + +end CompanionAlignmentGeometry + +theorem P4418T3OuterCompanionAlignment : + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle + bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions + bundle.selectedSlot bundle.selectedSign bundle.routedDirection), ∀ (row : + BandOrderedGeneralSelectedContactRow + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot placement.layout + placement.exteriorIndex placement.centralIndex), ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : + Fin 3), ∀ (s : Fin 4), (ProperBandQuadruple r) → ((r 0 = bundle.normalizedCircle.1.1) → + ((r i.succ = bundle.normalizedFixedCircle.1.1) → ((TileCentroid bundle.normalizedFixed - + TileCentroid bundle.normalizedRoot = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (r i.succ) (r 0) + + BandVectors.1 (r 0) (r i.succ)))) → ((bundle.normalizedFixedSlope.1 - + bundle.normalizedRootSlope.1 = + ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (r i.succ) (r 0) + + BandVectors.2 (r 0) (r i.succ)))).1) → ((bundle.normalizedFixedSlope.2 - + bundle.normalizedRootSlope.2 = + ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (r i.succ) (r 0) + + BandVectors.2 (r 0) (r i.succ)))).2) → (bundle.normalizedFixedCircle.1.1 = + bundle.normalizedPresentation + (match placement.exteriorIndex.label with + | .A | .B => 1 | .C | .D => 2 | .E | .F => 3) ∧ + s.val = (match placement.exteriorIndex.label with + | .A => if placement.exteriorIndex.first = -1 then 3 else 0 + | .B => if placement.exteriorIndex.first = 1 then 1 else 2 + | .C => if placement.exteriorIndex.second = 0 then 3 else 0 + | .D => if placement.exteriorIndex.second = 0 then 1 else 2 + | .E => if placement.exteriorIndex.first = 0 then 3 else 0 + | .F => if placement.exteriorIndex.first = 0 then 1 else 2) ∧ + (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) = + (match P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot placement.layout row with + | some z => z.oldShift + | none => match placement.exteriorIndex.label with + | .A => if placement.exteriorIndex.first = -1 then -placement.layout.u else + placement.layout.u + | .B => if placement.exteriorIndex.first = 1 then placement.layout.u else + -placement.layout.u + | .C => -placement.layout.v + | .D => placement.layout.v + | .E | .F => 0))))))) := by + intro C D T N h k x bundle placement row r i s hr hr0 hri hcentroid hslopex hslopey +-- BODY + classical + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let cert := placement.layout + let slot : PeriodicSubtileIndex → Fin 3 := fun a => + match a.label with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + -- Equal cell areas select a parent of the supplied presentation. + have area_of_band : ∀ (c : CircleCoordinates) (V : ProtoTile), + 0 < c.1 → BandPrototile c V → TileArea V = Int.toNat c.1 := + CompanionAlignmentGeometry.area_of_band + have positive_parent (j : Fin 3) : 0 < (q j.succ).1 := + CompanionAlignmentGeometry.positive_parent C D T N h k x bundle j + have occurrence_area (a : PeriodicSubtileIndex) : + TileArea (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) = + Int.toNat (q (slot a).succ).1 := CompanionAlignmentGeometry.occurrence_area C D T N h k x + bundle placement area_of_band positive_parent a + have fixed_area : TileArea bundle.normalizedFixed = + Int.toNat bundle.normalizedFixedCircle.1.1.1 := + area_of_band _ _ bundle.normalizedFixedCircle.2 + (TileOdometerBandPrototile _ _ _ bundle.normalized_fixed_odometer) + have area_eq : Int.toNat bundle.normalizedFixedCircle.1.1.1 = + Int.toNat (q (slot placement.exteriorIndex).succ).1 := CompanionAlignmentGeometry.area_eq C + D T N h k x bundle placement occurrence_area fixed_area + have strict23 : (q 3).1 < (q 2).1 := CompanionAlignmentGeometry.strict23 C D T N h k x bundle + have parent_area_injective (j otherSlot : Fin 3) + (heq : Int.toNat (q j.succ).1 = Int.toNat (q otherSlot.succ).1) : j = otherSlot := + CompanionAlignmentGeometry.parent_area_injective C D T N h k x bundle placement + positive_parent strict23 j otherSlot heq + obtain ⟨rotation, hrotation, _⟩ := + BandPredecessorNoCollision q r cfg.proper hr + (bundle.normalized_circle_eq.trans hr0.symm) + have parent_eq : bundle.normalizedFixedCircle.1.1 = + q (slot placement.exteriorIndex).succ := CompanionAlignmentGeometry.parent_eq C D T N h k x + bundle placement r i hri area_eq parent_area_injective rotation hrotation + have fixed_centroid : TileCentroid bundle.normalizedFixed = + TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v + placement.exteriorIndex) := + (ProtoTileObservableExtensionality _ _ placement.fixed_exterior_cells + placement.fixed_exterior_empty_anchor).2.2.2.2.symm + have presented_centroid : + TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v + placement.exteriorIndex) - TileCentroid bundle.normalizedRoot = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q (slot placement.exteriorIndex).succ) (q 0) + + BandVectors.1 (q 0) (q (slot placement.exteriorIndex).succ))) := + CompanionAlignmentGeometry.presented_centroid C D T N h k x bundle placement r i s + hr0 hri hcentroid parent_eq fixed_centroid + let turn : PeriodicSubtileIndex → Fin 4 := fun a => + match a.label with + | .A => if a.first = -1 then 3 else 0 + | .B => if a.first = 1 then 1 else 2 + | .C => if a.second = 0 then 3 else 0 + | .D => if a.second = 0 then 1 else 2 + | .E => if a.first = 0 then 3 else 0 + | .F => if a.first = 0 then 1 else 2 + let shift : PeriodicSubtileIndex → GaussianInt := fun a => + match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => if a.second = 0 then -cert.v else cert.v + | .D => if a.second = 0 then cert.v else -cert.v + | .E => if a.first = 0 then cert.u + cert.v else -cert.u - cert.v + | .F => if a.first = 0 then -cert.u - cert.v else cert.u + cert.v + -- Calculate the twelve literal exterior positions in the common vector basis. + have flip (j : Fin 3) : BandVectors.1 (q 0) (q j.succ) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q 0) := + ((VectorRecursionLaws q cfg.proper.1).2.2.2.2 cfg.proper j).1 + have incoming (j : Fin 3) : BandVectors.1 (q j.succ) (q 0) = + -(⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 0) (q j.succ) := + CompanionAlignmentGeometry.incoming C D T N h k x bundle flip j + have hin1 : BandVectors.1 (q 1) (q 0) = + -(⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 0) (q 1) := incoming 0 + have hin2 : BandVectors.1 (q 2) (q 0) = + -(⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 0) (q 2) := incoming 1 + have hin3 : BandVectors.1 (q 3) (q 0) = + -(⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 0) (q 3) := incoming 2 + have period_u : cert.u = BandVectors.1 (q 0) (q 1) := cert.period_u + have period_v : cert.v = BandVectors.1 (q 0) (q 2) := cert.period_v + obtain ⟨_, _, _, _, hout1, hout2, hout3, _⟩ := + P3055T1ParentVectorNormalForms q cfg + have signed_centroid := P3055T1SignedCentroidNormalForms q cfg + bundle.normalizedCircle bundle.normalizedRoot cert + have translated_centroid (j : Fin 3) (b : Bool) (d : GaussianInt) : + TileCentroid (TileTranslation (cert.P j b) d) = + TileCentroid (cert.P j b) + GaussianRealPoint d := + (TileTranslationFormulas _ _).2.2.2.2.1 + have geometry (a : PeriodicSubtileIndex) + (ha : a = ⟨.A, -1, -1⟩ ∨ a = ⟨.A, 0, -1⟩ ∨ + a = ⟨.C, 1, 0⟩ ∨ a = ⟨.C, 1, 1⟩ ∨ + a = ⟨.E, 0, 1⟩ ∨ a = ⟨.E, -1, 0⟩ ∨ + a = ⟨.B, 1, 1⟩ ∨ a = ⟨.B, 0, 1⟩ ∨ + a = ⟨.D, -1, 0⟩ ∨ a = ⟨.D, -1, -1⟩ ∨ + a = ⟨.F, 0, -1⟩ ∨ a = ⟨.F, 1, 0⟩) : + (TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) - + TileCentroid bundle.normalizedRoot = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (turn a).val * + (BandVectors.1 (q (slot a).succ) (q 0) + + BandVectors.1 (q 0) (q (slot a).succ)))) ∧ + (⟨0, 1⟩ : GaussianInt) ^ (turn a).val * + (if Even (turn a).val then BandVectors.1 (q 0) (q (slot a).succ) + else BandVectors.1 (q (slot a).succ) (q 0)) = shift a := + CompanionAlignmentGeometry.geometry C D T N h k x bundle placement hin1 hin2 hin3 + period_u period_v hout1 hout2 hout3 signed_centroid translated_centroid a ha + have half_point_injective (z w : GaussianInt) + (heq : (1 / 2 : ℝ) • GaussianRealPoint z = + (1 / 2 : ℝ) • GaussianRealPoint w) : z = w := + CompanionAlignmentGeometry.half_point_injective z w heq + -- Nonvanishing makes the four centroid offsets distinct. + have sum_ne (j : Fin 3) : + BandVectors.1 (q j.succ) (q 0) + BandVectors.1 (q 0) (q j.succ) ≠ 0 := + CompanionAlignmentGeometry.sum_ne C D T N h k x bundle positive_parent flip j + have turn_injective (a b : Fin 4) + (heq : (⟨0, 1⟩ : GaussianInt) ^ a.val = + (⟨0, 1⟩ : GaussianInt) ^ b.val) : a = b := CompanionAlignmentGeometry.turn_injective a b heq + obtain ⟨expected_centroid, expected_shift⟩ := + geometry placement.exteriorIndex placement.exterior_index + have turn_eq : s = turn placement.exteriorIndex := CompanionAlignmentGeometry.turn_eq C D T N h + k x bundle placement s presented_centroid half_point_injective sum_ne turn_injective + expected_centroid + have shift_eq : + (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (r 0) (r i.succ) + else BandVectors.1 (r i.succ) (r 0)) = shift placement.exteriorIndex := + CompanionAlignmentGeometry.shift_eq C D T N h k x bundle placement r i s hr0 hri + parent_eq expected_shift turn_eq + refine ⟨?_, ?_, ?_⟩ + · cases hl : placement.exteriorIndex.label <;> simpa [slot, hl] using parent_eq + · rw [turn_eq] + cases hl : placement.exteriorIndex.label <;> simp [turn, hl] + all_goals split_ifs <;> rfl + · rw [shift_eq] + generalize ha : placement.exteriorIndex = a at row ⊢ + generalize hb : placement.centralIndex = b at row + cases row <;> simp [P3996T1SRowTable, shift, cert] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean b/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean new file mode 100644 index 0000000000..ed67fea3bd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean @@ -0,0 +1,1341 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4418T3OuterCompanionAlignment +public import LeanPool.ApollonianSuperharmonic.P4261T1ContactAdjacency +public import LeanPool.ApollonianSuperharmonic.P4261T1CentralCoordinates +public import LeanPool.ApollonianSuperharmonic.P4387T1ParentSlopeNormalForms +public import LeanPool.ApollonianSuperharmonic.P4387T1PlacedCoordinates +public import LeanPool.ApollonianSuperharmonic.P3996T1SRowAlignment +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P4418T3PresentedRowAdjacency] + +/-! +# P4418T3PresentedRowAdjacency + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PresentedRowAdjacencyGeometry + +private theorem selected_cells : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), + let cert := placement.layout + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + (bundle.pieces bundle.selectedSlot bundle.selectedSign).cells = (occurrence + placement.centralIndex).cells ) := by + classical + intro C D T N h k x bundle placement cert occurrence + rw [placement.selected_central_index] + exact placement.piece_layout_cells _ _ + +private theorem selected_centroid : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), + let cert := placement.layout + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + ((bundle.pieces bundle.selectedSlot bundle.selectedSign).cells = (occurrence + placement.centralIndex).cells) → (TileCentroid (bundle.pieces bundle.selectedSlot + bundle.selectedSign) = TileCentroid (occurrence placement.centralIndex)) ) := by + classical + intro C D T N h k x bundle placement cert occurrence selected_cells + apply (ProtoTileObservableExtensionality _ _ selected_cells _).2.2.2.2 + intro he + rw [placement.selected_central_index] + exact placement.piece_layout_empty_anchor _ _ he + +private theorem translate_zero_centroid : + (by + classical + exact + ∀ (V : ProtoTile), TileCentroid (TileTranslation V 0) = TileCentroid V ) := by + classical + intro V + rw [(TileTranslationFormulas _ _).2.2.2.2.1] + simp [] + +private theorem central_centroid : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), + let cert := placement.layout + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let slot : SixSubtileLabel → Fin 3 := fun l => match l with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + let sign : SixSubtileLabel → Bool := fun l => match l with + | .A | .C | .E => true + | .B | .D | .F => false + (∀ (V : ProtoTile), TileCentroid (TileTranslation V 0) = TileCentroid V) → (TileCentroid + (occurrence placement.centralIndex) = TileCentroid (cert.P (slot + placement.centralIndex.label) (sign placement.centralIndex.label))) ) := by + classical + intro C D T N h k x bundle placement cert occurrence slot sign translate_zero_centroid + rcases placement.central_index with he | he | he | he | he | he + all_goals + rw [he] + simp [occurrence, SubtileOccurrenceInterpretation, slot, sign, + translate_zero_centroid] + +private theorem positive_parent : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + (BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedFixedCircle + bundle.normalizedRoot bundle.normalizedFixed bundle.normalizedRootFunction + bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces bundle.functions + bundle.selectedSlot bundle.selectedSign bundle.routedDirection) → ((Fin 4) → ( + let q := bundle.normalizedPresentation + ∀ (j : Fin 3), 0 < (q j.succ).1)) ) := by + classical + intro C D T N h k x bundle placement s q j + let cfg := bundle.configuration + have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 j + have hne := cfg.noLine j.succ + change 0 ≤ (q j.succ).1 at hn + change (q j.succ).1 ≠ 0 at hne + omega + +private theorem area_of_band : + (by + classical + exact + ∀ (c : CircleCoordinates), ∀ (V : ProtoTile), 0 < c.1 → BandPrototile c V → TileArea V = + Int.toNat c.1 ) := by + classical + intro c V hc hV + cases hV with + | line w x hw => simp at hc + | unit z x anchor => simp [TileArea] + | @decompose t ht S V hS hcells hfoot hcentroid => + exact (BandTileSimultaneousInduction t ht V + (BandPrototile.decompose ht hS hcells hfoot hcentroid)).2.1 + +private theorem occurrence_area : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), + let q := bundle.normalizedPresentation + let cert := placement.layout + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let slot : SixSubtileLabel → Fin 3 := fun l => match l with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + (∀ (j : Fin 3), 0 < (q j.succ).1) → ((∀ (c : CircleCoordinates), ∀ (V : ProtoTile), 0 < + c.1 → BandPrototile c V → TileArea V = Int.toNat c.1) → (∀ (a : + PeriodicSubtileIndex), TileArea (occurrence a) = Int.toNat (q (slot + a.label).succ).1)) ) := by + classical + intro C D T N h k x bundle placement q cert occurrence slot positive_parent area_of_band a + cases a with + | mk l m n => + cases l <;> simp only [occurrence, SubtileOccurrenceInterpretation, slot] + all_goals + rw [(TileDiskAreaCovariance _ _).2.2.2.1] + exact area_of_band _ _ (positive_parent _) (cert.outer_occurrence _ _).1 + +private theorem selected_slot : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), (Fin 4) → ( + let q := bundle.normalizedPresentation + let cert := placement.layout + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let slot : SixSubtileLabel → Fin 3 := fun l => match l with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + ((bundle.pieces bundle.selectedSlot bundle.selectedSign).cells = (occurrence + placement.centralIndex).cells) → ((∀ (j : Fin 3), 0 < (q j.succ).1) → ((∀ (a : + PeriodicSubtileIndex), TileArea (occurrence a) = Int.toNat (q (slot a.label).succ).1) + → ((TileArea (bundle.pieces bundle.selectedSlot bundle.selectedSign) = Int.toNat (q + bundle.selectedSlot.succ).1) → (bundle.selectedSlot = slot + placement.centralIndex.label))))) ) := by + classical + intro C D T N h k x bundle placement s q cert occurrence slot selected_cells positive_parent + occurrence_area selected_area + let cfg := bundle.configuration + have heq : Int.toNat (q bundle.selectedSlot.succ).1 = + Int.toNat (q (slot placement.centralIndex.label).succ).1 := by + rw [← selected_area, ← occurrence_area] + exact congrArg Finset.card selected_cells + have hp := positive_parent bundle.selectedSlot + have hq := positive_parent (slot placement.centralIndex.label) + have hc : (q bundle.selectedSlot.succ).1 = + (q (slot placement.centralIndex.label).succ).1 := by omega + have injective (j k : Fin 3) (he : (q j.succ).1 = (q k.succ).1) : j = k := by + have h12 := cfg.order12 + change (q 2).1 < (q 1).1 at h12 + have h23 := cfg.secondProper.2 0 + change (cfg.secondPredecessor 1).1 < (cfg.secondPredecessor 0).1 at h23 + rw [cfg.secondParentOne, cfg.secondChild] at h23 + change (q 3).1 < (q 2).1 at h23 + have h13 := lt_trans h23 h12 + fin_cases j <;> fin_cases k + all_goals first + | rfl + | exact False.elim ((ne_of_lt h12) he) + | exact False.elim ((ne_of_lt h12) he.symm) + | exact False.elim ((ne_of_lt h23) he) + | exact False.elim ((ne_of_lt h23) he.symm) + | exact False.elim ((ne_of_lt h13) he) + | exact False.elim ((ne_of_lt h13) he.symm) + exact injective _ _ hc + +private theorem cyclic_nonzero : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + (∀ (j : Fin 3), 0 < (q j.succ).1) → (∀ (j : Fin 3), BandVectors.1 (q ((j + 2).succ)) (q + ((j + 1).succ)) ≠ 0) ) := by + classical + intro C D T N h k x bundle q positive_parent j + let cfg := bundle.configuration + fin_cases j + · exact VectorNonvanishing _ cfg.proper.1 3 2 (by decide) + (Or.inl (positive_parent 2)) + · exact VectorNonvanishing _ cfg.proper.1 1 3 (by decide) + (Or.inl (positive_parent 0)) + · exact VectorNonvanishing _ cfg.proper.1 2 1 (by decide) + (Or.inl (positive_parent 1)) + +private theorem signed_injective : + (by + classical + exact + ∀ (v : GaussianInt), (v ≠ 0) → (∀ (b : Bool), ∀ (c : Bool), ((if b = true then (1 : ℝ) + else -1) • + ((1 / 2 : ℝ) • (GaussianRealPoint v - + (-(GaussianRealPoint v).2, (GaussianRealPoint v).1))) = + (if c = true then (1 : ℝ) else -1) • + ((1 / 2 : ℝ) • (GaussianRealPoint v - + (-(GaussianRealPoint v).2, (GaussianRealPoint v).1)))) → (b = c)) ) := by + classical + intro v hv b c he + have nonzero : (1 / 2 : ℝ) • (GaussianRealPoint v - + (-(GaussianRealPoint v).2, (GaussianRealPoint v).1)) ≠ (0 : ℝ × ℝ) := by + intro hz + have hx := congrArg Prod.fst hz + have hy := congrArg Prod.snd hz + simp [GaussianRealPoint, -GaussianInt.intCast_re, -GaussianInt.intCast_im] at hx hy + apply hv + apply Zsqrtd.ext + · exact_mod_cast (show (v.re : ℝ) = 0 by linarith) + · exact_mod_cast (show (v.im : ℝ) = 0 by linarith) + have he' := smul_left_injective ℝ nonzero he + cases b <;> cases c <;> first | rfl | norm_num at he' + +private theorem selected_sign : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), + let q := bundle.normalizedPresentation + let cert := placement.layout + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let slot : SixSubtileLabel → Fin 3 := fun l => match l with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + let sign : SixSubtileLabel → Bool := fun l => match l with + | .A | .C | .E => true + | .B | .D | .F => false + (TileCentroid (bundle.pieces bundle.selectedSlot bundle.selectedSign) = TileCentroid + (occurrence placement.centralIndex)) → ((TileCentroid (occurrence + placement.centralIndex) = TileCentroid (cert.P (slot placement.centralIndex.label) + (sign placement.centralIndex.label))) → ((bundle.selectedSlot = slot + placement.centralIndex.label) → ((∀ (j : Fin 3), BandVectors.1 (q ((j + 2).succ)) (q + ((j + 1).succ)) ≠ 0) → ((∀ (v : GaussianInt), (v ≠ 0) → (∀ (b : Bool), ∀ (c : Bool), + ((if b = true then (1 : ℝ) else -1) • ((1 / 2 : ℝ) • (GaussianRealPoint v - + (-(GaussianRealPoint v).2, (GaussianRealPoint v).1))) = (if c = true then (1 : ℝ) + else -1) • ((1 / 2 : ℝ) • (GaussianRealPoint v - (-(GaussianRealPoint v).2, + (GaussianRealPoint v).1)))) → (b = c))) → (bundle.selectedSign = sign + placement.centralIndex.label))))) ) := by + classical + intro C D T N h k x bundle placement q cert occurrence slot sign selected_centroid + central_centroid selected_slot cyclic_nonzero signed_injective + have hc := congrArg (fun a : ℝ × ℝ => a - TileCentroid bundle.normalizedRoot) + (selected_centroid.trans central_centroid) + simp only [bundle.piece_centroid, selected_slot] at hc + rw [(cert.outer_occurrence _ _).2.2] at hc + exact signed_injective _ (cyclic_nonzero _) _ _ hc + +private theorem fixed_circle : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), ∀ (row : + BandOrderedGeneralSelectedContactRow bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedRoot placement.layout + placement.exteriorIndex placement.centralIndex), ∀ (r : Fin 4 → CircleCoordinates), ∀ + (i : Fin 3), ∀ (s : Fin 4), + let q := bundle.normalizedPresentation + let slot : SixSubtileLabel → Fin 3 := fun l => match l with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + (bundle.normalizedFixedCircle.1.1 = + bundle.normalizedPresentation ((match placement.exteriorIndex.label with + | SixSubtileLabel.A => (1 : Fin (4 : ℕ)) + | SixSubtileLabel.B => (1 : Fin (4 : ℕ)) + | SixSubtileLabel.C => (2 : Fin (4 : ℕ)) + | SixSubtileLabel.D => (2 : Fin (4 : ℕ)) + | SixSubtileLabel.E => (3 : Fin (4 : ℕ)) + | SixSubtileLabel.F => (3 : Fin (4 : ℕ)) + )) ∧ + ((↑s : ℕ) = (match placement.exteriorIndex.label with + | SixSubtileLabel.A => if placement.exteriorIndex.first = (-1 : ℤ) then (3 : ℕ) + else (0 : ℕ) + | SixSubtileLabel.B => if placement.exteriorIndex.first = (1 : ℤ) then (1 : ℕ) else + (2 : ℕ) + | SixSubtileLabel.C => if placement.exteriorIndex.second = (0 : ℤ) then (3 : ℕ) + else (0 : ℕ) + | SixSubtileLabel.D => if placement.exteriorIndex.second = (0 : ℤ) then (1 : ℕ) + else (2 : ℕ) + | SixSubtileLabel.E => if placement.exteriorIndex.first = (0 : ℤ) then (3 : ℕ) else + (0 : ℕ) + | SixSubtileLabel.F => if placement.exteriorIndex.first = (0 : ℤ) then (1 : ℕ) else + (2 : ℕ) + )) ∧ ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) + * if Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ) else + BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ)))) = match P3996T1SRowTable + bundle.normalizedPresentation bundle.configuration bundle.normalizedCircle + bundle.normalizedRoot placement.layout row with + | some z => z.oldShift + | none => + (match placement.exteriorIndex.label with + | SixSubtileLabel.A => if placement.exteriorIndex.first = (-1 : ℤ) then + -placement.layout.u else placement.layout.u + | SixSubtileLabel.B => if placement.exteriorIndex.first = (1 : ℤ) then + placement.layout.u else -placement.layout.u + | SixSubtileLabel.C => -placement.layout.v + | SixSubtileLabel.D => placement.layout.v + | SixSubtileLabel.E => (0 : ℤ√(-1 : ℤ)) + | SixSubtileLabel.F => (0 : ℤ√(-1 : ℤ)) + )) → + (bundle.normalizedFixedCircle.1.1 = q (slot placement.exteriorIndex.label).succ) ) := by + classical + intro C D T N h k x bundle placement row r i s q slot outer + cases he : placement.exteriorIndex.label <;> simpa [slot, he, q] using outer.1 + +private theorem selected_slope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), ∀ (p : ℝ × ℝ), (PartialOdometerSlope + (bundle.functions bundle.selectedSlot bundle.selectedSign) = some p) → ( + let q := bundle.normalizedPresentation + let slot : SixSubtileLabel → Fin 3 := fun l => match l with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + let sign : SixSubtileLabel → Bool := fun l => match l with + | .A | .C | .E => true + | .B | .D | .F => false + (bundle.selectedSlot = slot placement.centralIndex.label) → ((bundle.selectedSign = sign + placement.centralIndex.label) → (p - bundle.normalizedRootSlope = (if sign + placement.centralIndex.label = true then (1 : ℝ) else -1) • ((1 / 2 : ℝ) • + GaussianRealPoint ((1 + (⟨0, 1⟩ : GaussianInt)) * BandVectors.2 (q ((slot + placement.centralIndex.label + 2).succ)) (q ((slot placement.centralIndex.label + + 1).succ))))))) ) := by + classical + intro C D T N h k x bundle placement p hp q slot sign selected_slot selected_sign + let cfg := bundle.configuration + have raw : p - bundle.normalizedRootSlope = + (if bundle.selectedSign = true then (1 : ℝ) else -1) • + ((1 / 2 : ℝ) • GaussianRealPoint + ((1 + (⟨0, 1⟩ : GaussianInt)) * + BandVectors.2 (q ((bundle.selectedSlot + 2).succ)) + (q ((bundle.selectedSlot + 1).succ)))) := by + rcases bundle.piece_slope bundle.selectedSlot bundle.selectedSign with + hz | ⟨p₀, p₁, hp₀, hp₁, hx, hy⟩ + · exact False.elim (cfg.noLine _ hz) + · have he₀ : p₀ = bundle.normalizedRootSlope := + Option.some.inj (hp₀.symm.trans bundle.normalized_root_slope) + have he₁ : p₁ = p := Option.some.inj (hp₁.symm.trans hp) + subst p₀ + subst p₁ + cases hs : bundle.selectedSign <;> apply Prod.ext + all_goals + simp [hs, GaussianRealPoint, q, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] at hx hy ⊢ + linarith + simpa only [selected_slot, selected_sign] using raw + +private theorem affine_incoming : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + ∀ (j : Fin 3), BandVectors.2 (q j.succ) (q 0) = (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q + 0) (q j.succ) ) := by + classical + intro C D T N h k x bundle q j + let cfg := bundle.configuration + have hf := ((VectorRecursionLaws q cfg.proper.1).2.2.2.2 cfg.proper j).2 + rw [hf] + ext <;> simp + +private theorem fixed_slope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), ∀ (row : + BandOrderedGeneralSelectedContactRow bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedRoot placement.layout + placement.exteriorIndex placement.centralIndex), ∀ (r : Fin 4 → CircleCoordinates), ∀ + (i : Fin 3), ∀ (s : Fin 4), (r (0 : Fin (4 : ℕ)) = bundle.normalizedCircle.1.1) → ((r + i.succ = + bundle.normalizedFixedCircle.1.1) → + ((bundle.normalizedFixedSlope.1 - bundle.normalizedRootSlope.1 = ((1 / 2 : ℝ) • + GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 + (r i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r + i.succ)))).1) → ((bundle.normalizedFixedSlope.2 - bundle.normalizedRootSlope.2 = ((1 + / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * + (BandVectors.2 (r i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.2 (r (0 : Fin (4 : ℕ))) + (r i.succ)))).2) → ( + let q := bundle.normalizedPresentation + let slot : SixSubtileLabel → Fin 3 := fun l => match l with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + (bundle.normalizedFixedCircle.1.1 = + bundle.normalizedPresentation ((match placement.exteriorIndex.label with + | SixSubtileLabel.A => (1 : Fin (4 : ℕ)) + | SixSubtileLabel.B => (1 : Fin (4 : ℕ)) + | SixSubtileLabel.C => (2 : Fin (4 : ℕ)) + | SixSubtileLabel.D => (2 : Fin (4 : ℕ)) + | SixSubtileLabel.E => (3 : Fin (4 : ℕ)) + | SixSubtileLabel.F => (3 : Fin (4 : ℕ)) + )) ∧ + ((↑s : ℕ) = (match placement.exteriorIndex.label with + | SixSubtileLabel.A => if placement.exteriorIndex.first = (-1 : ℤ) then (3 : ℕ) + else (0 : ℕ) + | SixSubtileLabel.B => if placement.exteriorIndex.first = (1 : ℤ) then (1 : ℕ) else + (2 : ℕ) + | SixSubtileLabel.C => if placement.exteriorIndex.second = (0 : ℤ) then (3 : ℕ) + else (0 : ℕ) + | SixSubtileLabel.D => if placement.exteriorIndex.second = (0 : ℤ) then (1 : ℕ) + else (2 : ℕ) + | SixSubtileLabel.E => if placement.exteriorIndex.first = (0 : ℤ) then (3 : ℕ) else + (0 : ℕ) + | SixSubtileLabel.F => if placement.exteriorIndex.first = (0 : ℤ) then (1 : ℕ) else + (2 : ℕ) + )) ∧ ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) + * if Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ) else + BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ)))) = match P3996T1SRowTable + bundle.normalizedPresentation bundle.configuration bundle.normalizedCircle + bundle.normalizedRoot placement.layout row with + | some z => z.oldShift + | none => + (match placement.exteriorIndex.label with + | SixSubtileLabel.A => if placement.exteriorIndex.first = (-1 : ℤ) then + -placement.layout.u else placement.layout.u + | SixSubtileLabel.B => if placement.exteriorIndex.first = (1 : ℤ) then + placement.layout.u else -placement.layout.u + | SixSubtileLabel.C => -placement.layout.v + | SixSubtileLabel.D => placement.layout.v + | SixSubtileLabel.E => (0 : ℤ√(-1 : ℤ)) + | SixSubtileLabel.F => (0 : ℤ√(-1 : ℤ)) + )) → + ((bundle.normalizedFixedCircle.1.1 = q (slot placement.exteriorIndex.label).succ) → + ((∀ (j : Fin 3), BandVectors.2 (q j.succ) (q 0) = (⟨0, 1⟩ : GaussianInt) * + BandVectors.2 (q 0) (q j.succ)) → (bundle.normalizedFixedSlope - + bundle.normalizedRootSlope = (1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : GaussianInt) + ^ ((match placement.exteriorIndex.label with + | .A => if placement.exteriorIndex.first = -1 then 3 else 0 + | .B => if placement.exteriorIndex.first = 1 then 1 else 2 + | .C => if placement.exteriorIndex.second = 0 then 3 else 0 + | .D => if placement.exteriorIndex.second = 0 then 1 else 2 + | .E => if placement.exteriorIndex.first = 0 then 3 else 0 + | .F => if placement.exteriorIndex.first = 0 then 1 else 2 + )) * ((⟨0, 1⟩ : GaussianInt) * + BandVectors.2 (q 0) (q (slot placement.exteriorIndex.label).succ) + BandVectors.2 (q + 0) (q (slot placement.exteriorIndex.label).succ)))))))))) ) := by + classical + intro C D T N h k x bundle placement row r i s hr0 hri hslopex hslopey q slot outer + fixed_circle affine_incoming + have he : bundle.normalizedFixedSlope - bundle.normalizedRootSlope = + (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (r i.succ) (r 0) + + BandVectors.2 (r 0) (r i.succ))) := Prod.ext hslopex hslopey + have hroot : r 0 = q 0 := hr0.trans bundle.normalized_circle_eq.symm + rw [hroot, hri, fixed_circle, affine_incoming, outer.2.1] at he + exact he + +private theorem selected_odometer : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (C' : BandCircle), + (C'.1.1 = bundle.normalizedPresentation bundle.selectedSlot.succ) → (TileOdometer + C'.1.1 (bundle.pieces bundle.selectedSlot bundle.selectedSign) (bundle.functions + bundle.selectedSlot bundle.selectedSign)) ) := by + classical + intro C D T N h k x bundle C' hC' + rw [hC'] + exact bundle.piece_odometer _ _ + +private theorem row_geometry : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let cert := placement.layout + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row' : + BandOrderedGeneralSelectedContactRow q cfg bundle.normalizedCircle + bundle.normalizedRoot cert a b), (TileCentroid bundle.normalizedFixed = TileCentroid + (occurrence a)) → ((TileCentroid (bundle.pieces bundle.selectedSlot + bundle.selectedSign) = + TileCentroid (occurrence b)) → (∀ (z : P3996T1SRowParameters), (P3996T1SRowTable + q cfg bundle.normalizedCircle + bundle.normalizedRoot cert row' = some z) → (ProperBandQuadruple z.predecessor ∧ (if + z.childIsExterior then TileCentroid (bundle.pieces bundle.selectedSlot + bundle.selectedSign) - TileCentroid bundle.normalizedFixed else TileCentroid + bundle.normalizedFixed - TileCentroid (bundle.pieces bundle.selectedSlot + bundle.selectedSign)) = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ + z.rotation.val * (BandVectors.1 (z.predecessor z.parentSlot.succ) (z.predecessor + 0) + BandVectors.1 (z.predecessor 0) (z.predecessor z.parentSlot.succ)))))) ) := by + classical + intro C D T N h k x bundle placement q cfg cert occurrence a b row' hfixed hselected z hz + obtain ⟨hproper, _, _, _, _, _, hindices, _, _, hc, _⟩ := + P3996T1SRowAlignment q cfg bundle.normalizedCircle + bundle.normalizedRoot cert _ _ row' z hz + refine ⟨hproper, ?_⟩ + cases hf : z.childIsExterior + · simp only [hf, Bool.false_eq_true, ↓reduceIte] at hindices ⊢ + rw [hselected, hfixed] + simpa only [hindices.1, hindices.2] using hc + · simp only [hf, ↓reduceIte] at hindices ⊢ + rw [hselected, hfixed] + simpa only [hindices.1, hindices.2] using hc + +private theorem sub : + (by + classical + exact + ∀ (z : P3996T1SRowParameters), ∀ (A : BandCircle), ∀ (B : BandCircle), ∀ (V : + ProtoTile), ∀ (W : ProtoTile), ∀ (f : PartialOdometer), ∀ (g : PartialOdometer), ∀ + (pV : ℝ × ℝ), ∀ (pW : ℝ × ℝ), (TileOdometer A.1.1 V f) → ((TileOdometer B.1.1 W g) → + ((PartialOdometerSlope f = some pV) → ((PartialOdometerSlope g = some pW) → + ((ProperBandQuadruple z.predecessor) → ((z.predecessor 0 = A.1.1) → ((z.predecessor + z.parentSlot.succ = B.1.1) → ((TileCentroid W - TileCentroid V = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.1 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.1 (z.predecessor 0) (z.predecessor z.parentSlot.succ)))) → ((pW - + pV = (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.2 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.2 (z.predecessor 0) (z.predecessor z.parentSlot.succ)))) → + (ProperBandQuadruple z.predecessor ∧ z.predecessor 0 = A.1.1 ∧ z.predecessor + z.parentSlot.succ = B.1.1 ∧ TileCentroid W - TileCentroid V = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * (BandVectors.1 + (z.predecessor z.parentSlot.succ) (z.predecessor 0) + BandVectors.1 + (z.predecessor 0) (z.predecessor z.parentSlot.succ))) ∧ pW - pV = (1 / 2 : ℝ) + • GaussianRealPoint ((-⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.2 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.2 (z.predecessor 0) (z.predecessor z.parentSlot.succ))) ∧ + SubtileLatticeAdjacent A B V W f g))))))))) ) := by + classical + intro z A B V W f g pV pW hV hW hf hg hr h0 hj hc hs + exact ⟨hr, h0, hj, hc, hs, hV, hW, pV, pW, hf, hg, + z.predecessor, z.parentSlot, z.rotation, hr, h0, hj, hc, + congrArg Prod.fst hs, congrArg Prod.snd hs⟩ + +private theorem left : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (C' : BandCircle), ∀ + (p : ℝ × ℝ), (PartialOdometerSlope (bundle.functions bundle.selectedSlot + bundle.selectedSign) = some p) → ((TileOdometer C'.1.1 (bundle.pieces + bundle.selectedSlot bundle.selectedSign) (bundle.functions bundle.selectedSlot + bundle.selectedSign)) → (∀ (r' : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), ∀ (e : + Bool), (ProperBandQuadruple r') → ((r' 0 = bundle.normalizedFixedCircle.1.1) → + ((C'.1.1 = bundle.normalizedFixedCircle.1.1) → ((TileCentroid (bundle.pieces + bundle.selectedSlot bundle.selectedSign) - + TileCentroid bundle.normalizedFixed = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.1 (r' j.succ) (r' 0))) → ((p - + bundle.normalizedFixedSlope = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.2 (r' j.succ) (r' 0))) → (C' = + bundle.normalizedFixedCircle ∧ LeftLatticeAdjacent bundle.normalizedFixedCircle + bundle.normalizedFixed (bundle.pieces bundle.selectedSlot bundle.selectedSign) + bundle.normalizedFixedFunction (bundle.functions bundle.selectedSlot + bundle.selectedSign)))))))) ) := by + classical + intro C D T N h k x bundle C' p hp selected_odometer r' j e hr' h0 heq hc hs + refine ⟨Subtype.ext (Subtype.ext heq), bundle.normalized_fixed_odometer, + ?_, bundle.normalizedFixedSlope, p, bundle.normalized_fixed_slope, hp, + Or.inr ⟨r', j, e, hr', h0, hc, ?_, ?_⟩⟩ + · simpa only [heq] using selected_odometer + · cases e <;> simpa [GaussianRealPoint] using congrArg Prod.fst hs + · cases e <;> simpa [GaussianRealPoint] using congrArg Prod.snd hs + +end PresentedRowAdjacencyGeometry + +namespace PresentedAdjacencyConclusion + +private theorem presentedAdjacency : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot + bundle.selectedSign bundle.routedDirection), ∀ (row : + BandOrderedGeneralSelectedContactRow bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedRoot placement.layout + placement.exteriorIndex placement.centralIndex), ∀ (r : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (C' : BandCircle), ∀ + (p : ℝ × ℝ), (PartialOdometerSlope (bundle.functions bundle.selectedSlot + bundle.selectedSign) = some p) → ( + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let cert := placement.layout + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let slot : SixSubtileLabel → Fin 3 := fun l => match l with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + let sign : SixSubtileLabel → Bool := fun l => match l with + | .A | .C | .E => true + | .B | .D | .F => false + (bundle.normalizedFixedCircle.1.1 = + bundle.normalizedPresentation ((match placement.exteriorIndex.label with + | SixSubtileLabel.A => (1 : Fin (4 : ℕ)) + | SixSubtileLabel.B => (1 : Fin (4 : ℕ)) + | SixSubtileLabel.C => (2 : Fin (4 : ℕ)) + | SixSubtileLabel.D => (2 : Fin (4 : ℕ)) + | SixSubtileLabel.E => (3 : Fin (4 : ℕ)) + | SixSubtileLabel.F => (3 : Fin (4 : ℕ)) + )) ∧ + ((↑s : ℕ) = (match placement.exteriorIndex.label with + | SixSubtileLabel.A => if placement.exteriorIndex.first = (-1 : ℤ) then (3 : ℕ) + else (0 : ℕ) + | SixSubtileLabel.B => if placement.exteriorIndex.first = (1 : ℤ) then (1 : ℕ) else + (2 : ℕ) + | SixSubtileLabel.C => if placement.exteriorIndex.second = (0 : ℤ) then (3 : ℕ) + else (0 : ℕ) + | SixSubtileLabel.D => if placement.exteriorIndex.second = (0 : ℤ) then (1 : ℕ) + else (2 : ℕ) + | SixSubtileLabel.E => if placement.exteriorIndex.first = (0 : ℤ) then (3 : ℕ) else + (0 : ℕ) + | SixSubtileLabel.F => if placement.exteriorIndex.first = (0 : ℤ) then (1 : ℕ) else + (2 : ℕ) + )) ∧ ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) + * if Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ) else + BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ)))) = match P3996T1SRowTable + bundle.normalizedPresentation bundle.configuration bundle.normalizedCircle + bundle.normalizedRoot placement.layout row with + | some z => z.oldShift + | none => + (match placement.exteriorIndex.label with + | SixSubtileLabel.A => if placement.exteriorIndex.first = (-1 : ℤ) then + -placement.layout.u else placement.layout.u + | SixSubtileLabel.B => if placement.exteriorIndex.first = (1 : ℤ) then + placement.layout.u else -placement.layout.u + | SixSubtileLabel.C => -placement.layout.v + | SixSubtileLabel.D => placement.layout.v + | SixSubtileLabel.E => (0 : ℤ√(-1 : ℤ)) + | SixSubtileLabel.F => (0 : ℤ√(-1 : ℤ)) + )) → ((TileCentroid + (bundle.pieces bundle.selectedSlot bundle.selectedSign) = TileCentroid (occurrence + placement.centralIndex)) → ((TileCentroid bundle.normalizedFixed = TileCentroid + (occurrence placement.exteriorIndex)) → ((TileCentroid (occurrence + placement.centralIndex) = TileCentroid (cert.P (slot placement.centralIndex.label) + (sign placement.centralIndex.label))) → ((C'.1.1 = q (slot + placement.centralIndex.label).succ) → ((bundle.normalizedFixedCircle.1.1 = + bundle.normalizedPresentation (slot placement.exteriorIndex.label).succ) → ((p - + bundle.normalizedRootSlope = (if sign placement.centralIndex.label = true then (1 : + ℝ) else -1) • ((1 / 2 : ℝ) • GaussianRealPoint ((1 + (⟨0, 1⟩ : GaussianInt)) * + BandVectors.2 (q ((slot placement.centralIndex.label + 2).succ)) (q ((slot + placement.centralIndex.label + 1).succ))))) → ((bundle.normalizedFixedSlope - + bundle.normalizedRootSlope = (1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : GaussianInt) + ^ (((match placement.exteriorIndex.label with + | .A => if placement.exteriorIndex.first = -1 then 3 else 0 + | .B => if placement.exteriorIndex.first = 1 then 1 else 2 + | .C => if placement.exteriorIndex.second = 0 then 3 else 0 + | .D => if placement.exteriorIndex.second = 0 then 1 else 2 + | .E => if placement.exteriorIndex.first = 0 then 3 else 0 + | .F => if placement.exteriorIndex.first = 0 then 1 else 2 + ) )) * ((⟨0, 1⟩ : GaussianInt) * + BandVectors.2 (q 0) (q (slot placement.exteriorIndex.label).succ) + BandVectors.2 (q + 0) (q (slot placement.exteriorIndex.label).succ)))) → ((TileOdometer C'.1.1 + (bundle.pieces bundle.selectedSlot bundle.selectedSign) (bundle.functions + bundle.selectedSlot bundle.selectedSign)) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : + PeriodicSubtileIndex), ∀ (row' : BandOrderedGeneralSelectedContactRow q cfg + bundle.normalizedCircle bundle.normalizedRoot cert a b), (TileCentroid + bundle.normalizedFixed = TileCentroid (occurrence a)) → ((TileCentroid (bundle.pieces + bundle.selectedSlot bundle.selectedSign) = TileCentroid (occurrence b)) → (∀ (z : + P3996T1SRowParameters), (P3996T1SRowTable q cfg bundle.normalizedCircle + bundle.normalizedRoot cert row' = some z) → (ProperBandQuadruple z.predecessor ∧ (if + z.childIsExterior then TileCentroid (bundle.pieces bundle.selectedSlot + bundle.selectedSign) - TileCentroid bundle.normalizedFixed else TileCentroid + bundle.normalizedFixed - TileCentroid (bundle.pieces bundle.selectedSlot + bundle.selectedSign)) = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ + z.rotation.val * (BandVectors.1 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.1 (z.predecessor 0) (z.predecessor z.parentSlot.succ))))))) → ((∀ (z : + P3996T1SRowParameters), ∀ (A : BandCircle), ∀ (B : BandCircle), ∀ (V : ProtoTile), + ∀ (W : ProtoTile), ∀ (f : PartialOdometer), ∀ (g : PartialOdometer), ∀ (pV : ℝ × ℝ), + ∀ (pW : ℝ × ℝ), (TileOdometer A.1.1 V f) → ((TileOdometer B.1.1 W g) → + ((PartialOdometerSlope f = some pV) → ((PartialOdometerSlope g = some pW) → + ((ProperBandQuadruple z.predecessor) → ((z.predecessor 0 = A.1.1) → ((z.predecessor + z.parentSlot.succ = B.1.1) → ((TileCentroid W - TileCentroid V = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * (BandVectors.1 + (z.predecessor z.parentSlot.succ) (z.predecessor 0) + BandVectors.1 (z.predecessor 0) + (z.predecessor z.parentSlot.succ)))) → ((pW - pV = (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * (BandVectors.2 (z.predecessor + z.parentSlot.succ) (z.predecessor 0) + BandVectors.2 (z.predecessor 0) (z.predecessor + z.parentSlot.succ)))) → (ProperBandQuadruple z.predecessor ∧ z.predecessor 0 = A.1.1 + ∧ z.predecessor z.parentSlot.succ = B.1.1 ∧ TileCentroid W - TileCentroid V = (1 / 2 + : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * (BandVectors.1 + (z.predecessor z.parentSlot.succ) (z.predecessor 0) + BandVectors.1 (z.predecessor 0) + (z.predecessor z.parentSlot.succ))) ∧ pW - pV = (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * (BandVectors.2 (z.predecessor + z.parentSlot.succ) (z.predecessor 0) + BandVectors.2 (z.predecessor 0) (z.predecessor + z.parentSlot.succ))) ∧ SubtileLatticeAdjacent A B V W f g)))))))))) → ((∀ (r' : Fin 4 + → CircleCoordinates), ∀ (j : Fin 3), ∀ (e : Bool), (ProperBandQuadruple r') → ((r' 0 + = bundle.normalizedFixedCircle.1.1) → ((C'.1.1 = bundle.normalizedFixedCircle.1.1) → + ((TileCentroid (bundle.pieces bundle.selectedSlot bundle.selectedSign) - TileCentroid + bundle.normalizedFixed = (if e = true then (1 : ℝ) else -1) • GaussianRealPoint + (BandVectors.1 (r' j.succ) (r' 0))) → ((p - bundle.normalizedFixedSlope = (if e = + true then (1 : ℝ) else -1) • GaussianRealPoint (BandVectors.2 (r' j.succ) (r' 0))) → + (C' = bundle.normalizedFixedCircle ∧ LeftLatticeAdjacent bundle.normalizedFixedCircle + bundle.normalizedFixed (bundle.pieces bundle.selectedSlot bundle.selectedSign) + bundle.normalizedFixedFunction (bundle.functions bundle.selectedSlot + bundle.selectedSign))))))) → ((BandVectors.2 (bundle.normalizedPresentation (1 : Fin + (4 : ℕ))) (bundle.normalizedPresentation (3 : Fin (4 : ℕ))) = -BandVectors.2 + (bundle.normalizedPresentation (2 : Fin (4 : ℕ))) (bundle.normalizedPresentation (1 : + Fin (4 : ℕ))) - BandVectors.2 (bundle.normalizedPresentation (3 : Fin (4 : ℕ))) + (bundle.normalizedPresentation (2 : Fin (4 : ℕ)))) → ((BandVectors.2 + (bundle.normalizedPresentation (3 : Fin (4 : ℕ))) (bundle.normalizedPresentation (1 : + Fin (4 : ℕ))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * (BandVectors.2 + (bundle.normalizedPresentation (2 : Fin (4 : ℕ))) (bundle.normalizedPresentation (1 : + Fin (4 : ℕ))) + BandVectors.2 (bundle.normalizedPresentation (3 : Fin (4 : ℕ))) + (bundle.normalizedPresentation (2 : Fin (4 : ℕ))))) → ((BandVectors.2 + (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (bundle.normalizedPresentation (1 : + Fin (4 : ℕ))) = BandVectors.2 (bundle.normalizedPresentation (2 : Fin (4 : ℕ))) + (bundle.normalizedPresentation (1 : Fin (4 : ℕ))) - -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * (BandVectors.2 (bundle.normalizedPresentation (2 : Fin (4 : ℕ))) + (bundle.normalizedPresentation (1 : Fin (4 : ℕ))) + BandVectors.2 + (bundle.normalizedPresentation (3 : Fin (4 : ℕ))) (bundle.normalizedPresentation (2 : + Fin (4 : ℕ))))) → ((BandVectors.2 (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) + (bundle.normalizedPresentation (2 : Fin (4 : ℕ))) = BandVectors.2 + (bundle.normalizedPresentation (3 : Fin (4 : ℕ))) (bundle.normalizedPresentation (2 : + Fin (4 : ℕ))) + -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 + (bundle.normalizedPresentation (2 : Fin (4 : ℕ))) (bundle.normalizedPresentation (1 : + Fin (4 : ℕ)))) → ((BandVectors.2 (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) + (bundle.normalizedPresentation (3 : Fin (4 : ℕ))) = -BandVectors.2 + (bundle.normalizedPresentation (2 : Fin (4 : ℕ))) (bundle.normalizedPresentation (1 : + Fin (4 : ℕ))) - BandVectors.2 (bundle.normalizedPresentation (3 : Fin (4 : ℕ))) + (bundle.normalizedPresentation (2 : Fin (4 : ℕ))) + -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (bundle.normalizedPresentation (3 : Fin (4 : ℕ))) + (bundle.normalizedPresentation (2 : Fin (4 : ℕ)))) → ((BandVectors.2 + (cfg.firstPredecessor (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) + + BandVectors.2 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor (2 : Fin + (4 : ℕ))) = ((1 : GaussianInt) + -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.2 + (bundle.normalizedPresentation (2 : Fin (4 : ℕ))) (bundle.normalizedPresentation (1 : + Fin (4 : ℕ)))) → ((BandVectors.2 (cfg.firstPredecessor (3 : Fin (4 : ℕ))) + (cfg.firstPredecessor (0 : Fin (4 : ℕ))) + BandVectors.2 (cfg.firstPredecessor (0 : + Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))) = (-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) - (1 : GaussianInt)) * (BandVectors.2 (bundle.normalizedPresentation (2 + : Fin (4 : ℕ))) (bundle.normalizedPresentation (1 : Fin (4 : ℕ))) + BandVectors.2 + (bundle.normalizedPresentation (3 : Fin (4 : ℕ))) (bundle.normalizedPresentation (2 : + Fin (4 : ℕ))))) → ((BandVectors.2 (cfg.secondPredecessor (1 : Fin (4 : ℕ))) + (cfg.secondPredecessor (0 : Fin (4 : ℕ))) + BandVectors.2 (cfg.secondPredecessor (0 : + Fin (4 : ℕ))) (cfg.secondPredecessor (1 : Fin (4 : ℕ))) = ((1 : GaussianInt) + -(⟨(0 + : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.2 (bundle.normalizedPresentation (3 : + Fin (4 : ℕ))) (bundle.normalizedPresentation (2 : Fin (4 : ℕ)))) → ( + let S := bundle.pieces bundle.selectedSlot bundle.selectedSign + let f := bundle.functions bundle.selectedSlot bundle.selectedSign + let directed := fun (z : P3996T1SRowParameters) + (A B : BandCircle) (V W : ProtoTile) (f g : PartialOdometer) + (pV pW : ℝ × ℝ) => + ProperBandQuadruple z.predecessor ∧ + z.predecessor 0 = A.1.1 ∧ + z.predecessor z.parentSlot.succ = B.1.1 ∧ + TileCentroid W - TileCentroid V = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.1 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.1 (z.predecessor 0) (z.predecessor z.parentSlot.succ))) ∧ + pW - pV = (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.2 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.2 (z.predecessor 0) (z.predecessor z.parentSlot.succ))) ∧ + SubtileLatticeAdjacent A B V W f g + match P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot placement.layout row with + | none => C' = bundle.normalizedFixedCircle ∧ + LeftLatticeAdjacent bundle.normalizedFixedCircle bundle.normalizedFixed S + bundle.normalizedFixedFunction f + | some z => + if z.childIsExterior then + directed z bundle.normalizedFixedCircle C' bundle.normalizedFixed S + bundle.normalizedFixedFunction f bundle.normalizedFixedSlope p + else + directed z C' bundle.normalizedFixedCircle S bundle.normalizedFixed + f bundle.normalizedFixedFunction p + bundle.normalizedFixedSlope))))))))))))))))))))) ) := by + classical + intro C D T N h k x bundle placement row r i s C' p hp q cfg cert occurrence slot sign outer + selected_centroid fixed_centroid central_centroid selected_circle fixed_circle + selected_slope fixed_slope selected_odometer row_geometry sub left a13 a31 a01 a02 a03 + sum12 sum13 sum23 + generalize ha : placement.exteriorIndex = a at row fixed_circle fixed_centroid fixed_slope ⊢ + generalize hb : placement.centralIndex = b at row selected_circle + rw [hb] at selected_slope selected_centroid central_centroid + cases row + case' positiveL1 hne presentation => + simp only [P3996T1SRowTable] + apply left cfg.firstPredecessor 1 true cfg.firstProper + · exact cfg.firstChild.trans fixed_circle.symm + · exact selected_circle.trans fixed_circle.symm + · rw [fixed_centroid, selected_centroid, central_centroid] + norm_num [slot, sign, Fin.succ] + simp only [cfg.firstChild, cfg.firstParentTwo] + rw [← neg_sub, presentation] + simp + case' positiveL2 hne presentation => + simp only [P3996T1SRowTable] + apply left cfg.firstPredecessor 2 true cfg.firstProper + · exact cfg.firstChild.trans fixed_circle.symm + · exact selected_circle.trans fixed_circle.symm + · rw [fixed_centroid, selected_centroid, central_centroid] + norm_num [slot, sign, Fin.succ] + simp only [cfg.firstChild, cfg.firstParentThree] + rw [← neg_sub, presentation] + simp + case' positiveL3 hne presentation => + simp only [P3996T1SRowTable] + apply left cfg.secondPredecessor 0 true cfg.secondProper + · exact cfg.secondChild.trans fixed_circle.symm + · exact selected_circle.trans fixed_circle.symm + · rw [fixed_centroid, selected_centroid, central_centroid] + norm_num [slot, sign, Fin.succ] + simp only [cfg.secondChild, cfg.secondParentOne] + rw [← neg_sub, presentation] + simp + case' reflectedL1 hne presentation => + simp only [P3996T1SRowTable] + apply left cfg.firstPredecessor 1 false cfg.firstProper + · exact cfg.firstChild.trans fixed_circle.symm + · exact selected_circle.trans fixed_circle.symm + · rw [fixed_centroid, selected_centroid, central_centroid] + norm_num [slot, sign, Fin.succ] + simp only [cfg.firstChild, cfg.firstParentTwo] + rw [← neg_sub, presentation] + case' reflectedL2 hne presentation => + simp only [P3996T1SRowTable] + apply left cfg.firstPredecessor 2 false cfg.firstProper + · exact cfg.firstChild.trans fixed_circle.symm + · exact selected_circle.trans fixed_circle.symm + · rw [fixed_centroid, selected_centroid, central_centroid] + norm_num [slot, sign, Fin.succ] + simp only [cfg.firstChild, cfg.firstParentThree] + rw [← neg_sub, presentation] + case' reflectedL3 hne presentation => + simp only [P3996T1SRowTable] + apply left cfg.secondPredecessor 0 false cfg.secondProper + · exact cfg.secondChild.trans fixed_circle.symm + · exact selected_circle.trans fixed_circle.symm + · rw [fixed_centroid, selected_centroid, central_centroid] + norm_num [slot, sign, Fin.succ] + simp only [cfg.secondChild, cfg.secondParentOne] + rw [← neg_sub, presentation] + case' positiveS1 presentation => + have geo := row_geometry _ _ (.positiveS1 presentation) + fixed_centroid selected_centroid _ rfl + simp only [P3996T1SRowTable, ↓reduceIte] + refine sub _ _ _ _ _ _ _ _ _ bundle.normalized_fixed_odometer selected_odometer + bundle.normalized_fixed_slope hp geo.1 ?_ ?_ geo.2 ?_ + · exact cfg.firstChild.trans fixed_circle.symm + · exact cfg.firstParentTwo.trans selected_circle.symm + case' positiveS2 presentation => + have geo := row_geometry _ _ (.positiveS2 presentation) + fixed_centroid selected_centroid _ rfl + simp only [P3996T1SRowTable, ↓reduceIte] + refine sub _ _ _ _ _ _ _ _ _ bundle.normalized_fixed_odometer selected_odometer + bundle.normalized_fixed_slope hp geo.1 ?_ ?_ geo.2 ?_ + · exact cfg.firstChild.trans fixed_circle.symm + · exact cfg.firstParentThree.trans selected_circle.symm + case' positiveS3 presentation => + have geo := row_geometry _ _ (.positiveS3 presentation) + fixed_centroid selected_centroid _ rfl + simp only [P3996T1SRowTable, ↓reduceIte] + refine sub _ _ _ _ _ _ _ _ _ bundle.normalized_fixed_odometer selected_odometer + bundle.normalized_fixed_slope hp geo.1 ?_ ?_ geo.2 ?_ + · exact cfg.secondChild.trans fixed_circle.symm + · exact cfg.secondParentOne.trans selected_circle.symm + case' positiveS4 presentation => + have geo := row_geometry _ _ (.positiveS4 presentation) + fixed_centroid selected_centroid _ rfl + simp only [P3996T1SRowTable] + refine sub _ _ _ _ _ _ _ _ _ selected_odometer bundle.normalized_fixed_odometer + hp bundle.normalized_fixed_slope geo.1 ?_ ?_ geo.2 ?_ + · exact cfg.firstChild.trans selected_circle.symm + · exact cfg.firstParentTwo.trans fixed_circle.symm + case' positiveS5 presentation => + have geo := row_geometry _ _ (.positiveS5 presentation) + fixed_centroid selected_centroid _ rfl + simp only [P3996T1SRowTable] + refine sub _ _ _ _ _ _ _ _ _ selected_odometer bundle.normalized_fixed_odometer + hp bundle.normalized_fixed_slope geo.1 ?_ ?_ geo.2 ?_ + · exact cfg.firstChild.trans selected_circle.symm + · exact cfg.firstParentThree.trans fixed_circle.symm + case' positiveS6 presentation => + have geo := row_geometry _ _ (.positiveS6 presentation) + fixed_centroid selected_centroid _ rfl + simp only [P3996T1SRowTable] + refine sub _ _ _ _ _ _ _ _ _ selected_odometer bundle.normalized_fixed_odometer + hp bundle.normalized_fixed_slope geo.1 ?_ ?_ geo.2 ?_ + · exact cfg.secondChild.trans selected_circle.symm + · exact cfg.secondParentOne.trans fixed_circle.symm + case' reflectedS1 presentation => + have geo := row_geometry _ _ (.reflectedS1 presentation) + fixed_centroid selected_centroid _ rfl + simp only [P3996T1SRowTable, ↓reduceIte] + refine sub _ _ _ _ _ _ _ _ _ bundle.normalized_fixed_odometer selected_odometer + bundle.normalized_fixed_slope hp geo.1 ?_ ?_ geo.2 ?_ + · exact cfg.firstChild.trans fixed_circle.symm + · exact cfg.firstParentTwo.trans selected_circle.symm + case' reflectedS2 presentation => + have geo := row_geometry _ _ (.reflectedS2 presentation) + fixed_centroid selected_centroid _ rfl + simp only [P3996T1SRowTable, ↓reduceIte] + refine sub _ _ _ _ _ _ _ _ _ bundle.normalized_fixed_odometer selected_odometer + bundle.normalized_fixed_slope hp geo.1 ?_ ?_ geo.2 ?_ + · exact cfg.firstChild.trans fixed_circle.symm + · exact cfg.firstParentThree.trans selected_circle.symm + case' reflectedS3 presentation => + have geo := row_geometry _ _ (.reflectedS3 presentation) + fixed_centroid selected_centroid _ rfl + simp only [P3996T1SRowTable, ↓reduceIte] + refine sub _ _ _ _ _ _ _ _ _ bundle.normalized_fixed_odometer selected_odometer + bundle.normalized_fixed_slope hp geo.1 ?_ ?_ geo.2 ?_ + · exact cfg.secondChild.trans fixed_circle.symm + · exact cfg.secondParentOne.trans selected_circle.symm + case' reflectedS4 presentation => + have geo := row_geometry _ _ (.reflectedS4 presentation) + fixed_centroid selected_centroid _ rfl + simp only [P3996T1SRowTable] + refine sub _ _ _ _ _ _ _ _ _ selected_odometer bundle.normalized_fixed_odometer + hp bundle.normalized_fixed_slope geo.1 ?_ ?_ geo.2 ?_ + · exact cfg.firstChild.trans selected_circle.symm + · exact cfg.firstParentTwo.trans fixed_circle.symm + case' reflectedS5 presentation => + have geo := row_geometry _ _ (.reflectedS5 presentation) + fixed_centroid selected_centroid _ rfl + simp only [P3996T1SRowTable] + refine sub _ _ _ _ _ _ _ _ _ selected_odometer bundle.normalized_fixed_odometer + hp bundle.normalized_fixed_slope geo.1 ?_ ?_ geo.2 ?_ + · exact cfg.firstChild.trans selected_circle.symm + · exact cfg.firstParentThree.trans fixed_circle.symm + case' reflectedS6 presentation => + have geo := row_geometry _ _ (.reflectedS6 presentation) + fixed_centroid selected_centroid _ rfl + simp only [P3996T1SRowTable] + refine sub _ _ _ _ _ _ _ _ _ selected_odometer bundle.normalized_fixed_odometer + hp bundle.normalized_fixed_slope geo.1 ?_ ?_ geo.2 ?_ + · exact cfg.secondChild.trans selected_circle.symm + · exact cfg.secondParentOne.trans fixed_circle.symm + all_goals + first + | rw [show p - bundle.normalizedFixedSlope = + (p - bundle.normalizedRootSlope) - + (bundle.normalizedFixedSlope - bundle.normalizedRootSlope) by abel, + selected_slope, fixed_slope] + | rw [show bundle.normalizedFixedSlope - p = + (bundle.normalizedFixedSlope - bundle.normalizedRootSlope) - + (p - bundle.normalizedRootSlope) by abel, fixed_slope, selected_slope] + norm_num [slot, sign, Fin.add_def, Fin.add, Fin.succ] + try simp only [sum12, sum13, sum23] + simp only [q, cfg.firstChild, cfg.firstParentTwo, cfg.firstParentThree, + cfg.secondChild, cfg.secondParentOne, a01, a02, a03, a13, a31] + ext <;> norm_num [GaussianRealPoint, pow_succ, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + +end PresentedAdjacencyConclusion + +theorem P4418T3PresentedRowAdjacency : + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralSubtilePlacement + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle + bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions + bundle.selectedSlot bundle.selectedSign bundle.routedDirection), ∀ (row : + BandOrderedGeneralSelectedContactRow + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot placement.layout + placement.exteriorIndex placement.centralIndex), ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : + Fin 3), ∀ (s : Fin 4), (ProperBandQuadruple r) → ((r 0 = bundle.normalizedCircle.1.1) → + ((r i.succ = bundle.normalizedFixedCircle.1.1) → ((TileCentroid bundle.normalizedFixed - + TileCentroid bundle.normalizedRoot = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (r i.succ) (r 0) + + BandVectors.1 (r 0) (r i.succ)))) → ((bundle.normalizedFixedSlope.1 - + bundle.normalizedRootSlope.1 = + ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (r i.succ) (r 0) + + BandVectors.2 (r 0) (r i.succ)))).1) → ((bundle.normalizedFixedSlope.2 - + bundle.normalizedRootSlope.2 = + ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (r i.succ) (r 0) + + BandVectors.2 (r 0) (r i.succ)))).2) → (∀ (C' : BandCircle), ∀ (p : ℝ × ℝ), (C'.1.1 = + bundle.normalizedPresentation bundle.selectedSlot.succ) → ((PartialOdometerSlope + (bundle.functions bundle.selectedSlot bundle.selectedSign) = some p) → ((TileSubodometer + bundle.normalizedCircle.1.1 C'.1.1 + bundle.normalizedRoot (bundle.pieces bundle.selectedSlot bundle.selectedSign) + bundle.normalizedRootFunction + (bundle.functions bundle.selectedSlot bundle.selectedSign)) → ( + let S := bundle.pieces bundle.selectedSlot bundle.selectedSign + let f := bundle.functions bundle.selectedSlot bundle.selectedSign + let directed := fun (z : P3996T1SRowParameters) + (A B : BandCircle) (V W : ProtoTile) (f g : PartialOdometer) + (pV pW : ℝ × ℝ) => + ProperBandQuadruple z.predecessor ∧ + z.predecessor 0 = A.1.1 ∧ + z.predecessor z.parentSlot.succ = B.1.1 ∧ + TileCentroid W - TileCentroid V = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.1 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.1 (z.predecessor 0) (z.predecessor z.parentSlot.succ))) ∧ + pW - pV = (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.2 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.2 (z.predecessor 0) (z.predecessor z.parentSlot.succ))) ∧ + SubtileLatticeAdjacent A B V W f g + match P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot placement.layout row with + | none => C' = bundle.normalizedFixedCircle ∧ + LeftLatticeAdjacent bundle.normalizedFixedCircle bundle.normalizedFixed S + bundle.normalizedFixedFunction f + | some z => + if z.childIsExterior then + directed z bundle.normalizedFixedCircle C' bundle.normalizedFixed S + bundle.normalizedFixedFunction f bundle.normalizedFixedSlope p + else + directed z C' bundle.normalizedFixedCircle S bundle.normalizedFixed + f bundle.normalizedFixedFunction p bundle.normalizedFixedSlope))))))))) := by + intro C D T N h k x bundle placement row r i s hr hr0 hri hcentroid hslopex hslopey C' p hC' hp + hsub +-- BODY + classical + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let cert := placement.layout + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let slot : SixSubtileLabel → Fin 3 := fun l => match l with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + let sign : SixSubtileLabel → Bool := fun l => match l with + | .A | .C | .E => true + | .B | .D | .F => false + have outer := P4418T3OuterCompanionAlignment C D T N h k x + bundle placement row r i s hr hr0 hri hcentroid hslopex hslopey + have selected_cells := PresentedRowAdjacencyGeometry.selected_cells + C D T N h k x bundle placement + have selected_centroid : + TileCentroid (bundle.pieces bundle.selectedSlot bundle.selectedSign) = + TileCentroid (occurrence placement.centralIndex) := + PresentedRowAdjacencyGeometry.selected_centroid C D T N h k x bundle placement + selected_cells + have fixed_centroid : TileCentroid bundle.normalizedFixed = + TileCentroid (occurrence placement.exteriorIndex) := + (ProtoTileObservableExtensionality _ _ placement.fixed_exterior_cells + placement.fixed_exterior_empty_anchor).2.2.2.2.symm + have central_centroid : TileCentroid (occurrence placement.centralIndex) = + TileCentroid (cert.P (slot placement.centralIndex.label) + (sign placement.centralIndex.label)) := PresentedRowAdjacencyGeometry.central_centroid C + D T N h k x bundle placement (PresentedRowAdjacencyGeometry.translate_zero_centroid) + have positive_parent := PresentedRowAdjacencyGeometry.positive_parent C D T N h k x bundle + placement s + have area_of_band := PresentedRowAdjacencyGeometry.area_of_band + have selected_area : + TileArea (bundle.pieces bundle.selectedSlot bundle.selectedSign) = + Int.toNat (q bundle.selectedSlot.succ).1 := + area_of_band _ _ (positive_parent _) + (TileOdometerBandPrototile _ _ _ (bundle.piece_odometer _ _)) + have selected_slot := PresentedRowAdjacencyGeometry.selected_slot C D T N h k x bundle + placement s selected_cells + positive_parent (PresentedRowAdjacencyGeometry.occurrence_area C D T N h k x bundle + placement positive_parent area_of_band) selected_area + have selected_circle : C'.1.1 = q (slot placement.centralIndex.label).succ := by + exact hC'.trans (congrArg (fun j : Fin 3 => q j.succ) selected_slot) + have fixed_circle := PresentedRowAdjacencyGeometry.fixed_circle C + D T N h k x bundle placement row r i s outer + have selected_slope : p - bundle.normalizedRootSlope = + (if sign placement.centralIndex.label = true then (1 : ℝ) else -1) • + ((1 / 2 : ℝ) • GaussianRealPoint + ((1 + (⟨0, 1⟩ : GaussianInt)) * + BandVectors.2 (q ((slot placement.centralIndex.label + 2).succ)) + (q ((slot placement.centralIndex.label + 1).succ)))) := + PresentedRowAdjacencyGeometry.selected_slope C D T N h k x bundle placement p + hp selected_slot (PresentedRowAdjacencyGeometry.selected_sign C D T N h k x + bundle placement selected_centroid central_centroid selected_slot + (PresentedRowAdjacencyGeometry.cyclic_nonzero C D T N h k x bundle + positive_parent) (PresentedRowAdjacencyGeometry.signed_injective)) + -- The proper affine flip is used on this actual normalized tuple. + have fixed_slope : bundle.normalizedFixedSlope - bundle.normalizedRootSlope = + (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ + ((match placement.exteriorIndex.label with + | .A => if placement.exteriorIndex.first = -1 then 3 else 0 + | .B => if placement.exteriorIndex.first = 1 then 1 else 2 + | .C => if placement.exteriorIndex.second = 0 then 3 else 0 + | .D => if placement.exteriorIndex.second = 0 then 1 else 2 + | .E => if placement.exteriorIndex.first = 0 then 3 else 0 + | .F => if placement.exteriorIndex.first = 0 then 1 else 2 + )) * + ((⟨0, 1⟩ : GaussianInt) * + BandVectors.2 (q 0) (q (slot placement.exteriorIndex.label).succ) + + BandVectors.2 (q 0) (q (slot placement.exteriorIndex.label).succ))) := + PresentedRowAdjacencyGeometry.fixed_slope C D T N h k x bundle placement row r i + s hr0 hri hslopex hslopey outer fixed_circle + (PresentedRowAdjacencyGeometry.affine_incoming C D T N h k x bundle) + have selected_odometer := PresentedRowAdjacencyGeometry.selected_odometer C D T N h k x bundle + C' hC' + have row_geometry (a b : PeriodicSubtileIndex) + (row' : BandOrderedGeneralSelectedContactRow q cfg bundle.normalizedCircle + bundle.normalizedRoot cert a b) + (hfixed : TileCentroid bundle.normalizedFixed = TileCentroid (occurrence a)) + (hselected : TileCentroid (bundle.pieces bundle.selectedSlot bundle.selectedSign) = + TileCentroid (occurrence b)) + (z : P3996T1SRowParameters) + (hz : P3996T1SRowTable q cfg bundle.normalizedCircle + bundle.normalizedRoot cert row' = some z) : + ProperBandQuadruple z.predecessor ∧ + (if z.childIsExterior then + TileCentroid (bundle.pieces bundle.selectedSlot bundle.selectedSign) - + TileCentroid bundle.normalizedFixed + else TileCentroid bundle.normalizedFixed - + TileCentroid (bundle.pieces bundle.selectedSlot bundle.selectedSign)) = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.1 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.1 (z.predecessor 0) (z.predecessor z.parentSlot.succ))) := + PresentedRowAdjacencyGeometry.row_geometry C D T N h k x bundle placement a b + row' hfixed hselected z hz + have sub (z : P3996T1SRowParameters) + (A B : BandCircle) (V W : ProtoTile) (f g : PartialOdometer) + (pV pW : ℝ × ℝ) + (hV : TileOdometer A.1.1 V f) (hW : TileOdometer B.1.1 W g) + (hf : PartialOdometerSlope f = some pV) + (hg : PartialOdometerSlope g = some pW) + (hr : ProperBandQuadruple z.predecessor) + (h0 : z.predecessor 0 = A.1.1) + (hj : z.predecessor z.parentSlot.succ = B.1.1) + (hc : TileCentroid W - TileCentroid V = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.1 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.1 (z.predecessor 0) (z.predecessor z.parentSlot.succ)))) + (hs : pW - pV = (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.2 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.2 (z.predecessor 0) (z.predecessor z.parentSlot.succ)))) : + ProperBandQuadruple z.predecessor ∧ + z.predecessor 0 = A.1.1 ∧ + z.predecessor z.parentSlot.succ = B.1.1 ∧ + TileCentroid W - TileCentroid V = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.1 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.1 (z.predecessor 0) (z.predecessor z.parentSlot.succ))) ∧ + pW - pV = (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.2 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.2 (z.predecessor 0) (z.predecessor z.parentSlot.succ))) ∧ + SubtileLatticeAdjacent A B V W f g := PresentedRowAdjacencyGeometry.sub z A B V W f g pV + pW hV hW hf hg hr h0 hj hc hs + have left (r' : Fin 4 → CircleCoordinates) (j : Fin 3) (e : Bool) + (hr' : ProperBandQuadruple r') + (h0 : r' 0 = bundle.normalizedFixedCircle.1.1) + (heq : C'.1.1 = bundle.normalizedFixedCircle.1.1) + (hc : TileCentroid (bundle.pieces bundle.selectedSlot bundle.selectedSign) - + TileCentroid bundle.normalizedFixed = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.1 (r' j.succ) (r' 0))) + (hs : p - bundle.normalizedFixedSlope = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.2 (r' j.succ) (r' 0))) : + C' = bundle.normalizedFixedCircle ∧ + LeftLatticeAdjacent bundle.normalizedFixedCircle bundle.normalizedFixed + (bundle.pieces bundle.selectedSlot bundle.selectedSign) + bundle.normalizedFixedFunction + (bundle.functions bundle.selectedSlot bundle.selectedSign) := + PresentedRowAdjacencyGeometry.left C D T N h k x bundle C' p hp selected_odometer + r' j e hr' h0 heq hc hs + obtain ⟨a13, a12, a31, a23, a01, a02, a03, sum12, sum13, sum23⟩ := + P4387T1ParentSlopeNormalForms q cfg + simp only [q] at a13 a12 a31 a23 a01 a02 a03 sum12 sum13 sum23 + have fin2 : (⟨2, by decide⟩ : Fin 4) = 2 := rfl + have fin3 : (⟨3, by decide⟩ : Fin 4) = 3 := rfl + -- Keep the table's predecessor, parent slot, rotation, and directed order. + have presentedAdjacency : + let S := bundle.pieces bundle.selectedSlot bundle.selectedSign + let f := bundle.functions bundle.selectedSlot bundle.selectedSign + let directed := fun (z : P3996T1SRowParameters) + (A B : BandCircle) (V W : ProtoTile) (f g : PartialOdometer) + (pV pW : ℝ × ℝ) => + ProperBandQuadruple z.predecessor ∧ + z.predecessor 0 = A.1.1 ∧ + z.predecessor z.parentSlot.succ = B.1.1 ∧ + TileCentroid W - TileCentroid V = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.1 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.1 (z.predecessor 0) (z.predecessor z.parentSlot.succ))) ∧ + pW - pV = (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ z.rotation.val * + (BandVectors.2 (z.predecessor z.parentSlot.succ) (z.predecessor 0) + + BandVectors.2 (z.predecessor 0) (z.predecessor z.parentSlot.succ))) ∧ + SubtileLatticeAdjacent A B V W f g + match P3996T1SRowTable bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot placement.layout row with + | none => C' = bundle.normalizedFixedCircle ∧ + LeftLatticeAdjacent bundle.normalizedFixedCircle bundle.normalizedFixed S + bundle.normalizedFixedFunction f + | some z => + if z.childIsExterior then + directed z bundle.normalizedFixedCircle C' bundle.normalizedFixed S + bundle.normalizedFixedFunction f bundle.normalizedFixedSlope p + else + directed z C' bundle.normalizedFixedCircle S bundle.normalizedFixed + f bundle.normalizedFixedFunction p bundle.normalizedFixedSlope := + PresentedAdjacencyConclusion.presentedAdjacency C D T N h k x bundle placement + row r i s C' p hp outer selected_centroid fixed_centroid central_centroid + selected_circle fixed_circle selected_slope fixed_slope selected_odometer + row_geometry sub left a13 a31 a01 a02 a03 sum12 sum13 sum23 + exact presentedAdjacency + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean b/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean new file mode 100644 index 0000000000..7b46bca623 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean @@ -0,0 +1,843 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4418T3EndpointOwnerIndices +public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceData +public import LeanPool.ApollonianSuperharmonic.P3996T1SRowTable +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.OppositeRoutedCommonEdgeOutsideCellUnique +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure + +-- [TABLET NODE: P4418T3RoutedBlockCriterion] + +/-! +# P4418T3RoutedBlockCriterion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +private def routedOldCoordinates + {q : Fin 4 → CircleCoordinates} {cfg : BandOrderedGeneralConfiguration q} + {C : BandCircle} {T : ProtoTile} + {cert : BandOrderedGeneralLayoutCertificate q cfg C T} + {a b : PeriodicSubtileIndex} + (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b) : Int × Int := + match row with + | .positiveL1 _ _ => (-1, 0) + | .positiveS1 _ => (-1, 0) + | .positiveL2 _ _ => (1, 0) + | .positiveS2 _ => (1, 0) + | .positiveL3 _ _ => (0, -1) + | .positiveS3 _ => (0, -1) + | .positiveS4 _ => (0, 1) + | .positiveS5 _ => (1, 1) + | .positiveS6 _ => (-1, -1) + | .reflectedL1 _ _ => (1, 0) + | .reflectedS1 _ => (1, 0) + | .reflectedL2 _ _ => (-1, 0) + | .reflectedS2 _ => (-1, 0) + | .reflectedL3 _ _ => (0, 1) + | .reflectedS3 _ => (0, 1) + | .reflectedS4 _ => (0, -1) + | .reflectedS5 _ => (-1, -1) + | .reflectedS6 _ => (1, 1) + +namespace RoutedBlockGeometry + +private theorem hshift : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + (P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)) → (∀ (x : GaussianInt), ∀ + (j : Fin 4), ∀ (edge : Finset GaussianInt), (edge ∈ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → + ((LatticeVertexIncidentCell x j ∈ (SubtileOccurrenceInterpretation cert.P cert.u + cert.v a).cells) → ((LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( + let shift : GaussianInt := match P3996T1SRowTable q cfg C T cert row with + | some z => z.oldShift + | none => match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => -cert.v + | .D => cert.v + | .E | .F => 0 + let oldCoord : Int × Int := routedOldCoordinates row + shift = (oldCoord.1 : GaussianInt) * cert.u + (oldCoord.2 : GaussianInt) * cert.v)))) ) + := by + classical + intro q cfg C T cert a b row data x j edge hedge ha hb shift oldCoord + cases row <;> simp [shift, oldCoord, routedOldCoordinates, P3996T1SRowTable] <;> ring + +private theorem root_disjoint : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (m : Int), ∀ (n : Int), ∀ (r : Int), ∀ (s : Int), ((m, n) ≠ (r, s)) → (Disjoint + (TileTranslation T ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells + (TileTranslation T ((r : GaussianInt) * cert.u + (s : GaussianInt) * cert.v)).cells) + ) := by + classical + intro q cfg C T cert m n r s hne + exact (BandOrderedGeneralPeriodicBlockCells q cfg C T cert).2 m n r s hne + +private theorem footprint_incident : + (by + classical + exact + ∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ (z : GaussianInt), (z ∈ FootprintVertices U) → + (∃ k : Fin 4, LatticeVertexIncidentCell z k ∈ U.cells)) ) := by + classical + intro U hne z hz + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hz + rcases hz with ⟨c, hc, rfl | rfl | rfl | rfl⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hc⟩ + · refine ⟨2, ?_⟩ + simpa [LatticeVertexIncidentCell, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hc + +private theorem incident_footprint : + (by + classical + exact + ∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ (z : GaussianInt), ∀ (k : Fin 4), + (LatticeVertexIncidentCell z k ∈ U.cells) → (z ∈ FootprintVertices U)) ) := by + classical + intro U hne z k hk + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] + refine ⟨LatticeVertexIncidentCell z k, hk, ?_⟩ + fin_cases k <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] + +private theorem root_cells : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (o : PeriodicSubtileIndex), ∀ (c : LatticeCell), (c ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v o).cells) → (c ∈ + (TileTranslation T ((o.first : GaussianInt) * cert.u + (o.second : GaussianInt) * + cert.v)).cells) ) := by + classical + intro q cfg C T cert o c hc + let d := (o.first : GaussianInt) * cert.u + (o.second : GaussianInt) * cert.v + have hbase (z : LatticeCell) := (BandOrderedGeneralPeriodicBlockCells q cfg C T cert).1 + o.first o.second z + cases hl : o.label with + | A => + simp only [SubtileOccurrenceInterpretation, hl] at hc + rw [(TileTranslationFormulas (cert.P 0 true) d).1] at hc + rcases Finset.mem_image.mp hc with ⟨y, hy, hcy⟩ + by_cases hO : y ∈ cert.O.cells + · have hprec : y ∈ (cert.S 0 true).cells := by + rw [← cert.precursor_cells] + exact hO + have hB : y ∈ (cert.P 0 false).cells := + (cert.minus_union y).2 ⟨0, true, hprec⟩ + have hmod : GaussianTranslation d y ∈ + (ModifiedSubtileOccurrenceInterpretation cert.P cert.O + cert.u cert.v ⟨.B, o.first, o.second⟩).cells := by + simpa [ModifiedSubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, d] using hB + simpa [hcy] using (hbase (GaussianTranslation d y)).mpr ⟨.B, hmod⟩ + · have hmod : GaussianTranslation d y ∈ + (ModifiedSubtileOccurrenceInterpretation cert.P cert.O + cert.u cert.v ⟨.A, o.first, o.second⟩).cells := by + simp [ModifiedSubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, TileCellComplement, hO, hy, d] + simpa [hcy] using (hbase (GaussianTranslation d y)).mpr ⟨.A, hmod⟩ + | B => + have hc' : c ∈ (ModifiedSubtileOccurrenceInterpretation cert.P cert.O + cert.u cert.v o).cells := by + simpa [SubtileOccurrenceInterpretation, ModifiedSubtileOccurrenceInterpretation, + hl] using hc + exact (hbase c).mpr ⟨.B, by + simpa [ModifiedSubtileOccurrenceInterpretation, hl] using hc'⟩ + | C => + have hc' : c ∈ (ModifiedSubtileOccurrenceInterpretation cert.P cert.O + cert.u cert.v o).cells := by + simpa [SubtileOccurrenceInterpretation, ModifiedSubtileOccurrenceInterpretation, + hl] using hc + exact (hbase c).mpr ⟨.C, by + simpa [ModifiedSubtileOccurrenceInterpretation, hl] using hc'⟩ + | D => + have hc' : c ∈ (ModifiedSubtileOccurrenceInterpretation cert.P cert.O + cert.u cert.v o).cells := by + simpa [SubtileOccurrenceInterpretation, ModifiedSubtileOccurrenceInterpretation, + hl] using hc + exact (hbase c).mpr ⟨.D, by + simpa [ModifiedSubtileOccurrenceInterpretation, hl] using hc'⟩ + | E => + have hc' : c ∈ (ModifiedSubtileOccurrenceInterpretation cert.P cert.O + cert.u cert.v o).cells := by + simpa [SubtileOccurrenceInterpretation, ModifiedSubtileOccurrenceInterpretation, + hl] using hc + exact (hbase c).mpr ⟨.E, by + simpa [ModifiedSubtileOccurrenceInterpretation, hl] using hc'⟩ + | F => + have hc' : c ∈ (ModifiedSubtileOccurrenceInterpretation cert.P cert.O + cert.u cert.v o).cells := by + simpa [SubtileOccurrenceInterpretation, ModifiedSubtileOccurrenceInterpretation, + hl] using hc + exact (hbase c).mpr ⟨.F, by + simpa [ModifiedSubtileOccurrenceInterpretation, hl] using hc'⟩ + +private theorem hVroot : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), + let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v a + (∀ (o : PeriodicSubtileIndex), ∀ (c : LatticeCell), (c ∈ (SubtileOccurrenceInterpretation + cert.P cert.u cert.v o).cells) → (c ∈ (TileTranslation T ((o.first : GaussianInt) * + cert.u + (o.second : GaussianInt) * cert.v)).cells)) → (∀ c : LatticeCell, c ∈ + V.cells → c ∈ (TileTranslation T ((a.first : GaussianInt) * cert.u + (a.second : + GaussianInt) * cert.v)).cells) ) := by + classical + intro q cfg C T cert a V root_cells c hc + exact root_cells a c (by simpa [V] using hc) + +private theorem hWroot : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (b : PeriodicSubtileIndex), + let W := SubtileOccurrenceInterpretation cert.P cert.u cert.v b + (∀ (o : PeriodicSubtileIndex), ∀ (c : LatticeCell), (c ∈ (SubtileOccurrenceInterpretation + cert.P cert.u cert.v o).cells) → (c ∈ (TileTranslation T ((o.first : GaussianInt) * + cert.u + (o.second : GaussianInt) * cert.v)).cells)) → (∀ c : LatticeCell, c ∈ + W.cells → c ∈ (TileTranslation T ((b.first : GaussianInt) * cert.u + (b.second : + GaussianInt) * cert.v)).cells) ) := by + classical + intro q cfg C T cert b W root_cells c hc + exact root_cells b c (by simpa [W] using hc) + +private theorem hG₀root : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let G₀ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + (∀ (o : PeriodicSubtileIndex), ∀ (c : LatticeCell), (c ∈ (SubtileOccurrenceInterpretation + cert.P cert.u cert.v o).cells) → (c ∈ (TileTranslation T ((o.first : GaussianInt) * + cert.u + (o.second : GaussianInt) * cert.v)).cells)) → (∀ c : LatticeCell, c ∈ + G₀.cells → c ∈ (TileTranslation T (((P4418T3EndpointOwnerIndices q cfg C T cert a b + row).1.first : GaussianInt) * cert.u + ((P4418T3EndpointOwnerIndices q cfg C T cert + a b row).1.second : GaussianInt) * cert.v)).cells) ) := by + classical + intro q cfg C T cert a b row G₀ root_cells c hc + let o := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + exact root_cells o c (by simpa [G₀, o] using hc) + +private theorem hG₁root : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let G₁ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 + (∀ (o : PeriodicSubtileIndex), ∀ (c : LatticeCell), (c ∈ (SubtileOccurrenceInterpretation + cert.P cert.u cert.v o).cells) → (c ∈ (TileTranslation T ((o.first : GaussianInt) * + cert.u + (o.second : GaussianInt) * cert.v)).cells)) → (∀ c : LatticeCell, c ∈ + G₁.cells → c ∈ (TileTranslation T (((P4418T3EndpointOwnerIndices q cfg C T cert a b + row).2.first : GaussianInt) * cert.u + ((P4418T3EndpointOwnerIndices q cfg C T cert + a b row).2.second : GaussianInt) * cert.v)).cells) ) := by + classical + intro q cfg C T cert a b row G₁ root_cells c hc + let o := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 + exact root_cells o c (by simpa [G₁, o] using hc) + +private theorem hVold : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + (P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)) → (∀ (x : GaussianInt), ∀ + (j : Fin 4), ∀ (edge : Finset GaussianInt), (edge ∈ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → + ((LatticeVertexIncidentCell x j ∈ (SubtileOccurrenceInterpretation cert.P cert.u + cert.v a).cells) → ((LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( + let shift : GaussianInt := match P3996T1SRowTable q cfg C T cert row with + | some z => z.oldShift + | none => match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => -cert.v + | .D => cert.v + | .E | .F => 0 + let oldCoord : Int × Int := routedOldCoordinates row + (shift = (oldCoord.1 : GaussianInt) * cert.u + (oldCoord.2 : GaussianInt) * cert.v) → + (((a.first, a.second) ≠ oldCoord) → ((∀ (m : Int), ∀ (n : Int), ∀ (r : Int), ∀ (s : + Int), ((m, n) ≠ (r, s)) → (Disjoint (TileTranslation T ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v)).cells (TileTranslation T ((r : GaussianInt) * cert.u + + (s : GaussianInt) * cert.v)).cells)) → ( + let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v a + (∀ c : LatticeCell, c ∈ V.cells → c ∈ (TileTranslation T ((a.first : GaussianInt) * + cert.u + (a.second : GaussianInt) * cert.v)).cells) → (Disjoint V.cells + (TileTranslation T shift).cells)))))))) ) := by + classical + intro q cfg C T cert a b row data x j edge hedge ha hb shift oldCoord hshift a_coord_ne + root_disjoint V hVroot + rw [Finset.disjoint_left] + intro c hcV hcOld + have hV := hVroot c hcV + have hOld : c ∈ (TileTranslation T + ((oldCoord.1 : GaussianInt) * cert.u + (oldCoord.2 : GaussianInt) * cert.v)).cells := by + simpa [hshift] using hcOld + exact (Finset.disjoint_left.mp + (root_disjoint a.first a.second oldCoord.1 oldCoord.2 a_coord_ne)) hV hOld + +private theorem hWold : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + (P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)) → (∀ (x : GaussianInt), ∀ + (j : Fin 4), ∀ (edge : Finset GaussianInt), (edge ∈ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → + ((LatticeVertexIncidentCell x j ∈ (SubtileOccurrenceInterpretation cert.P cert.u + cert.v a).cells) → ((LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( + let shift : GaussianInt := match P3996T1SRowTable q cfg C T cert row with + | some z => z.oldShift + | none => match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => -cert.v + | .D => cert.v + | .E | .F => 0 + let oldCoord : Int × Int := routedOldCoordinates row + (shift = (oldCoord.1 : GaussianInt) * cert.u + (oldCoord.2 : GaussianInt) * cert.v) → + (((b.first, b.second) ≠ oldCoord) → ((∀ (m : Int), ∀ (n : Int), ∀ (r : Int), ∀ (s : + Int), ((m, n) ≠ (r, s)) → (Disjoint (TileTranslation T ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v)).cells (TileTranslation T ((r : GaussianInt) * cert.u + + (s : GaussianInt) * cert.v)).cells)) → ( + let W := SubtileOccurrenceInterpretation cert.P cert.u cert.v b + (∀ c : LatticeCell, c ∈ W.cells → c ∈ (TileTranslation T ((b.first : GaussianInt) * + cert.u + (b.second : GaussianInt) * cert.v)).cells) → (Disjoint W.cells + (TileTranslation T shift).cells)))))))) ) := by + classical + intro q cfg C T cert a b row data x j edge hedge ha hb shift oldCoord hshift b_coord_ne + root_disjoint W hWroot + rw [Finset.disjoint_left] + intro c hcW hcOld + have hW := hWroot c hcW + have hOld : c ∈ (TileTranslation T + ((oldCoord.1 : GaussianInt) * cert.u + (oldCoord.2 : GaussianInt) * cert.v)).cells := by + simpa [hshift] using hcOld + exact (Finset.disjoint_left.mp + (root_disjoint b.first b.second oldCoord.1 oldCoord.2 b_coord_ne)) hW hOld + +private theorem hxedge : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + (P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)) → (∀ (x : GaussianInt), ∀ + (j : Fin 4), ∀ (edge : Finset GaussianInt), (x ∈ edge) → ((edge ∈ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → + ((LatticeVertexIncidentCell x j ∈ (SubtileOccurrenceInterpretation cert.P cert.u + cert.v a).cells) → ((LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( + let shift : GaussianInt := match P3996T1SRowTable q cfg C T cert row with + | some z => z.oldShift + | none => match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => -cert.v + | .D => cert.v + | .E | .F => 0 + let oldCoord : Int × Int := routedOldCoordinates row + (shift = (oldCoord.1 : GaussianInt) * cert.u + (oldCoord.2 : GaussianInt) * cert.v) → + (((a.first, a.second) ≠ oldCoord) → (((b.first, b.second) ≠ oldCoord) → ( + let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v a + let W := SubtileOccurrenceInterpretation cert.P cert.u cert.v b + ∃ e : Finset GaussianInt, x ∈ e ∧ e ∈ FootprintEdges V ∩ FootprintEdges W)))))))) ) := by + classical + intro q cfg C T cert a b row data x j edge hx hedge ha hb shift oldCoord hshift a_coord_ne + b_coord_ne V W + rcases hedge with ⟨heV, heW⟩ + exact ⟨edge, hx, by simpa [V, W] using ⟨heV, heW⟩⟩ + +private theorem hfirst_criterion : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : + P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (x : GaussianInt), ∀ (j + : Fin 4), ∀ (edge : Finset GaussianInt), (x ∈ edge) → ((edge ∈ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → + ((LatticeVertexIncidentCell x j ∈ (SubtileOccurrenceInterpretation cert.P cert.u + cert.v a).cells) → ((LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( + let shift : GaussianInt := match P3996T1SRowTable q cfg C T cert row with + | some z => z.oldShift + | none => match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => -cert.v + | .D => cert.v + | .E | .F => 0 + let oldCoord : Int × Int := routedOldCoordinates row + (shift = (oldCoord.1 : GaussianInt) * cert.u + (oldCoord.2 : GaussianInt) * cert.v) → + (((a.first, a.second) ≠ oldCoord) → (((b.first, b.second) ≠ oldCoord) → ((∀ (m : + Int), ∀ (n : Int), ∀ (r : Int), ∀ (s : Int), ((m, n) ≠ (r, s)) → (Disjoint + (TileTranslation T ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells + (TileTranslation T ((r : GaussianInt) * cert.u + (s : GaussianInt) * cert.v)).cells)) + → (((TileTranslation T shift).cells.Nonempty) → ((∀ (U : ProtoTile), + (U.cells.Nonempty) → (∀ (z : GaussianInt), (z ∈ FootprintVertices U) → (∃ k : Fin 4, + LatticeVertexIncidentCell z k ∈ U.cells))) → ((∀ (U : ProtoTile), (U.cells.Nonempty) + → (∀ (z : GaussianInt), ∀ (k : Fin 4), (LatticeVertexIncidentCell z k ∈ U.cells) → (z + ∈ FootprintVertices U))) → ( + let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v a + let W := SubtileOccurrenceInterpretation cert.P cert.u cert.v b + let G₀ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + (∀ c : LatticeCell, c ∈ G₀.cells → c ∈ (TileTranslation T + (((P4418T3EndpointOwnerIndices q cfg C T cert a b row).1.first : GaussianInt) * + cert.u + ((P4418T3EndpointOwnerIndices q cfg C T cert a b row).1.second : + GaussianInt) * cert.v)).cells) → ((Disjoint V.cells (TileTranslation T shift).cells) + → ((Disjoint W.cells (TileTranslation T shift).cells) → ((∃ e : Finset GaussianInt, x + ∈ e ∧ e ∈ FootprintEdges V ∩ FootprintEdges W) → ((x = data.first ∨ x = data.last ∨ ∃ + (e : Finset GaussianInt) (f : Finset GaussianInt), e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ e ∈ + FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) ∧ f ∈ + FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → ( + let o₀ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + x = data.first → (x ∈ FootprintVertices (TileTranslation T shift) ↔ oldCoord = (o₀.first, + o₀.second)))))))))))))))))) ) := by + classical + intro q cfg C T cert a b row data x j edge hx hedge ha hb shift oldCoord hshift a_coord_ne + b_coord_ne root_disjoint old_nonempty footprint_incident incident_footprint V W G₀ hG₀root + hVold hWold hxedge htri o₀ hfirst + subst x + obtain ⟨k, hk⟩ := + ((LocalLatticeInterfaceSectors.1 V W G₀ data.first data.latticeV + data.latticeW data.latticeG₀ data.touching₀ data.common₀).2.2.2.1) + have hkG : LatticeVertexIncidentCell data.first k ∈ G₀.cells := by + simpa [G₀] using hk + constructor + · intro hfoot + obtain ⟨l, hl⟩ := footprint_incident _ old_nonempty _ hfoot + have huniq := OppositeRoutedCommonEdgeOutsideCellUnique V W data.first j edge + data.disjointVW hx (by simpa [V, W] using hedge) + (by simpa [V] using ha) (by simpa [W] using hb) + have heq := huniq k l + (by + intro hc + exact (Finset.disjoint_left.mp + (by simpa [V, G₀] using data.disjointVG₀) hc hkG) + ) + (by + intro hc + exact (Finset.disjoint_left.mp + (by simpa [W, G₀] using data.disjointWG₀) hc hkG) + ) + (by intro hc; exact (Finset.disjoint_left.mp hVold) hc hl) + (by intro hc; exact (Finset.disjoint_left.mp hWold) hc hl) + have hgroot := hG₀root _ hkG + have hgroot' : LatticeVertexIncidentCell data.first k ∈ + (TileTranslation T + ((o₀.first : GaussianInt) * cert.u + + (o₀.second : GaussianInt) * cert.v)).cells := by + simpa [o₀] using hgroot + have holdroot : LatticeVertexIncidentCell data.first l ∈ + (TileTranslation T + ((oldCoord.1 : GaussianInt) * cert.u + + (oldCoord.2 : GaussianInt) * cert.v)).cells := by + simpa [hshift] using hl + by_contra hcoord + have hneq : (o₀.first, o₀.second) ≠ oldCoord := by + intro he + exact hcoord he.symm + exact (Finset.disjoint_left.mp + (root_disjoint o₀.first o₀.second oldCoord.1 oldCoord.2 hneq)) + hgroot' (by simpa using heq ▸ holdroot) + · intro hcoord + have hgroot := hG₀root _ hkG + have hold : LatticeVertexIncidentCell data.first k ∈ + (TileTranslation T shift).cells := by + simpa [hshift, hcoord, o₀] using hgroot + exact incident_footprint _ old_nonempty _ k hold + +private theorem hlast_criterion : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : + P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (x : GaussianInt), ∀ (j + : Fin 4), ∀ (edge : Finset GaussianInt), (x ∈ edge) → ((edge ∈ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → + ((LatticeVertexIncidentCell x j ∈ (SubtileOccurrenceInterpretation cert.P cert.u + cert.v a).cells) → ((LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( + let shift : GaussianInt := match P3996T1SRowTable q cfg C T cert row with + | some z => z.oldShift + | none => match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => -cert.v + | .D => cert.v + | .E | .F => 0 + let oldCoord : Int × Int := routedOldCoordinates row + (shift = (oldCoord.1 : GaussianInt) * cert.u + (oldCoord.2 : GaussianInt) * cert.v) → + (((a.first, a.second) ≠ oldCoord) → (((b.first, b.second) ≠ oldCoord) → ((∀ (m : + Int), ∀ (n : Int), ∀ (r : Int), ∀ (s : Int), ((m, n) ≠ (r, s)) → (Disjoint + (TileTranslation T ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells + (TileTranslation T ((r : GaussianInt) * cert.u + (s : GaussianInt) * cert.v)).cells)) + → (((TileTranslation T shift).cells.Nonempty) → ((∀ (U : ProtoTile), + (U.cells.Nonempty) → (∀ (z : GaussianInt), (z ∈ FootprintVertices U) → (∃ k : Fin 4, + LatticeVertexIncidentCell z k ∈ U.cells))) → ((∀ (U : ProtoTile), (U.cells.Nonempty) + → (∀ (z : GaussianInt), ∀ (k : Fin 4), (LatticeVertexIncidentCell z k ∈ U.cells) → (z + ∈ FootprintVertices U))) → ( + let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v a + let W := SubtileOccurrenceInterpretation cert.P cert.u cert.v b + let G₁ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 + (∀ c : LatticeCell, c ∈ G₁.cells → c ∈ (TileTranslation T + (((P4418T3EndpointOwnerIndices q cfg C T cert a b row).2.first : GaussianInt) * + cert.u + ((P4418T3EndpointOwnerIndices q cfg C T cert a b row).2.second : + GaussianInt) * cert.v)).cells) → ((Disjoint V.cells (TileTranslation T shift).cells) + → ((Disjoint W.cells (TileTranslation T shift).cells) → ((∃ e : Finset GaussianInt, x + ∈ e ∧ e ∈ FootprintEdges V ∩ FootprintEdges W) → ((x = data.first ∨ x = data.last ∨ ∃ + (e : Finset GaussianInt) (f : Finset GaussianInt), e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ e ∈ + FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) ∧ f ∈ + FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → ( + let o₀ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + let o₁ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 + (x = data.first → (x ∈ FootprintVertices (TileTranslation T shift) ↔ oldCoord = + (o₀.first, o₀.second))) → (x = data.last → (x ∈ FootprintVertices (TileTranslation T + shift) ↔ oldCoord = (o₁.first, o₁.second))))))))))))))))))) ) := by + classical + intro q cfg C T cert a b row data x j edge hx hedge ha hb shift oldCoord hshift a_coord_ne + b_coord_ne root_disjoint old_nonempty footprint_incident incident_footprint V W G₁ hG₁root + hVold hWold hxedge htri o₀ o₁ hfirst_criterion hlast + subst x + obtain ⟨k, hk⟩ := + ((LocalLatticeInterfaceSectors.1 V W G₁ data.last data.latticeV + data.latticeW data.latticeG₁ data.touching₁ data.common₁).2.2.2.1) + have hkG : LatticeVertexIncidentCell data.last k ∈ G₁.cells := by + simpa [G₁] using hk + constructor + · intro hfoot + obtain ⟨l, hl⟩ := footprint_incident _ old_nonempty _ hfoot + have huniq := OppositeRoutedCommonEdgeOutsideCellUnique V W data.last j edge + data.disjointVW hx (by simpa [V, W] using hedge) + (by simpa [V] using ha) (by simpa [W] using hb) + have heq := huniq k l + (by + intro hc + exact (Finset.disjoint_left.mp + (by simpa [V, G₁] using data.disjointVG₁) hc hkG) + ) + (by + intro hc + exact (Finset.disjoint_left.mp + (by simpa [W, G₁] using data.disjointWG₁) hc hkG) + ) + (by intro hc; exact (Finset.disjoint_left.mp hVold) hc hl) + (by intro hc; exact (Finset.disjoint_left.mp hWold) hc hl) + have hgroot := hG₁root _ hkG + have hgroot' : LatticeVertexIncidentCell data.last k ∈ + (TileTranslation T + ((o₁.first : GaussianInt) * cert.u + + (o₁.second : GaussianInt) * cert.v)).cells := by + simpa [o₁] using hgroot + have holdroot : LatticeVertexIncidentCell data.last l ∈ + (TileTranslation T + ((oldCoord.1 : GaussianInt) * cert.u + + (oldCoord.2 : GaussianInt) * cert.v)).cells := by + simpa [hshift] using hl + by_contra hcoord + have hneq : (o₁.first, o₁.second) ≠ oldCoord := by + intro he + exact hcoord he.symm + exact (Finset.disjoint_left.mp + (root_disjoint o₁.first o₁.second oldCoord.1 oldCoord.2 hneq)) + hgroot' (by simpa using heq ▸ holdroot) + · intro hcoord + have hgroot := hG₁root _ hkG + have hold : LatticeVertexIncidentCell data.last k ∈ + (TileTranslation T shift).cells := by + simpa [hshift, hcoord, o₁] using hgroot + exact incident_footprint _ old_nonempty _ k hold + +private theorem hcriterion : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : + P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices + q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (x : GaussianInt), ∀ (j + : Fin 4), ∀ (edge : Finset GaussianInt), (edge ∈ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → + ((LatticeVertexIncidentCell x j ∈ (SubtileOccurrenceInterpretation cert.P cert.u + cert.v a).cells) → ((LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( + let shift : GaussianInt := match P3996T1SRowTable q cfg C T cert row with + | some z => z.oldShift + | none => match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => -cert.v + | .D => cert.v + | .E | .F => 0 + let oldCoord : Int × Int := routedOldCoordinates row + ((TileTranslation T shift).cells.Nonempty) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ + (z : GaussianInt), (z ∈ FootprintVertices U) → (∃ k : Fin 4, + LatticeVertexIncidentCell z k ∈ U.cells))) → ( + let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v a + let W := SubtileOccurrenceInterpretation cert.P cert.u cert.v b + (Disjoint V.cells (TileTranslation T shift).cells) → ((Disjoint W.cells (TileTranslation + T shift).cells) → ((x = data.first ∨ x = data.last ∨ ∃ (e : Finset GaussianInt) (f : + Finset GaussianInt), e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ e ∈ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) ∧ f ∈ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → ( + let o₀ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + let o₁ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 + (x = data.first → (x ∈ FootprintVertices (TileTranslation T shift) ↔ oldCoord = + (o₀.first, o₀.second))) → ((x = data.last → (x ∈ FootprintVertices (TileTranslation T + shift) ↔ oldCoord = (o₁.first, o₁.second))) → (x ∈ FootprintVertices (TileTranslation + T shift) ↔ (x = data.first ∧ oldCoord = (o₀.first, o₀.second)) ∨ (x = data.last ∧ + oldCoord = (o₁.first, o₁.second)))))))))))) ) := by + classical + intro q cfg C T cert a b row data x j edge hedge ha hb shift oldCoord old_nonempty + footprint_incident V W hVold hWold htri o₀ o₁ hfirst_criterion hlast_criterion + rcases htri with hfirst | hlast | hinside + · have hnotlast : x ≠ data.last := by + intro h + exact data.distinct (hfirst.symm.trans h) + rw [hfirst_criterion hfirst] + constructor + · intro h + exact Or.inl ⟨hfirst, h⟩ + · rintro (⟨_, h⟩ | ⟨h, _⟩) + · exact h + · exact (hnotlast h).elim + · have hnotfirst : x ≠ data.first := by + intro h + exact data.distinct (h.symm.trans hlast) + rw [hlast_criterion hlast] + constructor + · intro h + exact Or.inr ⟨hlast, h⟩ + · rintro (⟨h, _⟩ | ⟨_, h⟩) + · exact (hnotfirst h).elim + · exact h + · rcases hinside with ⟨e, f, hef, hxe, hxf, heE, hfE⟩ + have hsector := LocalLatticeInterfaceSectors.2 V W x data.latticeV + data.latticeW data.disjointVW ⟨e, f, hef, hxe, hxf, + by simpa [V, W] using heE, by simpa [V, W] using hfE⟩ + have hnotold : x ∉ FootprintVertices (TileTranslation T shift) := by + intro hfoot + obtain ⟨k, hk⟩ := footprint_incident _ old_nonempty _ hfoot + rcases hsector.1 k with hv | hw + · exact (Finset.disjoint_left.mp hVold) hv hk + · exact (Finset.disjoint_left.mp hWold) hw hk + constructor + · intro h + exact (hnotold h).elim + · rintro (⟨hfirst, hcoord⟩ | ⟨hlast, hcoord⟩) + · exact (hnotold ((hfirst_criterion hfirst).2 hcoord)).elim + · exact (hnotold ((hlast_criterion hlast).2 hcoord)).elim + +end RoutedBlockGeometry + +theorem P4418T3RoutedBlockCriterion + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b) + (hT : LatticeTile T) + (data : P4418T3SelectedInterfaceData + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)) + (x : GaussianInt) (j : Fin 4) (edge : Finset GaussianInt) + (hx : x ∈ edge) + (hedge : edge ∈ FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) + (ha : LatticeVertexIncidentCell x j ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells) + (hb : LatticeVertexIncidentCell x (j + 2) ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) : + let oldShift := match P3996T1SRowTable q cfg C T cert row with + | some z => z.oldShift + | none => match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => -cert.v + | .D => cert.v + | .E | .F => 0 + x ∈ FootprintVertices (TileTranslation T oldShift) ↔ + match P3996T1SRowTable q cfg C T cert row with + | none => False + | some z => x = (if z.parentSlot = 0 then data.first else data.last) := by +-- BODY + classical + dsimp only + let shift : GaussianInt := match P3996T1SRowTable q cfg C T cert row with + | some z => z.oldShift + | none => match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => -cert.v + | .D => cert.v + | .E | .F => 0 + let oldCoord : Int × Int := routedOldCoordinates row + have hshift := RoutedBlockGeometry.hshift q cfg C T cert a b row data x j edge hedge ha hb + have a_coord_ne : (a.first, a.second) ≠ oldCoord := by + cases row <;> simp [oldCoord, routedOldCoordinates] + have b_coord_ne : (b.first, b.second) ≠ oldCoord := by + cases row <;> simp [oldCoord, routedOldCoordinates] + have root_disjoint (m n r s : Int) (hne : (m, n) ≠ (r, s)) := RoutedBlockGeometry.root_disjoint + q cfg C T cert m n r s hne + have old_lattice : LatticeTile (TileTranslation T shift) := + (TileDiskAreaCovariance T shift).1.mp hT + have old_nonempty : (TileTranslation T shift).cells.Nonempty := + (LatticeTileGridStructure _ old_lattice).1.1 + have footprint_incident (U : ProtoTile) (hne : U.cells.Nonempty) + (z : GaussianInt) (hz : z ∈ FootprintVertices U) := RoutedBlockGeometry.footprint_incident + U hne z hz + have incident_footprint (U : ProtoTile) (hne : U.cells.Nonempty) + (z : GaussianInt) (k : Fin 4) + (hk : LatticeVertexIncidentCell z k ∈ U.cells) := RoutedBlockGeometry.incident_footprint U + hne z k hk + let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v a + let W := SubtileOccurrenceInterpretation cert.P cert.u cert.v b + let G₀ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + let G₁ := SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 + have root_cells (o : PeriodicSubtileIndex) (c : LatticeCell) + (hc : c ∈ (SubtileOccurrenceInterpretation cert.P cert.u cert.v o).cells) := + RoutedBlockGeometry.root_cells q cfg C T cert o c hc + have hVroot := RoutedBlockGeometry.hVroot q cfg C T cert a root_cells + have hWroot := RoutedBlockGeometry.hWroot q cfg C T cert b root_cells + have hG₀root := RoutedBlockGeometry.hG₀root q cfg C T cert a b row root_cells + have hG₁root := RoutedBlockGeometry.hG₁root q cfg C T cert a b row root_cells + have hVold := RoutedBlockGeometry.hVold q cfg C T cert a b row data x j edge hedge ha hb hshift + a_coord_ne root_disjoint hVroot + have hWold := RoutedBlockGeometry.hWold q cfg C T cert a b row data x j edge hedge ha hb hshift + b_coord_ne root_disjoint hWroot + have hxedge := RoutedBlockGeometry.hxedge q cfg C T cert a b row data x j edge hx hedge ha hb + hshift a_coord_ne b_coord_ne + have htri := SimpleGridPathPointTrichotomy _ _ data.first data.last x data.path hxedge + let o₀ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + let o₁ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 + have hfirst_criterion := RoutedBlockGeometry.hfirst_criterion q cfg C T cert a b row data x j + edge hx hedge ha hb hshift a_coord_ne b_coord_ne root_disjoint old_nonempty + footprint_incident incident_footprint hG₀root hVold hWold hxedge htri + have hlast_criterion := RoutedBlockGeometry.hlast_criterion q cfg C T cert a b row data x j + edge hx hedge ha hb hshift a_coord_ne b_coord_ne root_disjoint old_nonempty + footprint_incident incident_footprint hG₁root hVold hWold hxedge htri hfirst_criterion + have hcriterion : x ∈ FootprintVertices (TileTranslation T shift) ↔ + (x = data.first ∧ oldCoord = (o₀.first, o₀.second)) ∨ + (x = data.last ∧ oldCoord = (o₁.first, o₁.second)) := RoutedBlockGeometry.hcriterion q cfg + C T cert a b row data x j edge hedge ha hb old_nonempty footprint_incident hVold hWold + htri hfirst_criterion hlast_criterion + change (x ∈ FootprintVertices (TileTranslation T shift) ↔ _) + rw [hcriterion] + cases row <;> + simp [oldCoord, routedOldCoordinates, o₀, o₁, P3996T1SRowTable, + P4418T3EndpointOwnerIndices] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceData.lean b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceData.lean new file mode 100644 index 0000000000..8fcf4cbf7f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceData.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: P4418T3SelectedInterfaceData] + +/-! +# P4418T3SelectedInterfaceData + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For literal tiles $V,W,G_0,G_1$, these data consist of distinct vertices +$y_0,y_1$, a complete nontrivial simple grid path from $y_0$ to $y_1$ +whose vertex set is $\operatorname{foot}(V)\cap\operatorname{foot}(W)$ and whose edge set is +$E(V)\cap E(W)$, lattice-disk certificates for all four tiles, and +cell disjointness of $V,W$ and of each $G_a$ from each of $V,W$. +They also retain touching triples $(V,W,G_a)$ and membership of $y_a$ +in their three raw footprints, for $a=0,1$. No orientation is imposed on +any independently supplied interface record. +-/ +structure P4418T3SelectedInterfaceData (V W G₀ G₁ : ProtoTile) where +-- BODY + /-- The distinguished interface endpoint belonging to the first companion. -/ + first : GaussianInt + /-- The opposite interface endpoint belonging to the second companion. -/ + last : GaussianInt + distinct : first ≠ last + path : SimpleGridPathBetween (FootprintVertices V ∩ FootprintVertices W) + (FootprintEdges V ∩ FootprintEdges W) first last + latticeV : LatticeTile V + latticeW : LatticeTile W + latticeG₀ : LatticeTile G₀ + latticeG₁ : LatticeTile G₁ + disjointVW : Disjoint V.cells W.cells + disjointVG₀ : Disjoint V.cells G₀.cells + disjointWG₀ : Disjoint W.cells G₀.cells + disjointVG₁ : Disjoint V.cells G₁.cells + disjointWG₁ : Disjoint W.cells G₁.cells + touching₀ : TouchingTriple V W G₀ + touching₁ : TouchingTriple V W G₁ + common₀ : first ∈ FootprintVertices V ∩ FootprintVertices W ∩ FootprintVertices G₀ + common₁ : last ∈ FootprintVertices V ∩ FootprintVertices W ∩ FootprintVertices G₁ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean new file mode 100644 index 0000000000..5a6669f1c1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean @@ -0,0 +1,1928 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4418T3EndpointOwnerIndices +public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceData +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations + +-- [TABLET NODE: P4418T3SelectedInterfaceExists] + +/-! +# P4418T3SelectedInterfaceExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +private def selectedFirstFace (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b) : + PeriodicSubtileFaceIndex := + match row with + | .positiveL1 _ _ => ⟨.J3,-1,-1⟩ + | .positiveL2 _ _ => ⟨.J1,0,-1⟩ + | .positiveL3 _ _ => ⟨.J7,1,0⟩ + | .reflectedL1 _ _ => ⟨.J3,0,0⟩ + | .reflectedL2 _ _ => ⟨.J1,0,0⟩ + | .reflectedL3 _ _ => ⟨.J7,0,0⟩ + | .positiveS1 _ => ⟨.J3,-1,-1⟩ + | .positiveS2 _ => ⟨.J1,0,-1⟩ + | .positiveS3 _ => ⟨.J5,0,-1⟩ + | .positiveS4 _ => ⟨.J3,0,0⟩ + | .positiveS5 _ => ⟨.J1,0,0⟩ + | .positiveS6 _ => ⟨.J5,-1,-1⟩ + | .reflectedS1 _ => ⟨.J4,0,0⟩ + | .reflectedS2 _ => ⟨.J2,0,0⟩ + | .reflectedS3 _ => ⟨.J6,0,1⟩ + | .reflectedS4 _ => ⟨.J4,-1,-1⟩ + | .reflectedS5 _ => ⟨.J2,0,-1⟩ + | .reflectedS6 _ => ⟨.J6,1,1⟩ + +private def selectedSecondFace (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b) : + PeriodicSubtileFaceIndex := + match row with + | .positiveL1 _ _ => ⟨.J4,-1,-1⟩ + | .positiveL2 _ _ => ⟨.J2,0,-1⟩ + | .positiveL3 _ _ => ⟨.J8,1,0⟩ + | .reflectedL1 _ _ => ⟨.J4,0,0⟩ + | .reflectedL2 _ _ => ⟨.J2,0,0⟩ + | .reflectedL3 _ _ => ⟨.J8,0,0⟩ + | .positiveS1 _ => ⟨.J5,-1,-1⟩ + | .positiveS2 _ => ⟨.J5,0,-1⟩ + | .positiveS3 _ => ⟨.J7,1,0⟩ + | .positiveS4 _ => ⟨.J5,0,0⟩ + | .positiveS5 _ => ⟨.J5,0,0⟩ + | .positiveS6 _ => ⟨.J7,0,0⟩ + | .reflectedS1 _ => ⟨.J6,1,1⟩ + | .reflectedS2 _ => ⟨.J6,0,1⟩ + | .reflectedS3 _ => ⟨.J8,0,0⟩ + | .reflectedS4 _ => ⟨.J6,0,0⟩ + | .reflectedS5 _ => ⟨.J6,0,0⟩ + | .reflectedS6 _ => ⟨.J8,1,0⟩ + +namespace SelectedInterfaceGeometry + +private theorem hOA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let P := cert.P + let O := cert.O + O.cells ⊆ (P 0 true).cells ) := by + classical + intro q cfg C T cert P O + change cert.O.cells ⊆ (cert.P 0 true).cells + rw [cert.precursor_eq] + intro x hx + exact (cert.plus_union x).2 ⟨0, false, hx⟩ + +private theorem hOB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let P := cert.P + let O := cert.O + O.cells ⊆ (P 0 false).cells ) := by + classical + intro q cfg C T cert P O + change cert.O.cells ⊆ (cert.P 0 false).cells + rw [cert.precursor_cells] + intro x hx + exact (cert.minus_union x).2 ⟨0, true, hx⟩ + +private theorem cellInclusion : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (d : GaussianInt), (TileTranslation X d).cells = X.cells.image + (GaussianTranslation d)) → (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells ⊆ Y.cells) + → (∀ (d : GaussianInt), (TileTranslation X d).cells ⊆ (TileTranslation Y d).cells)) ) + := by + classical + intro translatedCells X Y hXY d + rw [translatedCells, translatedCells] + intro z hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + exact Finset.mem_image.mpr ⟨w, hXY hw, rfl⟩ + +private theorem isolated : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ∀ (m : Int), ∀ (n : Int), ∀ z ∈ CellSupportedFootprintVertices (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v)), ∀ x : GaussianInt, z ∈ FootprintVertices + (⟨{x}, x⟩ : ProtoTile) → x ∈ (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells + ∨ x ∈ (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells ) := by + classical + intro q cfg C T cert P O u v m n z hz x hy + by_cases hn : (TileTranslation O + ((m : GaussianInt) * u + (n : GaussianInt) * v)).cells.Nonempty + · have hz' : z ∈ FootprintVertices (TileTranslation O + ((m : GaussianInt) * u + (n : GaussianInt) * v)) := by + simpa [CellSupportedFootprintVertices, FootprintVertices, hn] using hz + exact cert.precursor_isolated m n z hz' x hy + · rcases hz with ⟨w, hw, _⟩ + exact (hn ⟨w, hw⟩).elim + +private theorem translatedNonempty : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (d : GaussianInt), (TileTranslation X d).cells = X.cells.image + (GaussianTranslation d)) → (∀ (X : ProtoTile), (X.cells.Nonempty) → (∀ (d : + GaussianInt), (TileTranslation X d).cells.Nonempty)) ) := by + classical + intro translatedCells X hX d + rw [translatedCells] + obtain ⟨x, hx⟩ := hX + exact ⟨GaussianTranslation d x, Finset.mem_image.mpr ⟨x, hx, rfl⟩⟩ + +private theorem parentNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let P := cert.P + let u := cert.u + let v := cert.v + (∀ (X : ProtoTile), (X.cells.Nonempty) → (∀ (d : GaussianInt), (TileTranslation X + d).cells.Nonempty)) → (∀ (x : PeriodicSubtileIndex), (SubtileOccurrenceInterpretation + P u v x).cells.Nonempty) ) := by + classical + intro q cfg C T cert P u v translatedNonempty x + cases x with + | mk label m n => + cases label with + | A => + simpa [SubtileOccurrenceInterpretation, P, u, v] using + translatedNonempty (P 0 true) + ((LatticeTileGridStructure (P 0 true) (cert.parent_lattice 0 true)).1.1) + ((m : GaussianInt) * u + (n : GaussianInt) * v) + | B => + simpa [SubtileOccurrenceInterpretation, P, u, v] using + translatedNonempty (P 0 false) + ((LatticeTileGridStructure (P 0 false) (cert.parent_lattice 0 false)).1.1) + ((m : GaussianInt) * u + (n : GaussianInt) * v) + | C => + simpa [SubtileOccurrenceInterpretation, P, u, v] using + translatedNonempty (P 1 true) + ((LatticeTileGridStructure (P 1 true) (cert.parent_lattice 1 true)).1.1) + ((m : GaussianInt) * u + (n : GaussianInt) * v) + | D => + simpa [SubtileOccurrenceInterpretation, P, u, v] using + translatedNonempty (P 1 false) + ((LatticeTileGridStructure (P 1 false) (cert.parent_lattice 1 false)).1.1) + ((m : GaussianInt) * u + (n : GaussianInt) * v) + | E => + simpa [SubtileOccurrenceInterpretation, P, u, v] using + translatedNonempty (P 2 true) + ((LatticeTileGridStructure (P 2 true) (cert.parent_lattice 2 true)).1.1) + ((m : GaussianInt) * u + (n : GaussianInt) * v) + | F => + simpa [SubtileOccurrenceInterpretation, P, u, v] using + translatedNonempty (P 2 false) + ((LatticeTileGridStructure (P 2 false) (cert.parent_lattice 2 false)).1.1) + ((m : GaussianInt) * u + (n : GaussianInt) * v) + +private theorem complementNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (X : ProtoTile), (X.cells.Nonempty) → (∀ (d : GaussianInt), (TileTranslation X + d).cells.Nonempty)) → (∀ (m : Int), ∀ (n : Int), (TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))).cells.Nonempty) ) := by + classical + intro q cfg C T cert P O u v translatedNonempty m n + have ht := translatedNonempty (TileCellComplement (P 0 true) O) + ((LatticeTileGridStructure _ cert.precursor_complement_lattice.1).1.1) + ((m : GaussianInt) * u + (n : GaussianInt) * v) + rw [(TileCellComplementCovariance _ _ _).1] at ht + simpa [SubtileOccurrenceInterpretation, P, u, v] using ht + +private theorem deletionSupport : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (m : Int), ∀ (n : Int), (TileCellComplement (SubtileOccurrenceInterpretation P u v + ⟨.A,m,n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v))).cells.Nonempty) → (∀ (m : Int), ∀ (n : Int), ∀ (Y : ProtoTile), + (Y.cells.Nonempty) → ((TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v)).cells = ∅ ∨ ((TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))).cells.Nonempty ∧ + Y.cells.Nonempty))) ) := by + classical + intro q cfg C T cert P O u v complementNonempty m n Y hY + by_cases hO : O.cells = ∅ + · exact Or.inl ((TileTranslationFormulas O + ((m : GaussianInt) * u + (n : GaussianInt) * v)).2.2.1.mpr hO) + · exact Or.inr ⟨complementNonempty m n, hY⟩ + +private theorem deleteEdge : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (O.cells ⊆ (P 0 true).cells) → ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells ⊆ + Y.cells) → (∀ (d : GaussianInt), (TileTranslation X d).cells ⊆ (TileTranslation Y + d).cells)) → ((∀ (m : Int), ∀ (n : Int), ∀ z ∈ CellSupportedFootprintVertices + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)), ∀ x : + GaussianInt, z ∈ FootprintVertices (⟨{x}, x⟩ : ProtoTile) → x ∈ + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells ∨ x ∈ + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) → (∀ (m : Int), ∀ (n : + Int), ∀ (Y : ProtoTile), (Disjoint Y.cells (SubtileOccurrenceInterpretation P u v + ⟨.A,m,n⟩).cells) → ((Disjoint Y.cells (SubtileOccurrenceInterpretation P u v + ⟨.B,m,n⟩).cells) → (FootprintEdges (TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) ∩ FootprintEdges Y = FootprintEdges + (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) ∩ FootprintEdges Y))))) ) := by + classical + intro q cfg C T cert P O u v hOA cellInclusion isolated m n Y hYA hYB + exact (FootprintDeletionRetention _ _ _ _ + (cellInclusion O (P 0 true) hOA _) (isolated m n) hYA hYB).2.1 + +private theorem deleteVertex : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (O.cells ⊆ (P 0 true).cells) → ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells ⊆ + Y.cells) → (∀ (d : GaussianInt), (TileTranslation X d).cells ⊆ (TileTranslation Y + d).cells)) → ((∀ (m : Int), ∀ (n : Int), ∀ z ∈ CellSupportedFootprintVertices + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)), ∀ x : + GaussianInt, z ∈ FootprintVertices (⟨{x}, x⟩ : ProtoTile) → x ∈ + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells ∨ x ∈ + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) → ((∀ (m : Int), ∀ (n : + Int), ∀ (Y : ProtoTile), (Y.cells.Nonempty) → ((TileTranslation O ((m : GaussianInt) + * u + (n : GaussianInt) * v)).cells = ∅ ∨ ((TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))).cells.Nonempty ∧ Y.cells.Nonempty))) → (∀ + (m : Int), ∀ (n : Int), ∀ (Y : ProtoTile), (Disjoint Y.cells + (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩).cells) → ((Disjoint Y.cells + (SubtileOccurrenceInterpretation P u v ⟨.B,m,n⟩).cells) → ((Y.cells.Nonempty) → + (FootprintVertices (TileCellComplement (SubtileOccurrenceInterpretation P u v + ⟨.A,m,n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))) ∩ + FootprintVertices Y = FootprintVertices (SubtileOccurrenceInterpretation P u v + ⟨.A,m,n⟩) ∩ FootprintVertices Y))))))) ) := by + classical + intro q cfg C T cert P O u v hOA cellInclusion isolated deletionSupport m n Y hYA hYB hY + exact (FootprintDeletionRetention _ _ _ _ + (cellInclusion O (P 0 true) hOA _) (isolated m n) hYA hYB).2.2 + (deletionSupport m n Y hY) + +private theorem modifiedA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ∀ (m : Int), ∀ (n : Int), ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A,m,n⟩ = + TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) (TileTranslation + O ((m : GaussianInt) * u + (n : GaussianInt) * v)) ) := by + classical + intro q cfg C T cert P O u v m n + change TileTranslation (TileCellComplement (P 0 true) O) + ((m : GaussianInt) * u + (n : GaussianInt) * v) = _ + rw [(TileCellComplementCovariance _ _ _).1] + rfl + +private theorem modifiedOther : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ∀ (x : PeriodicSubtileIndex), (x.label ≠ .A) → (ModifiedSubtileOccurrenceInterpretation P + O u v x = SubtileOccurrenceInterpretation P u v x) ) := by + classical + intro q cfg C T cert P O u v x hx + cases x with + | mk label m n => cases label <;> simp_all + [ModifiedSubtileOccurrenceInterpretation, SubtileOccurrenceInterpretation] + +private theorem modifiedAFootprintSubset : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (m : Int), ∀ (n : Int), (TileCellComplement (SubtileOccurrenceInterpretation P u v + ⟨.A,m,n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v))).cells.Nonempty) → ((∀ (m : Int), ∀ (n : Int), + ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A,m,n⟩ = TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) → (∀ (m : Int), ∀ (n : Int), + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A,m,n⟩) ⊆ + FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩))) ) := by + classical + intro q cfg C T cert P O u v complementNonempty modifiedA m n + rw [modifiedA m n] + have hcomp := complementNonempty m n + have hparent : + (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩).cells.Nonempty := + hcomp.mono (by intro x hx; exact (Finset.mem_sdiff.mp hx).1) + intro z hz + simp only [FootprintVertices, ite_eq_left hcomp, ite_eq_left hparent] at hz ⊢ + rcases hz with ⟨x, hx, hcorner⟩ + exact ⟨x, (Finset.mem_sdiff.mp hx).1, hcorner⟩ + +private theorem modifiedFootSubset : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (m : Int), ∀ (n : Int), FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O + u v ⟨.A,m,n⟩) ⊆ FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩)) → + (∀ (x : PeriodicSubtileIndex), FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v x) ⊆ FootprintVertices + (SubtileOccurrenceInterpretation P u v x)) ) := by + classical + intro q cfg C T cert P O u v modifiedAFootprintSubset x + cases x with + | mk label m n => cases label with + | A => exact modifiedAFootprintSubset m n + | B => simp [ModifiedSubtileOccurrenceInterpretation, SubtileOccurrenceInterpretation] + | C => simp [ModifiedSubtileOccurrenceInterpretation, SubtileOccurrenceInterpretation] + | D => simp [ModifiedSubtileOccurrenceInterpretation, SubtileOccurrenceInterpretation] + | E => simp [ModifiedSubtileOccurrenceInterpretation, SubtileOccurrenceInterpretation] + | F => simp [ModifiedSubtileOccurrenceInterpretation, SubtileOccurrenceInterpretation] + +private theorem modifiedAEdges : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (x : PeriodicSubtileIndex), ∀ (y : PeriodicSubtileIndex), (x ≠ y) → ((¬ ((x.label = .A + ∧ y.label = .B ∨ x.label = .B ∧ y.label = .A) ∧ x.first = y.first ∧ x.second = + y.second)) → (Disjoint (SubtileOccurrenceInterpretation P u v x).cells + (SubtileOccurrenceInterpretation P u v y).cells))) → ((∀ (m : Int), ∀ (n : Int), ∀ (Y + : ProtoTile), (Disjoint Y.cells (SubtileOccurrenceInterpretation P u v + ⟨.A,m,n⟩).cells) → ((Disjoint Y.cells (SubtileOccurrenceInterpretation P u v + ⟨.B,m,n⟩).cells) → (FootprintEdges (TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) ∩ FootprintEdges Y = FootprintEdges + (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) ∩ FootprintEdges Y))) → ((∀ (m : + Int), ∀ (n : Int), ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A,m,n⟩ = + TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) (TileTranslation + O ((m : GaussianInt) * u + (n : GaussianInt) * v))) → ((∀ (x : PeriodicSubtileIndex), + (x.label ≠ .A) → (ModifiedSubtileOccurrenceInterpretation P O u v x = + SubtileOccurrenceInterpretation P u v x)) → (∀ (m : Int), ∀ (n : Int), ∀ (x : + PeriodicSubtileIndex), (x.label ≠ .A) → ((¬ (x.label = .B ∧ x.first = m ∧ x.second = + n)) → (FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A,m,n⟩) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v x) = FootprintEdges + (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v x))))))) ) := by + classical + intro q cfg C T cert P O u v pairCells deleteEdge modifiedA modifiedOther m n x hx hpair + have hneA : (⟨.A,m,n⟩ : PeriodicSubtileIndex) ≠ x := by + intro he + exact hx (by simpa using (congrArg PeriodicSubtileIndex.label he).symm) + have hneB : (⟨.B,m,n⟩ : PeriodicSubtileIndex) ≠ x := by + intro he + apply hpair + exact ⟨by simpa using (congrArg PeriodicSubtileIndex.label he).symm, + by simpa using (congrArg PeriodicSubtileIndex.first he).symm, + by simpa using (congrArg PeriodicSubtileIndex.second he).symm⟩ + have h := deleteEdge m n (SubtileOccurrenceInterpretation P u v x) + (pairCells x ⟨.A,m,n⟩ hneA.symm (by + intro hp + rcases hp with ⟨hl, hf, hs⟩ + rcases hl with ⟨hxA, hAB⟩ | ⟨hxB, hBA⟩ + · exact hx hxA + · exact hpair ⟨hxB, by simpa using hf, by simpa using hs⟩)) + (pairCells x ⟨.B,m,n⟩ hneB.symm (by + intro hp + rcases hp with ⟨hl, hf, hs⟩ + rcases hl with ⟨hxA, hAB⟩ | ⟨hxB, hBA⟩ + · exact hx hxA + · cases hBA)) + rw [modifiedA m n, modifiedOther x hx] + exact h + +private theorem modifiedAVertices : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (x : PeriodicSubtileIndex), ∀ (y : PeriodicSubtileIndex), (x ≠ y) → ((¬ ((x.label = .A + ∧ y.label = .B ∨ x.label = .B ∧ y.label = .A) ∧ x.first = y.first ∧ x.second = + y.second)) → (Disjoint (SubtileOccurrenceInterpretation P u v x).cells + (SubtileOccurrenceInterpretation P u v y).cells))) → ((∀ (x : PeriodicSubtileIndex), + (SubtileOccurrenceInterpretation P u v x).cells.Nonempty) → ((∀ (m : Int), ∀ (n : + Int), ∀ (Y : ProtoTile), (Disjoint Y.cells (SubtileOccurrenceInterpretation P u v + ⟨.A,m,n⟩).cells) → ((Disjoint Y.cells (SubtileOccurrenceInterpretation P u v + ⟨.B,m,n⟩).cells) → ((Y.cells.Nonempty) → (FootprintVertices (TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) ∩ FootprintVertices Y = FootprintVertices + (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) ∩ FootprintVertices Y)))) → ((∀ (m : + Int), ∀ (n : Int), ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A,m,n⟩ = + TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) (TileTranslation + O ((m : GaussianInt) * u + (n : GaussianInt) * v))) → ((∀ (x : PeriodicSubtileIndex), + (x.label ≠ .A) → (ModifiedSubtileOccurrenceInterpretation P O u v x = + SubtileOccurrenceInterpretation P u v x)) → (∀ (m : Int), ∀ (n : Int), ∀ (x : + PeriodicSubtileIndex), (x.label ≠ .A) → ((¬ (x.label = .B ∧ x.first = m ∧ x.second = + n)) → (FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A,m,n⟩) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v x) = + FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) ∩ + FootprintVertices (SubtileOccurrenceInterpretation P u v x)))))))) ) := by + classical + intro q cfg C T cert P O u v pairCells parentNonempty deleteVertex modifiedA modifiedOther m n + x hx hpair + have hneA : (⟨.A,m,n⟩ : PeriodicSubtileIndex) ≠ x := by + intro he + exact hx (by simpa using (congrArg PeriodicSubtileIndex.label he).symm) + have hneB : (⟨.B,m,n⟩ : PeriodicSubtileIndex) ≠ x := by + intro he + apply hpair + exact ⟨by simpa using (congrArg PeriodicSubtileIndex.label he).symm, + by simpa using (congrArg PeriodicSubtileIndex.first he).symm, + by simpa using (congrArg PeriodicSubtileIndex.second he).symm⟩ + have h := deleteVertex m n (SubtileOccurrenceInterpretation P u v x) + (pairCells x ⟨.A,m,n⟩ hneA.symm (by + intro hp + rcases hp with ⟨hl, hf, hs⟩ + rcases hl with ⟨hxA, hAB⟩ | ⟨hxB, hBA⟩ + · exact hx hxA + · exact hpair ⟨hxB, by simpa using hf, by simpa using hs⟩)) + (pairCells x ⟨.B,m,n⟩ hneB.symm (by + intro hp + rcases hp with ⟨hl, hf, hs⟩ + rcases hl with ⟨hxA, hAB⟩ | ⟨hxB, hBA⟩ + · exact hx hxA + · cases hBA)) + (parentNonempty x) + rw [modifiedA m n, modifiedOther x hx] + exact h + +private theorem retargeted : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), + (BandOrderedGeneralSelectedContactRow q cfg C T cert a b) → ( + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (m : Int), ∀ (n : Int), ∀ (x : PeriodicSubtileIndex), (x.label ≠ .A) → ((¬ (x.label = + .B ∧ x.first = m ∧ x.second = n)) → (FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A,m,n⟩) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v x) = FootprintEdges + (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v x)))) → ((∀ (m : Int), ∀ (n : Int), ∀ (x : + PeriodicSubtileIndex), (x.label ≠ .A) → ((¬ (x.label = .B ∧ x.first = m ∧ x.second = + n)) → (FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A,m,n⟩) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v x) = + FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) ∩ + FootprintVertices (SubtileOccurrenceInterpretation P u v x)))) → ((FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))))) ) := by + classical + intro q cfg C T cert a b row P O u v modifiedAEdges modifiedAVertices + cases row with + | positiveL1 => exact ⟨modifiedAEdges (-1) (-1) _ (by decide) (by decide), + modifiedAVertices (-1) (-1) _ (by decide) (by decide)⟩ + | positiveL2 => exact ⟨modifiedAEdges 0 (-1) _ (by decide) (by decide), + modifiedAVertices 0 (-1) _ (by decide) (by decide)⟩ + | positiveL3 => exact ⟨rfl, rfl⟩ + | positiveS1 => exact ⟨modifiedAEdges (-1) (-1) _ (by decide) (by decide), + modifiedAVertices (-1) (-1) _ (by decide) (by decide)⟩ + | positiveS2 => exact ⟨modifiedAEdges 0 (-1) _ (by decide) (by decide), + modifiedAVertices 0 (-1) _ (by decide) (by decide)⟩ + | positiveS3 => exact ⟨rfl, rfl⟩ + | positiveS4 => + have he := modifiedAEdges 0 0 ⟨.C,1,1⟩ (by decide) (by decide) + have hv := modifiedAVertices 0 0 ⟨.C,1,1⟩ (by decide) (by decide) + exact ⟨by simpa [Set.inter_comm] using he, + by simpa [Set.inter_comm] using hv⟩ + | positiveS5 => + have he := modifiedAEdges 0 0 ⟨.E,0,1⟩ (by decide) (by decide) + have hv := modifiedAVertices 0 0 ⟨.E,0,1⟩ (by decide) (by decide) + exact ⟨by simpa [Set.inter_comm] using he, + by simpa [Set.inter_comm] using hv⟩ + | positiveS6 => exact ⟨rfl, rfl⟩ + | reflectedL1 => + have he := modifiedAEdges 0 0 ⟨.B,1,1⟩ (by decide) (by decide) + have hv := modifiedAVertices 0 0 ⟨.B,1,1⟩ (by decide) (by decide) + exact ⟨by simpa [Set.inter_comm] using he, + by simpa [Set.inter_comm] using hv⟩ + | reflectedL2 => + have he := modifiedAEdges 0 0 ⟨.B,0,1⟩ (by decide) (by decide) + have hv := modifiedAVertices 0 0 ⟨.B,0,1⟩ (by decide) (by decide) + exact ⟨by simpa [Set.inter_comm] using he, + by simpa [Set.inter_comm] using hv⟩ + | reflectedL3 => exact ⟨rfl, rfl⟩ + | reflectedS1 => exact ⟨rfl, rfl⟩ + | reflectedS2 => exact ⟨rfl, rfl⟩ + | reflectedS3 => exact ⟨rfl, rfl⟩ + | reflectedS4 => exact ⟨rfl, rfl⟩ + | reflectedS5 => exact ⟨rfl, rfl⟩ + | reflectedS6 => exact ⟨rfl, rfl⟩ + +private theorem faceVertex : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (f : PeriodicSubtileFaceIndex), ∀ (i : Fin 3), cert.modified.plane.faceVertex + (cert.modified_face_equiv.symm f) i = SixSubtileFaceVertices f i ) := by + classical + intro q cfg C T cert f i + simpa using cert.modified_face_vertices (cert.modified_face_equiv.symm f) i + +private theorem faceDistinct : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))) → ( + let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row + let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row + let F0 := cert.modified_face_equiv.symm face0 + let F1 := cert.modified_face_equiv.symm face1 + F0 ≠ F1) ) := by + classical + intro q cfg C T cert a b row P O u v retargeted face0 face1 F0 F1 h + have hf := congrArg cert.modified_face_equiv h + cases row <;> simp [F0, F1, face0, face1, selectedFirstFace, selectedSecondFace] at hf + +private theorem faceTable : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))) → ( + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row + let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row + let F0 := cert.modified_face_equiv.symm face0 + let F1 := cert.modified_face_equiv.symm face1 + (∀ (f : PeriodicSubtileFaceIndex), ∀ (i : Fin 3), cert.modified.plane.faceVertex + (cert.modified_face_equiv.symm f) i = + SixSubtileFaceVertices f i) → ((F0 ≠ F1) → ((∃ iA iB iO : Fin 3, + cert.modified.plane.faceVertex F0 iA = a ∧ cert.modified.plane.faceVertex F0 iB = b ∧ + cert.modified.plane.faceVertex F0 iO = owners.1) ∧ (∃ jA jB jO : Fin 3, + cert.modified.plane.faceVertex F1 jA = a ∧ cert.modified.plane.faceVertex F1 jB = b ∧ + cert.modified.plane.faceVertex F1 jO = owners.2))))) := by + classical + intro q cfg C T cert a b row P O u v retargeted owners face0 face1 F0 F1 faceVertex faceDistinct + cases row <;> + simp? [F0, F1, face0, face1, owners, P4418T3EndpointOwnerIndices, + faceVertex, SixSubtileFaceVertices, selectedFirstFace, selectedSecondFace] <;> decide + +private theorem reversePath : + (by + classical + exact + ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween V E y x) + ) := by + classical + intro V E x y h + rcases h with ⟨p, hnd, hlen, hh, hl, hV, hstep, hE⟩ + have reverseRaw (r : List GaussianInt) (e : Finset GaussianInt) : + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e = {a,b}) → + ∃ a b l₁ l₂, r.reverse = l₁ ++ a :: b :: l₂ ∧ e = {a,b} := by + rintro ⟨a, b, l₁, l₂, hr, he⟩ + refine ⟨b, a, l₂.reverse, l₁.reverse, ?_, ?_⟩ + · rw [hr] + simp [List.reverse_append, List.append_assoc] + · simpa [Finset.pair_comm] using he + refine ⟨p.reverse, List.nodup_reverse.mpr hnd, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simpa using hlen + · simpa using hl + · simpa using hh + · simpa using hV + · intro a b l₁ l₂ hr + have hp : p = l₂.reverse ++ b :: a :: l₁.reverse := by + have hh := congrArg List.reverse hr + simpa [List.reverse_append, List.append_assoc] using hh + rcases hstep b a l₂.reverse l₁.reverse hp with h | h | h | h + · exact Or.inr (Or.inl (by rw [h]; simp)) + · exact Or.inl (by rw [h]; simp) + · exact Or.inr (Or.inr (Or.inr (by rw [h]; simp))) + · exact Or.inr (Or.inr (Or.inl (by rw [h]; simp))) + · intro e + constructor + · intro he + exact reverseRaw p e ((hE e).mp he) + · intro he + apply (hE e).mpr + simpa using reverseRaw p.reverse e he + +private theorem hne : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))) → ( + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row + let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row + let F0 := cert.modified_face_equiv.symm face0 + let F1 := cert.modified_face_equiv.symm face1 + (F0 ≠ F1) → (((∃ iA iB iO : Fin 3, cert.modified.plane.faceVertex F0 iA = a ∧ + cert.modified.plane.faceVertex F0 iB = b ∧ cert.modified.plane.faceVertex F0 iO = + owners.1) ∧ (∃ jA jB jO : Fin 3, cert.modified.plane.faceVertex F1 jA = a ∧ + cert.modified.plane.faceVertex F1 jB = b ∧ cert.modified.plane.faceVertex F1 jO = + owners.2)) → (a ≠ b))) ) := by + classical + intro q cfg C T cert a b row P O u v retargeted owners face0 face1 F0 F1 faceDistinct faceTable h + cases row <;> cases h + +private theorem allowed : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))) → ( + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row + let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row + let F0 := cert.modified_face_equiv.symm face0 + let F1 := cert.modified_face_equiv.symm face1 + (F0 ≠ F1) → (((∃ iA iB iO : Fin 3, cert.modified.plane.faceVertex F0 iA = a ∧ + cert.modified.plane.faceVertex F0 iB = b ∧ cert.modified.plane.faceVertex F0 iO = + owners.1) ∧ (∃ jA jB jO : Fin 3, cert.modified.plane.faceVertex F1 jA = a ∧ + cert.modified.plane.faceVertex F1 jB = b ∧ cert.modified.plane.faceVertex F1 jO = + owners.2)) → ((a ≠ b) → (AllowedSubtileIncidence a b)))) ) := by + classical + intro q cfg C T cert a b row P O u v retargeted owners face0 face1 F0 F1 faceDistinct faceTable + hne + cases row with + | positiveL1 => exact .AB11 (-1) (-1) + | positiveL2 => exact .AB01 0 (-1) + | positiveL3 => exact .CDm10 1 0 + | positiveS1 => exact .AC11 (-1) (-1) + | positiveS2 => exact .AE01 0 (-1) + | positiveS3 => exact .CEm10 1 0 + | positiveS4 => exact .symm (.AC11 0 0) + | positiveS5 => exact .symm (.AE01 0 0) + | positiveS6 => exact .symm (.CEm10 0 0) + | reflectedL1 => exact .symm (.AB11 0 0) + | reflectedL2 => exact .symm (.AB01 0 0) + | reflectedL3 => exact .symm (.CDm10 0 0) + | reflectedS1 => exact .BDm1m1 1 1 + | reflectedS2 => exact .BF0m1 0 1 + | reflectedS3 => exact .DF10 (-1) 0 + | reflectedS4 => exact .symm (.BDm1m1 0 0) + | reflectedS5 => exact .symm (.BF0m1 0 0) + | reflectedS6 => exact .symm (.DF10 0 0) + +private theorem modifiedEdges : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (a ≠ b) → ((AllowedSubtileIncidence a b) → ((FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty)) ) := by + classical + intro q cfg C T cert a b P O u v hne allowed + have hadj := (cert.modified_adjacency a b).2 allowed + have hclass := PeriodicTileIntersectionClassification cert.modified + have := (hclass.1 a b hne).1.mpr hadj + simpa only [cert.modified_tile] using this + +private theorem modifiedPath : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (a ≠ b) → (((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty) → (∃ x + y : GaussianInt, SimpleGridPathBetween (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b)) (FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b)) x y)) ) := by + classical + intro q cfg C T cert a b P O u v hne modifiedEdges + have hclass := PeriodicTileIntersectionClassification cert.modified + have hpaths := PeriodicTileIntersectionPaths cert.modified hclass.2 a b hne + have modifiedEdges' : + (FootprintEdges (cert.modified.tile a) ∩ + FootprintEdges (cert.modified.tile b)).Nonempty := by + simpa only [cert.modified_tile] using modifiedEdges + rcases hpaths.1.mpr modifiedEdges' with ⟨hadj, f, g, hfg, hf, hg, hfaces, hpath⟩ + have hraw := (hclass.1 a b hne).2.1 modifiedEdges' + rw [← hraw.2] at hpath + have hpath' : + SimpleGridPathBetween + (FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)) + (FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b)) + (cert.modified.rho f) (cert.modified.rho g) := by + simpa only [cert.modified_tile] using hpath + exact ⟨_, _, hpath'⟩ + +private theorem headLastNe : + (by + classical + exact + ∀ (p : List GaussianInt), (p.Nodup) → ((2 ≤ p.length) → (p.head? ≠ p.getLast?)) ) := by + classical + intro p hnd hlen + cases p with + | nil => simp at hlen + | cons x xs => + cases xs with + | nil => simp at hlen + | cons y ys => + intro heq + have hxnot : x ∉ y :: ys := (List.nodup_cons.mp hnd).1 + have hlast : x = (y :: ys).getLast (by simp) := by + simpa [List.getLast?_eq_some_getLast] using heq + exact hxnot (hlast ▸ List.getLast_mem (by simp)) + +private theorem pathAtOwners : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))) → ( + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row + let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row + let F0 := cert.modified_face_equiv.symm face0 + let F1 := cert.modified_face_equiv.symm face1 + (F0 ≠ F1) → (((∃ iA iB iO : Fin 3, cert.modified.plane.faceVertex F0 iA = a ∧ + cert.modified.plane.faceVertex F0 iB = b ∧ cert.modified.plane.faceVertex F0 iO = + owners.1) ∧ (∃ jA jB jO : Fin 3, cert.modified.plane.faceVertex F1 jA = a ∧ + cert.modified.plane.faceVertex F1 jB = b ∧ cert.modified.plane.faceVertex F1 jO = + owners.2)) → ((∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ + {x : GaussianInt}, ∀ {y : GaussianInt}, (SimpleGridPathBetween V E x y) → + (SimpleGridPathBetween V E y x)) → ((a ≠ b) → (((FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty) → + (SimpleGridPathBetween (FootprintVertices (occurrence a) ∩ FootprintVertices + (occurrence b)) (FootprintEdges (occurrence a) ∩ FootprintEdges (occurrence b)) + (cert.modified.rho F0) (cert.modified.rho F1))))))) ) := by + classical + intro q cfg C T cert a b row P O u v retargeted occurrence owners face0 face1 F0 F1 + faceDistinct faceTable reversePath hne modifiedEdges + have hclass := PeriodicTileIntersectionClassification cert.modified + have hpaths := PeriodicTileIntersectionPaths cert.modified hclass.2 a b hne + have hedge : + (FootprintEdges (cert.modified.tile a) ∩ + FootprintEdges (cert.modified.tile b)).Nonempty := by + simpa only [cert.modified_tile] using modifiedEdges + rcases hpaths.1.mpr hedge with ⟨_, f, g, hfg, hf, hg, hall, hp⟩ + have hraw := (hclass.1 a b hne).2.1 hedge + rw [← hraw.2] at hp + have hp' : + SimpleGridPathBetween + (FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)) + (FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b)) + (cert.modified.rho f) (cert.modified.rho g) := by + simpa only [cert.modified_tile] using hp + rcases faceTable with ⟨⟨iA,iB,iO,ha0,hb0,ho0⟩, + ⟨jA,jB,jO,ha1,hb1,ho1⟩⟩ + have hF0 := hall F0 ⟨⟨iA, ha0⟩, ⟨iB, hb0⟩⟩ + have hF1 := hall F1 ⟨⟨jA, ha1⟩, ⟨jB, hb1⟩⟩ + rcases hF0 with hF0 | hF0 <;> rcases hF1 with hF1 | hF1 + · exact (faceDistinct (hF0.trans hF1.symm)).elim + · have hOrient : f = F0 ∧ g = F1 := ⟨hF0.symm, hF1.symm⟩ + rw [retargeted.2, retargeted.1] at hp' + simpa [hOrient.1, hOrient.2] using hp' + · have hpRev := reversePath hp' + have hOrient : g = F0 ∧ f = F1 := ⟨hF0.symm, hF1.symm⟩ + rw [retargeted.2, retargeted.1] at hpRev + simpa [hOrient.1, hOrient.2] using hpRev + · exact (faceDistinct (hF0.trans hF1.symm)).elim + +private theorem endpointsDistinct : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))) → ( + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row + let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row + let F0 := cert.modified_face_equiv.symm face0 + let F1 := cert.modified_face_equiv.symm face1 + (∀ (p : List GaussianInt), (p.Nodup) → ((2 ≤ p.length) → (p.head? ≠ p.getLast?))) → + ((SimpleGridPathBetween (FootprintVertices (occurrence a) ∩ FootprintVertices + (occurrence b)) (FootprintEdges (occurrence a) ∩ FootprintEdges (occurrence b)) + (cert.modified.rho F0) (cert.modified.rho F1)) → (cert.modified.rho F0 ≠ + cert.modified.rho F1))) ) := by + classical + intro q cfg C T cert a b row P O u v retargeted occurrence face0 face1 F0 F1 headLastNe + pathAtOwners + rcases pathAtOwners with ⟨p, hnd, hlen, hh, hl, _, _, _⟩ + intro heq + apply headLastNe p hnd hlen + rw [hh, hl, heq] + +private theorem commonPair0 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))) → ( + let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row + let F0 := cert.modified_face_equiv.symm face0 + ∀ (iA : Fin (3 : ℕ)), ∀ (iB : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F0 iA = a) → + ((cert.modified.plane.faceVertex F0 iB = b) → (cert.modified.rho F0 ∈ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)))) ) := by + classical + intro q cfg C T cert a b row P O u v retargeted face0 F0 iA iB ha0 hb0 + exact ⟨by simpa only [ha0, cert.modified_tile] using cert.modified.rho_common F0 iA, + by simpa only [hb0, cert.modified_tile] using cert.modified.rho_common F0 iB⟩ + +private theorem commonPair1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))) → ( + let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row + let F1 := cert.modified_face_equiv.symm face1 + ∀ (jA : Fin (3 : ℕ)), ∀ (jB : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F1 jA = a) → + ((cert.modified.plane.faceVertex F1 jB = b) → (cert.modified.rho F1 ∈ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)))) ) := by + classical + intro q cfg C T cert a b row P O u v retargeted face1 F1 jA jB ha1 hb1 + exact ⟨by simpa only [ha1, cert.modified_tile] using cert.modified.rho_common F1 jA, + by simpa only [hb1, cert.modified_tile] using cert.modified.rho_common F1 jB⟩ + +private theorem ownerPoint0 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (x : PeriodicSubtileIndex), FootprintVertices (ModifiedSubtileOccurrenceInterpretation + P O u v x) ⊆ FootprintVertices (SubtileOccurrenceInterpretation P u v x)) → + (((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))) → ( + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row + let F0 := cert.modified_face_equiv.symm face0 + ∀ (iO : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F0 iO = owners.1) → + (cert.modified.rho F0 ∈ FootprintVertices (occurrence owners.1)))) ) := by + classical + intro q cfg C T cert a b row P O u v modifiedFootSubset retargeted occurrence owners face0 F0 + iO ho0 + have h := cert.modified.rho_common F0 iO + rw [ho0, cert.modified_tile] at h + exact modifiedFootSubset owners.1 h + +private theorem ownerPoint1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (x : PeriodicSubtileIndex), FootprintVertices (ModifiedSubtileOccurrenceInterpretation + P O u v x) ⊆ FootprintVertices (SubtileOccurrenceInterpretation P u v x)) → + (((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))) → ( + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row + let F1 := cert.modified_face_equiv.symm face1 + ∀ (jO : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F1 jO = owners.2) → + (cert.modified.rho F1 ∈ FootprintVertices (occurrence owners.2)))) ) := by + classical + intro q cfg C T cert a b row P O u v modifiedFootSubset retargeted occurrence owners face1 F1 + jO ho1 + have h := cert.modified.rho_common F1 jO + rw [ho1, cert.modified_tile] at h + exact modifiedFootSubset owners.2 h + +private theorem originalPair0 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))) → ( + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row + let F0 := cert.modified_face_equiv.symm face0 + (cert.modified.rho F0 ∈ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u + v a) ∩ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)) → + (cert.modified.rho F0 ∈ FootprintVertices (occurrence a) ∩ FootprintVertices + (occurrence b))) ) := by + classical + intro q cfg C T cert a b row P O u v retargeted occurrence face0 F0 commonPair0 + simpa only [retargeted.2] using commonPair0 + +private theorem originalPair1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))) → ( + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row + let F1 := cert.modified_face_equiv.symm face1 + (cert.modified.rho F1 ∈ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u + v a) ∩ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)) → + (cert.modified.rho F1 ∈ FootprintVertices (occurrence a) ∩ FootprintVertices + (occurrence b))) ) := by + classical + intro q cfg C T cert a b row P O u v retargeted occurrence face1 F1 commonPair1 + simpa only [retargeted.2] using commonPair1 + +private theorem latticeOccurrence : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + ∀ x : PeriodicSubtileIndex, LatticeTile (occurrence x) ) := by + classical + intro q cfg C T cert occurrence x + let P := cert.P + let u := cert.u + let v := cert.v + cases x with + | mk label m n => cases label with + | A => + simpa [occurrence, SubtileOccurrenceInterpretation, P, u, v] using + (TileDiskAreaCovariance (P 0 true) + ((m : GaussianInt) * u + (n : GaussianInt) * v)).1.mp + (cert.parent_lattice 0 true) + | B => + simpa [occurrence, SubtileOccurrenceInterpretation, P, u, v] using + (TileDiskAreaCovariance (P 0 false) + ((m : GaussianInt) * u + (n : GaussianInt) * v)).1.mp + (cert.parent_lattice 0 false) + | C => + simpa [occurrence, SubtileOccurrenceInterpretation, P, u, v] using + (TileDiskAreaCovariance (P 1 true) + ((m : GaussianInt) * u + (n : GaussianInt) * v)).1.mp + (cert.parent_lattice 1 true) + | D => + simpa [occurrence, SubtileOccurrenceInterpretation, P, u, v] using + (TileDiskAreaCovariance (P 1 false) + ((m : GaussianInt) * u + (n : GaussianInt) * v)).1.mp + (cert.parent_lattice 1 false) + | E => + simpa [occurrence, SubtileOccurrenceInterpretation, P, u, v] using + (TileDiskAreaCovariance (P 2 true) + ((m : GaussianInt) * u + (n : GaussianInt) * v)).1.mp + (cert.parent_lattice 2 true) + | F => + simpa [occurrence, SubtileOccurrenceInterpretation, P, u, v] using + (TileDiskAreaCovariance (P 2 false) + ((m : GaussianInt) * u + (n : GaussianInt) * v)).1.mp + (cert.parent_lattice 2 false) + +private theorem disjointData : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (x : PeriodicSubtileIndex), ∀ (y : PeriodicSubtileIndex), (x ≠ y) → ((¬ ((x.label = .A + ∧ y.label = .B ∨ x.label = .B ∧ y.label = .A) ∧ x.first = y.first ∧ x.second = + y.second)) → (Disjoint (SubtileOccurrenceInterpretation P u v x).cells + (SubtileOccurrenceInterpretation P u v y).cells))) → (((FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))) → ( + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row + let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row + let F0 := cert.modified_face_equiv.symm face0 + let F1 := cert.modified_face_equiv.symm face1 + (F0 ≠ F1) → ((a ≠ b) → ((AllowedSubtileIncidence a b) → (((FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty) → ((∃ x y : + GaussianInt, SimpleGridPathBetween (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b)) (FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b)) x y) → ((SimpleGridPathBetween + (FootprintVertices (occurrence a) ∩ FootprintVertices (occurrence b)) (FootprintEdges + (occurrence a) ∩ FootprintEdges (occurrence b)) (cert.modified.rho F0) + (cert.modified.rho F1)) → ((cert.modified.rho F0 ≠ cert.modified.rho F1) → (∀ (iA : + Fin (3 : ℕ)), ∀ (iB : Fin (3 : ℕ)), ∀ (iO : Fin (3 : ℕ)), + (cert.modified.plane.faceVertex F0 iA = a) → ((cert.modified.plane.faceVertex F0 iB = + b) → ((cert.modified.plane.faceVertex F0 iO = owners.1) → (∀ (jA : Fin (3 : ℕ)), ∀ + (jB : Fin (3 : ℕ)), ∀ (jO : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F1 jA = a) + → ((cert.modified.plane.faceVertex F1 jB = b) → ((cert.modified.plane.faceVertex F1 + jO = owners.2) → ((cert.modified.rho F0 ∈ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b)) → ((cert.modified.rho F1 ∈ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)) → + ((cert.modified.rho F0 ∈ FootprintVertices (occurrence owners.1)) → + ((cert.modified.rho F1 ∈ FootprintVertices (occurrence owners.2)) → + ((cert.modified.rho F0 ∈ FootprintVertices (occurrence a) ∩ FootprintVertices + (occurrence b)) → ((cert.modified.rho F1 ∈ FootprintVertices (occurrence a) ∩ + FootprintVertices (occurrence b)) → (Disjoint (occurrence a).cells (occurrence + b).cells ∧ Disjoint (occurrence a).cells (occurrence owners.1).cells ∧ Disjoint + (occurrence b).cells (occurrence owners.1).cells ∧ Disjoint (occurrence a).cells + (occurrence owners.2).cells ∧ Disjoint (occurrence b).cells (occurrence + owners.2).cells))))))))))))))))))))) ) := by + classical + intro q cfg C T cert a b row P O u v pairCells retargeted occurrence owners face0 face1 F0 F1 + faceDistinct hne allowed modifiedEdges modifiedPath pathAtOwners endpointsDistinct iA iB iO + ha0 hb0 ho0 jA jB jO ha1 hb1 ho1 commonPair0 commonPair1 ownerPoint0 ownerPoint1 + originalPair0 originalPair1 + cases row <;> dsimp [owners, P4418T3EndpointOwnerIndices] at * + all_goals + exact ⟨pairCells _ _ (by decide) (by decide), + pairCells _ _ (by decide) (by decide), + pairCells _ _ (by decide) (by decide), + pairCells _ _ (by decide) (by decide), + pairCells _ _ (by decide) (by decide)⟩ + +private theorem translateAdd : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), TileTranslation + (TileTranslation X x) y = TileTranslation X (x + y) ) := by + classical + intro X x y + cases X with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · simp only [TileTranslation, Finset.image_image, Function.comp_def] + congr 1 + funext z + simp only [GaussianTranslation, add_assoc] + · change (anchor + x) + y = anchor + (x + y) + exact add_assoc anchor x y + +private theorem translateZero : + (by + classical + exact + ∀ (X : ProtoTile), TileTranslation X 0 = X ) := by + classical + intro X + cases X with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · change Finset.image (fun z : GaussianInt => z + 0) cells = cells + simp + · simp [GaussianTranslation] + +private theorem touchingData : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))) → ( + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row + let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row + let F0 := cert.modified_face_equiv.symm face0 + let F1 := cert.modified_face_equiv.symm face1 + (F0 ≠ F1) → ((a ≠ b) → ((AllowedSubtileIncidence a b) → (((FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty) → ((∃ x y : + GaussianInt, SimpleGridPathBetween (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b)) (FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b)) x y) → ((SimpleGridPathBetween + (FootprintVertices (occurrence a) ∩ FootprintVertices (occurrence b)) (FootprintEdges + (occurrence a) ∩ FootprintEdges (occurrence b)) (cert.modified.rho F0) + (cert.modified.rho F1)) → ((cert.modified.rho F0 ≠ cert.modified.rho F1) → (∀ (iA : + Fin (3 : ℕ)), ∀ (iB : Fin (3 : ℕ)), ∀ (iO : Fin (3 : ℕ)), + (cert.modified.plane.faceVertex F0 iA = a) → ((cert.modified.plane.faceVertex F0 iB = + b) → ((cert.modified.plane.faceVertex F0 iO = owners.1) → (∀ (jA : Fin (3 : ℕ)), ∀ + (jB : Fin (3 : ℕ)), ∀ (jO : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F1 jA = a) + → ((cert.modified.plane.faceVertex F1 jB = b) → ((cert.modified.plane.faceVertex F1 + jO = owners.2) → ((cert.modified.rho F0 ∈ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b)) → ((cert.modified.rho F1 ∈ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)) → + ((cert.modified.rho F0 ∈ FootprintVertices (occurrence owners.1)) → + ((cert.modified.rho F1 ∈ FootprintVertices (occurrence owners.2)) → + ((cert.modified.rho F0 ∈ FootprintVertices (occurrence a) ∩ FootprintVertices + (occurrence b)) → ((cert.modified.rho F1 ∈ FootprintVertices (occurrence a) ∩ + FootprintVertices (occurrence b)) → ((Disjoint (occurrence a).cells (occurrence + b).cells ∧ Disjoint (occurrence a).cells (occurrence owners.1).cells ∧ Disjoint + (occurrence b).cells (occurrence owners.1).cells ∧ Disjoint (occurrence a).cells + (occurrence owners.2).cells ∧ Disjoint (occurrence b).cells (occurrence + owners.2).cells) → ((∀ (X : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), + TileTranslation (TileTranslation X x) y = TileTranslation X (x + y)) → ((∀ (X : + ProtoTile), TileTranslation X 0 = X) → ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : + ProtoTile), ∀ (d : GaussianInt), (TouchingTriple X Y Z) → (TouchingTriple + (TileTranslation X d) (TileTranslation Y d) (TileTranslation Z d))) → ((∀ + {X : ProtoTile}, ∀ {Y : ProtoTile}, ∀ {Z : ProtoTile}, (TouchingTriple X Y Z) → + (TouchingTriple X Z Y)) → ((∀ {X : ProtoTile}, ∀ {Y : ProtoTile}, ∀ {Z : ProtoTile}, + (TouchingTriple X Y Z) → (TouchingTriple Y X Z)) → ((∀ {X : ProtoTile}, ∀ + {Y : ProtoTile}, ∀ {Z : ProtoTile}, (TouchingTriple X Y Z) → (TouchingTriple Y Z X)) + → ((∀ {X : ProtoTile}, ∀ {Y : ProtoTile}, ∀ {Z : ProtoTile}, (TouchingTriple X Y Z) → + (TouchingTriple Z X Y)) → ((∀ {X : ProtoTile}, ∀ {Y : ProtoTile}, ∀ {Z : ProtoTile}, + (TouchingTriple X Y Z) → (TouchingTriple Z Y X)) → ((TouchingTriple (cert.P (0 : Fin + (3 : ℕ)) true) (TileTranslation (cert.P (0 : Fin (3 : ℕ)) false) cert.v) + (TileTranslation (cert.P (2 : Fin (3 : ℕ)) true) cert.v)) → ((TouchingTriple (cert.P + (0 : Fin (3 : ℕ)) true) (TileTranslation (cert.P (0 : Fin (3 : ℕ)) false) cert.v) + (cert.P (2 : Fin (3 : ℕ)) false)) → ((TouchingTriple (cert.P (0 : Fin (3 : ℕ)) true) + (TileTranslation (cert.P (0 : Fin (3 : ℕ)) false) (cert.u + cert.v)) (TileTranslation + (cert.P (1 : Fin (3 : ℕ)) true) (cert.u + cert.v))) → ((TouchingTriple (cert.P (0 : + Fin (3 : ℕ)) true) (TileTranslation (cert.P (0 : Fin (3 : ℕ)) false) (cert.u + + cert.v)) (cert.P (1 : Fin (3 : ℕ)) false)) → ((TouchingTriple (cert.P (0 : Fin (3 : + ℕ)) true) (TileTranslation (cert.P (1 : Fin (3 : ℕ)) true) (cert.u + cert.v)) + (TileTranslation (cert.P (2 : Fin (3 : ℕ)) true) cert.v)) → ((TouchingTriple (cert.P + (0 : Fin (3 : ℕ)) false) (TileTranslation (cert.P (1 : Fin (3 : ℕ)) false) (-cert.u - + cert.v)) (TileTranslation (cert.P (2 : Fin (3 : ℕ)) false) (-cert.v))) → + ((TouchingTriple (cert.P (1 : Fin (3 : ℕ)) true) (TileTranslation (cert.P (1 : Fin (3 + : ℕ)) false) (-cert.u)) (TileTranslation (cert.P (2 : Fin (3 : ℕ)) true) (-cert.u))) + → ((TouchingTriple (cert.P (1 : Fin (3 : ℕ)) true) (TileTranslation (cert.P (1 : Fin + (3 : ℕ)) false) (-cert.u)) (cert.P (2 : Fin (3 : ℕ)) false)) → (TouchingTriple + (occurrence a) (occurrence b) (occurrence owners.1) ∧ TouchingTriple (occurrence a) + (occurrence b) (occurrence owners.2)))))))))))))))))))))))))))))))))))))) ) := by + classical + intro q cfg C T cert a b row P O u v retargeted occurrence owners face0 face1 F0 F1 + faceDistinct hne allowed modifiedEdges modifiedPath pathAtOwners endpointsDistinct iA iB iO + ha0 hb0 ho0 jA jB jO ha1 hb1 ho1 commonPair0 commonPair1 ownerPoint0 ownerPoint1 + originalPair0 originalPair1 disjointData translateAdd translateZero touchTranslate touchXZY + touchYXZ touchYZX touchZXY touchZYX out1 out2 out3 out4 out5 out6 out7 out8 + cases row with + | positiveL1 _ _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, add_assoc, + add_comm, add_left_comm] using + touchTranslate _ _ _ (-(u+v)) out3 + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, add_assoc, + add_comm, add_left_comm] using + touchTranslate _ _ _ (-(u+v)) out4 + | positiveL2 _ _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using touchTranslate _ _ _ (-v) out1 + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using touchTranslate _ _ _ (-v) out2 + | positiveL3 _ _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using touchTranslate _ _ _ u out7 + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using touchTranslate _ _ _ u out8 + | reflectedL1 _ _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, u, v] using touchYXZ out3 + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, u, v] using touchYXZ out4 + | reflectedL2 _ _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, u, v] using touchYXZ out1 + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, u, v] using touchYXZ out2 + | reflectedL3 _ _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, u, v] using touchYXZ out7 + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, u, v] using touchYXZ out8 + | positiveS1 _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using + touchXZY (touchTranslate _ _ _ (-(u+v)) out3) + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using touchTranslate _ _ _ (-(u+v)) out5 + | positiveS2 _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using + touchXZY (touchTranslate _ _ _ (-v) out1) + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using + touchXZY (touchTranslate _ _ _ (-v) out5) + | positiveS3 _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using + touchYZX (touchTranslate _ _ _ (-v) out5) + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using + touchXZY (touchTranslate _ _ _ u out7) + | positiveS4 _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, u, v] using touchZXY out3 + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, u, v] using touchYXZ out5 + | positiveS5 _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, u, v] using touchZXY out1 + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, u, v] using touchZXY out5 + | positiveS6 _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using + touchZYX (touchTranslate _ _ _ (-(u+v)) out5) + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, u, v] using touchZXY out7 + | reflectedS1 _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, u, v] using touchYZX out4 + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using touchTranslate _ _ _ (u+v) out6 + | reflectedS2 _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, u, v] using touchYZX out2 + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using + touchXZY (touchTranslate _ _ _ v out6) + | reflectedS3 _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using touchYZX (touchTranslate _ _ _ v out6) + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, u, v] using touchYZX out8 + | reflectedS4 _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using + touchZYX (touchTranslate _ _ _ (-(u+v)) out4) + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, sub_eq_add_neg, + u, v] using touchYXZ out6 + | reflectedS5 _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using + touchZYX (touchTranslate _ _ _ (-v) out2) + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateZero, sub_eq_add_neg, + u, v] using touchZXY out6 + | reflectedS6 _ => + constructor + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using + touchZYX (touchTranslate _ _ _ (u+v) out6) + · simpa [occurrence, owners, P4418T3EndpointOwnerIndices, + SubtileOccurrenceInterpretation, translateAdd, translateZero, u, v, + add_assoc, add_comm, add_left_comm] using + touchZYX (touchTranslate _ _ _ u out8) + +end SelectedInterfaceGeometry + +namespace SelectedInterfaceCertificate + +private theorem selectedCertificate : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + (∀ (x : PeriodicSubtileIndex), ∀ (y : PeriodicSubtileIndex), (x ≠ y) → ((¬ ((x.label = .A + ∧ y.label = .B ∨ x.label = .B ∧ y.label = .A) ∧ x.first = y.first ∧ x.second = + y.second)) → (Disjoint (SubtileOccurrenceInterpretation P u v x).cells + (SubtileOccurrenceInterpretation P u v y).cells))) → ((∀ (x : PeriodicSubtileIndex), + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v x) ⊆ + FootprintVertices (SubtileOccurrenceInterpretation P u v x)) → (((FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))) → ( + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row + let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row + let F0 := cert.modified_face_equiv.symm face0 + let F1 := cert.modified_face_equiv.symm face1 + (F0 ≠ F1) → (((∃ iA iB iO : Fin 3, cert.modified.plane.faceVertex F0 iA = a ∧ + cert.modified.plane.faceVertex F0 iB = b ∧ cert.modified.plane.faceVertex F0 iO = + owners.1) ∧ (∃ jA jB jO : Fin 3, cert.modified.plane.faceVertex F1 jA = a ∧ + cert.modified.plane.faceVertex F1 jB = b ∧ cert.modified.plane.faceVertex F1 jO = + owners.2)) → ((a ≠ b) → ((AllowedSubtileIncidence a b) → (((FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty) → ((∃ x y : + GaussianInt, SimpleGridPathBetween (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b)) (FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges + (ModifiedSubtileOccurrenceInterpretation P O u v b)) x y) → ((SimpleGridPathBetween + (FootprintVertices (occurrence a) ∩ FootprintVertices (occurrence b)) (FootprintEdges + (occurrence a) ∩ FootprintEdges (occurrence b)) (cert.modified.rho F0) + (cert.modified.rho F1)) → ((cert.modified.rho F0 ≠ cert.modified.rho F1) → ( + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + Nonempty (P4418T3SelectedInterfaceData (occurrence a) (occurrence b) + (occurrence owners.1) (occurrence owners.2))))))))))))) ) := by + classical + intro q cfg C T cert a b row P O u v pairCells modifiedFootSubset retargeted occurrence owners + face0 face1 F0 F1 faceDistinct faceTable hne allowed modifiedEdges modifiedPath + pathAtOwners endpointsDistinct + rcases faceTable with ⟨⟨iA,iB,iO,ha0,hb0,ho0⟩, + ⟨jA,jB,jO,ha1,hb1,ho1⟩⟩ + have commonPair0 : + cert.modified.rho F0 ∈ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b) := + SelectedInterfaceGeometry.commonPair0 q cfg C T cert a b row retargeted iA iB ha0 hb0 + have commonPair1 : + cert.modified.rho F1 ∈ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b) := + SelectedInterfaceGeometry.commonPair1 q cfg C T cert a b row retargeted jA jB ha1 hb1 + have ownerPoint0 : cert.modified.rho F0 ∈ FootprintVertices (occurrence owners.1) := + SelectedInterfaceGeometry.ownerPoint0 q cfg C T cert a b row modifiedFootSubset retargeted + iO ho0 + have ownerPoint1 : cert.modified.rho F1 ∈ FootprintVertices (occurrence owners.2) := + SelectedInterfaceGeometry.ownerPoint1 q cfg C T cert a b row modifiedFootSubset retargeted + jO ho1 + have originalPair0 : cert.modified.rho F0 ∈ + FootprintVertices (occurrence a) ∩ FootprintVertices (occurrence b) := + SelectedInterfaceGeometry.originalPair0 q cfg C T cert a b row retargeted commonPair0 + have originalPair1 : cert.modified.rho F1 ∈ + FootprintVertices (occurrence a) ∩ FootprintVertices (occurrence b) := + SelectedInterfaceGeometry.originalPair1 q cfg C T cert a b row retargeted commonPair1 + have latticeOccurrence : ∀ x : PeriodicSubtileIndex, LatticeTile (occurrence x) := + SelectedInterfaceGeometry.latticeOccurrence q cfg C T cert + have disjointData : + Disjoint (occurrence a).cells (occurrence b).cells ∧ + Disjoint (occurrence a).cells (occurrence owners.1).cells ∧ + Disjoint (occurrence b).cells (occurrence owners.1).cells ∧ + Disjoint (occurrence a).cells (occurrence owners.2).cells ∧ + Disjoint (occurrence b).cells (occurrence owners.2).cells := + SelectedInterfaceGeometry.disjointData q cfg C T cert a b row pairCells retargeted + faceDistinct hne allowed modifiedEdges modifiedPath pathAtOwners endpointsDistinct iA + iB iO ha0 hb0 ho0 jA jB jO ha1 hb1 ho1 commonPair0 commonPair1 ownerPoint0 ownerPoint1 + originalPair0 originalPair1 + have translateAdd (X : ProtoTile) (x y : GaussianInt) : + TileTranslation (TileTranslation X x) y = TileTranslation X (x + y) := + SelectedInterfaceGeometry.translateAdd X x y + have translateZero (X : ProtoTile) : TileTranslation X 0 = X := + SelectedInterfaceGeometry.translateZero X + have cancelSum (x y : GaussianInt) : x + (y + (-x + -y)) = 0 := by abel + have touchTranslate (X Y Z : ProtoTile) (d : GaussianInt) + (h : TouchingTriple X Y Z) : + TouchingTriple (TileTranslation X d) (TileTranslation Y d) + (TileTranslation Z d) := + (TouchingTripleCovariance X Y Z d).1.mp h + have touchXZY {X Y Z : ProtoTile} (h : TouchingTriple X Y Z) : + TouchingTriple X Z Y := (TouchingTriplePermutations X Y Z).1 h |>.1 + have touchYXZ {X Y Z : ProtoTile} (h : TouchingTriple X Y Z) : + TouchingTriple Y X Z := (TouchingTriplePermutations X Y Z).1 h |>.2.1 + have touchYZX {X Y Z : ProtoTile} (h : TouchingTriple X Y Z) : + TouchingTriple Y Z X := (TouchingTriplePermutations X Y Z).1 h |>.2.2.1 + have touchZXY {X Y Z : ProtoTile} (h : TouchingTriple X Y Z) : + TouchingTriple Z X Y := (TouchingTriplePermutations X Y Z).1 h |>.2.2.2.1 + have touchZYX {X Y Z : ProtoTile} (h : TouchingTriple X Y Z) : + TouchingTriple Z Y X := (TouchingTriplePermutations X Y Z).1 h |>.2.2.2.2 + rcases cert.outer_touching with ⟨out1,out2,out3,out4,out5,out6,out7,out8⟩ + have touchingData : + TouchingTriple (occurrence a) (occurrence b) (occurrence owners.1) ∧ + TouchingTriple (occurrence a) (occurrence b) (occurrence owners.2) := + SelectedInterfaceGeometry.touchingData q cfg C T cert a b row retargeted faceDistinct + hne allowed modifiedEdges modifiedPath pathAtOwners endpointsDistinct iA iB iO ha0 hb0 + ho0 jA jB jO ha1 hb1 ho1 commonPair0 commonPair1 ownerPoint0 ownerPoint1 originalPair0 + originalPair1 disjointData translateAdd translateZero touchTranslate touchXZY touchYXZ + touchYZX touchZXY touchZYX out1 out2 out3 out4 out5 out6 out7 out8 + have touching0 := touchingData.1 + have touching1 := touchingData.2 + exact ⟨cert.modified.rho F0, cert.modified.rho F1, endpointsDistinct, + pathAtOwners, latticeOccurrence a, latticeOccurrence b, + latticeOccurrence owners.1, latticeOccurrence owners.2, + disjointData.1, disjointData.2.1, disjointData.2.2.1, + disjointData.2.2.2.1, disjointData.2.2.2.2, + touching0, touching1, ⟨originalPair0, ownerPoint0⟩, + ⟨originalPair1, ownerPoint1⟩⟩ + +end SelectedInterfaceCertificate + +theorem P4418T3SelectedInterfaceExists + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b) : + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + Nonempty (P4418T3SelectedInterfaceData (occurrence a) (occurrence b) + (occurrence owners.1) (occurrence owners.2)) := by +-- BODY + classical + let P := cert.P + let O := cert.O + let u := cert.u + let v := cert.v + have hOA : O.cells ⊆ (P 0 true).cells := SelectedInterfaceGeometry.hOA q cfg C T cert + have hOB : O.cells ⊆ (P 0 false).cells := SelectedInterfaceGeometry.hOB q cfg C T cert + have separation := BandOriginalPairSeparation P O u v hOA hOB cert.partition + have pairCells (x y : PeriodicSubtileIndex) (hxy : x ≠ y) + (hnot : ¬ ((x.label = .A ∧ y.label = .B ∨ + x.label = .B ∧ y.label = .A) ∧ x.first = y.first ∧ x.second = y.second)) : + Disjoint (SubtileOccurrenceInterpretation P u v x).cells + (SubtileOccurrenceInterpretation P u v y).cells := + separation.2 x y hxy hnot + have translatedCells (X : ProtoTile) (d : GaussianInt) : + (TileTranslation X d).cells = X.cells.image (GaussianTranslation d) := + (TileTranslationFormulas X d).1 + have cellInclusion (X Y : ProtoTile) (hXY : X.cells ⊆ Y.cells) + (d : GaussianInt) : + (TileTranslation X d).cells ⊆ (TileTranslation Y d).cells := + SelectedInterfaceGeometry.cellInclusion translatedCells X Y hXY d + have isolated (m n : Int) : + ∀ z ∈ CellSupportedFootprintVertices + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)), + ∀ x : GaussianInt, z ∈ FootprintVertices (⟨{x}, x⟩ : ProtoTile) → + x ∈ (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells ∨ + x ∈ (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells := + SelectedInterfaceGeometry.isolated q cfg C T cert m n + have translatedNonempty (X : ProtoTile) (hX : X.cells.Nonempty) + (d : GaussianInt) : (TileTranslation X d).cells.Nonempty := + SelectedInterfaceGeometry.translatedNonempty translatedCells X hX d + have parentNonempty (x : PeriodicSubtileIndex) : + (SubtileOccurrenceInterpretation P u v x).cells.Nonempty := + SelectedInterfaceGeometry.parentNonempty q cfg C T cert translatedNonempty x + have complementNonempty (m n : Int) : + (TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))).cells.Nonempty := + SelectedInterfaceGeometry.complementNonempty q cfg C T cert translatedNonempty m n + have deletionSupport (m n : Int) (Y : ProtoTile) (hY : Y.cells.Nonempty) : + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)).cells = ∅ ∨ + ((TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))).cells.Nonempty ∧ + Y.cells.Nonempty) := SelectedInterfaceGeometry.deletionSupport q cfg C T cert + complementNonempty m n Y hY + have deleteEdge (m n : Int) (Y : ProtoTile) + (hYA : Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩).cells) + (hYB : Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.B,m,n⟩).cells) : + FootprintEdges (TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))) ∩ + FootprintEdges Y = + FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) ∩ FootprintEdges Y := + SelectedInterfaceGeometry.deleteEdge q cfg C T cert hOA cellInclusion isolated m n Y + hYA hYB + have deleteVertex (m n : Int) (Y : ProtoTile) + (hYA : Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩).cells) + (hYB : Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.B,m,n⟩).cells) + (hY : Y.cells.Nonempty) : + FootprintVertices (TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))) ∩ + FootprintVertices Y = + FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) ∩ FootprintVertices Y := + SelectedInterfaceGeometry.deleteVertex q cfg C T cert hOA cellInclusion isolated + deletionSupport m n Y hYA hYB hY + have modifiedA (m n : Int) : + ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A,m,n⟩ = + TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)) := + SelectedInterfaceGeometry.modifiedA q cfg C T cert m n + have modifiedOther (x : PeriodicSubtileIndex) (hx : x.label ≠ .A) : + ModifiedSubtileOccurrenceInterpretation P O u v x = + SubtileOccurrenceInterpretation P u v x := SelectedInterfaceGeometry.modifiedOther q cfg + C T cert x hx + have modifiedAFootprintSubset (m n : Int) : + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A,m,n⟩) ⊆ + FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) := + SelectedInterfaceGeometry.modifiedAFootprintSubset q cfg C T cert complementNonempty + modifiedA m n + have modifiedFootSubset (x : PeriodicSubtileIndex) : + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v x) ⊆ + FootprintVertices (SubtileOccurrenceInterpretation P u v x) := + SelectedInterfaceGeometry.modifiedFootSubset q cfg C T cert modifiedAFootprintSubset x + have modifiedAEdges (m n : Int) (x : PeriodicSubtileIndex) + (hx : x.label ≠ .A) + (hpair : ¬ (x.label = .B ∧ x.first = m ∧ x.second = n)) : + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A,m,n⟩) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v x) = + FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v x) := + SelectedInterfaceGeometry.modifiedAEdges q cfg C T cert pairCells deleteEdge + modifiedA modifiedOther m n x hx hpair + have modifiedAVertices (m n : Int) (x : PeriodicSubtileIndex) + (hx : x.label ≠ .A) + (hpair : ¬ (x.label = .B ∧ x.first = m ∧ x.second = n)) : + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A,m,n⟩) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v x) = + FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) ∩ + FootprintVertices (SubtileOccurrenceInterpretation P u v x) := + SelectedInterfaceGeometry.modifiedAVertices q cfg C T cert pairCells parentNonempty + deleteVertex modifiedA modifiedOther m n x hx hpair + have retargeted : + (FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b) = + FootprintEdges (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v b)) ∧ + (FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b) = + FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices (SubtileOccurrenceInterpretation P u v b)) := + SelectedInterfaceGeometry.retargeted q cfg C T cert a b row modifiedAEdges + modifiedAVertices + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row + let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row + let F0 := cert.modified_face_equiv.symm face0 + let F1 := cert.modified_face_equiv.symm face1 + have faceVertex (f : PeriodicSubtileFaceIndex) (i : Fin 3) : + cert.modified.plane.faceVertex (cert.modified_face_equiv.symm f) i = + SixSubtileFaceVertices f i := SelectedInterfaceGeometry.faceVertex q cfg C T cert f i + have faceDistinct : F0 ≠ F1 := SelectedInterfaceGeometry.faceDistinct q cfg C T cert a b row + retargeted + have faceTable : + (∃ iA iB iO : Fin 3, + cert.modified.plane.faceVertex F0 iA = a ∧ + cert.modified.plane.faceVertex F0 iB = b ∧ + cert.modified.plane.faceVertex F0 iO = owners.1) ∧ + (∃ jA jB jO : Fin 3, + cert.modified.plane.faceVertex F1 jA = a ∧ + cert.modified.plane.faceVertex F1 jB = b ∧ + cert.modified.plane.faceVertex F1 jO = owners.2) := SelectedInterfaceGeometry.faceTable q + cfg C T cert a b row retargeted faceVertex faceDistinct + have reversePath {V : Set GaussianInt} {E : Set (Finset GaussianInt)} + {x y : GaussianInt} (h : SimpleGridPathBetween V E x y) : + SimpleGridPathBetween V E y x := SelectedInterfaceGeometry.reversePath (V := V) (E := E) (x + := x) (y := y) h + have hne : a ≠ b := SelectedInterfaceGeometry.hne q cfg C T cert a b row retargeted + faceDistinct faceTable + have allowed : AllowedSubtileIncidence a b := SelectedInterfaceGeometry.allowed q cfg C T cert + a b row retargeted faceDistinct faceTable hne + have modifiedEdges : + (FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty := + SelectedInterfaceGeometry.modifiedEdges q cfg C T cert a b hne allowed + have modifiedPath : ∃ x y : GaussianInt, + SimpleGridPathBetween + (FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)) + (FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b)) x y := + SelectedInterfaceGeometry.modifiedPath q cfg C T cert a b hne modifiedEdges + have headLastNe (p : List GaussianInt) (hnd : p.Nodup) + (hlen : 2 ≤ p.length) : p.head? ≠ p.getLast? := SelectedInterfaceGeometry.headLastNe p hnd + hlen + have pathAtOwners : + SimpleGridPathBetween + (FootprintVertices (occurrence a) ∩ FootprintVertices (occurrence b)) + (FootprintEdges (occurrence a) ∩ FootprintEdges (occurrence b)) + (cert.modified.rho F0) (cert.modified.rho F1) := SelectedInterfaceGeometry.pathAtOwners q + cfg C T cert a b row retargeted faceDistinct faceTable reversePath hne modifiedEdges + have endpointsDistinct : cert.modified.rho F0 ≠ cert.modified.rho F1 := + SelectedInterfaceGeometry.endpointsDistinct q cfg C T cert a b row retargeted headLastNe + pathAtOwners + have selectedCertificate : + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row + Nonempty (P4418T3SelectedInterfaceData (occurrence a) (occurrence b) + (occurrence owners.1) (occurrence owners.2)) := + SelectedInterfaceCertificate.selectedCertificate q cfg C T cert a b row pairCells + modifiedFootSubset retargeted faceDistinct faceTable hne allowed modifiedEdges + modifiedPath pathAtOwners endpointsDistinct + exact selectedCertificate + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4431T1OwnerTransitionSelector.lean b/LeanPool/ApollonianSuperharmonic/P4431T1OwnerTransitionSelector.lean new file mode 100644 index 0000000000..fc2888c993 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4431T1OwnerTransitionSelector.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Data.Fintype.Pi +public import Mathlib.Tactic.FinCases + +-- [TABLET NODE: P4431T1OwnerTransitionSelector] + +/-! +# P4431T1OwnerTransitionSelector + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4431T1OwnerTransitionSelector {α : Type*} + (o : Fin 4 → α) (s : Fin 4 → Bool) + (hleft : ∀ i k, s i ≠ s (i + 1) → o k = o i → s k = s i) + (hright : ∀ i k, s i ≠ s (i + 1) → + o k = o (i + 1) → s k = s (i + 1)) + (hrepeat : o 0 = o 1 ∨ o 0 = o 2 ∨ o 0 = o 3 ∨ + o 1 = o 2 ∨ o 1 = o 3 ∨ o 2 = o 3) + (hchecker : ¬ ((o 0 = o 2 ∧ o 1 ≠ o 0 ∧ o 3 ≠ o 0) ∨ + (o 1 = o 3 ∧ o 0 ≠ o 1 ∧ o 2 ≠ o 1))) + (hopposite : s 0 ≠ s 2 ∨ s 1 ≠ s 3) : + ∃ i, s i ≠ s (i + 1) ∧ + (o i = o (i + 3) ∨ o (i + 1) = o (i + 2)) := by +-- BODY + classical + have finite_selection : + ∀ (a b c d : Fin 4) (sa sb sc sd : Bool), + let p : Fin 4 → Fin 4 := ![a, b, c, d] + let t : Fin 4 → Bool := ![sa, sb, sc, sd] + (∀ i k, t i ≠ t (i + 1) → + (p k = p i → t k = t i) ∧ + (p k = p (i + 1) → t k = t (i + 1))) → + (a = b ∨ a = c ∨ a = d ∨ b = c ∨ b = d ∨ c = d) → + ¬ ((a = c ∧ b ≠ a ∧ d ≠ a) ∨ + (b = d ∧ a ≠ b ∧ c ≠ b)) → + (sa ≠ sc ∨ sb ≠ sd) → + ∃ i, t i ≠ t (i + 1) ∧ + (p i = p (i + 3) ∨ p (i + 1) = p (i + 2)) := by + exact ((((by decide +kernel)))) + let encode : α → Fin 4 := fun a => + if a = o 0 then 0 else if a = o 1 then 1 else if a = o 2 then 2 else 3 + have encode_eq (i j : Fin 4) : encode (o i) = encode (o j) ↔ o i = o j := by + clear * - o encode + fin_cases i <;> fin_cases j <;> + simp only [ Fin.isValue, Fin.zero_eta, ↓reduceIte, encode, Fin.mk_one, left_eq_ite_iff, + zero_ne_one, imp_false, Decidable.not_not, Fin.reduceFinMk, ite_eq_left_iff, one_ne_zero ] <;> + (try split_ifs) <;> simp_all [eq_comm] + have ho : ![encode (o 0), encode (o 1), encode (o 2), encode (o 3)] = + fun i => encode (o i) := by + funext i + fin_cases i <;> rfl + have hs : ![s 0, s 1, s 2, s 3] = s := by + funext i + fin_cases i <;> rfl + have hf := finite_selection (encode (o 0)) (encode (o 1)) + (encode (o 2)) (encode (o 3)) (s 0) (s 1) (s 2) (s 3) + dsimp only at hf + rw [ho, hs] at hf + simp only [ne_eq, encode_eq] at hf + exact hf (fun i k h => ⟨hleft i k h, hright i k h⟩) + hrepeat hchecker hopposite + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean b/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean new file mode 100644 index 0000000000..d415ac6266 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean @@ -0,0 +1,1025 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.AffineTriangularComplexChart +public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality + +-- [TABLET NODE: P4456T2BandGraphTriangle] + +/-! +# P4456T2BandGraphTriangle + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace BandGraphTriangleGeometry + +private theorem hTne : + (by + classical + exact + ∀ (T : ProtoTile), (LatticeTile T) → (T.cells.Nonempty) ) := by + classical + intro T hT1 + obtain ⟨e⟩ := hT1 + let p := (e ⟨(0 : Real × Real), by simp⟩).val + have hp : p ∈ TileRealization T := (e ⟨(0 : Real × Real), by simp⟩).property + simp only [TileRealization, Set.mem_iUnion] at hp + rcases hp with ⟨x, hx, _⟩ + exact ⟨x, hx⟩ + +private theorem hcentCells : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (g : GaussianInt), ((TileTranslation (TileQuarterTurn T) g).cells = + T.cells) → ( + let rot : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x - 1 + let cent : GaussianInt → GaussianInt := fun x => GaussianTranslation g (rot x) + T.cells.image cent = T.cells) ) := by + classical + intro T g hcenter rot cent + have hh := hcenter + rw [(TileTranslationFormulas (TileQuarterTurn T) g).1, + (TileQuarterTurnFormulas T).1] at hh + rw [Finset.image_image] at hh + change T.cells.image (fun x => GaussianTranslation g + (GaussianQuarterTurn x - 1)) = T.cells at hh + simpa [cent, rot] using hh + +private theorem hturnedCells : + (by + classical + exact + (Fin 4 → CircleCoordinates) → (∀ (T : ProtoTile), ∀ (g : GaussianInt), (GaussianRealPoint + g = ((TileCentroid T).1 + (TileCentroid T).2, (TileCentroid T).2 - (TileCentroid + T).1)) → (((TileTranslation (TileQuarterTurn T) g).cells = T.cells) → ( + let rot : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x - 1 + let cent : GaussianInt → GaussianInt := fun x => GaussianTranslation g (rot x) + (T.cells.image cent = T.cells) → (∀ (d : GaussianInt), (TileTranslation (TileQuarterTurn + (TileTranslation T d)) g).cells = (TileTranslation T (GaussianQuarterTurn + d)).cells)))) ) := by + classical + intro q T g hg hcenter rot cent hcentCells d + rw [(TileTranslationFormulas (TileQuarterTurn (TileTranslation T d)) g).1, + (TileQuarterTurnFormulas (TileTranslation T d)).1, + (TileTranslationFormulas T d).1, + (TileTranslationFormulas T (GaussianQuarterTurn d)).1] + simp only [Finset.image_image, Function.comp_def] + change T.cells.image (fun x => GaussianTranslation g + (GaussianQuarterTurn (GaussianTranslation d x) - 1)) = + T.cells.image (fun x => GaussianTranslation (GaussianQuarterTurn d) x) + calc + _ = T.cells.image (fun x => GaussianTranslation (GaussianQuarterTurn d) (cent x)) := by + apply Finset.image_congr + intro x hx + dsimp [cent, rot] + rcases x with ⟨a, b⟩ + rcases d with ⟨c, e⟩ + rcases g with ⟨r, s⟩ + apply Zsqrtd.ext_iff.mpr + constructor <;> simp [GaussianTranslation, GaussianQuarterTurn] <;> omega + _ = (T.cells.image cent).image (GaussianTranslation (GaussianQuarterTurn d)) := by + rw [Finset.image_image] + rfl + _ = T.cells.image (GaussianTranslation (GaussianQuarterTurn d)) := by + rw [hcentCells] + +private theorem hOpp : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + (TouchingTriple T (TileTranslation T u) (TileTranslation T (-v))) → ((T.cells.Nonempty) → + (∀ (g : GaussianInt), ((TileTranslation (TileQuarterTurn T) g).cells = T.cells) → ((∀ + (d : GaussianInt), (TileTranslation (TileQuarterTurn (TileTranslation T d)) g).cells + = (TileTranslation T (GaussianQuarterTurn d)).cells) → (TouchingTriple T + (TileTranslation T (-u)) (TileTranslation T v))))) ) := by + classical + intro q T u v hT3 hTne g hcenter hturnedCells + have htransne (d : GaussianInt) : (TileTranslation T d).cells.Nonempty := by + rw [(TileTranslationFormulas T d).1] + exact hTne.image _ + have observables (A B : ProtoTile) (hc : A.cells = B.cells) + (hBn : B.cells.Nonempty) : + BoundaryFootprintVertices A = BoundaryFootprintVertices B ∧ + BoundaryFootprintEdges A = BoundaryFootprintEdges B := by + have hext := ProtoTileObservableExtensionality A B hc (by + intro hempty + have hbe : B.cells = ∅ := by rw [← hc]; exact hempty + exact False.elim (hBn.ne_empty hbe)) + exact ⟨hext.2.1, hext.2.2.1⟩ + have replaceTriple (A A' B B' C C' : ProtoTile) + (hAc : A.cells = A'.cells) (hBc : B.cells = B'.cells) + (hCc : C.cells = C'.cells) + (hAb : BoundaryFootprintVertices A = BoundaryFootprintVertices A') + (hAe : BoundaryFootprintEdges A = BoundaryFootprintEdges A') + (hBb : BoundaryFootprintVertices B = BoundaryFootprintVertices B') + (hBe : BoundaryFootprintEdges B = BoundaryFootprintEdges B') + (hCb : BoundaryFootprintVertices C = BoundaryFootprintVertices C') + (hCe : BoundaryFootprintEdges C = BoundaryFootprintEdges C') + (hnA : A.cells.Nonempty) (hnB : B.cells.Nonempty) (hnC : C.cells.Nonempty) + (hh : TouchingTriple A B C) : TouchingTriple A' B' C' := by + have hnA' : A'.cells.Nonempty := by rw [← hAc]; exact hnA + have hnB' : B'.cells.Nonempty := by rw [← hBc]; exact hnB + have hnC' : C'.cells.Nonempty := by rw [← hCc]; exact hnC + have touch (X X' Y Y' : ProtoTile) (hX : X.cells = X'.cells) + (hY : Y.cells = Y'.cells) + (hXb : BoundaryFootprintVertices X = BoundaryFootprintVertices X') + (hXe : BoundaryFootprintEdges X = BoundaryFootprintEdges X') + (hYb : BoundaryFootprintVertices Y = BoundaryFootprintVertices Y') + (hYe : BoundaryFootprintEdges Y = BoundaryFootprintEdges Y') + (hnX : X.cells.Nonempty) (hnY : Y.cells.Nonempty) + (ht : TileTouching X Y) : TileTouching X' Y' := by + have hnX' : X'.cells.Nonempty := by rw [← hX]; exact hnX + have hnY' : Y'.cells.Nonempty := by rw [← hY]; exact hnY + rcases ht with ⟨_, _, hdis, hpath⟩ | ⟨hempty, _⟩ | ⟨hempty, _⟩ + · left + refine ⟨hnX', hnY', ?_, ?_⟩ + · simpa [hX, hY] using hdis + · simpa [hXb, hYb, hXe, hYe] using hpath + · exact False.elim ((Finset.not_nonempty_iff_eq_empty.mpr hempty) hnX) + · exact False.elim ((Finset.not_nonempty_iff_eq_empty.mpr hempty) hnY) + rcases hh with ⟨hab, hbc, hca, x, hx, hxuniq⟩ + refine ⟨touch A A' B B' hAc hBc hAb hAe hBb hBe hnA hnB hab, + touch B B' C C' hBc hCc hBb hBe hCb hCe hnB hnC hbc, + touch C C' A A' hCc hAc hCb hCe hAb hAe hnC hnA hca, x, ?_, ?_⟩ + · change x ∈ BoundaryFootprintVertices A' ∧ + x ∈ BoundaryFootprintVertices B' ∧ x ∈ BoundaryFootprintVertices C' + rw [← hAb, ← hBb, ← hCb] + exact hx + · intro y hy + have hy' : y ∈ BoundaryFootprintVertices A ∧ + y ∈ BoundaryFootprintVertices B ∧ y ∈ BoundaryFootprintVertices C := by + constructor + · rw [hAb]; exact hy.1 + constructor + · rw [hBb]; exact hy.2.1 + · rw [hCb]; exact hy.2.2 + exact hxuniq y hy' + have centeredTriple (d e : GaussianInt) + (ht : TouchingTriple T (TileTranslation T d) (TileTranslation T e)) : + TouchingTriple T (TileTranslation T (GaussianQuarterTurn d)) + (TileTranslation T (GaussianQuarterTurn e)) := by + have hq := (TouchingTripleCovariance T (TileTranslation T d) + (TileTranslation T e) 0).2.1.mp ht + have hs := (TouchingTripleCovariance (TileQuarterTurn T) + (TileQuarterTurn (TileTranslation T d)) + (TileQuarterTurn (TileTranslation T e)) g).1.mp hq + have hA := observables (TileTranslation (TileQuarterTurn T) g) T hcenter hTne + have hAne : (TileTranslation (TileQuarterTurn T) g).cells.Nonempty := by + rw [hcenter] + exact hTne + have hBcells := hturnedCells d + have hCcells := hturnedCells e + have hB := observables (TileTranslation (TileQuarterTurn (TileTranslation T d)) g) + (TileTranslation T (GaussianQuarterTurn d)) hBcells (htransne _) + have hC := observables (TileTranslation (TileQuarterTurn (TileTranslation T e)) g) + (TileTranslation T (GaussianQuarterTurn e)) hCcells (htransne _) + exact replaceTriple _ _ _ _ _ _ hcenter hBcells hCcells + hA.1 hA.2 hB.1 hB.2 hC.1 hC.2 hAne + (by rw [hBcells]; exact htransne _) (by rw [hCcells]; exact htransne _) hs + have hrot := centeredTriple u (-v) hT3 + have hhalf (z : GaussianInt) : GaussianQuarterTurn (GaussianQuarterTurn z) = -z := by + rcases z with ⟨a, b⟩ + apply Zsqrtd.ext_iff.mpr + simp [GaussianQuarterTurn] + simpa [hhalf] using centeredTriple (GaussianQuarterTurn u) + (GaussianQuarterTurn (-v)) hrot + +private theorem adjSymm : + (by + classical + exact + (Fin 4 → CircleCoordinates) → ((ProtoTile) → (∀ (x : Int × Int), ∀ (y : Int × Int), + (TriangularLatticeAdjacent x y) → (TriangularLatticeAdjacent y x))) ) := by + classical + intro q T x y h + simp only [TriangularLatticeAdjacent, Prod.ext_iff] at h ⊢ + rcases h with h | h | h | h | h | h <;> + simp only [Prod.fst_sub, Prod.snd_sub] at h ⊢ <;> omega + +private theorem hxy : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : + PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int + => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))), ∀ (a : ι), ∀ (b : ι), (P.plane.adjacent + a b) → ( + let x : Int × Int := chart.vertexEquiv.symm a + let y : Int × Int := chart.vertexEquiv.symm b + (chart.vertexEquiv x = a) → ((chart.vertexEquiv y = b) → (TriangularLatticeAdjacent x + y))) ) := by + classical + intro q T ι P chart a b hab x y hxa hyb + apply (chart.adjacent_iff x y).mp + simpa [hxa, hyb] using hab + +private theorem hyz : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : + PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int + => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))), ∀ (b : ι), ∀ (c : ι), (P.plane.adjacent + b c) → ( + let y : Int × Int := chart.vertexEquiv.symm b + let z : Int × Int := chart.vertexEquiv.symm c + (chart.vertexEquiv y = b) → ((chart.vertexEquiv z = c) → (TriangularLatticeAdjacent y + z))) ) := by + classical + intro q T ι P chart b c hbc y z hyb hzc + apply (chart.adjacent_iff y z).mp + simpa [hyb, hzc] using hbc + +private theorem hzx : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : + PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int + => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))), ∀ (a : ι), ∀ (c : ι), (P.plane.adjacent + c a) → ( + let x : Int × Int := chart.vertexEquiv.symm a + let z : Int × Int := chart.vertexEquiv.symm c + (chart.vertexEquiv x = a) → ((chart.vertexEquiv z = c) → (TriangularLatticeAdjacent z + x))) ) := by + classical + intro q T ι P chart a c hca' x z hxa hzc + apply (chart.adjacent_iff z x).mp + simpa [hzc, hxa] using hca' + +private theorem hpAt297 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : + PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int + => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))), ∀ (a : ι), ∀ (b : ι), + let x : Int × Int := chart.vertexEquiv.symm a + let y : Int × Int := chart.vertexEquiv.symm b + (TriangularLatticeAdjacent x y) → ( + let p := y - x + TriangularLatticeAdjacent (0, 0) p) ) := by + classical + intro q T ι P chart a b x y hxy p + simp [TriangularLatticeAdjacent, p] at hxy ⊢ + simpa [Prod.sub_def, Prod.ext_iff] using hxy + +private theorem hr : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : + PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int + => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))), ∀ (a : ι), ∀ (c : ι), + let x : Int × Int := chart.vertexEquiv.symm a + let z : Int × Int := chart.vertexEquiv.symm c + (TriangularLatticeAdjacent x z) → ( + let r := z - x + TriangularLatticeAdjacent (0, 0) r) ) := by + classical + intro q T ι P chart a c x z hzx' r + simp [TriangularLatticeAdjacent, r] at hzx' ⊢ + simpa [Prod.sub_def, Prod.ext_iff] using hzx' + +private theorem hpr : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : + PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int + => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), + let x : Int × Int := chart.vertexEquiv.symm a + let y : Int × Int := chart.vertexEquiv.symm b + let z : Int × Int := chart.vertexEquiv.symm c + (TriangularLatticeAdjacent y z) → ( + let p := y - x + let r := z - x + TriangularLatticeAdjacent p r) ) := by + classical + intro q T ι P chart a b c x y z hyz p r + have hh := hyz + simp only [TriangularLatticeAdjacent, Prod.ext_iff] at hh ⊢ + simp only [p, r, Prod.sub_def] at hh ⊢ + rcases hh with hh | hh | hh | hh | hh | hh <;> omega + +private theorem hdir : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : + PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int + => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), + let x : Int × Int := chart.vertexEquiv.symm a + let y : Int × Int := chart.vertexEquiv.symm b + let z : Int × Int := chart.vertexEquiv.symm c + let p := y - x + let r := z - x + (TriangularLatticeAdjacent (0, 0) p) → ((TriangularLatticeAdjacent (0, 0) r) → + ((TriangularLatticeAdjacent p r) → ((p = (1, 0) ∧ r = (1, 1)) ∨ (p = (1, 1) ∧ r = (1, + 0)) ∨ (p = (1, 1) ∧ r = (0, 1)) ∨ (p = (0, 1) ∧ r = (1, 1)) ∨ (p = (0, 1) ∧ r = (-1, + 0)) ∨ (p = (-1, 0) ∧ r = (0, 1)) ∨ (p = (-1, 0) ∧ r = (-1, -1)) ∨ (p = (-1, -1) ∧ r = + (-1, 0)) ∨ (p = (-1, -1) ∧ r = (0, -1)) ∨ (p = (0, -1) ∧ r = (-1, -1)) ∨ (p = (0, -1) + ∧ r = (1, 0)) ∨ (p = (1, 0) ∧ r = (0, -1))))) ) := by + classical + intro q T ι P chart a b c x y z p r hp hr hpr + generalize hpv : p = pp at hp hr hpr ⊢ + generalize hrv : r = rr at hp hr hpr ⊢ + clear * - hp hr hpr + simp only [TriangularLatticeAdjacent, Prod.ext_iff, Prod.sub_def, + ] at hp hr hpr + rcases hp with hp | hp | hp | hp | hp | hp + all_goals rcases hr with hr | hr | hr | hr | hr | hr + all_goals simp_all [Prod.ext_iff] + +private theorem shift_add : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + ∀ (w : Int × Int), ∀ (w' : Int × Int), shift (w + w') = shift w + shift w' ) := by + classical + intro q u v shift w w' + dsimp [shift] + simp only [Int.cast_add, add_mul] + ring + +private theorem shift_e1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + (∀ (w : Int × Int), ∀ (w' : Int × Int), shift (w + w') = shift w + shift w') → (∀ (w : + Int × Int), shift (w + (1, 0)) = shift w + u) ) := by + classical + intro q u v shift shift_add w + rw [shift_add] + simp [shift, u] + +private theorem shift_e2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + (∀ (w : Int × Int), ∀ (w' : Int × Int), shift (w + w') = shift w + shift w') → (∀ (w : + Int × Int), shift (w + (0, 1)) = shift w + v) ) := by + classical + intro q u v shift shift_add w + rw [shift_add] + simp [shift, v] + +private theorem shift_neg_e1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + (∀ (w : Int × Int), ∀ (w' : Int × Int), shift (w + w') = shift w + shift w') → (∀ (w : + Int × Int), shift (w - (1, 0)) = shift w - u) ) := by + classical + intro q u v shift shift_add w + have h := shift_add (w - (1, 0)) (1, 0) + have he : (w - (1, 0)) + (1, 0) = w := by ext <;> simp + rw [he] at h + have hc : shift (1, 0) = u := by simp [shift, u] + rw [hc] at h + calc + shift (w - (1, 0)) = (shift (w - (1, 0)) + u) - u := by simp + _ = shift w - u := by rw [h.symm] + +private theorem shift_neg_e2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + (∀ (w : Int × Int), ∀ (w' : Int × Int), shift (w + w') = shift w + shift w') → (∀ (w : + Int × Int), shift (w - (0, 1)) = shift w - v) ) := by + classical + intro q u v shift shift_add w + have h := shift_add (w - (0, 1)) (0, 1) + have he : (w - (0, 1)) + (0, 1) = w := by ext <;> simp + rw [he] at h + have hc : shift (0, 1) = v := by simp [shift, v] + rw [hc] at h + calc + shift (w - (0, 1)) = (shift (w - (0, 1)) + v) - v := by simp + _ = shift w - v := by rw [h.symm] + +private theorem shift_mne1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + (∀ (w : Int × Int), ∀ (w' : Int × Int), shift (w + w') = shift w + shift w') → (∀ (w : + Int × Int), shift (w + (-1, 0)) = shift w - u) ) := by + classical + intro q u v shift shift_add w + rw [shift_add] + have hc : shift (-1, 0) = -u := by simp [shift, u] + rw [hc] + abel + +private theorem shift_mne2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + (∀ (w : Int × Int), ∀ (w' : Int × Int), shift (w + w') = shift w + shift w') → (∀ (w : + Int × Int), shift (w + (0, -1)) = shift w - v) ) := by + classical + intro q u v shift shift_add w + rw [shift_add] + have hc : shift (0, -1) = -v := by simp [shift, v] + rw [hc] + abel + +private theorem transAssoc : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (s : GaussianInt), ∀ (t : GaussianInt), TileTranslation + (TileTranslation A s) t = TileTranslation A (s + t) ) := by + classical + intro A s t + cases A with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · change (cells.image (GaussianTranslation s)).image (GaussianTranslation t) = + cells.image (GaussianTranslation (s + t)) + rw [Finset.image_image] + apply Finset.image_congr + intro x hx + simp [GaussianTranslation, add_assoc] + · change GaussianTranslation t (GaussianTranslation s anchor) = + GaussianTranslation (s + t) anchor + simp [GaussianTranslation, add_assoc] + +private theorem upFace : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + (TouchingTriple T (TileTranslation T u) (TileTranslation T (-v))) → ( + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + let tileAt : Int × Int → ProtoTile := fun w => TileTranslation T (shift w) + (∀ (w : Int × Int), shift (w + (1, 0)) = shift w + u) → ((∀ (w : Int × Int), shift (w + + (0, -1)) = shift w - v) → ((∀ (A : ProtoTile), ∀ (s : GaussianInt), ∀ (t : + GaussianInt), TileTranslation (TileTranslation A s) t = TileTranslation A (s + t)) → + (∀ (w : Int × Int), TouchingTriple (tileAt w) (tileAt (w + (1, 0))) (tileAt (w - (0, + 1))))))) ) := by + classical + intro q T u v hT3 shift tileAt shift_e1 shift_mne2 transAssoc w + have hh := (TouchingTripleCovariance T (TileTranslation T u) + (TileTranslation T (-v)) (shift w)).1.mp hT3 + simpa [tileAt, shift_e1, shift_neg_e2, shift_mne2, transAssoc, add_comm, add_left_comm, + add_assoc, sub_eq_add_neg] using hh + +private theorem downFace : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + (TouchingTriple T (TileTranslation T (-u)) (TileTranslation T v)) → ( + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + let tileAt : Int × Int → ProtoTile := fun w => TileTranslation T (shift w) + (∀ (w : Int × Int), shift (w + (0, 1)) = shift w + v) → ((∀ (w : Int × Int), shift (w + + (-1, 0)) = shift w - u) → ((∀ (A : ProtoTile), ∀ (s : GaussianInt), ∀ (t : + GaussianInt), TileTranslation (TileTranslation A s) t = TileTranslation A (s + t)) → + (∀ (w : Int × Int), TouchingTriple (tileAt w) (tileAt (w - (1, 0))) (tileAt (w + (0, + 1))))))) ) := by + classical + intro q T u v hOpp shift tileAt shift_e2 shift_mne1 transAssoc w + have hh := (TouchingTripleCovariance T (TileTranslation T (-u)) + (TileTranslation T v) (shift w)).1.mp hOpp + simpa [tileAt, shift_neg_e1, shift_mne1, shift_e2, transAssoc, add_comm, add_left_comm, + add_assoc, sub_eq_add_neg] using hh + +private theorem coord_m10_m01 : + (by + classical + exact + ∀ (w : Int × Int), (w + (-1, 0)) + (0, -1) = w + (-1, -1) ) := by + classical + intro w + ext <;> simp [Prod.add_def] + +private theorem coord_m01_m10 : + (by + classical + exact + (Fin 4 → CircleCoordinates) → ((ProtoTile) → (∀ (w : Int × Int), (w + (0, -1)) - (1, 0) = + w + (-1, -1))) ) := by + classical + intro q T w + ext <;> simp [Prod.add_def, Prod.sub_def]; omega + +private theorem hdown01 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : + PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int + => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + ∀ (a : ι), + let x : Int × Int := chart.vertexEquiv.symm a + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + let tileAt : Int × Int → ProtoTile := fun w => TileTranslation T (shift w) + (∀ (w : Int × Int), TouchingTriple (tileAt w) (tileAt (w - (1, 0))) (tileAt (w + (0, + 1)))) → ((∀ (w : Int × Int), (w + (1, 0)) - (1, 0) = w) → ((∀ (w : Int × Int), (w + + (1, 0)) + (0, 1) = w + (1, 1)) → ((∀ (w : Int × Int), ∀ (w' : Int × Int), (w = w') → + (tileAt w = tileAt w')) → (TouchingTriple (tileAt (x + (1, 0))) (tileAt x) (tileAt (x + + (1, 1))))))) ) := by + classical + intro q T ι P chart u v a x shift tileAt downFace coord_p10_m10 coord_p10_p01 tileCongr + have hh := downFace (x + (1, 0)) + rw [tileCongr _ _ (coord_p10_m10 x), tileCongr _ _ (coord_p10_p01 x)] at hh + exact hh + +private theorem hup12 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : + PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int + => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + ∀ (a : ι), + let x : Int × Int := chart.vertexEquiv.symm a + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + let tileAt : Int × Int → ProtoTile := fun w => TileTranslation T (shift w) + (∀ (w : Int × Int), TouchingTriple (tileAt w) (tileAt (w + (1, 0))) (tileAt (w - (0, + 1)))) → ((∀ (w : Int × Int), (w + (0, 1)) + (1, 0) = w + (1, 1)) → ((∀ (w : Int × + Int), (w + (0, 1)) - (0, 1) = w) → ((∀ (w : Int × Int), ∀ (w' : Int × Int), (w = w') + → (tileAt w = tileAt w')) → (TouchingTriple (tileAt (x + (0, 1))) (tileAt (x + (1, + 1))) (tileAt x))))) ) := by + classical + intro q T ι P chart u v a x shift tileAt upFace coord_p01_p10 coord_p01_m01 tileCongr + have hh := upFace (x + (0, 1)) + rw [tileCongr _ _ (coord_p01_p10 x), tileCongr _ _ (coord_p01_m01 x)] at hh + exact hh + +private theorem hdown23 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : + PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int + => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + ∀ (a : ι), + let x : Int × Int := chart.vertexEquiv.symm a + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + let tileAt : Int × Int → ProtoTile := fun w => TileTranslation T (shift w) + (∀ (w : Int × Int), TouchingTriple (tileAt w) (tileAt (w - (1, 0))) (tileAt (w + (0, + 1)))) → ((∀ (w : Int × Int), w - (1, 0) = w + (-1, 0)) → ((∀ (w : Int × Int), ∀ (w' : + Int × Int), (w = w') → (tileAt w = tileAt w')) → (TouchingTriple (tileAt x) (tileAt + (x + (-1, 0))) (tileAt (x + (0, 1)))))) ) := by + classical + intro q T ι P chart u v a x shift tileAt downFace coord_sub10 tileCongr + have hh := downFace x + rw [tileCongr _ _ (coord_sub10 x)] at hh + exact hh + +private theorem hup34 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : + PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int + => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + ∀ (a : ι), + let x : Int × Int := chart.vertexEquiv.symm a + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + let tileAt : Int × Int → ProtoTile := fun w => TileTranslation T (shift w) + (∀ (w : Int × Int), TouchingTriple (tileAt w) (tileAt (w + (1, 0))) (tileAt (w - (0, + 1)))) → ((∀ (w : Int × Int), (w + (-1, 0)) + (1, 0) = w) → ((∀ (w : Int × Int), (w + + (-1, 0)) + (0, -1) = w + (-1, -1)) → ((∀ (w : Int × Int), w - (0, 1) = w + (0, -1)) → + ((∀ (w : Int × Int), ∀ (w' : Int × Int), (w = w') → (tileAt w = tileAt w')) → + (TouchingTriple (tileAt (x + (-1, 0))) (tileAt x) (tileAt (x + (-1, -1)))))))) ) := by + classical + intro q T ι P chart u v a x shift tileAt upFace coord_m10_p10 coord_m10_m01 coord_sub01 tileCongr + have hh := upFace (x + (-1, 0)) + rw [tileCongr _ _ (coord_m10_p10 x), tileCongr _ _ (coord_sub01 (x + (-1, 0))), + tileCongr _ _ (coord_m10_m01 x)] at hh + exact hh + +private theorem hdown45 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : + PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int + => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + ∀ (a : ι), + let x : Int × Int := chart.vertexEquiv.symm a + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + let tileAt : Int × Int → ProtoTile := fun w => TileTranslation T (shift w) + (∀ (w : Int × Int), TouchingTriple (tileAt w) (tileAt (w - (1, 0))) (tileAt (w + (0, + 1)))) → ((∀ (w : Int × Int), (w + (0, -1)) - (1, 0) = w + (-1, -1)) → ((∀ (w : Int × + Int), (w + (0, -1)) + (0, 1) = w) → ((∀ (w : Int × Int), ∀ (w' : Int × Int), (w = w') + → (tileAt w = tileAt w')) → (TouchingTriple (tileAt (x + (0, -1))) (tileAt (x + (-1, + -1))) (tileAt x))))) ) := by + classical + intro q T ι P chart u v a x shift tileAt downFace coord_m01_m10 coord_m01_p01 tileCongr + have hh := downFace (x + (0, -1)) + rw [tileCongr _ _ (coord_m01_m10 x), tileCongr _ _ (coord_m01_p01 x)] at hh + exact hh + +private theorem hup50 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : + PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int + => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + ∀ (a : ι), + let x : Int × Int := chart.vertexEquiv.symm a + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + let tileAt : Int × Int → ProtoTile := fun w => TileTranslation T (shift w) + (∀ (w : Int × Int), TouchingTriple (tileAt w) (tileAt (w + (1, 0))) (tileAt (w - (0, + 1)))) → ((∀ (w : Int × Int), w - (0, 1) = w + (0, -1)) → ((∀ (w : Int × Int), ∀ (w' : + Int × Int), (w = w') → (tileAt w = tileAt w')) → (TouchingTriple (tileAt x) (tileAt + (x + (1, 0))) (tileAt (x + (0, -1)))))) ) := by + classical + intro q T ι P chart u v a x shift tileAt upFace coord_sub01 tileCongr + have hh := upFace x + rw [tileCongr _ _ (coord_sub01 x)] at hh + exact hh + +private theorem offsetEq : + (by + classical + exact + (Fin 4 → CircleCoordinates) → ((ProtoTile) → (∀ (w : Int × Int), ∀ (w' : Int × Int), ∀ (d + : Int × Int), (w - w' = d) → (w = w' + d))) ) := by + classical + intro q T w w' d h + rcases w with ⟨a₁, a₂⟩ + rcases w' with ⟨b₁, b₂⟩ + rcases d with ⟨c₁, c₂⟩ + simp only [Prod.sub_def, Prod.add_def, Prod.mk.injEq] at h ⊢ + omega + +private theorem hlocal : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : + PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int + => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), + let x : Int × Int := chart.vertexEquiv.symm a + let y : Int × Int := chart.vertexEquiv.symm b + let z : Int × Int := chart.vertexEquiv.symm c + let p := y - x + let r := z - x + ((p = (1, 0) ∧ r = (1, 1)) ∨ (p = (1, 1) ∧ r = (1, 0)) ∨ (p = (1, 1) ∧ r = (0, 1)) ∨ (p = + (0, 1) ∧ r = (1, 1)) ∨ (p = (0, 1) ∧ r = (-1, 0)) ∨ (p = (-1, 0) ∧ r = (0, 1)) ∨ (p = + (-1, 0) ∧ r = (-1, -1)) ∨ (p = (-1, -1) ∧ r = (-1, 0)) ∨ (p = (-1, -1) ∧ r = (0, -1)) + ∨ (p = (0, -1) ∧ r = (-1, -1)) ∨ (p = (0, -1) ∧ r = (1, 0)) ∨ (p = (1, 0) ∧ r = (0, + -1))) → ( + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + let tileAt : Int × Int → ProtoTile := fun w => TileTranslation T (shift w) + (∀ (w : Int × Int), ∀ (w' : Int × Int), (w = w') → (tileAt w = tileAt w')) → + ((TouchingTriple (tileAt (x + (1, 0))) (tileAt x) (tileAt (x + (1, 1)))) → + ((TouchingTriple (tileAt (x + (0, 1))) (tileAt (x + (1, 1))) (tileAt x)) → + ((TouchingTriple (tileAt x) (tileAt (x + (-1, 0))) (tileAt (x + (0, 1)))) → + ((TouchingTriple (tileAt (x + (-1, 0))) (tileAt x) (tileAt (x + (-1, -1)))) → + ((TouchingTriple (tileAt (x + (0, -1))) (tileAt (x + (-1, -1))) (tileAt x)) → + ((TouchingTriple (tileAt x) (tileAt (x + (1, 0))) (tileAt (x + (0, -1)))) → ((∀ (w : + Int × Int), ∀ (w' : Int × Int), ∀ (d : Int × Int), (w - w' = d) → (w = w' + d)) → + (TouchingTriple (tileAt x) (tileAt y) (tileAt z)))))))))) ) := by + classical + intro q T ι P chart u v a b c x y z p r hdir shift tileAt tileCongr hdown01 hup12 hdown23 hup34 + hdown45 hup50 offsetEq + rcases hdir with h | h | h | h | h | h | h | h | h | h | h | h + · have hy : y = x + (1, 0) := offsetEq y x (1, 0) (by simpa [p] using h.1) + have hz : z = x + (1, 1) := offsetEq z x (1, 1) (by simpa [r] using h.2) + have hperms := (TouchingTriplePermutations (tileAt (x + (1, 0))) + (tileAt x) (tileAt (x + (1, 1)))).mp hdown01 + rw [tileCongr y (x + (1, 0)) hy, tileCongr z (x + (1, 1)) hz] + exact hperms.2.1 + · have hy : y = x + (1, 1) := offsetEq y x (1, 1) (by simpa [p] using h.1) + have hz : z = x + (1, 0) := offsetEq z x (1, 0) (by simpa [r] using h.2) + have hperms := (TouchingTriplePermutations (tileAt (x + (1, 0))) + (tileAt x) (tileAt (x + (1, 1)))).mp hdown01 + rw [tileCongr y (x + (1, 1)) hy, tileCongr z (x + (1, 0)) hz] + exact hperms.2.2.1 + · have hy : y = x + (1, 1) := offsetEq y x (1, 1) (by simpa [p] using h.1) + have hz : z = x + (0, 1) := offsetEq z x (0, 1) (by simpa [r] using h.2) + have hperms := (TouchingTriplePermutations (tileAt (x + (0, 1))) + (tileAt (x + (1, 1))) (tileAt x)).mp hup12 + rw [tileCongr y (x + (1, 1)) hy, tileCongr z (x + (0, 1)) hz] + exact hperms.2.2.2.2 + · have hy : y = x + (0, 1) := offsetEq y x (0, 1) (by simpa [p] using h.1) + have hz : z = x + (1, 1) := offsetEq z x (1, 1) (by simpa [r] using h.2) + have hperms := (TouchingTriplePermutations (tileAt (x + (0, 1))) + (tileAt (x + (1, 1))) (tileAt x)).mp hup12 + rw [tileCongr y (x + (0, 1)) hy, tileCongr z (x + (1, 1)) hz] + exact hperms.2.2.2.1 + · have hy : y = x + (0, 1) := offsetEq y x (0, 1) (by simpa [p] using h.1) + have hz : z = x + (-1, 0) := offsetEq z x (-1, 0) (by simpa [r] using h.2) + have hperms := (TouchingTriplePermutations (tileAt x) (tileAt (x + (-1, 0))) + (tileAt (x + (0, 1)))).mp hdown23 + rw [tileCongr y (x + (0, 1)) hy, tileCongr z (x + (-1, 0)) hz] + exact hperms.1 + · have hy : y = x + (-1, 0) := offsetEq y x (-1, 0) (by simpa [p] using h.1) + have hz : z = x + (0, 1) := offsetEq z x (0, 1) (by simpa [r] using h.2) + rw [tileCongr y (x + (-1, 0)) hy, tileCongr z (x + (0, 1)) hz] + exact hdown23 + · have hy : y = x + (-1, 0) := offsetEq y x (-1, 0) (by simpa [p] using h.1) + have hz : z = x + (-1, -1) := offsetEq z x (-1, -1) (by simpa [r] using h.2) + have hperms := (TouchingTriplePermutations (tileAt (x + (-1, 0))) (tileAt x) + (tileAt (x + (-1, -1)))).mp hup34 + rw [tileCongr y (x + (-1, 0)) hy, tileCongr z (x + (-1, -1)) hz] + exact hperms.2.1 + · have hy : y = x + (-1, -1) := offsetEq y x (-1, -1) (by simpa [p] using h.1) + have hz : z = x + (-1, 0) := offsetEq z x (-1, 0) (by simpa [r] using h.2) + have hperms := (TouchingTriplePermutations (tileAt (x + (-1, 0))) (tileAt x) + (tileAt (x + (-1, -1)))).mp hup34 + rw [tileCongr y (x + (-1, -1)) hy, tileCongr z (x + (-1, 0)) hz] + exact hperms.2.2.1 + · have hy : y = x + (-1, -1) := offsetEq y x (-1, -1) (by simpa [p] using h.1) + have hz : z = x + (0, -1) := offsetEq z x (0, -1) (by simpa [r] using h.2) + have hperms := (TouchingTriplePermutations (tileAt (x + (0, -1))) + (tileAt (x + (-1, -1))) (tileAt x)).mp hdown45 + rw [tileCongr y (x + (-1, -1)) hy, tileCongr z (x + (0, -1)) hz] + exact hperms.2.2.2.2 + · have hy : y = x + (0, -1) := offsetEq y x (0, -1) (by simpa [p] using h.1) + have hz : z = x + (-1, -1) := offsetEq z x (-1, -1) (by simpa [r] using h.2) + have hperms := (TouchingTriplePermutations (tileAt (x + (0, -1))) + (tileAt (x + (-1, -1))) (tileAt x)).mp hdown45 + rw [tileCongr y (x + (0, -1)) hy, tileCongr z (x + (-1, -1)) hz] + exact hperms.2.2.2.1 + · have hy : y = x + (0, -1) := offsetEq y x (0, -1) (by simpa [p] using h.1) + have hz : z = x + (1, 0) := offsetEq z x (1, 0) (by simpa [r] using h.2) + have hperms := (TouchingTriplePermutations (tileAt x) (tileAt (x + (1, 0))) + (tileAt (x + (0, -1)))).mp hup50 + rw [tileCongr y (x + (0, -1)) hy, tileCongr z (x + (1, 0)) hz] + exact hperms.1 + · have hy : y = x + (1, 0) := offsetEq y x (1, 0) (by simpa [p] using h.1) + have hz : z = x + (0, -1) := offsetEq z x (0, -1) (by simpa [r] using h.2) + rw [tileCongr y (x + (1, 0)) hy, tileCongr z (x + (0, -1)) hz] + exact hup50 + +private theorem htarget : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : + PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int + => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))), + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), + let x : Int × Int := chart.vertexEquiv.symm a + let y : Int × Int := chart.vertexEquiv.symm b + let z : Int × Int := chart.vertexEquiv.symm c + (chart.vertexEquiv x = a) → ((chart.vertexEquiv y = b) → ((chart.vertexEquiv z = c) → ( + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + let tileAt : Int × Int → ProtoTile := fun w => TileTranslation T (shift w) + (∀ (w : Int × Int), P.tile (chart.vertexEquiv w) = tileAt w) → ((TouchingTriple (tileAt + x) (tileAt y) (tileAt z)) → (TouchingTriple (P.tile a) (P.tile b) (P.tile c)))))) ) + := by + classical + intro q T ι P chart u v a b c x y z hxa hyb hzc shift tileAt chartTile hlocal + have ht := hlocal + rw [← chartTile x, ← chartTile y, ← chartTile z] at ht + rw [hxa, hyb, hzc] at ht + exact ht + +end BandGraphTriangleGeometry + +theorem P4456T2BandGraphTriangle (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) (T : ProtoTile) + (hT : BandPrototile (q 0) T) (hlarge : 1 < (q 0).1) + {ι : Type} (P : PeriodicTileComplex ι) + (chart : AffineTriangularComplexChart P (fun mn : Int × Int => + TileTranslation T + ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (mn.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)))) : + ∀ a b c : ι, a ≠ b → b ≠ c → c ≠ a → + P.plane.adjacent a b → P.plane.adjacent b c → + P.plane.adjacent c a → TouchingTriple (P.tile a) (P.tile b) (P.tile c) := by +-- BODY + classical + let u : GaussianInt := BandVectors.1 (q 1) (q 0) + let v : GaussianInt := BandVectors.1 (q 2) (q 0) + have hsim := BandTileSimultaneousInduction q hq T hT + have hT1 : LatticeTile T := hsim.1 + have hT2 : QuarterTurnSymmetric T := hsim.2.2.2.1 + have hT3 : TouchingTriple T (TileTranslation T u) (TileTranslation T (-v)) := by + simpa [u, v] using (hsim.2.2.2.2.1 hlarge 0) + have hTne : T.cells.Nonempty := BandGraphTriangleGeometry.hTne T hT1 + obtain ⟨g, hg, hcenter, _, _, _⟩ := QuarterTurnSymmetricCenteredTransport T hT2 + let rot : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x - 1 + let cent : GaussianInt → GaussianInt := fun x => GaussianTranslation g (rot x) + have hcentCells : T.cells.image cent = T.cells := BandGraphTriangleGeometry.hcentCells T g hcenter + have hturnedCells (d : GaussianInt) : + (TileTranslation (TileQuarterTurn (TileTranslation T d)) g).cells = + (TileTranslation T (GaussianQuarterTurn d)).cells := + BandGraphTriangleGeometry.hturnedCells q T g hg hcenter hcentCells d + have hOpp : TouchingTriple T (TileTranslation T (-u)) (TileTranslation T v) := + BandGraphTriangleGeometry.hOpp q T hT3 hTne g hcenter hturnedCells + intro a b c habc hbcc hca hab hbc hca' + have adjSymm (x y : Int × Int) (h : TriangularLatticeAdjacent x y) : + TriangularLatticeAdjacent y x := BandGraphTriangleGeometry.adjSymm q T x y h + let x : Int × Int := chart.vertexEquiv.symm a + let y : Int × Int := chart.vertexEquiv.symm b + let z : Int × Int := chart.vertexEquiv.symm c + have hxa : chart.vertexEquiv x = a := by simp [x] + have hyb : chart.vertexEquiv y = b := by simp [y] + have hzc : chart.vertexEquiv z = c := by simp [z] + have hxy : TriangularLatticeAdjacent x y := BandGraphTriangleGeometry.hxy q T ι P chart a b hab + hxa hyb + have hyz : TriangularLatticeAdjacent y z := BandGraphTriangleGeometry.hyz q T ι P chart b c hbc + hyb hzc + have hzx : TriangularLatticeAdjacent z x := BandGraphTriangleGeometry.hzx q T ι P chart a c + hca' hxa hzc + have hzx' : TriangularLatticeAdjacent x z := adjSymm z x hzx + let p := y - x + let r := z - x + have hp : TriangularLatticeAdjacent (0, 0) p := BandGraphTriangleGeometry.hpAt297 q T ι P chart + a b hxy + have hr : TriangularLatticeAdjacent (0, 0) r := BandGraphTriangleGeometry.hr q T ι P chart a c + hzx' + have hpr : TriangularLatticeAdjacent p r := BandGraphTriangleGeometry.hpr q T ι P chart a b c hyz + have hdir : + (p = (1, 0) ∧ r = (1, 1)) ∨ (p = (1, 1) ∧ r = (1, 0)) ∨ + (p = (1, 1) ∧ r = (0, 1)) ∨ (p = (0, 1) ∧ r = (1, 1)) ∨ + (p = (0, 1) ∧ r = (-1, 0)) ∨ (p = (-1, 0) ∧ r = (0, 1)) ∨ + (p = (-1, 0) ∧ r = (-1, -1)) ∨ (p = (-1, -1) ∧ r = (-1, 0)) ∨ + (p = (-1, -1) ∧ r = (0, -1)) ∨ (p = (0, -1) ∧ r = (-1, -1)) ∨ + (p = (0, -1) ∧ r = (1, 0)) ∨ (p = (1, 0) ∧ r = (0, -1)) := BandGraphTriangleGeometry.hdir q + T ι P chart a b c hp hr hpr + let shift : Int × Int → GaussianInt := fun w => + (w.1 : GaussianInt) * u + (w.2 : GaussianInt) * v + let tileAt : Int × Int → ProtoTile := fun w => TileTranslation T (shift w) + have shift_add (w w' : Int × Int) : shift (w + w') = shift w + shift w' := + BandGraphTriangleGeometry.shift_add q w w' + have shift_e1 (w : Int × Int) : shift (w + (1, 0)) = shift w + u := + BandGraphTriangleGeometry.shift_e1 q shift_add w + have shift_e2 (w : Int × Int) : shift (w + (0, 1)) = shift w + v := + BandGraphTriangleGeometry.shift_e2 q shift_add w + have shift_neg_e1 (w : Int × Int) : shift (w - (1, 0)) = shift w - u := + BandGraphTriangleGeometry.shift_neg_e1 q shift_add w + have shift_neg_e2 (w : Int × Int) : shift (w - (0, 1)) = shift w - v := + BandGraphTriangleGeometry.shift_neg_e2 q shift_add w + have shift_mne1 (w : Int × Int) : shift (w + (-1, 0)) = shift w - u := + BandGraphTriangleGeometry.shift_mne1 q shift_add w + have shift_mne2 (w : Int × Int) : shift (w + (0, -1)) = shift w - v := + BandGraphTriangleGeometry.shift_mne2 q shift_add w + have transAssoc (A : ProtoTile) (s t : GaussianInt) : + TileTranslation (TileTranslation A s) t = TileTranslation A (s + t) := + BandGraphTriangleGeometry.transAssoc A s t + have upFace (w : Int × Int) : + TouchingTriple (tileAt w) (tileAt (w + (1, 0))) (tileAt (w - (0, 1))) := + BandGraphTriangleGeometry.upFace q T hT3 shift_e1 shift_mne2 transAssoc w + have downFace (w : Int × Int) : + TouchingTriple (tileAt w) (tileAt (w - (1, 0))) (tileAt (w + (0, 1))) := + BandGraphTriangleGeometry.downFace q T hOpp shift_e2 shift_mne1 transAssoc w + have chartTile (w : Int × Int) : P.tile (chart.vertexEquiv w) = tileAt w := by + simpa [tileAt, shift, u, v] using chart.tile_eq w + have coord_p10_m10 (w : Int × Int) : + (w + (1, 0)) - (1, 0) = w := by ext <;> simp [Prod.add_def, Prod.sub_def] + have coord_p10_p01 (w : Int × Int) : + (w + (1, 0)) + (0, 1) = w + (1, 1) := by ext <;> simp [Prod.add_def] + have coord_p01_p10 (w : Int × Int) : + (w + (0, 1)) + (1, 0) = w + (1, 1) := by ext <;> simp [Prod.add_def] + have coord_p01_m01 (w : Int × Int) : + (w + (0, 1)) - (0, 1) = w := by ext <;> simp [Prod.add_def, Prod.sub_def] + have coord_m10_p10 (w : Int × Int) : + (w + (-1, 0)) + (1, 0) = w := by ext <;> simp [Prod.add_def] + have coord_m10_m01 (w : Int × Int) : + (w + (-1, 0)) + (0, -1) = w + (-1, -1) := BandGraphTriangleGeometry.coord_m10_m01 w + have coord_m01_m10 (w : Int × Int) : + (w + (0, -1)) - (1, 0) = w + (-1, -1) := BandGraphTriangleGeometry.coord_m01_m10 q T w + have coord_m01_p01 (w : Int × Int) : + (w + (0, -1)) + (0, 1) = w := by ext <;> simp [Prod.add_def] + have coord_sub10 (w : Int × Int) : w - (1, 0) = w + (-1, 0) := by + ext <;> simp [Prod.add_def, Prod.sub_def]; omega + have coord_sub01 (w : Int × Int) : w - (0, 1) = w + (0, -1) := by + ext <;> simp [Prod.add_def, Prod.sub_def]; omega + have tileCongr (w w' : Int × Int) (h : w = w') : tileAt w = tileAt w' := + congrArg tileAt h + have hdown01 : TouchingTriple (tileAt (x + (1, 0))) (tileAt x) + (tileAt (x + (1, 1))) := BandGraphTriangleGeometry.hdown01 q T ι P chart a downFace + coord_p10_m10 coord_p10_p01 tileCongr + have hup12 : TouchingTriple (tileAt (x + (0, 1))) + (tileAt (x + (1, 1))) (tileAt x) := BandGraphTriangleGeometry.hup12 q T ι P chart a upFace + coord_p01_p10 coord_p01_m01 tileCongr + have hdown23 : TouchingTriple (tileAt x) (tileAt (x + (-1, 0))) + (tileAt (x + (0, 1))) := BandGraphTriangleGeometry.hdown23 q T ι P chart a downFace + coord_sub10 tileCongr + have hup34 : TouchingTriple (tileAt (x + (-1, 0))) (tileAt x) + (tileAt (x + (-1, -1))) := BandGraphTriangleGeometry.hup34 q T ι P chart a upFace + coord_m10_p10 coord_m10_m01 coord_sub01 tileCongr + have hdown45 : TouchingTriple (tileAt (x + (0, -1))) + (tileAt (x + (-1, -1))) (tileAt x) := BandGraphTriangleGeometry.hdown45 q T ι P chart a + downFace coord_m01_m10 coord_m01_p01 tileCongr + have hup50 : TouchingTriple (tileAt x) (tileAt (x + (1, 0))) + (tileAt (x + (0, -1))) := BandGraphTriangleGeometry.hup50 q T ι P chart a upFace + coord_sub01 tileCongr + have offsetEq (w w' d : Int × Int) (h : w - w' = d) : w = w' + d := + BandGraphTriangleGeometry.offsetEq q T w w' d h + have hlocal : TouchingTriple (tileAt x) (tileAt y) (tileAt z) := + BandGraphTriangleGeometry.hlocal q T ι P chart a b c hdir tileCongr hdown01 hup12 hdown23 + hup34 hdown45 hup50 offsetEq + have htarget : TouchingTriple (P.tile a) (P.tile b) (P.tile c) := + BandGraphTriangleGeometry.htarget q T ι P chart a b c hxa hyb hzc chartTile hlocal + exact htarget + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean b/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean new file mode 100644 index 0000000000..88e25af13d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean @@ -0,0 +1,965 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4456T2EdgeInterior +public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndex +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.LatticeTileBoundarySimpleGridCycle +public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell + +-- [TABLET NODE: P4456T2CrosscutIndex] + +/-! +# P4456T2CrosscutIndex + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CrosscutIndexProof + +private theorem hab : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), ((x = + a + (1 : GaussianInt) ∧ y = a + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = a + (1 : + GaussianInt) ∧ x = a + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∧ b = a + (1 : + GaussianInt) ∨ (x = a + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ y = a + ⟨(0 : ℤ), (1 + : ℤ)⟩ ∨ y = a + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ x = a + ⟨(0 : ℤ), (1 : ℤ)⟩) + ∧ b = a + ⟨(0 : ℤ), (1 : ℤ)⟩) → (a ≠ b) ) := by + classical + intro x y a b hform + rcases hform with ⟨_, hb⟩ | ⟨_, hb⟩ + · rw [hb] + intro h + have hh := congrArg Zsqrtd.re h + simp at hh + · rw [hb] + intro h + have hh := congrArg Zsqrtd.im h + simp at hh + +private theorem hxmem : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ BoundaryFootprintVertices T) → (∀ (p : List + GaussianInt), (BoundaryFootprintVertices T = (↑p.toFinset : Set GaussianInt)) → (x ∈ + p)) ) := by + classical + intro T x hx p hpVerts + rw [hpVerts] at hx + simpa using hx + +private theorem hymem : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (y : GaussianInt), (y ∈ BoundaryFootprintVertices T) → (∀ (p : List + GaussianInt), (BoundaryFootprintVertices T = (↑p.toFinset : Set GaussianInt)) → (y ∈ + p)) ) := by + classical + intro T y hy p hpVerts + rw [hpVerts] at hy + simpa using hy + +private theorem hchordBoundary : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), ((x = a + (1 : GaussianInt) ∧ y = a + (1 : GaussianInt) + ⟨(0 : ℤ), (1 + : ℤ)⟩ ∨ y = a + (1 : GaussianInt) ∧ x = a + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∧ + b = a + (1 : GaussianInt) ∨ (x = a + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ y = a + + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = a + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ x = a + ⟨(0 : + ℤ), (1 : ℤ)⟩) ∧ b = a + ⟨(0 : ℤ), (1 : ℤ)⟩) → ((a ∈ T.cells ∧ b ∈ T.cells) → (({x, y} + : Finset GaussianInt) ∉ BoundaryFootprintEdges T)) ) := by + classical + intro T x y a b hform hboth he + have hc := (P4397T1UnitEdgeCells.2 x y a b hform T).2.1 + rcases hc.mp he with ⟨_, hbnot⟩ | ⟨hanot, _⟩ + · exact hbnot hboth.2 + · exact hanot hboth.1 + +private theorem hqHead : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (p : List GaussianInt), + let k := p.idxOf x + ∀ (hk : k < p.length), ((p[k]'hk = x) → ( + let q := p.rotate k + q.head? = some x)) ) := by + classical + intro x p k hk hxidx q + change (p.rotate k).head? = some x + rw [List.head?_rotate hk, List.getElem?_eq_getElem hk] + simp [hxidx] + +private theorem hxne : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), (FourNeighborAdjacent x y) → ((List + GaussianInt) → (x ≠ y)) ) := by + classical + intro x y hxy p h + rw [h] at hxy + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] at hxy + omega + +private theorem hjpos : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (p : List GaussianInt), ((4 : ℕ) ≤ p.length) → ( + let k := p.idxOf x + let q := p.rotate k + (q.head? = some x) → ((q.length = p.length) → ((y ∈ q) → ( + let j := q.idxOf y + ∀ (hj : j < q.length), ((q[j]'hj = y) → ((x ≠ y) → (0 < j))))))) ) := by + classical + intro x y p hpLen k q hqHead hqLen hyq j hj hyidx hxne + by_contra h + have hzero : j = 0 := by omega + have hq0 : q[0] = x := by + have hqne : q ≠ [] := List.ne_nil_of_mem hyq + rw [← List.head_eq_getElem hqne] + simpa [List.head?_eq_some_head hqne] using hqHead + have hqy : q[0] = y := by simpa [hzero] using hyidx + exact hxne (hq0.symm.trans hqy) + +private theorem hqBoundaryChain : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), (GaussianInt) → (∀ (p : List GaussianInt), ∀ (u : + GaussianInt), ∀ (v : GaussianInt), (p.head? = some u) → ((p.getLast? = some v) → ((∀ + (e : Finset GaussianInt), e ∈ BoundaryFootprintEdges T ↔ e = {v, u} ∨ ∃ (a : + GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = + l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ( + let k := p.idxOf x + (k < p.length) → ( + let q := p.rotate k + (q.length = p.length) → (List.IsChain (fun s t => ({s, t} : Finset GaussianInt) ∈ + BoundaryFootprintEdges T) q)))))) ) := by + classical + intro T x y p u v hpHead hpLast hpEdges k hk q hqLen + have hchain : List.IsChain (fun s t => ({s, t} : Finset GaussianInt) ∈ + BoundaryFootprintEdges T) p := by + apply (List.isChain_iff_getElem).2 + intro i hi + have hpair : p = p.take i ++ p[i] :: p[i + 1] :: p.drop (i + 2) := by + calc + p = p.take (i + 1) ++ p.drop (i + 1) := (List.take_append_drop (i + 1) p).symm + _ = (p.take i ++ [p[i]]) ++ p[i + 1] :: p.drop (i + 2) := by + have hi0 : i < p.length := by omega + rw [List.take_succ_eq_append_getElem (i := i) hi0] + have hdrop : p.drop (i + 1) = p[i + 1] :: p.drop (i + 2) := by + simp [] + rw [hdrop] + _ = p.take i ++ p[i] :: p[i + 1] :: p.drop (i + 2) := by simp [] + rw [hpEdges] + right + exact ⟨p[i], p[i + 1], p.take i, p.drop (i + 2), hpair, rfl⟩ + have hrot : q = p.drop k ++ p.take k := List.rotate_eq_drop_append_take hk.le + rw [hrot] + apply (List.isChain_append).2 + refine ⟨hchain.drop k, hchain.take k, ?_⟩ + intro s hs t ht + have hsLast : (p.drop k).getLast? = some v := by + rw [List.getLast?_drop] + simp [hpLast, Nat.not_le.mpr hk] + by_cases hkzero : k = 0 + · simp [hkzero] at ht + have hkpos : 0 < k := by omega + have htHead : (p.take k).head? = some u := by + rw [List.head?_take] + simp [hpHead, hkpos.ne'] + have hs' : s = v := by + simp [hsLast] at hs + exact hs.symm + have ht' : t = u := by + simp [htHead] at ht + exact ht.symm + subst s t + simpa [Finset.pair_comm] using (hpEdges {v, u}).2 (Or.inl rfl) + +private theorem hrLast : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (p : List GaussianInt), + let k := p.idxOf x + let q := p.rotate k + let j := q.idxOf y + ∀ (hj : j < q.length), ((q[j]'hj = y) → ((0 < j) → ( + let r := q.take (j + 1) + r.getLast? = some y))) ) := by + classical + intro x y p k q j hj hyidx hjpos r + change (q.take (j + 1)).getLast? = some y + rw [List.getLast?_take] + have hqj : q[j]? = some y := by + rw [List.getElem?_eq_getElem hj] + exact congrArg some hyidx + rw [ite_eq_right (show j + 1 ≠ 0 by omega)] + have hj' : j + 1 - 1 = j := by omega + rw [hj'] + rw [List.getElem?_eq_getElem hj, hyidx] + simp + +private theorem hrLen : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (p : List GaussianInt), + ((4 : ℕ) ≤ p.length) → ((({x, y} : Finset GaussianInt) ∉ BoundaryFootprintEdges T) → ( + let k := p.idxOf x + let q := p.rotate k + (q.head? = some x) → ((q.length = p.length) → ((y ∈ q) → ( + let j := q.idxOf y + ∀ (hj : j < q.length), ((q[j]'hj = y) → ((0 < j) → ((List.IsChain (fun s t => ({s, t} : + Finset + GaussianInt) ∈ BoundaryFootprintEdges T) q) → ( + let r := q.take (j + 1) + 3 ≤ r.length))))))))) ) := by + classical + intro T x y p hpLen hchordBoundary k q hqHead hqLen hyq j hj hyidx hjpos hqBoundaryChain r + by_contra hsmall + have hjle : j ≤ 1 := by + dsimp [r] at hsmall + simp only [List.length_take] at hsmall + omega + have hjnot0 : j ≠ 0 := by omega + have hj1 : j = 1 := by omega + have hqxy : ({x, y} : Finset GaussianInt) ∈ BoundaryFootprintEdges T := by + have hqchain := (List.isChain_iff_getElem.mp hqBoundaryChain) 0 (by + rw [hqLen] + omega) + have hq0 : q[0] = x := by + have hqne : q ≠ [] := List.ne_nil_of_mem hyq + rw [← List.head_eq_getElem hqne] + simpa [List.head?_eq_some_head hqne] using hqHead + have hq1 : q[1] = y := by simpa [hj1] using hyidx + simpa [hq0, hq1] using hqchain + exact hchordBoundary hqxy + +private theorem boundaryAdj : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (s : GaussianInt), ∀ (t : GaussianInt), {s, t} ∈ + BoundaryFootprintEdges T → FourNeighborAdjacent s t ) := by + classical + intro T s t hst + simp only [BoundaryFootprintEdges, Set.mem_ofPred_eq] at hst + rcases hst with ⟨z, ⟨heq, _⟩ | ⟨heq, _⟩⟩ + · have hne : s ≠ t := by + intro h + subst t + have hc := congrArg Finset.card heq + simp [] at hc + have hs : s ∈ ({z, z + 1} : Finset GaussianInt) := by + have : s ∈ ({s, t} : Finset GaussianInt) := by simp + rw [heq] at this + exact this + have ht : t ∈ ({z, z + 1} : Finset GaussianInt) := by + have : t ∈ ({s, t} : Finset GaussianInt) := by simp + rw [heq] at this + exact this + simp only [Finset.mem_insert, Finset.mem_singleton] at hs ht + rcases hs with hs | hs <;> rcases ht with ht | ht + · exact (hne (hs.trans ht.symm)).elim + · subst s t + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + · subst s t + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + · exact (hne (hs.trans ht.symm)).elim + · have hne : s ≠ t := by + intro h + subst t + have hc := congrArg Finset.card heq + simp [Zsqrtd.ext_iff] at hc + have hs : s ∈ ({z, z + ⟨0, 1⟩} : Finset GaussianInt) := by + have : s ∈ ({s, t} : Finset GaussianInt) := by simp + rw [heq] at this + exact this + have ht : t ∈ ({z, z + ⟨0, 1⟩} : Finset GaussianInt) := by + have : t ∈ ({s, t} : Finset GaussianInt) := by simp + rw [heq] at this + exact this + simp only [Finset.mem_insert, Finset.mem_singleton] at hs ht + rcases hs with hs | hs <;> rcases ht with ht | ht + · exact (hne (hs.trans ht.symm)).elim + · subst s t + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + · subst s t + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + · exact (hne (hs.trans ht.symm)).elim + +private theorem hclose : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), (FourNeighborAdjacent x y) → + (FourNeighborAdjacent y x) ) := by + classical + intro x y hxy + change y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ at hxy + rcases hxy with h | h | h | h + · right; left; rw [h]; ext <;> simp [] + · left; rw [h]; ext <;> simp [] + · right; right; right; rw [h]; ext <;> simp [] + · right; right; left; rw [h]; ext <;> simp [] + +private theorem pathAdj : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (p : List GaussianInt), + let k := p.idxOf x + let q := p.rotate k + let j := q.idxOf y + let r := q.take (j + 1) + (3 ≤ r.length) → ((List.IsChain (fun s t => ({s, t} : Finset GaussianInt) ∈ + BoundaryFootprintEdges T) r) → ((∀ (s : GaussianInt), ∀ (t : GaussianInt), (({s, t} : + Finset GaussianInt) ∈ BoundaryFootprintEdges T) → (FourNeighborAdjacent s t)) → (∀ s, + ∀ t, (s, t) ∈ r.zip r.tail → FourNeighborAdjacent s t))) ) := by + classical + intro T x y p k q j r hrLen hrBoundaryChain boundaryAdj s t hst + rw [List.mem_iff_getElem] at hst + rcases hst with ⟨i, hi, hst⟩ + have hi' : i + 1 < r.length := by + simp only [List.length_zip, List.length_tail] at hi + omega + rw [List.getElem_zip, List.getElem_tail] at hst + injection hst with hs ht + subst s t + exact boundaryAdj _ _ ((List.isChain_iff_getElem.mp hrBoundaryChain) i hi') + +private theorem hoccAt342 : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : GaussianInt), ∀ (p : List GaussianInt), + let k := p.idxOf x + let q := p.rotate k + let j := q.idxOf y + let r := q.take (j + 1) + let edges := r.zip r.tail ++ [(y, x)] + (x = a + (1 : GaussianInt) ∧ y = a + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = a + (1 + : GaussianInt) ∧ x = a + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) → ((a + 1, a + 1 + + ⟨0, 1⟩) ∈ edges ∨ (a + 1 + ⟨0, 1⟩, a + 1) ∈ edges) ) := by + classical + intro x y a p k q j r edges hvert + rcases hvert with ⟨hx', hy'⟩ | ⟨hy', hx'⟩ + · exact Or.inr (by simp [edges, hx', hy']) + · exact Or.inl (by simp [edges, hx', hy']) + +private theorem hoccAt353 : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : GaussianInt), ∀ (p : List GaussianInt), + let k := p.idxOf x + let q := p.rotate k + let j := q.idxOf y + let r := q.take (j + 1) + let edges := r.zip r.tail ++ [(y, x)] + (x = a + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ y = a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = a + (1 + : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ x = a + ⟨(0 : ℤ), (1 : ℤ)⟩) → ((a + 1 + ⟨0, 1⟩, + a + ⟨0, 1⟩) ∈ edges ∨ (a + ⟨0, 1⟩, a + 1 + ⟨0, 1⟩) ∈ edges) ) := by + classical + intro x y a p k q j r edges hhoriz + rcases hhoriz with ⟨hx', hy'⟩ | ⟨hy', hx'⟩ + · exact Or.inr (by simp [edges, hx', hy']) + · exact Or.inl (by simp [edges, hx', hy']) + +private theorem hcdAdj : + (by + classical + exact + (GaussianInt) → ((GaussianInt) → ((List GaussianInt) → (∀ (c : LatticeCell), ∀ (d : + LatticeCell), (c ≠ d) → (∀ (f : Finset GaussianInt), (f ∈ FootprintEdges (⟨{c}, c⟩ : + ProtoTile)) → ((f ∈ FootprintEdges (⟨{d}, d⟩ : ProtoTile)) → + (FourNeighborAdjacent c d)))))) ) := by + classical + intro x y p c d hcd f hfc hfd + have pairMatch (u v w z : GaussianInt) + (heq : ({u, v} : Finset GaussianInt) = {w, z}) (huv : u ≠ v) : + (u = w ∧ v = z) ∨ (u = z ∧ v = w) := by + have huwz : u = w ∨ u = z := by + have hm : u ∈ ({w, z} : Finset GaussianInt) := by rw [← heq]; simp + simpa using hm + have hvwz : v = w ∨ v = z := by + have hm : v ∈ ({w, z} : Finset GaussianInt) := by rw [← heq]; simp + simpa using hm + rcases huwz with huw | huz + · rcases hvwz with hvw | hvz + · exact False.elim (huv (huw.trans hvw.symm)) + · exact Or.inl ⟨huw, hvz⟩ + · rcases hvwz with hvw | hvz + · exact Or.inr ⟨huz, hvw⟩ + · exact False.elim (huv (huz.trans hvz.symm)) + change (∃ z ∈ ({c} : Finset GaussianInt), + f = {z, z + 1} ∨ f = {z, z + ⟨0, 1⟩} ∨ + f = {z + 1, z + 1 + ⟨0, 1⟩} ∨ + f = {z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩}) at hfc + change (∃ z ∈ ({d} : Finset GaussianInt), + f = {z, z + 1} ∨ f = {z, z + ⟨0, 1⟩} ∨ + f = {z + 1, z + 1 + ⟨0, 1⟩} ∨ + f = {z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩}) at hfd + simp only [Finset.mem_singleton] at hfc hfd + rcases hfc with ⟨z, hz, hfc⟩ + have hzc : z = c := by simpa using hz + rw [hzc] at hfc + rcases hfd with ⟨w, hw, hfd⟩ + have hwd : w = d := by simpa using hw + rw [hwd] at hfd + let edgePair (q : GaussianInt) (i : Fin 4) : GaussianInt × GaussianInt := + if i.val = 0 then (q, q + 1) else if i.val = 1 then (q, q + ⟨0, 1⟩) + else if i.val = 2 then (q + 1, q + 1 + ⟨0, 1⟩) + else (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) + have hcEdge : ∃ i : Fin 4, + f = {(edgePair c i).1, (edgePair c i).2} := by + rcases hfc with hfc | hfc | hfc | hfc + · exact ⟨⟨0, by omega⟩, by simpa [edgePair] using hfc⟩ + · exact ⟨⟨1, by omega⟩, by simpa [edgePair] using hfc⟩ + · exact ⟨⟨2, by omega⟩, by simpa [edgePair] using hfc⟩ + · exact ⟨⟨3, by omega⟩, by simpa [edgePair] using hfc⟩ + have hdEdge : ∃ i : Fin 4, + f = {(edgePair d i).1, (edgePair d i).2} := by + rcases hfd with hfd | hfd | hfd | hfd + · exact ⟨⟨0, by omega⟩, by simpa [edgePair] using hfd⟩ + · exact ⟨⟨1, by omega⟩, by simpa [edgePair] using hfd⟩ + · exact ⟨⟨2, by omega⟩, by simpa [edgePair] using hfd⟩ + · exact ⟨⟨3, by omega⟩, by simpa [edgePair] using hfd⟩ + obtain ⟨i, hi⟩ := hcEdge + obtain ⟨j, hj⟩ := hdEdge + have hne : (edgePair c i).1 ≠ (edgePair c i).2 := by + fin_cases i <;> simp [edgePair, Zsqrtd.ext_iff] + have hm := pairMatch (edgePair c i).1 (edgePair c i).2 + (edgePair d j).1 (edgePair d j).2 (hi.symm.trans hj) hne + have hcd' : c.re ≠ d.re ∨ c.im ≠ d.im := by + by_contra hnot + push Not at hnot + apply hcd + ext <;> omega + fin_cases i <;> fin_cases j + all_goals + simp [edgePair, FourNeighborAdjacent, Zsqrtd.ext_iff] at hm ⊢ + omega + +private theorem internalNotBoundary : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (c : LatticeCell), (c ∈ T.cells) → (∀ (d : LatticeCell), (d ∈ + T.cells) → ((c ≠ d) → (∀ (f : Finset GaussianInt), (f ∈ FootprintEdges (⟨{c}, c⟩ : + ProtoTile)) → ((f ∈ FootprintEdges (⟨{d}, d⟩ : ProtoTile)) → (∀ (u : + GaussianInt), ∀ (v : GaussianInt), f = {u, v} → FourNeighborAdjacent u v → f ∉ + BoundaryFootprintEdges T))))) ) := by + classical + intro T c hc d hd hcd f hfcOrig hfdOrig u v heq huv + obtain ⟨z, w, hgeom⟩ := (P4397T1UnitEdgeCells.1 u v huv) + have hmemC : ({u, v} : Finset GaussianInt) ∈ + FootprintEdges (⟨{c}, c⟩ : ProtoTile) := by + simpa [heq] using hfcOrig + have hmemD : ({u, v} : Finset GaussianInt) ∈ + FootprintEdges (⟨{d}, d⟩ : ProtoTile) := by + simpa [heq] using hfdOrig + have hincC : z = c ∨ w = c := by + have h := ((P4397T1UnitEdgeCells.2 u v z w hgeom + (⟨{c}, c⟩ : ProtoTile)).1.mp hmemC) + simpa [Finset.mem_singleton] using h + have hincD : z = d ∨ w = d := by + have h := ((P4397T1UnitEdgeCells.2 u v z w hgeom + (⟨{d}, d⟩ : ProtoTile)).1.mp hmemD) + simpa [Finset.mem_singleton] using h + intro hbound + have hxor := ((P4397T1UnitEdgeCells.2 u v z w hgeom T).2.1).mp + (by simpa [heq] using hbound) + rcases hincC with hzC | hwC <;> rcases hincD with hzD | hwD + · exact False.elim (hcd (hzC.symm.trans hzD)) + · have hzT : z ∈ T.cells := by simpa [hzC] using hc + have hwT : w ∈ T.cells := by simpa [hwD] using hd + rcases hxor with ⟨_, hnw⟩ | ⟨hnz, _⟩ + · exact hnw hwT + · exact hnz hzT + · have hwT : w ∈ T.cells := by simpa [hwC] using hc + have hzT : z ∈ T.cells := by simpa [hzD] using hd + rcases hxor with ⟨_, hnw⟩ | ⟨hnz, _⟩ + · exact hnw hwT + · exact hnz hzT + · exact False.elim (hcd (hwC.symm.trans hwD)) + +private theorem hnotBoundary : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (c : LatticeCell), ∀ (f : Finset GaussianInt), (f = {c, + c + (1 : GaussianInt)} ∨ f = {c, c + ⟨(0 : ℤ), (1 : ℤ)⟩} ∨ f = + {c + (1 : GaussianInt), c + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} ∨ f = + {c + ⟨(0 : ℤ), (1 : ℤ)⟩, c + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩}) → ((∀ (u : + GaussianInt), ∀ (v : GaussianInt), (f = {u, v}) → ((FourNeighborAdjacent u v) → (f ∉ + BoundaryFootprintEdges T))) → (f ∉ BoundaryFootprintEdges T)) ) := by + classical + intro T c f hfc internalNotBoundary + rcases hfc with hfc | hfc | hfc | hfc + · exact internalNotBoundary c (c + 1) hfc (by + change c + 1 = c + 1 ∨ _ + exact Or.inl rfl) + · exact internalNotBoundary c (c + ⟨0, 1⟩) hfc (by + change c + ⟨0, 1⟩ = c + 1 ∨ c + ⟨0, 1⟩ = c - 1 ∨ + c + ⟨0, 1⟩ = c + ⟨0, 1⟩ ∨ _ + exact Or.inr (Or.inr (Or.inl rfl))) + · exact internalNotBoundary (c + 1) (c + 1 + ⟨0, 1⟩) hfc (by + change c + 1 + ⟨0, 1⟩ = (c + 1) + 1 ∨ + c + 1 + ⟨0, 1⟩ = (c + 1) - 1 ∨ + c + 1 + ⟨0, 1⟩ = (c + 1) + ⟨0, 1⟩ ∨ _ + exact Or.inr (Or.inr (Or.inl (by abel)))) + · exact internalNotBoundary (c + ⟨0, 1⟩) (c + 1 + ⟨0, 1⟩) hfc (by + change c + 1 + ⟨0, 1⟩ = (c + ⟨0, 1⟩) + 1 ∨ _ + exact Or.inl (by abel)) + +private theorem internalIncident : + (by + classical + exact + ∀ (c : LatticeCell), ∀ (d : LatticeCell), (c ≠ d) → (∀ (f : Finset GaussianInt), (f ∈ + FootprintEdges (⟨{c}, c⟩ : ProtoTile)) → ((f ∈ FootprintEdges (⟨{d}, d⟩ : ProtoTile)) + → (∀ (u : GaussianInt), ∀ (v : GaussianInt), f = {u, v} → + FourNeighborAdjacent u v → ∃ (z : GaussianInt) (w : GaussianInt), ((u = z + (1 : + GaussianInt) ∧ v = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ v = z + (1 : + GaussianInt) ∧ u = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∧ w = z + (1 : + GaussianInt) ∨ (u = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ v = z + ⟨(0 : ℤ), (1 + : ℤ)⟩ ∨ v = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ u = z + ⟨(0 : ℤ), (1 : ℤ)⟩) + ∧ w = z + ⟨(0 : ℤ), (1 : ℤ)⟩) ∧ (z = c ∧ w = d ∨ z = d ∧ w = c)))) ) := by + classical + intro c d hcd f hfcOrig hfdOrig u v heq huv + obtain ⟨z, w, hgeom⟩ := (P4397T1UnitEdgeCells.1 u v huv) + have hmemC : ({u, v} : Finset GaussianInt) ∈ + FootprintEdges (⟨{c}, c⟩ : ProtoTile) := by + simpa [heq] using hfcOrig + have hmemD : ({u, v} : Finset GaussianInt) ∈ + FootprintEdges (⟨{d}, d⟩ : ProtoTile) := by + simpa [heq] using hfdOrig + have hincC : z = c ∨ w = c := by + have h := ((P4397T1UnitEdgeCells.2 u v z w hgeom + (⟨{c}, c⟩ : ProtoTile)).1.mp hmemC) + simpa [Finset.mem_singleton] using h + have hincD : z = d ∨ w = d := by + have h := ((P4397T1UnitEdgeCells.2 u v z w hgeom + (⟨{d}, d⟩ : ProtoTile)).1.mp hmemD) + simpa [Finset.mem_singleton] using h + rcases hincC with hzC | hwC <;> rcases hincD with hzD | hwD + · exact False.elim (hcd (hzC.symm.trans hzD)) + · exact ⟨z, w, hgeom, Or.inl ⟨hzC, hwD⟩⟩ + · exact ⟨z, w, hgeom, Or.inr ⟨hzD, hwC⟩⟩ + · exact False.elim (hcd (hwC.symm.trans hwD)) + +private theorem pathBoundary : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (p : List GaussianInt), + let k := p.idxOf x + let q := p.rotate k + let j := q.idxOf y + let r := q.take (j + 1) + (3 ≤ r.length) → ((List.IsChain (fun s t => ({s, t} : Finset GaussianInt) ∈ + BoundaryFootprintEdges T) r) → (∀ s, ∀ t, (s, t) ∈ r.zip r.tail → ({s, t} : Finset + GaussianInt) ∈ BoundaryFootprintEdges T)) ) := by + classical + intro T x y p k q j r hrLen hrBoundaryChain s t hst + rw [List.mem_iff_getElem] at hst + rcases hst with ⟨i, hi, hst⟩ + have hi' : i + 1 < r.length := by + simp only [List.length_zip, List.length_tail] at hi + omega + rw [List.getElem_zip, List.getElem_tail] at hst + injection hst with hs ht + subst s t + exact (List.isChain_iff_getElem.mp hrBoundaryChain) i hi' + +private theorem edgesAbsent : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (p : List GaussianInt), + let k := p.idxOf x + let q := p.rotate k + let j := q.idxOf y + let r := q.take (j + 1) + let edges := r.zip r.tail ++ [(y, x)] + ∀ (f : Finset GaussianInt), (f ∉ BoundaryFootprintEdges T) → ((∀ s, ∀ t, (s, t) ∈ r.zip + r.tail → ({s, t} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) → (∀ (u : + GaussianInt), ∀ (v : GaussianInt), f = {u, v} → f ≠ {x, y} → (u, v) ∉ edges ∧ (v, u) + ∉ edges)) ) := by + classical + intro T x y p k q j r edges f hnotBoundary pathBoundary u v heq hne + constructor + · intro hmem + have hsplit : (u, v) ∈ r.zip r.tail ∨ (u, v) = (y, x) := by + simpa [edges] using hmem + rcases hsplit with hArc | hClose + · apply hnotBoundary + rw [heq] + exact pathBoundary u v hArc + · apply hne + rw [heq] + cases hClose + simp [Finset.pair_comm] + · intro hmem + have hsplit : (v, u) ∈ r.zip r.tail ∨ (v, u) = (y, x) := by + simpa [edges] using hmem + rcases hsplit with hArc | hClose + · apply hnotBoundary + rw [heq] + simpa [Finset.pair_comm] using pathBoundary v u hArc + · apply hne + rw [heq] + cases hClose + simp [Finset.pair_comm] + +private theorem hunit : + (by + classical + exact + ∀ (c : LatticeCell), ∀ (f : Finset GaussianInt), (f = {c, c + (1 : GaussianInt)} ∨ f = + {c, c + ⟨(0 : ℤ), (1 : ℤ)⟩} ∨ f = {c + (1 : GaussianInt), + c + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} ∨ f = {c + ⟨(0 : ℤ), (1 : ℤ)⟩, + c + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩}) → (∃ u v, f = {u, v} ∧ + FourNeighborAdjacent u v) ) := by + classical + intro c f hfc + rcases hfc with h0 | h1 | h2 | h3 + · exact ⟨c, c + 1, h0, Or.inl rfl⟩ + · exact ⟨c, c + ⟨0, 1⟩, h1, + Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨c + 1, c + 1 + ⟨0, 1⟩, h2, by + change c + 1 + ⟨0, 1⟩ = (c + 1) + 1 ∨ + c + 1 + ⟨0, 1⟩ = (c + 1) - 1 ∨ + c + 1 + ⟨0, 1⟩ = (c + 1) + ⟨0, 1⟩ ∨ _ + exact Or.inr (Or.inr (Or.inl (by abel)))⟩ + · exact ⟨c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩, h3, by + change c + 1 + ⟨0, 1⟩ = (c + ⟨0, 1⟩) + 1 ∨ _ + exact Or.inl (by abel)⟩ + +private theorem hsetAt681 : + (by + classical + exact + ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (f : Finset GaussianInt), ∀ (z : + GaussianInt), (f = {u, v}) → ((u = z + (1 : GaussianInt) ∧ v = z + (1 : GaussianInt) + + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ v = z + (1 : GaussianInt) ∧ u = z + (1 : GaussianInt) + ⟨(0 : + ℤ), (1 : ℤ)⟩) → (f = {z + 1, z + 1 + ⟨0, 1⟩})) ) := by + classical + intro u v f z heq hvertical + rcases hvertical with ⟨hu, hv⟩ | ⟨hv, hu⟩ + · simpa [hu, hv] using heq + · simpa [hu, hv, Finset.pair_comm] using heq + +private theorem hcdEqAt689 : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (p : List GaussianInt), + let k := p.idxOf x + let q := p.rotate k + let j := q.idxOf y + let r := q.take (j + 1) + ∀ (c : LatticeCell), ∀ (d : LatticeCell), ∀ (z : GaussianInt), ∀ (w : GaussianInt), (z = + c ∧ w = d ∨ z = d ∧ w = c) → ((GridRayCrossingIndex w r = GridRayCrossingIndex z r) → + (GridRayCrossingIndex c r = GridRayCrossingIndex d r)) ) := by + classical + intro x y p k q j r c d z w hincident hzero' + rcases hincident with ⟨hzc, hwd⟩ | ⟨hzd, hwc⟩ + · simpa [hzc, hwd] using hzero'.symm + · simpa [hzd, hwc] using hzero' + +private theorem hsetAt695 : + (by + classical + exact + ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (f : Finset GaussianInt), ∀ (z : + GaussianInt), (f = {u, v}) → ((u = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ v = z + + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ v = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ u = z + ⟨(0 : + ℤ), (1 : ℤ)⟩) → (f = {z + 1 + ⟨0, 1⟩, z + ⟨0, 1⟩})) ) := by + classical + intro u v f z heq hhorizontal + rcases hhorizontal with ⟨hu, hv⟩ | ⟨hv, hu⟩ + · simpa [hu, hv] using heq + · simpa [hu, hv, Finset.pair_comm] using heq + +private theorem hcdEqAt703 : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (p : List GaussianInt), + let k := p.idxOf x + let q := p.rotate k + let j := q.idxOf y + let r := q.take (j + 1) + ∀ (c : LatticeCell), ∀ (d : LatticeCell), ∀ (z : GaussianInt), ∀ (w : GaussianInt), (z = + c ∧ w = d ∨ z = d ∧ w = c) → ((GridRayCrossingIndex w r = GridRayCrossingIndex z r) → + (GridRayCrossingIndex c r = GridRayCrossingIndex d r)) ) := by + classical + intro x y p k q j r c d z w hincident hzero' + rcases hincident with ⟨hzc, hwd⟩ | ⟨hzd, hwc⟩ + · simpa [hzc, hwd] using hzero'.symm + · simpa [hzd, hwc] using hzero' + +end CrosscutIndexProof + +theorem P4456T2CrosscutIndex (T : ProtoTile) (hT : LatticeTile T) + (x y : GaussianInt) (hxy : FourNeighborAdjacent x y) + (hx : x ∈ BoundaryFootprintVertices T) + (hy : y ∈ BoundaryFootprintVertices T) + (he : OpenLatticeEdge x y ⊆ interior (TileRealization T)) : + ∃ (side : GaussianInt → Int) (a b : GaussianInt), + a ∈ T.cells ∧ b ∈ T.cells ∧ a ≠ b ∧ side a ≠ side b ∧ + ({x, y} : Finset GaussianInt) ∈ FootprintEdges ⟨{a}, a⟩ ∧ + ({x, y} : Finset GaussianInt) ∈ FootprintEdges ⟨{b}, b⟩ ∧ + ∀ c ∈ T.cells, ∀ d ∈ T.cells, c ≠ d → + ∀ f ∈ FootprintEdges (⟨{c}, c⟩ : ProtoTile) ∩ + FootprintEdges (⟨{d}, d⟩ : ProtoTile), + side c ≠ side d → f = {x, y} := by +-- BODY + classical + obtain ⟨a, b, hform⟩ := P4397T1UnitEdgeCells.1 x y hxy + have hab := CrosscutIndexProof.hab x y a b hform + have ha : ({x, y} : Finset GaussianInt) ∈ FootprintEdges ⟨{a}, a⟩ := + (P4397T1UnitEdgeCells.2 x y a b hform ⟨{a}, a⟩).1.mpr + (Or.inl (Finset.mem_singleton_self a)) + have hb : ({x, y} : Finset GaussianInt) ∈ FootprintEdges ⟨{b}, b⟩ := + (P4397T1UnitEdgeCells.2 x y a b hform ⟨{b}, b⟩).1.mpr + (Or.inr (Finset.mem_singleton_self b)) + have hboth := (P4456T2EdgeInterior T x y a b hxy hab ha hb).mp he + suffices hs : ∃ side : GaussianInt → Int, side a ≠ side b ∧ + ∀ c ∈ T.cells, ∀ d ∈ T.cells, c ≠ d → + ∀ f ∈ FootprintEdges (⟨{c}, c⟩ : ProtoTile) ∩ + FootprintEdges (⟨{d}, d⟩ : ProtoTile), + side c ≠ side d → f = {x, y} by + obtain ⟨side, hside, hstep⟩ := hs + exact ⟨side, a, b, hboth.1, hboth.2, hab, hside, ha, hb, hstep⟩ + classical + obtain ⟨p, u, v, hpNodup, hpLen, hpHead, hpLast, hpVerts, hvu, + hpChain, hpEdges⟩ := LatticeTileBoundarySimpleGridCycle T hT + let k := p.idxOf x + have hk : k < p.length := List.idxOf_lt_length_of_mem (CrosscutIndexProof.hxmem T x hx p hpVerts) + have hxidx : p[k] = x := by simp [k] + let q := p.rotate k + have hqHead : q.head? = some x := CrosscutIndexProof.hqHead x p hk hxidx + have hqNodup : q.Nodup := (List.nodup_rotate).2 hpNodup + have hqLen : q.length = p.length := List.length_rotate _ _ + have hyq : y ∈ q := (List.mem_rotate).2 (CrosscutIndexProof.hymem T y hy p hpVerts) + let j := q.idxOf y + have hj : j < q.length := List.idxOf_lt_length_of_mem hyq + have hyidx : q[j] = y := by simp [j] + have hjpos : 0 < j := CrosscutIndexProof.hjpos x y p hpLen hqHead hqLen hyq hj hyidx + (CrosscutIndexProof.hxne x y hxy p) + have hqBoundaryChain := CrosscutIndexProof.hqBoundaryChain T x y p u v hpHead hpLast hpEdges hk + hqLen + let r := q.take (j + 1) + have hrHead : r.head? = some x := by + simp [r, List.head?_take, Nat.ne_of_gt hjpos, hqHead] + have hrNodup : r.Nodup := by + exact List.Nodup.sublist (List.take_sublist _ _) hqNodup + have hrLen := CrosscutIndexProof.hrLen T x y p hpLen (CrosscutIndexProof.hchordBoundary T x y a + b hform hboth) hqHead hqLen hyq hj hyidx + hjpos hqBoundaryChain + have hrBoundaryChain : List.IsChain (fun s t => ({s, t} : Finset GaussianInt) ∈ + BoundaryFootprintEdges T) r := hqBoundaryChain.take _ + let side : GaussianInt → Int := fun c => GridRayCrossingIndex c r + have hcross := GridRayCrossingIndexAdjacentCell r x y hrHead (CrosscutIndexProof.hrLast x y p + hj hyidx hjpos) hrNodup hrLen + (CrosscutIndexProof.pathAdj T x y p hrLen hrBoundaryChain (CrosscutIndexProof.boundaryAdj T)) + (CrosscutIndexProof.hclose x y hxy) + let edges := r.zip r.tail ++ [(y, x)] + refine ⟨side, ?_, ?_⟩ + · have hc := hcross a + rcases hform with ⟨hvert, hbform⟩ | ⟨hhoriz, hbform⟩ + · have hocc : (a + 1, a + 1 + ⟨0, 1⟩) ∈ edges ∨ + (a + 1 + ⟨0, 1⟩, a + 1) ∈ edges := CrosscutIndexProof.hoccAt342 x y a p hvert + have hnat := hc.2.1 (by simpa [edges] using hocc) + intro heq + rw [hbform] at heq + change GridRayCrossingIndex a r = GridRayCrossingIndex (a + 1) r at heq + rw [← heq] at hnat + simp at hnat + · have hocc : (a + 1 + ⟨0, 1⟩, a + ⟨0, 1⟩) ∈ edges ∨ + (a + ⟨0, 1⟩, a + 1 + ⟨0, 1⟩) ∈ edges := CrosscutIndexProof.hoccAt353 x y a p hhoriz + have hnat := hc.2.2.2 (by simpa [edges] using hocc) + intro heq + rw [hbform] at heq + change GridRayCrossingIndex a r = GridRayCrossingIndex (a + ⟨0, 1⟩) r at heq + rw [← heq] at hnat + simp at hnat + · -- Every occupied shared side other than the chord is absent from the arc. + intro c hc d hd hcd f hf hdiff + rcases hf with ⟨hfc, hfd⟩ + have hfcOrig := hfc + have hfdOrig := hfd + have hcdAdj := CrosscutIndexProof.hcdAdj x y p c d hcd f hfc hfd + change (∃ z ∈ ({c} : Finset GaussianInt), + f = {z, z + 1} ∨ f = {z, z + ⟨0, 1⟩} ∨ + f = {z + 1, z + 1 + ⟨0, 1⟩} ∨ + f = {z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩}) at hfc + change (∃ z ∈ ({d} : Finset GaussianInt), + f = {z, z + 1} ∨ f = {z, z + ⟨0, 1⟩} ∨ + f = {z + 1, z + 1 + ⟨0, 1⟩} ∨ + f = {z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩}) at hfd + simp only [Finset.mem_singleton] at hfc hfd + rcases hfc with ⟨z, hz, hfc⟩ + have hzc : z = c := by simpa using hz + rw [hzc] at hfc + rcases hfd with ⟨w, hw, hfd⟩ + have hwd : w = d := by simpa using hw + rw [hwd] at hfd + /- + let edgePair (q : GaussianInt) (i : Fin 4) : GaussianInt × GaussianInt := + if i.val = 0 then (q, q + 1) else if i.val = 1 then (q, q + ⟨0, 1⟩) + else if i.val = 2 then (q + 1, q + 1 + ⟨0, 1⟩) + else (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) + have hcEdge : ∃ i : Fin 4, + f = {(edgePair c i).1, (edgePair c i).2} := by + rcases hfc with hfc | hfc | hfc | hfc + · exact ⟨⟨0, by omega⟩, by simpa [edgePair] using hfc⟩ + · exact ⟨⟨1, by omega⟩, by simpa [edgePair] using hfc⟩ + · exact ⟨⟨2, by omega⟩, by simpa [edgePair] using hfc⟩ + · exact ⟨⟨3, by omega⟩, by simpa [edgePair] using hfc⟩ + have hdEdge : ∃ i : Fin 4, + f = {(edgePair d i).1, (edgePair d i).2} := by + rcases hfd with hfd | hfd | hfd | hfd + · exact ⟨⟨0, by omega⟩, by simpa [edgePair] using hfd⟩ + · exact ⟨⟨1, by omega⟩, by simpa [edgePair] using hfd⟩ + · exact ⟨⟨2, by omega⟩, by simpa [edgePair] using hfd⟩ + · exact ⟨⟨3, by omega⟩, by simpa [edgePair] using hfd⟩ + obtain ⟨i, hi⟩ := hcEdge + obtain ⟨j, hj⟩ := hdEdge + have pairMatch (u v w z : GaussianInt) + (heq : ({u, v} : Finset GaussianInt) = {w, z}) (huv : u ≠ v) : + (u = w ∧ v = z) ∨ (u = z ∧ v = w) := by + have huwz : u = w ∨ u = z := by + have hm : u ∈ ({w, z} : Finset GaussianInt) := by rw [← heq]; simp + simpa using hm + have hvwz : v = w ∨ v = z := by + have hm : v ∈ ({w, z} : Finset GaussianInt) := by rw [← heq]; simp + simpa using hm + rcases huwz with huw | huz <;> rcases hvwz with hvw | hvz + · exact False.elim (huv (huw.trans hvw.symm)) + · exact Or.inl ⟨huw, hvz⟩ + · exact Or.inr ⟨huz, hvw⟩ + · exact False.elim (huv (huz.trans hvz.symm)) + have hne : (edgePair c i).1 ≠ (edgePair c i).2 := by + fin_cases i <;> simp [edgePair, Zsqrtd.ext_iff] + have hm := pairMatch (edgePair c i).1 (edgePair c i).2 + (edgePair d j).1 (edgePair d j).2 (hi.symm.trans hj) hne + have hshared : + (d = c + 1 ∧ f = {c + 1, c + 1 + ⟨0, 1⟩}) ∨ + (d = c - 1 ∧ f = {c, c + ⟨0, 1⟩}) ∨ + (d = c + ⟨0, 1⟩ ∧ f = {c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩}) ∨ + (d = c - ⟨0, 1⟩ ∧ f = {c, c + 1}) := by + rcases hcdAdj with hd | hd | hd | hd + · left + constructor + · exact hd + · rw [hd] at hm hj + fin_cases i <;> fin_cases j + all_goals + first + | simpa [edgePair, Finset.pair_comm] using hi + | (rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> + dsimp [edgePair] at h1 h2 <;> + simp only [Zsqrtd.ext_iff] at h1 h2 <;> + (trace_state; omega)) + · right; left + have hc' : c = d + 1 := by rw [hd]; simp + constructor + · exact hd + · + fin_cases i <;> fin_cases j + all_goals + rw [hc'] at hm hi ⊢ + first + | simpa [edgePair, Finset.pair_comm] using hi + | (rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> + dsimp [edgePair] at h1 h2 <;> + simp only [Zsqrtd.ext_iff] at h1 h2 <;> + ring_nf at h1 h2 <;> omega) + · right; right; left + constructor + · exact hd + · rw [hd] at hm hj + fin_cases i <;> fin_cases j + all_goals + first + | simpa [edgePair, Finset.pair_comm] using hi + | ((rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> + dsimp [edgePair] at h1 h2 <;> + simp only [Zsqrtd.ext_iff] at h1 h2 <;> + ring_nf at h1 h2 <;> omega)) + · right; right; right + have hc' : c = d + ⟨0, 1⟩ := by rw [hd]; simp + constructor + · exact hd + · + fin_cases i <;> fin_cases j + all_goals + rw [hc'] at hm hi ⊢ + first + | simpa [edgePair, Finset.pair_comm] using hi + | (rcases hm with ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> + dsimp [edgePair] at h1 h2 <;> + simp only [Zsqrtd.ext_iff] at h1 h2 <;> + ring_nf at h1 h2 <;> omega) + -/ + have edgesAbsent (u v : GaussianInt) (heq : f = {u, v}) + (hne : f ≠ {x, y}) := CrosscutIndexProof.edgesAbsent T x y p f + (CrosscutIndexProof.hnotBoundary T c f hfc (CrosscutIndexProof.internalNotBoundary T + c hc d hd hcd f hfcOrig hfdOrig)) (CrosscutIndexProof.pathBoundary T x y p hrLen + hrBoundaryChain) + u v heq hne + have hsideDiff := hdiff + by_cases hchord : f = {x, y} + · exact hchord + · have hunit : ∃ u v, f = {u, v} ∧ FourNeighborAdjacent u v := CrosscutIndexProof.hunit c f hfc + obtain ⟨u, v, heq, huv⟩ := hunit + obtain ⟨z, w, hgeom, hincident⟩ := (CrosscutIndexProof.internalIncident c d hcd f hfcOrig + hfdOrig) u v heq huv + rcases hgeom with ⟨hvertical, hwz⟩ | ⟨hhorizontal, hwz⟩ + · have hset : f = {z + 1, z + 1 + ⟨0, 1⟩} := CrosscutIndexProof.hsetAt681 u v f z heq + hvertical + have habsent := edgesAbsent (z + 1) (z + 1 + ⟨0, 1⟩) hset hchord + have hzero := (hcross z).1 (by simpa [edges] using habsent) + have hzero' : GridRayCrossingIndex w r = GridRayCrossingIndex z r := by + simpa [hwz] using hzero + have hcdEq := CrosscutIndexProof.hcdEqAt689 x y p c d z w hincident hzero' + change GridRayCrossingIndex c r ≠ GridRayCrossingIndex d r at hsideDiff + exact False.elim (hsideDiff hcdEq) + · have hset : f = {z + 1 + ⟨0, 1⟩, z + ⟨0, 1⟩} := CrosscutIndexProof.hsetAt695 u v f z heq + hhorizontal + have habsent := edgesAbsent (z + 1 + ⟨0, 1⟩) (z + ⟨0, 1⟩) hset hchord + have hzero := (hcross z).2.2.1 (by simpa [edges] using habsent) + have hzero' : GridRayCrossingIndex w r = GridRayCrossingIndex z r := by + simpa [hwz] using hzero + have hcdEq := CrosscutIndexProof.hcdEqAt703 x y p c d z w hincident hzero' + change GridRayCrossingIndex c r ≠ GridRayCrossingIndex d r at hsideDiff + exact False.elim (hsideDiff hcdEq) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2DiamondNoChord.lean b/LeanPool/ApollonianSuperharmonic/P4456T2DiamondNoChord.lean new file mode 100644 index 0000000000..190a04cb63 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4456T2DiamondNoChord.lean @@ -0,0 +1,395 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4456T2EdgeInterior +public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain +public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P4456T2DiamondNoChord] + +/-! +# P4456T2DiamondNoChord + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiamondNoChordProof + +private theorem hcell : + ∀ (k : Nat), ∀ (w : GaussianInt), ∀ (T : ProtoTile), (T.cells = (TileTranslation (DiamondTile + k) w).cells) → (((TileTranslation (DiamondTile k) w).cells = (DiamondCellDomain k).image + (GaussianTranslation w)) → (∀ (c : GaussianInt), c ∈ T.cells ↔ c - w ∈ DiamondCellDomain + k)) := by + classical + intro k w T hcells htrans c + rw [hcells, htrans] + change c ∈ (DiamondCellDomain k).image (GaussianTranslation w) ↔ _ + constructor + · intro hc + rcases Finset.mem_image.mp hc with ⟨a, ha, heq⟩ + have : a = c - w := by + have := congrArg (fun z : GaussianInt => z - w) heq + simpa [GaussianTranslation, sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] using this + simpa [this] using ha + · intro hc + apply Finset.mem_image.mpr + refine ⟨c - w, hc, ?_⟩ + simp [GaussianTranslation, sub_eq_add_neg, add_comm] + +private theorem hstar : + ∀ (k : Nat), ∀ (w : GaussianInt), ∀ (T : ProtoTile), ∀ (x : LatticeCell), ∀ (y : + LatticeCell), (x ∈ BoundaryFootprintVertices T) → ((y ∈ BoundaryFootprintVertices T) → + ((∀ (c : GaussianInt), c ∈ T.cells ↔ c - w ∈ DiamondCellDomain k) → ((T.cells.Nonempty) → + ((∀ (v : GaussianInt), (v ∈ BoundaryFootprintVertices T) → (v ∈ FootprintVertices T)) → + (∀ (p : GaussianInt), p = x ∨ p = y → (∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell (p + - w) j ∈ DiamondCellDomain k) → p ∉ BoundaryFootprintVertices T))))) := by + classical + intro k w T x y hx hy hcell hnonempty hvertex p hp hs + have hsT : ∀ j : Fin 4, LatticeVertexIncidentCell p j ∈ T.cells := by + intro j + have heq : LatticeVertexIncidentCell (p - w) j + w = + LatticeVertexIncidentCell p j := by + fin_cases j <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm] <;> abel + rw [← heq, hcell] + simpa [sub_sub] using hs j + have hpfoot : p ∈ FootprintVertices T := by + rcases hp with h | h + · rw [h] + exact hvertex x hx + · rw [h] + exact hvertex y hy + exact (P4456T2VertexInterior T hnonempty p hpfoot).2.mpr hsT + +private theorem growUp : + ∀ (k : Nat), (∀ q ∈ DiamondCellDomain k, (0 : ℤ) ≤ q.im ∧ q.im < (2 : ℤ) * (↑k : ℤ) ∧ -(q.im + + (1 : ℤ)) ≤ q.re ∧ q.re < q.im + (1 : ℤ) ∧ -((2 : ℤ) * (↑k : ℤ) - q.im) ≤ q.re ∧ q.re < + (2 : ℤ) * (↑k : ℤ) - q.im) → (∀ q ∈ DiamondCellDomain k, q + (1 : GaussianInt) ∈ + DiamondCellDomain k → q.im < (↑k : ℤ) → ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell (q + + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) j ∈ DiamondCellDomain k) := by + classical + intro k rowFacts q hq hq1 hb + have hr := rowFacts q hq + have hr1 := rowFacts (q + 1) (by simpa using hq1) + have hup : q + ⟨0,1⟩ ∈ DiamondCellDomain k := by + apply (P4194T1DiamondCellRows k (q + ⟨0,1⟩)).1.mpr + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, + ] at hr hr1 ⊢ + omega + have hup1 : q + 1 + ⟨0,1⟩ ∈ DiamondCellDomain k := by + apply (P4194T1DiamondCellRows k (q + 1 + ⟨0,1⟩)).1.mpr + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, + ] at hr hr1 ⊢ + omega + intro j + fin_cases j + · simpa [LatticeVertexIncidentCell] using hup1 + · have heq : q + 1 + ⟨0,1⟩ - 1 = q + ⟨0,1⟩ := by abel + simpa [LatticeVertexIncidentCell, heq] using hup + · have heq : q + 1 + ⟨0,1⟩ - 1 - ⟨0,1⟩ = q := by abel + simpa [LatticeVertexIncidentCell, heq] using hq + · have heq : q + 1 + ⟨0,1⟩ - ⟨0,1⟩ = q + 1 := by abel + simpa [LatticeVertexIncidentCell, heq] using hq1 + +private theorem growDown : + ∀ (k : Nat), (∀ q ∈ DiamondCellDomain k, (0 : ℤ) ≤ q.im ∧ q.im < (2 : ℤ) * (↑k : ℤ) ∧ -(q.im + + (1 : ℤ)) ≤ q.re ∧ q.re < q.im + (1 : ℤ) ∧ -((2 : ℤ) * (↑k : ℤ) - q.im) ≤ q.re ∧ q.re < + (2 : ℤ) * (↑k : ℤ) - q.im) → (∀ q ∈ DiamondCellDomain k, q + (1 : GaussianInt) ∈ + DiamondCellDomain k → (↑k : ℤ) ≤ q.im → ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell (q + + (1 : GaussianInt)) j ∈ DiamondCellDomain k) := by + classical + intro k rowFacts q hq hq1 hb + have hr := rowFacts q hq + have hr1 := rowFacts (q + 1) (by simpa using hq1) + have hdown : q - ⟨0,1⟩ ∈ DiamondCellDomain k := by + apply (P4194T1DiamondCellRows k (q - ⟨0,1⟩)).1.mpr + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, + Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one, + ] at hr hr1 ⊢ + omega + have hdown1 : q + 1 - ⟨0,1⟩ ∈ DiamondCellDomain k := by + apply (P4194T1DiamondCellRows k (q + 1 - ⟨0,1⟩)).1.mpr + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, + Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, + ] at hr hr1 ⊢ + omega + intro j + fin_cases j + · simpa [LatticeVertexIncidentCell] using hq1 + · have heq : q + 1 - 1 = q := by abel + simpa [LatticeVertexIncidentCell, heq] using hq + · have heq : q + 1 - 1 - ⟨0,1⟩ = q - ⟨0,1⟩ := by abel + simpa [LatticeVertexIncidentCell, heq] using hdown + · have heq : q + 1 - ⟨0,1⟩ = q + 1 - ⟨0,1⟩ := rfl + simpa [LatticeVertexIncidentCell, heq] using hdown1 + +private theorem horizontalStar : + ∀ (k : Nat), (∀ q ∈ DiamondCellDomain k, (0 : ℤ) ≤ q.im ∧ q.im < (2 : ℤ) * (↑k : ℤ) ∧ -(q.im + + (1 : ℤ)) ≤ q.re ∧ q.re < q.im + (1 : ℤ) ∧ -((2 : ℤ) * (↑k : ℤ) - q.im) ≤ q.re ∧ q.re < + (2 : ℤ) * (↑k : ℤ) - q.im) → (∀ q ∈ DiamondCellDomain k, q + ⟨(0 : ℤ), (1 : ℤ)⟩ ∈ + DiamondCellDomain k → ∃ (p : GaussianInt), (p = q + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ p = q + (1 : + GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∧ ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell p j ∈ + DiamondCellDomain k) := by + classical + intro k rowFacts q hq hqi + have hr := rowFacts q hq + have hr1 := rowFacts (q + ⟨0,1⟩) (by simpa using hqi) + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] at hr hr1 + rcases hr with ⟨hb0, hbN, hlo1, hhi1, hlo2, hhi2⟩ + rcases hr1 with ⟨hb10, hb1N, hlo11, hhi11, hlo12, hhi12⟩ + let m : Int := if q.im < (k : Int) then q.im + 1 else 2 * (k : Int) - q.im - 1 + have hmrange : -m ≤ q.re ∧ q.re < m := by + dsimp [m] + by_cases hb : q.im < (k : Int) <;> simp [hb] at * <;> omega + have hmpos : 0 < m := by + dsimp [m] + by_cases hb : q.im < (k : Int) <;> simp [hb] at * <;> omega + have hright (ha : q.re = -m) : + ∀ j : Fin 4, LatticeVertexIncidentCell (q + 1 + ⟨0,1⟩) j ∈ + DiamondCellDomain k := by + have hq1 : q + 1 ∈ DiamondCellDomain k := by + apply (P4194T1DiamondCellRows k (q + 1)).1.mpr + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, + ] + by_cases hb : q.im < (k : Int) + · have hm : m = q.im + 1 := by simp [m, hb] + rw [hm] at ha hmrange + omega + · have hm : m = 2 * (k : Int) - q.im - 1 := by simp [m, hb] + rw [hm] at ha hmrange + omega + have hqi1 : q + ⟨0,1⟩ + 1 ∈ DiamondCellDomain k := by + apply (P4194T1DiamondCellRows k (q + ⟨0,1⟩ + 1)).1.mpr + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, + ] + by_cases hb : q.im < (k : Int) + · have hm : m = q.im + 1 := by simp [m, hb] + rw [hm] at ha hmrange + omega + · have hm : m = 2 * (k : Int) - q.im - 1 := by simp [m, hb] + rw [hm] at ha hmrange + omega + intro j + fin_cases j + · simpa [LatticeVertexIncidentCell, add_assoc, add_comm, add_left_comm] using hqi1 + · have heq : q + 1 + ⟨0,1⟩ - 1 = q + ⟨0,1⟩ := by abel + simpa [LatticeVertexIncidentCell, heq] using hqi + · have heq : q + 1 + ⟨0,1⟩ - 1 - ⟨0,1⟩ = q := by abel + simpa [LatticeVertexIncidentCell, heq] using hq + · have heq : q + 1 + ⟨0,1⟩ - ⟨0,1⟩ = q + 1 := by abel + simpa [LatticeVertexIncidentCell, heq] using hq1 + have hleft (ha : -m < q.re) : + ∀ j : Fin 4, LatticeVertexIncidentCell (q + ⟨0,1⟩) j ∈ + DiamondCellDomain k := by + have hqm : q - 1 ∈ DiamondCellDomain k := by + apply (P4194T1DiamondCellRows k (q - 1)).1.mpr + simp only [Zsqrtd.re_sub, + Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, + ] + by_cases hb : q.im < (k : Int) + · have hm : m = q.im + 1 := by simp [m, hb] + rw [hm] at ha hmrange + omega + · have hm : m = 2 * (k : Int) - q.im - 1 := by simp [m, hb] + rw [hm] at ha hmrange + omega + have hqim : q + ⟨0,1⟩ - 1 ∈ DiamondCellDomain k := by + apply (P4194T1DiamondCellRows k (q + ⟨0,1⟩ - 1)).1.mpr + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, + Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, + ] + by_cases hb : q.im < (k : Int) + · have hm : m = q.im + 1 := by simp [m, hb] + rw [hm] at ha hmrange + omega + · have hm : m = 2 * (k : Int) - q.im - 1 := by simp [m, hb] + rw [hm] at ha hmrange + omega + intro j + fin_cases j + · simpa [LatticeVertexIncidentCell] using hqi + · have heq : q + ⟨0,1⟩ - 1 = q - 1 + ⟨0,1⟩ := by abel + simpa [LatticeVertexIncidentCell, heq] using hqim + · have heq : q + ⟨0,1⟩ - 1 - ⟨0,1⟩ = q - 1 := by abel + simpa [LatticeVertexIncidentCell, heq] using hqm + · have heq : q + ⟨0,1⟩ - ⟨0,1⟩ = q := by abel + simpa [LatticeVertexIncidentCell, heq] using hq + by_cases ha : q.re = -m + · exact ⟨q + 1 + ⟨0,1⟩, Or.inr rfl, hright ha⟩ + · have ha' : -m < q.re := by omega + exact ⟨q + ⟨0,1⟩, Or.inl rfl, hleft ha'⟩ + +private theorem hpcoordsAt386 : + ∀ (w : GaussianInt), ∀ (z : GaussianInt), ∀ (r : GaussianInt), + let p : GaussianInt := r + w + r = z - w + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ r = z - w + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ → p = z + + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ p = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ := by + classical + intro w z r p hr' + dsimp [p] + rcases hr' with h | h + · left + rw [h] + abel + · right + rw [h] + abel + +end DiamondNoChordProof + +theorem P4456T2DiamondNoChord (k : Nat) (hk : 0 < k) + (w : GaussianInt) (T : ProtoTile) + (hcells : T.cells = (TileTranslation (DiamondTile k) w).cells) : + ∀ x y, FourNeighborAdjacent x y → + x ∈ BoundaryFootprintVertices T → y ∈ BoundaryFootprintVertices T → + ¬ OpenLatticeEdge x y ⊆ interior (TileRealization T) := by +-- BODY + classical + intro x y hxy hx hy hinside + have htrans : (TileTranslation (DiamondTile k) w).cells = + (DiamondCellDomain k).image (GaussianTranslation w) := by + exact (TileTranslationFormulas (DiamondTile k) w).1 + have hcell (c : GaussianInt) : c ∈ T.cells ↔ c - w ∈ DiamondCellDomain k := + DiamondNoChordProof.hcell k w T hcells htrans c + have hnonempty : T.cells.Nonempty := by + rw [hcells, htrans] + apply Finset.image_nonempty.mpr + refine ⟨0, ?_⟩ + have hzero : (0 : GaussianInt) ∈ DiamondCellDomain k := by + rw [(P4194T1DiamondCellRows k 0).1] + norm_num + omega + exact hzero + have hvertex (v : GaussianInt) (hv : v ∈ BoundaryFootprintVertices T) : + v ∈ FootprintVertices T := by + unfold BoundaryFootprintVertices at hv + rw [ite_eq_left hnonempty] at hv + rcases hv with ⟨e, he, hv⟩ + unfold BoundaryFootprintEdges at he + rcases he with ⟨z, hz⟩ + rcases hz with ⟨rfl, _⟩ | ⟨rfl, _⟩ <;> + simp [FootprintVertices, hnonempty] <;> aesop + obtain ⟨z, v, hform⟩ := P4397T1UnitEdgeCells.1 x y hxy + let A : ProtoTile := ⟨{z}, z⟩ + let B : ProtoTile := ⟨{v}, v⟩ + have hzv : z ≠ v := by + intro heq + rcases hform with ⟨_, hvform⟩ | ⟨_, hvform⟩ + · rw [hvform] at heq + have := congrArg Zsqrtd.re heq + norm_num at this + · rw [hvform] at heq + have := congrArg Zsqrtd.im heq + norm_num at this + have hA : ({x,y} : Finset GaussianInt) ∈ FootprintEdges A := by + exact (P4397T1UnitEdgeCells.2 x y z v hform A).1.mpr (by simp [A]) + have hB : ({x,y} : Finset GaussianInt) ∈ FootprintEdges B := by + exact (P4397T1UnitEdgeCells.2 x y z v hform B).1.mpr (by simp [B]) + have hinc : z ∈ T.cells ∧ v ∈ T.cells := + (P4456T2EdgeInterior T x y z v hxy hzv hA hB).1 hinside + have hza := hinc.1 + have hva := hinc.2 + have hstar (p : GaussianInt) (hp : p = x ∨ p = y) + (hs : ∀ j : Fin 4, LatticeVertexIncidentCell (p - w) j ∈ DiamondCellDomain k) : + p ∉ BoundaryFootprintVertices T := DiamondNoChordProof.hstar k w T x y hx hy hcell + hnonempty hvertex p hp hs + have rowFacts (q : GaussianInt) (hq : q ∈ DiamondCellDomain k) := + (P4194T1DiamondCellRows k q).1.mp hq + have growUp (q : GaussianInt) (hq : q ∈ DiamondCellDomain k) + (hq1 : q + 1 ∈ DiamondCellDomain k) (hb : q.im < (k : Int)) : + ∀ j : Fin 4, LatticeVertexIncidentCell (q + 1 + ⟨0,1⟩) j ∈ + DiamondCellDomain k := DiamondNoChordProof.growUp k rowFacts q hq hq1 hb + have growDown (q : GaussianInt) (hq : q ∈ DiamondCellDomain k) + (hq1 : q + 1 ∈ DiamondCellDomain k) (hb : (k : Int) ≤ q.im) : + ∀ j : Fin 4, LatticeVertexIncidentCell (q + 1) j ∈ + DiamondCellDomain k := DiamondNoChordProof.growDown k rowFacts q hq hq1 hb + have horizontalStar (q : GaussianInt) (hq : q ∈ DiamondCellDomain k) + (hqi : q + ⟨0,1⟩ ∈ DiamondCellDomain k) : + ∃ p, (p = q + ⟨0,1⟩ ∨ p = q + 1 + ⟨0,1⟩) ∧ + ∀ j : Fin 4, LatticeVertexIncidentCell p j ∈ DiamondCellDomain k := + DiamondNoChordProof.horizontalStar k rowFacts q hq hqi + rcases hform with ⟨hor, hvform⟩ | ⟨hor, hvform⟩ + · have hq : z - w ∈ DiamondCellDomain k := hcell z |>.mp hza + have hq1 : (z - w) + 1 ∈ DiamondCellDomain k := by + have heq : v - w = (z - w) + 1 := by rw [hvform]; abel + rw [← heq] + exact hcell v |>.mp hva + by_cases hb : (z - w).im < (k : Int) + · let p : GaussianInt := ((z - w) + 1 + ⟨0,1⟩) + w + have hpcoords : (z - w) + 1 + ⟨0,1⟩ + w = z + 1 + ⟨0,1⟩ := by + abel + have hpends : p = x ∨ p = y := by + dsimp [p] + rw [hpcoords] + rcases hor with ⟨hx', hy'⟩ | ⟨hy', hx'⟩ + · exact Or.inr hy'.symm + · exact Or.inl hx'.symm + have hs := growUp (z - w) hq hq1 hb + have hnot := hstar p hpends (by + have hcalc : p - w = (z - w) + 1 + ⟨0,1⟩ := by dsimp [p]; abel + simpa [hcalc] using hs) + rcases hpends with hp | hp + · exact hnot (by simpa [hp] using hx) + · exact hnot (by simpa [hp] using hy) + · let p : GaussianInt := ((z - w) + 1) + w + have hpcoords : (z - w) + 1 + w = z + 1 := by abel + have hpends : p = x ∨ p = y := by + dsimp [p] + rw [hpcoords] + rcases hor with ⟨hx', hy'⟩ | ⟨hy', hx'⟩ + · exact Or.inl hx'.symm + · exact Or.inr hy'.symm + have hs := growDown (z - w) hq hq1 (le_of_not_gt hb) + have hnot := hstar p hpends (by + have hcalc : p - w = (z - w) + 1 := by dsimp [p]; abel + simpa [hcalc] using hs) + rcases hpends with hp | hp + · exact hnot (by simpa [hp] using hx) + · exact hnot (by simpa [hp] using hy) + · have hq : z - w ∈ DiamondCellDomain k := hcell z |>.mp hza + have hqi : (z - w) + ⟨0,1⟩ ∈ DiamondCellDomain k := by + have heq : v - w = (z - w) + ⟨0,1⟩ := by rw [hvform]; abel + rw [← heq] + exact hcell v |>.mp hva + obtain ⟨r, hr, hstarR⟩ := horizontalStar (z - w) hq hqi + let p : GaussianInt := r + w + have hpcoords (hr' : r = (z - w) + ⟨0,1⟩ ∨ + r = (z - w) + 1 + ⟨0,1⟩) : + p = z + ⟨0,1⟩ ∨ p = z + 1 + ⟨0,1⟩ := DiamondNoChordProof.hpcoordsAt386 w z r hr' + have hpends : p = x ∨ p = y := by + have hcoord := hpcoords hr + rcases hor with ⟨hx', hy'⟩ | ⟨hy', hx'⟩ + · rcases hcoord with h | h + · exact Or.inr (h.trans hy'.symm) + · exact Or.inl (h.trans hx'.symm) + · rcases hcoord with h | h + · exact Or.inl (h.trans hx'.symm) + · exact Or.inr (h.trans hy'.symm) + have hnot := hstar p hpends (by + have hcalc : p - w = r := by dsimp [p]; abel + simpa [hcalc] using hstarR) + rcases hpends with hp | hp + · exact hnot (by simpa [hp] using hx) + · exact hnot (by simpa [hp] using hy) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2EdgeInterior.lean b/LeanPool/ApollonianSuperharmonic/P4456T2EdgeInterior.lean new file mode 100644 index 0000000000..4e6104db1d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4456T2EdgeInterior.lean @@ -0,0 +1,352 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells +public import LeanPool.ApollonianSuperharmonic.OpenLatticeEdge +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: P4456T2EdgeInterior] + +/-! +# P4456T2EdgeInterior + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace EdgeInteriorProof + +private theorem hu : + ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), ∀ (w : GaussianInt), ((x = z + + (1 : GaussianInt) ∧ y = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = z + (1 : + GaussianInt) ∧ x = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∧ w = z + (1 : + GaussianInt) ∨ (x = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ y = z + ⟨(0 : ℤ), (1 : + ℤ)⟩ ∨ y = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ x = z + ⟨(0 : ℤ), (1 : ℤ)⟩) ∧ w = + z + ⟨(0 : ℤ), (1 : ℤ)⟩) → + ∀ U : ProtoTile, + (({x, y} : Finset GaussianInt) ∈ FootprintEdges U ↔ z ∈ U.cells ∨ w ∈ U.cells) ∧ + (z ∈ U.cells ∧ w ∈ U.cells → + OpenLatticeEdge x y ⊆ interior (TileRealization U)) := by + intro x y z w hform U + have h := P4397T1UnitEdgeCells.2 x y z w hform U + exact ⟨h.1, h.2.2.2.1⟩ + +private theorem hbase : + ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ≠ b) → (∀ (z : GaussianInt), ∀ (w : + GaussianInt), (z = a ∨ w = a) → ((z = b ∨ w = b) → ((a = z ∧ b = w) ∨ (a = w ∧ b = z)))) + := by + classical + intro a b hab z w ha' hb' + rcases ha' with haz | haw <;> rcases hb' with hbz | hbw + · exact False.elim (hab (haz.symm.trans hbz)) + · exact Or.inl ⟨haz.symm, hbw.symm⟩ + · exact Or.inr ⟨haw.symm, hbz.symm⟩ + · exact False.elim (hab (haw.symm.trans hbw)) + +private theorem edgeSym : + ∀ (u : GaussianInt), ∀ (v : GaussianInt), OpenLatticeEdge u v = OpenLatticeEdge v u := by + classical + intro u v + ext p + constructor <;> rintro ⟨t, ht0, ht1, hp⟩ + · refine ⟨1 - t, by linarith, by linarith, ?_⟩ + rw [hp] + simp [GaussianRealPoint] + constructor <;> ring + · refine ⟨1 - t, by linarith, by linarith, ?_⟩ + rw [hp] + simp [GaussianRealPoint] + constructor <;> ring + +private theorem vertical : + ∀ (T : ProtoTile), ∀ (q : GaussianInt), (OpenLatticeEdge (q + 1) (q + 1 + ⟨0, 1⟩) ⊆ + interior (TileRealization T)) → (q ∈ T.cells ∧ q + 1 ∈ T.cells) := by + classical + intro T q he + let m : ℝ × ℝ := ((q.re : ℝ) + 1, (q.im : ℝ) + 1/2) + have hm : m ∈ OpenLatticeEdge (q + 1) (q + 1 + ⟨0, 1⟩) := by + change ∃ t : ℝ, 0 < t ∧ t < 1 ∧ + m = (1-t) • GaussianRealPoint (q+1) + t • GaussianRealPoint (q+1+⟨0,1⟩) + refine ⟨1/2, by norm_num, by norm_num, ?_⟩ + simp [m, GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, Int.cast_add, Int.cast_one] + constructor <;> ring + have hmI : m ∈ interior (TileRealization T) := he hm + obtain ⟨r, hr, hball⟩ := (Metric.isOpen_iff.mp isOpen_interior) m hmI + let ε := min (r/2) (1/4 : ℝ) + have hε : 0 < ε := by dsimp [ε]; exact lt_min (by linarith) (by norm_num) + have hεhalf : ε < 1/2 := by + dsimp [ε] + exact lt_of_le_of_lt (min_le_right _ _) (by norm_num) + have hεr : ε < r := by + dsimp [ε] + exact lt_of_le_of_lt (min_le_left _ _) (by linarith) + let pL : ℝ × ℝ := ((q.re : ℝ)+1-ε, (q.im : ℝ)+1/2) + let pR : ℝ × ℝ := ((q.re : ℝ)+1+ε, (q.im : ℝ)+1/2) + have hLball : pL ∈ Metric.ball m r := by + rw [Metric.mem_ball, Prod.dist_eq] + simp? [pL, m, Real.dist_eq, abs_of_pos hε] + exact ⟨hεr, hr⟩ + have hRball : pR ∈ Metric.ball m r := by + rw [Metric.mem_ball, Prod.dist_eq] + simp? [pR, m, Real.dist_eq, abs_of_pos hε] + exact ⟨hεr, hr⟩ + have hpL : pL ∈ TileRealization T := interior_subset (hball hLball) + have hpR : pR ∈ TileRealization T := interior_subset (hball hRball) + have getCell (p : ℝ × ℝ) (hp : p ∈ TileRealization T) : + ∃ c ∈ T.cells, p ∈ ClosedSquareRealization c := by + change p ∈ ⋃ c ∈ T.cells, ClosedSquareRealization c at hp + rcases Set.mem_iUnion.mp hp with ⟨c, hc⟩ + rcases Set.mem_iUnion.mp hc with ⟨hc, hp⟩ + exact ⟨c, hc, hp⟩ + obtain ⟨cL, hcL, hsqL⟩ := getCell pL hpL + obtain ⟨cR, hcR, hsqR⟩ := getCell pR hpR + have hsL : pL ∈ ClosedSquareRealization cL := hsqL + have hsR : pR ∈ ClosedSquareRealization cR := hsqR + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hsL hsR + have hleftre : cL.re = q.re := by + by_contra hne + have hne' : cL.re ≠ q.re := by omega + rcases lt_or_gt_of_ne hne' with hlt | hgt + · have hcast : (cL.re : ℝ) + 1 ≤ (q.re : ℝ) := by + exact_mod_cast (Int.add_one_le_iff.mpr hlt) + dsimp [pL] at hsL + linarith + · have hcast : (q.re : ℝ) + 1 ≤ (cL.re : ℝ) := by + exact_mod_cast (Int.add_one_le_iff.mpr hgt) + dsimp [pL] at hsL + linarith + have hleftim : cL.im = q.im := by + by_contra hne + have hne' : cL.im ≠ q.im := by omega + rcases lt_or_gt_of_ne hne' with hlt | hgt + · have hcast : (cL.im : ℝ) + 1 ≤ (q.im : ℝ) := by + exact_mod_cast (Int.add_one_le_iff.mpr hlt) + dsimp [pL] at hsL + linarith + · have hcast : (q.im : ℝ) + 1 ≤ (cL.im : ℝ) := by + exact_mod_cast (Int.add_one_le_iff.mpr hgt) + dsimp [pL] at hsL + linarith + have hleft : cL = q := by ext <;> assumption + have hrightre : cR.re = q.re + 1 := by + by_contra hne + have hne' : cR.re ≠ q.re + 1 := by omega + rcases lt_or_gt_of_ne hne' with hlt | hgt + · have hcast : (cR.re : ℝ) + 1 ≤ (q.re : ℝ) + 1 := by + exact_mod_cast (Int.add_one_le_iff.mpr hlt) + dsimp [pR] at hsR + linarith [hsR.2.1] + · have hcast : (q.re : ℝ) + 2 ≤ (cR.re : ℝ) := by + have hInt : q.re + 2 ≤ cR.re := by omega + exact_mod_cast hInt + dsimp [pR] at hsR + linarith [hsR.1.1, hεhalf] + have hrightim : cR.im = q.im := by + by_contra hne + have hne' : cR.im ≠ q.im := by omega + rcases lt_or_gt_of_ne hne' with hlt | hgt + · have hcast : (cR.im : ℝ) + 1 ≤ (q.im : ℝ) := by + exact_mod_cast (Int.add_one_le_iff.mpr hlt) + dsimp [pR] at hsR + linarith [hsR.2.2] + · have hcast : (q.im : ℝ) + 1 ≤ (cR.im : ℝ) := by + exact_mod_cast (Int.add_one_le_iff.mpr hgt) + dsimp [pR] at hsR + linarith [hsR.1.2] + have hright : cR = q + 1 := by + ext + · simpa using hrightre + · simpa using hrightim + constructor + · rw [hleft] at hcL + exact hcL + · rw [hright] at hcR + exact hcR + +private theorem horizontal : + ∀ (T : ProtoTile), ∀ (q : GaussianInt), (OpenLatticeEdge (q + 1 + ⟨0, 1⟩) (q + ⟨0, 1⟩) ⊆ + interior (TileRealization T)) → (q ∈ T.cells ∧ q + ⟨0, 1⟩ ∈ T.cells) := by + classical + intro T q he + let m : ℝ × ℝ := ((q.re : ℝ) + 1/2, (q.im : ℝ) + 1) + have hm : m ∈ OpenLatticeEdge (q + 1 + ⟨0, 1⟩) (q + ⟨0, 1⟩) := by + change ∃ t : ℝ, 0 < t ∧ t < 1 ∧ + m = (1-t) • GaussianRealPoint (q+1+⟨0,1⟩) + t • GaussianRealPoint (q+⟨0,1⟩) + refine ⟨1/2, by norm_num, by norm_num, ?_⟩ + simp [m, GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, Int.cast_add, Int.cast_one] + constructor <;> ring + have hmI : m ∈ interior (TileRealization T) := he hm + obtain ⟨r, hr, hball⟩ := (Metric.isOpen_iff.mp isOpen_interior) m hmI + let ε := min (r/2) (1/4 : ℝ) + have hε : 0 < ε := by dsimp [ε]; exact lt_min (by linarith) (by norm_num) + have hεhalf : ε < 1/2 := by + dsimp [ε] + exact lt_of_le_of_lt (min_le_right _ _) (by norm_num) + have hεr : ε < r := by + dsimp [ε] + exact lt_of_le_of_lt (min_le_left _ _) (by linarith) + let pD : ℝ × ℝ := ((q.re : ℝ)+1/2, (q.im : ℝ)+1-ε) + let pU : ℝ × ℝ := ((q.re : ℝ)+1/2, (q.im : ℝ)+1+ε) + have hDball : pD ∈ Metric.ball m r := by + rw [Metric.mem_ball, Prod.dist_eq] + simp? [pD, m, Real.dist_eq, abs_of_pos hε] + exact ⟨hr, hεr⟩ + have hUball : pU ∈ Metric.ball m r := by + rw [Metric.mem_ball, Prod.dist_eq] + simp? [pU, m, Real.dist_eq, abs_of_pos hε] + exact ⟨hr, hεr⟩ + have hpD : pD ∈ TileRealization T := interior_subset (hball hDball) + have hpU : pU ∈ TileRealization T := interior_subset (hball hUball) + have getCell (p : ℝ × ℝ) (hp : p ∈ TileRealization T) : + ∃ c ∈ T.cells, p ∈ ClosedSquareRealization c := by + change p ∈ ⋃ c ∈ T.cells, ClosedSquareRealization c at hp + rcases Set.mem_iUnion.mp hp with ⟨c, hc⟩ + rcases Set.mem_iUnion.mp hc with ⟨hc, hp⟩ + exact ⟨c, hc, hp⟩ + obtain ⟨cD, hcD, hsqD⟩ := getCell pD hpD + obtain ⟨cU, hcU, hsqU⟩ := getCell pU hpU + have hsD : pD ∈ ClosedSquareRealization cD := hsqD + have hsU : pU ∈ ClosedSquareRealization cU := hsqU + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hsD hsU + have hdownre : cD.re = q.re := by + by_contra hne + have hne' : cD.re ≠ q.re := by omega + rcases lt_or_gt_of_ne hne' with hlt | hgt + · have hcast : (cD.re : ℝ) + 1 ≤ (q.re : ℝ) := by + exact_mod_cast (Int.add_one_le_iff.mpr hlt) + dsimp [pD] at hsD + linarith + · have hcast : (q.re : ℝ) + 1 ≤ (cD.re : ℝ) := by + exact_mod_cast (Int.add_one_le_iff.mpr hgt) + dsimp [pD] at hsD + linarith + have hdownim : cD.im = q.im := by + by_contra hne + have hne' : cD.im ≠ q.im := by omega + rcases lt_or_gt_of_ne hne' with hlt | hgt + · have hcast : (cD.im : ℝ) + 1 ≤ (q.im : ℝ) := by + exact_mod_cast (Int.add_one_le_iff.mpr hlt) + dsimp [pD] at hsD + linarith + · have hcast : (q.im : ℝ) + 1 ≤ (cD.im : ℝ) := by + exact_mod_cast (Int.add_one_le_iff.mpr hgt) + dsimp [pD] at hsD + linarith + have hdown : cD = q := by ext <;> assumption + have hupre : cU.re = q.re := by + by_contra hne + have hne' : cU.re ≠ q.re := by omega + rcases lt_or_gt_of_ne hne' with hlt | hgt + · have hcast : (cU.re : ℝ) + 1 ≤ (q.re : ℝ) := by + exact_mod_cast (Int.add_one_le_iff.mpr hlt) + dsimp [pU] at hsU + linarith [hsU.2.1] + · have hcast : (q.re : ℝ) + 1 ≤ (cU.re : ℝ) := by + exact_mod_cast (Int.add_one_le_iff.mpr hgt) + dsimp [pU] at hsU + linarith [hsU.1.1, hεhalf] + have hupim : cU.im = q.im + 1 := by + by_contra hne + have hne' : cU.im ≠ q.im + 1 := by omega + rcases lt_or_gt_of_ne hne' with hlt | hgt + · have hcast : (cU.im : ℝ) + 1 ≤ (q.im : ℝ) + 1 := by + exact_mod_cast (Int.add_one_le_iff.mpr hlt) + dsimp [pU] at hsU + linarith [hsU.2.2] + · have hcast : (q.im : ℝ) + 2 ≤ (cU.im : ℝ) := by + have hInt : q.im + 2 ≤ cU.im := by omega + exact_mod_cast hInt + dsimp [pU] at hsU + linarith [hsU.1.2, hεhalf] + have hup : cU = q + ⟨0, 1⟩ := by + ext + · simpa using hupre + · simpa using hupim + constructor + · rw [hdown] at hcD + exact hcD + · rw [hup] at hcU + exact hcU + +end EdgeInteriorProof + +theorem P4456T2EdgeInterior (T : ProtoTile) (x y a b : GaussianInt) + (hxy : FourNeighborAdjacent x y) (hab : a ≠ b) + (ha : ({x, y} : Finset GaussianInt) ∈ FootprintEdges ⟨{a}, a⟩) + (hb : ({x, y} : Finset GaussianInt) ∈ FootprintEdges ⟨{b}, b⟩) : + OpenLatticeEdge x y ⊆ interior (TileRealization T) ↔ + a ∈ T.cells ∧ b ∈ T.cells := by +-- BODY + classical + obtain ⟨z, w, hform⟩ := (P4397T1UnitEdgeCells.1 x y hxy) + have hu := EdgeInteriorProof.hu x y z w hform + have ha' : z ∈ (⟨{a}, a⟩ : ProtoTile).cells ∨ w ∈ (⟨{a}, a⟩ : ProtoTile).cells := + (hu (⟨{a}, a⟩ : ProtoTile)).1.mp ha + have hb' : z ∈ (⟨{b}, b⟩ : ProtoTile).cells ∨ w ∈ (⟨{b}, b⟩ : ProtoTile).cells := + (hu (⟨{b}, b⟩ : ProtoTile)).1.mp hb + simp only [Finset.mem_singleton] at ha' hb' + have hbase : (a = z ∧ b = w) ∨ (a = w ∧ b = z) := EdgeInteriorProof.hbase a b hab z w ha' hb' + have edgeSym (u v : GaussianInt) : OpenLatticeEdge u v = OpenLatticeEdge v u := + EdgeInteriorProof.edgeSym u v + constructor + · intro he + have hocc : z ∈ T.cells ∧ w ∈ T.cells := by + rcases hform with ⟨hcase, hw⟩ | ⟨hcase, hw⟩ + · subst w + rcases hcase with ⟨hx, hy⟩ | ⟨hy, hx⟩ + · subst x; subst y + exact EdgeInteriorProof.vertical T z he + · subst x; subst y + have hs : OpenLatticeEdge (z + 1) (z + 1 + ⟨0, 1⟩) = + OpenLatticeEdge (z + 1 + ⟨0, 1⟩) (z + 1) := edgeSym _ _ + rw [← hs] at he + exact EdgeInteriorProof.vertical T z he + · subst w + rcases hcase with ⟨hx, hy⟩ | ⟨hy, hx⟩ + · subst x; subst y + exact EdgeInteriorProof.horizontal T z he + · subst x; subst y + have hs : OpenLatticeEdge (z + 1 + ⟨0, 1⟩) (z + ⟨0, 1⟩) = + OpenLatticeEdge (z + ⟨0, 1⟩) (z + 1 + ⟨0, 1⟩) := edgeSym _ _ + rw [← hs] at he + exact EdgeInteriorProof.horizontal T z he + rcases hbase with ⟨haEq, hbEq⟩ | ⟨haEq, hbEq⟩ + · simpa [haEq, hbEq] using hocc + · simpa [haEq, hbEq] using ⟨hocc.2, hocc.1⟩ + · rintro ⟨haz, haw⟩ + rcases hform with ⟨hcase, hw⟩ | ⟨hcase, hw⟩ + · subst w + have hboth : z ∈ T.cells ∧ z + 1 ∈ T.cells := by + rcases hbase with ⟨haEq, hbEq⟩ | ⟨haEq, hbEq⟩ + · subst a; subst b; exact ⟨haz, haw⟩ + · subst a; subst b; exact ⟨haw, haz⟩ + rcases hcase with ⟨hxy₁, hxy₂⟩ | ⟨hxy₁, hxy₂⟩ + · subst x y + exact (hu T).2 hboth + · subst x y + exact (hu T).2 hboth + · subst w + have hboth : z ∈ T.cells ∧ z + ⟨0, 1⟩ ∈ T.cells := by + rcases hbase with ⟨haEq, hbEq⟩ | ⟨haEq, hbEq⟩ + · subst a; subst b; exact ⟨haz, haw⟩ + · subst a; subst b; exact ⟨haw, haz⟩ + rcases hcase with ⟨hxy₁, hxy₂⟩ | ⟨hxy₁, hxy₂⟩ + · subst x y + exact (hu T).2 hboth + · subst x y + exact (hu T).2 hboth + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean b/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean new file mode 100644 index 0000000000..449e2cf7f8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean @@ -0,0 +1,600 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4456T2BandGraphTriangle +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.P4456T2EdgeInterior +public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected + +-- [TABLET NODE: P4456T2MissingEdge] + +/-! +# P4456T2MissingEdge + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace MissingEdgeGeometry + +private theorem hzero : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), (BandPrototile + (q (0 : Fin (4 : ℕ))) T) → ((∀ (u : ↥(TilingLattice C)), ∀ (x : LatticeCell), ∀ (y : + LatticeCell), FourNeighborAdjacent x y → x ∈ BoundaryFootprintVertices + (TileTranslation T (↑u : GaussianInt)) → y ∈ BoundaryFootprintVertices + (TileTranslation T (↑u : GaussianInt)) → ¬OpenLatticeEdge x y ⊆ interior + (TileRealization (TileTranslation T (↑u : GaussianInt)))) → (∀ (P : + PeriodicTileComplex ↥(TilingLattice C)), (∀ (u : ↥(TilingLattice C)), P.tile u = + TileTranslation T (↑u : GaussianInt)) → ((AffineTriangularComplexChart P fun (mn : ℤ + × ℤ) => TileTranslation T ((↑mn.1 : GaussianInt) * BandVectors.1 (q (1 : Fin (4 : + ℕ))) (q (0 : Fin (4 : ℕ))) + (↑mn.2 : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : + ℕ))) (q (0 : Fin (4 : ℕ))))) → (∀ (x : GaussianInt), (x ∈ FootprintVertices T) → (∀ + (y : GaussianInt), (y ∈ FootprintVertices T) → (({x, y} ∉ FootprintEdges T) → (P.tile + 0 = T))))))) ) := by + classical + intro C q T hT hnochord P htile chart x hx y hy hnot + rw [htile 0] + cases T with + | mk cells anchor => + change ProtoTile.mk (cells.image (GaussianTranslation 0)) + (GaussianTranslation 0 anchor) = ProtoTile.mk cells anchor + apply congrArg₂ ProtoTile.mk + · ext c + simp [GaussianTranslation] + · simp [GaussianTranslation] + +private theorem hzwT : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), ∀ (w : + GaussianInt), (∀ (U : ProtoTile), ({x, y} ∈ FootprintEdges U ↔ z ∈ U.cells ∨ w ∈ + U.cells) ∧ ({x, y} ∈ BoundaryFootprintEdges U ↔ z ∈ U.cells ∧ w ∉ U.cells ∨ z ∉ + U.cells ∧ w ∈ U.cells) ∧ (z ∈ U.cells ∨ w ∈ U.cells → x ∈ FootprintVertices U ∧ y ∈ + FootprintVertices U ∧ ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (((1 : ℝ) - (↑t : + ℝ)) * (↑x.re : ℝ) + (↑t : ℝ) * (↑y.re : ℝ), ((1 : ℝ) - (↑t : ℝ)) * (↑x.im : ℝ) + (↑t + : ℝ) * (↑y.im : ℝ)) ∈ TileRealization U) ∧ (z ∈ U.cells ∧ w ∈ U.cells → + OpenLatticeEdge x y ⊆ interior (TileRealization U)) ∧ ((∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ U.cells) → z ∈ U.cells ∧ w ∈ U.cells)) → ((({x, y} : + Finset GaussianInt) ∉ FootprintEdges T) → (z ∉ T.cells ∧ w ∉ T.cells)) ) := by + classical + intro T x y z w hedgeFacts hedgeT + have hh : ¬ (z ∈ T.cells ∨ w ∈ T.cells) := fun h => + hedgeT ((hedgeFacts T).1.mpr h) + exact not_or.mp hh + +private theorem ha0 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + (P.tile 0 = T) → (∀ (z : GaussianInt), ∀ (w : GaussianInt), (z ∉ T.cells ∧ w ∉ + T.cells) → (∀ (a : ↥(TilingLattice C)), (z ∈ (P.tile a).cells) → ((∀ (y : + ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => z ∈ (P.tile a).cells) y → y = + a) → (a ≠ 0)))) ) := by + classical + intro C T P hzero z w hzwT a ha hauniq heq + subst a + exact hzwT.1 (by simpa [hzero] using ha) + +private theorem hb0 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + (P.tile 0 = T) → (∀ (z : GaussianInt), ∀ (w : GaussianInt), (z ∉ T.cells ∧ w ∉ + T.cells) → (∀ (b : ↥(TilingLattice C)), (w ∈ (P.tile b).cells) → ((∀ (y : + ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => w ∈ (P.tile a).cells) y → y = + b) → (b ≠ 0)))) ) := by + classical + intro C T P hzero z w hzwT b hb hbuniq heq + subst b + exact hzwT.2 (by simpa [hzero] using hb) + +private theorem incident_of_footprint : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (v : GaussianInt), (U.cells.Nonempty) → ((v ∈ FootprintVertices U) → + (∃ j : Fin 4, LatticeVertexIncidentCell v j ∈ U.cells)) ) := by + classical + intro U v hne hv + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hv + rcases hv with ⟨c, hc, hcase⟩ + rcases hcase with hcase | hcase | hcase | hcase + · exact ⟨0, by simpa [LatticeVertexIncidentCell, hcase] using hc⟩ + · subst v + exact ⟨1, by simpa [LatticeVertexIncidentCell, sub_eq_add_neg] using hc⟩ + · subst v + exact ⟨3, by simpa [LatticeVertexIncidentCell, sub_eq_add_neg] using hc⟩ + · subst v + exact ⟨2, by simpa [LatticeVertexIncidentCell, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hc⟩ + +private theorem hTne : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (T : + ProtoTile), (BandPrototile (q (0 : Fin (4 : ℕ))) T) → (((1 : ℤ) < (q (0 : Fin (4 : + ℕ))).1) → ((PeriodicTileComplex ↥(TilingLattice C)) → (T.cells.Nonempty)))) ) := by + classical + intro C q hq T hT hlarge P + have harea := (BandTileSimultaneousInduction q hq T hT).2.1 + rw [Finset.nonempty_iff_ne_empty] + intro he + have hzeroarea : TileArea T = 0 := by simp [TileArea, he] + rw [harea] at hzeroarea + have hpos : 0 < Int.toNat (q 0).1 := by omega + omega + +private theorem hmissT : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ + (x : GaussianInt), (x ∈ FootprintVertices T) → (∀ (y : GaussianInt), (y ∈ + FootprintVertices T) → ((FourNeighborAdjacent x y) → (({x, y} ∉ FootprintEdges T) → + (∀ (z : GaussianInt), ∀ (w : GaussianInt), ((x = z + (1 : GaussianInt) ∧ y = z + (1 : + GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = z + (1 : GaussianInt) ∧ x = z + + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∧ w = z + (1 : GaussianInt) + ∨ (x = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∧ y = z + (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∧ x = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∧ w = z + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt)) → ((∀ (U : ProtoTile), ({x, y} ∈ FootprintEdges U ↔ z ∈ U.cells ∨ + w ∈ U.cells) ∧ ({x, y} ∈ BoundaryFootprintEdges U ↔ z ∈ U.cells ∧ w ∉ U.cells ∨ z ∉ + U.cells ∧ w ∈ U.cells) ∧ (z ∈ U.cells ∨ w ∈ U.cells → x ∈ FootprintVertices U ∧ y ∈ + FootprintVertices U ∧ ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (((1 : ℝ) - (↑t : + ℝ)) * (↑x.re : ℝ) + (↑t : ℝ) * (↑y.re : ℝ), ((1 : ℝ) - (↑t : ℝ)) * (↑x.im : ℝ) + (↑t + : ℝ) * (↑y.im : ℝ)) ∈ TileRealization U) ∧ (z ∈ U.cells ∧ w ∈ U.cells → + OpenLatticeEdge x y ⊆ interior (TileRealization U)) ∧ ((∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ U.cells) → z ∈ U.cells ∧ w ∈ U.cells)) → ((({x, y} : + Finset GaussianInt) ∉ FootprintEdges T) → ((z ∉ T.cells ∧ w ∉ T.cells) → (∀ (a : + ↥(TilingLattice C)), ∀ (b : ↥(TilingLattice C)), (x ∈ FootprintVertices (P.tile a)) → + ((y ∈ FootprintVertices (P.tile a)) → ((x ∈ FootprintVertices (P.tile b)) → ((y ∈ + FootprintVertices (P.tile b)) → (∀ (v : GaussianInt), (v = x ∨ v = y) → (∃ j : Fin 4, + LatticeVertexIncidentCell v j ∉ T.cells))))))))))))) ) := by + classical + intro C T P x hx y hy hxy hnot z w hform hedgeFacts hedgeT hzwT a b hxa hya hxb hyb v hv + rcases hform with ⟨hor, hw⟩ | ⟨hor, hw⟩ + · rcases hor with ⟨hx0, hy0⟩ | ⟨hy0, hx0⟩ + · rcases hv with rfl | rfl + · refine ⟨1, ?_⟩ + simpa [LatticeVertexIncidentCell, hx0, sub_eq_add_neg] using hzwT.1 + · refine ⟨2, ?_⟩ + simpa [LatticeVertexIncidentCell, hy0, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hzwT.1 + · rcases hv with rfl | rfl + · refine ⟨2, ?_⟩ + simpa [LatticeVertexIncidentCell, hx0, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hzwT.1 + · refine ⟨1, ?_⟩ + simpa [LatticeVertexIncidentCell, hy0, sub_eq_add_neg] using hzwT.1 + · rcases hor with ⟨hx0, hy0⟩ | ⟨hy0, hx0⟩ + · rcases hv with rfl | rfl + · refine ⟨1, ?_⟩ + simpa [LatticeVertexIncidentCell, hx0, hw, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hzwT.2 + · refine ⟨0, ?_⟩ + simpa [LatticeVertexIncidentCell, hy0, hw] using hzwT.2 + · rcases hv with rfl | rfl + · refine ⟨0, ?_⟩ + simpa [LatticeVertexIncidentCell, hx0, hw] using hzwT.2 + · refine ⟨1, ?_⟩ + simpa [LatticeVertexIncidentCell, hy0, hx0, hw, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hzwT.2 + +private theorem hmissingA : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + (P.tile 0 = T) → ((∀ (x : LatticeCell), ∃! a : ↥(TilingLattice C), x ∈ (P.tile + a).cells) → (∀ (a : ↥(TilingLattice C)), (a ≠ 0) → ((∀ (U : ProtoTile), ∀ (v : + GaussianInt), (U.cells.Nonempty) → ((v ∈ FootprintVertices U) → (∃ j : Fin 4, + LatticeVertexIncidentCell v j ∈ U.cells))) → ((T.cells.Nonempty) → (∀ (v : + GaussianInt), (v ∈ FootprintVertices T) → (∃ j : Fin 4, LatticeVertexIncidentCell v j + ∉ (P.tile a).cells)))))) ) := by + classical + intro C T P hzero hindexed a ha0 incident_of_footprint hTne v hv + obtain ⟨j, hj⟩ := incident_of_footprint T v hTne hv + refine ⟨j, ?_⟩ + intro hja + have hzeroCell : LatticeVertexIncidentCell v j ∈ (P.tile 0).cells := by + simpa [hzero] using hj + have heq := (hindexed (LatticeVertexIncidentCell v j)).unique hzeroCell hja + exact ha0 heq.symm + +private theorem hmissingB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + (P.tile 0 = T) → ((∀ (x : LatticeCell), ∃! a : ↥(TilingLattice C), x ∈ (P.tile + a).cells) → (∀ (b : ↥(TilingLattice C)), (b ≠ 0) → ((∀ (U : ProtoTile), ∀ (v : + GaussianInt), (U.cells.Nonempty) → ((v ∈ FootprintVertices U) → (∃ j : Fin 4, + LatticeVertexIncidentCell v j ∈ U.cells))) → ((T.cells.Nonempty) → (∀ (v : + GaussianInt), (v ∈ FootprintVertices T) → (∃ j : Fin 4, LatticeVertexIncidentCell v j + ∉ (P.tile b).cells)))))) ) := by + classical + intro C T P hzero hindexed b hb0 incident_of_footprint hTne v hv + obtain ⟨j, hj⟩ := incident_of_footprint T v hTne hv + refine ⟨j, ?_⟩ + intro hjb + have hzeroCell : LatticeVertexIncidentCell v j ∈ (P.tile 0).cells := by + simpa [hzero] using hj + have heq := (hindexed (LatticeVertexIncidentCell v j)).unique hzeroCell hjb + exact hb0 heq.symm + +private theorem hneqxy : + (by + classical + exact + ∀ (C : BandCircle), (Fin 4 → CircleCoordinates) → (∀ (T : ProtoTile), ∀ (P : + PeriodicTileComplex ↥(TilingLattice C)), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (y + ∈ FootprintVertices T) → ((FourNeighborAdjacent x y) → (({x, y} ∉ FootprintEdges T) → + (∀ (z : GaussianInt), ∀ (w : GaussianInt), ((x = z + (1 : GaussianInt) ∧ y = z + (1 : + GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = z + (1 : GaussianInt) ∧ x = z + + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∧ w = z + (1 : GaussianInt) + ∨ (x = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∧ y = z + (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∧ x = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∧ w = z + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt)) → ((∀ (U : ProtoTile), ({x, y} ∈ FootprintEdges U ↔ z ∈ U.cells ∨ + w ∈ U.cells) ∧ ({x, y} ∈ BoundaryFootprintEdges U ↔ z ∈ U.cells ∧ w ∉ U.cells ∨ z ∉ + U.cells ∧ w ∈ U.cells) ∧ (z ∈ U.cells ∨ w ∈ U.cells → x ∈ FootprintVertices U ∧ y ∈ + FootprintVertices U ∧ ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (((1 : ℝ) - (↑t : + ℝ)) * (↑x.re : ℝ) + (↑t : ℝ) * (↑y.re : ℝ), ((1 : ℝ) - (↑t : ℝ)) * (↑x.im : ℝ) + (↑t + : ℝ) * (↑y.im : ℝ)) ∈ TileRealization U) ∧ (z ∈ U.cells ∧ w ∈ U.cells → + OpenLatticeEdge x y ⊆ interior (TileRealization U)) ∧ ((∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ U.cells) → z ∈ U.cells ∧ w ∈ U.cells)) → ((({x, y} : + Finset GaussianInt) ∉ FootprintEdges T) → (∀ (a : ↥(TilingLattice C)), ∀ (b : + ↥(TilingLattice C)), (y ∈ FootprintVertices (P.tile a)) → ((y ∈ FootprintVertices + (P.tile b)) → ((∀ (v : GaussianInt), (v = x ∨ v = y) → (∃ j : Fin 4, + LatticeVertexIncidentCell v j ∉ T.cells)) → ((y ∈ BoundaryFootprintVertices (P.tile + a)) → ((y ∈ BoundaryFootprintVertices (P.tile b)) → (x ≠ y)))))))))))) ) := by + classical + intro C q T P x y hy hxy hnot z w hform hedgeFacts hedgeT a b hya hyb hmissT hboundA_y + hboundB_y hxy' + subst y + simp only [FourNeighborAdjacent] at hxy + rcases hxy with h | h | h | h + · have hr := congrArg Zsqrtd.re h + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr + omega + · have hr := congrArg Zsqrtd.re h + simp only [Zsqrtd.re_sub, Zsqrtd.re_one] at hr + omega + · have hi := congrArg Zsqrtd.im h + simp only [Zsqrtd.im_add] at hi + omega + · have hi := congrArg Zsqrtd.im h + simp only [Zsqrtd.im_sub] at hi + omega + +private theorem habEdge : + (by + classical + exact + ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (x : GaussianInt), + ∀ (y : GaussianInt), ∀ (z : GaussianInt), ∀ (w : GaussianInt), (∀ (U : ProtoTile), + ({x, y} ∈ FootprintEdges U ↔ z ∈ U.cells ∨ w ∈ U.cells) ∧ ({x, y} ∈ + BoundaryFootprintEdges U ↔ z ∈ U.cells ∧ w ∉ U.cells ∨ z ∉ U.cells ∧ w ∈ U.cells) ∧ + (z ∈ U.cells ∨ w ∈ U.cells → x ∈ FootprintVertices U ∧ y ∈ FootprintVertices U ∧ ∀ (t + : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (((1 : ℝ) - (↑t : ℝ)) * (↑x.re : ℝ) + (↑t : + ℝ) * (↑y.re : ℝ), ((1 : ℝ) - (↑t : ℝ)) * (↑x.im : ℝ) + (↑t : ℝ) * (↑y.im : ℝ)) ∈ + TileRealization U) ∧ (z ∈ U.cells ∧ w ∈ U.cells → OpenLatticeEdge x y ⊆ interior + (TileRealization U)) ∧ ((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ + U.cells) → z ∈ U.cells ∧ w ∈ U.cells)) → (∀ (a : ↥(TilingLattice C)), ∀ (b : + ↥(TilingLattice C)), (z ∈ (P.tile a).cells) → ((w ∈ (P.tile b).cells) → + ((FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty))) ) := by + classical + intro C P x y z w hedgeFacts a b hza hwb + refine ⟨{x, y}, ?_⟩ + constructor + · exact (hedgeFacts (P.tile a)).1.mpr (Or.inl hza) + · exact (hedgeFacts (P.tile b)).1.mpr (Or.inr hwb) + +private theorem hzeroaEdge : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ + (x : GaussianInt), (x ∈ FootprintVertices T) → (∀ (y : GaussianInt), (y ∈ + FootprintVertices T) → ((P.tile 0 = T) → (∀ (a : ↥(TilingLattice C)), (a ≠ 0) → ((x ∈ + FootprintVertices (P.tile a)) → ((y ∈ FootprintVertices (P.tile a)) → ((x ≠ y) → ((∀ + (a : ↥(TilingLattice C)), ∀ (b : ↥(TilingLattice C)), a ≠ b → ((FootprintEdges + (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty ↔ P.plane.adjacent a b) ∧ + ((FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty → SimpleGridPath + (CommonFootprintEdgeVertices (P.tile a) (P.tile b)) (FootprintEdges (P.tile a) ∩ + FootprintEdges (P.tile b)) ∧ FootprintVertices (P.tile a) ∩ FootprintVertices (P.tile + b) = CommonFootprintEdgeVertices (P.tile a) (P.tile b)) ∧ (¬(FootprintEdges (P.tile + a) ∩ FootprintEdges (P.tile b)).Nonempty → FootprintVertices (P.tile a) ∩ + FootprintVertices (P.tile b) = ∅ ∨ (FootprintVertices (P.tile a) ∩ FootprintVertices + (P.tile b)).Subsingleton)) → ((FootprintEdges (P.tile 0) ∩ FootprintEdges (P.tile + a)).Nonempty)))))))) ) := by + classical + intro C T P x hx y hy hzero a ha0 hxa hya hneqxy hclass + by_contra hn + have hsmall := (hclass 0 a (Ne.symm ha0)).2.2 hn + rcases hsmall with hempty | hsub + · have hxI : x ∈ FootprintVertices (P.tile 0) ∩ FootprintVertices (P.tile a) := + ⟨by simpa [hzero] using hx, hxa⟩ + simp [hempty] at hxI + · have hxI : x ∈ FootprintVertices (P.tile 0) ∩ FootprintVertices (P.tile a) := + ⟨by simpa [hzero] using hx, hxa⟩ + have hyI : y ∈ FootprintVertices (P.tile 0) ∩ FootprintVertices (P.tile a) := + ⟨by simpa [hzero] using hy, hya⟩ + exact hneqxy (hsub hxI hyI) + +private theorem hzerobEdge : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ + (x : GaussianInt), (x ∈ FootprintVertices T) → (∀ (y : GaussianInt), (y ∈ + FootprintVertices T) → ((P.tile 0 = T) → (∀ (b : ↥(TilingLattice C)), (b ≠ 0) → ((x ∈ + FootprintVertices (P.tile b)) → ((y ∈ FootprintVertices (P.tile b)) → ((x ≠ y) → ((∀ + (a : ↥(TilingLattice C)), ∀ (b : ↥(TilingLattice C)), a ≠ b → ((FootprintEdges + (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty ↔ P.plane.adjacent a b) ∧ + ((FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty → SimpleGridPath + (CommonFootprintEdgeVertices (P.tile a) (P.tile b)) (FootprintEdges (P.tile a) ∩ + FootprintEdges (P.tile b)) ∧ FootprintVertices (P.tile a) ∩ FootprintVertices (P.tile + b) = CommonFootprintEdgeVertices (P.tile a) (P.tile b)) ∧ (¬(FootprintEdges (P.tile + a) ∩ FootprintEdges (P.tile b)).Nonempty → FootprintVertices (P.tile a) ∩ + FootprintVertices (P.tile b) = ∅ ∨ (FootprintVertices (P.tile a) ∩ FootprintVertices + (P.tile b)).Subsingleton)) → ((FootprintEdges (P.tile 0) ∩ FootprintEdges (P.tile + b)).Nonempty)))))))) ) := by + classical + intro C T P x hx y hy hzero b hb0 hxb hyb hneqxy hclass + by_contra hn + have hsmall := (hclass 0 b (Ne.symm hb0)).2.2 hn + rcases hsmall with hempty | hsub + · have hxI : x ∈ FootprintVertices (P.tile 0) ∩ FootprintVertices (P.tile b) := + ⟨by simpa [hzero] using hx, hxb⟩ + simp [hempty] at hxI + · have hxI : x ∈ FootprintVertices (P.tile 0) ∩ FootprintVertices (P.tile b) := + ⟨by simpa [hzero] using hx, hxb⟩ + have hyI : y ∈ FootprintVertices (P.tile 0) ∩ FootprintVertices (P.tile b) := + ⟨by simpa [hzero] using hy, hyb⟩ + exact hneqxy (hsub hxI hyI) + +private theorem habneq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), (∀ (u : ↥(TilingLattice C)), ∀ (x : LatticeCell), + ∀ (y : LatticeCell), FourNeighborAdjacent x y → x ∈ BoundaryFootprintVertices + (TileTranslation T (↑u : GaussianInt)) → y ∈ BoundaryFootprintVertices + (TileTranslation T (↑u : GaussianInt)) → ¬OpenLatticeEdge x y ⊆ interior + (TileRealization (TileTranslation T (↑u : GaussianInt)))) → (∀ (P : + PeriodicTileComplex ↥(TilingLattice C)), (∀ (u : ↥(TilingLattice C)), P.tile u = + TileTranslation T (↑u : GaussianInt)) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), + (FourNeighborAdjacent x y) → (∀ (z : GaussianInt), ∀ (w : GaussianInt), ((x = z + (1 + : GaussianInt) ∧ y = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = + z + (1 : GaussianInt) ∧ x = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ∧ w = z + (1 : GaussianInt) ∨ (x = z + (1 : GaussianInt) + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt) ∧ y = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = z + (1 : + GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∧ x = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ∧ w = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → ((∀ (U : ProtoTile), + ({x, y} ∈ FootprintEdges U ↔ z ∈ U.cells ∨ w ∈ U.cells) ∧ ({x, y} ∈ + BoundaryFootprintEdges U ↔ z ∈ U.cells ∧ w ∉ U.cells ∨ z ∉ U.cells ∧ w ∈ U.cells) ∧ + (z ∈ U.cells ∨ w ∈ U.cells → x ∈ FootprintVertices U ∧ y ∈ FootprintVertices U ∧ ∀ (t + : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (((1 : ℝ) - (↑t : ℝ)) * (↑x.re : ℝ) + (↑t : + ℝ) * (↑y.re : ℝ), ((1 : ℝ) - (↑t : ℝ)) * (↑x.im : ℝ) + (↑t : ℝ) * (↑y.im : ℝ)) ∈ + TileRealization U) ∧ (z ∈ U.cells ∧ w ∈ U.cells → OpenLatticeEdge x y ⊆ interior + (TileRealization U)) ∧ ((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ + U.cells) → z ∈ U.cells ∧ w ∈ U.cells)) → ((z ∉ T.cells ∧ w ∉ T.cells) → (∀ (a : + ↥(TilingLattice C)), (z ∈ (P.tile a).cells) → (∀ (b : ↥(TilingLattice C)), (w ∈ + (P.tile b).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => w + ∈ (P.tile a).cells) y → y = b) → ((b ≠ 0) → ((w ∈ (P.tile b).cells) → ((x ∈ + FootprintVertices (P.tile b)) → ((y ∈ FootprintVertices (P.tile b)) → (((P.tile + b).cells.Nonempty) → ((∀ (v : GaussianInt), (v ∈ FootprintVertices T) → (∃ j : Fin 4, + LatticeVertexIncidentCell v j ∉ (P.tile b).cells)) → ((x ∈ BoundaryFootprintVertices + (P.tile a)) → ((y ∈ BoundaryFootprintVertices (P.tile a)) → ((x ∈ + BoundaryFootprintVertices (P.tile b)) → ((y ∈ BoundaryFootprintVertices (P.tile b)) → + (((FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty) → + (((FootprintEdges (P.tile 0) ∩ FootprintEdges (P.tile b)).Nonempty) → (a ≠ + b))))))))))))))))))))) ) := by + classical + intro C T hnochord P htile x y hxy z w hform hedgeFacts hzwT a ha b hb hbuniq hb0 hwb hxb hyb + hnonemptyB hmissingB hboundA_x hboundA_y hboundB_x hboundB_y habEdge hzerobEdge heq + subst b + have hboth : z ∈ (P.tile a).cells ∧ w ∈ (P.tile a).cells := ⟨ha, hb⟩ + have hzw : z ≠ w := by + rcases hform with ⟨_, rfl⟩ | ⟨_, rfl⟩ + · intro hh + have hr := congrArg Zsqrtd.re hh + norm_num at hr + · intro hh + have hi := congrArg Zsqrtd.im hh + norm_num at hi + have hsingleZ : ({x, y} : Finset GaussianInt) ∈ + FootprintEdges (⟨{z}, z⟩ : ProtoTile) := by + exact (hedgeFacts (⟨{z}, z⟩ : ProtoTile)).1.mpr (Or.inl (by simp)) + have hsingleW : ({x, y} : Finset GaussianInt) ∈ + FootprintEdges (⟨{w}, w⟩ : ProtoTile) := by + exact (hedgeFacts (⟨{w}, w⟩ : ProtoTile)).1.mpr (Or.inr (by simp)) + have hinside := (P4456T2EdgeInterior (P.tile a) x y z w hxy hzw + hsingleZ hsingleW).2 hboth + have hchord := hnochord a x y hxy + (by simpa [htile] using hboundA_x) + (by simpa [htile] using hboundA_y) + have hinside' : OpenLatticeEdge x y ⊆ + interior (TileRealization (TileTranslation T (a : GaussianInt))) := by + simpa [htile] using hinside + exact hchord hinside' + +private theorem hxcommon : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ + (x : GaussianInt), (x ∈ FootprintVertices T) → (∀ (y : GaussianInt), (P.tile 0 = T) → + (∀ (a : ↥(TilingLattice C)), ∀ (b : ↥(TilingLattice C)), (∀ (U : ProtoTile), ∀ (v : + GaussianInt), (U.cells.Nonempty) → ((v ∈ FootprintVertices U) → (∃ j : Fin 4, + LatticeVertexIncidentCell v j ∈ U.cells))) → ((T.cells.Nonempty) → ((∀ (v : + GaussianInt), (v = x ∨ v = y) → (∃ j : Fin 4, LatticeVertexIncidentCell v j ∉ + T.cells)) → ((x ∈ BoundaryFootprintVertices (P.tile a)) → ((x ∈ + BoundaryFootprintVertices (P.tile b)) → (x ∈ BoundaryFootprintVertices (P.tile 0) ∧ x + ∈ BoundaryFootprintVertices (P.tile a) ∧ x ∈ BoundaryFootprintVertices (P.tile + b)))))))) ) := by + classical + intro C T P x hx y hzero a b incident_of_footprint hTne hmissT hboundA_x hboundB_x + exact ⟨by simpa [hzero] using (P3161T2IncidentBoundary T x + (incident_of_footprint T x hTne hx) (hmissT x (Or.inl rfl))), hboundA_x, hboundB_x⟩ + +private theorem hycommon : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ + (x : GaussianInt), ∀ (y : GaussianInt), (y ∈ FootprintVertices T) → ((P.tile 0 = T) → + (∀ (a : ↥(TilingLattice C)), ∀ (b : ↥(TilingLattice C)), (∀ (U : ProtoTile), ∀ (v : + GaussianInt), (U.cells.Nonempty) → ((v ∈ FootprintVertices U) → (∃ j : Fin 4, + LatticeVertexIncidentCell v j ∈ U.cells))) → ((T.cells.Nonempty) → ((∀ (v : + GaussianInt), (v = x ∨ v = y) → (∃ j : Fin 4, LatticeVertexIncidentCell v j ∉ + T.cells)) → ((y ∈ BoundaryFootprintVertices (P.tile a)) → ((y ∈ + BoundaryFootprintVertices (P.tile b)) → (y ∈ BoundaryFootprintVertices (P.tile 0) ∧ y + ∈ BoundaryFootprintVertices (P.tile a) ∧ y ∈ BoundaryFootprintVertices (P.tile + b)))))))) ) := by + classical + intro C T P x y hy hzero a b incident_of_footprint hTne hmissT hboundA_y hboundB_y + exact ⟨by simpa [hzero] using (P3161T2IncidentBoundary T y + (incident_of_footprint T y hTne hy) (hmissT y (Or.inr rfl))), hboundA_y, hboundB_y⟩ + +end MissingEdgeGeometry + +theorem P4456T2MissingEdge (C : BandCircle) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hqC : q 0 = C.1.1) (T : ProtoTile) (hT : BandPrototile (q 0) T) + (hlarge : 1 < (q 0).1) + (hnochord : ∀ u : TilingLattice C, ∀ x y, + FourNeighborAdjacent x y → + x ∈ BoundaryFootprintVertices (TileTranslation T (u : GaussianInt)) → + y ∈ BoundaryFootprintVertices (TileTranslation T (u : GaussianInt)) → + ¬ OpenLatticeEdge x y ⊆ + interior (TileRealization (TileTranslation T (u : GaussianInt)))) : + ∀ x, x ∈ FootprintVertices T → ∀ y, y ∈ FootprintVertices T → + FourNeighborAdjacent x y → ({x, y} : Finset GaussianInt) ∈ FootprintEdges T := by +-- BODY + obtain ⟨P, hL, htile, hadj, hposition, hvertices, hedges, hfaces, ⟨chart⟩⟩ := + BandRegularTranslatePeriodicComplex C q hq hqC T hT + suffices hlocal : + (∀ a b c, a ≠ b → b ≠ c → c ≠ a → + P.plane.adjacent a b → P.plane.adjacent b c → P.plane.adjacent c a → + TouchingTriple (P.tile a) (P.tile b) (P.tile c)) → + ∀ x, x ∈ FootprintVertices T → ∀ y, y ∈ FootprintVertices T → + FourNeighborAdjacent x y → + ({x, y} : Finset GaussianInt) ∈ FootprintEdges T by + exact hlocal (P4456T2BandGraphTriangle q hq T hT hlarge P chart) + intro htriangles + classical + intro x hx y hy hxy + by_contra hnot + have hzero : P.tile 0 = T := MissingEdgeGeometry.hzero C q T hT hnochord P htile chart x hx y + hy hnot + have hindexed := PeriodicTileIndexedMultiplicityOne P + obtain ⟨z, w, hform⟩ := (P4397T1UnitEdgeCells.1 x y hxy) + have hedgeFacts := P4397T1UnitEdgeCells.2 x y z w hform + have hedgeT : ({x, y} : Finset GaussianInt) ∉ FootprintEdges T := hnot + have hzwT : z ∉ T.cells ∧ w ∉ T.cells := MissingEdgeGeometry.hzwT T x y z w hedgeFacts hedgeT + obtain ⟨a, ha, hauniq⟩ := hindexed z + obtain ⟨b, hb, hbuniq⟩ := hindexed w + have ha0 : a ≠ 0 := MissingEdgeGeometry.ha0 C T P hzero z w hzwT a ha hauniq + have hb0 : b ≠ 0 := MissingEdgeGeometry.hb0 C T P hzero z w hzwT b hb hbuniq + have hza : z ∈ (P.tile a).cells := ha + have hwb : w ∈ (P.tile b).cells := hb + have hxa : x ∈ FootprintVertices (P.tile a) := by + exact ((hedgeFacts (P.tile a)).2.2.1 (Or.inl hza)).1 + have hya : y ∈ FootprintVertices (P.tile a) := by + exact ((hedgeFacts (P.tile a)).2.2.1 (Or.inl hza)).2.1 + have hxb : x ∈ FootprintVertices (P.tile b) := by + exact ((hedgeFacts (P.tile b)).2.2.1 (Or.inr hwb)).1 + have hyb : y ∈ FootprintVertices (P.tile b) := by + exact ((hedgeFacts (P.tile b)).2.2.1 (Or.inr hwb)).2.1 + have incident_of_footprint (U : ProtoTile) (v : GaussianInt) + (hne : U.cells.Nonempty) (hv : v ∈ FootprintVertices U) : + ∃ j : Fin 4, LatticeVertexIncidentCell v j ∈ U.cells := + MissingEdgeGeometry.incident_of_footprint U v hne hv + have hnonemptyA : (P.tile a).cells.Nonempty := ⟨z, ha⟩ + have hnonemptyB : (P.tile b).cells.Nonempty := ⟨w, hb⟩ + have hTne : T.cells.Nonempty := MissingEdgeGeometry.hTne C q hq T hT hlarge P + have hmissT (v : GaussianInt) (hv : v = x ∨ v = y) : + ∃ j : Fin 4, LatticeVertexIncidentCell v j ∉ T.cells := MissingEdgeGeometry.hmissT C T P x + hx y hy hxy hnot z w hform hedgeFacts hedgeT hzwT a b hxa hya hxb hyb v hv + have hmissingA (v : GaussianInt) (hv : v ∈ FootprintVertices T) : + ∃ j : Fin 4, LatticeVertexIncidentCell v j ∉ (P.tile a).cells := + MissingEdgeGeometry.hmissingA C T P hzero hindexed a ha0 incident_of_footprint hTne v hv + have hmissingB (v : GaussianInt) (hv : v ∈ FootprintVertices T) : + ∃ j : Fin 4, LatticeVertexIncidentCell v j ∉ (P.tile b).cells := + MissingEdgeGeometry.hmissingB C T P hzero hindexed b hb0 incident_of_footprint hTne v hv + have hboundA_x : x ∈ BoundaryFootprintVertices (P.tile a) := + P3161T2IncidentBoundary (P.tile a) x + (incident_of_footprint (P.tile a) x hnonemptyA hxa) (hmissingA x hx) + have hboundA_y : y ∈ BoundaryFootprintVertices (P.tile a) := + P3161T2IncidentBoundary (P.tile a) y + (incident_of_footprint (P.tile a) y hnonemptyA hya) (hmissingA y hy) + have hboundB_x : x ∈ BoundaryFootprintVertices (P.tile b) := + P3161T2IncidentBoundary (P.tile b) x + (incident_of_footprint (P.tile b) x hnonemptyB hxb) (hmissingB x hx) + have hboundB_y : y ∈ BoundaryFootprintVertices (P.tile b) := + P3161T2IncidentBoundary (P.tile b) y + (incident_of_footprint (P.tile b) y hnonemptyB hyb) (hmissingB y hy) + have hneqxy : x ≠ y := MissingEdgeGeometry.hneqxy C q T P x y hy hxy hnot z w hform hedgeFacts + hedgeT a b hya hyb hmissT hboundA_y hboundB_y + have hclass := (PeriodicTileIntersectionClassification P).1 + have habEdge : (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty := + MissingEdgeGeometry.habEdge C P x y z w hedgeFacts a b hza hwb + have hzeroaEdge : (FootprintEdges (P.tile 0) ∩ FootprintEdges (P.tile a)).Nonempty := + MissingEdgeGeometry.hzeroaEdge C T P x hx y hy hzero a ha0 hxa hya hneqxy hclass + have hzerobEdge : (FootprintEdges (P.tile 0) ∩ FootprintEdges (P.tile b)).Nonempty := + MissingEdgeGeometry.hzerobEdge C T P x hx y hy hzero b hb0 hxb hyb hneqxy hclass + have habneq : a ≠ b := MissingEdgeGeometry.habneq C T hnochord P htile x y hxy z w hform + hedgeFacts hzwT a ha b hb hbuniq hb0 hwb hxb hyb hnonemptyB hmissingB hboundA_x hboundA_y + hboundB_x hboundB_y habEdge hzerobEdge + have habAdj : P.plane.adjacent a b := (hclass a b habneq).1.mp habEdge + have h0aAdj : P.plane.adjacent 0 a := + (hclass 0 a (Ne.symm ha0)).1.mp hzeroaEdge + have h0bAdj : P.plane.adjacent 0 b := + (hclass 0 b (Ne.symm hb0)).1.mp hzerobEdge + have htriple := htriangles 0 a b (Ne.symm ha0) habneq hb0 h0aAdj habAdj + ((P.plane.adjacent_symmetric 0 b).mp h0bAdj) + obtain ⟨_, _, _, v, hv, hvuniq⟩ := htriple + have hxcommon : x ∈ BoundaryFootprintVertices (P.tile 0) ∧ + x ∈ BoundaryFootprintVertices (P.tile a) ∧ x ∈ BoundaryFootprintVertices (P.tile b) := + MissingEdgeGeometry.hxcommon C T P x hx y hzero a b incident_of_footprint hTne hmissT + hboundA_x hboundB_x + have hycommon : y ∈ BoundaryFootprintVertices (P.tile 0) ∧ + y ∈ BoundaryFootprintVertices (P.tile a) ∧ y ∈ BoundaryFootprintVertices (P.tile b) := + MissingEdgeGeometry.hycommon C T P x y hy hzero a b incident_of_footprint hTne hmissT + hboundA_y hboundB_y + have hvx := hvuniq x hxcommon + have hvy := hvuniq y hycommon + exact hneqxy (hvx.trans hvy.symm) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean b/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean new file mode 100644 index 0000000000..5695b1fe81 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean @@ -0,0 +1,671 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4456T2CrosscutIndex +public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.P4456T2ParentSide +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn +public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport + +-- [TABLET NODE: P4456T2OrderedNoChord] + +/-! +# P4456T2OrderedNoChord + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OrderedNoChordGeometry + +private theorem cycle_constant : + (by + classical + exact + ∀ (f : Fin 6 → Int), ∀ (i : Fin 6), ∀ (i' : Fin 6), (∀ j : Fin 6, f j = f (j + 1) ∨ (j = + i ∧ j + 1 = i') ∨ (j = i' ∧ j + 1 = i)) → ∀ j, f j = f 0 ) := by + classical + intro f i i' h j + have h0 : f 0 = f 1 ∨ (0 = i ∧ 1 = i') ∨ (0 = i' ∧ 1 = i) := h 0 + have h1 : f 1 = f 2 ∨ (1 = i ∧ 2 = i') ∨ (1 = i' ∧ 2 = i) := h 1 + have h2 : f 2 = f 3 ∨ (2 = i ∧ 3 = i') ∨ (2 = i' ∧ 3 = i) := h 2 + have h3 : f 3 = f 4 ∨ (3 = i ∧ 4 = i') ∨ (3 = i' ∧ 4 = i) := h 3 + have h4 : f 4 = f 5 ∨ (4 = i ∧ 5 = i') ∨ (4 = i' ∧ 5 = i) := h 4 + have h5 : f 5 = f 0 ∨ (5 = i ∧ 0 = i') ∨ (5 = i' ∧ 0 = i) := h 5 + have hall : f 1 = f 0 ∧ f 2 = f 0 ∧ f 3 = f 0 ∧ f 4 = f 0 ∧ f 5 = f 0 := by + fin_cases i <;> fin_cases i' <;> + norm_num [Fin.ext_iff] at h0 h1 h2 h3 h4 h5 <;> omega + fin_cases j + · rfl + · exact hall.1 + · exact hall.2.1 + · exact hall.2.2.1 + · exact hall.2.2.2.1 + · exact hall.2.2.2.2 + +private theorem hsub : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C T), ∀ i, ∀ s, (layout.P i s).cells ⊆ T.cells ) := by + classical + intro q cfg C T layout i s c hc + exact (layout.outer_union c).mpr ⟨i, s, hc⟩ + +private theorem ht : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C T), ∀ (u : GaussianInt), (GaussianRealPoint u = ((TileCentroid (layout.P (0 : Fin + (3 : ℕ)) false)).1 + (TileCentroid (layout.P (0 : Fin (3 : ℕ)) false)).2, + (TileCentroid (layout.P (0 : Fin (3 : ℕ)) false)).2 - (TileCentroid (layout.P (0 : + Fin (3 : ℕ)) false)).1)) → ( + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + (t.re : Real) = 2 * (TileCentroid T).1 ∧ (t.im : Real) = 2 * (TileCentroid T).2) ) := by + classical + intro q cfg C T layout u hu w t + have hur := congrArg Prod.fst hu + have hui := congrArg Prod.snd hu + have hc := (layout.outer_occurrence 0 false).2.2 + have hcr := congrArg Prod.fst hc + have hci := congrArg Prod.snd hc + norm_num [GaussianRealPoint] at hur hui hcr hci + simp only [← GaussianInt.intCast_re, ← GaussianInt.intCast_im] at hur hui hcr hci + dsimp [t, w] + push_cast + constructor <;> linarith + +private theorem htau : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ + Function.Involutive tau ) := by + classical + intro q u w t tau z + dsimp [tau] + abel + +private theorem hHcells : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t + let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ + ∀ U, (H U).cells = U.cells.image tau ) := by + classical + intro q u w t H tau U + simp only [H, TileTranslation, TileQuarterTurn, Finset.image_image] + apply Finset.image_congr + intro z hz + apply Zsqrtd.ext <;> simp [Function.comp_def, GaussianTranslation, + GaussianQuarterTurn, tau] <;> ring + +private theorem hHreal : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + ((t.re : Real) = 2 * (TileCentroid T).1 ∧ (t.im : Real) = 2 * (TileCentroid T).2) → ( + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t + ∀ U, TileRealization (H U) = (fun p : Real × Real => (2 * (TileCentroid T).1 - p.1, 2 * + (TileCentroid T).2 - p.2)) '' TileRealization U) ) := by + classical + intro q T u w t ht H U + dsimp only [H] + rw [(TileTranslationFormulas _ t).2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn U)).2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.1, Set.image_image, Set.image_image] + congr 1 + funext p + apply Prod.ext <;> dsimp <;> simp only [ht.1, ht.2] <;> ring + +private theorem hcenter : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (z : GaussianInt), z ∈ U.cells ↔ ((z.re : Real) + 1 / 2, (z.im : + Real) + 1 / 2) ∈ TileRealization U ) := by + classical + intro U z + constructor + · intro hz + simp only [TileRealization, Set.mem_iUnion] + refine ⟨z, hz, ?_⟩ + norm_num [ClosedSquareRealization, Set.mem_Icc] + · intro hp + simp only [TileRealization, Set.mem_iUnion] at hp + obtain ⟨b, hb, hbox⟩ := hp + simp only [ClosedSquareRealization, Set.mem_Icc] at hbox + have hr₁ : b.re < z.re + 1 := by + exact_mod_cast (show (b.re : Real) < (z.re : Real) + 1 by linarith [hbox.1.1]) + have hr₂ : z.re < b.re + 1 := by + exact_mod_cast (show (z.re : Real) < (b.re : Real) + 1 by linarith [hbox.2.1]) + have hi₁ : b.im < z.im + 1 := by + exact_mod_cast (show (b.im : Real) < (z.im : Real) + 1 by linarith [hbox.1.2]) + have hi₂ : z.im < b.im + 1 := by + exact_mod_cast (show (z.im : Real) < (b.im : Real) + 1 by linarith [hbox.2.2]) + have hbz : b = z := by apply Zsqrtd.ext <;> omega + exact hbz ▸ hb + +private theorem hHsigned : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C T), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t + let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ + (Function.Involutive tau) → ((∀ U, (H U).cells = U.cells.image tau) → ((∀ U, + TileRealization (H U) = (fun p : Real × Real => (2 * (TileCentroid T).1 - p.1, 2 * + (TileCentroid T).2 - p.2)) '' TileRealization U) → ((∀ (U : ProtoTile), ∀ (z : + GaussianInt), z ∈ U.cells ↔ ((z.re : Real) + 1 / 2, (z.im : Real) + 1 / 2) ∈ + TileRealization U) → (∀ i, ∀ s, (H (layout.P i s)).cells = (layout.P i + (!s)).cells)))) ) := by + classical + intro q cfg C T layout u w t H tau htau hHcells hHreal hcenter i s + have hsigned := BandSignedOccurrenceHalfTurn q (TileCentroid T) layout.P + (fun i s => (layout.outer_occurrence i s).1) + (fun i s => (layout.outer_occurrence i s).2.2) i + have hplus : (H (layout.P i true)).cells = (layout.P i false).cells := by + have hreal : TileRealization (H (layout.P i true)) = + TileRealization (layout.P i false) := + (hHreal _).trans hsigned.2.2.2.2.2.symm + ext z + rw [hcenter, hcenter, hreal] + cases s + · change (H (layout.P i false)).cells = (layout.P i true).cells + rw [hHcells, ← hplus, hHcells, Finset.image_image] + simp [htau] + · exact hplus + +private theorem touch_flip : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C T), (∀ i, ∀ s, (layout.P i s).cells.Nonempty) → (∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t + (∀ i, ∀ s, (H (layout.P i s)).cells = (layout.P i (!s)).cells) → (∀ i, ∀ s, ∀ j, ∀ r, + TileTouching (layout.P i s) (layout.P j r) → TileTouching (layout.P i (!s)) (layout.P + j (!r)))) ) := by + classical + intro q cfg C T layout hne u w t H hHsigned i s j r h + have hH : TileTouching (H (layout.P i s)) (H (layout.P j r)) := + (TileTouchingCovariance _ _ t).1.mp + ((TileTouchingCovariance _ _ 0).2.1.mp + ((TileTouchingCovariance _ _ 0).2.1.mp h)) + have oa := ProtoTileObservableExtensionality _ _ (hHsigned i s) + (fun he => False.elim ((hne i (!s)).ne_empty ((hHsigned i s).symm.trans he))) + have ob := ProtoTileObservableExtensionality _ _ (hHsigned j r) + (fun he => False.elim ((hne j (!r)).ne_empty ((hHsigned j r).symm.trans he))) + rcases hH with hH | ⟨he, _⟩ | ⟨he, _⟩ + · left + simpa only [hHsigned, oa.2.1, ob.2.1, oa.2.2.1, ob.2.2.1] using hH + · exact False.elim ((hne i (!s)).ne_empty ((hHsigned i s).symm.trans he)) + · exact False.elim ((hne j (!r)).ne_empty ((hHsigned j r).symm.trans he)) + +private theorem touch_sym : + (by + classical + exact + ∀ U, ∀ V, TileTouching U V → TileTouching V U ) := by + classical + intro U V h + rcases h with ⟨hu, hv, hd, hp⟩ | h | h + · left + exact ⟨hv, hu, hd.symm, by simpa only [Set.inter_comm] using hp⟩ + · exact Or.inr (Or.inr h) + · exact Or.inr (Or.inl h) + +private theorem hlabels : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C T), ∀ (side : GaussianInt → ℤ), ∀ (k : Fin (3 : ℕ) → Bool → ℤ), (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), ∀ c ∈ (layout.P i s).cells, side c = k i s) → ( + let V : Fin 6 → Fin 3 × Bool := + ![(0, true), (2, false), (1, true), (0, false), (2, true), (1, false)] + let P : Fin 6 → ProtoTile := fun j => layout.P (V j).1 (V j).2 + let l : Fin 6 → Int := fun j => k (V j).1 (V j).2 + ∀ j, ∀ c, c ∈ (P j).cells → side c = l j) ) := by + classical + intro q cfg C T layout side k hk V P l j c hc + exact hk _ _ c hc + +private theorem hcontacts : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C T), (∀ i, ∀ s, ∀ j, ∀ r, TileTouching (layout.P i s) (layout.P j r) → TileTouching + (layout.P i (!s)) (layout.P j (!r))) → ((∀ U, ∀ V, TileTouching U V → TileTouching V + U) → ( + let V : Fin 6 → Fin 3 × Bool := + ![(0, true), (2, false), (1, true), (0, false), (2, true), (1, false)] + let P : Fin 6 → ProtoTile := fun j => layout.P (V j).1 (V j).2 + ∀ j : Fin 6, TileTouching (P j) (P (j + 1)))) ) := by + classical + intro q cfg C T layout touch_flip touch_sym V P j + have hFA := layout.outer_touching.2.1.2.2.1 + have hDA := layout.outer_touching.2.2.2.1.2.2.1 + have hFC := layout.outer_touching.2.2.2.2.2.2.2.2.2.1 + fin_cases j + · exact touch_sym _ _ hFA + · exact hFC + · exact touch_flip 1 false 0 true hDA + · exact touch_flip 0 true 2 false (touch_sym _ _ hFA) + · exact touch_flip 2 false 1 true hFC + · exact hDA + +private theorem incident : + (by + classical + exact + ∀ (x : LatticeCell), ∀ (y : LatticeCell), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ≠ + b) → (({x, y} ∈ FootprintEdges (⟨{a}, a⟩ : ProtoTile)) → (({x, y} ∈ FootprintEdges + (⟨{b}, b⟩ : ProtoTile)) → (∀ (z : GaussianInt), ∀ (z' : GaussianInt), ((x = z + (1 : + GaussianInt) ∧ y = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = z + + (1 : GaussianInt) ∧ x = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) + ∧ z' = z + (1 : GaussianInt) ∨ (x = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∧ y = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = z + (1 : GaussianInt) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∧ x = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∧ + z' = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → (∀ c, ({x, y} : Finset GaussianInt) ∈ + FootprintEdges (⟨{c}, c⟩ : ProtoTile) → c = a ∨ c = b)))) ) := by + classical + intro x y a b hab hea heb z z' hform c hc + have hia := (P4397T1UnitEdgeCells.2 x y z z' hform ⟨{a}, a⟩).1.mp hea + have hib := (P4397T1UnitEdgeCells.2 x y z z' hform ⟨{b}, b⟩).1.mp heb + have hic := (P4397T1UnitEdgeCells.2 x y z z' hform ⟨{c}, c⟩).1.mp hc + simp only [Finset.mem_singleton] at hia hib hic + rcases hia with hia | hia <;> rcases hib with hib | hib <;> + rcases hic with hic | hic + all_goals first + | exact Or.inl (hic.symm.trans hia) + | exact Or.inr (hic.symm.trans hib) + | exact False.elim (hab (hia.symm.trans hib)) + +private theorem chord_vertex : + (by + classical + exact + ∀ (x : LatticeCell), ∀ (y : LatticeCell), ∀ (z : GaussianInt), ∀ (z' : GaussianInt), ((x + = z + (1 : GaussianInt) ∧ y = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∨ y = z + (1 : GaussianInt) ∧ x = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt)) ∧ z' = z + (1 : GaussianInt) ∨ (x = z + (1 : GaussianInt) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∧ y = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = + z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∧ x = z + (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt)) ∧ z' = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → (∀ U, ({x, y} : + Finset GaussianInt) ∈ FootprintEdges U → x ∈ FootprintVertices U) ) := by + classical + intro x y z z' hform U heU + have hU := P4397T1UnitEdgeCells.2 x y z z' hform U + exact (hU.2.2.1 (hU.1.mp heU)).1 + +private theorem trans0 : + (by + classical + exact + ∀ U : ProtoTile, TileTranslation U 0 = U ) := by + classical + intro U + have hz : GaussianTranslation (0 : GaussianInt) = id := by + funext z + exact add_zero z + cases U + simp [TileTranslation, hz] + +private theorem hOparents : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C T), ∀ c ∈ layout.O.cells, c ∈ (layout.P 0 true).cells ∧ c ∈ (layout.P 0 + false).cells ) := by + classical + intro q cfg C T layout c hc + constructor + · apply (layout.plus_union c).mpr + exact ⟨0, false, by simpa only [← layout.precursor_eq] using hc⟩ + · apply (layout.minus_union c).mpr + exact ⟨0, true, by simpa only [← layout.precursor_cells] using hc⟩ + +private theorem precursor_side : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C T), ∀ (x : LatticeCell), ∀ (y : LatticeCell), ∀ (side : GaussianInt → ℤ), ∀ (k : + Fin (3 : ℕ) → Bool → ℤ), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ c ∈ (layout.P i + s).cells, side c = k i s) → ((∀ U, ({x, y} : Finset GaussianInt) ∈ FootprintEdges U → + x ∈ FootprintVertices U) → ((∀ U : ProtoTile, TileTranslation U 0 = U) → ((∀ c ∈ + layout.O.cells, c ∈ (layout.P 0 true).cells ∧ c ∈ (layout.P 0 false).cells) → (∀ c, ∀ + d, c ∈ layout.O.cells → ({x, y} : Finset GaussianInt) ∈ FootprintEdges (⟨{c}, c⟩ : + ProtoTile) → ({x, y} : Finset GaussianInt) ∈ FootprintEdges (⟨{d}, d⟩ : ProtoTile) → + side c = side d)))) ) := by + classical + intro q cfg C T layout x y side k hk chord_vertex trans0 hOparents c d hc hec hed + have hxO : x ∈ FootprintVertices layout.O := by + apply chord_vertex + obtain ⟨c', hc', hf⟩ := hec + have hcc : c' = c := Finset.mem_singleton.mp hc' + subst c' + exact ⟨c, hc, hf⟩ + have hxO' : x ∈ FootprintVertices + (TileTranslation layout.O ((0 : GaussianInt) * layout.u + + (0 : GaussianInt) * layout.v)) := by + simpa only [zero_mul, zero_add, trans0] using hxO + have hd := layout.precursor_isolated 0 0 x hxO' d (chord_vertex _ hed) + have hd' : d ∈ (layout.P 0 true).cells ∨ d ∈ (layout.P 0 false).cells := by + simpa only [SubtileOccurrenceInterpretation, Int.cast_zero, zero_mul, + zero_add, trans0] using hd + rcases hd' with hd | hd + · exact (hk 0 true c (hOparents c hc).1).trans (hk 0 true d hd).symm + · exact (hk 0 false c (hOparents c hc).2).trans (hk 0 false d hd).symm + +private theorem hmodzero : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C T), + let V : Fin 6 → Fin 3 × Bool := + ![(0, true), (2, false), (1, true), (0, false), (2, true), (1, false)] + let P : Fin 6 → ProtoTile := fun j => layout.P (V j).1 (V j).2 + (∀ U : ProtoTile, TileTranslation U 0 = U) → ( + let label : Fin 6 → SixSubtileLabel := ![.A, .F, .C, .B, .E, .D] + ∀ j, ∀ c, c ∉ layout.O.cells → (c ∈ (P j).cells ↔ c ∈ + (ModifiedSubtileOccurrenceInterpretation layout.P layout.O layout.u layout.v ⟨label + j, 0, 0⟩).cells)) ) := by + classical + intro q cfg C T layout V P trans0 label j c hc + fin_cases j <;> + simp [P, V, label, ModifiedSubtileOccurrenceInterpretation, + TileCellComplement, hc, trans0] + +private theorem unique_owner : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C T), + let V : Fin 6 → Fin 3 × Bool := + ![(0, true), (2, false), (1, true), (0, false), (2, true), (1, false)] + let P : Fin 6 → ProtoTile := fun j => layout.P (V j).1 (V j).2 + let label : Fin 6 → SixSubtileLabel := ![.A, .F, .C, .B, .E, .D] + (∀ j, ∀ c, c ∉ layout.O.cells → (c ∈ (P j).cells ↔ c ∈ + (ModifiedSubtileOccurrenceInterpretation layout.P layout.O layout.u layout.v ⟨label + j, 0, 0⟩).cells)) → ((Function.Injective label) → (∀ c, c ∉ layout.O.cells → ∀ i j : + Fin 6, c ∈ (P i).cells → c ∈ (P j).cells → i = j)) ) := by + classical + intro q cfg C T layout V P label hmodzero hlabel_inj c hc i j hi hj + have heq := (layout.partition c).unique + ((hmodzero i c hc).mp hi) ((hmodzero j c hc).mp hj) + exact hlabel_inj (congrArg PeriodicSubtileIndex.label heq) + +private theorem cover : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C T), + let V : Fin 6 → Fin 3 × Bool := + ![(0, true), (2, false), (1, true), (0, false), (2, true), (1, false)] + let P : Fin 6 → ProtoTile := fun j => layout.P (V j).1 (V j).2 + ∀ c ∈ T.cells, ∃ j : Fin 6, c ∈ (P j).cells ) := by + classical + intro q cfg C T layout V P c hc + obtain ⟨i, s, hc⟩ := (layout.outer_union c).mp hc + fin_cases i <;> cases s + · exact ⟨3, hc⟩ + · exact ⟨0, hc⟩ + · exact ⟨5, hc⟩ + · exact ⟨2, hc⟩ + · exact ⟨1, hc⟩ + · exact ⟨4, hc⟩ + +private theorem common_edge : + (by + classical + exact + ∀ U W : ProtoTile, U.cells.Nonempty → W.cells.Nonempty → TileTouching U W → + (FootprintEdges U ∩ FootprintEdges W).Nonempty ) := by + classical + intro U W hU hW htouch + rcases htouch with ⟨_, _, _, p, hnodup, hlength, hverts, hsteps, hedges⟩ | + ⟨he, _⟩ | ⟨he, _⟩ + · cases p with + | nil => simp at hlength + | cons r p => + cases p with + | nil => simp at hlength + | cons s tail => + have hrs : FourNeighborAdjacent r s := hsteps r s [] tail rfl + have hbound : ({r, s} : Finset GaussianInt) ∈ + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges W := + (hedges _).mpr ⟨r, s, [], tail, rfl, rfl⟩ + obtain ⟨v, v', hgeom⟩ := P4397T1UnitEdgeCells.1 r s hrs + have toFoot (J : ProtoTile) (hJ : ({r, s} : Finset GaussianInt) ∈ + BoundaryFootprintEdges J) : ({r, s} : Finset GaussianInt) ∈ + FootprintEdges J := by + have hunit := P4397T1UnitEdgeCells.2 r s v v' hgeom J + apply hunit.1.mpr + rcases hunit.2.1.mp hJ with ⟨hv, _⟩ | ⟨_, hv'⟩ + · exact Or.inl hv + · exact Or.inr hv' + exact ⟨{r, s}, toFoot U hbound.1, toFoot W hbound.2⟩ + · exact False.elim (hU.ne_empty he) + · exact False.elim (hW.ne_empty he) + +private theorem changes : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C T), ∀ (x : LatticeCell), ∀ (y : LatticeCell), ∀ (side : GaussianInt → ℤ), ∀ (a : + GaussianInt), ∀ (b : GaussianInt), (∀ c ∈ T.cells, ∀ d ∈ T.cells, c ≠ d → ∀ f ∈ + FootprintEdges (⟨{c}, c⟩ : ProtoTile) ∩ FootprintEdges (⟨{d}, d⟩ : ProtoTile), side c + ≠ side d → f = {x, y}) → ((∀ i, ∀ s, (layout.P i s).cells ⊆ T.cells) → (∀ (k : Fin (3 + : ℕ) → Bool → ℤ), (∀ i, ∀ s, (layout.P i s).cells.Nonempty) → ( + let V : Fin 6 → Fin 3 × Bool := + ![(0, true), (2, false), (1, true), (0, false), (2, true), (1, false)] + let P : Fin 6 → ProtoTile := fun j => layout.P (V j).1 (V j).2 + let l : Fin 6 → Int := fun j => k (V j).1 (V j).2 + (∀ j, ∀ c, c ∈ (P j).cells → side c = l j) → ((∀ j : Fin 6, TileTouching (P j) (P (j + + 1))) → ((∀ c, ({x, y} : Finset GaussianInt) ∈ FootprintEdges (⟨{c}, c⟩ : ProtoTile) → + c = a ∨ c = b) → ((a ∉ layout.O.cells) → ((b ∉ layout.O.cells) → ((∀ c, c ∉ + layout.O.cells → ∀ i j : Fin 6, c ∈ (P i).cells → c ∈ (P j).cells → i = j) → (∀ (ia : + Fin (6 : ℕ)), (a ∈ (P ia).cells) → (∀ (ib : Fin (6 : ℕ)), (b ∈ (P ib).cells) → ((∀ U + W : ProtoTile, U.cells.Nonempty → W.cells.Nonempty → TileTouching U W → + (FootprintEdges U ∩ FootprintEdges W).Nonempty) → (∀ j : Fin 6, l j ≠ l (j + 1) → (j + = ia ∧ j + 1 = ib) ∨ (j = ib ∧ j + 1 = ia))))))))))))) ) := by + classical + intro q cfg C T layout x y side a b hstep hsub k hne V P l hlabels hcontacts incident haO hbO + unique_owner ia hia ib hib common_edge j hj + obtain ⟨f, hfU, hfW⟩ := common_edge (P j) (P (j + 1)) + (hne _ _) (hne _ _) (hcontacts j) + obtain ⟨c, hc, hfc⟩ := hfU + obtain ⟨d, hd, hfd⟩ := hfW + have hfc' : f ∈ FootprintEdges (⟨{c}, c⟩ : ProtoTile) := + ⟨c, Finset.mem_singleton_self c, hfc⟩ + have hfd' : f ∈ FootprintEdges (⟨{d}, d⟩ : ProtoTile) := + ⟨d, Finset.mem_singleton_self d, hfd⟩ + have hdiff : side c ≠ side d := by + rw [hlabels j c hc, hlabels (j + 1) d hd] + exact hj + have hcd : c ≠ d := fun heq => hdiff (congrArg side heq) + have hfe : f = {x, y} := hstep c (hsub _ _ hc) d (hsub _ _ hd) + hcd f ⟨hfc', hfd'⟩ hdiff + rw [hfe] at hfc' hfd' + rcases incident c hfc' with hca | hcb <;> + rcases incident d hfd' with hda | hdb + · exact False.elim (hcd (hca.trans hda.symm)) + · exact Or.inl ⟨unique_owner a haO j ia (hca ▸ hc) hia, + unique_owner b hbO (j + 1) ib (hdb ▸ hd) hib⟩ + · exact Or.inr ⟨unique_owner b hbO j ib (hcb ▸ hc) hib, + unique_owner a haO (j + 1) ia (hda ▸ hd) hia⟩ + · exact False.elim (hcd (hcb.trans hdb.symm)) + +private theorem hallAt444 : + (by + classical + exact + (∀ (f : Fin 6 → Int), ∀ (i : Fin 6), ∀ (i' : Fin 6), (∀ j : Fin 6, f j = f (j + 1) ∨ (j = + i ∧ j + 1 = i') ∨ (j = i' ∧ j + 1 = i)) → ∀ j, f j = f 0) → (∀ (k : Fin (3 : ℕ) → + Bool → ℤ), + let V : Fin 6 → Fin 3 × Bool := + ![(0, true), (2, false), (1, true), (0, false), (2, true), (1, false)] + let l : Fin 6 → Int := fun j => k (V j).1 (V j).2 + ∀ (ia : Fin (6 : ℕ)), ∀ (ib : Fin (6 : ℕ)), (∀ j : Fin 6, l j ≠ l (j + 1) → (j = ia ∧ j + + 1 = ib) ∨ (j = ib ∧ j + 1 = ia)) → (∀ j, l j = l 0)) ) := by + classical + intro cycle_constant k V l ia ib changes + apply cycle_constant l ia ib + intro j + by_cases hj : l j = l (j + 1) + · exact Or.inl hj + · exact Or.inr (changes j hj) + +end OrderedNoChordGeometry + +theorem P4456T2OrderedNoChord + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) (hT : LatticeTile T) + (layout : BandOrderedGeneralLayoutCertificate q cfg C T) + (hparents : ∀ i s, ∀ x y, FourNeighborAdjacent x y → + x ∈ BoundaryFootprintVertices (layout.P i s) → + y ∈ BoundaryFootprintVertices (layout.P i s) → + ¬ OpenLatticeEdge x y ⊆ interior (TileRealization (layout.P i s))) : + ∀ x y, FourNeighborAdjacent x y → + x ∈ BoundaryFootprintVertices T → y ∈ BoundaryFootprintVertices T → + ¬ OpenLatticeEdge x y ⊆ interior (TileRealization T) := by +-- BODY + exact (by + classical + -- The six-cycle remains connected after deleting any one unordered edge. + have cycle_constant := OrderedNoChordGeometry.cycle_constant + intro x y hxy hx hy he + obtain ⟨side, a, b, ha, hb, hab, hdifferent, hea, heb, hstep⟩ := + P4456T2CrosscutIndex T hT x y hxy hx hy he + have hsub := OrderedNoChordGeometry.hsub q cfg C T layout + choose k hk using fun i s => + P4456T2ParentSide T (layout.P i s) hT (layout.parent_lattice i s) + (hsub i s) x y hxy hx hy side hstep (hparents i s) + suffices hcycle : ∀ (k : Fin 3 → Bool → Int), + (∀ i s, ∀ c ∈ (layout.P i s).cells, side c = k i s) → + side a = side b by + exact hdifferent (hcycle k hk) + intro k hk + have hne : ∀ i s, (layout.P i s).cells.Nonempty := + fun i s => (LatticeTileFourNeighborConnected _ (layout.parent_lattice i s)).1 + -- Construct one integral half-turn centered at the outer centroid. + obtain ⟨u, hu, _⟩ := QuarterTurnSymmetricCenteredTransport + (layout.P 0 false) (layout.parent_quarter_turn 0 false) + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + have ht := OrderedNoChordGeometry.ht q cfg C T layout u hu + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t + let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ + have htau := OrderedNoChordGeometry.htau q u + have hHcells := OrderedNoChordGeometry.hHcells q u + have hHreal := OrderedNoChordGeometry.hHreal q T u ht + have hcenter := OrderedNoChordGeometry.hcenter + have hHsigned := OrderedNoChordGeometry.hHsigned q cfg C T layout u htau hHcells hHreal hcenter + have touch_flip := OrderedNoChordGeometry.touch_flip q cfg C T layout hne u hHsigned + have touch_sym := OrderedNoChordGeometry.touch_sym + let V : Fin 6 → Fin 3 × Bool := + ![(0, true), (2, false), (1, true), (0, false), (2, true), (1, false)] + let P : Fin 6 → ProtoTile := fun j => layout.P (V j).1 (V j).2 + let l : Fin 6 → Int := fun j => k (V j).1 (V j).2 + have hlabels := OrderedNoChordGeometry.hlabels q cfg C T layout side k hk + have hcontacts := OrderedNoChordGeometry.hcontacts q cfg C T layout touch_flip touch_sym + obtain ⟨z, z', hform⟩ := P4397T1UnitEdgeCells.1 x y hxy + have incident := OrderedNoChordGeometry.incident x y a b hab hea heb z z' hform + have chord_vertex := OrderedNoChordGeometry.chord_vertex x y z z' hform + have trans0 := OrderedNoChordGeometry.trans0 + have hOparents := OrderedNoChordGeometry.hOparents q cfg C T layout + -- Isolation is used at a corner supported by an occupied precursor cell. + have precursor_side := OrderedNoChordGeometry.precursor_side q cfg C T layout x y side k hk + chord_vertex trans0 hOparents + have haO : a ∉ layout.O.cells := fun h => + hdifferent (precursor_side a b h hea heb) + have hbO : b ∉ layout.O.cells := fun h => + hdifferent (precursor_side b a h heb hea).symm + -- Outside the precursor, the modified partition gives original owners. + let label : Fin 6 → SixSubtileLabel := ![.A, .F, .C, .B, .E, .D] + have hmodzero := OrderedNoChordGeometry.hmodzero q cfg C T layout trans0 + have hlabel_inj : Function.Injective label := by decide + have unique_owner := OrderedNoChordGeometry.unique_owner q cfg C T layout hmodzero hlabel_inj + have cover := OrderedNoChordGeometry.cover q cfg C T layout + obtain ⟨ia, hia⟩ := cover a ha + obtain ⟨ib, hib⟩ := cover b hb + have common_edge := OrderedNoChordGeometry.common_edge + -- Every change uses the chord itself and its same two incident cells. + have changes := OrderedNoChordGeometry.changes q cfg C T layout x y side a b hstep hsub k hne + hlabels hcontacts incident haO hbO unique_owner ia hia ib hib common_edge + have hall := OrderedNoChordGeometry.hallAt444 cycle_constant k ia ib changes + exact (hlabels ia a hia).trans ((hall ia).trans + ((hall ib).symm.trans (hlabels ib b hib).symm))) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2PackingNoChord.lean b/LeanPool/ApollonianSuperharmonic/P4456T2PackingNoChord.lean new file mode 100644 index 0000000000..51664ec09f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4456T2PackingNoChord.lean @@ -0,0 +1,436 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.OpenLatticeEdge +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import Mathlib.Topology.Algebra.Ring.Basic +public import Mathlib.Topology.Algebra.Ring.Real + +-- [TABLET NODE: P4456T2PackingNoChord] + +/-! +# P4456T2PackingNoChord + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PackingChordConstruction + +private noncomputable abbrev NoChord (T : ProtoTile) : Prop := by + classical + exact ∀ x y, FourNeighborAdjacent x y → + x ∈ BoundaryFootprintVertices T → y ∈ BoundaryFootprintVertices T → + ¬ OpenLatticeEdge x y ⊆ interior (TileRealization T) + +private noncomputable abbrev q : Real × Real → Real × Real := by + classical + exact fun p => (-p.2, p.1) + +private noncomputable abbrev r : Real × Real → Real × Real := by + classical + exact fun p => (p.1, -p.2) + +private noncomputable abbrev qh : (Real × Real) ≃ₜ (Real × Real) := by + classical + let q : Real × Real → Real × Real := fun p => (-p.2, p.1) + exact { + toEquiv := { + toFun := q + invFun := fun p => (p.2, -p.1) + left_inv := by intro p; simp [q] + right_inv := by intro p; simp [q] + } + continuous_toFun := by + exact Continuous.prodMk (continuous_neg.comp continuous_snd) continuous_fst + continuous_invFun := by + exact Continuous.prodMk continuous_snd (continuous_neg.comp continuous_fst) + } + +private noncomputable abbrev rh : (Real × Real) ≃ₜ (Real × Real) := by + classical + let r : Real × Real → Real × Real := fun p => (p.1, -p.2) + exact { + toEquiv := { + toFun := r + invFun := r + left_inv := by intro p; simp [r] + right_inv := by intro p; simp [r] + } + continuous_toFun := by + exact Continuous.prodMk continuous_fst (continuous_neg.comp continuous_snd) + continuous_invFun := by + exact Continuous.prodMk continuous_fst (continuous_neg.comp continuous_snd) + } + +private theorem transport (T U : ProtoTile) (f : GaussianInt → GaussianInt) + (H : (Real × Real) ≃ₜ (Real × Real)) + (hb : BoundaryFootprintVertices U = f '' BoundaryFootprintVertices T) + (ha : ∀ x y, FourNeighborAdjacent x y ↔ + FourNeighborAdjacent (f x) (f y)) + (he : ∀ x y, OpenLatticeEdge (f x) (f y) = + H '' OpenLatticeEdge x y) + (hr : TileRealization U = H '' TileRealization T) : + (NoChord) T ↔ (NoChord) U := by + classical + let NoChord (T : ProtoTile) : Prop := + ∀ x y, FourNeighborAdjacent x y → + x ∈ BoundaryFootprintVertices T → y ∈ BoundaryFootprintVertices T → + ¬ OpenLatticeEdge x y ⊆ interior (TileRealization T) + change (NoChord T ↔ NoChord U) + have hc (x y : GaussianInt) : + (OpenLatticeEdge x y ⊆ interior (TileRealization T)) ↔ + (OpenLatticeEdge (f x) (f y) ⊆ interior (TileRealization U)) := by + rw [he, hr, (H.image_interior _).symm] + constructor + · intro h p hp + obtain ⟨z, hz, rfl⟩ := (Set.mem_image H (OpenLatticeEdge x y) p).1 hp + exact Set.mem_image_of_mem H (h hz) + · intro h p hp + obtain ⟨q, hq, hpq⟩ := h (Set.mem_image_of_mem H hp) + have : q = p := H.injective hpq + simpa [this] using hq + constructor + · intro h x y hxy hx hy hchord + obtain ⟨x₀, hx₀, hxEq⟩ := (Set.mem_image f (BoundaryFootprintVertices T) x).1 (hb ▸ hx) + obtain ⟨y₀, hy₀, hyEq⟩ := (Set.mem_image f (BoundaryFootprintVertices T) y).1 (hb ▸ hy) + have hxy0 : FourNeighborAdjacent (f x₀) (f y₀) := by + simpa [hxEq, hyEq] using hxy + have hchord0 : OpenLatticeEdge (f x₀) (f y₀) ⊆ + interior (TileRealization U) := by + simpa [hxEq, hyEq] using hchord + exact h x₀ y₀ ((ha x₀ y₀).2 hxy0) hx₀ hy₀ ((hc x₀ y₀).2 hchord0) + · intro h x y hxy hx hy hchord + apply h (f x) (f y) ((ha x y).1 hxy) + · rw [hb] + exact ⟨x, hx, rfl⟩ + · rw [hb] + exact ⟨y, hy, rfl⟩ + · exact (hc x y).1 hchord + +private theorem qadj (x y : GaussianInt) : + FourNeighborAdjacent x y ↔ + FourNeighborAdjacent (GaussianQuarterTurn x) (GaussianQuarterTurn y) := by + classical + have q1 (z : GaussianInt) : GaussianQuarterTurn (z + 1) = GaussianQuarterTurn z + ⟨0, 1⟩ := by + ext <;> simp [GaussianQuarterTurn] + have qm1 (z : GaussianInt) : GaussianQuarterTurn (z - 1) = GaussianQuarterTurn z - ⟨0, 1⟩ := by + ext <;> simp [GaussianQuarterTurn] + have qi (z : GaussianInt) : GaussianQuarterTurn (z + ⟨0, 1⟩) = GaussianQuarterTurn z - 1 := by + ext <;> simp [GaussianQuarterTurn]; ring + have qmi (z : GaussianInt) : GaussianQuarterTurn (z - ⟨0, 1⟩) = GaussianQuarterTurn z + 1 := by + ext <;> simp [GaussianQuarterTurn]; ring + have qsq (z : GaussianInt) : GaussianQuarterTurn (GaussianQuarterTurn z) = -z := by + ext <;> simp [GaussianQuarterTurn] + have negAdj : FourNeighborAdjacent (-x) (-y) ↔ FourNeighborAdjacent x y := by + constructor + · intro h + rcases h with h | h | h | h + · right; left; have := congrArg Neg.neg h; simpa [add_comm, sub_eq_add_neg] using this + · left; have := congrArg Neg.neg h; simpa [add_comm, sub_eq_add_neg] using this + · right; right; right; have := congrArg Neg.neg h; simpa [add_comm, sub_eq_add_neg] using this + · right; right; left; have := congrArg Neg.neg h; simpa [add_comm, sub_eq_add_neg] using this + · intro h + rcases h with h | h | h | h + · right; left; have := congrArg Neg.neg h; simpa [add_comm, sub_eq_add_neg] using this + · left; have := congrArg Neg.neg h; simpa [add_comm, sub_eq_add_neg] using this + · right; right; right; have := congrArg Neg.neg h; simpa [add_comm, sub_eq_add_neg] using this + · right; right; left; have := congrArg Neg.neg h; simpa [add_comm, sub_eq_add_neg] using this + have fwd (a b : GaussianInt) : FourNeighborAdjacent a b → + FourNeighborAdjacent (GaussianQuarterTurn a) (GaussianQuarterTurn b) := by + intro h + rcases h with h | h | h | h + · rw [h, q1] + exact Or.inr (Or.inr (Or.inl rfl)) + · rw [h, qm1] + exact Or.inr (Or.inr (Or.inr rfl)) + · rw [h, qi] + exact Or.inr (Or.inl rfl) + · rw [h, qmi] + exact Or.inl rfl + refine ⟨fwd x y, ?_⟩ + intro h + have h₂ := fwd (GaussianQuarterTurn x) (GaussianQuarterTurn y) h + exact negAdj.mp (by simpa [qsq] using h₂) + +private theorem radj (x y : GaussianInt) : + FourNeighborAdjacent x y ↔ + FourNeighborAdjacent (GaussianReflection x) (GaussianReflection y) := by + classical + have r1 (z : GaussianInt) : GaussianReflection (z + 1) = GaussianReflection z + 1 := by + ext <;> simp [GaussianReflection] + have rm1 (z : GaussianInt) : GaussianReflection (z - 1) = GaussianReflection z - 1 := by + ext <;> simp [GaussianReflection] + have ri (z : GaussianInt) : GaussianReflection (z + ⟨0, 1⟩) = GaussianReflection z - ⟨0, 1⟩ := by + ext <;> simp [GaussianReflection]; ring + have rmi (z : GaussianInt) : GaussianReflection (z - ⟨0, 1⟩) = GaussianReflection z + ⟨0, 1⟩ := by + ext <;> simp [GaussianReflection]; ring + have rinv (z : GaussianInt) : GaussianReflection (GaussianReflection z) = z := by + ext <;> simp [GaussianReflection] + have fwd (a b : GaussianInt) : FourNeighborAdjacent a b → + FourNeighborAdjacent (GaussianReflection a) (GaussianReflection b) := by + intro h + rcases h with h | h | h | h + · rw [h, r1]; exact Or.inl rfl + · rw [h, rm1]; exact Or.inr (Or.inl rfl) + · rw [h, ri]; exact Or.inr (Or.inr (Or.inr rfl)) + · rw [h, rmi]; exact Or.inr (Or.inr (Or.inl rfl)) + refine ⟨fwd x y, ?_⟩ + intro h + have h₂ := fwd (GaussianReflection x) (GaussianReflection y) h + simpa [rinv] using h₂ + +private theorem qedge (x y : GaussianInt) : + OpenLatticeEdge (GaussianQuarterTurn x) (GaussianQuarterTurn y) = + (qh) '' OpenLatticeEdge x y := by + classical + let q : Real × Real → Real × Real := fun p => (-p.2, p.1) + let qh : (Real × Real) ≃ₜ (Real × Real) := { + toEquiv := { + toFun := q + invFun := fun p => (p.2, -p.1) + left_inv := by intro p; simp [q] + right_inv := by intro p; simp [q] + } + continuous_toFun := by + exact Continuous.prodMk (continuous_neg.comp continuous_snd) continuous_fst + continuous_invFun := by + exact Continuous.prodMk continuous_snd (continuous_neg.comp continuous_fst) + } + change (OpenLatticeEdge (GaussianQuarterTurn x) (GaussianQuarterTurn y) = + qh '' OpenLatticeEdge x y) + ext p + simp only [OpenLatticeEdge, Set.mem_ofPred_eq, Set.mem_image] + constructor + · rintro ⟨t, ht, ht1, hp⟩ + refine ⟨(1 - t) • GaussianRealPoint x + t • GaussianRealPoint y, + ⟨t, ht, ht1, rfl⟩, ?_⟩ + rw [hp] + simp [qh, q, GaussianRealPoint, GaussianQuarterTurn]; ring + · rintro ⟨z, ⟨t, ht, ht1, hp⟩, hpz⟩ + refine ⟨t, ht, ht1, ?_⟩ + have hz : z = (1 - t) • GaussianRealPoint x + t • GaussianRealPoint y := hp + subst z + rw [← hpz] + simp [qh, q, GaussianRealPoint, GaussianQuarterTurn]; ring + +private theorem redge (x y : GaussianInt) : + OpenLatticeEdge (GaussianReflection x) (GaussianReflection y) = + (rh) '' OpenLatticeEdge x y := by + classical + let r : Real × Real → Real × Real := fun p => (p.1, -p.2) + let rh : (Real × Real) ≃ₜ (Real × Real) := { + toEquiv := { + toFun := r + invFun := r + left_inv := by intro p; simp [r] + right_inv := by intro p; simp [r] + } + continuous_toFun := by + exact Continuous.prodMk continuous_fst (continuous_neg.comp continuous_snd) + continuous_invFun := by + exact Continuous.prodMk continuous_fst (continuous_neg.comp continuous_snd) + } + change (OpenLatticeEdge (GaussianReflection x) (GaussianReflection y) = + rh '' OpenLatticeEdge x y) + ext p + simp only [OpenLatticeEdge, Set.mem_ofPred_eq, Set.mem_image] + constructor + · rintro ⟨t, ht, ht1, hp⟩ + refine ⟨(1 - t) • GaussianRealPoint x + t • GaussianRealPoint y, + ⟨t, ht, ht1, rfl⟩, ?_⟩ + rw [hp] + simp [rh, r, GaussianRealPoint, GaussianReflection]; ring + · rintro ⟨z, ⟨t, ht, ht1, hp⟩, hpz⟩ + refine ⟨t, ht, ht1, ?_⟩ + have hz : z = (1 - t) • GaussianRealPoint x + t • GaussianRealPoint y := hp + subst z + rw [← hpz] + simp [rh, r, GaussianRealPoint, GaussianReflection]; ring + +private theorem qturn (transport : ∀ (T U : ProtoTile) (f : GaussianInt → GaussianInt) (H : ℝ × ℝ + ≃ₜ ℝ × ℝ), + BoundaryFootprintVertices U = f '' BoundaryFootprintVertices T → + (∀ (x y : LatticeCell), FourNeighborAdjacent x y ↔ FourNeighborAdjacent (f x) (f y)) → + (∀ (x y : GaussianInt), OpenLatticeEdge (f x) (f y) = ⇑H '' OpenLatticeEdge x y) → + TileRealization U = ⇑H '' TileRealization T → ((NoChord) T ↔ (NoChord) U)) (qadj : ∀ (x y + : GaussianInt), FourNeighborAdjacent x y ↔ FourNeighborAdjacent (GaussianQuarterTurn + x) (GaussianQuarterTurn y)) (qedge : ∀ (x y : GaussianInt), OpenLatticeEdge + (GaussianQuarterTurn x) (GaussianQuarterTurn y) = ⇑(qh) '' OpenLatticeEdge x y) (T : + ProtoTile) : + (NoChord) T ↔ (NoChord) (TileQuarterTurn T) := by + classical + let NoChord (T : ProtoTile) : Prop := + ∀ x y, FourNeighborAdjacent x y → + x ∈ BoundaryFootprintVertices T → y ∈ BoundaryFootprintVertices T → + ¬ OpenLatticeEdge x y ⊆ interior (TileRealization T) + let q : Real × Real → Real × Real := fun p => (-p.2, p.1) + let qh : (Real × Real) ≃ₜ (Real × Real) := { + toEquiv := { + toFun := q + invFun := fun p => (p.2, -p.1) + left_inv := by intro p; simp [q] + right_inv := by intro p; simp [q] + } + continuous_toFun := by + exact Continuous.prodMk (continuous_neg.comp continuous_snd) continuous_fst + continuous_invFun := by + exact Continuous.prodMk continuous_snd (continuous_neg.comp continuous_fst) + } + change (∀ (T U : ProtoTile) (f : GaussianInt → GaussianInt) (H : ℝ × ℝ ≃ₜ ℝ × ℝ), + BoundaryFootprintVertices U = f '' BoundaryFootprintVertices T → + (∀ (x y : LatticeCell), FourNeighborAdjacent x y ↔ FourNeighborAdjacent (f x) (f y)) → + (∀ (x y : GaussianInt), OpenLatticeEdge (f x) (f y) = ⇑H '' OpenLatticeEdge x y) → + TileRealization U = ⇑H '' TileRealization T → (NoChord T ↔ NoChord U)) at transport + change (∀ (x y : GaussianInt), OpenLatticeEdge (GaussianQuarterTurn x) (GaussianQuarterTurn y) + = ⇑qh '' OpenLatticeEdge x y) at qedge + change (NoChord T ↔ NoChord (TileQuarterTurn T)) + apply transport T (TileQuarterTurn T) GaussianQuarterTurn qh + · exact (TileQuarterTurnFormulas T).2.2.2.2.2.2.2.1 + · exact qadj + · exact qedge + · exact (TileQuarterTurnFormulas T).2.2.2.1 + +private theorem rturn (transport : ∀ (T U : ProtoTile) (f : GaussianInt → GaussianInt) (H : ℝ × ℝ + ≃ₜ ℝ × ℝ), + BoundaryFootprintVertices U = f '' BoundaryFootprintVertices T → + (∀ (x y : LatticeCell), FourNeighborAdjacent x y ↔ FourNeighborAdjacent (f x) (f y)) → + (∀ (x y : GaussianInt), OpenLatticeEdge (f x) (f y) = ⇑H '' OpenLatticeEdge x y) → + TileRealization U = ⇑H '' TileRealization T → ((NoChord) T ↔ (NoChord) U)) (radj : ∀ (x y + : GaussianInt), FourNeighborAdjacent x y ↔ FourNeighborAdjacent (GaussianReflection + x) (GaussianReflection y)) (redge : ∀ (x y : GaussianInt), OpenLatticeEdge + (GaussianReflection x) (GaussianReflection y) = ⇑(rh) '' OpenLatticeEdge x y) (T : + ProtoTile) : + (NoChord) T ↔ (NoChord) (TileReflection T) := by + classical + let NoChord (T : ProtoTile) : Prop := + ∀ x y, FourNeighborAdjacent x y → + x ∈ BoundaryFootprintVertices T → y ∈ BoundaryFootprintVertices T → + ¬ OpenLatticeEdge x y ⊆ interior (TileRealization T) + let r : Real × Real → Real × Real := fun p => (p.1, -p.2) + let rh : (Real × Real) ≃ₜ (Real × Real) := { + toEquiv := { + toFun := r + invFun := r + left_inv := by intro p; simp [r] + right_inv := by intro p; simp [r] + } + continuous_toFun := by + exact Continuous.prodMk continuous_fst (continuous_neg.comp continuous_snd) + continuous_invFun := by + exact Continuous.prodMk continuous_fst (continuous_neg.comp continuous_snd) + } + change (∀ (T U : ProtoTile) (f : GaussianInt → GaussianInt) (H : ℝ × ℝ ≃ₜ ℝ × ℝ), + BoundaryFootprintVertices U = f '' BoundaryFootprintVertices T → + (∀ (x y : LatticeCell), FourNeighborAdjacent x y ↔ FourNeighborAdjacent (f x) (f y)) → + (∀ (x y : GaussianInt), OpenLatticeEdge (f x) (f y) = ⇑H '' OpenLatticeEdge x y) → + TileRealization U = ⇑H '' TileRealization T → (NoChord T ↔ NoChord U)) at transport + change (∀ (x y : GaussianInt), OpenLatticeEdge (GaussianReflection x) (GaussianReflection y) = + ⇑rh '' OpenLatticeEdge x y) at redge + change (NoChord T ↔ NoChord (TileReflection T)) + apply transport T (TileReflection T) GaussianReflection rh + · exact (TileReflectionFormulas T).2.2.2.2.2.2.2.1 + · exact radj + · exact redge + · exact (TileReflectionFormulas T).2.2.2.1 + +end PackingChordConstruction + +theorem P4456T2PackingNoChord (g : BandPackingSymmetry) (T : ProtoTile) : + (∀ x y, FourNeighborAdjacent x y → + x ∈ BoundaryFootprintVertices T → y ∈ BoundaryFootprintVertices T → + ¬ OpenLatticeEdge x y ⊆ interior (TileRealization T)) ↔ + (∀ x y, FourNeighborAdjacent x y → + x ∈ BoundaryFootprintVertices (BandPackingSymmetryTileAction g T) → + y ∈ BoundaryFootprintVertices (BandPackingSymmetryTileAction g T) → + ¬ OpenLatticeEdge x y ⊆ + interior (TileRealization (BandPackingSymmetryTileAction g T))) := by +-- BODY + let NoChord (T : ProtoTile) : Prop := + ∀ x y, FourNeighborAdjacent x y → + x ∈ BoundaryFootprintVertices T → y ∈ BoundaryFootprintVertices T → + ¬ OpenLatticeEdge x y ⊆ interior (TileRealization T) + let q : Real × Real → Real × Real := fun p => (-p.2, p.1) + let r : Real × Real → Real × Real := fun p => (p.1, -p.2) + let qh : (Real × Real) ≃ₜ (Real × Real) := { + toEquiv := { + toFun := q + invFun := fun p => (p.2, -p.1) + left_inv := by intro p; simp [q] + right_inv := by intro p; simp [q] + } + continuous_toFun := by + exact Continuous.prodMk (continuous_neg.comp continuous_snd) continuous_fst + continuous_invFun := by + exact Continuous.prodMk continuous_snd (continuous_neg.comp continuous_fst) + } + let rh : (Real × Real) ≃ₜ (Real × Real) := { + toEquiv := { + toFun := r + invFun := r + left_inv := by intro p; simp [r] + right_inv := by intro p; simp [r] + } + continuous_toFun := by + exact Continuous.prodMk continuous_fst (continuous_neg.comp continuous_snd) + continuous_invFun := by + exact Continuous.prodMk continuous_fst (continuous_neg.comp continuous_snd) + } + have transport (T U : ProtoTile) (f : GaussianInt → GaussianInt) + (H : (Real × Real) ≃ₜ (Real × Real)) + (hb : BoundaryFootprintVertices U = f '' BoundaryFootprintVertices T) + (ha : ∀ x y, FourNeighborAdjacent x y ↔ + FourNeighborAdjacent (f x) (f y)) + (he : ∀ x y, OpenLatticeEdge (f x) (f y) = + H '' OpenLatticeEdge x y) + (hr : TileRealization U = H '' TileRealization T) : + NoChord T ↔ NoChord U := PackingChordConstruction.transport T U f H hb ha he hr + have qadj (x y : GaussianInt) : + FourNeighborAdjacent x y ↔ + FourNeighborAdjacent (GaussianQuarterTurn x) (GaussianQuarterTurn y) := + PackingChordConstruction.qadj x y + have radj (x y : GaussianInt) : + FourNeighborAdjacent x y ↔ + FourNeighborAdjacent (GaussianReflection x) (GaussianReflection y) := + PackingChordConstruction.radj x y + have qedge (x y : GaussianInt) : + OpenLatticeEdge (GaussianQuarterTurn x) (GaussianQuarterTurn y) = + qh '' OpenLatticeEdge x y := PackingChordConstruction.qedge x y + have redge (x y : GaussianInt) : + OpenLatticeEdge (GaussianReflection x) (GaussianReflection y) = + rh '' OpenLatticeEdge x y := PackingChordConstruction.redge x y + have qturn (T : ProtoTile) : + NoChord T ↔ NoChord (TileQuarterTurn T) := PackingChordConstruction.qturn transport qadj + qedge T + have rturn (T : ProtoTile) : + NoChord T ↔ NoChord (TileReflection T) := PackingChordConstruction.rturn transport radj + redge T + change NoChord T ↔ NoChord (BandPackingSymmetryTileAction g T) + induction g generalizing T with + | identity => simp [BandPackingSymmetryTileAction] + | shift w => simp [BandPackingSymmetryTileAction] + | negate => exact qturn T + | conjugate => + change NoChord T ↔ NoChord + (TileQuarterTurn (TileQuarterTurn (TileReflection T))) + exact (rturn T).trans ((qturn (TileReflection T)).trans + (qturn (TileQuarterTurn (TileReflection T)))) + | comp g h ihg ihh => + change NoChord T ↔ NoChord + (BandPackingSymmetryTileAction g (BandPackingSymmetryTileAction h T)) + exact (ihh T).trans (ihg (BandPackingSymmetryTileAction h T)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2ParentSide.lean b/LeanPool/ApollonianSuperharmonic/P4456T2ParentSide.lean new file mode 100644 index 0000000000..1e1b4c92b7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4456T2ParentSide.lean @@ -0,0 +1,188 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells +public import LeanPool.ApollonianSuperharmonic.P4456T2EdgeInterior +public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected + +-- [TABLET NODE: P4456T2ParentSide] + +/-! +# P4456T2ParentSide + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4456T2ParentSide (T U : ProtoTile) + (hT : LatticeTile T) (hU : LatticeTile U) (hsub : U.cells ⊆ T.cells) + (x y : GaussianInt) (hxy : FourNeighborAdjacent x y) + (hx : x ∈ BoundaryFootprintVertices T) + (hy : y ∈ BoundaryFootprintVertices T) + (side : GaussianInt → Int) + (hstep : ∀ c ∈ T.cells, ∀ d ∈ T.cells, c ≠ d → + ∀ f ∈ FootprintEdges (⟨{c}, c⟩ : ProtoTile) ∩ + FootprintEdges (⟨{d}, d⟩ : ProtoTile), side c ≠ side d → f = {x, y}) + (hnochord : ∀ u v, FourNeighborAdjacent u v → + u ∈ BoundaryFootprintVertices U → v ∈ BoundaryFootprintVertices U → + ¬ OpenLatticeEdge u v ⊆ interior (TileRealization U)) : + ∃ k : Int, ∀ c ∈ U.cells, side c = k := by +-- BODY + classical + have hneT : T.cells.Nonempty := (LatticeTileFourNeighborConnected T hT).1 + have hneU : U.cells.Nonempty := (LatticeTileFourNeighborConnected U hU).1 + have adjacent_equal : ∀ c ∈ U.cells, ∀ d ∈ U.cells, + FourNeighborAdjacent c d → side c = side d := by + intro c hc d hd hcd + have hct : c ∈ T.cells := hsub hc + have hdt : d ∈ T.cells := hsub hd + have hne : c ≠ d := by + intro h + subst d + rcases hcd with h | h | h | h <;> simp [Zsqrtd.ext_iff] at h <;> omega + have change_impossible (f : Finset GaussianInt) + (hfc : f ∈ FootprintEdges (⟨{c}, c⟩ : ProtoTile)) + (hfd : f ∈ FootprintEdges (⟨{d}, d⟩ : ProtoTile)) + (hfeq : f = {x, y}) (hlabels : side c ≠ side d) : False := by + have hf : f ∈ FootprintEdges (⟨{c}, c⟩ : ProtoTile) ∩ + FootprintEdges (⟨{d}, d⟩ : ProtoTile) := ⟨hfc, hfd⟩ + have hab : {x, y} ∈ FootprintEdges (⟨{c}, c⟩ : ProtoTile) := by + rw [← hfeq] + exact hfc + have habD : {x, y} ∈ FootprintEdges (⟨{d}, d⟩ : ProtoTile) := by + rw [← hfeq] + exact hfd + have hcdedge : OpenLatticeEdge x y ⊆ interior (TileRealization U) := by + exact (P4456T2EdgeInterior U x y c d hxy hne hab habD).2 ⟨hc, hd⟩ + rcases P4397T1UnitEdgeCells.1 x y hxy with ⟨z, w, hform⟩ + have unitU := P4397T1UnitEdgeCells.2 x y z w hform U + have hoccU : z ∈ U.cells ∨ w ∈ U.cells := by + have unitC := P4397T1UnitEdgeCells.2 x y z w hform (⟨{c}, c⟩ : ProtoTile) + have hoccC : z ∈ ({c} : Finset GaussianInt) ∨ w ∈ ({c} : Finset GaussianInt) := + unitC.1.mp hab + rcases hoccC with hz | hw + · have : z = c := Finset.mem_singleton.mp hz + subst z + exact Or.inl hc + · have : w = c := Finset.mem_singleton.mp hw + subst w + exact Or.inr hc + have hvertices := unitU.2.2.1 hoccU + have hxUfoot : x ∈ FootprintVertices U := hvertices.1 + have hyUfoot : y ∈ FootprintVertices U := hvertices.2.1 + have hxTfoot : x ∈ FootprintVertices T := by + simp only [FootprintVertices, ite_eq_left hneU] at hxUfoot + simp only [FootprintVertices, ite_eq_left hneT] + rcases hxUfoot with ⟨q, hq, hcorner⟩ + exact ⟨q, hsub hq, hcorner⟩ + have hyTfoot : y ∈ FootprintVertices T := by + simp only [FootprintVertices, ite_eq_left hneU] at hyUfoot + simp only [FootprintVertices, ite_eq_left hneT] + rcases hyUfoot with ⟨q, hq, hcorner⟩ + exact ⟨q, hsub hq, hcorner⟩ + have hxU : x ∈ BoundaryFootprintVertices U := by + have hnotall : ¬ ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells := by + intro hall + have hallT : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells := + fun j => hsub (hall j) + have hxnot : x ∉ BoundaryFootprintVertices T := + (P4456T2VertexInterior T hneT x hxTfoot).2.mpr hallT + exact hxnot hx + by_contra hbound + exact hnotall ((P4456T2VertexInterior U hneU x hxUfoot).2.mp hbound) + have hyU : y ∈ BoundaryFootprintVertices U := by + have hnotall : ¬ ∀ j : Fin 4, LatticeVertexIncidentCell y j ∈ U.cells := by + intro hall + have hallT : ∀ j : Fin 4, LatticeVertexIncidentCell y j ∈ T.cells := + fun j => hsub (hall j) + have hynot : y ∉ BoundaryFootprintVertices T := + (P4456T2VertexInterior T hneT y hyTfoot).2.mpr hallT + exact hynot hy + by_contra hbound + exact hnotall ((P4456T2VertexInterior U hneU y hyUfoot).2.mp hbound) + exact hnochord x y hxy hxU hyU hcdedge + change d = c + 1 ∨ d = c - 1 ∨ d = c + ⟨0, 1⟩ ∨ d = c - ⟨0, 1⟩ at hcd + rcases hcd with hdir | hdir | hdir | hdir + · let f : Finset GaussianInt := {c + 1, c + 1 + ⟨0, 1⟩} + have hfc : f ∈ FootprintEdges (⟨{c}, c⟩ : ProtoTile) := by + simp [f, FootprintEdges, add_assoc] + have hfd : f ∈ FootprintEdges (⟨{d}, d⟩ : ProtoTile) := by + subst d + simp [f, FootprintEdges, add_assoc, add_comm, add_left_comm] + by_cases hlabels : side c = side d + · exact hlabels + · have hfeq : f = {x, y} := by + apply hstep c hct d hdt hne f ⟨hfc, hfd⟩ hlabels + exact False.elim (change_impossible f hfc hfd hfeq hlabels) + · let f : Finset GaussianInt := {c, c + ⟨0, 1⟩} + have hfc : f ∈ FootprintEdges (⟨{c}, c⟩ : ProtoTile) := by + simp [f, FootprintEdges] + have hfd : f ∈ FootprintEdges (⟨{d}, d⟩ : ProtoTile) := by + subst d + simp [f, FootprintEdges, sub_eq_add_neg, add_assoc] + by_cases hlabels : side c = side d + · exact hlabels + · have hfeq : f = {x, y} := by + apply hstep c hct d hdt hne f ⟨hfc, hfd⟩ hlabels + exact False.elim (change_impossible f hfc hfd hfeq hlabels) + · let f : Finset GaussianInt := {c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩} + have hfc : f ∈ FootprintEdges (⟨{c}, c⟩ : ProtoTile) := by + simp [f, FootprintEdges, add_assoc] + have hfd : f ∈ FootprintEdges (⟨{d}, d⟩ : ProtoTile) := by + subst d + simp [f, FootprintEdges, add_assoc, add_comm, add_left_comm] + by_cases hlabels : side c = side d + · exact hlabels + · have hfeq : f = {x, y} := by + apply hstep c hct d hdt hne f ⟨hfc, hfd⟩ hlabels + exact False.elim (change_impossible f hfc hfd hfeq hlabels) + · let f : Finset GaussianInt := {c, c + 1} + have hfc : f ∈ FootprintEdges (⟨{c}, c⟩ : ProtoTile) := by + simp [f, FootprintEdges] + have hfd : f ∈ FootprintEdges (⟨{d}, d⟩ : ProtoTile) := by + subst d + simp [f, FootprintEdges, sub_eq_add_neg, add_assoc] + by_cases hlabels : side c = side d + · exact hlabels + · have hfeq : f = {x, y} := by + apply hstep c hct d hdt hne f ⟨hfc, hfd⟩ hlabels + exact False.elim (change_impossible f hfc hfd hfeq hlabels) + obtain ⟨c₀, hc₀⟩ := hneU + refine ⟨side c₀, ?_⟩ + intro c hc + obtain ⟨p, hphead, hplast, hpinside, hpadj⟩ := + (LatticeTileFourNeighborConnected U hU).2 c₀ hc₀ c hc + have hchain : List.IsChain FourNeighborAdjacent p := by + rw [List.isChain_iff_forall_rel_of_append_cons_cons] + exact hpadj + have hlabels : List.IsChain (fun a b => side a = side b) p := + hchain.imp_of_mem_imp (fun a b ha hb hab => + adjacent_equal a (hpinside a ha) b (hpinside b hb) hab) + cases p with + | nil => simp at hphead + | cons a p => + have hac : a = c₀ := by simpa using Option.some.inj hphead + subst a + have hcmem : c ∈ c₀ :: p := by + rcases List.getLast?_eq_some_iff.mp hplast with ⟨l, hl⟩ + rw [hl] + simp + simp only [List.mem_cons] at hcmem + rcases hcmem with hcc | hcp + · simp [hcc] + · exact (hlabels.rel_cons hcp).symm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean b/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean new file mode 100644 index 0000000000..aead84a059 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean @@ -0,0 +1,911 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4456T2EdgeInterior +public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P4456T2SquareEdges] + +/-! +# P4456T2SquareEdges + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SquareEdgeProof + +private theorem hcell : + (by + classical + exact + ∀ (n : Nat), ∀ (w : GaussianInt), ∀ (T : ProtoTile), (T.cells = (TileTranslation + (FordTile n) + w).cells) → (((TileTranslation (FordTile n) w).cells = (FordCellDomain n).image + (GaussianTranslation w)) → (∀ (c : GaussianInt), c ∈ T.cells ↔ ∃ (a : ℕ) (b : ℕ), a < + n ∧ + b < n ∧ c = w + ⟨(↑a : ℤ), (↑b : ℤ)⟩)) ) := by + classical + intro n w T hcells htrans c + rw [hcells, htrans] + constructor + · intro hz + rcases Finset.mem_image.mp hz with ⟨z, hzdom, heq⟩ + rcases Finset.mem_image.mp hzdom with ⟨p, hp, hpz⟩ + rcases p with ⟨a, b⟩ + subst z + rcases Finset.mem_product.mp hp with ⟨ha, hb⟩ + have ha := Finset.mem_range.mp ha + have hb := Finset.mem_range.mp hb + have heq' : GaussianTranslation w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) = c := by simpa [GaussianTranslation] using heq + exact ⟨a, b, ha, hb, by simpa [GaussianTranslation, add_comm] using heq'.symm⟩ + · rintro ⟨a, b, ha, hb, hc⟩ + rw [hc] + apply Finset.mem_image.mpr + refine ⟨(⟨(a : Int), (b : Int)⟩ : GaussianInt), ?_, ?_⟩ + · apply Finset.mem_image.mpr + refine ⟨(a,b), Finset.mem_product.mpr ⟨Finset.mem_range.mpr ha, + Finset.mem_range.mpr hb⟩, rfl⟩ + · simp [GaussianTranslation, add_comm] + +private theorem hnonempty : + (by + classical + exact + ∀ (n : Nat), ((0 : ℕ) < n) → (∀ (w : GaussianInt), ∀ (T : ProtoTile), (T.cells = + (TileTranslation (FordTile n) w).cells) → (((TileTranslation (FordTile n) w).cells = + (FordCellDomain n).image (GaussianTranslation w)) → (T.cells.Nonempty))) ) := by + classical + intro n hn w T hcells htrans + rw [hcells, htrans] + apply Finset.image_nonempty.mpr + refine ⟨(⟨(0 : Int), (0 : Int)⟩ : GaussianInt), ?_⟩ + change (⟨(0 : Int), (0 : Int)⟩ : GaussianInt) ∈ + Finset.image (fun p : Nat × Nat => + (⟨(p.1 : Int), (p.2 : Int)⟩ : GaussianInt)) + ((Finset.range n).product (Finset.range n)) + apply Finset.mem_image.mpr + refine ⟨(0,0), Finset.mem_product.mpr ⟨?_, ?_⟩, rfl⟩ + · exact Finset.mem_range.mpr hn + · exact Finset.mem_range.mpr hn + +private theorem hvertex_coords : + (by + classical + exact + ∀ (n : Nat), ∀ (w : GaussianInt), ∀ (T : ProtoTile), (∀ (c : GaussianInt), c ∈ T.cells ↔ ∃ a + b : Nat, a < n ∧ b < n ∧ c = w + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) → + ((T.cells.Nonempty) → (∀ v ∈ FootprintVertices T, ∃ (a : ℕ) (b : ℕ), a ≤ n ∧ b ≤ n ∧ v = + w + ⟨(↑a : ℤ), (↑b : ℤ)⟩)) ) := by + classical + intro n w T hcell hnonempty v hv + unfold FootprintVertices at hv + rw [ite_eq_left hnonempty] at hv + rcases hv with ⟨c, hc, hcorner⟩ + rcases hcell c |>.mp hc with ⟨a,b,ha,hb,hcw⟩ + rcases hcorner with h | h | h | h + · subst v + refine ⟨a,b, Nat.le_of_lt ha, Nat.le_of_lt hb, ?_⟩ + simp [hcw] + · subst v + refine ⟨a+1,b, ?_, Nat.le_of_lt hb, ?_⟩ + · exact Nat.succ_le_of_lt ha + · rw [hcw] + apply Zsqrtd.ext <;> simp; ring + · subst v + refine ⟨a,b+1, Nat.le_of_lt ha, ?_, ?_⟩ + · exact Nat.succ_le_of_lt hb + · simp [hcw, add_assoc] + · subst v + refine ⟨a+1,b+1, Nat.succ_le_of_lt ha, Nat.succ_le_of_lt hb, ?_⟩ + rw [hcw] + apply Zsqrtd.ext <;> simp <;> ring + +private theorem hvertex_box : + (by + classical + exact + ∀ (n : Nat), ∀ (w : GaussianInt), ∀ (T : ProtoTile), (∀ (c : GaussianInt), c ∈ T.cells ↔ ∃ a + b : Nat, a < n ∧ b < n ∧ c = w + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) → + ((T.cells.Nonempty) → (∀ v ∈ FootprintVertices T, w.re ≤ v.re ∧ v.re ≤ w.re + (↑n : ℤ) ∧ + w.im ≤ v.im ∧ v.im ≤ w.im + (↑n : ℤ))) ) := by + classical + intro n w T hcell hnonempty v hv + unfold FootprintVertices at hv + rw [ite_eq_left hnonempty] at hv + rcases hv with ⟨c, hc, hcorner⟩ + rcases hcell c |>.mp hc with ⟨a,b,ha,hb,hcw⟩ + rcases hcorner with h | h | h | h + all_goals + subst v + rw [hcw] at * + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] + norm_num + have ha' : (a : Int) < n := by exact_mod_cast ha + have hb' : (b : Int) < n := by exact_mod_cast hb + omega + +private theorem hstarCoords : + (by + classical + exact + ∀ (n : Nat), ∀ (w : GaussianInt), ∀ (T : ProtoTile), (∀ (c : GaussianInt), c ∈ T.cells ↔ ∃ a + b : Nat, a < n ∧ b < n ∧ c = w + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) → (∀ (a : + ℕ), ∀ (b : ℕ), (0 : ℕ) < a → a < n → (0 : ℕ) < b → b < n → ∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell (w + ⟨(↑a : ℤ), (↑b : ℤ)⟩) j ∈ T.cells) ) := by + classical + intro n w T hcell a b ha0 haN hb0 hbN + let p : GaussianInt := w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) + have hmem (u v : Nat) (hu : u < n) (hv : v < n) : + w + (⟨(u : Int), (v : Int)⟩ : GaussianInt) ∈ T.cells := by + exact (hcell _).2 ⟨u, v, hu, hv, rfl⟩ + have hA : p - 1 = w + (⟨((a - 1 : Nat) : Int), (b : Int)⟩ : GaussianInt) := by + apply Zsqrtd.ext <;> simp [p]; omega + have hAB : p - 1 - ⟨0,1⟩ = + w + (⟨((a - 1 : Nat) : Int), ((b - 1 : Nat) : Int)⟩ : GaussianInt) := by + apply Zsqrtd.ext <;> simp [p] <;> omega + have hB : p - ⟨0,1⟩ = + w + (⟨(a : Int), ((b - 1 : Nat) : Int)⟩ : GaussianInt) := by + apply Zsqrtd.ext <;> simp [p]; omega + intro j + fin_cases j + · simpa [LatticeVertexIncidentCell, p] using hmem a b haN hbN + · rw [LatticeVertexIncidentCell, hA] + exact hmem (a-1) b (by omega) hbN + · rw [LatticeVertexIncidentCell, hAB] + exact hmem (a-1) (b-1) (by omega) (by omega) + · rw [LatticeVertexIncidentCell, hB] + exact hmem a (b-1) haN (by omega) + +private theorem hEdgeH : + (by + classical + exact + ∀ (n : Nat), ((0 : ℕ) < n) → (∀ (w : GaussianInt), ∀ (T : ProtoTile), (∀ (a : Nat), ∀ (b + : Nat), (a < n) → ((b < n) → (w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) ∈ T.cells))) + → (∀ (a : ℕ), ∀ (b : ℕ), a < n → b ≤ n → {w + ⟨(↑a : ℤ), (↑b : ℤ)⟩, w + ⟨(↑(a + (1 : + ℕ)) : ℤ), + (↑b : ℤ)⟩} ∈ FootprintEdges T)) ) := by + classical + intro n hn w T hmem a b ha hb + change ∃ c ∈ T.cells, + ({w + (⟨(a : Int), (b : Int)⟩ : GaussianInt), + w + (⟨((a+1 : Nat) : Int), (b : Int)⟩ : GaussianInt)} : Finset GaussianInt) = + {c, c + 1} ∨ _ = {c, c + ⟨0,1⟩} ∨ + _ = {c+1, c+1+⟨0,1⟩} ∨ _ = {c+⟨0,1⟩, c+1+⟨0,1⟩} + by_cases hb' : b < n + · refine ⟨w + (⟨(a : Int), (b : Int)⟩ : GaussianInt), hmem a b ha hb', Or.inl ?_⟩ + apply Finset.ext + intro q + simp only [Finset.mem_insert, Finset.mem_singleton] + apply Iff.intro + · rintro (rfl | rfl) <;> simp [Zsqrtd.ext_iff]; omega + · rintro (rfl | rfl) <;> simp [Zsqrtd.ext_iff]; omega + · have hb'lt : b = n := by omega + let c : GaussianInt := w + (⟨(a : Int), ((b-1 : Nat) : Int)⟩ : GaussianInt) + have hc : c ∈ T.cells := by + apply hmem + · exact ha + · omega + refine ⟨c, hc, Or.inr (Or.inr (Or.inr ?_))⟩ + apply Finset.ext + intro q + simp only [Finset.mem_insert, Finset.mem_singleton] + constructor + · rintro (rfl | rfl) <;> simp [c, hb'lt, Zsqrtd.ext_iff] <;> omega + · rintro (rfl | rfl) <;> simp [c, hb'lt, Zsqrtd.ext_iff] <;> omega + +private theorem hEdgeV : + (by + classical + exact + ∀ (n : Nat), ((0 : ℕ) < n) → (∀ (w : GaussianInt), ∀ (T : ProtoTile), (∀ (a : Nat), ∀ (b + : Nat), (a < n) → ((b < n) → (w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) ∈ T.cells))) + → (∀ (a : ℕ), ∀ (b : ℕ), a ≤ n → b < n → {w + ⟨(↑a : ℤ), (↑b : ℤ)⟩, w + ⟨(↑a : ℤ), + (↑(b + (1 : ℕ)) : ℤ)⟩} ∈ FootprintEdges T)) ) := by + classical + intro n hn w T hmem a b ha hb + change ∃ c ∈ T.cells, + ({w + (⟨(a : Int), (b : Int)⟩ : GaussianInt), + w + (⟨(a : Int), ((b+1 : Nat) : Int)⟩ : GaussianInt)} : Finset GaussianInt) = + {c, c + 1} ∨ _ = {c, c + ⟨0,1⟩} ∨ + _ = {c+1, c+1+⟨0,1⟩} ∨ _ = {c+⟨0,1⟩, c+1+⟨0,1⟩} + by_cases ha' : a < n + · refine ⟨w + (⟨(a : Int), (b : Int)⟩ : GaussianInt), hmem a b ha' hb, Or.inr (Or.inl ?_)⟩ + apply Finset.ext + intro q + simp only [Finset.mem_insert, Finset.mem_singleton] + constructor + · rintro (rfl | rfl) <;> simp [Zsqrtd.ext_iff]; omega + · rintro (rfl | rfl) <;> simp [Zsqrtd.ext_iff]; omega + · have ha'lt : a = n := by omega + let c : GaussianInt := w + (⟨((a-1 : Nat) : Int), (b : Int)⟩ : GaussianInt) + have hc : c ∈ T.cells := by + apply hmem + · omega + · exact hb + refine ⟨c, hc, Or.inr (Or.inr (Or.inl ?_))⟩ + apply Finset.ext + intro q + simp only [Finset.mem_insert, Finset.mem_singleton] + constructor + · rintro (rfl | rfl) <;> simp [c, ha'lt, Zsqrtd.ext_iff] <;> omega + · rintro (rfl | rfl) <;> simp [c, ha'lt, Zsqrtd.ext_iff] <;> omega + +private theorem hzv : + (by + classical + exact + ∀ (x : LatticeCell), ∀ (y : LatticeCell), ∀ (z : GaussianInt), ∀ (v : GaussianInt), ((x = + z + + (1 : GaussianInt) ∧ y = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = z + (1 : + GaussianInt) ∧ x = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∧ v = z + (1 : + GaussianInt) ∨ (x = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ y = z + ⟨(0 : ℤ), (1 : + ℤ)⟩ ∨ y = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ x = z + ⟨(0 : ℤ), (1 : ℤ)⟩) ∧ v = + z + ⟨(0 : ℤ), (1 : ℤ)⟩) → (z ≠ v) ) := by + classical + intro x y z v hform heq + rcases hform with ⟨_, hvform⟩ | ⟨_, hvform⟩ + · rw [hvform] at heq + have heq' : z + 0 = z + 1 := by simp at heq + have hzero : (0 : GaussianInt) = 1 := add_left_cancel heq' + norm_num at hzero + · rw [hvform] at heq + have heq' : z + 0 = z + ⟨0,1⟩ := by simpa using heq + have hzero : (0 : GaussianInt) = ⟨0,1⟩ := add_left_cancel heq' + have hr := congrArg Zsqrtd.im hzero + norm_num at hr + +private theorem hcoordsAt320 : + (by + classical + exact + (Nat) → (∀ (w : GaussianInt), ∀ (z : GaussianInt), ∀ (v : GaussianInt), ∀ (a : ℕ), ∀ (b : + ℕ), (z = w + ⟨(↑a : ℤ), (↑b : ℤ)⟩) → (∀ (c : ℕ), ∀ (d : ℕ), (v = w + ⟨(↑c : ℤ), (↑d : + ℤ)⟩) → + ((v = z + (1 : GaussianInt)) → (c = a + 1 ∧ d = b)))) ) := by + classical + intro n w z v a b hza c d hvc hvform + have heq' : w + (⟨(c : Int), (d : Int)⟩ : GaussianInt) = z + 1 := by + rw [← hvc, hvform] + rw [hza] at heq' + have heq := congrArg Zsqrtd.re heq' + have him := congrArg Zsqrtd.im heq' + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] at heq him + norm_num at heq him + constructor <;> omega + +private theorem hcoordsAt367 : + (by + classical + exact + (Nat) → (∀ (w : GaussianInt), ∀ (z : GaussianInt), ∀ (v : GaussianInt), ∀ (a : ℕ), ∀ (b : + ℕ), (z = w + ⟨(↑a : ℤ), (↑b : ℤ)⟩) → (∀ (c : ℕ), ∀ (d : ℕ), (v = w + ⟨(↑c : ℤ), (↑d : + ℤ)⟩) → + ((v = z + ⟨(0 : ℤ), (1 : ℤ)⟩) → (c = a ∧ d = b + 1)))) ) := by + classical + intro n w z v a b hza c d hvc hvform + have heq' : w + (⟨(c : Int), (d : Int)⟩ : GaussianInt) = z + ⟨0,1⟩ := by + rw [← hvc, hvform] + rw [hza] at heq' + have heq := congrArg Zsqrtd.re heq' + have him := congrArg Zsqrtd.im heq' + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] at heq him + norm_num at heq him + constructor <;> omega + +end SquareEdgeProof + +namespace SquareEdgeDetails + +private theorem htrans : + (by + classical + exact + ∀ (n : Nat), ∀ (w : GaussianInt), (TileTranslation (FordTile n) w).cells = + (FordCellDomain n).image (GaussianTranslation w) ) := by + classical + intro n w + exact (TileTranslationFormulas (FordTile n) w).1 + +private theorem hmem : + (by + classical + exact + ∀ (n : Nat), ∀ (w : GaussianInt), ∀ (T : ProtoTile), (∀ (c : GaussianInt), c ∈ T.cells ↔ + ∃ a b : Nat, a < n ∧ b < n ∧ c = w + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) → (∀ (a + : ℕ), ∀ (b : ℕ), a < n → b < n → w + ⟨(↑a : ℤ), (↑b : ℤ)⟩ ∈ T.cells) ) := by + classical + intro n w T hcell a b ha hb + exact (hcell _).2 ⟨a, b, ha, hb, rfl⟩ + +private theorem hAedge : + (by + classical + exact + ∀ (x : LatticeCell), ∀ (y : LatticeCell), ∀ (z : GaussianInt), ∀ (v : GaussianInt), ((x = + z + (1 : GaussianInt) ∧ y = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = z + (1 : + GaussianInt) ∧ x = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∧ v = z + (1 : + GaussianInt) ∨ (x = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ y = z + ⟨(0 : ℤ), (1 + : ℤ)⟩ ∨ y = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ x = z + ⟨(0 : ℤ), (1 : ℤ)⟩) + ∧ v = z + ⟨(0 : ℤ), (1 : ℤ)⟩) → ( + let A : ProtoTile := ⟨{z}, z⟩ + ({x,y} : Finset GaussianInt) ∈ FootprintEdges A) ) := by + classical + intro x y z v hform A + have h := (P4397T1UnitEdgeCells.2 x y z v hform A).1 + apply h.mpr + simp [A] + +private theorem hBedge : + (by + classical + exact + ∀ (x : LatticeCell), ∀ (y : LatticeCell), ∀ (z : GaussianInt), ∀ (v : GaussianInt), ((x = + z + (1 : GaussianInt) ∧ y = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = z + (1 : + GaussianInt) ∧ x = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∧ v = z + (1 : + GaussianInt) ∨ (x = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ y = z + ⟨(0 : ℤ), (1 + : ℤ)⟩ ∨ y = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ x = z + ⟨(0 : ℤ), (1 : ℤ)⟩) + ∧ v = z + ⟨(0 : ℤ), (1 : ℤ)⟩) → ( + let B : ProtoTile := ⟨{v}, v⟩ + ({x,y} : Finset GaussianInt) ∈ FootprintEdges B) ) := by + classical + intro x y z v hform B + have h := (P4397T1UnitEdgeCells.2 x y z v hform B).1 + apply h.mpr + simp [B] + +private theorem hpcoordsAt429 : + (by + classical + exact + ∀ (w : GaussianInt), ∀ (z : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), (z = w + ⟨(↑a : ℤ), (↑b : + ℤ)⟩) → ( + let pa : Nat := a + 1 + let p : GaussianInt := if 0 < b then z + 1 else z + 1 + ⟨0,1⟩ + let pb : Nat := if 0 < b then b else b + 1 + p = w + (⟨(pa : Int), (pb : Int)⟩ : GaussianInt)) ) := by + classical + intro w z a b hza pa p pb + dsimp [p, pa, pb] + split_ifs <;> rw [hza] <;> apply Zsqrtd.ext <;> simp <;> ring + +private theorem hcoordsNAt432 : + (by + classical + exact + ∀ (n : Nat), ((0 : ℕ) < n) → (∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), ∀ (d : ℕ), (c < n) → ((c = + a + 1 ∧ d = b) → (1 < n))) ) := by + classical + intro n hn a b c d hc hcoords + have hc' : (c : Int) < n := by exact_mod_cast hc + rw [hcoords.1] at hc' + omega + +private theorem hpstrictAt436 : + (by + classical + exact + ∀ (n : Nat), ∀ (a : ℕ), ∀ (b : ℕ), (b < n) → (∀ (c : ℕ), ∀ (d : ℕ), (c < n) → ((c = a + 1 + ∧ d = b) → ( + let pa : Nat := a + 1 + let pb : Nat := if 0 < b then b else b + 1 + (1 < n) → (0 < pa ∧ pa < n ∧ 0 < pb ∧ pb < n)))) ) := by + classical + intro n a b hb c d hc hcoords pa pb hcoordsN + dsimp [pa, pb] + split_ifs <;> omega + +private theorem hpIsEndAt439 : + (by + classical + exact + ∀ (x : LatticeCell), ∀ (y : LatticeCell), ∀ (z : GaussianInt), ∀ (b : ℕ), (x = z + (1 : + GaussianInt) ∧ y = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = z + (1 : + GaussianInt) ∧ x = z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) → ( + let p : GaussianInt := if 0 < b then z + 1 else z + 1 + ⟨0,1⟩ + p = x ∨ p = y) ) := by + classical + intro x y z b hor p + rcases hor with ⟨hx, hy⟩ | ⟨hy, hx⟩ + · dsimp [p] + split_ifs with hbpos <;> simp [hx, hy] + · dsimp [p] + split_ifs with hbpos <;> simp [hx, hy] + +private theorem hpFootAt445 : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : LatticeCell), ∀ (y : LatticeCell), ∀ (z : GaussianInt), ∀ (v : + GaussianInt), (({x, y} ∈ FootprintEdges T ↔ z ∈ T.cells ∨ v ∈ T.cells) ∧ ({x, y} ∈ + BoundaryFootprintEdges T ↔ z ∈ T.cells ∧ v ∉ T.cells ∨ z ∉ T.cells ∧ v ∈ T.cells) ∧ + (z ∈ T.cells ∨ v ∈ T.cells → x ∈ FootprintVertices T ∧ y ∈ FootprintVertices T ∧ ∀ (t + : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (((1 : ℝ) - (↑t : ℝ)) * (↑x.re : ℝ) + (↑t : + ℝ) * (↑y.re : ℝ), ((1 : ℝ) - (↑t : ℝ)) * (↑x.im : ℝ) + (↑t : ℝ) * (↑y.im : ℝ)) ∈ + TileRealization T) ∧ (z ∈ T.cells ∧ v ∈ T.cells → OpenLatticeEdge x y ⊆ interior + (TileRealization T)) ∧ ((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ + T.cells) → z ∈ T.cells ∧ v ∈ T.cells)) → ((z ∈ T.cells) → (∀ (b : ℕ), + let p : GaussianInt := if 0 < b then z + 1 else z + 1 + ⟨0,1⟩ + (p = x ∨ p = y) → (p ∈ FootprintVertices T))) ) := by + classical + intro T x y z v hedgeInfo hz b p hpIsEnd + have hends := hedgeInfo.2.2.1 (Or.inl hz) + rcases hpIsEnd with h | h + · rw [h] + exact hends.1 + · rw [h] + exact hends.2.1 + +private theorem hstarAt452 : + (by + classical + exact + ∀ (n : Nat), ∀ (w : GaussianInt), ∀ (T : ProtoTile), (∀ (a : Nat), ∀ (b : Nat), (0 < a) → + ((a < n) → ((0 < b) → ((b < n) → (∀ j : Fin 4, LatticeVertexIncidentCell (w + (⟨(a : + Int), (b : Int)⟩ : GaussianInt)) j ∈ T.cells))))) → (∀ (z : GaussianInt), ∀ (a : ℕ), + ∀ (b : ℕ), + let pa : Nat := a + 1 + let p : GaussianInt := if 0 < b then z + 1 else z + 1 + ⟨0,1⟩ + let pb : Nat := if 0 < b then b else b + 1 + (p = w + (⟨(pa : Int), (pb : Int)⟩ : GaussianInt)) → ((0 < pa ∧ pa < n ∧ 0 < pb ∧ pb < n) + → (∀ j : Fin 4, LatticeVertexIncidentCell p j ∈ T.cells))) ) := by + classical + intro n w T hstarCoords z a b pa p pb hpcoords hpstrict + have hs := hstarCoords pa pb hpstrict.1 hpstrict.2.1 + hpstrict.2.2.1 hpstrict.2.2.2 + simpa [hpcoords] using hs + +private theorem hpcoordsAt468 : + (by + classical + exact + ∀ (w : GaussianInt), ∀ (z : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), (z = w + ⟨(↑a : ℤ), (↑b : + ℤ)⟩) → ( + let pa : Nat := if 0 < a then a else a + 1 + let pb : Nat := b + 1 + let p : GaussianInt := if 0 < a then z + ⟨0,1⟩ else z + 1 + ⟨0,1⟩ + p = w + (⟨(pa : Int), (pb : Int)⟩ : GaussianInt)) ) := by + classical + intro w z a b hza pa pb p + dsimp [p, pa, pb] + split_ifs <;> rw [hza] <;> apply Zsqrtd.ext <;> simp <;> ring + +private theorem hcoordsNAt471 : + (by + classical + exact + ∀ (n : Nat), ((0 : ℕ) < n) → (∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), ∀ (d : ℕ), (d < n) → ((c = + a ∧ d = b + 1) → (1 < n))) ) := by + classical + intro n hn a b c d hd hcoords + have hd' : (d : Int) < n := by exact_mod_cast hd + rw [hcoords.2] at hd' + omega + +private theorem hpstrictAt475 : + (by + classical + exact + ∀ (n : Nat), ∀ (a : ℕ), ∀ (b : ℕ), (a < n) → (∀ (c : ℕ), ∀ (d : ℕ), (d < n) → ((c = a ∧ d + = b + 1) → ( + let pa : Nat := if 0 < a then a else a + 1 + let pb : Nat := b + 1 + (1 < n) → (0 < pa ∧ pa < n ∧ 0 < pb ∧ pb < n)))) ) := by + classical + intro n a b ha c d hd hcoords pa pb hcoordsN + dsimp [pa, pb] + split_ifs <;> omega + +private theorem hpIsEndAt478 : + (by + classical + exact + ∀ (x : LatticeCell), ∀ (y : LatticeCell), ∀ (z : GaussianInt), ∀ (a : ℕ), (x = z + (1 : + GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ y = z + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = z + (1 : + GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ x = z + ⟨(0 : ℤ), (1 : ℤ)⟩) → ( + let p : GaussianInt := if 0 < a then z + ⟨0,1⟩ else z + 1 + ⟨0,1⟩ + p = x ∨ p = y) ) := by + classical + intro x y z a hor p + rcases hor with ⟨hx, hy⟩ | ⟨hy, hx⟩ + · dsimp [p] + split_ifs with hapos <;> simp [hx, hy] + · dsimp [p] + split_ifs with hapos <;> simp [hx, hy] + +private theorem hpFootAt484 : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : LatticeCell), ∀ (y : LatticeCell), ∀ (z : GaussianInt), ∀ (v : + GaussianInt), (({x, y} ∈ FootprintEdges T ↔ z ∈ T.cells ∨ v ∈ T.cells) ∧ ({x, y} ∈ + BoundaryFootprintEdges T ↔ z ∈ T.cells ∧ v ∉ T.cells ∨ z ∉ T.cells ∧ v ∈ T.cells) ∧ + (z ∈ T.cells ∨ v ∈ T.cells → x ∈ FootprintVertices T ∧ y ∈ FootprintVertices T ∧ ∀ (t + : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (((1 : ℝ) - (↑t : ℝ)) * (↑x.re : ℝ) + (↑t : + ℝ) * (↑y.re : ℝ), ((1 : ℝ) - (↑t : ℝ)) * (↑x.im : ℝ) + (↑t : ℝ) * (↑y.im : ℝ)) ∈ + TileRealization T) ∧ (z ∈ T.cells ∧ v ∈ T.cells → OpenLatticeEdge x y ⊆ interior + (TileRealization T)) ∧ ((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ + T.cells) → z ∈ T.cells ∧ v ∈ T.cells)) → ((z ∈ T.cells) → (∀ (a : ℕ), + let p : GaussianInt := if 0 < a then z + ⟨0,1⟩ else z + 1 + ⟨0,1⟩ + (p = x ∨ p = y) → (p ∈ FootprintVertices T))) ) := by + classical + intro T x y z v hedgeInfo hz a p hpIsEnd + have hends := hedgeInfo.2.2.1 (Or.inl hz) + rcases hpIsEnd with h | h + · rw [h] + exact hends.1 + · rw [h] + exact hends.2.1 + +private theorem hstarAt491 : + (by + classical + exact + ∀ (n : Nat), ∀ (w : GaussianInt), ∀ (T : ProtoTile), (∀ (a : Nat), ∀ (b : Nat), (0 < a) → + ((a < n) → ((0 < b) → ((b < n) → (∀ j : Fin 4, LatticeVertexIncidentCell (w + (⟨(a : + Int), (b : Int)⟩ : GaussianInt)) j ∈ T.cells))))) → (∀ (z : GaussianInt), ∀ (a : ℕ), + ∀ (b : ℕ), + let pa : Nat := if 0 < a then a else a + 1 + let pb : Nat := b + 1 + let p : GaussianInt := if 0 < a then z + ⟨0,1⟩ else z + 1 + ⟨0,1⟩ + (p = w + (⟨(pa : Int), (pb : Int)⟩ : GaussianInt)) → ((0 < pa ∧ pa < n ∧ 0 < pb ∧ pb < n) + → (∀ j : Fin 4, LatticeVertexIncidentCell p j ∈ T.cells))) ) := by + classical + intro n w T hstarCoords z a b pa pb p hpcoords hpstrict + have hs := hstarCoords pa pb hpstrict.1 hpstrict.2.1 + hpstrict.2.2.1 hpstrict.2.2.2 + simpa [hpcoords] using hs + +private theorem heqAt507 : + (by + classical + exact + ∀ (w : GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), (x = + w + ⟨(↑a : ℤ), (↑b : ℤ)⟩) → (∀ (c : ℕ), ∀ (d : ℕ), (y = w + ⟨(↑c : ℤ), (↑d : ℤ)⟩) → + ((y = x + (1 : GaussianInt)) → (w + (⟨(c : Int), (d : Int)⟩ : GaussianInt) = (w + + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) + 1))) ) := by + classical + intro w x y a b hxcoord c d hycoord h + calc + _ = y := hycoord.symm + _ = x + 1 := h + _ = _ := by rw [hxcoord] + +private theorem hcdAt513 : + (by + classical + exact + (Nat) → (∀ (w : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), ∀ (d : ℕ), (w + (⟨(c : + Int), (d : Int)⟩ : GaussianInt) = (w + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) + 1) → + (c = a + 1 ∧ d = b)) ) := by + classical + intro n w a b c d heq + have hr := congrArg Zsqrtd.re heq + have hi := congrArg Zsqrtd.im heq + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] at hr hi + norm_num at hr hi + constructor <;> omega + +private theorem hsetAt520 : + (by + classical + exact + ∀ (w : GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), (x = + w + ⟨(↑a : ℤ), (↑b : ℤ)⟩) → (∀ (c : ℕ), ∀ (d : ℕ), (y = w + ⟨(↑c : ℤ), (↑d : ℤ)⟩) → + ((c = a + 1 ∧ d = b) → (({x,y} : Finset GaussianInt) = {w + (⟨(a : Int), + (b : Int)⟩ : GaussianInt), w + (⟨((a+1 : Nat) : Int), (b : Int)⟩ : GaussianInt)}))) ) + := by + classical + intro w x y a b hxcoord c d hycoord hcd + rw [hxcoord, hycoord, hcd.1, hcd.2] + +private theorem heqAt526 : + (by + classical + exact + ∀ (w : GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), (x = + w + ⟨(↑a : ℤ), (↑b : ℤ)⟩) → (∀ (c : ℕ), ∀ (d : ℕ), (y = w + ⟨(↑c : ℤ), (↑d : ℤ)⟩) → + ((y = x - (1 : GaussianInt)) → (w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) = (w + + (⟨(c : Int), (d : Int)⟩ : GaussianInt)) + 1))) ) := by + classical + intro w x y a b hxcoord c d hycoord h + calc + _ = x := hxcoord.symm + _ = y + 1 := by rw [h]; simp + _ = _ := by rw [hycoord] + +private theorem hcdAt532 : + (by + classical + exact + (Nat) → (∀ (w : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), ∀ (d : ℕ), (w + (⟨(a : + Int), (b : Int)⟩ : GaussianInt) = (w + (⟨(c : Int), (d : Int)⟩ : GaussianInt)) + 1) → + (a = c + 1 ∧ b = d)) ) := by + classical + intro n w a b c d heq + have hr := congrArg Zsqrtd.re heq + have hi := congrArg Zsqrtd.im heq + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] at hr hi + norm_num at hr hi + constructor <;> omega + +private theorem hsetAt539 : + (by + classical + exact + (Nat) → (∀ (w : GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : ℕ), ∀ (b : + ℕ), (x = w + ⟨(↑a : ℤ), (↑b : ℤ)⟩) → (∀ (c : ℕ), ∀ (d : ℕ), (y = w + ⟨(↑c : ℤ), (↑d : + ℤ)⟩) → ((a = c + 1 ∧ b = d) → (({x,y} : Finset GaussianInt) = {w + (⟨(c : Int), + (d : Int)⟩ : GaussianInt), w + (⟨((c+1 : Nat) : Int), (d : Int)⟩ : GaussianInt)})))) + ) := by + classical + intro n w x y a b hxcoord c d hycoord hcd + rw [hxcoord, hycoord, hcd.1, hcd.2] + apply Finset.ext + intro q + simp [Zsqrtd.ext_iff]; omega + +private theorem heqAt548 : + (by + classical + exact + ∀ (w : GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), (x = + w + ⟨(↑a : ℤ), (↑b : ℤ)⟩) → (∀ (c : ℕ), ∀ (d : ℕ), (y = w + ⟨(↑c : ℤ), (↑d : ℤ)⟩) → + ((y = x + ⟨(0 : ℤ), (1 : ℤ)⟩) → (w + (⟨(c : Int), (d : Int)⟩ : GaussianInt) = (w + + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) + ⟨0,1⟩))) ) := by + classical + intro w x y a b hxcoord c d hycoord h + calc + _ = y := hycoord.symm + _ = x + ⟨0,1⟩ := h + _ = _ := by rw [hxcoord] + +private theorem hcdAt554 : + (by + classical + exact + (Nat) → (∀ (w : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), ∀ (d : ℕ), (w + (⟨(c : + Int), (d : Int)⟩ : GaussianInt) = (w + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) + + ⟨0,1⟩) → (c = a ∧ d = b + 1)) ) := by + classical + intro n w a b c d heq + have hr := congrArg Zsqrtd.re heq + have hi := congrArg Zsqrtd.im heq + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] at hr hi + norm_num at hr hi + constructor <;> omega + +private theorem hsetAt561 : + (by + classical + exact + ∀ (w : GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), (x = + w + ⟨(↑a : ℤ), (↑b : ℤ)⟩) → (∀ (c : ℕ), ∀ (d : ℕ), (y = w + ⟨(↑c : ℤ), (↑d : ℤ)⟩) → + ((c = a ∧ d = b + 1) → (({x,y} : Finset GaussianInt) = {w + (⟨(a : Int), + (b : Int)⟩ : GaussianInt), w + (⟨(a : Int), ((b+1 : Nat) : Int)⟩ : GaussianInt)}))) ) + := by + classical + intro w x y a b hxcoord c d hycoord hcd + rw [hxcoord, hycoord, hcd.1, hcd.2] + +private theorem heqAt567 : + (by + classical + exact + ∀ (w : GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), (x = + w + ⟨(↑a : ℤ), (↑b : ℤ)⟩) → (∀ (c : ℕ), ∀ (d : ℕ), (y = w + ⟨(↑c : ℤ), (↑d : ℤ)⟩) → + ((y = x - ⟨(0 : ℤ), (1 : ℤ)⟩) → (w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) = (w + + (⟨(c : Int), (d : Int)⟩ : GaussianInt)) + ⟨0,1⟩))) ) := by + classical + intro w x y a b hxcoord c d hycoord h + calc + _ = x := hxcoord.symm + _ = y + ⟨0,1⟩ := by rw [h]; simp + _ = _ := by rw [hycoord] + +private theorem hcdAt573 : + (by + classical + exact + (Nat) → (∀ (w : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), ∀ (d : ℕ), (w + (⟨(a : + Int), (b : Int)⟩ : GaussianInt) = (w + (⟨(c : Int), (d : Int)⟩ : GaussianInt)) + + ⟨0,1⟩) → (a = c ∧ b = d + 1)) ) := by + classical + intro n w a b c d heq + have hr := congrArg Zsqrtd.re heq + have hi := congrArg Zsqrtd.im heq + simp only [Zsqrtd.re_add, Zsqrtd.im_add, + ] at hr hi + norm_num at hr hi + constructor <;> omega + +private theorem hsetAt580 : + (by + classical + exact + (Nat) → (∀ (w : GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : ℕ), ∀ (b : + ℕ), (x = w + ⟨(↑a : ℤ), (↑b : ℤ)⟩) → (∀ (c : ℕ), ∀ (d : ℕ), (y = w + ⟨(↑c : ℤ), (↑d : + ℤ)⟩) → ((a = c ∧ b = d + 1) → (({x,y} : Finset GaussianInt) = {w + (⟨(c : Int), + (d : Int)⟩ : GaussianInt), w + (⟨(c : Int), ((d+1 : Nat) : Int)⟩ : GaussianInt)})))) + ) := by + classical + intro n w x y a b hxcoord c d hycoord hcd + rw [hxcoord, hycoord, hcd.1, hcd.2] + apply Finset.ext + intro q + simp [Zsqrtd.ext_iff]; omega + +end SquareEdgeDetails + +theorem P4456T2SquareEdges (n : Nat) (hn : 0 < n) + (w : GaussianInt) (T : ProtoTile) + (hcells : T.cells = (TileTranslation (FordTile n) w).cells) : + (∀ x y, FourNeighborAdjacent x y → + x ∈ BoundaryFootprintVertices T → y ∈ BoundaryFootprintVertices T → + ¬ OpenLatticeEdge x y ⊆ interior (TileRealization T)) ∧ + (∀ x, x ∈ FootprintVertices T → ∀ y, y ∈ FootprintVertices T → + FourNeighborAdjacent x y → ({x, y} : Finset GaussianInt) ∈ FootprintEdges T) := by +-- BODY + have htrans : (TileTranslation (FordTile n) w).cells = + (FordCellDomain n).image (GaussianTranslation w) := SquareEdgeDetails.htrans n w + have hcell (c : GaussianInt) : c ∈ T.cells ↔ + ∃ a b : Nat, a < n ∧ b < n ∧ + c = w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) := SquareEdgeProof.hcell n w T hcells + htrans c + have hnonempty : T.cells.Nonempty := SquareEdgeProof.hnonempty n hn w T hcells htrans + have hvertex_coords (v : GaussianInt) (hv : v ∈ FootprintVertices T) : + ∃ a b : Nat, a ≤ n ∧ b ≤ n ∧ + v = w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) := SquareEdgeProof.hvertex_coords n w T + hcell hnonempty v hv + have hvertex_box (v : GaussianInt) (hv : v ∈ FootprintVertices T) : + (w.re : Int) ≤ v.re ∧ v.re ≤ w.re + n ∧ + w.im ≤ v.im ∧ v.im ≤ w.im + n := SquareEdgeProof.hvertex_box n w T hcell hnonempty v hv + have hstarCoords (a b : Nat) (ha0 : 0 < a) (haN : a < n) + (hb0 : 0 < b) (hbN : b < n) : + ∀ j : Fin 4, LatticeVertexIncidentCell + (w + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) j ∈ T.cells := SquareEdgeProof.hstarCoords n + w T hcell a b ha0 haN hb0 hbN + have hmem (a b : Nat) (ha : a < n) (hb : b < n) : + w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) ∈ T.cells := SquareEdgeDetails.hmem n w T hcell + a b ha hb + have hEdgeH (a b : Nat) (ha : a < n) (hb : b ≤ n) : + ({w + (⟨(a : Int), (b : Int)⟩ : GaussianInt), + w + (⟨((a+1 : Nat) : Int), (b : Int)⟩ : GaussianInt)} : Finset GaussianInt) + ∈ FootprintEdges T := SquareEdgeProof.hEdgeH n hn w T hmem a b ha hb + have hEdgeV (a b : Nat) (ha : a ≤ n) (hb : b < n) : + ({w + (⟨(a : Int), (b : Int)⟩ : GaussianInt), + w + (⟨(a : Int), ((b+1 : Nat) : Int)⟩ : GaussianInt)} : Finset GaussianInt) + ∈ FootprintEdges T := SquareEdgeProof.hEdgeV n hn w T hmem a b ha hb + constructor + · intro x y hxy hxB hyB hinside + obtain ⟨z, v, hform⟩ := P4397T1UnitEdgeCells.1 x y hxy + let A : ProtoTile := ⟨{z}, z⟩ + let B : ProtoTile := ⟨{v}, v⟩ + have hedgeInfo := (P4397T1UnitEdgeCells.2 x y z v hform T) + have hAedge : ({x,y} : Finset GaussianInt) ∈ FootprintEdges A := SquareEdgeDetails.hAedge x y + z v hform + have hBedge : ({x,y} : Finset GaussianInt) ∈ FootprintEdges B := SquareEdgeDetails.hBedge x y + z v hform + have hzv : z ≠ v := SquareEdgeProof.hzv x y z v hform + have hz : z ∈ T.cells := by + exact (P4456T2EdgeInterior T x y z v hxy hzv hAedge hBedge).1 hinside |>.1 + have hv : v ∈ T.cells := by + exact (P4456T2EdgeInterior T x y z v hxy hzv hAedge hBedge).1 hinside |>.2 + rcases hcell z |>.mp hz with ⟨a,b,ha,hb,hza⟩ + rcases hcell v |>.mp hv with ⟨c,d,hc,hd,hvc⟩ + rcases hform with ⟨hor, hvform⟩ | ⟨hor, hvform⟩ + · have hcoords : c = a + 1 ∧ d = b := SquareEdgeProof.hcoordsAt320 n w z v a b hza c d hvc + hvform + let pa : Nat := a + 1 + let p : GaussianInt := if 0 < b then z + 1 else z + 1 + ⟨0,1⟩ + let pb : Nat := if 0 < b then b else b + 1 + have hpcoords : p = w + (⟨(pa : Int), (pb : Int)⟩ : GaussianInt) := + SquareEdgeDetails.hpcoordsAt429 w z a b hza + have hcoordsN : 1 < n := SquareEdgeDetails.hcoordsNAt432 n hn a b c d hc hcoords + have hpstrict : 0 < pa ∧ pa < n ∧ 0 < pb ∧ pb < n := SquareEdgeDetails.hpstrictAt436 n a b + hb c d hc hcoords hcoordsN + have hpIsEnd : p = x ∨ p = y := SquareEdgeDetails.hpIsEndAt439 x y z b hor + have hpFoot : p ∈ FootprintVertices T := SquareEdgeDetails.hpFootAt445 T x y z v hedgeInfo + hz b hpIsEnd + have hstar : ∀ j : Fin 4, LatticeVertexIncidentCell p j ∈ T.cells := + SquareEdgeDetails.hstarAt452 n w T hstarCoords z a b hpcoords hpstrict + have hpnot : p ∉ BoundaryFootprintVertices T := + (P4456T2VertexInterior T hnonempty p hpFoot).2.mpr hstar + rcases hpIsEnd with h | h + · rw [← h] at hxB + exact hpnot hxB + · rw [← h] at hyB + exact hpnot hyB + · have hcoords : c = a ∧ d = b + 1 := SquareEdgeProof.hcoordsAt367 n w z v a b hza c d hvc + hvform + let pa : Nat := if 0 < a then a else a + 1 + let pb : Nat := b + 1 + let p : GaussianInt := if 0 < a then z + ⟨0,1⟩ else z + 1 + ⟨0,1⟩ + have hpcoords : p = w + (⟨(pa : Int), (pb : Int)⟩ : GaussianInt) := + SquareEdgeDetails.hpcoordsAt468 w z a b hza + have hcoordsN : 1 < n := SquareEdgeDetails.hcoordsNAt471 n hn a b c d hd hcoords + have hpstrict : 0 < pa ∧ pa < n ∧ 0 < pb ∧ pb < n := SquareEdgeDetails.hpstrictAt475 n a b + ha c d hd hcoords hcoordsN + have hpIsEnd : p = x ∨ p = y := SquareEdgeDetails.hpIsEndAt478 x y z a hor + have hpFoot : p ∈ FootprintVertices T := SquareEdgeDetails.hpFootAt484 T x y z v hedgeInfo + hz a hpIsEnd + have hstar : ∀ j : Fin 4, LatticeVertexIncidentCell p j ∈ T.cells := + SquareEdgeDetails.hstarAt491 n w T hstarCoords z a b hpcoords hpstrict + have hpnot : p ∉ BoundaryFootprintVertices T := + (P4456T2VertexInterior T hnonempty p hpFoot).2.mpr hstar + rcases hpIsEnd with h | h + · rw [← h] at hxB + exact hpnot hxB + · rw [← h] at hyB + exact hpnot hyB + · intro x hx y hy hxy + obtain ⟨a,b,ha,hb,hxcoord⟩ := hvertex_coords x hx + obtain ⟨c,d,hc,hd,hycoord⟩ := hvertex_coords y hy + change y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0,1⟩ ∨ y = x - ⟨0,1⟩ at hxy + rcases hxy with h | h | h | h + · have heq : w + (⟨(c : Int), (d : Int)⟩ : GaussianInt) = + (w + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) + 1 := SquareEdgeDetails.heqAt507 w x y a + b hxcoord c d hycoord h + have hcd : c = a + 1 ∧ d = b := SquareEdgeDetails.hcdAt513 n w a b c d heq + have hset : ({x,y} : Finset GaussianInt) = + {w + (⟨(a : Int), (b : Int)⟩ : GaussianInt), + w + (⟨((a+1 : Nat) : Int), (b : Int)⟩ : GaussianInt)} := SquareEdgeDetails.hsetAt520 + w x y a b hxcoord c d hycoord hcd + rw [hset] + exact hEdgeH a b (by omega) (by omega) + · have heq : w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) = + (w + (⟨(c : Int), (d : Int)⟩ : GaussianInt)) + 1 := SquareEdgeDetails.heqAt526 w x y a + b hxcoord c d hycoord h + have hcd : a = c + 1 ∧ b = d := SquareEdgeDetails.hcdAt532 n w a b c d heq + have hset : ({x,y} : Finset GaussianInt) = + {w + (⟨(c : Int), (d : Int)⟩ : GaussianInt), + w + (⟨((c+1 : Nat) : Int), (d : Int)⟩ : GaussianInt)} := SquareEdgeDetails.hsetAt539 + n w x y a b hxcoord c d hycoord hcd + rw [hset, Finset.pair_comm] + simpa [Finset.pair_comm] using hEdgeH c d (by omega) (by omega) + · have heq : w + (⟨(c : Int), (d : Int)⟩ : GaussianInt) = + (w + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) + ⟨0,1⟩ := SquareEdgeDetails.heqAt548 w x + y a b hxcoord c d hycoord h + have hcd : c = a ∧ d = b + 1 := SquareEdgeDetails.hcdAt554 n w a b c d heq + have hset : ({x,y} : Finset GaussianInt) = + {w + (⟨(a : Int), (b : Int)⟩ : GaussianInt), + w + (⟨(a : Int), ((b+1 : Nat) : Int)⟩ : GaussianInt)} := SquareEdgeDetails.hsetAt561 + w x y a b hxcoord c d hycoord hcd + rw [hset] + exact hEdgeV a b (by omega) (by omega) + · have heq : w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) = + (w + (⟨(c : Int), (d : Int)⟩ : GaussianInt)) + ⟨0,1⟩ := SquareEdgeDetails.heqAt567 w x + y a b hxcoord c d hycoord h + have hcd : a = c ∧ b = d + 1 := SquareEdgeDetails.hcdAt573 n w a b c d heq + have hset : ({x,y} : Finset GaussianInt) = + {w + (⟨(c : Int), (d : Int)⟩ : GaussianInt), + w + (⟨(c : Int), ((d+1 : Nat) : Int)⟩ : GaussianInt)} := SquareEdgeDetails.hsetAt580 + n w x y a b hxcoord c d hycoord hcd + rw [hset, Finset.pair_comm] + simpa [Finset.pair_comm] using hEdgeV c d (by omega) (by omega) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2VertexInterior.lean b/LeanPool/ApollonianSuperharmonic/P4456T2VertexInterior.lean new file mode 100644 index 0000000000..664785437d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4456T2VertexInterior.lean @@ -0,0 +1,382 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint + +-- [TABLET NODE: P4456T2VertexInterior] + +/-! +# P4456T2VertexInterior + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace VertexInteriorLemmas + +private theorem hsector : + ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin (4 : ℕ)), (LatticeVertexIncidentCell x j ∉ + T.cells) → ∀ (ε : ℝ), + let δ : ℝ := min ε 1 / 4 + (0 < δ) → (δ < 1) → + let X : ℝ := (x.re : Int) + let Y : ℝ := (x.im : Int) + let Q : Fin 4 → ℝ × ℝ := fun k => + if k = 0 then (X + δ, Y + δ) else + if k = 1 then (X - δ, Y + δ) else + if k = 2 then (X - δ, Y - δ) else (X + δ, Y - δ) + (∀ (k : Fin 4), Q k ∈ TileRealization T) → LatticeVertexIncidentCell x j ∈ T.cells := by + classical + intro T x j hnot ε δ hδpos hδone X Y Q hQreal + -- Square membership in the corresponding open quadrant forces its base. + fin_cases j + · have hq := hQreal 0 + simp only [TileRealization, Set.mem_iUnion] at hq + rcases hq with ⟨c, hc, hcp⟩ + simp only [ClosedSquareRealization, Set.mem_Icc] at hcp + rcases hcp with ⟨⟨hcrlo, hcilow⟩, ⟨hcrhi, hcihi⟩⟩ + have hcrloQ : (c.re : ℝ) ≤ (Q 0).1 := by + simpa only [← GaussianInt.intCast_re] using hcrlo + have hcrhiQ : (Q 0).1 ≤ (c.re : ℝ) + 1 := by + simpa only [← GaussianInt.intCast_re] using hcrhi + have hcilowQ : (c.im : ℝ) ≤ (Q 0).2 := by + simpa only [← GaussianInt.intCast_im] using hcilow + have hcihiQ : (Q 0).2 ≤ (c.im : ℝ) + 1 := by + simpa only [← GaussianInt.intCast_im] using hcihi + have hcrlo' : (c.re : ℝ) ≤ X + δ := by simpa [Q] using hcrloQ + have hcrhi' : X + δ ≤ (c.re : ℝ) + 1 := by simpa [Q] using hcrhiQ + have hcilow' : (c.im : ℝ) ≤ Y + δ := by simpa [Q] using hcilowQ + have hcihi' : Y + δ ≤ (c.im : ℝ) + 1 := by simpa [Q] using hcihiQ + simp only [X] at hcrlo' hcrhi' + simp only [Y] at hcilow' hcihi' + have hrelo : x.re - 1 < c.re := by + have h : (x.re : ℝ) - 1 < (c.re : ℝ) := by + linarith [hcrhi', hδpos] + exact_mod_cast h + have hrehi : c.re < x.re + 1 := by + have h : (c.re : ℝ) < (x.re : ℝ) + 1 := by + linarith [hcrlo', hδone] + exact_mod_cast h + have himlo : x.im - 1 < c.im := by + have h : (x.im : ℝ) - 1 < (c.im : ℝ) := by + linarith [hcihi', hδpos] + exact_mod_cast h + have himhi : c.im < x.im + 1 := by + have h : (c.im : ℝ) < (x.im : ℝ) + 1 := by + linarith [hcilow', hδone] + exact_mod_cast h + have hcre : c.re = x.re := by omega + have hcim : c.im = x.im := by omega + have hcEq : c = LatticeVertexIncidentCell x 0 := by + ext <;> simp [LatticeVertexIncidentCell, hcre, hcim] + change LatticeVertexIncidentCell x 0 ∈ T.cells + simpa [hcEq] using hc + · have hq := hQreal 1 + simp only [TileRealization, Set.mem_iUnion] at hq + rcases hq with ⟨c, hc, hcp⟩ + simp only [ClosedSquareRealization, Set.mem_Icc] at hcp + rcases hcp with ⟨⟨hcrlo, hcilow⟩, ⟨hcrhi, hcihi⟩⟩ + have hcrloQ : (c.re : ℝ) ≤ (Q 1).1 := by + simpa only [← GaussianInt.intCast_re] using hcrlo + have hcrhiQ : (Q 1).1 ≤ (c.re : ℝ) + 1 := by + simpa only [← GaussianInt.intCast_re] using hcrhi + have hcilowQ : (c.im : ℝ) ≤ (Q 1).2 := by + simpa only [← GaussianInt.intCast_im] using hcilow + have hcihiQ : (Q 1).2 ≤ (c.im : ℝ) + 1 := by + simpa only [← GaussianInt.intCast_im] using hcihi + have hcrlo' : (c.re : ℝ) ≤ (x.re : ℝ) - δ := by + simpa [Q, X] using hcrloQ + have hcrhi' : (x.re : ℝ) - δ ≤ (c.re : ℝ) + 1 := by + simpa [Q, X] using hcrhiQ + have hcilow' : (c.im : ℝ) ≤ (x.im : ℝ) + δ := by + simpa [Q, Y] using hcilowQ + have hcihi' : (x.im : ℝ) + δ ≤ (c.im : ℝ) + 1 := by + simpa [Q, Y] using hcihiQ + have hrlo : x.re - 2 < c.re := by + have h : (x.re : ℝ) - 2 < (c.re : ℝ) := by linarith [hcrhi', hδone] + exact_mod_cast h + have hrhi : c.re < x.re := by + have h : (c.re : ℝ) < (x.re : ℝ) := by linarith [hcrlo', hδpos] + exact_mod_cast h + have hilo : x.im - 1 < c.im := by + have h : (x.im : ℝ) - 1 < (c.im : ℝ) := by linarith [hcihi', hδpos] + exact_mod_cast h + have hihi : c.im < x.im + 1 := by + have h : (c.im : ℝ) < (x.im : ℝ) + 1 := by linarith [hcilow', hδone] + exact_mod_cast h + have hcre : c.re = x.re - 1 := by omega + have hcim : c.im = x.im := by omega + have hcEq : c = LatticeVertexIncidentCell x 1 := by + ext <;> simp [LatticeVertexIncidentCell, hcre, hcim] + simpa [hcEq] using hc + · have hq := hQreal 2 + simp only [TileRealization, Set.mem_iUnion] at hq + rcases hq with ⟨c, hc, hcp⟩ + simp only [ClosedSquareRealization, Set.mem_Icc] at hcp + rcases hcp with ⟨⟨hcrlo, hcilow⟩, ⟨hcrhi, hcihi⟩⟩ + have hcrloQ : (c.re : ℝ) ≤ (Q 2).1 := by + simpa only [← GaussianInt.intCast_re] using hcrlo + have hcrhiQ : (Q 2).1 ≤ (c.re : ℝ) + 1 := by + simpa only [← GaussianInt.intCast_re] using hcrhi + have hcilowQ : (c.im : ℝ) ≤ (Q 2).2 := by + simpa only [← GaussianInt.intCast_im] using hcilow + have hcihiQ : (Q 2).2 ≤ (c.im : ℝ) + 1 := by + simpa only [← GaussianInt.intCast_im] using hcihi + have hcrlo' : (c.re : ℝ) ≤ (x.re : ℝ) - δ := by + simpa [Q, X] using hcrloQ + have hcrhi' : (x.re : ℝ) - δ ≤ (c.re : ℝ) + 1 := by + simpa [Q, X] using hcrhiQ + have hcilow' : (c.im : ℝ) ≤ (x.im : ℝ) - δ := by + simpa [Q, Y] using hcilowQ + have hcihi' : (x.im : ℝ) - δ ≤ (c.im : ℝ) + 1 := by + simpa [Q, Y] using hcihiQ + have hrlo : x.re - 2 < c.re := by + have h : (x.re : ℝ) - 2 < (c.re : ℝ) := by linarith [hcrhi', hδone] + exact_mod_cast h + have hrhi : c.re < x.re := by + have h : (c.re : ℝ) < (x.re : ℝ) := by linarith [hcrlo', hδpos] + exact_mod_cast h + have hilo : x.im - 2 < c.im := by + have h : (x.im : ℝ) - 2 < (c.im : ℝ) := by linarith [hcihi', hδone] + exact_mod_cast h + have hihi : c.im < x.im := by + have h : (c.im : ℝ) < (x.im : ℝ) := by linarith [hcilow', hδpos] + exact_mod_cast h + have hcre : c.re = x.re - 1 := by omega + have hcim : c.im = x.im - 1 := by omega + have hcEq : c = LatticeVertexIncidentCell x 2 := by + ext <;> simp [LatticeVertexIncidentCell, hcre, hcim] + simpa [hcEq] using hc + · have hq := hQreal 3 + simp only [TileRealization, Set.mem_iUnion] at hq + rcases hq with ⟨c, hc, hcp⟩ + simp only [ClosedSquareRealization, Set.mem_Icc] at hcp + rcases hcp with ⟨⟨hcrlo, hcilow⟩, ⟨hcrhi, hcihi⟩⟩ + have hcrloQ : (c.re : ℝ) ≤ (Q 3).1 := by + simpa only [← GaussianInt.intCast_re] using hcrlo + have hcrhiQ : (Q 3).1 ≤ (c.re : ℝ) + 1 := by + simpa only [← GaussianInt.intCast_re] using hcrhi + have hcilowQ : (c.im : ℝ) ≤ (Q 3).2 := by + simpa only [← GaussianInt.intCast_im] using hcilow + have hcihiQ : (Q 3).2 ≤ (c.im : ℝ) + 1 := by + simpa only [← GaussianInt.intCast_im] using hcihi + have hcrlo' : (c.re : ℝ) ≤ (x.re : ℝ) + δ := by + simpa [Q, X] using hcrloQ + have hcrhi' : (x.re : ℝ) + δ ≤ (c.re : ℝ) + 1 := by + simpa [Q, X] using hcrhiQ + have hcilow' : (c.im : ℝ) ≤ (x.im : ℝ) - δ := by + simpa [Q, Y] using hcilowQ + have hcihi' : (x.im : ℝ) - δ ≤ (c.im : ℝ) + 1 := by + simpa [Q, Y] using hcihiQ + have hrlo : x.re - 1 < c.re := by + have h : (x.re : ℝ) - 1 < (c.re : ℝ) := by linarith [hcrhi', hδpos] + exact_mod_cast h + have hrhi : c.re < x.re + 1 := by + have h : (c.re : ℝ) < (x.re : ℝ) + 1 := by linarith [hcrlo', hδone] + exact_mod_cast h + have hilo : x.im - 2 < c.im := by + have h : (x.im : ℝ) - 2 < (c.im : ℝ) := by linarith [hcihi', hδone] + exact_mod_cast h + have hihi : c.im < x.im := by + have h : (c.im : ℝ) < (x.im : ℝ) := by linarith [hcilow', hδpos] + exact_mod_cast h + have hcre : c.re = x.re := by omega + have hcim : c.im = x.im - 1 := by omega + have hcEq : c = LatticeVertexIncidentCell x 3 := by + ext <;> simp [LatticeVertexIncidentCell, hcre, hcim] + simpa [hcEq] using hc + +end VertexInteriorLemmas + +theorem P4456T2VertexInterior (T : ProtoTile) (hne : T.cells.Nonempty) + (x : GaussianInt) (hx : x ∈ FootprintVertices T) : + (GaussianRealPoint x ∈ interior (TileRealization T) ↔ + ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) ∧ + (x ∉ BoundaryFootprintVertices T ↔ + ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) := by +-- BODY + classical + have hsome : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells := by + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hx + rcases hx with ⟨c, hc, hcase⟩ + rcases hcase with rfl | rfl | rfl | rfl + · exact ⟨0, by simp [LatticeVertexIncidentCell, hc]⟩ + · refine ⟨1, ?_⟩ + simpa [LatticeVertexIncidentCell, sub_eq_add_neg] using hc + · refine ⟨3, ?_⟩ + simpa [LatticeVertexIncidentCell, sub_eq_add_neg] using hc + · refine ⟨2, ?_⟩ + simpa [LatticeVertexIncidentCell, sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] using hc + constructor + · constructor + · intro hinterior j + by_contra hnot + have hball : ∃ ε > 0, + Metric.ball (GaussianRealPoint x) ε ⊆ TileRealization T := + Metric.mem_nhds_iff.mp (mem_interior_iff_mem_nhds.mp hinterior) + obtain ⟨ε, hε, hsub⟩ := hball + let δ : ℝ := min ε 1 / 4 + have hδpos : 0 < δ := by dsimp [δ]; positivity + have hδeps : δ < ε := by dsimp [δ]; have := min_le_left ε 1; linarith + have hδone : δ < 1 := by dsimp [δ]; have := min_le_right ε 1; linarith + have hδabs : |δ| = δ := abs_of_pos hδpos + let X : ℝ := (x.re : Int) + let Y : ℝ := (x.im : Int) + let Q : Fin 4 → ℝ × ℝ := fun k => + if k = 0 then (X + δ, Y + δ) else + if k = 1 then (X - δ, Y + δ) else + if k = 2 then (X - δ, Y - δ) else (X + δ, Y - δ) + have hQball (k : Fin 4) : Q k ∈ Metric.ball (GaussianRealPoint x) ε := by + fin_cases k <;> + simp? [Q, X, Y, GaussianRealPoint, Metric.mem_ball, Prod.dist_eq, + Real.dist_eq, hδabs] <;> exact hδeps + have hQreal (k : Fin 4) : Q k ∈ TileRealization T := hsub (hQball k) + have hsector : LatticeVertexIncidentCell x j ∈ T.cells := VertexInteriorLemmas.hsector T x + j hnot ε hδpos hδone hQreal + exact hnot hsector + · intro hall + have h0 : x ∈ T.cells := by + simpa [LatticeVertexIncidentCell] using hall 0 + have h1 : x - 1 ∈ T.cells := by + simpa [LatticeVertexIncidentCell] using hall 1 + have h2 : x - 1 - ⟨0, 1⟩ ∈ T.cells := by + simpa [LatticeVertexIncidentCell] using hall 2 + have h3 : x - ⟨0, 1⟩ ∈ T.cells := by + simpa [LatticeVertexIncidentCell] using hall 3 + have hsub : Metric.ball (GaussianRealPoint x) (1 / 2 : ℝ) ⊆ TileRealization T := by + intro p hp + have hpdist : dist p (GaussianRealPoint x) < (1 / 2 : ℝ) := + Metric.mem_ball.mp hp + rw [Prod.dist_eq, Real.dist_eq, Real.dist_eq] at hpdist + have hpx : |p.1 - (x.re : ℝ)| < (1 / 2 : ℝ) := + lt_of_le_of_lt (le_max_left _ _) hpdist + have hpy : |p.2 - (x.im : ℝ)| < (1 / 2 : ℝ) := + lt_of_le_of_lt (le_max_right _ _) hpdist + have hpx' : (x.re : ℝ) - 1 / 2 < p.1 ∧ p.1 < (x.re : ℝ) + 1 / 2 := by + rcases abs_lt.mp hpx with ⟨hlo, hhi⟩ + constructor <;> linarith + have hpy' : (x.im : ℝ) - 1 / 2 < p.2 ∧ p.2 < (x.im : ℝ) + 1 / 2 := by + rcases abs_lt.mp hpy with ⟨hlo, hhi⟩ + constructor <;> linarith + by_cases hleft : p.1 ≤ (x.re : ℝ) + · by_cases hdown : p.2 ≤ (x.im : ℝ) + · simp only [TileRealization, Set.mem_iUnion] + refine ⟨LatticeVertexIncidentCell x 2, h2, ?_⟩ + change ((((LatticeVertexIncidentCell x 2).re : ℝ) ≤ p.1 ∧ + ((LatticeVertexIncidentCell x 2).im : ℝ) ≤ p.2) ∧ + (p.1 ≤ (LatticeVertexIncidentCell x 2).re + 1 ∧ + p.2 ≤ (LatticeVertexIncidentCell x 2).im + 1)) + have hre : ((LatticeVertexIncidentCell x 2).re : ℝ) = (x.re : ℝ) - 1 := by + simp [LatticeVertexIncidentCell] + have him : ((LatticeVertexIncidentCell x 2).im : ℝ) = (x.im : ℝ) - 1 := by + simp [LatticeVertexIncidentCell] + rw [hre, him] + constructor <;> constructor <;> linarith [hpx'.1, hpy'.1, hpx'.2, hpy'.2] + · simp only [TileRealization, Set.mem_iUnion] + refine ⟨LatticeVertexIncidentCell x 1, h1, ?_⟩ + change ((((LatticeVertexIncidentCell x 1).re : ℝ) ≤ p.1 ∧ + ((LatticeVertexIncidentCell x 1).im : ℝ) ≤ p.2) ∧ + (p.1 ≤ (LatticeVertexIncidentCell x 1).re + 1 ∧ + p.2 ≤ (LatticeVertexIncidentCell x 1).im + 1)) + have hre : ((LatticeVertexIncidentCell x 1).re : ℝ) = (x.re : ℝ) - 1 := by + simp [LatticeVertexIncidentCell] + have him : ((LatticeVertexIncidentCell x 1).im : ℝ) = (x.im : ℝ) := by + simp [LatticeVertexIncidentCell] + rw [hre, him] + constructor <;> constructor <;> linarith [hpx'.1, hpy'.1, hpx'.2, hpy'.2] + · by_cases hdown : p.2 ≤ (x.im : ℝ) + · simp only [TileRealization, Set.mem_iUnion] + refine ⟨LatticeVertexIncidentCell x 3, h3, ?_⟩ + change ((((LatticeVertexIncidentCell x 3).re : ℝ) ≤ p.1 ∧ + ((LatticeVertexIncidentCell x 3).im : ℝ) ≤ p.2) ∧ + (p.1 ≤ (LatticeVertexIncidentCell x 3).re + 1 ∧ + p.2 ≤ (LatticeVertexIncidentCell x 3).im + 1)) + have hre : ((LatticeVertexIncidentCell x 3).re : ℝ) = (x.re : ℝ) := by + simp [LatticeVertexIncidentCell] + have him : ((LatticeVertexIncidentCell x 3).im : ℝ) = (x.im : ℝ) - 1 := by + simp [LatticeVertexIncidentCell] + rw [hre, him] + constructor <;> constructor <;> linarith [hpx'.1, hpy'.1, hpx'.2, hpy'.2] + · simp only [TileRealization, Set.mem_iUnion] + refine ⟨LatticeVertexIncidentCell x 0, h0, ?_⟩ + change ((((LatticeVertexIncidentCell x 0).re : ℝ) ≤ p.1 ∧ + ((LatticeVertexIncidentCell x 0).im : ℝ) ≤ p.2) ∧ + (p.1 ≤ (LatticeVertexIncidentCell x 0).re + 1 ∧ + p.2 ≤ (LatticeVertexIncidentCell x 0).im + 1)) + have hre : ((LatticeVertexIncidentCell x 0).re : ℝ) = (x.re : ℝ) := by + simp [LatticeVertexIncidentCell] + have him : ((LatticeVertexIncidentCell x 0).im : ℝ) = (x.im : ℝ) := by + simp [LatticeVertexIncidentCell] + rw [hre, him] + constructor <;> constructor <;> linarith [hpx'.1, hpy'.1, hpx'.2, hpy'.2] + exact mem_interior_iff_mem_nhds.mpr + (Metric.mem_nhds_iff.mpr ⟨1 / 2, by norm_num, hsub⟩) + · constructor + · intro hnotboundary + by_contra hnotall + push Not at hnotall + exact hnotboundary (P3161T2IncidentBoundary T x hsome hnotall) + · intro hall hboundary + have h0 : x ∈ T.cells := by + simpa [LatticeVertexIncidentCell] using hall 0 + have h1 : x - 1 ∈ T.cells := by + simpa [LatticeVertexIncidentCell] using hall 1 + have h2 : x - 1 - ⟨0, 1⟩ ∈ T.cells := by + simpa [LatticeVertexIncidentCell] using hall 2 + have h3 : x - ⟨0, 1⟩ ∈ T.cells := by + simpa [LatticeVertexIncidentCell] using hall 3 + simp only [BoundaryFootprintVertices, hne, ite_true, + Set.mem_ofPred_eq] at hboundary + rcases hboundary with ⟨e, he, hxe⟩ + simp only [BoundaryFootprintEdges, Set.mem_ofPred_eq] at he + rcases he with ⟨z, (⟨rfl, hor⟩ | ⟨rfl, hver⟩)⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hxe with hxe | hxe + · subst z + rcases hor with ⟨_, hn⟩ | ⟨hn, _⟩ + · exact hn (by simpa [sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] using h3) + · exact hn h0 + · have hz : z = x - 1 := by + have hx' : x = z + 1 := hxe + exact (sub_eq_iff_eq_add.mpr (by simpa [add_comm] using hx')).symm + subst z + rcases hor with ⟨_, hn⟩ | ⟨hn, _⟩ + · exact hn (by simpa [sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] using h2) + · exact hn h1 + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hxe with hxe | hxe + · subst z + rcases hver with ⟨_, hn⟩ | ⟨hn, _⟩ + · exact hn h1 + · exact hn h0 + · have hz : z = x - ⟨0, 1⟩ := by + have hx' : x = z + ⟨0, 1⟩ := hxe + exact (sub_eq_iff_eq_add.mpr (by simpa [add_comm] using hx')).symm + subst z + rcases hver with ⟨_, hn⟩ | ⟨hn, _⟩ + · exact hn (by simpa [sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] using h2) + · exact hn (by simpa [sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] using h3) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1BoundaryFrame.lean b/LeanPool/ApollonianSuperharmonic/P4458T1BoundaryFrame.lean new file mode 100644 index 0000000000..07472ba9fe --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4458T1BoundaryFrame.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryString +public import LeanPool.ApollonianSuperharmonic.TileOdometer + +-- [TABLET NODE: P4458T1BoundaryFrame] + +/-! +# P4458T1BoundaryFrame + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a positive band circle $C$, a Boolean chart $\epsilon$, a regular-family +base $B$, literal endpoint tiles $R^-,R^+$, and endpoint functions $h^-,h^+$, +a boundary frame consists of a positive outer circle $C_0$, a proper +quadruple $q$, a parent slot $i$, a tile $T_0$ and function $h_0$. +It records $q_0=C_0$, $q_{i+1}=C$, tile-odometer certificates for +$(C_0,T_0,h_0)$ and $(C,R^\pm,h^\pm)$, band-prototile certificates for +$T_0$ and $B$, and literal membership of both endpoints in +$\operatorname{RegularTileFamily}(B,\Lambda_C)$. +If $c_C=1$, it records $\operatorname{UnitOccurrenceOrientation}(q,i,\epsilon)$. +Writing $v_{ab}=v(q_a,q_b)$ and $a_{ab}=a(q_a,q_b)$, its centroid data are +$\operatorname{cent}(R^\pm)-\operatorname{cent}(T_0)=\tfrac12(v_{i+1,0}\pm v_{0,i+1})$. +It also records defined slopes $p_0,p^-,p^+$ of these three functions and +$p^\pm-p_0=\tfrac12(a_{i+1,0}\pm a_{0,i+1})$. +No boundary list or conclusion about restrictions is part of this data. +-/ +structure P4458T1BoundaryFrame (C : BandCircle) (orientation : Bool) + (base Rminus Rplus : ProtoTile) (hminus hplus : PartialOdometer) where +-- BODY + /-- The positive outer circle whose decomposition contains the selected boundary. -/ + outer : BandCircle + /-- The proper ordered presentation with that outer circle as child. -/ + q : Fin 4 → CircleCoordinates + proper : ProperBandQuadruple q + /-- The parent slot occupied by the selected boundary circle. -/ + slot : Fin 3 + child : q 0 = outer.1.1 + parent : q slot.succ = C.1.1 + /-- The literal outer prototile. -/ + tile : ProtoTile + /-- The literal partial odometer on the outer prototile. -/ + odometer : PartialOdometer + outer_odo : TileOdometer outer.1.1 tile odometer + minus_odo : TileOdometer C.1.1 Rminus hminus + plus_odo : TileOdometer C.1.1 Rplus hplus + outer_band : BandPrototile outer.1.1 tile + base_band : BandPrototile C.1.1 base + minus_family : Rminus ∈ RegularTileFamily base (TilingLattice C) + plus_family : Rplus ∈ RegularTileFamily base (TilingLattice C) + chart : C.1.1.1 = 1 → UnitOccurrenceOrientation q slot orientation + minus_centroid : TileCentroid Rminus - TileCentroid tile = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (q slot.succ) (q 0) - BandVectors.1 (q 0) (q slot.succ)) + plus_centroid : TileCentroid Rplus - TileCentroid tile = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (q slot.succ) (q 0) + BandVectors.1 (q 0) (q slot.succ)) + /-- The defined slope of the outer odometer. -/ + outer_slope : ℝ × ℝ + /-- The defined slope at the initial boundary endpoint. -/ + minus_slope : ℝ × ℝ + /-- The defined slope at the terminal boundary endpoint. -/ + plus_slope : ℝ × ℝ + slope_outer : PartialOdometerSlope odometer = some outer_slope + slope_minus : PartialOdometerSlope hminus = some minus_slope + slope_plus : PartialOdometerSlope hplus = some plus_slope + minus_difference : minus_slope - outer_slope = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (q slot.succ) (q 0) - BandVectors.2 (q 0) (q slot.succ)) + plus_difference : plus_slope - outer_slope = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (q slot.succ) (q 0) + BandVectors.2 (q 0) (q slot.succ)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1BoundaryPlacement.lean b/LeanPool/ApollonianSuperharmonic/P4458T1BoundaryPlacement.lean new file mode 100644 index 0000000000..8334809144 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4458T1BoundaryPlacement.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundarySide + +-- [TABLET NODE: P4458T1BoundaryPlacement] + +/-! +# P4458T1BoundaryPlacement + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a boundary frame $F$ and a six-restriction family $D$, a boundary +placement consists of a literal joining tile $J$ with the same cells as +$D.T_i^-$, a tile-odometer certificate on $J$ for the unchanged function +$D.h_i^-$, its ancestor-odometer certificate relative to $F.h_0$, and its +negative signed occurrence certificate in $F.q$. +It records a `P4458T1BoundarySide` from $(R^-,h^-)$ to +$(J,D.h_i^-)$ and another from $(J,D.h_i^-)$ to $(R^+,h^+)$. +The same tile and the same function occur in both sides. Neither final +endpoint is replaced by a record with equal cells. +-/ +structure P4458T1BoundaryPlacement + {C : BandCircle} {orientation : Bool} {base Rminus Rplus : ProtoTile} + {hminus hplus : PartialOdometer} + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) + (D : P4458T1RestrictionFamily F) where +-- BODY + /-- The literal joining tile shared by the two boundary sides. -/ + join : ProtoTile + cells : join.cells = (D.tiles F.slot false).cells + odometer : TileOdometer C.1.1 join (D.functions F.slot false) + ancestor : AncestorOdometer C.1.1 F.outer.1.1 + join F.tile (D.functions F.slot false) F.odometer + occurrence : BandSubtileOccurrence F.q F.tile F.slot false join + /-- The direct or recursive side from the initial endpoint to the joining tile. -/ + left : P4458T1BoundarySide F Rminus join hminus (D.functions F.slot false) + /-- The direct or recursive side from the joining tile to the terminal endpoint. -/ + right : P4458T1BoundarySide F join Rplus (D.functions F.slot false) hplus + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1BoundarySide.lean b/LeanPool/ApollonianSuperharmonic/P4458T1BoundarySide.lean new file mode 100644 index 0000000000..535aa6e723 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4458T1BoundarySide.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent + +-- [TABLET NODE: P4458T1BoundarySide] + +/-! +# P4458T1BoundarySide + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Fix an outer boundary frame $F$ with selected circle $C$, chart $\epsilon$ +and base $B$. A side from literal $(U,g)$ to literal $(V,h)$ is one of two +pieces of construction data. A direct side records the two-term +$\epsilon$-oriented tile string $[U,V]$ in the same regular family and +$\operatorname{LeftLatticeAdjacent}(C,U,V,g,h)$. +A recursive side records a boundary frame $G$ with the same selected +circle, chart, base and literal endpoint functions $(U,g),(V,h)$, +a parent slot $j$ of $F.q$ with $G.C_0=F.q_{j+1}$, and +$\operatorname{AncestorOdometer}(G.C_0,F.C_0,G.T_0,F.T_0,G.h_0,F.h_0)$. +It does not record a recursive string or a respected odometer list. +-/ +inductive P4458T1BoundarySide + {C : BandCircle} {orientation : Bool} {base Rminus Rplus : ProtoTile} + {hminus hplus : PartialOdometer} + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) + (U V : ProtoTile) (g h : PartialOdometer) : Type where +-- BODY + | direct + (string : TileString C orientation base U V [U, V]) + (link : LeftLatticeAdjacent C U V g h) + | recursive + (frame : P4458T1BoundaryFrame C orientation base U V g h) + (outerSlot : Fin 3) + (parent : frame.outer.1.1 = F.q outerSlot.succ) + (ancestor : AncestorOdometer frame.outer.1.1 F.outer.1.1 + frame.tile F.tile frame.odometer F.odometer) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean new file mode 100644 index 0000000000..de47b60ac0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean @@ -0,0 +1,1243 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization +public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryPlacement +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorsExistUnique +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TilingLattice +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique +public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct + +-- [TABLET NODE: P4458T1FirstProperRows] + +/-! +# P4458T1FirstProperRows + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FirstProperRowProof + +private theorem properGt : + (by + classical + exact + ∀ q : Fin 4 → CircleCoordinates, ProperBandQuadruple q → 1 < (q 0).1 ) := by + classical + intro q hq + have hf := ProperBandCurvatureStructure q hq + by_contra hn + have hz : ∀ i : Fin 3, (q i.succ).1 = 0 := by + intro i + have hnonneg := hf.2.1 i + have hbelow := hq.2 i + omega + exact (by decide : (0 : Fin 3) ≠ 1) (hf.2.2 0 1 (hz 0) (hz 1)) + +private theorem forestRows : + (by + classical + exact + (BandCircle) → ( + let I : GaussianInt := ⟨0, 1⟩ + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let L := fun z : GaussianInt => + ![((4 : ℤ), 1 + 8 * z + 4 * I), + (1, 1 + 2 * z), (0, -1), (1, 1 + 2 * z + 2 * I)] + let R := fun z : GaussianInt => + ![((4 : ℤ), 7 + 8 * z + 4 * I), + (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * I), (0, 1)] + (∀ q : Fin 4 → CircleCoordinates, ProperBandQuadruple q → 1 < (q 0).1) → ((∀ (q : Fin 4 → + CircleCoordinates), ∀ (i : Fin 3), ∀ (j : Fin 3), cyc (cyc q i) j = cyc q (i + j)) → + (∀ q + : Fin 4 → CircleCoordinates, SemiProperQuadruple q → ProperBandQuadruple q → (∀ j : Fin + 3, (q j.succ).1 ≤ 1) → ∃ z : GaussianInt, ∃ k : Fin 3, q = cyc (L z) k ∨ q = cyc (R z) + k))) ) := by + classical + intro C I cyc L R properGt cycCyc q hq + induction hq with + | base z => + intro hp hs + have h := hp.2 0 + norm_num at h + | @rotate q hq ih => + intro hp hs + have hp' : ProperBandQuadruple q := by + refine ⟨hq, ?_⟩ + intro j + fin_cases j + · exact hp.2 2 + · exact hp.2 0 + · exact hp.2 1 + have hs' : ∀ j : Fin 3, (q j.succ).1 ≤ 1 := by + intro j + fin_cases j + · exact hs 2 + · exact hs 0 + · exact hs 1 + rcases ih hp' hs' with ⟨z, k, heq | heq⟩ + · refine ⟨z, k + 1, Or.inl ?_⟩ + change cyc q 1 = _ + rw [heq, cycCyc] + · refine ⟨z, k + 1, Or.inr ?_⟩ + change cyc q 1 = _ + rw [heq, cycCyc] + | @successor q hq ih => + intro hp hs + rcases (SemiProperForestClassification q hq).2 with + ⟨z, heq⟩ | ⟨z, heq⟩ | ⟨z, heq⟩ | hp' + · have h := hp.2 0 + rw [heq] at h + change (1 : ℤ) < 1 at h + omega + · refine ⟨z, 0, Or.inl ?_⟩ + rw [heq] + funext j + fin_cases j <;> simp [cyc, L, I]; ring + · refine ⟨z, 0, Or.inr ?_⟩ + rw [heq] + funext j + fin_cases j <;> simp [cyc, R, I]; ring + · exact (not_le_of_gt (properGt q hp') (hs 0)).elim + +private theorem hrAt221 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + ProperBandQuadruple r ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F cyc r + have rot : ∀ i : Fin 3, ProperBandQuadruple (cyc F.q i) := by + intro i + fin_cases i + · convert F.proper using 1; funext j; fin_cases j <;> rfl + · refine ⟨SemiProperQuadruple.rotate F.proper.1, ?_⟩ + intro j + fin_cases j + · simpa [cyc] using F.proper.2 1 + · simpa [cyc] using F.proper.2 2 + · simpa [cyc] using F.proper.2 0 + · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate F.proper.1), ?_⟩ + intro j + fin_cases j + · simpa [cyc] using F.proper.2 2 + · simpa [cyc] using F.proper.2 0 + · simpa [cyc] using F.proper.2 1 + exact rot F.slot + +private theorem rotateChart : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + ∀ (i : Fin 3), ∀ (o : Bool), UnitOccurrenceOrientation F.q i o → UnitOccurrenceOrientation + (cyc F.q i) 0 o ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F cyc i o h + fin_cases i + · convert h using 1 + · funext j + fin_cases j <;> rfl + · rfl + · exact UnitOccurrenceOrientation.rotate h + · exact UnitOccurrenceOrientation.rotate (UnitOccurrenceOrientation.rotate h) + +private theorem rootValues : + (by + classical + exact + (BandCircle) → ( + let I : GaussianInt := ⟨0, 1⟩ + (∀ (z : GaussianInt), + let q := ![((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z), ((1 : + ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩), + ((0 : ℤ), (1 : GaussianInt)), ((0 : ℤ), (-1 : GaussianInt))]; BandVectors.1 (q (3 : Fin + (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (2 : Fin (4 : + ℕ))) + (q (1 : Fin (4 : ℕ))) = (-1 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : + Fin (4 : ℕ))) = (1 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : + ℕ))) = (1 : GaussianInt) ∧ BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = + (-1 : GaussianInt) - z - ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q + (3 : + Fin (4 : ℕ))) = z + ⟨(0 : ℤ), (1 : ℤ)⟩) → ((∀ (q : Fin (4 : ℕ) → CircleCoordinates), + SemiProperQuadruple q → BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ BandVectors.1 (q (0 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.2 (q (2 : Fin (4 + : ℕ))) (q (1 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (q (3 : Fin (4 : ℕ))) + (q (2 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → ((∀ (C : + CircleCoordinates), ∀ (D : CircleCoordinates), PrimitiveVectorOrientation C D → + BandVectors.1 D C = ⟨(0 : + ℤ), + (1 : ℤ)⟩ * BandVectors.1 C D ∧ BandVectors.2 D C = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 C + D) → (∀ (z : GaussianInt), + let U : CircleCoordinates := (1, 1 + 2 * z) + let H : CircleCoordinates := (1, 1 + 2 * z + 2 * I) + BandVectors.1 (0, -1) U = -I ∧ + BandVectors.2 (0, -1) U = I * z ∧ + BandVectors.1 U H = -1 + I ∧ + BandVectors.2 U H = -z - I - I * z ∧ + BandVectors.1 H (0, -1) = 1 ∧ + BandVectors.2 H (0, -1) = z + I ∧ + BandVectors.1 H U = 1 + I ∧ + BandVectors.2 H U = 1 + z - I * z ∧ + BandVectors.1 U (0, 1) = -I ∧ + BandVectors.2 U (0, 1) = I + I * z ∧ + BandVectors.1 (0, 1) H = -1 ∧ + BandVectors.2 (0, 1) H = -1 - z - I)))) ) := by + classical + intro C I baseLaw stepLaw flipLaw z + let b : Fin 4 → CircleCoordinates := + ![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * I), (0, 1), (0, -1)] + have hb : SemiProperQuadruple b := SemiProperQuadruple.base z + have hb0 := baseLaw z + change BandVectors.1 (b 3) (b 2) = 0 ∧ + BandVectors.1 (b 2) (b 1) = -1 ∧ + BandVectors.1 (b 1) (b 3) = 1 ∧ + BandVectors.2 (b 3) (b 2) = 1 ∧ + BandVectors.2 (b 2) (b 1) = -1 - z - I ∧ + BandVectors.2 (b 1) (b 3) = z + I at hb0 + rcases hb0 with ⟨v32, v21, v13, a32, a21, a13⟩ + have step := stepLaw b hb + have vv20 : BandVectors.1 (b 2) (b 0) = -1 := by + rw [step.1, v21, v32]; ring + have aa20 : BandVectors.2 (b 2) (b 0) = -1 - z := by + rw [step.2.2.1, a21, a32]; ring + have vv03 : BandVectors.1 (b 0) (b 3) = 1 := by + rw [step.2.1, v13, v32]; ring + have aa03 : BandVectors.2 (b 0) (b 3) = z := by + rw [step.2.2.2, a13, a32]; ring + have hminus : PrimitiveVectorOrientation (b 3) (b 0) := by + have h := PrimitiveVectorOrientation.base31 (z - I) + convert h using 1 <;> simp [b, I]; ring + have hplus : PrimitiveVectorOrientation (b 2) (b 0) := by + have h := PrimitiveVectorOrientation.base21 (z - I) + convert h using 1 <;> simp [b, I]; ring + have fm := flipLaw _ _ hminus + have fp := flipLaw _ _ hplus + have f01 := flipLaw _ _ (PrimitiveVectorOrientation.base10 z) + have h10 := (VectorRecursionLaws b hb).2.2.1 + have ha10 := (VectorRecursionLaws b hb).2.2.2.1 + change BandVectors.1 (b 0) (b 1) = I * BandVectors.1 (b 1) (b 0) ∧ + BandVectors.2 (b 0) (b 1) = -I * BandVectors.2 (b 1) (b 0) at f01 + have vv10 : BandVectors.1 (b 1) (b 0) = 1 + I := by + rw [h10, v13, v21]; ring + have aa10 : BandVectors.2 (b 1) (b 0) = 1 + z - I * z := by + rw [ha10, a13, a21] + apply Zsqrtd.ext <;> norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring + have vv30 : BandVectors.1 (b 3) (b 0) = -I := by + have h := fm.1 + rw [vv03] at h + have hr := congrArg Zsqrtd.re h + have hi := congrArg Zsqrtd.im h + apply Zsqrtd.ext <;> norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at hr hi ⊢ <;> omega + have aa30 : BandVectors.2 (b 3) (b 0) = I * z := by + have h := fm.2 + rw [aa03] at h + have hr := congrArg Zsqrtd.re h + have hi := congrArg Zsqrtd.im h + apply Zsqrtd.ext <;> norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at hr hi ⊢ <;> omega + have vv01 : BandVectors.1 (b 0) (b 1) = -1 + I := by + rw [f01.1, vv10] + apply Zsqrtd.ext <;> norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] + have aa01 : BandVectors.2 (b 0) (b 1) = -z - I - I * z := by + rw [f01.2, aa10] + apply Zsqrtd.ext <;> norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring + have vv02 : BandVectors.1 (b 0) (b 2) = -I := by + rw [fp.1, vv20]; ring + have aa02 : BandVectors.2 (b 0) (b 2) = I + I * z := by + rw [fp.2, aa20]; ring + exact ⟨vv30, aa30, vv01, aa01, v13, a13, vv10, aa10, + vv02, aa02, v21, a21⟩ + +private theorem htable : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let I : GaussianInt := ⟨0, 1⟩ + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let L := fun z : GaussianInt => + ![((4 : ℤ), 1 + 8 * z + 4 * I), + (1, 1 + 2 * z), (0, -1), (1, 1 + 2 * z + 2 * I)] + let R := fun z : GaussianInt => + ![((4 : ℤ), 7 + 8 * z + 4 * I), + (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * I), (0, 1)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + (r 1 = C.1.1) → (∀ (z : GaussianInt), (r = L z ∧ orientation = true ∨ r = cyc (L z) (2 : Fin + (3 : ℕ)) ∧ orientation = false ∨ r = R z ∧ orientation = true ∨ r = cyc (R z) (1 : + Fin (3 + : ℕ)) ∧ orientation = false) → ((∀ (z : GaussianInt), + let U : CircleCoordinates := (1, 1 + 2 * z) + let H : CircleCoordinates := (1, 1 + 2 * z + 2 * I) + BandVectors.1 (0, -1) U = -I ∧ + BandVectors.2 (0, -1) U = I * z ∧ + BandVectors.1 U H = -1 + I ∧ + BandVectors.2 U H = -z - I - I * z ∧ + BandVectors.1 H (0, -1) = 1 ∧ + BandVectors.2 H (0, -1) = z + I ∧ + BandVectors.1 H U = 1 + I ∧ + BandVectors.2 H U = 1 + z - I * z ∧ + BandVectors.1 U (0, 1) = -I ∧ + BandVectors.2 U (0, 1) = I + I * z ∧ + BandVectors.1 (0, 1) H = -1 ∧ + BandVectors.2 (0, 1) H = -1 - z - I) → ( + let x := BandVectors.1 (r 1) (r 3) + let y := BandVectors.1 (r 2) (r 1) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + let Row := fun (e : Bool) (y d ya da : GaussianInt) => + UnitTriangularStep e y ∧ + UnitTriangularStep e d ∧ + y ≠ 0 ∧ d ≠ 0 ∧ + (ya.re : ℝ) = CircleMatrix C 0 0 * y.re + CircleMatrix C 0 1 * y.im ∧ + (ya.im : ℝ) = CircleMatrix C 1 0 * y.re + CircleMatrix C 1 1 * y.im ∧ + (da.re : ℝ) = CircleMatrix C 0 0 * d.re + CircleMatrix C 0 1 * d.im ∧ + (da.im : ℝ) = CircleMatrix C 1 0 * d.re + CircleMatrix C 1 1 * d.im + Row orientation y (I * x) ya (-I * xa)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F I cyc L R r hcr z hrows rootValues x y xa + ya Row + rcases rootValues z with ⟨v30, a30, v01, a01, v13, a13, + v10, a10, v02, a02, v21, a21⟩ + rcases hrows with ⟨hr, ho⟩ | ⟨hr, ho⟩ | ⟨hr, ho⟩ | ⟨hr, ho⟩ + all_goals + change r = _ at hr + have hraw := hcr.symm + rw [hr] at hraw + dsimp [cyc, L, R] at hraw + dsimp only [y, x, ya, xa] + rw [hr, ho] + · change Row true + (BandVectors.1 (0, -1) (1, 1 + 2 * z)) + (I * BandVectors.1 (1, 1 + 2 * z) (1, 1 + 2 * z + 2 * I)) + (BandVectors.2 (0, -1) (1, 1 + 2 * z)) + (-I * BandVectors.2 (1, 1 + 2 * z) (1, 1 + 2 * z + 2 * I)) + rw [v30, v01, a30, a01] + dsimp only [Row] + norm_num [UnitTriangularStep, CircleMatrix, BandCircleEuclideanData, + hraw, I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul, + GaussianInt.toComplex_def, -GaussianInt.intCast_re, -GaussianInt.intCast_im] + all_goals repeat' constructor + all_goals ring + · change Row false + (BandVectors.1 (1, 1 + 2 * z) (1, 1 + 2 * z + 2 * I)) + (I * BandVectors.1 (1, 1 + 2 * z + 2 * I) (0, -1)) + (BandVectors.2 (1, 1 + 2 * z) (1, 1 + 2 * z + 2 * I)) + (-I * BandVectors.2 (1, 1 + 2 * z + 2 * I) (0, -1)) + rw [v01, v13, a01, a13] + dsimp only [Row] + norm_num [UnitTriangularStep, CircleMatrix, BandCircleEuclideanData, + hraw, I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul, + GaussianInt.toComplex_def, -GaussianInt.intCast_re, -GaussianInt.intCast_im] + all_goals repeat' constructor + all_goals ring + · change Row true + (BandVectors.1 (1, 1 + 2 * z + 2 * I) (1, 1 + 2 * z)) + (I * BandVectors.1 (1, 1 + 2 * z) (0, 1)) + (BandVectors.2 (1, 1 + 2 * z + 2 * I) (1, 1 + 2 * z)) + (-I * BandVectors.2 (1, 1 + 2 * z) (0, 1)) + rw [v10, v02, a10, a02] + dsimp only [Row] + norm_num [UnitTriangularStep, CircleMatrix, BandCircleEuclideanData, + hraw, I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul, + GaussianInt.toComplex_def, -GaussianInt.intCast_re, -GaussianInt.intCast_im] + all_goals repeat' constructor + all_goals ring + · change Row false + (BandVectors.1 (0, 1) (1, 1 + 2 * z + 2 * I)) + (I * BandVectors.1 (1, 1 + 2 * z + 2 * I) (1, 1 + 2 * z)) + (BandVectors.2 (0, 1) (1, 1 + 2 * z + 2 * I)) + (-I * BandVectors.2 (1, 1 + 2 * z + 2 * I) (1, 1 + 2 * z)) + rw [v21, v10, a21, a10] + dsimp only [Row] + norm_num [UnitTriangularStep, CircleMatrix, BandCircleEuclideanData, + hraw, I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul, + GaussianInt.toComplex_def, -GaussianInt.intCast_re, -GaussianInt.intCast_im] + all_goals repeat' constructor + all_goals ring + +private theorem hjoinAncestor : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + let y := BandVectors.1 (r 2) (r 1) + (0 < (F.q F.slot.succ).1) → (∀ (u : GaussianInt), + let join := TileTranslation base (u + y) + (BandPrototile C.1.1 join) → (((D.tiles F.slot false).cells = join.cells ∧ ((D.tiles F.slot + false).cells = ∅ → (D.tiles F.slot false).anchor = join.anchor)) → (AncestorOdometer + C.1.1 F.outer.1.1 join F.tile (D.functions F.slot false) F.odometer))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D cyc r y hCpositive u join hjoinBand + hjoinCells + have hstrict : (F.q F.slot.succ).1 < F.outer.1.1.1 := by + rw [← F.child] + exact F.proper.2 F.slot + have h := AncestorOdometerInnerSupportNormalization + (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) join F.tile + (D.functions F.slot false) F.odometer hCpositive hstrict + (D.ancestors F.slot false hCpositive) + (by rw [F.parent]; exact hjoinBand) hjoinCells.1 + simpa only [F.parent] using h + +private theorem hSlopeInfo : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + let wa := BandVectors.2 (r 3) (r 2) + (0 < (F.q F.slot.succ).1) → (∃ root child : ℝ × ℝ, PartialOdometerSlope F.odometer = some + root ∧ PartialOdometerSlope (D.functions F.slot false) = some child ∧ child.1 - root.1 = + -(1 / 2 : ℝ) * ((wa.re : ℝ) - (wa.im : ℝ)) ∧ child.2 - root.2 = -(1 / 2 : ℝ) * ((wa.im : + ℝ) + (wa.re : ℝ))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D cyc r wa hCpositive + rcases D.slopes F.slot false with hz | ⟨root, child, hroot, hchild, hre, him⟩ + · omega + · refine ⟨root, child, hroot, hchild, ?_, ?_⟩ + · simpa [r, cyc, wa] using hre + · simpa [r, cyc, wa] using him + +private theorem pairString : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), + (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → ((C.1.1.1 = 1) → + ((Function.Injective GaussianRealPoint) → (∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (d + : GaussianInt), U ∈ RegularTileFamily base (TilingLattice C) → V ∈ + RegularTileFamily base + (TilingLattice C) → UnitTriangularStep orientation d → d ≠ (0 : GaussianInt) → + TileCentroid V - TileCentroid U = GaussianRealPoint d → TileString C orientation base + U V + [U, V]))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F hunit pointInjective U V d hU hV hstep hne + hcenter + have hUV : U ≠ V := by + intro heq + have hzero : GaussianRealPoint d = GaussianRealPoint 0 := by + rw [← hcenter, heq] + simp [GaussianRealPoint] + rfl + exact hne (pointInjective hzero) + refine ⟨F.base_band, rfl, rfl, ?_, ?_, ?_, ?_⟩ + · simpa using hUV + · intro T hT + rcases List.mem_cons.mp hT with rfl | hT + · exact hU + · have heq : T = V := by simpa using hT + simpa [heq] using hV + · apply List.isChain_pair.mpr + rw [ite_eq_left hunit] + exact ⟨d, hstep, hcenter⟩ + · intro pre T post heq hpre hpost + have hlen := congrArg List.length heq + have hp : 1 ≤ pre.length := by + cases pre with + | nil => simp at hpre + | cons x xs => simp + have hq : 1 ≤ post.length := by + cases post with + | nil => simp at hpost + | cons x xs => simp + simp at hlen + omega + +end FirstProperRowProof + +namespace FirstProperRowDetails + +private theorem small : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ((F.q (1 : + Fin (4 : ℕ))).1 = (1 : ℤ) ∧ (F.q (2 : Fin (4 : ℕ))).1 = (0 : ℤ) ∧ (F.q (3 : Fin (4 : + ℕ))).1 = (1 : ℤ) ∨ (F.q (1 : Fin (4 : ℕ))).1 = (1 : ℤ) ∧ (F.q (2 : Fin (4 : ℕ))).1 = + (1 : ℤ) ∧ (F.q (3 : Fin (4 : ℕ))).1 = (0 : ℤ) ∨ (F.q (1 : Fin (4 : ℕ))).1 = (0 : ℤ) ∧ + (F.q (2 : Fin (4 : ℕ))).1 = (1 : ℤ) ∧ (F.q (3 : Fin (4 : ℕ))).1 = (1 : ℤ)) → (∀ i : + Fin 3, (F.q i.succ).1 ≤ 1) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F hroot i + fin_cases i <;> rcases hroot with h | h | h <;> simp_all + +private theorem hunit : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), (∀ i : Fin + 3, (F.q i.succ).1 ≤ 1) → (C.1.1.1 = 1) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F small + have hpos := C.2 + have hle := small F.slot + rw [F.parent] at hle + omega + +private theorem cycCyc : + (by + classical + exact + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), cyc + (cyc q i) j = cyc q (i + j) ) := by + classical + intro cyc q i j + fin_cases i <;> fin_cases j <;> funext k <;> fin_cases k <;> rfl + +private theorem chartEq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + (C.1.1.1 = 1) → ( + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + (ProperBandQuadruple r) → ((r 1 = C.1.1) → ((∀ (i : Fin 3), ∀ (o : Bool), + UnitOccurrenceOrientation F.q i o → UnitOccurrenceOrientation (cyc F.q i) 0 o) → (∀ + (e : Bool), UnitOccurrenceOrientation r (0 : Fin (3 : ℕ)) e → orientation = e)))) ) + := by + classical + intro C orientation base Rminus Rplus hminus hplus F cyc hunit r hr hcr rotateChart e hc + have hu : (r (0 : Fin 3).succ).1 = 1 := by + change (r 1).1 = 1 + rw [hcr] + exact hunit + exact (UnitOccurrenceOrientationUnique.1 r hr 0 hu).unique + (rotateChart F.slot orientation (F.chart hunit)) hc + +private theorem hr'At615 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let I : GaussianInt := ⟨0, 1⟩ + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let L := fun z : GaussianInt => + ![((4 : ℤ), 1 + 8 * z + 4 * I), + (1, 1 + 2 * z), (0, -1), (1, 1 + 2 * z + 2 * I)] + (∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (j : Fin 3), cyc (cyc q i) j = cyc q + (i + j)) → ( + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + ∀ (z : GaussianInt), ∀ (k : Fin (3 : ℕ)), (F.q = cyc (L z) k) → (r = cyc (L z) (k + + F.slot))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F I cyc L cycCyc r z k heq + dsimp only [r] + rw [heq, cycCyc] + +private theorem hr'At633 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let I : GaussianInt := ⟨0, 1⟩ + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let R := fun z : GaussianInt => + ![((4 : ℤ), 7 + 8 * z + 4 * I), + (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * I), (0, 1)] + (∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (j : Fin 3), cyc (cyc q i) j = cyc q + (i + j)) → ( + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + ∀ (z : GaussianInt), ∀ (k : Fin (3 : ℕ)), (F.q = cyc (R z) k) → (r = cyc (R z) (k + + F.slot))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F I cyc R cycCyc r z k heq + dsimp only [r] + rw [heq, cycCyc] + +private theorem hw : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + (ProperBandQuadruple r) → ( + let x := BandVectors.1 (r 1) (r 3) + let y := BandVectors.1 (r 2) (r 1) + let w := BandVectors.1 (r 3) (r 2) + w = -x - y) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F cyc r hr x y w + have h : w + x + y = 0 := (VectorRecursionLaws r hr.1).1 + linear_combination h + +private theorem hwa : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + (ProperBandQuadruple r) → ( + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + let wa := BandVectors.2 (r 3) (r 2) + wa = -xa - ya) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F cyc r hr xa ya wa + have h : wa + xa + ya = 0 := (VectorRecursionLaws r hr.1).2.1 + linear_combination h + +private theorem hCpositive : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), 0 < (F.q + F.slot.succ).1 ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F + rw [F.parent] + exact C.2 + +private theorem hUcenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + let w := BandVectors.1 (r 3) (r 2) + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then (1 : + ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 + : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : + ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : + ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → (TileCentroid (D.tiles + F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D cyc r w hUcent + simpa [r, cyc, w] using hUcent + +private theorem hcenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let I : GaussianInt := ⟨0, 1⟩ + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + let x := BandVectors.1 (r 1) (r 3) + let y := BandVectors.1 (r 2) (r 1) + let w := BandVectors.1 (r 3) (r 2) + (w = -x - y) → ((BandVectors.1 (r 1) (r 0) = x - I * y) → ((BandVectors.1 (r 0) (r 1) = I + * BandVectors.1 (r 1) (r 0)) → ((TileCentroid (D.tiles F.slot false) - TileCentroid + F.tile = -(1 / 2 : ℝ) • (GaussianRealPoint w - (-(GaussianRealPoint w).2, + (GaussianRealPoint w).1))) → ((TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : + ℝ) • GaussianRealPoint (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → + (TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = GaussianRealPoint y))))) + ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D I cyc r x y w hw hvrec hvflip hUcenter + hMcenter + rw [show TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile) - + (TileCentroid Rminus - TileCentroid F.tile) by abel] + rw [hUcenter, hMcenter, hvflip, hvrec, hw] + apply Prod.ext <;> + norm_num [GaussianRealPoint, I, Prod.smul_mk, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + +private theorem hplusCenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let I : GaussianInt := ⟨0, 1⟩ + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + let x := BandVectors.1 (r 1) (r 3) + let y := BandVectors.1 (r 2) (r 1) + let w := BandVectors.1 (r 3) (r 2) + (w = -x - y) → ((BandVectors.1 (r 1) (r 0) = x - I * y) → ((BandVectors.1 (r 0) (r 1) = I + * BandVectors.1 (r 1) (r 0)) → ((TileCentroid (D.tiles F.slot false) - TileCentroid + F.tile = -(1 / 2 : ℝ) • (GaussianRealPoint w - (-(GaussianRealPoint w).2, + (GaussianRealPoint w).1))) → ((TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) + • GaussianRealPoint (BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1))) → + (TileCentroid Rplus - TileCentroid (D.tiles F.slot false) = GaussianRealPoint (I * + x)))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D I cyc r x y w hw hvrec hvflip hUcenter + hPcenter + rw [show TileCentroid Rplus - TileCentroid (D.tiles F.slot false) = + (TileCentroid Rplus - TileCentroid F.tile) - + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile) by abel] + rw [hPcenter, hUcenter, hvflip, hvrec, hw] + apply Prod.ext <;> + norm_num [GaussianRealPoint, I, Prod.smul_mk, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + +private theorem hjoinCenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + let y := BandVectors.1 (r 2) (r 1) + ∀ (u : GaussianInt), (Rminus = TileTranslation base u) → ( + let join := TileTranslation base (u + y) + TileCentroid join - TileCentroid Rminus = GaussianRealPoint y) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F cyc r y u hminusTrans join + rw [hminusTrans] + change TileCentroid (TileTranslation base (u + y)) - + TileCentroid (TileTranslation base u) = _ + rw [(TileTranslationFormulas base (u + y)).2.2.2.2.1, + (TileTranslationFormulas base u).2.2.2.2.1] + apply Prod.ext <;> + norm_num [GaussianRealPoint, -GaussianInt.intCast_re, -GaussianInt.intCast_im] + +private theorem hjoinCenterEq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + let y := BandVectors.1 (r 2) (r 1) + (TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = GaussianRealPoint y) → (∀ (u + : GaussianInt), + let join := TileTranslation base (u + y) + (TileCentroid join - TileCentroid Rminus = GaussianRealPoint y) → (TileCentroid (D.tiles + F.slot false) = TileCentroid join)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D cyc r y hcenter u join hjoinCenter + have h := hcenter.trans hjoinCenter.symm + simpa using congrArg (fun p : ℝ × ℝ => p + TileCentroid Rminus) h + +private theorem hUbandC : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), (BandPrototile (F.q F.slot.succ) (D.tiles F.slot + false)) → (BandPrototile C.1.1 (D.tiles F.slot false)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D hUband + rw [← F.parent] + exact hUband + +private theorem hjoinFoot : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + let y := BandVectors.1 (r 2) (r 1) + ∀ (u : GaussianInt), + let join := TileTranslation base (u + y) + (AncestorOdometer C.1.1 F.outer.1.1 join F.tile (D.functions F.slot false) F.odometer) → + (FootprintVertices join ⊆ FootprintVertices F.tile) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D cyc r y u join hjoinAncestor + rw [← hjoinAncestor.2.2.1, + ← PositiveCurvatureTileOdometerDomain F.outer.1.1 F.tile F.odometer + F.outer.2 F.outer_odo] + exact hjoinAncestor.2.2.2.1 + +private theorem hjoinOccurrence : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + let y := BandVectors.1 (r 2) (r 1) + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then (1 : + ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 + : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : + ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : + ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (u : GaussianInt), + let join := TileTranslation base (u + y) + (BandPrototile C.1.1 join) → ((TileCentroid (D.tiles F.slot false) = TileCentroid join) → + ((FootprintVertices join ⊆ FootprintVertices F.tile) → (BandSubtileOccurrence F.q + F.tile F.slot false join)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D cyc r y hUcent u join hjoinBand + hjoinCenterEq hjoinFoot + refine ⟨by rw [F.parent]; exact hjoinBand, hjoinFoot, ?_⟩ + rw [← hjoinCenterEq] + exact hUcent + +private theorem hDoffset : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let I : GaussianInt := ⟨0, 1⟩ + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + let wa := BandVectors.2 (r 3) (r 2) + ∀ (joinSlope : ℝ × ℝ), (joinSlope.1 - F.outer_slope.1 = -(1 / 2 : ℝ) * ((↑wa.re : ℝ) - + (↑wa.im : ℝ))) → ((joinSlope.2 - F.outer_slope.2 = -(1 / 2 : ℝ) * ((↑wa.im : ℝ) + + (↑wa.re : ℝ))) → (joinSlope - F.outer_slope = -(1 / 2 : ℝ) • GaussianRealPoint ((1 + + I) * wa))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F I cyc r wa joinSlope hre him + apply Prod.ext + · norm_num [GaussianRealPoint, I, Prod.smul_mk, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] + linarith [hre] + · norm_num [GaussianRealPoint, I, Prod.smul_mk, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] + linarith [him] + +private theorem hminusSlope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let I : GaussianInt := ⟨0, 1⟩ + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + let wa := BandVectors.2 (r 3) (r 2) + (wa = -xa - ya) → ((BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.2 (r 0) (r + 1) = -I * BandVectors.2 (r 1) (r 0)) → (∀ (joinSlope : ℝ × ℝ), (joinSlope - + F.outer_slope = -(1 / 2 : ℝ) • GaussianRealPoint ((1 + I) * wa)) → ((F.minus_slope - + F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r 1) (r 0) - + BandVectors.2 (r 0) (r 1))) → (joinSlope - F.minus_slope = GaussianRealPoint ya))))) + ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F I cyc r xa ya wa hwa harec haflip + joinSlope hDoffset hFminus + rw [show joinSlope - F.minus_slope = + (joinSlope - F.outer_slope) - (F.minus_slope - F.outer_slope) by abel] + rw [hDoffset, hFminus, haflip, harec, hwa] + apply Prod.ext <;> + norm_num [GaussianRealPoint, I, Prod.smul_mk, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + +private theorem hplusSlope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let I : GaussianInt := ⟨0, 1⟩ + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + let wa := BandVectors.2 (r 3) (r 2) + (wa = -xa - ya) → ((BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.2 (r 0) (r + 1) = -I * BandVectors.2 (r 1) (r 0)) → (∀ (joinSlope : ℝ × ℝ), (joinSlope - + F.outer_slope = -(1 / 2 : ℝ) • GaussianRealPoint ((1 + I) * wa)) → ((F.plus_slope - + F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r 1) (r 0) + + BandVectors.2 (r 0) (r 1))) → (F.plus_slope - joinSlope = GaussianRealPoint (-I * + xa)))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F I cyc r xa ya wa hwa harec haflip + joinSlope hDoffset hFplus + rw [show F.plus_slope - joinSlope = + (F.plus_slope - F.outer_slope) - (joinSlope - F.outer_slope) by abel] + rw [hFplus, hDoffset, haflip, harec, hwa] + apply Prod.ext <;> + norm_num [GaussianRealPoint, I, Prod.smul_mk, + -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring + +private theorem hleftAdjacent : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + (C.1.1.1 = 1) → ( + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + let y := BandVectors.1 (r 2) (r 1) + let ya := BandVectors.2 (r 2) (r 1) + (UnitTriangularStep orientation y) → (((↑ya.re : ℝ) = CircleMatrix C (0 : Fin (2 : ℕ)) (0 + : Fin (2 : ℕ)) * (↑y.re : ℝ) + CircleMatrix C (0 : Fin (2 : ℕ)) (1 : Fin (2 : ℕ)) * + (↑y.im : ℝ)) → (((↑ya.im : ℝ) = CircleMatrix C (1 : Fin (2 : ℕ)) (0 : Fin (2 : ℕ)) * + (↑y.re : ℝ) + CircleMatrix C (1 : Fin (2 : ℕ)) (1 : Fin (2 : ℕ)) * (↑y.im : ℝ)) → (∀ + (u : GaussianInt), + let join := TileTranslation base (u + y) + (TileCentroid join - TileCentroid Rminus = GaussianRealPoint y) → ((TileOdometer C.1.1 + join (D.functions F.slot false)) → (∀ (joinSlope : ℝ × ℝ), (PartialOdometerSlope + (D.functions F.slot false) = some joinSlope) → ((joinSlope - F.minus_slope = + GaussianRealPoint ya) → (LeftLatticeAdjacent C Rminus join hminus (D.functions F.slot + false))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D cyc hunit r y ya hyStep hyRe hyIm u join + hjoinCenter hjoinOdo joinSlope hjoinSlope hminusSlope + refine ⟨F.minus_odo, hjoinOdo, F.minus_slope, joinSlope, + F.slope_minus, hjoinSlope, Or.inl ⟨hunit, orientation, y, hyStep, hjoinCenter, ?_, ?_⟩⟩ + · rw [← hyRe] + exact congrArg Prod.fst hminusSlope + · rw [← hyIm] + exact congrArg Prod.snd hminusSlope + +private theorem hrightAdjacent : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let I : GaussianInt := ⟨0, 1⟩ + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + (C.1.1.1 = 1) → ( + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + let x := BandVectors.1 (r 1) (r 3) + let y := BandVectors.1 (r 2) (r 1) + let xa := BandVectors.2 (r 1) (r 3) + (UnitTriangularStep orientation (I * x)) → (((↑(-I * xa).re : ℝ) = CircleMatrix C (0 : + Fin (2 : ℕ)) (0 : Fin (2 : ℕ)) * (↑(I * x).re : ℝ) + CircleMatrix C (0 : Fin (2 : ℕ)) + (1 : Fin (2 : ℕ)) * (↑(I * x).im : ℝ)) → (((↑(-I * xa).im : ℝ) = CircleMatrix C (1 : + Fin (2 : ℕ)) (0 : Fin (2 : ℕ)) * (↑(I * x).re : ℝ) + CircleMatrix C (1 : Fin (2 : ℕ)) + (1 : Fin (2 : ℕ)) * (↑(I * x).im : ℝ)) → (∀ (u : GaussianInt), + let join := TileTranslation base (u + y) + (TileOdometer C.1.1 join (D.functions F.slot false)) → ((TileCentroid Rplus - + TileCentroid join = GaussianRealPoint (I * x)) → (∀ (joinSlope : ℝ × ℝ), + (PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → ((F.plus_slope - + joinSlope = GaussianRealPoint (-I * xa)) → (LeftLatticeAdjacent C join Rplus + (D.functions F.slot false) hplus)))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D I cyc hunit r x y xa hxStep hxRe hxIm u + join hjoinOdo hrightCenter joinSlope hjoinSlope hplusSlope + refine ⟨hjoinOdo, F.plus_odo, joinSlope, F.plus_slope, + hjoinSlope, F.slope_plus, Or.inl ⟨hunit, orientation, I * x, hxStep, hrightCenter, ?_, ?_⟩⟩ + · rw [← hxRe] + exact congrArg Prod.fst hplusSlope + · rw [← hxIm] + exact congrArg Prod.snd hplusSlope + +private theorem pointInjective : + (by + classical + exact + Function.Injective GaussianRealPoint ) := by + classical + intro a b hab + apply Zsqrtd.ext + · have h := congrArg Prod.fst hab + change (a.re : ℝ) = (b.re : ℝ) at h + exact_mod_cast h + · have h := congrArg Prod.snd hab + change (a.im : ℝ) = (b.im : ℝ) at h + exact_mod_cast h + +end FirstProperRowDetails + +theorem P4458T1FirstProperRows + {C : BandCircle} {orientation : Bool} {base Rminus Rplus : ProtoTile} + {hminus hplus : PartialOdometer} + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) + (D : P4458T1RestrictionFamily F) + (hroot : + ((F.q 1).1 = 1 ∧ (F.q 2).1 = 0 ∧ (F.q 3).1 = 1) ∨ + ((F.q 1).1 = 1 ∧ (F.q 2).1 = 1 ∧ (F.q 3).1 = 0) ∨ + ((F.q 1).1 = 0 ∧ (F.q 2).1 = 1 ∧ (F.q 3).1 = 1)) : + Nonempty (P4458T1BoundaryPlacement F D) := by +-- BODY + classical + let I : GaussianInt := ⟨0, 1⟩ + let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => + ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + let L := fun z : GaussianInt => + ![((4 : ℤ), 1 + 8 * z + 4 * I), + (1, 1 + 2 * z), (0, -1), (1, 1 + 2 * z + 2 * I)] + let R := fun z : GaussianInt => + ![((4 : ℤ), 7 + 8 * z + 4 * I), + (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * I), (0, 1)] + have small : ∀ i : Fin 3, (F.q i.succ).1 ≤ 1 := FirstProperRowDetails.small C orientation base + Rminus Rplus hminus hplus F hroot + have hunit : C.1.1.1 = 1 := FirstProperRowDetails.hunit C orientation base Rminus Rplus hminus + hplus F small + -- Classify the literal coordinates before comparing occurrence charts. + have cycCyc (q : Fin 4 → CircleCoordinates) (i j : Fin 3) : + cyc (cyc q i) j = cyc q (i + j) := FirstProperRowDetails.cycCyc q i j + have forestRows : ∀ q : Fin 4 → CircleCoordinates, + SemiProperQuadruple q → ProperBandQuadruple q → + (∀ j : Fin 3, (q j.succ).1 ≤ 1) → + ∃ z : GaussianInt, ∃ k : Fin 3, + q = cyc (L z) k ∨ q = cyc (R z) k := FirstProperRowProof.forestRows C + (FirstProperRowProof.properGt) cycCyc + let r : Fin 4 → CircleCoordinates := cyc F.q F.slot + have hr : ProperBandQuadruple r := FirstProperRowProof.hrAt221 C orientation base Rminus Rplus + hminus hplus F + have hcr : r 1 = C.1.1 := F.parent + have chartEq (e : Bool) (hc : UnitOccurrenceOrientation r 0 e) : orientation = e := + FirstProperRowDetails.chartEq C orientation base Rminus Rplus hminus hplus F hunit hr hcr + (FirstProperRowProof.rotateChart C orientation base Rminus Rplus hminus hplus F) e hc + obtain ⟨z, hrows⟩ : ∃ z : GaussianInt, + (r = L z ∧ orientation = true) ∨ + (r = cyc (L z) 2 ∧ orientation = false) ∨ + (r = R z ∧ orientation = true) ∨ + (r = cyc (R z) 1 ∧ orientation = false) := by + rcases forestRows F.q F.proper.1 F.proper small with ⟨z, k, heq | heq⟩ + · have hr' : r = cyc (L z) (k + F.slot) := FirstProperRowDetails.hr'At615 C orientation base + Rminus Rplus hminus hplus F cycCyc z k heq + generalize k + F.slot = j at hr' + fin_cases j + · have he : r = L z := by + convert hr' using 1; funext j; fin_cases j <;> rfl + refine ⟨z, Or.inl ⟨he, chartEq true ?_⟩⟩ + rw [he] + exact UnitOccurrenceOrientation.leftLower z + · have hu : (r 1).1 = 1 := by rw [hcr]; exact hunit + rw [hr'] at hu + change (0 : ℤ) = 1 at hu + omega + · refine ⟨z, Or.inr (Or.inl ⟨hr', chartEq false ?_⟩)⟩ + rw [hr'] + exact UnitOccurrenceOrientation.rotate + (UnitOccurrenceOrientation.rotate (UnitOccurrenceOrientation.leftUpper z)) + · have hr' : r = cyc (R z) (k + F.slot) := FirstProperRowDetails.hr'At633 C orientation base + Rminus Rplus hminus hplus F cycCyc z k heq + generalize k + F.slot = j at hr' + fin_cases j + · have he : r = R z := by + convert hr' using 1; funext j; fin_cases j <;> rfl + refine ⟨z, Or.inr (Or.inr (Or.inl ⟨he, chartEq true ?_⟩))⟩ + rw [he] + exact UnitOccurrenceOrientation.rightUpper z + · refine ⟨z, Or.inr (Or.inr (Or.inr ⟨hr', chartEq false ?_⟩))⟩ + rw [hr'] + exact UnitOccurrenceOrientation.rotate (UnitOccurrenceOrientation.rightLower z) + · have hu : (r 1).1 = 1 := by rw [hcr]; exact hunit + rw [hr'] at hu + change (0 : ℤ) = 1 at hu + omega + -- These directed base pairs determine all four local edge rows. + have systemLaw : RecursiveVectorSystem BandVectors := by + simpa [BandVectors] using (Classical.choose_spec RecursiveVectorsExistUnique).1 + rcases systemLaw with ⟨zeroLaw, baseLaw, stepLaw, flipLaw⟩ + let x := BandVectors.1 (r 1) (r 3) + let y := BandVectors.1 (r 2) (r 1) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + let Row := fun (e : Bool) (y d ya da : GaussianInt) => + UnitTriangularStep e y ∧ + UnitTriangularStep e d ∧ + y ≠ 0 ∧ d ≠ 0 ∧ + (ya.re : ℝ) = CircleMatrix C 0 0 * y.re + CircleMatrix C 0 1 * y.im ∧ + (ya.im : ℝ) = CircleMatrix C 1 0 * y.re + CircleMatrix C 1 1 * y.im ∧ + (da.re : ℝ) = CircleMatrix C 0 0 * d.re + CircleMatrix C 0 1 * d.im ∧ + (da.im : ℝ) = CircleMatrix C 1 0 * d.re + CircleMatrix C 1 1 * d.im + have htable : Row orientation y (I * x) ya (-I * xa) := FirstProperRowProof.htable C + orientation base Rminus Rplus hminus hplus F hcr z hrows (FirstProperRowProof.rootValues C + baseLaw stepLaw flipLaw) + rcases htable with ⟨hyStep, hxStep, hyNe, hxNe, hyRe, hyIm, hxRe, hxIm⟩ + -- Subtract the actual endpoint offsets from the selected negative piece. + let w := BandVectors.1 (r 3) (r 2) + let wa := BandVectors.2 (r 3) (r 2) + have hw : w = -x - y := FirstProperRowDetails.hw C orientation base Rminus Rplus hminus hplus F hr + have hwa : wa = -xa - ya := FirstProperRowDetails.hwa C orientation base Rminus Rplus hminus + hplus F hr + have hvrec : BandVectors.1 (r 1) (r 0) = x - I * y := + (VectorRecursionLaws r hr.1).2.2.1 + have harec : BandVectors.2 (r 1) (r 0) = xa + I * ya := + (VectorRecursionLaws r hr.1).2.2.2.1 + have hvflip : BandVectors.1 (r 0) (r 1) = I * BandVectors.1 (r 1) (r 0) := + (VectorRecursionLaws r hr.1).2.2.2.2 hr 0 |>.1 + have haflip : BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0) := + (VectorRecursionLaws r hr.1).2.2.2.2 hr 0 |>.2 + have hCpositive : 0 < (F.q F.slot.succ).1 := FirstProperRowDetails.hCpositive C orientation + base Rminus Rplus hminus hplus F + rcases D.occurrences F.slot false with ⟨hUband, hUfoot, hUcent⟩ + have hUcenter : TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = + -(1 / 2 : ℝ) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) := FirstProperRowDetails.hUcenter C + orientation base Rminus Rplus hminus hplus F D hUcent + have hcenter : TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = + GaussianRealPoint y := FirstProperRowDetails.hcenter C orientation base Rminus Rplus hminus + hplus F D hw hvrec hvflip hUcenter (F.minus_centroid) + have hplusCenter : TileCentroid Rplus - TileCentroid (D.tiles F.slot false) = + GaussianRealPoint (I * x) := FirstProperRowDetails.hplusCenter C orientation base Rminus + Rplus hminus hplus F D hw hvrec hvflip hUcenter (F.plus_centroid) + -- Normalize only the join support; the function and endpoints stay literal. + obtain ⟨u, hu, hminusTrans⟩ := F.minus_family + let join := TileTranslation base (u + y) + have hyLattice : y ∈ TilingLattice C := by simp [TilingLattice, hunit] + have hjoinFamily : join ∈ RegularTileFamily base (TilingLattice C) := + ⟨u + y, (TilingLattice C).add_mem hu hyLattice, rfl⟩ + have hjoinBand : BandPrototile C.1.1 join := + BandPrototileTranslation C.1.1 base (u + y) F.base_band + have hjoinCenter : TileCentroid join - TileCentroid Rminus = GaussianRealPoint y := + FirstProperRowDetails.hjoinCenter C orientation base Rminus Rplus hminus hplus F u hminusTrans + have hjoinCenterEq : TileCentroid (D.tiles F.slot false) = TileCentroid join := + FirstProperRowDetails.hjoinCenterEq C orientation base Rminus Rplus hminus hplus F D + hcenter u hjoinCenter + have hjoinCells := BandPrototileCentroidUnique C.1.1 + (D.tiles F.slot false) join (FirstProperRowDetails.hUbandC C orientation base Rminus Rplus + hminus hplus F D hUband) hjoinBand hjoinCenterEq + have hjoinOdo : TileOdometer C.1.1 join (D.functions F.slot false) := + PositiveCurvatureTileOdometerSupportTransport C.1.1 + (D.tiles F.slot false) join (D.functions F.slot false) C.2 + (by rw [← F.parent]; exact D.odometers F.slot false) hjoinBand hjoinCells.1 + have hjoinAncestor : AncestorOdometer C.1.1 F.outer.1.1 + join F.tile (D.functions F.slot false) F.odometer := FirstProperRowProof.hjoinAncestor C + orientation base Rminus Rplus hminus hplus F D hCpositive u hjoinBand hjoinCells + have hrightCenter : TileCentroid Rplus - TileCentroid join = + GaussianRealPoint (I * x) := by rw [← hjoinCenterEq]; exact hplusCenter + have hSlopeInfo : ∃ root child : ℝ × ℝ, + PartialOdometerSlope F.odometer = some root ∧ + PartialOdometerSlope (D.functions F.slot false) = some child ∧ + child.1 - root.1 = -(1 / 2 : ℝ) * ((wa.re : ℝ) - (wa.im : ℝ)) ∧ + child.2 - root.2 = -(1 / 2 : ℝ) * ((wa.im : ℝ) + (wa.re : ℝ)) := + FirstProperRowProof.hSlopeInfo C orientation base Rminus Rplus hminus hplus F D hCpositive + rcases hSlopeInfo with ⟨rootSlope, joinSlope, hrootSlope, hjoinSlope, hre, him⟩ + have hrootSlopeEq : rootSlope = F.outer_slope := + Option.some.inj (hrootSlope.symm.trans F.slope_outer) + rw [hrootSlopeEq] at hre him + have hDoffset : joinSlope - F.outer_slope = + -(1 / 2 : ℝ) • GaussianRealPoint ((1 + I) * wa) := FirstProperRowDetails.hDoffset C + orientation base Rminus Rplus hminus hplus F joinSlope hre him + have pairString (U V : ProtoTile) (d : GaussianInt) + (hU : U ∈ RegularTileFamily base (TilingLattice C)) + (hV : V ∈ RegularTileFamily base (TilingLattice C)) + (hstep : UnitTriangularStep orientation d) (hne : d ≠ 0) + (hcenter : TileCentroid V - TileCentroid U = GaussianRealPoint d) : + TileString C orientation base U V [U, V] := FirstProperRowProof.pairString C orientation + base Rminus Rplus hminus hplus F hunit (FirstProperRowDetails.pointInjective) U V d hU + hV hstep hne hcenter + exact ⟨⟨join, hjoinCells.1.symm, hjoinOdo, hjoinAncestor, + (FirstProperRowDetails.hjoinOccurrence C orientation base Rminus Rplus hminus hplus F D + hUcent u hjoinBand hjoinCenterEq (FirstProperRowDetails.hjoinFoot C orientation base Rminus + Rplus hminus hplus F D u hjoinAncestor)), + .direct (pairString Rminus join y F.minus_family hjoinFamily hyStep hyNe hjoinCenter) + (FirstProperRowDetails.hleftAdjacent C orientation base Rminus Rplus hminus hplus F D + hunit hyStep hyRe hyIm u hjoinCenter hjoinOdo joinSlope hjoinSlope + (FirstProperRowDetails.hminusSlope C orientation base Rminus Rplus hminus hplus F hwa + harec haflip joinSlope hDoffset (F.minus_difference))), + .direct (pairString join Rplus (I * x) hjoinFamily F.plus_family hxStep hxNe hrightCenter) + (FirstProperRowDetails.hrightAdjacent C orientation base Rminus Rplus hminus hplus F D + hunit hxStep hxRe hxIm u hjoinOdo hrightCenter joinSlope hjoinSlope + (FirstProperRowDetails.hplusSlope C orientation base Rminus Rplus hminus hplus F hwa + harec haflip joinSlope hDoffset (F.plus_difference)))⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean new file mode 100644 index 0000000000..d5a60c7512 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean @@ -0,0 +1,2971 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification +public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryFrame +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryPlacement +public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily +public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileString +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P4458T1LargestParentRows] + +/-! +# P4458T1LargestParentRows + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace LargestParentGeometry + +private theorem hq1 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + 4 → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : + Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin + (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - + (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : + GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 + - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : + ℕ))]) → (F.q F.slot.succ = p 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p hstep + have h := congrFun hstep 1 + simpa using h + +private theorem hq2 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + 4 → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : + Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin + (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - + (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : + GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 + - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : + ℕ))]) → (F.q ((F.slot + 1).succ) = p 2) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p hstep + have h := congrFun hstep 2 + simpa using h + +private theorem hq3 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + 4 → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : + Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin + (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - + (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : + GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 + - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : + ℕ))]) → (F.q ((F.slot + 2).succ) = p 3) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p hstep + have h := congrFun hstep 3 + simpa using h + +private theorem houter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + 4 → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : + Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin + (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - + (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : + GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 + - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : + ℕ))]) → (F.q 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 + * (p 2).2 + 2 * (p 3).2 - (p 1).2)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p hstep + have h := congrFun hstep 0 + simpa using h + +private theorem hCpositive : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + 4 → CircleCoordinates), (ProperBandQuadruple p) → ((F.q F.slot.succ = p 0) → (0 < + (F.q F.slot.succ).1)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p hp hq1 + rw [hq1] + exact (ProperBandCurvatureStructure p hp).1 + +private theorem hnegativeSlope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), (0 < (F.q F.slot.succ).1) → (∃ s, PartialOdometerSlope + (D.functions F.slot false) = some s) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D hCpositive + rcases D.slopes F.slot false with hz | ⟨root, child, hroot, hchild, _, _⟩ + · have hz' : (F.q F.slot.succ).1 = 0 := hz + omega + · exact ⟨child, hchild⟩ + +private theorem hr : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ProperBandQuadruple r ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r + have rot : ∀ i : Fin 3, + ProperBandQuadruple + ![F.q 0, F.q i.succ, F.q ((i + 1).succ), F.q ((i + 2).succ)] := by + intro i + fin_cases i + · convert F.proper using 1; funext j; fin_cases j <;> rfl + · refine ⟨SemiProperQuadruple.rotate F.proper.1, ?_⟩ + intro j + fin_cases j + · simpa using F.proper.2 1 + · simpa using F.proper.2 2 + · simpa using F.proper.2 0 + · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate F.proper.1), ?_⟩ + intro j + fin_cases j + · simpa using F.proper.2 2 + · simpa using F.proper.2 0 + · simpa using F.proper.2 1 + simpa [r] using rot F.slot + +private theorem hrstep : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + 4 → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : + Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin + (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - + (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : + GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 + - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : + ℕ))]) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * + (p 3).2 - (p 1).2), p 0, p 2, p 3]) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p hstep r + simpa [r] using hstep + +private theorem hvflip : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + (ProperBandQuadruple r) → ( + let I : GaussianInt := ⟨0, 1⟩ + BandVectors.1 (r 0) (r 1) = I * BandVectors.1 (r 1) (r 0)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r hr I + simpa [I] using + (VectorRecursionLaws r hr.1).2.2.2.2 hr 0 |>.1 + +private theorem haflip : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + (ProperBandQuadruple r) → ( + let I : GaussianInt := ⟨0, 1⟩ + BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r hr I + simpa [I] using + (VectorRecursionLaws r hr.1).2.2.2.2 hr 0 |>.2 + +private theorem hUcenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then (1 : + ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 + : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : + ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : + ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → (TileCentroid (D.tiles + F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r w hUcent + simpa [r, w] using hUcent + +private theorem hMcenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r + simpa [r] using F.minus_centroid + +private theorem hvsumRe : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (w + x + y = 0) → (w.re + x.re + y.re = 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r w x y hvsum + have h := congrArg (fun z : GaussianInt => z.re) hvsum + simpa [w, x, y] using h + +private theorem hvsumIm : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (w + x + y = 0) → (w.im + x.im + y.im = 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r w x y hvsum + have h := congrArg (fun z : GaussianInt => z.im) hvsum + simpa [w, x, y] using h + +private theorem hcenterVector : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (BandVectors.1 (r 1) (r 0) = x - I * y) → ((BandVectors.1 (r 0) (r 1) = I * BandVectors.1 + (r 1) (r 0)) → ((w.re + x.re + y.re = 0) → ((w.im + x.im + y.im = 0) → (-w + I * w - + BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1) = 2 * y)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I w x y hvrec hvflip hvsumRe hvsumIm + rw [hvflip, hvrec] + apply Zsqrtd.ext <;> + norm_num [I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> + omega + +private theorem hcenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • + (GaussianRealPoint w - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) → + ((TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → (((↑(-w + I * w - + BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin + (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).re : ℝ) = (↑((2 : GaussianInt) * y).re : ℝ)) → + (((↑(-w + I * w - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im : ℝ) = (↑((2 : + GaussianInt) * y).im : ℝ)) → (TileCentroid (D.tiles F.slot false) - TileCentroid + Rminus = GaussianRealPoint y)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r I w y hUcenter hMcenter hcenterRe + hcenterIm + rw [show TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile) - + (TileCentroid Rminus - TileCentroid F.tile) by + ext <;> dsimp <;> ring] + rw [hUcenter, hMcenter] + apply Prod.ext + · simp [GaussianRealPoint, w, y, Prod.smul_mk] + norm_num at hcenterRe ⊢ + linarith + · simp [GaussianRealPoint, w, y, Prod.smul_mk] + norm_num at hcenterIm ⊢ + linarith + +private theorem hyLattice : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + (ProperBandQuadruple r) → ( + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (r 1 = C.1.1) → (y ∈ TilingLattice C)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r hr y hRparent + have h := (ParentVectorsInTilingLattice r hr 0 C hRparent).1 + simpa [y] using h + +private theorem translate_add : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), TileTranslation + (TileTranslation T v) z = TileTranslation T (v + z) ) := by + classical + intro T v z + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · ext q + simp [TileTranslation, GaussianTranslation, add_comm, add_left_comm] + · simp [TileTranslation, GaussianTranslation, add_comm, add_left_comm] + +private theorem hjoinBand : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + BandPrototile C.1.1 join ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r y u join + simpa [join] using + BandPrototileTranslation C.1.1 base (u + y) F.base_band + +private theorem hjoinFamily : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (y ∈ TilingLattice C) → (∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + join ∈ RegularTileFamily base (TilingLattice C)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r y hyLattice u join + refine ⟨(u : GaussianInt) + y, (TilingLattice C).add_mem u.property hyLattice, ?_⟩ + rfl + +private theorem hjoinCenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (join = TileTranslation Rminus y) → (TileCentroid join = TileCentroid Rminus + + GaussianRealPoint y) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r y u join hjoin_eq + rw [hjoin_eq, (TileTranslationFormulas Rminus y).2.2.2.2.1] + apply Prod.ext <;> simp [GaussianRealPoint] + +private theorem hjoinCenterEq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = GaussianRealPoint y) → (∀ (u + : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (TileCentroid join = TileCentroid Rminus + GaussianRealPoint y) → (TileCentroid (D.tiles + F.slot false) = TileCentroid join)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r y hcenter u join hjoinCenter + calc + TileCentroid (D.tiles F.slot false) = + (TileCentroid (D.tiles F.slot false) - TileCentroid Rminus) + + TileCentroid Rminus := by ext <;> dsimp <;> ring + _ = GaussianRealPoint y + TileCentroid Rminus := by rw [hcenter] + _ = TileCentroid Rminus + GaussianRealPoint y := by ext <;> dsimp <;> ring + _ = TileCentroid join := hjoinCenter.symm + +private theorem hUbandC : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), (BandPrototile (F.q F.slot.succ) (D.tiles F.slot + false)) → (BandPrototile C.1.1 (D.tiles F.slot false)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D hUband + rw [← F.parent] + exact hUband + +private theorem hjoinOdo : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), (0 < (F.q F.slot.succ).1) → ((TileOdometer (F.q + F.slot.succ) (D.tiles F.slot false) (D.functions F.slot false)) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (BandPrototile C.1.1 join) → (((D.tiles F.slot false).cells = join.cells ∧ ((D.tiles + F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = join.anchor)) → + (TileOdometer C.1.1 join (D.functions F.slot false))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D hCpositive hselectedOdo r y u join + hjoinBand hjoinCells + exact PositiveCurvatureTileOdometerSupportTransport C.1.1 + (D.tiles F.slot false) join (D.functions F.slot false) + (by rw [← F.parent]; exact hCpositive) + (by rw [← F.parent]; exact hselectedOdo) hjoinBand hjoinCells.1 + +private theorem hjoinAncestor : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), (0 < (F.q F.slot.succ).1) → (((F.q F.slot.succ).1 < + (F.q 0).1) → ((AncestorOdometer (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) + F.tile (D.functions F.slot false) + F.odometer) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (BandPrototile C.1.1 join) → (((D.tiles F.slot false).cells = join.cells ∧ ((D.tiles + F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = join.anchor)) → + (AncestorOdometer C.1.1 F.outer.1.1 join F.tile (D.functions F.slot false) + F.odometer))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D hCpositive hstrict hselectedAnc r y u + join hjoinBand hjoinCells + have hstrictOuter : (F.q F.slot.succ).1 < F.outer.1.1.1 := by + rw [← F.child] + exact hstrict + have hAnc := AncestorOdometerInnerSupportNormalization + (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) join F.tile + (D.functions F.slot false) F.odometer hCpositive hstrictOuter hselectedAnc + (by simpa only [← F.parent] using hjoinBand) hjoinCells.1 + simpa only [← F.parent] using hAnc + +private theorem positiveCells : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), + (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → (∀ (c : + CircleCoordinates), ∀ (T : ProtoTile), 0 < c.1 → BandPrototile c T → + T.cells.Nonempty) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F c T hc hT + induction hT with + | line w z hw => simp at hc + | unit z x anchor => simp + | @decompose q hq S T hs hcells hfoot hcentroid ih => + have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by + by_cases h0 : 0 < (q (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (q (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + by_cases h2 : 0 < (q (2 : Fin 3).succ).1 + · exact ⟨2, h2⟩ + have facts := ProperBandCurvatureStructure q hq + have n0 := facts.2.1 (0 : Fin 3) + have n1 := facts.2.1 (1 : Fin 3) + have hzero0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have hzero1 : (q (1 : Fin 3).succ).1 = 0 := by omega + exact False.elim ((by decide : (0 : Fin 3) ≠ 1) + (facts.2.2 0 1 hzero0 hzero1)) + rcases hp with ⟨i, hi⟩ + rcases ih i false hi with ⟨x, hx⟩ + exact ⟨x, (hcells x).mpr ⟨i, false, hx⟩⟩ + +private theorem hjoinFootEq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + ((D.tiles F.slot false).cells = join.cells ∧ ((D.tiles F.slot false).cells = ∅ → (D.tiles + F.slot false).anchor = join.anchor)) → (((D.tiles F.slot false).cells.Nonempty) → + ((join.cells.Nonempty) → (FootprintVertices join = FootprintVertices (D.tiles F.slot + false)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r y u join hjoinCells hUnonempty hJnonempty + simp only [FootprintVertices, ite_eq_left hJnonempty, ite_eq_left hUnonempty] + rw [hjoinCells.1] + +private theorem hjoinFoot : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (FootprintVertices (D.tiles F.slot false) ⊆ FootprintVertices F.tile) → (∀ (u : + ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (FootprintVertices join = FootprintVertices (D.tiles F.slot false)) → (FootprintVertices + join ⊆ FootprintVertices F.tile)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r y hUfoot u join hjoinFootEq + rw [hjoinFootEq] + exact hUfoot + +private theorem hjoinOccurrence : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then (1 : + ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 + : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : + ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : + ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (BandPrototile C.1.1 join) → ((TileCentroid (D.tiles F.slot false) = TileCentroid join) → + ((FootprintVertices join ⊆ FootprintVertices F.tile) → (BandSubtileOccurrence F.q + F.tile F.slot false join)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r y hUcent u join hjoinBand + hjoinCenterEq hjoinFoot + refine ⟨by simpa only [← F.parent] using hjoinBand, hjoinFoot, ?_⟩ + rw [← hjoinCenterEq] + exact hUcent + +private theorem hplusVector : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (BandVectors.1 (r 1) (r 0) = x - I * y) → ((BandVectors.1 (r 0) (r 1) = I * BandVectors.1 + (r 1) (r 0)) → ((w.re + x.re + y.re = 0) → ((w.im + x.im + y.im = 0) → (BandVectors.1 + (r 1) (r 0) + BandVectors.1 (r 0) (r 1) + w - I * w = 2 * I * x)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I w x y hvrec hvflip hvsumRe hvsumIm + rw [hvflip, hvrec] + apply Zsqrtd.ext <;> + norm_num [I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> + omega + +private theorem hPcenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 + (r 1) (r 0) + BandVectors.1 (r 0) (r 1)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r + simpa [r] using F.plus_centroid + +private theorem hPlusJoin : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • + (GaussianRealPoint w - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) → (∀ (u + : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (TileCentroid (D.tiles F.slot false) = TileCentroid join) → ((BandVectors.1 (r 1) (r 0) + + BandVectors.1 (r 0) (r 1) + w - I * w = 2 * I * x) → ((TileCentroid Rplus - + TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (r 1) (r 0) + + BandVectors.1 (r 0) (r 1))) → (TileCentroid Rplus - TileCentroid join = + GaussianRealPoint (I * x))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r I w x y hUcenter u join hjoinCenterEq + hplusVector hPcenter + rw [show TileCentroid Rplus - TileCentroid join = + (TileCentroid Rplus - TileCentroid F.tile) - + (TileCentroid join - TileCentroid F.tile) by + ext <;> dsimp <;> ring] + rw [hPcenter, ← hjoinCenterEq, hUcenter] + have hRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) hplusVector + have hIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) hplusVector + apply Prod.ext + · simp [GaussianRealPoint, I, w, x, Prod.smul_mk] + norm_num at hRe ⊢ + linarith + · simp [GaussianRealPoint, I, w, x, Prod.smul_mk] + norm_num at hIm ⊢ + linarith + +private theorem hSlopeInfo : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), (0 < (F.q F.slot.succ).1) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + ∃ root child : ℝ × ℝ, PartialOdometerSlope F.odometer = some root ∧ PartialOdometerSlope + (D.functions F.slot false) = some child ∧ child.1 - root.1 = -(1 / 2 : ℝ) * (((wa.re + : ℤ) : ℝ) - ((wa.im : ℤ) : ℝ)) ∧ child.2 - root.2 = -(1 / 2 : ℝ) * (((wa.im : ℤ) : ℝ) + + ((wa.re : ℤ) : ℝ))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D hCpositive r wa + rcases D.slopes F.slot false with hzero | hdata + · have hz := hzero + omega + · rcases hdata with ⟨root, child, hroot, hchild, hre, him⟩ + refine ⟨root, child, hroot, hchild, ?_, ?_⟩ + · simpa [r, wa] using hre + · simpa [r, wa] using him + +private theorem hDoffset : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + ∀ (rootSlope : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (joinSlope.1 - rootSlope.1 = -(1 / 2 : ℝ) * + ((↑wa.re : ℝ) - (↑wa.im : ℝ))) → ((joinSlope.2 - rootSlope.2 = -(1 / 2 : ℝ) * + ((↑wa.im : ℝ) + (↑wa.re : ℝ))) → (joinSlope - rootSlope = (-(1 / 2 : ℝ) * ((wa.re : + ℤ) : ℝ) + (1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ), -(1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - (1 / 2 + : ℝ) * ((wa.re : ℤ) : ℝ)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa rootSlope joinSlope hjoinSlopeRe + hjoinSlopeIm + apply Prod.ext <;> dsimp <;> nlinarith [hjoinSlopeRe, hjoinSlopeIm] + +private theorem hFminusSlope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + F.minus_slope - F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r + 1) (r 0))).re - (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) + * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - (GaussianInt.toComplex + (BandVectors.2 (r 0) (r 1))).im)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r + simpa [r, GaussianRealPoint, Prod.smul_mk] using F.minus_difference + +private theorem hFplusSlope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + F.plus_slope - F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r + 1) (r 0))).re + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) + * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im + (GaussianInt.toComplex + (BandVectors.2 (r 0) (r 1))).im)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r + simpa [r, GaussianRealPoint, Prod.smul_mk] using F.plus_difference + +private theorem hasumRe : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (wa + xa + ya = 0) → (wa.re + xa.re + ya.re = 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum + have h := congrArg (fun z : GaussianInt => z.re) hasum + simpa [wa, xa, ya] using h + +private theorem hasumIm : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (wa + xa + ya = 0) → (wa.im + xa.im + ya.im = 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum + have h := congrArg (fun z : GaussianInt => z.im) hasum + simpa [wa, xa, ya] using h + +private theorem ha10Re : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.2 (r 1) (r 0)).re = xa.re - + ya.im) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I xa ya harec + have h := congrArg (fun z : GaussianInt => z.re) harec + have hh : (BandVectors.2 (r 1) (r 0)).re = xa.re + -ya.im := by + simpa [I, xa, ya, Zsqrtd.re_mul, Zsqrtd.im_mul] using h + linarith + +private theorem ha10Im : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.2 (r 1) (r 0)).im = xa.im + + ya.re) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I xa ya harec + have h := congrArg (fun z : GaussianInt => z.im) harec + simpa [I, xa, ya, Zsqrtd.re_mul, Zsqrtd.im_mul] using h + +private theorem ha01Re : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → (((BandVectors.2 (r 1) (r + 0)).im = xa.im + ya.re) → ((BandVectors.2 (r 0) (r 1)).re = xa.im + ya.re)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I xa ya haflip ha10Im + have h := congrArg (fun z : GaussianInt => z.re) haflip + simpa [I, ha10Im, Zsqrtd.re_mul, Zsqrtd.im_mul] using h + +private theorem ha01Im : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → (((BandVectors.2 (r 1) (r + 0)).re = xa.re - ya.im) → ((BandVectors.2 (r 0) (r 1)).im = -xa.re + ya.im)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I xa ya haflip ha10Re + have h := congrArg (fun z : GaussianInt => z.im) haflip + have hh : (BandVectors.2 (r 0) (r 1)).im = ya.im - xa.re := by + simpa [I, ha10Re, Zsqrtd.re_mul, Zsqrtd.im_mul] using h + linarith + +private theorem hminusSlopeVector : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (wa.re + xa.re + ya.re = 0) → ((wa.im + xa.im + ya.im = 0) → (((BandVectors.2 (r 1) (r + 0)).re = xa.re - ya.im) → (((BandVectors.2 (r 1) (r 0)).im = xa.im + ya.re) → + (((BandVectors.2 (r 0) (r 1)).re = xa.im + ya.re) → (((BandVectors.2 (r 0) (r 1)).im + = -xa.re + ya.im) → (-(1 + I) * wa - BandVectors.2 (r 1) (r 0) + BandVectors.2 (r 0) + (r 1) = 2 * ya)))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I wa xa ya hasumRe hasumIm ha10Re ha10Im + ha01Re ha01Im + apply Zsqrtd.ext + · norm_num [I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul] + rw [ha10Re, ha01Re] + omega + · norm_num [I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul] + rw [ha10Im, ha01Im] + omega + +private theorem hplusSlopeVector : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (wa.re + xa.re + ya.re = 0) → ((wa.im + xa.im + ya.im = 0) → (((BandVectors.2 (r 1) (r + 0)).re = xa.re - ya.im) → (((BandVectors.2 (r 1) (r 0)).im = xa.im + ya.re) → ((1 - + I) * BandVectors.2 (r 1) (r 0) + (1 + I) * wa = -2 * I * xa)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I wa xa ya hasumRe hasumIm ha10Re ha10Im + apply Zsqrtd.ext + · norm_num [I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul] + rw [ha10Re] + omega + · norm_num [I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul] + rw [ha10Im] + omega + +private theorem ha10ReC : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ((BandVectors.2 (r 1) (r 0)).re = xa.re - ya.im) → ((∀ (z : GaussianInt), + (GaussianInt.toComplex z).re = (z.re : ℝ)) → ((∀ (z : GaussianInt), + (GaussianInt.toComplex z).im = (z.im : ℝ)) → ((GaussianInt.toComplex (BandVectors.2 + (r 1) (r 0))).re = (GaussianInt.toComplex xa).re - (GaussianInt.toComplex ya).im))) ) + := by + classical + intro C orientation base Rminus Rplus hminus hplus F r xa ya ha10Re toRealRe toRealIm + rw [toRealRe, toRealRe, toRealIm] + exact_mod_cast ha10Re + +private theorem ha10ImC : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ((BandVectors.2 (r 1) (r 0)).im = xa.im + ya.re) → ((∀ (z : GaussianInt), + (GaussianInt.toComplex z).re = (z.re : ℝ)) → ((∀ (z : GaussianInt), + (GaussianInt.toComplex z).im = (z.im : ℝ)) → ((GaussianInt.toComplex (BandVectors.2 + (r 1) (r 0))).im = (GaussianInt.toComplex xa).im + (GaussianInt.toComplex ya).re))) ) + := by + classical + intro C orientation base Rminus Rplus hminus hplus F r xa ya ha10Im toRealRe toRealIm + rw [toRealIm, toRealIm, toRealRe] + exact_mod_cast ha10Im + +private theorem ha01ReC : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ((BandVectors.2 (r 0) (r 1)).re = xa.im + ya.re) → ((∀ (z : GaussianInt), + (GaussianInt.toComplex z).re = (z.re : ℝ)) → ((∀ (z : GaussianInt), + (GaussianInt.toComplex z).im = (z.im : ℝ)) → ((GaussianInt.toComplex (BandVectors.2 + (r 0) (r 1))).re = (GaussianInt.toComplex xa).im + (GaussianInt.toComplex ya).re))) ) + := by + classical + intro C orientation base Rminus Rplus hminus hplus F r xa ya ha01Re toRealRe toRealIm + rw [toRealRe, toRealIm, toRealRe] + exact_mod_cast ha01Re + +private theorem ha01ImC : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ((BandVectors.2 (r 0) (r 1)).im = -xa.re + ya.im) → ((∀ (z : GaussianInt), + (GaussianInt.toComplex z).re = (z.re : ℝ)) → ((∀ (z : GaussianInt), + (GaussianInt.toComplex z).im = (z.im : ℝ)) → ((GaussianInt.toComplex (BandVectors.2 + (r 0) (r 1))).im = -(GaussianInt.toComplex xa).re + (GaussianInt.toComplex ya).im))) + ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r xa ya ha01Im toRealRe toRealIm + rw [toRealIm, toRealRe, toRealIm] + exact_mod_cast ha01Im + +private theorem hsumReC : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (wa.re + xa.re + ya.re = 0) → ((∀ (z : GaussianInt), (GaussianInt.toComplex z).re = (z.re + : ℝ)) → ((GaussianInt.toComplex wa).re + (GaussianInt.toComplex xa).re + + (GaussianInt.toComplex ya).re = 0)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasumRe toRealRe + rw [toRealRe, toRealRe, toRealRe] + exact_mod_cast hasumRe + +private theorem hsumImC : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (wa.im + xa.im + ya.im = 0) → ((∀ (z : GaussianInt), (GaussianInt.toComplex z).im = (z.im + : ℝ)) → ((GaussianInt.toComplex wa).im + (GaussianInt.toComplex xa).im + + (GaussianInt.toComplex ya).im = 0)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasumIm toRealIm + rw [toRealIm, toRealIm, toRealIm] + exact_mod_cast hasumIm + +private theorem hplusVectorRe' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (wa.re + xa.re + ya.re = 0) → ((wa.im + xa.im + ya.im = 0) → (((BandVectors.2 (r 1) (r + 0)).re = xa.re - ya.im) → (((BandVectors.2 (r 1) (r 0)).im = xa.im + ya.re) → + ((BandVectors.2 (r 1) (r 0)).re + (BandVectors.2 (r 1) (r 0)).im + wa.re - wa.im = 2 + * xa.im)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasumRe hasumIm ha10Re ha10Im + omega + +private theorem hplusVectorIm' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (wa.re + xa.re + ya.re = 0) → ((wa.im + xa.im + ya.im = 0) → (((BandVectors.2 (r 1) (r + 0)).re = xa.re - ya.im) → (((BandVectors.2 (r 1) (r 0)).im = xa.im + ya.re) → + ((BandVectors.2 (r 1) (r 0)).im - (BandVectors.2 (r 1) (r 0)).re + wa.im + wa.re = -2 + * xa.re)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasumRe hasumIm ha10Re ha10Im + omega + +private theorem hplusVectorReC : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + (∀ (z : GaussianInt), (GaussianInt.toComplex z).re = (z.re : ℝ)) → ((∀ (z : GaussianInt), + (GaussianInt.toComplex z).im = (z.im : ℝ)) → (((BandVectors.2 (r 1) (r 0)).re + + (BandVectors.2 (r 1) (r 0)).im + wa.re - wa.im = 2 * xa.im) → ((GaussianInt.toComplex + (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex (BandVectors.2 (r 1) (r + 0))).im + (GaussianInt.toComplex wa).re - (GaussianInt.toComplex wa).im = 2 * + (GaussianInt.toComplex xa).im))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa xa toRealRe toRealIm hplusVectorRe' + rw [toRealRe, toRealIm, toRealRe, toRealIm, toRealIm] + exact_mod_cast hplusVectorRe' + +private theorem hplusVectorImC : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + (∀ (z : GaussianInt), (GaussianInt.toComplex z).re = (z.re : ℝ)) → ((∀ (z : GaussianInt), + (GaussianInt.toComplex z).im = (z.im : ℝ)) → (((BandVectors.2 (r 1) (r 0)).im - + (BandVectors.2 (r 1) (r 0)).re + wa.im + wa.re = -2 * xa.re) → + ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - (GaussianInt.toComplex + (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex wa).im + + (GaussianInt.toComplex wa).re = -2 * (GaussianInt.toComplex xa).re))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa xa toRealRe toRealIm hplusVectorIm' + rw [toRealIm, toRealRe, toRealIm, toRealRe, toRealRe] + exact_mod_cast hplusVectorIm' + +private theorem hminusSlope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ∀ (rootSlope : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (rootSlope = F.outer_slope) → ((joinSlope - + rootSlope = (-(1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ) + (1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ), -(1 + / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - (1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ))) → ((F.minus_slope - + F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r + 0))).re - (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) * + ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - (GaussianInt.toComplex + (BandVectors.2 (r 0) (r 1))).im))) → ((-(1 + I) * wa - BandVectors.2 (r 1) (r 0) + + BandVectors.2 (r 0) (r 1) = 2 * ya) → (((GaussianInt.toComplex (BandVectors.2 (r 1) + (r 0))).re = (GaussianInt.toComplex xa).re - (GaussianInt.toComplex ya).im) → + (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im = (GaussianInt.toComplex + xa).im + (GaussianInt.toComplex ya).re) → (((GaussianInt.toComplex (BandVectors.2 (r + 0) (r 1))).re = (GaussianInt.toComplex xa).im + (GaussianInt.toComplex ya).re) → + (((GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im = -(GaussianInt.toComplex + xa).re + (GaussianInt.toComplex ya).im) → (((GaussianInt.toComplex wa).re + + (GaussianInt.toComplex xa).re + (GaussianInt.toComplex ya).re = 0) → + (((GaussianInt.toComplex wa).im + (GaussianInt.toComplex xa).im + + (GaussianInt.toComplex ya).im = 0) → (joinSlope - F.minus_slope = GaussianRealPoint + ya)))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I wa xa ya rootSlope joinSlope + hrootSlopeEq hDoffset hFminusSlope hminusSlopeVector ha10ReC ha10ImC ha01ReC ha01ImC + hsumReC hsumImC + have h := hminusSlopeVector + have hre := congrArg (fun z : GaussianInt => (z.re : ℝ)) h + have him := congrArg (fun z : GaussianInt => (z.im : ℝ)) h + have hDoffset' : joinSlope - rootSlope = + (-(1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ) + + (1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ), + -(1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - + (1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ)) := hDoffset + have hFminusSlope' : F.minus_slope - rootSlope = + ((1 / 2 : ℝ) * + ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re - + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), + (1 / 2 : ℝ) * + ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im)) := by + rw [hrootSlopeEq] + exact hFminusSlope + rw [show joinSlope - F.minus_slope = + (joinSlope - rootSlope) - (F.minus_slope - rootSlope) by + ext <;> dsimp <;> ring] + rw [hDoffset', hFminusSlope'] + apply Prod.ext + · simp [GaussianRealPoint] + norm_num at hre ⊢ + linarith + · simp [GaussianRealPoint] + norm_num at him ⊢ + linarith + +private theorem hplusSlope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ∀ (rootSlope : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (rootSlope = F.outer_slope) → ((joinSlope - + rootSlope = (-(1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ) + (1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ), -(1 + / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - (1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ))) → ((F.plus_slope - + F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r + 0))).re + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) * + ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im + (GaussianInt.toComplex + (BandVectors.2 (r 0) (r 1))).im))) → (((1 - I) * BandVectors.2 (r 1) (r 0) + (1 + I) + * wa = -2 * I * xa) → (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re = + (GaussianInt.toComplex xa).re - (GaussianInt.toComplex ya).im) → + (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im = (GaussianInt.toComplex + xa).im + (GaussianInt.toComplex ya).re) → (((GaussianInt.toComplex (BandVectors.2 (r + 0) (r 1))).re = (GaussianInt.toComplex xa).im + (GaussianInt.toComplex ya).re) → + (((GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im = -(GaussianInt.toComplex + xa).re + (GaussianInt.toComplex ya).im) → (((GaussianInt.toComplex wa).re + + (GaussianInt.toComplex xa).re + (GaussianInt.toComplex ya).re = 0) → + (((GaussianInt.toComplex wa).im + (GaussianInt.toComplex xa).im + + (GaussianInt.toComplex ya).im = 0) → (F.plus_slope - joinSlope = GaussianRealPoint + (-I * xa))))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I wa xa ya rootSlope joinSlope + hrootSlopeEq hDoffset hFplusSlope hplusSlopeVector ha10ReC ha10ImC ha01ReC ha01ImC hsumReC + hsumImC + have hre := congrArg (fun z : GaussianInt => (z.re : ℝ)) hplusSlopeVector + have him := congrArg (fun z : GaussianInt => (z.im : ℝ)) hplusSlopeVector + have hDoffset' : joinSlope - rootSlope = + (-(1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ) + + (1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ), + -(1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - + (1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ)) := hDoffset + have hFplusSlope' : F.plus_slope - rootSlope = + ((1 / 2 : ℝ) * + ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re + + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), + (1 / 2 : ℝ) * + ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im + + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im)) := by + rw [hrootSlopeEq] + exact hFplusSlope + rw [show F.plus_slope - joinSlope = + (F.plus_slope - rootSlope) - (joinSlope - rootSlope) by + ext <;> dsimp <;> ring] + rw [hFplusSlope', hDoffset'] + apply Prod.ext + · simp [GaussianRealPoint] + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] + linarith [ha10ReC, ha01ReC, hsumReC, hsumImC, + hplusVectorReC] + · simp [GaussianRealPoint] + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] + linarith [ha10ImC, ha01ImC, hsumReC, hsumImC, + hplusVectorImC] + +private theorem hCgt1 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), + (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → (∀ (p : Fin 4 + → CircleCoordinates), (ProperBandQuadruple p) → ((C.1.1 = p 0) → (1 < C.1.1.1))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p hp hCcoord + rw [hCcoord] + have hfacts := ProperBandCurvatureStructure p hp + have hpositive' : 0 < (p 0).1 := hfacts.1 + by_contra hn + have hle : (p 0).1 ≤ 1 := by omega + have hz : ∀ i : Fin 3, (p i.succ).1 = 0 := by + intro i + have hnonneg := hfacts.2.1 i + have hbelow := hp.2 i + have : (p i.succ).1 < 1 := by omega + omega + exact (by decide : (0 : Fin 3) ≠ 1) (hfacts.2.2 0 1 (hz 0) (hz 1)) + +private theorem hleftCent : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (TileCentroid join = TileCentroid Rminus + GaussianRealPoint y) → (TileCentroid join - + TileCentroid Rminus = GaussianRealPoint y) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r y u join hjoinCenter + rw [hjoinCenter] + simp [] + +private theorem hbasep : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), + (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → (∀ (p : Fin 4 + → CircleCoordinates), (C.1.1 = p 0) → (BandPrototile (p 0) base)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p hCcoord + rw [← hCcoord] + exact F.base_band + +private theorem hleftTouch : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + 4 → CircleCoordinates), (ProperBandQuadruple p) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (C.1.1 = p 0) → (∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (join ∈ RegularTileFamily base (TilingLattice C)) → ((y = BandVectors.1 (p 2) (p 0)) → + ((TileCentroid join - TileCentroid Rminus = GaussianRealPoint y) → ((BandPrototile (p + 0) base) → (TileTouching Rminus join)))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p hp r y hCcoord u join hjoinFamily hy + hleftCent hbasep + apply (BandRegularTileTouchingClassification C p hp hCcoord.symm base + hbasep Rminus join F.minus_family hjoinFamily).2 + exact ⟨1, Or.inl (by rw [hleftCent, hy]; norm_num [GaussianRealPoint])⟩ + +private theorem hrightTouch : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + 4 → CircleCoordinates), (ProperBandQuadruple p) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (C.1.1 = p 0) → (∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (join ∈ RegularTileFamily base (TilingLattice C)) → ((TileCentroid Rplus - TileCentroid + join = GaussianRealPoint (I * x)) → (((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) = BandVectors.1 (p (3 : Fin + (4 : ℕ))) (p (0 : Fin (4 : ℕ))) ∧ -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 + (p (0 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) = BandVectors.2 (p (3 : Fin (4 : ℕ))) (p + (0 : Fin (4 : ℕ))) ∨ (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (p (0 : Fin + (4 : ℕ))) (p (3 : Fin (4 : ℕ))) = -BandVectors.1 (p (3 : Fin (4 : ℕ))) (p (0 : Fin (4 + : ℕ))) ∧ -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (p (0 : Fin (4 : ℕ))) (p + (3 : Fin (4 : ℕ))) = -BandVectors.2 (p (3 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ)))) → + ((x = BandVectors.1 (p 0) (p 3)) → ((BandPrototile (p 0) base) → (((3 : Fin 4) = + Fin.succ (2 : Fin 3)) → (TileTouching join Rplus)))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p hp r I x y hCcoord u join hjoinFamily + hPlusJoin horientation hx hbasep hindex3 + apply (BandRegularTileTouchingClassification C p hp hCcoord.symm base + hbasep join Rplus hjoinFamily F.plus_family).2 + rcases horientation with horient | horient + · refine ⟨2, Or.inl ?_⟩ + rw [hPlusJoin, hx, horient.1] + simp [GaussianRealPoint, ← hindex3] + · refine ⟨2, Or.inr ?_⟩ + rw [hPlusJoin, hx, horient.1] + simp [GaussianRealPoint] + +private theorem hleftSlope1 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ∀ (joinSlope : ℝ × ℝ), (joinSlope - F.minus_slope = GaussianRealPoint ya) → (joinSlope.1 + - F.minus_slope.1 = (ya.re : ℝ)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r ya joinSlope hleftSlope + have h := congrArg Prod.fst hleftSlope + simpa [GaussianRealPoint] using h + +private theorem hleftSlope2 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ∀ (joinSlope : ℝ × ℝ), (joinSlope - F.minus_slope = GaussianRealPoint ya) → (joinSlope.2 + - F.minus_slope.2 = (ya.im : ℝ)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r ya joinSlope hleftSlope + have h := congrArg Prod.snd hleftSlope + simpa [GaussianRealPoint] using h + +private theorem hleftAdjacent : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (p : Fin 4 → CircleCoordinates), + (ProperBandQuadruple p) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (C.1.1 = p 0) → (∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (TileOdometer C.1.1 join (D.functions F.slot false)) → (∀ (joinSlope : ℝ × ℝ), + (PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → ((y = + BandVectors.1 (p 2) (p 0)) → ((ya = BandVectors.2 (p 2) (p 0)) → ((TileCentroid join + - TileCentroid Rminus = GaussianRealPoint y) → ((joinSlope.1 - F.minus_slope.1 = + (ya.re : ℝ)) → ((joinSlope.2 - F.minus_slope.2 = (ya.im : ℝ)) → (LeftLatticeAdjacent + C Rminus join hminus (D.functions F.slot false)))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D p hp r y ya hCcoord u join hjoinOdo + joinSlope hjoinSlope hy haya hleftCent hleftSlope1 hleftSlope2 + refine ⟨F.minus_odo, hjoinOdo, F.minus_slope, joinSlope, + F.slope_minus, hjoinSlope, ?_⟩ + · right + refine ⟨p, 1, true, hp, hCcoord.symm, ?_, ?_, ?_⟩ + · rw [hleftCent, hy] + norm_num [GaussianRealPoint] + · simpa [haya] using hleftSlope1 + · simpa [haya] using hleftSlope2 + +private theorem hrightSlope1 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + ∀ (joinSlope : ℝ × ℝ), (F.plus_slope - joinSlope = GaussianRealPoint (-I * xa)) → + (F.plus_slope.1 - joinSlope.1 = ((-I * xa).re : ℝ)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I xa joinSlope hrightSlope + have h := congrArg Prod.fst hrightSlope + simpa [GaussianRealPoint] using h + +private theorem hrightSlope2 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + ∀ (joinSlope : ℝ × ℝ), (F.plus_slope - joinSlope = GaussianRealPoint (-I * xa)) → + (F.plus_slope.2 - joinSlope.2 = ((-I * xa).im : ℝ)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I xa joinSlope hrightSlope + have h := congrArg Prod.snd hrightSlope + simpa [GaussianRealPoint] using h + +private theorem hrightAdjacent : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (p : Fin 4 → CircleCoordinates), + (ProperBandQuadruple p) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + (C.1.1 = p 0) → (∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (TileOdometer C.1.1 join (D.functions F.slot false)) → ((TileCentroid Rplus - + TileCentroid join = GaussianRealPoint (I * x)) → (∀ (joinSlope : ℝ × ℝ), + (PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → (((⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) * BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) = + BandVectors.1 (p (3 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) ∧ -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) = + BandVectors.2 (p (3 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) ∨ (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) = + -BandVectors.1 (p (3 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) ∧ -(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) = + -BandVectors.2 (p (3 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ)))) → ((x = BandVectors.1 (p + 0) (p 3)) → ((xa = BandVectors.2 (p 0) (p 3)) → (((3 : Fin 4) = Fin.succ (2 : Fin 3)) + → ((F.plus_slope.1 - joinSlope.1 = ((-I * xa).re : ℝ)) → ((F.plus_slope.2 - + joinSlope.2 = ((-I * xa).im : ℝ)) → (LeftLatticeAdjacent C join Rplus (D.functions + F.slot false) hplus))))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D p hp r I x y xa hCcoord u join hjoinOdo + hPlusJoin joinSlope hjoinSlope horientation hx hxa hindex3 hrightSlope1 hrightSlope2 + refine ⟨hjoinOdo, F.plus_odo, joinSlope, F.plus_slope, + hjoinSlope, F.slope_plus, ?_⟩ + rcases horientation with horient | horient + · right + refine ⟨p, 2, true, hp, hCcoord.symm, ?_, ?_, ?_⟩ + · rw [hPlusJoin, hx, horient.1] + simp [GaussianRealPoint, ← hindex3] + · simpa [hindex3] using (calc + F.plus_slope.1 - joinSlope.1 = ((-I * xa).re : ℝ) := hrightSlope1 + _ = ((BandVectors.2 (p 3) (p 0)).re : ℝ) := by + rw [hxa] + have ha := congrArg (fun z : GaussianInt => z.re) horient.2 + exact_mod_cast ha + ) + · simpa [hindex3] using (calc + F.plus_slope.2 - joinSlope.2 = ((-I * xa).im : ℝ) := hrightSlope2 + _ = ((BandVectors.2 (p 3) (p 0)).im : ℝ) := by + rw [hxa] + have ha := congrArg (fun z : GaussianInt => z.im) horient.2 + exact_mod_cast ha + ) + · right + refine ⟨p, 2, false, hp, hCcoord.symm, ?_, ?_, ?_⟩ + · rw [hPlusJoin, hx, horient.1] + simp [GaussianRealPoint] + · simpa [hindex3] using (calc + F.plus_slope.1 - joinSlope.1 = ((-I * xa).re : ℝ) := hrightSlope1 + _ = -((BandVectors.2 (p 3) (p 0)).re : ℝ) := by + rw [hxa] + have ha := congrArg (fun z : GaussianInt => z.re) horient.2 + exact_mod_cast ha + ) + · simpa [hindex3] using (calc + F.plus_slope.2 - joinSlope.2 = ((-I * xa).im : ℝ) := hrightSlope2 + _ = -((BandVectors.2 (p 3) (p 0)).im : ℝ) := by + rw [hxa] + have ha := congrArg (fun z : GaussianInt => z.im) horient.2 + exact_mod_cast ha + ) + +private theorem hMnonempty : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), + (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → ((∀ (c : + CircleCoordinates), ∀ (T : ProtoTile), 0 < c.1 → BandPrototile c T → + T.cells.Nonempty) → ((1 < C.1.1.1) → (Rminus.cells.Nonempty))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F positiveCells hCgt1 + apply positiveCells C.1.1 Rminus (by omega) + exact TileOdometerBandPrototile C.1.1 Rminus hminus F.minus_odo + +private theorem hPnonempty : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), + (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → ((∀ (c : + CircleCoordinates), ∀ (T : ProtoTile), 0 < c.1 → BandPrototile c T → + T.cells.Nonempty) → ((1 < C.1.1.1) → (Rplus.cells.Nonempty))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F positiveCells hCgt1 + apply positiveCells C.1.1 Rplus (by omega) + exact TileOdometerBandPrototile C.1.1 Rplus hplus F.plus_odo + +private theorem hleftNe : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (TileTouching Rminus join) → ((Rminus.cells.Nonempty) → (Rminus ≠ join)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r y u join hleftTouch hMnonempty heq + have ht := hleftTouch + rw [← heq] at ht + rcases ht with h | h | h + · exact hMnonempty.ne_empty ((Finset.disjoint_self_iff_empty _).mp h.2.2.1) + · exact hMnonempty.ne_empty h.1 + · exact hMnonempty.ne_empty h.1 + +private theorem hrightNe : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (TileTouching join Rplus) → ((Rplus.cells.Nonempty) → (join ≠ Rplus)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r y u join hrightTouch hPnonempty heq + have ht := hrightTouch + rw [heq] at ht + rcases ht with h | h | h + · exact hPnonempty.ne_empty ((Finset.disjoint_self_iff_empty _).mp h.2.2.1) + · exact hPnonempty.ne_empty h.1 + · exact hPnonempty.ne_empty h.1 + +private theorem leftString : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (p : Fin 4 → CircleCoordinates), (![F.q (0 : Fin (4 + : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin + (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ((F.q F.slot.succ = p 0) → + ((F.q ((F.slot + 1).succ) = p 2) → ((F.q ((F.slot + 2).succ) = p 3) → ((F.q 0 = (2 * + (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p + 3).2 - (p 1).2)) → ((0 < (F.q F.slot.succ).1) → (((F.q F.slot.succ).1 < (F.q 0).1) → + ((AncestorOdometer (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) F.tile + (D.functions F.slot false) + F.odometer) → ((TileOdometer (F.q F.slot.succ) (D.tiles F.slot false) (D.functions + F.slot false)) → ((∃ s, PartialOdometerSlope (D.functions F.slot false) = some s) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + (ProperBandQuadruple r) → ((r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * + (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → ((r 1 = p 0) → ((r + 2 = p 2) → ((r 3 = p 3) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (w + x + y = 0) → ((wa + xa + ya = 0) → ((BandVectors.1 (r 1) (r 0) = x - I * y) → + ((BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.1 (r 0) (r 1) = I * + BandVectors.1 (r 1) (r 0)) → ((BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) + (r 0)) → ((BandPrototile (F.q F.slot.succ) (D.tiles F.slot false)) → + ((FootprintVertices (D.tiles F.slot false) ⊆ FootprintVertices F.tile) → + ((TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then + (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q + (F.slot + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q + (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → + ((TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • + (GaussianRealPoint w - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) → + ((TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → ((w.re + x.re + y.re = 0) + → ((w.im + x.im + y.im = 0) → ((-w + I * w - BandVectors.1 (r 1) (r 0) + + BandVectors.1 (r 0) (r 1) = 2 * y) → (((↑(-w + I * w - BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ)))).re : ℝ) = (↑((2 : GaussianInt) * y).re : ℝ)) → (((↑(-w + I * w - BandVectors.1 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r + (1 : Fin (4 : ℕ)))).im : ℝ) = (↑((2 : GaussianInt) * y).im : ℝ)) → ((TileCentroid + (D.tiles F.slot false) - TileCentroid Rminus = GaussianRealPoint y) → ((r 1 = C.1.1) + → ((y ∈ TilingLattice C) → (∀ (u : ↥(TilingLattice C)), (Rminus = TileTranslation + base (↑u : GaussianInt)) → ((∀ (y : ↥(TilingLattice C)), (fun (u : ↥(TilingLattice + C)) => Rminus = TileTranslation base (↑u : GaussianInt)) y → y = u) → ( + let join : ProtoTile := TileTranslation base (u + y) + (join = TileTranslation Rminus y) → ((BandPrototile C.1.1 join) → ((join ∈ + RegularTileFamily base (TilingLattice C)) → ((TileCentroid join = TileCentroid Rminus + + GaussianRealPoint y) → ((TileCentroid (D.tiles F.slot false) = TileCentroid join) → + ((BandPrototile C.1.1 (D.tiles F.slot false)) → (((D.tiles F.slot false).cells = + join.cells ∧ ((D.tiles F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = + join.anchor)) → ((TileOdometer C.1.1 join (D.functions F.slot false)) → + ((AncestorOdometer C.1.1 F.outer.1.1 join F.tile (D.functions F.slot false) + F.odometer) → (((D.tiles F.slot false).cells.Nonempty) → ((join.cells.Nonempty) → + ((FootprintVertices join = FootprintVertices (D.tiles F.slot false)) → + ((FootprintVertices join ⊆ FootprintVertices F.tile) → ((BandSubtileOccurrence F.q + F.tile F.slot false join) → ((BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1) + + w - I * w = 2 * I * x) → ((TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • + GaussianRealPoint (BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1))) → + ((TileCentroid Rplus - TileCentroid join = GaussianRealPoint (I * x)) → (∀ (rootSlope + : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (PartialOdometerSlope F.odometer = some rootSlope) → + ((PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → ((joinSlope.1 - + rootSlope.1 = -(1 / 2 : ℝ) * ((↑wa.re : ℝ) - (↑wa.im : ℝ))) → ((joinSlope.2 - + rootSlope.2 = -(1 / 2 : ℝ) * ((↑wa.im : ℝ) + (↑wa.re : ℝ))) → ((rootSlope = + F.outer_slope) → ((joinSlope - rootSlope = (-(1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ) + (1 / 2 + : ℝ) * ((wa.im : ℤ) : ℝ), -(1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - (1 / 2 : ℝ) * ((wa.re : + ℤ) : ℝ))) → ((F.minus_slope - F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex + (BandVectors.2 (r 1) (r 0))).re - (GaussianInt.toComplex (BandVectors.2 (r 0) (r + 1))).re), (1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im))) → ((F.plus_slope - + F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r + 0))).re + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) * + ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im + (GaussianInt.toComplex + (BandVectors.2 (r 0) (r 1))).im))) → ((wa.re + xa.re + ya.re = 0) → ((wa.im + xa.im + + ya.im = 0) → (((BandVectors.2 (r 1) (r 0)).re = xa.re - ya.im) → (((BandVectors.2 (r + 1) (r 0)).im = xa.im + ya.re) → (((BandVectors.2 (r 0) (r 1)).re = xa.im + ya.re) → + (((BandVectors.2 (r 0) (r 1)).im = -xa.re + ya.im) → ((-(1 + I) * wa - BandVectors.2 + (r 1) (r 0) + BandVectors.2 (r 0) (r 1) = 2 * ya) → (((1 - I) * BandVectors.2 (r 1) + (r 0) + (1 + I) * wa = -2 * I * xa) → (((GaussianInt.toComplex (BandVectors.2 (r 1) + (r 0))).re = (GaussianInt.toComplex xa).re - (GaussianInt.toComplex ya).im) → + (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im = (GaussianInt.toComplex + xa).im + (GaussianInt.toComplex ya).re) → (((GaussianInt.toComplex (BandVectors.2 (r + 0) (r 1))).re = (GaussianInt.toComplex xa).im + (GaussianInt.toComplex ya).re) → + (((GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im = -(GaussianInt.toComplex + xa).re + (GaussianInt.toComplex ya).im) → (((GaussianInt.toComplex wa).re + + (GaussianInt.toComplex xa).re + (GaussianInt.toComplex ya).re = 0) → + (((GaussianInt.toComplex wa).im + (GaussianInt.toComplex xa).im + + (GaussianInt.toComplex ya).im = 0) → (((((1 : GaussianInt) - I) * BandVectors.2 (r (1 + : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + ((1 : GaussianInt) + I) * wa).re = ((-2 : + GaussianInt) * I * xa).re) → (((((1 : GaussianInt) - I) * BandVectors.2 (r (1 : Fin + (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + ((1 : GaussianInt) + I) * wa).im = ((-2 : + GaussianInt) * I * xa).im) → (((BandVectors.2 (r 1) (r 0)).re + (BandVectors.2 (r 1) + (r 0)).im + wa.re - wa.im = 2 * xa.im) → (((BandVectors.2 (r 1) (r 0)).im - + (BandVectors.2 (r 1) (r 0)).re + wa.im + wa.re = -2 * xa.re) → + (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex + (BandVectors.2 (r 1) (r 0))).im + (GaussianInt.toComplex wa).re - + (GaussianInt.toComplex wa).im = 2 * (GaussianInt.toComplex xa).im) → + (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - (GaussianInt.toComplex + (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex wa).im + + (GaussianInt.toComplex wa).re = -2 * (GaussianInt.toComplex xa).re) → ((joinSlope - + F.minus_slope = GaussianRealPoint ya) → ((F.plus_slope - joinSlope = + GaussianRealPoint (-I * xa)) → ((y = BandVectors.1 (p 2) (p 0)) → ((x = BandVectors.1 + (p 0) (p 3)) → ((xa = BandVectors.2 (p 0) (p 3)) → ((ya = BandVectors.2 (p 2) (p 0)) + → ((TileCentroid join - TileCentroid Rminus = GaussianRealPoint y) → ((TileTouching + Rminus join) → ((TileTouching join Rplus) → ((joinSlope - F.minus_slope = + GaussianRealPoint ya) → ((joinSlope.1 - F.minus_slope.1 = (ya.re : ℝ)) → + ((joinSlope.2 - F.minus_slope.2 = (ya.im : ℝ)) → ((LeftLatticeAdjacent C Rminus join + hminus (D.functions F.slot false)) → ((F.plus_slope - joinSlope = GaussianRealPoint + (-I * xa)) → ((F.plus_slope.1 - joinSlope.1 = ((-I * xa).re : ℝ)) → ((F.plus_slope.2 + - joinSlope.2 = ((-I * xa).im : ℝ)) → ((LeftLatticeAdjacent C join Rplus (D.functions + F.slot false) hplus) → ((Rminus.cells.Nonempty) → ((Rminus ≠ join) → ((join ≠ Rplus) + → ((C.1.1.1 ≠ 1) → (TileString C orientation base Rminus join [Rminus, + join]))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + ))))))))))))))))))))))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D p hstep hq1 hq2 hq3 houter hCpositive + hstrict hselectedAnc hselectedOdo hnegativeSlope r hr hrstep hr1 hr2 hr3 I w x y wa xa ya + hvsum hasum hvrec harec hvflip haflip hUband hUfoot hUcent hUcenter hMcenter hvsumRe + hvsumIm hcenterVector hcenterRe hcenterIm hcenter hRparent hyLattice u huRminus + hRminusUnique join hjoin_eq hjoinBand hjoinFamily hjoinCenter hjoinCenterEq hUbandC + hjoinCells hjoinOdo hjoinAncestor hUnonempty hJnonempty hjoinFootEq hjoinFoot + hjoinOccurrence hplusVector hPcenter hPlusJoin rootSlope joinSlope hrootSlope hjoinSlope + hjoinSlopeRe hjoinSlopeIm hrootSlopeEq hDoffset hFminusSlope hFplusSlope hasumRe hasumIm + ha10Re ha10Im ha01Re ha01Im hminusSlopeVector hplusSlopeVector ha10ReC ha10ImC ha01ReC + ha01ImC hsumReC hsumImC hplusVectorRe hplusVectorIm hplusVectorRe' hplusVectorIm' + hplusVectorReC hplusVectorImC hminusSlope hplusSlope hy hx hxa haya hleftCent hleftTouch + hrightTouch hleftSlope hleftSlope1 hleftSlope2 hleftAdjacent hrightSlope hrightSlope1 + hrightSlope2 hrightAdjacent hMnonempty hleftNe hrightNe hnonunit + unfold TileString + refine ⟨F.base_band, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rfl + · rfl + · simpa using hleftNe + · intro T hT + simp only [List.mem_cons] at hT + rcases hT with hT | hT + · rcases hT with rfl + exact F.minus_family + · rcases hT with hT | hT + · rcases hT with rfl + exact hjoinFamily + · simp at hT + · simpa [List.IsChain, List.isChain_pair, hnonunit] using hleftTouch + · intro pre T post heq hpre hpost + have hlen := congrArg List.length heq + have hp : 1 ≤ pre.length := by + cases pre with + | nil => simp at hpre + | cons x xs => simp + have hq : 1 ≤ post.length := by + cases post with + | nil => simp at hpost + | cons x xs => simp + simp at hlen + omega + +private theorem rightString : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (p : Fin 4 → CircleCoordinates), (![F.q (0 : Fin (4 + : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : + ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : + GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin + (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ((F.q F.slot.succ = p 0) → + ((F.q ((F.slot + 1).succ) = p 2) → ((F.q ((F.slot + 2).succ) = p 3) → ((F.q 0 = (2 * + (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p + 3).2 - (p 1).2)) → ((0 < (F.q F.slot.succ).1) → (((F.q F.slot.succ).1 < (F.q 0).1) → + ((AncestorOdometer (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) F.tile + (D.functions F.slot false) + F.odometer) → ((TileOdometer (F.q F.slot.succ) (D.tiles F.slot false) (D.functions + F.slot false)) → ((∃ s, PartialOdometerSlope (D.functions F.slot false) = some s) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + (ProperBandQuadruple r) → ((r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * + (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → ((r 1 = p 0) → ((r + 2 = p 2) → ((r 3 = p 3) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (w + x + y = 0) → ((wa + xa + ya = 0) → ((BandVectors.1 (r 1) (r 0) = x - I * y) → + ((BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.1 (r 0) (r 1) = I * + BandVectors.1 (r 1) (r 0)) → ((BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) + (r 0)) → ((BandPrototile (F.q F.slot.succ) (D.tiles F.slot false)) → + ((FootprintVertices (D.tiles F.slot false) ⊆ FootprintVertices F.tile) → + ((TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then + (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q + (F.slot + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q + (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → + ((TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • + (GaussianRealPoint w - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) → + ((TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → ((w.re + x.re + y.re = 0) + → ((w.im + x.im + y.im = 0) → ((-w + I * w - BandVectors.1 (r 1) (r 0) + + BandVectors.1 (r 0) (r 1) = 2 * y) → (((↑(-w + I * w - BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ)))).re : ℝ) = (↑((2 : GaussianInt) * y).re : ℝ)) → (((↑(-w + I * w - BandVectors.1 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r + (1 : Fin (4 : ℕ)))).im : ℝ) = (↑((2 : GaussianInt) * y).im : ℝ)) → ((TileCentroid + (D.tiles F.slot false) - TileCentroid Rminus = GaussianRealPoint y) → ((r 1 = C.1.1) + → ((y ∈ TilingLattice C) → (∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (join = TileTranslation Rminus y) → ((BandPrototile C.1.1 join) → ((join ∈ + RegularTileFamily base (TilingLattice C)) → ((TileCentroid join = TileCentroid Rminus + + GaussianRealPoint y) → ((TileCentroid (D.tiles F.slot false) = TileCentroid join) → + ((BandPrototile C.1.1 (D.tiles F.slot false)) → (((D.tiles F.slot false).cells = + join.cells ∧ ((D.tiles F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = + join.anchor)) → ((TileOdometer C.1.1 join (D.functions F.slot false)) → + ((AncestorOdometer C.1.1 F.outer.1.1 join F.tile (D.functions F.slot false) + F.odometer) → (((D.tiles F.slot false).cells.Nonempty) → ((join.cells.Nonempty) → + ((FootprintVertices join = FootprintVertices (D.tiles F.slot false)) → + ((FootprintVertices join ⊆ FootprintVertices F.tile) → ((BandSubtileOccurrence F.q + F.tile F.slot false join) → ((BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1) + + w - I * w = 2 * I * x) → ((TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • + GaussianRealPoint (BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1))) → + ((TileCentroid Rplus - TileCentroid join = GaussianRealPoint (I * x)) → (∀ (rootSlope + : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (PartialOdometerSlope F.odometer = some rootSlope) → + ((PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → ((joinSlope.1 - + rootSlope.1 = -(1 / 2 : ℝ) * ((↑wa.re : ℝ) - (↑wa.im : ℝ))) → ((joinSlope.2 - + rootSlope.2 = -(1 / 2 : ℝ) * ((↑wa.im : ℝ) + (↑wa.re : ℝ))) → ((rootSlope = + F.outer_slope) → ((joinSlope - rootSlope = (-(1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ) + (1 / 2 + : ℝ) * ((wa.im : ℤ) : ℝ), -(1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - (1 / 2 : ℝ) * ((wa.re : + ℤ) : ℝ))) → ((F.minus_slope - F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex + (BandVectors.2 (r 1) (r 0))).re - (GaussianInt.toComplex (BandVectors.2 (r 0) (r + 1))).re), (1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im))) → ((F.plus_slope - + F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r + 0))).re + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) * + ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im + (GaussianInt.toComplex + (BandVectors.2 (r 0) (r 1))).im))) → ((wa.re + xa.re + ya.re = 0) → ((wa.im + xa.im + + ya.im = 0) → (((BandVectors.2 (r 1) (r 0)).re = xa.re - ya.im) → (((BandVectors.2 (r + 1) (r 0)).im = xa.im + ya.re) → (((BandVectors.2 (r 0) (r 1)).re = xa.im + ya.re) → + (((BandVectors.2 (r 0) (r 1)).im = -xa.re + ya.im) → ((-(1 + I) * wa - BandVectors.2 + (r 1) (r 0) + BandVectors.2 (r 0) (r 1) = 2 * ya) → (((1 - I) * BandVectors.2 (r 1) + (r 0) + (1 + I) * wa = -2 * I * xa) → (((GaussianInt.toComplex (BandVectors.2 (r 1) + (r 0))).re = (GaussianInt.toComplex xa).re - (GaussianInt.toComplex ya).im) → + (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im = (GaussianInt.toComplex + xa).im + (GaussianInt.toComplex ya).re) → (((GaussianInt.toComplex (BandVectors.2 (r + 0) (r 1))).re = (GaussianInt.toComplex xa).im + (GaussianInt.toComplex ya).re) → + (((GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im = -(GaussianInt.toComplex + xa).re + (GaussianInt.toComplex ya).im) → (((GaussianInt.toComplex wa).re + + (GaussianInt.toComplex xa).re + (GaussianInt.toComplex ya).re = 0) → + (((GaussianInt.toComplex wa).im + (GaussianInt.toComplex xa).im + + (GaussianInt.toComplex ya).im = 0) → (((((1 : GaussianInt) - I) * BandVectors.2 (r (1 + : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + ((1 : GaussianInt) + I) * wa).re = ((-2 : + GaussianInt) * I * xa).re) → (((((1 : GaussianInt) - I) * BandVectors.2 (r (1 : Fin + (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + ((1 : GaussianInt) + I) * wa).im = ((-2 : + GaussianInt) * I * xa).im) → (((BandVectors.2 (r 1) (r 0)).re + (BandVectors.2 (r 1) + (r 0)).im + wa.re - wa.im = 2 * xa.im) → (((BandVectors.2 (r 1) (r 0)).im - + (BandVectors.2 (r 1) (r 0)).re + wa.im + wa.re = -2 * xa.re) → + (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex + (BandVectors.2 (r 1) (r 0))).im + (GaussianInt.toComplex wa).re - + (GaussianInt.toComplex wa).im = 2 * (GaussianInt.toComplex xa).im) → + (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - (GaussianInt.toComplex + (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex wa).im + + (GaussianInt.toComplex wa).re = -2 * (GaussianInt.toComplex xa).re) → ((joinSlope - + F.minus_slope = GaussianRealPoint ya) → ((F.plus_slope - joinSlope = + GaussianRealPoint (-I * xa)) → ((y = BandVectors.1 (p 2) (p 0)) → ((x = BandVectors.1 + (p 0) (p 3)) → ((xa = BandVectors.2 (p 0) (p 3)) → ((ya = BandVectors.2 (p 2) (p 0)) + → ((TileCentroid join - TileCentroid Rminus = GaussianRealPoint y) → ((TileTouching + Rminus join) → ((TileTouching join Rplus) → ((joinSlope - F.minus_slope = + GaussianRealPoint ya) → ((joinSlope.1 - F.minus_slope.1 = (ya.re : ℝ)) → + ((joinSlope.2 - F.minus_slope.2 = (ya.im : ℝ)) → ((LeftLatticeAdjacent C Rminus join + hminus (D.functions F.slot false)) → ((F.plus_slope - joinSlope = GaussianRealPoint + (-I * xa)) → ((F.plus_slope.1 - joinSlope.1 = ((-I * xa).re : ℝ)) → ((F.plus_slope.2 + - joinSlope.2 = ((-I * xa).im : ℝ)) → ((LeftLatticeAdjacent C join Rplus (D.functions + F.slot false) hplus) → ((Rplus.cells.Nonempty) → ((Rminus ≠ join) → ((join ≠ Rplus) → + ((C.1.1.1 ≠ 1) → ((TileString C orientation base Rminus join [Rminus, join]) → + (TileString C orientation base join Rplus [join, + Rplus])))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + ))))))))))))))))))))))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D p hstep hq1 hq2 hq3 houter hCpositive + hstrict hselectedAnc hselectedOdo hnegativeSlope r hr hrstep hr1 hr2 hr3 I w x y wa xa ya + hvsum hasum hvrec harec hvflip haflip hUband hUfoot hUcent hUcenter hMcenter hvsumRe + hvsumIm hcenterVector hcenterRe hcenterIm hcenter hRparent hyLattice u join hjoin_eq + hjoinBand hjoinFamily hjoinCenter hjoinCenterEq hUbandC hjoinCells hjoinOdo hjoinAncestor + hUnonempty hJnonempty hjoinFootEq hjoinFoot hjoinOccurrence hplusVector hPcenter hPlusJoin + rootSlope joinSlope hrootSlope hjoinSlope hjoinSlopeRe hjoinSlopeIm hrootSlopeEq hDoffset + hFminusSlope hFplusSlope hasumRe hasumIm ha10Re ha10Im ha01Re ha01Im hminusSlopeVector + hplusSlopeVector ha10ReC ha10ImC ha01ReC ha01ImC hsumReC hsumImC hplusVectorRe + hplusVectorIm hplusVectorRe' hplusVectorIm' hplusVectorReC hplusVectorImC hminusSlope + hplusSlope hy hx hxa haya hleftCent hleftTouch hrightTouch hleftSlope hleftSlope1 + hleftSlope2 hleftAdjacent hrightSlope hrightSlope1 hrightSlope2 hrightAdjacent hPnonempty + hleftNe hrightNe hnonunit leftString + unfold TileString + refine ⟨F.base_band, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rfl + · rfl + · simpa using hrightNe + · intro T hT + simp only [List.mem_cons] at hT + rcases hT with hT | hT + · rcases hT with rfl + exact hjoinFamily + · rcases hT with hT | hT + · rcases hT with rfl + exact F.plus_family + · simp at hT + · simpa [List.IsChain, List.isChain_pair, hnonunit] using hrightTouch + · intro pre T post heq hpre hpost + have hlen := congrArg List.length heq + have hp : 1 ≤ pre.length := by + cases pre with + | nil => simp at hpre + | cons x xs => simp + have hq : 1 ≤ post.length := by + cases post with + | nil => simp at hpost + | cons x xs => simp + simp at hlen + omega + +end LargestParentGeometry + +namespace LargestParentConclusion + +private theorem largestParentCertificate : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (p : Fin 4 → CircleCoordinates), + (ProperBandQuadruple p) → ((![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 + : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : + ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : + GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 + - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : + ℕ))]) → ((F.q F.slot.succ = p 0) → ((F.q ((F.slot + 1).succ) = p 2) → ((F.q ((F.slot + + 2).succ) = p 3) → ((F.q (0 : Fin (4 : ℕ)) = ((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 + : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : + ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin + (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2)) + → (((0 : ℤ) < (F.q F.slot.succ).1) → (((F.q F.slot.succ).1 < (F.q 0).1) → + ((AncestorOdometer (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) F.tile + (D.functions F.slot false) + F.odometer) → ((TileOdometer (F.q F.slot.succ) (D.tiles F.slot false) (D.functions + F.slot false)) → ((∃ (s : ℝ × ℝ), PartialOdometerSlope (D.functions F.slot false) = + some s) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + (ProperBandQuadruple r) → (( + let r := ![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, + F.q (F.slot + (2 : Fin (3 : ℕ))).succ]; r = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 + : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : + ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin + (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), + p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ((r 1 = p 0) → ((r + 2 = p 2) → ((r 3 = p 3) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (w + x + y = 0) → ((wa + xa + ya = 0) → ((BandVectors.1 (r 1) (r 0) = x - I * y) → + ((BandVectors.2 (r 1) (r 0) = xa + I * ya) → (( + let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) + = I * BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin + (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ)))) → (( + let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) + = -I * BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : + Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q + (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ)))) → ((BandPrototile (F.q + F.slot.succ) (D.tiles F.slot false)) → ((FootprintVertices (D.tiles F.slot false) ⊆ + FootprintVertices F.tile) → ((TileCentroid (D.tiles F.slot false) - TileCentroid + F.tile = (if false = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q + (F.slot + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (F.q + (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q + (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → ((TileCentroid (D.tiles F.slot false) - + TileCentroid F.tile = -(1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ)))) - (-(GaussianRealPoint (BandVectors.1 (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 + : ℕ))))).2, (GaussianRealPoint (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : + ℕ))))).1))) → (( + let r := ![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, + F.q (F.slot + (2 : Fin (3 : ℕ))).succ]; TileCentroid Rminus - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : + ℕ))) - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))))) → (((BandVectors.1 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ)))).re + (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : + ℕ)))).re + (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 + : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))).re = (0 : ℤ)) → + (((BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 + : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).im + (BandVectors.1 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ)))).im + (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))).im = (0 : ℤ)) → + ((-BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 + : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) - BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) + + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 + : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) = (2 : GaussianInt) * BandVectors.1 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ)))) → (((↑(-BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + - BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 + : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).re : ℝ) = (↑((2 : GaussianInt) * BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).re : ℝ)) → (((↑(-BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) * BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) - BandVectors.1 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ))) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).im : ℝ) = (↑((2 : GaussianInt) * BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).im : ℝ)) → ((TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = + GaussianRealPoint (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))))) → ((C.1.1 = p + 0) → ((r 1 = C.1.1) → ((BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) ∈ TilingLattice + C) → (∀ (u : ↥(TilingLattice C)), (Rminus = TileTranslation base (↑u : GaussianInt)) + → ((∀ (y : ↥(TilingLattice C)), (fun (u : ↥(TilingLattice C)) => Rminus = + TileTranslation base (↑u : GaussianInt)) y → y = u) → ( + let join : ProtoTile := TileTranslation base (u + y) + (join = TileTranslation Rminus y) → (( + let join := TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 + : ℕ)))); BandPrototile C.1.1 join) → (( + let join := TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 + : ℕ)))); join ∈ RegularTileFamily base (TilingLattice C)) → ((TileCentroid + (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ))))) = TileCentroid Rminus + GaussianRealPoint (BandVectors.1 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 + : ℕ))))) → ((TileCentroid (D.tiles F.slot false) = TileCentroid (TileTranslation base + ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))))) → + ((BandPrototile C.1.1 (D.tiles F.slot false)) → (((D.tiles F.slot false).cells = + join.cells ∧ ((D.tiles F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = + join.anchor)) → ((TileOdometer C.1.1 (TileTranslation base ((↑u : GaussianInt) + + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))))) (D.functions F.slot false)) → + ((AncestorOdometer C.1.1 F.outer.1.1 + (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ))))) F.tile (D.functions F.slot false) F.odometer) → ((∀ (c : CircleCoordinates), ∀ + (T : ProtoTile), (0 : ℤ) < c.1 → BandPrototile c T → Finset.Nonempty T.cells) → + (((D.tiles F.slot false).cells.Nonempty) → ((join.cells.Nonempty) → + ((FootprintVertices (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q + (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))))) = FootprintVertices (D.tiles F.slot false)) → + ((FootprintVertices (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q + (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))))) ⊆ FootprintVertices F.tile) → ((BandSubtileOccurrence + F.q F.tile F.slot false (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ)))))) → ((BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) + + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 + : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + = (2 : GaussianInt) * (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ)))) → (( + let r := ![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, + F.q (F.slot + (2 : Fin (3 : ℕ))).succ]; TileCentroid Rplus - TileCentroid F.tile = (1 + / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : + ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))))) → ((TileCentroid + Rplus - TileCentroid (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q + (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))))) = GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))))) → (∀ (rootSlope : ℝ × ℝ), ∀ + (joinSlope : ℝ × ℝ), (PartialOdometerSlope F.odometer = some rootSlope) → + ((PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → ((joinSlope.1 - + rootSlope.1 = -(1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : + ℕ)))).re : ℝ) - (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).im : ℝ))) → + ((joinSlope.2 - rootSlope.2 = -(1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 + : ℕ)))).im : ℝ) + (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).re : ℝ))) → + ((rootSlope = F.outer_slope) → ((joinSlope - rootSlope = (-(1 / 2 : ℝ) * + (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 + : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).re : ℝ) + (1 / 2 : ℝ) * (↑(BandVectors.2 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ)))).im : ℝ), -(1 / 2 : ℝ) * (↑(BandVectors.2 (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ)))).im : ℝ) - (1 / 2 : ℝ) * (↑(BandVectors.2 (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ)))).re : ℝ))) → (( + let r := ![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, + F.q (F.slot + (2 : Fin (3 : ℕ))).succ]; F.minus_slope - F.outer_slope = ((1 / 2 : ℝ) + * (((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))))).re - ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 + (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))))).re), (1 / 2 : ℝ) * + (((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))))).im - ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 + (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))))).im))) → (( + let r := ![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, + F.q (F.slot + (2 : Fin (3 : ℕ))).succ]; F.plus_slope - F.outer_slope = ((1 / 2 : ℝ) * + (((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))))).re + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 + (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))))).re), (1 / 2 : ℝ) * + (((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))))).im + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 + (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))))).im))) → (((BandVectors.2 (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ)))).re + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : + ℕ)))).re + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 + : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))).re = (0 : ℤ)) → + (((BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 + : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).im + (BandVectors.2 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ)))).im + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))).im = (0 : ℤ)) → + (((BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 + : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ)))).re = (BandVectors.2 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ)))).re - (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))).im) → (((BandVectors.2 (![F.q + (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ)))).im = (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : + ℕ)))).im + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 + : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))).re) → (((BandVectors.2 (![F.q + (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ)))).re = (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : + ℕ)))).im + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 + : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))).re) → (((BandVectors.2 (![F.q + (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ)))).im = -(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : + ℕ)))).re + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 + : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))).im) → ((-((1 : GaussianInt) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + - BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 + : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) + BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) + = (2 : GaussianInt) * BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))) → ((((1 : + GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.2 (![F.q (0 : Fin (4 + : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 + : ℕ))) + ((1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.2 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) = (-2 : GaussianInt) * (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ)))) → ((((GaussianInt.toComplex : + GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))))).re = + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : + ℕ))))).re - ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 + : ℕ))))).im) → ((((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ))))).im = ((GaussianInt.toComplex : GaussianInt → ℂ) + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))))).im + ((GaussianInt.toComplex : GaussianInt → + ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin + (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))))).re) → ((((GaussianInt.toComplex : + GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))))).re = + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : + ℕ))))).im + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 + : ℕ))))).re) → ((((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))))).im = -((GaussianInt.toComplex : GaussianInt → ℂ) + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))))).re + ((GaussianInt.toComplex : GaussianInt → + ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin + (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))))).im) → ((((GaussianInt.toComplex : + GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))))).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : + ℕ))))).re + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 + : ℕ))))).re = (0 : ℝ)) → ((((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))))).im + ((GaussianInt.toComplex : GaussianInt → ℂ) + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))))).im + ((GaussianInt.toComplex : GaussianInt → + ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin + (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))))).im = (0 : ℝ)) → (((((1 : GaussianInt) - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) + + ((1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.2 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ)))).re = ((-2 : GaussianInt) * (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ)))).re) → (((((1 : GaussianInt) - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) + + ((1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.2 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ)))).im = ((-2 : GaussianInt) * (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ)))).im) → (((BandVectors.2 (![F.q + (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ)))).re + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : + ℕ)))).im + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 + : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).re - (BandVectors.2 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ)))).im = (2 : ℤ) * (BandVectors.2 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ)))).im) → (((BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ)))).im - (BandVectors.2 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ)))).re + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : + ℕ)))).im + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 + : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).re = (-2 : ℤ) * (BandVectors.2 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ)))).re) → ((((GaussianInt.toComplex : GaussianInt → ℂ) + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))))).re + ((GaussianInt.toComplex : GaussianInt → + ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin + (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))))).im + ((GaussianInt.toComplex : + GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))))).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : + ℕ))))).im = (2 : ℝ) * ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))))).im) → ((((GaussianInt.toComplex : GaussianInt → ℂ) + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))))).im - ((GaussianInt.toComplex : GaussianInt → + ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin + (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))))).re + ((GaussianInt.toComplex : + GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))))).im + + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : + ℕ))))).re = (-2 : ℝ) * ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))))).re) → ((joinSlope - F.minus_slope = GaussianRealPoint + ya) → ((F.plus_slope - joinSlope = GaussianRealPoint (-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))))) → (Nonempty + (P4458T1BoundaryPlacement F + D))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + )))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D p hp hstep hq1 hq2 hq3 houter hCpositive + hstrict hselectedAnc hselectedOdo hnegativeSlope r hr hrstep hr1 hr2 hr3 I w x y wa xa ya + hvsum hasum hvrec harec hvflip haflip hUband hUfoot hUcent hUcenter hMcenter hvsumRe + hvsumIm hcenterVector hcenterRe hcenterIm hcenter hCcoord hRparent hyLattice u huRminus + hRminusUnique join hjoin_eq hjoinBand hjoinFamily hjoinCenter hjoinCenterEq hUbandC + hjoinCells hjoinOdo hjoinAncestor positiveCells hUnonempty hJnonempty hjoinFootEq hjoinFoot + hjoinOccurrence hplusVector hPcenter hPlusJoin rootSlope joinSlope hrootSlope hjoinSlope + hjoinSlopeRe hjoinSlopeIm hrootSlopeEq hDoffset hFminusSlope hFplusSlope hasumRe hasumIm + ha10Re ha10Im ha01Re ha01Im hminusSlopeVector hplusSlopeVector ha10ReC ha10ImC ha01ReC + ha01ImC hsumReC hsumImC hplusVectorRe hplusVectorIm hplusVectorRe' hplusVectorIm' + hplusVectorReC hplusVectorImC hminusSlope hplusSlope + have hCgt1 := LargestParentGeometry.hCgt1 C orientation base Rminus Rplus hminus hplus F p hp + hCcoord + have hpTangency : BandTangency (p 0) (p 3) := by + exact ⟨p, hp.1, 0, 3, by decide, rfl, rfl⟩ + have horientation := BandVectorOrientationDichotomy (p 0) (p 3) hpTangency + have hy : y = BandVectors.1 (p 2) (p 0) := by + simp [y, hr2, hr1] + have hx : x = BandVectors.1 (p 0) (p 3) := by + simp [x, hr1, hr3] + have hxa : xa = BandVectors.2 (p 0) (p 3) := by + simp [xa, hr1, hr3] + have haya : ya = BandVectors.2 (p 2) (p 0) := by + simp [ya, hr2, hr1] + have hleftCent := LargestParentGeometry.hleftCent C orientation base Rminus Rplus hminus hplus + F u hjoinCenter + have hbasep := LargestParentGeometry.hbasep C orientation base Rminus Rplus hminus hplus F p + hCcoord + have hindex3 : (3 : Fin 4) = Fin.succ (2 : Fin 3) := by decide + have hleftTouch := LargestParentGeometry.hleftTouch C orientation base Rminus Rplus hminus + hplus F p hp hCcoord u hjoinFamily hy hleftCent hbasep + have hrightTouch := LargestParentGeometry.hrightTouch C orientation base Rminus Rplus hminus + hplus F p hp hCcoord u hjoinFamily hPlusJoin horientation hx hbasep hindex3 + have hleftSlope : joinSlope - F.minus_slope = GaussianRealPoint ya := by + rw [hminusSlope] + have hleftSlope1 := LargestParentGeometry.hleftSlope1 C orientation base Rminus Rplus hminus + hplus F joinSlope hleftSlope + have hleftSlope2 := LargestParentGeometry.hleftSlope2 C orientation base Rminus Rplus hminus + hplus F joinSlope hleftSlope + have hleftAdjacent := LargestParentGeometry.hleftAdjacent C orientation base Rminus Rplus + hminus hplus F D p hp hCcoord u hjoinOdo joinSlope hjoinSlope hy haya hleftCent hleftSlope1 + hleftSlope2 + have hrightSlope : F.plus_slope - joinSlope = GaussianRealPoint (-I * xa) := hplusSlope + have hrightSlope1 := LargestParentGeometry.hrightSlope1 C orientation base Rminus Rplus hminus + hplus F joinSlope hrightSlope + have hrightSlope2 := LargestParentGeometry.hrightSlope2 C orientation base Rminus Rplus hminus + hplus F joinSlope hrightSlope + have hrightAdjacent := LargestParentGeometry.hrightAdjacent C orientation base Rminus Rplus + hminus hplus F D p hp hCcoord u hjoinOdo hPlusJoin joinSlope hjoinSlope horientation hx hxa + hindex3 hrightSlope1 hrightSlope2 + have hMnonempty := LargestParentGeometry.hMnonempty C orientation base Rminus Rplus hminus + hplus F positiveCells hCgt1 + have hPnonempty := LargestParentGeometry.hPnonempty C orientation base Rminus Rplus hminus + hplus F positiveCells hCgt1 + have hleftNe := LargestParentGeometry.hleftNe C orientation base Rminus Rplus hminus hplus F u + hleftTouch hMnonempty + have hrightNe := LargestParentGeometry.hrightNe C orientation base Rminus Rplus hminus hplus F + u hrightTouch hPnonempty + have hnonunit : C.1.1.1 ≠ 1 := by omega + have leftString := LargestParentGeometry.leftString C orientation base Rminus Rplus hminus + hplus F D p hstep hq1 hq2 hq3 houter hCpositive hstrict hselectedAnc hselectedOdo + hnegativeSlope hr hrstep hr1 hr2 hr3 hvsum hasum hvrec harec hvflip haflip hUband hUfoot + hUcent hUcenter hMcenter hvsumRe hvsumIm hcenterVector hcenterRe hcenterIm hcenter hRparent + hyLattice u huRminus hRminusUnique hjoin_eq hjoinBand hjoinFamily hjoinCenter hjoinCenterEq + hUbandC hjoinCells hjoinOdo hjoinAncestor hUnonempty hJnonempty hjoinFootEq hjoinFoot + hjoinOccurrence hplusVector hPcenter hPlusJoin rootSlope joinSlope hrootSlope hjoinSlope + hjoinSlopeRe hjoinSlopeIm hrootSlopeEq hDoffset hFminusSlope hFplusSlope hasumRe hasumIm + ha10Re ha10Im ha01Re ha01Im hminusSlopeVector hplusSlopeVector ha10ReC ha10ImC ha01ReC + ha01ImC hsumReC hsumImC hplusVectorRe hplusVectorIm hplusVectorRe' hplusVectorIm' + hplusVectorReC hplusVectorImC hminusSlope hplusSlope hy hx hxa haya hleftCent hleftTouch + hrightTouch hleftSlope hleftSlope1 hleftSlope2 hleftAdjacent hrightSlope hrightSlope1 + hrightSlope2 hrightAdjacent hMnonempty hleftNe hrightNe hnonunit + refine ⟨⟨join, hjoinCells.1.symm, hjoinOdo, hjoinAncestor, + hjoinOccurrence, .direct leftString hleftAdjacent, + .direct (LargestParentGeometry.rightString C orientation base Rminus Rplus hminus hplus F D p + hstep hq1 hq2 hq3 houter hCpositive hstrict hselectedAnc hselectedOdo hnegativeSlope hr + hrstep hr1 hr2 hr3 hvsum hasum hvrec harec hvflip haflip hUband hUfoot hUcent hUcenter + hMcenter hvsumRe hvsumIm hcenterVector hcenterRe hcenterIm hcenter hRparent hyLattice u + hjoin_eq hjoinBand hjoinFamily hjoinCenter hjoinCenterEq hUbandC hjoinCells hjoinOdo + hjoinAncestor hUnonempty hJnonempty hjoinFootEq hjoinFoot hjoinOccurrence hplusVector + hPcenter hPlusJoin rootSlope joinSlope hrootSlope hjoinSlope hjoinSlopeRe hjoinSlopeIm + hrootSlopeEq hDoffset hFminusSlope hFplusSlope hasumRe hasumIm ha10Re ha10Im ha01Re + ha01Im hminusSlopeVector hplusSlopeVector ha10ReC ha10ImC ha01ReC ha01ImC hsumReC hsumImC + hplusVectorRe hplusVectorIm hplusVectorRe' hplusVectorIm' hplusVectorReC hplusVectorImC + hminusSlope hplusSlope hy hx hxa haya hleftCent hleftTouch hrightTouch hleftSlope + hleftSlope1 hleftSlope2 hleftAdjacent hrightSlope hrightSlope1 hrightSlope2 + hrightAdjacent hPnonempty hleftNe hrightNe hnonunit leftString) hrightAdjacent⟩⟩ + +end LargestParentConclusion + +theorem P4458T1LargestParentRows + {C : BandCircle} {orientation : Bool} {base Rminus Rplus : ProtoTile} + {hminus hplus : PartialOdometer} + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) + (D : P4458T1RestrictionFamily F) + (a : Fin 3) (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (hstep : ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3]) + (selected : F.slot = a) : + Nonempty (P4458T1BoundaryPlacement F D) := by +-- BODY + classical + subst a + have hq1 : F.q F.slot.succ = p 0 := LargestParentGeometry.hq1 C orientation base Rminus Rplus + hminus hplus F p hstep + have hq2 : F.q ((F.slot + 1).succ) = p 2 := LargestParentGeometry.hq2 C orientation base Rminus + Rplus hminus hplus F p hstep + have hq3 : F.q ((F.slot + 2).succ) = p 3 := LargestParentGeometry.hq3 C orientation base Rminus + Rplus hminus hplus F p hstep + have houter := LargestParentGeometry.houter C orientation base Rminus Rplus hminus hplus F p hstep + have hCpositive := LargestParentGeometry.hCpositive C orientation base Rminus Rplus hminus + hplus F p hp hq1 + have hstrict : (F.q F.slot.succ).1 < (F.q 0).1 := F.proper.2 F.slot + have hselectedAnc := D.ancestors F.slot false hCpositive + have hselectedOdo := D.odometers F.slot false + have hselectedOcc := D.occurrences F.slot false + have hnegativeSlope := LargestParentGeometry.hnegativeSlope C orientation base Rminus Rplus + hminus hplus F D hCpositive + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + have hr : ProperBandQuadruple r := LargestParentGeometry.hr C orientation base Rminus Rplus + hminus hplus F + have hrstep := LargestParentGeometry.hrstep C orientation base Rminus Rplus hminus hplus F p hstep + have hr1 : r 1 = p 0 := by simpa [r] using hq1 + have hr2 : r 2 = p 2 := by simpa [r] using hq2 + have hr3 : r 3 = p 3 := by simpa [r] using hq3 + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + have hvsum : w + x + y = 0 := by + simpa [w, x, y] using (VectorRecursionLaws r hr.1).1 + have hasum : wa + xa + ya = 0 := by + simpa [wa, xa, ya] using (VectorRecursionLaws r hr.1).2.1 + have hvrec : BandVectors.1 (r 1) (r 0) = x - I * y := by + simpa [x, y, I] using (VectorRecursionLaws r hr.1).2.2.1 + have harec : BandVectors.2 (r 1) (r 0) = xa + I * ya := by + simpa [xa, ya, I] using (VectorRecursionLaws r hr.1).2.2.2.1 + have hvflip := LargestParentGeometry.hvflip C orientation base Rminus Rplus hminus hplus F hr + have haflip := LargestParentGeometry.haflip C orientation base Rminus Rplus hminus hplus F hr + rcases hselectedOcc with ⟨hUband, hUfoot, hUcent⟩ + have hUcenter := LargestParentGeometry.hUcenter C orientation base Rminus Rplus hminus hplus F + D hUcent + have hMcenter := LargestParentGeometry.hMcenter C orientation base Rminus Rplus hminus hplus F + have hvsumRe := LargestParentGeometry.hvsumRe C orientation base Rminus Rplus hminus hplus F hvsum + have hvsumIm := LargestParentGeometry.hvsumIm C orientation base Rminus Rplus hminus hplus F hvsum + have hcenterVector := LargestParentGeometry.hcenterVector C orientation base Rminus Rplus + hminus hplus F hvrec hvflip hvsumRe hvsumIm + have hcenterRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) hcenterVector + have hcenterIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) hcenterVector + have hcenter := LargestParentGeometry.hcenter C orientation base Rminus Rplus hminus hplus F D + hUcenter hMcenter hcenterRe hcenterIm + have hCcoord : C.1.1 = p 0 := F.parent.symm.trans hq1 + have hRparent : r 1 = C.1.1 := by simpa [r] using F.parent + have hyLattice := LargestParentGeometry.hyLattice C orientation base Rminus Rplus hminus hplus + F hr hRparent + obtain ⟨u, huRminus, hRminusUnique⟩ := + RegularTileFamilyTranslationUnique base (TilingLattice C) Rminus F.minus_family + let join : ProtoTile := TileTranslation base (u + y) + have translate_add (T : ProtoTile) (v z : GaussianInt) : + TileTranslation (TileTranslation T v) z = TileTranslation T (v + z) := + LargestParentGeometry.translate_add T v z + have hjoin_eq : join = TileTranslation Rminus y := by + simpa [join, huRminus] using (translate_add base (u : GaussianInt) y).symm + have hjoinBand := LargestParentGeometry.hjoinBand C orientation base Rminus Rplus hminus hplus F u + have hjoinFamily := LargestParentGeometry.hjoinFamily C orientation base Rminus Rplus hminus + hplus F hyLattice u + have hjoinCenter := LargestParentGeometry.hjoinCenter C orientation base Rminus Rplus hminus + hplus F u hjoin_eq + have hjoinCenterEq := LargestParentGeometry.hjoinCenterEq C orientation base Rminus Rplus + hminus hplus F D hcenter u hjoinCenter + have hUbandC := LargestParentGeometry.hUbandC C orientation base Rminus Rplus hminus hplus F D + hUband + have hjoinCells := BandPrototileCentroidUnique C.1.1 + (D.tiles F.slot false) join hUbandC hjoinBand + hjoinCenterEq + have hjoinOdo := LargestParentGeometry.hjoinOdo C orientation base Rminus Rplus hminus hplus F + D hCpositive hselectedOdo u hjoinBand hjoinCells + have hjoinAncestor := LargestParentGeometry.hjoinAncestor C orientation base Rminus Rplus + hminus hplus F D hCpositive hstrict hselectedAnc u hjoinBand hjoinCells + have positiveCells := LargestParentGeometry.positiveCells C orientation base Rminus Rplus + hminus hplus F + have hUnonempty : (D.tiles F.slot false).cells.Nonempty := + positiveCells _ _ hCpositive hUband + have hJnonempty : join.cells.Nonempty := by rw [← hjoinCells.1]; exact hUnonempty + have hjoinFootEq := LargestParentGeometry.hjoinFootEq C orientation base Rminus Rplus hminus + hplus F D u hjoinCells hUnonempty hJnonempty + have hjoinFoot := LargestParentGeometry.hjoinFoot C orientation base Rminus Rplus hminus hplus + F D hUfoot u hjoinFootEq + have hjoinOccurrence := LargestParentGeometry.hjoinOccurrence C orientation base Rminus Rplus + hminus hplus F D hUcent u hjoinBand hjoinCenterEq hjoinFoot + have hplusVector := LargestParentGeometry.hplusVector C orientation base Rminus Rplus hminus + hplus F hvrec hvflip hvsumRe hvsumIm + have hPcenter := LargestParentGeometry.hPcenter C orientation base Rminus Rplus hminus hplus F + have hPlusJoin := LargestParentGeometry.hPlusJoin C orientation base Rminus Rplus hminus hplus + F D hUcenter u hjoinCenterEq hplusVector hPcenter + have hSlopeInfo := LargestParentGeometry.hSlopeInfo C orientation base Rminus Rplus hminus + hplus F D hCpositive + rcases hSlopeInfo with ⟨rootSlope, joinSlope, hrootSlope, hjoinSlope, + hjoinSlopeRe, hjoinSlopeIm⟩ + have hrootSlopeEq : rootSlope = F.outer_slope := + Option.some.inj (hrootSlope.symm.trans F.slope_outer) + have hDoffset := LargestParentGeometry.hDoffset C orientation base Rminus Rplus hminus hplus F + rootSlope joinSlope hjoinSlopeRe hjoinSlopeIm + have hFminusSlope := LargestParentGeometry.hFminusSlope C orientation base Rminus Rplus hminus + hplus F + have hFplusSlope := LargestParentGeometry.hFplusSlope C orientation base Rminus Rplus hminus + hplus F + have hasumRe := LargestParentGeometry.hasumRe C orientation base Rminus Rplus hminus hplus F hasum + have hasumIm := LargestParentGeometry.hasumIm C orientation base Rminus Rplus hminus hplus F hasum + have ha10Re := LargestParentGeometry.ha10Re C orientation base Rminus Rplus hminus hplus F harec + have ha10Im := LargestParentGeometry.ha10Im C orientation base Rminus Rplus hminus hplus F harec + have ha01Re := LargestParentGeometry.ha01Re C orientation base Rminus Rplus hminus hplus F + haflip ha10Im + have ha01Im := LargestParentGeometry.ha01Im C orientation base Rminus Rplus hminus hplus F + haflip ha10Re + have hminusSlopeVector := LargestParentGeometry.hminusSlopeVector C orientation base Rminus + Rplus hminus hplus F hasumRe hasumIm ha10Re ha10Im ha01Re ha01Im + have hplusSlopeVector := LargestParentGeometry.hplusSlopeVector C orientation base Rminus Rplus + hminus hplus F hasumRe hasumIm ha10Re ha10Im + have toRealRe (z : GaussianInt) : + (GaussianInt.toComplex z).re = (z.re : ℝ) := + (GaussianInt.intCast_re z).symm + have toRealIm (z : GaussianInt) : + (GaussianInt.toComplex z).im = (z.im : ℝ) := + (GaussianInt.intCast_im z).symm + have ha10ReC := LargestParentGeometry.ha10ReC C orientation base Rminus Rplus hminus hplus F + ha10Re toRealRe toRealIm + have ha10ImC := LargestParentGeometry.ha10ImC C orientation base Rminus Rplus hminus hplus F + ha10Im toRealRe toRealIm + have ha01ReC := LargestParentGeometry.ha01ReC C orientation base Rminus Rplus hminus hplus F + ha01Re toRealRe toRealIm + have ha01ImC := LargestParentGeometry.ha01ImC C orientation base Rminus Rplus hminus hplus F + ha01Im toRealRe toRealIm + have hsumReC := LargestParentGeometry.hsumReC C orientation base Rminus Rplus hminus hplus F + hasumRe toRealRe + have hsumImC := LargestParentGeometry.hsumImC C orientation base Rminus Rplus hminus hplus F + hasumIm toRealIm + have hplusVectorRe := congrArg (fun z : GaussianInt => z.re) hplusSlopeVector + have hplusVectorIm := congrArg (fun z : GaussianInt => z.im) hplusSlopeVector + have hplusVectorRe' := LargestParentGeometry.hplusVectorRe' C orientation base Rminus Rplus + hminus hplus F hasumRe hasumIm ha10Re ha10Im + have hplusVectorIm' := LargestParentGeometry.hplusVectorIm' C orientation base Rminus Rplus + hminus hplus F hasumRe hasumIm ha10Re ha10Im + have hplusVectorReC := LargestParentGeometry.hplusVectorReC C orientation base Rminus Rplus + hminus hplus F toRealRe toRealIm hplusVectorRe' + have hplusVectorImC := LargestParentGeometry.hplusVectorImC C orientation base Rminus Rplus + hminus hplus F toRealRe toRealIm hplusVectorIm' + have hminusSlope : joinSlope - F.minus_slope = GaussianRealPoint ya := + LargestParentGeometry.hminusSlope C orientation base Rminus Rplus hminus hplus F rootSlope + joinSlope hrootSlopeEq hDoffset hFminusSlope hminusSlopeVector ha10ReC ha10ImC ha01ReC + ha01ImC hsumReC hsumImC + have hplusSlope := LargestParentGeometry.hplusSlope C orientation base Rminus Rplus hminus + hplus F rootSlope joinSlope hrootSlopeEq hDoffset hFplusSlope hplusSlopeVector ha10ReC + ha10ImC ha01ReC ha01ImC hsumReC hsumImC + have largestParentCertificate : + Nonempty (P4458T1BoundaryPlacement F D) := LargestParentConclusion.largestParentCertificate + C orientation base Rminus Rplus hminus hplus F D p hp hstep hq1 hq2 hq3 houter hCpositive + hstrict hselectedAnc hselectedOdo hnegativeSlope hr hrstep hr1 hr2 hr3 hvsum hasum hvrec + harec hvflip haflip hUband hUfoot hUcent hUcenter hMcenter hvsumRe hvsumIm hcenterVector + hcenterRe hcenterIm hcenter hCcoord hRparent hyLattice u huRminus hRminusUnique hjoin_eq + hjoinBand hjoinFamily hjoinCenter hjoinCenterEq hUbandC hjoinCells hjoinOdo hjoinAncestor + positiveCells hUnonempty hJnonempty hjoinFootEq hjoinFoot hjoinOccurrence hplusVector + hPcenter hPlusJoin rootSlope joinSlope hrootSlope hjoinSlope hjoinSlopeRe hjoinSlopeIm + hrootSlopeEq hDoffset hFminusSlope hFplusSlope hasumRe hasumIm ha10Re ha10Im ha01Re + ha01Im hminusSlopeVector hplusSlopeVector ha10ReC ha10ImC ha01ReC ha01ImC hsumReC hsumImC + hplusVectorRe hplusVectorIm hplusVectorRe' hplusVectorIm' hplusVectorReC hplusVectorImC + hminusSlope hplusSlope + exact largestParentCertificate + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean b/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean new file mode 100644 index 0000000000..1c001c680b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean @@ -0,0 +1,708 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer + +-- [TABLET NODE: P4458T1RespectAppend] + +/-! +# P4458T1RespectAppend + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RespectAppendProof + +private theorem dropLastForall₂ : + ∀ {α : Type}, ∀ {β : Type}, ∀ {Rel : α → β → Prop}, ∀ {xs : List α}, ∀ {ys : List β}, + (List.Forall₂ Rel xs ys) → (List.Forall₂ Rel xs.dropLast ys.dropLast) := by + classical + intro α β Rel xs ys hall + induction hall with + | nil => simp + | @cons x y xs ys hxy htail ih => + cases htail with + | nil => simp + | cons hnext hrest => + simpa only [List.dropLast_cons_cons] using List.Forall₂.cons hxy ih + +private theorem zipDropLast : + ∀ {α : Type}, ∀ {β : Type}, ∀ (xs : List α), ∀ (ys : List β), (xs.length = ys.length) → + (xs.dropLast.zip ys.dropLast = (xs.zip ys).dropLast) := by + classical + intro α β xs ys hlen + induction xs generalizing ys with + | nil => cases ys <;> simp_all + | cons x xs ih => + cases ys with + | nil => simp at hlen + | cons y ys => + cases xs with + | nil => cases ys <;> simp + | cons x' xs => + cases ys with + | nil => simp at hlen + | cons y' ys => + have ht : (x' :: xs).length = (y' :: ys).length := by simpa using hlen + simp only [List.dropLast_cons_cons, List.zip_cons_cons] + congr 1 + exact ih (y' :: ys) ht + +private theorem hrightZipShape : + ∀ (C : BandCircle), ∀ (C₀ : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (R : + ProtoTile), ∀ (J : ProtoTile), ∀ (S : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (hJ : + PartialOdometer), ∀ (hS : PartialOdometer), ∀ (h₀ : PartialOdometer), ∀ (left : List + ProtoTile), ∀ (right : List ProtoTile), ∀ (hl : List PartialOdometer), ∀ (hr : List + PartialOdometer), (hr.head? = some hJ) → ((hr.getLast? = some hS) → ((TileString C + orientation base R S (left.dropLast ++ right)) → ((∀ U ∈ (List.drop (1 : ℕ) + right).dropLast, ∃ (g : PartialOdometer), (U, g) ∈ right.zip hr ∧ AncestorOdometer C.1.1 + C₀.1.1 U T₀ g h₀) → ((List.Forall₂ (fun (T : ProtoTile) (h : PartialOdometer) + => TileOdometer C.1.1 T h) right hr) → + ((List.IsChain (fun (X Y : ProtoTile × PartialOdometer) => LeftLatticeAdjacent C X.1 Y.1 + X.2 Y.2) (right.zip hr)) → ((right.length = hr.length) → ((right.head? = some J) → + ((right.getLast? = some S) → ((List.Pairwise (fun (T U : ProtoTile) => T ≠ U) right) → + ((∀ T ∈ right, T ∈ RegularTileFamily base (TilingLattice C)) → ((List.IsChain (fun (T U : + ProtoTile) => if C.1.1.1 = (1 : ℤ) then ∃ (v : + GaussianInt), UnitTriangularStep orientation v ∧ TileCentroid U - TileCentroid T = + GaussianRealPoint v else TileTouching T U) right) → ((∀ (pre : List ProtoTile), ∀ (T : + ProtoTile), ∀ (post : List ProtoTile), right = pre ++ T :: post → pre ≠ [] → post ≠ [] → + (0 : ℝ) ≤ (fun (T : ProtoTile) => ((TileCentroid T).2 - (TileCentroid J).2) * + ((TileCentroid S).1 - (TileCentroid J).1) - ((TileCentroid T).1 - (TileCentroid J).1) * + ((TileCentroid S).2 - (TileCentroid J).2)) T ∧ ∃ U ∈ RegularTileFamily base + (TilingLattice C), (fun (T U : ProtoTile) => if C.1.1.1 = (1 : ℤ) then ∃ (v : + GaussianInt), UnitTriangularStep orientation v + ∧ TileCentroid U - TileCentroid T = GaussianRealPoint v else TileTouching T U) T U ∧ (fun + (T : ProtoTile) => ((TileCentroid T).2 - (TileCentroid J).2) * ((TileCentroid S).1 - + (TileCentroid J).1) - ((TileCentroid T).1 - (TileCentroid J).1) * ((TileCentroid S).2 - + (TileCentroid J).2)) U < (0 : ℝ)) → ((List.Forall₂ (fun T h => TileOdometer C.1.1 T h) + (left.dropLast ++ right) (hl.dropLast ++ hr)) → (((left.dropLast ++ right).zip + (hl.dropLast ++ hr) = (left.zip hl).dropLast ++ right.zip hr) → (right.zip hr = [(J, hJ)] + ++ right.tail.zip hr.tail))))))))))))))) := by + classical + intro C C₀ orientation base R J S T₀ hJ hS h₀ left right hl hr hrhead hrlast hjoined hrightAnc + hrightOdo hrightChain hrightLen hrightTileHead hrightTileLast hrightNodup hrightMem + hrightTileChain hrightHeight hrel hzip + cases right with + | nil => simp at hrightTileHead + | cons t ts => + cases hr with + | nil => simp at hrhead + | cons g gs => + simp only [List.head?_cons] at hrightTileHead hrhead + injection hrightTileHead with ht + injection hrhead with hg + subst t + subst g + rfl + +private theorem hUdropLast : + ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), ∀ (U : ProtoTile), (U ∈ (List.drop (1 + : ℕ) (left.dropLast ++ right)).dropLast) → (U ∈ (left.dropLast ++ right).dropLast) := by + classical + intro left right U hU + have hsub : List.Sublist ((left.dropLast ++ right).drop 1).dropLast + (left.dropLast ++ right).dropLast := by + cases left.dropLast ++ right with + | nil => simp + | cons a xs => + cases xs with + | nil => simp + | cons b xs => + simp only [List.drop_succ_cons, List.dropLast_cons_cons] + exact List.Sublist.cons _ (List.Sublist.refl _) + exact hsub.subset hU + +end RespectAppendProof + +namespace RespectAppendDetails + +private theorem appendForall₂ : + ∀ {α : Type}, ∀ {β : Type}, ∀ {Rel : α → β → Prop}, ∀ {xs : List α}, ∀ {ys : List β}, ∀ + {us : List α}, ∀ {vs : List β}, (List.Forall₂ Rel xs ys) → ((List.Forall₂ Rel us vs) → + (List.Forall₂ Rel (xs ++ us) (ys ++ vs))) := by + classical + intro α β Rel xs ys us vs hxy huv + induction hxy with + | nil => simpa using huv + | cons hxy htail ih => exact List.Forall₂.cons hxy ih + +private theorem hzip : + ∀ (C : BandCircle), ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), ∀ (hl : List + PartialOdometer), ∀ (hr : List PartialOdometer), (List.Forall₂ (fun (T : ProtoTile) (h : + PartialOdometer) => TileOdometer C.1.1 T h) + left hl) → ((∀ {α : Type}, ∀ {β : Type}, ∀ {Rel : α → β → Prop}, ∀ {xs : List α}, ∀ + {ys : List β}, (List.Forall₂ Rel xs ys) → (List.Forall₂ Rel xs.dropLast ys.dropLast)) → + ((∀ {α : Type}, ∀ {β : Type}, ∀ (xs : List α), ∀ (ys : List β), (xs.length = ys.length) → + (xs.dropLast.zip ys.dropLast = (xs.zip ys).dropLast)) → ((left.length = hl.length) → + ((left.dropLast ++ right).zip (hl.dropLast ++ hr) = + (left.zip hl).dropLast ++ right.zip hr)))) := by + classical + intro C left right hl hr hleftOdo dropLastForall₂ zipDropLast hleftLen + rw [List.zip_append] + · rw [zipDropLast left hl hleftLen] + · exact List.Forall₂.length_eq (dropLastForall₂ hleftOdo) + +private theorem hleftTailChain : + ∀ (C : BandCircle), ∀ (left : List ProtoTile), ∀ (hl : List PartialOdometer), (List.IsChain + (fun (X Y : ProtoTile × PartialOdometer) => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) + (left.zip hl)) → ((left.zip hl).dropLast.IsChain + (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2)) := by + classical + intro C left hl hleftChain + exact hleftChain.dropLast + +private theorem hleftZipShape : + ∀ (C : BandCircle), ∀ (J : ProtoTile), ∀ (hJ : PartialOdometer), ∀ (left : List ProtoTile), ∀ + (hl : List PartialOdometer), (List.Forall₂ (fun (T : ProtoTile) (h : PartialOdometer) => + TileOdometer C.1.1 T h) left hl) → ((∀ + {α : Type}, ∀ {β : Type}, ∀ {Rel : α → β → Prop}, ∀ {xs : List α}, ∀ {ys : List β}, + (List.Forall₂ Rel xs ys) → (List.Forall₂ Rel xs.dropLast ys.dropLast)) → ((left.dropLast + ++ [J] = left) → ((hl.dropLast ++ [hJ] = hl) → (left.zip hl = left.dropLast.zip + hl.dropLast ++ [(J, hJ)])))) := by + classical + intro C J hJ left hl hleftOdo dropLastForall₂ hleftList hleftFunList + rw [← hleftList, ← hleftFunList, List.zip_append] + · simp + · exact List.Forall₂.length_eq (dropLastForall₂ hleftOdo) + +private theorem hleftChainShape : + ∀ (C : BandCircle), ∀ (J : ProtoTile), ∀ (hJ : PartialOdometer), ∀ (left : List ProtoTile), ∀ + (hl : List PartialOdometer), (List.IsChain (fun (X Y : ProtoTile × PartialOdometer) => + LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) (left.zip hl)) → ((left.zip hl = left.dropLast.zip + hl.dropLast ++ [(J, hJ)]) → (List.IsChain + (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) + (left.dropLast.zip hl.dropLast ++ [(J, hJ)]))) := by + classical + intro C J hJ left hl hleftChain hleftZipShape + rw [← hleftZipShape] + exact hleftChain + +private theorem hrightChainShape : + ∀ (C : BandCircle), ∀ (J : ProtoTile), ∀ (hJ : PartialOdometer), ∀ (right : List ProtoTile), + ∀ (hr : List PartialOdometer), (List.IsChain (fun (X Y : ProtoTile × PartialOdometer) => + LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) (right.zip hr)) → ((right.zip hr = [(J, hJ)] ++ + right.tail.zip hr.tail) → (List.IsChain + (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) + ([(J, hJ)] ++ right.tail.zip hr.tail))) := by + classical + intro C J hJ right hr hrightChain hrightZipShape + rw [← hrightZipShape] + exact hrightChain + +private theorem hnewChain : + ∀ (C : BandCircle), ∀ (J : ProtoTile), ∀ (hJ : PartialOdometer), ∀ (left : List ProtoTile), ∀ + (right : List ProtoTile), ∀ (hl : List PartialOdometer), ∀ (hr : List PartialOdometer), + (left.zip hl = left.dropLast.zip hl.dropLast ++ [(J, hJ)]) → ((right.zip hr = [(J, hJ)] + ++ right.tail.zip hr.tail) → ((List.IsChain (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 + Y.2) (left.dropLast.zip hl.dropLast ++ [(J, hJ)])) → ((List.IsChain (fun X Y => + LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) ([(J, hJ)] ++ right.tail.zip hr.tail)) → + (((left.zip hl).dropLast ++ right.zip hr).IsChain + (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2))))) := by + classical + intro C J hJ left right hl hr hleftZipShape hrightZipShape hleftChainShape hrightChainShape + rw [hleftZipShape, hrightZipShape, List.dropLast_append, List.dropLast_singleton] + simpa [List.append_assoc] using + hleftChainShape.append_overlap hrightChainShape + (show [(J, hJ)] ≠ [] by simp) + +private theorem hleftZipDrop : + ∀ (J : ProtoTile), ∀ (hJ : PartialOdometer), ∀ (left : List ProtoTile), ∀ (hl : List + PartialOdometer), (left.zip hl = left.dropLast.zip hl.dropLast ++ [(J, hJ)]) → ((left.zip + hl).dropLast = left.dropLast.zip hl.dropLast) := by + classical + intro J hJ left hl hleftZipShape + rw [hleftZipShape] + simp + +private theorem hJmem : + ∀ (C : BandCircle), ∀ (C₀ : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (R : + ProtoTile), ∀ (J : ProtoTile), ∀ (S : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (hJ : + PartialOdometer), ∀ (h₀ : PartialOdometer), ∀ (left : List ProtoTile), ∀ (right : List + ProtoTile), ∀ (hl : List PartialOdometer), ∀ (hr : List PartialOdometer), (∀ U ∈ + (List.drop (1 : ℕ) right).dropLast, ∃ (g : PartialOdometer), (U, g) ∈ right.zip hr ∧ + AncestorOdometer C.1.1 C₀.1.1 U T₀ g h₀) → ((List.Forall₂ (fun (T : ProtoTile) + (h : PartialOdometer) => TileOdometer C.1.1 T + h) right hr) → ((List.IsChain (fun (X Y : ProtoTile × PartialOdometer) => + LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) (right.zip hr)) → ((right.length = hr.length) → + ((right.head? = some J) → ((right.getLast? = some S) → ((List.Pairwise (fun (T U : + ProtoTile) => T ≠ U) right) → ((∀ T ∈ right, T ∈ RegularTileFamily base (TilingLattice + C)) → ((List.IsChain (fun (T U : ProtoTile) => if C.1.1.1 = (1 : ℤ) then ∃ (v : + GaussianInt), UnitTriangularStep orientation v + ∧ TileCentroid U - TileCentroid T = GaussianRealPoint v else TileTouching T U) right) → + ((∀ (pre : List ProtoTile), ∀ (T : ProtoTile), ∀ (post : List ProtoTile), right = pre ++ + T :: post → pre ≠ [] → post ≠ [] → (0 : ℝ) ≤ (fun (T : ProtoTile) => ((TileCentroid T).2 + - (TileCentroid J).2) * ((TileCentroid S).1 - (TileCentroid J).1) - ((TileCentroid T).1 - + (TileCentroid J).1) * ((TileCentroid S).2 - (TileCentroid J).2)) T ∧ ∃ U ∈ + RegularTileFamily base (TilingLattice C), (fun (T U : ProtoTile) => if C.1.1.1 = (1 : ℤ) + then ∃ (v : GaussianInt), + UnitTriangularStep orientation v ∧ TileCentroid U - TileCentroid T = GaussianRealPoint v + else TileTouching T U) T U ∧ (fun (T : ProtoTile) => ((TileCentroid T).2 - (TileCentroid + J).2) * ((TileCentroid S).1 - (TileCentroid J).1) - ((TileCentroid T).1 - (TileCentroid + J).1) * ((TileCentroid S).2 - (TileCentroid J).2)) U < (0 : ℝ)) → ((List.Forall₂ (fun T h + => TileOdometer C.1.1 T h) (left.dropLast ++ right) (hl.dropLast ++ hr)) → + (((left.dropLast ++ right).zip (hl.dropLast ++ hr) = (left.zip hl).dropLast ++ right.zip + hr) → ((right.zip hr = [(J, hJ)] ++ right.tail.zip hr.tail) → ((List.IsChain (fun X Y => + LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) ([(J, hJ)] ++ right.tail.zip hr.tail)) → + ((((left.zip hl).dropLast ++ right.zip hr).IsChain (fun X Y => LeftLatticeAdjacent C X.1 + Y.1 X.2 Y.2)) → ((TileString C orientation base R S (left.dropLast ++ right)) → + (((left.dropLast ++ right).head? = some R) → (((left.dropLast ++ right).getLast? = some + S) → ((List.Pairwise (fun (T U : ProtoTile) => T ≠ U) (left.dropLast ++ right)) → + ((List.Nodup (left.dropLast ++ right)) → ((List.Disjoint left.dropLast right) → (J ∈ + right))))))))))))))))))))) := by + classical + intro C C₀ orientation base R J S T₀ hJ h₀ left right hl hr hrightAnc hrightOdo hrightChain + hrightLen hrightTileHead hrightTileLast hrightNodup hrightMem hrightTileChain hrightHeight + hrel hzip hrightZipShape hrightChainShape hnewChain hjoinedKeep hcatHead hcatLast + hcatPairwise hcatNodup hdisj + cases right with + | nil => simp at hrightTileHead + | cons t ts => + simp only [List.head?_cons] at hrightTileHead + injection hrightTileHead with ht + subst t + simp + +private theorem leftPairDrop : + ∀ (J : ProtoTile), ∀ (hJ : PartialOdometer), ∀ (left : List ProtoTile), ∀ (hl : List + PartialOdometer), (left.zip hl = left.dropLast.zip hl.dropLast ++ [(J, hJ)]) → (∀ + {U : ProtoTile}, ∀ {g : PartialOdometer}, ((U, g) ∈ left.zip hl) → ((U ≠ J) → ((U, g) ∈ + left.dropLast.zip hl.dropLast))) := by + classical + intro J hJ left hl hleftZipShape U g hpair hUJ + rw [hleftZipShape] at hpair + simp only [List.mem_append, List.mem_singleton] at hpair + rcases hpair with hpair | heq + · exact hpair + · have hEq : U = J := congrArg Prod.fst heq + exact (hUJ hEq).elim + +private theorem leftPairTransfer : + ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), ∀ (hl : List PartialOdometer), ∀ (hr : + List PartialOdometer), ((left.dropLast ++ right).zip (hl.dropLast ++ hr) = (left.zip + hl).dropLast ++ right.zip hr) → (((left.zip hl).dropLast = left.dropLast.zip hl.dropLast) + → (∀ {U : ProtoTile}, ∀ {g : PartialOdometer}, ((U, g) ∈ left.dropLast.zip hl.dropLast) → + ((U, g) ∈ (left.dropLast ++ right).zip (hl.dropLast ++ hr)))) := by + classical + intro left right hl hr hzip hleftZipDrop U g hpair + rw [hzip, hleftZipDrop] + exact List.mem_append.mpr (Or.inl hpair) + +private theorem rightPairTransfer : + ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), ∀ (hl : List PartialOdometer), ∀ (hr : + List PartialOdometer), ((left.dropLast ++ right).zip (hl.dropLast ++ hr) = (left.zip + hl).dropLast ++ right.zip hr) → (∀ {U : ProtoTile}, ∀ {g : PartialOdometer}, ((U, g) ∈ + right.zip hr) → ((U, g) ∈ (left.dropLast ++ right).zip (hl.dropLast ++ hr))) := by + classical + intro left right hl hr hzip U g hpair + rw [hzip] + exact List.mem_append.mpr (Or.inr hpair) + +private theorem hrespect : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (R : ProtoTile), ∀ (S : + ProtoTile), ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), ∀ (hl : List + PartialOdometer), ∀ (hr : List PartialOdometer), (List.Forall₂ (fun T h => TileOdometer + C.1.1 T h) (left.dropLast ++ right) (hl.dropLast ++ hr)) → (((left.dropLast ++ right).zip + (hl.dropLast ++ hr) = (left.zip hl).dropLast ++ right.zip hr) → ((((left.zip hl).dropLast + ++ right.zip hr).IsChain (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2)) → + ((TileString C orientation base R S (left.dropLast ++ right)) → (OdometerStringRespect C + orientation base R S + (left.dropLast ++ right) (hl.dropLast ++ hr))))) := by + classical + intro C orientation base R S left right hl hr hrel hzip hnewChain hjoinedKeep + exact ⟨hjoinedKeep, hrel, by rw [hzip]; exact hnewChain⟩ + +private theorem hhead : + ∀ (C : BandCircle), ∀ (C₀ : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (R : + ProtoTile), ∀ (J : ProtoTile), ∀ (S : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (hR : + PartialOdometer), ∀ (hJ : PartialOdometer), ∀ (h₀ : PartialOdometer), ∀ (left : List + ProtoTile), ∀ (right : List ProtoTile), ∀ (hl : List PartialOdometer), ∀ (hr : List + PartialOdometer), (hl.head? = some hR) → ((hl.getLast? = some hJ) → ((hr.head? = some hJ) + → ((∀ U ∈ (List.drop (1 : ℕ) left).dropLast, ∃ (g : PartialOdometer), (U, g) ∈ left.zip + hl ∧ AncestorOdometer C.1.1 C₀.1.1 U T₀ g h₀) → ((List.Forall₂ (fun (T : ProtoTile) + (h : PartialOdometer) => TileOdometer C.1.1 T + h) left hl) → ((List.IsChain (fun (X Y : ProtoTile × PartialOdometer) => + LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) (left.zip hl)) → ((left.length = hl.length) → + ((List.Forall₂ (fun T h => TileOdometer C.1.1 T h) (left.dropLast ++ right) (hl.dropLast + ++ hr)) → (((left.dropLast ++ right).zip (hl.dropLast ++ hr) = (left.zip hl).dropLast ++ + right.zip hr) → (((left.zip hl).dropLast.IsChain (fun X Y => LeftLatticeAdjacent C X.1 + Y.1 X.2 Y.2)) → ((hl.dropLast ++ [hJ] = hl) → ((left.zip hl = left.dropLast.zip + hl.dropLast ++ [(J, hJ)]) → ((List.IsChain (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 + Y.2) (left.dropLast.zip hl.dropLast ++ [(J, hJ)])) → ((((left.zip hl).dropLast ++ + right.zip hr).IsChain (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2)) → (((left.zip + hl).dropLast = left.dropLast.zip hl.dropLast) → ((∀ {U : ProtoTile}, ∀ + {g : PartialOdometer}, ((U, g) ∈ left.zip hl) → ((U ≠ J) → ((U, g) ∈ left.dropLast.zip + hl.dropLast))) → ((∀ {U : ProtoTile}, ∀ {g : PartialOdometer}, ((U, g) ∈ + left.dropLast.zip hl.dropLast) → ((U, g) ∈ (left.dropLast ++ right).zip (hl.dropLast ++ + hr))) → ((∀ {U : ProtoTile}, ∀ {g : PartialOdometer}, ((U, g) ∈ right.zip hr) → ((U, g) ∈ + (left.dropLast ++ right).zip (hl.dropLast ++ hr))) → ((OdometerStringRespect C + orientation base R S (left.dropLast ++ right) (hl.dropLast ++ hr)) → ((hl.dropLast ++ + hr).head? = some hR))))))))))))))))))) := by + classical + intro C C₀ orientation base R J S T₀ hR hJ h₀ left right hl hr hlhead hllast hrhead hleftAnc + hleftOdo hleftChain hleftLen hrel hzip hleftTailChain hleftFunList hleftZipShape + hleftChainShape hnewChain hleftZipDrop leftPairDrop leftPairTransfer rightPairTransfer + hrespect + cases hl with + | nil => simp at hlhead + | cons x xs => cases xs <;> simp_all + +private theorem hlast : + ∀ (C : BandCircle), ∀ (C₀ : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (R : + ProtoTile), ∀ (J : ProtoTile), ∀ (S : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (hR : + PartialOdometer), ∀ (hJ : PartialOdometer), ∀ (hS : PartialOdometer), ∀ (h₀ : + PartialOdometer), ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), ∀ (hl : List + PartialOdometer), ∀ (hr : List PartialOdometer), (hr.head? = some hJ) → ((hr.getLast? = + some hS) → ((∀ U ∈ (List.drop (1 : ℕ) right).dropLast, ∃ (g : PartialOdometer), (U, g) ∈ + right.zip hr ∧ AncestorOdometer C.1.1 C₀.1.1 U T₀ g h₀) → ((List.Forall₂ (fun (T : + ProtoTile) (h : PartialOdometer) => TileOdometer C.1.1 T h) right hr) → ((List.IsChain + (fun (X Y : ProtoTile × + PartialOdometer) => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) (right.zip hr)) → + ((right.length = hr.length) → ((List.Forall₂ (fun T h => TileOdometer C.1.1 T h) + (left.dropLast ++ right) (hl.dropLast ++ hr)) → (((left.dropLast ++ right).zip + (hl.dropLast ++ hr) = (left.zip hl).dropLast ++ right.zip hr) → ((right.zip hr = [(J, + hJ)] ++ right.tail.zip hr.tail) → ((List.IsChain (fun X Y => LeftLatticeAdjacent C X.1 + Y.1 X.2 Y.2) ([(J, hJ)] ++ right.tail.zip hr.tail)) → ((((left.zip hl).dropLast ++ + right.zip hr).IsChain (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2)) → ((∀ + {U : ProtoTile}, ∀ {g : PartialOdometer}, ((U, g) ∈ left.dropLast.zip hl.dropLast) → ((U, + g) ∈ (left.dropLast ++ right).zip (hl.dropLast ++ hr))) → ((∀ {U : ProtoTile}, ∀ + {g : PartialOdometer}, ((U, g) ∈ right.zip hr) → ((U, g) ∈ (left.dropLast ++ right).zip + (hl.dropLast ++ hr))) → ((OdometerStringRespect C orientation base R S (left.dropLast ++ + right) (hl.dropLast ++ hr)) → (((hl.dropLast ++ hr).head? = some hR) → ((hl.dropLast ++ + hr).getLast? = some hS))))))))))))))) := by + classical + intro C C₀ orientation base R J S T₀ hR hJ hS h₀ left right hl hr hrhead hrlast hrightAnc + hrightOdo hrightChain hrightLen hrel hzip hrightZipShape hrightChainShape hnewChain + leftPairTransfer rightPairTransfer hrespect hhead + have hne : hr ≠ [] := by + intro he; simp [he] at hrlast + cases hr with + | nil => contradiction + | cons x xs => simpa using hrlast + +private theorem hcatNe : + ∀ (R : ProtoTile), ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), ((left.dropLast ++ + right).head? = some R) → (left.dropLast ++ right ≠ []) := by + classical + intro R left right hcatHead he + simp [he] at hcatHead + +private theorem hcatGetLast : + ∀ (S : ProtoTile), ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), ((left.dropLast ++ + right).getLast? = some S) → (∀ (hcatNe : left.dropLast ++ right ≠ []), (left.dropLast ++ + right).getLast hcatNe = S) := by + classical + intro S left right hcatLast hcatNe + have hopt := hcatLast + rw [List.getLast?_eq_getLast_of_ne_nil hcatNe] at hopt + exact Option.some.inj hopt + +private theorem hUneS : + ∀ (S : ProtoTile), ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), (List.Pairwise (fun + (T U : ProtoTile) => T ≠ U) (left.dropLast ++ right)) → (∀ (U : ProtoTile), (U ∈ + (left.dropLast ++ right).dropLast) → (∀ (hcatNe : left.dropLast ++ right ≠ []), + ((left.dropLast ++ right).getLast hcatNe = S) → (U ≠ S))) := by + classical + intro S left right hcatPairwise U hUdropLast hcatNe hcatGetLast + have hne := hcatPairwise.rel_dropLast_getLast hUdropLast + simpa [hcatGetLast] using hne + +private theorem hshape : + ∀ (R : ProtoTile), ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), ((left.dropLast ++ + right).head? = some R) → (left.dropLast ++ right = R :: (left.dropLast ++ right).tail) := by + classical + intro R left right hcatHead + cases hcat : left.dropLast ++ right with + | nil => simp [hcat] at hcatHead + | cons a xs => + have ha : a = R := by simpa [hcat] using hcatHead + subst a + simp [] + +private theorem hUtail : + ∀ (R : ProtoTile), ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), ∀ (U : ProtoTile), + (U ∈ (left.dropLast ++ right).drop 1) → ((left.dropLast ++ right = R :: (left.dropLast ++ + right).tail) → (U ∈ (left.dropLast ++ right).tail)) := by + classical + intro R left right U hUstart hshape + rw [hshape] at hUstart + simpa using hUstart + +private theorem hUneR : + ∀ (R : ProtoTile), ∀ (S : ProtoTile), ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), + (List.Pairwise (fun (T U : ProtoTile) => T ≠ U) (left.dropLast ++ right)) → (∀ (U : + ProtoTile), (U ∈ (List.drop (1 : ℕ) (left.dropLast ++ right)).dropLast) → ((U ∈ + (left.dropLast ++ right).drop 1) → ((U ∈ left.dropLast ++ right) → ((U ∈ (left.dropLast + ++ right).dropLast) → ((U ≠ S) → ((left.dropLast ++ right = R :: (left.dropLast ++ + right).tail) → ((U ∈ (left.dropLast ++ right).tail) → (U ≠ R)))))))) := by + classical + intro R S left right hcatPairwise U hU hUstart hUall hUdropLast hUneS hshape hUtail he + subst U + have hnot : R ∉ (left.dropLast ++ right).tail := by + rw [hshape] at hcatPairwise + have hfirst := (List.pairwise_cons.mp hcatPairwise).1 + exact fun hm => (hfirst R hm) rfl + exact hnot hUtail + +private theorem hUneJ : + ∀ (J : ProtoTile), ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), (List.Disjoint + left.dropLast right) → ((J ∈ right) → (∀ (U : ProtoTile), (U ∈ left.dropLast) → (U ≠ J))) + := by + classical + intro J left right hdisj hJmem U hUL he + have hJleft : J ∈ left.dropLast := by simpa [he] using hUL + exact (List.disjoint_left.mp hdisj) hJleft hJmem + +private theorem hUintAt389 : + ∀ (R : ProtoTile), ∀ (U : ProtoTile), (U ≠ R) → (∀ (b : ProtoTile), ∀ (bs : List ProtoTile), + (U ∈ (R :: b :: bs).dropLast) → (U ∈ (b :: bs).dropLast)) := by + classical + intro R U hUneR b bs hUL + simp only [List.dropLast_cons_cons, List.mem_cons] at hUL + rcases hUL with hEq | hmem + · exact (hUneR hEq).elim + · exact hmem + +private theorem hpairRight : + ∀ (J : ProtoTile), ∀ (hJ : PartialOdometer), ∀ (right : List ProtoTile), ∀ (hr : List + PartialOdometer), (right.zip hr = [(J, hJ)] ++ right.tail.zip hr.tail) → ((J, hJ) ∈ + right.zip hr) := by + classical + intro J hJ right hr hrightZipShape + rw [hrightZipShape] + simp + +private theorem hpairNewAt405 : + ∀ (J : ProtoTile), ∀ (hJ : PartialOdometer), ∀ (left : List ProtoTile), ∀ (right : List + ProtoTile), ∀ (hl : List PartialOdometer), ∀ (hr : List PartialOdometer), ((left.dropLast + ++ right).zip (hl.dropLast ++ hr) = (left.zip hl).dropLast ++ right.zip hr) → (((J, hJ) ∈ + right.zip hr) → ((J, hJ) ∈ (left.dropLast ++ right).zip (hl.dropLast ++ hr))) := by + classical + intro J hJ left right hl hr hzip hpairRight + rw [hzip] + exact List.mem_append.mpr (Or.inr hpairRight) + +private theorem hUintAt414 : + ∀ (J : ProtoTile), ∀ (U : ProtoTile), (¬U = J) → (∀ (as : List ProtoTile), (U ∈ J :: as) → (U + ∈ as)) := by + classical + intro J U hUJ as hUR + simpa using (List.mem_cons.mp hUR).resolve_left (by + intro hEq + exact hUJ hEq) + +private theorem hrightGetLast : + ∀ (J : ProtoTile), ∀ (S : ProtoTile), ∀ (as : List ProtoTile), ((J :: + as).getLast? = some S) → ((J :: as).getLast (by simp) = S) := by + classical + intro J S as hrightTileLast + have hopt := hrightTileLast + rw [List.getLast?_eq_getLast_of_ne_nil (by simp)] at hopt + exact Option.some.inj hopt + +private theorem hrightDrop : + ∀ (J : ProtoTile), ∀ (S : ProtoTile), ∀ (U : ProtoTile), (U ≠ S) → (∀ (as : List + ProtoTile), (U ∈ J :: as) → (((J :: as).getLast (by simp) = S) → (U ∈ (J :: + as).dropLast))) := by + classical + intro J S U hUneS as hUR hrightGetLast + exact List.mem_dropLast_of_mem_of_ne_getLast hUR (by + simpa [hrightGetLast] using hUneS) + +private theorem hrightTailDrop : + ∀ (J : ProtoTile), ∀ (U : ProtoTile), (¬U = J) → (∀ (b : ProtoTile), ∀ (bs : List ProtoTile), + (U ∈ (J :: b :: bs).dropLast) → (U ∈ (b :: bs).dropLast)) := by + classical + intro J U hUJ b bs hrightDrop + simp only [List.dropLast_cons_cons, List.mem_cons] at hrightDrop + rcases hrightDrop with hEq | hmem + · exact (hUJ hEq).elim + · exact hmem + +end RespectAppendDetails + +theorem P4458T1RespectAppend + (C C₀ : BandCircle) (orientation : Bool) + (base R J S T₀ : ProtoTile) (hR hJ hS h₀ : PartialOdometer) + (left right : List ProtoTile) (hl hr : List PartialOdometer) + (hleft : OdometerStringRespect C orientation base R J left hl) + (hright : OdometerStringRespect C orientation base J S right hr) + (hlhead : hl.head? = some hR) (hllast : hl.getLast? = some hJ) + (hrhead : hr.head? = some hJ) (hrlast : hr.getLast? = some hS) + (hjoined : TileString C orientation base R S (left.dropLast ++ right)) + (hjoin : AncestorOdometer C.1.1 C₀.1.1 J T₀ hJ h₀) + (hleftAnc : ∀ U ∈ (left.drop 1).dropLast, + ∃ g, (U, g) ∈ left.zip hl ∧ AncestorOdometer C.1.1 C₀.1.1 U T₀ g h₀) + (hrightAnc : ∀ U ∈ (right.drop 1).dropLast, + ∃ g, (U, g) ∈ right.zip hr ∧ AncestorOdometer C.1.1 C₀.1.1 U T₀ g h₀) : + (hl.dropLast ++ hr).head? = some hR ∧ + (hl.dropLast ++ hr).getLast? = some hS ∧ + OdometerStringRespect C orientation base R S + (left.dropLast ++ right) (hl.dropLast ++ hr) ∧ + ∀ U ∈ ((left.dropLast ++ right).drop 1).dropLast, + ∃ g, (U, g) ∈ (left.dropLast ++ right).zip (hl.dropLast ++ hr) ∧ + AncestorOdometer C.1.1 C₀.1.1 U T₀ g h₀ := by +-- BODY + classical + rcases hleft with ⟨hleftTiles, hleftOdo, hleftChain⟩ + rcases hright with ⟨hrightTiles, hrightOdo, hrightChain⟩ + have dropLastForall₂ {α β : Type} {Rel : α → β → Prop} + {xs : List α} {ys : List β} (hall : List.Forall₂ Rel xs ys) : + List.Forall₂ Rel xs.dropLast ys.dropLast := RespectAppendProof.dropLastForall₂ (α := α) (β + := β) (Rel := Rel) (xs := xs) (ys := ys) hall + have appendForall₂ {α β : Type} {Rel : α → β → Prop} + {xs : List α} {ys : List β} {us : List α} {vs : List β} + (hxy : List.Forall₂ Rel xs ys) (huv : List.Forall₂ Rel us vs) : + List.Forall₂ Rel (xs ++ us) (ys ++ vs) := RespectAppendDetails.appendForall₂ (α := α) (β := + β) (Rel := Rel) (xs := xs) (ys := ys) (us := us) (vs := vs) hxy huv + have zipDropLast {α β : Type} (xs : List α) (ys : List β) + (hlen : xs.length = ys.length) : + xs.dropLast.zip ys.dropLast = (xs.zip ys).dropLast := RespectAppendProof.zipDropLast (α := + α) (β := β) xs ys hlen + have hleftLen : left.length = hl.length := List.Forall₂.length_eq hleftOdo + have hrightLen : right.length = hr.length := List.Forall₂.length_eq hrightOdo + rcases hleftTiles with ⟨_, hleftTileHead, hleftTileLast, hleftNodup, hleftMem, + hleftTileChain, hleftHeight⟩ + rcases hrightTiles with ⟨_, hrightTileHead, hrightTileLast, hrightNodup, hrightMem, + hrightTileChain, hrightHeight⟩ + have hrel : List.Forall₂ (fun T h => TileOdometer C.1.1 T h) + (left.dropLast ++ right) (hl.dropLast ++ hr) := + appendForall₂ (dropLastForall₂ hleftOdo) hrightOdo + have hzip : (left.dropLast ++ right).zip (hl.dropLast ++ hr) = + (left.zip hl).dropLast ++ right.zip hr := RespectAppendDetails.hzip C left right hl hr + hleftOdo dropLastForall₂ zipDropLast hleftLen + have hleftTailChain : (left.zip hl).dropLast.IsChain + (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) := RespectAppendDetails.hleftTailChain C + left hl hleftChain + have hleftList : left.dropLast ++ [J] = left := + List.dropLast_append_getLast? J (by simp [hleftTileLast]) + have hleftFunList : hl.dropLast ++ [hJ] = hl := + List.dropLast_append_getLast? hJ (by simp [hllast]) + have hleftZipShape : left.zip hl = left.dropLast.zip hl.dropLast ++ [(J, hJ)] := + RespectAppendDetails.hleftZipShape C J hJ left hl hleftOdo dropLastForall₂ hleftList + hleftFunList + have hrightZipShape : right.zip hr = [(J, hJ)] ++ right.tail.zip hr.tail := + RespectAppendProof.hrightZipShape C C₀ orientation base R J S T₀ hJ hS h₀ left right hl hr + hrhead hrlast hjoined hrightAnc hrightOdo hrightChain hrightLen hrightTileHead + hrightTileLast hrightNodup hrightMem hrightTileChain hrightHeight hrel hzip + have hleftChainShape : List.IsChain + (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) + (left.dropLast.zip hl.dropLast ++ [(J, hJ)]) := RespectAppendDetails.hleftChainShape C J hJ + left hl hleftChain hleftZipShape + have hrightChainShape : List.IsChain + (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) + ([(J, hJ)] ++ right.tail.zip hr.tail) := RespectAppendDetails.hrightChainShape C J hJ right + hr hrightChain hrightZipShape + have hnewChain : ((left.zip hl).dropLast ++ right.zip hr).IsChain + (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) := RespectAppendDetails.hnewChain C J hJ + left right hl hr hleftZipShape hrightZipShape hleftChainShape hrightChainShape + have hleftZipDrop : (left.zip hl).dropLast = left.dropLast.zip hl.dropLast := + RespectAppendDetails.hleftZipDrop J hJ left hl hleftZipShape + have hjoinedKeep := hjoined + rcases hjoined with ⟨_, hcatHead, hcatLast, hcatPairwise, _, _, _⟩ + have hcatNodup : List.Nodup (left.dropLast ++ right) := hcatPairwise + have hdisj : List.Disjoint left.dropLast right := + List.disjoint_of_nodup_append hcatNodup + have hJmem : J ∈ right := RespectAppendDetails.hJmem C C₀ orientation base R J S T₀ hJ h₀ left + right hl hr hrightAnc hrightOdo hrightChain hrightLen hrightTileHead hrightTileLast + hrightNodup hrightMem hrightTileChain hrightHeight hrel hzip hrightZipShape + hrightChainShape hnewChain hjoinedKeep hcatHead hcatLast hcatPairwise hcatNodup hdisj + have leftPairDrop {U : ProtoTile} {g : PartialOdometer} + (hpair : (U, g) ∈ left.zip hl) (hUJ : U ≠ J) : + (U, g) ∈ left.dropLast.zip hl.dropLast := RespectAppendDetails.leftPairDrop J hJ left hl + hleftZipShape (U := U) (g := g) hpair hUJ + have leftPairTransfer {U : ProtoTile} {g : PartialOdometer} + (hpair : (U, g) ∈ left.dropLast.zip hl.dropLast) : + (U, g) ∈ (left.dropLast ++ right).zip (hl.dropLast ++ hr) := + RespectAppendDetails.leftPairTransfer left right hl hr hzip hleftZipDrop (U := U) (g := + g) hpair + have rightPairTransfer {U : ProtoTile} {g : PartialOdometer} + (hpair : (U, g) ∈ right.zip hr) : + (U, g) ∈ (left.dropLast ++ right).zip (hl.dropLast ++ hr) := + RespectAppendDetails.rightPairTransfer left right hl hr hzip (U := U) (g := g) hpair + have hrespect : OdometerStringRespect C orientation base R S + (left.dropLast ++ right) (hl.dropLast ++ hr) := RespectAppendDetails.hrespect C orientation + base R S left right hl hr hrel hzip hnewChain hjoinedKeep + have hhead : (hl.dropLast ++ hr).head? = some hR := RespectAppendDetails.hhead C C₀ orientation + base R J S T₀ hR hJ h₀ left right hl hr hlhead hllast hrhead hleftAnc hleftOdo hleftChain + hleftLen hrel hzip hleftTailChain hleftFunList hleftZipShape hleftChainShape hnewChain + hleftZipDrop leftPairDrop leftPairTransfer rightPairTransfer hrespect + have hlast : (hl.dropLast ++ hr).getLast? = some hS := RespectAppendDetails.hlast C C₀ + orientation base R J S T₀ hR hJ hS h₀ left right hl hr hrhead hrlast hrightAnc hrightOdo + hrightChain hrightLen hrel hzip hrightZipShape hrightChainShape hnewChain leftPairTransfer + rightPairTransfer hrespect hhead + refine ⟨hhead, hlast, hrespect, ?_⟩ + intro U hU + have hUstart : U ∈ (left.dropLast ++ right).drop 1 := + List.mem_of_mem_dropLast hU + have hUall : U ∈ left.dropLast ++ right := List.mem_of_mem_drop hUstart + have hUdropLast : U ∈ (left.dropLast ++ right).dropLast := RespectAppendProof.hUdropLast left + right U hU + have hcatNe : left.dropLast ++ right ≠ [] := RespectAppendDetails.hcatNe R left right hcatHead + have hcatGetLast : (left.dropLast ++ right).getLast hcatNe = S := + RespectAppendDetails.hcatGetLast S left right hcatLast hcatNe + have hUneS : U ≠ S := RespectAppendDetails.hUneS S left right hcatPairwise U hUdropLast hcatNe + hcatGetLast + have hshape : left.dropLast ++ right = R :: (left.dropLast ++ right).tail := + RespectAppendDetails.hshape R left right hcatHead + have hUtail : U ∈ (left.dropLast ++ right).tail := RespectAppendDetails.hUtail R left right U + hUstart hshape + have hUneR : U ≠ R := RespectAppendDetails.hUneR R S left right hcatPairwise U hU hUstart hUall + hUdropLast hUneS hshape hUtail + rcases List.mem_append.mp hUall with hUL | hUR + · have hUneJ : U ≠ J := RespectAppendDetails.hUneJ J left right hdisj hJmem U hUL + cases left with + | nil => simp at hleftTileHead + | cons a as => + have ha : a = R := by simpa using hleftTileHead + subst a + cases as with + | nil => simp at hUL + | cons b bs => + have hUint : U ∈ (b :: bs).dropLast := RespectAppendDetails.hUintAt389 R U hUneR b bs hUL + have hleftInterior : U ∈ ((R :: b :: bs).drop 1).dropLast := by + simpa [List.drop_succ_cons] using hUint + obtain ⟨g, hpair, hanc⟩ := hleftAnc U hleftInterior + have hpairDrop := leftPairDrop hpair hUneJ + have hpairNew := leftPairTransfer hpairDrop + exact ⟨g, hpairNew, hanc⟩ + · by_cases hUJ : U = J + · subst U + have hpairRight : (J, hJ) ∈ right.zip hr := RespectAppendDetails.hpairRight J hJ right hr + hrightZipShape + have hpairNew : (J, hJ) ∈ (left.dropLast ++ right).zip (hl.dropLast ++ hr) := + RespectAppendDetails.hpairNewAt405 J hJ left right hl hr hzip hpairRight + exact ⟨hJ, hpairNew, hjoin⟩ + · cases right with + | nil => simp at hrightTileHead + | cons a as => + have ha : a = J := by simpa using hrightTileHead + subst a + have hUint : U ∈ as := RespectAppendDetails.hUintAt414 J U hUJ as hUR + have hrightGetLast : (J :: as).getLast (by simp) = S := + RespectAppendDetails.hrightGetLast J S as hrightTileLast + have hrightDrop : U ∈ (J :: as).dropLast := RespectAppendDetails.hrightDrop J S U hUneS + as hUR hrightGetLast + cases as with + | nil => simp at hUint + | cons b bs => + have hrightTailDrop : U ∈ (b :: bs).dropLast := RespectAppendDetails.hrightTailDrop J U + hUJ b bs hrightDrop + have hrightInterior : U ∈ ((J :: b :: bs).drop 1).dropLast := by + simpa [List.drop_succ_cons] using hrightTailDrop + obtain ⟨g, hpair, hanc⟩ := hrightAnc U hrightInterior + have hpairNew := rightPairTransfer hpair + exact ⟨g, hpairNew, hanc⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1RestrictionFamily.lean b/LeanPool/ApollonianSuperharmonic/P4458T1RestrictionFamily.lean new file mode 100644 index 0000000000..e9f36413db --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4458T1RestrictionFamily.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryFrame +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence + +-- [TABLET NODE: P4458T1RestrictionFamily] + +/-! +# P4458T1RestrictionFamily + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a boundary frame $F$, a restriction family consists of tiles $T_j^s$ +and partial functions $h_j^s$, for $j\in\mathbb Z/3$ and $s\in\{-,+\}$. +Each is a tile odometer for $q_{j+1}$ and an actual signed +`BandSubtileOccurrence` of $F.T_0$ in the presentation $F.q$. +For every positive parent it records +$\operatorname{AncestorOdometer}(q_{j+1},F.C_0,T_j^s,F.T_0,h_j^s,F.h_0)$. +Put $P_j=F.q_{j+1}$ for $j\in\mathbb Z/3$, +$w_j=a(P_{j+2},P_{j+1})$, and let $\sigma_+=1$, $\sigma_-=-1$. +For each $j,s$ it records either zero parent curvature, or defined slopes +$p,p_j^s$ of $F.h_0,h_j^s$ with +$p_j^s-p=\sigma_s\tfrac12(w_j+\mathrm i w_j)$ in real coordinates. +The functions are literal restrictions, not independently affinely +normalized copies. +-/ +structure P4458T1RestrictionFamily + {C : BandCircle} {orientation : Bool} {base Rminus Rplus : ProtoTile} + {hminus hplus : PartialOdometer} + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) where +-- BODY + /-- The six signed supports in the outer tile decomposition. -/ + tiles : Fin 3 → Bool → ProtoTile + /-- The literal restriction odometers on those six supports. -/ + functions : Fin 3 → Bool → PartialOdometer + odometers : ∀ j s, TileOdometer (F.q j.succ) (tiles j s) (functions j s) + occurrences : ∀ j s, BandSubtileOccurrence F.q F.tile j s (tiles j s) + domain_subset : ∀ j s, (functions j s).domain ⊆ F.odometer.domain + value_eq : ∀ j s x, x ∈ (functions j s).domain → + (functions j s).value x = F.odometer.value x + ancestors : ∀ j s, 0 < (F.q j.succ).1 → + AncestorOdometer (F.q j.succ) F.outer.1.1 + (tiles j s) F.tile (functions j s) F.odometer + slopes : ∀ j s, (F.q j.succ).1 = 0 ∨ + ∃ p pj : ℝ × ℝ, + PartialOdometerSlope F.odometer = some p ∧ + PartialOdometerSlope (functions j s) = some pj ∧ + pj.1 - p.1 = (if s = true then (1 : ℝ) else -1) * (1 / 2) * + (((BandVectors.2 (F.q ((j + 2).succ)) (F.q ((j + 1).succ))).re : ℤ) - + ((BandVectors.2 (F.q ((j + 2).succ)) (F.q ((j + 1).succ))).im : ℤ)) ∧ + pj.2 - p.2 = (if s = true then (1 : ℝ) else -1) * (1 / 2) * + (((BandVectors.2 (F.q ((j + 2).succ)) (F.q ((j + 1).succ))).im : ℤ) + + ((BandVectors.2 (F.q ((j + 2).succ)) (F.q ((j + 1).succ))).re : ℤ)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean new file mode 100644 index 0000000000..a439b268be --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean @@ -0,0 +1,4674 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification +public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryFrame +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryPlacement +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundarySide +public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily +public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileString +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P4458T1SecondNewerRows] + +/-! +# P4458T1SecondNewerRows + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SecondNewerRowsGeometry + +private theorem hnegativeSlope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), (Fin (4 : ℕ) → CircleCoordinates) → ((0 < (F.q + F.slot.succ).1) → (∃ s, PartialOdometerSlope (D.functions F.slot false) = some s)) ) + := by + classical + intro C orientation base Rminus Rplus hminus hplus F D p hCpositive + rcases D.slopes F.slot false with hz | ⟨root, child, hroot, hchild, _, _⟩ + · omega + · exact ⟨child, hchild⟩ + +private theorem hr : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ProperBandQuadruple r ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r + have rot : ∀ i : Fin 3, + ProperBandQuadruple + ![F.q 0, F.q i.succ, F.q ((i + 1).succ), F.q ((i + 2).succ)] := by + intro i + fin_cases i + · convert F.proper using 1; funext j; fin_cases j <;> rfl + · refine ⟨SemiProperQuadruple.rotate F.proper.1, ?_⟩ + intro j + fin_cases j + · simpa using F.proper.2 1 + · simpa using F.proper.2 2 + · simpa using F.proper.2 0 + · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate F.proper.1), ?_⟩ + intro j + fin_cases j + · simpa using F.proper.2 2 + · simpa using F.proper.2 0 + · simpa using F.proper.2 1 + simpa [r] using rot F.slot + +private theorem hvsumRe : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (w + x + y = 0) → (w.re + x.re + y.re = 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r w x y hvsum + have h := congrArg (fun z : GaussianInt => z.re) hvsum + simpa [w, x, y] using h + +private theorem hvsumIm : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (w + x + y = 0) → (w.im + x.im + y.im = 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r w x y hvsum + have h := congrArg (fun z : GaussianInt => z.im) hvsum + simpa [w, x, y] using h + +private theorem hUcenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then (1 : + ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 + : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : + ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : + ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → (TileCentroid (D.tiles + F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r w hUcent + simpa [r, w] using hUcent + +private theorem hMcenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r + simpa [r] using F.minus_centroid + +private theorem hcenterVector : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), (Fin (4 : + ℕ) → CircleCoordinates) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (BandVectors.1 (r 1) (r 0) = x - I * y) → ((BandVectors.1 (r 0) (r 1) = I * BandVectors.1 + (r 1) (r 0)) → ((w.re + x.re + y.re = 0) → ((w.im + x.im + y.im = 0) → (-w + I * w - + BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1) = 2 * y))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p r I w x y hvrec hvflip hvsumRe hvsumIm + rw [hvflip, hvrec] + apply Zsqrtd.ext <;> + norm_num [I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> omega + +private theorem hcenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • + (GaussianRealPoint w - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) → + ((TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → (((↑(-w + I * w - + BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin + (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).re : ℝ) = (↑((2 : GaussianInt) * y).re : ℝ)) → + (((↑(-w + I * w - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im : ℝ) = (↑((2 : + GaussianInt) * y).im : ℝ)) → (TileCentroid (D.tiles F.slot false) - TileCentroid + Rminus = GaussianRealPoint y)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r I w y hUcenter hMcenter hcenterRe + hcenterIm + rw [show TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile) - + (TileCentroid Rminus - TileCentroid F.tile) by + ext <;> dsimp <;> ring] + rw [hUcenter, hMcenter] + apply Prod.ext + · simp [GaussianRealPoint, w, y, Prod.smul_mk] + norm_num at hcenterRe ⊢ + linarith + · simp [GaussianRealPoint, w, y, Prod.smul_mk] + norm_num at hcenterIm ⊢ + linarith + +private theorem hyLattice : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + (ProperBandQuadruple r) → ((r 1 = C.1.1) → ( + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + y ∈ TilingLattice C)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r hr hRparent y + have h := (ParentVectorsInTilingLattice r hr 0 C hRparent).1 + simpa [y] using h + +private theorem translate_add : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), TileTranslation + (TileTranslation T v) z = TileTranslation T (v + z) ) := by + classical + intro T v z + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · ext q + simp [TileTranslation, GaussianTranslation, add_comm, add_left_comm] + · simp [TileTranslation, GaussianTranslation, add_comm, add_left_comm] + +private theorem hjoinFamily : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (y ∈ TilingLattice C) → (∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + join ∈ RegularTileFamily base (TilingLattice C)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r y hyLattice u join + refine ⟨(u : GaussianInt) + y, (TilingLattice C).add_mem u.property hyLattice, ?_⟩ + rfl + +private theorem hjoinCenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (join = TileTranslation Rminus y) → (TileCentroid join = TileCentroid Rminus + + GaussianRealPoint y) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r y u join hjoin_eq + rw [hjoin_eq, (TileTranslationFormulas Rminus y).2.2.2.2.1] + apply Prod.ext <;> simp [GaussianRealPoint] + +private theorem hjoinCenterEq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = GaussianRealPoint y) → (∀ (u + : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (TileCentroid join = TileCentroid Rminus + GaussianRealPoint y) → (TileCentroid (D.tiles + F.slot false) = TileCentroid join)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r y hcenter u join hjoinCenter + calc + TileCentroid (D.tiles F.slot false) = + (TileCentroid (D.tiles F.slot false) - TileCentroid Rminus) + + TileCentroid Rminus := by ext <;> dsimp <;> ring + _ = GaussianRealPoint y + TileCentroid Rminus := by rw [hcenter] + _ = TileCentroid Rminus + GaussianRealPoint y := by ext <;> dsimp <;> ring + _ = TileCentroid join := hjoinCenter.symm + +private theorem hUbandC : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), (BandPrototile (F.q F.slot.succ) (D.tiles F.slot + false)) → (BandPrototile C.1.1 (D.tiles F.slot false)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D hUband + rw [← F.parent] + exact hUband + +private theorem hjoinOdo : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), (TileOdometer (F.q F.slot.succ) (D.tiles F.slot false) + (D.functions F.slot false)) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (BandPrototile C.1.1 join) → (((D.tiles F.slot false).cells = join.cells ∧ ((D.tiles + F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = join.anchor)) → + (TileOdometer C.1.1 join (D.functions F.slot false)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D hselectedOdo r y u join hjoinBand + hjoinCells + have hselectedOdo' : TileOdometer C.1.1 + (D.tiles F.slot false) (D.functions F.slot false) := by + simpa only [← F.parent] using hselectedOdo + exact PositiveCurvatureTileOdometerSupportTransport C.1.1 + (D.tiles F.slot false) join (D.functions F.slot false) C.2 + hselectedOdo' hjoinBand hjoinCells.1 + +private theorem hjoinAncestor : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), (0 < (F.q F.slot.succ).1) → (((F.q F.slot.succ).1 < + (F.q 0).1) → ((AncestorOdometer (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) + F.tile (D.functions F.slot false) + F.odometer) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (BandPrototile C.1.1 join) → (((D.tiles F.slot false).cells = join.cells ∧ ((D.tiles + F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = join.anchor)) → + (AncestorOdometer C.1.1 F.outer.1.1 join F.tile (D.functions F.slot false) + F.odometer))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D hCpositive hstrict hselectedAnc r y u + join hjoinBand hjoinCells + have hstrictOuter : (F.q F.slot.succ).1 < F.outer.1.1.1 := by + rw [← F.child] + exact hstrict + have hAnc := AncestorOdometerInnerSupportNormalization + (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) join F.tile + (D.functions F.slot false) F.odometer hCpositive hstrictOuter hselectedAnc + (by simpa only [← F.parent] using hjoinBand) hjoinCells.1 + simpa only [← F.parent] using hAnc + +private theorem positiveCells : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), + (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → ((Fin (4 : ℕ) + → CircleCoordinates) → (∀ (c : CircleCoordinates), ∀ (T : ProtoTile), 0 < c.1 → + BandPrototile c T → T.cells.Nonempty)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p c T hc hT + induction hT with + | line w z hw => simp at hc + | unit z x anchor => simp + | @decompose q hq S T hs hcells hfoot hcentroid ih => + have hp' : ∃ i : Fin 3, 0 < (q i.succ).1 := by + by_cases h0 : 0 < (q (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (q (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + by_cases h2 : 0 < (q (2 : Fin 3).succ).1 + · exact ⟨2, h2⟩ + have facts := ProperBandCurvatureStructure q hq + have n0 := facts.2.1 (0 : Fin 3) + have n1 := facts.2.1 (1 : Fin 3) + have hzero0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have hzero1 : (q (1 : Fin 3).succ).1 = 0 := by omega + exact False.elim ((by decide : (0 : Fin 3) ≠ 1) + (facts.2.2 0 1 hzero0 hzero1)) + rcases hp' with ⟨i, hi⟩ + rcases ih i false hi with ⟨x, hx⟩ + exact ⟨x, (hcells x).mpr ⟨i, false, hx⟩⟩ + +private theorem hjoinFootEq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + ((D.tiles F.slot false).cells = join.cells ∧ ((D.tiles F.slot false).cells = ∅ → (D.tiles + F.slot false).anchor = join.anchor)) → (((D.tiles F.slot false).cells.Nonempty) → + ((join.cells.Nonempty) → (FootprintVertices join = FootprintVertices (D.tiles F.slot + false)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r y u join hjoinCells hUnonempty + hJoinNonemptyBase + simp only [FootprintVertices, ite_eq_left hJoinNonemptyBase, ite_eq_left hUnonempty] + rw [hjoinCells.1] + +private theorem hjoinFoot : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (FootprintVertices (D.tiles F.slot false) ⊆ FootprintVertices F.tile) → (∀ (u : + ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (FootprintVertices join = FootprintVertices (D.tiles F.slot false)) → (FootprintVertices + join ⊆ FootprintVertices F.tile)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r y hUfoot u join hjoinFootEq + rw [hjoinFootEq] + exact hUfoot + +private theorem hjoinOccurrence : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then (1 : + ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 + : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : + ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : + ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (BandPrototile C.1.1 join) → ((TileCentroid (D.tiles F.slot false) = TileCentroid join) → + ((FootprintVertices join ⊆ FootprintVertices F.tile) → (BandSubtileOccurrence F.q + F.tile F.slot false join)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r y hUcent u join hjoinBand + hjoinCenterEq hjoinFoot + refine ⟨by simpa only [← F.parent] using hjoinBand, hjoinFoot, ?_⟩ + rw [← hjoinCenterEq] + exact hUcent + +private theorem hq0 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q + a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] = ![((2 : + ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : + Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : + ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : + Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), + p (3 : Fin (4 : ℕ))]) → (F.q 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hstep + have h := congrFun hstep 0 + simpa using h + +private theorem hqA : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q + a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] = ![((2 : + ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : + Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : + ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : + Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), + p (3 : Fin (4 : ℕ))]) → (F.q a.succ = p 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hstep + have h := congrFun hstep 1 + simpa using h + +private theorem hqB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q + a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] = ![((2 : + ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : + Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : + ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : + Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), + p (3 : Fin (4 : ℕ))]) → (F.q (a + 1).succ = p 2) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hstep + have h := congrFun hstep 2 + simpa using h + +private theorem hqD : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q + a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] = ![((2 : + ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : + Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : + ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : + Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), + p (3 : Fin (4 : ℕ))]) → (F.q (a + 2).succ = p 3) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hstep + have h := congrFun hstep 3 + simpa using h + +private theorem hslot : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), (Fin (4 : ℕ) → CircleCoordinates) → ((F.slot ≠ a) → (F.slot = a + 1 ∨ + F.slot = a + 2)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p selected + have hne : F.slot.val ≠ a.val := by + intro heq + exact selected (Fin.ext heq) + have hval : F.slot.val = (a.val + 1) % 3 ∨ + F.slot.val = (a.val + 2) % 3 := by omega + rcases hval with hval | hval + · apply Or.inl + apply Fin.ext + rw [Fin.val_add] + exact hval + · apply Or.inr + apply Fin.ext + rw [Fin.val_add] + exact hval + +private theorem hSlopeInfo : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), (Fin (4 : ℕ) → CircleCoordinates) → ((0 < (F.q + F.slot.succ).1) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + ∃ root child : ℝ × ℝ, PartialOdometerSlope F.odometer = some root ∧ PartialOdometerSlope + (D.functions F.slot false) = some child ∧ child.1 - root.1 = -(1 / 2 : ℝ) * (((wa.re + : ℤ) : ℝ) - ((wa.im : ℤ) : ℝ)) ∧ child.2 - root.2 = -(1 / 2 : ℝ) * (((wa.im : ℤ) : ℝ) + + ((wa.re : ℤ) : ℝ)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D p hCpositive r wa + rcases D.slopes F.slot false with hz | ⟨root, child, hroot, hchild, hre, him⟩ + · have hz' : (F.q F.slot.succ).1 = 0 := hz + omega + · refine ⟨root, child, hroot, hchild, ?_, ?_⟩ + · simpa [r, wa] using hre + · simpa [r, wa] using him + +private theorem hr2At377 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + (F.q (a + 2).succ = p 3) → ((F.slot = a + (1 : Fin (3 : ℕ))) → (r 2 = p 3)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r hqD hSB + have hidx : (a + 1) + 1 = a + 2 := by + apply Fin.ext + simp [Fin.val_add] + simp only [r, hSB] + rw [hidx] + exact hqD + +private theorem hr3At384 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + (F.q a.succ = p 0) → ((F.slot = a + (1 : Fin (3 : ℕ))) → (r 3 = p 0)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r hqA hSB + have hidx : (a + 1) + 2 = a := by + apply Fin.ext + simp [Fin.val_add]; omega + simp only [r, hSB] + rw [hidx] + exact hqA + +private theorem hparentB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (F.q (a + 1).succ = p 2) → + ((F.slot = a + (1 : Fin (3 : ℕ))) → (p 2 = C.1.1)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hqB hSB + calc + p 2 = F.q (a + 1).succ := hqB.symm + _ = F.q F.slot.succ := by rw [hSB] + _ = C.1.1 := F.parent + +private theorem houterAnc : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), (F.q a.succ = p 0) → ((0 < (F.q a.succ).1) → (AncestorOdometer (p + 0) F.outer.1.1 (D.tiles a true) F.tile (D.functions a true) F.odometer)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hAcoord hApos' + simpa only [hAcoord] using D.ancestors a true hApos' + +private theorem hvAB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple p) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + (BandVectors.1 (p 2) (p 0) = x) → (BandVectors.1 (p 0) (p 2) = I * x)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p hp r I x hBA + have h := (VectorRecursionLaws p hp.1).2.2.2.2 hp 1 |>.1 + simpa [I, hBA] using h + +private theorem haAB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple p) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + (BandVectors.2 (p 2) (p 0) = xa) → (BandVectors.2 (p 0) (p 2) = -I * xa)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p hp r I xa haBA + have h := (VectorRecursionLaws p hp.1).2.2.2.2 hp 1 |>.2 + simpa [I, haBA] using h + +private theorem hAoccAt427 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (F.q (a + 1).succ = p 2) → ((F.q (a + 2).succ = p 3) → ((r 1 = p 2) → ((r 2 = p 3) → + (TileCentroid (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • + (GaussianRealPoint y - (-(GaussianRealPoint y).2, (GaussianRealPoint y).1)))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p r y hqB hqD hr1 hr2 + have h := (D.occurrences a true).2.2 + simpa [hqD, hqB, y, hr1, hr2] using h + +private theorem hARe'At432 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (F.q (a + 1).succ = p 2) → ((F.q (a + 2).succ = p 3) → ((r 1 = p 2) → ((r 2 = p 3) → (∀ + (rootSlope : ℝ × ℝ), ∀ (aSlope : ℝ × ℝ), (aSlope.1 - rootSlope.1 = (if true = true + then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : + ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → (aSlope.1 - + rootSlope.1 = (1 / 2 : ℝ) * (ya.re - ya.im)))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r ya hqB hqD hr1 hr2 rootSlope aSlope + hARe + simpa [hqD, hqB, hr1, hr2, ya] using hARe + +private theorem hAIm'At435 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (F.q (a + 1).succ = p 2) → ((F.q (a + 2).succ = p 3) → ((r 1 = p 2) → ((r 2 = p 3) → (∀ + (rootSlope : ℝ × ℝ), ∀ (aSlope : ℝ × ℝ), (aSlope.2 - rootSlope.2 = (if true = true + then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : + ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (aSlope.2 - + rootSlope.2 = (1 / 2 : ℝ) * (ya.im + ya.re)))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r ya hqB hqD hr1 hr2 rootSlope aSlope + hAIm + simpa [hqD, hqB, hr1, hr2, ya] using hAIm + +private theorem hasumReAt438 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (wa + xa + ya = 0) → (wa.re + xa.re + ya.re = 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum + have h := congrArg (fun z : GaussianInt => z.re) hasum + simpa [wa, xa, ya] using h + +private theorem hasumImAt441 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (wa + xa + ya = 0) → (wa.im + xa.im + ya.im = 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum + have h := congrArg (fun z : GaussianInt => z.im) hasum + simpa [wa, xa, ya] using h + +private theorem hminusSlopeOffset : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ∀ (rootNeg : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (joinSlope.1 - rootNeg.1 = -(1 / 2 : ℝ) * + ((↑wa.re : ℝ) - (↑wa.im : ℝ))) → ((joinSlope.2 - rootNeg.2 = -(1 / 2 : ℝ) * ((↑wa.im + : ℝ) + (↑wa.re : ℝ))) → ((rootNeg = F.outer_slope) → (∀ (rootSlope : ℝ × ℝ), ∀ + (aSlope : ℝ × ℝ), (rootSlope = F.outer_slope) → ((BandVectors.2 (p 2) (p 0) = xa) → + ((BandVectors.2 (p 0) (p 2) = -I * xa) → ((aSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * + (ya.re - ya.im)) → ((aSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * (ya.im + ya.re)) → + (((wa.re : ℝ) + (xa.re : ℝ) + (ya.re : ℝ) = 0) → (((wa.im : ℝ) + (xa.im : ℝ) + (ya.im + : ℝ) = 0) → ((∀ (z : GaussianInt), (GaussianInt.toComplex z).re = (z.re : ℝ)) → ((∀ + (z : GaussianInt), (GaussianInt.toComplex z).im = (z.im : ℝ)) → (joinSlope - aSlope = + (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p 2) (p 0) - BandVectors.2 (p 0) (p + 2)))))))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p r I wa xa ya rootNeg joinSlope + hjoinSlopeRe hjoinSlopeIm hrootNegEq rootSlope aSlope hrootSlopeEq haBA haAB hARe' hAIm' + hasumReR hasumImR toRealRe toRealIm + apply Prod.ext + · calc + joinSlope.1 - aSlope.1 = + (joinSlope.1 - rootNeg.1) - (aSlope.1 - rootSlope.1) := by + rw [hrootNegEq, hrootSlopeEq] + ring + _ = (1 / 2 : ℝ) * (xa.re - xa.im) := by + rw [hjoinSlopeRe, hARe'] + linarith [hasumReR, hasumImR] + _ = ((1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (p 2) (p 0) - BandVectors.2 (p 0) (p 2))).1 := by + change (1 / 2 : ℝ) * ((xa.re : ℝ) - (xa.im : ℝ)) = + (1 / 2 : ℝ) * + (((BandVectors.2 (p 2) (p 0) - + BandVectors.2 (p 0) (p 2)).re : ℤ) : ℝ) + congr 1 + rw [haBA, haAB] + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] + rw [toRealRe, toRealIm] + ring + · calc + joinSlope.2 - aSlope.2 = + (joinSlope.2 - rootNeg.2) - (aSlope.2 - rootSlope.2) := by + rw [hrootNegEq, hrootSlopeEq] + ring + _ = (1 / 2 : ℝ) * (xa.im + xa.re) := by + rw [hjoinSlopeIm, hAIm'] + linarith [hasumReR, hasumImR] + _ = ((1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (p 2) (p 0) - BandVectors.2 (p 0) (p 2))).2 := by + change (1 / 2 : ℝ) * ((xa.im : ℝ) + (xa.re : ℝ)) = + (1 / 2 : ℝ) * + (((BandVectors.2 (p 2) (p 0) - + BandVectors.2 (p 0) (p 2)).im : ℤ) : ℝ) + congr 1 + rw [haBA, haAB] + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] + +private theorem hFplusSlope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ∀ (rootSlope : ℝ × ℝ), (rootSlope = F.outer_slope) → (F.plus_slope - rootSlope = (1 / 2 : + ℝ) • GaussianRealPoint (BandVectors.2 (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r rootSlope hrootSlopeEq + rw [hrootSlopeEq] + simpa [r, GaussianRealPoint, Prod.smul_mk] using F.plus_difference + +private theorem hFplusRe : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ∀ (rootSlope : ℝ × ℝ), (F.plus_slope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) → (F.plus_slope.1 - + rootSlope.1 = (1 / 2 : ℝ) * (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re) + + ((GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r rootSlope hFplusSlope + have h := congrArg Prod.fst hFplusSlope + simpa [GaussianRealPoint] using h + +private theorem hFplusIm : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ∀ (rootSlope : ℝ × ℝ), (F.plus_slope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) → (F.plus_slope.2 - + rootSlope.2 = (1 / 2 : ℝ) * (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im) + + ((GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r rootSlope hFplusSlope + have h := congrArg Prod.snd hFplusSlope + simpa [GaussianRealPoint] using h + +private theorem ha10ReAt509 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), (Fin (3 : + ℕ)) → ((Fin (4 : ℕ) → CircleCoordinates) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.2 (r 1) (r 0)).re = xa.re - + ya.im))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I xa ya harec + have h := congrArg (fun z : GaussianInt => z.re) harec + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + omega + +private theorem ha10ImAt513 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.2 (r 1) (r 0)).im = xa.im + + ya.re) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I xa ya harec + have h := congrArg (fun z : GaussianInt => z.im) harec + simp [I, Zsqrtd.im_mul] at h + omega + +private theorem ha01ReAt517 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → (((BandVectors.2 (r 1) (r + 0)).im = xa.im + ya.re) → ((BandVectors.2 (r 0) (r 1)).re = xa.im + ya.re)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I xa ya haflip ha10Im + have h := congrArg (fun z : GaussianInt => z.re) haflip + simp? [I, Zsqrtd.re_mul] at h + rw [ha10Im] at h + omega + +private theorem ha01ImAt522 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), (Fin (3 : + ℕ)) → ((Fin (4 : ℕ) → CircleCoordinates) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → (((BandVectors.2 (r 1) (r + 0)).re = xa.re - ya.im) → ((BandVectors.2 (r 0) (r 1)).im = -xa.re + ya.im)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I xa ya haflip ha10Re + have h := congrArg (fun z : GaussianInt => z.im) haflip + simp? [I, Zsqrtd.im_mul] at h + rw [ha10Re] at h + omega + +private theorem hplusReVec : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + (BandVectors.2 (p 2) (p 0) = xa) → ((BandVectors.2 (p 0) (p 2) = -I * xa) → + ((BandVectors.2 (p 2) (p 0) + BandVectors.2 (p 0) (p 2)).re = xa.re + xa.im)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p r I xa haBA haAB + rw [haBA, haAB] + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] + +private theorem hplusImVec : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), (Fin (3 : + ℕ)) → (∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + (BandVectors.2 (p 2) (p 0) = xa) → ((BandVectors.2 (p 0) (p 2) = -I * xa) → + ((BandVectors.2 (p 2) (p 0) + BandVectors.2 (p 0) (p 2)).im = xa.im - xa.re))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I xa haBA haAB + rw [haBA, haAB] + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] + omega + +private theorem hFplusRe' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ∀ (rootSlope : ℝ × ℝ), (∀ (z : GaussianInt), (GaussianInt.toComplex z).re = (z.re : ℝ)) → + ((F.plus_slope.1 - rootSlope.1 = (1 / 2 : ℝ) * (((GaussianInt.toComplex + (BandVectors.2 (r 1) (r 0))).re) + ((GaussianInt.toComplex (BandVectors.2 (r 0) (r + 1))).re))) → (F.plus_slope.1 - rootSlope.1 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r + 0)).re : ℝ) + ((BandVectors.2 (r 0) (r 1)).re : ℝ)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r rootSlope toRealRe hFplusRe + simpa only [toRealRe] using hFplusRe + +private theorem hFplusIm' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ∀ (rootSlope : ℝ × ℝ), (∀ (z : GaussianInt), (GaussianInt.toComplex z).im = (z.im : ℝ)) → + ((F.plus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) * (((GaussianInt.toComplex + (BandVectors.2 (r 1) (r 0))).im) + ((GaussianInt.toComplex (BandVectors.2 (r 0) (r + 1))).im))) → (F.plus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r + 0)).im : ℝ) + ((BandVectors.2 (r 0) (r 1)).im : ℝ)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r rootSlope toRealIm hFplusIm + simpa only [toRealIm] using hFplusIm + +private theorem hplusSlopeOffset : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ∀ (rootSlope : ℝ × ℝ), ∀ (aSlope : ℝ × ℝ), (aSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * (ya.re + - ya.im)) → ((aSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * (ya.im + ya.re)) → + (((BandVectors.2 (r 1) (r 0)).re = xa.re - ya.im) → (((BandVectors.2 (r 1) (r 0)).im + = xa.im + ya.re) → (((BandVectors.2 (r 0) (r 1)).re = xa.im + ya.re) → + (((BandVectors.2 (r 0) (r 1)).im = -xa.re + ya.im) → (((BandVectors.2 (p 2) (p 0) + + BandVectors.2 (p 0) (p 2)).re = xa.re + xa.im) → (((BandVectors.2 (p 2) (p 0) + + BandVectors.2 (p 0) (p 2)).im = xa.im - xa.re) → ((F.plus_slope.1 - rootSlope.1 = (1 + / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).re : ℝ) + ((BandVectors.2 (r 0) (r 1)).re : + ℝ))) → ((F.plus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r + 0)).im : ℝ) + ((BandVectors.2 (r 0) (r 1)).im : ℝ))) → (F.plus_slope - aSlope = (1 / + 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p 2) (p 0) + BandVectors.2 (p 0) (p + 2)))))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p r xa ya rootSlope aSlope hARe' hAIm' + ha10Re ha10Im ha01Re ha01Im hplusReVec hplusImVec hFplusRe' hFplusIm' + apply Prod.ext + · calc + F.plus_slope.1 - aSlope.1 = + (F.plus_slope.1 - rootSlope.1) - (aSlope.1 - rootSlope.1) := by ring + _ = (1 / 2 : ℝ) * (xa.re + xa.im) := by + rw [hFplusRe', hARe', ha10Re, ha01Re] + push_cast + ring + _ = ((1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (p 2) (p 0) + BandVectors.2 (p 0) (p 2))).1 := by + change (1 / 2 : ℝ) * ((xa.re : ℝ) + (xa.im : ℝ)) = + (1 / 2 : ℝ) * + (((BandVectors.2 (p 2) (p 0) + + BandVectors.2 (p 0) (p 2)).re : ℤ) : ℝ) + congr 1 + exact_mod_cast hplusReVec.symm + · calc + F.plus_slope.2 - aSlope.2 = + (F.plus_slope.2 - rootSlope.2) - (aSlope.2 - rootSlope.2) := by ring + _ = (1 / 2 : ℝ) * (xa.im - xa.re) := by + rw [hFplusIm', hAIm', ha10Im, ha01Im] + push_cast + ring + _ = ((1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (p 2) (p 0) + BandVectors.2 (p 0) (p 2))).2 := by + change (1 / 2 : ℝ) * ((xa.im : ℝ) - (xa.re : ℝ)) = + (1 / 2 : ℝ) * + (((BandVectors.2 (p 2) (p 0) + + BandVectors.2 (p 0) (p 2)).im : ℤ) : ℝ) + congr 1 + exact_mod_cast hplusImVec.symm + +private theorem hPcenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 + (r 1) (r 0) + BandVectors.1 (r 0) (r 1)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r + simpa [r] using F.plus_centroid + +private theorem hFminusSlopeAt641 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ∀ (rootSlope : ℝ × ℝ), (rootSlope = F.outer_slope) → (F.minus_slope - rootSlope = (1 / 2 + : ℝ) • GaussianRealPoint (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) ) + := by + classical + intro C orientation base Rminus Rplus hminus hplus F r rootSlope hrootSlopeEq + rw [hrootSlopeEq] + exact F.minus_difference + +private theorem hFminusReAt646 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ∀ (rootSlope : ℝ × ℝ), (F.minus_slope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) → (F.minus_slope.1 - + rootSlope.1 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).re : ℝ) - ((BandVectors.2 + (r 0) (r 1)).re : ℝ))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r rootSlope hFminusSlope + have h := congrArg Prod.fst hFminusSlope + simpa [GaussianRealPoint, Prod.smul_mk] using h + +private theorem hFminusImAt652 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ∀ (rootSlope : ℝ × ℝ), (F.minus_slope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) → (F.minus_slope.2 - + rootSlope.2 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).im : ℝ) - ((BandVectors.2 + (r 0) (r 1)).im : ℝ))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r rootSlope hFminusSlope + have h := congrArg Prod.snd hFminusSlope + simpa [GaussianRealPoint, Prod.smul_mk] using h + +private theorem hdirectSlope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ∀ (joinSlope : ℝ × ℝ), ∀ (rootSlope : ℝ × ℝ), (joinSlope.2 - rootSlope.2 = -(1 / 2 : ℝ) * + ((↑wa.im : ℝ) + (↑wa.re : ℝ))) → ((joinSlope.1 - rootSlope.1 = -(1 / 2 : ℝ) * + ((↑wa.re : ℝ) - (↑wa.im : ℝ))) → (((↑wa.re : ℝ) + (↑xa.re : ℝ) + (↑ya.re : ℝ) = (0 : + ℝ)) → (((↑wa.im : ℝ) + (↑xa.im : ℝ) + (↑ya.im : ℝ) = (0 : ℝ)) → ((F.minus_slope.1 - + rootSlope.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : + ℕ)))).re : ℝ) - (↑(BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).re : + ℝ))) → ((F.minus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (r (1 : Fin + (4 : ℕ))) (r (0 : Fin (4 : ℕ)))).im : ℝ) - (↑(BandVectors.2 (r (0 : Fin (4 : ℕ))) (r + (1 : Fin (4 : ℕ)))).im : ℝ))) → ((((BandVectors.2 (r 1) (r 0)).re : ℝ) = (xa.re : ℝ) + - (ya.im : ℝ)) → ((((BandVectors.2 (r 1) (r 0)).im : ℝ) = (xa.im : ℝ) + (ya.re : ℝ)) + → ((((BandVectors.2 (r 0) (r 1)).re : ℝ) = (xa.im : ℝ) + (ya.re : ℝ)) → + ((((BandVectors.2 (r 0) (r 1)).im : ℝ) = -(xa.re : ℝ) + (ya.im : ℝ)) → (joinSlope - + F.minus_slope = GaussianRealPoint ya)))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa xa ya joinSlope rootSlope + hjoinSlopeIm hjoinSlopeRe hasumReR hasumImR hFminusRe hFminusIm ha10ReR ha10ImR ha01ReR + ha01ImR + apply Prod.ext + · calc + joinSlope.1 - F.minus_slope.1 = + (joinSlope.1 - rootSlope.1) - + (F.minus_slope.1 - rootSlope.1) := by ring + _ = (ya.re : ℝ) := by + rw [hjoinSlopeRe, hFminusRe, + ha10ReR, ha01ReR] + linarith [hasumReR, hasumImR] + · calc + joinSlope.2 - F.minus_slope.2 = + (joinSlope.2 - rootSlope.2) - + (F.minus_slope.2 - rootSlope.2) := by ring + _ = (ya.im : ℝ) := by + rw [hjoinSlopeIm, hFminusIm, + ha10ImR, ha01ImR] + linarith [hasumReR, hasumImR] + +private theorem hleftCent : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = GaussianRealPoint y) → (∀ (u + : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (TileCentroid (D.tiles F.slot false) = TileCentroid join) → (TileCentroid join - + TileCentroid Rminus = GaussianRealPoint y)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r y hcenter u join hjoinCenterEq + rw [← hjoinCenterEq] + exact hcenter + +private theorem hbaseT : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), + (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → (∀ (t : Fin + (4 : ℕ) → CircleCoordinates), (t 0 = C.1.1) → (BandPrototile (t 0) base)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F t htC + rw [htC] + exact F.base_band + +private theorem hleftTouch : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + (4 : ℕ) → CircleCoordinates), ∀ (t : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple t) → ((t (0 : Fin (4 : ℕ)) = p (2 : Fin (4 : ℕ))) → ((t (1 : Fin + (4 : ℕ)) = p (3 : Fin (4 : ℕ))) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (join ∈ RegularTileFamily base (TilingLattice C)) → ((r 1 = p 2) → ((r 2 = p 3) → + ((TileCentroid join - TileCentroid Rminus = GaussianRealPoint y) → ((t 0 = C.1.1) → + ((BandPrototile (t 0) base) → (TileTouching Rminus join))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p t ht ht0 ht1 r y u join hjoinFamily hr1 + hr2 hleftCent htC hbaseT + apply (BandRegularTileTouchingClassification C t ht htC + base hbaseT Rminus join F.minus_family hjoinFamily).2 + exact ⟨0, Or.inl (by simpa [y, ht0, ht1, hr1, hr2] using hleftCent)⟩ + +private theorem hleftAdjacent : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), ∀ (t : Fin (4 + : ℕ) → CircleCoordinates), (ProperBandQuadruple t) → ((t (0 : Fin (4 : ℕ)) = p (2 : + Fin (4 : ℕ))) → ((t (1 : Fin (4 : ℕ)) = p (3 : Fin (4 : ℕ))) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (TileOdometer C.1.1 join (D.functions F.slot false)) → (∀ (joinSlope : ℝ × ℝ), + (PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → ((r 1 = p 2) → + ((r 2 = p 3) → ((joinSlope - F.minus_slope = GaussianRealPoint ya) → ((TileCentroid + join - TileCentroid Rminus = GaussianRealPoint y) → ((t 0 = C.1.1) → + (LeftLatticeAdjacent C Rminus join hminus (D.functions F.slot false))))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D p t ht ht0 ht1 r y ya u join hjoinOdo + joinSlope hjoinSlope hr1 hr2 hdirectSlope hleftCent htC + refine ⟨F.minus_odo, hjoinOdo, F.minus_slope, joinSlope, + F.slope_minus, hjoinSlope, ?_⟩ + right + refine ⟨t, 0, true, ht, htC, ?_, ?_, ?_⟩ + · simpa [y, ht0, ht1, hr1, hr2] using hleftCent + · have h := congrArg Prod.fst hdirectSlope + simpa [GaussianRealPoint, ya, ht0, ht1, hr1, hr2] using h + · have h := congrArg Prod.snd hdirectSlope + simpa [GaussianRealPoint, ya, ht0, ht1, hr1, hr2] using h + +private theorem hMnonempty : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), + (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → ((∀ (c : + CircleCoordinates), ∀ (T : ProtoTile), 0 < c.1 → BandPrototile c T → + T.cells.Nonempty) → (Rminus.cells.Nonempty)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F positiveCells + apply positiveCells C.1.1 Rminus C.2 + exact TileOdometerBandPrototile C.1.1 Rminus hminus F.minus_odo + +private theorem hJnonempty : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + ((D.tiles F.slot false).cells = join.cells ∧ ((D.tiles F.slot false).cells = ∅ → (D.tiles + F.slot false).anchor = join.anchor)) → (((D.tiles F.slot false).cells.Nonempty) → + (join.cells.Nonempty)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r y u join hjoinCells hUnonempty + rw [← hjoinCells.1] + exact hUnonempty + +private theorem hleftNe : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (TileTouching Rminus join) → ((Rminus.cells.Nonempty) → (Rminus ≠ join)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r y u join hleftTouch hMnonempty heq + have htch := hleftTouch + rw [← heq] at htch + rcases htch with h | h | h + · exact hMnonempty.ne_empty ((Finset.disjoint_self_iff_empty _).mp h.2.2.1) + · exact hMnonempty.ne_empty h.1 + · exact hMnonempty.ne_empty h.1 + +private theorem hnonunit : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), + (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → ((Fin (3 : + ℕ)) → ((Fin (4 : ℕ) → CircleCoordinates) → (∀ (t : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple t) → ((t 0 = C.1.1) → (C.1.1.1 ≠ 1))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p t ht htC + have hcurv := ProperBandCurvatureStructure t ht + have hrootlarge : 1 < (t 0).1 := by + by_contra hn + have hrootle : (t 0).1 ≤ 1 := by omega + have hzeros : ∀ k : Fin 3, (t k.succ).1 = 0 := by + intro k + have hnonneg := hcurv.2.1 k + have hbelow := ht.2 k + omega + exact ((by decide : (0 : Fin 3) ≠ 1) + (hcurv.2.2 0 1 (hzeros 0) (hzeros 1))).elim + have hcurvEq : (t 0).1 = C.1.1.1 := congrArg Prod.fst htC + rw [← hcurvEq] + exact ne_of_gt hrootlarge + +private theorem leftString : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), ∀ (hp : ProperBandQuadruple p), (![F.q (0 : Fin (4 : + ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] + = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) + * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin + (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 + : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : + ℕ)), p (3 : Fin (4 : ℕ))]) → (∀ (hB : F.slot = a + (1 : Fin (3 : ℕ)) → C.1.1.1 = (1 : + ℤ) → UnitOccurrenceOrientation p (1 : Fin (3 : ℕ)) orientation), (F.slot = a + + (2 : Fin (3 : ℕ)) → C.1.1.1 = (1 : ℤ) → UnitOccurrenceOrientation p (2 : Fin (3 : ℕ)) + orientation) → ((F.slot ≠ a) → (∀ (t : Fin (4 : ℕ) → CircleCoordinates), (F.slot = a + + (2 : Fin (3 : ℕ)) → C.1.1.1 = (1 : ℤ) → + UnitOccurrenceOrientation t (0 : Fin (3 : ℕ)) orientation) → ((0 < (F.q + F.slot.succ).1) → (((F.q F.slot.succ).1 < (F.q 0).1) → ((AncestorOdometer (F.q + F.slot.succ) F.outer.1.1 (D.tiles F.slot false) F.tile + (D.functions F.slot false) + F.odometer) → ((TileOdometer (F.q F.slot.succ) (D.tiles F.slot false) + (D.functions F.slot false)) → ((∃ s, PartialOdometerSlope + (D.functions F.slot false) = some s) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + (ProperBandQuadruple r) → ((r 1 = C.1.1) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (w + x + y = 0) → ((wa + xa + ya = 0) → (∀ (hvrec : BandVectors.1 (r 1) + (r 0) = x - I * y), (BandVectors.2 (r 1) (r 0) = xa + I * ya) → (∀ (hvflip : + BandVectors.1 (r 0) (r 1) = I * BandVectors.1 (r 1) (r 0)), (BandVectors.2 + (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → ((w.re + x.re + y.re = 0) → ((w.im + + x.im + y.im = 0) → ((BandPrototile (F.q F.slot.succ) + (D.tiles F.slot false)) → ((FootprintVertices (D.tiles F.slot false) ⊆ + FootprintVertices F.tile) → ((TileCentroid (D.tiles F.slot false) - + TileCentroid F.tile = (if false = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q + (F.slot + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (F.q + (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q + (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → ((TileCentroid (D.tiles F.slot + false) - TileCentroid F.tile = -(1 / 2 : ℝ) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) → (∀ (hMcenter : TileCentroid + Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (r 1) + (r 0) - BandVectors.1 (r 0) (r 1))), (-w + I * w - BandVectors.1 (r + 1) (r 0) + BandVectors.1 (r 0) (r 1) = 2 * y) → (((↑(-w + I * w - + BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin + (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).re : ℝ) = (↑((2 : GaussianInt) * y).re : ℝ)) → + (((↑(-w + I * w - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : + ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im : ℝ) = (↑((2 : + GaussianInt) * y).im : ℝ)) → (∀ (hcenter : TileCentroid (D.tiles F.slot false) - + TileCentroid Rminus = GaussianRealPoint y), (y ∈ TilingLattice C) → (∀ (u : + ↥(TilingLattice C)), (Rminus = TileTranslation base (↑u : GaussianInt)) → ( + let join : ProtoTile := TileTranslation base (u + y) + (join = TileTranslation Rminus y) → ((BandPrototile C.1.1 join) → (∀ (hjoinFamily : join + ∈ RegularTileFamily base (TilingLattice C)), (TileCentroid join = TileCentroid Rminus + + GaussianRealPoint y) → (∀ (hjoinCenterEq : TileCentroid (D.tiles F.slot false) = + TileCentroid join), (BandPrototile + C.1.1 (D.tiles F.slot false)) → (((D.tiles F.slot false).cells = + join.cells ∧ ((D.tiles F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = + join.anchor)) → (∀ (hjoinOdo : TileOdometer C.1.1 join (D.functions F.slot false)), + (AncestorOdometer C.1.1 F.outer.1.1 join F.tile (D.functions F.slot + false) F.odometer) → (((D.tiles F.slot false).cells.Nonempty) → + ((join.cells.Nonempty) → ((FootprintVertices join = + FootprintVertices (D.tiles F.slot false)) → ((FootprintVertices join ⊆ + FootprintVertices F.tile) → ((BandSubtileOccurrence F.q F.tile + F.slot false join) → ((F.q 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p + 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2)) → ((F.q a.succ = p + 0) → ((F.q (a + 1).succ = p 2) → ((F.q (a + 2).succ = p 3) → (∀ (rootNeg : ℝ × ℝ), ∀ + (joinSlope : ℝ × ℝ), (PartialOdometerSlope F.odometer = some + rootNeg) → (∀ (hjoinSlope : PartialOdometerSlope (D.functions F.slot false) = some + joinSlope), (rootNeg = F.outer_slope) → (∀ (hSB : F.slot = a + (1 : Fin + (3 : ℕ))), (r 1 = p 2) → ((r 2 = p 3) → ((r 3 = p 0) → ((F.q a.succ = p 0) → ((0 < + (F.q a.succ).1) → (∀ (rootSlope : ℝ × ℝ), (joinSlope.2 - rootSlope.2 = -(1 / 2 : + ℝ) * ((↑wa.im : ℝ) + (↑wa.re : + ℝ))) → ((joinSlope.1 - rootSlope.1 = -(1 / 2 : ℝ) * ((↑wa.re : ℝ) - + (↑wa.im : ℝ))) → (∀ (aSlope : ℝ × ℝ), (PartialOdometerSlope F.odometer = + some rootSlope) → (∀ (haSlope : PartialOdometerSlope (D.functions a true) = some + aSlope), (aSlope.1 - rootSlope.1 = (if true = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 + : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) + (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((aSlope.2 - rootSlope.2 = (if + true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + + (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : + ℕ))).succ)).re : ℝ))) → ((rootSlope = F.outer_slope) → ( + let outerA : BandCircle := + ⟨⟨p 0, ⟨Or.inl (ProperBandCurvatureStructure p hp).1, + ⟨p, hp.1, 0, rfl⟩⟩⟩, (ProperBandCurvatureStructure p hp).1⟩ + (outerA.1.1 = F.q a.succ) → (∀ (hparentB : p (2 : Fin (4 : + ℕ)) = C.1.1), ∀ (houterOdo : TileOdometer (p (0 : Fin (4 : ℕ))) (D.tiles a true) + (D.functions a true)), ∀ (houterBand : BandPrototile (p (0 : Fin (4 : ℕ))) (D.tiles a + true)), (AncestorOdometer (p (0 : Fin (4 : ℕ))) F.outer.1.1 (D.tiles a + true) F.tile (D.functions a true) + F.odometer) → (∀ (hBA : BandVectors.1 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) = + x), (BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) = xa) → (∀ (hvAB : + BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))) = I * x), + (BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))) = -I * xa) → (∀ (hidx2 + : Fin.succ (1 : Fin (3 : ℕ)) = (2 : Fin ((3 : ℕ) + (1 : ℕ)))), ∀ (hAocc : + TileCentroid + (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • (GaussianRealPoint y - + (-(GaussianRealPoint y).2, (GaussianRealPoint y).1))), (aSlope.1 - + rootSlope.1 = (1 / 2 : ℝ) * ((↑ya.re : ℝ) - (↑ya.im : ℝ))) → ((aSlope.2 - + rootSlope.2 = (1 / 2 : ℝ) * ((↑ya.im : ℝ) + (↑ya.re : ℝ))) → ((wa.re + + xa.re + ya.re = (0 : ℤ)) → ((wa.im + xa.im + ya.im = (0 : ℤ)) → (((↑wa.re : ℝ) + + (↑xa.re : ℝ) + (↑ya.re : ℝ) = (0 : ℝ)) → (((↑wa.im : ℝ) + + (↑xa.im : ℝ) + (↑ya.im : ℝ) = (0 : ℝ)) → (∀ (hminusSlopeOffset : joinSlope - aSlope = + (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : + ℕ))) - BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))))), (F.plus_slope - + rootSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r (1 : Fin + (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 + : ℕ))))) → ((F.plus_slope.1 - rootSlope.1 = (1 / 2 : ℝ) * + (((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))))).re + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 + (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))))).re)) → ((F.plus_slope.2 - + rootSlope.2 = (1 / 2 : ℝ) * (((GaussianInt.toComplex : GaussianInt → ℂ) + (BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))))).im + + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 + : Fin (4 : ℕ))))).im)) → (((BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin + (4 : ℕ)))).re = xa.re - ya.im) → (((BandVectors.2 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ)))).im = xa.im + ya.re) → (((BandVectors.2 (r (0 : Fin (4 : + ℕ))) (r (1 : Fin (4 : ℕ)))).re = xa.im + ya.re) → (((BandVectors.2 (r (0 : + Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im = -xa.re + ya.im) → (((BandVectors.2 (p (2 : + Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) + BandVectors.2 (p (0 : + Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ)))).re = xa.re + xa.im) → (((BandVectors.2 (p (2 : + Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) + BandVectors.2 (p (0 : + Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ)))).im = xa.im - xa.re) → ((F.plus_slope.1 - + rootSlope.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (r (1 : Fin (4 : ℕ))) + (r (0 : Fin (4 : ℕ)))).re : ℝ) + (↑(BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin + (4 : ℕ)))).re : ℝ))) → ((F.plus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) * + ((↑(BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ)))).im : ℝ) + + (↑(BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im : ℝ))) → (∀ + (hplusSlopeOffset : F.plus_slope - aSlope = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) + BandVectors.2 (p (0 : + Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))))), + let G : P4458T1BoundaryFrame C orientation base join Rplus + (D.functions F.slot false) hplus := { + outer := outerA + q := p + proper := hp + slot := 1 + child := rfl + parent := hparentB + tile := D.tiles a true + odometer := D.functions a true + outer_odo := houterOdo + minus_odo := hjoinOdo + plus_odo := F.plus_odo + outer_band := houterBand + base_band := F.base_band + minus_family := hjoinFamily + plus_family := F.plus_family + chart := by + intro hunit + exact hB hSB (by simpa only [hparentB] using hunit) + minus_centroid := by + rw [hidx2] + rw [show TileCentroid join - TileCentroid (D.tiles a true) = + (TileCentroid join - TileCentroid Rminus) + + (TileCentroid Rminus - TileCentroid F.tile) - + (TileCentroid (D.tiles a true) - TileCentroid F.tile) by + ext <;> dsimp <;> ring] + rw [← hjoinCenterEq, hcenter, hMcenter, hAocc, + hvflip, hvrec, hBA, hvAB] + apply Prod.ext <;> + simp [GaussianRealPoint, I, Prod.smul_mk, + Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring + plus_centroid := by + rw [hidx2] + rw [show TileCentroid Rplus - TileCentroid (D.tiles a true) = + (TileCentroid Rplus - TileCentroid F.tile) - + (TileCentroid (D.tiles a true) - TileCentroid F.tile) by + ext <;> dsimp <;> ring] + have hPcenter : TileCentroid Rplus - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1)) := by + simpa [r] using F.plus_centroid + rw [hPcenter, hAocc, hvflip, hvrec, hBA, hvAB] + apply Prod.ext <;> + simp [GaussianRealPoint, I, Prod.smul_mk, + Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring + outer_slope := aSlope + minus_slope := joinSlope + plus_slope := F.plus_slope + slope_outer := haSlope + slope_minus := hjoinSlope + slope_plus := F.slope_plus + minus_difference := hminusSlopeOffset + plus_difference := hplusSlopeOffset + } + (G.outer.1.1 = F.q a.succ) → + ((P4458T1BoundarySide F join Rplus (D.functions F.slot false) hplus) → + ((F.minus_slope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r (1 : + Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin + (4 : ℕ))))) → ((F.minus_slope.1 - rootSlope.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (r (1 + : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ)))).re : ℝ) - (↑(BandVectors.2 (r (0 : Fin (4 : + ℕ))) (r (1 : Fin (4 : ℕ)))).re : ℝ))) → ((F.minus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) + * ((↑(BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ)))).im : ℝ) - + (↑(BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im : ℝ))) → + ((((BandVectors.2 (r 1) (r 0)).re : ℝ) = (xa.re : ℝ) - (ya.im : ℝ)) → + ((((BandVectors.2 (r 1) (r 0)).im : ℝ) = (xa.im : ℝ) + (ya.re : ℝ)) → + ((((BandVectors.2 (r 0) (r 1)).re : ℝ) = (xa.im : ℝ) + (ya.re : ℝ)) → + ((((BandVectors.2 (r 0) (r 1)).im : ℝ) = -(xa.re : ℝ) + (ya.im : ℝ)) → ((joinSlope - + F.minus_slope = GaussianRealPoint ya) → ((TileCentroid join - TileCentroid Rminus = + GaussianRealPoint y) → ((TileTouching Rminus join) → ((LeftLatticeAdjacent C Rminus + join hminus (D.functions F.slot false)) → ((Rminus.cells.Nonempty) → + ((join.cells.Nonempty) → ((Rminus ≠ join) → ((C.1.1.1 ≠ 1) → (TileString C + orientation base Rminus join [Rminus, + join]))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + )))))))))))))))))))))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hp hstep hB hD selected t olderChart + hCpositive hstrict hselectedAnc hselectedOdo hnegativeSlope r hr hRparent I w x y wa xa ya + hvsum hasum hvrec harec hvflip haflip hvsumRe hvsumIm hUband hUfoot hUcent hUcenter + hMcenter hcenterVector hcenterRe hcenterIm hcenter hyLattice u huRminus join hjoin_eq + hjoinBand hjoinFamily hjoinCenter hjoinCenterEq hUbandC hjoinCells hjoinOdo hjoinAncestor + hUnonempty hJoinNonemptyBase hjoinFootEq hjoinFoot hjoinOccurrence hq0 hqA hqB hqD rootNeg + joinSlope hrootNeg hjoinSlope hrootNegEq hSB hr1 hr2 hr3 hAcoord hApos' rootSlope + hjoinSlopeIm hjoinSlopeRe aSlope hrootSlope haSlope hARe hAIm hrootSlopeEq outerA hparentA + hparentB houterOdo houterBand houterAnc hBA haBA hvAB haAB hidx2 hAocc hARe' hAIm' hasumRe + hasumIm hasumReR hasumImR hminusSlopeOffset hFplusSlope hFplusRe hFplusIm ha10Re ha10Im + ha01Re ha01Im hplusReVec hplusImVec hFplusRe' hFplusIm' hplusSlopeOffset G houterEq hright + hFminusSlope hFminusRe hFminusIm ha10ReR ha10ImR ha01ReR ha01ImR hdirectSlope hleftCent + hleftTouch hleftAdjacent hMnonempty hJnonempty hleftNe hnonunit + unfold TileString + refine ⟨F.base_band, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rfl + · rfl + · simpa using hleftNe + · intro T hT + simp only [List.mem_cons] at hT + rcases hT with hT | hT + · rcases hT with rfl + exact F.minus_family + · rcases hT with hT | hT + · rcases hT with rfl + exact hjoinFamily + · simp at hT + · simpa [List.IsChain, List.isChain_pair, hnonunit] using hleftTouch + · intro pre T post heq hpre hpost + have hlen := congrArg List.length heq + have hp' : 1 ≤ pre.length := by + cases pre with + | nil => simp at hpre + | cons x xs => simp + have hq' : 1 ≤ post.length := by + cases post with + | nil => simp at hpost + | cons x xs => simp + simp at hlen + omega + +private theorem hr2At770 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + (F.q a.succ = p 0) → ((F.slot = a + (2 : Fin (3 : ℕ))) → (r 2 = p 0)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r hqA hSD + have hidx : (a + 2) + 1 = a := by + apply Fin.ext + simp [Fin.val_add]; omega + simp only [r, hSD] + rw [hidx] + exact hqA + +private theorem hr3At777 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + (F.q (a + 1).succ = p 2) → ((F.slot = a + (2 : Fin (3 : ℕ))) → (r 3 = p 2)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r hqB hSD + have hidx : (a + 2) + 2 = a + 1 := by + apply Fin.ext + simp [Fin.val_add]; omega + simp only [r, hSD] + rw [hidx] + exact hqB + +private theorem hBpos : + (by + classical + exact + ∀ (p : Fin (4 : ℕ) → CircleCoordinates), ∀ (t : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple t) → ((t (0 : Fin (4 : ℕ)) = p (2 : Fin (4 : ℕ))) → (0 < (p + 2).1)) ) := by + classical + intro p t ht ht0 + have hcurv := ProperBandCurvatureStructure t ht + simpa [ht0] using hcurv.1 + +private theorem houterAOdo : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), (F.q a.succ = p 0) → (TileOdometer (p 0) (D.tiles a true) + (D.functions a true)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hqA + simpa only [hqA] using D.odometers a true + +private theorem houterAAnc : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), (F.q a.succ = p 0) → ((0 < (p 0).1) → (AncestorOdometer (p 0) + F.outer.1.1 (D.tiles a true) F.tile (D.functions a true) F.odometer)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hqA hApos + simpa only [hqA] using D.ancestors a true (by rw [hqA]; exact hApos) + +private theorem hparentD : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (F.q (a + 2).succ = p 3) → + ((F.slot = a + (2 : Fin (3 : ℕ))) → (p 3 = C.1.1)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hqD hSD + rw [← hqD, ← hSD] + exact F.parent + +private theorem hAoccAt816 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + (F.q (a + 1).succ = p 2) → ((F.q (a + 2).succ = p 3) → ((r 1 = p 3) → ((r 3 = p 2) → + (TileCentroid (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • + (GaussianRealPoint x - (-(GaussianRealPoint x).2, (GaussianRealPoint x).1)))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p r x hqB hqD hr1 hr3 + have h := (D.occurrences a true).2.2 + simpa [hqD, hqB, x, hr1, hr3] using h + +private theorem hpRot : + (by + classical + exact + ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple p) → ( + let pRot : Fin 4 → CircleCoordinates := ![p 0, p 3, p 1, p 2] + ProperBandQuadruple pRot) ) := by + classical + intro p hp pRot + refine ⟨SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate hp.1), ?_⟩ + intro j + fin_cases j + · simpa [pRot] using hp.2 2 + · simpa [pRot] using hp.2 0 + · simpa [pRot] using hp.2 1 + +private theorem hRotV : + (by + classical + exact + ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let pRot : Fin 4 → CircleCoordinates := ![p 0, p 3, p 1, p 2] + (ProperBandQuadruple pRot) → (BandVectors.1 (p 0) (p 3) = I * BandVectors.1 (p 3) (p 0)) + ) := by + classical + intro p I pRot hpRot + have h := (VectorRecursionLaws pRot hpRot.1).2.2.2.2 hpRot 0 |>.1 + simpa [pRot, I] using h + +private theorem hRotA : + (by + classical + exact + ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + let pRot : Fin 4 → CircleCoordinates := ![p 0, p 3, p 1, p 2] + (ProperBandQuadruple pRot) → (BandVectors.2 (p 0) (p 3) = -I * BandVectors.2 (p 3) (p 0)) + ) := by + classical + intro p I pRot hpRot + have h := (VectorRecursionLaws pRot hpRot.1).2.2.2.2 hpRot 0 |>.2 + simpa [pRot, I] using h + +private theorem hRotVRe : + (by + classical + exact + ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.1 (p 0) (p 3) = I * BandVectors.1 (p 3) (p 0)) → ((BandVectors.1 (p 0) (p + 3)).re = -(BandVectors.1 (p 3) (p 0)).im) ) := by + classical + intro p I hRotV + have h := congrArg (fun z : GaussianInt => z.re) hRotV + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + omega + +private theorem hRotVIm : + (by + classical + exact + ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.1 (p 0) (p 3) = I * BandVectors.1 (p 3) (p 0)) → ((BandVectors.1 (p 0) (p + 3)).im = (BandVectors.1 (p 3) (p 0)).re) ) := by + classical + intro p I hRotV + have h := congrArg (fun z : GaussianInt => z.im) hRotV + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + omega + +private theorem hrecVRe : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (BandVectors.1 (r 1) (r 0) = x - I * y) → ((BandVectors.1 (r 1) (r 0)).re = x.re + y.im) + ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I x y hvrec + have h := congrArg (fun z : GaussianInt => z.re) hvrec + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + omega + +private theorem hrecVIm : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (BandVectors.1 (r 1) (r 0) = x - I * y) → ((BandVectors.1 (r 1) (r 0)).im = x.im - y.re) + ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I x y hvrec + have h := congrArg (fun z : GaussianInt => z.im) hvrec + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + omega + +private theorem hflipVRe : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.1 (r 0) (r 1) = I * BandVectors.1 (r 1) (r 0)) → ((BandVectors.1 (r 0) (r + 1)).re = -(BandVectors.1 (r 1) (r 0)).im) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I hvflip + have h := congrArg (fun z : GaussianInt => z.re) hvflip + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + omega + +private theorem hflipVIm : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.1 (r 0) (r 1) = I * BandVectors.1 (r 1) (r 0)) → ((BandVectors.1 (r 0) (r + 1)).im = (BandVectors.1 (r 1) (r 0)).re) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I hvflip + have h := congrArg (fun z : GaussianInt => z.im) hvflip + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + omega + +private theorem hrecVC : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (BandVectors.1 (r 1) (r 0) = x - I * y) → (GaussianInt.toComplex (BandVectors.1 (r 1) (r + 0)) = GaussianInt.toComplex x - GaussianInt.toComplex I * GaussianInt.toComplex y) ) + := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I x y hvrec + have h := congrArg GaussianInt.toComplex hvrec + simpa only [GaussianInt.toComplex_sub, GaussianInt.toComplex_mul] using h + +private theorem hflipVC : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.1 (r 0) (r 1) = I * BandVectors.1 (r 1) (r 0)) → (GaussianInt.toComplex + (BandVectors.1 (r 0) (r 1)) = GaussianInt.toComplex I * GaussianInt.toComplex + (BandVectors.1 (r 1) (r 0))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I hvflip + have h := congrArg GaussianInt.toComplex hvflip + simpa only [GaussianInt.toComplex_mul] using h + +private theorem hRotVC : + (by + classical + exact + ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.1 (p 0) (p 3) = I * BandVectors.1 (p 3) (p 0)) → (GaussianInt.toComplex + (BandVectors.1 (p 0) (p 3)) = GaussianInt.toComplex I * GaussianInt.toComplex + (BandVectors.1 (p 3) (p 0))) ) := by + classical + intro p I hRotV + have h := congrArg GaussianInt.toComplex hRotV + simpa only [GaussianInt.toComplex_mul] using h + +private theorem hleftAminus : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → ((TileCentroid (D.tiles a + true) - TileCentroid F.tile = (1 / 2 : ℝ) • (GaussianRealPoint x - + (-(GaussianRealPoint x).2, (GaussianRealPoint x).1))) → ((((BandVectors.1 (p 0) (p + 3)).re : ℝ) = -((BandVectors.1 (p 3) (p 0)).im : ℝ)) → ((((BandVectors.1 (p 0) (p + 3)).im : ℝ) = ((BandVectors.1 (p 3) (p 0)).re : ℝ)) → ((((BandVectors.1 (r 1) (r + 0)).re : ℝ) = (x.re : ℝ) + (y.im : ℝ)) → ((((BandVectors.1 (r 1) (r 0)).im : ℝ) = + (x.im : ℝ) - (y.re : ℝ)) → ((((BandVectors.1 (r 0) (r 1)).re : ℝ) = -((BandVectors.1 + (r 1) (r 0)).im : ℝ)) → ((((BandVectors.1 (r 0) (r 1)).im : ℝ) = ((BandVectors.1 (r + 1) (r 0)).re : ℝ)) → ((y = BandVectors.1 (p 0) (p 3)) → (TileCentroid Rminus - + TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (p 3) + (p 0) - BandVectors.1 (p 0) (p 3))))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p r x y hMcenter hAocc hRotVReR + hRotVImR hrecVReR hrecVImR hflipVReR hflipVImR hyRot + rw [show TileCentroid Rminus - TileCentroid (D.tiles a true) = + (TileCentroid Rminus - TileCentroid F.tile) - + (TileCentroid (D.tiles a true) - TileCentroid F.tile) by + ext <;> dsimp <;> ring] + rw [hMcenter, hAocc] + apply Prod.ext + · simp only [GaussianRealPoint, Prod.smul_mk, Zsqrtd.re_sub, + Zsqrtd.im_sub, + Int.cast_sub] + rw [hRotVReR, hflipVReR, hflipVImR, + hrecVReR, hrecVImR] + rw [hyRot] + rw [hRotVReR, hRotVImR] + simp only [Prod.fst_sub] + rw [Prod.smul_fst] + simp only [Prod.fst_sub] + ring + · simp only [GaussianRealPoint, Prod.smul_mk, Zsqrtd.re_sub, + Zsqrtd.im_sub, + Int.cast_sub] + rw [hRotVImR, hflipVReR, hflipVImR, + hrecVReR, hrecVImR] + rw [hyRot] + rw [hRotVReR, hRotVImR] + simp only [Prod.snd_sub] + rw [Prod.smul_snd] + simp only [Prod.snd_sub] + ring + +private theorem hleftAplus : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = GaussianRealPoint y) → (∀ (u + : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (TileCentroid (D.tiles F.slot false) = TileCentroid join) → ((r 1 = p 3) → ((r 2 = p 0) → + ((TileCentroid Rminus - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • + GaussianRealPoint (BandVectors.1 (p 3) (p 0) - BandVectors.1 (p 0) (p 3))) → + (TileCentroid join - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (p 3) (p 0) + BandVectors.1 (p 0) (p 3))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p r y hcenter u join hjoinCenterEq hr1 + hr2 hleftAminus + rw [show TileCentroid join - TileCentroid (D.tiles a true) = + (TileCentroid join - TileCentroid Rminus) + + (TileCentroid Rminus - TileCentroid (D.tiles a true)) by + ext <;> dsimp <;> ring] + rw [show TileCentroid join - TileCentroid Rminus = GaussianRealPoint y by + rw [← hjoinCenterEq] + exact hcenter, hleftAminus] + apply Prod.ext <;> simp [GaussianRealPoint, y, hr1, hr2] <;> ring + +private theorem hARe'At945 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + (F.q (a + 1).succ = p 2) → ((F.q (a + 2).succ = p 3) → ((r 1 = p 3) → ((r 3 = p 2) → (∀ + (rootA : ℝ × ℝ), ∀ (slopeA : ℝ × ℝ), (slopeA.1 - rootA.1 = (if true = true then (1 : + ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : + ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → (slopeA.1 - + rootA.1 = (1 / 2 : ℝ) * ((xa.re : ℝ) - (xa.im : ℝ))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r xa hqB hqD hr1 hr3 rootA slopeA hARe + simpa [hqD, hqB, hr1, hr3, xa] using hARe + +private theorem hAIm'At948 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + (F.q (a + 1).succ = p 2) → ((F.q (a + 2).succ = p 3) → ((r 1 = p 3) → ((r 3 = p 2) → (∀ + (rootA : ℝ × ℝ), ∀ (slopeA : ℝ × ℝ), (slopeA.2 - rootA.2 = (if true = true then (1 : + ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : + ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (slopeA.2 - + rootA.2 = (1 / 2 : ℝ) * ((xa.im : ℝ) + (xa.re : ℝ))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r xa hqB hqD hr1 hr3 rootA slopeA hAIm + simpa [hqD, hqB, hr1, hr3, xa] using hAIm + +private theorem ha10ReAt951 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), (Fin (3 : + ℕ)) → ((Fin (4 : ℕ) → CircleCoordinates) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.2 (r 1) (r 0)).re = xa.re - + ya.im))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I xa ya harec + have h := congrArg (fun z : GaussianInt => z.re) harec + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + omega + +private theorem ha10ImAt955 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.2 (r 1) (r 0)).im = xa.im + + ya.re) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r I xa ya harec + have h := congrArg (fun z : GaussianInt => z.im) harec + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + omega + +private theorem ha01ReAt959 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), (Fin (3 : + ℕ)) → ((Fin (4 : ℕ) → CircleCoordinates) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → (((BandVectors.2 (r 1) (r + 0)).im = xa.im + ya.re) → ((BandVectors.2 (r 0) (r 1)).re = xa.im + ya.re)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I xa ya haflip ha10Im + have h := congrArg (fun z : GaussianInt => z.re) haflip + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + omega + +private theorem ha01ImAt963 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), (Fin (3 : + ℕ)) → ((Fin (4 : ℕ) → CircleCoordinates) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → (((BandVectors.2 (r 1) (r + 0)).re = xa.re - ya.im) → ((BandVectors.2 (r 0) (r 1)).im = -xa.re + ya.im)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I xa ya haflip ha10Re + have h := congrArg (fun z : GaussianInt => z.im) haflip + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + omega + +private theorem hRotARe : + (by + classical + exact + ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.2 (p 0) (p 3) = -I * BandVectors.2 (p 3) (p 0)) → ((BandVectors.2 (p 0) (p + 3)).re = (BandVectors.2 (p 3) (p 0)).im) ) := by + classical + intro p I hRotA + have h := congrArg (fun z : GaussianInt => z.re) hRotA + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + omega + +private theorem hRotAIm : + (by + classical + exact + ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.2 (p 0) (p 3) = -I * BandVectors.2 (p 3) (p 0)) → ((BandVectors.2 (p 0) (p + 3)).im = -(BandVectors.2 (p 3) (p 0)).re) ) := by + classical + intro p I hRotA + have h := congrArg (fun z : GaussianInt => z.im) hRotA + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + omega + +private theorem hFminusSlopeAt991 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ∀ (rootA : ℝ × ℝ), (rootA = F.outer_slope) → (F.minus_slope - rootA = (1 / 2 : ℝ) • + GaussianRealPoint (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r rootA hrootAEq + rw [hrootAEq] + exact F.minus_difference + +private theorem hFminusReAt996 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ∀ (rootA : ℝ × ℝ), (F.minus_slope - rootA = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) → (F.minus_slope.1 - rootA.1 + = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).re : ℝ) - ((BandVectors.2 (r 0) (r + 1)).re : ℝ))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r rootA hFminusSlope + have h := congrArg Prod.fst hFminusSlope + simpa [GaussianRealPoint, Prod.smul_mk] using h + +private theorem hFminusImAt1002 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ∀ (rootA : ℝ × ℝ), (F.minus_slope - rootA = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) → (F.minus_slope.2 - rootA.2 + = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).im : ℝ) - ((BandVectors.2 (r 0) (r + 1)).im : ℝ))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r rootA hFminusSlope + have h := congrArg Prod.snd hFminusSlope + simpa [GaussianRealPoint, Prod.smul_mk] using h + +private theorem hleftAslopeMinus : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ∀ (rootA : ℝ × ℝ), ∀ (slopeA : ℝ × ℝ), (slopeA.1 - rootA.1 = (1 / 2 : ℝ) * ((xa.re : ℝ) - + (xa.im : ℝ))) → ((slopeA.2 - rootA.2 = (1 / 2 : ℝ) * ((xa.im : ℝ) + (xa.re : ℝ))) → + ((ya = BandVectors.2 (p 0) (p 3)) → ((((BandVectors.2 (r 1) (r 0)).re : ℝ) = (xa.re : + ℝ) - (ya.im : ℝ)) → ((((BandVectors.2 (r 1) (r 0)).im : ℝ) = (xa.im : ℝ) + (ya.re : + ℝ)) → ((((BandVectors.2 (r 0) (r 1)).re : ℝ) = (xa.im : ℝ) + (ya.re : ℝ)) → + ((((BandVectors.2 (r 0) (r 1)).im : ℝ) = -(xa.re : ℝ) + (ya.im : ℝ)) → + ((((BandVectors.2 (p 0) (p 3)).re : ℝ) = ((BandVectors.2 (p 3) (p 0)).im : ℝ)) → + ((((BandVectors.2 (p 0) (p 3)).im : ℝ) = -((BandVectors.2 (p 3) (p 0)).re : ℝ)) → + ((F.minus_slope.1 - rootA.1 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).re : ℝ) - + ((BandVectors.2 (r 0) (r 1)).re : ℝ))) → ((F.minus_slope.2 - rootA.2 = (1 / 2 : ℝ) * + (((BandVectors.2 (r 1) (r 0)).im : ℝ) - ((BandVectors.2 (r 0) (r 1)).im : ℝ))) → + (F.minus_slope - slopeA = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p 3) (p 0) + - BandVectors.2 (p 0) (p 3))))))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p r xa ya rootA slopeA hARe' hAIm' hyaA + ha10ReR ha10ImR ha01ReR ha01ImR hRotAReR hRotAImR hFminusRe hFminusIm + apply Prod.ext + · calc + F.minus_slope.1 - slopeA.1 = + (F.minus_slope.1 - rootA.1) - + (slopeA.1 - rootA.1) := by ring + _ = (1 / 2 : ℝ) * + (((BandVectors.2 (p 3) (p 0)).re : ℝ) - + ((BandVectors.2 (p 0) (p 3)).re : ℝ)) := by + rw [hFminusRe, hARe', ha10ReR, ha01ReR, hyaA] + rw [hRotAReR, hRotAImR] + ring + _ = ((1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (p 3) (p 0) - BandVectors.2 (p 0) (p 3))).1 := by + simp [GaussianRealPoint, Prod.smul_mk, + Zsqrtd.re_sub, Int.cast_sub] + · calc + F.minus_slope.2 - slopeA.2 = + (F.minus_slope.2 - rootA.2) - + (slopeA.2 - rootA.2) := by ring + _ = (1 / 2 : ℝ) * + (((BandVectors.2 (p 3) (p 0)).im : ℝ) - + ((BandVectors.2 (p 0) (p 3)).im : ℝ)) := by + rw [hFminusIm, hAIm', ha10ImR, ha01ImR, hyaA] + rw [hRotAReR, hRotAImR] + ring + _ = ((1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (p 3) (p 0) - BandVectors.2 (p 0) (p 3))).2 := by + simp [GaussianRealPoint, Prod.smul_mk, + Zsqrtd.im_sub, Int.cast_sub] + +private theorem hjoinSlopeReA : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + ∀ (rootNeg : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (joinSlope.1 - rootNeg.1 = -(1 / 2 : ℝ) * + ((↑wa.re : ℝ) - (↑wa.im : ℝ))) → (∀ (rootA : ℝ × ℝ), (rootNeg = rootA) → (joinSlope.1 + - rootA.1 = -(1 / 2 : ℝ) * ((wa.re : ℝ) - (wa.im : ℝ)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa rootNeg joinSlope hjoinSlopeRe rootA + hrootNegA + rw [← hrootNegA] + exact hjoinSlopeRe + +private theorem hjoinSlopeImA : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + ∀ (rootNeg : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (joinSlope.2 - rootNeg.2 = -(1 / 2 : ℝ) * + ((↑wa.im : ℝ) + (↑wa.re : ℝ))) → (∀ (rootA : ℝ × ℝ), (rootNeg = rootA) → (joinSlope.2 + - rootA.2 = -(1 / 2 : ℝ) * ((wa.im : ℝ) + (wa.re : ℝ)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa rootNeg joinSlope hjoinSlopeIm rootA + hrootNegA + rw [← hrootNegA] + exact hjoinSlopeIm + +private theorem hasumReAt1051 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (wa + xa + ya = 0) → (wa.re + xa.re + ya.re = 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum + have h := congrArg (fun z : GaussianInt => z.re) hasum + simpa [wa, xa, ya] using h + +private theorem hasumImAt1054 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (wa + xa + ya = 0) → (wa.im + xa.im + ya.im = 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum + have h := congrArg (fun z : GaussianInt => z.im) hasum + simpa [wa, xa, ya] using h + +private theorem hleftAplusSlope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin + (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ∀ (joinSlope : ℝ × ℝ), ∀ (rootA : ℝ × ℝ), ∀ (slopeA : ℝ × ℝ), (slopeA.1 - rootA.1 = (1 / + 2 : ℝ) * ((xa.re : ℝ) - (xa.im : ℝ))) → ((slopeA.2 - rootA.2 = (1 / 2 : ℝ) * ((xa.im + : ℝ) + (xa.re : ℝ))) → ((ya = BandVectors.2 (p 0) (p 3)) → ((((BandVectors.2 (p 0) (p + 3)).re : ℝ) = ((BandVectors.2 (p 3) (p 0)).im : ℝ)) → ((((BandVectors.2 (p 0) (p + 3)).im : ℝ) = -((BandVectors.2 (p 3) (p 0)).re : ℝ)) → ((joinSlope.1 - rootA.1 = -(1 + / 2 : ℝ) * ((wa.re : ℝ) - (wa.im : ℝ))) → ((joinSlope.2 - rootA.2 = -(1 / 2 : ℝ) * + ((wa.im : ℝ) + (wa.re : ℝ))) → (((wa.re : ℝ) + (xa.re : ℝ) + (ya.re : ℝ) = 0) → + (((wa.im : ℝ) + (xa.im : ℝ) + (ya.im : ℝ) = 0) → (joinSlope - slopeA = (1 / 2 : ℝ) • + GaussianRealPoint (BandVectors.2 (p 3) (p 0) + BandVectors.2 (p 0) (p 3))))))))))) ) + := by + classical + intro C orientation base Rminus Rplus hminus hplus F p r wa xa ya joinSlope rootA slopeA hARe' + hAIm' hyaA hRotAReR hRotAImR hjoinSlopeReA hjoinSlopeImA hasumReR hasumImR + apply Prod.ext + · calc + joinSlope.1 - slopeA.1 = + (joinSlope.1 - rootA.1) - (slopeA.1 - rootA.1) := by ring + _ = (1 / 2 : ℝ) * ((ya.re : ℝ) - (ya.im : ℝ)) := by + rw [hjoinSlopeReA, hARe'] + linarith [hasumReR, hasumImR] + _ = (1 / 2 : ℝ) * + (((BandVectors.2 (p 3) (p 0)).re : ℝ) + + ((BandVectors.2 (p 0) (p 3)).re : ℝ)) := by + rw [hyaA, hRotAReR, hRotAImR] + ring + _ = ((1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (p 3) (p 0) + + BandVectors.2 (p 0) (p 3))).1 := by + simp [GaussianRealPoint, Prod.smul_mk, Zsqrtd.re_add, + Int.cast_add] + · calc + joinSlope.2 - slopeA.2 = + (joinSlope.2 - rootA.2) - (slopeA.2 - rootA.2) := by ring + _ = (1 / 2 : ℝ) * ((ya.im : ℝ) + (ya.re : ℝ)) := by + rw [hjoinSlopeImA, hAIm'] + linarith [hasumReR, hasumImR] + _ = (1 / 2 : ℝ) * + (((BandVectors.2 (p 3) (p 0)).im : ℝ) + + ((BandVectors.2 (p 0) (p 3)).im : ℝ)) := by + rw [hyaA, hRotAReR, hRotAImR] + ring + _ = ((1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (p 3) (p 0) + + BandVectors.2 (p 0) (p 3))).2 := by + simp [GaussianRealPoint, Prod.smul_mk, Zsqrtd.im_add, + Int.cast_add] + +private theorem houterBOdo : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), (F.q (a + 1).succ = p 2) → (TileOdometer (p 2) (D.tiles (a + 1) + true) (D.functions (a + 1) true)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hqB + simpa only [hqB] using D.odometers (a + 1) true + +private theorem houterBAnc : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), (F.q (a + 1).succ = p 2) → ((0 < (p 2).1) → (AncestorOdometer (p + 2) F.outer.1.1 (D.tiles (a + 1) true) F.tile (D.functions (a + 1) true) F.odometer)) + ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hqB hBpos + simpa only [hqB] using D.ancestors (a + 1) true + (by rw [hqB]; exact hBpos) + +private theorem hidxB2 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), + (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → (∀ (a : Fin + (3 : ℕ)), (Fin (4 : ℕ) → CircleCoordinates) → ((a + 1) + 2 = a)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p + apply Fin.ext + simp [Fin.val_add]; omega + +private theorem hidxB1 : + (by + classical + exact + ∀ (a : Fin (3 : ℕ)), (a + 1) + 1 = a + 2 ) := by + classical + intro a + apply Fin.ext + simp [Fin.val_add] + +private theorem hBocc : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (F.q a.succ = p 0) → ((F.q (a + 2).succ = p 3) → ((r 1 = p 3) → ((r 2 = p 0) → (((a + 1) + + 2 = a) → (((a + 1) + 1 = a + 2) → (TileCentroid (D.tiles (a + 1) true) - + TileCentroid F.tile = (1 / 2 : ℝ) • (GaussianRealPoint y - (-(GaussianRealPoint y).2, + (GaussianRealPoint y).1)))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p r y hqA hqD hr1 hr2 hidxB2 hidxB1 + have h := (D.occurrences (a + 1) true).2.2 + simpa [hqA, hqD, hidxB2, hidxB1, y, hr1, hr2] using h + +private theorem hjoinFcenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → ((TileCentroid (D.tiles + F.slot false) - TileCentroid Rminus = GaussianRealPoint y) → (∀ (u : ↥(TilingLattice + C)), + let join : ProtoTile := TileTranslation base (u + y) + (TileCentroid (D.tiles F.slot false) = TileCentroid join) → (TileCentroid join - + TileCentroid F.tile = GaussianRealPoint y + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r y hMcenter hcenter u join hjoinCenterEq + rw [← hjoinCenterEq] + rw [show TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = + (TileCentroid (D.tiles F.slot false) - TileCentroid Rminus) + + (TileCentroid Rminus - TileCentroid F.tile) by + ext <;> dsimp <;> ring] + rw [hcenter, hMcenter] + +private theorem hTflip : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (t : Fin + (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple t) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + (BandVectors.1 (t 1) (t 0) = x) → (BandVectors.1 (t 0) (t 1) = I * x)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F t ht r I x hTvec + have h := (VectorRecursionLaws t ht.1).2.2.2.2 ht 0 |>.1 + simpa [I, hTvec] using h + +private theorem hrightBminus : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (t : Fin (4 : ℕ) → + CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (BandVectors.1 (r 1) (r 0) = x - I * y) → ((BandVectors.1 (r 0) (r 1) = I * BandVectors.1 + (r 1) (r 0)) → (∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (TileCentroid (D.tiles (a + 1) true) - TileCentroid F.tile = (1 / 2 : ℝ) • + (GaussianRealPoint y - (-(GaussianRealPoint y).2, (GaussianRealPoint y).1))) → + ((TileCentroid join - TileCentroid F.tile = GaussianRealPoint y + (1 / 2 : ℝ) • + GaussianRealPoint (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → + ((BandVectors.1 (t 1) (t 0) = x) → ((BandVectors.1 (t 0) (t 1) = I * x) → + (TileCentroid join - TileCentroid (D.tiles (a + 1) true) = (1 / 2 : ℝ) • + GaussianRealPoint (BandVectors.1 (t 1) (t 0) - BandVectors.1 (t 0) (t 1)))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a t r I x y hvrec hvflip u join hBocc + hjoinFcenter hTvec hTflip + rw [show TileCentroid join - TileCentroid (D.tiles (a + 1) true) = + (TileCentroid join - TileCentroid F.tile) - + (TileCentroid (D.tiles (a + 1) true) - TileCentroid F.tile) by + ext <;> dsimp <;> ring] + rw [hjoinFcenter, hBocc, hTvec, hTflip] + apply Prod.ext <;> + simp [GaussianRealPoint, x, y, I, Prod.smul_mk, + Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_mul, Zsqrtd.im_mul, hvrec, hvflip] <;> ring + +private theorem hplusFcenter : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 + (r 1) (r 0) + BandVectors.1 (r 0) (r 1)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r + simpa [r] using F.plus_centroid + +private theorem hrightBplus : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (t : Fin (4 : ℕ) → + CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (BandVectors.1 (r 1) (r 0) = x - I * y) → ((BandVectors.1 (r 0) (r 1) = I * BandVectors.1 + (r 1) (r 0)) → ((TileCentroid (D.tiles (a + 1) true) - TileCentroid F.tile = (1 / 2 : + ℝ) • (GaussianRealPoint y - (-(GaussianRealPoint y).2, (GaussianRealPoint y).1))) → + ((BandVectors.1 (t 1) (t 0) = x) → ((BandVectors.1 (t 0) (t 1) = I * x) → + ((TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1))) → (TileCentroid Rplus - + TileCentroid (D.tiles (a + 1) true) = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 + (t 1) (t 0) + BandVectors.1 (t 0) (t 1)))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a t r I x y hvrec hvflip hBocc hTvec + hTflip hplusFcenter + rw [show TileCentroid Rplus - TileCentroid (D.tiles (a + 1) true) = + (TileCentroid Rplus - TileCentroid F.tile) - + (TileCentroid (D.tiles (a + 1) true) - TileCentroid F.tile) by + ext <;> dsimp <;> ring] + rw [hplusFcenter, hBocc, hTvec, hTflip] + apply Prod.ext <;> + simp [GaussianRealPoint, x, y, I, Prod.smul_mk, + Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_mul, Zsqrtd.im_mul, hvrec, hvflip] <;> ring + +private theorem hBRe' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (F.q a.succ = p 0) → ((F.q (a + 2).succ = p 3) → (∀ (rootB : ℝ × ℝ), ∀ (slopeB : ℝ × ℝ), + (slopeB.1 - rootB.1 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (F.q (a + (1 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 + : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (1 : + Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ)) + (1 : Fin (3 : + ℕ))).succ)).im : ℝ))) → ((∀ (z : GaussianInt), (GaussianInt.toComplex z).re = (z.re : + ℝ)) → ((∀ (z : GaussianInt), (GaussianInt.toComplex z).im = (z.im : ℝ)) → (((a + 1) + + 2 = a) → (((a + 1) + 1 = a + 2) → (((ya.re : ℝ) = ((BandVectors.2 (p 0) (p 3)).re : + ℝ)) → (((ya.im : ℝ) = ((BandVectors.2 (p 0) (p 3)).im : ℝ)) → (slopeB.1 - rootB.1 = + (1 / 2 : ℝ) * ((ya.re : ℝ) - (ya.im : ℝ))))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r ya hqA hqD rootB slopeB hBRe + toRealRe toRealIm hidxB2 hidxB1 hyaReR hyaImR + simp only [hidxB2, hidxB1, hqA, hqD] at hBRe + norm_num at hBRe + rw [toRealRe] at hBRe + rw [toRealIm] at hBRe + rw [← hyaReR, ← hyaImR] at hBRe + exact hBRe + +private theorem hBIm' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin + (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (F.q a.succ = p 0) → ((F.q (a + 2).succ = p 3) → (∀ (rootB : ℝ × ℝ), ∀ (slopeB : ℝ × ℝ), + (slopeB.2 - rootB.2 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (F.q (a + (1 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 + : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + (1 : + Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ)) + (1 : Fin (3 : + ℕ))).succ)).re : ℝ))) → ((∀ (z : GaussianInt), (GaussianInt.toComplex z).re = (z.re : + ℝ)) → ((∀ (z : GaussianInt), (GaussianInt.toComplex z).im = (z.im : ℝ)) → (((a + 1) + + 2 = a) → (((a + 1) + 1 = a + 2) → (((ya.re : ℝ) = ((BandVectors.2 (p 0) (p 3)).re : + ℝ)) → (((ya.im : ℝ) = ((BandVectors.2 (p 0) (p 3)).im : ℝ)) → (slopeB.2 - rootB.2 = + (1 / 2 : ℝ) * ((ya.im : ℝ) + (ya.re : ℝ))))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r ya hqA hqD rootB slopeB hBIm + toRealRe toRealIm hidxB2 hidxB1 hyaReR hyaImR + simp only [hidxB2, hidxB1, hqA, hqD] at hBIm + norm_num at hBIm + rw [toRealIm] at hBIm + rw [toRealRe] at hBIm + rw [← hyaImR, ← hyaReR] at hBIm + exact hBIm + +private theorem hjoinSlopeReB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + ∀ (rootNeg : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (joinSlope.1 - rootNeg.1 = -(1 / 2 : ℝ) * + ((↑wa.re : ℝ) - (↑wa.im : ℝ))) → (∀ (rootB : ℝ × ℝ), (rootNeg = rootB) → (joinSlope.1 + - rootB.1 = -(1 / 2 : ℝ) * ((wa.re : ℝ) - (wa.im : ℝ)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa rootNeg joinSlope hjoinSlopeRe rootB + hrootNegB + rw [← hrootNegB] + exact hjoinSlopeRe + +private theorem hjoinSlopeImB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + ∀ (rootNeg : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (joinSlope.2 - rootNeg.2 = -(1 / 2 : ℝ) * + ((↑wa.im : ℝ) + (↑wa.re : ℝ))) → (∀ (rootB : ℝ × ℝ), (rootNeg = rootB) → (joinSlope.2 + - rootB.2 = -(1 / 2 : ℝ) * ((wa.im : ℝ) + (wa.re : ℝ)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa rootNeg joinSlope hjoinSlopeIm rootB + hrootNegB + rw [← hrootNegB] + exact hjoinSlopeIm + +private theorem hFplusSlopeB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ∀ (rootB : ℝ × ℝ), (rootB = F.outer_slope) → (F.plus_slope - rootB = (1 / 2 : ℝ) • + GaussianRealPoint (BandVectors.2 (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r rootB hrootBEq + rw [hrootBEq] + exact F.plus_difference + +private theorem hFplusReB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ∀ (rootB : ℝ × ℝ), (F.plus_slope - rootB = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 + (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) → (F.plus_slope.1 - rootB.1 = (1 / 2 : ℝ) * + (((BandVectors.2 (r 1) (r 0)).re : ℝ) + ((BandVectors.2 (r 0) (r 1)).re : ℝ))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r rootB hFplusSlopeB + have h := congrArg Prod.fst hFplusSlopeB + simpa [GaussianRealPoint, Prod.smul_mk] using h + +private theorem hFplusImB : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ∀ (rootB : ℝ × ℝ), (F.plus_slope - rootB = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 + (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) → (F.plus_slope.2 - rootB.2 = (1 / 2 : ℝ) * + (((BandVectors.2 (r 1) (r 0)).im : ℝ) + ((BandVectors.2 (r 0) (r 1)).im : ℝ))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r rootB hFplusSlopeB + have h := congrArg Prod.snd hFplusSlopeB + simpa [GaussianRealPoint, Prod.smul_mk] using h + +private theorem hTflipA : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (t : Fin + (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple t) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + (BandVectors.2 (t 1) (t 0) = xa) → (BandVectors.2 (t 0) (t 1) = -I * xa)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F t ht r I xa hTvecA + have h := (VectorRecursionLaws t ht.1).2.2.2.2 ht 0 |>.2 + simpa [I, hTvecA] using h + +private theorem hrightBminusSlope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (t : Fin + (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ∀ (joinSlope : ℝ × ℝ), ∀ (rootB : ℝ × ℝ), ∀ (slopeB : ℝ × ℝ), ((wa.re : ℝ) + (xa.re : ℝ) + + (ya.re : ℝ) = 0) → (((wa.im : ℝ) + (xa.im : ℝ) + (ya.im : ℝ) = 0) → ((slopeB.1 - + rootB.1 = (1 / 2 : ℝ) * ((ya.re : ℝ) - (ya.im : ℝ))) → ((slopeB.2 - rootB.2 = (1 / 2 + : ℝ) * ((ya.im : ℝ) + (ya.re : ℝ))) → ((joinSlope.1 - rootB.1 = -(1 / 2 : ℝ) * + ((wa.re : ℝ) - (wa.im : ℝ))) → ((joinSlope.2 - rootB.2 = -(1 / 2 : ℝ) * ((wa.im : ℝ) + + (wa.re : ℝ))) → ((BandVectors.2 (t 1) (t 0) = xa) → ((BandVectors.2 (t 0) (t 1) = + -I * xa) → (joinSlope - slopeB = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (t 1) + (t 0) - BandVectors.2 (t 0) (t 1)))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F t r I wa xa ya joinSlope rootB slopeB + hasumReR hasumImR hBRe' hBIm' hjoinSlopeReB hjoinSlopeImB hTvecA hTflipA + apply Prod.ext + · calc + joinSlope.1 - slopeB.1 = + (joinSlope.1 - rootB.1) - (slopeB.1 - rootB.1) := by ring + _ = (1 / 2 : ℝ) * ((xa.re : ℝ) - (xa.im : ℝ)) := by + rw [hjoinSlopeReB, hBRe'] + linarith [hasumReR, hasumImR] + _ = (1 / 2 : ℝ) * + (((BandVectors.2 (t 1) (t 0)).re : ℝ) - + ((BandVectors.2 (t 0) (t 1)).re : ℝ)) := by + rw [hTvecA, hTflipA] + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] + _ = ((1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (t 1) (t 0) - + BandVectors.2 (t 0) (t 1))).1 := by + simp [GaussianRealPoint, Prod.smul_mk, Zsqrtd.re_sub, + Int.cast_sub] + · calc + joinSlope.2 - slopeB.2 = + (joinSlope.2 - rootB.2) - (slopeB.2 - rootB.2) := by ring + _ = (1 / 2 : ℝ) * ((xa.im : ℝ) + (xa.re : ℝ)) := by + rw [hjoinSlopeImB, hBIm'] + linarith [hasumReR, hasumImR] + _ = (1 / 2 : ℝ) * + (((BandVectors.2 (t 1) (t 0)).im : ℝ) - + ((BandVectors.2 (t 0) (t 1)).im : ℝ)) := by + rw [hTvecA, hTflipA] + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] + _ = ((1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (t 1) (t 0) - + BandVectors.2 (t 0) (t 1))).2 := by + simp [GaussianRealPoint, Zsqrtd.im_sub, + Int.cast_sub] + +private theorem hrightBplusSlope : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (t : Fin + (4 : ℕ) → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + ∀ (rootB : ℝ × ℝ), ∀ (slopeB : ℝ × ℝ), (((BandVectors.2 (r 1) (r 0)).re : ℝ) = (xa.re : + ℝ) - (ya.im : ℝ)) → ((((BandVectors.2 (r 1) (r 0)).im : ℝ) = (xa.im : ℝ) + (ya.re : + ℝ)) → ((((BandVectors.2 (r 0) (r 1)).re : ℝ) = (xa.im : ℝ) + (ya.re : ℝ)) → + ((((BandVectors.2 (r 0) (r 1)).im : ℝ) = -(xa.re : ℝ) + (ya.im : ℝ)) → ((slopeB.1 - + rootB.1 = (1 / 2 : ℝ) * ((ya.re : ℝ) - (ya.im : ℝ))) → ((slopeB.2 - rootB.2 = (1 / 2 + : ℝ) * ((ya.im : ℝ) + (ya.re : ℝ))) → ((F.plus_slope.1 - rootB.1 = (1 / 2 : ℝ) * + (((BandVectors.2 (r 1) (r 0)).re : ℝ) + ((BandVectors.2 (r 0) (r 1)).re : ℝ))) → + ((F.plus_slope.2 - rootB.2 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).im : ℝ) + + ((BandVectors.2 (r 0) (r 1)).im : ℝ))) → ((BandVectors.2 (t 1) (t 0) = xa) → + ((BandVectors.2 (t 0) (t 1) = -I * xa) → (F.plus_slope - slopeB = (1 / 2 : ℝ) • + GaussianRealPoint (BandVectors.2 (t 1) (t 0) + BandVectors.2 (t 0) (t 1)))))))))))) ) + := by + classical + intro C orientation base Rminus Rplus hminus hplus F t r I xa ya rootB slopeB ha10ReR ha10ImR + ha01ReR ha01ImR hBRe' hBIm' hFplusReB hFplusImB hTvecA hTflipA + apply Prod.ext + · calc + F.plus_slope.1 - slopeB.1 = + (F.plus_slope.1 - rootB.1) - (slopeB.1 - rootB.1) := by ring + _ = (1 / 2 : ℝ) * ((xa.re : ℝ) + (xa.im : ℝ)) := by + rw [hFplusReB, hBRe', ha10ReR, ha01ReR] + ring + _ = (1 / 2 : ℝ) * + (((BandVectors.2 (t 1) (t 0)).re : ℝ) + + ((BandVectors.2 (t 0) (t 1)).re : ℝ)) := by + rw [hTvecA, hTflipA] + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] + _ = ((1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (t 1) (t 0) + + BandVectors.2 (t 0) (t 1))).1 := by + simp [GaussianRealPoint, Zsqrtd.re_add, + Int.cast_add] + · calc + F.plus_slope.2 - slopeB.2 = + (F.plus_slope.2 - rootB.2) - (slopeB.2 - rootB.2) := by ring + _ = (1 / 2 : ℝ) * ((xa.im : ℝ) - (xa.re : ℝ)) := by + rw [hFplusImB, hBIm', ha10ImR, ha01ImR] + ring + _ = (1 / 2 : ℝ) * + (((BandVectors.2 (t 1) (t 0)).im : ℝ) + + ((BandVectors.2 (t 0) (t 1)).im : ℝ)) := by + rw [hTvecA, hTflipA] + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] + ring + _ = ((1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (t 1) (t 0) + + BandVectors.2 (t 0) (t 1))).2 := by + simp [GaussianRealPoint, Zsqrtd.im_add, + Int.cast_add] + +private theorem hrightAnc : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), ∀ (hp : ProperBandQuadruple p), ∀ (t : Fin (4 : ℕ) → + CircleCoordinates), ∀ (ht : ProperBandQuadruple t), ∀ (ht0 : t (0 : Fin (4 : ℕ)) = p + (2 : Fin (4 : ℕ))), ∀ (olderChart : F.slot = a + (2 : Fin (3 : ℕ)) → C.1.1.1 = (1 : + ℤ) → UnitOccurrenceOrientation t (0 : Fin (3 : ℕ)) orientation), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + ∀ (hjoinFamily : join ∈ RegularTileFamily base (TilingLattice C)), ∀ (hjoinOdo : + TileOdometer C.1.1 join (D.functions F.slot false)), ∀ (joinSlope : ℝ × ℝ), ∀ + (hjoinSlope : PartialOdometerSlope (D.functions F.slot false) = some joinSlope), ∀ + (hSD : F.slot = a + (2 : Fin (3 : ℕ))), ∀ (hBpos : 0 < (p 2).1), ∀ (slopeB : ℝ × ℝ), + ∀ (hslopeB : PartialOdometerSlope (D.functions (a + (1 : Fin (3 : ℕ))) true) = some + slopeB), + let outerB : BandCircle := + ⟨⟨p 2, ⟨Or.inl hBpos, ⟨p, hp.1, 2, rfl⟩⟩⟩, hBpos⟩ + ∀ (houterBOdo : TileOdometer (p 2) (D.tiles (a + 1) true) (D.functions (a + 1) true)), ∀ + (houterBBand : BandPrototile (p 2) (D.tiles (a + 1) true)), (AncestorOdometer (p 2) + F.outer.1.1 (D.tiles (a + 1) true) F.tile (D.functions (a + 1) + true) F.odometer) → (∀ (ht1C : t 1 = C.1.1), ∀ (hrightBminus : TileCentroid join - + TileCentroid (D.tiles (a + 1) true) = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 + (t 1) (t 0) - BandVectors.1 (t 0) (t 1))), ∀ (hrightBplus : TileCentroid Rplus - + TileCentroid (D.tiles (a + 1) true) = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 + (t 1) (t 0) + BandVectors.1 (t 0) (t 1))), ∀ (hrightBminusSlope : joinSlope - slopeB + = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (t 1) (t 0) - BandVectors.2 (t 0) (t + 1))), ∀ (hrightBplusSlope : F.plus_slope - slopeB = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (t 1) (t 0) + BandVectors.2 (t 0) (t 1))), + let Gright : P4458T1BoundaryFrame C orientation base join Rplus + (D.functions F.slot false) hplus := { + outer := outerB + q := t + proper := ht + slot := 0 + child := by simpa [outerB] using ht0 + parent := ht1C + tile := D.tiles (a + 1) true + odometer := D.functions (a + 1) true + outer_odo := houterBOdo + minus_odo := hjoinOdo + plus_odo := F.plus_odo + outer_band := houterBBand + base_band := F.base_band + minus_family := hjoinFamily + plus_family := F.plus_family + chart := by + intro hunit + exact olderChart hSD (by simpa only [ht1C] using hunit) + minus_centroid := hrightBminus + plus_centroid := hrightBplus + outer_slope := slopeB + minus_slope := joinSlope + plus_slope := F.plus_slope + slope_outer := hslopeB + slope_minus := hjoinSlope + slope_plus := F.slope_plus + minus_difference := hrightBminusSlope + plus_difference := hrightBplusSlope + } + AncestorOdometer Gright.outer.1.1 F.outer.1.1 Gright.tile F.tile Gright.odometer + F.odometer)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hp t ht ht0 olderChart r y u join + hjoinFamily hjoinOdo joinSlope hjoinSlope hSD hBpos slopeB hslopeB outerB houterBOdo + houterBBand houterBAnc ht1C hrightBminus hrightBplus hrightBminusSlope hrightBplusSlope Gright + simpa only using houterBAnc + +end SecondNewerRowsGeometry + +namespace SecondParentPlacements + +private theorem firstParentPlacement : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), ∀ (hp : ProperBandQuadruple p), (![F.q (0 : Fin (4 : ℕ)), F.q + a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] = ![((2 : + ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : + Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : + ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : + Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), + p (3 : Fin (4 : ℕ))]) → ((F.slot = a + (1 : Fin (3 : ℕ)) → C.1.1.1 = (1 : ℤ) → + UnitOccurrenceOrientation p (1 : Fin (3 : ℕ)) orientation) → ((F.slot = a + (2 : Fin + (3 : ℕ)) → C.1.1.1 = (1 : ℤ) → UnitOccurrenceOrientation p (2 : Fin (3 : ℕ)) + orientation) → ((F.slot ≠ a) → (∀ (t : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple t) → ((t (0 : Fin (4 : ℕ)) = p (2 : Fin (4 : ℕ))) → ((t (1 : Fin + (4 : ℕ)) = p (3 : Fin (4 : ℕ))) → ((F.slot = a + (2 : Fin (3 : ℕ)) → C.1.1.1 = (1 : + ℤ) → UnitOccurrenceOrientation t (0 : Fin (3 : ℕ)) orientation) → ((0 < (F.q + F.slot.succ).1) → (((F.q F.slot.succ).1 < (F.q 0).1) → ((AncestorOdometer (F.q + F.slot.succ) F.outer.1.1 (D.tiles F.slot false) F.tile (D.functions F.slot false) + F.odometer) → ((TileOdometer (F.q F.slot.succ) (D.tiles F.slot false) (D.functions + F.slot false)) → ((∃ (s : ℝ × ℝ), PartialOdometerSlope (D.functions F.slot false) = + some s) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + (ProperBandQuadruple r) → ((r 1 = C.1.1) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (w + x + y = 0) → ((wa + xa + ya = 0) → ((BandVectors.1 (r 1) (r 0) = x - I * y) → + ((BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.1 (r 0) (r 1) = I * + BandVectors.1 (r 1) (r 0)) → ((BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) + (r 0)) → (((BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 + : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).re + (BandVectors.1 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ)))).re + (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).re = (0 : ℤ)) → (((BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).im + + (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ)))).im + (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).im = (0 : ℤ)) → ((BandPrototile (F.q F.slot.succ) (D.tiles F.slot false)) → + ((FootprintVertices (D.tiles F.slot false) ⊆ FootprintVertices F.tile) → + ((TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then + (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q + (F.slot + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q + (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → + ((TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))) - + (-(GaussianRealPoint (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))))).2, + (GaussianRealPoint (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))))).1))) → + ((TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → ((-BandVectors.1 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) - BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) + + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 + : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) = (2 : GaussianInt) * BandVectors.1 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ)))) → (((↑(-BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + - BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 + : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).re : ℝ) = (↑((2 : GaussianInt) * BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).re : ℝ)) → (((↑(-BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) * BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) - BandVectors.1 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ))) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).im : ℝ) = (↑((2 : GaussianInt) * BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).im : ℝ)) → ((TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = + GaussianRealPoint y) → (( + let y := BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin + (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))); y ∈ TilingLattice C) → (∀ (u : + ↥(TilingLattice C)), (Rminus = TileTranslation base (↑u : GaussianInt)) → ( + let join : ProtoTile := TileTranslation base (u + y) + (join = TileTranslation Rminus y) → ((BandPrototile C.1.1 join) → (( + let join := TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 + : ℕ)))); join ∈ RegularTileFamily base (TilingLattice C)) → ((TileCentroid + (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ))))) = TileCentroid Rminus + GaussianRealPoint (BandVectors.1 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 + : ℕ))))) → ((TileCentroid (D.tiles F.slot false) = TileCentroid join) → + ((BandPrototile C.1.1 (D.tiles F.slot false)) → (((D.tiles F.slot false).cells = + join.cells ∧ ((D.tiles F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = + join.anchor)) → ((TileOdometer C.1.1 (TileTranslation base ((↑u : GaussianInt) + + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))))) (D.functions F.slot false)) → + ((AncestorOdometer C.1.1 F.outer.1.1 (TileTranslation base ((↑u : GaussianInt) + + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))))) F.tile (D.functions F.slot false) + F.odometer) → ((∀ (c : CircleCoordinates), ∀ (T : ProtoTile), (0 : ℤ) < c.1 → + BandPrototile c T → Finset.Nonempty T.cells) → (((D.tiles F.slot + false).cells.Nonempty) → ((join.cells.Nonempty) → ((FootprintVertices + (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ))))) = FootprintVertices (D.tiles F.slot false)) → ((FootprintVertices + (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ))))) ⊆ FootprintVertices F.tile) → ((BandSubtileOccurrence F.q F.tile F.slot false + (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))))) → ((F.q (0 : Fin (4 : ℕ)) = ((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p + (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : + ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2)) → + ((F.q a.succ = p 0) → ((F.q (a + 1).succ = p 2) → ((F.q (a + 2).succ = p 3) → (∀ + (rootNeg : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (PartialOdometerSlope F.odometer = some + rootNeg) → ((PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → + ((joinSlope.1 - rootNeg.1 = -(1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 + : ℕ)))).re : ℝ) - (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).im : ℝ))) → + ((joinSlope.2 - rootNeg.2 = -(1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 + : ℕ)))).im : ℝ) + (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).re : ℝ))) → + ((rootNeg = F.outer_slope) → ((F.slot = a + (1 : Fin (3 : ℕ))) → ((r 1 = p 2) → ((r 2 + = p 3) → ((r 3 = p 0) → (∀ (hApos : 0 < (p 0).1), (F.q a.succ = p 0) → ((0 < (F.q + a.succ).1) → (∀ (rootSlope : ℝ × ℝ), ∀ (aSlope : ℝ × ℝ), (PartialOdometerSlope + F.odometer = some rootSlope) → ((PartialOdometerSlope (D.functions a true) = some + aSlope) → ((aSlope.1 - rootSlope.1 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 + / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 + : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((aSlope.2 - rootSlope.2 = (if true = true then + (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : + ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((rootSlope + = F.outer_slope) → ( + let directOuter : BandCircle := + ⟨⟨p 0, ⟨Or.inl hApos, ⟨p, hp.1, 0, rfl⟩⟩⟩, hApos⟩ + (directOuter.1.1 = F.q a.succ) → ((p 2 = C.1.1) → ((TileOdometer (p 0) (D.tiles a true) + (D.functions a true)) → ((BandPrototile (p 0) (D.tiles a true)) → ((AncestorOdometer + (p (0 : Fin (4 : ℕ))) F.outer.1.1 (D.tiles a true) F.tile (D.functions a true) + F.odometer) → ((BandVectors.1 (p 2) (p 0) = x) → ((BandVectors.2 (p 2) (p 0) = xa) → + ((BandVectors.1 (p 0) (p 2) = I * x) → ((BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (2 : + Fin (4 : ℕ))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ)))) → ((Fin.succ (1 : Fin 3) = 2) → ((TileCentroid (D.tiles a true) - + TileCentroid F.tile = (1 / 2 : ℝ) • (GaussianRealPoint y - (-(GaussianRealPoint y).2, + (GaussianRealPoint y).1))) → ((aSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * + ((↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin + (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))).re : ℝ) - (↑(BandVectors.2 (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ)))).im : ℝ))) → ((aSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * + ((↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin + (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))).im : ℝ) + (↑(BandVectors.2 (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ)))).re : ℝ))) → (((BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : + ℕ)))).re + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 + : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ)))).re + (BandVectors.2 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ)))).re = (0 : ℤ)) → (((BandVectors.2 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 + : ℕ)))).im + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ)))).im + (BandVectors.2 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ)))).im = (0 : ℤ)) → (((wa.re : ℝ) + (xa.re : ℝ) + (ya.re : + ℝ) = 0) → (((wa.im : ℝ) + (xa.im : ℝ) + (ya.im : ℝ) = 0) → ((joinSlope - aSlope = (1 + / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : + ℕ))) - BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))))) → ((F.plus_slope - + rootSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) + + BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 + : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))))) → ((F.plus_slope.1 - rootSlope.1 = (1 / + 2 : ℝ) * (((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 + : ℕ))))).re + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))))).re)) → ((F.plus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) * + (((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : + ℕ))))).im + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 + : ℕ))))).im)) → (((BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ)))).re = + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ)))).re - (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).im) → (((BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ)))).im = (BandVectors.2 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ)))).im + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).re) → (((BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))).re = (BandVectors.2 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ)))).im + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).re) → (((BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))).im = -(BandVectors.2 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ)))).re + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).im) → (((BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) + + BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ)))).re = (BandVectors.2 (![F.q + (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ)))).re + (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : + ℕ)))).im) → (((BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) + + BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ)))).im = (BandVectors.2 (![F.q + (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ)))).im - (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : + ℕ)))).re) → ((F.plus_slope.1 - rootSlope.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q + (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ)))).re : ℝ) + (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).re : ℝ))) → ((F.plus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) * ((↑(BandVectors.2 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ)))).im : ℝ) + (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).im : ℝ))) → ((F.plus_slope - aSlope = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) + BandVectors.2 (p (0 : + Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))))) → (Nonempty (P4458T1BoundaryPlacement F + D))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + ))))))))))))))))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hp hstep hB hD selected t ht ht0 ht1 + olderChart hCpositive hstrict hselectedAnc hselectedOdo hnegativeSlope r hr hRparent I w x + y wa xa ya hvsum hasum hvrec harec hvflip haflip hvsumRe hvsumIm hUband hUfoot hUcent + hUcenter hMcenter hcenterVector hcenterRe hcenterIm hcenter hyLattice u huRminus join + hjoin_eq hjoinBand hjoinFamily hjoinCenter hjoinCenterEq hUbandC hjoinCells hjoinOdo + hjoinAncestor positiveCells hUnonempty hJoinNonemptyBase hjoinFootEq hjoinFoot + hjoinOccurrence hq0 hqA hqB hqD rootNeg joinSlope hrootNeg hjoinSlope hjoinSlopeRe + hjoinSlopeIm hrootNegEq hSB hr1 hr2 hr3 hApos hAcoord hApos' rootSlope aSlope hrootSlope + haSlope hARe hAIm hrootSlopeEq directOuter hparentA hparentB houterOdo houterBand houterAnc + hBA haBA hvAB haAB hidx2 hAocc hARe' hAIm' hasumRe hasumIm hasumReR hasumImR + hminusSlopeOffset hFplusSlope hFplusRe hFplusIm ha10Re ha10Im ha01Re ha01Im hplusReVec + hplusImVec hFplusRe' hFplusIm' hplusSlopeOffset + let G : P4458T1BoundaryFrame C orientation base join Rplus + (D.functions F.slot false) hplus := { + outer := directOuter + q := p + proper := hp + slot := 1 + child := rfl + parent := hparentB + tile := D.tiles a true + odometer := D.functions a true + outer_odo := houterOdo + minus_odo := hjoinOdo + plus_odo := F.plus_odo + outer_band := houterBand + base_band := F.base_band + minus_family := hjoinFamily + plus_family := F.plus_family + chart := by + intro hunit + exact hB hSB (by simpa only [hparentB] using hunit) + minus_centroid := by + rw [hidx2] + rw [show TileCentroid join - TileCentroid (D.tiles a true) = + (TileCentroid join - TileCentroid Rminus) + + (TileCentroid Rminus - TileCentroid F.tile) - + (TileCentroid (D.tiles a true) - TileCentroid F.tile) by + ext <;> dsimp <;> ring] + rw [← hjoinCenterEq, hcenter, hMcenter, hAocc, + hvflip, hvrec, hBA, hvAB] + apply Prod.ext <;> + simp [GaussianRealPoint, I, Prod.smul_mk, + Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring + plus_centroid := by + rw [hidx2] + rw [show TileCentroid Rplus - TileCentroid (D.tiles a true) = + (TileCentroid Rplus - TileCentroid F.tile) - + (TileCentroid (D.tiles a true) - TileCentroid F.tile) by + ext <;> dsimp <;> ring] + have hPcenter : TileCentroid Rplus - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1)) := + SecondNewerRowsGeometry.hPcenter C orientation base Rminus Rplus hminus hplus F + rw [hPcenter, hAocc, hvflip, hvrec, hBA, hvAB] + apply Prod.ext <;> + simp [GaussianRealPoint, I, Prod.smul_mk, + Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring + outer_slope := aSlope + minus_slope := joinSlope + plus_slope := F.plus_slope + slope_outer := haSlope + slope_minus := hjoinSlope + slope_plus := F.slope_plus + minus_difference := hminusSlopeOffset + plus_difference := hplusSlopeOffset + } + have houterEq : G.outer.1.1 = F.q a.succ := hparentA + have hright : P4458T1BoundarySide F join Rplus + (D.functions F.slot false) hplus := + .recursive G a houterEq houterAnc + have hFminusSlope := SecondNewerRowsGeometry.hFminusSlopeAt641 C orientation base Rminus + Rplus hminus hplus F rootSlope hrootSlopeEq + have hFminusRe := SecondNewerRowsGeometry.hFminusReAt646 C orientation base Rminus Rplus + hminus hplus F rootSlope hFminusSlope + have hFminusIm := SecondNewerRowsGeometry.hFminusImAt652 C orientation base Rminus Rplus + hminus hplus F rootSlope hFminusSlope + have hrootSame : rootNeg = rootSlope := hrootNegEq.trans hrootSlopeEq.symm + rw [hrootSame] at hjoinSlopeRe hjoinSlopeIm + have ha10ReR : ((BandVectors.2 (r 1) (r 0)).re : ℝ) = + (xa.re : ℝ) - (ya.im : ℝ) := by exact_mod_cast ha10Re + have ha10ImR : ((BandVectors.2 (r 1) (r 0)).im : ℝ) = + (xa.im : ℝ) + (ya.re : ℝ) := by exact_mod_cast ha10Im + have ha01ReR : ((BandVectors.2 (r 0) (r 1)).re : ℝ) = + (xa.im : ℝ) + (ya.re : ℝ) := by exact_mod_cast ha01Re + have ha01ImR : ((BandVectors.2 (r 0) (r 1)).im : ℝ) = + -(xa.re : ℝ) + (ya.im : ℝ) := by exact_mod_cast ha01Im + have hdirectSlope := SecondNewerRowsGeometry.hdirectSlope C orientation base Rminus Rplus + hminus hplus F joinSlope rootSlope hjoinSlopeIm hjoinSlopeRe hasumReR hasumImR + hFminusRe hFminusIm ha10ReR ha10ImR ha01ReR ha01ImR + have hleftCent := SecondNewerRowsGeometry.hleftCent C orientation base Rminus Rplus hminus + hplus F D hcenter u hjoinCenterEq + have htC : t 0 = C.1.1 := ht0.trans hparentB + have hleftTouch := SecondNewerRowsGeometry.hleftTouch C orientation base Rminus Rplus + hminus hplus F p t ht ht0 ht1 u hjoinFamily hr1 hr2 hleftCent htC + (SecondNewerRowsGeometry.hbaseT C orientation base Rminus Rplus hminus hplus F t htC) + have hleftAdjacent := SecondNewerRowsGeometry.hleftAdjacent C orientation base Rminus Rplus + hminus hplus F D p t ht ht0 ht1 u hjoinOdo joinSlope hjoinSlope hr1 hr2 hdirectSlope + hleftCent htC + have hMnonempty := SecondNewerRowsGeometry.hMnonempty C orientation base Rminus Rplus + hminus hplus F positiveCells + refine ⟨⟨join, hjoinCells.1.symm, hjoinOdo, hjoinAncestor, + hjoinOccurrence, .direct (SecondNewerRowsGeometry.leftString C orientation base Rminus + Rplus hminus hplus F D a p hp hstep hB hD selected t olderChart hCpositive hstrict + hselectedAnc hselectedOdo hnegativeSlope hr hRparent hvsum hasum hvrec harec hvflip + haflip hvsumRe hvsumIm hUband hUfoot hUcent hUcenter hMcenter hcenterVector hcenterRe + hcenterIm hcenter hyLattice u huRminus hjoin_eq hjoinBand hjoinFamily hjoinCenter + hjoinCenterEq hUbandC hjoinCells hjoinOdo hjoinAncestor hUnonempty hJoinNonemptyBase + hjoinFootEq hjoinFoot hjoinOccurrence hq0 hqA hqB hqD rootNeg joinSlope hrootNeg + hjoinSlope hrootNegEq hSB hr1 hr2 hr3 hAcoord hApos' rootSlope hjoinSlopeIm + hjoinSlopeRe aSlope hrootSlope haSlope hARe hAIm hrootSlopeEq hparentA + hparentB houterOdo houterBand houterAnc hBA haBA hvAB haAB hidx2 hAocc hARe' hAIm' + hasumRe hasumIm hasumReR hasumImR hminusSlopeOffset hFplusSlope hFplusRe hFplusIm + ha10Re ha10Im ha01Re ha01Im hplusReVec hplusImVec hFplusRe' hFplusIm' + hplusSlopeOffset houterEq hright hFminusSlope hFminusRe hFminusIm ha10ReR ha10ImR + ha01ReR ha01ImR hdirectSlope hleftCent hleftTouch hleftAdjacent hMnonempty + (SecondNewerRowsGeometry.hJnonempty C orientation base Rminus Rplus hminus hplus F D + u hjoinCells hUnonempty) (SecondNewerRowsGeometry.hleftNe C orientation base Rminus + Rplus hminus hplus F u hleftTouch hMnonempty) (SecondNewerRowsGeometry.hnonunit C + orientation base Rminus Rplus hminus hplus F a p t ht htC)) hleftAdjacent, hright⟩⟩ + +private theorem secondParentPlacement : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), ∀ (hp : ProperBandQuadruple p), (F.slot = a + (2 : Fin (3 : ℕ)) → + C.1.1.1 = (1 : ℤ) → UnitOccurrenceOrientation p (2 : Fin (3 : ℕ)) orientation) → (∀ + (t : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple t) → ((t (0 : Fin (4 : + ℕ)) = p (2 : Fin (4 : ℕ))) → ((t (1 : Fin (4 : ℕ)) = p (3 : Fin (4 : ℕ))) → ((F.slot + = a + (2 : Fin (3 : ℕ)) → C.1.1.1 = (1 : ℤ) → UnitOccurrenceOrientation t (0 : Fin (3 + : ℕ)) orientation) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (BandVectors.1 (r 1) (r 0) = x - I * y) → ((BandVectors.1 (r 0) (r 1) = I * BandVectors.1 + (r 1) (r 0)) → ((TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • + GaussianRealPoint (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → + ((TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = GaussianRealPoint y) → + (∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + ( + let join := TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 + : ℕ)))); join ∈ RegularTileFamily base (TilingLattice C)) → ((TileCentroid (D.tiles + F.slot false) = TileCentroid join) → (((D.tiles F.slot false).cells = join.cells ∧ + ((D.tiles F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = join.anchor)) → + ((TileOdometer C.1.1 (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q + (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))))) (D.functions F.slot false)) → ((AncestorOdometer + C.1.1 F.outer.1.1 (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))))) F.tile (D.functions F.slot false) F.odometer) → + ((BandSubtileOccurrence F.q F.tile F.slot false (TileTranslation base ((↑u : + GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))))) → ((F.q a.succ = p 0) → + ((F.q (a + 1).succ = p 2) → ((F.q (a + 2).succ = p 3) → (∀ (rootNeg : ℝ × ℝ), ∀ + (joinSlope : ℝ × ℝ), (PartialOdometerSlope (D.functions F.slot false) = some + joinSlope) → ((joinSlope.1 - rootNeg.1 = -(1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ)))).re : ℝ) - (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : + ℕ)))).im : ℝ))) → ((joinSlope.2 - rootNeg.2 = -(1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q + (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ)))).im : ℝ) + (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : + ℕ)))).re : ℝ))) → ((rootNeg = F.outer_slope) → ((F.slot = a + (2 : Fin (3 : ℕ))) → + ((r 1 = p 3) → ((r 2 = p 0) → ((r 3 = p 2) → (∀ (hApos : 0 < (p 0).1), ((0 : ℤ) < (p + (2 : Fin (4 : ℕ))).1) → (∀ (rootA : ℝ × ℝ), ∀ (slopeA : ℝ × ℝ), (PartialOdometerSlope + (D.functions a true) = some slopeA) → (∀ (rootB : ℝ × ℝ), ∀ (slopeB : ℝ × ℝ), + (PartialOdometerSlope (D.functions (a + (1 : Fin (3 : ℕ))) true) = some slopeB) → + ((slopeB.1 - rootB.1 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (F.q (a + (1 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 + : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (1 : + Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ)) + (1 : Fin (3 : + ℕ))).succ)).im : ℝ))) → ((slopeB.2 - rootB.2 = (if true = true then (1 : ℝ) else (-1 + : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (1 : Fin (3 : ℕ)) + (2 : Fin (3 : + ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + + (↑(BandVectors.2 (F.q (a + (1 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 + : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((rootB = F.outer_slope) → ( + let recursiveOuter : BandCircle := + ⟨⟨p 0, ⟨Or.inl hApos, ⟨p, hp.1, 0, rfl⟩⟩⟩, hApos⟩ + (recursiveOuter.1.1 = F.q a.succ) → ((TileOdometer (p (0 : Fin (4 : ℕ))) (D.tiles a true) + (D.functions a true)) → ((BandPrototile (p 0) (D.tiles a true)) → ((p 3 = C.1.1) → + ((∀ (z : GaussianInt), (GaussianInt.toComplex z).re = (z.re : ℝ)) → ((∀ (z : + GaussianInt), (GaussianInt.toComplex z).im = (z.im : ℝ)) → ((TileCentroid Rminus - + TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (p (3 + : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) - BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (3 : + Fin (4 : ℕ))))) → ((slopeA.1 - rootA.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ)))).re : ℝ) - (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : + ℕ)))).im : ℝ))) → ((slopeA.2 - rootA.2 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ)))).im : ℝ) + (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : + ℕ)))).re : ℝ))) → ((ya = BandVectors.2 (p 0) (p 3)) → ((((BandVectors.2 (r 1) (r + 0)).re : ℝ) = (xa.re : ℝ) - (ya.im : ℝ)) → ((((BandVectors.2 (r 1) (r 0)).im : ℝ) = + (xa.im : ℝ) + (ya.re : ℝ)) → ((((BandVectors.2 (r 0) (r 1)).re : ℝ) = (xa.im : ℝ) + + (ya.re : ℝ)) → ((((BandVectors.2 (r 0) (r 1)).im : ℝ) = -(xa.re : ℝ) + (ya.im : ℝ)) → + ((((BandVectors.2 (p 0) (p 3)).re : ℝ) = ((BandVectors.2 (p 3) (p 0)).im : ℝ)) → + ((((BandVectors.2 (p 0) (p 3)).im : ℝ) = -((BandVectors.2 (p 3) (p 0)).re : ℝ)) → + ((F.minus_slope.1 - rootA.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 + : ℕ)))).re : ℝ) - (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))).re : ℝ))) → + ((F.minus_slope.2 - rootA.2 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 + : ℕ)))).im : ℝ) - (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))).im : ℝ))) → + ((rootNeg = rootA) → (((wa.re : ℝ) + (xa.re : ℝ) + (ya.re : ℝ) = 0) → (((wa.im : ℝ) + + (xa.im : ℝ) + (ya.im : ℝ) = 0) → (Nonempty (P4458T1BoundaryPlacement F + D)))))))))))))))))))))))))))))))))))))))))))))))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hp hD t ht ht0 ht1 olderChart r I x + y wa xa ya hvrec hvflip hMcenter hcenter u join hjoinFamily hjoinCenterEq hjoinCells + hjoinOdo hjoinAncestor hjoinOccurrence hqA hqB hqD rootNeg joinSlope hjoinSlope + hjoinSlopeRe hjoinSlopeIm hrootNegEq hSD hr1 hr2 hr3 hApos hBpos rootA slopeA hslopeA rootB + slopeB hslopeB hBRe hBIm hrootBEq recursiveOuter houterA houterAOdo houterABand hparentD + toRealRe toRealIm hleftAminus hARe' hAIm' hyaA ha10ReR ha10ImR ha01ReR ha01ImR hRotAReR + hRotAImR hFminusRe hFminusIm hrootNegA hasumReR hasumImR + let Gleft : P4458T1BoundaryFrame C orientation base Rminus join + hminus (D.functions F.slot false) := { + outer := recursiveOuter + q := p + proper := hp + slot := 2 + child := rfl + parent := hparentD + tile := D.tiles a true + odometer := D.functions a true + outer_odo := houterAOdo + minus_odo := F.minus_odo + plus_odo := hjoinOdo + outer_band := houterABand + base_band := F.base_band + minus_family := F.minus_family + plus_family := hjoinFamily + chart := by + intro hunit + exact hD hSD (by simpa only [hparentD] using hunit) + minus_centroid := hleftAminus + plus_centroid := (SecondNewerRowsGeometry.hleftAplus C orientation base Rminus Rplus + hminus hplus F D a p hcenter u hjoinCenterEq hr1 hr2 hleftAminus) + outer_slope := slopeA + minus_slope := F.minus_slope + plus_slope := joinSlope + slope_outer := hslopeA + slope_minus := F.slope_minus + slope_plus := hjoinSlope + minus_difference := (SecondNewerRowsGeometry.hleftAslopeMinus C orientation base Rminus + Rplus hminus hplus F p rootA slopeA hARe' hAIm' hyaA ha10ReR ha10ImR ha01ReR ha01ImR + hRotAReR hRotAImR hFminusRe hFminusIm) + plus_difference := (SecondNewerRowsGeometry.hleftAplusSlope C orientation base Rminus + Rplus hminus hplus F p joinSlope rootA slopeA hARe' hAIm' hyaA hRotAReR hRotAImR + (SecondNewerRowsGeometry.hjoinSlopeReA C orientation base Rminus Rplus hminus hplus F + rootNeg joinSlope hjoinSlopeRe rootA hrootNegA) + (SecondNewerRowsGeometry.hjoinSlopeImA C orientation base Rminus Rplus hminus hplus F + rootNeg joinSlope hjoinSlopeIm rootA hrootNegA) hasumReR hasumImR) + } + have hleftOuterEq : Gleft.outer.1.1 = F.q a.succ := houterA + have hleft : P4458T1BoundarySide F Rminus join + hminus (D.functions F.slot false) := + .recursive Gleft a hleftOuterEq (SecondNewerRowsGeometry.houterAAnc C orientation base + Rminus Rplus hminus hplus F D a p hqA hApos) + let outerB : BandCircle := + ⟨⟨p 2, ⟨Or.inl hBpos, ⟨p, hp.1, 2, rfl⟩⟩⟩, hBpos⟩ + have houterB : outerB.1.1 = F.q (a + 1).succ := by + simp [outerB, hqB] + have houterBOdo := SecondNewerRowsGeometry.houterBOdo C orientation base Rminus Rplus + hminus hplus F D a p hqB + have houterBBand : BandPrototile (p 2) (D.tiles (a + 1) true) := + TileOdometerBandPrototile (p 2) (D.tiles (a + 1) true) + (D.functions (a + 1) true) houterBOdo + have ht1C : t 1 = C.1.1 := ht1.trans hparentD + have hidxB2 := SecondNewerRowsGeometry.hidxB2 C orientation base Rminus Rplus hminus hplus + F a p + have hidxB1 := SecondNewerRowsGeometry.hidxB1 a + have hBocc := SecondNewerRowsGeometry.hBocc C orientation base Rminus Rplus hminus hplus F + D a p hqA hqD hr1 hr2 hidxB2 hidxB1 + have hTvec : BandVectors.1 (t 1) (t 0) = x := by + simp [ht0, ht1, hr1, hr3, x] + have hTflip := SecondNewerRowsGeometry.hTflip C orientation base Rminus Rplus hminus hplus + F t ht hTvec + have hrightBminus := SecondNewerRowsGeometry.hrightBminus C orientation base Rminus Rplus + hminus hplus F D a t hvrec hvflip u hBocc (SecondNewerRowsGeometry.hjoinFcenter C + orientation base Rminus Rplus hminus hplus F D hMcenter hcenter u hjoinCenterEq) hTvec + hTflip + have hrightBplus := SecondNewerRowsGeometry.hrightBplus C orientation base Rminus Rplus + hminus hplus F D a t hvrec hvflip hBocc hTvec hTflip + (SecondNewerRowsGeometry.hplusFcenter C orientation base Rminus Rplus hminus hplus F) + have hyaReR : (ya.re : ℝ) = + ((BandVectors.2 (p 0) (p 3)).re : ℝ) := by rw [hyaA] + have hyaImR : (ya.im : ℝ) = + ((BandVectors.2 (p 0) (p 3)).im : ℝ) := by rw [hyaA] + have hBRe' := SecondNewerRowsGeometry.hBRe' C orientation base Rminus Rplus hminus hplus F + a p hqA hqD rootB slopeB hBRe toRealRe toRealIm hidxB2 hidxB1 hyaReR hyaImR + have hBIm' := SecondNewerRowsGeometry.hBIm' C orientation base Rminus Rplus hminus hplus F + a p hqA hqD rootB slopeB hBIm toRealRe toRealIm hidxB2 hidxB1 hyaReR hyaImR + have hrootNegB : rootNeg = rootB := hrootNegEq.trans hrootBEq.symm + have hFplusSlopeB := SecondNewerRowsGeometry.hFplusSlopeB C orientation base Rminus Rplus + hminus hplus F rootB hrootBEq + have hTvecA : BandVectors.2 (t 1) (t 0) = xa := by + simp [ht0, ht1, hr1, hr3, xa] + have hTflipA := SecondNewerRowsGeometry.hTflipA C orientation base Rminus Rplus hminus + hplus F t ht hTvecA + have hrightBminusSlope := SecondNewerRowsGeometry.hrightBminusSlope C orientation base + Rminus Rplus hminus hplus F t joinSlope rootB slopeB hasumReR hasumImR hBRe' hBIm' + (SecondNewerRowsGeometry.hjoinSlopeReB C orientation base Rminus Rplus hminus hplus F + rootNeg joinSlope hjoinSlopeRe rootB hrootNegB) (SecondNewerRowsGeometry.hjoinSlopeImB + C orientation base Rminus Rplus hminus hplus F rootNeg joinSlope hjoinSlopeIm rootB + hrootNegB) hTvecA hTflipA + have hrightBplusSlope := SecondNewerRowsGeometry.hrightBplusSlope C orientation base Rminus + Rplus hminus hplus F t rootB slopeB ha10ReR ha10ImR ha01ReR ha01ImR hBRe' hBIm' + (SecondNewerRowsGeometry.hFplusReB C orientation base Rminus Rplus hminus hplus F rootB + hFplusSlopeB) (SecondNewerRowsGeometry.hFplusImB C orientation base Rminus Rplus hminus + hplus F rootB hFplusSlopeB) hTvecA hTflipA + let Gright : P4458T1BoundaryFrame C orientation base join Rplus + (D.functions F.slot false) hplus := { + outer := outerB + q := t + proper := ht + slot := 0 + child := by simpa [outerB] using ht0 + parent := ht1C + tile := D.tiles (a + 1) true + odometer := D.functions (a + 1) true + outer_odo := houterBOdo + minus_odo := hjoinOdo + plus_odo := F.plus_odo + outer_band := houterBBand + base_band := F.base_band + minus_family := hjoinFamily + plus_family := F.plus_family + chart := by + intro hunit + exact olderChart hSD (by simpa only [ht1C] using hunit) + minus_centroid := hrightBminus + plus_centroid := hrightBplus + outer_slope := slopeB + minus_slope := joinSlope + plus_slope := F.plus_slope + slope_outer := hslopeB + slope_minus := hjoinSlope + slope_plus := F.slope_plus + minus_difference := hrightBminusSlope + plus_difference := hrightBplusSlope + } + have hrightOuterEq : Gright.outer.1.1 = F.q (a + 1).succ := houterB + have hrightParent : Gright.outer.1.1 = F.q (a + 1).succ := hrightOuterEq + have hright : P4458T1BoundarySide F join Rplus + (D.functions F.slot false) hplus := + .recursive Gright (a + 1) hrightParent (SecondNewerRowsGeometry.hrightAnc C orientation + base Rminus Rplus hminus hplus F D a p hp t ht ht0 olderChart u hjoinFamily hjoinOdo + joinSlope hjoinSlope hSD hBpos slopeB hslopeB houterBOdo houterBBand + (SecondNewerRowsGeometry.houterBAnc C orientation base Rminus Rplus hminus hplus F D + a p hqB hBpos) ht1C hrightBminus hrightBplus hrightBminusSlope hrightBplusSlope) + refine ⟨⟨join, hjoinCells.1.symm, hjoinOdo, hjoinAncestor, + hjoinOccurrence, hleft, hright⟩⟩ + +end SecondParentPlacements + +namespace SecondParentCases + +private theorem directParentCase : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), (ProperBandQuadruple p) → ((![F.q (0 : Fin (4 : ℕ)), F.q a.succ, + F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] = ![((2 : ℤ) * (p + (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : + ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : + GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 + - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : + ℕ))]) → ((F.slot = a + (1 : Fin (3 : ℕ)) → C.1.1.1 = (1 : ℤ) → + UnitOccurrenceOrientation p (1 : Fin (3 : ℕ)) orientation) → ((F.slot = a + (2 : Fin + (3 : ℕ)) → C.1.1.1 = (1 : ℤ) → UnitOccurrenceOrientation p (2 : Fin (3 : ℕ)) + orientation) → ((F.slot ≠ a) → (∀ (t : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple t) → ((t (0 : Fin (4 : ℕ)) = p (2 : Fin (4 : ℕ))) → ((t (1 : Fin + (4 : ℕ)) = p (3 : Fin (4 : ℕ))) → ((F.slot = a + (2 : Fin (3 : ℕ)) → C.1.1.1 = (1 : + ℤ) → UnitOccurrenceOrientation t (0 : Fin (3 : ℕ)) orientation) → ((0 < (F.q + F.slot.succ).1) → (((F.q F.slot.succ).1 < (F.q 0).1) → ((AncestorOdometer (F.q + F.slot.succ) F.outer.1.1 (D.tiles F.slot false) F.tile (D.functions F.slot false) + F.odometer) → ((TileOdometer (F.q F.slot.succ) (D.tiles F.slot false) (D.functions + F.slot false)) → ((∃ (s : ℝ × ℝ), PartialOdometerSlope (D.functions F.slot false) = + some s) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + (ProperBandQuadruple r) → ((r 1 = C.1.1) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (w + x + y = 0) → ((wa + xa + ya = 0) → ((BandVectors.1 (r 1) (r 0) = x - I * y) → + ((BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.1 (r 0) (r 1) = I * + BandVectors.1 (r 1) (r 0)) → ((BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) + (r 0)) → (((BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 + : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).re + (BandVectors.1 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ)))).re + (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).re = (0 : ℤ)) → (((BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).im + + (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ)))).im + (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).im = (0 : ℤ)) → ((BandPrototile (F.q F.slot.succ) (D.tiles F.slot false)) → + ((FootprintVertices (D.tiles F.slot false) ⊆ FootprintVertices F.tile) → + ((TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then + (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q + (F.slot + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q + (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → + ((TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))) - + (-(GaussianRealPoint (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))))).2, + (GaussianRealPoint (BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))))).1))) → + ((TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → ((-BandVectors.1 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) - BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) + + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 + : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) = (2 : GaussianInt) * BandVectors.1 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ)))) → (((↑(-BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + - BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 + : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).re : ℝ) = (↑((2 : GaussianInt) * BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).re : ℝ)) → (((↑(-BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) * BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) - BandVectors.1 + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ))) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).im : ℝ) = (↑((2 : GaussianInt) * BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))).im : ℝ)) → ((TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = + GaussianRealPoint y) → (( + let y := BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin + (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))); y ∈ TilingLattice C) → (∀ (u : + ↥(TilingLattice C)), (Rminus = TileTranslation base (↑u : GaussianInt)) → ( + let join : ProtoTile := TileTranslation base (u + y) + (join = TileTranslation Rminus y) → ((BandPrototile C.1.1 join) → (( + let join := TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 + : ℕ)))); join ∈ RegularTileFamily base (TilingLattice C)) → ((TileCentroid + (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ))))) = TileCentroid Rminus + GaussianRealPoint (BandVectors.1 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 + : ℕ))))) → ((TileCentroid (D.tiles F.slot false) = TileCentroid join) → + ((BandPrototile C.1.1 (D.tiles F.slot false)) → (((D.tiles F.slot false).cells = + join.cells ∧ ((D.tiles F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = + join.anchor)) → ((TileOdometer C.1.1 (TileTranslation base ((↑u : GaussianInt) + + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))))) (D.functions F.slot false)) → + ((AncestorOdometer C.1.1 F.outer.1.1 (TileTranslation base ((↑u : GaussianInt) + + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin + (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : + Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))))) F.tile (D.functions F.slot false) + F.odometer) → ((∀ (c : CircleCoordinates), ∀ (T : ProtoTile), (0 : ℤ) < c.1 → + BandPrototile c T → Finset.Nonempty T.cells) → (((D.tiles F.slot + false).cells.Nonempty) → ((join.cells.Nonempty) → ((FootprintVertices + (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ))))) = FootprintVertices (D.tiles F.slot false)) → ((FootprintVertices + (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ))))) ⊆ FootprintVertices F.tile) → ((BandSubtileOccurrence F.q F.tile F.slot false + (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : + ℕ)))))) → ((F.q (0 : Fin (4 : ℕ)) = ((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p + (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : + ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2)) → + ((F.q a.succ = p 0) → ((F.q (a + 1).succ = p 2) → ((F.q (a + 2).succ = p 3) → (∀ + (rootNeg : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (PartialOdometerSlope F.odometer = some + rootNeg) → ((PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → + ((joinSlope.1 - rootNeg.1 = -(1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 + : ℕ)))).re : ℝ) - (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).im : ℝ))) → + ((joinSlope.2 - rootNeg.2 = -(1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 + : ℕ)))).im : ℝ) + (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 + : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : + ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).re : ℝ))) → + ((rootNeg = F.outer_slope) → ((F.slot = a + (1 : Fin (3 : ℕ))) → (Nonempty + (P4458T1BoundaryPlacement F + D))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hp hstep hB hD selected t ht ht0 ht1 + olderChart hCpositive hstrict hselectedAnc hselectedOdo hnegativeSlope r hr hRparent I w x + y wa xa ya hvsum hasum hvrec harec hvflip haflip hvsumRe hvsumIm hUband hUfoot hUcent + hUcenter hMcenter hcenterVector hcenterRe hcenterIm hcenter hyLattice u huRminus join + hjoin_eq hjoinBand hjoinFamily hjoinCenter hjoinCenterEq hUbandC hjoinCells hjoinOdo + hjoinAncestor positiveCells hUnonempty hJoinNonemptyBase hjoinFootEq hjoinFoot + hjoinOccurrence hq0 hqA hqB hqD rootNeg joinSlope hrootNeg hjoinSlope hjoinSlopeRe + hjoinSlopeIm hrootNegEq hSB + have hr1 : r 1 = p 2 := by + simpa [r, hSB] using hqB + have hr2 : r 2 = p 3 := SecondNewerRowsGeometry.hr2At377 C orientation base Rminus Rplus + hminus hplus F a p hqD hSB + have hr3 : r 3 = p 0 := SecondNewerRowsGeometry.hr3At384 C orientation base Rminus Rplus + hminus hplus F a p hqA hSB + have hApos : 0 < (p 0).1 := (ProperBandCurvatureStructure p hp).1 + have hAcoord : F.q a.succ = p 0 := hqA + have hApos' : 0 < (F.q a.succ).1 := by rw [hAcoord]; exact hApos + have hAdata := D.slopes a true + obtain hAzero | ⟨rootSlope, aSlope, hrootSlope, haSlope, hARe, hAIm⟩ := hAdata + · rw [hAcoord] at hAzero + omega + have hrootSlopeEq : rootSlope = F.outer_slope := + Option.some.inj (hrootSlope.symm.trans F.slope_outer) + let directOuter : BandCircle := + ⟨⟨p 0, ⟨Or.inl hApos, ⟨p, hp.1, 0, rfl⟩⟩⟩, hApos⟩ + have hparentA : directOuter.1.1 = F.q a.succ := by + simp [directOuter, hAcoord] + have hparentB : p 2 = C.1.1 := SecondNewerRowsGeometry.hparentB C orientation base Rminus + Rplus hminus hplus F a p hqB hSB + have houterOdo : TileOdometer (p 0) (D.tiles a true) (D.functions a true) := by + simpa only [hAcoord] using D.odometers a true + have houterBand : BandPrototile (p 0) (D.tiles a true) := + TileOdometerBandPrototile (p 0) (D.tiles a true) (D.functions a true) houterOdo + have houterAnc := SecondNewerRowsGeometry.houterAnc C orientation base Rminus Rplus hminus + hplus F D a p hAcoord hApos' + have hBA : BandVectors.1 (p 2) (p 0) = x := by + simp [x, hr1, hr3] + have haBA : BandVectors.2 (p 2) (p 0) = xa := by + simp [xa, hr1, hr3] + have hvAB : BandVectors.1 (p 0) (p 2) = I * x := SecondNewerRowsGeometry.hvAB C orientation + base Rminus Rplus hminus hplus F p hp hBA + have haAB := SecondNewerRowsGeometry.haAB C orientation base Rminus Rplus hminus hplus F p + hp haBA + have hidx2 : Fin.succ (1 : Fin 3) = 2 := by decide + have hAocc : TileCentroid (D.tiles a true) - TileCentroid F.tile = + (1 / 2 : ℝ) • (GaussianRealPoint y - + (-(GaussianRealPoint y).2, (GaussianRealPoint y).1)) := + SecondNewerRowsGeometry.hAoccAt427 C orientation base Rminus Rplus hminus hplus F + D a p hqB hqD hr1 hr2 + have hARe' := SecondNewerRowsGeometry.hARe'At432 C orientation base Rminus Rplus hminus + hplus F a p hqB hqD hr1 hr2 rootSlope aSlope hARe + have hAIm' := SecondNewerRowsGeometry.hAIm'At435 C orientation base Rminus Rplus hminus + hplus F a p hqB hqD hr1 hr2 rootSlope aSlope hAIm + have hasumRe := SecondNewerRowsGeometry.hasumReAt438 C orientation base Rminus Rplus hminus + hplus F hasum + have hasumIm := SecondNewerRowsGeometry.hasumImAt441 C orientation base Rminus Rplus hminus + hplus F hasum + have hasumReR : (wa.re : ℝ) + (xa.re : ℝ) + (ya.re : ℝ) = 0 := by + exact_mod_cast hasumRe + have hasumImR : (wa.im : ℝ) + (xa.im : ℝ) + (ya.im : ℝ) = 0 := by + exact_mod_cast hasumIm + have toRealRe (z : GaussianInt) : + (GaussianInt.toComplex z).re = (z.re : ℝ) := (GaussianInt.intCast_re z).symm + have toRealIm (z : GaussianInt) : + (GaussianInt.toComplex z).im = (z.im : ℝ) := (GaussianInt.intCast_im z).symm + have hminusSlopeOffset := SecondNewerRowsGeometry.hminusSlopeOffset C orientation base + Rminus Rplus hminus hplus F p rootNeg joinSlope hjoinSlopeRe hjoinSlopeIm hrootNegEq + rootSlope aSlope hrootSlopeEq haBA haAB hARe' hAIm' hasumReR hasumImR toRealRe toRealIm + have hFplusSlope := SecondNewerRowsGeometry.hFplusSlope C orientation base Rminus Rplus + hminus hplus F rootSlope hrootSlopeEq + have hFplusRe := SecondNewerRowsGeometry.hFplusRe C orientation base Rminus Rplus hminus + hplus F rootSlope hFplusSlope + have hFplusIm := SecondNewerRowsGeometry.hFplusIm C orientation base Rminus Rplus hminus + hplus F rootSlope hFplusSlope + have ha10Re := SecondNewerRowsGeometry.ha10ReAt509 C orientation base Rminus Rplus hminus + hplus F a p harec + have ha10Im := SecondNewerRowsGeometry.ha10ImAt513 C orientation base Rminus Rplus hminus + hplus F harec + have ha01Re := SecondNewerRowsGeometry.ha01ReAt517 C orientation base Rminus Rplus hminus + hplus F haflip ha10Im + have ha01Im := SecondNewerRowsGeometry.ha01ImAt522 C orientation base Rminus Rplus hminus + hplus F a p haflip ha10Re + have hplusReVec := SecondNewerRowsGeometry.hplusReVec C orientation base Rminus Rplus + hminus hplus F p haBA haAB + have hplusImVec := SecondNewerRowsGeometry.hplusImVec C orientation base Rminus Rplus + hminus hplus F a p haBA haAB + have hFplusRe' := SecondNewerRowsGeometry.hFplusRe' C orientation base Rminus Rplus hminus + hplus F rootSlope toRealRe hFplusRe + have hFplusIm' := SecondNewerRowsGeometry.hFplusIm' C orientation base Rminus Rplus hminus + hplus F rootSlope toRealIm hFplusIm + have hplusSlopeOffset := SecondNewerRowsGeometry.hplusSlopeOffset C orientation base Rminus + Rplus hminus hplus F p rootSlope aSlope hARe' hAIm' ha10Re ha10Im ha01Re ha01Im + hplusReVec hplusImVec hFplusRe' hFplusIm' + have firstParentPlacement : Nonempty (P4458T1BoundaryPlacement F D) := + SecondParentPlacements.firstParentPlacement C orientation base Rminus Rplus hminus + hplus F D a p hp hstep hB hD selected t ht ht0 ht1 olderChart hCpositive hstrict + hselectedAnc hselectedOdo hnegativeSlope hr hRparent hvsum hasum hvrec harec hvflip + haflip hvsumRe hvsumIm hUband hUfoot hUcent hUcenter hMcenter hcenterVector hcenterRe + hcenterIm hcenter hyLattice u huRminus hjoin_eq hjoinBand hjoinFamily hjoinCenter + hjoinCenterEq hUbandC hjoinCells hjoinOdo hjoinAncestor positiveCells hUnonempty + hJoinNonemptyBase hjoinFootEq hjoinFoot hjoinOccurrence hq0 hqA hqB hqD rootNeg + joinSlope hrootNeg hjoinSlope hjoinSlopeRe hjoinSlopeIm hrootNegEq hSB hr1 hr2 hr3 + hApos hAcoord hApos' rootSlope aSlope hrootSlope haSlope hARe hAIm hrootSlopeEq + hparentA hparentB houterOdo houterBand houterAnc hBA haBA hvAB haAB hidx2 hAocc hARe' + hAIm' hasumRe hasumIm hasumReR hasumImR hminusSlopeOffset hFplusSlope hFplusRe hFplusIm + ha10Re ha10Im ha01Re ha01Im hplusReVec hplusImVec hFplusRe' hFplusIm' hplusSlopeOffset + exact firstParentPlacement + +private theorem recursiveParentCase : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → + CircleCoordinates), (ProperBandQuadruple p) → ((F.slot = a + (2 : Fin (3 : ℕ)) → + C.1.1.1 = (1 : ℤ) → UnitOccurrenceOrientation p (2 : Fin (3 : ℕ)) orientation) → (∀ + (t : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple t) → ((t (0 : Fin (4 : + ℕ)) = p (2 : Fin (4 : ℕ))) → ((t (1 : Fin (4 : ℕ)) = p (3 : Fin (4 : ℕ))) → ((F.slot + = a + (2 : Fin (3 : ℕ)) → C.1.1.1 = (1 : ℤ) → UnitOccurrenceOrientation t (0 : Fin (3 + : ℕ)) orientation) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (wa + xa + ya = 0) → ((BandVectors.1 (r 1) (r 0) = x - I * y) → ((BandVectors.2 (r 1) (r + 0) = xa + I * ya) → ((BandVectors.1 (r 0) (r 1) = I * BandVectors.1 (r 1) (r 0)) → + ((BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → ((TileCentroid Rminus + - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (r 1) (r 0) - + BandVectors.1 (r 0) (r 1))) → ((TileCentroid (D.tiles F.slot false) - TileCentroid + Rminus = GaussianRealPoint y) → (∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + ( + let join := TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : + ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin + (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q + (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 + : ℕ)))); join ∈ RegularTileFamily base (TilingLattice C)) → ((TileCentroid (D.tiles + F.slot false) = TileCentroid join) → (((D.tiles F.slot false).cells = join.cells ∧ + ((D.tiles F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = join.anchor)) → + ((TileOdometer C.1.1 (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q + (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))))) (D.functions F.slot false)) → ((AncestorOdometer + C.1.1 F.outer.1.1 (TileTranslation base ((↑u : GaussianInt) + BandVectors.1 (![F.q (0 + : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (4 : ℕ))))) F.tile (D.functions F.slot false) F.odometer) → + ((BandSubtileOccurrence F.q F.tile F.slot false (TileTranslation base ((↑u : + GaussianInt) + BandVectors.1 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ))) + (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))))) → ((F.q a.succ = p 0) → + ((F.q (a + 1).succ = p 2) → ((F.q (a + 2).succ = p 3) → (∀ (rootNeg : ℝ × ℝ), ∀ + (joinSlope : ℝ × ℝ), (PartialOdometerSlope (D.functions F.slot false) = some + joinSlope) → ((joinSlope.1 - rootNeg.1 = -(1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : + Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ)))).re : ℝ) - (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : + ℕ)))).im : ℝ))) → ((joinSlope.2 - rootNeg.2 = -(1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q + (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q + (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q + F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (2 : Fin (4 : ℕ)))).im : ℝ) + (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), + F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : + ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : + ℕ)))).re : ℝ))) → ((rootNeg = F.outer_slope) → ((F.slot = a + (2 : Fin (3 : ℕ))) → + (Nonempty (P4458T1BoundaryPlacement F D)))))))))))))))))))))))))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hp hD t ht ht0 ht1 olderChart r I x + y wa xa ya hasum hvrec harec hvflip haflip hMcenter hcenter u join hjoinFamily + hjoinCenterEq hjoinCells hjoinOdo hjoinAncestor hjoinOccurrence hqA hqB hqD rootNeg + joinSlope hjoinSlope hjoinSlopeRe hjoinSlopeIm hrootNegEq hSD + have hr1 : r 1 = p 3 := by + simpa [r, hSD] using hqD + have hr2 : r 2 = p 0 := SecondNewerRowsGeometry.hr2At770 C orientation base Rminus Rplus + hminus hplus F a p hqA hSD + have hr3 : r 3 = p 2 := SecondNewerRowsGeometry.hr3At777 C orientation base Rminus Rplus + hminus hplus F a p hqB hSD + have hApos : 0 < (p 0).1 := (ProperBandCurvatureStructure p hp).1 + have hBpos := SecondNewerRowsGeometry.hBpos p t ht ht0 + have hAdata := D.slopes a true + obtain hAzero | ⟨rootA, slopeA, hrootA, hslopeA, hARe, hAIm⟩ := hAdata + · rw [hqA] at hAzero + omega + have hrootAEq : rootA = F.outer_slope := + Option.some.inj (hrootA.symm.trans F.slope_outer) + have hBdata := D.slopes (a + 1) true + obtain hBzero | ⟨rootB, slopeB, hrootB, hslopeB, hBRe, hBIm⟩ := hBdata + · rw [hqB] at hBzero + omega + have hrootBEq : rootB = F.outer_slope := + Option.some.inj (hrootB.symm.trans F.slope_outer) + let recursiveOuter : BandCircle := + ⟨⟨p 0, ⟨Or.inl hApos, ⟨p, hp.1, 0, rfl⟩⟩⟩, hApos⟩ + have houterA : recursiveOuter.1.1 = F.q a.succ := by + simp [recursiveOuter, hqA] + have houterAOdo := SecondNewerRowsGeometry.houterAOdo C orientation base Rminus Rplus + hminus hplus F D a p hqA + have houterABand : BandPrototile (p 0) (D.tiles a true) := + TileOdometerBandPrototile (p 0) (D.tiles a true) + (D.functions a true) houterAOdo + have hparentD : p 3 = C.1.1 := SecondNewerRowsGeometry.hparentD C orientation base Rminus + Rplus hminus hplus F a p hqD hSD + have hAocc : TileCentroid (D.tiles a true) - TileCentroid F.tile = + (1 / 2 : ℝ) • (GaussianRealPoint x - + (-(GaussianRealPoint x).2, (GaussianRealPoint x).1)) := + SecondNewerRowsGeometry.hAoccAt816 C orientation base Rminus Rplus hminus hplus F + D a p hqB hqD hr1 hr3 + let pRot : Fin 4 → CircleCoordinates := ![p 0, p 3, p 1, p 2] + have hpRot := SecondNewerRowsGeometry.hpRot p hp + have hRotV := SecondNewerRowsGeometry.hRotV p hpRot + have hRotA := SecondNewerRowsGeometry.hRotA p hpRot + have hRotVReR : ((BandVectors.1 (p 0) (p 3)).re : ℝ) = + -((BandVectors.1 (p 3) (p 0)).im : ℝ) := by exact_mod_cast + (SecondNewerRowsGeometry.hRotVRe p hRotV) + have hRotVImR : ((BandVectors.1 (p 0) (p 3)).im : ℝ) = + ((BandVectors.1 (p 3) (p 0)).re : ℝ) := by exact_mod_cast + (SecondNewerRowsGeometry.hRotVIm p hRotV) + have hrecVReR : ((BandVectors.1 (r 1) (r 0)).re : ℝ) = + (x.re : ℝ) + (y.im : ℝ) := by exact_mod_cast (SecondNewerRowsGeometry.hrecVRe C + orientation base Rminus Rplus hminus hplus F hvrec) + have hrecVImR : ((BandVectors.1 (r 1) (r 0)).im : ℝ) = + (x.im : ℝ) - (y.re : ℝ) := by exact_mod_cast (SecondNewerRowsGeometry.hrecVIm C + orientation base Rminus Rplus hminus hplus F hvrec) + have hflipVReR : ((BandVectors.1 (r 0) (r 1)).re : ℝ) = + -((BandVectors.1 (r 1) (r 0)).im : ℝ) := by exact_mod_cast + (SecondNewerRowsGeometry.hflipVRe C orientation base Rminus Rplus hminus hplus F + hvflip) + have hflipVImR : ((BandVectors.1 (r 0) (r 1)).im : ℝ) = + ((BandVectors.1 (r 1) (r 0)).re : ℝ) := by exact_mod_cast + (SecondNewerRowsGeometry.hflipVIm C orientation base Rminus Rplus hminus hplus F + hvflip) + have hyRot : y = BandVectors.1 (p 0) (p 3) := by + simp [y, hr1, hr2] + have toRealRe (z : GaussianInt) : + (GaussianInt.toComplex z).re = (z.re : ℝ) := + (GaussianInt.intCast_re z).symm + have toRealIm (z : GaussianInt) : + (GaussianInt.toComplex z).im = (z.im : ℝ) := + (GaussianInt.intCast_im z).symm + have hrecVC := SecondNewerRowsGeometry.hrecVC C orientation base Rminus Rplus hminus hplus + F hvrec + have hflipVC := SecondNewerRowsGeometry.hflipVC C orientation base Rminus Rplus hminus + hplus F hvflip + have hRotVC := SecondNewerRowsGeometry.hRotVC p hRotV + have hyRotC : GaussianInt.toComplex y = + GaussianInt.toComplex (BandVectors.1 (p 0) (p 3)) := + congrArg GaussianInt.toComplex hyRot + have hleftAminus := SecondNewerRowsGeometry.hleftAminus C orientation base Rminus Rplus + hminus hplus F D a p hMcenter hAocc hRotVReR hRotVImR hrecVReR hrecVImR hflipVReR + hflipVImR hyRot + have hARe' := SecondNewerRowsGeometry.hARe'At945 C orientation base Rminus Rplus hminus + hplus F a p hqB hqD hr1 hr3 rootA slopeA hARe + have hAIm' := SecondNewerRowsGeometry.hAIm'At948 C orientation base Rminus Rplus hminus + hplus F a p hqB hqD hr1 hr3 rootA slopeA hAIm + have ha10Re := SecondNewerRowsGeometry.ha10ReAt951 C orientation base Rminus Rplus hminus + hplus F a p harec + have ha10Im := SecondNewerRowsGeometry.ha10ImAt955 C orientation base Rminus Rplus hminus + hplus F harec + have ha01Re := SecondNewerRowsGeometry.ha01ReAt959 C orientation base Rminus Rplus hminus + hplus F a p haflip ha10Im + have ha01Im := SecondNewerRowsGeometry.ha01ImAt963 C orientation base Rminus Rplus hminus + hplus F a p haflip ha10Re + have hyaA : ya = BandVectors.2 (p 0) (p 3) := by + simp [ya, hr1, hr2] + have ha10ReR : ((BandVectors.2 (r 1) (r 0)).re : ℝ) = + (xa.re : ℝ) - (ya.im : ℝ) := by exact_mod_cast ha10Re + have ha10ImR : ((BandVectors.2 (r 1) (r 0)).im : ℝ) = + (xa.im : ℝ) + (ya.re : ℝ) := by exact_mod_cast ha10Im + have ha01ReR : ((BandVectors.2 (r 0) (r 1)).re : ℝ) = + (xa.im : ℝ) + (ya.re : ℝ) := by exact_mod_cast ha01Re + have ha01ImR : ((BandVectors.2 (r 0) (r 1)).im : ℝ) = + -(xa.re : ℝ) + (ya.im : ℝ) := by exact_mod_cast ha01Im + have hRotAReR : ((BandVectors.2 (p 0) (p 3)).re : ℝ) = + ((BandVectors.2 (p 3) (p 0)).im : ℝ) := by exact_mod_cast + (SecondNewerRowsGeometry.hRotARe p hRotA) + have hRotAImR : ((BandVectors.2 (p 0) (p 3)).im : ℝ) = + -((BandVectors.2 (p 3) (p 0)).re : ℝ) := by exact_mod_cast + (SecondNewerRowsGeometry.hRotAIm p hRotA) + have hFminusSlope := SecondNewerRowsGeometry.hFminusSlopeAt991 C orientation base Rminus + Rplus hminus hplus F rootA hrootAEq + have hFminusRe := SecondNewerRowsGeometry.hFminusReAt996 C orientation base Rminus Rplus + hminus hplus F rootA hFminusSlope + have hFminusIm := SecondNewerRowsGeometry.hFminusImAt1002 C orientation base Rminus Rplus + hminus hplus F rootA hFminusSlope + have hrootNegA : rootNeg = rootA := hrootNegEq.trans hrootAEq.symm + have hasumRe := SecondNewerRowsGeometry.hasumReAt1051 C orientation base Rminus Rplus + hminus hplus F hasum + have hasumIm := SecondNewerRowsGeometry.hasumImAt1054 C orientation base Rminus Rplus + hminus hplus F hasum + have hasumReR : (wa.re : ℝ) + (xa.re : ℝ) + (ya.re : ℝ) = 0 := by + exact_mod_cast hasumRe + have hasumImR : (wa.im : ℝ) + (xa.im : ℝ) + (ya.im : ℝ) = 0 := by + exact_mod_cast hasumIm + have secondParentPlacement : Nonempty (P4458T1BoundaryPlacement F D) := + SecondParentPlacements.secondParentPlacement C orientation base Rminus Rplus hminus + hplus F D a p hp hD t ht ht0 ht1 olderChart hvrec hvflip hMcenter hcenter u hjoinFamily + hjoinCenterEq hjoinCells hjoinOdo hjoinAncestor hjoinOccurrence hqA hqB hqD rootNeg + joinSlope hjoinSlope hjoinSlopeRe hjoinSlopeIm hrootNegEq hSD hr1 hr2 hr3 hApos hBpos + rootA slopeA hslopeA rootB slopeB hslopeB hBRe hBIm hrootBEq houterA houterAOdo + houterABand hparentD toRealRe toRealIm hleftAminus hARe' hAIm' hyaA ha10ReR ha10ImR + ha01ReR ha01ImR hRotAReR hRotAImR hFminusRe hFminusIm hrootNegA hasumReR hasumImR + exact secondParentPlacement + +end SecondParentCases + +theorem P4458T1SecondNewerRows : + ∀ {C : BandCircle}, ∀ {orientation : Bool}, ∀ {base : ProtoTile}, ∀ {Rminus : ProtoTile}, ∀ + {Rplus : ProtoTile}, ∀ {hminus : PartialOdometer}, ∀ {hplus : PartialOdometer}, ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), + (ProperBandQuadruple p) → ((![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3]) → ((F.slot = a + 1 → C.1.1.1 = 1 → + UnitOccurrenceOrientation p 1 orientation) → ((F.slot = a + 2 → C.1.1.1 = 1 → + UnitOccurrenceOrientation p 2 orientation) → ((F.slot ≠ a) → (∀ (t : Fin 4 → + CircleCoordinates), (ProperBandQuadruple t) → ((t 0 = p 2) → ((t 1 = p 3) → (((p 3).1 < + (p 2).1) → ((F.slot = a + 2 → C.1.1.1 = 1 → + UnitOccurrenceOrientation t 0 orientation) → (Nonempty (P4458T1BoundaryPlacement F + D))))))))))) := by + intro C orientation base Rminus Rplus hminus hplus F D a p hp hstep hB hD selected t ht ht0 ht1 + newer olderChart +-- BODY + exact (by + classical + have hCpositive : 0 < (F.q F.slot.succ).1 := by + simpa only [← F.parent] using C.2 + have hstrict : (F.q F.slot.succ).1 < (F.q 0).1 := F.proper.2 F.slot + have hselectedAnc := D.ancestors F.slot false hCpositive + have hselectedOdo := D.odometers F.slot false + have hselectedOcc := D.occurrences F.slot false + have hnegativeSlope := SecondNewerRowsGeometry.hnegativeSlope C orientation base Rminus Rplus + hminus hplus F D p hCpositive + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + have hr : ProperBandQuadruple r := SecondNewerRowsGeometry.hr C orientation base Rminus Rplus + hminus hplus F + have hRparent : r 1 = C.1.1 := by simpa [r] using F.parent + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + have hvsum : w + x + y = 0 := by + simpa [w, x, y] using (VectorRecursionLaws r hr.1).1 + have hasum : wa + xa + ya = 0 := by + simpa [wa, xa, ya] using (VectorRecursionLaws r hr.1).2.1 + have hvrec : BandVectors.1 (r 1) (r 0) = x - I * y := by + simpa [x, y, I] using (VectorRecursionLaws r hr.1).2.2.1 + have harec : BandVectors.2 (r 1) (r 0) = xa + I * ya := by + simpa [xa, ya, I] using (VectorRecursionLaws r hr.1).2.2.2.1 + have hvflip : BandVectors.1 (r 0) (r 1) = I * BandVectors.1 (r 1) (r 0) := by + simpa [I] using (VectorRecursionLaws r hr.1).2.2.2.2 hr 0 |>.1 + have haflip : BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0) := by + simpa [I] using (VectorRecursionLaws r hr.1).2.2.2.2 hr 0 |>.2 + have hvsumRe := SecondNewerRowsGeometry.hvsumRe C orientation base Rminus Rplus hminus hplus + F hvsum + have hvsumIm := SecondNewerRowsGeometry.hvsumIm C orientation base Rminus Rplus hminus hplus + F hvsum + rcases hselectedOcc with ⟨hUband, hUfoot, hUcent⟩ + have hUcenter := SecondNewerRowsGeometry.hUcenter C orientation base Rminus Rplus hminus + hplus F D hUcent + have hMcenter : TileCentroid Rminus - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1)) := + SecondNewerRowsGeometry.hMcenter C orientation base Rminus Rplus hminus hplus F + have hcenterVector := SecondNewerRowsGeometry.hcenterVector C orientation base Rminus Rplus + hminus hplus F p hvrec hvflip hvsumRe hvsumIm + have hcenterRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) hcenterVector + have hcenterIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) hcenterVector + have hcenter : TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = + GaussianRealPoint y := SecondNewerRowsGeometry.hcenter C orientation base Rminus Rplus + hminus hplus F D hUcenter hMcenter hcenterRe hcenterIm + have hyLattice := SecondNewerRowsGeometry.hyLattice C orientation base Rminus Rplus hminus + hplus F hr hRparent + obtain ⟨u, huRminus, _⟩ := + RegularTileFamilyTranslationUnique base (TilingLattice C) Rminus F.minus_family + let join : ProtoTile := TileTranslation base (u + y) + have translate_add (T : ProtoTile) (v z : GaussianInt) : + TileTranslation (TileTranslation T v) z = TileTranslation T (v + z) := + SecondNewerRowsGeometry.translate_add T v z + have hjoin_eq : join = TileTranslation Rminus y := by + simpa [join, huRminus] using (translate_add base (u : GaussianInt) y).symm + have hjoinBand : BandPrototile C.1.1 join := by + simpa [join] using BandPrototileTranslation C.1.1 base (u + y) F.base_band + have hjoinFamily := SecondNewerRowsGeometry.hjoinFamily C orientation base Rminus Rplus + hminus hplus F hyLattice u + have hjoinCenter := SecondNewerRowsGeometry.hjoinCenter C orientation base Rminus Rplus + hminus hplus F u hjoin_eq + have hjoinCenterEq : TileCentroid (D.tiles F.slot false) = TileCentroid join := + SecondNewerRowsGeometry.hjoinCenterEq C orientation base Rminus Rplus hminus hplus F D + hcenter u hjoinCenter + have hUbandC := SecondNewerRowsGeometry.hUbandC C orientation base Rminus Rplus hminus hplus + F D hUband + have hjoinCells := BandPrototileCentroidUnique C.1.1 + (D.tiles F.slot false) join hUbandC hjoinBand hjoinCenterEq + have hjoinOdo := SecondNewerRowsGeometry.hjoinOdo C orientation base Rminus Rplus hminus + hplus F D hselectedOdo u hjoinBand hjoinCells + have hjoinAncestor := SecondNewerRowsGeometry.hjoinAncestor C orientation base Rminus Rplus + hminus hplus F D hCpositive hstrict hselectedAnc u hjoinBand hjoinCells + have positiveCells := SecondNewerRowsGeometry.positiveCells C orientation base Rminus Rplus + hminus hplus F p + have hUnonempty : (D.tiles F.slot false).cells.Nonempty := + positiveCells _ _ hCpositive hUband + have hJoinNonemptyBase : join.cells.Nonempty := by rw [← hjoinCells.1]; exact hUnonempty + have hjoinFootEq := SecondNewerRowsGeometry.hjoinFootEq C orientation base Rminus Rplus + hminus hplus F D u hjoinCells hUnonempty hJoinNonemptyBase + have hjoinFoot := SecondNewerRowsGeometry.hjoinFoot C orientation base Rminus Rplus hminus + hplus F D hUfoot u hjoinFootEq + have hjoinOccurrence := SecondNewerRowsGeometry.hjoinOccurrence C orientation base Rminus + Rplus hminus hplus F D hUcent u hjoinBand hjoinCenterEq hjoinFoot + have hq0 := SecondNewerRowsGeometry.hq0 C orientation base Rminus Rplus hminus hplus F a p hstep + have hqA : F.q a.succ = p 0 := SecondNewerRowsGeometry.hqA C orientation base Rminus Rplus + hminus hplus F a p hstep + have hqB : F.q (a + 1).succ = p 2 := SecondNewerRowsGeometry.hqB C orientation base Rminus + Rplus hminus hplus F a p hstep + have hqD : F.q (a + 2).succ = p 3 := SecondNewerRowsGeometry.hqD C orientation base Rminus + Rplus hminus hplus F a p hstep + have hslot := SecondNewerRowsGeometry.hslot C orientation base Rminus Rplus hminus hplus F a + p selected + have hSlopeInfo := SecondNewerRowsGeometry.hSlopeInfo C orientation base Rminus Rplus hminus + hplus F D p hCpositive + obtain ⟨rootNeg, joinSlope, hrootNeg, hjoinSlope, + hjoinSlopeRe, hjoinSlopeIm⟩ := hSlopeInfo + have hrootNegEq : rootNeg = F.outer_slope := + Option.some.inj (hrootNeg.symm.trans F.slope_outer) + rcases hslot with hSB | hSD + · have directParentCase : Nonempty (P4458T1BoundaryPlacement F D) := + SecondParentCases.directParentCase C orientation base Rminus Rplus hminus hplus F D a p + hp hstep hB hD selected t ht ht0 ht1 olderChart hCpositive hstrict hselectedAnc + hselectedOdo hnegativeSlope hr hRparent hvsum hasum hvrec harec hvflip haflip hvsumRe + hvsumIm hUband hUfoot hUcent hUcenter hMcenter hcenterVector hcenterRe hcenterIm hcenter + hyLattice u huRminus hjoin_eq hjoinBand hjoinFamily hjoinCenter hjoinCenterEq hUbandC + hjoinCells hjoinOdo hjoinAncestor positiveCells hUnonempty hJoinNonemptyBase hjoinFootEq + hjoinFoot hjoinOccurrence hq0 hqA hqB hqD rootNeg joinSlope hrootNeg hjoinSlope + hjoinSlopeRe hjoinSlopeIm hrootNegEq hSB + exact directParentCase + · have recursiveParentCase : Nonempty (P4458T1BoundaryPlacement F D) := + SecondParentCases.recursiveParentCase C orientation base Rminus Rplus hminus hplus F D a + p hp hD t ht ht0 ht1 olderChart hasum hvrec harec hvflip haflip hMcenter hcenter u + hjoinFamily hjoinCenterEq hjoinCells hjoinOdo hjoinAncestor hjoinOccurrence hqA hqB hqD + rootNeg joinSlope hjoinSlope hjoinSlopeRe hjoinSlopeIm hrootNegEq hSD + exact recursiveParentCase + ) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1SmallPairRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1SmallPairRows.lean new file mode 100644 index 0000000000..21de3466b5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4458T1SmallPairRows.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization +public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData +public import LeanPool.ApollonianSuperharmonic.BandOrientedBoundaryOccurrenceGenealogy +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryFrame +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryPlacement +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundarySide +public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily +public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct +public import LeanPool.ApollonianSuperharmonic.P4536T1AFrameB +public import LeanPool.ApollonianSuperharmonic.P4536T1AFrameD +public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointDifferences +public import LeanPool.ApollonianSuperharmonic.P4536T1RegularJoin +public import LeanPool.ApollonianSuperharmonic.P4536T1SmallUnitSides + +-- [TABLET NODE: P4458T1SmallPairRows] + +/-! +# P4458T1SmallPairRows + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4458T1SmallPairRows + {C : BandCircle} {orientation : Bool} {base Rminus Rplus : ProtoTile} + {hminus hplus : PartialOdometer} + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) + (D : P4458T1RestrictionFamily F) + (a : Fin 3) (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (hstep : ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3]) + (hB : F.slot = a + 1 → C.1.1.1 = 1 → + UnitOccurrenceOrientation p 1 orientation) + (hD : F.slot = a + 2 → C.1.1.1 = 1 → + UnitOccurrenceOrientation p 2 orientation) + (selected : F.slot ≠ a) + (small : ((p 2).1 = 0 ∨ (p 2).1 = 1) ∧ + ((p 3).1 = 0 ∨ (p 3).1 = 1)) : + Nonempty (P4458T1BoundaryPlacement F D) := by +-- BODY + obtain ⟨s, hs, hcenter, _⟩ := P4536T1EndpointDifferences F D + obtain ⟨J, hfamily, hcent, hcells, hodo, hanc, hocc⟩ := + P4536T1RegularJoin F D hcenter + have direct := P4536T1SmallUnitSides F D a p hp hstep small J hfamily hodo hcent + have hqA : F.q a.succ = p 0 := by simpa using congrFun hstep 1 + have hpos : 0 < (F.q a.succ).1 := by + rw [hqA] + exact (ProperBandCurvatureStructure p hp).1 + have hancA := D.ancestors a true hpos + have hslots : F.slot = a + 1 ∨ F.slot = a + 2 := by + have hne : F.slot.val ≠ a.val := fun he => selected (Fin.ext he) + have hi := F.slot.isLt + have ha := a.isLt + have hv : F.slot.val = (a.val + 1) % 3 ∨ + F.slot.val = (a.val + 2) % 3 := by omega + rcases hv with h | h + · exact Or.inl (Fin.ext (by simpa [Fin.val_add] using h)) + · exact Or.inr (Fin.ext (by simpa [Fin.val_add] using h)) + rcases hslots with hslot | hslot + · obtain ⟨G, _, _, houter, htile, hfunction⟩ := + P4536T1AFrameB F D a p hp hstep hslot (hB hslot) J hfamily hodo hcent + have hancestor : AncestorOdometer G.outer.1.1 F.outer.1.1 + G.tile F.tile G.odometer F.odometer := by + rw [houter, htile, hfunction] + exact hancA + exact ⟨⟨J, hcells, hodo, hanc, hocc, + .direct (direct.1 hslot).1 (direct.1 hslot).2, + .recursive G a houter hancestor⟩⟩ + · obtain ⟨G, _, _, houter, htile, hfunction⟩ := + P4536T1AFrameD F D a p hp hstep hslot (hD hslot) J hfamily hodo hcent + have hancestor : AncestorOdometer G.outer.1.1 F.outer.1.1 + G.tile F.tile G.odometer F.odometer := by + rw [houter, htile, hfunction] + exact hancA + exact ⟨⟨J, hcells, hodo, hanc, hocc, + .recursive G a houter hancestor, + .direct (direct.2 hslot).1 (direct.2 hslot).2⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1ThirdNewerRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1ThirdNewerRows.lean new file mode 100644 index 0000000000..0b31e6cfbc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4458T1ThirdNewerRows.lean @@ -0,0 +1,129 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification +public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryFrame +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryPlacement +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundarySide +public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily +public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileString +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P4536T1AFrameB +public import LeanPool.ApollonianSuperharmonic.P4536T1AFrameD +public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointDifferences +public import LeanPool.ApollonianSuperharmonic.P4536T1RegularJoin +public import LeanPool.ApollonianSuperharmonic.P4549T1DeeperFrameB +public import LeanPool.ApollonianSuperharmonic.P4549T1NegativeIncomingSide + +-- [TABLET NODE: P4458T1ThirdNewerRows] + +/-! +# P4458T1ThirdNewerRows + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4458T1ThirdNewerRows : + ∀ {C : BandCircle}, ∀ {orientation : Bool}, ∀ {base : ProtoTile}, ∀ {Rminus : ProtoTile}, ∀ + {Rplus : ProtoTile}, ∀ {hminus : PartialOdometer}, ∀ {hplus : PartialOdometer}, ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), + (ProperBandQuadruple p) → ((![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3]) → ((F.slot = a + 1 → C.1.1.1 = 1 → + UnitOccurrenceOrientation p 1 orientation) → ((F.slot = a + 2 → C.1.1.1 = 1 → + UnitOccurrenceOrientation p 2 orientation) → ((F.slot ≠ a) → (∀ (t : Fin 4 → + CircleCoordinates), (ProperBandQuadruple t) → ((t 0 = p 3) → ((t 1 = p 2) → (((p 2).1 < + (p 3).1) → ((F.slot = a + 1 → C.1.1.1 = 1 → + UnitOccurrenceOrientation t 0 orientation) → (Nonempty (P4458T1BoundaryPlacement F + D))))))))))) := by + intro C orientation base Rminus Rplus hminus hplus F D a p hp hstep hB hD selected t ht ht0 ht1 + newer olderChart +-- BODY + obtain ⟨s, hs, hcenter, hright, _, hrightSlope⟩ := P4536T1EndpointDifferences F D + obtain ⟨J, hfamily, hcent, hcells, hodo, hanc, hocc⟩ := + P4536T1RegularJoin F D hcenter + have hqA : F.q a.succ = p 0 := by simpa using congrFun hstep 1 + have hposA : 0 < (F.q a.succ).1 := by + rw [hqA] + exact (ProperBandCurvatureStructure p hp).1 + have hancA := D.ancestors a true hposA + have hslots : F.slot = a + 1 ∨ F.slot = a + 2 := by + have hne : F.slot.val ≠ a.val := fun he => selected (Fin.ext he) + have hi := F.slot.isLt + have ha := a.isLt + have hv : F.slot.val = (a.val + 1) % 3 ∨ + F.slot.val = (a.val + 2) % 3 := by omega + rcases hv with h | h + · exact Or.inl (Fin.ext (by simpa [Fin.val_add] using h)) + · exact Or.inr (Fin.ext (by simpa [Fin.val_add] using h)) + rcases hslots with hslot | hslot + · obtain ⟨G, _, _, houter, htile, hfunction⟩ := + P4549T1DeeperFrameB F D a p hp hstep hslot t ht ht0 ht1 + (olderChart hslot) J hfamily hodo hcent + have hqE : F.q (a + 2).succ = p 3 := by simpa using congrFun hstep 3 + have hposE : 0 < (F.q (a + 2).succ).1 := by + rw [hqE, ← ht0] + exact (ProperBandCurvatureStructure t ht).1 + have hancestorG : AncestorOdometer G.outer.1.1 F.outer.1.1 + G.tile F.tile G.odometer F.odometer := by + rw [houter, htile, hfunction] + exact D.ancestors (a + 2) true hposE + obtain ⟨H, _, _, houterH, htileH, hfunctionH⟩ := + P4536T1AFrameB F D a p hp hstep hslot (hB hslot) J hfamily hodo hcent + have hancestorH : AncestorOdometer H.outer.1.1 F.outer.1.1 + H.tile F.tile H.odometer F.odometer := by + rw [houterH, htileH, hfunctionH] + exact hancA + exact ⟨⟨J, hcells, hodo, hanc, hocc, + .recursive G (a + 2) houter hancestorG, + .recursive H a houterH hancestorH⟩⟩ + · obtain ⟨G, _, _, houter, htile, hfunction⟩ := + P4536T1AFrameD F D a p hp hstep hslot (hD hslot) J hfamily hodo hcent + have hancestor : AncestorOdometer G.outer.1.1 F.outer.1.1 + G.tile F.tile G.odometer F.odometer := by + rw [houter, htile, hfunction] + exact hancA + have hqB : F.q (a + 1).succ = p 2 := by simpa using congrFun hstep 2 + have hqE : F.q (a + 2).succ = p 3 := by simpa using congrFun hstep 3 + have htC : t 0 = C.1.1 := by + rw [ht0, ← hqE, ← hslot] + exact F.parent + have idx : a + 2 + 2 = a + 1 := by fin_cases a <;> rfl + have hrightCent : TileCentroid Rplus - TileCentroid J = + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (t 0) (t 1)) := by + rw [hcent] + simpa only [hslot, idx, hqE, hqB, ht0, ht1] using hright + have hrightDiff : F.plus_slope - s = + GaussianRealPoint (-(⟨0, 1⟩ : GaussianInt) * BandVectors.2 (t 0) (t 1)) := by + simpa only [hslot, idx, hqE, hqB, ht0, ht1] using hrightSlope + obtain ⟨hstring, hlink⟩ := P4549T1NegativeIncomingSide t ht htC + base J Rplus (D.functions F.slot false) hplus F.base_band hfamily F.plus_family + hodo F.plus_odo s F.plus_slope hs F.slope_plus hrightCent hrightDiff + exact ⟨⟨J, hcells, hodo, hanc, hocc, + .recursive G a houter hancestor, .direct hstring hlink⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean new file mode 100644 index 0000000000..9f8eb3b92c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean @@ -0,0 +1,1540 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily +public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointAlgebra +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P4536T1AFrameB] + +/-! +# P4536T1AFrameB + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace AFrameBProof + +private theorem hr : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + ProperBandQuadruple r := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r + have rot : ∀ j : Fin 3, ProperBandQuadruple + ![F.q 0, F.q j.succ, F.q (j + 1).succ, F.q (j + 2).succ] := by + intro j + fin_cases j + · convert F.proper using 1; funext k; fin_cases k <;> rfl + · refine ⟨SemiProperQuadruple.rotate F.proper.1, ?_⟩ + intro k + fin_cases k + · exact F.proper.2 1 + · exact F.proper.2 2 + · exact F.proper.2 0 + · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate F.proper.1), ?_⟩ + intro k + fin_cases k + · exact F.proper.2 2 + · exact F.proper.2 0 + · exact F.proper.2 1 + exact rot a + +private theorem hcentJ : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q + (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : + ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : + Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 + : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p + (3 : Fin (4 : ℕ))]) → ((F.slot = a + (1 : Fin (3 : ℕ))) → (∀ (J : ProtoTile), + (TileCentroid J = TileCentroid (D.tiles F.slot false)) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ((r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p + 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2)) → ((r 1 = p 0) → ((r 2 = p 2) → ((r 3 = p 3) + → ((r 2 = C.1.1) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (r 3) (r 2) + let x := BandVectors.1 (r 1) (r 3) + let y := BandVectors.1 (r 2) (r 1) + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : + Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r + j.succ) (r (0 : Fin (4 : ℕ))))) → ((SemiProperQuadruple ![r 0, r 2, r 3, r 1]) → + ((BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : + ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), + r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : + ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), + r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : + ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : + ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple ![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r + (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : + Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 : Fin + (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : + ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = + -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : + Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r + (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → ((BandVectors.1 (r 2) (r + 0) = y - I * w) → ((BandVectors.2 (r 2) (r 0) = ya + I * wa) → ((BandVectors.1 (r 0) (r + 2) = I * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → + ((BandVectors.1 (p 0) (p 2) = I * y) → ((BandVectors.2 (p 0) (p 2) = -I * ya) → ((-(w - I + * w) - (x - I * y - I * (x - I * y)) = (2 : GaussianInt) * y ∧ x - I * y + I * (x - I * + y) + (w - I * w) = (2 : GaussianInt) * I * x ∧ -(x - I * x) - (w - I * w) = y - I * y ∧ y + - I * w + I * (y - I * w) - (w - I * w) = y + I * y ∧ w - I * x - I * (w - I * x) - (w - + I * w) = -I * x - x ∧ -(y - I * y) - (w - I * w) = -I * x + x ∧ y - I * w - I * (y - I * + w) - (y - I * y) = -I * w - w ∧ -(x - I * x) - (y - I * y) = -I * w + w ∧ -(y - I * y) - + (x - I * x) = w - I * w ∧ w - I * x + I * (w - I * x) - (x - I * x) = w + I * w) → ((-(wa + - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya + + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - + (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya + + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - + -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - + -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I + * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * + xa) = wa + -I * wa) → ((-(xa - -I * xa) - (wa - -I * wa) = ya - -I * ya) → ((ya - -I * wa + + -I * (ya - -I * wa) - (wa - -I * wa) = ya + -I * ya) → ((BandVectors.1 (r 0) (r 2) = I + * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → (TileCentroid J - + TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * + x)))))))))))))))))))))))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J hcent r hr hcoord hA + hB hE hparent I w x y wa xa ya laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird + aFourth vflip aflip + have h := (D.occurrences F.slot false).2.2 + rw [hslot] at h + rw [hslot] at hcent + rw [← hcent] at h + fin_cases a <;> simp? [r, I, x] at h ⊢ + all_goals + rw [h] + ext <;> simp [GaussianRealPoint, + Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring + +private theorem hcentR : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q + (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : + ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : + Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 + : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p + (3 : Fin (4 : ℕ))]) → ((F.slot = a + (1 : Fin (3 : ℕ))) → (∀ (J : ProtoTile), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ((r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p + 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2)) → ((r 1 = p 0) → ((r 2 = p 2) → ((r 3 = p 3) + → ((r 2 = C.1.1) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (r 3) (r 2) + let x := BandVectors.1 (r 1) (r 3) + let y := BandVectors.1 (r 2) (r 1) + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : + Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r + j.succ) (r (0 : Fin (4 : ℕ))))) → ((SemiProperQuadruple ![r 0, r 2, r 3, r 1]) → + ((BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : + ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), + r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : + ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), + r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : + ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : + ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple ![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r + (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : + Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 : Fin + (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : + ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = + -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : + Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r + (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → ((BandVectors.1 (r 2) (r + 0) = y - I * w) → ((BandVectors.2 (r 2) (r 0) = ya + I * wa) → ((BandVectors.1 (r 0) (r + 2) = I * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → + ((BandVectors.1 (p 0) (p 2) = I * y) → ((BandVectors.2 (p 0) (p 2) = -I * ya) → ((-(w - I + * w) - (x - I * y - I * (x - I * y)) = (2 : GaussianInt) * y ∧ x - I * y + I * (x - I * + y) + (w - I * w) = (2 : GaussianInt) * I * x ∧ -(x - I * x) - (w - I * w) = y - I * y ∧ y + - I * w + I * (y - I * w) - (w - I * w) = y + I * y ∧ w - I * x - I * (w - I * x) - (w - + I * w) = -I * x - x ∧ -(y - I * y) - (w - I * w) = -I * x + x ∧ y - I * w - I * (y - I * + w) - (y - I * y) = -I * w - w ∧ -(x - I * x) - (y - I * y) = -I * w + w ∧ -(y - I * y) - + (x - I * x) = w - I * w ∧ w - I * x + I * (w - I * x) - (x - I * x) = w + I * w) → ((-(wa + - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya + + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - + (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya + + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - + -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - + -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I + * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * + xa) = wa + -I * wa) → ((-(xa - -I * xa) - (wa - -I * wa) = ya - -I * ya) → ((ya - -I * wa + + -I * (ya - -I * wa) - (wa - -I * wa) = ya + -I * ya) → ((BandVectors.1 (r 0) (r 2) = I + * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → ((TileCentroid J - + TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * x))) → ((TileCentroid + (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (w - I * w)) → + (TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint ((y - I * w) + + I * (y - I * w))))))))))))))))))))))))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J r hr hcoord hA hB hE + hparent I w x y wa xa ya laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird + aFourth vflip aflip hcentJ hcentK + have h := F.plus_centroid + rw [hslot] at h + fin_cases a + all_goals + simp? [] at h ⊢ + have hv' := hv + have vf' := vflip + simp? [r] at hv' vf' + rw [hv', vf'] at h + simpa [y, w, I, r, GaussianRealPoint, + Zsqrtd.re_mul, Zsqrtd.im_mul] using h + +private theorem hcentJK : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (J : ProtoTile), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (r 3) (r 2) + let x := BandVectors.1 (r 1) (r 3) + let y := BandVectors.1 (r 2) (r 1) + (-(w - I * w) - (x - I * y - I * (x - I * y)) = (2 : GaussianInt) * y ∧ x - I * y + I * (x - + I * y) + (w - I * w) = (2 : GaussianInt) * I * x ∧ -(x - I * x) - (w - I * w) = y - I * y + ∧ y - I * w + I * (y - I * w) - (w - I * w) = y + I * y ∧ w - I * x - I * (w - I * x) - + (w - I * w) = -I * x - x ∧ -(y - I * y) - (w - I * w) = -I * x + x ∧ y - I * w - I * (y - + I * w) - (y - I * y) = -I * w - w ∧ -(x - I * x) - (y - I * y) = -I * w + w ∧ -(y - I * + y) - (x - I * x) = w - I * w ∧ w - I * x + I * (w - I * x) - (x - I * x) = w + I * w) → ( + let halfPoint : GaussianInt → ℝ × ℝ := + fun z => (1 / 2 : ℝ) • GaussianRealPoint z + (∀ (u : GaussianInt), ∀ (v : GaussianInt), halfPoint u - halfPoint v = halfPoint (u - v)) → + ((TileCentroid J - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * x))) + → ((TileCentroid (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint + (w - I * w)) → (TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • + GaussianRealPoint (y - I * y))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a J r I w x y vAlg halfPoint + halfPoint_sub hcentJ hcentK + have h := vAlg.2.2.1 + calc + _ = (TileCentroid J - TileCentroid F.tile) - + (TileCentroid (D.tiles a true) - TileCentroid F.tile) := by abel + _ = _ := by + rw [hcentJ, hcentK] + change halfPoint (-(x - I * x)) - halfPoint (w - I * w) = _ + rw [halfPoint_sub, vAlg.2.2.1] + +private theorem hcentRK : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (r 3) (r 2) + let x := BandVectors.1 (r 1) (r 3) + let y := BandVectors.1 (r 2) (r 1) + (-(w - I * w) - (x - I * y - I * (x - I * y)) = (2 : GaussianInt) * y ∧ x - I * y + I * (x - + I * y) + (w - I * w) = (2 : GaussianInt) * I * x ∧ -(x - I * x) - (w - I * w) = y - I * y + ∧ y - I * w + I * (y - I * w) - (w - I * w) = y + I * y ∧ w - I * x - I * (w - I * x) - + (w - I * w) = -I * x - x ∧ -(y - I * y) - (w - I * w) = -I * x + x ∧ y - I * w - I * (y - + I * w) - (y - I * y) = -I * w - w ∧ -(x - I * x) - (y - I * y) = -I * w + w ∧ -(y - I * + y) - (x - I * x) = w - I * w ∧ w - I * x + I * (w - I * x) - (x - I * x) = w + I * w) → ( + let halfPoint : GaussianInt → ℝ × ℝ := + fun z => (1 / 2 : ℝ) • GaussianRealPoint z + (∀ (u : GaussianInt), ∀ (v : GaussianInt), halfPoint u - halfPoint v = halfPoint (u - v)) → + ((TileCentroid (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint + (w - I * w)) → ((TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • + GaussianRealPoint ((y - I * w) + I * (y - I * w))) → (TileCentroid Rplus - TileCentroid + (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint (y + I * y))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a r I w x y vAlg halfPoint halfPoint_sub + hcentK hcentR + calc + _ = (TileCentroid Rplus - TileCentroid F.tile) - + (TileCentroid (D.tiles a true) - TileCentroid F.tile) := by abel + _ = _ := by + rw [hcentR, hcentK] + change halfPoint ((y - I * w) + I * (y - I * w)) - + halfPoint (w - I * w) = _ + rw [halfPoint_sub, vAlg.2.2.2.1] + +private theorem hslopeJ : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q + (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : + ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : + Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 + : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p + (3 : Fin (4 : ℕ))]) → ((F.slot = a + (1 : Fin (3 : ℕ))) → (∀ (J : ProtoTile), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ((r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p + 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2)) → ((r 1 = p 0) → ((r 2 = p 2) → ((r 3 = p 3) + → ((r 2 = C.1.1) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (r 3) (r 2) + let x := BandVectors.1 (r 1) (r 3) + let y := BandVectors.1 (r 2) (r 1) + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : + Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r + j.succ) (r (0 : Fin (4 : ℕ))))) → ((SemiProperQuadruple ![r 0, r 2, r 3, r 1]) → + ((BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : + ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), + r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : + ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), + r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : + ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : + ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple ![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r + (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : + Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 : Fin + (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : + ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = + -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : + Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r + (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → ((BandVectors.1 (r 2) (r + 0) = y - I * w) → ((BandVectors.2 (r 2) (r 0) = ya + I * wa) → ((BandVectors.1 (r 0) (r + 2) = I * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → + ((BandVectors.1 (p 0) (p 2) = I * y) → ((BandVectors.2 (p 0) (p 2) = -I * ya) → ((-(w - I + * w) - (x - I * y - I * (x - I * y)) = (2 : GaussianInt) * y ∧ x - I * y + I * (x - I * + y) + (w - I * w) = (2 : GaussianInt) * I * x ∧ -(x - I * x) - (w - I * w) = y - I * y ∧ y + - I * w + I * (y - I * w) - (w - I * w) = y + I * y ∧ w - I * x - I * (w - I * x) - (w - + I * w) = -I * x - x ∧ -(y - I * y) - (w - I * w) = -I * x + x ∧ y - I * w - I * (y - I * + w) - (y - I * y) = -I * w - w ∧ -(x - I * x) - (y - I * y) = -I * w + w ∧ -(y - I * y) - + (x - I * x) = w - I * w ∧ w - I * x + I * (w - I * x) - (x - I * x) = w + I * w) → ((-(wa + - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya + + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - + (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya + + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - + -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - + -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I + * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * + xa) = wa + -I * wa) → ((-(xa - -I * xa) - (wa - -I * wa) = ya - -I * ya) → ((ya - -I * wa + + -I * (ya - -I * wa) - (wa - -I * wa) = ya + -I * ya) → ((BandVectors.1 (r 0) (r 2) = I + * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → ((TileCentroid J - + TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * x))) → ((TileCentroid + (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (w - I * w)) → + ((TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint ((y - I * w) + + I * (y - I * w))) → ((TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • + GaussianRealPoint (y - I * y)) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = + (1 / 2 : ℝ) • GaussianRealPoint (y + I * y)) → ((TileOdometer (p 0) (D.tiles a true) + (D.functions a true)) → ((BandPrototile (p 0) (D.tiles a true)) → ((F.q a.succ = p 0) → + ((F.q ((a + 1).succ) = p 2) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = (1 / + 2 : ℝ) • GaussianRealPoint (BandVectors.1 (p 2) (p 0) + BandVectors.1 (p 0) (p 2))) → (∀ + (sJ : ℝ × ℝ), (sJ.1 - F.outer_slope.1 = (if false = true then (1 : ℝ) else (-1 : ℝ)) + * (1 + / 2 : ℝ) * ((↑(BandVectors.2 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : + Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) + (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sJ.2 - F.outer_slope.2 = (if false + = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (F.slot + (2 : + Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 + (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).re : + ℝ))) → ((0 < (F.q a.succ).1) → (∀ (sA : ℝ × ℝ), (PartialOdometerSlope (D.functions a + true) = some sA) → ((sA.1 - F.outer_slope.1 = (if true = true then (1 : ℝ) else (-1 : ℝ)) + * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin + (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sA.2 - F.outer_slope.2 = (if true = true then (1 + : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) + (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : + ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (sJ - F.outer_slope = (1 / 2 : + ℝ) • GaussianRealPoint (-(xa - (-I) * xa))))))))))))))))))))))))))))))))))))))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J r hr hcoord hA hB hE + hparent I w x y wa xa ya laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird + aFourth vflip aflip hcentJ hcentK hcentR hcentJK hcentRK hodoK hbandK hAcoord hBcoord + hcentRnew sJ hreJ himJ hqapos sA hsA hreA himA + have hJvec : BandVectors.2 (F.q ((F.slot + 2).succ)) + (F.q ((F.slot + 1).succ)) = xa := by + rw [hslot] + fin_cases a <;> simp [r, xa] + rw [hJvec] at hreJ himJ + have h1 : sJ.1 - F.outer_slope.1 = + -1 * (1 / 2 : ℝ) * ((xa.re : ℝ) - (xa.im : ℝ)) := by + simpa using hreJ + have h2 : sJ.2 - F.outer_slope.2 = + -1 * (1 / 2 : ℝ) * ((xa.im : ℝ) + (xa.re : ℝ)) := by + simpa using himJ + apply Prod.ext + · change sJ.1 - F.outer_slope.1 = + (1 / 2 : ℝ) * ((-(xa - (-I) * xa)).re : ℝ) + rw [h1] + simp [I, xa, Zsqrtd.re_mul] + ring + · change sJ.2 - F.outer_slope.2 = + (1 / 2 : ℝ) * ((-(xa - (-I) * xa)).im : ℝ) + rw [h2] + simp [I, xa, Zsqrtd.im_mul] + ring + +private theorem hslopeA : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q + (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : + ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : + Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 + : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p + (3 : Fin (4 : ℕ))]) → ((F.slot = a + (1 : Fin (3 : ℕ))) → (∀ (J : ProtoTile), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ((r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p + 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2)) → ((r 1 = p 0) → ((r 2 = p 2) → ((r 3 = p 3) + → ((r 2 = C.1.1) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (r 3) (r 2) + let x := BandVectors.1 (r 1) (r 3) + let y := BandVectors.1 (r 2) (r 1) + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : + Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r + j.succ) (r (0 : Fin (4 : ℕ))))) → ((SemiProperQuadruple ![r 0, r 2, r 3, r 1]) → + ((BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : + ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), + r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : + ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), + r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : + ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : + ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple ![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r + (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : + Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 : Fin + (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : + ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = + -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : + Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r + (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → ((BandVectors.1 (r 2) (r + 0) = y - I * w) → ((BandVectors.2 (r 2) (r 0) = ya + I * wa) → ((BandVectors.1 (r 0) (r + 2) = I * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → + ((BandVectors.1 (p 0) (p 2) = I * y) → ((BandVectors.2 (p 0) (p 2) = -I * ya) → ((-(w - I + * w) - (x - I * y - I * (x - I * y)) = (2 : GaussianInt) * y ∧ x - I * y + I * (x - I * + y) + (w - I * w) = (2 : GaussianInt) * I * x ∧ -(x - I * x) - (w - I * w) = y - I * y ∧ y + - I * w + I * (y - I * w) - (w - I * w) = y + I * y ∧ w - I * x - I * (w - I * x) - (w - + I * w) = -I * x - x ∧ -(y - I * y) - (w - I * w) = -I * x + x ∧ y - I * w - I * (y - I * + w) - (y - I * y) = -I * w - w ∧ -(x - I * x) - (y - I * y) = -I * w + w ∧ -(y - I * y) - + (x - I * x) = w - I * w ∧ w - I * x + I * (w - I * x) - (x - I * x) = w + I * w) → ((-(wa + - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya + + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - + (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya + + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - + -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - + -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I + * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * + xa) = wa + -I * wa) → ((-(xa - -I * xa) - (wa - -I * wa) = ya - -I * ya) → ((ya - -I * wa + + -I * (ya - -I * wa) - (wa - -I * wa) = ya + -I * ya) → ((BandVectors.1 (r 0) (r 2) = I + * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → ((TileCentroid J - + TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * x))) → ((TileCentroid + (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (w - I * w)) → + ((TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint ((y - I * w) + + I * (y - I * w))) → ((TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • + GaussianRealPoint (y - I * y)) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = + (1 / 2 : ℝ) • GaussianRealPoint (y + I * y)) → ((TileOdometer (p 0) (D.tiles a true) + (D.functions a true)) → ((BandPrototile (p 0) (D.tiles a true)) → ((F.q a.succ = p 0) → + ((F.q ((a + 1).succ) = p 2) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = (1 / + 2 : ℝ) • GaussianRealPoint (BandVectors.1 (p 2) (p 0) + BandVectors.1 (p 0) (p 2))) → (∀ + (sJ : ℝ × ℝ), (0 < (F.q a.succ).1) → (∀ (sA : ℝ × ℝ), (PartialOdometerSlope (D.functions + a true) = some sA) → ((sA.1 - F.outer_slope.1 = (if true = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : + Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q + (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sA.2 - F.outer_slope.2 = (if true = true + then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : + ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + (2 : + Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((sJ - F.outer_slope + = (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa))) → (sA - F.outer_slope = (1 / 2 : + ℝ) • GaussianRealPoint (wa - (-I) * wa))))))))))))))))))))))))))))))))))))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J r hr hcoord hA hB hE + hparent I w x y wa xa ya laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird + aFourth vflip aflip hcentJ hcentK hcentR hcentJK hcentRK hodoK hbandK hAcoord hBcoord + hcentRnew sJ hqapos sA hsA hreA himA hslopeJ + have hslotvec : BandVectors.2 (F.q ((a + 2).succ)) + (F.q ((a + 1).succ)) = wa := by + fin_cases a <;> simp [r, wa] + have h1 := hreA + have h2 := himA + have h1 : sA.1 - F.outer_slope.1 = (1 / 2 : ℝ) * + (((BandVectors.2 (F.q ((a + 2).succ)) + (F.q ((a + 1).succ))).re : ℤ) - + ((BandVectors.2 (F.q ((a + 2).succ)) + (F.q ((a + 1).succ))).im : ℤ)) := by + simpa using hreA + have h2 : sA.2 - F.outer_slope.2 = (1 / 2 : ℝ) * + (((BandVectors.2 (F.q ((a + 2).succ)) + (F.q ((a + 1).succ))).im : ℤ) + + ((BandVectors.2 (F.q ((a + 2).succ)) + (F.q ((a + 1).succ))).re : ℤ)) := by + simpa using himA + rw [hslotvec] at h1 h2 + apply Prod.ext + · simp? [GaussianRealPoint, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h1 ⊢ + exact_mod_cast h1 + · simp? [GaussianRealPoint, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h2 ⊢ + exact_mod_cast h2 + +private theorem hminusSlope : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + (-(xa - -I * xa) - (wa - -I * wa) = ya - -I * ya) → (∀ (sJ : ℝ × ℝ), ∀ (sA : ℝ × ℝ), (sJ - + F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa))) → ((sA - + F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (wa - (-I) * wa)) → (sJ - sA = (1 / 2 : + ℝ) • GaussianRealPoint (ya - (-I) * ya)))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r I wa xa ya aThird sJ sA hslopeJ hslopeA + calc + _ = (sJ - F.outer_slope) - (sA - F.outer_slope) := by abel + _ = _ := by + rw [hslopeJ, hslopeA] + have h := congrArg (fun z : GaussianInt => + (1 / 2 : ℝ) • GaussianRealPoint z) aThird + simp [GaussianRealPoint, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ + constructor <;> nlinarith + +private theorem hplusSlopeRoot : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q + (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : + ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : + Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 + : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p + (3 : Fin (4 : ℕ))]) → ((F.slot = a + (1 : Fin (3 : ℕ))) → (∀ (J : ProtoTile), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ((r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p + 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2)) → ((r 1 = p 0) → ((r 2 = p 2) → ((r 3 = p 3) + → ((r 2 = C.1.1) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (r 3) (r 2) + let x := BandVectors.1 (r 1) (r 3) + let y := BandVectors.1 (r 2) (r 1) + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : + Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r + j.succ) (r (0 : Fin (4 : ℕ))))) → ((SemiProperQuadruple ![r 0, r 2, r 3, r 1]) → + ((BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : + ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), + r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : + ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), + r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : + ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : + Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin + (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : + ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple ![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r + (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : + Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 : Fin + (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : + ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin + (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (![r (0 : Fin (4 : ℕ)), + r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 + : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = + -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : + Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r + (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → ((BandVectors.1 (r 2) (r + 0) = y - I * w) → ((BandVectors.2 (r 2) (r 0) = ya + I * wa) → ((BandVectors.1 (r 0) (r + 2) = I * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → + ((BandVectors.1 (p 0) (p 2) = I * y) → ((BandVectors.2 (p 0) (p 2) = -I * ya) → ((-(w - I + * w) - (x - I * y - I * (x - I * y)) = (2 : GaussianInt) * y ∧ x - I * y + I * (x - I * + y) + (w - I * w) = (2 : GaussianInt) * I * x ∧ -(x - I * x) - (w - I * w) = y - I * y ∧ y + - I * w + I * (y - I * w) - (w - I * w) = y + I * y ∧ w - I * x - I * (w - I * x) - (w - + I * w) = -I * x - x ∧ -(y - I * y) - (w - I * w) = -I * x + x ∧ y - I * w - I * (y - I * + w) - (y - I * y) = -I * w - w ∧ -(x - I * x) - (y - I * y) = -I * w + w ∧ -(y - I * y) - + (x - I * x) = w - I * w ∧ w - I * x + I * (w - I * x) - (x - I * x) = w + I * w) → ((-(wa + - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya + + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - + (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya + + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - + -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - + -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I + * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * + xa) = wa + -I * wa) → ((-(xa - -I * xa) - (wa - -I * wa) = ya - -I * ya) → ((ya - -I * wa + + -I * (ya - -I * wa) - (wa - -I * wa) = ya + -I * ya) → ((BandVectors.1 (r 0) (r 2) = I + * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → ((TileCentroid J - + TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * x))) → ((TileCentroid + (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (w - I * w)) → + ((TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint ((y - I * w) + + I * (y - I * w))) → ((TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • + GaussianRealPoint (y - I * y)) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = + (1 / 2 : ℝ) • GaussianRealPoint (y + I * y)) → ((TileOdometer (p 0) (D.tiles a true) + (D.functions a true)) → ((BandPrototile (p 0) (D.tiles a true)) → ((F.q a.succ = p 0) → + ((F.q ((a + 1).succ) = p 2) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = (1 / + 2 : ℝ) • GaussianRealPoint (BandVectors.1 (p 2) (p 0) + BandVectors.1 (p 0) (p 2))) → (∀ + (sJ : ℝ × ℝ), (0 < (F.q a.succ).1) → (∀ (sA : ℝ × ℝ), (PartialOdometerSlope (D.functions + a true) = some sA) → ((sA.1 - F.outer_slope.1 = (if true = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : + Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q + (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sA.2 - F.outer_slope.2 = (if true = true + then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : + ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + (2 : + Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((sJ - F.outer_slope + = (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa))) → ((sA - F.outer_slope = (1 / 2 : + ℝ) • GaussianRealPoint (wa - (-I) * wa)) → ((sJ - sA = (1 / 2 : ℝ) • GaussianRealPoint + (ya - (-I) * ya)) → (F.plus_slope - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (ya + + I * wa + (-I) * (ya + I * wa)))))))))))))))))))))))))))))))))))))))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J r hr hcoord hA hB hE + hparent I w x y wa xa ya laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird + aFourth vflip aflip hcentJ hcentK hcentR hcentJK hcentRK hodoK hbandK hAcoord hBcoord + hcentRnew sJ hqapos sA hsA hreA himA hslopeJ hslopeA hminusSlope + have h := F.plus_difference + rw [hslot] at h + fin_cases a + all_goals + have hIn := ha + have hFlip := hflipa + simp? [r] at hIn hFlip h ⊢ + rw [hIn, hFlip] at h + simpa [I, ya, wa, GaussianRealPoint, Zsqrtd.re_mul, + Zsqrtd.im_mul] using h + +private theorem hplusSlope : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let wa := BandVectors.2 (r 3) (r 2) + let ya := BandVectors.2 (r 2) (r 1) + let halfPoint : GaussianInt → ℝ × ℝ := + fun z => (1 / 2 : ℝ) • GaussianRealPoint z + (∀ (u : GaussianInt), ∀ (v : GaussianInt), halfPoint u - halfPoint v = halfPoint (u - v)) → + (∀ (sA : ℝ × ℝ), (sA - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (wa - (-I) * wa)) + → ((F.plus_slope - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (ya + I * wa + (-I) * + (ya + I * wa))) → (((ya + I * wa + (-I) * (ya + I * wa)) - (wa - (-I) * wa) = ya + (-I) * + ya) → (F.plus_slope - sA = (1 / 2 : ℝ) • GaussianRealPoint (ya + (-I) * ya))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r I wa ya halfPoint halfPoint_sub sA + hslopeA hplusSlopeRoot hplusDelta + calc + _ = (F.plus_slope - F.outer_slope) - (sA - F.outer_slope) := by abel + _ = halfPoint + ((ya + I * wa + (-I) * (ya + I * wa)) - + (wa - (-I) * wa)) := by + rw [hplusSlopeRoot, hslopeA] + change halfPoint (ya + I * wa + (-I) * (ya + I * wa)) - + halfPoint (wa - (-I) * wa) = _ + exact halfPoint_sub _ _ + _ = halfPoint (ya + (-I) * ya) := by rw [hplusDelta] + _ = _ := rfl + +end AFrameBProof + +namespace AFrameBDetails + +private theorem hcoord : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 + : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : + ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 + : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : + Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p + 3).2 - (p 1).2)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hstep r + have := congrFun hstep 0 + simpa [r] using this + +private theorem hA : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 + : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : + ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 + : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : + Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + r 1 = p 0) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hstep r + have := congrFun hstep 1 + simpa [r] using this + +private theorem hB : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 + : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : + ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 + : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : + Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + r 2 = p 2) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hstep r + have := congrFun hstep 2 + simpa [r] using this + +private theorem hE : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 + : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : + ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 + : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : + Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + r 3 = p 3) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hstep r + have := congrFun hstep 3 + simpa [r] using this + +private theorem hparent : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 + : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : + ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 + : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : + Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ((F.slot = a + (1 : Fin (3 : + ℕ))) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ((r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p + 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2)) → ((r 1 = p 0) → ((r 2 = p 2) → ((r 3 = p 3) + → (r 2 = C.1.1))))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hstep hslot r hr hcoord hA hB hE + rw [← F.parent, hslot] + fin_cases a <;> simp [r] + +private theorem hflipv : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (r 3) (r 2) + let y := BandVectors.1 (r 2) (r 1) + (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : + Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r + j.succ) (r (0 : Fin (4 : ℕ))))) → ((BandVectors.1 (r 2) (r 0) = y - I * w) → + (BandVectors.1 (r 0) (r 2) = I * (y - I * w)))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r hr I w y laws hv + have h := (laws.2.2.2.2 hr 1).1 + simpa [I, hv] using h + +private theorem hflipa : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ( + let I : GaussianInt := ⟨0, 1⟩ + let wa := BandVectors.2 (r 3) (r 2) + let ya := BandVectors.2 (r 2) (r 1) + (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : + Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r + j.succ) (r (0 : Fin (4 : ℕ))))) → ((BandVectors.2 (r 2) (r 0) = ya + I * wa) → + (BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r hr I wa ya laws ha + have h := (laws.2.2.2.2 hr 1).2 + simpa [I, ha] using h + +private theorem hvp : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (r 1 = p 0) → ((r 2 = p 2) → ( + let I : GaussianInt := ⟨0, 1⟩ + let y := BandVectors.1 (r 2) (r 1) + BandVectors.1 (p 0) (p 2) = I * y))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hp r hA hB I y + have h := VectorRecursionLaws p hp.1 + have hf := (h.2.2.2.2 hp 1).1 + simpa [I, y, r, hA, hB] using hf + +private theorem hap : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (r 1 = p 0) → ((r 2 = p 2) → ( + let I : GaussianInt := ⟨0, 1⟩ + let ya := BandVectors.2 (r 2) (r 1) + BandVectors.2 (p 0) (p 2) = -I * ya))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hp r hA hB I ya + have h := VectorRecursionLaws p hp.1 + have hf := (h.2.2.2.2 hp 1).2 + simpa [I, ya, r, hA, hB] using hf + +private theorem vflip : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ( + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (r 3) (r 2) + let y := BandVectors.1 (r 2) (r 1) + (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : + Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r + j.succ) (r (0 : Fin (4 : ℕ))))) → ((BandVectors.1 (r 2) (r 0) = y - I * w) → + (BandVectors.1 (r 0) (r 2) = I * (y - I * w)))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r hr I w y laws hv + have h := (laws.2.2.2.2 hr 1).1 + simpa [I, hv] using h + +private theorem aflip : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ( + let I : GaussianInt := ⟨0, 1⟩ + let wa := BandVectors.2 (r 3) (r 2) + let ya := BandVectors.2 (r 2) (r 1) + (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : + Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r + j.succ) (r (0 : Fin (4 : ℕ))))) → ((BandVectors.2 (r 2) (r 0) = ya + I * wa) → + (BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r hr I wa ya laws ha + have h := (laws.2.2.2.2 hr 1).2 + simpa [I, ha] using h + +private theorem halfPoint_sub : + let halfPoint : GaussianInt → ℝ × ℝ := + fun z => (1 / 2 : ℝ) • GaussianRealPoint z + ∀ (u : GaussianInt), ∀ (v : GaussianInt), halfPoint u - halfPoint v = halfPoint (u - v) := by + classical + intro halfPoint u v + apply Prod.ext <;> simp [halfPoint, GaussianRealPoint] <;> ring + +private theorem hcentK : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (r 3) (r 2) + TileCentroid (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (w - I + * w) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a r I w + have h := (D.occurrences a true).2.2 + simp? [r, I, w] at h ⊢ + rw [h] + ext <;> simp [GaussianRealPoint, Zsqrtd.re_mul, Zsqrtd.im_mul] + +private theorem hodoK : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (r 1 = p 0) → (TileOdometer (p 0) (D.tiles a true) (D.functions a true)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p r hA + have hqa : F.q a.succ = p 0 := by simpa [r] using hA + rw [← hqa] + exact D.odometers a true + +private theorem hcentRnew : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (r 1 = p 0) → ((r 2 = p 2) → ( + let I : GaussianInt := ⟨0, 1⟩ + let y := BandVectors.1 (r 2) (r 1) + (BandVectors.1 (p 0) (p 2) = I * y) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = + (1 / 2 : ℝ) • GaussianRealPoint (y + I * y)) → (TileCentroid Rplus - TileCentroid + (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (p 2) (p 0) + + BandVectors.1 (p 0) (p 2)))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p r hA hB I y hvp hcentRK + have h := hcentRK + rw [← hvp] at h + simpa [y, r, hA, hB] using h + +private theorem hqapos : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (r 1 = p 0) → ((0 < (p 0).1) → (0 < (F.q a.succ).1)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r hA hposA + have hqa : F.q a.succ = p 0 := by simpa [r] using hA + rw [hqa] + exact hposA + +private theorem hplusDelta : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let wa := BandVectors.2 (r 3) (r 2) + let ya := BandVectors.2 (r 2) (r 1) + (ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya + -I * ya) → ((ya + I * wa + (-I) * + (ya + I * wa)) - (wa - (-I) * wa) = ya + (-I) * ya) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r I wa ya aFourth + convert aFourth using 1; ring + +private theorem hya : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let ya := BandVectors.2 (r 2) (r 1) + (F.q a.succ = p 0) → ((F.q ((a + 1).succ) = p 2) → (BandVectors.2 (p 2) (p 0) = ya)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r ya hAcoord hBcoord + dsimp [ya, r] + rw [hBcoord, hAcoord] + +private theorem hplusVec : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let ya := BandVectors.2 (r 2) (r 1) + (BandVectors.2 (p 0) (p 2) = -I * ya) → ((BandVectors.2 (p 2) (p 0) = ya) → (BandVectors.2 (p + 2) (p 0) + BandVectors.2 (p 0) (p 2) = ya + (-I) * ya)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I ya hap hya + rw [hya, hap] + +private theorem hminusVec : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let ya := BandVectors.2 (r 2) (r 1) + (BandVectors.2 (p 0) (p 2) = -I * ya) → ((BandVectors.2 (p 2) (p 0) = ya) → (BandVectors.2 (p + 2) (p 0) - BandVectors.2 (p 0) (p 2) = ya - (-I) * ya)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I ya hap hya + rw [hya, hap] + +private theorem hplusSlopeP : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let ya := BandVectors.2 (r 2) (r 1) + ∀ (sA : ℝ × ℝ), (F.plus_slope - sA = (1 / 2 : ℝ) • GaussianRealPoint (ya + (-I) * ya)) → + ((BandVectors.2 (p 2) (p 0) + BandVectors.2 (p 0) (p 2) = ya + (-I) * ya) → (F.plus_slope + - sA = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p 2) (p 0) + BandVectors.2 (p 0) + (p 2)))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I ya sA hplusSlope hplusVec + let halfPoint : GaussianInt → ℝ × ℝ := + fun z => (1 / 2 : ℝ) • GaussianRealPoint z + calc + _ = halfPoint (ya + (-I) * ya) := by + exact hplusSlope + _ = _ := congrArg halfPoint hplusVec.symm + +private theorem hminusSlopeP : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let ya := BandVectors.2 (r 2) (r 1) + ∀ (sJ : ℝ × ℝ), ∀ (sA : ℝ × ℝ), (sJ - sA = (1 / 2 : ℝ) • GaussianRealPoint (ya - (-I) * ya)) + → ((BandVectors.2 (p 2) (p 0) - BandVectors.2 (p 0) (p 2) = ya - (-I) * ya) → (sJ - sA = + (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p 2) (p 0) - BandVectors.2 (p 0) (p 2)))) + := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I ya sJ sA hminusSlope hminusVec + let halfPoint : GaussianInt → ℝ × ℝ := + fun z => (1 / 2 : ℝ) • GaussianRealPoint z + calc + _ = halfPoint (ya - (-I) * ya) := by + exact hminusSlope + _ = _ := congrArg halfPoint hminusVec.symm + +private theorem hyv : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let y := BandVectors.1 (r 2) (r 1) + (F.q a.succ = p 0) → ((F.q ((a + 1).succ) = p 2) → (BandVectors.1 (p 2) (p 0) = y)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r y hAcoord hBcoord + dsimp [y, r] + rw [hBcoord, hAcoord] + +private theorem hminusCentVec : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let y := BandVectors.1 (r 2) (r 1) + (BandVectors.1 (p 0) (p 2) = I * y) → ((BandVectors.1 (p 2) (p 0) = y) → (BandVectors.1 (p 2) + (p 0) - BandVectors.1 (p 0) (p 2) = y - I * y)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I y hvp hyv + rw [hyv, hvp] + +private theorem hminusCentP : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), ∀ (J : + ProtoTile), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let y := BandVectors.1 (r 2) (r 1) + (TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint (y - I * + y)) → ((BandVectors.1 (p 2) (p 0) - BandVectors.1 (p 0) (p 2) = y - I * y) → + (TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (p 2) (p 0) - BandVectors.1 (p 0) (p 2)))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p J r I y hcentJK hminusCentVec + let halfPoint : GaussianInt → ℝ × ℝ := + fun z => (1 / 2 : ℝ) • GaussianRealPoint z + calc + _ = halfPoint (y - I * y) := by + exact hcentJK + _ = _ := congrArg halfPoint hminusCentVec.symm + +end AFrameBDetails + +theorem P4536T1AFrameB + {C : BandCircle} {orientation : Bool} {base Rminus Rplus : ProtoTile} + {hminus hplus : PartialOdometer} + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) + (D : P4458T1RestrictionFamily F) + (a : Fin 3) (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (hstep : ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3]) + (hslot : F.slot = a + 1) + (hchart : C.1.1.1 = 1 → UnitOccurrenceOrientation p 1 orientation) + (J : ProtoTile) (hfamily : J ∈ RegularTileFamily base (TilingLattice C)) + (hodo : TileOdometer C.1.1 J (D.functions F.slot false)) + (hcent : TileCentroid J = TileCentroid (D.tiles F.slot false)) : + ∃ G : P4458T1BoundaryFrame C orientation base J Rplus + (D.functions F.slot false) hplus, + G.q = p ∧ G.slot = 1 ∧ G.outer.1.1 = F.q a.succ ∧ + G.tile = D.tiles a true ∧ G.odometer = D.functions a true := by +-- BODY + exact (show ∃ G : P4458T1BoundaryFrame C orientation base J Rplus + (D.functions F.slot false) hplus, + G.q = p ∧ G.slot = 1 ∧ G.outer.1.1 = F.q a.succ ∧ + G.tile = D.tiles a true ∧ G.odometer = D.functions a true from by + classical + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + have hr : ProperBandQuadruple r := AFrameBProof.hr C orientation base Rminus Rplus hminus + hplus F a + have hcoord : r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2) := AFrameBDetails.hcoord C + orientation base Rminus Rplus hminus hplus F a p hstep + have hA : r 1 = p 0 := AFrameBDetails.hA C orientation base Rminus Rplus hminus hplus F a p + hstep + have hB : r 2 = p 2 := AFrameBDetails.hB C orientation base Rminus Rplus hminus hplus F a p + hstep + have hE : r 3 = p 3 := AFrameBDetails.hE C orientation base Rminus Rplus hminus hplus F a p + hstep + have hparent : r 2 = C.1.1 := AFrameBDetails.hparent C orientation base Rminus Rplus hminus + hplus F a p hstep hslot hr hcoord hA hB hE + have hpB : p 2 = C.1.1 := hB.symm.trans hparent + have hposA : 0 < (p 0).1 := (ProperBandCurvatureStructure p hp).1 + have hposB : 0 < (p 2).1 := by rw [hpB]; exact C.2 + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (r 3) (r 2) + let x := BandVectors.1 (r 1) (r 3) + let y := BandVectors.1 (r 2) (r 1) + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + have laws := VectorRecursionLaws r hr.1 + have hrot : SemiProperQuadruple ![r 0, r 2, r 3, r 1] := by + exact SemiProperQuadruple.rotate hr.1 + have rlaws := VectorRecursionLaws (![r 0, r 2, r 3, r 1]) hrot + have hv : BandVectors.1 (r 2) (r 0) = y - I * w := by + simpa [I, w, x, y, r] using rlaws.2.2.1 + have ha : BandVectors.2 (r 2) (r 0) = ya + I * wa := by + simpa [I, wa, xa, ya, r] using rlaws.2.2.2.1 + have hflipv : BandVectors.1 (r 0) (r 2) = I * (y - I * w) := AFrameBDetails.hflipv C + orientation base Rminus Rplus hminus hplus F a hr laws hv + have hflipa : BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa) := AFrameBDetails.hflipa C + orientation base Rminus Rplus hminus hplus F a hr laws ha + have hvp : BandVectors.1 (p 0) (p 2) = I * y := AFrameBDetails.hvp C orientation base + Rminus Rplus hminus hplus F a p hp hA hB + have hap : BandVectors.2 (p 0) (p 2) = -I * ya := AFrameBDetails.hap C orientation base + Rminus Rplus hminus hplus F a p hp hA hB + have vAlg := P4536T1EndpointAlgebra I w x y (by decide +kernel) laws.1 + have aAlg := P4536T1EndpointAlgebra (-I) wa xa ya (by decide +kernel) laws.2.1 + have aThird := aAlg.2.2.1 + have aFourth := aAlg.2.2.2.1 + have vflip : BandVectors.1 (r 0) (r 2) = I * (y - I * w) := AFrameBDetails.vflip C + orientation base Rminus Rplus hminus hplus F a hr laws hv + have aflip : BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa) := AFrameBDetails.aflip C + orientation base Rminus Rplus hminus hplus F a hr laws ha + let halfPoint : GaussianInt → ℝ × ℝ := + fun z => (1 / 2 : ℝ) • GaussianRealPoint z + have halfPoint_sub (u v : GaussianInt) : + halfPoint u - halfPoint v = halfPoint (u - v) := AFrameBDetails.halfPoint_sub u v + have hcentJ : TileCentroid J - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * x)) := AFrameBProof.hcentJ C orientation + base Rminus Rplus hminus hplus F D a p hstep hslot J hcent hr hcoord hA hB hE + hparent laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird aFourth vflip + aflip + have hcentK : TileCentroid (D.tiles a true) - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint (w - I * w) := AFrameBDetails.hcentK C orientation base + Rminus Rplus hminus hplus F D a + have hcentR : TileCentroid Rplus - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint ((y - I * w) + I * (y - I * w)) := AFrameBProof.hcentR + C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J hr hcoord hA hB + hE hparent laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird aFourth + vflip aflip hcentJ hcentK + have hcentJK : TileCentroid J - TileCentroid (D.tiles a true) = + (1 / 2 : ℝ) • GaussianRealPoint (y - I * y) := AFrameBProof.hcentJK C orientation base + Rminus Rplus hminus hplus F D a J vAlg halfPoint_sub hcentJ hcentK + have hcentRK : TileCentroid Rplus - TileCentroid (D.tiles a true) = + (1 / 2 : ℝ) • GaussianRealPoint (y + I * y) := AFrameBProof.hcentRK C orientation base + Rminus Rplus hminus hplus F D a vAlg halfPoint_sub hcentK hcentR + let houter : BandCircle := + ⟨⟨p 0, ⟨Or.inl hposA, ⟨p, hp.1, ⟨0, rfl⟩⟩⟩⟩, hposA⟩ + have hodoK : TileOdometer (p 0) (D.tiles a true) (D.functions a true) := + AFrameBDetails.hodoK C orientation base Rminus Rplus hminus hplus F D a p hA + have hbandK : BandPrototile (p 0) (D.tiles a true) := + TileOdometerBandPrototile _ _ _ hodoK + have hparentNew : p 2 = C.1.1 := hpB + have hAcoord : F.q a.succ = p 0 := by simpa [r] using hA + have hBcoord : F.q ((a + 1).succ) = p 2 := by simpa [r] using hB + have hfamilyR : Rplus ∈ RegularTileFamily base (TilingLattice C) := by + exact F.plus_family + have hfamilyJ : J ∈ RegularTileFamily base (TilingLattice C) := by + exact hfamily + have hcentRnew : TileCentroid Rplus - TileCentroid (D.tiles a true) = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (p 2) (p 0) + BandVectors.1 (p 0) (p 2)) := AFrameBDetails.hcentRnew C + orientation base Rminus Rplus hminus hplus F D a p hA hB hvp hcentRK + have hslotpos : 0 < (F.q F.slot.succ).1 := F.parent ▸ C.2 + rcases D.slopes F.slot false with hzJ | ⟨rootJ, sJ, hrootJ, hsJ, hreJ, himJ⟩ + · have : (F.q F.slot.succ).1 = 0 := hzJ + omega + have hrootJeq : rootJ = F.outer_slope := + Option.some.inj (hrootJ.symm.trans F.slope_outer) + subst rootJ + have hqapos : 0 < (F.q a.succ).1 := AFrameBDetails.hqapos C orientation base Rminus Rplus + hminus hplus F a p hA hposA + rcases D.slopes a true with hzA | ⟨rootA, sA, hrootA, hsA, hreA, himA⟩ + · have : (F.q a.succ).1 = 0 := hzA + omega + have hrootAeq : rootA = F.outer_slope := + Option.some.inj (hrootA.symm.trans F.slope_outer) + subst rootA + have hslopeJ : sJ - F.outer_slope = + (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa)) := AFrameBProof.hslopeJ C + orientation base Rminus Rplus hminus hplus F D a p hstep hslot J hr hcoord hA hB hE + hparent laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird aFourth vflip + aflip hcentJ hcentK hcentR hcentJK hcentRK hodoK hbandK hAcoord hBcoord hcentRnew + sJ hreJ himJ hqapos sA hsA hreA himA + have hslopeA : sA - F.outer_slope = + (1 / 2 : ℝ) • GaussianRealPoint (wa - (-I) * wa) := AFrameBProof.hslopeA C orientation + base Rminus Rplus hminus hplus F D a p hstep hslot J hr hcoord hA hB hE hparent + laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird aFourth vflip aflip + hcentJ hcentK hcentR hcentJK hcentRK hodoK hbandK hAcoord hBcoord hcentRnew sJ + hqapos sA hsA hreA himA hslopeJ + have hminusSlope : sJ - sA = + (1 / 2 : ℝ) • GaussianRealPoint (ya - (-I) * ya) := AFrameBProof.hminusSlope C + orientation base Rminus Rplus hminus hplus F a aThird sJ sA hslopeJ hslopeA + have hya : BandVectors.2 (p 2) (p 0) = ya := AFrameBDetails.hya C orientation base Rminus + Rplus hminus hplus F a p hAcoord hBcoord + let G : P4458T1BoundaryFrame C orientation base J Rplus + (D.functions F.slot false) hplus := { + outer := houter + q := p + proper := hp + slot := 1 + child := by rfl + parent := hpB + tile := D.tiles a true + odometer := D.functions a true + outer_odo := hodoK + minus_odo := hodo + plus_odo := F.plus_odo + outer_band := hbandK + base_band := F.base_band + minus_family := hfamilyJ + plus_family := hfamilyR + chart := hchart + minus_centroid := (AFrameBDetails.hminusCentP C orientation base Rminus Rplus hminus + hplus F D a p J hcentJK (AFrameBDetails.hminusCentVec C orientation base Rminus + Rplus hminus hplus F a p hvp (AFrameBDetails.hyv C orientation base Rminus Rplus + hminus hplus F a p hAcoord hBcoord))) + plus_centroid := hcentRnew + outer_slope := sA + minus_slope := sJ + plus_slope := F.plus_slope + slope_outer := hsA + slope_minus := hsJ + slope_plus := F.slope_plus + minus_difference := (AFrameBDetails.hminusSlopeP C orientation base Rminus Rplus hminus + hplus F a p sJ sA hminusSlope (AFrameBDetails.hminusVec C orientation base Rminus + Rplus hminus hplus F a p hap hya)) + plus_difference := by + calc + _ = F.plus_slope - sA := rfl + _ = _ := (AFrameBDetails.hplusSlopeP C orientation base Rminus Rplus hminus hplus F + a p sA (AFrameBProof.hplusSlope C orientation base Rminus Rplus hminus hplus F + a halfPoint_sub sA hslopeA (AFrameBProof.hplusSlopeRoot C orientation base + Rminus Rplus hminus hplus F D a p hstep hslot J hr hcoord hA hB hE hparent laws + hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird aFourth vflip aflip + hcentJ hcentK hcentR hcentJK hcentRK hodoK hbandK hAcoord hBcoord hcentRnew sJ + hqapos sA hsA hreA himA hslopeJ hslopeA hminusSlope) (AFrameBDetails.hplusDelta + C orientation base Rminus Rplus hminus hplus F a aFourth)) + (AFrameBDetails.hplusVec C orientation base Rminus Rplus hminus hplus F a p hap + hya)) + } + refine ⟨G, ?_⟩ + constructor + · simp [G] + constructor + · simp [G] + constructor + · simpa [G, houter] using hAcoord.symm + constructor + · simp [G] + · simp [G]) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean new file mode 100644 index 0000000000..20355bfb96 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean @@ -0,0 +1,1674 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily +public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointAlgebra +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P4536T1AFrameD] + +/-! +# P4536T1AFrameD + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FrameDiagonalProof + +private theorem hrAt128 : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), (![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p + 3).2 - (p 1).2), p 0, p 2, p 3]) → ((F.slot = a + 2) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + ProperBandQuadruple r)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hstep hslot r + fin_cases a + · have heq : r = F.q := by + funext j + fin_cases j <;> rfl + rw [heq] + exact F.proper + · refine ⟨SemiProperQuadruple.rotate F.proper.1, ?_⟩ + have heq : r = ![F.q 0, F.q 2, F.q 3, F.q 1] := by + funext k + fin_cases k <;> rfl + rw [heq] + intro j + fin_cases j + · exact F.proper.2 1 + · exact F.proper.2 2 + · exact F.proper.2 0 + · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate F.proper.1), ?_⟩ + have heq : r = ![F.q 0, F.q 3, F.q 1, F.q 2] := by + funext k + fin_cases k <;> rfl + rw [heq] + intro j + fin_cases j + · exact F.proper.2 2 + · exact F.proper.2 0 + · exact F.proper.2 1 + +private theorem hrstep : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), (![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p + 3).2 - (p 1).2), p 0, p 2, p 3]) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hstep r + simpa [r] using hstep + +private theorem r1 : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p + 3).2 - (p 1).2), p 0, p 2, p 3]) → (r 1 = p 0) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r hrstep + simpa using congrFun hrstep 1 + +private theorem r2 : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p + 3).2 - (p 1).2), p 0, p 2, p 3]) → (r 2 = p 2) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r hrstep + simpa using congrFun hrstep 2 + +private theorem r3 : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p + 3).2 - (p 1).2), p 0, p 2, p 3]) → (r 3 = p 3) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r hrstep + simpa using congrFun hrstep 3 + +private theorem hparent : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), (![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p + 3).2 - (p 1).2), p 0, p 2, p 3]) → ((F.slot = a + 2) → (F.q (F.slot).succ = p 3)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hstep hslot + have hqE : F.q (a + 2).succ = p 3 := by + have h := congrFun hstep 3 + simpa using h + rw [hslot] + exact hqE + +private theorem hparentR : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (r 3 = p 3) → ((F.q (F.slot).succ = p 3) → (F.q F.slot.succ = r 3)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r r3 hparent + exact hparent.trans r3.symm + +private theorem hzero : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + F.q 0 = r 0 := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r + exact rfl + +private theorem hC : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin 4 → + CircleCoordinates), (F.q (F.slot).succ = p 3) → (C.1.1 = p 3) := by + classical + intro C orientation base Rminus Rplus hminus hplus F p hparent + exact F.parent.symm.trans hparent + +private theorem positiveA : + ∀ (p : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → (0 < (p 0).1) := by + classical + intro p hp + exact (ProperBandCurvatureStructure p hp).1 + +private theorem positiveE : + ∀ (C : BandCircle), ∀ (p : Fin 4 → CircleCoordinates), (C.1.1 = p 3) → (0 < (p 3).1) := by + classical + intro C p hC + rw [← hC] + exact C.2 + +private theorem laws : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ + BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + + BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ + BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = + BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - + { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ))) ∧ + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + + { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 + : ℕ))) ∧ + (ProperBandQuadruple r → + ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) (r j.succ) = + { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = + -{ re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (r j.succ) (r (0 : Fin (4 : + ℕ))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r hr + exact VectorRecursionLaws r hr.1 + +private theorem hrr : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ( + let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] + ProperBandQuadruple rr) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r hr rr + have hrot := SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hr.1) + refine ⟨hrot, ?_⟩ + intro j + fin_cases j + · simpa [rr] using hr.2 2 + · simpa [rr] using hr.2 0 + · simpa [rr] using hr.2 1 + +private theorem lawsR : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] + (ProperBandQuadruple rr) → (BandVectors.1 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + + BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + + BandVectors.1 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ + BandVectors.2 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + + BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + + BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ + BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) = + BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) - + { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 + : ℕ))) ∧ + BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) = + BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + + { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin + (4 : ℕ))) ∧ + (ProperBandQuadruple rr → + ∀ (j : Fin (3 : ℕ)), BandVectors.1 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = + { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (rr j.succ) (rr (0 : Fin (4 : + ℕ))) ∧ + BandVectors.2 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = + -{ re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (rr j.succ) (rr (0 : Fin (4 : + ℕ))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r rr hrr + exact VectorRecursionLaws rr hrr.1 + +private theorem win : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let wv := BandVectors.1 (r 3) (r 2) + let xv := BandVectors.1 (r 1) (r 3) + let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] + (BandVectors.1 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + BandVectors.1 (rr (1 : Fin (4 + : ℕ))) (rr (3 : Fin (4 : ℕ))) + BandVectors.1 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : + ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + + BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + BandVectors.2 (rr (2 : Fin + (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (rr (1 : Fin (4 : + ℕ))) (rr (0 : Fin (4 : ℕ))) = BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ + BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) = BandVectors.2 (rr (1 : Fin + (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (rr (2 : Fin (4 : + ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple rr → ∀ (j : Fin (3 : ℕ)), + BandVectors.1 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (rr + j.succ) (rr (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = -⟨(0 + : ℤ), (1 : ℤ)⟩ * BandVectors.2 (rr j.succ) (rr (0 : Fin (4 : ℕ))))) → (BandVectors.1 (r + 3) (r 0) = wv - I * xv) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r I wv xv rr lawsR + simpa [rr, wv, xv, I] using lawsR.2.2.1 + +private theorem ain : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] + (BandVectors.1 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + BandVectors.1 (rr (1 : Fin (4 + : ℕ))) (rr (3 : Fin (4 : ℕ))) + BandVectors.1 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : + ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + + BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + BandVectors.2 (rr (2 : Fin + (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (rr (1 : Fin (4 : + ℕ))) (rr (0 : Fin (4 : ℕ))) = BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ + BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) = BandVectors.2 (rr (1 : Fin + (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (rr (2 : Fin (4 : + ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple rr → ∀ (j : Fin (3 : ℕ)), + BandVectors.1 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (rr + j.succ) (rr (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = -⟨(0 + : ℤ), (1 : ℤ)⟩ * BandVectors.2 (rr j.succ) (rr (0 : Fin (4 : ℕ))))) → (BandVectors.2 (r + 3) (r 0) = wa + I * xa) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r I wa xa rr lawsR + simpa [rr, wa, xa, I] using lawsR.2.2.2.1 + +private theorem hv : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let wv := BandVectors.1 (r 3) (r 2) + let xv := BandVectors.1 (r 1) (r 3) + let yv := BandVectors.1 (r 2) (r 1) + (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : + Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r + j.succ) (r (0 : Fin (4 : ℕ))))) → (-(wv - I * wv) - (xv - I * yv - I * (xv - I * yv)) = + (2 : GaussianInt) * yv ∧ + xv - I * yv + I * (xv - I * yv) + (wv - I * wv) = (2 : GaussianInt) * I * xv ∧ + -(xv - I * xv) - (wv - I * wv) = yv - I * yv ∧ + yv - I * wv + I * (yv - I * wv) - (wv - I * wv) = yv + I * yv ∧ + wv - I * xv - I * (wv - I * xv) - (wv - I * wv) = -I * xv - xv ∧ + -(yv - I * yv) - (wv - I * wv) = -I * xv + xv ∧ + yv - I * wv - I * (yv - I * wv) - (yv - I * yv) = -I * wv - wv ∧ + -(xv - I * xv) - (yv - I * yv) = -I * wv + wv ∧ + -(yv - I * yv) - (xv - I * xv) = wv - I * wv ∧ + wv - I * xv + I * (wv - I * xv) - (xv - I * xv) = wv + I * wv) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r I wv xv yv laws + exact P4536T1EndpointAlgebra I wv xv yv (by decide +kernel) laws.1 + +private theorem ha : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : + Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r + j.succ) (r (0 : Fin (4 : ℕ))))) → (-(wa - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) + = (2 : GaussianInt) * ya ∧ + xa - -I * ya + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ + -(xa - -I * xa) - (wa - -I * wa) = ya - -I * ya ∧ + ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya + -I * ya ∧ + wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ + -(ya - -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ + ya - -I * wa - -I * (ya - -I * wa) - (ya - -I * ya) = - -I * wa - wa ∧ + -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ + -(ya - -I * ya) - (xa - -I * xa) = wa - -I * wa ∧ + wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * xa) = wa + -I * wa) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r I wa xa ya laws + exact P4536T1EndpointAlgebra (-I) wa xa ya (by decide +kernel) laws.2.1 + +private theorem vflip : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ((BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r + (2 : Fin (4 : ℕ))) + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + + BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 + : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) + (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple r → ∀ (j + : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (r (0 : Fin (4 : ℕ))) (r + j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r j.succ) (r (0 : Fin (4 : ℕ))))) → + (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = + { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin + (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = + -{ re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : + Fin (4 : ℕ))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r hr laws + exact (laws.2.2.2.2 hr) 2 + +private theorem aflip : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ((BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r + (2 : Fin (4 : ℕ))) + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + + BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 + : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) + (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple r → ∀ (j + : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (r (0 : Fin (4 : ℕ))) (r + j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r j.succ) (r (0 : Fin (4 : ℕ))))) → + (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = + { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin + (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = + -{ re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : + Fin (4 : ℕ))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r hr laws + exact (laws.2.2.2.2 hr) 2 + +private theorem vflip' : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (r + (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 + (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → (BandVectors.1 (r 0) (r 3) = I + * BandVectors.1 (r 3) (r 0)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r I vflip + simpa using vflip.1 + +private theorem aflip' : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (r + (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 + (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → (BandVectors.2 (r 0) (r 3) = -I + * BandVectors.2 (r 3) (r 0)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r I aflip + simpa using aflip.2 + +private theorem centMinus : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (r 3 = p 3) → ((F.q (F.slot).succ = p 3) → ((F.q 0 = r 0) → ( + let I : GaussianInt := ⟨0, 1⟩ + let wv := BandVectors.1 (r 3) (r 2) + let xv := BandVectors.1 (r 1) (r 3) + (BandVectors.1 (r 3) (r 0) = wv - I * xv) → ((BandVectors.1 (r 0) (r 3) = I * BandVectors.1 + (r 3) (r 0)) → (TileCentroid Rminus - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint ((wv - I * xv) - I * (wv - I * xv))))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r r3 hparent hzero I wv xv win vflip' + have h := F.minus_centroid + have hindex : F.q F.slot.succ = r 3 := hparent.trans r3.symm + change TileCentroid Rminus - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (F.q F.slot.succ) (F.q 0) - BandVectors.1 (F.q 0) (F.q F.slot.succ)) at h + rw [hindex, hzero] at h + rw [vflip', win] at h + simpa using h + +private theorem centJ : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q + 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * + (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → + ((F.slot = a + 2) → (∀ (J : ProtoTile), (TileCentroid J = TileCentroid (D.tiles F.slot + false)) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ((r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p + 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → ((r 1 = p 0) → ((r 2 = p + 2) → ((r 3 = p 3) → ((F.q F.slot.succ = r 3) → ((F.q 0 = r 0) → ( + let I : GaussianInt := ⟨0, 1⟩ + let wv := BandVectors.1 (r 3) (r 2) + let xv := BandVectors.1 (r 1) (r 3) + let yv := BandVectors.1 (r 2) (r 1) + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : + Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r + j.succ) (r (0 : Fin (4 : ℕ))))) → ( + let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] + (ProperBandQuadruple rr) → ((BandVectors.1 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + + BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + BandVectors.1 (rr (2 : Fin + (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (rr (3 : Fin (4 : + ℕ))) (rr (2 : Fin (4 : ℕ))) + BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + + BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) = BandVectors.1 (rr (1 : Fin + (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (rr (2 : Fin (4 : + ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) + = BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple rr → ∀ + (j : Fin (3 : ℕ)), BandVectors.1 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ + * BandVectors.1 (rr j.succ) (rr (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (0 : Fin (4 : ℕ))) + (rr j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (rr j.succ) (rr (0 : Fin (4 : ℕ))))) → + ((BandVectors.1 (r 3) (r 0) = wv - I * xv) → ((BandVectors.2 (r 3) (r 0) = wa + I * xa) → + ((-(wv - I * wv) - (xv - I * yv - I * (xv - I * yv)) = (2 : GaussianInt) * yv ∧ xv - I * + yv + I * (xv - I * yv) + (wv - I * wv) = (2 : GaussianInt) * I * xv ∧ -(xv - I * xv) - + (wv - I * wv) = yv - I * yv ∧ yv - I * wv + I * (yv - I * wv) - (wv - I * wv) = yv + I * + yv ∧ wv - I * xv - I * (wv - I * xv) - (wv - I * wv) = -I * xv - xv ∧ -(yv - I * yv) - + (wv - I * wv) = -I * xv + xv ∧ yv - I * wv - I * (yv - I * wv) - (yv - I * yv) = -I * wv + - wv ∧ -(xv - I * xv) - (yv - I * yv) = -I * wv + wv ∧ -(yv - I * yv) - (xv - I * xv) = + wv - I * wv ∧ wv - I * xv + I * (wv - I * xv) - (xv - I * xv) = wv + I * wv) → ((-(wa - + -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya + + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - + (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya + + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - + -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - + -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I + * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * + xa) = wa + -I * wa) → ((BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : + ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → + ((BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : + ℤ)⟩ * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : ℤ), (1 : + ℤ)⟩ * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → + ((BandVectors.1 (r 0) (r 3) = I * BandVectors.1 (r 3) (r 0)) → ((BandVectors.2 (r 0) (r + 3) = -I * BandVectors.2 (r 3) (r 0)) → ((TileCentroid Rminus - TileCentroid F.tile = (1 / + 2 : ℝ) • GaussianRealPoint ((wv - I * xv) - I * (wv - I * xv))) → (TileCentroid J - + TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint (-(yv - I * yv)))))))))))))))))))))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J hcent r hr hrstep r1 + r2 r3 hparentR hzero I wv xv yv wa xa ya laws rr hrr lawsR win ain hv ha vflip aflip vflip' + aflip' centMinus + have h := (D.occurrences F.slot false).2.2 + have hs2 : F.slot + 2 = a + 1 := by + rw [hslot] + fin_cases a <;> decide + have hs1 : F.slot + 1 = a := by + rw [hslot] + fin_cases a <;> decide + have hindices : F.q ((F.slot + 2).succ) = r 2 ∧ F.q ((F.slot + 1).succ) = r 1 := by + rw [hs2, hs1] + constructor <;> rfl + change TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = + (-1 : ℝ) • ((1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (F.q ((F.slot + 2).succ)) (F.q ((F.slot + 1).succ)) ) - + (-(GaussianRealPoint (BandVectors.1 (F.q ((F.slot + 2).succ)) (F.q ((F.slot + 1).succ)))).2, + (GaussianRealPoint (BandVectors.1 (F.q ((F.slot + 2).succ)) (F.q ((F.slot + + 1).succ)))).1))) at h + rw [hindices.1, hindices.2] at h + rw [hcent] + rw [h] + ext <;> simp [GaussianRealPoint, I, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring + +private theorem centK : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let wv := BandVectors.1 (r 3) (r 2) + TileCentroid (D.tiles a true) - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint (wv - I * wv) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a r I wv + have h := (D.occurrences a true).2.2 + have hindices : F.q ((a + 2).succ) = r 3 ∧ F.q ((a + 1).succ) = r 2 := by + constructor <;> rfl + change TileCentroid (D.tiles a true) - TileCentroid F.tile = + (1 : ℝ) • ((1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (F.q ((a + 2).succ)) (F.q ((a + 1).succ))) - + (-(GaussianRealPoint (BandVectors.1 (F.q ((a + 2).succ)) (F.q ((a + 1).succ)))).2, + (GaussianRealPoint (BandVectors.1 (F.q ((a + 2).succ)) (F.q ((a + 1).succ)))).1))) at h + rw [hindices.1, hindices.2] at h + rw [h] + ext <;> simp [GaussianRealPoint, I, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring + +private theorem halfDiff : + ∀ {X : GaussianInt}, ∀ {Y : GaussianInt}, ∀ {Z : GaussianInt}, (X - Y = Z) → ((1 / 2 : ℝ) • + GaussianRealPoint X - + (1 / 2 : ℝ) • GaussianRealPoint Y = + (1 / 2 : ℝ) • GaussianRealPoint Z) := by + classical + intro X Y Z hxy + have hr := congrArg (fun z : GaussianInt => z.re) hxy + have hi := congrArg (fun z : GaussianInt => z.im) hxy + have hr' : (X.re : ℝ) - (Y.re : ℝ) = (Z.re : ℝ) := by exact_mod_cast (by simpa using hr) + have hi' : (X.im : ℝ) - (Y.im : ℝ) = (Z.im : ℝ) := by exact_mod_cast (by simpa using hi) + apply Prod.ext + · change (1 / 2 : ℝ) * (X.re : ℝ) - (1 / 2 : ℝ) * (Y.re : ℝ) = + (1 / 2 : ℝ) * (Z.re : ℝ) + linarith + · change (1 / 2 : ℝ) * (X.im : ℝ) - (1 / 2 : ℝ) * (Y.im : ℝ) = + (1 / 2 : ℝ) * (Z.im : ℝ) + linarith + +private theorem hcentR : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let wv := BandVectors.1 (r 3) (r 2) + let xv := BandVectors.1 (r 1) (r 3) + let yv := BandVectors.1 (r 2) (r 1) + (-(wv - I * wv) - (xv - I * yv - I * (xv - I * yv)) = (2 : GaussianInt) * yv ∧ xv - I * yv + + I * (xv - I * yv) + (wv - I * wv) = (2 : GaussianInt) * I * xv ∧ -(xv - I * xv) - (wv - I + * wv) = yv - I * yv ∧ yv - I * wv + I * (yv - I * wv) - (wv - I * wv) = yv + I * yv ∧ wv + - I * xv - I * (wv - I * xv) - (wv - I * wv) = -I * xv - xv ∧ -(yv - I * yv) - (wv - I * + wv) = -I * xv + xv ∧ yv - I * wv - I * (yv - I * wv) - (yv - I * yv) = -I * wv - wv ∧ + -(xv - I * xv) - (yv - I * yv) = -I * wv + wv ∧ -(yv - I * yv) - (xv - I * xv) = wv - I * + wv ∧ wv - I * xv + I * (wv - I * xv) - (xv - I * xv) = wv + I * wv) → ((TileCentroid + Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint ((wv - I * xv) - I * (wv - + I * xv))) → ((TileCentroid (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • + GaussianRealPoint (wv - I * wv)) → ((∀ {X : GaussianInt}, ∀ {Y : GaussianInt}, ∀ + {Z : GaussianInt}, (X - Y = Z) → ((1 / 2 : ℝ) • GaussianRealPoint X - (1 / 2 : ℝ) • + GaussianRealPoint Y = (1 / 2 : ℝ) • GaussianRealPoint Z)) → (TileCentroid Rminus - + TileCentroid (D.tiles a true) = + (1 / 2 : ℝ) • GaussianRealPoint (-I * xv - xv))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a r I wv xv yv hv centMinus centK halfDiff + calc + _ = (TileCentroid Rminus - TileCentroid F.tile) - + (TileCentroid (D.tiles a true) - TileCentroid F.tile) := by abel + _ = _ := by rw [centMinus, centK]; exact halfDiff hv.2.2.2.2.1 + +private theorem hcentJ : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (J : ProtoTile), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let wv := BandVectors.1 (r 3) (r 2) + let xv := BandVectors.1 (r 1) (r 3) + let yv := BandVectors.1 (r 2) (r 1) + (-(wv - I * wv) - (xv - I * yv - I * (xv - I * yv)) = (2 : GaussianInt) * yv ∧ xv - I * yv + + I * (xv - I * yv) + (wv - I * wv) = (2 : GaussianInt) * I * xv ∧ -(xv - I * xv) - (wv - I + * wv) = yv - I * yv ∧ yv - I * wv + I * (yv - I * wv) - (wv - I * wv) = yv + I * yv ∧ wv + - I * xv - I * (wv - I * xv) - (wv - I * wv) = -I * xv - xv ∧ -(yv - I * yv) - (wv - I * + wv) = -I * xv + xv ∧ yv - I * wv - I * (yv - I * wv) - (yv - I * yv) = -I * wv - wv ∧ + -(xv - I * xv) - (yv - I * yv) = -I * wv + wv ∧ -(yv - I * yv) - (xv - I * xv) = wv - I * + wv ∧ wv - I * xv + I * (wv - I * xv) - (xv - I * xv) = wv + I * wv) → ((TileCentroid J - + TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(yv - I * yv))) → ((TileCentroid + (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (wv - I * wv)) → + ((∀ {X : GaussianInt}, ∀ {Y : GaussianInt}, ∀ {Z : GaussianInt}, (X - Y = Z) → ((1 / 2 : + ℝ) • GaussianRealPoint X - (1 / 2 : ℝ) • GaussianRealPoint Y = (1 / 2 : ℝ) • + GaussianRealPoint Z)) → (TileCentroid J - TileCentroid (D.tiles a true) = + (1 / 2 : ℝ) • GaussianRealPoint (-I * xv + xv))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a J r I wv xv yv hv centJ centK halfDiff + calc + _ = (TileCentroid J - TileCentroid F.tile) - + (TileCentroid (D.tiles a true) - TileCentroid F.tile) := by abel + _ = _ := by rw [centJ, centK]; exact halfDiff hv.2.2.2.2.2.1 + +private theorem lawsP : + ∀ (p : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → (BandVectors.1 (p (3 : Fin (4 : + ℕ))) (p (2 : Fin (4 : ℕ))) + BandVectors.1 (p (1 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) + + BandVectors.1 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ + BandVectors.2 (p (3 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))) + + BandVectors.2 (p (1 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) + + BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ + BandVectors.1 (p (1 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) = + BandVectors.1 (p (1 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) - + { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 : + ℕ))) ∧ + BandVectors.2 (p (1 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) = + BandVectors.2 (p (1 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) + + { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 + : ℕ))) ∧ + (ProperBandQuadruple p → + ∀ (j : Fin (3 : ℕ)), BandVectors.1 (p (0 : Fin (4 : ℕ))) (p j.succ) = + { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (p j.succ) (p (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (p (0 : Fin (4 : ℕ))) (p j.succ) = + -{ re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (p j.succ) (p (0 : Fin (4 : + ℕ))))) := by + classical + intro p hp + exact VectorRecursionLaws p hp.1 + +private theorem pflip : + ∀ (p : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → ((BandVectors.1 (p (3 : Fin (4 : + ℕ))) (p (2 : Fin (4 : ℕ))) + BandVectors.1 (p (1 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) + + BandVectors.1 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.2 (p (3 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))) + BandVectors.2 (p (1 : Fin (4 + : ℕ))) (p (3 : Fin (4 : ℕ))) + BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 : ℕ))) + = (0 : GaussianInt) ∧ BandVectors.1 (p (1 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) = + BandVectors.1 (p (1 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (p (1 : Fin (4 + : ℕ))) (p (0 : Fin (4 : ℕ))) = BandVectors.2 (p (1 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) + + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 : ℕ))) ∧ + (ProperBandQuadruple p → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (p (0 : Fin (4 : ℕ))) (p + j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (p j.succ) (p (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (p (0 : Fin (4 : ℕ))) (p j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (p + j.succ) (p (0 : Fin (4 : ℕ))))) → (BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (Fin.succ (2 : + Fin (3 : ℕ)))) = + { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (p (Fin.succ (2 : Fin (3 : ℕ)))) (p (0 : Fin + (4 : ℕ))) ∧ + BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (Fin.succ (2 : Fin (3 : ℕ)))) = + -{ re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (p (Fin.succ (2 : Fin (3 : ℕ)))) (p (0 : + Fin (4 : ℕ))))) := by + classical + intro p hp lawsP + exact (lawsP.2.2.2.2 hp) 2 + +private theorem hxcoordV : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (r 1 = p 0) → ((r 3 = p 3) → ( + let xv := BandVectors.1 (r 1) (r 3) + BandVectors.1 (p 0) (p 3) = xv)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r r1 r3 xv + rw [← r1, ← r3] + +private theorem hxcoordA : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (r 1 = p 0) → ((r 3 = p 3) → ( + let xa := BandVectors.2 (r 1) (r 3) + BandVectors.2 (p 0) (p 3) = xa)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r r1 r3 xa + rw [← r1, ← r3] + +private theorem hI2 : + let I : GaussianInt := ⟨0, 1⟩ + I * I = -1 := by + classical + intro I + decide +kernel + +private theorem he2 : + let I : GaussianInt := ⟨0, 1⟩ + let e : GaussianInt := -I + e * e = -1 := by + classical + intro I e + decide +kernel + +private theorem hIneg : + let I : GaussianInt := ⟨0, 1⟩ + (I * I = -1) → (-I * I = 1) := by + classical + intro I hI2 + calc + -I * I = -(I * I) := by ring + _ = -(-1) := by rw [hI2] + _ = 1 := by norm_num + +private theorem heneg : + let I : GaussianInt := ⟨0, 1⟩ + let e : GaussianInt := -I + (e * e = -1) → (-e * e = 1) := by + classical + intro I e he2 + calc + -e * e = -(e * e) := by ring + _ = -(-1) := by rw [he2] + _ = 1 := by norm_num + +private theorem hxv : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let xv := BandVectors.1 (r 1) (r 3) + (BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (p (Fin.succ (2 : Fin (3 : ℕ)))) (p (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (p + (0 : Fin (4 : ℕ))) (p (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 + (p (Fin.succ (2 : Fin (3 : ℕ)))) (p (0 : Fin (4 : ℕ)))) → ((BandVectors.1 (p 0) (p 3) = + xv) → (xv = I * BandVectors.1 (p 3) (p 0))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I xv pflip hxcoordV + rw [← hxcoordV] + simpa using pflip.1 + +private theorem hza : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let xv := BandVectors.1 (r 1) (r 3) + (-I * I = 1) → ((xv = I * BandVectors.1 (p 3) (p 0)) → (BandVectors.1 (p 3) (p 0) = -I * xv)) + := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I xv hIneg hxv + calc + _ = 1 * BandVectors.1 (p 3) (p 0) := by simp + _ = (-I * I) * BandVectors.1 (p 3) (p 0) := by rw [hIneg] + _ = -I * (I * BandVectors.1 (p 3) (p 0)) := by + simp [mul_assoc] + _ = _ := by rw [← hxv] + +private theorem hxa : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let xa := BandVectors.2 (r 1) (r 3) + let e : GaussianInt := -I + (BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (p (Fin.succ (2 : Fin (3 : ℕ)))) (p (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (p + (0 : Fin (4 : ℕ))) (p (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 + (p (Fin.succ (2 : Fin (3 : ℕ)))) (p (0 : Fin (4 : ℕ)))) → ((BandVectors.2 (p 0) (p 3) = + xa) → (xa = e * BandVectors.2 (p 3) (p 0))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I xa e pflip hxcoordA + rw [← hxcoordA] + simpa [e, I] using pflip.2 + +private theorem hzaA : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let xa := BandVectors.2 (r 1) (r 3) + let e : GaussianInt := -I + (-e * e = 1) → ((xa = e * BandVectors.2 (p 3) (p 0)) → (BandVectors.2 (p 3) (p 0) = -e * xa)) + := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I xa e heneg hxa + calc + _ = 1 * BandVectors.2 (p 3) (p 0) := by simp + _ = (-e * e) * BandVectors.2 (p 3) (p 0) := by rw [heneg] + _ = -e * (e * BandVectors.2 (p 3) (p 0)) := by + simp [mul_assoc] + _ = _ := by rw [← hxa] + +private theorem hminusVecV : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let xv := BandVectors.1 (r 1) (r 3) + (BandVectors.1 (p 0) (p 3) = xv) → ((BandVectors.1 (p 3) (p 0) = -I * xv) → (BandVectors.1 (p + 3) (p 0) - BandVectors.1 (p 0) (p 3) = + -I * xv - xv)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I xv hxcoordV hza + rw [hza, hxcoordV] + +private theorem hplusVecV : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let xv := BandVectors.1 (r 1) (r 3) + (BandVectors.1 (p 0) (p 3) = xv) → ((BandVectors.1 (p 3) (p 0) = -I * xv) → (BandVectors.1 (p + 3) (p 0) + BandVectors.1 (p 0) (p 3) = + -I * xv + xv)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I xv hxcoordV hza + rw [hza, hxcoordV] + +private theorem hminusVecA : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let xa := BandVectors.2 (r 1) (r 3) + let e : GaussianInt := -I + (BandVectors.2 (p 0) (p 3) = xa) → ((BandVectors.2 (p 3) (p 0) = -e * xa) → (BandVectors.2 (p + 3) (p 0) - BandVectors.2 (p 0) (p 3) = + -e * xa - xa)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I xa e hxcoordA hzaA + rw [hzaA, hxcoordA] + +private theorem hplusVecA : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let xa := BandVectors.2 (r 1) (r 3) + let e : GaussianInt := -I + (BandVectors.2 (p 0) (p 3) = xa) → ((BandVectors.2 (p 3) (p 0) = -e * xa) → (BandVectors.2 (p + 3) (p 0) + BandVectors.2 (p 0) (p 3) = + -e * xa + xa)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p r I xa e hxcoordA hzaA + rw [hzaA, hxcoordA] + +private theorem houterA : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p + : Fin 4 → CircleCoordinates), (![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p + 3).2 - (p 1).2), p 0, p 2, p 3]) → (F.q a.succ = p 0) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a p hstep + have h := congrFun hstep 1 + simpa using h + +private theorem hindicesA : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + F.q ((a + 2).succ) = r 3 ∧ F.q ((a + 1).succ) = r 2 := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r + constructor <;> rfl + +private theorem hvecA : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let wa := BandVectors.2 (r 3) (r 2) + (F.q ((a + 2).succ) = r 3 ∧ F.q ((a + 1).succ) = r 2) → (BandVectors.2 (F.q ((a + 2).succ)) + (F.q ((a + 1).succ)) = wa) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r wa hindicesA + rw [hindicesA.1, hindicesA.2] + +private theorem hslotplus2 : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q + 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * + (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → + ((F.slot = a + 2) → (∀ (J : ProtoTile), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ((r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p + 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → ((r 1 = p 0) → ((r 2 = p + 2) → ((r 3 = p 3) → ((F.q F.slot.succ = r 3) → ((F.q 0 = r 0) → ( + let I : GaussianInt := ⟨0, 1⟩ + let wv := BandVectors.1 (r 3) (r 2) + let xv := BandVectors.1 (r 1) (r 3) + let yv := BandVectors.1 (r 2) (r 1) + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : + Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r + j.succ) (r (0 : Fin (4 : ℕ))))) → ( + let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] + (ProperBandQuadruple rr) → ((BandVectors.1 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + + BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + BandVectors.1 (rr (2 : Fin + (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (rr (3 : Fin (4 : + ℕ))) (rr (2 : Fin (4 : ℕ))) + BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + + BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) = BandVectors.1 (rr (1 : Fin + (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (rr (2 : Fin (4 : + ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) + = BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple rr → ∀ + (j : Fin (3 : ℕ)), BandVectors.1 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ + * BandVectors.1 (rr j.succ) (rr (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (0 : Fin (4 : ℕ))) + (rr j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (rr j.succ) (rr (0 : Fin (4 : ℕ))))) → + ((BandVectors.1 (r 3) (r 0) = wv - I * xv) → ((BandVectors.2 (r 3) (r 0) = wa + I * xa) → + ((-(wv - I * wv) - (xv - I * yv - I * (xv - I * yv)) = (2 : GaussianInt) * yv ∧ xv - I * + yv + I * (xv - I * yv) + (wv - I * wv) = (2 : GaussianInt) * I * xv ∧ -(xv - I * xv) - + (wv - I * wv) = yv - I * yv ∧ yv - I * wv + I * (yv - I * wv) - (wv - I * wv) = yv + I * + yv ∧ wv - I * xv - I * (wv - I * xv) - (wv - I * wv) = -I * xv - xv ∧ -(yv - I * yv) - + (wv - I * wv) = -I * xv + xv ∧ yv - I * wv - I * (yv - I * wv) - (yv - I * yv) = -I * wv + - wv ∧ -(xv - I * xv) - (yv - I * yv) = -I * wv + wv ∧ -(yv - I * yv) - (xv - I * xv) = + wv - I * wv ∧ wv - I * xv + I * (wv - I * xv) - (xv - I * xv) = wv + I * wv) → ((-(wa - + -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya + + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - + (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya + + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - + -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - + -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I + * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * + xa) = wa + -I * wa) → ((BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : + ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → + ((BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : + ℤ)⟩ * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : ℤ), (1 : + ℤ)⟩ * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → + ((BandVectors.1 (r 0) (r 3) = I * BandVectors.1 (r 3) (r 0)) → ((BandVectors.2 (r 0) (r + 3) = -I * BandVectors.2 (r 3) (r 0)) → ((TileCentroid Rminus - TileCentroid F.tile = (1 / + 2 : ℝ) • GaussianRealPoint ((wv - I * xv) - I * (wv - I * xv))) → ((TileCentroid J - + TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(yv - I * yv))) → ((TileCentroid + (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (wv - I * wv)) → + ((TileCentroid Rminus - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint + (-I * xv - xv)) → ((TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • + GaussianRealPoint (-I * xv + xv)) → ( + let e : GaussianInt := -I + (BandVectors.1 (p 0) (p 3) = xv) → ((BandVectors.2 (p 0) (p 3) = xa) → ((xv = I * + BandVectors.1 (p 3) (p 0)) → ((BandVectors.1 (p 3) (p 0) = -I * xv) → ((xa = e * + BandVectors.2 (p 3) (p 0)) → ((BandVectors.2 (p 3) (p 0) = -e * xa) → ((BandVectors.1 (p + 3) (p 0) - BandVectors.1 (p 0) (p 3) = -I * xv - xv) → ((BandVectors.1 (p 3) (p 0) + + BandVectors.1 (p 0) (p 3) = -I * xv + xv) → ((BandVectors.2 (p 3) (p 0) - BandVectors.2 + (p 0) (p 3) = -e * xa - xa) → ((BandVectors.2 (p 3) (p 0) + BandVectors.2 (p 0) (p 3) = + -e * xa + xa) → ((F.q a.succ = p 0) → ((F.q ((a + 2).succ) = r 3 ∧ F.q ((a + 1).succ) = r + 2) → ((BandVectors.2 (F.q ((a + 2).succ)) (F.q ((a + 1).succ)) = wa) → (F.slot + 2 = a + + 1)))))))))))))))))))))))))))))))))))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J r hr hrstep r1 r2 r3 + hparentR hzero I wv xv yv wa xa ya laws rr hrr lawsR win ain hv ha vflip aflip vflip' + aflip' centMinus centJ centK hcentR hcentJ e hxcoordV hxcoordA hxv hza hxa hzaA hminusVecV + hplusVecV hminusVecA hplusVecA houterA hindicesA hvecA + rw [hslot] + fin_cases a <;> decide + +private theorem hslotplus1 : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q + 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * + (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → + ((F.slot = a + 2) → (∀ (J : ProtoTile), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (ProperBandQuadruple r) → ((r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p + 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → ((r 1 = p 0) → ((r 2 = p + 2) → ((r 3 = p 3) → ((F.q F.slot.succ = r 3) → ((F.q 0 = r 0) → ( + let I : GaussianInt := ⟨0, 1⟩ + let wv := BandVectors.1 (r 3) (r 2) + let xv := BandVectors.1 (r 1) (r 3) + let yv := BandVectors.1 (r 2) (r 1) + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : + ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 + : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r + (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 + (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : + Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : + ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r + j.succ) (r (0 : Fin (4 : ℕ))))) → ( + let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] + (ProperBandQuadruple rr) → ((BandVectors.1 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + + BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + BandVectors.1 (rr (2 : Fin + (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (rr (3 : Fin (4 : + ℕ))) (rr (2 : Fin (4 : ℕ))) + BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + + BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ + BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) = BandVectors.1 (rr (1 : Fin + (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (rr (2 : Fin (4 : + ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) + = BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple rr → ∀ + (j : Fin (3 : ℕ)), BandVectors.1 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ + * BandVectors.1 (rr j.succ) (rr (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (0 : Fin (4 : ℕ))) + (rr j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (rr j.succ) (rr (0 : Fin (4 : ℕ))))) → + ((BandVectors.1 (r 3) (r 0) = wv - I * xv) → ((BandVectors.2 (r 3) (r 0) = wa + I * xa) → + ((-(wv - I * wv) - (xv - I * yv - I * (xv - I * yv)) = (2 : GaussianInt) * yv ∧ xv - I * + yv + I * (xv - I * yv) + (wv - I * wv) = (2 : GaussianInt) * I * xv ∧ -(xv - I * xv) - + (wv - I * wv) = yv - I * yv ∧ yv - I * wv + I * (yv - I * wv) - (wv - I * wv) = yv + I * + yv ∧ wv - I * xv - I * (wv - I * xv) - (wv - I * wv) = -I * xv - xv ∧ -(yv - I * yv) - + (wv - I * wv) = -I * xv + xv ∧ yv - I * wv - I * (yv - I * wv) - (yv - I * yv) = -I * wv + - wv ∧ -(xv - I * xv) - (yv - I * yv) = -I * wv + wv ∧ -(yv - I * yv) - (xv - I * xv) = + wv - I * wv ∧ wv - I * xv + I * (wv - I * xv) - (xv - I * xv) = wv + I * wv) → ((-(wa - + -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya + + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - + (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya + + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - + -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - + -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I + * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * + xa) = wa + -I * wa) → ((BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : + ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → + ((BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : + ℤ)⟩ * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ))) ∧ + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : ℤ), (1 : + ℤ)⟩ * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → + ((BandVectors.1 (r 0) (r 3) = I * BandVectors.1 (r 3) (r 0)) → ((BandVectors.2 (r 0) (r + 3) = -I * BandVectors.2 (r 3) (r 0)) → ((TileCentroid Rminus - TileCentroid F.tile = (1 / + 2 : ℝ) • GaussianRealPoint ((wv - I * xv) - I * (wv - I * xv))) → ((TileCentroid J - + TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(yv - I * yv))) → ((TileCentroid + (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (wv - I * wv)) → + ((TileCentroid Rminus - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint + (-I * xv - xv)) → ((TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • + GaussianRealPoint (-I * xv + xv)) → ( + let e : GaussianInt := -I + (BandVectors.1 (p 0) (p 3) = xv) → ((BandVectors.2 (p 0) (p 3) = xa) → ((xv = I * + BandVectors.1 (p 3) (p 0)) → ((BandVectors.1 (p 3) (p 0) = -I * xv) → ((xa = e * + BandVectors.2 (p 3) (p 0)) → ((BandVectors.2 (p 3) (p 0) = -e * xa) → ((BandVectors.1 (p + 3) (p 0) - BandVectors.1 (p 0) (p 3) = -I * xv - xv) → ((BandVectors.1 (p 3) (p 0) + + BandVectors.1 (p 0) (p 3) = -I * xv + xv) → ((BandVectors.2 (p 3) (p 0) - BandVectors.2 + (p 0) (p 3) = -e * xa - xa) → ((BandVectors.2 (p 3) (p 0) + BandVectors.2 (p 0) (p 3) = + -e * xa + xa) → ((F.q a.succ = p 0) → ((F.q ((a + 2).succ) = r 3 ∧ F.q ((a + 1).succ) = r + 2) → ((BandVectors.2 (F.q ((a + 2).succ)) (F.q ((a + 1).succ)) = wa) → ((F.slot + 2 = a + + 1) → (F.slot + 1 = a))))))))))))))))))))))))))))))))))))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J r hr hrstep r1 r2 r3 + hparentR hzero I wv xv yv wa xa ya laws rr hrr lawsR win ain hv ha vflip aflip vflip' + aflip' centMinus centJ centK hcentR hcentJ e hxcoordV hxcoordA hxv hza hxa hzaA hminusVecV + hplusVecV hminusVecA hplusVecA houterA hindicesA hvecA hslotplus2 + rw [hslot] + fin_cases a <;> decide + +private theorem hindicesJ : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (F.slot + 2 = a + 1) → ((F.slot + 1 = a) → (F.q ((F.slot + 2).succ) = r 2 ∧ + F.q ((F.slot + 1).succ) = r 1)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r hslotplus2 hslotplus1 + rw [hslotplus2, hslotplus1] + constructor <;> rfl + +private theorem hvecJ : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let ya := BandVectors.2 (r 2) (r 1) + (F.q ((F.slot + 2).succ) = r 2 ∧ F.q ((F.slot + 1).succ) = r 1) → (BandVectors.2 (F.q + ((F.slot + 2).succ)) + (F.q ((F.slot + 1).succ)) = ya) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r ya hindicesJ + rw [hindicesJ.1, hindicesJ.2] + +private theorem hpositiveSlot : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), 0 < (F.q + F.slot.succ).1 := by + classical + intro C orientation base Rminus Rplus hminus hplus F + rw [F.parent] + exact C.2 + +private theorem hrootAEq : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (rootA : ℝ × ℝ), + (PartialOdometerSlope F.odometer = some rootA) → (rootA = F.outer_slope) := by + classical + intro C orientation base Rminus Rplus hminus hplus F rootA hrootA + exact Option.some.inj (hrootA.symm.trans F.slope_outer) + +private theorem hrootJEq : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (rootJ : ℝ × ℝ), + (PartialOdometerSlope F.odometer = some rootJ) → (rootJ = F.outer_slope) := by + classical + intro C orientation base Rminus Rplus hminus hplus F rootJ hrootJ + exact Option.some.inj (hrootJ.symm.trans F.slope_outer) + +private theorem slopeK : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let wa := BandVectors.2 (r 3) (r 2) + let e : GaussianInt := -I + (BandVectors.2 (F.q ((a + 2).succ)) (F.q ((a + 1).succ)) = wa) → (∀ (sA : ℝ × ℝ), (sA.1 - + F.outer_slope.1 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : + ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : + Fin (3 : ℕ))).succ)).im : ℝ))) → ((sA.2 - F.outer_slope.2 = (if true = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q + (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : + ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (sA - F.outer_slope = + (1 / 2 : ℝ) • GaussianRealPoint (wa - e * wa)))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r I wa e hvecA sA hARe hAIm + have hre := hARe + have him := hAIm + rw [hvecA] at hre him + change sA.1 - F.outer_slope.1 = 1 * (1 / 2 : ℝ) * + (((wa.re : ℤ) : ℝ) - ((wa.im : ℤ) : ℝ)) at hre + change sA.2 - F.outer_slope.2 = 1 * (1 / 2 : ℝ) * + (((wa.im : ℤ) : ℝ) + ((wa.re : ℤ) : ℝ)) at him + apply Prod.ext + · simp [GaussianRealPoint, e, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at hre ⊢ + linarith + · simp [GaussianRealPoint, e, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at him ⊢ + linarith + +private theorem slopeJ : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let ya := BandVectors.2 (r 2) (r 1) + let e : GaussianInt := -I + (BandVectors.2 (F.q ((F.slot + 2).succ)) (F.q ((F.slot + 1).succ)) = ya) → (∀ (sJ : ℝ × ℝ), + (sJ.1 - F.outer_slope.1 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : + ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q + (F.slot + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sJ.2 - F.outer_slope.2 = (if false = + true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (F.slot + (2 : + Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 + (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).re : + ℝ))) → (sJ - F.outer_slope = + (1 / 2 : ℝ) • GaussianRealPoint (-(ya - e * ya))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r I ya e hvecJ sJ hJRe hJIm + have hre := hJRe + have him := hJIm + rw [hvecJ] at hre him + change sJ.1 - F.outer_slope.1 = -1 * (1 / 2 : ℝ) * + (((ya.re : ℤ) : ℝ) - ((ya.im : ℤ) : ℝ)) at hre + change sJ.2 - F.outer_slope.2 = -1 * (1 / 2 : ℝ) * + (((ya.im : ℤ) : ℝ) + ((ya.re : ℤ) : ℝ)) at him + apply Prod.ext + · simp [GaussianRealPoint, e, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at hre ⊢ + linarith + · simp [GaussianRealPoint, e, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at him ⊢ + linarith + +private theorem slopeMinusRoot : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + (F.q F.slot.succ = r 3) → ((F.q 0 = r 0) → ( + let I : GaussianInt := ⟨0, 1⟩ + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + (BandVectors.2 (r 3) (r 0) = wa + I * xa) → ((BandVectors.2 (r 0) (r 3) = -I * BandVectors.2 + (r 3) (r 0)) → ( + let e : GaussianInt := -I + F.minus_slope - F.outer_slope = + (1 / 2 : ℝ) • GaussianRealPoint ((wa - e * xa) - e * (wa - e * xa)))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r hparentR hzero I wa xa ain aflip' e + have h := F.minus_difference + change F.minus_slope - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (F.q F.slot.succ) (F.q 0) - + BandVectors.2 (F.q 0) (F.q F.slot.succ)) at h + rw [hparentR, hzero, aflip', ain] at h + simpa [e, I] using h + +private theorem slopeMinusA : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + (-(wa - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * + ya + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) + - (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = + ya + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ + -(ya - -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - + (ya - -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ + -(ya - -I * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - + (xa - -I * xa) = wa + -I * wa) → ((∀ {X : GaussianInt}, ∀ {Y : GaussianInt}, ∀ + {Z : GaussianInt}, (X - Y = Z) → ((1 / 2 : ℝ) • GaussianRealPoint X - (1 / 2 : ℝ) • + GaussianRealPoint Y = (1 / 2 : ℝ) • GaussianRealPoint Z)) → ( + let e : GaussianInt := -I + ∀ (sA : ℝ × ℝ), (sA - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (wa - e * wa)) → + ((F.minus_slope - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint ((wa - e * xa) - e * + (wa - e * xa))) → (F.minus_slope - sA = + (1 / 2 : ℝ) • GaussianRealPoint (-e * xa - xa))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r I wa xa ya ha halfDiff e sA slopeK + slopeMinusRoot + calc + _ = (F.minus_slope - F.outer_slope) - (sA - F.outer_slope) := by abel + _ = _ := by rw [slopeMinusRoot, slopeK]; exact halfDiff ha.2.2.2.2.1 + +private theorem slopeJminusA : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + (-(wa - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * + ya + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) + - (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = + ya + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ + -(ya - -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - + (ya - -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ + -(ya - -I * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - + (xa - -I * xa) = wa + -I * wa) → ((∀ {X : GaussianInt}, ∀ {Y : GaussianInt}, ∀ + {Z : GaussianInt}, (X - Y = Z) → ((1 / 2 : ℝ) • GaussianRealPoint X - (1 / 2 : ℝ) • + GaussianRealPoint Y = (1 / 2 : ℝ) • GaussianRealPoint Z)) → ( + let e : GaussianInt := -I + ∀ (sA : ℝ × ℝ), ∀ (sJ : ℝ × ℝ), (sA - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (wa - e + * wa)) → ((sJ - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (-(ya - e * ya))) → (sJ - + sA = + (1 / 2 : ℝ) • GaussianRealPoint (-e * xa + xa))))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F a r I wa xa ya ha halfDiff e sA sJ slopeK + slopeJ + calc + _ = (sJ - F.outer_slope) - (sA - F.outer_slope) := by abel + _ = _ := by rw [slopeJ, slopeK]; exact halfDiff ha.2.2.2.2.2.1 + +private theorem centMinusA : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let xv := BandVectors.1 (r 1) (r 3) + (TileCentroid Rminus - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint (-I * + xv - xv)) → ((BandVectors.1 (p 3) (p 0) - BandVectors.1 (p 0) (p 3) = -I * xv - xv) → + (TileCentroid Rminus - TileCentroid (D.tiles a true) = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (p 3) (p 0) - BandVectors.1 (p 0) (p 3)))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p r I xv hcentR hminusVecV + rw [hminusVecV] + exact hcentR + +private theorem centJA : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), ∀ (J : + ProtoTile), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + let I : GaussianInt := ⟨0, 1⟩ + let xv := BandVectors.1 (r 1) (r 3) + (TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint (-I * xv + + xv)) → ((BandVectors.1 (p 3) (p 0) + BandVectors.1 (p 0) (p 3) = -I * xv + xv) → + (TileCentroid J - TileCentroid (D.tiles a true) = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (p 3) (p 0) + BandVectors.1 (p 0) (p 3)))) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p J r I xv hcentJ hplusVecV + rw [hplusVecV] + exact hcentJ + +private theorem hodoA : + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ + (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (F.q + a.succ = p 0) → (TileOdometer (p 0) (D.tiles a true) (D.functions a true)) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D a p houterA + simpa [houterA] using D.odometers a true + +end FrameDiagonalProof + +theorem P4536T1AFrameD + {C : BandCircle} {orientation : Bool} {base Rminus Rplus : ProtoTile} + {hminus hplus : PartialOdometer} + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) + (D : P4458T1RestrictionFamily F) + (a : Fin 3) (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (hstep : ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3]) + (hslot : F.slot = a + 2) + (hchart : C.1.1.1 = 1 → UnitOccurrenceOrientation p 2 orientation) + (J : ProtoTile) (hfamily : J ∈ RegularTileFamily base (TilingLattice C)) + (hodo : TileOdometer C.1.1 J (D.functions F.slot false)) + (hcent : TileCentroid J = TileCentroid (D.tiles F.slot false)) : + ∃ G : P4458T1BoundaryFrame C orientation base Rminus J + hminus (D.functions F.slot false), + G.q = p ∧ G.slot = 2 ∧ G.outer.1.1 = F.q a.succ ∧ + G.tile = D.tiles a true ∧ G.odometer = D.functions a true := by +-- BODY + classical + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + have hr := FrameDiagonalProof.hrAt128 C orientation base Rminus Rplus + hminus hplus F a p hstep hslot + have hrstep := FrameDiagonalProof.hrstep C orientation base Rminus Rplus hminus hplus F a p hstep + have r1 := FrameDiagonalProof.r1 C orientation base Rminus Rplus hminus hplus F a p + hrstep + have r2 := FrameDiagonalProof.r2 C orientation base Rminus Rplus hminus hplus F a p + hrstep + have r3 := FrameDiagonalProof.r3 C orientation base Rminus Rplus hminus hplus F a p + hrstep + have hparent := FrameDiagonalProof.hparent C orientation base Rminus + Rplus hminus hplus F a p hstep hslot + have hparentR := FrameDiagonalProof.hparentR C orientation base Rminus + Rplus hminus hplus F a p r3 hparent + have hzero := FrameDiagonalProof.hzero C orientation base Rminus Rplus hminus + hplus F a + have hC := FrameDiagonalProof.hC C orientation base Rminus Rplus hminus hplus F p + hparent + have positiveA := FrameDiagonalProof.positiveA p hp + have positiveE := FrameDiagonalProof.positiveE C p hC + let I : GaussianInt := ⟨0, 1⟩ + let wv := BandVectors.1 (r 3) (r 2) + let xv := BandVectors.1 (r 1) (r 3) + let yv := BandVectors.1 (r 2) (r 1) + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + have laws := FrameDiagonalProof.laws C orientation base Rminus Rplus hminus hplus F a hr + let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] + have hrr := FrameDiagonalProof.hrr C orientation base Rminus Rplus + hminus hplus F a hr + have lawsR := FrameDiagonalProof.lawsR C orientation base Rminus Rplus hminus hplus F a hrr + have win := FrameDiagonalProof.win C orientation base + Rminus Rplus hminus hplus F a lawsR + have ain := FrameDiagonalProof.ain C orientation base + Rminus Rplus hminus hplus F a lawsR + have hv := FrameDiagonalProof.hv C orientation base Rminus Rplus hminus hplus F a laws + have ha := FrameDiagonalProof.ha C orientation base Rminus Rplus hminus hplus F a laws + have vflip := FrameDiagonalProof.vflip C orientation base Rminus Rplus hminus hplus F a hr laws + have aflip := FrameDiagonalProof.aflip C orientation base Rminus Rplus hminus hplus F a hr laws + have vflip' := FrameDiagonalProof.vflip' C orientation base Rminus Rplus hminus hplus F a vflip + have aflip' := FrameDiagonalProof.aflip' C orientation base Rminus Rplus hminus hplus F a aflip + have centMinus := FrameDiagonalProof.centMinus C orientation base Rminus Rplus hminus hplus F a + p r3 + hparent hzero win vflip' + have centJ := FrameDiagonalProof.centJ C orientation + base Rminus Rplus hminus hplus F D a p hstep hslot J hcent hr hrstep r1 r2 r3 hparentR + hzero laws hrr lawsR win ain hv ha vflip aflip vflip' aflip' centMinus + have centK := FrameDiagonalProof.centK C orientation + base Rminus Rplus hminus hplus F D a + have halfDiff {X Y Z : GaussianInt} (hxy : X - Y = Z) := FrameDiagonalProof.halfDiff (X := X) + (Y := Y) (Z + := Z) hxy + have hcentR := FrameDiagonalProof.hcentR C orientation + base Rminus Rplus hminus hplus F D a hv centMinus centK halfDiff + have hcentJ := FrameDiagonalProof.hcentJ C orientation + base Rminus Rplus hminus hplus F D a J hv centJ centK halfDiff + let e : GaussianInt := -I + have lawsP := FrameDiagonalProof.lawsP p hp + have pflip := FrameDiagonalProof.pflip p hp lawsP + have hxcoordV := FrameDiagonalProof.hxcoordV C orientation + base Rminus Rplus hminus hplus F a p r1 r3 + have hxcoordA := FrameDiagonalProof.hxcoordA C orientation + base Rminus Rplus hminus hplus F a p r1 r3 + have hI2 := FrameDiagonalProof.hI2 + have he2 := FrameDiagonalProof.he2 + have hIneg := FrameDiagonalProof.hIneg hI2 + have heneg := FrameDiagonalProof.heneg he2 + have hxv := FrameDiagonalProof.hxv C orientation base + Rminus Rplus hminus hplus F a p pflip hxcoordV + have hza := FrameDiagonalProof.hza C orientation base + Rminus Rplus hminus hplus F a p hIneg hxv + have hxa := FrameDiagonalProof.hxa C orientation base + Rminus Rplus hminus hplus F a p pflip hxcoordA + have hzaA := FrameDiagonalProof.hzaA C orientation base + Rminus Rplus hminus hplus F a p heneg hxa + have hminusVecV := FrameDiagonalProof.hminusVecV C orientation base Rminus Rplus hminus hplus + F a p hxcoordV hza + have hplusVecV := FrameDiagonalProof.hplusVecV C orientation base Rminus Rplus hminus hplus F + a p hxcoordV hza + have hminusVecA : BandVectors.2 (p 3) (p 0) - BandVectors.2 (p 0) (p 3) = + -e * xa - xa := FrameDiagonalProof.hminusVecA C orientation base Rminus Rplus hminus hplus + F a p hxcoordA hzaA + have hplusVecA : BandVectors.2 (p 3) (p 0) + BandVectors.2 (p 0) (p 3) = + -e * xa + xa := FrameDiagonalProof.hplusVecA C orientation base Rminus Rplus hminus hplus F + a p hxcoordA hzaA + have houterA := FrameDiagonalProof.houterA C orientation base Rminus Rplus + hminus hplus F a p hstep + let A : BandCircle := + ⟨⟨p 0, Or.inl positiveA, p, hp.1, 0, rfl⟩, positiveA⟩ + have hindicesA := FrameDiagonalProof.hindicesA C orientation base Rminus Rplus hminus hplus F a + have hvecA := FrameDiagonalProof.hvecA C orientation base Rminus Rplus hminus hplus F a hindicesA + have hslotplus2 := FrameDiagonalProof.hslotplus2 C orientation base Rminus + Rplus hminus hplus F D a p hstep hslot J hr hrstep r1 r2 r3 hparentR hzero laws hrr lawsR + win ain hv ha vflip aflip vflip' aflip' centMinus centJ centK hcentR hcentJ hxcoordV + hxcoordA hxv hza hxa hzaA hminusVecV hplusVecV hminusVecA hplusVecA houterA hindicesA hvecA + have hslotplus1 := FrameDiagonalProof.hslotplus1 C orientation base Rminus + Rplus hminus hplus F D a p hstep hslot J hr hrstep r1 r2 r3 hparentR hzero laws hrr lawsR + win ain hv ha vflip aflip vflip' aflip' centMinus centJ centK hcentR hcentJ hxcoordV + hxcoordA hxv hza hxa hzaA hminusVecV hplusVecV hminusVecA hplusVecA houterA hindicesA hvecA + hslotplus2 + have hindicesJ := FrameDiagonalProof.hindicesJ C orientation base Rminus + Rplus hminus hplus F a hslotplus2 hslotplus1 + have hvecJ := FrameDiagonalProof.hvecJ C orientation base Rminus Rplus + hminus hplus F a hindicesJ + have hpositiveSlot := FrameDiagonalProof.hpositiveSlot C orientation + base Rminus Rplus hminus hplus F + obtain hzA | ⟨rootA, sA, hrootA, hsA, hARe, hAIm⟩ := D.slopes a true + · rw [houterA] at hzA + omega + have hrootAEq := FrameDiagonalProof.hrootAEq C orientation base Rminus + Rplus hminus hplus F rootA hrootA + subst rootA + obtain hzJ | ⟨rootJ, sJ, hrootJ, hsJ, hJRe, hJIm⟩ := D.slopes F.slot false + · omega + have hrootJEq := FrameDiagonalProof.hrootJEq C orientation base Rminus + Rplus hminus hplus F rootJ hrootJ + subst rootJ + have slopeK := FrameDiagonalProof.slopeK C orientation + base Rminus Rplus hminus hplus F a hvecA sA hARe hAIm + have slopeJ := FrameDiagonalProof.slopeJ C orientation + base Rminus Rplus hminus hplus F a hvecJ sJ hJRe hJIm + have slopeMinusRoot := FrameDiagonalProof.slopeMinusRoot C orientation base Rminus Rplus hminus + hplus F a + hparentR hzero ain aflip' + have slopeMinusA := FrameDiagonalProof.slopeMinusA C + orientation base Rminus Rplus hminus hplus F a ha halfDiff sA slopeK slopeMinusRoot + have slopeJminusA := FrameDiagonalProof.slopeJminusA C + orientation base Rminus Rplus hminus hplus F a ha halfDiff sA sJ slopeK slopeJ + have centMinusA := FrameDiagonalProof.centMinusA + C orientation base Rminus Rplus hminus hplus F D a p hcentR hminusVecV + have centJA := FrameDiagonalProof.centJA C + orientation base Rminus Rplus hminus hplus F D a p J hcentJ hplusVecV + have hodoA := FrameDiagonalProof.hodoA C orientation base Rminus Rplus hminus hplus F D a p + houterA + let G : P4458T1BoundaryFrame C orientation base Rminus J hminus + (D.functions F.slot false) := { + outer := A + q := p + proper := hp + slot := 2 + child := rfl + parent := hC.symm + tile := D.tiles a true + odometer := D.functions a true + outer_odo := by + simpa [A] using hodoA + minus_odo := F.minus_odo + plus_odo := hodo + outer_band := by + simpa [A] using TileOdometerBandPrototile _ _ _ hodoA + base_band := F.base_band + minus_family := F.minus_family + plus_family := hfamily + chart := hchart + minus_centroid := centMinusA + plus_centroid := centJA + outer_slope := sA + minus_slope := F.minus_slope + plus_slope := sJ + slope_outer := hsA + slope_minus := F.slope_minus + slope_plus := hsJ + minus_difference := by + have h : BandVectors.2 (p (2 : Fin 3).succ) (p 0) - + BandVectors.2 (p 0) (p (2 : Fin 3).succ) = -e * xa - xa := by + simpa [e, xa] using hminusVecA + rw [h] + exact slopeMinusA + plus_difference := by + have h : BandVectors.2 (p (2 : Fin 3).succ) (p 0) + + BandVectors.2 (p 0) (p (2 : Fin 3).succ) = -e * xa + xa := by + simpa [e, xa] using hplusVecA + rw [h] + exact slopeJminusA + } + refine ⟨G, rfl, rfl, ?_, rfl, rfl⟩ + exact houterA.symm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1EndpointAlgebra.lean b/LeanPool/ApollonianSuperharmonic/P4536T1EndpointAlgebra.lean new file mode 100644 index 0000000000..76406900e5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4536T1EndpointAlgebra.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Tactic.LinearCombination +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P4536T1EndpointAlgebra] + +/-! +# P4536T1EndpointAlgebra + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4536T1EndpointAlgebra {R : Type*} [CommRing R] + (e w x y : R) (he : e ^ 2 = -1) (hs : w + x + y = 0) : + (-(w - e * w) - ((x - e * y) - e * (x - e * y)) = 2 * y) ∧ + ((x - e * y) + e * (x - e * y) + (w - e * w) = 2 * e * x) ∧ + (-(x - e * x) - (w - e * w) = y - e * y) ∧ + ((y - e * w) + e * (y - e * w) - (w - e * w) = y + e * y) ∧ + ((w - e * x) - e * (w - e * x) - (w - e * w) = -e * x - x) ∧ + (-(y - e * y) - (w - e * w) = -e * x + x) ∧ + ((y - e * w) - e * (y - e * w) - (y - e * y) = -e * w - w) ∧ + (-(x - e * x) - (y - e * y) = -e * w + w) ∧ + (-(y - e * y) - (x - e * x) = w - e * w) ∧ + ((w - e * x) + e * (w - e * x) - (x - e * x) = w + e * w) := by +-- BODY + have hw : w = -x - y := by linear_combination hs + subst w + constructor + · linear_combination -y * he + constructor + · linear_combination -y * he + constructor + · ring + constructor + · linear_combination (x + y) * he + constructor + · linear_combination x * he + constructor + · ring + constructor + · linear_combination -(x + y) * he + constructor + · ring + constructor + · ring + · linear_combination -x * he + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1EndpointDifferences.lean b/LeanPool/ApollonianSuperharmonic/P4536T1EndpointDifferences.lean new file mode 100644 index 0000000000..cacf2704c5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4536T1EndpointDifferences.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily +public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointAlgebra +public import LeanPool.ApollonianSuperharmonic.P4536T1HalfOffsetBridge +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P4536T1EndpointDifferences] + +/-! +# P4536T1EndpointDifferences + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4536T1EndpointDifferences + {C : BandCircle} {orientation : Bool} {base Rminus Rplus : ProtoTile} + {hminus hplus : PartialOdometer} + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) + (D : P4458T1RestrictionFamily F) : + ∃ s : ℝ × ℝ, + PartialOdometerSlope (D.functions F.slot false) = some s ∧ + TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = + GaussianRealPoint (BandVectors.1 (F.q (F.slot + 1).succ) (F.q F.slot.succ)) ∧ + TileCentroid Rplus - TileCentroid (D.tiles F.slot false) = + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (F.q F.slot.succ) (F.q (F.slot + 2).succ)) ∧ + s - F.minus_slope = + GaussianRealPoint (BandVectors.2 (F.q (F.slot + 1).succ) (F.q F.slot.succ)) ∧ + F.plus_slope - s = + GaussianRealPoint (-(⟨0, 1⟩ : GaussianInt) * + BandVectors.2 (F.q F.slot.succ) (F.q (F.slot + 2).succ)) := by +-- BODY + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q (F.slot + 1).succ, F.q (F.slot + 2).succ] + have hr : ProperBandQuadruple r := by + have rot : ∀ j : Fin 3, ProperBandQuadruple + ![F.q 0, F.q j.succ, F.q (j + 1).succ, F.q (j + 2).succ] := by + intro j + fin_cases j + · convert F.proper using 1; funext k; fin_cases k <;> rfl + · refine ⟨SemiProperQuadruple.rotate F.proper.1, ?_⟩ + intro k + fin_cases k + · exact F.proper.2 1 + · exact F.proper.2 2 + · exact F.proper.2 0 + · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate F.proper.1), ?_⟩ + intro k + fin_cases k + · exact F.proper.2 2 + · exact F.proper.2 0 + · exact F.proper.2 1 + exact rot F.slot + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (r 3) (r 2) + let x := BandVectors.1 (r 1) (r 3) + let y := BandVectors.1 (r 2) (r 1) + let wa := BandVectors.2 (r 3) (r 2) + let xa := BandVectors.2 (r 1) (r 3) + let ya := BandVectors.2 (r 2) (r 1) + have laws := VectorRecursionLaws r hr.1 + have vflip : BandVectors.1 (r 0) (r 1) = I * BandVectors.1 (r 1) (r 0) := + (laws.2.2.2.2 hr 0).1 + have aflip : BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0) := + (laws.2.2.2.2 hr 0).2 + have hv := P4536T1EndpointAlgebra I w x y (by decide +kernel) laws.1 + have ha := P4536T1EndpointAlgebra (-I) wa xa ya (by decide +kernel) laws.2.1 + have vm : TileCentroid Rminus - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint ((x - I * y) - I * (x - I * y)) := by + have h := F.minus_centroid + change TileCentroid Rminus - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1)) at h + rw [vflip, laws.2.2.1] at h + exact h + have vp : TileCentroid Rplus - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint ((x - I * y) + I * (x - I * y)) := by + have h := F.plus_centroid + change TileCentroid Rplus - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1)) at h + rw [vflip, laws.2.2.1] at h + exact h + have vn : TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint (-(w - I * w)) := by + have h := (D.occurrences F.slot false).2.2 + change TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = + (-1 : ℝ) • ((1 / 2 : ℝ) • + (GaussianRealPoint w - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) at h + rw [h] + ext <;> simp [GaussianRealPoint, I, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring + have pos : 0 < (F.q F.slot.succ).1 := F.parent ▸ C.2 + rcases D.slopes F.slot false with hz | ⟨root, s, hroot, hs, hre, him⟩ + · omega + have hrootEq : root = F.outer_slope := Option.some.inj (hroot.symm.trans F.slope_outer) + subst root + have an : s - F.outer_slope = + (1 / 2 : ℝ) • GaussianRealPoint (-(wa - (-I) * wa)) := by + change s.1 - F.outer_slope.1 = -1 * (1 / 2 : ℝ) * + ((wa.re : ℝ) - (wa.im : ℝ)) at hre + change s.2 - F.outer_slope.2 = -1 * (1 / 2 : ℝ) * + ((wa.im : ℝ) + (wa.re : ℝ)) at him + apply Prod.ext + · simp [GaussianRealPoint, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at hre ⊢ + linarith [hre] + · simp [GaussianRealPoint, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at him ⊢ + linarith [him] + have am : F.minus_slope - F.outer_slope = (1 / 2 : ℝ) • + GaussianRealPoint ((xa - (-I) * ya) - (-I) * (xa - (-I) * ya)) := by + have h := F.minus_difference + change F.minus_slope - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1)) at h + rw [aflip, laws.2.2.2.1] at h + simpa only [sub_neg_eq_add, neg_mul] using h + have ap : F.plus_slope - F.outer_slope = (1 / 2 : ℝ) • + GaussianRealPoint ((xa - (-I) * ya) + (-I) * (xa - (-I) * ya)) := by + have h := F.plus_difference + change F.plus_slope - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (r 1) (r 0) + BandVectors.2 (r 0) (r 1)) at h + rw [aflip, laws.2.2.2.1] at h + simpa only [sub_neg_eq_add, neg_mul] using h + refine ⟨s, hs, ?_, ?_, ?_, ?_⟩ + · change TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = GaussianRealPoint y + calc + _ = (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile) - + (TileCentroid Rminus - TileCentroid F.tile) := by abel + _ = _ := by rw [vn, vm]; exact P4536T1HalfOffsetBridge _ _ _ hv.1 + · change TileCentroid Rplus - TileCentroid (D.tiles F.slot false) = GaussianRealPoint (I * x) + calc + _ = (TileCentroid Rplus - TileCentroid F.tile) - + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile) := by abel + _ = _ := by + rw [vp, vn] + apply P4536T1HalfOffsetBridge + simpa only [sub_neg_eq_add, mul_assoc] using hv.2.1 + · change s - F.minus_slope = GaussianRealPoint ya + calc + _ = (s - F.outer_slope) - (F.minus_slope - F.outer_slope) := by abel + _ = _ := by rw [an, am]; exact P4536T1HalfOffsetBridge _ _ _ ha.1 + · change F.plus_slope - s = GaussianRealPoint (-I * xa) + calc + _ = (F.plus_slope - F.outer_slope) - (s - F.outer_slope) := by abel + _ = _ := by + rw [ap, an] + apply P4536T1HalfOffsetBridge + simpa only [sub_neg_eq_add, mul_assoc] using ha.2.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1HalfOffsetBridge.lean b/LeanPool/ApollonianSuperharmonic/P4536T1HalfOffsetBridge.lean new file mode 100644 index 0000000000..502e2929dd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4536T1HalfOffsetBridge.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P4536T1HalfOffsetBridge] + +/-! +# P4536T1HalfOffsetBridge + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4536T1HalfOffsetBridge (A B C : GaussianInt) (h : B - C = 2 * A) : + (1 / 2 : ℝ) • GaussianRealPoint B - + (1 / 2 : ℝ) • GaussianRealPoint C = GaussianRealPoint A := by +-- BODY + have hre := congrArg (fun z : GaussianInt => z.re) h + have him := congrArg (fun z : GaussianInt => z.im) h + have hreZ : B.re - C.re = 2 * A.re := by simpa using hre + have himZ : B.im - C.im = 2 * A.im := by simpa using him + have hreR : (B.re : ℝ) - (C.re : ℝ) = 2 * (A.re : ℝ) := by + exact_mod_cast hreZ + have himR : (B.im : ℝ) - (C.im : ℝ) = 2 * (A.im : ℝ) := by + exact_mod_cast himZ + apply Prod.ext + · change (1 / 2 : ℝ) * (B.re : ℝ) - + (1 / 2 : ℝ) * (C.re : ℝ) = (A.re : ℝ) + linarith + · change (1 / 2 : ℝ) * (B.im : ℝ) - + (1 / 2 : ℝ) * (C.im : ℝ) = (A.im : ℝ) + linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1RegularJoin.lean b/LeanPool/ApollonianSuperharmonic/P4536T1RegularJoin.lean new file mode 100644 index 0000000000..267e0dd107 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4536T1RegularJoin.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P4536T1RegularJoin] + +/-! +# P4536T1RegularJoin + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4536T1RegularJoin + {C : BandCircle} {orientation : Bool} {base Rminus Rplus : ProtoTile} + {hminus hplus : PartialOdometer} + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) + (D : P4458T1RestrictionFamily F) + (hcenter : TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = + GaussianRealPoint (BandVectors.1 (F.q (F.slot + 1).succ) (F.q F.slot.succ))) : + ∃ J : ProtoTile, + J ∈ RegularTileFamily base (TilingLattice C) ∧ + TileCentroid J = TileCentroid (D.tiles F.slot false) ∧ + J.cells = (D.tiles F.slot false).cells ∧ + TileOdometer C.1.1 J (D.functions F.slot false) ∧ + AncestorOdometer C.1.1 F.outer.1.1 + J F.tile (D.functions F.slot false) F.odometer ∧ + BandSubtileOccurrence F.q F.tile F.slot false J := by +-- BODY + let y := BandVectors.1 (F.q (F.slot + 1).succ) (F.q F.slot.succ) + have hy : y ∈ TilingLattice C := + (ParentVectorsInTilingLattice F.q F.proper F.slot C F.parent).1 + obtain ⟨r, hr, hR⟩ := F.minus_family + let J := TileTranslation base (r + y) + have hfamily : J ∈ RegularTileFamily base (TilingLattice C) := + ⟨r + y, (TilingLattice C).add_mem hr hy, rfl⟩ + have hband : BandPrototile C.1.1 J := + BandPrototileTranslation C.1.1 base (r + y) F.base_band + have hJcenter : TileCentroid J - TileCentroid Rminus = GaussianRealPoint y := by + rw [hR] + change TileCentroid (TileTranslation base (r + y)) - + TileCentroid (TileTranslation base r) = GaussianRealPoint y + rw [(TileTranslationFormulas base (r + y)).2.2.2.2.1, + (TileTranslationFormulas base r).2.2.2.2.1] + ext <;> simp [GaussianRealPoint] + have hcent : TileCentroid J = TileCentroid (D.tiles F.slot false) := by + calc + TileCentroid J = (TileCentroid J - TileCentroid Rminus) + + TileCentroid Rminus := (sub_add_cancel _ _).symm + _ = GaussianRealPoint y + TileCentroid Rminus := by rw [hJcenter] + _ = TileCentroid (D.tiles F.slot false) := by rw [← hcenter]; abel + have hpos : 0 < (F.q F.slot.succ).1 := F.parent ▸ C.2 + have hNband : BandPrototile C.1.1 (D.tiles F.slot false) := + F.parent ▸ (D.occurrences F.slot false).1 + have hcells : (D.tiles F.slot false).cells = J.cells := + (BandPrototileCentroidUnique C.1.1 _ J hNband hband hcent.symm).1 + have hodo : TileOdometer C.1.1 J (D.functions F.slot false) := + PositiveCurvatureTileOdometerSupportTransport C.1.1 _ J _ C.2 + (F.parent ▸ D.odometers F.slot false) hband hcells + have hstrict : (F.q F.slot.succ).1 < F.outer.1.1.1 := + F.child ▸ F.proper.2 F.slot + have hanc : AncestorOdometer C.1.1 F.outer.1.1 + J F.tile (D.functions F.slot false) F.odometer := by + have h := AncestorOdometerInnerSupportNormalization + (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) J F.tile + (D.functions F.slot false) F.odometer hpos hstrict + (D.ancestors F.slot false hpos) (F.parent.symm ▸ hband) hcells + exact F.parent ▸ h + have hdom := PositiveCurvatureTileOdometerDomain C.1.1 J _ C.2 hodo + have houterdom := PositiveCurvatureTileOdometerDomain F.outer.1.1 F.tile _ + F.outer.2 F.outer_odo + have hfoot : FootprintVertices J ⊆ FootprintVertices F.tile := by + intro z hz + rw [← houterdom] + apply D.domain_subset F.slot false + change z ∈ ((D.functions F.slot false).domain : Set GaussianInt) + rwa [hdom] + refine ⟨J, hfamily, hcent, hcells.symm, hodo, hanc, + F.parent.symm ▸ hband, hfoot, ?_⟩ + rw [hcent] + exact (D.occurrences F.slot false).2.2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1SmallUnitSides.lean b/LeanPool/ApollonianSuperharmonic/P4536T1SmallUnitSides.lean new file mode 100644 index 0000000000..eeda61b34d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4536T1SmallUnitSides.lean @@ -0,0 +1,190 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointDifferences +public import LeanPool.ApollonianSuperharmonic.P4536T1TangentPairMatrix +public import LeanPool.ApollonianSuperharmonic.BandOrientedBoundaryOccurrenceGenealogy +public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure + +-- [TABLET NODE: P4536T1SmallUnitSides] + +/-! +# P4536T1SmallUnitSides + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4536T1SmallUnitSides + {C : BandCircle} {orientation : Bool} {base Rminus Rplus : ProtoTile} + {hminus hplus : PartialOdometer} + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) + (D : P4458T1RestrictionFamily F) + (a : Fin 3) (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (hstep : ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3]) + (small : ((p 2).1 = 0 ∨ (p 2).1 = 1) ∧ + ((p 3).1 = 0 ∨ (p 3).1 = 1)) + (J : ProtoTile) (hfamily : J ∈ RegularTileFamily base (TilingLattice C)) + (hodo : TileOdometer C.1.1 J (D.functions F.slot false)) + (hcent : TileCentroid J = TileCentroid (D.tiles F.slot false)) : + (F.slot = a + 1 → + TileString C orientation base Rminus J [Rminus, J] ∧ + LeftLatticeAdjacent C Rminus J hminus (D.functions F.slot false)) ∧ + (F.slot = a + 2 → + TileString C orientation base J Rplus [J, Rplus] ∧ + LeftLatticeAdjacent C J Rplus (D.functions F.slot false) hplus) := by +-- BODY + classical + let q : Fin 4 → CircleCoordinates := + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3] + have hqB : F.q (a + 1).succ = p 2 := by simpa using congrFun hstep 2 + have hqD : F.q (a + 2).succ = p 3 := by simpa using congrFun hstep 3 + have eta : ![F.q 0, F.q 1, F.q 2, F.q 3] = F.q := by + funext k + fin_cases k <;> rfl + have large (t : Fin 4 → CircleCoordinates) (ht : ProperBandQuadruple t) : + 1 < (t 0).1 := by + have f := ProperBandCurvatureStructure t ht + have n0 := f.2.1 0 + have n1 := f.2.1 1 + have l0 := ht.2 0 + have l1 := ht.2 1 + by_contra h + have z0 : (t (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (t (1 : Fin 3).succ).1 = 0 := by omega + exact (by decide : (0 : Fin 3) ≠ 1) (f.2.2 0 1 z0 z1) + have steps : + (∀ e, UnitOccurrenceOrientation q 1 e → + UnitTriangularStep e (BandVectors.1 (p 3) (p 2))) ∧ + (∀ e, UnitOccurrenceOrientation q 2 e → + UnitTriangularStep e ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (p 3) (p 2))) := by + rcases (BandOrientedBoundaryOccurrenceGenealogy p hp).2.2.2.2.2 with + ⟨_, hd⟩ | ⟨t, ht, ht0, _⟩ | ⟨t, ht, ht0, _⟩ + · rcases hd with ⟨_, hB, hD, _⟩ | ⟨_, hB, hD, _⟩ <;> + exact ⟨fun e he => (hB e he).1, fun e he => (hD e he).1⟩ + · have hl := large t ht + rw [ht0] at hl + rcases small.1 with h | h <;> omega + · have hl := large t ht + rw [ht0] at hl + rcases small.2 with h | h <;> omega + obtain ⟨s, hs, cvL, cvR, caL, caR⟩ := P4536T1EndpointDifferences F D + rw [← hcent] at cvL cvR + have unit_side (U V : ProtoTile) (g h : PartialOdometer) (r t : ℝ × ℝ) + (v b : GaussianInt) (hu : C.1.1.1 = 1) + (hU : TileOdometer C.1.1 U g) (hV : TileOdometer C.1.1 V h) + (hUf : U ∈ RegularTileFamily base (TilingLattice C)) + (hVf : V ∈ RegularTileFamily base (TilingLattice C)) + (hr : PartialOdometerSlope g = some r) (ht : PartialOdometerSlope h = some t) + (hv : UnitTriangularStep orientation v) + (hc : TileCentroid V - TileCentroid U = GaussianRealPoint v) + (hb : t - r = GaussianRealPoint b) + (hm : (b.re : ℝ) = CircleMatrix C 0 0 * v.re + CircleMatrix C 0 1 * v.im ∧ + (b.im : ℝ) = CircleMatrix C 1 0 * v.re + CircleMatrix C 1 1 * v.im) : + TileString C orientation base U V [U, V] ∧ LeftLatticeAdjacent C U V g h := by + have hv0 : v ≠ 0 := by + intro hz + rw [hz] at hv + cases orientation <;> norm_num [UnitTriangularStep, Zsqrtd.ext_iff] at hv + have hne : U ≠ V := by + intro heq + have hp : GaussianRealPoint v = 0 := by rw [← hc, heq, sub_self] + apply hv0 + apply Zsqrtd.ext + · have he := congrArg Prod.fst hp + change (v.re : ℝ) = 0 at he + exact_mod_cast he + · have he := congrArg Prod.snd hp + change (v.im : ℝ) = 0 at he + exact_mod_cast he + constructor + · refine ⟨F.base_band, rfl, rfl, ?_, ?_, ?_, ?_⟩ + · simpa using hne + · intro T hT + simp only [List.mem_cons, List.not_mem_nil, or_false] at hT + rcases hT with rfl | rfl + · exact hUf + · exact hVf + · simpa [List.IsChain, List.isChain_pair, hu] using (show + ∃ w, UnitTriangularStep orientation w ∧ + TileCentroid V - TileCentroid U = GaussianRealPoint w from ⟨v, hv, hc⟩) + · intro pre T post heq hpre hpost + have hlen := congrArg List.length heq + have hp : 1 ≤ pre.length := List.length_pos_iff.mpr hpre + have hq : 1 ≤ post.length := List.length_pos_iff.mpr hpost + simp at hlen + omega + · refine ⟨hU, hV, r, t, hr, ht, Or.inl ⟨hu, orientation, v, hv, hc, ?_, ?_⟩⟩ + · exact (congrArg Prod.fst hb).trans hm.1 + · exact (congrArg Prod.snd hb).trans hm.2 + constructor + · intro hslot + have hc : p 2 = C.1.1 := by rw [← hqB, ← hslot]; exact F.parent + have hu : C.1.1.1 = 1 := by + have he := congrArg Prod.fst hc + have hp := C.2 + rcases small.1 with h | h <;> omega + have chart : UnitOccurrenceOrientation q 1 orientation := by + have h := F.chart hu + have hrot : UnitOccurrenceOrientation + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] 1 orientation := by + fin_cases a + · simpa [hslot, eta] using h + · simpa [hslot] using UnitOccurrenceOrientation.rotate h + · simpa [hslot] using UnitOccurrenceOrientation.rotate (UnitOccurrenceOrientation.rotate h) + rw [hstep] at hrot + exact hrot + have hi : (a + 1) + 1 = a + 2 := by fin_cases a <;> decide + rw [hslot, hi, hqD, hqB] at cvL caL + exact unit_side Rminus J hminus _ F.minus_slope s _ _ hu F.minus_odo hodo + F.minus_family hfamily F.slope_minus hs (steps.1 orientation chart) cvL caL + (P4536T1TangentPairMatrix C p hp.1 3 2 (by decide) hc) + · intro hslot + have hc : p 3 = C.1.1 := by rw [← hqD, ← hslot]; exact F.parent + have hu : C.1.1.1 = 1 := by + have he := congrArg Prod.fst hc + have hp := C.2 + rcases small.2 with h | h <;> omega + have chart : UnitOccurrenceOrientation q 2 orientation := by + have h := F.chart hu + have hrot : UnitOccurrenceOrientation + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] 2 orientation := by + fin_cases a + · simpa [hslot, eta] using h + · simpa [hslot] using UnitOccurrenceOrientation.rotate h + · simpa [hslot] using UnitOccurrenceOrientation.rotate (UnitOccurrenceOrientation.rotate h) + rw [hstep] at hrot + exact hrot + have hi : (a + 2) + 2 = a + 1 := by fin_cases a <;> decide + rw [hslot, hi, hqD, hqB] at cvR caR + apply unit_side J Rplus _ hplus s F.plus_slope _ _ hu hodo F.plus_odo + hfamily F.plus_family hs F.slope_plus (steps.2 orientation chart) cvR caR + have hm := P4536T1TangentPairMatrix C p hp.1 2 3 (by decide) hc + rcases BandVectorOrientationDichotomy (p 3) (p 2) + ⟨p, hp.1, 3, 2, by decide, rfl, rfl⟩ with ⟨hv, ha⟩ | ⟨hv, ha⟩ + · rw [hv, ha] + exact hm + · rw [hv, ha] + constructor + · simpa only [Zsqrtd.re_neg, Zsqrtd.im_neg, Int.cast_neg, mul_neg, ← neg_add] + using congrArg Neg.neg hm.1 + · simpa only [Zsqrtd.re_neg, Zsqrtd.im_neg, Int.cast_neg, mul_neg, ← neg_add] + using congrArg Neg.neg hm.2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1TangentPairMatrix.lean b/LeanPool/ApollonianSuperharmonic/P4536T1TangentPairMatrix.lean new file mode 100644 index 0000000000..6b5842f28d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4536T1TangentPairMatrix.lean @@ -0,0 +1,107 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing +public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct + +-- [TABLET NODE: P4536T1TangentPairMatrix] + +/-! +# P4536T1TangentPairMatrix + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4536T1TangentPairMatrix (C : BandCircle) + (q : Fin 4 → CircleCoordinates) (hq : SemiProperQuadruple q) + (i j : Fin 4) (hij : i ≠ j) (hC : q j = C.1.1) : + (BandVectors.2 (q i) (q j)).re = + CircleMatrix C 0 0 * (BandVectors.1 (q i) (q j)).re + + CircleMatrix C 0 1 * (BandVectors.1 (q i) (q j)).im ∧ + (BandVectors.2 (q i) (q j)).im = + CircleMatrix C 1 0 * (BandVectors.1 (q i) (q j)).re + + CircleMatrix C 1 1 * (BandVectors.1 (q i) (q j)).im := by +-- BODY + have hpos : 0 < (q j).1 := hC ▸ C.2 + have hv := VectorNonvanishing q hq i j hij (Or.inr hpos) + have hident := VectorSquareProduct q hq i j hij + have htan := TangencyCoordinateIdentity q hq i j hij + have hnorm : Zsqrtd.norm (BandVectors.1 (q i) (q j)) = (q i).1 + (q j).1 := by + have hs : Zsqrtd.norm (BandVectors.1 (q i) (q j)) ^ 2 = + ((q i).1 + (q j).1) ^ 2 := by + calc + _ = Zsqrtd.norm (BandVectors.1 (q i) (q j) ^ 2) := by + simp [pow_two] + _ = _ := by rw [hident.1]; exact htan + have hn := GaussianInt.norm_nonneg (BandVectors.1 (q i) (q j)) + have nn := (SemiProperForestClassification q hq).1 + have hc := add_nonneg (nn i) (nn j) + nlinarith + have hgauss : BandVectors.1 (q i) (q j) + + (q j).2 * star (BandVectors.1 (q i) (q j)) = + (2 : GaussianInt) * (q j).1 * BandVectors.2 (q i) (q j) := by + apply mul_left_cancel₀ hv + calc + _ = BandVectors.1 (q i) (q j) ^ 2 + + (q j).2 * (BandVectors.1 (q i) (q j) * + star (BandVectors.1 (q i) (q j))) := by ring + _ = (q j).1 * ((q i).2 + (q j).2) := by + rw [← Zsqrtd.norm_eq_mul_conj, hnorm, hident.1] + push_cast + ring + _ = _ := by + rw [← hident.2] + ring + have hre := congrArg Zsqrtd.re hgauss + have him := congrArg Zsqrtd.im hgauss + simp? at hre him + rw [hC] at hre him + have hrer : ((BandVectors.1 (q i) C.1.1).re : ℝ) + + ((C.1.1.2.re : ℝ) * (BandVectors.1 (q i) C.1.1).re + + (C.1.1.2.im : ℝ) * (BandVectors.1 (q i) C.1.1).im) = + 2 * (C.1.1.1 : ℝ) * (BandVectors.2 (q i) C.1.1).re := by + exact_mod_cast hre + have himr : ((BandVectors.1 (q i) C.1.1).im : ℝ) + + (-((C.1.1.2.re : ℝ) * (BandVectors.1 (q i) C.1.1).im) + + (C.1.1.2.im : ℝ) * (BandVectors.1 (q i) C.1.1).re) = + 2 * (C.1.1.1 : ℝ) * (BandVectors.2 (q i) C.1.1).im := by + exact_mod_cast him + have hcurv : 0 < (C.1.1.1 : ℝ) := by exact_mod_cast C.2 + have hmatrix : CircleMatrix C = + (2 * (C.1.1.1 : ℝ))⁻¹ • + ![![1 + (C.1.1.2.re : ℝ), (C.1.1.2.im : ℝ)], + ![(C.1.1.2.im : ℝ), 1 - (C.1.1.2.re : ℝ)]] := by + ext k l + fin_cases k <;> fin_cases l <;> + simp [CircleMatrix, BandCircleEuclideanData] + all_goals field_simp + rw [hC, hmatrix] + constructor + · change (BandVectors.2 (q i) C.1.1).re = + (2 * (C.1.1.1 : ℝ))⁻¹ * (1 + (C.1.1.2.re : ℝ)) * + (BandVectors.1 (q i) C.1.1).re + + (2 * (C.1.1.1 : ℝ))⁻¹ * (C.1.1.2.im : ℝ) * + (BandVectors.1 (q i) C.1.1).im + field_simp [ne_of_gt hcurv] + nlinarith [hrer] + · change (BandVectors.2 (q i) C.1.1).im = + (2 * (C.1.1.1 : ℝ))⁻¹ * (C.1.1.2.im : ℝ) * + (BandVectors.1 (q i) C.1.1).re + + (2 * (C.1.1.1 : ℝ))⁻¹ * (1 - (C.1.1.2.re : ℝ)) * + (BandVectors.1 (q i) C.1.1).im + field_simp [ne_of_gt hcurv] + nlinarith [himr] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4549T1DeeperFrameB.lean b/LeanPool/ApollonianSuperharmonic/P4549T1DeeperFrameB.lean new file mode 100644 index 0000000000..60928d711f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4549T1DeeperFrameB.lean @@ -0,0 +1,205 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily +public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointAlgebra +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P4549T1DeeperFrameB] + +/-! +# P4549T1DeeperFrameB + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4549T1DeeperFrameB + {C : BandCircle} {orientation : Bool} {base Rminus Rplus : ProtoTile} + {hminus hplus : PartialOdometer} + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) + (D : P4458T1RestrictionFamily F) + (a : Fin 3) (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (hstep : ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3]) + (hslot : F.slot = a + 1) + (t : Fin 4 → CircleCoordinates) (ht : ProperBandQuadruple t) + (ht0 : t 0 = p 3) (ht1 : t 1 = p 2) + (hchart : C.1.1.1 = 1 → UnitOccurrenceOrientation t 0 orientation) + (J : ProtoTile) (hfamily : J ∈ RegularTileFamily base (TilingLattice C)) + (hodo : TileOdometer C.1.1 J (D.functions F.slot false)) + (hcent : TileCentroid J = TileCentroid (D.tiles F.slot false)) : + ∃ G : P4458T1BoundaryFrame C orientation base Rminus J + hminus (D.functions F.slot false), + G.q = t ∧ G.slot = 0 ∧ G.outer.1.1 = F.q (a + 2).succ ∧ + G.tile = D.tiles (a + 2) true ∧ G.odometer = D.functions (a + 2) true := by +-- BODY + have hqA : F.q a.succ = p 0 := by simpa using congrFun hstep 1 + have hqB : F.q (a + 1).succ = p 2 := by simpa using congrFun hstep 2 + have hqE : F.q (a + 2).succ = p 3 := by simpa using congrFun hstep 3 + have hparent : t 1 = C.1.1 := by rw [ht1, ← hqB, ← hslot]; exact F.parent + have hEpos : 0 < (p 3).1 := ht0 ▸ (ProperBandCurvatureStructure t ht).1 + have hEpos' : 0 < (F.q (a + 2).succ).1 := hqE.symm ▸ hEpos + have hBpos : 0 < (F.q F.slot.succ).1 := F.parent ▸ C.2 + have idx1 : a + 2 + 1 = a := by fin_cases a <;> rfl + have idx2 : a + 2 + 2 = a + 1 := by fin_cases a <;> rfl + have idx3 : a + 1 + 1 = a + 2 := by fin_cases a <;> rfl + have idx4 : a + 1 + 2 = a := by fin_cases a <;> rfl + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + have hr : SemiProperQuadruple r := by + dsimp [r] + rw [hstep] + exact SemiProperQuadruple.successor hp.1 + let I : GaussianInt := ⟨0, 1⟩ + let w := BandVectors.1 (p 3) (p 2) + let x := BandVectors.1 (p 0) (p 3) + let y := BandVectors.1 (p 2) (p 0) + let z := BandVectors.1 (p 2) (p 3) + let wa := BandVectors.2 (p 3) (p 2) + let xa := BandVectors.2 (p 0) (p 3) + let ya := BandVectors.2 (p 2) (p 0) + let za := BandVectors.2 (p 2) (p 3) + have laws := VectorRecursionLaws r hr + have rotated := VectorRecursionLaws _ (SemiProperQuadruple.rotate hr) + have vrec : BandVectors.1 (F.q F.slot.succ) (F.q 0) = y - I * w := by + simpa [r, hslot, hqA, hqB, hqE, y, w, I] using rotated.2.2.1 + have arec : BandVectors.2 (F.q F.slot.succ) (F.q 0) = ya - (-I) * wa := by + simpa [r, hslot, hqA, hqB, hqE, ya, wa, I, neg_mul] using rotated.2.2.2.1 + have vflip := ((VectorRecursionLaws F.q F.proper.1).2.2.2.2 F.proper F.slot).1 + have aflip := ((VectorRecursionLaws F.q F.proper.1).2.2.2.2 F.proper F.slot).2 + have vw : w = I * z := by + simpa [w, z, ht0, ht1, I] using + ((VectorRecursionLaws t ht.1).2.2.2.2 ht 0).1 + have aw : wa = (-I) * za := by + simpa [wa, za, ht0, ht1, I] using + ((VectorRecursionLaws t ht.1).2.2.2.2 ht 0).2 + have offsets (e w x y z : GaussianInt) (he : e ^ 2 = -1) + (hs : w + x + y = 0) (hf : w = e * z) : + ((y - e * w) - e * (y - e * w) - (y - e * y) = z - w) ∧ + (-(x - e * x) - (y - e * y) = z + w) := by + have hz : z = -e * w := by + rw [hf] + linear_combination z * he + have h := P4536T1EndpointAlgebra e w x y he hs + constructor + · rw [hz]; exact h.2.2.2.2.2.2.1 + · rw [hz]; exact h.2.2.2.2.2.2.2.1 + have hv := offsets I w x y z (by decide +kernel) + (by simpa [r, hqA, hqB, hqE, w, x, y] using laws.1) vw + have ha := offsets (-I) wa xa ya za (by decide +kernel) + (by simpa [r, hqA, hqB, hqE, wa, xa, ya] using laws.2.1) aw + have half_sub (A B H : GaussianInt) (h : A - B = H) : + (1 / 2 : ℝ) • GaussianRealPoint A - (1 / 2 : ℝ) • GaussianRealPoint B = + (1 / 2 : ℝ) • GaussianRealPoint H := by + rw [← h] + ext <;> simp [GaussianRealPoint] <;> ring + have vm : TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • + GaussianRealPoint ((y - I * w) - I * (y - I * w)) := by + rw [F.minus_centroid, vflip, vrec] + have vn : TileCentroid J - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * x)) := by + rw [hcent] + have h := (D.occurrences F.slot false).2.2 + rw [hslot, idx3, idx4, hqA, hqE] at h + change TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = _ + rw [hslot, h] + ext <;> simp [GaussianRealPoint, x, I, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring + have ve : TileCentroid (D.tiles (a + 2) true) - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint (y - I * y) := by + have h := (D.occurrences (a + 2) true).2.2 + rw [idx1, idx2, hqA, hqB] at h + rw [h] + ext <;> simp [GaussianRealPoint, y, I, Zsqrtd.re_mul, Zsqrtd.im_mul] + rcases D.slopes F.slot false with hz | ⟨root, sJ, hroot, hsJ, hre, him⟩ + · omega + have hrootEq : root = F.outer_slope := Option.some.inj (hroot.symm.trans F.slope_outer) + subst root + have an : sJ - F.outer_slope = + (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa)) := by + rw [hslot, idx3, idx4, hqA, hqE] at hre him + apply Prod.ext <;> + simp [GaussianRealPoint, xa, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at hre him ⊢ <;> + linarith + rcases D.slopes (a + 2) true with hz | ⟨root, sE, hroot, hsE, hre, him⟩ + · omega + have hrootEq : root = F.outer_slope := Option.some.inj (hroot.symm.trans F.slope_outer) + subst root + have ae : sE - F.outer_slope = + (1 / 2 : ℝ) • GaussianRealPoint (ya - (-I) * ya) := by + rw [idx1, idx2, hqA, hqB] at hre him + apply Prod.ext <;> + simp [GaussianRealPoint, ya, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at hre him ⊢ <;> + linarith + have am : F.minus_slope - F.outer_slope = (1 / 2 : ℝ) • + GaussianRealPoint ((ya - (-I) * wa) - (-I) * (ya - (-I) * wa)) := by + rw [F.minus_difference, aflip, arec] + have vmE : TileCentroid Rminus - TileCentroid (D.tiles (a + 2) true) = + (1 / 2 : ℝ) • GaussianRealPoint (z - w) := by + calc + _ = (TileCentroid Rminus - TileCentroid F.tile) - + (TileCentroid (D.tiles (a + 2) true) - TileCentroid F.tile) := by abel + _ = _ := by rw [vm, ve]; exact half_sub _ _ _ hv.1 + have vnE : TileCentroid J - TileCentroid (D.tiles (a + 2) true) = + (1 / 2 : ℝ) • GaussianRealPoint (z + w) := by + calc + _ = (TileCentroid J - TileCentroid F.tile) - + (TileCentroid (D.tiles (a + 2) true) - TileCentroid F.tile) := by abel + _ = _ := by rw [vn, ve]; exact half_sub _ _ _ hv.2 + have amE : F.minus_slope - sE = + (1 / 2 : ℝ) • GaussianRealPoint (za - wa) := by + calc + _ = (F.minus_slope - F.outer_slope) - (sE - F.outer_slope) := by abel + _ = _ := by rw [am, ae]; exact half_sub _ _ _ ha.1 + have anE : sJ - sE = (1 / 2 : ℝ) • GaussianRealPoint (za + wa) := by + calc + _ = (sJ - F.outer_slope) - (sE - F.outer_slope) := by abel + _ = _ := by rw [an, ae]; exact half_sub _ _ _ ha.2 + let outer : BandCircle := + ⟨⟨p 3, Or.inl hEpos, t, ht.1, 0, ht0⟩, hEpos⟩ + have houterOdo : TileOdometer (p 3) (D.tiles (a + 2) true) + (D.functions (a + 2) true) := hqE ▸ D.odometers (a + 2) true + refine ⟨{ + outer := outer + q := t + proper := ht + slot := 0 + child := ht0 + parent := hparent + tile := D.tiles (a + 2) true + odometer := D.functions (a + 2) true + outer_odo := houterOdo + minus_odo := F.minus_odo + plus_odo := hodo + outer_band := TileOdometerBandPrototile _ _ _ houterOdo + base_band := F.base_band + minus_family := F.minus_family + plus_family := hfamily + chart := hchart + minus_centroid := by simpa only [Fin.succ_zero_eq_one, ht0, ht1, z, w] using vmE + plus_centroid := by simpa only [Fin.succ_zero_eq_one, ht0, ht1, z, w] using vnE + outer_slope := sE + minus_slope := F.minus_slope + plus_slope := sJ + slope_outer := hsE + slope_minus := F.slope_minus + slope_plus := hsJ + minus_difference := by simpa only [Fin.succ_zero_eq_one, ht0, ht1, za, wa] using amE + plus_difference := by simpa only [Fin.succ_zero_eq_one, ht0, ht1, za, wa] using anE + }, rfl, rfl, hqE.symm, rfl, rfl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4549T1NegativeIncomingSide.lean b/LeanPool/ApollonianSuperharmonic/P4549T1NegativeIncomingSide.lean new file mode 100644 index 0000000000..0a665d61af --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4549T1NegativeIncomingSide.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileString +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P4549T1NegativeIncomingSide] + +/-! +# P4549T1NegativeIncomingSide + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4549T1NegativeIncomingSide + {C : BandCircle} {orientation : Bool} + (t : Fin 4 → CircleCoordinates) (ht : ProperBandQuadruple t) + (htC : t 0 = C.1.1) + (base U V : ProtoTile) (g h : PartialOdometer) + (hbase : BandPrototile C.1.1 base) + (hU : U ∈ RegularTileFamily base (TilingLattice C)) + (hV : V ∈ RegularTileFamily base (TilingLattice C)) + (hg : TileOdometer C.1.1 U g) (hh : TileOdometer C.1.1 V h) + (sU sV : ℝ × ℝ) + (hsU : PartialOdometerSlope g = some sU) + (hsV : PartialOdometerSlope h = some sV) + (hcent : TileCentroid V - TileCentroid U = + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (t 0) (t 1))) + (hslope : sV - sU = + GaussianRealPoint (-(⟨0, 1⟩ : GaussianInt) * BandVectors.2 (t 0) (t 1))) : + TileString C orientation base U V [U, V] ∧ LeftLatticeAdjacent C U V g h := by +-- BODY + let I : GaussianInt := ⟨0, 1⟩ + have flip := (VectorRecursionLaws t ht.1).2.2.2.2 ht 0 + change BandVectors.1 (t 0) (t 1) = I * BandVectors.1 (t 1) (t 0) ∧ + BandVectors.2 (t 0) (t 1) = -I * BandVectors.2 (t 1) (t 0) at flip + have vv : I * BandVectors.1 (t 0) (t 1) = -BandVectors.1 (t 1) (t 0) := by + rw [flip.1, ← mul_assoc, show I * I = -1 from by decide +kernel, neg_one_mul] + have aa : -I * BandVectors.2 (t 0) (t 1) = -BandVectors.2 (t 1) (t 0) := by + rw [flip.2, ← mul_assoc, show -I * -I = -1 from by decide +kernel, neg_one_mul] + have hc : TileCentroid V - TileCentroid U = + -GaussianRealPoint (BandVectors.1 (t 1) (t 0)) := by + rw [vv] at hcent + simpa [GaussianRealPoint] using hcent + have ha : sV - sU = -GaussianRealPoint (BandVectors.2 (t 1) (t 0)) := by + rw [aa] at hslope + simpa [GaussianRealPoint] using hslope + have curvature := ProperBandCurvatureStructure t ht + have hlarge : 1 < (t 0).1 := by + by_contra hn + have hzeros : ∀ k : Fin 3, (t k.succ).1 = 0 := by + intro k + have hnonneg := curvature.2.1 k + have hbelow := ht.2 k + omega + exact (by decide : (0 : Fin 3) ≠ 1) + (curvature.2.2 0 1 (hzeros 0) (hzeros 1)) + have hnonunit : C.1.1.1 ≠ 1 := by rw [← htC]; omega + have htouch : TileTouching U V := by + apply (BandRegularTileTouchingClassification C t ht htC base + (htC.symm ▸ hbase) U V hU hV).2 + exact ⟨0, Or.inr hc⟩ + have hvne : BandVectors.1 (t 1) (t 0) ≠ 0 := + VectorNonvanishing t ht.1 1 0 (by decide) (Or.inr curvature.1) + have hne : U ≠ V := by + intro heq + rw [heq, sub_self] at hc + have hz : GaussianRealPoint (BandVectors.1 (t 1) (t 0)) = 0 := + neg_eq_zero.mp hc.symm + apply hvne + apply Zsqrtd.ext + · have h := congrArg Prod.fst hz + dsimp [GaussianRealPoint] at h + exact_mod_cast h + · have h := congrArg Prod.snd hz + dsimp [GaussianRealPoint] at h + exact_mod_cast h + constructor + · unfold TileString + refine ⟨hbase, rfl, rfl, ?_, ?_, ?_, ?_⟩ + · simpa using hne + · intro T hT + simp only [List.mem_cons, List.not_mem_nil, or_false] at hT + rcases hT with rfl | rfl + · exact hU + · exact hV + · simpa [List.IsChain, List.isChain_pair, hnonunit] using htouch + · intro pre T post heq hpre hpost + have hlen := congrArg List.length heq + have hp : 1 ≤ pre.length := by + cases pre with + | nil => simp at hpre + | cons x xs => simp + have hq : 1 ≤ post.length := by + cases post with + | nil => simp at hpost + | cons x xs => simp + simp at hlen + omega + · refine ⟨hg, hh, sU, sV, hsU, hsV, Or.inr ⟨t, 0, false, ht, htC, ?_, ?_, ?_⟩⟩ + · simpa using hc + · have h := congrArg Prod.fst ha + simpa [GaussianRealPoint] using h + · have h := congrArg Prod.snd ha + simpa [GaussianRealPoint] using h + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean new file mode 100644 index 0000000000..59a588caba --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean @@ -0,0 +1,1043 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance +public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.DiamondBaseT1 +public import LeanPool.ApollonianSuperharmonic.DiamondBaseT2 +public import LeanPool.ApollonianSuperharmonic.DiamondBaseTouching +public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.DiamondTileGeometry +public import LeanPool.ApollonianSuperharmonic.TileArea + +-- [TABLET NODE: P4564T2DiamondGeometry] + +/-! +# P4564T2DiamondGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiamondInterfaceGeometry + +private theorem hT'cells : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), + let D := DiamondTile K.1 + ∀ (w : GaussianInt), (T.cells = (TileTranslation D w).cells) → ( + let T' := TileTranslation T (-w) + T'.cells = D.cells) ) := by + classical + intro K T D w hwcells T' + dsimp [T', TileTranslation] + rw [hwcells] + change ((D.cells.image (GaussianTranslation w)).image + (GaussianTranslation (-w))) = D.cells + rw [Finset.image_image] + ext x + simp [GaussianTranslation, add_assoc, + add_comm] + +private theorem hT'anchor : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), + let D := DiamondTile K.1 + ∀ (w : GaussianInt), (T.cells = ∅ → T.anchor = (TileTranslation D w).anchor) → ( + let T' := TileTranslation T (-w) + T'.cells = ∅ → T'.anchor = D.anchor) ) := by + classical + intro K T D w hwanchor T' he + have heT : T.cells = ∅ := by + simpa [T', TileTranslation, Finset.image_eq_empty] using he + have ha := hwanchor heT + dsimp [T', TileTranslation] + rw [ha] + change (D.anchor + w) + -w = D.anchor + abel + +private theorem harea : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), + let q := DiamondRecursiveQuadruple K + let D := DiamondTile K.1 + (TileArea D = Int.toNat (q 0).1) → (∀ (w : GaussianInt), + let T' := TileTranslation T (-w) + (T'.cells = D.cells) → (TileArea T = Int.toNat (q 0).1)) ) := by + classical + intro K T q D hDarea w T' hT'cells + have htarea := (TileDiskAreaCovariance T (-w)).2.2.2.1 + calc + TileArea T = TileArea T' := by simpa [T'] using htarea.symm + _ = TileArea D := by + change T'.cells.card = D.cells.card + rw [hT'cells] + _ = Int.toNat (q 0).1 := hDarea + +private theorem disk_cells_nonempty : + (by + classical + exact + ∀ (X : ProtoTile), (LatticeTile X) → (X.cells.Nonempty) ) := by + classical + intro X hX + unfold LatticeTile TopologicalDisk TileRealization at hX + rcases hX with ⟨e⟩ + have hp : (0 : Real × Real) ∈ + (Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) := by + simp + have hm := (e ⟨(0 : Real × Real), hp⟩).property + simp only [Set.mem_iUnion] at hm + obtain ⟨x, hx⟩ := hm + exact ⟨x, by simpa [TileRealization] using hx.1⟩ + +private theorem touching_same_cells : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), (A.cells = A'.cells) → + ((A.cells.Nonempty) → ((BoundaryFootprintVertices A = BoundaryFootprintVertices A') → + ((BoundaryFootprintEdges A = BoundaryFootprintEdges A') → (TileTouching A B ↔ + TileTouching A' B)))) ) := by + classical + intro A A' B hc hne hbv hbe + have hne' : A'.cells.Nonempty := by rw [← hc]; exact hne + unfold TileTouching + have hneA : A'.cells ≠ ∅ := by + intro he + rw [he] at hne' + simp at hne' + simp [hc, hbv, hbe, hneA] + +private theorem cancel_translationAt227 : + (by + classical + exact + ∀ (w : GaussianInt), ∀ (X : ProtoTile), TileTranslation (TileTranslation X (-w)) w = X ) + := by + classical + intro w X + cases X with + | mk cells anchor => + change ProtoTile.mk ((cells.image (GaussianTranslation (-w))).image + (GaussianTranslation w)) + (GaussianTranslation w (GaussianTranslation (-w) anchor)) = + ProtoTile.mk cells anchor + congr + · ext x + simp [GaussianTranslation, add_comm] + · simp [GaussianTranslation, add_comm] + +private theorem translate_comp : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), TileTranslation + (TileTranslation X a) b = TileTranslation X (a + b) ) := by + classical + intro X a b + cases X with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · ext z + simp [TileTranslation, GaussianTranslation, add_comm, + add_left_comm] + · simp [TileTranslation, GaussianTranslation, add_comm, + add_left_comm] + +private theorem touching_pair_congr : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), (A.cells = + A'.cells) → ((B.cells = B'.cells) → ((A.cells.Nonempty) → ((B.cells.Nonempty) → + ((BoundaryFootprintVertices A = BoundaryFootprintVertices A') → + ((BoundaryFootprintVertices B = BoundaryFootprintVertices B') → + ((BoundaryFootprintEdges A = BoundaryFootprintEdges A') → ((BoundaryFootprintEdges B + = BoundaryFootprintEdges B') → (TileTouching A B ↔ TileTouching A' B')))))))) ) := by + classical + intro A A' B B' ha hb hane hbne hav hbv hae hbe + have hane' : A'.cells.Nonempty := by rw [← ha]; exact hane + have hbne' : B'.cells.Nonempty := by rw [← hb]; exact hbne + have hane0 : A'.cells ≠ ∅ := by + intro he + rw [he] at hane' + simp at hane' + have hbne0 : B'.cells ≠ ∅ := by + intro he + rw [he] at hbne' + simp at hbne' + unfold TileTouching + simp [ha, hb, hav, hbv, hae, hbe, hane0, hbne0] + +private theorem translation_symmetry : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (u : GaussianInt), (QuarterTurnSymmetric X) → (QuarterTurnSymmetric + (TileTranslation X u)) ) := by + classical + intro X u hX p + let a : Real := (GaussianInt.toComplex u).re + let b : Real := (GaussianInt.toComplex u).im + let unshift : Real × Real → Real × Real := fun z => (z.1 - a, z.2 - b) + let rotate (c z : Real × Real) : Real × Real := + (c.1 - (z.2 - c.2), c.2 + (z.1 - c.1)) + have hre : (GaussianInt.toComplex u).re = (u.re : Real) := + (GaussianInt.intCast_re u).symm + have him : (GaussianInt.toComplex u).im = (u.im : Real) := + (GaussianInt.intCast_im u).symm + have hmem (z : Real × Real) : + z ∈ TileRealization (TileTranslation X u) ↔ + unshift z ∈ TileRealization X := by + rw [(TileTranslationFormulas X u).2.2.2.1] + simp only [Set.mem_image] + constructor + · rintro ⟨y, hy, heq⟩ + have : y = unshift z := by + apply Prod.ext + · have h := congrArg Prod.fst heq + dsimp [unshift, a] at ⊢ h + linarith + · have h := congrArg Prod.snd heq + dsimp [unshift, b] at ⊢ h + linarith + simpa [this] using hy + · intro hz + refine ⟨unshift z, hz, ?_⟩ + apply Prod.ext + · dsimp [unshift, a] + rw [hre] + ring + · dsimp [unshift, b] + rw [him] + ring + have hrot (z : Real × Real) : + unshift (rotate (TileCentroid (TileTranslation X u)) z) = + rotate (TileCentroid X) (unshift z) := by + rw [(TileTranslationFormulas X u).2.2.2.2.1] + apply Prod.ext <;> dsimp [unshift, rotate, a, b] <;> + simp only [hre, him] <;> ring + change p ∈ TileRealization (TileTranslation X u) ↔ + rotate (TileCentroid (TileTranslation X u)) p ∈ + TileRealization (TileTranslation X u) + rw [hmem, hmem, hrot] + exact hX (unshift p) + +private theorem touching_symm : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), TileTouching A B ↔ TileTouching B A ) := by + classical + intro A B + unfold TileTouching + constructor + · intro h + rcases h with h | h | h + · rcases h with ⟨ha, hb, hab, hp⟩ + exact Or.inl ⟨hb, ha, hab.symm, by simpa [Set.inter_comm] using hp⟩ + · exact Or.inr (Or.inr h) + · exact Or.inr (Or.inl h) + · intro h + rcases h with h | h | h + · rcases h with ⟨hb, ha, hba, hp⟩ + exact Or.inl ⟨ha, hb, hba.symm, by simpa [Set.inter_comm] using hp⟩ + · exact Or.inr (Or.inr h) + · exact Or.inr (Or.inl h) + +private theorem triple_root_congr : + (by + classical + exact + (∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), (A.cells = A'.cells) → + ((A.cells.Nonempty) → ((BoundaryFootprintVertices A = BoundaryFootprintVertices A') → + ((BoundaryFootprintEdges A = BoundaryFootprintEdges A') → (TileTouching A B ↔ + TileTouching A' B))))) → ((∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), + ∀ (B' : ProtoTile), (A.cells = A'.cells) → ((B.cells = B'.cells) → + ((A.cells.Nonempty) → ((B.cells.Nonempty) → ((BoundaryFootprintVertices A = + BoundaryFootprintVertices A') → ((BoundaryFootprintVertices B = + BoundaryFootprintVertices B') → ((BoundaryFootprintEdges A = BoundaryFootprintEdges + A') → ((BoundaryFootprintEdges B = BoundaryFootprintEdges B') → (TileTouching A B ↔ + TileTouching A' B'))))))))) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), TileTouching A + B ↔ TileTouching B A) → (∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ + (B' : ProtoTile), ∀ (C : ProtoTile), (A.cells = A'.cells) → ((B.cells = B'.cells) → + ((A.cells.Nonempty) → ((B.cells.Nonempty) → ((BoundaryFootprintVertices A = + BoundaryFootprintVertices A') → ((BoundaryFootprintVertices B = + BoundaryFootprintVertices B') → ((BoundaryFootprintEdges A = BoundaryFootprintEdges + A') → ((BoundaryFootprintEdges B = BoundaryFootprintEdges B') → (TouchingTriple A B C + ↔ TouchingTriple A' B' C))))))))))) ) := by + classical + intro touching_same_cells touching_pair_congr touching_symm A A' B B' C ha hb hane hbne hav hbv + hae hbe + unfold TouchingTriple + rw [touching_pair_congr A A' B B' ha hb hane hbne hav hbv hae hbe, + touching_same_cells B B' C hb hbne hbv hbe] + have hlast : TileTouching C A ↔ TileTouching C A' := + (touching_symm C A).trans + ((touching_same_cells A A' C ha hane hav hae).trans + (touching_symm A' C)) + rw [hlast, hav, hbv] + +private theorem triple_root_one : + (by + classical + exact + (∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), (A.cells = A'.cells) → + ((A.cells.Nonempty) → ((BoundaryFootprintVertices A = BoundaryFootprintVertices A') → + ((BoundaryFootprintEdges A = BoundaryFootprintEdges A') → (TileTouching A B ↔ + TileTouching A' B))))) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), TileTouching A B ↔ + TileTouching B A) → (∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (C : + ProtoTile), (A.cells = A'.cells) → ((A.cells.Nonempty) → ((BoundaryFootprintVertices + A = BoundaryFootprintVertices A') → ((BoundaryFootprintEdges A = + BoundaryFootprintEdges A') → (TouchingTriple A B C ↔ TouchingTriple A' B C)))))) ) := by + classical + intro touching_same_cells touching_symm A A' B C ha hane hav hae + unfold TouchingTriple + rw [touching_same_cells A A' B ha hane hav hae] + have hlast : TileTouching C A ↔ TileTouching C A' := + (touching_symm C A).trans + ((touching_same_cells A A' C ha hane hav hae).trans + (touching_symm A' C)) + rw [hlast, hav] + +private theorem triple_all_congr : + (by + classical + exact + (∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), (A.cells = + A'.cells) → ((B.cells = B'.cells) → ((A.cells.Nonempty) → ((B.cells.Nonempty) → + ((BoundaryFootprintVertices A = BoundaryFootprintVertices A') → + ((BoundaryFootprintVertices B = BoundaryFootprintVertices B') → + ((BoundaryFootprintEdges A = BoundaryFootprintEdges A') → ((BoundaryFootprintEdges B + = BoundaryFootprintEdges B') → (TileTouching A B ↔ TileTouching A' B'))))))))) → (∀ + (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (C : + ProtoTile), ∀ (C' : ProtoTile), (A.cells = A'.cells) → ((B.cells = B'.cells) → + ((C.cells = C'.cells) → ((A.cells.Nonempty) → ((B.cells.Nonempty) → + ((C.cells.Nonempty) → ((BoundaryFootprintVertices A = BoundaryFootprintVertices A') → + ((BoundaryFootprintVertices B = BoundaryFootprintVertices B') → + ((BoundaryFootprintVertices C = BoundaryFootprintVertices C') → + ((BoundaryFootprintEdges A = BoundaryFootprintEdges A') → ((BoundaryFootprintEdges B + = BoundaryFootprintEdges B') → ((BoundaryFootprintEdges C = BoundaryFootprintEdges + C') → (TouchingTriple A B C ↔ TouchingTriple A' B' C'))))))))))))) ) := by + classical + intro touching_pair_congr A A' B B' C C' ha hb hc hane hbne hcne hav hbv hcv hae hbe hce + unfold TouchingTriple + rw [touching_pair_congr A A' B B' ha hb hane hbne hav hbv hae hbe, + touching_pair_congr B B' C C' hb hc hbne hcne hbv hcv hbe hce, + touching_pair_congr C C' A A' hc ha hcne hane hcv hav hce hae, + hav, hbv, hcv] + +private theorem translation_observables : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (u : GaussianInt), (A.cells = A'.cells) → + ((BoundaryFootprintVertices A = BoundaryFootprintVertices A') → + ((BoundaryFootprintEdges A = BoundaryFootprintEdges A') → ((TileTranslation A + u).cells = (TileTranslation A' u).cells ∧ BoundaryFootprintVertices (TileTranslation + A u) = BoundaryFootprintVertices (TileTranslation A' u) ∧ BoundaryFootprintEdges + (TileTranslation A u) = BoundaryFootprintEdges (TileTranslation A' u)))) ) := by + classical + intro A A' u hc hbv hbe + refine ⟨?_, ?_, ?_⟩ + · rw [(TileTranslationFormulas A u).1, (TileTranslationFormulas A' u).1, hc] + · rw [(TileTranslationFormulas A u).2.2.2.2.2.2.2.1, + (TileTranslationFormulas A' u).2.2.2.2.2.2.2.1, hbv] + · rw [(TileTranslationFormulas A u).2.2.2.2.2.2.2.2, + (TileTranslationFormulas A' u).2.2.2.2.2.2.2.2, hbe] + +private theorem translation_nonempty : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (u : GaussianInt), (A.cells.Nonempty) → ((TileTranslation A + u).cells.Nonempty) ) := by + classical + intro A u hne + rw [(TileTranslationFormulas A u).1] + exact hne.image _ + +private theorem translate_swap : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), TileTranslation + (TileTranslation X a) b = TileTranslation X (a + b)) → (∀ (X : ProtoTile), ∀ (a : + GaussianInt), ∀ (b : GaussianInt), TileTranslation (TileTranslation X a) b = + TileTranslation (TileTranslation X b) a) ) := by + classical + intro translate_comp X a b + rw [translate_comp X a b, translate_comp X b a] + congr 1 + abel + +private theorem translate_centroid_diff : + (by + classical + exact + ∀ (w : GaussianInt), ∀ (A : ProtoTile), ∀ (B : ProtoTile), TileCentroid (TileTranslation + A (-w)) - TileCentroid (TileTranslation B (-w)) = TileCentroid A - TileCentroid B ) + := by + classical + intro w A B + rw [(TileTranslationFormulas A (-w)).2.2.2.2.1, + (TileTranslationFormulas B (-w)).2.2.2.2.1] + apply Prod.ext <;> simp + +private theorem arbitrary_family : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), + let q := DiamondRecursiveQuadruple K + let D := DiamondTile K.1 + ∀ (w : GaussianInt), + let T' := TileTranslation T (-w) + (T'.cells = D.cells) → ((TileCentroid T' = TileCentroid D) → ((FootprintVertices T' = + FootprintVertices D) → ((∀ (X : ProtoTile), (LatticeTile X) → (X.cells.Nonempty)) → + ((∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), (A.cells = A'.cells) → + ((A.cells.Nonempty) → ((BoundaryFootprintVertices A = BoundaryFootprintVertices A') → + ((BoundaryFootprintEdges A = BoundaryFootprintEdges A') → (TileTouching A B ↔ + TileTouching A' B))))) → (∀ (R : Fin 3 → Bool → ProtoTile), (∀ i, ∀ s, + BandSubtileOccurrence q T i s (R i s)) → (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (R i + s).cells) → ∀ i, ∀ s, LatticeTile (TileCellComplement T (R i s)) ∧ TileTouching + (TileCellComplement T (R i s)) (R i s)))))) ) := by + classical + intro K T q D w T' hT'cells hcent hfoot disk_cells_nonempty touching_same_cells R hR hRunion i s + let R' : Fin 3 → Bool → ProtoTile := fun j b => + TileTranslation (R j b) (-w) + have hRocc : ∀ j b, BandSubtileOccurrence q T' j b (R' j b) := by + intro j b + exact (BandSubtileOccurrenceTranslation q T (R j b) j b (-w)).mp + (hR j b) + have hRunion' : ∀ x, x ∈ T'.cells ↔ ∃ j b, x ∈ (R' j b).cells := by + intro x + change x ∈ T.cells.image (GaussianTranslation (-w)) ↔ + ∃ j b, x ∈ (R j b).cells.image (GaussianTranslation (-w)) + simp only [Finset.mem_image] + constructor + · rintro ⟨y, hy, hxy⟩ + rcases (hRunion y).mp hy with ⟨j, b, hb⟩ + exact ⟨j, b, ⟨y, hb, hxy⟩⟩ + · rintro ⟨j, b, y, hy, hxy⟩ + exact ⟨y, (hRunion y).mpr ⟨j, b, hy⟩, hxy⟩ + have hRoccD : ∀ j b, BandSubtileOccurrence q D j b (R' j b) := by + intro j b + rcases hRocc j b with ⟨hband, hfp, hcentroid⟩ + refine ⟨hband, ?_, ?_⟩ + · rw [hfoot] at hfp + exact hfp + · rw [hcent] at hcentroid + exact hcentroid + have hRunionD : ∀ x, x ∈ D.cells ↔ ∃ j b, x ∈ (R' j b).cells := by + intro x + rw [← hT'cells] + exact hRunion' x + have hRbase := DiamondBaseT1 K R' hRoccD hRunionD + have hDcompCells : + (TileCellComplement D (R' i s)).cells = + (TileCellComplement T' (R' i s)).cells := by + simp only [TileCellComplement] + rw [hT'cells] + have hDcompDisk : LatticeTile (TileCellComplement D (R' i s)) := + (hRbase.2.2 i s).1 + have hDcompNe := disk_cells_nonempty _ hDcompDisk + have hcompObs := ProtoTileObservableExtensionality + (TileCellComplement D (R' i s)) (TileCellComplement T' (R' i s)) + hDcompCells (by + intro he + have hnot : ¬ (TileCellComplement D (R' i s)).cells.Nonempty := by + rw [he] + simp + exact False.elim (hnot hDcompNe)) + have hTcompDisk : LatticeTile (TileCellComplement T' (R' i s)) := by + change TopologicalDisk + (TileRealization (TileCellComplement T' (R' i s))) + change TopologicalDisk + (TileRealization (TileCellComplement D (R' i s))) at hDcompDisk + rw [hcompObs.2.2.2.1] at hDcompDisk + exact hDcompDisk + have hTcompNe : (TileCellComplement T' (R' i s)).cells.Nonempty := by + rw [← hDcompCells] + exact hDcompNe + have hTcompTouch : + TileTouching (TileCellComplement T' (R' i s)) (R' i s) := by + exact (touching_same_cells _ _ _ hDcompCells hDcompNe + hcompObs.2.1 hcompObs.2.2.1).mp (hRbase.2.2 i s).2 + have cancel_translation (X : ProtoTile) : + TileTranslation (TileTranslation X (-w)) w = X := by + cases X with + | mk cells anchor => + change ProtoTile.mk ((cells.image (GaussianTranslation (-w))).image + (GaussianTranslation w)) + (GaussianTranslation w (GaussianTranslation (-w) anchor)) = + ProtoTile.mk cells anchor + congr + · ext x + simp [GaussianTranslation, add_comm] + · simp [GaussianTranslation, add_comm] + have hbackDisk : LatticeTile (TileCellComplement T (R i s)) := by + have hcov := (TileCellComplementCovariance T' (R' i s) w).1 + have htranslated := + (TileDiskAreaCovariance (TileCellComplement T' (R' i s)) w).1.mp + hTcompDisk + rw [hcov, cancel_translation T, cancel_translation (R i s)] at htranslated + exact htranslated + have hbackTouch : + TileTouching (TileCellComplement T (R i s)) (R i s) := by + have hcov := (TileCellComplementCovariance T' (R' i s) w).1 + have htranslated := + (TileTouchingCovariance (TileCellComplement T' (R' i s)) + (R' i s) w).1.mp hTcompTouch + rw [hcov, cancel_translation T, cancel_translation (R i s)] at htranslated + exact htranslated + exact ⟨hbackDisk, hbackTouch⟩ + +private theorem hdisk' : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), + let D := DiamondTile K.1 + (LatticeTile D) → (∀ (w : GaussianInt), + let T' := TileTranslation T (-w) + (TileRealization T' = TileRealization D) → (LatticeTile T')) ) := by + classical + intro K T D hDdisk w T' hreal + change TopologicalDisk (TileRealization T') + change TopologicalDisk (TileRealization D) at hDdisk + rw [← hreal] at hDdisk + exact hDdisk + +private theorem hsym' : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), + let D := DiamondTile K.1 + ∀ (w : GaussianInt), + let T' := TileTranslation T (-w) + (TileRealization T' = TileRealization D) → ((TileCentroid T' = TileCentroid D) → + ((QuarterTurnSymmetric D) → (QuarterTurnSymmetric T'))) ) := by + classical + intro K T D w T' hreal hcent hsymD p + simpa [QuarterTurnSymmetric, hreal, hcent] using hsymD p + +private theorem htriple'At530 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), + let q := DiamondRecursiveQuadruple K + let D := DiamondTile K.1 + ∀ (w : GaussianInt), + let T' := TileTranslation T (-w) + (T'.cells = D.cells) → ((BoundaryFootprintVertices T' = BoundaryFootprintVertices D) → + ((BoundaryFootprintEdges T' = BoundaryFootprintEdges D) → ((∀ (A : ProtoTile), ∀ (A' + : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (C : ProtoTile), ∀ (C' : + ProtoTile), (A.cells = A'.cells) → ((B.cells = B'.cells) → ((C.cells = C'.cells) → + ((A.cells.Nonempty) → ((B.cells.Nonempty) → ((C.cells.Nonempty) → + ((BoundaryFootprintVertices A = BoundaryFootprintVertices A') → + ((BoundaryFootprintVertices B = BoundaryFootprintVertices B') → + ((BoundaryFootprintVertices C = BoundaryFootprintVertices C') → + ((BoundaryFootprintEdges A = BoundaryFootprintEdges A') → ((BoundaryFootprintEdges B + = BoundaryFootprintEdges B') → ((BoundaryFootprintEdges C = BoundaryFootprintEdges + C') → (TouchingTriple A B C ↔ TouchingTriple A' B' C'))))))))))))) → ((∀ (A : + ProtoTile), ∀ (u : GaussianInt), (A.cells.Nonempty) → ((TileTranslation A + u).cells.Nonempty)) → (∀ (i : Fin (3 : ℕ)), ( + let q := DiamondRecursiveQuadruple K; + let T := DiamondTile K.1; (∀ (i : Fin (3 : ℕ)), TouchingTriple T (TileTranslation T + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation T (-BandVectors.1 + (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) ∧ (∀ (i : Fin (3 : ℕ)), ∀ + (U : ProtoTile), BandPrototile (q i.succ) U → TileCentroid U - TileCentroid T = (1 / + 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple + T (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ ∀ (i : + Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → + BandPrototile (q (i + (1 : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = + (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V + - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin + (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin + (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple T U V) → + ((Finset.Nonempty D.cells) → ( + let v := BandVectors.1 (q i.succ) (q 0) + let z := -BandVectors.1 (q ((i + 1).succ)) (q 0) + ((TileTranslation D v).cells = (TileTranslation T' v).cells ∧ BoundaryFootprintVertices + (TileTranslation D v) = BoundaryFootprintVertices (TileTranslation T' v) ∧ + BoundaryFootprintEdges (TileTranslation D v) = BoundaryFootprintEdges + (TileTranslation T' v)) → (((TileTranslation D z).cells = (TileTranslation T' + z).cells ∧ BoundaryFootprintVertices (TileTranslation D z) = + BoundaryFootprintVertices (TileTranslation T' z) ∧ BoundaryFootprintEdges + (TileTranslation D z) = BoundaryFootprintEdges (TileTranslation T' z)) → + (TouchingTriple T' (TileTranslation T' v) (TileTranslation T' z)))))))))) ) := by + classical + intro K T q D w T' hT'cells hbdv hbde triple_all_congr translation_nonempty i hbaseTouch hDne v + z hobsV hobsZ + apply (triple_all_congr D T' (TileTranslation D v) + (TileTranslation T' v) (TileTranslation D z) + (TileTranslation T' z) hT'cells.symm hobsV.1 hobsZ.1 hDne + (translation_nonempty D v hDne) (translation_nonempty D z hDne) + hbdv.symm hobsV.2.1 hobsZ.2.1 hbde.symm hobsV.2.2 hobsZ.2.2).mp + exact hbaseTouch.1 i + +private theorem hperiodVAt540 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), + let q := DiamondRecursiveQuadruple K + ∀ (w : GaussianInt), + let T' := TileTranslation T (-w) + (∀ (X : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), TileTranslation + (TileTranslation X a) b = TileTranslation (TileTranslation X b) a) → + ((TileTranslation T' w = T) → (∀ (i : Fin (3 : ℕ)), + let v := BandVectors.1 (q i.succ) (q 0) + TileTranslation (TileTranslation T' v) w = TileTranslation T v)) ) := by + classical + intro K T q w T' translate_swap hTrestore i v + rw [← hTrestore] + exact translate_swap T' v w + +private theorem hperiodZ : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), + let q := DiamondRecursiveQuadruple K + ∀ (w : GaussianInt), + let T' := TileTranslation T (-w) + (∀ (X : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), TileTranslation + (TileTranslation X a) b = TileTranslation (TileTranslation X b) a) → + ((TileTranslation T' w = T) → (∀ (i : Fin (3 : ℕ)), + let z := -BandVectors.1 (q ((i + 1).succ)) (q 0) + TileTranslation (TileTranslation T' z) w = TileTranslation T z)) ) := by + classical + intro K T q w T' translate_swap hTrestore i z + rw [← hTrestore] + exact translate_swap T' z w + +private theorem hcenter' : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), + let q := DiamondRecursiveQuadruple K + let D := DiamondTile K.1 + ∀ (w : GaussianInt), + let T' := TileTranslation T (-w) + (TileCentroid T' = TileCentroid D) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), TileCentroid + (TileTranslation A (-w)) - TileCentroid (TileTranslation B (-w)) = TileCentroid A - + TileCentroid B) → (∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), (TileCentroid U - + TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (DiamondRecursiveQuadruple K i.succ) (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ))) + (DiamondRecursiveQuadruple K i.succ)))) → ( + let U' := TileTranslation U (-w) + TileCentroid U' - TileCentroid D = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q + i.succ) (q 0)) + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))))) ) := by + classical + intro K T q D w T' hcent translate_centroid_diff i U hcenter U' + calc + TileCentroid U' - TileCentroid D = + TileCentroid U' - TileCentroid T' := by rw [hcent] + _ = TileCentroid U - TileCentroid T := translate_centroid_diff U T + _ = _ := hcenter + +private theorem htriple'At567 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), + let q := DiamondRecursiveQuadruple K + let D := DiamondTile K.1 + ∀ (w : GaussianInt), + let T' := TileTranslation T (-w) + (T'.cells = D.cells) → ((BoundaryFootprintVertices T' = BoundaryFootprintVertices D) → + ((BoundaryFootprintEdges T' = BoundaryFootprintEdges D) → ((∀ (A : ProtoTile), ∀ (A' + : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (C : ProtoTile), (A.cells = + A'.cells) → ((B.cells = B'.cells) → ((A.cells.Nonempty) → ((B.cells.Nonempty) → + ((BoundaryFootprintVertices A = BoundaryFootprintVertices A') → + ((BoundaryFootprintVertices B = BoundaryFootprintVertices B') → + ((BoundaryFootprintEdges A = BoundaryFootprintEdges A') → ((BoundaryFootprintEdges B + = BoundaryFootprintEdges B') → (TouchingTriple A B C ↔ TouchingTriple A' B' + C))))))))) → ((∀ (A : ProtoTile), ∀ (u : GaussianInt), (A.cells.Nonempty) → + ((TileTranslation A u).cells.Nonempty)) → (∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), ( + let q := DiamondRecursiveQuadruple K; + let T := DiamondTile K.1; (∀ (i : Fin (3 : ℕ)), TouchingTriple T (TileTranslation T + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation T (-BandVectors.1 + (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) ∧ (∀ (i : Fin (3 : ℕ)), ∀ + (U : ProtoTile), BandPrototile (q i.succ) U → TileCentroid U - TileCentroid T = (1 / + 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple + T (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ ∀ (i : + Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → + BandPrototile (q (i + (1 : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = + (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V + - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin + (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin + (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple T U V) → ( + let v := BandVectors.1 (q i.succ) (q 0) + let U' := TileTranslation U (-w) + (BandPrototile (q i.succ) U') → ((TileCentroid U' - TileCentroid D = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + GaussianRealPoint + (BandVectors.1 (q 0) (q i.succ)))) → (((TileTranslation D v).cells = (TileTranslation + T' v).cells ∧ BoundaryFootprintVertices (TileTranslation D v) = + BoundaryFootprintVertices (TileTranslation T' v) ∧ BoundaryFootprintEdges + (TileTranslation D v) = BoundaryFootprintEdges (TileTranslation T' v)) → + ((Finset.Nonempty D.cells) → (TouchingTriple T' (TileTranslation T' v) U')))))))))) ) + := by + classical + intro K T q D w T' hT'cells hbdv hbde triple_root_congr translation_nonempty i U hbaseTouch v + U' hU'band hcenter' hobsV hDne + apply (triple_root_congr D T' (TileTranslation D v) + (TileTranslation T' v) U' hT'cells.symm hobsV.1 hDne + (translation_nonempty D v hDne) hbdv.symm hobsV.2.1 hbde.symm + hobsV.2.2).mp + exact hbaseTouch.2.1 i U' hU'band hcenter' + +private theorem hperiodVAt575 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), + let q := DiamondRecursiveQuadruple K + ∀ (w : GaussianInt), + let T' := TileTranslation T (-w) + (∀ (X : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), TileTranslation + (TileTranslation X a) b = TileTranslation (TileTranslation X b) a) → + ((TileTranslation T' w = T) → (∀ (i : Fin (3 : ℕ)), + let v := BandVectors.1 (q i.succ) (q 0) + TileTranslation (TileTranslation T' v) w = TileTranslation T v)) ) := by + classical + intro K T q w T' translate_swap hTrestore i v + rw [← hTrestore] + exact translate_swap T' v w + +private theorem hcenterU' : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), + let q := DiamondRecursiveQuadruple K + let D := DiamondTile K.1 + ∀ (w : GaussianInt), + let T' := TileTranslation T (-w) + (TileCentroid T' = TileCentroid D) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), TileCentroid + (TileTranslation A (-w)) - TileCentroid (TileTranslation B (-w)) = TileCentroid A - + TileCentroid B) → (∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), (TileCentroid U - + TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (DiamondRecursiveQuadruple K i.succ) (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ))) + (DiamondRecursiveQuadruple K i.succ)))) → ( + let U' := TileTranslation U (-w) + TileCentroid U' - TileCentroid D = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q + i.succ) (q 0)) + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))))) ) := by + classical + intro K T q D w T' hcent translate_centroid_diff i U hcenterU U' + calc + TileCentroid U' - TileCentroid D = + TileCentroid U' - TileCentroid T' := by rw [hcent] + _ = TileCentroid U - TileCentroid T := translate_centroid_diff U T + _ = _ := hcenterU + +private theorem hcenterV' : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), + let q := DiamondRecursiveQuadruple K + let D := DiamondTile K.1 + ∀ (w : GaussianInt), + let T' := TileTranslation T (-w) + (TileCentroid T' = TileCentroid D) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), TileCentroid + (TileTranslation A (-w)) - TileCentroid (TileTranslation B (-w)) = TileCentroid A - + TileCentroid B) → (∀ (i : Fin (3 : ℕ)), ∀ (V : ProtoTile), (TileCentroid V - + TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (DiamondRecursiveQuadruple K (i + (1 : Fin (3 : ℕ))).succ) (DiamondRecursiveQuadruple + K (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (DiamondRecursiveQuadruple K + (0 : Fin (4 : ℕ))) (DiamondRecursiveQuadruple K (i + (1 : Fin (3 : ℕ))).succ)))) → ( + let V' := TileTranslation V (-w) + TileCentroid V' - TileCentroid D = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q + ((i + 1).succ)) (q 0)) - GaussianRealPoint (BandVectors.1 (q 0) (q ((i + + 1).succ))))))) ) := by + classical + intro K T q D w T' hcent translate_centroid_diff i V hcenterV V' + calc + TileCentroid V' - TileCentroid D = + TileCentroid V' - TileCentroid T' := by rw [hcent] + _ = TileCentroid V - TileCentroid T := translate_centroid_diff V T + _ = _ := hcenterV + +private theorem htriple'At612 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (T : ProtoTile), + let q := DiamondRecursiveQuadruple K + let D := DiamondTile K.1 + ∀ (w : GaussianInt), + let T' := TileTranslation T (-w) + (T'.cells = D.cells) → ((BoundaryFootprintVertices T' = BoundaryFootprintVertices D) → + ((BoundaryFootprintEdges T' = BoundaryFootprintEdges D) → ((∀ (A : ProtoTile), ∀ (A' + : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (A.cells = A'.cells) → + ((A.cells.Nonempty) → ((BoundaryFootprintVertices A = BoundaryFootprintVertices A') → + ((BoundaryFootprintEdges A = BoundaryFootprintEdges A') → (TouchingTriple A B C ↔ + TouchingTriple A' B C))))) → (∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), ( + let q := DiamondRecursiveQuadruple K; + let T := DiamondTile K.1; (∀ (i : Fin (3 : ℕ)), TouchingTriple T (TileTranslation T + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation T (-BandVectors.1 + (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) ∧ (∀ (i : Fin (3 : ℕ)), ∀ + (U : ProtoTile), BandPrototile (q i.succ) U → TileCentroid U - TileCentroid T = (1 / + 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple + T (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ ∀ (i : + Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → + BandPrototile (q (i + (1 : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = + (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V + - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin + (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin + (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple T U V) → ( + let U' := TileTranslation U (-w) + let V' := TileTranslation V (-w) + (BandPrototile (q i.succ) U') → ((BandPrototile (q ((i + 1).succ)) V') → ((TileCentroid + U' - TileCentroid D = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q i.succ) + (q 0)) + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))) → ((TileCentroid V' - + TileCentroid D = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q ((i + + 1).succ)) (q 0)) - GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ))))) → + ((Finset.Nonempty D.cells) → (TouchingTriple T' U' V')))))))))) ) := by + classical + intro K T q D w T' hT'cells hbdv hbde triple_root_one i U V hbaseTouch U' V' hU'band hV'band + hcenterU' hcenterV' hDne + apply (triple_root_one D T' U' V' hT'cells.symm hDne + hbdv.symm hbde.symm).mp + exact hbaseTouch.2.2 i U' V' hU'band hV'band hcenterU' hcenterV' + +end DiamondInterfaceGeometry + +theorem P4564T2DiamondGeometry : + ∀ (K : DiamondParameter), (1 < K.1) → (∀ (T : ProtoTile), (BandPrototile + ((DiamondRecursiveQuadruple K) 0) T) → ( + let q := DiamondRecursiveQuadruple K + LatticeTile T ∧ TileArea T = Int.toNat (q 0).1 ∧ + (∀ (S : Fin 3 → Bool → ProtoTile), (∀ i, ∀ s, BandSubtileOccurrence q T i s (S i s)) → + (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (S i s).cells) → + ∀ i, ∀ s, LatticeTile (TileCellComplement T (S i s)) ∧ + TileTouching (TileCellComplement T (S i s)) (S i s)) ∧ + QuarterTurnSymmetric T ∧ + (1 < (q 0).1 → ∀ i : Fin 3, + TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) + (TileTranslation T + (-BandVectors.1 (q ((i + 1).succ)) (q 0)))) ∧ + (1 < (q 0).1 → ∀ (i : Fin 3), ∀ (U : ProtoTile), BandPrototile (q i.succ) U → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U) ∧ + (∀ (i : Fin 3), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → + BandPrototile (q ((i + 1).succ)) V → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ)))) → + TouchingTriple T U V))) := by + intro K hK T hT +-- BODY + classical + dsimp + let q := DiamondRecursiveQuadruple K + let D := DiamondTile K.1 + have hrec := DiamondTileRecursiveIdentification K + rcases hrec with ⟨hD, S₀, hS₀, hUnion₀, _, _, _, _, _, _⟩ + have hbase₀ := DiamondBaseT1 K S₀ hS₀ hUnion₀ + have hDarea : TileArea D = Int.toNat (q 0).1 := hbase₀.2.1 + have hDdisk : LatticeTile D := hbase₀.1 + have hnorm := BandPrototileTranslationNormalForm (q 0) T D hT hD + rcases hnorm with ⟨w, hwcells, hwanchor⟩ + let T' := TileTranslation T (-w) + have hT'cells := DiamondInterfaceGeometry.hT'cells K T w hwcells + have hT'anchor := DiamondInterfaceGeometry.hT'anchor K T w hwanchor + have hobs := ProtoTileObservableExtensionality T' D hT'cells hT'anchor + have hreal : TileRealization T' = TileRealization D := hobs.2.2.2.1 + have hcent : TileCentroid T' = TileCentroid D := hobs.2.2.2.2 + have hfoot : FootprintVertices T' = FootprintVertices D := hobs.1 + have hbdv : BoundaryFootprintVertices T' = BoundaryFootprintVertices D := + hobs.2.1 + have hbde : BoundaryFootprintEdges T' = BoundaryFootprintEdges D := + hobs.2.2.1 + have harea := DiamondInterfaceGeometry.harea K T hDarea w hT'cells + have disk_cells_nonempty (X : ProtoTile) (hX : LatticeTile X) := + DiamondInterfaceGeometry.disk_cells_nonempty X hX + have touching_same_cells (A A' B : ProtoTile) + (hc : A.cells = A'.cells) (hne : A.cells.Nonempty) + (hbv : BoundaryFootprintVertices A = BoundaryFootprintVertices A') + (hbe : BoundaryFootprintEdges A = BoundaryFootprintEdges A') := + DiamondInterfaceGeometry.touching_same_cells A A' B hc hne hbv hbe + have cancel_translation (X : ProtoTile) : + TileTranslation (TileTranslation X (-w)) w = X := + DiamondInterfaceGeometry.cancel_translationAt227 w X + have translate_comp (X : ProtoTile) (a b : GaussianInt) := + DiamondInterfaceGeometry.translate_comp X a b + have touching_pair_congr (A A' B B' : ProtoTile) + (ha : A.cells = A'.cells) (hb : B.cells = B'.cells) + (hane : A.cells.Nonempty) (hbne : B.cells.Nonempty) + (hav : BoundaryFootprintVertices A = BoundaryFootprintVertices A') + (hbv : BoundaryFootprintVertices B = BoundaryFootprintVertices B') + (hae : BoundaryFootprintEdges A = BoundaryFootprintEdges A') + (hbe : BoundaryFootprintEdges B = BoundaryFootprintEdges B') := + DiamondInterfaceGeometry.touching_pair_congr A A' B B' ha hb hane hbne hav hbv hae hbe + have translation_symmetry (X : ProtoTile) (u : GaussianInt) + (hX : QuarterTurnSymmetric X) := DiamondInterfaceGeometry.translation_symmetry X u hX + have touching_symm (A B : ProtoTile) := DiamondInterfaceGeometry.touching_symm A B + have triple_root_congr (A A' B B' C : ProtoTile) + (ha : A.cells = A'.cells) (hb : B.cells = B'.cells) + (hane : A.cells.Nonempty) (hbne : B.cells.Nonempty) + (hav : BoundaryFootprintVertices A = BoundaryFootprintVertices A') + (hbv : BoundaryFootprintVertices B = BoundaryFootprintVertices B') + (hae : BoundaryFootprintEdges A = BoundaryFootprintEdges A') + (hbe : BoundaryFootprintEdges B = BoundaryFootprintEdges B') := + DiamondInterfaceGeometry.triple_root_congr touching_same_cells touching_pair_congr + touching_symm A A' B B' C ha hb hane hbne hav hbv hae hbe + have triple_root_one (A A' B C : ProtoTile) + (ha : A.cells = A'.cells) (hane : A.cells.Nonempty) + (hav : BoundaryFootprintVertices A = BoundaryFootprintVertices A') + (hae : BoundaryFootprintEdges A = BoundaryFootprintEdges A') := + DiamondInterfaceGeometry.triple_root_one touching_same_cells touching_symm A A' B C ha + hane hav hae + have triple_all_congr (A A' B B' C C' : ProtoTile) + (ha : A.cells = A'.cells) (hb : B.cells = B'.cells) + (hc : C.cells = C'.cells) + (hane : A.cells.Nonempty) (hbne : B.cells.Nonempty) + (hcne : C.cells.Nonempty) + (hav : BoundaryFootprintVertices A = BoundaryFootprintVertices A') + (hbv : BoundaryFootprintVertices B = BoundaryFootprintVertices B') + (hcv : BoundaryFootprintVertices C = BoundaryFootprintVertices C') + (hae : BoundaryFootprintEdges A = BoundaryFootprintEdges A') + (hbe : BoundaryFootprintEdges B = BoundaryFootprintEdges B') + (hce : BoundaryFootprintEdges C = BoundaryFootprintEdges C') := + DiamondInterfaceGeometry.triple_all_congr touching_pair_congr A A' B B' C C' ha hb hc + hane hbne hcne hav hbv hcv hae hbe hce + have translation_observables (A A' : ProtoTile) (u : GaussianInt) + (hc : A.cells = A'.cells) + (hbv : BoundaryFootprintVertices A = BoundaryFootprintVertices A') + (hbe : BoundaryFootprintEdges A = BoundaryFootprintEdges A') := + DiamondInterfaceGeometry.translation_observables A A' u hc hbv hbe + have translation_nonempty (A : ProtoTile) (u : GaussianInt) + (hne : A.cells.Nonempty) := DiamondInterfaceGeometry.translation_nonempty A u hne + have translate_swap (X : ProtoTile) (a b : GaussianInt) := + DiamondInterfaceGeometry.translate_swap translate_comp X a b + have translate_centroid_diff (A B : ProtoTile) := + DiamondInterfaceGeometry.translate_centroid_diff w A B + have hTrestore : TileTranslation T' w = T := by + simpa [T'] using cancel_translation T + have arbitrary_family := DiamondInterfaceGeometry.arbitrary_family K T w hT'cells hcent hfoot + disk_cells_nonempty touching_same_cells + refine ⟨?_, harea, ?_, ?_, ?_, ?_, ?_⟩ + · have hdisk' := DiamondInterfaceGeometry.hdisk' K T hDdisk w hreal + exact (TileDiskAreaCovariance T (-w)).1.mpr hdisk' + · intro R hR hRunion i s + exact (arbitrary_family R hR hRunion i s) + · have hsymD : QuarterTurnSymmetric D := DiamondBaseT2 K + have hsym' := DiamondInterfaceGeometry.hsym' K T w hreal hcent hsymD + have hsymT := translation_symmetry T' w hsym' + rw [hTrestore] at hsymT + exact hsymT + · intro hc i + have hbaseTouch := DiamondBaseTouching K + have hDne := disk_cells_nonempty D hDdisk + let v := BandVectors.1 (q i.succ) (q 0) + let z := -BandVectors.1 (q ((i + 1).succ)) (q 0) + have hobsV := translation_observables D T' v hT'cells.symm hbdv.symm hbde.symm + have hobsZ := translation_observables D T' z hT'cells.symm hbdv.symm hbde.symm + have htriple' := DiamondInterfaceGeometry.htriple'At530 K T w hT'cells hbdv hbde + triple_all_congr translation_nonempty i hbaseTouch hDne hobsV hobsZ + have htripleW := (TouchingTripleCovariance T' + (TileTranslation T' v) (TileTranslation T' z) w).1.mp htriple' + have hperiodV : TileTranslation (TileTranslation T' v) w = + TileTranslation T v := DiamondInterfaceGeometry.hperiodVAt540 K T w translate_swap + hTrestore i + have hperiodZ : TileTranslation (TileTranslation T' z) w = + TileTranslation T z := DiamondInterfaceGeometry.hperiodZ K T w translate_swap hTrestore i + rw [hTrestore, hperiodV, hperiodZ] at htripleW + exact htripleW + · intro hc i U hU hcenter + have hbaseTouch := DiamondBaseTouching K + let v := BandVectors.1 (q i.succ) (q 0) + let U' := TileTranslation U (-w) + have hU'band : BandPrototile (q i.succ) U' := + BandPrototileTranslation (q i.succ) U (-w) hU + have hcenter' := DiamondInterfaceGeometry.hcenter' K T w hcent translate_centroid_diff i U + hcenter + have hobsV := translation_observables D T' v hT'cells.symm hbdv.symm hbde.symm + have hDne := disk_cells_nonempty D hDdisk + have htriple' := DiamondInterfaceGeometry.htriple'At567 K T w hT'cells hbdv hbde + triple_root_congr translation_nonempty i U hbaseTouch hU'band hcenter' hobsV hDne + have htripleW := (TouchingTripleCovariance T' + (TileTranslation T' v) U' w).1.mp htriple' + have hperiodV : TileTranslation (TileTranslation T' v) w = + TileTranslation T v := DiamondInterfaceGeometry.hperiodVAt575 K T w translate_swap + hTrestore i + have hUrestore : TileTranslation U' w = U := by + simpa [U'] using cancel_translation U + rw [hTrestore, hperiodV, hUrestore] at htripleW + exact htripleW + · intro i U V hU hV hcenterU hcenterV + have hbaseTouch := DiamondBaseTouching K + let v := BandVectors.1 (q i.succ) (q 0) + let z := BandVectors.1 (q ((i + 1).succ)) (q 0) + let U' := TileTranslation U (-w) + let V' := TileTranslation V (-w) + have hU'band : BandPrototile (q i.succ) U' := + BandPrototileTranslation (q i.succ) U (-w) hU + have hV'band : BandPrototile (q ((i + 1).succ)) V' := + BandPrototileTranslation (q ((i + 1).succ)) V (-w) hV + have hcenterU' := DiamondInterfaceGeometry.hcenterU' K T w hcent translate_centroid_diff i U + hcenterU + have hcenterV' := DiamondInterfaceGeometry.hcenterV' K T w hcent translate_centroid_diff i V + hcenterV + have hDne := disk_cells_nonempty D hDdisk + have htriple' := DiamondInterfaceGeometry.htriple'At612 K T w hT'cells hbdv hbde + triple_root_one i U V hbaseTouch hU'band hV'band hcenterU' hcenterV' hDne + have htripleW := (TouchingTripleCovariance T' U' V' w).1.mp htriple' + have hUrestore : TileTranslation U' w = U := by + simpa [U'] using cancel_translation U + have hVrestore : TileTranslation V' w = V := by + simpa [V'] using cancel_translation V + rw [hTrestore, hUrestore, hVrestore] at htripleW + exact htripleW + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondOrderExclusion.lean b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondOrderExclusion.lean new file mode 100644 index 0000000000..0d23b3ef16 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondOrderExclusion.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance + +-- [TABLET NODE: P4564T2DiamondOrderExclusion] + +/-! +# P4564T2DiamondOrderExclusion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4564T2DiamondOrderExclusion : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (a : Fin 3), ∀ (g : BandPackingSymmetry), ∀ (K : + DiamondParameter), (BandPackingSymmetryQuadrupleAction g ![q 0, q a.succ, q (a + 1).succ, + q (a + + 2).succ] = + DiamondRecursiveQuadruple K) → (((q 2).1 ≤ (q 1).1) → (((q 3).1 ≤ (q 2).1) → ((q 2).1 ≤ + 1))) := by + intro q a g K hnormal h12 h23 +-- BODY + have h1 := congrArg (fun p : Fin 4 → CircleCoordinates => (p 1).1) hnormal + have h2 := congrArg (fun p : Fin 4 → CircleCoordinates => (p 2).1) hnormal + have hc := (BandPackingSymmetryCovariance g).1 + cases ho : BandPackingSymmetryReversesOrientation g <;> fin_cases a <;> + simp [BandPackingSymmetryQuadrupleAction, ho, hc, + DiamondRecursiveQuadruple] at h1 h2 <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2ElementaryQuarterTurn.lean b/LeanPool/ApollonianSuperharmonic/P4564T2ElementaryQuarterTurn.lean new file mode 100644 index 0000000000..3f8bfadec3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4564T2ElementaryQuarterTurn.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization + +-- [TABLET NODE: P4564T2ElementaryQuarterTurn] + +/-! +# P4564T2ElementaryQuarterTurn + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4564T2ElementaryQuarterTurn (x anchor : GaussianInt) : + QuarterTurnSymmetric (⟨∅, anchor⟩ : ProtoTile) ∧ + QuarterTurnSymmetric (⟨{x}, anchor⟩ : ProtoTile) := by +-- BODY + constructor + · intro p + simp [TileRealization] + · intro p + simp only [TileRealization, Finset.mem_singleton, Set.iUnion_iUnion_eq_left, + TileCentroid, Finset.singleton_nonempty, ite_eq_left, Finset.sum_singleton, + Finset.card_singleton, Nat.cast_one, div_one] + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor <;> rintro ⟨⟨hx, hy⟩, hx', hy'⟩ <;> + constructor <;> constructor <;> linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean new file mode 100644 index 0000000000..95a1e73ef0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean @@ -0,0 +1,987 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance +public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.FordBaseT1 +public import LeanPool.ApollonianSuperharmonic.FordBaseT2 +public import LeanPool.ApollonianSuperharmonic.FordBaseTouching +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.TileArea + +-- [TABLET NODE: P4564T2FordGeometry] + +/-! +# P4564T2FordGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FordInterfaceGeometry + +private theorem hFcells : + (by + classical + exact + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ( + let F := FordTile P.q + (LatticeTile (FordTile P.q) ∧ TileArea (FordTile P.q) = P.q * P.q) → (F.cells.Nonempty)) + ) := by + classical + intro P hP F hFgeom + by_contra hn + have he : F.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hn + have harea := hFgeom.2 + simp [F, TileArea, he] at harea + omega + +private theorem hTstarCells : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), + let F := FordTile P.q + ∀ (w : GaussianInt), (T.cells = (TileTranslation F w).cells) → ( + let Tstar := TileTranslation T (-w) + Tstar.cells = F.cells) ) := by + classical + intro P T F w hcellsT Tstar + have ht := (TileTranslationFormulas T (-w)).1 + rw [ht, hcellsT] + ext x + simp [TileTranslation, GaussianTranslation, Finset.mem_image] + +private theorem hTstarTile : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), + let F := FordTile P.q + ∀ (S₀ : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + (FootprintVertices Tstar = FootprintVertices F ∧ BoundaryFootprintVertices Tstar = + BoundaryFootprintVertices F ∧ BoundaryFootprintEdges Tstar = BoundaryFootprintEdges F + ∧ TileRealization Tstar = TileRealization F ∧ TileCentroid Tstar = TileCentroid F) → + ((LatticeTile (FordTile P.q) ∧ TileArea (FordTile P.q) = (FordRecursiveQuadruple P (0 + : Fin (4 : ℕ))).1.toNat ∧ ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), LatticeTile + (TileCellComplement (FordTile P.q) (S₀ i s)) ∧ TileTouching (TileCellComplement + (FordTile P.q) (S₀ i s)) (S₀ i s)) → (LatticeTile Tstar)) ) := by + classical + intro P T F S₀ w Tstar hTstarObs hcanT1 + change TopologicalDisk (TileRealization Tstar) + rw [hTstarObs.2.2.2.1] + exact hcanT1.1 + +private theorem hareaT : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), + let F := FordTile P.q + ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + (TileArea Tstar = TileArea F) → (TileArea T = TileArea F) ) := by + classical + intro P T F w Tstar hareaStar + calc + TileArea T = TileArea Tstar := (TileDiskAreaCovariance T (-w)).2.2.2.1.symm + _ = TileArea F := hareaStar + +private theorem hTstarquarter : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), + let F := FordTile P.q + ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + (FootprintVertices Tstar = FootprintVertices F ∧ BoundaryFootprintVertices Tstar = + BoundaryFootprintVertices F ∧ BoundaryFootprintEdges Tstar = BoundaryFootprintEdges F + ∧ TileRealization Tstar = TileRealization F ∧ TileCentroid Tstar = TileCentroid F) → + ((QuarterTurnSymmetric F) → (QuarterTurnSymmetric Tstar)) ) := by + classical + intro P T F w Tstar hTstarObs hFquarter + simpa [QuarterTurnSymmetric, hTstarObs.2.2.2.1, + hTstarObs.2.2.2.2] using hFquarter + +private theorem hTstarCent : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + TileCentroid Tstar = ((TileCentroid T).1 - (w.re : Real), (TileCentroid T).2 - (w.im : + Real)) ) := by + classical + intro T w Tstar + simpa [Tstar, sub_eq_add_neg] using + (TileTranslationFormulas T (-w)).2.2.2.2.1 + +private theorem translated_center_diff : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), + let F := FordTile P.q + ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + (FootprintVertices Tstar = FootprintVertices F ∧ BoundaryFootprintVertices Tstar = + BoundaryFootprintVertices F ∧ BoundaryFootprintEdges Tstar = BoundaryFootprintEdges F + ∧ TileRealization Tstar = TileRealization F ∧ TileCentroid Tstar = TileCentroid F) → + ((TileCentroid Tstar = ((TileCentroid T).1 - (w.re : Real), (TileCentroid T).2 - + (w.im : Real))) → (∀ (U : ProtoTile), TileCentroid (TileTranslation U (-w)) - + TileCentroid F = TileCentroid U - TileCentroid T)) ) := by + classical + intro P T F w Tstar hTstarObs hTstarCent U + rw [(TileTranslationFormulas U (-w)).2.2.2.2.1, + ← hTstarObs.2.2.2.2, hTstarCent] + apply Prod.ext <;> dsimp <;> simp only [Int.cast_neg] <;> ring + +private theorem translated_cells_comm : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (TileTranslation + (TileTranslation A a) b).cells = (TileTranslation (TileTranslation A b) a).cells ) := by + classical + intro A a b + rw [(TileTranslationFormulas (TileTranslation A a) b).1, + (TileTranslationFormulas (TileTranslation A b) a).1, + (TileTranslationFormulas A a).1, (TileTranslationFormulas A b).1] + ext x + simp [GaussianTranslation, Finset.mem_image, add_comm, + add_left_comm] + +private theorem translate_cancel : + (by + classical + exact + ∀ (w : GaussianInt), ∀ (A : ProtoTile), TileTranslation (TileTranslation A (-w)) w = A ) + := by + classical + intro w A + have hfun : GaussianTranslation w ∘ GaussianTranslation (-w) = id := by + funext z + simp [GaussianTranslation, add_comm, + ] + cases A with + | mk cells anchor => + simp only [TileTranslation, ProtoTile.mk.injEq] + constructor + · rw [Finset.image_image, hfun] + simp + · simp [GaussianTranslation, add_comm] + +private theorem triple_same_cells : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (C : + ProtoTile), (A.cells = A'.cells) → ((B.cells = B'.cells) → ((A.cells.Nonempty) → + ((B.cells.Nonempty) → ((TouchingTriple A B C ↔ TouchingTriple A' B' C))))) ) := by + classical + intro A A' B B' C hAcells hBcells hAne hBne + have hAobs := ProtoTileObservableExtensionality A A' hAcells (by + intro he + exact (hAne.ne_empty he).elim) + have hBobs := ProtoTileObservableExtensionality B B' hBcells (by + intro he + exact (hBne.ne_empty he).elim) + have hA'ne : A'.cells.Nonempty := by rw [← hAcells]; exact hAne + have hB'ne : B'.cells.Nonempty := by rw [← hBcells]; exact hBne + have hA'not : A'.cells ≠ ∅ := hA'ne.ne_empty + have hB'not : B'.cells ≠ ∅ := hB'ne.ne_empty + simp [TouchingTriple, TileTouching, hAcells, hBcells, + hA'ne, hB'ne, hA'not, hB'not, hAobs.2.1, hAobs.2.2.1, + hBobs.2.1, hBobs.2.2.1] + +private theorem triple_same_root : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (A.cells = + A'.cells) → ((A.cells.Nonempty) → ((TouchingTriple A B C ↔ TouchingTriple A' B C))) ) + := by + classical + intro A A' B C hAcells hAne + have hAobs := ProtoTileObservableExtensionality A A' hAcells (by + intro he + exact (hAne.ne_empty he).elim) + have hA'ne : A'.cells.Nonempty := by rw [← hAcells]; exact hAne + have hA'not : A'.cells ≠ ∅ := hA'ne.ne_empty + simp [TouchingTriple, TileTouching, hAcells, hA'ne, hA'not, + hAobs.2.1, hAobs.2.2.1] + +private theorem triple_same_cells_all : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (C : + ProtoTile), ∀ (C' : ProtoTile), (A.cells = A'.cells) → ((B.cells = B'.cells) → + ((C.cells = C'.cells) → ((A.cells.Nonempty) → ((B.cells.Nonempty) → + ((C.cells.Nonempty) → ((TouchingTriple A B C ↔ TouchingTriple A' B' C'))))))) ) := by + classical + intro A A' B B' C C' hAcells hBcells hCcells hAne hBne hCne + have hAobs := ProtoTileObservableExtensionality A A' hAcells (by + intro he + exact (hAne.ne_empty he).elim) + have hBobs := ProtoTileObservableExtensionality B B' hBcells (by + intro he + exact (hBne.ne_empty he).elim) + have hCobs := ProtoTileObservableExtensionality C C' hCcells (by + intro he + exact (hCne.ne_empty he).elim) + have hA'ne : A'.cells.Nonempty := by rw [← hAcells]; exact hAne + have hB'ne : B'.cells.Nonempty := by rw [← hBcells]; exact hBne + have hC'ne : C'.cells.Nonempty := by rw [← hCcells]; exact hCne + have hA'not : A'.cells ≠ ∅ := hA'ne.ne_empty + have hB'not : B'.cells ≠ ∅ := hB'ne.ne_empty + have hC'not : C'.cells ≠ ∅ := hC'ne.ne_empty + simp [TouchingTriple, TileTouching, hAcells, hBcells, hCcells, + hA'ne, hB'ne, hC'ne, hA'not, hB'not, hC'not, + hAobs.2.1, hAobs.2.2.1, hBobs.2.1, hBobs.2.2.1, + hCobs.2.1, hCobs.2.2.1] + +private theorem translated_root_cells : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), + let F := FordTile P.q + ∀ (w : GaussianInt), (T.cells = (TileTranslation F w).cells) → ((∀ (A : ProtoTile), ∀ (a + : GaussianInt), ∀ (b : GaussianInt), (TileTranslation (TileTranslation A a) b).cells + = (TileTranslation (TileTranslation A b) a).cells) → (∀ (v : GaussianInt), + (TileTranslation (TileTranslation F v) w).cells = (TileTranslation T v).cells)) ) := by + classical + intro P T F w hcellsT translated_cells_comm v + rw [translated_cells_comm F v w, + (TileTranslationFormulas (TileTranslation F w) v).1, + (TileTranslationFormulas T v).1, hcellsT] + +private theorem lattice_cells_nonempty : + (by + classical + exact + ∀ (A : ProtoTile), (LatticeTile A) → (A.cells.Nonempty) ) := by + classical + intro A hA + by_contra hn + have hc : A.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hn + have hr : (TileRealization A).Nonempty := by + change Nonempty + ((Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) ≃ₜ + TileRealization A) at hA + rcases hA with ⟨e⟩ + exact ⟨(e ⟨0, by simp⟩).1, (e ⟨0, by simp⟩).2⟩ + have : TileRealization A = ∅ := by simp [TileRealization, hc] + rw [this] at hr + rcases hr with ⟨x, hx⟩ + simp at hx + +private theorem hoccStar : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), + let q := FordRecursiveQuadruple P + ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence (FordRecursiveQuadruple P) T i s (S i s)) → ( + let Sstar : Fin 3 → Bool → ProtoTile := fun i s => + TileTranslation (S i s) (-w) + ∀ (i : Fin 3), ∀ (s : Bool), BandSubtileOccurrence q Tstar i s (Sstar i s)) ) := by + classical + intro P T q w Tstar S hS Sstar i s + simpa [Tstar, Sstar, q] using + (BandSubtileOccurrenceTranslation q T (S i s) i s (-w)).mp (hS i s) + +private theorem hoccF : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), + let q := FordRecursiveQuadruple P + let F := FordTile P.q + ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + (FootprintVertices Tstar = FootprintVertices F ∧ BoundaryFootprintVertices Tstar = + BoundaryFootprintVertices F ∧ BoundaryFootprintEdges Tstar = BoundaryFootprintEdges F + ∧ TileRealization Tstar = TileRealization F ∧ TileCentroid Tstar = TileCentroid F) → + (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let Sstar : Fin 3 → Bool → ProtoTile := fun i s => + TileTranslation (S i s) (-w) + (∀ (i : Fin 3), ∀ (s : Bool), BandSubtileOccurrence q Tstar i s (Sstar i s)) → (∀ (i : + Fin 3), ∀ (s : Bool), BandSubtileOccurrence q F i s (Sstar i s))) ) := by + classical + intro P T q F w Tstar hTstarObs S Sstar hoccStar i s + rcases hoccStar i s with ⟨hband, hfoot, hcentroid⟩ + refine ⟨hband, ?_, ?_⟩ + · rw [hTstarObs.1] at hfoot + exact hfoot + · rw [hTstarObs.2.2.2.2] at hcentroid + exact hcentroid + +private theorem hunionF : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), + let F := FordTile P.q + ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + (Tstar.cells = F.cells) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (x : LatticeCell), + x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → ( + let Sstar : Fin 3 → Bool → ProtoTile := fun i s => + TileTranslation (S i s) (-w) + ∀ (x : GaussianInt), x ∈ F.cells ↔ ∃ i s, x ∈ (Sstar i s).cells)) ) := by + classical + intro P T F w Tstar hTstarCells S hunion Sstar x + constructor + · intro hx + have hx' : x ∈ Tstar.cells := by simpa [hTstarCells] using hx + rw [(TileTranslationFormulas T (-w)).1] at hx' + rcases Finset.mem_image.mp hx' with ⟨y, hy, hxy⟩ + rcases (hunion y).mp hy with ⟨i, s, hys⟩ + refine ⟨i, s, ?_⟩ + rw [(TileTranslationFormulas (S i s) (-w)).1] + exact Finset.mem_image.mpr ⟨y, hys, hxy⟩ + · rintro ⟨i, s, hx⟩ + rw [(TileTranslationFormulas (S i s) (-w)).1] at hx + rcases Finset.mem_image.mp hx with ⟨y, hy, hxy⟩ + have hyT : y ∈ T.cells := (hunion y).mpr ⟨i, s, hy⟩ + have hxStar : x ∈ Tstar.cells := by + rw [(TileTranslationFormulas T (-w)).1] + exact Finset.mem_image.mpr ⟨y, hyT, hxy⟩ + simpa [hTstarCells] using hxStar + +private theorem hCobsAt360 : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), + let F := FordTile P.q + ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let Sstar : Fin 3 → Bool → ProtoTile := fun i s => + TileTranslation (S i s) (-w) + ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + let Cstar := TileCellComplement Tstar (Sstar i s) + let CF := TileCellComplement F (Sstar i s) + (Cstar.cells = CF.cells) → ((Finset.Nonempty CF.cells) → (FootprintVertices Cstar = + FootprintVertices CF ∧ BoundaryFootprintVertices Cstar = BoundaryFootprintVertices CF + ∧ BoundaryFootprintEdges Cstar = BoundaryFootprintEdges CF ∧ TileRealization Cstar = + TileRealization CF ∧ TileCentroid Cstar = TileCentroid CF)) ) := by + classical + intro P T F w Tstar S Sstar i s Cstar CF hCcells hCFne + exact ProtoTileObservableExtensionality Cstar CF hCcells (by + intro he + have he' : CF.cells = ∅ := by rw [← hCcells]; exact he + exact (hCFne.ne_empty he').elim) + +private theorem hCtile : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), + let F := FordTile P.q + ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let Sstar : Fin 3 → Bool → ProtoTile := fun i s => + TileTranslation (S i s) (-w) + ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + let Cstar := TileCellComplement Tstar (Sstar i s) + let CF := TileCellComplement F (Sstar i s) + (LatticeTile (TileCellComplement (FordTile P.q) (Sstar i s))) → ((FootprintVertices Cstar + = FootprintVertices CF ∧ BoundaryFootprintVertices Cstar = BoundaryFootprintVertices + CF ∧ BoundaryFootprintEdges Cstar = BoundaryFootprintEdges CF ∧ TileRealization Cstar + = TileRealization CF ∧ TileCentroid Cstar = TileCentroid CF) → (LatticeTile Cstar)) ) + := by + classical + intro P T F w Tstar S Sstar i s Cstar CF hCFtile hCobs + change TopologicalDisk (TileRealization Cstar) + rw [hCobs.2.2.2.1] + exact hCFtile + +private theorem hCtouch : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), + let F := FordTile P.q + ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + (Tstar.cells = F.cells) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let Sstar : Fin 3 → Bool → ProtoTile := fun i s => + TileTranslation (S i s) (-w) + (LatticeTile (FordTile P.q) ∧ TileArea (FordTile P.q) = (FordRecursiveQuadruple P (0 : + Fin (4 : ℕ))).1.toNat ∧ ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), LatticeTile + (TileCellComplement (FordTile P.q) (Sstar i s)) ∧ TileTouching (TileCellComplement + (FordTile P.q) (Sstar i s)) (Sstar i s)) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + let Cstar := TileCellComplement Tstar (Sstar i s) + let CF := TileCellComplement F (Sstar i s) + (Cstar.cells = CF.cells) → ((Finset.Nonempty CF.cells) → ((FootprintVertices Cstar = + FootprintVertices CF ∧ BoundaryFootprintVertices Cstar = BoundaryFootprintVertices CF + ∧ BoundaryFootprintEdges Cstar = BoundaryFootprintEdges CF ∧ TileRealization Cstar = + TileRealization CF ∧ TileCentroid Cstar = TileCentroid CF) → (TileTouching Cstar + (Sstar i s)))))) ) := by + classical + intro P T F w Tstar hTstarCells S Sstar hbase i s Cstar CF hCcells hCFne hCobs + rcases (hbase.2.2 i s).2 with hregular | hemptyComp | hemptySubtile + · rcases hregular with ⟨hcfne, hsne, hdisj, hpath⟩ + left + refine ⟨?_, hsne, ?_, ?_⟩ + · rw [hCcells] + exact hcfne + · simpa [Cstar, CF, TileCellComplement, hTstarCells] using hdisj + · simpa [hCobs.2.1, hCobs.2.2.1] using hpath + · rcases hemptyComp with ⟨hce, ha⟩ + have : False := hCFne.ne_empty (by + have he' : CF.cells = ∅ := by simpa [CF, TileCellComplement] using hce + exact he') + exact this.elim + · rcases hemptySubtile with ⟨hse, ha⟩ + right + right + refine ⟨hse, ?_⟩ + rw [hCobs.2.1] + exact ha + +private theorem hTcomp : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let Sstar : Fin 3 → Bool → ProtoTile := fun i s => + TileTranslation (S i s) (-w) + ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + let Cstar := TileCellComplement Tstar (Sstar i s) + (LatticeTile Cstar) → ((TileTranslation (TileCellComplement T (S i s)) (-w) = Cstar) → + (LatticeTile (TileCellComplement T (S i s)))) ) := by + classical + intro T w Tstar S Sstar i s Cstar hCtile hcovEq + exact (TileDiskAreaCovariance (TileCellComplement T (S i s)) (-w)).1.mpr + (hcovEq ▸ hCtile) + +private theorem hTtouch : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let Sstar : Fin 3 → Bool → ProtoTile := fun i s => + TileTranslation (S i s) (-w) + ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + let Cstar := TileCellComplement Tstar (Sstar i s) + (TileTouching Cstar (Sstar i s)) → ((TileTranslation (TileCellComplement T (S i s)) (-w) + = Cstar) → (TileTouching (TileCellComplement T (S i s)) (S i s))) ) := by + classical + intro T w Tstar S Sstar i s Cstar hCtouch hcovEq + apply (TileTouchingCovariance (TileCellComplement T (S i s)) (S i s) (-w)).1.mpr + simpa [Sstar, hcovEq] using hCtouch + +private theorem hreal : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + TileRealization Tstar = (fun p : Real × Real => (p.1 - (w.re : Real), p.2 - (w.im : + Real))) '' TileRealization T ) := by + classical + intro T w Tstar + simpa [Tstar, sub_eq_add_neg] using + (TileTranslationFormulas T (-w)).2.2.2.1 + +private theorem hcent : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + TileCentroid Tstar = ((TileCentroid T).1 - (w.re : Real), (TileCentroid T).2 - (w.im : + Real)) ) := by + classical + intro T w Tstar + simpa [Tstar, sub_eq_add_neg] using + (TileTranslationFormulas T (-w)).2.2.2.2.1 + +private theorem hf_inj : + (by + classical + exact + ∀ (w : GaussianInt), + let f : Real × Real → Real × Real := fun p => + (p.1 - (w.re : Real), p.2 - (w.im : Real)) + Function.Injective f ) := by + classical + intro w f a b hab + have h1 := congrArg Prod.fst hab + have h2 := congrArg Prod.snd hab + dsimp [f] at h1 h2 + exact Prod.ext (by linarith) (by linarith) + +private theorem hrotate : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + (TileCentroid Tstar = ((TileCentroid T).1 - (w.re : Real), (TileCentroid T).2 - (w.im : + Real))) → ( + let f : Real × Real → Real × Real := fun p => + (p.1 - (w.re : Real), p.2 - (w.im : Real)) + ∀ (p : Real × Real), ( (TileCentroid Tstar).1 - ((f p).2 - (TileCentroid Tstar).2), + (TileCentroid Tstar).2 + ((f p).1 - (TileCentroid Tstar).1)) = f ((TileCentroid T).1 + - (p.2 - (TileCentroid T).2), (TileCentroid T).2 + (p.1 - (TileCentroid T).1))) ) := by + classical + intro T w Tstar hcent f p + rw [hcent] + dsimp [f] + congr 1 <;> ring + +private theorem hpsAt428 : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + (TileRealization Tstar = (fun p : Real × Real => (p.1 - (w.re : Real), p.2 - (w.im : + Real))) '' TileRealization T) → ( + let f : Real × Real → Real × Real := fun p => + (p.1 - (w.re : Real), p.2 - (w.im : Real)) + ∀ (p : ℝ × ℝ), (p ∈ TileRealization T) → (f p ∈ TileRealization Tstar)) ) := by + classical + intro T w Tstar hreal f p hp + rw [hreal] + exact ⟨p, hp, rfl⟩ + +private theorem hr'At434 : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + let f : Real × Real → Real × Real := fun p => + (p.1 - (w.re : Real), p.2 - (w.im : Real)) + (Function.Injective f) → ((∀ (p : Real × Real), ( (TileCentroid Tstar).1 - ((f p).2 - + (TileCentroid Tstar).2), (TileCentroid Tstar).2 + ((f p).1 - (TileCentroid Tstar).1)) + = f ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), (TileCentroid T).2 + (p.1 - + (TileCentroid T).1))) → (∀ (p : ℝ × ℝ), ∀ (r : ℝ × ℝ), ((fun (p : ℝ × ℝ) => (p.1 - + (↑w.re : ℝ), p.2 - (↑w.im : ℝ))) r = ((TileCentroid Tstar).1 - ((f p).2 - + (TileCentroid Tstar).2), (TileCentroid Tstar).2 + ((f p).1 - (TileCentroid + Tstar).1))) → (r = ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), (TileCentroid + T).2 + (p.1 - (TileCentroid T).1))))) ) := by + classical + intro T w Tstar f hf_inj hrotate p r hrf + apply hf_inj + change f r = _ at hrf + rw [hrotate] at hrf + exact hrf + +private theorem hpsAt443 : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + (TileRealization Tstar = (fun p : Real × Real => (p.1 - (w.re : Real), p.2 - (w.im : + Real))) '' TileRealization T) → ( + let f : Real × Real → Real × Real := fun p => + (p.1 - (w.re : Real), p.2 - (w.im : Real)) + ∀ (p : ℝ × ℝ), ( + let c := TileCentroid T; (c.1 - (p.2 - c.2), c.2 + (p.1 - c.1)) ∈ TileRealization T) → (f + ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), (TileCentroid T).2 + (p.1 - + (TileCentroid T).1)) ∈ TileRealization Tstar)) ) := by + classical + intro T w Tstar hreal f p hp + rw [hreal] + exact ⟨_, hp, rfl⟩ + +private theorem hrotmem : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (w : GaussianInt), + let Tstar := TileTranslation T (-w) + let f : Real × Real → Real × Real := fun p => + (p.1 - (w.re : Real), p.2 - (w.im : Real)) + (∀ (p : Real × Real), ( (TileCentroid Tstar).1 - ((f p).2 - (TileCentroid Tstar).2), + (TileCentroid Tstar).2 + ((f p).1 - (TileCentroid Tstar).1)) = f ((TileCentroid T).1 + - (p.2 - (TileCentroid T).2), (TileCentroid T).2 + (p.1 - (TileCentroid T).1))) → (∀ + (p : ℝ × ℝ), (f ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), (TileCentroid T).2 + + (p.1 - (TileCentroid T).1)) ∈ TileRealization Tstar) → (((TileCentroid Tstar).1 - + ((f p).2 - (TileCentroid Tstar).2), (TileCentroid Tstar).2 + ((f p).1 - (TileCentroid + Tstar).1)) ∈ TileRealization Tstar)) ) := by + classical + intro T w Tstar f hrotate p hps + rw [hrotate] + exact hps + +private theorem hAneAt467 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let F := FordTile P.q + ∀ (w : GaussianInt), (F.cells.Nonempty) → ((TileTranslation F w).cells.Nonempty) ) := by + classical + intro P F w hFcells + rw [(TileTranslationFormulas F w).1] + exact hFcells.image _ + +private theorem hBneAt470 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let q := FordRecursiveQuadruple P + let F := FordTile P.q + ∀ (w : GaussianInt), (F.cells.Nonempty) → (∀ (i : Fin (3 : ℕ)), + let a := BandVectors.1 (q i.succ) (q 0) + (TileTranslation (TileTranslation F a) w).cells.Nonempty) ) := by + classical + intro P q F w hFcells i a + rw [(TileTranslationFormulas (TileTranslation F a) w).1, + (TileTranslationFormulas F a).1] + exact (hFcells.image _).image _ + +private theorem hCne : + (by + classical + exact + ∀ (P : FordFareyParameter), + let q := FordRecursiveQuadruple P + let F := FordTile P.q + ∀ (w : GaussianInt), (F.cells.Nonempty) → (∀ (i : Fin (3 : ℕ)), + let b := -BandVectors.1 (q ((i + 1).succ)) (q 0) + (TileTranslation (TileTranslation F b) w).cells.Nonempty) ) := by + classical + intro P q F w hFcells i b + rw [(TileTranslationFormulas (TileTranslation F b) w).1, + (TileTranslationFormulas F b).1] + exact (hFcells.image _).image _ + +private theorem hbaseAt490 : + (by + classical + exact + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → (∀ (T : ProtoTile), + let q := FordRecursiveQuadruple P + let F := FordTile P.q + ∀ (w : GaussianInt), (∀ (U : ProtoTile), TileCentroid (TileTranslation U (-w)) - + TileCentroid F = TileCentroid U - TileCentroid T) → (∀ (i : Fin (3 : ℕ)), ∀ (U : + ProtoTile), (TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : + ℕ))) (FordRecursiveQuadruple P i.succ)))) → ( + let a := BandVectors.1 (q i.succ) (q 0) + let Ustar := TileTranslation U (-w) + (BandPrototile (q i.succ) Ustar) → (TouchingTriple F (TileTranslation F a) Ustar)))) ) := by + classical + intro P hP T q F w translated_center_diff i U hcent a Ustar hUstar + apply (FordBaseTouching P hP).2.1 i Ustar hUstar + rw [translated_center_diff U] + exact hcent + +private theorem hAneAt500 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let F := FordTile P.q + ∀ (w : GaussianInt), (F.cells.Nonempty) → ((TileTranslation F w).cells.Nonempty) ) := by + classical + intro P F w hFcells + rw [(TileTranslationFormulas F w).1] + exact hFcells.image _ + +private theorem hBneAt503 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let q := FordRecursiveQuadruple P + let F := FordTile P.q + ∀ (w : GaussianInt), (F.cells.Nonempty) → (∀ (i : Fin (3 : ℕ)), + let a := BandVectors.1 (q i.succ) (q 0) + (TileTranslation (TileTranslation F a) w).cells.Nonempty) ) := by + classical + intro P q F w hFcells i a + rw [(TileTranslationFormulas (TileTranslation F a) w).1, + (TileTranslationFormulas F a).1] + exact (hFcells.image _).image _ + +private theorem hbaseAt517 : + (by + classical + exact + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → (∀ (T : ProtoTile), + let q := FordRecursiveQuadruple P + let F := FordTile P.q + ∀ (w : GaussianInt), (∀ (U : ProtoTile), TileCentroid (TileTranslation U (-w)) - + TileCentroid F = TileCentroid U - TileCentroid T) → (∀ (i : Fin (3 : ℕ)), ∀ (U : + ProtoTile), ∀ (V : ProtoTile), (TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ)))) → + ((TileCentroid V - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (FordRecursiveQuadruple P (i + (1 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (0 + : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P (0 : + Fin (4 : ℕ))) (FordRecursiveQuadruple P (i + (1 : Fin (3 : ℕ))).succ)))) → ( + let Ustar := TileTranslation U (-w) + let Vstar := TileTranslation V (-w) + (BandPrototile (q i.succ) Ustar) → ((BandPrototile (q ((i + 1).succ)) Vstar) → + (TouchingTriple F Ustar Vstar)))))) ) := by + classical + intro P hP T q F w translated_center_diff i U V hUcent hVcent Ustar Vstar hUstar hVstar + apply (FordBaseTouching P hP).2.2 i Ustar Vstar hUstar hVstar + · rw [translated_center_diff U] + exact hUcent + · rw [translated_center_diff V] + exact hVcent + +private theorem hAneAt528 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let F := FordTile P.q + ∀ (w : GaussianInt), (F.cells.Nonempty) → ((TileTranslation F w).cells.Nonempty) ) := by + classical + intro P F w hFcells + rw [(TileTranslationFormulas F w).1] + exact hFcells.image _ + +end FordInterfaceGeometry + +theorem P4564T2FordGeometry (P : FordFareyParameter) (hP : 1 < P.q) + (T : ProtoTile) (hT : BandPrototile ((FordRecursiveQuadruple P) 0) T) : + let q := FordRecursiveQuadruple P + LatticeTile T ∧ TileArea T = Int.toNat (q 0).1 ∧ + (∀ (S : Fin 3 → Bool → ProtoTile), + (∀ i s, BandSubtileOccurrence q T i s (S i s)) → + (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (S i s).cells) → + ∀ i s, LatticeTile (TileCellComplement T (S i s)) ∧ + TileTouching (TileCellComplement T (S i s)) (S i s)) ∧ + QuarterTurnSymmetric T ∧ + (1 < (q 0).1 → ∀ i : Fin 3, + TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) + (TileTranslation T + (-BandVectors.1 (q ((i + 1).succ)) (q 0)))) ∧ + (1 < (q 0).1 → ∀ (i : Fin 3) (U : ProtoTile), + BandPrototile (q i.succ) U → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) U) ∧ + (∀ (i : Fin 3) (U V : ProtoTile), + BandPrototile (q i.succ) U → + BandPrototile (q ((i + 1).succ)) V → + TileCentroid U - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) → + TileCentroid V - TileCentroid T = (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ)))) → + TouchingTriple T U V) := by +-- BODY + classical + dsimp only + let q := FordRecursiveQuadruple P + let F := FordTile P.q + have hrec := FordTileRecursiveIdentification P + have hF : BandPrototile (q 0) F := by + simpa [q, F, FordRecursiveQuadruple] using hrec.1 + have hT' : BandPrototile (q 0) T := by + simpa [q, FordRecursiveQuadruple] using hT + have hcanon := hrec.2.2 hP + rcases hcanon with ⟨hqproper, S₀, hS₀, hunion₀, _, _, _, _, _, _, _⟩ + have hnorm := BandPrototileTranslationNormalForm (q 0) T F hT' hF + rcases hnorm with ⟨w, hcellsT, hemptyAnchor⟩ + have hFgeom := FordTileGeometry P.q P.q_pos + have hFcells := FordInterfaceGeometry.hFcells P hP hFgeom + let Tstar := TileTranslation T (-w) + have hTstarCells : Tstar.cells = F.cells := FordInterfaceGeometry.hTstarCells P T w hcellsT + have hTstarObs := ProtoTileObservableExtensionality Tstar F hTstarCells (by + intro he + exact (hFcells.ne_empty (hTstarCells.symm.trans he)).elim) + have hcanT1 := FordBaseT1 P hP S₀ hS₀ hunion₀ + have hTstarTile := FordInterfaceGeometry.hTstarTile P T S₀ w hTstarObs hcanT1 + have hTtile : LatticeTile T := by + exact (TileDiskAreaCovariance T (-w)).1.mpr hTstarTile + have hareaStar : TileArea Tstar = TileArea F := by + simp [TileArea, hTstarCells] + have hareaT := FordInterfaceGeometry.hareaT P T w hareaStar + have hFquarter : QuarterTurnSymmetric F := by + simpa [F] using FordBaseT2 P.q P.q_pos + have hTstarquarter := FordInterfaceGeometry.hTstarquarter P T w hTstarObs hFquarter + have hTstarCent := FordInterfaceGeometry.hTstarCent T w + have translated_center_diff (U : ProtoTile) := FordInterfaceGeometry.translated_center_diff P T + w hTstarObs hTstarCent U + have translated_cells_comm (A : ProtoTile) (a b : GaussianInt) := + FordInterfaceGeometry.translated_cells_comm A a b + have translate_cancel (A : ProtoTile) : + TileTranslation (TileTranslation A (-w)) w = A := FordInterfaceGeometry.translate_cancel w A + have triple_same_cells (A A' B B' C : ProtoTile) + (hAcells : A.cells = A'.cells) (hBcells : B.cells = B'.cells) + (hAne : A.cells.Nonempty) (hBne : B.cells.Nonempty) := + FordInterfaceGeometry.triple_same_cells A A' B B' C hAcells hBcells hAne hBne + have triple_same_root (A A' B C : ProtoTile) + (hAcells : A.cells = A'.cells) (hAne : A.cells.Nonempty) := + FordInterfaceGeometry.triple_same_root A A' B C hAcells hAne + have triple_same_cells_all (A A' B B' C C' : ProtoTile) + (hAcells : A.cells = A'.cells) (hBcells : B.cells = B'.cells) + (hCcells : C.cells = C'.cells) + (hAne : A.cells.Nonempty) (hBne : B.cells.Nonempty) + (hCne : C.cells.Nonempty) := FordInterfaceGeometry.triple_same_cells_all A A' B B' C C' + hAcells hBcells hCcells hAne hBne hCne + have translated_root_cells (v : GaussianInt) := FordInterfaceGeometry.translated_root_cells P T + w hcellsT translated_cells_comm v + have lattice_cells_nonempty (A : ProtoTile) (hA : LatticeTile A) := + FordInterfaceGeometry.lattice_cells_nonempty A hA + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · exact hTtile + · calc + TileArea T = TileArea F := hareaT + _ = Int.toNat ((q 0).1) := by + simpa [F, q, FordRecursiveQuadruple] using hcanT1.2.1 + · intro S hS hunion + let Sstar : Fin 3 → Bool → ProtoTile := fun i s => + TileTranslation (S i s) (-w) + have hoccStar (i : Fin 3) (s : Bool) := FordInterfaceGeometry.hoccStar P T w S hS i s + have hoccF (i : Fin 3) (s : Bool) := FordInterfaceGeometry.hoccF P T w hTstarObs S hoccStar i s + have hunionF (x : GaussianInt) := FordInterfaceGeometry.hunionF P T w hTstarCells S hunion x + have hbase := FordBaseT1 P hP Sstar hoccF hunionF + intro i s + let Cstar := TileCellComplement Tstar (Sstar i s) + let CF := TileCellComplement F (Sstar i s) + have hCcells : Cstar.cells = CF.cells := by + simp [Cstar, CF, TileCellComplement, hTstarCells] + have hCFtile := (hbase.2.2 i s).1 + have hCFne := lattice_cells_nonempty CF hCFtile + have hCobs := FordInterfaceGeometry.hCobsAt360 P T w S i s hCcells hCFne + have hCtile := FordInterfaceGeometry.hCtile P T w S i s hCFtile hCobs + have hCtouch := FordInterfaceGeometry.hCtouch P T w hTstarCells S hbase i s hCcells hCFne hCobs + have hcov := TileCellComplementCovariance T (S i s) (-w) + have hcovEq : TileTranslation (TileCellComplement T (S i s)) (-w) = Cstar := by + simpa [Tstar, Sstar, Cstar] using hcov.1 + have hTcomp := FordInterfaceGeometry.hTcomp T w S i s hCtile hcovEq + have hTtouch := FordInterfaceGeometry.hTtouch T w S i s hCtouch hcovEq + exact ⟨hTcomp, hTtouch⟩ + · have hreal : TileRealization Tstar = + (fun p : Real × Real => + (p.1 - (w.re : Real), p.2 - (w.im : Real))) '' TileRealization T := + FordInterfaceGeometry.hreal T w + have hcent := FordInterfaceGeometry.hcent T w + let f : Real × Real → Real × Real := fun p => + (p.1 - (w.re : Real), p.2 - (w.im : Real)) + have hf_inj := FordInterfaceGeometry.hf_inj w + have hrotate (p : Real × Real) := FordInterfaceGeometry.hrotate T w hcent p + unfold QuarterTurnSymmetric + intro p + constructor + · intro hp + have hps := FordInterfaceGeometry.hpsAt428 T w hreal p hp + have hr := (hTstarquarter (f p)).mp hps + rw [hreal] at hr + rcases hr with ⟨r, hrT, hrf⟩ + have hr' : r = + ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), + (TileCentroid T).2 + (p.1 - (TileCentroid T).1)) := FordInterfaceGeometry.hr'At434 T + w hf_inj hrotate p r hrf + simpa [hr'] using hrT + · intro hp + have hps := FordInterfaceGeometry.hpsAt443 T w hreal p hp + have hrotmem := FordInterfaceGeometry.hrotmem T w hrotate p hps + have hr := (hTstarquarter (f p)).mpr hrotmem + rw [hreal] at hr + rcases hr with ⟨r, hrT, hrf⟩ + change f r = f p at hrf + have hr' : r = p := hf_inj hrf + simpa [hr'] using hrT + · intro hguard i + let a := BandVectors.1 (q i.succ) (q 0) + let b := -BandVectors.1 (q ((i + 1).succ)) (q 0) + change TouchingTriple T (TileTranslation T a) (TileTranslation T b) + have hbase : TouchingTriple F (TileTranslation F a) (TileTranslation F b) := + (FordBaseTouching P hP).1 i + have hmove := (TouchingTripleCovariance F (TileTranslation F a) + (TileTranslation F b) w).1.mp hbase + have hAne := FordInterfaceGeometry.hAneAt467 P w hFcells + have hBne := FordInterfaceGeometry.hBneAt470 P w hFcells i + have hCne := FordInterfaceGeometry.hCne P w hFcells i + exact (triple_same_cells_all + (TileTranslation F w) T + (TileTranslation (TileTranslation F a) w) (TileTranslation T a) + (TileTranslation (TileTranslation F b) w) (TileTranslation T b) + hcellsT.symm (translated_root_cells a) (translated_root_cells b) + hAne hBne hCne).mp hmove + · intro hguard i U hU hcent + let a := BandVectors.1 (q i.succ) (q 0) + let Ustar := TileTranslation U (-w) + change TouchingTriple T (TileTranslation T a) U + have hUstar : BandPrototile (q i.succ) Ustar := + BandPrototileTranslation (q i.succ) U (-w) hU + have hbase := FordInterfaceGeometry.hbaseAt490 P hP T w translated_center_diff i U hcent hUstar + have hmove := (TouchingTripleCovariance F (TileTranslation F a) + Ustar w).1.mp hbase + change TouchingTriple (TileTranslation F w) + (TileTranslation (TileTranslation F a) w) + (TileTranslation (TileTranslation U (-w)) w) at hmove + rw [translate_cancel U] at hmove + have hAne := FordInterfaceGeometry.hAneAt500 P w hFcells + have hBne := FordInterfaceGeometry.hBneAt503 P w hFcells i + exact (triple_same_cells (TileTranslation F w) T + (TileTranslation (TileTranslation F a) w) (TileTranslation T a) U + hcellsT.symm (translated_root_cells a) hAne hBne).mp hmove + · intro i U V hU hV hUcent hVcent + let Ustar := TileTranslation U (-w) + let Vstar := TileTranslation V (-w) + have hUstar : BandPrototile (q i.succ) Ustar := + BandPrototileTranslation (q i.succ) U (-w) hU + have hVstar : BandPrototile (q ((i + 1).succ)) Vstar := + BandPrototileTranslation (q ((i + 1).succ)) V (-w) hV + have hbase := FordInterfaceGeometry.hbaseAt517 P hP T w translated_center_diff i U V hUcent + hVcent hUstar hVstar + have hmove := (TouchingTripleCovariance F Ustar Vstar w).1.mp hbase + change TouchingTriple (TileTranslation F w) + (TileTranslation (TileTranslation U (-w)) w) + (TileTranslation (TileTranslation V (-w)) w) at hmove + rw [translate_cancel U, translate_cancel V] at hmove + have hAne := FordInterfaceGeometry.hAneAt528 P w hFcells + exact (triple_same_root (TileTranslation F w) T U V + hcellsT.symm hAne).mp hmove + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean b/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean new file mode 100644 index 0000000000..aff370e723 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean @@ -0,0 +1,1204 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordBaseT6 +public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse +public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretationCovariance +public import LeanPool.ApollonianSuperharmonic.TileArea + +-- [TABLET NODE: P4564T2FordT6Transport] + +/-! +# P4564T2FordT6Transport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FordT6Geometry + +private theorem hlineq : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (a : Fin 3), ∀ (g : + BandPackingSymmetry), ∀ (F : FordFareyParameter), (BandPackingSymmetryQuadrupleAction + g ![q (0 : Fin (4 : ℕ)), q a.succ, q (a + (1 : Fin (3 : ℕ))).succ, q (a + (2 : Fin (3 + : ℕ))).succ] = FordRecursiveQuadruple F) → (((q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 + : ℕ))).1) → (((1 : ℤ) < (q (2 : Fin (4 : ℕ))).1) → (((0 : ℤ) < (q (0 : Fin (4 : + ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (j : + Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) → (∃ i : Fin + 4, (q i).1 = 0))))) ) := by + classical + intro q hq a g F hnormal h12 hlarge qcur + have hzero : ((FordRecursiveQuadruple F) 3).1 = 0 := by + simp [FordRecursiveQuadruple] + have hval := congrArg (fun t : Fin 4 → CircleCoordinates => (t 3).1) hnormal + have hcurv := (BandPackingSymmetryCovariance g).1 + have hact : (BandPackingSymmetryQuadrupleAction g + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] 3).1 = 0 := by + rw [hval] + exact hzero + have hparent : ∃ j : Fin 3, (q j.succ).1 = 0 := by + cases hor : BandPackingSymmetryReversesOrientation g <;> + fin_cases a <;> + simp? [BandPackingSymmetryQuadrupleAction, hor] at hact + all_goals + first + | exact ⟨0, (hcurv (q 1)).symm.trans hact⟩ + | exact ⟨1, (hcurv (q 2)).symm.trans hact⟩ + | exact ⟨2, (hcurv (q 3)).symm.trans hact⟩ + rcases hparent with ⟨j, hj⟩ + have hp1 := qcur.2.1 0 + have hp2 := qcur.2.1 1 + have hq1 : 0 < (q 1).1 := by + have := hq.2 0 + simp at this + omega + have hq2 : 0 < (q 2).1 := by + have := hq.2 1 + simp at this + omega + fin_cases j + · simp at hj + omega + · simp at hj + omega + · exact ⟨3, by simpa using hj⟩ + +private theorem hb : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (FordFareyParameter) → (((q (2 : Fin (4 : ℕ))).1 ≤ (q + (1 : Fin (4 : ℕ))).1) → (((1 : ℤ) < (q (2 : Fin (4 : ℕ))).1) → (((0 : ℤ) < (q (0 : + Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin (3 : + ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) → + ((∃ i : Fin 4, (q i).1 = 0) → (∀ (b : Fin (3 : ℕ)), ∀ (h : BandPackingSymmetry), ∀ + (F' : FordFareyParameter), ((q (b + (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ)) → + ((BandPackingSymmetryQuadrupleAction h ![q (0 : Fin (4 : ℕ)), q b.succ, q (b + (1 : + Fin (3 : ℕ))).succ, q (b + (2 : Fin (3 : ℕ))).succ] = FordRecursiveQuadruple F') → (b + = 0))))))) ) := by + classical + intro q F h12 hlarge qcur hlineq b h F' hzero hnorm + fin_cases b + · rfl + · have := qcur.2.1 0 + have hz : (q 1).1 = 0 := by simpa using hzero + omega + · have := qcur.2.1 1 + have hz : (q 2).1 = 0 := by simpa using hzero + omega + +private theorem hnormq : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (h : BandPackingSymmetry), ∀ (F' : + FordFareyParameter), (BandPackingSymmetryQuadrupleAction h ![q (0 : Fin (4 : ℕ)), q + (Fin.succ (0 : Fin (3 : ℕ))), q ((0 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ, q ((0 : + Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ] = FordRecursiveQuadruple F') → + (BandPackingSymmetryQuadrupleAction h q = FordRecursiveQuadruple F') ) := by + classical + intro q h F' hnorm + rw [show q = ![q 0, q 1, q 2, q 3] by + funext i + fin_cases i <;> rfl] + exact hnorm + +private theorem hqhat : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (h : BandPackingSymmetry), ∀ (F' : + FordFareyParameter), (BandPackingSymmetryQuadrupleAction h q = FordRecursiveQuadruple + F') → (∀ (gN : BandPackingSymmetry), (∀ (p : Fin (4 : ℕ) → CircleCoordinates), + BandPackingSymmetryQuadrupleAction gN p = BandPackingSymmetryQuadrupleAction h p) → + (BandPackingSymmetryQuadrupleAction gN q = FordRecursiveQuadruple F')) ) := by + classical + intro q h F' hnormq gN hquadAdapt + rw [hquadAdapt] + exact hnormq + +private theorem hr0hat : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), (r (0 : Fin + (4 : ℕ)) = q (1 : Fin (4 : ℕ))) → (∀ (h : BandPackingSymmetry), ∀ (F' : + FordFareyParameter), ∀ (gN : BandPackingSymmetry), + (BandPackingSymmetryReversesOrientation gN = BandPackingSymmetryReversesOrientation + h) → ((BandPackingSymmetryQuadrupleAction gN q = FordRecursiveQuadruple F') → + ((BandPackingSymmetryQuadrupleAction gN r) 0 = (FordRecursiveQuadruple F') 1))) ) := by + classical + intro q r hr0 h F' gN horientationAdapt hqhat + have hh := congrFun hqhat 1 + change BandPackingSymmetryCircleAction gN (r 0) = _ + rw [hr0] + simpa [BandPackingSymmetryQuadrupleAction, horientationAdapt] using hh + +private theorem hr2hat : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), (r (2 : Fin + (4 : ℕ)) = q (2 : Fin (4 : ℕ))) → (∀ (h : BandPackingSymmetry), ∀ (F' : + FordFareyParameter), (BandPackingSymmetryReversesOrientation h = false) → (∀ (gN : + BandPackingSymmetry), (BandPackingSymmetryReversesOrientation gN = + BandPackingSymmetryReversesOrientation h) → ((BandPackingSymmetryQuadrupleAction gN q + = FordRecursiveQuadruple F') → ((BandPackingSymmetryQuadrupleAction gN r) 2 = + (FordRecursiveQuadruple F') 2)))) ) := by + classical + intro q r hr2 h F' hrev gN horientationAdapt hqhat + have hh : BandPackingSymmetryCircleAction gN (q 2) = + (FordRecursiveQuadruple F') 2 := by + simpa [BandPackingSymmetryQuadrupleAction, horientationAdapt, hrev] using + congrFun hqhat 2 + simpa [BandPackingSymmetryQuadrupleAction, horientationAdapt, hrev, hr2] using + hh + +private theorem hr3hat : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), (r (3 : Fin + (4 : ℕ)) = q (3 : Fin (4 : ℕ))) → (∀ (h : BandPackingSymmetry), ∀ (F' : + FordFareyParameter), (BandPackingSymmetryReversesOrientation h = false) → (∀ (gN : + BandPackingSymmetry), (BandPackingSymmetryReversesOrientation gN = + BandPackingSymmetryReversesOrientation h) → ((BandPackingSymmetryQuadrupleAction gN q + = FordRecursiveQuadruple F') → ((BandPackingSymmetryQuadrupleAction gN r) 3 = + (FordRecursiveQuadruple F') 3)))) ) := by + classical + intro q r hr3 h F' hrev gN horientationAdapt hqhat + have hh : BandPackingSymmetryCircleAction gN (q 3) = + (FordRecursiveQuadruple F') 3 := by + simpa [BandPackingSymmetryQuadrupleAction, horientationAdapt, hrev] using + congrFun hqhat 3 + simpa [BandPackingSymmetryQuadrupleAction, horientationAdapt, hrev, hr3] using + hh + +private theorem horder : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), (r (0 : Fin + (4 : ℕ)) = q (1 : Fin (4 : ℕ))) → ((r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ))) → (((q + (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1) → (∀ (h : BandPackingSymmetry), ∀ (F' + : FordFareyParameter), (BandPackingSymmetryReversesOrientation h = false) → (∀ (gN : + BandPackingSymmetry), (BandPackingSymmetryReversesOrientation gN = + BandPackingSymmetryReversesOrientation h) → (((BandPackingSymmetryQuadrupleAction gN + r) 0 = (FordRecursiveQuadruple F') 1) → (((BandPackingSymmetryQuadrupleAction gN r) 2 + = (FordRecursiveQuadruple F') 2) → (((FordRecursiveQuadruple F') 2).1 ≤ + ((FordRecursiveQuadruple F') 1).1))))))) ) := by + classical + intro q r hr0 hr2 h12 h F' hrev gN horientationAdapt hr0hat hr2hat + have hc : ∀ C, (BandPackingSymmetryCircleAction gN C).1 = C.1 := + (BandPackingSymmetryCovariance gN).1 + rw [← hr2hat, ← hr0hat] + simp? [BandPackingSymmetryQuadrupleAction, horientationAdapt, hrev, hc, hr2, hr0] + exact h12 + +private theorem hlarge' : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), (r (2 : Fin + (4 : ℕ)) = q (2 : Fin (4 : ℕ))) → (((1 : ℤ) < (q (2 : Fin (4 : ℕ))).1) → (∀ (h : + BandPackingSymmetry), ∀ (F' : FordFareyParameter), + (BandPackingSymmetryReversesOrientation h = false) → (∀ (gN : BandPackingSymmetry), + (BandPackingSymmetryReversesOrientation gN = BandPackingSymmetryReversesOrientation + h) → (((BandPackingSymmetryQuadrupleAction gN r) 2 = (FordRecursiveQuadruple F') 2) → + (1 < ((FordRecursiveQuadruple F') 2).1))))) ) := by + classical + intro q r hr2 hlarge h F' hrev gN horientationAdapt hr2hat + have hc : ∀ C, (BandPackingSymmetryCircleAction gN C).1 = C.1 := + (BandPackingSymmetryCovariance gN).1 + rw [← hr2hat] + simp? [BandPackingSymmetryQuadrupleAction, horientationAdapt, hrev, hc, hr2] + exact hlarge + +private theorem hT' : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), (BandPrototile (q (0 : Fin (4 : + ℕ))) T) → (∀ (gN : BandPackingSymmetry), BandPrototile + ((BandPackingSymmetryQuadrupleAction gN q) 0) (BandPackingSymmetryTileAction gN T)) ) + := by + classical + intro q T hT gN + exact ((BandPackingSymmetryCovariance gN).2.1 (q 0) T).mp hT + +private theorem hep : + (by + classical + exact + ∀ (h : BandPackingSymmetry), (BandPackingSymmetryReversesOrientation h = false) → (∀ (gN + : BandPackingSymmetry), (BandPackingSymmetryReversesOrientation gN = + BandPackingSymmetryReversesOrientation h) → (∀ (dp : Bool), ∀ (ep : Fin (3 : ℕ) × + Bool ≃ Fin (3 : ℕ) × Bool), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (ep : Fin (3 : ℕ) × + Bool → Fin (3 : ℕ) × Bool) (i, s) = ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation gN = true then -i else i) i, s ^^ dp)) → ((dp + = false) → (∀ (i : Fin 3), ∀ (s : Bool), ep (i, s) = (i, s))))) ) := by + classical + intro h hrev gN horientationAdapt dp ep hpe hdp i s + rw [hpe] + simp [horientationAdapt, hrev, hdp] + +private theorem hPp : + (by + classical + exact + ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gN : BandPackingSymmetry), ∀ (ep : Fin (3 : ℕ) + × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (Pp : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 + : ℕ)), ∀ (s : Bool), Pp ((ep : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + ((ep : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).2 = + BandPackingSymmetryTileAction gN (P i s)) → ((∀ (i : Fin 3), ∀ (s : Bool), ep (i, s) + = (i, s)) → (∀ i, ∀ s, Pp i s = BandPackingSymmetryTileAction gN (P i s))) ) := by + classical + intro P gN ep Pp hpmem hep i s + simpa [hep i s] using hpmem i s + +private theorem heq : + (by + classical + exact + ∀ (h : BandPackingSymmetry), (BandPackingSymmetryReversesOrientation h = false) → (∀ (gN + : BandPackingSymmetry), (BandPackingSymmetryReversesOrientation gN = + BandPackingSymmetryReversesOrientation h) → (∀ (dq : Bool), ∀ (eq : Fin (3 : ℕ) × + Bool ≃ Fin (3 : ℕ) × Bool), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (eq : Fin (3 : ℕ) × + Bool → Fin (3 : ℕ) × Bool) (i, s) = ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation gN = true then -i else i) i, s ^^ dq)) → ((dq + = false) → (∀ (i : Fin 3), ∀ (s : Bool), eq (i, s) = (i, s))))) ) := by + classical + intro h hrev gN horientationAdapt dq eq hqe hdq i s + rw [hqe] + simp [horientationAdapt, hrev, hdq] + +private theorem hes : + (by + classical + exact + ∀ (h : BandPackingSymmetry), (BandPackingSymmetryReversesOrientation h = false) → (∀ (gN + : BandPackingSymmetry), (BandPackingSymmetryReversesOrientation gN = + BandPackingSymmetryReversesOrientation h) → (∀ (ds : Bool), ∀ (es : Fin (3 : ℕ) × + Bool ≃ Fin (3 : ℕ) × Bool), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (es : Fin (3 : ℕ) × + Bool → Fin (3 : ℕ) × Bool) (i, s) = ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation gN = true then -i else i) i, s ^^ ds)) → ((ds + = false) → (∀ (i : Fin 3), ∀ (s : Bool), es (i, s) = (i, s))))) ) := by + classical + intro h hrev gN horientationAdapt ds es hse hds i s + rw [hse] + simp [horientationAdapt, hrev, hds] + +private theorem hQp : + (by + classical + exact + ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gN : BandPackingSymmetry), ∀ (eq : Fin (3 : ℕ) + × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (Qp : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 + : ℕ)), ∀ (s : Bool), Qp ((eq : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + ((eq : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).2 = + BandPackingSymmetryTileAction gN (Q i s)) → ((∀ (i : Fin 3), ∀ (s : Bool), eq (i, s) + = (i, s)) → (∀ i, ∀ s, Qp i s = BandPackingSymmetryTileAction gN (Q i s))) ) := by + classical + intro Q gN eq Qp hqmem heq i s + simpa [heq i s] using hqmem i s + +private theorem hSp : + (by + classical + exact + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gN : BandPackingSymmetry), ∀ (es : Fin (3 : ℕ) + × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (Sp : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 + : ℕ)), ∀ (s : Bool), Sp ((es : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + ((es : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).2 = + BandPackingSymmetryTileAction gN (S i s)) → ((∀ (i : Fin 3), ∀ (s : Bool), es (i, s) + = (i, s)) → (∀ i, ∀ s, Sp i s = BandPackingSymmetryTileAction gN (S i s))) ) := by + classical + intro S gN es Sp hsmem hes i s + simpa [hes i s] using hsmem i s + +private theorem hFord : + (by + classical + exact + ∀ (F' : FordFareyParameter), BandPrototile ((FordRecursiveQuadruple F') 0) (FordTile + F'.q) ) := by + classical + intro F' + simpa [FordRecursiveQuadruple] using + (FordTileRecursiveIdentification F').1 + +private theorem cancelTranslation : + (by + classical + exact + ∀ (w : GaussianInt), ∀ (U : ProtoTile), TileTranslation (TileTranslation U w) (-w) = U ) + := by + classical + intro w U + cases U with + | mk cells anchor => + simp [TileTranslation, GaussianTranslation, Finset.image_image, + Function.comp_def, add_assoc, add_comm] + +private theorem hrootCells : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (F' : FordFareyParameter), ∀ (gN : BandPackingSymmetry), + let Tn := BandPackingSymmetryTileAction gN T + ∀ (w : GaussianInt), (Tn.cells = (TileTranslation (FordTile F'.q) w).cells) → ( + let Tbar : ProtoTile := TileTranslation Tn (-w) + (∀ (U : ProtoTile), TileTranslation (TileTranslation U w) (-w) = U) → (Tbar.cells = + (FordTile F'.q).cells)) ) := by + classical + intro T F' gN Tn w hcellsNormal Tbar cancelTranslation + rw [(TileTranslationFormulas Tn (-w)).1, hcellsNormal, + (TileTranslationFormulas (FordTile F'.q) w).1] + have hc := congrArg ProtoTile.cells (cancelTranslation (FordTile F'.q)) + simpa [TileTranslation, Finset.image_image, Function.comp_def] using hc + +private theorem hrootAnchor : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (F' : FordFareyParameter), ∀ (gN : BandPackingSymmetry), + let Tn := BandPackingSymmetryTileAction gN T + ∀ (w : GaussianInt), (Tn.cells = ∅ → Tn.anchor = (TileTranslation (FordTile F'.q) + w).anchor) → ( + let Tbar : ProtoTile := TileTranslation Tn (-w) + Tbar.cells = ∅ → Tbar.anchor = (FordTile F'.q).anchor) ) := by + classical + intro T F' gN Tn w hemptyNormal Tbar hempty + have hempty' : Tn.cells = ∅ := + (TileTranslationFormulas Tn (-w)).2.2.1.mp (by simpa [Tbar] using hempty) + have ha := hemptyNormal hempty' + change GaussianTranslation (-w) Tn.anchor = (FordTile F'.q).anchor + rw [ha] + simp [TileTranslation, GaussianTranslation, add_assoc, add_comm] + +private theorem hPbar : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (F' : FordFareyParameter), ∀ (gN + : BandPackingSymmetry), (BandPackingSymmetryQuadrupleAction gN q = + FordRecursiveQuadruple F') → (∀ (Pp : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 + : ℕ)), ∀ (s : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction gN q) + (BandPackingSymmetryTileAction gN T) i s (Pp i s)) → ( + let Tn := BandPackingSymmetryTileAction gN T + let Pn : Fin 3 → Bool → ProtoTile := Pp + ∀ (w : GaussianInt), + let Pbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Pn i s) (-w) + let Tbar : ProtoTile := TileTranslation Tn (-w) + ∀ i, ∀ s, BandSubtileOccurrence (FordRecursiveQuadruple F') Tbar i s (Pbar i s))) ) := by + classical + intro q T F' gN hqhat Pp hpp Tn Pn w Pbar Tbar i s + have ho := (BandSubtileOccurrenceTranslation + (FordRecursiveQuadruple F') Tn (Pn i s) i s (-w) + ).mp (by simpa [Tn, Pn, hqhat] using hpp i s) + rcases ho with ⟨hb, hf, hc⟩ + refine ⟨hb, ?_, ?_⟩ + · simpa [Pbar, Tbar] using hf + · simpa [Pbar, Tbar, TileTranslationFormulas] using hc + +private theorem hPford : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (F' : FordFareyParameter), ∀ (gN : BandPackingSymmetry), ∀ (Pp : Fin + (3 : ℕ) → Bool → ProtoTile), + let Tn := BandPackingSymmetryTileAction gN T + let Pn : Fin 3 → Bool → ProtoTile := Pp + ∀ (w : GaussianInt), + let Pbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Pn i s) (-w) + let Tbar : ProtoTile := TileTranslation Tn (-w) + (FootprintVertices Tbar = FootprintVertices (FordTile F'.q) ∧ BoundaryFootprintVertices + Tbar = BoundaryFootprintVertices (FordTile F'.q) ∧ BoundaryFootprintEdges Tbar = + BoundaryFootprintEdges (FordTile F'.q) ∧ TileRealization Tbar = TileRealization + (FordTile F'.q) ∧ TileCentroid Tbar = TileCentroid (FordTile F'.q)) → ((∀ i, ∀ s, + BandSubtileOccurrence (FordRecursiveQuadruple F') Tbar i s (Pbar i s)) → (∀ i, ∀ s, + BandSubtileOccurrence (FordRecursiveQuadruple F') (FordTile F'.q) i s (Pbar i s))) ) + := by + classical + intro T F' gN Pp Tn Pn w Pbar Tbar hobs hPbar i s + rcases hPbar i s with ⟨hb, hf, hc⟩ + refine ⟨hb, ?_, ?_⟩ + · simpa [hobs.1] using hf + · simpa [hobs.2.2.2.2] using hc + +private theorem hQbar : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gN : + BandPackingSymmetry), ∀ (Pp : Fin (3 : ℕ) → Bool → ProtoTile), (∀ i, ∀ s, Pp i s = + BandPackingSymmetryTileAction gN (P i s)) → (∀ (Qp : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence + (BandPackingSymmetryQuadrupleAction gN r) (BandPackingSymmetryTileAction gN (P (0 : + Fin (3 : ℕ)) true)) i s (Qp i s)) → ( + let rN := BandPackingSymmetryQuadrupleAction gN r + let Pn : Fin 3 → Bool → ProtoTile := Pp + let Qn : Fin 3 → Bool → ProtoTile := Qp + ∀ (w : GaussianInt), + let Pbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Pn i s) (-w) + let Qbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Qn i s) (-w) + ∀ i, ∀ s, BandSubtileOccurrence rN (Pbar 0 true) i s (Qbar i s))) ) := by + classical + intro r P gN Pp hPp Qp hqocc rN Pn Qn w Pbar Qbar i s + have ho := (BandSubtileOccurrenceTranslation rN (Pn 0 true) (Qn i s) i s (-w)).mp + (by simpa [rN, Pn, Qn, hPp 0 true] using hqocc i s) + simpa [Pbar, Qbar] using ho + +private theorem hSbar : + (by + classical + exact + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gN : + BandPackingSymmetry), ∀ (Pp : Fin (3 : ℕ) → Bool → ProtoTile), (∀ i, ∀ s, Pp i s = + BandPackingSymmetryTileAction gN (P i s)) → (∀ (Sp : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence + (BandPackingSymmetryQuadrupleAction gN r) (BandPackingSymmetryTileAction gN (P (0 : + Fin (3 : ℕ)) false)) i s (Sp i s)) → ( + let rN := BandPackingSymmetryQuadrupleAction gN r + let Pn : Fin 3 → Bool → ProtoTile := Pp + let Sn : Fin 3 → Bool → ProtoTile := Sp + ∀ (w : GaussianInt), + let Pbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Pn i s) (-w) + let Sbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Sn i s) (-w) + ∀ i, ∀ s, BandSubtileOccurrence rN (Pbar 0 false) i s (Sbar i s))) ) := by + classical + intro r P gN Pp hPp Sp hsocc rN Pn Sn w Pbar Sbar i s + have ho := (BandSubtileOccurrenceTranslation rN (Pn 0 false) (Sn i s) i s (-w)).mp + (by simpa [rN, Pn, Sn, hPp 0 false] using hsocc i s) + simpa [Pbar, Sbar] using ho + +private theorem hq0 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (h : BandPackingSymmetry), ∀ (F' : + FordFareyParameter), (BandPackingSymmetryReversesOrientation h = false) → (∀ (gN : + BandPackingSymmetry), (BandPackingSymmetryReversesOrientation gN = + BandPackingSymmetryReversesOrientation h) → ((BandPackingSymmetryQuadrupleAction gN q + = FordRecursiveQuadruple F') → (BandPackingSymmetryCircleAction gN (q 0) = + (FordRecursiveQuadruple F') 0))) ) := by + classical + intro q h F' hrev gN horientationAdapt hqhat + simpa [BandPackingSymmetryQuadrupleAction, horientationAdapt, hrev] using + congrFun hqhat 0 + +private theorem hq1At383 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (h : BandPackingSymmetry), ∀ (F' : + FordFareyParameter), (BandPackingSymmetryReversesOrientation h = false) → (∀ (gN : + BandPackingSymmetry), (BandPackingSymmetryReversesOrientation gN = + BandPackingSymmetryReversesOrientation h) → ((BandPackingSymmetryQuadrupleAction gN q + = FordRecursiveQuadruple F') → (BandPackingSymmetryCircleAction gN (q 1) = + (FordRecursiveQuadruple F') 1))) ) := by + classical + intro q h F' hrev gN horientationAdapt hqhat + simpa [BandPackingSymmetryQuadrupleAction, horientationAdapt, hrev] using + congrFun hqhat 1 + +private theorem hq2At387 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (h : BandPackingSymmetry), ∀ (F' : + FordFareyParameter), (BandPackingSymmetryReversesOrientation h = false) → (∀ (gN : + BandPackingSymmetry), (BandPackingSymmetryReversesOrientation gN = + BandPackingSymmetryReversesOrientation h) → ((BandPackingSymmetryQuadrupleAction gN q + = FordRecursiveQuadruple F') → (BandPackingSymmetryCircleAction gN (q 2) = + (FordRecursiveQuadruple F') 2))) ) := by + classical + intro q h F' hrev gN horientationAdapt hqhat + simpa [BandPackingSymmetryQuadrupleAction, horientationAdapt, hrev] using + congrFun hqhat 2 + +private theorem huN : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let hclaim : GaussianInt := BandVectors.1 (q 0) (q 1) + ∀ (h : BandPackingSymmetry), + ∀ (F' : FordFareyParameter), (BandPackingSymmetryReversesOrientation h = false) → (∀ + (gN : BandPackingSymmetry), (BandPackingSymmetryReversesOrientation gN = + BandPackingSymmetryReversesOrientation h) → ((BandPackingSymmetryScopedPhase gN q + false) → ( + let uN := BandVectors.1 ((FordRecursiveQuadruple F') 0) + ((FordRecursiveQuadruple F') 1) + (BandPackingSymmetryCircleAction gN (q 0) = (FordRecursiveQuadruple F') 0) → + ((BandPackingSymmetryCircleAction gN (q 1) = (FordRecursiveQuadruple F') 1) → (uN = + BandPackingSymmetryVectorAction gN hclaim))))) ) := by + classical + intro q hclaim h F' hrev gN horientationAdapt hqphase uN hq0 hq1 + have hh := (hqphase 0).2.1 + simpa [uN, hclaim, BandPackingSymmetryScopedPhase, BandPackingSymmetryQuadrupleAction, + horientationAdapt, hrev, hq0, hq1] using hh + +private theorem hvN : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (h : BandPackingSymmetry), ∀ (F' : + FordFareyParameter), (BandPackingSymmetryReversesOrientation h = false) → (∀ (gN : + BandPackingSymmetry), (BandPackingSymmetryReversesOrientation gN = + BandPackingSymmetryReversesOrientation h) → ((BandPackingSymmetryScopedPhase gN q + false) → ( + let v0 := BandVectors.1 (q 0) (q 2) + let vN := BandVectors.1 ((FordRecursiveQuadruple F') 0) + ((FordRecursiveQuadruple F') 2) + (BandPackingSymmetryCircleAction gN (q 0) = (FordRecursiveQuadruple F') 0) → + ((BandPackingSymmetryCircleAction gN (q 2) = (FordRecursiveQuadruple F') 2) → (vN = + BandPackingSymmetryVectorAction gN v0))))) ) := by + classical + intro q h F' hrev gN horientationAdapt hqphase v0 vN hq0 hq2 + have hh := (hqphase 1).2.1 + simpa [vN, v0, BandPackingSymmetryScopedPhase, BandPackingSymmetryQuadrupleAction, + horientationAdapt, hrev, hq0, hq2] using hh + +private theorem L_injective_all : + (by + classical + exact + ∀ z : BandPackingSymmetry, Function.Injective (BandPackingSymmetryVectorAction z) ) := by + classical + intro z + induction z with + | identity => intro x y hxy; exact hxy + | shift w => intro x y hxy; exact hxy + | negate => + intro x y hxy + apply Zsqrtd.ext + · have hh := congrArg (fun z : GaussianInt => z.im) hxy + simpa [BandPackingSymmetryVectorAction, GaussianQuarterTurn] using hh + · have hh := congrArg (fun z : GaussianInt => z.re) hxy + have hh' : -x.im = -y.im := by + simpa [BandPackingSymmetryVectorAction, GaussianQuarterTurn] using hh + exact neg_injective hh' + | conjugate => + intro x y hxy + apply Zsqrtd.ext + · have hh := congrArg (fun z : GaussianInt => z.re) hxy + have hh' : -x.re = -y.re := by + simpa [BandPackingSymmetryVectorAction, GaussianReflection] using hh + exact neg_injective hh' + · have hh := congrArg (fun z : GaussianInt => z.im) hxy + simpa [BandPackingSymmetryVectorAction, GaussianReflection] using hh + | comp g k ihg ihk => exact ihg.comp ihk + +private theorem f_injective : + (by + classical + exact + ∀ (gN : BandPackingSymmetry), ∀ (w : GaussianInt), (Function.Injective + (BandPackingSymmetryVectorAction gN)) → ( + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation (-w) (BandPackingSymmetryVectorAction gN z) + Function.Injective f) ) := by + classical + intro gN w L_injective f x y hxy + apply L_injective + apply add_right_cancel + change BandPackingSymmetryVectorAction gN x + (-w) = + BandPackingSymmetryVectorAction gN y + (-w) at hxy + exact hxy + +private theorem hfv : + (by + classical + exact + ∀ (gN : BandPackingSymmetry), ∀ (w : GaussianInt), + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation (-w) (BandPackingSymmetryVectorAction gN z) + (∀ (T : ProtoTile), FootprintVertices (BandPackingSymmetryTileAction gN T) = + BandPackingSymmetryVectorAction gN '' FootprintVertices T) → (∀ (X : ProtoTile), + FootprintVertices (TileTranslation (BandPackingSymmetryTileAction gN X) (-w)) = f '' + FootprintVertices X) ) := by + classical + intro gN w f hvertices X + rw [(TileTranslationFormulas (BandPackingSymmetryTileAction gN X) (-w)).2.2.2.2.2.1, + hvertices X] + simp only [Set.image_image] + rfl + +private theorem hfe : + (by + classical + exact + ∀ (gN : BandPackingSymmetry), ∀ (w : GaussianInt), + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation (-w) (BandPackingSymmetryVectorAction gN z) + (∀ (T : ProtoTile), FootprintEdges (BandPackingSymmetryTileAction gN T) = (fun (e : + Finset GaussianInt) => Finset.image (BandPackingSymmetryVectorAction gN) e) '' + FootprintEdges T) → (∀ (X : ProtoTile), FootprintEdges (TileTranslation + (BandPackingSymmetryTileAction gN X) (-w)) = (fun e : Finset GaussianInt => e.image + f) '' FootprintEdges X) ) := by + classical + intro gN w f hedges X + rw [(TileTranslationFormulas (BandPackingSymmetryTileAction gN X) (-w)).2.2.2.2.2.2.1, + hedges X] + simp only [Set.image_image, Finset.image_image, Function.comp_def] + rfl + +private theorem hPfoot : + (by + classical + exact + ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gN : BandPackingSymmetry), ∀ (Pp : Fin (3 : ℕ) + → Bool → ProtoTile), (∀ i, ∀ s, Pp i s = BandPackingSymmetryTileAction gN (P i s)) → ( + let Pn : Fin 3 → Bool → ProtoTile := Pp + ∀ (w : GaussianInt), + let Pbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Pn i s) (-w) + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation (-w) (BandPackingSymmetryVectorAction gN z) + (∀ (X : ProtoTile), FootprintVertices (TileTranslation (BandPackingSymmetryTileAction gN + X) (-w)) = f '' FootprintVertices X) → (∀ (i : Fin 3), ∀ (s : Bool), + FootprintVertices (Pbar i s) = f '' FootprintVertices (P i s))) ) := by + classical + intro P gN Pp hPp Pn w Pbar f hfv i s + simpa [Pbar, Pn, hPp i s] using hfv (P i s) + +private theorem hQfoot : + (by + classical + exact + ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gN : BandPackingSymmetry), ∀ (Qp : Fin (3 : ℕ) + → Bool → ProtoTile), (∀ i, ∀ s, Qp i s = BandPackingSymmetryTileAction gN (Q i s)) → ( + let Qn : Fin 3 → Bool → ProtoTile := Qp + ∀ (w : GaussianInt), + let Qbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Qn i s) (-w) + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation (-w) (BandPackingSymmetryVectorAction gN z) + (∀ (X : ProtoTile), FootprintVertices (TileTranslation (BandPackingSymmetryTileAction gN + X) (-w)) = f '' FootprintVertices X) → (∀ (i : Fin 3), ∀ (s : Bool), + FootprintVertices (Qbar i s) = f '' FootprintVertices (Q i s))) ) := by + classical + intro Q gN Qp hQp Qn w Qbar f hfv i s + simpa [Qbar, Qn, hQp i s] using hfv (Q i s) + +private theorem hSfoot : + (by + classical + exact + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gN : BandPackingSymmetry), ∀ (Sp : Fin (3 : ℕ) + → Bool → ProtoTile), (∀ i, ∀ s, Sp i s = BandPackingSymmetryTileAction gN (S i s)) → ( + let Sn : Fin 3 → Bool → ProtoTile := Sp + ∀ (w : GaussianInt), + let Sbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Sn i s) (-w) + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation (-w) (BandPackingSymmetryVectorAction gN z) + (∀ (X : ProtoTile), FootprintVertices (TileTranslation (BandPackingSymmetryTileAction gN + X) (-w)) = f '' FootprintVertices X) → (∀ (i : Fin 3), ∀ (s : Bool), + FootprintVertices (Sbar i s) = f '' FootprintVertices (S i s))) ) := by + classical + intro S gN Sp hSp Sn w Sbar f hfv i s + simpa [Sbar, Sn, hSp i s] using hfv (S i s) + +private theorem hOccNorm : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hclaim : + GaussianInt), ∀ (F' : FordFareyParameter), ∀ (gN : BandPackingSymmetry), ∀ (Pp : Fin + (3 : ℕ) → Bool → ProtoTile), (∀ i, ∀ s, Pp i s = BandPackingSymmetryTileAction gN (P + i s)) → ( + let Pn : Fin 3 → Bool → ProtoTile := Pp + ∀ (w : GaussianInt), + let Pbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Pn i s) (-w) + let v0 := BandVectors.1 (q 0) (q 2) + let uN := BandVectors.1 ((FordRecursiveQuadruple F') 0) + ((FordRecursiveQuadruple F') 1) + let vN := BandVectors.1 ((FordRecursiveQuadruple F') 0) + ((FordRecursiveQuadruple F') 2) + (uN = BandPackingSymmetryVectorAction gN hclaim) → ((vN = BandPackingSymmetryVectorAction + gN v0) → ((∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), ∀ (o : PeriodicSubtileIndex), BandPackingSymmetryTileAction gN + (SubtileOccurrenceInterpretation S u v o) = SubtileOccurrenceInterpretation (fun (i : + Fin (3 : ℕ)) (s : Bool) => BandPackingSymmetryTileAction gN (S i s)) + (BandPackingSymmetryVectorAction gN u) (BandPackingSymmetryVectorAction gN v) o) → (∀ + (o : PeriodicSubtileIndex), SubtileOccurrenceInterpretation Pbar uN vN o = + TileTranslation (BandPackingSymmetryTileAction gN (SubtileOccurrenceInterpretation P + hclaim v0 o)) (-w))))) ) := by + classical + intro q P hclaim F' gN Pp hPp Pn w Pbar v0 uN vN huN hvN hocc o + have h := hocc P hclaim v0 o + rw [← huN, ← hvN] at h + have ht := (SubtileOccurrenceInterpretationCovariance Pn uN vN (-w) o).1 + have hfamily : (fun i s => BandPackingSymmetryTileAction gN (P i s)) = Pn := by + funext i s + exact (hPp i s).symm + have h' : BandPackingSymmetryTileAction gN + (SubtileOccurrenceInterpretation P hclaim v0 o) = + SubtileOccurrenceInterpretation Pn uN vN o := by + rw [hfamily] at h + exact h + calc + SubtileOccurrenceInterpretation Pbar uN vN o = + TileTranslation (SubtileOccurrenceInterpretation Pn uN vN o) (-w) := by + simpa [Pbar] using ht.symm + _ = TileTranslation (BandPackingSymmetryTileAction gN + (SubtileOccurrenceInterpretation P hclaim v0 o)) (-w) := + congrArg (fun X : ProtoTile => TileTranslation X (-w)) h'.symm + +private theorem hOccEdges : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hclaim : + GaussianInt), ∀ (F' : FordFareyParameter), ∀ (gN : BandPackingSymmetry), ∀ (Pp : Fin + (3 : ℕ) → Bool → ProtoTile), + let Pn : Fin 3 → Bool → ProtoTile := Pp + ∀ (w : GaussianInt), + let Pbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Pn i s) (-w) + let v0 := BandVectors.1 (q 0) (q 2) + let uN := BandVectors.1 ((FordRecursiveQuadruple F') 0) + ((FordRecursiveQuadruple F') 1) + let vN := BandVectors.1 ((FordRecursiveQuadruple F') 0) + ((FordRecursiveQuadruple F') 2) + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation (-w) (BandPackingSymmetryVectorAction gN z) + (∀ (X : ProtoTile), FootprintEdges (TileTranslation (BandPackingSymmetryTileAction gN X) + (-w)) = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges X) → ((∀ (o : + PeriodicSubtileIndex), SubtileOccurrenceInterpretation Pbar uN vN o = TileTranslation + (BandPackingSymmetryTileAction gN (SubtileOccurrenceInterpretation P hclaim v0 o)) + (-w)) → (∀ (o : PeriodicSubtileIndex), FootprintEdges + (SubtileOccurrenceInterpretation Pbar uN vN o) = (fun e : Finset GaussianInt => + e.image f) '' FootprintEdges (SubtileOccurrenceInterpretation P hclaim v0 o))) ) := by + classical + intro q P hclaim F' gN Pp Pn w Pbar v0 uN vN f hfe hOccNorm o + rw [hOccNorm] + exact hfe _ + +private theorem hOccVertices : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hclaim : + GaussianInt), ∀ (F' : FordFareyParameter), ∀ (gN : BandPackingSymmetry), ∀ (Pp : Fin + (3 : ℕ) → Bool → ProtoTile), + let Pn : Fin 3 → Bool → ProtoTile := Pp + ∀ (w : GaussianInt), + let Pbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Pn i s) (-w) + let v0 := BandVectors.1 (q 0) (q 2) + let uN := BandVectors.1 ((FordRecursiveQuadruple F') 0) + ((FordRecursiveQuadruple F') 1) + let vN := BandVectors.1 ((FordRecursiveQuadruple F') 0) + ((FordRecursiveQuadruple F') 2) + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation (-w) (BandPackingSymmetryVectorAction gN z) + (∀ (X : ProtoTile), FootprintVertices (TileTranslation (BandPackingSymmetryTileAction gN + X) (-w)) = f '' FootprintVertices X) → ((∀ (o : PeriodicSubtileIndex), + SubtileOccurrenceInterpretation Pbar uN vN o = TileTranslation + (BandPackingSymmetryTileAction gN (SubtileOccurrenceInterpretation P hclaim v0 o)) + (-w)) → (∀ (o : PeriodicSubtileIndex), FootprintVertices + (SubtileOccurrenceInterpretation Pbar uN vN o) = f '' FootprintVertices + (SubtileOccurrenceInterpretation P hclaim v0 o))) ) := by + classical + intro q P hclaim F' gN Pp Pn w Pbar v0 uN vN f hfv hOccNorm o + rw [hOccNorm] + exact hfv _ + +private theorem imageMem : + (by + classical + exact + ∀ (gN : BandPackingSymmetry), ∀ (w : GaussianInt), + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation (-w) (BandPackingSymmetryVectorAction gN z) + (Function.Injective f) → (∀ (A : Set GaussianInt), ∀ (B : Set GaussianInt), (B = f '' A) + → (∀ (x : GaussianInt), f x ∈ B ↔ x ∈ A)) ) := by + classical + intro gN w f f_injective A B hB x + rw [hB] + constructor + · rintro ⟨y, hy, hxy⟩ + have hEq : y = x := f_injective hxy + simpa [hEq] using hy + · intro hx + exact ⟨x, hx, rfl⟩ + +private theorem hperiodic : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hclaim : + GaussianInt), ∀ (F' : FordFareyParameter), ∀ (gN : BandPackingSymmetry), ∀ (Pp : Fin + (3 : ℕ) → Bool → ProtoTile), + let Pn : Fin 3 → Bool → ProtoTile := Pp + ∀ (w : GaussianInt), + let Pbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Pn i s) (-w) + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges + (SubtileOccurrenceInterpretation Pbar (BandVectors.1 (FordRecursiveQuadruple F' (0 : + Fin (4 : ℕ))) (FordRecursiveQuadruple F' (1 : Fin (4 : ℕ)))) (BandVectors.1 + (FordRecursiveQuadruple F' (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple F' (2 : Fin (4 + : ℕ)))) a) ∩ FootprintEdges (SubtileOccurrenceInterpretation Pbar (BandVectors.1 + (FordRecursiveQuadruple F' (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple F' (1 : Fin (4 + : ℕ)))) (BandVectors.1 (FordRecursiveQuadruple F' (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple F' (2 : Fin (4 : ℕ)))) b)).Nonempty → AllowedSubtileIncidence + a b) ∧ (¬AllowedSubtileIncidence a b → FootprintVertices + (SubtileOccurrenceInterpretation Pbar (BandVectors.1 (FordRecursiveQuadruple F' (0 : + Fin (4 : ℕ))) (FordRecursiveQuadruple F' (1 : Fin (4 : ℕ)))) (BandVectors.1 + (FordRecursiveQuadruple F' (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple F' (2 : Fin (4 + : ℕ)))) a) ∩ FootprintVertices (SubtileOccurrenceInterpretation Pbar (BandVectors.1 + (FordRecursiveQuadruple F' (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple F' (1 : Fin (4 + : ℕ)))) (BandVectors.1 (FordRecursiveQuadruple F' (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple F' (2 : Fin (4 : ℕ)))) b) = ∅ ∨ (FootprintVertices + (SubtileOccurrenceInterpretation Pbar (BandVectors.1 (FordRecursiveQuadruple F' (0 : + Fin (4 : ℕ))) (FordRecursiveQuadruple F' (1 : Fin (4 : ℕ)))) (BandVectors.1 + (FordRecursiveQuadruple F' (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple F' (2 : Fin (4 + : ℕ)))) a) ∩ FootprintVertices (SubtileOccurrenceInterpretation Pbar (BandVectors.1 + (FordRecursiveQuadruple F' (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple F' (1 : Fin (4 + : ℕ)))) (BandVectors.1 (FordRecursiveQuadruple F' (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple F' (2 : Fin (4 : ℕ)))) b)).Subsingleton)) → ( + let v0 := BandVectors.1 (q 0) (q 2) + let uN := BandVectors.1 ((FordRecursiveQuadruple F') 0) + ((FordRecursiveQuadruple F') 1) + let vN := BandVectors.1 ((FordRecursiveQuadruple F') 0) + ((FordRecursiveQuadruple F') 2) + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation (-w) (BandPackingSymmetryVectorAction gN z) + (Function.Injective f) → ((∀ (o : PeriodicSubtileIndex), FootprintEdges + (SubtileOccurrenceInterpretation Pbar uN vN o) = (fun e : Finset GaussianInt => + e.image f) '' FootprintEdges (SubtileOccurrenceInterpretation P hclaim v0 o)) → ((∀ + (o : PeriodicSubtileIndex), FootprintVertices (SubtileOccurrenceInterpretation Pbar + uN vN o) = f '' FootprintVertices (SubtileOccurrenceInterpretation P hclaim v0 o)) → + ((∀ a b : PeriodicSubtileIndex, a ≠ b → ((FootprintEdges + (SubtileOccurrenceInterpretation P hclaim v0 a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P hclaim v0 b)).Nonempty → AllowedSubtileIncidence a + b) ∧ (¬ AllowedSubtileIncidence a b → FootprintVertices + (SubtileOccurrenceInterpretation P hclaim v0 a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P hclaim v0 b) = ∅ ∨ (FootprintVertices + (SubtileOccurrenceInterpretation P hclaim v0 a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P hclaim v0 b)).Subsingleton)))))) ) := by + classical + intro q P hclaim F' gN Pp Pn w Pbar hledgerN v0 uN vN f f_injective hOccEdges hOccVertices a b hab + constructor + · intro hedgesAB + have hedgesN : + (FootprintEdges (SubtileOccurrenceInterpretation Pbar uN vN a) ∩ + FootprintEdges (SubtileOccurrenceInterpretation Pbar uN vN b)).Nonempty := by + rcases hedgesAB with ⟨e, hea, heb⟩ + refine ⟨e.image f, ?_, ?_⟩ + · rw [hOccEdges] + exact Set.mem_image_of_mem (fun e : Finset GaussianInt => e.image f) hea + · rw [hOccEdges] + exact Set.mem_image_of_mem (fun e : Finset GaussianInt => e.image f) heb + exact (hledgerN a b hab).1 hedgesN + · intro hnot + rcases (hledgerN a b hab).2 hnot with hempty | hsingle + · left + ext x + constructor + · intro hx + have hxN : f x ∈ + FootprintVertices (SubtileOccurrenceInterpretation Pbar uN vN a) ∩ + FootprintVertices (SubtileOccurrenceInterpretation Pbar uN vN b) := by + rw [hOccVertices a, hOccVertices b] + exact ⟨Set.mem_image_of_mem f hx.1, Set.mem_image_of_mem f hx.2⟩ + rw [hempty] at hxN + simp at hxN + · simp + · right + intro x hx y hy + have hxN : f x ∈ + FootprintVertices (SubtileOccurrenceInterpretation Pbar uN vN a) ∩ + FootprintVertices (SubtileOccurrenceInterpretation Pbar uN vN b) := by + rw [hOccVertices a, hOccVertices b] + exact ⟨Set.mem_image_of_mem f hx.1, Set.mem_image_of_mem f hx.2⟩ + have hyN : f y ∈ + FootprintVertices (SubtileOccurrenceInterpretation Pbar uN vN a) ∩ + FootprintVertices (SubtileOccurrenceInterpretation Pbar uN vN b) := by + rw [hOccVertices a, hOccVertices b] + exact ⟨Set.mem_image_of_mem f hy.1, Set.mem_image_of_mem f hy.2⟩ + exact f_injective (hsingle hxN hyN) + +private theorem hraw1 : + (by + classical + exact + ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gN : + BandPackingSymmetry), ∀ (Pp : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Qp : Fin (3 : ℕ) → + Bool → ProtoTile), + let Pn : Fin 3 → Bool → ProtoTile := Pp + let Qn : Fin 3 → Bool → ProtoTile := Qp + ∀ (w : GaussianInt), + let Pbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Pn i s) (-w) + let Qbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Qn i s) (-w) + (FootprintVertices (Pbar (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (Pbar (1 : Fin (3 : + ℕ)) true) ⊆ FootprintVertices (Qbar (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (Pbar + (1 : Fin (3 : ℕ)) true)) → ( + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation (-w) (BandPackingSymmetryVectorAction gN z) + (∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices (Pbar i s) = f '' FootprintVertices (P i + s)) → ((∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices (Qbar i s) = f '' + FootprintVertices (Q i s)) → ((∀ (A : Set GaussianInt), ∀ (B : Set GaussianInt), (B = + f '' A) → (∀ (x : GaussianInt), f x ∈ B ↔ x ∈ A)) → (FootprintVertices (P 0 true) ∩ + FootprintVertices (P 1 true) ⊆ FootprintVertices (Q 1 true) ∩ FootprintVertices (P 1 + true))))) ) := by + classical + intro P Q gN Pp Qp Pn Qn w Pbar Qbar hraw1N f hPfoot hQfoot imageMem x hx + have hxN : f x ∈ FootprintVertices (Pbar 0 true) ∩ + FootprintVertices (Pbar 1 true) := by + exact ⟨(imageMem _ _ (hPfoot 0 true) x).2 hx.1, + (imageMem _ _ (hPfoot 1 true) x).2 hx.2⟩ + have hout := hraw1N hxN + exact ⟨(imageMem _ _ (hQfoot 1 true) x).1 hout.1, + (imageMem _ _ (hPfoot 1 true) x).1 hout.2⟩ + +private theorem hraw2 : + (by + classical + exact + ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : + Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gN : BandPackingSymmetry), ∀ (Pp : Fin (3 : ℕ) → + Bool → ProtoTile), ∀ (Qp : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Sp : Fin (3 : ℕ) → + Bool → ProtoTile), + let Pn : Fin 3 → Bool → ProtoTile := Pp + let Qn : Fin 3 → Bool → ProtoTile := Qp + let Sn : Fin 3 → Bool → ProtoTile := Sp + ∀ (w : GaussianInt), + let Pbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Pn i s) (-w) + let Qbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Qn i s) (-w) + let Sbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Sn i s) (-w) + (FootprintVertices (Pbar (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (Pbar (0 : Fin (3 : + ℕ)) false) ⊆ FootprintVertices (Qbar (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices + (Sbar (2 : Fin (3 : ℕ)) false) ∪ FootprintVertices (Qbar (0 : Fin (3 : ℕ)) false) ∪ + FootprintVertices (Qbar (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (Sbar (1 : Fin (3 + : ℕ)) false)) → ( + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation (-w) (BandPackingSymmetryVectorAction gN z) + (∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices (Pbar i s) = f '' FootprintVertices (P i + s)) → ((∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices (Qbar i s) = f '' + FootprintVertices (Q i s)) → ((∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices (Sbar i + s) = f '' FootprintVertices (S i s)) → ((∀ (A : Set GaussianInt), ∀ (B : Set + GaussianInt), (B = f '' A) → (∀ (x : GaussianInt), f x ∈ B ↔ x ∈ A)) → + (FootprintVertices (P 0 true) ∩ FootprintVertices (P 0 false) ⊆ (FootprintVertices (Q + 1 true) ∩ FootprintVertices (S 2 false)) ∪ FootprintVertices (Q 0 false) ∪ + (FootprintVertices (Q 2 true) ∩ FootprintVertices (S 1 false))))))) ) := by + classical + intro P Q S gN Pp Qp Sp Pn Qn Sn w Pbar Qbar Sbar hraw2N f hPfoot hQfoot hSfoot imageMem x hx + have hxN : f x ∈ FootprintVertices (Pbar 0 true) ∩ + FootprintVertices (Pbar 0 false) := by + exact ⟨(imageMem _ _ (hPfoot 0 true) x).2 hx.1, + (imageMem _ _ (hPfoot 0 false) x).2 hx.2⟩ + have hout := hraw2N hxN + have hA : f x ∈ FootprintVertices (Qbar 1 true) ∩ + FootprintVertices (Sbar 2 false) ↔ + x ∈ FootprintVertices (Q 1 true) ∩ FootprintVertices (S 2 false) := by + simp only [Set.mem_inter_iff] + exact and_congr (imageMem _ _ (hQfoot 1 true) x) + (imageMem _ _ (hSfoot 2 false) x) + have hB : f x ∈ FootprintVertices (Qbar 0 false) ↔ + x ∈ FootprintVertices (Q 0 false) := imageMem _ _ (hQfoot 0 false) x + have hC : f x ∈ FootprintVertices (Qbar 2 true) ∩ + FootprintVertices (Sbar 1 false) ↔ + x ∈ FootprintVertices (Q 2 true) ∩ FootprintVertices (S 1 false) := by + simp only [Set.mem_inter_iff] + exact and_congr (imageMem _ _ (hQfoot 2 true) x) + (imageMem _ _ (hSfoot 1 false) x) + simp only [Set.mem_union, Set.mem_inter_iff, hA, hB, hC] at hout ⊢ + exact hout + +end FordT6Geometry + +theorem P4564T2FordT6Transport : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (T : ProtoTile), + (BandPrototile (q 0) T) → (∀ (a : Fin 3), ∀ (g : BandPackingSymmetry), ∀ (F : + FordFareyParameter), (1 < F.q) → ((BandPackingSymmetryQuadrupleAction g + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] = FordRecursiveQuadruple F) → ((∀ (r : Fin + 4 → CircleCoordinates), ProperBandQuadruple r → + r 0 = q 1 → r 2 = q 2 → r 3 = q 3 → + (q 2).1 ≤ (q 1).1 → (q 3).1 ≤ (q 2).1 → + 1 < (q 2).1 → + ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (Q : Fin 3 → Bool → ProtoTile), ∀ (S : Fin 3 → Bool → + ProtoTile), (∀ i, ∀ s, BandSubtileOccurrence q T i s (P i s)) → + (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (P i s).cells) → + (∀ i, ∀ s, BandSubtileOccurrence r (P 0 true) i s (Q i s)) → + (∀ x, x ∈ (P 0 true).cells ↔ ∃ i s, x ∈ (Q i s).cells) → + (∀ i, ∀ s, BandSubtileOccurrence r (P 0 false) i s (S i s)) → + (∀ x, x ∈ (P 0 false).cells ↔ ∃ i s, x ∈ (S i s).cells) → + ( + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + (∀ a b : PeriodicSubtileIndex, a ≠ b → + ((FootprintEdges (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty → + AllowedSubtileIncidence a b) ∧ + (¬ AllowedSubtileIncidence a b → + FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ + FootprintVertices (P 0 true) ∩ FootprintVertices (P 1 true) ⊆ + FootprintVertices (Q 1 true) ∩ FootprintVertices (P 1 true) ∧ + FootprintVertices (P 0 true) ∩ FootprintVertices (P 0 false) ⊆ + (FootprintVertices (Q 1 true) ∩ FootprintVertices (S 2 false)) ∪ + FootprintVertices (Q 0 false) ∪ + (FootprintVertices (Q 2 true) ∩ + FootprintVertices (S 1 false)))))))) := by + intro q hq T hT a g F hF hnormal r hr hr0 hr2 hr3 h12 h23 hlarge + P Q S hP hcells hQ hQcells hS hScells hclaim + have qcur := ProperBandCurvatureStructure q hq + have hlineq := FordT6Geometry.hlineq q hq a g F hnormal h12 hlarge qcur + obtain ⟨b, h, F', hF', hrev, hword, hzero, hnorm⟩ := + FordRegimeConverse q hq hlineq + have hb := FordT6Geometry.hb q F h12 hlarge qcur hlineq b h F' hzero hnorm + subst b + have hnormq := FordT6Geometry.hnormq q h F' hnorm + obtain ⟨negative, hphase, hphaseR, hphaseT, hcircle, horientation, + hquad, hvector, ⟨gN, hwordAdapt, hcircleAdapt, horientationAdapt, hquadAdapt, + hphaseAdaptQ, hphaseAdaptRest⟩⟩ := + BandPackingSymmetryProjectiveVectorCovariance h q hq + have hqphase : BandPackingSymmetryScopedPhase gN q false := hphaseAdaptQ + rcases hphaseAdaptRest with ⟨hphaseAdaptR, _⟩ + have hrphase : BandPackingSymmetryScopedPhase gN r false := + hphaseAdaptR r hr hr0 hr2 hr3 + have hqhat : BandPackingSymmetryQuadrupleAction gN q = FordRecursiveQuadruple F' := + FordT6Geometry.hqhat q h F' hnormq gN hquadAdapt + have hrproper : ProperBandQuadruple (BandPackingSymmetryQuadrupleAction gN r) := + BandPackingSymmetryProperCovariance gN r hr + have hr0hat : (BandPackingSymmetryQuadrupleAction gN r) 0 = + (FordRecursiveQuadruple F') 1 := FordT6Geometry.hr0hat q r hr0 h F' gN horientationAdapt hqhat + have hr2hat : (BandPackingSymmetryQuadrupleAction gN r) 2 = + (FordRecursiveQuadruple F') 2 := FordT6Geometry.hr2hat q r hr2 h F' hrev gN + horientationAdapt hqhat + have hr3hat : (BandPackingSymmetryQuadrupleAction gN r) 3 = + (FordRecursiveQuadruple F') 3 := FordT6Geometry.hr3hat q r hr3 h F' hrev gN + horientationAdapt hqhat + have horder : ((FordRecursiveQuadruple F') 2).1 ≤ + ((FordRecursiveQuadruple F') 1).1 := FordT6Geometry.horder q r hr0 hr2 h12 h F' hrev gN + horientationAdapt hr0hat hr2hat + have hlarge' : 1 < ((FordRecursiveQuadruple F') 2).1 := FordT6Geometry.hlarge' q r hr2 hlarge h + F' hrev gN horientationAdapt hr2hat + have hT' : BandPrototile ((BandPackingSymmetryQuadrupleAction gN q) 0) + (BandPackingSymmetryTileAction gN T) := FordT6Geometry.hT' q T hT gN + have covP := (BandPackingSymmetryCovariance gN).2.2 q T P hq hT hP hcells + rcases covP with ⟨dp, ep, Pp, hpphase, hpe, hpmem, hpp, hpcells⟩ + have hdp : dp = false := + BandPackingSymmetryScopedPhaseUnique gN q hq dp false hpphase hqphase + have hep (i : Fin 3) (s : Bool) := FordT6Geometry.hep h hrev gN horientationAdapt dp ep hpe hdp + i s + have hPp := FordT6Geometry.hPp P gN ep Pp hpmem hep + have hP0plus : BandPrototile (r 0) (P 0 true) := by + simpa [hr0] using (hP 0 true).1 + have hP0minus : BandPrototile (r 0) (P 0 false) := by + simpa [hr0] using (hP 0 false).1 + have hQcov := (BandPackingSymmetryCovariance gN).2.2 r (P 0 true) Q hr + hP0plus (fun i s => hQ i s) hQcells + have hScov := (BandPackingSymmetryCovariance gN).2.2 r (P 0 false) S hr + hP0minus (fun i s => hS i s) hScells + rcases hQcov with ⟨dq, eq, Qp, hqphase', hqe, hqmem, hqocc, hqcells'⟩ + rcases hScov with ⟨ds, es, Sp, hsphase', hse, hsmem, hsocc, hscells'⟩ + have hdq : dq = false := + BandPackingSymmetryScopedPhaseUnique gN r hr dq false hqphase' hrphase + have hds : ds = false := + BandPackingSymmetryScopedPhaseUnique gN r hr ds false hsphase' hrphase + have heq (i : Fin 3) (s : Bool) := FordT6Geometry.heq h hrev gN horientationAdapt dq eq hqe hdq + i s + have hes (i : Fin 3) (s : Bool) := FordT6Geometry.hes h hrev gN horientationAdapt ds es hse hds + i s + have hQp := FordT6Geometry.hQp Q gN eq Qp hqmem heq + have hSp := FordT6Geometry.hSp S gN es Sp hsmem hes + let rN := BandPackingSymmetryQuadrupleAction gN r + let Tn := BandPackingSymmetryTileAction gN T + let Pn : Fin 3 → Bool → ProtoTile := Pp + let Qn : Fin 3 → Bool → ProtoTile := Qp + let Sn : Fin 3 → Bool → ProtoTile := Sp + have hFord := FordT6Geometry.hFord F' + have hTn : BandPrototile ((FordRecursiveQuadruple F') 0) Tn := by + simpa [Tn, hqhat] using hT' + obtain ⟨w, hcellsNormal, hemptyNormal⟩ := + BandPrototileTranslationNormalForm _ Tn (FordTile F'.q) hTn hFord + let Pbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Pn i s) (-w) + let Qbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Qn i s) (-w) + let Sbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Sn i s) (-w) + let Tbar : ProtoTile := TileTranslation Tn (-w) + have cancelTranslation (U : ProtoTile) := FordT6Geometry.cancelTranslation w U + have hrootCells := FordT6Geometry.hrootCells T F' gN w hcellsNormal cancelTranslation + have hrootAnchor := FordT6Geometry.hrootAnchor T F' gN w hemptyNormal + have hobs := ProtoTileObservableExtensionality Tbar (FordTile F'.q) + hrootCells hrootAnchor + have hPbar := FordT6Geometry.hPbar q T F' gN hqhat Pp hpp w + have hPford : ∀ i s, + BandSubtileOccurrence (FordRecursiveQuadruple F') (FordTile F'.q) i s (Pbar i s) := + FordT6Geometry.hPford T F' gN Pp w hobs hPbar + have hQbar : ∀ i s, BandSubtileOccurrence rN (Pbar 0 true) i s (Qbar i s) := + FordT6Geometry.hQbar r P gN Pp hPp Qp hqocc w + have hSbar : ∀ i s, BandSubtileOccurrence rN (Pbar 0 false) i s (Sbar i s) := + FordT6Geometry.hSbar r P gN Pp hPp Sp hsocc w + have hFordBase := FordBaseT6 F' hF' rN hrproper (by simpa [rN] using hr0hat) + (by simpa [rN] using hr2hat) (by simpa [rN] using hr3hat) + horder hlarge' Pbar Qbar Sbar hPford hQbar hSbar + rcases hFordBase with ⟨hledgerN, hraw1N, hraw2N⟩ + let v0 := BandVectors.1 (q 0) (q 2) + let uN := BandVectors.1 ((FordRecursiveQuadruple F') 0) + ((FordRecursiveQuadruple F') 1) + let vN := BandVectors.1 ((FordRecursiveQuadruple F') 0) + ((FordRecursiveQuadruple F') 2) + have hq0 := FordT6Geometry.hq0 q h F' hrev gN horientationAdapt hqhat + have hq1 := FordT6Geometry.hq1At383 q h F' hrev gN horientationAdapt hqhat + have hq2 := FordT6Geometry.hq2At387 q h F' hrev gN horientationAdapt hqhat + have huN := FordT6Geometry.huN q h F' hrev gN horientationAdapt hqphase hq0 hq1 + have hvN := FordT6Geometry.hvN q h F' hrev gN horientationAdapt hqphase hq0 hq2 + have L_injective_all := FordT6Geometry.L_injective_all + have L_injective := L_injective_all gN + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation (-w) (BandPackingSymmetryVectorAction gN z) + have f_injective := FordT6Geometry.f_injective gN w L_injective + obtain ⟨_, _, _, _, _, _, _, hvertices, hedges, _, hocc⟩ := + BandPackingSymmetryTilingTransport gN + have hfv (X : ProtoTile) := FordT6Geometry.hfv gN w hvertices X + have hfe (X : ProtoTile) := FordT6Geometry.hfe gN w hedges X + have hPfoot (i : Fin 3) (s : Bool) := FordT6Geometry.hPfoot P gN Pp hPp w hfv i s + have hQfoot (i : Fin 3) (s : Bool) := FordT6Geometry.hQfoot Q gN Qp hQp w hfv i s + have hSfoot (i : Fin 3) (s : Bool) := FordT6Geometry.hSfoot S gN Sp hSp w hfv i s + have hOccNorm (o : PeriodicSubtileIndex) := FordT6Geometry.hOccNorm q P hclaim F' gN Pp hPp w + huN hvN hocc o + have hOccEdges (o : PeriodicSubtileIndex) := FordT6Geometry.hOccEdges q P hclaim F' gN Pp w hfe + hOccNorm o + have hOccVertices (o : PeriodicSubtileIndex) := FordT6Geometry.hOccVertices q P hclaim F' gN Pp + w hfv hOccNorm o + have imageMem (A B : Set GaussianInt) (hB : B = f '' A) (x : GaussianInt) := + FordT6Geometry.imageMem gN w f_injective A B hB x + have hperiodic := FordT6Geometry.hperiodic q P hclaim F' gN Pp w hledgerN f_injective hOccEdges + hOccVertices + have hraw1 := FordT6Geometry.hraw1 P Q gN Pp Qp w hraw1N hPfoot hQfoot imageMem + have hraw2 := FordT6Geometry.hraw2 P Q S gN Pp Qp Sp w hraw2N hPfoot hQfoot hSfoot imageMem + dsimp + exact ⟨hperiodic, hraw1, hraw2⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean b/LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean new file mode 100644 index 0000000000..b9973febdd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean @@ -0,0 +1,623 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRawSupport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.P4055T1PackingGridEquivalence + +-- [TABLET NODE: P4564T2GeneralT6Transport] + +/-! +# P4564T2GeneralT6Transport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace GeneralT6Geometry + +private theorem normalized23 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (a : Fin 3), ∀ (g : BandPackingSymmetry), + (BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g ![q 0, q + a.succ, q (a + 1).succ, q (a + 2).succ])) → (((BandPackingSymmetryQuadrupleAction g + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ]) 3).1 < + ((BandPackingSymmetryQuadrupleAction g ![q 0, q a.succ, q (a + 1).succ, q (a + + 2).succ]) 2).1) ) := by + classical + intro q a g cfg + have hs := cfg.secondProper.2 0 + change (cfg.secondPredecessor 1).1 < (cfg.secondPredecessor 0).1 at hs + simpa only [cfg.secondChild, cfg.secondParentOne] using hs + +private theorem order_forces : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (a : Fin 3), ∀ (g : + BandPackingSymmetry), (BandPackingSymmetryScopedPhase g ![q (0 : Fin (4 : ℕ)), q + a.succ, q (a + (1 : Fin (3 : ℕ))).succ, q (a + (2 : Fin (3 : ℕ))).succ] false) → ((∀ + (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = + ![q (0 : Fin (4 : ℕ)), q a.succ, q (a + (1 : Fin (3 : ℕ))).succ, q (a + (2 : Fin (3 : + ℕ))).succ] (1 : Fin (Nat.succ (3 : ℕ))) → r (2 : Fin (4 : ℕ)) = ![q (0 : Fin (4 : + ℕ)), q a.succ, q (a + (1 : Fin (3 : ℕ))).succ, q (a + (2 : Fin (3 : ℕ))).succ] (2 : + Fin (Nat.succ (3 : ℕ))) → r (3 : Fin (4 : ℕ)) = ![q (0 : Fin (4 : ℕ)), q a.succ, q (a + + (1 : Fin (3 : ℕ))).succ, q (a + (2 : Fin (3 : ℕ))).succ] (3 : Fin (Nat.succ (3 : + ℕ))) → BandPackingSymmetryScopedPhase g r false) → (∀ (cfg : + BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g ![q 0, q + a.succ, q (a + 1).succ, q (a + 2).succ])), ∀ (C : BandCircle), + (BandOrderedGeneralLayoutCertificate (BandPackingSymmetryQuadrupleAction g ![q 0, q + a.succ, q (a + 1).succ, q (a + 2).succ]) cfg C (BandPackingSymmetryTileAction g T)) → + (((q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1) → (((q (3 : Fin (4 : ℕ))).1 ≤ (q + (2 : Fin (4 : ℕ))).1) → ((∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction + g C).1 = C.1) → (((BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q + a.succ, q (a + (1 : Fin (3 : ℕ))).succ, q (a + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : + ℕ))).1 < (BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q a.succ, q (a + + (1 : Fin (3 : ℕ))).succ, q (a + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))).1) → + ((((BandPackingSymmetryQuadrupleAction g ![q 0, q a.succ, q (a + 1).succ, q (a + + 2).succ]) 3).1 < ((BandPackingSymmetryQuadrupleAction g ![q 0, q a.succ, q (a + + 1).succ, q (a + 2).succ]) 2).1) → (a = 0 ∧ BandPackingSymmetryReversesOrientation g = + false)))))))) ) := by + classical + intro q T a g hphase hpredecessor cfg C cert h12 h23 curvature normalized12 normalized23 + cases hg : BandPackingSymmetryReversesOrientation g <;> fin_cases a <;> + simp [BandPackingSymmetryQuadrupleAction, hg, curvature] at normalized12 normalized23 ⊢ <;> + omega + +private theorem hrotate : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (![q 0, q (0 : Fin 3).succ, q (0 + 1 : Fin 3).succ, q + (0 + 2 : Fin 3).succ] : Fin 4 → CircleCoordinates) = q ) := by + classical + intro q + funext i + fin_cases i <;> rfl + +private theorem action : + (by + classical + exact + ∀ (g : BandPackingSymmetry), (BandPackingSymmetryReversesOrientation g = false) → (∀ (p : + Fin 4 → CircleCoordinates), ∀ (i : Fin 4), BandPackingSymmetryQuadrupleAction g p i = + BandPackingSymmetryCircleAction g (p i)) ) := by + classical + intro g hg p i + fin_cases i <;> simp [BandPackingSymmetryQuadrupleAction, hg] + +private theorem transport : + (by + classical + exact + ∀ (g : BandPackingSymmetry), (BandPackingSymmetryReversesOrientation g = false) → (∀ (p : + Fin 4 → CircleCoordinates), ∀ (X : ProtoTile), ∀ (F : Fin 3 → Bool → ProtoTile), + (ProperBandQuadruple p) → ((BandPrototile (p 0) X) → ((∀ i, ∀ s, + BandSubtileOccurrence p X i s (F i s)) → ((∀ x, x ∈ X.cells ↔ ∃ i s, x ∈ (F i + s).cells) → ((BandPackingSymmetryScopedPhase g p false) → (∀ i, ∀ s, + BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction g p) + (BandPackingSymmetryTileAction g X) i s (BandPackingSymmetryTileAction g (F i + s)))))))) ) := by + classical + intro g hg p X F hp hX hF hFu hph + obtain ⟨d, e, F', hd, he, hF', ho, hu⟩ := + (BandPackingSymmetryCovariance g).2.2 p X F hp hX hF hFu + have hd0 := BandPackingSymmetryScopedPhaseUnique g p hp d false hd hph + subst d + have heq (i : Fin 3) (s : Bool) : e (i, s) = (i, s) := by + simpa [hg] using he i s + intro i s + have hid : F' i s = BandPackingSymmetryTileAction g (F i s) := by + simpa only [heq] using hF' i s + simpa only [hid] using ho i s + +private theorem predecessor : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (g : BandPackingSymmetry), ∀ (r : Fin (4 : ℕ) → + CircleCoordinates), (ProperBandQuadruple r) → ((r (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : + ℕ))) → ((r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ))) → ((r (3 : Fin (4 : ℕ)) = q (3 : + Fin (4 : ℕ))) → (((BandPackingSymmetryQuadrupleAction g q (3 : Fin (4 : ℕ))).1 < + (BandPackingSymmetryQuadrupleAction g q (2 : Fin (4 : ℕ))).1) → (∀ (cfg : + BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g q)), (∀ (p : + Fin 4 → CircleCoordinates), ∀ (i : + Fin 4), BandPackingSymmetryQuadrupleAction g p i = BandPackingSymmetryCircleAction g + (p i)) → (BandPackingSymmetryQuadrupleAction g r = cfg.firstPredecessor)))))) ) := by + classical + intro q g r hr hr0 hr2 hr3 normalized23 cfg action + have child : BandPackingSymmetryQuadrupleAction g r 0 = cfg.firstPredecessor 0 := by + rw [action, hr0, cfg.firstChild, action] + obtain ⟨k, hk, _⟩ := BandPredecessorNoCollision + (BandPackingSymmetryQuadrupleAction g r) cfg.firstPredecessor + (BandPackingSymmetryProperCovariance g r hr) cfg.firstProper child + have hk0 : k = 0 := by + fin_cases k + · rfl + · have he := hk 1 + change cfg.firstPredecessor 2 = BandPackingSymmetryQuadrupleAction g r 3 at he + rw [cfg.firstParentTwo, action r 3, hr3, ← action q 3] at he + have hc := congrArg Prod.fst he + omega + · have he := hk 2 + change cfg.firstPredecessor 3 = BandPackingSymmetryQuadrupleAction g r 2 at he + rw [cfg.firstParentThree, action r 2, hr2, ← action q 2] at he + have hc := congrArg Prod.fst he + omega + subst k + funext i + fin_cases i + · exact child + · exact (hk 0).symm + · exact (hk 1).symm + · exact (hk 2).symm + +private theorem compare : + (by + classical + exact + ∀ (p : Fin 4 → CircleCoordinates), ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (U : + ProtoTile), ∀ (V : ProtoTile), ∀ (i : Fin 3), ∀ (s : Bool), (BandSubtileOccurrence p + X i s U) → ((BandSubtileOccurrence p Y i s V) → ((TileCentroid X = TileCentroid Y) → + (U.cells = V.cells ∧ (U.cells = ∅ → U.anchor = V.anchor) ∧ FootprintVertices U = + FootprintVertices V ∧ TileCentroid U = TileCentroid V))) ) := by + classical + intro p X Y U V i s hU hV hXY + have hc : TileCentroid U = TileCentroid V := by + have hu := hU.2.2 + rw [hXY] at hu + exact sub_left_injective (hu.trans hV.2.2.symm) + obtain ⟨hcell, hanchor⟩ := BandPrototileCentroidUnique (p i.succ) U V hU.1 hV.1 hc + exact ⟨hcell, hanchor, (ProtoTileObservableExtensionality U V hcell hanchor).1, hc⟩ + +private theorem translated : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (w : GaussianInt), (X.cells = Y.cells) → + ((FootprintVertices X = FootprintVertices Y) → (FootprintVertices (TileTranslation X + w) = FootprintVertices (TileTranslation Y w) ∧ FootprintEdges (TileTranslation X w) = + FootprintEdges (TileTranslation Y w))) ) := by + classical + intro X Y w hc hv + have he : FootprintEdges X = FootprintEdges Y := by + unfold FootprintEdges + rw [hc] + exact ⟨by rw [(TileTranslationFormulas X w).2.2.2.2.2.1, + (TileTranslationFormulas Y w).2.2.2.2.2.1, hv], + by rw [(TileTranslationFormulas X w).2.2.2.2.2.2.1, + (TileTranslationFormulas Y w).2.2.2.2.2.2.1, he]⟩ + +private theorem samePeriodic : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (g : BandPackingSymmetry), ∀ (C : + BandCircle), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (cfg : + BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g q)), ∀ (cert : + BandOrderedGeneralLayoutCertificate (BandPackingSymmetryQuadrupleAction g q) cfg C + (BandPackingSymmetryTileAction g T)), + let P' : Fin 3 → Bool → ProtoTile := fun i s => BandPackingSymmetryTileAction g (P i s) + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (BandPackingSymmetryTileAction g (P i s)).cells = + (cert.P i s).cells ∧ ((BandPackingSymmetryTileAction g (P i s)).cells = ∅ → + (BandPackingSymmetryTileAction g (P i s)).anchor = (cert.P i s).anchor) ∧ + FootprintVertices (BandPackingSymmetryTileAction g (P i s)) = FootprintVertices + (cert.P i s) ∧ TileCentroid (BandPackingSymmetryTileAction g (P i s)) = TileCentroid + (cert.P i s)) → ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (w : GaussianInt), (X.cells + = Y.cells) → ((FootprintVertices X = FootprintVertices Y) → (FootprintVertices + (TileTranslation X w) = FootprintVertices (TileTranslation Y w) ∧ FootprintEdges + (TileTranslation X w) = FootprintEdges (TileTranslation Y w)))) → (∀ (o : + PeriodicSubtileIndex), FootprintVertices (SubtileOccurrenceInterpretation P' cert.u + cert.v o) = FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + o) ∧ FootprintEdges (SubtileOccurrenceInterpretation P' cert.u cert.v o) = + FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v o))) ) := by + classical + intro q T g C P cfg cert P' sameP translated o + cases o with + | mk label m n => + cases label <;> apply translated <;> + first | exact (sameP _ _).1 | exact (sameP _ _).2.2.1 + +private theorem callerClassification : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (g : BandPackingSymmetry), ∀ (C : + BandCircle), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (cfg : + BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g q)), ∀ (cert : + BandOrderedGeneralLayoutCertificate (BandPackingSymmetryQuadrupleAction g q) cfg C + (BandPackingSymmetryTileAction g T)), + let P' : Fin 3 → Bool → ProtoTile := fun i s => BandPackingSymmetryTileAction g (P i s) + (∀ (o : PeriodicSubtileIndex), FootprintVertices (SubtileOccurrenceInterpretation P' + cert.u cert.v o) = FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u + cert.v o) ∧ FootprintEdges (SubtileOccurrenceInterpretation P' cert.u cert.v o) = + FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v o)) → (( + let u := cert.u; + let v := cert.v; ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → + ((FootprintEdges (SubtileOccurrenceInterpretation cert.P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation cert.P u v b)).Nonempty → AllowedSubtileIncidence a + b) ∧ (¬AllowedSubtileIncidence a b → FootprintVertices + (SubtileOccurrenceInterpretation cert.P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation cert.P u v b) = ∅ ∨ (FootprintVertices + (SubtileOccurrenceInterpretation cert.P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation cert.P u v b)).Subsingleton)) → (∀ (o : + PeriodicSubtileIndex), ∀ (p : PeriodicSubtileIndex), (o ≠ p) → (((FootprintEdges + (SubtileOccurrenceInterpretation P' cert.u cert.v o) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P' cert.u cert.v p)).Nonempty → + AllowedSubtileIncidence o p) ∧ (¬ AllowedSubtileIncidence o p → FootprintVertices + (SubtileOccurrenceInterpretation P' cert.u cert.v o) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P' cert.u cert.v p) = ∅ ∨ (FootprintVertices + (SubtileOccurrenceInterpretation P' cert.u cert.v o) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P' cert.u cert.v p)).Subsingleton)))) ) := by + classical + intro q T g C P cfg cert P' samePeriodic classification o p hop + simpa only [(samePeriodic o).1, (samePeriodic p).1, + (samePeriodic o).2, (samePeriodic p).2] using classification o p hop + +private theorem callerRaw : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (g : BandPackingSymmetry), ∀ (C : + BandCircle), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (cfg : + BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g q)), ∀ (cert : + BandOrderedGeneralLayoutCertificate (BandPackingSymmetryQuadrupleAction g q) cfg C + (BandPackingSymmetryTileAction g T)), + let P' : Fin 3 → Bool → ProtoTile := fun i s => BandPackingSymmetryTileAction g (P i s) + let Q' : Fin 3 → Bool → ProtoTile := fun i s => BandPackingSymmetryTileAction g (Q i s) + let S' : Fin 3 → Bool → ProtoTile := fun i s => BandPackingSymmetryTileAction g (S i s) + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (BandPackingSymmetryTileAction g (P i s)).cells = + (cert.P i s).cells ∧ ((BandPackingSymmetryTileAction g (P i s)).cells = ∅ → + (BandPackingSymmetryTileAction g (P i s)).anchor = (cert.P i s).anchor) ∧ + FootprintVertices (BandPackingSymmetryTileAction g (P i s)) = FootprintVertices + (cert.P i s) ∧ TileCentroid (BandPackingSymmetryTileAction g (P i s)) = TileCentroid + (cert.P i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (BandPackingSymmetryTileAction g + (Q i s)).cells = (cert.Q i s).cells ∧ ((BandPackingSymmetryTileAction g (Q i + s)).cells = ∅ → (BandPackingSymmetryTileAction g (Q i s)).anchor = (cert.Q i + s).anchor) ∧ FootprintVertices (BandPackingSymmetryTileAction g (Q i s)) = + FootprintVertices (cert.Q i s) ∧ TileCentroid (BandPackingSymmetryTileAction g (Q i + s)) = TileCentroid (cert.Q i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + (BandPackingSymmetryTileAction g (S i s)).cells = (cert.S i s).cells ∧ + ((BandPackingSymmetryTileAction g (S i s)).cells = ∅ → (BandPackingSymmetryTileAction + g (S i s)).anchor = (cert.S i s).anchor) ∧ FootprintVertices + (BandPackingSymmetryTileAction g (S i s)) = FootprintVertices (cert.S i s) ∧ + TileCentroid (BandPackingSymmetryTileAction g (S i s)) = TileCentroid (cert.S i s)) → + ((FootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.P (1 : + Fin (3 : ℕ)) true) ⊆ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∩ + FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true) ∧ FootprintVertices (cert.P (0 : + Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.P (0 : Fin (3 : ℕ)) false) ⊆ + FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.S (2 : + Fin (3 : ℕ)) false) ∪ FootprintVertices (cert.Q (0 : Fin (3 : ℕ)) false) ∪ + FootprintVertices (cert.Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.S (1 : + Fin (3 : ℕ)) false)) → (FootprintVertices (P' 0 true) ∩ FootprintVertices (P' 1 true) + ⊆ FootprintVertices (Q' 1 true) ∩ FootprintVertices (P' 1 true) ∧ FootprintVertices + (P' 0 true) ∩ FootprintVertices (P' 0 false) ⊆ (FootprintVertices (Q' 1 true) ∩ + FootprintVertices (S' 2 false)) ∪ FootprintVertices (Q' 0 false) ∪ (FootprintVertices + (Q' 2 true) ∩ FootprintVertices (S' 1 false)))))) ) := by + classical + intro q T g C P Q S cfg cert P' Q' S' sameP sameQ sameS raw + simpa only [P', Q', S', (sameP _ _).2.2.1, (sameQ _ _).2.2.1, + (sameS _ _).2.2.1] using raw + +private theorem period_u : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (g : BandPackingSymmetry), ∀ (C : + BandCircle), (BandPackingSymmetryReversesOrientation g = false) → + ((BandPackingSymmetryScopedPhase g q false) → (∀ (cfg : + BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g q)), ∀ (cert : + BandOrderedGeneralLayoutCertificate (BandPackingSymmetryQuadrupleAction g q) cfg C + (BandPackingSymmetryTileAction g T)), + let L := BandPackingSymmetryVectorAction g + cert.u = L (BandVectors.1 (q 0) (q 1)))) ) := by + classical + intro q T g C hg hphase cfg cert L + rw [cert.period_u] + simpa [BandPackingSymmetryScopedPhase, hg, L] using (hphase 0).2.1 + +private theorem period_v : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (g : BandPackingSymmetry), ∀ (C : + BandCircle), (BandPackingSymmetryReversesOrientation g = false) → + ((BandPackingSymmetryScopedPhase g q false) → (∀ (cfg : + BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g q)), ∀ (cert : + BandOrderedGeneralLayoutCertificate (BandPackingSymmetryQuadrupleAction g q) cfg C + (BandPackingSymmetryTileAction g T)), + let L := BandPackingSymmetryVectorAction g + cert.v = L (BandVectors.1 (q 0) (q 2)))) ) := by + classical + intro q T g C hg hphase cfg cert L + rw [cert.period_v] + simpa [BandPackingSymmetryScopedPhase, hg, L] using (hphase 1).2.1 + +private theorem occurrence_image : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (g : BandPackingSymmetry), ∀ (C : + BandCircle), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (cfg : + BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g q)), ∀ (cert : + BandOrderedGeneralLayoutCertificate (BandPackingSymmetryQuadrupleAction g q) cfg C + (BandPackingSymmetryTileAction g T)), + let P' : Fin 3 → Bool → ProtoTile := fun i s => BandPackingSymmetryTileAction g (P i s) + let L := BandPackingSymmetryVectorAction g + (cert.u = L (BandVectors.1 (q 0) (q 1))) → ((cert.v = L (BandVectors.1 (q 0) (q 2))) → + ((∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ + (o : PeriodicSubtileIndex), BandPackingSymmetryTileAction g + (SubtileOccurrenceInterpretation S u v o) = SubtileOccurrenceInterpretation (fun (i : + Fin (3 : ℕ)) (s : Bool) => BandPackingSymmetryTileAction g (S i s)) + (BandPackingSymmetryVectorAction g u) (BandPackingSymmetryVectorAction g v) o) → (∀ + (o : PeriodicSubtileIndex), BandPackingSymmetryTileAction g + (SubtileOccurrenceInterpretation P (BandVectors.1 (q 0) (q 1)) (BandVectors.1 (q 0) + (q 2)) o) = SubtileOccurrenceInterpretation P' cert.u cert.v o))) ) := by + classical + intro q T g C P cfg cert P' L period_u period_v occurrence_transport o + rw [occurrence_transport, period_u, period_v] + +private theorem linj : + (by + classical + exact + ∀ (g : BandPackingSymmetry), + let L := BandPackingSymmetryVectorAction g + ∀ (f : GaussianInt ≃ GaussianInt), (∀ (z : GaussianInt), (f : GaussianInt → GaussianInt) + z = BandPackingSymmetryVectorAction g z) → (Function.Injective L) ) := by + classical + intro g L f hf x y hxy + apply f.injective + simpa only [hf] using hxy + +private theorem mem_vertices : + (by + classical + exact + ∀ (g : BandPackingSymmetry), + let L := BandPackingSymmetryVectorAction g + (∀ (T : ProtoTile), FootprintVertices (BandPackingSymmetryTileAction g T) = + BandPackingSymmetryVectorAction g '' FootprintVertices T) → ((Function.Injective L) → + (∀ (X : ProtoTile), ∀ (x : GaussianInt), L x ∈ FootprintVertices + (BandPackingSymmetryTileAction g X) ↔ x ∈ FootprintVertices X)) ) := by + classical + intro g L vertices_image linj X x + rw [vertices_image] + constructor + · rintro ⟨z, hz, he⟩ + exact linj he ▸ hz + · intro hx + exact ⟨x, hx, rfl⟩ + +end GeneralT6Geometry + +theorem P4564T2GeneralT6Transport (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (T : ProtoTile) (hT : BandPrototile (q 0) T) + (a : Fin 3) (g : BandPackingSymmetry) + (hphase : BandPackingSymmetryScopedPhase g + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] false) + (hpredecessor : ∀ r : Fin 4 → CircleCoordinates, ProperBandQuadruple r → + r 0 = (![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] : Fin 4 → CircleCoordinates) 1 → + r 2 = (![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] : Fin 4 → CircleCoordinates) 2 → + r 3 = (![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] : Fin 4 → CircleCoordinates) 3 → + BandPackingSymmetryScopedPhase g r false) + (cfg : BandOrderedGeneralConfiguration + (BandPackingSymmetryQuadrupleAction g ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ])) + (C : BandCircle) + (cert : BandOrderedGeneralLayoutCertificate + (BandPackingSymmetryQuadrupleAction g ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ]) cfg C + (BandPackingSymmetryTileAction g T)) : + (∀ (r : Fin 4 → CircleCoordinates), ProperBandQuadruple r → + r 0 = q 1 → r 2 = q 2 → r 3 = q 3 → + (q 2).1 ≤ (q 1).1 → (q 3).1 ≤ (q 2).1 → + 1 < (q 2).1 → + ∀ (P Q S : Fin 3 → Bool → ProtoTile), + (∀ i s, BandSubtileOccurrence q T i s (P i s)) → + (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (P i s).cells) → + (∀ i s, BandSubtileOccurrence r (P 0 true) i s (Q i s)) → + (∀ x, x ∈ (P 0 true).cells ↔ ∃ i s, x ∈ (Q i s).cells) → + (∀ i s, BandSubtileOccurrence r (P 0 false) i s (S i s)) → + (∀ x, x ∈ (P 0 false).cells ↔ ∃ i s, x ∈ (S i s).cells) → + (let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + (∀ a b : PeriodicSubtileIndex, a ≠ b → + ((FootprintEdges (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty → + AllowedSubtileIncidence a b) ∧ + (¬ AllowedSubtileIncidence a b → + FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices + (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices + (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ + FootprintVertices (P 0 true) ∩ FootprintVertices (P 1 true) ⊆ + FootprintVertices (Q 1 true) ∩ FootprintVertices (P 1 true) ∧ + FootprintVertices (P 0 true) ∩ FootprintVertices (P 0 false) ⊆ + (FootprintVertices (Q 1 true) ∩ FootprintVertices (S 2 false)) ∪ + FootprintVertices (Q 0 false) ∪ + (FootprintVertices (Q 2 true) ∩ + FootprintVertices (S 1 false)))) := by +-- BODY + classical + intro r hr hr0 hr2 hr3 h12 h23 hlarge P Q S hP hPu hQ hQu hS hSu + -- Strict normalized curvature order fixes the cyclic and orientation choices. + have curvature := (BandPackingSymmetryCovariance g).1 + have normalized12 := cfg.order12 + have normalized23 : + ((BandPackingSymmetryQuadrupleAction g + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ]) 3).1 < + ((BandPackingSymmetryQuadrupleAction g + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ]) 2).1 := GeneralT6Geometry.normalized23 + q a g cfg + have order_forces : a = 0 ∧ BandPackingSymmetryReversesOrientation g = false := + GeneralT6Geometry.order_forces q T a g hphase hpredecessor cfg C cert h12 h23 curvature + normalized12 normalized23 + obtain ⟨rfl, hg⟩ := order_forces + have hrotate : + (![q 0, q (0 : Fin 3).succ, q (0 + 1 : Fin 3).succ, + q (0 + 2 : Fin 3).succ] : Fin 4 → CircleCoordinates) = q := GeneralT6Geometry.hrotate q + rw [hrotate] at hphase hpredecessor normalized23 + revert cert cfg + rw [hrotate] + intro cfg cert + have action (p : Fin 4 → CircleCoordinates) (i : Fin 4) : + BandPackingSymmetryQuadrupleAction g p i = + BandPackingSymmetryCircleAction g (p i) := GeneralT6Geometry.action g hg p i + -- The supplied phase fixes signs independently of orientation parity. + have transport (p : Fin 4 → CircleCoordinates) (X : ProtoTile) + (F : Fin 3 → Bool → ProtoTile) (hp : ProperBandQuadruple p) + (hX : BandPrototile (p 0) X) + (hF : ∀ i s, BandSubtileOccurrence p X i s (F i s)) + (hFu : ∀ x, x ∈ X.cells ↔ ∃ i s, x ∈ (F i s).cells) + (hph : BandPackingSymmetryScopedPhase g p false) : + ∀ i s, BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction g p) + (BandPackingSymmetryTileAction g X) i s + (BandPackingSymmetryTileAction g (F i s)) := GeneralT6Geometry.transport g hg p X F hp hX + hF hFu hph + let P' : Fin 3 → Bool → ProtoTile := fun i s => BandPackingSymmetryTileAction g (P i s) + let Q' : Fin 3 → Bool → ProtoTile := fun i s => BandPackingSymmetryTileAction g (Q i s) + let S' : Fin 3 → Bool → ProtoTile := fun i s => BandPackingSymmetryTileAction g (S i s) + have hP' := transport q T P hq hT hP hPu hphase + have hrphase : BandPackingSymmetryScopedPhase g r false := + hpredecessor r hr (by simpa using hr0) (by simpa using hr2) (by simpa using hr3) + have hQ' := transport r (P 0 true) Q hr (by simpa [hr0] using (hP 0 true).1) + hQ hQu hrphase + have hS' := transport r (P 0 false) S hr (by simpa [hr0] using (hP 0 false).1) + hS hSu hrphase + -- Strict order excludes the two nontrivial predecessor rotations. + have predecessor : BandPackingSymmetryQuadrupleAction g r = cfg.firstPredecessor := + GeneralT6Geometry.predecessor q g r hr hr0 hr2 hr3 normalized23 cfg action + rw [predecessor] at hQ' hS' + -- Compare observables without asserting equality of nonempty records. + have compare (p : Fin 4 → CircleCoordinates) (X Y U V : ProtoTile) + (i : Fin 3) (s : Bool) + (hU : BandSubtileOccurrence p X i s U) + (hV : BandSubtileOccurrence p Y i s V) + (hXY : TileCentroid X = TileCentroid Y) : + U.cells = V.cells ∧ (U.cells = ∅ → U.anchor = V.anchor) ∧ + FootprintVertices U = FootprintVertices V ∧ TileCentroid U = TileCentroid V := + GeneralT6Geometry.compare p X Y U V i s hU hV hXY + have sameP (i : Fin 3) (s : Bool) := + compare _ _ _ _ _ i s (hP' i s) (cert.outer_occurrence i s) rfl + have sameQ (i : Fin 3) (s : Bool) := + compare _ _ _ _ _ i s (hQ' i s) (cert.plus_occurrence i s) (sameP 0 true).2.2.2 + have sameS (i : Fin 3) (s : Bool) := + compare _ _ _ _ _ i s (hS' i s) (cert.minus_occurrence i s) (sameP 0 false).2.2.2 + have translated (X Y : ProtoTile) (w : GaussianInt) + (hc : X.cells = Y.cells) (hv : FootprintVertices X = FootprintVertices Y) : + FootprintVertices (TileTranslation X w) = FootprintVertices (TileTranslation Y w) ∧ + FootprintEdges (TileTranslation X w) = FootprintEdges (TileTranslation Y w) := + GeneralT6Geometry.translated X Y w hc hv + have samePeriodic (o : PeriodicSubtileIndex) : + FootprintVertices (SubtileOccurrenceInterpretation P' cert.u cert.v o) = + FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v o) ∧ + FootprintEdges (SubtileOccurrenceInterpretation P' cert.u cert.v o) = + FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v o) := + GeneralT6Geometry.samePeriodic q T g C P cfg cert sameP translated o + -- Original periodic classification and raw support are separate inputs. + have classification := BandOriginalOccurrenceIntersectionClassification _ cfg C _ cert + have raw := BandOrderedGeneralRawSupport _ cfg C _ cert + have callerClassification (o p : PeriodicSubtileIndex) (hop : o ≠ p) : + ((FootprintEdges (SubtileOccurrenceInterpretation P' cert.u cert.v o) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P' cert.u cert.v p)).Nonempty → + AllowedSubtileIncidence o p) ∧ + (¬ AllowedSubtileIncidence o p → + FootprintVertices (SubtileOccurrenceInterpretation P' cert.u cert.v o) ∩ + FootprintVertices (SubtileOccurrenceInterpretation P' cert.u cert.v p) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation P' cert.u cert.v o) ∩ + FootprintVertices (SubtileOccurrenceInterpretation P' cert.u cert.v p)).Subsingleton) + := GeneralT6Geometry.callerClassification q T g C P cfg cert samePeriodic + classification o p hop + have callerRaw : + FootprintVertices (P' 0 true) ∩ FootprintVertices (P' 1 true) ⊆ + FootprintVertices (Q' 1 true) ∩ FootprintVertices (P' 1 true) ∧ + FootprintVertices (P' 0 true) ∩ FootprintVertices (P' 0 false) ⊆ + (FootprintVertices (Q' 1 true) ∩ FootprintVertices (S' 2 false)) ∪ + FootprintVertices (Q' 0 false) ∪ + (FootprintVertices (Q' 2 true) ∩ FootprintVertices (S' 1 false)) := + GeneralT6Geometry.callerRaw q T g C P Q S cfg cert sameP sameQ sameS raw + -- Use the same false phase for the ordered periods before pulling back. + let L := BandPackingSymmetryVectorAction g + have period_u : cert.u = L (BandVectors.1 (q 0) (q 1)) := GeneralT6Geometry.period_u q T g C hg + hphase cfg cert + have period_v : cert.v = L (BandVectors.1 (q 0) (q 2)) := GeneralT6Geometry.period_v q T g C hg + hphase cfg cert + obtain ⟨_, _, _, _, _, _, _, vertices_image, edges_image, subsingleton_transport, + occurrence_transport⟩ := BandPackingSymmetryTilingTransport g + have occurrence_image (o : PeriodicSubtileIndex) : + BandPackingSymmetryTileAction g + (SubtileOccurrenceInterpretation P (BandVectors.1 (q 0) (q 1)) + (BandVectors.1 (q 0) (q 2)) o) = + SubtileOccurrenceInterpretation P' cert.u cert.v o := GeneralT6Geometry.occurrence_image q + T g C P cfg cert period_u period_v occurrence_transport o + obtain ⟨f, hf, _, _⟩ := P4055T1PackingGridEquivalence g + have linj : Function.Injective L := GeneralT6Geometry.linj g f hf + have mem_vertices (X : ProtoTile) (x : GaussianInt) : + L x ∈ FootprintVertices (BandPackingSymmetryTileAction g X) ↔ + x ∈ FootprintVertices X := GeneralT6Geometry.mem_vertices g vertices_image linj X x + dsimp only + refine ⟨?_, ?_, ?_⟩ + · intro o p hop + obtain ⟨hallowed, hraw⟩ := callerClassification o p hop + rw [← occurrence_image o, ← occurrence_image p] at hallowed hraw + constructor + · rintro ⟨e, heo, hep⟩ + apply hallowed + rw [edges_image, edges_image] + exact ⟨e.image L, ⟨e, heo, rfl⟩, ⟨e, hep, rfl⟩⟩ + · intro hnot + rcases hraw hnot with hempty | hsub + · left + apply Set.eq_empty_iff_forall_notMem.mpr + intro x hx + have hm := And.intro ((mem_vertices _ x).mpr hx.1) + ((mem_vertices _ x).mpr hx.2) + change L x ∈ FootprintVertices (BandPackingSymmetryTileAction g + (SubtileOccurrenceInterpretation P (BandVectors.1 (q 0) (q 1)) + (BandVectors.1 (q 0) (q 2)) o)) ∩ + FootprintVertices (BandPackingSymmetryTileAction g + (SubtileOccurrenceInterpretation P (BandVectors.1 (q 0) (q 1)) + (BandVectors.1 (q 0) (q 2)) p)) at hm + rw [hempty] at hm + exact hm + · right + exact (subsingleton_transport _ _).mpr hsub + · intro x hx + have hm := callerRaw.1 + ⟨(mem_vertices (P 0 true) x).mpr hx.1, (mem_vertices (P 1 true) x).mpr hx.2⟩ + exact ⟨(mem_vertices (Q 1 true) x).mp hm.1, (mem_vertices (P 1 true) x).mp hm.2⟩ + · intro x hx + have hm := callerRaw.2 + ⟨(mem_vertices (P 0 true) x).mpr hx.1, (mem_vertices (P 0 false) x).mpr hx.2⟩ + rcases hm with (hm | hm) | hm + · exact Or.inl (Or.inl + ⟨(mem_vertices (Q 1 true) x).mp hm.1, (mem_vertices (S 2 false) x).mp hm.2⟩) + · exact Or.inl (Or.inr ((mem_vertices (Q 0 false) x).mp hm)) + · exact Or.inr + ⟨(mem_vertices (Q 2 true) x).mp hm.1, (mem_vertices (S 1 false) x).mp hm.2⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2GeometryPullback.lean b/LeanPool/ApollonianSuperharmonic/P4564T2GeometryPullback.lean new file mode 100644 index 0000000000..48236d2e32 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4564T2GeometryPullback.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandParentRotationOccurrenceCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport + +-- [TABLET NODE: P4564T2GeometryPullback] + +/-! +# P4564T2GeometryPullback + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4564T2GeometryPullback (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (T : ProtoTile) (hT : BandPrototile (q 0) T) + (a : Fin 3) (g : BandPackingSymmetry) : + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + let qg := BandPackingSymmetryQuadrupleAction g qa + let Tg := BandPackingSymmetryTileAction g T + (LatticeTile Tg ∧ TileArea Tg = Int.toNat (qg 0).1 ∧ + (∀ (S : Fin 3 → Bool → ProtoTile), + (∀ i s, BandSubtileOccurrence qg Tg i s (S i s)) → + (∀ x, x ∈ Tg.cells ↔ ∃ i s, x ∈ (S i s).cells) → + ∀ i s, LatticeTile (TileCellComplement Tg (S i s)) ∧ + TileTouching (TileCellComplement Tg (S i s)) (S i s)) ∧ + QuarterTurnSymmetric Tg) → + (LatticeTile T ∧ TileArea T = Int.toNat (q 0).1 ∧ + (∀ (S : Fin 3 → Bool → ProtoTile), + (∀ i s, BandSubtileOccurrence q T i s (S i s)) → + (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (S i s).cells) → + ∀ i s, LatticeTile (TileCellComplement T (S i s)) ∧ + TileTouching (TileCellComplement T (S i s)) (S i s)) ∧ + QuarterTurnSymmetric T) := by +-- BODY + dsimp only + rintro ⟨hdisk, harea, hcomplements, hquarter⟩ + obtain ⟨disk, area, complement, touching, quarter, _⟩ := + BandPackingSymmetryTilingTransport g + refine ⟨(disk T).mpr hdisk, ?_, ?_, (quarter T).mpr hquarter⟩ + · have hcurv : + (BandPackingSymmetryQuadrupleAction g + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] 0).1 = + (q 0).1 := (BandPackingSymmetryCovariance g).1 (q 0) + exact (area T).symm.trans (harea.trans (congrArg Int.toNat hcurv)) + · intro S hS hcover i s + let qa : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + obtain ⟨hqa, hSa, hcovera⟩ := + BandParentRotationOccurrenceCovariance q hq a T hT S hS hcover + obtain ⟨d, e, S', hphase, he, hfamily, hS', hcover'⟩ := + (BandPackingSymmetryCovariance g).2.2 qa T + (fun j t => S (a + j) t) hqa hT hSa hcovera + have h := hcomplements S' hS' hcover' (e (i - a, s)).1 (e (i - a, s)).2 + have hmember : S' (e (i - a, s)).1 (e (i - a, s)).2 = + BandPackingSymmetryTileAction g (S i s) := by + have hi : a + (i - a) = i := by abel + simpa only [hi] using hfamily (i - a) s + rw [hmember] at h + refine ⟨(disk _).mpr ?_, (touching _ _).mpr ?_⟩ + · rw [complement] + exact h.1 + · rw [complement] + exact h.2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4566T1LiteralSuccessorCharts.lean b/LeanPool/ApollonianSuperharmonic/P4566T1LiteralSuccessorCharts.lean new file mode 100644 index 0000000000..9c3ea038b3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4566T1LiteralSuccessorCharts.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4566T1UnitPairCharts +public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique + +-- [TABLET NODE: P4566T1LiteralSuccessorCharts] + +/-! +# P4566T1LiteralSuccessorCharts + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4566T1LiteralSuccessorCharts + (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) : + let q : Fin 4 → CircleCoordinates := + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] + (((p 2).1 = 1) → ∀ orientation : Bool, + UnitOccurrenceOrientation q 1 orientation ↔ + UnitOccurrenceOrientation p 1 orientation) ∧ + (((p 3).1 = 1) → ∀ orientation : Bool, + UnitOccurrenceOrientation q 2 orientation ↔ + UnitOccurrenceOrientation p 2 orientation) := by +-- BODY + classical + dsimp only + let q : Fin 4 → CircleCoordinates := + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] + have nn := (SemiProperForestClassification p hp.1).1 + have hx : (p 1).1 < (p 0).1 := hp.2 0 + have growth : (p 0).1 < (q 0).1 := by + have h2 := nn 2 + have h3 := nn 3 + dsimp [q] + omega + have hq : ProperBandQuadruple q := by + rcases BandSuccessorClassification p hp.1 with bad | good + · have h0 := nn 1 + change 2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1 = 1 at bad + dsimp [q] at growth + omega + · exact good.1 + have direction : PrimitiveVectorOrientation (p 2) (p 3) ∨ + PrimitiveVectorOrientation (p 3) (p 2) := by + have ht : BandTangency (p 2) (p 3) := + ⟨p, hp.1, 2, 3, by decide, rfl, rfl⟩ + rcases (PrimitiveVectorOrientationUnique _ _).2 ht |>.2 with h | h + · exact Or.inl h.1 + · exact Or.inr h.1 + constructor + · intro hunit orientation + have forward : ∀ b, UnitOccurrenceOrientation p 1 b → + UnitOccurrenceOrientation q 1 b := by + intro b hb + by_cases other : (p 3).1 = 1 + · rcases direction with hd | hd + · have pair := P4566T1UnitPairCharts p hp 1 2 (by decide) hunit other hd + have eq := (UnitOccurrenceOrientationUnique.1 p hp 1 hunit).unique hb pair.1 + subst b + exact UnitOccurrenceOrientation.retainSecondToThird hp other hd pair.1 + · have pair := P4566T1UnitPairCharts p hp 2 1 (by decide) other hunit hd + have eq := (UnitOccurrenceOrientationUnique.1 p hp 1 hunit).unique hb pair.2 + subst b + exact UnitOccurrenceOrientation.retainSecondFromThird hp other hd pair.2 + · exact UnitOccurrenceOrientation.retainSecondOther hp other hb + constructor + · intro supplied + obtain ⟨b, hb, _⟩ := UnitOccurrenceOrientationUnique.1 p hp 1 hunit + have eq := (UnitOccurrenceOrientationUnique.1 q hq 1 hunit).unique + (forward b hb) supplied + simpa only [eq] using hb + · exact forward orientation + · intro hunit orientation + have forward : ∀ b, UnitOccurrenceOrientation p 2 b → + UnitOccurrenceOrientation q 2 b := by + intro b hb + by_cases other : (p 2).1 = 1 + · rcases direction with hd | hd + · have pair := P4566T1UnitPairCharts p hp 1 2 (by decide) other hunit hd + have eq := (UnitOccurrenceOrientationUnique.1 p hp 2 hunit).unique hb pair.2 + subst b + exact UnitOccurrenceOrientation.retainThirdFromSecond hp other hd pair.2 + · have pair := P4566T1UnitPairCharts p hp 2 1 (by decide) hunit other hd + have eq := (UnitOccurrenceOrientationUnique.1 p hp 2 hunit).unique hb pair.1 + subst b + exact UnitOccurrenceOrientation.retainThirdToSecond hp other hd pair.1 + · exact UnitOccurrenceOrientation.retainThirdOther hp other hb + constructor + · intro supplied + obtain ⟨b, hb, _⟩ := UnitOccurrenceOrientationUnique.1 p hp 2 hunit + have eq := (UnitOccurrenceOrientationUnique.1 q hq 2 hunit).unique + (forward b hb) supplied + simpa only [eq] using hb + · exact forward orientation + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4566T1SmallPairCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4566T1SmallPairCoordinates.lean new file mode 100644 index 0000000000..2922431845 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4566T1SmallPairCoordinates.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure + +-- [TABLET NODE: P4566T1SmallPairCoordinates] + +/-! +# P4566T1SmallPairCoordinates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4566T1SmallPairCoordinates + (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (h2 : (p 2).1 = 0 ∨ (p 2).1 = 1) + (h3 : (p 3).1 = 0 ∨ (p 3).1 = 1) : + ∃ z : GaussianInt, + (p 2 = (0, -1) ∧ p 3 = (1, 1 + 2 * z + 2 * ⟨0, 1⟩)) ∨ + (p 2 = (1, 1 + 2 * z + 2 * ⟨0, 1⟩) ∧ p 3 = (1, 1 + 2 * z)) ∨ + (p 2 = (1, 1 + 2 * z) ∧ p 3 = (0, -1)) ∨ + (p 2 = (1, 1 + 2 * z + 2 * ⟨0, 1⟩) ∧ p 3 = (0, 1)) ∨ + (p 2 = (0, 1) ∧ p 3 = (1, 1 + 2 * z)) ∨ + (p 2 = (1, 1 + 2 * z) ∧ p 3 = (1, 1 + 2 * z + 2 * ⟨0, 1⟩)) := by +-- BODY + let Rel (a b : CircleCoordinates) : Prop := + ((a.1 = 0 ∨ a.1 = 1) ∧ (b.1 = 0 ∨ b.1 = 1)) → + ∃ z : GaussianInt, + (a = (0, -1) ∧ b = (1, 1 + 2 * z + 2 * ⟨0, 1⟩)) ∨ + (a = (1, 1 + 2 * z + 2 * ⟨0, 1⟩) ∧ b = (1, 1 + 2 * z)) ∨ + (a = (1, 1 + 2 * z) ∧ b = (0, -1)) ∨ + (a = (1, 1 + 2 * z + 2 * ⟨0, 1⟩) ∧ b = (0, 1)) ∨ + (a = (0, 1) ∧ b = (1, 1 + 2 * z)) ∨ + (a = (1, 1 + 2 * z) ∧ b = (1, 1 + 2 * z + 2 * ⟨0, 1⟩)) + have large (u : Fin 4 → CircleCoordinates) (hu : ProperBandQuadruple u) : + 1 < (u 0).1 := by + have facts := ProperBandCurvatureStructure u hu + have h0 := facts.2.1 0 + have h1 := facts.2.1 1 + have l0 := hu.2 0 + have l1 := hu.2 1 + by_contra hn + have z0 : (u (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (u (1 : Fin 3).succ).1 = 0 := by omega + exact (by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1) + have claim : ∀ u, SemiProperQuadruple u → ProperBandQuadruple u → + Rel (u 1) (u 2) ∧ Rel (u 2) (u 3) ∧ Rel (u 3) (u 1) := by + intro u hs + induction hs with + | base z => + intro hu + have bad := hu.2 0 + simp at bad + | @rotate u hs ih => + intro hu + have old : ProperBandQuadruple u := by + refine ⟨hs, ?_⟩ + intro k + fin_cases k + · exact hu.2 2 + · exact hu.2 0 + · exact hu.2 1 + exact ⟨(ih old).2.1, (ih old).2.2, (ih old).1⟩ + | @successor u hs ih => + intro hu + rcases (SemiProperForestClassification u hs).2 with root | root | root | old + · rcases root with ⟨z, hz⟩ + have bad := hu.2 0 + simp [hz] at bad + · rcases root with ⟨z, hz⟩ + rw [hz] + refine ⟨?_, ?_, ?_⟩ + all_goals intro small + all_goals exact ⟨z, by simp⟩ + · rcases root with ⟨z, hz⟩ + rw [hz] + refine ⟨?_, ?_, ?_⟩ + all_goals intro small + all_goals exact ⟨z, by simp⟩ + · have hl := large u old + refine ⟨?_, (ih old).2.1, ?_⟩ + · intro small + have h : (u 0).1 = 0 ∨ (u 0).1 = 1 := small.1 + rcases h with h | h <;> exact (by omega) + · intro small + have h : (u 0).1 = 0 ∨ (u 0).1 = 1 := small.2 + rcases h with h | h <;> exact (by omega) + exact (claim p hp.1 hp).2.1 ⟨h2, h3⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4566T1SmallRetainedSides.lean b/LeanPool/ApollonianSuperharmonic/P4566T1SmallRetainedSides.lean new file mode 100644 index 0000000000..4124ee7686 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4566T1SmallRetainedSides.lean @@ -0,0 +1,365 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4566T1LiteralSuccessorCharts +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep +public import LeanPool.ApollonianSuperharmonic.P4566T1SmallPairCoordinates + +-- [TABLET NODE: P4566T1SmallRetainedSides] + +/-! +# P4566T1SmallRetainedSides + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SmallRetainedSidesProof + +private theorem nextProper : + ∀ (u : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple u → ProperBandQuadruple ![((2 : + ℤ) * (u (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (u (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (u (3 : Fin + (4 : ℕ))).1 - (u (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (u (0 : Fin (4 : ℕ))).2 + (2 : + GaussianInt) * (u (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (u (3 : Fin (4 : ℕ))).2 - (u + (1 : Fin (4 : ℕ))).2), u (0 : Fin (4 : ℕ)), u (2 : Fin (4 : ℕ)), u (3 : Fin (4 : ℕ))] := by + classical + intro u hu + refine ⟨SemiProperQuadruple.successor hu.1, ?_⟩ + have nn := (SemiProperForestClassification u hu.1).1 + have h0 := nn 0 + have h2 := nn 2 + have h3 := nn 3 + have hx : (u 1).1 < (u 0).1 := hu.2 0 + intro k + fin_cases k <;> dsimp <;> omega + +private theorem unit : + ∀ {u : Fin 4 → CircleCoordinates}, ∀ {k : Fin 3}, ∀ {b : Bool}, UnitOccurrenceOrientation u k + b → (u k.succ).1 = 1 := by + classical + intro u k b cert + induction cert with + | leftLower z => rfl + | leftUpper z => rfl + | rightUpper z => rfl + | rightLower z => rfl + | @rotate u k b cert ih => fin_cases k <;> simpa using ih + | retainSecondToThird _ _ _ _ ih => exact ih + | retainSecondFromThird _ _ _ _ ih => exact ih + | retainSecondOther _ _ _ ih => exact ih + | retainThirdFromSecond _ _ _ _ ih => exact ih + | retainThirdToSecond _ _ _ _ ih => exact ih + | retainThirdOther _ _ _ ih => exact ih + +private theorem rootValues : + (Fin 4 → CircleCoordinates) → ( + let I : GaussianInt := ⟨0, 1⟩ + (∀ (z : GaussianInt), have q := ![((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z), ((1 : + ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩), + ((0 : ℤ), (1 : GaussianInt)), ((0 : ℤ), (-1 : GaussianInt))]; BandVectors.1 (q (3 : Fin + (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (2 : Fin (4 : ℕ))) + (q (1 : Fin (4 : ℕ))) = (-1 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : + Fin (4 : ℕ))) = (1 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : + ℕ))) = (1 : GaussianInt) ∧ BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = + (-1 : GaussianInt) - z - ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : + Fin (4 : ℕ))) = z + ⟨(0 : ℤ), (1 : ℤ)⟩) → ((∀ (q : Fin (4 : ℕ) → CircleCoordinates), + SemiProperQuadruple q → BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ BandVectors.1 (q (0 : Fin (4 + : ℕ))) (q (3 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.2 (q (2 : Fin (4 + : ℕ))) (q (1 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (q (3 : Fin (4 : ℕ))) + (q (2 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → ((∀ (C : CircleCoordinates), + ∀ (D : CircleCoordinates), PrimitiveVectorOrientation C D → BandVectors.1 D C = ⟨(0 : + ℤ), + (1 : ℤ)⟩ * BandVectors.1 C D ∧ BandVectors.2 D C = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 C + D) → (∀ (z : GaussianInt), BandVectors.1 ((0 : ℤ), (-1 : GaussianInt)) ((1 : ℤ), (1 : + GaussianInt) + (2 : GaussianInt) * z) = -I ∧ BandVectors.1 ((1 : ℤ), (1 : GaussianInt) + + (2 : GaussianInt) * z) ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z + (2 : + GaussianInt) * I) = (-1 : GaussianInt) + I ∧ BandVectors.1 ((1 : ℤ), (1 : GaussianInt) + + (2 : GaussianInt) * z + (2 : GaussianInt) * I) ((0 : ℤ), (-1 : GaussianInt)) = (1 : + GaussianInt) ∧ BandVectors.1 ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z + (2 : + GaussianInt) * I) ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z) = (1 : + GaussianInt) + I ∧ BandVectors.1 ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z) ((0 + : ℤ), (1 : GaussianInt)) = -I ∧ BandVectors.1 ((0 : ℤ), (1 : GaussianInt)) ((1 : ℤ), (1 : + GaussianInt) + (2 : GaussianInt) * z + (2 : GaussianInt) * I) = (-1 : GaussianInt))))) := by + classical + intro p I baseLaw stepLaw flipLaw z + let q : Fin 4 → CircleCoordinates := + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] + let b : Fin 4 → CircleCoordinates := + ![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * I), (0, 1), (0, -1)] + have hb : SemiProperQuadruple b := SemiProperQuadruple.base z + have v32 : BandVectors.1 (b 3) (b 2) = 0 := (baseLaw z).1 + have v21 : BandVectors.1 (b 2) (b 1) = -1 := (baseLaw z).2.1 + have v13 : BandVectors.1 (b 1) (b 3) = 1 := (baseLaw z).2.2.1 + have v20 : BandVectors.1 (b 2) (b 0) = -1 := by + rw [(stepLaw b hb).1, v21, v32] + ring + have v03 : BandVectors.1 (b 0) (b 3) = 1 := by + rw [(stepLaw b hb).2.1, v13, v32] + ring + have v01 : BandVectors.1 (b 0) (b 1) = -1 + I := by + have h := (stepLaw _ (SemiProperQuadruple.rotate hb)).2.1 + change BandVectors.1 (b 0) (b 1) = + BandVectors.1 (b 2) (b 1) + I * BandVectors.1 (b 1) (b 3) at h + rw [h, v21, v13] + ring + have pm : PrimitiveVectorOrientation (b 3) (b 0) := by + convert PrimitiveVectorOrientation.base31 (z - I) using 1 <;> + simp [b, I]; ring + have pp : PrimitiveVectorOrientation (b 2) (b 0) := by + convert PrimitiveVectorOrientation.base21 (z - I) using 1 <;> + simp [b, I]; ring + have v30 : BandVectors.1 (b 3) (b 0) = -I := by + have h := (flipLaw _ _ pm).1 + rw [v03] at h + have re := congrArg Zsqrtd.re h + have im := congrArg Zsqrtd.im h + apply Zsqrtd.ext <;> + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at re im ⊢ <;> omega + have v10 : BandVectors.1 (b 1) (b 0) = 1 + I := by + have h := (flipLaw _ _ (PrimitiveVectorOrientation.base10 z)).1 + change BandVectors.1 (b 0) (b 1) = I * BandVectors.1 (b 1) (b 0) at h + rw [v01] at h + have re := congrArg Zsqrtd.re h + have im := congrArg Zsqrtd.im h + apply Zsqrtd.ext <;> + norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at re im ⊢ <;> omega + have v02 : BandVectors.1 (b 0) (b 2) = -I := by + rw [(flipLaw _ _ pp).1, v20] + ring + exact ⟨v30, v01, v13, v10, v02, v21⟩ + +private theorem data : + ∀ (p : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → (((p (2 : Fin (4 : ℕ))).1 = (0 : + ℤ) ∨ (p (2 : Fin (4 : ℕ))).1 = (1 : ℤ)) → (((p (3 : Fin (4 : ℕ))).1 = (0 : ℤ) ∨ (p (3 : + Fin (4 : ℕ))).1 = (1 : ℤ)) → ( + let I : GaussianInt := ⟨0, 1⟩ + (∀ (z : GaussianInt), BandVectors.1 (0, -1) (1, 1 + 2 * z) = -I ∧ BandVectors.1 (1, 1 + 2 * + z) (1, 1 + 2 * z + 2 * I) = -1 + I ∧ BandVectors.1 (1, 1 + 2 * z + 2 * I) (0, -1) = 1 ∧ + BandVectors.1 (1, 1 + 2 * z + 2 * I) (1, 1 + 2 * z) = 1 + I ∧ BandVectors.1 (1, 1 + 2 * + z) (0, 1) = -I ∧ BandVectors.1 (0, 1) (1, 1 + 2 * z + 2 * I) = -1) → + ((PrimitiveVectorOrientation (p 2) (p 3) ∧ (∀ o : Bool, ((p 3).1 = 0 ∨ o = false) → + UnitTriangularStep o (BandVectors.1 (p 3) (p 2))) ∧ (∀ o : Bool, ((p 2).1 = 0 ∨ o = true) + → UnitTriangularStep o (I * BandVectors.1 (p 3) (p 2)))) ∨ (PrimitiveVectorOrientation (p + 3) (p 2) ∧ (∀ o : Bool, ((p 3).1 = 0 ∨ o = true) → UnitTriangularStep o (BandVectors.1 (p + 3) (p 2))) ∧ (∀ o : Bool, ((p 2).1 = 0 ∨ o = false) → UnitTriangularStep o (I * + BandVectors.1 (p 3) (p 2)))))))) := by + classical + intro p hp h2 h3 I rootValues + obtain ⟨z, rows⟩ := P4566T1SmallPairCoordinates p hp h2 h3 + rcases rootValues z with ⟨v30, v01, v13, v10, v02, v21⟩ + rcases rows with ⟨a, b⟩ | ⟨a, b⟩ | ⟨a, b⟩ | ⟨a, b⟩ | ⟨a, b⟩ | ⟨a, b⟩ + · refine Or.inl ⟨?_, ?_, ?_⟩ + · rw [a, b] + exact PrimitiveVectorOrientation.base31 z + · intro o label + rw [a, b, v13] + cases o <;> norm_num [UnitTriangularStep, I, Zsqrtd.ext_iff] + · intro o label + rw [a, b, v13] + cases o <;> norm_num [UnitTriangularStep, I, Zsqrtd.ext_iff] + · refine Or.inl ⟨?_, ?_, ?_⟩ + · rw [a, b] + exact PrimitiveVectorOrientation.base10 z + · intro o label + rw [a, b, v01] + have ho : o = false := by simpa [b] using label + subst o + norm_num [UnitTriangularStep, I, Zsqrtd.ext_iff] + · intro o label + rw [a, b, v01] + have ho : o = true := by simpa [a] using label + subst o + norm_num [UnitTriangularStep, I, Zsqrtd.ext_iff] + · refine Or.inr ⟨?_, ?_, ?_⟩ + · rw [a, b] + convert PrimitiveVectorOrientation.base31 (z - I) using 1; simp [I]; ring + · intro o label + rw [a, b, v30] + cases o <;> norm_num [UnitTriangularStep, I, Zsqrtd.ext_iff] + · intro o label + rw [a, b, v30] + cases o <;> norm_num [UnitTriangularStep, I, Zsqrtd.ext_iff] + · refine Or.inr ⟨?_, ?_, ?_⟩ + · rw [a, b] + exact PrimitiveVectorOrientation.base21 z + · intro o label + rw [a, b, v21] + cases o <;> norm_num [UnitTriangularStep, I, Zsqrtd.ext_iff] + · intro o label + rw [a, b, v21] + cases o <;> norm_num [UnitTriangularStep, I, Zsqrtd.ext_iff] + · refine Or.inl ⟨?_, ?_, ?_⟩ + · rw [a, b] + convert PrimitiveVectorOrientation.base21 (z - I) using 1; simp [I]; ring + · intro o label + rw [a, b, v02] + cases o <;> norm_num [UnitTriangularStep, I, Zsqrtd.ext_iff] + · intro o label + rw [a, b, v02] + cases o <;> norm_num [UnitTriangularStep, I, Zsqrtd.ext_iff] + · refine Or.inr ⟨?_, ?_, ?_⟩ + · rw [a, b] + exact PrimitiveVectorOrientation.base10 z + · intro o label + rw [a, b, v10] + have ho : o = true := by simpa [b] using label + subst o + norm_num [UnitTriangularStep, I, Zsqrtd.ext_iff] + · intro o label + rw [a, b, v10] + have ho : o = false := by simpa [a] using label + subst o + norm_num [UnitTriangularStep, I, Zsqrtd.ext_iff] + +end SmallRetainedSidesProof + +theorem P4566T1SmallRetainedSides + (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (h2 : (p 2).1 = 0 ∨ (p 2).1 = 1) + (h3 : (p 3).1 = 0 ∨ (p 3).1 = 1) : + let q : Fin 4 → CircleCoordinates := + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] + let r : Fin 4 → CircleCoordinates := + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + (PrimitiveVectorOrientation (p 2) (p 3) ∧ + (∀ orientation : Bool, + UnitOccurrenceOrientation q 1 orientation → + UnitTriangularStep orientation (BandVectors.1 (p 3) (p 2)) ∧ + ((p 3).1 = 0 ∨ orientation = false)) ∧ + (∀ orientation : Bool, + UnitOccurrenceOrientation q 2 orientation → + UnitTriangularStep orientation + ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (p 3) (p 2)) ∧ + ((p 2).1 = 0 ∨ orientation = true)) ∧ + ((p 2).1 = 1 → (p 3).1 = 1 → + UnitOccurrenceOrientation q 1 false ∧ + UnitOccurrenceOrientation q 2 true ∧ + UnitOccurrenceOrientation r 1 false ∧ + UnitOccurrenceOrientation r 2 true)) ∨ + (PrimitiveVectorOrientation (p 3) (p 2) ∧ + (∀ orientation : Bool, + UnitOccurrenceOrientation q 1 orientation → + UnitTriangularStep orientation (BandVectors.1 (p 3) (p 2)) ∧ + ((p 3).1 = 0 ∨ orientation = true)) ∧ + (∀ orientation : Bool, + UnitOccurrenceOrientation q 2 orientation → + UnitTriangularStep orientation + ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (p 3) (p 2)) ∧ + ((p 2).1 = 0 ∨ orientation = false)) ∧ + ((p 2).1 = 1 → (p 3).1 = 1 → + UnitOccurrenceOrientation q 1 true ∧ + UnitOccurrenceOrientation q 2 false ∧ + UnitOccurrenceOrientation r 1 true ∧ + UnitOccurrenceOrientation r 2 false)) := by +-- BODY + classical + dsimp only + let I : GaussianInt := ⟨0, 1⟩ + let q : Fin 4 → CircleCoordinates := + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] + let r : Fin 4 → CircleCoordinates := + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + have nextProper (u : Fin 4 → CircleCoordinates) (hu : ProperBandQuadruple u) : + ProperBandQuadruple + ![(2 * (u 0).1 + 2 * (u 2).1 + 2 * (u 3).1 - (u 1).1, + 2 * (u 0).2 + 2 * (u 2).2 + 2 * (u 3).2 - (u 1).2), + u 0, u 2, u 3] := SmallRetainedSidesProof.nextProper u hu + have hq : ProperBandQuadruple q := nextProper p hp + have hr : ProperBandQuadruple r := nextProper q hq + have unit : ∀ {u : Fin 4 → CircleCoordinates} {k : Fin 3} {b : Bool}, + UnitOccurrenceOrientation u k b → (u k.succ).1 = 1 := SmallRetainedSidesProof.unit + have systemLaw : RecursiveVectorSystem BandVectors := by + simpa [BandVectors] using (Classical.choose_spec RecursiveVectorsExistUnique).1 + rcases systemLaw with ⟨_, baseLaw, stepLaw, flipLaw⟩ + have rootValues (z : GaussianInt) : + BandVectors.1 (0, -1) (1, 1 + 2 * z) = -I ∧ + BandVectors.1 (1, 1 + 2 * z) (1, 1 + 2 * z + 2 * I) = -1 + I ∧ + BandVectors.1 (1, 1 + 2 * z + 2 * I) (0, -1) = 1 ∧ + BandVectors.1 (1, 1 + 2 * z + 2 * I) (1, 1 + 2 * z) = 1 + I ∧ + BandVectors.1 (1, 1 + 2 * z) (0, 1) = -I ∧ + BandVectors.1 (0, 1) (1, 1 + 2 * z + 2 * I) = -1 := SmallRetainedSidesProof.rootValues p + baseLaw stepLaw flipLaw z + have data : + (PrimitiveVectorOrientation (p 2) (p 3) ∧ + (∀ o : Bool, ((p 3).1 = 0 ∨ o = false) → + UnitTriangularStep o (BandVectors.1 (p 3) (p 2))) ∧ + (∀ o : Bool, ((p 2).1 = 0 ∨ o = true) → + UnitTriangularStep o (I * BandVectors.1 (p 3) (p 2)))) ∨ + (PrimitiveVectorOrientation (p 3) (p 2) ∧ + (∀ o : Bool, ((p 3).1 = 0 ∨ o = true) → + UnitTriangularStep o (BandVectors.1 (p 3) (p 2))) ∧ + (∀ o : Bool, ((p 2).1 = 0 ∨ o = false) → + UnitTriangularStep o (I * BandVectors.1 (p 3) (p 2)))) := SmallRetainedSidesProof.data + p hp h2 h3 rootValues + rcases data with ⟨hd, stepB, stepD⟩ | ⟨hd, stepB, stepD⟩ + · refine Or.inl ⟨hd, ?_, ?_, ?_⟩ + · intro o cert + have label : (p 3).1 = 0 ∨ o = false := by + rcases h3 with zero | one + · exact Or.inl zero + · have selected : (p 2).1 = 1 := unit cert + have pair := P4566T1UnitPairCharts q hq 1 2 (by decide) selected one hd + exact Or.inr ((UnitOccurrenceOrientationUnique.1 q hq 1 selected).unique cert pair.1) + exact ⟨stepB o label, label⟩ + · intro o cert + have label : (p 2).1 = 0 ∨ o = true := by + rcases h2 with zero | one + · exact Or.inl zero + · have selected : (p 3).1 = 1 := unit cert + have pair := P4566T1UnitPairCharts q hq 1 2 (by decide) one selected hd + exact Or.inr ((UnitOccurrenceOrientationUnique.1 q hq 2 selected).unique cert pair.2) + exact ⟨stepD o label, label⟩ + · intro hb hdunit + have a := P4566T1UnitPairCharts q hq 1 2 (by decide) hb hdunit hd + have b := P4566T1UnitPairCharts r hr 1 2 (by decide) hb hdunit hd + exact ⟨a.1, a.2, b.1, b.2⟩ + · refine Or.inr ⟨hd, ?_, ?_, ?_⟩ + · intro o cert + have label : (p 3).1 = 0 ∨ o = true := by + rcases h3 with zero | one + · exact Or.inl zero + · have selected : (p 2).1 = 1 := unit cert + have pair := P4566T1UnitPairCharts q hq 2 1 (by decide) one selected hd + exact Or.inr ((UnitOccurrenceOrientationUnique.1 q hq 1 selected).unique cert pair.2) + exact ⟨stepB o label, label⟩ + · intro o cert + have label : (p 2).1 = 0 ∨ o = false := by + rcases h2 with zero | one + · exact Or.inl zero + · have selected : (p 3).1 = 1 := unit cert + have pair := P4566T1UnitPairCharts q hq 2 1 (by decide) selected one hd + exact Or.inr ((UnitOccurrenceOrientationUnique.1 q hq 2 selected).unique cert pair.1) + exact ⟨stepD o label, label⟩ + · intro hb hdunit + have a := P4566T1UnitPairCharts q hq 2 1 (by decide) hdunit hb hd + have b := P4566T1UnitPairCharts r hr 2 1 (by decide) hdunit hb hd + exact ⟨a.2, a.1, b.2, b.1⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4566T1StrictRetainedGenealogy.lean b/LeanPool/ApollonianSuperharmonic/P4566T1StrictRetainedGenealogy.lean new file mode 100644 index 0000000000..4b36743644 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4566T1StrictRetainedGenealogy.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4566T1LiteralSuccessorCharts +public import LeanPool.ApollonianSuperharmonic.BandOrientedBoundaryParentChain + +-- [TABLET NODE: P4566T1StrictRetainedGenealogy] + +/-! +# P4566T1StrictRetainedGenealogy + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4566T1StrictRetainedGenealogy + (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (hlarge : ¬ (((p 2).1 = 0 ∨ (p 2).1 = 1) ∧ + ((p 3).1 = 0 ∨ (p 3).1 = 1))) : + (∃ t : Fin 4 → CircleCoordinates, + ProperBandQuadruple t ∧ t 0 = p 2 ∧ t 1 = p 3 ∧ + (p 3).1 < (p 2).1 ∧ + ∀ orientation : Bool, + UnitOccurrenceOrientation p 2 orientation → + (((t 2).1 ≠ 1 → UnitOccurrenceOrientation t 0 orientation) ∧ + ((t 2).1 = 1 → + ((PrimitiveVectorOrientation (t 1) (t 2) ∧ orientation = false) ∨ + (PrimitiveVectorOrientation (t 2) (t 1) ∧ orientation = true))))) ∨ + ∃ t : Fin 4 → CircleCoordinates, + ProperBandQuadruple t ∧ t 0 = p 3 ∧ t 1 = p 2 ∧ + (p 2).1 < (p 3).1 ∧ + ∀ orientation : Bool, + UnitOccurrenceOrientation p 1 orientation → + (((t 3).1 ≠ 1 → UnitOccurrenceOrientation t 0 orientation) ∧ + ((t 3).1 = 1 → + ((PrimitiveVectorOrientation (t 1) (t 3) ∧ orientation = false) ∨ + (PrimitiveVectorOrientation (t 3) (t 1) ∧ orientation = true)))) := by +-- BODY + have unit : ∀ {u : Fin 4 → CircleCoordinates} {k : Fin 3} {b : Bool}, + UnitOccurrenceOrientation u k b → (u k.succ).1 = 1 := by + intro u k b cert + induction cert with + | leftLower z => rfl + | leftUpper z => rfl + | rightUpper z => rfl + | rightLower z => rfl + | @rotate u k b cert ih => fin_cases k <;> simpa using ih + | retainSecondToThird _ _ _ _ ih => exact ih + | retainSecondFromThird _ _ _ _ ih => exact ih + | retainSecondOther _ _ _ ih => exact ih + | retainThirdFromSecond _ _ _ _ ih => exact ih + | retainThirdToSecond _ _ _ _ ih => exact ih + | retainThirdOther _ _ _ ih => exact ih + let rot (u : Fin 4 → CircleCoordinates) := ![u 0, u 2, u 3, u 1] + have rot3 (u : Fin 4 → CircleCoordinates) : rot (rot (rot u)) = u := by + funext k + fin_cases k <;> rfl + have rotProper (u : Fin 4 → CircleCoordinates) (hu : ProperBandQuadruple u) : + ProperBandQuadruple (rot u) := by + refine ⟨SemiProperQuadruple.rotate hu.1, ?_⟩ + intro k + fin_cases k + · exact hu.2 1 + · exact hu.2 2 + · exact hu.2 0 + have unrotate {u : Fin 4 → CircleCoordinates} {k : Fin 3} {b : Bool} + (cert : UnitOccurrenceOrientation (rot u) (k + 2) b) : + UnitOccurrenceOrientation u k b := by + have h := UnitOccurrenceOrientation.rotate (UnitOccurrenceOrientation.rotate cert) + change UnitOccurrenceOrientation (rot (rot (rot u))) _ b at h + rw [rot3] at h + fin_cases k <;> simpa using h + have forced (u : Fin 4 → CircleCoordinates) (hu : ProperBandQuadruple u) + (a b : Fin 3) (hab : a ≠ b) (ha : (u a.succ).1 = 1) + (hb : (u b.succ).1 = 1) (o : Bool) (cert : UnitOccurrenceOrientation u a o) : + (PrimitiveVectorOrientation (u a.succ) (u b.succ) ∧ o = false) ∨ + (PrimitiveVectorOrientation (u b.succ) (u a.succ) ∧ o = true) := by + have tangent : BandTangency (u a.succ) (u b.succ) := + ⟨u, hu.1, a.succ, b.succ, by simpa using hab, rfl, rfl⟩ + rcases (PrimitiveVectorOrientationUnique _ _).2 tangent |>.2 with hd | hd + · have pair := P4566T1UnitPairCharts u hu a b hab ha hb hd.1 + exact Or.inl ⟨hd.1, (UnitOccurrenceOrientationUnique.1 u hu a ha).unique cert pair.1⟩ + · have pair := P4566T1UnitPairCharts u hu b a (Ne.symm hab) hb ha hd.1 + exact Or.inr ⟨hd.1, (UnitOccurrenceOrientationUnique.1 u hu a ha).unique cert pair.2⟩ + let Rel (u : Fin 4 → CircleCoordinates) : Prop := + (((u 2).1 = 0 ∨ (u 2).1 = 1) ∧ ((u 3).1 = 0 ∨ (u 3).1 = 1)) ∨ + (∃ t : Fin 4 → CircleCoordinates, + ProperBandQuadruple t ∧ t 0 = u 2 ∧ t 1 = u 3 ∧ (u 3).1 < (u 2).1 ∧ + ∀ o : Bool, UnitOccurrenceOrientation u 2 o → + (((t 2).1 ≠ 1 → UnitOccurrenceOrientation t 0 o) ∧ + ((t 2).1 = 1 → + ((PrimitiveVectorOrientation (t 1) (t 2) ∧ o = false) ∨ + (PrimitiveVectorOrientation (t 2) (t 1) ∧ o = true))))) ∨ + ∃ t : Fin 4 → CircleCoordinates, + ProperBandQuadruple t ∧ t 0 = u 3 ∧ t 1 = u 2 ∧ (u 2).1 < (u 3).1 ∧ + ∀ o : Bool, UnitOccurrenceOrientation u 1 o → + (((t 3).1 ≠ 1 → UnitOccurrenceOrientation t 0 o) ∧ + ((t 3).1 = 1 → + ((PrimitiveVectorOrientation (t 1) (t 3) ∧ o = false) ∨ + (PrimitiveVectorOrientation (t 3) (t 1) ∧ o = true)))) + have claim : ∀ u, SemiProperQuadruple u → ProperBandQuadruple u → + Rel u ∧ Rel (rot u) ∧ Rel (rot (rot u)) := by + intro u hs + induction hs with + | base z => + intro hu + have bad := hu.2 0 + simp at bad + | @rotate u hs ih => + intro hu + have old : ProperBandQuadruple u := by + refine ⟨hs, ?_⟩ + intro k + fin_cases k + · exact hu.2 2 + · exact hu.2 0 + · exact hu.2 1 + change Rel (rot u) ∧ Rel (rot (rot u)) ∧ Rel (rot (rot (rot u))) + rw [rot3] + exact ⟨(ih old).2.1, (ih old).2.2, (ih old).1⟩ + | @successor u hs ih => + intro hu + let s : Fin 4 → CircleCoordinates := + ![(2 * (u 0).1 + 2 * (u 2).1 + 2 * (u 3).1 - (u 1).1, + 2 * (u 0).2 + 2 * (u 2).2 + 2 * (u 3).2 - (u 1).2), + u 0, u 2, u 3] + change Rel s ∧ Rel (rot s) ∧ Rel (rot (rot s)) + rcases (SemiProperForestClassification u hs).2 with root | root | root | old + · rcases root with ⟨z, hz⟩ + simp [s, rot, Rel, hz] + · rcases root with ⟨z, hz⟩ + simp [s, rot, Rel, hz] + · rcases root with ⟨z, hz⟩ + simp [s, rot, Rel, hz] + · have charts := P4566T1LiteralSuccessorCharts u old + have inherited : Rel s := by + rcases (ih old).1 with small | ⟨t, ht, ht0, ht1, hlt, transport⟩ | + ⟨t, ht, ht0, ht1, hlt, transport⟩ + · exact Or.inl small + · refine Or.inr (Or.inl ⟨t, ht, ht0, ht1, hlt, ?_⟩) + intro o cert + exact transport o ((charts.2 (unit cert) o).mp cert) + · refine Or.inr (Or.inr ⟨t, ht, ht0, ht1, hlt, ?_⟩) + intro o cert + exact transport o ((charts.1 (unit cert) o).mp cert) + have second : Rel (rot s) := by + refine Or.inr (Or.inr ⟨rot (rot u), rotProper _ (rotProper u old), + rfl, rfl, old.2 2, ?_⟩) + intro o cert + have current : UnitOccurrenceOrientation s 2 o := + unrotate (k := 2) (by simpa using cert) + have selected : (u 3).1 = 1 := unit current + constructor + · intro hidden + have previous := (charts.2 selected o).mp current + have moved := UnitOccurrenceOrientation.rotate + (UnitOccurrenceOrientation.rotate previous) + simpa [rot] using moved + · intro hidden + exact forced s hu 2 1 (by decide) selected hidden o current + have third : Rel (rot (rot s)) := by + refine Or.inr (Or.inl ⟨rot u, rotProper u old, + rfl, rfl, old.2 1, ?_⟩) + intro o cert + have current : UnitOccurrenceOrientation s 1 o := by + have moved := UnitOccurrenceOrientation.rotate cert + change UnitOccurrenceOrientation (rot (rot (rot s))) _ o at moved + rw [rot3] at moved + simpa [rot] using moved + have selected : (u 2).1 = 1 := unit current + constructor + · intro hidden + have previous := (charts.1 selected o).mp current + have moved := UnitOccurrenceOrientation.rotate previous + simpa using moved + · intro hidden + exact forced s hu 1 2 (by decide) selected hidden o current + exact ⟨inherited, second, third⟩ + rcases (claim p hp.1 hp).1 with small | first | second + · exact (hlarge small).elim + · exact Or.inl first + · exact Or.inr second + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4566T1UnitPairCharts.lean b/LeanPool/ApollonianSuperharmonic/P4566T1UnitPairCharts.lean new file mode 100644 index 0000000000..d5d24f9802 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4566T1UnitPairCharts.lean @@ -0,0 +1,149 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure + +-- [TABLET NODE: P4566T1UnitPairCharts] + +/-! +# P4566T1UnitPairCharts + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4566T1UnitPairCharts + (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (i j : Fin 3) (hij : i ≠ j) + (hi : (p i.succ).1 = 1) (hj : (p j.succ).1 = 1) + (hd : PrimitiveVectorOrientation (p i.succ) (p j.succ)) : + UnitOccurrenceOrientation p i false ∧ + UnitOccurrenceOrientation p j true := by +-- BODY + have noReverse {A B : CircleCoordinates} + (h : PrimitiveVectorOrientation A B) : ¬ PrimitiveVectorOrientation B A := by + have ht := (PrimitiveVectorOrientationUnique A B).1 h + rcases (PrimitiveVectorOrientationUnique A B).2 ht |>.2 with hd | hd + · exact hd.2 + · exact (hd.2 h).elim + let Charts (u : Fin 4 → CircleCoordinates) : Prop := + ∀ i j : Fin 3, i ≠ j → (u i.succ).1 = 1 → (u j.succ).1 = 1 → + PrimitiveVectorOrientation (u i.succ) (u j.succ) → + UnitOccurrenceOrientation u i false ∧ UnitOccurrenceOrientation u j true + have leftSeed (z : GaussianInt) : Charts + ![(4, 1 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z), (0, -1), (1, 1 + 2 * z + 2 * ⟨0, 1⟩)] := by + intro a b hab ha hb hd + fin_cases a <;> fin_cases b + all_goals simp? at ha hb hd + all_goals try { exact (hab rfl).elim } + · exact (noReverse (PrimitiveVectorOrientation.base10 z) hd).elim + · exact ⟨UnitOccurrenceOrientation.leftUpper z, UnitOccurrenceOrientation.leftLower z⟩ + have rightSeed (z : GaussianInt) : Charts + ![(4, 7 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (0, 1)] := by + intro a b hab ha hb hd + fin_cases a <;> fin_cases b + all_goals simp? at ha hb hd + all_goals try { exact (hab rfl).elim } + · exact (noReverse (PrimitiveVectorOrientation.base10 z) hd).elim + · exact ⟨UnitOccurrenceOrientation.rightLower z, UnitOccurrenceOrientation.rightUpper z⟩ + have large (u : Fin 4 → CircleCoordinates) (hu : ProperBandQuadruple u) : + 1 < (u 0).1 := by + have facts := ProperBandCurvatureStructure u hu + have h0 := facts.2.1 0 + have h1 := facts.2.1 1 + have l0 := hu.2 0 + have l1 := hu.2 1 + by_contra hn + have z0 : (u (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (u (1 : Fin 3).succ).1 = 0 := by omega + exact (by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1) + have claim : ∀ u, SemiProperQuadruple u → ProperBandQuadruple u → Charts u := by + intro u hs + induction hs with + | base z => + intro hu + have bad := hu.2 0 + simp at bad + | @rotate u hs ih => + intro hu + have old : ProperBandQuadruple u := by + refine ⟨hs, ?_⟩ + intro k + fin_cases k + · simpa using hu.2 2 + · simpa using hu.2 0 + · simpa using hu.2 1 + intro a b hab ha hb hd + have hne : a + 1 ≠ b + 1 := by + fin_cases a <;> fin_cases b <;> simp_all + have ea : u (a + 1).succ = (![u 0, u 2, u 3, u 1] a.succ) := by + fin_cases a <;> rfl + have eb : u (b + 1).succ = (![u 0, u 2, u 3, u 1] b.succ) := by + fin_cases b <;> rfl + have pair := ih old (a + 1) (b + 1) hne (by simpa [ea] using ha) + (by simpa [eb] using hb) (by simpa [ea, eb] using hd) + constructor + · have cert := UnitOccurrenceOrientation.rotate pair.1 + fin_cases a <;> simpa using cert + · have cert := UnitOccurrenceOrientation.rotate pair.2 + fin_cases b <;> simpa using cert + | @successor u hs ih => + intro hu + rcases (SemiProperForestClassification u hs).2 with root | root | root | old + · rcases root with ⟨z, hz⟩ + have bad := hu.2 0 + simp [hz] at bad + · rcases root with ⟨z, hz⟩ + have eq : + ![(2 * (u 0).1 + 2 * (u 2).1 + 2 * (u 3).1 - (u 1).1, + 2 * (u 0).2 + 2 * (u 2).2 + 2 * (u 3).2 - (u 1).2), + u 0, u 2, u 3] = + ![(4, 1 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z), (0, -1), (1, 1 + 2 * z + 2 * ⟨0, 1⟩)] := by + rw [hz] + funext k + fin_cases k <;> simp; ring + rw [eq] + exact leftSeed z + · rcases root with ⟨z, hz⟩ + have eq : + ![(2 * (u 0).1 + 2 * (u 2).1 + 2 * (u 3).1 - (u 1).1, + 2 * (u 0).2 + 2 * (u 2).2 + 2 * (u 3).2 - (u 1).2), + u 0, u 2, u 3] = + ![(4, 7 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (0, 1)] := by + rw [hz] + funext k + fin_cases k <;> simp; ring + rw [eq] + exact rightSeed z + · have hl := large u old + intro a b hab ha hb hd + fin_cases a <;> fin_cases b + all_goals simp at ha hb hd + all_goals try { exact (hab rfl).elim } + all_goals try { omega } + · have pair := ih old 1 2 (by decide) ha hb hd + exact ⟨UnitOccurrenceOrientation.retainSecondToThird old hb hd pair.1, + UnitOccurrenceOrientation.retainThirdFromSecond old ha hd pair.2⟩ + · have pair := ih old 2 1 (by decide) ha hb hd + exact ⟨UnitOccurrenceOrientation.retainThirdToSecond old hb hd pair.1, + UnitOccurrenceOrientation.retainSecondFromThird old ha hd pair.2⟩ + exact claim p hp.1 hp i j hij hi hj hd + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1CentralDiskSectors.lean b/LeanPool/ApollonianSuperharmonic/P4590T1CentralDiskSectors.lean new file mode 100644 index 0000000000..7190161fe6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4590T1CentralDiskSectors.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4590T1RotationalDiskCenter +public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import Mathlib.Tactic.FinCases + +-- [TABLET NODE: P4590T1CentralDiskSectors] + +/-! +# P4590T1CentralDiskSectors + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4590T1CentralDiskSectors (T : ProtoTile) (hT : LatticeTile T) + (hQ : QuarterTurnSymmetric T) (x : GaussianInt) + (hcent : TileCentroid T = GaussianRealPoint x) : + ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells := by +-- BODY + have hc : GaussianRealPoint x ∈ TileRealization T := by + apply P4590T1RotationalDiskCenter _ hT + intro p hp + simpa only [← hcent] using (hQ p).mp hp + obtain ⟨a, hsq⟩ := Set.mem_iUnion.mp hc + obtain ⟨ha, hsq⟩ := Set.mem_iUnion.mp hsq + have haAt : a = x ∨ a = x - 1 ∨ a = x - 1 - ⟨0, 1⟩ ∨ + a = x - ⟨0, 1⟩ := by + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, + GaussianRealPoint] at hsq + have hre : a.re = x.re ∨ a.re = x.re - 1 := by + have h1 : a.re ≤ x.re := by exact_mod_cast hsq.1.1 + have h2 : x.re ≤ a.re + 1 := by exact_mod_cast hsq.2.1 + omega + have him : a.im = x.im ∨ a.im = x.im - 1 := by + have h1 : a.im ≤ x.im := by exact_mod_cast hsq.1.2 + have h2 : x.im ≤ a.im + 1 := by exact_mod_cast hsq.2.2 + omega + rcases hre with hr | hr <;> rcases him with hi | hi + · exact Or.inl (by ext <;> assumption) + · exact Or.inr (Or.inr (Or.inr (by ext <;> simp_all))) + · exact Or.inr (Or.inl (by ext <;> simp_all)) + · exact Or.inr (Or.inr (Or.inl (by ext <;> simp_all))) + have rotate (j : Fin 4) (hj : LatticeVertexIncidentCell x j ∈ T.cells) : + LatticeVertexIncidentCell x (j + 1) ∈ T.cells := by + let p : Real × Real := + (((LatticeVertexIncidentCell x j).re : Real) + 1 / 2, + ((LatticeVertexIncidentCell x j).im : Real) + 1 / 2) + have hp := (hQ p).mp (by + simpa only [p, GaussianRealPoint, Prod.mk_add_mk] using + (P3776T1CellCenterMembership T _).mpr hj) + rw [hcent] at hp + have heq : + ((GaussianRealPoint x).1 - (p.2 - (GaussianRealPoint x).2), + (GaussianRealPoint x).2 + (p.1 - (GaussianRealPoint x).1)) = + (((LatticeVertexIncidentCell x (j + 1)).re : Real) + 1 / 2, + ((LatticeVertexIncidentCell x (j + 1)).im : Real) + 1 / 2) := by + fin_cases j <;> ext <;> + simp [p, LatticeVertexIncidentCell, GaussianRealPoint] <;> ring + change ((GaussianRealPoint x).1 - (p.2 - (GaussianRealPoint x).2), + (GaussianRealPoint x).2 + (p.1 - (GaussianRealPoint x).1)) ∈ TileRealization T at hp + rw [heq] at hp + exact (P3776T1CellCenterMembership T _).mp (by + simpa only [GaussianRealPoint, Prod.mk_add_mk] using hp) + have hsome : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells := by + rcases haAt with rfl | rfl | rfl | rfl + · exact ⟨0, ha⟩ + · exact ⟨1, ha⟩ + · exact ⟨2, ha⟩ + · exact ⟨3, ha⟩ + obtain ⟨j, hj⟩ := hsome + have hj1 := rotate j hj + have hj2 := rotate (j + 1) hj1 + have hj3 := rotate (j + 1 + 1) hj2 + intro k + fin_cases j <;> fin_cases k <;> assumption + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean new file mode 100644 index 0000000000..62fe629062 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean @@ -0,0 +1,2251 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralGeometricSectors +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells +public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention +public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.P4590T1PositivePrototileDisk +public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.P4055T1BandQuarterTurn +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEndpointPairUnique +public import LeanPool.ApollonianSuperharmonic.P4616T1ThirdOwnerPathEndpoint + +-- [TABLET NODE: P4590T1JunctionRefinement] + +/-! +# P4590T1JunctionRefinement + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace JunctionRefinementGeometry + +private theorem htransZero : + (by + classical + exact + GaussianTranslation (0 : GaussianInt) = id ) := by + classical + funext z + exact add_zero z + +private theorem incident : + (by + classical + exact + ∀ (W : ProtoTile), ∀ (y : GaussianInt), (W.cells.Nonempty) → ((y ∈ FootprintVertices W) → + (∃ j : Fin 4, LatticeVertexIncidentCell y j ∈ W.cells)) ) := by + classical + intro W y hne hy + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hy + rcases hy with ⟨c, hc, h | h | h | h⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using h ▸ hc⟩ + · refine ⟨1, ?_⟩ + rw [h] + simpa [LatticeVertexIncidentCell] using hc + · refine ⟨3, ?_⟩ + rw [h] + simpa [LatticeVertexIncidentCell] using hc + · refine ⟨2, ?_⟩ + change y - 1 - ⟨0, 1⟩ ∈ W.cells + rw [h] + convert hc using 1 + ext <;> simp + +private theorem hfourCells : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T.cells) → (x ∈ T.cells ∧ x - 1 ∈ T.cells ∧ x - 1 - ⟨0, 1⟩ ∈ T.cells ∧ x - ⟨0, 1⟩ ∈ + T.cells) ) := by + classical + intro T x hmissingT + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa [LatticeVertexIncidentCell] using hmissingT 0 + · simpa [LatticeVertexIncidentCell] using hmissingT 1 + · simpa [LatticeVertexIncidentCell] using hmissingT 2 + · simpa [LatticeVertexIncidentCell] using hmissingT 3 + +private theorem incidentCorner : + (by + classical + exact + ∀ (W : ProtoTile), ∀ (y : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell y j ∈ + W.cells) → (y ∈ FootprintVertices W) ) := by + classical + intro W y j hc + have hne : W.cells.Nonempty := ⟨_, hc⟩ + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] + refine ⟨LatticeVertexIncidentCell y j, hc, ?_⟩ + fin_cases j <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] + +private theorem singletonCorner : + (by + classical + exact + ∀ (y : GaussianInt), ∀ (a : GaussianInt), (y = a ∨ y = a + 1 ∨ y = a + ⟨0, 1⟩ ∨ + y = a + 1 + ⟨0, 1⟩) → (y ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile)) ) := by + classical + intro y a hc + simp only [FootprintVertices, Finset.singleton_nonempty, ite_true, + Set.mem_ofPred_eq] + exact ⟨a, Finset.mem_singleton_self a, hc⟩ + +private theorem incidentSingleton : + (by + classical + exact + (∀ (y : GaussianInt), ∀ (a : GaussianInt), (y = a ∨ y = a + 1 ∨ y = a + ⟨0, 1⟩ ∨ y = a + + 1 + ⟨0, 1⟩) → (y ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile))) → (∀ (y : GaussianInt), + ∀ (j : Fin 4), y ∈ FootprintVertices (⟨{LatticeVertexIncidentCell y j}, + LatticeVertexIncidentCell y j⟩ : ProtoTile)) ) := by + classical + intro singletonCorner y j + apply singletonCorner + fin_cases j <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] + +private theorem supportedToFootprint : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (y : GaussianInt), (y ∈ CellSupportedFootprintVertices cert.O) → (y ∈ + FootprintVertices cert.O) ) := by + classical + intro q cfg C T cert y hy + by_cases hO : cert.O.cells.Nonempty + · simpa [CellSupportedFootprintVertices, FootprintVertices, hO] using hy + · have hempty : cert.O.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hO + simp [CellSupportedFootprintVertices, hempty] at hy + +private theorem precursorIsolationSupported : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (GaussianTranslation (0 : GaussianInt) = id) → ((∀ (y : GaussianInt), (y ∈ + CellSupportedFootprintVertices cert.O) → (y ∈ FootprintVertices cert.O)) → (∀ y ∈ + CellSupportedFootprintVertices cert.O, ∀ a : GaussianInt, y ∈ FootprintVertices + (⟨{a}, a⟩ : ProtoTile) → a ∈ (cert.P 0 true).cells ∨ a ∈ (cert.P 0 false).cells)) ) + := by + classical + intro q cfg C T cert htransZero supportedToFootprint y hy a hya + have hyfoot := supportedToFootprint y hy + have hisolated := cert.precursor_isolated 0 0 y + (by simpa [TileTranslation, GaussianTranslation, htransZero, + Finset.image_id] using hyfoot) a hya + simpa [SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation, htransZero, Finset.image_id] using hisolated + +private theorem blockSeparation : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (GaussianTranslation (0 : GaussianInt) = id) → (((∀ (m : ℤ), ∀ (n : ℤ), ∀ (x : + LatticeCell), x ∈ (TileTranslation T ((↑m : GaussianInt) * cert.u + (↑n : + GaussianInt) * cert.v)).cells ↔ ∃ (label : SixSubtileLabel), x ∈ + (ModifiedSubtileOccurrenceInterpretation cert.P cert.O cert.u cert.v ⟨label, m, + n⟩).cells) ∧ ∀ (m : ℤ), ∀ (n : ℤ), ∀ (r : ℤ), ∀ (s : ℤ), (m, n) ≠ (r, s) → Disjoint + (TileTranslation T ((↑m : GaussianInt) * cert.u + (↑n : GaussianInt) * cert.v)).cells + (TileTranslation T ((↑r : GaussianInt) * cert.u + (↑s : GaussianInt) * + cert.v)).cells) → (∀ (m : Int), ∀ (n : Int), ((m, n) ≠ (0, 0)) → (Disjoint T.cells + (TileTranslation T ((m : GaussianInt) * cert.u + (n : GaussianInt) * + cert.v)).cells))) ) := by + classical + intro q cfg C T cert htransZero hblocks m n hmn + have h := hblocks.2 0 0 m n hmn.symm + simpa [TileTranslation, GaussianTranslation, htransZero, Finset.image_id] using h + +private theorem tileCellInBlock : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ((∀ (m : ℤ), ∀ (n : ℤ), ∀ (x : LatticeCell), x ∈ (TileTranslation T ((↑m : + GaussianInt) * cert.u + (↑n : GaussianInt) * cert.v)).cells ↔ ∃ (label : + SixSubtileLabel), x ∈ (ModifiedSubtileOccurrenceInterpretation cert.P cert.O cert.u + cert.v ⟨label, m, n⟩).cells) ∧ ∀ (m : ℤ), ∀ (n : ℤ), ∀ (r : ℤ), ∀ (s : ℤ), (m, n) ≠ + (r, s) → Disjoint (TileTranslation T ((↑m : GaussianInt) * cert.u + (↑n : + GaussianInt) * cert.v)).cells (TileTranslation T ((↑r : GaussianInt) * cert.u + (↑s : + GaussianInt) * cert.v)).cells) → (∀ (label : SixSubtileLabel), ∀ (m : Int), ∀ (n : + Int), ∀ (a : GaussianInt), (a ∈ (cert.modified.tile ⟨label, m, n⟩).cells) → (a ∈ + (TileTranslation T ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells)) + ) := by + classical + intro q cfg C T cert hblocks label m n a ha + apply (hblocks.1 m n a).2 + exact ⟨label, by simpa [cert.modified_tile] using ha⟩ + +private theorem hBtile : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (GaussianTranslation (0 : GaussianInt) = id) → ( + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + cert.modified.tile b = cert.P 0 false) ) := by + classical + intro q cfg C T cert htransZero b + rw [cert.modified_tile] + simp [b, ModifiedSubtileOccurrenceInterpretation, TileTranslation, htransZero] + +private theorem hCtile : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (GaussianTranslation (0 : GaussianInt) = id) → ( + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + cert.modified.tile c = cert.P 1 true) ) := by + classical + intro q cfg C T cert htransZero c + rw [cert.modified_tile] + simp [c, ModifiedSubtileOccurrenceInterpretation, TileTranslation, htransZero] + +private theorem hthirdABC : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (GaussianTranslation (0 : GaussianInt) = id) → ((∀ (W : + ProtoTile), ∀ (y : GaussianInt), (W.cells.Nonempty) → ((y ∈ FootprintVertices W) → (∃ + j : Fin 4, LatticeVertexIncidentCell y j ∈ W.cells))) → ((∀ (W : ProtoTile), ∀ (y : + GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell y j ∈ W.cells) → (y ∈ + FootprintVertices W)) → ((∀ (y : GaussianInt), ∀ (j : Fin 4), y ∈ FootprintVertices + (⟨{LatticeVertexIncidentCell y j}, LatticeVertexIncidentCell y j⟩ : ProtoTile)) → + (((cert.P (0 : Fin (3 : ℕ)) true).cells ∩ (cert.P (0 : Fin (3 : ℕ)) false).cells = + cert.O.cells) → ((Disjoint (cert.P 0 false).cells (cert.P 1 true).cells) → ((Disjoint + (cert.P 0 true).cells (cert.P 1 true).cells) → ((x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 true)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + (cert.P 0 true).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.P 0 false).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.P 1 true).cells)))))))) ) := by + classical + intro q cfg C T cert x htransZero incident incidentCorner incidentSingleton hABO hBCseparate + hACseparate hABC + obtain ⟨jA, hjA⟩ := incident (cert.P 0 true) x + (LatticeTileGridStructure _ (cert.parent_lattice 0 true)).1.1 hABC.1 + have hnotC : LatticeVertexIncidentCell x jA ∉ (cert.P 1 true).cells := by + intro hC + exact (Finset.disjoint_left.mp hACseparate hjA hC).elim + have hnotB : LatticeVertexIncidentCell x jA ∉ (cert.P 0 false).cells := by + intro hB + have hO : LatticeVertexIncidentCell x jA ∈ cert.O.cells := by + rw [← hABO] + exact Finset.mem_inter.mpr ⟨hjA, hB⟩ + have hxO : x ∈ FootprintVertices cert.O := incidentCorner cert.O x jA hO + obtain ⟨jC, hjC⟩ := incident (cert.P 1 true) x + (LatticeTileGridStructure _ (cert.parent_lattice 1 true)).1.1 hABC.2.2 + let a := LatticeVertexIncidentCell x jC + have hisolated := cert.precursor_isolated 0 0 x + (by simpa [TileTranslation, GaussianTranslation, htransZero, + Finset.image_id] using hxO) a + (incidentSingleton x jC) + have hab : a ∈ (cert.P 0 true).cells ∨ a ∈ (cert.P 0 false).cells := by + simpa [a, SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation] using hisolated + rcases hab with ha | hb + · exact (Finset.disjoint_left.mp hACseparate ha hjC).elim + · exact (Finset.disjoint_left.mp hBCseparate hb hjC).elim + exact ⟨jA, hjA, hnotB, hnotC⟩ + +private theorem hxBC : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + (cert.modified.tile b = cert.P 0 false) → ((cert.modified.tile c = cert.P 1 true) → ((x ∈ + FootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) ∧ x ∈ FootprintVertices (cert.P (0 + : Fin (3 : ℕ)) false) ∧ x ∈ FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true)) → (x ∈ + FootprintVertices (cert.modified.tile b) ∩ FootprintVertices (cert.modified.tile + c)))) ) := by + classical + intro q cfg C T cert x b c hBtile hCtile hABC + simpa [hBtile, hCtile] using ⟨hABC.2.1, hABC.2.2⟩ + +private theorem hxv : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + (cert.modified.plane.adjacent b c) → ((PeriodicTileAdjacentContactRegularity + cert.modified) → ((x ∈ FootprintVertices (cert.modified.tile b) ∩ FootprintVertices + (cert.modified.tile c)) → (x ∈ CommonFootprintEdgeVertices (cert.modified.tile b) + (cert.modified.tile c)))) ) := by + classical + intro q cfg C T cert x b c hbc hregular hxBC + rw [← hregular.adjacent_raw_eq_edge_vertices b c hbc] + exact hxBC + +private theorem classifyBCface : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + ∀ (F : cert.modified.plane.Face), ((∃ i, cert.modified.plane.faceVertex F i = b) ∧ + ∃ i, cert.modified.plane.faceVertex F i = c) → (cert.modified_face_equiv F = ⟨.I1, 0, + 0⟩ ∨ cert.modified_face_equiv F = ⟨.J3, -1, -1⟩) ) := by + classical + intro q cfg C T cert b c F hF + obtain ⟨i, hi⟩ := hF.1 + obtain ⟨j, hj⟩ := hF.2 + rw [cert.modified_face_vertices] at hi hj + generalize hidx : cert.modified_face_equiv F = face at hi hj ⊢ + rcases face with ⟨label, m, n⟩ + cases label <;> fin_cases i <;> fin_cases j <;> + simp [SixSubtileFaceVertices, b, c] at hi hj ⊢ <;> omega + +private theorem rhoFace : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), + (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm face)) ) := by + classical + intro q cfg C T cert F face hF + have hEq : F = cert.modified_face_equiv.symm face := by + have hh := congrArg cert.modified_face_equiv.symm hF + simpa using hh + rw [hEq, cert.modified_face_points] + +private theorem hfpoint : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (f : cert.modified.plane.Face), ((cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) f = (⟨SixSubtileFaceLabel.I1, (0 + : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) f = (⟨SixSubtileFaceLabel.J3, + (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( + let p1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let pJ := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J3, -1, -1⟩) + (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), + (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho f = p1 ∨ + cert.modified.rho f = pJ)) ) := by + classical + intro q cfg C T cert f hfclass p1 pJ rhoFace + rcases hfclass with h | h + · exact Or.inl (by simpa [p1] using rhoFace f _ h) + · exact Or.inr (by simpa [pJ] using rhoFace f _ h) + +private theorem hgpoint : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (g : cert.modified.plane.Face), ((cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) g = (⟨SixSubtileFaceLabel.I1, (0 + : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) g = (⟨SixSubtileFaceLabel.J3, + (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( + let p1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let pJ := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J3, -1, -1⟩) + (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), + (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho g = p1 ∨ + cert.modified.rho g = pJ)) ) := by + classical + intro q cfg C T cert g hgclass p1 pJ rhoFace + rcases hgclass with h | h + · exact Or.inl (by simpa [p1] using rhoFace g _ h) + · exact Or.inr (by simpa [pJ] using rhoFace g _ h) + +private theorem hx_p1_or_pJ : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (f : cert.modified.plane.Face), ∀ (g : + cert.modified.plane.Face), (x = cert.modified.rho f ∨ x = cert.modified.rho g) → ( + let p1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let pJ := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J3, -1, -1⟩) + (cert.modified.rho f = p1 ∨ cert.modified.rho f = pJ) → ((cert.modified.rho g = p1 ∨ + cert.modified.rho g = pJ) → (x = p1 ∨ x = pJ))) ) := by + classical + intro q cfg C T cert x f g hxendpoint p1 pJ hfpoint hgpoint + rcases hxendpoint with h | h + · rcases hfpoint with hF | hF + · exact Or.inl (h.trans hF) + · exact Or.inr (h.trans hF) + · rcases hgpoint with hG | hG + · exact Or.inl (h.trans hG) + · exact Or.inr (h.trans hG) + +private theorem hJvertex : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let faceJ : PeriodicSubtileFaceIndex := ⟨.J3, -1, -1⟩ + let aJ : PeriodicSubtileIndex := ⟨.A, -1, -1⟩ + cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ) 0 = aJ ) := by + classical + intro q cfg C T cert faceJ aJ + rw [cert.modified_face_vertices] + simp [faceJ, aJ, SixSubtileFaceVertices] + +private theorem hpJa : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let pJ := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J3, -1, -1⟩) + let faceJ : PeriodicSubtileFaceIndex := ⟨.J3, -1, -1⟩ + let aJ : PeriodicSubtileIndex := ⟨.A, -1, -1⟩ + (cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ) 0 = aJ) → (pJ ∈ + FootprintVertices (cert.modified.tile aJ)) ) := by + classical + intro q cfg C T cert pJ faceJ aJ hJvertex + have h := cert.modified.rho_common (cert.modified_face_equiv.symm faceJ) 0 + rw [cert.modified_face_points, hJvertex] at h + simpa [pJ, faceJ] using h + +private theorem hblockSep : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (∀ (m : Int), ∀ (n : Int), ((m, n) ≠ (0, 0)) → (Disjoint T.cells (TileTranslation + T ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells)) → (Disjoint + T.cells (TileTranslation T ((-1 : GaussianInt) * cert.u + (-1 : GaussianInt) * + cert.v)).cells) ) := by + classical + intro q cfg C T cert blockSeparation + exact blockSeparation (-1) (-1) (by decide) + +private theorem htranslatedCell : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (∀ (label : SixSubtileLabel), ∀ (m : Int), ∀ (n : Int), ∀ (a : GaussianInt), (a ∈ + (cert.modified.tile ⟨label, m, n⟩).cells) → (a ∈ (TileTranslation T ((m : + GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells)) → ( + let aJ : PeriodicSubtileIndex := ⟨.A, -1, -1⟩ + ∀ (a : GaussianInt), (a ∈ (cert.modified.tile aJ).cells) → (a ∈ (TileTranslation T ((-1 : + GaussianInt) * cert.u + (-1 : GaussianInt) * cert.v)).cells)) ) := by + classical + intro q cfg C T cert tileCellInBlock aJ a ha + exact tileCellInBlock .A (-1) (-1) a (by simpa [aJ] using ha) + +private theorem hp1C : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (GaussianTranslation (0 : GaussianInt) = id) → ( + let p1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + p1 ∈ FootprintVertices (cert.P 1 true)) ) := by + classical + intro q cfg C T cert htransZero p1 + let faceI : PeriodicSubtileFaceIndex := ⟨.I1, 0, 0⟩ + let cI : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + have hvertex : cert.modified.plane.faceVertex + (cert.modified_face_equiv.symm faceI) 2 = cI := by + rw [cert.modified_face_vertices] + simp [faceI, cI, SixSubtileFaceVertices] + have h := cert.modified.rho_common + (cert.modified_face_equiv.symm faceI) 2 + rw [hvertex, cert.modified_tile, cert.modified_face_points] at h + simpa [p1, faceI, cI, ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation, htransZero, Finset.image_id] using h + +private theorem hAtile : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (GaussianTranslation (0 : GaussianInt) = id) → ( + let a0 : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + cert.modified.tile a0 = TileCellComplement (cert.P 0 true) cert.O) ) := by + classical + intro q cfg C T cert htransZero a0 + rw [cert.modified_tile] + simp [a0, ModifiedSubtileOccurrenceInterpretation, + TileTranslation, htransZero] + +private theorem hDtile : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (GaussianTranslation (0 : GaussianInt) = id) → ( + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + cert.modified.tile d0 = cert.P 1 false) ) := by + classical + intro q cfg C T cert htransZero d0 + rw [cert.modified_tile] + simp [d0, ModifiedSubtileOccurrenceInterpretation, + TileTranslation, htransZero] + +private theorem hOinA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ((cert.P (0 : Fin (3 : ℕ)) true).cells ∩ (cert.P (0 : Fin (3 : ℕ)) false).cells = + cert.O.cells) → (cert.O.cells ⊆ (cert.P 0 true).cells) ) := by + classical + intro q cfg C T cert hABO z hz + have hz' : z ∈ (cert.P 0 true).cells ∩ (cert.P 0 false).cells := by + rw [hABO] + exact hz + exact (Finset.mem_inter.mp hz').1 + +private theorem hAcompne : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let a0 : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + (cert.modified.tile a0 = TileCellComplement (cert.P 0 true) cert.O) → + ((TileCellComplement (cert.P 0 true) cert.O).cells.Nonempty) ) := by + classical + intro q cfg C T cert a0 hAtile + rw [← hAtile] + exact (LatticeTileGridStructure _ (cert.modified.tiles_are_disks a0)).1.1 + +private theorem hxAD : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (x ∈ FootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) ∧ x ∈ + FootprintVertices (cert.P (0 : Fin (3 : ℕ)) false) ∧ x ∈ FootprintVertices (cert.P (1 + : Fin (3 : ℕ)) false)) → ( + let a0 : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + (cert.modified.tile a0 = TileCellComplement (cert.P 0 true) cert.O) → + ((cert.modified.tile d0 = cert.P 1 false) → ((FootprintVertices (TileCellComplement + (cert.P 0 true) cert.O) ∩ FootprintVertices (cert.P 1 false) = FootprintVertices + (cert.P 0 true) ∩ FootprintVertices (cert.P 1 false)) → (x ∈ FootprintVertices + (cert.modified.tile a0) ∩ FootprintVertices (cert.modified.tile d0))))) ) := by + classical + intro q cfg C T cert x hABD a0 d0 hAtile hDtile hADvertices + rw [hAtile, hDtile] + exact hADvertices.symm ▸ (show x ∈ FootprintVertices (cert.P 0 true) ∩ + FootprintVertices (cert.P 1 false) from ⟨hABD.1, hABD.2.2⟩) + +private theorem had : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let a0 : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + cert.modified.plane.adjacent a0 d0 ) := by + classical + intro q cfg C T cert a0 d0 + exact (cert.modified_adjacency a0 d0).mpr + (AllowedSubtileIncidence.AD 0 0) + +private theorem hADdis : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let a0 : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + (cert.modified.tile a0 = TileCellComplement (cert.P 0 true) cert.O) → + ((cert.modified.tile d0 = cert.P 1 false) → ((Disjoint (cert.P 1 false).cells (cert.P + 0 true).cells) → (Disjoint (cert.modified.tile a0).cells (cert.modified.tile + d0).cells))) ) := by + classical + intro q cfg C T cert a0 d0 hAtile hDtile hDA + rw [hAtile, hDtile] + apply Finset.disjoint_left.mpr + intro z hzA hzD + exact (Finset.disjoint_left.mp hDA hzD (Finset.mem_sdiff.mp hzA).1).elim + +private theorem hthirdABD : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (∀ (W : ProtoTile), ∀ (y : GaussianInt), (W.cells.Nonempty) + → ((y ∈ FootprintVertices W) → (∃ j : Fin 4, LatticeVertexIncidentCell y j ∈ + W.cells))) → (((cert.P (0 : Fin (3 : ℕ)) true).cells ∩ (cert.P (0 : Fin (3 : ℕ)) + false).cells = cert.O.cells) → ( + let a0 : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + (cert.modified.tile a0 = TileCellComplement (cert.P 0 true) cert.O) → + ((cert.modified.tile d0 = cert.P 1 false) → ((Disjoint (cert.P 1 false).cells (cert.P + 0 false).cells) → ((x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 false)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + (cert.P 0 false).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.modified.tile + a0).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.modified.tile d0).cells)))))) ) + := by + classical + intro q cfg C T cert x incident hABO a0 d0 hAtile hDtile hDB h + obtain ⟨jB, hjB⟩ := incident (cert.P 0 false) x + (LatticeTileGridStructure _ (cert.parent_lattice 0 false)).1.1 h.2.1 + have hjD : LatticeVertexIncidentCell x jB ∉ (cert.P 1 false).cells := by + intro hh + exact (Finset.disjoint_left.mp hDB hh hjB).elim + have hjA : LatticeVertexIncidentCell x jB ∉ + (TileCellComplement (cert.P 0 true) cert.O).cells := by + intro hh + have hpair : LatticeVertexIncidentCell x jB ∈ + (cert.P 0 true).cells ∩ (cert.P 0 false).cells := + Finset.mem_inter.mpr ⟨(Finset.mem_sdiff.mp hh).1, hjB⟩ + have ho : LatticeVertexIncidentCell x jB ∈ cert.O.cells := by + rw [← hABO] + exact hpair + exact (Finset.mem_sdiff.mp hh).2 ho + exact ⟨jB, hjB, by simpa [hAtile] using hjA, by simpa [hDtile] using hjD⟩ + +private theorem hxvAD : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (PeriodicTileAdjacentContactRegularity cert.modified) → ( + let a0 : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + (x ∈ FootprintVertices (cert.modified.tile a0) ∩ FootprintVertices (cert.modified.tile + d0)) → ((cert.modified.plane.adjacent a0 d0) → (x ∈ CommonFootprintEdgeVertices + (cert.modified.tile a0) (cert.modified.tile d0)))) ) := by + classical + intro q cfg C T cert x hregular a0 d0 hxAD had + rw [← hregular.adjacent_raw_eq_edge_vertices a0 d0 had] + exact hxAD + +private theorem classifyADface : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let a0 : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + ∀ (F : cert.modified.plane.Face), ((∃ i, cert.modified.plane.faceVertex F i = a0) ∧ + ∃ i, cert.modified.plane.faceVertex F i = d0) → (cert.modified_face_equiv F = ⟨.I2, + 0, 0⟩ ∨ cert.modified_face_equiv F = ⟨.J4, 0, 0⟩) ) := by + classical + intro q cfg C T cert a0 d0 F hF + obtain ⟨i, hi⟩ := hF.1 + obtain ⟨j, hj⟩ := hF.2 + rw [cert.modified_face_vertices] at hi hj + generalize hidx : cert.modified_face_equiv F = face at hi hj ⊢ + rcases face with ⟨label, m, n⟩ + cases label <;> fin_cases i <;> fin_cases j <;> + simp [SixSubtileFaceVertices, a0, d0] at hi hj ⊢ <;> omega + +private theorem rhoFace2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), + (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm face)) ) := by + classical + intro q cfg C T cert F face hF + have hEq : F = cert.modified_face_equiv.symm face := by + have hh := congrArg cert.modified_face_equiv.symm hF + simpa using hh + rw [hEq, cert.modified_face_points] + +private theorem hf2point : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (f2 : cert.modified.plane.Face), ((cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) f2 = (⟨SixSubtileFaceLabel.I2, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) f2 = (⟨SixSubtileFaceLabel.J4, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( + let p2 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) + let pJ4 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J4, 0, 0⟩) + (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), + (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho f2 = p2 ∨ + cert.modified.rho f2 = pJ4)) ) := by + classical + intro q cfg C T cert f2 hf2class p2 pJ4 rhoFace2 + rcases hf2class with h | h + · exact Or.inl (by simpa [p2] using rhoFace2 f2 _ h) + · exact Or.inr (by simpa [pJ4] using rhoFace2 f2 _ h) + +private theorem hg2point : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (g2 : cert.modified.plane.Face), ((cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) g2 = (⟨SixSubtileFaceLabel.I2, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) g2 = (⟨SixSubtileFaceLabel.J4, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( + let p2 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) + let pJ4 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J4, 0, 0⟩) + (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), + (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho g2 = p2 ∨ + cert.modified.rho g2 = pJ4)) ) := by + classical + intro q cfg C T cert g2 hg2class p2 pJ4 rhoFace2 + rcases hg2class with h | h + · exact Or.inl (by simpa [p2] using rhoFace2 g2 _ h) + · exact Or.inr (by simpa [pJ4] using rhoFace2 g2 _ h) + +private theorem hx_p2_or_pJ4 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (f2 : cert.modified.plane.Face), ∀ (g2 : + cert.modified.plane.Face), (x = cert.modified.rho f2 ∨ x = cert.modified.rho g2) → ( + let p2 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) + let pJ4 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J4, 0, 0⟩) + (cert.modified.rho f2 = p2 ∨ cert.modified.rho f2 = pJ4) → ((cert.modified.rho g2 = p2 ∨ + cert.modified.rho g2 = pJ4) → (x = p2 ∨ x = pJ4))) ) := by + classical + intro q cfg C T cert x f2 g2 hxendpointAD p2 pJ4 hf2point hg2point + rcases hxendpointAD with h | h + · rcases hf2point with hF | hF + · exact Or.inl (h.trans hF) + · exact Or.inr (h.trans hF) + · rcases hg2point with hG | hG + · exact Or.inl (h.trans hG) + · exact Or.inr (h.trans hG) + +private theorem hJ4vertex : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let faceJ4 : PeriodicSubtileFaceIndex := ⟨.J4, 0, 0⟩ + let bJ4 : PeriodicSubtileIndex := ⟨.B, 1, 1⟩ + cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ4) 1 = bJ4 ) := by + classical + intro q cfg C T cert faceJ4 bJ4 + rw [cert.modified_face_vertices] + simp [faceJ4, bJ4, SixSubtileFaceVertices] + +private theorem hpJ4b : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let pJ4 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J4, 0, 0⟩) + let faceJ4 : PeriodicSubtileFaceIndex := ⟨.J4, 0, 0⟩ + let bJ4 : PeriodicSubtileIndex := ⟨.B, 1, 1⟩ + (cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ4) 1 = bJ4) → (pJ4 ∈ + FootprintVertices (cert.modified.tile bJ4)) ) := by + classical + intro q cfg C T cert pJ4 faceJ4 bJ4 hJ4vertex + have hh := cert.modified.rho_common (cert.modified_face_equiv.symm faceJ4) 1 + rw [cert.modified_face_points, hJ4vertex] at hh + simpa [pJ4, faceJ4] using hh + +private theorem hp2D : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (GaussianTranslation (0 : GaussianInt) = id) → ( + let p2 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) + p2 ∈ FootprintVertices (cert.P 1 false)) ) := by + classical + intro q cfg C T cert htransZero p2 + let faceI2 : PeriodicSubtileFaceIndex := ⟨.I2, 0, 0⟩ + let dI2 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + have hvertex : cert.modified.plane.faceVertex + (cert.modified_face_equiv.symm faceI2) 2 = dI2 := by + rw [cert.modified_face_vertices] + simp [faceI2, dI2, SixSubtileFaceVertices] + have hh := cert.modified.rho_common + (cert.modified_face_equiv.symm faceI2) 2 + rw [hvertex, cert.modified_tile, cert.modified_face_points] at hh + simpa [p2, faceI2, dI2, ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation, htransZero, Finset.image_id] using hh + +private theorem hCtile0 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (GaussianTranslation (0 : GaussianInt) = id) → ( + let c0 : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + cert.modified.tile c0 = cert.P 1 true) ) := by + classical + intro q cfg C T cert htransZero c0 + rw [cert.modified_tile] + simp [c0, ModifiedSubtileOccurrenceInterpretation, + TileTranslation, htransZero] + +private theorem hFtile0 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (GaussianTranslation (0 : GaussianInt) = id) → ( + let f0 : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + cert.modified.tile f0 = cert.P 2 false) ) := by + classical + intro q cfg C T cert htransZero f0 + rw [cert.modified_tile] + simp [f0, ModifiedSubtileOccurrenceInterpretation, + TileTranslation, htransZero] + +private theorem hcd : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let c0 : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f0 : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + cert.modified.plane.adjacent c0 f0 ) := by + classical + intro q cfg C T cert c0 f0 + exact (cert.modified_adjacency c0 f0).mpr + (AllowedSubtileIncidence.CF 0 0) + +private theorem hCFdis : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let c0 : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f0 : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + (cert.modified.tile c0 = cert.P 1 true) → ((cert.modified.tile f0 = cert.P 2 false) → + ((Disjoint (cert.P 1 true).cells (cert.P 2 false).cells) → (Disjoint + (cert.modified.tile c0).cells (cert.modified.tile f0).cells))) ) := by + classical + intro q cfg C T cert c0 f0 hCtile0 hFtile0 hCFseparate + rw [hCtile0, hFtile0] + exact hCFseparate + +private theorem hthirdACF : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (∀ (W : ProtoTile), ∀ (y : GaussianInt), (W.cells.Nonempty) + → ((y ∈ FootprintVertices W) → (∃ j : Fin 4, LatticeVertexIncidentCell y j ∈ + W.cells))) → ((Disjoint (cert.P 0 true).cells (cert.P 1 true).cells) → ( + let c0 : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f0 : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + (cert.modified.tile c0 = cert.P 1 true) → ((cert.modified.tile f0 = cert.P 2 false) → + ((Disjoint (cert.P 0 true).cells (cert.P 2 false).cells) → ((x ∈ FootprintVertices + (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 1 true) ∧ + x ∈ FootprintVertices (cert.P 2 false)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + (cert.P 0 true).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.modified.tile + c0).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.modified.tile f0).cells)))))) ) + := by + classical + intro q cfg C T cert x incident hACseparate c0 f0 hCtile0 hFtile0 hAFseparate h + obtain ⟨jA, hjA⟩ := incident (cert.P 0 true) x + (LatticeTileGridStructure _ (cert.parent_lattice 0 true)).1.1 h.1 + have hjC : LatticeVertexIncidentCell x jA ∉ (cert.P 1 true).cells := by + intro hh + exact (Finset.disjoint_left.mp hACseparate hjA hh).elim + have hjF : LatticeVertexIncidentCell x jA ∉ (cert.P 2 false).cells := by + intro hh + exact (Finset.disjoint_left.mp hAFseparate hjA hh).elim + exact ⟨jA, hjA, by simpa [hCtile0] using hjC, + by simpa [hFtile0] using hjF⟩ + +private theorem hxCF : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (x ∈ FootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) ∧ x ∈ + FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true) ∧ x ∈ FootprintVertices (cert.P (2 + : Fin (3 : ℕ)) false)) → ( + let c0 : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f0 : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + (cert.modified.tile c0 = cert.P 1 true) → ((cert.modified.tile f0 = cert.P 2 false) → (x + ∈ FootprintVertices (cert.modified.tile c0) ∩ FootprintVertices (cert.modified.tile + f0)))) ) := by + classical + intro q cfg C T cert x hACF c0 f0 hCtile0 hFtile0 + simpa [hCtile0, hFtile0] using ⟨hACF.2.1, hACF.2.2⟩ + +private theorem hxvCF : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (PeriodicTileAdjacentContactRegularity cert.modified) → ( + let c0 : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f0 : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + (cert.modified.plane.adjacent c0 f0) → ((x ∈ FootprintVertices (cert.modified.tile c0) ∩ + FootprintVertices (cert.modified.tile f0)) → (x ∈ CommonFootprintEdgeVertices + (cert.modified.tile c0) (cert.modified.tile f0)))) ) := by + classical + intro q cfg C T cert x hregular c0 f0 hcd hxCF + rw [← hregular.adjacent_raw_eq_edge_vertices c0 f0 hcd] + exact hxCF + +private theorem classifyCFface : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let c0 : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f0 : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + ∀ (F : cert.modified.plane.Face), ((∃ i, cert.modified.plane.faceVertex F i = c0) ∧ + ∃ i, cert.modified.plane.faceVertex F i = f0) → (cert.modified_face_equiv F = ⟨.I3, + 0, 0⟩ ∨ cert.modified_face_equiv F = ⟨.J8, 0, 0⟩) ) := by + classical + intro q cfg C T cert c0 f0 F hF + obtain ⟨i, hi⟩ := hF.1 + obtain ⟨j, hj⟩ := hF.2 + rw [cert.modified_face_vertices] at hi hj + generalize hidx : cert.modified_face_equiv F = face at hi hj ⊢ + rcases face with ⟨label, m, n⟩ + cases label <;> fin_cases i <;> fin_cases j <;> + simp [SixSubtileFaceVertices, c0, f0] at hi hj ⊢ <;> omega + +private theorem rhoFace3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), + (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm face)) ) := by + classical + intro q cfg C T cert F face hF + have hEq : F = cert.modified_face_equiv.symm face := by + have hh := congrArg cert.modified_face_equiv.symm hF + simpa using hh + rw [hEq, cert.modified_face_points] + +private theorem hf3point : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (f3 : cert.modified.plane.Face), ((cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) f3 = (⟨SixSubtileFaceLabel.I3, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) f3 = (⟨SixSubtileFaceLabel.J8, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( + let p3 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + let pJ8 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J8, 0, 0⟩) + (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), + (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho f3 = p3 ∨ + cert.modified.rho f3 = pJ8)) ) := by + classical + intro q cfg C T cert f3 hf3class p3 pJ8 rhoFace3 + rcases hf3class with h | h + · exact Or.inl (by simpa [p3] using rhoFace3 f3 _ h) + · exact Or.inr (by simpa [pJ8] using rhoFace3 f3 _ h) + +private theorem hg3point : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (g3 : cert.modified.plane.Face), ((cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) g3 = (⟨SixSubtileFaceLabel.I3, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) g3 = (⟨SixSubtileFaceLabel.J8, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( + let p3 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + let pJ8 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J8, 0, 0⟩) + (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), + (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho g3 = p3 ∨ + cert.modified.rho g3 = pJ8)) ) := by + classical + intro q cfg C T cert g3 hg3class p3 pJ8 rhoFace3 + rcases hg3class with h | h + · exact Or.inl (by simpa [p3] using rhoFace3 g3 _ h) + · exact Or.inr (by simpa [pJ8] using rhoFace3 g3 _ h) + +private theorem hx_p3_or_pJ8 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), ∀ (f3 : cert.modified.plane.Face), ∀ (g3 : + cert.modified.plane.Face), (x = cert.modified.rho f3 ∨ x = cert.modified.rho g3) → ( + let p3 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + let pJ8 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J8, 0, 0⟩) + (cert.modified.rho f3 = p3 ∨ cert.modified.rho f3 = pJ8) → ((cert.modified.rho g3 = p3 ∨ + cert.modified.rho g3 = pJ8) → (x = p3 ∨ x = pJ8))) ) := by + classical + intro q cfg C T cert x f3 g3 hxendpointCF p3 pJ8 hf3point hg3point + rcases hxendpointCF with h | h + · rcases hf3point with hF | hF + · exact Or.inl (h.trans hF) + · exact Or.inr (h.trans hF) + · rcases hg3point with hG | hG + · exact Or.inl (h.trans hG) + · exact Or.inr (h.trans hG) + +private theorem hJ8vertex : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let faceJ8 : PeriodicSubtileFaceIndex := ⟨.J8, 0, 0⟩ + let dJ8 : PeriodicSubtileIndex := ⟨.D, -1, 0⟩ + cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ8) 1 = dJ8 ) := by + classical + intro q cfg C T cert faceJ8 dJ8 + rw [cert.modified_face_vertices] + simp [faceJ8, dJ8, SixSubtileFaceVertices] + +private theorem hpJ8d : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let pJ8 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J8, 0, 0⟩) + let faceJ8 : PeriodicSubtileFaceIndex := ⟨.J8, 0, 0⟩ + let dJ8 : PeriodicSubtileIndex := ⟨.D, -1, 0⟩ + (cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ8) 1 = dJ8) → (pJ8 ∈ + FootprintVertices (cert.modified.tile dJ8)) ) := by + classical + intro q cfg C T cert pJ8 faceJ8 dJ8 hJ8vertex + have hh := cert.modified.rho_common (cert.modified_face_equiv.symm faceJ8) 1 + rw [cert.modified_face_points, hJ8vertex] at hh + simpa [pJ8, faceJ8] using hh + +private theorem hp3F : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (GaussianTranslation (0 : GaussianInt) = id) → ( + let p3 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + p3 ∈ FootprintVertices (cert.P 2 false)) ) := by + classical + intro q cfg C T cert htransZero p3 + let faceI3 : PeriodicSubtileFaceIndex := ⟨.I3, 0, 0⟩ + let fI3 : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + have hvertex : cert.modified.plane.faceVertex + (cert.modified_face_equiv.symm faceI3) 2 = fI3 := by + rw [cert.modified_face_vertices] + simp [faceI3, fI3, SixSubtileFaceVertices] + have hh := cert.modified.rho_common + (cert.modified_face_equiv.symm faceI3) 2 + rw [hvertex, cert.modified_tile, cert.modified_face_points] at hh + simpa [p3, faceI3, fI3, ModifiedSubtileOccurrenceInterpretation, + TileTranslation, GaussianTranslation, htransZero, Finset.image_id] using hh + +private theorem hDtile0 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (GaussianTranslation (0 : GaussianInt) = id) → ( + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + cert.modified.tile d0 = cert.P 1 false) ) := by + classical + intro q cfg C T cert htransZero d0 + rw [cert.modified_tile] + simp [d0, ModifiedSubtileOccurrenceInterpretation, + TileTranslation, htransZero] + +private theorem hEtile0 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (GaussianTranslation (0 : GaussianInt) = id) → ( + let e0 : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + cert.modified.tile e0 = cert.P 2 true) ) := by + classical + intro q cfg C T cert htransZero e0 + rw [cert.modified_tile] + simp [e0, ModifiedSubtileOccurrenceInterpretation, + TileTranslation, htransZero] + +private theorem hde : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + let e0 : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + cert.modified.plane.adjacent d0 e0 ) := by + classical + intro q cfg C T cert d0 e0 + exact (cert.modified_adjacency d0 e0).mpr + (AllowedSubtileIncidence.DE 0 0) + +private theorem hDEdis : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + let e0 : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + (cert.modified.tile d0 = cert.P 1 false) → ((cert.modified.tile e0 = cert.P 2 true) → + ((Disjoint (cert.P 1 false).cells (cert.P 2 true).cells) → (Disjoint + (cert.modified.tile d0).cells (cert.modified.tile e0).cells))) ) := by + classical + intro q cfg C T cert d0 e0 hDtile0 hEtile0 hDEseparate + rw [hDtile0, hEtile0] + exact hDEseparate + +private theorem hthirdB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (∀ (W : ProtoTile), ∀ (y : GaussianInt), (W.cells.Nonempty) + → ((y ∈ FootprintVertices W) → (∃ j : Fin 4, LatticeVertexIncidentCell y j ∈ + W.cells))) → ( + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + let e0 : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + (cert.modified.tile d0 = cert.P 1 false) → ((cert.modified.tile e0 = cert.P 2 true) → + ((Disjoint (cert.P 0 false).cells (cert.P 1 false).cells) → ((Disjoint (cert.P 0 + false).cells (cert.P 2 true).cells) → ((x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 false) ∧ + x ∈ FootprintVertices (cert.P 2 true)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + (cert.P 0 false).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.modified.tile + d0).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.modified.tile e0).cells)))))) ) + := by + classical + intro q cfg C T cert x incident d0 e0 hDtile0 hEtile0 hBDseparate hBEseparate h + obtain ⟨jB, hjB⟩ := incident (cert.P 0 false) x + (LatticeTileGridStructure _ (cert.parent_lattice 0 false)).1.1 h.1 + have hjD : LatticeVertexIncidentCell x jB ∉ (cert.P 1 false).cells := by + intro hh + exact (Finset.disjoint_left.mp hBDseparate hjB hh).elim + have hjE : LatticeVertexIncidentCell x jB ∉ (cert.P 2 true).cells := by + intro hh + exact (Finset.disjoint_left.mp hBEseparate hjB hh).elim + exact ⟨jB, hjB, by simpa [hDtile0] using hjD, + by simpa [hEtile0] using hjE⟩ + +private theorem hxDE : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (x ∈ FootprintVertices (cert.P (0 : Fin (3 : ℕ)) false) ∧ x + ∈ FootprintVertices (cert.P (1 : Fin (3 : ℕ)) false) ∧ x ∈ FootprintVertices (cert.P + (2 : Fin (3 : ℕ)) true)) → ( + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + let e0 : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + (cert.modified.tile d0 = cert.P 1 false) → ((cert.modified.tile e0 = cert.P 2 true) → (x + ∈ FootprintVertices (cert.modified.tile d0) ∩ FootprintVertices (cert.modified.tile + e0)))) ) := by + classical + intro q cfg C T cert x hBDE d0 e0 hDtile0 hEtile0 + simpa [hDtile0, hEtile0] using ⟨hBDE.2.1, hBDE.2.2⟩ + +private theorem hxvDE : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (PeriodicTileAdjacentContactRegularity cert.modified) → ( + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + let e0 : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + (cert.modified.plane.adjacent d0 e0) → ((x ∈ FootprintVertices (cert.modified.tile d0) ∩ + FootprintVertices (cert.modified.tile e0)) → (x ∈ CommonFootprintEdgeVertices + (cert.modified.tile d0) (cert.modified.tile e0)))) ) := by + classical + intro q cfg C T cert x hregular d0 e0 hde hxDE + rw [← hregular.adjacent_raw_eq_edge_vertices d0 e0 hde] + exact hxDE + +private theorem rhoFace4 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), + (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm face)) ) := by + classical + intro q cfg C T cert F face hF + have hEq : F = cert.modified_face_equiv.symm face := by + have hh := congrArg cert.modified_face_equiv.symm hF + simpa using hh + rw [hEq, cert.modified_face_points] + +private theorem hf4point : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (f4 : cert.modified.plane.Face), ((cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) f4 = (⟨SixSubtileFaceLabel.I4, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) f4 = (⟨SixSubtileFaceLabel.J7, + (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( + let p4 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I4, 0, 0⟩) + let pJ7 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J7, 1, 0⟩) + (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), + (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho f4 = p4 ∨ + cert.modified.rho f4 = pJ7)) ) := by + classical + intro q cfg C T cert f4 hf4class p4 pJ7 rhoFace4 + rcases hf4class with h | h + · exact Or.inl (by simpa [p4] using rhoFace4 f4 _ h) + · exact Or.inr (by simpa [pJ7] using rhoFace4 f4 _ h) + +private theorem hg4point : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (g4 : cert.modified.plane.Face), ((cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) g4 = (⟨SixSubtileFaceLabel.I4, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + cert.modified.plane.Face → PeriodicSubtileFaceIndex) g4 = (⟨SixSubtileFaceLabel.J7, + (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( + let p4 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I4, 0, 0⟩) + let pJ7 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J7, 1, 0⟩) + (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), + (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho g4 = p4 ∨ + cert.modified.rho g4 = pJ7)) ) := by + classical + intro q cfg C T cert g4 hg4class p4 pJ7 rhoFace4 + rcases hg4class with h | h + · exact Or.inl (by simpa [p4] using rhoFace4 g4 _ h) + · exact Or.inr (by simpa [pJ7] using rhoFace4 g4 _ h) + +private theorem endpointAlternative : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (f4 : cert.modified.plane.Face), ∀ (g4 : cert.modified.plane.Face), + let p4 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I4, 0, 0⟩) + let pJ7 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J7, 1, 0⟩) + (cert.modified.rho f4 = p4 ∨ cert.modified.rho f4 = pJ7) → ((cert.modified.rho g4 = p4 ∨ + cert.modified.rho g4 = pJ7) → (∀ (z : GaussianInt), (z = cert.modified.rho f4 ∨ z = + cert.modified.rho g4) → (z = p4 ∨ z = pJ7))) ) := by + classical + intro q cfg C T cert f4 g4 p4 pJ7 hf4point hg4point z hz + rcases hz with h | h + · rcases hf4point with hp | hp + · exact Or.inl (h.trans hp) + · exact Or.inr (h.trans hp) + · rcases hg4point with hp | hp + · exact Or.inl (h.trans hp) + · exact Or.inr (h.trans hp) + +private theorem hJ7vertex : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let faceJ7 : PeriodicSubtileFaceIndex := ⟨.J7, 1, 0⟩ + let cJ7 : PeriodicSubtileIndex := ⟨.C, 1, 0⟩ + cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ7) 0 = cJ7 ) := by + classical + intro q cfg C T cert faceJ7 cJ7 + rw [cert.modified_face_vertices] + simp [faceJ7, cJ7, SixSubtileFaceVertices] + +private theorem hpJ7c : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let pJ7 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J7, 1, 0⟩) + let faceJ7 : PeriodicSubtileFaceIndex := ⟨.J7, 1, 0⟩ + let cJ7 : PeriodicSubtileIndex := ⟨.C, 1, 0⟩ + (cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ7) 0 = cJ7) → (pJ7 ∈ + FootprintVertices (cert.modified.tile cJ7)) ) := by + classical + intro q cfg C T cert pJ7 faceJ7 cJ7 hJ7vertex + have hh := cert.modified.rho_common (cert.modified_face_equiv.symm faceJ7) 0 + rw [cert.modified_face_points, hJ7vertex] at hh + simpa [pJ7, faceJ7] using hh + +private theorem hS1disk : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), LatticeTile (cert.S 1 false) ) := by + classical + intro q cfg C T cert + apply P4590T1PositivePrototileDisk _ _ + (cert.minus_occurrence 1 false).1 + change 0 < (cfg.firstPredecessor 2).1 + rw [cfg.firstParentTwo] + have h := cfg.secondLarge + omega + +private theorem boundaryFootprint : + (by + classical + exact + ∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ (z : GaussianInt), (z ∈ + BoundaryFootprintVertices U) → (z ∈ FootprintVertices U)) ) := by + classical + intro U hne z hz + simp only [BoundaryFootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hz + obtain ⟨e, he, hz⟩ := hz + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] + obtain ⟨a, ⟨rfl, ha⟩ | ⟨rfl, ha⟩⟩ := he + all_goals + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases ha with ⟨ha, _⟩ | ⟨_, ha⟩ + · refine ⟨a, ha, ?_⟩ + rcases hz with rfl | rfl <;> simp + · refine ⟨_, ha, ?_⟩ + rcases hz with rfl | rfl <;> + simp [sub_eq_add_neg, add_comm, add_left_comm, add_assoc] + +private theorem nestedCellsInsideT : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ z, z ∈ (cert.S 1 false).cells ∨ z ∈ (cert.P 1 false).cells ∨ z ∈ (cert.P 2 + true).cells → z ∈ T.cells ) := by + classical + intro q cfg C T cert z hz + rcases hz with hs | hd | he + · exact (cert.outer_union z).2 ⟨0, false, + (cert.minus_union z).2 ⟨1, false, hs⟩⟩ + · exact (cert.outer_union z).2 ⟨1, false, hd⟩ + · exact (cert.outer_union z).2 ⟨2, true, he⟩ + +private theorem nestedStarInsideT : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (pN : GaussianInt), ((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell pN j ∈ + (cert.S (1 : Fin (3 : ℕ)) false).cells ∨ LatticeVertexIncidentCell pN j ∈ (cert.P (1 + : Fin (3 : ℕ)) false).cells ∨ LatticeVertexIncidentCell pN j ∈ (cert.P (2 : Fin (3 : + ℕ)) true).cells) ∧ (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell pN j ∈ (cert.S (1 + : Fin (3 : ℕ)) false).cells) ∧ (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell pN j ∈ + (cert.P (1 : Fin (3 : ℕ)) false).cells) ∧ (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell pN j ∈ (cert.P (2 : Fin (3 : ℕ)) true).cells) ∧ ((∃ (j : + Fin (4 : ℕ)), LatticeVertexIncidentCell pN j ∈ (cert.S (1 : Fin (3 : ℕ)) false).cells + ∧ LatticeVertexIncidentCell pN (j + (2 : Fin (4 : ℕ))) ∈ (cert.P (1 : Fin (3 : ℕ)) + false).cells) ∨ (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell pN j ∈ (cert.S (1 : + Fin (3 : ℕ)) false).cells ∧ LatticeVertexIncidentCell pN (j + (2 : Fin (4 : ℕ))) ∈ + (cert.P (2 : Fin (3 : ℕ)) true).cells) ∨ ∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell pN j ∈ (cert.P (1 : Fin (3 : ℕ)) false).cells ∧ + LatticeVertexIncidentCell pN (j + (2 : Fin (4 : ℕ))) ∈ (cert.P (2 : Fin (3 : ℕ)) + true).cells)) → ((∀ z, z ∈ (cert.S 1 false).cells ∨ z ∈ (cert.P 1 false).cells ∨ z ∈ + (cert.P 2 true).cells → z ∈ T.cells) → (∀ j : Fin 4, LatticeVertexIncidentCell pN j ∈ + T.cells)) ) := by + classical + intro q cfg C T cert pN hsectorN nestedCellsInsideT j + rcases hsectorN.1 j with hs | hd | he + · exact nestedCellsInsideT _ (Or.inl hs) + · exact nestedCellsInsideT _ (Or.inr (Or.inl hd)) + · exact nestedCellsInsideT _ (Or.inr (Or.inr he)) + +private theorem hSNthird : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (∀ (W : ProtoTile), ∀ (y : GaussianInt), (W.cells.Nonempty) → ((y ∈ + FootprintVertices W) → (∃ j : Fin 4, LatticeVertexIncidentCell y j ∈ W.cells))) → ( + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + let e0 : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + (cert.modified.tile d0 = cert.P 1 false) → ((cert.modified.tile e0 = cert.P 2 true) → + ((Disjoint (cert.P 0 false).cells (cert.P 1 false).cells) → ((Disjoint (cert.P 0 + false).cells (cert.P 2 true).cells) → (((cert.S 1 false).cells.Nonempty) → (∀ (pN : + GaussianInt), (pN ∈ FootprintVertices (cert.S 1 false)) → (∃ j : Fin 4, + LatticeVertexIncidentCell pN j ∈ (cert.S 1 false).cells ∧ LatticeVertexIncidentCell + pN j ∉ (cert.modified.tile d0).cells ∧ LatticeVertexIncidentCell pN j ∉ + (cert.modified.tile e0).cells))))))) ) := by + classical + intro q cfg C T cert incident d0 e0 hDtile0 hEtile0 hBDseparate hBEseparate hS1ne pN hpNS + obtain ⟨j, hj⟩ := incident (cert.S 1 false) pN hS1ne hpNS + have hjB : LatticeVertexIncidentCell pN j ∈ (cert.P 0 false).cells := + (cert.minus_union _).2 ⟨1, false, hj⟩ + have hjD : LatticeVertexIncidentCell pN j ∉ (cert.P 1 false).cells := by + intro hh + exact (Finset.disjoint_left.mp hBDseparate hjB hh).elim + have hjE : LatticeVertexIncidentCell pN j ∉ (cert.P 2 true).cells := by + intro hh + exact (Finset.disjoint_left.mp hBEseparate hjB hh).elim + exact ⟨j, hj, by simpa [hDtile0] using hjD, + by simpa [hEtile0] using hjE⟩ + +private theorem hpNv : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (PeriodicTileAdjacentContactRegularity cert.modified) → ( + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + let e0 : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + (cert.modified.tile d0 = cert.P 1 false) → ((cert.modified.tile e0 = cert.P 2 true) → + ((cert.modified.plane.adjacent d0 e0) → (∀ (pN : GaussianInt), (pN ∈ + FootprintVertices (cert.P 1 false)) → ((pN ∈ FootprintVertices (cert.P 2 true)) → (pN + ∈ CommonFootprintEdgeVertices (cert.modified.tile d0) (cert.modified.tile e0))))))) ) + := by + classical + intro q cfg C T cert hregular d0 e0 hDtile0 hEtile0 hde pN hpND hpNE + rw [← hregular.adjacent_raw_eq_edge_vertices d0 e0 hde] + simpa [hDtile0, hEtile0] using ⟨hpND, hpNE⟩ + +private theorem hpNeTranslated : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (∀ (W : ProtoTile), ∀ (y : GaussianInt), (W.cells.Nonempty) → ((y ∈ + FootprintVertices W) → (∃ j : Fin 4, LatticeVertexIncidentCell y j ∈ W.cells))) → ( + let pJ7 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J7, 1, 0⟩) + let cJ7 : PeriodicSubtileIndex := ⟨.C, 1, 0⟩ + (pJ7 ∈ FootprintVertices (cert.modified.tile cJ7)) → ((Disjoint T.cells (TileTranslation + T ((↑(1 : ℤ) : GaussianInt) * cert.u + (↑(0 : ℤ) : GaussianInt) * cert.v)).cells) → + ((∀ (z : GaussianInt), (z ∈ (cert.modified.tile cJ7).cells) → (z ∈ (TileTranslation T + ((1 : GaussianInt) * cert.u + (0 : GaussianInt) * cert.v)).cells)) → (∀ (pN : + GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell pN j ∈ T.cells) → (pN ≠ + pJ7))))) ) := by + classical + intro q cfg C T cert incident pJ7 cJ7 hpJ7c hblockSepDE hblockCellDE pN nestedStarInsideT hEq + obtain ⟨j, hj⟩ := incident (cert.modified.tile cJ7) pJ7 + (LatticeTileGridStructure _ (cert.modified.tiles_are_disks cJ7)).1.1 hpJ7c + have hjBlock := hblockCellDE (LatticeVertexIncidentCell pJ7 j) hj + have hjT : LatticeVertexIncidentCell pJ7 j ∈ T.cells := by + simpa [hEq] using nestedStarInsideT j + exact (Finset.disjoint_left.mp hblockSepDE hjT hjBlock).elim + +private theorem hpNisP4 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let p4 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I4, 0, 0⟩) + let pJ7 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J7, 1, 0⟩) + ∀ (pN : GaussianInt), (pN = p4 ∨ pN = pJ7) → ((pN ≠ pJ7) → (pN = p4)) ) := by + classical + intro q cfg C T cert p4 pJ7 pN hpNalt hpNeTranslated + rcases hpNalt with hp | hp + · exact hp + · exact (hpNeTranslated hp).elim + +private theorem hxJ7neq : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ BoundaryFootprintVertices + T) → ((∀ (W : ProtoTile), ∀ (y : GaussianInt), (W.cells.Nonempty) → ((y ∈ + FootprintVertices W) → (∃ j : Fin 4, LatticeVertexIncidentCell y j ∈ W.cells))) → ((∀ + j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) → ((x ∈ T.cells ∧ x - 1 ∈ T.cells + ∧ x - 1 - ⟨0, 1⟩ ∈ T.cells ∧ x - ⟨0, 1⟩ ∈ T.cells) → (((x ∈ FootprintVertices (cert.P + 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ FootprintVertices (cert.P 1 + true)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.P 0 false).cells ∧ LatticeVertexIncidentCell x + j ∉ (cert.P 1 true).cells)) → ((x ∈ FootprintVertices (cert.P (0 : Fin (3 : ℕ)) + false) ∧ x ∈ FootprintVertices (cert.P (1 : Fin (3 : ℕ)) false) ∧ x ∈ + FootprintVertices (cert.P (2 : Fin (3 : ℕ)) true)) → ( + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + let e0 : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + ∀ (f4 : cert.modified.plane.Face), ∀ (g4 : cert.modified.plane.Face), ((x ∈ + FootprintVertices (cert.P 0 false) ∧ x ∈ FootprintVertices (cert.P 1 false) ∧ x ∈ + FootprintVertices (cert.P 2 true)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + (cert.P 0 false).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.modified.tile + d0).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.modified.tile e0).cells)) → ((x ∈ + FootprintVertices (cert.modified.tile d0) ∩ FootprintVertices (cert.modified.tile + e0)) → ((x ∈ CommonFootprintEdgeVertices (cert.modified.tile d0) (cert.modified.tile + e0)) → ((x = cert.modified.rho f4 ∨ x = cert.modified.rho g4) → ( + let pJ7 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J7, 1, 0⟩) + let cJ7 : PeriodicSubtileIndex := ⟨.C, 1, 0⟩ + (pJ7 ∈ FootprintVertices (cert.modified.tile cJ7)) → ((Disjoint T.cells (TileTranslation + T ((↑(1 : ℤ) : GaussianInt) * cert.u + (↑(0 : ℤ) : GaussianInt) * cert.v)).cells) → + ((∀ (z : GaussianInt), (z ∈ (cert.modified.tile cJ7).cells) → (z ∈ (TileTranslation T + ((1 : GaussianInt) * cert.u + (0 : GaussianInt) * cert.v)).cells)) → ((x = pJ7) → (x + ≠ pJ7))))))))))))))) ) := by + classical + intro q cfg C T cert x hx hxb incident hmissingT hfourCells hthirdABC hBDE d0 e0 f4 g4 hthirdB + hxDE hxvDE hxendpointDE pJ7 cJ7 hpJ7c hblockSepDE hblockCellDE hxJ7 hEq + subst x + obtain ⟨j, hj⟩ := incident (cert.modified.tile cJ7) pJ7 + (LatticeTileGridStructure _ (cert.modified.tiles_are_disks cJ7)).1.1 hpJ7c + have hjBlock := hblockCellDE (LatticeVertexIncidentCell pJ7 j) hj + exact (Finset.disjoint_left.mp hblockSepDE (hmissingT j) hjBlock).elim + +end JunctionRefinementGeometry + +namespace JunctionCases + +private theorem firstJunction : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ BoundaryFootprintVertices + T) → ((GaussianTranslation (0 : GaussianInt) = id) → ((∀ (W : ProtoTile), ∀ (y : + GaussianInt), Finset.Nonempty W.cells → y ∈ FootprintVertices W → ∃ (j : Fin (4 : + ℕ)), LatticeVertexIncidentCell y j ∈ W.cells) → ((∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T.cells) → ((x ∈ T.cells ∧ x - (1 : GaussianInt) ∈ + T.cells ∧ x - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells ∧ x - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells) → ((∀ (U : ProtoTile), ∀ (V : + ProtoTile), ∀ (W : ProtoTile), ∀ (p : GaussianInt), ∀ (q : GaussianInt), ∀ (vertex : + GaussianInt), ∀ (vertices : Set GaussianInt), LatticeTile U → LatticeTile V → + Disjoint U.cells V.cells → SimpleGridPathBetween vertices (FootprintEdges U ∩ + FootprintEdges V) p q → vertex ∈ vertices → (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell vertex j ∈ W.cells ∧ LatticeVertexIncidentCell vertex j ∉ + U.cells ∧ LatticeVertexIncidentCell vertex j ∉ V.cells) → vertex = p ∨ vertex = q) → ( + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + (cert.modified.plane.adjacent b c) → ((PeriodicTileAdjacentContactRegularity + cert.modified) → (∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), + ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex f i = b) ∧ ∃ (i : Fin (3 : ℕ)), + cert.modified.plane.faceVertex f i = c) → (((∃ (i : Fin (3 : ℕ)), + cert.modified.plane.faceVertex g i = b) ∧ ∃ (i : Fin (3 : ℕ)), + cert.modified.plane.faceVertex g i = c) → ((SimpleGridPathBetween + (CommonFootprintEdgeVertices (cert.modified.tile b) (cert.modified.tile c)) + (FootprintEdges (cert.modified.tile b) ∩ FootprintEdges (cert.modified.tile c)) + (cert.modified.rho f) (cert.modified.rho g)) → ((∀ (m : ℤ), ∀ (n : ℤ), (m, n) ≠ ((0 : + ℤ), (0 : ℤ)) → Disjoint T.cells (TileTranslation T ((↑m : GaussianInt) * cert.u + (↑n + : GaussianInt) * cert.v)).cells) → ((∀ (label : SixSubtileLabel), ∀ (m : Int), ∀ (n : + Int), ∀ (a : GaussianInt), (a ∈ (cert.modified.tile ⟨label, m, n⟩).cells) → (a ∈ + (TileTranslation T ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells)) + → ((cert.modified.tile b = cert.P 0 false) → ((cert.modified.tile c = cert.P 1 true) + → ((Disjoint (cert.modified.tile b).cells (cert.modified.tile c).cells) → (((x ∈ + FootprintVertices (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ + FootprintVertices (cert.P 1 true)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + (cert.P 0 true).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.P 0 false).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.P 1 true).cells)) → (((x ∈ FootprintVertices + (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ FootprintVertices + (cert.P 1 true)) → x ∈ FootprintVertices (cert.Q 1 true) ∩ FootprintVertices (cert.S + 2 false) ∩ FootprintVertices (cert.P 1 true)))))))))))))))))))) ) := by + classical + intro q cfg C T cert x hx hxb htransZero incident hmissingT hfourCells path_endpoint_of_third b + c hbc hregular f g hf hg hBCpath blockSeparation tileCellInBlock hBtile hCtile hBCdis + hthirdABC hABC + have hxv : x ∈ CommonFootprintEdgeVertices + (cert.modified.tile b) (cert.modified.tile c) := JunctionRefinementGeometry.hxv q cfg C T + cert x hbc hregular (JunctionRefinementGeometry.hxBC q cfg C T cert x hBtile hCtile + hABC) + have hxendpoint := path_endpoint_of_third + (cert.modified.tile b) (cert.modified.tile c) (cert.P 0 true) + (cert.modified.rho f) (cert.modified.rho g) x + (CommonFootprintEdgeVertices (cert.modified.tile b) (cert.modified.tile c)) + (cert.modified.tiles_are_disks b) (cert.modified.tiles_are_disks c) + hBCdis hBCpath hxv (by simpa [hBtile, hCtile] using hthirdABC hABC) + have classifyBCface := JunctionRefinementGeometry.classifyBCface q cfg C T cert + have hfclass := classifyBCface f hf + have hgclass := classifyBCface g hg + let p1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let pJ := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J3, -1, -1⟩) + have rhoFace := JunctionRefinementGeometry.rhoFace q cfg C T cert + have hx_p1_or_pJ := JunctionRefinementGeometry.hx_p1_or_pJ q cfg C T cert x + f g hxendpoint (JunctionRefinementGeometry.hfpoint q cfg C T cert f hfclass rhoFace) + (JunctionRefinementGeometry.hgpoint q cfg C T cert g hgclass rhoFace) + let faceJ : PeriodicSubtileFaceIndex := ⟨.J3, -1, -1⟩ + let aJ : PeriodicSubtileIndex := ⟨.A, -1, -1⟩ + have hpJa := JunctionRefinementGeometry.hpJa + q cfg C T cert (JunctionRefinementGeometry.hJvertex q cfg C T cert) + have hblockSep := JunctionRefinementGeometry.hblockSep q cfg C T cert blockSeparation + have htranslatedCell := JunctionRefinementGeometry.htranslatedCell q cfg C T cert + tileCellInBlock + rcases hx_p1_or_pJ with hxp1 | hxpj + · have hp1C := JunctionRefinementGeometry.hp1C q cfg + C T cert htransZero + have htarget : p1 ∈ FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.S 2 false) ∩ + FootprintVertices (cert.P 1 true) := ⟨cert.inner_first, hp1C⟩ + simpa [hxp1] using htarget + · subst x + obtain ⟨j, hj⟩ := incident (cert.modified.tile aJ) pJ + (LatticeTileGridStructure _ (cert.modified.tiles_are_disks aJ)).1.1 hpJa + have hjT : LatticeVertexIncidentCell pJ j ∈ T.cells := hmissingT j + have hjBlock := htranslatedCell (LatticeVertexIncidentCell pJ j) hj + exact (Finset.disjoint_left.mp hblockSep hjT hjBlock).elim + +private theorem secondJunction : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ BoundaryFootprintVertices + T) → ((GaussianTranslation (0 : GaussianInt) = id) → ((∀ (W : ProtoTile), ∀ (y : + GaussianInt), Finset.Nonempty W.cells → y ∈ FootprintVertices W → ∃ (j : Fin (4 : + ℕ)), LatticeVertexIncidentCell y j ∈ W.cells) → ((∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T.cells) → ((x ∈ T.cells ∧ x - (1 : GaussianInt) ∈ + T.cells ∧ x - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells ∧ x - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells) → ((∀ y ∈ + CellSupportedFootprintVertices cert.O, ∀ (a : GaussianInt), y ∈ FootprintVertices + (⟨{a}, a⟩ : ProtoTile) → a ∈ (cert.P (0 : Fin (3 : ℕ)) true).cells ∨ a ∈ (cert.P (0 : + Fin (3 : ℕ)) false).cells) → ((∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (W : + ProtoTile), ∀ (p : GaussianInt), ∀ (q : GaussianInt), ∀ (vertex : GaussianInt), ∀ + (vertices : Set GaussianInt), LatticeTile U → LatticeTile V → Disjoint U.cells + V.cells → SimpleGridPathBetween vertices (FootprintEdges U ∩ FootprintEdges V) p q → + vertex ∈ vertices → (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell vertex j ∈ + W.cells ∧ LatticeVertexIncidentCell vertex j ∉ U.cells ∧ LatticeVertexIncidentCell + vertex j ∉ V.cells) → vertex = p ∨ vertex = q) → (((cert.P (0 : Fin (3 : ℕ)) + true).cells ∩ (cert.P (0 : Fin (3 : ℕ)) false).cells = cert.O.cells) → ((∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), (i, s) ≠ (j, t) → ¬(i = (0 + : Fin (3 : ℕ)) ∧ j = (0 : Fin (3 : ℕ))) → Disjoint (cert.P i s).cells (cert.P j + t).cells) → ((PeriodicTileAdjacentContactRegularity cert.modified) → ((∀ (m : ℤ), ∀ + (n : ℤ), (m, n) ≠ ((0 : ℤ), (0 : ℤ)) → Disjoint T.cells (TileTranslation T ((↑m : + GaussianInt) * cert.u + (↑n : GaussianInt) * cert.v)).cells) → ((∀ (label : + SixSubtileLabel), ∀ (m : Int), ∀ (n : Int), ∀ (a : GaussianInt), (a ∈ + (cert.modified.tile ⟨label, m, n⟩).cells) → (a ∈ (TileTranslation T ((m : + GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells)) → (((x ∈ + FootprintVertices (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ + FootprintVertices (cert.P 1 true)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + (cert.P 0 true).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.P 0 false).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.P 1 true).cells)) → ((((x ∈ FootprintVertices + (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ FootprintVertices + (cert.P 1 true)) → x ∈ FootprintVertices (cert.Q 1 true) ∩ FootprintVertices (cert.S + 2 false) ∩ FootprintVertices (cert.P 1 true))) → (((x ∈ FootprintVertices (cert.P 0 + true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ FootprintVertices (cert.P 1 + false)) → x ∈ FootprintVertices (cert.Q 2 true) ∩ FootprintVertices (cert.S 1 false) + ∩ FootprintVertices (cert.P 1 false))))))))))))))))) ) := by + classical + intro q cfg C T cert x hx hxb htransZero incident hmissingT hfourCells + precursorIsolationSupported path_endpoint_of_third hABO hseparate hregular blockSeparation + tileCellInBlock hthirdABC firstJunction hABD + let a0 : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + have hAtile : cert.modified.tile a0 = + TileCellComplement (cert.P 0 true) cert.O := JunctionRefinementGeometry.hAtile q cfg C + T cert htransZero + have hDtile : cert.modified.tile d0 = cert.P 1 false := JunctionRefinementGeometry.hDtile q + cfg C T cert htransZero + have hDA : Disjoint (cert.P 1 false).cells (cert.P 0 true).cells := + hseparate 1 false 0 true (by decide) (by decide) + have hDB : Disjoint (cert.P 1 false).cells (cert.P 0 false).cells := + hseparate 1 false 0 false (by decide) (by decide) + have hret := FootprintDeletionRetention (cert.P 0 true) + (cert.P 0 false) cert.O (cert.P 1 false) (JunctionRefinementGeometry.hOinA q cfg C T cert + hABO) + precursorIsolationSupported hDA hDB + have hDne : (cert.P 1 false).cells.Nonempty := + (LatticeTileGridStructure _ (cert.parent_lattice 1 false)).1.1 + have hADvertices : + FootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintVertices (cert.P 1 false) = + FootprintVertices (cert.P 0 true) ∩ + FootprintVertices (cert.P 1 false) := + hret.2.2 (Or.inr ⟨(JunctionRefinementGeometry.hAcompne q cfg C T cert hAtile), hDne⟩) + have hxAD := JunctionRefinementGeometry.hxAD q cfg C T + cert x hABD hAtile hDtile hADvertices + have had := JunctionRefinementGeometry.had q cfg C T cert + have hadne : a0 ≠ d0 := by decide + have hADedges := cert.modified.adjacent_has_common_edge a0 d0 had + obtain ⟨_, f2, g2, hfg2, hf2, hg2, hfaces2, hADpath⟩ := + (PeriodicTileIntersectionPaths cert.modified hregular a0 d0 hadne).1.mpr hADedges + have hthirdABD (h : x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 false)) : + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.modified.tile a0).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.modified.tile d0).cells := + JunctionRefinementGeometry.hthirdABD q cfg C T cert x incident hABO hAtile hDtile + hDB h + have hxendpointAD := path_endpoint_of_third + (cert.modified.tile a0) (cert.modified.tile d0) (cert.P 0 false) + (cert.modified.rho f2) (cert.modified.rho g2) x + (CommonFootprintEdgeVertices (cert.modified.tile a0) (cert.modified.tile d0)) + (cert.modified.tiles_are_disks a0) (cert.modified.tiles_are_disks d0) + (JunctionRefinementGeometry.hADdis q cfg C T cert hAtile hDtile hDA) hADpath + (JunctionRefinementGeometry.hxvAD q cfg C T cert x hregular hxAD had) + (by simpa [hAtile, hDtile] using hthirdABD hABD) + have classifyADface := JunctionRefinementGeometry.classifyADface q cfg C T cert + have hf2class := classifyADface f2 hf2 + have hg2class := classifyADface g2 hg2 + let p2 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) + let pJ4 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J4, 0, 0⟩) + have rhoFace2 := JunctionRefinementGeometry.rhoFace2 q cfg C T cert + have hx_p2_or_pJ4 := JunctionRefinementGeometry.hx_p2_or_pJ4 q cfg C T + cert x f2 g2 hxendpointAD (JunctionRefinementGeometry.hf2point q cfg C T cert f2 + hf2class rhoFace2) (JunctionRefinementGeometry.hg2point q cfg C T cert g2 hg2class + rhoFace2) + let faceJ4 : PeriodicSubtileFaceIndex := ⟨.J4, 0, 0⟩ + let bJ4 : PeriodicSubtileIndex := ⟨.B, 1, 1⟩ + have hpJ4b := JunctionRefinementGeometry.hpJ4b q cfg C T cert + (JunctionRefinementGeometry.hJ4vertex q cfg C T cert) + have hblockSepAD := blockSeparation 1 1 (by decide) + have hblockCellAD (v : GaussianInt) + (hv : v ∈ (cert.modified.tile bJ4).cells) : + v ∈ (TileTranslation T + ((1 : GaussianInt) * cert.u + (1 : GaussianInt) * cert.v)).cells := + tileCellInBlock .B 1 1 v (by simpa [bJ4] using hv) + rcases hx_p2_or_pJ4 with hxp2 | hxpj4 + · have hp2D := JunctionRefinementGeometry.hp2D q + cfg C T cert htransZero + have htarget : p2 ∈ FootprintVertices (cert.Q 2 true) ∩ + FootprintVertices (cert.S 1 false) ∩ + FootprintVertices (cert.P 1 false) := ⟨cert.inner_second, hp2D⟩ + simpa [hxp2] using htarget + · subst x + obtain ⟨j, hj⟩ := incident (cert.modified.tile bJ4) pJ4 + (LatticeTileGridStructure _ (cert.modified.tiles_are_disks bJ4)).1.1 hpJ4b + have hjT : LatticeVertexIncidentCell pJ4 j ∈ T.cells := hmissingT j + exact (Finset.disjoint_left.mp hblockSepAD hjT + (hblockCellAD (LatticeVertexIncidentCell pJ4 j) hj)).elim + +private theorem thirdJunction : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ BoundaryFootprintVertices + T) → ((GaussianTranslation (0 : GaussianInt) = id) → ((∀ (W : ProtoTile), ∀ (y : + GaussianInt), Finset.Nonempty W.cells → y ∈ FootprintVertices W → ∃ (j : Fin (4 : + ℕ)), LatticeVertexIncidentCell y j ∈ W.cells) → ((∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T.cells) → ((x ∈ T.cells ∧ x - (1 : GaussianInt) ∈ + T.cells ∧ x - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells ∧ x - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells) → ((∀ (U : ProtoTile), ∀ (V : + ProtoTile), ∀ (W : ProtoTile), ∀ (p : GaussianInt), ∀ (q : GaussianInt), ∀ (vertex : + GaussianInt), ∀ (vertices : Set GaussianInt), LatticeTile U → LatticeTile V → + Disjoint U.cells V.cells → SimpleGridPathBetween vertices (FootprintEdges U ∩ + FootprintEdges V) p q → vertex ∈ vertices → (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell vertex j ∈ W.cells ∧ LatticeVertexIncidentCell vertex j ∉ + U.cells ∧ LatticeVertexIncidentCell vertex j ∉ V.cells) → vertex = p ∨ vertex = q) → + ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), (i, s) ≠ (j, + t) → ¬(i = (0 : Fin (3 : ℕ)) ∧ j = (0 : Fin (3 : ℕ))) → Disjoint (cert.P i s).cells + (cert.P j t).cells) → ((Disjoint (cert.P 0 true).cells (cert.P 1 true).cells) → + ((PeriodicTileAdjacentContactRegularity cert.modified) → ((∀ (m : ℤ), ∀ (n : ℤ), (m, + n) ≠ ((0 : ℤ), (0 : ℤ)) → Disjoint T.cells (TileTranslation T ((↑m : GaussianInt) * + cert.u + (↑n : GaussianInt) * cert.v)).cells) → ((∀ (label : SixSubtileLabel), ∀ (m : + Int), ∀ (n : Int), ∀ (a : GaussianInt), (a ∈ (cert.modified.tile ⟨label, m, + n⟩).cells) → (a ∈ (TileTranslation T ((m : GaussianInt) * cert.u + (n : GaussianInt) + * cert.v)).cells)) → (((x ∈ FootprintVertices (cert.P 0 true) ∧ x ∈ FootprintVertices + (cert.P 0 false) ∧ x ∈ FootprintVertices (cert.P 1 true)) → (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∧ LatticeVertexIncidentCell x j + ∉ (cert.P 0 false).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.P 1 true).cells)) → + ((((x ∈ FootprintVertices (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 true)) → x ∈ FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.S 2 false) ∩ FootprintVertices (cert.P 1 true))) → ((((x ∈ + FootprintVertices (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ + FootprintVertices (cert.P 1 false)) → x ∈ FootprintVertices (cert.Q 2 true) ∩ + FootprintVertices (cert.S 1 false) ∩ FootprintVertices (cert.P 1 false))) → (((x ∈ + FootprintVertices (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 1 true) ∧ x ∈ + FootprintVertices (cert.P 2 false)) → x ∈ FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.P 1 true) ∩ FootprintVertices (cert.P 2 + false))))))))))))))))) ) := by + classical + intro q cfg C T cert x hx hxb htransZero incident hmissingT hfourCells path_endpoint_of_third + hseparate hACseparate hregular blockSeparation tileCellInBlock hthirdABC firstJunction + secondJunction hACF + let c0 : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f0 : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + have hCtile0 : cert.modified.tile c0 = cert.P 1 true := + JunctionRefinementGeometry.hCtile0 q cfg C T cert htransZero + have hFtile0 : cert.modified.tile f0 = cert.P 2 false := + JunctionRefinementGeometry.hFtile0 q cfg C T cert htransZero + have hCFseparate : Disjoint (cert.P 1 true).cells + (cert.P 2 false).cells := hseparate 1 true 2 false (by decide) (by decide) + have hAFseparate : Disjoint (cert.P 0 true).cells + (cert.P 2 false).cells := hseparate 0 true 2 false (by decide) (by decide) + have hcd := JunctionRefinementGeometry.hcd q cfg C T + cert + have hcdne : c0 ≠ f0 := by decide + have hCFedges := cert.modified.adjacent_has_common_edge c0 f0 hcd + obtain ⟨_, f3, g3, hfg3, hf3, hg3, hfaces3, hCFpath⟩ := + (PeriodicTileIntersectionPaths cert.modified hregular c0 f0 hcdne).1.mpr hCFedges + have hthirdACF (h : x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 1 true) ∧ + x ∈ FootprintVertices (cert.P 2 false)) : + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.modified.tile c0).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.modified.tile f0).cells := + JunctionRefinementGeometry.hthirdACF q cfg C T cert x incident hACseparate + hCtile0 hFtile0 hAFseparate h + have hxendpointCF := path_endpoint_of_third + (cert.modified.tile c0) (cert.modified.tile f0) (cert.P 0 true) + (cert.modified.rho f3) (cert.modified.rho g3) x + (CommonFootprintEdgeVertices (cert.modified.tile c0) (cert.modified.tile f0)) + (cert.modified.tiles_are_disks c0) (cert.modified.tiles_are_disks f0) + (JunctionRefinementGeometry.hCFdis q cfg C T cert hCtile0 hFtile0 hCFseparate) hCFpath + (JunctionRefinementGeometry.hxvCF q cfg C T cert x hregular hcd + (JunctionRefinementGeometry.hxCF q cfg C T cert x hACF hCtile0 hFtile0)) + (by simpa [hCtile0, hFtile0] using hthirdACF hACF) + have classifyCFface := JunctionRefinementGeometry.classifyCFface q cfg C T cert + have hf3class := classifyCFface f3 hf3 + have hg3class := classifyCFface g3 hg3 + let p3 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + let pJ8 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J8, 0, 0⟩) + have rhoFace3 := JunctionRefinementGeometry.rhoFace3 q cfg C T cert + have hx_p3_or_pJ8 := JunctionRefinementGeometry.hx_p3_or_pJ8 q cfg C T + cert x f3 g3 hxendpointCF (JunctionRefinementGeometry.hf3point q cfg C T cert f3 + hf3class rhoFace3) (JunctionRefinementGeometry.hg3point q cfg C T cert g3 + hg3class rhoFace3) + let faceJ8 : PeriodicSubtileFaceIndex := ⟨.J8, 0, 0⟩ + let dJ8 : PeriodicSubtileIndex := ⟨.D, -1, 0⟩ + have hpJ8d := JunctionRefinementGeometry.hpJ8d q cfg C T cert + (JunctionRefinementGeometry.hJ8vertex q cfg C T cert) + have hblockSepCF := blockSeparation (-1) 0 (by decide) + rcases hx_p3_or_pJ8 with hxp3 | hxpj8 + · have hp3F := JunctionRefinementGeometry.hp3F + q cfg C T cert htransZero + have htarget : p3 ∈ FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.P 1 true) ∩ + FootprintVertices (cert.P 2 false) := ⟨cert.inner_third, hp3F⟩ + simpa [hxp3] using htarget + · subst x + obtain ⟨j, hj⟩ := incident (cert.modified.tile dJ8) pJ8 + (LatticeTileGridStructure _ (cert.modified.tiles_are_disks dJ8)).1.1 hpJ8d + have hjBlock := tileCellInBlock .D (-1) 0 + (LatticeVertexIncidentCell pJ8 j) (by simpa [dJ8] using hj) + exact (Finset.disjoint_left.mp hblockSepCF (hmissingT j) hjBlock).elim + +private theorem fourthJunction : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ BoundaryFootprintVertices + T) → ((GaussianTranslation (0 : GaussianInt) = id) → ((∀ (W : ProtoTile), ∀ (y : + GaussianInt), Finset.Nonempty W.cells → y ∈ FootprintVertices W → ∃ (j : Fin (4 : + ℕ)), LatticeVertexIncidentCell y j ∈ W.cells) → ((∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T.cells) → ((x ∈ T.cells ∧ x - (1 : GaussianInt) ∈ + T.cells ∧ x - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells ∧ x - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells) → ((∀ (U : ProtoTile), ∀ (V : + ProtoTile), ∀ (W : ProtoTile), ∀ (p : GaussianInt), ∀ (q : GaussianInt), ∀ (vertex : + GaussianInt), ∀ (vertices : Set GaussianInt), LatticeTile U → LatticeTile V → + Disjoint U.cells V.cells → SimpleGridPathBetween vertices (FootprintEdges U ∩ + FootprintEdges V) p q → vertex ∈ vertices → (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell vertex j ∈ W.cells ∧ LatticeVertexIncidentCell vertex j ∉ + U.cells ∧ LatticeVertexIncidentCell vertex j ∉ V.cells) → vertex = p ∨ vertex = q) → + ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), (i, s) ≠ (j, + t) → ¬(i = (0 : Fin (3 : ℕ)) ∧ j = (0 : Fin (3 : ℕ))) → Disjoint (cert.P i s).cells + (cert.P j t).cells) → ((PeriodicTileAdjacentContactRegularity cert.modified) → ((∀ (m + : ℤ), ∀ (n : ℤ), (m, n) ≠ ((0 : ℤ), (0 : ℤ)) → Disjoint T.cells (TileTranslation T + ((↑m : GaussianInt) * cert.u + (↑n : GaussianInt) * cert.v)).cells) → ((∀ (label : + SixSubtileLabel), ∀ (m : Int), ∀ (n : Int), ∀ (a : GaussianInt), (a ∈ + (cert.modified.tile ⟨label, m, n⟩).cells) → (a ∈ (TileTranslation T ((m : + GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells)) → (((x ∈ + FootprintVertices (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ + FootprintVertices (cert.P 1 true)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + (cert.P 0 true).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.P 0 false).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.P 1 true).cells)) → ((((x ∈ FootprintVertices + (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ FootprintVertices + (cert.P 1 true)) → x ∈ FootprintVertices (cert.Q 1 true) ∩ FootprintVertices (cert.S + 2 false) ∩ FootprintVertices (cert.P 1 true))) → ((((x ∈ FootprintVertices (cert.P 0 + true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ FootprintVertices (cert.P 1 + false)) → x ∈ FootprintVertices (cert.Q 2 true) ∩ FootprintVertices (cert.S 1 false) + ∩ FootprintVertices (cert.P 1 false))) → ((((x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 1 true) ∧ x ∈ FootprintVertices (cert.P 2 false)) → x ∈ + FootprintVertices (cert.Q 1 true) ∩ FootprintVertices (cert.P 1 true) ∩ + FootprintVertices (cert.P 2 false))) → (((x ∈ FootprintVertices (cert.P 0 false) ∧ x + ∈ FootprintVertices (cert.P 1 false) ∧ x ∈ FootprintVertices (cert.P 2 true)) → x ∈ + FootprintVertices (cert.S 1 false) ∩ FootprintVertices (cert.P 1 false) ∩ + FootprintVertices (cert.P 2 true))))))))))))))))) ) := by + classical + intro q cfg C T cert x hx hxb htransZero incident hmissingT hfourCells path_endpoint_of_third + hseparate hregular blockSeparation tileCellInBlock hthirdABC firstJunction secondJunction + thirdJunction hBDE + let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ + let e0 : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ + have hDtile0 : cert.modified.tile d0 = cert.P 1 false := + JunctionRefinementGeometry.hDtile0 q cfg C T cert htransZero + have hEtile0 : cert.modified.tile e0 = cert.P 2 true := + JunctionRefinementGeometry.hEtile0 q cfg C T cert htransZero + have hDEseparate : Disjoint (cert.P 1 false).cells + (cert.P 2 true).cells := hseparate 1 false 2 true (by decide) (by decide) + have hBDseparate : Disjoint (cert.P 0 false).cells + (cert.P 1 false).cells := hseparate 0 false 1 false (by decide) (by decide) + have hBEseparate : Disjoint (cert.P 0 false).cells + (cert.P 2 true).cells := hseparate 0 false 2 true (by decide) (by decide) + have hde := JunctionRefinementGeometry.hde q cfg C T + cert + have hdene : d0 ≠ e0 := by decide + have hDEedges := cert.modified.adjacent_has_common_edge d0 e0 hde + obtain ⟨_, f4, g4, hfg4, hf4, hg4, hfaces4, hDEpath⟩ := + (PeriodicTileIntersectionPaths cert.modified hregular d0 e0 hdene).1.mpr hDEedges + have hDEdis := JunctionRefinementGeometry.hDEdis q cfg C T cert + hDtile0 hEtile0 hDEseparate + have hthirdB (h : x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 false) ∧ + x ∈ FootprintVertices (cert.P 2 true)) : + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.modified.tile d0).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.modified.tile e0).cells := + JunctionRefinementGeometry.hthirdB q cfg C T cert x incident hDtile0 hEtile0 + hBDseparate hBEseparate h + have hxDE := JunctionRefinementGeometry.hxDE q cfg C + T cert x hBDE hDtile0 hEtile0 + have hxvDE := JunctionRefinementGeometry.hxvDE q + cfg C T cert x hregular hde hxDE + have hxendpointDE := path_endpoint_of_third + (cert.modified.tile d0) (cert.modified.tile e0) (cert.P 0 false) + (cert.modified.rho f4) (cert.modified.rho g4) x + (CommonFootprintEdgeVertices (cert.modified.tile d0) (cert.modified.tile e0)) + (cert.modified.tiles_are_disks d0) (cert.modified.tiles_are_disks e0) + hDEdis hDEpath hxvDE + (by simpa [hDtile0, hEtile0] using hthirdB hBDE) + have classifyDEface (F : cert.modified.plane.Face) + (hF : (∃ i, cert.modified.plane.faceVertex F i = d0) ∧ + ∃ i, cert.modified.plane.faceVertex F i = e0) : + cert.modified_face_equiv F = ⟨.I4, 0, 0⟩ ∨ + cert.modified_face_equiv F = ⟨.J7, 1, 0⟩ := + (by + obtain ⟨i, hi⟩ := hF.1 + obtain ⟨j, hj⟩ := hF.2 + rw [cert.modified_face_vertices] at hi hj + generalize hidx : cert.modified_face_equiv F = face at hi hj ⊢ + rcases face with ⟨label, m, n⟩ + cases label <;> fin_cases i <;> fin_cases j <;> + simp [SixSubtileFaceVertices, d0, e0] at hi hj ⊢ <;> omega) + have hf4class := classifyDEface f4 hf4 + have hg4class := classifyDEface g4 hg4 + let p4 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I4, 0, 0⟩) + let pJ7 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J7, 1, 0⟩) + have rhoFace4 := JunctionRefinementGeometry.rhoFace4 q cfg C T cert + have endpointAlternative := JunctionRefinementGeometry.endpointAlternative q cfg C T cert + f4 g4 (JunctionRefinementGeometry.hf4point q cfg C T cert f4 hf4class rhoFace4) + (JunctionRefinementGeometry.hg4point q cfg C T cert g4 hg4class rhoFace4) + let faceJ7 : PeriodicSubtileFaceIndex := ⟨.J7, 1, 0⟩ + let cJ7 : PeriodicSubtileIndex := ⟨.C, 1, 0⟩ + have hpJ7c := JunctionRefinementGeometry.hpJ7c q cfg C T cert + (JunctionRefinementGeometry.hJ7vertex q cfg C T cert) + have hblockSepDE := blockSeparation 1 0 (by decide) + have hblockCellDE (z : GaussianInt) + (hz : z ∈ (cert.modified.tile cJ7).cells) : + z ∈ (TileTranslation T + ((1 : GaussianInt) * cert.u + (0 : GaussianInt) * cert.v)).cells := + tileCellInBlock SixSubtileLabel.C 1 0 z + (by simpa only [cJ7] using hz) + have hS1disk := JunctionRefinementGeometry.hS1disk q cfg C + T cert + have hS1ne : (cert.S 1 false).cells.Nonempty := + (LatticeTileGridStructure _ hS1disk).1.1 + have boundaryFootprint := JunctionRefinementGeometry.boundaryFootprint + obtain ⟨pN, hpN, hpNUnique⟩ := cert.double_fourth.2.2.2 + have hpNS : pN ∈ FootprintVertices (cert.S 1 false) := + boundaryFootprint _ hS1ne _ hpN.1 + have hpND : pN ∈ FootprintVertices (cert.P 1 false) := + boundaryFootprint _ (LatticeTileGridStructure _ + (cert.parent_lattice 1 false)).1.1 _ hpN.2.1 + have hpNE : pN ∈ FootprintVertices (cert.P 2 true) := + boundaryFootprint _ (LatticeTileGridStructure _ + (cert.parent_lattice 2 true)).1.1 _ hpN.2.2 + have hpNendpoint := path_endpoint_of_third + (cert.modified.tile d0) (cert.modified.tile e0) (cert.S 1 false) + (cert.modified.rho f4) (cert.modified.rho g4) pN + (CommonFootprintEdgeVertices (cert.modified.tile d0) (cert.modified.tile e0)) + (cert.modified.tiles_are_disks d0) (cert.modified.tiles_are_disks e0) + hDEdis hDEpath (JunctionRefinementGeometry.hpNv q cfg C T cert hregular hDtile0 hEtile0 + hde pN hpND hpNE) (JunctionRefinementGeometry.hSNthird q cfg C T cert incident + hDtile0 hEtile0 hBDseparate hBEseparate hS1ne pN hpNS) + have hpNalt := endpointAlternative pN hpNendpoint + have hpNisP4 : pN = p4 := JunctionRefinementGeometry.hpNisP4 q cfg C T cert pN hpNalt + (JunctionRefinementGeometry.hpNeTranslated q cfg C T cert incident hpJ7c hblockSepDE + hblockCellDE pN (JunctionRefinementGeometry.nestedStarInsideT q cfg C T cert pN + (LocalLatticeInterfaceSectors.1 (cert.S 1 false) (cert.P 1 false) (cert.P 2 true) + pN hS1disk (cert.parent_lattice 1 false) (cert.parent_lattice 2 true) + cert.double_fourth ⟨⟨hpNS, hpND⟩, hpNE⟩) + (JunctionRefinementGeometry.nestedCellsInsideT q cfg C T cert))) + have hxAlt := endpointAlternative x hxendpointDE + rcases hxAlt with hxP4 | hxJ7 + · subst x + have htarget : pN ∈ FootprintVertices (cert.S 1 false) ∩ + FootprintVertices (cert.P 1 false) ∩ + FootprintVertices (cert.P 2 true) := ⟨⟨hpNS, hpND⟩, hpNE⟩ + simpa [hpNisP4] using htarget + · have hxJ7neq := JunctionRefinementGeometry.hxJ7neq q cfg C T cert x hx hxb + incident hmissingT hfourCells hthirdABC hBDE f4 g4 hthirdB hxDE hxvDE hxendpointDE + hpJ7c hblockSepDE hblockCellDE hxJ7 + exact (hxJ7neq hxJ7).elim + +end JunctionCases + +theorem P4590T1JunctionRefinement + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (hT : LatticeTile T) (x : GaussianInt) + (hx : x ∈ FootprintVertices T) (hxb : x ∉ BoundaryFootprintVertices T) : + ((x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 true)) → + x ∈ FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.S 2 false) ∩ FootprintVertices (cert.P 1 true)) ∧ + ((x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 false)) → + x ∈ FootprintVertices (cert.Q 2 true) ∩ + FootprintVertices (cert.S 1 false) ∩ FootprintVertices (cert.P 1 false)) ∧ + ((x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 1 true) ∧ + x ∈ FootprintVertices (cert.P 2 false)) → + x ∈ FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.P 1 true) ∩ FootprintVertices (cert.P 2 false)) ∧ + ((x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 false) ∧ + x ∈ FootprintVertices (cert.P 2 true)) → + x ∈ FootprintVertices (cert.S 1 false) ∩ + FootprintVertices (cert.P 1 false) ∩ FootprintVertices (cert.P 2 true)) := by +-- BODY + classical + have hTne : T.cells.Nonempty := (LatticeTileGridStructure T hT).1.1 + have htransZero := JunctionRefinementGeometry.htransZero + have incident := JunctionRefinementGeometry.incident + have hmissingT : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells := + (P4456T2VertexInterior T hTne x hx).2.mp hxb + have hfourCells := JunctionRefinementGeometry.hfourCells T + x hmissingT + have incidentCorner := JunctionRefinementGeometry.incidentCorner + have incidentSingleton := JunctionRefinementGeometry.incidentSingleton + (JunctionRefinementGeometry.singletonCorner) + have precursorIsolationSupported := JunctionRefinementGeometry.precursorIsolationSupported q + cfg C T cert htransZero + (JunctionRefinementGeometry.supportedToFootprint q cfg C T cert) + have path_endpoint_of_third := P4616T1ThirdOwnerPathEndpoint + obtain ⟨_, _, _, _, _, _, hABO, hseparate⟩ := + P4339T1PrecursorSupportGeometry C q cfg T cert + have hBCseparate : Disjoint (cert.P 0 false).cells + (cert.P 1 true).cells := hseparate 0 false 1 true (by decide) (by decide) + have hACseparate : Disjoint (cert.P 0 true).cells + (cert.P 1 true).cells := hseparate 0 true 1 true (by decide) (by decide) + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + have hbc : cert.modified.plane.adjacent b c := by + exact (cert.modified_adjacency b c).mpr (AllowedSubtileIncidence.BC 0 0) + have hbcne : b ≠ c := by decide + have hBCedges := cert.modified.adjacent_has_common_edge b c hbc + have hregular := (PeriodicTileIntersectionClassification cert.modified).2 + obtain ⟨_, f, g, hfg, hf, hg, hfaces, hBCpath⟩ := + (PeriodicTileIntersectionPaths cert.modified hregular b c hbcne).1.mpr hBCedges + have hblocks := BandOrderedGeneralPeriodicBlockCells q cfg C T cert + have blockSeparation := JunctionRefinementGeometry.blockSeparation q cfg C T cert htransZero + hblocks + have tileCellInBlock (label : SixSubtileLabel) (m n : Int) (a : GaussianInt) + (ha : a ∈ (cert.modified.tile ⟨label, m, n⟩).cells) : + a ∈ (TileTranslation T + ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells := + JunctionRefinementGeometry.tileCellInBlock q cfg C T cert hblocks label m n a ha + have hBtile : cert.modified.tile b = cert.P 0 false := JunctionRefinementGeometry.hBtile q cfg + C T cert htransZero + have hCtile : cert.modified.tile c = cert.P 1 true := JunctionRefinementGeometry.hCtile q cfg C + T cert htransZero + have hBCdis : Disjoint (cert.modified.tile b).cells + (cert.modified.tile c).cells := by rw [hBtile, hCtile]; exact hBCseparate + have hthirdABC (hABC : x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 true)) : + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.P 0 false).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.P 1 true).cells := + JunctionRefinementGeometry.hthirdABC q cfg C T cert x htransZero incident + incidentCorner incidentSingleton hABO hBCseparate hACseparate hABC + have firstJunction : + ((x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 true)) → + x ∈ FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.S 2 false) ∩ FootprintVertices (cert.P 1 true)) := + JunctionCases.firstJunction q cfg C T cert x hx hxb htransZero incident hmissingT + hfourCells path_endpoint_of_third hbc hregular f g hf hg hBCpath blockSeparation + tileCellInBlock hBtile hCtile hBCdis hthirdABC + have secondJunction : + ((x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 false)) → + x ∈ FootprintVertices (cert.Q 2 true) ∩ + FootprintVertices (cert.S 1 false) ∩ FootprintVertices (cert.P 1 false)) := + JunctionCases.secondJunction q cfg C T cert x hx hxb htransZero incident + hmissingT hfourCells precursorIsolationSupported path_endpoint_of_third hABO + hseparate hregular blockSeparation tileCellInBlock hthirdABC firstJunction + have thirdJunction : + ((x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 1 true) ∧ + x ∈ FootprintVertices (cert.P 2 false)) → + x ∈ FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.P 1 true) ∩ FootprintVertices (cert.P 2 false)) := + JunctionCases.thirdJunction q cfg C T cert x hx hxb htransZero incident hmissingT + hfourCells path_endpoint_of_third hseparate hACseparate hregular blockSeparation + tileCellInBlock hthirdABC firstJunction secondJunction + have fourthJunction : + ((x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 false) ∧ + x ∈ FootprintVertices (cert.P 2 true)) → + x ∈ FootprintVertices (cert.S 1 false) ∩ + FootprintVertices (cert.P 1 false) ∩ FootprintVertices (cert.P 2 true)) := + JunctionCases.fourthJunction q cfg C T cert x hx hxb htransZero incident + hmissingT hfourCells path_endpoint_of_third hseparate hregular blockSeparation + tileCellInBlock hthirdABC firstJunction secondJunction thirdJunction + exact ⟨firstJunction, secondJunction, thirdJunction, fourthJunction⟩ + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRouting.lean b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRouting.lean new file mode 100644 index 0000000000..bc1fcba47c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRouting.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4590T1MixedCompanionMarks +public import LeanPool.ApollonianSuperharmonic.P4590T1PositivePrototileDisk +public import LeanPool.ApollonianSuperharmonic.P4590T1OppositeCellsStar +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorWebRow +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure + +-- [TABLET NODE: P4590T1JunctionRouting] + +/-! +# P4590T1JunctionRouting + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4590T1JunctionRouting + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (hT : LatticeTile T) (x : GaussianInt) + (hx : x ∈ FootprintVertices T) (hxb : x ∉ BoundaryFootprintVertices T) + (hjunction : + (x ∈ FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.S 2 false) ∩ FootprintVertices (cert.P 1 true)) ∨ + (x ∈ FootprintVertices (cert.Q 2 true) ∩ + FootprintVertices (cert.S 1 false) ∩ FootprintVertices (cert.P 1 false)) ∨ + (x ∈ FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.P 1 true) ∩ FootprintVertices (cert.P 2 false)) ∨ + (x ∈ FootprintVertices (cert.S 1 false) ∩ + FootprintVertices (cert.P 1 false) ∩ FootprintVertices (cert.P 2 true))) : + BandOrderedGeneralInteriorWebRow cert x true := by +-- BODY + have hq2 : 0 < (q 2).1 := by have h := cfg.secondLarge; omega + have hq3 : 0 < (q 3).1 := by + have h := (ProperBandCurvatureStructure q cfg.proper).2.1 (2 : Fin 3) + have hn := cfg.noLine 3 + change 0 ≤ (q 3).1 at h + omega + have hQ2 := P4590T1PositivePrototileDisk _ _ (cert.plus_occurrence 1 true).1 + (by change 0 < (cfg.firstPredecessor 2).1; rw [cfg.firstParentTwo]; exact hq2) + have hQ3 := P4590T1PositivePrototileDisk _ _ (cert.plus_occurrence 2 true).1 + (by change 0 < (cfg.firstPredecessor 3).1; rw [cfg.firstParentThree]; exact hq3) + have hS2 := P4590T1PositivePrototileDisk _ _ (cert.minus_occurrence 1 false).1 + (by change 0 < (cfg.firstPredecessor 2).1; rw [cfg.firstParentTwo]; exact hq2) + have hS3 := P4590T1PositivePrototileDisk _ _ (cert.minus_occurrence 2 false).1 + (by change 0 < (cfg.firstPredecessor 3).1; rw [cfg.firstParentThree]; exact hq3) + have ne (W : ProtoTile) (hW : LatticeTile W) : W.cells.Nonempty := + (LatticeTileGridStructure W hW).1.1 + have touchD (U V : ProtoTile) (hU : LatticeTile U) (hV : LatticeTile V) + (ht : TileTouching U V) : Disjoint U.cells V.cells := by + rcases ht with ht | ht | ht + · exact ht.2.2.1 + · have hh := ne U hU; rw [ht.1] at hh; simp at hh + · have hh := ne V hV; rw [ht.1] at hh; simp at hh + have third_missing (U V W : ProtoTile) + (hW : LatticeTile W) (hw : x ∈ FootprintVertices W) + (hdU : Disjoint W.cells U.cells) (hdV : Disjoint W.cells V.cells) : + ¬ (∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩ → z ∈ U.cells ∨ z ∈ V.cells) := by + intro hall + have hne := ne W hW + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hw + obtain ⟨z, hz, hcorner⟩ := hw + have hbase : z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩ := by + rcases hcorner with h | h | h | h + · exact Or.inl h.symm + · exact Or.inr (Or.inl (by rw [h]; simp)) + · exact Or.inr (Or.inr (Or.inl (by rw [h]; simp))) + · exact Or.inr (Or.inr (Or.inr (by rw [h]; simp [sub_sub]))) + rcases hall z hbase with hu | hv + · exact Finset.disjoint_left.mp hdU hz hu + · exact Finset.disjoint_left.mp hdV hz hv + have liftStar (U V U' V' : ProtoTile) + (hu : FootprintVertices U ⊆ FootprintVertices U') + (hv : FootprintVertices V ⊆ FootprintVertices V') + (hstar : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V) : + ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices U' ∨ y ∈ FootprintVertices V' := by + intro y hy + exact (hstar y hy).imp (fun h => hu h) (fun h => hv h) + have swapStar (U V : ProtoTile) + (hstar : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V) : + ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices V ∨ y ∈ FootprintVertices U := + fun y hy => (hstar y hy).symm + obtain ⟨m12, m13, m21, m31, m23, m32⟩ := + P4590T1MixedCompanionMarks q cfg C T cert hT x hx hxb + have subQ2 := (cert.plus_occurrence 1 true).2.1 + have subQ3 := (cert.plus_occurrence 2 true).2.1 + have subS2 := (cert.minus_occurrence 1 false).2.1 + have subS3 := (cert.minus_occurrence 2 false).2.1 + rcases hjunction with h | h | h | h + · have hA := subQ2 h.1.1 + have hB := subS3 h.1.2 + have hC := h.2 + have sec := LocalLatticeInterfaceSectors.1 _ _ _ x hQ2 hS3 + (cert.parent_lattice 1 true) cert.double_first h + rcases sec.2.2.2.2 with opp | opp | opp + · exact .largestPositive h.1.1 h.1.2 + (P4590T1OppositeCellsStar _ _ x opp) (by simp [hC]) + · apply BandOrderedGeneralInteriorWebRow.rightPositive h.1.1 hC + (P4590T1OppositeCellsStar _ _ x opp) + simpa only [Bool.true_eq_false, iff_false] using + third_missing _ _ _ hS3 h.1.2 + (touchD _ _ hQ2 hS3 cert.double_first.1).symm + (touchD _ _ hS3 (cert.parent_lattice 1 true) cert.double_first.2.1) + · have st := P4590T1OppositeCellsStar _ _ x opp + exact .outer21 hC hB + (swapStar _ _ (liftStar _ _ _ _ subS3 (fun _ h => h) st)) + (by simp [hA]) ((m21 hC hB).trans (by simp [hA])) + · have hA := subQ3 h.1.1 + have hB := subS2 h.1.2 + have hD := h.2 + have sec := LocalLatticeInterfaceSectors.1 _ _ _ x hQ3 hS2 + (cert.parent_lattice 1 false) cert.double_second h + rcases sec.2.2.2.2 with opp | opp | opp + · exact .largestReflected h.1.1 h.1.2 + (P4590T1OppositeCellsStar _ _ x opp) (by simp [hD]) + · have st := P4590T1OppositeCellsStar _ _ x opp + exact .outer12 hA hD + (liftStar _ _ _ _ subQ3 (fun _ h => h) st) + (by simp [hB]) ((m12 hA hD).trans (by simp [hB])) + · apply BandOrderedGeneralInteriorWebRow.rightReflected h.1.2 hD + (P4590T1OppositeCellsStar _ _ x opp) + simpa only [Bool.true_eq_false, iff_false] using + third_missing _ _ _ hQ3 h.1.1 + (touchD _ _ hQ3 hS2 cert.double_second.1) + (touchD _ _ (cert.parent_lattice 1 false) hQ3 + cert.double_second.2.2.1).symm + · have hA := subQ2 h.1.1 + have hC := h.1.2 + have hF := h.2 + have sec := LocalLatticeInterfaceSectors.1 _ _ _ x hQ2 + (cert.parent_lattice 1 true) (cert.parent_lattice 2 false) + cert.double_third h + rcases sec.2.2.2.2 with opp | opp | opp + · apply BandOrderedGeneralInteriorWebRow.rightPositive h.1.1 hC + (P4590T1OppositeCellsStar _ _ x opp) + simpa only [Bool.true_eq_false, iff_false] using + third_missing _ _ _ (cert.parent_lattice 2 false) hF + (touchD _ _ (cert.parent_lattice 2 false) hQ2 + cert.double_third.2.2.1) + (touchD _ _ (cert.parent_lattice 1 true) (cert.parent_lattice 2 false) + cert.double_third.2.1).symm + · have st := P4590T1OppositeCellsStar _ _ x opp + exact .outer13 hA hF + (liftStar _ _ _ _ subQ2 (fun _ h => h) st) + (by simp [hC]) ((m13 hA hF).trans (by simp [hC])) + · exact .outer23 hC hF (P4590T1OppositeCellsStar _ _ x opp) + (by simp [hA]) ((m23 hC hF).trans (by simp [hA])) + · have hB := subS2 h.1.1 + have hD := h.1.2 + have hE := h.2 + have sec := LocalLatticeInterfaceSectors.1 _ _ _ x hS2 + (cert.parent_lattice 1 false) (cert.parent_lattice 2 true) + cert.double_fourth h + rcases sec.2.2.2.2 with opp | opp | opp + · apply BandOrderedGeneralInteriorWebRow.rightReflected h.1.1 hD + (P4590T1OppositeCellsStar _ _ x opp) + simpa only [Bool.true_eq_false, iff_false] using + third_missing _ _ _ (cert.parent_lattice 2 true) hE + (touchD _ _ (cert.parent_lattice 2 true) hS2 + cert.double_fourth.2.2.1) + (touchD _ _ (cert.parent_lattice 1 false) (cert.parent_lattice 2 true) + cert.double_fourth.2.1).symm + · have st := P4590T1OppositeCellsStar _ _ x opp + exact .outer31 hE hB + (swapStar _ _ (liftStar _ _ _ _ subS2 (fun _ h => h) st)) + (by simp [hD]) ((m31 hE hB).trans (by simp [hD])) + · exact .outer32 hE hD + (swapStar _ _ (P4590T1OppositeCellsStar _ _ x opp)) + (by simp [hB]) ((m32 hE hD).trans (by simp [hB])) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1MixedCompanionMarks.lean b/LeanPool/ApollonianSuperharmonic/P4590T1MixedCompanionMarks.lean new file mode 100644 index 0000000000..0f1a1b0e62 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4590T1MixedCompanionMarks.lean @@ -0,0 +1,561 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints +public import LeanPool.ApollonianSuperharmonic.P3996T1AdjacentParentPlacement +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.P4590T1PositivePrototileDisk +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEndpointPairUnique +public import LeanPool.ApollonianSuperharmonic.P4590T1JunctionRefinement +public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import LeanPool.ApollonianSuperharmonic.P4616T1OriginalMixedPaths +public import LeanPool.ApollonianSuperharmonic.P4616T1MixedCoarseSectors +public import LeanPool.ApollonianSuperharmonic.P4616T1PeriodicEndpointExclusion +public import LeanPool.ApollonianSuperharmonic.P4616T1FirstPredecessorCentroids +public import LeanPool.ApollonianSuperharmonic.P4616T1NestedCompanionFootprints +public import LeanPool.ApollonianSuperharmonic.P4616T1ThirdOwnerPathEndpoint + +-- [TABLET NODE: P4590T1MixedCompanionMarks] + +/-! +# P4590T1MixedCompanionMarks + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace MixedCompanionMarksGeometry + +private theorem endpointMem : + (by + classical + exact + ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {a : GaussianInt}, ∀ + {b : GaussianInt}, (SimpleGridPathBetween V E a b) → (a ∈ V ∧ b ∈ V) ) := by + classical + intro V E a b hp + obtain ⟨xs, _, hlen, hh, ht, hv, _, _⟩ := hp + have hne : xs ≠ [] := by intro he; simp [he] at hlen + have hhead : xs.head hne = a := by + simpa [List.head?_eq_some_head hne] using hh + have hlast : xs.getLast hne = b := by + simpa [List.getLast?_eq_some_getLast hne] using ht + rw [hv] + constructor + · change a ∈ xs.toFinset + exact List.mem_toFinset.mpr (hhead ▸ List.head_mem hne) + · change b ∈ xs.toFinset + exact List.mem_toFinset.mpr (hlast ▸ List.getLast_mem hne) + +private theorem pairDisjoint : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), + let U : Fin 6 → ProtoTile := ![cert.P 0 true, cert.P 0 true, + cert.P 0 false, cert.P 0 false, cert.P 1 true, cert.P 1 false] + let W : Fin 6 → ProtoTile := ![cert.P 1 false, cert.P 2 false, + cert.P 1 true, cert.P 2 true, cert.P 2 false, cert.P 2 true] + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), (i, s) ≠ (j, t) → + ¬(i = (0 : Fin (3 : ℕ)) ∧ j = (0 : Fin (3 : ℕ))) → Disjoint (cert.P i s).cells + (cert.P j t).cells) → (∀ (k : Fin 6), Disjoint (U k).cells (W k).cells) ) := by + classical + intro q cfg C T cert U W separate k + fin_cases k <;> dsimp [U, W] <;> + exact separate _ _ _ _ (by decide) (by decide) + +private theorem exclude : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), + let U : Fin 6 → ProtoTile := ![cert.P 0 true, cert.P 0 true, + cert.P 0 false, cert.P 0 false, cert.P 1 true, cert.P 1 false] + let W : Fin 6 → ProtoTile := ![cert.P 1 false, cert.P 2 false, + cert.P 1 true, cert.P 2 true, cert.P 2 false, cert.P 2 true] + let K : Fin 6 → ProtoTile := ![cert.P 0 false, cert.P 1 true, + cert.P 0 true, cert.P 1 false, cert.P 0 true, cert.P 0 false] + let H : Fin 6 → ProtoTile := ![ + TileTranslation (cert.P 0 false) (cert.u + cert.v), + TileTranslation (cert.P 0 false) cert.v, + TileTranslation (cert.P 0 true) (-cert.u - cert.v), + TileTranslation (cert.P 0 true) (-cert.v), + TileTranslation (cert.P 1 false) (-cert.u), + TileTranslation (cert.P 1 true) cert.u] + let rho := fun f : PeriodicSubtileFaceIndex => + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm f) + let p : Fin 6 → GaussianInt := ![rho ⟨.I2, 0, 0⟩, rho ⟨.I3, 0, 0⟩, + rho ⟨.I1, 0, 0⟩, rho ⟨.I4, 0, 0⟩, rho ⟨.I3, 0, 0⟩, rho ⟨.I4, 0, 0⟩] + let l : Fin 6 → GaussianInt := ![rho ⟨.J4, 0, 0⟩, rho ⟨.J2, 0, 0⟩, + rho ⟨.J3, -1, -1⟩, rho ⟨.J1, 0, -1⟩, rho ⟨.J8, 0, 0⟩, + rho ⟨.J7, 1, 0⟩] + (∀ (k : Fin (6 : ℕ)), SimpleGridPathBetween (FootprintVertices (U k) ∩ FootprintVertices + (W k)) (FootprintEdges (U k) ∩ FootprintEdges (W k)) (p k) (l k) ∧ p k ∈ + FootprintVertices (K k) ∧ l k ∈ FootprintVertices (H k)) → ((∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ T.cells) → (∀ (k : Fin 6), x ≠ l k)) ) := by + classical + intro q cfg C T cert x U W K H rho p l paths rootstar k + let S : Fin 6 → ProtoTile := ![cert.P 0 false, cert.P 0 false, + cert.P 0 true, cert.P 0 true, cert.P 1 false, cert.P 1 true] + let m : Fin 6 → Int := ![1, 0, -1, 0, -1, 1] + let n : Fin 6 → Int := ![1, 1, -1, -1, 0, 0] + have hS : (S k).cells.Nonempty := by + fin_cases k <;> exact (LatticeTileGridStructure _ (cert.parent_lattice _ _)).1.1 + have hST : (S k).cells ⊆ T.cells := by + intro a ha + apply (cert.outer_union a).mpr + fin_cases k <;> exact ⟨_, _, ha⟩ + have hmn : (m k, n k) ≠ (0, 0) := by fin_cases k <;> decide + apply P4616T1PeriodicEndpointExclusion q cfg C T cert + (S k) hS hST (m k) (n k) hmn x (l k) rootstar + have hh := (paths k).2.2 + fin_cases k <;> simpa [S, m, n, H, sub_eq_add_neg] using hh + +private theorem coarse : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), + let U : Fin 6 → ProtoTile := ![cert.P 0 true, cert.P 0 true, + cert.P 0 false, cert.P 0 false, cert.P 1 true, cert.P 1 false] + let W : Fin 6 → ProtoTile := ![cert.P 1 false, cert.P 2 false, + cert.P 1 true, cert.P 2 true, cert.P 2 false, cert.P 2 true] + let K : Fin 6 → ProtoTile := ![cert.P 0 false, cert.P 1 true, + cert.P 0 true, cert.P 1 false, cert.P 0 true, cert.P 0 false] + let H : Fin 6 → ProtoTile := ![ + TileTranslation (cert.P 0 false) (cert.u + cert.v), + TileTranslation (cert.P 0 false) cert.v, + TileTranslation (cert.P 0 true) (-cert.u - cert.v), + TileTranslation (cert.P 0 true) (-cert.v), + TileTranslation (cert.P 1 false) (-cert.u), + TileTranslation (cert.P 1 true) cert.u] + let rho := fun f : PeriodicSubtileFaceIndex => + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm f) + let p : Fin 6 → GaussianInt := ![rho ⟨.I2, 0, 0⟩, rho ⟨.I3, 0, 0⟩, + rho ⟨.I1, 0, 0⟩, rho ⟨.I4, 0, 0⟩, rho ⟨.I3, 0, 0⟩, rho ⟨.I4, 0, 0⟩] + let l : Fin 6 → GaussianInt := ![rho ⟨.J4, 0, 0⟩, rho ⟨.J2, 0, 0⟩, + rho ⟨.J3, -1, -1⟩, rho ⟨.J1, 0, -1⟩, rho ⟨.J8, 0, 0⟩, + rho ⟨.J7, 1, 0⟩] + (∀ (k : Fin (6 : ℕ)), SimpleGridPathBetween (FootprintVertices (U k) ∩ FootprintVertices + (W k)) (FootprintEdges (U k) ∩ FootprintEdges (W k)) (p k) (l k) ∧ p k ∈ + FootprintVertices (K k) ∧ l k ∈ FootprintVertices (H k)) → ((∀ (k : Fin 6), Disjoint + (U k).cells (W k).cells) → ((∀ (k : Fin 6), LatticeTile (U k)) → ((∀ (k : Fin 6), + LatticeTile (W k)) → ((∀ (k : Fin 6), x ≠ l k) → ((∀ (k : Fin (6 : ℕ)), ∀ z ∈ + FootprintVertices (U k), z ∈ FootprintVertices (W k) → z ∈ FootprintVertices (K k) → + ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell z j ∈ (K k).cells ∧ + LatticeVertexIncidentCell z j ∉ (U k).cells ∧ LatticeVertexIncidentCell z j ∉ (W + k).cells) → (∀ (k : Fin 6), (x ∈ FootprintVertices (U k)) → ((x ∈ FootprintVertices + (W k)) → (x ∈ FootprintVertices (K k) ↔ x = p k)))))))) ) := by + classical + intro q cfg C T cert x U W K H rho p l paths pairDisjoint diskU diskW exclude sectors k hu hw + constructor + · intro hk + exact (P4616T1ThirdOwnerPathEndpoint (U k) (W k) (K k) + (p k) (l k) x _ (diskU k) (diskW k) (pairDisjoint k) + (paths k).1 ⟨hu, hw⟩ (sectors k x hu hw hk)).resolve_right (exclude k) + · intro he + simpa only [he] using (paths k).2.1 + +private theorem pos2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let r := cfg.firstPredecessor + 0 < (r 2).1 ) := by + classical + intro q cfg r + dsimp [r] + rw [cfg.firstParentTwo] + have hh := cfg.secondLarge + omega + +private theorem pos3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let r := cfg.firstPredecessor + 0 < (r 3).1 ) := by + classical + intro q cfg r + dsimp [r] + rw [cfg.firstParentThree] + have hh := (ProperBandCurvatureStructure q cfg.proper).2.1 2 + have hn := cfg.noLine 3 + change 0 ≤ (q 3).1 at hh + omega + +private theorem firstFour : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), + let U : Fin 6 → ProtoTile := ![cert.P 0 true, cert.P 0 true, + cert.P 0 false, cert.P 0 false, cert.P 1 true, cert.P 1 false] + let W : Fin 6 → ProtoTile := ![cert.P 1 false, cert.P 2 false, + cert.P 1 true, cert.P 2 true, cert.P 2 false, cert.P 2 true] + let K : Fin 6 → ProtoTile := ![cert.P 0 false, cert.P 1 true, + cert.P 0 true, cert.P 1 false, cert.P 0 true, cert.P 0 false] + let H : Fin 6 → ProtoTile := ![ + TileTranslation (cert.P 0 false) (cert.u + cert.v), + TileTranslation (cert.P 0 false) cert.v, + TileTranslation (cert.P 0 true) (-cert.u - cert.v), + TileTranslation (cert.P 0 true) (-cert.v), + TileTranslation (cert.P 1 false) (-cert.u), + TileTranslation (cert.P 1 true) cert.u] + let rho := fun f : PeriodicSubtileFaceIndex => + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm f) + let p : Fin 6 → GaussianInt := ![rho ⟨.I2, 0, 0⟩, rho ⟨.I3, 0, 0⟩, + rho ⟨.I1, 0, 0⟩, rho ⟨.I4, 0, 0⟩, rho ⟨.I3, 0, 0⟩, rho ⟨.I4, 0, 0⟩] + let l : Fin 6 → GaussianInt := ![rho ⟨.J4, 0, 0⟩, rho ⟨.J2, 0, 0⟩, + rho ⟨.J3, -1, -1⟩, rho ⟨.J1, 0, -1⟩, rho ⟨.J8, 0, 0⟩, + rho ⟨.J7, 1, 0⟩] + (∀ (k : Fin (6 : ℕ)), SimpleGridPathBetween (FootprintVertices (U k) ∩ + FootprintVertices (W k)) (FootprintEdges (U k) ∩ FootprintEdges (W k)) (p k) (l k) ∧ + p k ∈ FootprintVertices (K k) ∧ l k ∈ FootprintVertices (H k)) → ((∀ + {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {a : GaussianInt}, ∀ + {b : GaussianInt}, (SimpleGridPathBetween V E a b) → (a ∈ V ∧ b ∈ V)) → ( + let r := cfg.firstPredecessor + let j : Fin 4 → Fin 3 := ![1, 2, 1, 2] + let s : Fin 4 → Fin 4 := ![3, 0, 1, 2] + let e : Fin 4 → Fin 6 := fun k => ⟨k.val, by omega⟩ + (0 < (r 2).1) → ((0 < (r 3).1) → (∀ (k : Fin 4), (x ∈ FootprintVertices (U (e k))) → ((x + ∈ FootprintVertices (W (e k))) → (x ∈ FootprintVertices (TileTranslation (U (e k)) + ((⟨0, 1⟩ : GaussianInt) ^ (s k).val * (if Even (s k).val then BandVectors.1 (r 0) (r + (j k).succ) else BandVectors.1 (r (j k).succ) (r 0)))) ↔ x = p (e k)))))))) := by + classical + intro q cfg C T cert x U W K H rho p l paths endpointMem r j s e pos2 pos3 k hu hw + have hbU : BandPrototile (r 0) (U (e k)) := by + fin_cases k <;> first + | simpa [r, cfg.firstChild, U, e] using (cert.outer_occurrence 0 true).1 + | simpa [r, cfg.firstChild, U, e] using (cert.outer_occurrence 0 false).1 + have hbW : BandPrototile (r (j k).succ) (W (e k)) := by + fin_cases k <;> simp only [j] + all_goals first + | simpa [r, cfg.firstParentTwo, W, e] using (cert.outer_occurrence 1 false).1 + | simpa [r, cfg.firstParentTwo, W, e] using (cert.outer_occurrence 1 true).1 + | simpa [r, cfg.firstParentThree, W, e] using (cert.outer_occurrence 2 false).1 + | simpa [r, cfg.firstParentThree, W, e] using (cert.outer_occurrence 2 true).1 + have hposW : 0 < (r (j k).succ).1 := by + fin_cases k <;> first | exact pos2 | exact pos3 + have hposZ : 0 < (r ((if Even (s k).val then j k - 1 else j k + 1).succ)).1 := by + fin_cases k <;> norm_num [j, s, show Even (0 : Nat) from by decide, + show ¬Even (1 : Nat) from by decide, + show Even (2 : Nat) from by decide, + show ¬Even (3 : Nat) from by decide] <;> first | exact pos2 | exact pos3 + obtain ⟨Z, hbZ, hcZ⟩ := P3996T1AdjacentParentPlacement r cfg.firstProper + (j k) (s k) (U (e k)) hbU + have algebra := P4616T1FirstPredecessorCentroids q cfg C T cert k + have hcW : TileCentroid (W (e k)) - TileCentroid (U (e k)) = + (1 / 2 : Real) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (s k).val * + (BandVectors.1 (r (j k).succ) (r 0) + BandVectors.1 (r 0) (r (j k).succ))) := by + fin_cases k <;> simpa [U, W, e, j, s, r] using algebra.1 + obtain ⟨R, I, _, hne, _, hlink, _, _⟩ := + BandOrientedChildParentEndpoints r cfg.firstProper (j k) (s k) + (U (e k)) (W (e k)) Z hbU hbW hbZ + (ProperBandCurvatureStructure r cfg.firstProper).1 hposW hposZ hcW hcZ + have hbH : BandPrototile (r 0) (H (e k)) := by + fin_cases k <;> dsimp [H, e] <;> apply BandPrototileTranslation + all_goals first + | simpa [r, cfg.firstChild] using (cert.outer_occurrence 0 false).1 + | simpa [r, cfg.firstChild] using (cert.outer_occurrence 0 true).1 + have hcH : TileCentroid (TileTranslation (U (e k)) + ((⟨0, 1⟩ : GaussianInt) ^ (s k).val * + (if Even (s k).val then BandVectors.1 (r (j k).succ) (r 0) + else BandVectors.1 (r 0) (r (j k).succ)))) = TileCentroid (H (e k)) := by + fin_cases k <;> simpa [U, H, e, j, s, r] using algebra.2 + obtain ⟨hcell, hanchor⟩ := BandPrototileCentroidUnique _ _ _ + (BandPrototileTranslation _ _ _ hbU) hbH hcH + have hfoot := (ProtoTileObservableExtensionality _ _ hcell hanchor).1 + have hl := (endpointMem (paths (e k)).1).2 + have hi : I.point = l (e k) := by + apply Eq.symm + apply (I.unique_common _).mp + exact ⟨⟨hl.1, hfoot.symm ▸ (paths (e k)).2.2⟩, hl.2⟩ + have hpR : SimpleGridPathBetween + (FootprintVertices (U (e k)) ∩ FootprintVertices (W (e k))) + (FootprintEdges (U (e k)) ∩ FootprintEdges (W (e k))) R.point I.point := by + simpa only [Set.inter_comm, hlink] using R.pathCA + have he := SimpleGridPathEndpointPairUnique (paths (e k)).1 hpR + have hr : R.point = p (e k) := by + have hm : R.point ∈ ({p (e k), l (e k)} : Finset GaussianInt) := by + rw [he] + simp + rcases (show R.point = p (e k) ∨ R.point = l (e k) by simpa using hm) with hr | hr + · exact hr + · exact (hne (hr.trans hi.symm)).elim + constructor + · intro h + exact ((R.unique_common x).mp ⟨⟨hu, h⟩, hw⟩).trans hr + · intro h + exact ((R.unique_common x).mpr (h.trans hr.symm)).1.2 + +private theorem incident : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (N : ProtoTile), (N.cells.Nonempty) → ((x ∈ FootprintVertices N) → + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ N.cells)) ) := by + classical + intro x N hne hn + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hn + rcases hn with ⟨a, ha, h | h | h | h⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using h ▸ ha⟩ + · refine ⟨1, ?_⟩; rw [h]; simpa [LatticeVertexIncidentCell] using ha + · refine ⟨3, ?_⟩; rw [h]; simpa [LatticeVertexIncidentCell] using ha + · refine ⟨2, ?_⟩ + change x - 1 - ⟨0, 1⟩ ∈ N.cells + rw [h] + convert ha using 1 + ext <;> simp + +private theorem touchDisjoint : + (by + classical + exact + ∀ (M : ProtoTile), ∀ (N : ProtoTile), (M.cells.Nonempty) → ((N.cells.Nonempty) → + ((TileTouching M N) → (Disjoint M.cells N.cells))) ) := by + classical + intro M N hm hn ht + rcases ht with ht | ht | ht + · exact ht.2.2.1 + · rw [ht.1] at hm; simp at hm + · rw [ht.1] at hn; simp at hn + +private theorem nested : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), + let U : Fin 6 → ProtoTile := ![cert.P 0 true, cert.P 0 true, + cert.P 0 false, cert.P 0 false, cert.P 1 true, cert.P 1 false] + let W : Fin 6 → ProtoTile := ![cert.P 1 false, cert.P 2 false, + cert.P 1 true, cert.P 2 true, cert.P 2 false, cert.P 2 true] + let K : Fin 6 → ProtoTile := ![cert.P 0 false, cert.P 1 true, + cert.P 0 true, cert.P 1 false, cert.P 0 true, cert.P 0 false] + let H : Fin 6 → ProtoTile := ![ + TileTranslation (cert.P 0 false) (cert.u + cert.v), + TileTranslation (cert.P 0 false) cert.v, + TileTranslation (cert.P 0 true) (-cert.u - cert.v), + TileTranslation (cert.P 0 true) (-cert.v), + TileTranslation (cert.P 1 false) (-cert.u), + TileTranslation (cert.P 1 true) cert.u] + let rho := fun f : PeriodicSubtileFaceIndex => + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm f) + let p : Fin 6 → GaussianInt := ![rho ⟨.I2, 0, 0⟩, rho ⟨.I3, 0, 0⟩, + rho ⟨.I1, 0, 0⟩, rho ⟨.I4, 0, 0⟩, rho ⟨.I3, 0, 0⟩, rho ⟨.I4, 0, 0⟩] + let l : Fin 6 → GaussianInt := ![rho ⟨.J4, 0, 0⟩, rho ⟨.J2, 0, 0⟩, + rho ⟨.J3, -1, -1⟩, rho ⟨.J1, 0, -1⟩, rho ⟨.J8, 0, 0⟩, + rho ⟨.J7, 1, 0⟩] + (∀ (k : Fin (6 : ℕ)), SimpleGridPathBetween (FootprintVertices (U k) ∩ FootprintVertices + (W k)) (FootprintEdges (U k) ∩ FootprintEdges (W k)) (p k) (l k) ∧ p k ∈ + FootprintVertices (K k) ∧ l k ∈ FootprintVertices (H k)) → ((∀ (k : Fin 6), Disjoint + (U k).cells (W k).cells) → ((∀ (k : Fin 6), LatticeTile (U k)) → ((∀ (k : Fin 6), + LatticeTile (W k)) → ((∀ (k : Fin 6), x ≠ l k) → ((∀ (N : ProtoTile), + (N.cells.Nonempty) → ((x ∈ FootprintVertices N) → (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ N.cells))) → (∀ (k : Fin 6), ∀ (N : ProtoTile), + (N.cells.Nonempty) → ((Disjoint N.cells (U k).cells) → ((Disjoint N.cells (W + k).cells) → ((x = p k → x ∈ FootprintVertices N) → ((x ∈ FootprintVertices (U k)) → + ((x ∈ FootprintVertices (W k)) → (x ∈ FootprintVertices N ↔ x = p k)))))))))))) ) := by + classical + intro q cfg C T cert x U W K H rho p l paths pairDisjoint diskU diskW exclude incident k N hne + hNU hNW hpresent hu hw + refine ⟨?_, hpresent⟩ + intro hn + obtain ⟨j, hj⟩ := incident N hne hn + apply (P4616T1ThirdOwnerPathEndpoint (U k) (W k) N (p k) (l k) x _ + (diskU k) (diskW k) (pairDisjoint k) (paths k).1 ⟨hu, hw⟩ ?_).resolve_right (exclude k) + exact ⟨j, hj, fun h => Finset.disjoint_left.mp hNU hj h, + fun h => Finset.disjoint_left.mp hNW hj h⟩ + +end MixedCompanionMarksGeometry + +theorem P4590T1MixedCompanionMarks + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (hT : LatticeTile T) (x : GaussianInt) + (hx : x ∈ FootprintVertices T) (hxb : x ∉ BoundaryFootprintVertices T) : + (x ∈ FootprintVertices (cert.P 0 true) → x ∈ FootprintVertices (cert.P 1 false) → + (x ∈ FootprintVertices (TileTranslation (cert.P 0 true) + ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * + (if Even (3 : Nat) then + BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) + else BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0)))) ↔ + x ∈ FootprintVertices (cert.P 0 false))) ∧ + (x ∈ FootprintVertices (cert.P 0 true) → x ∈ FootprintVertices (cert.P 2 false) → + (x ∈ FootprintVertices (TileTranslation (cert.P 0 true) + ((⟨0, 1⟩ : GaussianInt) ^ (0 : Nat) * + (if Even (0 : Nat) then + BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) + else BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0)))) ↔ + x ∈ FootprintVertices (cert.P 1 true))) ∧ + (x ∈ FootprintVertices (cert.P 1 true) → x ∈ FootprintVertices (cert.P 0 false) → + (x ∈ FootprintVertices (TileTranslation (cert.P 0 false) + ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * + (if Even (1 : Nat) then + BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) + else BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0)))) ↔ + x ∈ FootprintVertices (cert.P 0 true))) ∧ + (x ∈ FootprintVertices (cert.P 2 true) → x ∈ FootprintVertices (cert.P 0 false) → + (x ∈ FootprintVertices (TileTranslation (cert.P 0 false) + ((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + (if Even (2 : Nat) then + BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 3) + else BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0)))) ↔ + x ∈ FootprintVertices (cert.P 1 false))) ∧ + (x ∈ FootprintVertices (cert.P 1 true) → x ∈ FootprintVertices (cert.P 2 false) → + (x ∈ FootprintVertices (TileTranslation (cert.P 1 true) + ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * + (if Even (3 : Nat) then + BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) + else BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0)))) ↔ + x ∈ FootprintVertices (cert.P 0 true))) ∧ + (x ∈ FootprintVertices (cert.P 2 true) → x ∈ FootprintVertices (cert.P 1 false) → + (x ∈ FootprintVertices (TileTranslation (cert.P 1 false) + ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * + (if Even (1 : Nat) then + BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) + else BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0)))) ↔ + x ∈ FootprintVertices (cert.P 0 false))) := by +-- BODY + classical + let U : Fin 6 → ProtoTile := ![cert.P 0 true, cert.P 0 true, + cert.P 0 false, cert.P 0 false, cert.P 1 true, cert.P 1 false] + let W : Fin 6 → ProtoTile := ![cert.P 1 false, cert.P 2 false, + cert.P 1 true, cert.P 2 true, cert.P 2 false, cert.P 2 true] + let K : Fin 6 → ProtoTile := ![cert.P 0 false, cert.P 1 true, + cert.P 0 true, cert.P 1 false, cert.P 0 true, cert.P 0 false] + let H : Fin 6 → ProtoTile := ![ + TileTranslation (cert.P 0 false) (cert.u + cert.v), + TileTranslation (cert.P 0 false) cert.v, + TileTranslation (cert.P 0 true) (-cert.u - cert.v), + TileTranslation (cert.P 0 true) (-cert.v), + TileTranslation (cert.P 1 false) (-cert.u), + TileTranslation (cert.P 1 true) cert.u] + let rho := fun f : PeriodicSubtileFaceIndex => + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm f) + let p : Fin 6 → GaussianInt := ![rho ⟨.I2, 0, 0⟩, rho ⟨.I3, 0, 0⟩, + rho ⟨.I1, 0, 0⟩, rho ⟨.I4, 0, 0⟩, rho ⟨.I3, 0, 0⟩, rho ⟨.I4, 0, 0⟩] + let l : Fin 6 → GaussianInt := ![rho ⟨.J4, 0, 0⟩, rho ⟨.J2, 0, 0⟩, + rho ⟨.J3, -1, -1⟩, rho ⟨.J1, 0, -1⟩, rho ⟨.J8, 0, 0⟩, + rho ⟨.J7, 1, 0⟩] + have paths := P4616T1OriginalMixedPaths q cfg C T cert + change ∀ k, SimpleGridPathBetween + (FootprintVertices (U k) ∩ FootprintVertices (W k)) + (FootprintEdges (U k) ∩ FootprintEdges (W k)) (p k) (l k) ∧ + p k ∈ FootprintVertices (K k) ∧ l k ∈ FootprintVertices (H k) at paths + have endpointMem {V : Set GaussianInt} {E : Set (Finset GaussianInt)} + {a b : GaussianInt} (hp : SimpleGridPathBetween V E a b) : a ∈ V ∧ b ∈ V := + MixedCompanionMarksGeometry.endpointMem (V := V) (E := E) (a := a) (b := b) hp + obtain ⟨_, _, _, _, _, _, _, separate⟩ := + P4339T1PrecursorSupportGeometry C q cfg T cert + have pairDisjoint (k : Fin 6) : Disjoint (U k).cells (W k).cells := + MixedCompanionMarksGeometry.pairDisjoint q cfg C T cert separate k + have diskU (k : Fin 6) : LatticeTile (U k) := by + fin_cases k <;> exact cert.parent_lattice _ _ + have diskW (k : Fin 6) : LatticeTile (W k) := by + fin_cases k <;> exact cert.parent_lattice _ _ + have rootstar := (P4456T2VertexInterior T + (LatticeTileGridStructure T hT).1.1 x hx).2.mp hxb + have exclude (k : Fin 6) : x ≠ l k := MixedCompanionMarksGeometry.exclude q cfg C T cert x + paths rootstar k + have sectors := P4616T1MixedCoarseSectors q cfg C T cert + change ∀ k z, z ∈ FootprintVertices (U k) → z ∈ FootprintVertices (W k) → + z ∈ FootprintVertices (K k) → ∃ j : Fin 4, + LatticeVertexIncidentCell z j ∈ (K k).cells ∧ + LatticeVertexIncidentCell z j ∉ (U k).cells ∧ + LatticeVertexIncidentCell z j ∉ (W k).cells at sectors + have coarse (k : Fin 6) (hu : x ∈ FootprintVertices (U k)) + (hw : x ∈ FootprintVertices (W k)) : + x ∈ FootprintVertices (K k) ↔ x = p k := MixedCompanionMarksGeometry.coarse q cfg C T cert + x paths pairDisjoint diskU diskW exclude sectors k hu hw + let r := cfg.firstPredecessor + let j : Fin 4 → Fin 3 := ![1, 2, 1, 2] + let s : Fin 4 → Fin 4 := ![3, 0, 1, 2] + let e : Fin 4 → Fin 6 := fun k => ⟨k.val, by omega⟩ + have pos2 : 0 < (r 2).1 := MixedCompanionMarksGeometry.pos2 q cfg + have pos3 : 0 < (r 3).1 := MixedCompanionMarksGeometry.pos3 q cfg + have firstFour (k : Fin 4) (hu : x ∈ FootprintVertices (U (e k))) + (hw : x ∈ FootprintVertices (W (e k))) : + x ∈ FootprintVertices (TileTranslation (U (e k)) + ((⟨0, 1⟩ : GaussianInt) ^ (s k).val * + (if Even (s k).val then BandVectors.1 (r 0) (r (j k).succ) + else BandVectors.1 (r (j k).succ) (r 0)))) ↔ x = p (e k) := + MixedCompanionMarksGeometry.firstFour q cfg C T cert x paths endpointMem pos2 + pos3 k hu hw + have incident (N : ProtoTile) (hne : N.cells.Nonempty) + (hn : x ∈ FootprintVertices N) : + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ N.cells := + MixedCompanionMarksGeometry.incident x N hne hn + have touchDisjoint (M N : ProtoTile) (hm : M.cells.Nonempty) + (hn : N.cells.Nonempty) (ht : TileTouching M N) : Disjoint M.cells N.cells := + MixedCompanionMarksGeometry.touchDisjoint M N hm hn ht + have nested (k : Fin 6) (N : ProtoTile) (hne : N.cells.Nonempty) + (hNU : Disjoint N.cells (U k).cells) (hNW : Disjoint N.cells (W k).cells) + (hpresent : x = p k → x ∈ FootprintVertices N) + (hu : x ∈ FootprintVertices (U k)) (hw : x ∈ FootprintVertices (W k)) : + x ∈ FootprintVertices N ↔ x = p k := MixedCompanionMarksGeometry.nested q cfg C T cert x + paths pairDisjoint diskU diskW exclude incident k N hne hNU hNW hpresent hu hw + have hQdisk := P4590T1PositivePrototileDisk _ _ + (cert.plus_occurrence 1 true).1 pos2 + have hSdisk := P4590T1PositivePrototileDisk _ _ + (cert.minus_occurrence 1 false).1 pos2 + have hQne := (LatticeTileGridStructure _ hQdisk).1.1 + have hSne := (LatticeTileGridStructure _ hSdisk).1.1 + have hf := P4616T1NestedCompanionFootprints q cfg C T cert + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro ha hd + exact (firstFour 0 ha hd).trans (coarse 0 ha hd).symm + · intro ha hf + exact (firstFour 1 ha hf).trans (coarse 1 ha hf).symm + · intro hc hb + exact (firstFour 2 hb hc).trans (coarse 2 hb hc).symm + · intro he hb + exact (firstFour 3 hb he).trans (coarse 3 hb he).symm + · intro hc hF + have hn := nested 4 (cert.Q 1 true) hQne + (touchDisjoint _ _ hQne (LatticeTileGridStructure _ (diskU 4)).1.1 cert.double_third.1) + (touchDisjoint _ _ (LatticeTileGridStructure _ (diskW 4)).1.1 hQne + cert.double_third.2.2.1).symm + (fun h => by simpa [h, p, rho] using cert.inner_third.1) hc hF + have ht := hn.trans (coarse 4 hc hF).symm + simpa [show ¬Even (3 : Nat) from by decide, hf.1, K] using ht + · intro he hd + have hn := nested 5 (cert.S 1 false) hSne + (touchDisjoint _ _ hSne (LatticeTileGridStructure _ (diskU 5)).1.1 cert.double_fourth.1) + (touchDisjoint _ _ (LatticeTileGridStructure _ (diskW 5)).1.1 hSne + cert.double_fourth.2.2.1).symm + (fun h => (P4590T1JunctionRefinement q cfg C T cert hT x hx hxb).2.2.2 + ⟨(coarse 5 hd he).mpr h, hd, he⟩ |>.1.1) hd he + have ht := hn.trans (coarse 5 hd he).symm + simpa [show ¬Even (1 : Nat) from by decide, hf.2, K] using ht + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean new file mode 100644 index 0000000000..3c1cf4bb7e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean @@ -0,0 +1,648 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralGeometricSectors +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells +public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.P4590T1OppositeCellsStar +public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices + +-- [TABLET NODE: P4590T1MixedInteriorGeometry] + +/-! +# P4590T1MixedInteriorGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace MixedInteriorGeometry + +private theorem raw_incident : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (U.cells.Nonempty) → ((z ∈ FootprintVertices U) → + (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ U.cells)) ) := by + classical + intro U z hne hz + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hz + rcases hz with ⟨a, ha, rfl | rfl | rfl | rfl⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using ha⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using ha⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using ha⟩ + · exact ⟨2, by simpa [LatticeVertexIncidentCell, sub_sub] using ha⟩ + +private theorem incident_foot : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (U : ProtoTile), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ + U.cells) → (x ∈ FootprintVertices U) ) := by + classical + intro x U j hj + rw [FootprintVertices, ite_eq_left ⟨LatticeVertexIncidentCell x j, hj⟩] + refine ⟨LatticeVertexIncidentCell x j, hj, ?_⟩ + fin_cases j <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm, Zsqrtd.ext_iff] + +private theorem footprint_iff_incident : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (∀ (U : ProtoTile), ∀ (z : GaussianInt), (U.cells.Nonempty) + → ((z ∈ FootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ + U.cells))) → ((∀ (i : Fin 3), ∀ (s : Bool), (cert.P i s).cells.Nonempty) → ((∀ (U : + ProtoTile), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ U.cells) → (x ∈ + FootprintVertices U)) → (∀ (i : Fin 3), ∀ (s : Bool), x ∈ FootprintVertices (cert.P i + s) ↔ ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P i s).cells))) ) := by + classical + intro q cfg C T cert x raw_incident hparentNe incident_foot i s + constructor + · exact raw_incident (cert.P i s) x (hparentNe i s) + · rintro ⟨j, hj⟩ + exact incident_foot (cert.P i s) j hj + +private theorem noThirdBoundary : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), + let boundaryOwners := {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} + (Fintype.card boundaryOwners = 2) → (∀ (a : Fin 3 × Bool), ∀ (b : Fin 3 × Bool), ∀ (c : + Fin 3 × Bool), (a ≠ b) → ((a ≠ c) → ((b ≠ c) → ((x ∈ BoundaryFootprintVertices + (cert.P a.1 a.2)) → ((x ∈ BoundaryFootprintVertices (cert.P b.1 b.2)) → (x ∉ + BoundaryFootprintVertices (cert.P c.1 c.2))))))) ) := by + classical + intro q cfg C T cert x boundaryOwners hboundaryOwnersCard a b c hab hac hbc ha hb hc + let f : Fin 3 → boundaryOwners := fun n => + if h : n = 0 then ⟨a, ha⟩ else + if h : n = 1 then ⟨b, hb⟩ else ⟨c, hc⟩ + have hf : Function.Injective f := by + intro n m hnm + have hv := congrArg Subtype.val hnm + fin_cases n <;> fin_cases m <;> simp [f] at hv <;> + simp_all [] + have hle := Fintype.card_le_of_injective f hf + rw [hboundaryOwnersCard] at hle + norm_num at hle + +private theorem pair_boundary : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (∀ (i : Fin 3), ∀ (s : Bool), x ∈ FootprintVertices (cert.P + i s) ↔ ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P i s).cells) → ((∀ (i : + Fin 3), ∀ (j : Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → ((¬ (i = 0 ∧ j + = 0)) → (Disjoint (cert.P i s).cells (cert.P j t).cells))) → (∀ (i : Fin 3), ∀ (j : + Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → ((¬ (i = 0 ∧ j = 0)) → ((x ∈ + FootprintVertices (cert.P i s)) → ((x ∈ FootprintVertices (cert.P j t)) → (x ∈ + BoundaryFootprintVertices (cert.P i s) ∧ x ∈ BoundaryFootprintVertices (cert.P j + t))))))) ) := by + classical + intro q cfg C T cert x footprint_iff_incident selected_disjoint i j s t hij hnot hi hj + obtain ⟨ki, hki⟩ := (footprint_iff_incident i s).1 hi + obtain ⟨kj, hkj⟩ := (footprint_iff_incident j t).1 hj + refine ⟨?_, ?_⟩ + · apply P3161T2IncidentBoundary _ x ⟨ki, hki⟩ + refine ⟨kj, ?_⟩ + intro h + exact (Finset.disjoint_left.mp (selected_disjoint i j s t hij hnot)) h hkj + · apply P3161T2IncidentBoundary _ x ⟨kj, hkj⟩ + refine ⟨ki, ?_⟩ + intro h + exact Finset.disjoint_left.mp (selected_disjoint i j s t hij hnot).symm h hki + +private theorem noOtherFoot : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (∀ (i : Fin 3), ∀ (s : Bool), x ∈ FootprintVertices (cert.P + i s) ↔ ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P i s).cells) → ((∀ (a : + Fin 3 × Bool), ∀ (b : Fin 3 × Bool), ∀ (c : Fin 3 × Bool), (a ≠ b) → ((a ≠ c) → ((b ≠ + c) → ((x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)) → ((x ∈ + BoundaryFootprintVertices (cert.P b.1 b.2)) → (x ∉ BoundaryFootprintVertices (cert.P + c.1 c.2))))))) → ((∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) + ≠ (j, t)) → ((¬ (i = 0 ∧ j = 0)) → ((x ∈ FootprintVertices (cert.P i s)) → ((x ∈ + FootprintVertices (cert.P j t)) → (x ∈ BoundaryFootprintVertices (cert.P i s) ∧ x ∈ + BoundaryFootprintVertices (cert.P j t)))))) → (∀ (a : Fin 3 × Bool), ∀ (b : Fin 3 × + Bool), ∀ (c : Fin 3 × Bool), (a ≠ b) → ((a ≠ c) → ((b ≠ c) → ((¬ (a.1 = 0 ∧ b.1 = 0)) + → ((Disjoint (cert.P a.1 a.2).cells (cert.P c.1 c.2).cells ∨ + Disjoint (cert.P b.1 b.2).cells (cert.P c.1 c.2).cells) → ((x ∈ FootprintVertices + (cert.P a.1 a.2)) → ((x ∈ FootprintVertices (cert.P b.1 b.2)) → (x ∉ + FootprintVertices (cert.P c.1 c.2))))))))))) ) := by + classical + intro q cfg C T cert x footprint_iff_incident noThirdBoundary pair_boundary a b c hab hac hbc + hnot hdisj ha hb + have hba := (pair_boundary a.1 b.1 a.2 b.2 hab hnot ha hb).1 + have hbb := (pair_boundary a.1 b.1 a.2 b.2 hab hnot ha hb).2 + intro hc + obtain ⟨jc, hjc⟩ := (footprint_iff_incident c.1 c.2).1 hc + rcases hdisj with hdisj | hdisj + · obtain ⟨ja, hja⟩ := (footprint_iff_incident a.1 a.2).1 ha + have hjamiss : LatticeVertexIncidentCell x ja ∉ (cert.P c.1 c.2).cells := + Finset.disjoint_left.mp hdisj hja + have hbc' := P3161T2IncidentBoundary _ x ⟨jc, hjc⟩ ⟨ja, hjamiss⟩ + exact noThirdBoundary a b c hab hac hbc hba hbb hbc' + · obtain ⟨jb, hjb⟩ := (footprint_iff_incident b.1 b.2).1 hb + have hjbmiss : LatticeVertexIncidentCell x jb ∉ (cert.P c.1 c.2).cells := + Finset.disjoint_left.mp hdisj hjb + have hbc' := P3161T2IncidentBoundary _ x ⟨jc, hjc⟩ ⟨jb, hjbmiss⟩ + exact noThirdBoundary a b c hab hac hbc hba hbb hbc' + +private theorem pair_cover : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) → ((∀ + (U : ProtoTile), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ U.cells) → (x ∈ + FootprintVertices U)) → ((∀ (a : Fin 3 × Bool), ∀ (b : Fin 3 × Bool), ∀ (c : Fin 3 × + Bool), (a ≠ b) → ((a ≠ c) → ((b ≠ c) → ((¬ (a.1 = 0 ∧ b.1 = 0)) → ((Disjoint (cert.P + a.1 a.2).cells (cert.P c.1 c.2).cells ∨ Disjoint (cert.P b.1 b.2).cells (cert.P c.1 + c.2).cells) → ((x ∈ FootprintVertices (cert.P a.1 a.2)) → ((x ∈ FootprintVertices + (cert.P b.1 b.2)) → (x ∉ FootprintVertices (cert.P c.1 c.2))))))))) → (∀ (a : Fin 3 × + Bool), ∀ (b : Fin 3 × Bool), ∀ (c : Fin 3 × Bool), (a ≠ b) → ((a ≠ c) → ((b ≠ c) → + ((¬ (a.1 = 0 ∧ b.1 = 0)) → ((∀ c', c' ≠ a → c' ≠ b → + Disjoint (cert.P a.1 a.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P b.1 b.2).cells (cert.P c'.1 c'.2).cells) → ((x ∈ FootprintVertices + (cert.P a.1 a.2)) → ((x ∈ FootprintVertices (cert.P b.1 b.2)) → (∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (cert.P a.1 a.2).cells ∨ + LatticeVertexIncidentCell x j ∈ (cert.P b.1 b.2).cells)))))))))) ) := by + classical + intro q cfg C T cert x hstar incident_foot noOtherFoot a b c hab hac hbc hnot hthird ha hb j + have hcell := hstar j + obtain ⟨i, s, howner⟩ := (cert.outer_union _).1 hcell + have hownerFoot := incident_foot (cert.P i s) j howner + by_cases hia : (i, s) = a + · exact Or.inl (hia ▸ howner) + by_cases hib : (i, s) = b + · exact Or.inr (hib ▸ howner) + · exact (noOtherFoot a b (i, s) hab (fun h => hia h.symm) + (fun h => hib h.symm) hnot + (hthird (i, s) hia hib) ha hb hownerFoot).elim + +private theorem pair_result : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), ∀ (x : GaussianInt), (∀ (i : Fin 3), ∀ (s : Bool), x ∈ FootprintVertices (cert.P + i s) ↔ ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P i s).cells) → ((∀ (i : + Fin 3), ∀ (j : Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → ((¬ (i = 0 ∧ j + = 0)) → (Disjoint (cert.P i s).cells (cert.P j t).cells))) → ((∀ (i : Fin 3), ∀ (j : + Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → ((¬ (i = 0 ∧ j = 0)) → ((x ∈ + FootprintVertices (cert.P i s)) → ((x ∈ FootprintVertices (cert.P j t)) → (x ∈ + BoundaryFootprintVertices (cert.P i s) ∧ x ∈ BoundaryFootprintVertices (cert.P j + t)))))) → ((∀ (a : Fin 3 × Bool), ∀ (b : Fin 3 × Bool), ∀ (c : Fin 3 × Bool), (a ≠ b) + → ((a ≠ c) → ((b ≠ c) → ((¬ (a.1 = 0 ∧ b.1 = 0)) → ((Disjoint (cert.P a.1 a.2).cells + (cert.P c.1 c.2).cells ∨ Disjoint (cert.P b.1 b.2).cells (cert.P c.1 c.2).cells) → + ((x ∈ FootprintVertices (cert.P a.1 a.2)) → ((x ∈ FootprintVertices (cert.P b.1 b.2)) + → (x ∉ FootprintVertices (cert.P c.1 c.2))))))))) → ((∀ (a : Fin 3 × Bool), ∀ (b : + Fin 3 × Bool), ∀ (c : Fin 3 × Bool), (a ≠ b) → ((a ≠ c) → ((b ≠ c) → ((¬ (a.1 = 0 ∧ + b.1 = 0)) → ((∀ c', c' ≠ a → c' ≠ b → Disjoint (cert.P a.1 a.2).cells (cert.P c'.1 + c'.2).cells ∨ Disjoint (cert.P b.1 b.2).cells (cert.P c'.1 c'.2).cells) → ((x ∈ + FootprintVertices (cert.P a.1 a.2)) → ((x ∈ FootprintVertices (cert.P b.1 b.2)) → (∀ + j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P a.1 a.2).cells ∨ + LatticeVertexIncidentCell x j ∈ (cert.P b.1 b.2).cells)))))))) → (∀ (a : Fin 3 × + Bool), ∀ (b : Fin 3 × Bool), ∀ (k : Fin 3 × Bool), (a ≠ b) → ((a ≠ k) → ((b ≠ k) → + ((¬ (a.1 = 0 ∧ b.1 = 0)) → ((∀ c', c' ≠ a → c' ≠ b → + Disjoint (cert.P a.1 a.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P b.1 b.2).cells (cert.P c'.1 c'.2).cells) → ((x ∈ FootprintVertices + (cert.P a.1 a.2)) → ((x ∈ FootprintVertices (cert.P b.1 b.2)) → ((∀ y, y = x ∨ + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ FootprintVertices + (cert.P a.1 a.2) ∨ y ∈ FootprintVertices (cert.P b.1 b.2)) ∧ x ∉ + FootprintVertices (cert.P k.1 k.2))))))))))))) ) := by + classical + intro q cfg C T cert x footprint_iff_incident selected_disjoint pair_boundary noOtherFoot + pair_cover a b k hab hak hbk hnot hthird ha hb + have hdisjAB := selected_disjoint a.1 b.1 a.2 b.2 hab hnot + have hboundaryAB := pair_boundary a.1 b.1 a.2 b.2 hab hnot ha hb + have hcover := pair_cover a b k hab hak hbk hnot hthird ha hb + have hU := (footprint_iff_incident a.1 a.2).1 ha + have hV := (footprint_iff_incident b.1 b.2).1 hb + have hchecker := (LatticeTileGridStructure (cert.P a.1 a.2) + (cert.parent_lattice a.1 a.2)).2.1 x + have hopposite : ∃ j : Fin 4, + (LatticeVertexIncidentCell x j ∈ (cert.P a.1 a.2).cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ (cert.P b.1 b.2).cells) ∨ + (LatticeVertexIncidentCell x j ∈ (cert.P b.1 b.2).cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ (cert.P a.1 a.2).cells) := by + by_contra hn + have same02 : (LatticeVertexIncidentCell x 0 ∈ (cert.P a.1 a.2).cells ↔ + LatticeVertexIncidentCell x 2 ∈ (cert.P a.1 a.2).cells) := by + constructor + · intro h0 + rcases hcover 2 with h2 | h2 + · exact h2 + · exact (hn ⟨0, Or.inl ⟨h0, by simpa using h2⟩⟩).elim + · intro h2 + rcases hcover 0 with h0 | h0 + · exact h0 + · exact (hn ⟨0, Or.inr ⟨by simpa using h0, h2⟩⟩).elim + have same13 : (LatticeVertexIncidentCell x 1 ∈ (cert.P a.1 a.2).cells ↔ + LatticeVertexIncidentCell x 3 ∈ (cert.P a.1 a.2).cells) := by + constructor + · intro h1 + rcases hcover 3 with h3 | h3 + · exact h3 + · exact (hn ⟨1, Or.inl ⟨h1, by simpa using h3⟩⟩).elim + · intro h3 + rcases hcover 1 with h1 | h1 + · exact h1 + · exact (hn ⟨1, Or.inr ⟨by simpa using h1, h3⟩⟩).elim + by_cases h0 : LatticeVertexIncidentCell x 0 ∈ (cert.P a.1 a.2).cells + · by_cases h1 : LatticeVertexIncidentCell x 1 ∈ (cert.P a.1 a.2).cells + · have h2 := same02.1 h0 + have h3 := same13.1 h1 + obtain ⟨j, hj⟩ := hV + have hallU : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + (cert.P a.1 a.2).cells := by + intro j + fin_cases j <;> simpa [LatticeVertexIncidentCell] using + (by + first + | exact h0 + | exact h1 + | exact h2 + | exact h3) + exact (Finset.disjoint_left.mp hdisjAB (hallU j) hj).elim + · have h2 := same02.1 h0 + have h3not : LatticeVertexIncidentCell x 3 ∉ (cert.P a.1 a.2).cells := by + intro h3 + exact h1 (same13.2 h3) + have hbad : (LatticeVertexIncidentCell x 0 ∈ (cert.P a.1 a.2).cells ∧ + LatticeVertexIncidentCell x 2 ∈ (cert.P a.1 a.2).cells ∧ + LatticeVertexIncidentCell x 1 ∉ (cert.P a.1 a.2).cells ∧ + LatticeVertexIncidentCell x 3 ∉ (cert.P a.1 a.2).cells) ∨ + (LatticeVertexIncidentCell x 1 ∈ (cert.P a.1 a.2).cells ∧ + LatticeVertexIncidentCell x 3 ∈ (cert.P a.1 a.2).cells ∧ + LatticeVertexIncidentCell x 0 ∉ (cert.P a.1 a.2).cells ∧ + LatticeVertexIncidentCell x 2 ∉ (cert.P a.1 a.2).cells) := Or.inl ⟨h0, h2, h1, h3not⟩ + exact hchecker (by simpa [NoCheckerboardCellVertex, + LatticeVertexIncidentCell] using hbad) + · by_cases h1 : LatticeVertexIncidentCell x 1 ∈ (cert.P a.1 a.2).cells + · have h2not : LatticeVertexIncidentCell x 2 ∉ (cert.P a.1 a.2).cells := by + intro h2 + exact h0 (same02.2 h2) + have h3 := same13.1 h1 + have hbad : (LatticeVertexIncidentCell x 0 ∈ (cert.P a.1 a.2).cells ∧ + LatticeVertexIncidentCell x 2 ∈ (cert.P a.1 a.2).cells ∧ + LatticeVertexIncidentCell x 1 ∉ (cert.P a.1 a.2).cells ∧ + LatticeVertexIncidentCell x 3 ∉ (cert.P a.1 a.2).cells) ∨ + (LatticeVertexIncidentCell x 1 ∈ (cert.P a.1 a.2).cells ∧ + LatticeVertexIncidentCell x 3 ∈ (cert.P a.1 a.2).cells ∧ + LatticeVertexIncidentCell x 0 ∉ (cert.P a.1 a.2).cells ∧ + LatticeVertexIncidentCell x 2 ∉ (cert.P a.1 a.2).cells) := Or.inr ⟨h1, h3, h0, h2not⟩ + exact hchecker (by simpa [NoCheckerboardCellVertex, + LatticeVertexIncidentCell] using hbad) + · have h2not : LatticeVertexIncidentCell x 2 ∉ (cert.P a.1 a.2).cells := + fun h => h0 (same02.2 h) + have h3not : LatticeVertexIncidentCell x 3 ∉ (cert.P a.1 a.2).cells := + fun h => h1 (same13.2 h) + obtain ⟨j, hj⟩ := hU + fin_cases j + · exact h0 (by simpa [LatticeVertexIncidentCell] using hj) + · exact h1 (by simpa [LatticeVertexIncidentCell] using hj) + · exact h2not (by simpa [LatticeVertexIncidentCell] using hj) + · exact h3not (by simpa [LatticeVertexIncidentCell] using hj) + have hstar' := P4590T1OppositeCellsStar + (cert.P a.1 a.2) (cert.P b.1 b.2) x (by + obtain ⟨j, h⟩ := hopposite + rcases h with h | h + · exact ⟨j, h⟩ + · let j' : Fin 4 := j + 2 + have hj' : j' + 2 = j := by fin_cases j <;> decide + exact ⟨j', h.2, by rw [hj']; exact h.1⟩) + refine ⟨hstar', ?_⟩ + exact noOtherFoot a b k hab hak hbk hnot + (hthird k (fun h => hak h.symm) (fun h => hbk h.symm)) ha hb + +private theorem hthirdAD : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → + ((¬ (i = 0 ∧ j = 0)) → (Disjoint (cert.P i s).cells (cert.P j t).cells))) → ( + let A : Fin 3 × Bool := (0, true) + let D : Fin 3 × Bool := (1, false) + ∀ c', c' ≠ A → c' ≠ D → Disjoint (cert.P A.1 A.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P D.1 D.2).cells (cert.P c'.1 c'.2).cells) ) := by + classical + intro q cfg C T cert selected_disjoint A D c' hca hcd + rcases c' with ⟨i, s⟩ + fin_cases i <;> cases s + all_goals first + | exact Or.inl (selected_disjoint _ _ _ _ (by decide) (by decide)) + | exact Or.inr (selected_disjoint _ _ _ _ (by decide) (by decide)) + +private theorem hthirdAF : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → + ((¬ (i = 0 ∧ j = 0)) → (Disjoint (cert.P i s).cells (cert.P j t).cells))) → ( + let A : Fin 3 × Bool := (0, true) + let F : Fin 3 × Bool := (2, false) + ∀ c', c' ≠ A → c' ≠ F → Disjoint (cert.P A.1 A.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P F.1 F.2).cells (cert.P c'.1 c'.2).cells) ) := by + classical + intro q cfg C T cert selected_disjoint A F c' hca hcf + rcases c' with ⟨i, s⟩ + fin_cases i <;> cases s + all_goals first + | exact Or.inl (selected_disjoint _ _ _ _ (by decide) (by decide)) + | exact Or.inr (selected_disjoint _ _ _ _ (by decide) (by decide)) + +private theorem hthirdCB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → + ((¬ (i = 0 ∧ j = 0)) → (Disjoint (cert.P i s).cells (cert.P j t).cells))) → ( + let B : Fin 3 × Bool := (0, false) + let C' : Fin 3 × Bool := (1, true) + ∀ c', c' ≠ C' → c' ≠ B → Disjoint (cert.P C'.1 C'.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P B.1 B.2).cells (cert.P c'.1 c'.2).cells) ) := by + classical + intro q cfg C T cert selected_disjoint B C' c' hcc hcb + rcases c' with ⟨i, s⟩ + fin_cases i <;> cases s + all_goals first + | exact Or.inl (selected_disjoint _ _ _ _ (by decide) (by decide)) + | exact Or.inr (selected_disjoint _ _ _ _ (by decide) (by decide)) + +private theorem hthirdEB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → + ((¬ (i = 0 ∧ j = 0)) → (Disjoint (cert.P i s).cells (cert.P j t).cells))) → ( + let B : Fin 3 × Bool := (0, false) + let E : Fin 3 × Bool := (2, true) + ∀ c', c' ≠ E → c' ≠ B → Disjoint (cert.P E.1 E.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P B.1 B.2).cells (cert.P c'.1 c'.2).cells) ) := by + classical + intro q cfg C T cert selected_disjoint B E c' hce hcb + rcases c' with ⟨i, s⟩ + fin_cases i <;> cases s + all_goals first + | exact Or.inl (selected_disjoint _ _ _ _ (by decide) (by decide)) + | exact Or.inr (selected_disjoint _ _ _ _ (by decide) (by decide)) + +private theorem hthirdCF : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → + ((¬ (i = 0 ∧ j = 0)) → (Disjoint (cert.P i s).cells (cert.P j t).cells))) → ( + let C' : Fin 3 × Bool := (1, true) + let F : Fin 3 × Bool := (2, false) + ∀ c', c' ≠ C' → c' ≠ F → Disjoint (cert.P C'.1 C'.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P F.1 F.2).cells (cert.P c'.1 c'.2).cells) ) := by + classical + intro q cfg C T cert selected_disjoint C' F c' hcc hcf + rcases c' with ⟨i, s⟩ + fin_cases i <;> cases s + all_goals first + | exact Or.inl (selected_disjoint _ _ _ _ (by decide) (by decide)) + | exact Or.inr (selected_disjoint _ _ _ _ (by decide) (by decide)) + +private theorem hthirdED : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C + T), (∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → + ((¬ (i = 0 ∧ j = 0)) → (Disjoint (cert.P i s).cells (cert.P j t).cells))) → ( + let D : Fin 3 × Bool := (1, false) + let E : Fin 3 × Bool := (2, true) + ∀ c', c' ≠ E → c' ≠ D → Disjoint (cert.P E.1 E.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P D.1 D.2).cells (cert.P c'.1 c'.2).cells) ) := by + classical + intro q cfg C T cert selected_disjoint D E c' hce hcd + rcases c' with ⟨i, s⟩ + fin_cases i <;> cases s + all_goals first + | exact Or.inl (selected_disjoint _ _ _ _ (by decide) (by decide)) + | exact Or.inr (selected_disjoint _ _ _ _ (by decide) (by decide)) + +end MixedInteriorGeometry + +theorem P4590T1MixedInteriorGeometry + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (hT : LatticeTile T) (x : GaussianInt) + (hx : x ∈ FootprintVertices T) (hxb : x ∉ BoundaryFootprintVertices T) + (hk : Nat.card {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2) : + (x ∈ FootprintVertices (cert.P 0 true) → x ∈ FootprintVertices (cert.P 1 false) → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.P 0 true) ∨ y ∈ FootprintVertices (cert.P 1 false)) ∧ + x ∉ FootprintVertices (cert.P 0 false)) ∧ + (x ∈ FootprintVertices (cert.P 0 true) → x ∈ FootprintVertices (cert.P 2 false) → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.P 0 true) ∨ y ∈ FootprintVertices (cert.P 2 false)) ∧ + x ∉ FootprintVertices (cert.P 1 true)) ∧ + (x ∈ FootprintVertices (cert.P 1 true) → x ∈ FootprintVertices (cert.P 0 false) → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.P 1 true) ∨ y ∈ FootprintVertices (cert.P 0 false)) ∧ + x ∉ FootprintVertices (cert.P 0 true)) ∧ + (x ∈ FootprintVertices (cert.P 2 true) → x ∈ FootprintVertices (cert.P 0 false) → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.P 2 true) ∨ y ∈ FootprintVertices (cert.P 0 false)) ∧ + x ∉ FootprintVertices (cert.P 1 false)) ∧ + (x ∈ FootprintVertices (cert.P 1 true) → x ∈ FootprintVertices (cert.P 2 false) → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.P 1 true) ∨ y ∈ FootprintVertices (cert.P 2 false)) ∧ + x ∉ FootprintVertices (cert.P 0 true)) ∧ + (x ∈ FootprintVertices (cert.P 2 true) → x ∈ FootprintVertices (cert.P 1 false) → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.P 2 true) ∨ y ∈ FootprintVertices (cert.P 1 false)) ∧ + x ∉ FootprintVertices (cert.P 0 false)) := by +-- BODY + classical + have hTne : T.cells.Nonempty := + (LatticeTileGridStructure T hT).1.1 + have raw_incident (U : ProtoTile) (z : GaussianInt) + (hne : U.cells.Nonempty) (hz : z ∈ FootprintVertices U) : + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ U.cells := MixedInteriorGeometry.raw_incident + U z hne hz + have hstar : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells := + (P4456T2VertexInterior T hTne x hx).2.mp hxb + have hparentNe (i : Fin 3) (s : Bool) : + (cert.P i s).cells.Nonempty := + (LatticeTileGridStructure _ (cert.parent_lattice i s)).1.1 + have hprec := P4339T1PrecursorSupportGeometry C q cfg T cert + have hsep : ∀ (i : Fin 3) (s : Bool) (j : Fin 3) (t : Bool), + (i, s) ≠ (j, t) → ¬ (i = 0 ∧ j = 0) → + Disjoint (cert.P i s).cells (cert.P j t).cells := hprec.2.2.2.2.2.2.2 + have hzero : (cert.P 0 true).cells ∩ (cert.P 0 false).cells = cert.O.cells := + hprec.2.2.2.2.2.2.1 + have hboundaryCount : Nat.card {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2 := hk + have incident_foot (U : ProtoTile) (j : Fin 4) + (hj : LatticeVertexIncidentCell x j ∈ U.cells) : + x ∈ FootprintVertices U := MixedInteriorGeometry.incident_foot x U j hj + have footprint_iff_incident (i : Fin 3) (s : Bool) : + x ∈ FootprintVertices (cert.P i s) ↔ + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P i s).cells := + MixedInteriorGeometry.footprint_iff_incident q cfg C T cert x raw_incident hparentNe + incident_foot i s + have selected_disjoint (i j : Fin 3) (s t : Bool) + (hij : (i, s) ≠ (j, t)) (hnot : ¬ (i = 0 ∧ j = 0)) : + Disjoint (cert.P i s).cells (cert.P j t).cells := hsep i s j t hij hnot + let boundaryOwners := {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} + have hboundaryOwnersCard : Fintype.card boundaryOwners = 2 := by + simpa [boundaryOwners, Nat.card_eq_fintype_card] using hboundaryCount + have noThirdBoundary (a b c : Fin 3 × Bool) + (hab : a ≠ b) (hac : a ≠ c) (hbc : b ≠ c) + (ha : x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)) + (hb : x ∈ BoundaryFootprintVertices (cert.P b.1 b.2)) : + x ∉ BoundaryFootprintVertices (cert.P c.1 c.2) := MixedInteriorGeometry.noThirdBoundary q + cfg C T cert x hboundaryOwnersCard a b c hab hac hbc ha hb + have pair_boundary (i j : Fin 3) (s t : Bool) + (hij : (i, s) ≠ (j, t)) (hnot : ¬ (i = 0 ∧ j = 0)) + (hi : x ∈ FootprintVertices (cert.P i s)) + (hj : x ∈ FootprintVertices (cert.P j t)) : + x ∈ BoundaryFootprintVertices (cert.P i s) ∧ + x ∈ BoundaryFootprintVertices (cert.P j t) := MixedInteriorGeometry.pair_boundary q cfg C + T cert x footprint_iff_incident selected_disjoint i j s t hij hnot hi hj + have noOtherFoot (a b c : Fin 3 × Bool) + (hab : a ≠ b) (hac : a ≠ c) (hbc : b ≠ c) + (hnot : ¬ (a.1 = 0 ∧ b.1 = 0)) + (hdisj : Disjoint (cert.P a.1 a.2).cells (cert.P c.1 c.2).cells ∨ + Disjoint (cert.P b.1 b.2).cells (cert.P c.1 c.2).cells) + (ha : x ∈ FootprintVertices (cert.P a.1 a.2)) + (hb : x ∈ FootprintVertices (cert.P b.1 b.2)) : + x ∉ FootprintVertices (cert.P c.1 c.2) := MixedInteriorGeometry.noOtherFoot q cfg C T cert + x footprint_iff_incident noThirdBoundary pair_boundary a b c hab hac hbc hnot hdisj ha hb + have pair_cover (a b c : Fin 3 × Bool) + (hab : a ≠ b) (hac : a ≠ c) (hbc : b ≠ c) + (hnot : ¬ (a.1 = 0 ∧ b.1 = 0)) + (hthird : ∀ c', c' ≠ a → c' ≠ b → + Disjoint (cert.P a.1 a.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P b.1 b.2).cells (cert.P c'.1 c'.2).cells) + (ha : x ∈ FootprintVertices (cert.P a.1 a.2)) + (hb : x ∈ FootprintVertices (cert.P b.1 b.2)) : + ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P a.1 a.2).cells ∨ + LatticeVertexIncidentCell x j ∈ (cert.P b.1 b.2).cells := + MixedInteriorGeometry.pair_cover q cfg C T cert x hstar incident_foot noOtherFoot a b + c hab hac hbc hnot hthird ha hb + have pair_result (a b k : Fin 3 × Bool) + (hab : a ≠ b) (hak : a ≠ k) (hbk : b ≠ k) + (hnot : ¬ (a.1 = 0 ∧ b.1 = 0)) + (hthird : ∀ c', c' ≠ a → c' ≠ b → + Disjoint (cert.P a.1 a.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P b.1 b.2).cells (cert.P c'.1 c'.2).cells) + (ha : x ∈ FootprintVertices (cert.P a.1 a.2)) + (hb : x ∈ FootprintVertices (cert.P b.1 b.2)) : + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.P a.1 a.2) ∨ + y ∈ FootprintVertices (cert.P b.1 b.2)) ∧ + x ∉ FootprintVertices (cert.P k.1 k.2) := MixedInteriorGeometry.pair_result q cfg C T + cert x footprint_iff_incident selected_disjoint pair_boundary noOtherFoot pair_cover + a b k hab hak hbk hnot hthird ha hb + let A : Fin 3 × Bool := (0, true) + let B : Fin 3 × Bool := (0, false) + let C' : Fin 3 × Bool := (1, true) + let D : Fin 3 × Bool := (1, false) + let E : Fin 3 × Bool := (2, true) + let F : Fin 3 × Bool := (2, false) + have hthirdAD : ∀ c', c' ≠ A → c' ≠ D → + Disjoint (cert.P A.1 A.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P D.1 D.2).cells (cert.P c'.1 c'.2).cells := + MixedInteriorGeometry.hthirdAD q cfg C T cert selected_disjoint + have hthirdAF : ∀ c', c' ≠ A → c' ≠ F → + Disjoint (cert.P A.1 A.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P F.1 F.2).cells (cert.P c'.1 c'.2).cells := + MixedInteriorGeometry.hthirdAF q cfg C T cert selected_disjoint + have hthirdCB : ∀ c', c' ≠ C' → c' ≠ B → + Disjoint (cert.P C'.1 C'.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P B.1 B.2).cells (cert.P c'.1 c'.2).cells := + MixedInteriorGeometry.hthirdCB q cfg C T cert selected_disjoint + have hthirdEB : ∀ c', c' ≠ E → c' ≠ B → + Disjoint (cert.P E.1 E.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P B.1 B.2).cells (cert.P c'.1 c'.2).cells := + MixedInteriorGeometry.hthirdEB q cfg C T cert selected_disjoint + have hthirdCF : ∀ c', c' ≠ C' → c' ≠ F → + Disjoint (cert.P C'.1 C'.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P F.1 F.2).cells (cert.P c'.1 c'.2).cells := + MixedInteriorGeometry.hthirdCF q cfg C T cert selected_disjoint + have hthirdED : ∀ c', c' ≠ E → c' ≠ D → + Disjoint (cert.P E.1 E.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P D.1 D.2).cells (cert.P c'.1 c'.2).cells := + MixedInteriorGeometry.hthirdED q cfg C T cert selected_disjoint + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro ha hd + exact pair_result A D B (by decide) (by decide) (by decide) (by simp [A, D]) + hthirdAD ha hd + · intro ha hf + exact pair_result A F C' (by decide) (by decide) (by decide) (by simp [A, F]) + hthirdAF ha hf + · intro hc hb + exact pair_result C' B A (by decide) (by decide) (by decide) (by simp [C', B]) + hthirdCB hc hb + · intro he hb + exact pair_result E B D (by decide) (by decide) (by decide) (by simp [E, B]) + hthirdEB he hb + · intro hc hf + exact pair_result C' F A (by decide) (by decide) (by decide) (by simp [C', F]) + hthirdCF hc hf + · intro he hd + exact pair_result E D B (by decide) (by decide) (by decide) (by simp [E, D]) + hthirdED he hd + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1OppositeCellsStar.lean b/LeanPool/ApollonianSuperharmonic/P4590T1OppositeCellsStar.lean new file mode 100644 index 0000000000..9fbd5537f8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4590T1OppositeCellsStar.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import Mathlib.Tactic.FinCases + +-- [TABLET NODE: P4590T1OppositeCellsStar] + +/-! +# P4590T1OppositeCellsStar + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4590T1OppositeCellsStar (U V : ProtoTile) (x : GaussianInt) + (hopp : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ V.cells) : + ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V := by +-- BODY + obtain ⟨j, hj, hk⟩ := hopp + have hU : U.cells.Nonempty := ⟨_, hj⟩ + have hV : V.cells.Nonempty := ⟨_, hk⟩ + have raw (W : ProtoTile) (a : GaussianInt) (ha : a ∈ W.cells) + (y : GaussianInt) + (hy : y = a ∨ y = a + 1 ∨ y = a + ⟨0, 1⟩ ∨ + y = a + 1 + ⟨0, 1⟩) : y ∈ FootprintVertices W := by + simp only [FootprintVertices, show W.cells.Nonempty from ⟨a, ha⟩, + ite_true, Set.mem_ofPred_eq] + exact ⟨a, ha, hy⟩ + intro y hy + fin_cases j <;> + rcases hy with rfl | rfl | rfl | rfl | rfl + all_goals first + | (left; apply raw U _ hj; simp [LatticeVertexIncidentCell, + sub_eq_add_neg, add_assoc, add_comm, add_left_comm]; done) + | (right; apply raw V _ hk; simp [LatticeVertexIncidentCell, + sub_eq_add_neg, add_assoc, add_comm, add_left_comm]; ) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1OriginalNonedges.lean b/LeanPool/ApollonianSuperharmonic/P4590T1OriginalNonedges.lean new file mode 100644 index 0000000000..c9dc0857d1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4590T1OriginalNonedges.lean @@ -0,0 +1,154 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralGeometricSectors +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry + +-- [TABLET NODE: P4590T1OriginalNonedges] + +/-! +# P4590T1OriginalNonedges + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4590T1OriginalNonedges (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) : + FootprintVertices (cert.P 0 true) ∩ FootprintVertices (cert.P 2 true) = ∅ ∧ + FootprintVertices (cert.P 0 false) ∩ FootprintVertices (cert.P 2 false) = ∅ ∧ + FootprintVertices (cert.P 1 true) ∩ FootprintVertices (cert.P 1 false) = ∅ ∧ + FootprintVertices (cert.P 1 true) ∩ FootprintVertices (cert.P 2 true) = ∅ ∧ + FootprintVertices (cert.P 1 false) ∩ FootprintVertices (cert.P 2 false) = ∅ ∧ + FootprintVertices (cert.P 2 true) ∩ FootprintVertices (cert.P 2 false) = ∅ := by +-- BODY + classical + obtain ⟨whole, hw, hT, _, _⟩ := BandOrderedGeneralFinitePatches q cfg C T cert + have hNP := (BandOrderedGeneralGeometricSectors q cfg C T cert whole hw hT).1 + have hn (a b : PeriodicSubtileIndex) (ha : a ∈ whole.indices) + (hb : b ∈ whole.indices) (hab : a ≠ b) + (hnab : ¬ AllowedSubtileIncidence a b) : + FootprintVertices (cert.modified.tile a) ∩ + FootprintVertices (cert.modified.tile b) = ∅ := by + rw [hNP a ha b hb hab] + have hnot : ¬ (FootprintEdges (cert.modified.tile a) ∩ + FootprintEdges (cert.modified.tile b)).Nonempty := by + intro he + exact hnab ((cert.modified_adjacency a b).mp + (((PeriodicTileIntersectionClassification cert.modified).1 a b hab).1.mp he)) + apply Set.eq_empty_iff_forall_notMem.mpr + rintro x ⟨e, he, _⟩ + exact hnot ⟨e, he⟩ + have htranslation_zero : GaussianTranslation 0 = id := by + funext z + exact add_zero z + have hM (l : SixSubtileLabel) : cert.modified.tile ⟨l, 0, 0⟩ = + match l with + | .A => TileCellComplement (cert.P 0 true) cert.O + | .B => cert.P 0 false + | .C => cert.P 1 true + | .D => cert.P 1 false + | .E => cert.P 2 true + | .F => cert.P 2 false := by + rw [cert.modified_tile] + cases l <;> simp [ModifiedSubtileOccurrenceInterpretation, TileTranslation, + htranslation_zero] + have hnoledger (a b : SixSubtileLabel) + (hpair : (a = .A ∧ b = .E) ∨ (a = .B ∧ b = .F) ∨ + (a = .C ∧ b = .D) ∨ (a = .C ∧ b = .E) ∨ + (a = .D ∧ b = .F) ∨ (a = .E ∧ b = .F)) : + ¬ AllowedSubtileIncidence ⟨a, 0, 0⟩ ⟨b, 0, 0⟩ := by + intro h + have haux : ∀ {u v : PeriodicSubtileIndex}, AllowedSubtileIncidence u v → + ¬ ((u.first = 0 ∧ u.second = 0 ∧ v.first = 0 ∧ v.second = 0) ∧ + ((u.label = .A ∧ v.label = .E) ∨ (u.label = .E ∧ v.label = .A) ∨ + (u.label = .B ∧ v.label = .F) ∨ (u.label = .F ∧ v.label = .B) ∨ + (u.label = .C ∧ v.label = .D) ∨ (u.label = .D ∧ v.label = .C) ∨ + (u.label = .C ∧ v.label = .E) ∨ (u.label = .E ∧ v.label = .C) ∨ + (u.label = .D ∧ v.label = .F) ∨ (u.label = .F ∧ v.label = .D) ∨ + (u.label = .E ∧ v.label = .F) ∨ (u.label = .F ∧ v.label = .E))) := by + as_aux_lemma => + intro u v huv + induction huv with + | symm h ih => + rintro ⟨⟨h1, h2, h3, h4⟩, hp⟩ + apply ih + refine ⟨⟨h3, h4, h1, h2⟩, ?_⟩ + simpa only [and_comm, or_comm, or_left_comm, or_assoc] using hp + | _ => + simp + all_goals omega + apply haux h + simp only + refine ⟨by simp, ?_⟩ + rcases hpair with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | + ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ <;> simp + have hraw (a b : SixSubtileLabel) (hne : a ≠ b) + (hpair : (a = .A ∧ b = .E) ∨ (a = .B ∧ b = .F) ∨ + (a = .C ∧ b = .D) ∨ (a = .C ∧ b = .E) ∨ + (a = .D ∧ b = .F) ∨ (a = .E ∧ b = .F)) : + FootprintVertices (cert.modified.tile ⟨a, 0, 0⟩) ∩ + FootprintVertices (cert.modified.tile ⟨b, 0, 0⟩) = ∅ := by + apply hn + · rw [hw]; cases a <;> simp + · rw [hw]; cases b <;> simp + · intro he + exact hne (congrArg PeriodicSubtileIndex.label he) + · exact hnoledger a b hpair + have hAE := hraw .A .E (by decide) (by simp) + have hBF := hraw .B .F (by decide) (by simp) + have hCD := hraw .C .D (by decide) (by simp) + have hCE := hraw .C .E (by decide) (by simp) + have hDF := hraw .D .F (by decide) (by simp) + have hEF := hraw .E .F (by decide) (by simp) + simp only [hM] at hAE hBF hCD hCE hDF hEF + refine ⟨?_, hBF, hCD, hCE, hDF, hEF⟩ + apply Set.eq_empty_iff_forall_notMem.mpr + rintro x ⟨hxA, hxE⟩ + have hAne : (cert.P 0 true).cells.Nonempty := + (LatticeTileGridStructure _ (cert.parent_lattice 0 true)).1.1 + have hEne : (cert.P 2 true).cells.Nonempty := + (LatticeTileGridStructure _ (cert.parent_lattice 2 true)).1.1 + obtain ⟨a, ha, hxa⟩ := (show ∃ a ∈ (cert.P 0 true).cells, + x = a ∨ x = a + 1 ∨ x = a + ⟨0, 1⟩ ∨ x = a + 1 + ⟨0, 1⟩ from by + simpa [FootprintVertices, hAne] using hxA) + by_cases haO : a ∈ cert.O.cells + · have hxO : x ∈ FootprintVertices cert.O := by + simp only [FootprintVertices, show cert.O.cells.Nonempty from ⟨a, haO⟩, ite_true] + exact ⟨a, haO, hxa⟩ + obtain ⟨b, hb, hxb⟩ := (show ∃ b ∈ (cert.P 2 true).cells, + x = b ∨ x = b + 1 ∨ x = b + ⟨0, 1⟩ ∨ x = b + 1 + ⟨0, 1⟩ from by + simpa [FootprintVertices, hEne] using hxE) + have hxb' : x ∈ FootprintVertices (⟨{b}, b⟩ : ProtoTile) := by + simpa [FootprintVertices] using hxb + have hiso := cert.precursor_isolated 0 0 x (by + simpa [TileTranslation, htranslation_zero] using hxO) b hxb' + have hsep := (P4339T1PrecursorSupportGeometry C q cfg T cert).2.2.2.2.2.2.2 + simp only [SubtileOccurrenceInterpretation, TileTranslation, htranslation_zero, + Int.cast_zero, zero_mul, zero_add, Finset.image_id] at hiso + rcases hiso with hiso | hiso + · exact Finset.disjoint_left.mp (hsep 0 true 2 true (by decide) (by decide)) hiso hb + · exact Finset.disjoint_left.mp (hsep 0 false 2 true (by decide) (by decide)) hiso hb + · have hxmod : x ∈ FootprintVertices (TileCellComplement (cert.P 0 true) cert.O) := by + have ha' : a ∈ (TileCellComplement (cert.P 0 true) cert.O).cells := by + exact Finset.mem_sdiff.mpr ⟨ha, haO⟩ + simp only [FootprintVertices, show (TileCellComplement (cert.P 0 true) cert.O).cells.Nonempty + from ⟨a, ha'⟩, ite_true] + exact ⟨a, ha', hxa⟩ + have : x ∈ (∅ : Set GaussianInt) := hAE ▸ ⟨hxmod, hxE⟩ + exact this + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1PositivePrototileDisk.lean b/LeanPool/ApollonianSuperharmonic/P4590T1PositivePrototileDisk.lean new file mode 100644 index 0000000000..c46c984bda --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4590T1PositivePrototileDisk.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance + +-- [TABLET NODE: P4590T1PositivePrototileDisk] + +/-! +# P4590T1PositivePrototileDisk + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4590T1PositivePrototileDisk (c : CircleCoordinates) (U : ProtoTile) + (hU : BandPrototile c U) (hc : 0 < c.1) : LatticeTile U := by +-- BODY + cases hU with + | line w x hw => simp at hc + | unit z x anchor => + have hford := (FordTileGeometry 1 (by norm_num)).1 + have hcells : ({x} : Finset GaussianInt) = + (TileTranslation (FordTile 1) x).cells := by + ext y + simp [TileTranslation, FordTile, FordCellDomain, GaussianTranslation, + ] + cases x; cases y; simp [Zsqrtd.ext_iff] + have ht : LatticeTile (TileTranslation (FordTile 1) x) := + (TileDiskAreaCovariance (FordTile 1) x).1.mp hford + change TopologicalDisk (TileRealization _) at ht ⊢ + simpa only [TileRealization, hcells] using ht + | @decompose r hr S X hS hcells hfoot hcentroid => + exact (BandTileSimultaneousInduction r hr U + (BandPrototile.decompose hr hS hcells hfoot hcentroid)).1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1ReflectedCenterBoundary.lean b/LeanPool/ApollonianSuperharmonic/P4590T1ReflectedCenterBoundary.lean new file mode 100644 index 0000000000..50f6546e28 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4590T1ReflectedCenterBoundary.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership +public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior +public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint + +-- [TABLET NODE: P4590T1ReflectedCenterBoundary] + +/-! +# P4590T1ReflectedCenterBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4590T1ReflectedCenterBoundary (U V : ProtoTile) (x : GaussianInt) + (hU : U.cells.Nonempty) (hV : V.cells.Nonempty) + (hR : CentrallyReflectedAt (GaussianRealPoint x) U V) : + x ∈ BoundaryFootprintVertices U ↔ x ∈ BoundaryFootprintVertices V := by +-- BODY + classical + let R : Real × Real → Real × Real := fun p => + (2 * (GaussianRealPoint x).1 - p.1, 2 * (GaussianRealPoint x).2 - p.2) + have hR2 (p : Real × Real) : R (R p) = p := by + ext <;> dsimp [R] <;> ring + have hreal (p : Real × Real) : p ∈ TileRealization U ↔ R p ∈ TileRealization V := by + change TileRealization V = R '' TileRealization U at hR + rw [hR] + constructor + · intro hp + exact ⟨p, hp, rfl⟩ + · rintro ⟨q, hq, hqp⟩ + have heq : q = p := by + have h := congrArg R hqp + simpa only [hR2] using h + exact heq ▸ hq + have hcell (j : Fin 4) : + LatticeVertexIncidentCell x j ∈ U.cells ↔ + LatticeVertexIncidentCell x (j + 2) ∈ V.cells := by + rw [← P3776T1CellCenterMembership, ← P3776T1CellCenterMembership] + simp only [GaussianRealPoint, Prod.mk_add_mk] + rw [hreal] + have heq : R + (((LatticeVertexIncidentCell x j).re : Real) + 1 / 2, + ((LatticeVertexIncidentCell x j).im : Real) + 1 / 2) = + (((LatticeVertexIncidentCell x (j + 2)).re : Real) + 1 / 2, + ((LatticeVertexIncidentCell x (j + 2)).im : Real) + 1 / 2) := by + fin_cases j <;> ext <;> simp [R, GaussianRealPoint, LatticeVertexIncidentCell] <;> ring + rw [heq] + have htwo (j : Fin 4) : j + 2 + 2 = j := by fin_cases j <;> rfl + have boundary_sectors (W : ProtoTile) (hne : W.cells.Nonempty) + (hb : x ∈ BoundaryFootprintVertices W) : + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ W.cells) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ W.cells) := by + have hraw : x ∈ FootprintVertices W := by + simp only [BoundaryFootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hb + obtain ⟨e, he, hx⟩ := hb + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] + obtain ⟨a, ⟨rfl, ha⟩ | ⟨rfl, ha⟩⟩ := he + all_goals + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + rcases ha with ⟨ha, _⟩ | ⟨_, ha⟩ + · refine ⟨a, ha, ?_⟩ + rcases hx with rfl | rfl <;> simp + · refine ⟨_, ha, ?_⟩ + rcases hx with rfl | rfl <;> + simp [sub_eq_add_neg, add_comm, add_left_comm, add_assoc] + refine ⟨?_, ?_⟩ + · simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hraw + rcases hraw with ⟨a, ha, rfl | rfl | rfl | rfl⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using ha⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using ha⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using ha⟩ + · exact ⟨2, by simpa [LatticeVertexIncidentCell, sub_sub] using ha⟩ + · by_contra! hall + exact ((P4456T2VertexInterior W hne x hraw).2.mpr hall) hb + constructor + · intro hb + obtain ⟨⟨j, hj⟩, ⟨k, hk⟩⟩ := boundary_sectors U hU hb + exact P3161T2IncidentBoundary V x ⟨j + 2, (hcell j).mp hj⟩ + ⟨k + 2, fun hv => hk ((hcell k).mpr hv)⟩ + · intro hb + obtain ⟨⟨j, hj⟩, ⟨k, hk⟩⟩ := boundary_sectors V hV hb + refine P3161T2IncidentBoundary U x ⟨j + 2, (hcell (j + 2)).mpr ?_⟩ + ⟨k + 2, fun hu => hk ?_⟩ + · simpa only [htwo] using hj + · simpa only [htwo] using (hcell (k + 2)).mp hu + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean new file mode 100644 index 0000000000..bffa52d690 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean @@ -0,0 +1,1127 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRawSupport +public import LeanPool.ApollonianSuperharmonic.BandExceptionalRestorationSectorOrder +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import LeanPool.ApollonianSuperharmonic.P4590T1PositivePrototileDisk +public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior +public import LeanPool.ApollonianSuperharmonic.P4590T1OppositeCellsStar +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.P3161T2PathExhaustion +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRawSupport +public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence + +-- [TABLET NODE: P4590T1RestoredBoundaryGeometry] + +/-! +# P4590T1RestoredBoundaryGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RestoredBoundaryGeometry + +private theorem hempty_anchor : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let O := cert.O + let seg := cert.exceptional_segments + (TileCentroid O = TileCentroid T) → (O.cells = ∅ → GaussianRealPoint seg.a = TileCentroid + T) ) := by + classical + intro q cfg C T cert O seg hOcent hOempty + have hcut := seg.empty_cut hOempty + have ha : seg.a = O.anchor := hcut.2 + have hanc : GaussianRealPoint O.anchor = TileCentroid T := by + rw [← hOcent] + simp [GaussianRealPoint, TileCentroid, hOempty] + simpa [ha] using hanc + +private theorem hnonemptyO : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), (GaussianRealPoint x ≠ TileCentroid T) → ( + let O := cert.O + let seg := cert.exceptional_segments + (O.cells = ∅ → GaussianRealPoint seg.a = TileCentroid T) → (O.cells.Nonempty ∨ x ≠ + seg.a)) ) := by + classical + intro q cfg C T cert x hnoncentral O seg hempty_anchor + by_cases hO : O.cells.Nonempty + · exact Or.inl hO + · right + intro hxa + have hOempty : O.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hO + exact hnoncentral (hxa ▸ hempty_anchor hOempty) + +private theorem rawBoundary : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ + BoundaryFootprintVertices T) → ((Nat.card + { is : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 + : ℕ)) → ((GaussianRealPoint x ≠ TileCentroid T) → ((x ∈ BoundaryFootprintVertices + (cert.P (0 : Fin (3 : ℕ)) true)) → ((x ∈ BoundaryFootprintVertices (cert.P (0 : Fin + (3 : ℕ)) false)) → ( + let O := cert.O + let seg := cert.exceptional_segments + (O.cells.Nonempty ∨ x ≠ seg.a) → (∀ (U : ProtoTile), (U.cells.Nonempty) → ((x ∈ + BoundaryFootprintVertices U) → (x ∈ FootprintVertices U))))))))) ) := by + classical + intro q cfg C T cert x hx hxb hk hnoncentral hA hB O seg hnonemptyO U hUne hb + simp only [BoundaryFootprintVertices, hUne, ite_true, Set.mem_ofPred_eq] at hb + obtain ⟨e, he, hz⟩ := hb + simp only [FootprintVertices, hUne, ite_true, Set.mem_ofPred_eq] + obtain ⟨a, ⟨rfl, ha⟩ | ⟨rfl, ha⟩⟩ := he + all_goals + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases ha with ⟨ha, _⟩ | ⟨_, ha⟩ + · refine ⟨a, ha, ?_⟩ + rcases hz with rfl | rfl <;> simp + · refine ⟨_, ha, ?_⟩ + rcases hz with rfl | rfl <;> + simp [sub_eq_add_neg, add_comm, add_left_comm, add_assoc] + +private theorem boundary_sectors : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ + BoundaryFootprintVertices T) → ((Nat.card + { is : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 + : ℕ)) → ((GaussianRealPoint x ≠ TileCentroid T) → ((x ∈ BoundaryFootprintVertices + (cert.P (0 : Fin (3 : ℕ)) true)) → ((x ∈ BoundaryFootprintVertices (cert.P (0 : Fin + (3 : ℕ)) false)) → ( + let O := cert.O + let seg := cert.exceptional_segments + (O.cells.Nonempty ∨ x ≠ seg.a) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → ((x ∈ + BoundaryFootprintVertices U) → (x ∈ FootprintVertices U))) → (∀ (U : ProtoTile), + (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → ((∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ U.cells) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell x + j ∉ U.cells))))))))))) ) := by + classical + intro q cfg C T cert x hx hxb hk hnoncentral hA hB O seg hnonemptyO rawBoundary U hne hb + have hraw := rawBoundary U hne hb + refine ⟨?_, ?_⟩ + · simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hraw + rcases hraw with ⟨a, ha, rfl | rfl | rfl | rfl⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using ha⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using ha⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using ha⟩ + · exact ⟨2, by simpa [LatticeVertexIncidentCell, sub_sub] using ha⟩ + · by_contra! hall + exact ((P4456T2VertexInterior U hne x hraw).2.mpr hall) hb + +private theorem noThird : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), (Nat.card + { is : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 + : ℕ)) → ((x ∈ BoundaryFootprintVertices (cert.P (0 : Fin (3 : ℕ)) true)) → ((x ∈ + BoundaryFootprintVertices (cert.P (0 : Fin (3 : ℕ)) false)) → (∀ (i : Fin 3), ∀ (s : + Bool), ((i, s) ≠ ((0 : Fin 3), true)) → (((i, s) ≠ ((0 : Fin 3), false)) → ((x ∈ + BoundaryFootprintVertices (cert.P i s)) → (False)))))) ) := by + classical + intro q cfg C T cert x hk hA hB i s hiA hiB hother + let Sub := {is : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} + let u : Sub := ⟨(0, true), by simpa using hA⟩ + let v : Sub := ⟨(0, false), by simpa using hB⟩ + let w : Sub := ⟨(i, s), hother⟩ + have huv : u ≠ v := by + intro h + have := congrArg Subtype.val h + cases this + have huw : u ≠ w := by + intro h + exact hiA (congrArg Subtype.val h).symm + have hvw : v ≠ w := by + intro h + exact hiB (congrArg Subtype.val h).symm + have htriple : ({u, v, w} : Finset Sub).card = 3 := by + simp [huv, huw, hvw] + have hk' : Fintype.card Sub = 2 := by + simpa [Sub, Nat.card_eq_fintype_card] using hk + have hle : 3 ≤ Fintype.card Sub := by + calc + 3 = ({u, v, w} : Finset Sub).card := htriple.symm + _ ≤ Finset.univ.card := Finset.card_le_univ _ + _ = Fintype.card Sub := by simp + omega + +private theorem hnotO : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), (GaussianRealPoint x ≠ TileCentroid T) → ( + let O := cert.O + (TileCentroid O = TileCentroid T) → (x ∉ FootprintVertices O ∨ O.cells.Nonempty)) ) := by + classical + intro q cfg C T cert x hnoncentral O hOcent + by_cases hO : O.cells.Nonempty + · exact Or.inr hO + · left + intro hxO + have ha : x = O.anchor := by simpa [FootprintVertices, hO] using hxO + have hcen : GaussianRealPoint O.anchor = TileCentroid T := by + rw [← hOcent] + simp [GaussianRealPoint, TileCentroid, Finset.not_nonempty_iff_eq_empty.mp hO] + exact hnoncentral (by simpa [ha] using hcen) + +private theorem hmodifiedCommon : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), + let A := cert.P 0 true + let B := cert.P 0 false + let O := cert.O + (A.cells.Nonempty) → ((x ∈ FootprintVertices A) → ((x ∈ FootprintVertices B) → + (((TileCellComplement A O).cells.Nonempty) → (x ∉ FootprintVertices O → x ∈ + FootprintVertices (TileCellComplement A O) ∩ FootprintVertices B)))) ) := by + classical + intro q cfg C T cert x A B O hAne hxA' hxB' hdeletedNe hxO + refine ⟨?_, hxB'⟩ + obtain ⟨z, hz, hcorner⟩ := by + simpa only [FootprintVertices, hAne, ite_true, Set.mem_ofPred_eq] using hxA' + have hzO : z ∉ O.cells := by + intro hzO + apply hxO + simp only [FootprintVertices, show O.cells.Nonempty from ⟨z, hzO⟩, + ite_true, Set.mem_ofPred_eq] + exact ⟨z, hzO, hcorner⟩ + simp only [FootprintVertices, hdeletedNe, ite_true, Set.mem_ofPred_eq] + exact ⟨z, Finset.mem_sdiff.mpr ⟨hz, hzO⟩, hcorner⟩ + +private theorem translation_zero : + (by + classical + exact + ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by + classical + intro U + have hzero : GaussianTranslation (0 : GaussianInt) = id := by + funext z + simp [GaussianTranslation] + cases U + simp [TileTranslation, hzero, GaussianTranslation] + +private theorem htileA : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let A := cert.P 0 true + let O := cert.O + let ia : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + (∀ (U : ProtoTile), TileTranslation U 0 = U) → (cert.modified.tile ia = + TileCellComplement A O) ) := by + classical + intro q cfg C T cert A O ia translation_zero + rw [cert.modified_tile] + simp [ia, A, O, ModifiedSubtileOccurrenceInterpretation, translation_zero] + +private theorem htileB : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let B := cert.P 0 false + let ib : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + (∀ (U : ProtoTile), TileTranslation U 0 = U) → (cert.modified.tile ib = B) ) := by + classical + intro q cfg C T cert B ib translation_zero + rw [cert.modified_tile] + simp [ib, B, ModifiedSubtileOccurrenceInterpretation, translation_zero] + +private theorem hadj : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let ia : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let ib : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + cert.modified.plane.adjacent ia ib ) := by + classical + intro q cfg C T cert ia ib + rw [cert.modified_adjacency] + exact .AB 0 0 + +private theorem hf1 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let ia : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let ib : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : + cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i + = ia) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = ib) → h = f ∨ h = + g) → (f1 = f ∨ f1 = g) ) := by + classical + intro q cfg C T cert ia ib f1 f g hfaces + apply hfaces + constructor + · exact ⟨0, by simp [f1, ia, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + · exact ⟨1, by simp [f1, ib, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + +private theorem hf2 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let ia : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let ib : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : + cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i + = ia) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = ib) → h = f ∨ h = + g) → (f2 = f ∨ f2 = g) ) := by + classical + intro q cfg C T cert ia ib f2 f g hfaces + apply hfaces + constructor + · exact ⟨0, by simp [f2, ia, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + · exact ⟨1, by simp [f2, ib, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + +private theorem hf12 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + f1 ≠ f2 ) := by + classical + intro q cfg C T cert f1 f2 h + have := congrArg cert.modified_face_equiv h + simp [f1, f2] at this + +private theorem hexhaust : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let A := cert.P 0 true + let B := cert.P 0 false + let O := cert.O + let seg := cert.exceptional_segments + let ia : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let ib : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + (cert.modified.tile ia = TileCellComplement A O) → ((cert.modified.tile ib = B) → + ((FootprintVertices (cert.modified.tile ia) ∩ FootprintVertices (cert.modified.tile + ib) = CommonFootprintEdgeVertices (cert.modified.tile ia) (cert.modified.tile ib)) → + (∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), + (SimpleGridPathBetween (CommonFootprintEdgeVertices (cert.modified.tile ia) + (cert.modified.tile ib)) (FootprintEdges (cert.modified.tile ia) ∩ FootprintEdges + (cert.modified.tile ib)) (cert.modified.rho f) (cert.modified.rho g)) → ((f1 = f ∨ f1 + = g) → ((f2 = f ∨ f2 = g) → ((f1 ≠ f2) → ((cert.modified.rho f1 = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) → + ((cert.modified.rho f2 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm + ⟨.I2, 0, 0⟩)) → (∀ z ∈ FootprintVertices (TileCellComplement A O) ∩ FootprintVertices + B, z ∈ seg.connector))))))))) ) := by + classical + intro q cfg C T cert A B O seg ia ib f1 f2 htileA htileB hraw f g hpath hf1 hf2 hf12 hrho1 hrho2 + rcases hf1 with hf1 | hf1 <;> rcases hf2 with hf2 | hf2 + · exact False.elim (hf12 (hf1.trans hf2.symm)) + · rw [← hraw, ← hf1, ← hf2, hrho1, hrho2, htileA, htileB] at hpath + simpa [htileA, htileB] using + P3161T2PathExhaustion hpath seg.connector seg.connector_head + seg.connector_last seg.connector_edges + · rw [← hraw, ← hf2, ← hf1, hrho2, hrho1, htileA, htileB] at hpath + have hrevEdges : ∀ x y : GaussianInt, ∀ l r : List GaussianInt, + seg.connector.reverse = l ++ x :: y :: r → + {x, y} ∈ FootprintEdges (TileCellComplement A O) ∩ FootprintEdges B := by + intro x y l r h + have h' := congrArg List.reverse h + simp only [List.reverse_reverse, List.reverse_append, List.reverse_cons, + List.append_assoc] at h' + have he := seg.connector_edges y x r.reverse l.reverse (by simpa using h') + simpa [Finset.pair_comm] using he + have hex := P3161T2PathExhaustion hpath seg.connector.reverse + (by simpa using seg.connector_last) (by simpa using seg.connector_head) hrevEdges + intro z hz + apply List.mem_reverse.mp + apply hex + simpa [htileA, htileB] using hz + · exact False.elim (hf12 (hf1.trans hf2.symm)) + +private theorem hsegMembership : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), + let A := cert.P 0 true + let B := cert.P 0 false + let O := cert.O + let seg := cert.exceptional_segments + (x ∉ FootprintVertices O → x ∈ FootprintVertices (TileCellComplement A O) ∩ + FootprintVertices B) → ((∀ z ∈ FootprintVertices (TileCellComplement A O) ∩ + FootprintVertices B, z ∈ seg.connector) → ((seg.connector.Sublist seg.walk) → (x ∉ + FootprintVertices O → x ∈ seg.left ∨ x ∈ seg.middle ∨ x ∈ seg.right))) ) := by + classical + intro q cfg C T cert x A B O seg hmodifiedCommon hexhaust hconnectorWalk hxO + have hxwalk : x ∈ seg.walk := + hconnectorWalk.subset (hexhaust x (hmodifiedCommon hxO)) + rw [seg.walk_order] at hxwalk + rcases List.mem_append.mp hxwalk with h | hr + · rcases List.mem_append.mp h with hl | hm + · exact Or.inl hl + · exact Or.inr (Or.inl (List.mem_of_mem_tail hm)) + · exact Or.inr (Or.inr (List.mem_of_mem_tail hr)) + +private theorem incidentRaw : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ + BoundaryFootprintVertices T) → ((Nat.card + { is : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 + : ℕ)) → ((GaussianRealPoint x ≠ TileCentroid T) → ((x ∈ BoundaryFootprintVertices + (cert.P (0 : Fin (3 : ℕ)) true)) → ((x ∈ BoundaryFootprintVertices (cert.P (0 : Fin + (3 : ℕ)) false)) → ( + let A := cert.P 0 true + let B := cert.P 0 false + let O := cert.O + let seg := cert.exceptional_segments + (O.cells.Nonempty ∨ x ≠ seg.a) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → ((x ∈ + BoundaryFootprintVertices U) → (x ∈ FootprintVertices U))) → ((∀ (U : ProtoTile), + (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → ((∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ U.cells) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell x + j ∉ U.cells)))) → (((∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ A.cells) ∧ (∃ j : + Fin 4, LatticeVertexIncidentCell x j ∉ A.cells)) → (((∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ B.cells) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell x + j ∉ B.cells)) → ((∀ (i : Fin 3), ∀ (s : Bool), ((i, s) ≠ ((0 : Fin 3), true)) → (((i, + s) ≠ ((0 : Fin 3), false)) → ((x ∈ BoundaryFootprintVertices (cert.P i s)) → + (False)))) → ((x ∉ FootprintVertices O ∨ O.cells.Nonempty) → ((x ∈ FootprintVertices + A) → ((x ∈ FootprintVertices B) → ((x ∉ FootprintVertices O → x ∈ FootprintVertices + (TileCellComplement A O) ∩ FootprintVertices B) → ((x ∉ FootprintVertices O → x ∈ + seg.left ∨ x ∈ seg.middle ∨ x ∈ seg.right) → (∀ (U : ProtoTile), (U.cells.Nonempty) → + ((x ∈ FootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + U.cells))))))))))))))))))) ) := by + classical + intro q cfg C T cert x hx hxb hk hnoncentral hA hB A B O seg hnonemptyO rawBoundary + boundary_sectors hIncidentA hIncidentB noThird hnotO hxA' hxB' hmodifiedCommon + hsegMembership U hUne hu + simp only [FootprintVertices, hUne, ite_true, Set.mem_ofPred_eq] at hu + rcases hu with ⟨z, hz, hcorner⟩ + rcases hcorner with h | h | h | h + · refine ⟨0, ?_⟩ + simpa [LatticeVertexIncidentCell] using h ▸ hz + · refine ⟨1, ?_⟩ + subst x + simpa [LatticeVertexIncidentCell] using hz + · refine ⟨3, ?_⟩ + subst x + simpa [LatticeVertexIncidentCell] using hz + · refine ⟨2, ?_⟩ + subst x + change (z + 1 + ⟨0, 1⟩) - 1 - ⟨0, 1⟩ ∈ U.cells + convert hz using 1; ext <;> simp + +private theorem hOpositive : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), (GaussianRealPoint x ≠ TileCentroid T) → ( + let O := cert.O + (TileCentroid O = TileCentroid T) → (x ∈ FootprintVertices O → O.cells.Nonempty)) ) := by + classical + intro q cfg C T cert x hnoncentral O hOcent hxO + by_contra hempty + have hanchor : x = O.anchor := by + simpa [FootprintVertices, hempty] using hxO + have hcent : GaussianRealPoint O.anchor = TileCentroid T := by + rw [← hOcent] + simp [GaussianRealPoint, TileCentroid, hempty] + exact hnoncentral (by simpa [hanchor] using hcent) + +private theorem hOcuts : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), + let A := cert.P 0 true + let B := cert.P 0 false + let O := cert.O + let seg := cert.exceptional_segments + (TileCentroid cert.O = TileCentroid T ∧ (cert.O.cells = ∅ ↔ (cfg.firstPredecessor (1 : + Fin (4 : ℕ))).1 = (0 : ℤ)) ∧ BandPrototile (cfg.firstPredecessor (1 : Fin (4 : ℕ))) + cert.O ∧ (Finset.Nonempty cert.O.cells → LatticeTile cert.O) ∧ Finset.Nonempty + (cert.Q (1 : Fin (3 : ℕ)) true).cells ∧ Finset.Nonempty (cert.S (2 : Fin (3 : ℕ)) + false).cells ∧ (cert.P (0 : Fin (3 : ℕ)) true).cells ∩ (cert.P (0 : Fin (3 : ℕ)) + false).cells = cert.O.cells ∧ ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin (3 : ℕ)), + ∀ (t : Bool), (i, s) ≠ (j, t) → ¬(i = (0 : Fin (3 : ℕ)) ∧ j = (0 : Fin (3 : ℕ))) → + Disjoint (cert.P i s).cells (cert.P j t).cells) → (((∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ A.cells) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell x + j ∉ A.cells)) → (((∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ B.cells) ∧ (∃ j : Fin + 4, LatticeVertexIncidentCell x j ∉ B.cells)) → ((∀ (U : ProtoTile), TileTranslation U + 0 = U) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → ((x ∈ FootprintVertices U) → (∃ j + : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells))) → ((x ∈ FootprintVertices O → + O.cells.Nonempty) → (x ∈ FootprintVertices O → x = seg.a ∨ x = seg.b)))))) ) := by + classical + intro q cfg C T cert x A B O seg hpre hIncidentA hIncidentB translation_zero incidentRaw + hOpositive hxO + have hOne := hOpositive hxO + have hOlat : LatticeTile O := hpre.2.2.2.1 hOne + have hOneCell := incidentRaw O hOne hxO + have isolated (j : Fin 4) : + LatticeVertexIncidentCell x j ∈ A.cells ∨ + LatticeVertexIncidentCell x j ∈ B.cells := by + let z := LatticeVertexIncidentCell x j + have hsingle : x ∈ FootprintVertices (⟨{z}, z⟩ : ProtoTile) := by + simp only [FootprintVertices, Finset.singleton_nonempty, ite_true, + Set.mem_ofPred_eq] + refine ⟨z, Finset.mem_singleton_self z, ?_⟩ + fin_cases j <;> simp [z, LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] + have hi := cert.precursor_isolated 0 0 x + (by simpa [O, zero_mul, add_zero, translation_zero] using hxO) z hsingle + simpa [z, SubtileOccurrenceInterpretation, TileTranslation, + GaussianTranslation] using hi + obtain ⟨jA, hjA⟩ := hIncidentA.2 + have hjAB : LatticeVertexIncidentCell x jA ∈ B.cells := by + rcases isolated jA with h | h + · exact (hjA h).elim + · exact h + have hjAO : LatticeVertexIncidentCell x jA ∉ O.cells := by + intro hz + exact hjA (seg.precursor_in_left hz) + obtain ⟨jB, hjB⟩ := hIncidentB.2 + have hjBA : LatticeVertexIncidentCell x jB ∈ A.cells := by + rcases isolated jB with h | h + · exact h + · exact (hjB h).elim + have hjBO : LatticeVertexIncidentCell x jB ∉ O.cells := by + intro hz + exact hjB (seg.precursor_in_right hz) + have hDminusIn : LatticeVertexIncidentCell x jA ∈ + (TileCellComplement B O).cells := by + change LatticeVertexIncidentCell x jA ∈ B.cells \ O.cells + exact Finset.mem_sdiff.mpr ⟨hjAB, hjAO⟩ + have hDplusIn : LatticeVertexIncidentCell x jB ∈ + (TileCellComplement A O).cells := by + change LatticeVertexIncidentCell x jB ∈ A.cells \ O.cells + exact Finset.mem_sdiff.mpr ⟨hjBA, hjBO⟩ + have hOoutsidePlus : LatticeVertexIncidentCell x jA ∉ + (TileCellComplement A O).cells := by + change LatticeVertexIncidentCell x jA ∉ A.cells \ O.cells + intro h + exact hjA (Finset.mem_sdiff.mp h).1 + have hOoutsideMinus : LatticeVertexIncidentCell x jB ∉ + (TileCellComplement B O).cells := by + change LatticeVertexIncidentCell x jB ∉ B.cells \ O.cells + intro h + exact hjB (Finset.mem_sdiff.mp h).1 + have hDplusNe : (TileCellComplement A O).cells.Nonempty := + ⟨LatticeVertexIncidentCell x jB, hDplusIn⟩ + have hDminusNe : (TileCellComplement B O).cells.Nonempty := + ⟨LatticeVertexIncidentCell x jA, hDminusIn⟩ + have hOB : x ∈ BoundaryFootprintVertices O := by + exact P3161T2IncidentBoundary O x hOneCell ⟨jA, hjAO⟩ + have hDplusB : x ∈ BoundaryFootprintVertices (TileCellComplement A O) := by + exact P3161T2IncidentBoundary _ x ⟨jB, hDplusIn⟩ ⟨jA, hOoutsidePlus⟩ + have hDminusB : x ∈ BoundaryFootprintVertices (TileCellComplement B O) := by + exact P3161T2IncidentBoundary _ x ⟨jA, hDminusIn⟩ ⟨jB, hOoutsideMinus⟩ + rcases cert.precursor_boundary.branch with hbranch | hempty + · rcases hbranch with ⟨_, plusArc, minusArc, _, _, _, _, _, _, hplusSet, + hminusSet, _, _, _, hinter, _, _⟩ + have hplus : x ∈ (plusArc.toFinset : Set GaussianInt) := by + rw [hplusSet] + exact ⟨hDplusB, hOB⟩ + have hminus : x ∈ (minusArc.toFinset : Set GaussianInt) := by + rw [hminusSet] + exact ⟨hDminusB, hOB⟩ + have haa : cert.precursor_boundary.a = seg.a := by + apply (seg.first_cut_unique cert.precursor_boundary.a).mp + exact (cert.precursor_boundary.first_transition cert.precursor_boundary.a).mpr rfl + have hbb : cert.precursor_boundary.b = seg.b := by + apply (seg.second_cut_unique cert.precursor_boundary.b).mp + exact (cert.precursor_boundary.second_transition cert.precursor_boundary.b).mpr rfl + have hpair : x ∈ ({cert.precursor_boundary.a, + cert.precursor_boundary.b} : Set GaussianInt) := by + rw [← hinter] + exact ⟨hplus, hminus⟩ + rw [haa, hbb] at hpair + simpa using hpair + · rcases hempty with ⟨he, _, _, _, _, _⟩ + rw [he] at hOne + simp at hOne + +private theorem hsupport : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), + let A := cert.P 0 true + let B := cert.P 0 false + let O := cert.O + let Q := cert.Q 1 true + let S := cert.S 2 false + let R := cert.Q 2 true + let V := cert.S 1 false + (FootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.P (1 : Fin + (3 : ℕ)) true) ⊆ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∩ + FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true) ∧ FootprintVertices (cert.P (0 : + Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.P (0 : Fin (3 : ℕ)) false) ⊆ + FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.S (2 : + Fin (3 : ℕ)) false) ∪ FootprintVertices (cert.Q (0 : Fin (3 : ℕ)) false) ∪ + FootprintVertices (cert.Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.S (1 : + Fin (3 : ℕ)) false)) → ((x ∈ FootprintVertices A) → ((x ∈ FootprintVertices B) → (x ∈ + (FootprintVertices Q ∩ FootprintVertices S) ∪ FootprintVertices O ∪ + (FootprintVertices R ∩ FootprintVertices V)))) ) := by + classical + intro q cfg C T cert x A B O Q S R V hrawAB hxA' hxB' + have hs := hrawAB.2 ⟨hxA', hxB'⟩ + simpa [Q, S, O, R, V, ← cert.precursor_eq] using hs + +private theorem hVnonzero : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + (cfg.firstPredecessor 2 = q 2) → ((cfg.firstPredecessor 2).1 ≠ 0) ) := by + classical + intro q cfg hVcoord + rw [hVcoord] + exact cfg.noLine 2 + +private theorem hRnonzero : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + (cfg.firstPredecessor 3 = q 3) → ((cfg.firstPredecessor 3).1 ≠ 0) ) := by + classical + intro q cfg hRcoord + rw [hRcoord] + exact cfg.noLine 3 + +private theorem touchingDisjoint : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → ((Y.cells.Nonempty) → + ((TileTouching X Y) → (Disjoint X.cells Y.cells))) ) := by + classical + intro X Y hX hY hxy + rcases hxy with ⟨_, _, hd, _⟩ | ⟨he, _⟩ | ⟨he, _⟩ + · exact hd + · simp [he] at hX + · simp [he] at hY + +private theorem hp1_not : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), + let Ctile := cert.P 1 true + let Q := cert.Q 1 true + let S := cert.S 2 false + (ExceptionalRestorationSectorData (cert.P (0 : Fin (3 : ℕ)) true) (cert.P (0 : Fin (3 : + ℕ)) false) cert.O (cert.Q (1 : Fin (3 : ℕ)) true) (cert.S (2 : Fin (3 : ℕ)) false) + (cert.Q (2 : Fin (3 : ℕ)) true) (cert.S (1 : Fin (3 : ℕ)) false) (cert.P (1 : Fin (3 + : ℕ)) true) (cert.P (1 : Fin (3 : ℕ)) false) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I1, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ((∀ (i : Fin 3), ∀ (s : + Bool), ((i, s) ≠ ((0 : Fin 3), true)) → (((i, s) ≠ ((0 : Fin 3), false)) → ((x ∈ + BoundaryFootprintVertices (cert.P i s)) → (False)))) → ( + let p1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + (Disjoint S.cells Ctile.cells) → ((Disjoint Q.cells Ctile.cells) → (x ≠ p1)))) ) := by + classical + intro q cfg C T cert x Ctile Q S sec noThird p1 hSCdisj hQCd hxp + have hboundC : p1 ∈ BoundaryFootprintVertices Ctile := by + apply P3161T2IncidentBoundary Ctile p1 + · obtain ⟨jc, hjc⟩ := sec.first_marked_companion + exact ⟨jc, hjc⟩ + · rcases sec.first_marked_opposite with hQS | hQC | hSC + · obtain ⟨j, hq, _⟩ := hQS + exact ⟨j, fun hc => Finset.disjoint_left.mp hQCd hq hc⟩ + · obtain ⟨j, hq, _⟩ := hQC + exact ⟨j, fun hc => Finset.disjoint_left.mp hQCd hq hc⟩ + · obtain ⟨j, hs, _⟩ := hSC + exact ⟨j, fun hc => Finset.disjoint_left.mp hSCdisj hs hc⟩ + exact noThird 1 true (by decide) (by decide) + (by simpa [hxp] using hboundC) + +private theorem hp2_not : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), + let Dtile := cert.P 1 false + let R := cert.Q 2 true + let V := cert.S 1 false + (ExceptionalRestorationSectorData (cert.P (0 : Fin (3 : ℕ)) true) (cert.P (0 : Fin (3 : + ℕ)) false) cert.O (cert.Q (1 : Fin (3 : ℕ)) true) (cert.S (2 : Fin (3 : ℕ)) false) + (cert.Q (2 : Fin (3 : ℕ)) true) (cert.S (1 : Fin (3 : ℕ)) false) (cert.P (1 : Fin (3 + : ℕ)) true) (cert.P (1 : Fin (3 : ℕ)) false) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I1, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ((∀ (i : Fin 3), ∀ (s : + Bool), ((i, s) ≠ ((0 : Fin 3), true)) → (((i, s) ≠ ((0 : Fin 3), false)) → ((x ∈ + BoundaryFootprintVertices (cert.P i s)) → (False)))) → ( + let p2 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) + (Disjoint V.cells Dtile.cells) → ((Disjoint R.cells Dtile.cells) → (x ≠ p2)))) ) := by + classical + intro q cfg C T cert x Dtile R V sec noThird p2 hVRdisj hRDdisj hxp + have hboundD : p2 ∈ BoundaryFootprintVertices Dtile := by + apply P3161T2IncidentBoundary Dtile p2 + · obtain ⟨jd, hjd⟩ := sec.second_marked_companion + exact ⟨jd, hjd⟩ + · rcases sec.second_marked_opposite with hRS | hRD | hSD + · obtain ⟨j, hr, _⟩ := hRS + exact ⟨j, fun hd => Finset.disjoint_left.mp hRDdisj hr hd⟩ + · obtain ⟨j, hr, _⟩ := hRD + exact ⟨j, fun hd => Finset.disjoint_left.mp hRDdisj hr hd⟩ + · obtain ⟨j, hs, _⟩ := hSD + exact ⟨j, fun hd => Finset.disjoint_left.mp hVRdisj hs hd⟩ + exact noThird 1 false (by decide) (by decide) + (by simpa [hxp] using hboundD) + +private theorem hcutApositive : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), + let O := cert.O + let seg := cert.exceptional_segments + (O.cells.Nonempty ∨ x ≠ seg.a) → (x = seg.a → O.cells.Nonempty) ) := by + classical + intro q cfg C T cert x O seg hnonemptyO hxa + rcases hnonemptyO with h | h + · exact h + · exact (h hxa).elim + +private theorem hcutBpositive : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), (GaussianRealPoint x ≠ TileCentroid T) → ( + let O := cert.O + let seg := cert.exceptional_segments + (O.cells = ∅ → GaussianRealPoint seg.a = TileCentroid T) → (x = seg.b → + O.cells.Nonempty)) ) := by + classical + intro q cfg C T cert x hnoncentral O seg hempty_anchor hxb + by_contra hO + have hOempty : O.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hO + have hcut := seg.empty_cut hOempty + have hxa : x = seg.a := hxb.trans hcut.1.symm + have hcen : GaussianRealPoint x = TileCentroid T := by + rw [hxa] + exact hempty_anchor hOempty + exact hnoncentral hcen + +private theorem hCnone : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), + let Ctile := cert.P 1 true + let O := cert.O + let seg := cert.exceptional_segments + (ExceptionalRestorationSectorData (cert.P (0 : Fin (3 : ℕ)) true) (cert.P (0 : Fin (3 : + ℕ)) false) cert.O (cert.Q (1 : Fin (3 : ℕ)) true) (cert.S (2 : Fin (3 : ℕ)) false) + (cert.Q (2 : Fin (3 : ℕ)) true) (cert.S (1 : Fin (3 : ℕ)) false) (cert.P (1 : Fin (3 + : ℕ)) true) (cert.P (1 : Fin (3 : ℕ)) false) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I1, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ((O.cells.Nonempty ∨ x ≠ + seg.a) → ( + let p1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + (x ≠ p1) → ((x ∈ seg.left) → (∀ j : Fin 4, LatticeVertexIncidentCell x j ∉ + Ctile.cells)))) ) := by + classical + intro q cfg C T cert x Ctile O seg sec hnonemptyO p1 hp1_not hleft j hj + have hc : ∃ k : Fin 4, LatticeVertexIncidentCell x k ∈ Ctile.cells := ⟨j, hj⟩ + have hxP := (sec.left_companion x hleft hnonemptyO).mp hc + exact hp1_not (by + have hendpoint : x = p1 := hxP + simpa [p1] using hendpoint) + +private theorem hOnoneAt589 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), + let O := cert.O + let seg := cert.exceptional_segments + (ExceptionalRestorationSectorData (cert.P (0 : Fin (3 : ℕ)) true) (cert.P (0 : Fin (3 : + ℕ)) false) cert.O (cert.Q (1 : Fin (3 : ℕ)) true) (cert.S (2 : Fin (3 : ℕ)) false) + (cert.Q (2 : Fin (3 : ℕ)) true) (cert.S (1 : Fin (3 : ℕ)) false) (cert.P (1 : Fin (3 + : ℕ)) true) (cert.P (1 : Fin (3 : ℕ)) false) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I1, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ((x ∈ seg.left) → ((¬x = + seg.a) → (∀ j : Fin 4, LatticeVertexIncidentCell x j ∉ O.cells))) ) := by + classical + intro q cfg C T cert x O seg sec hleft hxa j hj + by_cases hO : O.cells.Nonempty + · have hxcut := (sec.positive_left_precursor hO x hleft).mp ⟨j, hj⟩ + exact hxa hxcut + · exact hO ⟨LatticeVertexIncidentCell x j, hj⟩ + +private theorem hguardR : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), + let seg := cert.exceptional_segments + (¬x = seg.b) → ( + let O := cert.O + O.cells.Nonempty ∨ x ≠ seg.b) ) := by + classical + intro q cfg C T cert x seg hxb O + by_cases hO : O.cells.Nonempty + · exact Or.inl hO + · exact Or.inr hxb + +private theorem hDnone : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), + let Dtile := cert.P 1 false + let O := cert.O + let seg := cert.exceptional_segments + (ExceptionalRestorationSectorData (cert.P (0 : Fin (3 : ℕ)) true) (cert.P (0 : Fin (3 : + ℕ)) false) cert.O (cert.Q (1 : Fin (3 : ℕ)) true) (cert.S (2 : Fin (3 : ℕ)) false) + (cert.Q (2 : Fin (3 : ℕ)) true) (cert.S (1 : Fin (3 : ℕ)) false) (cert.P (1 : Fin (3 + : ℕ)) true) (cert.P (1 : Fin (3 : ℕ)) false) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I1, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ( + let p2 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) + (x ≠ p2) → ((x ∈ seg.right) → ((O.cells.Nonempty ∨ x ≠ seg.b) → (∀ j : Fin 4, + LatticeVertexIncidentCell x j ∉ Dtile.cells)))) ) := by + classical + intro q cfg C T cert x Dtile O seg sec p2 hp2_not hright hguardR j hj + have hd : ∃ k : Fin 4, LatticeVertexIncidentCell x k ∈ Dtile.cells := ⟨j, hj⟩ + have hxP := (sec.right_companion x hright hguardR).mp hd + exact hp2_not (by simpa [p2] using hxP) + +private theorem hOnoneAt624 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), + let seg := cert.exceptional_segments + (¬x = seg.b) → ( + let O := cert.O + (ExceptionalRestorationSectorData (cert.P (0 : Fin (3 : ℕ)) true) (cert.P (0 : Fin (3 : + ℕ)) false) cert.O (cert.Q (1 : Fin (3 : ℕ)) true) (cert.S (2 : Fin (3 : ℕ)) false) + (cert.Q (2 : Fin (3 : ℕ)) true) (cert.S (1 : Fin (3 : ℕ)) false) (cert.P (1 : Fin (3 + : ℕ)) true) (cert.P (1 : Fin (3 : ℕ)) false) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I1, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho + ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → + cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ((x ∈ seg.right) → (∀ j : + Fin 4, LatticeVertexIncidentCell x j ∉ O.cells))) ) := by + classical + intro q cfg C T cert x seg hxb O sec hright j hj + by_cases hO : O.cells.Nonempty + · have hxcut := (sec.positive_right_precursor hO x hright).mp ⟨j, hj⟩ + exact hxb hxcut + · exact hO ⟨LatticeVertexIncidentCell x j, hj⟩ + +end RestoredBoundaryGeometry + +theorem P4590T1RestoredBoundaryGeometry : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + (LatticeTile T) → (∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ + BoundaryFootprintVertices T) → ((Nat.card {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2) → ((GaussianRealPoint x ≠ + TileCentroid T) → ((x ∈ BoundaryFootprintVertices (cert.P 0 true)) → ((x ∈ + BoundaryFootprintVertices (cert.P 0 false)) → ((x ∈ FootprintVertices (cert.Q 1 true) ∧ + x ∈ FootprintVertices (cert.S 2 false) ∧ + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.Q 1 true) ∨ y ∈ FootprintVertices (cert.S 2 false)) ∧ + x ∉ FootprintVertices (cert.P 1 true)) ∨ + (x ∈ FootprintVertices (cert.Q 2 true) ∧ x ∈ FootprintVertices (cert.S 1 false) ∧ + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.Q 2 true) ∨ y ∈ FootprintVertices (cert.S 1 false)) ∧ + x ∉ FootprintVertices (cert.P 1 false)) ∨ + (x = cert.exceptional_segments.a ∧ cert.O.cells.Nonempty) ∨ + (x = cert.exceptional_segments.b ∧ cert.O.cells.Nonempty)))))))) := by + intro q cfg C T cert hT x hx hxb hk hnoncentral hA hB +-- BODY + classical + let A := cert.P 0 true + let B := cert.P 0 false + let Ctile := cert.P 1 true + let Dtile := cert.P 1 false + let O := cert.O + let Q := cert.Q 1 true + let S := cert.S 2 false + let R := cert.Q 2 true + let V := cert.S 1 false + let seg := cert.exceptional_segments + let sec := BandExceptionalRestorationSectorOrder q cfg C T cert + have hsec := sec + have hpre := P4339T1PrecursorSupportGeometry C q cfg T cert + have hABcells : A.cells ∩ B.cells = O.cells := by + simpa [A, B, O] using hpre.2.2.2.2.2.2.1 + have hsep := hpre.2.2.2.2.2.2.2 + have hABdisj : Disjoint A.cells Ctile.cells := by + simpa [A, Ctile] using hsep 0 true 1 true (by decide) (by decide) + have hBDdisj : Disjoint B.cells Dtile.cells := by + simpa [B, Dtile] using hsep 0 false 1 false (by decide) (by decide) + have hAne : A.cells.Nonempty := + (LatticeTileGridStructure A (cert.parent_lattice 0 true)).1.1 + have hBne : B.cells.Nonempty := + (LatticeTileGridStructure B (cert.parent_lattice 0 false)).1.1 + have hOcent : TileCentroid O = TileCentroid T := hpre.1 + have hempty_anchor := RestoredBoundaryGeometry.hempty_anchor q cfg C T cert hOcent + have hnonemptyO := RestoredBoundaryGeometry.hnonemptyO q cfg C T cert x hnoncentral hempty_anchor + have rawBoundary (U : ProtoTile) (hUne : U.cells.Nonempty) + (hb : x ∈ BoundaryFootprintVertices U) : x ∈ FootprintVertices U := + RestoredBoundaryGeometry.rawBoundary q cfg C T cert x hx hxb hk hnoncentral hA hB + hnonemptyO U hUne hb + have boundary_sectors (U : ProtoTile) (hne : U.cells.Nonempty) + (hb : x ∈ BoundaryFootprintVertices U) : + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ U.cells) := + RestoredBoundaryGeometry.boundary_sectors q cfg C T cert x hx hxb hk hnoncentral hA hB + hnonemptyO rawBoundary U hne hb + have hIncidentA : (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ A.cells) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ A.cells) := + boundary_sectors A hAne (by simpa [A] using hA) + have hIncidentB : (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ B.cells) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ B.cells) := + boundary_sectors B hBne (by simpa [B] using hB) + have noThird := RestoredBoundaryGeometry.noThird q cfg C T cert x hk hA hB + have hnotO := RestoredBoundaryGeometry.hnotO q cfg C T cert x hnoncentral hOcent + have hrawAB := BandOrderedGeneralRawSupport q cfg C T cert + have hxA' := rawBoundary A hAne (by simpa [A] using hA) + have hxB' := rawBoundary B hBne (by simpa [B] using hB) + have hdeletedNe : (TileCellComplement A O).cells.Nonempty := + (LatticeTileGridStructure _ cert.precursor_complement_lattice.1).1.1 + have hmodifiedCommon := RestoredBoundaryGeometry.hmodifiedCommon q cfg C T cert x hAne hxA' + hxB' hdeletedNe + let ia : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let ib : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + have translation_zero := RestoredBoundaryGeometry.translation_zero + have htileA := RestoredBoundaryGeometry.htileA q cfg C T cert translation_zero + have htileB := RestoredBoundaryGeometry.htileB q cfg C T cert translation_zero + have hab : ia ≠ ib := by decide + have habedge := cert.modified.adjacent_has_common_edge ia ib (RestoredBoundaryGeometry.hadj q + cfg C T cert) + obtain ⟨hclassification, hregular⟩ := PeriodicTileIntersectionClassification cert.modified + have hraw := ((hclassification ia ib hab).2.1 habedge).2 + obtain ⟨_, f, g, hfg, hf, hg, hfaces, hpath⟩ := + (PeriodicTileIntersectionPaths cert.modified hregular ia ib hab).1.mpr habedge + have hrho1 : cert.modified.rho f1 = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) := + cert.modified_face_points _ + have hrho2 : cert.modified.rho f2 = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) := + cert.modified_face_points _ + have hconnectorWalk : seg.connector.Sublist seg.walk := seg.connector_from_walk + have hsegMembership := RestoredBoundaryGeometry.hsegMembership q cfg C T cert x hmodifiedCommon + (RestoredBoundaryGeometry.hexhaust q cfg C T cert htileA htileB hraw f g hpath + (RestoredBoundaryGeometry.hf1 q cfg C T cert f g hfaces) (RestoredBoundaryGeometry.hf2 q + cfg C T cert f g hfaces) (RestoredBoundaryGeometry.hf12 q cfg C T cert) hrho1 hrho2) + hconnectorWalk + have incidentRaw := RestoredBoundaryGeometry.incidentRaw q cfg C T cert x hx hxb hk hnoncentral + hA hB hnonemptyO rawBoundary boundary_sectors hIncidentA hIncidentB noThird hnotO hxA' hxB' + hmodifiedCommon hsegMembership + have hOpositive := RestoredBoundaryGeometry.hOpositive q cfg C T cert x hnoncentral hOcent + have hOcuts := RestoredBoundaryGeometry.hOcuts q cfg C T cert x hpre hIncidentA hIncidentB + translation_zero incidentRaw hOpositive + have hsupport := RestoredBoundaryGeometry.hsupport q cfg C T cert x hrawAB hxA' hxB' + let p1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let p2 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) + have hQne : Q.cells.Nonempty := hpre.2.2.2.2.1 + have hSne : S.cells.Nonempty := hpre.2.2.2.2.2.1 + have hCparent : LatticeTile Ctile := cert.parent_lattice 1 true + have hDparent : LatticeTile Dtile := cert.parent_lattice 1 false + have hCne : Ctile.cells.Nonempty := (LatticeTileGridStructure _ hCparent).1.1 + have hDne : Dtile.cells.Nonempty := (LatticeTileGridStructure _ hDparent).1.1 + have hVcurv := + (ProperBandCurvatureStructure cfg.firstPredecessor cfg.firstProper).2.1 1 + have hVcoord : cfg.firstPredecessor 2 = q 2 := cfg.firstParentTwo + have hVpos : 0 < (cfg.firstPredecessor 2).1 := + lt_of_le_of_ne hVcurv (Ne.symm (RestoredBoundaryGeometry.hVnonzero q cfg hVcoord)) + have hVlat : LatticeTile V := + P4590T1PositivePrototileDisk (cfg.firstPredecessor 2) V + (cert.minus_occurrence 1 false).1 hVpos + have hVne : V.cells.Nonempty := (LatticeTileGridStructure _ hVlat).1.1 + have hRcurv := + (ProperBandCurvatureStructure cfg.firstPredecessor cfg.firstProper).2.1 2 + have hRcoord : cfg.firstPredecessor 3 = q 3 := cfg.firstParentThree + have hRpos : 0 < (cfg.firstPredecessor 3).1 := + lt_of_le_of_ne hRcurv (Ne.symm (RestoredBoundaryGeometry.hRnonzero q cfg hRcoord)) + have hRlat : LatticeTile R := + P4590T1PositivePrototileDisk (cfg.firstPredecessor 3) R + (cert.plus_occurrence 2 true).1 hRpos + have hRne : R.cells.Nonempty := (LatticeTileGridStructure _ hRlat).1.1 + have touchingDisjoint := RestoredBoundaryGeometry.touchingDisjoint + have hSCdisj : Disjoint S.cells Ctile.cells := + touchingDisjoint S Ctile hSne hCne cert.double_first.2.1 + have hCQdisj : Disjoint Ctile.cells Q.cells := + touchingDisjoint Ctile Q hCne hQne cert.double_first.2.2.1 + have hQCd : Disjoint Q.cells Ctile.cells := hCQdisj.symm + have hVRdisj : Disjoint V.cells Dtile.cells := by + exact touchingDisjoint V Dtile hVne hDne cert.double_second.2.1 + have hDRdisj : Disjoint Dtile.cells R.cells := + touchingDisjoint Dtile R hDne hRne cert.double_second.2.2.1 + have hRDdisj : Disjoint R.cells Dtile.cells := hDRdisj.symm + have hp1_not := RestoredBoundaryGeometry.hp1_not q cfg C T cert x sec noThird hSCdisj hQCd + have hp2_not := RestoredBoundaryGeometry.hp2_not q cfg C T cert x sec noThird hVRdisj hRDdisj + have hcutApositive := RestoredBoundaryGeometry.hcutApositive q cfg C T cert x hnonemptyO + have hcutBpositive := RestoredBoundaryGeometry.hcutBpositive q cfg C T cert x hnoncentral + hempty_anchor + by_cases hxO : x ∈ FootprintVertices O + · rcases hOcuts hxO with hxA | hxB + · exact Or.inr (Or.inr (Or.inl ⟨hxA, hOpositive hxO⟩)) + · exact Or.inr (Or.inr (Or.inr ⟨hxB, hOpositive hxO⟩)) + · rcases hsegMembership hxO with hleft | hmiddle | hright + · by_cases hxa : x = seg.a + · exact Or.inr (Or.inr (Or.inl ⟨hxa, hcutApositive hxa⟩)) + · by_cases hxb : x = seg.b + · exact Or.inr (Or.inr (Or.inr ⟨hxb, hcutBpositive hxb⟩)) + · have hCnone := RestoredBoundaryGeometry.hCnone q cfg C T cert x sec hnonemptyO hp1_not + hleft + have hOnone := RestoredBoundaryGeometry.hOnoneAt589 q cfg C T cert x sec hleft hxa + have hopp := sec.left_opposite x hleft hnonemptyO hCnone hOnone + have hvertices := seg.left_vertices x hleft + exact Or.inl ⟨hvertices.1, hvertices.2, + P4590T1OppositeCellsStar Q S x hopp, by + intro hxC + obtain ⟨j, hj⟩ := incidentRaw Ctile hCne hxC + exact hCnone j hj⟩ + · by_cases hxa : x = seg.a + · exact Or.inr (Or.inr (Or.inl ⟨hxa, hcutApositive hxa⟩)) + · by_cases hxb : x = seg.b + · exact Or.inr (Or.inr (Or.inr ⟨hxb, hcutBpositive hxb⟩)) + · have hcommon : x ∈ BoundaryFootprintVertices A ∩ + BoundaryFootprintVertices B := ⟨by simpa [A] using hA, by simpa [B] using hB⟩ + have hnotcommon := sec.proper_middle_not_original_common x hmiddle hxa hxb + exact False.elim (hnotcommon hcommon) + · by_cases hxa : x = seg.a + · exact Or.inr (Or.inr (Or.inl ⟨hxa, hcutApositive hxa⟩)) + · by_cases hxb : x = seg.b + · exact Or.inr (Or.inr (Or.inr ⟨hxb, hcutBpositive hxb⟩)) + · have hguardR := RestoredBoundaryGeometry.hguardR q cfg C T cert x hxb + have hDnone := RestoredBoundaryGeometry.hDnone q cfg C T cert x sec hp2_not hright hguardR + have hOnone := RestoredBoundaryGeometry.hOnoneAt624 q cfg C T cert x hxb sec hright + have hopp := sec.right_opposite x hright hguardR hDnone hOnone + have hvertices := seg.right_vertices x hright + exact Or.inr (Or.inl ⟨hvertices.1, hvertices.2, + P4590T1OppositeCellsStar R V x hopp, by + intro hxD + obtain ⟨j, hj⟩ := incidentRaw Dtile hDne hxD + exact hDnone j hj⟩) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean new file mode 100644 index 0000000000..710faa1ab2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean @@ -0,0 +1,2269 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRawSupport +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralGeometricSectors +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn +public import LeanPool.ApollonianSuperharmonic.P4055T1BandQuarterTurn +public import LeanPool.ApollonianSuperharmonic.P4590T1PositivePrototileDisk +public import LeanPool.ApollonianSuperharmonic.P4590T1OppositeCellsStar +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas + +-- [TABLET NODE: P4590T1RightInteriorGeometry] + +/-! +# P4590T1RightInteriorGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RightInteriorGeometry + +private theorem ht : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (u : GaussianInt), (GaussianRealPoint u = ((TileCentroid (cert.P (0 : Fin + (3 : ℕ)) false)).1 + (TileCentroid (cert.P (0 : Fin (3 : ℕ)) false)).2, (TileCentroid + (cert.P (0 : Fin (3 : ℕ)) false)).2 - (TileCentroid (cert.P (0 : Fin (3 : ℕ)) + false)).1)) → ( + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + (t.re : Real) = 2 * (TileCentroid T).1 ∧ (t.im : Real) = 2 * (TileCentroid T).2) ) := by + classical + intro q cfg C T cert u hu w t + have hur := congrArg Prod.fst hu + have hui := congrArg Prod.snd hu + have hc := (cert.outer_occurrence 0 false).2.2 + have hcr := congrArg Prod.fst hc + have hci := congrArg Prod.snd hc + norm_num [GaussianRealPoint] at hur hui hcr hci + simp only [← GaussianInt.intCast_re, ← GaussianInt.intCast_im] at hur hui hcr hci + dsimp [t, w] + push_cast + constructor <;> linarith + +private theorem hHcells : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ + ∀ (U : ProtoTile), (H U).cells = U.cells.image tau ) := by + classical + intro q u w t H tau U + simp only [H, TileTranslation, TileHalfTurn, Finset.image_image] + apply Finset.image_congr + intro z hz + apply Zsqrtd.ext <;> + simp [GaussianTranslation, tau] <;> ring + +private theorem halfTurnRealization : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + ((t.re : Real) = 2 * (TileCentroid T).1 ∧ (t.im : Real) = 2 * (TileCentroid T).2) → ( + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + ∀ (U : ProtoTile), TileRealization (H U) = (fun p : Real × Real => (2 * (TileCentroid + T).1 - p.1, 2 * (TileCentroid T).2 - p.2)) '' TileRealization U) ) := by + classical + intro q T u w t ht H U + change TileRealization (TileTranslation (TileHalfTurn U) t) = _ + rw [(TileTranslationFormulas (TileHalfTurn U) t).2.2.2.1, + (TileHalfTurnFormulas U).2.2.2.2.2.1, Set.image_image] + congr 1 + funext p + apply Prod.ext <;> simp [ht.1, ht.2] <;> ring + +private theorem halfTurnFootprint : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + ∀ (U : ProtoTile), FootprintVertices (H U) = (fun z : GaussianInt => t - z) '' + FootprintVertices U ) := by + classical + intro q u w t H U + change FootprintVertices (TileTranslation (TileHalfTurn U) t) = _ + rw [(TileTranslationFormulas (TileHalfTurn U) t).2.2.2.2.2.1, + (TileHalfTurnFormulas U).2.2.2.2.2.2.1, Set.image_image] + congr 1 + funext z + apply Zsqrtd.ext <;> simp [GaussianTranslation] <;> ring + +private theorem halfTurnBoundary : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + ∀ (U : ProtoTile), (U.cells.Nonempty) → (BoundaryFootprintVertices (H U) = (fun z : + GaussianInt => t - z) '' BoundaryFootprintVertices U) ) := by + classical + intro q u w t H U hne + have hcells : (TileHalfTurn U).cells = + (TileQuarterTurn (TileQuarterTurn U)).cells := + (TileHalfTurnFormulas U).2.2.2.2.1 + have hhalfne : (TileHalfTurn U).cells.Nonempty := by + apply Finset.nonempty_iff_ne_empty.mpr + intro he + exact hne.ne_empty ((TileHalfTurnFormulas U).2.2.1.mp he) + have hqne : (TileQuarterTurn (TileQuarterTurn U)).cells.Nonempty := by + rw [← hcells] + exact hhalfne + have hhalfBound : BoundaryFootprintVertices (TileHalfTurn U) = + BoundaryFootprintVertices (TileQuarterTurn (TileQuarterTurn U)) := by + have hempty : (TileHalfTurn U).cells = ∅ → + (TileHalfTurn U).anchor = + (TileQuarterTurn (TileQuarterTurn U)).anchor := by + intro h + exact False.elim (hhalfne.ne_empty h) + exact (ProtoTileObservableExtensionality _ _ hcells hempty).2.1 + have hquarterBound : + BoundaryFootprintVertices (TileQuarterTurn (TileQuarterTurn U)) = + (fun z : GaussianInt => -z) '' BoundaryFootprintVertices U := by + rw [(TileQuarterTurnFormulas (TileQuarterTurn U)).2.2.2.2.2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.2.2.2.2.1, Set.image_image] + congr 1 + change BoundaryFootprintVertices (TileTranslation (TileHalfTurn U) t) = _ + rw [(TileTranslationFormulas (TileHalfTurn U) t).2.2.2.2.2.2.2.1, + hhalfBound, hquarterBound, Set.image_image] + congr 1 + funext z + apply Zsqrtd.ext <;> simp [GaussianTranslation] <;> ring + +private theorem cells_of_realization : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (V : ProtoTile), (TileRealization U = TileRealization V) → (U.cells + = V.cells) ) := by + classical + intro U V hreal + ext a + rw [← P3776T1CellCenterMembership U a, + ← P3776T1CellCenterMembership V a, hreal] + +private theorem outerRealization : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + (∀ (U : ProtoTile), TileRealization (H U) = (fun p : Real × Real => (2 * (TileCentroid + T).1 - p.1, 2 * (TileCentroid T).2 - p.2)) '' TileRealization U) → ((∀ (i : Fin (3 : + ℕ)), + let w := BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ); + let u := GaussianQuarterTurn w - w; (TileTranslation (cert.P i true) u).cells = (cert.P i + false).cells ∧ ((cert.P i true).cells = ∅ → (TileTranslation (cert.P i true) + u).anchor = (cert.P i false).anchor) ∧ FootprintVertices (TileTranslation (cert.P i + true) u) = FootprintVertices (cert.P i false) ∧ TileCentroid (TileTranslation (cert.P + i true) u) = TileCentroid (cert.P i false) ∧ TileArea (cert.P i true) = TileArea + (cert.P i false) ∧ CentrallyReflectedAt (TileCentroid T) (cert.P i true) (cert.P i + false)) → (∀ (i : Fin 3), TileRealization (H (cert.P i true)) = TileRealization + (cert.P i false))) ) := by + classical + intro q cfg C T cert u w t H halfTurnRealization signedOuter i + rw [halfTurnRealization] + have houter := (signedOuter i).2.2.2.2.2 + simpa using houter.symm + +private theorem outerFootprint : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + (∀ (i : Fin 3), (H (cert.P i true)).cells = (cert.P i false).cells) → ((∀ (i : Fin 3), ∀ + (s : Bool), (cert.P i s).cells.Nonempty) → (∀ (i : Fin 3), FootprintVertices (H + (cert.P i true)) = FootprintVertices (cert.P i false))) ) := by + classical + intro q cfg C T cert u w t H outerCells outerNonempty i + have hempty : (H (cert.P i true)).cells = ∅ → + (H (cert.P i true)).anchor = (cert.P i false).anchor := by + intro hh + have : (cert.P i false).cells = ∅ := by rw [← outerCells i]; exact hh + exact False.elim ((outerNonempty i false).ne_empty this) + exact (ProtoTileObservableExtensionality (H (cert.P i true)) + (cert.P i false) (outerCells i) hempty).1 + +private theorem outerBoundary : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + (∀ (i : Fin 3), (H (cert.P i true)).cells = (cert.P i false).cells) → ((∀ (i : Fin 3), ∀ + (s : Bool), (cert.P i s).cells.Nonempty) → (∀ (i : Fin 3), BoundaryFootprintVertices + (H (cert.P i true)) = BoundaryFootprintVertices (cert.P i false))) ) := by + classical + intro q cfg C T cert u w t H outerCells outerNonempty i + have hempty : (H (cert.P i true)).cells = ∅ → + (H (cert.P i true)).anchor = (cert.P i false).anchor := by + intro hh + have : (cert.P i false).cells = ∅ := by rw [← outerCells i]; exact hh + exact False.elim ((outerNonempty i false).ne_empty this) + exact (ProtoTileObservableExtensionality (H (cert.P i true)) + (cert.P i false) (outerCells i) hempty).2.1 + +private theorem splitInternal : + (by + classical + exact + ∀ (l : List GaussianInt), ∀ (x : GaussianInt), ∀ (h : GaussianInt), ∀ (t : GaussianInt), + l.Nodup → l.head? = some h → l.getLast? = some t → x ∈ l → x ≠ h → x ≠ t → ∃ pre y z + post, l = pre ++ y :: x :: z :: post ) := by + classical + intro l + induction l with + | nil => intro x h t hn hh ht hx; simp at hx + | cons a tail ih => + intro x h t hn hh ht hx hxh hxt + have hah : a = h := by simpa using hh + subst h + rcases List.mem_cons.mp hx with hxa | hx + · exact (hxh hxa).elim + · cases tail with + | nil => simp at hx + | cons b rest => + by_cases hxb : x = b + · subst x + have hrest : rest ≠ [] := by + intro he + subst rest + have hb : b = t := by simpa using ht + exact hxt hb + cases rest with + | nil => exact (hrest rfl).elim + | cons c u => + refine ⟨[], a, c, u, ?_⟩ + simp + · obtain ⟨pre, y, z, post, heq⟩ := + ih x b t hn.tail (by rfl) (by simpa using ht) hx hxb hxt + refine ⟨a :: pre, y, z, post, ?_⟩ + simp [heq] + +private theorem twoPathEdges : + (by + classical + exact + (∀ (l : List GaussianInt), ∀ (x : GaussianInt), ∀ (h : GaussianInt), ∀ (t : GaussianInt), + l.Nodup → l.head? = some h → l.getLast? = some t → x ∈ l → x ≠ h → x ≠ t → ∃ pre y z + post, l = pre ++ y :: x :: z :: post) → (∀ (v : GaussianInt), ∀ (V : Set + GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), (SimpleGridPathBetween V E a b) → ((v ∈ V) → ((v ≠ a) → ((v ≠ b) → (∃ y + z : GaussianInt, ∃ e f : Finset GaussianInt, e ≠ f ∧ v ∈ e ∧ v ∈ f ∧ e ∈ E ∧ f ∈ E ∧ + e = {y, v} ∧ f = {v, z} ∧ FourNeighborAdjacent y v ∧ FourNeighborAdjacent v z))))) ) + := by + classical + intro splitInternal v V E a b hpath hxV hxa hxb + rcases hpath with ⟨p, hp, hlen, hhead, hlast, hV, hstep, hE⟩ + have hxp : v ∈ p := by + rw [hV] at hxV + simpa using hxV + obtain ⟨pre, y, z, post, hlist⟩ := + splitInternal p v a b hp hhead hlast hxp hxa hxb + have he₁ : {y, v} ∈ E := + (hE {y, v}).2 ⟨y, v, pre, z :: post, hlist, rfl⟩ + have he₂ : {v, z} ∈ E := + (hE {v, z}).2 ⟨v, z, pre ++ [y], post, by + rw [hlist] + simp [List.append_assoc], rfl⟩ + have hstep₁ := hstep y v pre (z :: post) hlist + have hstep₂ := hstep v z (pre ++ [y]) post (by + rw [hlist] + simp [List.append_assoc]) + have hnod := hp + rw [hlist] at hnod + have htail : (y :: v :: z :: post).Nodup := + (List.nodup_append.mp hnod).2.1 + have hnot : y ∉ v :: z :: post := (List.nodup_cons.mp htail).1 + have hyx : y ≠ v := by intro h; exact hnot (by simp [h]) + have hyz : y ≠ z := by intro h; exact hnot (by simp [h]) + have hne : ({y, v} : Finset GaussianInt) ≠ {v, z} := by + intro h + have hy' : y = v ∨ y = z := by + have : y ∈ ({v, z} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + rcases hy' with hy' | hy' + · exact hyx (by simpa using hy') + · exact hyz hy' + refine ⟨y, z, {y, v}, {v, z}, hne, by simp, by simp, he₁, he₂, rfl, rfl, + ?_, ?_⟩ + · simpa [FourNeighborAdjacent] using hstep₁ + · simpa [FourNeighborAdjacent] using hstep₂ + +private theorem touching_disjoint : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (W : ProtoTile), (U.cells.Nonempty) → + ((V.cells.Nonempty) → ((TouchingTriple U V W) → (Disjoint U.cells V.cells))) ) := by + classical + intro U V W hUne hVne ht + rcases ht with ht | ht | ht + · exact ht.2.2.1 + · rw [ht.1] at hUne + simp at hUne + · rw [ht.1] at hVne + simp at hVne + +private theorem rawIncident : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (U.cells.Nonempty) → ((z ∈ FootprintVertices U) → + (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ U.cells)) ) := by + classical + intro U z hne hz + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hz + rcases hz with ⟨cell, hc, h | h | h | h⟩ + · refine ⟨0, ?_⟩ + simpa [LatticeVertexIncidentCell] using h ▸ hc + · refine ⟨1, ?_⟩ + subst z + simpa [LatticeVertexIncidentCell] using hc + · refine ⟨3, ?_⟩ + subst z + simpa [LatticeVertexIncidentCell] using hc + · refine ⟨2, ?_⟩ + change z - 1 - ⟨0, 1⟩ ∈ U.cells + rw [h] + convert hc using 1; ext <;> simp + +private theorem edgeEndpoint : + (by + classical + exact + ∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges + U) → (∀ (z : GaussianInt), (z ∈ e) → (z ∈ FootprintVertices U))) ) := by + classical + intro U hne e he z hz + rcases he with ⟨cell, hc, hshape | hshape | hshape | hshape⟩ + all_goals rw [hshape] at hz + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hz + all_goals rw [FootprintVertices, ite_eq_left (show U.cells.Nonempty from ⟨cell, hc⟩)] + all_goals refine ⟨cell, hc, ?_⟩ + all_goals rcases hz with hz | hz <;> simp [hz] + +private theorem threeBoundaries : + (by + classical + exact + (∀ (U : ProtoTile), ∀ (z : GaussianInt), (U.cells.Nonempty) → ((z ∈ FootprintVertices U) + → (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ U.cells))) → (∀ (z : GaussianInt), ∀ + (U : ProtoTile), ∀ (V : ProtoTile), ∀ (W : ProtoTile), (LatticeTile U) → + ((LatticeTile V) → ((LatticeTile W) → ((Disjoint U.cells W.cells) → ((Disjoint + V.cells W.cells) → ((z ∈ FootprintVertices U) → ((z ∈ FootprintVertices V) → ((z ∈ + FootprintVertices W) → (z ∈ BoundaryFootprintVertices U ∧ z ∈ + BoundaryFootprintVertices V ∧ z ∈ BoundaryFootprintVertices W))))))))) ) := by + classical + intro rawIncident z U V W hU hV hW hUW hVW hzU hzV hzW + have hUne := (LatticeTileGridStructure U hU).1.1 + have hVne := (LatticeTileGridStructure V hV).1.1 + have hWne := (LatticeTileGridStructure W hW).1.1 + obtain ⟨jU, hjU⟩ := rawIncident U z hUne hzU + obtain ⟨jV, hjV⟩ := rawIncident V z hVne hzV + obtain ⟨jW, hjW⟩ := rawIncident W z hWne hzW + refine ⟨?_, ⟨?_, ?_⟩⟩ + · exact P3161T2IncidentBoundary U z ⟨jU, hjU⟩ + ⟨jW, fun h => Finset.disjoint_left.mp hUW h hjW⟩ + · exact P3161T2IncidentBoundary V z ⟨jV, hjV⟩ + ⟨jW, fun h => Finset.disjoint_left.mp hVW h hjW⟩ + · exact P3161T2IncidentBoundary W z ⟨jW, hjW⟩ + ⟨jU, fun h => Finset.disjoint_left.mp hUW hjU h⟩ + +private theorem threeOwnersContradict : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), (GaussianInt) → (∀ (v : GaussianInt), ∀ (z : GaussianInt), (Nat.card {is : + Fin 3 × Bool // + v ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2) → ((z = v) → ((z ∈ + BoundaryFootprintVertices (cert.P 0 true)) → ((z ∈ BoundaryFootprintVertices + (cert.P 0 false)) → ((z ∈ BoundaryFootprintVertices (cert.P 1 true)) → (False)))))) + ) := by + classical + intro q cfg C T cert x v z hcount hzx hA hB hC + subst z + let S := {is : Fin 3 × Bool // + v ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} + let f : Fin 3 → S := ![ + ⟨(0, true), hA⟩, + ⟨(0, false), hB⟩, + ⟨(1, true), hC⟩] + have hf : Function.Injective f := by + intro i j hij + have hval := congrArg Subtype.val hij + fin_cases i <;> fin_cases j <;> simp [f] at hval ⊢ + have hcard := Fintype.card_le_of_injective f hf + have hk' : Fintype.card S = 2 := by + simpa [S, Nat.card_eq_fintype_card] using hcount + have hcard' : 3 ≤ Fintype.card S := by simpa using hcard + omega + +private theorem threeOwnersAFContradict : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), (GaussianInt) → (∀ (v : GaussianInt), ∀ (z : GaussianInt), (Nat.card {is : + Fin 3 × Bool // + v ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2) → ((z = v) → ((z ∈ + BoundaryFootprintVertices (cert.P 0 true)) → ((z ∈ BoundaryFootprintVertices + (cert.P 1 true)) → ((z ∈ BoundaryFootprintVertices (cert.P 2 false)) → (False)))))) + ) := by + classical + intro q cfg C T cert x v z hcount hzx hA hC hF + subst z + let S := {is : Fin 3 × Bool // + v ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} + let f : Fin 3 → S := ![ + ⟨(0, true), hA⟩, + ⟨(1, true), hC⟩, + ⟨(2, false), hF⟩] + have hf : Function.Injective f := by + intro i j hij + have hval := congrArg Subtype.val hij + fin_cases i <;> fin_cases j <;> simp [f] at hval ⊢ + have hcard := Fintype.card_le_of_injective f hf + have hk' : Fintype.card S = 2 := by + simpa [S, Nat.card_eq_fintype_card] using hcount + have hcard' : 3 ≤ Fintype.card S := by simpa using hcard + omega + +private theorem interfaceConclusion : + (by + classical + exact + ∀ (v : GaussianInt), ∀ (U : ProtoTile), ∀ (V : ProtoTile), (ProtoTile) → ((LatticeTile U) + → ((LatticeTile V) → ((Disjoint U.cells V.cells) → ((∃ e f : Finset GaussianInt, + e ≠ f ∧ v ∈ e ∧ v ∈ f ∧ + e ∈ FootprintEdges U ∩ FootprintEdges V ∧ + f ∈ FootprintEdges U ∩ FootprintEdges V) → ((∀ y, y = v ∨ y = v + 1 ∨ y = v - 1 ∨ y + = v + ⟨0, 1⟩ ∨ y = v - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ FootprintVertices + V) ∧ (∀ z, z = v ∨ z = v - 1 ∨ z = v - ⟨0, 1⟩ ∨ z = v - 1 - ⟨0, 1⟩ → z ∈ + U.cells ∨ z ∈ V.cells)))))) ) := by + classical + intro v U V W hU hV hdis hedges + have sec := (LocalLatticeInterfaceSectors.2 U V v hU hV hdis hedges) + refine ⟨P4590T1OppositeCellsStar U V v sec.2, ?_⟩ + intro z hz + have hzindex : ∃ j : Fin 4, z = LatticeVertexIncidentCell v j := by + rcases hz with hz | hz | hz | hz + · subst z + exact ⟨0, by simp [LatticeVertexIncidentCell]⟩ + · subst z + exact ⟨1, by simp [LatticeVertexIncidentCell]⟩ + · subst z + exact ⟨3, by simp [LatticeVertexIncidentCell]⟩ + · subst z + exact ⟨2, by simp [LatticeVertexIncidentCell]⟩ + obtain ⟨j, rfl⟩ := hzindex + rcases sec.1 j with hUcell | hVcell + · exact Or.inl hUcell + · exact Or.inr hVcell + +private theorem translation_zero : + (by + classical + exact + ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by + classical + intro U + have hzero : GaussianTranslation (0 : GaussianInt) = id := by + funext z + simp [GaussianTranslation] + cases U + simp [TileTranslation, hzero, GaussianTranslation] + +private theorem htileA : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + (∀ (U : ProtoTile), TileTranslation U 0 = U) → (cert.modified.tile a = TileCellComplement + (cert.P 0 true) cert.O) ) := by + classical + intro q cfg C T cert a translation_zero + rw [cert.modified_tile] + simp [a, ModifiedSubtileOccurrenceInterpretation, translation_zero] + +private theorem htileC : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + (∀ (U : ProtoTile), TileTranslation U 0 = U) → (cert.modified.tile c = cert.P 1 true) ) + := by + classical + intro q cfg C T cert c translation_zero + rw [cert.modified_tile] + simp [c, ModifiedSubtileOccurrenceInterpretation, translation_zero] + +private theorem hOA : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), cert.O.cells ⊆ (cert.P 0 true).cells ) := by + classical + intro q cfg C T cert cell hc + apply (cert.plus_union cell).mpr + rw [cert.precursor_eq] at hc + exact ⟨0, false, hc⟩ + +private theorem hOB : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), cert.O.cells ⊆ (cert.P 0 false).cells ) := by + classical + intro q cfg C T cert cell hc + apply (cert.minus_union cell).mpr + rw [cert.precursor_cells] at hc + exact ⟨0, true, hc⟩ + +private theorem hCA : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + (∀ (U : ProtoTile), TileTranslation U 0 = U) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : + PeriodicSubtileIndex), a ≠ b → ¬((a.label = SixSubtileLabel.A ∧ b.label = + SixSubtileLabel.B ∨ a.label = SixSubtileLabel.B ∧ b.label = SixSubtileLabel.A) ∧ + a.first = b.first ∧ a.second = b.second) → Disjoint (SubtileOccurrenceInterpretation + cert.P cert.u cert.v a).cells (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b).cells) → (Disjoint (cert.P 1 true).cells (cert.P 0 true).cells)) ) := by + classical + intro q cfg C T cert translation_zero hsep + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + simpa [c, a, SubtileOccurrenceInterpretation, translation_zero] using + hsep c a (by decide) (by simp [c, a]) + +private theorem hCB : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + (∀ (U : ProtoTile), TileTranslation U 0 = U) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : + PeriodicSubtileIndex), a ≠ b → ¬((a.label = SixSubtileLabel.A ∧ b.label = + SixSubtileLabel.B ∨ a.label = SixSubtileLabel.B ∧ b.label = SixSubtileLabel.A) ∧ + a.first = b.first ∧ a.second = b.second) → Disjoint (SubtileOccurrenceInterpretation + cert.P cert.u cert.v a).cells (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b).cells) → (Disjoint (cert.P 1 true).cells (cert.P 0 false).cells)) ) := by + classical + intro q cfg C T cert translation_zero hsep + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + simpa [c, b, SubtileOccurrenceInterpretation, translation_zero] using + hsep c b (by decide) (by simp [c, b]) + +private theorem hisolated : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), (∀ (U : ProtoTile), TileTranslation U 0 = U) → (∀ z ∈ + CellSupportedFootprintVertices cert.O, ∀ cell : GaussianInt, z ∈ FootprintVertices + (⟨{cell}, cell⟩ : ProtoTile) → cell ∈ (cert.P 0 true).cells ∨ cell ∈ (cert.P 0 + false).cells) ) := by + classical + intro q cfg C T cert translation_zero z hz cell hc + have hzraw : z ∈ FootprintVertices cert.O := by + rcases hz with ⟨a0, ha0, hcorner⟩ + simpa only [FootprintVertices, + ite_eq_left (show cert.O.cells.Nonempty from ⟨a0, ha0⟩), Set.mem_ofPred_eq] using + (show ∃ a0 ∈ cert.O.cells, + z = a0 ∨ z = a0 + 1 ∨ z = a0 + ⟨0, 1⟩ ∨ + z = a0 + 1 + ⟨0, 1⟩ from ⟨a0, ha0, hcorner⟩) + simpa [SubtileOccurrenceInterpretation, translation_zero] using + cert.precursor_isolated 0 0 z + (by simpa [translation_zero] using hzraw) cell hc + +private theorem hf1 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : + cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i + = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = c) → h = f ∨ h = g) + → (f1 = f ∨ f1 = g) ) := by + classical + intro q cfg C T cert a c f1 f g hfaces + apply hfaces + constructor + · exact ⟨0, by simp [f1, a, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + · exact ⟨2, by simp [f1, c, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + +private theorem hf3 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : + cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i + = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = c) → h = f ∨ h = g) + → (f3 = f ∨ f3 = g) ) := by + classical + intro q cfg C T cert a c f3 f g hfaces + apply hfaces + constructor + · exact ⟨0, by simp [f3, a, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + · exact ⟨1, by simp [f3, c, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + +private theorem hf13 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + f1 ≠ f3 ) := by + classical + intro q cfg C T cert f1 f3 h + have hh := congrArg cert.modified_face_equiv h + simp [f1, f3] at hh + +private theorem hpair : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (f1 = f ∨ f1 = g) → + ((f3 = f ∨ f3 = g) → ((f1 ≠ f3) → ((f1 = f ∧ f3 = g) ∨ (f1 = g ∧ f3 = f)))) ) := by + classical + intro q cfg C T cert f1 f3 f g hf1 hf3 hf13 + rcases hf1 with h1 | h1 <;> rcases hf3 with h3 | h3 + · exact False.elim (hf13 (h1.trans h3.symm)) + · exact Or.inl ⟨h1, h3⟩ + · exact Or.inr ⟨h1, h3⟩ + · exact False.elim (hf13 (h1.trans h3.symm)) + +private theorem hend : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), + (SimpleGridPathBetween (CommonFootprintEdgeVertices (cert.modified.tile a) + (cert.modified.tile c)) (FootprintEdges (cert.modified.tile a) ∩ FootprintEdges + (cert.modified.tile c)) (cert.modified.rho f) (cert.modified.rho g)) → + (cert.modified.rho f ≠ cert.modified.rho g) ) := by + classical + intro q cfg C T cert a c f g hpath heq + rcases hpath with ⟨p, hnd, hlen, hh, ht, _, _, _⟩ + have hpne : p ≠ [] := by + intro hp + simp [hp] at hlen + have hh' : p.head hpne = cert.modified.rho f := by + simpa [List.head?_eq_some_head hpne] using hh + have ht' : p.getLast hpne = cert.modified.rho g := by + simpa [List.getLast?_eq_some_getLast hpne] using ht + obtain ⟨z, hz⟩ := (List.Nodup.head_eq_getLast_iff hpne hnd).mp + (hh'.trans (heq.trans ht'.symm)) + simp [hz] at hlen + +private theorem hz13 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), ((f1 = f ∧ f3 = g) ∨ + (f1 = g ∧ f3 = f)) → ((cert.modified.rho f1 = cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) → ((cert.modified.rho f3 = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩)) → + ((cert.modified.rho f ≠ cert.modified.rho g) → (cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) ≠ cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩))))) ) := by + classical + intro q cfg C T cert f1 f3 f g hpair hrho1 hrho3 hend + rw [← hrho1, ← hrho3] + rcases hpair with ⟨h1, h3⟩ | ⟨h1, h3⟩ + · simpa [h1, h3] using hend + · simpa [h1, h3] using hend.symm + +private theorem hcomplete : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + (cert.modified.tile a = TileCellComplement (cert.P 0 true) cert.O) → ((cert.modified.tile + c = cert.P 1 true) → ((FootprintVertices (cert.modified.tile a) ∩ FootprintVertices + (cert.modified.tile c) = CommonFootprintEdgeVertices (cert.modified.tile a) + (cert.modified.tile c)) → (∀ (f : cert.modified.plane.Face), ∀ (g : + cert.modified.plane.Face), (SimpleGridPathBetween (CommonFootprintEdgeVertices + (cert.modified.tile a) (cert.modified.tile c)) (FootprintEdges (cert.modified.tile a) + ∩ FootprintEdges (cert.modified.tile c)) (cert.modified.rho f) (cert.modified.rho g)) + → (((f1 = f ∧ f3 = g) ∨ (f1 = g ∧ f3 = f)) → ((cert.modified.rho f1 = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) → + ((cert.modified.rho f3 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm + ⟨.I3, 0, 0⟩)) → (SimpleGridPathBetween (FootprintVertices (TileCellComplement (cert.P + 0 true) cert.O) ∩ FootprintVertices (cert.P 1 true)) (FootprintEdges + (TileCellComplement (cert.P 0 true) cert.O) ∩ FootprintEdges (cert.P 1 true)) + (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) + (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩)) ∨ + SimpleGridPathBetween (FootprintVertices (TileCellComplement (cert.P 0 true) cert.O) + ∩ FootprintVertices (cert.P 1 true)) (FootprintEdges (TileCellComplement (cert.P 0 + true) cert.O) ∩ FootprintEdges (cert.P 1 true)) (cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩)) (cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩))))))))) ) := by + classical + intro q cfg C T cert a c f1 f3 htileA htileC hraw f g hpath hpair hrho1 hrho3 + rw [← hraw, htileA, htileC] at hpath + rcases hpair with ⟨h1, h3⟩ | ⟨h1, h3⟩ + · left + simpa [← h1, ← h3, hrho1, hrho3] using hpath + · right + simpa [← h3, ← h1, hrho1, hrho3] using hpath + +private theorem hcompleteOriginal : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), (FootprintEdges (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintEdges (cert.P 1 true) = FootprintEdges (cert.P 0 true) ∩ FootprintEdges + (cert.P 1 true)) → ((FootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintVertices (cert.P 1 true) = FootprintVertices (cert.P 0 true) ∩ + FootprintVertices (cert.P 1 true)) → ((SimpleGridPathBetween (FootprintVertices + (TileCellComplement (cert.P 0 true) cert.O) ∩ FootprintVertices (cert.P 1 true)) + (FootprintEdges (TileCellComplement (cert.P 0 true) cert.O) ∩ FootprintEdges (cert.P + 1 true)) (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) + (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩)) ∨ + SimpleGridPathBetween (FootprintVertices (TileCellComplement (cert.P 0 true) cert.O) + ∩ FootprintVertices (cert.P 1 true)) (FootprintEdges (TileCellComplement (cert.P 0 + true) cert.O) ∩ FootprintEdges (cert.P 1 true)) (cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩)) (cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩))) → (SimpleGridPathBetween + (FootprintVertices (cert.P 0 true) ∩ FootprintVertices (cert.P 1 true)) + (FootprintEdges (cert.P 0 true) ∩ FootprintEdges (cert.P 1 true)) + (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) + (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩)) ∨ + SimpleGridPathBetween (FootprintVertices (cert.P 0 true) ∩ FootprintVertices (cert.P + 1 true)) (FootprintEdges (cert.P 0 true) ∩ FootprintEdges (cert.P 1 true)) + (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩)) + (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩))))) ) := by + classical + intro q cfg C T cert hretainEdges hretainVertices hcomplete + rcases hcomplete with h | h + · exact Or.inl (by simpa [hretainVertices, hretainEdges] using h) + · exact Or.inr (by simpa [hretainVertices, hretainEdges] using h) + +private theorem htileB : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), (∀ (U : ProtoTile), TileTranslation U 0 = U) → ( + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + cert.modified.tile b = cert.P 0 false) ) := by + classical + intro q cfg C T cert translation_zero b + rw [cert.modified_tile] + simp [b, ModifiedSubtileOccurrenceInterpretation, translation_zero] + +private theorem htileF : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), (∀ (U : ProtoTile), TileTranslation U 0 = U) → ( + let fidx : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + cert.modified.tile fidx = cert.P 2 false) ) := by + classical + intro q cfg C T cert translation_zero fidx + rw [cert.modified_tile] + simp [fidx, ModifiedSubtileOccurrenceInterpretation, translation_zero] + +private theorem hz1Amod : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + (cert.modified.tile a = TileCellComplement (cert.P 0 true) cert.O) → ((cert.modified.rho + f1 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) → + ((cert.modified.plane.faceVertex f1 0 = a) → ( + let z1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + z1 ∈ FootprintVertices (TileCellComplement (cert.P 0 true) cert.O)))) ) := by + classical + intro q cfg C T cert a f1 htileA hrho1 hfa10 z1 + have hh := cert.modified.rho_common f1 0 + rw [hfa10, htileA, hrho1] at hh + simpa [z1] using hh + +private theorem hz1B : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + (cert.modified.rho f1 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, + 0⟩)) → ( + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + (cert.modified.tile b = cert.P 0 false) → ((cert.modified.plane.faceVertex f1 1 = b) → ( + let z1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + z1 ∈ FootprintVertices (cert.P 0 false)))) ) := by + classical + intro q cfg C T cert f1 hrho1 b htileB hfa11 z1 + have hh := cert.modified.rho_common f1 1 + rw [hfa11, htileB, hrho1] at hh + simpa [z1] using hh + +private theorem hz1C : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + (cert.modified.tile c = cert.P 1 true) → ((cert.modified.rho f1 = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) → + ((cert.modified.plane.faceVertex f1 2 = c) → ( + let z1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + z1 ∈ FootprintVertices (cert.P 1 true)))) ) := by + classical + intro q cfg C T cert c f1 htileC hrho1 hfa12 z1 + have hh := cert.modified.rho_common f1 2 + rw [hfa12, htileC, hrho1] at hh + simpa [z1] using hh + +private theorem hz1AC : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), (FootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintVertices (cert.P 1 true) = FootprintVertices (cert.P 0 true) ∩ + FootprintVertices (cert.P 1 true)) → ( + let z1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + (z1 ∈ FootprintVertices (TileCellComplement (cert.P 0 true) cert.O)) → ((z1 ∈ + FootprintVertices (cert.P 1 true)) → (z1 ∈ FootprintVertices (cert.P 0 true) ∩ + FootprintVertices (cert.P 1 true)))) ) := by + classical + intro q cfg C T cert hretainVertices z1 hz1Amod hz1C + rw [← hretainVertices] + exact ⟨hz1Amod, hz1C⟩ + +private theorem hz3Amod : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + (cert.modified.tile a = TileCellComplement (cert.P 0 true) cert.O) → ((cert.modified.rho + f3 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩)) → + ((cert.modified.plane.faceVertex f3 0 = a) → ( + let z3 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + z3 ∈ FootprintVertices (TileCellComplement (cert.P 0 true) cert.O)))) ) := by + classical + intro q cfg C T cert a f3 htileA hrho3 hfa30 z3 + have hh := cert.modified.rho_common f3 0 + rw [hfa30, htileA, hrho3] at hh + simpa [z3] using hh + +private theorem hz3C : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + (cert.modified.tile c = cert.P 1 true) → ((cert.modified.rho f3 = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩)) → + ((cert.modified.plane.faceVertex f3 1 = c) → ( + let z3 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + z3 ∈ FootprintVertices (cert.P 1 true)))) ) := by + classical + intro q cfg C T cert c f3 htileC hrho3 hfa31 z3 + have hh := cert.modified.rho_common f3 1 + rw [hfa31, htileC, hrho3] at hh + simpa [z3] using hh + +private theorem hz3F : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + (cert.modified.rho f3 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, + 0⟩)) → ( + let fidx : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + (cert.modified.tile fidx = cert.P 2 false) → ((cert.modified.plane.faceVertex f3 2 = + fidx) → ( + let z3 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + z3 ∈ FootprintVertices (cert.P 2 false)))) ) := by + classical + intro q cfg C T cert f3 hrho3 fidx htileF hfa32 z3 + have hh := cert.modified.rho_common f3 2 + rw [hfa32, htileF, hrho3] at hh + simpa [z3] using hh + +private theorem hz3AC : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), (FootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintVertices (cert.P 1 true) = FootprintVertices (cert.P 0 true) ∩ + FootprintVertices (cert.P 1 true)) → ( + let z3 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + (z3 ∈ FootprintVertices (TileCellComplement (cert.P 0 true) cert.O)) → ((z3 ∈ + FootprintVertices (cert.P 1 true)) → (z3 ∈ FootprintVertices (cert.P 0 true) ∩ + FootprintVertices (cert.P 1 true)))) ) := by + classical + intro q cfg C T cert hretainVertices z3 hz3Amod hz3C + rw [← hretainVertices] + exact ⟨hz3Amod, hz3C⟩ + +private theorem hACdis : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + (∀ (U : ProtoTile), TileTranslation U 0 = U) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : + PeriodicSubtileIndex), a ≠ b → ¬((a.label = SixSubtileLabel.A ∧ b.label = + SixSubtileLabel.B ∨ a.label = SixSubtileLabel.B ∧ b.label = SixSubtileLabel.A) ∧ + a.first = b.first ∧ a.second = b.second) → Disjoint (SubtileOccurrenceInterpretation + cert.P cert.u cert.v a).cells (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b).cells) → (Disjoint (cert.P 0 true).cells (cert.P 1 true).cells)) ) := by + classical + intro q cfg C T cert translation_zero hsep + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + simpa [a, c, SubtileOccurrenceInterpretation, translation_zero] using + hsep a c (by decide) (by simp [a, c]) + +private theorem hBCdis : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + (∀ (U : ProtoTile), TileTranslation U 0 = U) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : + PeriodicSubtileIndex), a ≠ b → ¬((a.label = SixSubtileLabel.A ∧ b.label = + SixSubtileLabel.B ∨ a.label = SixSubtileLabel.B ∧ b.label = SixSubtileLabel.A) ∧ + a.first = b.first ∧ a.second = b.second) → Disjoint (SubtileOccurrenceInterpretation + cert.P cert.u cert.v a).cells (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b).cells) → ( + Disjoint (cert.P 0 false).cells (cert.P 1 true).cells)) ) := by + classical + intro q cfg C T cert translation_zero hsep + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + simpa [b, c, SubtileOccurrenceInterpretation, translation_zero] using + hsep b c (by decide) (by simp [b, c]) + +private theorem hAFdis : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + (∀ (U : ProtoTile), TileTranslation U 0 = U) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : + PeriodicSubtileIndex), a ≠ b → ¬((a.label = SixSubtileLabel.A ∧ b.label = + SixSubtileLabel.B ∨ a.label = SixSubtileLabel.B ∧ b.label = SixSubtileLabel.A) ∧ + a.first = b.first ∧ a.second = b.second) → Disjoint (SubtileOccurrenceInterpretation + cert.P cert.u cert.v a).cells (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b).cells) → ( + Disjoint (cert.P 0 true).cells (cert.P 2 false).cells)) ) := by + classical + intro q cfg C T cert translation_zero hsep + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let fidx : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + simpa [a, fidx, SubtileOccurrenceInterpretation, translation_zero] using + hsep a fidx (by decide) (by simp [a, fidx]) + +private theorem hCFdis : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + (∀ (U : ProtoTile), TileTranslation U 0 = U) → ((∀ (a : PeriodicSubtileIndex), ∀ (b : + PeriodicSubtileIndex), a ≠ b → ¬((a.label = SixSubtileLabel.A ∧ b.label = + SixSubtileLabel.B ∨ a.label = SixSubtileLabel.B ∧ b.label = SixSubtileLabel.A) ∧ + a.first = b.first ∧ a.second = b.second) → Disjoint (SubtileOccurrenceInterpretation + cert.P cert.u cert.v a).cells (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b).cells) → ( + Disjoint (cert.P 1 true).cells (cert.P 2 false).cells)) ) := by + classical + intro q cfg C T cert translation_zero hsep + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let fidx : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + simpa [c, fidx, SubtileOccurrenceInterpretation, translation_zero] using + hsep c fidx (by decide) (by simp [c, fidx]) + +private theorem hz1ne : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), (Nat.card + { is : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 + : ℕ)) → ((∀ (v : GaussianInt), ∀ (z : GaussianInt), (Nat.card + {is : Fin 3 × Bool // v ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2) → ((z = + v) → ((z ∈ BoundaryFootprintVertices (cert.P 0 true)) → ((z ∈ + BoundaryFootprintVertices (cert.P 0 false)) → ((z ∈ BoundaryFootprintVertices (cert.P + 1 true)) → (False)))))) → ( + let z1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + (z1 ∈ BoundaryFootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) ∧ z1 ∈ + BoundaryFootprintVertices (cert.P (0 : Fin (3 : ℕ)) false) ∧ z1 ∈ + BoundaryFootprintVertices (cert.P (1 : Fin (3 : ℕ)) true)) → (z1 ≠ x))) ) := by + classical + intro q cfg C T cert x hk threeOwnersContradict z1 hz1boundary heq + exact threeOwnersContradict x z1 hk heq hz1boundary.1 hz1boundary.2.1 + hz1boundary.2.2 + +private theorem hz3ne : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), (Nat.card + { is : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 + : ℕ)) → ((∀ (v : GaussianInt), ∀ (z : GaussianInt), (Nat.card + {is : Fin 3 × Bool // v ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2) → ((z = + v) → ((z ∈ BoundaryFootprintVertices (cert.P 0 true)) → ((z ∈ + BoundaryFootprintVertices (cert.P 1 true)) → ((z ∈ BoundaryFootprintVertices (cert.P + 2 false)) → (False)))))) → ( + let z3 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + (z3 ∈ BoundaryFootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) ∧ z3 ∈ + BoundaryFootprintVertices (cert.P (1 : Fin (3 : ℕ)) true) ∧ z3 ∈ + BoundaryFootprintVertices (cert.P (2 : Fin (3 : ℕ)) false)) → (z3 ≠ x))) ) := by + classical + intro q cfg C T cert x hk threeOwnersAFContradict z3 hz3boundary heq + exact threeOwnersAFContradict x z3 hk heq hz3boundary.1 hz3boundary.2.1 + hz3boundary.2.2 + +private theorem hpathEndpoints : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), (∀ (v : GaussianInt), ∀ (V : Set GaussianInt), ∀ (E : + Set (Finset GaussianInt)), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + (SimpleGridPathBetween V E a b) → ((v ∈ V) → ((v ≠ a) → ((v ≠ b) → (∃ y z : + GaussianInt, ∃ e f : Finset GaussianInt, e ≠ f ∧ v ∈ e ∧ v ∈ f ∧ e ∈ E ∧ f ∈ E ∧ e = + {y, v} ∧ f = {v, z} ∧ FourNeighborAdjacent y v ∧ FourNeighborAdjacent v z))))) → ((x + ∈ FootprintVertices (cert.P (0 : Fin (3 : ℕ)) true)) → ((x ∈ FootprintVertices + (cert.P (1 : Fin (3 : ℕ)) true)) → ((SimpleGridPathBetween (FootprintVertices (cert.P + 0 true) ∩ FootprintVertices (cert.P 1 true)) (FootprintEdges (cert.P 0 true) ∩ + FootprintEdges (cert.P 1 true)) (cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) (cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩)) ∨ SimpleGridPathBetween + (FootprintVertices (cert.P 0 true) ∩ FootprintVertices (cert.P 1 true)) + (FootprintEdges (cert.P 0 true) ∩ FootprintEdges (cert.P 1 true)) + (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩)) + (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩))) → ( + let z1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let z3 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + (z1 ≠ x) → ((z3 ≠ x) → (∃ y z : GaussianInt, ∃ e f : Finset GaussianInt, e ≠ f ∧ x ∈ e ∧ + x ∈ f ∧ e ∈ FootprintEdges (cert.P 0 true) ∩ FootprintEdges (cert.P 1 true) ∧ f ∈ + FootprintEdges (cert.P 0 true) ∩ FootprintEdges (cert.P 1 true) ∧ e = {y, x} ∧ f = + {x, z} ∧ FourNeighborAdjacent y x ∧ FourNeighborAdjacent x z)))))) ) := by + classical + intro q cfg C T cert x twoPathEdges hA hC hcompleteOriginal z1 z3 hz1ne hz3ne + rcases hcompleteOriginal with hp | hp + · exact twoPathEdges x _ _ z1 z3 hp ⟨hA, hC⟩ hz1ne.symm hz3ne.symm + · exact twoPathEdges x _ _ z3 z1 hp ⟨hA, hC⟩ hz3ne.symm hz1ne.symm + +private theorem hprepos : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), 0 < + (cfg.firstPredecessor 2).1 ) := by + classical + intro q cfg + rw [cfg.firstParentTwo] + have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 (1 : Fin 3) + have hnonneg : 0 ≤ (q 2).1 := by simpa using hn + exact lt_of_le_of_ne hnonneg (Ne.symm (cfg.noLine 2)) + +private theorem hprotoC : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (hprepos : 0 < (cfg.firstPredecessor 2).1), + let C2 : BandCircle := ⟨⟨cfg.firstPredecessor 2, + ⟨Or.inl hprepos, cfg.firstPredecessor, cfg.firstProper.1, 2, rfl⟩⟩, hprepos⟩ + BandPrototile C2.1.1 (cert.P 1 true) ) := by + classical + intro q cfg C T cert hprepos C2 + change BandPrototile (cfg.firstPredecessor 2) (cert.P 1 true) + rw [cfg.firstParentTwo] + exact (cert.outer_occurrence 1 true).1 + +private theorem hEdgesQC : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), (∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ (e : + Finset GaussianInt), (e ∈ FootprintEdges U) → (∀ (z : GaussianInt), (z ∈ e) → (z ∈ + FootprintVertices U)))) → ((FootprintVertices (cert.P 0 true) ∩ FootprintVertices + (cert.P 1 true) ⊆ FootprintVertices (cert.Q 1 true) ∩ FootprintVertices (cert.P 1 + true)) → (((cert.P 1 true).cells.Nonempty) → ((∃ y z : GaussianInt, ∃ e f : Finset + GaussianInt, e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ e ∈ FootprintEdges (cert.P 0 true) ∩ + FootprintEdges (cert.P 1 true) ∧ f ∈ FootprintEdges (cert.P 0 true) ∩ FootprintEdges + (cert.P 1 true) ∧ e = {y, x} ∧ f = {x, z} ∧ FourNeighborAdjacent y x ∧ + FourNeighborAdjacent x z) → ((∀ x ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) + true), ∀ y ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true), FourNeighborAdjacent + x y → {x, y} ∈ FootprintEdges (cert.Q (1 : Fin (3 : ℕ)) true)) → ((∀ x ∈ + FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true), ∀ y ∈ FootprintVertices (cert.P (1 + : Fin (3 : ℕ)) true), FourNeighborAdjacent x y → {x, y} ∈ FootprintEdges (cert.P (1 : + Fin (3 : ℕ)) true)) → (∃ e f : Finset GaussianInt, e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ e ∈ + FootprintEdges (cert.Q 1 true) ∩ FootprintEdges (cert.P 1 true) ∧ f ∈ FootprintEdges + (cert.Q 1 true) ∩ FootprintEdges (cert.P 1 true))))))) ) := by + classical + intro q cfg C T cert x edgeEndpoint raw_support hCne hpathEndpoints regQ regC + obtain ⟨y, z, e, f, hef, hxe, hxf, he, hf, rfl, rfl, hyx, hxz⟩ := + hpathEndpoints + have hyA := edgeEndpoint (cert.P 0 true) + (LatticeTileGridStructure _ (cert.parent_lattice 0 true)).1.1 + {y, x} he.1 y (by simp) + have hxA := edgeEndpoint (cert.P 0 true) + (LatticeTileGridStructure _ (cert.parent_lattice 0 true)).1.1 + {y, x} he.1 x (by simp) + have hyC := edgeEndpoint (cert.P 1 true) hCne {y, x} he.2 y (by simp) + have hxC := edgeEndpoint (cert.P 1 true) hCne {y, x} he.2 x (by simp) + have hxA' := edgeEndpoint (cert.P 0 true) + (LatticeTileGridStructure _ (cert.parent_lattice 0 true)).1.1 + {x, z} hf.1 x (by simp) + have hzA := edgeEndpoint (cert.P 0 true) + (LatticeTileGridStructure _ (cert.parent_lattice 0 true)).1.1 + {x, z} hf.1 z (by simp) + have hxC' := edgeEndpoint (cert.P 1 true) hCne {x, z} hf.2 x (by simp) + have hzC := edgeEndpoint (cert.P 1 true) hCne {x, z} hf.2 z (by simp) + have hyQ := (raw_support ⟨hyA, hyC⟩).1 + have hxQ := (raw_support ⟨hxA, hxC⟩).1 + have hzQ := (raw_support ⟨hzA, hzC⟩).1 + refine ⟨{y, x}, {x, z}, hef, by simp, by simp, ?_, ?_⟩ + · exact ⟨regQ y hyQ x hxQ hyx, regC y hyC x hxC hyx⟩ + · exact ⟨regQ x hxQ z hzQ hxz, regC x hxC' z hzC hxz⟩ + +private theorem hFinj : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let F : GaussianInt → GaussianInt := fun z => t - z + (∀ (z : GaussianInt), F (F z) = z) → (Function.Injective F) ) := by + classical + intro q u w t F hFinvol a b hab + have := congrArg F hab + simpa [hFinvol] using this + +private theorem image_mem : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let F : GaussianInt → GaussianInt := fun z => t - z + (Function.Injective F) → (∀ (A : Set GaussianInt), ∀ (B : Set GaussianInt), (F '' A = B) + → (∀ (z : GaussianInt), z ∈ A ↔ F z ∈ B)) ) := by + classical + intro q u w t F hFinj A B hAB z + rw [← hAB] + constructor + · intro hz + exact ⟨z, hz, rfl⟩ + · rintro ⟨y, hy, hEq⟩ + have : y = z := hFinj hEq + simpa [this] using hy + +private theorem parentFootprint : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + (∀ (U : ProtoTile), FootprintVertices (H U) = (fun z : GaussianInt => t - z) '' + FootprintVertices U) → ((∀ (i : Fin 3), FootprintVertices (H (cert.P i true)) = + FootprintVertices (cert.P i false)) → ( + let F : GaussianInt → GaussianInt := fun z => t - z + ∀ (i : Fin 3), F '' FootprintVertices (cert.P i true) = FootprintVertices (cert.P i + false))) ) := by + classical + intro q cfg C T cert u w t H halfTurnFootprint outerFootprint F i + calc + _ = FootprintVertices (H (cert.P i true)) := + (halfTurnFootprint (cert.P i true)).symm + _ = _ := outerFootprint i + +private theorem parentBoundary : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + (∀ (U : ProtoTile), (U.cells.Nonempty) → (BoundaryFootprintVertices (H U) = (fun z : + GaussianInt => t - z) '' BoundaryFootprintVertices U)) → ((∀ (i : Fin 3), ∀ (s : + Bool), (cert.P i s).cells.Nonempty) → ((∀ (i : Fin 3), BoundaryFootprintVertices (H + (cert.P i true)) = BoundaryFootprintVertices (cert.P i false)) → ( + let F : GaussianInt → GaussianInt := fun z => t - z + ∀ (i : Fin 3), F '' BoundaryFootprintVertices (cert.P i true) = BoundaryFootprintVertices + (cert.P i false)))) ) := by + classical + intro q cfg C T cert u w t H halfTurnBoundary outerNonempty outerBoundary F i + calc + _ = BoundaryFootprintVertices (H (cert.P i true)) := + (halfTurnBoundary (cert.P i true) (outerNonempty i true)).symm + _ = _ := outerBoundary i + +private theorem parentBoundaryReverse : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let F : GaussianInt → GaussianInt := fun z => t - z + (∀ (z : GaussianInt), F (F z) = z) → ((∀ (i : Fin 3), F '' BoundaryFootprintVertices + (cert.P i true) = BoundaryFootprintVertices (cert.P i false)) → (∀ (i : Fin 3), F '' + BoundaryFootprintVertices (cert.P i false) = BoundaryFootprintVertices (cert.P i + true))) ) := by + classical + intro q cfg C T cert u w t F hFinvol parentBoundary i + calc + _ = F '' (F '' BoundaryFootprintVertices (cert.P i true)) := by + rw [parentBoundary] + _ = _ := by + rw [Set.image_image] + ext z + simp [hFinvol] + +private theorem hboundaryFlip : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let F : GaussianInt → GaussianInt := fun z => t - z + let v : GaussianInt := F x + (∀ (z : GaussianInt), F (F z) = z) → ((∀ (A : Set GaussianInt), ∀ (B : Set GaussianInt), + (F '' A = B) → (∀ (z : GaussianInt), z ∈ A ↔ F z ∈ B)) → ((∀ (i : Fin 3), F '' + BoundaryFootprintVertices (cert.P i true) = BoundaryFootprintVertices (cert.P i + false)) → ((∀ (i : Fin 3), F '' BoundaryFootprintVertices (cert.P i false) = + BoundaryFootprintVertices (cert.P i true)) → (∀ (i : Fin 3), ∀ (s : Bool), v ∈ + BoundaryFootprintVertices (cert.P i s) ↔ x ∈ BoundaryFootprintVertices (cert.P i + (!s)))))) ) := by + classical + intro q cfg C T cert x u w t F v hFinvol image_mem parentBoundary parentBoundaryReverse i s + cases s + · have h := image_mem _ _ (parentBoundaryReverse i) v + simpa [v, hFinvol] using h + · have h := image_mem _ _ (parentBoundary i) v + simpa [v, hFinvol] using h + +private theorem hvk : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), (Nat.card + { is : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 + : ℕ)) → (∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let F : GaussianInt → GaussianInt := fun z => t - z + let v : GaussianInt := F x + (∀ (i : Fin 3), ∀ (s : Bool), v ∈ BoundaryFootprintVertices (cert.P i + s) ↔ x ∈ BoundaryFootprintVertices (cert.P i (!s))) → ( + let A := {is : Fin 3 × Bool // + v ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} + Nat.card A = 2))) := by + classical + intro q cfg C T cert x hk u w t F v hboundaryFlip A + let B := {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} + let e : A ≃ B := + { toFun := fun a => ⟨(a.val.1, !a.val.2), hboundaryFlip a.val.1 a.val.2 |>.mp a.property⟩ + invFun := fun b => ⟨(b.val.1, !b.val.2), by + have hb : x ∈ BoundaryFootprintVertices + (cert.P b.val.1 (!(!b.val.2))) := by simpa using b.property + exact (hboundaryFlip b.val.1 (!b.val.2)).mpr hb⟩ + left_inv := by intro a; apply Subtype.ext; simp + right_inv := by intro b; apply Subtype.ext; simp } + calc + Nat.card A = Nat.card B := Nat.card_congr e + _ = 2 := hk + +private theorem hcentQS : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), (TileCentroid (cert.P (0 : Fin (3 : ℕ)) true) - TileCentroid T = (1 : ℝ) • + (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin ((1 + : ℕ) + (2 : ℕ) + (1 : ℕ))))) - (-(GaussianRealPoint (BandVectors.1 (q (3 : Fin (4 : + ℕ))) (q (2 : Fin ((1 : ℕ) + (2 : ℕ) + (1 : ℕ)))))).2, (GaussianRealPoint + (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin ((1 : ℕ) + (2 : ℕ) + (1 : + ℕ)))))).1))) → ((TileCentroid (cert.P (0 : Fin (3 : ℕ)) false) - TileCentroid T = (-1 + : ℝ) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : + Fin ((1 : ℕ) + (2 : ℕ) + (1 : ℕ))))) - (-(GaussianRealPoint (BandVectors.1 (q (3 : + Fin (4 : ℕ))) (q (2 : Fin ((1 : ℕ) + (2 : ℕ) + (1 : ℕ)))))).2, (GaussianRealPoint + (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin ((1 : ℕ) + (2 : ℕ) + (1 : + ℕ)))))).1))) → ((TileCentroid (cert.Q (1 : Fin (3 : ℕ)) true) - TileCentroid (cert.P + (0 : Fin (3 : ℕ)) true) = (1 : ℝ) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor (1 : Fin ((2 : ℕ) + (1 : ℕ) + (1 : ℕ)))) (cfg.firstPredecessor + (3 : Fin (4 : ℕ)))) - (-(GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor (1 : + Fin ((2 : ℕ) + (1 : ℕ) + (1 : ℕ)))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))))).2, + (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor (1 : Fin ((2 : ℕ) + (1 : ℕ) + + (1 : ℕ)))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))))).1))) → ((TileCentroid (cert.S + (1 : Fin (3 : ℕ)) false) - TileCentroid (cert.P (0 : Fin (3 : ℕ)) false) = (-1 : ℝ) • + (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor (1 : Fin ((2 : + ℕ) + (1 : ℕ) + (1 : ℕ)))) (cfg.firstPredecessor (3 : Fin (4 : ℕ)))) - + (-(GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor (1 : Fin ((2 : ℕ) + (1 : ℕ) + + (1 : ℕ)))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))))).2, (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor (1 : Fin ((2 : ℕ) + (1 : ℕ) + (1 : ℕ)))) + (cfg.firstPredecessor (3 : Fin (4 : ℕ))))).1))) → (TileCentroid (cert.Q 1 true) + + TileCentroid (cert.S 1 false) = (2 : Real) • TileCentroid T)))) ) := by + classical + intro q cfg C T cert houterPlus houterMinus hchildPlus hchildMinus + apply Prod.ext + · have h1 := congrArg Prod.fst houterPlus + have h2 := congrArg Prod.fst houterMinus + have h3 := congrArg Prod.fst hchildPlus + have h4 := congrArg Prod.fst hchildMinus + dsimp at h1 h2 h3 h4 ⊢ + linarith + · have h1 := congrArg Prod.snd houterPlus + have h2 := congrArg Prod.snd houterMinus + have h3 := congrArg Prod.snd hchildPlus + have h4 := congrArg Prod.snd hchildMinus + dsimp at h1 h2 h3 h4 ⊢ + linarith + +private theorem hquarterOffset : + (by + classical + exact + ∀ (w : GaussianInt), GaussianRealPoint (GaussianQuarterTurn w - w) = (-(GaussianRealPoint + w).1 - (GaussianRealPoint w).2, (GaussianRealPoint w).1 - (GaussianRealPoint w).2) ) + := by + classical + intro w + apply Prod.ext <;> simp [GaussianRealPoint, GaussianQuarterTurn]; ring + +private theorem hdeltaRaw : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let wo := BandVectors.1 (q 3) (q 2) + let wc := BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) + let delta : GaussianInt := + (GaussianQuarterTurn wo - wo) + (GaussianQuarterTurn wc - wc) + GaussianRealPoint delta = GaussianRealPoint (GaussianQuarterTurn wo - wo) + + GaussianRealPoint (GaussianQuarterTurn wc - wc) ) := by + classical + intro q cfg wo wc delta + apply Prod.ext <;> simp [delta, GaussianRealPoint, GaussianQuarterTurn] + +private theorem hdelta : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let wo := BandVectors.1 (q 3) (q 2) + let wc := BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) + let delta : GaussianInt := + (GaussianQuarterTurn wo - wo) + (GaussianQuarterTurn wc - wc) + (TileCentroid (cert.P (0 : Fin (3 : ℕ)) true) - TileCentroid T = (1 : ℝ) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin ((1 : ℕ) + (2 : + ℕ) + (1 : ℕ))))) - (-(GaussianRealPoint (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : + Fin ((1 : ℕ) + (2 : ℕ) + (1 : ℕ)))))).2, (GaussianRealPoint (BandVectors.1 (q (3 : + Fin (4 : ℕ))) (q (2 : Fin ((1 : ℕ) + (2 : ℕ) + (1 : ℕ)))))).1))) → ((TileCentroid + (cert.P (0 : Fin (3 : ℕ)) false) - TileCentroid T = (-1 : ℝ) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin ((1 : ℕ) + (2 : + ℕ) + (1 : ℕ))))) - (-(GaussianRealPoint (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : + Fin ((1 : ℕ) + (2 : ℕ) + (1 : ℕ)))))).2, (GaussianRealPoint (BandVectors.1 (q (3 : + Fin (4 : ℕ))) (q (2 : Fin ((1 : ℕ) + (2 : ℕ) + (1 : ℕ)))))).1))) → ((TileCentroid + (cert.Q (1 : Fin (3 : ℕ)) true) - TileCentroid (cert.P (0 : Fin (3 : ℕ)) true) = (1 : + ℝ) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor (1 : Fin + ((2 : ℕ) + (1 : ℕ) + (1 : ℕ)))) (cfg.firstPredecessor (3 : Fin (4 : ℕ)))) - + (-(GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor (1 : Fin ((2 : ℕ) + (1 : ℕ) + + (1 : ℕ)))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))))).2, (GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor (1 : Fin ((2 : ℕ) + (1 : ℕ) + (1 : ℕ)))) + (cfg.firstPredecessor (3 : Fin (4 : ℕ))))).1))) → ((TileCentroid (cert.S (1 : Fin (3 + : ℕ)) false) - TileCentroid (cert.P (0 : Fin (3 : ℕ)) false) = (-1 : ℝ) • (1 / 2 : ℝ) + • (GaussianRealPoint (BandVectors.1 (cfg.firstPredecessor (1 : Fin ((2 : ℕ) + (1 : ℕ) + + (1 : ℕ)))) (cfg.firstPredecessor (3 : Fin (4 : ℕ)))) - (-(GaussianRealPoint + (BandVectors.1 (cfg.firstPredecessor (1 : Fin ((2 : ℕ) + (1 : ℕ) + (1 : ℕ)))) + (cfg.firstPredecessor (3 : Fin (4 : ℕ))))).2, (GaussianRealPoint (BandVectors.1 + (cfg.firstPredecessor (1 : Fin ((2 : ℕ) + (1 : ℕ) + (1 : ℕ)))) (cfg.firstPredecessor + (3 : Fin (4 : ℕ))))).1))) → ((∀ (w : GaussianInt), GaussianRealPoint + (GaussianQuarterTurn w - w) = (-(GaussianRealPoint w).1 - (GaussianRealPoint w).2, + (GaussianRealPoint w).1 - (GaussianRealPoint w).2)) → ((GaussianRealPoint delta = + GaussianRealPoint (GaussianQuarterTurn wo - wo) + GaussianRealPoint + (GaussianQuarterTurn wc - wc)) → (GaussianRealPoint delta = TileCentroid (cert.S 1 + false) - TileCentroid (cert.Q 1 true))))))) ) := by + classical + intro q cfg C T cert wo wc delta houterPlus houterMinus hchildPlus hchildMinus hquarterOffset + hdeltaRaw + apply Prod.ext + · have h1 := congrArg Prod.fst houterPlus + have h2 := congrArg Prod.fst houterMinus + have h3 := congrArg Prod.fst hchildPlus + have h4 := congrArg Prod.fst hchildMinus + have ho := congrArg Prod.fst (hquarterOffset wo) + have hc := congrArg Prod.fst (hquarterOffset wc) + rw [hdeltaRaw, hquarterOffset wo, hquarterOffset wc] + dsimp [wo, wc] at h1 h2 h3 h4 ⊢ + dsimp at ho hc + linarith + · have h1 := congrArg Prod.snd houterPlus + have h2 := congrArg Prod.snd houterMinus + have h3 := congrArg Prod.snd hchildPlus + have h4 := congrArg Prod.snd hchildMinus + have ho := congrArg Prod.snd (hquarterOffset wo) + have hc := congrArg Prod.snd (hquarterOffset wc) + rw [hdeltaRaw, hquarterOffset wo, hquarterOffset wc] + dsimp [wo, wc] at h1 h2 h3 h4 ⊢ + dsimp at ho hc + linarith + +private theorem hQtransCentroid : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), + let wo := BandVectors.1 (q 3) (q 2) + let wc := BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) + let delta : GaussianInt := + (GaussianQuarterTurn wo - wo) + (GaussianQuarterTurn wc - wc) + (GaussianRealPoint delta = TileCentroid (cert.S 1 false) - TileCentroid (cert.Q 1 true)) + → (TileCentroid (TileTranslation (cert.Q 1 true) delta) = TileCentroid (cert.S 1 + false)) ) := by + classical + intro q cfg C T cert wo wc delta hdelta + rw [(TileTranslationFormulas (cert.Q 1 true) delta).2.2.2.2.1] + change TileCentroid (cert.Q 1 true) + GaussianRealPoint delta = _ + rw [hdelta] + ext <;> simp [Prod.add_def, sub_eq_add_neg] + +private theorem hrealHQ : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + (∀ (U : ProtoTile), TileRealization (H U) = (fun p : Real × Real => (2 * (TileCentroid + T).1 - p.1, 2 * (TileCentroid T).2 - p.2)) '' TileRealization U) → ( + let wo := BandVectors.1 (q 3) (q 2) + let wc := BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) + let delta : GaussianInt := + (GaussianQuarterTurn wo - wo) + (GaussianQuarterTurn wc - wc) + (TileCentroid (cert.Q 1 true) + TileCentroid (cert.S 1 false) = (2 : Real) • TileCentroid + T) → ((GaussianRealPoint delta = TileCentroid (cert.S 1 false) - TileCentroid (cert.Q + 1 true)) → ((CentrallyReflectedAt (TileCentroid (cert.Q (1 : Fin (3 : ℕ)) true)) + (cert.Q (1 : Fin (3 : ℕ)) true) (cert.Q (1 : Fin (3 : ℕ)) true)) → (TileRealization + (H (cert.Q 1 true)) = TileRealization (TileTranslation (cert.Q 1 true) delta))))) ) + := by + classical + intro q cfg C T cert u w t H halfTurnRealization wo wc delta hcentQS hdelta hrealQcentral + rw [halfTurnRealization] + change TileRealization (cert.Q 1 true) = _ at hrealQcentral + rw [hrealQcentral, Set.image_image] + have hmaps : + (fun p : Real × Real => + (2 * (TileCentroid T).1 - (2 * (TileCentroid (cert.Q 1 true)).1 - p.1), + 2 * (TileCentroid T).2 - (2 * (TileCentroid (cert.Q 1 true)).2 - p.2))) = + (fun p : Real × Real => (p.1 + (delta.re : Real), p.2 + (delta.im : Real))) := by + funext p + apply Prod.ext + · have hs := congrArg Prod.fst hcentQS + have hd := congrArg Prod.fst hdelta + dsimp at hs hd ⊢ + change (delta.re : Real) = _ at hd + linarith + · have hs := congrArg Prod.snd hcentQS + have hd := congrArg Prod.snd hdelta + dsimp at hs hd ⊢ + change (delta.im : Real) = _ at hd + linarith + rw [hmaps] + exact (TileTranslationFormulas (cert.Q 1 true) delta).2.2.2.1.symm + +private theorem hHQne : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + ((H (cert.Q 1 true)).cells = (cert.S 1 false).cells) → ((LatticeTile (cert.S 1 false)) → + ((H (cert.Q 1 true)).cells.Nonempty)) ) := by + classical + intro q cfg C T cert u w t H hHQcells hSLat + rw [hHQcells] + exact (LatticeTileGridStructure _ hSLat).1.1 + +private theorem hHQfoot : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + ((H (cert.Q 1 true)).cells = (cert.S 1 false).cells) → (((H (cert.Q 1 + true)).cells.Nonempty) → (FootprintVertices (H (cert.Q 1 true)) = FootprintVertices + (cert.S 1 false))) ) := by + classical + intro q cfg C T cert u w t H hHQcells hHQne + have hempty : (H (cert.Q 1 true)).cells = ∅ → + (H (cert.Q 1 true)).anchor = (cert.S 1 false).anchor := by + intro he + exact False.elim (hHQne.ne_empty he) + exact (ProtoTileObservableExtensionality _ _ hHQcells hempty).1 + +private theorem childFoot : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + (∀ (U : ProtoTile), FootprintVertices (H U) = (fun z : GaussianInt => t - z) '' + FootprintVertices U) → ( + let F : GaussianInt → GaussianInt := fun z => t - z + (FootprintVertices (H (cert.Q 1 true)) = FootprintVertices (cert.S 1 false)) → (F '' + FootprintVertices (cert.Q 1 true) = FootprintVertices (cert.S 1 false))) ) := by + classical + intro q cfg C T cert u w t H halfTurnFootprint F hHQfoot + calc + _ = FootprintVertices (H (cert.Q 1 true)) := + (halfTurnFootprint (cert.Q 1 true)).symm + _ = _ := hHQfoot + +private theorem moveFoot : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let F : GaussianInt → GaussianInt := fun z => t - z + (∀ (z : GaussianInt), F (F z) = z) → ((∀ (A : Set GaussianInt), ∀ (B : Set GaussianInt), + (F '' A = B) → (∀ (z : GaussianInt), z ∈ A ↔ F z ∈ B)) → (∀ (U : ProtoTile), ∀ (V : + ProtoTile), (F '' FootprintVertices U = FootprintVertices V) → (∀ (z : GaussianInt), + (F z ∈ FootprintVertices U) → (z ∈ FootprintVertices V)))) ) := by + classical + intro q u w t F hFinvol image_mem U V hUV z hz + have h := (image_mem _ _ hUV (F z)).mp hz + simpa [hFinvol] using h + +private theorem moveCell : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ + (∀ (U : ProtoTile), (H U).cells = U.cells.image tau) → (∀ (U : ProtoTile), ∀ (V : + ProtoTile), ((H U).cells = V.cells) → (∀ (z : GaussianInt), (z ∈ U.cells) → (tau z ∈ + V.cells))) ) := by + classical + intro q u w t H tau hHcells U V hUV z hz + have hz' : tau z ∈ (H U).cells := by + rw [hHcells] + exact Finset.mem_image.mpr ⟨z, hz, rfl⟩ + rw [hUV] at hz' + exact hz' + +private theorem hstar : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ + BoundaryFootprintVertices T) → ((Nat.card + { is : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 + : ℕ)) → (∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + (x ∈ FootprintVertices (cert.P (0 : Fin (3 : ℕ)) false)) → ((x ∈ FootprintVertices + (cert.P (1 : Fin (3 : ℕ)) false)) → ( + let F : GaussianInt → GaussianInt := fun z => t - z + let v : GaussianInt := F x + (∀ (i : Fin 3), F '' FootprintVertices (cert.P i true) = FootprintVertices (cert.P i + false)) → ((∀ (i : Fin 3), ∀ (s : Bool), v ∈ BoundaryFootprintVertices (cert.P i s) ↔ + x ∈ BoundaryFootprintVertices (cert.P i (!s))) → ((v ∈ FootprintVertices (cert.P 0 + true)) → ((v ∈ FootprintVertices (cert.P 1 true)) → ( + let A := {is : Fin 3 × Bool // + v ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} + (Nat.card A = 2) → ((v ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∧ (∀ (y : + GaussianInt), y = v ∨ y = v + (1 : GaussianInt) ∨ y = v - (1 : GaussianInt) ∨ y = v + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = v - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ + FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∨ y ∈ FootprintVertices (cert.P (1 + : Fin (3 : ℕ)) true)) ∧ ∀ (z : GaussianInt), z = v ∨ z = v - (1 : GaussianInt) ∨ z = + v - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ z = v - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) → z ∈ (cert.Q (1 : Fin (3 : ℕ)) true).cells ∨ z ∈ (cert.P (1 : Fin + (3 : ℕ)) true).cells) → ((F '' FootprintVertices (cert.Q 1 true) = FootprintVertices + (cert.S 1 false)) → ((∀ (U : ProtoTile), ∀ (V : ProtoTile), (F '' FootprintVertices U + = FootprintVertices V) → (∀ (z : GaussianInt), (F z ∈ FootprintVertices U) → (z ∈ + FootprintVertices V))) → (∀ (y : GaussianInt), (y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → (y ∈ FootprintVertices (cert.S 1 false) ∨ y ∈ + FootprintVertices (cert.P 1 false))))))))))))))) ) := by + classical + intro q cfg C T cert x hx hxb hk u w t hB hD F v parentFootprint hboundaryFlip hvA hvC A hvk + hpositive childFoot moveFoot y hy + have hFinvol (z : GaussianInt) : F (F z) = z := by + dsimp [F] + abel + have hFy : F y = v ∨ F y = v + 1 ∨ F y = v - 1 ∨ + F y = v + ⟨0, 1⟩ ∨ F y = v - ⟨0, 1⟩ := by + rcases hy with rfl | hy | hy | hy | hy + · exact Or.inl rfl + · subst y + right; right; left + simp [F, v]; ring + · subst y + right; left + simp [F, v]; ring + · subst y + right; right; right; right + simp [F, v]; ring + · subst y + right; right; right; left + simp [F, v]; ring + rcases (hpositive.2.1 (F y) hFy) with hq | hp + · exact Or.inl (moveFoot _ _ childFoot y (by simpa [hFinvol] using hq)) + · exact Or.inr (moveFoot _ _ (parentFootprint 1) y + (by simpa [hFinvol] using hp)) + +private theorem hcellLift : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (x : GaussianInt), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ + let F : GaussianInt → GaussianInt := fun z => t - z + let v : GaussianInt := F x + ∀ (z : GaussianInt), (z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩) → (∃ c : GaussianInt, (c = v ∨ c = v - 1 ∨ c = v - ⟨0, 1⟩ ∨ c = v + - 1 - ⟨0, 1⟩) ∧ tau c = z) ) := by + classical + intro q x u w t tau F v z hz + rcases hz with hz | hz | hz | hz + · subst z + refine ⟨v - 1 - ⟨0, 1⟩, Or.inr (Or.inr (Or.inr rfl)), ?_⟩ + apply Zsqrtd.ext <;> simp [tau, v, F] <;> ring + · subst z + refine ⟨v - ⟨0, 1⟩, Or.inr (Or.inr (Or.inl rfl)), ?_⟩ + apply Zsqrtd.ext <;> simp [tau, v, F]; ring + · subst z + refine ⟨v - 1, Or.inr (Or.inl rfl), ?_⟩ + apply Zsqrtd.ext <;> simp [tau, v, F]; ring + · subst z + refine ⟨v, Or.inl rfl, ?_⟩ + apply Zsqrtd.ext <;> simp [tau, v, F] + +private theorem hcellsAt1062 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), ∀ (x : GaussianInt), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ + (∀ (i : Fin 3), (H (cert.P i true)).cells = (cert.P i false).cells) → ( + let F : GaussianInt → GaussianInt := fun z => t - z + let v : GaussianInt := F x + (v ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∧ (∀ (y : GaussianInt), y = v ∨ y + = v + (1 : GaussianInt) ∨ y = v - (1 : GaussianInt) ∨ y = v + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∨ y = v - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices + (cert.Q (1 : Fin (3 : ℕ)) true) ∨ y ∈ FootprintVertices (cert.P (1 : Fin (3 : ℕ)) + true)) ∧ ∀ (z : GaussianInt), z = v ∨ z = v - (1 : GaussianInt) ∨ z = v - (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt) ∨ z = v - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) → z ∈ (cert.Q (1 : Fin (3 : ℕ)) true).cells ∨ z ∈ (cert.P (1 : Fin (3 : + ℕ)) true).cells) → (((H (cert.Q 1 true)).cells = (cert.S 1 false).cells) → ((∀ (U : + ProtoTile), ∀ (V : ProtoTile), ((H U).cells = V.cells) → (∀ (z : GaussianInt), (z ∈ + U.cells) → (tau z ∈ V.cells))) → ((∀ (z : GaussianInt), (z = x ∨ z = x - 1 ∨ z = x - + ⟨0, 1⟩ ∨ z = x - 1 - ⟨0, 1⟩) → (∃ c : GaussianInt, (c = v ∨ c = v - 1 ∨ c = v - ⟨0, + 1⟩ ∨ c = v - 1 - ⟨0, 1⟩) ∧ tau c = z)) → (∀ (z : GaussianInt), (z = x ∨ z = x - 1 ∨ z + = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩) → (z ∈ (cert.S 1 false).cells ∨ z ∈ (cert.P 1 false).cells)))))) + ) := by + classical + intro q cfg C T cert x u w t H tau outerCells F v hpositive hHQcells moveCell hcellLift z hz + obtain ⟨c, hc, htc⟩ := hcellLift z hz + have hsquare := hpositive.2.2 c hc + rcases hsquare with hq | hp + · have hh := moveCell _ _ hHQcells c hq + rw [htc] at hh + exact Or.inl hh + · have hh := moveCell _ _ (outerCells 1) c hp + rw [htc] at hh + exact Or.inr hh + +end RightInteriorGeometry + +namespace RightInteriorConclusion + +private theorem positiveCase : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ + (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q + cfg C T), (GaussianInt) → ((∀ (v : GaussianInt), ∀ (V : Set GaussianInt), ∀ (E : Set + (Finset GaussianInt)), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + SimpleGridPathBetween V E a b → v ∈ V → v ≠ a → v ≠ b → ∃ (y : GaussianInt) (z : + GaussianInt) (e : Finset GaussianInt) (f : Finset GaussianInt), e ≠ f ∧ v ∈ e ∧ v ∈ f + ∧ e ∈ E ∧ f ∈ E ∧ e = {y, v} ∧ f = {v, z} ∧ FourNeighborAdjacent y v ∧ + FourNeighborAdjacent v z) → ((∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (W : + ProtoTile), Finset.Nonempty U.cells → Finset.Nonempty V.cells → TouchingTriple U V W + → Disjoint U.cells V.cells) → ((∀ (U : ProtoTile), Finset.Nonempty U.cells → ∀ e ∈ + FootprintEdges U, ∀ z ∈ e, z ∈ FootprintVertices U) → ((∀ (z : GaussianInt), ∀ (U : + ProtoTile), ∀ (V : ProtoTile), ∀ (W : ProtoTile), LatticeTile U → LatticeTile V → + LatticeTile W → Disjoint U.cells W.cells → Disjoint V.cells W.cells → z ∈ + FootprintVertices U → z ∈ FootprintVertices V → z ∈ FootprintVertices W → z ∈ + BoundaryFootprintVertices U ∧ z ∈ BoundaryFootprintVertices V ∧ z ∈ + BoundaryFootprintVertices W) → ((∀ (v : GaussianInt), ∀ (z : GaussianInt), Nat.card + { is : Fin (3 : ℕ) × Bool // v ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 + : ℕ) → z = v → z ∈ BoundaryFootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) → z ∈ + BoundaryFootprintVertices (cert.P (0 : Fin (3 : ℕ)) false) → z ∈ + BoundaryFootprintVertices (cert.P (1 : Fin (3 : ℕ)) true) → False) → ((∀ (v : + GaussianInt), ∀ (z : GaussianInt), Nat.card + { is : Fin (3 : ℕ) × Bool // v ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 + : ℕ) → z = v → z ∈ BoundaryFootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) → z ∈ + BoundaryFootprintVertices (cert.P (1 : Fin (3 : ℕ)) true) → z ∈ + BoundaryFootprintVertices (cert.P (2 : Fin (3 : ℕ)) false) → False) → ((∀ (v : + GaussianInt), ∀ (U : ProtoTile), ∀ (V : ProtoTile), (ProtoTile) → (LatticeTile U → + LatticeTile V → Disjoint U.cells V.cells → (∃ (e : Finset GaussianInt) (f : Finset + GaussianInt), e ≠ f ∧ v ∈ e ∧ v ∈ f ∧ e ∈ FootprintEdges U ∩ FootprintEdges V ∧ f ∈ + FootprintEdges U ∩ FootprintEdges V) → (∀ (y : GaussianInt), y = v ∨ y = v + (1 : + GaussianInt) ∨ y = v - (1 : GaussianInt) ∨ y = v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ∨ y = v - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices U ∨ y ∈ + FootprintVertices V) ∧ ∀ (z : GaussianInt), z = v ∨ z = v - (1 : GaussianInt) ∨ z = v + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ z = v - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) → z ∈ U.cells ∨ z ∈ V.cells)) → ((FootprintVertices (cert.P 0 + true) ∩ FootprintVertices (cert.P 1 true) ⊆ FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.P 1 true)) → (∀ (point : GaussianInt), (Nat.card {is : Fin 3 + × Bool // + point ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2) → ((point ∈ + FootprintVertices (cert.P 0 true)) → ((point ∈ FootprintVertices (cert.P 1 true)) + → (point ∈ FootprintVertices (cert.Q 1 true) ∧ (∀ y, y = point ∨ y = point + 1 ∨ + y = point - 1 ∨ y = point + ⟨0, 1⟩ ∨ y = point - ⟨0, 1⟩ → y ∈ FootprintVertices + (cert.Q 1 true) ∨ y ∈ FootprintVertices (cert.P 1 true)) ∧ (∀ z, z = point ∨ z = + point - 1 ∨ z = point - ⟨0, 1⟩ ∨ z = point - 1 - ⟨0, 1⟩ → z ∈ (cert.Q 1 + true).cells ∨ z ∈ (cert.P 1 true).cells))))))))))))) ) := by + classical + intro q cfg C T cert x twoPathEdges touching_disjoint edgeEndpoint threeBoundaries + threeOwnersContradict threeOwnersAFContradict interfaceConclusion raw_support point hk hA hC + have hQC := raw_support ⟨hA, hC⟩ + have hQ : LatticeTile (cert.Q 1 true) := + P4590T1PositivePrototileDisk _ _ (cert.plus_occurrence 1 true).1 (by + change 0 < (cfg.firstPredecessor 2).1 + rw [cfg.firstParentTwo] + have hnonneg := (ProperBandCurvatureStructure q cfg.proper).2.1 (1 : Fin 3) + have hn := cfg.noLine 2 + change 0 ≤ (q 2).1 at hnonneg + omega) + have hCtile : LatticeTile (cert.P 1 true) := cert.parent_lattice 1 true + have hQne : (cert.Q 1 true).cells.Nonempty := + (LatticeTileGridStructure _ hQ).1.1 + have hCne : (cert.P 1 true).cells.Nonempty := + (LatticeTileGridStructure _ hCtile).1.1 + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + have translation_zero := RightInteriorGeometry.translation_zero + have htileA := RightInteriorGeometry.htileA q cfg C T cert translation_zero + have htileC := RightInteriorGeometry.htileC q cfg C T cert translation_zero + have hOA := RightInteriorGeometry.hOA q cfg C T cert + have hsep := (BandOriginalPairSeparation cert.P cert.O cert.u cert.v + hOA (RightInteriorGeometry.hOB q cfg C T cert) cert.partition).2 + have hdeletedNe : (TileCellComplement (cert.P 0 true) cert.O).cells.Nonempty := + (LatticeTileGridStructure _ cert.precursor_complement_lattice.1).1.1 + have hretainData := FootprintDeletionRetention (cert.P 0 true) + (cert.P 0 false) cert.O (cert.P 1 true) hOA (RightInteriorGeometry.hisolated q cfg C T cert + translation_zero) (RightInteriorGeometry.hCA q cfg C T cert translation_zero hsep) + (RightInteriorGeometry.hCB q cfg C T cert translation_zero hsep) + have hretainEdges : + FootprintEdges (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintEdges (cert.P 1 true) = + FootprintEdges (cert.P 0 true) ∩ FootprintEdges (cert.P 1 true) := + hretainData.2.1 + have hretainVertices : + FootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintVertices (cert.P 1 true) = + FootprintVertices (cert.P 0 true) ∩ FootprintVertices (cert.P 1 true) := + hretainData.2.2 (Or.inr ⟨hdeletedNe, hCne⟩) + have hac : a ≠ c := by decide + have hadj : cert.modified.plane.adjacent a c := + (cert.modified_adjacency a c).mpr (.AC 0 0) + have hcommon := cert.modified.adjacent_has_common_edge a c hadj + obtain ⟨hclass, hregular⟩ := PeriodicTileIntersectionClassification cert.modified + have hraw := ((hclass a c hac).2.1 hcommon).2 + obtain ⟨_, f, g, hfg, hf, hg, hfaces, hpath⟩ := + (PeriodicTileIntersectionPaths cert.modified hregular a c hac).1.mpr hcommon + have hpair := RightInteriorGeometry.hpair q cfg C T cert f g (RightInteriorGeometry.hf1 q cfg + C T cert f g hfaces) (RightInteriorGeometry.hf3 q cfg C T cert f g hfaces) + (RightInteriorGeometry.hf13 q cfg C T cert) + have hrho1 : cert.modified.rho f1 = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) := + cert.modified_face_points _ + have hrho3 : cert.modified.rho f3 = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) := + cert.modified_face_points _ + have hz13 := RightInteriorGeometry.hz13 q cfg C T cert f g hpair hrho1 hrho3 + (RightInteriorGeometry.hend q cfg C T cert f g hpath) + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let fidx : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ + have hfa10 : cert.modified.plane.faceVertex f1 0 = a := by + simp [f1, a, cert.modified_face_vertices, SixSubtileFaceVertices] + have hfa11 : cert.modified.plane.faceVertex f1 1 = b := by + simp [f1, b, cert.modified_face_vertices, SixSubtileFaceVertices] + have hfa12 : cert.modified.plane.faceVertex f1 2 = c := by + simp [f1, c, cert.modified_face_vertices, SixSubtileFaceVertices] + have hfa30 : cert.modified.plane.faceVertex f3 0 = a := by + simp [f3, a, cert.modified_face_vertices, SixSubtileFaceVertices] + have hfa31 : cert.modified.plane.faceVertex f3 1 = c := by + simp [f3, c, cert.modified_face_vertices, SixSubtileFaceVertices] + have hfa32 : cert.modified.plane.faceVertex f3 2 = fidx := by + simp [f3, fidx, cert.modified_face_vertices, SixSubtileFaceVertices] + let z1 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) + let z3 := cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) + have hz1AC := RightInteriorGeometry.hz1AC q cfg C T cert hretainVertices + (RightInteriorGeometry.hz1Amod q cfg C T cert htileA hrho1 hfa10) + (RightInteriorGeometry.hz1C q cfg C T cert htileC hrho1 hfa12) + have hz3C := RightInteriorGeometry.hz3C q cfg C T cert htileC hrho3 hfa31 + have hz1boundary := threeBoundaries z1 (cert.P 0 true) + (cert.P 0 false) (cert.P 1 true) (cert.parent_lattice 0 true) + (cert.parent_lattice 0 false) hCtile (RightInteriorGeometry.hACdis q cfg C T cert + translation_zero hsep) (RightInteriorGeometry.hBCdis q cfg C T cert translation_zero hsep) + hz1AC.1 (RightInteriorGeometry.hz1B q cfg C T cert hrho1 (RightInteriorGeometry.htileB q + cfg C T cert translation_zero) hfa11) hz1AC.2 + have hz3boundary := threeBoundaries z3 (cert.P 0 true) + (cert.P 1 true) (cert.P 2 false) (cert.parent_lattice 0 true) + hCtile (cert.parent_lattice 2 false) (RightInteriorGeometry.hAFdis q cfg C T cert + translation_zero hsep) (RightInteriorGeometry.hCFdis q cfg C T cert translation_zero + hsep) (RightInteriorGeometry.hz3AC q cfg C T cert hretainVertices + (RightInteriorGeometry.hz3Amod q cfg C T cert htileA hrho3 hfa30) hz3C).1 hz3C + (RightInteriorGeometry.hz3F q cfg C T cert hrho3 (RightInteriorGeometry.htileF q cfg C + T cert translation_zero) hfa32) + have hprepos := RightInteriorGeometry.hprepos q cfg + let C2 : BandCircle := ⟨⟨cfg.firstPredecessor 2, + ⟨Or.inl hprepos, cfg.firstPredecessor, cfg.firstProper.1, 2, rfl⟩⟩, hprepos⟩ + have hprotoQ : BandPrototile C2.1.1 (cert.Q 1 true) := + (cert.plus_occurrence 1 true).1 + have regQ := (LatticeEdgeRegularity C2 (cert.Q 1 true) hprotoQ hQ).2.1 + have regC := (LatticeEdgeRegularity C2 (cert.P 1 true) (RightInteriorGeometry.hprotoC q cfg C + T cert hprepos) hCtile).2.1 + have hdis : Disjoint (cert.Q 1 true).cells (cert.P 1 true).cells := + touching_disjoint _ _ _ hQne hCne cert.double_third + have hresult := interfaceConclusion point (cert.Q 1 true) (cert.P 1 true) + (cert.P 2 false) hQ hCtile hdis (RightInteriorGeometry.hEdgesQC q cfg C T cert point + edgeEndpoint raw_support hCne (RightInteriorGeometry.hpathEndpoints q cfg C T cert point + twoPathEdges hA hC (RightInteriorGeometry.hcompleteOriginal q cfg C T cert hretainEdges + hretainVertices (RightInteriorGeometry.hcomplete q cfg C T cert htileA htileC hraw f g + hpath hpair hrho1 hrho3)) (RightInteriorGeometry.hz1ne q cfg C T cert point hk + threeOwnersContradict hz1boundary) (RightInteriorGeometry.hz3ne q cfg C T cert point hk + threeOwnersAFContradict hz3boundary)) regQ regC) + exact ⟨hQC.1, hresult.1, hresult.2⟩ + +end RightInteriorConclusion + +theorem P4590T1RightInteriorGeometry : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + (LatticeTile T) → (∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ + BoundaryFootprintVertices T) → ((Nat.card {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2) → ((x ∈ FootprintVertices (cert.P 0 + true) → x ∈ FootprintVertices (cert.P 1 true) → + x ∈ FootprintVertices (cert.Q 1 true) ∧ + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.Q 1 true) ∨ y ∈ FootprintVertices (cert.P 1 true)) ∧ + (∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩ → + z ∈ (cert.Q 1 true).cells ∨ z ∈ (cert.P 1 true).cells)) ∧ + (x ∈ FootprintVertices (cert.P 0 false) → x ∈ FootprintVertices (cert.P 1 false) → + x ∈ FootprintVertices (cert.S 1 false) ∧ + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.S 1 false) ∨ y ∈ FootprintVertices (cert.P 1 false)) ∧ + (∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩ → + z ∈ (cert.S 1 false).cells ∨ z ∈ (cert.P 1 false).cells)))))) := by + intro q cfg C T cert hT x hx hxb hk +-- BODY + classical + obtain ⟨u, hu, _⟩ := QuarterTurnSymmetricCenteredTransport + (cert.P 0 false) (cert.parent_quarter_turn 0 false) + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileHalfTurn U) t + let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ + have hHcells := RightInteriorGeometry.hHcells q u + have halfTurnRealization := RightInteriorGeometry.halfTurnRealization q T u + (RightInteriorGeometry.ht q cfg C T cert u hu) + have halfTurnFootprint := RightInteriorGeometry.halfTurnFootprint q u + have halfTurnBoundary := RightInteriorGeometry.halfTurnBoundary q u + have cells_of_realization (U V : ProtoTile) + (hreal : TileRealization U = TileRealization V) : U.cells = V.cells := + RightInteriorGeometry.cells_of_realization U V hreal + have signedOuter := BandSignedOccurrenceHalfTurn q (TileCentroid T) cert.P + (fun i s => (cert.outer_occurrence i s).1) + (fun i s => (cert.outer_occurrence i s).2.2) + have outerCells (i : Fin 3) : + (H (cert.P i true)).cells = (cert.P i false).cells := + cells_of_realization _ _ ((RightInteriorGeometry.outerRealization q cfg C T cert u + halfTurnRealization signedOuter) i) + have outerNonempty (i : Fin 3) (s : Bool) : + (cert.P i s).cells.Nonempty := + (LatticeTileGridStructure _ (cert.parent_lattice i s)).1.1 + have outerFootprint := RightInteriorGeometry.outerFootprint q cfg C T cert u outerCells + outerNonempty + have outerBoundary := RightInteriorGeometry.outerBoundary q cfg C T cert u outerCells + outerNonempty + have twoPathEdges := RightInteriorGeometry.twoPathEdges (RightInteriorGeometry.splitInternal) + have touching_disjoint := RightInteriorGeometry.touching_disjoint + have edgeEndpoint := RightInteriorGeometry.edgeEndpoint + have threeBoundaries := RightInteriorGeometry.threeBoundaries (RightInteriorGeometry.rawIncident) + have threeOwnersContradict := RightInteriorGeometry.threeOwnersContradict q cfg C T cert x + have threeOwnersAFContradict := RightInteriorGeometry.threeOwnersAFContradict q cfg C T cert x + have interfaceConclusion := RightInteriorGeometry.interfaceConclusion + have raw_support : + FootprintVertices (cert.P 0 true) ∩ FootprintVertices (cert.P 1 true) ⊆ + FootprintVertices (cert.Q 1 true) ∩ FootprintVertices (cert.P 1 true) := + (BandOrderedGeneralRawSupport q cfg C T cert).1 + have positiveCase (point : GaussianInt) + (hk : Nat.card {is : Fin 3 × Bool // + point ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2) + (hA : point ∈ FootprintVertices (cert.P 0 true)) + (hC : point ∈ FootprintVertices (cert.P 1 true)) : + point ∈ FootprintVertices (cert.Q 1 true) ∧ + (∀ y, y = point ∨ y = point + 1 ∨ y = point - 1 ∨ + y = point + ⟨0, 1⟩ ∨ y = point - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.Q 1 true) ∨ y ∈ FootprintVertices (cert.P 1 true)) ∧ + (∀ z, z = point ∨ z = point - 1 ∨ z = point - ⟨0, 1⟩ ∨ + z = point - 1 - ⟨0, 1⟩ → + z ∈ (cert.Q 1 true).cells ∨ z ∈ (cert.P 1 true).cells) := + RightInteriorConclusion.positiveCase q cfg C T cert x twoPathEdges touching_disjoint + edgeEndpoint threeBoundaries threeOwnersContradict threeOwnersAFContradict + interfaceConclusion raw_support point hk hA hC + constructor + · exact positiveCase x hk + · intro hB hD + let F : GaussianInt → GaussianInt := fun z => t - z + let v : GaussianInt := F x + have hFinvol (z : GaussianInt) : F (F z) = z := by + apply Zsqrtd.ext <;> simp [F] + have image_mem (A B : Set GaussianInt) (hAB : F '' A = B) + (z : GaussianInt) : z ∈ A ↔ F z ∈ B := RightInteriorGeometry.image_mem q u + (RightInteriorGeometry.hFinj q u hFinvol) A B hAB z + have parentFootprint (i : Fin 3) : + F '' FootprintVertices (cert.P i true) = + FootprintVertices (cert.P i false) := RightInteriorGeometry.parentFootprint q cfg C T + cert u halfTurnFootprint outerFootprint i + have parentBoundary := RightInteriorGeometry.parentBoundary q cfg C T cert u halfTurnBoundary + outerNonempty outerBoundary + have hboundaryFlip := RightInteriorGeometry.hboundaryFlip q cfg C T cert x u hFinvol + image_mem parentBoundary (RightInteriorGeometry.parentBoundaryReverse q cfg C T cert u + hFinvol parentBoundary) + have hvA : v ∈ FootprintVertices (cert.P 0 true) := by + exact (image_mem _ _ (parentFootprint 0) v).2 (by simpa [v, F] using hB) + have hvC : v ∈ FootprintVertices (cert.P 1 true) := by + exact (image_mem _ _ (parentFootprint 1) v).2 (by simpa [v, F] using hD) + let A := {is : Fin 3 × Bool // + v ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} + let B := {is : Fin 3 × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} + let e : A ≃ B := + { toFun := fun a => ⟨(a.val.1, !a.val.2), hboundaryFlip a.val.1 a.val.2 |>.mp a.property⟩ + invFun := fun b => ⟨(b.val.1, !b.val.2), by + have hb : x ∈ BoundaryFootprintVertices + (cert.P b.val.1 (!(!b.val.2))) := by simpa using b.property + exact (hboundaryFlip b.val.1 (!b.val.2)).mpr hb⟩ + left_inv := by intro a; apply Subtype.ext; simp + right_inv := by intro b; apply Subtype.ext; simp } + have hvk := RightInteriorGeometry.hvk q cfg C T cert x hk u hboundaryFlip + have hpositive := positiveCase v hvk hvA hvC + let wo := BandVectors.1 (q 3) (q 2) + let wc := BandVectors.1 (cfg.firstPredecessor 1) (cfg.firstPredecessor 3) + let delta : GaussianInt := + (GaussianQuarterTurn wo - wo) + (GaussianQuarterTurn wc - wc) + have houterPlus := (cert.outer_occurrence 0 true).2.2 + have houterMinus := (cert.outer_occurrence 0 false).2.2 + have hchildPlus := (cert.plus_occurrence 1 true).2.2 + have hchildMinus := (cert.minus_occurrence 1 false).2.2 + dsimp [wo, wc] at houterPlus houterMinus hchildPlus hchildMinus + have hdelta := RightInteriorGeometry.hdelta q cfg C T cert houterPlus houterMinus hchildPlus + hchildMinus (RightInteriorGeometry.hquarterOffset) (RightInteriorGeometry.hdeltaRaw q cfg) + have hQproto : BandPrototile (cfg.firstPredecessor 2) (cert.Q 1 true) := + (cert.plus_occurrence 1 true).1 + have hSproto : BandPrototile (cfg.firstPredecessor 2) (cert.S 1 false) := + (cert.minus_occurrence 1 false).1 + have hQtrans : BandPrototile (cfg.firstPredecessor 2) + (TileTranslation (cert.Q 1 true) delta) := + BandPrototileTranslation _ _ _ hQproto + have htransCells := (BandPrototileCentroidUnique (cfg.firstPredecessor 2) + (TileTranslation (cert.Q 1 true) delta) (cert.S 1 false) + hQtrans hSproto (RightInteriorGeometry.hQtransCentroid q cfg C T cert hdelta)).1 + have hrealQcentral := BandPrototileCentralSymmetry + (cfg.firstPredecessor 2) (cert.Q 1 true) hQproto + have hrealHQ : TileRealization (H (cert.Q 1 true)) = + TileRealization (TileTranslation (cert.Q 1 true) delta) := RightInteriorGeometry.hrealHQ + q cfg C T cert u halfTurnRealization (RightInteriorGeometry.hcentQS q cfg C T cert + houterPlus houterMinus hchildPlus hchildMinus) hdelta hrealQcentral + have hHQcells : (H (cert.Q 1 true)).cells = (cert.S 1 false).cells := by + rw [cells_of_realization _ _ hrealHQ, htransCells] + have hSLat : LatticeTile (cert.S 1 false) := + P4590T1PositivePrototileDisk _ _ hSproto (by + rw [cfg.firstParentTwo] + have hnonneg := (ProperBandCurvatureStructure q cfg.proper).2.1 (1 : Fin 3) + have hn := cfg.noLine 2 + change 0 ≤ (q 2).1 at hnonneg + omega) + have childFoot : F '' FootprintVertices (cert.Q 1 true) = + FootprintVertices (cert.S 1 false) := RightInteriorGeometry.childFoot q cfg C T cert u + halfTurnFootprint (RightInteriorGeometry.hHQfoot q cfg C T cert u hHQcells + (RightInteriorGeometry.hHQne q cfg C T cert u hHQcells hSLat)) + have moveFoot (U V : ProtoTile) + (hUV : F '' FootprintVertices U = FootprintVertices V) + (z : GaussianInt) (hz : F z ∈ FootprintVertices U) : + z ∈ FootprintVertices V := RightInteriorGeometry.moveFoot q u hFinvol image_mem U V hUV z hz + exact ⟨by + exact moveFoot _ _ childFoot x (by simpa [hFinvol] using hpositive.1), + (RightInteriorGeometry.hstar q cfg C T cert x hx hxb hk u hB hD parentFootprint + hboundaryFlip hvA hvC hvk hpositive childFoot moveFoot), + (RightInteriorGeometry.hcellsAt1062 q cfg C T cert x u outerCells hpositive hHQcells + (RightInteriorGeometry.moveCell q u hHcells) (RightInteriorGeometry.hcellLift q x u))⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RotationalDiskCenter.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RotationalDiskCenter.lean new file mode 100644 index 0000000000..5b7e3a8182 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RotationalDiskCenter.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TopologicalDiskExponentialLift +public import Mathlib.Topology.Connected.TotallyDisconnected + +-- [TABLET NODE: P4590T1RotationalDiskCenter] + +/-! +# P4590T1RotationalDiskCenter + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4590T1RotationalDiskCenter (S : Set (Real × Real)) (hS : TopologicalDisk S) + (c : Real × Real) + (hR : ∀ p ∈ S, (c.1 - (p.2 - c.2), c.2 + (p.1 - c.1)) ∈ S) : + c ∈ S := by +-- BODY + classical + by_contra hc + obtain ⟨F, hF, hExp⟩ := TopologicalDiskExponentialLift S hS c hc + obtain ⟨e⟩ := hS + let D : Set (Real × Real) := Metric.closedBall 0 1 + let : ContractibleSpace D := Metric.contractibleSpace_closedBall (by norm_num) + let : ContractibleSpace S := e.symm.contractibleSpace + let R : S → S := fun p => ⟨(c.1 - (p.1.2 - c.2), c.2 + (p.1.1 - c.1)), + hR p p.2⟩ + have hRc : Continuous R := by dsimp [R]; fun_prop + let a : ℂ := (Real.pi / 2 : Real) * Complex.I + let H : S → ℂ := fun p => F (R p) - F p - a + have hHc : Continuous H := (hF.comp hRc).sub hF |>.sub continuous_const + have hexpa : Complex.exp a = Complex.I := by + simp [a, Complex.exp_mul_I] + have hDelta (p : S) : Complex.exp (F (R p) - F p) = Complex.exp a := by + rw [Complex.exp_sub, hExp, hExp, hexpa] + have hn : (⟨p.1.1 - c.1, p.1.2 - c.2⟩ : ℂ) ≠ 0 := by + rw [← hExp p] + exact Complex.exp_ne_zero _ + apply (div_eq_iff hn).mpr + apply Complex.ext <;> dsimp [R] <;> simp + have hmem (p : S) : H p ∈ AddSubgroup.zmultiples + (2 * (Real.pi : ℂ) * Complex.I) := by + obtain ⟨n, hn⟩ := Complex.exp_eq_exp_iff_exists_int.mp (hDelta p) + rw [AddSubgroup.mem_zmultiples_iff] + refine ⟨n, ?_⟩ + simp only [H, hn, zsmul_eq_mul] + ring + let G : S → AddSubgroup.zmultiples (2 * (Real.pi : ℂ) * Complex.I) := + fun p => ⟨H p, hmem p⟩ + have hGc : Continuous G := hHc.subtype_mk _ + have heq (p q : S) : H p = H q := + congrArg Subtype.val (TotallyDisconnectedSpace.eq_of_continuous G hGc p q) + let p : S := e ⟨0, by norm_num [Metric.mem_closedBall]⟩ + have hR4 : R (R (R (R p))) = p := by + apply Subtype.ext + apply Prod.ext <;> dsimp [R] <;> ring + have h0 := heq (R p) p + have h1 := heq (R (R p)) p + have h2 := heq (R (R (R p))) p + dsimp only [H] at h0 h1 h2 + rw [hR4] at h2 + obtain ⟨n, hn⟩ := Complex.exp_eq_exp_iff_exists_int.mp (hDelta p) + have hz : (1 : Int) + 4 * n = 0 := by + have h0i := congrArg Complex.im h0 + have h1i := congrArg Complex.im h1 + have h2i := congrArg Complex.im h2 + have hni := congrArg Complex.im hn + simp? [a] at h0i h1i h2i hni + have hreal : (1 : Real) + 4 * (n : Real) = 0 := by + nlinarith [Real.pi_pos] + exact_mod_cast hreal + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1SixLabelBoundaryCount.lean b/LeanPool/ApollonianSuperharmonic/P4590T1SixLabelBoundaryCount.lean new file mode 100644 index 0000000000..0baaa36304 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4590T1SixLabelBoundaryCount.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: P4590T1SixLabelBoundaryCount] + +/-! +# P4590T1SixLabelBoundaryCount + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4590T1SixLabelBoundaryCount (p : Fin 3 → Bool → Prop) + (hAE : ¬ (p 0 true ∧ p 2 true)) + (hBF : ¬ (p 0 false ∧ p 2 false)) + (hCD : ¬ (p 1 true ∧ p 1 false)) + (hCE : ¬ (p 1 true ∧ p 2 true)) + (hDF : ¬ (p 1 false ∧ p 2 false)) + (hEF : ¬ (p 2 true ∧ p 2 false)) : + let k := Nat.card {is : Fin 3 × Bool // p is.1 is.2} + k ≤ 3 ∧ + (k = 2 → + (p 0 true ∧ p 0 false) ∨ + (p 0 true ∧ p 1 true) ∨ + (p 0 false ∧ p 1 false) ∨ + ∃ i j : Fin 3, i ≠ j ∧ p i true ∧ p j false) ∧ + (k = 3 → + (p 0 true ∧ p 0 false ∧ p 1 true) ∨ + (p 0 true ∧ p 0 false ∧ p 1 false) ∨ + (p 0 true ∧ p 1 true ∧ p 2 false) ∨ + (p 0 false ∧ p 1 false ∧ p 2 true)) ∧ + ((∀ i, p i true ↔ p i false) → + k ≠ 3 ∧ (k = 2 → p 0 true ∧ p 0 false)) := by +-- BODY + classical + have hc : Nat.card {is : Fin 3 × Bool // p is.1 is.2} = + (if p 0 false then 1 else 0) + (if p 0 true then 1 else 0) + + (if p 1 false then 1 else 0) + (if p 1 true then 1 else 0) + + (if p 2 false then 1 else 0) + (if p 2 true then 1 else 0) := by + rw [Nat.card_eq_fintype_card, Fintype.card_subtype] + have huniv : (Finset.univ : Finset (Fin 3 × Bool)) = + {(0, false), (0, true), (1, false), (1, true), (2, false), (2, true)} := by + decide + rw [huniv] + by_cases ha : p 0 true <;> by_cases hb : p 0 false <;> + by_cases hc : p 1 true <;> by_cases hd : p 1 false <;> + by_cases he : p 2 true <;> by_cases hf : p 2 false <;> + simp_all [Finset.filter_insert, Finset.filter_singleton] + dsimp only + rw [hc] + simp only [ne_eq, Fin.exists_fin_succ, Fin.exists_fin_zero, Fin.forall_fin_succ, + Fin.forall_fin_zero] + by_cases ha : p 0 true <;> by_cases hb : p 0 false <;> + by_cases hc : p 1 true <;> by_cases hd : p 1 false <;> + by_cases he : p 2 true <;> by_cases hf : p 2 false <;> + simp_all + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4616T1FirstPredecessorCentroids.lean b/LeanPool/ApollonianSuperharmonic/P4616T1FirstPredecessorCentroids.lean new file mode 100644 index 0000000000..1ac6f6f5b4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4616T1FirstPredecessorCentroids.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P4616T1FirstPredecessorCentroids] + +/-! +# P4616T1FirstPredecessorCentroids + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4616T1FirstPredecessorCentroids + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) : + let r := cfg.firstPredecessor + let U : Fin 4 → ProtoTile := ![cert.P 0 true, cert.P 0 true, + cert.P 0 false, cert.P 0 false] + let W : Fin 4 → ProtoTile := ![cert.P 1 false, cert.P 2 false, + cert.P 1 true, cert.P 2 true] + let H : Fin 4 → ProtoTile := ![ + TileTranslation (cert.P 0 false) (cert.u + cert.v), + TileTranslation (cert.P 0 false) cert.v, + TileTranslation (cert.P 0 true) (-cert.u - cert.v), + TileTranslation (cert.P 0 true) (-cert.v)] + let j : Fin 4 → Fin 3 := ![1, 2, 1, 2] + let s : Fin 4 → Fin 4 := ![3, 0, 1, 2] + ∀ k, + TileCentroid (W k) - TileCentroid (U k) = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (s k).val * + (BandVectors.1 (r (j k).succ) (r 0) + + BandVectors.1 (r 0) (r (j k).succ))) ∧ + TileCentroid (TileTranslation (U k) + ((⟨0, 1⟩ : GaussianInt) ^ (s k).val * + (if Even (s k).val then BandVectors.1 (r (j k).succ) (r 0) + else BandVectors.1 (r 0) (r (j k).succ)))) = + TileCentroid (H k) := by +-- BODY + have hA := (cert.outer_occurrence 0 true).2.2 + have hB := (cert.outer_occurrence 0 false).2.2 + have hC := (cert.outer_occurrence 1 true).2.2 + have hD := (cert.outer_occurrence 1 false).2.2 + have hE := (cert.outer_occurrence 2 true).2.2 + have hF := (cert.outer_occurrence 2 false).2.2 + have hs := congrArg GaussianRealPoint (VectorRecursionLaws q cfg.proper.1).1 + have h20 := congrArg GaussianRealPoint cfg.firstVectorTwo + have hf2 := congrArg GaussianRealPoint + (((VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).2.2.2.2 + cfg.firstProper 1).1) + have hf3 := congrArg GaussianRealPoint + (((VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).2.2.2.2 + cfg.firstProper 2).1) + have hqf1 := congrArg GaussianRealPoint + (((VectorRecursionLaws q cfg.proper.1).2.2.2.2 cfg.proper 0).1) + have hqf2 := congrArg GaussianRealPoint + (((VectorRecursionLaws q cfg.proper.1).2.2.2.2 cfg.proper 1).1) + have hqi1 := congrArg GaussianRealPoint (VectorRecursionLaws q cfg.proper.1).2.2.1 + have hqi2 := congrArg GaussianRealPoint + (VectorRecursionLaws ![q 0, q 2, q 3, q 1] + (SemiProperQuadruple.rotate cfg.proper.1)).2.2.1 + dsimp only + intro k + fin_cases k <;> + norm_num [show Even (0 : Nat) from by decide, + show ¬Even (1 : Nat) from by decide, + show Even (2 : Nat) from by decide, + show ¬Even (3 : Nat) from by decide] + all_goals + constructor + all_goals + try rw [(TileTranslationFormulas _ _).2.2.2.2.1] + try rw [(TileTranslationFormulas _ _).2.2.2.2.1] + apply Prod.ext + all_goals + simp [Prod.ext_iff, GaussianRealPoint, pow_succ, cert.period_u, cert.period_v, + cfg.firstChild, cfg.firstParentTwo, cfg.firstParentThree] at *; linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4616T1MixedCoarseSectors.lean b/LeanPool/ApollonianSuperharmonic/P4616T1MixedCoarseSectors.lean new file mode 100644 index 0000000000..08baa62488 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4616T1MixedCoarseSectors.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure + +-- [TABLET NODE: P4616T1MixedCoarseSectors] + +/-! +# P4616T1MixedCoarseSectors + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4616T1MixedCoarseSectors + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) : + let U : Fin 6 → ProtoTile := ![cert.P 0 true, cert.P 0 true, + cert.P 0 false, cert.P 0 false, cert.P 1 true, cert.P 1 false] + let W : Fin 6 → ProtoTile := ![cert.P 1 false, cert.P 2 false, + cert.P 1 true, cert.P 2 true, cert.P 2 false, cert.P 2 true] + let K : Fin 6 → ProtoTile := ![cert.P 0 false, cert.P 1 true, + cert.P 0 true, cert.P 1 false, cert.P 0 true, cert.P 0 false] + ∀ k (z : GaussianInt), z ∈ FootprintVertices (U k) → + z ∈ FootprintVertices (W k) → z ∈ FootprintVertices (K k) → + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ (K k).cells ∧ + LatticeVertexIncidentCell z j ∉ (U k).cells ∧ + LatticeVertexIncidentCell z j ∉ (W k).cells := by +-- BODY + classical + obtain ⟨_, _, _, _, _, _, hABO, separate⟩ := + P4339T1PrecursorSupportGeometry C q cfg T cert + have incident (N : ProtoTile) (hne : N.cells.Nonempty) + (z : GaussianInt) (hz : z ∈ FootprintVertices N) : + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ N.cells := by + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hz + rcases hz with ⟨a, ha, h | h | h | h⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using h ▸ ha⟩ + · refine ⟨1, ?_⟩; rw [h]; simpa [LatticeVertexIncidentCell] using ha + · refine ⟨3, ?_⟩; rw [h]; simpa [LatticeVertexIncidentCell] using ha + · refine ⟨2, ?_⟩ + change z - 1 - ⟨0, 1⟩ ∈ N.cells + rw [h] + convert ha using 1 + ext <;> simp + have corner (N : ProtoTile) (z : GaussianInt) (j : Fin 4) + (hj : LatticeVertexIncidentCell z j ∈ N.cells) : z ∈ FootprintVertices N := by + have hne : N.cells.Nonempty := ⟨_, hj⟩ + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] + refine ⟨LatticeVertexIncidentCell z j, hj, ?_⟩ + fin_cases j <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] + have outside (U W K : ProtoTile) (hne : K.cells.Nonempty) + (hKU : Disjoint K.cells U.cells) (hKW : Disjoint K.cells W.cells) + (z : GaussianInt) (hk : z ∈ FootprintVertices K) : + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ K.cells ∧ + LatticeVertexIncidentCell z j ∉ U.cells ∧ + LatticeVertexIncidentCell z j ∉ W.cells := by + obtain ⟨j, hj⟩ := incident K hne z hk + exact ⟨j, hj, fun h => Finset.disjoint_left.mp hKU hj h, + fun h => Finset.disjoint_left.mp hKW hj h⟩ + have noO (V : ProtoTile) (hne : V.cells.Nonempty) + (hVA : Disjoint V.cells (cert.P 0 true).cells) + (hVB : Disjoint V.cells (cert.P 0 false).cells) + (z : GaussianInt) (hz : z ∈ FootprintVertices V) : + z ∉ FootprintVertices cert.O := by + intro hzO + obtain ⟨j, hj⟩ := incident V hne z hz + have hs : z ∈ FootprintVertices + (⟨{LatticeVertexIncidentCell z j}, LatticeVertexIncidentCell z j⟩ : ProtoTile) := + corner _ z j (by simp) + have hzero : GaussianTranslation (0 : GaussianInt) = id := funext add_zero + have hi := cert.precursor_isolated 0 0 z + (by simpa [TileTranslation, hzero, Finset.image_id] using hzO) + (LatticeVertexIncidentCell z j) hs + have hi' : LatticeVertexIncidentCell z j ∈ (cert.P 0 true).cells ∨ + LatticeVertexIncidentCell z j ∈ (cert.P 0 false).cells := by + simpa [SubtileOccurrenceInterpretation, TileTranslation, hzero, Finset.image_id] using hi + exact hi'.elim (fun h => Finset.disjoint_left.mp hVA hj h) + (fun h => Finset.disjoint_left.mp hVB hj h) + have ne (i : Fin 3) (s : Bool) : (cert.P i s).cells.Nonempty := + (LatticeTileGridStructure _ (cert.parent_lattice i s)).1.1 + dsimp only + intro k z hu hw hk + fin_cases k + · dsimp at hu hw hk ⊢ + obtain ⟨j, hj⟩ := incident _ (ne 0 false) z hk + refine ⟨j, hj, ?_, fun h => Finset.disjoint_left.mp + (separate 0 false 1 false (by decide) (by decide)) hj h⟩ + intro hjA + have hjO : LatticeVertexIncidentCell z j ∈ cert.O.cells := by + rw [← hABO] + exact Finset.mem_inter.mpr ⟨hjA, hj⟩ + exact noO _ (ne 1 false) + (separate 1 false 0 true (by decide) (by decide)) + (separate 1 false 0 false (by decide) (by decide)) z hw (corner _ z j hjO) + · exact outside _ _ _ (ne 1 true) + (separate 1 true 0 true (by decide) (by decide)) + (separate 1 true 2 false (by decide) (by decide)) z hk + · dsimp at hu hw hk ⊢ + obtain ⟨j, hj⟩ := incident _ (ne 0 true) z hk + refine ⟨j, hj, ?_, fun h => Finset.disjoint_left.mp + (separate 0 true 1 true (by decide) (by decide)) hj h⟩ + intro hjB + have hjO : LatticeVertexIncidentCell z j ∈ cert.O.cells := by + rw [← hABO] + exact Finset.mem_inter.mpr ⟨hj, hjB⟩ + exact noO _ (ne 1 true) + (separate 1 true 0 true (by decide) (by decide)) + (separate 1 true 0 false (by decide) (by decide)) z hw (corner _ z j hjO) + · exact outside _ _ _ (ne 1 false) + (separate 1 false 0 false (by decide) (by decide)) + (separate 1 false 2 true (by decide) (by decide)) z hk + · exact outside _ _ _ (ne 0 true) + (separate 0 true 1 true (by decide) (by decide)) + (separate 0 true 2 false (by decide) (by decide)) z hk + · exact outside _ _ _ (ne 0 false) + (separate 0 false 1 false (by decide) (by decide)) + (separate 0 false 2 true (by decide) (by decide)) z hk + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4616T1NestedCompanionFootprints.lean b/LeanPool/ApollonianSuperharmonic/P4616T1NestedCompanionFootprints.lean new file mode 100644 index 0000000000..9afcfbb688 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4616T1NestedCompanionFootprints.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P4616T1NestedCompanionFootprints] + +/-! +# P4616T1NestedCompanionFootprints + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4616T1NestedCompanionFootprints + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) : + let a := BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) + FootprintVertices (TileTranslation (cert.P 1 true) + ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * a)) = + FootprintVertices (cert.Q 1 true) ∧ + FootprintVertices (TileTranslation (cert.P 1 false) + ((⟨0, 1⟩ : GaussianInt) * a)) = + FootprintVertices (cert.S 1 false) := by +-- BODY + have hA := (cert.outer_occurrence 0 true).2.2 + have hB := (cert.outer_occurrence 0 false).2.2 + have hC := (cert.outer_occurrence 1 true).2.2 + have hD := (cert.outer_occurrence 1 false).2.2 + have hQ := (cert.plus_occurrence 1 true).2.2 + have hS := (cert.minus_occurrence 1 false).2.2 + have hr := congrArg GaussianRealPoint + (VectorRecursionLaws + ![cfg.firstPredecessor 0, cfg.firstPredecessor 3, + cfg.firstPredecessor 1, cfg.firstPredecessor 2] + (SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate cfg.firstProper.1))).2.2.1 + have hf := congrArg GaussianRealPoint + (((VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).2.2.2.2 + cfg.firstProper 2).1) + have hQband : BandPrototile (q 2) (cert.Q 1 true) := by + simpa [cfg.firstParentTwo] using (cert.plus_occurrence 1 true).1 + have hSband : BandPrototile (q 2) (cert.S 1 false) := by + simpa [cfg.firstParentTwo] using (cert.minus_occurrence 1 false).1 + dsimp only + constructor + · obtain ⟨hc, ha⟩ := BandPrototileCentroidUnique (q 2) + (TileTranslation (cert.P 1 true) ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * + BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0))) + (cert.Q 1 true) + (BandPrototileTranslation _ _ _ (cert.outer_occurrence 1 true).1) hQband + (by + rw [(TileTranslationFormulas _ _).2.2.2.2.1] + apply Prod.ext <;> + simp [Prod.ext_iff, GaussianRealPoint, pow_succ, cfg.secondVectorOne, + cfg.firstChild, cfg.firstParentTwo, cfg.firstParentThree] at * <;> + linarith) + exact (ProtoTileObservableExtensionality _ _ hc ha).1 + · obtain ⟨hc, ha⟩ := BandPrototileCentroidUnique (q 2) + (TileTranslation (cert.P 1 false) ((⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0))) + (cert.S 1 false) + (BandPrototileTranslation _ _ _ (cert.outer_occurrence 1 false).1) hSband + (by + rw [(TileTranslationFormulas _ _).2.2.2.2.1] + apply Prod.ext <;> + simp [Prod.ext_iff, GaussianRealPoint, cfg.secondVectorOne, + cfg.firstChild, cfg.firstParentTwo, cfg.firstParentThree] at * <;> + linarith) + exact (ProtoTileObservableExtensionality _ _ hc ha).1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4616T1OriginalMixedPaths.lean b/LeanPool/ApollonianSuperharmonic/P4616T1OriginalMixedPaths.lean new file mode 100644 index 0000000000..a9b87db615 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4616T1OriginalMixedPaths.lean @@ -0,0 +1,242 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths +public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices + +-- [TABLET NODE: P4616T1OriginalMixedPaths] + +/-! +# P4616T1OriginalMixedPaths + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4616T1OriginalMixedPaths + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) : + let U : Fin 6 → ProtoTile := ![cert.P 0 true, cert.P 0 true, + cert.P 0 false, cert.P 0 false, cert.P 1 true, cert.P 1 false] + let W : Fin 6 → ProtoTile := ![cert.P 1 false, cert.P 2 false, + cert.P 1 true, cert.P 2 true, cert.P 2 false, cert.P 2 true] + let K : Fin 6 → ProtoTile := ![cert.P 0 false, cert.P 1 true, + cert.P 0 true, cert.P 1 false, cert.P 0 true, cert.P 0 false] + let H : Fin 6 → ProtoTile := ![ + TileTranslation (cert.P 0 false) (cert.u + cert.v), + TileTranslation (cert.P 0 false) cert.v, + TileTranslation (cert.P 0 true) (-cert.u - cert.v), + TileTranslation (cert.P 0 true) (-cert.v), + TileTranslation (cert.P 1 false) (-cert.u), + TileTranslation (cert.P 1 true) cert.u] + let rho := fun f : PeriodicSubtileFaceIndex => + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm f) + let p : Fin 6 → GaussianInt := ![rho ⟨.I2, 0, 0⟩, rho ⟨.I3, 0, 0⟩, + rho ⟨.I1, 0, 0⟩, rho ⟨.I4, 0, 0⟩, rho ⟨.I3, 0, 0⟩, rho ⟨.I4, 0, 0⟩] + let l : Fin 6 → GaussianInt := ![rho ⟨.J4, 0, 0⟩, rho ⟨.J2, 0, 0⟩, + rho ⟨.J3, -1, -1⟩, rho ⟨.J1, 0, -1⟩, rho ⟨.J8, 0, 0⟩, + rho ⟨.J7, 1, 0⟩] + ∀ k, SimpleGridPathBetween + (FootprintVertices (U k) ∩ FootprintVertices (W k)) + (FootprintEdges (U k) ∩ FootprintEdges (W k)) (p k) (l k) ∧ + p k ∈ FootprintVertices (K k) ∧ l k ∈ FootprintVertices (H k) := by +-- BODY + classical + let U : Fin 6 → ProtoTile := ![cert.P 0 true, cert.P 0 true, + cert.P 0 false, cert.P 0 false, cert.P 1 true, cert.P 1 false] + let W : Fin 6 → ProtoTile := ![cert.P 1 false, cert.P 2 false, + cert.P 1 true, cert.P 2 true, cert.P 2 false, cert.P 2 true] + let K : Fin 6 → ProtoTile := ![cert.P 0 false, cert.P 1 true, + cert.P 0 true, cert.P 1 false, cert.P 0 true, cert.P 0 false] + let H : Fin 6 → ProtoTile := ![ + TileTranslation (cert.P 0 false) (cert.u + cert.v), + TileTranslation (cert.P 0 false) cert.v, + TileTranslation (cert.P 0 true) (-cert.u - cert.v), + TileTranslation (cert.P 0 true) (-cert.v), + TileTranslation (cert.P 1 false) (-cert.u), + TileTranslation (cert.P 1 true) cert.u] + let rho := fun f : PeriodicSubtileFaceIndex => + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm f) + let f : Fin 6 → PeriodicSubtileFaceIndex := ![⟨.I2, 0, 0⟩, ⟨.I3, 0, 0⟩, + ⟨.I1, 0, 0⟩, ⟨.I4, 0, 0⟩, ⟨.I3, 0, 0⟩, ⟨.I4, 0, 0⟩] + let g : Fin 6 → PeriodicSubtileFaceIndex := ![⟨.J4, 0, 0⟩, ⟨.J2, 0, 0⟩, + ⟨.J3, -1, -1⟩, ⟨.J1, 0, -1⟩, ⟨.J8, 0, 0⟩, ⟨.J7, 1, 0⟩] + let a : Fin 6 → PeriodicSubtileIndex := ![⟨.A, 0, 0⟩, ⟨.A, 0, 0⟩, + ⟨.B, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, ⟨.D, 0, 0⟩] + let b : Fin 6 → PeriodicSubtileIndex := ![⟨.D, 0, 0⟩, ⟨.F, 0, 0⟩, + ⟨.C, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩, ⟨.E, 0, 0⟩] + let p : Fin 6 → GaussianInt := ![rho ⟨.I2, 0, 0⟩, rho ⟨.I3, 0, 0⟩, + rho ⟨.I1, 0, 0⟩, rho ⟨.I4, 0, 0⟩, rho ⟨.I3, 0, 0⟩, rho ⟨.I4, 0, 0⟩] + let l : Fin 6 → GaussianInt := ![rho ⟨.J4, 0, 0⟩, rho ⟨.J2, 0, 0⟩, + rho ⟨.J3, -1, -1⟩, rho ⟨.J1, 0, -1⟩, rho ⟨.J8, 0, 0⟩, + rho ⟨.J7, 1, 0⟩] + change ∀ k, SimpleGridPathBetween + (FootprintVertices (U k) ∩ FootprintVertices (W k)) + (FootprintEdges (U k) ∩ FootprintEdges (W k)) (p k) (l k) ∧ + p k ∈ FootprintVertices (K k) ∧ l k ∈ FootprintVertices (H k) + have reversePath {V : Set GaussianInt} {E : Set (Finset GaussianInt)} + {x y : GaussianInt} (hp : SimpleGridPathBetween V E x y) : + SimpleGridPathBetween V E y x := by + obtain ⟨p, hn, hl, hh, ht, hv, hs, he⟩ := hp + have reverseRaw (r : List GaussianInt) (e : Finset GaussianInt) : + (∃ u v l₁ l₂, r = l₁ ++ u :: v :: l₂ ∧ e = {u, v}) → + ∃ u v l₁ l₂, r.reverse = l₁ ++ u :: v :: l₂ ∧ e = {u, v} := by + rintro ⟨u, v, l₁, l₂, hr, he⟩ + exact ⟨v, u, l₂.reverse, l₁.reverse, by + simp [hr, List.reverse_append, List.append_assoc], by + simpa only [Finset.pair_comm] using he⟩ + refine ⟨p.reverse, List.nodup_reverse.mpr hn, by simpa using hl, + by simpa using ht, by simpa using hh, by simpa using hv, ?_, ?_⟩ + · intro u v l₁ l₂ hr + have hpform : p = l₂.reverse ++ v :: u :: l₁.reverse := by + have hr' := congrArg List.reverse hr + simpa [List.reverse_append, List.append_assoc] using hr' + rcases hs v u l₂.reverse l₁.reverse hpform with h | h | h | h + · exact Or.inr (Or.inl (by rw [h]; simp)) + · exact Or.inl (by rw [h]; simp) + · exact Or.inr (Or.inr (Or.inr (by rw [h]; simp))) + · exact Or.inr (Or.inr (Or.inl (by rw [h]; simp))) + · intro e + constructor + · exact fun h => reverseRaw p e ((he e).mp h) + · intro h + apply (he e).mpr + simpa using reverseRaw p.reverse e h + have regular := (PeriodicTileIntersectionClassification cert.modified).2 + have pathFor (a b : PeriodicSubtileIndex) (hab : a ≠ b) + (hadj : AllowedSubtileIncidence a b) (f g : PeriodicSubtileFaceIndex) + (hfg : f ≠ g) + (hf : (∃ i, SixSubtileFaceVertices f i = a) ∧ + ∃ i, SixSubtileFaceVertices f i = b) + (hg : (∃ i, SixSubtileFaceVertices g i = a) ∧ + ∃ i, SixSubtileFaceVertices g i = b) : + SimpleGridPathBetween + (FootprintVertices (cert.modified.tile a) ∩ FootprintVertices (cert.modified.tile b)) + (FootprintEdges (cert.modified.tile a) ∩ FootprintEdges (cert.modified.tile b)) + (rho f) (rho g) := by + have hadj' := (cert.modified_adjacency a b).mpr hadj + obtain ⟨_, f', g', _, _, _, allFaces, hp⟩ := + (PeriodicTileIntersectionPaths cert.modified regular a b hab).1.mpr + (cert.modified.adjacent_has_common_edge a b hadj') + have liftFace (F : PeriodicSubtileFaceIndex) + (hF : (∃ i, SixSubtileFaceVertices F i = a) ∧ + ∃ i, SixSubtileFaceVertices F i = b) : + (∃ i, cert.modified.plane.faceVertex (cert.modified_face_equiv.symm F) i = a) ∧ + ∃ i, cert.modified.plane.faceVertex (cert.modified_face_equiv.symm F) i = b := by + constructor + · obtain ⟨i, hi⟩ := hF.1 + exact ⟨i, by rw [cert.modified_face_vertices]; simpa using hi⟩ + · obtain ⟨i, hi⟩ := hF.2 + exact ⟨i, by rw [cert.modified_face_vertices]; simpa using hi⟩ + have hfc := allFaces _ (liftFace f hf) + have hgc := allFaces _ (liftFace g hg) + have hne : cert.modified_face_equiv.symm f ≠ cert.modified_face_equiv.symm g := + fun h => hfg (cert.modified_face_equiv.symm.injective h) + rw [regular.adjacent_raw_eq_edge_vertices a b hadj'] + have hpath : SimpleGridPathBetween + (CommonFootprintEdgeVertices (cert.modified.tile a) (cert.modified.tile b)) + (FootprintEdges (cert.modified.tile a) ∩ FootprintEdges (cert.modified.tile b)) + (cert.modified.rho (cert.modified_face_equiv.symm f)) + (cert.modified.rho (cert.modified_face_equiv.symm g)) := by + rcases hfc with hfc | hfc <;> rcases hgc with hgc | hgc + · exact (hne (hfc.trans hgc.symm)).elim + · simpa only [hfc, hgc] using hp + · simpa only [hfc, hgc] using reversePath hp + · exact (hne (hfc.trans hgc.symm)).elim + simpa only [cert.modified_face_points, rho] using hpath + have modifiedPath (k : Fin 6) : SimpleGridPathBetween + (FootprintVertices (cert.modified.tile (a k)) ∩ + FootprintVertices (cert.modified.tile (b k))) + (FootprintEdges (cert.modified.tile (a k)) ∩ + FootprintEdges (cert.modified.tile (b k))) (rho (f k)) (rho (g k)) := by + apply pathFor (a k) (b k) (by fin_cases k <;> decide) + · fin_cases k + · exact AllowedSubtileIncidence.AD 0 0 + · exact AllowedSubtileIncidence.AF 0 0 + · exact AllowedSubtileIncidence.BC 0 0 + · exact AllowedSubtileIncidence.BE 0 0 + · exact AllowedSubtileIncidence.CF 0 0 + · exact AllowedSubtileIncidence.DE 0 0 + · fin_cases k <;> decide + · let j : Fin 6 → Fin 3 := ![0, 0, 1, 0, 1, 1] + refine ⟨⟨j k, ?_⟩, ⟨2, ?_⟩⟩ <;> + fin_cases k <;> simp [SixSubtileFaceVertices, a, b, f, j] + · let j : Fin 6 → Fin 3 := ![0, 0, 1, 1, 0, 1] + refine ⟨⟨j k, ?_⟩, ⟨2, ?_⟩⟩ <;> + fin_cases k <;> simp [SixSubtileFaceVertices, a, b, g, j] + have hzero : GaussianTranslation (0 : GaussianInt) = id := funext add_zero + have hAtile : cert.modified.tile ⟨.A, 0, 0⟩ = + TileCellComplement (cert.P 0 true) cert.O := by + rw [cert.modified_tile] + simp [ModifiedSubtileOccurrenceInterpretation, TileTranslation, hzero] + have hAO : (TileCellComplement (cert.P 0 true) cert.O).cells.Nonempty := by + rw [← hAtile] + exact (LatticeTileGridStructure _ (cert.modified.tiles_are_disks _)).1.1 + have hOA : cert.O.cells ⊆ (cert.P 0 true).cells := by + intro z hz + exact (cert.plus_union z).mpr ⟨0, false, by simpa only [← cert.precursor_eq] using hz⟩ + obtain ⟨_, _, _, _, _, _, _, separate⟩ := + P4339T1PrecursorSupportGeometry C q cfg T cert + have isolated : ∀ z ∈ CellSupportedFootprintVertices cert.O, ∀ c : GaussianInt, + z ∈ FootprintVertices (⟨{c}, c⟩ : ProtoTile) → + c ∈ (cert.P 0 true).cells ∨ c ∈ (cert.P 0 false).cells := by + intro z hz c hc + have hzO : z ∈ FootprintVertices cert.O := by + have hne : cert.O.cells.Nonempty := by obtain ⟨w, hw, _⟩ := hz; exact ⟨w, hw⟩ + simpa [FootprintVertices, CellSupportedFootprintVertices, hne] using hz + have hh := cert.precursor_isolated 0 0 z + (by simpa [TileTranslation, hzero, Finset.image_id] using hzO) c hc + simpa [SubtileOccurrenceInterpretation, TileTranslation, hzero, Finset.image_id] using hh + have restore (i : Fin 3) (hi : i ≠ 0) : + FootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintVertices (cert.P i false) = + FootprintVertices (cert.P 0 true) ∩ FootprintVertices (cert.P i false) ∧ + FootprintEdges (TileCellComplement (cert.P 0 true) cert.O) ∩ + FootprintEdges (cert.P i false) = + FootprintEdges (cert.P 0 true) ∩ FootprintEdges (cert.P i false) := by + have hYA := separate i false 0 true (by simp [hi]) (by simp [hi]) + have hYB := separate i false 0 false (by simp [hi]) (by simp [hi]) + have hr := FootprintDeletionRetention _ _ _ _ hOA isolated hYA hYB + exact ⟨hr.2.2 (Or.inr ⟨hAO, + (LatticeTileGridStructure _ (cert.parent_lattice i false)).1.1⟩), hr.2.1⟩ + have restoreD := restore 1 (by decide) + have restoreF := restore 2 (by decide) + have faceOwner (F : PeriodicSubtileFaceIndex) (i : Fin 3) : + rho F ∈ FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (SixSubtileFaceVertices F i)) := by + have hh := cert.unmodified.core.rho_common (cert.unmodified.faceEquiv.symm F) i + rw [cert.unmodified.face_vertices] at hh + simpa only [Equiv.apply_symm_apply, cert.unmodified.tile_eq, rho] using hh + intro k + have hp : p k = rho (f k) := by fin_cases k <;> rfl + have hl : l k = rho (g k) := by fin_cases k <;> rfl + rw [hp, hl] + refine ⟨?_, ?_, ?_⟩ + · have hp := modifiedPath k + fin_cases k <;> + simpa [a, b, U, W, cert.modified_tile, ModifiedSubtileOccurrenceInterpretation, + TileTranslation, hzero, restoreD.1, restoreD.2, restoreF.1, restoreF.2] using hp + · let j : Fin 6 → Fin 3 := ![1, 1, 0, 1, 0, 0] + have hh := faceOwner (f k) (j k) + fin_cases k <;> simpa [f, j, K, SixSubtileFaceVertices, + SubtileOccurrenceInterpretation, TileTranslation, hzero] using hh + · let j : Fin 6 → Fin 3 := ![1, 1, 0, 0, 1, 0] + have hh := faceOwner (g k) (j k) + fin_cases k <;> simpa [g, j, H, SixSubtileFaceVertices, + SubtileOccurrenceInterpretation, sub_eq_add_neg] using hh + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4616T1PeriodicEndpointExclusion.lean b/LeanPool/ApollonianSuperharmonic/P4616T1PeriodicEndpointExclusion.lean new file mode 100644 index 0000000000..9a1c2c2e61 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4616T1PeriodicEndpointExclusion.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell + +-- [TABLET NODE: P4616T1PeriodicEndpointExclusion] + +/-! +# P4616T1PeriodicEndpointExclusion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4616T1PeriodicEndpointExclusion + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (S : ProtoTile) (hS : S.cells.Nonempty) (hST : S.cells ⊆ T.cells) + (m n : Int) (hmn : (m, n) ≠ (0, 0)) (x y : GaussianInt) + (hroot : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) + (hy : y ∈ FootprintVertices (TileTranslation S + ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v))) : + x ≠ y := by +-- BODY + let d := (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v + have hSep : Disjoint T.cells (TileTranslation T d).cells := by + have h := (BandOrderedGeneralPeriodicBlockCells q cfg C T cert).2 + 0 0 m n hmn.symm + have hz : GaussianTranslation (0 : GaussianInt) = id := funext add_zero + simpa [d, TileTranslation, hz, Finset.image_id] using h + have hne : (TileTranslation S d).cells.Nonempty := by + exact hS.image _ + have incident (R : ProtoTile) (z : GaussianInt) + (hne : R.cells.Nonempty) (hz : z ∈ FootprintVertices R) : + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ R.cells := by + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hz + rcases hz with ⟨a, ha, h | h | h | h⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using h ▸ ha⟩ + · refine ⟨1, ?_⟩ + rw [h] + simpa [LatticeVertexIncidentCell] using ha + · refine ⟨3, ?_⟩ + rw [h] + simpa [LatticeVertexIncidentCell] using ha + · refine ⟨2, ?_⟩ + change z - 1 - ⟨0, 1⟩ ∈ R.cells + rw [h] + convert ha using 1 + ext <;> simp + intro hxy + obtain ⟨j, hj⟩ := incident (TileTranslation S d) y hne hy + have hjT : LatticeVertexIncidentCell y j ∈ (TileTranslation T d).cells := by + exact Finset.image_subset_image hST hj + exact Finset.disjoint_left.mp hSep (by simpa [hxy] using hroot j) hjT + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4616T1ThirdOwnerPathEndpoint.lean b/LeanPool/ApollonianSuperharmonic/P4616T1ThirdOwnerPathEndpoint.lean new file mode 100644 index 0000000000..4f71662264 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4616T1ThirdOwnerPathEndpoint.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge + +-- [TABLET NODE: P4616T1ThirdOwnerPathEndpoint] + +/-! +# P4616T1ThirdOwnerPathEndpoint + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4616T1ThirdOwnerPathEndpoint (U V W : ProtoTile) + (p q vertex : GaussianInt) (vertices : Set GaussianInt) + (hU : LatticeTile U) (hV : LatticeTile V) + (hdis : Disjoint U.cells V.cells) + (hpath : SimpleGridPathBetween vertices + (FootprintEdges U ∩ FootprintEdges V) p q) + (hxv : vertex ∈ vertices) + (hthird : ∃ j : Fin 4, + LatticeVertexIncidentCell vertex j ∈ W.cells ∧ + LatticeVertexIncidentCell vertex j ∉ U.cells ∧ + LatticeVertexIncidentCell vertex j ∉ V.cells) : + vertex = p ∨ vertex = q := by +-- BODY + have hsimple : SimpleGridPath vertices (FootprintEdges U ∩ FootprintEdges V) := by + obtain ⟨l, hn, hl, _, _, hv, hs, he⟩ := hpath + exact ⟨l, hn, hl, hv, hs, he⟩ + obtain h | h | h := SimpleGridPathPointTrichotomy _ _ p q vertex hpath + (SimpleGridPathVertexIncidentEdge _ _ hsimple vertex hxv) + · exact Or.inl h + · exact Or.inr h + · have hcover := (LocalLatticeInterfaceSectors.2 U V vertex hU hV hdis h).1 + obtain ⟨j, _, hju, hjv⟩ := hthird + exact (hcover j).elim (fun hu => (hju hu).elim) (fun hv => (hjv hv).elim) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockExterior.lean b/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockExterior.lean new file mode 100644 index 0000000000..0ea7b05b27 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockExterior.lean @@ -0,0 +1,99 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3161T1AggregateComplementConnectivity + +-- [TABLET NODE: P4623T1ZeroBlockExterior] + +/-! +# P4623T1ZeroBlockExterior + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4623T1ZeroBlockExterior : + let K : Finset PeriodicSubtileIndex := + {⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, + ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} + ∀ S : Finset PeriodicSubtileIndex, + (S = K ∨ ∃ d ∈ K, S = K.erase d) → + ∀ a ∉ S, ∀ b ∉ S, + Relation.ReflTransGen + (fun x y ↦ AllowedSubtileIncidence x y ∧ x ∉ S ∧ y ∉ S) a b := by +-- BODY + classical + dsimp only + let K : Finset PeriodicSubtileIndex := + {⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, + ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} + have memK (a : PeriodicSubtileIndex) : + a ∈ K ↔ (a.first, a.second) ∈ ({(0, 0)} : Finset (Int × Int)) := by + rcases a with ⟨l, m, n⟩ + cases l <;> simp [K, PeriodicSubtileIndex.mk.injEq] + have outside (a b : PeriodicSubtileIndex) (ha : a ∉ K) (hb : b ∉ K) : + Relation.ReflTransGen + (fun x y ↦ AllowedSubtileIncidence x y ∧ x ∉ K ∧ y ∉ K) a b := by + exact Relation.ReflTransGen.mono + (fun x y e ↦ ⟨e.1, fun h ↦ e.2.1 ((memK x).mp h), + fun h ↦ e.2.2 ((memK y).mp h)⟩) a b + (P3161T1AggregateComplementConnectivity + {(0, 0), (1, 0), (0, -1)} {(0, 0)} (by decide) + (by decide) a b (fun h ↦ ha ((memK a).mpr h)) + (fun h ↦ hb ((memK b).mpr h))) + have attachment (d : PeriodicSubtileIndex) (hd : d ∈ K) : + ∃ e, e ∉ K ∧ AllowedSubtileIncidence d e := by + simp only [K, Finset.mem_insert, Finset.mem_singleton] at hd + rcases hd with rfl | rfl | rfl | rfl | rfl | rfl + · exact ⟨⟨.B, 0, 1⟩, by decide, .AB01 0 0⟩ + · exact ⟨⟨.D, -1, -1⟩, by decide, by + simpa using AllowedSubtileIncidence.BDm1m1 0 0⟩ + · exact ⟨⟨.D, -1, 0⟩, by decide, by + simpa using AllowedSubtileIncidence.CDm10 0 0⟩ + · exact ⟨⟨.F, 1, 0⟩, by decide, .DF10 0 0⟩ + · exact ⟨⟨.C, 1, 0⟩, by decide, (AllowedSubtileIncidence.CEm10 1 0).symm⟩ + · exact ⟨⟨.B, 0, 1⟩, by decide, (AllowedSubtileIncidence.BF0m1 0 1).symm⟩ + intro S hS + rcases hS with rfl | ⟨d, hd, rfl⟩ + · intro a ha b hb + exact outside a b ha hb + · let R := fun x y ↦ AllowedSubtileIncidence x y ∧ + x ∉ K.erase d ∧ y ∉ K.erase d + have lift {a b} (h : Relation.ReflTransGen + (fun x y ↦ AllowedSubtileIncidence x y ∧ x ∉ K ∧ y ∉ K) a b) : + Relation.ReflTransGen R a b := + Relation.ReflTransGen.mono + (fun x y e ↦ ⟨e.1, fun h ↦ e.2.1 (Finset.mem_of_mem_erase h), + fun h ↦ e.2.2 (Finset.mem_of_mem_erase h)⟩) a b h + have attach (a : PeriodicSubtileIndex) (ha : a ∉ K.erase d) : + ∃ e, e ∉ K ∧ Relation.ReflTransGen R a e := by + by_cases h : a ∈ K + · have had : a = d := by + by_contra hne + exact ha (Finset.mem_erase.mpr ⟨hne, h⟩) + subst a + obtain ⟨e, he, hde⟩ := attachment d hd + exact ⟨e, he, .single ⟨hde, ha, + fun h ↦ he (Finset.mem_of_mem_erase h)⟩⟩ + · exact ⟨a, h, .refl⟩ + intro a ha b hb + obtain ⟨a', ha', hpa⟩ := attach a ha + obtain ⟨b', hb', hpb⟩ := attach b hb + have reverse : Relation.ReflTransGen R b' b := by + clear hb' + induction hpb with + | refl => exact .refl + | tail _ e ih => exact (Relation.ReflTransGen.single ⟨e.1.symm, e.2.2, e.2.1⟩).trans ih + exact hpa.trans ((lift (outside a' b' ha' hb')).trans reverse) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockLinks.lean b/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockLinks.lean new file mode 100644 index 0000000000..4da508a4ef --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockLinks.lean @@ -0,0 +1,129 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import Mathlib.Tactic.FinCases + +-- [TABLET NODE: P4623T1ZeroBlockLinks] + +/-! +# P4623T1ZeroBlockLinks + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4623T1ZeroBlockLinks : + let K : Finset PeriodicSubtileIndex := + {⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, + ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} + ∀ d ∈ K, ∃ (n : Nat) (neighbor : Fin n → PeriodicSubtileIndex) + (face : Fin (n + 1) → PeriodicSubtileFaceIndex), + 0 < n ∧ Function.Injective neighbor ∧ Function.Injective face ∧ + (∀ b, b ∈ K.erase d ∧ AllowedSubtileIncidence d b ↔ + ∃ k, neighbor k = b) ∧ + ∀ k, + (∃ i, SixSubtileFaceVertices (face (Fin.castSucc k)) i = d) ∧ + (∃ i, SixSubtileFaceVertices (face (Fin.castSucc k)) i = neighbor k) ∧ + (∃ i, SixSubtileFaceVertices (face k.succ) i = d) ∧ + (∃ i, SixSubtileFaceVertices (face k.succ) i = neighbor k) := by +-- BODY + classical + dsimp only + let K : Finset PeriodicSubtileIndex := + {⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, + ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} + let central : SixSubtileLabel → SixSubtileLabel → Prop := fun a b ↦ + match a, b with + | .A, .B | .B, .A | .A, .C | .C, .A | .A, .D | .D, .A + | .A, .F | .F, .A | .B, .C | .C, .B | .B, .D | .D, .B + | .B, .E | .E, .B | .C, .F | .F, .C | .D, .E | .E, .D => True + | _, _ => False + have reverse (a b) : central a b → central b a := by + cases a <;> cases b <;> decide + have bound {a b : PeriodicSubtileIndex} (h : AllowedSubtileIncidence a b) : + a.first = 0 → a.second = 0 → b.first = 0 → b.second = 0 → + central a.label b.label := by + induction h with + | symm h ih => + intro ha hn hb hm + exact reverse _ _ (ih hb hm ha hn) + | AB m n | AB01 m n | AB11 m n | AC m n | AC11 m n + | AD m n | AE01 m n | AF m n | BC m n | BDm1m1 m n + | BD m n | BE m n | BF0m1 m n | CDm10 m n | CEm10 m n + | CF m n | DE m n | DF10 m n => + dsimp [central] + intros + first | trivial | omega + have adjzero (a b : SixSubtileLabel) : + AllowedSubtileIncidence ⟨a, 0, 0⟩ ⟨b, 0, 0⟩ ↔ central a b := by + constructor + · intro h + exact bound h rfl rfl rfl rfl + · intro h + cases a <;> cases b <;> dsimp [central] at h + all_goals first + | exact AllowedSubtileIncidence.AB 0 0 + | exact (AllowedSubtileIncidence.AB 0 0).symm + | exact AllowedSubtileIncidence.AC 0 0 + | exact (AllowedSubtileIncidence.AC 0 0).symm + | exact AllowedSubtileIncidence.AD 0 0 + | exact (AllowedSubtileIncidence.AD 0 0).symm + | exact AllowedSubtileIncidence.AF 0 0 + | exact (AllowedSubtileIncidence.AF 0 0).symm + | exact AllowedSubtileIncidence.BC 0 0 + | exact (AllowedSubtileIncidence.BC 0 0).symm + | exact AllowedSubtileIncidence.BD 0 0 + | exact (AllowedSubtileIncidence.BD 0 0).symm + | exact AllowedSubtileIncidence.BE 0 0 + | exact (AllowedSubtileIncidence.BE 0 0).symm + | exact AllowedSubtileIncidence.CF 0 0 + | exact (AllowedSubtileIncidence.CF 0 0).symm + | exact AllowedSubtileIncidence.DE 0 0 + | exact (AllowedSubtileIncidence.DE 0 0).symm + intro d hd + simp only [Finset.mem_insert, Finset.mem_singleton] at hd + rcases hd with rfl | rfl | rfl | rfl | rfl | rfl + all_goals first + | refine ⟨4, ![⟨.D, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, ⟨.F, 0, 0⟩], + ![⟨.J4, 0, 0⟩, ⟨.I2, 0, 0⟩, ⟨.I1, 0, 0⟩, ⟨.I3, 0, 0⟩, + ⟨.J2, 0, 0⟩], by decide, by decide, by decide, ?_, by decide⟩ + | refine ⟨4, ![⟨.C, 0, 0⟩, ⟨.A, 0, 0⟩, ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩], + ![⟨.J3, -1, -1⟩, ⟨.I1, 0, 0⟩, ⟨.I2, 0, 0⟩, ⟨.I4, 0, 0⟩, + ⟨.J1, 0, -1⟩], by decide, by decide, by decide, ?_, by decide⟩ + | refine ⟨3, ![⟨.B, 0, 0⟩, ⟨.A, 0, 0⟩, ⟨.F, 0, 0⟩], + ![⟨.J3, -1, -1⟩, ⟨.I1, 0, 0⟩, ⟨.I3, 0, 0⟩, ⟨.J8, 0, 0⟩], + by decide, by decide, by decide, ?_, by decide⟩ + | refine ⟨3, ![⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.E, 0, 0⟩], + ![⟨.J4, 0, 0⟩, ⟨.I2, 0, 0⟩, ⟨.I4, 0, 0⟩, ⟨.J7, 1, 0⟩], + by decide, by decide, by decide, ?_, by decide⟩ + | refine ⟨2, ![⟨.B, 0, 0⟩, ⟨.D, 0, 0⟩], + ![⟨.J1, 0, -1⟩, ⟨.I4, 0, 0⟩, ⟨.J7, 1, 0⟩], + by decide, by decide, by decide, ?_, by decide⟩ + | refine ⟨2, ![⟨.A, 0, 0⟩, ⟨.C, 0, 0⟩], + ![⟨.J2, 0, 0⟩, ⟨.I3, 0, 0⟩, ⟨.J8, 0, 0⟩], + by decide, by decide, by decide, ?_, by decide⟩ + all_goals + intro b + by_cases hb : b ∈ K + · simp only [K, Finset.mem_insert, Finset.mem_singleton] at hb + rcases hb with rfl | rfl | rfl | rfl | rfl | rfl + all_goals rw [adjzero]; decide + · constructor + · intro h + exact (hb (Finset.mem_of_mem_erase h.1)).elim + · rintro ⟨k, rfl⟩ + exact (hb (by fin_cases k <;> decide)).elim + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockPaths.lean b/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockPaths.lean new file mode 100644 index 0000000000..0d5e761b4d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockPaths.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import Mathlib.Logic.Relation + +-- [TABLET NODE: P4623T1ZeroBlockPaths] + +/-! +# P4623T1ZeroBlockPaths + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4623T1ZeroBlockPaths : + let K : Finset PeriodicSubtileIndex := + {⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, + ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} + ∀ S : Finset PeriodicSubtileIndex, + (S = K ∨ ∃ d ∈ K, S = K.erase d) → + ∀ a ∈ S, ∀ b ∈ S, + Relation.ReflTransGen + (fun x y ↦ AllowedSubtileIncidence x y ∧ x ∈ S ∧ y ∈ S) a b := by +-- BODY + classical + dsimp only + let K : Finset PeriodicSubtileIndex := + {⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, + ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} + have reverse {S : Finset PeriodicSubtileIndex} {a b} + (h : Relation.ReflTransGen + (fun x y ↦ AllowedSubtileIncidence x y ∧ x ∈ S ∧ y ∈ S) a b) : + Relation.ReflTransGen + (fun x y ↦ AllowedSubtileIncidence x y ∧ x ∈ S ∧ y ∈ S) b a := by + induction h with + | refl => exact .refl + | tail _ e ih => exact (Relation.ReflTransGen.single ⟨e.1.symm, e.2.2, e.2.1⟩).trans ih + have tree (S : Finset PeriodicSubtileIndex) (root : PeriodicSubtileIndex) + (hroot : ∀ a ∈ S, Relation.ReflTransGen + (fun x y ↦ AllowedSubtileIncidence x y ∧ x ∈ S ∧ y ∈ S) a root) : + ∀ a ∈ S, ∀ b ∈ S, Relation.ReflTransGen + (fun x y ↦ AllowedSubtileIncidence x y ∧ x ∈ S ∧ y ∈ S) a b := by + intro a ha b hb + exact (hroot a ha).trans (reverse (hroot b hb)) + have edge (S : Finset PeriodicSubtileIndex) (a b : PeriodicSubtileIndex) + (e : AllowedSubtileIncidence a b) (ha : a ∈ S) (hb : b ∈ S) : + Relation.ReflTransGen + (fun x y ↦ AllowedSubtileIncidence x y ∧ x ∈ S ∧ y ∈ S) a b := + .single ⟨e, ha, hb⟩ + intro S hS + rcases hS with rfl | ⟨d, hd, rfl⟩ + · apply tree K ⟨.A, 0, 0⟩ + intro a ha + simp only [K, Finset.mem_insert, Finset.mem_singleton] at ha + rcases ha with rfl | rfl | rfl | rfl | rfl | rfl + · exact .refl + · exact edge _ _ _ (AllowedSubtileIncidence.AB 0 0).symm (by decide) (by decide) + · exact edge _ _ _ (AllowedSubtileIncidence.AC 0 0).symm (by decide) (by decide) + · exact edge _ _ _ (AllowedSubtileIncidence.AD 0 0).symm (by decide) (by decide) + · exact (edge _ _ _ (AllowedSubtileIncidence.BE 0 0).symm (by decide) (by decide)).trans + (edge _ _ _ (AllowedSubtileIncidence.AB 0 0).symm (by decide) (by decide)) + · exact edge _ _ _ (AllowedSubtileIncidence.AF 0 0).symm (by decide) (by decide) + · simp only [Finset.mem_insert, Finset.mem_singleton] at hd + rcases hd with rfl | rfl | rfl | rfl | rfl | rfl + · apply tree _ ⟨.B, 0, 0⟩ + intro a ha + simp only [Finset.mem_erase, Finset.mem_insert, + Finset.mem_singleton] at ha + rcases ha with ⟨hne, rfl | rfl | rfl | rfl | rfl | rfl⟩ + · exact (hne rfl).elim + · exact .refl + · exact edge _ _ _ (AllowedSubtileIncidence.BC 0 0).symm (by decide) (by decide) + · exact edge _ _ _ (AllowedSubtileIncidence.BD 0 0).symm (by decide) (by decide) + · exact edge _ _ _ (AllowedSubtileIncidence.BE 0 0).symm (by decide) (by decide) + · exact (edge _ _ _ (AllowedSubtileIncidence.CF 0 0).symm (by decide) (by decide)).trans + (edge _ _ _ (AllowedSubtileIncidence.BC 0 0).symm (by decide) (by decide)) + · apply tree _ ⟨.A, 0, 0⟩ + intro a ha + simp only [Finset.mem_erase, Finset.mem_insert, + Finset.mem_singleton] at ha + rcases ha with ⟨hne, rfl | rfl | rfl | rfl | rfl | rfl⟩ + · exact .refl + · exact (hne rfl).elim + · exact edge _ _ _ (AllowedSubtileIncidence.AC 0 0).symm (by decide) (by decide) + · exact edge _ _ _ (AllowedSubtileIncidence.AD 0 0).symm (by decide) (by decide) + · exact (edge _ _ _ (AllowedSubtileIncidence.DE 0 0).symm (by decide) (by decide)).trans + (edge _ _ _ (AllowedSubtileIncidence.AD 0 0).symm (by decide) (by decide)) + · exact edge _ _ _ (AllowedSubtileIncidence.AF 0 0).symm (by decide) (by decide) + all_goals + apply tree _ ⟨.A, 0, 0⟩ + intro a ha + simp only [Finset.mem_erase, Finset.mem_insert, + Finset.mem_singleton] at ha + rcases ha with ⟨hne, rfl | rfl | rfl | rfl | rfl | rfl⟩ + all_goals first + | exact (hne rfl).elim + | exact .refl + | exact edge _ _ _ (AllowedSubtileIncidence.AB 0 0).symm (by decide) (by decide) + | exact edge _ _ _ (AllowedSubtileIncidence.AC 0 0).symm (by decide) (by decide) + | exact edge _ _ _ (AllowedSubtileIncidence.AD 0 0).symm (by decide) (by decide) + | exact edge _ _ _ (AllowedSubtileIncidence.AF 0 0).symm (by decide) (by decide) + | exact (edge _ _ _ (AllowedSubtileIncidence.BE 0 0).symm (by decide) (by decide)).trans + (edge _ _ _ (AllowedSubtileIncidence.AB 0 0).symm (by decide) (by decide)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4630T1AffineCellSymmetry.lean b/LeanPool/ApollonianSuperharmonic/P4630T1AffineCellSymmetry.lean new file mode 100644 index 0000000000..27916e68bd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4630T1AffineCellSymmetry.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P4630T1AffineCellSymmetry] + +/-! +# P4630T1AffineCellSymmetry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4630T1AffineCellSymmetry (T : ProtoTile) (t : GaussianInt) + (hne : T.cells.Nonempty) + (h : T.cells.image (fun x => GaussianQuarterTurn x - 1 + t) = T.cells) : + QuarterTurnSymmetric T := by +-- BODY + classical + let U := TileTranslation (TileQuarterTurn T) t + have cells : U.cells = T.cells := by + change (T.cells.image (fun x => GaussianQuarterTurn x - 1)).image + (GaussianTranslation t) = T.cells + simpa only [Finset.image_image, Function.comp_def, GaussianTranslation] using h + have cent : TileCentroid U = TileCentroid T := by + simp only [TileCentroid, cells, ite_eq_left hne] + have real : TileRealization U = TileRealization T := by + simp only [TileRealization, cells] + have hc := cent + rw [(TileTranslationFormulas (TileQuarterTurn T) t).2.2.2.2.1, + (TileQuarterTurnFormulas T).2.2.2.2.1] at hc + have hcr := congrArg Prod.fst hc + have hci := congrArg Prod.snd hc + dsimp at hcr hci + have image : + (fun p : Real × Real => + ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), + (TileCentroid T).2 + (p.1 - (TileCentroid T).1))) '' + TileRealization T = TileRealization T := by + calc + _ = (fun p : Real × Real => (-p.2 + (t.re : Real), + p.1 + (t.im : Real))) '' TileRealization T := by + apply congrArg (fun f : (Real × Real) → Real × Real => + f '' TileRealization T) + funext p + apply Prod.ext <;> dsimp <;> linarith + _ = TileRealization U := by + rw [(TileTranslationFormulas (TileQuarterTurn T) t).2.2.2.1, + (TileQuarterTurnFormulas T).2.2.2.1, Set.image_image] + _ = TileRealization T := real + intro p + constructor + · intro hp + rw [← image] + exact ⟨p, hp, rfl⟩ + · intro hp + rw [← image] at hp + obtain ⟨z, hz, he⟩ := hp + have he₁ := congrArg Prod.fst he + have he₂ := congrArg Prod.snd he + have heq : z = p := by + apply Prod.ext <;> dsimp at he₁ he₂ ⊢ <;> linarith + simpa only [heq] using hz + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4630T1CellRouteLift.lean b/LeanPool/ApollonianSuperharmonic/P4630T1CellRouteLift.lean new file mode 100644 index 0000000000..6abbe8301a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4630T1CellRouteLift.lean @@ -0,0 +1,491 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.P4630T1RingIndex +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import Mathlib.Data.List.Chain +public import Mathlib.Logic.Relation + +-- [TABLET NODE: P4630T1CellRouteLift] + +/-! +# P4630T1CellRouteLift + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CellRouteGeometry + +private theorem op : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (x : LatticeCell), (x ∈ cert.O.cells) → (x ∈ (cert.P 0 true).cells) ) := by + classical + intro q cfg C₀ T cert x hx + apply (cert.plus_union x).mpr + exact ⟨0, false, by simpa only [← cert.precursor_eq] using hx⟩ + +private theorem om : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (x : LatticeCell), (x ∈ cert.O.cells) → (x ∈ (cert.P 0 false).cells) ) := by + classical + intro q cfg C₀ T cert x hx + apply (cert.minus_union x).mpr + exact ⟨0, true, by simpa only [← cert.precursor_cells] using hx⟩ + +private theorem original : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let shift := fun a : PeriodicSubtileIndex => + (a.first : GaussianInt) * cert.u + (a.second : GaussianInt) * cert.v + let O := fun a : PeriodicSubtileIndex => TileTranslation cert.O (shift a) + (∀ (x : LatticeCell), (x ∈ cert.O.cells) → (x ∈ (cert.P 0 false).cells)) → (∀ (a : + PeriodicSubtileIndex), ∀ (x : LatticeCell), (x ∈ (SubtileOccurrenceInterpretation + cert.P cert.u cert.v a).cells) → (x ∈ (cert.modified.tile a).cells ∨ a.label = .A ∧ x + ∈ (O a).cells ∧ x ∈ (cert.modified.tile ⟨.B, a.first, a.second⟩).cells)) ) := by + classical + intro q cfg C₀ T cert shift O om a x hx + rcases a with ⟨l, m, n⟩ + cases l + · simp only [SubtileOccurrenceInterpretation, TileTranslation] at hx + obtain ⟨y, hy, he⟩ := Finset.mem_image.mp hx + by_cases ho : y ∈ cert.O.cells + · right + refine ⟨rfl, Finset.mem_image.mpr ⟨y, ho, he⟩, ?_⟩ + rw [cert.modified_tile] + exact Finset.mem_image.mpr ⟨y, om y ho, he⟩ + · left + rw [cert.modified_tile] + exact Finset.mem_image.mpr ⟨y, Finset.mem_sdiff.mpr ⟨hy, ho⟩, he⟩ + all_goals + left + simpa only [cert.modified_tile, ModifiedSubtileOccurrenceInterpretation, + SubtileOccurrenceInterpretation, TileTranslation] using hx + +private theorem dirty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let safe := fun a : PeriodicSubtileIndex => + ¬ (a.first = 0 ∧ a.second = 0) ∧ ∀ i, ∀ k, a ≠ P4630T1RingIndex i k + let shift := fun a : PeriodicSubtileIndex => + (a.first : GaussianInt) * cert.u + (a.second : GaussianInt) * cert.v + let clean := fun x : LatticeCell => ∀ i, ∀ k, x ∉ (SubtileOccurrenceInterpretation cert.P + cert.u cert.v (P4630T1RingIndex i k)).cells + let O := fun a : PeriodicSubtileIndex => TileTranslation cert.O (shift a) + (∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (cert.modified.tile a).cells) → + ((∀ (a : PeriodicSubtileIndex), ∀ (x : LatticeCell), (x ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells) → (x ∈ + (cert.modified.tile a).cells ∨ a.label = .A ∧ x ∈ (O a).cells ∧ x ∈ + (cert.modified.tile ⟨.B, a.first, a.second⟩).cells)) → (∀ (a : PeriodicSubtileIndex), + (safe a) → (∀ (x : LatticeCell), (x ∈ (cert.modified.tile a).cells) → ((¬ clean x) → + (∃ i k, (P4630T1RingIndex i k).label = .A ∧ a = ⟨.B, (P4630T1RingIndex i + k).first, (P4630T1RingIndex i k).second⟩ ∧ x ∈ (O (P4630T1RingIndex i + k)).cells))))) ) := by + classical + intro q cfg C₀ T cert safe shift clean O indexed original a ha x hx h + obtain ⟨i, hi⟩ := not_forall.mp h + obtain ⟨k, hk⟩ := not_forall.mp hi + have hi' : x ∈ (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4630T1RingIndex i k)).cells := not_not.mp hk + rcases original _ x hi' with hmod | ⟨hl, hO, hB⟩ + · exact False.elim (ha.2 i k ((indexed x).unique hx hmod)) + · exact ⟨i, k, hl, (indexed x).unique hx hB, hO⟩ + +private theorem clean_B : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let safe := fun a : PeriodicSubtileIndex => + ¬ (a.first = 0 ∧ a.second = 0) ∧ ∀ i, ∀ k, a ≠ P4630T1RingIndex i k + let shift := fun a : PeriodicSubtileIndex => + (a.first : GaussianInt) * cert.u + (a.second : GaussianInt) * cert.v + let clean := fun x : LatticeCell => ∀ i, ∀ k, x ∉ (SubtileOccurrenceInterpretation cert.P + cert.u cert.v (P4630T1RingIndex i k)).cells + let O := fun a : PeriodicSubtileIndex => TileTranslation cert.O (shift a) + (∀ (x : LatticeCell), (x ∈ cert.O.cells) → (x ∈ (cert.P 0 true).cells)) → ((∀ (a : + PeriodicSubtileIndex), (safe a) → (∀ (x : LatticeCell), (x ∈ (cert.modified.tile + a).cells) → ((¬ clean x) → (∃ i k, (P4630T1RingIndex i k).label = .A ∧ a = ⟨.B, + (P4630T1RingIndex i k).first, (P4630T1RingIndex i k).second⟩ ∧ x ∈ (O + (P4630T1RingIndex i k)).cells)))) → (∀ (m : Int), ∀ (n : Int), (safe ⟨.B, m, n⟩) → + ((∃ i k, P4630T1RingIndex i k = ⟨.A, m, n⟩) → (∀ (x : LatticeCell), (x ∈ + (cert.modified.tile ⟨.B, m, n⟩).cells) → (clean x ↔ x ∉ (TileTranslation cert.O ((m : + GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells))))) ) := by + classical + intro q cfg C₀ T cert safe shift clean O op dirty m n ha hA x hx + constructor + · intro hc hO + obtain ⟨i, k, he⟩ := hA + apply hc i k + rw [he] + obtain ⟨y, hy, hxy⟩ := Finset.mem_image.mp hO + exact Finset.mem_image.mpr ⟨y, op y hy, hxy⟩ + · intro hO + by_contra hc + obtain ⟨i, k, _, he, hmem⟩ := dirty _ ha x hx hc + have hm := congrArg PeriodicSubtileIndex.first he + have hn := congrArg PeriodicSubtileIndex.second he + dsimp at hm hn + apply hO + simpa only [O, shift, ← hm, ← hn] using hmem + +private theorem disk_B : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let safe := fun a : PeriodicSubtileIndex => + ¬ (a.first = 0 ∧ a.second = 0) ∧ ∀ i, ∀ k, a ≠ P4630T1RingIndex i k + let clean := fun x : LatticeCell => ∀ i, ∀ k, x ∉ (SubtileOccurrenceInterpretation cert.P + cert.u cert.v (P4630T1RingIndex i k)).cells + let V := fun a : PeriodicSubtileIndex => + (⟨(cert.modified.tile a).cells.filter clean, (cert.modified.tile a).anchor⟩ : ProtoTile) + (∀ (m : Int), ∀ (n : Int), (safe ⟨.B, m, n⟩) → ((∃ i k, P4630T1RingIndex i k = ⟨.A, m, + n⟩) → (∀ (x : LatticeCell), (x ∈ (cert.modified.tile ⟨.B, m, n⟩).cells) → (clean x ↔ + x ∉ (TileTranslation cert.O ((m : GaussianInt) * cert.u + (n : GaussianInt) * + cert.v)).cells)))) → (∀ (m : Int), ∀ (n : Int), (safe ⟨.B, m, n⟩) → ((∃ i k, + P4630T1RingIndex i k = ⟨.A, m, n⟩) → (LatticeTile (V ⟨.B, m, n⟩)))) ) := by + classical + intro q cfg C₀ T cert safe clean V clean_B m n ha hA + let D := TileTranslation (TileCellComplement (cert.P 0 false) cert.O) + ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v) + have cells : (V ⟨.B, m, n⟩).cells = D.cells := by + ext x + simp only [V, Finset.mem_filter] + rw [and_congr_right (fun hx => clean_B m n ha hA x hx)] + rw [cert.modified_tile] + change x ∈ ((cert.P 0 false).cells.image (GaussianTranslation _)) ∧ + x ∉ (cert.O.cells.image (GaussianTranslation _)) ↔ + x ∈ (((cert.P 0 false).cells \ cert.O.cells).image (GaussianTranslation _)) + rw [Finset.image_sdiff _ _ (show Function.Injective (GaussianTranslation + ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)) from + fun a b h => add_right_cancel h), Finset.mem_sdiff] + have hd : LatticeTile D := + (TileDiskAreaCovariance _ _).1.mp cert.precursor_complement_lattice.2 + change TopologicalDisk (TileRealization (V ⟨.B, m, n⟩)) + simpa only [LatticeTile, TileRealization, cells] using hd + +private theorem disk : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let safe := fun a : PeriodicSubtileIndex => + ¬ (a.first = 0 ∧ a.second = 0) ∧ ∀ i, ∀ k, a ≠ P4630T1RingIndex i k + let shift := fun a : PeriodicSubtileIndex => + (a.first : GaussianInt) * cert.u + (a.second : GaussianInt) * cert.v + let clean := fun x : LatticeCell => ∀ i, ∀ k, x ∉ (SubtileOccurrenceInterpretation cert.P + cert.u cert.v (P4630T1RingIndex i k)).cells + let O := fun a : PeriodicSubtileIndex => TileTranslation cert.O (shift a) + let V := fun a : PeriodicSubtileIndex => + (⟨(cert.modified.tile a).cells.filter clean, (cert.modified.tile a).anchor⟩ : ProtoTile) + (∀ (a : PeriodicSubtileIndex), (safe a) → (∀ (x : LatticeCell), (x ∈ (cert.modified.tile + a).cells) → ((¬ clean x) → (∃ i k, (P4630T1RingIndex i k).label = .A ∧ a = ⟨.B, + (P4630T1RingIndex i k).first, (P4630T1RingIndex i k).second⟩ ∧ x ∈ (O + (P4630T1RingIndex i k)).cells)))) → ((∀ (m : Int), ∀ (n : Int), (safe ⟨.B, m, n⟩) → + ((∃ i k, P4630T1RingIndex i k = ⟨.A, m, n⟩) → (LatticeTile (V ⟨.B, m, n⟩)))) → (∀ + (a : PeriodicSubtileIndex), (safe a) → (LatticeTile (V a)))) ) := by + classical + intro q cfg C₀ T cert safe shift clean O V dirty disk_B a ha + by_cases h₁ : a = ⟨.B, -1, -1⟩ + · subst a + exact disk_B (-1) (-1) ha ⟨0, 0, rfl⟩ + by_cases h₂ : a = ⟨.B, 0, -1⟩ + · subst a + exact disk_B 0 (-1) ha ⟨0, 1, rfl⟩ + have cells : (V a).cells = (cert.modified.tile a).cells := by + apply Finset.filter_eq_self.mpr + intro x hx + by_contra hc + obtain ⟨i, k, hl, he, _⟩ := dirty a ha x hx hc + fin_cases i <;> fin_cases k <;> + simp? [P4630T1RingIndex] at hl he + · exact h₁ he + · exact h₂ he + change TopologicalDisk (TileRealization (V a)) + simpa only [LatticeTile, TileRealization, cells] using cert.modified.tiles_are_disks a + +private theorem corner : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (p : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell p j ∈ + U.cells) → (p ∈ FootprintVertices U) ) := by + classical + intro U p j hx + rw [FootprintVertices, ite_eq_left ⟨_, hx⟩] + refine ⟨_, hx, ?_⟩ + fin_cases j <;> simp only [LatticeVertexIncidentCell, + ] + · exact Or.inl rfl + · exact Or.inr (Or.inl (by change p = (p - 1) + 1; abel)) + · exact Or.inr (Or.inr (Or.inr (by + change p = (p - 1 - ⟨0, 1⟩) + 1 + ⟨0, 1⟩; abel))) + · exact Or.inr (Or.inr (Or.inl (by change p = (p - ⟨0, 1⟩) + ⟨0, 1⟩; abel))) + +private theorem crossing_clean : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let safe := fun a : PeriodicSubtileIndex => + ¬ (a.first = 0 ∧ a.second = 0) ∧ ∀ i, ∀ k, a ≠ P4630T1RingIndex i k + let shift := fun a : PeriodicSubtileIndex => + (a.first : GaussianInt) * cert.u + (a.second : GaussianInt) * cert.v + let clean := fun x : LatticeCell => ∀ i, ∀ k, x ∉ (SubtileOccurrenceInterpretation cert.P + cert.u cert.v (P4630T1RingIndex i k)).cells + let O := fun a : PeriodicSubtileIndex => TileTranslation cert.O (shift a) + (∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (cert.modified.tile a).cells) → + ((∀ (a : PeriodicSubtileIndex), ∀ (x : LatticeCell), (x ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells) → (x ∈ + (cert.modified.tile a).cells ∨ a.label = .A ∧ x ∈ (O a).cells ∧ x ∈ + (cert.modified.tile ⟨.B, a.first, a.second⟩).cells)) → ((∀ (a : + PeriodicSubtileIndex), (safe a) → (∀ (x : LatticeCell), (x ∈ (cert.modified.tile + a).cells) → ((¬ clean x) → (∃ i k, (P4630T1RingIndex i k).label = .A ∧ a = ⟨.B, + (P4630T1RingIndex i k).first, (P4630T1RingIndex i k).second⟩ ∧ x ∈ (O + (P4630T1RingIndex i k)).cells)))) → ((∀ (U : ProtoTile), ∀ (p : GaussianInt), ∀ (j + : Fin 4), (LatticeVertexIncidentCell p j ∈ U.cells) → (p ∈ FootprintVertices U)) → (∀ + (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (safe a) → ((safe b) → ((a + ≠ b) → (∀ (p : GaussianInt), ∀ (j : Fin 4), ∀ (k : Fin 4), (LatticeVertexIncidentCell + p j ∈ (cert.modified.tile a).cells) → ((LatticeVertexIncidentCell p k ∈ + (cert.modified.tile b).cells) → (clean (LatticeVertexIncidentCell p j)))))))))) ) := by + classical + intro q cfg C₀ T cert safe shift clean O indexed original dirty corner a b ha hb hab p j k hx hy + by_contra hc + obtain ⟨i, l, hlabel, he, hO⟩ := dirty a ha _ hx hc + have hp := corner _ p j hO + have hp' : p ∈ FootprintVertices + (⟨{LatticeVertexIncidentCell p k}, LatticeVertexIncidentCell p k⟩ : ProtoTile) := + corner _ p k (by simp) + have isolated := cert.precursor_isolated _ _ p hp _ hp' + rcases isolated with hA | hB + · rcases original _ _ hA with hmod | ⟨_, _, hmod⟩ + · have eq : b = P4630T1RingIndex i l := by + have hidx : (⟨.A, (P4630T1RingIndex i l).first, + (P4630T1RingIndex i l).second⟩ : PeriodicSubtileIndex) = + P4630T1RingIndex i l := by + cases hval : P4630T1RingIndex i l + simp_all + exact ((indexed _).unique hy hmod).trans hidx + exact hb.2 i l eq + · exact hab (he.trans ((indexed _).unique hy hmod).symm) + · have hmod : LatticeVertexIncidentCell p k ∈ + (cert.modified.tile ⟨.B, (P4630T1RingIndex i l).first, + (P4630T1RingIndex i l).second⟩).cells := by + simpa only [cert.modified_tile, ModifiedSubtileOccurrenceInterpretation, + SubtileOccurrenceInterpretation] using hB + exact hab (he.trans ((indexed _).unique hy hmod).symm) + +private theorem symmetry : + (by + classical + exact + ∀ {x : LatticeCell}, ∀ {y : LatticeCell}, FourNeighborAdjacent x y → FourNeighborAdjacent + y x ) := by + classical + intro x y h + rcases h with h | h | h | h + all_goals subst y + all_goals simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + +private theorem step : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let safe := fun a : PeriodicSubtileIndex => + ¬ (a.first = 0 ∧ a.second = 0) ∧ ∀ i, ∀ k, a ≠ P4630T1RingIndex i k + let clean := fun x : LatticeCell => ∀ i, ∀ k, x ∉ (SubtileOccurrenceInterpretation cert.P + cert.u cert.v (P4630T1RingIndex i k)).cells + let V := fun a : PeriodicSubtileIndex => + (⟨(cert.modified.tile a).cells.filter clean, (cert.modified.tile a).anchor⟩ : ProtoTile) + let E := fun c d => AllowedSubtileIncidence c d ∧ safe c ∧ safe d + (∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (cert.modified.tile a).cells) → + ((∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (safe a) → ((safe b) → + ((a ≠ b) → (∀ (p : GaussianInt), ∀ (j : Fin 4), ∀ (k : Fin 4), + (LatticeVertexIncidentCell p j ∈ (cert.modified.tile a).cells) → + ((LatticeVertexIncidentCell p k ∈ (cert.modified.tile b).cells) → (clean + (LatticeVertexIncidentCell p j))))))) → ((∀ {x : LatticeCell}, ∀ {y : LatticeCell}, + FourNeighborAdjacent x y → FourNeighborAdjacent y x) → (∀ {a : PeriodicSubtileIndex}, + ∀ {b : PeriodicSubtileIndex}, (E a b) → (∃ x ∈ (V a).cells, ∃ y ∈ (V b).cells, + FourNeighborAdjacent x y)))) ) := by + classical + intro q cfg C₀ T cert safe clean V E indexed crossing_clean symmetry a b e + have adj := (cert.modified_adjacency a b).mpr e.1 + have hab : a ≠ b := by rintro rfl; exact cert.modified.plane.adjacent_irreflexive _ adj + obtain ⟨edge, h₁, h₂⟩ := cert.modified.adjacent_has_common_edge a b adj + have hene : edge.Nonempty := by + obtain ⟨x, _, h | h | h | h⟩ := h₁ + all_goals rw [h]; simp + obtain ⟨p, hp⟩ := hene + have disjoint : Disjoint (cert.modified.tile a).cells (cert.modified.tile b).cells := + Finset.disjoint_left.mpr (fun x hx hy => hab ((indexed x).unique hx hy)) + obtain ⟨j, _, hsector⟩ := P3102T2CommonEdgeSectorTransition _ _ p edge disjoint hp ⟨h₁, h₂⟩ + have adjacent (j : Fin 4) : FourNeighborAdjacent (LatticeVertexIncidentCell p j) + (LatticeVertexIncidentCell p (j + 1)) := by + fin_cases j <;> simp [FourNeighborAdjacent, LatticeVertexIncidentCell, Zsqrtd.ext_iff] + rcases hsector with ⟨hx, hy⟩ | ⟨hy, hx⟩ + · exact ⟨_, Finset.mem_filter.mpr ⟨hx, crossing_clean a b e.2.1 e.2.2 hab p _ _ hx hy⟩, + _, Finset.mem_filter.mpr ⟨hy, crossing_clean b a e.2.2 e.2.1 hab.symm p _ _ hy hx⟩, + adjacent j⟩ + · exact ⟨_, Finset.mem_filter.mpr ⟨hx, crossing_clean a b e.2.1 e.2.2 hab p _ _ hx hy⟩, + _, Finset.mem_filter.mpr ⟨hy, crossing_clean b a e.2.2 e.2.1 hab.symm p _ _ hy hx⟩, + symmetry (adjacent j)⟩ + +private theorem within : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let safe := fun a : PeriodicSubtileIndex => + ¬ (a.first = 0 ∧ a.second = 0) ∧ ∀ i, ∀ k, a ≠ P4630T1RingIndex i k + let clean := fun x : LatticeCell => ∀ i, ∀ k, x ∉ (SubtileOccurrenceInterpretation cert.P + cert.u cert.v (P4630T1RingIndex i k)).cells + let V := fun a : PeriodicSubtileIndex => + (⟨(cert.modified.tile a).cells.filter clean, (cert.modified.tile a).anchor⟩ : ProtoTile) + let H := fun z w => FourNeighborAdjacent z w ∧ clean z ∧ clean w + (∀ (a : PeriodicSubtileIndex), (safe a) → (LatticeTile (V a))) → (∀ (a : + PeriodicSubtileIndex), (safe a) → (∀ (x : LatticeCell), (x ∈ (V a).cells) → (∀ (y : + LatticeCell), (y ∈ (V a).cells) → (Relation.ReflTransGen H x y)))) ) := by + classical + intro q cfg C₀ T cert safe clean V H disk a ha x hx y hy + obtain ⟨p, hp, hl, hm, hs⟩ := + (LatticeTileGridStructure _ (disk a ha)).1.2 x hx y hy + have hne : p ≠ [] := by rintro rfl; simp at hp + have chain : p.IsChain H := + (List.isChain_iff_forall_rel_of_append_cons_cons.mpr hs).imp_of_mem_imp + (fun u v hu hv h => ⟨h, (Finset.mem_filter.mp (hm u hu)).2, + (Finset.mem_filter.mp (hm v hv)).2⟩) + have h := List.relationReflTransGen_of_exists_isChain p chain hne + rw [List.head?_eq_some_head hne] at hp + rw [List.getLast?_eq_getLast_of_ne_nil hne] at hl + simpa only [Option.some.inj hp, Option.some.inj hl] using h + +end CellRouteGeometry + +theorem P4630T1CellRouteLift + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + let safe := fun a : PeriodicSubtileIndex => + ¬ (a.first = 0 ∧ a.second = 0) ∧ + ∀ i k, a ≠ P4630T1RingIndex i k + let clean := fun x : LatticeCell => ∀ i k, + x ∉ (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4630T1RingIndex i k)).cells + ∀ a b, safe a → safe b → + Relation.ReflTransGen + (fun c d => AllowedSubtileIncidence c d ∧ safe c ∧ safe d) a b → + ∀ x ∈ (cert.modified.tile a).cells, clean x → + ∀ y ∈ (cert.modified.tile b).cells, clean y → + Relation.ReflTransGen + (fun z w => FourNeighborAdjacent z w ∧ clean z ∧ clean w) x y := by +-- BODY + classical + let safe := fun a : PeriodicSubtileIndex => + ¬ (a.first = 0 ∧ a.second = 0) ∧ ∀ i k, a ≠ P4630T1RingIndex i k + let shift := fun a : PeriodicSubtileIndex => + (a.first : GaussianInt) * cert.u + (a.second : GaussianInt) * cert.v + let clean := fun x : LatticeCell => ∀ i k, + x ∉ (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4630T1RingIndex i k)).cells + let O := fun a : PeriodicSubtileIndex => TileTranslation cert.O (shift a) + let V := fun a : PeriodicSubtileIndex => + (⟨(cert.modified.tile a).cells.filter clean, (cert.modified.tile a).anchor⟩ : ProtoTile) + let E := fun c d => AllowedSubtileIncidence c d ∧ safe c ∧ safe d + let H := fun z w => FourNeighborAdjacent z w ∧ clean z ∧ clean w + change ∀ a b, safe a → safe b → Relation.ReflTransGen E a b → + ∀ x ∈ (cert.modified.tile a).cells, clean x → + ∀ y ∈ (cert.modified.tile b).cells, clean y → Relation.ReflTransGen H x y + have indexed := PeriodicTileIndexedMultiplicityOne cert.modified + have op (x : LatticeCell) (hx : x ∈ cert.O.cells) := CellRouteGeometry.op q cfg C₀ T cert x hx + have om (x : LatticeCell) (hx : x ∈ cert.O.cells) := CellRouteGeometry.om q cfg C₀ T cert x hx + have original (a : PeriodicSubtileIndex) (x : LatticeCell) + (hx : x ∈ (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells) := + CellRouteGeometry.original q cfg C₀ T cert om a x hx + have dirty (a : PeriodicSubtileIndex) (ha : safe a) (x : LatticeCell) + (hx : x ∈ (cert.modified.tile a).cells) (h : ¬ clean x) := CellRouteGeometry.dirty q cfg C₀ + T cert indexed original a ha x hx h + have clean_B (m n : Int) (ha : safe ⟨.B, m, n⟩) + (hA : ∃ i k, P4630T1RingIndex i k = ⟨.A, m, n⟩) + (x : LatticeCell) (hx : x ∈ (cert.modified.tile ⟨.B, m, n⟩).cells) := + CellRouteGeometry.clean_B q cfg C₀ T cert op dirty m n ha hA x hx + have disk_B (m n : Int) (ha : safe ⟨.B, m, n⟩) + (hA : ∃ i k, P4630T1RingIndex i k = ⟨.A, m, n⟩) := CellRouteGeometry.disk_B q cfg C₀ T + cert clean_B m n ha hA + have disk (a : PeriodicSubtileIndex) (ha : safe a) := CellRouteGeometry.disk q cfg C₀ T cert + dirty disk_B a ha + have corner (U : ProtoTile) (p : GaussianInt) (j : Fin 4) + (hx : LatticeVertexIncidentCell p j ∈ U.cells) := CellRouteGeometry.corner U p j hx + have crossing_clean (a b : PeriodicSubtileIndex) (ha : safe a) (hb : safe b) + (hab : a ≠ b) (p : GaussianInt) (j k : Fin 4) + (hx : LatticeVertexIncidentCell p j ∈ (cert.modified.tile a).cells) + (hy : LatticeVertexIncidentCell p k ∈ (cert.modified.tile b).cells) := + CellRouteGeometry.crossing_clean q cfg C₀ T cert indexed original dirty corner a b ha + hb hab p j k hx hy + have symmetry : ∀ {x y : LatticeCell}, + FourNeighborAdjacent x y → FourNeighborAdjacent y x := @CellRouteGeometry.symmetry + have step {a b : PeriodicSubtileIndex} (e : E a b) := CellRouteGeometry.step q cfg C₀ T cert + indexed crossing_clean symmetry (a := a) (b := b) e + have within (a : PeriodicSubtileIndex) (ha : safe a) + (x : LatticeCell) (hx : x ∈ (V a).cells) + (y : LatticeCell) (hy : y ∈ (V a).cells) := CellRouteGeometry.within q cfg C₀ T cert disk a + ha x hx y hy + intro a b ha hb path + clear hb + induction path with + | refl => + intro x hx hcx y hy hcy + exact within a ha x (Finset.mem_filter.mpr ⟨hx, hcx⟩) + y (Finset.mem_filter.mpr ⟨hy, hcy⟩) + | @tail b c path e ih => + intro x hx hcx y hy hcy + obtain ⟨u, hu, v, hv, huv⟩ := step e + have hu' := Finset.mem_filter.mp hu + have hv' := Finset.mem_filter.mp hv + exact (ih x hx hcx u hu'.1 hu'.2).trans + ((Relation.ReflTransGen.single ⟨huv, hu'.2, hv'.2⟩).trans + (within c e.2.2 v hv y (Finset.mem_filter.mpr ⟨hy, hcy⟩))) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4630T1ExteriorNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4630T1ExteriorNeighbors.lean new file mode 100644 index 0000000000..9f68cf7a60 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4630T1ExteriorNeighbors.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.P4630T1RingIndex + +-- [TABLET NODE: P4630T1ExteriorNeighbors] + +/-! +# P4630T1ExteriorNeighbors + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4630T1ExteriorNeighbors + {a b : PeriodicSubtileIndex} (h : AllowedSubtileIncidence a b) + (ha : a.first = 0 ∧ a.second = 0) + (hb : ¬ (b.first = 0 ∧ b.second = 0)) : + ∃ i k, b = P4630T1RingIndex i k := by +-- BODY + have table : ∀ {a b}, AllowedSubtileIncidence a b → + ((a.first = 0 ∧ a.second = 0) → + ¬ (b.first = 0 ∧ b.second = 0) → + ∃ i k, b = P4630T1RingIndex i k) ∧ + ((b.first = 0 ∧ b.second = 0) → + ¬ (a.first = 0 ∧ a.second = 0) → + ∃ i k, a = P4630T1RingIndex i k) := by + intro a b e + induction e with + | symm _ ih => exact ih.symm + | _ => + simp [P4630T1RingIndex, Fin.exists_fin_succ, + PeriodicSubtileIndex.mk.injEq] at *; omega + exact (table h).1 ha hb + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4630T1ExteriorWalks.lean b/LeanPool/ApollonianSuperharmonic/P4630T1ExteriorWalks.lean new file mode 100644 index 0000000000..7d1476c555 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4630T1ExteriorWalks.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.P4630T1RingIndex +public import Mathlib.Logic.Relation + +-- [TABLET NODE: P4630T1ExteriorWalks] + +/-! +# P4630T1ExteriorWalks + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4630T1ExteriorWalks : + let safe := fun a : PeriodicSubtileIndex => + ¬ (a.first = 0 ∧ a.second = 0) ∧ + ∀ i k, a ≠ P4630T1RingIndex i k + ∀ a, safe a → ∃ f : Nat → PeriodicSubtileIndex, + Function.Injective f ∧ ∀ n, + (f n).label = .A ∧ safe (f n) ∧ + Relation.ReflTransGen + (fun x y => AllowedSubtileIncidence x y ∧ safe x ∧ safe y) + a (f n) := by +-- BODY + let safe := fun a : PeriodicSubtileIndex => + ¬ (a.first = 0 ∧ a.second = 0) ∧ + ∀ i k, a ≠ P4630T1RingIndex i k + let E := fun x y => AllowedSubtileIncidence x y ∧ safe x ∧ safe y + change ∀ a, safe a → ∃ f : Nat → PeriodicSubtileIndex, + Function.Injective f ∧ ∀ n, (f n).label = .A ∧ safe (f n) ∧ + Relation.ReflTransGen E a (f n) + have edge {a b} (h : AllowedSubtileIncidence a b) + (ha : safe a) (hb : safe b) : Relation.ReflTransGen E a b := + .single ⟨h, ha, hb⟩ + have attach : ∀ a, safe a → ∃ m n, + safe ⟨.A, m, n⟩ ∧ Relation.ReflTransGen E a ⟨.A, m, n⟩ := by + rintro ⟨l, m, n⟩ ha + by_cases h₁ : m = -1 ∧ n = -1 + · rcases h₁ with ⟨rfl, rfl⟩ + have hb : Relation.ReflTransGen E ⟨.B, -1, -1⟩ ⟨.A, -1, -2⟩ := + (edge (.BF0m1 (-1) (-1)) (by decide) (by decide)).trans + (edge (.symm (.AF (-1) (-2))) (by decide) (by decide)) + have hc : Relation.ReflTransGen E ⟨.C, -1, -1⟩ ⟨.A, -2, -1⟩ := + (edge (.CEm10 (-1) (-1)) (by decide) (by decide)).trans + ((edge (.symm (.BE (-2) (-1))) (by decide) (by decide)).trans + (edge (.symm (.AB (-2) (-1))) (by decide) (by decide))) + cases l + · exact False.elim (ha.2 0 0 rfl) + · exact ⟨-1, -2, by decide, hb⟩ + · exact ⟨-2, -1, by decide, hc⟩ + · exact False.elim (ha.2 1 3 rfl) + · exact ⟨-1, -2, by decide, + (edge (.symm (.BE (-1) (-1))) ha (by decide)).trans hb⟩ + · exact ⟨-2, -1, by decide, + (edge (.symm (.CF (-1) (-1))) ha (by decide)).trans hc⟩ + by_cases h₂ : m = 0 ∧ n = -1 + · rcases h₂ with ⟨rfl, rfl⟩ + have hb : Relation.ReflTransGen E ⟨.B, 0, -1⟩ ⟨.A, -1, -2⟩ := + (edge (.BDm1m1 0 (-1)) (by decide) (by decide)).trans + (edge (.symm (.AD (-1) (-2))) (by decide) (by decide)) + have hc : Relation.ReflTransGen E ⟨.C, 0, -1⟩ ⟨.A, -1, -2⟩ := + (edge (.CEm10 0 (-1)) (by decide) (by decide)).trans + ((edge (.symm (.BE (-1) (-1))) (by decide) (by decide)).trans + ((edge (.BF0m1 (-1) (-1)) (by decide) (by decide)).trans + (edge (.symm (.AF (-1) (-2))) (by decide) (by decide)))) + cases l + · exact False.elim (ha.2 0 1 rfl) + · exact ⟨-1, -2, by decide, hb⟩ + · exact ⟨-1, -2, by decide, hc⟩ + · exact ⟨-1, -2, by decide, + (edge (.symm (.BD 0 (-1))) ha (by decide)).trans hb⟩ + · exact ⟨-1, -2, by decide, + (edge (.symm (.BE 0 (-1))) ha (by decide)).trans hb⟩ + · exact False.elim (ha.2 2 2 rfl) + have hA : safe ⟨.A, m, n⟩ := by + have hz := ha.1 + simp [safe, P4630T1RingIndex, Fin.forall_fin_succ, + PeriodicSubtileIndex.mk.injEq] at * + omega + refine ⟨m, n, hA, ?_⟩ + cases l + · exact .refl + · exact edge (.symm (.AB m n)) ha hA + · exact edge (.symm (.AC m n)) ha hA + · exact edge (.symm (.AD m n)) ha hA + · by_cases h₃ : m = 1 ∧ n = 1 + · rcases h₃ with ⟨rfl, rfl⟩ + exact (edge (.symm (.DE 1 1)) ha (by decide)).trans + (edge (.symm (.AD 1 1)) (by decide) hA) + · have hB : safe ⟨.B, m, n⟩ := by + simp [safe, P4630T1RingIndex, Fin.forall_fin_succ, + PeriodicSubtileIndex.mk.injEq] at * + omega + exact (edge (.symm (.BE m n)) ha hB).trans + (edge (.symm (.AB m n)) hB hA) + · exact edge (.symm (.AF m n)) ha hA + intro a ha + obtain ⟨m, n, hA, hp⟩ := attach a ha + by_cases east : ((n - m = -1 ∨ n - m = 0) ∧ 0 < m) ∨ + (n - m = 1 ∧ 0 ≤ m) + · let f : Nat → PeriodicSubtileIndex := fun j => ⟨.A, m + j, n + j⟩ + have hf (j : Nat) : safe (f j) := by + simp [f, safe, P4630T1RingIndex, Fin.forall_fin_succ, + PeriodicSubtileIndex.mk.injEq] at hA ⊢ + omega + have hm (j : Nat) : safe ⟨.B, m + j + 1, n + j + 1⟩ := by + simp [safe, P4630T1RingIndex, Fin.forall_fin_succ, + PeriodicSubtileIndex.mk.injEq] + omega + refine ⟨f, ?_, fun j => ⟨rfl, hf j, ?_⟩⟩ + · intro j k h + have he := congrArg PeriodicSubtileIndex.first h + dsimp [f] at he + omega + · induction j with + | zero => simpa [f] using hp + | succ j ih => + apply ih.trans + have hstep := (edge (.AB11 (m + j) (n + j)) (hf j) (hm j)).trans + (edge (.symm (.AB (m + j + 1) (n + j + 1))) (hm j) + (by simpa [f, Nat.cast_add, Nat.cast_one, add_assoc] using hf (j + 1))) + simpa [f, Nat.cast_add, Nat.cast_one, add_assoc] using hstep + · let f : Nat → PeriodicSubtileIndex := fun j => ⟨.A, m - j, n - j⟩ + have hf (j : Nat) : safe (f j) := by + simp [f, safe, P4630T1RingIndex, Fin.forall_fin_succ, + PeriodicSubtileIndex.mk.injEq] at hA ⊢ + omega + have hm (j : Nat) : safe ⟨.B, m - j, n - j⟩ := by + simp [safe, P4630T1RingIndex, Fin.forall_fin_succ, + PeriodicSubtileIndex.mk.injEq] at hA ⊢ + omega + refine ⟨f, ?_, fun j => ⟨rfl, hf j, ?_⟩⟩ + · intro j k h + have he := congrArg PeriodicSubtileIndex.first h + dsimp [f] at he + omega + · induction j with + | zero => simpa [f] using hp + | succ j ih => + apply ih.trans + have he : AllowedSubtileIncidence ⟨.B, m - j, n - j⟩ (f (j + 1)) := by + convert (AllowedSubtileIncidence.AB11 + (m - (j + 1 : Nat)) (n - (j + 1 : Nat))).symm using 1; + simp [Nat.cast_add, Nat.cast_one, PeriodicSubtileIndex.mk.injEq]; + omega + exact (edge (.AB (m - j) (n - j)) (hf j) (hm j)).trans + (edge he (hm j) (hf (j + 1))) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4630T1GridComplementCriterion.lean b/LeanPool/ApollonianSuperharmonic/P4630T1GridComplementCriterion.lean new file mode 100644 index 0000000000..a1d1e54642 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4630T1GridComplementCriterion.lean @@ -0,0 +1,140 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.UniqueBoundedGridComplementComponent +public import Mathlib.Data.List.Chain + +-- [TABLET NODE: P4630T1GridComplementCriterion] + +/-! +# P4630T1GridComplementCriterion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4630T1GridComplementCriterion (B C : Set LatticeCell) + (hfinite : C.Finite) (hC : FourNeighborConnected C) + (hdisjoint : C ⊆ Bᶜ) + (hboundary : ∀ x ∈ C, ∀ y, FourNeighborAdjacent x y → y ∉ C → y ∈ B) + (hexterior : ∀ x, x ∉ C → x ∉ B → + ∃ f : Nat → LatticeCell, Function.Injective f ∧ ∀ n, + Relation.ReflTransGen + (fun a b => FourNeighborAdjacent a b ∧ a ∉ B ∧ b ∉ B) x (f n)) : + UniqueBoundedGridComplementComponent B C := by +-- BODY + have symmetry : ∀ {x y : LatticeCell}, + FourNeighborAdjacent x y → FourNeighborAdjacent y x := by + intro x y h + rcases h with h | h | h | h + all_goals subst y + all_goals simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + have fromList (S : Set LatticeCell) (hs : FourNeighborConnected S) + (x : LatticeCell) (hx : x ∈ S) (y : LatticeCell) (hy : y ∈ S) : + Relation.ReflTransGen + (fun a b => FourNeighborAdjacent a b ∧ a ∈ S ∧ b ∈ S) x y := by + obtain ⟨p, hp, hlast, hmem, hstep⟩ := hs.2 x hx y hy + have hne : p ≠ [] := by rintro rfl; simp at hp + have chain : p.IsChain + (fun a b => FourNeighborAdjacent a b ∧ a ∈ S ∧ b ∈ S) := + (List.isChain_iff_forall_rel_of_append_cons_cons.mpr hstep).imp_of_mem_imp + (fun a b ha hb e => ⟨e, hmem a ha, hmem b hb⟩) + have h := List.relationReflTransGen_of_exists_isChain p chain hne + rw [List.head?_eq_some_head hne] at hp + rw [List.getLast?_eq_getLast_of_ne_nil hne] at hlast + simpa only [Option.some.inj hp, Option.some.inj hlast] using h + have toList (S : Set LatticeCell) {x y : LatticeCell} (hx : x ∈ S) + (h : Relation.ReflTransGen + (fun a b => FourNeighborAdjacent a b ∧ a ∈ S ∧ b ∈ S) x y) : + ∃ p : List LatticeCell, p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ S) ∧ ∀ a b : LatticeCell, ∀ l₁ l₂ : List LatticeCell, + p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b := by + obtain ⟨p, hp, hlast⟩ := List.exists_isChain_cons_of_relationReflTransGen h + refine ⟨x :: p, by simp, ?_, ?_, ?_⟩ + · rw [List.getLast?_eq_getLast_of_ne_nil (by simp), hlast] + · exact hp.induction (fun z => z ∈ S) _ (fun {_ _} e _ => e.2.2) + (fun _ => hx) + · exact List.isChain_iff_forall_rel_of_append_cons_cons.mp + (hp.imp (fun _ _ e => e.1)) + let R := fun a b : LatticeCell => FourNeighborAdjacent a b ∧ a ∉ B ∧ b ∉ B + have maximal (D : Set LatticeCell) (hD : FourNeighborConnected D) + (hCD : C ⊆ D) (hDB : D ⊆ Bᶜ) : D = C := by + apply Set.Subset.antisymm _ hCD + obtain ⟨x, hx⟩ := hC.1 + intro y hy + have h : Relation.ReflTransGen R x y := + Relation.ReflTransGen.mono + (fun a b e => ⟨e.1, hDB e.2.1, hDB e.2.2⟩) + x y (fromList D hD x (hCD hx) y hy) + clear hy + induction h with + | refl => exact hx + | @tail y z h e ih => + by_contra hz + exact e.2.2 (hboundary y ih z e.1 hz) + change C.Finite ∧ C ⊆ Bᶜ ∧ FourNeighborConnected C ∧ + (∀ D, FourNeighborConnected D → C ⊆ D → D ⊆ Bᶜ → D = C) ∧ + ∀ D, D.Finite → D ⊆ Bᶜ → FourNeighborConnected D → + (∀ E, FourNeighborConnected E → D ⊆ E → E ⊆ Bᶜ → E = D) → D = C + refine ⟨hfinite, hdisjoint, hC, maximal, ?_⟩ + intro D hfin hDB hD hmax + obtain ⟨x, hx⟩ := hD.1 + by_cases hxC : x ∈ C + · have DC : D ⊆ C := by + intro y hy + have h : Relation.ReflTransGen R x y := + Relation.ReflTransGen.mono + (fun a b e => ⟨e.1, hDB e.2.1, hDB e.2.2⟩) + x y (fromList D hD x hx y hy) + clear hy + induction h with + | refl => exact hxC + | @tail y z h e ih => + by_contra hz + exact e.2.2 (hboundary y ih z e.1 hz) + exact (hmax C hC DC hdisjoint).symm + · obtain ⟨f, hf, hroute⟩ := hexterior x hxC (hDB hx) + let E : Set LatticeCell := {y | Relation.ReflTransGen R x y} + have hEB : E ⊆ Bᶜ := by + intro y hy + induction hy with + | refl => exact hDB hx + | tail _ e _ => exact e.2.2 + have extend {y z : LatticeCell} (hy : y ∈ E) + (h : Relation.ReflTransGen R y z) : + Relation.ReflTransGen + (fun a b => FourNeighborAdjacent a b ∧ a ∈ E ∧ b ∈ E) y z := by + induction h with + | refl => exact .refl + | tail h e ih => exact ih.tail ⟨e.1, hy.trans h, (hy.trans h).tail e⟩ + have hE : FourNeighborConnected E := by + refine ⟨⟨x, Relation.ReflTransGen.refl⟩, ?_⟩ + intro y hy z hz + have rev : Relation.ReflTransGen R y x := by + induction hy with + | refl => exact .refl + | tail _ e ih => exact + (Relation.ReflTransGen.single ⟨symmetry e.1, e.2.2, e.2.1⟩).trans ih + exact toList E hy (extend hy (rev.trans hz)) + have hDE : D ⊆ E := by + intro y hy + exact Relation.ReflTransGen.mono + (fun a b e => ⟨e.1, hDB e.2.1, hDB e.2.2⟩) + x y (fromList D hD x hx y hy) + have eq := hmax E hE hDE hEB + have hEF : E.Finite := eq.symm ▸ hfin + have hrange : Set.range f ⊆ E := by rintro _ ⟨n, rfl⟩; exact hroute n + exact False.elim ((Set.infinite_range_of_injective hf) (hEF.subset hrange)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4630T1ParentRotation.lean b/LeanPool/ApollonianSuperharmonic/P4630T1ParentRotation.lean new file mode 100644 index 0000000000..1cee69b310 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4630T1ParentRotation.lean @@ -0,0 +1,237 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn +public import LeanPool.ApollonianSuperharmonic.P4630T1RingIndex +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P4630T1ParentRotation] + +/-! +# P4630T1ParentRotation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4630T1ParentRotation + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + ∃ t : GaussianInt, + GaussianRealPoint t = + ((TileCentroid T).1 + (TileCentroid T).2, + (TileCentroid T).2 - (TileCentroid T).1) ∧ + ∀ i k, + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4630T1RingIndex i k)).cells.image + (fun x => GaussianQuarterTurn x - 1 + t) = + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4630T1RingIndex i (k + 1))).cells := by +-- BODY + classical + let W := fun i : Fin 3 => + BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + let r : Fin 3 → GaussianInt := ![-cert.u - cert.v, cert.u, cert.v] + let s : Fin 3 → GaussianInt := ![-cert.v, cert.u + cert.v, -cert.u] + have quarter_add (x y : GaussianInt) : + GaussianQuarterTurn (x + y) = GaussianQuarterTurn x + GaussianQuarterTurn y := by + ext <;> simp [GaussianQuarterTurn]; ring + have quarter_sub (x y : GaussianInt) : + GaussianQuarterTurn (x - y) = GaussianQuarterTurn x - GaussianQuarterTurn y := by + ext <;> simp [GaussianQuarterTurn]; ring + have quarter_twice (x : GaussianInt) : + GaussianQuarterTurn (GaussianQuarterTurn x) = -x := by + ext <;> simp [GaussianQuarterTurn] + have rotated : ProperBandQuadruple (![q 0, q 2, q 3, q 1]) := by + refine ⟨SemiProperQuadruple.rotate cfg.proper.1, ?_⟩ + intro j + fin_cases j + · exact cfg.proper.2 1 + · exact cfg.proper.2 2 + · exact cfg.proper.2 0 + have laws := VectorRecursionLaws q cfg.proper.1 + have laws' := VectorRecursionLaws (![q 0, q 2, q 3, q 1]) rotated.1 + have U : cert.u = BandVectors.1 (q 2) (q 1) + + GaussianQuarterTurn (BandVectors.1 (q 1) (q 3)) := by + rw [cert.period_u] + have flip : BandVectors.1 (q 0) (q 1) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 1) (q 0) := + (laws.2.2.2.2 cfg.proper 0).1 + rw [flip, laws.2.2.1] + ext <;> simp [GaussianQuarterTurn] <;> ring + have V : cert.v = BandVectors.1 (q 3) (q 2) + + GaussianQuarterTurn (BandVectors.1 (q 2) (q 1)) := by + rw [cert.period_v] + have flip : BandVectors.1 (q 0) (q 2) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 2) (q 0) := + (laws.2.2.2.2 cfg.proper 1).1 + have recurrence : BandVectors.1 (q 2) (q 0) = + BandVectors.1 (q 2) (q 1) - + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 3) (q 2) := by + simpa using laws'.2.2.1 + rw [flip, recurrence] + ext <;> simp [GaussianQuarterTurn] <;> ring + have offsets (i : Fin 3) : s i = GaussianQuarterTurn (W i) + + GaussianQuarterTurn (r i) := by + have hre := congrArg Zsqrtd.re laws.1 + have him := congrArg Zsqrtd.im laws.1 + fin_cases i + all_goals + simp? [W, r, s, U, V, GaussianQuarterTurn] at hre him ⊢ + apply Zsqrtd.ext_iff.mpr + simp + constructor <;> omega + have offsets' (i : Fin 3) : GaussianQuarterTurn (s i) = -W i - r i := by + rw [offsets i, quarter_add, quarter_twice, quarter_twice] + abel + have half := BandSignedOccurrenceHalfTurn q (TileCentroid T) cert.P + (fun i b => (cert.outer_occurrence i b).1) + (fun i b => (cert.outer_occurrence i b).2.2) + choose τ hτ using fun i : Fin 3 => + QuarterTurnSymmetricCenteredTransport (cert.P i true) (cert.parent_quarter_turn i true) + have root (i : Fin 3) : GaussianRealPoint (τ i + GaussianQuarterTurn (W i)) = + ((TileCentroid T).1 + (TileCentroid T).2, + (TileCentroid T).2 - (TileCentroid T).1) := by + have hc := (cert.outer_occurrence i true).2.2 + have hx := congrArg Prod.fst hc + have hy := congrArg Prod.snd hc + have tx := congrArg Prod.fst (hτ i).1 + have ty := congrArg Prod.snd (hτ i).1 + have hx' : (TileCentroid (cert.P i true)).1 - (TileCentroid T).1 = + (1 / 2 : Real) * ((W i).re + (W i).im) := by + simpa [W, GaussianRealPoint, sub_eq_add_neg] using hx + have hy' : (TileCentroid (cert.P i true)).2 - (TileCentroid T).2 = + (1 / 2 : Real) * ((W i).im - (W i).re) := by + simpa [W, GaussianRealPoint] using hy + apply Prod.ext + all_goals + dsimp [GaussianRealPoint, GaussianQuarterTurn] at tx ty ⊢ + push_cast + linarith + let t := τ 0 + GaussianQuarterTurn (W 0) + have center (i : Fin 3) : τ i + GaussianQuarterTurn (W i) = t := by + have he := (root i).trans (root 0).symm + have he₁ := congrArg Prod.fst he + have he₂ := congrArg Prod.snd he + dsimp [GaussianRealPoint] at he₁ he₂ + apply Zsqrtd.ext_iff.mpr + constructor + · exact_mod_cast he₁ + · exact_mod_cast he₂ + let F := fun x => GaussianQuarterTurn x - 1 + t + have translate (S : ProtoTile) (z : GaussianInt) : + (TileTranslation S z).cells.image F = + (S.cells.image F).image (fun x => x + GaussianQuarterTurn z) := by + simp only [TileTranslation, Finset.image_image, GaussianTranslation] + apply congrArg (fun f : GaussianInt → GaussianInt => S.cells.image f) + funext x + dsimp [Function.comp_def, F, GaussianTranslation] + rw [quarter_add] + abel + have plus (i : Fin 3) : (cert.P i true).cells.image F = + (cert.P i true).cells.image (fun x => x + GaussianQuarterTurn (W i)) := by + have hc : (cert.P i true).cells.image + (fun x => GaussianQuarterTurn x - 1 + τ i) = (cert.P i true).cells := by + simpa only [TileTranslation, TileQuarterTurn, Finset.image_image, + GaussianTranslation, Function.comp_def] using (hτ i).2.1 + calc + _ = ((cert.P i true).cells.image + (fun x => GaussianQuarterTurn x - 1 + τ i)).image + (fun x => x + GaussianQuarterTurn (W i)) := by + rw [Finset.image_image] + apply congrArg (fun f : GaussianInt → GaussianInt => (cert.P i true).cells.image f) + funext x + dsimp [F, Function.comp_def] + rw [← center i] + abel + _ = _ := by rw [hc] + have plus_shift (i : Fin 3) (z : GaussianInt) : + (TileTranslation (cert.P i true) z).cells.image F = + (cert.P i true).cells.image + (fun x => x + GaussianQuarterTurn (W i) + GaussianQuarterTurn z) := by + rw [translate, plus, Finset.image_image] + rfl + have negative (i : Fin 3) : (cert.P i false).cells.image F = + (cert.P i true).cells.image (fun x => x - W i) := by + have hc := (half i).1 + change (TileTranslation (cert.P i true) + (GaussianQuarterTurn (W i) - W i)).cells = (cert.P i false).cells at hc + rw [← hc, plus_shift] + apply congrArg (fun f : GaussianInt → GaussianInt => (cert.P i true).cells.image f) + funext x + rw [quarter_sub, quarter_twice] + abel + have negative_shift (i : Fin 3) (z : GaussianInt) : + (TileTranslation (cert.P i false) z).cells.image F = + (cert.P i true).cells.image (fun x => x - W i + GaussianQuarterTurn z) := by + rw [translate, negative, Finset.image_image] + rfl + have minus_cells (i : Fin 3) (z : GaussianInt) : + (TileTranslation (cert.P i false) z).cells = + (cert.P i true).cells.image (fun x => x + GaussianQuarterTurn (W i) - W i + z) := by + have hc := (half i).1 + change (TileTranslation (cert.P i true) + (GaussianQuarterTurn (W i) - W i)).cells = (cert.P i false).cells at hc + change (cert.P i false).cells.image (GaussianTranslation z) = _ + rw [← hc] + simp only [TileTranslation, Finset.image_image, GaussianTranslation] + congr 1 + funext x + dsimp [Function.comp_def, GaussianTranslation] + abel + have table (i : Fin 3) (k : Fin 4) : + SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4630T1RingIndex i k) = + if k = 0 then TileTranslation (cert.P i true) (r i) + else if k = 1 then TileTranslation (cert.P i true) (s i) + else if k = 2 then TileTranslation (cert.P i false) (-r i) + else TileTranslation (cert.P i false) (-s i) := by + fin_cases i <;> fin_cases k <;> + simp [P4630T1RingIndex, SubtileOccurrenceInterpretation, r, s, + sub_eq_add_neg, add_comm] + refine ⟨t, root 0, ?_⟩ + intro i k + change Finset.image F _ = _ + rw [table, table] + fin_cases k + all_goals norm_num [Fin.ext_iff, Fin.add_def] + · rw [plus_shift] + change _ = (cert.P i true).cells.image (GaussianTranslation (s i)) + rw [offsets i] + congr 1 + funext x + simp [GaussianTranslation, add_assoc] + · rw [plus_shift, minus_cells, offsets'] + congr 1 + funext x + abel + · rw [negative_shift, minus_cells] + simp only [show ∀ x : GaussianInt, GaussianQuarterTurn (-x) = + -GaussianQuarterTurn x by intro x; ext <;> simp [GaussianQuarterTurn]] + rw [offsets i] + congr 1 + funext x + abel + · rw [negative_shift] + change _ = (cert.P i true).cells.image (GaussianTranslation (r i)) + simp only [show ∀ x : GaussianInt, GaussianQuarterTurn (-x) = + -GaussianQuarterTurn x by intro x; ext <;> simp [GaussianQuarterTurn]] + rw [offsets'] + congr 1 + funext x + simp only [GaussianTranslation] + abel + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4630T1RingIndex.lean b/LeanPool/ApollonianSuperharmonic/P4630T1RingIndex.lean new file mode 100644 index 0000000000..7701f7fe2f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4630T1RingIndex.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex + +-- [TABLET NODE: P4630T1RingIndex] + +/-! +# P4630T1RingIndex + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The twelve exterior periodic indices, in cyclic order for each parent, +are the entries of the following array. The row index is in +$\{0,1,2\}$ and the column index is in $\{0,1,2,3\}$. +$$ +\begin{pmatrix} +A_{-1,-1}&A_{0,-1}&B_{1,1}&B_{0,1}\\ +C_{1,0}&C_{1,1}&D_{-1,0}&D_{-1,-1}\\ +E_{0,1}&E_{-1,0}&F_{0,-1}&F_{1,0} +\end{pmatrix}. +$$ +These are indices, not identifications of prototile records. +-/ +def P4630T1RingIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := +-- BODY + ![![⟨.A, -1, -1⟩, ⟨.A, 0, -1⟩, ⟨.B, 1, 1⟩, ⟨.B, 0, 1⟩], + ![⟨.C, 1, 0⟩, ⟨.C, 1, 1⟩, ⟨.D, -1, 0⟩, ⟨.D, -1, -1⟩], + ![⟨.E, 0, 1⟩, ⟨.E, -1, 0⟩, ⟨.F, 0, -1⟩, ⟨.F, 1, 0⟩]] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1AntipodalContactArcs.lean b/LeanPool/ApollonianSuperharmonic/P4638T1AntipodalContactArcs.lean new file mode 100644 index 0000000000..558a673f0e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4638T1AntipodalContactArcs.lean @@ -0,0 +1,217 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.P4590T1CentralDiskSectors +public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.P4651T1GridHalfTurnTransport +public import LeanPool.ApollonianSuperharmonic.P4651T1FreeBoundaryHalfTurn +public import LeanPool.ApollonianSuperharmonic.P4651T1ContactEdgeSeparation +public import LeanPool.ApollonianSuperharmonic.P4651T1CycleComplementaryArcs + +-- [TABLET NODE: P4638T1AntipodalContactArcs] + +/-! +# P4638T1AntipodalContactArcs + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4638T1AntipodalContactArcs : + ∀ (Dplus : ProtoTile), ∀ (Dminus : ProtoTile), ∀ (O : ProtoTile), ∀ (O' : ProtoTile), ∀ (X : + ProtoTile), ∀ (Y : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), (O.cells.Nonempty) → + ((LatticeTile O) → ((LatticeTile Dplus) → ((LatticeTile Dminus) → ((TileTouching Dplus O) + → ((TileTouching Dminus O) → ((Disjoint Dplus.cells Dminus.cells) → + ((CentrallyReflectedAt (TileCentroid O) Dplus Dminus) → ((QuarterTurnSymmetric O) → + ((O.cells = O'.cells) → ((O.cells = ∅ → O.anchor = O'.anchor) → ((X.cells.Nonempty) → + ((Y.cells.Nonempty) → ((U.cells.Nonempty) → ((V.cells.Nonempty) → ((TouchingTriple X Y O) + → ((TouchingTriple U V O) → ((X.cells ⊆ Dplus.cells) → ((Y.cells ⊆ Dminus.cells) → + ((U.cells ⊆ Dplus.cells) → ((V.cells ⊆ Dminus.cells) → ((CentrallyReflectedAt + (TileCentroid O) X V) → ((CentrallyReflectedAt (TileCentroid O) Y U) → (Nonempty + (PrecursorBoundaryArcData Dplus Dminus O O' X Y U V) ∧ + ∀ e ∈ BoundaryFootprintEdges O, + e ∈ BoundaryFootprintEdges Dplus ∨ e ∈ BoundaryFootprintEdges + Dminus))))))))))))))))))))))) := by + intro Dplus Dminus O O' X Y U V hO hOL hplus hminus htplus htminus hdisjoint hreflect hsym + hcells hanchor hX hY hU hV hfirst hsecond hXsub hYsub hUsub hVsub hXV hYU +-- BODY + classical + have positive_touch (S T : ProtoTile) (hS : S.cells.Nonempty) + (hT : T.cells.Nonempty) (ht : TileTouching S T) : + Disjoint S.cells T.cells ∧ + SimpleGridPath (BoundaryFootprintVertices S ∩ BoundaryFootprintVertices T) + (BoundaryFootprintEdges S ∩ BoundaryFootprintEdges T) := by + rcases ht with ⟨_, _, hd, hp⟩ | ⟨hs, _⟩ | ⟨ht, _⟩ + · exact ⟨hd, hp⟩ + · simp [hs] at hS + · simp [ht] at hT + have hDp : Dplus.cells.Nonempty := hX.mono hXsub + have hDm : Dminus.cells.Nonempty := hY.mono hYsub + obtain ⟨hdp, hpathp⟩ := positive_touch Dplus O hDp hO htplus + obtain ⟨hdm, hpathm⟩ := positive_touch Dminus O hDm hO htminus + obtain ⟨growp, growm, hsep⟩ := + P4651T1ContactEdgeSeparation Dplus Dminus O hdp hdm hdisjoint + obtain ⟨u, hu, _⟩ := QuarterTurnSymmetricCenteredTransport O hsym + let w := u + GaussianQuarterTurn u + have hw : GaussianRealPoint w = + (2 * (TileCentroid O).1, 2 * (TileCentroid O).2) := by + have hx := congrArg Prod.fst hu + have hy := congrArg Prod.snd hu + dsimp [GaussianRealPoint] at hx hy + change (((u.re + -u.im : Int) : Real), ((u.im + u.re : Int) : Real)) = _ + push_cast + exact Prod.ext (by linarith) (by linarith) + have hself : CentrallyReflectedAt (TileCentroid O) O O := by + let H : Real × Real → Real × Real := fun p => + (2 * (TileCentroid O).1 - p.1, 2 * (TileCentroid O).2 - p.2) + have hH (p : Real × Real) : H (H p) = p := by + ext <;> dsimp [H] <;> ring + have hmem (p : Real × Real) (hp : p ∈ TileRealization O) : + H p ∈ TileRealization O := by + have h := (hsym _).mp ((hsym p).mp hp) + convert h using 1; dsimp [H]; ring + change TileRealization O = H '' TileRealization O + ext p + constructor + · intro hp + exact ⟨H p, hmem p hp, hH p⟩ + · rintro ⟨q, hq, rfl⟩ + exact hmem q hq + let r : GaussianInt → GaussianInt := fun z => w - z + have hinv : Function.Involutive r := by + intro z + dsimp [r] + abel + have hinj : Function.Injective r := hinv.injective + obtain ⟨_, heO, hvO⟩ := P4651T1GridHalfTurnTransport + (TileCentroid O) w hw O O hO hO hself + obtain ⟨_, _, hvD⟩ := P4651T1GridHalfTurnTransport + (TileCentroid O) w hw Dplus Dminus hDp hDm hreflect + obtain ⟨_, _, hvXV⟩ := P4651T1GridHalfTurnTransport + (TileCentroid O) w hw X V hX hV hXV + obtain ⟨_, _, hvYU⟩ := P4651T1GridHalfTurnTransport + (TileCentroid O) w hw Y U hY hU hYU + obtain ⟨hfreeV, hfreeE⟩ := + P4651T1FreeBoundaryHalfTurn O hO hOL hsym w hw hself + have image_inter (A B : Set GaussianInt) : + r '' (A ∩ B) = r '' A ∩ r '' B := by + ext z + constructor + · rintro ⟨x, ⟨hx, hy⟩, rfl⟩ + exact ⟨⟨x, hx, rfl⟩, ⟨x, hy, rfl⟩⟩ + · rintro ⟨⟨x, hx, hxr⟩, ⟨y, hy, hyr⟩⟩ + have hxy : x = y := hinj (hxr.trans hyr.symm) + subst y + exact ⟨x, ⟨hx, hy⟩, hxr⟩ + have hcontact : + r '' (BoundaryFootprintVertices Dplus ∩ BoundaryFootprintVertices O) = + BoundaryFootprintVertices Dminus ∩ BoundaryFootprintVertices O := by + rw [image_inter, ← hvD, ← hvO] + obtain ⟨a, ha, hau⟩ := hfirst.2.2.2 + have first_transition (x : GaussianInt) : + x ∈ BoundaryFootprintVertices X ∧ x ∈ BoundaryFootprintVertices Y ∧ + x ∈ BoundaryFootprintVertices O ↔ x = a := by + exact ⟨fun hx => hau x hx, fun hx => hx.symm ▸ ha⟩ + -- Identify the second supplied labelled junction by exact boundary transport. + have hra : r a ∈ BoundaryFootprintVertices U ∧ + r a ∈ BoundaryFootprintVertices V ∧ r a ∈ BoundaryFootprintVertices O := by + refine ⟨?_, ?_, ?_⟩ + · rw [hvYU] + exact ⟨a, ha.2.1, rfl⟩ + · rw [hvXV] + exact ⟨a, ha.1, rfl⟩ + · rw [hvO] + exact ⟨a, ha.2.2, rfl⟩ + have second_transition (x : GaussianInt) : + x ∈ BoundaryFootprintVertices U ∧ x ∈ BoundaryFootprintVertices V ∧ + x ∈ BoundaryFootprintVertices O ↔ x = r a := by + obtain ⟨b, hb, hbu⟩ := hsecond.2.2.2 + have hab : r a = b := hbu _ hra + exact ⟨fun hx => (hbu x hx).trans hab.symm, fun hx => hx.symm ▸ hra⟩ + have lift_vertex (S D : ProtoTile) (hD : D.cells.Nonempty) + (hpath : SimpleGridPath + (BoundaryFootprintVertices S ∩ BoundaryFootprintVertices O) + (BoundaryFootprintEdges S ∩ BoundaryFootprintEdges O)) + (hgrow : BoundaryFootprintEdges S ∩ BoundaryFootprintEdges O ⊆ + BoundaryFootprintEdges D ∩ BoundaryFootprintEdges O) + (hx : a ∈ BoundaryFootprintVertices S ∩ BoundaryFootprintVertices O) : + a ∈ BoundaryFootprintVertices D ∩ BoundaryFootprintVertices O := by + obtain ⟨e, hae, he⟩ := SimpleGridPathVertexIncidentEdge _ _ hpath a hx + have hg := hgrow he + refine ⟨?_, hx.2⟩ + simp only [BoundaryFootprintVertices, ite_eq_left hD, Set.mem_ofPred_eq] + exact ⟨e, hg.1, hae⟩ + have hpathXO : SimpleGridPath + (BoundaryFootprintVertices X ∩ BoundaryFootprintVertices O) + (BoundaryFootprintEdges X ∩ BoundaryFootprintEdges O) := by + simpa only [Set.inter_comm] using + (positive_touch O X hO hX hfirst.2.2.1).2 + have hpathYO := (positive_touch Y O hY hO hfirst.2.1).2 + have hap := lift_vertex X Dplus hDp hpathXO (growp X hXsub) ⟨ha.1, ha.2.2⟩ + have ham := lift_vertex Y Dminus hDm hpathYO (growm Y hYsub) ⟨ha.2.1, ha.2.2⟩ + obtain ⟨⟨p, q, hpN, hqN, hph, hpl, hqh, hql, hpS, hqS, + hpstep, hqstep, hunion, hinter⟩, hcover⟩ := + P4651T1CycleComplementaryArcs + (BoundaryFootprintVertices O) + (BoundaryFootprintVertices Dplus ∩ BoundaryFootprintVertices O) + (BoundaryFootprintVertices Dminus ∩ BoundaryFootprintVertices O) + (BoundaryFootprintEdges O) + (BoundaryFootprintEdges Dplus ∩ BoundaryFootprintEdges O) + (BoundaryFootprintEdges Dminus ∩ BoundaryFootprintEdges O) + r a (LatticeTileGridStructure O hOL).2.2 hpathp hpathm + Set.inter_subset_right Set.inter_subset_right + Set.inter_subset_right Set.inter_subset_right hinv hvO.symm heO.symm + hfreeV hfreeE hcontact hsep ⟨hap, ham⟩ + have real_action (z : GaussianInt) : GaussianRealPoint (r z) = + (2 * (TileCentroid O).1 - (GaussianRealPoint z).1, + 2 * (TileCentroid O).2 - (GaussianRealPoint z).2) := by + have hx := congrArg Prod.fst hw + have hy := congrArg Prod.snd hw + dsimp [GaussianRealPoint] at hx hy + change (((w.re - z.re : Int) : Real), ((w.im - z.im : Int) : Real)) = _ + push_cast + exact Prod.ext (by dsimp [GaussianRealPoint]; linarith) + (by dsimp [GaussianRealPoint]; linarith) + have hrealcontact : + (fun z : GaussianInt => + (2 * (TileCentroid O).1 - (GaussianRealPoint z).1, + 2 * (TileCentroid O).2 - (GaussianRealPoint z).2)) '' + (p.toFinset : Set GaussianInt) = + GaussianRealPoint '' (q.toFinset : Set GaussianInt) := by + simp_rw [← real_action] + rw [← Set.image_image, hpS, hqS, hcontact] + refine ⟨⟨{ + precursor_cells := hcells + precursor_anchor := hanchor + first_touching := hfirst + second_touching := hsecond + first_plus_child := hXsub + first_minus_child := hYsub + second_plus_child := hUsub + second_minus_child := hVsub + a := a + b := r a + first_transition := first_transition + second_transition := second_transition + branch := Or.inl ⟨hO, p, q, hpN, hqN, hph, hpl, hqh, hql, hpS, hqS, + hpstep, hqstep, hunion, hinter, real_action a, hrealcontact⟩ + }⟩, ?_⟩ + intro e he + exact (hcover e he).imp And.left And.left + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean b/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean new file mode 100644 index 0000000000..37de1a53e4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean @@ -0,0 +1,991 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge +public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition + +-- [TABLET NODE: P4638T1ContactStarCoverage] + +/-! +# P4638T1ContactStarCoverage + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ContactStarGeometry + +private def canonicalEdgeAt (y : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{y, y + ⟨0, 1⟩}, {y - 1, y}, {y - ⟨0, 1⟩, y}, {y, y + 1}] + +private theorem boundaryEdgeOfCross (T : ProtoTile) (y : GaussianInt) (j : Fin 4) + (hcross : (LatticeVertexIncidentCell y j ∈ T.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∉ T.cells) ∨ + (LatticeVertexIncidentCell y j ∉ T.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∈ T.cells)) : + canonicalEdgeAt y j ∈ BoundaryFootprintEdges T := by + classical + fin_cases j + · rcases hcross with ⟨hl, hr⟩ | ⟨hl, hr⟩ + · change y ∈ T.cells at hl + change y - 1 ∉ T.cells at hr + change {y, y + ⟨0, 1⟩} ∈ BoundaryFootprintEdges T + exact ⟨y, Or.inr ⟨rfl, Or.inl ⟨hl, hr⟩⟩⟩ + · change y ∉ T.cells at hl + change y - 1 ∈ T.cells at hr + change {y, y + ⟨0, 1⟩} ∈ BoundaryFootprintEdges T + exact ⟨y, Or.inr ⟨rfl, Or.inr ⟨hl, hr⟩⟩⟩ + · rcases hcross with ⟨hl, hr⟩ | ⟨hl, hr⟩ + · change y - 1 ∈ T.cells at hl + change y - 1 - ⟨0, 1⟩ ∉ T.cells at hr + change {y - 1, y} ∈ BoundaryFootprintEdges T + refine ⟨y - 1, Or.inl ⟨by ext z; simp [], Or.inl ⟨hl, hr⟩⟩⟩ + · change y - 1 ∉ T.cells at hl + change y - 1 - ⟨0, 1⟩ ∈ T.cells at hr + change {y - 1, y} ∈ BoundaryFootprintEdges T + refine ⟨y - 1, Or.inl ⟨by ext z; simp [], Or.inr ⟨hl, hr⟩⟩⟩ + · rcases hcross with ⟨hl, hr⟩ | ⟨hl, hr⟩ + · change y - 1 - ⟨0, 1⟩ ∈ T.cells at hl + change y - ⟨0, 1⟩ ∉ T.cells at hr + change {y - ⟨0, 1⟩, y} ∈ BoundaryFootprintEdges T + refine ⟨y - ⟨0, 1⟩, Or.inr ⟨by ext z; simp [sub_add_cancel], Or.inr ⟨hr, ?_⟩⟩⟩ + simpa [sub_eq_add_neg, add_comm, add_left_comm, add_assoc] using hl + · change y - 1 - ⟨0, 1⟩ ∉ T.cells at hl + change y - ⟨0, 1⟩ ∈ T.cells at hr + change {y - ⟨0, 1⟩, y} ∈ BoundaryFootprintEdges T + refine ⟨y - ⟨0, 1⟩, Or.inr ⟨by ext z; simp [sub_add_cancel], Or.inl ⟨hr, ?_⟩⟩⟩ + simpa [sub_eq_add_neg, add_comm, add_left_comm, add_assoc] using hl + · rcases hcross with ⟨hl, hr⟩ | ⟨hl, hr⟩ + · change y - ⟨0, 1⟩ ∈ T.cells at hl + change y ∉ T.cells at hr + change {y, y + 1} ∈ BoundaryFootprintEdges T + refine ⟨y, Or.inl ⟨rfl, Or.inr ⟨hr, ?_⟩⟩⟩ + simpa using hl + · change y - ⟨0, 1⟩ ∉ T.cells at hl + change y ∈ T.cells at hr + change {y, y + 1} ∈ BoundaryFootprintEdges T + exact ⟨y, Or.inl ⟨rfl, Or.inl ⟨hr, hl⟩⟩⟩ + +end ContactStarGeometry + +namespace ContactStarCases + +private theorem hdisjPlusO : + (by + classical + exact + ∀ (Dplus : ProtoTile), ∀ (O : ProtoTile), (Finset.Nonempty O.cells) → ((TileTouching + Dplus O) → ((Dplus.cells.Nonempty) → (Disjoint Dplus.cells O.cells))) ) := by + classical + intro Dplus O hO htplus hDplus + rcases htplus with ⟨_, _, hd, _⟩ | ⟨hE, _⟩ | ⟨hE, _⟩ + · exact hd + · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hDplus).elim + · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hO).elim + +private theorem hdisjMinusO : + (by + classical + exact + ∀ (Dminus : ProtoTile), ∀ (O : ProtoTile), (Finset.Nonempty O.cells) → ((TileTouching + Dminus O) → ((Dminus.cells.Nonempty) → (Disjoint Dminus.cells O.cells))) ) := by + classical + intro Dminus O hO htminus hDminus + rcases htminus with ⟨_, _, hd, _⟩ | ⟨hE, _⟩ | ⟨hE, _⟩ + · exact hd + · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hDminus).elim + · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hO).elim + +private theorem hpathPlusO : + (by + classical + exact + ∀ (Dplus : ProtoTile), ∀ (O : ProtoTile), (Finset.Nonempty O.cells) → ((TileTouching + Dplus O) → ((Dplus.cells.Nonempty) → (SimpleGridPath (BoundaryFootprintVertices Dplus + ∩ BoundaryFootprintVertices O) (BoundaryFootprintEdges Dplus ∩ BoundaryFootprintEdges + O)))) ) := by + classical + intro Dplus O hO htplus hDplus + rcases htplus with ⟨_, _, _, hp⟩ | ⟨hE, _⟩ | ⟨hE, _⟩ + · exact hp + · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hDplus).elim + · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hO).elim + +private theorem hpathMinusO : + (by + classical + exact + ∀ (Dminus : ProtoTile), ∀ (O : ProtoTile), (Finset.Nonempty O.cells) → ((TileTouching + Dminus O) → ((Dminus.cells.Nonempty) → (SimpleGridPath (BoundaryFootprintVertices + Dminus ∩ BoundaryFootprintVertices O) (BoundaryFootprintEdges Dminus ∩ + BoundaryFootprintEdges O)))) ) := by + classical + intro Dminus O hO htminus hDminus + rcases htminus with ⟨_, _, _, hp⟩ | ⟨hE, _⟩ | ⟨hE, _⟩ + · exact hp + · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hDminus).elim + · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hO).elim + +private theorem boundaryEdgeFootprint : + (by + classical + exact + ∀ (T : ProtoTile), ∀ e ∈ BoundaryFootprintEdges T, e ∈ FootprintEdges T ) := by + classical + intro T e he + let I : GaussianInt := ⟨0, 1⟩ + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [I, Zsqrtd.ext_iff] + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + +private theorem edgeAt_eq : + (by + classical + exact + let edgeAt (y : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{y, y + ⟨0, 1⟩}, {y - 1, y}, + {y - ⟨0, 1⟩, y}, {y, y + 1}] + let offsetAt : Fin 4 → GaussianInt := ![⟨0, 1⟩, -1, -⟨0, 1⟩, 1] + ∀ (y : GaussianInt), ∀ (i : Fin (4 : ℕ)), edgeAt y i = {y, y + offsetAt i} ) := by + classical + intro edgeAt offsetAt y i + fin_cases i <;> ext z <;> simp [edgeAt, offsetAt, sub_eq_add_neg, + or_comm] + +private theorem offsetAt_injective : + (by + classical + exact + let offsetAt : Fin 4 → GaussianInt := ![⟨0, 1⟩, -1, -⟨0, 1⟩, 1] + ∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), offsetAt i = offsetAt j → i = j ) := by + classical + intro offsetAt i j h + fin_cases i <;> fin_cases j <;> + simp [offsetAt, Zsqrtd.ext_iff] at h ⊢ + +private theorem edgeAt_injective : + (by + classical + exact + let edgeAt (y : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{y, y + ⟨0, 1⟩}, {y - 1, y}, + {y - ⟨0, 1⟩, y}, {y, y + 1}] + let offsetAt : Fin 4 → GaussianInt := ![⟨0, 1⟩, -1, -⟨0, 1⟩, 1] + (∀ (y : GaussianInt), ∀ (i : Fin 4), edgeAt y i = {y, y + offsetAt i}) → ((∀ (i : Fin 4), + ∀ (j : Fin 4), (offsetAt i = offsetAt j) → (i = j)) → (∀ (y : GaussianInt), ∀ (i : + Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), edgeAt y i = edgeAt y j → i = j)) ) := by + classical + intro edgeAt offsetAt edgeAt_eq offsetAt_injective y i j h + rw [edgeAt_eq y i, edgeAt_eq y j] at h + have hm : y + offsetAt i ∈ ({y, y + offsetAt j} : Finset GaussianInt) := by + rw [← h] + simp + have heq : y + offsetAt i = y ∨ y + offsetAt i = y + offsetAt j := by + simpa using hm + rcases heq with heq | heq + · have hz : offsetAt i = 0 := by + have h' : y + offsetAt i = y + 0 := by simpa using heq + have := add_left_cancel h' + simpa using this + fin_cases i <;> simp [offsetAt, Zsqrtd.ext_iff] at hz + · exact offsetAt_injective i j (add_left_cancel heq) + +private theorem edgeCross : + (by + classical + exact + ∀ (Dplus : ProtoTile), ∀ (Dminus : ProtoTile), ∀ (O : ProtoTile), (∀ e ∈ + BoundaryFootprintEdges O, e ∈ BoundaryFootprintEdges Dplus ∨ e ∈ + BoundaryFootprintEdges Dminus) → ((Disjoint Dplus.cells O.cells) → ((Disjoint + Dminus.cells O.cells) → ((∀ (T : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ + BoundaryFootprintEdges T) → (e ∈ FootprintEdges T)) → ( + let edgeAt (y : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{y, y + ⟨0, 1⟩}, {y - 1, y}, + {y - ⟨0, 1⟩, y}, {y, y + 1}] + (∀ (y : GaussianInt), ∀ (i : Fin 4), ∀ (j : Fin 4), (edgeAt y i = edgeAt y j) → (i = j)) + → (∀ (y : GaussianInt), ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell y j ∈ O.cells + ∧ LatticeVertexIncidentCell y (j + (1 : Fin (4 : ℕ))) ∉ O.cells ∨ + LatticeVertexIncidentCell y j ∉ O.cells ∧ LatticeVertexIncidentCell y (j + (1 : Fin + (4 : ℕ))) ∈ O.cells → ((LatticeVertexIncidentCell y j ∈ Dplus.cells ∨ + LatticeVertexIncidentCell y j ∈ Dminus.cells) ∨ LatticeVertexIncidentCell y (j + (1 : + Fin (4 : ℕ))) ∈ Dplus.cells ∨ LatticeVertexIncidentCell y (j + (1 : Fin (4 : ℕ))) ∈ + Dminus.cells) ∧ ∃ (e : Finset GaussianInt), y ∈ e ∧ e ∈ BoundaryFootprintEdges O ∧ (e + ∈ BoundaryFootprintEdges Dplus ∨ e ∈ BoundaryFootprintEdges Dminus)))))) ) := by + classical + intro Dplus Dminus O hedges hdisjPlusO hdisjMinusO boundaryEdgeFootprint edgeAt + edgeAt_injective y j hcross + have heO : edgeAt y j ∈ BoundaryFootprintEdges O := + ContactStarGeometry.boundaryEdgeOfCross O y j hcross + have heD := hedges (edgeAt y j) heO + rcases heD with heD | heD + · have hfoot : edgeAt y j ∈ FootprintEdges O ∩ FootprintEdges Dplus := + ⟨boundaryEdgeFootprint O _ heO, boundaryEdgeFootprint Dplus _ heD⟩ + have hcontact : ∃ e, y ∈ e ∧ e ∈ BoundaryFootprintEdges O ∧ + (e ∈ BoundaryFootprintEdges Dplus ∨ e ∈ BoundaryFootprintEdges Dminus) := + ⟨edgeAt y j, by fin_cases j <;> simp [edgeAt], heO, Or.inl heD⟩ + rcases P3102T2CommonEdgeSectorTransition O Dplus y (edgeAt y j) + hdisjPlusO.symm (by fin_cases j <;> simp [edgeAt]) hfoot with + ⟨k, hk, hkocc⟩ + have hk' : edgeAt y k = edgeAt y j := by + change edgeAt y j = edgeAt y k at hk + exact hk.symm + have hkj : k = j := edgeAt_injective y k j hk' + subst k + rcases hkocc with ⟨hfirst, hsecond⟩ | ⟨hfirst, hsecond⟩ + · exact ⟨Or.inr (Or.inl hsecond), hcontact⟩ + · exact ⟨Or.inl (Or.inl hfirst), hcontact⟩ + · have hfoot : edgeAt y j ∈ FootprintEdges O ∩ FootprintEdges Dminus := + ⟨boundaryEdgeFootprint O _ heO, boundaryEdgeFootprint Dminus _ heD⟩ + have hcontact : ∃ e, y ∈ e ∧ e ∈ BoundaryFootprintEdges O ∧ + (e ∈ BoundaryFootprintEdges Dplus ∨ e ∈ BoundaryFootprintEdges Dminus) := + ⟨edgeAt y j, by fin_cases j <;> simp [edgeAt], heO, Or.inr heD⟩ + rcases P3102T2CommonEdgeSectorTransition O Dminus y (edgeAt y j) + hdisjMinusO.symm (by fin_cases j <;> simp [edgeAt]) hfoot with + ⟨k, hk, hkocc⟩ + have hk' : edgeAt y k = edgeAt y j := by + change edgeAt y j = edgeAt y k at hk + exact hk.symm + have hkj : k = j := edgeAt_injective y k j hk' + subst k + rcases hkocc with ⟨hfirst, hsecond⟩ | ⟨hfirst, hsecond⟩ + · exact ⟨Or.inr (Or.inr hsecond), hcontact⟩ + · exact ⟨Or.inl (Or.inr hfirst), hcontact⟩ + +private theorem boundaryVertexOfCross : + (by + classical + exact + let edgeAt (y : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{y, y + ⟨0, 1⟩}, {y - 1, y}, + {y - ⟨0, 1⟩, y}, {y, y + 1}] + (∀ (T : ProtoTile), ∀ (y : GaussianInt), ∀ (j : Fin 4), ((LatticeVertexIncidentCell y j ∈ + T.cells ∧ LatticeVertexIncidentCell y (j + 1) ∉ T.cells) ∨ (LatticeVertexIncidentCell + y j ∉ T.cells ∧ LatticeVertexIncidentCell y (j + 1) ∈ T.cells)) → (edgeAt y j ∈ + BoundaryFootprintEdges T)) → (∀ (T : ProtoTile), ∀ (y : GaussianInt), ∀ (j : Fin (4 : + ℕ)), LatticeVertexIncidentCell y j ∈ T.cells ∧ LatticeVertexIncidentCell y (j + (1 : + Fin (4 : ℕ))) ∉ T.cells ∨ LatticeVertexIncidentCell y j ∉ T.cells ∧ + LatticeVertexIncidentCell y (j + (1 : Fin (4 : ℕ))) ∈ T.cells → y ∈ + BoundaryFootprintVertices T) ) := by + classical + intro edgeAt boundaryEdgeOfCross T y j hcross + have hne : T.cells.Nonempty := by + rcases hcross with ⟨h, _⟩ | ⟨_, h⟩ + · exact ⟨_, h⟩ + · exact ⟨_, h⟩ + unfold BoundaryFootprintVertices + rw [ite_eq_left hne] + exact ⟨edgeAt y j, boundaryEdgeOfCross T y j hcross, + by fin_cases j <;> simp [edgeAt]⟩ + +private theorem incident : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (y : GaussianInt), Finset.Nonempty T.cells → y ∈ FootprintVertices T + → ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell y j ∈ T.cells ) := by + classical + intro T y hne hy + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hy + rcases hy with ⟨c, hc, h | h | h | h⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using h ▸ hc⟩ + · refine ⟨1, ?_⟩ + rw [h] + simpa [LatticeVertexIncidentCell] using hc + · refine ⟨3, ?_⟩ + rw [h] + simpa [LatticeVertexIncidentCell] using hc + · refine ⟨2, ?_⟩ + change y - 1 - ⟨0, 1⟩ ∈ T.cells + rw [h] + convert hc using 1 + ext <;> simp + +private theorem coverLeft : + (by + classical + exact + ∀ (Dplus : ProtoTile), ∀ (Dminus : ProtoTile), ∀ (O : ProtoTile), (Disjoint Dplus.cells + O.cells) → ((Disjoint Dminus.cells O.cells) → ((∀ (y : GaussianInt), ∀ (j : Fin 4), + ((LatticeVertexIncidentCell y j ∈ O.cells ∧ LatticeVertexIncidentCell y (j + 1) ∉ + O.cells) ∨ (LatticeVertexIncidentCell y j ∉ O.cells ∧ LatticeVertexIncidentCell y (j + + 1) ∈ O.cells)) → (((LatticeVertexIncidentCell y j ∈ Dplus.cells ∨ + LatticeVertexIncidentCell y j ∈ Dminus.cells) ∨ (LatticeVertexIncidentCell y (j + 1) + ∈ Dplus.cells ∨ LatticeVertexIncidentCell y (j + 1) ∈ Dminus.cells)) ∧ ∃ e, y ∈ e ∧ e + ∈ BoundaryFootprintEdges O ∧ (e ∈ BoundaryFootprintEdges Dplus ∨ e ∈ + BoundaryFootprintEdges Dminus))) → (∀ (y : GaussianInt), ∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell y j ∈ O.cells ∧ LatticeVertexIncidentCell y (j + (1 : Fin + (4 : ℕ))) ∉ O.cells ∨ LatticeVertexIncidentCell y j ∉ O.cells ∧ + LatticeVertexIncidentCell y (j + (1 : Fin (4 : ℕ))) ∈ O.cells → + LatticeVertexIncidentCell y j ∉ O.cells → LatticeVertexIncidentCell y j ∈ Dplus.cells + ∨ LatticeVertexIncidentCell y j ∈ Dminus.cells))) ) := by + classical + intro Dplus Dminus O hdisjPlusO hdisjMinusO edgeCross y j hcross hnot + rcases hcross with hcase | hcase + · exact (hnot hcase.1).elim + · rcases (edgeCross y j (Or.inr hcase)).1 with hleft | hright + · exact hleft + · rcases hright with hplus | hminus + · exact (Finset.disjoint_left.mp hdisjPlusO hplus hcase.2).elim + · exact (Finset.disjoint_left.mp hdisjMinusO hminus hcase.2).elim + +private theorem coverRight : + (by + classical + exact + ∀ (Dplus : ProtoTile), ∀ (Dminus : ProtoTile), ∀ (O : ProtoTile), (Disjoint Dplus.cells + O.cells) → ((Disjoint Dminus.cells O.cells) → ((∀ (y : GaussianInt), ∀ (j : Fin 4), + ((LatticeVertexIncidentCell y j ∈ O.cells ∧ LatticeVertexIncidentCell y (j + 1) ∉ + O.cells) ∨ (LatticeVertexIncidentCell y j ∉ O.cells ∧ LatticeVertexIncidentCell y (j + + 1) ∈ O.cells)) → (((LatticeVertexIncidentCell y j ∈ Dplus.cells ∨ + LatticeVertexIncidentCell y j ∈ Dminus.cells) ∨ (LatticeVertexIncidentCell y (j + 1) + ∈ Dplus.cells ∨ LatticeVertexIncidentCell y (j + 1) ∈ Dminus.cells)) ∧ ∃ e, y ∈ e ∧ e + ∈ BoundaryFootprintEdges O ∧ (e ∈ BoundaryFootprintEdges Dplus ∨ e ∈ + BoundaryFootprintEdges Dminus))) → (∀ (y : GaussianInt), ∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell y j ∈ O.cells ∧ LatticeVertexIncidentCell y (j + (1 : Fin + (4 : ℕ))) ∉ O.cells ∨ LatticeVertexIncidentCell y j ∉ O.cells ∧ + LatticeVertexIncidentCell y (j + (1 : Fin (4 : ℕ))) ∈ O.cells → + LatticeVertexIncidentCell y (j + (1 : Fin (4 : ℕ))) ∉ O.cells → + LatticeVertexIncidentCell y (j + (1 : Fin (4 : ℕ))) ∈ Dplus.cells ∨ + LatticeVertexIncidentCell y (j + (1 : Fin (4 : ℕ))) ∈ Dminus.cells))) ) := by + classical + intro Dplus Dminus O hdisjPlusO hdisjMinusO edgeCross y j hcross hnot + rcases hcross with hcase | hcase + · rcases (edgeCross y j (Or.inl hcase)).1 with hleft | hright + · rcases hleft with hplus | hminus + · exact (Finset.disjoint_left.mp hdisjPlusO hplus hcase.1).elim + · exact (Finset.disjoint_left.mp hdisjMinusO hminus hcase.1).elim + · exact hright + · exact (hnot hcase.2).elim + +private theorem noCheckerboardDiagonal : + (by + classical + exact + ∀ (T : ProtoTile), NoCheckerboardCellVertex (↑T.cells : Set LatticeCell) → ∀ (y : + GaussianInt), ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell y (j + (1 : Fin (4 : + ℕ))) ∈ T.cells → LatticeVertexIncidentCell y (j + (3 : Fin (4 : ℕ))) ∈ T.cells → + LatticeVertexIncidentCell y j ∉ T.cells → LatticeVertexIncidentCell y (j + (2 : Fin + (4 : ℕ))) ∈ T.cells ) := by + classical + intro T hT y j hside1 hside3 hcenter + by_contra hdiag + unfold NoCheckerboardCellVertex at hT + fin_cases j + · exact (hT y) (Or.inr ⟨by simpa [LatticeVertexIncidentCell] using hside1, + by simpa [LatticeVertexIncidentCell] using hside3, + by simpa [LatticeVertexIncidentCell] using hcenter, + by simpa [LatticeVertexIncidentCell] using hdiag⟩) + · exact (hT y) (Or.inl ⟨by simpa [LatticeVertexIncidentCell] using hside3, + by simpa [LatticeVertexIncidentCell] using hside1, + by simpa [LatticeVertexIncidentCell] using hcenter, + by simpa [LatticeVertexIncidentCell] using hdiag⟩) + · exact (hT y) (Or.inr ⟨by simpa [LatticeVertexIncidentCell] using hside3, + by simpa [LatticeVertexIncidentCell] using hside1, + by simpa [LatticeVertexIncidentCell] using hdiag, + by simpa [LatticeVertexIncidentCell] using hcenter⟩) + · exact (hT y) (Or.inl ⟨by simpa [LatticeVertexIncidentCell] using hside1, + by simpa [LatticeVertexIncidentCell] using hside3, + by simpa [LatticeVertexIncidentCell] using hdiag, + by simpa [LatticeVertexIncidentCell] using hcenter⟩) + +private theorem mixedCornerContradiction : + (by + classical + exact + ∀ (Dplus : ProtoTile), ∀ (Dminus : ProtoTile), ∀ (O : ProtoTile), (Disjoint Dplus.cells + Dminus.cells) → ((Disjoint Dplus.cells O.cells) → ((Disjoint Dminus.cells O.cells) → + ((∀ (T : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges T) → (e + ∈ FootprintEdges T)) → (∀ (J : ProtoTile), ∀ (K : ProtoTile), Finset.Nonempty J.cells + → Finset.Nonempty K.cells → J.cells ⊆ Dplus.cells → K.cells ⊆ Dminus.cells → + TileTouching J K → ∀ (y : GaussianInt), ∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell y j ∈ O.cells → LatticeVertexIncidentCell y (j + (1 : Fin + (4 : ℕ))) ∈ Dplus.cells ∧ LatticeVertexIncidentCell y (j + (3 : Fin (4 : ℕ))) ∈ + Dminus.cells ∨ LatticeVertexIncidentCell y (j + (1 : Fin (4 : ℕ))) ∈ Dminus.cells ∧ + LatticeVertexIncidentCell y (j + (3 : Fin (4 : ℕ))) ∈ Dplus.cells → + LatticeVertexIncidentCell y (j + (2 : Fin (4 : ℕ))) ∉ Dplus.cells → + LatticeVertexIncidentCell y (j + (2 : Fin (4 : ℕ))) ∉ Dminus.cells → y ∈ + BoundaryFootprintVertices J → y ∈ BoundaryFootprintVertices K → False)))) ) := by + classical + intro Dplus Dminus O hdisjoint hdisjPlusO hdisjMinusO boundaryEdgeFootprint J K hJne hKne hJsub + hKsub hJK y j hcenter hassign hdiagPlus hdiagMinus hyJ hyK + have hdisjJK : Disjoint J.cells K.cells := by + rcases hJK with ⟨_, _, hd, _⟩ | ⟨hE, _⟩ | ⟨hE, _⟩ + · exact hd + · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hJne).elim + · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hKne).elim + have hpathJK : SimpleGridPath + (BoundaryFootprintVertices J ∩ BoundaryFootprintVertices K) + (BoundaryFootprintEdges J ∩ BoundaryFootprintEdges K) := by + rcases hJK with ⟨_, _, _, hp⟩ | ⟨hE, _⟩ | ⟨hE, _⟩ + · exact hp + · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hJne).elim + · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hKne).elim + have hyJK : y ∈ BoundaryFootprintVertices J ∩ BoundaryFootprintVertices K := + ⟨hyJ, hyK⟩ + obtain ⟨e, hye, heJK⟩ := SimpleGridPathVertexIncidentEdge _ _ hpathJK y hyJK + have heFoot : e ∈ FootprintEdges J ∩ FootprintEdges K := + ⟨boundaryEdgeFootprint J e heJK.1, boundaryEdgeFootprint K e heJK.2⟩ + obtain ⟨k, hk, hkocc⟩ := P3102T2CommonEdgeSectorTransition J K y e + hdisjJK hye heFoot + have noAdjacent (k : Fin 4) : + ¬ ((LatticeVertexIncidentCell y k ∈ J.cells ∧ + LatticeVertexIncidentCell y (k + 1) ∈ K.cells) ∨ + (LatticeVertexIncidentCell y k ∈ K.cells ∧ + LatticeVertexIncidentCell y (k + 1) ∈ J.cells)) := + (by + have hJcenter : LatticeVertexIncidentCell y j ∉ J.cells := by + intro h + exact (Finset.disjoint_left.mp hdisjPlusO (hJsub h) hcenter).elim + have hKcenter : LatticeVertexIncidentCell y j ∉ K.cells := by + intro h + exact (Finset.disjoint_left.mp hdisjMinusO (hKsub h) hcenter).elim + have hJdiag : LatticeVertexIncidentCell y (j + 2) ∉ J.cells := + fun h => hdiagPlus (hJsub h) + have hKdiag : LatticeVertexIncidentCell y (j + 2) ∉ K.cells := + fun h => hdiagMinus (hKsub h) + rcases hassign with ⟨h1plus, h3minus⟩ | ⟨h1minus, h3plus⟩ + · have hJother : LatticeVertexIncidentCell y (j + 3) ∉ J.cells := by + intro h + exact (Finset.disjoint_left.mp hdisjoint (hJsub h) h3minus).elim + have hKother : LatticeVertexIncidentCell y (j + 1) ∉ K.cells := by + intro h + exact (Finset.disjoint_left.mp hdisjoint.symm (hKsub h) h1plus).elim + clear hJsub hKsub hcenter hdiagPlus hdiagMinus hdisjoint hJne hKne hJK hdisjJK hpathJK + hyJK e hye heJK heFoot hk hkocc h1plus h3minus + fin_cases j <;> (fin_cases k <;> intro hp <;> + rcases hp with ⟨hJL, hKR⟩ | ⟨hKL, hJR⟩ <;> first + | exact hJcenter (by simpa [LatticeVertexIncidentCell] using hJL) + | exact hJcenter (by simpa [LatticeVertexIncidentCell] using hJR) + | exact hKcenter (by simpa [LatticeVertexIncidentCell] using hKL) + | exact hKcenter (by simpa [LatticeVertexIncidentCell] using hKR) + | exact hJdiag (by simpa [LatticeVertexIncidentCell] using hJL) + | exact hJdiag (by simpa [LatticeVertexIncidentCell] using hJR) + | exact hKdiag (by simpa [LatticeVertexIncidentCell] using hKL) + | exact hKdiag (by simpa [LatticeVertexIncidentCell] using hKR) + ) + · have hJother : LatticeVertexIncidentCell y (j + 1) ∉ J.cells := by + intro h + exact (Finset.disjoint_left.mp hdisjoint (hJsub h) h1minus).elim + have hKother : LatticeVertexIncidentCell y (j + 3) ∉ K.cells := by + intro h + exact (Finset.disjoint_left.mp hdisjoint.symm (hKsub h) h3plus).elim + clear hJsub hKsub hcenter hdiagPlus hdiagMinus hdisjoint hJne hKne hJK hdisjJK hpathJK + hyJK e hye heJK heFoot hk hkocc h1minus h3plus + fin_cases j <;> (fin_cases k <;> intro hp <;> + rcases hp with ⟨hJL, hKR⟩ | ⟨hKL, hJR⟩ <;> first + | exact hJcenter (by simpa [LatticeVertexIncidentCell] using hJL) + | exact hJcenter (by simpa [LatticeVertexIncidentCell] using hJR) + | exact hKcenter (by simpa [LatticeVertexIncidentCell] using hKL) + | exact hKcenter (by simpa [LatticeVertexIncidentCell] using hKR) + | exact hJdiag (by simpa [LatticeVertexIncidentCell] using hJL) + | exact hJdiag (by simpa [LatticeVertexIncidentCell] using hJR) + | exact hKdiag (by simpa [LatticeVertexIncidentCell] using hKL) + | exact hKdiag (by simpa [LatticeVertexIncidentCell] using hKR) + ) + ) + exact noAdjacent k (by + rcases hkocc with ⟨hfirst, hsecond⟩ | ⟨hfirst, hsecond⟩ + · exact Or.inl ⟨hfirst, hsecond⟩ + · exact Or.inr ⟨hfirst, hsecond⟩) + +private theorem cornerRescue : + (by + classical + exact + ∀ (Dplus : ProtoTile), ∀ (Dminus : ProtoTile), ∀ (O : ProtoTile), ∀ (O' : ProtoTile), ∀ + (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), + (Finset.Nonempty O.cells) → ((Finset.Nonempty X.cells) → ((Finset.Nonempty Y.cells) → + ((Finset.Nonempty U.cells) → ((Finset.Nonempty V.cells) → ((PrecursorBoundaryArcData + Dplus Dminus O O' X Y U V) → ((NoCheckerboardCellVertex (Dplus.cells : Set + LatticeCell)) → ((NoCheckerboardCellVertex (Dminus.cells : Set LatticeCell)) → + ((Disjoint Dplus.cells O.cells) → ((Disjoint Dminus.cells O.cells) → ((∀ (T : + ProtoTile), ∀ (y : GaussianInt), ∀ (j : Fin 4), ((LatticeVertexIncidentCell y j ∈ + T.cells ∧ LatticeVertexIncidentCell y (j + 1) ∉ T.cells) ∨ (LatticeVertexIncidentCell + y j ∉ T.cells ∧ LatticeVertexIncidentCell y (j + 1) ∈ T.cells)) → (y ∈ + BoundaryFootprintVertices T)) → ((∀ (y : GaussianInt), ∀ (j : Fin 4), + ((LatticeVertexIncidentCell y j ∈ O.cells ∧ LatticeVertexIncidentCell y (j + 1) ∉ + O.cells) ∨ (LatticeVertexIncidentCell y j ∉ O.cells ∧ LatticeVertexIncidentCell y (j + + 1) ∈ O.cells)) → ((LatticeVertexIncidentCell y j ∉ O.cells) → + (LatticeVertexIncidentCell y j ∈ Dplus.cells ∨ LatticeVertexIncidentCell y j ∈ + Dminus.cells))) → ((∀ (y : GaussianInt), ∀ (j : Fin 4), ((LatticeVertexIncidentCell y + j ∈ O.cells ∧ LatticeVertexIncidentCell y (j + 1) ∉ O.cells) ∨ + (LatticeVertexIncidentCell y j ∉ O.cells ∧ LatticeVertexIncidentCell y (j + 1) ∈ + O.cells)) → ((LatticeVertexIncidentCell y (j + 1) ∉ O.cells) → + (LatticeVertexIncidentCell y (j + 1) ∈ Dplus.cells ∨ LatticeVertexIncidentCell y (j + + 1) ∈ Dminus.cells))) → ((∀ (T : ProtoTile), (NoCheckerboardCellVertex (T.cells : Set + LatticeCell)) → (∀ (y : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell y (j + + 1) ∈ T.cells) → ((LatticeVertexIncidentCell y (j + 3) ∈ T.cells) → + ((LatticeVertexIncidentCell y j ∉ T.cells) → (LatticeVertexIncidentCell y (j + 2) ∈ + T.cells))))) → ((∀ (J : ProtoTile), ∀ (K : ProtoTile), (J.cells.Nonempty) → + ((K.cells.Nonempty) → ((J.cells ⊆ Dplus.cells) → ((K.cells ⊆ Dminus.cells) → + ((TileTouching J K) → (∀ (y : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell + y j ∈ O.cells) → (((LatticeVertexIncidentCell y (j + 1) ∈ Dplus.cells ∧ + LatticeVertexIncidentCell y (j + 3) ∈ Dminus.cells) ∨ (LatticeVertexIncidentCell y (j + + 1) ∈ Dminus.cells ∧ LatticeVertexIncidentCell y (j + 3) ∈ Dplus.cells)) → + ((LatticeVertexIncidentCell y (j + 2) ∉ Dplus.cells) → ((LatticeVertexIncidentCell y + (j + 2) ∉ Dminus.cells) → ((y ∈ BoundaryFootprintVertices J) → ((y ∈ + BoundaryFootprintVertices K) → (False)))))))))))) → (∀ (y : GaussianInt), ∀ (j : Fin + (4 : ℕ)), LatticeVertexIncidentCell y j ∈ O.cells → LatticeVertexIncidentCell y (j + + (2 : Fin (4 : ℕ))) ∉ O.cells → LatticeVertexIncidentCell y (j + (1 : Fin (4 : ℕ))) ∉ + O.cells → LatticeVertexIncidentCell y (j + (3 : Fin (4 : ℕ))) ∉ O.cells → + LatticeVertexIncidentCell y (j + (2 : Fin (4 : ℕ))) ∈ Dplus.cells ∨ + LatticeVertexIncidentCell y (j + (2 : Fin (4 : ℕ))) ∈ Dminus.cells))))))))))))))) ) + := by + classical + intro Dplus Dminus O O' X Y U V hO hX hY hU hV data hcheckPlus hcheckMinus hdisjPlusO + hdisjMinusO boundaryVertexOfCross coverLeft coverRight noCheckerboardDiagonal + mixedCornerContradiction y j hcenter hdiagO hside1O hside3O + by_cases hdiagPlus : LatticeVertexIncidentCell y (j + 2) ∈ Dplus.cells + · exact Or.inl hdiagPlus + by_cases hdiagMinus : LatticeVertexIncidentCell y (j + 2) ∈ Dminus.cells + · exact Or.inr hdiagMinus + have hOafter : LatticeVertexIncidentCell y (j + 3 + 1) ∈ O.cells := by + fin_cases j <;> simpa [LatticeVertexIncidentCell] using hcenter + have hcross1 : (LatticeVertexIncidentCell y j ∈ O.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∉ O.cells) := ⟨hcenter, hside1O⟩ + have hcross3 : (LatticeVertexIncidentCell y (j + 3) ∉ O.cells ∧ + LatticeVertexIncidentCell y (j + 3 + 1) ∈ O.cells) := ⟨hside3O, hOafter⟩ + have hs1 := coverRight y j (Or.inl hcross1) hside1O + have hs3 := coverLeft y (j + 3) (Or.inr hcross3) hside3O + have hOvertex := boundaryVertexOfCross O y j (Or.inl hcross1) + rcases hs1 with hs1p | hs1m <;> rcases hs3 with hs3p | hs3m + · exact Or.inl (noCheckerboardDiagonal Dplus hcheckPlus y j hs1p hs3p + (fun h => (Finset.disjoint_left.mp hdisjPlusO h hcenter).elim)) + · exfalso + rcases data.branch with hpos | hzero + · rcases hpos with ⟨_, ⟨plusArc, minusArc, hfields⟩⟩ + rcases hfields with ⟨_, _, _, _, _, _, hplusEq, hminusEq, _, _, _, + hintersection, _, _⟩ + have hcenterPlusNot : LatticeVertexIncidentCell y j ∉ Dplus.cells := by + intro h + exact (Finset.disjoint_left.mp hdisjPlusO h hcenter).elim + have hwrapPlusNot : LatticeVertexIncidentCell y (j + 3 + 1) ∉ Dplus.cells := by + intro h + have hcenter' : LatticeVertexIncidentCell y (j + 3 + 1) ∈ O.cells := by + fin_cases j <;> simpa [LatticeVertexIncidentCell] using hcenter + exact (Finset.disjoint_left.mp hdisjPlusO h hcenter').elim + have hwrapMinusNot : LatticeVertexIncidentCell y (j + 3 + 1) ∉ Dminus.cells := by + intro h + have hcenter' : LatticeVertexIncidentCell y (j + 3 + 1) ∈ O.cells := by + fin_cases j <;> simpa [LatticeVertexIncidentCell] using hcenter + exact (Finset.disjoint_left.mp hdisjMinusO h hcenter').elim + have hplusVertex : y ∈ BoundaryFootprintVertices Dplus := + boundaryVertexOfCross Dplus y j (Or.inr ⟨hcenterPlusNot, hs1p⟩) + have hminusVertex : y ∈ BoundaryFootprintVertices Dminus := by + have hcrossM : LatticeVertexIncidentCell y (j + 3) ∈ Dminus.cells ∧ + LatticeVertexIncidentCell y (j + 3 + 1) ∉ Dminus.cells := + ⟨hs3m, hwrapMinusNot⟩ + exact boundaryVertexOfCross Dminus y (j + 3) (Or.inl hcrossM) + have hplusArc : y ∈ (plusArc.toFinset : Set GaussianInt) := by + rw [hplusEq] + exact ⟨hplusVertex, hOvertex⟩ + have hminusArc : y ∈ (minusArc.toFinset : Set GaussianInt) := by + rw [hminusEq] + exact ⟨hminusVertex, hOvertex⟩ + have hlabels : y = data.a ∨ y = data.b := by + have hmem : y ∈ (plusArc.toFinset : Set GaussianInt) ∩ + (minusArc.toFinset : Set GaussianInt) := ⟨hplusArc, hminusArc⟩ + rw [hintersection] at hmem + simpa using hmem + rcases hlabels with hya | hyb + · have htr := (data.first_transition y).mpr hya + have hXvertex := htr.1 + have hYvertex := htr.2.1 + exact mixedCornerContradiction X Y hX hY data.first_plus_child + data.first_minus_child data.first_touching.1 y j hcenter + (Or.inl ⟨hs1p, hs3m⟩) hdiagPlus hdiagMinus hXvertex hYvertex + · have htr := (data.second_transition y).mpr hyb + have hUvertex := htr.1 + have hVvertex := htr.2.1 + exact mixedCornerContradiction U V hU hV data.second_plus_child + data.second_minus_child data.second_touching.1 y j hcenter + (Or.inl ⟨hs1p, hs3m⟩) hdiagPlus hdiagMinus hUvertex hVvertex + · exact (Finset.not_nonempty_iff_eq_empty.mpr hzero.1 hO).elim + · exfalso + rcases data.branch with hpos | hzero + · rcases hpos with ⟨_, ⟨plusArc, minusArc, hfields⟩⟩ + rcases hfields with ⟨_, _, _, _, _, _, hplusEq, hminusEq, _, _, _, + hintersection, _, _⟩ + have hcenterMinusNot : LatticeVertexIncidentCell y j ∉ Dminus.cells := by + intro h + exact (Finset.disjoint_left.mp hdisjMinusO h hcenter).elim + have hwrapMinusNot : LatticeVertexIncidentCell y (j + 3 + 1) ∉ Dminus.cells := by + intro h + have hcenter' : LatticeVertexIncidentCell y (j + 3 + 1) ∈ O.cells := by + fin_cases j <;> simpa [LatticeVertexIncidentCell] using hcenter + exact (Finset.disjoint_left.mp hdisjMinusO h hcenter').elim + have hwrapPlusNot : LatticeVertexIncidentCell y (j + 3 + 1) ∉ Dplus.cells := by + intro h + have hcenter' : LatticeVertexIncidentCell y (j + 3 + 1) ∈ O.cells := by + fin_cases j <;> simpa [LatticeVertexIncidentCell] using hcenter + exact (Finset.disjoint_left.mp hdisjPlusO h hcenter').elim + have hminusVertex : y ∈ BoundaryFootprintVertices Dminus := + boundaryVertexOfCross Dminus y j (Or.inr ⟨hcenterMinusNot, hs1m⟩) + have hplusVertex : y ∈ BoundaryFootprintVertices Dplus := by + have hcrossP : LatticeVertexIncidentCell y (j + 3) ∈ Dplus.cells ∧ + LatticeVertexIncidentCell y (j + 3 + 1) ∉ Dplus.cells := + ⟨hs3p, hwrapPlusNot⟩ + exact boundaryVertexOfCross Dplus y (j + 3) (Or.inl hcrossP) + have hplusArc : y ∈ (plusArc.toFinset : Set GaussianInt) := by + rw [hplusEq] + exact ⟨hplusVertex, hOvertex⟩ + have hminusArc : y ∈ (minusArc.toFinset : Set GaussianInt) := by + rw [hminusEq] + exact ⟨hminusVertex, hOvertex⟩ + have hlabels : y = data.a ∨ y = data.b := by + have hmem : y ∈ (plusArc.toFinset : Set GaussianInt) ∩ + (minusArc.toFinset : Set GaussianInt) := ⟨hplusArc, hminusArc⟩ + rw [hintersection] at hmem + simpa using hmem + rcases hlabels with hya | hyb + · have htr := (data.first_transition y).mpr hya + exact mixedCornerContradiction X Y hX hY data.first_plus_child + data.first_minus_child data.first_touching.1 y j hcenter + (Or.inr ⟨hs1m, hs3p⟩) hdiagPlus hdiagMinus htr.1 htr.2.1 + · have htr := (data.second_transition y).mpr hyb + exact mixedCornerContradiction U V hU hV data.second_plus_child + data.second_minus_child data.second_touching.1 y j hcenter + (Or.inr ⟨hs1m, hs3p⟩) hdiagPlus hdiagMinus htr.1 htr.2.1 + · exact (Finset.not_nonempty_iff_eq_empty.mpr hzero.1 hO).elim + · exact Or.inr (noCheckerboardDiagonal Dminus hcheckMinus y j hs1m hs3m + (fun h => (Finset.disjoint_left.mp hdisjMinusO h hcenter).elim)) + +private theorem singletonCorner : + (by + classical + exact + ∀ (y : GaussianInt), ∀ (j : Fin (4 : ℕ)), y ∈ FootprintVertices + (⟨{LatticeVertexIncidentCell y j}, LatticeVertexIncidentCell y j⟩ : ProtoTile) ) := by + classical + intro y j + simp only [FootprintVertices, Finset.singleton_nonempty, ite_true, + Set.mem_ofPred_eq] + refine ⟨LatticeVertexIncidentCell y j, Finset.mem_singleton_self _, ?_⟩ + fin_cases j <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc] + +private theorem ha : + (by + classical + exact + ∀ (y : GaussianInt), ∀ (a : GaussianInt), (y ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile)) + → (∃ j : Fin 4, a = LatticeVertexIncidentCell y j) ) := by + classical + intro y a hya + simp only [FootprintVertices, Finset.singleton_nonempty, ite_true, + Set.mem_ofPred_eq] at hya + rcases hya with ⟨c, hc, h⟩ + simp only [Finset.mem_singleton] at hc + rw [hc] at h + clear hc c + rcases h with h0 | h1 | h2 | h3 + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using h0.symm⟩ + · exact ⟨1, by rw [h1]; simp [LatticeVertexIncidentCell]⟩ + · exact ⟨3, by rw [h2]; simp [LatticeVertexIncidentCell]⟩ + · exact ⟨2, by rw [h3]; simp [LatticeVertexIncidentCell, sub_eq_add_neg, + add_comm, add_left_comm, add_assoc]⟩ + +private theorem coverAt : + (by + classical + exact + ∀ (Dplus : ProtoTile), ∀ (Dminus : ProtoTile), ∀ (O : ProtoTile), (∀ (y : GaussianInt), ∀ + (j : Fin 4), ((LatticeVertexIncidentCell y j ∈ O.cells ∧ LatticeVertexIncidentCell y + (j + 1) ∉ O.cells) ∨ (LatticeVertexIncidentCell y j ∉ O.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∈ O.cells)) → ((LatticeVertexIncidentCell y j ∉ + O.cells) → (LatticeVertexIncidentCell y j ∈ Dplus.cells ∨ LatticeVertexIncidentCell y + j ∈ Dminus.cells))) → ((∀ (y : GaussianInt), ∀ (j : Fin 4), + ((LatticeVertexIncidentCell y j ∈ O.cells ∧ LatticeVertexIncidentCell y (j + 1) ∉ + O.cells) ∨ (LatticeVertexIncidentCell y j ∉ O.cells ∧ LatticeVertexIncidentCell y (j + + 1) ∈ O.cells)) → ((LatticeVertexIncidentCell y (j + 1) ∉ O.cells) → + (LatticeVertexIncidentCell y (j + 1) ∈ Dplus.cells ∨ LatticeVertexIncidentCell y (j + + 1) ∈ Dminus.cells))) → ((∀ (y : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell y j ∈ O.cells) → ((LatticeVertexIncidentCell y (j + 2) ∉ + O.cells) → ((LatticeVertexIncidentCell y (j + 1) ∉ O.cells) → + ((LatticeVertexIncidentCell y (j + 3) ∉ O.cells) → (LatticeVertexIncidentCell y (j + + 2) ∈ Dplus.cells ∨ LatticeVertexIncidentCell y (j + 2) ∈ Dminus.cells))))) → (∀ (y : + GaussianInt), ∀ (jo : Fin (4 : ℕ)), (LatticeVertexIncidentCell y jo ∈ O.cells) → (∀ + (i : Fin (4 : ℕ)), LatticeVertexIncidentCell y i ∈ O.cells ∨ + LatticeVertexIncidentCell y i ∈ Dplus.cells ∨ LatticeVertexIncidentCell y i ∈ + Dminus.cells)))) ) := by + classical + intro Dplus Dminus O coverLeft coverRight cornerRescue y jo hjo i + by_cases hiO : LatticeVertexIncidentCell y i ∈ O.cells + · exact Or.inl hiO + · fin_cases jo + · fin_cases i + · exact (hiO (by simpa [LatticeVertexIncidentCell] using hjo)).elim + · right + have hc := coverRight y 0 + (Or.inl ⟨by simpa [LatticeVertexIncidentCell] using hjo, + by simpa [LatticeVertexIncidentCell] using hiO⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · by_cases hs1 : LatticeVertexIncidentCell y 1 ∈ O.cells + · right + have hc := coverRight y 1 + (Or.inl ⟨by simpa [LatticeVertexIncidentCell] using hs1, + by simpa [LatticeVertexIncidentCell] using hiO⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · by_cases hs3 : LatticeVertexIncidentCell y 3 ∈ O.cells + · right + have hc := coverLeft y 2 + (Or.inr ⟨by simpa [LatticeVertexIncidentCell] using hiO, + by simpa [LatticeVertexIncidentCell] using hs3⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · right + have hc := cornerRescue y 0 (by simpa [LatticeVertexIncidentCell] using hjo) + (by simpa [LatticeVertexIncidentCell] using hiO) + (by simpa [LatticeVertexIncidentCell] using hs1) + (by simpa [LatticeVertexIncidentCell] using hs3) + simpa [LatticeVertexIncidentCell] using hc + · right + have hc := coverLeft y 3 + (Or.inr ⟨by simpa [LatticeVertexIncidentCell] using hiO, + by simpa [LatticeVertexIncidentCell] using hjo⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · fin_cases i + · right + have hc := coverLeft y 0 + (Or.inr ⟨by simpa [LatticeVertexIncidentCell] using hiO, + by simpa [LatticeVertexIncidentCell] using hjo⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · exact (hiO (by simpa [LatticeVertexIncidentCell] using hjo)).elim + · right + have hc := coverRight y 1 + (Or.inl ⟨by simpa [LatticeVertexIncidentCell] using hjo, + by simpa [LatticeVertexIncidentCell] using hiO⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · by_cases hs1 : LatticeVertexIncidentCell y 2 ∈ O.cells + · right + have hc := coverRight y 2 + (Or.inl ⟨by simpa [LatticeVertexIncidentCell] using hs1, + by simpa [LatticeVertexIncidentCell] using hiO⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · by_cases hs3 : LatticeVertexIncidentCell y 0 ∈ O.cells + · right + have hc := coverLeft y 3 + (Or.inr ⟨by simpa [LatticeVertexIncidentCell] using hiO, + by simpa [LatticeVertexIncidentCell] using hs3⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · right + have hc := cornerRescue y 1 (by simpa [LatticeVertexIncidentCell] using hjo) + (by simpa [LatticeVertexIncidentCell] using hiO) + (by simpa [LatticeVertexIncidentCell] using hs1) + (by simpa [LatticeVertexIncidentCell] using hs3) + simpa [LatticeVertexIncidentCell] using hc + · fin_cases i + · by_cases hs1 : LatticeVertexIncidentCell y 3 ∈ O.cells + · right + have hc := coverRight y 3 + (Or.inl ⟨by simpa [LatticeVertexIncidentCell] using hs1, + by simpa [LatticeVertexIncidentCell] using hiO⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · by_cases hs3 : LatticeVertexIncidentCell y 1 ∈ O.cells + · right + have hc := coverLeft y 0 + (Or.inr ⟨by simpa [LatticeVertexIncidentCell] using hiO, + by simpa [LatticeVertexIncidentCell] using hs3⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · right + have hc := cornerRescue y 2 (by simpa [LatticeVertexIncidentCell] using hjo) + (by simpa [LatticeVertexIncidentCell] using hiO) + (by simpa [LatticeVertexIncidentCell] using hs1) + (by simpa [LatticeVertexIncidentCell] using hs3) + simpa [LatticeVertexIncidentCell] using hc + · right + have hc := coverLeft y 1 + (Or.inr ⟨by simpa [LatticeVertexIncidentCell] using hiO, + by simpa [LatticeVertexIncidentCell] using hjo⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · exact (hiO (by simpa [LatticeVertexIncidentCell] using hjo)).elim + · right + have hc := coverRight y 2 + (Or.inl ⟨by simpa [LatticeVertexIncidentCell] using hjo, + by simpa [LatticeVertexIncidentCell] using hiO⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · fin_cases i + · right + have hc := coverRight y 3 + (Or.inl ⟨by simpa [LatticeVertexIncidentCell] using hjo, + by simpa [LatticeVertexIncidentCell] using hiO⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · by_cases hs1 : LatticeVertexIncidentCell y 0 ∈ O.cells + · right + have hc := coverRight y 0 + (Or.inl ⟨by simpa [LatticeVertexIncidentCell] using hs1, + by simpa [LatticeVertexIncidentCell] using hiO⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · by_cases hs3 : LatticeVertexIncidentCell y 2 ∈ O.cells + · right + have hc := coverLeft y 1 + (Or.inr ⟨by simpa [LatticeVertexIncidentCell] using hiO, + by simpa [LatticeVertexIncidentCell] using hs3⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · right + have hc := cornerRescue y 3 (by simpa [LatticeVertexIncidentCell] using hjo) + (by simpa [LatticeVertexIncidentCell] using hiO) + (by simpa [LatticeVertexIncidentCell] using hs1) + (by simpa [LatticeVertexIncidentCell] using hs3) + simpa [LatticeVertexIncidentCell] using hc + · right + have hc := coverLeft y 2 + (Or.inr ⟨by simpa [LatticeVertexIncidentCell] using hiO, + by simpa [LatticeVertexIncidentCell] using hjo⟩) + (by simpa [LatticeVertexIncidentCell] using hiO) + simpa [LatticeVertexIncidentCell] using hc + · exact (hiO (by simpa [LatticeVertexIncidentCell] using hjo)).elim + +end ContactStarCases + +theorem P4638T1ContactStarCoverage (Dplus Dminus O O' X Y U V : ProtoTile) + (hO : O.cells.Nonempty) (hOL : LatticeTile O) + (hplus : LatticeTile Dplus) (hminus : LatticeTile Dminus) + (htplus : TileTouching Dplus O) (htminus : TileTouching Dminus O) + (hdisjoint : Disjoint Dplus.cells Dminus.cells) + (hX : X.cells.Nonempty) (hY : Y.cells.Nonempty) + (hU : U.cells.Nonempty) (hV : V.cells.Nonempty) + (data : PrecursorBoundaryArcData Dplus Dminus O O' X Y U V) + (hedges : ∀ e ∈ BoundaryFootprintEdges O, + e ∈ BoundaryFootprintEdges Dplus ∨ e ∈ BoundaryFootprintEdges Dminus) : + ∀ y ∈ FootprintVertices O, ∀ a : GaussianInt, + y ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) → + a ∈ O.cells ∨ a ∈ Dplus.cells ∨ a ∈ Dminus.cells := by +-- BODY + classical + have hDplus : Dplus.cells.Nonempty := + (LatticeTileGridStructure Dplus hplus).1.1 + have hDminus : Dminus.cells.Nonempty := + (LatticeTileGridStructure Dminus hminus).1.1 + have hcheckO : NoCheckerboardCellVertex (O.cells : Set LatticeCell) := + (LatticeTileGridStructure O hOL).2.1 + have hcheckPlus : NoCheckerboardCellVertex (Dplus.cells : Set LatticeCell) := + (LatticeTileGridStructure Dplus hplus).2.1 + have hcheckMinus : NoCheckerboardCellVertex (Dminus.cells : Set LatticeCell) := + (LatticeTileGridStructure Dminus hminus).2.1 + have hdisjPlusO := ContactStarCases.hdisjPlusO Dplus O hO htplus hDplus + have hdisjMinusO := ContactStarCases.hdisjMinusO Dminus O hO htminus hDminus + have hpathPlusO := ContactStarCases.hpathPlusO Dplus O hO htplus hDplus + have hpathMinusO := ContactStarCases.hpathMinusO Dminus O hO htminus hDminus + have boundaryEdgeFootprint (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) := ContactStarCases.boundaryEdgeFootprint T e he + let edgeAt (y : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{y, y + ⟨0, 1⟩}, {y - 1, y}, + {y - ⟨0, 1⟩, y}, {y, y + 1}] + let offsetAt : Fin 4 → GaussianInt := ![⟨0, 1⟩, -1, -⟨0, 1⟩, 1] + have edgeAt_eq (y : GaussianInt) (i : Fin 4) := ContactStarCases.edgeAt_eq y i + have offsetAt_injective (i j : Fin 4) (h : offsetAt i = offsetAt j) := + ContactStarCases.offsetAt_injective i j h + have edgeAt_injective (y : GaussianInt) (i j : Fin 4) + (h : edgeAt y i = edgeAt y j) := ContactStarCases.edgeAt_injective edgeAt_eq + offsetAt_injective y i j h + have edgeCross (y : GaussianInt) (j : Fin 4) + (hcross : (LatticeVertexIncidentCell y j ∈ O.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∉ O.cells) ∨ + (LatticeVertexIncidentCell y j ∉ O.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∈ O.cells)) := ContactStarCases.edgeCross Dplus + Dminus O hedges hdisjPlusO hdisjMinusO boundaryEdgeFootprint edgeAt_injective y j + hcross + have boundaryEdgeOfCross (T : ProtoTile) (y : GaussianInt) (j : Fin 4) + (hcross : (LatticeVertexIncidentCell y j ∈ T.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∉ T.cells) ∨ + (LatticeVertexIncidentCell y j ∉ T.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∈ T.cells)) := + ContactStarGeometry.boundaryEdgeOfCross T y j hcross + have boundaryVertexOfCross (T : ProtoTile) (y : GaussianInt) (j : Fin 4) + (hcross : (LatticeVertexIncidentCell y j ∈ T.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∉ T.cells) ∨ + (LatticeVertexIncidentCell y j ∉ T.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∈ T.cells)) := + ContactStarCases.boundaryVertexOfCross boundaryEdgeOfCross T y j hcross + have incident (T : ProtoTile) (y : GaussianInt) + (hne : T.cells.Nonempty) (hy : y ∈ FootprintVertices T) := ContactStarCases.incident T y + hne hy + have coverLeft (y : GaussianInt) (j : Fin 4) + (hcross : (LatticeVertexIncidentCell y j ∈ O.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∉ O.cells) ∨ + (LatticeVertexIncidentCell y j ∉ O.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∈ O.cells)) + (hnot : LatticeVertexIncidentCell y j ∉ O.cells) := ContactStarCases.coverLeft Dplus Dminus + O hdisjPlusO hdisjMinusO edgeCross y j hcross hnot + have coverRight (y : GaussianInt) (j : Fin 4) + (hcross : (LatticeVertexIncidentCell y j ∈ O.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∉ O.cells) ∨ + (LatticeVertexIncidentCell y j ∉ O.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∈ O.cells)) + (hnot : LatticeVertexIncidentCell y (j + 1) ∉ O.cells) := ContactStarCases.coverRight Dplus + Dminus O hdisjPlusO hdisjMinusO edgeCross y j hcross hnot + have noCheckerboardDiagonal (T : ProtoTile) + (hT : NoCheckerboardCellVertex (T.cells : Set LatticeCell)) + (y : GaussianInt) (j : Fin 4) + (hside1 : LatticeVertexIncidentCell y (j + 1) ∈ T.cells) + (hside3 : LatticeVertexIncidentCell y (j + 3) ∈ T.cells) + (hcenter : LatticeVertexIncidentCell y j ∉ T.cells) := + ContactStarCases.noCheckerboardDiagonal T hT y j hside1 hside3 hcenter + have mixedCornerContradiction (J K : ProtoTile) + (hJne : J.cells.Nonempty) (hKne : K.cells.Nonempty) + (hJsub : J.cells ⊆ Dplus.cells) (hKsub : K.cells ⊆ Dminus.cells) + (hJK : TileTouching J K) (y : GaussianInt) (j : Fin 4) + (hcenter : LatticeVertexIncidentCell y j ∈ O.cells) + (hassign : (LatticeVertexIncidentCell y (j + 1) ∈ Dplus.cells ∧ + LatticeVertexIncidentCell y (j + 3) ∈ Dminus.cells) ∨ + (LatticeVertexIncidentCell y (j + 1) ∈ Dminus.cells ∧ + LatticeVertexIncidentCell y (j + 3) ∈ Dplus.cells)) + (hdiagPlus : LatticeVertexIncidentCell y (j + 2) ∉ Dplus.cells) + (hdiagMinus : LatticeVertexIncidentCell y (j + 2) ∉ Dminus.cells) + (hyJ : y ∈ BoundaryFootprintVertices J) + (hyK : y ∈ BoundaryFootprintVertices K) := ContactStarCases.mixedCornerContradiction Dplus + Dminus O hdisjoint hdisjPlusO hdisjMinusO boundaryEdgeFootprint J K hJne hKne hJsub + hKsub hJK y j hcenter hassign hdiagPlus hdiagMinus hyJ hyK + have cornerRescue (y : GaussianInt) (j : Fin 4) + (hcenter : LatticeVertexIncidentCell y j ∈ O.cells) + (hdiagO : LatticeVertexIncidentCell y (j + 2) ∉ O.cells) + (hside1O : LatticeVertexIncidentCell y (j + 1) ∉ O.cells) + (hside3O : LatticeVertexIncidentCell y (j + 3) ∉ O.cells) := ContactStarCases.cornerRescue + Dplus Dminus O O' X Y U V hO hX hY hU hV data hcheckPlus hcheckMinus hdisjPlusO + hdisjMinusO boundaryVertexOfCross coverLeft coverRight noCheckerboardDiagonal + mixedCornerContradiction y j hcenter hdiagO hside1O hside3O + have singletonCorner (y : GaussianInt) (j : Fin 4) := ContactStarCases.singletonCorner y j + intro y hy a hya + obtain ⟨jo, hjo⟩ := incident O y hO hy + have ha := ContactStarCases.ha y a hya + have coverAt (i : Fin 4) := ContactStarCases.coverAt Dplus Dminus O coverLeft coverRight + cornerRescue y jo hjo i + rcases ha with ⟨i, hai⟩ + rw [hai] + exact coverAt i + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyCurvature.lean b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyCurvature.lean new file mode 100644 index 0000000000..980b2af2a7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyCurvature.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure + +-- [TABLET NODE: P4638T1EmptyCurvature] + +/-! +# P4638T1EmptyCurvature + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4638T1EmptyCurvature (C : CircleCoordinates) (T : ProtoTile) + (hT : BandPrototile C T) (hempty : T.cells = ∅) : C.1 = 0 := by +-- BODY + induction hT with + | line w x hw => rfl + | unit z x anchor => simp at hempty + | @decompose q hq S U hS hcells hfoot hcent ih => + have children : ∀ i s, (S i s).cells = ∅ := by + intro i s + apply Finset.eq_empty_iff_forall_notMem.mpr + intro a ha + have hu := (hcells a).mpr ⟨i, s, ha⟩ + rw [hempty] at hu + exact Finset.notMem_empty a hu + have h0 := ih 0 true (children 0 true) + have h1 := ih 1 true (children 1 true) + have bad := (ProperBandCurvatureStructure q hq).2.2 0 1 h0 h1 + exact False.elim (by simp at bad) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean new file mode 100644 index 0000000000..2174b4fdd4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean @@ -0,0 +1,1039 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas + +-- [TABLET NODE: P4638T1EmptyFordLocalization] + +/-! +# P4638T1EmptyFordLocalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace EmptyFordGeometry + +private theorem hρ : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ((r (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → (((0 : ℤ) < (r + (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (r i.succ).1) ∧ ∀ (i : Fin (3 + : ℕ)), ∀ (j : Fin (3 : ℕ)), (r i.succ).1 = (0 : ℤ) → (r j.succ).1 = (0 : ℤ) → i = j) + → (∀ (ρ : Fin (3 : ℕ)), ∀ (g₀ : BandPackingSymmetry), ∀ (P : FordFareyParameter), ((r + (ρ + (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g₀ + ![r (0 : Fin (4 : ℕ)), r ρ.succ, r (ρ + (1 : Fin (3 : ℕ))).succ, r (ρ + (2 : Fin (3 : + ℕ))).succ] = FordRecursiveQuadruple P) → (ρ = 1)))) ) := by + classical + intro r hline hcurve ρ g₀ P hz hrec + have huni := hcurve.2.2 + fin_cases ρ + · have hbad := huni 0 2 hline (by simpa using hz) + exact False.elim ((by decide : (0 : Fin 3) ≠ 2) hbad) + · rfl + · have hbad := huni 0 1 hline (by simpa using hz) + exact False.elim ((by decide : (0 : Fin 3) ≠ 1) hbad) + +private theorem hp : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), (ProperBandQuadruple r) → ( + let p : Fin 4 → CircleCoordinates := ![r 0, r 2, r 3, r 1] + ProperBandQuadruple p) ) := by + classical + intro r hr p + refine ⟨SemiProperQuadruple.rotate hr.1, ?_⟩ + intro j + fin_cases j <;> simp? [p] <;> first | exact hr.2 0 | exact hr.2 1 | exact hr.2 2 + +private theorem hq1 : + (by + classical + exact + (Fin 4 → CircleCoordinates) → (∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → (0 < P.q₁)) + ) := by + classical + intro r P hP + by_contra hn + have hzq : P.q₁ = 0 := by omega + have hd := P.det₁ + simp [hzq, P.sum_q] at hd + have hdiv : (P.q₂ : Int) ∣ 1 := ⟨P.p₁, by nlinarith⟩ + have hone : (P.q₂ : Int) = 1 := + Int.eq_one_of_dvd_one (by exact_mod_cast (Nat.zero_le P.q₂)) hdiv + have honeNat : P.q₂ = 1 := by exact_mod_cast hone + have hqeq : P.q = 1 := by + rw [P.sum_q, hzq, honeNat] + rw [hqeq] at hP + have hnot : ¬ 1 < 1 := by omega + exact hnot hP + +private theorem hrecg : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (g₀ : BandPackingSymmetry), ∀ (P : + FordFareyParameter), (BandPackingSymmetryReversesOrientation g₀ = false) → ((∃ (w : + GaussianInt), g₀ = BandPackingSymmetry.shift w ∨ g₀ = (BandPackingSymmetry.shift + w).comp BandPackingSymmetry.negate) → ((BandPackingSymmetryQuadrupleAction g₀ ![r (0 + : Fin (4 : ℕ)), r (Fin.succ (1 : Fin (3 : ℕ))), r ((1 : Fin (3 : ℕ)) + (1 : Fin (3 : + ℕ))).succ, r ((1 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ] = FordRecursiveQuadruple + P) → ( + let p : Fin 4 → CircleCoordinates := ![r 0, r 2, r 3, r 1] + (BandPackingSymmetryQuadrupleAction g₀ p = FordRecursiveQuadruple P) → (∀ (neg : Bool), + (BandPackingSymmetryScopedPhase g₀ p neg) → ((∀ (t : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = p (2 : Fin (4 : ℕ)) + → t (1 : Fin (4 : ℕ)) = p (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g₀ t + neg) → ((∀ (C : CircleCoordinates), BandPackingSymmetryCircleAction + ((BandPackingSymmetry.negate.comp BandPackingSymmetry.negate).comp g₀) C = + BandPackingSymmetryCircleAction g₀ C) → ((BandPackingSymmetryReversesOrientation + ((BandPackingSymmetry.negate.comp BandPackingSymmetry.negate).comp g₀) = + BandPackingSymmetryReversesOrientation g₀) → ((∀ (p : Fin (4 : ℕ) → + CircleCoordinates), BandPackingSymmetryQuadrupleAction + ((BandPackingSymmetry.negate.comp BandPackingSymmetry.negate).comp g₀) p = + BandPackingSymmetryQuadrupleAction g₀ p) → ((∀ (v : GaussianInt), + BandPackingSymmetryVectorAction ((BandPackingSymmetry.negate.comp + BandPackingSymmetry.negate).comp g₀) v = -BandPackingSymmetryVectorAction g₀ v) → (∀ + (g : BandPackingSymmetry), (g = g₀ ∨ g = (BandPackingSymmetry.negate.comp + BandPackingSymmetry.negate).comp g₀) → ((∀ (C : CircleCoordinates), + BandPackingSymmetryCircleAction g C = BandPackingSymmetryCircleAction g₀ C) → + ((BandPackingSymmetryReversesOrientation g = BandPackingSymmetryReversesOrientation + g₀) → ((∀ (p : Fin (4 : ℕ) → CircleCoordinates), BandPackingSymmetryQuadrupleAction g + p = BandPackingSymmetryQuadrupleAction g₀ p) → ((BandPackingSymmetryScopedPhase g p + false) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : + Fin (4 : ℕ)) = p (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = p (2 : Fin (4 : ℕ)) → r (3 + : Fin (4 : ℕ)) = p (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g r false) → + (BandPackingSymmetryQuadrupleAction g p = FordRecursiveQuadruple P)))))))))))))))) ) + := by + classical + intro r g₀ P hg₀ hw₀ hrec p hrec' neg hphase hcyclic hcirc horient hquad hvec g hg hcirg + horientg hquadg hfalse hfalsecyc + rcases hg with rfl | rfl + · exact hrec' + · rw [hquadg p] + exact hrec' + +private theorem hcanonical : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (P : FordFareyParameter), + let p : Fin 4 → CircleCoordinates := ![r 0, r 2, r 3, r 1] + ∀ (g : BandPackingSymmetry), (BandPackingSymmetryQuadrupleAction g p = + FordRecursiveQuadruple P) → ((BandPackingSymmetryReversesOrientation g = false) → + ((BandPackingSymmetryScopedPhase g p false) → (BandVectors.1 ((FordRecursiveQuadruple + P) 2) ((FordRecursiveQuadruple P) 1) = BandPackingSymmetryVectorAction g + (BandVectors.1 (p 2) (p 1))))) ) := by + classical + intro r P p g hrecg hgfalse hphase2 + have h := hphase2 2 + simpa [BandPackingSymmetryScopedPhase, hrecg, hgfalse] using h.2.2 + +private theorem hproperFord : + (by + classical + exact + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → (ProperBandQuadruple + (FordRecursiveQuadruple P)) ) := by + classical + intro P hP + have h := (FordCoordinateConfiguration P).2 hP + exact h.1 + +private theorem hvector : + (by + classical + exact + (Fin 4 → CircleCoordinates) → (∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((P.q = P.q₁ + + P.q₂) → ((ProperBandQuadruple (FordRecursiveQuadruple P)) → (BandVectors.1 + ((FordRecursiveQuadruple P) 2) ((FordRecursiveQuadruple P) 1) = -((P.q₁ : Int) : + GaussianInt) + ⟨0, (P.q₂ : Int)⟩)))) ) := by + classical + intro r P hP hsum hproperFord + let F := FordRecursiveQuadruple P + have hrot : SemiProperQuadruple ![F 0, F 2, F 3, F 1] := + SemiProperQuadruple.rotate hproperFord.1 + obtain ⟨hsumv, _, h10, _, _⟩ := VectorRecursionLaws F hproperFord.1 + obtain ⟨_, _, h20, _, _⟩ := VectorRecursionLaws ![F 0, F 2, F 3, F 1] hrot + obtain ⟨_, hF10, hF20, _⟩ := (FordCoordinateConfiguration P).2 hP + have h10' : BandVectors.1 (F 1) (F 0) = ⟨(P.q : Int), (P.q₁ : Int)⟩ := hF10 + have h20' : BandVectors.1 (F 2) (F 0) = ⟨-(P.q : Int), (P.q₂ : Int)⟩ := hF20 + have h20rot : BandVectors.1 (F 2) (F 0) = + BandVectors.1 (F 2) (F 1) - ⟨0, 1⟩ * BandVectors.1 (F 3) (F 2) := by + simpa using h20 + have h10eq : (⟨(P.q : Int), (P.q₁ : Int)⟩ : GaussianInt) = + BandVectors.1 (F 1) (F 3) - ⟨0, 1⟩ * BandVectors.1 (F 2) (F 1) := by + simpa [h10'] using h10 + let u := BandVectors.1 (F 3) (F 2) + let v := BandVectors.1 (F 1) (F 3) + let t := BandVectors.1 (F 2) (F 1) + let ii : GaussianInt := ⟨0, 1⟩ + have hx : (⟨(P.q : Int), (P.q₁ : Int)⟩ : GaussianInt) = v - ii * t := by + simpa [v, t, ii] using h10eq + have hy : (⟨-(P.q : Int), (P.q₂ : Int)⟩ : GaussianInt) = t - ii * u := by + simpa [t, u, ii, h20'] using h20rot + have hcyc : u + v + t = 0 := by simpa [u, v, t] using hsumv + have hv : v = (⟨(P.q : Int), (P.q₁ : Int)⟩ : GaussianInt) + ii * t := by + calc + v = (v - ii * t) + ii * t := by abel + _ = _ := by rw [← hx] + have hu : u = -ii * t + ii * (⟨-(P.q : Int), (P.q₂ : Int)⟩ : GaussianInt) := by + have hyre := congrArg Zsqrtd.re hy + have hyim := congrArg Zsqrtd.im hy + ext <;> simp [ii] at hyre hyim ⊢ <;> omega + have hsumzero : (⟨(P.q : Int), (P.q₁ : Int)⟩ : GaussianInt) + + ii * (⟨-(P.q : Int), (P.q₂ : Int)⟩ : GaussianInt) + t = 0 := by + calc + _ = u + v + t := by rw [hu, hv]; ring + _ = 0 := hcyc + have ht : t = -((⟨(P.q : Int), (P.q₁ : Int)⟩ : GaussianInt) + + ii * (⟨-(P.q : Int), (P.q₂ : Int)⟩ : GaussianInt)) := by + have hsumzero' : (⟨(P.q : Int), (P.q₁ : Int)⟩ : GaussianInt) + + ii * (⟨-(P.q : Int), (P.q₂ : Int)⟩ : GaussianInt) + t = 0 := hsumzero + have hneg : -((⟨(P.q : Int), (P.q₁ : Int)⟩ : GaussianInt) + + ii * (⟨-(P.q : Int), (P.q₂ : Int)⟩ : GaussianInt)) = t := by + have h := congrArg Neg.neg (add_eq_zero_iff_eq_neg.mp hsumzero') + simpa using h + exact hneg.symm + calc + BandVectors.1 ((FordRecursiveQuadruple P) 2) ((FordRecursiveQuadruple P) 1) = t := rfl + _ = -((⟨(P.q : Int), (P.q₁ : Int)⟩ : GaussianInt) + + ii * (⟨-(P.q : Int), (P.q₂ : Int)⟩ : GaussianInt)) := ht + _ = -((P.q₁ : Int) : GaussianInt) + ⟨0, (P.q₂ : Int)⟩ := by + ext <;> simp [ii, hsum] + +private theorem htargetvec : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (P : FordFareyParameter), + let p : Fin 4 → CircleCoordinates := ![r 0, r 2, r 3, r 1] + ∀ (g : BandPackingSymmetry), (BandVectors.1 ((FordRecursiveQuadruple P) 2) + ((FordRecursiveQuadruple P) 1) = BandPackingSymmetryVectorAction g (BandVectors.1 (p + 2) (p 1))) → ((BandVectors.1 ((FordRecursiveQuadruple P) 2) ((FordRecursiveQuadruple + P) 1) = -((P.q₁ : Int) : GaussianInt) + ⟨0, (P.q₂ : Int)⟩) → + (BandPackingSymmetryVectorAction g (BandVectors.1 (r 3) (r 2)) = -((P.q₁ : Int) : + GaussianInt) + ⟨0, (P.q₂ : Int)⟩)) ) := by + classical + intro r P p g hcanonical hvector + simpa [p] using hcanonical.symm.trans hvector + +private theorem cellTurn_bij : + (by + classical + exact + let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 + Function.Bijective cellTurn ) := by + classical + intro cellTurn + constructor + · intro a b hab + have hre := congrArg Zsqrtd.re hab + have him := congrArg Zsqrtd.im hab + simp [cellTurn, GaussianQuarterTurn] at hre him + ext <;> simp [cellTurn, GaussianQuarterTurn] at * <;> omega + · intro z + refine ⟨-GaussianQuarterTurn (z + 1), ?_⟩ + ext <;> simp [cellTurn, GaussianQuarterTurn] + +private theorem hword : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (g₀ : BandPackingSymmetry), ∀ (P : + FordFareyParameter), (∃ (w : GaussianInt), g₀ = BandPackingSymmetry.shift w ∨ g₀ = + (BandPackingSymmetry.shift w).comp BandPackingSymmetry.negate) → ( + let p : Fin 4 → CircleCoordinates := ![r 0, r 2, r 3, r 1] + ∀ (g : BandPackingSymmetry), (g = g₀ ∨ g = (BandPackingSymmetry.negate.comp + BandPackingSymmetry.negate).comp g₀) → ((∀ (C : CircleCoordinates), + BandPackingSymmetryCircleAction g C = BandPackingSymmetryCircleAction g₀ C) → + ((BandPackingSymmetryReversesOrientation g = BandPackingSymmetryReversesOrientation + g₀) → ((∀ (p : Fin (4 : ℕ) → CircleCoordinates), BandPackingSymmetryQuadrupleAction g + p = BandPackingSymmetryQuadrupleAction g₀ p) → ((BandPackingSymmetryScopedPhase g p + false) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : + Fin (4 : ℕ)) = p (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = p (2 : Fin (4 : ℕ)) → r (3 + : Fin (4 : ℕ)) = p (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g r false) → + ((BandPackingSymmetryQuadrupleAction g p = FordRecursiveQuadruple P) → + ((BandPackingSymmetryReversesOrientation g = false) → + ((BandPackingSymmetryScopedPhase g p false) → ((BandVectors.1 + ((FordRecursiveQuadruple P) 2) ((FordRecursiveQuadruple P) 1) = + BandPackingSymmetryVectorAction g (BandVectors.1 (p 2) (p 1))) → + ((BandPackingSymmetryVectorAction g (BandVectors.1 (r 3) (r 2)) = -((P.q₁ : Int) : + GaussianInt) + ⟨0, (P.q₂ : Int)⟩) → ( + let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := + if k = 0 then T else if k = 1 then TileQuarterTurn T else + if k = 2 then TileQuarterTurn (TileQuarterTurn T) else + TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)) + let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := + if k = 0 then z else if k = 1 then GaussianQuarterTurn z else + if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∃ k : Fin 4, (∀ T, BandPackingSymmetryTileAction g T = TP k T) ∧ (∀ z, + BandPackingSymmetryVectorAction g z = VP k z))))))))))))) ) := by + classical + intro r g₀ P hw₀ p g hg hcirg horientg hquadg hfalse hfalsecyc hrecg hgfalse hphase2 hcanonical + htargetvec TP VP + rcases hw₀ with ⟨w, hw₀⟩ + rcases hg with hsame | hadapt + · subst g + rcases hw₀ with hw | hw + · refine ⟨0, ?_, ?_⟩ <;> intro x <;> simp [TP, VP, hw, BandPackingSymmetryTileAction, + BandPackingSymmetryVectorAction] + · refine ⟨1, ?_, ?_⟩ <;> intro x <;> simp [TP, VP, hw, BandPackingSymmetryTileAction, + BandPackingSymmetryVectorAction] + · subst g + rcases hw₀ with hw | hw + · refine ⟨2, ?_, ?_⟩ <;> intro x <;> simp [TP, VP, hw, BandPackingSymmetryTileAction, + BandPackingSymmetryVectorAction] + · refine ⟨3, ?_, ?_⟩ <;> intro x <;> simp [TP, VP, hw, BandPackingSymmetryTileAction, + BandPackingSymmetryVectorAction] + +private theorem hcellpow : + (by + classical + exact + ∀ (g : BandPackingSymmetry), + let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 + ∀ (cellTurn_bij : Function.Bijective cellTurn), + let E1 : GaussianInt ≃ GaussianInt := Equiv.ofBijective cellTurn cellTurn_bij + let E2 : GaussianInt ≃ GaussianInt := E1.trans E1 + let E3 : GaussianInt ≃ GaussianInt := E2.trans E1 + let E : Fin 4 → GaussianInt ≃ GaussianInt := ![Equiv.refl _, E1, E2, E3] + let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := + if k = 0 then T else if k = 1 then TileQuarterTurn T else + if k = 2 then TileQuarterTurn (TileQuarterTurn T) else + TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)) + let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := + if k = 0 then z else if k = 1 then GaussianQuarterTurn z else + if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (k : Fin (4 : ℕ)), (∀ (T : ProtoTile), BandPackingSymmetryTileAction g T = TP k T) → + ((∀ (z : GaussianInt), BandPackingSymmetryVectorAction g z = VP k z) → (∀ T, + (BandPackingSymmetryTileAction g T).cells = T.cells.image (E k))) ) := by + classical + intro g cellTurn cellTurn_bij E1 E2 E3 E TP VP k htilepow hvecpow T + rw [htilepow] + fin_cases k <;> + simp [TP, E, E1, E2, E3, cellTurn, TileQuarterTurnFormulas, + Finset.image_image, Function.comp_def] + +private theorem hanchorpow : + (by + classical + exact + ∀ (g : BandPackingSymmetry), + let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 + ∀ (cellTurn_bij : Function.Bijective cellTurn), + let E1 : GaussianInt ≃ GaussianInt := Equiv.ofBijective cellTurn cellTurn_bij + let E2 : GaussianInt ≃ GaussianInt := E1.trans E1 + let E3 : GaussianInt ≃ GaussianInt := E2.trans E1 + let E : Fin 4 → GaussianInt ≃ GaussianInt := ![Equiv.refl _, E1, E2, E3] + let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := + if k = 0 then T else if k = 1 then TileQuarterTurn T else + if k = 2 then TileQuarterTurn (TileQuarterTurn T) else + TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)) + let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := + if k = 0 then z else if k = 1 then GaussianQuarterTurn z else + if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (k : Fin (4 : ℕ)), (∀ (T : ProtoTile), BandPackingSymmetryTileAction g T = TP k T) → + ((∀ (z : GaussianInt), BandPackingSymmetryVectorAction g z = VP k z) → ((∀ T, + (BandPackingSymmetryTileAction g T).cells = T.cells.image (E k)) → (∀ T, + (BandPackingSymmetryTileAction g T).anchor = VP k T.anchor))) ) := by + classical + intro g cellTurn cellTurn_bij E1 E2 E3 E TP VP k htilepow hvecpow hcellpow T + rw [htilepow] + fin_cases k <;> simp [TP, VP, TileQuarterTurnFormulas, GaussianQuarterTurn] + +private theorem hcentpow : + (by + classical + exact + ∀ (g : BandPackingSymmetry), + let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 + ∀ (cellTurn_bij : Function.Bijective cellTurn), + let E1 : GaussianInt ≃ GaussianInt := Equiv.ofBijective cellTurn cellTurn_bij + let E2 : GaussianInt ≃ GaussianInt := E1.trans E1 + let E3 : GaussianInt ≃ GaussianInt := E2.trans E1 + let E : Fin 4 → GaussianInt ≃ GaussianInt := ![Equiv.refl _, E1, E2, E3] + let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := + if k = 0 then T else if k = 1 then TileQuarterTurn T else + if k = 2 then TileQuarterTurn (TileQuarterTurn T) else + TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)) + let RP (k : Fin 4) (x : Real × Real) : Real × Real := + if k = 0 then x else if k = 1 then (-x.2, x.1) else + if k = 2 then (-x.1, -x.2) else (x.2, -x.1) + let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := + if k = 0 then z else if k = 1 then GaussianQuarterTurn z else + if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (k : Fin (4 : ℕ)), (∀ (T : ProtoTile), BandPackingSymmetryTileAction g T = TP k T) → + ((∀ (z : GaussianInt), BandPackingSymmetryVectorAction g z = VP k z) → ((∀ T, + (BandPackingSymmetryTileAction g T).cells = T.cells.image (E k)) → ((∀ T, + (BandPackingSymmetryTileAction g T).anchor = VP k T.anchor) → (∀ T, TileCentroid + (BandPackingSymmetryTileAction g T) = RP k (TileCentroid T))))) ) := by + classical + intro g cellTurn cellTurn_bij E1 E2 E3 E TP RP VP k htilepow hvecpow hcellpow hanchorpow T + rw [htilepow] + fin_cases k <;> simp [TP, RP, TileQuarterTurnFormulas] + +private theorem hchild : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (P : FordFareyParameter), + let p : Fin 4 → CircleCoordinates := ![r 0, r 2, r 3, r 1] + ∀ (g : BandPackingSymmetry), (BandPackingSymmetryQuadrupleAction g p = + FordRecursiveQuadruple P) → ((BandPackingSymmetryReversesOrientation g = false) → + (BandPackingSymmetryCircleAction g (r 0) = (FordRecursiveQuadruple P) 0)) ) := by + classical + intro r P p g hrecg hgfalse + have h := congrFun hrecg 0 + simpa [p, BandPackingSymmetryQuadrupleAction, hgfalse] using h + +private theorem hpointrot : + (by + classical + exact + ∀ (g : BandPackingSymmetry), + let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 + ∀ (cellTurn_bij : Function.Bijective cellTurn), + let E1 : GaussianInt ≃ GaussianInt := Equiv.ofBijective cellTurn cellTurn_bij + let E2 : GaussianInt ≃ GaussianInt := E1.trans E1 + let E3 : GaussianInt ≃ GaussianInt := E2.trans E1 + let E : Fin 4 → GaussianInt ≃ GaussianInt := ![Equiv.refl _, E1, E2, E3] + let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := + if k = 0 then T else if k = 1 then TileQuarterTurn T else + if k = 2 then TileQuarterTurn (TileQuarterTurn T) else + TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)) + let RP (k : Fin 4) (x : Real × Real) : Real × Real := + if k = 0 then x else if k = 1 then (-x.2, x.1) else + if k = 2 then (-x.1, -x.2) else (x.2, -x.1) + let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := + if k = 0 then z else if k = 1 then GaussianQuarterTurn z else + if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (k : Fin (4 : ℕ)), (∀ (T : ProtoTile), BandPackingSymmetryTileAction g T = TP k T) → + ((∀ (z : GaussianInt), BandPackingSymmetryVectorAction g z = VP k z) → ((∀ T, + (BandPackingSymmetryTileAction g T).cells = T.cells.image (E k)) → ((∀ T, + (BandPackingSymmetryTileAction g T).anchor = VP k T.anchor) → ((∀ T, TileCentroid + (BandPackingSymmetryTileAction g T) = RP k (TileCentroid T)) → (∀ (z : GaussianInt), + RP k (GaussianRealPoint z) = GaussianRealPoint (VP k z)))))) ) := by + classical + intro g cellTurn cellTurn_bij E1 E2 E3 E TP RP VP k htilepow hvecpow hcellpow hanchorpow + hcentpow z + fin_cases k <;> ext <;> simp [RP, VP, GaussianRealPoint, GaussianQuarterTurn] + +private theorem hDrot : + (by + classical + exact + ∀ (g : BandPackingSymmetry), + let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 + ∀ (cellTurn_bij : Function.Bijective cellTurn), + let E1 : GaussianInt ≃ GaussianInt := Equiv.ofBijective cellTurn cellTurn_bij + let E2 : GaussianInt ≃ GaussianInt := E1.trans E1 + let E3 : GaussianInt ≃ GaussianInt := E2.trans E1 + let E : Fin 4 → GaussianInt ≃ GaussianInt := ![Equiv.refl _, E1, E2, E3] + let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := + if k = 0 then T else if k = 1 then TileQuarterTurn T else + if k = 2 then TileQuarterTurn (TileQuarterTurn T) else + TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)) + let RP (k : Fin 4) (x : Real × Real) : Real × Real := + if k = 0 then x else if k = 1 then (-x.2, x.1) else + if k = 2 then (-x.1, -x.2) else (x.2, -x.1) + let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := + if k = 0 then z else if k = 1 then GaussianQuarterTurn z else + if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (k : Fin (4 : ℕ)), (∀ (T : ProtoTile), BandPackingSymmetryTileAction g T = TP k T) → + ((∀ (z : GaussianInt), BandPackingSymmetryVectorAction g z = VP k z) → ((∀ T, + (BandPackingSymmetryTileAction g T).cells = T.cells.image (E k)) → ((∀ T, + (BandPackingSymmetryTileAction g T).anchor = VP k T.anchor) → ((∀ T, TileCentroid + (BandPackingSymmetryTileAction g T) = RP k (TileCentroid T)) → ( + let D : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint + z).1)) + (∀ (z : GaussianInt), RP k (GaussianRealPoint z) = GaussianRealPoint (VP k z)) → (∀ (z : + GaussianInt), RP k (D z) = D (VP k z))))))) ) := by + classical + intro g cellTurn cellTurn_bij E1 E2 E3 E TP RP VP k htilepow hvecpow hcellpow hanchorpow + hcentpow D hpointrot z + fin_cases k <;> ext <;> + simp [D, RP, VP, GaussianRealPoint, GaussianQuarterTurn] <;> ring + +private theorem hDcanonical : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (P : FordFareyParameter), ∀ (g : + BandPackingSymmetry), (BandPackingSymmetryVectorAction g (BandVectors.1 (r 3) (r 2)) + = -((P.q₁ : Int) : GaussianInt) + ⟨0, (P.q₂ : Int)⟩) → ( + let RP (k : Fin 4) (x : Real × Real) : Real × Real := + if k = 0 then x else if k = 1 then (-x.2, x.1) else + if k = 2 then (-x.1, -x.2) else (x.2, -x.1) + let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := + if k = 0 then z else if k = 1 then GaussianQuarterTurn z else + if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (k : Fin (4 : ℕ)), (∀ (z : GaussianInt), BandPackingSymmetryVectorAction g z = VP k z) → ( + let D : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint + z).1)) + (∀ (z : GaussianInt), RP k (D z) = D (VP k z)) → (RP k (D (BandVectors.1 (r 3) (r 2))) = + D (-((P.q₁ : Int) : GaussianInt) + ⟨0, (P.q₂ : Int)⟩)))) ) := by + classical + intro r P g htargetvec RP VP k hvecpow D hDrot + rw [hDrot, ← hvecpow, htargetvec] + +private theorem hOempty : + (by + classical + exact + ∀ (O : ProtoTile), (O.cells = ∅) → (∀ (g : BandPackingSymmetry), + let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 + ∀ (cellTurn_bij : Function.Bijective cellTurn), + let E1 : GaussianInt ≃ GaussianInt := Equiv.ofBijective cellTurn cellTurn_bij + let E2 : GaussianInt ≃ GaussianInt := E1.trans E1 + let E3 : GaussianInt ≃ GaussianInt := E2.trans E1 + let E : Fin 4 → GaussianInt ≃ GaussianInt := ![Equiv.refl _, E1, E2, E3] + ∀ (k : Fin (4 : ℕ)), (∀ T, (BandPackingSymmetryTileAction g T).cells = T.cells.image (E + k)) → ((BandPackingSymmetryTileAction g O).cells = ∅)) ) := by + classical + intro O hempty g cellTurn cellTurn_bij E1 E2 E3 E k hcellpow + rw [hcellpow, hempty] + simp + +private theorem hw₀ : + (by + classical + exact + ∀ (O : ProtoTile), ∀ (g : BandPackingSymmetry), + let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := + if k = 0 then z else if k = 1 then GaussianQuarterTurn z else + if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (k : Fin (4 : ℕ)), (∀ T, (BandPackingSymmetryTileAction g T).anchor = VP k T.anchor) → ( + let w₀ := (BandPackingSymmetryTileAction g O).anchor + w₀ = VP k O.anchor) ) := by + classical + intro O g VP k hanchorpow w₀ + dsimp [w₀] + exact hanchorpow O + +private theorem hOcent : + (by + classical + exact + ∀ (O : ProtoTile), + let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := + if k = 0 then z else if k = 1 then GaussianQuarterTurn z else + if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (k : Fin (4 : ℕ)), ∀ (g : BandPackingSymmetry), + let w₀ := (BandPackingSymmetryTileAction g O).anchor + (w₀ = VP k O.anchor) → ( + let RP (k : Fin 4) (x : Real × Real) : Real × Real := + if k = 0 then x else if k = 1 then (-x.2, x.1) else + if k = 2 then (-x.1, -x.2) else (x.2, -x.1) + (∀ T, TileCentroid (BandPackingSymmetryTileAction g T) = RP k (TileCentroid T)) → ((∀ (z + : GaussianInt), RP k (GaussianRealPoint z) = GaussianRealPoint (VP k z)) → + ((TileCentroid O = GaussianRealPoint O.anchor) → (TileCentroid + (BandPackingSymmetryTileAction g O) = GaussianRealPoint w₀)))) ) := by + classical + intro O VP k g w₀ hw₀ RP hcentpow hpointrot hObase + rw [hcentpow, hObase, hpointrot O.anchor, ← hw₀] + +private theorem hAcent' : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (A : ProtoTile), ∀ (O : ProtoTile), (TileCentroid O + - TileCentroid A = -((1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (r (3 : Fin (4 : + ℕ))) (r (2 : Fin (4 : ℕ)))) - (-(GaussianRealPoint (BandVectors.1 (r (3 : Fin (4 : + ℕ))) (r (2 : Fin (4 : ℕ))))).2, (GaussianRealPoint (BandVectors.1 (r (3 : Fin (4 : + ℕ))) (r (2 : Fin (4 : ℕ))))).1)))) → ( + let D : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint + z).1)) + TileCentroid A = TileCentroid O + D (BandVectors.1 (r 3) (r 2))) ) := by + classical + intro r A O hAcent D + ext + · have h := congrArg Prod.fst hAcent + dsimp [D, GaussianRealPoint] at h ⊢ + linarith + · have h := congrArg Prod.snd hAcent + dsimp [D, GaussianRealPoint] at h ⊢ + linarith + +private theorem hBcent' : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (B : ProtoTile), ∀ (O : ProtoTile), (TileCentroid O + - TileCentroid B = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (r (3 : Fin (4 : + ℕ))) (r (2 : Fin (4 : ℕ)))) - (-(GaussianRealPoint (BandVectors.1 (r (3 : Fin (4 : + ℕ))) (r (2 : Fin (4 : ℕ))))).2, (GaussianRealPoint (BandVectors.1 (r (3 : Fin (4 : + ℕ))) (r (2 : Fin (4 : ℕ))))).1))) → ( + let D : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint + z).1)) + TileCentroid B = TileCentroid O - D (BandVectors.1 (r 3) (r 2))) ) := by + classical + intro r B O hBcent D + ext + · have h := congrArg Prod.fst hBcent + dsimp [D, GaussianRealPoint] at h ⊢ + linarith + · have h := congrArg Prod.snd hBcent + dsimp [D, GaussianRealPoint] at h ⊢ + linarith + +private theorem hAactual : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (A : ProtoTile), ∀ (O : ProtoTile), ∀ (P : + FordFareyParameter), + let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := + if k = 0 then z else if k = 1 then GaussianQuarterTurn z else + if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (k : Fin (4 : ℕ)), ∀ (g : BandPackingSymmetry), + let w₀ := (BandPackingSymmetryTileAction g O).anchor + (w₀ = VP k O.anchor) → ( + let RP (k : Fin 4) (x : Real × Real) : Real × Real := + if k = 0 then x else if k = 1 then (-x.2, x.1) else + if k = 2 then (-x.1, -x.2) else (x.2, -x.1) + (∀ T, TileCentroid (BandPackingSymmetryTileAction g T) = RP k (TileCentroid T)) → ( + let D : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint + z).1)) + (∀ (z : GaussianInt), RP k (GaussianRealPoint z) = GaussianRealPoint (VP k z)) → ((RP k + (D (BandVectors.1 (r 3) (r 2))) = D (-((P.q₁ : Int) : GaussianInt) + ⟨0, (P.q₂ : + Int)⟩)) → ((∀ (x : Real × Real), ∀ (y : Real × Real), RP k (x + y) = RP k x + RP k y) + → ((TileCentroid O = GaussianRealPoint O.anchor) → ((TileCentroid A = TileCentroid O + + D (BandVectors.1 (r 3) (r 2))) → (TileCentroid (BandPackingSymmetryTileAction g A) + = GaussianRealPoint w₀ + D (-((P.q₁ : Int) : GaussianInt) + ⟨0, (P.q₂ : Int)⟩)))))))) + ) := by + classical + intro r A O P VP k g w₀ hw₀ RP hcentpow D hpointrot hDcanonical hRPadd hObase hAcent' + rw [hcentpow A, hAcent', hRPadd, hObase, hpointrot O.anchor, hw₀, hDcanonical] + +private theorem hBactual : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (B : ProtoTile), ∀ (O : ProtoTile), ∀ (P : + FordFareyParameter), + let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := + if k = 0 then z else if k = 1 then GaussianQuarterTurn z else + if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (k : Fin (4 : ℕ)), ∀ (g : BandPackingSymmetry), + let w₀ := (BandPackingSymmetryTileAction g O).anchor + (w₀ = VP k O.anchor) → ( + let RP (k : Fin 4) (x : Real × Real) : Real × Real := + if k = 0 then x else if k = 1 then (-x.2, x.1) else + if k = 2 then (-x.1, -x.2) else (x.2, -x.1) + (∀ T, TileCentroid (BandPackingSymmetryTileAction g T) = RP k (TileCentroid T)) → ( + let D : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint + z).1)) + (∀ (z : GaussianInt), RP k (GaussianRealPoint z) = GaussianRealPoint (VP k z)) → ((RP k + (D (BandVectors.1 (r 3) (r 2))) = D (-((P.q₁ : Int) : GaussianInt) + ⟨0, (P.q₂ : + Int)⟩)) → ((∀ (x : Real × Real), ∀ (y : Real × Real), RP k (x - y) = RP k x - RP k y) + → ((TileCentroid O = GaussianRealPoint O.anchor) → ((TileCentroid B = TileCentroid O + - D (BandVectors.1 (r 3) (r 2))) → (TileCentroid (BandPackingSymmetryTileAction g B) + = GaussianRealPoint w₀ - D (-((P.q₁ : Int) : GaussianInt) + ⟨0, (P.q₂ : Int)⟩)))))))) + ) := by + classical + intro r B O P VP k g w₀ hw₀ RP hcentpow D hpointrot hDcanonical hRPsub hObase hBcent' + rw [hcentpow B, hBcent', hRPsub, hObase, hpointrot O.anchor, hw₀, hDcanonical] + +private theorem hAproto : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (A : ProtoTile), (BandPrototile (r (0 : Fin (4 : + ℕ))) A) → (∀ (P : FordFareyParameter), ∀ (g : BandPackingSymmetry), + (BandPackingSymmetryCircleAction g (r 0) = (FordRecursiveQuadruple P) 0) → + (BandPrototile ((FordRecursiveQuadruple P) 0) (BandPackingSymmetryTileAction g A))) ) + := by + classical + intro r A hA P g hchild + have h := (BandPackingSymmetryCovariance g).2.1 (r 0) A + rw [hchild] at h + exact h.mp hA + +private theorem hBproto : + (by + classical + exact + ∀ (r : Fin 4 → CircleCoordinates), ∀ (B : ProtoTile), (BandPrototile (r (0 : Fin (4 : + ℕ))) B) → (∀ (P : FordFareyParameter), ∀ (g : BandPackingSymmetry), + (BandPackingSymmetryCircleAction g (r 0) = (FordRecursiveQuadruple P) 0) → + (BandPrototile ((FordRecursiveQuadruple P) 0) (BandPackingSymmetryTileAction g B))) ) + := by + classical + intro r B hB P g hchild + have h := (BandPackingSymmetryCovariance g).2.1 (r 0) B + rw [hchild] at h + exact h.mp hB + +private theorem hmodel : + (by + classical + exact + ∀ (P : FordFareyParameter), BandPrototile ((FordRecursiveQuadruple P) 0) (FordTile P.q) ) + := by + classical + intro P + simpa [FordRecursiveQuadruple, FordCircleCoordinate] using + (FordTileRecursiveIdentification P).1 + +private theorem hMAcent : + (by + classical + exact + ∀ (O : ProtoTile), ∀ (P : FordFareyParameter), (P.q = P.q₁ + P.q₂) → (∀ (g : + BandPackingSymmetry), + let D : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint + z).1)) + let w₀ := (BandPackingSymmetryTileAction g O).anchor + let uA : GaussianInt := w₀ - ⟨(P.q₁ : Int), 0⟩ + let M_A := TileTranslation (FordTile P.q) uA + (TileCentroid (FordTile P.q) = ((↑P.q : ℝ) / (2 : ℝ), (↑P.q : ℝ) / (2 : ℝ))) → + (TileCentroid M_A = GaussianRealPoint w₀ + D (-((P.q₁ : Int) : GaussianInt) + ⟨0, + (P.q₂ : Int)⟩))) ) := by + classical + intro O P hsum g D w₀ uA M_A hcentFord + rw [(TileTranslationFormulas (FordTile P.q) uA).2.2.2.2.1, hcentFord] + dsimp [uA, D, GaussianRealPoint] + ext <;> simp [hsum] <;> ring + +private theorem hMBcent : + (by + classical + exact + ∀ (O : ProtoTile), ∀ (P : FordFareyParameter), (P.q = P.q₁ + P.q₂) → (∀ (g : + BandPackingSymmetry), + let D : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint + z).1)) + let w₀ := (BandPackingSymmetryTileAction g O).anchor + let uB : GaussianInt := w₀ - ⟨(P.q₂ : Int), (P.q : Int)⟩ + let M_B := TileTranslation (FordTile P.q) uB + (TileCentroid (FordTile P.q) = ((↑P.q : ℝ) / (2 : ℝ), (↑P.q : ℝ) / (2 : ℝ))) → + (TileCentroid M_B = GaussianRealPoint w₀ - D (-((P.q₁ : Int) : GaussianInt) + ⟨0, + (P.q₂ : Int)⟩))) ) := by + classical + intro O P hsum g D w₀ uB M_B hcentFord + rw [(TileTranslationFormulas (FordTile P.q) uB).2.2.2.2.1, hcentFord] + dsimp [uB, D, GaussianRealPoint] + ext <;> simp [hsum] <;> ring + +private theorem hvertices : + (by + classical + exact + ∀ (O : ProtoTile), ∀ (a : GaussianInt), (O.anchor ∈ FootprintVertices (⟨{a}, a⟩ : + ProtoTile)) → (O.anchor = a ∨ O.anchor = a + 1 ∨ O.anchor = a + ⟨0, 1⟩ ∨ O.anchor = a + + 1 + ⟨0, 1⟩) ) := by + classical + intro O a ha + simpa [FootprintVertices] using ha + +private theorem ha'At433 : + (by + classical + exact + ∀ (O : ProtoTile), ∀ (a : GaussianInt), (O.anchor = a + (1 : GaussianInt)) → (a = + O.anchor - 1) ) := by + classical + intro O a h1 + calc a = (a + 1) - 1 := by simp + _ = O.anchor - 1 := by rw [h1] + +private theorem ha'At444 : + (by + classical + exact + ∀ (O : ProtoTile), ∀ (a : GaussianInt), (O.anchor = a + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) → (a = O.anchor - ⟨0, 1⟩) ) := by + classical + intro O a h2 + calc a = (a + ⟨0, 1⟩) - ⟨0, 1⟩ := by simp + _ = O.anchor - ⟨0, 1⟩ := by rw [h2] + +private theorem ha'At455 : + (by + classical + exact + ∀ (O : ProtoTile), ∀ (a : GaussianInt), (O.anchor = a + (1 : GaussianInt) + (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt)) → (a = O.anchor - 1 - ⟨0, 1⟩) ) := by + classical + intro O a h3 + calc a = (a + 1 + ⟨0, 1⟩) - 1 - ⟨0, 1⟩ := by abel + _ = O.anchor - 1 - ⟨0, 1⟩ := by rw [h3] + +private theorem hmemAt468 : + (by + classical + exact + ∀ (O : ProtoTile), ∀ (P : FordFareyParameter), ∀ (g : BandPackingSymmetry), + let w₀ := (BandPackingSymmetryTileAction g O).anchor + let uA : GaussianInt := w₀ - ⟨(P.q₁ : Int), 0⟩ + ∀ (a : GaussianInt), a ∈ (FordTile P.q).cells.image (GaussianTranslation uA) ↔ a - uA ∈ + (FordTile P.q).cells ) := by + classical + intro O P g w₀ uA a + constructor + · intro hx + obtain ⟨z, hz, rfl⟩ := Finset.mem_image.mp hx + simpa [GaussianTranslation] using hz + · intro hz + exact Finset.mem_image.mpr ⟨a - uA, hz, by simp [GaussianTranslation]⟩ + +private theorem hmemAt482 : + (by + classical + exact + ∀ (O : ProtoTile), ∀ (P : FordFareyParameter), ∀ (g : BandPackingSymmetry), + let w₀ := (BandPackingSymmetryTileAction g O).anchor + let uB : GaussianInt := w₀ - ⟨(P.q₂ : Int), (P.q : Int)⟩ + ∀ (a : GaussianInt), a ∈ (FordTile P.q).cells.image (GaussianTranslation uB) ↔ a - uB ∈ + (FordTile P.q).cells ) := by + classical + intro O P g w₀ uB a + constructor + · intro hx + obtain ⟨z, hz, rfl⟩ := Finset.mem_image.mp hx + simpa [GaussianTranslation] using hz + · intro hz + exact Finset.mem_image.mpr ⟨a - uB, hz, by simp [GaussianTranslation]⟩ + +end EmptyFordGeometry + +theorem P4638T1EmptyFordLocalization (r : Fin 4 → CircleCoordinates) + (hr : ProperBandQuadruple r) (A B O : ProtoTile) + (hA : BandPrototile (r 0) A) (hB : BandPrototile (r 0) B) + (hempty : O.cells = ∅) (hline : (r 1).1 = 0) + (hAcent : TileCentroid O - TileCentroid A = + -((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (r 3) (r 2)) - + (-(GaussianRealPoint (BandVectors.1 (r 3) (r 2))).2, + (GaussianRealPoint (BandVectors.1 (r 3) (r 2))).1)))) + (hBcent : TileCentroid O - TileCentroid B = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (r 3) (r 2)) - + (-(GaussianRealPoint (BandVectors.1 (r 3) (r 2))).2, + (GaussianRealPoint (BandVectors.1 (r 3) (r 2))).1))) : + ∃ (P : FordFareyParameter) (g : BandPackingSymmetry) + (e : GaussianInt ≃ GaussianInt), + 0 < P.q₁ ∧ 0 < P.q₂ ∧ + (∀ T : ProtoTile, (BandPackingSymmetryTileAction g T).cells = + T.cells.image e) ∧ + (∀ a : GaussianInt, + O.anchor ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) → + let z := e a - (BandPackingSymmetryTileAction g O).anchor; + z = 0 ∨ z = -1 ∨ z = -⟨0, 1⟩ ∨ z = -1 - ⟨0, 1⟩) ∧ + (∀ a : GaussianInt, + a ∈ (BandPackingSymmetryTileAction g A).cells ↔ + let z := a - (BandPackingSymmetryTileAction g O).anchor; + -(P.q₁ : Int) ≤ z.re ∧ z.re < (P.q₂ : Int) ∧ + 0 ≤ z.im ∧ z.im < ((P.q₁ + P.q₂ : Nat) : Int)) ∧ + (∀ a : GaussianInt, + a ∈ (BandPackingSymmetryTileAction g B).cells ↔ + let z := a - (BandPackingSymmetryTileAction g O).anchor; + -(P.q₂ : Int) ≤ z.re ∧ z.re < (P.q₁ : Int) ∧ + -((P.q₁ + P.q₂ : Nat) : Int) ≤ z.im ∧ z.im < 0) := by +-- BODY + classical + have hcurve := ProperBandCurvatureStructure r hr + obtain ⟨ρ, g₀, P, hP, hg₀, hw₀, hz, hrec⟩ := + FordRegimeConverse r hr ⟨1, hline⟩ + have hρ := EmptyFordGeometry.hρ r hline hcurve ρ g₀ P hz hrec + subst ρ + let p : Fin 4 → CircleCoordinates := ![r 0, r 2, r 3, r 1] + have hp := EmptyFordGeometry.hp r hr + have hrec' : BandPackingSymmetryQuadrupleAction g₀ p = FordRecursiveQuadruple P := by + simpa [p] using hrec + have hq1 := EmptyFordGeometry.hq1 r P hP + have hq2 : 0 < P.q₂ := P.q₂_pos + have hsum : P.q = P.q₁ + P.q₂ := P.sum_q + obtain ⟨neg, hphase, _, hcyclic, hcirc, horient, hquad, hvec, g, hg, hcirg, + horientg, hquadg, hfalse, hfalsecyc, _⟩ := + BandPackingSymmetryProjectiveVectorCovariance g₀ p hp + have hrecg := EmptyFordGeometry.hrecg r g₀ P hg₀ hw₀ hrec hrec' neg hphase hcyclic hcirc + horient hquad hvec g hg hcirg horientg hquadg hfalse hfalsecyc + have hgfalse : BandPackingSymmetryReversesOrientation g = false := by + rw [horientg, hg₀] + have hphase2 : BandPackingSymmetryScopedPhase g p false := hfalse + have hcanonical := EmptyFordGeometry.hcanonical r P g hrecg hgfalse hphase2 + have hproperFord := EmptyFordGeometry.hproperFord P hP + have hvector := EmptyFordGeometry.hvector r P hP hsum hproperFord + have htargetvec := EmptyFordGeometry.htargetvec r P g hcanonical hvector + let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 + have cellTurn_bij := EmptyFordGeometry.cellTurn_bij + let E1 : GaussianInt ≃ GaussianInt := Equiv.ofBijective cellTurn cellTurn_bij + let E2 : GaussianInt ≃ GaussianInt := E1.trans E1 + let E3 : GaussianInt ≃ GaussianInt := E2.trans E1 + let E : Fin 4 → GaussianInt ≃ GaussianInt := ![Equiv.refl _, E1, E2, E3] + let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := + if k = 0 then T else if k = 1 then TileQuarterTurn T else + if k = 2 then TileQuarterTurn (TileQuarterTurn T) else + TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)) + let RP (k : Fin 4) (x : Real × Real) : Real × Real := + if k = 0 then x else if k = 1 then (-x.2, x.1) else + if k = 2 then (-x.1, -x.2) else (x.2, -x.1) + let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := + if k = 0 then z else if k = 1 then GaussianQuarterTurn z else + if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) + have hword := EmptyFordGeometry.hword r g₀ P hw₀ g hg hcirg horientg hquadg hfalse hfalsecyc + hrecg hgfalse hphase2 hcanonical htargetvec + obtain ⟨k, htilepow, hvecpow⟩ := hword + have hcellpow := EmptyFordGeometry.hcellpow g cellTurn_bij k htilepow hvecpow + have hanchorpow := EmptyFordGeometry.hanchorpow g cellTurn_bij k htilepow hvecpow hcellpow + have hcentpow := EmptyFordGeometry.hcentpow g cellTurn_bij k htilepow hvecpow hcellpow hanchorpow + have hchild := EmptyFordGeometry.hchild r P g hrecg hgfalse + let D : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + have hpointrot (z : GaussianInt) := EmptyFordGeometry.hpointrot g cellTurn_bij k htilepow + hvecpow hcellpow hanchorpow hcentpow z + have hDrot (z : GaussianInt) := EmptyFordGeometry.hDrot g cellTurn_bij k htilepow hvecpow + hcellpow hanchorpow hcentpow hpointrot z + have hDcanonical := EmptyFordGeometry.hDcanonical r P g htargetvec k hvecpow hDrot + have hRPadd (x y : Real × Real) : RP k (x + y) = RP k x + RP k y := by + fin_cases k <;> ext <;> simp [RP] <;> ring + have hRPsub (x y : Real × Real) : RP k (x - y) = RP k x - RP k y := by + fin_cases k <;> ext <;> simp [RP] <;> ring + have hOempty := EmptyFordGeometry.hOempty O hempty g cellTurn_bij k hcellpow + let w₀ := (BandPackingSymmetryTileAction g O).anchor + have hw₀ : w₀ = VP k O.anchor := EmptyFordGeometry.hw₀ O g k hanchorpow + have hObase : TileCentroid O = GaussianRealPoint O.anchor := by + simp [TileCentroid, hempty, GaussianRealPoint] + have hOcent := EmptyFordGeometry.hOcent O k g hw₀ hcentpow hpointrot hObase + have hAcent' := EmptyFordGeometry.hAcent' r A O hAcent + have hBcent' := EmptyFordGeometry.hBcent' r B O hBcent + have hAactual := EmptyFordGeometry.hAactual r A O P k g hw₀ hcentpow hpointrot hDcanonical + hRPadd hObase hAcent' + have hBactual := EmptyFordGeometry.hBactual r B O P k g hw₀ hcentpow hpointrot hDcanonical + hRPsub hObase hBcent' + have hfordC : (FordRecursiveQuadruple P) 0 = FordCircleCoordinate P.p P.q := by rfl + have hAproto := EmptyFordGeometry.hAproto r A hA P g hchild + have hBproto := EmptyFordGeometry.hBproto r B hB P g hchild + let uA : GaussianInt := w₀ - ⟨(P.q₁ : Int), 0⟩ + let uB : GaussianInt := w₀ - ⟨(P.q₂ : Int), (P.q : Int)⟩ + let M_A := TileTranslation (FordTile P.q) uA + let M_B := TileTranslation (FordTile P.q) uB + have hmodel := EmptyFordGeometry.hmodel P + have hMA : BandPrototile ((FordRecursiveQuadruple P) 0) M_A := + BandPrototileTranslation _ _ _ hmodel + have hMB : BandPrototile ((FordRecursiveQuadruple P) 0) M_B := + BandPrototileTranslation _ _ _ hmodel + have hcentFord := P4210T1FordSquareCentroid P.q (by omega) + have hMAcent := EmptyFordGeometry.hMAcent O P hsum g hcentFord + have hMBcent := EmptyFordGeometry.hMBcent O P hsum g hcentFord + have hcellA : (BandPackingSymmetryTileAction g A).cells = M_A.cells := + (BandPrototileCentroidUnique _ _ _ hAproto hMA (hAactual.trans hMAcent.symm)).1 + have hcellB : (BandPackingSymmetryTileAction g B).cells = M_B.cells := + (BandPrototileCentroidUnique _ _ _ hBproto hMB (hBactual.trans hMBcent.symm)).1 + refine ⟨P, g, E k, hq1, hq2, hcellpow, ?_, ?_, ?_⟩ + · intro a ha + have hvertices := EmptyFordGeometry.hvertices O a ha + have hE1 (z : GaussianInt) : E1 z = cellTurn z := rfl + have hE2 (z : GaussianInt) : E2 z = cellTurn (cellTurn z) := rfl + have hE3 (z : GaussianInt) : E3 z = cellTurn (cellTurn (cellTurn z)) := rfl + change E k a - w₀ = 0 ∨ E k a - w₀ = -1 ∨ + E k a - w₀ = -⟨0, 1⟩ ∨ E k a - w₀ = -1 - ⟨0, 1⟩ + rw [hw₀] + rcases hvertices with h0 | h1 | h2 | h3 + · rw [h0] + fin_cases k + · exact Or.inl (by + ext <;> simp [E, VP]) + · exact Or.inr (Or.inl (by + ext <;> simp [E, hE1, VP, cellTurn, GaussianQuarterTurn] + )) + · exact Or.inr (Or.inr (Or.inr (by + ext <;> simp [E, hE2, VP, cellTurn, GaussianQuarterTurn] <;> omega))) + · exact Or.inr (Or.inr (Or.inl (by + ext <;> simp [E, hE3, VP, cellTurn, GaussianQuarterTurn]; omega))) + · have ha' : a = O.anchor - 1 := EmptyFordGeometry.ha'At433 O a h1 + rw [ha'] + fin_cases k + · exact Or.inr (Or.inl (by + ext <;> simp [E, VP])) + · exact Or.inr (Or.inr (Or.inr (by + ext <;> simp [E, hE1, VP, cellTurn, GaussianQuarterTurn]; omega))) + · exact Or.inr (Or.inr (Or.inl (by + ext <;> simp [E, hE2, VP, cellTurn, GaussianQuarterTurn]; omega))) + · exact Or.inl (by + ext <;> simp [E, hE3, VP, cellTurn, GaussianQuarterTurn] ) + · have ha' : a = O.anchor - ⟨0, 1⟩ := EmptyFordGeometry.ha'At444 O a h2 + rw [ha'] + fin_cases k + · exact Or.inr (Or.inr (Or.inl (by + ext <;> simp [E, VP]))) + · exact Or.inl (by + ext <;> simp [E, hE1, VP, cellTurn, GaussianQuarterTurn] ) + · exact Or.inr (Or.inl (by + ext <;> simp [E, hE2, VP, cellTurn, GaussianQuarterTurn] + )) + · exact Or.inr (Or.inr (Or.inr (by + ext <;> simp [E, hE3, VP, cellTurn, GaussianQuarterTurn]; omega))) + · have ha' : a = O.anchor - 1 - ⟨0, 1⟩ := EmptyFordGeometry.ha'At455 O a h3 + rw [ha'] + fin_cases k + · exact Or.inr (Or.inr (Or.inr (by + ext <;> simp [E, VP]))) + · exact Or.inr (Or.inr (Or.inl (by + ext <;> simp [E, hE1, VP, cellTurn, GaussianQuarterTurn] + ))) + · exact Or.inl (by + ext <;> simp [E, hE2, VP, cellTurn, GaussianQuarterTurn] ) + · exact Or.inr (Or.inl (by + ext <;> simp [E, hE3, VP, cellTurn, GaussianQuarterTurn] + )) + · intro a + rw [hcellA, (TileTranslationFormulas (FordTile P.q) uA).1] + have hmem : a ∈ (FordTile P.q).cells.image (GaussianTranslation uA) ↔ + a - uA ∈ (FordTile P.q).cells := EmptyFordGeometry.hmemAt468 O P g a + rw [hmem, (P4210T1FordCellRectangles P.q (a - uA)).1] + dsimp [uA, w₀] + omega + · intro a + rw [hcellB, (TileTranslationFormulas (FordTile P.q) uB).1] + have hmem : a ∈ (FordTile P.q).cells.image (GaussianTranslation uB) ↔ + a - uB ∈ (FordTile P.q).cells := EmptyFordGeometry.hmemAt482 O P g a + rw [hmem, (P4210T1FordCellRectangles P.q (a - uB)).1] + dsimp [uB, w₀] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1FordIncidentCells.lean b/LeanPool/ApollonianSuperharmonic/P4638T1FordIncidentCells.lean new file mode 100644 index 0000000000..a1109294eb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4638T1FordIncidentCells.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import Mathlib.Tactic.NormNum + +-- [TABLET NODE: P4638T1FordIncidentCells] + +/-! +# P4638T1FordIncidentCells + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4638T1FordIncidentCells (q1 q2 : Nat) (h1 : 0 < q1) (h2 : 0 < q2) + (z : GaussianInt) + (hz : z = 0 ∨ z = -1 ∨ z = -⟨0, 1⟩ ∨ z = -1 - ⟨0, 1⟩) : + (-(q1 : Int) ≤ z.re ∧ z.re < (q2 : Int) ∧ + 0 ≤ z.im ∧ z.im < ((q1 + q2 : Nat) : Int)) ∨ + (-(q2 : Int) ≤ z.re ∧ z.re < (q1 : Int) ∧ + -((q1 + q2 : Nat) : Int) ≤ z.im ∧ z.im < 0) := by +-- BODY + rcases hz with rfl | rfl | rfl | rfl + all_goals norm_num + all_goals omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1MidpointReflection.lean b/LeanPool/ApollonianSuperharmonic/P4638T1MidpointReflection.lean new file mode 100644 index 0000000000..997bd44c5d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4638T1MidpointReflection.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P4638T1MidpointReflection] + +/-! +# P4638T1MidpointReflection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4638T1MidpointReflection (C : CircleCoordinates) (T U : ProtoTile) + (hT : BandPrototile C T) (hU : BandPrototile C U) + (hnonempty : T.cells.Nonempty) (c : Real × Real) + (hcent : TileCentroid U = + (2 * c.1 - (TileCentroid T).1, 2 * c.2 - (TileCentroid T).2)) : + CentrallyReflectedAt c T U := by +-- BODY + obtain ⟨u, hcells, _⟩ := BandPrototileTranslationNormalForm C U T hU hT + have htransnonempty : (TileTranslation T u).cells.Nonempty := by + rw [(TileTranslationFormulas T u).1] + exact hnonempty.image _ + have hUnonempty : U.cells.Nonempty := hcells.symm ▸ htransnonempty + have hcentcells : TileCentroid U = TileCentroid (TileTranslation T u) := by + simp only [TileCentroid, ite_eq_left htransnonempty, hcells] + have hrealcells : TileRealization U = TileRealization (TileTranslation T u) := by + simp only [TileRealization, hcells] + have hc := hcentcells.trans (TileTranslationFormulas T u).2.2.2.2.1 + have hre := congrArg Prod.fst (hc.symm.trans hcent) + have him := congrArg Prod.snd (hc.symm.trans hcent) + dsimp at hre him + have hs := BandPrototileCentralSymmetry C T hT + unfold CentrallyReflectedAt at hs ⊢ + rw [hrealcells, (TileTranslationFormulas T u).2.2.2.1] + nth_rewrite 1 [hs] + rw [Set.image_image] + congr 1 + funext p + apply Prod.ext <;> dsimp <;> linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4651T1ContactEdgeSeparation.lean b/LeanPool/ApollonianSuperharmonic/P4651T1ContactEdgeSeparation.lean new file mode 100644 index 0000000000..ea918144d6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4651T1ContactEdgeSeparation.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary +public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells + +-- [TABLET NODE: P4651T1ContactEdgeSeparation] + +/-! +# P4651T1ContactEdgeSeparation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4651T1ContactEdgeSeparation (Dplus Dminus O : ProtoTile) + (hp : Disjoint Dplus.cells O.cells) + (hm : Disjoint Dminus.cells O.cells) + (hpm : Disjoint Dplus.cells Dminus.cells) : + (∀ S : ProtoTile, S.cells ⊆ Dplus.cells → + BoundaryFootprintEdges S ∩ BoundaryFootprintEdges O ⊆ + BoundaryFootprintEdges Dplus ∩ BoundaryFootprintEdges O) ∧ + (∀ S : ProtoTile, S.cells ⊆ Dminus.cells → + BoundaryFootprintEdges S ∩ BoundaryFootprintEdges O ⊆ + BoundaryFootprintEdges Dminus ∩ BoundaryFootprintEdges O) ∧ + Disjoint (BoundaryFootprintEdges Dplus ∩ BoundaryFootprintEdges O) + (BoundaryFootprintEdges Dminus ∩ BoundaryFootprintEdges O) := by +-- BODY + classical + have grow (D S : ProtoTile) (hd : Disjoint D.cells O.cells) + (hsub : S.cells ⊆ D.cells) : + BoundaryFootprintEdges S ∩ BoundaryFootprintEdges O ⊆ + BoundaryFootprintEdges D ∩ BoundaryFootprintEdges O := by + have hs : Disjoint S.cells O.cells := Finset.disjoint_left.mpr + (fun _ hx hy => Finset.disjoint_left.mp hd (hsub hx) hy) + rw [← CellDisjointCommonEdgesBoundary S O hs, + ← CellDisjointCommonEdgesBoundary D O hd] + rintro e ⟨⟨x, hx, hshape⟩, he⟩ + exact ⟨⟨x, hsub hx, hshape⟩, he⟩ + refine ⟨fun S hS => grow Dplus S hp hS, + fun S hS => grow Dminus S hm hS, ?_⟩ + apply Set.disjoint_left.mpr + rintro e ⟨hep, heO⟩ ⟨hem, _⟩ + have impossible (a b : GaussianInt) (hadj : FourNeighborAdjacent a b) + (hpE : {a, b} ∈ BoundaryFootprintEdges Dplus) + (hmE : {a, b} ∈ BoundaryFootprintEdges Dminus) + (hOE : {a, b} ∈ BoundaryFootprintEdges O) : False := by + obtain ⟨z, w, hshape⟩ := P4397T1UnitEdgeCells.1 a b hadj + have hP := (P4397T1UnitEdgeCells.2 a b z w hshape Dplus).2.1.mp hpE + have hM := (P4397T1UnitEdgeCells.2 a b z w hshape Dminus).2.1.mp hmE + have hO := (P4397T1UnitEdgeCells.2 a b z w hshape O).2.1.mp hOE + have hpo := Finset.disjoint_left.mp hp + have hmo := Finset.disjoint_left.mp hm + have hpm' := Finset.disjoint_left.mp hpm + rcases hP with ⟨hzp, _⟩ | ⟨_, hwp⟩ <;> + rcases hM with ⟨hzm, _⟩ | ⟨_, hwm⟩ <;> + rcases hO with ⟨hzo, _⟩ | ⟨_, hwo⟩ + all_goals first | exact hpo hzp hzo | exact hpo hwp hwo | + exact hmo hzm hzo | exact hmo hwm hwo | + exact hpm' hzp hzm | exact hpm' hwp hwm + obtain ⟨z, ⟨rfl, _⟩ | ⟨rfl, _⟩⟩ := heO + · exact impossible z (z + 1) (Or.inl rfl) hep hem + ⟨z, Or.inl ⟨rfl, by assumption⟩⟩ + · exact impossible z (z + ⟨0, 1⟩) (Or.inr (Or.inr (Or.inl rfl))) hep hem + ⟨z, Or.inr ⟨rfl, by assumption⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean b/LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean new file mode 100644 index 0000000000..908ca04796 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean @@ -0,0 +1,1463 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycleSubgraphDegreeTwo +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge + +-- [TABLET NODE: P4651T1CycleComplementaryArcs] + +/-! +# P4651T1CycleComplementaryArcs + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CycleArcProof + +private theorem splitInterior : + ∀ (s : List GaussianInt), s.Nodup → ∀ x, x ∈ s → s.head? ≠ some x → s.getLast? ≠ some x → ∃ + l₁ l₂ y z, s = l₁ ++ y :: x :: z :: l₂ ∧ y ≠ z := by + classical + intro s + induction s with + | nil => + intro hn x hx + simp at hx + | cons w s ih => + cases s with + | nil => + intro hn x hx hh hl + simp? at hx + subst x + exact False.elim (hh rfl) + | cons v t => + intro hn x hx hh hl + rcases List.mem_cons.mp hx with hxw | hxTail + · subst x + exact False.elim (hh rfl) + · rcases List.mem_cons.mp hxTail with hxv | hxt + · subst x + cases t with + | nil => exact False.elim (hl rfl) + | cons z zs => + refine ⟨[], zs, w, z, ?_, ?_⟩ + · simp + · intro hwz + subst z + have hnot := (List.nodup_cons.mp hn).1 + apply hnot + simp + · have hvx : v ≠ x := by + intro hvx + subst v + exact (List.nodup_cons.mp (List.nodup_cons.mp hn).2).1 hxt + have hht : (v :: t).head? ≠ some x := by simpa using hvx + have hlt : (v :: t).getLast? ≠ some x := by simpa using hl + obtain ⟨l₁, l₂, y, z, hdec, hyz⟩ := + ih (List.nodup_cons.mp hn).2 x + (List.mem_cons.mpr (Or.inr hxt)) hht hlt + refine ⟨w :: l₁, l₂, y, z, ?_, hyz⟩ + simp [hdec] + +private theorem hSupport : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (Fplus : Set (Finset + GaussianInt)), ∀ (Fminus : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), (p.Nodup) + → (((2 : ℕ) ≤ p.length) → ((Kplus = (↑p.toFinset : Set GaussianInt)) → ((∀ (a : + GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List + GaussianInt), p = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 : + GaussianInt) ∨ b = a + + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ b = a - ⟨(0 : ℤ), (1 : ℤ)⟩) → ((∀ (e : Finset GaussianInt), e ∈ + Fplus ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List + GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (∀ (q : List GaussianInt), (q.Nodup) + → (((2 : ℕ) ≤ q.length) → ((Kminus = (↑q.toFinset : Set GaussianInt)) → ((∀ (a : + GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List + GaussianInt), q = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 : + GaussianInt) ∨ b = a + + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ b = a - ⟨(0 : ℤ), (1 : ℤ)⟩) → ((∀ (e : Finset GaussianInt), e ∈ + Fminus ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List + GaussianInt), q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ( + let X : Set GaussianInt := Kplus ∪ Kminus + let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus + X = {z | ∃ e ∈ GEdges, z ∈ e})))))))))) := by + classical + intro Kplus Kminus Fplus Fminus p hpN hpLen hKp hpStep hpEdges q hqN hqLen hKm hqStep hqEdges X + GEdges + apply Set.ext + intro z + constructor + · intro hz + simp only [X, Set.mem_union] at hz + rcases hz with hz | hz + · obtain ⟨e, hze, he⟩ := SimpleGridPathVertexIncidentEdge Kplus Fplus + ⟨p, hpN, hpLen, hKp, hpStep, hpEdges⟩ z hz + exact ⟨e, Set.mem_union_left _ he, hze⟩ + · obtain ⟨e, hze, he⟩ := SimpleGridPathVertexIncidentEdge Kminus Fminus + ⟨q, hqN, hqLen, hKm, hqStep, hqEdges⟩ z hz + exact ⟨e, Set.mem_union_right _ he, hze⟩ + · rintro ⟨e, he, hze⟩ + simp only [GEdges, Set.mem_union] at he + rcases he with he | he + · have hx : z ∈ Kplus := by + rw [hKp] + rcases (hpEdges e).mp he with ⟨x, y, l₁, l₂, hpdecomp, rfl⟩ + simp only [Finset.mem_insert, Finset.mem_singleton] at hze + rw [hpdecomp] + rcases hze with hze | hze + · subst z + simp + · subst z + simp + exact Set.mem_union_left _ hx + · have hx : z ∈ Kminus := by + rw [hKm] + rcases (hqEdges e).mp he with ⟨x, y, l₁, l₂, hqdecomp, rfl⟩ + simp only [Finset.mem_insert, Finset.mem_singleton] at hze + rw [hqdecomp] + rcases hze with hze | hze + · subst z + simp + · subst z + simp + exact Set.mem_union_right _ hx + +private theorem noThree : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (Fplus : Set (Finset + GaussianInt)), ∀ (Fminus : Set (Finset GaussianInt)), (List GaussianInt) → ((List + GaussianInt) → ((List GaussianInt) → ( + let X : Set GaussianInt := Kplus ∪ Kminus + let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus + ∀ [Finite (↑X : Type)], + let G : SimpleGraph X := SimpleGraph.fromRel fun u v => + ({u.1, v.1} : Finset GaussianInt) ∈ GEdges + (∀ v : X, Set.ncard (G.neighborSet v) ≤ 2) → (∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (w + : GaussianInt), ∀ (z : GaussianInt), ∀ (hu : u ∈ X), ∀ (hv : v ∈ X), ∀ (hw : w ∈ X), ∀ + (hz : z ∈ X), u ≠ v → u ≠ w → u ≠ z → v ≠ w → v ≠ z → w ≠ z → G.Adj ⟨u, hu⟩ ⟨v, hv⟩ → + G.Adj ⟨u, hu⟩ ⟨w, hw⟩ → G.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False)))) := by + classical + intro Kplus Kminus Fplus Fminus c p q X GEdges this G hdeg' u v w z hu hv hw hz huv huw huz hvw + hvz hwz hUv hUw hUz + let A : Set X := {⟨v, hv⟩, ⟨w, hw⟩, ⟨z, hz⟩} + have hsub : A ⊆ G.neighborSet ⟨u, hu⟩ := by + intro t ht + simp only [A, Set.mem_insert_iff, Set.mem_singleton_iff] at ht + rcases ht with ht | ht | ht + · simpa [ht] using hUv + · simpa [ht] using hUw + · simpa [ht] using hUz + have hcard : A.ncard = 3 := by + simp [A, hvw, hvz, hwz] + have hle := Set.ncard_mono hsub + have hbound := hdeg' ⟨u, hu⟩ + rw [hcard] at hle + omega + +private theorem path_other : + (∀ (s : List GaussianInt), s.Nodup → ∀ x, ∀ y, ∀ l₁, ∀ l₂, s = l₁ ++ x :: y :: l₂ → x ≠ y) → + (∀ S, ∀ F, SimpleGridPath S F → ∀ x, x ∈ S → ∃ y, y ≠ x ∧ ({x, y} : Finset GaussianInt) ∈ + F) := by + classical + intro pair_ne S F hpath x hx + rcases hpath with ⟨s, hsN, hsLen, hS, hsStep, hsEdges⟩ + obtain ⟨e, hxe, he⟩ := SimpleGridPathVertexIncidentEdge S F + ⟨s, hsN, hsLen, hS, hsStep, hsEdges⟩ x hx + rcases (hsEdges e).mp he with ⟨u, v, l₁, l₂, hdec, rfl⟩ + have hxe' : x = u ∨ x = v := by + simpa only [Finset.mem_insert, Finset.mem_singleton] using hxe + have huv : u ≠ v := pair_ne s hsN u v l₁ l₂ hdec + rcases hxe' with hxu | hxv + · subst u + refine ⟨v, huv.symm, ?_⟩ + exact (hsEdges {x, v}).2 ⟨x, v, l₁, l₂, hdec, rfl⟩ + · subst v + refine ⟨u, huv, ?_⟩ + simpa [Finset.pair_comm] using + (hsEdges {u, x}).2 ⟨u, x, l₁, l₂, hdec, rfl⟩ + +private theorem shared_no_interior_plus : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (Fplus : Set (Finset + GaussianInt)), ∀ (Fminus : Set (Finset GaussianInt)), (Disjoint Fplus Fminus) → (∀ (p : + List GaussianInt), (p.Nodup) → ((Kplus = (↑p.toFinset : Set GaussianInt)) → ((∀ (e : + Finset GaussianInt), e ∈ Fplus ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (∀ (q : List + GaussianInt), (q.Nodup) → (((2 : ℕ) ≤ q.length) → ((Kminus = (↑q.toFinset : Set + GaussianInt)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ + (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 + : GaussianInt) ∨ b = a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ b = a - ⟨(0 : ℤ), (1 : ℤ)⟩) → ((∀ (e : + Finset GaussianInt), e ∈ Fminus ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((∀ (s : + List GaussianInt), s.Nodup → ∀ x, x ∈ s → s.head? ≠ some x → s.getLast? ≠ some x → ∃ l₁ + l₂ y z, s = l₁ ++ y :: x :: z :: l₂ ∧ y ≠ z) → ( + let X : Set GaussianInt := Kplus ∪ Kminus + let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus + let G : SimpleGraph X := SimpleGraph.fromRel fun u v => + ({u.1, v.1} : Finset GaussianInt) ∈ GEdges + (∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (hu : u ∈ X), ∀ (hv : v ∈ X), u ≠ v → ({u, v} : + Finset GaussianInt) ∈ GEdges → G.Adj ⟨u, hu⟩ ⟨v, hv⟩) → ((∀ (u : GaussianInt), ∀ (v : + GaussianInt), ∀ (w : GaussianInt), ∀ (z : GaussianInt), ∀ (hu : u ∈ X), ∀ (hv : v ∈ + X), ∀ (hw : w ∈ X), ∀ (hz : z ∈ X), u ≠ v → u ≠ w → u ≠ z → v ≠ w → v ≠ z → w ≠ z → + G.Adj ⟨u, + hu⟩ ⟨v, hv⟩ → G.Adj ⟨u, hu⟩ ⟨w, hw⟩ → G.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False) → ((∀ (s : List + GaussianInt), s.Nodup → ∀ x, ∀ y, ∀ l₁, ∀ l₂, s = l₁ ++ x :: y :: l₂ → x ≠ y) → (∀ x, x ∈ + Kplus → x ∈ Kminus → p.head? ≠ some x → p.getLast? ≠ some x → False))))))))))))) := by + classical + intro Kplus Kminus Fplus Fminus hdisjoint p hpN hKp hpEdges q hqN hqLen hKm hqStep hqEdges + splitInterior X GEdges G edgeAdj noThree pair_ne x hxplus hxminus hhead hlast + have hxlist : x ∈ p := by + rw [hKp] at hxplus + simpa using hxplus + obtain ⟨l₁, l₂, y, z, hdec, hyz⟩ := splitInterior p hpN x hxlist hhead hlast + have hdecz : p = (l₁ ++ [y]) ++ x :: z :: l₂ := by simpa using hdec + have he1 : ({y, x} : Finset GaussianInt) ∈ Fplus := + (hpEdges {y, x}).2 ⟨y, x, l₁, z :: l₂, hdec, rfl⟩ + have he2 : ({x, z} : Finset GaussianInt) ∈ Fplus := + (hpEdges {x, z}).2 ⟨x, z, l₁ ++ [y], l₂, hdecz, rfl⟩ + have hxy : y ≠ x := pair_ne p hpN y x l₁ (z :: l₂) hdec + have hxz : x ≠ z := pair_ne p hpN x z (l₁ ++ [y]) l₂ hdecz + have hyK : y ∈ Kplus := by + rw [hKp] + change y ∈ p.toFinset + rw [hdec] + simp + have hzK : z ∈ Kplus := by + rw [hKp] + change z ∈ p.toFinset + rw [hdec] + simp + have incident_other : ∃ w, w ≠ x ∧ ({x, w} : Finset GaussianInt) ∈ Fminus := by + obtain ⟨e, hxe, he⟩ := SimpleGridPathVertexIncidentEdge Kminus Fminus + ⟨q, hqN, hqLen, hKm, hqStep, hqEdges⟩ x hxminus + rcases (hqEdges e).mp he with ⟨u, v, k₁, k₂, hdecq, rfl⟩ + have hxe' : x = u ∨ x = v := by + simpa only [Finset.mem_insert, Finset.mem_singleton] using hxe + have heuv : ({u, v} : Finset GaussianInt) ∈ Fminus := + (hqEdges {u, v}).2 ⟨u, v, k₁, k₂, hdecq, rfl⟩ + rcases hxe' with hxu | hxv + · subst u + refine ⟨v, ?_, ?_⟩ + · exact (pair_ne q hqN x v k₁ k₂ hdecq).symm + · simpa using heuv + · subst v + refine ⟨u, ?_, ?_⟩ + · exact pair_ne q hqN u x k₁ k₂ hdecq + · simpa [Finset.pair_comm] using heuv + rcases incident_other with ⟨w, hxw, he3⟩ + have hwK : w ∈ Kminus := by + rw [hKm] + change w ∈ q.toFinset + rcases (hqEdges {x, w}).mp he3 with ⟨u, v, k₁, k₂, hdecq, hpair⟩ + have hmem : w = u ∨ w = v := by + have : w ∈ ({x, w} : Finset GaussianInt) := by simp + rw [hpair] at this + simpa only [Finset.mem_insert, Finset.mem_singleton] using this + rcases hmem with hmem | hmem + · subst w + rw [hdecq] + simp + · subst w + rw [hdecq] + simp + have hyw : y ≠ w := by + intro hyw + subst w + have hcontra := Set.disjoint_left.mp hdisjoint + have hminus : ({y, x} : Finset GaussianInt) ∈ Fminus := by + simpa [Finset.pair_comm] using he3 + exact hcontra he1 hminus + have hzw : z ≠ w := by + intro hzw + subst w + have hcontra := Set.disjoint_left.mp hdisjoint + exact hcontra he2 he3 + exact noThree x y z w (Set.mem_union_left _ hxplus) + (Set.mem_union_left _ hyK) (Set.mem_union_left _ hzK) + (Set.mem_union_right _ hwK) hxy.symm hxz hxw.symm hyz hyw hzw + (edgeAdj x y (Set.mem_union_left _ hxplus) (Set.mem_union_left _ hyK) + hxy.symm (Set.mem_union_left _ (by simpa [Finset.pair_comm] using he1))) + (edgeAdj x z (Set.mem_union_left _ hxplus) (Set.mem_union_left _ hzK) + hxz (Set.mem_union_left _ he2)) + (edgeAdj x w (Set.mem_union_left _ hxplus) (Set.mem_union_right _ hwK) + hxw.symm (Set.mem_union_right _ he3)) + +private theorem shared_no_interior_minus : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (Fplus : Set (Finset + GaussianInt)), ∀ (Fminus : Set (Finset GaussianInt)), (Disjoint Fplus Fminus) → (∀ (p : + List GaussianInt), (p.Nodup) → (((2 : ℕ) ≤ p.length) → ((Kplus = (↑p.toFinset : Set + GaussianInt)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ + (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 + : GaussianInt) ∨ b = a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ b = a - ⟨(0 : ℤ), (1 : ℤ)⟩) → ((∀ (e : + Finset GaussianInt), e ∈ Fplus ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (∀ (q : List + GaussianInt), (q.Nodup) → ((Kminus = (↑q.toFinset : Set GaussianInt)) → ((∀ (e : Finset + GaussianInt), e ∈ Fminus ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) + (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((∀ (s : List + GaussianInt), s.Nodup → ∀ x, x ∈ s → s.head? ≠ some x → s.getLast? ≠ some x → ∃ l₁ l₂ y + z, s = l₁ ++ y :: x :: z :: l₂ ∧ y ≠ z) → ( + let X : Set GaussianInt := Kplus ∪ Kminus + let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus + let G : SimpleGraph X := SimpleGraph.fromRel fun u v => + ({u.1, v.1} : Finset GaussianInt) ∈ GEdges + (∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (hu : u ∈ X), ∀ (hv : v ∈ X), u ≠ v → ({u, v} : + Finset GaussianInt) ∈ GEdges → G.Adj ⟨u, hu⟩ ⟨v, hv⟩) → ((∀ (u : GaussianInt), ∀ (v : + GaussianInt), ∀ (w : GaussianInt), ∀ (z : GaussianInt), ∀ (hu : u ∈ X), ∀ (hv : v ∈ + X), ∀ (hw : w ∈ X), ∀ (hz : z ∈ X), u ≠ v → u ≠ w → u ≠ z → v ≠ w → v ≠ z → w ≠ z → + G.Adj ⟨u, + hu⟩ ⟨v, hv⟩ → G.Adj ⟨u, hu⟩ ⟨w, hw⟩ → G.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False) → ((∀ (s : List + GaussianInt), s.Nodup → ∀ x, ∀ y, ∀ l₁, ∀ l₂, s = l₁ ++ x :: y :: l₂ → x ≠ y) → (∀ x, x ∈ + Kplus → x ∈ Kminus → q.head? ≠ some x → q.getLast? ≠ some x → False))))))))))))) := by + classical + intro Kplus Kminus Fplus Fminus hdisjoint p hpN hpLen hKp hpStep hpEdges q hqN hKm hqEdges + splitInterior X GEdges G edgeAdj noThree pair_ne x hxplus hxminus hhead hlast + have hxlist : x ∈ q := by + rw [hKm] at hxminus + simpa using hxminus + obtain ⟨l₁, l₂, y, z, hdec, hyz⟩ := splitInterior q hqN x hxlist hhead hlast + have hdecz : q = (l₁ ++ [y]) ++ x :: z :: l₂ := by simpa using hdec + have he1 : ({y, x} : Finset GaussianInt) ∈ Fminus := + (hqEdges {y, x}).2 ⟨y, x, l₁, z :: l₂, hdec, rfl⟩ + have he2 : ({x, z} : Finset GaussianInt) ∈ Fminus := + (hqEdges {x, z}).2 ⟨x, z, l₁ ++ [y], l₂, hdecz, rfl⟩ + have hxy : y ≠ x := pair_ne q hqN y x l₁ (z :: l₂) hdec + have hxz : x ≠ z := pair_ne q hqN x z (l₁ ++ [y]) l₂ hdecz + have hyK : y ∈ Kminus := by + rw [hKm] + change y ∈ q.toFinset + rw [hdec] + simp + have hzK : z ∈ Kminus := by + rw [hKm] + change z ∈ q.toFinset + rw [hdec] + simp + have incident_other : ∃ w, w ≠ x ∧ ({x, w} : Finset GaussianInt) ∈ Fplus := by + obtain ⟨e, hxe, he⟩ := SimpleGridPathVertexIncidentEdge Kplus Fplus + ⟨p, hpN, hpLen, hKp, hpStep, hpEdges⟩ x hxplus + rcases (hpEdges e).mp he with ⟨u, v, k₁, k₂, hdecq, rfl⟩ + have hxe' : x = u ∨ x = v := by + simpa only [Finset.mem_insert, Finset.mem_singleton] using hxe + have heuv : ({u, v} : Finset GaussianInt) ∈ Fplus := + (hpEdges {u, v}).2 ⟨u, v, k₁, k₂, hdecq, rfl⟩ + rcases hxe' with hxu | hxv + · subst u + refine ⟨v, ?_, ?_⟩ + · exact (pair_ne p hpN x v k₁ k₂ hdecq).symm + · simpa using heuv + · subst v + refine ⟨u, ?_, ?_⟩ + · exact pair_ne p hpN u x k₁ k₂ hdecq + · simpa [Finset.pair_comm] using heuv + rcases incident_other with ⟨w, hxw, he3⟩ + have hwK : w ∈ Kplus := by + rw [hKp] + change w ∈ p.toFinset + rcases (hpEdges {x, w}).mp he3 with ⟨u, v, k₁, k₂, hdecq, hpair⟩ + have hmem : w = u ∨ w = v := by + have : w ∈ ({x, w} : Finset GaussianInt) := by simp + rw [hpair] at this + simpa only [Finset.mem_insert, Finset.mem_singleton] using this + rcases hmem with hmem | hmem + · subst w + rw [hdecq] + simp + · subst w + rw [hdecq] + simp + have hyw : y ≠ w := by + intro hyw + subst w + have hcontra := Set.disjoint_left.mp hdisjoint.symm + have hplus : ({y, x} : Finset GaussianInt) ∈ Fplus := by + simpa [Finset.pair_comm] using he3 + exact hcontra he1 hplus + have hzw : z ≠ w := by + intro hzw + subst w + have hcontra := Set.disjoint_left.mp hdisjoint.symm + exact hcontra he2 he3 + exact noThree x y z w (Set.mem_union_right _ hxminus) + (Set.mem_union_right _ hyK) (Set.mem_union_right _ hzK) + (Set.mem_union_left _ hwK) hxy.symm hxz hxw.symm hyz hyw hzw + (edgeAdj x y (Set.mem_union_right _ hxminus) (Set.mem_union_right _ hyK) + hxy.symm (Set.mem_union_right _ (by simpa [Finset.pair_comm] using he1))) + (edgeAdj x z (Set.mem_union_right _ hxminus) (Set.mem_union_right _ hzK) + hxz (Set.mem_union_right _ he2)) + (edgeAdj x w (Set.mem_union_right _ hxminus) (Set.mem_union_left _ hwK) + hxw.symm (Set.mem_union_left _ he3)) + +private theorem pOrientation : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (r : GaussianInt → GaussianInt), + ∀ (a : GaussianInt), (a ∈ Kplus ∩ Kminus) → (∀ (p : List GaussianInt), (r a ∈ Kminus) → + ((r a ∈ Kplus) → ((a ≠ r a) → ((∀ x, x ∈ Kplus → x ∈ Kminus → p.head? = some x ∨ + p.getLast? = some x) → ((p.head? = some a ∧ p.getLast? = some (r a)) ∨ (p.head? = some (r + a) ∧ p.getLast? = some a)))))) := by + classical + intro Kplus Kminus r a ha p hara harp hdistinct pEndpoint + rcases pEndpoint a ha.1 ha.2 with haH | haL <;> + rcases pEndpoint (r a) harp hara with hrH | hrL + · have : a = r a := Option.some.inj (haH.symm.trans hrH) + exact False.elim (hdistinct this) + · exact Or.inl ⟨haH, hrL⟩ + · exact Or.inr ⟨hrH, haL⟩ + · have : a = r a := Option.some.inj (haL.symm.trans hrL) + exact False.elim (hdistinct this) + +private theorem qOrientation : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (r : GaussianInt → GaussianInt), + ∀ (a : GaussianInt), (a ∈ Kplus ∩ Kminus) → (∀ (q : List GaussianInt), (r a ∈ Kminus) → + ((r a ∈ Kplus) → ((a ≠ r a) → ((∀ x, x ∈ Kplus → x ∈ Kminus → q.head? = some x ∨ + q.getLast? = some x) → ((q.head? = some (r a) ∧ q.getLast? = some a) ∨ (q.head? = some a + ∧ q.getLast? = some (r a))))))) := by + classical + intro Kplus Kminus r a ha q hara harp hdistinct qEndpoint + rcases qEndpoint a ha.1 ha.2 with haH | haL <;> + rcases qEndpoint (r a) harp hara with hrH | hrL + · have : a = r a := Option.some.inj (haH.symm.trans hrH) + exact False.elim (hdistinct this) + · exact Or.inr ⟨haH, hrL⟩ + · exact Or.inl ⟨hrH, haL⟩ + · have : a = r a := Option.some.inj (haL.symm.trans hrL) + exact False.elim (hdistinct this) + +private theorem twoNeighbors : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (Fplus : Set (Finset + GaussianInt)), ∀ (Fminus : Set (Finset GaussianInt)), ∀ (r : GaussianInt → GaussianInt), + ∀ (a : GaussianInt), (Disjoint Fplus Fminus) → ((a ∈ Kplus ∩ Kminus) → (∀ (p : List + GaussianInt), (p.Nodup) → (((2 : ℕ) ≤ p.length) → ((Kplus = (↑p.toFinset : Set + GaussianInt)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ + (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 + : GaussianInt) ∨ b = a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ b = a - ⟨(0 : ℤ), (1 : ℤ)⟩) → ((∀ (e : + Finset GaussianInt), e ∈ Fplus ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (∀ (q : List + GaussianInt), (q.Nodup) → (((2 : ℕ) ≤ q.length) → ((Kminus = (↑q.toFinset : Set + GaussianInt)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ + (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 + : GaussianInt) ∨ b = a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ b = a - ⟨(0 : ℤ), (1 : ℤ)⟩) → ((∀ (e : + Finset GaussianInt), e ∈ Fminus ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((r a ∈ + Kminus) → ((r a ∈ Kplus) → ((∀ (s : List GaussianInt), s.Nodup → ∀ x, x ∈ s → s.head? ≠ + some x → s.getLast? ≠ some x → ∃ l₁ l₂ y z, s = l₁ ++ y :: x :: z :: l₂ ∧ y ≠ z) → ( + let X : Set GaussianInt := Kplus ∪ Kminus + let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus + (∀ (s : List GaussianInt), s.Nodup → ∀ x, ∀ y, ∀ l₁, ∀ l₂, s = l₁ ++ x :: y :: l₂ → x ≠ y) → + ((∀ S, ∀ F, SimpleGridPath S F → ∀ x, x ∈ S → ∃ y, y ≠ x ∧ ({x, y} : Finset GaussianInt) + ∈ F) → (((p.head? = some a ∧ p.getLast? = some (r a)) ∨ (p.head? = some (r a) ∧ + p.getLast? = some a)) → (((q.head? = some (r a) ∧ q.getLast? = some a) ∨ (q.head? = some + a ∧ q.getLast? = some (r a))) → (∀ x, x ∈ X → ∃ y z, y ≠ z ∧ x ≠ y ∧ x ≠ z ∧ ({x, y} : + Finset GaussianInt) ∈ GEdges ∧ ({x, z} : Finset GaussianInt) ∈ GEdges))))))))))))))))))) + := by + classical + intro Kplus Kminus Fplus Fminus r a hdisjoint ha p hpN hpLen hKp hpStep hpEdges q hqN hqLen hKm + hqStep hqEdges hara harp splitInterior X GEdges pair_ne path_other pOrientation + qOrientation x hx + simp only [X, Set.mem_union] at hx + rcases hx with hxP | hxM + · by_cases hxM : x ∈ Kminus + · obtain ⟨y, hyx, heY⟩ := path_other Kplus Fplus + ⟨p, hpN, hpLen, hKp, hpStep, hpEdges⟩ x hxP + obtain ⟨z, hzx, heZ⟩ := path_other Kminus Fminus + ⟨q, hqN, hqLen, hKm, hqStep, hqEdges⟩ x hxM + have hyz : y ≠ z := by + intro h + subst z + exact (Set.disjoint_left.mp hdisjoint) heY heZ + exact ⟨y, z, hyz, hyx.symm, hzx.symm, + Set.mem_union_left _ heY, Set.mem_union_right _ heZ⟩ + · have hhead : p.head? ≠ some x := by + intro hh + rcases pOrientation with ⟨hph, _⟩ | ⟨hph, _⟩ + · have hxa : x = a := Option.some.inj (hh.symm.trans hph) + apply hxM + simpa [hxa] using ha.2 + · have hxr : x = r a := Option.some.inj (hh.symm.trans hph) + apply hxM + simpa [hxr] using hara + have hlast : p.getLast? ≠ some x := by + intro hh + rcases pOrientation with ⟨_, hpl⟩ | ⟨_, hpl⟩ + · have hxr : x = r a := Option.some.inj (hh.symm.trans hpl) + apply hxM + simpa [hxr] using hara + · have hxa : x = a := Option.some.inj (hh.symm.trans hpl) + apply hxM + simpa [hxa] using ha.2 + have hxlist : x ∈ p := by rw [hKp] at hxP; simpa using hxP + obtain ⟨l₁, l₂, y, z, hdec, hyz⟩ := splitInterior p hpN x hxlist hhead hlast + have hdecz : p = (l₁ ++ [y]) ++ x :: z :: l₂ := by simpa using hdec + have hxy : y ≠ x := pair_ne p hpN y x l₁ (z :: l₂) hdec + have hxz : x ≠ z := pair_ne p hpN x z (l₁ ++ [y]) l₂ hdecz + have heY : ({x, y} : Finset GaussianInt) ∈ Fplus := by + simpa [Finset.pair_comm] using + (hpEdges {y, x}).2 ⟨y, x, l₁, z :: l₂, hdec, rfl⟩ + have heZ : ({x, z} : Finset GaussianInt) ∈ Fplus := + (hpEdges {x, z}).2 ⟨x, z, l₁ ++ [y], l₂, hdecz, rfl⟩ + exact ⟨y, z, hyz, hxy.symm, hxz, + Set.mem_union_left _ heY, Set.mem_union_left _ heZ⟩ + · by_cases hxP : x ∈ Kplus + · obtain ⟨y, hyx, heY⟩ := path_other Kplus Fplus + ⟨p, hpN, hpLen, hKp, hpStep, hpEdges⟩ x hxP + obtain ⟨z, hzx, heZ⟩ := path_other Kminus Fminus + ⟨q, hqN, hqLen, hKm, hqStep, hqEdges⟩ x hxM + have hyz : y ≠ z := by + intro h + subst z + exact (Set.disjoint_left.mp hdisjoint) heY heZ + exact ⟨y, z, hyz, hyx.symm, hzx.symm, + Set.mem_union_left _ heY, Set.mem_union_right _ heZ⟩ + · have hhead : q.head? ≠ some x := by + intro hh + rcases qOrientation with ⟨hqh, _⟩ | ⟨hqh, _⟩ + · have hxr : x = r a := Option.some.inj (hh.symm.trans hqh) + apply hxP + simpa [hxr] using harp + · have hxa : x = a := Option.some.inj (hh.symm.trans hqh) + apply hxP + simpa [hxa] using ha.1 + have hlast : q.getLast? ≠ some x := by + intro hh + rcases qOrientation with ⟨_, hql⟩ | ⟨_, hql⟩ + · have hxa : x = a := Option.some.inj (hh.symm.trans hql) + apply hxP + simpa [hxa] using ha.1 + · have hxr : x = r a := Option.some.inj (hh.symm.trans hql) + apply hxP + simpa [hxr] using harp + have hxlist : x ∈ q := by rw [hKm] at hxM; simpa using hxM + obtain ⟨l₁, l₂, y, z, hdec, hyz⟩ := splitInterior q hqN x hxlist hhead hlast + have hdecz : q = (l₁ ++ [y]) ++ x :: z :: l₂ := by simpa using hdec + have hxy : y ≠ x := pair_ne q hqN y x l₁ (z :: l₂) hdec + have hxz : x ≠ z := pair_ne q hqN x z (l₁ ++ [y]) l₂ hdecz + have heY : ({x, y} : Finset GaussianInt) ∈ Fminus := by + simpa [Finset.pair_comm] using + (hqEdges {y, x}).2 ⟨y, x, l₁, z :: l₂, hdec, rfl⟩ + have heZ : ({x, z} : Finset GaussianInt) ∈ Fminus := + (hqEdges {x, z}).2 ⟨x, z, l₁ ++ [y], l₂, hdecz, rfl⟩ + exact ⟨y, z, hyz, hxy.symm, hxz, + Set.mem_union_right _ heY, Set.mem_union_right _ heZ⟩ + +private theorem hEend : + ∀ (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (c : List GaussianInt), ∀ (cx : + GaussianInt), ∀ (cy : GaussianInt), (V = (↑c.toFinset : Set GaussianInt)) → ((∀ (e : + Finset GaussianInt), e ∈ E ↔ e = {cy, cx} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : + List GaussianInt) (l₂ : List GaussianInt), c = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((cx ∈ + V) → ((cy ∈ V) → (∀ e, e ∈ E → ∀ x, x ∈ e → x ∈ V)))) := by + classical + intro V E c cx cy hVcyc hcEdges hcxV hcyV e he x hx + rcases (hcEdges e).mp he with hcloseE | ⟨u, v, l₁, l₂, hdec, hpair⟩ + · rw [hcloseE] at hx + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + rcases hx with hx | hx + · rw [hx] + exact hcyV + · rw [hx] + exact hcxV + · rw [hpair] at hx + simp only [Finset.mem_insert, Finset.mem_singleton] at hx + rcases hx with hx | hx + · rw [hx] + rw [hVcyc] + change u ∈ c.toFinset + rw [hdec] + simp + · rw [hx] + rw [hVcyc] + change v ∈ c.toFinset + rw [hdec] + simp + +private theorem hEne : + ∀ (E : Set (Finset GaussianInt)), ∀ (c : List GaussianInt), ∀ (cx : GaussianInt), ∀ (cy : + GaussianInt), (FourNeighborAdjacent cy cx) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), + ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), c = l₁ ++ a :: b :: l₂ → + FourNeighborAdjacent a b) → ((∀ (e : Finset GaussianInt), e ∈ E ↔ e = {cy, cx} ∨ ∃ (a : + GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), c = l₁ ++ + a :: b :: l₂ ∧ e = {a, b}) → ((List GaussianInt) → ((List GaussianInt) → ((∀ u, ∀ v, + FourNeighborAdjacent u v → u ≠ v) → (∀ x, ∀ y, ({x, y} : Finset GaussianInt) ∈ E → x ≠ + y)))))) := by + classical + intro E c cx cy hclose hcStep hcEdges p q fourNe x y he hxy + have hcard : ({x, y} : Finset GaussianInt).card = 1 := by simp [hxy] + rcases (hcEdges {x, y}).mp he with hcloseE | ⟨u, v, l₁, l₂, hdec, hpair⟩ + · have hne := fourNe cy cx hclose + have hcard' := congrArg Finset.card hcloseE + rw [hcard, Finset.card_pair hne] at hcard' + omega + · have hstep : FourNeighborAdjacent u v := hcStep u v l₁ l₂ hdec + have hne := fourNe u v hstep + have hcard' := congrArg Finset.card hpair + rw [hcard, Finset.card_pair hne] at hcard' + omega + +private theorem cycleOther : + ∀ (E : Set (Finset GaussianInt)), ∀ (c : List GaussianInt), ∀ (cx : GaussianInt), ∀ (cy : + GaussianInt), (FourNeighborAdjacent cy cx) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), + ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), c = l₁ ++ a :: b :: l₂ → + FourNeighborAdjacent a b) → ((∀ (e : Finset GaussianInt), e ∈ E ↔ e = {cy, cx} ∨ ∃ (a : + GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), c = l₁ ++ + a :: b :: l₂ ∧ e = {a, b}) → ((∀ u, ∀ v, FourNeighborAdjacent u v → u ≠ v) → (∀ e, e ∈ E + → ∀ x, x ∈ e → ∃ y, y ≠ x ∧ e = {x, y})))) := by + classical + intro E c cx cy hclose hcStep hcEdges fourNe e he x hx + rcases (hcEdges e).mp he with hcloseE | ⟨u, v, l₁, l₂, hdec, hpair⟩ + · have hmem : x = cy ∨ x = cx := by + rw [hcloseE] at hx + simpa only [Finset.mem_insert, Finset.mem_singleton] using hx + rcases hmem with hmem | hmem + · subst x + exact ⟨cx, (fourNe cy cx hclose).symm, hcloseE⟩ + · subst x + refine ⟨cy, fourNe cy cx hclose, ?_⟩ + simpa [Finset.pair_comm] using hcloseE + · have hmem : x = u ∨ x = v := by + rw [hpair] at hx + simpa only [Finset.mem_insert, Finset.mem_singleton] using hx + have hne := fourNe u v (hcStep u v l₁ l₂ hdec) + rcases hmem with hmem | hmem + · subst x + exact ⟨v, hne.symm, hpair⟩ + · subst x + refine ⟨u, hne, ?_⟩ + simpa [Finset.pair_comm] using hpair + +private theorem noThreeE : + ∀ (E : Set (Finset GaussianInt)), (List GaussianInt) → ((List GaussianInt) → ((List + GaussianInt) → ( + let U : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + ∀ [Finite (↑U : Type)], + let C : SimpleGraph U := SimpleGraph.fromRel fun u v => + ({u.1, v.1} : Finset GaussianInt) ∈ E + (∀ v : U, Set.ncard (C.neighborSet v) ≤ 2) → (∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (w + : GaussianInt), ∀ (z : GaussianInt), ∀ (hu : u ∈ U), ∀ (hv : v ∈ U), ∀ (hw : w ∈ U), ∀ + (hz : z ∈ U), u ≠ v → u ≠ w → u ≠ z → v ≠ w → v ≠ z → w ≠ z → C.Adj ⟨u, hu⟩ ⟨v, hv⟩ → + C.Adj ⟨u, hu⟩ ⟨w, hw⟩ → C.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False)))) := by + classical + intro E c p q U this C hdegE' u v w z hu hv hw hz huv huw huz hvw hvz hwz hUv hUw hUz + let A : Set U := {⟨v, hv⟩, ⟨w, hw⟩, ⟨z, hz⟩} + have hsub : A ⊆ C.neighborSet ⟨u, hu⟩ := by + intro t ht + simp only [A, Set.mem_insert_iff, Set.mem_singleton_iff] at ht + rcases ht with ht | ht | ht + · simpa [ht] using hUv + · simpa [ht] using hUw + · simpa [ht] using hUz + have hcard : A.ncard = 3 := by + simp [A, hvw, hvz, hwz] + have hle := Set.ncard_mono hsub + have hbound := hdegE' ⟨u, hu⟩ + rw [hcard] at hle + omega + +private theorem edgeCovered : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), + ∀ (Fplus : Set (Finset GaussianInt)), ∀ (Fminus : Set (Finset GaussianInt)), + let X : Set GaussianInt := Kplus ∪ Kminus + let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus + (GEdges ⊆ E) → ((X = {z | ∃ e ∈ GEdges, z ∈ e}) → ((∀ x, x ∈ X → ∃ y z, y ≠ z ∧ x ≠ y ∧ x ≠ z + ∧ ({x, y} : Finset GaussianInt) ∈ GEdges ∧ ({x, z} : Finset GaussianInt) ∈ GEdges) → ((∀ + x, ∀ y, ({x, y} : Finset GaussianInt) ∈ E → x ≠ y) → ( + let U : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + let C : SimpleGraph U := SimpleGraph.fromRel fun u v => + ({u.1, v.1} : Finset GaussianInt) ∈ E + (∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (hu : u ∈ U), ∀ (hv : v ∈ U), u ≠ v → ({u, v} : + Finset GaussianInt) ∈ E → C.Adj ⟨u, hu⟩ ⟨v, hv⟩) → ((∀ (u : GaussianInt), ∀ (v : + GaussianInt), ∀ (w : GaussianInt), ∀ (z : GaussianInt), ∀ (hu : u ∈ U), ∀ (hv : v ∈ + U), ∀ (hw : w ∈ U), ∀ (hz : z ∈ U), u ≠ v → u ≠ w → u ≠ z → v ≠ w → v ≠ z → w ≠ z → + C.Adj ⟨u, + hu⟩ ⟨v, hv⟩ → C.Adj ⟨u, hu⟩ ⟨w, hw⟩ → C.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False) → ((X ⊆ U) → (∀ x, x + ∈ X → ∀ y, ({x, y} : Finset GaussianInt) ∈ E → ({x, y} : Finset GaussianInt) ∈ + GEdges))))))) := by + classical + intro Kplus Kminus E Fplus Fminus X GEdges hGE hSupport twoNeighbors hEne U C edgeAdjE noThreeE + hXU x hx y hxyE + obtain ⟨u, v, huv, hxu, hxv, hxuE, hxvE⟩ := twoNeighbors x hx + have hxU := hXU hx + have huX : u ∈ X := by + rw [hSupport] + exact ⟨{x, u}, hxuE, by simp⟩ + have hvX : v ∈ X := by + rw [hSupport] + exact ⟨{x, v}, hxvE, by simp⟩ + have huU := hXU huX + have hvU := hXU hvX + have hyU : y ∈ U := ⟨{x, y}, hxyE, by simp⟩ + by_cases hyu : y = u + · subst y + exact hxuE + · by_cases hyv : y = v + · subst y + exact hxvE + · have hneXY := hEne x y hxyE + exact False.elim (noThreeE x u v y hxU huU hvU hyU + hxu hxv hneXY huv (by intro h; exact hyu h.symm) + (by intro h; exact hyv h.symm) + (edgeAdjE x u hxU huU hxu (hGE hxuE)) + (edgeAdjE x v hxU hvU hxv (hGE hxvE)) + (edgeAdjE x y hxU hyU hneXY hxyE)) + +private theorem allTail : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), + ∀ (c : List GaussianInt), ∀ (cx : GaussianInt), ∀ (cy : GaussianInt), (∀ (e : Finset + GaussianInt), e ∈ E ↔ e = {cy, cx} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), c = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ( + let X : Set GaussianInt := Kplus ∪ Kminus + (∀ x, x ∈ X → ∀ y, ({x, y} : Finset GaussianInt) ∈ E → y ∈ X) → (∀ pre, ∀ x, ∀ s, c = pre ++ + x :: s → x ∈ X → ∀ z, z ∈ s → z ∈ X)) := by + classical + intro Kplus Kminus E c cx cy hcEdges X edgeClosure pre x s + induction s generalizing pre x with + | nil => + intro hdec hx z hz + simp at hz + | cons y ys ih => + intro hdec hx z hz + have hey : ({x, y} : Finset GaussianInt) ∈ E := + (hcEdges {x, y}).2 (Or.inr ⟨x, y, pre, ys, hdec, rfl⟩) + have hyX := edgeClosure x hx y hey + have hdec' : c = (pre ++ [x]) ++ y :: ys := by simpa using hdec + have hzy : z = y ∨ z ∈ ys := by simpa using hz + rcases hzy with hzy | hzy + · subst z + exact hyX + · exact ih (pre ++ [x]) y hdec' hyX z hzy + +private theorem splitAt : + ∀ (s : List GaussianInt), ∀ (x : GaussianInt), x ∈ s → ∃ l t, s = l ++ x :: t := by + classical + intro s + induction s with + | nil => intro x hx; simp at hx + | cons y ys ih => + intro x hx + rcases List.mem_cons.mp hx with hxy | hxy + · subst x + exact ⟨[], ys, rfl⟩ + · rcases ih x hxy with ⟨l, t, h⟩ + exact ⟨y :: l, t, by simp [h, List.cons_append]⟩ + +private theorem hIntersection : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (r : GaussianInt → GaussianInt), + ∀ (a : GaussianInt), (a ∈ Kplus ∩ Kminus) → (∀ (p : List GaussianInt), (r a ∈ Kminus) → + ((r a ∈ Kplus) → ((∀ x, x ∈ Kplus → x ∈ Kminus → p.head? = some x ∨ p.getLast? = some x) + → (((p.head? = some a ∧ p.getLast? = some (r a)) ∨ (p.head? = some (r a) ∧ p.getLast? = + some a)) → (Kplus ∩ Kminus = {a, r a}))))) := by + classical + intro Kplus Kminus r a ha p hara harp pEndpoint pOrientation + apply Set.ext + intro x + constructor + · intro hx + have hEnd := pEndpoint x hx.1 hx.2 + rcases pOrientation with ⟨hpH, hpL⟩ | ⟨hpH, hpL⟩ + · rcases hEnd with hxH | hxL + · have hxa : x = a := Option.some.inj (hxH.symm.trans hpH) + simp [hxa] + · have hxr : x = r a := Option.some.inj (hxL.symm.trans hpL) + simp [hxr] + · rcases hEnd with hxH | hxL + · have hxr : x = r a := Option.some.inj (hxH.symm.trans hpH) + simp [hxr] + · have hxa : x = a := Option.some.inj (hxL.symm.trans hpL) + simp [hxa] + · intro hx + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hx + rcases hx with hx | hx + · subst x + exact ⟨ha.1, ha.2⟩ + · subst x + exact ⟨harp, hara⟩ + +private theorem hEdgeCoverage : + ∀ (V : Set GaussianInt), ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (E : + Set (Finset GaussianInt)), ∀ (Fplus : Set (Finset GaussianInt)), ∀ (Fminus : Set (Finset + GaussianInt)), ∀ (c : List GaussianInt), ∀ (cx : GaussianInt), ∀ (cy : GaussianInt), (∀ + (e : Finset GaussianInt), e ∈ E ↔ e = {cy, cx} ∨ ∃ (a : GaussianInt) (b : GaussianInt) + (l₁ : List GaussianInt) (l₂ : List GaussianInt), c = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ( + let X : Set GaussianInt := Kplus ∪ Kminus + let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus + (∀ e, e ∈ E → ∀ x, x ∈ e → x ∈ V) → ((∀ e, e ∈ E → ∀ x, x ∈ e → ∃ y, y ≠ x ∧ e = {x, y}) → + ((∀ x, x ∈ X → ∀ y, ({x, y} : Finset GaussianInt) ∈ E → ({x, y} : Finset GaussianInt) ∈ + GEdges) → ((V ⊆ X) → (∀ e, e ∈ E → e ∈ Fplus ∨ e ∈ Fminus))))) := by + classical + intro V Kplus Kminus E Fplus Fminus c cx cy hcEdges X GEdges hEend cycleOther edgeCovered hVtoX + e he + have heNonempty : e.Nonempty := by + rcases (hcEdges e).mp he with hcloseE | ⟨u, v, l₁, l₂, hdec, hpair⟩ + · rw [hcloseE] + simp + · rw [hpair] + simp + obtain ⟨x, hxe⟩ := heNonempty + obtain ⟨y, _, hpair⟩ := cycleOther e he x hxe + have hxX : x ∈ X := hVtoX (hEend e he x hxe) + have hexy : ({x, y} : Finset GaussianInt) ∈ E := by + rw [← hpair] + exact he + have heG := edgeCovered x hxX y hexy + rw [hpair] + simp only [GEdges, Set.mem_union] at heG + exact heG + +private theorem hp'Orient : + ∀ (r : GaussianInt → GaussianInt), ∀ (a : GaussianInt), ∀ (p : List GaussianInt), (a ≠ r a) → + (((p.head? = some a ∧ p.getLast? = some (r a)) ∨ (p.head? = some (r a) ∧ p.getLast? = + some a)) → ( + let p' : List GaussianInt := if p.head? = some a then p else p.reverse + p'.head? = some a ∧ p'.getLast? = some (r a))) := by + classical + intro r a p hdistinct pOrientation p' + dsimp [p'] + split_ifs with h + · rcases pOrientation with hpF | hpR + · exact hpF + · have hab : a = r a := Option.some.inj (h.symm.trans hpR.1) + exact False.elim (hdistinct hab) + · rcases pOrientation with hpF | hpR + · exact False.elim (h hpF.1) + · constructor + · simpa [List.head?_reverse] using hpR.2 + · simpa [List.getLast?_reverse] using hpR.1 + +private theorem hq'Orient : + ∀ (r : GaussianInt → GaussianInt), ∀ (a : GaussianInt), ∀ (q : List GaussianInt), (a ≠ r a) → + (((q.head? = some (r a) ∧ q.getLast? = some a) ∨ (q.head? = some a ∧ q.getLast? = some (r + a))) → ( + let q' : List GaussianInt := if q.head? = some (r a) then q else q.reverse + q'.head? = some (r a) ∧ q'.getLast? = some a)) := by + classical + intro r a q hdistinct qOrientation q' + dsimp [q'] + split_ifs with h + · rcases qOrientation with hqF | hqR + · exact hqF + · have hab : r a = a := Option.some.inj (h.symm.trans hqR.1) + exact False.elim (hdistinct hab.symm) + · rcases qOrientation with hqF | hqR + · exact False.elim (h hqF.1) + · constructor + · simpa [List.head?_reverse] using hqR.2 + · simpa [List.getLast?_reverse] using hqR.1 + +private theorem hp'Edges : + ∀ (Fplus : Set (Finset GaussianInt)), ∀ (a : GaussianInt), ∀ (p : List GaussianInt), (∀ (e : + Finset GaussianInt), e ∈ Fplus ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ( + let p' : List GaussianInt := if p.head? = some a then p else p.reverse + ∀ x, ∀ y, ∀ l₁, ∀ l₂, p' = l₁ ++ x :: y :: l₂ → ({x, y} : Finset GaussianInt) ∈ Fplus) := by + classical + intro Fplus a p hpEdges p' x y l₁ l₂ hdec + by_cases hforward : p.head? = some a + · have hdec' : p = l₁ ++ x :: y :: l₂ := by simpa [p', hforward] using hdec + exact (hpEdges {x, y}).2 ⟨x, y, l₁, l₂, hdec', rfl⟩ + · have hdec' : p.reverse = l₁ ++ x :: y :: l₂ := by + simpa [p', hforward] using hdec + have horig : p = l₂.reverse ++ y :: x :: l₁.reverse := by + calc + p = p.reverse.reverse := (List.reverse_reverse p).symm + _ = (l₁ ++ x :: y :: l₂).reverse := congrArg List.reverse hdec' + _ = l₂.reverse ++ y :: x :: l₁.reverse := by simp [List.reverse_append] + exact (hpEdges {x, y}).2 ⟨y, x, l₂.reverse, l₁.reverse, horig, + by simp [Finset.pair_comm]⟩ + +private theorem hq'Edges : + ∀ (Fminus : Set (Finset GaussianInt)), ∀ (r : GaussianInt → GaussianInt), ∀ (a : + GaussianInt), ∀ (q : List GaussianInt), (∀ (e : Finset GaussianInt), e ∈ Fminus ↔ ∃ (a : + GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), q = l₁ ++ + a :: b :: l₂ ∧ e = {a, b}) → ( + let q' : List GaussianInt := if q.head? = some (r a) then q else q.reverse + ∀ x, ∀ y, ∀ l₁, ∀ l₂, q' = l₁ ++ x :: y :: l₂ → ({x, y} : Finset GaussianInt) ∈ Fminus) := by + classical + intro Fminus r a q hqEdges q' x y l₁ l₂ hdec + by_cases hforward : q.head? = some (r a) + · have hdec' : q = l₁ ++ x :: y :: l₂ := by simpa [q', hforward] using hdec + exact (hqEdges {x, y}).2 ⟨x, y, l₁, l₂, hdec', rfl⟩ + · have hdec' : q.reverse = l₁ ++ x :: y :: l₂ := by + simpa [q', hforward] using hdec + have horig : q = l₂.reverse ++ y :: x :: l₁.reverse := by + calc + q = q.reverse.reverse := (List.reverse_reverse q).symm + _ = (l₁ ++ x :: y :: l₂).reverse := congrArg List.reverse hdec' + _ = l₂.reverse ++ y :: x :: l₁.reverse := by simp [List.reverse_append] + exact (hqEdges {x, y}).2 ⟨y, x, l₂.reverse, l₁.reverse, horig, + by simp [Finset.pair_comm]⟩ + +end CycleArcProof + +namespace CycleArcDetails + +private theorem hara : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (r : GaussianInt → GaussianInt), + ∀ (a : GaussianInt), (r '' Kplus = Kminus) → ((a ∈ Kplus ∩ Kminus) → (r a ∈ Kminus)) := by + classical + intro Kplus Kminus r a hcontact ha + rw [← hcontact] + exact ⟨a, ha.1, rfl⟩ + +private theorem harp : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (r : GaussianInt → GaussianInt), + ∀ (a : GaussianInt), (Function.Involutive r) → ((r '' Kplus = Kminus) → ((a ∈ Kplus ∩ + Kminus) → (r a ∈ Kplus))) := by + classical + intro Kplus Kminus r a hinv hcontact ha + have hImage : a ∈ r '' Kplus := by rw [hcontact]; exact ha.2 + rcases hImage with ⟨z, hz, hza⟩ + have hzr : z = r a := by + calc z = r (r z) := (hinv z).symm + _ = r a := by rw [hza] + rw [← hzr] + exact hz + +private theorem hdistinct : + ∀ (V : Set GaussianInt), ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (r : + GaussianInt → GaussianInt), ∀ (a : GaussianInt), (Kplus ⊆ V) → ((∀ z ∈ V, r z ≠ z) → ((a + ∈ Kplus ∩ Kminus) → (a ≠ r a))) := by + classical + intro V Kplus Kminus r a hpV hfreeV ha h + exact hfreeV a (hpV ha.1) h.symm + +private theorem hXV : + ∀ (V : Set GaussianInt), ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), (Kplus ⊆ + V) → ((Kminus ⊆ V) → ( + let X : Set GaussianInt := Kplus ∪ Kminus + X ⊆ V)) := by + classical + intro V Kplus Kminus hpV hmV X z hz + simp only [X, Set.mem_union] at hz + rcases hz with hz | hz + · exact hpV hz + · exact hmV hz + +private theorem hGE : + ∀ (E : Set (Finset GaussianInt)), ∀ (Fplus : Set (Finset GaussianInt)), ∀ (Fminus : Set + (Finset GaussianInt)), (Fplus ⊆ E) → ((Fminus ⊆ E) → ( + let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus + GEdges ⊆ E)) := by + classical + intro E Fplus Fminus hpE hmE GEdges e he + simp only [GEdges, Set.mem_union] at he + rcases he with he | he + · exact hpE he + · exact hmE he + +private theorem hXfinite : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (p : List GaussianInt), (Kplus = + (↑p.toFinset : Set GaussianInt)) → (∀ (q : List GaussianInt), (Kminus = (↑q.toFinset : + Set GaussianInt)) → ( + let X : Set GaussianInt := Kplus ∪ Kminus + X.Finite)) := by + classical + intro Kplus Kminus p hKp q hKm X + change (Kplus ∪ Kminus).Finite + rw [hKp, hKm] + exact (Finset.finite_toSet p.toFinset).union + (Finset.finite_toSet q.toFinset) + +private theorem edgeAdj : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (Fplus : Set (Finset + GaussianInt)), ∀ (Fminus : Set (Finset GaussianInt)), + let X : Set GaussianInt := Kplus ∪ Kminus + let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus + let G : SimpleGraph X := SimpleGraph.fromRel fun u v => + ({u.1, v.1} : Finset GaussianInt) ∈ GEdges + ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (hu : u ∈ X), ∀ (hv : v ∈ X), u ≠ v → ({u, v} : + Finset GaussianInt) ∈ GEdges → G.Adj ⟨u, hu⟩ ⟨v, hv⟩ := by + classical + intro Kplus Kminus Fplus Fminus X GEdges G u v hu hv huv hedge + simp only [G, SimpleGraph.fromRel_adj] + exact ⟨by intro h; apply huv; exact congrArg Subtype.val h, + Or.inl hedge⟩ + +private theorem pair_ne : + ∀ (s : List GaussianInt), s.Nodup → ∀ x, ∀ y, ∀ l₁, ∀ l₂, s = l₁ ++ x :: y :: l₂ → x ≠ y := by + classical + intro s hs x y l₁ l₂ hdec hxy + have hN : (l₁ ++ x :: y :: l₂).Nodup := by simpa [hdec] using hs + have htail : (x :: y :: l₂).Nodup := (List.nodup_append.mp hN).2.1 + subst y + exact (List.nodup_cons.mp htail).1 (by simp) + +private theorem pEndpoint : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (Fplus : Set (Finset + GaussianInt)), ∀ (Fminus : Set (Finset GaussianInt)), (Disjoint Fplus Fminus) → (∀ (p : + List GaussianInt), (p.Nodup) → ((Kplus = (↑p.toFinset : Set GaussianInt)) → ((∀ (e : + Finset GaussianInt), e ∈ Fplus ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (∀ (q : List + GaussianInt), (q.Nodup) → (((2 : ℕ) ≤ q.length) → ((Kminus = (↑q.toFinset : Set + GaussianInt)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ + (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 + : GaussianInt) ∨ b = a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ b = a - ⟨(0 : ℤ), (1 : ℤ)⟩) → ((∀ (e : + Finset GaussianInt), e ∈ Fminus ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((∀ (s : + List GaussianInt), s.Nodup → ∀ x, x ∈ s → s.head? ≠ some x → s.getLast? ≠ some x → ∃ l₁ + l₂ y z, s = l₁ ++ y :: x :: z :: l₂ ∧ y ≠ z) → ( + let X : Set GaussianInt := Kplus ∪ Kminus + let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus + let G : SimpleGraph X := SimpleGraph.fromRel fun u v => + ({u.1, v.1} : Finset GaussianInt) ∈ GEdges + (∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (hu : u ∈ X), ∀ (hv : v ∈ X), u ≠ v → ({u, v} : + Finset GaussianInt) ∈ GEdges → G.Adj ⟨u, hu⟩ ⟨v, hv⟩) → ((∀ (u : GaussianInt), ∀ (v : + GaussianInt), ∀ (w : GaussianInt), ∀ (z : GaussianInt), ∀ (hu : u ∈ X), ∀ (hv : v ∈ X), ∀ + (hw : w ∈ X), ∀ (hz : z ∈ X), u ≠ v → u ≠ w → u ≠ z → v ≠ w → v ≠ z → w ≠ z → G.Adj ⟨u, + hu⟩ ⟨v, hv⟩ → G.Adj ⟨u, hu⟩ ⟨w, hw⟩ → G.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False) → ((∀ (s : List + GaussianInt), s.Nodup → ∀ x, ∀ y, ∀ l₁, ∀ l₂, s = l₁ ++ x :: y :: l₂ → x ≠ y) → (∀ x, x ∈ + Kplus → x ∈ Kminus → p.head? = some x ∨ p.getLast? = some x))))))))))))) := by + classical + intro Kplus Kminus Fplus Fminus hdisjoint p hpN hKp hpEdges q hqN hqLen hKm hqStep hqEdges + splitInterior X GEdges G edgeAdj noThree pair_ne x hx₁ hx₂ + by_cases hh : p.head? = some x + · exact Or.inl hh + · by_cases hl : p.getLast? = some x + · exact Or.inr hl + · exact False.elim ((CycleArcProof.shared_no_interior_plus Kplus Kminus Fplus Fminus + hdisjoint p hpN hKp hpEdges q hqN hqLen hKm hqStep hqEdges splitInterior edgeAdj noThree + pair_ne) x hx₁ hx₂ hh hl) + +private theorem qEndpoint : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (Fplus : Set (Finset + GaussianInt)), ∀ (Fminus : Set (Finset GaussianInt)), (Disjoint Fplus Fminus) → (∀ (p : + List GaussianInt), (p.Nodup) → (((2 : ℕ) ≤ p.length) → ((Kplus = (↑p.toFinset : Set + GaussianInt)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ + (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 + : GaussianInt) ∨ b = a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ b = a - ⟨(0 : ℤ), (1 : ℤ)⟩) → ((∀ (e : + Finset GaussianInt), e ∈ Fplus ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (∀ (q : List + GaussianInt), (q.Nodup) → ((Kminus = (↑q.toFinset : Set GaussianInt)) → ((∀ (e : Finset + GaussianInt), e ∈ Fminus ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) + (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((∀ (s : List + GaussianInt), s.Nodup → ∀ x, x ∈ s → s.head? ≠ some x → s.getLast? ≠ some x → ∃ l₁ l₂ y + z, s = l₁ ++ y :: x :: z :: l₂ ∧ y ≠ z) → ( + let X : Set GaussianInt := Kplus ∪ Kminus + let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus + let G : SimpleGraph X := SimpleGraph.fromRel fun u v => + ({u.1, v.1} : Finset GaussianInt) ∈ GEdges + (∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (hu : u ∈ X), ∀ (hv : v ∈ X), u ≠ v → ({u, v} : + Finset GaussianInt) ∈ GEdges → G.Adj ⟨u, hu⟩ ⟨v, hv⟩) → ((∀ (u : GaussianInt), ∀ (v : + GaussianInt), ∀ (w : GaussianInt), ∀ (z : GaussianInt), ∀ (hu : u ∈ X), ∀ (hv : v ∈ X), ∀ + (hw : w ∈ X), ∀ (hz : z ∈ X), u ≠ v → u ≠ w → u ≠ z → v ≠ w → v ≠ z → w ≠ z → G.Adj ⟨u, + hu⟩ ⟨v, hv⟩ → G.Adj ⟨u, hu⟩ ⟨w, hw⟩ → G.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False) → ((∀ (s : List + GaussianInt), s.Nodup → ∀ x, ∀ y, ∀ l₁, ∀ l₂, s = l₁ ++ x :: y :: l₂ → x ≠ y) → (∀ x, x ∈ + Kplus → x ∈ Kminus → q.head? = some x ∨ q.getLast? = some x))))))))))))) := by + classical + intro Kplus Kminus Fplus Fminus hdisjoint p hpN hpLen hKp hpStep hpEdges q hqN hKm hqEdges + splitInterior X GEdges G edgeAdj noThree pair_ne x hx₁ hx₂ + by_cases hh : q.head? = some x + · exact Or.inl hh + · by_cases hl : q.getLast? = some x + · exact Or.inr hl + · exact False.elim ((CycleArcProof.shared_no_interior_minus Kplus Kminus Fplus Fminus + hdisjoint p hpN hpLen hKp hpStep hpEdges q hqN hKm hqEdges splitInterior edgeAdj noThree + pair_ne) x hx₁ hx₂ hh hl) + +private theorem fourNe : + (List GaussianInt) → ((List GaussianInt) → ((List GaussianInt) → (∀ u, ∀ v, + FourNeighborAdjacent u v → u ≠ v))) := by + classical + intro c p q u v huv huvEq + subst v + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] at huv + omega + +private theorem hcne : + ∀ (c : List GaussianInt), ((4 : ℕ) ≤ c.length) → (c ≠ []) := by + classical + intro c hcLen hc + simp [hc] at hcLen + +private theorem hcxList : + ∀ (c : List GaussianInt), ∀ (cx : GaussianInt), (c.head? = some cx) → ((c ≠ []) → (cx ∈ c)) + := by + classical + intro c cx hcHead hcne + have hh := (List.head_eq_iff_head?_eq_some hcne).mpr hcHead + simpa [hh] using List.head_mem hcne + +private theorem hcyList : + ∀ (c : List GaussianInt), ∀ (cy : GaussianInt), (c.getLast? = some cy) → ((c ≠ []) → (cy ∈ + c)) := by + classical + intro c cy hcLast hcne + have hh := (List.getLast_eq_iff_getLast?_eq_some hcne).mpr hcLast + simpa [hh] using List.getLast_mem hcne + +private theorem hUV : + ∀ (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), (∀ e, e ∈ E → ∀ x, x ∈ e → x ∈ V) → ( + let U : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + U ⊆ V) := by + classical + intro V E hEend U x hx + rcases hx with ⟨e, he, hxe⟩ + exact hEend e he x hxe + +private theorem hVfinite : + ∀ (V : Set GaussianInt), ∀ (c : List GaussianInt), (V = (↑c.toFinset : Set GaussianInt)) → + (V.Finite) := by + classical + intro V c hVcyc + rw [hVcyc] + exact Finset.finite_toSet c.toFinset + +private theorem edgeAdjE : + ∀ (E : Set (Finset GaussianInt)), + let U : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + let C : SimpleGraph U := SimpleGraph.fromRel fun u v => + ({u.1, v.1} : Finset GaussianInt) ∈ E + ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (hu : u ∈ U), ∀ (hv : v ∈ U), u ≠ v → ({u, v} : + Finset GaussianInt) ∈ E → C.Adj ⟨u, hu⟩ ⟨v, hv⟩ := by + classical + intro E U C u v hu hv huv hedge + simp only [C, SimpleGraph.fromRel_adj] + exact ⟨by intro h; apply huv; exact congrArg Subtype.val h, + Or.inl hedge⟩ + +private theorem hXU : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), + ∀ (Fplus : Set (Finset GaussianInt)), ∀ (Fminus : Set (Finset GaussianInt)), + let X : Set GaussianInt := Kplus ∪ Kminus + let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus + (GEdges ⊆ E) → ((X = {z | ∃ e ∈ GEdges, z ∈ e}) → ( + let U : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + X ⊆ U)) := by + classical + intro Kplus Kminus E Fplus Fminus X GEdges hGE hSupport U x hx + rw [hSupport] at hx + rcases hx with ⟨e, he, hxe⟩ + exact ⟨e, hGE he, hxe⟩ + +private theorem edgeClosure : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), + ∀ (Fplus : Set (Finset GaussianInt)), ∀ (Fminus : Set (Finset GaussianInt)), + let X : Set GaussianInt := Kplus ∪ Kminus + let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus + (X = {z | ∃ e ∈ GEdges, z ∈ e}) → ((∀ x, x ∈ X → ∀ y, ({x, y} : Finset GaussianInt) ∈ E → + ({x, y} : Finset GaussianInt) ∈ GEdges) → (∀ x, x ∈ X → ∀ y, ({x, y} : Finset + GaussianInt) ∈ E → y ∈ X)) := by + classical + intro Kplus Kminus E Fplus Fminus X GEdges hSupport edgeCovered x hx y he + rw [hSupport] + exact ⟨{x, y}, edgeCovered x hx y he, by simp⟩ + +private theorem haCycle : + ∀ (V : Set GaussianInt), ∀ (a : GaussianInt), ∀ (c : List GaussianInt), (V = (↑c.toFinset : + Set GaussianInt)) → ((a ∈ V) → (a ∈ c)) := by + classical + intro V a c hVcyc haV + rw [hVcyc] at haV + simpa using haV + +private theorem hcyLast : + ∀ (a : GaussianInt), ∀ (c : List GaussianInt), ∀ (cy : GaussianInt), (c.getLast? = some cy) → + (∀ (pre : List GaussianInt), ∀ (suf : List GaussianInt), (c = pre ++ a :: suf) → ((a :: + suf).getLast? = some cy)) := by + classical + intro a c cy hcLast pre suf hcSplit + have h := congrArg List.getLast? hcSplit + simpa only [List.getLast?_append_of_ne_nil pre (by simp : (a :: suf) ≠ [])] + using h.symm.trans hcLast + +private theorem hcySuffix : + ∀ (a : GaussianInt), ∀ (cy : GaussianInt), ∀ (suf : List GaussianInt), ((a :: suf).getLast? = + some cy) → (cy ∈ a :: suf) := by + classical + intro a cy suf hcyLast + rcases (List.getLast?_eq_some_iff).mp hcyLast with ⟨t, ht⟩ + rw [ht] + simp + +private theorem hcyX : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (a : GaussianInt), ∀ (c : List + GaussianInt), ∀ (cy : GaussianInt), + let X : Set GaussianInt := Kplus ∪ Kminus + (∀ pre, ∀ x, ∀ s, c = pre ++ x :: s → x ∈ X → ∀ z, z ∈ s → z ∈ X) → (∀ (pre : List + GaussianInt), ∀ (suf : List GaussianInt), (c = pre ++ a :: suf) → ((a ∈ X) → ((cy ∈ a :: + suf) → (cy ∈ X)))) := by + classical + intro Kplus Kminus a c cy X allTail pre suf hcSplit haX hcySuffix + rcases List.mem_cons.mp hcySuffix with hca | hcs + · simpa [hca] using haX + · exact allTail pre a suf hcSplit haX cy hcs + +private theorem hcShape : + ∀ (V : Set GaussianInt), ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (E : + Set (Finset GaussianInt)), ∀ (a : GaussianInt), ∀ (c : List GaussianInt), ∀ (cx : + GaussianInt), ∀ (cy : GaussianInt), (c.Nodup) → (((4 : ℕ) ≤ c.length) → ((c.head? = some + cx) → ((c.getLast? = some cy) → ((V = (↑c.toFinset : Set GaussianInt)) → ((∀ (a : + GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), + c = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → ((∀ (e : Finset GaussianInt), e ∈ E + ↔ e = {cy, cx} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List + GaussianInt), c = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ( + let X : Set GaussianInt := Kplus ∪ Kminus + (c ≠ []) → ((cx ∈ c) → ((cy ∈ c) → ((∀ pre, ∀ x, ∀ s, c = pre ++ x :: s → x ∈ X → ∀ z, z ∈ s + → z ∈ X) → ((a ∈ c) → (∀ (pre : List GaussianInt), ∀ (suf : List GaussianInt), (c = pre + ++ a :: suf) → (c = cx :: c.tail))))))))))))) := by + classical + intro V Kplus Kminus E a c cx cy hcN hcLen hcHead hcLast hVcyc hcStep hcEdges X hcne hcxList + hcyList allTail haCycle pre suf hcSplit + cases c with + | nil => simp at hcLen + | cons z zs => + have hzx : z = cx := by simpa using hcHead + subst z + rfl + +private theorem hallC : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (c : List GaussianInt), ∀ (cx : + GaussianInt), + let X : Set GaussianInt := Kplus ∪ Kminus + (∀ pre, ∀ x, ∀ s, c = pre ++ x :: s → x ∈ X → ∀ z, z ∈ s → z ∈ X) → ((cx ∈ X) → ((c = cx :: + c.tail) → (∀ z, z ∈ c → z ∈ X))) := by + classical + intro Kplus Kminus c cx X allTail hcxX hcShape z hz + rw [hcShape] at hz + rcases List.mem_cons.mp hz with hzc | hzt + · simpa [hzc] using hcxX + · exact allTail [] cx c.tail hcShape hcxX z hzt + +private theorem hVtoX : + ∀ (V : Set GaussianInt), ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (c : + List GaussianInt), (V = (↑c.toFinset : Set GaussianInt)) → ( + let X : Set GaussianInt := Kplus ∪ Kminus + (∀ z, z ∈ c → z ∈ X) → (V ⊆ X)) := by + classical + intro V Kplus Kminus c hVcyc X hallC z hz + rw [hVcyc] at hz + exact hallC z (by simpa using hz) + +private theorem hp'Nodup : + ∀ (a : GaussianInt), ∀ (p : List GaussianInt), (p.Nodup) → ( + let p' : List GaussianInt := if p.head? = some a then p else p.reverse + p'.Nodup) := by + classical + intro a p hpN p' + dsimp [p'] + split_ifs <;> simp [hpN] + +private theorem hq'Nodup : + ∀ (r : GaussianInt → GaussianInt), ∀ (a : GaussianInt), ∀ (q : List GaussianInt), (q.Nodup) → ( + let q' : List GaussianInt := if q.head? = some (r a) then q else q.reverse + q'.Nodup) := by + classical + intro r a q hqN q' + dsimp [q'] + split_ifs <;> simp [hqN] + +private theorem hp'Set : + ∀ (Kplus : Set GaussianInt), ∀ (a : GaussianInt), ∀ (p : List GaussianInt), (Kplus = + (↑p.toFinset : Set GaussianInt)) → ( + let p' : List GaussianInt := if p.head? = some a then p else p.reverse + (p'.toFinset : Set GaussianInt) = Kplus) := by + classical + intro Kplus a p hKp p' + dsimp [p'] + split_ifs + · exact hKp.symm + · simpa [List.toFinset_reverse] using hKp.symm + +private theorem hq'Set : + ∀ (Kminus : Set GaussianInt), ∀ (r : GaussianInt → GaussianInt), ∀ (a : GaussianInt), ∀ (q : + List GaussianInt), (Kminus = (↑q.toFinset : Set GaussianInt)) → ( + let q' : List GaussianInt := if q.head? = some (r a) then q else q.reverse + (q'.toFinset : Set GaussianInt) = Kminus) := by + classical + intro Kminus r a q hKm q' + dsimp [q'] + split_ifs + · exact hKm.symm + · simpa [List.toFinset_reverse] using hKm.symm + +private theorem hVlists : + ∀ (V : Set GaussianInt), ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (r : + GaussianInt → GaussianInt), ∀ (a : GaussianInt), ∀ (p : List GaussianInt), ∀ (q : List + GaussianInt), (V = Kplus ∪ Kminus) → ( + let p' : List GaussianInt := if p.head? = some a then p else p.reverse + let q' : List GaussianInt := if q.head? = some (r a) then q else q.reverse + ((p'.toFinset : Set GaussianInt) = Kplus) → (((q'.toFinset : Set GaussianInt) = Kminus) → (V + = (p'.toFinset : Set GaussianInt) ∪ (q'.toFinset : Set GaussianInt)))) := by + classical + intro V Kplus Kminus r a p q hVparts p' q' hp'Set hq'Set + rw [hp'Set, hq'Set] + exact hVparts + +private theorem hIntersectionLists : + ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (r : GaussianInt → GaussianInt), + ∀ (a : GaussianInt), (a ∈ Kplus ∩ Kminus) → (∀ (p : List GaussianInt), ∀ (q : List + GaussianInt), (r a ∈ Kminus) → ((r a ∈ Kplus) → ((∀ x, x ∈ Kplus → x ∈ Kminus → p.head? = + some x ∨ p.getLast? = some x) → (((p.head? = some a ∧ p.getLast? = some (r a)) ∨ (p.head? + = some (r a) ∧ p.getLast? = some a)) → ( + let p' : List GaussianInt := if p.head? = some a then p else p.reverse + let q' : List GaussianInt := if q.head? = some (r a) then q else q.reverse + ((p'.toFinset : Set GaussianInt) = Kplus) → (((q'.toFinset : Set GaussianInt) = Kminus) → + ((p'.toFinset : Set GaussianInt) ∩ (q'.toFinset : Set GaussianInt) = {a, r a}))))))) := by + classical + intro Kplus Kminus r a ha p q hara harp pEndpoint pOrientation p' q' hp'Set hq'Set + rw [hp'Set, hq'Set] + exact (CycleArcProof.hIntersection Kplus Kminus r a ha p hara harp pEndpoint pOrientation) + +end CycleArcDetails + +theorem P4651T1CycleComplementaryArcs : + ∀ (V : Set GaussianInt), ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (E : + Set (Finset GaussianInt)), ∀ (Fplus : Set (Finset GaussianInt)), ∀ (Fminus : Set (Finset + GaussianInt)), ∀ (r : GaussianInt → GaussianInt), ∀ (a : GaussianInt), (SimpleGridCycle V + E) → ((SimpleGridPath Kplus Fplus) → ((SimpleGridPath Kminus Fminus) → ((Kplus ⊆ V) → + ((Kminus ⊆ V) → ((Fplus ⊆ E) → ((Fminus ⊆ E) → ((Function.Involutive r) → ((r '' V = V) → + (((fun e : Finset GaussianInt => e.image r) '' E = E) → ((∀ z ∈ V, r z ≠ z) → ((∀ e ∈ E, + e.image r ≠ e) → ((r '' Kplus = Kminus) → ((Disjoint Fplus Fminus) → ((a ∈ Kplus ∩ + Kminus) → ((∃ p q : List GaussianInt, + p.Nodup ∧ q.Nodup ∧ + p.head? = some a ∧ p.getLast? = some (r a) ∧ + q.head? = some (r a) ∧ q.getLast? = some a ∧ + (p.toFinset : Set GaussianInt) = Kplus ∧ + (q.toFinset : Set GaussianInt) = Kminus ∧ + (∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + p = l1 ++ x :: y :: l2 → {x, y} ∈ Fplus) ∧ + (∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + q = l1 ++ x :: y :: l2 → {x, y} ∈ Fminus) ∧ + V = (p.toFinset : Set GaussianInt) ∪ (q.toFinset : Set GaussianInt) ∧ + (p.toFinset : Set GaussianInt) ∩ (q.toFinset : Set GaussianInt) = + {a, r a}) ∧ + ∀ e ∈ E, e ∈ Fplus ∨ e ∈ Fminus))))))))))))))) := by + intro V Kplus Kminus E Fplus Fminus r a hcycle hp hm hpV hmV hpE hmE hinv hV hE hfreeV hfreeE + hcontact hdisjoint ha +-- BODY + classical + rcases hcycle with ⟨c, cx, cy, hcN, hcLen, hcHead, hcLast, hVcyc, + hclose, hcStep, hcEdges⟩ + rcases hp with ⟨p, hpN, hpLen, hKp, hpStep, hpEdges⟩ + rcases hm with ⟨q, hqN, hqLen, hKm, hqStep, hqEdges⟩ + have hara : r a ∈ Kminus := CycleArcDetails.hara Kplus Kminus r a hcontact ha + have harp : r a ∈ Kplus := CycleArcDetails.harp Kplus Kminus r a hinv hcontact ha + have hdistinct : a ≠ r a := CycleArcDetails.hdistinct V Kplus Kminus r a hpV hfreeV ha + have splitInterior : ∀ (s : List GaussianInt), s.Nodup → + ∀ x, x ∈ s → s.head? ≠ some x → s.getLast? ≠ some x → + ∃ l₁ l₂ y z, s = l₁ ++ y :: x :: z :: l₂ ∧ y ≠ z := CycleArcProof.splitInterior + let X : Set GaussianInt := Kplus ∪ Kminus + let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus + have hXV : X ⊆ V := CycleArcDetails.hXV V Kplus Kminus hpV hmV + have hGE : GEdges ⊆ E := CycleArcDetails.hGE E Fplus Fminus hpE hmE + have hSupport : X = {z | ∃ e ∈ GEdges, z ∈ e} := CycleArcProof.hSupport Kplus Kminus Fplus + Fminus p hpN hpLen hKp hpStep hpEdges q hqN hqLen hKm hqStep hqEdges + have hXfinite : X.Finite := CycleArcDetails.hXfinite Kplus Kminus p hKp q hKm + let : Finite X := hXfinite.to_subtype + have hdeg := SimpleGridCycleSubgraphDegreeTwo X V GEdges E + ⟨c, cx, cy, hcN, hcLen, hcHead, hcLast, hVcyc, hclose, hcStep, hcEdges⟩ + hXV hGE + let G : SimpleGraph X := SimpleGraph.fromRel fun u v => + ({u.1, v.1} : Finset GaussianInt) ∈ GEdges + have hdeg' : ∀ v : X, Set.ncard (G.neighborSet v) ≤ 2 := by + simpa [G, X, GEdges] using hdeg + have edgeAdj : ∀ (u v : GaussianInt) (hu : u ∈ X) (hv : v ∈ X), + u ≠ v → ({u, v} : Finset GaussianInt) ∈ GEdges → + G.Adj ⟨u, hu⟩ ⟨v, hv⟩ := CycleArcDetails.edgeAdj Kplus Kminus Fplus Fminus + have noThree : ∀ (u v w z : GaussianInt) + (hu : u ∈ X) (hv : v ∈ X) (hw : w ∈ X) (hz : z ∈ X), + u ≠ v → u ≠ w → u ≠ z → v ≠ w → v ≠ z → w ≠ z → + G.Adj ⟨u, hu⟩ ⟨v, hv⟩ → G.Adj ⟨u, hu⟩ ⟨w, hw⟩ → + G.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False := CycleArcProof.noThree Kplus Kminus Fplus Fminus c p q + hdeg' + have pair_ne : ∀ (s : List GaussianInt), s.Nodup → + ∀ x y l₁ l₂, s = l₁ ++ x :: y :: l₂ → x ≠ y := CycleArcDetails.pair_ne + have pEndpoint : ∀ x, x ∈ Kplus → x ∈ Kminus → + p.head? = some x ∨ p.getLast? = some x := CycleArcDetails.pEndpoint Kplus Kminus Fplus + Fminus hdisjoint p hpN hKp hpEdges q hqN hqLen hKm hqStep hqEdges splitInterior edgeAdj + noThree pair_ne + have qEndpoint : ∀ x, x ∈ Kplus → x ∈ Kminus → + q.head? = some x ∨ q.getLast? = some x := CycleArcDetails.qEndpoint Kplus Kminus Fplus + Fminus hdisjoint p hpN hpLen hKp hpStep hpEdges q hqN hKm hqEdges splitInterior edgeAdj + noThree pair_ne + have pOrientation : + (p.head? = some a ∧ p.getLast? = some (r a)) ∨ + (p.head? = some (r a) ∧ p.getLast? = some a) := CycleArcProof.pOrientation Kplus Kminus r a + ha p hara harp hdistinct pEndpoint + have qOrientation : + (q.head? = some (r a) ∧ q.getLast? = some a) ∨ + (q.head? = some a ∧ q.getLast? = some (r a)) := CycleArcProof.qOrientation Kplus Kminus r a + ha q hara harp hdistinct qEndpoint + have fourNe : ∀ u v, FourNeighborAdjacent u v → u ≠ v := CycleArcDetails.fourNe c p q + have hcne : c ≠ [] := CycleArcDetails.hcne c hcLen + have hcxList : cx ∈ c := CycleArcDetails.hcxList c cx hcHead hcne + have hcyList : cy ∈ c := CycleArcDetails.hcyList c cy hcLast hcne + have hcxV : cx ∈ V := by rw [hVcyc]; simpa using hcxList + have hcyV : cy ∈ V := by rw [hVcyc]; simpa using hcyList + have hEend : ∀ e, e ∈ E → ∀ x, x ∈ e → x ∈ V := CycleArcProof.hEend V E c cx cy hVcyc hcEdges + hcxV hcyV + let U : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} + have hUV : U ⊆ V := CycleArcDetails.hUV V E hEend + have hVfinite : V.Finite := CycleArcDetails.hVfinite V c hVcyc + have hUfinite : U.Finite := hVfinite.subset hUV + let : Finite U := hUfinite.to_subtype + have hdegE := SimpleGridCycleSubgraphDegreeTwo U V E E + ⟨c, cx, cy, hcN, hcLen, hcHead, hcLast, hVcyc, hclose, hcStep, hcEdges⟩ + hUV (Set.Subset.rfl) + let C : SimpleGraph U := SimpleGraph.fromRel fun u v => + ({u.1, v.1} : Finset GaussianInt) ∈ E + have hdegE' : ∀ v : U, Set.ncard (C.neighborSet v) ≤ 2 := by + simpa [C, U] using hdegE + have edgeAdjE : ∀ (u v : GaussianInt) (hu : u ∈ U) (hv : v ∈ U), + u ≠ v → ({u, v} : Finset GaussianInt) ∈ E → + C.Adj ⟨u, hu⟩ ⟨v, hv⟩ := CycleArcDetails.edgeAdjE E + have hXU : X ⊆ U := CycleArcDetails.hXU Kplus Kminus E Fplus Fminus hGE hSupport + have edgeCovered : ∀ x, x ∈ X → ∀ y, + ({x, y} : Finset GaussianInt) ∈ E → + ({x, y} : Finset GaussianInt) ∈ GEdges := CycleArcProof.edgeCovered Kplus Kminus E Fplus + Fminus hGE hSupport (CycleArcProof.twoNeighbors Kplus Kminus Fplus Fminus r a + hdisjoint ha p hpN hpLen hKp hpStep hpEdges q hqN hqLen hKm hqStep hqEdges hara + harp splitInterior pair_ne (CycleArcProof.path_other pair_ne) pOrientation + qOrientation) (CycleArcProof.hEne E c cx cy hclose hcStep hcEdges p q fourNe) + edgeAdjE (CycleArcProof.noThreeE E c p q hdegE') hXU + have edgeClosure : ∀ x, x ∈ X → ∀ y, + ({x, y} : Finset GaussianInt) ∈ E → y ∈ X := CycleArcDetails.edgeClosure Kplus Kminus E + Fplus Fminus hSupport edgeCovered + have allTail : ∀ pre x s, c = pre ++ x :: s → x ∈ X → + ∀ z, z ∈ s → z ∈ X := CycleArcProof.allTail Kplus Kminus E c cx cy hcEdges edgeClosure + have haV : a ∈ V := hpV ha.1 + have haCycle : a ∈ c := CycleArcDetails.haCycle V a c hVcyc haV + obtain ⟨pre, suf, hcSplit⟩ := (CycleArcProof.splitAt) c a haCycle + have haX : a ∈ X := Set.mem_union_left _ ha.1 + have hcyLast : (a :: suf).getLast? = some cy := CycleArcDetails.hcyLast a c cy hcLast pre suf + hcSplit + have hcySuffix : cy ∈ a :: suf := CycleArcDetails.hcySuffix a cy suf hcyLast + have hcyX : cy ∈ X := CycleArcDetails.hcyX Kplus Kminus a c cy allTail pre suf hcSplit haX + hcySuffix + have hcloseE : ({cy, cx} : Finset GaussianInt) ∈ E := + (hcEdges {cy, cx}).2 (Or.inl rfl) + have hcxX := edgeClosure cy hcyX cx hcloseE + have hcShape : c = cx :: c.tail := CycleArcDetails.hcShape V Kplus Kminus E a c cx cy hcN hcLen + hcHead hcLast hVcyc hcStep hcEdges hcne hcxList hcyList allTail haCycle pre suf hcSplit + have hallC : ∀ z, z ∈ c → z ∈ X := CycleArcDetails.hallC Kplus Kminus c cx allTail hcxX hcShape + have hVtoX : V ⊆ X := CycleArcDetails.hVtoX V Kplus Kminus c hVcyc hallC + have hVparts : V = Kplus ∪ Kminus := by + exact Set.Subset.antisymm hVtoX hXV + let p' : List GaussianInt := if p.head? = some a then p else p.reverse + let q' : List GaussianInt := if q.head? = some (r a) then q else q.reverse + have hp'Orient : p'.head? = some a ∧ p'.getLast? = some (r a) := CycleArcProof.hp'Orient r a p + hdistinct pOrientation + have hq'Orient : q'.head? = some (r a) ∧ q'.getLast? = some a := CycleArcProof.hq'Orient r a q + hdistinct qOrientation + have hp'Nodup : p'.Nodup := CycleArcDetails.hp'Nodup a p hpN + have hq'Nodup : q'.Nodup := CycleArcDetails.hq'Nodup r a q hqN + have hp'Set : (p'.toFinset : Set GaussianInt) = Kplus := CycleArcDetails.hp'Set Kplus a p hKp + have hq'Set : (q'.toFinset : Set GaussianInt) = Kminus := CycleArcDetails.hq'Set Kminus r a q hKm + have hVlists : V = (p'.toFinset : Set GaussianInt) ∪ + (q'.toFinset : Set GaussianInt) := CycleArcDetails.hVlists V Kplus Kminus r a p q hVparts + hp'Set hq'Set + have hIntersectionLists : + (p'.toFinset : Set GaussianInt) ∩ (q'.toFinset : Set GaussianInt) = + {a, r a} := CycleArcDetails.hIntersectionLists Kplus Kminus r a ha p q hara harp + pEndpoint pOrientation hp'Set hq'Set + refine ⟨⟨p', q', hp'Nodup, hq'Nodup, hp'Orient.1, hp'Orient.2, + hq'Orient.1, hq'Orient.2, hp'Set, hq'Set, (CycleArcProof.hp'Edges Fplus a p hpEdges), + (CycleArcProof.hq'Edges Fminus r a q hqEdges), hVlists, hIntersectionLists⟩, + (CycleArcProof.hEdgeCoverage V Kplus Kminus E Fplus Fminus c cx cy hcEdges hEend + (CycleArcProof.cycleOther E c cx cy hclose hcStep hcEdges fourNe) edgeCovered hVtoX)⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4651T1FreeBoundaryHalfTurn.lean b/LeanPool/ApollonianSuperharmonic/P4651T1FreeBoundaryHalfTurn.lean new file mode 100644 index 0000000000..e24d7ee4d9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4651T1FreeBoundaryHalfTurn.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4590T1CentralDiskSectors +public import LeanPool.ApollonianSuperharmonic.P4397T1ReflectedEdgeNotBoundary +public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric + +-- [TABLET NODE: P4651T1FreeBoundaryHalfTurn] + +/-! +# P4651T1FreeBoundaryHalfTurn + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4651T1FreeBoundaryHalfTurn (O : ProtoTile) + (hO : O.cells.Nonempty) (hL : LatticeTile O) + (hQ : QuarterTurnSymmetric O) (w : GaussianInt) + (hw : GaussianRealPoint w = + (2 * (TileCentroid O).1, 2 * (TileCentroid O).2)) + (hR : CentrallyReflectedAt (TileCentroid O) O O) : + (∀ z ∈ BoundaryFootprintVertices O, w - z ≠ z) ∧ + (∀ e ∈ BoundaryFootprintEdges O, + e.image (fun z => w - z) ≠ e) := by +-- BODY + classical + have real_action (z : GaussianInt) : GaussianRealPoint (w - z) = + (2 * (TileCentroid O).1 - (GaussianRealPoint z).1, + 2 * (TileCentroid O).2 - (GaussianRealPoint z).2) := by + have hx := congrArg Prod.fst hw + have hy := congrArg Prod.snd hw + dsimp [GaussianRealPoint] at hx hy + change (((w.re - z.re : Int) : Real), ((w.im - z.im : Int) : Real)) = _ + push_cast + exact Prod.ext (by dsimp [GaussianRealPoint]; linarith) + (by dsimp [GaussianRealPoint]; linarith) + have free_vertex : ∀ z ∈ BoundaryFootprintVertices O, w - z ≠ z := by + intro z hz hfix + have hh := real_action z + rw [hfix] at hh + have hc : TileCentroid O = GaussianRealPoint z := by + have hx := congrArg Prod.fst hh + have hy := congrArg Prod.snd hh + exact Prod.ext (by dsimp at hx ⊢; linarith) + (by dsimp at hy ⊢; linarith) + have hall := P4590T1CentralDiskSectors O hL hQ z hc + have hraw : z ∈ FootprintVertices O := by + simp only [FootprintVertices, ite_eq_left hO, Set.mem_ofPred_eq] + exact ⟨z, by simpa [LatticeVertexIncidentCell] using hall 0, Or.inl rfl⟩ + exact ((P4456T2VertexInterior O hO z hraw).2.mpr hall) hz + refine ⟨free_vertex, ?_⟩ + intro e he hfix + have impossible (a b : GaussianInt) (hadj : FourNeighborAdjacent a b) + (he : {a, b} ∈ BoundaryFootprintEdges O) + (hf : ({a, b} : Finset GaussianInt).image (fun z => w - z) = {a, b}) : + False := by + have ha : a ∈ BoundaryFootprintVertices O := by + simp only [BoundaryFootprintVertices, ite_eq_left hO, Set.mem_ofPred_eq] + exact ⟨{a, b}, he, by simp⟩ + have hr : w - a = a ∨ w - a = b := by + have : w - a ∈ ({a, b} : Finset GaussianInt) := by + rw [← hf] + exact Finset.mem_image.mpr ⟨a, by simp, rfl⟩ + simpa only [Finset.mem_insert, Finset.mem_singleton] using this + rcases hr with hr | hr + · exact free_vertex a ha hr + · have hab : GaussianRealPoint b = + (2 * (TileCentroid O).1 - (GaussianRealPoint a).1, + 2 * (TileCentroid O).2 - (GaussianRealPoint a).2) := by + rw [← hr] + exact real_action a + exact P4397T1ReflectedEdgeNotBoundary O (TileCentroid O) hR a b hadj hab he + rcases he with ⟨z, ⟨rfl, hz⟩ | ⟨rfl, hz⟩⟩ + · exact impossible z (z + 1) (Or.inl rfl) ⟨z, Or.inl ⟨rfl, hz⟩⟩ hfix + · exact impossible z (z + ⟨0, 1⟩) (Or.inr (Or.inr (Or.inl rfl))) + ⟨z, Or.inr ⟨rfl, hz⟩⟩ hfix + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4651T1GridHalfTurnTransport.lean b/LeanPool/ApollonianSuperharmonic/P4651T1GridHalfTurnTransport.lean new file mode 100644 index 0000000000..f96c6d1deb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4651T1GridHalfTurnTransport.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P4651T1GridHalfTurnTransport] + +/-! +# P4651T1GridHalfTurnTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4651T1GridHalfTurnTransport (c : Real × Real) (w : GaussianInt) + (hw : GaussianRealPoint w = (2 * c.1, 2 * c.2)) + (S T : ProtoTile) (hS : S.cells.Nonempty) (hT : T.cells.Nonempty) + (hR : CentrallyReflectedAt c S T) : + T.cells = S.cells.image (fun t => w - t - 1 - ⟨0, 1⟩) ∧ + BoundaryFootprintEdges T = + (fun e : Finset GaussianInt => e.image (fun z => w - z)) '' + BoundaryFootprintEdges S ∧ + BoundaryFootprintVertices T = + (fun z : GaussianInt => w - z) '' BoundaryFootprintVertices S := by +-- BODY + classical + let H : Real × Real → Real × Real := fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + let r : GaussianInt → GaussianInt := fun z => w - z + let f : GaussianInt → GaussianInt := fun t => w - t - 1 - ⟨0, 1⟩ + have hH (p : Real × Real) : H (H p) = p := by + ext <;> dsimp [H] <;> ring + have hr : Function.Involutive r := by intro z; dsimp [r]; abel + have hf : Function.Involutive f := by intro z; dsimp [f]; abel + have hmem (p : Real × Real) : p ∈ TileRealization S ↔ H p ∈ TileRealization T := by + change TileRealization T = H '' TileRealization S at hR + rw [hR] + constructor + · intro hp + exact ⟨p, hp, rfl⟩ + · rintro ⟨q, hq, hqp⟩ + have heq : q = p := by + have h := congrArg H hqp + simpa only [hH] using h + exact heq ▸ hq + have center (q : GaussianInt) : + H (GaussianRealPoint q + ((1 / 2, 1 / 2) : Real × Real)) = + GaussianRealPoint (f q) + ((1 / 2, 1 / 2) : Real × Real) := by + have hx := congrArg Prod.fst hw + have hy := congrArg Prod.snd hw + dsimp [GaussianRealPoint] at hx hy + change (2 * c.1 - ((q.re : Real) + 1 / 2), + 2 * c.2 - ((q.im : Real) + 1 / 2)) = + ((((w.re - q.re - 1 - 0 : Int) : Real) + 1 / 2), + (((w.im - q.im - 0 - 1 : Int) : Real) + 1 / 2)) + push_cast + exact Prod.ext (by linarith) (by linarith) + have hcell (q : GaussianInt) : q ∈ S.cells ↔ f q ∈ T.cells := by + rw [← P3776T1CellCenterMembership, ← P3776T1CellCenterMembership, + hmem, center] + have hback (q : GaussianInt) : q ∈ T.cells ↔ f q ∈ S.cells := by + simpa only [hf q] using (hcell (f q)).symm + have hcells : T.cells = S.cells.image f := by + ext q + constructor + · intro hq + exact Finset.mem_image.mpr ⟨f q, (hback q).mp hq, hf q⟩ + · rintro hq + obtain ⟨x, hx, rfl⟩ := Finset.mem_image.mp hq + exact (hcell x).mp hx + have transport (A B : ProtoTile) + (hc : ∀ q, q ∈ A.cells ↔ f q ∈ B.cells) + (e : Finset GaussianInt) (he : e ∈ BoundaryFootprintEdges A) : + e.image r ∈ BoundaryFootprintEdges B := by + rcases he with ⟨z, ⟨rfl, hz⟩ | ⟨rfl, hz⟩⟩ + · refine ⟨w - z - 1, Or.inl ⟨?_, ?_⟩⟩ + · simp only [Finset.image_insert, Finset.image_singleton] + change ({w - z, w - (z + 1)} : Finset GaussianInt) = + {w - z - 1, w - z - 1 + 1} + have h1 : w - (z + 1) = w - z - 1 := by abel + have h2 : w - z - 1 + 1 = w - z := by abel + rw [h1, h2, Finset.pair_comm] + · have h1 : f (z - ⟨0, 1⟩) = w - z - 1 := by dsimp [f]; abel + have h2 : f z = w - z - 1 - ⟨0, 1⟩ := rfl + rw [← h2, ← h1, ← hc (z - ⟨0, 1⟩), ← hc z] + exact hz.elim (fun h => Or.inr ⟨h.2, h.1⟩) (fun h => Or.inl ⟨h.2, h.1⟩) + · refine ⟨w - z - ⟨0, 1⟩, Or.inr ⟨?_, ?_⟩⟩ + · simp only [Finset.image_insert, Finset.image_singleton] + change ({w - z, w - (z + ⟨0, 1⟩)} : Finset GaussianInt) = + {w - z - ⟨0, 1⟩, w - z - ⟨0, 1⟩ + ⟨0, 1⟩} + have h1 : w - (z + ⟨0, 1⟩) = w - z - ⟨0, 1⟩ := by abel + have h2 : w - z - ⟨0, 1⟩ + ⟨0, 1⟩ = w - z := by abel + rw [h1, h2, Finset.pair_comm] + · have h1 : f (z - 1) = w - z - ⟨0, 1⟩ := by dsimp [f]; abel + have h2 : f z = w - z - ⟨0, 1⟩ - 1 := by dsimp [f]; abel + rw [← h2, ← h1, ← hc (z - 1), ← hc z] + exact hz.elim (fun h => Or.inr ⟨h.2, h.1⟩) (fun h => Or.inl ⟨h.2, h.1⟩) + have heinv (e : Finset GaussianInt) : (e.image r).image r = e := by + rw [Finset.image_image] + have hid : r ∘ r = id := funext hr + rw [hid, Finset.image_id] + have hedges : BoundaryFootprintEdges T = + (fun e : Finset GaussianInt => e.image r) '' BoundaryFootprintEdges S := by + ext e + constructor + · intro he + exact ⟨e.image r, transport T S hback e he, heinv e⟩ + · rintro ⟨d, hd, rfl⟩ + exact transport S T hcell d hd + refine ⟨hcells, hedges, ?_⟩ + ext z + simp only [BoundaryFootprintVertices, ite_eq_left hT, ite_eq_left hS, Set.mem_ofPred_eq] + constructor + · rintro ⟨e, he, hze⟩ + rw [hedges] at he + obtain ⟨d, hd, rfl⟩ := he + obtain ⟨x, hx, rfl⟩ := Finset.mem_image.mp hze + exact ⟨x, ⟨d, hd, hx⟩, rfl⟩ + · rintro ⟨x, ⟨e, he, hxe⟩, rfl⟩ + exact ⟨e.image r, hedges ▸ ⟨e, he, rfl⟩, Finset.mem_image.mpr ⟨x, hxe, rfl⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4670T1ComplementReflection.lean b/LeanPool/ApollonianSuperharmonic/P4670T1ComplementReflection.lean new file mode 100644 index 0000000000..ff357b2f69 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4670T1ComplementReflection.lean @@ -0,0 +1,642 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P4670T1ComplementReflection] + +/-! +# P4670T1ComplementReflection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ComplementReflectionConstruction + +private noncomputable abbrev H (c : ℝ × ℝ) : Real × Real → Real × Real := by + classical + exact fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + +private theorem hmemAB (A : ProtoTile) (B : ProtoTile) (c : ℝ × ℝ) (hAB : TileRealization B = (H + c) '' TileRealization A) (p : Real × Real) : p ∈ TileRealization A ↔ + (H c) p ∈ TileRealization B := by + classical + let H : Real × Real → Real × Real := + fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + change (TileRealization B = H '' TileRealization A) at hAB + change (p ∈ TileRealization A ↔ + H p ∈ TileRealization B) + rw [hAB] + constructor + · exact fun hp => ⟨p, hp, rfl⟩ + · rintro ⟨q, hq, hqp⟩ + have : q = p := by + obtain ⟨hx, hy⟩ := Prod.mk.inj hqp + ext <;> linarith + exact this ▸ hq + +private theorem hmemO (O : ProtoTile) (c : ℝ × ℝ) (hO : TileRealization O = (H c) '' + TileRealization O) (p : Real × Real) : p ∈ TileRealization O ↔ + (H c) p ∈ TileRealization O := by + classical + let H : Real × Real → Real × Real := + fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + change (TileRealization O = H '' TileRealization O) at hO + change (p ∈ TileRealization O ↔ + H p ∈ TileRealization O) + constructor + · intro hp + rw [hO] + exact ⟨p, hp, rfl⟩ + · intro hp + have hHp : H p ∈ H '' TileRealization O := by + rw [← hO] + exact hp + obtain ⟨q, hq, hqp⟩ := hHp + have : q = p := by + obtain ⟨hx, hy⟩ := Prod.mk.inj hqp + ext <;> linarith + subst q + exact hq + +private theorem hbackAB (A : ProtoTile) (B : ProtoTile) (c : ℝ × ℝ) (hmemAB : ∀ (p : ℝ × ℝ), p ∈ + TileRealization A ↔ (H c) p ∈ TileRealization B) (p : Real × Real) : p ∈ TileRealization B ↔ + (H c) p ∈ TileRealization A := by + classical + let H : Real × Real → Real × Real := + fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + change (∀ (p : ℝ × ℝ), p ∈ TileRealization A ↔ H p ∈ TileRealization B) at hmemAB + change (p ∈ TileRealization B ↔ + H p ∈ TileRealization A) + constructor + · intro hp + have hHH : H (H p) = p := by dsimp [H]; ext <;> ring + have hp' : H (H p) ∈ TileRealization B := by simpa only [hHH] using hp + exact (hmemAB _).mpr hp' + · intro hp + have hp' := (hmemAB _).mp hp + have hHH : H (H p) = p := by dsimp [H]; ext <;> ring + simpa only [hHH] using hp' + +private theorem hneB (A : ProtoTile) (B : ProtoTile) (c : ℝ × ℝ) (hA : Finset.Nonempty A.cells) + (hmemAB : ∀ (p : ℝ × ℝ), p ∈ TileRealization A ↔ (H c) p ∈ TileRealization B) : + B.cells.Nonempty := by + classical + let H : Real × Real → Real × Real := + fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + change (∀ (p : ℝ × ℝ), p ∈ TileRealization A ↔ H p ∈ TileRealization B) at hmemAB + obtain ⟨q, hq⟩ := hA + have hp : GaussianRealPoint q + ((1 / 2, 1 / 2) : Real × Real) ∈ + TileRealization A := (P3776T1CellCenterMembership A q).2 hq + have hpr := (hmemAB _).mp hp + simp only [TileRealization, Set.mem_iUnion] at hpr + obtain ⟨z, hz, _⟩ := hpr + exact ⟨z, hz⟩ + +private noncomputable abbrev amax (A : ProtoTile) (hA : Finset.Nonempty A.cells) : Int := by + classical + exact (A.cells.image fun z => z.re).max' + (Finset.image_nonempty.mpr hA) + +private noncomputable abbrev bmin (B : ProtoTile) (hneB : Finset.Nonempty B.cells) : Int := by + classical + exact (B.cells.image fun z => z.re).min' + (Finset.image_nonempty.mpr hneB) + +private theorem hmaxmem (A : ProtoTile) (hA : Finset.Nonempty A.cells) : (amax A hA) ∈ + A.cells.image (fun z => z.re) := by + classical + let amax : Int := (A.cells.image fun z => z.re).max' + (Finset.image_nonempty.mpr hA) + change (amax ∈ A.cells.image (fun z => z.re)) + exact Finset.max'_mem _ _ + +private theorem hbminmem (B : ProtoTile) (hneB : Finset.Nonempty B.cells) : (bmin B hneB) ∈ + B.cells.image (fun z => z.re) := by + classical + let bmin : Int := (B.cells.image fun z => z.re).min' + (Finset.image_nonempty.mpr hneB) + change (bmin ∈ B.cells.image (fun z => z.re)) + exact Finset.min'_mem _ _ + +private theorem hpointA (A : ProtoTile) (hA : Finset.Nonempty A.cells) (qa : LatticeCell) (haq : + qa ∈ A.cells) (haqre : qa.re = (amax A hA)) : ((((amax A hA) : Int) : Real) + 1, + (qa.im : Real)) ∈ TileRealization A := by + classical + let amax : Int := (A.cells.image fun z => z.re).max' + (Finset.image_nonempty.mpr hA) + change (qa.re = amax) at haqre + change ((((amax : Int) : Real) + 1, + (qa.im : Real)) ∈ TileRealization A) + simp only [TileRealization, Set.mem_iUnion] + refine ⟨qa, haq, ?_⟩ + simp [ClosedSquareRealization, haqre, Set.mem_Icc, Prod.le_def] + +private theorem hpointB (B : ProtoTile) (hneB : Finset.Nonempty B.cells) (qb : LatticeCell) (hqb + : qb ∈ B.cells) (hqbim : qb.re = (bmin B hneB)) : ((((bmin B hneB) : Int) : Real), (qb.im : + Real)) ∈ + TileRealization B := by + classical + let bmin : Int := (B.cells.image fun z => z.re).min' + (Finset.image_nonempty.mpr hneB) + change (qb.re = bmin) at hqbim + change ((((bmin : Int) : Real), (qb.im : Real)) ∈ + TileRealization B) + simp only [TileRealization, Set.mem_iUnion] + refine ⟨qb, hqb, ?_⟩ + simp [ClosedSquareRealization, hqbim, Set.mem_Icc, Prod.le_def] + +private theorem hpointAtoB (A : ProtoTile) (B : ProtoTile) (c : ℝ × ℝ) (hA : Finset.Nonempty + A.cells) (hmemAB : ∀ (p : ℝ × ℝ), p ∈ TileRealization A ↔ (H c) p ∈ TileRealization B) (qa : + LatticeCell) (hpointA : ((↑(amax A hA) : ℝ) + 1, (↑qa.im : ℝ)) ∈ TileRealization A) : (H c) + ((↑(amax A hA) : ℝ) + 1, (↑qa.im : ℝ)) ∈ TileRealization B := by + classical + let H : Real × Real → Real × Real := + fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + let amax : Int := (A.cells.image fun z => z.re).max' + (Finset.image_nonempty.mpr hA) + change (∀ (p : ℝ × ℝ), p ∈ TileRealization A ↔ H p ∈ TileRealization B) at hmemAB + change (((↑amax : ℝ) + 1, (↑qa.im : ℝ)) ∈ TileRealization A) at hpointA + change (H ((↑amax : ℝ) + 1, (↑qa.im : ℝ)) ∈ TileRealization B) + exact (hmemAB _).mp hpointA + +private theorem hpointBtoA (A : ProtoTile) (B : ProtoTile) (c : ℝ × ℝ) (hbackAB : ∀ (p : ℝ × ℝ), + p ∈ TileRealization B ↔ (H c) p ∈ TileRealization A) (hneB : Finset.Nonempty B.cells) (qb : + LatticeCell) (hpointB : ((↑(bmin B hneB) : ℝ), (↑qb.im : ℝ)) ∈ TileRealization B) : (H c) + ((↑(bmin B hneB) : ℝ), (↑qb.im : ℝ)) ∈ TileRealization A := by + classical + let H : Real × Real → Real × Real := + fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + let bmin : Int := (B.cells.image fun z => z.re).min' + (Finset.image_nonempty.mpr hneB) + change (∀ (p : ℝ × ℝ), p ∈ TileRealization B ↔ H p ∈ TileRealization A) at hbackAB + change (((↑bmin : ℝ), (↑qb.im : ℝ)) ∈ TileRealization B) at hpointB + change (H ((↑bmin : ℝ), (↑qb.im : ℝ)) ∈ TileRealization A) + exact (hbackAB _).mp hpointB + +private theorem hmaxbound (A : ProtoTile) (hA : Finset.Nonempty A.cells) (p : Real × Real) (hp : + p ∈ TileRealization A) : + p.1 ≤ ((amax A hA) : Real) + 1 := by + classical + let amax : Int := (A.cells.image fun z => z.re).max' + (Finset.image_nonempty.mpr hA) + change (p.1 ≤ (amax : Real) + 1) + simp only [TileRealization, Set.mem_iUnion] at hp + obtain ⟨z, hz, hpz⟩ := hp + have hzr : z.re ≤ amax := by + apply Finset.le_max' + exact Finset.mem_image.mpr ⟨z, hz, rfl⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpz + exact le_trans hpz.2.1 (by exact_mod_cast (Int.add_le_add_right hzr 1)) + +private theorem hbminbound (B : ProtoTile) (hneB : Finset.Nonempty B.cells) (p : Real × Real) (hp + : p ∈ TileRealization B) : + ((bmin B hneB) : Real) ≤ p.1 := by + classical + let bmin : Int := (B.cells.image fun z => z.re).min' + (Finset.image_nonempty.mpr hneB) + change ((bmin : Real) ≤ p.1) + simp only [TileRealization, Set.mem_iUnion] at hp + obtain ⟨z, hz, hpz⟩ := hp + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpz + have hzr : bmin ≤ z.re := by + apply Finset.min'_le + exact Finset.mem_image.mpr ⟨z, hz, rfl⟩ + exact le_trans (by exact_mod_cast hzr) hpz.1.1 + +private theorem hxb (A : ProtoTile) (B : ProtoTile) (c : ℝ × ℝ) (hA : Finset.Nonempty A.cells) + (hneB : Finset.Nonempty B.cells) (qa : LatticeCell) (qb : LatticeCell) (hpointAtoB : (H c) + ((↑(amax A hA) : ℝ) + 1, (↑qa.im : ℝ)) ∈ TileRealization B) (hpointBtoA : (H c) ((↑(bmin B + hneB) : ℝ), (↑qb.im : ℝ)) ∈ TileRealization A) (hmaxbound : ∀ p ∈ TileRealization A, p.1 ≤ + (↑(amax A hA) : ℝ) + 1) (hbminbound : ∀ p ∈ TileRealization B, (↑(bmin B hneB) : ℝ) ≤ p.1) : + ((bmin B hneB) : Real) = 2 * c.1 - (((amax A hA) : Real) + 1) := by + classical + let H : Real × Real → Real × Real := + fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + let amax : Int := (A.cells.image fun z => z.re).max' + (Finset.image_nonempty.mpr hA) + let bmin : Int := (B.cells.image fun z => z.re).min' + (Finset.image_nonempty.mpr hneB) + change (H ((↑amax : ℝ) + 1, (↑qa.im : ℝ)) ∈ TileRealization B) at hpointAtoB + change (H ((↑bmin : ℝ), (↑qb.im : ℝ)) ∈ TileRealization A) at hpointBtoA + change (∀ p ∈ TileRealization A, p.1 ≤ (↑amax : ℝ) + 1) at hmaxbound + change (∀ p ∈ TileRealization B, (↑bmin : ℝ) ≤ p.1) at hbminbound + change ((bmin : Real) = 2 * c.1 - ((amax : Real) + 1)) + apply le_antisymm + · have hb := hbminbound _ hpointAtoB + exact hb + · have ha := hmaxbound _ hpointBtoA + dsimp [H] at hpointBtoA + linarith + +private theorem hcx (A : ProtoTile) (B : ProtoTile) (c : ℝ × ℝ) (hA : Finset.Nonempty A.cells) + (hneB : Finset.Nonempty B.cells) (hxb : (↑(bmin B hneB) : ℝ) = 2 * c.1 - ((↑(amax A hA) : ℝ) + + 1)) : ∃ dx : Int, (dx : Real) = 2 * c.1 := by + classical + let amax : Int := (A.cells.image fun z => z.re).max' + (Finset.image_nonempty.mpr hA) + let bmin : Int := (B.cells.image fun z => z.re).min' + (Finset.image_nonempty.mpr hneB) + change ((↑bmin : ℝ) = 2 * c.1 - ((↑amax : ℝ) + 1)) at hxb + refine ⟨bmin + amax + 1, ?_⟩ + rw [Int.cast_add, Int.cast_add, Int.cast_one] + linarith [hxb] + +private noncomputable abbrev aimax (A : ProtoTile) (hA : Finset.Nonempty A.cells) : Int := by + classical + exact (A.cells.image fun z => z.im).max' + (Finset.image_nonempty.mpr hA) + +private noncomputable abbrev bimin (B : ProtoTile) (hneB : Finset.Nonempty B.cells) : Int := by + classical + exact (B.cells.image fun z => z.im).min' + (Finset.image_nonempty.mpr hneB) + +private theorem haimem (A : ProtoTile) (hA : Finset.Nonempty A.cells) : (aimax A hA) ∈ + A.cells.image (fun z => z.im) := by + classical + let aimax : Int := (A.cells.image fun z => z.im).max' + (Finset.image_nonempty.mpr hA) + change (aimax ∈ A.cells.image (fun z => z.im)) + exact Finset.max'_mem _ _ + +private theorem hbimem (B : ProtoTile) (hneB : Finset.Nonempty B.cells) : (bimin B hneB) ∈ + B.cells.image (fun z => z.im) := by + classical + let bimin : Int := (B.cells.image fun z => z.im).min' + (Finset.image_nonempty.mpr hneB) + change (bimin ∈ B.cells.image (fun z => z.im)) + exact Finset.min'_mem _ _ + +private theorem hpointAy (A : ProtoTile) (hA : Finset.Nonempty A.cells) (qay : LatticeCell) (haqy + : qay ∈ A.cells) (haqim : qay.im = (aimax A hA)) : ((qay.re : Real), ((aimax A hA) : Real) + + 1) ∈ TileRealization A := by + classical + let aimax : Int := (A.cells.image fun z => z.im).max' + (Finset.image_nonempty.mpr hA) + change (qay.im = aimax) at haqim + change (((qay.re : Real), (aimax : Real) + 1) ∈ TileRealization A) + simp only [TileRealization, Set.mem_iUnion] + refine ⟨qay, haqy, ?_⟩ + simp [ClosedSquareRealization, haqim, Set.mem_Icc, Prod.le_def] + +private theorem hpointBy (B : ProtoTile) (hneB : Finset.Nonempty B.cells) (qby : LatticeCell) + (hqby : qby ∈ B.cells) (hqbim' : qby.im = (bimin B hneB)) : ((qby.re : Real), ((bimin B hneB) + : Real)) ∈ TileRealization B := by + classical + let bimin : Int := (B.cells.image fun z => z.im).min' + (Finset.image_nonempty.mpr hneB) + change (qby.im = bimin) at hqbim' + change (((qby.re : Real), (bimin : Real)) ∈ TileRealization B) + simp only [TileRealization, Set.mem_iUnion] + refine ⟨qby, hqby, ?_⟩ + simp [ClosedSquareRealization, hqbim', Set.mem_Icc, Prod.le_def] + +private theorem hmaxY (A : ProtoTile) (hA : Finset.Nonempty A.cells) (p : Real × Real) (hp : p ∈ + TileRealization A) : + p.2 ≤ ((aimax A hA) : Real) + 1 := by + classical + let aimax : Int := (A.cells.image fun z => z.im).max' + (Finset.image_nonempty.mpr hA) + change (p.2 ≤ (aimax : Real) + 1) + simp only [TileRealization, Set.mem_iUnion] at hp + obtain ⟨z, hz, hpz⟩ := hp + have hzr : z.im ≤ aimax := by + apply Finset.le_max' + exact Finset.mem_image.mpr ⟨z, hz, rfl⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpz + exact le_trans hpz.2.2 (by exact_mod_cast (Int.add_le_add_right hzr 1)) + +private theorem hbminY (B : ProtoTile) (hneB : Finset.Nonempty B.cells) (p : Real × Real) (hp : p + ∈ TileRealization B) : + ((bimin B hneB) : Real) ≤ p.2 := by + classical + let bimin : Int := (B.cells.image fun z => z.im).min' + (Finset.image_nonempty.mpr hneB) + change ((bimin : Real) ≤ p.2) + simp only [TileRealization, Set.mem_iUnion] at hp + obtain ⟨z, hz, hpz⟩ := hp + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hpz + have hzr : bimin ≤ z.im := by + apply Finset.min'_le + exact Finset.mem_image.mpr ⟨z, hz, rfl⟩ + exact le_trans (by exact_mod_cast hzr) hpz.1.2 + +private theorem hcy (A : ProtoTile) (B : ProtoTile) (c : ℝ × ℝ) (hA : Finset.Nonempty A.cells) + (hmemAB : ∀ (p : ℝ × ℝ), p ∈ TileRealization A ↔ (H c) p ∈ TileRealization B) (hbackAB : ∀ (p + : ℝ × ℝ), p ∈ TileRealization B ↔ (H c) p ∈ TileRealization A) (hneB : Finset.Nonempty + B.cells) (qay : LatticeCell) (qby : LatticeCell) (hpointAy : ((↑qay.re : ℝ), (↑(aimax A hA) : + ℝ) + 1) ∈ TileRealization A) (hpointBy : ((↑qby.re : ℝ), (↑(bimin B hneB) : ℝ)) ∈ + TileRealization B) (hmaxY : ∀ p ∈ TileRealization A, p.2 ≤ (↑(aimax A hA) : ℝ) + 1) (hbminY : + ∀ p ∈ TileRealization B, (↑(bimin B hneB) : ℝ) ≤ p.2) : ∃ dy : Int, (dy : Real) = 2 * c.2 := by + classical + let H : Real × Real → Real × Real := + fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + let aimax : Int := (A.cells.image fun z => z.im).max' + (Finset.image_nonempty.mpr hA) + let bimin : Int := (B.cells.image fun z => z.im).min' + (Finset.image_nonempty.mpr hneB) + change (∀ (p : ℝ × ℝ), p ∈ TileRealization A ↔ H p ∈ TileRealization B) at hmemAB + change (∀ (p : ℝ × ℝ), p ∈ TileRealization B ↔ H p ∈ TileRealization A) at hbackAB + change (((↑qay.re : ℝ), (↑aimax : ℝ) + 1) ∈ TileRealization A) at hpointAy + change (((↑qby.re : ℝ), (↑bimin : ℝ)) ∈ TileRealization B) at hpointBy + change (∀ p ∈ TileRealization A, p.2 ≤ (↑aimax : ℝ) + 1) at hmaxY + change (∀ p ∈ TileRealization B, (↑bimin : ℝ) ≤ p.2) at hbminY + have hby := (hmemAB _).mp hpointAy + have hbacky := (hbackAB _).mp hpointBy + have hbi : (bimin : Real) = 2 * c.2 - ((aimax : Real) + 1) := by + apply le_antisymm + · exact hbminY _ hby + · have ha := hmaxY _ hbacky + dsimp [H] at hbacky + linarith + refine ⟨bimin + aimax + 1, ?_⟩ + rw [Int.cast_add, Int.cast_add, Int.cast_one] + linarith [hbi] + +private noncomputable abbrev w (dx : ℤ) (dy : ℤ) : GaussianInt := by + classical + exact ⟨dx, dy⟩ + +private theorem hw (c : ℝ × ℝ) (dx : ℤ) (hdx : (↑dx : ℝ) = 2 * c.1) (dy : ℤ) (hdy : (↑dy : ℝ) = 2 + * c.2) : GaussianRealPoint (w dx dy) = (2 * c.1, 2 * c.2) := by + classical + let w : GaussianInt := ⟨dx, dy⟩ + change (GaussianRealPoint w = (2 * c.1, 2 * c.2)) + change ((dx : Real), (dy : Real)) = (2 * c.1, 2 * c.2) + exact Prod.ext hdx hdy + +private noncomputable abbrev f (dx : ℤ) (dy : ℤ) : GaussianInt → GaussianInt := by + classical + let w : GaussianInt := ⟨dx, dy⟩ + exact fun q => w - q - 1 - ⟨0, 1⟩ + +private theorem Hcenter (c : ℝ × ℝ) (dx : ℤ) (hdx : (↑dx : ℝ) = 2 * c.1) (dy : ℤ) (hdy : (↑dy : + ℝ) = 2 * c.2) (hw : GaussianRealPoint (w dx dy) = (2 * c.1, 2 * c.2)) (q : GaussianInt) : + (H c) (GaussianRealPoint q + ((1 / 2, 1 / 2) : Real × Real)) = + GaussianRealPoint ((f dx dy) q) + ((1 / 2, 1 / 2) : Real × Real) := by + classical + let H : Real × Real → Real × Real := + fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + let w : GaussianInt := ⟨dx, dy⟩ + let f : GaussianInt → GaussianInt := fun q => w - q - 1 - ⟨0, 1⟩ + change (GaussianRealPoint w = (2 * c.1, 2 * c.2)) at hw + change (H (GaussianRealPoint q + ((1 / 2, 1 / 2) : Real × Real)) = + GaussianRealPoint (f q) + ((1 / 2, 1 / 2) : Real × Real)) + have hx := congrArg Prod.fst hw + have hy := congrArg Prod.snd hw + dsimp [GaussianRealPoint] at hx hy + change (2 * c.1 - ((q.re : Real) + 1 / 2), + 2 * c.2 - ((q.im : Real) + 1 / 2)) = + ((((w.re - q.re - 1 - 0 : Int) : Real) + 1 / 2), + (((w.im - q.im - 0 - 1 : Int) : Real) + 1 / 2)) + push_cast + exact Prod.ext (by linarith) (by linarith) + +private theorem hcellAB (A : ProtoTile) (B : ProtoTile) (c : ℝ × ℝ) (hmemAB : ∀ (p : ℝ × ℝ), p ∈ + TileRealization A ↔ (H c) p ∈ TileRealization B) (dx : ℤ) (dy : ℤ) (Hcenter : ∀ (q : + GaussianInt), (H c) (GaussianRealPoint q + (1 / 2, 1 / 2)) = GaussianRealPoint ((f dx dy) q) + + (1 / 2, 1 / 2)) (q : GaussianInt) : q ∈ A.cells ↔ + (f dx dy) q ∈ B.cells := by + classical + let H : Real × Real → Real × Real := + fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + let w : GaussianInt := ⟨dx, dy⟩ + let f : GaussianInt → GaussianInt := fun q => w - q - 1 - ⟨0, 1⟩ + change (∀ (p : ℝ × ℝ), p ∈ TileRealization A ↔ H p ∈ TileRealization B) at hmemAB + change (∀ (q : GaussianInt), H (GaussianRealPoint q + (1 / 2, 1 / 2)) = GaussianRealPoint (f q) + + (1 / 2, 1 / 2)) at Hcenter + change (q ∈ A.cells ↔ + f q ∈ B.cells) + rw [← P3776T1CellCenterMembership, ← P3776T1CellCenterMembership, + hmemAB, Hcenter] + +private theorem hcellO (O : ProtoTile) (c : ℝ × ℝ) (hmemO : ∀ (p : ℝ × ℝ), p ∈ TileRealization O + ↔ (H c) p ∈ TileRealization O) (dx : ℤ) (dy : ℤ) (Hcenter : ∀ (q : GaussianInt), (H c) + (GaussianRealPoint q + (1 / 2, 1 / 2)) = GaussianRealPoint ((f dx dy) q) + (1 / 2, 1 / 2)) (q + : GaussianInt) : q ∈ O.cells ↔ + (f dx dy) q ∈ O.cells := by + classical + let H : Real × Real → Real × Real := + fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + let w : GaussianInt := ⟨dx, dy⟩ + let f : GaussianInt → GaussianInt := fun q => w - q - 1 - ⟨0, 1⟩ + change (∀ (p : ℝ × ℝ), p ∈ TileRealization O ↔ H p ∈ TileRealization O) at hmemO + change (∀ (q : GaussianInt), H (GaussianRealPoint q + (1 / 2, 1 / 2)) = GaussianRealPoint (f q) + + (1 / 2, 1 / 2)) at Hcenter + change (q ∈ O.cells ↔ + f q ∈ O.cells) + rw [← P3776T1CellCenterMembership, ← P3776T1CellCenterMembership, + hmemO, Hcenter] + +private theorem hf (dx : ℤ) (dy : ℤ) : Function.Involutive (f dx dy) := by + classical + let w : GaussianInt := ⟨dx, dy⟩ + let f : GaussianInt → GaussianInt := fun q => w - q - 1 - ⟨0, 1⟩ + change (Function.Involutive f) + intro q + dsimp [f] + abel + +private theorem hcellComp (A : ProtoTile) (B : ProtoTile) (O : ProtoTile) (dx : ℤ) (dy : ℤ) + (hcellAB : ∀ (q : GaussianInt), q ∈ A.cells ↔ (f dx dy) q ∈ B.cells) (hcellO : ∀ (q : + GaussianInt), q ∈ O.cells ↔ (f dx dy) q ∈ O.cells) (q : GaussianInt) : + q ∈ A.cells \ O.cells ↔ (f dx dy) q ∈ B.cells \ O.cells := by + classical + let w : GaussianInt := ⟨dx, dy⟩ + let f : GaussianInt → GaussianInt := fun q => w - q - 1 - ⟨0, 1⟩ + change (∀ (q : GaussianInt), q ∈ A.cells ↔ f q ∈ B.cells) at hcellAB + change (∀ (q : GaussianInt), q ∈ O.cells ↔ f q ∈ O.cells) at hcellO + change (q ∈ A.cells \ O.cells ↔ f q ∈ B.cells \ O.cells) + rw [Finset.mem_sdiff, Finset.mem_sdiff] + exact ⟨fun ⟨ha, hno⟩ => + ⟨(hcellAB q).mp ha, fun hqo => hno ((hcellO q).mpr hqo)⟩, + fun ⟨hb, hno⟩ => + ⟨(hcellAB q).mpr hb, fun hqo => hno ((hcellO q).mp hqo)⟩⟩ + +private theorem hsquare (c : ℝ × ℝ) (dx : ℤ) (dy : ℤ) (hw : GaussianRealPoint (w dx dy) = (2 * + c.1, 2 * c.2)) (q : GaussianInt) (p : Real × Real) : + p ∈ ClosedSquareRealization q ↔ (H c) p ∈ ClosedSquareRealization ((f dx dy) q) := by + classical + let H : Real × Real → Real × Real := + fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + let w : GaussianInt := ⟨dx, dy⟩ + let f : GaussianInt → GaussianInt := fun q => w - q - 1 - ⟨0, 1⟩ + change (GaussianRealPoint w = (2 * c.1, 2 * c.2)) at hw + change (p ∈ ClosedSquareRealization q ↔ H p ∈ ClosedSquareRealization (f q)) + have hx := congrArg Prod.fst hw + have hy := congrArg Prod.snd hw + dsimp [GaussianRealPoint] at hx hy + have hfre : ((f q).re : Real) = 2 * c.1 - (q.re : Real) - 1 := by + change ((w.re - q.re - 1 - 0 : Int) : Real) = _ + push_cast + rw [hx] + ring + have hfim : ((f q).im : Real) = 2 * c.2 - (q.im : Real) - 1 := by + change ((w.im - q.im - 0 - 1 : Int) : Real) = _ + push_cast + rw [hy] + ring + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor + · rintro ⟨⟨hxl, hyl⟩, ⟨hxu, hyu⟩⟩ + refine ⟨⟨?_, ?_⟩, ⟨?_, ?_⟩⟩ <;> dsimp [H] at * + · rw [hfre]; linarith + · rw [hfim]; linarith + · rw [hfre]; linarith + · rw [hfim]; linarith + · rintro ⟨⟨hxl, hyl⟩, ⟨hxu, hyu⟩⟩ + refine ⟨⟨?_, ?_⟩, ⟨?_, ?_⟩⟩ <;> dsimp [H] at * + · rw [hfre] at hxl; linarith + · rw [hfim] at hyl; linarith + · rw [hfre] at hxu; linarith + · rw [hfim] at hyu; linarith + +private theorem hreal (A : ProtoTile) (B : ProtoTile) (O : ProtoTile) (c : ℝ × ℝ) (dx : ℤ) (dy : + ℤ) (hf : Function.Involutive (f dx dy)) (hcellComp : ∀ (q : GaussianInt), q ∈ A.cells \ + O.cells ↔ (f dx dy) q ∈ B.cells \ O.cells) (hsquare : ∀ (q : GaussianInt) (p : ℝ × ℝ), p ∈ + ClosedSquareRealization q ↔ (H c) p ∈ ClosedSquareRealization ((f dx dy) q)) (p : Real × Real) : + p ∈ TileRealization (TileCellComplement A O) ↔ + (H c) p ∈ TileRealization (TileCellComplement B O) := by + classical + let H : Real × Real → Real × Real := + fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + let w : GaussianInt := ⟨dx, dy⟩ + let f : GaussianInt → GaussianInt := fun q => w - q - 1 - ⟨0, 1⟩ + change (Function.Involutive f) at hf + change (∀ (q : GaussianInt), q ∈ A.cells \ O.cells ↔ f q ∈ B.cells \ O.cells) at hcellComp + change (∀ (q : GaussianInt) (p : ℝ × ℝ), p ∈ ClosedSquareRealization q ↔ H p ∈ + ClosedSquareRealization (f q)) at hsquare + change (p ∈ TileRealization (TileCellComplement A O) ↔ + H p ∈ TileRealization (TileCellComplement B O)) + constructor + · intro hp + simp only [TileCellComplement, TileRealization, Set.mem_iUnion] at hp ⊢ + obtain ⟨q, hq, hpq⟩ := hp + refine ⟨f q, (hcellComp q).mp hq, (hsquare q p).mp hpq⟩ + · intro hp + simp only [TileCellComplement, TileRealization, Set.mem_iUnion] at hp ⊢ + obtain ⟨q, hq, hpq⟩ := hp + refine ⟨f q, ?_, ?_⟩ + · exact (hcellComp (f q)).mpr (by simpa only [hf q] using hq) + · exact (hsquare (f q) p).mpr (by simpa only [hf q] using hpq) + +end ComplementReflectionConstruction + +theorem P4670T1ComplementReflection (A B O : ProtoTile) (c : Real × Real) + (hA : A.cells.Nonempty) + (hAB : CentrallyReflectedAt c A B) + (hO : CentrallyReflectedAt c O O) : + CentrallyReflectedAt c (TileCellComplement A O) + (TileCellComplement B O) := by +-- BODY + classical + let H : Real × Real → Real × Real := + fun p => (2 * c.1 - p.1, 2 * c.2 - p.2) + change TileRealization B = H '' TileRealization A at hAB + change TileRealization O = H '' TileRealization O at hO + have hmemAB (p : Real × Real) : p ∈ TileRealization A ↔ + H p ∈ TileRealization B := ComplementReflectionConstruction.hmemAB A B c hAB p + have hmemO (p : Real × Real) : p ∈ TileRealization O ↔ + H p ∈ TileRealization O := ComplementReflectionConstruction.hmemO O c hO p + have hbackAB (p : Real × Real) : p ∈ TileRealization B ↔ + H p ∈ TileRealization A := ComplementReflectionConstruction.hbackAB A B c hmemAB p + have hneB : B.cells.Nonempty := ComplementReflectionConstruction.hneB A B c hA hmemAB + let amax : Int := (A.cells.image fun z => z.re).max' + (Finset.image_nonempty.mpr hA) + let bmin : Int := (B.cells.image fun z => z.re).min' + (Finset.image_nonempty.mpr hneB) + have hmaxmem : amax ∈ A.cells.image (fun z => z.re) := ComplementReflectionConstruction.hmaxmem + A hA + have hbminmem : bmin ∈ B.cells.image (fun z => z.re) := + ComplementReflectionConstruction.hbminmem B hneB + obtain ⟨qa, haq, haqre⟩ := Finset.mem_image.mp hmaxmem + obtain ⟨qb, hqb, hqbim⟩ := Finset.mem_image.mp hbminmem + have hpointA : (((amax : Int) : Real) + 1, + (qa.im : Real)) ∈ TileRealization A := ComplementReflectionConstruction.hpointA A hA qa haq + haqre + have hpointB : (((bmin : Int) : Real), (qb.im : Real)) ∈ + TileRealization B := ComplementReflectionConstruction.hpointB B hneB qb hqb hqbim + have hpointAtoB := ComplementReflectionConstruction.hpointAtoB A B c hA hmemAB qa hpointA + have hpointBtoA := ComplementReflectionConstruction.hpointBtoA A B c hbackAB hneB qb hpointB + have hmaxbound (p : Real × Real) (hp : p ∈ TileRealization A) : + p.1 ≤ (amax : Real) + 1 := ComplementReflectionConstruction.hmaxbound A hA p hp + have hbminbound (p : Real × Real) (hp : p ∈ TileRealization B) : + (bmin : Real) ≤ p.1 := ComplementReflectionConstruction.hbminbound B hneB p hp + have hxb : (bmin : Real) = 2 * c.1 - ((amax : Real) + 1) := + ComplementReflectionConstruction.hxb A B c hA hneB qa qb hpointAtoB hpointBtoA hmaxbound + hbminbound + have hcx : ∃ dx : Int, (dx : Real) = 2 * c.1 := ComplementReflectionConstruction.hcx A B c hA + hneB hxb + let aimax : Int := (A.cells.image fun z => z.im).max' + (Finset.image_nonempty.mpr hA) + let bimin : Int := (B.cells.image fun z => z.im).min' + (Finset.image_nonempty.mpr hneB) + have haimem : aimax ∈ A.cells.image (fun z => z.im) := ComplementReflectionConstruction.haimem + A hA + have hbimem : bimin ∈ B.cells.image (fun z => z.im) := ComplementReflectionConstruction.hbimem + B hneB + obtain ⟨qay, haqy, haqim⟩ := Finset.mem_image.mp haimem + obtain ⟨qby, hqby, hqbim'⟩ := Finset.mem_image.mp hbimem + have hpointAy : ((qay.re : Real), (aimax : Real) + 1) ∈ TileRealization A := + ComplementReflectionConstruction.hpointAy A hA qay haqy haqim + have hpointBy : ((qby.re : Real), (bimin : Real)) ∈ TileRealization B := + ComplementReflectionConstruction.hpointBy B hneB qby hqby hqbim' + have hmaxY (p : Real × Real) (hp : p ∈ TileRealization A) : + p.2 ≤ (aimax : Real) + 1 := ComplementReflectionConstruction.hmaxY A hA p hp + have hbminY (p : Real × Real) (hp : p ∈ TileRealization B) : + (bimin : Real) ≤ p.2 := ComplementReflectionConstruction.hbminY B hneB p hp + have hcy : ∃ dy : Int, (dy : Real) = 2 * c.2 := ComplementReflectionConstruction.hcy A B c hA + hmemAB hbackAB hneB qay qby hpointAy hpointBy hmaxY hbminY + obtain ⟨dx, hdx⟩ := hcx + obtain ⟨dy, hdy⟩ := hcy + let w : GaussianInt := ⟨dx, dy⟩ + have hw : GaussianRealPoint w = (2 * c.1, 2 * c.2) := ComplementReflectionConstruction.hw c dx + hdx dy hdy + let f : GaussianInt → GaussianInt := fun q => w - q - 1 - ⟨0, 1⟩ + have Hcenter (q : GaussianInt) : + H (GaussianRealPoint q + ((1 / 2, 1 / 2) : Real × Real)) = + GaussianRealPoint (f q) + ((1 / 2, 1 / 2) : Real × Real) := + ComplementReflectionConstruction.Hcenter c dx hdx dy hdy hw q + have hcellAB (q : GaussianInt) : q ∈ A.cells ↔ + f q ∈ B.cells := ComplementReflectionConstruction.hcellAB A B c hmemAB dx dy Hcenter q + have hcellO (q : GaussianInt) : q ∈ O.cells ↔ + f q ∈ O.cells := ComplementReflectionConstruction.hcellO O c hmemO dx dy Hcenter q + have hf : Function.Involutive f := ComplementReflectionConstruction.hf dx dy + have hcellComp (q : GaussianInt) : + q ∈ A.cells \ O.cells ↔ f q ∈ B.cells \ O.cells := + ComplementReflectionConstruction.hcellComp A B O dx dy hcellAB hcellO q + have hsquare (q : GaussianInt) (p : Real × Real) : + p ∈ ClosedSquareRealization q ↔ H p ∈ ClosedSquareRealization (f q) := + ComplementReflectionConstruction.hsquare c dx dy hw q p + have hreal (p : Real × Real) : + p ∈ TileRealization (TileCellComplement A O) ↔ + H p ∈ TileRealization (TileCellComplement B O) := ComplementReflectionConstruction.hreal + A B O c dx dy hf hcellComp hsquare p + change TileRealization (TileCellComplement B O) = + H '' TileRealization (TileCellComplement A O) + ext p + constructor + · intro hp + have hH : H (H p) = p := by dsimp [H]; ext <;> ring + have hp' : H p ∈ TileRealization (TileCellComplement A O) := by + exact (hreal (H p)).mpr (by simpa only [hH] using hp) + exact ⟨H p, hp', hH⟩ + · rintro ⟨q, hq, rfl⟩ + exact (hreal q).mp hq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4670T1OrdinaryEdges.lean b/LeanPool/ApollonianSuperharmonic/P4670T1OrdinaryEdges.lean new file mode 100644 index 0000000000..7e7a8b9abf --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4670T1OrdinaryEdges.lean @@ -0,0 +1,240 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: P4670T1OrdinaryEdges] + +/-! +# P4670T1OrdinaryEdges + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4670T1OrdinaryEdges + (P : Fin 3 → Bool → ProtoTile) (u v : GaussianInt) + (hP : ∀ i s, (P i s).cells.Nonempty) + (X Y : ProtoTile) (hX : X.cells.Nonempty) (hY : Y.cells.Nonempty) + (hXA : X.cells ⊆ (P 0 true).cells) + (hYB : Y.cells ⊆ (P 0 false).cells) + (hXC : TileTouching X (P 1 true)) + (hYD : TileTouching Y (P 1 false)) + (houter : + TouchingTriple (P 0 true) (TileTranslation (P 0 false) v) + (TileTranslation (P 2 true) v) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) v) (P 2 false) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) (u + v)) + (TileTranslation (P 1 true) (u + v)) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) (u + v)) (P 1 false) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 1 true) (u + v)) + (TileTranslation (P 2 true) v) ∧ + TouchingTriple (P 0 false) (TileTranslation (P 1 false) (-u - v)) + (TileTranslation (P 2 false) (-v)) ∧ + TouchingTriple (P 1 true) (TileTranslation (P 1 false) (-u)) + (TileTranslation (P 2 true) (-u)) ∧ + TouchingTriple (P 1 true) (TileTranslation (P 1 false) (-u)) (P 2 false)) : + ∀ a b : PeriodicSubtileIndex, AllowedSubtileIncidence a b → + ¬ ((a.label = .A ∧ b.label = .B ∨ a.label = .B ∧ b.label = .A) ∧ + a.first = b.first ∧ a.second = b.second) → + (FootprintEdges (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v b)).Nonempty := by +-- BODY + classical + let common (A B : ProtoTile) := (FootprintEdges A ∩ FootprintEdges B).Nonempty + have boundary (U : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges U) : e ∈ FootprintEdges U := by + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [Zsqrtd.ext_iff] + · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + have pair (A B : ProtoTile) (ha : A.cells.Nonempty) (hb : B.cells.Nonempty) + (ht : TileTouching A B) : common A B := by + rcases ht with h | h | h + · obtain ⟨p, _, hp, _, _, he⟩ := h.2.2.2 + cases p with + | nil => simp at hp + | cons a p => + cases p with + | nil => simp at hp + | cons b p => + have h := (he {a, b}).mpr ⟨a, b, [], p, rfl, rfl⟩ + exact ⟨{a, b}, boundary _ _ h.1, boundary _ _ h.2⟩ + · exact (ha.ne_empty h.1).elim + · exact (hb.ne_empty h.1).elim + have sym (A B : ProtoTile) (h : common A B) : common B A := by + simpa only [common, Set.inter_comm] using h + have triple (A B C : ProtoTile) (ha : A.cells.Nonempty) (hb : B.cells.Nonempty) + (hc : C.cells.Nonempty) (h : TouchingTriple A B C) : + common A B ∧ common B C ∧ common C A := + ⟨pair A B ha hb h.1, pair B C hb hc h.2.1, pair C A hc ha h.2.2.1⟩ + have ne (i : Fin 3) (s : Bool) (w : GaussianInt) : + (TileTranslation (P i s) w).cells.Nonempty := Finset.image_nonempty.mpr (hP i s) + have H1 := triple _ _ _ (hP 0 true) (ne 0 false v) (ne 2 true v) houter.1 + have H2 := triple _ _ _ (hP 0 true) (ne 0 false v) (hP 2 false) houter.2.1 + have H3 := triple _ _ _ (hP 0 true) (ne 0 false (u + v)) + (ne 1 true (u + v)) houter.2.2.1 + have H4 := triple _ _ _ (hP 0 true) (ne 0 false (u + v)) (hP 1 false) houter.2.2.2.1 + have H6 := triple _ _ _ (hP 0 false) (ne 1 false (-u - v)) + (ne 2 false (-v)) houter.2.2.2.2.2.1 + have H7 := triple _ _ _ (hP 1 true) (ne 1 false (-u)) + (ne 2 true (-u)) houter.2.2.2.2.2.2.1 + have H8 := triple _ _ _ (hP 1 true) (ne 1 false (-u)) + (hP 2 false) houter.2.2.2.2.2.2.2 + have trans (A B : ProtoTile) (w : GaussianInt) (h : common A B) : + common (TileTranslation A w) (TileTranslation B w) := by + obtain ⟨e, hea, heb⟩ := h + refine ⟨e.image (GaussianTranslation w), ?_, ?_⟩ + · rw [(TileTranslationFormulas A w).2.2.2.2.2.2.1] + exact ⟨e, hea, rfl⟩ + · rw [(TileTranslationFormulas B w).2.2.2.2.2.2.1] + exact ⟨e, heb, rfl⟩ + have tr0 (A : ProtoTile) : TileTranslation A 0 = A := by + have hz : GaussianTranslation 0 = id := by funext z; exact add_zero z + cases A + simp only [TileTranslation, hz, Finset.image_id, id_eq] + have trcomp (A : ProtoTile) (x y : GaussianInt) : + TileTranslation (TileTranslation A x) y = TileTranslation A (x + y) := by + cases A + simp only [TileTranslation, Finset.image_image] + congr 1 + · congr 1 + funext z + exact add_assoc z x y + · exact add_assoc _ x y + have ac : common (P 0 true) (P 1 true) := by + obtain ⟨e, ⟨z, hz, he⟩, hc⟩ := pair X _ hX (hP 1 true) hXC + exact ⟨e, ⟨z, hXA hz, he⟩, hc⟩ + have bd : common (P 0 false) (P 1 false) := by + obtain ⟨e, ⟨z, hz, he⟩, hc⟩ := pair Y _ hY (hP 1 false) hYD + exact ⟨e, ⟨z, hYB hz, he⟩, hc⟩ + have bc : common (P 0 false) (P 1 true) := by + simpa only [trcomp, add_neg_cancel, tr0] using trans _ _ (-(u + v)) H3.2.1 + have be : common (P 0 false) (P 2 true) := by + simpa only [trcomp, add_neg_cancel, tr0] using trans _ _ (-v) H1.2.1 + have de : common (P 1 false) (P 2 true) := by + simpa only [trcomp, neg_add_cancel, tr0] using trans _ _ u H7.2.1 + have df : common (P 1 false) (TileTranslation (P 2 false) u) := by + simpa only [trcomp, neg_add_cancel, tr0] using trans _ _ u H8.2.1 + have shifted (o : PeriodicSubtileIndex) (m n : Int) : + SubtileOccurrenceInterpretation P u v + {o with first := o.first + m, second := o.second + n} = + TileTranslation (SubtileOccurrenceInterpretation P u v o) + ((m : GaussianInt) * u + (n : GaussianInt) * v) := by + rcases o with ⟨l, a, b⟩ + cases l <;> simp only [SubtileOccurrenceInterpretation, trcomp] <;> + congr 1 <;> simp only [Int.cast_add, add_mul] <;> abel + have lift (a b : PeriodicSubtileIndex) (m n : Int) + (h : common (SubtileOccurrenceInterpretation P u v a) + (SubtileOccurrenceInterpretation P u v b)) : + common (SubtileOccurrenceInterpretation P u v + {a with first := a.first + m, second := a.second + n}) + (SubtileOccurrenceInterpretation P u v + {b with first := b.first + m, second := b.second + n}) := by + rw [shifted, shifted] + exact trans _ _ _ h + intro a b hab + induction hab with + | AB m n => intro h; exact (h (by simp)).elim + | AB01 m n => + intro _ + have h := lift ⟨.A, 0, 0⟩ ⟨.B, 0, 1⟩ m n (by + simpa [SubtileOccurrenceInterpretation, tr0] using H1.1) + simpa only [zero_add, add_zero, add_comm] using h + | AB11 m n => + intro _ + have h := lift ⟨.A, 0, 0⟩ ⟨.B, 1, 1⟩ m n (by + simpa [SubtileOccurrenceInterpretation, tr0] using H3.1) + simpa only [zero_add, add_zero, add_comm] using h + | AC m n => + intro _ + simpa only [zero_add] using lift ⟨.A, 0, 0⟩ ⟨.C, 0, 0⟩ m n (by simpa + [SubtileOccurrenceInterpretation, tr0] using ac) + | AC11 m n => + intro _ + have h := lift ⟨.A, 0, 0⟩ ⟨.C, 1, 1⟩ m n (by + simpa [SubtileOccurrenceInterpretation, tr0] using sym _ _ H3.2.2) + simpa only [zero_add, add_zero, add_comm] using h + | AD m n => + intro _ + simpa only [zero_add] using lift ⟨.A, 0, 0⟩ ⟨.D, 0, 0⟩ m n (by + simpa [SubtileOccurrenceInterpretation, tr0] using sym _ _ H4.2.2) + | AE01 m n => + intro _ + have h := lift ⟨.A, 0, 0⟩ ⟨.E, 0, 1⟩ m n (by + simpa [SubtileOccurrenceInterpretation, tr0] using sym _ _ H1.2.2) + simpa only [zero_add, add_zero, add_comm] using h + | AF m n => + intro _ + simpa only [zero_add] using lift ⟨.A, 0, 0⟩ ⟨.F, 0, 0⟩ m n (by + simpa [SubtileOccurrenceInterpretation, tr0] using sym _ _ H2.2.2) + | BC m n => + intro _ + simpa only [zero_add] using lift ⟨.B, 0, 0⟩ ⟨.C, 0, 0⟩ m n (by simpa + [SubtileOccurrenceInterpretation, tr0] using bc) + | BDm1m1 m n => + intro _ + have h := lift ⟨.B, 0, 0⟩ ⟨.D, -1, -1⟩ m n (by + simpa [SubtileOccurrenceInterpretation, tr0, sub_eq_add_neg] using H6.1) + simpa only [zero_add, add_zero, add_comm, sub_eq_add_neg] using h + | BD m n => + intro _ + simpa only [zero_add] using lift ⟨.B, 0, 0⟩ ⟨.D, 0, 0⟩ m n (by simpa + [SubtileOccurrenceInterpretation, tr0] using bd) + | BE m n => + intro _ + simpa only [zero_add] using lift ⟨.B, 0, 0⟩ ⟨.E, 0, 0⟩ m n (by simpa + [SubtileOccurrenceInterpretation, tr0] using be) + | BF0m1 m n => + intro _ + have h := lift ⟨.B, 0, 0⟩ ⟨.F, 0, -1⟩ m n (by + simpa [SubtileOccurrenceInterpretation, tr0] using sym _ _ H6.2.2) + simpa only [zero_add, add_zero, add_comm, sub_eq_add_neg] using h + | CDm10 m n => + intro _ + have h := lift ⟨.C, 0, 0⟩ ⟨.D, -1, 0⟩ m n (by + simpa [SubtileOccurrenceInterpretation, tr0] using H7.1) + simpa only [zero_add, add_zero, add_comm, sub_eq_add_neg] using h + | CEm10 m n => + intro _ + have h := lift ⟨.C, 0, 0⟩ ⟨.E, -1, 0⟩ m n (by + simpa [SubtileOccurrenceInterpretation, tr0] using sym _ _ H7.2.2) + simpa only [zero_add, add_zero, add_comm, sub_eq_add_neg] using h + | CF m n => + intro _ + simpa only [zero_add] using lift ⟨.C, 0, 0⟩ ⟨.F, 0, 0⟩ m n (by + simpa [SubtileOccurrenceInterpretation, tr0] using sym _ _ H8.2.2) + | DE m n => + intro _ + simpa only [zero_add] using lift ⟨.D, 0, 0⟩ ⟨.E, 0, 0⟩ m n (by simpa + [SubtileOccurrenceInterpretation, tr0] using de) + | DF10 m n => + intro _ + have h := lift ⟨.D, 0, 0⟩ ⟨.F, 1, 0⟩ m n (by + simpa [SubtileOccurrenceInterpretation, tr0] using df) + simpa only [zero_add, add_zero, add_comm] using h + | @symm a b hab ih => + intro h + apply sym + apply ih + simpa only [and_comm, or_comm, eq_comm] using h + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4670T1SmallerGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4670T1SmallerGeometry.lean new file mode 100644 index 0000000000..64b0c3ac04 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4670T1SmallerGeometry.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance + +-- [TABLET NODE: P4670T1SmallerGeometry] + +/-! +# P4670T1SmallerGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4670T1SmallerGeometry (n : Nat) + (hsmall : ∀ (p : Fin 4 → CircleCoordinates) (V : ProtoTile) + (S : Fin 3 → Bool → ProtoTile), ProperBandQuadruple p → + BandPrototile (p 0) V → + (∀ i s, BandSubtileOccurrence p V i s (S i s)) → + (∀ x, x ∈ V.cells ↔ ∃ i s, x ∈ (S i s).cells) → + Int.toNat (p 0).1 < n → + LatticeTile V ∧ TileArea V = Int.toNat (p 0).1) + (c : CircleCoordinates) (U : ProtoTile) (hU : BandPrototile c U) + (hlt : Int.toNat c.1 < n) : + 0 ≤ c.1 ∧ TileArea U = Int.toNat c.1 ∧ + (0 < c.1 → LatticeTile U) := by +-- BODY + cases hU with + | line w x hw => + simp [TileArea] + | unit z x anchor => + refine ⟨by norm_num, by simp [TileArea], ?_⟩ + intro _ + have hd := ((TileDiskAreaCovariance (FordTile 1) x).1).mp + (FordTileGeometry 1 (by decide)).1 + have hc : (TileTranslation (FordTile 1) x).cells = {x} := by + simp [TileTranslation, FordTile, FordCellDomain, GaussianTranslation] + rfl + change TopologicalDisk (TileRealization (⟨{x}, anchor⟩ : ProtoTile)) + change TopologicalDisk (TileRealization (TileTranslation (FordTile 1) x)) at hd + simpa only [TileRealization, hc] using hd + | @decompose p hp S _ hS hcells hfoot hcent => + have hv : BandPrototile (p 0) U := + BandPrototile.decompose hp hS hcells hfoot hcent + have hg := hsmall p U S hp hv (fun i s => ⟨hS i s, hfoot i s, hcent i s⟩) + hcells hlt + exact ⟨(SemiProperForestClassification p hp.1).1 0, hg.2, fun _ => hg.1⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2DrawingData.lean b/LeanPool/ApollonianSuperharmonic/P4677T2DrawingData.lean new file mode 100644 index 0000000000..be88aa53f8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4677T2DrawingData.lean @@ -0,0 +1,132 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation + +-- [TABLET NODE: P4677T2DrawingData] + +/-! +# P4677T2DrawingData + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For Gaussian integers $u,v$ and an additive subgroup $L$, periodic drawing +data consist of positions on `PeriodicSubtileIndex`, edge arcs, +and regions indexed by `PeriodicSubtileFaceIndex`, with the +geometric laws of `PlaneTriangulation`: injective positions, +symmetric arcs, interval homeomorphisms with the specified endpoint +positions on allowed edges, intersections of distinct allowed edges +exactly at common endpoint positions, open connected pairwise disjoint +face regions, face frontier exactly the three side arcs, and coverage +by positions, allowed arcs, and face regions. Here adjacency is +`AllowedSubtileIncidence` and face vertices are +`SixSubtileFaceVertices`. The abstract graph laws, including +three-connectivity and the two-face incidence law, are not part of these +data. A coordinate function $c:L\to\mathbb Z^2$ satisfies +$c_1(w)u+c_2(w)v=w$. Vertex shift adds $c(w)$ to the two integer +coordinates, preserving the label; face shift does the same. Both shifts +have the zero and addition action laws. +Adjacency is invariant, and the face-vertex map is equivariant. Positions, +edge arcs, and open face regions translate by the real vector of $w$. +There are finite vertex, ordered-edge, and face representative sets. +Every ordered-edge representative $(a,b)$ satisfies allowed incidence +between $a$ and $b$. +The vertex representatives are exactly the six zero-coordinate indices; +the face representatives are exactly the twelve zero-coordinate faces. +Every vertex has a unique representative in its shift orbit, and every +ordered adjacent pair and every face is a shift of a representative. +These data contain no tile, selected lattice point, footprint walk, or +fundamental set of lattice cells. +-/ +structure P4677T2DrawingData (u v : GaussianInt) + (L : AddSubgroup GaussianInt) where +-- BODY + /-- The embedded position of each periodic occurrence index. -/ + position : PeriodicSubtileIndex → Real × Real + /-- The stored plane arc for each ordered pair of occurrence indices. -/ + edgeArc : PeriodicSubtileIndex → PeriodicSubtileIndex → Set (Real × Real) + /-- The open region of each translated face label. -/ + faceRegion : PeriodicSubtileFaceIndex → Set (Real × Real) + position_injective : Function.Injective position + arc_symmetric : ∀ a b, edgeArc a b = edgeArc b a + arc_homeomorph : ∀ a b, AllowedSubtileIncidence a b → + ∃ h : (Set.Icc (0 : Real) 1) ≃ₜ edgeArc a b, + ((h ⟨0, by norm_num⟩ : edgeArc a b) : Real × Real) = position a ∧ + ((h ⟨1, by norm_num⟩ : edgeArc a b) : Real × Real) = position b + arc_intersections : ∀ a b c d, + AllowedSubtileIncidence a b → AllowedSubtileIncidence c d → + ({a, b} : Set PeriodicSubtileIndex) ≠ {c, d} → + edgeArc a b ∩ edgeArc c d = + position '' (({a, b} : Set PeriodicSubtileIndex) ∩ {c, d}) + region_open : ∀ f, IsOpen (faceRegion f) + region_connected : ∀ f, IsConnected (faceRegion f) + region_disjoint : Pairwise fun f g => Disjoint (faceRegion f) (faceRegion g) + face_boundary : ∀ f, + frontier (faceRegion f) = + edgeArc (SixSubtileFaceVertices f 0) (SixSubtileFaceVertices f 1) ∪ + edgeArc (SixSubtileFaceVertices f 1) (SixSubtileFaceVertices f 2) ∪ + edgeArc (SixSubtileFaceVertices f 2) (SixSubtileFaceVertices f 0) + plane_cover : Set.range position ∪ + {p | ∃ a b, AllowedSubtileIncidence a b ∧ p ∈ edgeArc a b} ∪ + {p | ∃ f, p ∈ faceRegion f} = Set.univ + /-- The integral coefficients of a period in the chosen two-vector basis. -/ + coordinates : L → Int × Int + coordinates_spec : ∀ w, + (coordinates w).1 * u + (coordinates w).2 * v = (w : GaussianInt) + /-- Translate an occurrence index by a period lattice element. -/ + shift : L → PeriodicSubtileIndex → PeriodicSubtileIndex + /-- Translate the entire face index by a period lattice element. -/ + faceShift : L → PeriodicSubtileFaceIndex → PeriodicSubtileFaceIndex + shift_eq : ∀ w a, shift w a = + ⟨a.label, a.first + (coordinates w).1, a.second + (coordinates w).2⟩ + faceShift_eq : ∀ w f, faceShift w f = + ⟨f.label, f.first + (coordinates w).1, f.second + (coordinates w).2⟩ + shift_zero : ∀ a, shift 0 a = a + shift_add : ∀ w z a, shift (w + z) a = shift w (shift z a) + faceShift_zero : ∀ f, faceShift 0 f = f + faceShift_add : ∀ w z f, faceShift (w + z) f = faceShift w (faceShift z f) + edge_periodic : ∀ w a b, + AllowedSubtileIncidence (shift w a) (shift w b) ↔ AllowedSubtileIncidence a b + face_vertices_periodic : ∀ w f i, + SixSubtileFaceVertices (faceShift w f) i = shift w (SixSubtileFaceVertices f i) + position_periodic : ∀ w a, + position (shift w a) = position a + GaussianRealPoint w + edgeArc_periodic : ∀ w a b, + edgeArc (shift w a) (shift w b) = + (fun p => p + GaussianRealPoint w) '' edgeArc a b + faceRegion_periodic : ∀ w f, + faceRegion (faceShift w f) = + (fun p => p + GaussianRealPoint w) '' faceRegion f + /-- The six zero-coordinate occurrence representatives. -/ + vertexReps : Finset PeriodicSubtileIndex + /-- The selected finite family of ordered allowed-edge representatives. -/ + edgeReps : Finset (PeriodicSubtileIndex × PeriodicSubtileIndex) + /-- The twelve zero-coordinate face representatives. -/ + faceReps : Finset PeriodicSubtileFaceIndex + vertex_reps : ∀ a, a ∈ vertexReps ↔ a.first = 0 ∧ a.second = 0 + edge_reps_allowed : ∀ r ∈ edgeReps, AllowedSubtileIncidence r.1 r.2 + face_reps : ∀ f, f ∈ faceReps ↔ + f.first = 0 ∧ f.second = 0 + vertex_orbits : ∀ a, ∃! r, + r ∈ vertexReps ∧ ∃ w, a = shift w r + edge_orbits : ∀ a b, AllowedSubtileIncidence a b → + ∃ r ∈ edgeReps, ∃ w, a = shift w r.1 ∧ b = shift w r.2 + face_orbits : ∀ f, ∃ r ∈ faceReps, ∃ w, f = faceShift w r + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2DrawingExists.lean b/LeanPool/ApollonianSuperharmonic/P4677T2DrawingExists.lean new file mode 100644 index 0000000000..e44cb62846 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4677T2DrawingExists.lean @@ -0,0 +1,155 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4677T2DrawingData +public import LeanPool.ApollonianSuperharmonic.P4715T1LatticeCoordinates +public import LeanPool.ApollonianSuperharmonic.P4715T1PlaneMap +public import LeanPool.ApollonianSuperharmonic.P4715T1CoefficientEdges +public import LeanPool.ApollonianSuperharmonic.P4715T1CoefficientFaces +public import LeanPool.ApollonianSuperharmonic.P4715T1CoefficientTranslation +public import LeanPool.ApollonianSuperharmonic.P4715T1OrbitRepresentatives + +-- [TABLET NODE: P4677T2DrawingExists] + +/-! +# P4677T2DrawingExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4677T2DrawingExists (u v : GaussianInt) + (L : AddSubgroup GaussianInt) (hu : u ∈ L) (hv : v ∈ L) + (hcoords : ∀ w : L, ∃! mn : Int × Int, + ((mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v) = + (w : GaussianInt)) : + Nonempty (P4677T2DrawingData u v L) := by +-- BODY + classical + obtain ⟨hinj, c, hc, hcsurj⟩ := P4715T1LatticeCoordinates u v L hu hv hcoords + obtain ⟨hdet, E, hE⟩ := P4715T1PlaneMap u v hinj + obtain ⟨hsymm, hinterval, hinter⟩ := P4715T1CoefficientEdges + obtain ⟨hopen, hconnected, hdisjoint, hboundary, hcover⟩ := P4715T1CoefficientFaces + obtain ⟨hvzero, hvadd, hfzero, hfadd, hadj, hvertices⟩ := P4715T1IndexAction + obtain ⟨vr, er, fr, hvr, her, hfr, hvo, heo, hfo⟩ := P4715T1OrbitRepresentatives + have Eint (k : Int × Int) : + E ((k.1 : Real), (k.2 : Real)) = + GaussianRealPoint ((k.1 : GaussianInt) * u + (k.2 : GaussianInt) * v) := by + rw [hE] + ext <;> simp [GaussianRealPoint] + have Ec (w : L) : E (((c w).1 : Real), ((c w).2 : Real)) = GaussianRealPoint w := by + rw [Eint, hc] + refine ⟨{ + position := fun a => E (P4715T1Position a) + edgeArc := fun a b => E '' P4715T1Arc a b + faceRegion := fun f => E '' P4715T1Region f + position_injective := E.injective.comp P4715T1PositionInjective + arc_symmetric := fun a b => congrArg (fun s => E '' s) (hsymm a b) + arc_homeomorph := ?_ + arc_intersections := ?_ + region_open := fun f => E.toHomeomorph.isOpen_image.mpr (hopen f) + region_connected := fun f => (hconnected f).image E E.continuous.continuousOn + region_disjoint := fun f g hfg => + Set.disjoint_image_of_injective E.injective (hdisjoint hfg) + face_boundary := ?_ + plane_cover := ?_ + coordinates := c + coordinates_spec := hc + shift := fun w => P4715T1VertexShift (c w) + faceShift := fun w => P4715T1FaceShift (c w) + shift_eq := fun _ _ => rfl + faceShift_eq := fun _ _ => rfl + shift_zero := ?_ + shift_add := ?_ + faceShift_zero := ?_ + faceShift_add := ?_ + edge_periodic := fun w => hadj (c w) + face_vertices_periodic := fun w => hvertices (c w) + position_periodic := ?_ + edgeArc_periodic := ?_ + faceRegion_periodic := ?_ + vertexReps := vr + edgeReps := er + faceReps := fr + vertex_reps := hvr + edge_reps_allowed := her + face_reps := hfr + vertex_orbits := ?_ + edge_orbits := ?_ + face_orbits := ?_ }⟩ + · intro a b hab + obtain ⟨h, h0, h1⟩ := hinterval a b hab + refine ⟨h.trans (E.toHomeomorph.image (P4715T1Arc a b)), ?_, ?_⟩ + · change E (h ⟨0, by norm_num⟩ : Real × Real) = E (P4715T1Position a) + rw [h0] + · change E (h ⟨1, by norm_num⟩ : Real × Real) = E (P4715T1Position b) + rw [h1] + · intro a b d e hab hde hne + rw [← Set.image_inter E.injective, hinter a b d e hab hde hne, Set.image_image] + · intro f + calc + frontier (E '' P4715T1Region f) = E '' frontier (P4715T1Region f) := + (E.toHomeomorph.image_frontier _).symm + _ = _ := by rw [hboundary f, Set.image_union, Set.image_union] + · apply Set.eq_univ_of_forall + intro p + obtain ⟨y, rfl⟩ := E.surjective p + have hy : y ∈ Set.range P4715T1Position ∪ + {p | ∃ a b, AllowedSubtileIncidence a b ∧ p ∈ P4715T1Arc a b} ∪ + {p | ∃ f, p ∈ P4715T1Region f} := by rw [hcover]; trivial + rcases hy with (⟨a, rfl⟩ | ⟨a, b, hab, hy⟩) | ⟨f, hy⟩ + · exact Or.inl (Or.inl ⟨a, rfl⟩) + · exact Or.inl (Or.inr ⟨a, b, hab, Set.mem_image_of_mem E hy⟩) + · exact Or.inr ⟨f, Set.mem_image_of_mem E hy⟩ + · intro a + simpa only [map_zero] using hvzero a + · intro w z a + simpa only [map_add] using hvadd (c w) (c z) a + · intro f + simpa only [map_zero] using hfzero f + · intro w z f + simpa only [map_add] using hfadd (c w) (c z) f + · intro w a + rw [(P4715T1CoefficientTranslation (c w)).1 a, map_add, Ec] + · intro w a b + rw [(P4715T1CoefficientTranslation (c w)).2.1 a b] + simp only [Set.image_image] + congr 1 + funext p + exact (map_add E p _).trans (congrArg (fun z => E p + z) (Ec w)) + · intro w f + rw [(P4715T1CoefficientTranslation (c w)).2.2 f] + simp only [Set.image_image] + congr 1 + funext p + exact (map_add E p _).trans (congrArg (fun z => E p + z) (Ec w)) + · intro a + obtain ⟨r, hr, huniq⟩ := hvo a + refine ⟨r, ⟨hr.1, ?_⟩, ?_⟩ + · obtain ⟨k, hk⟩ := hr.2 + obtain ⟨w, hw⟩ := hcsurj k + exact ⟨w, hw.symm ▸ hk⟩ + · intro s hs + apply huniq s + obtain ⟨w, hw⟩ := hs.2 + exact ⟨hs.1, c w, hw⟩ + · intro a b hab + obtain ⟨r, hr, k, ha, hb⟩ := heo a b hab + obtain ⟨w, hw⟩ := hcsurj k + exact ⟨r, hr, w, hw.symm ▸ ha, hw.symm ▸ hb⟩ + · intro f + obtain ⟨r, hr, k, hf⟩ := hfo f + obtain ⟨w, hw⟩ := hcsurj k + exact ⟨r, hr, w, hw.symm ▸ hf⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean b/LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean new file mode 100644 index 0000000000..506af00d4c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean @@ -0,0 +1,682 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4677T2DrawingData +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P4677T2FacePoints] + +/-! +# P4677T2FacePoints + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FacePointConstruction + +private theorem boundary_to_footprint (T : ProtoTile) (x : GaussianInt) + (hx : x ∈ BoundaryFootprintVertices T) : x ∈ FootprintVertices T := by + classical + have edge_to_footprint (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) : e ∈ FootprintEdges T := by + change ∃ z : GaussianInt, + (e = {z, z + 1} ∧ + ((z ∈ T.cells ∧ z - ⟨0, 1⟩ ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - ⟨0, 1⟩ ∈ T.cells))) ∨ + (e = {z, z + ⟨0, 1⟩} ∧ + ((z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ + (z ∉ T.cells ∧ z - 1 ∈ T.cells))) at he + change ∃ c ∈ T.cells, + e = {c, c + 1} ∨ e = {c, c + ⟨0, 1⟩} ∨ + e = {c + 1, c + 1 + ⟨0, 1⟩} ∨ + e = {c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩} + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [Zsqrtd.ext_iff] + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + by_cases hne : T.cells.Nonempty + · simp only [BoundaryFootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hx + rcases hx with ⟨e, he, hxe⟩ + have he' := edge_to_footprint e he + rcases he' with ⟨z, hz, he⟩ + rcases he with h | h | h | h + all_goals + rw [h] at hxe + simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + simp only [FootprintVertices, ite_eq_left hne] + · rcases hxe with hxe | hxe + · subst x; exact ⟨z, hz, Or.inl rfl⟩ + · subst x; exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · rcases hxe with hxe | hxe + · subst x; exact ⟨z, hz, Or.inl rfl⟩ + · subst x; exact ⟨z, hz, Or.inr (Or.inr (Or.inl rfl))⟩ + · rcases hxe with hxe | hxe + · subst x; exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · subst x; exact ⟨z, hz, Or.inr (Or.inr (Or.inr rfl))⟩ + · rcases hxe with hxe | hxe + · subst x; exact ⟨z, hz, Or.inr (Or.inr (Or.inl rfl))⟩ + · subst x; exact ⟨z, hz, Or.inr (Or.inr (Or.inr rfl))⟩ + · simp only [BoundaryFootprintVertices, ite_eq_right hne, Set.mem_singleton_iff] at hx + subst x + simp [FootprintVertices, hne] + +private theorem touching_point (A B C : ProtoTile) (h : TouchingTriple A B C) : + ∃ x : GaussianInt, x ∈ BoundaryFootprintVertices A ∧ + x ∈ BoundaryFootprintVertices B ∧ x ∈ BoundaryFootprintVertices C := by + classical + change TileTouching A B ∧ TileTouching B C ∧ TileTouching C A ∧ + (∃! x : GaussianInt, x ∈ BoundaryFootprintVertices A ∧ + x ∈ BoundaryFootprintVertices B ∧ x ∈ BoundaryFootprintVertices C) at h + exact h.2.2.2.exists + +private theorem fp3 (boundary_to_footprint : ∀ (T : ProtoTile), ∀ x ∈ BoundaryFootprintVertices + T, x ∈ FootprintVertices T) (A B C : ProtoTile) (x : GaussianInt) + (h : x ∈ BoundaryFootprintVertices A ∧ + x ∈ BoundaryFootprintVertices B ∧ x ∈ BoundaryFootprintVertices C) : + x ∈ FootprintVertices A ∧ x ∈ FootprintVertices B ∧ + x ∈ FootprintVertices C := by + classical + exact ⟨boundary_to_footprint A x h.1, + boundary_to_footprint B x h.2.1, + boundary_to_footprint C x h.2.2⟩ + +private theorem h1 (P : Fin 3 → Bool → ProtoTile) (Q : Fin 3 → Bool → ProtoTile) (S : Fin 3 → + Bool → ProtoTile) (p1 : GaussianInt) (hp1 : p1 ∈ BoundaryFootprintVertices (Q 1 true) ∧ + p1 ∈ BoundaryFootprintVertices (S 2 false) ∧ p1 ∈ BoundaryFootprintVertices (P 1 true)) (fp3 : + ∀ (A B C : ProtoTile) (x : GaussianInt), + x ∈ BoundaryFootprintVertices A ∧ x ∈ BoundaryFootprintVertices B ∧ x ∈ + BoundaryFootprintVertices C → + x ∈ FootprintVertices A ∧ x ∈ FootprintVertices B ∧ x ∈ FootprintVertices C) : p1 ∈ + FootprintVertices (Q 1 true) ∧ p1 ∈ FootprintVertices (S 2 false) ∧ p1 ∈ + FootprintVertices (P 1 true) := by + classical + exact fp3 (Q 1 true) (S 2 false) (P 1 true) p1 hp1 + +private theorem h2 (P : Fin 3 → Bool → ProtoTile) (Q : Fin 3 → Bool → ProtoTile) (S : Fin 3 → + Bool → ProtoTile) (p2 : GaussianInt) (hp2 : p2 ∈ BoundaryFootprintVertices (Q 2 true) ∧ + p2 ∈ BoundaryFootprintVertices (S 1 false) ∧ p2 ∈ BoundaryFootprintVertices (P 1 false)) (fp3 : + ∀ (A B C : ProtoTile) (x : GaussianInt), + x ∈ BoundaryFootprintVertices A ∧ x ∈ BoundaryFootprintVertices B ∧ x ∈ + BoundaryFootprintVertices C → + x ∈ FootprintVertices A ∧ x ∈ FootprintVertices B ∧ x ∈ FootprintVertices C) : p2 ∈ + FootprintVertices (Q 2 true) ∧ p2 ∈ FootprintVertices (S 1 false) ∧ p2 ∈ + FootprintVertices (P 1 false) := by + classical + exact fp3 (Q 2 true) (S 1 false) (P 1 false) p2 hp2 + +private theorem h3 (P : Fin 3 → Bool → ProtoTile) (Q : Fin 3 → Bool → ProtoTile) (p3 : + GaussianInt) (hp3 : p3 ∈ BoundaryFootprintVertices (Q 1 true) ∧ + p3 ∈ BoundaryFootprintVertices (P 1 true) ∧ p3 ∈ BoundaryFootprintVertices (P 2 false)) (fp3 : + ∀ (A B C : ProtoTile) (x : GaussianInt), + x ∈ BoundaryFootprintVertices A ∧ x ∈ BoundaryFootprintVertices B ∧ x ∈ + BoundaryFootprintVertices C → + x ∈ FootprintVertices A ∧ x ∈ FootprintVertices B ∧ x ∈ FootprintVertices C) : p3 ∈ + FootprintVertices (Q 1 true) ∧ p3 ∈ FootprintVertices (P 1 true) ∧ p3 ∈ FootprintVertices + (P 2 false) := by + classical + exact fp3 (Q 1 true) (P 1 true) (P 2 false) p3 hp3 + +private theorem h4 (P : Fin 3 → Bool → ProtoTile) (S : Fin 3 → Bool → ProtoTile) (p4 : + GaussianInt) (hp4 : p4 ∈ BoundaryFootprintVertices (S 1 false) ∧ + p4 ∈ BoundaryFootprintVertices (P 1 false) ∧ p4 ∈ BoundaryFootprintVertices (P 2 true)) (fp3 : + ∀ (A B C : ProtoTile) (x : GaussianInt), + x ∈ BoundaryFootprintVertices A ∧ x ∈ BoundaryFootprintVertices B ∧ x ∈ + BoundaryFootprintVertices C → + x ∈ FootprintVertices A ∧ x ∈ FootprintVertices B ∧ x ∈ FootprintVertices C) : p4 ∈ + FootprintVertices (S 1 false) ∧ p4 ∈ FootprintVertices (P 1 false) ∧ p4 ∈ + FootprintVertices (P 2 true) := by + classical + exact fp3 (S 1 false) (P 1 false) (P 2 true) p4 hp4 + +private theorem h1' (P : Fin 3 → Bool → ProtoTile) (Q : Fin 3 → Bool → ProtoTile) (S : Fin 3 → + Bool → ProtoTile) (hQfoot : ∀ (i : Fin 3) (s : Bool), FootprintVertices (Q i s) ⊆ + FootprintVertices (P 0 true)) (hSfoot : ∀ (i : Fin 3) (s : Bool), FootprintVertices (S i s) ⊆ + FootprintVertices (P 0 false)) (p1 : GaussianInt) (h1 : p1 ∈ FootprintVertices (Q 1 true) ∧ + p1 ∈ FootprintVertices (S 2 false) ∧ p1 ∈ FootprintVertices (P 1 true)) : p1 ∈ + FootprintVertices (P 0 true) ∧ + p1 ∈ FootprintVertices (P 0 false) ∧ p1 ∈ FootprintVertices (P 1 true) := by + classical + exact ⟨hQfoot 1 true h1.1, hSfoot 2 false h1.2.1, h1.2.2⟩ + +private theorem h2' (P : Fin 3 → Bool → ProtoTile) (Q : Fin 3 → Bool → ProtoTile) (S : Fin 3 → + Bool → ProtoTile) (hQfoot : ∀ (i : Fin 3) (s : Bool), FootprintVertices (Q i s) ⊆ + FootprintVertices (P 0 true)) (hSfoot : ∀ (i : Fin 3) (s : Bool), FootprintVertices (S i s) ⊆ + FootprintVertices (P 0 false)) (p2 : GaussianInt) (h2 : p2 ∈ FootprintVertices (Q 2 true) ∧ + p2 ∈ FootprintVertices (S 1 false) ∧ p2 ∈ FootprintVertices (P 1 false)) : p2 ∈ + FootprintVertices (P 0 true) ∧ + p2 ∈ FootprintVertices (P 0 false) ∧ p2 ∈ FootprintVertices (P 1 false) := by + classical + exact ⟨hQfoot 2 true h2.1, hSfoot 1 false h2.2.1, h2.2.2⟩ + +private theorem h3' (P : Fin 3 → Bool → ProtoTile) (Q : Fin 3 → Bool → ProtoTile) (hQfoot : ∀ (i + : Fin 3) (s : Bool), FootprintVertices (Q i s) ⊆ FootprintVertices (P 0 true)) (p3 : + GaussianInt) (h3 : p3 ∈ FootprintVertices (Q 1 true) ∧ p3 ∈ FootprintVertices (P 1 true) ∧ p3 + ∈ FootprintVertices (P 2 false)) : p3 ∈ FootprintVertices (P 0 true) ∧ + p3 ∈ FootprintVertices (P 1 true) ∧ p3 ∈ FootprintVertices (P 2 false) := by + classical + exact ⟨hQfoot 1 true h3.1, h3.2.1, h3.2.2⟩ + +private theorem h4' (P : Fin 3 → Bool → ProtoTile) (S : Fin 3 → Bool → ProtoTile) (hSfoot : ∀ (i + : Fin 3) (s : Bool), FootprintVertices (S i s) ⊆ FootprintVertices (P 0 false)) (p4 : + GaussianInt) (h4 : p4 ∈ FootprintVertices (S 1 false) ∧ p4 ∈ FootprintVertices (P 1 false) ∧ + p4 ∈ FootprintVertices (P 2 true)) : p4 ∈ FootprintVertices (P 0 false) ∧ + p4 ∈ FootprintVertices (P 1 false) ∧ p4 ∈ FootprintVertices (P 2 true) := by + classical + exact ⟨hSfoot 1 false h4.1, h4.2.1, h4.2.2⟩ + +private theorem h5 (P : Fin 3 → Bool → ProtoTile) (v : GaussianInt) (p5 : GaussianInt) (hp5 : p5 + ∈ BoundaryFootprintVertices (P 0 true) ∧ + p5 ∈ BoundaryFootprintVertices (TileTranslation (P 0 false) v) ∧ + p5 ∈ BoundaryFootprintVertices (TileTranslation (P 2 true) v)) (fp3 : ∀ (A B C : ProtoTile) + (x : GaussianInt), + x ∈ BoundaryFootprintVertices A ∧ x ∈ BoundaryFootprintVertices B ∧ x ∈ + BoundaryFootprintVertices C → + x ∈ FootprintVertices A ∧ x ∈ FootprintVertices B ∧ x ∈ FootprintVertices C) : p5 ∈ + FootprintVertices (P 0 true) ∧ + p5 ∈ FootprintVertices (TileTranslation (P 0 false) v) ∧ p5 ∈ FootprintVertices + (TileTranslation (P 2 true) v) := by + classical + exact fp3 (P 0 true) (TileTranslation (P 0 false) v) + (TileTranslation (P 2 true) v) p5 hp5 + +private theorem h6 (P : Fin 3 → Bool → ProtoTile) (v : GaussianInt) (p6 : GaussianInt) (hp6 : p6 + ∈ BoundaryFootprintVertices (P 0 true) ∧ + p6 ∈ BoundaryFootprintVertices (TileTranslation (P 0 false) v) ∧ p6 ∈ BoundaryFootprintVertices + (P 2 false)) (fp3 : ∀ (A B C : ProtoTile) (x : GaussianInt), + x ∈ BoundaryFootprintVertices A ∧ x ∈ BoundaryFootprintVertices B ∧ x ∈ + BoundaryFootprintVertices C → + x ∈ FootprintVertices A ∧ x ∈ FootprintVertices B ∧ x ∈ FootprintVertices C) : p6 ∈ + FootprintVertices (P 0 true) ∧ + p6 ∈ FootprintVertices (TileTranslation (P 0 false) v) ∧ p6 ∈ FootprintVertices (P 2 false) := by + classical + exact fp3 (P 0 true) (TileTranslation (P 0 false) v) + (P 2 false) p6 hp6 + +private theorem h7 (P : Fin 3 → Bool → ProtoTile) (u : GaussianInt) (v : GaussianInt) (p7 : + GaussianInt) (hp7 : p7 ∈ BoundaryFootprintVertices (P 0 true) ∧ + p7 ∈ BoundaryFootprintVertices (TileTranslation (P 0 false) (u + v)) ∧ + p7 ∈ BoundaryFootprintVertices (TileTranslation (P 1 true) (u + v))) (fp3 : ∀ (A B C : + ProtoTile) (x : GaussianInt), + x ∈ BoundaryFootprintVertices A ∧ x ∈ BoundaryFootprintVertices B ∧ x ∈ + BoundaryFootprintVertices C → + x ∈ FootprintVertices A ∧ x ∈ FootprintVertices B ∧ x ∈ FootprintVertices C) : p7 ∈ + FootprintVertices (P 0 true) ∧ + p7 ∈ FootprintVertices (TileTranslation (P 0 false) (u + v)) ∧ + p7 ∈ FootprintVertices (TileTranslation (P 1 true) (u + v)) := by + classical + exact fp3 (P 0 true) (TileTranslation (P 0 false) (u + v)) + (TileTranslation (P 1 true) (u + v)) p7 hp7 + +private theorem h8 (P : Fin 3 → Bool → ProtoTile) (u : GaussianInt) (v : GaussianInt) (p8 : + GaussianInt) (hp8 : p8 ∈ BoundaryFootprintVertices (P 0 true) ∧ + p8 ∈ BoundaryFootprintVertices (TileTranslation (P 0 false) (u + v)) ∧ p8 ∈ + BoundaryFootprintVertices (P 1 false)) (fp3 : ∀ (A B C : ProtoTile) (x : GaussianInt), + x ∈ BoundaryFootprintVertices A ∧ x ∈ BoundaryFootprintVertices B ∧ x ∈ + BoundaryFootprintVertices C → + x ∈ FootprintVertices A ∧ x ∈ FootprintVertices B ∧ x ∈ FootprintVertices C) : p8 ∈ + FootprintVertices (P 0 true) ∧ + p8 ∈ FootprintVertices (TileTranslation (P 0 false) (u + v)) ∧ p8 ∈ FootprintVertices (P 1 + false) := by + classical + exact fp3 (P 0 true) (TileTranslation (P 0 false) (u + v)) + (P 1 false) p8 hp8 + +private theorem h9 (P : Fin 3 → Bool → ProtoTile) (u : GaussianInt) (v : GaussianInt) (p9 : + GaussianInt) (hp9 : p9 ∈ BoundaryFootprintVertices (P 0 true) ∧ + p9 ∈ BoundaryFootprintVertices (TileTranslation (P 1 true) (u + v)) ∧ + p9 ∈ BoundaryFootprintVertices (TileTranslation (P 2 true) v)) (fp3 : ∀ (A B C : ProtoTile) + (x : GaussianInt), + x ∈ BoundaryFootprintVertices A ∧ x ∈ BoundaryFootprintVertices B ∧ x ∈ + BoundaryFootprintVertices C → + x ∈ FootprintVertices A ∧ x ∈ FootprintVertices B ∧ x ∈ FootprintVertices C) : p9 ∈ + FootprintVertices (P 0 true) ∧ + p9 ∈ FootprintVertices (TileTranslation (P 1 true) (u + v)) ∧ p9 ∈ FootprintVertices + (TileTranslation (P 2 true) v) := by + classical + exact fp3 (P 0 true) (TileTranslation (P 1 true) (u + v)) + (TileTranslation (P 2 true) v) p9 hp9 + +private theorem h10 (P : Fin 3 → Bool → ProtoTile) (u : GaussianInt) (v : GaussianInt) (p10 : + GaussianInt) (hp10 : p10 ∈ BoundaryFootprintVertices (P 0 false) ∧ + p10 ∈ BoundaryFootprintVertices (TileTranslation (P 1 false) (-u - v)) ∧ + p10 ∈ BoundaryFootprintVertices (TileTranslation (P 2 false) (-v))) (fp3 : ∀ (A B C : + ProtoTile) (x : GaussianInt), + x ∈ BoundaryFootprintVertices A ∧ x ∈ BoundaryFootprintVertices B ∧ x ∈ + BoundaryFootprintVertices C → + x ∈ FootprintVertices A ∧ x ∈ FootprintVertices B ∧ x ∈ FootprintVertices C) : p10 ∈ + FootprintVertices (P 0 false) ∧ + p10 ∈ FootprintVertices (TileTranslation (P 1 false) (-u - v)) ∧ + p10 ∈ FootprintVertices (TileTranslation (P 2 false) (-v)) := by + classical + exact fp3 (P 0 false) (TileTranslation (P 1 false) (-u-v)) + (TileTranslation (P 2 false) (-v)) p10 hp10 + +private theorem h11 (P : Fin 3 → Bool → ProtoTile) (u : GaussianInt) (p11 : GaussianInt) (hp11 : + p11 ∈ BoundaryFootprintVertices (P 1 true) ∧ + p11 ∈ BoundaryFootprintVertices (TileTranslation (P 1 false) (-u)) ∧ + p11 ∈ BoundaryFootprintVertices (TileTranslation (P 2 true) (-u))) (fp3 : ∀ (A B C : + ProtoTile) (x : GaussianInt), + x ∈ BoundaryFootprintVertices A ∧ x ∈ BoundaryFootprintVertices B ∧ x ∈ + BoundaryFootprintVertices C → + x ∈ FootprintVertices A ∧ x ∈ FootprintVertices B ∧ x ∈ FootprintVertices C) : p11 ∈ + FootprintVertices (P 1 true) ∧ + p11 ∈ FootprintVertices (TileTranslation (P 1 false) (-u)) ∧ p11 ∈ FootprintVertices + (TileTranslation (P 2 true) (-u)) := by + classical + exact fp3 (P 1 true) (TileTranslation (P 1 false) (-u)) + (TileTranslation (P 2 true) (-u)) p11 hp11 + +private theorem h12 (P : Fin 3 → Bool → ProtoTile) (u : GaussianInt) (p12 : GaussianInt) (hp12 : + p12 ∈ BoundaryFootprintVertices (P 1 true) ∧ + p12 ∈ BoundaryFootprintVertices (TileTranslation (P 1 false) (-u)) ∧ p12 ∈ + BoundaryFootprintVertices (P 2 false)) (fp3 : ∀ (A B C : ProtoTile) (x : GaussianInt), + x ∈ BoundaryFootprintVertices A ∧ x ∈ BoundaryFootprintVertices B ∧ x ∈ + BoundaryFootprintVertices C → + x ∈ FootprintVertices A ∧ x ∈ FootprintVertices B ∧ x ∈ FootprintVertices C) : p12 ∈ + FootprintVertices (P 1 true) ∧ + p12 ∈ FootprintVertices (TileTranslation (P 1 false) (-u)) ∧ p12 ∈ FootprintVertices (P 2 + false) := by + classical + exact fp3 (P 1 true) (TileTranslation (P 1 false) (-u)) + (P 2 false) p12 hp12 + +private noncomputable abbrev point (p1 : GaussianInt) (p2 : GaussianInt) (p3 : GaussianInt) (p4 : + GaussianInt) (p5 : GaussianInt) (p6 : GaussianInt) (p7 : GaussianInt) (p8 : GaussianInt) (p9 + : GaussianInt) (p10 : GaussianInt) (p11 : GaussianInt) (p12 : GaussianInt) : + SixSubtileFaceLabel → GaussianInt := by + classical + exact fun + | .I1 => p1 | .I2 => p2 | .I3 => p3 | .I4 => p4 + | .J1 => p5 | .J2 => p6 | .J3 => p7 | .J4 => p8 + | .J5 => p9 | .J6 => p10 | .J7 => p11 | .J8 => p12 + +private theorem translate_zero (T : ProtoTile) : TileTranslation T 0 = T := by + classical + cases T with + | mk cells anchor => + simp only [TileTranslation] + rw [ProtoTile.mk.injEq] + constructor + · ext z + simp [GaussianTranslation] + · simp [GaussianTranslation] + +private theorem zero_membership (P : Fin 3 → Bool → ProtoTile) (u : GaussianInt) (v : + GaussianInt) (p1 : GaussianInt) (p2 : GaussianInt) (p3 : GaussianInt) (p4 : GaussianInt) (p5 + : GaussianInt) (p6 : GaussianInt) (p7 : GaussianInt) (p8 : GaussianInt) (p9 : GaussianInt) + (p10 : GaussianInt) (p11 : GaussianInt) (p12 : GaussianInt) (h1' : p1 ∈ FootprintVertices (P + 0 true) ∧ p1 ∈ FootprintVertices (P 0 false) ∧ p1 ∈ FootprintVertices (P 1 true)) (h2' : p2 ∈ + FootprintVertices (P 0 true) ∧ p2 ∈ FootprintVertices (P 0 false) ∧ p2 ∈ FootprintVertices (P + 1 false)) (h3' : p3 ∈ FootprintVertices (P 0 true) ∧ p3 ∈ FootprintVertices (P 1 true) ∧ p3 ∈ + FootprintVertices (P 2 false)) (h4' : p4 ∈ FootprintVertices (P 0 false) ∧ p4 ∈ + FootprintVertices (P 1 false) ∧ p4 ∈ FootprintVertices (P 2 true)) (h5 : p5 ∈ + FootprintVertices (P 0 true) ∧ + p5 ∈ FootprintVertices (TileTranslation (P 0 false) v) ∧ p5 ∈ FootprintVertices + (TileTranslation (P 2 true) v)) (h6 : p6 ∈ FootprintVertices (P 0 true) ∧ + p6 ∈ FootprintVertices (TileTranslation (P 0 false) v) ∧ p6 ∈ FootprintVertices (P 2 false)) + (h7 : p7 ∈ FootprintVertices (P 0 true) ∧ + p7 ∈ FootprintVertices (TileTranslation (P 0 false) (u + v)) ∧ + p7 ∈ FootprintVertices (TileTranslation (P 1 true) (u + v))) (h8 : p8 ∈ FootprintVertices (P + 0 true) ∧ + p8 ∈ FootprintVertices (TileTranslation (P 0 false) (u + v)) ∧ p8 ∈ FootprintVertices (P 1 + false)) (h9 : p9 ∈ FootprintVertices (P 0 true) ∧ + p9 ∈ FootprintVertices (TileTranslation (P 1 true) (u + v)) ∧ p9 ∈ FootprintVertices + (TileTranslation (P 2 true) v)) (h10 : p10 ∈ FootprintVertices (P 0 false) ∧ + p10 ∈ FootprintVertices (TileTranslation (P 1 false) (-u - v)) ∧ + p10 ∈ FootprintVertices (TileTranslation (P 2 false) (-v))) (h11 : p11 ∈ FootprintVertices (P + 1 true) ∧ + p11 ∈ FootprintVertices (TileTranslation (P 1 false) (-u)) ∧ p11 ∈ FootprintVertices + (TileTranslation (P 2 true) (-u))) (h12 : p12 ∈ FootprintVertices (P 1 true) ∧ + p12 ∈ FootprintVertices (TileTranslation (P 1 false) (-u)) ∧ p12 ∈ FootprintVertices (P 2 + false)) (translate_zero : ∀ (T : ProtoTile), TileTranslation T 0 = T) : ∀ l i, + (point p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12) l ∈ FootprintVertices + (SubtileOccurrenceInterpretation P u v + (SixSubtileFaceVertices ⟨l, 0, 0⟩ i)) := by + classical + let point : SixSubtileFaceLabel → GaussianInt := fun + | .I1 => p1 | .I2 => p2 | .I3 => p3 | .I4 => p4 + | .J1 => p5 | .J2 => p6 | .J3 => p7 | .J4 => p8 + | .J5 => p9 | .J6 => p10 | .J7 => p11 | .J8 => p12 + change (∀ l i, + point l ∈ FootprintVertices + (SubtileOccurrenceInterpretation P u v + (SixSubtileFaceVertices ⟨l, 0, 0⟩ i))) + intro l i + cases l + · fin_cases i + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h1'.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h1'.2.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h1'.2.2 + · fin_cases i + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h2'.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h2'.2.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h2'.2.2 + · fin_cases i + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h3'.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h3'.2.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h3'.2.2 + · fin_cases i + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h4'.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h4'.2.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h4'.2.2 + · fin_cases i + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h5.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h5.2.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h5.2.2 + · fin_cases i + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h6.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h6.2.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h6.2.2 + · fin_cases i + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h7.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h7.2.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h7.2.2 + · fin_cases i + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h8.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h8.2.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h8.2.2 + · fin_cases i + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h9.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h9.2.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h9.2.2 + · fin_cases i + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h10.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero, sub_eq_add_neg] using h10.2.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h10.2.2 + · fin_cases i + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h11.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h11.2.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h11.2.2 + · fin_cases i + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h12.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h12.2.1 + · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, + translate_zero] using h12.2.2 + +private theorem translate_comp (T : ProtoTile) (a b : GaussianInt) : + TileTranslation (TileTranslation T a) b = TileTranslation T (a + b) := by + classical + cases T with + | mk cells anchor => + simp only [TileTranslation] + rw [ProtoTile.mk.injEq] + constructor + · rw [Finset.image_image] + congr 1 + funext x + simp [GaussianTranslation, add_assoc] + · simp [GaussianTranslation, add_assoc] + +private theorem occurrence_shift (P : Fin 3 → Bool → ProtoTile) (u : GaussianInt) (v : + GaussianInt) (translate_comp : ∀ (T : ProtoTile) (a b : GaussianInt), TileTranslation + (TileTranslation T a) b = TileTranslation T (a + b)) (f : PeriodicSubtileFaceIndex) (i : Fin + 3) : + SubtileOccurrenceInterpretation P u v (SixSubtileFaceVertices f i) = + TileTranslation + (SubtileOccurrenceInterpretation P u v + (SixSubtileFaceVertices ⟨f.label, 0, 0⟩ i)) + ((f.first : GaussianInt) * u + (f.second : GaussianInt) * v) := by + classical + cases f with + | mk l m n => + cases l <;> fin_cases i <;> + simp? [SixSubtileFaceVertices, SubtileOccurrenceInterpretation] <;> + rw [translate_comp] <;> congr 1 <;> ring_nf + +private noncomputable abbrev rho (u : GaussianInt) (v : GaussianInt) (p1 : GaussianInt) (p2 : + GaussianInt) (p3 : GaussianInt) (p4 : GaussianInt) (p5 : GaussianInt) (p6 : GaussianInt) (p7 + : GaussianInt) (p8 : GaussianInt) (p9 : GaussianInt) (p10 : GaussianInt) (p11 : GaussianInt) + (p12 : GaussianInt) : PeriodicSubtileFaceIndex → GaussianInt := by + classical + let point : SixSubtileFaceLabel → GaussianInt := fun + | .I1 => p1 | .I2 => p2 | .I3 => p3 | .I4 => p4 + | .J1 => p5 | .J2 => p6 | .J3 => p7 | .J4 => p8 + | .J5 => p9 | .J6 => p10 | .J7 => p11 | .J8 => p12 + exact fun f => + GaussianTranslation + ((f.first : GaussianInt) * u + (f.second : GaussianInt) * v) + (point f.label) + +private theorem rho_mem (P : Fin 3 → Bool → ProtoTile) (u : GaussianInt) (v : GaussianInt) (p1 : + GaussianInt) (p2 : GaussianInt) (p3 : GaussianInt) (p4 : GaussianInt) (p5 : GaussianInt) (p6 + : GaussianInt) (p7 : GaussianInt) (p8 : GaussianInt) (p9 : GaussianInt) (p10 : GaussianInt) + (p11 : GaussianInt) (p12 : GaussianInt) (zero_membership : ∀ (l : SixSubtileFaceLabel) (i : + Fin 3), + (point p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12) l ∈ + FootprintVertices + (SubtileOccurrenceInterpretation P u v (SixSubtileFaceVertices ⟨l, 0, 0⟩ i))) + (occurrence_shift : ∀ (f : PeriodicSubtileFaceIndex) (i : Fin 3), + SubtileOccurrenceInterpretation P u v (SixSubtileFaceVertices f i) = + TileTranslation + (SubtileOccurrenceInterpretation P u v (SixSubtileFaceVertices ⟨f.label, 0, 0⟩ i)) + (↑f.first * u + ↑f.second * v)) : ∀ f i, + (rho u v p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12) f ∈ FootprintVertices + (SubtileOccurrenceInterpretation P u v (SixSubtileFaceVertices f i)) := by + classical + let point : SixSubtileFaceLabel → GaussianInt := fun + | .I1 => p1 | .I2 => p2 | .I3 => p3 | .I4 => p4 + | .J1 => p5 | .J2 => p6 | .J3 => p7 | .J4 => p8 + | .J5 => p9 | .J6 => p10 | .J7 => p11 | .J8 => p12 + let rho : PeriodicSubtileFaceIndex → GaussianInt := fun f => + GaussianTranslation + ((f.first : GaussianInt) * u + (f.second : GaussianInt) * v) + (point f.label) + change (∀ (l : SixSubtileFaceLabel) (i : Fin 3), + point l ∈ + FootprintVertices + (SubtileOccurrenceInterpretation P u v (SixSubtileFaceVertices ⟨l, 0, 0⟩ i))) + at zero_membership + change (∀ f i, + rho f ∈ FootprintVertices + (SubtileOccurrenceInterpretation P u v (SixSubtileFaceVertices f i))) + intro f i + rw [occurrence_shift] + dsimp [rho] + rcases TileTranslationFormulas + (SubtileOccurrenceInterpretation P u v + (SixSubtileFaceVertices ⟨f.label, 0, 0⟩ i)) + ((f.first : GaussianInt) * u + (f.second : GaussianInt) * v) with + ⟨_, _, _, _, _, hfoot, _, _, _⟩ + rw [hfoot] + exact ⟨point f.label, zero_membership f.label i, rfl⟩ + +end FacePointConstruction + +theorem P4677T2FacePoints + (P Q S : Fin 3 → Bool → ProtoTile) (u v : GaussianInt) + (L : AddSubgroup GaussianInt) (D : P4677T2DrawingData u v L) + (hQfoot : forall i s, + FootprintVertices (Q i s) ⊆ FootprintVertices (P 0 true)) + (hSfoot : forall i s, + FootprintVertices (S i s) ⊆ FootprintVertices (P 0 false)) + (hinner : + TouchingTriple (Q 1 true) (S 2 false) (P 1 true) ∧ + TouchingTriple (Q 2 true) (S 1 false) (P 1 false) ∧ + TouchingTriple (Q 1 true) (P 1 true) (P 2 false) ∧ + TouchingTriple (S 1 false) (P 1 false) (P 2 true)) + (houter : + TouchingTriple (P 0 true) (TileTranslation (P 0 false) v) + (TileTranslation (P 2 true) v) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) v) + (P 2 false) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) (u + v)) + (TileTranslation (P 1 true) (u + v)) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) (u + v)) + (P 1 false) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 1 true) (u + v)) + (TileTranslation (P 2 true) v) ∧ + TouchingTriple (P 0 false) (TileTranslation (P 1 false) (-u - v)) + (TileTranslation (P 2 false) (-v)) ∧ + TouchingTriple (P 1 true) (TileTranslation (P 1 false) (-u)) + (TileTranslation (P 2 true) (-u)) ∧ + TouchingTriple (P 1 true) (TileTranslation (P 1 false) (-u)) + (P 2 false)) : + ∃ rho : PeriodicSubtileFaceIndex → GaussianInt, + (∀ f i, rho f ∈ FootprintVertices + (SubtileOccurrenceInterpretation P u v (SixSubtileFaceVertices f i))) ∧ + (∀ w f, rho (D.faceShift w f) = rho f + (w : GaussianInt)) ∧ + rho ⟨.I1, 0, 0⟩ ∈ FootprintVertices (Q 1 true) ∩ FootprintVertices (S 2 false) ∧ + rho ⟨.I2, 0, 0⟩ ∈ FootprintVertices (Q 2 true) ∩ FootprintVertices (S 1 false) ∧ + rho ⟨.I3, 0, 0⟩ ∈ FootprintVertices (Q 1 true) ∩ FootprintVertices (P 1 true) ∧ + rho ⟨.I4, 0, 0⟩ ∈ FootprintVertices (S 1 false) ∩ FootprintVertices (P 1 false) := by +-- BODY + classical + have boundary_to_footprint (T : ProtoTile) (x : GaussianInt) + (hx : x ∈ BoundaryFootprintVertices T) : x ∈ FootprintVertices T := + FacePointConstruction.boundary_to_footprint T x hx + have touching_point (A B C : ProtoTile) (h : TouchingTriple A B C) : + ∃ x : GaussianInt, x ∈ BoundaryFootprintVertices A ∧ + x ∈ BoundaryFootprintVertices B ∧ x ∈ BoundaryFootprintVertices C := + FacePointConstruction.touching_point A B C h + rcases hinner with ⟨hI1, hI2, hI3, hI4⟩ + rcases houter with ⟨hJ1, hJ2, hJ3, hJ4, hJ5, hJ6, hJ7, hJ8⟩ + obtain ⟨p1, hp1⟩ := touching_point _ _ _ hI1 + obtain ⟨p2, hp2⟩ := touching_point _ _ _ hI2 + obtain ⟨p3, hp3⟩ := touching_point _ _ _ hI3 + obtain ⟨p4, hp4⟩ := touching_point _ _ _ hI4 + obtain ⟨p5, hp5⟩ := touching_point _ _ _ hJ1 + obtain ⟨p6, hp6⟩ := touching_point _ _ _ hJ2 + obtain ⟨p7, hp7⟩ := touching_point _ _ _ hJ3 + obtain ⟨p8, hp8⟩ := touching_point _ _ _ hJ4 + obtain ⟨p9, hp9⟩ := touching_point _ _ _ hJ5 + obtain ⟨p10, hp10⟩ := touching_point _ _ _ hJ6 + obtain ⟨p11, hp11⟩ := touching_point _ _ _ hJ7 + obtain ⟨p12, hp12⟩ := touching_point _ _ _ hJ8 + have fp3 (A B C : ProtoTile) (x : GaussianInt) + (h : x ∈ BoundaryFootprintVertices A ∧ + x ∈ BoundaryFootprintVertices B ∧ x ∈ BoundaryFootprintVertices C) : + x ∈ FootprintVertices A ∧ x ∈ FootprintVertices B ∧ + x ∈ FootprintVertices C := FacePointConstruction.fp3 boundary_to_footprint A B C x h + have h1 := FacePointConstruction.h1 P Q S p1 hp1 fp3 + have h2 := FacePointConstruction.h2 P Q S p2 hp2 fp3 + have h3 := FacePointConstruction.h3 P Q p3 hp3 fp3 + have h4 := FacePointConstruction.h4 P S p4 hp4 fp3 + have h1' : p1 ∈ FootprintVertices (P 0 true) ∧ + p1 ∈ FootprintVertices (P 0 false) ∧ p1 ∈ FootprintVertices (P 1 true) := + FacePointConstruction.h1' P Q S hQfoot hSfoot p1 h1 + have h2' : p2 ∈ FootprintVertices (P 0 true) ∧ + p2 ∈ FootprintVertices (P 0 false) ∧ p2 ∈ FootprintVertices (P 1 false) := + FacePointConstruction.h2' P Q S hQfoot hSfoot p2 h2 + have h3' : p3 ∈ FootprintVertices (P 0 true) ∧ + p3 ∈ FootprintVertices (P 1 true) ∧ p3 ∈ FootprintVertices (P 2 false) := + FacePointConstruction.h3' P Q hQfoot p3 h3 + have h4' : p4 ∈ FootprintVertices (P 0 false) ∧ + p4 ∈ FootprintVertices (P 1 false) ∧ p4 ∈ FootprintVertices (P 2 true) := + FacePointConstruction.h4' P S hSfoot p4 h4 + have h5 := FacePointConstruction.h5 P v p5 hp5 fp3 + have h6 := FacePointConstruction.h6 P v p6 hp6 fp3 + have h7 := FacePointConstruction.h7 P u v p7 hp7 fp3 + have h8 := FacePointConstruction.h8 P u v p8 hp8 fp3 + have h9 := FacePointConstruction.h9 P u v p9 hp9 fp3 + have h10 := FacePointConstruction.h10 P u v p10 hp10 fp3 + have h11 := FacePointConstruction.h11 P u p11 hp11 fp3 + have h12 := FacePointConstruction.h12 P u p12 hp12 fp3 + let point : SixSubtileFaceLabel → GaussianInt + | .I1 => p1 | .I2 => p2 | .I3 => p3 | .I4 => p4 + | .J1 => p5 | .J2 => p6 | .J3 => p7 | .J4 => p8 + | .J5 => p9 | .J6 => p10 | .J7 => p11 | .J8 => p12 + have translate_zero (T : ProtoTile) : TileTranslation T 0 = T := + FacePointConstruction.translate_zero T + have zero_membership : ∀ l i, + point l ∈ FootprintVertices + (SubtileOccurrenceInterpretation P u v + (SixSubtileFaceVertices ⟨l, 0, 0⟩ i)) := FacePointConstruction.zero_membership P u v p1 + p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 h1' h2' h3' h4' h5 h6 h7 h8 h9 h10 h11 h12 + translate_zero + have translate_comp (T : ProtoTile) (a b : GaussianInt) : + TileTranslation (TileTranslation T a) b = TileTranslation T (a + b) := + FacePointConstruction.translate_comp T a b + have occurrence_shift (f : PeriodicSubtileFaceIndex) (i : Fin 3) : + SubtileOccurrenceInterpretation P u v (SixSubtileFaceVertices f i) = + TileTranslation + (SubtileOccurrenceInterpretation P u v + (SixSubtileFaceVertices ⟨f.label, 0, 0⟩ i)) + ((f.first : GaussianInt) * u + (f.second : GaussianInt) * v) := + FacePointConstruction.occurrence_shift P u v translate_comp f i + let rho : PeriodicSubtileFaceIndex → GaussianInt := fun f => + GaussianTranslation + ((f.first : GaussianInt) * u + (f.second : GaussianInt) * v) + (point f.label) + have rho_mem : ∀ f i, + rho f ∈ FootprintVertices + (SubtileOccurrenceInterpretation P u v (SixSubtileFaceVertices f i)) := + FacePointConstruction.rho_mem P u v p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 + zero_membership occurrence_shift + refine ⟨rho, rho_mem, ?_, ?_, ?_, ?_, ?_⟩ + · intro w f + rw [D.faceShift_eq] + change point f.label + + (((((f.first + (D.coordinates w).1 : Int) : GaussianInt) * u) + + (((f.second + (D.coordinates w).2 : Int) : GaussianInt) * v))) = + (point f.label + + ((f.first : GaussianInt) * u + (f.second : GaussianInt) * v)) + + (w : GaussianInt) + rw [Int.cast_add, Int.cast_add, ← D.coordinates_spec w] + ring_nf + · simpa [rho, point, GaussianTranslation] using + (show p1 ∈ FootprintVertices (Q 1 true) ∧ + p1 ∈ FootprintVertices (S 2 false) from ⟨h1.1, h1.2.1⟩) + · simpa [rho, point, GaussianTranslation] using + (show p2 ∈ FootprintVertices (Q 2 true) ∧ + p2 ∈ FootprintVertices (S 1 false) from ⟨h2.1, h2.2.1⟩) + · simpa [rho, point, GaussianTranslation] using + (show p3 ∈ FootprintVertices (Q 1 true) ∧ + p3 ∈ FootprintVertices (P 1 true) from ⟨h3.1, h3.2.1⟩) + · simpa [rho, point, GaussianTranslation] using + (show p4 ∈ FootprintVertices (S 1 false) ∧ + p4 ∈ FootprintVertices (P 1 false) from ⟨h4.1, h4.2.1⟩) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2IncidenceLedger.lean b/LeanPool/ApollonianSuperharmonic/P4677T2IncidenceLedger.lean new file mode 100644 index 0000000000..efb5ec8cde --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4677T2IncidenceLedger.lean @@ -0,0 +1,203 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import Mathlib.Tactic.FinCases +public import Mathlib.Data.Int.Interval + + +-- [TABLET NODE: P4677T2IncidenceLedger] + +/-! +# P4677T2IncidenceLedger + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4677T2IncidenceLedger : + (∀ a b, AllowedSubtileIncidence a b ↔ AllowedSubtileIncidence b a) ∧ + (∀ a, ¬ AllowedSubtileIncidence a a) ∧ + (∀ a, Set.Finite {b | AllowedSubtileIncidence a b}) ∧ + (∀ f, Function.Injective (SixSubtileFaceVertices f)) ∧ + (∀ f i j, i ≠ j → + AllowedSubtileIncidence (SixSubtileFaceVertices f i) + (SixSubtileFaceVertices f j)) ∧ + (∀ a b, AllowedSubtileIncidence a b → + ∃ f g : PeriodicSubtileFaceIndex, f ≠ g ∧ + ((∃ i, SixSubtileFaceVertices f i = a) ∧ + (∃ i, SixSubtileFaceVertices f i = b)) ∧ + ((∃ i, SixSubtileFaceVertices g i = a) ∧ + (∃ i, SixSubtileFaceVertices g i = b)) ∧ + ∀ h : PeriodicSubtileFaceIndex, + ((∃ i, SixSubtileFaceVertices h i = a) ∧ + (∃ i, SixSubtileFaceVertices h i = b)) → h = f ∨ h = g) := by +-- BODY + classical + let forward (a b : PeriodicSubtileIndex) : Prop := + match a.label, b.label with + | .A, .B => (b.first = a.first ∧ b.second = a.second) ∨ + (b.first = a.first ∧ b.second = a.second + 1) ∨ + (b.first = a.first + 1 ∧ b.second = a.second + 1) + | .A, .C => (b.first = a.first ∧ b.second = a.second) ∨ + (b.first = a.first + 1 ∧ b.second = a.second + 1) + | .A, .D => b.first = a.first ∧ b.second = a.second + | .A, .E => b.first = a.first ∧ b.second = a.second + 1 + | .A, .F => b.first = a.first ∧ b.second = a.second + | .B, .C => b.first = a.first ∧ b.second = a.second + | .B, .D => (b.first = a.first ∧ b.second = a.second) ∨ + (b.first = a.first - 1 ∧ b.second = a.second - 1) + | .B, .E => b.first = a.first ∧ b.second = a.second + | .B, .F => b.first = a.first ∧ b.second = a.second - 1 + | .C, .D => b.first = a.first - 1 ∧ b.second = a.second + | .C, .E => b.first = a.first - 1 ∧ b.second = a.second + | .C, .F => b.first = a.first ∧ b.second = a.second + | .D, .E => b.first = a.first ∧ b.second = a.second + | .D, .F => b.first = a.first + 1 ∧ b.second = a.second + | _, _ => False + have normal {a b} (h : AllowedSubtileIncidence a b) : + forward a b ∨ forward b a := by + induction h with + | symm _ ih => exact ih.symm + | _ => simp [forward] + have positive (a b : PeriodicSubtileIndex) (h : forward a b) : + AllowedSubtileIncidence a b := by + rcases a with ⟨al, m, n⟩ + rcases b with ⟨bl, p, q⟩ + cases al <;> cases bl <;> simp only [forward] at h + all_goals repeat' (rcases h with h | h) + all_goals first + | (convert AllowedSubtileIncidence.AB m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] + <;> omega) + | (convert AllowedSubtileIncidence.AB01 m n using 1 <;> simp + [PeriodicSubtileIndex.mk.injEq] <;> omega) + | (convert AllowedSubtileIncidence.AB11 m n using 1 <;> simp + [PeriodicSubtileIndex.mk.injEq] <;> omega) + | (convert AllowedSubtileIncidence.AC m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] + <;> omega) + | (convert AllowedSubtileIncidence.AC11 m n using 1 <;> simp + [PeriodicSubtileIndex.mk.injEq] <;> omega) + | (convert AllowedSubtileIncidence.AD m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] + <;> omega) + | (convert AllowedSubtileIncidence.AE01 m n using 1 <;> simp + [PeriodicSubtileIndex.mk.injEq] <;> omega) + | (convert AllowedSubtileIncidence.AF m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] + <;> omega) + | (convert AllowedSubtileIncidence.BC m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] + <;> omega) + | (convert AllowedSubtileIncidence.BDm1m1 m n using 1 <;> simp + [PeriodicSubtileIndex.mk.injEq] <;> omega) + | (convert AllowedSubtileIncidence.BD m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] + <;> omega) + | (convert AllowedSubtileIncidence.BE m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] + <;> omega) + | (convert AllowedSubtileIncidence.BF0m1 m n using 1 <;> simp + [PeriodicSubtileIndex.mk.injEq] <;> omega) + | (convert AllowedSubtileIncidence.CDm10 m n using 1 <;> simp + [PeriodicSubtileIndex.mk.injEq] <;> omega) + | (convert AllowedSubtileIncidence.CEm10 m n using 1 <;> simp + [PeriodicSubtileIndex.mk.injEq] <;> omega) + | (convert AllowedSubtileIncidence.CF m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] + <;> omega) + | (convert AllowedSubtileIncidence.DE m n using 1; + simp [PeriodicSubtileIndex.mk.injEq]; omega) + | (convert AllowedSubtileIncidence.DF10 m n using 1; simp + [PeriodicSubtileIndex.mk.injEq]; omega) + have normal_iff (a b) : AllowedSubtileIncidence a b ↔ forward a b ∨ forward b a := + ⟨normal, fun h => h.elim (positive a b) (fun h => .symm (positive b a h))⟩ + refine ⟨fun a b => ⟨AllowedSubtileIncidence.symm, AllowedSubtileIncidence.symm⟩, + ?_, ?_, ?_, ?_, ?_⟩ + · intro a h + have hn := normal h + rcases a with ⟨l, m, n⟩ + cases l <;> simp [forward] at hn + · intro a + let labels : Finset SixSubtileLabel := {.A, .B, .C, .D, .E, .F} + let box := ((labels.product (Finset.Icc (a.first - 1) (a.first + 1))).product + (Finset.Icc (a.second - 1) (a.second + 1))).image + (fun p => (⟨p.1.1, p.1.2, p.2⟩ : PeriodicSubtileIndex)) + apply box.finite_toSet.subset + intro b hb + have hn := normal hb + have bounds : a.first - 1 ≤ b.first ∧ b.first ≤ a.first + 1 ∧ + a.second - 1 ≤ b.second ∧ b.second ≤ a.second + 1 := by + rcases a with ⟨al, m, n⟩ + rcases b with ⟨bl, p, q⟩ + cases al <;> cases bl <;> simp [forward] at hn ⊢ <;> omega + apply Finset.mem_image.mpr + refine ⟨((b.label, b.first), b.second), ?_, ?_⟩ + · apply Finset.mem_product.mpr + refine ⟨Finset.mem_product.mpr ⟨?_, Finset.mem_Icc.mpr ⟨bounds.1, bounds.2.1⟩⟩, + Finset.mem_Icc.mpr bounds.2.2⟩ + cases b.label <;> simp [labels] + · cases b; rfl + · intro f i j hij + rcases f with ⟨l, m, n⟩ + cases l <;> fin_cases i <;> fin_cases j <;> + simp [SixSubtileFaceVertices, PeriodicSubtileIndex.mk.injEq] at hij ⊢ + · intro f i j hij + rcases f with ⟨l, m, n⟩ + cases l <;> fin_cases i <;> fin_cases j <;> try contradiction + all_goals rw [normal_iff] + all_goals simp [SixSubtileFaceVertices, forward] + · intro a b hab + have occurs (f : PeriodicSubtileFaceIndex) (a : PeriodicSubtileIndex) : + (∃ i, SixSubtileFaceVertices f i = a) ↔ + SixSubtileFaceVertices f 0 = a ∨ + SixSubtileFaceVertices f 1 = a ∨ SixSubtileFaceVertices f 2 = a := by + constructor + · rintro ⟨i, hi⟩ + fin_cases i + · exact Or.inl hi + · exact Or.inr (Or.inl hi) + · exact Or.inr (Or.inr hi) + · rintro (h | h | h) + · exact ⟨0, h⟩ + · exact ⟨1, h⟩ + · exact ⟨2, h⟩ + induction hab + case symm a b hab ih => + obtain ⟨f, g, hfg, hf, hg, hu⟩ := ih + exact ⟨f, g, hfg, ⟨hf.2, hf.1⟩, ⟨hg.2, hg.1⟩, + fun h hh => hu h ⟨hh.2, hh.1⟩⟩ + case' AB m n => refine ⟨⟨.I1, m, n⟩, ⟨.I2, m, n⟩, ?_, ?_, ?_, ?_⟩ + case' AB01 m n => refine ⟨⟨.J1, m, n⟩, ⟨.J2, m, n⟩, ?_, ?_, ?_, ?_⟩ + case' AB11 m n => refine ⟨⟨.J3, m, n⟩, ⟨.J4, m, n⟩, ?_, ?_, ?_, ?_⟩ + case' AC m n => refine ⟨⟨.I1, m, n⟩, ⟨.I3, m, n⟩, ?_, ?_, ?_, ?_⟩ + case' AC11 m n => refine ⟨⟨.J3, m, n⟩, ⟨.J5, m, n⟩, ?_, ?_, ?_, ?_⟩ + case' AD m n => refine ⟨⟨.I2, m, n⟩, ⟨.J4, m, n⟩, ?_, ?_, ?_, ?_⟩ + case' AE01 m n => refine ⟨⟨.J1, m, n⟩, ⟨.J5, m, n⟩, ?_, ?_, ?_, ?_⟩ + case' AF m n => refine ⟨⟨.I3, m, n⟩, ⟨.J2, m, n⟩, ?_, ?_, ?_, ?_⟩ + case' BC m n => refine ⟨⟨.I1, m, n⟩, ⟨.J3, m - 1, n - 1⟩, ?_, ?_, ?_, ?_⟩ + case' BDm1m1 m n => refine ⟨⟨.J4, m - 1, n - 1⟩, ⟨.J6, m, n⟩, ?_, ?_, ?_, ?_⟩ + case' BD m n => refine ⟨⟨.I2, m, n⟩, ⟨.I4, m, n⟩, ?_, ?_, ?_, ?_⟩ + case' BE m n => refine ⟨⟨.I4, m, n⟩, ⟨.J1, m, n - 1⟩, ?_, ?_, ?_, ?_⟩ + case' BF0m1 m n => refine ⟨⟨.J2, m, n - 1⟩, ⟨.J6, m, n⟩, ?_, ?_, ?_, ?_⟩ + case' CDm10 m n => refine ⟨⟨.J7, m, n⟩, ⟨.J8, m, n⟩, ?_, ?_, ?_, ?_⟩ + case' CEm10 m n => refine ⟨⟨.J5, m - 1, n - 1⟩, ⟨.J7, m, n⟩, ?_, ?_, ?_, ?_⟩ + case' CF m n => refine ⟨⟨.I3, m, n⟩, ⟨.J8, m, n⟩, ?_, ?_, ?_, ?_⟩ + case' DE m n => refine ⟨⟨.I4, m, n⟩, ⟨.J7, m + 1, n⟩, ?_, ?_, ?_, ?_⟩ + case' DF10 m n => refine ⟨⟨.J6, m + 1, n + 1⟩, ⟨.J8, m + 1, n⟩, ?_, ?_, ?_, ?_⟩ + all_goals first + | (solve | (try simp only [occurs]); simp [SixSubtileFaceVertices, + PeriodicSubtileIndex.mk.injEq, PeriodicSubtileFaceIndex.mk.injEq]) + | (intro h hh + simp only [occurs] at hh + rcases h with ⟨hl, p, q⟩ + cases hl <;> + simp [SixSubtileFaceVertices, + PeriodicSubtileIndex.mk.injEq, PeriodicSubtileFaceIndex.mk.injEq] at hh ⊢ <;> + omega) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2PeriodicWalkAssembly.lean b/LeanPool/ApollonianSuperharmonic/P4677T2PeriodicWalkAssembly.lean new file mode 100644 index 0000000000..f0c0ff4dcb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4677T2PeriodicWalkAssembly.lean @@ -0,0 +1,148 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4733T1RepresentativeWalks +public import LeanPool.ApollonianSuperharmonic.P4733T1FacePairNormalForm +public import LeanPool.ApollonianSuperharmonic.P4733T1WalkExtension +public import LeanPool.ApollonianSuperharmonic.P4733T1WalkTransport +public import LeanPool.ApollonianSuperharmonic.P4733T1OccurrenceTranslation + +-- [TABLET NODE: P4677T2PeriodicWalkAssembly] + +/-! +# P4677T2PeriodicWalkAssembly + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4677T2PeriodicWalkAssembly + (P Q S : Fin 3 → Bool → ProtoTile) (u v : GaussianInt) + (L : AddSubgroup GaussianInt) (D : P4677T2DrawingData u v L) + (hQcells : forall i s, (Q i s).cells ⊆ (P 0 true).cells) + (hScells : forall i s, (S i s).cells ⊆ (P 0 false).cells) + (hQfoot : forall i s, + FootprintVertices (Q i s) ⊆ FootprintVertices (P 0 true)) + (hSfoot : forall i s, + FootprintVertices (S i s) ⊆ FootprintVertices (P 0 false)) + (hinner : + TouchingTriple (Q 1 true) (S 2 false) (P 1 true) ∧ + TouchingTriple (Q 2 true) (S 1 false) (P 1 false) ∧ + TouchingTriple (Q 1 true) (P 1 true) (P 2 false) ∧ + TouchingTriple (S 1 false) (P 1 false) (P 2 true)) + (houter : + TouchingTriple (P 0 true) (TileTranslation (P 0 false) v) + (TileTranslation (P 2 true) v) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) v) + (P 2 false) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) (u + v)) + (TileTranslation (P 1 true) (u + v)) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) (u + v)) + (P 1 false) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 1 true) (u + v)) + (TileTranslation (P 2 true) v) ∧ + TouchingTriple (P 0 false) (TileTranslation (P 1 false) (-u - v)) + (TileTranslation (P 2 false) (-v)) ∧ + TouchingTriple (P 1 true) (TileTranslation (P 1 false) (-u)) + (TileTranslation (P 2 true) (-u)) ∧ + TouchingTriple (P 1 true) (TileTranslation (P 1 false) (-u)) + (P 2 false)) + (rho : PeriodicSubtileFaceIndex → GaussianInt) + (hcommon : ∀ f i, rho f ∈ FootprintVertices + (SubtileOccurrenceInterpretation P u v (SixSubtileFaceVertices f i))) + (hperiodic : ∀ w f, rho (D.faceShift w f) = rho f + (w : GaussianInt)) + (hI1 : rho ⟨.I1, 0, 0⟩ ∈ FootprintVertices (Q 1 true) ∩ FootprintVertices (S 2 false)) + (hI2 : rho ⟨.I2, 0, 0⟩ ∈ FootprintVertices (Q 2 true) ∩ FootprintVertices (S 1 false)) + (hI3 : rho ⟨.I3, 0, 0⟩ ∈ FootprintVertices (Q 1 true) ∩ FootprintVertices (P 1 true)) + (hI4 : rho ⟨.I4, 0, 0⟩ ∈ FootprintVertices (S 1 false) ∩ FootprintVertices (P 1 false)) + (htouch : ∀ (T U : ProtoTile) (x y : GaussianInt), + TileTouching T U → + x ∈ FootprintVertices T ∩ FootprintVertices U → + y ∈ FootprintVertices T ∩ FootprintVertices U → + ∃ p : List GaussianInt, + p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ FootprintVertices T ∩ FootprintVertices U) ∧ + ∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → + {a, b} ∈ FootprintEdges T ∩ FootprintEdges U) + (hAB : ∃ p : List GaussianInt, + p.head? = some (rho ⟨.I1, 0, 0⟩) ∧ + p.getLast? = some (rho ⟨.I2, 0, 0⟩) ∧ + (∀ z ∈ p, z ∈ FootprintVertices (P 0 true) ∩ FootprintVertices (P 0 false)) ∧ + ∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → + {a, b} ∈ FootprintEdges (P 0 true) ∩ FootprintEdges (P 0 false)) : + ∃ path : PeriodicSubtileFaceIndex → PeriodicSubtileFaceIndex → List GaussianInt, + (∀ f g, path g f = (path f g).reverse) ∧ + (∀ w f g, path (D.faceShift w f) (D.faceShift w g) = + (path f g).map (fun x => x + (w : GaussianInt))) ∧ + ∀ a b, AllowedSubtileIncidence a b → + ∀ f g, f ≠ g → + (∃ i, SixSubtileFaceVertices f i = a) → + (∃ i, SixSubtileFaceVertices f i = b) → + (∃ i, SixSubtileFaceVertices g i = a) → + (∃ i, SixSubtileFaceVertices g i = b) → + (path f g).head? = some (rho f) ∧ + (path f g).getLast? = some (rho g) ∧ + (∀ x ∈ path f g, x ∈ + FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintVertices (SubtileOccurrenceInterpretation P u v b)) ∧ + ∀ x y : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + path f g = l₁ ++ x :: y :: l₂ → + {x, y} ∈ FootprintEdges (SubtileOccurrenceInterpretation P u v a) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v b) := by +-- BODY + classical + obtain ⟨hnormal, hcover⟩ := P4733T1FacePairNormalForm D + have hrows := P4733T1RepresentativeWalks P Q S u v + (hQcells 1 true) (hScells 1 false) (hQfoot 1 true) (hSfoot 1 false) + hinner.2.2.1.1 hinner.2.2.2.1 houter rho hcommon hI1.1 hI2.2 hI3 hI4 htouch hAB + choose p hp using hrows + obtain ⟨path, hreverse, htranslate, honrow, _⟩ := + P4733T1WalkExtension D hnormal p + refine ⟨path, hreverse, htranslate, ?_⟩ + intro a b hab f g hfg hfa hfb hga hgb + obtain ⟨⟨r, w, s⟩, hfaces, hedge⟩ := + hcover a b hab f g hfg hfa hfb hga hgb + have hwalk := (P4733T1WalkTransport _ _ _ _ (p r) (hp r)).2 (w : GaussianInt) + rw [← P4733T1OccurrenceTranslation P D w (P4733T1EdgeRow r).1.1, + ← P4733T1OccurrenceTranslation P D w (P4733T1EdgeRow r).1.2, + ← hperiodic w (P4733T1EdgeRow r).2.1, + ← hperiodic w (P4733T1EdgeRow r).2.2] at hwalk + have hfinal : P4733T1ContainedWalk + (SubtileOccurrenceInterpretation P u v (D.shift w (P4733T1EdgeRow r).1.1)) + (SubtileOccurrenceInterpretation P u v (D.shift w (P4733T1EdgeRow r).1.2)) + (rho f) (rho g) (path f g) := by + cases s + · have hf : D.faceShift w (P4733T1EdgeRow r).2.2 = f := + congrArg Prod.fst hfaces + have hg : D.faceShift w (P4733T1EdgeRow r).2.1 = g := + congrArg Prod.snd hfaces + have hr := (P4733T1WalkTransport _ _ _ _ _ hwalk).1 + have hpath := honrow (r, w, false) + rw [hfaces] at hpath + rw [hpath] + simpa [hf, hg] using hr + · have hf : D.faceShift w (P4733T1EdgeRow r).2.1 = f := + congrArg Prod.fst hfaces + have hg : D.faceShift w (P4733T1EdgeRow r).2.2 = g := + congrArg Prod.snd hfaces + have hpath := honrow (r, w, true) + rw [hfaces] at hpath + rw [hpath] + simpa [hf, hg] using hwalk + rcases hedge with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact hfinal + · simpa only [P4733T1ContainedWalk, Set.inter_comm] using hfinal + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean new file mode 100644 index 0000000000..d8b4cf9884 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean @@ -0,0 +1,620 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4677T2TouchingWalk +public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.LatticeTileBoundarySimpleGridCycle +public import Mathlib.Data.List.Chain + +-- [TABLET NODE: P4677T2PrecursorWalk] + +/-! +# P4677T2PrecursorWalk + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PrecursorWalkGeometry + +private theorem boundary_edge_footprint : + (by + classical + exact + ∀ (T : ProtoTile), ∀ e ∈ BoundaryFootprintEdges T, e ∈ FootprintEdges T ) := by + classical + intro T e he + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [Zsqrtd.ext_iff] + · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + +private theorem edge_vertex : + (by + classical + exact + ∀ (T : ProtoTile), ∀ e ∈ FootprintEdges T, ∀ z ∈ e, z ∈ FootprintVertices T ) := by + classical + intro T e he z hz + rcases he with ⟨c, hc, rfl | rfl | rfl | rfl⟩ + all_goals + simp only [FootprintVertices, + ite_eq_left (show T.cells.Nonempty from ⟨c, hc⟩), Set.mem_ofPred_eq] + refine ⟨c, hc, ?_⟩ + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl <;> simp + +private theorem boundary_vertex_footprint : + (by + classical + exact + (∀ (T : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges T) → (e ∈ + FootprintEdges T)) → ((∀ (T : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ + FootprintEdges T) → (∀ (z : GaussianInt), (z ∈ e) → (z ∈ FootprintVertices T))) → (∀ + (T : ProtoTile), ∀ z ∈ BoundaryFootprintVertices T, z ∈ FootprintVertices T)) ) := by + classical + intro boundary_edge_footprint edge_vertex T z hz + by_cases hne : T.cells.Nonempty + · simp only [BoundaryFootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hz + obtain ⟨e, he, hze⟩ := hz + exact edge_vertex T e (boundary_edge_footprint T e he) z hze + · have hanchor : z = T.anchor := by + simpa [BoundaryFootprintVertices, hne] using hz + simp [FootprintVertices, hne, hanchor] + +private theorem R_symm : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), + let R : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ FootprintVertices A ∩ FootprintVertices B ∧ + v ∈ FootprintVertices A ∩ FootprintVertices B ∧ + {u, v} ∈ FootprintEdges A ∩ FootprintEdges B + ∀ (u : GaussianInt), ∀ (v : GaussianInt), R u v → R v u ) := by + classical + intro A B R u v huv + refine ⟨huv.2.1, huv.1, ?_⟩ + simpa [Finset.pair_comm] using huv.2.2 + +private theorem reverse_reach : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), + let R : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ FootprintVertices A ∩ FootprintVertices B ∧ + v ∈ FootprintVertices A ∩ FootprintVertices B ∧ + {u, v} ∈ FootprintEdges A ∩ FootprintEdges B + (∀ (u : GaussianInt), ∀ (v : GaussianInt), (R u v) → (R v u)) → (∀ {u : GaussianInt}, ∀ + {v : GaussianInt}, Relation.ReflTransGen R u v → Relation.ReflTransGen R v u) ) := by + classical + intro A B R R_symm u v h + induction h with + | refl => exact .refl + | @tail b c hab hbc ih => exact ih.head (R_symm b c hbc) + +private theorem head_reach : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), + let R : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ FootprintVertices A ∩ FootprintVertices B ∧ + v ∈ FootprintVertices A ∩ FootprintVertices B ∧ + {u, v} ∈ FootprintEdges A ∩ FootprintEdges B + ∀ (u : GaussianInt), ∀ (l : List GaussianInt), List.IsChain R (u :: l) → ∀ z ∈ u :: l, + Relation.ReflTransGen R u z ) := by + classical + intro A B R u l hc + induction l generalizing u with + | nil => + intro z hz + have heq : z = u := by simpa using hz + subst z + exact .refl + | cons v l ih => + intro z hz + rcases List.mem_cons.mp hz with rfl | hz + · exact .refl + · exact (Relation.ReflTransGen.single + (List.isChain_cons_cons.mp hc).1).trans + (ih v (List.isChain_cons_cons.mp hc).2 z hz) + +private theorem chain_reach : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), + let R : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ FootprintVertices A ∩ FootprintVertices B ∧ + v ∈ FootprintVertices A ∩ FootprintVertices B ∧ + {u, v} ∈ FootprintEdges A ∩ FootprintEdges B + (∀ (u : GaussianInt), ∀ (l : List GaussianInt), (List.IsChain R (u :: l)) → (∀ z ∈ u :: + l, Relation.ReflTransGen R u z)) → (∀ {p : List GaussianInt}, ∀ {u : GaussianInt}, ∀ + {v : GaussianInt}, List.IsChain R p → p.head? = some u → p.getLast? = some v → + Relation.ReflTransGen R u v) ) := by + classical + intro A B R head_reach p u v hc hh hl + cases p with + | nil => simp at hh + | cons c cs => + have hcu : c = u := by simpa using hh + subst c + have hvmem : v ∈ u :: cs := by + rcases List.getLast?_eq_some_iff.mp hl with ⟨l, hform⟩ + rw [hform] + simp + exact head_reach u cs hc v hvmem + +private theorem edge_parent : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (T : ProtoTile), T.cells ⊆ A.cells → FootprintVertices T ⊆ + FootprintVertices A → ∀ e ∈ FootprintEdges T, e ∈ FootprintEdges A ) := by + classical + intro A T hTc hTf e he + rcases he with ⟨c, hc, hshape⟩ + exact ⟨c, hTc hc, hshape⟩ + +private theorem edge_parentB : + (by + classical + exact + ∀ (B : ProtoTile), ∀ (T : ProtoTile), T.cells ⊆ B.cells → ∀ e ∈ FootprintEdges T, e ∈ + FootprintEdges B ) := by + classical + intro B T hTc e he + rcases he with ⟨c, hc, hshape⟩ + exact ⟨c, hTc hc, hshape⟩ + +private theorem p₁chain : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells ⊆ + A.cells) → ((Y.cells ⊆ B.cells) → ((FootprintVertices X ⊆ FootprintVertices A) → + ((FootprintVertices Y ⊆ FootprintVertices B) → (∀ (p₁ : List GaussianInt), (∀ z ∈ p₁, + z ∈ FootprintVertices X ∩ FootprintVertices Y) → ((∀ (a : GaussianInt), ∀ (b : + GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), p₁ = l₁ ++ a :: b + :: l₂ → {a, b} ∈ FootprintEdges X ∩ FootprintEdges Y) → ( + let R : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ FootprintVertices A ∩ FootprintVertices B ∧ + v ∈ FootprintVertices A ∩ FootprintVertices B ∧ + {u, v} ∈ FootprintEdges A ∩ FootprintEdges B + (∀ (T : ProtoTile), (T.cells ⊆ A.cells) → ((FootprintVertices T ⊆ FootprintVertices A) → + (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges T) → (e ∈ FootprintEdges A)))) → ((∀ + (T : ProtoTile), (T.cells ⊆ B.cells) → (∀ (e : Finset GaussianInt), (e ∈ + FootprintEdges T) → (e ∈ FootprintEdges B))) → (List.IsChain R p₁)))))))) ) := by + classical + intro A B X Y hXc hYc hXf hYf p₁ hp₁v hp₁e R edge_parent edge_parentB + apply List.isChain_iff_forall_rel_of_append_cons_cons.mpr + intro u v l r h + refine ⟨?_, ?_, ?_⟩ + · have hu := hp₁v u (by simp [h]) + exact ⟨hXf hu.1, hYf hu.2⟩ + · have hv := hp₁v v (by simp [h]) + exact ⟨hXf hv.1, hYf hv.2⟩ + · have he := hp₁e u v l r h + exact ⟨edge_parent X hXc hXf _ he.1, + edge_parentB Y hYc _ he.2⟩ + +private theorem p₃chain : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (Z : ProtoTile), ∀ (W : ProtoTile), (Z.cells ⊆ + A.cells) → ((W.cells ⊆ B.cells) → ((FootprintVertices Z ⊆ FootprintVertices A) → + ((FootprintVertices W ⊆ FootprintVertices B) → (∀ (p₃ : List GaussianInt), (∀ z ∈ p₃, + z ∈ FootprintVertices Z ∩ FootprintVertices W) → ((∀ (a : GaussianInt), ∀ (b : + GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), p₃ = l₁ ++ a :: b + :: l₂ → {a, b} ∈ FootprintEdges Z ∩ FootprintEdges W) → ( + let R : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ FootprintVertices A ∩ FootprintVertices B ∧ + v ∈ FootprintVertices A ∩ FootprintVertices B ∧ + {u, v} ∈ FootprintEdges A ∩ FootprintEdges B + (∀ (T : ProtoTile), (T.cells ⊆ A.cells) → ((FootprintVertices T ⊆ FootprintVertices A) → + (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges T) → (e ∈ FootprintEdges A)))) → ((∀ + (T : ProtoTile), (T.cells ⊆ B.cells) → (∀ (e : Finset GaussianInt), (e ∈ + FootprintEdges T) → (e ∈ FootprintEdges B))) → (List.IsChain R p₃)))))))) ) := by + classical + intro A B Z W hZc hWc hZf hWf p₃ hp₃v hp₃e R edge_parent edge_parentB + apply List.isChain_iff_forall_rel_of_append_cons_cons.mpr + intro u v l r h + refine ⟨?_, ?_, ?_⟩ + · have hu := hp₃v u (by simp [h]) + exact ⟨hZf hu.1, hWf hu.2⟩ + · have hv := hp₃v v (by simp [h]) + exact ⟨hZf hv.1, hWf hv.2⟩ + · have he := hp₃e u v l r h + exact ⟨edge_parent Z hZc hZf _ he.1, + edge_parentB W hWc _ he.2⟩ + +private theorem p₁mem : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (X : ProtoTile), ∀ (Y : ProtoTile), + (FootprintVertices X ⊆ FootprintVertices A) → ((FootprintVertices Y ⊆ + FootprintVertices B) → (∀ (p₁ : List GaussianInt), (∀ z ∈ p₁, z ∈ FootprintVertices X + ∩ FootprintVertices Y) → (∀ z ∈ p₁, z ∈ FootprintVertices A ∩ FootprintVertices B))) + ) := by + classical + intro A B X Y hXf hYf p₁ hp₁v z hz + have hzv := hp₁v z hz + exact ⟨hXf hzv.1, hYf hzv.2⟩ + +private theorem p₃mem : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (Z : ProtoTile), ∀ (W : ProtoTile), + (FootprintVertices Z ⊆ FootprintVertices A) → ((FootprintVertices W ⊆ + FootprintVertices B) → (∀ (p₃ : List GaussianInt), (∀ z ∈ p₃, z ∈ FootprintVertices Z + ∩ FootprintVertices W) → (∀ z ∈ p₃, z ∈ FootprintVertices A ∩ FootprintVertices B))) + ) := by + classical + intro A B Z W hZf hWf p₃ hp₃v z hz + have hzv := hp₃v z hz + exact ⟨hZf hzv.1, hWf hzv.2⟩ + +private theorem qmem : + (by + classical + exact + ∀ (O : ProtoTile), ∀ (q : List GaussianInt), (BoundaryFootprintVertices O = (↑q.toFinset + : Set GaussianInt)) → (∀ z ∈ q, z ∈ BoundaryFootprintVertices O) ) := by + classical + intro O q hqvertices z hz + rw [hqvertices] + simpa using hz + +private theorem aq : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (O : ProtoTile), ∀ (a : GaussianInt), (a ∈ + BoundaryFootprintVertices X ∧ a ∈ BoundaryFootprintVertices Y ∧ a ∈ + BoundaryFootprintVertices O) → (∀ (q : List GaussianInt), (BoundaryFootprintVertices + O = (↑q.toFinset : Set GaussianInt)) → (a ∈ q)) ) := by + classical + intro X Y O a ha q hqvertices + have : a ∈ (q.toFinset : Set GaussianInt) := by rw [← hqvertices]; exact ha.2.2 + simpa using this + +private theorem bq : + (by + classical + exact + ∀ (Z : ProtoTile), ∀ (W : ProtoTile), ∀ (O : ProtoTile), ∀ (b : GaussianInt), (b ∈ + BoundaryFootprintVertices Z ∧ b ∈ BoundaryFootprintVertices W ∧ b ∈ + BoundaryFootprintVertices O) → (∀ (q : List GaussianInt), (BoundaryFootprintVertices + O = (↑q.toFinset : Set GaussianInt)) → (b ∈ q)) ) := by + classical + intro Z W O b hb q hqvertices + have : b ∈ (q.toFinset : Set GaussianInt) := by rw [← hqvertices]; exact hb.2.2 + simpa using this + +private theorem S_symm : + (by + classical + exact + ∀ (O : ProtoTile), + let S : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ BoundaryFootprintVertices O ∧ v ∈ BoundaryFootprintVertices O ∧ + {u, v} ∈ BoundaryFootprintEdges O + ∀ (u : GaussianInt), ∀ (v : GaussianInt), S u v → S v u ) := by + classical + intro O S u v huv + refine ⟨huv.2.1, huv.1, ?_⟩ + simpa [Finset.pair_comm] using huv.2.2 + +private theorem qchain : + (by + classical + exact + ∀ (O : ProtoTile), ∀ (q : List GaussianInt), ∀ (q₀ : GaussianInt), ∀ (q₁ : GaussianInt), + (∀ (e : Finset GaussianInt), e ∈ BoundaryFootprintEdges O ↔ e = {q₁, q₀} ∨ ∃ (a : + GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), q = + l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((∀ (z : GaussianInt), (z ∈ q) → (z ∈ + BoundaryFootprintVertices O)) → ( + let S : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ BoundaryFootprintVertices O ∧ v ∈ BoundaryFootprintVertices O ∧ + {u, v} ∈ BoundaryFootprintEdges O + List.IsChain S q)) ) := by + classical + intro O q q₀ q₁ hqedges qmem S + apply List.isChain_iff_forall_rel_of_append_cons_cons.mpr + intro u v l r h + refine ⟨qmem u (by simp [h]), qmem v (by simp [h]), ?_⟩ + apply (hqedges {u, v}).2 + exact Or.inr ⟨u, v, l, r, h, rfl⟩ + +private theorem qhead_reach : + (by + classical + exact + ∀ (O : ProtoTile), + let S : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ BoundaryFootprintVertices O ∧ v ∈ BoundaryFootprintVertices O ∧ + {u, v} ∈ BoundaryFootprintEdges O + ∀ (u : GaussianInt), ∀ (l : List GaussianInt), List.IsChain S (u :: l) → ∀ z ∈ u :: l, + Relation.ReflTransGen S u z ) := by + classical + intro O S u l hc + induction l generalizing u with + | nil => + intro z hz + have heq : z = u := by simpa using hz + subst z + exact .refl + | cons v l ih => + intro z hz + rcases List.mem_cons.mp hz with rfl | hz + · exact .refl + · exact (Relation.ReflTransGen.single + (List.isChain_cons_cons.mp hc).1).trans + (ih v (List.isChain_cons_cons.mp hc).2 z hz) + +private theorem qreverse : + (by + classical + exact + ∀ (O : ProtoTile), + let S : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ BoundaryFootprintVertices O ∧ v ∈ BoundaryFootprintVertices O ∧ + {u, v} ∈ BoundaryFootprintEdges O + (∀ (u : GaussianInt), ∀ (v : GaussianInt), (S u v) → (S v u)) → (∀ {u : GaussianInt}, ∀ + {v : GaussianInt}, Relation.ReflTransGen S u v → Relation.ReflTransGen S v u) ) := by + classical + intro O S S_symm u v h + induction h with + | refl => exact .refl + | @tail c d hcd hstep ih => exact ih.head (S_symm c d hstep) + +private theorem qhead : + (by + classical + exact + ∀ (O : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (q : List GaussianInt), ∀ + (q₀ : GaussianInt), ∀ (q₁ : GaussianInt), (q.Nodup) → (((4 : ℕ) ≤ q.length) → + ((q.head? = some q₀) → ((q.getLast? = some q₁) → ((BoundaryFootprintVertices O = + (↑q.toFinset : Set GaussianInt)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ + : List GaussianInt), ∀ (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ → + FourNeighborAdjacent a b) → ((∀ (e : Finset GaussianInt), e ∈ BoundaryFootprintEdges + O ↔ e = {q₁, q₀} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ + : List GaussianInt), q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((∀ (z : GaussianInt), (z + ∈ q) → (z ∈ BoundaryFootprintVertices O)) → ((a ∈ q) → ((b ∈ q) → ( + let S : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ BoundaryFootprintVertices O ∧ v ∈ BoundaryFootprintVertices O ∧ + {u, v} ∈ BoundaryFootprintEdges O + (List.IsChain S q) → (∃ c l, q = c :: l))))))))))) ) := by + classical + intro O a b q q₀ q₁ hqnd hqlen hqhead hqlast hqvertices hqstep hqedges qmem aq bq S qchain + cases q with + | nil => simp at hqhead + | cons c l => exact ⟨c, l, rfl⟩ + +private theorem S_to_R : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (O : ProtoTile), ∀ (O' : ProtoTile), (O.cells ⊆ + A.cells) → ((O'.cells ⊆ B.cells) → ((FootprintVertices O ⊆ FootprintVertices A) → + ((FootprintVertices O' ⊆ FootprintVertices B) → ((O.cells = O'.cells) → ((∀ (T : + ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges T) → (e ∈ + FootprintEdges T)) → ((∀ (T : ProtoTile), ∀ (z : GaussianInt), (z ∈ + BoundaryFootprintVertices T) → (z ∈ FootprintVertices T)) → ( + let R : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ FootprintVertices A ∩ FootprintVertices B ∧ + v ∈ FootprintVertices A ∩ FootprintVertices B ∧ + {u, v} ∈ FootprintEdges A ∩ FootprintEdges B + (∀ (T : ProtoTile), (T.cells ⊆ A.cells) → ((FootprintVertices T ⊆ FootprintVertices A) → + (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges T) → (e ∈ FootprintEdges A)))) → ((∀ + (T : ProtoTile), (T.cells ⊆ B.cells) → (∀ (e : Finset GaussianInt), (e ∈ + FootprintEdges T) → (e ∈ FootprintEdges B))) → ((O'.cells.Nonempty) → ( + let S : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ BoundaryFootprintVertices O ∧ v ∈ BoundaryFootprintVertices O ∧ + {u, v} ∈ BoundaryFootprintEdges O + ∀ {u : GaussianInt}, ∀ {v : GaussianInt}, S u v → R u v)))))))))) ) := by + classical + intro A B O O' hOc hO'c hOf hO'f hcell boundary_edge_footprint boundary_vertex_footprint R + edge_parent edge_parentB hneO' S u v huv + refine ⟨?_, ?_, ?_⟩ + · exact ⟨hOf (boundary_vertex_footprint O u huv.1), + hO'f (boundary_vertex_footprint O' u (by + simpa [BoundaryFootprintVertices, hneO', + BoundaryFootprintEdges, hcell] using huv.1))⟩ + · exact ⟨hOf (boundary_vertex_footprint O v huv.2.1), + hO'f (boundary_vertex_footprint O' v (by + simpa [BoundaryFootprintVertices, hneO', + BoundaryFootprintEdges, hcell] using huv.2.1))⟩ + · have heO := boundary_edge_footprint O _ huv.2.2 + have heO' : {u, v} ∈ FootprintEdges O' := by + simpa [FootprintEdges, hcell] using heO + exact ⟨edge_parent O hOc hOf _ heO, + edge_parentB O' hO'c _ heO'⟩ + +private theorem qrouteR : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (O : ProtoTile), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), + let R : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ FootprintVertices A ∩ FootprintVertices B ∧ + v ∈ FootprintVertices A ∩ FootprintVertices B ∧ + {u, v} ∈ FootprintEdges A ∩ FootprintEdges B + let S : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ BoundaryFootprintVertices O ∧ v ∈ BoundaryFootprintVertices O ∧ + {u, v} ∈ BoundaryFootprintEdges O + (Relation.ReflTransGen S a b) → ((∀ {u : GaussianInt}, ∀ {v : GaussianInt}, (S u v) → (R + u v)) → (Relation.ReflTransGen R a b)) ) := by + classical + intro A B O a b R S qroute S_to_R + exact Relation.ReflTransGen.mono (fun _ _ hstep => S_to_R hstep) + a b qroute + +end PrecursorWalkGeometry + +theorem P4677T2PrecursorWalk : + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : + ProtoTile), ∀ (W : ProtoTile), ∀ (O : ProtoTile), ∀ (O' : ProtoTile), ∀ (x : + GaussianInt), ∀ (y : GaussianInt), (X.cells ⊆ A.cells) → ((Z.cells ⊆ A.cells) → ((Y.cells + ⊆ B.cells) → ((W.cells ⊆ B.cells) → ((O.cells ⊆ A.cells) → ((O'.cells ⊆ B.cells) → + ((FootprintVertices X ⊆ FootprintVertices A) → ((FootprintVertices Z ⊆ FootprintVertices + A) → ((FootprintVertices Y ⊆ FootprintVertices B) → ((FootprintVertices W ⊆ + FootprintVertices B) → ((FootprintVertices O ⊆ FootprintVertices A) → ((FootprintVertices + O' ⊆ FootprintVertices B) → ((O.cells = O'.cells) → ((O.cells = ∅ → O.anchor = O'.anchor) + → ((O.cells.Nonempty → LatticeTile O) → ((TouchingTriple X Y O) → ((TouchingTriple Z W O) + → ((x ∈ FootprintVertices X ∩ FootprintVertices Y) → ((y ∈ FootprintVertices Z ∩ + FootprintVertices W) → (∃ p : List GaussianInt, + p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ FootprintVertices A ∩ FootprintVertices B) ∧ + ∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → + {a, b} ∈ FootprintEdges A ∩ FootprintEdges B))))))))))))))))))) := by + intro A B X Y Z W O O' x y hXc hZc hYc hWc hOc hO'c hXf hZf hYf hWf hOf hO'f hcell hanchor + hdisk hfirst hlast hx hy +-- BODY + classical + have boundary_edge_footprint (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) : e ∈ FootprintEdges T := + PrecursorWalkGeometry.boundary_edge_footprint T e he + have edge_vertex (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges T) (z : GaussianInt) (hz : z ∈ e) : + z ∈ FootprintVertices T := PrecursorWalkGeometry.edge_vertex T e he z hz + have boundary_vertex_footprint (T : ProtoTile) (z : GaussianInt) + (hz : z ∈ BoundaryFootprintVertices T) : z ∈ FootprintVertices T := + PrecursorWalkGeometry.boundary_vertex_footprint boundary_edge_footprint edge_vertex T z hz + obtain ⟨a, ha, _⟩ := hfirst.2.2.2 + obtain ⟨b, hb, _⟩ := hlast.2.2.2 + have haX : a ∈ FootprintVertices X := boundary_vertex_footprint X a ha.1 + have haY : a ∈ FootprintVertices Y := boundary_vertex_footprint Y a ha.2.1 + have haO : a ∈ FootprintVertices O := boundary_vertex_footprint O a ha.2.2 + have hbZ : b ∈ FootprintVertices Z := boundary_vertex_footprint Z b hb.1 + have hbW : b ∈ FootprintVertices W := boundary_vertex_footprint W b hb.2.1 + have hbO : b ∈ FootprintVertices O := boundary_vertex_footprint O b hb.2.2 + obtain ⟨p₁, hp₁h, hp₁l, hp₁v, hp₁e⟩ := + P4677T2TouchingWalk X Y x a hfirst.1 ⟨hx.1, hx.2⟩ ⟨haX, haY⟩ + obtain ⟨p₃, hp₃h, hp₃l, hp₃v, hp₃e⟩ := + P4677T2TouchingWalk Z W b y hlast.1 ⟨hbZ, hbW⟩ ⟨hy.1, hy.2⟩ + have hOeq : O.cells = O'.cells := hcell + let R : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ FootprintVertices A ∩ FootprintVertices B ∧ + v ∈ FootprintVertices A ∩ FootprintVertices B ∧ + {u, v} ∈ FootprintEdges A ∩ FootprintEdges B + have R_symm (u v : GaussianInt) (huv : R u v) : R v u := PrecursorWalkGeometry.R_symm A B u v huv + have reverse_reach {u v : GaussianInt} + (h : Relation.ReflTransGen R u v) : Relation.ReflTransGen R v u := + PrecursorWalkGeometry.reverse_reach A B R_symm (u := u) (v := v) h + have head_reach (u : GaussianInt) (l : List GaussianInt) + (hc : List.IsChain R (u :: l)) : + ∀ z ∈ u :: l, Relation.ReflTransGen R u z := PrecursorWalkGeometry.head_reach A B u l hc + have chain_reach {p : List GaussianInt} {u v : GaussianInt} + (hc : List.IsChain R p) (hh : p.head? = some u) + (hl : p.getLast? = some v) : Relation.ReflTransGen R u v := + PrecursorWalkGeometry.chain_reach A B head_reach (p := p) (u := u) (v := v) hc hh hl + have edge_parent (T : ProtoTile) (hTc : T.cells ⊆ A.cells) + (hTf : FootprintVertices T ⊆ FootprintVertices A) + (e : Finset GaussianInt) (he : e ∈ FootprintEdges T) : + e ∈ FootprintEdges A := PrecursorWalkGeometry.edge_parent A T hTc hTf e he + have edge_parentB (T : ProtoTile) (hTc : T.cells ⊆ B.cells) + (e : Finset GaussianInt) (he : e ∈ FootprintEdges T) : + e ∈ FootprintEdges B := PrecursorWalkGeometry.edge_parentB B T hTc e he + have p₁chain : List.IsChain R p₁ := PrecursorWalkGeometry.p₁chain A B X Y hXc hYc hXf hYf p₁ + hp₁v hp₁e edge_parent edge_parentB + have p₃chain : List.IsChain R p₃ := PrecursorWalkGeometry.p₃chain A B Z W hZc hWc hZf hWf p₃ + hp₃v hp₃e edge_parent edge_parentB + have p₁mem (z : GaussianInt) (hz : z ∈ p₁) : + z ∈ FootprintVertices A ∩ FootprintVertices B := PrecursorWalkGeometry.p₁mem A B X Y hXf + hYf p₁ hp₁v z hz + have p₃mem (z : GaussianInt) (hz : z ∈ p₃) : + z ∈ FootprintVertices A ∩ FootprintVertices B := PrecursorWalkGeometry.p₃mem A B Z W hZf + hWf p₃ hp₃v z hz + by_cases hneO : O.cells.Nonempty + · have hneO' : O'.cells.Nonempty := by rw [← hcell]; exact hneO + have hcycle := LatticeTileBoundarySimpleGridCycle O (hdisk hneO) + rcases hcycle with ⟨q, q₀, q₁, hqnd, hqlen, hqhead, hqlast, + hqvertices, hqclose, hqstep, hqedges⟩ + have qmem (z : GaussianInt) (hz : z ∈ q) : + z ∈ BoundaryFootprintVertices O := PrecursorWalkGeometry.qmem O q hqvertices z hz + have aq : a ∈ q := PrecursorWalkGeometry.aq X Y O a ha q hqvertices + have bq : b ∈ q := PrecursorWalkGeometry.bq Z W O b hb q hqvertices + let S : GaussianInt → GaussianInt → Prop := fun u v => + u ∈ BoundaryFootprintVertices O ∧ v ∈ BoundaryFootprintVertices O ∧ + {u, v} ∈ BoundaryFootprintEdges O + have S_symm (u v : GaussianInt) (huv : S u v) : S v u := PrecursorWalkGeometry.S_symm O u v huv + have qchain : List.IsChain S q := PrecursorWalkGeometry.qchain O q q₀ q₁ hqedges qmem + have qhead_reach (u : GaussianInt) (l : List GaussianInt) + (hc : List.IsChain S (u :: l)) : + ∀ z ∈ u :: l, Relation.ReflTransGen S u z := PrecursorWalkGeometry.qhead_reach O u l hc + have qreverse {u v : GaussianInt} + (h : Relation.ReflTransGen S u v) : Relation.ReflTransGen S v u := + PrecursorWalkGeometry.qreverse O S_symm (u := u) (v := v) h + have qhead : ∃ c l, q = c :: l := PrecursorWalkGeometry.qhead O a b q q₀ q₁ hqnd hqlen hqhead + hqlast hqvertices hqstep hqedges qmem aq bq qchain + rcases qhead with ⟨c, l, rfl⟩ + have hca : c = q₀ := by simpa using hqhead + subst c + have amem : a ∈ q₀ :: l := aq + have bmem : b ∈ q₀ :: l := bq + have qroute : Relation.ReflTransGen S a b := + (qreverse (qhead_reach q₀ l qchain a amem)).trans + (qhead_reach q₀ l qchain b bmem) + have S_to_R {u v : GaussianInt} (huv : S u v) : R u v := PrecursorWalkGeometry.S_to_R A B O + O' hOc hO'c hOf hO'f hcell boundary_edge_footprint boundary_vertex_footprint edge_parent + edge_parentB hneO' (u := u) (v := v) huv + have qrouteR : Relation.ReflTransGen R a b := PrecursorWalkGeometry.qrouteR A B O a b qroute + S_to_R + have hroute := (chain_reach p₁chain hp₁h hp₁l).trans + (qrouteR.trans (chain_reach p₃chain hp₃h hp₃l)) + obtain ⟨p, hc, hlast⟩ := List.exists_isChain_cons_of_relationReflTransGen hroute + refine ⟨x :: p, rfl, ?_, ?_, ?_⟩ + · rw [List.getLast?_eq_some_getLast (List.cons_ne_nil x p), hlast] + · have inside : ∀ z ∈ x :: p, z ∈ FootprintVertices A ∩ FootprintVertices B := + hc.induction (fun z => z ∈ FootprintVertices A ∩ FootprintVertices B) + (x :: p) (fun {_ _} h _ => h.2.1) + (fun _ => ⟨hXf hx.1, hYf hx.2⟩) + intro z hz + exact inside z hz + · intro u v l r h + have hed := (List.isChain_iff_forall_rel_of_append_cons_cons.mp hc h).2.2 + exact hed + · have haeq : a = O.anchor := by simpa [FootprintVertices, hneO] using haO + have hbeq : b = O.anchor := by simpa [FootprintVertices, hneO] using hbO + have hab : a = b := haeq.trans hbeq.symm + have middle : Relation.ReflTransGen R a b := by + rw [hab] + have hroute := (chain_reach p₁chain hp₁h hp₁l).trans + (middle.trans (chain_reach p₃chain hp₃h hp₃l)) + obtain ⟨p, hc, hlast⟩ := List.exists_isChain_cons_of_relationReflTransGen hroute + refine ⟨x :: p, rfl, ?_, ?_, ?_⟩ + · rw [List.getLast?_eq_some_getLast (List.cons_ne_nil x p), hlast] + · have inside : ∀ z ∈ x :: p, z ∈ FootprintVertices A ∩ FootprintVertices B := + hc.induction (fun z => z ∈ FootprintVertices A ∩ FootprintVertices B) + (x :: p) (fun {_ _} h _ => h.2.1) + (fun _ => ⟨hXf hx.1, hYf hx.2⟩) + intro z hz + exact inside z hz + · intro u v l r h + exact (List.isChain_iff_forall_rel_of_append_cons_cons.mp hc h).2.2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean b/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean new file mode 100644 index 0000000000..3e00f81b79 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean @@ -0,0 +1,932 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4677T2IncidenceLedger +public import LeanPool.ApollonianSuperharmonic.P3161T1BlockTreeReachability +public import Mathlib.Logic.Relation +public import Mathlib.Data.List.Basic +public import Mathlib.Data.List.Nodup +public import Mathlib.Data.List.Chain +public import Mathlib.Tactic.FinCases + +-- [TABLET NODE: P4677T2ThreeConnected] + +/-! +# P4677T2ThreeConnected + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ThreeConnectivityProof + +private theorem chain : + (by + classical + exact + let linkList : PeriodicSubtileIndex → List PeriodicSubtileIndex := fun z => + match z with + | ⟨.A,m,n⟩ => + [⟨.B,m,n⟩, ⟨.D,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m+1,n+1⟩, + ⟨.E,m,n+1⟩, ⟨.B,m,n+1⟩, ⟨.F,m,n⟩, ⟨.C,m,n⟩] + | ⟨.B,m,n⟩ => + [⟨.A,m-1,n-1⟩, ⟨.D,m-1,n-1⟩, ⟨.F,m,n-1⟩, ⟨.A,m,n-1⟩, + ⟨.E,m,n⟩, ⟨.D,m,n⟩, ⟨.A,m,n⟩, ⟨.C,m,n⟩] + | ⟨.C,m,n⟩ => + [⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.A,m,n⟩, ⟨.F,m,n⟩, + ⟨.D,m-1,n⟩, ⟨.E,m-1,n⟩] + | ⟨.D,m,n⟩ => + [⟨.A,m,n⟩, ⟨.B,m,n⟩, ⟨.E,m,n⟩, ⟨.C,m+1,n⟩, + ⟨.F,m+1,n⟩, ⟨.B,m+1,n+1⟩] + | ⟨.E,m,n⟩ => + [⟨.A,m,n-1⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩, ⟨.B,m,n⟩] + | ⟨.F,m,n⟩ => + [⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.D,m-1,n⟩, ⟨.C,m,n⟩] + let Chain := List.IsChain AllowedSubtileIncidence + ∀ (z : PeriodicSubtileIndex), Chain (linkList z) ) := by + classical + intro linkList Chain z + cases z with + | mk l m n => + cases l + · simp only [Chain, linkList, List.isChain_cons_cons] + refine ⟨.BD m n, ?_⟩ + refine ⟨by simpa [sub_add_cancel, add_sub_cancel_right] using + (AllowedSubtileIncidence.BDm1m1 (m+1) (n+1)).symm, ?_⟩ + refine ⟨.BC (m+1) (n+1), ?_⟩ + refine ⟨by simpa [sub_add_cancel] using + (AllowedSubtileIncidence.CEm10 (m+1) (n+1)), ?_⟩ + refine ⟨(AllowedSubtileIncidence.BE m (n+1)).symm, ?_⟩ + refine ⟨by simpa [add_sub_cancel_right] using + (AllowedSubtileIncidence.BF0m1 m (n+1)), ?_⟩ + refine ⟨(AllowedSubtileIncidence.CF m n).symm, ?_⟩ + exact .singleton _ + · simp only [Chain, linkList, List.isChain_cons_cons] + refine ⟨.AD (m-1) (n-1), ?_⟩ + refine ⟨by simpa [add_sub_cancel_right] using + (AllowedSubtileIncidence.DF10 (m-1) (n-1)), ?_⟩ + refine ⟨(AllowedSubtileIncidence.AF m (n-1)).symm, ?_⟩ + refine ⟨by simpa [sub_add_cancel] using + (AllowedSubtileIncidence.AE01 m (n-1)), ?_⟩ + refine ⟨(AllowedSubtileIncidence.DE m n).symm, ?_⟩ + refine ⟨(AllowedSubtileIncidence.AD m n).symm, ?_⟩ + refine ⟨AllowedSubtileIncidence.AC m n, ?_⟩ + exact .singleton _ + · simp only [Chain, linkList, List.isChain_cons_cons] + refine ⟨by simpa [sub_add_cancel] using + (AllowedSubtileIncidence.AB11 (m-1) (n-1)), ?_⟩ + refine ⟨(AllowedSubtileIncidence.AB m n).symm, ?_⟩ + refine ⟨.AF m n, ?_⟩ + refine ⟨by simpa [sub_add_cancel] using + (AllowedSubtileIncidence.DF10 (m-1) n).symm, ?_⟩ + refine ⟨.DE (m-1) n, ?_⟩ + exact .singleton _ + · simp only [Chain, linkList, List.isChain_cons_cons] + refine ⟨.AB m n, ?_⟩ + refine ⟨AllowedSubtileIncidence.BE m n, ?_⟩ + refine ⟨by simpa [add_sub_cancel_right] using + (AllowedSubtileIncidence.CEm10 (m+1) n).symm, ?_⟩ + refine ⟨AllowedSubtileIncidence.CF (m+1) n, ?_⟩ + refine ⟨by simpa [add_sub_cancel_right] using + (AllowedSubtileIncidence.BF0m1 (m+1) (n+1)).symm, ?_⟩ + exact .singleton _ + · simp only [Chain, linkList, List.isChain_cons_cons] + refine ⟨by simpa [sub_add_cancel] using + (AllowedSubtileIncidence.AC11 m (n-1)), ?_⟩ + refine ⟨by simpa [add_sub_cancel_right] using + (AllowedSubtileIncidence.CDm10 (m+1) n), ?_⟩ + refine ⟨(AllowedSubtileIncidence.BD m n).symm, ?_⟩ + exact .singleton _ + · simp only [Chain, linkList, List.isChain_cons_cons] + refine ⟨.AB01 m n, ?_⟩ + refine ⟨by simpa [add_sub_cancel_right] using + (AllowedSubtileIncidence.BDm1m1 m (n+1)), ?_⟩ + refine ⟨(AllowedSubtileIncidence.CDm10 m n).symm, ?_⟩ + exact .singleton _ + +private theorem adjacent : + (by + classical + exact + let linkList : PeriodicSubtileIndex → List PeriodicSubtileIndex := fun z => + match z with + | ⟨.A,m,n⟩ => + [⟨.B,m,n⟩, ⟨.D,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m+1,n+1⟩, + ⟨.E,m,n+1⟩, ⟨.B,m,n+1⟩, ⟨.F,m,n⟩, ⟨.C,m,n⟩] + | ⟨.B,m,n⟩ => + [⟨.A,m-1,n-1⟩, ⟨.D,m-1,n-1⟩, ⟨.F,m,n-1⟩, ⟨.A,m,n-1⟩, + ⟨.E,m,n⟩, ⟨.D,m,n⟩, ⟨.A,m,n⟩, ⟨.C,m,n⟩] + | ⟨.C,m,n⟩ => + [⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.A,m,n⟩, ⟨.F,m,n⟩, + ⟨.D,m-1,n⟩, ⟨.E,m-1,n⟩] + | ⟨.D,m,n⟩ => + [⟨.A,m,n⟩, ⟨.B,m,n⟩, ⟨.E,m,n⟩, ⟨.C,m+1,n⟩, + ⟨.F,m+1,n⟩, ⟨.B,m+1,n+1⟩] + | ⟨.E,m,n⟩ => + [⟨.A,m,n-1⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩, ⟨.B,m,n⟩] + | ⟨.F,m,n⟩ => + [⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.D,m-1,n⟩, ⟨.C,m,n⟩] + ∀ (z : PeriodicSubtileIndex), ∀ (u : PeriodicSubtileIndex), u ∈ linkList z → + AllowedSubtileIncidence z u ) := by + classical + intro linkList z + cases z with + | mk l m n => + cases l + · intro u hu + simp? [linkList] at hu + rcases hu with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + · exact .AB m n + · exact .AD m n + · exact .AB11 m n + · exact .AC11 m n + · exact .AE01 m n + · exact .AB01 m n + · exact .AF m n + · exact .AC m n + · intro u hu + simp? [linkList] at hu + rcases hu with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + · simpa [sub_add_cancel] using (AllowedSubtileIncidence.AB11 (m-1) (n-1)).symm + · exact AllowedSubtileIncidence.BDm1m1 m n + · exact .BF0m1 m n + · simpa [sub_add_cancel] using (AllowedSubtileIncidence.AB01 m (n-1)).symm + · exact .BE m n + · exact .BD m n + · exact (AllowedSubtileIncidence.AB m n).symm + · exact .BC m n + · intro u hu + simp? [linkList] at hu + rcases hu with rfl | rfl | rfl | rfl | rfl | rfl + · simpa [sub_add_cancel] using (AllowedSubtileIncidence.AC11 (m-1) (n-1)).symm + · exact (AllowedSubtileIncidence.BC m n).symm + · exact (AllowedSubtileIncidence.AC m n).symm + · exact AllowedSubtileIncidence.CF m n + · exact AllowedSubtileIncidence.CDm10 m n + · exact AllowedSubtileIncidence.CEm10 m n + · intro u hu + simp? [linkList] at hu + rcases hu with rfl | rfl | rfl | rfl | rfl | rfl + · exact (AllowedSubtileIncidence.AD m n).symm + · exact (AllowedSubtileIncidence.BD m n).symm + · exact AllowedSubtileIncidence.DE m n + · simpa [add_sub_cancel_right] using (AllowedSubtileIncidence.CDm10 (m+1) n).symm + · exact AllowedSubtileIncidence.DF10 m n + · simpa [add_sub_cancel_right] using + (AllowedSubtileIncidence.BDm1m1 (m+1) (n+1)).symm + · intro u hu + simp? [linkList] at hu + rcases hu with rfl | rfl | rfl | rfl + · simpa [sub_add_cancel] using (AllowedSubtileIncidence.AE01 m (n-1)).symm + · simpa [add_sub_cancel_right] using (AllowedSubtileIncidence.CEm10 (m+1) n).symm + · exact (AllowedSubtileIncidence.DE m n).symm + · exact (AllowedSubtileIncidence.BE m n).symm + · intro u hu + simp? [linkList] at hu + rcases hu with rfl | rfl | rfl | rfl + · exact (AllowedSubtileIncidence.AF m n).symm + · simpa [add_sub_cancel_right] using (AllowedSubtileIncidence.BF0m1 m (n+1)).symm + · simpa [sub_add_cancel] using (AllowedSubtileIncidence.DF10 (m-1) n).symm + · exact (AllowedSubtileIncidence.CF m n).symm + +private theorem edge_mem_link : + (by + classical + exact + let linkList : PeriodicSubtileIndex → List PeriodicSubtileIndex := fun z => + match z with + | ⟨.A,m,n⟩ => + [⟨.B,m,n⟩, ⟨.D,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m+1,n+1⟩, + ⟨.E,m,n+1⟩, ⟨.B,m,n+1⟩, ⟨.F,m,n⟩, ⟨.C,m,n⟩] + | ⟨.B,m,n⟩ => + [⟨.A,m-1,n-1⟩, ⟨.D,m-1,n-1⟩, ⟨.F,m,n-1⟩, ⟨.A,m,n-1⟩, + ⟨.E,m,n⟩, ⟨.D,m,n⟩, ⟨.A,m,n⟩, ⟨.C,m,n⟩] + | ⟨.C,m,n⟩ => + [⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.A,m,n⟩, ⟨.F,m,n⟩, + ⟨.D,m-1,n⟩, ⟨.E,m-1,n⟩] + | ⟨.D,m,n⟩ => + [⟨.A,m,n⟩, ⟨.B,m,n⟩, ⟨.E,m,n⟩, ⟨.C,m+1,n⟩, + ⟨.F,m+1,n⟩, ⟨.B,m+1,n+1⟩] + | ⟨.E,m,n⟩ => + [⟨.A,m,n-1⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩, ⟨.B,m,n⟩] + | ⟨.F,m,n⟩ => + [⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.D,m-1,n⟩, ⟨.C,m,n⟩] + ∀ {z : PeriodicSubtileIndex}, ∀ {u : PeriodicSubtileIndex}, AllowedSubtileIncidence z u → + u ∈ + linkList z ∧ z ∈ linkList u ) := by + classical + intro linkList z u h + induction h with + | AB m n => simp [linkList] + | AB01 m n => simp [linkList] + | AB11 m n => simp [linkList] + | AC m n => simp [linkList] + | AC11 m n => simp [linkList] + | AD m n => simp [linkList] + | AE01 m n => simp [linkList] + | AF m n => simp [linkList] + | BC m n => simp [linkList] + | BDm1m1 m n => simp [linkList] + | BD m n => simp [linkList] + | BE m n => simp [linkList] + | BF0m1 m n => simp [linkList] + | CDm10 m n => simp [linkList] + | CEm10 m n => simp [linkList] + | CF m n => simp [linkList] + | DE m n => simp [linkList] + | DF10 m n => simp [linkList] + | symm _ ih => exact ⟨ih.2, ih.1⟩ + +private theorem wrap : + (by + classical + exact + let linkList : PeriodicSubtileIndex → List PeriodicSubtileIndex := fun z => + match z with + | ⟨.A,m,n⟩ => + [⟨.B,m,n⟩, ⟨.D,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m+1,n+1⟩, + ⟨.E,m,n+1⟩, ⟨.B,m,n+1⟩, ⟨.F,m,n⟩, ⟨.C,m,n⟩] + | ⟨.B,m,n⟩ => + [⟨.A,m-1,n-1⟩, ⟨.D,m-1,n-1⟩, ⟨.F,m,n-1⟩, ⟨.A,m,n-1⟩, + ⟨.E,m,n⟩, ⟨.D,m,n⟩, ⟨.A,m,n⟩, ⟨.C,m,n⟩] + | ⟨.C,m,n⟩ => + [⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.A,m,n⟩, ⟨.F,m,n⟩, + ⟨.D,m-1,n⟩, ⟨.E,m-1,n⟩] + | ⟨.D,m,n⟩ => + [⟨.A,m,n⟩, ⟨.B,m,n⟩, ⟨.E,m,n⟩, ⟨.C,m+1,n⟩, + ⟨.F,m+1,n⟩, ⟨.B,m+1,n+1⟩] + | ⟨.E,m,n⟩ => + [⟨.A,m,n-1⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩, ⟨.B,m,n⟩] + | ⟨.F,m,n⟩ => + [⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.D,m-1,n⟩, ⟨.C,m,n⟩] + ∀ (nonempty : ∀ (z : PeriodicSubtileIndex), linkList z ≠ []), ∀ (z : + PeriodicSubtileIndex), AllowedSubtileIncidence ((linkList z).getLast (nonempty z)) + ((linkList z).head (nonempty + z)) ) := by + classical + intro linkList nonempty z + cases z with + | mk l m n => + cases l + · simpa [linkList] using (AllowedSubtileIncidence.BC m n).symm + · simpa [linkList, sub_add_cancel, add_sub_cancel_right] using + (AllowedSubtileIncidence.AC11 (m-1) (n-1)).symm + · simpa [linkList, sub_add_cancel, add_sub_cancel_right] using + (AllowedSubtileIncidence.AE01 (m-1) (n-1)).symm + · simpa [linkList, sub_add_cancel, add_sub_cancel_right] using + (AllowedSubtileIncidence.AB11 m n).symm + · simpa [linkList, sub_add_cancel] using + (AllowedSubtileIncidence.AB01 m (n-1)).symm + · simpa [linkList] using (AllowedSubtileIncidence.AC m n).symm + +private theorem cut_chain : + (by + classical + exact + let Chain := List.IsChain AllowedSubtileIncidence + ∀ {p : List PeriodicSubtileIndex}, ∀ {k : PeriodicSubtileIndex}, Chain p → ∀ (hne : p ≠ + []), AllowedSubtileIncidence (p.getLast hne) (p.head hne) → k ∈ p → Chain (List.drop + (List.idxOf k p + (1 : ℕ)) p ++ List.take (List.idxOf k p) p) ) := by + classical + intro Chain p k hp hne hw hk + let i := p.idxOf k + change Chain (p.drop (i + 1) ++ p.take i) + have hdchain := hp.drop (i + 1) + have htchain := hp.take i + by_cases ht : p.take i = [] + · have hi : i = 0 := by + have hh : i = 0 ∨ p = [] := by simpa [List.take_eq_nil_iff] using ht + rcases hh with h | h + · exact h + · exact (hne h).elim + rw [hi] at hdchain + simpa [hi, List.drop] using hdchain + · by_cases hd : p.drop (i + 1) = [] + · simp? [hd] + exact htchain + · apply List.IsChain.append hdchain htchain + intro x hx y hy + have hxv : x = (p.drop (i+1)).getLast hd := by + have hq := List.getLast?_eq_getLast_of_ne_nil hd + simp only [hq, Option.mem_def] at hx + exact Option.some.inj hx.symm + have hyv : y = (p.take i).head ht := by + have hq := List.head?_eq_some_head ht + simp only [hq, Option.mem_def] at hy + exact Option.some.inj hy.symm + subst x + subst y + have hdecomp : p.take (i+1) ++ p.drop (i+1) = p := List.take_append_drop _ _ + have hlast : (p.drop (i+1)).getLast hd = p.getLast hne := by + have hh := List.getLast_congr + (List.append_ne_nil_of_right_ne_nil _ hd) hne hdecomp + rw [List.getLast_append_of_right_ne_nil] at hh + exact hh + have hdecomp' : p.take i ++ p.drop i = p := List.take_append_drop _ _ + have hhead : (p.take i).head ht = p.head hne := by + have hopt : (p.take i).head? = p.head? := by + calc + (p.take i).head? = (p.take i ++ p.drop i).head? := by + rw [List.head?_append_of_ne_nil _ ht] + _ = p.head? := congrArg List.head? hdecomp' + have h₁ : (p.take i).head? = some ((p.take i).head ht) := + (List.head_eq_iff_head?_eq_some ht).mp rfl + have h₂ : p.head? = some (p.head hne) := + (List.head_eq_iff_head?_eq_some hne).mp rfl + rw [h₁, h₂] at hopt + exact Option.some.inj hopt + simpa [hlast, hhead] using hw + +private theorem mem_cut : + (by + classical + exact + (Finset PeriodicSubtileIndex) → (∀ {p : List PeriodicSubtileIndex}, ∀ + {k : PeriodicSubtileIndex}, ∀ {u : PeriodicSubtileIndex}, k ∈ p → u ∈ p → u ≠ k → u ∈ + List.drop (List.idxOf k p + (1 : ℕ)) p ++ List.take (List.idxOf k p) p) ) := by + classical + intro D p k u hk hu huk + let i := p.idxOf k + have hidxne : p.idxOf u ≠ i := by + intro he + have he' : u = k := (List.idxOf_inj hu).mp he + exact huk he' + have hdecomp : p.take (i+1) ++ p.drop (i+1) = p := List.take_append_drop _ _ + have huDecomp : u ∈ p.take (i+1) ∨ u ∈ p.drop (i+1) := by + have hm : u ∈ p.take (i+1) ++ p.drop (i+1) := by rw [hdecomp]; exact hu + exact List.mem_append.mp hm + rcases huDecomp with huLeft | huRight + · have huIdx : p.idxOf u < i+1 := (List.mem_take_iff_idxOf_lt hu).mp huLeft + have huLt : p.idxOf u < i := by omega + exact List.mem_append.mpr (Or.inr ((List.mem_take_iff_idxOf_lt hu).2 huLt)) + · exact List.mem_append.mpr (Or.inl huRight) + +private theorem k_not_mem_cut : + (by + classical + exact + (Finset PeriodicSubtileIndex) → (∀ {p : List PeriodicSubtileIndex}, ∀ + {k : PeriodicSubtileIndex}, p.Nodup → k ∈ p → k ∉ List.drop (List.idxOf k p + (1 : ℕ)) p + ++ List.take (List.idxOf k p) p) ) := by + classical + intro D p k hn hk + let i := p.idxOf k + intro h + rcases List.mem_append.mp h with hdrop | htake + · have hleft : k ∈ p.take (i+1) := by + apply (List.mem_take_iff_idxOf_lt hk).2 + omega + have hwhole : p.take (i+1) ++ p.drop (i+1) = p := List.take_append_drop _ _ + have hnodup : (p.take (i+1) ++ p.drop (i+1)).Nodup := by rw [hwhole]; exact hn + have hdisj := List.disjoint_of_nodup_append hnodup + exact (List.disjoint_left.mp hdisj hleft hdrop) + · have hidx : p.idxOf k < i := (List.mem_take_iff_idxOf_lt hk).mp htake + omega + +private theorem chain_reach : + (by + classical + exact + ∀ {R : PeriodicSubtileIndex → PeriodicSubtileIndex → Prop}, (∀ + {x : PeriodicSubtileIndex}, ∀ {y : PeriodicSubtileIndex}, R x y → R y x) → ∀ + {p : List PeriodicSubtileIndex}, List.IsChain R p → ∀ u ∈ p, ∀ v ∈ p, + Relation.ReflTransGen R u v ) := by + classical + intro R hsym p + induction p with + | nil => simp + | cons x p ih => + cases p with + | nil => + intro hc u hu v hv + simp only [List.mem_singleton] at hu hv + subst u + subst v + exact .refl + | cons y p => + intro hc u hu v hv + have htail : List.IsChain R (y :: p) := hc.tail + have fromHead : ∀ t ∈ x :: y :: p, Relation.ReflTransGen R x t := by + intro t ht + simp only [List.mem_cons] at ht + rcases ht with rfl | ht + · exact .refl + · exact (Relation.ReflTransGen.single hc.rel).trans + (ih htail y (by simp) t (by simpa using ht)) + have reverse {s t} (h : Relation.ReflTransGen R s t) : + Relation.ReflTransGen R t s := by + induction h with + | refl => exact .refl + | tail _ e ih => exact ih.head (hsym e) + exact (reverse (fromHead u hu)).trans (fromHead v hv) + +private theorem safeLink : + (by + classical + exact + ∀ (D : Finset PeriodicSubtileIndex), (D.card < (3 : ℕ)) → ( + let linkList : PeriodicSubtileIndex → List PeriodicSubtileIndex := fun z => + match z with + | ⟨.A,m,n⟩ => + [⟨.B,m,n⟩, ⟨.D,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m+1,n+1⟩, + ⟨.E,m,n+1⟩, ⟨.B,m,n+1⟩, ⟨.F,m,n⟩, ⟨.C,m,n⟩] + | ⟨.B,m,n⟩ => + [⟨.A,m-1,n-1⟩, ⟨.D,m-1,n-1⟩, ⟨.F,m,n-1⟩, ⟨.A,m,n-1⟩, + ⟨.E,m,n⟩, ⟨.D,m,n⟩, ⟨.A,m,n⟩, ⟨.C,m,n⟩] + | ⟨.C,m,n⟩ => + [⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.A,m,n⟩, ⟨.F,m,n⟩, + ⟨.D,m-1,n⟩, ⟨.E,m-1,n⟩] + | ⟨.D,m,n⟩ => + [⟨.A,m,n⟩, ⟨.B,m,n⟩, ⟨.E,m,n⟩, ⟨.C,m+1,n⟩, + ⟨.F,m+1,n⟩, ⟨.B,m+1,n+1⟩] + | ⟨.E,m,n⟩ => + [⟨.A,m,n-1⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩, ⟨.B,m,n⟩] + | ⟨.F,m,n⟩ => + [⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.D,m-1,n⟩, ⟨.C,m,n⟩] + let Chain := List.IsChain AllowedSubtileIncidence + (∀ (z : PeriodicSubtileIndex), Chain (linkList z)) → ((∀ (z : PeriodicSubtileIndex), + (linkList z).Nodup) → ((∀ (z : PeriodicSubtileIndex), z ∉ linkList z) → (∀ (nonempty + : ∀ (z : PeriodicSubtileIndex), linkList z ≠ []), (∀ {z : PeriodicSubtileIndex}, ∀ + {u : PeriodicSubtileIndex}, (AllowedSubtileIncidence z u) → (u ∈ linkList z ∧ z ∈ + linkList u)) → ((∀ (z : PeriodicSubtileIndex), AllowedSubtileIncidence ((linkList + z).getLast (nonempty z)) ((linkList z).head (nonempty z))) → ((∀ + {p : List PeriodicSubtileIndex}, ∀ {k : PeriodicSubtileIndex}, (Chain p) → (∀ (hne : p ≠ + []), (AllowedSubtileIncidence (p.getLast hne) (p.head hne)) → ((k ∈ p) → (Chain (p.drop + (p.idxOf k + 1) ++ p.take (p.idxOf k)))))) → ((∀ {p : List PeriodicSubtileIndex}, ∀ + {k : PeriodicSubtileIndex}, ∀ {u : PeriodicSubtileIndex}, (k ∈ p) → ((u ∈ p) → ((u ≠ + k) → + (u ∈ p.drop (p.idxOf k + 1) ++ p.take (p.idxOf k))))) → ((∀ + {p : List PeriodicSubtileIndex}, ∀ {k : PeriodicSubtileIndex}, (p.Nodup) → ((k ∈ p) → (k + ∉ p.drop (p.idxOf k + 1) ++ p.take (p.idxOf k)))) → ((∀ + {R : PeriodicSubtileIndex → PeriodicSubtileIndex → Prop}, (∀ {x y}, R x y → R y x) → + (∀ {p : List PeriodicSubtileIndex}, List.IsChain R p → ∀ u ∈ p, ∀ v ∈ p, + Relation.ReflTransGen R u v)) → ( + let SafeEdge (x y : PeriodicSubtileIndex) := + AllowedSubtileIncidence x y ∧ x ∉ D ∧ y ∉ D + ∀ (z : PeriodicSubtileIndex), ∀ (u : PeriodicSubtileIndex), ∀ (v : PeriodicSubtileIndex), + z ∈ + D → AllowedSubtileIncidence z u → AllowedSubtileIncidence z v → u ∉ D → v ∉ D → + Relation.ReflTransGen SafeEdge u v)))))))))) ) := by + classical + intro D hD linkList Chain chain nodup center_free nonempty edge_mem_link wrap cut_chain mem_cut + k_not_mem_cut chain_reach SafeEdge z u v hz hzu hzv hu hv + let p := linkList z + have hne : p ≠ [] := nonempty z + have hchain : Chain p := chain z + have hcenter : z ∉ p := center_free z + have huP : u ∈ p := (edge_mem_link hzu).1 + have hvP : v ∈ p := (edge_mem_link hzv).1 + have mkSafeChain {q : List PeriodicSubtileIndex} + (hc : List.IsChain AllowedSubtileIncidence q) + (hs : ∀ w ∈ q, w ∉ D) : List.IsChain SafeEdge q := by + induction q with + | nil => exact .nil + | cons x q ih => + cases q with + | nil => exact .singleton _ + | cons y q => + rw [List.isChain_cons_cons] at hc ⊢ + refine ⟨⟨hc.1, hs x (by simp), hs y (by simp)⟩, ?_⟩ + exact ih hc.2 (by + intro w hw + exact hs w (by simp [hw])) + have hsymmetric : ∀ {x y}, SafeEdge x y → SafeEdge y x := by + intro x y h + exact ⟨h.1.symm, h.2.2, h.2.1⟩ + by_cases hex : ∃ k, k ∈ D ∧ k ∈ p + · obtain ⟨k, hkD, hkP⟩ := hex + have hzk : z ≠ k := by + intro he + subst k + exact hcenter hkP + let q := p.drop (p.idxOf k + 1) ++ p.take (p.idxOf k) + have hqchain : List.IsChain AllowedSubtileIncidence q := by + exact cut_chain hchain hne (wrap z) hkP + have hkn : k ∉ q := by + exact k_not_mem_cut (nodup z) hkP + have hq_mem (w : PeriodicSubtileIndex) (hw : w ∈ q) : w ∈ p := by + rcases List.mem_append.mp hw with h | h + · exact List.mem_of_mem_drop h + · exact List.mem_of_mem_take h + have hq_safe : ∀ w ∈ q, w ∉ D := by + intro w hw hwD + have hwp := hq_mem w hw + have hwz : w ≠ z := by + intro e + subst w + exact hcenter hwp + have hwk : w ≠ k := by + intro e + subst w + exact hkn hw + have hsub : ({z, k, w} : Finset PeriodicSubtileIndex) ⊆ D := by + intro t ht + simp only [Finset.mem_insert, Finset.mem_singleton] at ht + rcases ht with rfl | rfl | rfl + · exact hz + · exact hkD + · exact hwD + have hcard : ({z, k, w} : Finset PeriodicSubtileIndex).card = 3 := by + have hzn : z ∉ ({k, w} : Finset PeriodicSubtileIndex) := by + simp [hzk, hwz.symm] + have hkn : k ∉ ({w} : Finset PeriodicSubtileIndex) := by + simp [hwk.symm] + simp only [Finset.card_insert_of_notMem hzn, + Finset.card_insert_of_notMem hkn, Finset.card_singleton] + have := Finset.card_le_card hsub + rw [hcard] at this + omega + have hqu : u ∈ q := mem_cut hkP huP (by + intro he + subst u + exact hu hkD) + have hqv : v ∈ q := mem_cut hkP hvP (by + intro he + subst v + exact hv hkD) + exact chain_reach hsymmetric (mkSafeChain hqchain hq_safe) u hqu v hqv + · have hp_safe : ∀ w ∈ p, w ∉ D := by + intro w hw hwD + exact hex ⟨w, hwD, hw⟩ + exact chain_reach hsymmetric (mkSafeChain hchain hp_safe) u huP v hvP + +private theorem common_neighbor : + (by + classical + exact + ∀ {y : PeriodicSubtileIndex}, ∀ {z : PeriodicSubtileIndex}, AllowedSubtileIncidence y z → ∃ + (w : PeriodicSubtileIndex), AllowedSubtileIncidence y w ∧ AllowedSubtileIncidence z w ∧ w + ≠ y ∧ w ≠ z ) := by + classical + intro y z h + obtain ⟨f, g, hfg, hf, hg, huniq⟩ := P4677T2IncidenceLedger.2.2.2.2.2 y z h + obtain ⟨i, hi⟩ := hf.1 + obtain ⟨j, hj⟩ := hf.2 + have hij : i ≠ j := by + intro he + subst j + have : y = z := hi.symm.trans hj + have hyy : AllowedSubtileIncidence y y := by simpa [this] using h + exact (P4677T2IncidenceLedger.2.1 y) hyy + have hk : ∃ k : Fin 3, k ≠ i ∧ k ≠ j := by + fin_cases i <;> fin_cases j <;> simp_all? <;> + first | exact ⟨0, by decide, by decide⟩ + | exact ⟨1, by decide, by decide⟩ + | exact ⟨2, by decide, by decide⟩ + obtain ⟨k, hki, hkj⟩ := hk + let w := SixSubtileFaceVertices f k + refine ⟨w, ?_, ?_, ?_, ?_⟩ + · have := P4677T2IncidenceLedger.2.2.2.2.1 f i k hki.symm + simpa [w, hi] using this + · have := P4677T2IncidenceLedger.2.2.2.2.1 f j k hkj.symm + simpa [w, hj] using this + · intro he + have he' : SixSubtileFaceVertices f i = SixSubtileFaceVertices f k := hi.trans he.symm + exact hki ((P4677T2IncidenceLedger.2.2.2.1 f) he'.symm) + · intro he + have he' : SixSubtileFaceVertices f j = SixSubtileFaceVertices f k := hj.trans he.symm + exact hkj ((P4677T2IncidenceLedger.2.2.2.1 f) he'.symm) + +private theorem global_reach : + (by + classical + exact + (Finset PeriodicSubtileIndex) → (∀ (x : PeriodicSubtileIndex), ∀ (y : + PeriodicSubtileIndex), Relation.ReflTransGen AllowedSubtileIncidence x y) ) := by + classical + intro D x y + let R := fun s t : PeriodicSubtileIndex => AllowedSubtileIncidence s t + let A := fun (z : Int × Int) => (⟨.A, z.1, z.2⟩ : PeriodicSubtileIndex) + let g := fun (z : Int × Int) => (z.1, z.2 + z.1) + have reverse {s t} (h : Relation.ReflTransGen R s t) : + Relation.ReflTransGen R t s := by + induction h with + | refl => exact .refl + | tail _ e ih => exact (Relation.ReflTransGen.single e.symm).trans ih + have step (u v : Int × Int) + (h : (u.1 = v.1 ∧ (u.2 + 1 = v.2 ∨ v.2 + 1 = u.2)) ∨ + (u.2 = v.2 ∧ (u.1 + 1 = v.1 ∨ v.1 + 1 = u.1))) : + Relation.ReflTransGen R (A (g u)) (A (g v)) := by + rcases h with ⟨heq, hup | hdown⟩ | ⟨heq, hup | hdown⟩ + · have hh : g v = ((g u).1, (g u).2 + 1) := by + apply Prod.ext <;> dsimp [g] <;> omega + rw [hh] + exact (Relation.ReflTransGen.single (AllowedSubtileIncidence.AB01 _ _)).trans + (Relation.ReflTransGen.single (AllowedSubtileIncidence.AB _ _).symm) + · have hh : g u = ((g v).1, (g v).2 + 1) := by + apply Prod.ext <;> dsimp [g] <;> omega + rw [hh] + exact reverse ((Relation.ReflTransGen.single (AllowedSubtileIncidence.AB01 _ _)).trans + (Relation.ReflTransGen.single (AllowedSubtileIncidence.AB _ _).symm)) + · have hh : g v = ((g u).1 + 1, (g u).2 + 1) := by + apply Prod.ext <;> dsimp [g] <;> omega + rw [hh] + exact (Relation.ReflTransGen.single (AllowedSubtileIncidence.AB11 _ _)).trans + (Relation.ReflTransGen.single (AllowedSubtileIncidence.AB _ _).symm) + · have hh : g u = ((g v).1 + 1, (g v).2 + 1) := by + apply Prod.ext <;> dsimp [g] <;> omega + rw [hh] + exact reverse ((Relation.ReflTransGen.single (AllowedSubtileIncidence.AB11 _ _)).trans + (Relation.ReflTransGen.single (AllowedSubtileIncidence.AB _ _).symm)) + have intWalk {S : (Int × Int) → (Int × Int) → Prop} + (hs : ∀ u v, S u v → S v u) (f : Int → Int × Int) + (hstep : ∀ k, S (f k) (f (k + 1))) (m n : Int) : + Relation.ReflTransGen S (f m) (f n) := by + have rev {s t} (h : Relation.ReflTransGen S s t) : + Relation.ReflTransGen S t s := by + induction h with + | refl => exact .refl + | @tail b c hbc hst ih => exact ih.head (hs _ _ hst) + have forward (m n : Int) (hmn : m ≤ n) : + Relation.ReflTransGen S (f m) (f n) := by + induction n, hmn using Int.leInduction with + | base => exact .refl + | succ n hn ih => exact ih.tail (hstep n) + by_cases hmn : m ≤ n + · exact forward m n hmn + · exact rev (forward n m (by omega)) + let S := fun u v : Int × Int => + ((u.1 = v.1 ∧ (u.2 + 1 = v.2 ∨ v.2 + 1 = u.2)) ∨ + (u.2 = v.2 ∧ (u.1 + 1 = v.1 ∨ v.1 + 1 = u.1))) + have ssym : ∀ u v, S u v → S v u := by + intro u v h + rcases h with ⟨h, e | e⟩ | ⟨h, e | e⟩ + · exact Or.inl ⟨h.symm, Or.inr e⟩ + · exact Or.inl ⟨h.symm, Or.inl e⟩ + · exact Or.inr ⟨h.symm, Or.inr e⟩ + · exact Or.inr ⟨h.symm, Or.inl e⟩ + have Aconnect (u v : Int × Int) : + Relation.ReflTransGen R (A (g u)) (A (g v)) := by + have vert := intWalk ssym (fun k => (u.1, k)) + (fun k => Or.inl ⟨rfl, Or.inl rfl⟩) u.2 v.2 + have horiz := intWalk ssym (fun k => (k, v.2)) + (fun k => Or.inr ⟨rfl, Or.inl rfl⟩) u.1 v.1 + have lift : ∀ {r s}, Relation.ReflTransGen S r s → + Relation.ReflTransGen R (A (g r)) (A (g s)) := by + intro r s h + induction h with + | refl => exact .refl + | tail _ e ih => exact ih.trans (step _ _ e) + exact lift (vert.trans horiz) + have sameCoord (l₁ l₂ : SixSubtileLabel) (m n : Int) : + Relation.ReflTransGen R (⟨l₁,m,n⟩ : PeriodicSubtileIndex) ⟨l₂,m,n⟩ := by + simpa [R] using + (P3161T1BlockTreeReachability (fun _ : Int × Int => True) m n trivial l₁ l₂) + cases x with + | mk lx mx nx => + cases y with + | mk ly my ny => + let cx := (mx, nx - mx) + let cy := (my, ny - my) + have hc := Aconnect cx cy + have hcx : g cx = (mx, nx) := by simp [g, cx] + have hcy : g cy = (my, ny) := by simp [g, cy] + rw [hcx, hcy] at hc + exact (sameCoord lx .A mx nx).trans + (hc.trans (sameCoord .A ly my ny)) + +private theorem reach_avoiding_from_local : + (by + classical + exact + ∀ (D : Finset PeriodicSubtileIndex), (D.card < (3 : ℕ)) → ( + let SafeEdge (x y : PeriodicSubtileIndex) := + AllowedSubtileIncidence x y ∧ x ∉ D ∧ y ∉ D + (∀ (z : PeriodicSubtileIndex), ∀ (u : PeriodicSubtileIndex), ∀ (v : + PeriodicSubtileIndex), (z + ∈ D) → ((AllowedSubtileIncidence z u) → ((AllowedSubtileIncidence z v) → ((u ∉ D) → ((v ∉ + D) → (Relation.ReflTransGen SafeEdge u v)))))) → ((∀ {y : PeriodicSubtileIndex}, ∀ + {z : PeriodicSubtileIndex}, (AllowedSubtileIncidence y z) → (∃ w, + AllowedSubtileIncidence + y w ∧ AllowedSubtileIncidence z w ∧ w ≠ y ∧ w ≠ z)) → (∀ x ∉ D, ∀ + {y : PeriodicSubtileIndex}, Relation.ReflTransGen AllowedSubtileIncidence x y → y ∉ D → + Relation.ReflTransGen SafeEdge x y))) ) := by + classical + intro D hD SafeEdge safeLink common_neighbor x hx + let R := fun s t : PeriodicSubtileIndex => AllowedSubtileIncidence s t + have main : ∀ {z}, Relation.ReflTransGen R x z → + (z ∉ D → Relation.ReflTransGen SafeEdge x z) ∧ + (z ∈ D → ∀ t, R z t → t ∉ D → Relation.ReflTransGen SafeEdge x t) := by + intro z h + induction h with + | refl => + constructor + · intro hz + exact .refl + · intro hz + exact (hx hz).elim + | @tail y z hxy hyz ih => + rcases ih with ⟨ihSafe, ihDeleted⟩ + constructor + · intro hz + by_cases hy : y ∉ D + · exact (ihSafe hy).tail ⟨hyz, hy, hz⟩ + · exact ihDeleted (by simpa using hy) z hyz hz + · intro hz t hzt ht + by_cases hy : y ∉ D + · have hroute := ihSafe hy + exact hroute.trans (safeLink z y t hz hyz.symm hzt hy ht) + · have hyD : y ∈ D := by simpa using hy + by_cases hyzEq : y = z + · subst z + exact ihDeleted hyD t hzt ht + · obtain ⟨w, hyw, hzw, hwy, hwz⟩ := common_neighbor hyz + have hwD : w ∉ D := by + intro hw + have hsub : ({y, z, w} : Finset PeriodicSubtileIndex) ⊆ D := by + intro q hq + simp only [Finset.mem_insert, Finset.mem_singleton] at hq + rcases hq with rfl | rfl | rfl + · exact hyD + · exact hz + · exact hw + have hc := Finset.card_le_card hsub + have hcard : ({y, z, w} : Finset PeriodicSubtileIndex).card = 3 := by + simp [Finset.card_insert_of_notMem, Finset.mem_insert, + Finset.mem_singleton, hyzEq, hwy.symm, hwz.symm] + omega + have hwroute := ihDeleted hyD w hyw hwD + exact hwroute.trans (safeLink z w t hz hzw hzt hwD ht) + intro y hxy hy + exact (main hxy).1 hy + +private theorem closure_list : + (by + classical + exact + ∀ (D : Finset PeriodicSubtileIndex), + let SafeEdge (x y : PeriodicSubtileIndex) := + AllowedSubtileIncidence x y ∧ x ∉ D ∧ y ∉ D + ∀ {x : PeriodicSubtileIndex}, ∀ {y : PeriodicSubtileIndex}, Relation.ReflTransGen SafeEdge x + y → x ∉ D → ∃ (p : List PeriodicSubtileIndex), p.head? = some x ∧ p.getLast? = some y ∧ + List.IsChain SafeEdge p ∧ ∀ w ∈ p, w ∉ D ) := by + classical + intro D SafeEdge x y h hx + induction h with + | refl => + exact ⟨[x], rfl, rfl, .singleton _, by simp [hx]⟩ + | @tail y z hxy hyz ih => + rcases ih with ⟨p, hhead, hlast, hp, hsafe⟩ + have hne : p ≠ [] := by + intro he + simp [he] at hhead + have hlastEq : p.getLast hne = y := by + have hh := List.getLast?_eq_getLast_of_ne_nil hne + rw [hh] at hlast + exact Option.some.inj hlast + refine ⟨p ++ [z], ?_, ?_, ?_, ?_⟩ + · rw [List.head?_append_of_ne_nil _ hne] + exact hhead + · simp + · apply List.IsChain.append hp (.singleton z) + intro s hs t ht + have hs' : s ∈ some (p.getLast hne) := by + simpa [List.getLast?_eq_getLast_of_ne_nil hne] using hs + have hsEq : s = p.getLast hne := by simpa using hs'.symm + have ht' : t ∈ some z := by simpa using ht + have htEq : t = z := by simpa using ht'.symm + subst s + subst t + rw [hlastEq] + exact hyz + · intro w hw + rcases List.mem_append.mp hw with hwp | hwz + · exact hsafe w hwp + · simp? at hwz + subst w + exact hyz.2.2 + +private theorem chain_pair : + (by + classical + exact + ∀ (D : Finset PeriodicSubtileIndex), + let SafeEdge (x y : PeriodicSubtileIndex) := + AllowedSubtileIncidence x y ∧ x ∉ D ∧ y ∉ D + ∀ (l₁ : List PeriodicSubtileIndex), ∀ (l₂ : List PeriodicSubtileIndex), ∀ (x : + PeriodicSubtileIndex), ∀ (y : PeriodicSubtileIndex), List.IsChain SafeEdge (l₁ ++ x :: y + :: l₂) → SafeEdge x y ) := by + classical + intro D SafeEdge l₁ + induction l₁ with + | nil => + intro l₂ x y hc + simp only [List.nil_append, List.isChain_cons_cons] at hc + exact hc.1 + | cons z l ih => + intro l₂ x y hc + have ht : List.IsChain SafeEdge (l ++ x :: y :: l₂) := by + simpa [List.cons_append] using hc.tail + exact ih l₂ x y ht + +end ThreeConnectivityProof + +theorem P4677T2ThreeConnected + (D : Finset PeriodicSubtileIndex) (hD : D.card < 3) + (a : PeriodicSubtileIndex) (ha : a ∉ D) + (b : PeriodicSubtileIndex) (hb : b ∉ D) : + ∃ p : List PeriodicSubtileIndex, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ x ∈ p, x ∉ D) ∧ + ∀ x y : PeriodicSubtileIndex, ∀ l₁ l₂ : List PeriodicSubtileIndex, + p = l₁ ++ x :: y :: l₂ → AllowedSubtileIncidence x y := by +-- BODY + classical + let linkList : PeriodicSubtileIndex → List PeriodicSubtileIndex := fun z => + match z with + | ⟨.A,m,n⟩ => + [⟨.B,m,n⟩, ⟨.D,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m+1,n+1⟩, + ⟨.E,m,n+1⟩, ⟨.B,m,n+1⟩, ⟨.F,m,n⟩, ⟨.C,m,n⟩] + | ⟨.B,m,n⟩ => + [⟨.A,m-1,n-1⟩, ⟨.D,m-1,n-1⟩, ⟨.F,m,n-1⟩, ⟨.A,m,n-1⟩, + ⟨.E,m,n⟩, ⟨.D,m,n⟩, ⟨.A,m,n⟩, ⟨.C,m,n⟩] + | ⟨.C,m,n⟩ => + [⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.A,m,n⟩, ⟨.F,m,n⟩, + ⟨.D,m-1,n⟩, ⟨.E,m-1,n⟩] + | ⟨.D,m,n⟩ => + [⟨.A,m,n⟩, ⟨.B,m,n⟩, ⟨.E,m,n⟩, ⟨.C,m+1,n⟩, + ⟨.F,m+1,n⟩, ⟨.B,m+1,n+1⟩] + | ⟨.E,m,n⟩ => + [⟨.A,m,n-1⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩, ⟨.B,m,n⟩] + | ⟨.F,m,n⟩ => + [⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.D,m-1,n⟩, ⟨.C,m,n⟩] + let Chain := List.IsChain AllowedSubtileIncidence + have chain (z : PeriodicSubtileIndex) : Chain (linkList z) := ThreeConnectivityProof.chain z + have nodup (z : PeriodicSubtileIndex) : (linkList z).Nodup := by + cases z with | mk l m n => cases l <;> simp [linkList] + have center_free (z : PeriodicSubtileIndex) : z ∉ linkList z := by + cases z with | mk l m n => cases l <;> simp [linkList] + have nonempty (z : PeriodicSubtileIndex) : linkList z ≠ [] := by + cases z with | mk l m n => cases l <;> simp [linkList] + have adjacent (z : PeriodicSubtileIndex) : + ∀ u ∈ linkList z, AllowedSubtileIncidence z u := ThreeConnectivityProof.adjacent z + have edge_mem_link {z u : PeriodicSubtileIndex} + (h : AllowedSubtileIncidence z u) : u ∈ linkList z ∧ z ∈ linkList u := + ThreeConnectivityProof.edge_mem_link (z := z) (u := u) h + have wrap (z : PeriodicSubtileIndex) : + AllowedSubtileIncidence ((linkList z).getLast (nonempty z)) + ((linkList z).head (nonempty z)) := ThreeConnectivityProof.wrap nonempty z + have cut_chain {p : List PeriodicSubtileIndex} {k : PeriodicSubtileIndex} + (hp : Chain p) (hne : p ≠ []) + (hw : AllowedSubtileIncidence (p.getLast hne) (p.head hne)) (hk : k ∈ p) : + Chain (p.drop (p.idxOf k + 1) ++ p.take (p.idxOf k)) := ThreeConnectivityProof.cut_chain (p + := p) (k := k) hp hne hw hk + have mem_cut {p : List PeriodicSubtileIndex} {k u : PeriodicSubtileIndex} + (hk : k ∈ p) (hu : u ∈ p) (huk : u ≠ k) : + u ∈ p.drop (p.idxOf k + 1) ++ p.take (p.idxOf k) := ThreeConnectivityProof.mem_cut D (p := + p) (k := k) (u := u) hk hu huk + have k_not_mem_cut {p : List PeriodicSubtileIndex} {k : PeriodicSubtileIndex} + (hn : p.Nodup) (hk : k ∈ p) : + k ∉ p.drop (p.idxOf k + 1) ++ p.take (p.idxOf k) := ThreeConnectivityProof.k_not_mem_cut D + (p := p) (k := k) hn hk + have chain_reach {R : PeriodicSubtileIndex → PeriodicSubtileIndex → Prop} + (hsym : ∀ {x y}, R x y → R y x) : + ∀ {p : List PeriodicSubtileIndex}, List.IsChain R p → + ∀ u ∈ p, ∀ v ∈ p, Relation.ReflTransGen R u v := ThreeConnectivityProof.chain_reach (R := + R) hsym + let SafeEdge (x y : PeriodicSubtileIndex) := + AllowedSubtileIncidence x y ∧ x ∉ D ∧ y ∉ D + have safeLink (z u v : PeriodicSubtileIndex) (hz : z ∈ D) + (hzu : AllowedSubtileIncidence z u) (hzv : AllowedSubtileIncidence z v) + (hu : u ∉ D) (hv : v ∉ D) : + Relation.ReflTransGen SafeEdge u v := ThreeConnectivityProof.safeLink D hD chain nodup + center_free nonempty edge_mem_link wrap cut_chain mem_cut k_not_mem_cut chain_reach z u + v hz hzu hzv hu hv + have common_neighbor {y z : PeriodicSubtileIndex} + (h : AllowedSubtileIncidence y z) : + ∃ w, AllowedSubtileIncidence y w ∧ AllowedSubtileIncidence z w ∧ + w ≠ y ∧ w ≠ z := ThreeConnectivityProof.common_neighbor (y := y) (z := z) h + have global_reach (x y : PeriodicSubtileIndex) : + Relation.ReflTransGen AllowedSubtileIncidence x y := ThreeConnectivityProof.global_reach D x y + have reach_avoiding_from_local + (x : PeriodicSubtileIndex) (hx : x ∉ D) : + ∀ {y}, Relation.ReflTransGen AllowedSubtileIncidence x y → y ∉ D → + Relation.ReflTransGen SafeEdge x y := ThreeConnectivityProof.reach_avoiding_from_local D + hD safeLink common_neighbor x hx + have closure_list {x y : PeriodicSubtileIndex} + (h : Relation.ReflTransGen SafeEdge x y) (hx : x ∉ D) : + ∃ p : List PeriodicSubtileIndex, p.head? = some x ∧ p.getLast? = some y ∧ + List.IsChain SafeEdge p ∧ ∀ w ∈ p, w ∉ D := ThreeConnectivityProof.closure_list D (x := + x) (y := y) h hx + have chain_pair : ∀ (l₁ l₂ : List PeriodicSubtileIndex) (x y : PeriodicSubtileIndex), + List.IsChain SafeEdge (l₁ ++ x :: y :: l₂) → SafeEdge x y := + ThreeConnectivityProof.chain_pair D + have havoiding : Relation.ReflTransGen SafeEdge a b := by + apply reach_avoiding_from_local a ha (global_reach a b) + exact hb + obtain ⟨p, hphead, hplast, hpchain, hpsafe⟩ := closure_list havoiding ha + refine ⟨p, hphead, hplast, hpsafe, ?_⟩ + intro x y l₁ l₂ heq + exact (chain_pair l₁ l₂ x y (heq ▸ hpchain)).1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2TouchingWalk.lean b/LeanPool/ApollonianSuperharmonic/P4677T2TouchingWalk.lean new file mode 100644 index 0000000000..4171d48bf2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4677T2TouchingWalk.lean @@ -0,0 +1,171 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge +public import Mathlib.Data.List.Chain + +-- [TABLET NODE: P4677T2TouchingWalk] + +/-! +# P4677T2TouchingWalk + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4677T2TouchingWalk (T U : ProtoTile) (x y : GaussianInt) + (h : TileTouching T U) + (hx : x ∈ FootprintVertices T ∩ FootprintVertices U) + (hy : y ∈ FootprintVertices T ∩ FootprintVertices U) : + ∃ p : List GaussianInt, + p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ FootprintVertices T ∩ FootprintVertices U) ∧ + ∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → + {a, b} ∈ FootprintEdges T ∩ FootprintEdges U := by +-- BODY + classical + have edge_raw (V : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges V) : e ∈ FootprintEdges V := by + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [Zsqrtd.ext_iff] + · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + have edge_vertex (V : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ FootprintEdges V) (z : GaussianInt) (hz : z ∈ e) : + z ∈ FootprintVertices V := by + rcases he with ⟨c, hc, rfl | rfl | rfl | rfl⟩ + all_goals + simp only [FootprintVertices, ite_eq_left (show V.cells.Nonempty from ⟨c, hc⟩), + Set.mem_ofPred_eq] + refine ⟨c, hc, ?_⟩ + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl <;> simp + have incident (V : ProtoTile) (z : GaussianInt) (hn : V.cells.Nonempty) + (hz : z ∈ FootprintVertices V) : + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ V.cells := by + simp only [FootprintVertices, ite_eq_left hn, Set.mem_ofPred_eq] at hz + rcases hz with ⟨c, hc, rfl | rfl | rfl | rfl⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨2, by simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hc⟩ + rcases h with h | h | h + · rcases h with ⟨hT, hU, hd, hp⟩ + let V := BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U + let E := BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U + have raw_boundary (z : GaussianInt) + (hz : z ∈ FootprintVertices T ∩ FootprintVertices U) : z ∈ V := by + obtain ⟨j, hj⟩ := incident T z hT hz.1 + obtain ⟨k, hk⟩ := incident U z hU hz.2 + exact ⟨P3161T2IncidentBoundary T z ⟨j, hj⟩ + ⟨k, fun h => Finset.disjoint_left.mp hd h hk⟩, + P3161T2IncidentBoundary U z ⟨k, hk⟩ + ⟨j, fun h => Finset.disjoint_left.mp hd hj h⟩⟩ + have boundary_raw (z : GaussianInt) (hz : z ∈ V) : + z ∈ FootprintVertices T ∩ FootprintVertices U := by + obtain ⟨e, hze, he⟩ := SimpleGridPathVertexIncidentEdge V E hp z hz + exact ⟨edge_vertex T e (edge_raw T e he.1) z hze, + edge_vertex U e (edge_raw U e he.2) z hze⟩ + let R : GaussianInt → GaussianInt → Prop := + fun a b => a ∈ V ∧ b ∈ V ∧ {a, b} ∈ E + have symmR (a b : GaussianInt) (h : R a b) : R b a := + ⟨h.2.1, h.1, by simpa [Finset.pair_comm] using h.2.2⟩ + have reverse {a b : GaussianInt} (h : Relation.ReflTransGen R a b) : + Relation.ReflTransGen R b a := by + induction h with + | refl => exact .refl + | @tail b c hbc hstep ih => exact ih.head (symmR _ _ hstep) + have head_reach (a : GaussianInt) (l : List GaussianInt) + (hc : List.IsChain R (a :: l)) : + ∀ z ∈ a :: l, Relation.ReflTransGen R a z := by + induction l generalizing a with + | nil => + intro z hz + have heq : z = a := by simpa using hz + subst z + exact .refl + | cons b l ih => + intro z hz + rcases List.mem_cons.mp hz with rfl | hz + · exact .refl + · exact (Relation.ReflTransGen.single (List.isChain_cons_cons.mp hc).1).trans + (ih b (List.isChain_cons_cons.mp hc).2 z hz) + have hxV := raw_boundary x hx + have hyV := raw_boundary y hy + rcases hp with ⟨q, hnodup, hlen, hv, hstep, he⟩ + have qmem (z : GaussianInt) (hz : z ∈ q) : z ∈ V := by + change z ∈ BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U + rw [hv] + simpa using hz + have chain : List.IsChain R q := by + apply List.isChain_iff_forall_rel_of_append_cons_cons.mpr + intro a b l₁ l₂ hab + refine ⟨qmem a (by simp [hab]), qmem b (by simp [hab]), ?_⟩ + exact (he _).mpr ⟨a, b, l₁, l₂, hab, rfl⟩ + have hxq : x ∈ q := by + have hh : x ∈ (q.toFinset : Set GaussianInt) := hv ▸ hxV + simpa using hh + have hyq : y ∈ q := by + have hh : y ∈ (q.toFinset : Set GaussianInt) := hv ▸ hyV + simpa using hh + obtain ⟨a, l, rfl⟩ := List.exists_cons_of_ne_nil + (show q ≠ [] by intro h; simp [h] at hlen) + have route := (reverse (head_reach a l chain x hxq)).trans + (head_reach a l chain y hyq) + obtain ⟨p, hc, hlast⟩ := List.exists_isChain_cons_of_relationReflTransGen route + refine ⟨x :: p, rfl, ?_, ?_, ?_⟩ + · rw [List.getLast?_eq_some_getLast (List.cons_ne_nil x p), hlast] + · have inside : ∀ z ∈ x :: p, z ∈ V := + hc.induction (fun z => z ∈ V) (x :: p) + (fun {_ _} h _ => h.2.1) (fun _ => hxV) + intro z hz + exact boundary_raw z (inside z hz) + · intro a b l₁ l₂ hab + have hed := (List.isChain_iff_forall_rel_of_append_cons_cons.mp hc hab).2.2 + exact ⟨edge_raw T _ hed.1, edge_raw U _ hed.2⟩ + · have heq : x = y := by + have hx' : x = T.anchor := by simpa [FootprintVertices, h.1] using hx.1 + have hy' : y = T.anchor := by simpa [FootprintVertices, h.1] using hy.1 + exact hx'.trans hy'.symm + subst y + refine ⟨[x], rfl, rfl, ?_, ?_⟩ + · intro z hz + simpa only [List.mem_singleton.mp hz] using hx + · intro a b l₁ l₂ h + have hh := congrArg List.length h + simp at hh + omega + · have heq : x = y := by + have hx' : x = U.anchor := by simpa [FootprintVertices, h.1] using hx.2 + have hy' : y = U.anchor := by simpa [FootprintVertices, h.1] using hy.2 + exact hx'.trans hy'.symm + subst y + refine ⟨[x], rfl, rfl, ?_, ?_⟩ + · intro z hz + simpa only [List.mem_singleton.mp hz] using hx + · intro a b l₁ l₂ h + have hh := congrArg List.length h + simp at hh + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1Arc.lean b/LeanPool/ApollonianSuperharmonic/P4715T1Arc.lean new file mode 100644 index 0000000000..81790947e0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1Arc.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1Position +public import Mathlib.Analysis.Convex.Segment + +-- [TABLET NODE: P4715T1Arc] + +/-! +# P4715T1Arc + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For every ordered pair of indices, including a nonedge or a repeated +index, let $S(a,b)=[p(a),p(b)]$ be the closed real segment between +the positions of `P4715T1Position`. +-/ +def P4715T1Arc (a b : PeriodicSubtileIndex) : Set (Real × Real) := +-- BODY + segment Real (P4715T1Position a) (P4715T1Position b) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1BoundaryCycle.lean b/LeanPool/ApollonianSuperharmonic/P4715T1BoundaryCycle.lean new file mode 100644 index 0000000000..e808ade8f0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1BoundaryCycle.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex + +-- [TABLET NODE: P4715T1BoundaryCycle] + +/-! +# P4715T1BoundaryCycle + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The cyclic list of corner indices is +$(A_{0,0},B_{0,0},A_{-1,-1},B_{-1,0},A_{-1,0},B_{0,1})$, +with indices as in `PeriodicSubtileIndex`. +-/ +def P4715T1BoundaryCycle : Fin 6 → PeriodicSubtileIndex := +-- BODY + ![⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.A, -1, -1⟩, + ⟨.B, -1, 0⟩, ⟨.A, -1, 0⟩, ⟨.B, 0, 1⟩] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientEdges.lean b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientEdges.lean new file mode 100644 index 0000000000..eebf3e1c48 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientEdges.lean @@ -0,0 +1,213 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonTessellation +public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonSubdivision +public import LeanPool.ApollonianSuperharmonic.P4715T1PatchEnumeration +public import LeanPool.ApollonianSuperharmonic.P4715T1PositionInjective +public import LeanPool.ApollonianSuperharmonic.P4677T2IncidenceLedger +public import LeanPool.ApollonianSuperharmonic.P4802T1PatchFaceRestriction +public import LeanPool.ApollonianSuperharmonic.P4802T1CrossPatchFaces +public import Mathlib.Topology.Homeomorph.Lemmas +public import Mathlib.Tactic.FunProp + +-- [TABLET NODE: P4715T1CoefficientEdges] + +/-! +# P4715T1CoefficientEdges + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4715T1CoefficientEdges : + (∀ a b, P4715T1Arc a b = P4715T1Arc b a) ∧ + (∀ a b, AllowedSubtileIncidence a b → + ∃ h : Set.Icc (0 : Real) 1 ≃ₜ P4715T1Arc a b, + ((h ⟨0, by norm_num⟩ : P4715T1Arc a b) : Real × Real) = + P4715T1Position a ∧ + ((h ⟨1, by norm_num⟩ : P4715T1Arc a b) : Real × Real) = + P4715T1Position b) ∧ + ∀ a b c d, AllowedSubtileIncidence a b → AllowedSubtileIncidence c d → + ({a, b} : Set PeriodicSubtileIndex) ≠ {c, d} → + P4715T1Arc a b ∩ P4715T1Arc c d = + P4715T1Position '' (({a, b} : Set PeriodicSubtileIndex) ∩ {c, d}) := by +-- BODY + classical + refine ⟨fun a b => segment_symm Real _ _, ?_, ?_⟩ + · intro a b hab + have hn : a ≠ b := by + intro h + subst b + exact P4677T2IncidenceLedger.2.1 a hab + have hne := P4715T1PositionInjective.ne hn + let g : Set.Icc (0 : Real) 1 → P4715T1Arc a b := fun t => + ⟨AffineMap.lineMap (P4715T1Position a) (P4715T1Position b) (t : Real), + lineMap_mem_segment Real _ _ t.property⟩ + have hg : Function.Bijective g := by + constructor + · intro s t h + apply Subtype.ext + exact AffineMap.lineMap_injective Real hne (congrArg Subtype.val h) + · intro p + have hp : (p : Real × Real) ∈ + AffineMap.lineMap (P4715T1Position a) (P4715T1Position b) '' + Set.Icc (0 : Real) 1 := by + simpa only [P4715T1Arc, segment_eq_image_lineMap] using p.property + obtain ⟨t, ht, heq⟩ := hp + exact ⟨⟨t, ht⟩, Subtype.ext heq⟩ + let e := Equiv.ofBijective g hg + have hc : Continuous (e : Set.Icc (0 : Real) 1 → P4715T1Arc a b) := by + change Continuous g + fun_prop + refine ⟨hc.homeoOfEquivCompactToT2, ?_, ?_⟩ + · change AffineMap.lineMap _ _ (0 : Real) = _ + simp + · change AffineMap.lineMap _ _ (1 : Real) = _ + simp + · intro a b c d hab hcd hne + obtain ⟨f, g, hfg, hfab, hgab, hfaces⟩ := + P4677T2IncidenceLedger.2.2.2.2.2 a b hab + obtain ⟨⟨k, i⟩, hki, haddress⟩ := P4715T1PatchEnumeration f + obtain ⟨f', g', hfg', hfcd, hgcd, hfaces'⟩ := + P4677T2IncidenceLedger.2.2.2.2.2 c d hcd + obtain ⟨⟨l, j⟩, hlj, haddress'⟩ := P4715T1PatchEnumeration f' + have hsub : (({a,b} : Set PeriodicSubtileIndex) ∩ {c,d}).Subsingleton := by + intro x hx y hy + simp only [Set.mem_inter_iff, Set.mem_insert_iff, Set.mem_singleton_iff] at hx hy + by_contra hxy + apply hne + rcases hx with ⟨hxa,hxc⟩ + rcases hy with ⟨hya,hyc⟩ + rcases hxa with hxa | hxa <;> rcases hya with hya | hya <;> + rcases hxc with hxc | hxc <;> rcases hyc with hyc | hyc <;> + subst_vars <;> simp_all [Set.pair_comm] + have hrhs : convexHull Real + (P4715T1Position '' (({a,b} : Set PeriodicSubtileIndex) ∩ {c,d})) = + P4715T1Position '' (({a,b} : Set PeriodicSubtileIndex) ∩ {c,d}) := + convexHull_eq_self.mpr (hsub.image _).convex + have habHull : P4715T1Arc a b = + convexHull Real (P4715T1Position '' ({a,b} : Set PeriodicSubtileIndex)) := by + simp only [P4715T1Arc, Set.image_pair, convexHull_pair] + have hcdHull : P4715T1Arc c d = + convexHull Real (P4715T1Position '' ({c,d} : Set PeriodicSubtileIndex)) := by + simp only [P4715T1Arc, Set.image_pair, convexHull_pair] + rw [habHull,hcdHull,← hrhs] + have hinside (k : Int × Int) (i : Fin 12) (f : PeriodicSubtileFaceIndex) + (hki : P4715T1FaceShift k (P4715T1PatchFaces i) = f) + (z : PeriodicSubtileIndex) (hz : z ∈ Set.range (SixSubtileFaceVertices f)) : + P4715T1Position z ∈ + (fun x : Real × Real => x + ((k.1 : Real),(k.2 : Real))) '' + P4715T1Hexagon := by + obtain ⟨t,ht⟩ := hz + have hv := P4715T1IndexAction.2.2.2.2.2 k (P4715T1PatchFaces i) t + rw [hki] at hv + have hsz : P4715T1VertexShift k + (SixSubtileFaceVertices (P4715T1PatchFaces i) t) = z := hv.symm.trans ht + refine ⟨P4715T1Position (SixSubtileFaceVertices (P4715T1PatchFaces i) t), ?_, ?_⟩ + · rw [← P4715T1HexagonSubdivision.1] + exact Set.mem_iUnion.mpr ⟨i, + subset_convexHull Real _ ⟨_,⟨t,rfl⟩,rfl⟩⟩ + · exact ((P4715T1CoefficientTranslation k).1 _).symm.trans + (congrArg P4715T1Position hsz) + by_cases hkl : k = l + · subst l + obtain ⟨ia,hia⟩ := hfab.1 + obtain ⟨ib,hib⟩ := hfab.2 + obtain ⟨ic,hic⟩ := hfcd.1 + obtain ⟨id,hid⟩ := hfcd.2 + let A := SixSubtileFaceVertices (P4715T1PatchFaces i) ia + let B := SixSubtileFaceVertices (P4715T1PatchFaces i) ib + let C := SixSubtileFaceVertices (P4715T1PatchFaces j) ic + let D := SixSubtileFaceVertices (P4715T1PatchFaces j) id + have hA : P4715T1VertexShift k A = a := by + rw [← P4715T1IndexAction.2.2.2.2.2, hki]; exact hia + have hB : P4715T1VertexShift k B = b := by + rw [← P4715T1IndexAction.2.2.2.2.2, hki]; exact hib + have hC : P4715T1VertexShift k C = c := by + rw [← P4715T1IndexAction.2.2.2.2.2, hlj]; exact hic + have hD : P4715T1VertexShift k D = d := by + rw [← P4715T1IndexAction.2.2.2.2.2, hlj]; exact hid + have hSA : ({a,b} : Set PeriodicSubtileIndex) = + P4715T1VertexShift k '' ({A,B} : Set PeriodicSubtileIndex) := by + simp only [Set.image_pair,hA,hB] + have hTC : ({c,d} : Set PeriodicSubtileIndex) = + P4715T1VertexShift k '' ({C,D} : Set PeriodicSubtileIndex) := by + simp only [Set.image_pair,hC,hD] + have hAB : ({A,B} : Set PeriodicSubtileIndex) ⊆ + Set.range (SixSubtileFaceVertices (P4715T1PatchFaces i)) := by + intro z hz + rcases hz with rfl | hz + · exact ⟨ia,rfl⟩ + · rcases hz with rfl; exact ⟨ib,rfl⟩ + have hCD : ({C,D} : Set PeriodicSubtileIndex) ⊆ + Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j)) := by + intro z hz + rcases hz with rfl | hz + · exact ⟨ic,rfl⟩ + · rcases hz with rfl; exact ⟨id,rfl⟩ + have hull_shift (S : Set PeriodicSubtileIndex) : + convexHull Real (P4715T1Position '' (P4715T1VertexShift k '' S)) = + (fun x : Real × Real => x + ((k.1 : Real),(k.2 : Real))) '' + convexHull Real (P4715T1Position '' S) := by + let G : (Real × Real) →ᵃ[Real] (Real × Real) := + AffineMap.id Real (Real × Real) + + AffineMap.const Real (Real × Real) ((k.1 : Real),(k.2 : Real)) + change convexHull Real (P4715T1Position '' (P4715T1VertexShift k '' S)) = + G '' convexHull Real (P4715T1Position '' S) + rw [G.image_convexHull, Set.image_image, Set.image_image] + congr 2 + funext z + exact (P4715T1CoefficientTranslation k).1 z + apply Set.Subset.antisymm + · intro p hp + have hp1 := hp.1 + have hp2 := hp.2 + rw [hSA,hull_shift] at hp1 + rw [hTC,hull_shift] at hp2 + obtain ⟨x,hx,hxp⟩ := hp1 + obtain ⟨y,hy,hyp⟩ := hp2 + have hxy : x = y := add_right_cancel (hxp.trans hyp.symm) + subst y + have hxST : x ∈ convexHull Real + (P4715T1Position '' (({A,B} : Set PeriodicSubtileIndex) ∩ {C,D})) := by + rw [← P4802T1PatchFaceRestriction i j _ _ hAB hCD] + exact ⟨hx,hy⟩ + have hpST : p ∈ convexHull Real (P4715T1Position '' + (P4715T1VertexShift k '' (({A,B} : Set PeriodicSubtileIndex) ∩ {C,D}))) := by + rw [hull_shift] + exact ⟨x,hxST,hxp⟩ + have hs : P4715T1VertexShift k '' + (({A,B} : Set PeriodicSubtileIndex) ∩ {C,D}) ⊆ + ({a,b} : Set PeriodicSubtileIndex) ∩ {c,d} := by + rintro _ ⟨z,hz,rfl⟩ + constructor + · rw [hSA]; exact ⟨z,hz.1,rfl⟩ + · rw [hTC]; exact ⟨z,hz.2,rfl⟩ + exact convexHull_mono (Set.image_mono hs) hpST + · exact Set.subset_inter + (convexHull_mono (Set.image_mono Set.inter_subset_left)) + (convexHull_mono (Set.image_mono Set.inter_subset_right)) + · apply P4802T1CrossPatchFaces k l hkl + · intro z hz + simp only [Set.mem_insert_iff,Set.mem_singleton_iff] at hz + rcases hz with rfl | rfl + · exact hinside k i f hki _ hfab.1 + · exact hinside k i f hki _ hfab.2 + · intro z hz + simp only [Set.mem_insert_iff,Set.mem_singleton_iff] at hz + rcases hz with rfl | rfl + · exact hinside l j f' hlj _ hfcd.1 + · exact hinside l j f' hlj _ hfcd.2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean new file mode 100644 index 0000000000..bad3b4fb7b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean @@ -0,0 +1,1458 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonTessellation +public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonSubdivision +public import LeanPool.ApollonianSuperharmonic.P4715T1PatchEnumeration +public import LeanPool.ApollonianSuperharmonic.P4715T1PositionInjective +public import LeanPool.ApollonianSuperharmonic.P4715T1Region +public import LeanPool.ApollonianSuperharmonic.P4677T2IncidenceLedger +public import Mathlib.Analysis.Convex.PathConnected +public import Mathlib.Tactic.Ring +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P4715T1CoefficientFaces] + +/-! +# P4715T1CoefficientFaces + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CoefficientFaceProof + +private theorem faceDet_eq_delta : + (by + classical + exact + let faceDet (f : PeriodicSubtileFaceIndex) : ℝ := + let p0 := P4715T1Position (SixSubtileFaceVertices f 0) + let p1 := P4715T1Position (SixSubtileFaceVertices f 1) + let p2 := P4715T1Position (SixSubtileFaceVertices f 2) + p1.1 * p2.2 - p1.1 * p0.2 - p0.1 * p2.2 - p1.2 * p2.1 + + p1.2 * p0.1 + p0.2 * p2.1 + ∀ (f : PeriodicSubtileFaceIndex), faceDet f = (P4715T1Position (SixSubtileFaceVertices + f (1 : Fin (3 : ℕ))) - P4715T1Position (SixSubtileFaceVertices f (0 : Fin (3 : + ℕ)))).1 * (P4715T1Position (SixSubtileFaceVertices f (2 : Fin (3 : ℕ))) - + P4715T1Position (SixSubtileFaceVertices f (0 : Fin (3 : ℕ)))).2 - + (P4715T1Position (SixSubtileFaceVertices f (1 : Fin (3 : ℕ))) - P4715T1Position + (SixSubtileFaceVertices f (0 : Fin (3 : ℕ)))).2 * (P4715T1Position + (SixSubtileFaceVertices f (2 : Fin (3 : ℕ))) - P4715T1Position + (SixSubtileFaceVertices f (0 : Fin (3 : ℕ)))).1 ) := by + classical + intro faceDet f + simp only [faceDet, Prod.fst_sub, Prod.snd_sub] + ring + +private theorem delta_nonzero : + (by + classical + exact + let faceDet (f : PeriodicSubtileFaceIndex) : ℝ := + let p0 := P4715T1Position (SixSubtileFaceVertices f 0) + let p1 := P4715T1Position (SixSubtileFaceVertices f 1) + let p2 := P4715T1Position (SixSubtileFaceVertices f 2) + p1.1 * p2.2 - p1.1 * p0.2 - p0.1 * p2.2 - p1.2 * p2.1 + + p1.2 * p0.1 + p0.2 * p2.1 + (∀ (f : PeriodicSubtileFaceIndex), faceDet f ≠ 0) → ((∀ (f : PeriodicSubtileFaceIndex), + faceDet f = (P4715T1Position (SixSubtileFaceVertices f 1) - P4715T1Position + (SixSubtileFaceVertices f 0)).1 * (P4715T1Position (SixSubtileFaceVertices f 2) - + P4715T1Position (SixSubtileFaceVertices f 0)).2 - (P4715T1Position + (SixSubtileFaceVertices f 1) - P4715T1Position (SixSubtileFaceVertices f 0)).2 * + (P4715T1Position (SixSubtileFaceVertices f 2) - P4715T1Position + (SixSubtileFaceVertices f 0)).1) → (∀ (f : PeriodicSubtileFaceIndex), + (P4715T1Position (SixSubtileFaceVertices f (1 : Fin (3 : ℕ))) - P4715T1Position + (SixSubtileFaceVertices f (0 : Fin (3 : ℕ)))).1 * (P4715T1Position + (SixSubtileFaceVertices f (2 : Fin (3 : ℕ))) - P4715T1Position + (SixSubtileFaceVertices f (0 : Fin (3 : ℕ)))).2 - (P4715T1Position + (SixSubtileFaceVertices f (1 : Fin (3 : ℕ))) - P4715T1Position + (SixSubtileFaceVertices f (0 : Fin (3 : ℕ)))).2 * (P4715T1Position + (SixSubtileFaceVertices f (2 : Fin (3 : ℕ))) - P4715T1Position + (SixSubtileFaceVertices f (0 : Fin (3 : ℕ)))).1 ≠ (0 : ℝ))) ) := by + classical + intro faceDet faceDet_nonzero faceDet_eq_delta f + rw [← faceDet_eq_delta f] + exact faceDet_nonzero f + +private theorem Dconvex : + (by + classical + exact + let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1} + Convex ℝ D ) := by + classical + intro D x hx y hy a b ha hb hab + dsimp [D] at hx hy ⊢ + have hpos (u v : ℝ) (hu : 0 < u) (hv : 0 < v) : 0 < a*u+b*v := by + by_cases hza : a = 0 + · have hb1 : b = 1 := by linarith + subst a + subst b + simpa using hv + · have hap : 0 < a := lt_of_le_of_ne ha (Ne.symm hza) + nlinarith [mul_pos hap hu, mul_nonneg hb (le_of_lt hv)] + constructor + · exact hpos _ _ hx.1 hy.1 + · constructor + · exact hpos _ _ hx.2.1 hy.2.1 + · have hsum : 0 < a * (1 - (x.1+x.2)) + b * (1 - (y.1+y.2)) := + hpos _ _ (sub_pos.mpr hx.2.2) (sub_pos.mpr hy.2.2) + calc + a*x.1+b*y.1+(a*x.2+b*y.2) = a*(x.1+x.2)+b*(y.1+y.2) := by ring + _ < a*1+b*1 := by nlinarith + _ = 1 := by rw [← add_mul, hab]; ring + +private theorem D_closure : + (by + classical + exact + let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1} + let W : Set (ℝ × ℝ) := {z | 0 ≤ z.1 ∧ 0 ≤ z.2 ∧ z.1+z.2 ≤ 1} + (D ⊆ W) → (∀ [IsClosed W], closure D = W) ) := by + classical + intro D W D_subset_W W_closed + apply Set.Subset.antisymm + · exact closure_minimal D_subset_W W_closed + · intro z hz + rw [Metric.mem_closure_iff] + intro ε hε + have hzw : 0 ≤ z.1 ∧ 0 ≤ z.2 ∧ z.1+z.2 ≤ 1 := by simpa [W] using hz + let c : ℝ × ℝ := (1/3,1/3) + let r : ℝ := min (1/2) (ε / (2 * (dist z c + 1))) + have hr0 : 0 < r := by dsimp [r]; positivity + have hrhalf : r ≤ 1/2 := min_le_left _ _ + have hrε : r ≤ ε / (2*(dist z c+1)) := min_le_right _ _ + let y : ℝ × ℝ := (1-r) • z + r • c + have hy : y ∈ D := by + dsimp [D, y, c] at hz ⊢ + have h1r : 0 ≤ 1-r := by linarith [hrhalf] + constructor + · have : 0 < r * (1/3) := mul_pos hr0 (by norm_num) + nlinarith [mul_nonneg h1r hzw.1] + · constructor + · have : 0 < r * (1/3) := mul_pos hr0 (by norm_num) + nlinarith [mul_nonneg h1r hzw.2.1] + · have hsum : z.1+z.2 ≤ 1 := hzw.2.2 + nlinarith [mul_nonneg h1r (by linarith : 0 ≤ 1-(z.1+z.2))] + have hcoord1 : dist y.1 z.1 ≤ r := by + rw [Real.dist_eq] + have heq : ((1-r) • z + r • c).1 - z.1 = r * (1/3-z.1) := by dsimp [c]; ring + rw [heq, abs_mul, abs_of_pos hr0] + have hz1 : 0 ≤ z.1 ∧ z.1 ≤ 1 := ⟨hzw.1, by linarith [hzw.2.1]⟩ + have hc : |(1:ℝ)/3-z.1| ≤ 1 := by rw [abs_le]; constructor <;> linarith + nlinarith [mul_le_mul_of_nonneg_left hc hr0.le] + have hcoord2 : dist y.2 z.2 ≤ r := by + rw [Real.dist_eq] + have heq : ((1-r) • z + r • c).2 - z.2 = r * (1/3-z.2) := by dsimp [c]; ring + rw [heq, abs_mul, abs_of_pos hr0] + have hz2 : 0 ≤ z.2 ∧ z.2 ≤ 1 := ⟨hzw.2.1, by linarith [hzw.2.2]⟩ + have hc : |(1:ℝ)/3-z.2| ≤ 1 := by rw [abs_le]; constructor <;> linarith + nlinarith [mul_le_mul_of_nonneg_left hc hr0.le] + have hdist : dist y z ≤ r := by + rw [Prod.dist_eq] + exact max_le_iff.mpr ⟨hcoord1, hcoord2⟩ + refine ⟨y, hy, ?_⟩ + calc + dist z y = dist y z := dist_comm _ _ + _ ≤ r := hdist + _ < ε := by + have hden : 0 < 2*(dist z c+1) := by positivity + have hbound : r * (2*(dist z c+1)) ≤ ε := (le_div_iff₀ hden).mp hrε + have hdistnonneg : 0 ≤ dist z c := dist_nonneg + nlinarith + +private theorem mem_bottom_segment : + (by + classical + exact + ∀ (z : ℝ × ℝ), z ∈ segment ℝ ((0 : ℝ), (0 : ℝ)) ((1 : ℝ), (0 : ℝ)) ↔ z.2 = (0 : ℝ) ∧ (0 : + ℝ) ≤ z.1 ∧ z.1 ≤ (1 : ℝ) ) := by + classical + intro z + rw [segment_eq_image_lineMap] + constructor + · rintro ⟨t, ht, heq⟩ + have h1 := congrArg Prod.fst heq + have h2 := congrArg Prod.snd heq + simp? [AffineMap.lineMap_apply] at h1 h2 + exact ⟨h2.symm, by simpa [h1] using ht.1, by simpa [h1] using ht.2⟩ + · rintro ⟨h2,h1,h1le⟩ + refine ⟨z.1, ⟨h1,h1le⟩, ?_⟩ + ext <;> simp [AffineMap.lineMap_apply, h2] + +private theorem mem_diagonal_segment : + (by + classical + exact + ∀ (z : ℝ × ℝ), z ∈ segment ℝ ((1 : ℝ), (0 : ℝ)) ((0 : ℝ), (1 : ℝ)) ↔ z.1 + z.2 = (1 : ℝ) + ∧ (0 : ℝ) ≤ z.1 ∧ (0 : ℝ) ≤ z.2 ) := by + classical + intro z + rw [segment_eq_image_lineMap] + constructor + · rintro ⟨t, ht, heq⟩ + have h1 := congrArg Prod.fst heq + have h2 := congrArg Prod.snd heq + simp? [AffineMap.lineMap_apply] at h1 h2 + exact ⟨by linarith [h1,h2], by linarith [h1,ht.2], by linarith [h2,ht.1]⟩ + · rintro ⟨hsum,h1,h2⟩ + refine ⟨z.2, ⟨h2, by linarith [hsum,h1]⟩, ?_⟩ + ext <;> simp [AffineMap.lineMap_apply]; linarith + +private theorem mem_left_segment : + (by + classical + exact + ∀ (z : ℝ × ℝ), z ∈ segment ℝ ((0 : ℝ), (0 : ℝ)) ((0 : ℝ), (1 : ℝ)) ↔ z.1 = (0 : ℝ) ∧ (0 : + ℝ) ≤ z.2 ∧ z.2 ≤ (1 : ℝ) ) := by + classical + intro z + rw [segment_eq_image_lineMap] + constructor + · rintro ⟨t, ht, heq⟩ + have h1 := congrArg Prod.fst heq + have h2 := congrArg Prod.snd heq + simp? [AffineMap.lineMap_apply] at h1 h2 + exact ⟨h1.symm, by simpa [h2] using ht.1, by simpa [h2] using ht.2⟩ + · rintro ⟨h1,h2,h2le⟩ + refine ⟨z.2, ⟨h2,h2le⟩, ?_⟩ + ext <;> simp [AffineMap.lineMap_apply, h1] + +private theorem D_frontier : + (by + classical + exact + let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1} + (IsOpen D) → ( + let W : Set (ℝ × ℝ) := {z | 0 ≤ z.1 ∧ 0 ≤ z.2 ∧ z.1+z.2 ≤ 1} + (closure D = W) → ((∀ (z : ℝ×ℝ), z ∈ segment ℝ (0,0) (1,0) ↔ z.2=0 ∧ 0≤z.1 ∧ z.1≤1) → ((∀ + (z : ℝ×ℝ), z ∈ segment ℝ (1,0) (0,1) ↔ z.1+z.2=1 ∧ 0≤z.1 ∧ 0≤z.2) → ((∀ (z : ℝ×ℝ), z + ∈ segment ℝ (0,0) (0,1) ↔ z.1=0 ∧ 0≤z.2 ∧ z.2≤1) → (frontier D = segment ℝ (0,0) + (1,0) ∪ segment ℝ (1,0) (0,1) ∪ segment ℝ (0,0) (0,1)))))) ) := by + classical + intro D Dopen W D_closure mem_bottom_segment mem_diagonal_segment mem_left_segment + rw [Dopen.frontier_eq, D_closure] + ext z + constructor + · rintro ⟨hzW, hnot⟩ + rcases (by simpa [W] using hzW) with ⟨hz1, hz2, hsum⟩ + have hnot' : ¬ (0 simp [wt] <;> linarith + have hw1 : ∑ i, wt i = 1 := by simp [wt, Fin.sum_univ_succ] + have hp : ∀ i, stdPts i ∈ Set.range stdPts := fun i => ⟨i,rfl⟩ + have hsum : ∑ i, wt i • stdPts i = z := by + ext <;> simp [wt,stdPts, Fin.sum_univ_succ] + exact mem_convexHull_of_exists_fintype wt stdPts hw0 hw1 hp hsum + · apply convexHull_min + · intro z hz + rcases hz with ⟨i, rfl⟩ + fin_cases i <;> norm_num [stdPts, W] + · exact W_convex + +private theorem region_image : + (by + classical + exact + let faceDet (f : PeriodicSubtileFaceIndex) : ℝ := + let p0 := P4715T1Position (SixSubtileFaceVertices f 0) + let p1 := P4715T1Position (SixSubtileFaceVertices f 1) + let p2 := P4715T1Position (SixSubtileFaceVertices f 2) + p1.1 * p2.2 - p1.1 * p0.2 - p0.1 * p2.2 - p1.2 * p2.1 + + p1.2 * p0.1 + p0.2 * p2.1 + ∀ (delta_nonzero : ∀ (f : PeriodicSubtileFaceIndex), (P4715T1Position + (SixSubtileFaceVertices f 1) - P4715T1Position (SixSubtileFaceVertices f 0)).1 * + (P4715T1Position (SixSubtileFaceVertices f 2) - P4715T1Position + (SixSubtileFaceVertices f 0)).2 - (P4715T1Position (SixSubtileFaceVertices f 1) - + P4715T1Position (SixSubtileFaceVertices f 0)).2 * (P4715T1Position + (SixSubtileFaceVertices f 2) - P4715T1Position (SixSubtileFaceVertices f 0)).1 ≠ 0), + let lin (v w x : ℝ × ℝ) : ℝ × ℝ := + (x.1 * v.1 + x.2 * w.1, x.1 * v.2 + x.2 * w.2) + let invlin (v w x : ℝ × ℝ) : ℝ × ℝ := + let d := v.1 * w.2 - v.2 * w.1 + ((x.1 * w.2 - x.2 * w.1) / d, (v.1 * x.2 - v.2 * x.1) / d) + ∀ (inv_right : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → + (lin v w (invlin v w x) = x)), ∀ (inv_left : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × + ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → (invlin v w (lin v w x) = x)), + let affineHomeo (q v w : ℝ × ℝ) (hd : v.1 * w.2 - v.2 * w.1 ≠ 0) : + Homeomorph (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => q + lin v w x + invFun := fun y => invlin v w (y - q) + left_inv := fun x => by simp [inv_left, hd] + right_inv := fun y => by simp [inv_right, hd] + continuous_toFun := by dsimp [lin]; fun_prop + continuous_invFun := by dsimp [invlin]; fun_prop + } + let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1} + ∀ (f : PeriodicSubtileFaceIndex), (faceDet f ≠ 0) → (P4715T1Region f = affineHomeo + (P4715T1Position (SixSubtileFaceVertices f 0)) (P4715T1Position + (SixSubtileFaceVertices f 1) - P4715T1Position (SixSubtileFaceVertices f 0)) + (P4715T1Position (SixSubtileFaceVertices f 2) - P4715T1Position + (SixSubtileFaceVertices f 0)) (delta_nonzero f) '' D) ) := by + classical + intro faceDet delta_nonzero lin invlin inv_right inv_left affineHomeo D f hd + ext z + constructor + · rintro ⟨s,t,hs,ht,hst,rfl⟩ + refine ⟨(s,t), ⟨hs,ht,hst⟩, ?_⟩ + ext <;> simp [affineHomeo, lin] <;> ring + · rintro ⟨⟨s,t⟩, ⟨hs,ht,hst⟩, hz⟩ + refine ⟨s,t,hs,ht,hst, ?_⟩ + calc + z = affineHomeo + (P4715T1Position (SixSubtileFaceVertices f 0)) + (P4715T1Position (SixSubtileFaceVertices f 1) - P4715T1Position + (SixSubtileFaceVertices f 0)) + (P4715T1Position (SixSubtileFaceVertices f 2) - P4715T1Position + (SixSubtileFaceVertices f 0)) + (delta_nonzero f) (s,t) := hz.symm + _ = _ := by ext <;> simp [affineHomeo, lin] <;> ring + +private theorem W_decomp : + (by + classical + exact + let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1} + (IsOpen D) → ( + let W : Set (ℝ × ℝ) := {z | 0 ≤ z.1 ∧ 0 ≤ z.2 ∧ z.1+z.2 ≤ 1} + (D ⊆ W) → ((closure D = W) → (W = D ∪ frontier D))) ) := by + classical + intro D Dopen W D_subset_W D_closure + rw [Dopen.frontier_eq, D_closure] + ext z + constructor + · intro hz + by_cases hzD : z ∈ D + · exact Or.inl hzD + · exact Or.inr ⟨hz,hzD⟩ + · rintro (hzD | ⟨hzW, hzNot⟩) + · exact D_subset_W hzD + · exact hzW + +private theorem triangle_image : + (by + classical + exact + ∀ (delta_nonzero : ∀ (f : PeriodicSubtileFaceIndex), (P4715T1Position + (SixSubtileFaceVertices f 1) - P4715T1Position (SixSubtileFaceVertices f 0)).1 * + (P4715T1Position (SixSubtileFaceVertices f 2) - P4715T1Position + (SixSubtileFaceVertices f 0)).2 - (P4715T1Position (SixSubtileFaceVertices f 1) - + P4715T1Position (SixSubtileFaceVertices f 0)).2 * (P4715T1Position + (SixSubtileFaceVertices f 2) - P4715T1Position (SixSubtileFaceVertices f 0)).1 ≠ 0), + let lin (v w x : ℝ × ℝ) : ℝ × ℝ := + (x.1 * v.1 + x.2 * w.1, x.1 * v.2 + x.2 * w.2) + let invlin (v w x : ℝ × ℝ) : ℝ × ℝ := + let d := v.1 * w.2 - v.2 * w.1 + ((x.1 * w.2 - x.2 * w.1) / d, (v.1 * x.2 - v.2 * x.1) / d) + ∀ (inv_right : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → + (lin v w (invlin v w x) = x)), ∀ (inv_left : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × + ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → (invlin v w (lin v w x) = x)), + let affineHomeo (q v w : ℝ × ℝ) (hd : v.1 * w.2 - v.2 * w.1 ≠ 0) : + Homeomorph (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => q + lin v w x + invFun := fun y => invlin v w (y - q) + left_inv := fun x => by simp [inv_left, hd] + right_inv := fun y => by simp [inv_right, hd] + continuous_toFun := by dsimp [lin]; fun_prop + continuous_invFun := by dsimp [invlin]; fun_prop + } + let W : Set (ℝ × ℝ) := {z | 0 ≤ z.1 ∧ 0 ≤ z.2 ∧ z.1+z.2 ≤ 1} + let stdPts : Fin 3 → ℝ×ℝ := ![(0,0),(1,0),(0,1)] + let affineLin (v w : ℝ×ℝ) : (ℝ×ℝ) →ₗ[ℝ] (ℝ×ℝ) := { + toFun := lin v w + map_add' := by intro x y; ext <;> simp [lin] <;> ring + map_smul' := by intro c x; ext <;> simp [lin] <;> ring + } + let affineMapTri (q v w : ℝ×ℝ) : AffineMap ℝ (ℝ×ℝ) (ℝ×ℝ) := { + toFun := fun x => q + lin v w x + linear := affineLin v w + map_vadd' := by intro x y; ext <;> simp [affineLin,lin] <;> ring + } + (∀ (q : ℝ×ℝ), ∀ (v : ℝ×ℝ), ∀ (w : ℝ×ℝ), convexHull ℝ (affineMapTri q v w '' Set.range + stdPts) = affineMapTri q v w '' W) → (∀ (f : PeriodicSubtileFaceIndex), convexHull ℝ + (P4715T1Position '' Set.range (SixSubtileFaceVertices f)) = affineHomeo + (P4715T1Position (SixSubtileFaceVertices f 0)) (P4715T1Position + (SixSubtileFaceVertices f 1) - P4715T1Position (SixSubtileFaceVertices f 0)) + (P4715T1Position (SixSubtileFaceVertices f 2) - P4715T1Position + (SixSubtileFaceVertices f 0)) (delta_nonzero f) '' W) ) := by + classical + intro delta_nonzero lin invlin inv_right inv_left affineHomeo W stdPts affineLin affineMapTri + hull_affine f + let q := P4715T1Position (SixSubtileFaceVertices f 0) + let v := P4715T1Position (SixSubtileFaceVertices f 1) - q + let w := P4715T1Position (SixSubtileFaceVertices f 2) - q + have hv (i : Fin 3) : affineMapTri q v w (stdPts i) = + P4715T1Position (SixSubtileFaceVertices f i) := by + fin_cases i <;> ext <;> simp [affineMapTri, affineLin, lin, stdPts, q, v, w] + have himage : affineMapTri q v w '' Set.range stdPts = + P4715T1Position '' Set.range (SixSubtileFaceVertices f) := by + ext z + constructor + · rintro ⟨x,⟨i,rfl⟩,rfl⟩ + exact ⟨SixSubtileFaceVertices f i, ⟨i,rfl⟩, (hv i).symm⟩ + · rintro ⟨x,⟨i,rfl⟩,rfl⟩ + exact ⟨stdPts i, ⟨i,rfl⟩, hv i⟩ + have hmap : (affineMapTri q v w : (ℝ×ℝ) → ℝ×ℝ) = + affineHomeo q v w (delta_nonzero f) := by + funext x + rfl + rw [← himage, hull_affine] + rw [hmap] + +private theorem hconnected : + (by + classical + exact + let faceDet (f : PeriodicSubtileFaceIndex) : ℝ := + let p0 := P4715T1Position (SixSubtileFaceVertices f 0) + let p1 := P4715T1Position (SixSubtileFaceVertices f 1) + let p2 := P4715T1Position (SixSubtileFaceVertices f 2) + p1.1 * p2.2 - p1.1 * p0.2 - p0.1 * p2.2 - p1.2 * p2.1 + + p1.2 * p0.1 + p0.2 * p2.1 + (∀ (f : PeriodicSubtileFaceIndex), faceDet f ≠ 0) → (∀ (delta_nonzero : ∀ (f : + PeriodicSubtileFaceIndex), (P4715T1Position (SixSubtileFaceVertices f 1) - + P4715T1Position (SixSubtileFaceVertices f 0)).1 * (P4715T1Position + (SixSubtileFaceVertices f 2) - P4715T1Position (SixSubtileFaceVertices f 0)).2 - + (P4715T1Position (SixSubtileFaceVertices f 1) - P4715T1Position + (SixSubtileFaceVertices f 0)).2 * (P4715T1Position (SixSubtileFaceVertices f 2) - + P4715T1Position (SixSubtileFaceVertices f 0)).1 ≠ 0), + let lin (v w x : ℝ × ℝ) : ℝ × ℝ := + (x.1 * v.1 + x.2 * w.1, x.1 * v.2 + x.2 * w.2) + let invlin (v w x : ℝ × ℝ) : ℝ × ℝ := + let d := v.1 * w.2 - v.2 * w.1 + ((x.1 * w.2 - x.2 * w.1) / d, (v.1 * x.2 - v.2 * x.1) / d) + ∀ (inv_right : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → + (lin v w (invlin v w x) = x)), ∀ (inv_left : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × + ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → (invlin v w (lin v w x) = x)), + let affineHomeo (q v w : ℝ × ℝ) (hd : v.1 * w.2 - v.2 * w.1 ≠ 0) : + Homeomorph (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => q + lin v w x + invFun := fun y => invlin v w (y - q) + left_inv := fun x => by simp [inv_left, hd] + right_inv := fun y => by simp [inv_right, hd] + continuous_toFun := by dsimp [lin]; fun_prop + continuous_invFun := by dsimp [invlin]; fun_prop + } + let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1} + (Convex ℝ D) → ((D.Nonempty) → ((∀ (f : PeriodicSubtileFaceIndex), (faceDet f ≠ 0) → + (P4715T1Region f = affineHomeo (P4715T1Position (SixSubtileFaceVertices f 0)) + (P4715T1Position (SixSubtileFaceVertices f 1) - P4715T1Position + (SixSubtileFaceVertices f 0)) (P4715T1Position (SixSubtileFaceVertices f 2) - + P4715T1Position (SixSubtileFaceVertices f 0)) (delta_nonzero f) '' D)) → (∀ f, + IsConnected (P4715T1Region f)))))) := by + classical + intro faceDet faceDet_nonzero delta_nonzero lin invlin inv_right inv_left affineHomeo D Dconvex + D_nonempty region_image f + rw [region_image f (faceDet_nonzero f)] + exact (Dconvex.isConnected D_nonempty).image _ + (affineHomeo (P4715T1Position (SixSubtileFaceVertices f 0)) + (P4715T1Position (SixSubtileFaceVertices f 1) - P4715T1Position + (SixSubtileFaceVertices f 0)) + (P4715T1Position (SixSubtileFaceVertices f 2) - P4715T1Position + (SixSubtileFaceVertices f 0)) + (delta_nonzero f)).continuous.continuousOn + +private theorem triangle_decomp : + (by + classical + exact + let faceDet (f : PeriodicSubtileFaceIndex) : ℝ := + let p0 := P4715T1Position (SixSubtileFaceVertices f 0) + let p1 := P4715T1Position (SixSubtileFaceVertices f 1) + let p2 := P4715T1Position (SixSubtileFaceVertices f 2) + p1.1 * p2.2 - p1.1 * p0.2 - p0.1 * p2.2 - p1.2 * p2.1 + + p1.2 * p0.1 + p0.2 * p2.1 + (∀ (f : PeriodicSubtileFaceIndex), faceDet f ≠ 0) → (∀ (delta_nonzero : ∀ (f : + PeriodicSubtileFaceIndex), (P4715T1Position (SixSubtileFaceVertices f 1) - + P4715T1Position (SixSubtileFaceVertices f 0)).1 * (P4715T1Position + (SixSubtileFaceVertices f 2) - P4715T1Position (SixSubtileFaceVertices f 0)).2 - + (P4715T1Position (SixSubtileFaceVertices f 1) - P4715T1Position + (SixSubtileFaceVertices f 0)).2 * (P4715T1Position (SixSubtileFaceVertices f 2) - + P4715T1Position (SixSubtileFaceVertices f 0)).1 ≠ 0), + let lin (v w x : ℝ × ℝ) : ℝ × ℝ := + (x.1 * v.1 + x.2 * w.1, x.1 * v.2 + x.2 * w.2) + let invlin (v w x : ℝ × ℝ) : ℝ × ℝ := + let d := v.1 * w.2 - v.2 * w.1 + ((x.1 * w.2 - x.2 * w.1) / d, (v.1 * x.2 - v.2 * x.1) / d) + ∀ (inv_right : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → + (lin v w (invlin v w x) = x)), ∀ (inv_left : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × + ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → (invlin v w (lin v w x) = x)), + let affineHomeo (q v w : ℝ × ℝ) (hd : v.1 * w.2 - v.2 * w.1 ≠ 0) : + Homeomorph (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => q + lin v w x + invFun := fun y => invlin v w (y - q) + left_inv := fun x => by simp [inv_left, hd] + right_inv := fun y => by simp [inv_right, hd] + continuous_toFun := by dsimp [lin]; fun_prop + continuous_invFun := by dsimp [invlin]; fun_prop + } + let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1} + let W : Set (ℝ × ℝ) := {z | 0 ≤ z.1 ∧ 0 ≤ z.2 ∧ z.1+z.2 ≤ 1} + (frontier D = segment ℝ (0,0) (1,0) ∪ segment ℝ (1,0) (0,1) ∪ segment ℝ (0,0) (0,1)) → + ((∀ (q : ℝ×ℝ), ∀ (v : ℝ×ℝ), ∀ (w : ℝ×ℝ), ∀ (hd : v.1*w.2-v.2*w.1≠0), ∀ (x : ℝ×ℝ), ∀ + (y : ℝ×ℝ), affineHomeo q v w hd '' segment ℝ x y = segment ℝ (affineHomeo q v w + hd x) + (affineHomeo q v w hd y)) → ((∀ (f : PeriodicSubtileFaceIndex), (faceDet f ≠ 0) → + (P4715T1Region f = affineHomeo (P4715T1Position (SixSubtileFaceVertices f 0)) + (P4715T1Position (SixSubtileFaceVertices f 1) - P4715T1Position + (SixSubtileFaceVertices f 0)) (P4715T1Position (SixSubtileFaceVertices f 2) - + P4715T1Position (SixSubtileFaceVertices f 0)) (delta_nonzero f) '' D)) → ((W = D ∪ + frontier D) → ((∀ (f : PeriodicSubtileFaceIndex), convexHull ℝ (P4715T1Position '' + Set.range (SixSubtileFaceVertices f)) = affineHomeo (P4715T1Position + (SixSubtileFaceVertices f 0)) (P4715T1Position (SixSubtileFaceVertices f 1) - + P4715T1Position (SixSubtileFaceVertices f 0)) (P4715T1Position + (SixSubtileFaceVertices f 2) - P4715T1Position (SixSubtileFaceVertices f 0)) + (delta_nonzero f) '' W) → (∀ (f : PeriodicSubtileFaceIndex), (convexHull ℝ : Set (ℝ × + ℝ) → Set (ℝ × ℝ)) (P4715T1Position '' Set.range (SixSubtileFaceVertices f)) = + P4715T1Region f ∪ (P4715T1Arc (SixSubtileFaceVertices f (0 : Fin (3 : ℕ))) + (SixSubtileFaceVertices f (1 : Fin (3 : ℕ))) ∪ P4715T1Arc (SixSubtileFaceVertices f + (1 : Fin (3 : ℕ))) (SixSubtileFaceVertices f (2 : Fin (3 : ℕ))) ∪ P4715T1Arc + (SixSubtileFaceVertices f (2 : Fin (3 : ℕ))) (SixSubtileFaceVertices f (0 : Fin (3 : + ℕ))))))))))) := by + classical + intro faceDet faceDet_nonzero delta_nonzero lin invlin inv_right inv_left affineHomeo D W + D_frontier image_segment region_image W_decomp triangle_image f + let q := P4715T1Position (SixSubtileFaceVertices f 0) + let v := P4715T1Position (SixSubtileFaceVertices f 1) - q + let w := P4715T1Position (SixSubtileFaceVertices f 2) - q + let E := affineHomeo q v w (delta_nonzero f) + rw [triangle_image f, W_decomp, Set.image_union] + rw [region_image f (faceDet_nonzero f), D_frontier] + rw [Set.image_union, Set.image_union] + rw [image_segment q v w (delta_nonzero f), image_segment q v w (delta_nonzero f), + image_segment q v w (delta_nonzero f)] + have e0 : E (0,0) = P4715T1Position (SixSubtileFaceVertices f 0) := by + simp [E, affineHomeo, lin, q] + have e1 : E (1,0) = P4715T1Position (SixSubtileFaceVertices f 1) := by + ext <;> simp [E, affineHomeo, lin, q, v] + have e2 : E (0,1) = P4715T1Position (SixSubtileFaceVertices f 2) := by + ext <;> simp [E, affineHomeo, lin, q, w] + simp only [P4715T1Arc] + rw [e0, e1, e2] + rw [segment_symm ℝ (P4715T1Position (SixSubtileFaceVertices f 2)) + (P4715T1Position (SixSubtileFaceVertices f 0))] + +private theorem std_edge_disjoint : + (by + classical + exact + let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1} + (∀ (z : ℝ×ℝ), z ∈ segment ℝ (0,0) (1,0) ↔ z.2=0 ∧ 0≤z.1 ∧ z.1≤1) → ((∀ (z : ℝ×ℝ), z ∈ + segment ℝ (1,0) (0,1) ↔ z.1+z.2=1 ∧ 0≤z.1 ∧ 0≤z.2) → ((∀ (z : ℝ×ℝ), z ∈ segment ℝ + (0,0) (0,1) ↔ z.1=0 ∧ 0≤z.2 ∧ z.2≤1) → ( + let stdPts : Fin 3 → ℝ×ℝ := ![(0,0),(1,0),(0,1)] + ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), i ≠ j → Disjoint D (segment ℝ (stdPts i) + (stdPts j))))) ) := by + classical + intro D mem_bottom_segment mem_diagonal_segment mem_left_segment stdPts i j hij + rw [Set.disjoint_left] + intro z hzD hzS + fin_cases i <;> fin_cases j + · exact (hij rfl).elim + · have hc := (mem_bottom_segment z).mp (by simpa [stdPts] using hzS) + exact (not_lt_of_ge (by simp [hc.1] : z.2 ≤ 0)) hzD.2.1 + · have hc := (mem_left_segment z).mp (by simpa [stdPts] using hzS) + exact (not_lt_of_ge (by simp [hc.1] : z.1 ≤ 0)) hzD.1 + · have hc := (mem_bottom_segment z).mp (by simpa [stdPts, segment_symm ℝ] using hzS) + exact (not_lt_of_ge (by simp [hc.1] : z.2 ≤ 0)) hzD.2.1 + · exact (hij rfl).elim + · have hc := (mem_diagonal_segment z).mp (by simpa [stdPts] using hzS) + exact (not_lt_of_ge (le_of_eq hc.1.symm)) hzD.2.2 + · have hc := (mem_left_segment z).mp (by simpa [stdPts, segment_symm ℝ] using hzS) + exact (not_lt_of_ge (by simp [hc.1] : z.1 ≤ 0)) hzD.1 + · have hc := (mem_diagonal_segment z).mp (by simpa [stdPts, segment_symm ℝ] using hzS) + exact (not_lt_of_ge (le_of_eq hc.1.symm)) hzD.2.2 + · exact (hij rfl).elim + +private theorem region_disjoint_arc : + (by + classical + exact + let faceDet (f : PeriodicSubtileFaceIndex) : ℝ := + let p0 := P4715T1Position (SixSubtileFaceVertices f 0) + let p1 := P4715T1Position (SixSubtileFaceVertices f 1) + let p2 := P4715T1Position (SixSubtileFaceVertices f 2) + p1.1 * p2.2 - p1.1 * p0.2 - p0.1 * p2.2 - p1.2 * p2.1 + + p1.2 * p0.1 + p0.2 * p2.1 + (∀ (f : PeriodicSubtileFaceIndex), faceDet f ≠ 0) → (∀ (delta_nonzero : ∀ (f : + PeriodicSubtileFaceIndex), (P4715T1Position (SixSubtileFaceVertices f 1) - + P4715T1Position (SixSubtileFaceVertices f 0)).1 * (P4715T1Position + (SixSubtileFaceVertices f 2) - P4715T1Position (SixSubtileFaceVertices f 0)).2 - + (P4715T1Position (SixSubtileFaceVertices f 1) - P4715T1Position + (SixSubtileFaceVertices f 0)).2 * (P4715T1Position (SixSubtileFaceVertices f 2) - + P4715T1Position (SixSubtileFaceVertices f 0)).1 ≠ 0), + let lin (v w x : ℝ × ℝ) : ℝ × ℝ := + (x.1 * v.1 + x.2 * w.1, x.1 * v.2 + x.2 * w.2) + let invlin (v w x : ℝ × ℝ) : ℝ × ℝ := + let d := v.1 * w.2 - v.2 * w.1 + ((x.1 * w.2 - x.2 * w.1) / d, (v.1 * x.2 - v.2 * x.1) / d) + ∀ (inv_right : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → + (lin v w (invlin v w x) = x)), ∀ (inv_left : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × + ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → (invlin v w (lin v w x) = x)), + let affineHomeo (q v w : ℝ × ℝ) (hd : v.1 * w.2 - v.2 * w.1 ≠ 0) : + Homeomorph (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => q + lin v w x + invFun := fun y => invlin v w (y - q) + left_inv := fun x => by simp [inv_left, hd] + right_inv := fun y => by simp [inv_right, hd] + continuous_toFun := by dsimp [lin]; fun_prop + continuous_invFun := by dsimp [invlin]; fun_prop + } + let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1} + (∀ (q : ℝ×ℝ), ∀ (v : ℝ×ℝ), ∀ (w : ℝ×ℝ), ∀ (hd : v.1*w.2-v.2*w.1≠0), ∀ (x : ℝ×ℝ), ∀ (y : + ℝ×ℝ), affineHomeo q v w hd '' segment ℝ x y = segment ℝ (affineHomeo q v w hd x) + (affineHomeo q v w hd y)) → ( + let stdPts : Fin 3 → ℝ×ℝ := ![(0,0),(1,0),(0,1)] + (∀ (f : PeriodicSubtileFaceIndex), (faceDet f ≠ 0) → (P4715T1Region f = affineHomeo + (P4715T1Position (SixSubtileFaceVertices f 0)) (P4715T1Position + (SixSubtileFaceVertices f 1) - P4715T1Position (SixSubtileFaceVertices f 0)) + (P4715T1Position (SixSubtileFaceVertices f 2) - P4715T1Position + (SixSubtileFaceVertices f 0)) (delta_nonzero f) '' D)) → ((∀ (i : Fin 3), ∀ (j : Fin + 3), (i ≠ j) → (Disjoint D (segment ℝ (stdPts i) (stdPts j)))) → (∀ (f : + PeriodicSubtileFaceIndex), ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), i ≠ j → + Disjoint + (P4715T1Region f) (P4715T1Arc (SixSubtileFaceVertices f i) + (SixSubtileFaceVertices f j))))))) := by + classical + intro faceDet faceDet_nonzero delta_nonzero lin invlin inv_right inv_left affineHomeo D + image_segment stdPts region_image std_edge_disjoint f i j hij + let q := P4715T1Position (SixSubtileFaceVertices f 0) + let v := P4715T1Position (SixSubtileFaceVertices f 1) - q + let w := P4715T1Position (SixSubtileFaceVertices f 2) - q + let E := affineHomeo q v w (delta_nonzero f) + have hstd (r : Fin 3) : E (stdPts r) = + P4715T1Position (SixSubtileFaceVertices f r) := by + fin_cases r <;> ext <;> simp [stdPts, E, affineHomeo, lin, q, v, w] + rw [Set.disjoint_left] + intro z hzR hzA + rw [region_image f (faceDet_nonzero f)] at hzR + change z ∈ segment ℝ + (P4715T1Position (SixSubtileFaceVertices f i)) + (P4715T1Position (SixSubtileFaceVertices f j)) at hzA + rw [← hstd i, ← hstd j] at hzA + rw [← image_segment q v w (delta_nonzero f) (stdPts i) (stdPts j)] at hzA + rcases hzR with ⟨x, hxD, rfl⟩ + rcases hzA with ⟨y, hyS, hxy⟩ + have hxy' : x = y := E.injective hxy.symm + subst y + exact (Set.disjoint_left.mp (std_edge_disjoint i j hij)) hxD hyS + +private theorem region_shift : + (by + classical + exact + let translation (k : Int × Int) : AffineMap ℝ (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => x + ((k.1 : Real), (k.2 : Real)) + linear := LinearMap.id + map_vadd' := by intro x y; simp [add_assoc] + } + let bary (f : PeriodicSubtileFaceIndex) (s t : Real) : ℝ × ℝ := + (1 - s - t) • P4715T1Position (SixSubtileFaceVertices f 0) + + s • P4715T1Position (SixSubtileFaceVertices f 1) + + t • P4715T1Position (SixSubtileFaceVertices f 2) + (∀ (k : Int × Int), ∀ (j : Fin 12), ∀ (s : Real), ∀ (t : Real), bary (P4715T1FaceShift + k (P4715T1PatchFaces j)) s t = translation k (bary (P4715T1PatchFaces j) s t)) → + (∀ (k : ℤ × ℤ), ∀ (j : Fin (12 : ℕ)), P4715T1Region (P4715T1FaceShift k + (P4715T1PatchFaces j)) = (⇑(translation k) : ℝ × ℝ → ℝ × ℝ) '' P4715T1Region + (P4715T1PatchFaces j)) ) := by + classical + intro translation bary bary_shift k j + ext z + constructor + · rintro ⟨s,t,hs,ht,hst,hz⟩ + refine ⟨bary (P4715T1PatchFaces j) s t, + ⟨s,t,hs,ht,hst,rfl⟩, ?_⟩ + change z = bary (P4715T1FaceShift k (P4715T1PatchFaces j)) s t at hz + rw [bary_shift] at hz + exact hz.symm + · rintro ⟨y, ⟨s,t,hs,ht,hst,hy⟩, hz⟩ + subst y + refine ⟨s,t,hs,ht,hst, ?_⟩ + change z = bary (P4715T1FaceShift k (P4715T1PatchFaces j)) s t + rw [bary_shift] + exact hz.symm + +private theorem translated_triangle : + (by + classical + exact + (∀ (k : Int × Int), ∀ (a : PeriodicSubtileIndex), P4715T1Position + (P4715T1VertexShift k a) = P4715T1Position a + ((k.1 : Real), (k.2 : Real))) → + ((∀ (k : Int × Int), ∀ (j : Fin 12), ∀ (i : Fin 3), SixSubtileFaceVertices + (P4715T1FaceShift k (P4715T1PatchFaces j)) i = + P4715T1VertexShift k (SixSubtileFaceVertices (P4715T1PatchFaces j) i)) → ( + let translation (k : Int × Int) : AffineMap ℝ (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => x + ((k.1 : Real), (k.2 : Real)) + linear := LinearMap.id + map_vadd' := by intro x y; simp [add_assoc] + } + ∀ (k : ℤ × ℤ), ∀ (j : Fin (12 : ℕ)), (⇑(translation k) : ℝ × ℝ → ℝ × ℝ) '' (convexHull ℝ + : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (P4715T1Position '' Set.range (SixSubtileFaceVertices + (P4715T1PatchFaces j))) = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (P4715T1Position '' Set.range (SixSubtileFaceVertices (P4715T1FaceShift k + (P4715T1PatchFaces j))))))) := by + classical + intro position_shift face_vertex_shift translation k j + rw [AffineMap.image_convexHull] + congr 1 + ext z + constructor + · rintro ⟨x, ⟨a, ⟨i, rfl⟩, rfl⟩, rfl⟩ + exact ⟨SixSubtileFaceVertices (P4715T1FaceShift k (P4715T1PatchFaces j)) i, + ⟨i, rfl⟩, by dsimp [translation]; rw [face_vertex_shift, position_shift]⟩ + · rintro ⟨a, ⟨i, rfl⟩, rfl⟩ + refine ⟨P4715T1Position (SixSubtileFaceVertices (P4715T1PatchFaces j) i), + ⟨SixSubtileFaceVertices (P4715T1PatchFaces j) i, ⟨i, rfl⟩, rfl⟩, ?_⟩ + dsimp [translation] + rw [face_vertex_shift, position_shift] + +private theorem region_subset_tile : + (by + classical + exact + (⋃ (j : Fin (12 : ℕ)), (fun (j : Fin (12 : ℕ)) => (convexHull ℝ : Set (ℝ × ℝ) + → Set (ℝ × ℝ)) (P4715T1Position '' (fun (j : Fin (12 : ℕ)) => Set.range + (SixSubtileFaceVertices (P4715T1PatchFaces j))) j)) j = P4715T1Hexagon) → ((∀ (f + : PeriodicSubtileFaceIndex), P4715T1Region f ⊆ + convexHull ℝ (P4715T1Position '' Set.range (SixSubtileFaceVertices f))) → ( + let translation (k : Int × Int) : AffineMap ℝ (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => x + ((k.1 : Real), (k.2 : Real)) + linear := LinearMap.id + map_vadd' := by intro x y; simp [add_assoc] + } + (∀ (k : Int × Int), ∀ (j : Fin 12), translation k '' convexHull ℝ (P4715T1Position '' + Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j))) = convexHull ℝ + (P4715T1Position '' Set.range (SixSubtileFaceVertices (P4715T1FaceShift k + (P4715T1PatchFaces j))))) → (∀ (k : ℤ × ℤ), ∀ (j : Fin (12 : ℕ)), P4715T1Region + (P4715T1FaceShift k (P4715T1PatchFaces j)) ⊆ (⇑(translation k) : ℝ × ℝ → ℝ × ℝ) + '' P4715T1Hexagon)))) := by + classical + intro hpatch region_subset_triangle translation translated_triangle k j z hz + have hzTri := region_subset_triangle (P4715T1FaceShift k (P4715T1PatchFaces j)) hz + rw [← translated_triangle k j] at hzTri + rcases hzTri with ⟨y, hyK, rfl⟩ + have hyHex : y ∈ P4715T1Hexagon := by + rw [← hpatch] + exact Set.mem_iUnion.mpr ⟨j, hyK⟩ + exact ⟨y, hyHex, rfl⟩ + +private theorem common_hull_subset_arc : + (by + classical + exact + (∀ (i : Fin 12), ∀ (j : Fin 12), (i ≠ j) → (∃ a b : Fin 3, a ≠ b ∧ ∀ r : Fin 3, + SixSubtileFaceVertices (P4715T1PatchFaces i) r ∈ Set.range (SixSubtileFaceVertices + (P4715T1PatchFaces j)) → r = a ∨ r = b)) → (∀ (i : Fin (12 : ℕ)), ∀ (j : Fin (12 : + ℕ)), i ≠ j → ∃ (a : Fin (3 : ℕ)) (b : Fin (3 : ℕ)), a ≠ b ∧ (convexHull ℝ : Set (ℝ × + ℝ) → Set (ℝ × ℝ)) (P4715T1Position '' (Set.range (SixSubtileFaceVertices + (P4715T1PatchFaces i)) ∩ Set.range (SixSubtileFaceVertices (P4715T1PatchFaces + j)))) ⊆ P4715T1Arc (SixSubtileFaceVertices (P4715T1PatchFaces i) a) + (SixSubtileFaceVertices (P4715T1PatchFaces i) b)) ) := by + classical + intro common_edge i j hij + obtain ⟨a,b,hab,hcommon⟩ := common_edge i j hij + refine ⟨a,b,hab, ?_⟩ + rw [P4715T1Arc] + rw [← convexHull_pair] + apply convexHull_mono + intro z hz + rcases hz with ⟨u, hu, rfl⟩ + rcases hu with ⟨hu1, hu2⟩ + rcases Set.mem_range.mp hu1 with ⟨r, hr⟩ + have hmem : SixSubtileFaceVertices (P4715T1PatchFaces i) r ∈ + Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j)) := by + simpa [hr] using hu2 + rw [← hr] + rcases hcommon r hmem with h | h + · rw [h] + simp + · rw [h] + simp + +private theorem plane_cover : + (by + classical + exact + (⋃ (k : ℤ × ℤ), (fun (p : ℝ × ℝ) => p + ((↑k.1 : ℝ), (↑k.2 : ℝ))) '' + P4715T1Hexagon = Set.univ) → ((⋃ (j : Fin (12 : ℕ)), (fun (j : Fin (12 : + ℕ)) => (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (P4715T1Position '' (fun (j : Fin + (12 : ℕ)) => Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j))) j)) j = + P4715T1Hexagon) → ((∀ (f : PeriodicSubtileFaceIndex), ∀ (i : Fin (3 : + ℕ)), ∀ (j : Fin (3 : ℕ)), i ≠ j → AllowedSubtileIncidence (SixSubtileFaceVertices f + i) (SixSubtileFaceVertices f j)) → ((∀ (f : PeriodicSubtileFaceIndex), convexHull ℝ + (P4715T1Position '' Set.range + (SixSubtileFaceVertices f)) = P4715T1Region f ∪ ( P4715T1Arc + (SixSubtileFaceVertices f 0) (SixSubtileFaceVertices f 1) ∪ P4715T1Arc + (SixSubtileFaceVertices f 1) (SixSubtileFaceVertices f 2) ∪ P4715T1Arc + (SixSubtileFaceVertices f 2) (SixSubtileFaceVertices f 0))) → ( + let translation (k : Int × Int) : AffineMap ℝ (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => x + ((k.1 : Real), (k.2 : Real)) + linear := LinearMap.id + map_vadd' := by intro x y; simp [add_assoc] + } + (∀ (k : Int × Int), ∀ (j : Fin 12), translation k '' convexHull ℝ (P4715T1Position '' + Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j))) = convexHull ℝ + (P4715T1Position '' Set.range (SixSubtileFaceVertices (P4715T1FaceShift k + (P4715T1PatchFaces j))))) → (Set.range P4715T1Position ∪ {p | ∃ a b, + AllowedSubtileIncidence a b ∧ p ∈ P4715T1Arc a b} ∪ {p | ∃ f, p ∈ P4715T1Region + f} = Set.univ)))))) := by + classical + intro hcover hpatch hallowed triangle_decomp translation translated_triangle + ext p + constructor + · intro _ + exact Set.mem_univ p + · intro _ + have hphex : p ∈ ⋃ k : Int × Int, + (fun x : ℝ × ℝ => x + ((k.1 : Real), (k.2 : Real))) '' P4715T1Hexagon := by + rw [hcover] + exact Set.mem_univ p + rcases Set.mem_iUnion.mp hphex with ⟨k, ⟨x, hx, rfl⟩⟩ + rw [← hpatch] at hx + have hxpatch : x ∈ ⋃ j : Fin 12, + convexHull ℝ (P4715T1Position '' Set.range + (SixSubtileFaceVertices (P4715T1PatchFaces j))) := by + exact hx + rcases Set.mem_iUnion.mp hxpatch with ⟨j, hxK⟩ + let f := P4715T1FaceShift k (P4715T1PatchFaces j) + have hpK : translation k x ∈ convexHull ℝ + (P4715T1Position '' Set.range (SixSubtileFaceVertices f)) := by + rw [← translated_triangle k j] + exact ⟨x, hxK, rfl⟩ + rw [triangle_decomp f] at hpK + rcases hpK with hpR | hpSide + · exact Or.inr ⟨f, hpR⟩ + · rcases hpSide with hp12or01 | hp20 + · rcases hp12or01 with hp01 | hp12 + · exact Or.inl (Or.inr ⟨SixSubtileFaceVertices f 0, + SixSubtileFaceVertices f 1, hallowed f 0 1 (by decide), hp01⟩) + · exact Or.inl (Or.inr ⟨SixSubtileFaceVertices f 1, + SixSubtileFaceVertices f 2, hallowed f 1 2 (by decide), hp12⟩) + · exact Or.inl (Or.inr ⟨SixSubtileFaceVertices f 2, + SixSubtileFaceVertices f 0, hallowed f 2 0 (by decide), hp20⟩) + +private theorem pairwise_regions : + (by + classical + exact + (Pairwise fun (k l : ℤ × ℤ) => Disjoint (interior ((fun (p : ℝ × ℝ) => p + + ((↑k.1 : ℝ), (↑k.2 : ℝ))) '' P4715T1Hexagon)) (interior ((fun (p : ℝ × ℝ) => p + + ((↑l.1 : ℝ), (↑l.2 : ℝ))) '' P4715T1Hexagon))) → ((∀ (i : Fin (12 : ℕ)), ∀ (j : Fin + (12 : ℕ)), i ≠ j → (fun (j : Fin (12 : ℕ)) => (convexHull ℝ : Set (ℝ × ℝ) → + Set (ℝ × ℝ)) (P4715T1Position '' (fun (j : Fin (12 : ℕ)) => Set.range + (SixSubtileFaceVertices (P4715T1PatchFaces j))) j)) i ∩ (fun (j : Fin (12 : ℕ)) => + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (P4715T1Position '' (fun (j : Fin (12 : + ℕ)) => Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j))) j)) j = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (P4715T1Position '' ((fun (j : Fin (12 : + ℕ)) => Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j))) i ∩ (fun (j : Fin + (12 : ℕ)) => Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j))) j))) → ((∀ + f, IsOpen (P4715T1Region f)) → ((∀ (f : PeriodicSubtileFaceIndex), + P4715T1Region f ⊆ convexHull ℝ (P4715T1Position '' + Set.range (SixSubtileFaceVertices f))) → ((∀ (f : PeriodicSubtileFaceIndex), ∀ (i : + Fin 3), ∀ (j : Fin 3), (i ≠ j) → (Disjoint + (P4715T1Region f) (P4715T1Arc (SixSubtileFaceVertices f i) + (SixSubtileFaceVertices f j)))) → ( + let translation (k : Int × Int) : AffineMap ℝ (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => x + ((k.1 : Real), (k.2 : Real)) + linear := LinearMap.id + map_vadd' := by intro x y; simp [add_assoc] + } + (∀ (k : Int × Int), ∀ (j : Fin 12), P4715T1Region (P4715T1FaceShift k + (P4715T1PatchFaces j)) = translation k '' P4715T1Region (P4715T1PatchFaces j)) + → ((∀ (k : Int × Int), ∀ (j : Fin 12), P4715T1Region (P4715T1FaceShift k + (P4715T1PatchFaces j)) ⊆ translation k '' P4715T1Hexagon) → ((∀ (i : Fin 12), ∀ + (j : Fin 12), (i ≠ j) → (∃ a b : Fin 3, a ≠ b ∧ convexHull ℝ (P4715T1Position '' + (Set.range (SixSubtileFaceVertices (P4715T1PatchFaces i)) ∩ Set.range + (SixSubtileFaceVertices (P4715T1PatchFaces j))) ) ⊆ P4715T1Arc + (SixSubtileFaceVertices (P4715T1PatchFaces i) a) (SixSubtileFaceVertices + (P4715T1PatchFaces i) b))) → ((∀ (k : Int × Int), Function.Injective (translation + k)) → (Pairwise fun f g => Disjoint (P4715T1Region f) (P4715T1Region g))))))))))) + := by + classical + intro hdisj hlocal hopen region_subset_triangle region_disjoint_arc translation region_shift + region_subset_tile common_hull_subset_arc translation_injective f g hfg + rw [Set.disjoint_left] + intro x hxf hxg + obtain ⟨af, haf, _⟩ := P4715T1PatchEnumeration f + obtain ⟨ag, hag, _⟩ := P4715T1PatchEnumeration g + rcases af with ⟨k,j⟩ + rcases ag with ⟨l,i⟩ + by_cases hkl : k = l + · subst l + have hji : j ≠ i := by + intro hji + apply hfg + calc + f = P4715T1FaceShift k (P4715T1PatchFaces j) := haf.symm + _ = P4715T1FaceShift k (P4715T1PatchFaces i) := by rw [hji] + _ = g := hag + rw [← haf, region_shift k j] at hxf + rw [← hag, region_shift k i] at hxg + rcases hxf with ⟨y, hyf, hxy⟩ + rcases hxg with ⟨y', hyg, hxy'⟩ + have hyy : y = y' := translation_injective k (hxy.trans hxy'.symm) + subst y' + have hyK : y ∈ + convexHull ℝ (P4715T1Position '' Set.range + (SixSubtileFaceVertices (P4715T1PatchFaces j))) ∩ + convexHull ℝ (P4715T1Position '' Set.range + (SixSubtileFaceVertices (P4715T1PatchFaces i))) := by + exact ⟨region_subset_triangle _ hyf, region_subset_triangle _ hyg⟩ + rw [hlocal j i hji] at hyK + obtain ⟨a,b,hab,hside⟩ := common_hull_subset_arc j i hji + exact (Set.disjoint_left.mp + (region_disjoint_arc (P4715T1PatchFaces j) a b hab)) hyf (hside hyK) + · have hsubf : P4715T1Region f ⊆ + translation k '' P4715T1Hexagon := by + rw [← haf] + exact region_subset_tile k j + have hsubg : P4715T1Region g ⊆ + translation l '' P4715T1Hexagon := by + rw [← hag] + exact region_subset_tile l i + have hxk : x ∈ interior (translation k '' P4715T1Hexagon) := + mem_interior_iff_mem_nhds.mpr + (Filter.mem_of_superset ((hopen f).mem_nhds hxf) hsubf) + have hxl : x ∈ interior (translation l '' P4715T1Hexagon) := + mem_interior_iff_mem_nhds.mpr + (Filter.mem_of_superset ((hopen g).mem_nhds hxg) hsubg) + exact (Set.disjoint_left.mp (hdisj hkl)) hxk hxl + +end CoefficientFaceProof + +namespace CoefficientFaceTopology + +private theorem position_shift : + (by + classical + exact + ∀ (k : ℤ × ℤ), ∀ (a : PeriodicSubtileIndex), P4715T1Position (P4715T1VertexShift k a) + = P4715T1Position a + ((↑k.1 : ℝ), (↑k.2 : ℝ)) ) := by + classical + intro k a + rcases a with ⟨l, m, n⟩ + change ((((m + k.1 : Int) : Real), ((n + k.2 : Int) : Real)) + P4715T1Offsets l) = + ((((m : Real), (n : Real)) + P4715T1Offsets l) + ((k.1 : Real), (k.2 : Real))) + ext <;> simp only [Prod.fst_add, Prod.snd_add] <;> push_cast <;> ring + +private theorem face_vertex_shift : + (by + classical + exact + ∀ (k : ℤ × ℤ), ∀ (j : Fin (12 : ℕ)), ∀ (i : Fin (3 : ℕ)), SixSubtileFaceVertices + (P4715T1FaceShift k (P4715T1PatchFaces j)) i = P4715T1VertexShift k + (SixSubtileFaceVertices (P4715T1PatchFaces j) i) ) := by + classical + intro k j i + rcases k with ⟨m,n⟩ + fin_cases j <;> fin_cases i <;> + simp [P4715T1FaceShift, P4715T1VertexShift, P4715T1PatchFaces, + SixSubtileFaceVertices] <;> omega + +private theorem faceDet_nonzero : + (by + classical + exact + let faceDet (f : PeriodicSubtileFaceIndex) : ℝ := + let p0 := P4715T1Position (SixSubtileFaceVertices f 0) + let p1 := P4715T1Position (SixSubtileFaceVertices f 1) + let p2 := P4715T1Position (SixSubtileFaceVertices f 2) + p1.1 * p2.2 - p1.1 * p0.2 - p0.1 * p2.2 - p1.2 * p2.1 + + p1.2 * p0.1 + p0.2 * p2.1 + ∀ (f : PeriodicSubtileFaceIndex), faceDet f ≠ (0 : ℝ) ) := by + classical + intro faceDet f + rcases f with ⟨l, m, n⟩ + cases l <;> simp [faceDet, P4715T1Position, P4715T1Offsets, + SixSubtileFaceVertices] <;> ring_nf <;> norm_num + +private theorem inv_right : + (by + classical + exact + let lin (v w x : ℝ × ℝ) : ℝ × ℝ := + (x.1 * v.1 + x.2 * w.1, x.1 * v.2 + x.2 * w.2) + let invlin (v w x : ℝ × ℝ) : ℝ × ℝ := + let d := v.1 * w.2 - v.2 * w.1 + ((x.1 * w.2 - x.2 * w.1) / d, (v.1 * x.2 - v.2 * x.1) / d) + ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × ℝ), v.1 * w.2 - v.2 * w.1 ≠ (0 : ℝ) → lin v w + (invlin v w x) = x ) := by + classical + intro lin invlin v w x hd + dsimp [lin, invlin] + have hd' : w.2 * v.1 - w.1 * v.2 ≠ 0 := by simpa [mul_comm] using hd + apply Prod.ext <;> field_simp [hd'] <;> ring + +private theorem inv_left : + (by + classical + exact + let lin (v w x : ℝ × ℝ) : ℝ × ℝ := + (x.1 * v.1 + x.2 * w.1, x.1 * v.2 + x.2 * w.2) + let invlin (v w x : ℝ × ℝ) : ℝ × ℝ := + let d := v.1 * w.2 - v.2 * w.1 + ((x.1 * w.2 - x.2 * w.1) / d, (v.1 * x.2 - v.2 * x.1) / d) + ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × ℝ), v.1 * w.2 - v.2 * w.1 ≠ (0 : ℝ) → invlin v w + (lin v w x) = x ) := by + classical + intro lin invlin v w x hd + dsimp [lin, invlin] + have hd' : v.1 * w.2 - w.1 * v.2 ≠ 0 := by simpa [mul_comm] using hd + apply Prod.ext <;> field_simp [hd'] <;> ring + +private theorem Dopen : + (by + classical + exact + let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1} + IsOpen D ) := by + classical + intro D + change IsOpen ({x : ℝ × ℝ | 0 < x.1} ∩ + ({x | 0 < x.2} ∩ {x | x.1 + x.2 < 1})) + apply (isOpen_lt continuous_const continuous_fst).inter + apply (isOpen_lt continuous_const continuous_snd).inter + exact isOpen_lt (continuous_fst.add continuous_snd) continuous_const + +private theorem D_nonempty : + (by + classical + exact + let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1} + D.Nonempty ) := by + classical + intro D + refine ⟨(1/3,1/3), ?_⟩ + norm_num [D] + +private theorem D_subset_W : + (by + classical + exact + let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1} + let W : Set (ℝ × ℝ) := {z | 0 ≤ z.1 ∧ 0 ≤ z.2 ∧ z.1+z.2 ≤ 1} + D ⊆ W ) := by + classical + intro D W z hz + exact ⟨le_of_lt hz.1, le_of_lt hz.2.1, le_of_lt hz.2.2⟩ + +private theorem W_closed : + (by + classical + exact + let W : Set (ℝ × ℝ) := {z | 0 ≤ z.1 ∧ 0 ≤ z.2 ∧ z.1+z.2 ≤ 1} + IsClosed W ) := by + classical + intro W + change IsClosed ({z : ℝ × ℝ | 0 ≤ z.1} ∩ + ({z | 0 ≤ z.2} ∩ {z | z.1+z.2 ≤ 1})) + apply (isClosed_Ici.preimage continuous_fst).inter + apply (isClosed_Ici.preimage continuous_snd).inter + exact isClosed_Iic.preimage (continuous_fst.add continuous_snd) + +private theorem image_segment : + (by + classical + exact + let lin (v w x : ℝ × ℝ) : ℝ × ℝ := + (x.1 * v.1 + x.2 * w.1, x.1 * v.2 + x.2 * w.2) + let invlin (v w x : ℝ × ℝ) : ℝ × ℝ := + let d := v.1 * w.2 - v.2 * w.1 + ((x.1 * w.2 - x.2 * w.1) / d, (v.1 * x.2 - v.2 * x.1) / d) + ∀ (inv_right : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → + (lin v w (invlin v w x) = x)), ∀ (inv_left : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × + ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → (invlin v w (lin v w x) = x)), + let affineHomeo (q v w : ℝ × ℝ) (hd : v.1 * w.2 - v.2 * w.1 ≠ 0) : + Homeomorph (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => q + lin v w x + invFun := fun y => invlin v w (y - q) + left_inv := fun x => by simp [inv_left, hd] + right_inv := fun y => by simp [inv_right, hd] + continuous_toFun := by dsimp [lin]; fun_prop + continuous_invFun := by dsimp [invlin]; fun_prop + } + ∀ (q : ℝ × ℝ), ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (hd : v.1 * w.2 - v.2 * w.1 ≠ (0 : ℝ)), ∀ + (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), (⇑(affineHomeo q v w hd) : ℝ × ℝ → ℝ × ℝ) '' segment ℝ x + y = segment ℝ ((affineHomeo q v w hd : ℝ × ℝ → ℝ × ℝ) x) ((affineHomeo q v w hd : ℝ × + ℝ → ℝ × ℝ) y) ) := by + classical + intro lin invlin inv_right inv_left affineHomeo q v w hd x y + rw [segment_eq_image_lineMap, segment_eq_image_lineMap] + simp only [Set.image_image] + congr 1 + funext t + ext <;> simp [affineHomeo, lin, AffineMap.lineMap_apply] <;> ring + +private theorem W_convex : + (by + classical + exact + let W : Set (ℝ × ℝ) := {z | 0 ≤ z.1 ∧ 0 ≤ z.2 ∧ z.1+z.2 ≤ 1} + Convex ℝ W ) := by + classical + intro W x hx y hy a b ha hb hab + dsimp [W] at hx hy ⊢ + constructor + · nlinarith [mul_nonneg ha hx.1, mul_nonneg hb hy.1] + · constructor + · nlinarith [mul_nonneg ha hx.2.1, mul_nonneg hb hy.2.1] + · nlinarith [mul_nonneg ha (by linarith [hx.2.2] : 0 ≤ 1-(x.1+x.2)), + mul_nonneg hb (by linarith [hy.2.2] : 0 ≤ 1-(y.1+y.2))] + +private theorem hull_affine : + (by + classical + exact + let lin (v w x : ℝ × ℝ) : ℝ × ℝ := + (x.1 * v.1 + x.2 * w.1, x.1 * v.2 + x.2 * w.2) + let W : Set (ℝ × ℝ) := {z | 0 ≤ z.1 ∧ 0 ≤ z.2 ∧ z.1+z.2 ≤ 1} + let stdPts : Fin 3 → ℝ×ℝ := ![(0,0),(1,0),(0,1)] + (W = convexHull ℝ (Set.range stdPts)) → ( + let affineLin (v w : ℝ×ℝ) : (ℝ×ℝ) →ₗ[ℝ] (ℝ×ℝ) := { + toFun := lin v w + map_add' := by intro x y; ext <;> simp [lin] <;> ring + map_smul' := by intro c x; ext <;> simp [lin] <;> ring + } + let affineMapTri (q v w : ℝ×ℝ) : AffineMap ℝ (ℝ×ℝ) (ℝ×ℝ) := { + toFun := fun x => q + lin v w x + linear := affineLin v w + map_vadd' := by intro x y; ext <;> simp [affineLin,lin] <;> ring + } + ∀ (q : ℝ × ℝ), ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + ((⇑(affineMapTri q v w) : ℝ × ℝ → ℝ × ℝ) '' Set.range stdPts) = (⇑(affineMapTri q v + w) : ℝ × ℝ → ℝ × ℝ) '' W)) := by + classical + intro lin W stdPts W_eq_stdHull affineLin affineMapTri q v w + rw [W_eq_stdHull, AffineMap.image_convexHull] + +private theorem hopen : + (by + classical + exact + let faceDet (f : PeriodicSubtileFaceIndex) : ℝ := + let p0 := P4715T1Position (SixSubtileFaceVertices f 0) + let p1 := P4715T1Position (SixSubtileFaceVertices f 1) + let p2 := P4715T1Position (SixSubtileFaceVertices f 2) + p1.1 * p2.2 - p1.1 * p0.2 - p0.1 * p2.2 - p1.2 * p2.1 + + p1.2 * p0.1 + p0.2 * p2.1 + (∀ (f : PeriodicSubtileFaceIndex), faceDet f ≠ 0) → (∀ (delta_nonzero : ∀ (f : + PeriodicSubtileFaceIndex), (P4715T1Position (SixSubtileFaceVertices f 1) - + P4715T1Position (SixSubtileFaceVertices f 0)).1 * (P4715T1Position + (SixSubtileFaceVertices f 2) - P4715T1Position (SixSubtileFaceVertices f 0)).2 - + (P4715T1Position (SixSubtileFaceVertices f 1) - P4715T1Position + (SixSubtileFaceVertices f 0)).2 * (P4715T1Position (SixSubtileFaceVertices f 2) - + P4715T1Position (SixSubtileFaceVertices f 0)).1 ≠ 0), + let lin (v w x : ℝ × ℝ) : ℝ × ℝ := + (x.1 * v.1 + x.2 * w.1, x.1 * v.2 + x.2 * w.2) + let invlin (v w x : ℝ × ℝ) : ℝ × ℝ := + let d := v.1 * w.2 - v.2 * w.1 + ((x.1 * w.2 - x.2 * w.1) / d, (v.1 * x.2 - v.2 * x.1) / d) + ∀ (inv_right : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → + (lin v w (invlin v w x) = x)), ∀ (inv_left : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × + ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → (invlin v w (lin v w x) = x)), + let affineHomeo (q v w : ℝ × ℝ) (hd : v.1 * w.2 - v.2 * w.1 ≠ 0) : + Homeomorph (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => q + lin v w x + invFun := fun y => invlin v w (y - q) + left_inv := fun x => by simp [inv_left, hd] + right_inv := fun y => by simp [inv_right, hd] + continuous_toFun := by dsimp [lin]; fun_prop + continuous_invFun := by dsimp [invlin]; fun_prop + } + let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1} + (IsOpen D) → ((∀ (f : PeriodicSubtileFaceIndex), (faceDet f ≠ 0) → (P4715T1Region f = + affineHomeo (P4715T1Position (SixSubtileFaceVertices f 0)) (P4715T1Position + (SixSubtileFaceVertices f 1) - P4715T1Position (SixSubtileFaceVertices f 0)) + (P4715T1Position (SixSubtileFaceVertices f 2) - P4715T1Position + (SixSubtileFaceVertices f 0)) (delta_nonzero f) '' D)) → (∀ f, IsOpen + (P4715T1Region f))))) := by + classical + intro faceDet faceDet_nonzero delta_nonzero lin invlin inv_right inv_left affineHomeo D Dopen + region_image f + rw [region_image f (faceDet_nonzero f)] + exact (affineHomeo (P4715T1Position (SixSubtileFaceVertices f 0)) + (P4715T1Position (SixSubtileFaceVertices f 1) - P4715T1Position (SixSubtileFaceVertices + f 0)) + (P4715T1Position (SixSubtileFaceVertices f 2) - P4715T1Position (SixSubtileFaceVertices + f 0)) + (delta_nonzero f)).isOpen_image.mpr Dopen + +private theorem region_subset_triangle : + (by + classical + exact + (∀ (f : PeriodicSubtileFaceIndex), convexHull ℝ (P4715T1Position '' Set.range + (SixSubtileFaceVertices f)) = P4715T1Region f ∪ ( P4715T1Arc + (SixSubtileFaceVertices f 0) (SixSubtileFaceVertices f 1) ∪ P4715T1Arc + (SixSubtileFaceVertices f 1) (SixSubtileFaceVertices f 2) ∪ P4715T1Arc + (SixSubtileFaceVertices f 2) (SixSubtileFaceVertices f 0))) → (∀ (f : + PeriodicSubtileFaceIndex), P4715T1Region f ⊆ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × + ℝ)) (P4715T1Position '' Set.range (SixSubtileFaceVertices f))) ) := by + classical + intro triangle_decomp f z hz + rw [triangle_decomp f] + exact Or.inl hz + +private theorem bary_shift : + (by + classical + exact + (∀ (k : Int × Int), ∀ (a : PeriodicSubtileIndex), P4715T1Position + (P4715T1VertexShift k a) = P4715T1Position a + ((k.1 : Real), (k.2 : Real))) → + ((∀ (k : Int × Int), ∀ (j : Fin 12), ∀ (i : Fin 3), SixSubtileFaceVertices + (P4715T1FaceShift k (P4715T1PatchFaces j)) i = + P4715T1VertexShift k (SixSubtileFaceVertices (P4715T1PatchFaces j) i)) → ( + let translation (k : Int × Int) : AffineMap ℝ (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => x + ((k.1 : Real), (k.2 : Real)) + linear := LinearMap.id + map_vadd' := by intro x y; simp [add_assoc] + } + let bary (f : PeriodicSubtileFaceIndex) (s t : Real) : ℝ × ℝ := + (1 - s - t) • P4715T1Position (SixSubtileFaceVertices f 0) + + s • P4715T1Position (SixSubtileFaceVertices f 1) + + t • P4715T1Position (SixSubtileFaceVertices f 2) + ∀ (k : ℤ × ℤ), ∀ (j : Fin (12 : ℕ)), ∀ (s : ℝ), ∀ (t : ℝ), bary (P4715T1FaceShift k + (P4715T1PatchFaces j)) s t = (translation k : ℝ × ℝ → ℝ × ℝ) (bary + (P4715T1PatchFaces j) s t)))) := by + classical + intro position_shift face_vertex_shift translation bary k j s t + dsimp [bary, translation] + rw [face_vertex_shift k j 0, face_vertex_shift k j 1, face_vertex_shift k j 2] + rw [position_shift, position_shift, position_shift] + ext <;> simp [smul_add, smul_eq_mul] + all_goals ring + +private theorem translation_injective : + (by + classical + exact + let translation (k : Int × Int) : AffineMap ℝ (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => x + ((k.1 : Real), (k.2 : Real)) + linear := LinearMap.id + map_vadd' := by intro x y; simp [add_assoc] + } + ∀ (k : ℤ × ℤ), Function.Injective (⇑(translation k) : ℝ × ℝ → ℝ × ℝ) ) := by + classical + intro translation k x y hxy + change x + ((k.1 : Real), (k.2 : Real)) = + y + ((k.1 : Real), (k.2 : Real)) at hxy + exact add_right_cancel hxy + +end CoefficientFaceTopology + +theorem P4715T1CoefficientFaces : + (∀ f, IsOpen (P4715T1Region f)) ∧ + (∀ f, IsConnected (P4715T1Region f)) ∧ + (Pairwise fun f g => Disjoint (P4715T1Region f) (P4715T1Region g)) ∧ + (∀ f, frontier (P4715T1Region f) = + P4715T1Arc (SixSubtileFaceVertices f 0) (SixSubtileFaceVertices f 1) ∪ + P4715T1Arc (SixSubtileFaceVertices f 1) (SixSubtileFaceVertices f 2) ∪ + P4715T1Arc (SixSubtileFaceVertices f 2) (SixSubtileFaceVertices f 0)) ∧ + Set.range P4715T1Position ∪ + {p | ∃ a b, AllowedSubtileIncidence a b ∧ p ∈ P4715T1Arc a b} ∪ + {p | ∃ f, p ∈ P4715T1Region f} = Set.univ := by +-- BODY + obtain ⟨hpoly, hboundary, hcover, hdisj, hinter⟩ := P4715T1HexagonTessellation + obtain ⟨hpatch, hdet, hlocal, htrace⟩ := P4715T1HexagonSubdivision + obtain ⟨_, _, _, _, hallowed, _⟩ := P4677T2IncidenceLedger + have position_shift (k : Int × Int) (a : PeriodicSubtileIndex) := + CoefficientFaceTopology.position_shift k a + have face_vertex_shift (k : Int × Int) (j : Fin 12) (i : Fin 3) := + CoefficientFaceTopology.face_vertex_shift k j i + let faceDet (f : PeriodicSubtileFaceIndex) : ℝ := + let p0 := P4715T1Position (SixSubtileFaceVertices f 0) + let p1 := P4715T1Position (SixSubtileFaceVertices f 1) + let p2 := P4715T1Position (SixSubtileFaceVertices f 2) + p1.1 * p2.2 - p1.1 * p0.2 - p0.1 * p2.2 - p1.2 * p2.1 + + p1.2 * p0.1 + p0.2 * p2.1 + have faceDet_nonzero (f : PeriodicSubtileFaceIndex) := CoefficientFaceTopology.faceDet_nonzero f + have faceDet_eq_delta (f : PeriodicSubtileFaceIndex) := CoefficientFaceProof.faceDet_eq_delta f + have delta_nonzero (f : PeriodicSubtileFaceIndex) := CoefficientFaceProof.delta_nonzero + faceDet_nonzero faceDet_eq_delta f + let lin (v w x : ℝ × ℝ) : ℝ × ℝ := + (x.1 * v.1 + x.2 * w.1, x.1 * v.2 + x.2 * w.2) + let invlin (v w x : ℝ × ℝ) : ℝ × ℝ := + let d := v.1 * w.2 - v.2 * w.1 + ((x.1 * w.2 - x.2 * w.1) / d, (v.1 * x.2 - v.2 * x.1) / d) + have inv_right (v w x : ℝ × ℝ) (hd : v.1 * w.2 - v.2 * w.1 ≠ 0) : + lin v w (invlin v w x) = x := CoefficientFaceTopology.inv_right v w x hd + have inv_left (v w x : ℝ × ℝ) (hd : v.1 * w.2 - v.2 * w.1 ≠ 0) : + invlin v w (lin v w x) = x := CoefficientFaceTopology.inv_left v w x hd + let affineHomeo (q v w : ℝ × ℝ) (hd : v.1 * w.2 - v.2 * w.1 ≠ 0) : + Homeomorph (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => q + lin v w x + invFun := fun y => invlin v w (y - q) + left_inv := fun x => by simp [inv_left, hd] + right_inv := fun y => by simp [inv_right, hd] + continuous_toFun := by dsimp [lin]; fun_prop + continuous_invFun := by dsimp [invlin]; fun_prop + } + let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1} + have Dopen := CoefficientFaceTopology.Dopen + have Dconvex := CoefficientFaceProof.Dconvex + have D_nonempty := CoefficientFaceTopology.D_nonempty + let W : Set (ℝ × ℝ) := {z | 0 ≤ z.1 ∧ 0 ≤ z.2 ∧ z.1+z.2 ≤ 1} + have D_subset_W := CoefficientFaceTopology.D_subset_W + have W_closed := CoefficientFaceTopology.W_closed + have D_closure := CoefficientFaceProof.D_closure D_subset_W + have mem_bottom_segment (z : ℝ×ℝ) := CoefficientFaceProof.mem_bottom_segment z + have mem_diagonal_segment (z : ℝ×ℝ) := CoefficientFaceProof.mem_diagonal_segment z + have mem_left_segment (z : ℝ×ℝ) := CoefficientFaceProof.mem_left_segment z + have D_frontier := CoefficientFaceProof.D_frontier Dopen + D_closure mem_bottom_segment mem_diagonal_segment mem_left_segment + have image_segment (q v w : ℝ×ℝ) + (hd : v.1*w.2-v.2*w.1≠0) (x y : ℝ×ℝ) := CoefficientFaceTopology.image_segment inv_right + inv_left q v w hd x y + let stdPts : Fin 3 → ℝ×ℝ := ![(0,0),(1,0),(0,1)] + have W_convex := CoefficientFaceTopology.W_convex + have W_eq_stdHull := CoefficientFaceProof.W_eq_stdHull + W_convex + let affineLin (v w : ℝ×ℝ) : (ℝ×ℝ) →ₗ[ℝ] (ℝ×ℝ) := { + toFun := lin v w + map_add' := by intro x y; ext <;> simp [lin] <;> ring + map_smul' := by intro c x; ext <;> simp [lin] <;> ring + } + let affineMapTri (q v w : ℝ×ℝ) : AffineMap ℝ (ℝ×ℝ) (ℝ×ℝ) := { + toFun := fun x => q + lin v w x + linear := affineLin v w + map_vadd' := by intro x y; ext <;> simp [affineLin,lin] <;> ring + } + have hull_affine (q v w : ℝ×ℝ) := CoefficientFaceTopology.hull_affine W_eq_stdHull q v w + have region_image (f : PeriodicSubtileFaceIndex) (hd : faceDet f ≠ 0) := + CoefficientFaceProof.region_image delta_nonzero inv_right + inv_left f hd + have W_decomp := CoefficientFaceProof.W_decomp Dopen D_subset_W D_closure + have triangle_image (f : PeriodicSubtileFaceIndex) := CoefficientFaceProof.triangle_image + delta_nonzero inv_right + inv_left hull_affine f + have hopen := CoefficientFaceTopology.hopen faceDet_nonzero + delta_nonzero inv_right inv_left Dopen region_image + have hconnected := CoefficientFaceProof.hconnected + faceDet_nonzero delta_nonzero inv_right inv_left Dconvex D_nonempty region_image + have triangle_decomp (f : PeriodicSubtileFaceIndex) := CoefficientFaceProof.triangle_decomp + faceDet_nonzero delta_nonzero inv_right + inv_left D_frontier image_segment region_image W_decomp triangle_image f + have region_subset_triangle (f : PeriodicSubtileFaceIndex) := + CoefficientFaceTopology.region_subset_triangle triangle_decomp f + have std_edge_disjoint (i j : Fin 3) (hij : i ≠ j) := CoefficientFaceProof.std_edge_disjoint + mem_bottom_segment mem_diagonal_segment mem_left_segment i j hij + have region_disjoint_arc (f : PeriodicSubtileFaceIndex) (i j : Fin 3) + (hij : i ≠ j) := CoefficientFaceProof.region_disjoint_arc faceDet_nonzero delta_nonzero + inv_right + inv_left image_segment region_image std_edge_disjoint f i j hij + let translation (k : Int × Int) : AffineMap ℝ (ℝ × ℝ) (ℝ × ℝ) := { + toFun := fun x => x + ((k.1 : Real), (k.2 : Real)) + linear := LinearMap.id + map_vadd' := by intro x y; simp [add_assoc] + } + let bary (f : PeriodicSubtileFaceIndex) (s t : Real) : ℝ × ℝ := + (1 - s - t) • P4715T1Position (SixSubtileFaceVertices f 0) + + s • P4715T1Position (SixSubtileFaceVertices f 1) + + t • P4715T1Position (SixSubtileFaceVertices f 2) + have bary_shift (k : Int × Int) (j : Fin 12) (s t : Real) := CoefficientFaceTopology.bary_shift + position_shift face_vertex_shift k j s t + have region_shift (k : Int × Int) (j : Fin 12) := CoefficientFaceProof.region_shift bary_shift k j + have translated_triangle (k : Int × Int) (j : Fin 12) := + CoefficientFaceProof.translated_triangle position_shift face_vertex_shift k j + have common_edge (i j : Fin 12) (hij : i ≠ j) : + ∃ a b : Fin 3, a ≠ b ∧ + ∀ r : Fin 3, + SixSubtileFaceVertices (P4715T1PatchFaces i) r ∈ + Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j)) → + r = a ∨ r = b := + (by decide +kernel +revert) + have region_subset_tile (k : Int × Int) (j : Fin 12) := CoefficientFaceProof.region_subset_tile + hpatch + region_subset_triangle translated_triangle k j + have common_hull_subset_arc (i j : Fin 12) (hij : i ≠ j) := + CoefficientFaceProof.common_hull_subset_arc common_edge i j hij + have translation_injective (k : Int × Int) := CoefficientFaceTopology.translation_injective k + have plane_cover := CoefficientFaceProof.plane_cover hcover + hpatch hallowed triangle_decomp translated_triangle + have pairwise_regions := CoefficientFaceProof.pairwise_regions + hdisj hlocal hopen region_subset_triangle region_disjoint_arc region_shift + region_subset_tile common_hull_subset_arc translation_injective + refine ⟨hopen, hconnected, ?_, ?_, ?_⟩ + · exact pairwise_regions + · intro f + let q := P4715T1Position (SixSubtileFaceVertices f 0) + let v := P4715T1Position (SixSubtileFaceVertices f 1) - q + let w := P4715T1Position (SixSubtileFaceVertices f 2) - q + let E := affineHomeo q v w (delta_nonzero f) + rw [region_image f (faceDet_nonzero f)] + calc + frontier (E '' D) = E '' frontier D := (E.image_frontier D).symm + _ = E '' (segment ℝ (0,0) (1,0) ∪ segment ℝ (1,0) (0,1) ∪ + segment ℝ (0,0) (0,1)) := by rw [D_frontier] + _ = P4715T1Arc (SixSubtileFaceVertices f 0) (SixSubtileFaceVertices f 1) ∪ + P4715T1Arc (SixSubtileFaceVertices f 1) (SixSubtileFaceVertices f 2) ∪ + P4715T1Arc (SixSubtileFaceVertices f 2) (SixSubtileFaceVertices f 0) := by + rw [Set.image_union, Set.image_union] + rw [image_segment q v w (delta_nonzero f), image_segment q v w (delta_nonzero f), + image_segment q v w (delta_nonzero f)] + have e0 : E (0,0) = P4715T1Position (SixSubtileFaceVertices f 0) := by + simp [E, affineHomeo, lin, q] + have e1 : E (1,0) = P4715T1Position (SixSubtileFaceVertices f 1) := by + ext <;> simp [E, affineHomeo, lin, q, v] + have e2 : E (0,1) = P4715T1Position (SixSubtileFaceVertices f 2) := by + ext <;> simp [E, affineHomeo, lin, q, w] + simp only [P4715T1Arc] + rw [e0, e1, e2] + rw [segment_symm ℝ (P4715T1Position (SixSubtileFaceVertices f 2)) + (P4715T1Position (SixSubtileFaceVertices f 0))] + · exact plane_cover + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientTranslation.lean b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientTranslation.lean new file mode 100644 index 0000000000..3fdbf30d0b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientTranslation.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1IndexAction +public import LeanPool.ApollonianSuperharmonic.P4715T1Arc +public import LeanPool.ApollonianSuperharmonic.P4715T1Region +public import Mathlib.Tactic.Module + +-- [TABLET NODE: P4715T1CoefficientTranslation] + +/-! +# P4715T1CoefficientTranslation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4715T1CoefficientTranslation (k : Int × Int) : + (∀ a, P4715T1Position (P4715T1VertexShift k a) = + P4715T1Position a + ((k.1 : Real), (k.2 : Real))) ∧ + (∀ a b, P4715T1Arc (P4715T1VertexShift k a) (P4715T1VertexShift k b) = + (fun p : Real × Real => p + ((k.1 : Real), (k.2 : Real))) '' P4715T1Arc a b) ∧ + ∀ f, P4715T1Region (P4715T1FaceShift k f) = + (fun p : Real × Real => p + ((k.1 : Real), (k.2 : Real))) '' P4715T1Region f := by +-- BODY + have hp (a) : P4715T1Position (P4715T1VertexShift k a) = + P4715T1Position a + ((k.1 : Real), (k.2 : Real)) := by + ext <;> simp [P4715T1Position, P4715T1VertexShift, + add_comm, add_left_comm] + refine ⟨hp, ?_, ?_⟩ + · intro a b + simp only [P4715T1Arc, hp] + simpa only [add_comm] using + (segment_translate_image Real ((k.1 : Real), (k.2 : Real)) + (P4715T1Position a) (P4715T1Position b)).symm + · intro f + have hf := P4715T1IndexAction.2.2.2.2.2 k f + let K : Real × Real := ((k.1 : Real), (k.2 : Real)) + have hcombo (s t : Real) (p q r : Real × Real) : + (1 - s - t) • (p + K) + s • (q + K) + t • (r + K) = + ((1 - s - t) • p + s • q + t • r) + K := by module + ext z + constructor + · rintro ⟨s, t, hs, ht, hst, hz⟩ + simp only [hf, hp] at hz + refine ⟨_, ⟨s, t, hs, ht, hst, rfl⟩, ?_⟩ + exact (hz.trans (hcombo s t _ _ _)).symm + · rintro ⟨y, ⟨s, t, hs, ht, hst, hy⟩, rfl⟩ + refine ⟨s, t, hs, ht, hst, ?_⟩ + simp only [hf, hp] + rw [hcombo, hy] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1FaceShift.lean b/LeanPool/ApollonianSuperharmonic/P4715T1FaceShift.lean new file mode 100644 index 0000000000..90fd7617c6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1FaceShift.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileFaceIndex + +-- [TABLET NODE: P4715T1FaceShift] + +/-! +# P4715T1FaceShift + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $k=(r,s)\in\mathbb Z^2$, define +$\sigma_k(X,m,n)=(X,m+r,n+s)$ on `PeriodicSubtileFaceIndex`. +-/ +def P4715T1FaceShift (k : Int × Int) (f : PeriodicSubtileFaceIndex) : + PeriodicSubtileFaceIndex := +-- BODY + ⟨f.label, f.first + k.1, f.second + k.2⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1Hexagon.lean b/LeanPool/ApollonianSuperharmonic/P4715T1Hexagon.lean new file mode 100644 index 0000000000..9078e37604 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1Hexagon.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1Position +public import LeanPool.ApollonianSuperharmonic.P4715T1BoundaryCycle +public import Mathlib.Analysis.Convex.Hull + +-- [TABLET NODE: P4715T1Hexagon] + +/-! +# P4715T1Hexagon + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $H$ be the real convex hull of the positions +of the six indices in `P4715T1BoundaryCycle`, using +`P4715T1Position`. +-/ +def P4715T1Hexagon : Set (Real × Real) := +-- BODY + convexHull Real (Set.range (P4715T1Position ∘ P4715T1BoundaryCycle)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1HexagonSubdivision.lean b/LeanPool/ApollonianSuperharmonic/P4715T1HexagonSubdivision.lean new file mode 100644 index 0000000000..11ddde5883 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1HexagonSubdivision.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1Hexagon +public import LeanPool.ApollonianSuperharmonic.P4715T1PatchFaces +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.P4783T1PatchCoverage +public import LeanPool.ApollonianSuperharmonic.P4783T1PatchDeterminants +public import LeanPool.ApollonianSuperharmonic.P4793T1PatchIntersections +public import LeanPool.ApollonianSuperharmonic.P4793T1PatchBoundaryTraces +public import Mathlib.Analysis.Convex.Topology + +-- [TABLET NODE: P4715T1HexagonSubdivision] + +/-! +# P4715T1HexagonSubdivision + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4715T1HexagonSubdivision : + let V := fun j : Fin 12 => Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j)) + let K := fun j : Fin 12 => convexHull Real (P4715T1Position '' V j) + (⋃ j, K j) = P4715T1Hexagon ∧ + (∀ j : Fin 12, + let p := P4715T1Position ∘ SixSubtileFaceVertices (P4715T1PatchFaces j) + (p 1).1 * (p 2).2 - (p 1).1 * (p 0).2 - + (p 0).1 * (p 2).2 - (p 1).2 * (p 2).1 + + (p 1).2 * (p 0).1 + (p 0).2 * (p 2).1 ≠ 0) ∧ + (∀ i j : Fin 12, i ≠ j → + K i ∩ K j = convexHull Real (P4715T1Position '' (V i ∩ V j))) ∧ + ∀ j : Fin 12, K j ∩ frontier P4715T1Hexagon = + convexHull Real (P4715T1Position '' + (V j ∩ Set.range P4715T1BoundaryCycle)) := by +-- BODY + dsimp only + refine ⟨P4783T1PatchCoverage, P4783T1PatchDeterminants, ?_, ?_⟩ + · intro i j hij + exact P4793T1PatchIntersections i j hij + · intro j + exact P4793T1PatchBoundaryTraces j + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1HexagonTessellation.lean b/LeanPool/ApollonianSuperharmonic/P4715T1HexagonTessellation.lean new file mode 100644 index 0000000000..f7986c3442 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1HexagonTessellation.lean @@ -0,0 +1,191 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1Hexagon +public import LeanPool.ApollonianSuperharmonic.P4715T1VertexShift +public import LeanPool.ApollonianSuperharmonic.P4715T1Arc +public import LeanPool.ApollonianSuperharmonic.P4780T1StrictInterior +public import LeanPool.ApollonianSuperharmonic.P4780T1ActiveFacets +public import LeanPool.ApollonianSuperharmonic.P4780T1IntegerCoverage +public import LeanPool.ApollonianSuperharmonic.P4780T1InteriorSeparation +public import LeanPool.ApollonianSuperharmonic.P4780T1NeighborFacets +public import LeanPool.ApollonianSuperharmonic.P4780T1NeighborCorners +public import LeanPool.ApollonianSuperharmonic.P4715T1CoefficientTranslation +public import Mathlib.Tactic.Abel + +-- [TABLET NODE: P4715T1HexagonTessellation] + +/-! +# P4715T1HexagonTessellation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4715T1HexagonTessellation : + P4715T1Hexagon = {p : Real × Real | + -2 ≤ 2 * p.1 - p.2 ∧ 2 * p.1 - p.2 ≤ 0 ∧ + -1 ≤ p.1 - 2 * p.2 ∧ p.1 - 2 * p.2 ≤ 1 ∧ + -2 ≤ p.1 + p.2 ∧ p.1 + p.2 ≤ 0} ∧ + frontier P4715T1Hexagon = ⋃ j : Fin 6, + P4715T1Arc (P4715T1BoundaryCycle j) + (P4715T1BoundaryCycle (j + 1)) ∧ + (⋃ k : Int × Int, + (fun p : Real × Real => p + ((k.1 : Real), (k.2 : Real))) '' + P4715T1Hexagon) = Set.univ ∧ + (Pairwise fun k l : Int × Int => Disjoint + (interior ((fun p : Real × Real => p + ((k.1 : Real), (k.2 : Real))) '' + P4715T1Hexagon)) + (interior ((fun p : Real × Real => p + ((l.1 : Real), (l.2 : Real))) '' + P4715T1Hexagon))) ∧ + ∀ k l : Int × Int, k ≠ l → + ((fun p : Real × Real => p + ((k.1 : Real), (k.2 : Real))) '' + P4715T1Hexagon) ∩ + ((fun p : Real × Real => p + ((l.1 : Real), (l.2 : Real))) '' + P4715T1Hexagon) = + convexHull Real (P4715T1Position '' + (Set.range (P4715T1VertexShift k ∘ P4715T1BoundaryCycle) ∩ + Set.range (P4715T1VertexShift l ∘ P4715T1BoundaryCycle))) := by +-- BODY + refine ⟨P4780T1HullHalfspaces, ?_, ?_, ?_, ?_⟩ + · have hclosed : IsClosed P4715T1Hexagon := by + rw [P4780T1HullHalfspaces] + simp only [Set.ofPred_and] + repeat' apply IsClosed.inter + all_goals exact isClosed_le (by fun_prop) (by fun_prop) + rw [hclosed.frontier_eq] + ext p + simp only [Set.mem_sdiff, Set.mem_iUnion] + constructor + · rintro ⟨hp, hn⟩ + have hq := hp + rw [P4780T1HullHalfspaces] at hq + rw [P4780T1StrictInterior] at hn + rcases hq with ⟨hx0, hx1, hy0, hy1, hz0, hz1⟩ + have he : 2*p.1-p.2=0 ∨ p.1-2*p.2=1 ∨ p.1+p.2 = -2 ∨ + 2*p.1-p.2 = -2 ∨ p.1-2*p.2 = -1 ∨ p.1+p.2=0 := by + by_contra h + push Not at h + apply hn + rcases h with ⟨h1, h2, h3, h4, h5, h6⟩ + exact ⟨lt_of_le_of_ne hx0 (Ne.symm h4), lt_of_le_of_ne hx1 h1, + lt_of_le_of_ne hy0 (Ne.symm h5), lt_of_le_of_ne hy1 h2, + lt_of_le_of_ne hz0 (Ne.symm h3), lt_of_le_of_ne hz1 h6⟩ + rcases he with he | he | he | he | he | he + · exact ⟨0, by rw [P4780T1ActiveFacets]; exact ⟨hp, he⟩⟩ + · exact ⟨1, by rw [P4780T1ActiveFacets]; exact ⟨hp, he⟩⟩ + · exact ⟨2, by rw [P4780T1ActiveFacets]; exact ⟨hp, he⟩⟩ + · exact ⟨3, by rw [P4780T1ActiveFacets]; exact ⟨hp, he⟩⟩ + · exact ⟨4, by rw [P4780T1ActiveFacets]; exact ⟨hp, he⟩⟩ + · exact ⟨5, by rw [P4780T1ActiveFacets]; exact ⟨hp, he⟩⟩ + · rintro ⟨j, hp⟩ + rw [P4780T1ActiveFacets] at hp + refine ⟨hp.1, ?_⟩ + rw [P4780T1StrictInterior] + intro hs + rcases hs with ⟨hx0, hx1, hy0, hy1, hz0, hz1⟩ + have he := hp.2 + fin_cases j <;> simp at he <;> linarith + · exact P4780T1IntegerCoverage + · exact P4780T1InteriorSeparation + · intro k l hkl + have hside (j : Fin 6) + (hd : l-k = (![(1,0), (0,-1), (-1,-1), (-1,0), (0,1), (1,1)] j : Int × Int)) + (a : Real × Real) + (ha : a ∈ P4715T1Arc (P4715T1BoundaryCycle j) + (P4715T1BoundaryCycle (j+1))) : + a + ((k.1 : Real), (k.2 : Real)) ∈ + convexHull Real (P4715T1Position '' + (Set.range (P4715T1VertexShift k ∘ P4715T1BoundaryCycle) ∩ + Set.range (P4715T1VertexShift l ∘ P4715T1BoundaryCycle))) := by + have hm (z : PeriodicSubtileIndex) + (hz : z ∈ ({P4715T1BoundaryCycle j, P4715T1BoundaryCycle (j+1)} : + Set PeriodicSubtileIndex)) : + P4715T1VertexShift k z ∈ + Set.range (P4715T1VertexShift k ∘ P4715T1BoundaryCycle) ∩ + Set.range (P4715T1VertexShift l ∘ P4715T1BoundaryCycle) := by + rw [← P4780T1NeighborCorners j] at hz + rcases hz with ⟨⟨r, hr⟩, ⟨s, hs⟩⟩ + refine ⟨⟨r, congrArg (P4715T1VertexShift k) hr⟩, ⟨s, ?_⟩⟩ + have hkd : k + (![(1,0), (0,-1), (-1,-1), (-1,0), (0,1), (1,1)] j : Int × Int) = l := by + rw [← hd] + abel + change P4715T1VertexShift l (P4715T1BoundaryCycle s) = _ + rw [← hs, Function.comp_apply, ← P4715T1IndexAction.2.1, hkd] + have hpa : a + ((k.1 : Real), (k.2 : Real)) ∈ + P4715T1Arc (P4715T1VertexShift k (P4715T1BoundaryCycle j)) + (P4715T1VertexShift k (P4715T1BoundaryCycle (j+1))) := by + rw [P4715T1CoefficientTranslation k |>.2.1] + exact ⟨a, ha, rfl⟩ + exact segment_subset_convexHull + (Set.mem_image_of_mem _ (hm _ (by simp))) + (Set.mem_image_of_mem _ (hm _ (by simp))) hpa + apply Set.Subset.antisymm + · rintro p ⟨⟨a, ha, hap⟩, ⟨b, hb, hbp⟩⟩ + generalize hde : l-k = d + have hab : a = b + ((d.1 : Real), (d.2 : Real)) := by + rw [← hde] + have h1 := congrArg Prod.fst (hap.trans hbp.symm) + have h2 := congrArg Prod.snd (hap.trans hbp.symm) + ext <;> simp [Int.cast_sub] at h1 h2 ⊢ <;> linarith + have hcase (j : Fin 6) + (hj : d = (![(1,0), (0,-1), (-1,-1), (-1,0), (0,1), (1,1)] j : Int × Int)) : + p ∈ convexHull Real (P4715T1Position '' + (Set.range (P4715T1VertexShift k ∘ P4715T1BoundaryCycle) ∩ + Set.range (P4715T1VertexShift l ∘ P4715T1BoundaryCycle))) := by + rw [← hap] + apply hside j (hde.trans hj) a + rw [← P4780T1NeighborFacets j] + refine ⟨ha, b, hb, ?_⟩ + simpa only [← hj] using hab.symm + have hdiag : d = (1,-1) ∨ d = (-1,1) → False := by + intro h + rw [P4780T1HullHalfspaces] at ha hb + rcases ha with ⟨ha1, ha2, ha3, ha4, ha5, ha6⟩ + rcases hb with ⟨hb1, hb2, hb3, hb4, hb5, hb6⟩ + rcases h with h | h <;> rw [h] at hab + all_goals + have he1 := congrArg Prod.fst hab + have he2 := congrArg Prod.snd hab + norm_num at he1 he2 + linarith + have hd := P4780T1OverlapBound d a b ha hb hab + have hne : d ≠ 0 := by rw [← hde]; exact sub_ne_zero.mpr (Ne.symm hkl) + rcases d with ⟨x,y⟩ + rcases hd with ⟨hx0, hx1, hy0, hy1⟩ + interval_cases x <;> interval_cases y + · exact hcase 2 rfl + · exact hcase 3 rfl + · exact (hdiag (Or.inr rfl)).elim + · exact hcase 1 rfl + · exact (hne rfl).elim + · exact hcase 4 rfl + · exact (hdiag (Or.inl rfl)).elim + · exact hcase 0 rfl + · exact hcase 5 rfl + · apply convexHull_min + · rintro _ ⟨z, hz, rfl⟩ + constructor + · rcases hz.1 with ⟨j, hj⟩ + rw [← hj, Function.comp_apply, (P4715T1CoefficientTranslation k).1] + exact ⟨_, subset_convexHull Real _ ⟨j, rfl⟩, rfl⟩ + · rcases hz.2 with ⟨j, hj⟩ + rw [← hj, Function.comp_apply, (P4715T1CoefficientTranslation l).1] + exact ⟨_, subset_convexHull Real _ ⟨j, rfl⟩, rfl⟩ + · have hc (z : Int × Int) : Convex Real + ((fun p : Real × Real => p + ((z.1 : Real), (z.2 : Real))) '' P4715T1Hexagon) := by + have hh : Convex Real P4715T1Hexagon := convex_convexHull Real _ + simpa only [add_comm] using hh.translate ((z.1 : Real), (z.2 : Real)) + exact (hc k).inter (hc l) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1IndexAction.lean b/LeanPool/ApollonianSuperharmonic/P4715T1IndexAction.lean new file mode 100644 index 0000000000..6b9b66bde0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1IndexAction.lean @@ -0,0 +1,99 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1VertexShift +public import LeanPool.ApollonianSuperharmonic.P4715T1FaceShift +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import Mathlib.Tactic.FinCases + +-- [TABLET NODE: P4715T1IndexAction] + +/-! +# P4715T1IndexAction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4715T1IndexAction : + (∀ a, P4715T1VertexShift 0 a = a) ∧ + (∀ k l a, P4715T1VertexShift (k + l) a = + P4715T1VertexShift k (P4715T1VertexShift l a)) ∧ + (∀ f, P4715T1FaceShift 0 f = f) ∧ + (∀ k l f, P4715T1FaceShift (k + l) f = + P4715T1FaceShift k (P4715T1FaceShift l f)) ∧ + (∀ k a b, AllowedSubtileIncidence (P4715T1VertexShift k a) + (P4715T1VertexShift k b) ↔ AllowedSubtileIncidence a b) ∧ + ∀ k f i, SixSubtileFaceVertices (P4715T1FaceShift k f) i = + P4715T1VertexShift k (SixSubtileFaceVertices f i) := by +-- BODY + have vz (a) : P4715T1VertexShift 0 a = a := by + cases a; simp [P4715T1VertexShift] + have va (k l a) : P4715T1VertexShift (k + l) a = + P4715T1VertexShift k (P4715T1VertexShift l a) := by + simp [P4715T1VertexShift, add_comm, add_left_comm] + have fz (f) : P4715T1FaceShift 0 f = f := by + cases f; simp [P4715T1FaceShift] + have fa (k l f) : P4715T1FaceShift (k + l) f = + P4715T1FaceShift k (P4715T1FaceShift l f) := by + simp [P4715T1FaceShift, add_comm, add_left_comm] + have forward (k : Int × Int) {a b} (h : AllowedSubtileIncidence a b) : + AllowedSubtileIncidence (P4715T1VertexShift k a) + (P4715T1VertexShift k b) := by + induction h with + | symm _ ih => exact .symm ih + | AB m n => exact .AB _ _ + | AB01 m n => simpa [P4715T1VertexShift, add_assoc, add_comm, add_left_comm] + using AllowedSubtileIncidence.AB01 (m + k.1) (n + k.2) + | AB11 m n => simpa [P4715T1VertexShift, add_assoc, add_comm, add_left_comm] + using AllowedSubtileIncidence.AB11 (m + k.1) (n + k.2) + | AC m n => exact .AC _ _ + | AC11 m n => simpa [P4715T1VertexShift, add_assoc, add_comm, add_left_comm] + using AllowedSubtileIncidence.AC11 (m + k.1) (n + k.2) + | AD m n => exact .AD _ _ + | AE01 m n => simpa [P4715T1VertexShift, add_assoc, add_comm, add_left_comm] + using AllowedSubtileIncidence.AE01 (m + k.1) (n + k.2) + | AF m n => exact .AF _ _ + | BC m n => exact .BC _ _ + | BDm1m1 m n => simpa [P4715T1VertexShift, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] + using AllowedSubtileIncidence.BDm1m1 (m + k.1) (n + k.2) + | BD m n => exact .BD _ _ + | BE m n => exact .BE _ _ + | BF0m1 m n => simpa [P4715T1VertexShift, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] + using AllowedSubtileIncidence.BF0m1 (m + k.1) (n + k.2) + | CDm10 m n => simpa [P4715T1VertexShift, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] + using AllowedSubtileIncidence.CDm10 (m + k.1) (n + k.2) + | CEm10 m n => simpa [P4715T1VertexShift, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] + using AllowedSubtileIncidence.CEm10 (m + k.1) (n + k.2) + | CF m n => exact .CF _ _ + | DE m n => exact .DE _ _ + | DF10 m n => simpa [P4715T1VertexShift, add_assoc, add_comm, add_left_comm] + using AllowedSubtileIncidence.DF10 (m + k.1) (n + k.2) + refine ⟨vz, va, fz, fa, ?_, ?_⟩ + · intro k a b + constructor + · intro h + have hh := forward (-k) h + simpa only [← va, neg_add_cancel, vz] using hh + · exact forward k + · rintro k ⟨l, m, n⟩ i + cases l <;> fin_cases i <;> + simp [P4715T1FaceShift, P4715T1VertexShift, SixSubtileFaceVertices, + sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1LatticeCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4715T1LatticeCoordinates.lean new file mode 100644 index 0000000000..0af507a894 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1LatticeCoordinates.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P4715T1LatticeCoordinates] + +/-! +# P4715T1LatticeCoordinates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4715T1LatticeCoordinates (u v : GaussianInt) + (L : AddSubgroup GaussianInt) (hu : u ∈ L) (hv : v ∈ L) + (hcoords : ∀ w : L, ∃! mn : Int × Int, + (mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v = w) : + Function.Injective (fun mn : Int × Int => + (mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v) ∧ + ∃ c : L →+ Int × Int, + (∀ w, ((c w).1 : GaussianInt) * u + ((c w).2 : GaussianInt) * v = w) ∧ + Function.Surjective c := by +-- BODY + classical + let F : (Int × Int) →+ GaussianInt := { + toFun := fun mn => (mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v + map_zero' := by simp + map_add' := by intros; simp [add_mul]; ring } + have hz (mn : Int × Int) (h : F mn = 0) : mn = 0 := by + obtain ⟨k, _, hk⟩ := hcoords 0 + exact (hk mn h).trans (hk 0 (by simp [])).symm + have hinj : Function.Injective F := by + intro a b hab + have h := hz (a - b) (by rw [map_sub, hab, sub_self]) + exact sub_eq_zero.mp h + let c0 : L → Int × Int := fun w => Classical.choose (hcoords w) + have hc (w : L) : F (c0 w) = w := (Classical.choose_spec (hcoords w)).1 + let c : L →+ Int × Int := { + toFun := c0 + map_zero' := hinj (by rw [hc]; simp) + map_add' := by + intro a b + apply hinj + rw [hc, map_add, hc, hc] + rfl } + refine ⟨hinj, c, hc, ?_⟩ + intro mn + have hm : F mn ∈ L := by + change (mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v ∈ L + simpa only [← zsmul_eq_mul] using + L.add_mem (L.zsmul_mem hu mn.1) (L.zsmul_mem hv mn.2) + refine ⟨⟨F mn, hm⟩, ?_⟩ + exact hinj (hc ⟨F mn, hm⟩) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1Offsets.lean b/LeanPool/ApollonianSuperharmonic/P4715T1Offsets.lean new file mode 100644 index 0000000000..6977111e10 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1Offsets.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SixSubtileLabel + +-- [TABLET NODE: P4715T1Offsets] + +/-! +# P4715T1Offsets + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The coefficient offsets of the six labels of `SixSubtileLabel` +are the following vectors in $\mathbb R^2$: +$$ +o_A=(0,0),\quad o_B=(-4,-8)/12,\quad o_C=(-6,-6)/12,\quad +o_D=(2,-2)/12,\quad o_E=(1,-7)/12,\quad o_F=(-5,-1)/12. +$$ +-/ +noncomputable def P4715T1Offsets : SixSubtileLabel → Real × Real := +-- BODY + fun l => match l with + | .A => (0, 0) + | .B => (-4 / 12, -8 / 12) + | .C => (-6 / 12, -6 / 12) + | .D => (2 / 12, -2 / 12) + | .E => (1 / 12, -7 / 12) + | .F => (-5 / 12, -1 / 12) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1OrbitRepresentatives.lean b/LeanPool/ApollonianSuperharmonic/P4715T1OrbitRepresentatives.lean new file mode 100644 index 0000000000..ce45b7880c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1OrbitRepresentatives.lean @@ -0,0 +1,99 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1IndexAction +public import LeanPool.ApollonianSuperharmonic.P4677T2IncidenceLedger + +-- [TABLET NODE: P4715T1OrbitRepresentatives] + +/-! +# P4715T1OrbitRepresentatives + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4715T1OrbitRepresentatives : + ∃ (vr : Finset PeriodicSubtileIndex) + (er : Finset (PeriodicSubtileIndex × PeriodicSubtileIndex)) + (fr : Finset PeriodicSubtileFaceIndex), + (∀ a, a ∈ vr ↔ a.first = 0 ∧ a.second = 0) ∧ + (∀ r ∈ er, AllowedSubtileIncidence r.1 r.2) ∧ + (∀ f, f ∈ fr ↔ f.first = 0 ∧ f.second = 0) ∧ + (∀ a, ∃! r, r ∈ vr ∧ ∃ k : Int × Int, a = P4715T1VertexShift k r) ∧ + (∀ a b, AllowedSubtileIncidence a b → + ∃ r ∈ er, ∃ k : Int × Int, + a = P4715T1VertexShift k r.1 ∧ b = P4715T1VertexShift k r.2) ∧ + ∀ f, ∃ r ∈ fr, ∃ k : Int × Int, f = P4715T1FaceShift k r := by +-- BODY + classical + let vr : Finset PeriodicSubtileIndex := + {⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, + ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} + let fr : Finset PeriodicSubtileFaceIndex := + {⟨.I1, 0, 0⟩, ⟨.I2, 0, 0⟩, ⟨.I3, 0, 0⟩, ⟨.I4, 0, 0⟩, + ⟨.J1, 0, 0⟩, ⟨.J2, 0, 0⟩, ⟨.J3, 0, 0⟩, ⟨.J4, 0, 0⟩, + ⟨.J5, 0, 0⟩, ⟨.J6, 0, 0⟩, ⟨.J7, 0, 0⟩, ⟨.J8, 0, 0⟩} + have hvr (a) : a ∈ vr ↔ a.first = 0 ∧ a.second = 0 := by + rcases a with ⟨l, m, n⟩ + cases l <;> simp [vr, PeriodicSubtileIndex.mk.injEq] + have hfr (f) : f ∈ fr ↔ f.first = 0 ∧ f.second = 0 := by + rcases f with ⟨l, m, n⟩ + cases l <;> simp [fr, PeriodicSubtileFaceIndex.mk.injEq] + have hn := P4677T2IncidenceLedger.2.2.1 + let er0 : Finset (PeriodicSubtileIndex × PeriodicSubtileIndex) := + vr.biUnion fun a => (hn a).toFinset.image (fun b => (a, b)) + let er := er0 ∪ er0.image Prod.swap + have he0 {r} (hr : r ∈ er0) : AllowedSubtileIncidence r.1 r.2 := by + obtain ⟨a, _, ha⟩ := Finset.mem_biUnion.mp hr + obtain ⟨b, hb, rfl⟩ := Finset.mem_image.mp ha + exact (hn a).mem_toFinset.mp hb + have he {r} (hr : r ∈ er) : AllowedSubtileIncidence r.1 r.2 := by + rcases Finset.mem_union.mp hr with hr | hr + · exact he0 hr + · obtain ⟨s, hs, rfl⟩ := Finset.mem_image.mp hr + exact (he0 hs).symm + refine ⟨vr, er, fr, hvr, fun _ => he, hfr, ?_, ?_, ?_⟩ + · intro a + refine ⟨⟨a.label, 0, 0⟩, ⟨(hvr _).mpr ⟨rfl, rfl⟩, + (a.first, a.second), ?_⟩, ?_⟩ + · simp [P4715T1VertexShift] + · rintro ⟨l, m, n⟩ ⟨hs, k, hk⟩ + obtain ⟨hm, hn⟩ := (hvr _).mp hs + change m = 0 at hm + change n = 0 at hn + subst m + subst n + have hl := congrArg PeriodicSubtileIndex.label hk + change a.label = l at hl + cases hl + rfl + · intro a b hab + let k : Int × Int := (a.first, a.second) + let x := P4715T1VertexShift (-k) a + let y := P4715T1VertexShift (-k) b + have hx : x ∈ vr := (hvr x).mpr (by simp [x, k, P4715T1VertexShift]) + have hxy : AllowedSubtileIncidence x y := + (P4715T1IndexAction.2.2.2.2.1 (-k) a b).mpr hab + have hr : (x, y) ∈ er0 := by + apply Finset.mem_biUnion.mpr + exact ⟨x, hx, Finset.mem_image.mpr ⟨y, (hn x).mem_toFinset.mpr hxy, rfl⟩⟩ + refine ⟨(x, y), Finset.mem_union.mpr (Or.inl hr), k, ?_, ?_⟩ + · simp [x, k, P4715T1VertexShift] + · simp [y, k, P4715T1VertexShift] + · intro f + refine ⟨⟨f.label, 0, 0⟩, (hfr _).mpr ⟨rfl, rfl⟩, + (f.first, f.second), ?_⟩ + simp [P4715T1FaceShift] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1PatchEnumeration.lean b/LeanPool/ApollonianSuperharmonic/P4715T1PatchEnumeration.lean new file mode 100644 index 0000000000..f3761f47c6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1PatchEnumeration.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1PatchFaces +public import LeanPool.ApollonianSuperharmonic.P4715T1FaceShift +public import Mathlib.Tactic.FinCases + +-- [TABLET NODE: P4715T1PatchEnumeration] + +/-! +# P4715T1PatchEnumeration + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4715T1PatchEnumeration (f : PeriodicSubtileFaceIndex) : + ∃! ki : (Int × Int) × Fin 12, + P4715T1FaceShift ki.1 (P4715T1PatchFaces ki.2) = f := by +-- BODY + rcases f with ⟨l, m, n⟩ + cases l + case' I1 => refine ⟨((m, n), 0), ?_, ?_⟩ + case' I2 => refine ⟨((m + 1, n), 2), ?_, ?_⟩ + case' I3 => refine ⟨((m, n), 8), ?_, ?_⟩ + case' I4 => refine ⟨((m + 1, n), 6), ?_, ?_⟩ + case' J1 => refine ⟨((m + 1, n + 1), 7), ?_, ?_⟩ + case' J2 => refine ⟨((m, n), 11), ?_, ?_⟩ + case' J3 => refine ⟨((m + 1, n + 1), 1), ?_, ?_⟩ + case' J4 => refine ⟨((m + 1, n), 3), ?_, ?_⟩ + case' J5 => refine ⟨((m + 1, n + 1), 4), ?_, ?_⟩ + case' J6 => refine ⟨((m, n - 1), 10), ?_, ?_⟩ + case' J7 => refine ⟨((m, n), 5), ?_, ?_⟩ + case' J8 => refine ⟨((m, n), 9), ?_, ?_⟩ + all_goals first + | (solve | simp [P4715T1FaceShift, P4715T1PatchFaces]) + | (rintro ⟨⟨p, q⟩, j⟩ h + fin_cases j <;> + simp [P4715T1FaceShift, P4715T1PatchFaces, + PeriodicSubtileFaceIndex.mk.injEq, Prod.ext_iff] at h ⊢; omega) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1PatchFaces.lean b/LeanPool/ApollonianSuperharmonic/P4715T1PatchFaces.lean new file mode 100644 index 0000000000..15c00df58e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1PatchFaces.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileFaceIndex + +-- [TABLET NODE: P4715T1PatchFaces] + +/-! +# P4715T1PatchFaces + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The ordered list of face indices in the base patch is +$$ +I_1,\ (J_3)_{-1,-1},\ (I_2)_{-1,0},\ (J_4)_{-1,0},\ +(J_5)_{-1,-1},\ J_7,\ (I_4)_{-1,0},\ (J_1)_{-1,-1},\ +I_3,\ J_8,\ (J_6)_{0,1},\ J_2, +$$ +where omitted subscripts are $(0,0)$ and face indices are those of +`PeriodicSubtileFaceIndex`. +-/ +def P4715T1PatchFaces : Fin 12 → PeriodicSubtileFaceIndex := +-- BODY + ![⟨.I1, 0, 0⟩, ⟨.J3, -1, -1⟩, ⟨.I2, -1, 0⟩, ⟨.J4, -1, 0⟩, + ⟨.J5, -1, -1⟩, ⟨.J7, 0, 0⟩, ⟨.I4, -1, 0⟩, ⟨.J1, -1, -1⟩, + ⟨.I3, 0, 0⟩, ⟨.J8, 0, 0⟩, ⟨.J6, 0, 1⟩, ⟨.J2, 0, 0⟩] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1PlaneMap.lean b/LeanPool/ApollonianSuperharmonic/P4715T1PlaneMap.lean new file mode 100644 index 0000000000..f845b78f39 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1PlaneMap.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import Mathlib.Topology.Algebra.Module.Equiv.Basic +public import Mathlib.Topology.Algebra.Module.Equiv.Pi +public import Mathlib.Topology.Algebra.Module.Equiv.Prod +public import Mathlib.Topology.Algebra.Module.Equiv.Submodule +public import Mathlib.Analysis.Normed.Module.Basic +public import Mathlib.Tactic.FunProp +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P4715T1PlaneMap] + +/-! +# P4715T1PlaneMap + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4715T1PlaneMap (u v : GaussianInt) + (hinj : Function.Injective (fun mn : Int × Int => + (mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v)) : + (u.re : Real) * (v.im : Real) - (u.im : Real) * (v.re : Real) ≠ 0 ∧ + ∃ E : (Real × Real) ≃L[Real] (Real × Real), + ∀ p, E p = p.1 • GaussianRealPoint u + p.2 • GaussianRealPoint v := by +-- BODY + have hZ : u.re * v.im - u.im * v.re ≠ 0 := by + intro h + have h1 : ((v.re, -u.re) : Int × Int) = (0, 0) := by + apply hinj + ext <;> simp <;> nlinarith + have h2 : ((v.im, -u.im) : Int × Int) = (0, 0) := by + apply hinj + ext <;> simp <;> nlinarith + have hur : u.re = 0 := by simpa using congrArg Prod.snd h1 + have hui : u.im = 0 := by simpa using congrArg Prod.snd h2 + have hu : u = 0 := by ext <;> assumption + have bad : ((1, 0) : Int × Int) = (0, 0) := hinj (by simp [hu]) + norm_num at bad + have hD : (u.re : Real) * (v.im : Real) - (u.im : Real) * (v.re : Real) ≠ 0 := by + exact_mod_cast hZ + let e : (Real × Real) ≃ₗ[Real] (Real × Real) := { + toFun := fun p => ((u.re : Real) * p.1 + (v.re : Real) * p.2, + (u.im : Real) * p.1 + (v.im : Real) * p.2) + invFun := fun p => + (((v.im : Real) * p.1 - (v.re : Real) * p.2) / + ((u.re : Real) * (v.im : Real) - (u.im : Real) * (v.re : Real)), + (-(u.im : Real) * p.1 + (u.re : Real) * p.2) / + ((u.re : Real) * (v.im : Real) - (u.im : Real) * (v.re : Real))) + left_inv := by + intro p + ext <;> dsimp <;> apply (div_eq_iff hD).2 <;> ring + right_inv := by + intro p + ext <;> dsimp <;> rw [← mul_div_assoc, ← mul_div_assoc, ← add_div] <;> + apply (div_eq_iff hD).2 <;> ring + map_add' := by intro p q; ext <;> simp <;> ring + map_smul' := by intro s p; ext <;> simp <;> ring } + let E : (Real × Real) ≃L[Real] (Real × Real) := { + e with + continuous_toFun := by dsimp [e]; fun_prop + continuous_invFun := by dsimp [e]; fun_prop } + refine ⟨hD, E, ?_⟩ + intro p + ext <;> simp [E, e, GaussianRealPoint, mul_comm] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1Position.lean b/LeanPool/ApollonianSuperharmonic/P4715T1Position.lean new file mode 100644 index 0000000000..11032698b8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1Position.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1Offsets +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex + +-- [TABLET NODE: P4715T1Position] + +/-! +# P4715T1Position + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For an index $a=(X,m,n)$ of `PeriodicSubtileIndex`, define +$p(a)=(m,n)+o_X$, using `P4715T1Offsets`. +-/ +noncomputable def P4715T1Position (a : PeriodicSubtileIndex) : Real × Real := +-- BODY + ((a.first : Real), (a.second : Real)) + P4715T1Offsets a.label + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1PositionInjective.lean b/LeanPool/ApollonianSuperharmonic/P4715T1PositionInjective.lean new file mode 100644 index 0000000000..d49e6147d1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1PositionInjective.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1Position +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P4715T1PositionInjective] + +/-! +# P4715T1PositionInjective + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4715T1PositionInjective : Function.Injective P4715T1Position := by +-- BODY + rintro ⟨l, m, n⟩ ⟨q, r, s⟩ h + have hx := congrArg Prod.fst h + have hy := congrArg Prod.snd h + change (m : Real) + (P4715T1Offsets l).1 = + (r : Real) + (P4715T1Offsets q).1 at hx + change (n : Real) + (P4715T1Offsets l).2 = + (s : Real) + (P4715T1Offsets q).2 at hy + have hx' : (12 : Real) * m + 12 * (P4715T1Offsets l).1 = + 12 * r + 12 * (P4715T1Offsets q).1 := by linarith + have hy' : (12 : Real) * n + 12 * (P4715T1Offsets l).2 = + 12 * s + 12 * (P4715T1Offsets q).2 := by linarith + cases l <;> cases q <;> norm_num [P4715T1Offsets] at hx' hy' + all_goals norm_cast at hx' hy' + all_goals simp_all [PeriodicSubtileIndex.mk.injEq] + all_goals omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1Region.lean b/LeanPool/ApollonianSuperharmonic/P4715T1Region.lean new file mode 100644 index 0000000000..19fb5a17bf --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1Region.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1Position +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices + +-- [TABLET NODE: P4715T1Region] + +/-! +# P4715T1Region + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a face $f$ of `PeriodicSubtileFaceIndex`, put +$p_j=p(\operatorname{SixSubtileFaceVertices}(f,j))$ using +`SixSubtileFaceVertices` and `P4715T1Position`. +Define $R_f=\{(1-s-t)p_0+sp_1+tp_2:s>0,\ t>0,\ s+t<1\}$. +This definition prescribes the region rather than choosing an unspecified +component of a complement. +-/ +def P4715T1Region (f : PeriodicSubtileFaceIndex) : Set (Real × Real) := +-- BODY + {z | ∃ s t : Real, 0 < s ∧ 0 < t ∧ s + t < 1 ∧ + z = (1 - s - t) • P4715T1Position (SixSubtileFaceVertices f 0) + + s • P4715T1Position (SixSubtileFaceVertices f 1) + + t • P4715T1Position (SixSubtileFaceVertices f 2)} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1VertexShift.lean b/LeanPool/ApollonianSuperharmonic/P4715T1VertexShift.lean new file mode 100644 index 0000000000..bd30ed594e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4715T1VertexShift.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex + +-- [TABLET NODE: P4715T1VertexShift] + +/-! +# P4715T1VertexShift + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $k=(r,s)\in\mathbb Z^2$, define +$\tau_k(X,m,n)=(X,m+r,n+s)$ on `PeriodicSubtileIndex`. +-/ +def P4715T1VertexShift (k : Int × Int) (a : PeriodicSubtileIndex) : + PeriodicSubtileIndex := +-- BODY + ⟨a.label, a.first + k.1, a.second + k.2⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1ContainedWalk.lean b/LeanPool/ApollonianSuperharmonic/P4733T1ContainedWalk.lean new file mode 100644 index 0000000000..1c73c4c764 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4733T1ContainedWalk.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices + +-- [TABLET NODE: P4733T1ContainedWalk] + +/-! +# P4733T1ContainedWalk + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A list $p$ is a contained walk in $T,U$ from $x$ to $y$ if its optional +head is $x$, its optional last element is $y$, every entry belongs to +$\operatorname{FootprintVertices}(T)\cap\operatorname{FootprintVertices}(U)$, +and every consecutive unordered pair belongs to +$\operatorname{FootprintEdges}(T)\cap\operatorname{FootprintEdges}(U)$. +The last condition means that for every decomposition +$p=l_1\mathbin{+\!+}[a,b]\mathbin{+\!+}l_2$, the edge $\{a,b\}$ +belongs to both graphs. Constant and repeating lists are permitted. +-/ +def P4733T1ContainedWalk (T U : ProtoTile) (x y : GaussianInt) + (p : List GaussianInt) : Prop := +-- BODY + p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ FootprintVertices T ∩ FootprintVertices U) ∧ + ∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → {a, b} ∈ FootprintEdges T ∩ FootprintEdges U + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1Coordinates.lean b/LeanPool/ApollonianSuperharmonic/P4733T1Coordinates.lean new file mode 100644 index 0000000000..8398ae6403 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4733T1Coordinates.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4677T2DrawingData + +-- [TABLET NODE: P4733T1Coordinates] + +/-! +# P4733T1Coordinates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4733T1Coordinates {u v : GaussianInt} {L : AddSubgroup GaussianInt} + (D : P4677T2DrawingData u v L) : Function.Bijective D.coordinates := by +-- BODY + constructor + · intro w z h + apply Subtype.ext + rw [← D.coordinates_spec w, ← D.coordinates_spec z, h] + · rintro ⟨m, n⟩ + obtain ⟨r, ⟨hr, w, hw⟩, _⟩ := D.vertex_orbits ⟨.A, m, n⟩ + obtain ⟨hrm, hrn⟩ := (D.vertex_reps r).mp hr + have hm := congrArg PeriodicSubtileIndex.first hw + have hn := congrArg PeriodicSubtileIndex.second hw + simp only [D.shift_eq, hrm, hrn, zero_add] at hm hn + exact ⟨w, Prod.ext hm.symm hn.symm⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1EdgeOrbit.lean b/LeanPool/ApollonianSuperharmonic/P4733T1EdgeOrbit.lean new file mode 100644 index 0000000000..30d2443da7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4733T1EdgeOrbit.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4733T1EdgeRow +public import LeanPool.ApollonianSuperharmonic.P4733T1Coordinates + +-- [TABLET NODE: P4733T1EdgeOrbit] + +/-! +# P4733T1EdgeOrbit + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4733T1EdgeOrbit {u v : GaussianInt} {L : AddSubgroup GaussianInt} + (D : P4677T2DrawingData u v L) (a b : PeriodicSubtileIndex) + (hab : AllowedSubtileIncidence a b) : + ∃ r : Fin 18, ∃ w : L, + (a = D.shift w (P4733T1EdgeRow r).1.1 ∧ + b = D.shift w (P4733T1EdgeRow r).1.2) ∨ + (a = D.shift w (P4733T1EdgeRow r).1.2 ∧ + b = D.shift w (P4733T1EdgeRow r).1.1) := by +-- BODY + induction hab with + | AB m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨0, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, add_comm] + | AB01 m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨1, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, add_comm] + | AB11 m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨2, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, add_comm] + | AC m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨3, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, add_comm] + | AC11 m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨4, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, add_comm] + | AD m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨5, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, add_comm] + | AE01 m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨6, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, add_comm] + | AF m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨7, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, add_comm] + | BC m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨8, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, add_comm] + | BDm1m1 m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨9, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, sub_eq_add_neg, add_comm] + | BD m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨10, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, add_comm] + | BE m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨11, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, add_comm] + | BF0m1 m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨12, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, sub_eq_add_neg, add_comm] + | CDm10 m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨13, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, sub_eq_add_neg, add_comm] + | CEm10 m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨14, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, sub_eq_add_neg, add_comm] + | CF m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨15, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, add_comm] + | DE m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨16, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, add_comm] + | DF10 m n => + obtain ⟨w, hw⟩ := (P4733T1Coordinates D).2 (m, n) + refine ⟨17, w, Or.inl ?_⟩ + simp [P4733T1EdgeRow, D.shift_eq, hw, add_comm] + | symm _ ih => + obtain ⟨r, w, h | h⟩ := ih + · exact ⟨r, w, Or.inr ⟨h.2, h.1⟩⟩ + · exact ⟨r, w, Or.inl ⟨h.2, h.1⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1EdgeRow.lean b/LeanPool/ApollonianSuperharmonic/P4733T1EdgeRow.lean new file mode 100644 index 0000000000..ad5f80a4f3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4733T1EdgeRow.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices + +-- [TABLET NODE: P4733T1EdgeRow] + +/-! +# P4733T1EdgeRow + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Write $X_{m,n}$ for a periodic vertex with label $X$ and coordinates +$(m,n)$, and use the same subscripts for faces. An omitted subscript +means $(0,0)$. For $0\leq r<18$, define the ordered edge and its ordered +incident faces $(a_r,b_r;f_r,g_r)$ by the following table. +$$ +\begin{array}{r|cc|cc} +r&a_r&b_r&f_r&g_r\\\hline +0&A&B&I_1&I_2\\ +1&A&B_{0,1}&J_1&J_2\\ +2&A&B_{1,1}&J_3&J_4\\ +3&A&C&I_1&I_3\\ +4&A&C_{1,1}&J_3&J_5\\ +5&A&D&I_2&J_4\\ +6&A&E_{0,1}&J_1&J_5\\ +7&A&F&I_3&J_2\\ +8&B&C&I_1&(J_3)_{-1,-1}\\ +9&B&D_{-1,-1}&(J_4)_{-1,-1}&J_6\\ +10&B&D&I_2&I_4\\ +11&B&E&I_4&(J_1)_{0,-1}\\ +12&B&F_{0,-1}&(J_2)_{0,-1}&J_6\\ +13&C&D_{-1,0}&J_7&J_8\\ +14&C&E_{-1,0}&(J_5)_{-1,-1}&J_7\\ +15&C&F&I_3&J_8\\ +16&D&E&I_4&(J_7)_{1,0}\\ +17&D&F_{1,0}&(J_6)_{1,1}&(J_8)_{1,0} +\end{array} +$$ +The value is stored as $((a_r,b_r),(f_r,g_r))$. +-/ +def P4733T1EdgeRow (r : Fin 18) : + (PeriodicSubtileIndex × PeriodicSubtileIndex) × + (PeriodicSubtileFaceIndex × PeriodicSubtileFaceIndex) := +-- BODY + match r with + | 0 => ((⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩), (⟨.I1, 0, 0⟩, ⟨.I2, 0, 0⟩)) + | 1 => ((⟨.A, 0, 0⟩, ⟨.B, 0, 1⟩), (⟨.J1, 0, 0⟩, ⟨.J2, 0, 0⟩)) + | 2 => ((⟨.A, 0, 0⟩, ⟨.B, 1, 1⟩), (⟨.J3, 0, 0⟩, ⟨.J4, 0, 0⟩)) + | 3 => ((⟨.A, 0, 0⟩, ⟨.C, 0, 0⟩), (⟨.I1, 0, 0⟩, ⟨.I3, 0, 0⟩)) + | 4 => ((⟨.A, 0, 0⟩, ⟨.C, 1, 1⟩), (⟨.J3, 0, 0⟩, ⟨.J5, 0, 0⟩)) + | 5 => ((⟨.A, 0, 0⟩, ⟨.D, 0, 0⟩), (⟨.I2, 0, 0⟩, ⟨.J4, 0, 0⟩)) + | 6 => ((⟨.A, 0, 0⟩, ⟨.E, 0, 1⟩), (⟨.J1, 0, 0⟩, ⟨.J5, 0, 0⟩)) + | 7 => ((⟨.A, 0, 0⟩, ⟨.F, 0, 0⟩), (⟨.I3, 0, 0⟩, ⟨.J2, 0, 0⟩)) + | 8 => ((⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩), (⟨.I1, 0, 0⟩, ⟨.J3, -1, -1⟩)) + | 9 => ((⟨.B, 0, 0⟩, ⟨.D, -1, -1⟩), (⟨.J4, -1, -1⟩, ⟨.J6, 0, 0⟩)) + | 10 => ((⟨.B, 0, 0⟩, ⟨.D, 0, 0⟩), (⟨.I2, 0, 0⟩, ⟨.I4, 0, 0⟩)) + | 11 => ((⟨.B, 0, 0⟩, ⟨.E, 0, 0⟩), (⟨.I4, 0, 0⟩, ⟨.J1, 0, -1⟩)) + | 12 => ((⟨.B, 0, 0⟩, ⟨.F, 0, -1⟩), (⟨.J2, 0, -1⟩, ⟨.J6, 0, 0⟩)) + | 13 => ((⟨.C, 0, 0⟩, ⟨.D, -1, 0⟩), (⟨.J7, 0, 0⟩, ⟨.J8, 0, 0⟩)) + | 14 => ((⟨.C, 0, 0⟩, ⟨.E, -1, 0⟩), (⟨.J5, -1, -1⟩, ⟨.J7, 0, 0⟩)) + | 15 => ((⟨.C, 0, 0⟩, ⟨.F, 0, 0⟩), (⟨.I3, 0, 0⟩, ⟨.J8, 0, 0⟩)) + | 16 => ((⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩), (⟨.I4, 0, 0⟩, ⟨.J7, 1, 0⟩)) + | _ => ((⟨.D, 0, 0⟩, ⟨.F, 1, 0⟩), (⟨.J6, 1, 1⟩, ⟨.J8, 1, 0⟩)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1FacePairNormalForm.lean b/LeanPool/ApollonianSuperharmonic/P4733T1FacePairNormalForm.lean new file mode 100644 index 0000000000..a00b6d0626 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4733T1FacePairNormalForm.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4733T1FacePairOrbit +public import LeanPool.ApollonianSuperharmonic.P4733T1EdgeOrbit +public import LeanPool.ApollonianSuperharmonic.P4733T1RowIncidence +public import LeanPool.ApollonianSuperharmonic.P4733T1RowLabelRigidity +public import LeanPool.ApollonianSuperharmonic.P4677T2IncidenceLedger + +-- [TABLET NODE: P4733T1FacePairNormalForm] + +/-! +# P4733T1FacePairNormalForm + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4733T1FacePairNormalForm {u v : GaussianInt} + {L : AddSubgroup GaussianInt} (D : P4677T2DrawingData u v L) : + Function.Injective (P4733T1FacePairOrbit D) ∧ + ∀ a b, AllowedSubtileIncidence a b → + ∀ f g, f ≠ g → + (∃ i, SixSubtileFaceVertices f i = a) → + (∃ i, SixSubtileFaceVertices f i = b) → + (∃ i, SixSubtileFaceVertices g i = a) → + (∃ i, SixSubtileFaceVertices g i = b) → + ∃ t : Fin 18 × L × Bool, + P4733T1FacePairOrbit D t = (f, g) ∧ + ((a = D.shift t.2.1 (P4733T1EdgeRow t.1).1.1 ∧ + b = D.shift t.2.1 (P4733T1EdgeRow t.1).1.2) ∨ + (a = D.shift t.2.1 (P4733T1EdgeRow t.1).1.2 ∧ + b = D.shift t.2.1 (P4733T1EdgeRow t.1).1.1)) := by +-- BODY + have face_inj (w : L) : Function.Injective (D.faceShift w) := by + intro f g h + have h' := congrArg (D.faceShift (-w)) h + simpa only [← D.faceShift_add, neg_add_cancel, D.faceShift_zero] using h' + constructor + · rintro ⟨r, w, s⟩ ⟨r', w', s'⟩ h + have hl := congrArg (fun p => (p.1.label, p.2.label)) h + have hrs : (r, s) = (r', s') := P4733T1RowLabelRigidity (by + cases s <;> cases s' <;> + simpa [P4733T1FacePairOrbit, D.faceShift_eq] using hl) + obtain ⟨rfl, rfl⟩ := Prod.mk.inj hrs + have hw : w = w' := by + apply (P4733T1Coordinates D).1 + have hfirst := congrArg (fun p => p.1.first) h + have hsecond := congrArg (fun p => p.1.second) h + cases s <;> simp only [P4733T1FacePairOrbit, Bool.false_eq_true, + ite_false, ite_true, D.faceShift_eq] at hfirst hsecond + all_goals exact Prod.ext (add_left_cancel hfirst) (add_left_cancel hsecond) + subst w' + rfl + · intro a b hab f g hfg hfa hfb hga hgb + obtain ⟨r, w, he⟩ := P4733T1EdgeOrbit D a b hab + let row := P4733T1EdgeRow r + let F := D.faceShift w row.2.1 + let G := D.faceShift w row.2.2 + let c := D.shift w row.1.1 + let d := D.shift w row.1.2 + have hr := P4733T1RowIncidence r + have hFG : F ≠ G := fun h => hr.2.1 (face_inj w h) + have hc : AllowedSubtileIncidence c d := (D.edge_periodic w _ _).mpr hr.1 + have memshift (h : PeriodicSubtileFaceIndex) (z : PeriodicSubtileIndex) + (hz : ∃ i, SixSubtileFaceVertices h i = z) : + ∃ i, SixSubtileFaceVertices (D.faceShift w h) i = D.shift w z := by + obtain ⟨i, hi⟩ := hz + exact ⟨i, by rw [D.face_vertices_periodic, hi]⟩ + have hF : (∃ i, SixSubtileFaceVertices F i = c) ∧ + (∃ i, SixSubtileFaceVertices F i = d) := + ⟨memshift _ _ hr.2.2.1, memshift _ _ hr.2.2.2.1⟩ + have hG : (∃ i, SixSubtileFaceVertices G i = c) ∧ + (∃ i, SixSubtileFaceVertices G i = d) := + ⟨memshift _ _ hr.2.2.2.2.1, memshift _ _ hr.2.2.2.2.2⟩ + obtain ⟨f₀, g₀, h₀, hf₀, hg₀, unique⟩ := + P4677T2IncidenceLedger.2.2.2.2.2 c d hc + have exhaust (h : PeriodicSubtileFaceIndex) + (hh : (∃ i, SixSubtileFaceVertices h i = c) ∧ + (∃ i, SixSubtileFaceVertices h i = d)) : h = F ∨ h = G := by + have hF' := unique F hF + have hG' := unique G hG + have hh' := unique h hh + rcases hF' with hF' | hF' <;> rcases hG' with hG' | hG' <;> + rcases hh' with hh' | hh' <;> aesop + have hf : f = F ∨ f = G := by + rcases he with ⟨ha, hb⟩ | ⟨ha, hb⟩ + · exact exhaust f ⟨⟨_, hfa.choose_spec.trans ha⟩, ⟨_, hfb.choose_spec.trans hb⟩⟩ + · exact exhaust f ⟨⟨_, hfb.choose_spec.trans hb⟩, ⟨_, hfa.choose_spec.trans ha⟩⟩ + have hg : g = F ∨ g = G := by + rcases he with ⟨ha, hb⟩ | ⟨ha, hb⟩ + · exact exhaust g ⟨⟨_, hga.choose_spec.trans ha⟩, ⟨_, hgb.choose_spec.trans hb⟩⟩ + · exact exhaust g ⟨⟨_, hgb.choose_spec.trans hb⟩, ⟨_, hga.choose_spec.trans ha⟩⟩ + rcases hf with rfl | rfl <;> rcases hg with rfl | rfl + · exact (hfg rfl).elim + · exact ⟨(r, w, true), rfl, he⟩ + · exact ⟨(r, w, false), rfl, he⟩ + · exact (hfg rfl).elim + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1FacePairOrbit.lean b/LeanPool/ApollonianSuperharmonic/P4733T1FacePairOrbit.lean new file mode 100644 index 0000000000..c6a630f497 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4733T1FacePairOrbit.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4733T1EdgeRow +public import LeanPool.ApollonianSuperharmonic.P4677T2DrawingData + +-- [TABLET NODE: P4733T1FacePairOrbit] + +/-! +# P4733T1FacePairOrbit + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For drawing data $D$ and a triple $(r,w,s)$ consisting of a row +$r\in\{0,\ldots,17\}$, $w\in L$, and a Boolean $s$, let +$N_D(r,w,\mathrm{true})=(w\cdot f_r,w\cdot g_r)$ and +$N_D(r,w,\mathrm{false})=(w\cdot g_r,w\cdot f_r)$. +Here $w\cdot f$ is the drawing's face translation, and the two faces +come from the original-footprint edge row. +-/ +def P4733T1FacePairOrbit {u v : GaussianInt} {L : AddSubgroup GaussianInt} + (D : P4677T2DrawingData u v L) (t : Fin 18 × L × Bool) : + PeriodicSubtileFaceIndex × PeriodicSubtileFaceIndex := +-- BODY + let faces := (P4733T1EdgeRow t.1).2 + if t.2.2 then (D.faceShift t.2.1 faces.1, D.faceShift t.2.1 faces.2) + else (D.faceShift t.2.1 faces.2, D.faceShift t.2.1 faces.1) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1OccurrenceTranslation.lean b/LeanPool/ApollonianSuperharmonic/P4733T1OccurrenceTranslation.lean new file mode 100644 index 0000000000..3f4cd5cdfa --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4733T1OccurrenceTranslation.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4677T2DrawingData +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation + +-- [TABLET NODE: P4733T1OccurrenceTranslation] + +/-! +# P4733T1OccurrenceTranslation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4733T1OccurrenceTranslation (P : Fin 3 → Bool → ProtoTile) + {u v : GaussianInt} {L : AddSubgroup GaussianInt} + (D : P4677T2DrawingData u v L) (w : L) (a : PeriodicSubtileIndex) : + SubtileOccurrenceInterpretation P u v (D.shift w a) = + TileTranslation (SubtileOccurrenceInterpretation P u v a) w := by +-- BODY + have translate_comp (T : ProtoTile) (a b : GaussianInt) : + TileTranslation (TileTranslation T a) b = TileTranslation T (a + b) := by + cases T with + | mk cells anchor => + simp only [TileTranslation] + rw [ProtoTile.mk.injEq] + constructor + · rw [Finset.image_image] + congr 1 + funext x + simp [GaussianTranslation, add_assoc] + · simp [GaussianTranslation, add_assoc] + have offset : ((a.first + (D.coordinates w).1 : Int) : GaussianInt) * u + + ((a.second + (D.coordinates w).2 : Int) : GaussianInt) * v = + (a.first : GaussianInt) * u + (a.second : GaussianInt) * v + (w : GaussianInt) := by + rw [← D.coordinates_spec w] + push_cast + ring + rw [D.shift_eq] + dsimp only [SubtileOccurrenceInterpretation] + rw [offset, translate_comp] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1RepresentativeWalks.lean b/LeanPool/ApollonianSuperharmonic/P4733T1RepresentativeWalks.lean new file mode 100644 index 0000000000..b0ae33e765 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4733T1RepresentativeWalks.lean @@ -0,0 +1,183 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4733T1EdgeRow +public import LeanPool.ApollonianSuperharmonic.P4733T1RowIncidence +public import LeanPool.ApollonianSuperharmonic.P4733T1ContainedWalk +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations +public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance + +-- [TABLET NODE: P4733T1RepresentativeWalks] + +/-! +# P4733T1RepresentativeWalks + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4733T1RepresentativeWalks + (P Q S : Fin 3 → Bool → ProtoTile) (u v : GaussianInt) + (hQcells : (Q 1 true).cells ⊆ (P 0 true).cells) + (hScells : (S 1 false).cells ⊆ (P 0 false).cells) + (hQfoot : FootprintVertices (Q 1 true) ⊆ FootprintVertices (P 0 true)) + (hSfoot : FootprintVertices (S 1 false) ⊆ FootprintVertices (P 0 false)) + (hAC : TileTouching (Q 1 true) (P 1 true)) + (hBD : TileTouching (S 1 false) (P 1 false)) + (houter : + TouchingTriple (P 0 true) (TileTranslation (P 0 false) v) + (TileTranslation (P 2 true) v) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) v) + (P 2 false) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) (u + v)) + (TileTranslation (P 1 true) (u + v)) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 0 false) (u + v)) + (P 1 false) ∧ + TouchingTriple (P 0 true) (TileTranslation (P 1 true) (u + v)) + (TileTranslation (P 2 true) v) ∧ + TouchingTriple (P 0 false) (TileTranslation (P 1 false) (-u - v)) + (TileTranslation (P 2 false) (-v)) ∧ + TouchingTriple (P 1 true) (TileTranslation (P 1 false) (-u)) + (TileTranslation (P 2 true) (-u)) ∧ + TouchingTriple (P 1 true) (TileTranslation (P 1 false) (-u)) + (P 2 false)) + (rho : PeriodicSubtileFaceIndex → GaussianInt) + (hcommon : ∀ f i, rho f ∈ FootprintVertices + (SubtileOccurrenceInterpretation P u v (SixSubtileFaceVertices f i))) + (hI1 : rho ⟨.I1, 0, 0⟩ ∈ FootprintVertices (Q 1 true)) + (hI2 : rho ⟨.I2, 0, 0⟩ ∈ FootprintVertices (S 1 false)) + (hI3 : rho ⟨.I3, 0, 0⟩ ∈ FootprintVertices (Q 1 true) ∩ FootprintVertices (P 1 true)) + (hI4 : rho ⟨.I4, 0, 0⟩ ∈ FootprintVertices (S 1 false) ∩ FootprintVertices (P 1 false)) + (htouch : ∀ (T U : ProtoTile) (x y : GaussianInt), TileTouching T U → + x ∈ FootprintVertices T ∩ FootprintVertices U → + y ∈ FootprintVertices T ∩ FootprintVertices U → + ∃ p, P4733T1ContainedWalk T U x y p) + (hAB : ∃ p, P4733T1ContainedWalk (P 0 true) (P 0 false) + (rho ⟨.I1, 0, 0⟩) (rho ⟨.I2, 0, 0⟩) p) : + ∀ r : Fin 18, ∃ p : List GaussianInt, + P4733T1ContainedWalk + (SubtileOccurrenceInterpretation P u v (P4733T1EdgeRow r).1.1) + (SubtileOccurrenceInterpretation P u v (P4733T1EdgeRow r).1.2) + (rho (P4733T1EdgeRow r).2.1) (rho (P4733T1EdgeRow r).2.2) p := by +-- BODY + classical + have translate_zero (T : ProtoTile) : TileTranslation T 0 = T := by + cases T with + | mk cells anchor => + simp only [TileTranslation] + rw [ProtoTile.mk.injEq] + constructor + · ext z + simp [GaussianTranslation] + · simp [GaussianTranslation] + have translate_comp (T : ProtoTile) (a b : GaussianInt) : + TileTranslation (TileTranslation T a) b = TileTranslation T (a + b) := by + cases T with + | mk cells anchor => + simp only [TileTranslation] + rw [ProtoTile.mk.injEq] + constructor + · rw [Finset.image_image] + congr 1 + funext x + simp [GaussianTranslation, add_assoc] + · simp [GaussianTranslation, add_assoc] + have skip (T U V : ProtoTile) (h : TouchingTriple T U V) : TileTouching T V := + ((TouchingTriplePermutations T U V).mp h).1.1 + have lift (T T' U : ProtoTile) (hc : T.cells ⊆ T'.cells) + (hv : FootprintVertices T ⊆ FootprintVertices T') + (x y : GaussianInt) (p : List GaussianInt) + (h : P4733T1ContainedWalk T U x y p) : + P4733T1ContainedWalk T' U x y p := by + refine ⟨h.1, h.2.1, ?_, ?_⟩ + · intro z hz + exact ⟨hv (h.2.2.1 z hz).1, (h.2.2.1 z hz).2⟩ + · intro a b l₁ l₂ hp + obtain ⟨ht, hu⟩ := h.2.2.2 a b l₁ l₂ hp + rcases ht with ⟨c, hc', he⟩ + exact ⟨⟨c, hc hc', he⟩, hu⟩ + have outerWalk (r : Fin 18) + (h : TileTouching + (SubtileOccurrenceInterpretation P u v (P4733T1EdgeRow r).1.1) + (SubtileOccurrenceInterpretation P u v (P4733T1EdgeRow r).1.2)) : + ∃ p, P4733T1ContainedWalk + (SubtileOccurrenceInterpretation P u v (P4733T1EdgeRow r).1.1) + (SubtileOccurrenceInterpretation P u v (P4733T1EdgeRow r).1.2) + (rho (P4733T1EdgeRow r).2.1) (rho (P4733T1EdgeRow r).2.2) p := by + obtain ⟨_, _, ⟨i, hi⟩, ⟨j, hj⟩, ⟨k, hk⟩, ⟨l, hl⟩⟩ := + P4733T1RowIncidence r + apply htouch _ _ _ _ h + · exact ⟨hi ▸ hcommon _ i, hj ▸ hcommon _ j⟩ + · exact ⟨hk ▸ hcommon _ k, hl ▸ hcommon _ l⟩ + obtain ⟨h1, h2, h3, h4, h5, h6, h7, h8⟩ := houter + intro r + fin_cases r + · simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_zero] using hAB + · apply outerWalk 1 + simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_zero] using h1.1 + · apply outerWalk 2 + simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_zero] using h3.1 + · have hx : rho ⟨.I1, 0, 0⟩ ∈ FootprintVertices (P 1 true) := by + simpa [SixSubtileFaceVertices, SubtileOccurrenceInterpretation, translate_zero] + using hcommon ⟨.I1, 0, 0⟩ 2 + obtain ⟨p, hp⟩ := htouch _ _ _ _ hAC ⟨hI1, hx⟩ hI3 + have h := lift _ _ _ hQcells hQfoot _ _ p hp + exact ⟨p, by simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, + translate_zero] using h⟩ + · apply outerWalk 4 + simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_zero] using h5.1 + · apply outerWalk 5 + simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_zero] using skip _ _ _ h4 + · apply outerWalk 6 + simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_zero] using skip _ _ _ h1 + · apply outerWalk 7 + simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_zero] using skip _ _ _ h2 + · apply outerWalk 8 + have h := (TileTouchingCovariance _ _ (-u - v)).1.mp h3.2.1 + simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_comp, + translate_zero, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using h + · apply outerWalk 9 + simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_zero, + sub_eq_add_neg] using h6.1 + · have hx : rho ⟨.I2, 0, 0⟩ ∈ FootprintVertices (P 1 false) := by + simpa [SixSubtileFaceVertices, SubtileOccurrenceInterpretation, translate_zero] + using hcommon ⟨.I2, 0, 0⟩ 2 + obtain ⟨p, hp⟩ := htouch _ _ _ _ hBD ⟨hI2, hx⟩ hI4 + have h := lift _ _ _ hScells hSfoot _ _ p hp + exact ⟨p, by simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, + translate_zero] using h⟩ + · apply outerWalk 11 + have h := (TileTouchingCovariance _ _ (-v)).1.mp h1.2.1 + simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_comp, + translate_zero] using h + · apply outerWalk 12 + simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_zero] using skip _ _ _ h6 + · apply outerWalk 13 + simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_zero] using h7.1 + · apply outerWalk 14 + have h := (TileTouchingCovariance _ _ (-u - v)).1.mp h5.2.1 + simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_comp, + translate_zero, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using h + · apply outerWalk 15 + simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_zero] using skip _ _ _ h8 + · apply outerWalk 16 + have h := (TileTouchingCovariance _ _ u).1.mp h7.2.1 + simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_comp, + translate_zero] using h + · apply outerWalk 17 + have h := (TileTouchingCovariance _ _ u).1.mp h8.2.1 + simpa [P4733T1EdgeRow, SubtileOccurrenceInterpretation, translate_comp, + translate_zero] using h + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1RowIncidence.lean b/LeanPool/ApollonianSuperharmonic/P4733T1RowIncidence.lean new file mode 100644 index 0000000000..aa1a6a5a41 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4733T1RowIncidence.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4733T1EdgeRow +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import Mathlib.Tactic.FinCases + +-- [TABLET NODE: P4733T1RowIncidence] + +/-! +# P4733T1RowIncidence + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4733T1RowIncidence (r : Fin 18) : + let row := P4733T1EdgeRow r + AllowedSubtileIncidence row.1.1 row.1.2 ∧ row.2.1 ≠ row.2.2 ∧ + (∃ i, SixSubtileFaceVertices row.2.1 i = row.1.1) ∧ + (∃ i, SixSubtileFaceVertices row.2.1 i = row.1.2) ∧ + (∃ i, SixSubtileFaceVertices row.2.2 i = row.1.1) ∧ + (∃ i, SixSubtileFaceVertices row.2.2 i = row.1.2) := by +-- BODY + fin_cases r <;> dsimp [P4733T1EdgeRow] + all_goals refine ⟨?_, by decide, ?_, ?_, ?_, ?_⟩ + all_goals first + | exact AllowedSubtileIncidence.AB 0 0 + | exact AllowedSubtileIncidence.AB01 0 0 + | exact AllowedSubtileIncidence.AB11 0 0 + | exact AllowedSubtileIncidence.AC 0 0 + | exact AllowedSubtileIncidence.AC11 0 0 + | exact AllowedSubtileIncidence.AD 0 0 + | exact AllowedSubtileIncidence.AE01 0 0 + | exact AllowedSubtileIncidence.AF 0 0 + | exact AllowedSubtileIncidence.BC 0 0 + | exact AllowedSubtileIncidence.BDm1m1 0 0 + | exact AllowedSubtileIncidence.BD 0 0 + | exact AllowedSubtileIncidence.BE 0 0 + | exact AllowedSubtileIncidence.BF0m1 0 0 + | exact AllowedSubtileIncidence.CDm10 0 0 + | exact AllowedSubtileIncidence.CEm10 0 0 + | exact AllowedSubtileIncidence.CF 0 0 + | exact AllowedSubtileIncidence.DE 0 0 + | exact AllowedSubtileIncidence.DF10 0 0 + | exact ⟨0, by decide⟩ + | exact ⟨1, by decide⟩ + | exact ⟨2, by decide⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1RowLabelRigidity.lean b/LeanPool/ApollonianSuperharmonic/P4733T1RowLabelRigidity.lean new file mode 100644 index 0000000000..608d32ac0a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4733T1RowLabelRigidity.lean @@ -0,0 +1,33 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4733T1EdgeRow + +-- [TABLET NODE: P4733T1RowLabelRigidity] + +/-! +# P4733T1RowLabelRigidity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4733T1RowLabelRigidity : Function.Injective + (fun t : Fin 18 × Bool => + let faces := (P4733T1EdgeRow t.1).2 + if t.2 then (faces.1.label, faces.2.label) + else (faces.2.label, faces.1.label)) := by +-- BODY + decide +kernel + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1WalkExtension.lean b/LeanPool/ApollonianSuperharmonic/P4733T1WalkExtension.lean new file mode 100644 index 0000000000..d0b54b41f5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4733T1WalkExtension.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4733T1FacePairOrbit +public import LeanPool.ApollonianSuperharmonic.P4733T1RowIncidence + +-- [TABLET NODE: P4733T1WalkExtension] + +/-! +# P4733T1WalkExtension + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4733T1WalkExtension {u v : GaussianInt} {L : AddSubgroup GaussianInt} + (D : P4677T2DrawingData u v L) + (hinj : Function.Injective (P4733T1FacePairOrbit D)) + (p : Fin 18 → List GaussianInt) : + ∃ path : PeriodicSubtileFaceIndex → PeriodicSubtileFaceIndex → List GaussianInt, + (∀ f g, path g f = (path f g).reverse) ∧ + (∀ w f g, path (D.faceShift w f) (D.faceShift w g) = + (path f g).map (fun x => x + (w : GaussianInt))) ∧ + (∀ t : Fin 18 × L × Bool, + path (P4733T1FacePairOrbit D t).1 (P4733T1FacePairOrbit D t).2 = + if t.2.2 then (p t.1).map (fun x => x + (t.2.1 : GaussianInt)) + else ((p t.1).map (fun x => x + (t.2.1 : GaussianInt))).reverse) ∧ + (∀ f, path f f = []) ∧ + ∀ f g, (¬ ∃ t, P4733T1FacePairOrbit D t = (f, g)) → path f g = [] := by +-- BODY + classical + let N := P4733T1FacePairOrbit D + let value (t : Fin 18 × L × Bool) := + if t.2.2 then (p t.1).map (fun x => x + (t.2.1 : GaussianInt)) + else ((p t.1).map (fun x => x + (t.2.1 : GaussianInt))).reverse + let path (f g : PeriodicSubtileFaceIndex) := + if h : ∃ t, N t = (f, g) then value h.choose else [] + have on_orbit (t : Fin 18 × L × Bool) : path (N t).1 (N t).2 = value t := by + dsimp only [path] + split_ifs with h + · exact congrArg value (hinj h.choose_spec) + · exact (h ⟨t, rfl⟩).elim + let flip (t : Fin 18 × L × Bool) : Fin 18 × L × Bool := + (t.1, t.2.1, !t.2.2) + let shift (w : L) (t : Fin 18 × L × Bool) : Fin 18 × L × Bool := + (t.1, w + t.2.1, t.2.2) + have flip_pair (t) : N (flip t) = ((N t).2, (N t).1) := by + rcases t with ⟨r, z, s⟩ + cases s <;> rfl + have flip_value (t) : value (flip t) = (value t).reverse := by + rcases t with ⟨r, z, s⟩ + cases s <;> simp [value, flip] + have shift_pair (w) (t) : N (shift w t) = + (D.faceShift w (N t).1, D.faceShift w (N t).2) := by + rcases t with ⟨r, z, s⟩ + cases s <;> simp [N, shift, P4733T1FacePairOrbit, D.faceShift_add] + have shift_value (w) (t) : value (shift w t) = + (value t).map (fun x => x + (w : GaussianInt)) := by + rcases t with ⟨r, z, s⟩ + cases s <;> simp [value, shift, List.map_reverse, List.map_map, + add_comm] + have outside (f g) (h : ¬ ∃ t, N t = (f, g)) : path f g = [] := dite_eq_right h + refine ⟨path, ?_, ?_, on_orbit, ?_, outside⟩ + · intro f g + by_cases h : ∃ t, N t = (f, g) + · obtain ⟨t, ht⟩ := h + have hat := on_orbit t + have hflip := on_orbit (flip t) + rw [ht] at hat + rw [flip_pair, ht] at hflip + exact hflip.trans ((flip_value t).trans (congrArg List.reverse hat.symm)) + · have hrev : ¬ ∃ t, N t = (g, f) := by + rintro ⟨t, ht⟩ + apply h + exact ⟨flip t, by rw [flip_pair, ht]⟩ + simp only [path, dite_eq_right h, dite_eq_right hrev, List.reverse_nil] + · intro w f g + by_cases h : ∃ t, N t = (f, g) + · obtain ⟨t, ht⟩ := h + have hat := on_orbit t + have hshift := on_orbit (shift w t) + rw [ht] at hat + rw [shift_pair, ht] at hshift + exact hshift.trans ((shift_value w t).trans (congrArg + (List.map (fun x => x + (w : GaussianInt))) hat.symm)) + · have hshift : ¬ ∃ t, N t = (D.faceShift w f, D.faceShift w g) := by + rintro ⟨t, ht⟩ + apply h + refine ⟨shift (-w) t, ?_⟩ + rw [shift_pair, ht] + simp only [← D.faceShift_add, neg_add_cancel, D.faceShift_zero] + simp only [path, dite_eq_right h, dite_eq_right hshift, List.map_nil] + · intro f + apply outside + rintro ⟨t, ht⟩ + have heq : flip t = t := hinj (by + change N (flip t) = N t + rw [flip_pair, ht]) + have hb := congrArg (fun t : Fin 18 × L × Bool => t.2.2) heq + rcases t with ⟨r, z, s⟩ + cases s <;> simp [flip] at hb + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1WalkTransport.lean b/LeanPool/ApollonianSuperharmonic/P4733T1WalkTransport.lean new file mode 100644 index 0000000000..87e3ad6796 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4733T1WalkTransport.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4733T1ContainedWalk +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import Mathlib.Data.List.Chain + +-- [TABLET NODE: P4733T1WalkTransport] + +/-! +# P4733T1WalkTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4733T1WalkTransport (T U : ProtoTile) (x y : GaussianInt) + (p : List GaussianInt) (h : P4733T1ContainedWalk T U x y p) : + P4733T1ContainedWalk T U y x p.reverse ∧ + ∀ w : GaussianInt, P4733T1ContainedWalk + (TileTranslation T w) (TileTranslation U w) (x + w) (y + w) + (p.map (fun z => z + w)) := by +-- BODY + rcases h with ⟨hh, hl, hv, he⟩ + constructor + · refine ⟨by simpa using hl, by simpa using hh, ?_, ?_⟩ + · intro z hz + exact hv z (List.mem_reverse.mp hz) + · intro a b l₁ l₂ hp + have hp' : p = l₂.reverse ++ b :: a :: l₁.reverse := by + simpa [List.reverse_append, List.reverse_cons, List.append_assoc] + using congrArg List.reverse hp + simpa only [Finset.pair_comm] using he b a _ _ hp' + · intro w + have vertex (V : ProtoTile) (z : GaussianInt) (hz : z ∈ FootprintVertices V) : + z + w ∈ FootprintVertices (TileTranslation V w) := by + rw [(TileTranslationFormulas V w).2.2.2.2.2.1] + exact ⟨z, hz, rfl⟩ + have edge (V : ProtoTile) (a b : GaussianInt) + (hab : {a, b} ∈ FootprintEdges V) : + {a + w, b + w} ∈ FootprintEdges (TileTranslation V w) := by + rw [(TileTranslationFormulas V w).2.2.2.2.2.2.1] + exact ⟨{a, b}, hab, by simp [GaussianTranslation]⟩ + refine ⟨by simp [hh], by simp [hl], ?_, ?_⟩ + · intro z hz + obtain ⟨a, ha, rfl⟩ := List.mem_map.mp hz + exact ⟨vertex T a (hv a ha).1, vertex U a (hv a ha).2⟩ + · have chain := List.isChain_iff_forall_rel_of_append_cons_cons.mpr he + have mapped : List.IsChain (fun a b => + {a, b} ∈ FootprintEdges (TileTranslation T w) ∩ + FootprintEdges (TileTranslation U w)) (p.map (fun z => z + w)) := + List.isChain_map_of_isChain (fun z => z + w) + (fun a b hab => ⟨edge T a b hab.1, edge U a b hab.2⟩) chain + exact List.isChain_iff_forall_rel_of_append_cons_cons.mp mapped + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1ActiveFacets.lean b/LeanPool/ApollonianSuperharmonic/P4780T1ActiveFacets.lean new file mode 100644 index 0000000000..c63dd8ae77 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4780T1ActiveFacets.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4780T1HullHalfspaces +public import LeanPool.ApollonianSuperharmonic.P4715T1Arc + +-- [TABLET NODE: P4780T1ActiveFacets] + +/-! +# P4780T1ActiveFacets + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4780T1ActiveFacets (j : Fin 6) : + P4715T1Arc (P4715T1BoundaryCycle j) + (P4715T1BoundaryCycle (j + 1)) = + P4715T1Hexagon ∩ {p : Real × Real | + ![2*p.1-p.2=0, p.1-2*p.2=1, p.1+p.2 = -2, + 2*p.1-p.2 = -2, p.1-2*p.2 = -1, p.1+p.2=0] j} := by +-- BODY + rw [P4780T1HullHalfspaces] + ext p + constructor + · intro hp + fin_cases j + all_goals + simp? [P4715T1Arc, P4715T1Position, P4715T1BoundaryCycle, + P4715T1Offsets] at hp ⊢ + rw [segment_eq_image] at hp + rcases hp with ⟨θ, ⟨hθ0, hθ1⟩, hp⟩ + have hfst := congrArg Prod.fst hp + have hsnd := congrArg Prod.snd hp + norm_num at hfst hsnd + refine ⟨⟨?_, ?_, ?_, ?_, ?_, ?_⟩, ?_⟩ <;> linarith + · intro hp + fin_cases j + all_goals + simp? [P4715T1Arc, P4715T1Position, P4715T1BoundaryCycle, + P4715T1Offsets] at hp ⊢ + rcases hp with ⟨⟨hx0, hx1, hy0, hy1, hz0, hz1⟩, heq⟩ + rw [segment_eq_image] + · refine ⟨-3*p.1, ⟨by linarith, by linarith⟩, ?_⟩ + ext <;> simp <;> linarith + · refine ⟨(-3*p.1-1)/2, ⟨by linarith, by linarith⟩, ?_⟩ + ext <;> simp <;> linarith + · refine ⟨-3*p.1-3, ⟨by linarith, by linarith⟩, ?_⟩ + ext <;> simp <;> linarith + · refine ⟨3*p.1+4, ⟨by linarith, by linarith⟩, ?_⟩ + ext <;> simp <;> linarith + · refine ⟨(3*p.1+3)/2, ⟨by linarith, by linarith⟩, ?_⟩ + ext <;> simp <;> linarith + · refine ⟨3*p.1+1, ⟨by linarith, by linarith⟩, ?_⟩ + ext <;> simp <;> linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1HullHalfspaces.lean b/LeanPool/ApollonianSuperharmonic/P4780T1HullHalfspaces.lean new file mode 100644 index 0000000000..cdc2132242 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4780T1HullHalfspaces.lean @@ -0,0 +1,129 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1Hexagon +public import Mathlib.Analysis.Convex.Combination + +-- [TABLET NODE: P4780T1HullHalfspaces] + +/-! +# P4780T1HullHalfspaces + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4780T1HullHalfspaces : + P4715T1Hexagon = {p : Real × Real | + -2 ≤ 2 * p.1 - p.2 ∧ 2 * p.1 - p.2 ≤ 0 ∧ + -1 ≤ p.1 - 2 * p.2 ∧ p.1 - 2 * p.2 ≤ 1 ∧ + -2 ≤ p.1 + p.2 ∧ p.1 + p.2 ≤ 0} := by +-- BODY + let V := Set.range (P4715T1Position ∘ P4715T1BoundaryCycle) + apply Set.Subset.antisymm + · unfold P4715T1Hexagon + apply convexHull_min + · rintro p ⟨j, rfl⟩ + fin_cases j <;> + norm_num [P4715T1Position, P4715T1BoundaryCycle, P4715T1Offsets] + · have l1 : IsLinearMap Real (fun p : Real × Real => 2 * p.1 - p.2) := by + constructor <;> intros <;> simp <;> ring + have l2 : IsLinearMap Real (fun p : Real × Real => p.1 - 2 * p.2) := by + constructor <;> intros <;> simp <;> ring + have l3 : IsLinearMap Real (fun p : Real × Real => p.1 + p.2) := by + constructor <;> intros <;> simp <;> ring + have c1 := convex_halfSpace_ge l1 (-2) + have c2 := convex_halfSpace_le l1 0 + have c3 := convex_halfSpace_ge l2 (-1) + have c4 := convex_halfSpace_le l2 1 + have c5 := convex_halfSpace_ge l3 (-2) + have c6 := convex_halfSpace_le l3 0 + simpa only [Set.ofPred_and, Set.inter_assoc] using + (((((c1.inter c2).inter c3).inter c4).inter c5).inter c6) + · intro p hq + rcases hq with ⟨hxlo, hxhi, hylo, hyhi, hzlo, hzhi⟩ + have htri (a b c : Real × Real) (u v w : Real) + (hu : 0 ≤ u) (hv : 0 ≤ v) (hw : 0 ≤ w) (hsum : u + v + w = 1) + (ha : a ∈ V) (hb : b ∈ V) (hc : c ∈ V) + (hp : u • a + v • b + w • c = p) : p ∈ P4715T1Hexagon := by + let ww : Fin 3 → Real := ![u, v, w] + let zz : Fin 3 → Real × Real := ![a, b, c] + apply mem_convexHull_of_exists_fintype (w := ww) (z := zz) + · intro i + fin_cases i <;> simp? [ww] <;> assumption + · simp [ww, Fin.sum_univ_succ] + linarith + · intro i + fin_cases i <;> simp? [zz] <;> assumption + · simpa [ww, zz, Fin.sum_univ_succ, add_assoc] using hp + have hv0 : (0, 0) ∈ V := by + exact ⟨0, by norm_num [P4715T1Position, P4715T1BoundaryCycle, P4715T1Offsets]⟩ + have hv1 : (-1/3, -2/3) ∈ V := by + exact ⟨1, by norm_num [P4715T1Position, P4715T1BoundaryCycle, P4715T1Offsets]⟩ + have hv2 : (-1, -1) ∈ V := by + exact ⟨2, by simp [P4715T1Position, P4715T1BoundaryCycle, + P4715T1Offsets]⟩ + have hv3 : (-4/3, -2/3) ∈ V := by + exact ⟨3, by simp [P4715T1Position, P4715T1BoundaryCycle, + P4715T1Offsets]; norm_num⟩ + have hv4 : (-1, 0) ∈ V := by + exact ⟨4, by simp [P4715T1Position, P4715T1BoundaryCycle, + P4715T1Offsets]⟩ + have hv5 : (-1/3, 1/3) ∈ V := by + exact ⟨5, by simp [P4715T1Position, P4715T1BoundaryCycle, + P4715T1Offsets]; norm_num⟩ + by_cases hA : p.2 ≤ p.1 + · apply htri (0, 0) (-1/3, -2/3) (-1, -1) + (1 - (p.1 - 2 * p.2)) (3 * (p.1 - p.2)) (-(2 * p.1 - p.2)) + · linarith + · linarith + · linarith + · ring + · exact hv0 + · exact hv1 + · exact hv2 + · ext <;> simp <;> ring + · by_cases hB : p.1 ≤ -1 + · apply htri (-1, -1) (-4/3, -2/3) (-1, 0) + (2 * p.1 - p.2 + 2) (-3 * (p.1 + 1)) (p.1 + p.2 + 2) + · linarith + · linarith + · linarith + · ring + · exact hv2 + · exact hv3 + · exact hv4 + · ext <;> simp <;> ring + · by_cases hC : 0 ≤ p.2 + · apply htri (-1, 0) (-1/3, 1/3) (0, 0) + (-p.1 - p.2) (3 * p.2) (1 + p.1 - 2 * p.2) + · linarith + · linarith + · linarith + · ring + · exact hv4 + · exact hv5 + · exact hv0 + · ext <;> simp <;> ring + · apply htri (0, 0) (-1, -1) (-1, 0) + (1 + p.1) (-p.2) (p.2 - p.1) + · linarith + · linarith + · linarith + · ring + · exact hv0 + · exact hv2 + · exact hv4 + · ext <;> simp + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1IntegerCoverage.lean b/LeanPool/ApollonianSuperharmonic/P4780T1IntegerCoverage.lean new file mode 100644 index 0000000000..793db9029c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4780T1IntegerCoverage.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4780T1HullHalfspaces +public import Mathlib.Algebra.Order.Archimedean.Real.Basic + +-- [TABLET NODE: P4780T1IntegerCoverage] + +/-! +# P4780T1IntegerCoverage + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4780T1IntegerCoverage : + (⋃ k : Int × Int, + (fun p : Real × Real => p + ((k.1 : Real), (k.2 : Real))) '' + P4715T1Hexagon) = Set.univ := by +-- BODY + ext p + simp only [Set.mem_univ, iff_true, Set.mem_iUnion] + let m : Int := ⌊p.1⌋ + let n : Int := ⌊p.2⌋ + let u : Real := p.1 - (m : Real) + let v : Real := p.2 - (n : Real) + have hu0 : 0 ≤ u := sub_nonneg.mpr (Int.floor_le p.1) + have hv0 : 0 ≤ v := sub_nonneg.mpr (Int.floor_le p.2) + have hu1 : u < 1 := Int.fract_lt_one p.1 + have hv1 : v < 1 := Int.fract_lt_one p.2 + suffices ∃ i j : Int, (u - (i : Real), v - (j : Real)) ∈ P4715T1Hexagon by + rcases this with ⟨i, j, hij⟩ + refine ⟨(m + i, n + j), _, hij, ?_⟩ + ext <;> simp [u, v, Int.cast_add] + by_cases hA : u ≤ 2*v + · by_cases hB : 2*u-v ≤ 1 + · refine ⟨1, 1, ?_⟩ + rw [P4780T1HullHalfspaces] + norm_num only [Int.cast_ofNat] + change -2 ≤ 2*(u-1)-(v-1) ∧ 2*(u-1)-(v-1) ≤ 0 ∧ + -1 ≤ (u-1)-2*(v-1) ∧ (u-1)-2*(v-1) ≤ 1 ∧ + -2 ≤ (u-1)+(v-1) ∧ (u-1)+(v-1) ≤ 0 + exact ⟨by linarith, by linarith, by linarith, + by linarith, by linarith, by linarith⟩ + · have hsum : 1 ≤ u+v := by linarith + refine ⟨2, 1, ?_⟩ + rw [P4780T1HullHalfspaces] + norm_num only [Int.cast_ofNat] + change -2 ≤ 2*(u-2)-(v-1) ∧ 2*(u-2)-(v-1) ≤ 0 ∧ + -1 ≤ (u-2)-2*(v-1) ∧ (u-2)-2*(v-1) ≤ 1 ∧ + -2 ≤ (u-2)+(v-1) ∧ (u-2)+(v-1) ≤ 0 + exact ⟨by linarith, by linarith, by linarith, + by linarith, by linarith, by linarith⟩ + · by_cases hsum : u+v ≤ 1 + · refine ⟨1, 0, ?_⟩ + rw [P4780T1HullHalfspaces] + norm_num only [Int.cast_ofNat, Int.cast_zero] + change -2 ≤ 2*(u-1)-(v-0) ∧ 2*(u-1)-(v-0) ≤ 0 ∧ + -1 ≤ (u-1)-2*(v-0) ∧ (u-1)-2*(v-0) ≤ 1 ∧ + -2 ≤ (u-1)+(v-0) ∧ (u-1)+(v-0) ≤ 0 + exact ⟨by linarith, by linarith, by linarith, + by linarith, by linarith, by linarith⟩ + · have hX : 1 < 2*u-v := by linarith + refine ⟨2, 1, ?_⟩ + rw [P4780T1HullHalfspaces] + norm_num only [Int.cast_ofNat] + change -2 ≤ 2*(u-2)-(v-1) ∧ 2*(u-2)-(v-1) ≤ 0 ∧ + -1 ≤ (u-2)-2*(v-1) ∧ (u-2)-2*(v-1) ≤ 1 ∧ + -2 ≤ (u-2)+(v-1) ∧ (u-2)+(v-1) ≤ 0 + exact ⟨by linarith, by linarith, by linarith, + by linarith, by linarith, by linarith⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1InteriorSeparation.lean b/LeanPool/ApollonianSuperharmonic/P4780T1InteriorSeparation.lean new file mode 100644 index 0000000000..ba9b1d3bce --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4780T1InteriorSeparation.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4780T1OverlapBound +public import LeanPool.ApollonianSuperharmonic.P4780T1StrictInterior +public import Mathlib.Topology.Algebra.Group.Basic + +-- [TABLET NODE: P4780T1InteriorSeparation] + +/-! +# P4780T1InteriorSeparation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4780T1InteriorSeparation : + Pairwise fun k l : Int × Int => Disjoint + (interior ((fun p : Real × Real => p + ((k.1 : Real), (k.2 : Real))) '' + P4715T1Hexagon)) + (interior ((fun p : Real × Real => p + ((l.1 : Real), (l.2 : Real))) '' + P4715T1Hexagon)) := by +-- BODY + intro k l hkl + apply Set.disjoint_left.mpr + intro p hp hq + have ht (c : Real × Real) : + interior ((fun p : Real × Real => p + c) '' P4715T1Hexagon) = + (fun p : Real × Real => p + c) '' interior P4715T1Hexagon := by + simpa using ((Homeomorph.addRight c).image_interior P4715T1Hexagon).symm + rw [ht] at hp hq + rcases hp with ⟨a, ha, hap⟩ + rcases hq with ⟨b, hb, hbp⟩ + let d := l - k + have hab : a = b + ((d.1 : Real), (d.2 : Real)) := by + have h1 := congrArg Prod.fst (hap.trans hbp.symm) + have h2 := congrArg Prod.snd (hap.trans hbp.symm) + ext <;> simp [d, Int.cast_sub] at * <;> linarith + have hd := P4780T1OverlapBound d a b (interior_subset ha) (interior_subset hb) hab + have hne : d ≠ 0 := sub_ne_zero.mpr (Ne.symm hkl) + rw [P4780T1StrictInterior] at ha hb + rcases ha with ⟨ha1, ha2, ha3, ha4, ha5, ha6⟩ + rcases hb with ⟨hb1, hb2, hb3, hb4, hb5, hb6⟩ + rcases d with ⟨x, y⟩ + rcases hd with ⟨hx0, hx1, hy0, hy1⟩ + have he1 := congrArg Prod.fst hab + have he2 := congrArg Prod.snd hab + simp only [Prod.fst_add, Prod.snd_add] at he1 he2 + interval_cases x <;> interval_cases y <;> norm_num at he1 he2 hne <;> linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1NeighborCorners.lean b/LeanPool/ApollonianSuperharmonic/P4780T1NeighborCorners.lean new file mode 100644 index 0000000000..84ab417530 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4780T1NeighborCorners.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1VertexShift +public import LeanPool.ApollonianSuperharmonic.P4715T1BoundaryCycle +public import Mathlib.Data.Fintype.Sets + +-- [TABLET NODE: P4780T1NeighborCorners] + +/-! +# P4780T1NeighborCorners + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4780T1NeighborCorners (j : Fin 6) : + let d : Int × Int := ![(1,0), (0,-1), (-1,-1), (-1,0), (0,1), (1,1)] j + Set.range P4715T1BoundaryCycle ∩ + Set.range (P4715T1VertexShift d ∘ P4715T1BoundaryCycle) = + {P4715T1BoundaryCycle j, P4715T1BoundaryCycle (j+1)} := by +-- BODY + have hf : ∀ j : Fin 6, + let d : Int × Int := ![(1,0), (0,-1), (-1,-1), (-1,0), (0,1), (1,1)] j + (Finset.univ.image P4715T1BoundaryCycle) ∩ + (Finset.univ.image (P4715T1VertexShift d ∘ P4715T1BoundaryCycle)) = + {P4715T1BoundaryCycle j, P4715T1BoundaryCycle (j+1)} := by + decide +kernel + have he := congrArg (fun s : Finset PeriodicSubtileIndex => + (s : Set PeriodicSubtileIndex)) (hf j) + simpa only [Finset.coe_inter, Fintype.coe_image_univ, + Finset.coe_insert, Finset.coe_singleton] using he + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1NeighborFacets.lean b/LeanPool/ApollonianSuperharmonic/P4780T1NeighborFacets.lean new file mode 100644 index 0000000000..5f7752152c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4780T1NeighborFacets.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4780T1ActiveFacets + +-- [TABLET NODE: P4780T1NeighborFacets] + +/-! +# P4780T1NeighborFacets + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4780T1NeighborFacets (j : Fin 6) : + let d : Int × Int := ![(1,0), (0,-1), (-1,-1), (-1,0), (0,1), (1,1)] j + P4715T1Hexagon ∩ + ((fun p : Real × Real => p + ((d.1 : Real), (d.2 : Real))) '' + P4715T1Hexagon) = + P4715T1Arc (P4715T1BoundaryCycle j) + (P4715T1BoundaryCycle (j + 1)) := by +-- BODY + have ht (c : Real × Real) : + (fun x : Real × Real => x + c) '' P4715T1Hexagon = + {p | p-c ∈ P4715T1Hexagon} := by + ext p + constructor + · rintro ⟨x, hx, rfl⟩ + simpa using hx + · intro hp + exact ⟨p-c, hp, sub_add_cancel p c⟩ + dsimp only + rw [P4780T1ActiveFacets] + ext p + fin_cases j + all_goals + simp? [ht, P4780T1HullHalfspaces] + intro ha1 ha2 ha3 ha4 ha5 ha6 + constructor + · rintro ⟨hb1, hb2, hb3, hb4, hb5, hb6⟩ + linarith + · intro he + exact ⟨by linarith, by linarith, by linarith, + by linarith, by linarith, by linarith⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1OverlapBound.lean b/LeanPool/ApollonianSuperharmonic/P4780T1OverlapBound.lean new file mode 100644 index 0000000000..e2bb5224c0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4780T1OverlapBound.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4780T1HullHalfspaces + +-- [TABLET NODE: P4780T1OverlapBound] + +/-! +# P4780T1OverlapBound + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4780T1OverlapBound (d : Int × Int) (a b : Real × Real) + (ha : a ∈ P4715T1Hexagon) (hb : b ∈ P4715T1Hexagon) + (hab : a = b + ((d.1 : Real), (d.2 : Real))) : + -1 ≤ d.1 ∧ d.1 ≤ 1 ∧ -1 ≤ d.2 ∧ d.2 ≤ 1 := by +-- BODY + rw [P4780T1HullHalfspaces] at ha hb + rcases ha with ⟨ha1, ha2, ha3, ha4, ha5, ha6⟩ + rcases hb with ⟨hb1, hb2, hb3, hb4, hb5, hb6⟩ + have he1 := congrArg Prod.fst hab + have he2 := congrArg Prod.snd hab + simp only [Prod.fst_add, Prod.snd_add] at he1 he2 + have hx0 : (-2 : Real) < (d.1 : Real) := by linarith + have hx1 : (d.1 : Real) < 2 := by linarith + have hy0 : (-2 : Real) < (d.2 : Real) := by linarith + have hy1 : (d.2 : Real) < 2 := by linarith + have hx0' : (-2 : Int) < d.1 := by exact_mod_cast hx0 + have hx1' : d.1 < 2 := by exact_mod_cast hx1 + have hy0' : (-2 : Int) < d.2 := by exact_mod_cast hy0 + have hy1' : d.2 < 2 := by exact_mod_cast hy1 + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1StrictInterior.lean b/LeanPool/ApollonianSuperharmonic/P4780T1StrictInterior.lean new file mode 100644 index 0000000000..062e362e51 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4780T1StrictInterior.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4780T1HullHalfspaces +public import Mathlib.Topology.Algebra.Module.FiniteDimension +public import Mathlib.Topology.Maps.Basic + +-- [TABLET NODE: P4780T1StrictInterior] + +/-! +# P4780T1StrictInterior + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4780T1StrictInterior : + interior P4715T1Hexagon = {p : Real × Real | + -2 < 2 * p.1 - p.2 ∧ 2 * p.1 - p.2 < 0 ∧ + -1 < p.1 - 2 * p.2 ∧ p.1 - 2 * p.2 < 1 ∧ + -2 < p.1 + p.2 ∧ p.1 + p.2 < 0} := by +-- BODY + have hi (f : (Real × Real) →ₗ[Real] Real) (hf : Function.Surjective f) + (a b : Real) : interior {p | a ≤ f p ∧ f p ≤ b} = + {p | a < f p ∧ f p < b} := by + have ho := LinearMap.isOpenMap_of_finiteDimensional f hf + have hc := f.continuous_of_finiteDimensional + have h1 : interior (f ⁻¹' Set.Ici a) = f ⁻¹' Set.Ioi a := by + rw [← ho.preimage_interior_eq_interior_preimage hc, interior_Ici] + have h2 : interior (f ⁻¹' Set.Iic b) = f ⁻¹' Set.Iio b := by + rw [← ho.preimage_interior_eq_interior_preimage hc, interior_Iic] + change interior ((f ⁻¹' Set.Ici a) ∩ (f ⁻¹' Set.Iic b)) = _ + rw [interior_inter, h1, h2] + rfl + let f : (Real × Real) →ₗ[Real] Real := + IsLinearMap.mk' (fun p : Real × Real => 2*p.1-p.2) (by + constructor <;> intros <;> simp <;> ring) + let g : (Real × Real) →ₗ[Real] Real := + IsLinearMap.mk' (fun p : Real × Real => p.1-2*p.2) (by + constructor <;> intros <;> simp <;> ring) + let h : (Real × Real) →ₗ[Real] Real := + IsLinearMap.mk' (fun p : Real × Real => p.1+p.2) (by + constructor <;> intros <;> simp <;> ring) + have hf : Function.Surjective f := by + intro x + exact ⟨(x / 2, 0), by simp [f, IsLinearMap.mk']; ring⟩ + have hg : Function.Surjective g := by + intro x + exact ⟨(x, 0), by simp [g, IsLinearMap.mk']⟩ + have hh : Function.Surjective h := by + intro x + exact ⟨(x, 0), by simp [h, IsLinearMap.mk']⟩ + rw [P4780T1HullHalfspaces] + rw [show {p : Real × Real | + -2 ≤ 2 * p.1 - p.2 ∧ 2 * p.1 - p.2 ≤ 0 ∧ + -1 ≤ p.1 - 2 * p.2 ∧ p.1 - 2 * p.2 ≤ 1 ∧ + -2 ≤ p.1 + p.2 ∧ p.1 + p.2 ≤ 0} = + ({p | -2 ≤ f p ∧ f p ≤ 0} ∩ + ({p | -1 ≤ g p ∧ g p ≤ 1} ∩ {p | -2 ≤ h p ∧ h p ≤ 0})) by + ext p; simp [f, g, h, and_assoc]] + rw [interior_inter, interior_inter, hi f hf, hi g hg, hi h hh] + ext p + simp only [Set.mem_inter_iff, Set.mem_ofPred_eq, f, g, h, + IsLinearMap.mk'_apply, and_assoc] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4783T1ParallelogramFan.lean b/LeanPool/ApollonianSuperharmonic/P4783T1ParallelogramFan.lean new file mode 100644 index 0000000000..9e44875bb5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4783T1ParallelogramFan.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Tactic.Module + +-- [TABLET NODE: P4783T1ParallelogramFan] + +/-! +# P4783T1ParallelogramFan + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4783T1ParallelogramFan + {E : Type*} [AddCommGroup E] [Module Real E] + (A u v : E) (x y : Real) + (hx : 0 ≤ x) (hx' : x ≤ 1) (hy : 0 ≤ y) (hy' : y ≤ 1) : + let O := A + (1 / 2 : Real) • u + (1 / 2 : Real) • v + let z := A + x • u + y • v + z ∈ convexHull Real ({A, A + u, O} : Set E) ∨ + z ∈ convexHull Real ({A + u, A + u + v, O} : Set E) ∨ + z ∈ convexHull Real ({A + u + v, A + v, O} : Set E) ∨ + z ∈ convexHull Real ({A + v, A, O} : Set E) := by +-- BODY + dsimp only + have triangle (P Q R : E) (a b c : Real) + (ha : 0 ≤ a) (hb : 0 ≤ b) (hc : 0 ≤ c) (hs : a + b + c = 1) : + a • P + b • Q + c • R ∈ convexHull Real ({P, Q, R} : Set E) := by + apply mem_convexHull_of_exists_fintype (ι := Fin 3) ![a, b, c] ![P, Q, R] + · intro i + fin_cases i + · exact ha + · exact hb + · exact hc + · simpa [Fin.sum_univ_succ, add_assoc] using hs + · intro i + fin_cases i <;> simp + · simp [Fin.sum_univ_succ, add_assoc] + by_cases hxy : y ≤ x + · by_cases hsum : x + y ≤ 1 + · left + convert triangle A (A + u) (A + (1 / 2 : Real) • u + (1 / 2 : Real) • v) + (1 - x - y) (x - y) (2 * y) (by linarith) (by linarith) + (by linarith) (by ring) using 1; module + · right; left + convert triangle (A + u) (A + u + v) + (A + (1 / 2 : Real) • u + (1 / 2 : Real) • v) + (x - y) (x + y - 1) (2 - 2 * x) (by linarith) (by linarith) + (by linarith) (by ring) using 1; module + · by_cases hsum : x + y ≤ 1 + · right; right; right + convert triangle (A + v) A (A + (1 / 2 : Real) • u + (1 / 2 : Real) • v) + (y - x) (1 - x - y) (2 * x) (by linarith) (by linarith) + (by linarith) (by ring) using 1; module + · right; right; left + convert triangle (A + u + v) (A + v) + (A + (1 / 2 : Real) • u + (1 / 2 : Real) • v) + (x + y - 1) (y - x) (2 - 2 * y) (by linarith) (by linarith) + (by linarith) (by ring) using 1; module + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4783T1PatchCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4783T1PatchCoordinates.lean new file mode 100644 index 0000000000..6a5f7f362d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4783T1PatchCoordinates.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1Position +public import LeanPool.ApollonianSuperharmonic.P4715T1PatchFaces +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices + +-- [TABLET NODE: P4783T1PatchCoordinates] + +/-! +# P4783T1PatchCoordinates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4783T1PatchCoordinates (j : Fin 12) : + P4715T1Position ∘ SixSubtileFaceVertices (P4715T1PatchFaces j) = + (![![(0,0),(-1/3,-2/3),(-1/2,-1/2)], + ![(-1,-1),(-1/3,-2/3),(-1/2,-1/2)], + ![(-1,0),(-4/3,-2/3),(-5/6,-1/6)], + ![(-1,0),(-1/3,1/3),(-5/6,-1/6)], + ![(-1,-1),(-1/2,-1/2),(-11/12,-7/12)], + ![(-1/2,-1/2),(-5/6,-1/6),(-11/12,-7/12)], + ![(-4/3,-2/3),(-5/6,-1/6),(-11/12,-7/12)], + ![(-1,-1),(-4/3,-2/3),(-11/12,-7/12)], + ![(0,0),(-1/2,-1/2),(-5/12,-1/12)], + ![(-1/2,-1/2),(-5/6,-1/6),(-5/12,-1/12)], + ![(-1/3,1/3),(-5/6,-1/6),(-5/12,-1/12)], + ![(0,0),(-1/3,1/3),(-5/12,-1/12)]] : + Fin 12 → Fin 3 → Real × Real) j := by +-- BODY + fin_cases j <;> funext k <;> fin_cases k <;> + norm_num [P4715T1Position, P4715T1Offsets, + P4715T1PatchFaces, SixSubtileFaceVertices, Function.comp_def] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4783T1PatchCoverage.lean b/LeanPool/ApollonianSuperharmonic/P4783T1PatchCoverage.lean new file mode 100644 index 0000000000..affb42ebfe --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4783T1PatchCoverage.lean @@ -0,0 +1,228 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1Hexagon +public import LeanPool.ApollonianSuperharmonic.P4715T1PatchFaces +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import LeanPool.ApollonianSuperharmonic.P4783T1ParallelogramFan +public import LeanPool.ApollonianSuperharmonic.P4783T1PatchCoordinates + + +-- [TABLET NODE: P4783T1PatchCoverage] + +/-! +# P4783T1PatchCoverage + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4783T1PatchCoverage : + (⋃ j : Fin 12, convexHull Real (P4715T1Position '' + Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j)))) = + P4715T1Hexagon := by +-- BODY + classical + let U : Real × Real := (0, 0) + let V : Real × Real := (-(1/3), -(2/3)) + let X : Real × Real := (-1, -1) + let Y : Real × Real := (-(4/3), -(2/3)) + let Z : Real × Real := (-1, 0) + let W : Real × Real := (-(1/3), 1/3) + let C : Real × Real := (-(1/2), -(1/2)) + let D : Real × Real := (-(5/6), -(1/6)) + let E : Real × Real := (-(11/12), -(7/12)) + let F : Real × Real := (-(5/12), -(1/12)) + let q : Fin 12 → Fin 3 → Real × Real := ![ + ![U, V, C], ![X, V, C], ![Z, Y, D], ![Z, W, D], + ![X, C, E], ![C, D, E], ![Y, D, E], ![X, Y, E], + ![U, C, F], ![C, D, F], ![W, D, F], ![U, W, F]] + have htable (j : Fin 12) : + P4715T1Position ∘ SixSubtileFaceVertices (P4715T1PatchFaces j) = q j := by + simpa only [q,U,V,X,Y,Z,W,C,D,E,F, neg_div] using + P4783T1PatchCoordinates j + have hK (j : Fin 12) : + convexHull Real (P4715T1Position '' + Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j))) = + convexHull Real (Set.range (q j)) := by + rw [← Set.range_comp, htable j] + have hboundary : P4715T1Position ∘ P4715T1BoundaryCycle = + ![U, V, X, Y, Z, W] := by + as_aux_lemma => + funext i + fin_cases i <;> norm_num [P4715T1Position, P4715T1Offsets, + P4715T1BoundaryCycle, Function.comp_def, + Matrix.cons_val_zero', Matrix.cons_val_succ', U, V, X, Y, Z, W] + have hhex : P4715T1Hexagon = + convexHull Real ({U, V, X, Y, Z, W} : Set (Real × Real)) := by + unfold P4715T1Hexagon + rw [hboundary] + congr 1 + ext z + simp [Matrix.range_cons]; tauto + have hconv : Convex Real P4715T1Hexagon := by + rw [hhex]; exact convex_convexHull _ _ + have hcorner (z : Real × Real) (hz : z ∈ ({U,V,X,Y,Z,W} : Set (Real × Real))) : + z ∈ P4715T1Hexagon := by + rw [hhex]; exact subset_convexHull _ _ hz + have hU := hcorner U (by simp) + have hV := hcorner V (by simp) + have hX := hcorner X (by simp) + have hY := hcorner Y (by simp) + have hZ := hcorner Z (by simp) + have hW := hcorner W (by simp) + have hmid (P Q : Real × Real) (hP : P ∈ P4715T1Hexagon) + (hQ : Q ∈ P4715T1Hexagon) : + (1/2 : Real) • P + (1/2 : Real) • Q ∈ P4715T1Hexagon := + hconv hP hQ (by norm_num) (by norm_num) (by norm_num) + have hC : C ∈ P4715T1Hexagon := by + convert hmid U X hU hX using 1; norm_num [C, U, X] + have hD : D ∈ P4715T1Hexagon := by + convert hmid Y W hY hW using 1; norm_num [D, Y, W] + have hE : E ∈ P4715T1Hexagon := by + convert hmid X D hX hD using 1; norm_num [E, X, D] + have hF : F ∈ P4715T1Hexagon := by + convert hmid U D hU hD using 1; norm_num [F, U, D] + have range3 (p : Fin 3 → Real × Real) : + Set.range p = ({p 0, p 1, p 2} : Set (Real × Real)) := by + ext z + simp [Set.mem_range, Fin.exists_fin_succ, eq_comm] + have toHull (j : Fin 12) (z : Real × Real) (a b c : Real) + (ha : 0 ≤ a) (hb : 0 ≤ b) (hc : 0 ≤ c) (hs : a + b + c = 1) + (heq : a • q j 0 + b • q j 1 + c • q j 2 = z) : + z ∈ convexHull Real (Set.range (q j)) := by + as_aux_lemma => + apply mem_convexHull_of_exists_fintype (ι := Fin 3) ![a,b,c] (q j) + · intro k + fin_cases k + · exact ha + · exact hb + · exact hc + · simpa [Fin.sum_univ_succ, add_assoc] using hs + · intro k; exact Set.mem_range_self k + · simpa [Fin.sum_univ_succ, add_assoc] using heq + simp_rw [hK] + apply Set.Subset.antisymm + · apply Set.iUnion_subset + intro j + apply convexHull_min _ hconv + rintro _ ⟨k, rfl⟩ + fin_cases j <;> fin_cases k <;> + first | exact hU | exact hV | exact hX | exact hY | exact hZ | + exact hW | exact hC | exact hD | exact hE | exact hF + · intro z hz + have bound (a b r : Real) + (hv : ∀ w ∈ ({U,V,X,Y,Z,W} : Set (Real × Real)), a*w.1+b*w.2 ≤ r) : + a*z.1+b*z.2 ≤ r := by + as_aux_lemma => + rw [hhex] at hz + apply convexHull_min hv (convex_halfSpace_le (f := fun w : Real × Real => + a*w.1+b*w.2) ?_ r) hz + constructor + · intro p q; simp; ring + · intro t p; simp; ring + have hbds : (1/2)*z.1+(1/2)*z.2 ≤ 0 ∧ (-1/2)*z.1+(-1/2)*z.2 ≤ 1 ∧ + 2*z.1+(-1)*z.2 ≤ 0 ∧ 1*z.1+(-2)*z.2 ≤ 1 ∧ + (-1)*z.1+2*z.2 ≤ 1 ∧ (-2)*z.1+1*z.2 ≤ 2 := by + as_aux_lemma => + refine ⟨bound (1/2) (1/2) 0 ?_, bound (-1/2) (-1/2) 1 ?_, + bound 2 (-1) 0 ?_, bound 1 (-2) 1 ?_, + bound (-1) 2 1 ?_, bound (-2) 1 2 ?_⟩ + all_goals + intro w hw + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hw + rcases hw with rfl | rfl | rfl | rfl | rfl | rfl <;> + norm_num [U,V,X,Y,Z,W] + let a := -(z.1+z.2)/2 + let b := -3*(z.1-z.2)/2 + have ha : 0 ≤ a := by dsimp [a]; linarith [hbds.1] + have ha' : a ≤ 1 := by dsimp [a]; linarith [hbds.2.1] + have hlo : -a ≤ b ∧ a-1 ≤ b := by + dsimp [a,b]; constructor <;> linarith [hbds.2.2.1, hbds.2.2.2.1] + have hhi : b ≤ 1+a ∧ b ≤ 2-a := by + dsimp [a,b]; constructor <;> linarith [hbds.2.2.2.2.1, hbds.2.2.2.2.2] + by_cases hb : b ≤ 0 + · by_cases ha2 : a ≤ 1/2 + · apply Set.mem_iUnion.mpr + refine ⟨0, toHull 0 z (1-2*a) (-2*b) (2*a+2*b) + (by linarith) (by linarith) (by linarith [hlo.1]) (by ring) ?_⟩ + change (1-2*a) • U + (-2*b) • V + (2*a+2*b) • C = z + ext <;> dsimp [U,V,C,a,b] <;> ring + · apply Set.mem_iUnion.mpr + refine ⟨1, toHull 1 z (2*a-1) (-2*b) (2-2*a+2*b) + (by linarith) (by linarith) (by linarith [hlo.2]) (by ring) ?_⟩ + change (2*a-1) • X + (-2*b) • V + (2-2*a+2*b) • C = z + ext <;> dsimp [X,V,C,a,b] <;> ring + · by_cases hb' : 1 ≤ b + · by_cases ha2 : a ≤ 1/2 + · apply Set.mem_iUnion.mpr + refine ⟨3, toHull 3 z (2*b-2) (1-2*a) (2*a-2*b+2) + (by linarith) (by linarith) (by linarith [hhi.1]) (by ring) ?_⟩ + change (2*b-2) • Z + (1-2*a) • W + (2*a-2*b+2) • D = z + ext <;> dsimp [Z,W,D,a,b] <;> ring + · apply Set.mem_iUnion.mpr + refine ⟨2, toHull 2 z (2*b-2) (2*a-1) (4-2*a-2*b) + (by linarith) (by linarith) (by linarith [hhi.2]) (by ring) ?_⟩ + change (2*b-2) • Z + (2*a-1) • Y + (4-2*a-2*b) • D = z + ext <;> dsimp [Z,Y,D,a,b] <;> ring + · by_cases ha2 : a ≤ 1/2 + · have hf := P4783T1ParallelogramFan U C W (2*a) b + (by linarith) (by linarith) (by linarith) (by linarith) + have heq : U + (2*a) • C + b • W = z := by + ext <;> dsimp [U,C,W,a,b] <;> ring + dsimp only at hf + rw [heq] at hf + norm_num [U,C,W] at hf + rcases hf with hf | hf | hf | hf + · exact Set.mem_iUnion.mpr ⟨8, by + rw [range3] + change z ∈ convexHull Real ({U,C,F} : Set (Real × Real)) + simpa [U,C,F] using hf⟩ + · exact Set.mem_iUnion.mpr ⟨9, by + rw [range3] + change z ∈ convexHull Real ({C,D,F} : Set (Real × Real)) + simpa [C,D,F] using hf⟩ + · exact Set.mem_iUnion.mpr ⟨10, by + rw [range3] + change z ∈ convexHull Real ({W,D,F} : Set (Real × Real)) + simpa [W,D,F, Set.insert_comm] using hf⟩ + · exact Set.mem_iUnion.mpr ⟨11, by + rw [range3] + change z ∈ convexHull Real ({U,W,F} : Set (Real × Real)) + simpa [U,W,F, Set.insert_comm] using hf⟩ + · have hf := P4783T1ParallelogramFan C C W (2*a-1) b + (by linarith) (by linarith) (by linarith) (by linarith) + have heq : C + (2*a-1) • C + b • W = z := by + ext <;> dsimp [C,W,a,b] <;> ring + dsimp only at hf + rw [heq] at hf + norm_num [C,W] at hf + rcases hf with hf | hf | hf | hf + · exact Set.mem_iUnion.mpr ⟨4, by + rw [range3] + change z ∈ convexHull Real ({X,C,E} : Set (Real × Real)) + simpa [X,C,E, Set.insert_comm] using hf⟩ + · exact Set.mem_iUnion.mpr ⟨7, by + rw [range3] + change z ∈ convexHull Real ({X,Y,E} : Set (Real × Real)) + simpa [X,Y,E] using hf⟩ + · exact Set.mem_iUnion.mpr ⟨6, by + rw [range3] + change z ∈ convexHull Real ({Y,D,E} : Set (Real × Real)) + simpa [Y,D,E] using hf⟩ + · exact Set.mem_iUnion.mpr ⟨5, by + rw [range3] + change z ∈ convexHull Real ({C,D,E} : Set (Real × Real)) + simpa [C,D,E, Set.insert_comm] using hf⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4783T1PatchDeterminants.lean b/LeanPool/ApollonianSuperharmonic/P4783T1PatchDeterminants.lean new file mode 100644 index 0000000000..83eda2488e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4783T1PatchDeterminants.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4783T1PatchCoordinates + +-- [TABLET NODE: P4783T1PatchDeterminants] + +/-! +# P4783T1PatchDeterminants + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4783T1PatchDeterminants (j : Fin 12) : + let p := P4715T1Position ∘ SixSubtileFaceVertices (P4715T1PatchFaces j) + (p 1).1 * (p 2).2 - (p 1).1 * (p 0).2 - + (p 0).1 * (p 2).2 - (p 1).2 * (p 2).1 + + (p 1).2 * (p 0).1 + (p 0).2 * (p 2).1 ≠ 0 := by +-- BODY + dsimp only + rw [P4783T1PatchCoordinates] + fin_cases j <;> norm_num [Matrix.cons_val_two] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4793T1FacetForms.lean b/LeanPool/ApollonianSuperharmonic/P4793T1FacetForms.lean new file mode 100644 index 0000000000..d6a57765f0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4793T1FacetForms.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.LinearAlgebra.AffineSpace.AffineMap +public import Mathlib.Data.Fin.VecNotation +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P4793T1FacetForms] + +/-! +# P4793T1FacetForms + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +In the cyclic side order of the coefficient hexagon, let $F_l$, +$l=0,\ldots,5$, be the following real-valued affine maps on the real plane: +$$ +F_0(s,t)=-2s+t,\quad F_1(s,t)=-s+2t+1,\quad +F_2(s,t)=s+t+2,\quad F_3(s,t)=2s-t+2,\quad +F_4(s,t)=s-2t+1,\quad F_5(s,t)=-s-t. +$$ +-/ +def P4793T1FacetForms (l : Fin 6) : (Real × Real) →ᵃ[Real] Real := +-- BODY + let t : Real × Real × Real := + ![(-2,1,0),(-1,2,1),(1,1,2),(2,-1,2),(1,-2,1),(-1,-1,0)] l + { toFun := fun z => t.1*z.1+t.2.1*z.2+t.2.2 + linear := + { toFun := fun z => t.1*z.1+t.2.1*z.2 + map_add' := by intros; simp; ring + map_smul' := by intros; simp; ring } + map_vadd' := by intros; simp; ring } + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4793T1PatchBoundaryTraces.lean b/LeanPool/ApollonianSuperharmonic/P4793T1PatchBoundaryTraces.lean new file mode 100644 index 0000000000..4413108dca --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4793T1PatchBoundaryTraces.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4793T1PatchFacetLedger +public import LeanPool.ApollonianSuperharmonic.P4793T1SupportingFace +public import LeanPool.ApollonianSuperharmonic.P4783T1PatchCoverage +public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonTessellation + +-- [TABLET NODE: P4793T1PatchBoundaryTraces] + +/-! +# P4793T1PatchBoundaryTraces + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4793T1PatchBoundaryTraces (j : Fin 12) : + convexHull Real (P4715T1Position '' + Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j))) ∩ + frontier P4715T1Hexagon = + convexHull Real (P4715T1Position '' + (Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j)) ∩ + Set.range P4715T1BoundaryCycle)) := by +-- BODY + let V := Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j)) + let S := P4715T1Position '' V + have hK : convexHull Real S ⊆ P4715T1Hexagon := by + intro x hx + rw [← P4783T1PatchCoverage] + exact Set.mem_iUnion.mpr ⟨j, hx⟩ + have hside (l : Fin 6) : + P4715T1Arc (P4715T1BoundaryCycle l) + (P4715T1BoundaryCycle (l+1)) = + P4715T1Hexagon ∩ {x | P4793T1FacetForms l x = 0} := by + rw [P4780T1ActiveFacets] + congr 1 + ext x + fin_cases l <;> norm_num [P4793T1FacetForms] <;> constructor <;> intro h <;> linarith + have hface (l : Fin 6) := P4793T1SupportingFace S (P4793T1FacetForms l) + (by + rintro _ ⟨_, ⟨k, rfl⟩, rfl⟩ + exact P4793T1PatchFacetLedger.1 j l k) + apply Set.Subset.antisymm + · intro x hx + have hb := hx.2 + rw [P4715T1HexagonTessellation.2.1] at hb + obtain ⟨l, hl⟩ := Set.mem_iUnion.mp hb + rw [hside] at hl + have hm : x ∈ convexHull Real (S ∩ {x | P4793T1FacetForms l x = 0}) := by + rw [← (hface l).2] + exact ⟨hx.1, hl.2⟩ + apply convexHull_mono (t := P4715T1Position '' + (V ∩ Set.range P4715T1BoundaryCycle)) ?_ hm + rintro _ ⟨⟨_, ⟨k, rfl⟩, rfl⟩, hz⟩ + exact ⟨_, ⟨⟨k, rfl⟩, P4793T1PatchFacetLedger.2.1 j l k hz⟩, rfl⟩ + · intro x hx + obtain ⟨l, hl⟩ := P4793T1PatchFacetLedger.2.2 j + have hm : x ∈ convexHull Real (S ∩ {x | P4793T1FacetForms l x = 0}) := by + apply convexHull_mono (s := P4715T1Position '' + (V ∩ Set.range P4715T1BoundaryCycle)) ?_ hx + rintro _ ⟨_, ⟨⟨k, rfl⟩, hb⟩, rfl⟩ + exact ⟨⟨_, ⟨k, rfl⟩, rfl⟩, hl k hb⟩ + rw [← (hface l).2] at hm + refine ⟨hm.1, ?_⟩ + rw [P4715T1HexagonTessellation.2.1] + apply Set.mem_iUnion.mpr + refine ⟨l, ?_⟩ + rw [hside] + exact ⟨hK hm.1, hm.2⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4793T1PatchFacetLedger.lean b/LeanPool/ApollonianSuperharmonic/P4793T1PatchFacetLedger.lean new file mode 100644 index 0000000000..aad9951dac --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4793T1PatchFacetLedger.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4793T1FacetForms +public import LeanPool.ApollonianSuperharmonic.P4783T1PatchCoordinates +public import LeanPool.ApollonianSuperharmonic.P4715T1BoundaryCycle + +-- [TABLET NODE: P4793T1PatchFacetLedger] + +/-! +# P4793T1PatchFacetLedger + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4793T1PatchFacetLedger : + let v := fun j => SixSubtileFaceVertices (P4715T1PatchFaces j) + let p := fun j => P4715T1Position ∘ v j + (∀ (j : Fin 12) (l : Fin 6) (k : Fin 3), 0 ≤ P4793T1FacetForms l (p j k)) ∧ + (∀ (j : Fin 12) (l : Fin 6) (k : Fin 3), + P4793T1FacetForms l (p j k) = 0 → v j k ∈ Set.range P4715T1BoundaryCycle) ∧ + ∀ j : Fin 12, ∃ l : Fin 6, ∀ k : Fin 3, + v j k ∈ Set.range P4715T1BoundaryCycle → P4793T1FacetForms l (p j k) = 0 := by +-- BODY + let q : Fin 12 → Fin 3 → Int × Int := ![ + ![(0,0),(-4,-8),(-6,-6)], + ![(-12,-12),(-4,-8),(-6,-6)], + ![(-12,0),(-16,-8),(-10,-2)], + ![(-12,0),(-4,4),(-10,-2)], + ![(-12,-12),(-6,-6),(-11,-7)], + ![(-6,-6),(-10,-2),(-11,-7)], + ![(-16,-8),(-10,-2),(-11,-7)], + ![(-12,-12),(-16,-8),(-11,-7)], + ![(0,0),(-6,-6),(-5,-1)], + ![(-6,-6),(-10,-2),(-5,-1)], + ![(-4,4),(-10,-2),(-5,-1)], + ![(0,0),(-4,4),(-5,-1)]] + let ev := fun (l : Fin 6) (z : Int × Int) => + ![-2*z.1+z.2, -z.1+2*z.2+12, z.1+z.2+24, + 2*z.1-z.2+24, z.1-2*z.2+12, -z.1-z.2] l + let v := fun j => SixSubtileFaceVertices (P4715T1PatchFaces j) + have cert : + (∀ (j : Fin 12) (l : Fin 6) (k : Fin 3), 0 ≤ ev l (q j k)) ∧ + (∀ (j : Fin 12) (l : Fin 6) (k : Fin 3), + ev l (q j k) = 0 → ∃ r, v j k = P4715T1BoundaryCycle r) ∧ + ∀ j : Fin 12, ∃ l : Fin 6, ∀ k : Fin 3, + (∃ r, v j k = P4715T1BoundaryCycle r) → ev l (q j k) = 0 := by + decide +kernel + let p := fun j => P4715T1Position ∘ v j + have coordinates (j : Fin 12) (k : Fin 3) : + 12*(p j k).1 = ((q j k).1 : Real) ∧ + 12*(p j k).2 = ((q j k).2 : Real) := by + dsimp only [p, v] + rw [P4783T1PatchCoordinates] + fin_cases j <;> fin_cases k <;> norm_num [q] + have values (l : Fin 6) (j : Fin 12) (k : Fin 3) : + 12 * P4793T1FacetForms l (p j k) = (ev l (q j k) : Real) := by + have hx := (coordinates j k).1 + have hy := (coordinates j k).2 + fin_cases l <;> norm_num [P4793T1FacetForms, ev] <;> linarith + dsimp only + refine ⟨?_, ?_, ?_⟩ + · intro j l k + have hn : (0 : Real) ≤ (ev l (q j k) : Real) := by exact_mod_cast cert.1 j l k + have he := values l j k + change 0 ≤ P4793T1FacetForms l (p j k) + linarith + · intro j l k hk + change P4793T1FacetForms l (p j k) = 0 at hk + have hz : (ev l (q j k) : Real) = 0 := by linarith [values l j k] + have hz' : ev l (q j k) = 0 := by exact_mod_cast hz + obtain ⟨r, hr⟩ := cert.2.1 j l k hz' + exact ⟨r, hr.symm⟩ + · intro j + obtain ⟨l, hl⟩ := cert.2.2 j + refine ⟨l, fun k hk => ?_⟩ + obtain ⟨r, hr⟩ := hk + have hz := hl k ⟨r, hr.symm⟩ + have hz' : (ev l (q j k) : Real) = 0 := by exact_mod_cast hz + change P4793T1FacetForms l (p j k) = 0 + linarith [values l j k] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4793T1PatchIntersections.lean b/LeanPool/ApollonianSuperharmonic/P4793T1PatchIntersections.lean new file mode 100644 index 0000000000..1d9c7cb6df --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4793T1PatchIntersections.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4793T1PatchSeparators +public import LeanPool.ApollonianSuperharmonic.P4793T1SeparatorIntersection +public import LeanPool.ApollonianSuperharmonic.P4715T1PositionInjective + +-- [TABLET NODE: P4793T1PatchIntersections] + +/-! +# P4793T1PatchIntersections + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4793T1PatchIntersections (i j : Fin 12) (hij : i ≠ j) : + let V := fun j : Fin 12 => Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j)) + convexHull Real (P4715T1Position '' V i) ∩ + convexHull Real (P4715T1Position '' V j) = + convexHull Real (P4715T1Position '' (V i ∩ V j)) := by +-- BODY + let V := fun j : Fin 12 => Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j)) + have ordered (i j : Fin 12) (hij : i < j) : + convexHull Real (P4715T1Position '' V i) ∩ + convexHull Real (P4715T1Position '' V j) = + convexHull Real (P4715T1Position '' (V i ∩ V j)) := by + obtain ⟨a, b, c, hS, hT, hface⟩ := P4793T1PatchSeparators i j hij + let f : (Real × Real) →ᵃ[Real] Real := + { toFun := fun z => (a : Real)*(12*z.1)+(b : Real)*(12*z.2)+(c : Real) + linear := + { toFun := fun z => (a : Real)*(12*z.1)+(b : Real)*(12*z.2) + map_add' := by intros; simp; ring + map_smul' := by intros; simp; ring } + map_vadd' := by intros; simp; ring } + have heq := P4793T1SeparatorIntersection + (P4715T1Position '' V i) (P4715T1Position '' V j) f + (by rintro _ ⟨_, ⟨k, rfl⟩, rfl⟩; exact hS k) + (by rintro _ ⟨_, ⟨k, rfl⟩, rfl⟩; exact hT k) (by + rcases hface with hface | hface + · left + rintro _ ⟨⟨_, ⟨k, rfl⟩, rfl⟩, hz⟩ + obtain ⟨l, hl⟩ := hface k hz + exact ⟨_, ⟨l, rfl⟩, hl.symm⟩ + · right + rintro _ ⟨⟨_, ⟨k, rfl⟩, rfl⟩, hz⟩ + obtain ⟨l, hl⟩ := hface k hz + exact ⟨_, ⟨l, rfl⟩, hl.symm⟩) + rw [heq, Set.image_inter P4715T1PositionInjective] + dsimp only + rcases lt_or_gt_of_ne hij with h | h + · exact ordered i j h + · simpa only [Set.inter_comm] using ordered j i h + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4793T1PatchSeparators.lean b/LeanPool/ApollonianSuperharmonic/P4793T1PatchSeparators.lean new file mode 100644 index 0000000000..e02eda5f9e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4793T1PatchSeparators.lean @@ -0,0 +1,126 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4783T1PatchCoordinates + +-- [TABLET NODE: P4793T1PatchSeparators] + +/-! +# P4793T1PatchSeparators + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4793T1PatchSeparators (i j : Fin 12) (hij : i < j) : + let p := fun j => P4715T1Position ∘ SixSubtileFaceVertices (P4715T1PatchFaces j) + ∃ a b c : Int, + let f := fun z : Real × Real => (a : Real)*(12*z.1)+(b : Real)*(12*z.2)+(c : Real) + (∀ k, 0 ≤ f (p i k)) ∧ (∀ k, f (p j k) ≤ 0) ∧ + ((∀ k, f (p i k) = 0 → ∃ l, p i k = p j l) ∨ + (∀ k, f (p j k) = 0 → ∃ l, p j k = p i l)) := by +-- BODY + let q : Fin 12 → Fin 3 → Int × Int := ![ + ![(0, 0), (-4, -8), (-6, -6)], + ![(-12, -12), (-4, -8), (-6, -6)], + ![(-12, 0), (-16, -8), (-10, -2)], + ![(-12, 0), (-4, 4), (-10, -2)], + ![(-12, -12), (-6, -6), (-11, -7)], + ![(-6, -6), (-10, -2), (-11, -7)], + ![(-16, -8), (-10, -2), (-11, -7)], + ![(-12, -12), (-16, -8), (-11, -7)], + ![(0, 0), (-6, -6), (-5, -1)], + ![(-6, -6), (-10, -2), (-5, -1)], + ![(-4, 4), (-10, -2), (-5, -1)], + ![(0, 0), (-4, 4), (-5, -1)]] + let sep : Fin 12 → Fin 12 → Int × Int × Int := ![ + ![(0, 0, 0), (1, 1, 12), (1, -1, 0), (1, -1, 0), (1, 0, 6), (1, -1, 0), (1, -1, 0), (1, 0, + 6), (1, -1, 0), (1, -1, 0), (1, -1, 0), (1, -1, 0)], + ![(0, 0, 0), (0, 0, 0), (1, -1, 0), (0, -1, -6), (1, -1, 0), (1, -1, 0), (1, -1, 0), (1, -1, + 0), (-1, -1, -12), (0, -1, -6), (0, -1, -6), (-1, -1, -12)], + ![(0, 0, 0), (0, 0, 0), (0, 0, 0), (-1, -1, -12), (-1, 1, -8), (-1, 1, -8), (-1, 1, -8), (-1, + 1, -8), (-1, 0, -10), (-1, 0, -10), (-1, -1, -12), (-1, -1, -12)], + ![(0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (-1, 1, -8), (-1, 1, -8), (0, 1, 2), (0, 1, 2), + (-1, 1, -8), (-1, 1, -8), (-1, 1, -8), (-1, 1, -8)], + ![(0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (1, -5, -24), (1, -1, 4), (5, -1, + 48), (-1, -1, -12), (-1, -1, -12), (0, -1, -6), (-1, -1, -12)], + ![(0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (5, -1, 48), (0, 1, 7), + (-1, -1, -12), (-1, -1, -12), (-1, -1, -12), (-1, -1, -12)], + ![(0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (-1, 5, 24), + (-1, 0, -10), (-1, -1, -12), (-1, -1, -12), (-1, -1, -12)], + ![(0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), + (-1, -1, -18), (-1, -1, -18), (-1, -1, -18), (-1, -1, -18)], + ![(0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, + 0, 0), (5, -1, 24), (1, -1, 4), (1, -5, 0)], + ![(0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, + 0, 0), (0, 0, 0), (1, -5, 0), (-1, -1, -6)], + ![(0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, + 0, 0), (0, 0, 0), (0, 0, 0), (-5, 1, -24)], + ![(0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0), (0, + 0, 0), (0, 0, 0), (0, 0, 0), (0, 0, 0)]] + let ev := fun (t : Int × Int × Int) (z : Int × Int) => + t.1*z.1+t.2.1*z.2+t.2.2 + have cert : ∀ i j : Fin 12, i < j → + (∀ k : Fin 3, 0 ≤ ev (sep i j) (q i k)) ∧ + (∀ k : Fin 3, ev (sep i j) (q j k) ≤ 0) ∧ + ((∀ k : Fin 3, ev (sep i j) (q i k) = 0 → ∃ l, q i k = q j l) ∨ + (∀ k : Fin 3, ev (sep i j) (q j k) = 0 → ∃ l, q j k = q i l)) := by + decide +kernel + let p := fun j => P4715T1Position ∘ SixSubtileFaceVertices (P4715T1PatchFaces j) + have coordinates (j : Fin 12) (k : Fin 3) : + 12*(p j k).1 = ((q j k).1 : Real) ∧ + 12*(p j k).2 = ((q j k).2 : Real) := by + dsimp only [p] + rw [P4783T1PatchCoordinates] + fin_cases j <;> fin_cases k <;> norm_num [q] + let f := fun z : Real × Real => + ((sep i j).1 : Real)*(12*z.1)+((sep i j).2.1 : Real)*(12*z.2)+((sep i j).2.2 : Real) + have values (r : Fin 12) (k : Fin 3) : + f (p r k) = (ev (sep i j) (q r k) : Real) := by + dsimp only [f, ev] + rw [(coordinates r k).1, (coordinates r k).2] + push_cast + rfl + have equal (r s : Fin 12) (k l : Fin 3) (h : q r k = q s l) : + p r k = p s l := by + have hx := congrArg (fun z : Int × Int => (z.1 : Real)) h + have hy := congrArg (fun z : Int × Int => (z.2 : Real)) h + ext + · linarith [(coordinates r k).1, (coordinates s l).1] + · linarith [(coordinates r k).2, (coordinates s l).2] + refine ⟨(sep i j).1, (sep i j).2.1, (sep i j).2.2, ?_, ?_, ?_⟩ + · intro k + change 0 ≤ f (p i k) + rw [values] + exact_mod_cast (cert i j hij).1 k + · intro k + change f (p j k) ≤ 0 + rw [values] + exact_mod_cast (cert i j hij).2.1 k + · rcases (cert i j hij).2.2 with h | h + · left + intro k hk + change f (p i k) = 0 at hk + rw [values] at hk + have hk' : ev (sep i j) (q i k) = 0 := by exact_mod_cast hk + obtain ⟨l, hl⟩ := h k hk' + exact ⟨l, equal i j k l hl⟩ + · right + intro k hk + change f (p j k) = 0 at hk + rw [values] at hk + have hk' : ev (sep i j) (q j k) = 0 := by exact_mod_cast hk + obtain ⟨l, hl⟩ := h k hk' + exact ⟨l, equal j i k l hl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4793T1SeparatorIntersection.lean b/LeanPool/ApollonianSuperharmonic/P4793T1SeparatorIntersection.lean new file mode 100644 index 0000000000..832e526101 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4793T1SeparatorIntersection.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4793T1SupportingFace + +-- [TABLET NODE: P4793T1SeparatorIntersection] + +/-! +# P4793T1SeparatorIntersection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4793T1SeparatorIntersection {E : Type*} [AddCommGroup E] [Module Real E] + (S T : Set E) (f : E →ᵃ[Real] Real) + (hS : ∀ x ∈ S, 0 ≤ f x) (hT : ∀ x ∈ T, f x ≤ 0) + (hface : (S ∩ {x | f x = 0} ⊆ T) ∨ (T ∩ {x | f x = 0} ⊆ S)) : + convexHull Real S ∩ convexHull Real T = convexHull Real (S ∩ T) := by +-- BODY + have hs := P4793T1SupportingFace S f hS + have ht := P4793T1SupportingFace T (-f) (by simpa using hT) + apply Set.Subset.antisymm + · intro x hx + have hx0 : f x = 0 := by + have hn := ht.1 x hx.2 + have hp := hs.1 x hx.1 + change 0 ≤ -f x at hn + linarith + rcases hface with hface | hface + · have hm : x ∈ convexHull Real (S ∩ {x | f x = 0}) := by + rw [← hs.2] + exact ⟨hx.1, hx0⟩ + exact convexHull_mono (show S ∩ {x | f x = 0} ⊆ S ∩ T from + fun y hy => ⟨hy.1, hface hy⟩) hm + · have hm : x ∈ convexHull Real (T ∩ {x | f x = 0}) := by + have heq : {x | (-f) x = 0} = {x | f x = 0} := by ext; simp + rw [← heq, ← ht.2] + exact ⟨hx.2, by simpa using hx0⟩ + exact convexHull_mono (show T ∩ {x | f x = 0} ⊆ S ∩ T from + fun y hy => ⟨hface hy, hy.1⟩) hm + · exact fun x hx => ⟨convexHull_mono Set.inter_subset_left hx, + convexHull_mono Set.inter_subset_right hx⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4793T1SupportingFace.lean b/LeanPool/ApollonianSuperharmonic/P4793T1SupportingFace.lean new file mode 100644 index 0000000000..b0bae395f8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4793T1SupportingFace.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Convex.Hull +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P4793T1SupportingFace] + +/-! +# P4793T1SupportingFace + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4793T1SupportingFace {E : Type*} [AddCommGroup E] [Module Real E] + (S : Set E) (f : E →ᵃ[Real] Real) (hf : ∀ x ∈ S, 0 ≤ f x) : + (∀ x ∈ convexHull Real S, 0 ≤ f x) ∧ + convexHull Real S ∩ {x | f x = 0} = convexHull Real (S ∩ {x | f x = 0}) := by +-- BODY + have hmap (x y : E) (a b : Real) (hab : a + b = 1) : + f (a • x + b • y) = a * f x + b * f y := by + rw [AffineMap.decomp f] + simp only [Pi.add_apply, map_add, map_smul, smul_eq_mul] + nlinarith only [show (a+b) * f 0 = f 0 by rw [hab]; ring] + let C := convexHull Real (S ∩ {x | f x = 0}) + have h : convexHull Real S ⊆ {x | 0 ≤ f x ∧ (f x = 0 → x ∈ C)} := by + apply convexHull_min + · intro x hx + exact ⟨hf x hx, fun hzero => subset_convexHull Real _ ⟨hx, hzero⟩⟩ + · intro x hx y hy a b ha hb hab + change 0 ≤ f (a • x + b • y) ∧ (f (a • x + b • y) = 0 → _) + rw [hmap x y a b hab] + refine ⟨add_nonneg (mul_nonneg ha hx.1) (mul_nonneg hb hy.1), ?_⟩ + intro hz + by_cases ha0 : a = 0 + · have hb1 : b = 1 := by linarith + simpa [ha0, hb1] using hy.2 (by simpa [ha0, hb1] using hz) + by_cases hb0 : b = 0 + · have ha1 : a = 1 := by linarith + simpa [hb0, ha1] using hx.2 (by simpa [hb0, ha1] using hz) + have hfx : f x = 0 := by + have hz' : a * f x = 0 := by nlinarith [mul_nonneg hb hy.1, mul_nonneg ha hx.1] + exact (mul_eq_zero.mp hz').resolve_left ha0 + have hfy : f y = 0 := by + have hz' : b * f y = 0 := by nlinarith [mul_nonneg hb hy.1, mul_nonneg ha hx.1] + exact (mul_eq_zero.mp hz').resolve_left hb0 + exact (convex_convexHull Real _) (hx.2 hfx) (hy.2 hfy) ha hb hab + refine ⟨fun x hx => (h hx).1, Set.Subset.antisymm ?_ ?_⟩ + · intro x hx + exact (h hx.1).2 hx.2 + · apply convexHull_min + · intro x hx + exact ⟨subset_convexHull Real S hx.1, hx.2⟩ + · apply (convex_convexHull Real S).inter + intro x hx y hy a b ha hb hab + change f (a • x + b • y) = 0 + rw [hmap x y a b hab, hx, hy] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4802T1CrossPatchFaces.lean b/LeanPool/ApollonianSuperharmonic/P4802T1CrossPatchFaces.lean new file mode 100644 index 0000000000..658cf1cefe --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4802T1CrossPatchFaces.lean @@ -0,0 +1,136 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4802T1HexagonOverlapSide +public import LeanPool.ApollonianSuperharmonic.P4802T1SideRestriction +public import LeanPool.ApollonianSuperharmonic.P4802T1SimplexFaces +public import LeanPool.ApollonianSuperharmonic.P4715T1PositionInjective + +-- [TABLET NODE: P4802T1CrossPatchFaces] + +/-! +# P4802T1CrossPatchFaces + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4802T1CrossPatchFaces (k l : Int × Int) (hkl : k ≠ l) + (S T : Set PeriodicSubtileIndex) + (hS : ∀ z ∈ S, P4715T1Position z ∈ + (fun x : Real × Real => x + ((k.1 : Real), (k.2 : Real))) '' + P4715T1Hexagon) + (hT : ∀ z ∈ T, P4715T1Position z ∈ + (fun x : Real × Real => x + ((l.1 : Real), (l.2 : Real))) '' + P4715T1Hexagon) : + convexHull Real (P4715T1Position '' S) ∩ + convexHull Real (P4715T1Position '' T) = + convexHull Real (P4715T1Position '' (S ∩ T)) := by +-- BODY + classical + have side_index (k : Int × Int) (r : Fin 6) (a : PeriodicSubtileIndex) + (ha : P4715T1Position a ∈ P4715T1Arc + (P4715T1VertexShift k (P4715T1BoundaryCycle r)) + (P4715T1VertexShift k (P4715T1BoundaryCycle (r+1)))) : + a ∈ ({P4715T1VertexShift k (P4715T1BoundaryCycle r), + P4715T1VertexShift k (P4715T1BoundaryCycle (r+1))} : Set _) := by + have hhex : P4715T1Position a ∈ + (fun x : Real × Real => x + ((k.1 : Real), (k.2 : Real))) '' + P4715T1Hexagon := by + rw [(P4715T1CoefficientTranslation k).2.1] at ha + obtain ⟨x,hx,hxa⟩ := ha + rw [P4780T1ActiveFacets] at hx + exact ⟨x,hx.1,hxa⟩ + have hh := P4802T1SideRestriction k r ({a} : Set _) + (by rintro z hz; rw [Set.mem_singleton_iff] at hz; exact hz.symm ▸ hhex) + have hp := (Set.ext_iff.mp hh (P4715T1Position a)).mp + ⟨subset_convexHull Real _ (Set.mem_image_of_mem _ (Set.mem_singleton a)), ha⟩ + by_contra hn + have he : ({a} : Set PeriodicSubtileIndex) ∩ + {P4715T1VertexShift k (P4715T1BoundaryCycle r), + P4715T1VertexShift k (P4715T1BoundaryCycle (r+1))} = ∅ := by + ext b + simp only [Set.mem_inter_iff, Set.mem_singleton_iff, + Set.mem_empty_iff_false, iff_false] + rintro ⟨rfl,h⟩ + exact hn h + simp only [he, Set.image_empty, convexHull_empty, Set.mem_empty_iff_false] at hp + have hconv (k : Int × Int) : Convex Real + ((fun x : Real × Real => x + ((k.1 : Real), (k.2 : Real))) '' + P4715T1Hexagon) := by + have hh : Convex Real P4715T1Hexagon := convex_convexHull Real _ + simpa only [add_comm] using hh.translate ((k.1 : Real), (k.2 : Real)) + apply Set.Subset.antisymm + · intro p hp + have hpS := convexHull_min (by rintro _ ⟨z,hz,rfl⟩; exact hS z hz) (hconv k) hp.1 + have hpT := convexHull_min (by rintro _ ⟨z,hz,rfl⟩; exact hT z hz) (hconv l) hp.2 + obtain ⟨r,hr⟩ := P4802T1HexagonOverlapSide k l hkl p ⟨hpS,hpT⟩ + obtain ⟨s,hs⟩ := P4802T1HexagonOverlapSide l k hkl.symm p ⟨hpT,hpS⟩ + let u := P4715T1VertexShift k (P4715T1BoundaryCycle r) + let v := P4715T1VertexShift k (P4715T1BoundaryCycle (r+1)) + let w := P4715T1VertexShift l (P4715T1BoundaryCycle s) + let z := P4715T1VertexShift l (P4715T1BoundaryCycle (s+1)) + have he : P4715T1Arc u v = P4715T1Arc w z := by + rw [← hr, Set.inter_comm, hs] + have hpair : ({u,v} : Set PeriodicSubtileIndex) = {w,z} := by + apply Set.Subset.antisymm + · intro a ha + have hpa : P4715T1Position a ∈ P4715T1Arc w z := by + rw [← he] + rcases ha with ha | ha + · rw [ha]; exact left_mem_segment Real _ _ + · rw [Set.mem_singleton_iff] at ha + rw [ha]; exact right_mem_segment Real _ _ + exact side_index l s a hpa + · intro a ha + have hpa : P4715T1Position a ∈ P4715T1Arc u v := by + rw [he] + rcases ha with ha | ha + · rw [ha]; exact left_mem_segment Real _ _ + · rw [Set.mem_singleton_iff] at ha + rw [ha]; exact right_mem_segment Real _ _ + exact side_index k r a hpa + have hpr : p ∈ P4715T1Arc u v := by rw [← hr]; exact ⟨hpS,hpT⟩ + have hps : p ∈ P4715T1Arc w z := he ▸ hpr + have ha : p ∈ convexHull Real (P4715T1Position '' (S ∩ ({u,v} : Set _))) := by + rw [← P4802T1SideRestriction k r S hS] + exact ⟨hp.1,hpr⟩ + have hb : p ∈ convexHull Real (P4715T1Position '' (T ∩ ({u,v} : Set _))) := by + rw [hpair, ← P4802T1SideRestriction l s T hT] + exact ⟨hp.2,hps⟩ + have huv : u ≠ v := by + fin_cases r <;> simp [u,v,P4715T1VertexShift,P4715T1BoundaryCycle] + have hi : AffineIndependent Real + (fun x : P4715T1Position '' ({u,v} : Set _) => (x : Real × Real)) := by + have hh := (affineIndependent_of_ne Real (P4715T1PositionInjective.ne huv)).range + have heq : Set.range ![P4715T1Position u,P4715T1Position v] = + P4715T1Position '' ({u,v} : Set _) := by + ext x + simp [or_comm] + rw [heq] at hh + exact hh + have hfaces := P4802T1SimplexFaces (P4715T1Position '' ({u,v} : Set _)) + ((Set.toFinite ({u,v} : Set PeriodicSubtileIndex)).image _) hi + (P4715T1Position '' (S ∩ ({u,v} : Set _))) + (P4715T1Position '' (T ∩ ({u,v} : Set _))) + (Set.image_mono Set.inter_subset_right) (Set.image_mono Set.inter_subset_right) + rw [← Set.image_inter P4715T1PositionInjective] at hfaces + have hab := (Set.ext_iff.mp hfaces p).mp ⟨ha,hb⟩ + have hsub : (S ∩ ({u,v} : Set _)) ∩ (T ∩ ({u,v} : Set _)) ⊆ S ∩ T := + fun _ h => ⟨h.1.1,h.2.1⟩ + exact convexHull_mono (Set.image_mono hsub) hab + · exact Set.subset_inter + (convexHull_mono (Set.image_mono Set.inter_subset_left)) + (convexHull_mono (Set.image_mono Set.inter_subset_right)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4802T1HexagonOverlapSide.lean b/LeanPool/ApollonianSuperharmonic/P4802T1HexagonOverlapSide.lean new file mode 100644 index 0000000000..af9eaf0754 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4802T1HexagonOverlapSide.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonTessellation + +-- [TABLET NODE: P4802T1HexagonOverlapSide] + +/-! +# P4802T1HexagonOverlapSide + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4802T1HexagonOverlapSide (k l : Int × Int) (hkl : k ≠ l) + (p : Real × Real) + (hp : p ∈ ((fun x : Real × Real => x + ((k.1 : Real), (k.2 : Real))) '' + P4715T1Hexagon) ∩ + ((fun x : Real × Real => x + ((l.1 : Real), (l.2 : Real))) '' + P4715T1Hexagon)) : + ∃ r : Fin 6, + ((fun x : Real × Real => x + ((k.1 : Real), (k.2 : Real))) '' + P4715T1Hexagon) ∩ + ((fun x : Real × Real => x + ((l.1 : Real), (l.2 : Real))) '' + P4715T1Hexagon) = + P4715T1Arc (P4715T1VertexShift k (P4715T1BoundaryCycle r)) + (P4715T1VertexShift k (P4715T1BoundaryCycle (r+1))) := by +-- BODY + obtain ⟨⟨a, ha, hap⟩, ⟨b, hb, hbp⟩⟩ := hp + let d := l-k + have hab : a = b + ((d.1 : Real), (d.2 : Real)) := by + have hx := congrArg Prod.fst (hap.trans hbp.symm) + have hy := congrArg Prod.snd (hap.trans hbp.symm) + ext <;> simp [d, Int.cast_sub] at hx hy ⊢ <;> linarith + have hd := P4780T1OverlapBound d a b ha hb hab + have hne : d ≠ 0 := sub_ne_zero.mpr (Ne.symm hkl) + have hdiag : d = (1,-1) ∨ d = (-1,1) → False := by + intro hh + rw [P4780T1HullHalfspaces] at ha hb + rcases ha with ⟨ha1, ha2, ha3, ha4, ha5, ha6⟩ + rcases hb with ⟨hb1, hb2, hb3, hb4, hb5, hb6⟩ + rcases hh with hh | hh <;> rw [hh] at hab + all_goals + have hx := congrArg Prod.fst hab + have hy := congrArg Prod.snd hab + norm_num at hx hy + linarith + have hn : ∃ r : Fin 6, + d = (![(1,0),(0,-1),(-1,-1),(-1,0),(0,1),(1,1)] r : Int × Int) := by + rcases d with ⟨x,y⟩ + rcases hd with ⟨hx0,hx1,hy0,hy1⟩ + interval_cases x <;> interval_cases y + · exact ⟨2,rfl⟩ + · exact ⟨3,rfl⟩ + · exact (hdiag (Or.inr rfl)).elim + · exact ⟨1,rfl⟩ + · exact (hne rfl).elim + · exact ⟨4,rfl⟩ + · exact (hdiag (Or.inl rfl)).elim + · exact ⟨0,rfl⟩ + · exact ⟨5,rfl⟩ + obtain ⟨r,hr⟩ := hn + refine ⟨r, ?_⟩ + rw [(P4715T1CoefficientTranslation k).2.1] + ext z + constructor + · rintro ⟨⟨x,hx,hxz⟩,⟨y,hy,hyz⟩⟩ + refine ⟨x, ?_, hxz⟩ + rw [← P4780T1NeighborFacets r] + refine ⟨hx,y,hy,?_⟩ + have h1 := congrArg Prod.fst (hxz.trans hyz.symm) + have h2 := congrArg Prod.snd (hxz.trans hyz.symm) + rw [← hr] + ext <;> simp [d, Int.cast_sub] at h1 h2 ⊢ <;> linarith + · rintro ⟨x,hx,rfl⟩ + rw [← P4780T1NeighborFacets r] at hx + obtain ⟨hx,y,hy,hyx⟩ := hx + refine ⟨⟨x,hx,rfl⟩,⟨y,hy,?_⟩⟩ + rw [← hr] at hyx + have h1 := congrArg Prod.fst hyx + have h2 := congrArg Prod.snd hyx + ext <;> simp [d, Int.cast_sub] at h1 h2 ⊢ <;> linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4802T1PatchFaceRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4802T1PatchFaceRestriction.lean new file mode 100644 index 0000000000..613cce985c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4802T1PatchFaceRestriction.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4802T1SimplexFaces +public import LeanPool.ApollonianSuperharmonic.P4802T1TriangleIndependent +public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonSubdivision +public import LeanPool.ApollonianSuperharmonic.P4715T1PositionInjective + +-- [TABLET NODE: P4802T1PatchFaceRestriction] + +/-! +# P4802T1PatchFaceRestriction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4802T1PatchFaceRestriction (i j : Fin 12) + (S T : Set PeriodicSubtileIndex) + (hS : S ⊆ Set.range (SixSubtileFaceVertices (P4715T1PatchFaces i))) + (hT : T ⊆ Set.range (SixSubtileFaceVertices (P4715T1PatchFaces j))) : + convexHull Real (P4715T1Position '' S) ∩ + convexHull Real (P4715T1Position '' T) = + convexHull Real (P4715T1Position '' (S ∩ T)) := by +-- BODY + let V := fun i => Set.range (SixSubtileFaceVertices (P4715T1PatchFaces i)) + have restrict (i : Fin 12) (A B : Set PeriodicSubtileIndex) + (hA : A ⊆ V i) (hB : B ⊆ V i) : + convexHull Real (P4715T1Position '' A) ∩ + convexHull Real (P4715T1Position '' B) = + convexHull Real (P4715T1Position '' (A ∩ B)) := by + have hi := P4802T1TriangleIndependent _ + (P4715T1HexagonSubdivision.2.1 i) + have hir : AffineIndependent Real + (fun x : P4715T1Position '' V i => (x : Real × Real)) := by + change AffineIndependent Real + (fun x : P4715T1Position '' Set.range + (SixSubtileFaceVertices (P4715T1PatchFaces i)) => (x : Real × Real)) + rw [← Set.range_comp] + exact hi.range + have hh := P4802T1SimplexFaces (P4715T1Position '' V i) + ((Set.finite_range _).image _) hir + (P4715T1Position '' A) (P4715T1Position '' B) + (Set.image_mono hA) (Set.image_mono hB) + rw [← Set.image_inter P4715T1PositionInjective] at hh + exact hh + by_cases hij : i = j + · subst j + exact restrict i S T hS hT + apply Set.Subset.antisymm + · intro p hp + have hpij : p ∈ convexHull Real (P4715T1Position '' (V i ∩ V j)) := by + rw [← P4715T1HexagonSubdivision.2.2.1 i j hij] + exact ⟨convexHull_mono (Set.image_mono hS) hp.1, + convexHull_mono (Set.image_mono hT) hp.2⟩ + have hpS : p ∈ convexHull Real (P4715T1Position '' (S ∩ (V i ∩ V j))) := by + rw [← restrict i S (V i ∩ V j) hS Set.inter_subset_left] + exact ⟨hp.1,hpij⟩ + have hpT : p ∈ convexHull Real + (P4715T1Position '' ((S ∩ (V i ∩ V j)) ∩ T)) := by + rw [← restrict j (S ∩ (V i ∩ V j)) T + (fun _ h => h.2.2) hT] + exact ⟨hpS,hp.2⟩ + have hs : (S ∩ (V i ∩ V j)) ∩ T ⊆ S ∩ T := + fun _ h => ⟨h.1.1,h.2⟩ + exact convexHull_mono (Set.image_mono hs) hpT + · exact Set.subset_inter + (convexHull_mono (Set.image_mono Set.inter_subset_left)) + (convexHull_mono (Set.image_mono Set.inter_subset_right)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4802T1SideRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4802T1SideRestriction.lean new file mode 100644 index 0000000000..4163390dc6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4802T1SideRestriction.lean @@ -0,0 +1,375 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4715T1CoefficientTranslation +public import LeanPool.ApollonianSuperharmonic.P4715T1BoundaryCycle +public import LeanPool.ApollonianSuperharmonic.P4793T1SupportingFace +public import LeanPool.ApollonianSuperharmonic.P4793T1FacetForms +public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonTessellation + + +-- [TABLET NODE: P4802T1SideRestriction] + +/-! +# P4802T1SideRestriction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +private theorem sideBoundary0 (z : PeriodicSubtileIndex) + (hz : P4715T1Position z ∈ P4715T1Arc + (P4715T1BoundaryCycle (0 : Fin 6)) + (P4715T1BoundaryCycle (0 + 1 : Fin 6))) : + z = P4715T1BoundaryCycle (0 : Fin 6) ∨ + z = P4715T1BoundaryCycle (0 + 1 : Fin 6) := by + rw [P4715T1Arc, segment_eq_image_lineMap] at hz + rcases hz with ⟨t, ht, hzt⟩ + cases z with + | mk label m n => + cases label <;> + simp only [P4715T1Position, P4715T1BoundaryCycle, + Int.reduceNeg, + Fin.isValue, Matrix.cons_val_zero, + Matrix.cons_val_one, Int.cast_zero, + P4715T1Offsets, + Prod.mk_add_mk, add_zero, zero_add, AffineMap.lineMap_apply, + vsub_eq_sub, Prod.mk_sub_mk, sub_zero, Prod.smul_mk, + smul_eq_mul, vadd_eq_add, Prod.mk.injEq, + PeriodicSubtileIndex.mk.injEq, true_and, reduceCtorEq, + false_and, or_false, false_or, or_self, + one_div] at hzt ⊢ + all_goals + have hmloR : (-2 : Real) < (m : Real) := by + linarith only [hzt.1, ht.1, ht.2] + have hmhiR : (m : Real) < 2 := by + linarith only [hzt.1, ht.1, ht.2] + have hnloR : (-2 : Real) < (n : Real) := by + linarith only [hzt.2, ht.1, ht.2] + have hnhiR : (n : Real) < 2 := by + linarith only [hzt.2, ht.1, ht.2] + have hmlo : (-2 : Int) < m := by exact_mod_cast hmloR + have hmhi : m < (2 : Int) := by exact_mod_cast hmhiR + have hnlo : (-2 : Int) < n := by exact_mod_cast hnloR + have hnhi : n < (2 : Int) := by exact_mod_cast hnhiR + interval_cases m <;> interval_cases n <;> + norm_num at hzt ⊢ <;> linarith only [hzt.1, hzt.2, ht.1, ht.2] + +private theorem sideBoundary1 (z : PeriodicSubtileIndex) + (hz : P4715T1Position z ∈ P4715T1Arc + (P4715T1BoundaryCycle (1 : Fin 6)) + (P4715T1BoundaryCycle (1 + 1 : Fin 6))) : + z = P4715T1BoundaryCycle (1 : Fin 6) ∨ + z = P4715T1BoundaryCycle (1 + 1 : Fin 6) := by + rw [P4715T1Arc, segment_eq_image_lineMap] at hz + rcases hz with ⟨t, ht, hzt⟩ + cases z with + | mk label m n => + cases label <;> + simp only [P4715T1Position, P4715T1BoundaryCycle, + Int.reduceNeg, + Fin.isValue, Fin.reduceAdd, Matrix.cons_val_zero, + Matrix.cons_val_one, Matrix.cons_val, Int.cast_zero, + Int.cast_one, Int.cast_neg, P4715T1Offsets, + Prod.mk_add_mk, add_zero, zero_add, AffineMap.lineMap_apply, + vsub_eq_sub, Prod.mk_sub_mk, Prod.smul_mk, + smul_eq_mul, vadd_eq_add, Prod.mk.injEq, + PeriodicSubtileIndex.mk.injEq, true_and, reduceCtorEq, + false_and, or_false, false_or, or_self, add_left_inj, + one_div] at hzt ⊢ + all_goals + have hmloR : (-2 : Real) < (m : Real) := by + linarith only [hzt.1, ht.1, ht.2] + have hmhiR : (m : Real) < 2 := by + linarith only [hzt.1, ht.1, ht.2] + have hnloR : (-2 : Real) < (n : Real) := by + linarith only [hzt.2, ht.1, ht.2] + have hnhiR : (n : Real) < 2 := by + linarith only [hzt.2, ht.1, ht.2] + have hmlo : (-2 : Int) < m := by exact_mod_cast hmloR + have hmhi : m < (2 : Int) := by exact_mod_cast hmhiR + have hnlo : (-2 : Int) < n := by exact_mod_cast hnloR + have hnhi : n < (2 : Int) := by exact_mod_cast hnhiR + interval_cases m <;> interval_cases n <;> + norm_num at hzt ⊢ <;> linarith only [hzt.1, hzt.2, ht.1, ht.2] + +private theorem sideBoundary2 (z : PeriodicSubtileIndex) + (hz : P4715T1Position z ∈ P4715T1Arc + (P4715T1BoundaryCycle (2 : Fin 6)) + (P4715T1BoundaryCycle (2 + 1 : Fin 6))) : + z = P4715T1BoundaryCycle (2 : Fin 6) ∨ + z = P4715T1BoundaryCycle (2 + 1 : Fin 6) := by + rw [P4715T1Arc, segment_eq_image_lineMap] at hz + rcases hz with ⟨t, ht, hzt⟩ + cases z with + | mk label m n => + cases label <;> + simp only [P4715T1Position, P4715T1BoundaryCycle, + Int.reduceNeg, + Fin.isValue, Fin.reduceAdd, + Matrix.cons_val, Int.cast_zero, + Int.cast_one, Int.cast_neg, P4715T1Offsets, + Prod.mk_add_mk, add_zero, zero_add, AffineMap.lineMap_apply, + vsub_eq_sub, Prod.mk_sub_mk, Prod.smul_mk, + smul_eq_mul, vadd_eq_add, Prod.mk.injEq, + PeriodicSubtileIndex.mk.injEq, true_and, reduceCtorEq, + false_and, or_false, false_or, or_self, + sub_neg_eq_add, neg_add_cancel_comm, + one_div] at hzt ⊢ + all_goals + have hmloR : (-2 : Real) < (m : Real) := by + linarith only [hzt.1, ht.1, ht.2] + have hmhiR : (m : Real) < 2 := by + linarith only [hzt.1, ht.1, ht.2] + have hnloR : (-2 : Real) < (n : Real) := by + linarith only [hzt.2, ht.1, ht.2] + have hnhiR : (n : Real) < 2 := by + linarith only [hzt.2, ht.1, ht.2] + have hmlo : (-2 : Int) < m := by exact_mod_cast hmloR + have hmhi : m < (2 : Int) := by exact_mod_cast hmhiR + have hnlo : (-2 : Int) < n := by exact_mod_cast hnloR + have hnhi : n < (2 : Int) := by exact_mod_cast hnhiR + interval_cases m <;> interval_cases n <;> + norm_num at hzt ⊢ <;> linarith only [hzt.1, hzt.2, ht.1, ht.2] + +private theorem sideBoundary3 (z : PeriodicSubtileIndex) + (hz : P4715T1Position z ∈ P4715T1Arc + (P4715T1BoundaryCycle (3 : Fin 6)) + (P4715T1BoundaryCycle (3 + 1 : Fin 6))) : + z = P4715T1BoundaryCycle (3 : Fin 6) ∨ + z = P4715T1BoundaryCycle (3 + 1 : Fin 6) := by + rw [P4715T1Arc, segment_eq_image_lineMap] at hz + rcases hz with ⟨t, ht, hzt⟩ + cases z with + | mk label m n => + cases label <;> + simp only [P4715T1Position, P4715T1BoundaryCycle, + Int.reduceNeg, + Fin.isValue, Fin.reduceAdd, + Matrix.cons_val, Int.cast_zero, + Int.cast_one, Int.cast_neg, P4715T1Offsets, + Prod.mk_add_mk, add_zero, zero_add, AffineMap.lineMap_apply, + vsub_eq_sub, Prod.mk_sub_mk, Prod.smul_mk, + smul_eq_mul, vadd_eq_add, Prod.mk.injEq, + PeriodicSubtileIndex.mk.injEq, true_and, reduceCtorEq, + false_and, or_false, false_or, or_self, add_left_inj, + sub_add_cancel_left, + zero_sub, mul_neg, one_div] at hzt ⊢ + all_goals + have hmloR : (-2 : Real) < (m : Real) := by + linarith only [hzt.1, ht.1, ht.2] + have hmhiR : (m : Real) < 2 := by + linarith only [hzt.1, ht.1, ht.2] + have hnloR : (-2 : Real) < (n : Real) := by + linarith only [hzt.2, ht.1, ht.2] + have hnhiR : (n : Real) < 2 := by + linarith only [hzt.2, ht.1, ht.2] + have hmlo : (-2 : Int) < m := by exact_mod_cast hmloR + have hmhi : m < (2 : Int) := by exact_mod_cast hmhiR + have hnlo : (-2 : Int) < n := by exact_mod_cast hnloR + have hnhi : n < (2 : Int) := by exact_mod_cast hnhiR + interval_cases m <;> interval_cases n <;> + norm_num at hzt ⊢ <;> linarith only [hzt.1, hzt.2, ht.1, ht.2] + +private theorem sideBoundary4 (z : PeriodicSubtileIndex) + (hz : P4715T1Position z ∈ P4715T1Arc + (P4715T1BoundaryCycle (4 : Fin 6)) + (P4715T1BoundaryCycle (4 + 1 : Fin 6))) : + z = P4715T1BoundaryCycle (4 : Fin 6) ∨ + z = P4715T1BoundaryCycle (4 + 1 : Fin 6) := by + rw [P4715T1Arc, segment_eq_image_lineMap] at hz + rcases hz with ⟨t, ht, hzt⟩ + cases z with + | mk label m n => + cases label <;> + simp only [P4715T1Position, P4715T1BoundaryCycle, + Int.reduceNeg, + Fin.isValue, Fin.reduceAdd, + Matrix.cons_val, Int.cast_zero, + Int.cast_one, Int.cast_neg, P4715T1Offsets, + Prod.mk_add_mk, add_zero, zero_add, AffineMap.lineMap_apply, + vsub_eq_sub, Prod.mk_sub_mk, sub_zero, Prod.smul_mk, + smul_eq_mul, vadd_eq_add, Prod.mk.injEq, + PeriodicSubtileIndex.mk.injEq, true_and, reduceCtorEq, + false_and, or_false, false_or, or_self, + sub_neg_eq_add, + one_div] at hzt ⊢ + all_goals + have hmloR : (-2 : Real) < (m : Real) := by + linarith only [hzt.1, ht.1, ht.2] + have hmhiR : (m : Real) < 2 := by + linarith only [hzt.1, ht.1, ht.2] + have hnloR : (-2 : Real) < (n : Real) := by + linarith only [hzt.2, ht.1, ht.2] + have hnhiR : (n : Real) < 2 := by + linarith only [hzt.2, ht.1, ht.2] + have hmlo : (-2 : Int) < m := by exact_mod_cast hmloR + have hmhi : m < (2 : Int) := by exact_mod_cast hmhiR + have hnlo : (-2 : Int) < n := by exact_mod_cast hnloR + have hnhi : n < (2 : Int) := by exact_mod_cast hnhiR + interval_cases m <;> interval_cases n <;> + norm_num at hzt ⊢ <;> linarith only [hzt.1, hzt.2, ht.1, ht.2] + +private theorem sideBoundary5 (z : PeriodicSubtileIndex) + (hz : P4715T1Position z ∈ P4715T1Arc + (P4715T1BoundaryCycle (5 : Fin 6)) + (P4715T1BoundaryCycle (5 + 1 : Fin 6))) : + z = P4715T1BoundaryCycle (5 : Fin 6) ∨ + z = P4715T1BoundaryCycle (5 + 1 : Fin 6) := by + rw [P4715T1Arc, segment_eq_image_lineMap] at hz + rcases hz with ⟨t, ht, hzt⟩ + cases z with + | mk label m n => + cases label <;> + simp only [P4715T1Position, P4715T1BoundaryCycle, + Int.reduceNeg, + Fin.isValue, Fin.reduceAdd, Matrix.cons_val_zero, + Matrix.cons_val, Int.cast_zero, + Int.cast_one, P4715T1Offsets, + Prod.mk_add_mk, add_zero, zero_add, AffineMap.lineMap_apply, + vsub_eq_sub, Prod.mk_sub_mk, Prod.smul_mk, + smul_eq_mul, vadd_eq_add, Prod.mk.injEq, + PeriodicSubtileIndex.mk.injEq, true_and, reduceCtorEq, + false_and, or_false, false_or, or_self, add_left_inj, + zero_sub, mul_neg, one_div] at hzt ⊢ + all_goals + have hmloR : (-2 : Real) < (m : Real) := by + linarith only [hzt.1, ht.1, ht.2] + have hmhiR : (m : Real) < 2 := by + linarith only [hzt.1, ht.1, ht.2] + have hnloR : (-2 : Real) < (n : Real) := by + linarith only [hzt.2, ht.1, ht.2] + have hnhiR : (n : Real) < 2 := by + linarith only [hzt.2, ht.1, ht.2] + have hmlo : (-2 : Int) < m := by exact_mod_cast hmloR + have hmhi : m < (2 : Int) := by exact_mod_cast hmhiR + have hnlo : (-2 : Int) < n := by exact_mod_cast hnloR + have hnhi : n < (2 : Int) := by exact_mod_cast hnhiR + interval_cases m <;> interval_cases n <;> + norm_num at hzt ⊢ <;> linarith only [hzt.1, hzt.2, ht.1, ht.2] + +theorem P4802T1SideRestriction (k : Int × Int) (r : Fin 6) + (S : Set PeriodicSubtileIndex) + (hS : ∀ z ∈ S, P4715T1Position z ∈ + (fun x : Real × Real => x + ((k.1 : Real), (k.2 : Real))) '' + P4715T1Hexagon) : + convexHull Real (P4715T1Position '' S) ∩ + P4715T1Arc (P4715T1VertexShift k (P4715T1BoundaryCycle r)) + (P4715T1VertexShift k (P4715T1BoundaryCycle (r+1))) = + convexHull Real (P4715T1Position '' + (S ∩ {P4715T1VertexShift k (P4715T1BoundaryCycle r), + P4715T1VertexShift k (P4715T1BoundaryCycle (r+1))})) := by +-- BODY + have boundary (k : Int × Int) (q : Fin 6) (z : PeriodicSubtileIndex) + (hz : P4715T1Position z ∈ P4715T1Arc + (P4715T1VertexShift k (P4715T1BoundaryCycle q)) + (P4715T1VertexShift k (P4715T1BoundaryCycle (q + 1)))) : + z = P4715T1VertexShift k (P4715T1BoundaryCycle q) ∨ + z = P4715T1VertexShift k (P4715T1BoundaryCycle (q + 1)) := by + as_aux_lemma => + have base (q : Fin 6) (z : PeriodicSubtileIndex) + (hz : P4715T1Position z ∈ P4715T1Arc + (P4715T1BoundaryCycle q) (P4715T1BoundaryCycle (q+1))) : + z = P4715T1BoundaryCycle q ∨ z = P4715T1BoundaryCycle (q+1) := by + as_aux_lemma => + fin_cases q + · exact sideBoundary0 z hz + · exact sideBoundary1 z hz + · exact sideBoundary2 z hz + · exact sideBoundary3 z hz + · exact sideBoundary4 z hz + · exact sideBoundary5 z hz + rw [(P4715T1CoefficientTranslation k).2.1] at hz + obtain ⟨x,hx,hxz⟩ := hz + have hpos : P4715T1Position (P4715T1VertexShift (-k) z) = x := by + rw [(P4715T1CoefficientTranslation (-k)).1, ← hxz] + ext <;> simp + have hh := base q (P4715T1VertexShift (-k) z) (hpos.symm ▸ hx) + have hinv : P4715T1VertexShift k (P4715T1VertexShift (-k) z) = z := by + rw [← P4715T1IndexAction.2.1, add_neg_cancel, P4715T1IndexAction.1] + rcases hh with hh | hh + · exact Or.inl (hinv.symm.trans (congrArg (P4715T1VertexShift k) hh)) + · exact Or.inr (hinv.symm.trans (congrArg (P4715T1VertexShift k) hh)) + let K : Real × Real := ((k.1 : Real), (k.2 : Real)) + let H := (fun x : Real × Real => x + K) '' P4715T1Hexagon + let F : (Real × Real) →ᵃ[Real] Real := + (P4793T1FacetForms r).comp + (AffineMap.id Real (Real × Real) - AffineMap.const Real (Real × Real) K) + have hF (x : Real × Real) : F x = P4793T1FacetForms r (x-K) := rfl + have hc : Convex Real H := by + have hh : Convex Real P4715T1Hexagon := convex_convexHull Real _ + simpa only [H, add_comm] using hh.translate K + have hnonneg (x : Real × Real) (hx : x ∈ H) : 0 ≤ F x := by + obtain ⟨y,hy,rfl⟩ := hx + rw [hF, add_sub_cancel_right] + rw [P4780T1HullHalfspaces] at hy + rcases hy with ⟨h1,h2,h3,h4,h5,h6⟩ + fin_cases r <;> norm_num [P4793T1FacetForms] <;> linarith + have hbase : P4715T1Arc (P4715T1BoundaryCycle r) + (P4715T1BoundaryCycle (r+1)) = + P4715T1Hexagon ∩ {x | P4793T1FacetForms r x = 0} := by + rw [P4780T1ActiveFacets] + congr 1 + ext x + fin_cases r <;> norm_num [P4793T1FacetForms] <;> + constructor <;> intro h <;> linarith + let u := P4715T1VertexShift k (P4715T1BoundaryCycle r) + let v := P4715T1VertexShift k (P4715T1BoundaryCycle (r+1)) + have hside (x : Real × Real) : x ∈ P4715T1Arc u v ↔ + x ∈ H ∧ F x = 0 := by + dsimp only [u,v] + rw [(P4715T1CoefficientTranslation k).2.1, hbase] + constructor + · rintro ⟨y,⟨hy,hz⟩,rfl⟩ + refine ⟨⟨y,hy,rfl⟩, ?_⟩ + change P4793T1FacetForms r y = 0 at hz + change P4793T1FacetForms r (y+K-K) = 0 + simpa only [add_sub_cancel_right] using hz + · rintro ⟨⟨y,hy,rfl⟩,hz⟩ + refine ⟨y,⟨hy,?_⟩,rfl⟩ + change P4793T1FacetForms r (y+K-K) = 0 at hz + change P4793T1FacetForms r y = 0 + simpa only [add_sub_cancel_right] using hz + have hvertex (z : PeriodicSubtileIndex) + (hz : P4715T1Position z ∈ P4715T1Arc u v) : z ∈ ({u,v} : Set _) := by + exact boundary k r z hz + have hzero : (P4715T1Position '' S) ∩ {x | F x = 0} = + P4715T1Position '' (S ∩ ({u,v} : Set _)) := by + ext x + constructor + · rintro ⟨⟨z,hz,rfl⟩,hf⟩ + exact ⟨z,⟨hz,hvertex z ((hside _).mpr ⟨hS z hz,hf⟩)⟩,rfl⟩ + · rintro ⟨z,⟨hz,hzuv⟩,rfl⟩ + refine ⟨⟨z,hz,rfl⟩, (hside _).mp ?_ |>.2⟩ + rcases hzuv with hzuv | hzuv + · rw [hzuv] + exact left_mem_segment Real _ _ + · rw [Set.mem_singleton_iff] at hzuv + rw [hzuv] + exact right_mem_segment Real _ _ + have hh := P4793T1SupportingFace (P4715T1Position '' S) F + (by rintro _ ⟨z,hz,rfl⟩; exact hnonneg _ (hS z hz)) + have hHull : convexHull Real (P4715T1Position '' S) ⊆ H := + convexHull_min (by rintro _ ⟨z,hz,rfl⟩; exact hS z hz) hc + change convexHull Real (P4715T1Position '' S) ∩ P4715T1Arc u v = _ + calc + _ = convexHull Real (P4715T1Position '' S) ∩ {x | F x = 0} := by + ext x + constructor + · rintro ⟨hx,hy⟩ + exact ⟨hx,((hside x).mp hy).2⟩ + · rintro ⟨hx,hy⟩ + exact ⟨hx,(hside x).mpr ⟨hHull hx,hy⟩⟩ + _ = _ := by rw [hh.2,hzero] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4802T1SimplexFaces.lean b/LeanPool/ApollonianSuperharmonic/P4802T1SimplexFaces.lean new file mode 100644 index 0000000000..e46582784c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4802T1SimplexFaces.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Convex.Combination + +-- [TABLET NODE: P4802T1SimplexFaces] + +/-! +# P4802T1SimplexFaces + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4802T1SimplexFaces {E : Type*} [AddCommGroup E] [Module Real E] + (V : Set E) (hV : V.Finite) (hi : AffineIndependent Real (fun x : V => (x : E))) + (S T : Set E) (hS : S ⊆ V) (hT : T ⊆ V) : + convexHull Real S ∩ convexHull Real T = convexHull Real (S ∩ T) := by +-- BODY + classical + have hs := hV.subset hS + have ht := hV.subset hT + have hh : AffineIndependent Real (fun x : hV.toFinset => (x : E)) := by + change AffineIndependent Real (fun x : (hV.toFinset : Set E) => (x : E)) + rw [hV.coe_toFinset] + exact hi + have he := hh.convexHull_inter (hs.toFinset_subset_toFinset.mpr hS) + (ht.toFinset_subset_toFinset.mpr hT) + simpa only [hs.coe_toFinset, ht.coe_toFinset] using he.symm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4802T1TriangleIndependent.lean b/LeanPool/ApollonianSuperharmonic/P4802T1TriangleIndependent.lean new file mode 100644 index 0000000000..392759e59e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4802T1TriangleIndependent.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Data.Fin.VecNotation +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.LinearCombination + +-- [TABLET NODE: P4802T1TriangleIndependent] + +/-! +# P4802T1TriangleIndependent + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4802T1TriangleIndependent (p : Fin 3 → Real × Real) + (hd : (p 1).1 * (p 2).2 - (p 1).1 * (p 0).2 - + (p 0).1 * (p 2).2 - (p 1).2 * (p 2).1 + + (p 1).2 * (p 0).1 + (p 0).2 * (p 2).1 ≠ 0) : + AffineIndependent Real p := by +-- BODY + rw [affineIndependent_iff_of_fintype] + intro w hw hp + rw [Finset.weightedVSub_eq_linear_combination _ hw] at hp + have hx := congrArg Prod.fst hp + have hy := congrArg Prod.snd hp + simp only [ Fin.sum_univ_succ, Fin.isValue, Fin.succ_zero_eq_one, Finset.univ_unique, + Fin.default_eq_zero, Finset.sum_singleton, Fin.succ_one_eq_two, Prod.fst_add, Prod.smul_fst, + smul_eq_mul, Prod.fst_zero, Prod.snd_add, Prod.smul_snd, Prod.snd_zero ] at hw hx hy + have h1 : w 1 = 0 := by + apply (mul_eq_zero.mp (show w 1 * + ((p 1).1 * (p 2).2 - (p 1).1 * (p 0).2 - + (p 0).1 * (p 2).2 - (p 1).2 * (p 2).1 + + (p 1).2 * (p 0).1 + (p 0).2 * (p 2).1) = 0 from ?_)).resolve_right hd + linear_combination ((p 2).2 - (p 0).2) * hx - + ((p 2).1 - (p 0).1) * hy + + ((p 0).2 * (p 2).1 - (p 0).1 * (p 2).2) * hw + have h2 : w 2 = 0 := by + apply (mul_eq_zero.mp (show w 2 * + ((p 1).1 * (p 2).2 - (p 1).1 * (p 0).2 - + (p 0).1 * (p 2).2 - (p 1).2 * (p 2).1 + + (p 1).2 * (p 0).1 + (p 0).2 * (p 2).1) = 0 from ?_)).resolve_right hd + linear_combination -((p 1).2 - (p 0).2) * hx + + ((p 1).1 - (p 0).1) * hy + + ((p 0).1 * (p 1).2 - (p 0).2 * (p 1).1) * hw + intro i + fin_cases i <;> simp_all + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1AffineDrawing.lean b/LeanPool/ApollonianSuperharmonic/P4812T1AffineDrawing.lean new file mode 100644 index 0000000000..1fa818ae27 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4812T1AffineDrawing.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent + +-- [TABLET NODE: P4812T1AffineDrawing] + +/-! +# P4812T1AffineDrawing + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a Gaussian-integer subgroup $L$ and additive equivalence +$\kappa:\mathbb Z^2\simeq L$, a periodic triangular drawing consists of +a `PlaneTriangulation` $P$ on $L$ and a bijection from +$L\sqcup L$ to its faces, written $U_x,D_x$. Adjacency in +$\kappa$-coordinates is `TriangularLatticeAdjacent`. Its +ordered face vertices are +$$ + U_x=(x,x+\kappa(1,0),x-\kappa(0,1)),\qquad + D_x=(x,x-\kappa(1,0),x+\kappa(0,1)). +$$ +The position of $x$ is $[x]$. For every $u,x,y\in L$, the arc on +$(u+x,u+y)$ is the translate by $[u]$ of the arc on $(x,y)$. +The regions of $U_{u+x}$ and $D_{u+x}$ are the translates by $[u]$ +of the regions of $U_x$ and $D_x$, respectively. These requirements +concern all pairs, not only adjacent pairs. This is purely geometric +data; no tiles, contact points, or contained walks are part of it. +-/ +structure P4812T1AffineDrawing (L : AddSubgroup GaussianInt) + (k : (Int × Int) ≃+ L) where +-- BODY + /-- The cellular plane triangulation on the period lattice. -/ + plane : PlaneTriangulation L + /-- Identify the two labelled face families with the faces of the drawing. -/ + faces : Sum L L ≃ plane.Face + adjacent_iff : ∀ x y, plane.adjacent x y ↔ + TriangularLatticeAdjacent (k.symm x) (k.symm y) + up_vertices : ∀ x, + plane.faceVertex (faces (.inl x)) 0 = x ∧ + plane.faceVertex (faces (.inl x)) 1 = x + k (1, 0) ∧ + plane.faceVertex (faces (.inl x)) 2 = x - k (0, 1) + down_vertices : ∀ x, + plane.faceVertex (faces (.inr x)) 0 = x ∧ + plane.faceVertex (faces (.inr x)) 1 = x - k (1, 0) ∧ + plane.faceVertex (faces (.inr x)) 2 = x + k (0, 1) + position_eq : ∀ x, plane.position x = GaussianRealPoint (x : GaussianInt) + edgeArc_periodic : ∀ (u x y : L), + plane.edgeArc (u + x) (u + y) = + (fun p => p + GaussianRealPoint (u : GaussianInt)) '' plane.edgeArc x y + faceRegion_periodic : ∀ (u : L) (f : Sum L L), + plane.faceRegion (faces (Sum.map (u + ·) (u + ·) f)) = + (fun p => p + GaussianRealPoint (u : GaussianInt)) '' + plane.faceRegion (faces f) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1AffineTransport.lean b/LeanPool/ApollonianSuperharmonic/P4812T1AffineTransport.lean new file mode 100644 index 0000000000..9a59762a8d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4812T1AffineTransport.lean @@ -0,0 +1,237 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4812T1AffineDrawing +public import Mathlib.Data.List.Chain +public import Mathlib.Topology.Homeomorph.Lemmas + +-- [TABLET NODE: P4812T1AffineTransport] + +/-! +# P4812T1AffineTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4812T1AffineTransport + (L : AddSubgroup GaussianInt) (k : (Int × Int) ≃+ L) + (P : PlaneTriangulation (Int × Int)) + (up down : (Int × Int) → P.Face) + (hadj : ∀ x y, P.adjacent x y ↔ TriangularLatticeAdjacent x y) + (hu : Function.Injective up) (hd : Function.Injective down) + (hud : ∀ x y, up x ≠ down y) + (hall : ∀ f, (∃ x, f = up x) ∨ ∃ x, f = down x) + (hup : ∀ x, P.faceVertex (up x) 0 = x ∧ + P.faceVertex (up x) 1 = x + (1, 0) ∧ + P.faceVertex (up x) 2 = x - (0, 1)) + (hdown : ∀ x, P.faceVertex (down x) 0 = x ∧ + P.faceVertex (down x) 1 = x - (1, 0) ∧ + P.faceVertex (down x) 2 = x + (0, 1)) + (hpos : ∀ x, P.position x = + (((x.1 : Real) - (x.2 : Real) / 2), (x.2 : Real))) + (harc : ∀ z x y, P.edgeArc (z + x) (z + y) = + (fun p => p + (((z.1 : Real) - (z.2 : Real) / 2), (z.2 : Real))) '' + P.edgeArc x y) + (hregions : ∀ z x, + P.faceRegion (up (z + x)) = + (fun p => p + (((z.1 : Real) - (z.2 : Real) / 2), (z.2 : Real))) '' + P.faceRegion (up x) ∧ + P.faceRegion (down (z + x)) = + (fun p => p + (((z.1 : Real) - (z.2 : Real) / 2), (z.2 : Real))) '' + P.faceRegion (down x)) + (H : (Real × Real) ≃ₜ (Real × Real)) + (hadd : ∀ p r, H (p + r) = H p + H r) + (hcoord : ∀ x, H (((x.1 : Real) - (x.2 : Real) / 2), (x.2 : Real)) = + GaussianRealPoint (k x : GaussianInt)) : + Nonempty (P4812T1AffineDrawing L k) := by +-- BODY + classical + let ev : Sum L L → P.Face := Sum.elim (fun x => up (k.symm x)) + (fun x => down (k.symm x)) + have hev : Function.Bijective ev := by + constructor + · intro f g h + cases f with + | inl x => + cases g with + | inl y => exact congrArg Sum.inl (k.symm.injective (hu h)) + | inr y => exact (hud _ _ h).elim + | inr x => + cases g with + | inl y => exact (hud _ _ h.symm).elim + | inr y => exact congrArg Sum.inr (k.symm.injective (hd h)) + · intro f + rcases hall f with ⟨x, rfl⟩ | ⟨x, rfl⟩ + · exact ⟨.inl (k x), by simp [ev]⟩ + · exact ⟨.inr (k x), by simp [ev]⟩ + let faces := Equiv.ofBijective ev hev + let Q : PlaneTriangulation L := { + adjacent := fun x y => P.adjacent (k.symm x) (k.symm y) + Face := P.Face + faceVertex := fun f i => k (P.faceVertex f i) + position := fun x => H (P.position (k.symm x)) + edgeArc := fun x y => H '' P.edgeArc (k.symm x) (k.symm y) + faceRegion := fun f => H '' P.faceRegion f + adjacent_symmetric := fun _ _ => P.adjacent_symmetric _ _ + adjacent_irreflexive := fun _ => P.adjacent_irreflexive _ + locally_finite := by + intro x + exact ((P.locally_finite (k.symm x)).image k).subset (by + intro y hy + exact ⟨k.symm y, hy, k.apply_symm_apply y⟩) + three_connected := by + intro D hD x hx y hy + let E := D.image k.symm + have hE : E.card < 3 := (Finset.card_image_le).trans_lt hD + have hxE : k.symm x ∉ E := by simpa [E] using hx + have hyE : k.symm y ∉ E := by simpa [E] using hy + obtain ⟨p, hp, hlast, havoid, hstep⟩ := P.three_connected E hE _ hxE _ hyE + refine ⟨p.map k, ?_, ?_, ?_, ?_⟩ + · simp [List.head?_map, hp] + · simp [List.getLast?_map, hlast] + · intro a ha + obtain ⟨b, hb, rfl⟩ := List.mem_map.mp ha + intro hk + exact havoid b hb (Finset.mem_image.mpr ⟨k b, hk, k.symm_apply_apply b⟩) + · have hc : List.IsChain P.adjacent p := + List.isChain_iff_forall_rel_of_append_cons_cons.mpr hstep + have hc' : List.IsChain (fun a b => P.adjacent (k.symm a) (k.symm b)) + (p.map k) := by simpa only [List.isChain_map, k.symm_apply_apply] using hc + exact List.isChain_iff_forall_rel_of_append_cons_cons.mp hc' + face_vertices_distinct := fun f => k.injective.comp (P.face_vertices_distinct f) + face_edges := by + intro f i j hij + simpa using P.face_edges f i j hij + every_edge_two_faces := by + intro x y hxy + obtain ⟨f, g, hfg, hf, hg, huniq⟩ := P.every_edge_two_faces _ _ hxy + have inc (h : P.Face) (z : L) : + (∃ i, k (P.faceVertex h i) = z) ↔ ∃ i, P.faceVertex h i = k.symm z := by + constructor + · rintro ⟨i, hi⟩ + exact ⟨i, k.injective (by simpa using hi)⟩ + · rintro ⟨i, hi⟩ + exact ⟨i, by simpa using congrArg k hi⟩ + refine ⟨f, g, hfg, ?_, ?_, ?_⟩ + · exact ⟨(inc f x).mpr hf.1, (inc f y).mpr hf.2⟩ + · exact ⟨(inc g x).mpr hg.1, (inc g y).mpr hg.2⟩ + · intro h hh + exact huniq h ⟨(inc h x).mp hh.1, (inc h y).mp hh.2⟩ + position_injective := H.injective.comp (P.position_injective.comp k.symm.injective) + arc_symmetric := by intro x y; rw [P.arc_symmetric] + arc_homeomorph := by + intro x y hxy + obtain ⟨h, h0, h1⟩ := P.arc_homeomorph _ _ hxy + refine ⟨h.trans (H.image _), ?_, ?_⟩ + · change H ((h ⟨0, by norm_num⟩ : P.edgeArc _ _) : Real × Real) = _ + rw [h0] + · change H ((h ⟨1, by norm_num⟩ : P.edgeArc _ _) : Real × Real) = _ + rw [h1] + arc_intersections := by + intro a b c d hab hcd hne + have hne' : ({k.symm a, k.symm b} : Set (Int × Int)) ≠ + {k.symm c, k.symm d} := by + intro he + apply hne + simpa only [Set.image_insert_eq, Set.image_singleton, + k.apply_symm_apply] using congrArg (fun s : Set (Int × Int) => k '' s) he + rw [← Set.image_inter H.injective, P.arc_intersections _ _ _ _ hab hcd hne'] + ext p + simp only [Set.mem_image, Set.mem_inter_iff, Set.mem_insert_iff, + Set.mem_singleton_iff] + constructor + · rintro ⟨z, ⟨w, ⟨hw, hw'⟩, rfl⟩, rfl⟩ + refine ⟨k w, ⟨?_, ?_⟩, by simp⟩ + · rcases hw with rfl | rfl <;> simp + · rcases hw' with rfl | rfl <;> simp + · rintro ⟨w, ⟨hw, hw'⟩, rfl⟩ + refine ⟨P.position (k.symm w), ⟨k.symm w, ⟨?_, ?_⟩, rfl⟩, rfl⟩ + · rcases hw with rfl | rfl <;> simp + · rcases hw' with rfl | rfl <;> simp + region_open := fun f => H.isOpenMap _ (P.region_open f) + region_connected := fun f => (P.region_connected f).image H H.continuous.continuousOn + region_disjoint := by + intro f g hfg + exact (P.region_disjoint hfg).image H.injective.injOn + (Set.subset_univ _) (Set.subset_univ _) + face_boundary := by + intro f + rw [← H.image_frontier, P.face_boundary] + simp only [Set.image_union, k.symm_apply_apply] + plane_cover := by + apply Set.eq_univ_of_forall + intro p + have hp : H.symm p ∈ Set.range P.position ∪ + {p | ∃ a b, P.adjacent a b ∧ p ∈ P.edgeArc a b} ∪ + {p | ∃ f, p ∈ P.faceRegion f} := by rw [P.plane_cover]; trivial + rcases hp with (⟨x, hx⟩ | ⟨a, b, hab, hp⟩) | ⟨f, hf⟩ + · exact Or.inl (Or.inl ⟨k x, by simp [hx]⟩) + · exact Or.inl (Or.inr ⟨k a, k b, by simpa using hab, + ⟨H.symm p, by simpa using hp, H.apply_symm_apply p⟩⟩) + · exact Or.inr ⟨f, H.symm p, hf, H.apply_symm_apply p⟩ } + refine ⟨{ + plane := Q + faces := faces + adjacent_iff := fun _ _ => hadj _ _ + up_vertices := ?_ + down_vertices := ?_ + position_eq := ?_ + edgeArc_periodic := ?_ + faceRegion_periodic := ?_ }⟩ + · intro x + change k (P.faceVertex (up (k.symm x)) 0) = x ∧ + k (P.faceVertex (up (k.symm x)) 1) = x + k (1, 0) ∧ + k (P.faceVertex (up (k.symm x)) 2) = x - k (0, 1) + rw [(hup _).1, (hup _).2.1, (hup _).2.2] + simp + · intro x + change k (P.faceVertex (down (k.symm x)) 0) = x ∧ + k (P.faceVertex (down (k.symm x)) 1) = x - k (1, 0) ∧ + k (P.faceVertex (down (k.symm x)) 2) = x + k (0, 1) + rw [(hdown _).1, (hdown _).2.1, (hdown _).2.2] + simp + · intro x + change H (P.position (k.symm x)) = _ + rw [hpos, hcoord, k.apply_symm_apply] + · intro u x y + change H '' P.edgeArc (k.symm (u + x)) (k.symm (u + y)) = + (fun p => p + GaussianRealPoint (u : GaussianInt)) '' + (H '' P.edgeArc (k.symm x) (k.symm y)) + rw [map_add, map_add, harc] + simp only [Set.image_image] + congr 1 + funext p + rw [hadd, hcoord, k.apply_symm_apply] + · intro u f + cases f with + | inl x => + change H '' P.faceRegion (up (k.symm (u + x))) = + (fun p => p + GaussianRealPoint (u : GaussianInt)) '' + (H '' P.faceRegion (up (k.symm x))) + rw [map_add, (hregions _ _).1] + simp only [Set.image_image] + congr 1 + funext p + rw [hadd, hcoord, k.apply_symm_apply] + | inr x => + change H '' P.faceRegion (down (k.symm (u + x))) = + (fun p => p + GaussianRealPoint (u : GaussianInt)) '' + (H '' P.faceRegion (down (k.symm x))) + rw [map_add, (hregions _ _).2] + simp only [Set.image_image] + congr 1 + funext p + rw [hadd, hcoord, k.apply_symm_apply] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1LatticeCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4812T1LatticeCoordinates.lean new file mode 100644 index 0000000000..0ef24d3e05 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4812T1LatticeCoordinates.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import Mathlib.Tactic.FunProp +public import Mathlib.Tactic.FieldSimp +public import Mathlib.Tactic.Ring +public import Mathlib.Analysis.Convex.Topology + +-- [TABLET NODE: P4812T1LatticeCoordinates] + +/-! +# P4812T1LatticeCoordinates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4812T1LatticeCoordinates (C : BandCircle) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hC : q 0 = C.1.1) : + ∃ k : (Int × Int) ≃+ TilingLattice C, + (∀ x, (k x : GaussianInt) = + (x.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (x.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) ∧ + ∃ H : (Real × Real) ≃ₜ (Real × Real), ∀ p, + H p = (p.1 + p.2 / 2) • GaussianRealPoint (BandVectors.1 (q 1) (q 0)) + + p.2 • GaussianRealPoint (BandVectors.1 (q 2) (q 0)) := by +-- BODY + classical + let a := BandVectors.1 (q 1) (q 0) + let b := BandVectors.1 (q 2) (q 0) + obtain ⟨ha, hb, hcoords, _⟩ := TilingLatticeBasis C q hq hC + let f : (Int × Int) →+ TilingLattice C := { + toFun := fun x => ⟨(x.1 : GaussianInt) * a + (x.2 : GaussianInt) * b, by + simpa [Int.cast_smul_eq_zsmul] using + (TilingLattice C).add_mem ((TilingLattice C).zsmul_mem ha x.1) + ((TilingLattice C).zsmul_mem hb x.2)⟩ + map_zero' := by apply Subtype.ext; simp + map_add' := by + intro x y + apply Subtype.ext + change ((x.1 + y.1 : Int) : GaussianInt) * a + + ((x.2 + y.2 : Int) : GaussianInt) * b = + ((x.1 : GaussianInt) * a + (x.2 : GaussianInt) * b) + + ((y.1 : GaussianInt) * a + (y.2 : GaussianInt) * b) + simp only [Int.cast_add] + ring } + have hf : Function.Bijective f := by + constructor + · intro x y hxy + obtain ⟨z, hz, huniq⟩ := hcoords (f x) + have hx : x = z := huniq x rfl + have hy : y = z := huniq y (congrArg Subtype.val hxy.symm) + exact hx.trans hy.symm + · intro w + obtain ⟨x, hx, _⟩ := hcoords w + exact ⟨x, Subtype.ext hx⟩ + let k : (Int × Int) ≃+ TilingLattice C := AddEquiv.ofBijective f hf + have hinj : Function.Injective (fun x : Int × Int => + (x.1 : GaussianInt) * a + (x.2 : GaussianInt) * b) := by + intro x y h + exact hf.1 (Subtype.ext h) + have hd : a.re * b.im - a.im * b.re ≠ 0 := by + intro hd + have h1 : (b.re, -a.re) = ((0, 0) : Int × Int) := by + apply hinj + apply Zsqrtd.ext <;> + simp <;> nlinarith + have h2 : (b.im, -a.im) = ((0, 0) : Int × Int) := by + apply hinj + apply Zsqrtd.ext <;> + simp <;> nlinarith + have ha0 : a = 0 := by + apply Zsqrtd.ext + · have := congrArg Prod.snd h1; simpa using neg_eq_zero.mp this + · have := congrArg Prod.snd h2; simpa using neg_eq_zero.mp this + have he : ((1, 0) : Int × Int) = (0, 0) := + hinj (by simp [ha0]) + norm_num at he + let d : Real := (a.re : Real) * b.im - (a.im : Real) * b.re + have hdR : d ≠ 0 := by dsimp [d]; exact_mod_cast hd + let H : (Real × Real) ≃ₜ (Real × Real) := { + toFun := fun p => + ((p.1 + p.2 / 2) * a.re + p.2 * b.re, + (p.1 + p.2 / 2) * a.im + p.2 * b.im) + invFun := fun p => + (((b.im : Real) * p.1 - b.re * p.2) / d - + (((a.re : Real) * p.2 - a.im * p.1) / d) / 2, + ((a.re : Real) * p.2 - a.im * p.1) / d) + left_inv := by + intro p + apply Prod.ext <;> dsimp <;> field_simp <;> ring + right_inv := by + intro p + apply Prod.ext <;> dsimp <;> field_simp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + refine ⟨k, fun _ => rfl, H, ?_⟩ + intro p + rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1ReflectedTouching.lean b/LeanPool/ApollonianSuperharmonic/P4812T1ReflectedTouching.lean new file mode 100644 index 0000000000..64f9782d8f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4812T1ReflectedTouching.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurn +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P4812T1ReflectedTouching] + +/-! +# P4812T1ReflectedTouching + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4812T1ReflectedTouching (T : ProtoTile) (a b : GaussianInt) + (hne : T.cells.Nonempty) (hsym : QuarterTurnSymmetric T) + (ht : TouchingTriple T (TileTranslation T a) (TileTranslation T (-b))) : + TouchingTriple T (TileTranslation T (-a)) (TileTranslation T b) := by +-- BODY + classical + obtain ⟨u, _, hfixed, _⟩ := QuarterTurnSymmetricCenteredTransport T hsym + let F : ProtoTile → ProtoTile := fun U => TileTranslation (TileQuarterTurn U) u + let f : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 + u + have cellsF (U : ProtoTile) : (F U).cells = U.cells.image f := by + simp [F, f, TileTranslation, TileQuarterTurn, Finset.image_image, + Function.comp_def, GaussianTranslation] + have fixed2 : (F (F T)).cells = T.cells := by + calc + (F (F T)).cells = (F T).cells.image f := cellsF _ + _ = T.cells.image f := congrArg (fun s => s.image f) hfixed + _ = (F T).cells := (cellsF T).symm + _ = T.cells := hfixed + have translated (z : GaussianInt) : + (F (F (TileTranslation T z))).cells = (TileTranslation T (-z)).cells := by + have comm : (F (F (TileTranslation T z))).cells = + (TileTranslation (F (F T)) (-z)).cells := by + simp only [cellsF, TileTranslation, Finset.image_image] + congr 1 + funext x + apply Zsqrtd.ext <;> simp [f, Function.comp_def, GaussianQuarterTurn, + GaussianTranslation] <;> ring + rw [comm] + change (F (F T)).cells.image _ = T.cells.image _ + rw [fixed2] + have preserves (A B C : ProtoTile) (h : TouchingTriple A B C) : + TouchingTriple (F A) (F B) (F C) := + (TouchingTripleCovariance (TileQuarterTurn A) (TileQuarterTurn B) + (TileQuarterTurn C) u).1.mp ((TouchingTripleCovariance A B C u).2.1.mp h) + have ht2 := preserves _ _ _ (preserves _ _ _ ht) + have ha := translated a + have hb : (F (F (TileTranslation T (-b)))).cells = (TileTranslation T b).cells := by + simpa only [neg_neg] using translated (-b) + have nonempty_tr (z : GaussianInt) : (TileTranslation T z).cells.Nonempty := + hne.image _ + have obs (A B : ProtoTile) (hc : A.cells = B.cells) (hn : B.cells.Nonempty) := + ProtoTileObservableExtensionality A B hc (by + intro h + exact (Finset.nonempty_iff_ne_empty.mp hn (hc.symm.trans h)).elim) + have o0 := obs _ _ fixed2 hne + have oa := obs _ _ ha (nonempty_tr (-a)) + have ob := obs _ _ hb (nonempty_tr b) + have e0 := Finset.nonempty_iff_ne_empty.mp hne + have ea := Finset.nonempty_iff_ne_empty.mp (nonempty_tr (-a)) + have eb := Finset.nonempty_iff_ne_empty.mp (nonempty_tr b) + unfold TouchingTriple TileTouching at ht2 ⊢ + simpa only [fixed2, ha, hb, o0.2.1, o0.2.2.1, + oa.2.1, oa.2.2.1, ob.2.1, ob.2.2.1, e0, ea, eb, false_and, or_false] using ht2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean new file mode 100644 index 0000000000..febc35e0d4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean @@ -0,0 +1,2666 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4812T1AffineDrawing +public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import LeanPool.ApollonianSuperharmonic.P4677T2TouchingWalk +public import LeanPool.ApollonianSuperharmonic.P4733T1WalkTransport +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FootprintEdges + +-- [TABLET NODE: P4812T1RegularFaceWalks] + +/-! +# P4812T1RegularFaceWalks + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RegularFaceWalkProof + +private theorem boundaryFoot : + (by + classical + exact + ∀ (W : ProtoTile), ∀ z ∈ BoundaryFootprintVertices W, z ∈ FootprintVertices W + ) := by + classical + intro W z hz + by_cases hW : W.cells.Nonempty + · simp only [BoundaryFootprintVertices, ite_eq_left hW, Set.mem_ofPred_eq] at hz + rcases hz with ⟨e, he, hze⟩ + have he' : e ∈ FootprintEdges W := by + change ∃ c ∈ W.cells, + e = {c, c + 1} ∨ e = {c, c + ⟨0, 1⟩} ∨ + e = {c + 1, c + 1 + ⟨0, 1⟩} ∨ + e = {c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩} + rcases he with ⟨w, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hw, _⟩ | ⟨_, hw⟩ + · exact ⟨w, hw, Or.inl rfl⟩ + · refine ⟨w - ⟨0, 1⟩, hw, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [Zsqrtd.ext_iff] + · rcases h with ⟨hw, _⟩ | ⟨_, hw⟩ + · exact ⟨w, hw, Or.inr (Or.inl rfl)⟩ + · refine ⟨w - 1, hw, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + rcases he' with ⟨c, hc, hcE⟩ + rcases hcE with hcE | hcE | hcE | hcE + all_goals + simp only [FootprintVertices, ite_eq_left hW] + rw [hcE] at hze + simp only [Finset.mem_insert, Finset.mem_singleton] at hze + rcases hze with hze | hze <;> subst z + · exact ⟨c, hc, Or.inl rfl⟩ + · exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ + · exact ⟨c, hc, Or.inl rfl⟩ + · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ + · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + · simpa [BoundaryFootprintVertices, FootprintVertices, hW] using hz + +private theorem translateComp : + (by + classical + exact + ∀ (W : ProtoTile), ∀ (v : GaussianInt), ∀ (w : GaussianInt), TileTranslation + (TileTranslation W v) w = TileTranslation W (v + w) + ) := by + classical + intro W v w + cases W with + | mk cells anchor => + simp only [TileTranslation] + rw [ProtoTile.mk.injEq] + constructor + · rw [Finset.image_image] + congr 1 + funext z + simp [GaussianTranslation, add_assoc] + · simp [GaussianTranslation, add_assoc] + +private theorem edgeDiff : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + (k (1, 1) = a + b) → ((k (-1, -1) = -(a + b)) → ((k (-1, 0) = -a) → ((k (0, -1) = -b) → + (∀ (x : ↥L), ∀ (y : ↥L), D.plane.adjacent x y → y = x + a ∨ x = y + a ∨ y = x + b ∨ x + = y + b ∨ y = x + (a + b) ∨ x = y + (a + b))))) + ) := by + classical + intro L k D a b k11 kneg11 kneg10 kneg01 x y hxy + have hc := (D.adjacent_iff x y).mp hxy + have forward {z : L} (hz : y - x = z) : y = x + z := by + calc y = (y - x) + x := by abel + _ = z + x := congrArg (fun t : L => t + x) hz + _ = x + z := add_comm _ _ + have backward {z : L} (hz : y - x = -z) : x = y + z := by + have hz' : x - y = z := by + calc x - y = -(y - x) := by abel + _ = -(-z) := congrArg Neg.neg hz + _ = z := by simp + calc x = (x - y) + y := by abel + _ = z + y := congrArg (fun t : L => t + y) hz' + _ = y + z := add_comm _ _ + rcases hc with h1 | h2 | h3 | h4 | h5 | h6 + · have hm : y - x = a := by + simpa [map_sub, k.apply_symm_apply, a, b] using congrArg k h1 + exact Or.inl (forward hm) + · have hm : y - x = b := by + simpa [map_sub, k.apply_symm_apply, a, b] using congrArg k h2 + exact Or.inr (Or.inr (Or.inl (forward hm))) + · have hm : y - x = -(a + b) := by + simpa [map_sub, k.apply_symm_apply, kneg11] using congrArg k h3 + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (backward hm))))) + · have hm : y - x = -a := by + simpa [map_sub, k.apply_symm_apply, kneg10] using congrArg k h4 + exact Or.inr (Or.inl (backward hm)) + · have hm : y - x = -b := by + simpa [map_sub, k.apply_symm_apply, kneg01] using congrArg k h5 + exact Or.inr (Or.inr (Or.inr (Or.inl (backward hm)))) + · have hm : y - x = a + b := by + simpa [map_sub, k.apply_symm_apply, a, b, k11] using congrArg k h6 + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (forward hm))))) + +private theorem uniquePair : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (x : ↥L), ∀ (y : ↥L), D.plane.adjacent x y → ∀ (f : D.plane.Face), ∀ (g : + D.plane.Face), ∀ (c : D.plane.Face), ∀ (d : D.plane.Face), f ≠ g → c ≠ d → ((∃ (i : + Fin (3 : ℕ)), D.plane.faceVertex f i = x) ∧ ∃ (i : Fin (3 : ℕ)), D.plane.faceVertex f + i = y) → ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex g i = x) ∧ ∃ (i : Fin (3 : ℕ)), + D.plane.faceVertex g i = y) → ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex c i = x) ∧ ∃ + (i : Fin (3 : ℕ)), D.plane.faceVertex c i = y) → ((∃ (i : Fin (3 : ℕ)), + D.plane.faceVertex d i = x) ∧ ∃ (i : Fin (3 : ℕ)), D.plane.faceVertex d i = y) → f = + c ∧ g = d ∨ f = d ∧ g = c + ) := by + classical + intro L k D x y hxy f g c d hfg hcd hf hg hc hd + obtain ⟨p, q, hpq, hp, hq, hu⟩ := D.plane.every_edge_two_faces x y hxy + have hmem (z : D.plane.Face) + (hz : (∃ i, D.plane.faceVertex z i = x) ∧ + (∃ i, D.plane.faceVertex z i = y)) : z = p ∨ z = q := hu z hz + have hfg' : (f = p ∧ g = q) ∨ (f = q ∧ g = p) := by + rcases hmem f hf with hfp | hfp + · rcases hmem g hg with hgp | hgp + · exact False.elim (hfg (hfp.trans hgp.symm)) + · exact Or.inl ⟨hfp, hgp⟩ + · rcases hmem g hg with hgp | hgp + · exact Or.inr ⟨hfp, hgp⟩ + · exact False.elim (hfg (hfp.trans hgp.symm)) + have hcd' : (c = p ∧ d = q) ∨ (c = q ∧ d = p) := by + rcases hmem c hc with hcp | hcp + · rcases hmem d hd with hdp | hdp + · exact False.elim (hcd (hcp.trans hdp.symm)) + · exact Or.inl ⟨hcp, hdp⟩ + · rcases hmem d hd with hdp | hdp + · exact Or.inr ⟨hcp, hdp⟩ + · exact False.elim (hcd (hcp.trans hdp.symm)) + rcases hfg' with ⟨hfp, hgq⟩ | ⟨hfq, hgp⟩ + · rcases hcd' with ⟨hcp, hdq⟩ | ⟨hcq, hdp⟩ + · exact Or.inl ⟨hfp.trans hcp.symm, hgq.trans hdq.symm⟩ + · exact Or.inr ⟨hfp.trans hdp.symm, hgq.trans hcq.symm⟩ + · rcases hcd' with ⟨hcp, hdq⟩ | ⟨hcq, hdp⟩ + · exact Or.inr ⟨hfq.trans hdq.symm, hgp.trans hcp.symm⟩ + · exact Or.inl ⟨hfq.trans hcq.symm, hgp.trans hdp.symm⟩ + +private theorem rho_mem : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + (∀ (W : ProtoTile), ∀ (z : GaussianInt), (z ∈ BoundaryFootprintVertices W) → (z ∈ + FootprintVertices W)) → ((∀ (W : ProtoTile), ∀ (z : GaussianInt), ∀ (v : + GaussianInt), (z ∈ BoundaryFootprintVertices W) → (z + v ∈ BoundaryFootprintVertices + (TileTranslation W v))) → ((∀ (W : ProtoTile), ∀ (v : GaussianInt), ∀ (w : + GaussianInt), TileTranslation (TileTranslation W v) w = TileTranslation W (v + w)) → + ((ru ∈ BoundaryFootprintVertices T) → ((ru ∈ BoundaryFootprintVertices + (TileTranslation T (a : GaussianInt))) → ((ru ∈ BoundaryFootprintVertices + (TileTranslation T (-(b : GaussianInt)))) → ((rd ∈ BoundaryFootprintVertices T) → + ((rd ∈ BoundaryFootprintVertices (TileTranslation T (-(a : GaussianInt)))) → ((rd ∈ + BoundaryFootprintVertices (TileTranslation T (b : GaussianInt))) → (∀ (q : ↥L ⊕ ↥L), + ∀ (i : Fin (3 : ℕ)), rho ((D.faces : ↥L ⊕ ↥L → D.plane.Face) q) ∈ FootprintVertices + (TileTranslation T (↑(D.plane.faceVertex ((D.faces : ↥L ⊕ ↥L → D.plane.Face) q) i) : + GaussianInt))))))))))) + ) := by + classical + intro L k D T a b ru rd rho boundaryFoot translateBoundary translateComp ru0 rua rub rd0 rda + rdb q i + cases q with + | inl x => + unfold rho + rw [D.faces.symm_apply_apply] + obtain ⟨hv0, hv1, hv2⟩ := D.up_vertices x + fin_cases i + · change ru + (x : GaussianInt) ∈ + FootprintVertices (TileTranslation T ((D.plane.faceVertex (D.faces (.inl x)) 0 : L) : + GaussianInt)) + rw [hv0] + exact boundaryFoot _ _ (translateBoundary T ru (x : GaussianInt) ru0) + · change ru + (x : GaussianInt) ∈ + FootprintVertices (TileTranslation T ((D.plane.faceVertex (D.faces (.inl x)) 1 : L) : + GaussianInt)) + rw [hv1] + have heq : (x + a : L) = a + x := add_comm x a + rw [heq] + simp only [AddSubgroup.coe_add] + change ru + (x : GaussianInt) ∈ + FootprintVertices (TileTranslation T ((a : GaussianInt) + (x : GaussianInt))) + rw [← translateComp T (a : GaussianInt) (x : GaussianInt)] + exact boundaryFoot _ _ (translateBoundary (TileTranslation T (a : GaussianInt)) + ru (x : GaussianInt) rua) + · change ru + (x : GaussianInt) ∈ + FootprintVertices (TileTranslation T ((D.plane.faceVertex (D.faces (.inl x)) 2 : L) : + GaussianInt)) + rw [hv2] + have heq : (x - b : L) = (-b) + x := by abel + rw [heq] + simp only [AddSubgroup.coe_add] + change ru + (x : GaussianInt) ∈ + FootprintVertices (TileTranslation T (-(b : GaussianInt) + (x : GaussianInt))) + rw [← translateComp T (-(b : GaussianInt)) (x : GaussianInt)] + exact boundaryFoot _ _ (translateBoundary (TileTranslation T (-(b : GaussianInt))) + ru (x : GaussianInt) rub) + | inr x => + unfold rho + rw [D.faces.symm_apply_apply] + obtain ⟨hv0, hv1, hv2⟩ := D.down_vertices x + fin_cases i + · change rd + (x : GaussianInt) ∈ + FootprintVertices (TileTranslation T ((D.plane.faceVertex (D.faces (.inr x)) 0 : L) : + GaussianInt)) + rw [hv0] + exact boundaryFoot _ _ (translateBoundary T rd (x : GaussianInt) rd0) + · change rd + (x : GaussianInt) ∈ + FootprintVertices (TileTranslation T ((D.plane.faceVertex (D.faces (.inr x)) 1 : L) : + GaussianInt)) + rw [hv1] + have heq : (x - a : L) = (-a) + x := by abel + rw [heq] + simp only [AddSubgroup.coe_add] + change rd + (x : GaussianInt) ∈ + FootprintVertices (TileTranslation T (-(a : GaussianInt) + (x : GaussianInt))) + rw [← translateComp T (-(a : GaussianInt)) (x : GaussianInt)] + exact boundaryFoot _ _ (translateBoundary (TileTranslation T (-(a : GaussianInt))) + rd (x : GaussianInt) rda) + · change rd + (x : GaussianInt) ∈ + FootprintVertices (TileTranslation T ((D.plane.faceVertex (D.faces (.inr x)) 2 : L) : + GaussianInt)) + rw [hv2] + have heq : (x + b : L) = b + x := add_comm x b + rw [heq] + simp only [AddSubgroup.coe_add] + change rd + (x : GaussianInt) ∈ + FootprintVertices (TileTranslation T ((b : GaussianInt) + (x : GaussianInt))) + rw [← translateComp T (b : GaussianInt) (x : GaussianInt)] + exact boundaryFoot _ _ (translateBoundary (TileTranslation T (b : GaussianInt)) + rd (x : GaussianInt) rdb) + +private theorem transZero : + (by + classical + exact + ∀ (W : ProtoTile), TileTranslation W (0 : GaussianInt) = W + ) := by + classical + intro W + cases W with + | mk cells anchor => + simp only [TileTranslation] + rw [ProtoTile.mk.injEq] + constructor + · change cells.image (GaussianTranslation 0) = cells + have h : GaussianTranslation 0 = id := by + funext z + simp [GaussianTranslation] + rw [h, Finset.image_id] + · simp [GaussianTranslation] + +private theorem mapTranslateRev : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), (∀ (p : List GaussianInt), ∀ (x : L), ∀ (u : L), p.map + (fun z => z + ((u + x : L) : GaussianInt)) = (p.map (fun z => z + (x : + GaussianInt))).map (fun z => z + (u : GaussianInt))) → (∀ (p : List GaussianInt), ∀ + (x : ↥L), ∀ (u : ↥L), (List.map (fun (z : GaussianInt) => z + (↑(u + x) : + GaussianInt)) p).reverse = List.map (fun (z : GaussianInt) => z + (↑u : GaussianInt)) + (List.map (fun (z : GaussianInt) => z + (↑x : GaussianInt)) p).reverse) + ) := by + classical + intro L mapTranslate p x u + calc + _ = ((p.map (fun z => z + (x : GaussianInt))).map + (fun z => z + (u : GaussianInt))).reverse := by + exact congrArg List.reverse (mapTranslate p x u) + _ = (((p.map (fun z => z + (x : GaussianInt))).reverse).map + (fun z => z + (u : GaussianInt))) := by + simp [List.map_reverse] + +private theorem ifMap3 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (u : ↥L), ∀ (P0 : Prop), ∀ (P1 : Prop), ∀ (P2 : Prop), + ∀ (Q0 : Prop), ∀ (Q1 : Prop), ∀ (Q2 : Prop), (P0 ↔ Q0) → (P1 ↔ Q1) → (P2 ↔ Q2) → ∀ + (A0 : List GaussianInt), ∀ (A1 : List GaussianInt), ∀ (A2 : List GaussianInt), ∀ (B0 + : List GaussianInt), ∀ (B1 : List GaussianInt), ∀ (B2 : List GaussianInt), A0 = + List.map (fun (z : GaussianInt) => z + (↑u : GaussianInt)) B0 → A1 = List.map (fun (z + : GaussianInt) => z + (↑u : GaussianInt)) B1 → A2 = List.map (fun (z : GaussianInt) + => z + (↑u : GaussianInt)) B2 → (if P0 then A0 else if P1 then A1 else if P2 then A2 + else []) = List.map (fun (z : GaussianInt) => z + (↑u : GaussianInt)) (if Q0 then B0 + else if Q1 then B1 else if Q2 then B2 else []) + ) := by + classical + intro L u P0 P1 P2 Q0 Q1 Q2 h0 h1 h2 A0 A1 A2 B0 B1 B2 m0 m1 m2 + by_cases hq0 : Q0 <;> by_cases hq1 : Q1 <;> by_cases hq2 : Q2 <;> + simp [h0, h1, h2, hq0, hq1, hq2, m0, m1, m2] + +private theorem boundaryEdgeFoot : + (by + classical + exact + ∀ (W : ProtoTile), ∀ e ∈ BoundaryFootprintEdges W, e ∈ FootprintEdges W + ) := by + classical + intro W e he + simp only [BoundaryFootprintEdges, Set.mem_ofPred_eq] at he + simp only [FootprintEdges, Set.mem_ofPred_eq] + change ∃ c ∈ W.cells, + e = {c, c + 1} ∨ e = {c, c + ⟨0, 1⟩} ∨ + e = {c + 1, c + 1 + ⟨0, 1⟩} ∨ + e = {c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩} + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [Zsqrtd.ext_iff] + · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + +private theorem commonEdgeTouch : + (by + classical + exact + (∀ (W : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges W) → (e ∈ + FootprintEdges W)) → (∀ (V : ProtoTile), ∀ (W : ProtoTile), Finset.Nonempty V.cells → + Finset.Nonempty W.cells → TileTouching V W → (FootprintEdges V ∩ FootprintEdges + W).Nonempty) + ) := by + classical + intro boundaryEdgeFoot V W hneV hneW h + rcases h with h | h | h + · rcases h with ⟨_, _, _, hp⟩ + rcases hp with ⟨p, _, hlen, _, _, hedges⟩ + cases p with + | nil => simp at hlen + | cons x xs => + cases xs with + | nil => simp at hlen + | cons y ys => + let e : Finset GaussianInt := {x, y} + have he : e ∈ BoundaryFootprintEdges V ∩ BoundaryFootprintEdges W := by + apply (hedges e).2 + refine ⟨x, y, [], ys, ?_, ?_⟩ + · rfl + · simp [e] + exact ⟨e, boundaryEdgeFoot V e he.1, boundaryEdgeFoot W e he.2⟩ + · exact (Finset.nonempty_iff_ne_empty.mp hneV h.1).elim + · exact (Finset.nonempty_iff_ne_empty.mp hneW h.1).elim + +private theorem rowEdge2 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (T : ProtoTile), + let a : L := k (1, 0) + let b : L := k (0, 1) + (∀ (W : ProtoTile), ∀ (v : GaussianInt), ∀ (w : GaussianInt), TileTranslation + (TileTranslation W v) w = TileTranslation W (v + w)) → (∀ (e2 : Finset GaussianInt), + (e2 ∈ FootprintEdges (TileTranslation T (↑a : GaussianInt)) ∩ FootprintEdges + (TileTranslation T (-(↑b : GaussianInt)))) → ((∀ (V : ProtoTile), ∀ (v : + GaussianInt), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges V) → (e.image + (GaussianTranslation v) ∈ FootprintEdges (TileTranslation V v))) → ((∀ (v : L), ∀ (w + : L), TileTranslation (TileTranslation T (v : GaussianInt)) (w : GaussianInt) = + TileTranslation T ((v + w : L) : GaussianInt)) → (∀ (w : ↥L), Finset.image + (GaussianTranslation (↑w : GaussianInt)) e2 ∈ FootprintEdges (TileTranslation T (↑(w + + a) : GaussianInt)) ∩ FootprintEdges (TileTranslation T (↑(w - b) : GaussianInt)))))) + ) := by + classical + intro L k T a b translateComp e2 he2 footprintEdgeTranslate tileAdd w + refine ⟨?_, ?_⟩ + · simpa [tileAdd, add_assoc, add_comm, add_left_comm] using + footprintEdgeTranslate (TileTranslation T (a : GaussianInt)) + (w : GaussianInt) e2 he2.1 + · simpa [translateComp, AddSubgroup.coe_neg, AddSubgroup.coe_sub, + sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using + footprintEdgeTranslate (TileTranslation T (-(b : GaussianInt))) + (w : GaussianInt) e2 he2.2 + +private theorem rowWalk0 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let a : L := k (1, 0) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + let fU := D.faces (.inl (0 : L)) + let fDa := D.faces (.inr a) + ∀ (p0 : List GaussianInt), (p0.head? = some (rho fU) ∧ p0.getLast? = some (rho fDa) ∧ (∀ + z ∈ p0, z ∈ FootprintVertices T ∩ FootprintVertices (TileTranslation T (↑a : + GaussianInt))) ∧ ∀ (a_1 : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List + GaussianInt), ∀ (l₂ : List GaussianInt), p0 = l₁ ++ a_1 :: b :: l₂ → {a_1, b} ∈ + FootprintEdges T ∩ FootprintEdges (TileTranslation T (↑a : GaussianInt))) → ((∀ (v : + L), ∀ (w : L), TileTranslation (TileTranslation T (v : GaussianInt)) (w : + GaussianInt) = TileTranslation T ((v + w : L) : GaussianInt)) → ((∀ (w : L), rho + (D.faces (.inl w)) = rho fU + (w : GaussianInt)) → ((∀ (w : L), rho (D.faces (.inr (w + + a))) = rho (D.faces (.inr a)) + (w : GaussianInt)) → (∀ (w : ↥L), + P4733T1ContainedWalk (TileTranslation T (↑w : GaussianInt)) (TileTranslation T (↑(w + + a) : GaussianInt)) (rho ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inl w))) (rho + ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w + a)))) (List.map (fun (z : + GaussianInt) => z + (↑w : GaussianInt)) p0))))) + ) := by + classical + intro L k D T a ru rd rho fU fDa p0 hp0 tileAdd rhoUpShift rhoDown0Shift w + have hb : P4733T1ContainedWalk T (TileTranslation T (a : GaussianInt)) + (rho fU) (rho fDa) p0 := by + exact hp0 + have ht := (P4733T1WalkTransport T (TileTranslation T (a : GaussianInt)) + (rho fU) (rho fDa) p0 hb).2 (w : GaussianInt) + simpa [P4733T1ContainedWalk, tileAdd, rhoUpShift, rhoDown0Shift, + add_assoc, add_comm, add_left_comm] using ht + +private theorem rowWalk1 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + (∀ (W : ProtoTile), ∀ (v : GaussianInt), ∀ (w : GaussianInt), TileTranslation + (TileTranslation W v) w = TileTranslation W (v + w)) → ( + let fU := D.faces (.inl (0 : L)) + let fDmb := D.faces (.inr (-b)) + ∀ (p1 : List GaussianInt), (p1.head? = some (rho fU) ∧ p1.getLast? = some (rho fDmb) ∧ (∀ + z ∈ p1, z ∈ FootprintVertices T ∩ FootprintVertices (TileTranslation T (-(↑b : + GaussianInt)))) ∧ ∀ (a : GaussianInt), ∀ (b_1 : GaussianInt), ∀ (l₁ : List + GaussianInt), ∀ (l₂ : List GaussianInt), p1 = l₁ ++ a :: b_1 :: l₂ → {a, b_1} ∈ + FootprintEdges T ∩ FootprintEdges (TileTranslation T (-(↑b : GaussianInt)))) → ((∀ (w + : L), rho (D.faces (.inl w)) = rho fU + (w : GaussianInt)) → ((∀ (w : L), rho + (D.faces (.inr (w - b))) = rho (D.faces (.inr (-b))) + (w : GaussianInt)) → (∀ (w : + ↥L), P4733T1ContainedWalk (TileTranslation T (↑w : GaussianInt)) (TileTranslation T + (↑(w - b) : GaussianInt)) (rho ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inl w))) (rho + ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w - b)))) (List.map (fun (z : + GaussianInt) => z + (↑w : GaussianInt)) p1))))) + ) := by + classical + intro L k D T b ru rd rho translateComp fU fDmb p1 hp1 rhoUpShift rhoDown1Shift w + have hb : P4733T1ContainedWalk T (TileTranslation T (-(b : GaussianInt))) + (rho fU) (rho fDmb) p1 := hp1 + have ht := (P4733T1WalkTransport T (TileTranslation T (-(b : GaussianInt))) + (rho fU) (rho fDmb) p1 hb).2 (w : GaussianInt) + rw [rhoDown1Shift] + simpa [P4733T1ContainedWalk, translateComp, rhoUpShift, rhoDown1Shift, + AddSubgroup.coe_neg, AddSubgroup.coe_sub, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using ht + +private theorem rowWalk2 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + (∀ (W : ProtoTile), ∀ (v : GaussianInt), ∀ (w : GaussianInt), TileTranslation + (TileTranslation W v) w = TileTranslation W (v + w)) → ( + let fU := D.faces (.inl (0 : L)) + let fDamB := D.faces (.inr (a - b)) + ∀ (p2 : List GaussianInt), (p2.head? = some (rho fU) ∧ p2.getLast? = some (rho fDamB) ∧ + (∀ z ∈ p2, z ∈ FootprintVertices (TileTranslation T (↑a : GaussianInt)) ∩ + FootprintVertices (TileTranslation T (-(↑b : GaussianInt)))) ∧ ∀ (a_1 : GaussianInt), + ∀ (b_1 : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), p2 = l₁ + ++ a_1 :: b_1 :: l₂ → {a_1, b_1} ∈ FootprintEdges (TileTranslation T (↑a : + GaussianInt)) ∩ FootprintEdges (TileTranslation T (-(↑b : GaussianInt)))) → ((∀ (w : + L), rho (D.faces (.inl w)) = rho fU + (w : GaussianInt)) → ((∀ (w : L), rho (D.faces + (.inr (w + a - b))) = rho (D.faces (.inr (a - b))) + (w : GaussianInt)) → (∀ (w : + ↥L), P4733T1ContainedWalk (TileTranslation T (↑(w + a) : GaussianInt)) + (TileTranslation T (↑(w - b) : GaussianInt)) (rho ((D.faces : ↥L ⊕ ↥L → D.plane.Face) + (Sum.inl w))) (rho ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w + a - b)))) + (List.map (fun (z : GaussianInt) => z + (↑w : GaussianInt)) p2))))) + ) := by + classical + intro L k D T a b ru rd rho translateComp fU fDamB p2 hp2 rhoUpShift rhoDown2Shift w + have hb : P4733T1ContainedWalk (TileTranslation T (a : GaussianInt)) + (TileTranslation T (-(b : GaussianInt))) (rho fU) (rho fDamB) p2 := hp2 + have ht := (P4733T1WalkTransport (TileTranslation T (a : GaussianInt)) + (TileTranslation T (-(b : GaussianInt))) (rho fU) (rho fDamB) p2 hb).2 (w : GaussianInt) + rw [rhoDown2Shift] + simpa [P4733T1ContainedWalk, translateComp, rhoUpShift, rhoDown2Shift, fDamB, + AddSubgroup.coe_neg, AddSubgroup.coe_sub, AddSubgroup.coe_add, + sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using ht + +private theorem row0Inc : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + ∀ (w : ↥L), ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex ((D.faces : ↥L ⊕ ↥L → D.plane.Face) + (Sum.inl w)) i = w) ∧ ∃ (i : Fin (3 : ℕ)), D.plane.faceVertex ((D.faces : ↥L ⊕ ↥L → + D.plane.Face) (Sum.inl w)) i = w + a) ∧ (∃ (i : Fin (3 : ℕ)), D.plane.faceVertex + ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w + a))) i = w) ∧ ∃ (i : Fin (3 : ℕ)), + D.plane.faceVertex ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w + a))) i = w + a + ) := by + classical + intro L k D a w + constructor <;> constructor + · exact ⟨0, by simp [D.up_vertices]⟩ + · exact ⟨1, by simp [D.up_vertices, a]⟩ + · exact ⟨1, by simp [D.down_vertices, a, sub_eq_add_neg]⟩ + · exact ⟨0, by simp [D.down_vertices]⟩ + +private theorem row1Inc : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let b : L := k (0, 1) + ∀ (w : ↥L), ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex ((D.faces : ↥L ⊕ ↥L → D.plane.Face) + (Sum.inl w)) i = w - b) ∧ ∃ (i : Fin (3 : ℕ)), D.plane.faceVertex ((D.faces : ↥L ⊕ ↥L + → D.plane.Face) (Sum.inl w)) i = w) ∧ (∃ (i : Fin (3 : ℕ)), D.plane.faceVertex + ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w - b))) i = w - b) ∧ ∃ (i : Fin (3 : + ℕ)), D.plane.faceVertex ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w - b))) i = w + ) := by + classical + intro L k D b w + constructor <;> constructor + · exact ⟨2, by simp [D.up_vertices, b, sub_eq_add_neg]⟩ + · exact ⟨0, by simp [D.up_vertices]⟩ + · exact ⟨0, by simp [D.down_vertices]⟩ + · exact ⟨2, by simp [D.down_vertices, b, + sub_eq_add_neg, add_comm, add_left_comm]⟩ + +private theorem row2CanonicalForward : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + (a ≠ a - b) → ((-b ≠ a - b) → (∀ (w : ↥L), path ((D.faces : ↥L ⊕ ↥L → D.plane.Face) + (Sum.inl w)) ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w + a - b))) = List.map + (fun (z : GaussianInt) => z + (↑w : GaussianInt)) p2)) + ) := by + classical + intro L k D a b p0 p1 p2 rowPath path aNeAmB negBNeAmB w + have hn1 : w + a - b ≠ w + a := by + intro hh + apply aNeAmB + have h' : w + (a - b) = w + a := by + simpa [sub_eq_add_neg, add_assoc] using hh + exact (add_left_cancel h').symm + have hn2 : w + a - b ≠ w - b := by + intro hh + apply negBNeAmB + have h' : w + (a - b) = w + (-b) := by + simpa [sub_eq_add_neg, add_assoc] using hh + exact (add_left_cancel h').symm + have ht : w + a - b = w + (a - b) := by abel + simp only [path, D.faces.symm_apply_apply, ite_eq_right hn1, ite_eq_right hn2, + ite_eq_left ht, rowPath] + simp + +private theorem row1CanonicalForward : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + (a ≠ -b) → (∀ (w : ↥L), path ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inl w)) ((D.faces : + ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w - b))) = List.map (fun (z : GaussianInt) => z + + (↑w : GaussianInt)) p1) + ) := by + classical + intro L k D a b p0 p1 p2 rowPath path aNeNegB w + have hn : w - b ≠ w + a := by + intro hh + apply aNeNegB + have h' : w + (-b) = w + a := by simpa [sub_eq_add_neg] using hh + exact (add_left_cancel h').symm + simp only [path, D.faces.symm_apply_apply, ite_eq_right hn, + rowPath] + simp + +private theorem row1CanonicalBackward : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + (a ≠ -b) → (∀ (w : ↥L), path ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w - b))) + ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inl w)) = (List.map (fun (z : GaussianInt) + => z + (↑w : GaussianInt)) p1).reverse) + ) := by + classical + intro L k D a b p0 p1 p2 rowPath path aNeNegB w + have hn : w - b ≠ w + a := by + intro hh + apply aNeNegB + have h' : w + (-b) = w + a := by simpa [sub_eq_add_neg] using hh + exact (add_left_cancel h').symm + simp only [path, D.faces.symm_apply_apply, ite_eq_right hn, + rowPath] + simp + +private theorem row2CanonicalBackward : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + (a ≠ a - b) → ((-b ≠ a - b) → (∀ (w : ↥L), path ((D.faces : ↥L ⊕ ↥L → D.plane.Face) + (Sum.inr (w + a - b))) ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inl w)) = (List.map + (fun (z : GaussianInt) => z + (↑w : GaussianInt)) p2).reverse)) + ) := by + classical + intro L k D a b p0 p1 p2 rowPath path aNeAmB negBNeAmB w + have hn1 : w + a - b ≠ w + a := by + intro hh + apply aNeAmB + have h' : w + (a - b) = w + a := by + simpa [sub_eq_add_neg, add_assoc] using hh + exact (add_left_cancel h').symm + have hn2 : w + a - b ≠ w - b := by + intro hh + apply negBNeAmB + have h' : w + (a - b) = w + (-b) := by + simpa [sub_eq_add_neg, add_assoc] using hh + exact (add_left_cancel h').symm + have ht : w + a - b = w + (a - b) := by abel + simp only [path, D.faces.symm_apply_apply, ite_eq_right hn1, ite_eq_right hn2, + ite_eq_left ht, rowPath] + simp + +private theorem walkClaims : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (fc : D.plane.Face), ∀ (gc : D.plane.Face), ∀ (P + : List GaussianInt), P4733T1ContainedWalk A B (rho fc) (rho gc) P → path fc gc = P + → path gc fc = P.reverse → ∀ (f : D.plane.Face), ∀ (g : D.plane.Face), f = fc ∧ g = + gc ∨ f = gc ∧ g = fc → (path f g).head? = some (rho f) ∧ (path f g).getLast? = some + (rho g) ∧ (∀ z ∈ path f g, z ∈ FootprintVertices A ∩ FootprintVertices B) ∧ ∀ (x : + GaussianInt), ∀ (y : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List + GaussianInt), path f g = l₁ ++ x :: y :: l₂ → {x, y} ∈ FootprintEdges A ∩ + FootprintEdges B + ) := by + classical + intro L k D a b ru rd rho p0 p1 p2 rowPath path A B fc gc P hw hforward hbackward f g hpair + rcases hpair with ⟨hf, hg⟩ | ⟨hf, hg⟩ + · simpa [P4733T1ContainedWalk, hf, hg, hforward] using hw + · have hr := (P4733T1WalkTransport A B (rho fc) (rho gc) P hw).1 + simpa [P4733T1ContainedWalk, hf, hg, hbackward] using hr + +private theorem commonEdgeForAdjacent : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let a : L := k (1, 0) + let b : L := k (0, 1) + (∀ (x : L), ∀ (y : L), (D.plane.adjacent x y) → (y = x + a ∨ x = y + a ∨ y = x + b ∨ x = + y + b ∨ y = x + (a + b) ∨ x = y + (a + b))) → (∀ (e0 : Finset GaussianInt), ∀ (e1 : + Finset GaussianInt), ∀ (e2 : Finset GaussianInt), (∀ (w : L), e0.image + (GaussianTranslation (w : GaussianInt)) ∈ FootprintEdges (TileTranslation T (w : + GaussianInt)) ∩ FootprintEdges (TileTranslation T ((w + a : L) : GaussianInt))) → ((∀ + (w : L), e1.image (GaussianTranslation (w : GaussianInt)) ∈ FootprintEdges + (TileTranslation T (w : GaussianInt)) ∩ FootprintEdges (TileTranslation T ((w - b : + L) : GaussianInt))) → ((∀ (w : L), e2.image (GaussianTranslation (w : GaussianInt)) ∈ + FootprintEdges (TileTranslation T ((w + a : L) : GaussianInt)) ∩ FootprintEdges + (TileTranslation T ((w - b : L) : GaussianInt))) → (∀ (x : ↥L), ∀ (y : ↥L), + D.plane.adjacent x y → (FootprintEdges (TileTranslation T (↑x : GaussianInt)) ∩ + FootprintEdges (TileTranslation T (↑y : GaussianInt))).Nonempty)))) + ) := by + classical + intro L k D T a b edgeDiff e0 e1 e2 rowEdge0 rowEdge1 rowEdge2 x y hxy + rcases edgeDiff x y hxy with h | h | h | h | h | h + · refine ⟨e0.image (GaussianTranslation (x : GaussianInt)), ?_⟩ + simpa [h] using rowEdge0 x + · have he := rowEdge0 y + rw [Set.inter_comm] at he + refine ⟨e0.image (GaussianTranslation (y : GaussianInt)), ?_⟩ + simpa [h] using he + · have he := rowEdge1 y + rw [Set.inter_comm] at he + refine ⟨e1.image (GaussianTranslation (y : GaussianInt)), ?_⟩ + simpa [h, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using he + · refine ⟨e1.image (GaussianTranslation (x : GaussianInt)), ?_⟩ + simpa [h, sub_eq_add_neg, add_assoc] using rowEdge1 x + · have he := rowEdge2 (x + b) + rw [Set.inter_comm] at he + refine ⟨e2.image (GaussianTranslation ((x + b : L) : GaussianInt)), ?_⟩ + have hx : x + b - b = x := by abel + have hy : x + b + a = y := by rw [h]; abel + simpa [hx, hy] using he + · refine ⟨e2.image (GaussianTranslation ((y + b : L) : GaussianInt)), ?_⟩ + have hy : y + b - b = y := by abel + have hx : y + b + a = x := by rw [h]; abel + simpa [hy, hx] using rowEdge2 (y + b) + +private theorem hcAt922 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), ∀ (x : ↥L), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + (↥L) → ( + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (fc : D.plane.Face), ∀ (gc : D.plane.Face), ∀ (P + : List GaussianInt), (P4733T1ContainedWalk A B (rho fc) (rho gc) P) → ((path fc gc + = P) → ((path gc fc = P.reverse) → (∀ (f : D.plane.Face), ∀ (g : D.plane.Face), ((f = + fc ∧ g = gc) ∨ (f = gc ∧ g = fc)) → ((path f g).head? = some (rho f) ∧ (path f + g).getLast? = some (rho g) ∧ (∀ z ∈ path f g, z ∈ FootprintVertices A ∩ + FootprintVertices B) ∧ ∀ x y : GaussianInt, ∀ l₁ l₂ : List GaussianInt, path f g = l₁ + ++ x :: y :: l₂ → {x, y} ∈ FootprintEdges A ∩ FootprintEdges B))))) → (∀ (f : + D.plane.Face), ∀ (g : D.plane.Face), + let w := x + let fc := D.faces (.inl w) + let gc := D.faces (.inr (w - b)) + (f = fc ∧ g = gc ∨ f = gc ∧ g = fc) → ((path fc gc = p1.map (fun z => z + (w : + GaussianInt))) → ((path gc fc = (p1.map (fun z => z + (w : GaussianInt))).reverse) → + ((P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) (TileTranslation T ((w + - b : L) : GaussianInt)) (rho fc) (rho gc) (p1.map (fun z => z + (w : GaussianInt)))) + → ((path f g).head? = some (rho f) ∧ (path f g).getLast? = some (rho g) ∧ (∀ z ∈ path + f g, z ∈ FootprintVertices (TileTranslation T ↑w) ∩ FootprintVertices + (TileTranslation T ↑(w - b))) ∧ ∀ x' y' : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + path f g = l₁ ++ x' :: y' :: l₂ → {x', y'} ∈ FootprintEdges (TileTranslation T ↑w) ∩ + FootprintEdges (TileTranslation T ↑(w - b))))))))) := by + classical + intro L k D T a b ru rd x rho p0 p1 p2 rowPath y path walkClaims f g w fc gc hpair hforward + hbackward hw + exact walkClaims (TileTranslation T (w : GaussianInt)) + (TileTranslation T ((w - b : L) : GaussianInt)) fc gc + (p1.map (fun z => z + (w : GaussianInt))) hw hforward hbackward f g hpair + +private theorem hdAt961 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (x : ↥L), ∀ (y : ↥L), + let w := x + b + let gc := D.faces (.inr (w + a - b)) + (w - b = x) → ((w + a = y) → ((∃ i, D.plane.faceVertex gc i = x) ∧ ∃ i, + D.plane.faceVertex gc i = y)) + ) := by + classical + intro L k D a b x y w gc hwx hwy + have h1 : w + a - b - a = x := by + calc + w + a - b - a = w - b := by abel + _ = x := hwx + have h2 : w + a - b + b = y := by + calc + w + a - b + b = w + a := sub_add_cancel _ _ + _ = y := hwy + constructor + · refine ⟨1, ?_⟩ + change D.plane.faceVertex (D.faces (.inr (w + a - b))) 1 = x + exact (D.down_vertices (w + a - b)).2.1.trans h1 + · refine ⟨2, ?_⟩ + change D.plane.faceVertex (D.faces (.inr (w + a - b))) 2 = y + exact (D.down_vertices (w + a - b)).2.2.trans h2 + +private theorem hdAt1029 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (x : ↥L), ∀ (y : ↥L), + let w := y + b + let gc := D.faces (.inr (w + a - b)) + (w - b = y) → ((w + a = x) → ((∃ i, D.plane.faceVertex gc i = y) ∧ ∃ i, + D.plane.faceVertex gc i = x)) + ) := by + classical + intro L k D a b x y w gc hwy hwx + have h1 : w + a - b - a = y := by + calc + w + a - b - a = w - b := by abel + _ = y := hwy + have h2 : w + a - b + b = x := + (by + calc + w + a - b + b = w + a := sub_add_cancel _ _ + _ = x := hwx) + constructor + · refine ⟨1, ?_⟩ + change D.plane.faceVertex (D.faces (.inr (w + a - b))) 1 = y + exact (D.down_vertices (w + a - b)).2.1.trans h1 + · refine ⟨2, ?_⟩ + change D.plane.faceVertex (D.faces (.inr (w + a - b))) 2 = x + exact (D.down_vertices (w + a - b)).2.2.trans h2 + +end RegularFaceWalkProof + +namespace RegularFaceDetails + +private theorem translateBoundary : + (by + classical + exact + ∀ (W : ProtoTile), ∀ (z : GaussianInt), ∀ (v : GaussianInt), z ∈ + BoundaryFootprintVertices W → z + v ∈ BoundaryFootprintVertices (TileTranslation W v) + ) := by + classical + intro W z v hz + rw [(TileTranslationFormulas W v).2.2.2.2.2.2.2.1] + exact ⟨z, hz, by simp [GaussianTranslation] + ⟩ + +private theorem k11 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), + let a : L := k (1, 0) + let b : L := k (0, 1) + k (1, 1) = a + b ) := by + classical + intro L k a b + have h : ((1, 1) : Int × Int) = ((1, 0) : Int × Int) + (0, 1) := by + ext <;> norm_num + rw [h, map_add] + +private theorem kneg11 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), + let a : L := k (1, 0) + let b : L := k (0, 1) + (k (1, 1) = a + b) → (k (-1, -1) = -(a + b)) ) := by + classical + intro L k a b k11 + have h : ((-1, -1) : Int × Int) = -((1, 1) : Int × Int) := by + ext <;> norm_num + rw [h, map_neg, k11] + +private theorem kneg10 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), + let a : L := k (1, 0) + k (-1, 0) = -a ) := by + classical + intro L k a + have h : ((-1, 0) : Int × Int) = -((1, 0) : Int × Int) := by + ext <;> norm_num + rw [h, map_neg] + +private theorem kneg01 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), + let b : L := k (0, 1) + k (0, -1) = -b ) := by + classical + intro L k b + have h : ((0, -1) : Int × Int) = -((0, 1) : Int × Int) := by + ext <;> norm_num + rw [h, map_neg] + +private theorem touchSymm : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), TileTouching A B → TileTouching B A ) := by + classical + intro A B h + rcases h with h | h | h + · rcases h with ⟨hA, hB, hdisj, hp⟩ + exact Or.inl ⟨hB, hA, disjoint_comm.mp hdisj, + by simpa [Set.inter_comm] using hp⟩ + · exact Or.inr (Or.inr ⟨h.1, h.2⟩) + · exact Or.inr (Or.inl ⟨h.1, h.2⟩) + +private theorem dmb0 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + (∀ (q : Sum L L), ∀ (i : Fin 3), rho (D.faces q) ∈ FootprintVertices (TileTranslation T + (D.plane.faceVertex (D.faces q) i : GaussianInt))) → ((∀ (W : ProtoTile), + TileTranslation W 0 = W) → ( + let fDmb := D.faces (.inr (-b)) + rho fDmb ∈ FootprintVertices T)) ) := by + classical + intro L k D T b ru rd rho rho_mem transZero fDmb + simpa [fDmb, b, D.down_vertices, transZero, add_assoc, add_comm, add_left_comm] using + rho_mem (.inr (-b)) 2 + +private theorem damB_mb : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + (∀ (q : Sum L L), ∀ (i : Fin 3), rho (D.faces q) ∈ FootprintVertices (TileTranslation T + (D.plane.faceVertex (D.faces q) i : GaussianInt))) → ( + let fDamB := D.faces (.inr (a - b)) + rho fDamB ∈ FootprintVertices (TileTranslation T (-(b : GaussianInt)))) ) := by + classical + intro L k D T a b ru rd rho rho_mem fDamB + have heq : (a - b - a : L) = -b := by abel + simpa [fDamB, a, b, D.down_vertices, heq] using rho_mem (.inr (a - b)) 1 + +private theorem shiftEq : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (u : ↥L), ∀ (x : ↥L), ∀ (y : ↥L), ∀ (d : ↥L), u + y = + u + x + d ↔ y = x + d ) := by + classical + intro L u x y d + rw [add_assoc] + exact add_left_cancel_iff + +private theorem mapTranslate : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (p : List GaussianInt), ∀ (x : ↥L), ∀ (u : ↥L), + List.map (fun (z : GaussianInt) => z + (↑(u + x) : GaussianInt)) p = List.map (fun (z + : GaussianInt) => z + (↑u : GaussianInt)) (List.map (fun (z : GaussianInt) => z + (↑x + : GaussianInt)) p) ) := by + classical + intro L p x u + simp only [List.map_map, Function.comp_def] + congr 1 + funext z + simp only [AddSubgroup.coe_add] + abel + +private theorem transNonempty : + (by + classical + exact + ∀ (T : ProtoTile), (Finset.Nonempty T.cells) → (∀ (v : GaussianInt), Finset.Nonempty + (TileTranslation T v).cells) ) := by + classical + intro T hne v + rcases hne with ⟨c, hc⟩ + change (T.cells.image (GaussianTranslation v)).Nonempty + refine ⟨GaussianTranslation v c, ?_⟩ + exact Finset.mem_image.mpr ⟨c, hc, rfl⟩ + +private theorem footprintEdgeTranslate : + (by + classical + exact + ∀ (V : ProtoTile), ∀ (v : GaussianInt), ∀ e ∈ FootprintEdges V, Finset.image + (GaussianTranslation v) e ∈ FootprintEdges (TileTranslation V v) ) := by + classical + intro V v e he + rw [(TileTranslationFormulas V v).2.2.2.2.2.2.1] + exact ⟨e, he, by simp⟩ + +private theorem tileAdd : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (T : ProtoTile), (∀ (W : ProtoTile), ∀ (v : + GaussianInt), ∀ (w : GaussianInt), TileTranslation (TileTranslation W v) w = + TileTranslation W (v + w)) → (∀ (v : ↥L), ∀ (w : ↥L), TileTranslation + (TileTranslation T (↑v : GaussianInt)) (↑w : GaussianInt) = TileTranslation T (↑(v + + w) : GaussianInt)) ) := by + classical + intro L T translateComp v w + rw [translateComp] + simp only [AddSubgroup.coe_add] + +private theorem rowEdge0 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (T : ProtoTile), + let a : L := k (1, 0) + ∀ (e0 : Finset GaussianInt), (e0 ∈ FootprintEdges T ∩ FootprintEdges (TileTranslation T + (↑a : GaussianInt))) → ((∀ (V : ProtoTile), ∀ (v : GaussianInt), ∀ (e : Finset + GaussianInt), (e ∈ FootprintEdges V) → (e.image (GaussianTranslation v) ∈ + FootprintEdges (TileTranslation V v))) → ((∀ (v : L), ∀ (w : L), TileTranslation + (TileTranslation T (v : GaussianInt)) (w : GaussianInt) = TileTranslation T ((v + w : + L) : GaussianInt)) → (∀ (w : ↥L), Finset.image (GaussianTranslation (↑w : + GaussianInt)) e0 ∈ FootprintEdges (TileTranslation T (↑w : GaussianInt)) ∩ + FootprintEdges (TileTranslation T (↑(w + a) : GaussianInt))))) ) := by + classical + intro L k T a e0 he0 footprintEdgeTranslate tileAdd w + refine ⟨footprintEdgeTranslate T (w : GaussianInt) e0 he0.1, ?_⟩ + simpa [tileAdd, add_comm] using + footprintEdgeTranslate (TileTranslation T (a : GaussianInt)) + (w : GaussianInt) e0 he0.2 + +private theorem rowEdge1 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (T : ProtoTile), + let b : L := k (0, 1) + (∀ (W : ProtoTile), ∀ (v : GaussianInt), ∀ (w : GaussianInt), TileTranslation + (TileTranslation W v) w = TileTranslation W (v + w)) → (∀ (e1 : Finset GaussianInt), + (e1 ∈ FootprintEdges T ∩ FootprintEdges (TileTranslation T (-(↑b : GaussianInt)))) → + ((∀ (V : ProtoTile), ∀ (v : GaussianInt), ∀ (e : Finset GaussianInt), (e ∈ + FootprintEdges V) → (e.image (GaussianTranslation v) ∈ FootprintEdges + (TileTranslation V v))) → (∀ (w : ↥L), Finset.image (GaussianTranslation (↑w : + GaussianInt)) e1 ∈ FootprintEdges (TileTranslation T (↑w : GaussianInt)) ∩ + FootprintEdges (TileTranslation T (↑(w - b) : GaussianInt))))) ) := by + classical + intro L k T b translateComp e1 he1 footprintEdgeTranslate w + refine ⟨footprintEdgeTranslate T (w : GaussianInt) e1 he1.1, ?_⟩ + simpa [translateComp, AddSubgroup.coe_neg, AddSubgroup.coe_sub, + sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using + footprintEdgeTranslate (TileTranslation T (-(b : GaussianInt))) + (w : GaussianInt) e1 he1.2 + +private theorem rhoUpShift : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + let fU := D.faces (.inl (0 : L)) + ∀ (w : ↥L), rho ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inl w)) = rho fU + (↑w : + GaussianInt) ) := by + classical + intro L k D ru rd rho fU w + simp [rho, fU, D.faces.symm_apply_apply] + +private theorem rhoDown0Shift : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + ∀ (w : ↥L), rho ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w + a))) = rho ((D.faces : + ↥L ⊕ ↥L → D.plane.Face) (Sum.inr a)) + (↑w : GaussianInt) ) := by + classical + intro L k D a ru rd rho w + simp [rho, D.faces.symm_apply_apply, AddSubgroup.coe_add, add_comm, add_left_comm] + +private theorem rhoDown1Shift : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + ∀ (w : ↥L), rho ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w - b))) = rho ((D.faces : + ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (-b))) + (↑w : GaussianInt) ) := by + classical + intro L k D b ru rd rho w + simp [rho, D.faces.symm_apply_apply, + sub_eq_add_neg, add_comm, add_left_comm] + +private theorem rhoDown2Shift : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + ∀ (w : ↥L), rho ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w + a - b))) = rho + ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (a - b))) + (↑w : GaussianInt) ) := by + classical + intro L k D a b ru rd rho w + simp [rho, D.faces.symm_apply_apply, AddSubgroup.coe_add, + sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + +private theorem faceTagsNe : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (x : ↥L), ∀ (y : ↥L), (D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inl x) ≠ + (D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr y) ) := by + classical + intro L k D x y h + have hh := D.faces.injective h + cases hh + +private theorem aNeNegB : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), + let a : L := k (1, 0) + let b : L := k (0, 1) + a ≠ -b ) := by + classical + intro L k a b h + have hcoord := congrArg k.symm h + norm_num [a, b] at hcoord + +private theorem aNeAmB : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), + let a : L := k (1, 0) + let b : L := k (0, 1) + a ≠ a - b ) := by + classical + intro L k a b h + have hcoord := congrArg k.symm h + norm_num [a, b] at hcoord + +private theorem negBNeAmB : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), + let a : L := k (1, 0) + let b : L := k (0, 1); + -b ≠ a - b ) := by + classical + intro L k a b h + have hcoord := congrArg k.symm h + norm_num [a, b] at hcoord + +private theorem row0CanonicalForward : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + ∀ (w : ↥L), path ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inl w)) ((D.faces : ↥L ⊕ ↥L → + D.plane.Face) (Sum.inr (w + a))) = List.map (fun (z : GaussianInt) => z + (↑w : + GaussianInt)) p0 ) := by + classical + intro L k D a b p0 p1 p2 rowPath path w + simp [path, rowPath, D.faces.symm_apply_apply] + +private theorem row0CanonicalBackward : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + ∀ (w : ↥L), path ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w + a))) ((D.faces : ↥L ⊕ + ↥L → D.plane.Face) (Sum.inl w)) = (List.map (fun (z : GaussianInt) => z + (↑w : + GaussianInt)) p0).reverse ) := by + classical + intro L k D a b p0 p1 p2 rowPath path w + simp [path, rowPath, D.faces.symm_apply_apply] + +private theorem transportContainedWalk : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (A' : ProtoTile), ∀ (B' : ProtoTile), ∀ (s : + GaussianInt), ∀ (t : GaussianInt), ∀ (P : List GaussianInt), A = A' → B = B' → + P4733T1ContainedWalk A B s t P → P4733T1ContainedWalk A' B' s t P ) := by + classical + intro A B A' B' s t P hA hB hw + rw [← hA, ← hB] + exact hw + +private theorem hs1At1481 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), + let b : L := k (0, 1) + (∀ (u : L), ∀ (x : L), ∀ (y : L), ∀ (d : L), (u + y = u + x + d) ↔ y = x + d) → (∀ (u : + ↥L), ∀ (x : ↥L), ∀ (y : ↥L), (u + y = u + x - b) ↔ y = x - b) ) := by + classical + intro L k b shiftEq u x y + have := shiftEq u x y (-b) + simpa [sub_eq_add_neg] using this + +private theorem hs1At1495 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), + let b : L := k (0, 1) + (∀ (u : L), ∀ (x : L), ∀ (y : L), ∀ (d : L), (u + y = u + x + d) ↔ y = x + d) → (∀ (u : + ↥L), ∀ (x : ↥L), ∀ (y : ↥L), (u + x = u + y - b) ↔ x = y - b) ) := by + classical + intro L k b shiftEq u x y + have := shiftEq u y x (-b) + simpa [sub_eq_add_neg] using this + +private theorem hwAt1515 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let a : L := k (1, 0) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), ∀ (x : ↥L), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + ∀ (p0 : List GaussianInt), (∀ (w : L), P4733T1ContainedWalk (TileTranslation T (w : + GaussianInt)) (TileTranslation T ((w + a : L) : GaussianInt)) (rho (D.faces (.inl + w))) (rho (D.faces (.inr (w + a)))) (p0.map (fun z => z + (w : GaussianInt)))) → (∀ + (y : ↥L), (y = x + a) → ( + let fc := D.faces (.inl x) + let gc := D.faces (.inr (x + a)) + P4733T1ContainedWalk (TileTranslation T (x : GaussianInt)) (TileTranslation T (y : + GaussianInt)) (rho fc) (rho gc) (p0.map (fun z => z + (x : GaussianInt))))) ) := by + classical + intro L k D T a ru rd x rho p0 rowWalk0 y h fc gc + simpa [h] using rowWalk0 x + +private theorem hcAt1607 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (x : ↥L), ∀ (y : ↥L), + let w := x + b + let fc := D.faces (.inl w) + (w - b = x) → ((w + a = y) → ((∃ i, D.plane.faceVertex fc i = x) ∧ ∃ i, + D.plane.faceVertex fc i = y)) ) := by + classical + intro L k D a b x y w fc hwx hwy + constructor + · refine ⟨2, ?_⟩ + change D.plane.faceVertex (D.faces (.inl w)) 2 = x + exact (D.up_vertices w).2.2.trans hwx + · refine ⟨1, ?_⟩ + change D.plane.faceVertex (D.faces (.inl w)) 1 = y + exact (D.up_vertices w).2.1.trans hwy + +private theorem hwxAt1656 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (x : ↥L), ∀ (y : ↥L), (x = y + (a + b)) → ( + let w := y + b + w + a = x) ) := by + classical + intro L k a b x y h w + calc + w + a = y + b + a := by rfl + _ = y + (a + b) := by abel + _ = x := h.symm + +private theorem hcAt1662 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (x : ↥L), ∀ (y : ↥L), + let w := y + b + let fc := D.faces (.inl w) + (w - b = y) → ((w + a = x) → ((∃ i, D.plane.faceVertex fc i = y) ∧ ∃ i, + D.plane.faceVertex fc i = x)) ) := by + classical + intro L k D a b x y w fc hwy hwx + constructor + · refine ⟨2, ?_⟩ + change D.plane.faceVertex (D.faces (.inl w)) 2 = y + exact (D.up_vertices w).2.2.trans hwy + · refine ⟨1, ?_⟩ + change D.plane.faceVertex (D.faces (.inl w)) 1 = x + exact (D.up_vertices w).2.1.trans hwx + +private theorem hwAt1679 : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), (↥L) → ( + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + ∀ (p2 : List GaussianInt), (∀ (w : L), P4733T1ContainedWalk (TileTranslation T ((w + a + : L) : GaussianInt)) (TileTranslation T ((w - b : L) : GaussianInt)) (rho (D.faces + (.inl w))) (rho (D.faces (.inr (w + a - b)))) (p2.map (fun z => z + (w : + GaussianInt)))) → (∀ (y : ↥L), + let w := y + b + let fc := D.faces (.inl w) + let gc := D.faces (.inr (w + a - b)) + P4733T1ContainedWalk (TileTranslation T ((w + a : L) : GaussianInt)) (TileTranslation T + ((w - b : L) : GaussianInt)) (rho fc) (rho gc) (p2.map (fun z => z + (w : + GaussianInt)))))) := by + classical + intro L k D T a b ru rd x rho p2 rowWalk2 y w fc gc + exact rowWalk2 w + +end RegularFaceDetails + +namespace RegularFaceProperties + +private theorem rhoPeriodic : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + let fs := fun (u : L) (f : D.plane.Face) => + D.faces (Sum.map (u + ·) (u + ·) (D.faces.symm f)) + ∀ u, ∀ f, rho (fs u f) = rho f + (u : GaussianInt) ) := by + classical + intro L k D ru rd rho fs + dsimp [fs] + intro u f + cases hq : D.faces.symm f with + | inl x => + rw [← D.faces.apply_symm_apply f, hq] + simp only [D.faces.symm_apply_apply, rho] + change ru + ((u + x : L) : GaussianInt) = + (ru + (x : GaussianInt)) + (u : GaussianInt) + simp only [AddSubgroup.coe_add] + abel + | inr x => + rw [← D.faces.apply_symm_apply f, hq] + simp only [D.faces.symm_apply_apply, rho] + change rd + ((u + x : L) : GaussianInt) = + (rd + (x : GaussianInt)) + (u : GaussianInt) + simp only [AddSubgroup.coe_add] + abel + +private theorem pathReverse : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + ∀ f, ∀ g, path g f = (path f g).reverse ) := by + classical + intro L k D a b p0 p1 p2 rowPath path f g + cases hf : D.faces.symm f with + | inl x => + cases hg : D.faces.symm g with + | inl y => simp [path, hf, hg] + | inr y => + simp only [path, hf, hg] + split_ifs <;> simp + | inr x => + cases hg : D.faces.symm g with + | inl y => + simp only [path, hf, hg] + split_ifs <;> simp + | inr y => simp [path, hf, hg] + +private theorem pathPeriodic : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + (∀ (u : L), ∀ (x : L), ∀ (y : L), ∀ (d : L), (u + y = u + x + d) ↔ y = x + d) → ((∀ (p : + List GaussianInt), ∀ (x : L), ∀ (u : L), p.map (fun z => z + ((u + x : L) : + GaussianInt)) = (p.map (fun z => z + (x : GaussianInt))).map (fun z => z + (u : + GaussianInt))) → ((∀ (p : List GaussianInt), ∀ (x : L), ∀ (u : L), ((p.map (fun z => + z + ((u + x : L) : GaussianInt))).reverse) = (((p.map (fun z => z + (x : + GaussianInt))).reverse).map (fun z => z + (u : GaussianInt)))) → ((∀ (u : L), ∀ (P0 : + Prop), ∀ (P1 : Prop), ∀ (P2 : Prop), ∀ (Q0 : Prop), ∀ (Q1 : Prop), ∀ (Q2 : Prop), (P0 + ↔ Q0) → ((P1 ↔ Q1) → ((P2 ↔ Q2) → (∀ (A0 : List GaussianInt), ∀ (A1 : List + GaussianInt), ∀ (A2 : List GaussianInt), ∀ (B0 : List GaussianInt), ∀ (B1 : List + GaussianInt), ∀ (B2 : List GaussianInt), (A0 = B0.map (fun z => z + (u : + GaussianInt))) → ((A1 = B1.map (fun z => z + (u : GaussianInt))) → ((A2 = B2.map (fun + z => z + (u : GaussianInt))) → ((if P0 then A0 else if P1 then A1 else if P2 then A2 + else []) = (if Q0 then B0 else if Q1 then B1 else if Q2 then B2 else []).map (fun z + => z + (u : GaussianInt))))))))) → ( + let fs := fun (u : L) (f : D.plane.Face) => + D.faces (Sum.map (u + ·) (u + ·) (D.faces.symm f)) + ∀ u, ∀ f, ∀ g, path (fs u f) (fs u g) = (path f g).map (fun z => z + (u : + GaussianInt)))))) ) := by + classical + intro L k D a b p0 p1 p2 rowPath path shiftEq mapTranslate mapTranslateRev ifMap3 fs + dsimp [fs] + intro u f g + cases hf : D.faces.symm f with + | inl x => + cases hg : D.faces.symm g with + | inl y => simp [path, hf, hg, D.faces.symm_apply_apply] + | inr y => + simp only [path, hf, hg, D.faces.symm_apply_apply, + Sum.map_inl, Sum.map_inr] + have hs0 := shiftEq u x y a + have hs1 : (u + y = u + x - b) ↔ y = x - b := RegularFaceDetails.hs1At1481 L k + shiftEq u x y + have hs2 : (u + y = u + x + (a - b)) ↔ y = x + (a - b) := + shiftEq u x y (a - b) + exact ifMap3 u _ _ _ _ _ _ hs0 hs1 hs2 _ _ _ _ _ _ + (mapTranslate (rowPath 0) x u) (mapTranslate (rowPath 1) x u) + (mapTranslate (rowPath 2) x u) + | inr x => + cases hg : D.faces.symm g with + | inl y => + simp only [path, hf, hg, D.faces.symm_apply_apply, + Sum.map_inl, Sum.map_inr] + have hs0 := shiftEq u y x a + have hs1 : (u + x = u + y - b) ↔ x = y - b := RegularFaceDetails.hs1At1495 L k + shiftEq u x y + have hs2 : (u + x = u + y + (a - b)) ↔ x = y + (a - b) := + shiftEq u y x (a - b) + exact ifMap3 u _ _ _ _ _ _ hs0 hs1 hs2 _ _ _ _ _ _ + (mapTranslateRev (rowPath 0) y u) (mapTranslateRev (rowPath 1) y u) + (mapTranslateRev (rowPath 2) y u) + | inr y => simp [path, hf, hg, D.faces.symm_apply_apply] + +private theorem firstForward : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), ∀ (x : ↥L), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + (∀ (x : L), ∀ (y : L), (D.plane.adjacent x y) → (∀ (f : D.plane.Face), ∀ (g : + D.plane.Face), ∀ (c : D.plane.Face), ∀ (d : D.plane.Face), (f ≠ g) → ((c ≠ d) → + (((∃ i, D.plane.faceVertex f i = x) ∧ (∃ i, D.plane.faceVertex f i = y)) → (((∃ i, + D.plane.faceVertex g i = x) ∧ (∃ i, D.plane.faceVertex g i = y)) → (((∃ i, + D.plane.faceVertex c i = x) ∧ (∃ i, D.plane.faceVertex c i = y)) → (((∃ i, + D.plane.faceVertex d i = x) ∧ (∃ i, D.plane.faceVertex d i = y)) → ((f = c ∧ g = d) ∨ + (f = d ∧ g = c))))))))) → (∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ + (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + ∀ (y : ↥L), + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + (∀ (w : L), P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) (TileTranslation + T ((w + a : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho (D.faces (.inr (w + + a)))) (p0.map (fun z => z + (w : GaussianInt)))) → ((∀ (x : L), ∀ (y : L), D.faces + (.inl x) ≠ D.faces (.inr y)) → ((∀ (w : L), ((∃ i, D.plane.faceVertex (D.faces (.inl + w)) i = w) ∧ ∃ i, D.plane.faceVertex (D.faces (.inl w)) i = w + a) ∧ ((∃ i, + D.plane.faceVertex (D.faces (.inr (w + a))) i = w) ∧ ∃ i, D.plane.faceVertex (D.faces + (.inr (w + a))) i = w + a)) → ((∀ (w : L), path (D.faces (.inl w)) (D.faces (.inr (w + + a))) = (p0.map (fun z => z + (w : GaussianInt)))) → ((∀ (w : L), path (D.faces + (.inr (w + a))) (D.faces (.inl w)) = (p0.map (fun z => z + (w : + GaussianInt))).reverse) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (fc : + D.plane.Face), ∀ (gc : D.plane.Face), ∀ (P : List GaussianInt), + (P4733T1ContainedWalk A B (rho fc) (rho gc) P) → ((path fc gc = P) → ((path gc + fc = + P.reverse) → (∀ (f : D.plane.Face), ∀ (g : D.plane.Face), ((f = fc ∧ g = gc) ∨ (f = + gc ∧ g = fc)) → ((path f g).head? = some (rho f) ∧ (path f g).getLast? = some (rho g) + ∧ (∀ z ∈ path f g, z ∈ FootprintVertices A ∩ FootprintVertices B) ∧ ∀ x y : + GaussianInt, ∀ l₁ l₂ : List GaussianInt, path f g = l₁ ++ x :: y :: l₂ → {x, y} ∈ + FootprintEdges A ∩ FootprintEdges B))))) → ((D.plane.adjacent x y) → (∀ (f : + D.plane.Face), ∀ (g : D.plane.Face), (f ≠ g) → ((∃ (i : Fin (3 : ℕ)), + D.plane.faceVertex f i = x) → ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex f i = y) → + ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex g i = x) → ((∃ (i : Fin (3 : ℕ)), + D.plane.faceVertex g i = y) → (y = x + a → P4733T1ContainedWalk (TileTranslation T + (↑x : GaussianInt)) (TileTranslation T (↑y : GaussianInt)) (rho f) (rho g) (path f + g))))))))))))))) := by + classical + intro L k D T a b ru rd x rho uniquePair p0 p1 p2 rowPath y path rowWalk0 faceTagsNe row0Inc + row0CanonicalForward row0CanonicalBackward walkClaims hxy f g hfg hfa hfb hga hgb h + let fc := D.faces (.inl x) + let gc := D.faces (.inr (x + a)) + have hpair := uniquePair x y hxy f g fc gc hfg (faceTagsNe x (x + a)) + ⟨hfa, hfb⟩ ⟨hga, hgb⟩ (by simpa [h] using (row0Inc x).1) (by simpa [h] using + (row0Inc x).2) + have hforward : path fc gc = p0.map (fun z => z + (x : GaussianInt)) := by + simpa [fc, gc] using row0CanonicalForward x + have hbackward : path gc fc = (p0.map (fun z => z + (x : GaussianInt))).reverse := by + simpa [fc, gc] using row0CanonicalBackward x + have hw : P4733T1ContainedWalk (TileTranslation T (x : GaussianInt)) + (TileTranslation T (y : GaussianInt)) (rho fc) (rho gc) + (p0.map (fun z => z + (x : GaussianInt))) := RegularFaceDetails.hwAt1515 L k D T + ru rd x p0 rowWalk0 y h + exact walkClaims _ _ fc gc _ hw hforward hbackward f g hpair + +private theorem firstBackward : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), ∀ (x : ↥L), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + (∀ (x : L), ∀ (y : L), (D.plane.adjacent x y) → (∀ (f : D.plane.Face), ∀ (g : + D.plane.Face), ∀ (c : D.plane.Face), ∀ (d : D.plane.Face), (f ≠ g) → ((c ≠ d) → + (((∃ i, D.plane.faceVertex f i = x) ∧ (∃ i, D.plane.faceVertex f i = y)) → (((∃ i, + D.plane.faceVertex g i = x) ∧ (∃ i, D.plane.faceVertex g i = y)) → (((∃ i, + D.plane.faceVertex c i = x) ∧ (∃ i, D.plane.faceVertex c i = y)) → (((∃ i, + D.plane.faceVertex d i = x) ∧ (∃ i, D.plane.faceVertex d i = y)) → ((f = c ∧ g = d) ∨ + (f = d ∧ g = c))))))))) → (∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ + (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + ∀ (y : ↥L), + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + (∀ (w : L), P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) (TileTranslation + T ((w + a : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho (D.faces (.inr (w + + a)))) (p0.map (fun z => z + (w : GaussianInt)))) → ((∀ (x : L), ∀ (y : L), D.faces + (.inl x) ≠ D.faces (.inr y)) → ((∀ (w : L), ((∃ i, D.plane.faceVertex (D.faces (.inl + w)) i = w) ∧ ∃ i, D.plane.faceVertex (D.faces (.inl w)) i = w + a) ∧ ((∃ i, + D.plane.faceVertex (D.faces (.inr (w + a))) i = w) ∧ ∃ i, D.plane.faceVertex (D.faces + (.inr (w + a))) i = w + a)) → ((∀ (w : L), path (D.faces (.inl w)) (D.faces (.inr (w + + a))) = (p0.map (fun z => z + (w : GaussianInt)))) → ((∀ (w : L), path (D.faces + (.inr (w + a))) (D.faces (.inl w)) = (p0.map (fun z => z + (w : + GaussianInt))).reverse) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (fc : + D.plane.Face), ∀ (gc : D.plane.Face), ∀ (P : List GaussianInt), + (P4733T1ContainedWalk A B (rho fc) (rho gc) P) → ((path fc gc = P) → ((path gc + fc = + P.reverse) → (∀ (f : D.plane.Face), ∀ (g : D.plane.Face), ((f = fc ∧ g = gc) ∨ (f = + gc ∧ g = fc)) → ((path f g).head? = some (rho f) ∧ (path f g).getLast? = some (rho g) + ∧ (∀ z ∈ path f g, z ∈ FootprintVertices A ∩ FootprintVertices B) ∧ ∀ x y : + GaussianInt, ∀ l₁ l₂ : List GaussianInt, path f g = l₁ ++ x :: y :: l₂ → {x, y} ∈ + FootprintEdges A ∩ FootprintEdges B))))) → ((D.plane.adjacent x y) → (∀ (f : + D.plane.Face), ∀ (g : D.plane.Face), (f ≠ g) → ((∃ (i : Fin (3 : ℕ)), + D.plane.faceVertex f i = x) → ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex f i = y) → + ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex g i = x) → ((∃ (i : Fin (3 : ℕ)), + D.plane.faceVertex g i = y) → (x = y + a → P4733T1ContainedWalk (TileTranslation T + (↑x : GaussianInt)) (TileTranslation T (↑y : GaussianInt)) (rho f) (rho g) (path f + g))))))))))))))) := by + classical + intro L k D T a b ru rd x rho uniquePair p0 p1 p2 rowPath y path rowWalk0 faceTagsNe row0Inc + row0CanonicalForward row0CanonicalBackward walkClaims hxy f g hfg hfa hfb hga hgb h + let w := y + let fc := D.faces (.inl w) + let gc := D.faces (.inr (w + a)) + have hsym := (D.plane.adjacent_symmetric x y).mp hxy + have hpair := uniquePair y x hsym f g fc gc hfg (faceTagsNe w (w + a)) + ⟨hfb, hfa⟩ ⟨hgb, hga⟩ + (by simpa [fc, w, h] using (row0Inc w).1) + (by simpa [gc, w, h] using (row0Inc w).2) + have hforward : path fc gc = p0.map (fun z => z + (w : GaussianInt)) := by + simpa [fc, gc] using row0CanonicalForward w + have hbackward : path gc fc = (p0.map (fun z => z + (w : GaussianInt))).reverse := by + simpa [fc, gc] using row0CanonicalBackward w + have hw : P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) + (TileTranslation T ((w + a : L) : GaussianInt)) (rho fc) (rho gc) + (p0.map (fun z => z + (w : GaussianInt))) := rowWalk0 w + have hclaims := walkClaims _ _ fc gc _ hw hforward hbackward f g hpair + simpa [h, w, Set.inter_comm, P4733T1ContainedWalk] using hclaims + +private theorem secondForward : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), ∀ (x : ↥L), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + (∀ (x : L), ∀ (y : L), (D.plane.adjacent x y) → (∀ (f : D.plane.Face), ∀ (g : + D.plane.Face), ∀ (c : D.plane.Face), ∀ (d : D.plane.Face), (f ≠ g) → ((c ≠ d) → + (((∃ i, D.plane.faceVertex f i = x) ∧ (∃ i, D.plane.faceVertex f i = y)) → (((∃ i, + D.plane.faceVertex g i = x) ∧ (∃ i, D.plane.faceVertex g i = y)) → (((∃ i, + D.plane.faceVertex c i = x) ∧ (∃ i, D.plane.faceVertex c i = y)) → (((∃ i, + D.plane.faceVertex d i = x) ∧ (∃ i, D.plane.faceVertex d i = y)) → ((f = c ∧ g = d) ∨ + (f = d ∧ g = c))))))))) → (∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ + (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + ∀ (y : ↥L), + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + (∀ (w : L), P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) (TileTranslation + T ((w - b : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho (D.faces (.inr (w - + b)))) (p1.map (fun z => z + (w : GaussianInt)))) → ((∀ (x : L), ∀ (y : L), D.faces + (.inl x) ≠ D.faces (.inr y)) → ((∀ (w : L), ((∃ i, D.plane.faceVertex (D.faces (.inl + w)) i = w - b) ∧ ∃ i, D.plane.faceVertex (D.faces (.inl w)) i = w) ∧ ((∃ i, + D.plane.faceVertex (D.faces (.inr (w - b))) i = w - b) ∧ ∃ i, D.plane.faceVertex + (D.faces (.inr (w - b))) i = w)) → ((∀ (w : L), path (D.faces (.inl w)) (D.faces + (.inr (w - b))) = (p1.map (fun z => z + (w : GaussianInt)))) → ((∀ (w : L), path + (D.faces (.inr (w - b))) (D.faces (.inl w)) = (p1.map (fun z => z + (w : + GaussianInt))).reverse) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (fc : + D.plane.Face), ∀ (gc : D.plane.Face), ∀ (P : List GaussianInt), + (P4733T1ContainedWalk A B (rho fc) (rho gc) P) → ((path fc gc = P) → ((path gc + fc = + P.reverse) → (∀ (f : D.plane.Face), ∀ (g : D.plane.Face), ((f = fc ∧ g = gc) ∨ (f = + gc ∧ g = fc)) → ((path f g).head? = some (rho f) ∧ (path f g).getLast? = some (rho g) + ∧ (∀ z ∈ path f g, z ∈ FootprintVertices A ∩ FootprintVertices B) ∧ ∀ x y : + GaussianInt, ∀ l₁ l₂ : List GaussianInt, path f g = l₁ ++ x :: y :: l₂ → {x, y} ∈ + FootprintEdges A ∩ FootprintEdges B))))) → ((D.plane.adjacent x y) → (∀ (f : + D.plane.Face), ∀ (g : D.plane.Face), (f ≠ g) → ((∃ (i : Fin (3 : ℕ)), + D.plane.faceVertex f i = x) → ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex f i = y) → + ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex g i = x) → ((∃ (i : Fin (3 : ℕ)), + D.plane.faceVertex g i = y) → (y = x + b → P4733T1ContainedWalk (TileTranslation T + (↑x : GaussianInt)) (TileTranslation T (↑y : GaussianInt)) (rho f) (rho g) (path f + g))))))))))))))) := by + classical + intro L k D T a b ru rd x rho uniquePair p0 p1 p2 rowPath y path rowWalk1 faceTagsNe row1Inc + row1CanonicalForward row1CanonicalBackward walkClaims hxy f g hfg hfa hfb hga hgb h + let w := y + let fc := D.faces (.inl w) + let gc := D.faces (.inr (w - b)) + have hpair := uniquePair x y hxy f g fc gc hfg (faceTagsNe w (w - b)) + ⟨hfa, hfb⟩ ⟨hga, hgb⟩ + (by simpa [h, w, fc, gc, sub_eq_add_neg, add_assoc] using (row1Inc w).1) + (by simpa [h, w, fc, gc, sub_eq_add_neg, add_assoc] using (row1Inc w).2) + have hforward : path fc gc = p1.map (fun z => z + (w : GaussianInt)) := by + simpa [fc, gc] using row1CanonicalForward w + have hbackward : path gc fc = (p1.map (fun z => z + (w : GaussianInt))).reverse := by + simpa [fc, gc] using row1CanonicalBackward w + have hw : P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) + (TileTranslation T ((w - b : L) : GaussianInt)) (rho fc) (rho gc) + (p1.map (fun z => z + (w : GaussianInt))) := rowWalk1 w + have hwx : w - b = x := by dsimp [w]; rw [h]; abel + have hclaims := walkClaims _ _ fc gc _ hw hforward hbackward f g hpair + rcases hclaims with ⟨hh, hl, hv, he⟩ + refine ⟨hh, hl, ?_, ?_⟩ + · intro z hz + rcases hv z hz with ⟨hz1, hz2⟩ + exact ⟨by simpa [hwx, AddSubgroup.coe_sub] using hz2, + by simpa [w] using hz1⟩ + · intro x' y' l₁ l₂ hp + rcases he x' y' l₁ l₂ hp with ⟨he1, he2⟩ + exact ⟨by simpa [hwx, AddSubgroup.coe_sub] using he2, + by simpa [w] using he1⟩ + +private theorem secondBackward : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), ∀ (x : ↥L), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + (∀ (x : L), ∀ (y : L), (D.plane.adjacent x y) → (∀ (f : D.plane.Face), ∀ (g : + D.plane.Face), ∀ (c : D.plane.Face), ∀ (d : D.plane.Face), (f ≠ g) → ((c ≠ d) → + (((∃ i, D.plane.faceVertex f i = x) ∧ (∃ i, D.plane.faceVertex f i = y)) → (((∃ i, + D.plane.faceVertex g i = x) ∧ (∃ i, D.plane.faceVertex g i = y)) → (((∃ i, + D.plane.faceVertex c i = x) ∧ (∃ i, D.plane.faceVertex c i = y)) → (((∃ i, + D.plane.faceVertex d i = x) ∧ (∃ i, D.plane.faceVertex d i = y)) → ((f = c ∧ g = d) ∨ + (f = d ∧ g = c))))))))) → (∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ + (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + ∀ (y : ↥L), + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + (∀ (w : L), P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) (TileTranslation + T ((w - b : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho (D.faces (.inr (w - + b)))) (p1.map (fun z => z + (w : GaussianInt)))) → ((∀ (x : L), ∀ (y : L), D.faces + (.inl x) ≠ D.faces (.inr y)) → ((∀ (w : L), ((∃ i, D.plane.faceVertex (D.faces (.inl + w)) i = w - b) ∧ ∃ i, D.plane.faceVertex (D.faces (.inl w)) i = w) ∧ ((∃ i, + D.plane.faceVertex (D.faces (.inr (w - b))) i = w - b) ∧ ∃ i, D.plane.faceVertex + (D.faces (.inr (w - b))) i = w)) → ((∀ (w : L), path (D.faces (.inl w)) (D.faces + (.inr (w - b))) = (p1.map (fun z => z + (w : GaussianInt)))) → ((∀ (w : L), path + (D.faces (.inr (w - b))) (D.faces (.inl w)) = (p1.map (fun z => z + (w : + GaussianInt))).reverse) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (fc : + D.plane.Face), ∀ (gc : D.plane.Face), ∀ (P : List GaussianInt), + (P4733T1ContainedWalk A B (rho fc) (rho gc) P) → ((path fc gc = P) → ((path gc + fc = + P.reverse) → (∀ (f : D.plane.Face), ∀ (g : D.plane.Face), ((f = fc ∧ g = gc) ∨ (f = + gc ∧ g = fc)) → ((path f g).head? = some (rho f) ∧ (path f g).getLast? = some (rho g) + ∧ (∀ z ∈ path f g, z ∈ FootprintVertices A ∩ FootprintVertices B) ∧ ∀ x y : + GaussianInt, ∀ l₁ l₂ : List GaussianInt, path f g = l₁ ++ x :: y :: l₂ → {x, y} ∈ + FootprintEdges A ∩ FootprintEdges B))))) → ((D.plane.adjacent x y) → (∀ (f : + D.plane.Face), ∀ (g : D.plane.Face), (f ≠ g) → ((∃ (i : Fin (3 : ℕ)), + D.plane.faceVertex f i = x) → ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex f i = y) → + ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex g i = x) → ((∃ (i : Fin (3 : ℕ)), + D.plane.faceVertex g i = y) → (x = y + b → P4733T1ContainedWalk (TileTranslation T + (↑x : GaussianInt)) (TileTranslation T (↑y : GaussianInt)) (rho f) (rho g) (path f + g))))))))))))))) := by + classical + intro L k D T a b ru rd x rho uniquePair p0 p1 p2 rowPath y path rowWalk1 faceTagsNe row1Inc + row1CanonicalForward row1CanonicalBackward walkClaims hxy f g hfg hfa hfb hga hgb h + let w := x + let fc := D.faces (.inl w) + let gc := D.faces (.inr (w - b)) + have hsym := (D.plane.adjacent_symmetric x y).mp hxy + have hpair := uniquePair y x hsym f g fc gc hfg (faceTagsNe w (w - b)) + ⟨hfb, hfa⟩ ⟨hgb, hga⟩ + (by simpa [h, w, fc, gc, sub_eq_add_neg, add_assoc] using (row1Inc w).1) + (by simpa [h, w, fc, gc, sub_eq_add_neg, add_assoc] using (row1Inc w).2) + have hwy : w - b = y := by dsimp [w]; rw [h]; abel + have hforward : path fc gc = p1.map (fun z => z + (w : GaussianInt)) := + by simpa [fc, gc] using row1CanonicalForward w + have hbackward : path gc fc = (p1.map (fun z => z + (w : GaussianInt))).reverse := + by simpa [fc, gc] using row1CanonicalBackward w + have hw : P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) + (TileTranslation T ((w - b : L) : GaussianInt)) (rho fc) (rho gc) + (p1.map (fun z => z + (w : GaussianInt))) := rowWalk1 w + have hc : (path f g).head? = some (rho f) ∧ + (path f g).getLast? = some (rho g) ∧ + (∀ z ∈ path f g, z ∈ FootprintVertices (TileTranslation T ↑w) ∩ + FootprintVertices (TileTranslation T ↑(w - b))) ∧ + ∀ x' y' : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + path f g = l₁ ++ x' :: y' :: l₂ → + {x', y'} ∈ FootprintEdges (TileTranslation T ↑w) ∩ + FootprintEdges (TileTranslation T ↑(w - b)) := RegularFaceWalkProof.hcAt922 + L k D T ru rd x p0 p1 p2 y walkClaims f g hpair hforward hbackward hw + rcases hc with ⟨hh, hl, hv, he⟩ + refine ⟨hh, hl, ?_, ?_⟩ + · intro z hz + rcases hv z hz with ⟨hz1, hz2⟩ + exact ⟨by simpa [w] using hz1, + by simpa [hwy, AddSubgroup.coe_sub] using hz2⟩ + · intro x' y' l₁ l₂ hp + rcases he x' y' l₁ l₂ hp with ⟨he1, he2⟩ + exact ⟨by simpa [w] using he1, + by simpa [hwy, AddSubgroup.coe_sub] using he2⟩ + +private theorem thirdForward : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), ∀ (x : ↥L), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + (∀ (x : L), ∀ (y : L), (D.plane.adjacent x y) → (∀ (f : D.plane.Face), ∀ (g : + D.plane.Face), ∀ (c : D.plane.Face), ∀ (d : D.plane.Face), (f ≠ g) → ((c ≠ d) → + (((∃ i, D.plane.faceVertex f i = x) ∧ (∃ i, D.plane.faceVertex f i = y)) → (((∃ i, + D.plane.faceVertex g i = x) ∧ (∃ i, D.plane.faceVertex g i = y)) → (((∃ i, + D.plane.faceVertex c i = x) ∧ (∃ i, D.plane.faceVertex c i = y)) → (((∃ i, + D.plane.faceVertex d i = x) ∧ (∃ i, D.plane.faceVertex d i = y)) → ((f = c ∧ g = d) ∨ + (f = d ∧ g = c))))))))) → (∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ + (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + ∀ (y : ↥L), + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + (∀ (w : L), P4733T1ContainedWalk (TileTranslation T ((w + a : L) : GaussianInt)) + (TileTranslation T ((w - b : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho + (D.faces (.inr (w + a - b)))) (p2.map (fun z => z + (w : GaussianInt)))) → ((∀ (x : + L), ∀ (y : L), D.faces (.inl x) ≠ D.faces (.inr y)) → ((∀ (w : L), path (D.faces + (.inl w)) (D.faces (.inr (w + a - b))) = (p2.map (fun z => z + (w : GaussianInt)))) → + ((∀ (w : L), path (D.faces (.inr (w + a - b))) (D.faces (.inl w)) = (p2.map (fun z => + z + (w : GaussianInt))).reverse) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (fc : + D.plane.Face), ∀ (gc : D.plane.Face), ∀ (P : List GaussianInt), + (P4733T1ContainedWalk A B (rho fc) (rho gc) P) → ((path fc gc = P) → ((path gc + fc = + P.reverse) → (∀ (f : D.plane.Face), ∀ (g : D.plane.Face), ((f = fc ∧ g = gc) ∨ (f = + gc ∧ g = fc)) → ((path f g).head? = some (rho f) ∧ (path f g).getLast? = some (rho g) + ∧ (∀ z ∈ path f g, z ∈ FootprintVertices A ∩ FootprintVertices B) ∧ ∀ x y : + GaussianInt, ∀ l₁ l₂ : List GaussianInt, path f g = l₁ ++ x :: y :: l₂ → {x, y} ∈ + FootprintEdges A ∩ FootprintEdges B))))) → ((D.plane.adjacent x y) → (∀ (f : + D.plane.Face), ∀ (g : D.plane.Face), (f ≠ g) → ((∃ (i : Fin (3 : ℕ)), + D.plane.faceVertex f i = x) → ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex f i = y) → + ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex g i = x) → ((∃ (i : Fin (3 : ℕ)), + D.plane.faceVertex g i = y) → (y = x + (a + b) → P4733T1ContainedWalk + (TileTranslation T (↑x : GaussianInt)) (TileTranslation T (↑y : GaussianInt)) (rho f) + (rho g) (path f g)))))))))))))) := by + classical + intro L k D T a b ru rd x rho uniquePair p0 p1 p2 rowPath y path rowWalk2 faceTagsNe + row2CanonicalForward row2CanonicalBackward walkClaims hxy f g hfg hfa hfb hga hgb h + let w := x + b + let fc := D.faces (.inl w) + let gc := D.faces (.inr (w + a - b)) + have hwx : w - b = x := by dsimp [w]; abel + have hwy : w + a = y := by dsimp [w]; rw [h]; abel + have hwxG : ((w - b : L) : GaussianInt) = (x : GaussianInt) := by + simpa only [AddSubgroup.coe_sub] using congrArg (fun z : L => (z : GaussianInt)) hwx + have hwyG : ((w + a : L) : GaussianInt) = (y : GaussianInt) := by + exact congrArg (fun z : L => (z : GaussianInt)) hwy + have hc : (∃ i, D.plane.faceVertex fc i = x) ∧ + ∃ i, D.plane.faceVertex fc i = y := RegularFaceDetails.hcAt1607 L k D x y hwx hwy + have hd : (∃ i, D.plane.faceVertex gc i = x) ∧ + ∃ i, D.plane.faceVertex gc i = y := RegularFaceWalkProof.hdAt961 L k D x y hwx hwy + have hpair := uniquePair x y hxy f g fc gc hfg (faceTagsNe w (w + a - b)) + ⟨hfa, hfb⟩ ⟨hga, hgb⟩ hc hd + have hforward : path fc gc = p2.map (fun z => z + (w : GaussianInt)) := + by simpa [fc, gc] using row2CanonicalForward w + have hbackward : path gc fc = (p2.map (fun z => z + (w : GaussianInt))).reverse := + by simpa [fc, gc] using row2CanonicalBackward w + have hw : P4733T1ContainedWalk + (TileTranslation T ((w + a : L) : GaussianInt)) + (TileTranslation T ((w - b : L) : GaussianInt)) (rho fc) (rho gc) + (p2.map (fun z => z + (w : GaussianInt))) := rowWalk2 w + have hclaims := walkClaims _ _ fc gc _ hw hforward hbackward f g hpair + rcases hclaims with ⟨hh, hl, hv, he⟩ + refine ⟨hh, hl, ?_, ?_⟩ + · intro z hz + rcases hv z hz with ⟨hz1, hz2⟩ + have hz2' := hz2 + have hz1' := hz1 + change z ∈ FootprintVertices (TileTranslation T ((w - b : L) : GaussianInt)) at hz2' + change z ∈ FootprintVertices (TileTranslation T ((w + a : L) : GaussianInt)) at hz1' + rw [hwxG] at hz2' + rw [hwyG] at hz1' + exact ⟨hz2', hz1'⟩ + · intro x' y' l₁ l₂ hp + rcases he x' y' l₁ l₂ hp with ⟨he1, he2⟩ + have he2' := he2 + have he1' := he1 + change {x', y'} ∈ FootprintEdges (TileTranslation T ((w - b : L) : GaussianInt)) + at he2' + change {x', y'} ∈ FootprintEdges (TileTranslation T ((w + a : L) : GaussianInt)) + at he1' + rw [hwxG] at he2' + rw [hwyG] at he1' + exact ⟨he2', he1'⟩ + +private theorem thirdBackward : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), ∀ (x : ↥L), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + (∀ (x : L), ∀ (y : L), (D.plane.adjacent x y) → (∀ (f : D.plane.Face), ∀ (g : + D.plane.Face), ∀ (c : D.plane.Face), ∀ (d : D.plane.Face), (f ≠ g) → ((c ≠ d) → + (((∃ i, D.plane.faceVertex f i = x) ∧ (∃ i, D.plane.faceVertex f i = y)) → (((∃ i, + D.plane.faceVertex g i = x) ∧ (∃ i, D.plane.faceVertex g i = y)) → (((∃ i, + D.plane.faceVertex c i = x) ∧ (∃ i, D.plane.faceVertex c i = y)) → (((∃ i, + D.plane.faceVertex d i = x) ∧ (∃ i, D.plane.faceVertex d i = y)) → ((f = c ∧ g = d) ∨ + (f = d ∧ g = c))))))))) → (∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ + (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + ∀ (y : ↥L), + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + (∀ (w : L), P4733T1ContainedWalk (TileTranslation T ((w + a : L) : GaussianInt)) + (TileTranslation T ((w - b : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho + (D.faces (.inr (w + a - b)))) (p2.map (fun z => z + (w : GaussianInt)))) → ((∀ (x : + L), ∀ (y : L), D.faces (.inl x) ≠ D.faces (.inr y)) → ((∀ (w : L), path (D.faces + (.inl w)) (D.faces (.inr (w + a - b))) = (p2.map (fun z => z + (w : GaussianInt)))) → + ((∀ (w : L), path (D.faces (.inr (w + a - b))) (D.faces (.inl w)) = (p2.map (fun z => + z + (w : GaussianInt))).reverse) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (fc : + D.plane.Face), ∀ (gc : D.plane.Face), ∀ (P : List GaussianInt), + (P4733T1ContainedWalk A B (rho fc) (rho gc) P) → ((path fc gc = P) → ((path gc + fc = + P.reverse) → (∀ (f : D.plane.Face), ∀ (g : D.plane.Face), ((f = fc ∧ g = gc) ∨ (f = + gc ∧ g = fc)) → ((path f g).head? = some (rho f) ∧ (path f g).getLast? = some (rho g) + ∧ (∀ z ∈ path f g, z ∈ FootprintVertices A ∩ FootprintVertices B) ∧ ∀ x y : + GaussianInt, ∀ l₁ l₂ : List GaussianInt, path f g = l₁ ++ x :: y :: l₂ → {x, y} ∈ + FootprintEdges A ∩ FootprintEdges B))))) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ + (A' : ProtoTile), ∀ (B' : ProtoTile), ∀ (s : GaussianInt), ∀ (t : GaussianInt), ∀ + (P : List GaussianInt), (A = A') → ((B = B') → ((P4733T1ContainedWalk A B s t P) → + (P4733T1ContainedWalk A' B' s t P)))) → ((D.plane.adjacent x y) → (∀ (f : + D.plane.Face), ∀ (g : D.plane.Face), (f ≠ g) → ((∃ (i : Fin (3 : ℕ)), + D.plane.faceVertex f i = x) → ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex f i = y) → + ((∃ (i : Fin (3 : ℕ)), D.plane.faceVertex g i = x) → ((∃ (i : Fin (3 : ℕ)), + D.plane.faceVertex g i = y) → (x = y + (a + b) → P4733T1ContainedWalk + (TileTranslation T (↑x : GaussianInt)) (TileTranslation T (↑y : GaussianInt)) (rho f) + (rho g) (path f g))))))))))))))) := by + classical + intro L k D T a b ru rd x rho uniquePair p0 p1 p2 rowPath y path rowWalk2 faceTagsNe + row2CanonicalForward row2CanonicalBackward walkClaims transportContainedWalk hxy f g hfg + hfa hfb hga hgb h + let w := y + b + let fc := D.faces (.inl w) + let gc := D.faces (.inr (w + a - b)) + have hwy : w - b = y := by + simpa only [w] using (add_sub_cancel_right y b) + have hwx : w + a = x := RegularFaceDetails.hwxAt1656 L k x y h + have hsym := (D.plane.adjacent_symmetric x y).mp hxy + have hc : (∃ i, D.plane.faceVertex fc i = y) ∧ + ∃ i, D.plane.faceVertex fc i = x := RegularFaceDetails.hcAt1662 L k D x y hwy hwx + have hd : (∃ i, D.plane.faceVertex gc i = y) ∧ + ∃ i, D.plane.faceVertex gc i = x := RegularFaceWalkProof.hdAt1029 L k D x y hwy hwx + have hpair := uniquePair y x hsym f g fc gc hfg (faceTagsNe w (w + a - b)) + ⟨hfb, hfa⟩ ⟨hgb, hga⟩ hc hd + have hforward : path fc gc = p2.map (fun z => z + (w : GaussianInt)) := by + exact row2CanonicalForward w + have hbackward : path gc fc = (p2.map (fun z => z + (w : GaussianInt))).reverse := by + exact row2CanonicalBackward w + have hw : P4733T1ContainedWalk + (TileTranslation T ((w + a : L) : GaussianInt)) + (TileTranslation T ((w - b : L) : GaussianInt)) (rho fc) (rho gc) + (p2.map (fun z => z + (w : GaussianInt))) := RegularFaceDetails.hwAt1679 L k D T + ru rd x p2 rowWalk2 y + have hwxG : ((w + a : L) : GaussianInt) = (x : GaussianInt) := + congrArg (fun z : L => z.1) hwx + have hwyG : ((w - b : L) : GaussianInt) = (y : GaussianInt) := + congrArg (fun z : L => z.1) hwy + have hw' := transportContainedWalk _ _ _ _ _ _ _ + (congrArg (TileTranslation T) hwxG) + (congrArg (TileTranslation T) hwyG) hw + exact walkClaims _ _ fc gc _ hw' hforward hbackward f g hpair + +private theorem pathDiagonal : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + ∀ f, path f f = [] ) := by + classical + intro L k D a b p0 p1 p2 rowPath path f + cases hf : D.faces.symm f with + | inl x => + rw [← D.faces.apply_symm_apply f, hf] + simp only [path, D.faces.symm_apply_apply] + | inr x => + rw [← D.faces.apply_symm_apply f, hf] + simp only [path, D.faces.symm_apply_apply] + +end RegularFaceProperties + +namespace RegularIncidentWalks + +private theorem incidentWalks : + (by + classical + exact + ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing + L k), ∀ (T : ProtoTile), + let a : L := k (1, 0) + let b : L := k (0, 1) + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + (∀ (x : L), ∀ (y : L), (D.plane.adjacent x y) → (y = x + a ∨ x = y + a ∨ y = + x + b ∨ x = y + b ∨ y = x + (a + b) ∨ x = y + (a + b))) → ((∀ (x : L), ∀ (y : L), + (D.plane.adjacent x y) → (∀ (f : D.plane.Face), ∀ (g : D.plane.Face), ∀ (c : + D.plane.Face), ∀ (d : D.plane.Face), (f ≠ g) → ((c ≠ d) → (((∃ i, D.plane.faceVertex + f i = x) ∧ (∃ i, D.plane.faceVertex f i = y)) → (((∃ i, D.plane.faceVertex g i = x) ∧ + (∃ i, D.plane.faceVertex g i = y)) → (((∃ i, D.plane.faceVertex c i = x) ∧ (∃ i, + D.plane.faceVertex c i = y)) → (((∃ i, D.plane.faceVertex d i = x) ∧ (∃ i, + D.plane.faceVertex d i = y)) → ((f = c ∧ g = d) ∨ (f = d ∧ g = c))))))))) → (∀ (p0 : + List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + (∀ (w : L), P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) (TileTranslation + T ((w + a : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho (D.faces (.inr (w + + a)))) (p0.map (fun z => z + (w : GaussianInt)))) → ((∀ (w : L), + P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) (TileTranslation T + ((w - + b : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho (D.faces (.inr (w - b)))) + (p1.map (fun z => z + (w : GaussianInt)))) → ((∀ (w : L), P4733T1ContainedWalk + (TileTranslation T ((w + a : L) : GaussianInt)) (TileTranslation T ((w - b : L) : + GaussianInt)) (rho (D.faces (.inl w))) (rho (D.faces (.inr (w + a - b)))) (p2.map + (fun z => z + (w : GaussianInt)))) → ((∀ (x : L), ∀ (y : L), D.faces (.inl x) ≠ + D.faces (.inr y)) → ((∀ (w : L), ((∃ i, D.plane.faceVertex (D.faces (.inl w)) i = w) + ∧ ∃ i, D.plane.faceVertex (D.faces (.inl w)) i = w + a) ∧ ((∃ i, D.plane.faceVertex + (D.faces (.inr (w + a))) i = w) ∧ ∃ i, D.plane.faceVertex (D.faces (.inr (w + a))) i + = w + a)) → ((∀ (w : L), ((∃ i, D.plane.faceVertex (D.faces (.inl w)) i = w - b) ∧ ∃ + i, D.plane.faceVertex (D.faces (.inl w)) i = w) ∧ ((∃ i, D.plane.faceVertex (D.faces + (.inr (w - b))) i = w - b) ∧ ∃ i, D.plane.faceVertex (D.faces (.inr (w - b))) i = w)) + → ((∀ (w : L), path (D.faces (.inl w)) (D.faces (.inr (w + a - b))) = (p2.map (fun z + => z + (w : GaussianInt)))) → ((∀ (w : L), path (D.faces (.inl w)) (D.faces (.inr (w + - b))) = (p1.map (fun z => z + (w : GaussianInt)))) → ((∀ (w : L), path (D.faces + (.inr (w - b))) (D.faces (.inl w)) = (p1.map (fun z => z + (w : + GaussianInt))).reverse) → ((∀ (w : L), path (D.faces (.inl w)) (D.faces (.inr (w + + a))) = (p0.map (fun z => z + (w : GaussianInt)))) → ((∀ (w : L), path (D.faces (.inr + (w + a))) (D.faces (.inl w)) = (p0.map (fun z => z + (w : GaussianInt))).reverse) → + ((∀ (w : L), path (D.faces (.inr (w + a - b))) (D.faces (.inl w)) = (p2.map (fun z => + z + (w : GaussianInt))).reverse) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (fc : + D.plane.Face), ∀ (gc : D.plane.Face), ∀ (P : List GaussianInt), + (P4733T1ContainedWalk A B (rho fc) (rho gc) P) → ((path fc gc = P) → ((path gc + fc = + P.reverse) → (∀ (f : D.plane.Face), ∀ (g : D.plane.Face), ((f = fc ∧ g = gc) ∨ (f = + gc ∧ g = fc)) → ((path f g).head? = some (rho f) ∧ (path f g).getLast? = some (rho g) + ∧ (∀ z ∈ path f g, z ∈ FootprintVertices A ∩ FootprintVertices B) ∧ ∀ x y : + GaussianInt, ∀ l₁ l₂ : List GaussianInt, path f g = l₁ ++ x :: y :: l₂ → {x, y} ∈ + FootprintEdges A ∩ FootprintEdges B))))) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ + (A' : ProtoTile), ∀ (B' : ProtoTile), ∀ (s : GaussianInt), ∀ (t : GaussianInt), ∀ + (P : List GaussianInt), (A = A') → ((B = B') → ((P4733T1ContainedWalk A B s t P) → + (P4733T1ContainedWalk A' B' s t P)))) → (∀ (x : L), ∀ (y : L), D.plane.adjacent x y + → ∀ (f : D.plane.Face), ∀ (g : D.plane.Face), f ≠ g → (∃ i, D.plane.faceVertex f i = + x) → (∃ i, D.plane.faceVertex f i = y) → (∃ i, D.plane.faceVertex g i = x) → (∃ i, + D.plane.faceVertex g i = y) → P4733T1ContainedWalk (TileTranslation T (x : + GaussianInt)) (TileTranslation T (y : GaussianInt)) (rho f) (rho g) (path f + g)))))))))))))))))) := by + classical + intro L k D T a b ru rd rho edgeDiff uniquePair p0 p1 p2 rowPath path rowWalk0 rowWalk1 + rowWalk2 faceTagsNe row0Inc row1Inc row2CanonicalForward row1CanonicalForward + row1CanonicalBackward row0CanonicalForward row0CanonicalBackward row2CanonicalBackward + walkClaims transportContainedWalk x y hxy f g hfg hfa hfb hga hgb + have firstForward (h : y = x + a) : + P4733T1ContainedWalk (TileTranslation T (x : GaussianInt)) + (TileTranslation T (y : GaussianInt)) (rho f) (rho g) (path f g) := + RegularFaceProperties.firstForward L k D T ru rd x uniquePair p0 p1 p2 y rowWalk0 + faceTagsNe row0Inc row0CanonicalForward row0CanonicalBackward walkClaims hxy f g + hfg hfa hfb hga hgb h + have firstBackward (h : x = y + a) : + P4733T1ContainedWalk (TileTranslation T (x : GaussianInt)) + (TileTranslation T (y : GaussianInt)) (rho f) (rho g) (path f g) := + RegularFaceProperties.firstBackward L k D T ru rd x uniquePair p0 p1 p2 y + rowWalk0 faceTagsNe row0Inc row0CanonicalForward row0CanonicalBackward walkClaims + hxy f g hfg hfa hfb hga hgb h + have secondForward (h : y = x + b) : + P4733T1ContainedWalk (TileTranslation T (x : GaussianInt)) + (TileTranslation T (y : GaussianInt)) (rho f) (rho g) (path f g) := + RegularFaceProperties.secondForward L k D T ru rd x uniquePair p0 p1 p2 y + rowWalk1 faceTagsNe row1Inc row1CanonicalForward row1CanonicalBackward walkClaims + hxy f g hfg hfa hfb hga hgb h + have secondBackward (h : x = y + b) : + P4733T1ContainedWalk (TileTranslation T (x : GaussianInt)) + (TileTranslation T (y : GaussianInt)) (rho f) (rho g) (path f g) := + RegularFaceProperties.secondBackward L k D T ru rd x uniquePair p0 p1 p2 y + rowWalk1 faceTagsNe row1Inc row1CanonicalForward row1CanonicalBackward walkClaims + hxy f g hfg hfa hfb hga hgb h + have thirdForward (h : y = x + (a + b)) : + P4733T1ContainedWalk (TileTranslation T (x : GaussianInt)) + (TileTranslation T (y : GaussianInt)) (rho f) (rho g) (path f g) := + RegularFaceProperties.thirdForward L k D T ru rd x uniquePair p0 p1 p2 y rowWalk2 + faceTagsNe row2CanonicalForward row2CanonicalBackward walkClaims hxy f g hfg hfa + hfb hga hgb h + have thirdBackward (h : x = y + (a + b)) : + P4733T1ContainedWalk (TileTranslation T (x : GaussianInt)) + (TileTranslation T (y : GaussianInt)) (rho f) (rho g) (path f g) := + RegularFaceProperties.thirdBackward L k D T ru rd x uniquePair p0 p1 p2 y + rowWalk2 faceTagsNe row2CanonicalForward row2CanonicalBackward walkClaims + transportContainedWalk hxy f g hfg hfa hfb hga hgb h + rcases edgeDiff x y hxy with h | h | h | h | h | h + · exact firstForward h + · exact firstBackward h + · exact secondForward h + · exact secondBackward h + · exact thirdForward h + · exact thirdBackward h + +end RegularIncidentWalks + +theorem P4812T1RegularFaceWalks + (L : AddSubgroup GaussianInt) (k : (Int × Int) ≃+ L) + (D : P4812T1AffineDrawing L k) (T : ProtoTile) + (hne : T.cells.Nonempty) + (hup : TouchingTriple T + (TileTranslation T (k (1, 0) : GaussianInt)) + (TileTranslation T (-(k (0, 1) : GaussianInt)))) + (hdown : TouchingTriple T + (TileTranslation T (-(k (1, 0) : GaussianInt))) + (TileTranslation T (k (0, 1) : GaussianInt))) : + let fs := fun (u : L) (f : D.plane.Face) => + D.faces (Sum.map (u + ·) (u + ·) (D.faces.symm f)) + ∃ rho : D.plane.Face → GaussianInt, + (∀ f i, rho f ∈ FootprintVertices + (TileTranslation T (D.plane.faceVertex f i : GaussianInt))) ∧ + (∀ u f, rho (fs u f) = rho f + (u : GaussianInt)) ∧ + ∃ path : D.plane.Face → D.plane.Face → List GaussianInt, + (∀ f g, path g f = (path f g).reverse) ∧ + (∀ u f g, path (fs u f) (fs u g) = + (path f g).map (fun z => z + (u : GaussianInt))) ∧ + (∀ a b, D.plane.adjacent a b → + ∀ f g, f ≠ g → + (∃ i, D.plane.faceVertex f i = a) → + (∃ i, D.plane.faceVertex f i = b) → + (∃ i, D.plane.faceVertex g i = a) → + (∃ i, D.plane.faceVertex g i = b) → + (path f g).head? = some (rho f) ∧ + (path f g).getLast? = some (rho g) ∧ + (∀ z ∈ path f g, z ∈ + FootprintVertices (TileTranslation T (a : GaussianInt)) ∩ + FootprintVertices (TileTranslation T (b : GaussianInt))) ∧ + ∀ x y : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + path f g = l₁ ++ x :: y :: l₂ → + {x, y} ∈ FootprintEdges (TileTranslation T (a : GaussianInt)) ∩ + FootprintEdges (TileTranslation T (b : GaussianInt))) ∧ + (∀ a b, D.plane.adjacent a b → + (FootprintEdges (TileTranslation T (a : GaussianInt)) ∩ + FootprintEdges (TileTranslation T (b : GaussianInt))).Nonempty) ∧ + ∀ f, path f f = [] := by +-- BODY + exact ((by + classical + dsimp only + let a : L := k (1, 0) + let b : L := k (0, 1) + obtain ⟨ru, hru⟩ := hup.2.2.2 + obtain ⟨rd, hrd⟩ := hdown.2.2.2 + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + have translateComp (W : ProtoTile) (v w : GaussianInt) := + RegularFaceWalkProof.translateComp W v w + have k11 := RegularFaceDetails.k11 L k + have edgeDiff (x y : L) (hxy : D.plane.adjacent x y) := RegularFaceWalkProof.edgeDiff L k D + k11 (RegularFaceDetails.kneg11 L k k11) + (RegularFaceDetails.kneg10 L k) (RegularFaceDetails.kneg01 L k) x y hxy + have ru0 : ru ∈ BoundaryFootprintVertices T := hru.1.1 + have rua : ru ∈ BoundaryFootprintVertices (TileTranslation T (a : GaussianInt)) := hru.1.2.1 + have rub : ru ∈ BoundaryFootprintVertices (TileTranslation T (-(b : GaussianInt))) := + hru.1.2.2 + have rd0 : rd ∈ BoundaryFootprintVertices T := hrd.1.1 + have rda : rd ∈ BoundaryFootprintVertices (TileTranslation T (-(a : GaussianInt))) := + hrd.1.2.1 + have rdb : rd ∈ BoundaryFootprintVertices (TileTranslation T (b : GaussianInt)) := hrd.1.2.2 + have rho_mem (q : Sum L L) (i : Fin 3) : + rho (D.faces q) ∈ FootprintVertices + (TileTranslation T (D.plane.faceVertex (D.faces q) i : GaussianInt)) := + RegularFaceWalkProof.rho_mem L k D T ru rd (RegularFaceWalkProof.boundaryFoot) + (RegularFaceDetails.translateBoundary) + translateComp ru0 rua rub rd0 rda rdb q i + have transZero (W : ProtoTile) : TileTranslation W 0 = W := RegularFaceWalkProof.transZero W + let fU := D.faces (.inl (0 : L)) + let fDa := D.faces (.inr a) + let fDmb := D.faces (.inr (-b)) + let fDamB := D.faces (.inr (a - b)) + have u00 : rho fU ∈ FootprintVertices T := by + simpa [fU, D.up_vertices, transZero] using rho_mem (.inl 0) 0 + have u0a : rho fU ∈ FootprintVertices (TileTranslation T (a : GaussianInt)) := by + simpa [fU, D.up_vertices] using rho_mem (.inl 0) 1 + have da0 : rho fDa ∈ FootprintVertices (TileTranslation T (a : GaussianInt)) := by + simpa [fDa, D.down_vertices] using rho_mem (.inr a) 0 + have da00 : rho fDa ∈ FootprintVertices T := by + simpa [fDa, a, D.down_vertices, transZero, sub_self] using rho_mem (.inr a) 1 + have dmb0 : rho fDmb ∈ FootprintVertices T := RegularFaceDetails.dmb0 L k D T ru rd rho_mem + transZero + have dmbb : rho fDmb ∈ FootprintVertices (TileTranslation T (-(b : GaussianInt))) := by + simpa [fDmb, D.down_vertices] using rho_mem (.inr (-b)) 0 + have damB_a : rho fDamB ∈ FootprintVertices (TileTranslation T (a : GaussianInt)) := by + simpa [fDamB, a, b, D.down_vertices] using rho_mem (.inr (a - b)) 2 + have touch0 : TileTouching T (TileTranslation T (a : GaussianInt)) := hup.1 + have touch1 : TileTouching T (TileTranslation T (-(b : GaussianInt))) := + (RegularFaceDetails.touchSymm) _ _ hup.2.2.1 + have touch2 : TileTouching (TileTranslation T (a : GaussianInt)) + (TileTranslation T (-(b : GaussianInt))) := hup.2.1 + obtain ⟨p0, hp0⟩ := P4677T2TouchingWalk T + (TileTranslation T (a : GaussianInt)) (rho fU) (rho fDa) touch0 + ⟨u00, u0a⟩ ⟨da00, da0⟩ + obtain ⟨p1, hp1⟩ := P4677T2TouchingWalk T + (TileTranslation T (-(b : GaussianInt))) (rho fU) (rho fDmb) touch1 + ⟨u00, by simpa [fU, b, D.up_vertices, transZero] using (rho_mem (.inl 0) 2)⟩ ⟨dmb0, dmbb⟩ + obtain ⟨p2, hp2⟩ := P4677T2TouchingWalk + (TileTranslation T (a : GaussianInt)) (TileTranslation T (-(b : GaussianInt))) + (rho fU) (rho fDamB) touch2 ⟨u0a, by simpa [fU, D.up_vertices, b] using rho_mem (.inl 0) 2⟩ + ⟨damB_a, (RegularFaceDetails.damB_mb L k D T ru rd rho_mem)⟩ + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2 + let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] + have mapTranslate (p : List GaussianInt) (x u : L) := RegularFaceDetails.mapTranslate L p x u + have commonEdgeTouch (V W : ProtoTile) (hneV : V.cells.Nonempty) + (hneW : W.cells.Nonempty) (h : TileTouching V W) := RegularFaceWalkProof.commonEdgeTouch + (RegularFaceWalkProof.boundaryEdgeFoot) V W hneV hneW h + have transNonempty (v : GaussianInt) := RegularFaceDetails.transNonempty T hne v + obtain ⟨e0, he0⟩ := commonEdgeTouch T (TileTranslation T (a : GaussianInt)) hne + (transNonempty (a : GaussianInt)) touch0 + obtain ⟨e1, he1⟩ := commonEdgeTouch T (TileTranslation T (-(b : GaussianInt))) hne + (transNonempty (-(b : GaussianInt))) touch1 + obtain ⟨e2, he2⟩ := commonEdgeTouch (TileTranslation T (a : GaussianInt)) + (TileTranslation T (-(b : GaussianInt))) (transNonempty (a : GaussianInt)) + (transNonempty (-(b : GaussianInt))) touch2 + have footprintEdgeTranslate (V : ProtoTile) (v : GaussianInt) + (e : Finset GaussianInt) (he : e ∈ FootprintEdges V) := + RegularFaceDetails.footprintEdgeTranslate V v e he + have tileAdd (v w : L) := RegularFaceDetails.tileAdd L T + translateComp v w + have rhoUpShift (w : L) := RegularFaceDetails.rhoUpShift L + k D ru rd w + have aNeNegB := RegularFaceDetails.aNeNegB L k + have aNeAmB := RegularFaceDetails.aNeAmB L k + have negBNeAmB := RegularFaceDetails.negBNeAmB L k + let fs := fun (u : L) (f : D.plane.Face) => + D.faces (Sum.map (u + ·) (u + ·) (D.faces.symm f)) + refine ⟨rho, ?_, (RegularFaceProperties.rhoPeriodic L k D ru rd), path, + (RegularFaceProperties.pathReverse L k D p0 p1 p2), (RegularFaceProperties.pathPeriodic + L k D p0 p1 p2 (RegularFaceDetails.shiftEq L) mapTranslate + (RegularFaceWalkProof.mapTranslateRev L mapTranslate) (RegularFaceWalkProof.ifMap3 L)), + (RegularIncidentWalks.incidentWalks L k D T ru rd edgeDiff + (RegularFaceWalkProof.uniquePair L k D) p0 p1 p2 (RegularFaceWalkProof.rowWalk0 L k D T + ru rd p0 hp0 tileAdd rhoUpShift (RegularFaceDetails.rhoDown0Shift L k D ru rd)) + (RegularFaceWalkProof.rowWalk1 L k D T ru rd translateComp p1 hp1 rhoUpShift + (RegularFaceDetails.rhoDown1Shift L k D ru rd)) (RegularFaceWalkProof.rowWalk2 L k D T + ru rd translateComp p2 hp2 rhoUpShift (RegularFaceDetails.rhoDown2Shift L k D ru rd)) + (RegularFaceDetails.faceTagsNe L k D) (RegularFaceWalkProof.row0Inc L k D) + (RegularFaceWalkProof.row1Inc L k D) (RegularFaceWalkProof.row2CanonicalForward L k D + p0 p1 p2 aNeAmB negBNeAmB) (RegularFaceWalkProof.row1CanonicalForward L k D p0 p1 p2 + aNeNegB) (RegularFaceWalkProof.row1CanonicalBackward L k D p0 p1 p2 aNeNegB) + (RegularFaceDetails.row0CanonicalForward L k D p0 p1 p2) + (RegularFaceDetails.row0CanonicalBackward L k D p0 p1 p2) + (RegularFaceWalkProof.row2CanonicalBackward L k D p0 p1 p2 aNeAmB negBNeAmB) + (RegularFaceWalkProof.walkClaims L k D ru rd p0 p1 p2) + (RegularFaceDetails.transportContainedWalk)), ?_, + (RegularFaceProperties.pathDiagonal L k D p0 p1 p2)⟩ + · intro f i + simpa only [Equiv.apply_symm_apply] using rho_mem (D.faces.symm f) i + · exact fun x y hxy => (RegularFaceWalkProof.commonEdgeForAdjacent L k D T edgeDiff e0 e1 + e2 (RegularFaceDetails.rowEdge0 L k T e0 he0 footprintEdgeTranslate tileAdd) + (RegularFaceDetails.rowEdge1 L k T translateComp e1 he1 footprintEdgeTranslate) + (RegularFaceWalkProof.rowEdge2 L k T translateComp e2 he2 footprintEdgeTranslate + tileAdd)) x y hxy + )) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4818T1AffineTransversalExtension.lean b/LeanPool/ApollonianSuperharmonic/P4818T1AffineTransversalExtension.lean new file mode 100644 index 0000000000..ca45140591 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4818T1AffineTransversalExtension.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction +public import Mathlib.Tactic.Abel +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P4818T1AffineTransversalExtension] + +/-! +# P4818T1AffineTransversalExtension + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4818T1AffineTransversalExtension + (H : Set GaussianInt) (a b : GaussianInt) + (α β : GaussianInt →+ Int) (ca cb : Int) (f : IntegerLatticeFunction) + (hrep : ∀ x : GaussianInt, ∃! p : GaussianInt × (Int × Int), + p.1 ∈ H ∧ x = p.1 + p.2.1 • a + p.2.2 • b) + (hcomm : α b = β a) : + ∃ g : IntegerLatticeFunction, + (∀ h, h ∈ H → g h = f h) ∧ + (∀ x, g (x + a) = g x + α x + ca) ∧ + (∀ x, g (x + b) = g x + β x + cb) ∧ + (∀ h, h ∈ H → ∀ m n : Int, + g (h + m • a + n • b) = f h + + m * (α h + ca) + (m * (m - 1) / 2) * α a + + n * (β h + cb) + (n * (n - 1) / 2) * β b + m * n * β a) ∧ + (∀ g' : IntegerLatticeFunction, + (∀ x, g' (x + a) = g' x + α x + ca) → + (∀ x, g' (x + b) = g' x + β x + cb) → + (∀ h, h ∈ H → g' h = f h) → g' = g) := by +-- BODY + classical + let B : Int → Int := fun t => t * (t - 1) / 2 + have hB (t : Int) : B (t + 1) = B t + t := by + have he : (t + 1) * (t + 1 - 1) = t * (t - 1) + t * 2 := by ring + dsimp [B] + rw [he, Int.add_mul_ediv_right _ _ (by decide)] + let E : GaussianInt → Int → Int → Int := fun h m n => + f h + m * (α h + ca) + B m * α a + + n * (β h + cb) + B n * β b + m * n * β a + have eA (h : GaussianInt) (m n : Int) : + E h (m + 1) n = E h m n + α (h + m • a + n • b) + ca := by + simp only [E, hB, map_add, map_zsmul] + simp only [zsmul_eq_mul, Int.cast_id, hcomm] + ring + have eB (h : GaussianInt) (m n : Int) : + E h m (n + 1) = E h m n + β (h + m • a + n • b) + cb := by + simp only [E, hB, map_add, map_zsmul] + simp only [zsmul_eq_mul, Int.cast_id] + ring + let coord := fun x => Classical.choose (hrep x) + have hc (x : GaussianInt) : + (coord x).1 ∈ H ∧ x = (coord x).1 + (coord x).2.1 • a + (coord x).2.2 • b := + (Classical.choose_spec (hrep x)).1 + have cu (h : GaussianInt) (hh : h ∈ H) (m n : Int) : + coord (h + m • a + n • b) = (h, m, n) := by + exact ((Classical.choose_spec (hrep (h + m • a + n • b))).2 + (h, m, n) ⟨hh, rfl⟩).symm + let g : IntegerLatticeFunction := fun x => + E (coord x).1 (coord x).2.1 (coord x).2.2 + have value (h : GaussianInt) (hh : h ∈ H) (m n : Int) : + g (h + m • a + n • b) = E h m n := by + dsimp [g] + rw [cu h hh m n] + have hH (h : GaussianInt) (hh : h ∈ H) : g h = f h := by + have hval := value h hh 0 0 + simpa [E, B] using hval + have ga (x : GaussianInt) : g (x + a) = g x + α x + ca := by + obtain ⟨hh, hx⟩ := hc x + let h := (coord x).1 + let m := (coord x).2.1 + let n := (coord x).2.2 + have he : x + a = h + (m + 1) • a + n • b := by + rw [hx] + simp only [h, m, n, add_zsmul, one_zsmul] + abel + rw [he, value h hh (m + 1) n, eA] + rw [show h + m • a + n • b = x from hx.symm] + have gb (x : GaussianInt) : g (x + b) = g x + β x + cb := by + obtain ⟨hh, hx⟩ := hc x + let h := (coord x).1 + let m := (coord x).2.1 + let n := (coord x).2.2 + have he : x + b = h + m • a + (n + 1) • b := by + rw [hx] + simp only [h, m, n, add_zsmul, one_zsmul] + abel + rw [he, value h hh m (n + 1), eB] + rw [show h + m • a + n • b = x from hx.symm] + refine ⟨g, hH, ga, gb, value, ?_⟩ + intro g' ga' gb' hH' + let w : GaussianInt → Int := fun x => g' x - g x + have wa (x : GaussianInt) : w (x + a) = w x := by + dsimp [w] + rw [ga', ga] + ring + have wb (x : GaussianInt) : w (x + b) = w x := by + dsimp [w] + rw [gb', gb] + ring + have periodic (d : GaussianInt) (hd : ∀ x, w (x + d) = w x) + (m : Int) (x : GaussianInt) : w (x + m • d) = w x := by + induction m using Int.induction_on with + | zero => simp + | succ m ih => + rw [add_zsmul, one_zsmul, ← add_assoc, hd, ih] + | pred m ih => + have he : x + (-(m : Int) - 1) • d + d = x + (-(m : Int)) • d := by + rw [sub_zsmul, one_zsmul] + abel + have h := hd (x + (-(m : Int) - 1) • d) + rw [he, ih] at h + exact h.symm + funext x + obtain ⟨p, ⟨hh, hx⟩, _⟩ := hrep x + have hw : w x = 0 := by + rw [hx, periodic b wb, periodic a wa] + dsimp [w] + rw [hH' p.1 hh, hH p.1 hh] + ring + exact sub_eq_zero.mp hw + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4818T1BoundaryRecovery.lean b/LeanPool/ApollonianSuperharmonic/P4818T1BoundaryRecovery.lean new file mode 100644 index 0000000000..3fb6e9852a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4818T1BoundaryRecovery.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4818T1HalfOpen +public import LeanPool.ApollonianSuperharmonic.P4818T1ClosedOverlaps +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P4818T1BoundaryRecovery] + +/-! +# P4818T1BoundaryRecovery + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4818T1BoundaryRecovery (K : DiamondParameter) + (P : GaussianInt → Prop) + (hH : ∀ x, x ∈ P4818T1HalfOpen K → P x) + (ha : ∀ x, x ∈ DiamondVertexDomains K false → + x + ⟨0, -(2 * K.1 : Int)⟩ ∈ DiamondVertexDomains K false → + (P x ↔ P (x + ⟨0, -(2 * K.1 : Int)⟩))) + (hb : ∀ x, x ∈ DiamondVertexDomains K false → + x + ⟨(K.1 + 1 : Int), (K.1 : Int)⟩ ∈ DiamondVertexDomains K false → + (P x ↔ P (x + ⟨(K.1 + 1 : Int), (K.1 : Int)⟩))) + (hc : ∀ x, x ∈ DiamondVertexDomains K false → + x + ⟨-(K.1 : Int) - 1, (K.1 : Int)⟩ ∈ DiamondVertexDomains K false → + (P x ↔ P (x + ⟨-(K.1 : Int) - 1, (K.1 : Int)⟩))) : + ∀ x, x ∈ DiamondVertexDomains K false → P x := by +-- BODY + classical + let k : Int := K.1 + let a : GaussianInt := ⟨0, -2 * k⟩ + let b : GaussianInt := ⟨k + 1, k⟩ + let c : GaussianInt := ⟨-k - 1, k⟩ + have hk : 0 < k := by + dsimp [k] + exact_mod_cast K.2 + obtain ⟨_, hA, hB, hC⟩ := P4818T1ClosedOverlaps K + have ha' : ∀ x, x ∈ DiamondVertexDomains K false → + x + a ∈ DiamondVertexDomains K false → (P x ↔ P (x + a)) := by + simpa only [a, k, neg_mul] using ha + have hb' : ∀ x, x ∈ DiamondVertexDomains K false → + x + b ∈ DiamondVertexDomains K false → (P x ↔ P (x + b)) := hb + have hc' : ∀ x, x ∈ DiamondVertexDomains K false → + x + c ∈ DiamondVertexDomains K false → (P x ↔ P (x + c)) := hc + have low (x : GaussianInt) (hx : x ∈ DiamondVertexDomains K false) + (hy : x.im < k) : x ∈ P4818T1HalfOpen K := by + refine ⟨hx, ?_, ?_, ?_⟩ + · rintro ⟨he, _, _⟩ + change x.im = 2 * k at he + omega + · rintro (⟨j, hj, _, he⟩ | ⟨j, hj, _, he⟩) + all_goals + have hi := congrArg Zsqrtd.im he + change x.im = k + j at hi + omega + · rintro (⟨j, hj, _, he⟩ | ⟨j, hj, _, he⟩) + · have hi := congrArg Zsqrtd.im he + change x.im = k + j - 1 at hi + omega + · have hi := congrArg Zsqrtd.im he + change x.im = k + j at hi + omega + have bottom (r : Int) (hr : -1 ≤ r) (hr' : r ≤ 1) : + P ⟨r, 0⟩ := by + have hp := (hA ⟨r, 2 * k⟩).mpr ⟨r, hr, hr', rfl⟩ + have hd := hp.2 + have he : (⟨r, 2 * k⟩ : GaussianInt) + a = ⟨r, 0⟩ := by + ext <;> simp [a] + change (⟨r, 2 * k⟩ : GaussianInt) + a ∈ DiamondVertexDomains K false at hd + rw [he] at hd + exact hH _ (low _ hd hk) + have top (r : Int) (hr : -1 ≤ r) (hr' : r ≤ 1) : + P ⟨r, 2 * k⟩ := by + have hp := (hA ⟨r, 2 * k⟩).mpr ⟨r, hr, hr', rfl⟩ + have h := ha' _ hp.1 hp.2 + have he : (⟨r, 2 * k⟩ : GaussianInt) + a = ⟨r, 0⟩ := by + ext <;> simp [a] + rw [he] at h + exact h.mpr (bottom r hr hr') + have middleR : P ⟨k, k⟩ := by + have hp := (hB ⟨-1, 0⟩).mpr (Or.inr ⟨0, by decide, hk, rfl⟩) + have h := (hb' _ hp.1 hp.2).mp (bottom (-1) (by decide) (by decide)) + have he : (⟨-1, 0⟩ : GaussianInt) + b = ⟨k, k⟩ := by + ext <;> simp [b] + simpa only [he] using h + have middleL : P ⟨-k, k⟩ := by + have hp := (hC ⟨1, 0⟩).mpr ⟨1, by decide, by omega, Or.inl (by simp)⟩ + have h := (hc' _ hp.1 hp.2).mp (bottom 1 (by decide) (by decide)) + have he : (⟨1, 0⟩ : GaussianInt) + c = ⟨-k, k⟩ := by + ext <;> simp [c] + simpa only [he] using h + have bFirst (j : Int) (hj : 1 ≤ j) (hjk : j ≤ k) : P ⟨-j, j⟩ := by + by_cases he : j = k + · simpa only [he] using middleL + · have hp := (hB ⟨-j, j⟩).mpr (Or.inl ⟨j, hj, hjk, rfl⟩) + exact hH _ (low _ hp.1 (by change j < k; omega)) + have bSecond (j : Int) (hj : 0 ≤ j) (hjk : j < k) : P ⟨-1 - j, j⟩ := by + have hp := (hB ⟨-1 - j, j⟩).mpr (Or.inr ⟨j, hj, hjk, rfl⟩) + exact hH _ (low _ hp.1 hjk) + have cFirst (j : Int) (hj : 1 ≤ j) (hjk : j ≤ k) : P ⟨j, j - 1⟩ := by + have hp := (hC ⟨j, j - 1⟩).mpr ⟨j, hj, hjk, Or.inl rfl⟩ + exact hH _ (low _ hp.1 (by change j - 1 < k; omega)) + have cSecond (j : Int) (hj : 1 ≤ j) (hjk : j ≤ k) : P ⟨j, j⟩ := by + by_cases he : j = k + · simpa only [he] using middleR + · have hp := (hC ⟨j, j⟩).mpr ⟨j, hj, hjk, Or.inr rfl⟩ + exact hH _ (low _ hp.1 (by change j < k; omega)) + intro x hx + by_cases hUa : x.im = 2 * k ∧ -1 ≤ x.re ∧ x.re ≤ 1 + · have he : x = (⟨x.re, 2 * k⟩ : GaussianInt) := by + ext <;> simp [hUa.1] + rw [he] + exact top x.re hUa.2.1 hUa.2.2 + by_cases hUb : + (∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ x = ⟨k + 1 - j, k + j⟩) ∨ + (∃ j : Int, 0 ≤ j ∧ j < k ∧ x = ⟨k - j, k + j⟩) + · rcases hUb with ⟨j, hj, hjk, rfl⟩ | ⟨j, hj, hjk, rfl⟩ + · have hp := (hB ⟨-j, j⟩).mpr (Or.inl ⟨j, hj, hjk, rfl⟩) + have h := (hb' _ hp.1 hp.2).mp (bFirst j hj hjk) + have he : (⟨-j, j⟩ : GaussianInt) + b = ⟨k + 1 - j, k + j⟩ := by + ext <;> simp [b] <;> ring + simpa only [he] using h + · have hp := (hB ⟨-1 - j, j⟩).mpr (Or.inr ⟨j, hj, hjk, rfl⟩) + have h := (hb' _ hp.1 hp.2).mp (bSecond j hj hjk) + have he : (⟨-1 - j, j⟩ : GaussianInt) + b = ⟨k - j, k + j⟩ := by + ext <;> simp [b] <;> ring + simpa only [he] using h + by_cases hUc : + (∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ x = ⟨j - k - 1, k + j - 1⟩) ∨ + (∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ x = ⟨j - k - 1, k + j⟩) + · rcases hUc with ⟨j, hj, hjk, rfl⟩ | ⟨j, hj, hjk, rfl⟩ + · have hp := (hC ⟨j, j - 1⟩).mpr ⟨j, hj, hjk, Or.inl rfl⟩ + have h := (hc' _ hp.1 hp.2).mp (cFirst j hj hjk) + have he : (⟨j, j - 1⟩ : GaussianInt) + c = ⟨j - k - 1, k + j - 1⟩ := by + ext <;> simp [c] <;> ring + simpa only [he] using h + · have hp := (hC ⟨j, j⟩).mpr ⟨j, hj, hjk, Or.inr rfl⟩ + have h := (hc' _ hp.1 hp.2).mp (cSecond j hj hjk) + have he : (⟨j, j⟩ : GaussianInt) + c = ⟨j - k - 1, k + j⟩ := by + ext <;> simp [c] <;> ring + simpa only [he] using h + exact hH x ⟨hx, hUa, hUb, hUc⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4818T1ClosedOverlaps.lean b/LeanPool/ApollonianSuperharmonic/P4818T1ClosedOverlaps.lean new file mode 100644 index 0000000000..0fa6788ceb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4818T1ClosedOverlaps.lean @@ -0,0 +1,174 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P4818T1ClosedOverlaps] + +/-! +# P4818T1ClosedOverlaps + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4818T1ClosedOverlaps (K : DiamondParameter) : + let k : Int := K.1 + let a : GaussianInt := ⟨0, -2 * k⟩ + let b : GaussianInt := ⟨k + 1, k⟩ + let c : GaussianInt := ⟨-k - 1, k⟩ + (∀ (x : GaussianInt) (m n : Int), + x ∈ DiamondVertexDomains K false → + x + m • a + n • b ∈ DiamondVertexDomains K false → + (m = 0 ∧ n = 0) ∨ (m = 1 ∧ n = 0) ∨ (m = -1 ∧ n = 0) ∨ + (m = 0 ∧ n = 1) ∨ (m = 0 ∧ n = -1) ∨ + (m = 1 ∧ n = 1) ∨ (m = -1 ∧ n = -1)) ∧ + (∀ x, (x ∈ DiamondVertexDomains K false ∧ + x + a ∈ DiamondVertexDomains K false) ↔ + ∃ r : Int, -1 ≤ r ∧ r ≤ 1 ∧ x = ⟨r, 2 * k⟩) ∧ + (∀ x, (x ∈ DiamondVertexDomains K false ∧ + x + b ∈ DiamondVertexDomains K false) ↔ + (∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ x = ⟨-j, j⟩) ∨ + (∃ j : Int, 0 ≤ j ∧ j < k ∧ x = ⟨-1 - j, j⟩)) ∧ + (∀ x, (x ∈ DiamondVertexDomains K false ∧ + x + c ∈ DiamondVertexDomains K false) ↔ + ∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ (x = ⟨j, j - 1⟩ ∨ x = ⟨j, j⟩)) := by +-- BODY + change {k : Nat // 0 < k} at K + dsimp only + let k : Int := K.1 + let a : GaussianInt := ⟨0, -2 * k⟩ + let b : GaussianInt := ⟨k + 1, k⟩ + let c : GaussianInt := ⟨-k - 1, k⟩ + have hk : 0 < k := by + dsimp [k] + exact_mod_cast K.2 + have mem (z : GaussianInt) : z ∈ DiamondVertexDomains K false ↔ + -k ≤ z.re ∧ z.re ≤ k ∧ 0 ≤ z.im ∧ z.im ≤ 2 * k ∧ + z.re + z.im ≤ 2 * k + 1 ∧ -z.re + z.im ≤ 2 * k + 1 ∧ + z.re - z.im ≤ 1 ∧ -z.re - z.im ≤ 1 := by + have raw : z ∈ DiamondVertexDomains K false ↔ + z.re.natAbs ≤ K.1 ∧ (z.im - k).natAbs ≤ K.1 ∧ + z.re.natAbs + (z.im - k).natAbs ≤ K.1 + 1 := by + change max z.re.natAbs (max (z.im - k).natAbs + (z.re.natAbs + (z.im - k).natAbs - 1)) ≤ K.1 ↔ _ + simp only [max_le_iff, Nat.sub_le_iff_le_add] + rw [raw] + have h1 := Int.natCast_natAbs z.re + have h2 := Int.natCast_natAbs (z.im - k) + by_cases hr : 0 ≤ z.re <;> by_cases hi : 0 ≤ z.im - k + · rw [abs_of_nonneg hr] at h1 + rw [abs_of_nonneg hi] at h2 + omega + · rw [abs_of_nonneg hr] at h1 + rw [abs_of_neg (by omega : z.im - k < 0)] at h2 + omega + · rw [abs_of_neg (by omega : z.re < 0)] at h1 + rw [abs_of_nonneg hi] at h2 + omega + · rw [abs_of_neg (by omega : z.re < 0)] at h1 + rw [abs_of_neg (by omega : z.im - k < 0)] at h2 + omega + refine ⟨?_, ?_, ?_, ?_⟩ + · intro x m n hx hy + have hx' := (mem x).mp hx + have hy' := (mem (x + m • a + n • b)).mp hy + have hr : (x + m • a + n • b).re = x.re + n * (k + 1) := by + simp [a, b, zsmul_eq_mul] + have hi : (x + m • a + n • b).im = x.im + k * (n - 2 * m) := by + simp [a, b, zsmul_eq_mul] + ring + rw [hr, hi] at hy' + have hnl : -1 ≤ n := by + by_contra hn + have hn' : n ≤ -2 := by omega + have hmul := mul_le_mul_of_nonneg_right hn' (by omega : 0 ≤ k + 1) + nlinarith only [hx'.1, hx'.2.1, hy'.1, hy'.2.1, hmul] + have hnu : n ≤ 1 := by + by_contra hn + have hn' : 2 ≤ n := by omega + have hmul := mul_le_mul_of_nonneg_right hn' (by omega : 0 ≤ k + 1) + nlinarith only [hx'.1, hx'.2.1, hy'.1, hy'.2.1, hmul] + have hvl : -2 ≤ n - 2 * m := by + by_contra hv + have hv' : n - 2 * m ≤ -3 := by omega + have hmul := mul_le_mul_of_nonneg_left hv' hk.le + nlinarith only [hx'.2.2.1, hx'.2.2.2.1, hy'.2.2.1, + hy'.2.2.2.1, hmul, hk] + have hvu : n - 2 * m ≤ 2 := by + by_contra hv + have hv' : 3 ≤ n - 2 * m := by omega + have hmul := mul_le_mul_of_nonneg_left hv' hk.le + nlinarith only [hx'.2.2.1, hx'.2.2.2.1, hy'.2.2.1, + hy'.2.2.2.1, hmul, hk] + omega + · intro x + constructor + · rintro ⟨hx, hy⟩ + have hx' := (mem x).mp hx + have hy' := (mem (x + a)).mp hy + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at hy' + dsimp [a] at hy' + refine ⟨x.re, by omega, by omega, ?_⟩ + ext + · rfl + · change x.im = 2 * k + omega + · rintro ⟨r, hr, hr', rfl⟩ + simp only [mem, Zsqrtd.re_add, Zsqrtd.im_add] + omega + · intro x + constructor + · rintro ⟨hx, hy⟩ + have hx' := (mem x).mp hx + have hy' := (mem (x + b)).mp hy + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at hy' + dsimp [b] at hy' + by_cases he : x.im = -x.re + · left + refine ⟨-x.re, by omega, by omega, ?_⟩ + ext <;> simp [he] + · right + refine ⟨x.im, by omega, by omega, ?_⟩ + ext + · change x.re = -1 - x.im + omega + · rfl + · rintro (⟨j, hj, hjk, rfl⟩ | ⟨j, hj, hjk, rfl⟩) + all_goals + simp only [mem, Zsqrtd.re_add, Zsqrtd.im_add] + omega + · intro x + constructor + · rintro ⟨hx, hy⟩ + have hx' := (mem x).mp hx + have hy' := (mem (x + c)).mp hy + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at hy' + dsimp [c] at hy' + refine ⟨x.re, by omega, by omega, ?_⟩ + by_cases he : x.im = x.re + · right + ext <;> simp [he] + · left + ext + · rfl + · change x.im = x.re - 1 + omega + · rintro ⟨j, hj, hjk, rfl | rfl⟩ + all_goals + simp only [mem, Zsqrtd.re_add, Zsqrtd.im_add] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4818T1HalfOpen.lean b/LeanPool/ApollonianSuperharmonic/P4818T1HalfOpen.lean new file mode 100644 index 0000000000..d4054d3cf3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4818T1HalfOpen.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains + +-- [TABLET NODE: P4818T1HalfOpen] + +/-! +# P4818T1HalfOpen + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a positive integer $k$, let $T_k$ be the closed lattice domain of +`DiamondVertexDomains`. Set +$$ +\begin{aligned} + U_a&=\{(r,2k):-1\le r\le1,\ r\in\mathbb Z\},\\ + U_b&=\{(k+1-j,k+j):1\le j\le k\} + \cup\{(k-j,k+j):0\le j simp [b] <;> ring + rw [he] + simpa only [neg_mul, mul_neg] using first j hj hjk + · have he : (⟨-1 - j, j⟩ : GaussianInt) + b = ⟨k - j, k + j⟩ := by + ext <;> simp [b] <;> ring + rw [he] + have h := second j hj hjk + change _ = k * (-1 - j) + j + k * (k + 1) / 2 + linarith + refine ⟨?_, hb, ?_⟩ + · intro x hx hxa + obtain ⟨r, _, _, rfl⟩ := (hA x).mp ⟨hx, hxa⟩ + have he : (⟨r, 2 * k⟩ : GaussianInt) + a = ⟨r, 0⟩ := by + ext <;> simp [a] + rw [he] + simp only [P4207T1DiamondFormula] + have es : r - 2 * k = r + 2 * -k := by ring + rw [sub_zero, es, P4207T1FloorArithmetic.1 r (-k)] + ring + · intro x hx hxc + let R : GaussianInt → GaussianInt := fun z => ⟨-z.re, z.im⟩ + have hrmem : R x ∈ DiamondVertexDomains K false ∧ + R x + b ∈ DiamondVertexDomains K false := by + apply (hB (R x)).mpr + obtain ⟨j, hj, hjk, he | he⟩ := (hC x).mp ⟨hx, hxc⟩ + · right + refine ⟨j - 1, by omega, by omega, ?_⟩ + rw [he] + ext <;> simp [R]; ring + · left + exact ⟨j, hj, hjk, by rw [he]⟩ + have h := hb (R x) hrmem.1 hrmem.2 + have hR (z : GaussianInt) : P4207T1DiamondFormula (R z) = + P4207T1DiamondFormula z - z.re * z.im := + P4207T1FloorArithmetic.2.2.2.2 z.re z.im + have he : R (x + c) = R x + b := by + ext <;> simp [R, c, b]; ring + rw [← he, hR, hR] at h + dsimp [R, c] at h ⊢ + have hhalf := half (k + 1) + have heven : (k + 1) * (k + 1 - 1) = k * (k + 1) := by ring + rw [heven] at hhalf + nlinarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean b/LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean new file mode 100644 index 0000000000..e99d5d0c9a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean @@ -0,0 +1,730 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4818T1HalfOpen +public import LeanPool.ApollonianSuperharmonic.P4818T1ClosedOverlaps +public import Mathlib.Data.Int.Interval +public import Mathlib.Tactic + +-- [TABLET NODE: P4818T1Representatives] + +/-! +# P4818T1Representatives + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RepresentativesProof + +private theorem hk : + ∀ (K : DiamondParameter), + let k : Int := K.1 + 0 < k := by + classical + intro K k + dsimp [k]; exact_mod_cast K.2 + +private theorem hmem : + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (z : GaussianInt), z ∈ DiamondVertexDomains K false ↔ + -k ≤ z.re ∧ z.re ≤ k ∧ 0 ≤ z.im ∧ z.im ≤ 2 * k ∧ + z.re + z.im ≤ 2 * k + 1 ∧ -z.re + z.im ≤ 2 * k + 1 ∧ + z.re - z.im ≤ 1 ∧ -z.re - z.im ≤ 1 := by + classical + intro K k z + have raw : z ∈ DiamondVertexDomains K false ↔ + z.re.natAbs ≤ K.1 ∧ (z.im - k).natAbs ≤ K.1 ∧ + z.re.natAbs + (z.im - k).natAbs ≤ K.1 + 1 := by + change max z.re.natAbs (max (z.im - k).natAbs + (z.re.natAbs + (z.im - k).natAbs - 1)) ≤ K.1 ↔ _ + simp only [max_le_iff, Nat.sub_le_iff_le_add] + rw [raw] + have h1 := Int.natCast_natAbs z.re + have h2 := Int.natCast_natAbs (z.im - k) + by_cases hr : 0 ≤ z.re <;> by_cases hi : 0 ≤ z.im - k + · rw [abs_of_nonneg hr] at h1 + rw [abs_of_nonneg hi] at h2 + omega + · rw [abs_of_nonneg hr] at h1 + rw [abs_of_neg (by omega : z.im - k < 0)] at h2 + omega + · rw [abs_of_neg (by omega : z.re < 0)] at h1 + rw [abs_of_nonneg hi] at h2 + omega + · rw [abs_of_neg (by omega : z.re < 0)] at h1 + rw [abs_of_neg (by omega : z.im - k < 0)] at h2 + omega + +private theorem hHmem : + ∀ (K : DiamondParameter), ∀ (z : GaussianInt), (z ∈ P4818T1HalfOpen K) → (z ∈ + DiamondVertexDomains K false) := by + classical + intro K z hz + simpa [P4818T1HalfOpen] using hz.1 + +private theorem noA : + ∀ (K : DiamondParameter), + let k : Int := K.1 + let a : GaussianInt := ⟨0, -2 * k⟩ + (∀ (x : GaussianInt), x ∈ DiamondVertexDomains K false ∧ x + ⟨(0 : ℤ), (-2 : ℤ) + * (↑(K.1 : ℕ) : ℤ)⟩ ∈ DiamondVertexDomains K false ↔ ∃ (r : ℤ), (-1 : ℤ) ≤ r ∧ r ≤ (1 : + ℤ) ∧ x = ⟨r, (2 : ℤ) * (↑(K.1 : ℕ) : ℤ)⟩) → ((∀ (z : GaussianInt), (z ∈ + P4818T1HalfOpen K) → (z ∈ DiamondVertexDomains K false)) → (∀ (u : GaussianInt), ∀ (v : + GaussianInt), (u ∈ P4818T1HalfOpen K) → ((v ∈ P4818T1HalfOpen K) → ((v = u + a) → + (False))))) := by + classical + intro K k a hA hHmem u v hu hv hadd + have hu' : u + a ∈ DiamondVertexDomains K false := by + rw [← hadd] + exact hHmem v hv + have hov := (hA u).mp ⟨hHmem u hu, by simpa [a, k] using hu'⟩ + rcases hov with ⟨r, hr, hr', hru⟩ + have hbad := hu + simp only [P4818T1HalfOpen] at hbad + exact hbad.2.1 ⟨by simp [hru], by simpa [hru, k] using hr, + by simpa [hru, k] using hr'⟩ + +private theorem noB : + ∀ (K : DiamondParameter), + let k : Int := K.1 + let b : GaussianInt := ⟨k + 1, k⟩ + (∀ (x : GaussianInt), x ∈ DiamondVertexDomains K false ∧ x + ⟨(↑(K.1 : ℕ) : ℤ) + (1 : + ℤ), (↑(K.1 : ℕ) : ℤ)⟩ ∈ DiamondVertexDomains K false ↔ (∃ (j : ℤ), (1 : ℤ) ≤ j ∧ j + ≤ (↑(K.1 : ℕ) : ℤ) ∧ x = ⟨-j, j⟩) ∨ ∃ (j : ℤ), (0 : ℤ) ≤ j ∧ j < (↑(K.1 : ℕ) + : ℤ) ∧ x = ⟨(-1 : ℤ) - j, j⟩) → ((∀ (z : GaussianInt), (z ∈ + P4818T1HalfOpen K) → (z ∈ DiamondVertexDomains K false)) → (∀ (u : GaussianInt), ∀ (v : + GaussianInt), (u ∈ P4818T1HalfOpen K) → ((v ∈ P4818T1HalfOpen K) → ((v = u + b) → + (False))))) := by + classical + intro K k b hB hHmem u v hu hv hadd + have hu' : u + b ∈ DiamondVertexDomains K false := by + rw [← hadd] + exact hHmem v hv + have hov := (hB u).mp ⟨hHmem u hu, by simpa [b, k] using hu'⟩ + rcases hov with (⟨j, hj, hjk, hsrc⟩ | ⟨j, hj, hjk, hsrc⟩) + · have hdst : v = ⟨k + 1 - j, k + j⟩ := by + rw [hadd, hsrc]; ext <;> simp [b, k] <;> ring + have hbad := hv + simp only [P4818T1HalfOpen] at hbad + exact hbad.2.2.1 (Or.inl ⟨j, hj, hjk, by simpa [k] using hdst⟩) + · have hdst : v = ⟨k - j, k + j⟩ := by + rw [hadd, hsrc]; ext <;> simp [b, k] <;> ring + have hbad := hv + simp only [P4818T1HalfOpen] at hbad + exact hbad.2.2.1 (Or.inr ⟨j, hj, hjk, by simpa [k] using hdst⟩) + +private theorem noC : + ∀ (K : DiamondParameter), + let k : Int := K.1 + let c : GaussianInt := ⟨-k - 1, k⟩ + (∀ (x : GaussianInt), x ∈ DiamondVertexDomains K false ∧ x + ⟨-(↑(K.1 : ℕ) : ℤ) - (1 : + ℤ), (↑(K.1 : ℕ) : ℤ)⟩ ∈ DiamondVertexDomains K false ↔ ∃ (j : ℤ), (1 : ℤ) ≤ j ∧ j ≤ + (↑(K.1 : ℕ) : ℤ) ∧ (x = ⟨j, j - (1 : ℤ)⟩ ∨ x = ⟨j, j⟩)) → ((∀ + (z : GaussianInt), (z ∈ P4818T1HalfOpen K) → (z ∈ DiamondVertexDomains K false)) → (∀ + (u : GaussianInt), ∀ (v : GaussianInt), (u ∈ P4818T1HalfOpen K) → ((v ∈ + P4818T1HalfOpen K) → ((v = u + c) → (False))))) := by + classical + intro K k c hC hHmem u v hu hv hadd + have hu' : u + c ∈ DiamondVertexDomains K false := by + rw [← hadd] + exact hHmem v hv + have hov := (hC u).mp ⟨hHmem u hu, by simpa [c, k] using hu'⟩ + rcases hov with ⟨j, hj, hjk, (hsrc | hsrc)⟩ + · have hdst : v = ⟨j - k - 1, k + j - 1⟩ := by + rw [hadd, hsrc]; ext <;> simp [c, k] <;> ring + have hbad := hv + simp only [P4818T1HalfOpen] at hbad + exact hbad.2.2.2 (Or.inl ⟨j, hj, hjk, by simpa [k] using hdst⟩) + · have hdst : v = ⟨j - k - 1, k + j⟩ := by + rw [hadd, hsrc]; ext <;> simp [c, k] <;> ring + have hbad := hv + simp only [P4818T1HalfOpen] at hbad + exact hbad.2.2.2 (Or.inr ⟨j, hj, hjk, by simpa [k] using hdst⟩) + +private theorem hinj : + ∀ (K : DiamondParameter), + let k : Int := K.1 + let a : GaussianInt := ⟨0, -2 * k⟩ + let b : GaussianInt := ⟨k + 1, k⟩ + let c : GaussianInt := ⟨-k - 1, k⟩ + (∀ (x : GaussianInt), ∀ (m : ℤ), ∀ (n : ℤ), x ∈ DiamondVertexDomains K false → x + m • ⟨(0 : + ℤ), (-2 : ℤ) * (↑(K.1 : ℕ) : ℤ)⟩ + n • ⟨(↑(K.1 : ℕ) : ℤ) + (1 : ℤ), (↑(K.1 : ℕ) : ℤ)⟩ ∈ + DiamondVertexDomains K false → m = (0 : ℤ) ∧ n = (0 : ℤ) ∨ m = + (1 : ℤ) ∧ n = (0 : ℤ) ∨ m = (-1 : ℤ) ∧ n = (0 : ℤ) ∨ m = (0 : ℤ) ∧ n = (1 : ℤ) ∨ m = (0 : + ℤ) ∧ n = (-1 : ℤ) ∨ m = (1 : ℤ) ∧ n = (1 : ℤ) ∨ m = (-1 : ℤ) ∧ n = (-1 : ℤ)) → ((∀ (z : + GaussianInt), (z ∈ P4818T1HalfOpen K) → (z ∈ DiamondVertexDomains K false)) → ((∀ (u : + GaussianInt), ∀ (v : GaussianInt), (u ∈ P4818T1HalfOpen K) → ((v ∈ P4818T1HalfOpen K) + → ((v = u + a) → (False)))) → ((∀ (u : GaussianInt), ∀ (v : GaussianInt), (u ∈ + P4818T1HalfOpen K) → ((v ∈ P4818T1HalfOpen K) → ((v = u + b) → (False)))) → ((∀ (u : + GaussianInt), ∀ (v : GaussianInt), (u ∈ P4818T1HalfOpen K) → ((v ∈ P4818T1HalfOpen K) + → ((v = u + c) → (False)))) → (∀ (h₁ : GaussianInt), ∀ (h₂ : GaussianInt), ∀ (m : Int), ∀ + (n : Int), h₁ ∈ P4818T1HalfOpen K → h₂ ∈ P4818T1HalfOpen K → + h₂ = h₁ + m • a + n • b → m = 0 ∧ n = 0))))) := by + classical + intro K k a b c hcoeff hHmem noA noB noC h₁ h₂ m n hh₁ hh₂ heq + have hcfs := hcoeff h₁ m n (hHmem h₁ hh₁) (by rw [heq.symm]; exact hHmem h₂ hh₂) + rcases hcfs with hz | hz | hz | hz | hz | hz | hz + · exact hz + · rcases hz with ⟨rfl, rfl⟩ + exfalso + apply noA h₁ h₂ hh₁ hh₂ + simpa [a, b] using heq + · rcases hz with ⟨hm, hn⟩ + subst m; subst n + exfalso + have hadd : h₁ = h₂ + a := by rw [heq]; simp [a, b] + exact noA h₂ h₁ hh₂ hh₁ hadd + · rcases hz with ⟨hm, hn⟩ + subst m; subst n + exfalso + have hadd : h₂ = h₁ + b := by simpa [a, b] using heq + exact noB h₁ h₂ hh₁ hh₂ hadd + · rcases hz with ⟨hm, hn⟩ + subst m; subst n + exfalso + have hadd : h₁ = h₂ + b := by rw [heq]; simp [a, b] + exact noB h₂ h₁ hh₂ hh₁ hadd + · rcases hz with ⟨hm, hn⟩ + subst m; subst n + exfalso + have habc : a + b = -c := by ext <;> simp [a, b, c] <;> ring + have hsum : a + b + c = 0 := by rw [habc]; simp + have hsum' : a + (b + c) = 0 := by simpa [add_assoc] using hsum + have hadd : h₁ = h₂ + c := by + calc + h₁ = h₁ + (a + (b + c)) := by rw [hsum']; simp + _ = h₂ + c := by + rw [heq] + simp only [one_zsmul] + abel + exact noC h₂ h₁ hh₂ hh₁ hadd + · rcases hz with ⟨hm, hn⟩ + subst m; subst n + exfalso + have habc : a + b = -c := by ext <;> simp [a, b, c] <;> ring + have hadd : h₂ = h₁ + c := by + calc + h₂ = h₁ + (-a) + (-b) := by simpa [a, b] using heq + _ = h₁ + c := by + have hc : -a - b = c := by calc + -a - b = -(a + b) := by abel + _ = -(-c) := by rw [habc] + _ = c := by simp + calc + h₁ + (-a) + (-b) = h₁ + (-a - b) := by abel + _ = h₁ + c := by rw [hc] + exact noC h₁ h₂ hh₁ hh₂ hadd + +private theorem rectMem : + ∀ (K : DiamondParameter), + let k : Int := K.1 + (∀ (z : GaussianInt), z ∈ DiamondVertexDomains K false ↔ -k ≤ z.re ∧ z.re ≤ k ∧ 0 ≤ z.im ∧ + z.im ≤ 2 * k ∧ z.re + z.im ≤ 2 * k + 1 ∧ -z.re + z.im ≤ 2 * k + 1 ∧ z.re - z.im ≤ 1 ∧ + -z.re - z.im ≤ 1) → (∀ (u : Int), ∀ (v : Int), (0 ≤ u) → ((u ≤ k) → ((0 ≤ v) → ((v < 2 * + k) → ((⟨u, v⟩ : GaussianInt) ∈ DiamondVertexDomains K false ↔ + u + v ≤ 2 * k + 1 ∧ u - v ≤ 1))))) := by + classical + intro K k hmem u v hu0 huk hv0 hvk + rw [hmem] + simp only [] + constructor <;> intro hh <;> omega + +private theorem inHalf : + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (z : GaussianInt), (z ∈ DiamondVertexDomains K false) → ((¬ (z.im = 2 * k ∧ -1 ≤ z.re ∧ + z.re ≤ 1)) → ((¬ ((∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ z = ⟨k + 1 - j, k + j⟩) ∨ + (∃ j : Int, 0 ≤ j ∧ j < k ∧ z = ⟨k - j, k + j⟩))) → ((¬ ((∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ z = + ⟨j - k - 1, k + j - 1⟩) ∨ + (∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ z = ⟨j - k - 1, k + j⟩))) → (z ∈ P4818T1HalfOpen K)))) := by + classical + intro K k z hz hnotA hnotB hnotC + change z ∈ DiamondVertexDomains K false ∧ _ ∧ _ ∧ _ + exact ⟨hz, hnotA, hnotB, hnotC⟩ + +private theorem hr0 : + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (x : GaussianInt), + let r : Int := x.re % (k + 1) + 0 ≤ r := by + classical + intro K k x r + dsimp [r] + exact Int.emod_nonneg _ (by omega) + +private theorem hrlt : + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (x : GaussianInt), + let r : Int := x.re % (k + 1) + r < k + 1 := by + classical + intro K k x r + have hk : 0 < k := RepresentativesProof.hk K + dsimp [r] + exact Int.emod_lt_of_pos _ (by omega) + +private theorem hs0 : + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (x : GaussianInt), + let n : Int := x.re / (k + 1) + let s : Int := (x.im - k * n) % (2 * k) + 0 ≤ s := by + classical + intro K k x n s + have hk : 0 < k := RepresentativesProof.hk K + dsimp [s] + exact Int.emod_nonneg _ (by omega) + +private theorem hslt : + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (x : GaussianInt), + let n : Int := x.re / (k + 1) + let s : Int := (x.im - k * n) % (2 * k) + s < 2 * k := by + classical + intro K k x n s + have hk : 0 < k := RepresentativesProof.hk K + dsimp [s] + exact Int.emod_lt_of_pos _ (by omega) + +private theorem hre : + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (x : GaussianInt), + let n : Int := x.re / (k + 1) + let r : Int := x.re % (k + 1) + x.re = r + n * (k + 1) := by + classical + intro K k x n r + calc + x.re = x.re % (k + 1) + (k + 1) * (x.re / (k + 1)) := + (Int.emod_add_mul_ediv x.re (k + 1)).symm + _ = r + n * (k + 1) := by simp [r, n]; ring + +private theorem him : + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (x : GaussianInt), + let n : Int := x.re / (k + 1) + let q : Int := (x.im - k * n) / (2 * k) + let s : Int := (x.im - k * n) % (2 * k) + x.im = s + 2 * k * q + k * n := by + classical + intro K k x n q s + have hq : s + 2 * k * q = x.im - k * n := by + simpa [s, q] using Int.emod_add_mul_ediv (x.im - k * n) (2 * k) + nlinarith + +private theorem hxrep : + ∀ (K : DiamondParameter), + let k : Int := K.1 + let a : GaussianInt := ⟨0, -2 * k⟩ + let b : GaussianInt := ⟨k + 1, k⟩ + ∀ (x : GaussianInt), + let n : Int := x.re / (k + 1) + let r : Int := x.re % (k + 1) + let q : Int := (x.im - k * n) / (2 * k) + let s : Int := (x.im - k * n) % (2 * k) + (x.re = r + n * (k + 1)) → ((x.im = s + 2 * k * q + k * n) → ( + let h : GaussianInt := ⟨r, s⟩ + x = h + (-q) • a + n • b)) := by + classical + intro K k a b x n r q s hre him h + ext + · simp [h, a, b, zsmul_eq_mul, hre] + · simp [h, a, b, zsmul_eq_mul, him] + ring + +private theorem hrectBounds : + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (x : GaussianInt), + let n : Int := x.re / (k + 1) + let r : Int := x.re % (k + 1) + let q : Int := (x.im - k * n) / (2 * k) + let s : Int := (x.im - k * n) % (2 * k) + (0 ≤ r) → ((r < k + 1) → ((0 ≤ s) → ((s < 2 * k) → ((x.re = r + n * (k + 1)) → ((x.im = s + 2 + * k * q + k * n) → (0 ≤ r ∧ r ≤ k ∧ 0 ≤ s ∧ s < 2 * k)))))) := by + classical + intro K k x n r q s hr0 hrlt hs0 hslt hre him + omega + +private theorem hex : + ∀ (K : DiamondParameter), + let k : Int := K.1 + let a : GaussianInt := ⟨0, -2 * k⟩ + let b : GaussianInt := ⟨k + 1, k⟩ + (∀ (x : GaussianInt), x ∈ DiamondVertexDomains K false ∧ x + ⟨(↑(K.1 : ℕ) : ℤ) + (1 : + ℤ), (↑(K.1 : ℕ) : ℤ)⟩ ∈ DiamondVertexDomains K false ↔ (∃ (j : ℤ), (1 : ℤ) ≤ j ∧ j + ≤ (↑(K.1 : ℕ) : ℤ) ∧ x = ⟨-j, j⟩) ∨ ∃ (j : ℤ), (0 : ℤ) ≤ j ∧ j < (↑(K.1 : ℕ) + : ℤ) ∧ x = ⟨(-1 : ℤ) - j, j⟩) → ((∀ (z : GaussianInt), z ∈ + DiamondVertexDomains K false ↔ -k ≤ z.re ∧ z.re ≤ k ∧ 0 ≤ z.im ∧ z.im ≤ 2 * k ∧ z.re + + z.im ≤ 2 * k + 1 ∧ -z.re + z.im ≤ 2 * k + 1 ∧ z.re - z.im ≤ 1 ∧ -z.re - z.im ≤ 1) → ((∀ + (u : Int), ∀ (v : Int), (0 ≤ u) → ((u ≤ k) → ((0 ≤ v) → ((v < 2 * k) → ((⟨u, v⟩ : + GaussianInt) ∈ DiamondVertexDomains K false ↔ u + v ≤ 2 * k + 1 ∧ u - v ≤ 1))))) → ((∀ (z + : GaussianInt), (z ∈ DiamondVertexDomains K false) → ((¬ (z.im = 2 * k ∧ -1 ≤ z.re ∧ z.re + ≤ 1)) → ((¬ ((∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ z = ⟨k + 1 - j, k + j⟩) ∨ (∃ j : Int, 0 ≤ j ∧ j + < k ∧ z = ⟨k - j, k + j⟩))) → ((¬ ((∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ z = ⟨j - k - 1, k + j - + 1⟩) ∨ (∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ z = ⟨j - k - 1, k + j⟩))) → (z ∈ P4818T1HalfOpen + K))))) → (∀ (x : GaussianInt), + let n : Int := x.re / (k + 1) + let r : Int := x.re % (k + 1) + let q : Int := (x.im - k * n) / (2 * k) + let s : Int := (x.im - k * n) % (2 * k) + (0 ≤ r) → ((r < k + 1) → ((0 ≤ s) → ((s < 2 * k) → ((x.re = r + n * (k + 1)) → ((x.im = s + 2 + * k * q + k * n) → ( + let h : GaussianInt := ⟨r, s⟩ + (x = h + (-q) • a + n • b) → ((0 ≤ r ∧ r ≤ k ∧ 0 ≤ s ∧ s < 2 * k) → (∃ p : GaussianInt × (Int + × Int), + p.1 ∈ P4818T1HalfOpen K ∧ + x = p.1 + p.2.1 • a + p.2.2 • b)))))))))))) := by + classical + intro K k a b hB hmem rectMem inHalf x n r q s hr0 hrlt hs0 hslt hre him h hxrep hrectBounds + by_cases hdiamond : r + s ≤ 2 * k + 1 ∧ r - s ≤ 1 + · have hT : h ∈ DiamondVertexDomains K false := by + exact (rectMem r s hrectBounds.1 hrectBounds.2.1 hrectBounds.2.2.1 hrectBounds.2.2.2).2 + hdiamond + by_cases hdel : + (∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ h = ⟨k + 1 - j, k + j⟩) ∨ + (∃ j : Int, 0 ≤ j ∧ j < k ∧ h = ⟨k - j, k + j⟩) + · rcases hdel with (⟨j, hj, hjk, he⟩ | ⟨j, hj, hjk, he⟩) + · let h' : GaussianInt := ⟨-j, j⟩ + have h'b : h = h' + b := by rw [he]; ext <;> simp [h', b] <;> ring + have h'T : h' ∈ DiamondVertexDomains K false := by + have hlist := (hB h').mpr (Or.inl ⟨j, hj, hjk, rfl⟩) + exact hlist.1 + have hjlt : j < k := by + have hi := congrArg Zsqrtd.im he + simp [h] at hi + omega + have h'notA : ¬ (h'.im = 2 * k ∧ -1 ≤ h'.re ∧ h'.re ≤ 1) := by + simp [h'] + omega + have h'notB : ¬ ((∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ h' = ⟨k + 1 - j, k + j⟩) ∨ + (∃ j : Int, 0 ≤ j ∧ j < k ∧ h' = ⟨k - j, k + j⟩)) := by + intro hh + rcases hh with (⟨l, hl, hlk, heq⟩ | ⟨l, hl, hlk, heq⟩) + · have hre' := congrArg Zsqrtd.re heq + simp [h'] at hre' + omega + · have hre' := congrArg Zsqrtd.re heq + simp [h'] at hre' + omega + have h'notC : ¬ ((∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ h' = ⟨j - k - 1, k + j - 1⟩) ∨ + (∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ h' = ⟨j - k - 1, k + j⟩)) := by + intro hh + rcases hh with (⟨l, hl, hlk, heq⟩ | ⟨l, hl, hlk, heq⟩) + · have him' := congrArg Zsqrtd.im heq + simp [h'] at him' + omega + · have him' := congrArg Zsqrtd.im heq + simp [h'] at him' + omega + refine ⟨Prod.mk h' (Prod.mk (-q) (n + 1)), ?_⟩ + constructor + · exact inHalf h' h'T h'notA h'notB h'notC + · rw [hxrep, h'b] + simp only [add_zsmul, one_zsmul] + abel + · let h' : GaussianInt := ⟨-1 - j, j⟩ + have h'b : h = h' + b := by rw [he]; ext <;> simp [h', b] <;> ring + have h'T : h' ∈ DiamondVertexDomains K false := by + have hlist := (hB h').mpr (Or.inr ⟨j, hj, hjk, rfl⟩) + exact hlist.1 + have h'notA : ¬ (h'.im = 2 * k ∧ -1 ≤ h'.re ∧ h'.re ≤ 1) := by + simp [h'] + omega + have h'notB : ¬ ((∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ h' = ⟨k + 1 - j, k + j⟩) ∨ + (∃ j : Int, 0 ≤ j ∧ j < k ∧ h' = ⟨k - j, k + j⟩)) := by + intro hh + rcases hh with (⟨l, hl, hlk, heq⟩ | ⟨l, hl, hlk, heq⟩) + · have hre' := congrArg Zsqrtd.re heq + simp [h'] at hre' + omega + · have hre' := congrArg Zsqrtd.re heq + simp [h'] at hre' + omega + have h'notC : ¬ ((∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ h' = ⟨j - k - 1, k + j - 1⟩) ∨ + (∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ h' = ⟨j - k - 1, k + j⟩)) := by + intro hh + rcases hh with (⟨l, hl, hlk, heq⟩ | ⟨l, hl, hlk, heq⟩) + · have him' := congrArg Zsqrtd.im heq + simp [h'] at him' + omega + · have him' := congrArg Zsqrtd.im heq + simp [h'] at him' + omega + refine ⟨Prod.mk h' (Prod.mk (-q) (n + 1)), ?_⟩ + constructor + · exact inHalf h' h'T h'notA h'notB h'notC + · rw [hxrep, h'b] + simp only [add_zsmul, one_zsmul] + abel + · have hnotA : ¬ (h.im = 2 * k ∧ -1 ≤ h.re ∧ h.re ≤ 1) := by + simp [h] + omega + have hnotC : ¬ ((∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ h = ⟨j - k - 1, k + j - 1⟩) ∨ + (∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ h = ⟨j - k - 1, k + j⟩)) := by + intro hh + rcases hh with (⟨l, hl, hlk, heq⟩ | ⟨l, hl, hlk, heq⟩) + · have hre' := congrArg Zsqrtd.re heq + simp [h] at hre' + omega + · have hre' := congrArg Zsqrtd.re heq + simp [h] at hre' + omega + refine ⟨Prod.mk h (Prod.mk (-q) n), ?_⟩ + constructor + · exact inHalf h hT hnotA hdel hnotC + · exact hxrep + · by_cases hsk : k ≤ s + · have hsum : 2 * k + 1 < r + s := by omega + let h' : GaussianInt := ⟨r - k - 1, s - k⟩ + have h'T : h' ∈ DiamondVertexDomains K false := by + apply (hmem h').2 + simp [h'] + omega + have h'notA : ¬ (h'.im = 2 * k ∧ -1 ≤ h'.re ∧ h'.re ≤ 1) := by + simp [h'] + omega + have h'notB : ¬ ((∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ h' = ⟨k + 1 - j, k + j⟩) ∨ + (∃ j : Int, 0 ≤ j ∧ j < k ∧ h' = ⟨k - j, k + j⟩)) := by + intro hh + rcases hh with (⟨l, hl, hlk, heq⟩ | ⟨l, hl, hlk, heq⟩) + · have hre' := congrArg Zsqrtd.re heq + simp [h'] at hre' + omega + · have hre' := congrArg Zsqrtd.re heq + simp [h'] at hre' + omega + have h'notC : ¬ ((∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ h' = ⟨j - k - 1, k + j - 1⟩) ∨ + (∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ h' = ⟨j - k - 1, k + j⟩)) := by + simp [h'] + omega + have h'b : h = h' + b := by ext <;> simp [h, h', b] + refine ⟨Prod.mk h' (Prod.mk (-q) (n + 1)), ?_⟩ + constructor + · exact inHalf h' h'T h'notA h'notB h'notC + · rw [hxrep, h'b] + simp only [add_zsmul, one_zsmul] + abel + · have hlow : s < k := by omega + have hdiff : 1 < r - s := by omega + let h' : GaussianInt := ⟨r - k - 1, s + k⟩ + have h'T : h' ∈ DiamondVertexDomains K false := by + apply (hmem h').2 + simp [h'] + omega + have h'notA : ¬ (h'.im = 2 * k ∧ -1 ≤ h'.re ∧ h'.re ≤ 1) := by + simp [h'] + omega + have h'notB : ¬ ((∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ h' = ⟨k + 1 - j, k + j⟩) ∨ + (∃ j : Int, 0 ≤ j ∧ j < k ∧ h' = ⟨k - j, k + j⟩)) := by + intro hh + rcases hh with (⟨l, hl, hlk, heq⟩ | ⟨l, hl, hlk, heq⟩) + · have hre' := congrArg Zsqrtd.re heq + simp [h'] at hre' + omega + · have hre' := congrArg Zsqrtd.re heq + simp [h'] at hre' + omega + have h'notC : ¬ ((∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ h' = ⟨j - k - 1, k + j - 1⟩) ∨ + (∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ h' = ⟨j - k - 1, k + j⟩)) := by + intro hh + rcases hh with (⟨l, hl, hlk, heq⟩ | ⟨l, hl, hlk, heq⟩) + · have him' := congrArg Zsqrtd.im heq + have hre' := congrArg Zsqrtd.re heq + simp [h'] at him' + simp [h'] at hre' + omega + · have him' := congrArg Zsqrtd.im heq + have hre' := congrArg Zsqrtd.re heq + simp [h'] at him' + simp [h'] at hre' + omega + have h'b : h = h' + a + b := by ext <;> simp [h, h', a, b]; ring + refine ⟨Prod.mk h' (Prod.mk (-q + 1) (n + 1)), ?_⟩ + constructor + · exact inHalf h' h'T h'notA h'notB h'notC + · rw [hxrep, h'b] + simp only [zsmul_eq_mul] + push_cast + ring + +private theorem hrel : + ∀ (K : DiamondParameter), + let k : Int := K.1 + let a : GaussianInt := ⟨0, -2 * k⟩ + let b : GaussianInt := ⟨k + 1, k⟩ + ∀ (x : GaussianInt), ∀ (p : GaussianInt × ℤ × ℤ), (p.1 ∈ P4818T1HalfOpen K ∧ x = p.1 + + p.2.1 • a + p.2.2 • b) → (∀ (p' : GaussianInt × ℤ × ℤ), (p'.1 ∈ P4818T1HalfOpen K ∧ x = + p'.1 + p'.2.1 • ⟨(0 : ℤ), (-2 : ℤ) * (↑(K.1 : ℕ) : ℤ)⟩ + p'.2.2 • ⟨(↑(K.1 : ℕ) : ℤ) + (1 + : ℤ), (↑(K.1 : ℕ) : ℤ)⟩) → (p.1 + p.2.1 • a + p.2.2 • b = + p'.1 + p'.2.1 • a + p'.2.2 • b)) := by + classical + intro K k a b x p hp p' hp' + exact hp.2.symm.trans hp'.2 + +private theorem hrepr : + ∀ (K : DiamondParameter), + let k : Int := K.1 + let a : GaussianInt := ⟨0, -2 * k⟩ + let b : GaussianInt := ⟨k + 1, k⟩ + ∀ (p : GaussianInt × ℤ × ℤ), ∀ (p' : GaussianInt × ℤ × ℤ), (p.1 + p.2.1 • a + p.2.2 • b = + p'.1 + p'.2.1 • a + p'.2.2 • b) → (p'.1 = p.1 + (p.2.1 - p'.2.1) • a + (p.2.2 - p'.2.2) • + b) := by + classical + intro K k a b p p' hrel + calc + p'.1 = p.1 + p.2.1 • a + p.2.2 • b - p'.2.1 • a - p'.2.2 • b := by + rw [hrel] + abel + _ = p.1 + (p.2.1 - p'.2.1) • a + (p.2.2 - p'.2.2) • b := by + rw [sub_zsmul, sub_zsmul] + abel + +private theorem hcAt488 : + ∀ (K : DiamondParameter), + let k : Int := K.1 + let a : GaussianInt := ⟨0, -2 * k⟩ + let b : GaussianInt := ⟨k + 1, k⟩ + (∀ (h₁ : GaussianInt), ∀ (h₂ : GaussianInt), ∀ (m : Int), ∀ (n : Int), h₁ ∈ P4818T1HalfOpen + K → h₂ ∈ P4818T1HalfOpen K → h₂ = h₁ + m • a + n • b → m = 0 ∧ n = 0) → (∀ (x : + GaussianInt), ∀ (p : GaussianInt × ℤ × ℤ), (p.1 ∈ P4818T1HalfOpen K ∧ x = p.1 + p.2.1 • + a + p.2.2 • b) → (∀ (p' : GaussianInt × ℤ × ℤ), (p'.1 ∈ P4818T1HalfOpen K ∧ x = p'.1 + + p'.2.1 • ⟨(0 : ℤ), (-2 : ℤ) * (↑(K.1 : ℕ) : ℤ)⟩ + p'.2.2 • ⟨(↑(K.1 : + ℕ) : ℤ) + (1 : ℤ), (↑(K.1 : ℕ) : ℤ)⟩) → ((p'.1 = p.1 + (p.2.1 - p'.2.1) • a + + (p.2.2 - p'.2.2) • b) → (p.2.1 - p'.2.1 = (0 : ℤ) ∧ p.2.2 - p'.2.2 = (0 : ℤ))))) := by + classical + intro K k a b hinj x p hp p' hp' hrepr + exact hinj p.1 p'.1 (p.2.1 - p'.2.1) (p.2.2 - p'.2.2) + hp.1 hp'.1 hrepr + +private theorem hm' : + (DiamondParameter) → ((GaussianInt) → (∀ (p : GaussianInt × ℤ × ℤ), ∀ (p' : GaussianInt × ℤ × + ℤ), (p.2.1 - p'.2.1 = (0 : ℤ)) → (p.2.1 = p'.2.1))) := by + classical + intro K x p p' hm + omega + +private theorem hn' : + (DiamondParameter) → ((GaussianInt) → (∀ (p : GaussianInt × ℤ × ℤ), ∀ (p' : GaussianInt × ℤ × + ℤ), (p.2.2 - p'.2.2 = (0 : ℤ)) → (p.2.2 = p'.2.2))) := by + classical + intro K x p p' hn + omega + +private theorem hpoint : + ∀ (K : DiamondParameter), + let k : Int := K.1 + let a : GaussianInt := ⟨0, -2 * k⟩ + let b : GaussianInt := ⟨k + 1, k⟩ + ∀ (p : GaussianInt × ℤ × ℤ), ∀ (p' : GaussianInt × ℤ × ℤ), (p.1 + p.2.1 • a + p.2.2 • b = + p'.1 + p'.2.1 • a + p'.2.2 • b) → ((p.2.1 = p'.2.1) → ((p.2.2 = p'.2.2) → (p.1 = p'.1))) + := by + classical + intro K k a b p p' hrel hm' hn' + have hrel' := hrel + rw [hm', hn'] at hrel' + exact add_right_cancel (add_right_cancel hrel') + +end RepresentativesProof + +theorem P4818T1Representatives (K : DiamondParameter) : + let k : Int := K.1 + let a : GaussianInt := ⟨0, -2 * k⟩ + let b : GaussianInt := ⟨k + 1, k⟩ + ∀ x : GaussianInt, ∃! p : GaussianInt × (Int × Int), + p.1 ∈ P4818T1HalfOpen K ∧ x = p.1 + p.2.1 • a + p.2.2 • b := by +-- BODY + classical + change {k : Nat // 0 < k} at K + dsimp only + let k : Int := K.1 + let a : GaussianInt := ⟨0, -2 * k⟩ + let b : GaussianInt := ⟨k + 1, k⟩ + let c : GaussianInt := ⟨-k - 1, k⟩ + have hk : 0 < k := RepresentativesProof.hk K + obtain ⟨hcoeff, hA, hB, hC⟩ := P4818T1ClosedOverlaps K + have hmem (z : GaussianInt) : z ∈ DiamondVertexDomains K false ↔ + -k ≤ z.re ∧ z.re ≤ k ∧ 0 ≤ z.im ∧ z.im ≤ 2 * k ∧ + z.re + z.im ≤ 2 * k + 1 ∧ -z.re + z.im ≤ 2 * k + 1 ∧ + z.re - z.im ≤ 1 ∧ -z.re - z.im ≤ 1 := RepresentativesProof.hmem K z + have hHmem (z : GaussianInt) (hz : z ∈ P4818T1HalfOpen K) : + z ∈ DiamondVertexDomains K false := RepresentativesProof.hHmem K z hz + have noA (u v : GaussianInt) (hu : u ∈ P4818T1HalfOpen K) + (hv : v ∈ P4818T1HalfOpen K) (hadd : v = u + a) : False := RepresentativesProof.noA K hA + hHmem u v hu hv hadd + have noB (u v : GaussianInt) (hu : u ∈ P4818T1HalfOpen K) + (hv : v ∈ P4818T1HalfOpen K) (hadd : v = u + b) : False := RepresentativesProof.noB K hB + hHmem u v hu hv hadd + have noC (u v : GaussianInt) (hu : u ∈ P4818T1HalfOpen K) + (hv : v ∈ P4818T1HalfOpen K) (hadd : v = u + c) : False := RepresentativesProof.noC K hC + hHmem u v hu hv hadd + have hinj : ∀ (h₁ h₂ : GaussianInt) (m n : Int), + h₁ ∈ P4818T1HalfOpen K → h₂ ∈ P4818T1HalfOpen K → + h₂ = h₁ + m • a + n • b → m = 0 ∧ n = 0 := RepresentativesProof.hinj K hcoeff hHmem noA noB + noC + have rectMem (u v : Int) (hu0 : 0 ≤ u) (huk : u ≤ k) + (hv0 : 0 ≤ v) (hvk : v < 2 * k) : + (⟨u, v⟩ : GaussianInt) ∈ DiamondVertexDomains K false ↔ + u + v ≤ 2 * k + 1 ∧ u - v ≤ 1 := RepresentativesProof.rectMem K hmem u v hu0 huk hv0 hvk + have inHalf (z : GaussianInt) (hz : z ∈ DiamondVertexDomains K false) + (hnotA : ¬ (z.im = 2 * k ∧ -1 ≤ z.re ∧ z.re ≤ 1)) + (hnotB : ¬ ((∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ z = ⟨k + 1 - j, k + j⟩) ∨ + (∃ j : Int, 0 ≤ j ∧ j < k ∧ z = ⟨k - j, k + j⟩))) + (hnotC : ¬ ((∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ z = ⟨j - k - 1, k + j - 1⟩) ∨ + (∃ j : Int, 1 ≤ j ∧ j ≤ k ∧ z = ⟨j - k - 1, k + j⟩))) : + z ∈ P4818T1HalfOpen K := RepresentativesProof.inHalf K z hz hnotA hnotB hnotC + intro x + let n : Int := x.re / (k + 1) + let r : Int := x.re % (k + 1) + let q : Int := (x.im - k * n) / (2 * k) + let s : Int := (x.im - k * n) % (2 * k) + have hr0 : 0 ≤ r := RepresentativesProof.hr0 K x + have hrlt : r < k + 1 := RepresentativesProof.hrlt K x + have hs0 : 0 ≤ s := RepresentativesProof.hs0 K x + have hslt : s < 2 * k := RepresentativesProof.hslt K x + have hre : x.re = r + n * (k + 1) := RepresentativesProof.hre K x + have him : x.im = s + 2 * k * q + k * n := RepresentativesProof.him K x + let h : GaussianInt := ⟨r, s⟩ + have hxrep : x = h + (-q) • a + n • b := RepresentativesProof.hxrep K x hre him + have hrectBounds : 0 ≤ r ∧ r ≤ k ∧ 0 ≤ s ∧ s < 2 * k := RepresentativesProof.hrectBounds K x + hr0 hrlt hs0 hslt hre him + have hex : ∃ p : GaussianInt × (Int × Int), + p.1 ∈ P4818T1HalfOpen K ∧ + x = p.1 + p.2.1 • a + p.2.2 • b := RepresentativesProof.hex K hB hmem rectMem inHalf x + hr0 hrlt hs0 hslt hre him hxrep hrectBounds + rcases hex with ⟨p, hp⟩ + refine ⟨p, hp, ?_⟩ + intro p' hp' + have hrel : p.1 + p.2.1 • a + p.2.2 • b = + p'.1 + p'.2.1 • a + p'.2.2 • b := RepresentativesProof.hrel K x p hp p' hp' + have hrepr : p'.1 = p.1 + (p.2.1 - p'.2.1) • a + (p.2.2 - p'.2.2) • b := + RepresentativesProof.hrepr K p p' hrel + have hc := RepresentativesProof.hcAt488 K hinj x p hp p' hp' hrepr + rcases hc with ⟨hm, hn⟩ + have hm' : p.2.1 = p'.2.1 := RepresentativesProof.hm' K x p p' hm + have hn' : p.2.2 = p'.2.2 := RepresentativesProof.hn' K x p p' hn + have hpoint : p.1 = p'.1 := RepresentativesProof.hpoint K p p' hrel hm' hn' + apply Prod.ext + · exact hpoint.symm + · apply Prod.ext <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean b/LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean new file mode 100644 index 0000000000..e741219111 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean @@ -0,0 +1,1059 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4828T1Gap +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Analysis.Complex.Norm +public import Mathlib.Topology.MetricSpace.Lipschitz + +-- [TABLET NODE: P4828T1CircularPlacement] + +/-! +# P4828T1CircularPlacement + +Adapted from Wesley Pegden’s Apache - 2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CircularPlacementConstruction + +private theorem hchild (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) : 0 < (q 0).1 + := by + classical + exact (ProperBandCurvatureStructure q hq).1 + +private theorem hcpos (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (hpositive : ∀ + j : Fin 3, 0 < (q j.succ).1) : ∀ i : Fin 4, 0 < (q i).1 := by + classical + have hchild : 0 < (q 0).1 := hchild q hq + intro i + fin_cases i + · exact hchild + · exact hpositive 0 + · exact hpositive 1 + · exact hpositive 2 + +private theorem normCast (w : GaussianInt) : + Complex.normSq (w : Complex) = (Zsqrtd.norm w : Real) := by + classical + simp [Complex.normSq, Zsqrtd.norm_def] + +private theorem circleDist (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (i j : + Fin 4) (hij : i ≠ j) + (hi : 0 < (q i).1) (hj : 0 < (q j).1) : + dist (((q i).2 : Complex) / (q i).1) + (((q j).2 : Complex) / (q j).1) = + 1 / (q i).1 + 1 / (q j).1 := by + classical + have normCast (w : GaussianInt) : + Complex.normSq (w : Complex) = (Zsqrtd.norm w : Real) := normCast w + let v : GaussianInt := (q j).1 • (q i).2 - (q i).1 • (q j).2 + have ht := TangencyCoordinateIdentity q hq.1 i j hij + have hn : Complex.normSq (v : Complex) = + (((q i).1 + (q j).1 : ℤ) ^ 2 : Real) := by + change Complex.normSq + (((q j).1 • (q i).2 - (q i).1 • (q j).2 : GaussianInt) : Complex) = _ + rw [normCast] + exact_mod_cast ht + have hnsq : ‖(v : Complex)‖ ^ 2 = + (((q i).1 + (q j).1 : ℤ) : Real) ^ 2 := by + rw [← Complex.normSq_eq_norm_sq, hn] + have hnorm : ‖(v : Complex)‖ = + (((q i).1 + (q j).1 : ℤ) : Real) := by + have hnonneg := norm_nonneg (v : Complex) + have hsum : 0 ≤ (((q i).1 + (q j).1 : ℤ) : Real) := by positivity + nlinarith + have hdiff : + ((q i).2 : Complex) / (q i).1 - ((q j).2 : Complex) / (q j).1 = + (v : Complex) / (((q i).1 * (q j).1 : ℤ) : Complex) := by + dsimp [v] + push_cast + simp only [map_sub, map_zsmul] + have hia : (q i).1 ≠ 0 := ne_of_gt hi + have hjb : (q j).1 ≠ 0 := ne_of_gt hj + field_simp [hia, hjb] + ring + rw [Complex.dist_eq, hdiff, Complex.norm_div, Complex.norm_intCast, hnorm] + have ha : 0 < ((q i).1 : Real) := by exact_mod_cast hi + have hb : 0 < ((q j).1 : Real) := by exact_mod_cast hj + have hab : 0 < (((q i).1 * (q j).1 : ℤ) : Real) := by + exact_mod_cast mul_pos hi hj + rw [abs_of_pos hab] + push_cast + field_simp [ne_of_gt ha, ne_of_gt hb] + ring + +private noncomputable abbrev ctr (q : Fin 4 → CircleCoordinates) (i : Fin 4) : Complex := by + classical + exact ((q i).2 : Complex) / (q i).1 + +private noncomputable abbrev rad (q : Fin 4 → CircleCoordinates) (i : Fin 4) : Real := by + classical + exact 1 / (q i).1 + +private theorem rpos (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (hpositive : ∀ + j : Fin 3, 0 < (q j.succ).1) (i : Fin 4) : 0 < (rad q) i := by + classical + have hcpos : ∀ i : Fin 4, 0 < (q i).1 := hcpos q hq hpositive + let rad (i : Fin 4) : Real := 1 / (q i).1 + change (0 < rad i) + dsimp [rad] + have hi : 0 < ((q i).1 : Real) := by exact_mod_cast hcpos i + exact one_div_pos.mpr hi + +private theorem ctrDist (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (hpositive : + ∀ j : Fin 3, 0 < (q j.succ).1) (i j : Fin 4) (hij : i ≠ j) : + dist ((ctr q) i) ((ctr q) j) = (rad q) i + (rad q) j := by + classical + have hcpos : ∀ i : Fin 4, 0 < (q i).1 := hcpos q hq hpositive + have circleDist (i j : Fin 4) (hij : i ≠ j) + (hi : 0 < (q i).1) (hj : 0 < (q j).1) : + dist (((q i).2 : Complex) / (q i).1) + (((q j).2 : Complex) / (q j).1) = + 1 / (q i).1 + 1 / (q j).1 := circleDist q hq i j hij hi hj + let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 + let rad (i : Fin 4) : Real := 1 / (q i).1 + change (dist (ctr i) (ctr j) = rad i + rad j) + simpa [ctr, rad] using circleDist i j hij (hcpos i) (hcpos j) + +private theorem hd21 (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (hpositive : ∀ + j : Fin 3, 0 < (q j.succ).1) : dist ((ctr q) 2) ((ctr q) 1) = (rad q) 2 + (rad q) 1 := by + classical + let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 + let rad (i : Fin 4) : Real := 1 / (q i).1 + have ctrDist (i j : Fin 4) (hij : i ≠ j) : + dist (ctr i) (ctr j) = rad i + rad j := ctrDist q hq hpositive i j hij + have hd12 := ctrDist 1 2 (by decide) + change (dist (ctr 2) (ctr 1) = rad 2 + rad 1) + simpa [dist_comm, add_comm] using hd12 + +private theorem hd31 (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (hpositive : ∀ + j : Fin 3, 0 < (q j.succ).1) : dist ((ctr q) 3) ((ctr q) 1) = (rad q) 3 + (rad q) 1 := by + classical + let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 + let rad (i : Fin 4) : Real := 1 / (q i).1 + have ctrDist (i j : Fin 4) (hij : i ≠ j) : + dist (ctr i) (ctr j) = rad i + rad j := ctrDist q hq hpositive i j hij + have hd13 := ctrDist 1 3 (by decide) + change (dist (ctr 3) (ctr 1) = rad 3 + rad 1) + simpa [dist_comm, add_comm] using hd13 + +private theorem hd32 (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (hpositive : ∀ + j : Fin 3, 0 < (q j.succ).1) : dist ((ctr q) 3) ((ctr q) 2) = (rad q) 3 + (rad q) 2 := by + classical + let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 + let rad (i : Fin 4) : Real := 1 / (q i).1 + have ctrDist (i j : Fin 4) (hij : i ≠ j) : + dist (ctr i) (ctr j) = rad i + rad j := ctrDist q hq hpositive i j hij + have hd23 := ctrDist 2 3 (by decide) + change (dist (ctr 3) (ctr 2) = rad 3 + rad 2) + simpa [dist_comm, add_comm] using hd23 + +private noncomputable abbrev crossC : Complex → Complex → Real := by + classical + exact fun z w => z.re * w.im - z.im * w.re + +private noncomputable abbrev dotC : Complex → Complex → Real := by + classical + exact fun z w => z.re * w.re + z.im * w.im + +private theorem soddySameSide (A B C D : Complex) (a b c d : Real) + (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) (hd : 0 < d) + (hdA : d < a) (hdB : d < b) + (hAB : dist A B = a + b) (hAC : dist A C = a + c) (hAD : dist A D = a + d) + (hBC : dist B C = b + c) (hBD : dist B D = b + d) (hCD : dist C D = c + d) : + 0 < crossC (B - A) (C - A) * crossC (B - A) (D - A) ∧ + (d * (a + b)) ^ 2 < crossC (B - A) (D - A) ^ 2 := by + classical + let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re + let dotC : Complex → Complex → Real := fun z w => z.re * w.re + z.im * w.im + change (0 < crossC (B - A) (C - A) * crossC (B - A) (D - A) ∧ + (d * (a + b)) ^ 2 < crossC (B - A) (D - A) ^ 2) + exact (by + let e := B - A + let u := C - A + let v := D - A + have hlen (x y : Complex) (r : Real) (h : dist x y = r) : + Complex.normSq (y - x) = r ^ 2 := by + have hn : ‖y - x‖ = r := by + simpa [Complex.dist_eq, norm_sub_rev] using h + rw [Complex.normSq_eq_norm_sq, hn] + have he : Complex.normSq e = (a + b) ^ 2 := hlen A B (a + b) hAB + have hu : Complex.normSq u = (a + c) ^ 2 := hlen A C (a + c) hAC + have hv : Complex.normSq v = (a + d) ^ 2 := hlen A D (a + d) hAD + have heu : Complex.normSq (e - u) = (b + c) ^ 2 := by + have h := hlen C B (b + c) (by simpa [dist_comm] using hBC) + simpa [e, u] using h + have hev : Complex.normSq (e - v) = (b + d) ^ 2 := by + have h := hlen D B (b + d) (by simpa [dist_comm] using hBD) + simpa [e, v] using h + have huv : Complex.normSq (u - v) = (c + d) ^ 2 := by + have h := hlen D C (c + d) (by simpa [dist_comm] using hCD) + simpa [u, v] using h + have dotEU : 2 * dotC e u = Complex.normSq e + Complex.normSq u - Complex.normSq (e - u) := by + simp [dotC, Complex.normSq, e, u] + ring + have dotEV : 2 * dotC e v = Complex.normSq e + Complex.normSq v - Complex.normSq (e - v) := by + simp [dotC, Complex.normSq, e, v] + ring + have dotUV : 2 * dotC u v = Complex.normSq u + Complex.normSq v - Complex.normSq (u - v) := by + simp [dotC, Complex.normSq, u, v] + ring + have areaProduct : crossC e u * crossC e v = + Complex.normSq e * dotC u v - dotC e u * dotC e v := by + simp [crossC, dotC, Complex.normSq, e, u, v] + ring + have hdotEU : 2 * dotC e u = (a + b) ^ 2 + (a + c) ^ 2 - (b + c) ^ 2 := by rw [dotEU, he, + hu, heu] + have hdotEV : 2 * dotC e v = (a + b) ^ 2 + (a + d) ^ 2 - (b + d) ^ 2 := by rw [dotEV, he, + hv, hev] + have hdotUV : 2 * dotC u v = (a + c) ^ 2 + (a + d) ^ 2 - (c + d) ^ 2 := by rw [dotUV, hu, + hv, huv] + have hp : crossC e u * crossC e v = + 2 * (a * b * (a + b) * (c + d) - c * d * (a ^ 2 + b ^ 2)) := by + have h1 : dotC e u = ((a + b) ^ 2 + (a + c) ^ 2 - (b + c) ^ 2) / 2 := by linarith [hdotEU] + have h2 : dotC e v = ((a + b) ^ 2 + (a + d) ^ 2 - (b + d) ^ 2) / 2 := by linarith [hdotEV] + have h3 : dotC u v = ((a + c) ^ 2 + (a + d) ^ 2 - (c + d) ^ 2) / 2 := by linarith [hdotUV] + rw [areaProduct, he, h1, h2, h3] + ring + have areaSquare : crossC e v ^ 2 = + Complex.normSq e * Complex.normSq v - dotC e v ^ 2 := by + simp [crossC, dotC, Complex.normSq, e, v] + ring + have hmarginEq : crossC e v ^ 2 = 4 * a * b * d * (a + b + d) := by + rw [areaSquare, he, hv] + have hdv : dotC e v = a ^ 2 + a * b + a * d - b * d := + by + have hpoly : (a + b) ^ 2 + (a + d) ^ 2 - (b + d) ^ 2 = + 2 * (a ^ 2 + a * b + a * d - b * d) := by ring + rw [hpoly] at hdotEV + linarith [hdotEV] + rw [hdv] + ring + constructor + · change 0 < crossC e u * crossC e v + rw [hp] + have hcore : 0 < a * b * (a + b) - d * (a ^ 2 + b ^ 2) := by + rcases le_total a b with hab | hba + · calc + 0 ≤ a * b * (a + b) - a * (a ^ 2 + b ^ 2) := by + rw [show a * b * (a + b) - a * (a ^ 2 + b ^ 2) = a ^ 2 * (b - a) by ring] + exact mul_nonneg (sq_nonneg a) (sub_nonneg.mpr hab) + _ < a * b * (a + b) - d * (a ^ 2 + b ^ 2) := by + have hsq : 0 < a ^ 2 + b ^ 2 := by positivity + have hgap : a * b * (a + b) - d * (a ^ 2 + b ^ 2) = + a * b * (a + b) - a * (a ^ 2 + b ^ 2) + (a - d) * (a ^ 2 + b ^ 2) := by ring + rw [hgap] + exact lt_add_of_pos_right _ (mul_pos (sub_pos.mpr hdA) hsq) + · calc + 0 ≤ a * b * (a + b) - b * (a ^ 2 + b ^ 2) := by + rw [show a * b * (a + b) - b * (a ^ 2 + b ^ 2) = b ^ 2 * (a - b) by ring] + exact mul_nonneg (sq_nonneg b) (sub_nonneg.mpr hba) + _ < a * b * (a + b) - d * (a ^ 2 + b ^ 2) := by + have hsq : 0 < a ^ 2 + b ^ 2 := by positivity + have hgap : a * b * (a + b) - d * (a ^ 2 + b ^ 2) = + a * b * (a + b) - b * (a ^ 2 + b ^ 2) + (b - d) * (a ^ 2 + b ^ 2) := by ring + rw [hgap] + exact lt_add_of_pos_right _ (mul_pos (sub_pos.mpr hdB) hsq) + have hpos : 0 < c * (a * b * (a + b) - d * (a ^ 2 + b ^ 2)) + a * b * (a + b) * d := by + positivity + have hrew (X Y : Real) : + X * (c + d) - c * d * Y = c * (X - d * Y) + X * d := by + calc + X * (c + d) - c * d * Y = X * c + X * d - c * d * Y := by ring + _ = c * (X - d * Y) + X * d := by ring + have hrew' : a * b * (a + b) * (c + d) - c * d * (a ^ 2 + b ^ 2) = + c * (a * b * (a + b) - d * (a ^ 2 + b ^ 2)) + a * b * (a + b) * d := by + simpa using hrew (a * b * (a + b)) (a ^ 2 + b ^ 2) + rw [hrew'] + exact mul_pos (by norm_num : (0 : Real) < 2) hpos + · rw [hmarginEq] + have hfactor : 0 < 4 * a * b - d * (a + b) := by + rcases le_total a b with hab | hba + · have habsum : a + b ≤ 2 * b := by + calc + a + b ≤ b + b := by simpa [add_comm] using add_le_add_right hab b + _ = 2 * b := by ring + have hprod : d * (a + b) < a * (a + b) := by + exact (mul_lt_mul_of_pos_right hdA (by positivity)) + have hbound : a * (a + b) ≤ 2 * a * b := by + calc + a * (a + b) ≤ a * (2 * b) := mul_le_mul_of_nonneg_left habsum (le_of_lt ha) + _ = 2 * a * b := by ring + have hprod' : d * (a + b) < 2 * a * b := lt_of_lt_of_le hprod hbound + have habpos : 0 < a * b := mul_pos ha hb + linarith + · have hbasum : a + b ≤ 2 * a := by + calc + a + b ≤ a + a := by simpa [add_comm] using add_le_add_left hba a + _ = 2 * a := by ring + have hprod : d * (a + b) < b * (a + b) := by + exact (mul_lt_mul_of_pos_right hdB (by positivity)) + have hbound : b * (a + b) ≤ 2 * a * b := by + calc + b * (a + b) ≤ b * (2 * a) := mul_le_mul_of_nonneg_left hbasum (le_of_lt hb) + _ = 2 * a * b := by ring + have hprod' : d * (a + b) < 2 * a * b := lt_of_lt_of_le hprod hbound + have habpos : 0 < a * b := mul_pos ha hb + linarith + have hmargin : 0 < 4 * a * b * (a + b + d) - d * (a + b) ^ 2 := by + rw [show 4 * a * b * (a + b + d) - d * (a + b) ^ 2 = + (a + b) * (4 * a * b - d * (a + b)) + 4 * a * b * d by ring] + positivity + have hm' : d * (d * (a + b) ^ 2) < d * (4 * a * b * (a + b + d)) := + mul_lt_mul_of_pos_left (sub_pos.mp hmargin) hd + calc + (d * (a + b)) ^ 2 = d * (d * (a + b) ^ 2) := by ring + _ < d * (4 * a * b * (a + b + d)) := hm' + _ = 4 * a * b * d * (a + b + d) := by ring + ) + +private theorem crossSq_le (z w : Complex) : + crossC z w ^ 2 ≤ Complex.normSq z * Complex.normSq w := by + classical + let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re + change (crossC z w ^ 2 ≤ Complex.normSq z * Complex.normSq w) + simp [crossC, Complex.normSq] + nlinarith [sq_nonneg (z.re * w.re + z.im * w.im)] + +private theorem diskEdgeSide (A B D p : Complex) (a d : Real) + (ha : 0 < a) (hd : 0 < d) + (hAB : dist A B = a) + (hmargin : (d * a) ^ 2 < crossC (B - A) (D - A) ^ 2) + (hpD : dist D p < d) : + 0 < crossC (B - A) (D - A) * crossC (B - A) (p - A) := by + classical + let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re + have crossSq_le (z w : Complex) : + crossC z w ^ 2 ≤ Complex.normSq z * Complex.normSq w := crossSq_le z w + change (0 < crossC (B - A) (D - A) * crossC (B - A) (p - A)) + change (d * a) ^ 2 < crossC (B - A) (D - A) ^ 2 at hmargin + let e := B - A + let w := p - D + have he : Complex.normSq e = a ^ 2 := by + have hn : ‖B - A‖ = a := by simpa [Complex.dist_eq, norm_sub_rev] using hAB + rw [Complex.normSq_eq_norm_sq, hn] + have hw : Complex.normSq w < d ^ 2 := by + have hn : ‖p - D‖ < d := by simpa [Complex.dist_eq, norm_sub_rev] using hpD + rw [Complex.normSq_eq_norm_sq] + nlinarith [norm_nonneg (p - D)] + have herr : crossC e w ^ 2 < (d * a) ^ 2 := by + have hcross := crossSq_le e w + have hprod : Complex.normSq e * Complex.normSq w < a ^ 2 * d ^ 2 := by + rw [he] + exact mul_lt_mul_of_pos_left hw (by positivity) + nlinarith [hcross, hprod] + have hmargin' : crossC e w ^ 2 < crossC e (D - A) ^ 2 := lt_trans herr hmargin + have hne : crossC e (D - A) ≠ 0 := by + intro hz + rw [hz] at hmargin + have hsq : 0 ≤ (d * a) ^ 2 := sq_nonneg _ + linarith + have hsign (x y : Real) (hx : x ≠ 0) (hxy : y ^ 2 < x ^ 2) : 0 < x * (x + y) := by + have habs : |y| < |x| := by + apply (sq_lt_sq₀ (abs_nonneg y) (abs_nonneg x)).mp + simpa [sq_abs] using hxy + rcases lt_or_gt_of_ne hx with hneg | hpos + · have hy : y < -x := by + have hh := (abs_lt.mp (by simpa [abs_of_neg hneg] using habs)).2 + linarith + have hs : x + y < 0 := by linarith + exact mul_pos_of_neg_of_neg hneg hs + · have hy : -x < y := by + have hh := (abs_lt.mp (by simpa [abs_of_pos hpos] using habs)).1 + linarith + have hs : 0 < x + y := by linarith + exact mul_pos hpos hs + have hlinear : crossC e (p - A) = crossC e (D - A) + crossC e w := by + simp [crossC, e, w] + ring + rw [hlinear] + exact hsign _ _ hne hmargin' + +private theorem sideTrans (x y z : Real) (hxy : 0 < x * y) (hyz : 0 < y * z) : + 0 < x * z := by + classical + rcases (mul_pos_iff.mp hxy) with ⟨hx, hy⟩ | ⟨hx, hy⟩ + · rcases (mul_pos_iff.mp hyz) with ⟨hy', hz⟩ | ⟨hy', hz⟩ + · exact mul_pos hx hz + · linarith + · rcases (mul_pos_iff.mp hyz) with ⟨hy', hz⟩ | ⟨hy', hz⟩ + · linarith + · exact mul_pos_of_neg_of_neg hx hz + +private theorem ratioPos (x y : Real) (hxy : 0 < x * y) : 0 < y / x := by + classical + rw [div_pos_iff] + rcases (mul_pos_iff.mp hxy) with ⟨hx, hy⟩ | ⟨hx, hy⟩ + · exact Or.inl ⟨hy, hx⟩ + · exact Or.inr ⟨hy, hx⟩ + +private theorem strictSides (A B C p : Complex) + (harea : crossC (B - A) (C - A) ≠ 0) + (hC : 0 < crossC (B - A) (p - A) / crossC (B - A) (C - A)) + (hB : 0 < crossC (p - A) (C - A) / crossC (B - A) (C - A)) + (hA : 0 < 1 - crossC (p - A) (C - A) / crossC (B - A) (C - A) - + crossC (B - A) (p - A) / crossC (B - A) (C - A)) : + p ∈ interior (convexHull Real ({A, B, C} : Set Complex)) := by + classical + let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re + exact (by + let den : Real := crossC (B - A) (C - A) + let nb (x : Complex) : Real := crossC (x - A) (C - A) + let nc (x : Complex) : Real := crossC (B - A) (x - A) + let wB (x : Complex) := nb x / den + let wC (x : Complex) := nc x / den + let wA (x : Complex) := 1 - wB x - wC x + let verts : Fin 3 → Complex := + Fin.cases A (fun i : Fin 2 => Fin.cases B (fun _ : Fin 1 => C) i) + let weights (x : Complex) : Fin 3 → Real := + Fin.cases (wA x) (fun i : Fin 2 => Fin.cases (wB x) (fun _ : Fin 1 => wC x) i) + let U : Set Complex := {x | 0 < wA x ∧ 0 < wB x ∧ 0 < wC x} + have hden : den ≠ 0 := by + intro hz + apply harea + simpa [den] using hz + have hcontRe : Continuous (fun z : Complex => z.re) := by + apply (LipschitzWith.of_dist_le_mul (K := 1) fun z w => ?_).continuous + rw [Real.dist_eq, Complex.dist_eq] + simpa [Complex.sub_re] using Complex.abs_re_le_norm (z - w) + have hcontIm : Continuous (fun z : Complex => z.im) := by + apply (LipschitzWith.of_dist_le_mul (K := 1) fun z w => ?_).continuous + rw [Real.dist_eq, Complex.dist_eq] + simpa [Complex.sub_im] using Complex.abs_im_le_norm (z - w) + have hcontSub (A : Complex) : Continuous (fun z : Complex => z - A) := by + apply (LipschitzWith.of_dist_le_mul (K := 1) fun z w => ?_).continuous + rw [Complex.dist_eq, Complex.dist_eq] + simp + have hcontNB : Continuous nb := by + dsimp [nb, crossC] + exact ((hcontRe.comp (hcontSub A)).mul continuous_const).sub + ((hcontIm.comp (hcontSub A)).mul continuous_const) + have hcontNC : Continuous nc := by + dsimp [nc, crossC] + exact (continuous_const.mul + (hcontIm.comp (hcontSub A))).sub + (continuous_const.mul + (hcontRe.comp (hcontSub A))) + have hcontB : Continuous wB := by + dsimp [wB] + exact hcontNB.div_const den + have hcontC : Continuous wC := by + dsimp [wC] + exact hcontNC.div_const den + have hcontA : Continuous wA := by + dsimp [wA] + exact Continuous.sub (continuous_const.sub hcontB) hcontC + have hopen : IsOpen U := by + apply (isOpen_lt continuous_const hcontA).inter + apply (isOpen_lt continuous_const hcontB).inter + exact isOpen_lt continuous_const hcontC + have expandReal (b c a y z : Real) : + (1 - b - c) * a + b * y + c * z = a + b * (y - a) + c * (z - a) := by + ring + have hU : p ∈ U := by + change 0 < wA p ∧ 0 < wB p ∧ 0 < wC p + constructor + · dsimp [wA, wB, wC, nb, nc, den] + exact hA + · constructor + · dsimp [wB, nb, den] + exact hB + · dsimp [wC, nc, den] + exact hC + have hsubset : U ⊆ convexHull Real ({A, B, C} : Set Complex) := by + intro x hx + change 0 < wA x ∧ 0 < wB x ∧ 0 < wC x at hx + let verts : Fin 3 → Complex := + Fin.cases A (fun i : Fin 2 => Fin.cases B (fun _ : Fin 1 => C) i) + let weights (x : Complex) : Fin 3 → Real := + Fin.cases (wA x) (fun i : Fin 2 => Fin.cases (wB x) (fun _ : Fin 1 => wC x) i) + have hs : ∑ i : Fin 3, weights x i = 1 := by + rw [Fin.sum_univ_three] + simp only [weights] + change wA x + wB x + wC x = 1 + dsimp [wA] + abel + have hcombo : ∑ i : Fin 3, weights x i • verts i = x := by + rw [Fin.sum_univ_three] + have hw0 : weights x 0 = wA x := rfl + have hw1 : weights x 1 = wB x := rfl + have hw2 : weights x 2 = wC x := rfl + have hv0 : verts 0 = A := rfl + have hv1 : verts 1 = B := rfl + have hv2 : verts 2 = C := rfl + rw [hw0, hw1, hw2, hv0, hv1, hv2] + apply Complex.ext + · simp only [Complex.add_re, Complex.smul_re] + change (1 - wB x - wC x) • A.re + + wB x • B.re + wC x • C.re = x.re + simp only [smul_eq_mul] + calc + (1 - wB x - wC x) * A.re + wB x * B.re + wC x * C.re = + A.re + wB x * (B.re - A.re) + wC x * (C.re - A.re) := + expandReal (wB x) (wC x) A.re B.re C.re + _ = x.re := by + dsimp [wB, wC] + field_simp [hden] + dsimp [nb, nc, crossC, den] + ring + · simp only [Complex.add_im, Complex.smul_im] + change (1 - wB x - wC x) • A.im + + wB x • B.im + wC x • C.im = x.im + simp only [smul_eq_mul] + calc + (1 - wB x - wC x) * A.im + wB x * B.im + wC x * C.im = + A.im + wB x * (B.im - A.im) + wC x * (C.im - A.im) := + expandReal (wB x) (wC x) A.im B.im C.im + _ = x.im := by + dsimp [wB, wC] + field_simp [hden] + dsimp [nb, nc, crossC, den] + ring + exact mem_convexHull_of_exists_fintype (weights x) verts + (by + intro i + fin_cases i + · change 0 ≤ wA x + exact le_of_lt hx.1 + · change 0 ≤ wB x + exact le_of_lt hx.2.1 + · change 0 ≤ wC x + exact le_of_lt hx.2.2) + hs + (by + intro i + fin_cases i + · exact Or.inl rfl + · exact Or.inr (Or.inl rfl) + · exact Or.inr (Or.inr rfl)) + hcombo + exact (interior_maximal hsubset hopen) hU + ) + +private theorem radChildLtParent (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hpositive : ∀ j : Fin 3, 0 < (q j.succ).1) (j : Fin 3) : (rad q) 0 < (rad q) j.succ := by + classical + let rad (i : Fin 4) : Real := 1 / (q i).1 + change (rad 0 < rad j.succ) + dsimp [rad] + have hp : 0 < ((q j.succ).1 : Real) := by exact_mod_cast hpositive j + have hc : ((q j.succ).1 : Real) < ((q 0).1 : Real) := by + exact_mod_cast hq.2 j + exact one_div_lt_one_div_of_lt hp hc + +private theorem hr01 (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (hpositive : ∀ + j : Fin 3, 0 < (q j.succ).1) : (rad q) 0 < (rad q) 1 := by + classical + let rad (i : Fin 4) : Real := 1 / (q i).1 + have radChildLtParent (j : Fin 3) : rad 0 < rad j.succ := radChildLtParent q hq hpositive j + change (rad 0 < rad 1) + simpa using radChildLtParent 0 + +private theorem hr02 (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (hpositive : ∀ + j : Fin 3, 0 < (q j.succ).1) : (rad q) 0 < (rad q) 2 := by + classical + let rad (i : Fin 4) : Real := 1 / (q i).1 + have radChildLtParent (j : Fin 3) : rad 0 < rad j.succ := radChildLtParent q hq hpositive j + change (rad 0 < rad 2) + simpa using radChildLtParent 1 + +private theorem hr03 (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (hpositive : ∀ + j : Fin 3, 0 < (q j.succ).1) : (rad q) 0 < (rad q) 3 := by + classical + let rad (i : Fin 4) : Real := 1 / (q i).1 + have radChildLtParent (j : Fin 3) : rad 0 < rad j.succ := radChildLtParent q hq hpositive j + change (rad 0 < rad 3) + simpa using radChildLtParent 2 + +private noncomputable abbrev den (q : Fin 4 → CircleCoordinates) : Real := by + classical + let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 + let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re + exact crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1) + +private theorem harea (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (hpositive : ∀ + j : Fin 3, 0 < (q j.succ).1) : crossC ((ctr q) 2 - (ctr q) 1) ((ctr q) 3 - (ctr q) 1) ≠ 0 := by + classical + let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 + let rad (i : Fin 4) : Real := 1 / (q i).1 + have rpos (i : Fin 4) : 0 < rad i := rpos q hq hpositive i + have ctrDist (i j : Fin 4) (hij : i ≠ j) : + dist (ctr i) (ctr j) = rad i + rad j := ctrDist q hq hpositive i j hij + have hd12 := ctrDist 1 2 (by decide) + have hd13 := ctrDist 1 3 (by decide) + have hd10 := ctrDist 1 0 (by decide) + have hd23 := ctrDist 2 3 (by decide) + have hd20 := ctrDist 2 0 (by decide) + have hd30 := ctrDist 3 0 (by decide) + let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re + have soddySameSide (A B C D : Complex) (a b c d : Real) + (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) (hd : 0 < d) + (hdA : d < a) (hdB : d < b) + (hAB : dist A B = a + b) (hAC : dist A C = a + c) (hAD : dist A D = a + d) + (hBC : dist B C = b + c) (hBD : dist B D = b + d) (hCD : dist C D = c + d) : + 0 < crossC (B - A) (C - A) * crossC (B - A) (D - A) ∧ + (d * (a + b)) ^ 2 < crossC (B - A) (D - A) ^ 2 := soddySameSide A B C D a b c d ha hb + hc hd hdA + hdB hAB hAC hAD hBC hBD hCD + have hr01 : rad 0 < rad 1 := hr01 q hq hpositive + have hr02 : rad 0 < rad 2 := hr02 q hq hpositive + have hside123 := soddySameSide (ctr 1) (ctr 2) (ctr 3) (ctr 0) + (rad 1) (rad 2) (rad 3) (rad 0) + (rpos 1) (rpos 2) (rpos 3) (rpos 0) hr01 hr02 + hd12 hd13 hd10 hd23 hd20 hd30 + change (crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1) ≠ 0) + have hprod : 0 < crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1) * + crossC (ctr 2 - ctr 1) (ctr 0 - ctr 1) := hside123.1 + intro hz + rw [hz] at hprod + norm_num at hprod + +private theorem hLamC (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (hpositive : ∀ + j : Fin 3, 0 < (q j.succ).1) (p : ℂ) (hp : dist p (((q 0).2 : ℂ) / ((q 0).1 : ℝ)) < 1 / ((q + 0).1 : ℝ)) : 0 < crossC ((ctr q) 2 - (ctr q) 1) (p - (ctr q) 1) / (den q) := by + classical + let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 + let rad (i : Fin 4) : Real := 1 / (q i).1 + have rpos (i : Fin 4) : 0 < rad i := rpos q hq hpositive i + have ctrDist (i j : Fin 4) (hij : i ≠ j) : + dist (ctr i) (ctr j) = rad i + rad j := ctrDist q hq hpositive i j hij + have hd12 := ctrDist 1 2 (by decide) + have hd13 := ctrDist 1 3 (by decide) + have hd10 := ctrDist 1 0 (by decide) + have hd23 := ctrDist 2 3 (by decide) + have hd20 := ctrDist 2 0 (by decide) + have hd30 := ctrDist 3 0 (by decide) + let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re + have soddySameSide (A B C D : Complex) (a b c d : Real) + (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) (hd : 0 < d) + (hdA : d < a) (hdB : d < b) + (hAB : dist A B = a + b) (hAC : dist A C = a + c) (hAD : dist A D = a + d) + (hBC : dist B C = b + c) (hBD : dist B D = b + d) (hCD : dist C D = c + d) : + 0 < crossC (B - A) (C - A) * crossC (B - A) (D - A) ∧ + (d * (a + b)) ^ 2 < crossC (B - A) (D - A) ^ 2 := soddySameSide A B C D a b c d ha hb + hc hd hdA + hdB hAB hAC hAD hBC hBD hCD + have diskEdgeSide (A B D p : Complex) (a d : Real) + (ha : 0 < a) (hd : 0 < d) + (hAB : dist A B = a) + (hmargin : (d * a) ^ 2 < crossC (B - A) (D - A) ^ 2) + (hpD : dist D p < d) : + 0 < crossC (B - A) (D - A) * crossC (B - A) (p - A) := diskEdgeSide A B D p a d ha hd hAB + hmargin hpD + have sideTrans (x y z : Real) (hxy : 0 < x * y) (hyz : 0 < y * z) : + 0 < x * z := sideTrans x y z hxy hyz + have ratioPos (x y : Real) (hxy : 0 < x * y) : 0 < y / x := ratioPos x y hxy + have hr01 : rad 0 < rad 1 := hr01 q hq hpositive + have hr02 : rad 0 < rad 2 := hr02 q hq hpositive + have hside123 := soddySameSide (ctr 1) (ctr 2) (ctr 3) (ctr 0) + (rad 1) (rad 2) (rad 3) (rad 0) + (rpos 1) (rpos 2) (rpos 3) (rpos 0) hr01 hr02 + hd12 hd13 hd10 hd23 hd20 hd30 + have hp12 := diskEdgeSide (ctr 1) (ctr 2) (ctr 0) p + (rad 1 + rad 2) (rad 0) (add_pos (rpos 1) (rpos 2)) (rpos 0) + (ctrDist 1 2 (by decide)) hside123.2 (by simpa only [ctr, rad, Complex.ofReal_intCast, + dist_comm] using hp) + have htri123 := sideTrans + (crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1)) + (crossC (ctr 2 - ctr 1) (ctr 0 - ctr 1)) + (crossC (ctr 2 - ctr 1) (p - ctr 1)) hside123.1 hp12 + let den : Real := crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1) + change (0 < crossC (ctr 2 - ctr 1) (p - ctr 1) / den) + exact ratioPos _ _ (by simpa [den] using htri123) + +private theorem hden312 (q : Fin 4 → CircleCoordinates) : crossC ((ctr q) 1 - (ctr q) 3) ((ctr q) + 2 - (ctr q) 3) = (den q) := by + classical + let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 + let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re + let den : Real := crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1) + change (crossC (ctr 1 - ctr 3) (ctr 2 - ctr 3) = den) + dsimp [den, crossC] + ring + +private theorem hnum312 (q : Fin 4 → CircleCoordinates) (p : ℂ) : crossC ((ctr q) 1 - (ctr q) 3) + (p - (ctr q) 3) = + crossC (p - (ctr q) 1) ((ctr q) 3 - (ctr q) 1) := by + classical + let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 + let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re + change (crossC (ctr 1 - ctr 3) (p - ctr 3) = + crossC (p - ctr 1) (ctr 3 - ctr 1)) + dsimp [crossC] + ring + +private theorem hLamB (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (hpositive : ∀ + j : Fin 3, 0 < (q j.succ).1) (p : ℂ) (hp : dist p (((q 0).2 : ℂ) / ((q 0).1 : ℝ)) < 1 / ((q + 0).1 : ℝ)) : 0 < crossC (p - (ctr q) 1) ((ctr q) 3 - (ctr q) 1) / (den q) := by + classical + let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 + let rad (i : Fin 4) : Real := 1 / (q i).1 + have rpos (i : Fin 4) : 0 < rad i := rpos q hq hpositive i + have ctrDist (i j : Fin 4) (hij : i ≠ j) : + dist (ctr i) (ctr j) = rad i + rad j := ctrDist q hq hpositive i j hij + have hd12 := ctrDist 1 2 (by decide) + have hd10 := ctrDist 1 0 (by decide) + have hd20 := ctrDist 2 0 (by decide) + have hd30 := ctrDist 3 0 (by decide) + have hd31 : dist (ctr 3) (ctr 1) = rad 3 + rad 1 := hd31 q hq hpositive + have hd32 : dist (ctr 3) (ctr 2) = rad 3 + rad 2 := hd32 q hq hpositive + let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re + have soddySameSide (A B C D : Complex) (a b c d : Real) + (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) (hd : 0 < d) + (hdA : d < a) (hdB : d < b) + (hAB : dist A B = a + b) (hAC : dist A C = a + c) (hAD : dist A D = a + d) + (hBC : dist B C = b + c) (hBD : dist B D = b + d) (hCD : dist C D = c + d) : + 0 < crossC (B - A) (C - A) * crossC (B - A) (D - A) ∧ + (d * (a + b)) ^ 2 < crossC (B - A) (D - A) ^ 2 := soddySameSide A B C D a b c d ha hb + hc hd hdA + hdB hAB hAC hAD hBC hBD hCD + have diskEdgeSide (A B D p : Complex) (a d : Real) + (ha : 0 < a) (hd : 0 < d) + (hAB : dist A B = a) + (hmargin : (d * a) ^ 2 < crossC (B - A) (D - A) ^ 2) + (hpD : dist D p < d) : + 0 < crossC (B - A) (D - A) * crossC (B - A) (p - A) := diskEdgeSide A B D p a d ha hd hAB + hmargin hpD + have sideTrans (x y z : Real) (hxy : 0 < x * y) (hyz : 0 < y * z) : + 0 < x * z := sideTrans x y z hxy hyz + have ratioPos (x y : Real) (hxy : 0 < x * y) : 0 < y / x := ratioPos x y hxy + have hr01 : rad 0 < rad 1 := hr01 q hq hpositive + have hr03 : rad 0 < rad 3 := hr03 q hq hpositive + have hside312 := soddySameSide (ctr 3) (ctr 1) (ctr 2) (ctr 0) + (rad 3) (rad 1) (rad 2) (rad 0) + (rpos 3) (rpos 1) (rpos 2) (rpos 0) hr03 hr01 + hd31 hd32 hd30 hd12 hd10 hd20 + have hp31 := diskEdgeSide (ctr 3) (ctr 1) (ctr 0) p + (rad 3 + rad 1) (rad 0) (add_pos (rpos 3) (rpos 1)) (rpos 0) + (ctrDist 3 1 (by decide)) hside312.2 (by simpa only [ctr, rad, Complex.ofReal_intCast, + dist_comm] using hp) + have htri312 := sideTrans + (crossC (ctr 1 - ctr 3) (ctr 2 - ctr 3)) + (crossC (ctr 1 - ctr 3) (ctr 0 - ctr 3)) + (crossC (ctr 1 - ctr 3) (p - ctr 3)) hside312.1 hp31 + let den : Real := crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1) + have hden312 : crossC (ctr 1 - ctr 3) (ctr 2 - ctr 3) = den := hden312 q + have hnum312 : crossC (ctr 1 - ctr 3) (p - ctr 3) = + crossC (p - ctr 1) (ctr 3 - ctr 1) := hnum312 q p + change (0 < crossC (p - ctr 1) (ctr 3 - ctr 1) / den) + have hh := ratioPos _ _ htri312 + rw [hden312, hnum312] at hh + exact hh + +private theorem hden231 (q : Fin 4 → CircleCoordinates) : crossC ((ctr q) 3 - (ctr q) 2) ((ctr q) + 1 - (ctr q) 2) = (den q) := by + classical + let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 + let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re + let den : Real := crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1) + change (crossC (ctr 3 - ctr 2) (ctr 1 - ctr 2) = den) + dsimp [den, crossC] + ring + +private theorem hnum231 (q : Fin 4 → CircleCoordinates) (p : ℂ) : crossC ((ctr q) 3 - (ctr q) 2) + (p - (ctr q) 2) = + crossC ((ctr q) 3 - (ctr q) 2) ((ctr q) 1 - (ctr q) 2) - + crossC (p - (ctr q) 1) ((ctr q) 3 - (ctr q) 1) - + crossC ((ctr q) 2 - (ctr q) 1) (p - (ctr q) 1) := by + classical + let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 + let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re + change (crossC (ctr 3 - ctr 2) (p - ctr 2) = + crossC (ctr 3 - ctr 2) (ctr 1 - ctr 2) - + crossC (p - ctr 1) (ctr 3 - ctr 1) - + crossC (ctr 2 - ctr 1) (p - ctr 1)) + dsimp [crossC] + ring + +private theorem hLamA (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (hpositive : ∀ + j : Fin 3, 0 < (q j.succ).1) (p : ℂ) (hp : dist p (((q 0).2 : ℂ) / ((q 0).1 : ℝ)) < 1 / ((q + 0).1 : ℝ)) : 0 < crossC ((ctr q) 3 - (ctr q) 2) (p - (ctr q) 2) / (den q) := by + classical + let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 + let rad (i : Fin 4) : Real := 1 / (q i).1 + have rpos (i : Fin 4) : 0 < rad i := rpos q hq hpositive i + have ctrDist (i j : Fin 4) (hij : i ≠ j) : + dist (ctr i) (ctr j) = rad i + rad j := ctrDist q hq hpositive i j hij + have hd10 := ctrDist 1 0 (by decide) + have hd23 := ctrDist 2 3 (by decide) + have hd20 := ctrDist 2 0 (by decide) + have hd30 := ctrDist 3 0 (by decide) + have hd21 : dist (ctr 2) (ctr 1) = rad 2 + rad 1 := hd21 q hq hpositive + have hd31 : dist (ctr 3) (ctr 1) = rad 3 + rad 1 := hd31 q hq hpositive + let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re + have soddySameSide (A B C D : Complex) (a b c d : Real) + (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) (hd : 0 < d) + (hdA : d < a) (hdB : d < b) + (hAB : dist A B = a + b) (hAC : dist A C = a + c) (hAD : dist A D = a + d) + (hBC : dist B C = b + c) (hBD : dist B D = b + d) (hCD : dist C D = c + d) : + 0 < crossC (B - A) (C - A) * crossC (B - A) (D - A) ∧ + (d * (a + b)) ^ 2 < crossC (B - A) (D - A) ^ 2 := soddySameSide A B C D a b c d ha hb + hc hd hdA + hdB hAB hAC hAD hBC hBD hCD + have diskEdgeSide (A B D p : Complex) (a d : Real) + (ha : 0 < a) (hd : 0 < d) + (hAB : dist A B = a) + (hmargin : (d * a) ^ 2 < crossC (B - A) (D - A) ^ 2) + (hpD : dist D p < d) : + 0 < crossC (B - A) (D - A) * crossC (B - A) (p - A) := diskEdgeSide A B D p a d ha hd hAB + hmargin hpD + have sideTrans (x y z : Real) (hxy : 0 < x * y) (hyz : 0 < y * z) : + 0 < x * z := sideTrans x y z hxy hyz + have ratioPos (x y : Real) (hxy : 0 < x * y) : 0 < y / x := ratioPos x y hxy + have hr02 : rad 0 < rad 2 := hr02 q hq hpositive + have hr03 : rad 0 < rad 3 := hr03 q hq hpositive + have hside231 := soddySameSide (ctr 2) (ctr 3) (ctr 1) (ctr 0) + (rad 2) (rad 3) (rad 1) (rad 0) + (rpos 2) (rpos 3) (rpos 1) (rpos 0) hr02 hr03 + hd23 hd21 hd20 hd31 hd30 hd10 + have hp23 := diskEdgeSide (ctr 2) (ctr 3) (ctr 0) p + (rad 2 + rad 3) (rad 0) (add_pos (rpos 2) (rpos 3)) (rpos 0) + (ctrDist 2 3 (by decide)) hside231.2 (by simpa only [ctr, rad, Complex.ofReal_intCast, + dist_comm] using hp) + have htri231 := sideTrans + (crossC (ctr 3 - ctr 2) (ctr 1 - ctr 2)) + (crossC (ctr 3 - ctr 2) (ctr 0 - ctr 2)) + (crossC (ctr 3 - ctr 2) (p - ctr 2)) hside231.1 hp23 + let den : Real := crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1) + have hden231 : crossC (ctr 3 - ctr 2) (ctr 1 - ctr 2) = den := hden231 q + change (0 < crossC (ctr 3 - ctr 2) (p - ctr 2) / den) + have hh := ratioPos _ _ htri231 + rw [hden231] at hh + exact hh + +private theorem hA (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (hpositive : ∀ j + : Fin 3, 0 < (q j.succ).1) (p : ℂ) (hp : dist p (((q 0).2 : ℂ) / ((q 0).1 : ℝ)) < 1 / ((q + 0).1 : ℝ)) : 0 < 1 - + crossC (p - (ctr q) 1) ((ctr q) 3 - (ctr q) 1) / (den q) - + crossC ((ctr q) 2 - (ctr q) 1) (p - (ctr q) 1) / (den q) := by + classical + let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 + let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re + let den : Real := crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1) + have harea : crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1) ≠ 0 := harea q hq hpositive + have hden231 : crossC (ctr 3 - ctr 2) (ctr 1 - ctr 2) = den := hden231 q + have hnum231 : crossC (ctr 3 - ctr 2) (p - ctr 2) = + crossC (ctr 3 - ctr 2) (ctr 1 - ctr 2) - + crossC (p - ctr 1) (ctr 3 - ctr 1) - + crossC (ctr 2 - ctr 1) (p - ctr 1) := hnum231 q p + have hLamA : 0 < crossC (ctr 3 - ctr 2) (p - ctr 2) / den := hLamA q hq hpositive p hp + change (0 < 1 - + crossC (p - ctr 1) (ctr 3 - ctr 1) / den - + crossC (ctr 2 - ctr 1) (p - ctr 1) / den) + have hAeq : 1 - + crossC (p - ctr 1) (ctr 3 - ctr 1) / den - + crossC (ctr 2 - ctr 1) (p - ctr 1) / den = + crossC (ctr 3 - ctr 2) (p - ctr 2) / den := by + have hnum : crossC (ctr 3 - ctr 2) (p - ctr 2) = + den - crossC (p - ctr 1) (ctr 3 - ctr 1) - + crossC (ctr 2 - ctr 1) (p - ctr 1) := by + rw [hnum231, hden231] + have hdenne : den ≠ 0 := by simpa [den] using harea + rw [hnum] + have fracComplement (d y z : Real) (hd : d ≠ 0) : + 1 - y / d - z / d=(d - y - z) / d := by + field_simp [hd] + exact fracComplement den + (crossC (p - ctr 1) (ctr 3 - ctr 1)) + (crossC (ctr 2 - ctr 1) (p - ctr 1)) hdenne + rw [hAeq] + exact hLamA + +end CircularPlacementConstruction + +theorem P4828T1CircularPlacement (L : Real) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hpositive : ∀ j : Fin 3, 0 < (q j.succ).1) : + P4828T1Disk (q 0) ⊆ P4828T1Gap L q := by +-- BODY + have hchild : 0 < (q 0).1 := CircularPlacementConstruction.hchild q hq + have hcpos : ∀ i : Fin 4, 0 < (q i).1 := CircularPlacementConstruction.hcpos q hq hpositive + have normCast (w : GaussianInt) : + Complex.normSq (w : Complex) = (Zsqrtd.norm w : Real) := + CircularPlacementConstruction.normCast w + have circleDist (i j : Fin 4) (hij : i ≠ j) + (hi : 0 < (q i).1) (hj : 0 < (q j).1) : + dist (((q i).2 : Complex) / (q i).1) + (((q j).2 : Complex) / (q j).1) = + 1 / (q i).1 + 1 / (q j).1 := CircularPlacementConstruction.circleDist q hq i j hij hi hj + let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 + let rad (i : Fin 4) : Real := 1 / (q i).1 + have rpos (i : Fin 4) : 0 < rad i := CircularPlacementConstruction.rpos q hq hpositive i + have ctrDist (i j : Fin 4) (hij : i ≠ j) : + dist (ctr i) (ctr j) = rad i + rad j := CircularPlacementConstruction.ctrDist q hq + hpositive i j hij + have hd12 := ctrDist 1 2 (by decide) + have hd13 := ctrDist 1 3 (by decide) + have hd10 := ctrDist 1 0 (by decide) + have hd23 := ctrDist 2 3 (by decide) + have hd20 := ctrDist 2 0 (by decide) + have hd30 := ctrDist 3 0 (by decide) + have hd21 : dist (ctr 2) (ctr 1) = rad 2 + rad 1 := CircularPlacementConstruction.hd21 q hq + hpositive + have hd31 : dist (ctr 3) (ctr 1) = rad 3 + rad 1 := CircularPlacementConstruction.hd31 q hq + hpositive + have hd32 : dist (ctr 3) (ctr 2) = rad 3 + rad 2 := CircularPlacementConstruction.hd32 q hq + hpositive + let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re + let dotC : Complex → Complex → Real := fun z w => z.re * w.re + z.im * w.im + have soddySameSide (A B C D : Complex) (a b c d : Real) + (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) (hd : 0 < d) + (hdA : d < a) (hdB : d < b) + (hAB : dist A B = a + b) (hAC : dist A C = a + c) (hAD : dist A D = a + d) + (hBC : dist B C = b + c) (hBD : dist B D = b + d) (hCD : dist C D = c + d) : + 0 < crossC (B - A) (C - A) * crossC (B - A) (D - A) ∧ + (d * (a + b)) ^ 2 < crossC (B - A) (D - A) ^ 2 := + CircularPlacementConstruction.soddySameSide A + B C D a b c d ha hb hc hd hdA hdB hAB hAC hAD hBC hBD hCD + have crossSq_le (z w : Complex) : + crossC z w ^ 2 ≤ Complex.normSq z * Complex.normSq w := + CircularPlacementConstruction.crossSq_le z w + have diskEdgeSide (A B D p : Complex) (a d : Real) + (ha : 0 < a) (hd : 0 < d) + (hAB : dist A B = a) + (hmargin : (d * a) ^ 2 < crossC (B - A) (D - A) ^ 2) + (hpD : dist D p < d) : + 0 < crossC (B - A) (D - A) * crossC (B - A) (p - A) := + CircularPlacementConstruction.diskEdgeSide A + B D p a d ha hd hAB hmargin hpD + have sideTrans (x y z : Real) (hxy : 0 < x * y) (hyz : 0 < y * z) : + 0 < x * z := CircularPlacementConstruction.sideTrans x y z hxy hyz + have ratioPos (x y : Real) (hxy : 0 < x * y) : 0 < y / x := + CircularPlacementConstruction.ratioPos x y hxy + have strictSides (A B C p : Complex) + (harea : crossC (B - A) (C - A) ≠ 0) + (hC : 0 < crossC (B - A) (p - A) / crossC (B - A) (C - A)) + (hB : 0 < crossC (p - A) (C - A) / crossC (B - A) (C - A)) + (hA : 0 < 1 - crossC (p - A) (C - A) / crossC (B - A) (C - A) - + crossC (B - A) (p - A) / crossC (B - A) (C - A)) : + p ∈ interior (convexHull Real ({A, B, C} : Set Complex)) := + CircularPlacementConstruction.strictSides A B C p harea hC hB hA + have radChildLtParent (j : Fin 3) : rad 0 < rad j.succ := + CircularPlacementConstruction.radChildLtParent q hq hpositive j + have hr01 : rad 0 < rad 1 := CircularPlacementConstruction.hr01 q hq hpositive + have hr02 : rad 0 < rad 2 := CircularPlacementConstruction.hr02 q hq hpositive + have hr03 : rad 0 < rad 3 := CircularPlacementConstruction.hr03 q hq hpositive + have hside123 := soddySameSide (ctr 1) (ctr 2) (ctr 3) (ctr 0) + (rad 1) (rad 2) (rad 3) (rad 0) + (rpos 1) (rpos 2) (rpos 3) (rpos 0) hr01 hr02 + hd12 hd13 hd10 hd23 hd20 hd30 + have hside231 := soddySameSide (ctr 2) (ctr 3) (ctr 1) (ctr 0) + (rad 2) (rad 3) (rad 1) (rad 0) + (rpos 2) (rpos 3) (rpos 1) (rpos 0) hr02 hr03 + hd23 hd21 hd20 hd31 hd30 hd10 + have hside312 := soddySameSide (ctr 3) (ctr 1) (ctr 2) (ctr 0) + (rad 3) (rad 1) (rad 2) (rad 0) + (rpos 3) (rpos 1) (rpos 2) (rpos 0) hr03 hr01 + hd31 hd32 hd30 hd12 hd10 hd20 + intro p hp + change dist p (ctr 0) < rad 0 at hp + have hp12 := diskEdgeSide (ctr 1) (ctr 2) (ctr 0) p + (rad 1 + rad 2) (rad 0) (add_pos (rpos 1) (rpos 2)) (rpos 0) + (ctrDist 1 2 (by decide)) hside123.2 (by simpa only [ctr, rad, Complex.ofReal_intCast, + dist_comm] using hp) + have hp23 := diskEdgeSide (ctr 2) (ctr 3) (ctr 0) p + (rad 2 + rad 3) (rad 0) (add_pos (rpos 2) (rpos 3)) (rpos 0) + (ctrDist 2 3 (by decide)) hside231.2 (by simpa only [ctr, rad, Complex.ofReal_intCast, + dist_comm] using hp) + have hp31 := diskEdgeSide (ctr 3) (ctr 1) (ctr 0) p + (rad 3 + rad 1) (rad 0) (add_pos (rpos 3) (rpos 1)) (rpos 0) + (ctrDist 3 1 (by decide)) hside312.2 (by simpa only [ctr, rad, Complex.ofReal_intCast, + dist_comm] using hp) + have htri123 := sideTrans + (crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1)) + (crossC (ctr 2 - ctr 1) (ctr 0 - ctr 1)) + (crossC (ctr 2 - ctr 1) (p - ctr 1)) hside123.1 hp12 + have htri231 := sideTrans + (crossC (ctr 3 - ctr 2) (ctr 1 - ctr 2)) + (crossC (ctr 3 - ctr 2) (ctr 0 - ctr 2)) + (crossC (ctr 3 - ctr 2) (p - ctr 2)) hside231.1 hp23 + have htri312 := sideTrans + (crossC (ctr 1 - ctr 3) (ctr 2 - ctr 3)) + (crossC (ctr 1 - ctr 3) (ctr 0 - ctr 3)) + (crossC (ctr 1 - ctr 3) (p - ctr 3)) hside312.1 hp31 + let den : Real := crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1) + have harea : crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1) ≠ 0 := CircularPlacementConstruction.harea + q hq hpositive + have hLamC : 0 < crossC (ctr 2 - ctr 1) (p - ctr 1) / den := + CircularPlacementConstruction.hLamC q hq hpositive p hp + have hden312 : crossC (ctr 1 - ctr 3) (ctr 2 - ctr 3) = den := + CircularPlacementConstruction.hden312 q + have hnum312 : crossC (ctr 1 - ctr 3) (p - ctr 3) = + crossC (p - ctr 1) (ctr 3 - ctr 1) := CircularPlacementConstruction.hnum312 q p + have hLamB : 0 < crossC (p - ctr 1) (ctr 3 - ctr 1) / den := + CircularPlacementConstruction.hLamB q hq hpositive p hp + have hden231 : crossC (ctr 3 - ctr 2) (ctr 1 - ctr 2) = den := + CircularPlacementConstruction.hden231 q + have hnum231 : crossC (ctr 3 - ctr 2) (p - ctr 2) = + crossC (ctr 3 - ctr 2) (ctr 1 - ctr 2) - + crossC (p - ctr 1) (ctr 3 - ctr 1) - + crossC (ctr 2 - ctr 1) (p - ctr 1) := CircularPlacementConstruction.hnum231 q p + have hLamA : 0 < crossC (ctr 3 - ctr 2) (p - ctr 2) / den := + CircularPlacementConstruction.hLamA q hq hpositive p hp + have hA : 0 < 1 - + crossC (p - ctr 1) (ctr 3 - ctr 1) / den - + crossC (ctr 2 - ctr 1) (p - ctr 1) / den := CircularPlacementConstruction.hA q hq hpositive + p hp + have hinside := strictSides (ctr 1) (ctr 2) (ctr 3) p harea hLamC hLamB hA + constructor + · have hverts : + ({x : Complex | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (x = ctr j.succ ∨ ∃ k : Fin 3, (q k.succ).1 = 0 ∧ + x = ⟨if (q k.succ).2 = -1 then L else L + 2, + (ctr j.succ).im⟩)} : Set Complex) = + ({ctr 1, ctr 2, ctr 3} : Set Complex) := by + ext x + constructor + · intro hx + change ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (x = ctr j.succ ∨ ∃ k : Fin 3, (q k.succ).1 = 0 ∧ + x = ⟨if (q k.succ).2 = -1 then L else L + 2, + (ctr j.succ).im⟩) at hx + rcases hx with ⟨j, hj, hx | ⟨k, hk, _⟩⟩ + · simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + fin_cases j + · exact Or.inl hx + · exact Or.inr (Or.inl hx) + · exact Or.inr (Or.inr hx) + · have hz := hpositive k + omega + · intro hx + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hx + rcases hx with hx | hx | hx + · exact ⟨0, hpositive 0, Or.inl hx⟩ + · exact ⟨1, hpositive 1, Or.inl hx⟩ + · exact ⟨2, hpositive 2, Or.inl hx⟩ + · change p ∈ interior (convexHull Real + {x : Complex | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (x = ctr j.succ ∨ ∃ k : Fin 3, (q k.succ).1 = 0 ∧ + x = ⟨if (q k.succ).2 = -1 then L else L + 2, + (ctr j.succ).im⟩)}) + rw [hverts] + exact hinside + · intro j hj + have hd := circleDist 0 j.succ (by intro h; exact Fin.succ_ne_zero j h.symm) + hchild (hpositive j) + have htri := dist_triangle + (((q 0).2 : Complex) / (q 0).1) p + (((q j.succ).2 : Complex) / (q j.succ).1) + have hlower : + 1 / (q j.succ).1 < + dist p (((q j.succ).2 : Complex) / (q j.succ).1) := by + rw [hd, dist_comm (((q 0).2 : Complex) / (q 0).1) p] at htri + linarith + exact hlower + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1ConstructorSupport.lean b/LeanPool/ApollonianSuperharmonic/P4828T1ConstructorSupport.lean new file mode 100644 index 0000000000..faae0fafa3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1ConstructorSupport.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4828T1RotationLaws +public import LeanPool.ApollonianSuperharmonic.P4828T1Step +public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import Mathlib.Tactic.LinearCombination + +-- [TABLET NODE: P4828T1ConstructorSupport] + +/-! +# P4828T1ConstructorSupport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4828T1ConstructorSupport (L : Real) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hs : P4828T1LineSupport L q) (b : Fin 3) : + ProperBandQuadruple (P4828T1Step (P4828T1Rotate q b)) ∧ + P4828T1LineSupport L (P4828T1Step (P4828T1Rotate q b)) := by +-- BODY + let t := P4828T1Rotate q b + have ht : ProperBandQuadruple t := P4828T1RotationLaws.2.2 q b hq + let idx : Fin 4 → Fin 4 := Fin.cases 0 (fun j => (j + b).succ) + have hidx : ∀ k, t k = q (idx k) := by + intro k + refine Fin.cases ?_ (fun j => ?_) k <;> rfl + have hsign : P4828T1LineSupport L t := by + constructor + · intro k hk + simpa only [hidx] using hs.normals (idx k) (by simpa only [hidx] using hk) + · intro k j hk hj + simpa only [hidx] using hs.signed (idx k) (idx j) + (by simpa only [hidx] using hk) (by simpa only [hidx] using hj) + have facts := ProperBandCurvatureStructure t ht + have p0 := facts.1 + have n0 := (SemiProperForestClassification t ht.1).1 (0 : Fin 4) + have n1 := facts.2.1 (0 : Fin 3) + have n2 := facts.2.1 (1 : Fin 3) + have n3 := facts.2.1 (2 : Fin 3) + have lt1 := ht.2 (0 : Fin 3) + have lt2 := ht.2 (1 : Fin 3) + have lt3 := ht.2 (2 : Fin 3) + change (t 1).1 < (t 0).1 at lt1 + change (t 2).1 < (t 0).1 at lt2 + change (t 3).1 < (t 0).1 at lt3 + change 0 ≤ (t 1).1 at n1 + change 0 ≤ (t 2).1 at n2 + change 0 ≤ (t 3).1 at n3 + have dpos : 0 < (P4828T1Step t 0).1 := by + dsimp [P4828T1Step] + omega + have proper : ProperBandQuadruple (P4828T1Step t) := by + refine ⟨SemiProperQuadruple.successor ht.1, ?_⟩ + intro j + fin_cases j <;> dsimp [P4828T1Step] <;> omega + refine ⟨proper, ?_⟩ + change P4828T1LineSupport L (P4828T1Step t) + constructor + · intro k hk + fin_cases k + · exact (ne_of_gt dpos hk).elim + · exact (ne_of_gt p0 hk).elim + · exact hsign.normals 2 hk + · exact hsign.normals 3 hk + · intro k j hk hj + fin_cases k + · exact (ne_of_gt dpos hk).elim + · exact (ne_of_gt p0 hk).elim + · have hk' : (t 2).1 = 0 := hk + have p1 : 0 < (t 1).1 := by + have ne : (t 1).1 ≠ 0 := by + intro hz + have bad := facts.2.2 0 1 hz hk' + exact (by decide : (0 : Fin 3) ≠ 1) bad + omega + have p3 : 0 < (t 3).1 := by + have ne : (t 3).1 ≠ 0 := by + intro hz + have bad := facts.2.2 2 1 hz hk' + exact (by decide : (2 : Fin 3) ≠ 1) bad + omega + fin_cases j + · have h0 := hsign.signed 2 0 hk' p0 + have h1 := hsign.signed 2 1 hk' p1 + have h3 := hsign.signed 2 3 hk' p3 + rcases hsign.normals 2 hk' with hn | hn + all_goals norm_num [P4828T1Step, hn, hk'] at h0 h1 h3 ⊢ + all_goals linear_combination 2 * h0 - h1 + 2 * h3 + · exact hsign.signed 2 0 hk' hj + · exact hsign.signed 2 2 hk' hj + · exact hsign.signed 2 3 hk' hj + · have hk' : (t 3).1 = 0 := hk + have p1 : 0 < (t 1).1 := by + have ne : (t 1).1 ≠ 0 := by + intro hz + have bad := facts.2.2 0 2 hz hk' + exact (by decide : (0 : Fin 3) ≠ 2) bad + omega + have p2 : 0 < (t 2).1 := by + have ne : (t 2).1 ≠ 0 := by + intro hz + have bad := facts.2.2 1 2 hz hk' + exact (by decide : (1 : Fin 3) ≠ 2) bad + omega + fin_cases j + · have h0 := hsign.signed 3 0 hk' p0 + have h1 := hsign.signed 3 1 hk' p1 + have h2 := hsign.signed 3 2 hk' p2 + rcases hsign.normals 3 hk' with hn | hn + all_goals norm_num [P4828T1Step, hn, hk'] at h0 h1 h2 ⊢ + all_goals linear_combination 2 * h0 - h1 + 2 * h2 + · exact hsign.signed 3 0 hk' hj + · exact hsign.signed 3 2 hk' hj + · exact hsign.signed 3 3 hk' hj + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1Disk.lean b/LeanPool/ApollonianSuperharmonic/P4828T1Disk.lean new file mode 100644 index 0000000000..cb219effc1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1Disk.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates +public import Mathlib.Analysis.Complex.Norm + +-- [TABLET NODE: P4828T1Disk] + +/-! +# P4828T1Disk + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a positive-curvature coordinate $C=(c,w)$ let $D(C)$ be the open +Euclidean disk with center $w/c$ and radius $1/c$. The total expression +`P4828T1Disk` uses the same formula at other curvatures; no +geometric circle interpretation is assigned to those cases. +-/ +def P4828T1Disk (C : CircleCoordinates) : Set Complex := +-- BODY + Metric.ball ((C.2 : Complex) / (C.1 : Real)) (1 / (C.1 : Real)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1Evaluate.lean b/LeanPool/ApollonianSuperharmonic/P4828T1Evaluate.lean new file mode 100644 index 0000000000..3f9f7f1f3e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1Evaluate.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate +public import LeanPool.ApollonianSuperharmonic.P4828T1Step +public import LeanPool.ApollonianSuperharmonic.P4828T1Root + +-- [TABLET NODE: P4828T1Evaluate] + +/-! +# P4828T1Evaluate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $z\in\mathbb Z[i]$, a side $e\in\{-,+\}$, and a finite word $w$ +over $\mathbb Z/3\mathbb Z$, define $E(z,e,[]) = F(z,e)$ and +$$ + E(z,e,w b)=S(R_b E(z,e,w)). +$$ +Thus letters are read from left to right; $w b$ means appending one letter. +This evaluation is denoted by `P4828T1Evaluate`. +-/ +def P4828T1Evaluate (z : GaussianInt) (side : Bool) + (word : List (Fin 3)) : Fin 4 → CircleCoordinates := +-- BODY + word.foldl (fun q b => P4828T1Step (P4828T1Rotate q b)) + (P4828T1Root z side) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1FiniteWordSeparation.lean b/LeanPool/ApollonianSuperharmonic/P4828T1FiniteWordSeparation.lean new file mode 100644 index 0000000000..c67a662c97 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1FiniteWordSeparation.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Data.List.Induction +public import Mathlib.Order.SetNotation + +-- [TABLET NODE: P4828T1FiniteWordSeparation] + +/-! +# P4828T1FiniteWordSeparation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4828T1FiniteWordSeparation {A B X : Type*} + (G D : B → List A → Set X) + (hroot : ∀ a b, a ≠ b → Disjoint (G a []) (G b [])) + (hsub : ∀ a w b, G a (w ++ [b]) ⊆ G a w) + (hsibling : ∀ a w b c, b ≠ c → + Disjoint (G a (w ++ [b])) (G a (w ++ [c]))) + (hexclude : ∀ a w b, Disjoint (G a (w ++ [b])) (D a w)) + (hinside : ∀ a w, D a w ⊆ G a w) + (hnonempty : ∀ a w, (D a w).Nonempty) : + (∀ a u v, G a (u ++ v) ⊆ G a u) ∧ + (∀ a u b v, G a (u ++ b :: v) ⊂ G a u ∧ + Disjoint (G a (u ++ b :: v)) (D a u)) ∧ + (∀ a b u v, (a ≠ b ∨ (¬ u <+: v) ∧ (¬ v <+: u)) → + Disjoint (G a u) (G b v)) ∧ + ∀ a b u v, (a, u) ≠ (b, v) → Disjoint (D a u) (D b v) := by +-- BODY + classical + have descendant : ∀ a u v, G a (u ++ v) ⊆ G a u := by + intro a u v + induction v using List.reverseRecOn with + | nil => simp + | append_singleton v c ih => + simpa only [List.append_assoc] using (hsub a (u ++ v) c).trans ih + have avoid : ∀ a u b v, Disjoint (G a (u ++ b :: v)) (D a u) := by + intro a u b v + have h := descendant a (u ++ [b]) v + simp only [List.append_assoc, List.singleton_append] at h + exact (hexclude a u b).mono_left h + refine ⟨descendant, ?_, ?_, ?_⟩ + · intro a u b v + refine ⟨?_, avoid a u b v⟩ + apply Set.ssubset_iff_subset_ne.mpr + refine ⟨descendant a u (b :: v), ?_⟩ + intro heq + obtain ⟨p, hp⟩ := hnonempty a u + have hp' : p ∈ G a (u ++ b :: v) := by rw [heq]; exact hinside a u hp + exact Set.disjoint_left.mp (avoid a u b v) hp' hp + · have incomparable : ∀ a u v w, (¬ u <+: v) → (¬ v <+: u) → + Disjoint (G a (w ++ u)) (G a (w ++ v)) := by + intro a u + induction u with + | nil => + intro v w h + exact (h List.nil_prefix).elim + | cons b u ih => + intro v w huv hvu + cases v with + | nil => exact (hvu List.nil_prefix).elim + | cons c v => + by_cases hbc : b = c + · subst c + have h1 : ¬ u <+: v := fun h => huv ((List.prefix_cons_inj b).2 h) + have h2 : ¬ v <+: u := fun h => hvu ((List.prefix_cons_inj b).2 h) + simpa only [List.append_assoc, List.singleton_append] using + ih v (w ++ [b]) h1 h2 + · exact (hsibling a w b c hbc).mono + (by simpa only [List.append_assoc, List.singleton_append] using + descendant a (w ++ [b]) u) + (by simpa only [List.append_assoc, List.singleton_append] using + descendant a (w ++ [c]) v) + intro a b u v h + by_cases hab : a = b + · subst b + rcases h with h | h + · exact (h rfl).elim + · simpa using incomparable a u v [] h.1 h.2 + · exact (hroot a b hab).mono + (by simpa using descendant a [] u) (by simpa using descendant b [] v) + · have sameRoot : ∀ a u v w, u ≠ v → + Disjoint (D a (w ++ u)) (D a (w ++ v)) := by + intro a u + induction u with + | nil => + intro v w hne + cases v with + | nil => exact (hne rfl).elim + | cons b v => + simpa only [List.append_nil] using + ((avoid a w b v).mono_left (hinside a (w ++ b :: v))).symm + | cons b u ih => + intro v w hne + cases v with + | nil => + simpa only [List.append_nil] using + (avoid a w b u).mono_left (hinside a (w ++ b :: u)) + | cons c v => + by_cases hbc : b = c + · subst c + have huv : u ≠ v := by intro h; apply hne; rw [h] + simpa only [List.append_assoc, List.singleton_append] using + ih v (w ++ [b]) huv + · have hu := (hinside a (w ++ b :: u)).trans + (by simpa only [List.append_assoc, List.singleton_append] using + descendant a (w ++ [b]) u) + have hv := (hinside a (w ++ c :: v)).trans + (by simpa only [List.append_assoc, List.singleton_append] using + descendant a (w ++ [c]) v) + exact (hsibling a w b c hbc).mono hu hv + intro a b u v hne + by_cases hab : a = b + · subst b + have huv : u ≠ v := by intro h; exact hne (by rw [h]) + simpa using sameRoot a u v [] huv + · exact (hroot a b hab).mono + ((hinside a u).trans (by simpa using descendant a [] u)) + ((hinside b v).trans (by simpa using descendant b [] v)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1Gap.lean b/LeanPool/ApollonianSuperharmonic/P4828T1Gap.lean new file mode 100644 index 0000000000..7176354c29 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1Gap.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4828T1Disk +public import LeanPool.ApollonianSuperharmonic.P4909T1ParentPolygon + +-- [TABLET NODE: P4828T1Gap] + +/-! +# P4828T1Gap + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $L\in\mathbb R$ and +$q:\operatorname{Fin}4\to\texttt{CircleCoordinates}$ be arbitrary. +Use the closed parent hull $P_L(q)$, positive-parent index set $J_+$, +and centers $p_j=w_j/c_j$ from `P4909T1ParentPolygon`, with +all its raw-input and contextual supporting-line conventions. +The open gap, denoted by `P4828T1Gap`, is +$$ + G_L(q)=\operatorname{int}_{\mathbb C}P_L(q)\cap + \bigcap_{j\in J_+}\{z\in\mathbb C:|z-p_j|>1/c_j\}. +$$ +Here the interior is the ambient planar interior, and each strict +inequality specifies the exterior of the positive parent's closed disk. +Zero- and negative-curvature parents impose no disk exclusions, and +the entry $q_0$ is entirely unused. No properness, tangency, or +nondegeneracy assumption is imposed. In particular, the ambient +interior makes the gap empty whenever the parent hull has empty +planar interior. +-/ +def P4828T1Gap (L : Real) (q : Fin 4 → CircleCoordinates) : Set Complex := +-- BODY + let center (j : Fin 3) : Complex := (q j.succ).2 / ((q j.succ).1 : Real) + {p | p ∈ interior (P4909T1ParentPolygon L q) ∧ + ∀ j : Fin 3, 0 < (q j.succ).1 → + (1 / ((q j.succ).1 : Real)) < dist p (center j)} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1HistoryNormalForm.lean b/LeanPool/ApollonianSuperharmonic/P4828T1HistoryNormalForm.lean new file mode 100644 index 0000000000..67d287f75f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1HistoryNormalForm.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4828T1Evaluate +public import LeanPool.ApollonianSuperharmonic.P4828T1RotationLaws +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification + +-- [TABLET NODE: P4828T1HistoryNormalForm] + +/-! +# P4828T1HistoryNormalForm + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4828T1HistoryNormalForm (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) : + ∃ z : GaussianInt, ∃ side : Bool, ∃ word : List (Fin 3), ∃ r : Fin 3, + q = P4828T1Rotate (P4828T1Evaluate z side word) r := by +-- BODY + have main : ∀ q : Fin 4 → CircleCoordinates, SemiProperQuadruple q → + ProperBandQuadruple q → + ∃ z : GaussianInt, ∃ side : Bool, ∃ word : List (Fin 3), ∃ r : Fin 3, + q = P4828T1Rotate (P4828T1Evaluate z side word) r := by + intro q hs + induction hs with + | base z => + intro hp + have bad := hp.2 (0 : Fin 3) + norm_num at bad + | @rotate q hs ih => + intro hp + have old : ProperBandQuadruple q := by + refine ⟨hs, ?_⟩ + intro j + fin_cases j + · simpa using hp.2 2 + · simpa using hp.2 0 + · simpa using hp.2 1 + obtain ⟨z, side, word, r, hr⟩ := ih old + refine ⟨z, side, word, 1 + r, ?_⟩ + calc + ![q 0, q 2, q 3, q 1] = P4828T1Rotate q 1 := by + funext k; fin_cases k <;> rfl + _ = P4828T1Rotate (P4828T1Rotate + (P4828T1Evaluate z side word) r) 1 := by rw [hr] + _ = _ := P4828T1RotationLaws.2.1 _ _ _ + | @successor q hs ih => + intro hp + rcases (SemiProperForestClassification q hs).2 with root | root | root | proper + · obtain ⟨z, hz⟩ := root + have bad := hp.2 (0 : Fin 3) + simp [hz] at bad + · obtain ⟨z, hz⟩ := root + refine ⟨z, false, [], 0, ?_⟩ + rw [P4828T1RotationLaws.1] + rw [hz] + funext k + fin_cases k <;> simp [P4828T1Evaluate, P4828T1Root]; ring + · obtain ⟨z, hz⟩ := root + refine ⟨z, true, [], 0, ?_⟩ + rw [P4828T1RotationLaws.1] + rw [hz] + funext k + fin_cases k <;> simp [P4828T1Evaluate, P4828T1Root]; ring + · obtain ⟨z, side, word, r, hr⟩ := ih proper + refine ⟨z, side, word ++ [r], 0, ?_⟩ + rw [P4828T1RotationLaws.1] + change P4828T1Step q = _ + rw [hr] + simp [P4828T1Evaluate, List.foldl_append] + exact main q hq.1 hq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1HistoryRealization.lean b/LeanPool/ApollonianSuperharmonic/P4828T1HistoryRealization.lean new file mode 100644 index 0000000000..429152bd26 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1HistoryRealization.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4828T1Evaluate +public import LeanPool.ApollonianSuperharmonic.P4828T1LeftRootGeometry +public import LeanPool.ApollonianSuperharmonic.P4828T1RightRootGeometry +public import LeanPool.ApollonianSuperharmonic.P4828T1CircularPlacement +public import LeanPool.ApollonianSuperharmonic.P4828T1LinePlacement +public import LeanPool.ApollonianSuperharmonic.P4828T1ConstructorSupport +public import LeanPool.ApollonianSuperharmonic.P4828T1ResidualPatches + +-- [TABLET NODE: P4828T1HistoryRealization] + +/-! +# P4828T1HistoryRealization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4828T1HistoryRealization (a : GaussianInt) (side : Bool) + (word : List (Fin 3)) : + let L : Real := 2 * (a.re : Real) + let q := P4828T1Evaluate a side word + (ProperBandQuadruple q ∧ P4828T1LineSupport L q ∧ + P4828T1Disk (q 0) ⊆ P4828T1Gap L q) ∧ + (∀ b : Fin 3, + P4828T1Gap L (P4828T1Evaluate a side (word ++ [b])) ⊆ + P4828T1Gap L q ∧ + Disjoint (P4828T1Gap L (P4828T1Evaluate a side (word ++ [b]))) + (P4828T1Disk (q 0))) ∧ + (∀ b c : Fin 3, b ≠ c → + Disjoint (P4828T1Gap L (P4828T1Evaluate a side (word ++ [b]))) + (P4828T1Gap L (P4828T1Evaluate a side (word ++ [c])))) := by +-- BODY + have state : ∀ w : List (Fin 3), + let q := P4828T1Evaluate a side w + ProperBandQuadruple q ∧ P4828T1LineSupport (2 * (a.re : Real)) q ∧ + P4828T1Disk (q 0) ⊆ P4828T1Gap (2 * (a.re : Real)) q := by + intro w + induction w using List.reverseRecOn with + | nil => + cases side + · exact ⟨(P4828T1LeftRootGeometry a).1, + (P4828T1LeftRootGeometry a).2.1, + (P4828T1LeftRootGeometry a).2.2.1⟩ + · exact ⟨(P4828T1RightRootGeometry a).1, + (P4828T1RightRootGeometry a).2.1, + (P4828T1RightRootGeometry a).2.2.1⟩ + | append_singleton w b ih => + obtain ⟨proper, signed, _⟩ := ih + have inherited := P4828T1ConstructorSupport (2 * (a.re : Real)) + (P4828T1Evaluate a side w) proper signed b + have heval : P4828T1Evaluate a side (w ++ [b]) = + P4828T1Step (P4828T1Rotate (P4828T1Evaluate a side w) b) := by + simp [P4828T1Evaluate, List.foldl_append] + rw [heval] + refine ⟨inherited.1, inherited.2, ?_⟩ + by_cases positive : ∀ j : Fin 3, + 0 < (P4828T1Step (P4828T1Rotate + (P4828T1Evaluate a side w) b) j.succ).1 + · exact P4828T1CircularPlacement _ _ inherited.1 positive + · push Not at positive + obtain ⟨j, hj⟩ := positive + have hn := (ProperBandCurvatureStructure _ inherited.1).2.1 j + exact P4828T1LinePlacement _ _ inherited.1 inherited.2 ⟨j, by omega⟩ + have h := state word + have patches := P4828T1ResidualPatches (2 * (a.re : Real)) + (P4828T1Evaluate a side word) h.1 h.2.1 h.2.2 + refine ⟨h, ?_, ?_⟩ + · intro b + simpa only [P4828T1Evaluate, List.foldl_append, List.foldl_cons, + List.foldl_nil] using patches.1 b + · intro b c hbc + simpa only [P4828T1Evaluate, List.foldl_append, List.foldl_cons, + List.foldl_nil] using patches.2.1 b c hbc + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean new file mode 100644 index 0000000000..1c9b6f6d8c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean @@ -0,0 +1,576 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4828T1Root +public import LeanPool.ApollonianSuperharmonic.P4828T1Gap +public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Analysis.Complex.ReImTopology + +-- [TABLET NODE: P4828T1LeftRootGeometry] + +/-! +# P4828T1LeftRootGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RootGeometryLeft + +private noncomputable def q (a : GaussianInt) := P4828T1Root a false + +private noncomputable def L (a : GaussianInt) : Real := 2 * (a.re : Real) + +private noncomputable def y (a : GaussianInt) : Real := 2 * (a.im : Real) + +private noncomputable def vertices (a : GaussianInt) : Set Complex := {p | ∃ j : Fin 3, 0 < ((q + a) j.succ).1 ∧ + (p = ((q a) j.succ).2 / (((q a) j.succ).1 : Real) ∨ ∃ k : Fin 3, + ((q a) k.succ).1 = 0 ∧ p = ⟨if ((q a) k.succ).2 = -1 then (L a) else (L a) + 2, + ((((q a) j.succ).2 : Complex) / (((q a) j.succ).1 : Real)).im⟩)} + +private noncomputable def bl (a : GaussianInt) : Complex := ⟨(L a), (y a)⟩ + +private noncomputable def br (a : GaussianInt) : Complex := ⟨(L a) + 1, (y a)⟩ + +private noncomputable def tl (a : GaussianInt) : Complex := ⟨(L a), (y a) + 2⟩ + +private noncomputable def tr (a : GaussianInt) : Complex := ⟨(L a) + 1, (y a) + 2⟩ + +private theorem hU0 (a : GaussianInt) : ((1 + 2 * a : GaussianInt) : Complex) = ⟨(L a) + 1, (y + a)⟩ := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + change (((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩) + rw [GaussianInt.toComplex_def₂] + apply Complex.ext <;> simp [Zsqrtd.re_add, Zsqrtd.re_mul, + Zsqrtd.im_add, Zsqrtd.im_mul, L, y]; ring + +private theorem hU1 (a : GaussianInt) : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = + ⟨(L a) + 1, (y a) + 2⟩ := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + change (((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = + ⟨L + 1, y + 2⟩) + rw [GaussianInt.toComplex_def₂] + apply Complex.ext <;> simp [Zsqrtd.re_add, Zsqrtd.re_mul, + Zsqrtd.im_add, Zsqrtd.im_mul, L, y]; ring + +private theorem hU0c (a : GaussianInt) : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) = ⟨(L a) + 1, (y a)⟩ := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + have hU0 : ((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩ := hU0 a + change ((1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) = ⟨L + 1, y⟩) + rw [GaussianInt.toComplex_add, GaussianInt.toComplex_one] at hU0 + rw [GaussianInt.toComplex_mul] at hU0 + exact hU0 + +private theorem hU1c (a : GaussianInt) : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (⟨0, 1⟩ : GaussianInt) = ⟨(L a) + 1, (y a) + 2⟩ := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + have hU1 : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = + ⟨L + 1, y + 2⟩ := hU1 a + change ((1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (⟨0, 1⟩ : GaussianInt) = ⟨L + 1, y + 2⟩) + rw [GaussianInt.toComplex_add, GaussianInt.toComplex_add, + GaussianInt.toComplex_one] at hU1 + rw [GaussianInt.toComplex_mul, GaussianInt.toComplex_mul] at hU1 + exact hU1 + +private theorem htwo_re : (GaussianInt.toComplex (2 : GaussianInt)).re = 2 := by + classical + norm_num [GaussianInt.toComplex_def] + +private theorem htwo_im : (GaussianInt.toComplex (2 : GaussianInt)).im = 0 := by + classical + norm_num [GaussianInt.toComplex_def] + +private theorem hvertices (a : GaussianInt) : (vertices a) = {(bl a), (br a), (tl a), (tr a)} := by + classical + let q := P4828T1Root a false + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, + (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, + (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} + let bl : Complex := ⟨L, y⟩ + let br : Complex := ⟨L + 1, y⟩ + let tl : Complex := ⟨L, y + 2⟩ + let tr : Complex := ⟨L + 1, y + 2⟩ + have hU0 : ((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩ := hU0 a + have hU1 : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = + ⟨L + 1, y + 2⟩ := hU1 a + have hU0c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) = ⟨L + 1, y⟩ := hU0c a + have hU1c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (⟨0, 1⟩ : GaussianInt) = ⟨L + 1, y + 2⟩ := hU1c a + have htwo_re : (GaussianInt.toComplex (2 : GaussianInt)).re = 2 := htwo_re + have htwo_im : (GaussianInt.toComplex (2 : GaussianInt)).im = 0 := htwo_im + change (vertices = {bl, br, tl, tr}) + ext p + constructor + · rintro ⟨j, hj, hp⟩ + fin_cases j + · simp? [q, P4828T1Root] at hj hp + rcases hp with hp | ⟨k, hk, hp⟩ + · subst p + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + right; left + simpa [br] using hU0c + · fin_cases k + · simp [] at hk + · simp [] at hk + subst p + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + left + apply Complex.ext <;> simp [bl, L, y, htwo_re, htwo_im, + ] + · simp [] at hk + · simp [q, P4828T1Root] at hj + · simp? [q, P4828T1Root] at hj hp + rcases hp with hp | ⟨k, hk, hp⟩ + · subst p + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + right; right; right + simpa [tr] using hU1c + · fin_cases k + · simp [] at hk + · simp [] at hk + subst p + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + right; right; left + apply Complex.ext <;> simp [tl, L, y, htwo_re, htwo_im, + ] + · simp [] at hk + · intro hp + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hp + rcases hp with hp | hp | hp | hp + · subst p + exact ⟨⟨0, by omega⟩, + by change 0 < (P4828T1Root a false ⟨1, by omega⟩).1; change 0 < 1; norm_num, + Or.inr ⟨⟨1, by omega⟩, + by change (P4828T1Root a false ⟨2, by omega⟩).1 = 0; change (0 : ℤ) = 0; rfl, + by apply Complex.ext <;> simp [bl, q, P4828T1Root, L, y, htwo_re, htwo_im, + ] ⟩⟩ + · subst p + exact ⟨⟨0, by omega⟩, + by change 0 < (P4828T1Root a false ⟨1, by omega⟩).1; change 0 < 1; norm_num, + Or.inl (by simpa [q, P4828T1Root] using hU0.symm)⟩ + · subst p + exact ⟨⟨2, by omega⟩, + by change 0 < (P4828T1Root a false ⟨3, by omega⟩).1; change 0 < 1; norm_num, + Or.inr ⟨⟨1, by omega⟩, + by change (P4828T1Root a false ⟨2, by omega⟩).1 = 0; change (0 : ℤ) = 0; rfl, + by apply Complex.ext <;> simp [tl, q, P4828T1Root, L, y, htwo_re, htwo_im, + ] ⟩⟩ + · subst p + exact ⟨⟨2, by omega⟩, + by change 0 < (P4828T1Root a false ⟨3, by omega⟩).1; change 0 < 1; norm_num, + Or.inl (by simpa [q, P4828T1Root] using hU1.symm)⟩ + +private theorem himage (a : GaussianInt) : Complex.equivRealProdLm '' (vertices a) = + ({(L a), (L a) + 1} : Set Real) ×ˢ {(y a), (y a) + 2} := by + classical + let q := P4828T1Root a false + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, + (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, + (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} + let bl : Complex := ⟨L, y⟩ + let br : Complex := ⟨L + 1, y⟩ + let tl : Complex := ⟨L, y + 2⟩ + let tr : Complex := ⟨L + 1, y + 2⟩ + have hvertices : vertices = {bl, br, tl, tr} := hvertices a + change (Complex.equivRealProdLm '' vertices = + ({L, L + 1} : Set Real) ×ˢ {y, y + 2}) + rw [hvertices] + ext z + simp [bl, br, tl, tr, Complex.equivRealProdLm]; aesop + +private theorem hcornerHull (a : GaussianInt) : convexHull Real + (({(L a), (L a) + 1} : Set Real) ×ˢ ({(y a), (y a) + 2} : Set Real)) = + Set.Icc (L a) ((L a) + 1) ×ˢ Set.Icc (y a) ((y a) + 2) := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + change (convexHull Real + (({L, L + 1} : Set Real) ×ˢ ({y, y + 2} : Set Real)) = + Set.Icc L (L + 1) ×ˢ Set.Icc y (y + 2)) + rw [convexHull_prod, convexHull_pair, convexHull_pair, + segment_eq_Icc (by linarith), segment_eq_Icc (by linarith)] + +private theorem hrectImage (a : GaussianInt) : Complex.equivRealProdLm '' + ((Set.Icc (L a) ((L a) + 1)) ×ℂ (Set.Icc (y a) ((y a) + 2))) = + Set.Icc (L a) ((L a) + 1) ×ˢ Set.Icc (y a) ((y a) + 2) := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + change (Complex.equivRealProdLm '' + ((Set.Icc L (L + 1)) ×ℂ (Set.Icc y (y + 2))) = + Set.Icc L (L + 1) ×ˢ Set.Icc y (y + 2)) + ext z + simp only [Set.mem_image, Set.mem_prod, Complex.mem_reProdIm] + constructor + · rintro ⟨p, ⟨hp, hp'⟩, rfl⟩ + exact ⟨hp, hp'⟩ + · rintro ⟨hz, hz'⟩ + refine ⟨Complex.equivRealProdLm.symm z, ?_, Complex.equivRealProdLm.apply_symm_apply z⟩ + constructor + · simpa [Complex.equivRealProdLm_symm_apply] using hz + · simpa [Complex.equivRealProdLm_symm_apply] using hz' + +private theorem himageLin (a : GaussianInt) : Complex.equivRealProdLm.toLinearMap '' (vertices a) = + ({(L a), (L a) + 1} : Set Real) ×ˢ {(y a), (y a) + 2} := by + classical + let q := P4828T1Root a false + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, + (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, + (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} + have himage : Complex.equivRealProdLm '' vertices = + ({L, L + 1} : Set Real) ×ˢ {y, y + 2} := himage a + change (Complex.equivRealProdLm.toLinearMap '' vertices = + ({L, L + 1} : Set Real) ×ˢ {y, y + 2}) + change Complex.equivRealProdLm '' vertices = _ + exact himage + +private theorem hrectImageLin (a : GaussianInt) : Complex.equivRealProdLm.toLinearMap '' + ((Set.Icc (L a) ((L a) + 1)) ×ℂ (Set.Icc (y a) ((y a) + 2))) = + Set.Icc (L a) ((L a) + 1) ×ˢ Set.Icc (y a) ((y a) + 2) := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + have hrectImage : Complex.equivRealProdLm '' + ((Set.Icc L (L + 1)) ×ℂ (Set.Icc y (y + 2))) = + Set.Icc L (L + 1) ×ˢ Set.Icc y (y + 2) := hrectImage a + change (Complex.equivRealProdLm.toLinearMap '' + ((Set.Icc L (L + 1)) ×ℂ (Set.Icc y (y + 2))) = + Set.Icc L (L + 1) ×ˢ Set.Icc y (y + 2)) + change Complex.equivRealProdLm '' + ((Set.Icc L (L + 1)) ×ℂ (Set.Icc y (y + 2))) = _ + exact hrectImage + +private theorem hHull (a : GaussianInt) : convexHull Real (vertices a) = + (Set.Icc (L a) ((L a) + 1)) ×ℂ (Set.Icc (y a) ((y a) + 2)) := by + classical + let q := P4828T1Root a false + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, + (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, + (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} + have hcornerHull : convexHull Real + (({L, L + 1} : Set Real) ×ˢ ({y, y + 2} : Set Real)) = + Set.Icc L (L + 1) ×ˢ Set.Icc y (y + 2) := hcornerHull a + have himageLin : Complex.equivRealProdLm.toLinearMap '' vertices = + ({L, L + 1} : Set Real) ×ˢ {y, y + 2} := himageLin a + have hrectImageLin : Complex.equivRealProdLm.toLinearMap '' + ((Set.Icc L (L + 1)) ×ℂ (Set.Icc y (y + 2))) = + Set.Icc L (L + 1) ×ˢ Set.Icc y (y + 2) := hrectImageLin a + change (convexHull Real vertices = + (Set.Icc L (L + 1)) ×ℂ (Set.Icc y (y + 2))) + apply (Set.image_injective.mpr Complex.equivRealProdLm.injective) + have hlin := LinearMap.image_convexHull + Complex.equivRealProdLm.toLinearMap vertices + change Complex.equivRealProdLm.toLinearMap '' + (convexHull Real vertices) = Complex.equivRealProdLm.toLinearMap '' + ((Set.Icc L (L + 1)) ×ℂ (Set.Icc y (y + 2))) + rw [hlin, himageLin, hcornerHull, hrectImageLin] + +private theorem rectangleInterior (l u v w : Real) : + interior (Set.Icc l u ×ℂ Set.Icc v w) = + {z : Complex | l < z.re ∧ z.re < u ∧ v < z.im ∧ z.im < w} := by + classical + ext z + simp [Complex.interior_reProdIm, interior_Icc, Complex.mem_reProdIm, Set.mem_Ioo, and_assoc] + +private theorem hInterior (a : GaussianInt) : interior (convexHull Real (vertices a)) = + {p : Complex | (L a) < p.re ∧ p.re < (L a) + 1 ∧ (y a) < p.im ∧ p.im < (y a) + 2} := by + classical + let q := P4828T1Root a false + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, + (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, + (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} + have hHull : convexHull Real vertices = + (Set.Icc L (L + 1)) ×ℂ (Set.Icc y (y + 2)) := hHull a + have rectangleInterior (l u v w : Real) : + interior (Set.Icc l u ×ℂ Set.Icc v w) = + {z : Complex | l < z.re ∧ z.re < u ∧ v < z.im ∧ z.im < w} := rectangleInterior l u v w + change (interior (convexHull Real vertices) = + {p : Complex | L < p.re ∧ p.re < L + 1 ∧ y < p.im ∧ p.im < y + 2}) + rw [hHull] + exact rectangleInterior L (L + 1) y (y + 2) + +private theorem hcenter0 (a : GaussianInt) : + (((q a) (0 : Fin 3).succ).2 : Complex) / (((q a) (0 : Fin 3).succ).1 : Real) = + ((1 + 2 * a : GaussianInt) : Complex) := by + classical + let q := P4828T1Root a false + change (((q (0 : Fin 3).succ).2 : Complex) / ((q (0 : Fin 3).succ).1 : Real) = + ((1 + 2 * a : GaussianInt) : Complex)) + simp [q, P4828T1Root] + +private theorem hcenter1 (a : GaussianInt) : + (((q a) (2 : Fin 3).succ).2 : Complex) / (((q a) (2 : Fin 3).succ).1 : Real) = + ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) := by + classical + let q := P4828T1Root a false + change (((q (2 : Fin 3).succ).2 : Complex) / ((q (2 : Fin 3).succ).1 : Real) = + ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)) + simp [q, P4828T1Root] + +private theorem hGap (a : GaussianInt) : P4828T1Gap (L a) (q a) = {p : Complex | + (L a) < p.re ∧ p.re < (L a) + 1 ∧ (y a) < p.im ∧ p.im < (y a) + 2 ∧ + 1 < dist p ((1 + 2 * a : GaussianInt) : Complex) ∧ + 1 < dist p ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)} := by + classical + let q := P4828T1Root a false + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, + (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, + (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} + have hInterior : interior (convexHull Real vertices) = + {p : Complex | L < p.re ∧ p.re < L + 1 ∧ y < p.im ∧ p.im < y + 2} := hInterior a + have hcenter0 : + ((q (0 : Fin 3).succ).2 : Complex) / ((q (0 : Fin 3).succ).1 : Real) = + ((1 + 2 * a : GaussianInt) : Complex) := hcenter0 a + have hcenter1 : + ((q (2 : Fin 3).succ).2 : Complex) / ((q (2 : Fin 3).succ).1 : Real) = + ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) := hcenter1 a + change (P4828T1Gap L q = {p : Complex | + L < p.re ∧ p.re < L + 1 ∧ y < p.im ∧ p.im < y + 2 ∧ + 1 < dist p ((1 + 2 * a : GaussianInt) : Complex) ∧ + 1 < dist p ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)}) + ext p + change (p ∈ interior (convexHull Real vertices) ∧ + ∀ j : Fin 3, 0 < (q j.succ).1 → + (1 / ((q j.succ).1 : Real)) < + dist p (((q j.succ).2 : Complex) / ((q j.succ).1 : Real))) ↔ _ + rw [hInterior] + constructor + · rintro ⟨⟨hxl, hxr, hyl, hyr⟩, hdist⟩ + have hd0 := hdist 0 (by simp [q, P4828T1Root]) + have hd1 := hdist 2 (by simp [q, P4828T1Root]) + refine ⟨hxl, hxr, hyl, hyr, ?_, ?_⟩ + · simpa [q, P4828T1Root, hcenter0] using hd0 + · simpa [q, P4828T1Root, hcenter1] using hd1 + · rintro ⟨hxl, hxr, hyl, hyr, hd0, hd1⟩ + refine ⟨?_, ?_⟩ + · exact ⟨hxl, hxr, hyl, hyr⟩ + · intro j hj + fin_cases j + · simpa [q, P4828T1Root, hcenter0] using hd0 + · simp [q, P4828T1Root] at hj + · simpa [q, P4828T1Root, hcenter1] using hd1 + +private noncomputable def child (a : GaussianInt) : Complex := ⟨(L a) + 1 / 4, (y a) + 1⟩ + +private theorem hchild (a : GaussianInt) : + (((q a) (0 : Fin 4)).2 : Complex) / (((q a) (0 : Fin 4)).1 : Real) = (child a) := by + classical + let q := P4828T1Root a false + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let child : Complex := ⟨L + 1 / 4, y + 1⟩ + change (((q (0 : Fin 4)).2 : Complex) / ((q (0 : Fin 4)).1 : Real) = child) + change ((1 + 8 * a + 4 * ⟨0, 1⟩ : GaussianInt) : Complex) / 4 = _ + rw [GaussianInt.toComplex_def₂] + apply Complex.ext + · simp [child, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.im_add, Zsqrtd.im_mul, + L]; field_simp; ring + · simp [child, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.im_add, Zsqrtd.im_mul, + y]; field_simp; ring + +private theorem hs25 : Real.sqrt (25 : Real) = 5 := by + classical + rw [show (25 : Real) = 5 * 5 by norm_num] + exact Real.sqrt_mul_self (by norm_num) + +private theorem hs16 : Real.sqrt (16 : Real) = 4 := by + classical + rw [show (16 : Real) = 4 * 4 by norm_num] + exact Real.sqrt_mul_self (by norm_num) + +private theorem hdist0 (a : GaussianInt) : dist (child a) (br a) = (5 : Real) / 4 := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let br : Complex := ⟨L + 1, y⟩ + let child : Complex := ⟨L + 1 / 4, y + 1⟩ + have hs25 : Real.sqrt (25 : Real) = 5 := hs25 + have hs16 : Real.sqrt (16 : Real) = 4 := hs16 + change (dist child br = (5 : Real) / 4) + norm_num [Complex.dist_eq, Complex.norm_def, Complex.normSq_apply, + hs25, hs16, child, br] + +private theorem hdist1 (a : GaussianInt) : dist (child a) (tr a) = (5 : Real) / 4 := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let tr : Complex := ⟨L + 1, y + 2⟩ + let child : Complex := ⟨L + 1 / 4, y + 1⟩ + have hs25 : Real.sqrt (25 : Real) = 5 := hs25 + have hs16 : Real.sqrt (16 : Real) = 4 := hs16 + change (dist child tr = (5 : Real) / 4) + norm_num [Complex.dist_eq, Complex.norm_def, Complex.normSq_apply, + hs25, hs16, child, tr] + +end RootGeometryLeft + +theorem P4828T1LeftRootGeometry (a : GaussianInt) : + let q := P4828T1Root a false + let L : Real := 2 * (a.re : Real) + ProperBandQuadruple q ∧ P4828T1LineSupport L q ∧ + P4828T1Disk (q 0) ⊆ P4828T1Gap L q ∧ + P4828T1Gap L q = {p : Complex | + L < p.re ∧ p.re < L + 1 ∧ + 2 * (a.im : Real) < p.im ∧ p.im < 2 * (a.im : Real) + 2 ∧ + 1 < dist p ((1 + 2 * a : GaussianInt) : Complex) ∧ + 1 < dist p ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)} := by +-- BODY + dsimp only + let q := P4828T1Root a false + let L : Real := 2 * (a.re : Real) + constructor + · constructor + · convert (SemiProperQuadruple.successor + (SemiProperQuadruple.rotate (SemiProperQuadruple.base a))) using 1; + simp [P4828T1Root]; ring + · intro j + fin_cases j <;> simp [P4828T1Root] + constructor + · refine ⟨?_, ?_⟩ + · intro k hk + fin_cases k <;> simp [P4828T1Root] at hk ⊢ + · intro k j hk hj + fin_cases k <;> fin_cases j <;> + simp [P4828T1Root] at hk hj ⊢; ring + let y : Real := 2 * (a.im : Real) + let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, + (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, + (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} + let bl : Complex := ⟨L, y⟩ + let br : Complex := ⟨L + 1, y⟩ + let tl : Complex := ⟨L, y + 2⟩ + let tr : Complex := ⟨L + 1, y + 2⟩ + have hU0 : ((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩ := RootGeometryLeft.hU0 a + have hU1 : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = + ⟨L + 1, y + 2⟩ := RootGeometryLeft.hU1 a + have hU0c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) = ⟨L + 1, y⟩ := RootGeometryLeft.hU0c a + have hU1c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (⟨0, 1⟩ : GaussianInt) = ⟨L + 1, y + 2⟩ := RootGeometryLeft.hU1c a + have htwo_re : (GaussianInt.toComplex (2 : GaussianInt)).re = 2 := RootGeometryLeft.htwo_re + have htwo_im : (GaussianInt.toComplex (2 : GaussianInt)).im = 0 := RootGeometryLeft.htwo_im + have hvertices : vertices = {bl, br, tl, tr} := RootGeometryLeft.hvertices a + have himage : Complex.equivRealProdLm '' vertices = + ({L, L + 1} : Set Real) ×ˢ {y, y + 2} := RootGeometryLeft.himage a + have hcornerHull : convexHull Real + (({L, L + 1} : Set Real) ×ˢ ({y, y + 2} : Set Real)) = + Set.Icc L (L + 1) ×ˢ Set.Icc y (y + 2) := RootGeometryLeft.hcornerHull a + have hrectImage : Complex.equivRealProdLm '' + ((Set.Icc L (L + 1)) ×ℂ (Set.Icc y (y + 2))) = + Set.Icc L (L + 1) ×ˢ Set.Icc y (y + 2) := RootGeometryLeft.hrectImage a + have himageLin : Complex.equivRealProdLm.toLinearMap '' vertices = + ({L, L + 1} : Set Real) ×ˢ {y, y + 2} := RootGeometryLeft.himageLin a + have hrectImageLin : Complex.equivRealProdLm.toLinearMap '' + ((Set.Icc L (L + 1)) ×ℂ (Set.Icc y (y + 2))) = + Set.Icc L (L + 1) ×ˢ Set.Icc y (y + 2) := RootGeometryLeft.hrectImageLin a + have hHull : convexHull Real vertices = + (Set.Icc L (L + 1)) ×ℂ (Set.Icc y (y + 2)) := RootGeometryLeft.hHull a + have rectangleInterior (l u v w : Real) : + interior (Set.Icc l u ×ℂ Set.Icc v w) = + {z : Complex | l < z.re ∧ z.re < u ∧ v < z.im ∧ z.im < w} := + RootGeometryLeft.rectangleInterior l u v w + have hInterior : interior (convexHull Real vertices) = + {p : Complex | L < p.re ∧ p.re < L + 1 ∧ y < p.im ∧ p.im < y + 2} := + RootGeometryLeft.hInterior a + have hcenter0 : + ((q (0 : Fin 3).succ).2 : Complex) / ((q (0 : Fin 3).succ).1 : Real) = + ((1 + 2 * a : GaussianInt) : Complex) := RootGeometryLeft.hcenter0 a + have hcenter1 : + ((q (2 : Fin 3).succ).2 : Complex) / ((q (2 : Fin 3).succ).1 : Real) = + ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) := RootGeometryLeft.hcenter1 a + have hGap : P4828T1Gap L q = {p : Complex | + L < p.re ∧ p.re < L + 1 ∧ y < p.im ∧ p.im < y + 2 ∧ + 1 < dist p ((1 + 2 * a : GaussianInt) : Complex) ∧ + 1 < dist p ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)} := RootGeometryLeft.hGap a + let child : Complex := ⟨L + 1 / 4, y + 1⟩ + have hchild : + ((q (0 : Fin 4)).2 : Complex) / ((q (0 : Fin 4)).1 : Real) = child := + RootGeometryLeft.hchild a + have hs25 : Real.sqrt (25 : Real) = 5 := RootGeometryLeft.hs25 + have hs16 : Real.sqrt (16 : Real) = 4 := RootGeometryLeft.hs16 + have hdist0 : dist child br = (5 : Real) / 4 := RootGeometryLeft.hdist0 a + have hdist1 : dist child tr = (5 : Real) / 4 := RootGeometryLeft.hdist1 a + · constructor + · rw [hGap] + intro p hp + have hballMember : dist p + (((q (0 : Fin 4)).2 : Complex) / ((q (0 : Fin 4)).1 : Real)) < + 1 / ((q (0 : Fin 4)).1 : Real) := by + simpa [P4828T1Disk] using hp + rw [hchild] at hballMember + have hcurv0 : (q (0 : Fin 4)).1 = 4 := by + change (P4828T1Root a false ⟨0, by omega⟩).1 = 4 + norm_num [P4828T1Root] + rw [hcurv0] at hballMember + have hpball : dist p child < (1 : Real) / 4 := by + simpa using hballMember + have hnorm : ‖p - child‖ < (1 : Real) / 4 := by + simpa [Complex.dist_eq] using hpball + have hre : |p.re - (L + 1 / 4)| < (1 : Real) / 4 := by + have h := lt_of_le_of_lt (Complex.abs_re_le_norm (p - child)) hnorm + simpa [child, Complex.sub_re] using h + have him : |p.im - (y + 1)| < (1 : Real) / 4 := by + have h := lt_of_le_of_lt (Complex.abs_im_le_norm (p - child)) hnorm + simpa [child, Complex.sub_im] using h + have hre' := abs_lt.mp hre + have him' := abs_lt.mp him + have htri0 := dist_triangle child p br + have htri1 := dist_triangle child p tr + rw [dist_comm child p] at htri0 htri1 + have hparent0 : 1 < dist p br := by linarith + have hparent1 : 1 < dist p tr := by linarith + refine ⟨by linarith [hre'.1], by linarith [hre'.2], + by linarith [him'.1], by linarith [him'.2], ?_, ?_⟩ + · simpa [br, hU0] using hparent0 + · simpa [tr, hU1] using hparent1 + · simpa [y, L, q, P4828T1Root] using hGap + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1LinePlacement.lean b/LeanPool/ApollonianSuperharmonic/P4828T1LinePlacement.lean new file mode 100644 index 0000000000..28ec1ea60e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1LinePlacement.lean @@ -0,0 +1,401 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4828T1Gap +public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.P4903T1ScalarTangencies +public import LeanPool.ApollonianSuperharmonic.P4903T1SignedDiskHull + +-- [TABLET NODE: P4828T1LinePlacement] + +/-! +# P4828T1LinePlacement + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace LinePlacementConstruction + +private theorem hparent_nonneg (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) : ∀ i + : Fin 3, 0 ≤ (q i.succ).1 := by + classical + have hc := ProperBandCurvatureStructure q hq + exact hc.2.1 + +private theorem hparent_pos (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (j : Fin + 3) (hj : (q j.succ).1 = 0) : ∀ i : Fin 3, i ≠ j → 0 < (q i.succ).1 := by + classical + have hc := ProperBandCurvatureStructure q hq + have hparent_nonneg : ∀ i : Fin 3, 0 ≤ (q i.succ).1 := hparent_nonneg q hq + have hline_unique := hc.2.2 + intro i hij + have hnonneg := hparent_nonneg i + by_contra hnot + have hzero : (q i.succ).1 = 0 := by omega + have heq := hline_unique i j hzero hj + exact (hij heq).elim + +private theorem hchild_pos (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) : 0 < (q + 0).1 := by + classical + have hc := ProperBandCurvatureStructure q hq + exact hc.1 + +private noncomputable abbrev center (q : Fin 4 → CircleCoordinates) (k : Fin 4) : ℂ := by + classical + exact ((q k).2 : ℂ) / ((q k).1 : ℝ) + +private theorem centerDistance (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) : ∀ i + j : Fin 4, i ≠ j → 0 < (q i).1 → 0 < (q j).1 → + dist ((center q) i) ((center q) j) = 1 / (q i).1 + 1 / (q j).1 := by + classical + let center (k : Fin 4) : ℂ := ((q k).2 : ℂ) / ((q k).1 : ℝ) + change (∀ i j : Fin 4, i ≠ j → 0 < (q i).1 → 0 < (q j).1 → + dist (center i) (center j) = 1 / (q i).1 + 1 / (q j).1) + as_aux_lemma => + intro i j hij hi hj + let a : ℝ := (q i).1 + let b : ℝ := (q j).1 + let x : ℂ := (q i).2 + let y : ℂ := (q j).2 + change dist (x / a) (y / b) = 1 / a + 1 / b + have hh := TangencyCoordinateIdentity q hq.1 i j hij + have hn : (Zsqrtd.norm ((q j).1 • (q i).2 - (q i).1 • (q j).2) : ℝ) = + ((q i).1 + (q j).1 : ℤ) ^ 2 := by exact_mod_cast hh + have hns : Complex.normSq ((b : ℝ) * x - a * y) = (a + b)^2 := by + dsimp [a, b, x, y] + norm_num [Complex.normSq_apply, Zsqrtd.norm] at hn ⊢ + nlinarith + have haPos : 0 < a := by simpa [a] using hi + have hbPos : 0 < b := by simpa [b] using hj + have ha : a ≠ 0 := ne_of_gt haPos + have hb : b ≠ 0 := ne_of_gt hbPos + have hdiv : (x / a - y / b) * (a * b) = (b : ℂ) * x - a * y := by + field_simp [ha, hb] + have hratio : x / a - y / b = ((b : ℂ) * x - a * y) / (a * b) := by + rw [← hdiv] + field_simp [ha, hb] + have hnumNorm : ‖(b : ℝ) * x - a * y‖ = a + b := by + rw [← sq_eq_sq₀ (norm_nonneg _) (add_pos haPos hbPos).le] + rw [← Complex.normSq_eq_norm_sq] + exact hns + have hA : ‖(a : ℂ)‖ = a := by + simp [Complex.norm_real, abs_of_pos haPos] + have hB : ‖(b : ℂ)‖ = b := by + simp [Complex.norm_real, abs_of_pos hbPos] + rw [dist_eq_norm, hratio, Complex.norm_div, hnumNorm, + Complex.norm_mul, hA, hB] + field_simp [ha, hb]; ring + +private theorem hsupport (L : ℝ) (q : Fin 4 → CircleCoordinates) (hs : P4828T1LineSupport L q) + (j : Fin 3) (hj : (q j.succ).1 = 0) : ∃ n b : ℝ, n^2 = 1 ∧ + (∀ k : Fin 4, 0 < (q k).1 → + -n * (((center q) k).re - b) = 1 / (q k).1) ∧ + (if (q j.succ).2 = -1 then L else L + 2) = b := by + classical + let center (k : Fin 4) : ℂ := ((q k).2 : ℂ) / ((q k).1 : ℝ) + change (∃ n b : ℝ, n^2 = 1 ∧ + (∀ k : Fin 4, 0 < (q k).1 → + -n * ((center k).re - b) = 1 / (q k).1) ∧ + (if (q j.succ).2 = -1 then L else L + 2) = b) + rcases hs.normals j.succ hj with hneg | hpos + · refine ⟨-1, L, by norm_num, ?_, by simp [hneg]⟩ + intro k hk + have hh := hs.signed j.succ k hj hk + rw [hneg] at hh + norm_num at hh + have hre : ((q k).2 : ℂ).re = (q k).2.re := by norm_num + rw [hre] at hh + have hcne : (q k).1 ≠ 0 := by omega + have hcenter_re : (center k).re = (q k).2.re / (q k).1 := by + dsimp [center] + rw [Complex.div_re] + simp [] + field_simp [hcne] + rw [hcenter_re] + field_simp [hcne] + nlinarith only [hh] + · refine ⟨1, L + 2, by norm_num, ?_, by norm_num [hpos]⟩ + intro k hk + have hh := hs.signed j.succ k hj hk + rw [hpos] at hh + norm_num at hh + have hre : ((q k).2 : ℂ).re = (q k).2.re := by norm_num + rw [hre] at hh + have hcne : (q k).1 ≠ 0 := by omega + have hcenter_re : (center k).re = (q k).2.re / (q k).1 := by + dsimp [center] + rw [Complex.div_re] + simp [] + field_simp [hcne] + rw [hcenter_re] + field_simp [hcne] + nlinarith only [hh] + +private theorem centerCoordSq (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) : ∀ u + v : Fin 4, u ≠ v → 0 < (q u).1 → 0 < (q v).1 → + (((center q) u).re - ((center q) v).re)^2 + (((center q) u).im - ((center q) v).im)^2 = + (1 / (q u).1 + 1 / (q v).1)^2 := by + classical + let center (k : Fin 4) : ℂ := ((q k).2 : ℂ) / ((q k).1 : ℝ) + have centerDistance : ∀ i j : Fin 4, i ≠ j → 0 < (q i).1 → 0 < (q j).1 → + dist (center i) (center j) = 1 / (q i).1 + 1 / (q j).1 := centerDistance q hq + change (∀ u v : Fin 4, u ≠ v → 0 < (q u).1 → 0 < (q v).1 → + ((center u).re - (center v).re)^2 + ((center u).im - (center v).im)^2 = + (1 / (q u).1 + 1 / (q v).1)^2) + clear * - q center centerDistance + intro u v huv hu hv + have hdist := centerDistance u v huv hu hv + have hnorm : ‖center u - center v‖ = 1 / (q u).1 + 1 / (q v).1 := by + simpa [dist_eq_norm, center] using hdist + have hnorm2 := congrArg (fun z : ℝ => z^2) hnorm + rw [← Complex.normSq_eq_norm_sq, Complex.normSq_apply, Complex.sub_re, + Complex.sub_im] at hnorm2 + nlinarith + +private theorem verticalSq (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (n : ℝ) + (boundary : ℝ) (hn : n ^ 2 = 1) : ∀ u v : Fin 4, u ≠ v → 0 < (q u).1 → 0 < (q v).1 → + -n * (((center q) u).re - boundary) = 1 / (q u).1 → + -n * (((center q) v).re - boundary) = 1 / (q v).1 → + (((center q) u).im - ((center q) v).im)^2 = + 4 * (1 / (q u).1) * (1 / (q v).1) := by + classical + let center (k : Fin 4) : ℂ := ((q k).2 : ℂ) / ((q k).1 : ℝ) + have centerCoordSq : ∀ u v : Fin 4, u ≠ v → 0 < (q u).1 → 0 < (q v).1 → + ((center u).re - (center v).re)^2 + ((center u).im - (center v).im)^2 = + (1 / (q u).1 + 1 / (q v).1)^2 := centerCoordSq q hq + change (∀ u v : Fin 4, u ≠ v → 0 < (q u).1 → 0 < (q v).1 → + -n * ((center u).re - boundary) = 1 / (q u).1 → + -n * ((center v).re - boundary) = 1 / (q v).1 → + ((center u).im - (center v).im)^2 = + 4 * (1 / (q u).1) * (1 / (q v).1)) + clear * - q center centerCoordSq n boundary hn + intro u v huv hu hv hxu hxv + have hcoords := centerCoordSq u v huv hu hv + have hsdiff : -n * ((center u).re - (center v).re) = + 1 / (q u).1 - 1 / (q v).1 := by + calc + -n * ((center u).re - (center v).re) = + -n * ((center u).re-boundary) - (-n * ((center v).re-boundary)) := by ring + _ = 1 / (q u).1 - 1 / (q v).1 := by rw [hxu,hxv] + have hnn : n * n = 1 := by simpa [pow_two] using hn + have hdx : (center u).re - (center v).re = + -n * (1 / (q u).1 - 1 / (q v).1) := by + calc + (center u).re - (center v).re = + n * n * ((center u).re - (center v).re) := by rw [hnn]; ring + _ = (-n) * ((-n) * ((center u).re - (center v).re)) := by ring + _ = -n * (1 / (q u).1 - 1 / (q v).1) := by rw [hsdiff] + rw [hdx] at hcoords + nlinarith [hn] + +end LinePlacementConstruction + +theorem P4828T1LinePlacement (L : Real) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hs : P4828T1LineSupport L q) + (hline : ∃ j : Fin 3, (q j.succ).1 = 0) : + P4828T1Disk (q 0) ⊆ P4828T1Gap L q := by +-- BODY + have hc := ProperBandCurvatureStructure q hq + rcases hline with ⟨j, hj⟩ + have hparent_nonneg : ∀ i : Fin 3, 0 ≤ (q i.succ).1 := LinePlacementConstruction.hparent_nonneg + q hq + have hline_unique := hc.2.2 + have hparent_pos : ∀ i : Fin 3, i ≠ j → 0 < (q i.succ).1 := + LinePlacementConstruction.hparent_pos q hq j hj + have hchild_pos : 0 < (q 0).1 := LinePlacementConstruction.hchild_pos q hq + let center (k : Fin 4) : ℂ := ((q k).2 : ℂ) / ((q k).1 : ℝ) + have centerDistance : ∀ i j : Fin 4, i ≠ j → 0 < (q i).1 → 0 < (q j).1 → + dist (center i) (center j) = 1 / (q i).1 + 1 / (q j).1 := + LinePlacementConstruction.centerDistance q hq + have hsupport : ∃ n b : ℝ, n^2 = 1 ∧ + (∀ k : Fin 4, 0 < (q k).1 → + -n * ((center k).re - b) = 1 / (q k).1) ∧ + (if (q j.succ).2 = -1 then L else L + 2) = b := LinePlacementConstruction.hsupport L q hs j hj + rcases hsupport with ⟨n, boundary, hn, hcenterX, hfoot⟩ + have centerCoordSq : ∀ u v : Fin 4, u ≠ v → 0 < (q u).1 → 0 < (q v).1 → + ((center u).re - (center v).re)^2 + ((center u).im - (center v).im)^2 = + (1 / (q u).1 + 1 / (q v).1)^2 := LinePlacementConstruction.centerCoordSq q hq + have verticalSq : ∀ u v : Fin 4, u ≠ v → 0 < (q u).1 → 0 < (q v).1 → + -n * ((center u).re - boundary) = 1 / (q u).1 → + -n * ((center v).re - boundary) = 1 / (q v).1 → + ((center u).im - (center v).im)^2 = + 4 * (1 / (q u).1) * (1 / (q v).1) := LinePlacementConstruction.verticalSq q hq n boundary hn + let i : Fin 3 := if j = 0 then 1 else 0 + let k : Fin 3 := if j = 2 then 1 else 2 + have hij : i ≠ j := by + clear * - i j + fin_cases j <;> decide + have hkj : k ≠ j := by + clear * - k j + fin_cases j <;> decide + have hik : i ≠ k := by + clear * - i k j + fin_cases j <;> decide + have hiPos := hparent_pos i hij + have hkPos := hparent_pos k hkj + have hik4 : i.succ ≠ k.succ := (Fin.succ_injective 3).ne hik + have hABsq := verticalSq i.succ k.succ hik4 hiPos hkPos + (hcenterX i.succ hiPos) (hcenterX k.succ hkPos) + have htneq : (center i.succ).im ≠ (center k.succ).im := by + intro heq + have hpos : 0 < 4 * (1 / ((q i.succ).1 : ℝ)) * (1 / ((q k.succ).1 : ℝ)) := by + positivity + rw [heq, sub_self, zero_pow (by decide : 2 ≠ 0)] at hABsq + linarith only [hABsq, hpos] + have ordered : ∃ low high : Fin 3, + 0 < (q low.succ).1 ∧ 0 < (q high.succ).1 ∧ low ≠ high ∧ + (center low.succ).im < (center high.succ).im := by + rcases lt_or_gt_of_ne htneq with h | h + · exact ⟨i, k, hiPos, hkPos, hik, h⟩ + · exact ⟨k, i, hkPos, hiPos, hik.symm, h⟩ + rcases ordered with ⟨low, high, hlowPos, hhighPos, hlowHigh, hheight⟩ + let r : ℝ := 1 / (q 0).1 + let a : ℝ := 1 / (q low.succ).1 + let b : ℝ := 1 / (q high.succ).1 + let tL : ℝ := (center low.succ).im + let D : ℝ := (center high.succ).im - tL + let x : ℝ := (center 0).im - tL + have hrpos : 0 < r := by dsimp [r]; positivity + have hapos : 0 < a := by dsimp [a]; positivity + have hbpos : 0 < b := by dsimp [b]; positivity + have hDpos : 0 < D := sub_pos.mpr hheight + have hra : r < a := by + dsimp [r, a] + rw [div_lt_div_iff₀ (by positivity) (by positivity)] + simpa using hq.2 low + have hrb : r < b := by + dsimp [r, b] + rw [div_lt_div_iff₀ (by positivity) (by positivity)] + simpa using hq.2 high + have hDsq : D^2 = 4*a*b := by + have hh := verticalSq low.succ high.succ + ((Fin.succ_injective 3).ne hlowHigh) hlowPos hhighPos + (hcenterX low.succ hlowPos) (hcenterX high.succ hhighPos) + change ((center high.succ).im - (center low.succ).im)^2 = 4*a*b + change ((center low.succ).im - (center high.succ).im)^2 = 4*a*b at hh + nlinarith only [hh] + have hxsq : x^2 = 4*r*a := + verticalSq 0 low.succ (Fin.succ_ne_zero low).symm hchild_pos hlowPos + (hcenterX 0 hchild_pos) (hcenterX low.succ hlowPos) + have hysq : (D-x)^2 = 4*r*b := by + have hh := verticalSq 0 high.succ (Fin.succ_ne_zero high).symm hchild_pos hhighPos + (hcenterX 0 hchild_pos) (hcenterX high.succ hhighPos) + have heq : D-x = -((center 0).im - (center high.succ).im) := by + dsimp [D, x]; ring + rw [heq, neg_sq] + exact hh + rcases P4903T1ScalarTangencies a b r D x hapos hbpos hrpos hDpos + hra hrb hDsq hxsq hysq with ⟨hxpos, hypos, hrel, hxD⟩ + have hrx : r < x := by nlinarith only [hxsq, hxpos, hrpos, hra] + have hry : r < D-x := by nlinarith only [hysq, hypos, hrpos, hrb] + have hmargin : D*a+(b-a)*x-D*r = r*(a+b)+a*b := by + as_aux_lemma => + clear * - a b r D x hDpos hxD hDsq hrel + have hDne : D ≠ 0 := ne_of_gt hDpos + have hxf : x=(D^2+4*r*(a-b))/(2*D) := by + field_simp [hDne] + nlinarith only [hxD] + have hD2rel : D^2=4*r*(a+b+D) := by + calc + D^2=4*a*b := hDsq + _=4*r*(a+b+D) := by nlinarith only [hrel] + rw [hxf] + field_simp [hDne] + have hrelA := congrArg (fun z : ℝ => 4*(a+b)*z) hrel + have hrelR := congrArg (fun z : ℝ => 8*r*z) hrel + have hrelD := congrArg (fun z : ℝ => 2*D*z) hrel + have hDsqA := congrArg (fun z : ℝ => (a+b)*z) hDsq + have hDsqR := congrArg (fun z : ℝ => 2*r*z) hDsq + nlinarith only [hrelA,hrelR,hrelD,hDsqA,hDsqR,hD2rel] + have hnn : n*n = 1 := by simpa only [pow_two] using hn + have hcenterRe : ∀ m : Fin 4, 0 < (q m).1 → + (center m).re = boundary-n*(1/(q m).1) := by + intro m hm + have hh := congrArg (fun z : ℝ => -n*z) (hcenterX m hm) + ring_nf at hh + rw [hn] at hh + simp only [one_mul] at hh + rw [one_div] + linarith only [hh] + let verts : Fin 4 → ℂ := + ![⟨boundary,tL⟩,center low.succ,center high.succ,⟨boundary,tL+D⟩] + let gapCenter (m : Fin 3) : ℂ := center m.succ + let gapVertices : Set ℂ := {z | ∃ m : Fin 3, 0 < (q m.succ).1 ∧ + (z=gapCenter m ∨ ∃ l : Fin 3, (q l.succ).1=0 ∧ + z=⟨if (q l.succ).2 = -1 then L else L+2,(gapCenter m).im⟩)} + have hverts : ∀ m : Fin 4, verts m ∈ gapVertices := by + intro m + fin_cases m + · refine ⟨low, hlowPos, Or.inr ⟨j, hj, ?_⟩⟩ + apply Complex.ext + · simp [verts, hfoot] + · rfl + · exact ⟨low, hlowPos, Or.inl rfl⟩ + · exact ⟨high, hhighPos, Or.inl rfl⟩ + · refine ⟨high, hhighPos, Or.inr ⟨j, hj, ?_⟩⟩ + apply Complex.ext + · simp [verts, hfoot] + · change tL+D = (center high.succ).im + dsimp [D]; ring + have hrange : Set.range verts ⊆ gapVertices := by + rintro z ⟨m, rfl⟩ + exact hverts m + have vertsEq : verts = ![⟨boundary,tL⟩,⟨boundary-n*a,tL⟩, + ⟨boundary-n*b,tL+D⟩,⟨boundary,tL+D⟩] := by + funext m + fin_cases m + · rfl + · apply Complex.ext + · exact hcenterRe low.succ hlowPos + · rfl + · apply Complex.ext + · exact hcenterRe high.succ hhighPos + · change (center high.succ).im = tL+D + dsimp [D]; ring + · rfl + have hcenter0 : center 0 = ⟨boundary-n*r,tL+x⟩ := by + apply Complex.ext + · exact hcenterRe 0 hchild_pos + · change (center 0).im = tL+x + dsimp [x]; ring + have hball : Metric.ball (center 0) r ⊆ convexHull ℝ gapVertices := by + have htrap := P4903T1SignedDiskHull a b r D x tL boundary n + hapos hbpos hrpos hDpos hnn hDsq hrx hry hmargin + rw [← hcenter0, ← vertsEq] at htrap + exact htrap.trans (convexHull_mono hrange) + intro p hp + simp only [P4828T1Disk, Metric.mem_ball] at hp + unfold P4828T1Gap + refine ⟨?_, ?_⟩ + · change p ∈ interior (convexHull ℝ gapVertices) + have hpball : p ∈ Metric.ball (center 0) r := hp + exact mem_interior_iff_mem_nhds.mpr + (Filter.mem_of_superset (Metric.isOpen_ball.mem_nhds hpball) hball) + · intro m hm + have hdist := centerDistance 0 m.succ (Fin.succ_ne_zero m).symm hchild_pos hm + have htri := dist_triangle (center 0) p (center m.succ) + change 1 / (q m.succ).1 < dist p (center m.succ) + have hp' : dist (center 0) p < 1 / (q 0).1 := by + rw [dist_comm] + exact hp + have hlt := lt_of_le_of_lt htri + (add_lt_add_left hp' (dist p (center m.succ))) + rw [hdist] at hlt + exact lt_of_add_lt_add_left hlt + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1LineSupport.lean b/LeanPool/ApollonianSuperharmonic/P4828T1LineSupport.lean new file mode 100644 index 0000000000..b510ffbbc4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1LineSupport.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates + +-- [TABLET NODE: P4828T1LineSupport] + +/-! +# P4828T1LineSupport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A signed line-support certificate at offset $L$ for $q$ says that every +zero-curvature entry has numerator $n=-1$ or $1$, and for every such entry +and every positive entry $(c,w)$, +$$ + n\operatorname{Re}w-c h_n=-1,\qquad h_{-1}=-L,\quad h_1=L+2. +$$ +It is denoted by `P4828T1LineSupport`. Equivalently the circle is +tangent from inside the strip to the contextual supporting line +$nX=h_n$. This records the side and offset, not merely unsigned tangency. +-/ +structure P4828T1LineSupport (L : Real) + (q : Fin 4 → CircleCoordinates) : Prop where +-- BODY + normals : ∀ k : Fin 4, (q k).1 = 0 → (q k).2 = -1 ∨ (q k).2 = 1 + signed : ∀ k j : Fin 4, (q k).1 = 0 → 0 < (q j).1 → + ((q k).2.re : Real) * ((q j).2.re : Real) - (q j).1 * + (if (q k).2 = -1 then -L else L + 2) = -1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1ParentsDistinct.lean b/LeanPool/ApollonianSuperharmonic/P4828T1ParentsDistinct.lean new file mode 100644 index 0000000000..e8c5dd04c8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1ParentsDistinct.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity + +-- [TABLET NODE: P4828T1ParentsDistinct] + +/-! +# P4828T1ParentsDistinct + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4828T1ParentsDistinct (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) : Function.Injective (fun j : Fin 3 => q j.succ) := by +-- BODY + intro i j hij + change q i.succ = q j.succ at hij + by_contra hne + have ht := TangencyCoordinateIdentity q hq.1 i.succ j.succ + (fun h => hne (Fin.succ_inj.mp h)) + have hn := (ProperBandCurvatureStructure q hq).2.1 i + rw [hij] at ht hn + simp at ht + have hz : (q j.succ).1 = 0 := by nlinarith [sq_nonneg ((q j.succ).1)] + exact hne ((ProperBandCurvatureStructure q hq).2.2 i j (by simpa [hij] using hz) hz) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1ResidualPatches.lean b/LeanPool/ApollonianSuperharmonic/P4828T1ResidualPatches.lean new file mode 100644 index 0000000000..16e41bb3cc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1ResidualPatches.lean @@ -0,0 +1,623 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4828T1Gap +public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport +public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate +public import LeanPool.ApollonianSuperharmonic.P4828T1Step +public import LeanPool.ApollonianSuperharmonic.P4828T1ParentsDistinct +public import LeanPool.ApollonianSuperharmonic.P4909T1TriangleFan +public import LeanPool.ApollonianSuperharmonic.P4909T1LineFan +public import LeanPool.ApollonianSuperharmonic.P4909T1OmittedDiskBarrier +public import LeanPool.ApollonianSuperharmonic.P4909T1TangentSegments + +-- [TABLET NODE: P4828T1ResidualPatches] + +/-! +# P4828T1ResidualPatches + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ResidualGapConstruction + +private noncomputable abbrev p (q : Fin 4 → CircleCoordinates) (i : Fin 4) : ℂ := by + classical + exact (q i).2 / ((q i).1 : ℝ) + +private noncomputable abbrev r (q : Fin 4 → CircleCoordinates) (i : Fin 4) : ℝ := by + classical + exact 1 / ((q i).1 : ℝ) + +private noncomputable abbrev s (q : Fin 4 → CircleCoordinates) (b : Fin 3) := by + classical + exact P4828T1Step (P4828T1Rotate q b) + +private noncomputable abbrev P (L : Real) (q : Fin 4 → CircleCoordinates) := by + classical + exact P4909T1ParentPolygon L q + +private noncomputable abbrev F (L : Real) (q : Fin 4 → CircleCoordinates) (b : Fin 3) := by + classical + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + exact P4909T1ParentPolygon L (s b) + +private noncomputable abbrev idx (b j : Fin 3) : Fin 4 := by + classical + exact ![0, (b + 1).succ, (b + 2).succ] j + +private theorem parent (q : Fin 4 → CircleCoordinates) (b j : Fin 3) : (s q) b j.succ = q (idx b + j) := by + classical + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let idx (b j : Fin 3) : Fin 4 := ![0, (b + 1).succ, (b + 2).succ] j + change (s b j.succ = q (idx b j)) + fin_cases b <;> fin_cases j <;> rfl + +private theorem idx_inj (b : Fin 3) : Function.Injective (idx b) := by + classical + let idx (b j : Fin 3) : Fin 4 := ![0, (b + 1).succ, (b + 2).succ] j + change (Function.Injective (idx b)) + fin_cases b <;> decide + +private theorem idx_ne (b j : Fin 3) : idx b j ≠ b.succ := by + classical + let idx (b j : Fin 3) : Fin 4 := ![0, (b + 1).succ, (b + 2).succ] j + change (idx b j ≠ b.succ) + fin_cases b <;> fin_cases j <;> decide + +private theorem old_retained (b j : Fin 3) (hne : j ≠ b) : + ∃ k : Fin 3, idx b k = j.succ := by + classical + let idx (b j : Fin 3) : Fin 4 := ![0, (b + 1).succ, (b + 2).succ] j + change (∃ k : Fin 3, idx b k = j.succ) + fin_cases b <;> fin_cases j <;> + first | exact (hne rfl).elim | exact ⟨1, rfl⟩ | exact ⟨2, rfl⟩ + +private theorem gap_iff (L : Real) (t : Fin 4 → CircleCoordinates) (z : ℂ) : + z ∈ P4828T1Gap L t ↔ + z ∈ interior (P4909T1ParentPolygon L t) ∧ + ∀ j : Fin 3, 0 < (t j.succ).1 → + 1 / ((t j.succ).1 : ℝ) < dist z ((t j.succ).2 / ((t j.succ).1 : ℝ)) := by + classical + exact Iff.rfl + +private theorem rpos (q : Fin 4 → CircleCoordinates) (i : Fin 4) (hi : 0 < (q i).1) : 0 < (r q) i + := by + classical + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + change (0 < r i) + dsimp [r] + positivity + +private theorem hcenter (L : Real) (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hinside : P4828T1Disk (q 0) ⊆ P4828T1Gap L q) : (p q) 0 ∈ interior (P L q) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let P := P4909T1ParentPolygon L q + have gap_iff (t : Fin 4 → CircleCoordinates) (z : ℂ) : + z ∈ P4828T1Gap L t ↔ + z ∈ interior (P4909T1ParentPolygon L t) ∧ + ∀ j : Fin 3, 0 < (t j.succ).1 → + 1 / ((t j.succ).1 : ℝ) < dist z ((t j.succ).2 / ((t j.succ).1 : ℝ)) := gap_iff L t z + have hc := ProperBandCurvatureStructure q hq + have rpos (i : Fin 4) (hi : 0 < (q i).1) : 0 < r i := rpos q i hi + change (p 0 ∈ interior P) + have hz : p 0 ∈ P4828T1Disk (q 0) := by + change dist (p 0) (p 0) < r 0 + simpa using rpos 0 hc.1 + exact ((gap_iff q (p 0)).mp (hinside hz)).1 + +private theorem support (L : Real) (q : Fin 4 → CircleCoordinates) (hs : P4828T1LineSupport L + q) (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + if (q k).2 = -1 then ((p q) i).re = L + (r q) i + else ((p q) i).re = L + 2 - (r q) i := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + change (if (q k).2 = -1 then (p i).re = L + r i + else (p i).re = L + 2 - r i) + have hh := hs.signed k i hk hi + have hnum : ((q i).2 : ℂ).re = (q i).2.re := by norm_num + have hci : ((q i).1 : ℝ) ≠ 0 := by exact_mod_cast ne_of_gt hi + have hre : (p i).re = (q i).2.re / ((q i).1 : ℝ) := by + simp [p] + rcases hs.normals k hk with hn | hn + · simp only [hn] + rw [hn] at hh + norm_num at hh + rw [hnum] at hh + rw [hre] + dsimp [r] + field_simp [hci] + linarith + · have hne : (q k).2 ≠ -1 := by rw [hn]; norm_num + simp only [ite_eq_right hne] + rw [hn] at hh + norm_num at hh + rw [hnum] at hh + rw [hre] + dsimp [r] + field_simp [hci] + linarith + +private theorem foot_dist (L : Real) (q : Fin 4 → CircleCoordinates) (hs : P4828T1LineSupport L + q) (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + dist ((p q) i) ⟨if (q k).2 = -1 then L else L + 2, ((p q) i).im⟩ = (r q) i := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + have rpos (i : Fin 4) (hi : 0 < (q i).1) : 0 < r i := rpos q i hi + have support (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + if (q k).2 = -1 then (p i).re = L + r i + else (p i).re = L + 2 - r i := support L q hs k i hk hi + change (dist (p i) ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ = r i) + have hr := (rpos i hi).le + have hh := support k i hk hi + rw [Complex.dist_eq] + by_cases hn : (q k).2 = -1 + · simp only [ite_eq_left hn] at hh ⊢ + have hv : p i - (⟨L, (p i).im⟩ : ℂ) = (r i : ℂ) := by + apply Complex.ext <;> simp [hh] + rw [hv, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg hr] + · simp only [ite_eq_right hn] at hh ⊢ + have hv : p i - (⟨L + 2, (p i).im⟩ : ℂ) = (-r i : ℂ) := by + apply Complex.ext <;> simp [hh] + rw [hv, norm_neg, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg hr] + +private theorem foot_cover (L : Real) (q : Fin 4 → CircleCoordinates) (hs : P4828T1LineSupport + L q) (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + segment ℝ ((p q) i) + ⟨if (q k).2 = -1 then L else L + 2, ((p q) i).im⟩ ⊆ + Metric.closedBall ((p q) i) ((r q) i) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + have rpos (i : Fin 4) (hi : 0 < (q i).1) : 0 < r i := rpos q i hi + have support (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + if (q k).2 = -1 then (p i).re = L + r i + else (p i).re = L + 2 - r i := support L q hs k i hk hi + have foot_dist (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + dist (p i) ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ = r i := foot_dist L q hs k i hk hi + change (segment ℝ (p i) + ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ ⊆ + Metric.closedBall (p i) (r i)) + intro z hz + have hd := foot_dist k i hk hi + rcases (P4909T1TangentSegments _ _ (r i) 0 + (by simpa only [add_zero] using hd)).1 hz with h | h + · exact h + · have heq : z = ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ := by + simpa only [Metric.mem_closedBall, dist_le_zero] using h + rw [Metric.mem_closedBall, heq, dist_comm, hd] + +private theorem line_dist (L : Real) (q : Fin 4 → CircleCoordinates) (hs : P4828T1LineSupport L + q) (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) + (z : ℂ) (hz : z.re = if (q k).2 = -1 then L else L + 2) : + (r q) i ≤ dist z ((p q) i) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + have rpos (i : Fin 4) (hi : 0 < (q i).1) : 0 < r i := rpos q i hi + have support (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + if (q k).2 = -1 then (p i).re = L + r i + else (p i).re = L + 2 - r i := support L q hs k i hk hi + change (r i ≤ dist z (p i)) + have hh := support k i hk hi + have hab := Complex.abs_re_le_norm (z - p i) + rw [Complex.sub_re, hz] at hab + rw [Complex.dist_eq] + by_cases hn : (q k).2 = -1 + · simp only [ite_eq_left hn] at hh hab + have heq : L - (p i).re = -r i := by linarith + rw [heq, abs_neg, abs_of_pos (rpos i hi)] at hab + exact hab + · simp only [ite_eq_right hn] at hh hab + have heq : L + 2 - (p i).re = r i := by linarith + rw [heq, abs_of_pos (rpos i hi)] at hab + exact hab + +private theorem center_dist (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) (i j : + Fin 4) (hij : i ≠ j) + (hi : 0 < (q i).1) (hj : 0 < (q j).1) : + dist ((p q) i) ((p q) j) = (r q) i + (r q) j := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + change (dist (p i) (p j) = r i + r j) + let v : GaussianInt := (q j).1 • (q i).2 - (q i).1 • (q j).2 + have ht := TangencyCoordinateIdentity q hq.1 i j hij + have hn : Complex.normSq (v : ℂ) = (((q i).1 + (q j).1 : ℤ)^2 : ℝ) := by + have normCast (w : GaussianInt) : + Complex.normSq (w : ℂ) = (Zsqrtd.norm w : ℝ) := by + simp [Complex.normSq, Zsqrtd.norm_def] + rw [normCast] + exact_mod_cast ht + have hnsq : ‖(v : ℂ)‖ ^ 2 = (((q i).1 + (q j).1 : ℤ) : ℝ) ^ 2 := by + rw [← Complex.normSq_eq_norm_sq, hn] + have hnorm : ‖(v : ℂ)‖ = (((q i).1 + (q j).1 : ℤ) : ℝ) := by + have hnonneg := norm_nonneg (v : ℂ) + have hsum : 0 ≤ (((q i).1 + (q j).1 : ℤ) : ℝ) := by positivity + nlinarith + have hdiff : p i - p j = + (v : ℂ) / (((q i).1 * (q j).1 : ℤ) : ℂ) := by + dsimp [p, v] + push_cast + simp only [map_sub, map_zsmul] + field_simp [ne_of_gt hi, ne_of_gt hj] + ring + rw [Complex.dist_eq, hdiff, Complex.norm_div, Complex.norm_intCast, hnorm] + have ha : 0 < ((q i).1 : ℝ) := by exact_mod_cast hi + have hb : 0 < ((q j).1 : ℝ) := by exact_mod_cast hj + have hab : 0 < (((q i).1 * (q j).1 : ℤ) : ℝ) := by + exact_mod_cast mul_pos hi hj + rw [abs_of_pos hab] + dsimp [r] + push_cast + field_simp [ne_of_gt ha, ne_of_gt hb] + ring + +private theorem geometry (L : Real) (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hs : P4828T1LineSupport L q) (hinside : P4828T1Disk (q 0) ⊆ P4828T1Gap L q) : + (∀ b, (F L q) b ⊆ (P L q) ∧ (0 < (q b.succ).1 → (p q) b.succ ∉ (F L q) b) ∧ + frontier ((F L q) b) ⊆ P4909T1ParentEdges L ((s q) b)) ∧ + (∀ b c, b ≠ c → Disjoint (interior ((F L q) b)) (interior ((F L q) c))) ∧ + (P L q) = ⋃ b, (F L q) b ∧ + (∀ z ∈ interior (P L q), + (∀ i : Fin 4, 0 < (q i).1 → z ∉ segment ℝ ((p q) 0) ((p q) i)) → + (∀ k : Fin 3, (q k.succ).1 = 0 → + z ∉ segment ℝ ((p q) 0) + ⟨if (q k.succ).2 = -1 then L else L + 2, ((p q) 0).im⟩) → + ∃ b, z ∈ interior ((F L q) b)) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + have gap_iff (t : Fin 4 → CircleCoordinates) (z : ℂ) : + z ∈ P4828T1Gap L t ↔ + z ∈ interior (P4909T1ParentPolygon L t) ∧ + ∀ j : Fin 3, 0 < (t j.succ).1 → + 1 / ((t j.succ).1 : ℝ) < dist z ((t j.succ).2 / ((t j.succ).1 : ℝ)) := gap_iff L t z + have hc := ProperBandCurvatureStructure q hq + have rpos (i : Fin 4) (hi : 0 < (q i).1) : 0 < r i := rpos q i hi + have hcenter : p 0 ∈ interior P := hcenter L q hq hinside + have support (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + if (q k).2 = -1 then (p i).re = L + r i + else (p i).re = L + 2 - r i := support L q hs k i hk hi + change ((∀ b, F b ⊆ P ∧ (0 < (q b.succ).1 → p b.succ ∉ F b) ∧ + frontier (F b) ⊆ P4909T1ParentEdges L (s b)) ∧ + (∀ b c, b ≠ c → Disjoint (interior (F b)) (interior (F c))) ∧ + P = ⋃ b, F b ∧ + (∀ z ∈ interior P, + (∀ i : Fin 4, 0 < (q i).1 → z ∉ segment ℝ (p 0) (p i)) → + (∀ k : Fin 3, (q k.succ).1 = 0 → + z ∉ segment ℝ (p 0) + ⟨if (q k.succ).2 = -1 then L else L + 2, (p 0).im⟩) → + ∃ b, z ∈ interior (F b))) + by_cases hp : ∀ j : Fin 3, 0 < (q j.succ).1 + · have hall : ∀ i : Fin 4, 0 < (q i).1 := Fin.cases hc.1 hp + have g := P4909T1TriangleFan L q hall hcenter + exact ⟨fun b => ⟨(g.1 b).1, fun _ => (g.1 b).2.1, (g.1 b).2.2⟩, g.2⟩ + · obtain ⟨l, hl⟩ := not_forall.mp hp + have hl0 : (q l.succ).1 = 0 := by have := hc.2.1 l; omega + have hother (i : Fin 3) (hne : i ≠ l) : 0 < (q i.succ).1 := by + have hn := hc.2.1 i + have hnonzero : (q i.succ).1 ≠ 0 := fun h => hne (hc.2.2 i l h hl0) + omega + apply P4909T1LineFan L q l hl0 hother hc.1 (hs.normals l.succ hl0) + · intro i hi + have hh := support l.succ i hl0 hi + have hr := rpos i hi + split_ifs at hh ⊢ <;> linarith + · exact hcenter + +private theorem omitted (L : Real) (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hs : P4828T1LineSupport L q) (hinside : P4828T1Disk (q 0) ⊆ P4828T1Gap L q) (b : Fin + 3) (hb : 0 < (q b.succ).1) : + ∀ z ∈ interior ((F L q) b), (r q) b.succ < dist z ((p q) b.succ) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let idx (b j : Fin 3) : Fin 4 := ![0, (b + 1).succ, (b + 2).succ] j + have parent (b j : Fin 3) : s b j.succ = q (idx b j) := parent q b j + have idx_inj (b : Fin 3) : Function.Injective (idx b) := idx_inj b + have idx_ne (b j : Fin 3) : idx b j ≠ b.succ := idx_ne b j + have gap_iff (t : Fin 4 → CircleCoordinates) (z : ℂ) : + z ∈ P4828T1Gap L t ↔ + z ∈ interior (P4909T1ParentPolygon L t) ∧ + ∀ j : Fin 3, 0 < (t j.succ).1 → + 1 / ((t j.succ).1 : ℝ) < dist z ((t j.succ).2 / ((t j.succ).1 : ℝ)) := gap_iff L t z + have hc := ProperBandCurvatureStructure q hq + have rpos (i : Fin 4) (hi : 0 < (q i).1) : 0 < r i := rpos q i hi + have hcenter : p 0 ∈ interior P := hcenter L q hq hinside + have support (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + if (q k).2 = -1 then (p i).re = L + r i + else (p i).re = L + 2 - r i := support L q hs k i hk hi + have foot_dist (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + dist (p i) ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ = r i := foot_dist L q hs k i hk hi + have foot_cover (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + segment ℝ (p i) + ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ ⊆ + Metric.closedBall (p i) (r i) := foot_cover L q hs k i hk hi + have line_dist (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) + (z : ℂ) (hz : z.re = if (q k).2 = -1 then L else L + 2) : + r i ≤ dist z (p i) := line_dist L q hs k i hk hi z hz + have center_dist (i j : Fin 4) (hij : i ≠ j) + (hi : 0 < (q i).1) (hj : 0 < (q j).1) : + dist (p i) (p j) = r i + r j := center_dist q hq i j hij hi hj + have geometry : + (∀ b, F b ⊆ P ∧ (0 < (q b.succ).1 → p b.succ ∉ F b) ∧ + frontier (F b) ⊆ P4909T1ParentEdges L (s b)) ∧ + (∀ b c, b ≠ c → Disjoint (interior (F b)) (interior (F c))) ∧ + P = ⋃ b, F b ∧ + (∀ z ∈ interior P, + (∀ i : Fin 4, 0 < (q i).1 → z ∉ segment ℝ (p 0) (p i)) → + (∀ k : Fin 3, (q k.succ).1 = 0 → + z ∉ segment ℝ (p 0) + ⟨if (q k.succ).2 = -1 then L else L + 2, (p 0).im⟩) → + ∃ b, z ∈ interior (F b)) := geometry L q hq hs hinside + change (∀ z ∈ interior (F b), r b.succ < dist z (p b.succ)) + apply P4909T1OmittedDiskBarrier (F b) (p b.succ) (r b.succ) + (rpos _ hb) ((geometry.1 b).2.1 hb) + rw [Set.disjoint_left] + intro z hz hball + have hedge := (geometry.1 b).2.2 hz + change (∃ i j : Fin 3, i ≠ j ∧ 0 < (s b i.succ).1 ∧ + 0 < (s b j.succ).1 ∧ z ∈ segment ℝ + (((s b i.succ).2 : ℂ) / ((s b i.succ).1 : ℝ)) + (((s b j.succ).2 : ℂ) / ((s b j.succ).1 : ℝ))) ∨ + (∃ i k : Fin 3, 0 < (s b i.succ).1 ∧ (s b k.succ).1 = 0 ∧ + z ∈ segment ℝ (((s b i.succ).2 : ℂ) / ((s b i.succ).1 : ℝ)) + ⟨if (s b k.succ).2 = -1 then L else L + 2, + (((s b i.succ).2 : ℂ) / ((s b i.succ).1 : ℝ)).im⟩) ∨ + (∃ k : Fin 3, (s b k.succ).1 = 0 ∧ + z.re = if (s b k.succ).2 = -1 then L else L + 2) at hedge + simp only [parent] at hedge + have avoid (i : Fin 3) (hi : 0 < (q (idx b i)).1) : + z ∉ Metric.closedBall (p (idx b i)) (r (idx b i)) := by + have hd := center_dist b.succ (idx b i) (idx_ne b i).symm hb hi + exact Set.disjoint_left.mp + (P4909T1TangentSegments _ _ _ _ hd).2 hball + rcases hedge with ⟨i, j, hij, hi, hj, hz⟩ | ⟨i, k, hi, hk, hz⟩ | ⟨k, hk, hz⟩ + · have hd := center_dist (idx b i) (idx b j) ((idx_inj b).ne hij) hi hj + rcases (P4909T1TangentSegments _ _ _ _ hd).1 hz with h | h + · exact avoid i hi h + · exact avoid j hj h + · have hd := foot_dist (idx b k) (idx b i) hk hi + have hclosed := foot_cover (idx b k) (idx b i) hk hi hz + exact avoid i hi hclosed + · have hd := line_dist (idx b k) b.succ hk hb z hz + have hzlt := Metric.mem_ball.mp hball + exact (not_lt_of_ge hd) hzlt + +private theorem inserted_exterior (L : Real) (q : Fin 4 → CircleCoordinates) (hq : + ProperBandQuadruple q) (b : Fin 3) (z : ℂ) + (hz : z ∈ P4828T1Gap L ((s q) b)) : (r q) 0 < dist z ((p q) 0) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let idx (b j : Fin 3) : Fin 4 := ![0, (b + 1).succ, (b + 2).succ] j + have parent (b j : Fin 3) : s b j.succ = q (idx b j) := parent q b j + have gap_iff (t : Fin 4 → CircleCoordinates) (z : ℂ) : + z ∈ P4828T1Gap L t ↔ + z ∈ interior (P4909T1ParentPolygon L t) ∧ + ∀ j : Fin 3, 0 < (t j.succ).1 → + 1 / ((t j.succ).1 : ℝ) < dist z ((t j.succ).2 / ((t j.succ).1 : ℝ)) := gap_iff L t z + have hc := ProperBandCurvatureStructure q hq + change (r 0 < dist z (p 0)) + have hp : s b (Fin.succ 0) = q 0 := parent b 0 + have he := ((gap_iff (s b) z).mp hz).2 0 (by rw [hp]; exact hc.1) + simpa only [hp] using he + +private theorem gap_subset (L : Real) (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple + q) (hs : P4828T1LineSupport L q) (hinside : P4828T1Disk (q 0) ⊆ P4828T1Gap L q) (b : + Fin 3) : P4828T1Gap L ((s q) b) ⊆ P4828T1Gap L q := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let idx (b j : Fin 3) : Fin 4 := ![0, (b + 1).succ, (b + 2).succ] j + have parent (b j : Fin 3) : s b j.succ = q (idx b j) := parent q b j + have idx_inj (b : Fin 3) : Function.Injective (idx b) := idx_inj b + have idx_ne (b j : Fin 3) : idx b j ≠ b.succ := idx_ne b j + have old_retained (b j : Fin 3) (hne : j ≠ b) : + ∃ k : Fin 3, idx b k = j.succ := old_retained b j hne + have gap_iff (t : Fin 4 → CircleCoordinates) (z : ℂ) : + z ∈ P4828T1Gap L t ↔ + z ∈ interior (P4909T1ParentPolygon L t) ∧ + ∀ j : Fin 3, 0 < (t j.succ).1 → + 1 / ((t j.succ).1 : ℝ) < dist z ((t j.succ).2 / ((t j.succ).1 : ℝ)) := gap_iff L t z + have hc := ProperBandCurvatureStructure q hq + have rpos (i : Fin 4) (hi : 0 < (q i).1) : 0 < r i := rpos q i hi + have hcenter : p 0 ∈ interior P := hcenter L q hq hinside + have support (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + if (q k).2 = -1 then (p i).re = L + r i + else (p i).re = L + 2 - r i := support L q hs k i hk hi + have foot_dist (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + dist (p i) ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ = r i := foot_dist L q hs k i hk hi + have foot_cover (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + segment ℝ (p i) + ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ ⊆ + Metric.closedBall (p i) (r i) := foot_cover L q hs k i hk hi + have line_dist (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) + (z : ℂ) (hz : z.re = if (q k).2 = -1 then L else L + 2) : + r i ≤ dist z (p i) := line_dist L q hs k i hk hi z hz + have center_dist (i j : Fin 4) (hij : i ≠ j) + (hi : 0 < (q i).1) (hj : 0 < (q j).1) : + dist (p i) (p j) = r i + r j := center_dist q hq i j hij hi hj + have geometry : + (∀ b, F b ⊆ P ∧ (0 < (q b.succ).1 → p b.succ ∉ F b) ∧ + frontier (F b) ⊆ P4909T1ParentEdges L (s b)) ∧ + (∀ b c, b ≠ c → Disjoint (interior (F b)) (interior (F c))) ∧ + P = ⋃ b, F b ∧ + (∀ z ∈ interior P, + (∀ i : Fin 4, 0 < (q i).1 → z ∉ segment ℝ (p 0) (p i)) → + (∀ k : Fin 3, (q k.succ).1 = 0 → + z ∉ segment ℝ (p 0) + ⟨if (q k.succ).2 = -1 then L else L + 2, (p 0).im⟩) → + ∃ b, z ∈ interior (F b)) := geometry L q hq hs hinside + have omitted (b : Fin 3) (hb : 0 < (q b.succ).1) : + ∀ z ∈ interior (F b), r b.succ < dist z (p b.succ) := omitted L q hq hs hinside b hb + change (P4828T1Gap L (s b) ⊆ P4828T1Gap L q) + intro z hz + have hg := (gap_iff (s b) z).mp hz + apply (gap_iff q z).mpr + refine ⟨interior_mono (geometry.1 b).1 hg.1, ?_⟩ + intro j hj + by_cases hjeq : j = b + · subst j + exact omitted b hj z hg.1 + · obtain ⟨k, hk⟩ := old_retained b j hjeq + have hp : s b k.succ = q j.succ := by rw [parent, hk] + have he := hg.2 k (by simpa only [hp] using hj) + simpa only [hp] using he + +end ResidualGapConstruction + +theorem P4828T1ResidualPatches (L : Real) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hs : P4828T1LineSupport L q) + (hinside : P4828T1Disk (q 0) ⊆ P4828T1Gap L q) : + let residual (b : Fin 3) := + P4828T1Gap L (P4828T1Step (P4828T1Rotate q b)) + (∀ b, residual b ⊆ P4828T1Gap L q ∧ + Disjoint (residual b) (P4828T1Disk (q 0))) ∧ + (∀ b c, b ≠ c → Disjoint (residual b) (residual c)) ∧ + P4828T1Gap L q \ Metric.closedBall + ((q 0).2 / ((q 0).1 : Real)) (1 / ((q 0).1 : Real)) = + ⋃ b : Fin 3, residual b := by +-- BODY + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let idx (b j : Fin 3) : Fin 4 := ![0, (b + 1).succ, (b + 2).succ] j + have parent (b j : Fin 3) : s b j.succ = q (idx b j) := ResidualGapConstruction.parent q b j + have idx_inj (b : Fin 3) : Function.Injective (idx b) := ResidualGapConstruction.idx_inj b + have idx_ne (b j : Fin 3) : idx b j ≠ b.succ := ResidualGapConstruction.idx_ne b j + have old_retained (b j : Fin 3) (hne : j ≠ b) : + ∃ k : Fin 3, idx b k = j.succ := ResidualGapConstruction.old_retained b j hne + have gap_iff (t : Fin 4 → CircleCoordinates) (z : ℂ) : + z ∈ P4828T1Gap L t ↔ + z ∈ interior (P4909T1ParentPolygon L t) ∧ + ∀ j : Fin 3, 0 < (t j.succ).1 → + 1 / ((t j.succ).1 : ℝ) < dist z ((t j.succ).2 / ((t j.succ).1 : ℝ)) := + ResidualGapConstruction.gap_iff L t z + have hc := ProperBandCurvatureStructure q hq + have rpos (i : Fin 4) (hi : 0 < (q i).1) : 0 < r i := ResidualGapConstruction.rpos q i hi + have hcenter : p 0 ∈ interior P := ResidualGapConstruction.hcenter L q hq hinside + -- Divide the signed supporting-line equation, preserving its actual offset. + have support (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + if (q k).2 = -1 then (p i).re = L + r i + else (p i).re = L + 2 - r i := ResidualGapConstruction.support L q hs k i hk hi + have foot_dist (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + dist (p i) ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ = r i := + ResidualGapConstruction.foot_dist L q hs k i hk hi + have foot_cover (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : + segment ℝ (p i) + ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ ⊆ + Metric.closedBall (p i) (r i) := ResidualGapConstruction.foot_cover L q hs k i hk hi + have line_dist (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) + (z : ℂ) (hz : z.re = if (q k).2 = -1 then L else L + 2) : + r i ≤ dist z (p i) := ResidualGapConstruction.line_dist L q hs k i hk hi z hz + -- External tangency is obtained directly from the registered norm identity. + have center_dist (i j : Fin 4) (hij : i ≠ j) + (hi : 0 < (q i).1) (hj : 0 < (q j).1) : + dist (p i) (p j) = r i + r j := ResidualGapConstruction.center_dist q hq i j hij hi hj + have geometry : + (∀ b, F b ⊆ P ∧ (0 < (q b.succ).1 → p b.succ ∉ F b) ∧ + frontier (F b) ⊆ P4909T1ParentEdges L (s b)) ∧ + (∀ b c, b ≠ c → Disjoint (interior (F b)) (interior (F c))) ∧ + P = ⋃ b, F b ∧ + (∀ z ∈ interior P, + (∀ i : Fin 4, 0 < (q i).1 → z ∉ segment ℝ (p 0) (p i)) → + (∀ k : Fin 3, (q k.succ).1 = 0 → + z ∉ segment ℝ (p 0) + ⟨if (q k.succ).2 = -1 then L else L + 2, (p 0).im⟩) → + ∃ b, z ∈ interior (F b)) := ResidualGapConstruction.geometry L q hq hs hinside + -- No point of an omitted open disk can cross the concrete boundary carrier. + have omitted (b : Fin 3) (hb : 0 < (q b.succ).1) : + ∀ z ∈ interior (F b), r b.succ < dist z (p b.succ) := ResidualGapConstruction.omitted L q + hq hs hinside b hb + have inserted_exterior (b : Fin 3) (z : ℂ) + (hz : z ∈ P4828T1Gap L (s b)) : r 0 < dist z (p 0) := + ResidualGapConstruction.inserted_exterior L q hq b z hz + have gap_subset (b : Fin 3) : P4828T1Gap L (s b) ⊆ P4828T1Gap L q := + ResidualGapConstruction.gap_subset L q hq hs hinside b + dsimp only + refine ⟨?_, ?_, ?_⟩ + · intro b + refine ⟨gap_subset b, ?_⟩ + rw [Set.disjoint_left] + intro z hz hd + have he := inserted_exterior b z hz + have hlt : dist z (p 0) < r 0 := Metric.mem_ball.mp hd + exact (not_lt_of_ge he.le) hlt + · intro b c hbc + rw [Set.disjoint_left] + intro z hb hz + exact Set.disjoint_left.mp (geometry.2.1 b c hbc) + ((gap_iff (s b) z).mp hb).1 ((gap_iff (s c) z).mp hz).1 + · apply Set.Subset.antisymm + · intro z hz + have hg := (gap_iff q z).mp hz.1 + have hex : r 0 < dist z (p 0) := by + exact lt_of_not_ge (fun h => hz.2 (Metric.mem_closedBall.mpr h)) + have radial (i : Fin 4) (hi : 0 < (q i).1) : z ∉ segment ℝ (p 0) (p i) := by + intro hseg + by_cases hi0 : i = 0 + · subst i + have heq : z = p 0 := by simpa using hseg + rw [heq, dist_self] at hex + exact (not_lt_of_ge (rpos 0 hc.1).le) hex + · have hd := center_dist 0 i (Ne.symm hi0) hc.1 hi + have hseg' := (P4909T1TangentSegments _ _ _ _ hd).1 hseg + rcases hseg' with h | h + · exact (not_le_of_gt hex) (Metric.mem_closedBall.mp h) + · obtain ⟨j, rfl⟩ := Fin.exists_succ_eq.mpr hi0 + exact (not_le_of_gt (hg.2 j hi)) (Metric.mem_closedBall.mp h) + have foot (k : Fin 3) (hk : (q k.succ).1 = 0) : + z ∉ segment ℝ (p 0) + ⟨if (q k.succ).2 = -1 then L else L + 2, (p 0).im⟩ := by + intro hseg + have hd := foot_dist k.succ 0 hk hc.1 + have hclosed := foot_cover k.succ 0 hk hc.1 hseg + exact (not_le_of_gt hex) (Metric.mem_closedBall.mp hclosed) + obtain ⟨b, hb⟩ := geometry.2.2.2 z hg.1 radial foot + apply Set.mem_iUnion.mpr + refine ⟨b, (gap_iff (s b) z).mpr ⟨hb, ?_⟩⟩ + intro j hj + rw [parent] at hj ⊢ + by_cases hi0 : idx b j = 0 + · simpa only [hi0] using hex + · obtain ⟨k, hk⟩ := Fin.exists_succ_eq.mpr hi0 + simpa only [hk] using hg.2 k (by simpa only [hk] using hj) + · intro z hz + obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hz + refine ⟨gap_subset b hb, ?_⟩ + intro hcball + exact (not_le_of_gt (inserted_exterior b z hb)) (Metric.mem_closedBall.mp hcball) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean new file mode 100644 index 0000000000..ea35472d08 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean @@ -0,0 +1,591 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4828T1Root +public import LeanPool.ApollonianSuperharmonic.P4828T1Gap +public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Analysis.Complex.ReImTopology + +-- [TABLET NODE: P4828T1RightRootGeometry] + +/-! +# P4828T1RightRootGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RootGeometryRight + +private noncomputable def q (a : GaussianInt) := P4828T1Root a true + +private noncomputable def L (a : GaussianInt) : Real := 2 * (a.re : Real) + +private noncomputable def y (a : GaussianInt) : Real := 2 * (a.im : Real) + +private noncomputable def vertices (a : GaussianInt) : Set Complex := {p | ∃ j : Fin 3, 0 < ((q + a) j.succ).1 ∧ + (p = ((q a) j.succ).2 / (((q a) j.succ).1 : Real) ∨ ∃ k : Fin 3, + ((q a) k.succ).1 = 0 ∧ p = ⟨if ((q a) k.succ).2 = -1 then (L a) else (L a) + 2, + ((((q a) j.succ).2 : Complex) / (((q a) j.succ).1 : Real)).im⟩)} + +private noncomputable def bl (a : GaussianInt) : Complex := ⟨(L a) + 1, (y a)⟩ + +private noncomputable def br (a : GaussianInt) : Complex := ⟨(L a) + 2, (y a)⟩ + +private noncomputable def tl (a : GaussianInt) : Complex := ⟨(L a) + 1, (y a) + 2⟩ + +private noncomputable def tr (a : GaussianInt) : Complex := ⟨(L a) + 2, (y a) + 2⟩ + +private theorem hU0 (a : GaussianInt) : ((1 + 2 * a : GaussianInt) : Complex) = ⟨(L a) + 1, (y + a)⟩ := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + change (((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩) + rw [GaussianInt.toComplex_def₂] + apply Complex.ext <;> simp [Zsqrtd.re_add, Zsqrtd.re_mul, + Zsqrtd.im_add, Zsqrtd.im_mul, L, y]; ring + +private theorem hU1 (a : GaussianInt) : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = + ⟨(L a) + 1, (y a) + 2⟩ := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + change (((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = + ⟨L + 1, y + 2⟩) + rw [GaussianInt.toComplex_def₂] + apply Complex.ext <;> simp [Zsqrtd.re_add, Zsqrtd.re_mul, + Zsqrtd.im_add, Zsqrtd.im_mul, L, y]; ring + +private theorem hU0c (a : GaussianInt) : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) = ⟨(L a) + 1, (y a)⟩ := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + have hU0 : ((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩ := hU0 a + change ((1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) = ⟨L + 1, y⟩) + rw [GaussianInt.toComplex_add, GaussianInt.toComplex_one] at hU0 + rw [GaussianInt.toComplex_mul] at hU0 + exact hU0 + +private theorem hU1c (a : GaussianInt) : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (⟨0, 1⟩ : GaussianInt) = ⟨(L a) + 1, (y a) + 2⟩ := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + have hU1 : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = + ⟨L + 1, y + 2⟩ := hU1 a + change ((1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (⟨0, 1⟩ : GaussianInt) = ⟨L + 1, y + 2⟩) + rw [GaussianInt.toComplex_add, GaussianInt.toComplex_add, + GaussianInt.toComplex_one] at hU1 + rw [GaussianInt.toComplex_mul, GaussianInt.toComplex_mul] at hU1 + exact hU1 + +private theorem htwo_re : (GaussianInt.toComplex (2 : GaussianInt)).re = 2 := by + classical + norm_num [GaussianInt.toComplex_def] + +private theorem htwo_im : (GaussianInt.toComplex (2 : GaussianInt)).im = 0 := by + classical + norm_num [GaussianInt.toComplex_def] + +private theorem hvertices (a : GaussianInt) : (vertices a) = {(bl a), (br a), (tl a), (tr a)} := by + classical + let q := P4828T1Root a true + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, + (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, + (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} + let bl : Complex := ⟨L + 1, y⟩ + let br : Complex := ⟨L + 2, y⟩ + let tl : Complex := ⟨L + 1, y + 2⟩ + let tr : Complex := ⟨L + 2, y + 2⟩ + have hU0 : ((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩ := hU0 a + have hU1 : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = + ⟨L + 1, y + 2⟩ := hU1 a + have hU0c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) = ⟨L + 1, y⟩ := hU0c a + have hU1c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (⟨0, 1⟩ : GaussianInt) = ⟨L + 1, y + 2⟩ := hU1c a + have htwo_re : (GaussianInt.toComplex (2 : GaussianInt)).re = 2 := htwo_re + have htwo_im : (GaussianInt.toComplex (2 : GaussianInt)).im = 0 := htwo_im + change (vertices = {bl, br, tl, tr}) + ext p + constructor + · rintro ⟨j, hj, hp⟩ + fin_cases j + · simp? [q, P4828T1Root] at hj hp + rcases hp with hp | ⟨k, hk, hp⟩ + · subst p + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + left + simpa [bl] using hU0c + · fin_cases k + · simp [] at hk + · simp [] at hk + · subst p + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + right; left + apply Complex.ext <;> simp [br, L, y, + htwo_re, htwo_im, + ]; norm_num + · simp? [q, P4828T1Root] at hj hp + rcases hp with hp | ⟨k, hk, hp⟩ + · subst p + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + right; right; left + simpa [tl] using hU1c + · fin_cases k + · simp [] at hk + · simp [] at hk + · subst p + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + right; right; right + apply Complex.ext <;> simp [tr, L, y, + htwo_re, htwo_im, + ]; norm_num + · simp [q, P4828T1Root] at hj + · intro hp + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hp + rcases hp with hp | hp | hp | hp + · subst p + exact ⟨⟨0, by omega⟩, + by change 0 < (P4828T1Root a true ⟨1, by omega⟩).1 + change (1 : ℤ) > 0; norm_num, + Or.inl (by simpa [q, P4828T1Root] using hU0.symm)⟩ + · subst p + exact ⟨⟨0, by omega⟩, + by change 0 < (P4828T1Root a true ⟨1, by omega⟩).1 + change (1 : ℤ) > 0; norm_num, + Or.inr ⟨⟨2, by omega⟩, + by change (P4828T1Root a true ⟨3, by omega⟩).1 = 0 + change (0 : ℤ) = 0; rfl, + by apply Complex.ext <;> simp [br, q, P4828T1Root, L, y, + htwo_re, htwo_im, + ]; norm_num ⟩⟩ + · subst p + exact ⟨⟨1, by omega⟩, + by change 0 < (P4828T1Root a true ⟨2, by omega⟩).1 + change (1 : ℤ) > 0; norm_num, + Or.inl (by simpa [q, P4828T1Root] using hU1.symm)⟩ + · subst p + exact ⟨⟨1, by omega⟩, + by change 0 < (P4828T1Root a true ⟨2, by omega⟩).1 + change (1 : ℤ) > 0; norm_num, + Or.inr ⟨⟨2, by omega⟩, + by change (P4828T1Root a true ⟨3, by omega⟩).1 = 0 + change (0 : ℤ) = 0; rfl, + by apply Complex.ext <;> simp [tr, q, P4828T1Root, L, y, + htwo_re, htwo_im, + ]; norm_num ⟩⟩ + +private theorem himage (a : GaussianInt) : Complex.equivRealProdLm '' (vertices a) = + ({(L a) + 1, (L a) + 2} : Set Real) ×ˢ {(y a), (y a) + 2} := by + classical + let q := P4828T1Root a true + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, + (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, + (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} + let bl : Complex := ⟨L + 1, y⟩ + let br : Complex := ⟨L + 2, y⟩ + let tl : Complex := ⟨L + 1, y + 2⟩ + let tr : Complex := ⟨L + 2, y + 2⟩ + have hvertices : vertices = {bl, br, tl, tr} := hvertices a + change (Complex.equivRealProdLm '' vertices = + ({L + 1, L + 2} : Set Real) ×ˢ {y, y + 2}) + rw [hvertices] + ext z + simp [bl, br, tl, tr, Complex.equivRealProdLm]; aesop + +private theorem hcornerHull (a : GaussianInt) : convexHull Real + (({(L a) + 1, (L a) + 2} : Set Real) ×ˢ ({(y a), (y a) + 2} : Set Real)) = + Set.Icc ((L a) + 1) ((L a) + 2) ×ˢ Set.Icc (y a) ((y a) + 2) := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + change (convexHull Real + (({L + 1, L + 2} : Set Real) ×ˢ ({y, y + 2} : Set Real)) = + Set.Icc (L + 1) (L + 2) ×ˢ Set.Icc y (y + 2)) + rw [convexHull_prod, convexHull_pair, convexHull_pair, + segment_eq_Icc (by linarith), segment_eq_Icc (by linarith)] + +private theorem hrectImage (a : GaussianInt) : Complex.equivRealProdLm '' + ((Set.Icc ((L a) + 1) ((L a) + 2)) ×ℂ (Set.Icc (y a) ((y a) + 2))) = + Set.Icc ((L a) + 1) ((L a) + 2) ×ˢ Set.Icc (y a) ((y a) + 2) := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + change (Complex.equivRealProdLm '' + ((Set.Icc (L + 1) (L + 2)) ×ℂ (Set.Icc y (y + 2))) = + Set.Icc (L + 1) (L + 2) ×ˢ Set.Icc y (y + 2)) + ext z + simp only [Set.mem_image, Set.mem_prod, Complex.mem_reProdIm] + constructor + · rintro ⟨p, ⟨hp, hp'⟩, rfl⟩ + exact ⟨hp, hp'⟩ + · rintro ⟨hz, hz'⟩ + refine ⟨Complex.equivRealProdLm.symm z, ?_, + Complex.equivRealProdLm.apply_symm_apply z⟩ + constructor + · simpa [Complex.equivRealProdLm_symm_apply] using hz + · simpa [Complex.equivRealProdLm_symm_apply] using hz' + +private theorem himageLin (a : GaussianInt) : Complex.equivRealProdLm.toLinearMap '' (vertices a) = + ({(L a) + 1, (L a) + 2} : Set Real) ×ˢ {(y a), (y a) + 2} := by + classical + let q := P4828T1Root a true + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, + (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, + (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} + have himage : Complex.equivRealProdLm '' vertices = + ({L + 1, L + 2} : Set Real) ×ˢ {y, y + 2} := himage a + change (Complex.equivRealProdLm.toLinearMap '' vertices = + ({L + 1, L + 2} : Set Real) ×ˢ {y, y + 2}) + change Complex.equivRealProdLm '' vertices = _ + exact himage + +private theorem hrectImageLin (a : GaussianInt) : Complex.equivRealProdLm.toLinearMap '' + ((Set.Icc ((L a) + 1) ((L a) + 2)) ×ℂ (Set.Icc (y a) ((y a) + 2))) = + Set.Icc ((L a) + 1) ((L a) + 2) ×ˢ Set.Icc (y a) ((y a) + 2) := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + have hrectImage : Complex.equivRealProdLm '' + ((Set.Icc (L + 1) (L + 2)) ×ℂ (Set.Icc y (y + 2))) = + Set.Icc (L + 1) (L + 2) ×ˢ Set.Icc y (y + 2) := hrectImage a + change (Complex.equivRealProdLm.toLinearMap '' + ((Set.Icc (L + 1) (L + 2)) ×ℂ (Set.Icc y (y + 2))) = + Set.Icc (L + 1) (L + 2) ×ˢ Set.Icc y (y + 2)) + change Complex.equivRealProdLm '' + ((Set.Icc (L + 1) (L + 2)) ×ℂ (Set.Icc y (y + 2))) = _ + exact hrectImage + +private theorem hHull (a : GaussianInt) : convexHull Real (vertices a) = + (Set.Icc ((L a) + 1) ((L a) + 2)) ×ℂ (Set.Icc (y a) ((y a) + 2)) := by + classical + let q := P4828T1Root a true + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, + (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, + (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} + have hcornerHull : convexHull Real + (({L + 1, L + 2} : Set Real) ×ˢ ({y, y + 2} : Set Real)) = + Set.Icc (L + 1) (L + 2) ×ˢ Set.Icc y (y + 2) := hcornerHull a + have himageLin : Complex.equivRealProdLm.toLinearMap '' vertices = + ({L + 1, L + 2} : Set Real) ×ˢ {y, y + 2} := himageLin a + have hrectImageLin : Complex.equivRealProdLm.toLinearMap '' + ((Set.Icc (L + 1) (L + 2)) ×ℂ (Set.Icc y (y + 2))) = + Set.Icc (L + 1) (L + 2) ×ˢ Set.Icc y (y + 2) := hrectImageLin a + change (convexHull Real vertices = + (Set.Icc (L + 1) (L + 2)) ×ℂ (Set.Icc y (y + 2))) + apply (Set.image_injective.mpr Complex.equivRealProdLm.injective) + have hlin := LinearMap.image_convexHull + Complex.equivRealProdLm.toLinearMap vertices + change Complex.equivRealProdLm.toLinearMap '' + (convexHull Real vertices) = Complex.equivRealProdLm.toLinearMap '' + ((Set.Icc (L + 1) (L + 2)) ×ℂ (Set.Icc y (y + 2))) + rw [hlin, himageLin, hcornerHull, hrectImageLin] + +private theorem rectangleInterior (l u v w : Real) : + interior (Set.Icc l u ×ℂ Set.Icc v w) = + {z : Complex | l < z.re ∧ z.re < u ∧ v < z.im ∧ z.im < w} := by + classical + ext z + simp [Complex.interior_reProdIm, interior_Icc, Complex.mem_reProdIm, Set.mem_Ioo, and_assoc] + +private theorem hInterior (a : GaussianInt) : interior (convexHull Real (vertices a)) = + {p : Complex | (L a) + 1 < p.re ∧ p.re < (L a) + 2 ∧ + (y a) < p.im ∧ p.im < (y a) + 2} := by + classical + let q := P4828T1Root a true + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, + (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, + (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} + have hHull : convexHull Real vertices = + (Set.Icc (L + 1) (L + 2)) ×ℂ (Set.Icc y (y + 2)) := hHull a + have rectangleInterior (l u v w : Real) : + interior (Set.Icc l u ×ℂ Set.Icc v w) = + {z : Complex | l < z.re ∧ z.re < u ∧ v < z.im ∧ z.im < w} := rectangleInterior l u v w + change (interior (convexHull Real vertices) = + {p : Complex | L + 1 < p.re ∧ p.re < L + 2 ∧ + y < p.im ∧ p.im < y + 2}) + rw [hHull] + exact rectangleInterior (L + 1) (L + 2) y (y + 2) + +private theorem hcenter0 (a : GaussianInt) : + (((q a) (0 : Fin 3).succ).2 : Complex) / (((q a) (0 : Fin 3).succ).1 : Real) = + ((1 + 2 * a : GaussianInt) : Complex) := by + classical + let q := P4828T1Root a true + change (((q (0 : Fin 3).succ).2 : Complex) / ((q (0 : Fin 3).succ).1 : Real) = + ((1 + 2 * a : GaussianInt) : Complex)) + simp [q, P4828T1Root] + +private theorem hcenter1 (a : GaussianInt) : + (((q a) (1 : Fin 3).succ).2 : Complex) / (((q a) (1 : Fin 3).succ).1 : Real) = + ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) := by + classical + let q := P4828T1Root a true + change (((q (1 : Fin 3).succ).2 : Complex) / ((q (1 : Fin 3).succ).1 : Real) = + ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)) + simp [q, P4828T1Root] + +private theorem hGap (a : GaussianInt) : P4828T1Gap (L a) (q a) = {p : Complex | + (L a) + 1 < p.re ∧ p.re < (L a) + 2 ∧ (y a) < p.im ∧ p.im < (y a) + 2 ∧ + 1 < dist p ((1 + 2 * a : GaussianInt) : Complex) ∧ + 1 < dist p ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)} := by + classical + let q := P4828T1Root a true + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, + (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, + (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} + have hInterior : interior (convexHull Real vertices) = + {p : Complex | L + 1 < p.re ∧ p.re < L + 2 ∧ + y < p.im ∧ p.im < y + 2} := hInterior a + have hcenter0 : + ((q (0 : Fin 3).succ).2 : Complex) / ((q (0 : Fin 3).succ).1 : Real) = + ((1 + 2 * a : GaussianInt) : Complex) := hcenter0 a + have hcenter1 : + ((q (1 : Fin 3).succ).2 : Complex) / ((q (1 : Fin 3).succ).1 : Real) = + ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) := hcenter1 a + change (P4828T1Gap L q = {p : Complex | + L + 1 < p.re ∧ p.re < L + 2 ∧ y < p.im ∧ p.im < y + 2 ∧ + 1 < dist p ((1 + 2 * a : GaussianInt) : Complex) ∧ + 1 < dist p ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)}) + ext p + change (p ∈ interior (convexHull Real vertices) ∧ + ∀ j : Fin 3, 0 < (q j.succ).1 → + (1 / ((q j.succ).1 : Real)) < + dist p (((q j.succ).2 : Complex) / ((q j.succ).1 : Real))) ↔ _ + rw [hInterior] + constructor + · rintro ⟨⟨hxl, hxr, hyl, hyr⟩, hdist⟩ + have hd0 := hdist 0 (by simp [q, P4828T1Root]) + have hd1 := hdist 1 (by simp [q, P4828T1Root]) + refine ⟨hxl, hxr, hyl, ?_, ?_, ?_⟩ + · linarith + · simpa [q, P4828T1Root, hcenter0] using hd0 + · simpa [q, P4828T1Root, hcenter1] using hd1 + · rintro ⟨hxl, hxr, hyl, hyr, hd0, hd1⟩ + refine ⟨⟨hxl, hxr, hyl, ?_⟩, ?_⟩ + · linarith + · intro j hj + fin_cases j + · simpa [q, P4828T1Root, hcenter0] using hd0 + · simpa [q, P4828T1Root, hcenter1] using hd1 + · simp [q, P4828T1Root] at hj + +private noncomputable def child (a : GaussianInt) : Complex := ⟨(L a) + 7 / 4, (y a) + 1⟩ + +private theorem hchild (a : GaussianInt) : + (((q a) (0 : Fin 4)).2 : Complex) / (((q a) (0 : Fin 4)).1 : Real) = (child a) := by + classical + let q := P4828T1Root a true + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let child : Complex := ⟨L + 7 / 4, y + 1⟩ + change (((q (0 : Fin 4)).2 : Complex) / ((q (0 : Fin 4)).1 : Real) = child) + change ((7 + 8 * a + 4 * ⟨0, 1⟩ : GaussianInt) : Complex) / 4 = _ + rw [GaussianInt.toComplex_def₂] + apply Complex.ext + · simp [child, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.im_add, + Zsqrtd.im_mul, L]; + field_simp; ring + · simp [child, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.im_add, + Zsqrtd.im_mul, y]; + field_simp; ring + +private theorem hs25 : Real.sqrt (25 : Real) = 5 := by + classical + rw [show (25 : Real) = 5 * 5 by norm_num] + exact Real.sqrt_mul_self (by norm_num) + +private theorem hs16 : Real.sqrt (16 : Real) = 4 := by + classical + rw [show (16 : Real) = 4 * 4 by norm_num] + exact Real.sqrt_mul_self (by norm_num) + +private theorem hdist0 (a : GaussianInt) : dist (child a) (bl a) = (5 : Real) / 4 := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let bl : Complex := ⟨L + 1, y⟩ + let child : Complex := ⟨L + 7 / 4, y + 1⟩ + have hs25 : Real.sqrt (25 : Real) = 5 := hs25 + have hs16 : Real.sqrt (16 : Real) = 4 := hs16 + change (dist child bl = (5 : Real) / 4) + norm_num [Complex.dist_eq, Complex.norm_def, Complex.normSq_apply, + hs25, hs16, child, bl] + +private theorem hdist1 (a : GaussianInt) : dist (child a) (tl a) = (5 : Real) / 4 := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + let tl : Complex := ⟨L + 1, y + 2⟩ + let child : Complex := ⟨L + 7 / 4, y + 1⟩ + have hs25 : Real.sqrt (25 : Real) = 5 := hs25 + have hs16 : Real.sqrt (16 : Real) = 4 := hs16 + change (dist child tl = (5 : Real) / 4) + norm_num [Complex.dist_eq, Complex.norm_def, Complex.normSq_apply, + hs25, hs16, child, tl] + +end RootGeometryRight + +theorem P4828T1RightRootGeometry (a : GaussianInt) : + let q := P4828T1Root a true + let L : Real := 2 * (a.re : Real) + ProperBandQuadruple q ∧ P4828T1LineSupport L q ∧ + P4828T1Disk (q 0) ⊆ P4828T1Gap L q ∧ + P4828T1Gap L q = {p : Complex | + L + 1 < p.re ∧ p.re < L + 2 ∧ + 2 * (a.im : Real) < p.im ∧ p.im < 2 * (a.im : Real) + 2 ∧ + 1 < dist p ((1 + 2 * a : GaussianInt) : Complex) ∧ + 1 < dist p ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)} := by +-- BODY + dsimp only + let q := P4828T1Root a true + let L : Real := 2 * (a.re : Real) + constructor + · constructor + · convert (SemiProperQuadruple.successor + (SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate (SemiProperQuadruple.base a)))) using 1; + simp [P4828T1Root]; ring + · intro j + fin_cases j <;> simp [P4828T1Root] + constructor + · refine ⟨?_, ?_⟩ + · intro k hk + fin_cases k <;> simp [P4828T1Root] at hk ⊢ + · intro k j hk hj + fin_cases k <;> fin_cases j <;> + simp [P4828T1Root] at hk hj ⊢ <;> norm_num at hk hj ⊢ <;> ring + let y : Real := 2 * (a.im : Real) + let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ + (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, + (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, + (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} + let bl : Complex := ⟨L + 1, y⟩ + let br : Complex := ⟨L + 2, y⟩ + let tl : Complex := ⟨L + 1, y + 2⟩ + let tr : Complex := ⟨L + 2, y + 2⟩ + have hU0 : ((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩ := RootGeometryRight.hU0 a + have hU1 : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = + ⟨L + 1, y + 2⟩ := RootGeometryRight.hU1 a + have hU0c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) = ⟨L + 1, y⟩ := RootGeometryRight.hU0c a + have hU1c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (⟨0, 1⟩ : GaussianInt) = ⟨L + 1, y + 2⟩ := RootGeometryRight.hU1c a + have htwo_re : (GaussianInt.toComplex (2 : GaussianInt)).re = 2 := RootGeometryRight.htwo_re + have htwo_im : (GaussianInt.toComplex (2 : GaussianInt)).im = 0 := RootGeometryRight.htwo_im + have hvertices : vertices = {bl, br, tl, tr} := RootGeometryRight.hvertices a + have himage : Complex.equivRealProdLm '' vertices = + ({L + 1, L + 2} : Set Real) ×ˢ {y, y + 2} := RootGeometryRight.himage a + have hcornerHull : convexHull Real + (({L + 1, L + 2} : Set Real) ×ˢ ({y, y + 2} : Set Real)) = + Set.Icc (L + 1) (L + 2) ×ˢ Set.Icc y (y + 2) := RootGeometryRight.hcornerHull a + have hrectImage : Complex.equivRealProdLm '' + ((Set.Icc (L + 1) (L + 2)) ×ℂ (Set.Icc y (y + 2))) = + Set.Icc (L + 1) (L + 2) ×ˢ Set.Icc y (y + 2) := RootGeometryRight.hrectImage a + have himageLin : Complex.equivRealProdLm.toLinearMap '' vertices = + ({L + 1, L + 2} : Set Real) ×ˢ {y, y + 2} := RootGeometryRight.himageLin a + have hrectImageLin : Complex.equivRealProdLm.toLinearMap '' + ((Set.Icc (L + 1) (L + 2)) ×ℂ (Set.Icc y (y + 2))) = + Set.Icc (L + 1) (L + 2) ×ˢ Set.Icc y (y + 2) := RootGeometryRight.hrectImageLin a + have hHull : convexHull Real vertices = + (Set.Icc (L + 1) (L + 2)) ×ℂ (Set.Icc y (y + 2)) := RootGeometryRight.hHull a + have rectangleInterior (l u v w : Real) : + interior (Set.Icc l u ×ℂ Set.Icc v w) = + {z : Complex | l < z.re ∧ z.re < u ∧ v < z.im ∧ z.im < w} := + RootGeometryRight.rectangleInterior l u v w + have hInterior : interior (convexHull Real vertices) = + {p : Complex | L + 1 < p.re ∧ p.re < L + 2 ∧ + y < p.im ∧ p.im < y + 2} := RootGeometryRight.hInterior a + have hcenter0 : + ((q (0 : Fin 3).succ).2 : Complex) / ((q (0 : Fin 3).succ).1 : Real) = + ((1 + 2 * a : GaussianInt) : Complex) := RootGeometryRight.hcenter0 a + have hcenter1 : + ((q (1 : Fin 3).succ).2 : Complex) / ((q (1 : Fin 3).succ).1 : Real) = + ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) := RootGeometryRight.hcenter1 a + have hGap : P4828T1Gap L q = {p : Complex | + L + 1 < p.re ∧ p.re < L + 2 ∧ y < p.im ∧ p.im < y + 2 ∧ + 1 < dist p ((1 + 2 * a : GaussianInt) : Complex) ∧ + 1 < dist p ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)} := RootGeometryRight.hGap a + let child : Complex := ⟨L + 7 / 4, y + 1⟩ + have hchild : + ((q (0 : Fin 4)).2 : Complex) / ((q (0 : Fin 4)).1 : Real) = child := + RootGeometryRight.hchild a + have hs25 : Real.sqrt (25 : Real) = 5 := RootGeometryRight.hs25 + have hs16 : Real.sqrt (16 : Real) = 4 := RootGeometryRight.hs16 + have hdist0 : dist child bl = (5 : Real) / 4 := RootGeometryRight.hdist0 a + have hdist1 : dist child tl = (5 : Real) / 4 := RootGeometryRight.hdist1 a + · constructor + · rw [hGap] + intro p hp + have hballMember : dist p + (((q (0 : Fin 4)).2 : Complex) / ((q (0 : Fin 4)).1 : Real)) < + 1 / ((q (0 : Fin 4)).1 : Real) := by + simpa [P4828T1Disk] using hp + rw [hchild] at hballMember + have hcurv0 : (q (0 : Fin 4)).1 = 4 := by + change (P4828T1Root a true ⟨0, by omega⟩).1 = 4 + norm_num [P4828T1Root] + rw [hcurv0] at hballMember + have hpball : dist p child < (1 : Real) / 4 := by simpa using hballMember + have hnorm : ‖p - child‖ < (1 : Real) / 4 := by + simpa [Complex.dist_eq] using hpball + have hre : |p.re - (L + 7 / 4)| < (1 : Real) / 4 := by + have h := lt_of_le_of_lt (Complex.abs_re_le_norm (p - child)) hnorm + simpa [child, Complex.sub_re] using h + have him : |p.im - (y + 1)| < (1 : Real) / 4 := by + have h := lt_of_le_of_lt (Complex.abs_im_le_norm (p - child)) hnorm + simpa [child, Complex.sub_im] using h + have hre' := abs_lt.mp hre + have him' := abs_lt.mp him + have htri0 := dist_triangle child p bl + have htri1 := dist_triangle child p tl + rw [dist_comm child p] at htri0 htri1 + have hparent0 : 1 < dist p bl := by linarith + have hparent1 : 1 < dist p tl := by linarith + refine ⟨by linarith [hre'.1], by linarith [hre'.2], + by linarith [him'.1], by linarith [him'.2], ?_, ?_⟩ + · simpa [bl, hU0] using hparent0 + · simpa [tl, hU1] using hparent1 + · simpa [y, L, q, P4828T1Root] using hGap + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1Root.lean b/LeanPool/ApollonianSuperharmonic/P4828T1Root.lean new file mode 100644 index 0000000000..bb4b42a3eb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1Root.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates + +-- [TABLET NODE: P4828T1Root] + +/-! +# P4828T1Root + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Put $U_z=(1,1+2z)$. The first proper left and right root presentations are +$$ + F(z,-)=((4,1+8z+4i),U_z,(0,-1),U_{z+i}),\qquad + F(z,+)=((4,7+8z+4i),U_z,U_{z+i},(0,1)). +$$ +The Boolean values false and true denote $-$ and $+$, respectively. +These presentations are denoted by `P4828T1Root`. +-/ +def P4828T1Root (z : GaussianInt) (side : Bool) : + Fin 4 → CircleCoordinates := +-- BODY + if side then + ![(4, 7 + 8 * z + 4 * ⟨0, 1⟩), (1, 1 + 2 * z), + (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (0, 1)] + else + ![(4, 1 + 8 * z + 4 * ⟨0, 1⟩), (1, 1 + 2 * z), + (0, -1), (1, 1 + 2 * z + 2 * ⟨0, 1⟩)] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1RootSeparation.lean b/LeanPool/ApollonianSuperharmonic/P4828T1RootSeparation.lean new file mode 100644 index 0000000000..c39c624c3f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1RootSeparation.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4828T1LeftRootGeometry +public import LeanPool.ApollonianSuperharmonic.P4828T1RightRootGeometry + +-- [TABLET NODE: P4828T1RootSeparation] + +/-! +# P4828T1RootSeparation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4828T1RootSeparation (a b : GaussianInt) (e f : Bool) + (hne : (a, e) ≠ (b, f)) : + Disjoint (P4828T1Gap (2 * (a.re : Real)) (P4828T1Root a e)) + (P4828T1Gap (2 * (b.re : Real)) (P4828T1Root b f)) := by +-- BODY + have bounds : ∀ (z : GaussianInt) (side : Bool) (p : Complex), + p ∈ P4828T1Gap (2 * (z.re : Real)) (P4828T1Root z side) → + 2 * (z.re : Real) < p.re ∧ p.re < 2 * (z.re : Real) + 2 ∧ + 2 * (z.im : Real) < p.im ∧ p.im < 2 * (z.im : Real) + 2 := by + intro z side p hp + cases side + · rw [(P4828T1LeftRootGeometry z).2.2.2] at hp + exact ⟨hp.1, by linarith [hp.2.1], hp.2.2.1, hp.2.2.2.1⟩ + · rw [(P4828T1RightRootGeometry z).2.2.2] at hp + exact ⟨by linarith [hp.1], hp.2.1, hp.2.2.1, hp.2.2.2.1⟩ + apply Set.disjoint_left.2 + intro p hp hp' + obtain ⟨ax, ax', ay, ay'⟩ := bounds a e p hp + obtain ⟨bx, bx', by_, by'⟩ := bounds b f p hp' + have hre : a.re = b.re := by + have h1 : a.re < b.re + 1 := by + exact_mod_cast (show (a.re : Real) < (b.re : Real) + 1 by linarith) + have h2 : b.re < a.re + 1 := by + exact_mod_cast (show (b.re : Real) < (a.re : Real) + 1 by linarith) + omega + have him : a.im = b.im := by + have h1 : a.im < b.im + 1 := by + exact_mod_cast (show (a.im : Real) < (b.im : Real) + 1 by linarith) + have h2 : b.im < a.im + 1 := by + exact_mod_cast (show (b.im : Real) < (a.im : Real) + 1 by linarith) + omega + have hab : a = b := by ext <;> assumption + subst b + have hef : e = f := by + cases e <;> cases f + · rfl + · rw [(P4828T1LeftRootGeometry a).2.2.2] at hp + rw [(P4828T1RightRootGeometry a).2.2.2] at hp' + linarith [hp.2.1, hp'.1] + · rw [(P4828T1RightRootGeometry a).2.2.2] at hp + rw [(P4828T1LeftRootGeometry a).2.2.2] at hp' + linarith [hp.1, hp'.2.1] + · rfl + exact hne (by rw [hef]) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1Rotate.lean b/LeanPool/ApollonianSuperharmonic/P4828T1Rotate.lean new file mode 100644 index 0000000000..e7e826da02 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1Rotate.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates + +-- [TABLET NODE: P4828T1Rotate] + +/-! +# P4828T1Rotate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a coordinate quadruple $q$ and $r\in\mathbb Z/3\mathbb Z$, let +$R_rq$ fix the child and send parent slot $j$ to the old parent slot $j+r$. +Here parent slots are numbered $0,1,2$, independently of the child slot. +This operation is denoted by `P4828T1Rotate`. +-/ +def P4828T1Rotate (q : Fin 4 → CircleCoordinates) (r : Fin 3) : + Fin 4 → CircleCoordinates := +-- BODY + Fin.cases (q 0) (fun j => q ((j + r).succ)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1RotationLaws.lean b/LeanPool/ApollonianSuperharmonic/P4828T1RotationLaws.lean new file mode 100644 index 0000000000..efb21f5900 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1RotationLaws.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple + +-- [TABLET NODE: P4828T1RotationLaws] + +/-! +# P4828T1RotationLaws + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4828T1RotationLaws : + (∀ q : Fin 4 → CircleCoordinates, P4828T1Rotate q 0 = q) ∧ + (∀ (q : Fin 4 → CircleCoordinates) (a b : Fin 3), + P4828T1Rotate (P4828T1Rotate q a) b = P4828T1Rotate q (b + a)) ∧ + (∀ (q : Fin 4 → CircleCoordinates) (a : Fin 3), + ProperBandQuadruple q → ProperBandQuadruple (P4828T1Rotate q a)) := by +-- BODY + refine ⟨?_, ?_, ?_⟩ + · intro q + funext k + refine Fin.cases ?_ (fun j => ?_) k + · rfl + · simp [P4828T1Rotate] + · intro q a b + funext k + refine Fin.cases ?_ (fun j => ?_) k + · rfl + · simp [P4828T1Rotate, add_assoc] + · intro q a hq + have hsemi : SemiProperQuadruple (P4828T1Rotate q a) := by + fin_cases a + · convert hq.1 using 1 + funext k + refine Fin.cases ?_ (fun j => ?_) k + · rfl + · simp [P4828T1Rotate] + · convert SemiProperQuadruple.rotate hq.1 using 1; + funext k; fin_cases k <;> rfl + · convert SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1) using 1; + funext k; fin_cases k <;> rfl + exact ⟨hsemi, fun j => by simpa [P4828T1Rotate] using hq.2 (j + a)⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1Step.lean b/LeanPool/ApollonianSuperharmonic/P4828T1Step.lean new file mode 100644 index 0000000000..e715702f54 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4828T1Step.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates + +-- [TABLET NODE: P4828T1Step] + +/-! +# P4828T1Step + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The coordinate successor of $q=(C_0,C_1,C_2,C_3)$ is +$S(q)=(2(C_0+C_2+C_3)-C_1,C_0,C_2,C_3)$, with the arithmetic +performed separately in the integer curvature and Gaussian numerator. +It is denoted by `P4828T1Step`. +-/ +def P4828T1Step (q : Fin 4 → CircleCoordinates) : + Fin 4 → CircleCoordinates := +-- BODY + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4840T6ConstructorCovariance.lean b/LeanPool/ApollonianSuperharmonic/P4840T6ConstructorCovariance.lean new file mode 100644 index 0000000000..ce49232398 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4840T6ConstructorCovariance.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction + +-- [TABLET NODE: P4840T6ConstructorCovariance] + +/-! +# P4840T6ConstructorCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4840T6ConstructorCovariance (g : BandPackingSymmetry) + (hg : ∃ w : GaussianInt, g = .shift w ∨ g = .comp (.shift w) .negate) : + BandPackingSymmetryReversesOrientation g = false ∧ + (∀ C : CircleCoordinates, (BandPackingSymmetryCircleAction g C).1 = C.1) ∧ + ∀ q : Fin 4 → CircleCoordinates, + let S := fun x : Fin 4 → CircleCoordinates => + ![(2 * (x 0).1 + 2 * (x 2).1 + 2 * (x 3).1 - (x 1).1, + 2 * (x 0).2 + 2 * (x 2).2 + 2 * (x 3).2 - (x 1).2), + x 0, x 2, x 3] + BandPackingSymmetryQuadrupleAction g (S q) = + S (BandPackingSymmetryQuadrupleAction g q) := by + obtain ⟨w, rfl | rfl⟩ := hg + all_goals + refine ⟨rfl, (fun _ => rfl), ?_⟩ + intro q + funext j + fin_cases j <;> apply Prod.ext + all_goals simp [BandPackingSymmetryQuadrupleAction, BandPackingSymmetryCircleAction, + BandPackingSymmetryReversesOrientation] + all_goals ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4840T6DiamondRecurrence.lean b/LeanPool/ApollonianSuperharmonic/P4840T6DiamondRecurrence.lean new file mode 100644 index 0000000000..2153c22661 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4840T6DiamondRecurrence.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple + +-- [TABLET NODE: P4840T6DiamondRecurrence] + +/-! +# P4840T6DiamondRecurrence + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4840T6DiamondRecurrence (K : DiamondParameter) : + let R := fun x : Fin 4 → CircleCoordinates => ![x 0, x 2, x 3, x 1] + let S := fun x : Fin 4 → CircleCoordinates => + ![(2 * (x 0).1 + 2 * (x 2).1 + 2 * (x 3).1 - (x 1).1, + 2 * (x 0).2 + 2 * (x 2).2 + 2 * (x 3).2 - (x 1).2), + x 0, x 2, x 3] + R (S (R (R (DiamondRecursiveQuadruple K)))) = + DiamondRecursiveQuadruple ⟨K.1 + 1, by omega⟩ := by + have hk : 1 ≤ K.1 := K.2 + funext j + fin_cases j <;> apply Prod.ext + all_goals try apply Zsqrtd.ext + all_goals simp [DiamondRecursiveQuadruple, Nat.cast_sub hk] + all_goals ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4840T6NegatedRoot.lean b/LeanPool/ApollonianSuperharmonic/P4840T6NegatedRoot.lean new file mode 100644 index 0000000000..811b581d07 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4840T6NegatedRoot.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple + +-- [TABLET NODE: P4840T6NegatedRoot] + +/-! +# P4840T6NegatedRoot + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4840T6NegatedRoot (z : GaussianInt) : + BandPackingSymmetryQuadrupleAction + (.comp (.shift (z + 1 + ⟨0, 1⟩)) .negate) + ![(4, 7 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (0, 1)] = + DiamondRecursiveQuadruple ⟨1, by norm_num⟩ := by + funext j + fin_cases j <;> apply Prod.ext + all_goals try apply Zsqrtd.ext + all_goals norm_num [BandPackingSymmetryQuadrupleAction, BandPackingSymmetryCircleAction, + BandPackingSymmetryReversesOrientation, DiamondRecursiveQuadruple] + all_goals ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4840T6ProperGrowth.lean b/LeanPool/ApollonianSuperharmonic/P4840T6ProperGrowth.lean new file mode 100644 index 0000000000..f4411d351c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4840T6ProperGrowth.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure + +-- [TABLET NODE: P4840T6ProperGrowth] + +/-! +# P4840T6ProperGrowth + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4840T6ProperGrowth (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) : + 1 < (q 0).1 ∧ + (q 0).1 < 2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1 := by +-- BODY + obtain ⟨hpos, hn, hz⟩ := ProperBandCurvatureStructure q hq + have h1 : (q 1).1 < (q 0).1 := hq.2 0 + have h2 : (q 2).1 < (q 0).1 := hq.2 1 + have n1 : 0 ≤ (q 1).1 := hn 0 + have n2 : 0 ≤ (q 2).1 := hn 1 + have n3 : 0 ≤ (q 3).1 := hn 2 + constructor + · by_contra h + have z1 : (q 1).1 = 0 := by omega + have z2 : (q 2).1 = 0 := by omega + have bad := hz 0 1 z1 z2 + norm_num at bad + · omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4840T6ShiftRoot.lean b/LeanPool/ApollonianSuperharmonic/P4840T6ShiftRoot.lean new file mode 100644 index 0000000000..aae3cb37d6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4840T6ShiftRoot.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple + +-- [TABLET NODE: P4840T6ShiftRoot] + +/-! +# P4840T6ShiftRoot + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4840T6ShiftRoot (z : GaussianInt) : + BandPackingSymmetryQuadrupleAction (.shift (-z)) + ![(4, 1 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (1, 1 + 2 * z), (0, -1)] = + DiamondRecursiveQuadruple ⟨1, by norm_num⟩ := by + funext j + fin_cases j <;> apply Prod.ext + all_goals try apply Zsqrtd.ext + all_goals norm_num [BandPackingSymmetryQuadrupleAction, BandPackingSymmetryCircleAction, + BandPackingSymmetryReversesOrientation, DiamondRecursiveQuadruple] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1Component.lean b/LeanPool/ApollonianSuperharmonic/P4849T1Component.lean new file mode 100644 index 0000000000..25800941f4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4849T1Component.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected + +-- [TABLET NODE: P4849T1Component] + +/-! +# P4849T1Component + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For sets $A,C\subseteq\mathbb Z[i]$, write +$\operatorname{Component}(A,C)$ when $C$ is nonempty and four-neighbor +connected, $C\subseteq A$, and every point of $A$ adjacent to a point of +$C$ belongs to $C$. Here connectedness is the finite-list path predicate +of `FourNeighborConnected`, and adjacency is that of +`FourNeighborAdjacent`. Thus this predicate specifies a whole +connected component, not merely a connected subset of $A$. +-/ +def P4849T1Component (A C : Set GaussianInt) : Prop := +-- BODY + FourNeighborConnected C ∧ C ⊆ A ∧ + ∀ x ∈ C, ∀ y ∈ A, FourNeighborAdjacent x y → y ∈ C + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1ComponentRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4849T1ComponentRestriction.lean new file mode 100644 index 0000000000..9fc4b8dc78 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4849T1ComponentRestriction.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4849T1Component +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian + +-- [TABLET NODE: P4849T1ComponentRestriction] + +/-! +# P4849T1ComponentRestriction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4849T1ComponentRestriction (g : IntegerLatticeFunction) + (A C : Set GaussianInt) + (hg : ∀ x, FourNeighborLaplacian g x ≤ 1) + (hA : ∀ x, FourNeighborLaplacian + (fun y => g y + Set.indicator A (fun _ => (1 : ℤ)) y) x ≤ 1) + (hC : P4849T1Component A C) : + ∀ x, FourNeighborLaplacian + (fun y => g y + Set.indicator C (fun _ => (1 : ℤ)) y) x ≤ 1 := by +-- BODY + classical + have symm {x y : GaussianInt} (h : FourNeighborAdjacent x y) : + FourNeighborAdjacent y x := by + rcases h with h | h | h | h + · exact Or.inr (Or.inl (by rw [h]; abel)) + · exact Or.inl (by rw [h]; abel) + · exact Or.inr (Or.inr (Or.inr (by rw [h]; abel))) + · exact Or.inr (Or.inr (Or.inl (by rw [h]; abel))) + let I (S : Set GaussianInt) (y : GaussianInt) : ℤ := + Set.indicator S (fun _ => (1 : ℤ)) y + have hsub (y : GaussianInt) : I C y ≤ I A y := by + by_cases hy : y ∈ C + · simp [I, hy, hC.2.1 hy] + · simp [I, hy] + by_cases ha : y ∈ A <;> simp [ha] + intro x + change FourNeighborLaplacian (fun y => g y + I C y) x ≤ 1 + by_cases hx : x ∈ C + · have heq (y : GaussianInt) (hy : FourNeighborAdjacent x y) : I C y = I A y := by + by_cases ha : y ∈ A + · simp [I, ha, hC.2.2 x hx y ha hy] + · have hc : y ∉ C := fun hc => ha (hC.2.1 hc) + simp [I, ha, hc] + have h := hA x + change FourNeighborLaplacian (fun y => g y + I A y) x ≤ 1 at h + simp only [FourNeighborLaplacian] at h ⊢ + rw [heq (x + 1) (Or.inl rfl), + heq (x - 1) (Or.inr (Or.inl rfl)), + heq (x + ⟨0, 1⟩) (Or.inr (Or.inr (Or.inl rfl))), + heq (x - ⟨0, 1⟩) (Or.inr (Or.inr (Or.inr rfl)))] + simpa [I, hx, hC.2.1 hx] using h + · by_cases ha : x ∈ A + · have hzero (y : GaussianInt) (hy : FourNeighborAdjacent x y) : I C y = 0 := by + have hc : y ∉ C := fun hc => hx (hC.2.2 y hc x ha (symm hy)) + simp [I, hc] + simp only [FourNeighborLaplacian] + rw [hzero (x + 1) (Or.inl rfl), + hzero (x - 1) (Or.inr (Or.inl rfl)), + hzero (x + ⟨0, 1⟩) (Or.inr (Or.inr (Or.inl rfl))), + hzero (x - ⟨0, 1⟩) (Or.inr (Or.inr (Or.inr rfl)))] + simpa [I, hx, FourNeighborLaplacian] using hg x + · have h := hA x + change FourNeighborLaplacian (fun y => g y + I A y) x ≤ 1 at h + have hIx : I C x = 0 := by simp [I, hx] + have hAx : I A x = 0 := by simp [I, ha] + simp only [FourNeighborLaplacian] at h ⊢ + rw [hIx] + rw [hAx] at h + linarith [hsub (x + 1), hsub (x - 1), + hsub (x + ⟨0, 1⟩), hsub (x - ⟨0, 1⟩)] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1InfiniteLimitComponent.lean b/LeanPool/ApollonianSuperharmonic/P4849T1InfiniteLimitComponent.lean new file mode 100644 index 0000000000..08d7e56943 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4849T1InfiniteLimitComponent.lean @@ -0,0 +1,276 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4849T1Component + +-- [TABLET NODE: P4849T1InfiniteLimitComponent] + +/-! +# P4849T1InfiniteLimitComponent + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace InfiniteLimitProof + +private theorem hconnX : + ∀ (L : Set GaussianInt), ∀ (a : GaussianInt), + let reachable (x : GaussianInt) : Prop := + ∃ p : List GaussianInt, p.head? = some a ∧ p.getLast? = some x ∧ + (∀ w ∈ p, w ∈ L) ∧ p.IsChain FourNeighborAdjacent + let X : Set GaussianInt := {x | reachable x} + (a ∈ X) → (FourNeighborConnected X) := by + classical + intro L a reachable X haX + refine ⟨⟨a, haX⟩, ?_⟩ + intro x hx y hy + rcases hx with ⟨p, hp, hpx, hpmem, hpc⟩ + rcases hy with ⟨q, hq, hqy, hqmem, hqc⟩ + have symm : ∀ u v, FourNeighborAdjacent u v → FourNeighborAdjacent v u := by + intro u v huv + rcases huv with rfl | rfl | rfl | rfl <;> + simp [FourNeighborAdjacent, add_assoc, add_comm, add_left_comm] + have prefixReach : ∀ (r : List GaussianInt), r.head? = some a → + (∀ t ∈ r, t ∈ L) → r.IsChain FourNeighborAdjacent → + ∀ t ∈ r, t ∈ X := by + intro r hr hmem hchain t ht + obtain ⟨l₁, l₂, heq⟩ := List.mem_iff_append.mp ht + subst r + refine ⟨l₁ ++ [t], ?_, ?_, ?_, ?_⟩ + · simpa using hr + · simp + · intro u hu + simp only [List.mem_append, List.mem_cons] at hu + rcases hu with hu | rfl | hu + · exact hmem u (by simp [hu]) + · exact hmem u (by simp) + · simp at hu + · exact (List.isChain_split.mp hchain).1 + have hpc' : p.IsChain (fun u v => FourNeighborAdjacent v u) := + hpc.imp (fun u v huv => symm u v huv) + have hrev : p.reverse.IsChain FourNeighborAdjacent := + List.isChain_reverse.mpr hpc' + have hqtail : q.tail.IsChain FourNeighborAdjacent := hqc.tail + have hpn : p ≠ [] := by intro he; simp [he] at hp + have hqn : q ≠ [] := by intro he; simp [he] at hq + have hjoin : (p.reverse ++ q.tail).IsChain FourNeighborAdjacent := by + apply hrev.append hqtail + intro u hu v hv + have hu' : u = a := by simpa [hp] using hu.symm + subst u + cases q with + | nil => simp at hq + | cons u s => + simp only [List.head?_cons, Option.some.injEq] at hq + subst u + cases s with + | nil => simp at hv + | cons u s => + have hfirst : FourNeighborAdjacent a u := (List.isChain_cons_cons.mp hqc).1 + rcases (by simpa using hv : u = v) with rfl + exact hfirst + have hjoinmem : ∀ w ∈ p.reverse ++ q.tail, w ∈ X := by + intro w hw + simp only [List.mem_append] at hw + rcases hw with hw | hw + · apply prefixReach p hp hpmem hpc w + simpa using hw + · apply prefixReach q hq hqmem hqc w + exact List.mem_of_mem_tail hw + have hpne' : p.reverse ≠ [] := List.reverse_ne_nil_iff.mpr hpn + have hhead : (p.reverse ++ q.tail).head? = some x := by + simp [List.head?_append, List.head?_reverse, hpx] + have hlast : (p.reverse ++ q.tail).getLast? = some y := by + cases q with + | nil => simp at hq + | cons u s => + simp only [List.head?_cons, Option.some.injEq] at hq + subst u + cases s with + | nil => + simp at hqy + subst y + simp [hp] + | cons u s => + simpa [List.getLast?_append] using hqy + refine ⟨p.reverse ++ q.tail, hhead, hlast, hjoinmem, ?_⟩ + exact List.isChain_iff_forall_rel_of_append_cons_cons.mp hjoin + +private theorem hadjClose : + ∀ (L : Set GaussianInt), ∀ (a : GaussianInt), + let reachable (x : GaussianInt) : Prop := + ∃ p : List GaussianInt, p.head? = some a ∧ p.getLast? = some x ∧ + (∀ w ∈ p, w ∈ L) ∧ p.IsChain FourNeighborAdjacent + let X : Set GaussianInt := {x | reachable x} + ∀ x ∈ X, ∀ y ∈ L, FourNeighborAdjacent x y → y ∈ X := by + classical + intro L a reachable X x hx y hy hxy + rcases hx with ⟨p, hp, hpx, hpmem, hpc⟩ + have hchain : p.IsChain FourNeighborAdjacent := hpc + have hpn : p ≠ [] := by intro he; simp [he] at hp + refine ⟨p ++ [y], ?_, ?_, ?_, ?_⟩ + · simp [List.head?_append, hp] + · simp [hpx] + · intro w hw + simp only [List.mem_append, List.mem_singleton] at hw + rcases hw with hw | rfl + · exact hpmem w hw + · exact hy + · apply List.isChain_append.mpr + refine ⟨hchain, List.isChain_singleton _, ?_⟩ + intro u hu v hv + have hu' : u = x := by simpa [hpx] using hu.symm + have hv' : y = v := by simpa using hv + subst u + subst v + exact hxy + +private theorem hXinf : + ∀ (C : ℕ → Set GaussianInt), ∀ (L : Set GaussianInt), ∀ (a : GaussianInt), (∀ (n : ℕ), a ∈ C + n) → ((∀ (n : ℕ), FourNeighborConnected (C n)) → ((∀ (n : ℕ), ∃ (F : Finset GaussianInt), + (↑F : Set GaussianInt) ⊆ C n ∧ n < F.card) → ((∀ (F : Finset GaussianInt), ∃ (N : ℕ), ∀ n + ≥ N, ∀ x ∈ F, x ∈ C n ↔ x ∈ L) → ( + let reachable (x : GaussianInt) : Prop := + ∃ p : List GaussianInt, p.head? = some a ∧ p.getLast? = some x ∧ + (∀ w ∈ p, w ∈ L) ∧ p.IsChain FourNeighborAdjacent + let X : Set GaussianInt := {x | reachable x} + (a ∈ X) → ((∀ x ∈ X, ∀ y ∈ L, FourNeighborAdjacent x y → y ∈ X) → (X.Infinite)))))) := by + classical + intro C L a hanchor hconn hlarge hlocal reachable X haX hadjClose + by_contra hnot + change ¬ ¬ X.Finite at hnot + have hXfin : X.Finite := not_not.mp hnot + let shell : Set GaussianInt := X ∪ (fun x : GaussianInt => x + 1) '' X ∪ + (fun x : GaussianInt => x - 1) '' X ∪ + (fun x : GaussianInt => x + ⟨0, 1⟩) '' X ∪ + (fun x : GaussianInt => x - ⟨0, 1⟩) '' X + have hshellfin : shell.Finite := by + dsimp [shell] + exact (((hXfin.union (hXfin.image (fun x : GaussianInt => x + 1))).union + (hXfin.image (fun x : GaussianInt => x - 1))).union + (hXfin.image (fun x : GaussianInt => x + ⟨0, 1⟩))).union + (hXfin.image (fun x : GaussianInt => x - ⟨0, 1⟩)) + obtain ⟨N, hN⟩ := hlocal hshellfin.toFinset + let n := max N hshellfin.toFinset.card + obtain ⟨F, hFsub, hFcard⟩ := hlarge n + have hFn : ¬ (F : Set GaussianInt) ⊆ shell := by + intro hsubset + have hcard : F.card ≤ hshellfin.toFinset.card := by + apply Finset.card_le_card + intro x hx + have hxShell : (x : GaussianInt) ∈ shell := hsubset (by simpa using hx) + simpa using hshellfin.mem_toFinset.mpr hxShell + have : n < hshellfin.toFinset.card := by omega + omega + obtain ⟨b, hbF, hbnot⟩ := Set.not_subset.mp hFn + have hbC : b ∈ C n := hFsub (by simpa using hbF) + have hbnotX : b ∉ X := by + intro hbX + exact hbnot (by simp [shell, hbX]) + rcases (hconn n).2 a (hanchor n) b hbC with ⟨p, hp, hpb, hpmem, hpadj⟩ + have firstExit : ∀ (p : List GaussianInt) (x : GaussianInt), + p.head? = some x → p.getLast? = some b → + (∀ w ∈ p, w ∈ C n) → p.IsChain FourNeighborAdjacent → + x ∈ X → b ∉ X → + ∃ u v, u ∈ p ∧ v ∈ p ∧ u ∈ X ∧ v ∉ X ∧ FourNeighborAdjacent u v := by + intro p + induction p with + | nil => + intro x hhead _ _ _ _ _ + simp at hhead + | cons u rest ih => + intro x hhead hlast hmem hchain huX hbX + have hux : u = x := by simpa using hhead + subst x + cases rest with + | nil => + simp? at hlast + subst b + exact (hbX huX).elim + | cons v tail => + have htailLast : (v :: tail).getLast? = some b := by simpa using hlast + have htailMem : ∀ w ∈ v :: tail, w ∈ C n := by + intro w hw + exact hmem w (by simp [hw]) + have htailChain : List.IsChain FourNeighborAdjacent (v :: tail) := + hchain.tail + have huv : FourNeighborAdjacent u v := (List.isChain_cons_cons.mp hchain).1 + by_cases hvX : v ∈ X + · obtain ⟨s, t, hsP, htP, hsX, htX, hst⟩ := + ih v (by rfl) htailLast htailMem htailChain hvX hbX + exact ⟨s, t, by simp [hsP], by simp [htP], hsX, htX, hst⟩ + · exact ⟨u, v, by simp, by simp, huX, hvX, huv⟩ + obtain ⟨x, y, hxP, hyP, hxX, hyX, hxy⟩ := + firstExit p a hp hpb hpmem + (List.isChain_iff_forall_rel_of_append_cons_cons.mpr hpadj) + haX hbnotX + have hxC : x ∈ C n := hpmem x hxP + have hyC : y ∈ C n := hpmem y hyP + have hxShell : x ∈ shell := by simp [shell, hxX] + have hyShell : y ∈ shell := by + rcases hxy with rfl | rfl | rfl | rfl <;> simp [shell, hxX] + have hnN : n ≥ N := by dsimp [n]; omega + have hxL : x ∈ L := (hN n hnN x (hshellfin.mem_toFinset.mpr hxShell)).mp hxC + have hyL : y ∈ L := (hN n hnN y (hshellfin.mem_toFinset.mpr hyShell)).mp hyC + exact hyX (hadjClose x hxX y hyL hxy) + +end InfiniteLimitProof + +theorem P4849T1InfiniteLimitComponent : + ∀ (C : ℕ → Set GaussianInt), ∀ (L : Set GaussianInt), ∀ (z : GaussianInt), ∀ (a : + GaussianInt), (FourNeighborAdjacent z a) → ((∀ n, z ∉ C n) → ((∀ n, a ∈ C n) → ((∀ n, + FourNeighborConnected (C n)) → ((∀ n, ∃ F : Finset GaussianInt, (↑F : Set GaussianInt) ⊆ + C n ∧ n < F.card) → ((∀ F : Finset GaussianInt, ∃ N : ℕ, ∀ n ≥ N, ∀ x ∈ F, + (x ∈ C n ↔ x ∈ L)) → (∃ X : Set GaussianInt, P4849T1Component L X ∧ X.Infinite ∧ a ∈ X ∧ + z ∉ X)))))) := by + intro C L z a hadj hzero hanchor hconn hlarge hlocal +-- BODY + classical + have haL : a ∈ L := by + obtain ⟨N, hN⟩ := hlocal {a} + exact (hN N le_rfl a (by simp)).mp (hanchor N) + have hzL : z ∉ L := by + obtain ⟨N, hN⟩ := hlocal {z} + intro hz + exact hzero N ((hN N le_rfl z (by simp)).mpr hz) + let reachable (x : GaussianInt) : Prop := + ∃ p : List GaussianInt, p.head? = some a ∧ p.getLast? = some x ∧ + (∀ w ∈ p, w ∈ L) ∧ p.IsChain FourNeighborAdjacent + let X : Set GaussianInt := {x | reachable x} + have haX : a ∈ X := by + refine ⟨[a], rfl, rfl, ?_, List.isChain_singleton _⟩ + intro w hw + have hwa : w = a := by simpa using hw + simpa [hwa] using haL + have hsub : X ⊆ L := by + intro x hx + rcases hx with ⟨p, hp, hlast, hpmem, hchain⟩ + have hne : p ≠ [] := by intro he; simp [he] at hp + have hxmem : x ∈ p := by + rw [← List.getLast_of_getLast?_eq_some hlast] + exact List.getLast_mem hne + exact hpmem x hxmem + have hconnX : FourNeighborConnected X := InfiniteLimitProof.hconnX L a haX + have hadjClose : ∀ x ∈ X, ∀ y ∈ L, FourNeighborAdjacent x y → y ∈ X := + InfiniteLimitProof.hadjClose L a + have hcomp : P4849T1Component L X := by + exact ⟨hconnX, hsub, hadjClose⟩ + have hzX : z ∉ X := by + intro hz + exact hzL (hsub hz) + have hXinf : X.Infinite := InfiniteLimitProof.hXinf C L a hanchor hconn hlarge hlocal haX + hadjClose + exact ⟨X, hcomp, hXinf, haX, hzX⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean b/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean new file mode 100644 index 0000000000..14b2d36ee5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean @@ -0,0 +1,543 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4849T1Component +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import Mathlib.Combinatorics.SimpleGraph.Connectivity.Connected + +-- [TABLET NODE: P4849T1LargePositiveComponents] + +/-! +# P4849T1LargePositiveComponents + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PositiveComponentLemmas + +private theorem adjSymm : + ∀ {x : GaussianInt}, ∀ {y : GaussianInt}, (FourNeighborAdjacent x y) → FourNeighborAdjacent y + x := by + classical + intro x y h + rcases h with h | h | h | h <;> subst y <;> + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + +private theorem edgeSymm : + ∀ (q : IntegerLatticeFunction), + let S : Set GaussianInt := {x | 0 < q x} + let edge (x y : GaussianInt) : Prop := + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S + (∀ {x : GaussianInt}, ∀ {y : GaussianInt}, (FourNeighborAdjacent x y) → FourNeighborAdjacent + y x) → ∀ {x : GaussianInt}, ∀ {y : GaussianInt}, (edge x y) → edge y x := by + classical + intro q S edge adjSymm x y h + exact ⟨adjSymm h.1, h.2.2, h.2.1⟩ + +private theorem reachSymm : + ∀ (q : IntegerLatticeFunction), + let S : Set GaussianInt := {x | 0 < q x} + let edge (x y : GaussianInt) : Prop := + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S + let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y + (∀ {x : GaussianInt}, ∀ {y : GaussianInt}, (edge x y) → edge y x) → ∀ {x : GaussianInt}, ∀ {y + : GaussianInt}, (reach x y) → reach y x := by + classical + intro q S edge reach edgeSymm x y h + induction h with + | refl => exact .refl + | tail h hxy ih => exact (Relation.ReflTransGen.single (edgeSymm hxy)).trans ih + +private theorem gridReach : + ∀ (u : GaussianInt), ∀ (v : GaussianInt), Relation.ReflTransGen FourNeighborAdjacent u v := by + classical + intro u v + have horizontal (a : GaussianInt) (r : ℤ) : + Relation.ReflTransGen FourNeighborAdjacent a (a + ⟨r, 0⟩) := by + refine Int.inductionOn' r 0 ?_ ?_ ?_ + · have hz : (⟨0, 0⟩ : GaussianInt) = 0 := by ext <;> simp + rw [hz, add_zero] + · intro k hk ih + have heq : a + ⟨k + 1, 0⟩ = (a + ⟨k, 0⟩) + 1 := by + ext <;> simp [Zsqrtd.re_add, Zsqrtd.im_add]; ring + exact ih.tail (Or.inl heq) + · intro k hk ih + have heq : a + ⟨k - 1, 0⟩ = (a + ⟨k, 0⟩) - 1 := by + ext <;> simp [Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_sub, Zsqrtd.im_sub]; ring + exact ih.tail (Or.inr (Or.inl heq)) + have vertical (a : GaussianInt) (r : ℤ) : + Relation.ReflTransGen FourNeighborAdjacent a (a + ⟨0, r⟩) := by + refine Int.inductionOn' r 0 ?_ ?_ ?_ + · have hz : (⟨0, 0⟩ : GaussianInt) = 0 := by ext <;> simp + rw [hz, add_zero] + · intro k hk ih + have heq : a + ⟨0, k + 1⟩ = (a + ⟨0, k⟩) + ⟨0, 1⟩ := by + ext <;> simp [Zsqrtd.re_add, Zsqrtd.im_add]; ring + exact ih.tail (Or.inr (Or.inr (Or.inl heq))) + · intro k hk ih + have heq : a + ⟨0, k - 1⟩ = (a + ⟨0, k⟩) - ⟨0, 1⟩ := by + ext <;> simp [Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_sub, Zsqrtd.im_sub]; ring + exact ih.tail (Or.inr (Or.inr (Or.inr heq))) + let r := v.re - u.re + let s := v.im - u.im + have hp := horizontal u r + have hq := vertical (u + ⟨r, 0⟩) s + have heq : u + ⟨r, 0⟩ + ⟨0, s⟩ = v := by + ext <;> simp [r, s, Zsqrtd.re_add, Zsqrtd.im_add] + rw [← heq] + exact hp.trans hq + +private theorem chainReach : + ∀ (q : IntegerLatticeFunction), + let S : Set GaussianInt := {x | 0 < q x} + let edge (x y : GaussianInt) : Prop := + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S + ∀ (p : List GaussianInt), (p.IsChain edge) → ∀ (hne : p ≠ []), ∀ y, y ∈ p → + Relation.ReflTransGen edge (p.head hne) y := by + classical + intro q S edge p hp hne + induction p with + | nil => simp at hne + | cons a p ih => + intro y hy + simp only [List.mem_cons] at hy + rcases hy with rfl | hy + · exact .refl + · cases p with + | nil => simp at hy + | cons b p => + have h₁ : edge a b := hp.rel + have h₂ : List.IsChain edge (b :: p) := hp.tail + have hn : b :: p ≠ [] := by simp + have hr := ih h₂ hn y (by simpa using hy) + simpa using (Relation.ReflTransGen.single h₁).trans hr + +private theorem walkReach : + ∀ (q : IntegerLatticeFunction), + let S : Set GaussianInt := {x | 0 < q x} + let edge (x y : GaussianInt) : Prop := + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S + let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y + ∀ (p : List GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), p.head? = some a → + p.getLast? = some b → + (∀ x ∈ p, x ∈ S) → p.IsChain FourNeighborAdjacent → reach a b := by + classical + intro q S edge reach p a b hp hlast hmem hchain + have hne : p ≠ [] := by intro he; subst p; simp at hp + have hc : p.IsChain edge := hchain.imp_of_mem_imp + (fun x y hx hy hadj => ⟨hadj, hmem x hx, hmem y hy⟩) + have hr := List.relationReflTransGen_of_exists_isChain p hc hne + have ha : p.head hne = a := by simpa [List.head?_eq_some_head hne] using hp + have hb : p.getLast hne = b := by + simpa [List.getLast?_eq_some_getLast hne] using hlast + simpa [ha, hb] using hr + +private theorem reachPos : + ∀ (q : IntegerLatticeFunction), + let S : Set GaussianInt := {x | 0 < q x} + let edge (x y : GaussianInt) : Prop := + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S + let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y + ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, (a ∈ S) → (reach a b) → b ∈ S := by + classical + intro q S edge reach a b ha h + induction h with + | refl => exact ha + | tail h hstep ih => exact hstep.2.2 + +private theorem reachWalk : + ∀ (q : IntegerLatticeFunction), + let S : Set GaussianInt := {x | 0 < q x} + let edge (x y : GaussianInt) : Prop := + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S + let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y + (∀ (p : List GaussianInt), (p.IsChain edge) → ∀ (hne : p ≠ []), ∀ y, y ∈ p → + Relation.ReflTransGen edge (p.head hne) y) → (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, + (a ∈ S) → (reach a b) → b ∈ S) → ∀ (x : GaussianInt), ∀ (y : GaussianInt), x ∈ S → reach + x y → + ∃ p : List GaussianInt, p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ S) ∧ p.IsChain FourNeighborAdjacent := by + classical + intro q S edge reach chainReach reachPos x y hx h + change Relation.ReflTransGen edge x y at h + obtain ⟨l, hc, hl⟩ := List.exists_isChain_cons_of_relationReflTransGen h + refine ⟨x :: l, rfl, ?_, ?_, hc.imp (fun _ _ he => he.1)⟩ + · simpa [List.getLast?_eq_some_getLast (List.cons_ne_nil x l)] using + congrArg some hl + · intro z hz + have hne : x :: l ≠ [] := by simp + have hrz := chainReach (x :: l) hc hne z hz + exact reachPos hx hrz + +private theorem Bsucc : + ∀ (M : ℤ), + let B : ℕ → ℤ := fun n => Nat.rec 0 (fun _ b => 4 * b + M) n + ∀ (n : ℕ), B (n + 1) = 4 * B n + M := by + classical + intro M B n + simp [B] + +private theorem Bnonneg : + ∀ (M : ℤ), (0 ≤ M) → + let B : ℕ → ℤ := fun n => Nat.rec 0 (fun _ b => 4 * b + M) n + (∀ (n : ℕ), B (n + 1) = 4 * B n + M) → ∀ (n : ℕ), 0 ≤ B n := by + classical + intro M hM B Bsucc n + induction n with + | zero => simp [B] + | succ n ih => rw [Bsucc]; nlinarith [hM] + +private theorem Bmono : + ∀ (M : ℤ), (0 ≤ M) → + let B : ℕ → ℤ := fun n => Nat.rec 0 (fun _ b => 4 * b + M) n + (∀ (n : ℕ), B (n + 1) = 4 * B n + M) → (∀ (n : ℕ), 0 ≤ B n) → ∀ (n : ℕ), ∀ (m : ℕ), (n ≤ m) → + B n ≤ B m := by + classical + intro M hM B Bsucc Bnonneg n m hnm + induction m, hnm using Nat.le_induction with + | base => rfl + | succ k hk ih => + rw [Bsucc] + nlinarith [Bnonneg k, hM] + +private theorem hxpos : + ∀ (q : IntegerLatticeFunction), ∀ (M : ℤ), (∃ z, q z = 0) → ∀ (N : ℕ), + let S : Set GaussianInt := {x | 0 < q x} + let B : ℕ → ℤ := fun n => Nat.rec 0 (fun _ b => 4 * b + M) n + (∀ (n : ℕ), 0 ≤ B n) → ∀ (x : GaussianInt), (B (N + 1) < q x) → x ∈ S := by + classical + intro q M hzero N S B Bnonneg x hx + change 0 < q x + have hB := Bnonneg (N + 1) + omega + +private theorem hxC : + ∀ (q : IntegerLatticeFunction), + let S : Set GaussianInt := {x | 0 < q x} + let edge (x y : GaussianInt) : Prop := + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S + let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y + ∀ (x : GaussianInt), + let C : Set GaussianInt := {y | reach x y} + x ∈ C := by + classical + intro q S edge reach x C + change reach x x + exact Relation.ReflTransGen.refl + +private theorem hCpos : + ∀ (q : IntegerLatticeFunction), + let S : Set GaussianInt := {x | 0 < q x} + let edge (x y : GaussianInt) : Prop := + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S + let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y + ∀ (x : GaussianInt), (x ∈ S) → + let C : Set GaussianInt := {y | reach x y} + C ⊆ S := by + classical + intro q S edge reach x hxpos C y hy + have hy' : reach x y := hy + change Relation.ReflTransGen edge x y at hy' + induction hy' with + | refl => exact hxpos + | tail hxy hstep ih => exact hstep.2.2 + +private theorem hCconn : + ∀ (q : IntegerLatticeFunction), + let S : Set GaussianInt := {x | 0 < q x} + let edge (x y : GaussianInt) : Prop := + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S + let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y + (∀ {x : GaussianInt}, ∀ {y : GaussianInt}, (reach x y) → reach y x) → (∀ (p : List + GaussianInt), (p.IsChain edge) → ∀ (hne : p ≠ []), ∀ y, y ∈ p → Relation.ReflTransGen + edge (p.head hne) y) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), x ∈ S → reach x y → ∃ p + : List GaussianInt, p.head? = some x ∧ p.getLast? = some y ∧ (∀ z ∈ p, z ∈ S) ∧ p.IsChain + FourNeighborAdjacent) → ∀ (x : GaussianInt), + let C : Set GaussianInt := {y | reach x y} + (x ∈ C) → (C ⊆ S) → FourNeighborConnected C := by + classical + intro q S edge reach reachSymm chainReach reachWalk x C hxC hCpos + refine ⟨⟨x, hxC⟩, ?_⟩ + intro y hy z hz + have hy' : reach x y := hy + have hz' : reach x z := hz + have hyz : reach y z := (reachSymm hy').trans hz' + obtain ⟨p, hp, hlast, hmem, hchain⟩ := reachWalk y z (hCpos hy) hyz + refine ⟨p, hp, hlast, ?_, (List.isChain_iff_forall_rel_of_append_cons_cons).mp hchain⟩ + intro w hw + have hne : p ≠ [] := by intro he; subst p; simp at hp + have hedges : p.IsChain edge := hchain.imp_of_mem_imp + (fun a b ha hb hab => ⟨hab, hmem a ha, hmem b hb⟩) + have hwy := chainReach p hedges hne w hw + -- Every path vertex is reachable from y, hence from the root x. + have hyhead : p.head hne = y := by + simpa [List.head?_eq_some_head hne] using hp + have hrootw : reach x w := by + have hwy' : reach y w := by simpa only [hyhead] using hwy + exact hy'.trans hwy' + exact hrootw + +private theorem hCcomponent : + ∀ (q : IntegerLatticeFunction), + let S : Set GaussianInt := {x | 0 < q x} + let edge (x y : GaussianInt) : Prop := + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S + let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y + ∀ (x : GaussianInt), + let C : Set GaussianInt := {y | reach x y} + (C ⊆ S) → (FourNeighborConnected C) → P4849T1Component S C := by + classical + intro q S edge reach x C hCpos hCconn + refine ⟨hCconn, hCpos, ?_⟩ + intro y hy z hz hadj + have he : edge y z := ⟨hadj, hCpos hy, hz⟩ + change reach x y at hy + change reach x z + exact Relation.ReflTransGen.tail hy he + +private theorem hz₀not : + ∀ (q : IntegerLatticeFunction), (ℤ) → (ℕ) → + let S : Set GaussianInt := {x | 0 < q x} + let edge (x y : GaussianInt) : Prop := + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S + let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y + ∀ (x : GaussianInt), ∀ (z₀ : GaussianInt), (q z₀ = 0) → + let C : Set GaussianInt := {y | reach x y} + (C ⊆ S) → z₀ ∉ C := by + classical + intro q M N S edge reach x z₀ hz₀ C hCpos hz + have hpos := hCpos hz + change 0 < q z₀ at hpos + omega + +private theorem firstExit : + ∀ (q : IntegerLatticeFunction), + let S : Set GaussianInt := {x | 0 < q x} + let edge (x y : GaussianInt) : Prop := + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S + let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y + ∀ (x : GaussianInt), + let C : Set GaussianInt := {y | reach x y} + ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, (Relation.ReflTransGen FourNeighborAdjacent a b) → + (a ∈ C) → (b ∉ C) → ∃ y z, y ∈ C ∧ z ∉ C ∧ FourNeighborAdjacent y z := by + classical + intro q S edge reach x C a b h ha hb + induction h with + | refl => exact (hb ha).elim + | @tail b c h hbc ih => + by_cases hbC : b ∈ C + · exact ⟨b, c, hbC, hb, hbc⟩ + · exact ih hbC + +private theorem hzEq : + ∀ (q : IntegerLatticeFunction), (ℤ) → (∀ x, 0 ≤ q x) → (ℕ) → + let S : Set GaussianInt := {x | 0 < q x} + let edge (x y : GaussianInt) : Prop := + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S + let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y + ∀ (x : GaussianInt), (GaussianInt) → + let C : Set GaussianInt := {y | reach x y} + (P4849T1Component S C) → ∀ (a : GaussianInt), ∀ (z : GaussianInt), (a ∈ C) → (z ∉ C) → + (FourNeighborAdjacent a z) → q z = 0 := by + classical + intro q M hq N S edge reach x z₀ C hCcomponent a z haC hzC haz + by_contra hn + have hqn := hq z + have hpos : 0 < q z := by omega + have hzS : z ∈ S := hpos + have hzIn : z ∈ C := hCcomponent.2.2 a haC z hzS haz + exact hzC hzIn + +private theorem hNoBig : + ∀ (q : IntegerLatticeFunction), (ℤ) → ∀ (N : ℕ), (¬∃ (C : Set GaussianInt), + P4849T1Component {x : GaussianInt | 0 < q x} C ∧ ∃ (z : GaussianInt) (a : GaussianInt), + q z = 0 ∧ a ∈ C ∧ FourNeighborAdjacent z a ∧ ∃ (F : Finset GaussianInt), (↑F : Set + GaussianInt) ⊆ C ∧ N < F.card) → + let S : Set GaussianInt := {x | 0 < q x} + let edge (x y : GaussianInt) : Prop := + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S + let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y + (∀ {x : GaussianInt}, ∀ {y : GaussianInt}, (FourNeighborAdjacent x y) → FourNeighborAdjacent + y x) → ∀ (x : GaussianInt), (GaussianInt) → + let C : Set GaussianInt := {y | reach x y} + (P4849T1Component S C) → ∀ (a : GaussianInt), ∀ (z : GaussianInt), (a ∈ C) → + (FourNeighborAdjacent a z) → (q z = 0) → ∀ (F : Finset GaussianInt), ((↑F : Set + GaussianInt) ⊆ C) → F.card ≤ N := by + classical + intro q M N hbad S edge reach adjSymm x z₀ C hCcomponent a z haC haz hzEq F hF + by_contra hcard + have hgt : N < F.card := by omega + apply hbad + refine ⟨C, ?_, z, a, hzEq, haC, adjSymm haz, F, hF, hgt⟩ + simpa [S] using hCcomponent + +end PositiveComponentLemmas + +theorem P4849T1LargePositiveComponents (q : IntegerLatticeFunction) (M : ℤ) + (hq : ∀ x, 0 ≤ q x) (hM : 0 ≤ M) + (hlap : ∀ x, FourNeighborLaplacian q x ≤ M) + (hzero : ∃ z, q z = 0) (hunbounded : ∀ B : ℤ, ∃ x, B < q x) : + ∀ N : ℕ, ∃ C : Set GaussianInt, + P4849T1Component {x | 0 < q x} C ∧ + ∃ z a : GaussianInt, q z = 0 ∧ a ∈ C ∧ FourNeighborAdjacent z a ∧ + ∃ F : Finset GaussianInt, (↑F : Set GaussianInt) ⊆ C ∧ N < F.card := by +-- BODY + classical + intro N + by_contra hbad + let S : Set GaussianInt := {x | 0 < q x} + let edge (x y : GaussianInt) : Prop := + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S + let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y + have adjSymm {x y : GaussianInt} (h : FourNeighborAdjacent x y) : + FourNeighborAdjacent y x := PositiveComponentLemmas.adjSymm (x := x) (y := y) h + have edgeSymm {x y : GaussianInt} (h : edge x y) : edge y x := PositiveComponentLemmas.edgeSymm + q adjSymm (x := x) (y := y) h + have reachSymm {x y : GaussianInt} (h : reach x y) : reach y x := + PositiveComponentLemmas.reachSymm q edgeSymm (x := x) (y := y) h + have gridReach (u v : GaussianInt) : + Relation.ReflTransGen FourNeighborAdjacent u v := PositiveComponentLemmas.gridReach u v + have chainReach (p : List GaussianInt) (hp : p.IsChain edge) (hne : p ≠ []) : + ∀ y, y ∈ p → Relation.ReflTransGen edge (p.head hne) y := + PositiveComponentLemmas.chainReach q p hp hne + have walkReach : ∀ (p : List GaussianInt) (a b : GaussianInt), + p.head? = some a → p.getLast? = some b → + (∀ x ∈ p, x ∈ S) → p.IsChain FourNeighborAdjacent → reach a b := + PositiveComponentLemmas.walkReach q + have reachPos {a b : GaussianInt} (ha : a ∈ S) (h : reach a b) : b ∈ S := + PositiveComponentLemmas.reachPos q (a := a) (b := b) ha h + have reachWalk : ∀ (x y : GaussianInt), x ∈ S → reach x y → + ∃ p : List GaussianInt, p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ S) ∧ p.IsChain FourNeighborAdjacent := PositiveComponentLemmas.reachWalk q + chainReach reachPos + let B : ℕ → ℤ := fun n => Nat.rec 0 (fun _ b => 4 * b + M) n + have Bsucc (n : ℕ) : B (n + 1) = 4 * B n + M := PositiveComponentLemmas.Bsucc M n + have Bnonneg (n : ℕ) : 0 ≤ B n := PositiveComponentLemmas.Bnonneg M hM Bsucc n + have Bmono (n m : ℕ) (hnm : n ≤ m) : B n ≤ B m := PositiveComponentLemmas.Bmono M hM Bsucc + Bnonneg n m hnm + obtain ⟨x, hx⟩ := hunbounded (B (N + 1)) + have hxpos : x ∈ S := PositiveComponentLemmas.hxpos q M hzero N Bnonneg x hx + obtain ⟨z₀, hz₀⟩ := hzero + let C : Set GaussianInt := {y | reach x y} + have hxC : x ∈ C := PositiveComponentLemmas.hxC q x + have hCpos : C ⊆ S := PositiveComponentLemmas.hCpos q x hxpos + have hCconn : FourNeighborConnected C := PositiveComponentLemmas.hCconn q reachSymm chainReach + reachWalk x hxC hCpos + have hCcomponent : P4849T1Component S C := PositiveComponentLemmas.hCcomponent q x hCpos hCconn + have hz₀not : z₀ ∉ C := PositiveComponentLemmas.hz₀not q M N x z₀ hz₀ hCpos + have firstExit {a b : GaussianInt} + (h : Relation.ReflTransGen FourNeighborAdjacent a b) + (ha : a ∈ C) (hb : b ∉ C) : + ∃ y z, y ∈ C ∧ z ∉ C ∧ FourNeighborAdjacent y z := PositiveComponentLemmas.firstExit q x (a + := a) (b := b) h ha hb + obtain ⟨a, z, haC, hzC, haz⟩ := firstExit (gridReach x z₀) hxC hz₀not + have hzEq : q z = 0 := PositiveComponentLemmas.hzEq q M hq N x z₀ hCcomponent a z haC hzC haz + have hNoBig (F : Finset GaussianInt) + (hF : (↑F : Set GaussianInt) ⊆ C) : F.card ≤ N := PositiveComponentLemmas.hNoBig q M N hbad + adjSymm x z₀ hCcomponent a z haC haz hzEq F hF + by_cases hN : N = 0 + · have hsingle : (↑({x} : Finset GaussianInt) : Set GaussianInt) ⊆ C := by + intro y hy + change y ∈ ({x} : Finset GaussianInt) at hy + simp only [Finset.mem_singleton] at hy + simpa [hy] using hxC + have := hNoBig {x} hsingle + simp at this + omega + · let V := {y : GaussianInt // y ∈ C} + let G : SimpleGraph V := SimpleGraph.fromRel (fun y w => + FourNeighborAdjacent y.1 w.1) + have rootReach : ∀ {y : GaussianInt} (hy : reach x y), + G.Reachable ⟨x, hxC⟩ ⟨y, hy⟩ := by + intro y hy + rw [SimpleGraph.reachable_iff_reflTransGen] + change Relation.ReflTransGen edge x y at hy + induction hy with + | refl => exact Relation.ReflTransGen.refl + | @tail b c h hstep ih => + have hc : c ∈ C := by + change reach x c + exact Relation.ReflTransGen.tail h hstep + have hne : b ≠ c := by + intro heq + subst c + rcases hstep.1 with hh | hh | hh | hh <;> + simp [Zsqrtd.ext_iff] at hh <;> omega + have hadj : G.Adj ⟨b, h⟩ ⟨c, hc⟩ := by + apply (SimpleGraph.fromRel_adj _ _ _).2 + exact ⟨fun heq => hne (congrArg Subtype.val heq), Or.inl hstep.1⟩ + exact Relation.ReflTransGen.tail ih hadj + let vx : V := ⟨x, hxC⟩ + let va : V := ⟨a, haC⟩ + have hrootA : G.Reachable vx va := rootReach haC + have hrootX : G.Reachable vx vx := SimpleGraph.Reachable.refl vx + have hpathReach : G.Reachable va vx := hrootA.symm.trans hrootX + obtain ⟨p, hp⟩ := SimpleGraph.Reachable.exists_isPath hpathReach + let F : Finset GaussianInt := p.support.toFinset.image Subtype.val + have hFsub : (↑F : Set GaussianInt) ⊆ C := by + intro y hy + rcases Finset.mem_image.mp hy with ⟨w, hw, rfl⟩ + exact w.2 + have hFsize : F.card = p.support.length := by + rw [Finset.card_image_iff.mpr (by + intro u hu v hv heq + exact Subtype.ext heq)] + exact List.toFinset_card_of_nodup hp.support_nodup + have hlen : p.length + 1 ≤ N := by + have h := hNoBig F hFsub + rw [hFsize, SimpleGraph.Walk.length_support] at h + omega + have graphAdjToGrid {u v : V} (h : G.Adj u v) : + FourNeighborAdjacent u.1 v.1 := by + have h' := (SimpleGraph.fromRel_adj _ _ _).1 h + rcases h'.2 with huv | hvu + · exact huv + · exact adjSymm hvu + have neighborBound {u v : GaussianInt} + (huv : FourNeighborAdjacent u v) : q v ≤ 4 * q u + M := by + have hl := hlap u + simp only [FourNeighborLaplacian] at hl + rcases huv with huv | huv | huv | huv + · subst v + nlinarith [hq (u - 1), hq (u + ⟨0, 1⟩), hq (u - ⟨0, 1⟩)] + · subst v + nlinarith [hq (u + 1), hq (u + ⟨0, 1⟩), hq (u - ⟨0, 1⟩)] + · subst v + nlinarith [hq (u + 1), hq (u - 1), hq (u - ⟨0, 1⟩)] + · subst v + nlinarith [hq (u + 1), hq (u - 1), hq (u + ⟨0, 1⟩)] + have walkBound {u v : V} (t : ℕ) (p : G.Walk u v) + (hu : q u.1 ≤ B t) : q v.1 ≤ B (t + p.length) := by + induction p generalizing t with + | nil => simpa using hu + | @cons u v w huv p ih => + have hqv := neighborBound (graphAdjToGrid huv) + have hv : q v.1 ≤ B (t + 1) := by + rw [Bsucc] + nlinarith + have hw := ih (t + 1) hv + have hidx : (t + 1) + p.length = t + (p.length + 1) := by omega + simpa [hidx] using hw + have hqa : q a ≤ B 1 := by + have h := neighborBound (adjSymm haz) + simpa [B, hzEq] using h + have hqx := walkBound 1 p hqa + have hidx : 1 + p.length ≤ N := by omega + have hbound : q x ≤ B N := le_trans hqx (Bmono _ _ hidx) + have hmono := Bmono N (N + 1) (by omega) + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1LocalLimitAdmissibility.lean b/LeanPool/ApollonianSuperharmonic/P4849T1LocalLimitAdmissibility.lean new file mode 100644 index 0000000000..2f5c9230d9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4849T1LocalLimitAdmissibility.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian + +-- [TABLET NODE: P4849T1LocalLimitAdmissibility] + +/-! +# P4849T1LocalLimitAdmissibility + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4849T1LocalLimitAdmissibility (g : IntegerLatticeFunction) + (C : ℕ → Set GaussianInt) (L : Set GaussianInt) + (hC : ∀ n x, FourNeighborLaplacian + (fun y => g y + Set.indicator (C n) (fun _ => (1 : ℤ)) y) x ≤ 1) + (hlocal : ∀ F : Finset GaussianInt, ∃ N : ℕ, ∀ n ≥ N, ∀ x ∈ F, + (x ∈ C n ↔ x ∈ L)) : + ∀ x, FourNeighborLaplacian + (fun y => g y + Set.indicator L (fun _ => (1 : ℤ)) y) x ≤ 1 := by +-- BODY + classical + intro x + obtain ⟨N, hN⟩ := hlocal {x, x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} + have heq (y : GaussianInt) + (hy : y ∈ ({x, x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt)) : + Set.indicator (C N) (fun _ => (1 : ℤ)) y = + Set.indicator L (fun _ => (1 : ℤ)) y := by + have h := hN N le_rfl y hy + by_cases hc : y ∈ C N + · simp [hc, h.mp hc] + · have hl : y ∉ L := fun hl => hc (h.mpr hl) + simp [hc, hl] + have h := hC N x + simp only [FourNeighborLaplacian] at h ⊢ + simpa only [heq x (by simp), heq (x + 1) (by simp), + heq (x - 1) (by simp), heq (x + ⟨0, 1⟩) (by simp), + heq (x - ⟨0, 1⟩) (by simp)] using h + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1MinimumTruncation.lean b/LeanPool/ApollonianSuperharmonic/P4849T1MinimumTruncation.lean new file mode 100644 index 0000000000..6a997bba10 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4849T1MinimumTruncation.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian + +-- [TABLET NODE: P4849T1MinimumTruncation] + +/-! +# P4849T1MinimumTruncation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4849T1MinimumTruncation (g q : IntegerLatticeFunction) + (hg : ∀ x, FourNeighborLaplacian g x ≤ 1) + (hq : ∀ x, 0 ≤ q x) + (hplus : ∀ x, FourNeighborLaplacian (fun y => g y + q y) x ≤ 1) : + ∀ x, FourNeighborLaplacian + (fun y => g y + Set.indicator {z | 0 < q z} (fun _ => (1 : ℤ)) y) x ≤ 1 := by +-- BODY + classical + let I : GaussianInt → ℤ := Set.indicator {z | 0 < q z} (fun _ => (1 : ℤ)) + have hI (y : GaussianInt) : I y ≤ 1 ∧ I y ≤ q y := by + by_cases hy : 0 < q y + · simp [I, hy] + omega + · simp [I, hy, hq y] + intro x + change FourNeighborLaplacian (fun y => g y + I y) x ≤ 1 + by_cases hx : 0 < q x + · have hIx : I x = 1 := by simp [I, hx] + have h := hg x + simp only [FourNeighborLaplacian] at h ⊢ + rw [hIx] + linarith [(hI (x + 1)).1, (hI (x - 1)).1, + (hI (x + ⟨0, 1⟩)).1, (hI (x - ⟨0, 1⟩)).1] + · have hqx : q x = 0 := by have := hq x; omega + have hIx : I x = 0 := by simp [I, hx] + have h := hplus x + simp only [FourNeighborLaplacian] at h ⊢ + rw [hIx] + rw [hqx] at h + linarith [(hI (x + 1)).2, (hI (x - 1)).2, + (hI (x + ⟨0, 1⟩)).2, (hI (x - ⟨0, 1⟩)).2] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1PeriodAnchoring.lean b/LeanPool/ApollonianSuperharmonic/P4849T1PeriodAnchoring.lean new file mode 100644 index 0000000000..34e7f6fa7f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4849T1PeriodAnchoring.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import Mathlib.Data.Fintype.Pigeonhole +public import Mathlib.Order.Interval.Finset.Nat + +-- [TABLET NODE: P4849T1PeriodAnchoring] + +/-! +# P4849T1PeriodAnchoring + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4849T1PeriodAnchoring (g : IntegerLatticeFunction) + (u v : GaussianInt) (R : Finset GaussianInt) + (hres : ∀ z, ∃ r ∈ R, ∃ a b : ℤ, z = r + a • u + b • v) + (hper : ∀ a b : ℤ, ∀ x, + FourNeighborLaplacian g (x + a • u + b • v) = FourNeighborLaplacian g x) + (hfamily : ∀ N : ℕ, ∃ C : Set GaussianInt, + FourNeighborConnected C ∧ + (∀ x, FourNeighborLaplacian + (fun y => g y + Set.indicator C (fun _ => (1 : ℤ)) y) x ≤ 1) ∧ + ∃ z a : GaussianInt, z ∉ C ∧ a ∈ C ∧ FourNeighborAdjacent z a ∧ + ∃ F : Finset GaussianInt, (↑F : Set GaussianInt) ⊆ C ∧ N < F.card) : + ∃ z a : GaussianInt, ∃ C : ℕ → Set GaussianInt, + FourNeighborAdjacent z a ∧ + ∀ n, z ∉ C n ∧ a ∈ C n ∧ FourNeighborConnected (C n) ∧ + (∀ x, FourNeighborLaplacian + (fun y => g y + Set.indicator (C n) (fun _ => (1 : ℤ)) y) x ≤ 1) ∧ + ∃ F : Finset GaussianInt, (↑F : Set GaussianInt) ⊆ C n ∧ n < F.card := by +-- BODY + classical + have translate_adj (t x y : GaussianInt) : + FourNeighborAdjacent (x + t) (y + t) ↔ FourNeighborAdjacent x y := by + have h₁ : x + t + 1 = x + 1 + t := by abel + have h₂ : x + t - 1 = x - 1 + t := by abel + have h₃ : x + t + ⟨0, 1⟩ = x + ⟨0, 1⟩ + t := by abel + have h₄ : x + t - ⟨0, 1⟩ = x - ⟨0, 1⟩ + t := by abel + simp only [FourNeighborAdjacent, h₁, h₂, h₃, h₄, add_left_inj] + have translate_conn (A : Set GaussianInt) (t : GaussianInt) + (hA : FourNeighborConnected A) : FourNeighborConnected {x | x + t ∈ A} := by + obtain ⟨a, ha⟩ := hA.1 + refine ⟨⟨a - t, by simpa using ha⟩, ?_⟩ + intro x hx y hy + obtain ⟨p, hphead, hplast, hpmem, hpedge⟩ := hA.2 (x + t) hx (y + t) hy + refine ⟨p.map (fun w => w - t), ?_, ?_, ?_, ?_⟩ + · simp [List.head?_map, hphead] + · simp [List.getLast?_map, hplast] + · intro w hw + obtain ⟨b, hb, rfl⟩ := List.mem_map.mp hw + simpa using hpmem b hb + · intro a b l₁ l₂ hp + have heq := congrArg (List.map (fun w : GaussianInt => w + t)) hp + simp only [List.map_map, List.map_append, List.map_cons, Function.comp_def] at heq + have hid : (fun w : GaussianInt => (w - t) + t) = id := by + funext w + exact sub_add_cancel w t + rw [hid, List.map_id] at heq + exact (translate_adj t a b).mp (hpedge _ _ _ _ heq) + choose A hAconn hAlap z a hz ha hza F hF hcard using hfamily + choose r hr α β hzrep using fun n => hres (z n) + let t (n : ℕ) : GaussianInt := α n • u + β n • v + let B (n : ℕ) : Set GaussianInt := {x | x + t n ∈ A n} + let b (n : ℕ) : GaussianInt := a n - t n + have hzrt (n : ℕ) : z n = r n + t n := by + simpa only [t, add_assoc] using hzrep n + have hb (n : ℕ) : b n ∈ B n := by + simpa [B, b] using ha n + have hmiss (n : ℕ) : r n ∉ B n := by + simpa [B, ← hzrt n] using hz n + have hadj (n : ℕ) : FourNeighborAdjacent (r n) (b n) := by + apply (translate_adj (t n) _ _).mp + simpa [b, ← hzrt n] using hza n + have hconn (n : ℕ) : FourNeighborConnected (B n) := + translate_conn (A n) (t n) (hAconn n) + have hlap (n : ℕ) (x : GaussianInt) : FourNeighborLaplacian + (fun y => g y + Set.indicator (B n) (fun _ => (1 : ℤ)) y) x ≤ 1 := by + have h := hAlap n (x + t n) + have ht : FourNeighborLaplacian g (x + t n) = FourNeighborLaplacian g x := by + simpa only [t, add_assoc] using hper (α n) (β n) x + have hI (w : GaussianInt) : + Set.indicator (B n) (fun _ => (1 : ℤ)) w = + Set.indicator (A n) (fun _ => (1 : ℤ)) (w + t n) := by + by_cases hw : w + t n ∈ A n <;> simp [B, hw] + simp only [FourNeighborLaplacian, hI] at h ⊢ + simp only [FourNeighborLaplacian] at ht + have h₁ : x + t n + 1 = x + 1 + t n := by abel + have h₂ : x + t n - 1 = x - 1 + t n := by abel + have h₃ : x + t n + ⟨0, 1⟩ = x + ⟨0, 1⟩ + t n := by abel + have h₄ : x + t n - ⟨0, 1⟩ = x - ⟨0, 1⟩ + t n := by abel + rw [h₁, h₂, h₃, h₄] at h ht + linarith + have hsize (n : ℕ) : ∃ K : Finset GaussianInt, + (↑K : Set GaussianInt) ⊆ B n ∧ n < K.card := by + refine ⟨(F n).image (fun w => w - t n), ?_, ?_⟩ + · intro w hw + obtain ⟨c, hc, rfl⟩ := Finset.mem_image.mp hw + simpa [B] using hF n hc + · rw [Finset.card_image_of_injective _ (fun x y h => by + simpa using congrArg (fun w => w + t n) h)] + exact hcard n + let S : Finset (GaussianInt × GaussianInt) := R.biUnion + (fun r => {(r, r + 1), (r, r - 1), (r, r + ⟨0, 1⟩), (r, r - ⟨0, 1⟩)}) + have hS (n : ℕ) : (r n, b n) ∈ S := by + apply Finset.mem_biUnion.mpr + refine ⟨r n, hr n, ?_⟩ + have h := hadj n + rcases h with h | h | h | h <;> simp [h] + let label (n : ℕ) : {p // p ∈ S} := ⟨(r n, b n), hS n⟩ + obtain ⟨p, hp⟩ := Finite.exists_infinite_fiber label + have hinf : {n : ℕ | label n = p}.Infinite := Set.infinite_coe_iff.mp hp + choose k hk hkn using fun n => hinf.exists_gt n + have hlabel (n : ℕ) : (r (k n), b (k n)) = p.val := + congrArg Subtype.val (hk n) + refine ⟨p.val.1, p.val.2, fun n => B (k n), ?_, ?_⟩ + · rw [← hlabel 0] + exact hadj (k 0) + · intro n + have hrn : r (k n) = p.val.1 := congrArg Prod.fst (hlabel n) + have hbn : b (k n) = p.val.2 := congrArg Prod.snd (hlabel n) + refine ⟨hrn ▸ hmiss (k n), hbn ▸ hb (k n), hconn (k n), hlap (k n), ?_⟩ + obtain ⟨K, hK, hKcard⟩ := hsize (k n) + exact ⟨K, hK, lt_trans (hkn n) hKcard⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1PeriodResidues.lean b/LeanPool/ApollonianSuperharmonic/P4849T1PeriodResidues.lean new file mode 100644 index 0000000000..477b4fdee2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4849T1PeriodResidues.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction +public import Mathlib.Algebra.Ring.Periodic +public import Mathlib.Data.Int.Interval + +-- [TABLET NODE: P4849T1PeriodResidues] + +/-! +# P4849T1PeriodResidues + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4849T1PeriodResidues (p : IntegerLatticeFunction) + (u v : GaussianInt) (hdet : u.re * v.im - u.im * v.re ≠ 0) + (hu : ∀ x, p (x + u) = p x) (hv : ∀ x, p (x + v) = p x) : + ∃ R : Finset GaussianInt, + (∀ z, ∃ r ∈ R, ∃ a b : ℤ, z = r + a • u + b • v) ∧ + (∀ a b : ℤ, ∀ x, p (x + a • u + b • v) = p x) := by +-- BODY + classical + let D : ℤ := u.re * v.im - u.im * v.re + have hD : D ≠ 0 := hdet + let R : Finset GaussianInt := + ((Finset.Ico (0 : ℤ) |D|).product (Finset.Ico (0 : ℤ) |D|)).image + (fun z : ℤ × ℤ => (⟨z.1, z.2⟩ : GaussianInt)) + refine ⟨R, ?_, ?_⟩ + · intro z + let r : GaussianInt := ⟨z.re % D, z.im % D⟩ + have hr : r ∈ R := by + dsimp only [R] + apply Finset.mem_image.mpr + refine ⟨(z.re % D, z.im % D), ?_, rfl⟩ + exact Finset.mem_product.mpr + ⟨Finset.mem_Ico.mpr ⟨Int.emod_nonneg _ hD, Int.emod_lt_abs _ hD⟩, + Finset.mem_Ico.mpr ⟨Int.emod_nonneg _ hD, Int.emod_lt_abs _ hD⟩⟩ + refine ⟨r, hr, (z.re / D) * v.im - (z.im / D) * v.re, + -(z.re / D) * u.im + (z.im / D) * u.re, ?_⟩ + have hre := Int.emod_add_mul_ediv z.re D + have him := Int.emod_add_mul_ediv z.im D + ext <;> simp [r, zsmul_eq_mul] <;> dsimp [D] at hre him ⊢ <;> nlinarith + · intro a b x + have hup : Function.Periodic p u := hu + have hvp : Function.Periodic p v := hv + rw [hvp.zsmul b, hup.zsmul a] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1SetDiagonalSubsequence.lean b/LeanPool/ApollonianSuperharmonic/P4849T1SetDiagonalSubsequence.lean new file mode 100644 index 0000000000..9f3bebe3f7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4849T1SetDiagonalSubsequence.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeCell +public import Mathlib.Topology.Sequences +public import Mathlib.Topology.Instances.Discrete + +-- [TABLET NODE: P4849T1SetDiagonalSubsequence] + +/-! +# P4849T1SetDiagonalSubsequence + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4849T1SetDiagonalSubsequence (C : ℕ → Set GaussianInt) : + ∃ σ : ℕ → ℕ, StrictMono σ ∧ ∃ L : Set GaussianInt, + ∀ F : Finset GaussianInt, ∃ N : ℕ, ∀ n ≥ N, ∀ x ∈ F, + (x ∈ C (σ n) ↔ x ∈ L) := by +-- BODY + classical + have : Countable GaussianInt := + Function.Injective.countable (f := fun z : GaussianInt => (z.re, z.im)) (by + intro a b h + exact Zsqrtd.ext (congrArg Prod.fst h) (congrArg Prod.snd h)) + let : TopologicalSpace Bool := ⊥ + have : DiscreteTopology Bool := ⟨rfl⟩ + let b : ℕ → GaussianInt → Bool := fun n x => decide (x ∈ C n) + obtain ⟨l, σ, hσ, hl⟩ := CompactSpace.tendsto_subseq b + refine ⟨σ, hσ, {x | l x = true}, ?_⟩ + intro F + have hpoint (x : GaussianInt) : ∀ᶠ n in Filter.atTop, b (σ n) x = l x := by + have hx := (tendsto_pi_nhds.mp hl) x + simpa only [nhds_discrete, Filter.tendsto_pure, Function.comp_apply] using hx + have hfinite : ∀ᶠ n in Filter.atTop, ∀ x ∈ F, b (σ n) x = l x := + F.eventually_all.mpr (fun x _ => hpoint x) + obtain ⟨N, hN⟩ := Filter.eventually_atTop.mp hfinite + refine ⟨N, ?_⟩ + intro n hn x hx + have heq := hN n hn x hx + change (x ∈ C (σ n) ↔ l x = true) + rw [← heq] + simp [b] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4903T1ScalarTangencies.lean b/LeanPool/ApollonianSuperharmonic/P4903T1ScalarTangencies.lean new file mode 100644 index 0000000000..c53866da87 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4903T1ScalarTangencies.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: P4903T1ScalarTangencies] + +/-! +# P4903T1ScalarTangencies + +Adapted from Wesley Pegden’s Apache - 2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4903T1ScalarTangencies (a b r D x : ℝ) + (ha : 0 < a) (hb : 0 < b) (hr : 0 < r) (hD : 0 < D) + (hra : r < a) (hrb : r < b) + (hDsq : D ^ 2 = 4 * a * b) (hxsq : x ^ 2 = 4 * r * a) + (hysq : (D - x) ^ 2 = 4 * r * b) : + 0 < x ∧ 0 < D - x ∧ r * (a + b + D) = a * b ∧ + 2 * x * D = D ^ 2 + 4 * r * (a - b) := by +-- BODY + have hxD : 2 * x * D = D ^ 2 + 4 * r * (a - b) := by nlinarith [hxsq, hysq] + have hDy : 2 * (D - x) * D = D ^ 2 + 4 * r * (b - a) := by nlinarith [hxsq, hysq] + have hxab : 0 < a * b + r * (a - b) := by + by_cases hab : a ≤ b + · have hba : 0 ≤ b - a := sub_nonneg.mpr hab + have hmul : r * (b - a) ≤ a * (b - a) := mul_le_mul_of_nonneg_right hra.le hba + nlinarith [hmul, sq_pos_of_pos ha] + · have hab' : 0 < a - b := by linarith + have hm : 0 < r * (a - b) := mul_pos hr hab' + nlinarith [hm] + have hyab : 0 < a * b + r * (b - a) := by + by_cases hba : b ≤ a + · have hab : 0 ≤ a - b := sub_nonneg.mpr hba + have hmul : r * (a - b) ≤ b * (a - b) := mul_le_mul_of_nonneg_right hrb.le hab + nlinarith [hmul, sq_pos_of_pos hb] + · have hba' : 0 < b - a := by linarith + have hm : 0 < r * (b - a) := mul_pos hr hba' + nlinarith [hm] + have hxpos : 0 < x := by nlinarith [hxD, hD, hxab] + have hypos : 0 < D - x := by nlinarith [hDy, hD, hyab] + have hprod : x * (D - x) = 2 * (a * b - r * (a + b)) := by nlinarith [hDsq, hxsq, hysq] + have hprodpos : 0 < a * b - r * (a + b) := by + have htwice : 0 < 2 * (a * b - r * (a + b)) := by + rw [← hprod] + exact mul_pos hxpos hypos + nlinarith only [htwice] + have htwo : (2 * (a * b - r * (a + b))) ^ 2=(2 * (r * D)) ^ 2 := by + have htemp := congrArg (fun z : ℝ => z ^ 2) hprod + have hprodSq : (x * (D - x)) ^ 2 = (2 * (r * D)) ^ 2 := by + calc + (x * (D - x)) ^ 2 = x ^ 2 * (D - x) ^ 2 := by ring + _ = (4 * r * a) * (4 * r * b) := by rw [hxsq, hysq] + _ = 4 * r ^ 2 * (4 * a * b) := by ring + _ = 4 * r ^ 2 * D ^ 2 := by rw [hDsq] + _ = (2 * (r * D)) ^ 2 := by ring + exact htemp.symm.trans hprodSq + have hleftpos : 0 < 2 * (a * b - r * (a + b)) := + mul_pos zero_lt_two hprodpos + have hrightpos : 0 < 2 * (r * D) := + mul_pos zero_lt_two (mul_pos hr hD) + have heq2 : 2 * (a * b - r * (a + b))=2 * (r * D) := + (sq_eq_sq₀ hleftpos.le hrightpos.le).mp htwo + have heq : a * b - r * (a + b) = r * D := + mul_left_cancel₀ (by norm_num : (2 : ℝ) ≠ 0) heq2 + have hrel : r * (a + b + D)=a * b := by + calc + r * (a + b + D)=r * (a + b) + r * D := by ring + _=r * (a + b) + (a * b - r * (a + b)) := by rw [← heq] + _=r * (a + b) + a * b - r * (a + b) := (add_sub_assoc _ _ _).symm + _=a * b + r * (a + b) - r * (a + b) := by rw [add_comm (r * (a + b)) (a * b)] + _=a * b := add_sub_cancel_right _ _ + exact ⟨hxpos, hypos, hrel, hxD⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4903T1SignedDiskHull.lean b/LeanPool/ApollonianSuperharmonic/P4903T1SignedDiskHull.lean new file mode 100644 index 0000000000..311d445585 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4903T1SignedDiskHull.lean @@ -0,0 +1,186 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Complex.Norm +public import Mathlib.Analysis.Convex.Hull +public import Mathlib.LinearAlgebra.Complex.Module + +-- [TABLET NODE: P4903T1SignedDiskHull] + +/-! +# P4903T1SignedDiskHull + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4903T1SignedDiskHull (a b r D x tL B n : ℝ) + (ha : 0 < a) (hb : 0 < b) (hr : 0 < r) (hD : 0 < D) + (hn : n * n = 1) (hDsq : D ^ 2 = 4 * a * b) + (hx : r < x) (hy : r < D - x) + (hmargin : D * a + (b - a) * x - D * r = r * (a + b) + a * b) : + Metric.ball (⟨B-n*r,tL+x⟩ : ℂ) r ⊆ + convexHull ℝ (Set.range + (![⟨B,tL⟩,⟨B-n*a,tL⟩,⟨B-n*b,tL+D⟩,⟨B,tL+D⟩] : Fin 4 → ℂ)) := by +-- BODY + have cauchyBound : ∀ (a b r D n dx dy : ℝ), 0 < a → 0 < b → 0 < r → + n*n=1 → D^2=4*a*b → dx^2+dy^2 nlinarith [hbound,mul_pos hr hab] + intro z hz + let c : ℂ := ⟨B-n*r,tL+x⟩ + let v : Fin 4 → ℂ := + ![⟨B,tL⟩,⟨B-n*a,tL⟩,⟨B-n*b,tL+D⟩,⟨B,tL+D⟩] + let w : ℂ := z-c + have hznorm : ‖w‖ < r := by simpa [w,c,dist_eq_norm] using hz + have hnormNonneg : 0 ≤ ‖w‖ := Complex.norm_nonneg w + have hsq : ‖w‖^2 < r^2 := + (sq_lt_sq₀ (M₀ := ℝ) (a := ‖w‖) (b := r) + hnormNonneg hr.le).2 hznorm + rw [← Complex.normSq_eq_norm_sq, Complex.normSq_apply, + Complex.sub_re, Complex.sub_im] at hsq + have hcoordsq : (z.re-c.re)^2+(z.im-c.im)^2 nlinarith only [hXsq,hr] + have hXpos : 0 norm_num + +private theorem side (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hside : ∀ i : Fin 4, 0 + < (q i).1 → if (q l.succ).2 = -1 then L < (((q i).2 : ℂ) / ((q i).1 : ℝ)).re else (((q i).2 : + ℂ) / ((q i).1 : ℝ)).re < L + 2) (i : Fin 4) (hi : 0 < (q i).1) : 0 < (σ q l) * (((p q) i).re + - (h L q l)) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + change (0 < σ * ((p i).re - h)) + have hh := hside i hi + by_cases hs : (q l.succ).2 = -1 + · simp only [hs, ite_true] at hh + dsimp [σ, h] + simp only [hs, ite_true, one_mul] + exact sub_pos.mpr hh + · simp only [hs, ite_false] at hh + dsimp [σ, h] + simp only [hs, ite_false, neg_one_mul] + change 0 < -((p i).re - (L + 2)) + linarith + +private noncomputable abbrev a₀ (l : Fin 3) : Fin 3 := by + classical + exact if l = 0 then 1 else 0 + +private noncomputable abbrev b₀ (l : Fin 3) : Fin 3 := by + classical + exact if l = 2 then 1 else 2 + +private theorem ha₀ (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q l.succ).1 = 0) + (hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1) (hnormal : (q l.succ).2 = -1 ∨ (q l.succ).2 = + 1) (hside : ∀ i : Fin 4, 0 < (q i).1 → if (q l.succ).2 = -1 then L < (((q i).2 : ℂ) / ((q + i).1 : ℝ)).re else (((q i).2 : ℂ) / ((q i).1 : ℝ)).re < L + 2) : (a₀ l) ≠ l := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + have hσ : σ ^ 2 = 1 := hσ q l + have side (i : Fin 4) (hi : 0 < (q i).1) : 0 < σ * ((p i).re - h) := side L q l hside i hi + let a₀ : Fin 3 := if l = 0 then 1 else 0 + change (a₀ ≠ l) + fin_cases l <;> simp [a₀] + +private theorem hb₀ (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q l.succ).1 = 0) + (hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1) (hnormal : (q l.succ).2 = -1 ∨ (q l.succ).2 = + 1) (hside : ∀ i : Fin 4, 0 < (q i).1 → if (q l.succ).2 = -1 then L < (((q i).2 : ℂ) / ((q + i).1 : ℝ)).re else (((q i).2 : ℂ) / ((q i).1 : ℝ)).re < L + 2) : (b₀ l) ≠ l := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + have hσ : σ ^ 2 = 1 := hσ q l + have side (i : Fin 4) (hi : 0 < (q i).1) : 0 < σ * ((p i).re - h) := side L q l hside i hi + let a₀ : Fin 3 := if l = 0 then 1 else 0 + let b₀ : Fin 3 := if l = 2 then 1 else 2 + have ha₀ : a₀ ≠ l := ha₀ L q l hl hpos hnormal hside + change (b₀ ≠ l) + fin_cases l <;> simp [b₀] + +private theorem hab₀ (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q l.succ).1 = 0) + (hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1) (hnormal : (q l.succ).2 = -1 ∨ (q l.succ).2 = + 1) (hside : ∀ i : Fin 4, 0 < (q i).1 → if (q l.succ).2 = -1 then L < (((q i).2 : ℂ) / ((q + i).1 : ℝ)).re else (((q i).2 : ℂ) / ((q i).1 : ℝ)).re < L + 2) : (a₀ l) ≠ (b₀ l) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + have hσ : σ ^ 2 = 1 := hσ q l + have side (i : Fin 4) (hi : 0 < (q i).1) : 0 < σ * ((p i).re - h) := side L q l hside i hi + let a₀ : Fin 3 := if l = 0 then 1 else 0 + let b₀ : Fin 3 := if l = 2 then 1 else 2 + have ha₀ : a₀ ≠ l := ha₀ L q l hl hpos hnormal hside + have hb₀ : b₀ ≠ l := hb₀ L q l hl hpos hnormal hside + change (a₀ ≠ b₀) + fin_cases l <;> simp [a₀, b₀] + +private theorem hne (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q l.succ).1 = 0) + (hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1) (hzero : 0 < (q 0).1) (hnormal : (q l.succ).2 + = -1 ∨ (q l.succ).2 = 1) (hside : ∀ i : Fin 4, 0 < (q i).1 → if (q l.succ).2 = -1 then L < + (((q i).2 : ℂ) / ((q i).1 : ℝ)).re else (((q i).2 : ℂ) / ((q i).1 : ℝ)).re < L + 2) (hinside + : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) : ((p q) (a₀ + l).succ).im ≠ ((p q) (b₀ l).succ).im := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let P := P4909T1ParentPolygon L q + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let x := p 0 + have hσ : σ ^ 2 = 1 := hσ q l + have side (i : Fin 4) (hi : 0 < (q i).1) : 0 < σ * ((p i).re - h) := side L q l hside i hi + let a₀ : Fin 3 := if l = 0 then 1 else 0 + let b₀ : Fin 3 := if l = 2 then 1 else 2 + have ha₀ : a₀ ≠ l := ha₀ L q l hl hpos hnormal hside + have hb₀ : b₀ ≠ l := hb₀ L q l hl hpos hnormal hside + have hab₀ : a₀ ≠ b₀ := hab₀ L q l hl hpos hnormal hside + have hp₀ := (P4953T1LiteralHulls L q l a₀ b₀ ha₀ hb₀ hab₀ hl + (hpos a₀ ha₀) (hpos b₀ hb₀) hzero).1 + have hheight := P4953T1HullHeight h (p a₀.succ) (p b₀.succ) x (by + rw [← hp₀]; exact hinside) + change ((p a₀.succ).im ≠ (p b₀.succ).im) + intro he + simp only [he, min_self, max_self] at hheight + linarith [hheight.1, hheight.2] + +private noncomputable abbrev A (q : Fin 4 → CircleCoordinates) (a : Fin 3) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + exact p a.succ + +private noncomputable abbrev B (q : Fin 4 → CircleCoordinates) (b : Fin 3) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + exact p b.succ + +private theorem classes (l : Fin 3) (a : Fin 3) (b : Fin 3) (hal : a ≠ l) (hbl : b ≠ l) (hab : a + ≠ b) (c : Fin 3) : c = l ∨ c = a ∨ c = b := by + classical + omega + +private theorem hvertices (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (a : Fin 3) (b : + Fin 3) (hP : (P L q) = convexHull ℝ ({(A q a), (B q b), ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), + (B q b).im⟩} : Set ℂ)) : (A q a) ∈ (P L q) ∧ (B q b) ∈ (P L q) ∧ (foot L q l) (A q a) ∈ (P L + q) ∧ (foot L q l) (B q b) ∈ (P L q) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let P := P4909T1ParentPolygon L q + let h := if (q l.succ).2 = -1 then L else L + 2 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let A := p a.succ + let B := p b.succ + rw [hP] + exact ⟨subset_convexHull ℝ _ (by simp), subset_convexHull ℝ _ (by simp), + subset_convexHull ℝ _ (by simp), subset_convexHull ℝ _ (by simp)⟩ + +private theorem hxP (L : ℝ) (q : Fin 4 → CircleCoordinates) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : + ℝ) ∈ interior (P4909T1ParentPolygon L q)) : (x q) ∈ (P L q) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let P := P4909T1ParentPolygon L q + let x := p 0 + change (x ∈ P) + exact interior_subset hinside + +private theorem hfxP (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hinside : ((q 0).2 : ℂ) + / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (a : Fin 3) (b : Fin 3) (qmem : ∀ (z + : ℂ), z ∈ ((P L q)) ↔ (A q a).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * (z.re - (h L q + l)) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / + ((B q b).im - (A q a).im)) z.im - z.re)) (qint : ∀ (z : ℂ), z ∈ interior (((P L q))) ↔ (A q + a).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y + => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q a).im)) + z.im - z.re)) (hAx : ((p q) a.succ).im < (x q).im) (hxB : (x q).im < ((p q) b.succ).im) : + (foot L q l) (x q) ∈ (P L q) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let P := P4909T1ParentPolygon L q + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + let A := p a.succ + let B := p b.succ + have hxi := (qint x).mp hinside + change (foot x ∈ P) + apply (qmem (foot x)).mpr + refine ⟨hAx.le, hxB.le, ?_, ?_⟩ + · change 0 ≤ σ * (h - h) + simp + · change 0 ≤ σ * (A.re + (B.re - A.re) * + (x.im - A.im) / (B.im - A.im) - h) + nlinarith only [hxi.2.2.1, hxi.2.2.2] + +private theorem convexP (L : ℝ) (q : Fin 4 → CircleCoordinates) : Convex ℝ (P L q) := by + classical + let P := P4909T1ParentPolygon L q + change (Convex ℝ P) + exact convex_convexHull ℝ _ + +private theorem subC (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hinside : ((q 0).2 : ℂ) + / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (a : Fin 3) (b : Fin 3) (hP : (P L + q) = convexHull ℝ ({(A q a), (B q b), ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), (B q b).im⟩} : Set + ℂ)) (hC : (F L q) l = convexHull ℝ ({(x q), (A q a), (B q b)} : Set ℂ)) : (F L q) l ⊆ (P L q) + := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let P := P4909T1ParentPolygon L q + let F (c : Fin 3) := P4909T1ParentPolygon L (s c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + let A := p a.succ + let B := p b.succ + have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP + have hxP : x ∈ P := hxP L q hinside + have convexP : Convex ℝ P := convexP L q + rw [hC] + apply convexHull_min _ convexP + intro z hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with rfl | rfl | rfl + · exact hxP + · exact hvertices.1 + · exact hvertices.2.1 + +private theorem subU (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hinside : ((q 0).2 : ℂ) + / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (a : Fin 3) (b : Fin 3) (qmem : ∀ (z + : ℂ), z ∈ ((P L q)) ↔ (A q a).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * (z.re - (h L q + l)) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / + ((B q b).im - (A q a).im)) z.im - z.re)) (qint : ∀ (z : ℂ), z ∈ interior (((P L q))) ↔ (A q + a).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y + => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q a).im)) + z.im - z.re)) (hP : (P L q) = convexHull ℝ ({(A q a), (B q b), ⟨(h L q l), (A q a).im⟩, ⟨(h L + q l), (B q b).im⟩} : Set ℂ)) (hU : (F L q) a = convexHull ℝ ({(x q), (B q b), ⟨(h L q l), (x + q).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hAx : ((p q) a.succ).im < (x q).im) (hxB : (x + q).im < ((p q) b.succ).im) : (F L q) a ⊆ (P L q) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let P := P4909T1ParentPolygon L q + let F (c : Fin 3) := P4909T1ParentPolygon L (s c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + let A := p a.succ + let B := p b.succ + have hxi := (qint x).mp hinside + have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP + have hxP : x ∈ P := hxP L q hinside + have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB + have convexP : Convex ℝ P := convexP L q + rw [hU] + apply convexHull_min _ convexP + intro z hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with rfl | rfl | rfl | rfl + · exact hxP + · exact hvertices.2.1 + · exact hfxP + · exact hvertices.2.2.2 + +private theorem subD (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hinside : ((q 0).2 : ℂ) + / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (a : Fin 3) (b : Fin 3) (qmem : ∀ (z + : ℂ), z ∈ ((P L q)) ↔ (A q a).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * (z.re - (h L q + l)) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / + ((B q b).im - (A q a).im)) z.im - z.re)) (qint : ∀ (z : ℂ), z ∈ interior (((P L q))) ↔ (A q + a).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y + => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q a).im)) + z.im - z.re)) (hP : (P L q) = convexHull ℝ ({(A q a), (B q b), ⟨(h L q l), (A q a).im⟩, ⟨(h L + q l), (B q b).im⟩} : Set ℂ)) (hD : (F L q) b = convexHull ℝ ({(A q a), (x q), ⟨(h L q l), (A + q a).im⟩, ⟨(h L q l), (x q).im⟩} : Set ℂ)) (hAx : ((p q) a.succ).im < (x q).im) (hxB : (x + q).im < ((p q) b.succ).im) : (F L q) b ⊆ (P L q) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let P := P4909T1ParentPolygon L q + let F (c : Fin 3) := P4909T1ParentPolygon L (s c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + let A := p a.succ + let B := p b.succ + have hxi := (qint x).mp hinside + have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP + have hxP : x ∈ P := hxP L q hinside + have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB + have convexP : Convex ℝ P := convexP L q + rw [hD] + apply convexHull_min _ convexP + intro z hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with rfl | rfl | rfl | rfl + · exact hvertices.1 + · exact hxP + · exact hvertices.2.2.1 + · exact hfxP + +private theorem sub (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q l.succ).1 = 0) + (hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1) (hzero : 0 < (q 0).1) (hnormal : (q l.succ).2 + = -1 ∨ (q l.succ).2 = 1) (hside : ∀ i : Fin 4, 0 < (q i).1 → if (q l.succ).2 = -1 then L < + (((q i).2 : ℂ) / ((q i).1 : ℝ)).re else (((q i).2 : ℂ) / ((q i).1 : ℝ)).re < L + 2) (hinside + : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (a : Fin 3) (b : Fin + 3) (qmem : ∀ (z : ℂ), z ∈ ((P L q)) ↔ (A q a).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * + (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - + (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re)) (dmem : ∀ (z : ℂ), z ∈ ((F L q) b) ↔ + (A q a).im ≤ z.im ∧ z.im ≤ (x q).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun + y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) z.im + - z.re)) (tlower : ∀ (z : ℂ), (A q a).im ≤ z.im → z.im ≤ (x q).im → (z ∈ ((F L q) l) ↔ 0 ≤ (σ + q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im + - (A q a).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - + (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (umem : ∀ (z : ℂ), z ∈ ((F L q) a) ↔ + (x q).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun + y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - + z.re)) (tupper : ∀ (z : ℂ), (x q).im ≤ z.im → z.im ≤ (B q b).im → (z ∈ ((F L q) l) ↔ 0 ≤ (σ q + l) * (z.re - (fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x + q).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q + a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (qint : ∀ (z : ℂ), z ∈ interior (((P L + q))) ↔ (A q a).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) + * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q + a).im)) z.im - z.re)) (qfront : frontier (((P L q))) = segment ℝ (A q a) (B q b) ∪ segment ℝ + (A q a) ⟨(h L q l), (A q a).im⟩ ∪ segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ segment ℝ ⟨(h L + q l), (A q a).im⟩ ⟨(h L q l), (B q b).im⟩) (dint : ∀ (z : ℂ), z ∈ interior (((F L q) b)) ↔ (A + q a).im < z.im ∧ z.im < (x q).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y + => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) z.im - + z.re)) (dfront : frontier (((F L q) b)) = segment ℝ (A q a) (x q) ∪ segment ℝ (A q a) ⟨(h L q + l), (A q a).im⟩ ∪ segment ℝ (x q) ⟨(h L q l), (x q).im⟩ ∪ segment ℝ ⟨(h L q l), (A q a).im⟩ + ⟨(h L q l), (x q).im⟩) (uint : ∀ (z : ℂ), z ∈ interior (((F L q) a)) ↔ (x q).im < z.im ∧ z.im + < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y => (x q).re + ((B q + b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - z.re)) (ufront : + frontier (((F L q) a)) = segment ℝ (x q) (B q b) ∪ segment ℝ (x q) ⟨(h L q l), (x q).im⟩ ∪ + segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ segment ℝ ⟨(h L q l), (x q).im⟩ ⟨(h L q l), (B q + b).im⟩) (tint : ∀ (z : ℂ), z ∈ interior (((F L q) l)) ↔ 0 < (σ q l) * ((fun y => (A q a).re + + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re) ∧ 0 < + (σ q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x + q).im - (A q a).im)) z.im) ∧ 0 < (σ q l) * (z.re - (fun y => (x q).re + ((B q b).re - (x + q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im)) (tfront : frontier (((F L q) l)) = + segment ℝ (x q) (A q a) ∪ segment ℝ (x q) (B q b) ∪ segment ℝ (A q a) (B q b)) (hal : a ≠ l) + (hbl : b ≠ l) (hab : a ≠ b) (hP : (P L q) = convexHull ℝ ({(A q a), (B q b), ⟨(h L q l), (A q + a).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hD : (F L q) b = convexHull ℝ ({(A q a), (x q), + ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), (x q).im⟩} : Set ℂ)) (hC : (F L q) l = convexHull ℝ ({(x + q), (A q a), (B q b)} : Set ℂ)) (hU : (F L q) a = convexHull ℝ ({(x q), (B q b), ⟨(h L q l), + (x q).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hAx : ((p q) a.succ).im < (x q).im) (hxB : (x + q).im < ((p q) b.succ).im) (c : Fin 3) : (F L q) c ⊆ (P L q) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let P := P4909T1ParentPolygon L q + let F (c : Fin 3) := P4909T1ParentPolygon L (s c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + have hσ : σ ^ 2 = 1 := hσ q l + have side (i : Fin 4) (hi : 0 < (q i).1) : 0 < σ * ((p i).re - h) := side L q l hside i hi + let a₀ : Fin 3 := if l = 0 then 1 else 0 + let b₀ : Fin 3 := if l = 2 then 1 else 2 + have ha₀ : a₀ ≠ l := ha₀ L q l hl hpos hnormal hside + have hb₀ : b₀ ≠ l := hb₀ L q l hl hpos hnormal hside + have hab₀ : a₀ ≠ b₀ := hab₀ L q l hl hpos hnormal hside + have hp₀ := (P4953T1LiteralHulls L q l a₀ b₀ ha₀ hb₀ hab₀ hl + (hpos a₀ ha₀) (hpos b₀ hb₀) hzero).1 + have hheight := P4953T1HullHeight h (p a₀.succ) (p b₀.succ) x (by + rw [← hp₀]; exact hinside) + have hne : (p a₀.succ).im ≠ (p b₀.succ).im := hne L q l hl hpos hzero hnormal hside hinside + let A := p a.succ + let B := p b.succ + have ha := hpos a hal + have hb := hpos b hbl + have classes (c : Fin 3) : c = l ∨ c = a ∨ c = b := classes l a b hal hbl hab c + have hA := side a.succ ha + have hB := side b.succ hb + have hx := side 0 hzero + have hxi := (qint x).mp hinside + have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP + have hxP : x ∈ P := hxP L q hinside + have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB + have convexP : Convex ℝ P := convexP L q + have subC : F l ⊆ P := subC L q l hinside a b hP hC + have subU : F a ⊆ P := subU L q l hinside a b qmem qint hP hU hAx hxB + have subD : F b ⊆ P := subD L q l hinside a b qmem qint hP hD hAx hxB + change (F c ⊆ P) + rcases classes c with rfl | rfl | rfl + · exact subC + · exact subU + · exact subD + +private theorem omitted (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q l.succ).1 = + 0) (hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1) (hzero : 0 < (q 0).1) (hnormal : (q + l.succ).2 = -1 ∨ (q l.succ).2 = 1) (hside : ∀ i : Fin 4, 0 < (q i).1 → if (q l.succ).2 = -1 + then L < (((q i).2 : ℂ) / ((q i).1 : ℝ)).re else (((q i).2 : ℂ) / ((q i).1 : ℝ)).re < L + 2) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (a : Fin 3) + (b : Fin 3) (qmem : ∀ (z : ℂ), z ∈ ((P L q)) ↔ (A q a).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ + q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * + (y - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re)) (dmem : ∀ (z : ℂ), z ∈ ((F L q) + b) ↔ (A q a).im ≤ z.im ∧ z.im ≤ (x q).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * + ((fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) + z.im - z.re)) (tlower : ∀ (z : ℂ), (A q a).im ≤ z.im → z.im ≤ (x q).im → (z ∈ ((F L q) l) ↔ 0 + ≤ (σ q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x + q).im - (A q a).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) + * (y - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (umem : ∀ (z : ℂ), z ∈ ((F L + q) a) ↔ (x q).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) + * ((fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) + z.im - z.re)) (tupper : ∀ (z : ℂ), (x q).im ≤ z.im → z.im ≤ (B q b).im → (z ∈ ((F L q) l) ↔ 0 + ≤ (σ q l) * (z.re - (fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q + b).im - (x q).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * + (y - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (qint : ∀ (z : ℂ), z ∈ interior + (((P L q))) ↔ (A q a).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < + (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im + - (A q a).im)) z.im - z.re)) (qfront : frontier (((P L q))) = segment ℝ (A q a) (B q b) ∪ + segment ℝ (A q a) ⟨(h L q l), (A q a).im⟩ ∪ segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ + segment ℝ ⟨(h L q l), (A q a).im⟩ ⟨(h L q l), (B q b).im⟩) (dint : ∀ (z : ℂ), z ∈ interior + (((F L q) b)) ↔ (A q a).im < z.im ∧ z.im < (x q).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < + (σ q l) * ((fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A + q a).im)) z.im - z.re)) (dfront : frontier (((F L q) b)) = segment ℝ (A q a) (x q) ∪ segment + ℝ (A q a) ⟨(h L q l), (A q a).im⟩ ∪ segment ℝ (x q) ⟨(h L q l), (x q).im⟩ ∪ segment ℝ ⟨(h L q + l), (A q a).im⟩ ⟨(h L q l), (x q).im⟩) (uint : ∀ (z : ℂ), z ∈ interior (((F L q) a)) ↔ (x + q).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y + => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - + z.re)) (ufront : frontier (((F L q) a)) = segment ℝ (x q) (B q b) ∪ segment ℝ (x q) ⟨(h L q + l), (x q).im⟩ ∪ segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ segment ℝ ⟨(h L q l), (x q).im⟩ + ⟨(h L q l), (B q b).im⟩) (tint : ∀ (z : ℂ), z ∈ interior (((F L q) l)) ↔ 0 < (σ q l) * ((fun + y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q a).im)) + z.im - z.re) ∧ 0 < (σ q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A + q a).im) / ((x q).im - (A q a).im)) z.im) ∧ 0 < (σ q l) * (z.re - (fun y => (x q).re + ((B q + b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im)) (tfront : frontier (((F + L q) l)) = segment ℝ (x q) (A q a) ∪ segment ℝ (x q) (B q b) ∪ segment ℝ (A q a) (B q b)) + (hal : a ≠ l) (hbl : b ≠ l) (hab : a ≠ b) (hP : (P L q) = convexHull ℝ ({(A q a), (B q b), + ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hD : (F L q) b = convexHull ℝ + ({(A q a), (x q), ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), (x q).im⟩} : Set ℂ)) (hC : (F L q) l = + convexHull ℝ ({(x q), (A q a), (B q b)} : Set ℂ)) (hU : (F L q) a = convexHull ℝ ({(x q), (B + q b), ⟨(h L q l), (x q).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hAx : ((p q) a.succ).im < (x + q).im) (hxB : (x q).im < ((p q) b.succ).im) (c : Fin 3) (hc : 0 < (q c.succ).1) : (p q) + c.succ ∉ (F L q) c := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let P := P4909T1ParentPolygon L q + let F (c : Fin 3) := P4909T1ParentPolygon L (s c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + have hσ : σ ^ 2 = 1 := hσ q l + have side (i : Fin 4) (hi : 0 < (q i).1) : 0 < σ * ((p i).re - h) := side L q l hside i hi + let a₀ : Fin 3 := if l = 0 then 1 else 0 + let b₀ : Fin 3 := if l = 2 then 1 else 2 + have ha₀ : a₀ ≠ l := ha₀ L q l hl hpos hnormal hside + have hb₀ : b₀ ≠ l := hb₀ L q l hl hpos hnormal hside + have hab₀ : a₀ ≠ b₀ := hab₀ L q l hl hpos hnormal hside + have hp₀ := (P4953T1LiteralHulls L q l a₀ b₀ ha₀ hb₀ hab₀ hl + (hpos a₀ ha₀) (hpos b₀ hb₀) hzero).1 + have hheight := P4953T1HullHeight h (p a₀.succ) (p b₀.succ) x (by + rw [← hp₀]; exact hinside) + have hne : (p a₀.succ).im ≠ (p b₀.succ).im := hne L q l hl hpos hzero hnormal hside hinside + let A := p a.succ + let B := p b.succ + have ha := hpos a hal + have hb := hpos b hbl + have classes (c : Fin 3) : c = l ∨ c = a ∨ c = b := classes l a b hal hbl hab c + have hA := side a.succ ha + have hB := side b.succ hb + have hx := side 0 hzero + have hxi := (qint x).mp hinside + have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP + have hxP : x ∈ P := hxP L q hinside + have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB + have convexP : Convex ℝ P := convexP L q + have subC : F l ⊆ P := subC L q l hinside a b hP hC + have subU : F a ⊆ P := subU L q l hinside a b qmem qint hP hU hAx hxB + have subD : F b ⊆ P := subD L q l hinside a b qmem qint hP hD hAx hxB + change (p c.succ ∉ F c) + rcases classes c with rfl | rfl | rfl + · omega + · intro hz + have hh := ((umem A).mp hz).1 + exact (not_le_of_gt hAx) hh + · intro hz + have hh := ((dmem B).mp hz).2.1 + exact (not_le_of_gt hxB) hh + +private theorem root (q : Fin 4 → CircleCoordinates) (slots : ∀ (c j : Fin 3), (fun c => + ApollonianSuperharmonic.P4828T1Step (ApollonianSuperharmonic.P4828T1Rotate q c)) c j.succ + = if j = 0 then q 0 else q (j + c).succ) (c : Fin 3) : (s q) c (0 : Fin 3).succ = q 0 := by + classical + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + change (s c (0 : Fin 3).succ = q 0) + exact (slots c 0).trans (ite_eq_left rfl) + +private theorem keep (q : Fin 4 → CircleCoordinates) (slots : ∀ (c j : Fin 3), (fun c => + ApollonianSuperharmonic.P4828T1Step (ApollonianSuperharmonic.P4828T1Rotate q c)) c j.succ + = if j = 0 then q 0 else q (j + c).succ) (c i : Fin 3) (hi : i ≠ c) : (s q) c (i - c).succ = + q i.succ := by + classical + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + change (s c (i - c).succ = q i.succ) + simpa only [ite_eq_right (sub_ne_zero.mpr hi), sub_add_cancel] using slots c (i - c) + +private theorem radial (L : ℝ) (q : Fin 4 → CircleCoordinates) (hzero : 0 < (q 0).1) (slots : ∀ + (c j : Fin 3), (fun c => ApollonianSuperharmonic.P4828T1Step + (ApollonianSuperharmonic.P4828T1Rotate q c)) c j.succ = if j = 0 then q 0 else q (j + + c).succ) (c i : Fin 3) (hi : i ≠ c) (hpi : 0 < (q i.succ).1) : segment ℝ (x q) ((p q) i.succ) + ⊆ P4909T1ParentEdges L ((s q) c) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let x := p 0 + have root (c : Fin 3) : s c (0 : Fin 3).succ = q 0 := root q slots c + have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := keep q slots c i hi + change (segment ℝ x (p i.succ) ⊆ P4909T1ParentEdges L (s c)) + intro z hz + apply Or.inl + refine ⟨0, i - c, (sub_ne_zero.mpr hi).symm, ?_, ?_, ?_⟩ + · rw [root]; exact hzero + · rw [keep c i hi]; exact hpi + · simpa only [root, keep c i hi] using hz + +private theorem retained (L : ℝ) (q : Fin 4 → CircleCoordinates) (slots : ∀ (c j : Fin 3), (fun c + => ApollonianSuperharmonic.P4828T1Step (ApollonianSuperharmonic.P4828T1Rotate q c)) c + j.succ = if j = 0 then q 0 else q (j + c).succ) (c i j : Fin 3) (hi : i ≠ c) (hj : j ≠ c) + (hij : i ≠ j) (hpi : 0 < (q i.succ).1) (hpj : 0 < (q j.succ).1) : segment ℝ ((p q) i.succ) + ((p q) j.succ) ⊆ P4909T1ParentEdges L ((s q) c) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := keep q slots c i hi + change (segment ℝ (p i.succ) (p j.succ) ⊆ P4909T1ParentEdges L (s c)) + intro z hz + apply Or.inl + refine ⟨i - c, j - c, fun he => hij (sub_left_inj.mp he), ?_, ?_, ?_⟩ + · rw [keep c i hi]; exact hpi + · rw [keep c j hj]; exact hpj + · simpa only [keep c i hi, keep c j hj] using hz + +private theorem rootFoot (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q l.succ).1 = + 0) (hzero : 0 < (q 0).1) (slots : ∀ (c j : Fin 3), (fun c => + ApollonianSuperharmonic.P4828T1Step (ApollonianSuperharmonic.P4828T1Rotate q c)) c j.succ + = if j = 0 then q 0 else q (j + c).succ) (c : Fin 3) (hc : l ≠ c) : segment ℝ (x q) ((foot L + q l) (x q)) ⊆ P4909T1ParentEdges L ((s q) c) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + have root (c : Fin 3) : s c (0 : Fin 3).succ = q 0 := root q slots c + have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := keep q slots c i hi + change (segment ℝ x (foot x) ⊆ P4909T1ParentEdges L (s c)) + intro z hz + apply Or.inr ∘ Or.inl + refine ⟨0, l - c, ?_, ?_, ?_⟩ + · rw [root]; exact hzero + · rw [keep c l hc]; exact hl + · simpa only [root, keep c l hc] using hz + +private theorem retainedFoot (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q + l.succ).1 = 0) (slots : ∀ (c j : Fin 3), (fun c => ApollonianSuperharmonic.P4828T1Step + (ApollonianSuperharmonic.P4828T1Rotate q c)) c j.succ = if j = 0 then q 0 else q (j + + c).succ) (c i : Fin 3) (hc : l ≠ c) (hi : i ≠ c) (hpi : 0 < (q i.succ).1) : segment ℝ ((p q) + i.succ) ((foot L q l) ((p q) i.succ)) ⊆ P4909T1ParentEdges L ((s q) c) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := keep q slots c i hi + change (segment ℝ (p i.succ) (foot (p i.succ)) ⊆ P4909T1ParentEdges L (s c)) + intro z hz + apply Or.inr ∘ Or.inl + refine ⟨i - c, l - c, ?_, ?_, ?_⟩ + · rw [keep c i hi]; exact hpi + · rw [keep c l hc]; exact hl + · simpa only [keep c i hi, keep c l hc] using hz + +private theorem lineCarrier (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q + l.succ).1 = 0) (slots : ∀ (c j : Fin 3), (fun c => ApollonianSuperharmonic.P4828T1Step + (ApollonianSuperharmonic.P4828T1Rotate q c)) c j.succ = if j = 0 then q 0 else q (j + + c).succ) (c : Fin 3) (hc : l ≠ c) : {z : ℂ | z.re = (h L q l)} ⊆ P4909T1ParentEdges L ((s + q) c) := by + classical + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let h := if (q l.succ).2 = -1 then L else L + 2 + have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := keep q slots c i hi + change ({z : ℂ | z.re = h} ⊆ P4909T1ParentEdges L (s c)) + intro z hz + apply Or.inr ∘ Or.inr + refine ⟨l - c, ?_, ?_⟩ + · rw [keep c l hc]; exact hl + · rw [keep c l hc] + exact hz + +private theorem footLine (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (u v : ℂ) : segment + ℝ ((foot L q l) u) ((foot L q l) v) ⊆ {z : ℂ | z.re = (h L q l)} := by + classical + let h := if (q l.succ).2 = -1 then L else L + 2 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + change (segment ℝ (foot u) (foot v) ⊆ {z : ℂ | z.re = h}) + rintro z ⟨r, t, _, _, hrt, rfl⟩ + change (r • foot u + t • foot v).re = h + simp only [Complex.add_re, Complex.smul_re] + change r * h + t * h = h + rw [← add_mul, hrt, one_mul] + +private theorem frontC (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hpos : ∀ i : Fin 3, i + ≠ l → 0 < (q i.succ).1) (hzero : 0 < (q 0).1) (a : Fin 3) (b : Fin 3) (tfront : frontier (((F + L q) l)) = segment ℝ (x q) (A q a) ∪ segment ℝ (x q) (B q b) ∪ segment ℝ (A q a) (B q b)) + (slots : ∀ (c j : Fin 3), (fun c => ApollonianSuperharmonic.P4828T1Step + (ApollonianSuperharmonic.P4828T1Rotate q c)) c j.succ = if j = 0 then q 0 else q (j + + c).succ) (hal : a ≠ l) (hbl : b ≠ l) (hab : a ≠ b) : frontier ((F L q) l) ⊆ + P4909T1ParentEdges L ((s q) l) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let F (c : Fin 3) := P4909T1ParentPolygon L (s c) + let x := p 0 + let A := p a.succ + let B := p b.succ + have ha := hpos a hal + have hb := hpos b hbl + have root (c : Fin 3) : s c (0 : Fin 3).succ = q 0 := root q slots c + have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := keep q slots c i hi + have radial (c i : Fin 3) (hi : i ≠ c) (hpi : 0 < (q i.succ).1) : + segment ℝ x (p i.succ) ⊆ P4909T1ParentEdges L (s c) := radial L q hzero slots c i hi hpi + have retained (c i j : Fin 3) (hi : i ≠ c) (hj : j ≠ c) + (hij : i ≠ j) (hpi : 0 < (q i.succ).1) (hpj : 0 < (q j.succ).1) : + segment ℝ (p i.succ) (p j.succ) ⊆ P4909T1ParentEdges L (s c) := retained L q slots c i j + hi hj hij hpi hpj + rw [tfront] + exact Set.union_subset (Set.union_subset (radial l a hal ha) (radial l b hbl hb)) + (retained l a b hal hbl hab ha hb) + +private theorem frontU (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q l.succ).1 = + 0) (hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1) (hzero : 0 < (q 0).1) (a : Fin 3) (b : Fin + 3) (ufront : frontier (((F L q) a)) = segment ℝ (x q) (B q b) ∪ segment ℝ (x q) ⟨(h L q l), + (x q).im⟩ ∪ segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ segment ℝ ⟨(h L q l), (x q).im⟩ ⟨(h L + q l), (B q b).im⟩) (slots : ∀ (c j : Fin 3), (fun c => ApollonianSuperharmonic.P4828T1Step + (ApollonianSuperharmonic.P4828T1Rotate q c)) c j.succ = if j = 0 then q 0 else q (j + + c).succ) (hal : a ≠ l) (hbl : b ≠ l) (hab : a ≠ b) : frontier ((F L q) a) ⊆ + P4909T1ParentEdges L ((s q) a) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let F (c : Fin 3) := P4909T1ParentPolygon L (s c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + let B := p b.succ + have hb := hpos b hbl + have root (c : Fin 3) : s c (0 : Fin 3).succ = q 0 := root q slots c + have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := keep q slots c i hi + have radial (c i : Fin 3) (hi : i ≠ c) (hpi : 0 < (q i.succ).1) : + segment ℝ x (p i.succ) ⊆ P4909T1ParentEdges L (s c) := radial L q hzero slots c i hi hpi + have rootFoot (c : Fin 3) (hc : l ≠ c) : + segment ℝ x (foot x) ⊆ P4909T1ParentEdges L (s c) := rootFoot L q l hl hzero slots c hc + have retainedFoot (c i : Fin 3) (hc : l ≠ c) (hi : i ≠ c) + (hpi : 0 < (q i.succ).1) : + segment ℝ (p i.succ) (foot (p i.succ)) ⊆ P4909T1ParentEdges L (s c) := retainedFoot L q l + hl slots c i hc hi hpi + have lineCarrier (c : Fin 3) (hc : l ≠ c) : + {z : ℂ | z.re = h} ⊆ P4909T1ParentEdges L (s c) := lineCarrier L q l hl slots c hc + have footLine (u v : ℂ) : segment ℝ (foot u) (foot v) ⊆ {z : ℂ | z.re = h} := footLine L q l u v + rw [ufront] + exact Set.union_subset (Set.union_subset (Set.union_subset (radial a b hab.symm hb) + (rootFoot a hal.symm)) (retainedFoot a b hal.symm hab.symm hb)) + ((footLine x B).trans (lineCarrier a hal.symm)) + +private theorem frontD (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q l.succ).1 = + 0) (hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1) (hzero : 0 < (q 0).1) (a : Fin 3) (b : Fin + 3) (dfront : frontier (((F L q) b)) = segment ℝ (A q a) (x q) ∪ segment ℝ (A q a) ⟨(h L q l), + (A q a).im⟩ ∪ segment ℝ (x q) ⟨(h L q l), (x q).im⟩ ∪ segment ℝ ⟨(h L q l), (A q a).im⟩ ⟨(h L + q l), (x q).im⟩) (slots : ∀ (c j : Fin 3), (fun c => ApollonianSuperharmonic.P4828T1Step + (ApollonianSuperharmonic.P4828T1Rotate q c)) c j.succ = if j = 0 then q 0 else q (j + + c).succ) (hal : a ≠ l) (hbl : b ≠ l) (hab : a ≠ b) : frontier ((F L q) b) ⊆ + P4909T1ParentEdges L ((s q) b) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let F (c : Fin 3) := P4909T1ParentPolygon L (s c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + let A := p a.succ + have ha := hpos a hal + have root (c : Fin 3) : s c (0 : Fin 3).succ = q 0 := root q slots c + have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := keep q slots c i hi + have radial (c i : Fin 3) (hi : i ≠ c) (hpi : 0 < (q i.succ).1) : + segment ℝ x (p i.succ) ⊆ P4909T1ParentEdges L (s c) := radial L q hzero slots c i hi hpi + have rootFoot (c : Fin 3) (hc : l ≠ c) : + segment ℝ x (foot x) ⊆ P4909T1ParentEdges L (s c) := rootFoot L q l hl hzero slots c hc + have retainedFoot (c i : Fin 3) (hc : l ≠ c) (hi : i ≠ c) + (hpi : 0 < (q i.succ).1) : + segment ℝ (p i.succ) (foot (p i.succ)) ⊆ P4909T1ParentEdges L (s c) := retainedFoot L q l + hl slots c i hc hi hpi + have lineCarrier (c : Fin 3) (hc : l ≠ c) : + {z : ℂ | z.re = h} ⊆ P4909T1ParentEdges L (s c) := lineCarrier L q l hl slots c hc + have footLine (u v : ℂ) : segment ℝ (foot u) (foot v) ⊆ {z : ℂ | z.re = h} := footLine L q l u v + change (frontier (F b) ⊆ P4909T1ParentEdges L (s b)) + rw [dfront, segment_symm ℝ A x] + exact Set.union_subset (Set.union_subset (Set.union_subset (radial b a hab ha) + (retainedFoot b a hbl.symm hab ha)) (rootFoot b hbl.symm)) + ((footLine A x).trans (lineCarrier b hbl.symm)) + +private theorem front (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q l.succ).1 = 0) + (hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1) (hzero : 0 < (q 0).1) (hnormal : (q l.succ).2 + = -1 ∨ (q l.succ).2 = 1) (hside : ∀ i : Fin 4, 0 < (q i).1 → if (q l.succ).2 = -1 then L < + (((q i).2 : ℂ) / ((q i).1 : ℝ)).re else (((q i).2 : ℂ) / ((q i).1 : ℝ)).re < L + 2) (hinside + : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (a : Fin 3) (b : Fin + 3) (qmem : ∀ (z : ℂ), z ∈ ((P L q)) ↔ (A q a).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * + (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - + (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re)) (dmem : ∀ (z : ℂ), z ∈ ((F L q) b) ↔ + (A q a).im ≤ z.im ∧ z.im ≤ (x q).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun + y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) z.im + - z.re)) (tlower : ∀ (z : ℂ), (A q a).im ≤ z.im → z.im ≤ (x q).im → (z ∈ ((F L q) l) ↔ 0 ≤ (σ + q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im + - (A q a).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - + (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (umem : ∀ (z : ℂ), z ∈ ((F L q) a) ↔ + (x q).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun + y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - + z.re)) (tupper : ∀ (z : ℂ), (x q).im ≤ z.im → z.im ≤ (B q b).im → (z ∈ ((F L q) l) ↔ 0 ≤ (σ q + l) * (z.re - (fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x + q).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q + a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (qint : ∀ (z : ℂ), z ∈ interior (((P L + q))) ↔ (A q a).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) + * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q + a).im)) z.im - z.re)) (qfront : frontier (((P L q))) = segment ℝ (A q a) (B q b) ∪ segment ℝ + (A q a) ⟨(h L q l), (A q a).im⟩ ∪ segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ segment ℝ ⟨(h L + q l), (A q a).im⟩ ⟨(h L q l), (B q b).im⟩) (dint : ∀ (z : ℂ), z ∈ interior (((F L q) b)) ↔ (A + q a).im < z.im ∧ z.im < (x q).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y + => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) z.im - + z.re)) (dfront : frontier (((F L q) b)) = segment ℝ (A q a) (x q) ∪ segment ℝ (A q a) ⟨(h L q + l), (A q a).im⟩ ∪ segment ℝ (x q) ⟨(h L q l), (x q).im⟩ ∪ segment ℝ ⟨(h L q l), (A q a).im⟩ + ⟨(h L q l), (x q).im⟩) (uint : ∀ (z : ℂ), z ∈ interior (((F L q) a)) ↔ (x q).im < z.im ∧ z.im + < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y => (x q).re + ((B q + b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - z.re)) (ufront : + frontier (((F L q) a)) = segment ℝ (x q) (B q b) ∪ segment ℝ (x q) ⟨(h L q l), (x q).im⟩ ∪ + segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ segment ℝ ⟨(h L q l), (x q).im⟩ ⟨(h L q l), (B q + b).im⟩) (tint : ∀ (z : ℂ), z ∈ interior (((F L q) l)) ↔ 0 < (σ q l) * ((fun y => (A q a).re + + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re) ∧ 0 < + (σ q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x + q).im - (A q a).im)) z.im) ∧ 0 < (σ q l) * (z.re - (fun y => (x q).re + ((B q b).re - (x + q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im)) (tfront : frontier (((F L q) l)) = + segment ℝ (x q) (A q a) ∪ segment ℝ (x q) (B q b) ∪ segment ℝ (A q a) (B q b)) (slots : ∀ (c + j : Fin 3), (fun c => ApollonianSuperharmonic.P4828T1Step + (ApollonianSuperharmonic.P4828T1Rotate q c)) c j.succ = if j = 0 then q 0 else q (j + + c).succ) (hal : a ≠ l) (hbl : b ≠ l) (hab : a ≠ b) (hP : (P L q) = convexHull ℝ ({(A q a), (B + q b), ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hD : (F L q) b = + convexHull ℝ ({(A q a), (x q), ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), (x q).im⟩} : Set ℂ)) (hC + : (F L q) l = convexHull ℝ ({(x q), (A q a), (B q b)} : Set ℂ)) (hU : (F L q) a = convexHull + ℝ ({(x q), (B q b), ⟨(h L q l), (x q).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hAx : ((p q) + a.succ).im < (x q).im) (hxB : (x q).im < ((p q) b.succ).im) (c : Fin 3) : frontier ((F L q) + c) ⊆ P4909T1ParentEdges L ((s q) c) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let P := P4909T1ParentPolygon L q + let F (c : Fin 3) := P4909T1ParentPolygon L (s c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + have hσ : σ ^ 2 = 1 := hσ q l + have side (i : Fin 4) (hi : 0 < (q i).1) : 0 < σ * ((p i).re - h) := side L q l hside i hi + let a₀ : Fin 3 := if l = 0 then 1 else 0 + let b₀ : Fin 3 := if l = 2 then 1 else 2 + have ha₀ : a₀ ≠ l := ha₀ L q l hl hpos hnormal hside + have hb₀ : b₀ ≠ l := hb₀ L q l hl hpos hnormal hside + have hab₀ : a₀ ≠ b₀ := hab₀ L q l hl hpos hnormal hside + have hp₀ := (P4953T1LiteralHulls L q l a₀ b₀ ha₀ hb₀ hab₀ hl + (hpos a₀ ha₀) (hpos b₀ hb₀) hzero).1 + have hheight := P4953T1HullHeight h (p a₀.succ) (p b₀.succ) x (by + rw [← hp₀]; exact hinside) + have hne : (p a₀.succ).im ≠ (p b₀.succ).im := hne L q l hl hpos hzero hnormal hside hinside + let A := p a.succ + let B := p b.succ + have ha := hpos a hal + have hb := hpos b hbl + have classes (c : Fin 3) : c = l ∨ c = a ∨ c = b := classes l a b hal hbl hab c + have hA := side a.succ ha + have hB := side b.succ hb + have hx := side 0 hzero + have hxi := (qint x).mp hinside + have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP + have hxP : x ∈ P := hxP L q hinside + have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB + have convexP : Convex ℝ P := convexP L q + have subC : F l ⊆ P := subC L q l hinside a b hP hC + have subU : F a ⊆ P := subU L q l hinside a b qmem qint hP hU hAx hxB + have subD : F b ⊆ P := subD L q l hinside a b qmem qint hP hD hAx hxB + have root (c : Fin 3) : s c (0 : Fin 3).succ = q 0 := root q slots c + have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := keep q slots c i hi + have radial (c i : Fin 3) (hi : i ≠ c) (hpi : 0 < (q i.succ).1) : + segment ℝ x (p i.succ) ⊆ P4909T1ParentEdges L (s c) := radial L q hzero slots c i hi hpi + have retained (c i j : Fin 3) (hi : i ≠ c) (hj : j ≠ c) + (hij : i ≠ j) (hpi : 0 < (q i.succ).1) (hpj : 0 < (q j.succ).1) : + segment ℝ (p i.succ) (p j.succ) ⊆ P4909T1ParentEdges L (s c) := retained L q slots c i j + hi hj hij hpi hpj + have rootFoot (c : Fin 3) (hc : l ≠ c) : + segment ℝ x (foot x) ⊆ P4909T1ParentEdges L (s c) := rootFoot L q l hl hzero slots c hc + have retainedFoot (c i : Fin 3) (hc : l ≠ c) (hi : i ≠ c) + (hpi : 0 < (q i.succ).1) : + segment ℝ (p i.succ) (foot (p i.succ)) ⊆ P4909T1ParentEdges L (s c) := retainedFoot L q l + hl slots c i hc hi hpi + have lineCarrier (c : Fin 3) (hc : l ≠ c) : + {z : ℂ | z.re = h} ⊆ P4909T1ParentEdges L (s c) := lineCarrier L q l hl slots c hc + have footLine (u v : ℂ) : segment ℝ (foot u) (foot v) ⊆ {z : ℂ | z.re = h} := footLine L q l u v + have frontC : frontier (F l) ⊆ P4909T1ParentEdges L (s l) := frontC L q l hpos hzero a b + tfront slots hal hbl hab + have frontU : frontier (F a) ⊆ P4909T1ParentEdges L (s a) := frontU L q l hl hpos hzero a b + ufront slots hal hbl hab + have frontD : frontier (F b) ⊆ P4909T1ParentEdges L (s b) := frontD L q l hl hpos hzero a b + dfront slots hal hbl hab + change (frontier (F c) ⊆ P4909T1ParentEdges L (s c)) + rcases classes c with rfl | rfl | rfl + · exact frontC + · exact frontU + · exact frontD + +private theorem sepCU (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (a : Fin 3) (b : Fin 3) + (uint : ∀ (z : ℂ), z ∈ interior (((F L q) a)) ↔ (x q).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ + q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y => (x q).re + ((B q b).re - (x q).re) * (y + - (x q).im) / ((B q b).im - (x q).im)) z.im - z.re)) (tint : ∀ (z : ℂ), z ∈ interior (((F L + q) l)) ↔ 0 < (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / + ((B q b).im - (A q a).im)) z.im - z.re) ∧ 0 < (σ q l) * (z.re - (fun y => (A q a).re + ((x + q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) z.im) ∧ 0 < (σ q l) * (z.re + - (fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) + z.im)) : Disjoint (interior ((F L q) l)) (interior ((F L q) a)) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let F (c : Fin 3) := P4909T1ParentPolygon L (s c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + let A := p a.succ + let B := p b.succ + change (Disjoint (interior (F l)) (interior (F a))) + apply Set.disjoint_left.mpr + intro z ht hu + have ht' := ((tint z).mp ht).2.2 + have hu' := ((uint z).mp hu).2.2.2 + nlinarith only [ht', hu'] + +private theorem sepCD (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (a : Fin 3) (b : Fin 3) + (dint : ∀ (z : ℂ), z ∈ interior (((F L q) b)) ↔ (A q a).im < z.im ∧ z.im < (x q).im ∧ 0 < (σ + q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y => (A q a).re + ((x q).re - (A q a).re) * + (y - (A q a).im) / ((x q).im - (A q a).im)) z.im - z.re)) (tint : ∀ (z : ℂ), z ∈ interior + (((F L q) l)) ↔ 0 < (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q + a).im) / ((B q b).im - (A q a).im)) z.im - z.re) ∧ 0 < (σ q l) * (z.re - (fun y => (A q a).re + + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) z.im) ∧ 0 < (σ q l) * + (z.re - (fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x + q).im)) z.im)) : Disjoint (interior ((F L q) l)) (interior ((F L q) b)) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let F (c : Fin 3) := P4909T1ParentPolygon L (s c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + let A := p a.succ + let B := p b.succ + change (Disjoint (interior (F l)) (interior (F b))) + apply Set.disjoint_left.mpr + intro z ht hd + have ht' := ((tint z).mp ht).2.1 + have hd' := ((dint z).mp hd).2.2.2 + nlinarith only [ht', hd'] + +private theorem sepUD (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (a : Fin 3) (b : Fin 3) + (dint : ∀ (z : ℂ), z ∈ interior (((F L q) b)) ↔ (A q a).im < z.im ∧ z.im < (x q).im ∧ 0 < (σ + q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y => (A q a).re + ((x q).re - (A q a).re) * + (y - (A q a).im) / ((x q).im - (A q a).im)) z.im - z.re)) (uint : ∀ (z : ℂ), z ∈ interior + (((F L q) a)) ↔ (x q).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < + (σ q l) * ((fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x + q).im)) z.im - z.re)) : Disjoint (interior ((F L q) a)) (interior ((F L q) b)) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let F (c : Fin 3) := P4909T1ParentPolygon L (s c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + let A := p a.succ + let B := p b.succ + change (Disjoint (interior (F a)) (interior (F b))) + apply Set.disjoint_left.mpr + intro z hu hd + exact (not_lt_of_gt ((uint z).mp hu).1) ((dint z).mp hd).2.1 + +private theorem sep (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q l.succ).1 = 0) + (hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1) (hzero : 0 < (q 0).1) (hnormal : (q l.succ).2 + = -1 ∨ (q l.succ).2 = 1) (hside : ∀ i : Fin 4, 0 < (q i).1 → if (q l.succ).2 = -1 then L < + (((q i).2 : ℂ) / ((q i).1 : ℝ)).re else (((q i).2 : ℂ) / ((q i).1 : ℝ)).re < L + 2) (hinside + : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (a : Fin 3) (b : Fin + 3) (qmem : ∀ (z : ℂ), z ∈ ((P L q)) ↔ (A q a).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * + (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - + (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re)) (dmem : ∀ (z : ℂ), z ∈ ((F L q) b) ↔ + (A q a).im ≤ z.im ∧ z.im ≤ (x q).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun + y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) z.im + - z.re)) (tlower : ∀ (z : ℂ), (A q a).im ≤ z.im → z.im ≤ (x q).im → (z ∈ ((F L q) l) ↔ 0 ≤ (σ + q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im + - (A q a).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - + (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (umem : ∀ (z : ℂ), z ∈ ((F L q) a) ↔ + (x q).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun + y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - + z.re)) (tupper : ∀ (z : ℂ), (x q).im ≤ z.im → z.im ≤ (B q b).im → (z ∈ ((F L q) l) ↔ 0 ≤ (σ q + l) * (z.re - (fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x + q).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q + a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (qint : ∀ (z : ℂ), z ∈ interior (((P L + q))) ↔ (A q a).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) + * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q + a).im)) z.im - z.re)) (qfront : frontier (((P L q))) = segment ℝ (A q a) (B q b) ∪ segment ℝ + (A q a) ⟨(h L q l), (A q a).im⟩ ∪ segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ segment ℝ ⟨(h L + q l), (A q a).im⟩ ⟨(h L q l), (B q b).im⟩) (dint : ∀ (z : ℂ), z ∈ interior (((F L q) b)) ↔ (A + q a).im < z.im ∧ z.im < (x q).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y + => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) z.im - + z.re)) (dfront : frontier (((F L q) b)) = segment ℝ (A q a) (x q) ∪ segment ℝ (A q a) ⟨(h L q + l), (A q a).im⟩ ∪ segment ℝ (x q) ⟨(h L q l), (x q).im⟩ ∪ segment ℝ ⟨(h L q l), (A q a).im⟩ + ⟨(h L q l), (x q).im⟩) (uint : ∀ (z : ℂ), z ∈ interior (((F L q) a)) ↔ (x q).im < z.im ∧ z.im + < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y => (x q).re + ((B q + b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - z.re)) (ufront : + frontier (((F L q) a)) = segment ℝ (x q) (B q b) ∪ segment ℝ (x q) ⟨(h L q l), (x q).im⟩ ∪ + segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ segment ℝ ⟨(h L q l), (x q).im⟩ ⟨(h L q l), (B q + b).im⟩) (tint : ∀ (z : ℂ), z ∈ interior (((F L q) l)) ↔ 0 < (σ q l) * ((fun y => (A q a).re + + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re) ∧ 0 < + (σ q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x + q).im - (A q a).im)) z.im) ∧ 0 < (σ q l) * (z.re - (fun y => (x q).re + ((B q b).re - (x + q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im)) (tfront : frontier (((F L q) l)) = + segment ℝ (x q) (A q a) ∪ segment ℝ (x q) (B q b) ∪ segment ℝ (A q a) (B q b)) (slots : ∀ (c + j : Fin 3), (fun c => ApollonianSuperharmonic.P4828T1Step + (ApollonianSuperharmonic.P4828T1Rotate q c)) c j.succ = if j = 0 then q 0 else q (j + + c).succ) (hal : a ≠ l) (hbl : b ≠ l) (hab : a ≠ b) (hP : (P L q) = convexHull ℝ ({(A q a), (B + q b), ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hD : (F L q) b = + convexHull ℝ ({(A q a), (x q), ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), (x q).im⟩} : Set ℂ)) (hC + : (F L q) l = convexHull ℝ ({(x q), (A q a), (B q b)} : Set ℂ)) (hU : (F L q) a = convexHull + ℝ ({(x q), (B q b), ⟨(h L q l), (x q).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hAx : ((p q) + a.succ).im < (x q).im) (hxB : (x q).im < ((p q) b.succ).im) (c d : Fin 3) (hcd : c ≠ d) : + Disjoint (interior ((F L q) c)) (interior ((F L q) d)) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let P := P4909T1ParentPolygon L q + let F (c : Fin 3) := P4909T1ParentPolygon L (s c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + have hσ : σ ^ 2 = 1 := hσ q l + have side (i : Fin 4) (hi : 0 < (q i).1) : 0 < σ * ((p i).re - h) := side L q l hside i hi + let a₀ : Fin 3 := if l = 0 then 1 else 0 + let b₀ : Fin 3 := if l = 2 then 1 else 2 + have ha₀ : a₀ ≠ l := ha₀ L q l hl hpos hnormal hside + have hb₀ : b₀ ≠ l := hb₀ L q l hl hpos hnormal hside + have hab₀ : a₀ ≠ b₀ := hab₀ L q l hl hpos hnormal hside + have hp₀ := (P4953T1LiteralHulls L q l a₀ b₀ ha₀ hb₀ hab₀ hl + (hpos a₀ ha₀) (hpos b₀ hb₀) hzero).1 + have hheight := P4953T1HullHeight h (p a₀.succ) (p b₀.succ) x (by + rw [← hp₀]; exact hinside) + have hne : (p a₀.succ).im ≠ (p b₀.succ).im := hne L q l hl hpos hzero hnormal hside hinside + let A := p a.succ + let B := p b.succ + have ha := hpos a hal + have hb := hpos b hbl + have classes (c : Fin 3) : c = l ∨ c = a ∨ c = b := classes l a b hal hbl hab c + have hA := side a.succ ha + have hB := side b.succ hb + have hx := side 0 hzero + have hxi := (qint x).mp hinside + have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP + have hxP : x ∈ P := hxP L q hinside + have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB + have convexP : Convex ℝ P := convexP L q + have subC : F l ⊆ P := subC L q l hinside a b hP hC + have subU : F a ⊆ P := subU L q l hinside a b qmem qint hP hU hAx hxB + have subD : F b ⊆ P := subD L q l hinside a b qmem qint hP hD hAx hxB + have root (c : Fin 3) : s c (0 : Fin 3).succ = q 0 := root q slots c + have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := keep q slots c i hi + have radial (c i : Fin 3) (hi : i ≠ c) (hpi : 0 < (q i.succ).1) : + segment ℝ x (p i.succ) ⊆ P4909T1ParentEdges L (s c) := radial L q hzero slots c i hi hpi + have retained (c i j : Fin 3) (hi : i ≠ c) (hj : j ≠ c) + (hij : i ≠ j) (hpi : 0 < (q i.succ).1) (hpj : 0 < (q j.succ).1) : + segment ℝ (p i.succ) (p j.succ) ⊆ P4909T1ParentEdges L (s c) := retained L q slots c i j + hi hj hij hpi hpj + have rootFoot (c : Fin 3) (hc : l ≠ c) : + segment ℝ x (foot x) ⊆ P4909T1ParentEdges L (s c) := rootFoot L q l hl hzero slots c hc + have retainedFoot (c i : Fin 3) (hc : l ≠ c) (hi : i ≠ c) + (hpi : 0 < (q i.succ).1) : + segment ℝ (p i.succ) (foot (p i.succ)) ⊆ P4909T1ParentEdges L (s c) := retainedFoot L q l + hl slots c i hc hi hpi + have lineCarrier (c : Fin 3) (hc : l ≠ c) : + {z : ℂ | z.re = h} ⊆ P4909T1ParentEdges L (s c) := lineCarrier L q l hl slots c hc + have footLine (u v : ℂ) : segment ℝ (foot u) (foot v) ⊆ {z : ℂ | z.re = h} := footLine L q l u v + have frontC : frontier (F l) ⊆ P4909T1ParentEdges L (s l) := frontC L q l hpos hzero a b + tfront slots hal hbl hab + have frontU : frontier (F a) ⊆ P4909T1ParentEdges L (s a) := frontU L q l hl hpos hzero a b + ufront slots hal hbl hab + have frontD : frontier (F b) ⊆ P4909T1ParentEdges L (s b) := frontD L q l hl hpos hzero a b + dfront slots hal hbl hab + have sepCU : Disjoint (interior (F l)) (interior (F a)) := sepCU L q l a b uint tint + have sepCD : Disjoint (interior (F l)) (interior (F b)) := sepCD L q l a b dint tint + have sepUD : Disjoint (interior (F a)) (interior (F b)) := sepUD L q l a b dint uint + change (Disjoint (interior (F c)) (interior (F d))) + rcases classes c with rfl | rfl | rfl + · rcases classes d with rfl | rfl | rfl + · exact (hcd rfl).elim + · exact sepCU + · exact sepCD + · rcases classes d with rfl | rfl | rfl + · exact sepCU.symm + · exact (hcd rfl).elim + · exact sepUD + · rcases classes d with rfl | rfl | rfl + · exact sepCD.symm + · exact sepUD.symm + · exact (hcd rfl).elim + +private theorem cover (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (a : Fin 3) (b : Fin 3) + (qmem : ∀ (z : ℂ), z ∈ ((P L q)) ↔ (A q a).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * + (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - + (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re)) (dmem : ∀ (z : ℂ), z ∈ ((F L q) b) ↔ + (A q a).im ≤ z.im ∧ z.im ≤ (x q).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun + y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) z.im + - z.re)) (tlower : ∀ (z : ℂ), (A q a).im ≤ z.im → z.im ≤ (x q).im → (z ∈ ((F L q) l) ↔ 0 ≤ (σ + q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im + - (A q a).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - + (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (umem : ∀ (z : ℂ), z ∈ ((F L q) a) ↔ + (x q).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun + y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - + z.re)) (tupper : ∀ (z : ℂ), (x q).im ≤ z.im → z.im ≤ (B q b).im → (z ∈ ((F L q) l) ↔ 0 ≤ (σ q + l) * (z.re - (fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x + q).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q + a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (z : ℂ) (hz : z ∈ (P L q)) : ∃ c, z ∈ (F L + q) c := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let P := P4909T1ParentPolygon L q + let F (c : Fin 3) := P4909T1ParentPolygon L (s c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + let A := p a.succ + let B := p b.succ + change (∃ c, z ∈ F c) + have hz' := (qmem z).mp hz + by_cases hm : z.im ≤ x.im + · by_cases he : 0 ≤ σ * (A.re + (x.re - A.re) * + (z.im - A.im) / (x.im - A.im) - z.re) + · exact ⟨b, (dmem z).mpr ⟨hz'.1, hm, hz'.2.2.1, he⟩⟩ + · refine ⟨l, (tlower z hz'.1 hm).mpr ⟨?_, hz'.2.2.2⟩⟩ + nlinarith only [he] + · have hm' : x.im ≤ z.im := (not_le.mp hm).le + by_cases he : 0 ≤ σ * (x.re + (B.re - x.re) * + (z.im - x.im) / (B.im - x.im) - z.re) + · exact ⟨a, (umem z).mpr ⟨hm', hz'.2.1, hz'.2.2.1, he⟩⟩ + · refine ⟨l, (tupper z hm' hz'.2.1).mpr ⟨?_, hz'.2.2.2⟩⟩ + nlinarith only [he] + +end LineFanConstruction + +theorem P4909T1LineFan (L : ℝ) (q : Fin 4 → CircleCoordinates) + (l : Fin 3) (hl : (q l.succ).1 = 0) + (hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1) + (hzero : 0 < (q 0).1) + (hnormal : (q l.succ).2 = -1 ∨ (q l.succ).2 = 1) + (hside : ∀ i : Fin 4, 0 < (q i).1 → + if (q l.succ).2 = -1 then L < (((q i).2 : ℂ) / ((q i).1 : ℝ)).re + else (((q i).2 : ℂ) / ((q i).1 : ℝ)).re < L + 2) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) : + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + (∀ b, F b ⊆ P ∧ (0 < (q b.succ).1 → p b.succ ∉ F b) ∧ + frontier (F b) ⊆ P4909T1ParentEdges L (s b)) ∧ + (∀ b c, b ≠ c → Disjoint (interior (F b)) (interior (F c))) ∧ + P = ⋃ b, F b ∧ + (∀ z ∈ interior P, + (∀ i : Fin 4, 0 < (q i).1 → z ∉ segment ℝ (p 0) (p i)) → + (∀ k : Fin 3, (q k.succ).1 = 0 → + z ∉ segment ℝ (p 0) + ⟨if (q k.succ).2 = -1 then L else L + 2, (p 0).im⟩) → + ∃ b, z ∈ interior (F b)) := by +-- BODY + classical + dsimp only + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + let P := P4909T1ParentPolygon L q + let F (c : Fin 3) := P4909T1ParentPolygon L (s c) + let h := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + have hσ : σ ^ 2 = 1 := LineFanConstruction.hσ q l + have side (i : Fin 4) (hi : 0 < (q i).1) : 0 < σ * ((p i).re - h) := LineFanConstruction.side L + q l hside i hi + -- The interior assumption, not an extra hypothesis, orders the parent heights. + let a₀ : Fin 3 := if l = 0 then 1 else 0 + let b₀ : Fin 3 := if l = 2 then 1 else 2 + have ha₀ : a₀ ≠ l := LineFanConstruction.ha₀ L q l hl hpos hnormal hside + have hb₀ : b₀ ≠ l := LineFanConstruction.hb₀ L q l hl hpos hnormal hside + have hab₀ : a₀ ≠ b₀ := LineFanConstruction.hab₀ L q l hl hpos hnormal hside + have hp₀ := (P4953T1LiteralHulls L q l a₀ b₀ ha₀ hb₀ hab₀ hl + (hpos a₀ ha₀) (hpos b₀ hb₀) hzero).1 + change P = convexHull ℝ + ({p a₀.succ, p b₀.succ, ⟨h, (p a₀.succ).im⟩, ⟨h, (p b₀.succ).im⟩} : Set ℂ) at hp₀ + have hheight := P4953T1HullHeight h (p a₀.succ) (p b₀.succ) x (by + rw [← hp₀]; exact hinside) + have hne : (p a₀.succ).im ≠ (p b₀.succ).im := LineFanConstruction.hne L q l hl hpos hzero + hnormal hside hinside + obtain ⟨a, b, hal, hbl, hab, hAx, hxB⟩ : ∃ a b : Fin 3, + a ≠ l ∧ b ≠ l ∧ a ≠ b ∧ (p a.succ).im < x.im ∧ x.im < (p b.succ).im := by + rcases lt_or_gt_of_ne hne with hh | hh + · exact ⟨a₀, b₀, ha₀, hb₀, hab₀, by + simpa only [min_eq_left hh.le] using hheight.1, by + simpa only [max_eq_right hh.le] using hheight.2⟩ + · exact ⟨b₀, a₀, hb₀, ha₀, hab₀.symm, by + simpa only [min_eq_right hh.le] using hheight.1, by + simpa only [max_eq_left hh.le] using hheight.2⟩ + let A := p a.succ + let B := p b.succ + have ha := hpos a hal + have hb := hpos b hbl + have classes (c : Fin 3) : c = l ∨ c = a ∨ c = b := LineFanConstruction.classes l a b hal hbl + hab c + obtain ⟨hP, hC, hU, hD, slots⟩ := + P4953T1LiteralHulls L q l a b hal hbl hab hl ha hb hzero + change P = convexHull ℝ ({A, B, foot A, foot B} : Set ℂ) at hP + change F l = convexHull ℝ ({x, A, B} : Set ℂ) at hC + change F a = convexHull ℝ ({x, B, foot x, foot B} : Set ℂ) at hU + change F b = convexHull ℝ ({A, x, foot A, foot x} : Set ℂ) at hD + have hA := side a.succ ha + have hB := side b.succ hb + have hx := side 0 hzero + obtain ⟨qmem, qint, qfront⟩ := + P4953T1QuadrilateralSections h σ A B hσ hA hB (hAx.trans hxB) + obtain ⟨dmem, dint, dfront⟩ := + P4953T1QuadrilateralSections h σ A x hσ hA hx hAx + obtain ⟨umem, uint, ufront⟩ := + P4953T1QuadrilateralSections h σ x B hσ hx hB hxB + rw [← hP] at qmem qint qfront + rw [← hD] at dmem dint dfront + rw [← hU] at umem uint ufront + have hxi := (qint x).mp hinside + obtain ⟨tint, tlower, tupper, tfront⟩ := + P4953T1TriangleSections σ A x B hAx hxB hxi.2.2.2 + rw [← hC] at tint tlower tupper tfront + -- Containment uses only convexity and the inserted foot's actual height. + have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := LineFanConstruction.hvertices L q l + a b hP + have hxP : x ∈ P := LineFanConstruction.hxP L q hinside + have hfxP : foot x ∈ P := LineFanConstruction.hfxP L q l hinside a b qmem qint hAx hxB + have convexP : Convex ℝ P := LineFanConstruction.convexP L q + have subC : F l ⊆ P := LineFanConstruction.subC L q l hinside a b hP hC + have subU : F a ⊆ P := LineFanConstruction.subU L q l hinside a b qmem qint hP hU hAx hxB + have subD : F b ⊆ P := LineFanConstruction.subD L q l hinside a b qmem qint hP hD hAx hxB + have sub (c : Fin 3) : F c ⊆ P := LineFanConstruction.sub L q l hl hpos hzero hnormal hside + hinside a b qmem dmem tlower umem tupper qint qfront dint dfront uint ufront tint tfront + hal hbl hab hP hD hC hU hAx hxB c + have omitted (c : Fin 3) (hc : 0 < (q c.succ).1) : p c.succ ∉ F c := + LineFanConstruction.omitted L q l hl hpos hzero hnormal hside hinside a b qmem dmem tlower + umem tupper qint qfront dint dfront uint ufront tint tfront hal hbl hab hP hD hC hU hAx hxB + c hc + -- Build the literal edge witnesses without identifying same-center records. + have root (c : Fin 3) : s c (0 : Fin 3).succ = q 0 := LineFanConstruction.root q slots c + have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := LineFanConstruction.keep + q slots c i hi + have radial (c i : Fin 3) (hi : i ≠ c) (hpi : 0 < (q i.succ).1) : + segment ℝ x (p i.succ) ⊆ P4909T1ParentEdges L (s c) := LineFanConstruction.radial L q + hzero slots c i hi hpi + have retained (c i j : Fin 3) (hi : i ≠ c) (hj : j ≠ c) + (hij : i ≠ j) (hpi : 0 < (q i.succ).1) (hpj : 0 < (q j.succ).1) : + segment ℝ (p i.succ) (p j.succ) ⊆ P4909T1ParentEdges L (s c) := + LineFanConstruction.retained L q slots c i j hi hj hij hpi hpj + have rootFoot (c : Fin 3) (hc : l ≠ c) : + segment ℝ x (foot x) ⊆ P4909T1ParentEdges L (s c) := LineFanConstruction.rootFoot L q l + hl hzero slots c hc + have retainedFoot (c i : Fin 3) (hc : l ≠ c) (hi : i ≠ c) + (hpi : 0 < (q i.succ).1) : + segment ℝ (p i.succ) (foot (p i.succ)) ⊆ P4909T1ParentEdges L (s c) := + LineFanConstruction.retainedFoot L q l hl slots c i hc hi hpi + have lineCarrier (c : Fin 3) (hc : l ≠ c) : + {z : ℂ | z.re = h} ⊆ P4909T1ParentEdges L (s c) := LineFanConstruction.lineCarrier L q l + hl slots c hc + have footLine (u v : ℂ) : segment ℝ (foot u) (foot v) ⊆ {z : ℂ | z.re = h} := + LineFanConstruction.footLine L q l u v + have frontC : frontier (F l) ⊆ P4909T1ParentEdges L (s l) := LineFanConstruction.frontC L q l + hpos hzero a b tfront slots hal hbl hab + have frontU : frontier (F a) ⊆ P4909T1ParentEdges L (s a) := LineFanConstruction.frontU L q l + hl hpos hzero a b ufront slots hal hbl hab + have frontD : frontier (F b) ⊆ P4909T1ParentEdges L (s b) := LineFanConstruction.frontD L q l + hl hpos hzero a b dfront slots hal hbl hab + have front (c : Fin 3) : frontier (F c) ⊆ P4909T1ParentEdges L (s c) := + LineFanConstruction.front L q l hl hpos hzero hnormal hside hinside a b qmem dmem tlower + umem tupper qint qfront dint dfront uint ufront tint tfront slots hal hbl hab hP hD hC hU + hAx hxB c + -- Strict affine inequalities separate the central and lateral interiors. + have sepCU : Disjoint (interior (F l)) (interior (F a)) := LineFanConstruction.sepCU L q l a b + uint tint + have sepCD : Disjoint (interior (F l)) (interior (F b)) := LineFanConstruction.sepCD L q l a b + dint tint + have sepUD : Disjoint (interior (F a)) (interior (F b)) := LineFanConstruction.sepUD L q l a b + dint uint + have sep (c d : Fin 3) (hcd : c ≠ d) : Disjoint (interior (F c)) (interior (F d)) := + LineFanConstruction.sep L q l hl hpos hzero hnormal hside hinside a b qmem dmem tlower umem + tupper qint qfront dint dfront uint ufront tint tfront slots hal hbl hab hP hD hC hU hAx + hxB c d hcd + have cover (z : ℂ) (hz : z ∈ P) : ∃ c, z ∈ F c := LineFanConstruction.cover L q l a b qmem dmem + tlower umem tupper z hz + refine ⟨fun c => ⟨sub c, omitted c, front c⟩, sep, ?_, ?_⟩ + · apply Set.Subset.antisymm + · intro z hz + exact Set.mem_iUnion.mpr (cover z hz) + · intro z hz + obtain ⟨c, hc⟩ := Set.mem_iUnion.mp hz + exact sub c hc + · intro z hz hseams hfeet + have noA : z ∉ segment ℝ x A := hseams a.succ ha + have noB : z ∉ segment ℝ x B := hseams b.succ hb + have noFoot : z ∉ segment ℝ x (foot x) := hfeet l hl + have noLine (he : z.re = h) : False := by + have hp := ((qint z).mp hz).2.2.1 + rw [he, sub_self, mul_zero] at hp + exact (lt_irrefl 0) hp + have noOuter (he : z ∈ segment ℝ A B ∪ segment ℝ A (foot A) ∪ + segment ℝ B (foot B)) : False := by + have hf : z ∈ frontier P := by rw [qfront]; exact Or.inl he + exact hf.2 hz + obtain ⟨c, hc⟩ := cover z (interior_subset hz) + refine ⟨c, ?_⟩ + by_contra hn + have hf : z ∈ frontier (F c) := ⟨subset_closure hc, hn⟩ + rcases classes c with rfl | rfl | rfl + · rw [tfront] at hf + rcases hf with (hf | hf) | hf + · exact noA hf + · exact noB hf + · exact noOuter (Or.inl (Or.inl hf)) + · rw [ufront] at hf + rcases hf with ((hf | hf) | hf) | hf + · exact noB hf + · exact noFoot hf + · exact noOuter (Or.inr hf) + · exact noLine (footLine x B hf) + · rw [dfront] at hf + rcases hf with ((hf | hf) | hf) | hf + · exact noA (by rwa [segment_symm] at hf) + · exact noOuter (Or.inl (Or.inr hf)) + · exact noFoot hf + · exact noLine (footLine A x hf) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4909T1OmittedDiskBarrier.lean b/LeanPool/ApollonianSuperharmonic/P4909T1OmittedDiskBarrier.lean new file mode 100644 index 0000000000..178a19277e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4909T1OmittedDiskBarrier.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Complex.Norm +public import Mathlib.Topology.Order.IntermediateValue +public import Mathlib.Topology.Order.DenselyOrdered + +-- [TABLET NODE: P4909T1OmittedDiskBarrier] + +/-! +# P4909T1OmittedDiskBarrier + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4909T1OmittedDiskBarrier (P : Set ℂ) (a : ℂ) (r : ℝ) + (hr : 0 < r) (ha : a ∉ P) + (hboundary : Disjoint (frontier P) (Metric.ball a r)) : + ∀ z ∈ interior P, r < dist z a := by +-- BODY + have path_cont (z : ℂ) : Continuous (fun t : ℝ => (t : ℂ) * (z - a) + a) := by + rw [Metric.continuous_iff] + intro t ε hε + have hn := norm_nonneg (z - a) + refine ⟨ε / (‖z - a‖ + 1), div_pos hε (by linarith), ?_⟩ + intro u hu + have hdiff : (u : ℂ) * (z - a) + a - ((t : ℂ) * (z - a) + a) = + ((u - t : ℝ) : ℂ) * (z - a) := by push_cast; ring + rw [dist_eq_norm, hdiff, Complex.norm_mul, Complex.norm_real, Real.norm_eq_abs] + have hu' : |u - t| < ε / (‖z - a‖ + 1) := by + simpa only [Real.dist_eq] using hu + have hprod := (lt_div_iff₀ (by linarith : 0 < ‖z - a‖ + 1)).mp hu' + nlinarith [abs_nonneg (u - t)] + have hball : a ∈ Metric.ball a r := Metric.mem_ball_self hr + have hdisj : Disjoint (interior P) (interior Pᶜ) := by + rw [Set.disjoint_left] + intro z hz hc + exact (interior_subset hc) (interior_subset hz) + have hcover : Metric.ball a r ⊆ interior P ∪ interior Pᶜ := by + rw [← compl_frontier_eq_union_interior] + intro z hz + exact fun h => Set.disjoint_left.mp hboundary h hz + have hopen : Disjoint (interior P) (Metric.ball a r) := by + rw [Set.disjoint_left] + intro z hz hb + let γ (t : ℝ) := (t : ℂ) * (z - a) + a + have hγ : Continuous γ := path_cont z + have hconn : IsPreconnected (γ '' Set.Icc (0 : ℝ) 1) := + isPreconnected_Icc.image γ hγ.continuousOn + have hsub : γ '' Set.Icc (0 : ℝ) 1 ⊆ Metric.ball a r := by + rintro w ⟨t, ht, rfl⟩ + change dist (γ t) a < r + rw [dist_eq_norm] + dsimp [γ] + rw [add_sub_cancel_right, Complex.norm_mul, Complex.norm_real, + Real.norm_eq_abs, abs_of_nonneg ht.1] + have hb' : ‖z - a‖ < r := by simpa only [Metric.mem_ball, dist_eq_norm] using hb + exact lt_of_le_of_lt (mul_le_mul_of_nonneg_right ht.2 (norm_nonneg _)) + (by simpa only [one_mul] using hb') + have ha' : a ∈ γ '' Set.Icc (0 : ℝ) 1 := by + exact ⟨0, ⟨le_rfl, zero_le_one⟩, by simp [γ]⟩ + have hz' : z ∈ γ '' Set.Icc (0 : ℝ) 1 := by + exact ⟨1, ⟨zero_le_one, le_rfl⟩, by simp [γ]⟩ + rcases hconn.subset_or_subset isOpen_interior isOpen_interior hdisj + (hsub.trans hcover) with hin | hout + · exact ha (interior_subset (hin ha')) + · exact Set.disjoint_left.mp hdisj hz (hout hz') + have hclosed := hopen.closure_right isOpen_interior + intro z hz + apply lt_of_not_ge + intro hle + have hzclosure : z ∈ closure (Metric.ball a r) := by + let γ (t : ℝ) := (t : ℂ) * (z - a) + a + have hγ : Continuous γ := path_cont z + have h1 : (1 : ℝ) ∈ closure (Set.Ico (0 : ℝ) 1) := by + rw [closure_Ico zero_ne_one] + exact ⟨zero_le_one, le_rfl⟩ + have hmap : Set.MapsTo γ (Set.Ico (0 : ℝ) 1) (Metric.ball a r) := by + intro t ht + change dist (γ t) a < r + rw [dist_eq_norm] + dsimp [γ] + rw [add_sub_cancel_right, Complex.norm_mul, Complex.norm_real, + Real.norm_eq_abs, abs_of_nonneg ht.1] + have hn : ‖z - a‖ ≤ r := by simpa only [dist_eq_norm] using hle + calc + t * ‖z - a‖ ≤ t * r := mul_le_mul_of_nonneg_left hn ht.1 + _ < r := by nlinarith [hr, ht.2] + have hlim := hγ.continuousWithinAt.mem_closure h1 hmap + simpa only [γ, Complex.ofReal_one, one_mul, sub_add_cancel] using hlim + exact Set.disjoint_left.mp hclosed hz hzclosure + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4909T1ParentEdges.lean b/LeanPool/ApollonianSuperharmonic/P4909T1ParentEdges.lean new file mode 100644 index 0000000000..2fcc8f7f15 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4909T1ParentEdges.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4909T1ParentPolygon + +-- [TABLET NODE: P4909T1ParentEdges] + +/-! +# P4909T1ParentEdges + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $p_i=w_i/c_i$ for positive parents of $q$. +The set $E_L(q)$ consists of all center-to-center segments $[p_i,p_j]$ +for distinct positive parent indices, all center-to-foot segments +$[p_i,(h_k,\operatorname{Im}p_i)]$ for a positive parent $i$ and a +zero-curvature parent $k$, and the entire lines $X=h_k$ for these zero +parents. Here $h_k=L$ if $w_k=-1$, and $h_k=L+2$ otherwise. +It is a boundary carrier, not a claim that every listed segment is an edge. +-/ +def P4909T1ParentEdges (L : ℝ) (q : Fin 4 → CircleCoordinates) : Set ℂ := +-- BODY + let p (i : Fin 3) : ℂ := (q i.succ).2 / ((q i.succ).1 : ℝ) + {z | (∃ i j : Fin 3, i ≠ j ∧ 0 < (q i.succ).1 ∧ + 0 < (q j.succ).1 ∧ z ∈ segment ℝ (p i) (p j)) ∨ + (∃ i k : Fin 3, 0 < (q i.succ).1 ∧ (q k.succ).1 = 0 ∧ + z ∈ segment ℝ (p i) + ⟨if (q k.succ).2 = -1 then L else L + 2, (p i).im⟩) ∨ + (∃ k : Fin 3, (q k.succ).1 = 0 ∧ + z.re = if (q k.succ).2 = -1 then L else L + 2)} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4909T1ParentPolygon.lean b/LeanPool/ApollonianSuperharmonic/P4909T1ParentPolygon.lean new file mode 100644 index 0000000000..0f74511df9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4909T1ParentPolygon.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates +public import Mathlib.Analysis.Complex.Norm +public import Mathlib.Analysis.Convex.Hull +public import Mathlib.LinearAlgebra.Complex.Module + +-- [TABLET NODE: P4909T1ParentPolygon] + +/-! +# P4909T1ParentPolygon + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $L\in\mathbb R$ and +$q:\operatorname{Fin}4\to\texttt{CircleCoordinates}$ be arbitrary, with +$q_j=(c_j,w_j)\in\mathbb Z\times\mathbb Z[i]$ as in +`CircleCoordinates`. The parent indices are $1,2,3$; no +properness, tangency, or unit-normal assumption is imposed. Put +$$ + J_+=\{j\in\{1,2,3\}:c_j>0\},\qquad + J_0=\{k\in\{1,2,3\}:c_k=0\}. +$$ +For $j\in J_+$ let $p_j=w_j/c_j\in\mathbb C$, using the natural +embeddings of the coordinates, and for $k\in J_0$ set +$$ + h_k=\begin{cases} + L,&w_k=-1,\\ + L+2,&w_k\ne-1. + \end{cases} +$$ +The closed parent polygon, denoted by `P4909T1ParentPolygon`, +is the real convex hull +$$ + V_L(q)=\{p_j:j\in J_+\}\cup + \{h_k+i\operatorname{Im}p_j:j\in J_+,\ k\in J_0\},\qquad + P_L(q)=\operatorname{conv}_{\mathbb R}V_L(q). +$$ +Negative-curvature parents contribute no vertices, and the entry $q_0$ +is entirely unused. In particular, if there are no positive parents, +the vertex set and hull are empty. + +For arbitrary raw zero-curvature coordinates, the otherwise branch +$h_k=L+2$ is only a convention making this definition total. It does not +assert that $w_k=1$ or that $(0,w_k)$ represents a band line. +In the paper's band between $X=L$ and $X=L+2$, the normalized coordinates +$(0,-1)$ and $(0,1)$ represent the left and right supporting lines, +respectively. For these coordinates, the added points are precisely the +orthogonal projections of the positive-parent centers onto the +corresponding supporting line. The offset $L$ is contextual data, not +part of a line's curvature coordinates; for the paper's band +$\mathcal B_m$ it is $L=2m$. + +If all three parents have positive curvature and their centers are +noncollinear, $P_L(q)$ is their nondegenerate center triangle. If exactly +two parents have positive curvature and the remaining parent is +$(0,-1)$ or $(0,1)$, the vertex set consists of the two centers and their +feet on the corresponding supporting line. Provided that the centers +have distinct heights and lie strictly on its inward side ($X>L$ for +$(0,-1)$, or $X z.re) := by + classical + apply LipschitzWith.continuous (K := 1) + apply LipschitzWith.mk_one + intro z w + simpa only [Real.dist_eq, ← Complex.sub_re, Complex.dist_eq] using + Complex.abs_re_le_norm (z - w) + +private theorem contIm : Continuous (fun z : ℂ => z.im) := by + classical + apply LipschitzWith.continuous (K := 1) + apply LipschitzWith.mk_one + intro z w + simpa only [Real.dist_eq, ← Complex.sub_im, Complex.dist_eq] using + Complex.abs_im_le_norm (z - w) + +private theorem affineContinuous (f : ℂ →ᵃ[ℝ] ℝ) : Continuous f := by + classical + have contRe : Continuous (fun z : ℂ => z.re) := contRe + have contIm : Continuous (fun z : ℂ => z.im) := contIm + have hf (z : ℂ) : f z = z.re * f.linear 1 + z.im * f.linear Complex.I + f 0 := by + have hz : z = z.re • (1 : ℂ) + z.im • Complex.I := by + apply Complex.ext <;> simp [Complex.real_smul] + calc + f z = f.linear z + f 0 := by + simpa only [vadd_eq_add, add_zero] using f.map_vadd 0 z + _ = z.re * f.linear 1 + z.im * f.linear Complex.I + f 0 := by + conv_lhs => arg 1; rw [hz] + simp only [map_add, map_smul, smul_eq_mul] + have hc := ((contRe.mul_const (f.linear 1)).add + (contIm.mul_const (f.linear Complex.I))).add_const (f 0) + exact (show (fun z => z.re * f.linear 1 + z.im * f.linear Complex.I + f 0) = f + from funext fun z => (hf z).symm) ▸ hc + +private theorem affineShift (f : ℂ →ᵃ[ℝ] ℝ) (z a b : ℂ) (t : ℝ) : + f (t • (a - b) + z) = t * (f a - f b) + f z := by + classical + change f (t • (a -ᵥ b) +ᵥ z) = _ + rw [f.map_vadd, map_smul, f.linear_apply_vsub] + rfl + +private theorem interiorHull (D : AffineBasis (Fin 3) ℝ ℂ) : + interior (convexHull ℝ (Set.range D)) = {z | ∀ i, 0 < D.coord i z} := by + classical + have smallStep (z d : ℂ) (ε : ℝ) (hε : 0 < ε) : + ∃ t : ℝ, 0 < t ∧ t • d + z ∈ Metric.ball z ε := smallStep z d ε hε + have affineContinuous (f : ℂ →ᵃ[ℝ] ℝ) : Continuous f := affineContinuous f + have affineShift (f : ℂ →ᵃ[ℝ] ℝ) (z a b : ℂ) (t : ℝ) : + f (t • (a - b) + z) = t * (f a - f b) + f z := affineShift f z a b t + apply Set.Subset.antisymm + · intro z hz i + have hc : ∀ i, 0 ≤ D.coord i z := + (Set.ext_iff.mp D.convexHull_eq_nonneg_coord z).mp (interior_subset hz) + by_contra hi + have hi0 : D.coord i z = 0 := le_antisymm (not_lt.mp hi) (hc i) + obtain ⟨ε, hε, hball⟩ := Metric.mem_nhds_iff.mp (mem_interior_iff_mem_nhds.mp hz) + obtain ⟨j, hji⟩ := exists_ne i + obtain ⟨t, ht, hstep⟩ := smallStep z (D j - D i) ε hε + have hnonneg : 0 ≤ D.coord i (t • (D j - D i) + z) := + (Set.ext_iff.mp D.convexHull_eq_nonneg_coord _).mp (hball hstep) i + rw [affineShift, D.coord_apply_ne hji.symm, D.coord_apply_eq, hi0] at hnonneg + linarith + · have hop : IsOpen {z | ∀ i, 0 < D.coord i z} := by + rw [Set.ofPred_forall] + exact isOpen_iInter_of_finite fun i => isOpen_lt continuous_const (affineContinuous _) + apply interior_maximal _ hop + intro z hz + exact (Set.ext_iff.mp D.convexHull_eq_nonneg_coord z).mpr (fun i => (hz i).le) + +private theorem spanOfInterior (S : Set ℂ) (x : ℂ) + (hx : x ∈ interior (convexHull ℝ S)) : affineSpan ℝ S = ⊤ := by + classical + have smallStep (z d : ℂ) (ε : ℝ) (hε : 0 < ε) : + ∃ t : ℝ, 0 < t ∧ t • d + z ∈ Metric.ball z ε := smallStep z d ε hε + apply top_unique + intro z _ + obtain ⟨ε, hε, hball⟩ := Metric.mem_nhds_iff.mp (mem_interior_iff_mem_nhds.mp hx) + obtain ⟨t, ht, hstep⟩ := smallStep x (z - x) ε hε + have hxS := convexHull_subset_affineSpan (𝕜 := ℝ) S (interior_subset hx) + have hyS := convexHull_subset_affineSpan (𝕜 := ℝ) S (hball hstep) + have hzS := (affineSpan ℝ S).smul_vsub_vadd_mem t⁻¹ hyS hxS hxS + change t⁻¹ • ((t • (z - x) + x) - x) + x ∈ affineSpan ℝ S at hzS + simpa only [add_sub_cancel_right, smul_smul, inv_mul_cancel₀ ht.ne', one_smul, + sub_add_cancel] using hzS + +private noncomputable abbrev p (q : Fin 4 → CircleCoordinates) (i : Fin 4) : ℂ := by + classical + exact (q i).2 / ((q i).1 : ℝ) + +private noncomputable abbrev s (q : Fin 4 → CircleCoordinates) (b : Fin 3) := P4828T1Step + (P4828T1Rotate q b) + +private noncomputable abbrev P (L : ℝ) (q : Fin 4 → CircleCoordinates) := P4909T1ParentPolygon L q + +private noncomputable abbrev F (L : ℝ) (q : Fin 4 → CircleCoordinates) (b : Fin 3) := + P4909T1ParentPolygon L ((s q) b) + +private noncomputable abbrev v (q : Fin 4 → CircleCoordinates) : Fin 3 → ℂ := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + exact fun i => p i.succ + +private theorem parentHull (L : ℝ) (t : Fin 4 → CircleCoordinates) + (ht : ∀ i : Fin 3, 0 < (t i.succ).1) : + P4909T1ParentPolygon L t = + convexHull ℝ (Set.range fun i : Fin 3 => + ((t i.succ).2 : ℂ) / ((t i.succ).1 : ℝ)) := by + classical + apply congrArg (convexHull ℝ) + ext z + constructor + · rintro ⟨i, hi, hz | ⟨k, hk, hz⟩⟩ + · exact ⟨i, hz.symm⟩ + · exact False.elim ((ne_of_gt (ht k)) hk) + · rintro ⟨i, rfl⟩ + exact ⟨i, ht i, Or.inl rfl⟩ + +private theorem hP (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) : (P + L q) = convexHull ℝ (Set.range (v q)) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let P := P4909T1ParentPolygon L q + let v : Fin 3 → ℂ := fun i => p i.succ + have parentHull (t : Fin 4 → CircleCoordinates) + (ht : ∀ i : Fin 3, 0 < (t i.succ).1) : + P4909T1ParentPolygon L t = + convexHull ℝ (Set.range fun i : Fin 3 => + ((t i.succ).2 : ℂ) / ((t i.succ).1 : ℝ)) := parentHull L t ht + change (P = convexHull ℝ (Set.range v)) + exact parentHull q (fun i => hpos i.succ) + +private theorem hxmem (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) : (p q) 0 ∈ + interior (convexHull ℝ (Set.range (v q))) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let P := P4909T1ParentPolygon L q + let v : Fin 3 → ℂ := fun i => p i.succ + have hP : P = convexHull ℝ (Set.range v) := hP L q hpos + change (p 0 ∈ interior (convexHull ℝ (Set.range v))) + rw [← hP] + exact hinside + +private theorem hspan (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) : + affineSpan ℝ (Set.range (v q)) = ⊤ := by + classical + have spanOfInterior (S : Set ℂ) (x : ℂ) + (hx : x ∈ interior (convexHull ℝ S)) : affineSpan ℝ S = ⊤ := spanOfInterior S x hx + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let v : Fin 3 → ℂ := fun i => p i.succ + have hxmem : p 0 ∈ interior (convexHull ℝ (Set.range v)) := hxmem L q hpos hinside + change (affineSpan ℝ (Set.range v) = ⊤) + exact spanOfInterior (Set.range v) (p 0) hxmem + +private theorem hvspan (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) : + vectorSpan ℝ (Set.range (v q)) = ⊤ := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let P := P4909T1ParentPolygon L q + let v : Fin 3 → ℂ := fun i => p i.succ + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + change (vectorSpan ℝ (Set.range v) = ⊤) + exact AffineSubspace.vectorSpan_eq_top_of_affineSpan_eq_top + (k := ℝ) (V := ℂ) (P := ℂ) hspan + +private theorem hind (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) : + AffineIndependent ℝ (v q) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let P := P4909T1ParentPolygon L q + let v : Fin 3 → ℂ := fun i => p i.succ + have hvspan : vectorSpan ℝ (Set.range v) = ⊤ := hvspan L q hpos hinside + change (AffineIndependent ℝ v) + apply (affineIndependent_iff_finrank_vectorSpan_eq + (k := ℝ) (V := ℂ) (P := ℂ) v (n := 2) (by norm_num)).2 + rw [hvspan, finrank_top, Complex.finrank_real_complex] + +private noncomputable abbrev A (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < + (q i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) : + AffineBasis (Fin 3) ℝ ℂ := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let v : Fin 3 → ℂ := fun i => p i.succ + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + exact ⟨v, hind, hspan⟩ + +private theorem hmem (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (z : ℂ) : z + ∈ (P L q) ↔ ∀ i, 0 ≤ (A L q hpos hinside).coord i z := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let P := P4909T1ParentPolygon L q + let v : Fin 3 → ℂ := fun i => p i.succ + have hP : P = convexHull ℝ (Set.range v) := hP L q hpos + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + change (z ∈ P ↔ ∀ i, 0 ≤ A.coord i z) + rw [hP] + exact Set.ext_iff.mp A.convexHull_eq_nonneg_coord z + +private theorem hint (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (z : ℂ) : z + ∈ interior (P L q) ↔ ∀ i, 0 < (A L q hpos hinside).coord i z := by + classical + have interiorHull (D : AffineBasis (Fin 3) ℝ ℂ) : + interior (convexHull ℝ (Set.range D)) = {z | ∀ i, 0 < D.coord i z} := interiorHull D + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let P := P4909T1ParentPolygon L q + let v : Fin 3 → ℂ := fun i => p i.succ + have hP : P = convexHull ℝ (Set.range v) := hP L q hpos + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + change (z ∈ interior P ↔ ∀ i, 0 < A.coord i z) + rw [hP] + exact Set.ext_iff.mp (interiorHull A) z + +private noncomputable abbrev alpha (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 + < (q i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) + (i : Fin 3) : ℝ := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let v : Fin 3 → ℂ := fun i => p i.succ + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + exact A.coord i (p 0) + +private theorem alphaPos (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q + i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (i : + Fin 3) : 0 < (alpha L q hpos hinside) i := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let P := P4909T1ParentPolygon L q + let v : Fin 3 → ℂ := fun i => p i.succ + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + have hint (z : ℂ) : z ∈ interior P ↔ ∀ i, 0 < A.coord i z := hint L q hpos hinside z + let alpha (i : Fin 3) : ℝ := A.coord i (p 0) + change (0 < alpha i) + exact (hint (p 0)).mp hinside i + +private noncomputable abbrev u (q : Fin 4 → CircleCoordinates) (b : Fin 3) : Fin 3 → ℂ := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let v : Fin 3 → ℂ := fun i => p i.succ + exact Function.update v b (p 0) + +private theorem huind (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b : Fin 3) + : AffineIndependent ℝ ((u q) b) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let v : Fin 3 → ℂ := fun i => p i.succ + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + let alpha (i : Fin 3) : ℝ := A.coord i (p 0) + have alphaPos (i : Fin 3) : 0 < alpha i := alphaPos L q hpos hinside i + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + change (AffineIndependent ℝ (u b)) + apply hind.affineIndependent_update_of_notMem_affineSpan + intro hx + have heq : Set.EqOn (A.coord b) (AffineMap.const ℝ ℂ (0 : ℝ)) + (v '' {i | i ≠ b}) := by + rintro _ ⟨i, hi, rfl⟩ + exact A.coord_apply_ne hi.symm + have hz := AffineMap.eqOn_affineSpan heq hx + exact (ne_of_gt (alphaPos b)) hz + +private theorem hutot (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b : Fin 3) + : affineSpan ℝ (Set.range ((u q) b)) = ⊤ := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let v : Fin 3 → ℂ := fun i => p i.succ + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + change (affineSpan ℝ (Set.range (u b)) = ⊤) + apply (huind b).affineSpan_eq_top_iff_card_eq_finrank_add_one.mpr + rw [Complex.finrank_real_complex] + rfl + +private noncomputable abbrev B (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < + (q i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b + : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let v : Fin 3 → ℂ := fun i => p i.succ + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + exact ⟨u b, huind b, hutot b⟩ + +private theorem hBself (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b : Fin 3) + : (B L q hpos hinside) b b = (p q) 0 := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let v : Fin 3 → ℂ := fun i => p i.succ + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + change (B b b = p 0) + change Function.update v b (p 0) b = p 0 + simp + +private theorem hBother (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b i : Fin + 3) (hi : i ≠ b) : (B L q hpos hinside) b i = (v q) i := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let v : Fin 3 → ℂ := fun i => p i.succ + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + change (B b i = v i) + change Function.update v b (p 0) i = v i + simp [hi] + +private theorem hparents (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) (b : + Fin 3) : ∀ i : Fin 3, 0 < ((s q) b i.succ).1 := by + classical + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + change (∀ i : Fin 3, 0 < (s b i.succ).1) + fin_cases b <;> intro i <;> fin_cases i <;> exact hpos _ + +private theorem hparentPoint (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q + i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b j + : Fin 3) : + (((s q) b j.succ).2 : ℂ) / (((s q) b j.succ).1 : ℝ) = (B L q hpos hinside) b (j + b) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let v : Fin 3 → ℂ := fun i => p i.succ + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + change (((s b j.succ).2 : ℂ) / ((s b j.succ).1 : ℝ) = B b (j + b)) + fin_cases b <;> fin_cases j <;> rfl + +private theorem hchild (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b : Fin 3) + : (F L q) b = convexHull ℝ (Set.range ((B L q hpos hinside) b)) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let v : Fin 3 → ℂ := fun i => p i.succ + have parentHull (t : Fin 4 → CircleCoordinates) + (ht : ∀ i : Fin 3, 0 < (t i.succ).1) : + P4909T1ParentPolygon L t = + convexHull ℝ (Set.range fun i : Fin 3 => + ((t i.succ).2 : ℂ) / ((t i.succ).1 : ℝ)) := parentHull L t ht + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + have hparents (b : Fin 3) : ∀ i : Fin 3, 0 < (s b i.succ).1 := hparents q hpos b + have hparentPoint (b j : Fin 3) : + ((s b j.succ).2 : ℂ) / ((s b j.succ).1 : ℝ) = B b (j + b) := hparentPoint L q hpos hinside b j + change (F b = convexHull ℝ (Set.range (B b))) + rw [show F b = P4909T1ParentPolygon L (s b) from rfl, parentHull (s b) (hparents b)] + apply congrArg (convexHull ℝ) + ext z + constructor + · rintro ⟨j, rfl⟩ + exact ⟨j + b, (hparentPoint b j).symm⟩ + · rintro ⟨i, rfl⟩ + exact ⟨i - b, by simpa using hparentPoint b (i - b)⟩ + +private theorem hBmem (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b : Fin 3) + (z : ℂ) : z ∈ (F L q) b ↔ ∀ i, 0 ≤ ((B L q hpos hinside) b).coord i z := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let v : Fin 3 → ℂ := fun i => p i.succ + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + have hchild (b : Fin 3) : F b = convexHull ℝ (Set.range (B b)) := hchild L q hpos hinside b + change (z ∈ F b ↔ ∀ i, 0 ≤ (B b).coord i z) + rw [hchild] + exact Set.ext_iff.mp (B b).convexHull_eq_nonneg_coord z + +private theorem hBint (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b : Fin 3) + (z : ℂ) : + z ∈ interior ((F L q) b) ↔ ∀ i, 0 < ((B L q hpos hinside) b).coord i z := by + classical + have interiorHull (D : AffineBasis (Fin 3) ℝ ℂ) : + interior (convexHull ℝ (Set.range D)) = {z | ∀ i, 0 < D.coord i z} := interiorHull D + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let v : Fin 3 → ℂ := fun i => p i.succ + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + have hchild (b : Fin 3) : F b = convexHull ℝ (Set.range (B b)) := hchild L q hpos hinside b + change (z ∈ interior (F b) ↔ ∀ i, 0 < (B b).coord i z) + rw [hchild] + exact Set.ext_iff.mp (interiorHull (B b)) z + +private theorem coordSelf (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q + i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b : + Fin 3) : + (A L q hpos hinside).coord b = (alpha L q hpos hinside) b • ((B L q hpos hinside) b).coord + b := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let v : Fin 3 → ℂ := fun i => p i.succ + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + let alpha (i : Fin 3) : ℝ := A.coord i (p 0) + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + have hBself (b : Fin 3) : B b b = p 0 := hBself L q hpos hinside b + have hBother (b i : Fin 3) (hi : i ≠ b) : B b i = v i := hBother L q hpos hinside b i hi + change (A.coord b = alpha b • (B b).coord b) + apply AffineMap.ext_on (B b).tot + rintro _ ⟨i, rfl⟩ + change A.coord b (B b i) = alpha b * (B b).coord b (B b i) + by_cases hi : i = b + · subst i + rw [(B b).coord_apply_eq, mul_one, hBself] + · rw [(B b).coord_apply_ne (Ne.symm hi), mul_zero, hBother b i hi] + exact A.coord_apply_ne (Ne.symm hi) + +private theorem coordOther (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q + i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b i + : Fin 3) (hi : i ≠ b) : + (A L q hpos hinside).coord i = (alpha L q hpos hinside) i • ((B L q hpos hinside) b).coord + b + ((B L q hpos hinside) b).coord i := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let v : Fin 3 → ℂ := fun i => p i.succ + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + let alpha (i : Fin 3) : ℝ := A.coord i (p 0) + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + have hBself (b : Fin 3) : B b b = p 0 := hBself L q hpos hinside b + have hBother (b i : Fin 3) (hi : i ≠ b) : B b i = v i := hBother L q hpos hinside b i hi + change (A.coord i = alpha i • (B b).coord b + (B b).coord i) + apply AffineMap.ext_on (B b).tot + rintro _ ⟨j, rfl⟩ + change A.coord i (B b j) = + alpha i * (B b).coord b (B b j) + (B b).coord i (B b j) + by_cases hj : j = b + · subst j + rw [(B b).coord_apply_eq, (B b).coord_apply_ne hi, mul_one, add_zero, hBself] + · rw [(B b).coord_apply_ne (Ne.symm hj), mul_zero, zero_add, + (B b).coord_apply, hBother b j hj] + exact A.coord_apply i j + +private theorem coordSelfApply (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < + (q i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b + : Fin 3) (z : ℂ) : + (A L q hpos hinside).coord b z = (alpha L q hpos hinside) b * ((B L q hpos hinside) + b).coord b z := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let v : Fin 3 → ℂ := fun i => p i.succ + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + let alpha (i : Fin 3) : ℝ := A.coord i (p 0) + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + have coordSelf (b : Fin 3) : + A.coord b = alpha b • (B b).coord b := coordSelf L q hpos hinside b + change (A.coord b z = alpha b * (B b).coord b z) + rw [coordSelf b] + rfl + +private theorem coordOtherApply (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < + (q i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b + i : Fin 3) (hi : i ≠ b) (z : ℂ) : + (A L q hpos hinside).coord i z = (alpha L q hpos hinside) i * ((B L q hpos hinside) + b).coord b z + ((B L q hpos hinside) b).coord i z := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let v : Fin 3 → ℂ := fun i => p i.succ + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + let alpha (i : Fin 3) : ℝ := A.coord i (p 0) + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + have coordOther (b i : Fin 3) (hi : i ≠ b) : + A.coord i = alpha i • (B b).coord b + (B b).coord i := coordOther L q hpos hinside b i hi + change (A.coord i z = alpha i * (B b).coord b z + (B b).coord i z) + rw [coordOther b i hi] + rfl + +private theorem childSubset (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q + i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b : + Fin 3) : (F L q) b ⊆ (P L q) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let v : Fin 3 → ℂ := fun i => p i.succ + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + have hmem (z : ℂ) : z ∈ P ↔ ∀ i, 0 ≤ A.coord i z := hmem L q hpos hinside z + let alpha (i : Fin 3) : ℝ := A.coord i (p 0) + have alphaPos (i : Fin 3) : 0 < alpha i := alphaPos L q hpos hinside i + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + have hBmem (b : Fin 3) (z : ℂ) : z ∈ F b ↔ ∀ i, 0 ≤ (B b).coord i z := hBmem L q hpos hinside b z + have coordSelfApply (b : Fin 3) (z : ℂ) : + A.coord b z = alpha b * (B b).coord b z := coordSelfApply L q hpos hinside b z + have coordOtherApply (b i : Fin 3) (hi : i ≠ b) (z : ℂ) : + A.coord i z = alpha i * (B b).coord b z + (B b).coord i z := coordOtherApply L q hpos + hinside b i hi z + change (F b ⊆ P) + intro z hz + have hc := (hBmem b z).mp hz + apply (hmem z).mpr + intro i + by_cases hi : i = b + · subst i + rw [coordSelfApply] + exact mul_nonneg (alphaPos b).le (hc b) + · rw [coordOtherApply b i hi] + exact add_nonneg (mul_nonneg (alphaPos i).le (hc b)) (hc i) + +private theorem omittedNotIn (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q + i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b : + Fin 3) : (p q) b.succ ∉ (F L q) b := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let v : Fin 3 → ℂ := fun i => p i.succ + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + let alpha (i : Fin 3) : ℝ := A.coord i (p 0) + have alphaPos (i : Fin 3) : 0 < alpha i := alphaPos L q hpos hinside i + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + have hBmem (b : Fin 3) (z : ℂ) : z ∈ F b ↔ ∀ i, 0 ≤ (B b).coord i z := hBmem L q hpos hinside b z + have coordSelfApply (b : Fin 3) (z : ℂ) : + A.coord b z = alpha b * (B b).coord b z := coordSelfApply L q hpos hinside b z + have coordOtherApply (b i : Fin 3) (hi : i ≠ b) (z : ℂ) : + A.coord i z = alpha i * (B b).coord b z + (B b).coord i z := coordOtherApply L q hpos + hinside b i hi z + change (p b.succ ∉ F b) + intro hz + have hc := (hBmem b (v b)).mp hz + obtain ⟨i, hi⟩ := exists_ne b + have hs := coordSelfApply b (v b) + have ho := coordOtherApply b i hi (v b) + rw [show A.coord b (v b) = 1 from A.coord_apply_eq b] at hs + rw [show A.coord i (v b) = 0 from A.coord_apply_ne hi] at ho + have hle : (B b).coord b (v b) ≤ 0 := by + nlinarith [alphaPos i, hc i] + nlinarith [alphaPos b] + +private theorem childCover (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q + i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (z : + ℂ) (hz : z ∈ (P L q)) : ∃ b : Fin 3, z ∈ (F L q) b := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let v : Fin 3 → ℂ := fun i => p i.succ + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + have hmem (z : ℂ) : z ∈ P ↔ ∀ i, 0 ≤ A.coord i z := hmem L q hpos hinside z + let alpha (i : Fin 3) : ℝ := A.coord i (p 0) + have alphaPos (i : Fin 3) : 0 < alpha i := alphaPos L q hpos hinside i + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + have hBmem (b : Fin 3) (z : ℂ) : z ∈ F b ↔ ∀ i, 0 ≤ (B b).coord i z := hBmem L q hpos hinside b z + have coordSelfApply (b : Fin 3) (z : ℂ) : + A.coord b z = alpha b * (B b).coord b z := coordSelfApply L q hpos hinside b z + have coordOtherApply (b i : Fin 3) (hi : i ≠ b) (z : ℂ) : + A.coord i z = alpha i * (B b).coord b z + (B b).coord i z := coordOtherApply L q hpos + hinside b i hi z + change (∃ b : Fin 3, z ∈ F b) + let ratio (i : Fin 3) := A.coord i z / alpha i + obtain ⟨b, _, hb⟩ := Finset.exists_min_image Finset.univ ratio Finset.univ_nonempty + refine ⟨b, (hBmem b z).mpr ?_⟩ + have hs := coordSelfApply b z + have hbpos : 0 ≤ (B b).coord b z := by + have ha := (hmem z).mp hz b + nlinarith [alphaPos b] + intro i + by_cases hi : i = b + · simpa [hi] using hbpos + · have hratio := hb i (Finset.mem_univ i) + have hmul := (div_le_div_iff₀ (alphaPos b) (alphaPos i)).mp hratio + have ho := coordOtherApply b i hi z + rw [hs, ho] at hmul + have : 0 ≤ alpha b * (B b).coord i z := by nlinarith only [hmul] + nlinarith [alphaPos b] + +private theorem intRatio (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q + i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b : + Fin 3) (z : ℂ) (hz : z ∈ interior ((F L q) b)) + (i : Fin 3) (hi : i ≠ b) : + (A L q hpos hinside).coord b z / (alpha L q hpos hinside) b < (A L q hpos hinside).coord i + z / (alpha L q hpos hinside) i := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let v : Fin 3 → ℂ := fun i => p i.succ + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + let alpha (i : Fin 3) : ℝ := A.coord i (p 0) + have alphaPos (i : Fin 3) : 0 < alpha i := alphaPos L q hpos hinside i + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + have hBint (b : Fin 3) (z : ℂ) : + z ∈ interior (F b) ↔ ∀ i, 0 < (B b).coord i z := hBint L q hpos hinside b z + have coordSelfApply (b : Fin 3) (z : ℂ) : + A.coord b z = alpha b * (B b).coord b z := coordSelfApply L q hpos hinside b z + have coordOtherApply (b i : Fin 3) (hi : i ≠ b) (z : ℂ) : + A.coord i z = alpha i * (B b).coord b z + (B b).coord i z := coordOtherApply L q hpos + hinside b i hi z + change (A.coord b z / alpha b < A.coord i z / alpha i) + apply (div_lt_div_iff₀ (alphaPos b) (alphaPos i)).mpr + have hs := coordSelfApply b z + have ho := coordOtherApply b i hi z + have hp := (hBint b z).mp hz i + have hprod := mul_pos (alphaPos b) hp + rw [hs, ho] + nlinarith only [hprod] + +private theorem disjointInt (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q + i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b c + : Fin 3) (hbc : b ≠ c) : + Disjoint (interior ((F L q) b)) (interior ((F L q) c)) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let v : Fin 3 → ℂ := fun i => p i.succ + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + let alpha (i : Fin 3) : ℝ := A.coord i (p 0) + have intRatio (b : Fin 3) (z : ℂ) (hz : z ∈ interior (F b)) + (i : Fin 3) (hi : i ≠ b) : + A.coord b z / alpha b < A.coord i z / alpha i := intRatio L q hpos hinside b z hz i hi + change (Disjoint (interior (F b)) (interior (F c))) + apply Set.disjoint_left.mpr + intro z hb hc + exact (lt_asymm (intRatio b z hb c hbc.symm)) (intRatio c z hc b hbc) + +private theorem segmentOfZero (D : AffineBasis (Fin 3) ℝ ℂ) (z : ℂ) + (hnonneg : ∀ i, 0 ≤ D.coord i z) (i : Fin 3) (hi : D.coord i z = 0) : + ∃ j k : Fin 3, j ≠ k ∧ j ≠ i ∧ k ≠ i ∧ z ∈ segment ℝ (D j) (D k) := by + classical + have hs := D.sum_coord_apply_eq_one z + have hv := D.linear_combination_coord_eq_self z + simp only [Fin.sum_univ_three] at hs hv + fin_cases i + · change D.coord 0 z = 0 at hi + refine ⟨1, 2, by decide, by decide, by decide, + D.coord 1 z, D.coord 2 z, hnonneg 1, hnonneg 2, ?_, ?_⟩ + · linarith + · simpa [hi] using hv + · change D.coord 1 z = 0 at hi + refine ⟨0, 2, by decide, by decide, by decide, + D.coord 0 z, D.coord 2 z, hnonneg 0, hnonneg 2, ?_, ?_⟩ + · linarith + · simpa [hi] using hv + · change D.coord 2 z = 0 at hi + refine ⟨0, 1, by decide, by decide, by decide, + D.coord 0 z, D.coord 1 z, hnonneg 0, hnonneg 1, ?_, ?_⟩ + · linarith + · simpa [hi] using hv + +private theorem childClosed (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q + i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b : + Fin 3) : IsClosed ((F L q) b) := by + classical + have affineContinuous (f : ℂ →ᵃ[ℝ] ℝ) : Continuous f := affineContinuous f + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let v : Fin 3 → ℂ := fun i => p i.succ + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + have hchild (b : Fin 3) : F b = convexHull ℝ (Set.range (B b)) := hchild L q hpos hinside b + change (IsClosed (F b)) + rw [hchild, (B b).convexHull_eq_nonneg_coord] + rw [Set.ofPred_forall] + exact isClosed_iInter fun i => isClosed_le continuous_const + (affineContinuous ((B b).coord i)) + +private theorem childFrontier (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q + i).1) (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (b : + Fin 3) : frontier ((F L q) b) ⊆ P4909T1ParentEdges L ((s q) b) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let v : Fin 3 → ℂ := fun i => p i.succ + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + have hparents (b : Fin 3) : ∀ i : Fin 3, 0 < (s b i.succ).1 := hparents q hpos b + have hparentPoint (b j : Fin 3) : + ((s b j.succ).2 : ℂ) / ((s b j.succ).1 : ℝ) = B b (j + b) := hparentPoint L q hpos hinside b j + have hBmem (b : Fin 3) (z : ℂ) : z ∈ F b ↔ ∀ i, 0 ≤ (B b).coord i z := hBmem L q hpos hinside b z + have hBint (b : Fin 3) (z : ℂ) : + z ∈ interior (F b) ↔ ∀ i, 0 < (B b).coord i z := hBint L q hpos hinside b z + have segmentOfZero (D : AffineBasis (Fin 3) ℝ ℂ) (z : ℂ) + (hnonneg : ∀ i, 0 ≤ D.coord i z) (i : Fin 3) (hi : D.coord i z = 0) : + ∃ j k : Fin 3, j ≠ k ∧ j ≠ i ∧ k ≠ i ∧ z ∈ segment ℝ (D j) (D k) := segmentOfZero D z + hnonneg i hi + have childClosed (b : Fin 3) : IsClosed (F b) := childClosed L q hpos hinside b + change (frontier (F b) ⊆ P4909T1ParentEdges L (s b)) + intro z hz + rw [(childClosed b).frontier_eq] at hz + have hc := (hBmem b z).mp hz.1 + have hn : ¬ ∀ i, 0 < (B b).coord i z := by + intro hp + exact hz.2 ((hBint b z).mpr hp) + obtain ⟨i, hi⟩ := not_forall.mp hn + have heq : (B b).coord i z = 0 := le_antisymm (not_lt.mp hi) (hc i) + obtain ⟨j, k, hjk, _, _, hseg⟩ := segmentOfZero (B b) z hc i heq + change (∃ j k : Fin 3, j ≠ k ∧ 0 < (s b j.succ).1 ∧ 0 < (s b k.succ).1 ∧ + z ∈ segment ℝ (((s b j.succ).2 : ℂ) / ((s b j.succ).1 : ℝ)) + (((s b k.succ).2 : ℂ) / ((s b k.succ).1 : ℝ))) ∨ _ + apply Or.inl + refine ⟨j - b, k - b, ?_, hparents b _, hparents b _, ?_⟩ + · intro he + apply hjk + exact (sub_left_inj).mp he + · simpa only [hparentPoint, sub_add_cancel] using hseg + +private theorem offSeam (L : ℝ) (q : Fin 4 → CircleCoordinates) (hpos : ∀ i : Fin 4, 0 < (q i).1) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (z : ℂ) (hz + : z ∈ interior (P L q)) + (hseam : ∀ i : Fin 4, 0 < (q i).1 → z ∉ segment ℝ ((p q) 0) ((p q) i)) : + ∃ b, z ∈ interior ((F L q) b) := by + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let v : Fin 3 → ℂ := fun i => p i.succ + have hspan : affineSpan ℝ (Set.range v) = ⊤ := hspan L q hpos hinside + have hind : AffineIndependent ℝ v := hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + have hint (z : ℂ) : z ∈ interior P ↔ ∀ i, 0 < A.coord i z := hint L q hpos hinside z + let alpha (i : Fin 3) : ℝ := A.coord i (p 0) + have alphaPos (i : Fin 3) : 0 < alpha i := alphaPos L q hpos hinside i + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := huind L q hpos hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := hutot L q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + have hBself (b : Fin 3) : B b b = p 0 := hBself L q hpos hinside b + have hBother (b i : Fin 3) (hi : i ≠ b) : B b i = v i := hBother L q hpos hinside b i hi + have hBmem (b : Fin 3) (z : ℂ) : z ∈ F b ↔ ∀ i, 0 ≤ (B b).coord i z := hBmem L q hpos hinside b z + have hBint (b : Fin 3) (z : ℂ) : + z ∈ interior (F b) ↔ ∀ i, 0 < (B b).coord i z := hBint L q hpos hinside b z + have coordSelfApply (b : Fin 3) (z : ℂ) : + A.coord b z = alpha b * (B b).coord b z := coordSelfApply L q hpos hinside b z + have childCover (z : ℂ) (hz : z ∈ P) : ∃ b : Fin 3, z ∈ F b := childCover L q hpos hinside z hz + have segmentOfZero (D : AffineBasis (Fin 3) ℝ ℂ) (z : ℂ) + (hnonneg : ∀ i, 0 ≤ D.coord i z) (i : Fin 3) (hi : D.coord i z = 0) : + ∃ j k : Fin 3, j ≠ k ∧ j ≠ i ∧ k ≠ i ∧ z ∈ segment ℝ (D j) (D k) := segmentOfZero D z + hnonneg i hi + change (∃ b, z ∈ interior (F b)) + obtain ⟨b, hb⟩ := childCover z (interior_subset hz) + have hc := (hBmem b z).mp hb + have hbp : 0 < (B b).coord b z := by + have ha := (hint z).mp hz b + have hs := coordSelfApply b z + nlinarith [alphaPos b] + refine ⟨b, (hBint b z).mpr ?_⟩ + intro i + by_contra hi + have hzero : (B b).coord i z = 0 := le_antisymm (not_lt.mp hi) (hc i) + have hib : i ≠ b := by + intro he + subst i + linarith + obtain ⟨j, k, hjk, hji, hki, hseg⟩ := segmentOfZero (B b) z hc i hzero + have hbjk : b = j ∨ b = k := by omega + rcases hbjk with rfl | rfl + · rw [hBself, hBother b k hjk.symm] at hseg + exact hseam k.succ (hpos k.succ) hseg + · rw [segment_symm, hBself, hBother b j hjk] at hseg + exact hseam j.succ (hpos j.succ) hseg + +end TriangleFanConstruction + +theorem P4909T1TriangleFan (L : ℝ) (q : Fin 4 → CircleCoordinates) + (hpos : ∀ i : Fin 4, 0 < (q i).1) + (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) : + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + (∀ b, F b ⊆ P ∧ p b.succ ∉ F b ∧ frontier (F b) ⊆ P4909T1ParentEdges L (s b)) ∧ + (∀ b c, b ≠ c → Disjoint (interior (F b)) (interior (F c))) ∧ + P = ⋃ b, F b ∧ + (∀ z ∈ interior P, + (∀ i : Fin 4, 0 < (q i).1 → z ∉ segment ℝ (p 0) (p i)) → + (∀ k : Fin 3, (q k.succ).1 = 0 → + z ∉ segment ℝ (p 0) + ⟨if (q k.succ).2 = -1 then L else L + 2, (p 0).im⟩) → + ∃ b, z ∈ interior (F b)) := by +-- BODY + classical + dsimp only + -- Establish affine-coordinate topology directly from real and imaginary parts. + have normRealSmul (r : ℝ) (z : ℂ) : ‖r • z‖ = |r| * ‖z‖ := TriangleFanConstruction.normRealSmul + r z + have smallStep (z d : ℂ) (ε : ℝ) (hε : 0 < ε) : + ∃ t : ℝ, 0 < t ∧ t • d + z ∈ Metric.ball z ε := TriangleFanConstruction.smallStep z d ε hε + have contRe : Continuous (fun z : ℂ => z.re) := TriangleFanConstruction.contRe + have contIm : Continuous (fun z : ℂ => z.im) := TriangleFanConstruction.contIm + have affineContinuous (f : ℂ →ᵃ[ℝ] ℝ) : Continuous f := TriangleFanConstruction.affineContinuous f + have affineShift (f : ℂ →ᵃ[ℝ] ℝ) (z a b : ℂ) (t : ℝ) : + f (t • (a - b) + z) = t * (f a - f b) + f z := TriangleFanConstruction.affineShift f z a b t + have interiorHull (D : AffineBasis (Fin 3) ℝ ℂ) : + interior (convexHull ℝ (Set.range D)) = {z | ∀ i, 0 < D.coord i z} := + TriangleFanConstruction.interiorHull D + have spanOfInterior (S : Set ℂ) (x : ℂ) + (hx : x ∈ interior (convexHull ℝ S)) : affineSpan ℝ S = ⊤ := + TriangleFanConstruction.spanOfInterior S x hx + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let v : Fin 3 → ℂ := fun i => p i.succ + have parentHull (t : Fin 4 → CircleCoordinates) + (ht : ∀ i : Fin 3, 0 < (t i.succ).1) : + P4909T1ParentPolygon L t = + convexHull ℝ (Set.range fun i : Fin 3 => + ((t i.succ).2 : ℂ) / ((t i.succ).1 : ℝ)) := TriangleFanConstruction.parentHull L t ht + have hP : P = convexHull ℝ (Set.range v) := TriangleFanConstruction.hP L q hpos + have hxmem : p 0 ∈ interior (convexHull ℝ (Set.range v)) := TriangleFanConstruction.hxmem L q + hpos hinside + have hspan : affineSpan ℝ (Set.range v) = ⊤ := TriangleFanConstruction.hspan L q hpos hinside + have hvspan : vectorSpan ℝ (Set.range v) = ⊤ := TriangleFanConstruction.hvspan L q hpos hinside + have hind : AffineIndependent ℝ v := TriangleFanConstruction.hind L q hpos hinside + let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ + have hmem (z : ℂ) : z ∈ P ↔ ∀ i, 0 ≤ A.coord i z := TriangleFanConstruction.hmem L q hpos + hinside z + have hint (z : ℂ) : z ∈ interior P ↔ ∀ i, 0 < A.coord i z := TriangleFanConstruction.hint L q + hpos hinside z + let alpha (i : Fin 3) : ℝ := A.coord i (p 0) + have alphaPos (i : Fin 3) : 0 < alpha i := TriangleFanConstruction.alphaPos L q hpos hinside i + -- The child basis replaces precisely the omitted parent by the inserted center. + let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) + have huind (b : Fin 3) : AffineIndependent ℝ (u b) := TriangleFanConstruction.huind L q hpos + hinside b + have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := TriangleFanConstruction.hutot L + q hpos hinside b + let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ + have hBself (b : Fin 3) : B b b = p 0 := TriangleFanConstruction.hBself L q hpos hinside b + have hBother (b i : Fin 3) (hi : i ≠ b) : B b i = v i := TriangleFanConstruction.hBother L q + hpos hinside b i hi + have hparents (b : Fin 3) : ∀ i : Fin 3, 0 < (s b i.succ).1 := TriangleFanConstruction.hparents + q hpos b + have hparentPoint (b j : Fin 3) : + ((s b j.succ).2 : ℂ) / ((s b j.succ).1 : ℝ) = B b (j + b) := + TriangleFanConstruction.hparentPoint L q hpos hinside b j + have hchild (b : Fin 3) : F b = convexHull ℝ (Set.range (B b)) := + TriangleFanConstruction.hchild L q hpos hinside b + have hBmem (b : Fin 3) (z : ℂ) : z ∈ F b ↔ ∀ i, 0 ≤ (B b).coord i z := + TriangleFanConstruction.hBmem L q hpos hinside b z + have hBint (b : Fin 3) (z : ℂ) : + z ∈ interior (F b) ↔ ∀ i, 0 < (B b).coord i z := TriangleFanConstruction.hBint L q hpos + hinside b z + have coordSelf (b : Fin 3) : + A.coord b = alpha b • (B b).coord b := TriangleFanConstruction.coordSelf L q hpos hinside b + have coordOther (b i : Fin 3) (hi : i ≠ b) : + A.coord i = alpha i • (B b).coord b + (B b).coord i := TriangleFanConstruction.coordOther L + q hpos hinside b i hi + have coordSelfApply (b : Fin 3) (z : ℂ) : + A.coord b z = alpha b * (B b).coord b z := TriangleFanConstruction.coordSelfApply L q hpos + hinside b z + have coordOtherApply (b i : Fin 3) (hi : i ≠ b) (z : ℂ) : + A.coord i z = alpha i * (B b).coord b z + (B b).coord i z := + TriangleFanConstruction.coordOtherApply L q hpos hinside b i hi z + have childSubset (b : Fin 3) : F b ⊆ P := TriangleFanConstruction.childSubset L q hpos hinside b + have omittedNotIn (b : Fin 3) : p b.succ ∉ F b := TriangleFanConstruction.omittedNotIn L q hpos + hinside b + -- A minimum barycentric ratio makes all child coordinates nonnegative. + have childCover (z : ℂ) (hz : z ∈ P) : ∃ b : Fin 3, z ∈ F b := + TriangleFanConstruction.childCover L q hpos hinside z hz + have intRatio (b : Fin 3) (z : ℂ) (hz : z ∈ interior (F b)) + (i : Fin 3) (hi : i ≠ b) : + A.coord b z / alpha b < A.coord i z / alpha i := TriangleFanConstruction.intRatio L q hpos + hinside b z hz i hi + have disjointInt (b c : Fin 3) (hbc : b ≠ c) : + Disjoint (interior (F b)) (interior (F c)) := TriangleFanConstruction.disjointInt L q hpos + hinside b c hbc + -- A zero coordinate leaves a convex combination of the other two vertices. + have segmentOfZero (D : AffineBasis (Fin 3) ℝ ℂ) (z : ℂ) + (hnonneg : ∀ i, 0 ≤ D.coord i z) (i : Fin 3) (hi : D.coord i z = 0) : + ∃ j k : Fin 3, j ≠ k ∧ j ≠ i ∧ k ≠ i ∧ z ∈ segment ℝ (D j) (D k) := + TriangleFanConstruction.segmentOfZero D z hnonneg i hi + have childClosed (b : Fin 3) : IsClosed (F b) := TriangleFanConstruction.childClosed L q hpos + hinside b + have childFrontier (b : Fin 3) : frontier (F b) ⊆ P4909T1ParentEdges L (s b) := + TriangleFanConstruction.childFrontier L q hpos hinside b + have offSeam (z : ℂ) (hz : z ∈ interior P) + (hseam : ∀ i : Fin 4, 0 < (q i).1 → z ∉ segment ℝ (p 0) (p i)) : + ∃ b, z ∈ interior (F b) := TriangleFanConstruction.offSeam L q hpos hinside z hz hseam + refine ⟨fun b => ⟨childSubset b, omittedNotIn b, childFrontier b⟩, disjointInt, ?_, ?_⟩ + · apply Set.Subset.antisymm + · intro z hz + exact Set.mem_iUnion.mpr (childCover z hz) + · intro z hz + obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hz + exact childSubset b hb + · intro z hz hseam _ + exact offSeam z hz hseam + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4953T1HullHeight.lean b/LeanPool/ApollonianSuperharmonic/P4953T1HullHeight.lean new file mode 100644 index 0000000000..767d3f11ec --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4953T1HullHeight.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Complex.Norm +public import Mathlib.Analysis.Convex.Hull +public import Mathlib.LinearAlgebra.Complex.Module + +-- [TABLET NODE: P4953T1HullHeight] + +/-! +# P4953T1HullHeight + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4953T1HullHeight (h : ℝ) (A B x : ℂ) + (hx : x ∈ interior (convexHull ℝ + ({A, B, ⟨h, A.im⟩, ⟨h, B.im⟩} : Set ℂ))) : + min A.im B.im < x.im ∧ x.im < max A.im B.im := by +-- BODY + let u := min A.im B.im + let v := max A.im B.im + let strip : Set ℂ := {z | u ≤ z.im ∧ z.im ≤ v} + have hconv : Convex ℝ strip := by + intro z hz w hw r s hr hs hrs + change u ≤ z.im ∧ z.im ≤ v at hz + change u ≤ w.im ∧ w.im ≤ v at hw + change u ≤ (r • z + s • w).im ∧ (r • z + s • w).im ≤ v + simp only [Complex.add_im, Complex.smul_im] + constructor + · calc + u = r * u + s * u := by rw [← add_mul, hrs, one_mul] + _ ≤ r * z.im + s * w.im := add_le_add + (mul_le_mul_of_nonneg_left hz.1 hr) (mul_le_mul_of_nonneg_left hw.1 hs) + · calc + r * z.im + s * w.im ≤ r * v + s * v := add_le_add + (mul_le_mul_of_nonneg_left hz.2 hr) (mul_le_mul_of_nonneg_left hw.2 hs) + _ = v := by rw [← add_mul, hrs, one_mul] + have hsub : convexHull ℝ ({A, B, ⟨h, A.im⟩, ⟨h, B.im⟩} : Set ℂ) ⊆ strip := by + apply convexHull_min _ hconv + intro z hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with rfl | rfl | rfl | rfl + all_goals first + | exact ⟨min_le_left _ _, le_max_left _ _⟩ + | exact ⟨min_le_right _ _, le_max_right _ _⟩ + have hxint := interior_mono hsub hx + have hxweak := interior_subset hxint + change u ≤ x.im ∧ x.im ≤ v at hxweak + obtain ⟨ε, hε, hball⟩ := Metric.mem_nhds_iff.mp + (mem_interior_iff_mem_nhds.mp hxint) + have step (r : ℝ) (hr : |r| < ε) : x + (r : ℂ) * Complex.I ∈ Metric.ball x ε := by + rw [Metric.mem_ball, Complex.dist_eq, add_sub_cancel_left, + Complex.norm_mul, Complex.norm_I, mul_one, Complex.norm_real, Real.norm_eq_abs] + exact hr + have hlo := hball (step (-ε / 2) (by rw [abs_of_neg (by linarith)]; linarith)) + have hhi := hball (step (ε / 2) (by rw [abs_of_pos (by linarith)]; linarith)) + change u ≤ (x + ((-ε / 2 : ℝ) : ℂ) * Complex.I).im ∧ _ at hlo + change _ ∧ (x + ((ε / 2 : ℝ) : ℂ) * Complex.I).im ≤ v at hhi + simp only [Complex.add_im, Complex.mul_im, Complex.ofReal_re, Complex.I_im, + mul_one, Complex.ofReal_im, Complex.I_re, mul_zero, add_zero] at hlo hhi + constructor <;> linarith [hlo.1, hhi.2] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4953T1LiteralHulls.lean b/LeanPool/ApollonianSuperharmonic/P4953T1LiteralHulls.lean new file mode 100644 index 0000000000..624381595e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4953T1LiteralHulls.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Tactic.Tauto + +public import LeanPool.ApollonianSuperharmonic.P4909T1ParentPolygon +public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate +public import LeanPool.ApollonianSuperharmonic.P4828T1Step + +-- [TABLET NODE: P4953T1LiteralHulls] + +/-! +# P4953T1LiteralHulls + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4953T1LiteralHulls (L : ℝ) (q : Fin 4 → CircleCoordinates) + (l a b : Fin 3) (hal : a ≠ l) (hbl : b ≠ l) (hab : a ≠ b) + (hl : (q l.succ).1 = 0) (ha : 0 < (q a.succ).1) + (hb : 0 < (q b.succ).1) (hx : 0 < (q 0).1) : + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let h := if (q l.succ).2 = -1 then L else L + 2 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + let x := p 0 + let A := p a.succ + let B := p b.succ + let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) + P4909T1ParentPolygon L q = + convexHull ℝ ({A, B, foot A, foot B} : Set ℂ) ∧ + P4909T1ParentPolygon L (s l) = convexHull ℝ ({x, A, B} : Set ℂ) ∧ + P4909T1ParentPolygon L (s a) = + convexHull ℝ ({x, B, foot x, foot B} : Set ℂ) ∧ + P4909T1ParentPolygon L (s b) = + convexHull ℝ ({A, x, foot A, foot x} : Set ℂ) ∧ + (∀ c j : Fin 3, s c j.succ = + if j = 0 then q 0 else q ((j + c).succ)) := by +-- BODY + classical + dsimp only + have hs (c j : Fin 3) : P4828T1Step (P4828T1Rotate q c) j.succ = + if j = 0 then q 0 else q ((j + c).succ) := by + fin_cases c <;> fin_cases j <;> rfl + fin_cases l <;> fin_cases a <;> fin_cases b + all_goals try (norm_num at hal) + all_goals try (norm_num at hbl) + all_goals try (norm_num at hab) + all_goals dsimp at hl ha hb + all_goals + refine ⟨?_, ?_, ?_, ?_, hs⟩ + all_goals + apply congrArg (convexHull ℝ) + ext z + simp [hs, + Fin.exists_fin_succ, hl, ha, hb, hx, ne_of_gt ha, ne_of_gt hb, ne_of_gt hx] + all_goals tauto + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean b/LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean new file mode 100644 index 0000000000..29a9d79494 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean @@ -0,0 +1,1000 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Complex.Norm +public import Mathlib.Analysis.Convex.Hull +public import Mathlib.Analysis.Convex.Join +public import Mathlib.LinearAlgebra.Complex.Module + +-- [TABLET NODE: P4953T1QuadrilateralSections] + +/-! +# P4953T1QuadrilateralSections + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace QuadrilateralSectionsConstruction + +private noncomputable abbrev fA (h : ℝ) (A : ℂ) : ℂ := by + classical + exact ⟨h, A.im⟩ + +private noncomputable abbrev fB (h : ℝ) (B : ℂ) : ℂ := by + classical + exact ⟨h, B.im⟩ + +private noncomputable abbrev d (A : ℂ) (B : ℂ) (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / + (B.im - A.im) + +private noncomputable abbrev Q (h : ℝ) (A : ℂ) (B : ℂ) := convexHull ℝ ({A, B, (fA h A), (fB h + B)} : Set ℂ) + +private theorem hσsq (σ : ℝ) (hσ : σ ^ 2 = 1) : σ * σ = 1 := by + classical + nlinarith [hσ] + +private noncomputable abbrev T (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) : Set ℂ := by + classical + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + exact {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} + +private theorem hconv (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hAB : A.im < B.im) : Convex ℝ (T h σ A B) + := by + classical + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} + change (Convex ℝ T) + intro z hz w hw a b ha hb hab + change A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re) at hz + change A.im ≤ w.im ∧ w.im ≤ B.im ∧ + 0 ≤ σ * (w.re - h) ∧ 0 ≤ σ * (d w.im - w.re) at hw + change A.im ≤ (a • z + b • w).im ∧ (a • z + b • w).im ≤ B.im ∧ + 0 ≤ σ * ((a • z + b • w).re - h) ∧ + 0 ≤ σ * (d (a • z + b • w).im - (a • z + b • w).re) + simp only [Complex.add_im, Complex.smul_im, Complex.add_re, Complex.smul_re] + simp only [smul_eq_mul] + have hd : d (a * z.im + b * w.im) = a * d z.im + b * d w.im := by + have hb' : b = 1 - a := by linarith + rw [hb'] + dsimp [d] + field_simp [ne_of_gt hAB] + ring + have hre : σ * (a * z.re + b * w.re - h) = + a * (σ * (z.re - h)) + b * (σ * (w.re - h)) := by + rw [show a * z.re + b * w.re - h = + a * (z.re - h) + b * (w.re - h) by linear_combination h * hab] + ring + have hrd : σ * (a * d z.im + b * d w.im - (a * z.re + b * w.re)) = + a * (σ * (d z.im - z.re)) + b * (σ * (d w.im - w.re)) := by ring + refine ⟨?_, ?_, ?_, ?_⟩ + · calc + A.im = a * A.im + b * A.im := by rw [← add_mul, hab, one_mul] + _ ≤ a * z.im + b * w.im := add_le_add + (mul_le_mul_of_nonneg_left hz.1 ha) (mul_le_mul_of_nonneg_left hw.1 hb) + · calc + a * z.im + b * w.im ≤ a * B.im + b * B.im := add_le_add + (mul_le_mul_of_nonneg_left hz.2.1 ha) (mul_le_mul_of_nonneg_left hw.2.1 hb) + _ = B.im := by rw [← add_mul, hab, one_mul] + · have hz' := hz.2.2.1 + have hw' := hw.2.2.1 + rw [hre] + exact add_nonneg (mul_nonneg ha hz') (mul_nonneg hb hw') + · have hz' := hz.2.2.2 + have hw' := hw.2.2.2 + rw [hd] + rw [hrd] + exact add_nonneg (mul_nonneg ha hz') (mul_nonneg hb hw') + +private theorem hda (A : ℂ) (B : ℂ) (hAB : A.im < B.im) : (d A B) A.im = A.re := by + classical + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + change (d A.im = A.re) + dsimp [d] + field_simp [ne_of_gt hAB]; + ring + +private theorem hdb (A : ℂ) (B : ℂ) (hAB : A.im < B.im) : (d A B) B.im = B.re := by + classical + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + change (d B.im = B.re) + have hv : B.im - A.im ≠ 0 := sub_ne_zero.mpr (ne_of_gt hAB) + dsimp [d] + simp [hv] + +private theorem hQsub (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hA : 0 < σ * (A.re - h)) (hB : 0 < σ * + (B.re - h)) (hAB : A.im < B.im) : (Q h A B) ⊆ (T h σ A B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} + have hconv : Convex ℝ T := hconv h σ A B hAB + have hda : d A.im = A.re := hda A B hAB + have hdb : d B.im = B.re := hdb A B hAB + change (Q ⊆ T) + apply convexHull_min + · intro z hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with rfl | rfl | rfl | rfl + · exact ⟨le_rfl, hAB.le, le_of_lt (by simpa [fA] using hA), by + rw [hda] + simp + ⟩ + · exact ⟨hAB.le, le_rfl, le_of_lt (by simpa [fB] using hB), by + rw [hdb] + simp + ⟩ + · exact ⟨le_rfl, hAB.le, by simp [fA], by + rw [hda] + simpa [fA] using hA.le + ⟩ + · exact ⟨hAB.le, le_rfl, by simp [fB], by + rw [hdb] + simpa [fB] using hB.le + ⟩ + · exact hconv + +private theorem hTsub (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hσ : σ ^ 2 = 1) (hA : 0 < σ * (A.re - h)) + (hB : 0 < σ * (B.re - h)) (hAB : A.im < B.im) : (T h σ A B) ⊆ (Q h A B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + have hσsq : σ * σ = 1 := hσsq σ hσ + let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} + change (T ⊆ Q) + intro z hz + change A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re) at hz + have hv : 0 < B.im - A.im := sub_pos.mpr hAB + let t := (z.im - A.im) / (B.im - A.im) + have ht0 : 0 ≤ t := by + dsimp [t] + exact div_nonneg (sub_nonneg.mpr hz.1) hv.le + have ht1 : t ≤ 1 := by + dsimp [t] + apply (div_le_one₀ hv).2 + linarith [hz.2.1] + have ht : (1 - t) + t = 1 := by ring + have hlinD : d z.im = (1 - t) * A.re + t * B.re := by + dsimp [d, t] + field_simp [ne_of_gt hv] + ring + have hDform : σ * (d z.im - h) = + (1 - t) * (σ * (A.re - h)) + t * (σ * (B.re - h)) := by + rw [hlinD] + rw [show (1 - t) * A.re + t * B.re - h = + (1 - t) * (A.re - h) + t * (B.re - h) by linear_combination h * ht] + ring + have hD : 0 < σ * (d z.im - h) := by + rw [hDform] + by_cases htEq : t = 1 + · rw [htEq] + simpa using hB + · have hleft : 0 < 1 - t := by + have htlt : t < 1 := by + by_contra hn + have hge : 1 ≤ t := le_of_not_gt hn + exact htEq (le_antisymm ht1 hge) + linarith + exact add_pos_of_pos_of_nonneg (mul_pos hleft hA) + (mul_nonneg ht0 hB.le) + let r := σ * (z.re - h) / (σ * (d z.im - h)) + have hr0 : 0 ≤ r := by + dsimp [r] + exact div_nonneg hz.2.2.1 hD.le + have hnumle : σ * (z.re - h) ≤ σ * (d z.im - h) := by + have := hz.2.2.2 + nlinarith + have hr1 : r ≤ 1 := by + dsimp [r] + exact (div_le_one₀ hD).2 hnumle + have hreal : z.re = h + r * (d z.im - h) := by + have hcancel : r * (σ * (d z.im - h)) = σ * (z.re - h) := by + dsimp [r] + exact div_mul_cancel₀ _ (ne_of_gt hD) + have hσsq : σ * σ = 1 := by nlinarith [hσ] + have hratio : r * (d z.im - h) = z.re - h := by + calc + r * (d z.im - h) = σ * (r * (σ * (d z.im - h))) := by + calc + r * (d z.im - h) = r * (d z.im - h) * (σ * σ) := by rw [hσsq]; ring + _ = σ * (r * (σ * (d z.im - h))) := by ring + _ = σ * (σ * (z.re - h)) := by rw [hcancel] + _ = z.re - h := by calc + σ * (σ * (z.re - h)) = (σ * σ) * (z.re - h) := by ring + _ = z.re - h := by rw [hσsq]; ring + rw [hratio] + ring + let foot : ℂ := ⟨h, z.im⟩ + let top : ℂ := ⟨d z.im, z.im⟩ + have hfootSeg : foot ∈ segment ℝ fA fB := by + rw [segment_eq_image] + refine ⟨t, ⟨ht0, ht1⟩, ?_⟩ + apply Complex.ext + · simp only [Complex.add_re, Complex.smul_re, foot, fA, fB] + simp only [smul_eq_mul] + ring + · simp only [Complex.add_im, Complex.smul_im] + simp only [smul_eq_mul] + rw [show (1 - t) * A.im + t * B.im = z.im by + dsimp [t] + field_simp [ne_of_gt hv] + ring] + have htopSeg : top ∈ segment ℝ A B := by + rw [segment_eq_image] + refine ⟨t, ⟨ht0, ht1⟩, ?_⟩ + apply Complex.ext + · simp only [Complex.add_re, Complex.smul_re] + simp only [smul_eq_mul] + change (1 - t) * A.re + t * B.re = d z.im + exact hlinD.symm + · simp only [Complex.add_im, Complex.smul_im] + simp only [smul_eq_mul] + rw [show (1 - t) * A.im + t * B.im = z.im by + dsimp [t] + field_simp [ne_of_gt hv] + ring] + have hfootQ : foot ∈ Q := by + dsimp [Q] + have hfA : fA ∈ ({A, B, fA, fB} : Set ℂ) := by simp [fA] + have hfB : fB ∈ ({A, B, fA, fB} : Set ℂ) := by simp [fB] + exact segment_subset_convexHull hfA hfB hfootSeg + have htopQ : top ∈ Q := by + dsimp [Q] + have hA' : A ∈ ({A, B, fA, fB} : Set ℂ) := by simp + have hB' : B ∈ ({A, B, fA, fB} : Set ℂ) := by simp + exact segment_subset_convexHull hA' hB' htopSeg + have hzSeg : z ∈ segment ℝ foot top := by + rw [segment_eq_image] + refine ⟨r, ⟨hr0, hr1⟩, ?_⟩ + apply Complex.ext + · simp only [Complex.add_re, Complex.smul_re, foot, top] + simp only [smul_eq_mul] + rw [hreal] + ring + · simp only [Complex.add_im, Complex.smul_im, foot, top] + simp only [smul_eq_mul] + ring + simpa [Q] using (convex_convexHull ℝ _).segment_subset hfootQ htopQ hzSeg + +private theorem hQeq (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hσ : σ ^ 2 = 1) (hA : 0 < σ * (A.re - h)) + (hB : 0 < σ * (B.re - h)) (hAB : A.im < B.im) : (Q h A B) = (T h σ A B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} + have hQsub : Q ⊆ T := hQsub h σ A B hA hB hAB + have hTsub : T ⊆ Q := hTsub h σ A B hσ hA hB hAB + change (Q = T) + exact Set.Subset.antisymm hQsub hTsub + +private noncomputable abbrev S (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) : Set ℂ := by + classical + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + exact {z | A.im < z.im} ∩ {z | z.im < B.im} ∩ + {z | 0 < σ * (z.re - h)} ∩ {z | 0 < σ * (d z.im - z.re)} + +private theorem hcReLip : LipschitzWith 1 (fun z : ℂ => z.re) := by + classical + intro z w + rw [edist_dist, edist_dist, Real.dist_eq, Complex.dist_eq] + have he : |z.re - w.re| ≤ ‖z - w‖ := by + calc + |z.re - w.re| = |(z - w).re| := by simp + _ ≤ ‖z - w‖ := Complex.abs_re_le_norm _ + calc + ENNReal.ofReal |z.re - w.re| ≤ ENNReal.ofReal ‖z - w‖ := ENNReal.ofReal_le_ofReal he + _ = ((1 : NNReal) : ENNReal) * ENNReal.ofReal ‖z - w‖ := by norm_num + +private theorem hcImLip : LipschitzWith 1 (fun z : ℂ => z.im) := by + classical + intro z w + rw [edist_dist, edist_dist, Real.dist_eq, Complex.dist_eq] + have he : |z.im - w.im| ≤ ‖z - w‖ := by + calc + |z.im - w.im| = |(z - w).im| := by simp + _ ≤ ‖z - w‖ := Complex.abs_im_le_norm _ + calc + ENNReal.ofReal |z.im - w.im| ≤ ENNReal.ofReal ‖z - w‖ := ENNReal.ofReal_le_ofReal he + _ = ((1 : NNReal) : ENNReal) * ENNReal.ofReal ‖z - w‖ := by norm_num + +private theorem hcIm : Continuous fun z : ℂ => z.im := by + classical + have hcImLip : LipschitzWith 1 (fun z : ℂ => z.im) := hcImLip + exact hcImLip.continuous + +private theorem hcRe : Continuous fun z : ℂ => z.re := by + classical + have hcReLip : LipschitzWith 1 (fun z : ℂ => z.re) := hcReLip + exact hcReLip.continuous + +private theorem hcD (A : ℂ) (B : ℂ) : Continuous fun z : ℂ => (d A B) z.im := by + classical + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + have hcIm : Continuous fun z : ℂ => z.im := hcIm + change (Continuous fun z : ℂ => d z.im) + dsimp [d] + exact continuous_const.add + ((continuous_const.mul (hcIm.sub continuous_const)).div_const (B.im - A.im)) + +private theorem hcSide (h : ℝ) (σ : ℝ) : Continuous fun z : ℂ => σ * (z.re - h) := by + classical + have hcRe : Continuous fun z : ℂ => z.re := hcRe + exact continuous_const.mul (hcRe.sub continuous_const) + +private theorem hcTop (σ : ℝ) (A : ℂ) (B : ℂ) : Continuous fun z : ℂ => σ * ((d A B) z.im - z.re) + := by + classical + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + have hcRe : Continuous fun z : ℂ => z.re := hcRe + have hcD : Continuous fun z : ℂ => d z.im := hcD A B + change (Continuous fun z : ℂ => σ * (d z.im - z.re)) + exact continuous_const.mul (hcD.sub hcRe) + +private theorem hSopen (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) : IsOpen (S h σ A B) := by + classical + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let S : Set ℂ := {z | A.im < z.im} ∩ {z | z.im < B.im} ∩ + {z | 0 < σ * (z.re - h)} ∩ {z | 0 < σ * (d z.im - z.re)} + have hcIm : Continuous fun z : ℂ => z.im := hcIm + have hcSide : Continuous fun z : ℂ => σ * (z.re - h) := hcSide h σ + have hcTop : Continuous fun z : ℂ => σ * (d z.im - z.re) := hcTop σ A B + change (IsOpen S) + dsimp [S] + exact (isOpen_lt continuous_const hcIm).inter + (isOpen_lt hcIm continuous_const) |>.inter + (isOpen_lt continuous_const hcSide) |>.inter + (isOpen_lt continuous_const hcTop) + +private theorem hSsub (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hσ : σ ^ 2 = 1) (hA : 0 < σ * (A.re - h)) + (hB : 0 < σ * (B.re - h)) (hAB : A.im < B.im) : (S h σ A B) ⊆ (Q h A B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} + have hTsub : T ⊆ Q := hTsub h σ A B hσ hA hB hAB + let S : Set ℂ := {z | A.im < z.im} ∩ {z | z.im < B.im} ∩ + {z | 0 < σ * (z.re - h)} ∩ {z | 0 < σ * (d z.im - z.re)} + change (S ⊆ Q) + intro z hz + apply hTsub + rcases hz with ⟨⟨⟨hz₁, hz₂⟩, hz₃⟩, hz₄⟩ + exact ⟨hz₁.le, hz₂.le, hz₃.le, hz₄.le⟩ + +private theorem hSinter (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hσ : σ ^ 2 = 1) (hA : 0 < σ * (A.re - + h)) (hB : 0 < σ * (B.re - h)) (hAB : A.im < B.im) : (S h σ A B) ⊆ interior (Q h A B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + let S : Set ℂ := {z | A.im < z.im} ∩ {z | z.im < B.im} ∩ + {z | 0 < σ * (z.re - h)} ∩ {z | 0 < σ * (d z.im - z.re)} + have hSopen : IsOpen S := hSopen h σ A B + have hSsub : S ⊆ Q := hSsub h σ A B hσ hA hB hAB + change (S ⊆ interior Q) + exact hSopen.subset_interior_iff.mpr hSsub + +private theorem hInteriorRev (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hσ : σ ^ 2 = 1) (hA : 0 < σ * (A.re + - h)) (hB : 0 < σ * (B.re - h)) (hAB : A.im < B.im) (x : ℂ) (hx : x ∈ interior (Q h A B)) : x + ∈ (S h σ A B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + have hσsq : σ * σ = 1 := hσsq σ hσ + let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} + have hQsub : Q ⊆ T := hQsub h σ A B hA hB hAB + let S : Set ℂ := {z | A.im < z.im} ∩ {z | z.im < B.im} ∩ + {z | 0 < σ * (z.re - h)} ∩ {z | 0 < σ * (d z.im - z.re)} + change (x ∈ S) + have hxQ := hQsub (interior_subset hx) + change A.im ≤ x.im ∧ x.im ≤ B.im ∧ + 0 ≤ σ * (x.re - h) ∧ 0 ≤ σ * (d x.im - x.re) at hxQ + obtain ⟨ε, hε, hball⟩ := Metric.mem_nhds_iff.mp + (mem_interior_iff_mem_nhds.mp hx) + have stepV (r : ℝ) (hr : |r| < ε) : + x + (r : ℂ) * Complex.I ∈ Metric.ball x ε := by + rw [Metric.mem_ball, Complex.dist_eq, add_sub_cancel_left, + Complex.norm_mul, Complex.norm_I, Complex.norm_real, Real.norm_eq_abs] + simpa using hr + have stepR (r : ℝ) (hr : |r| < ε) : + x + (r : ℂ) ∈ Metric.ball x ε := by + rw [Metric.mem_ball, Complex.dist_eq, add_sub_cancel_left, + Complex.norm_real, Real.norm_eq_abs] + simpa using hr + have hVlo := hQsub (hball (stepV (-ε / 2) (by + rw [abs_of_neg (by linarith [hε])] + linarith))) + have hVhi := hQsub (hball (stepV (ε / 2) (by + rw [abs_of_pos (by linarith [hε])] + linarith))) + change A.im ≤ (x + ((-ε / 2 : ℝ) : ℂ) * Complex.I).im ∧ _ at hVlo + change A.im ≤ (x + ((ε / 2 : ℝ) : ℂ) * Complex.I).im ∧ _ at hVhi + simp only [Complex.add_im, Complex.mul_im, Complex.ofReal_re, Complex.I_im, + mul_one, Complex.ofReal_im, Complex.I_re, mul_zero, add_zero] at hVlo hVhi + have hsigmaAbs : |σ| = 1 := by + have habs : |σ| * |σ| = 1 := by + calc + |σ| * |σ| = |σ * σ| := by rw [abs_mul] + _ = |1| := by rw [← pow_two, hσ] + _ = 1 := abs_one + nlinarith [habs, abs_nonneg σ] + have hrAbs : |σ * ε / 2| = ε / 2 := by + rw [abs_div, abs_mul, hsigmaAbs, abs_of_pos hε] + norm_num + have hRlo := hQsub (hball (stepR (-σ * ε / 2) (by + rw [show -σ * ε / 2 = -(σ * ε / 2) by ring, abs_neg, hrAbs] + linarith))) + have hRhi := hQsub (hball (stepR (σ * ε / 2) (by + rw [hrAbs] + linarith))) + change _ ∧ _ ∧ 0 ≤ σ * ((x + ((-σ * ε / 2 : ℝ) : ℂ)).re - h) ∧ _ at hRlo + change _ ∧ _ ∧ _ ∧ 0 ≤ σ * (d (x + ((σ * ε / 2 : ℝ) : ℂ)).im - + (x + ((σ * ε / 2 : ℝ) : ℂ)).re) at hRhi + simp only [Complex.add_re, Complex.ofReal_re, Complex.add_im, Complex.ofReal_im, + add_zero] at hRlo hRhi + have hstrictYlo : A.im < x.im := by linarith [hVlo.1] + have hstrictYhi : x.im < B.im := by linarith [hVhi.2.1] + have hstrictX : 0 < σ * (x.re - h) := by + have := hRlo.2.2.1 + nlinarith [hσsq] + have hstrictD : 0 < σ * (d x.im - x.re) := by + have := hRhi.2.2.2 + nlinarith [hσsq] + change x ∈ S + exact ⟨⟨⟨hstrictYlo, hstrictYhi⟩, hstrictX⟩, hstrictD⟩ + +private theorem hInteriorEq (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hσ : σ ^ 2 = 1) (hA : 0 < σ * (A.re + - h)) (hB : 0 < σ * (B.re - h)) (hAB : A.im < B.im) : interior (Q h A B) = (S h σ A B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + let S : Set ℂ := {z | A.im < z.im} ∩ {z | z.im < B.im} ∩ + {z | 0 < σ * (z.re - h)} ∩ {z | 0 < σ * (d z.im - z.re)} + have hSinter : S ⊆ interior Q := hSinter h σ A B hσ hA hB hAB + have hInteriorRev (x : ℂ) (hx : x ∈ interior Q) : x ∈ S := hInteriorRev h σ A B hσ hA hB hAB x hx + change (interior Q = S) + ext z + constructor + · exact hInteriorRev z + · exact fun hz => hSinter hz + +private theorem hTclosed (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) : IsClosed (T h σ A B) := by + classical + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} + have hcIm : Continuous fun z : ℂ => z.im := hcIm + have hcSide : Continuous fun z : ℂ => σ * (z.re - h) := hcSide h σ + have hcTop : Continuous fun z : ℂ => σ * (d z.im - z.re) := hcTop σ A B + change (IsClosed T) + have hset : T = ({z : ℂ | A.im ≤ z.im} ∩ {z | z.im ≤ B.im} ∩ + {z | 0 ≤ σ * (z.re - h)} ∩ {z | 0 ≤ σ * (d z.im - z.re)}) := by + ext z + simp only [Set.mem_ofPred_eq, Set.mem_inter_iff] + simp [T]; tauto + rw [hset] + exact (isClosed_le continuous_const hcIm).inter + (isClosed_le hcIm continuous_const) |>.inter + (isClosed_le continuous_const hcSide) |>.inter + (isClosed_le continuous_const hcTop) + +private theorem hfrontier (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hσ : σ ^ 2 = 1) (hA : 0 < σ * (A.re - + h)) (hB : 0 < σ * (B.re - h)) (hAB : A.im < B.im) : frontier (Q h A B) = (Q h A B) \ interior + (Q h A B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} + have hQeq : Q = T := hQeq h σ A B hσ hA hB hAB + have hTclosed : IsClosed T := hTclosed h σ A B + change (frontier Q = Q \ interior Q) + simpa [Q, hQeq] using hTclosed.frontier_eq + +private theorem segCoords (P R z : ℂ) : z ∈ segment ℝ P R ↔ + ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ + z.re = (1 - t) * P.re + t * R.re ∧ + z.im = (1 - t) * P.im + t * R.im := by + classical + rw [segment_eq_image] + simp only [Set.mem_image] + constructor + · rintro ⟨t, ht, hz⟩ + have hre := congrArg Complex.re hz + have him := congrArg Complex.im hz + simp only [Complex.add_re, Complex.smul_re, smul_eq_mul] at hre + simp only [Complex.add_im, Complex.smul_im, smul_eq_mul] at him + exact ⟨t, ht.1, ht.2, hre.symm, him.symm⟩ + · rintro ⟨t, ht0, ht1, hre, him⟩ + refine ⟨t, ⟨ht0, ht1⟩, ?_⟩ + apply Complex.ext + · simpa only [Complex.add_re, Complex.smul_re, Complex.ofReal_re, smul_eq_mul] using hre.symm + · simpa only [Complex.add_im, Complex.smul_im, Complex.ofReal_im, smul_eq_mul] using him.symm + +private theorem hDinterp (A : ℂ) (B : ℂ) (hAB : A.im < B.im) (t : ℝ) : (d A B) ((1 - t) * A.im + + t * B.im) = + (1 - t) * A.re + t * B.re := by + classical + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + change (d ((1 - t) * A.im + t * B.im) = + (1 - t) * A.re + t * B.re) + dsimp [d] + field_simp [ne_of_gt (sub_pos.mpr hAB)] + ring + +private theorem heightParam (y u v : ℝ) (huv : u < v) (hyu : u ≤ y) (hyv : y ≤ v) : + ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ y = (1 - t) * u + t * v := by + classical + let t := (y - u) / (v - u) + have hv : 0 < v - u := sub_pos.mpr huv + have ht0 : 0 ≤ t := by + dsimp [t] + exact div_nonneg (sub_nonneg.mpr hyu) hv.le + have ht1 : t ≤ 1 := by + dsimp [t] + apply (div_le_one₀ hv).2 + linarith + refine ⟨t, ht0, ht1, ?_⟩ + dsimp [t] + field_simp [ne_of_gt hv] + ring + +private theorem sideParam (h : ℝ) (σ : ℝ) (hσ : σ ^ 2 = 1) (x c : ℝ) (hc : 0 < σ * (c - h)) + (hlo : 0 ≤ σ * (x - h)) (hhi : 0 ≤ σ * (c - x)) : + ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ x = (1 - t) * c + t * h := by + classical + have hσsq : σ * σ = 1 := hσsq σ hσ + let s := σ * (x - h) / (σ * (c - h)) + have hs0 : 0 ≤ s := by + dsimp [s] + exact div_nonneg hlo hc.le + have hnumle : σ * (x - h) ≤ σ * (c - h) := by nlinarith + have hs1 : s ≤ 1 := by + dsimp [s] + exact (div_le_one₀ hc).2 hnumle + have hcancel : s * (σ * (c - h)) = σ * (x - h) := by + dsimp [s] + exact div_mul_cancel₀ _ (ne_of_gt hc) + have hratio : s * (c - h) = x - h := by + calc + s * (c - h) = σ * (s * (σ * (c - h))) := by + calc + s * (c - h) = s * (c - h) * (σ * σ) := by rw [hσsq]; ring + _ = σ * (s * (σ * (c - h))) := by ring + _ = σ * (σ * (x - h)) := by rw [hcancel] + _ = x - h := by + calc + σ * (σ * (x - h)) = (σ * σ) * (x - h) := by ring + _ = x - h := by rw [hσsq]; ring + refine ⟨1 - s, by linarith, by linarith, ?_⟩ + rw [show x = h + s * (c - h) by linarith [hratio]] + ring + +private theorem hSegFoot (h : ℝ) (A : ℂ) (B : ℂ) (hAB : A.im < B.im) (z : ℂ) (hzY₁ : A.im ≤ z.im) + (hzY₂ : z.im ≤ B.im) + (hzx : z.re = h) : z ∈ segment ℝ (fA h A) (fB h B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + have segCoords (P R z : ℂ) : z ∈ segment ℝ P R ↔ + ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ + z.re = (1 - t) * P.re + t * R.re ∧ + z.im = (1 - t) * P.im + t * R.im := segCoords P R z + have heightParam (y u v : ℝ) (huv : u < v) (hyu : u ≤ y) (hyv : y ≤ v) : + ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ y = (1 - t) * u + t * v := heightParam y u v huv hyu hyv + change (z ∈ segment ℝ fA fB) + obtain ⟨t, ht0, ht1, him⟩ := heightParam z.im A.im B.im hAB hzY₁ hzY₂ + apply (segCoords fA fB z).2 + refine ⟨t, ht0, ht1, ?_, ?_⟩ + · rw [hzx] + simp only [fA, fB] + ring + · simpa [fA, fB] using him + +private theorem hSegDiag (A : ℂ) (B : ℂ) (hAB : A.im < B.im) (z : ℂ) (hzY₁ : A.im ≤ z.im) (hzY₂ : + z.im ≤ B.im) + (hzd : z.re = (d A B) z.im) : z ∈ segment ℝ A B := by + classical + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + have segCoords (P R z : ℂ) : z ∈ segment ℝ P R ↔ + ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ + z.re = (1 - t) * P.re + t * R.re ∧ + z.im = (1 - t) * P.im + t * R.im := segCoords P R z + have hDinterp (t : ℝ) : d ((1 - t) * A.im + t * B.im) = + (1 - t) * A.re + t * B.re := hDinterp A B hAB t + have heightParam (y u v : ℝ) (huv : u < v) (hyu : u ≤ y) (hyv : y ≤ v) : + ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ y = (1 - t) * u + t * v := heightParam y u v huv hyu hyv + obtain ⟨t, ht0, ht1, him⟩ := heightParam z.im A.im B.im hAB hzY₁ hzY₂ + apply (segCoords A B z).2 + refine ⟨t, ht0, ht1, ?_, him⟩ + calc + z.re = d z.im := hzd + _ = (1 - t) * A.re + t * B.re := by rw [him]; exact hDinterp t + +private theorem hSegA (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hσ : σ ^ 2 = 1) (hA : 0 < σ * (A.re - h)) + (hAB : A.im < B.im) (z : ℂ) (hz : z ∈ (T h σ A B)) (hzy : z.im = A.im) : + z ∈ segment ℝ A (fA h A) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} + have hda : d A.im = A.re := hda A B hAB + have segCoords (P R z : ℂ) : z ∈ segment ℝ P R ↔ + ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ + z.re = (1 - t) * P.re + t * R.re ∧ + z.im = (1 - t) * P.im + t * R.im := segCoords P R z + have sideParam (x c : ℝ) (hc : 0 < σ * (c - h)) + (hlo : 0 ≤ σ * (x - h)) (hhi : 0 ≤ σ * (c - x)) : + ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ x = (1 - t) * c + t * h := sideParam h σ hσ x c hc hlo hhi + change (z ∈ segment ℝ A fA) + change A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re) at hz + have hhi : 0 ≤ σ * (A.re - z.re) := by simpa [hzy, hda] using hz.2.2.2 + obtain ⟨t, ht0, ht1, hre⟩ := sideParam z.re A.re hA hz.2.2.1 hhi + apply (segCoords A fA z).2 + refine ⟨t, ht0, ht1, ?_, ?_⟩ + · simpa [fA] using hre + · rw [hzy] + simp only [fA] + ring + +private theorem hSegB (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hσ : σ ^ 2 = 1) (hB : 0 < σ * (B.re - h)) + (hAB : A.im < B.im) (z : ℂ) (hz : z ∈ (T h σ A B)) (hzy : z.im = B.im) : + z ∈ segment ℝ B (fB h B) := by + classical + let fB : ℂ := ⟨h, B.im⟩ + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} + have hdb : d B.im = B.re := hdb A B hAB + have segCoords (P R z : ℂ) : z ∈ segment ℝ P R ↔ + ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ + z.re = (1 - t) * P.re + t * R.re ∧ + z.im = (1 - t) * P.im + t * R.im := segCoords P R z + have sideParam (x c : ℝ) (hc : 0 < σ * (c - h)) + (hlo : 0 ≤ σ * (x - h)) (hhi : 0 ≤ σ * (c - x)) : + ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ x = (1 - t) * c + t * h := sideParam h σ hσ x c hc hlo hhi + change (z ∈ segment ℝ B fB) + change A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re) at hz + have hlow : 0 ≤ σ * (z.re - h) := hz.2.2.1 + have hhi : 0 ≤ σ * (B.re - z.re) := by simpa [hzy, hdb] using hz.2.2.2 + obtain ⟨t, ht0, ht1, hre⟩ := sideParam z.re B.re hB hlow hhi + apply (segCoords B fB z).2 + refine ⟨t, ht0, ht1, ?_, ?_⟩ + · simpa [fB] using hre + · rw [hzy] + simp only [fB] + ring + +private noncomputable abbrev E (h : ℝ) (A : ℂ) (B : ℂ) := segment ℝ A B ∪ segment ℝ A (fA h A) ∪ + segment ℝ B (fB h B) ∪ + segment ℝ (fA h A) (fB h B) + +private theorem hAin (h : ℝ) (A : ℂ) (B : ℂ) : A ∈ (Q h A B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + change (A ∈ Q) + dsimp [Q]; exact subset_convexHull ℝ _ (by simp) + +private theorem hBin (h : ℝ) (A : ℂ) (B : ℂ) : B ∈ (Q h A B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + change (B ∈ Q) + dsimp [Q]; exact subset_convexHull ℝ _ (by simp) + +private theorem hfAin (h : ℝ) (A : ℂ) (B : ℂ) : (fA h A) ∈ (Q h A B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + change (fA ∈ Q) + dsimp [Q]; exact subset_convexHull ℝ _ (by simp [fA]) + +private theorem hfBin (h : ℝ) (A : ℂ) (B : ℂ) : (fB h B) ∈ (Q h A B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + change (fB ∈ Q) + dsimp [Q]; exact subset_convexHull ℝ _ (by simp [fB]) + +private theorem hEsub (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hσ : σ ^ 2 = 1) (hA : 0 < σ * (A.re - h)) + (hB : 0 < σ * (B.re - h)) (hAB : A.im < B.im) : (E h A B) ⊆ (Q h A B) \ interior (Q h A B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + let S : Set ℂ := {z | A.im < z.im} ∩ {z | z.im < B.im} ∩ + {z | 0 < σ * (z.re - h)} ∩ {z | 0 < σ * (d z.im - z.re)} + have hInteriorEq : interior Q = S := hInteriorEq h σ A B hσ hA hB hAB + have segCoords (P R z : ℂ) : z ∈ segment ℝ P R ↔ + ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ + z.re = (1 - t) * P.re + t * R.re ∧ + z.im = (1 - t) * P.im + t * R.im := segCoords P R z + have hDinterp (t : ℝ) : d ((1 - t) * A.im + t * B.im) = + (1 - t) * A.re + t * B.re := hDinterp A B hAB t + let E := segment ℝ A B ∪ segment ℝ A fA ∪ segment ℝ B fB ∪ + segment ℝ fA fB + have hAin : A ∈ Q := hAin h A B + have hBin : B ∈ Q := hBin h A B + have hfAin : fA ∈ Q := hfAin h A B + have hfBin : fB ∈ Q := hfBin h A B + change (E ⊆ Q \ interior Q) + intro z hz + constructor + · change z ∈ E at hz + dsimp [E] at hz + rcases hz with hz | hz + · rcases hz with hz | hz + · rcases hz with hz | hz + · exact (convex_convexHull ℝ _).segment_subset hAin hBin hz + · exact (convex_convexHull ℝ _).segment_subset hAin hfAin hz + · exact (convex_convexHull ℝ _).segment_subset hBin hfBin hz + · exact (convex_convexHull ℝ _).segment_subset hfAin hfBin hz + · rw [hInteriorEq] + dsimp [E] at hz + rcases hz with hz | hz + · rcases hz with hz | hz + · rcases hz with hz | hz + · intro hs + obtain ⟨t, ht0, ht1, hre, him⟩ := (segCoords A B z).mp hz + rcases hs with ⟨⟨⟨_, _⟩, _⟩, hsupper⟩ + have hdeq : d z.im = z.re := by + rw [him, hDinterp t] + exact hre.symm + change 0 < σ * (d z.im - z.re) at hsupper + rw [hdeq] at hsupper + simp at hsupper + · intro hs + obtain ⟨t, ht0, ht1, hre, him⟩ := (segCoords A fA z).mp hz + rcases hs with ⟨⟨⟨hlo, _⟩, _⟩, _⟩ + change A.im < z.im at hlo + have hconst : (1 - t) * A.im + t * A.im = A.im := by ring + simp only [fA] at him + rw [hconst] at him + linarith + · intro hs + obtain ⟨t, ht0, ht1, hre, him⟩ := (segCoords B fB z).mp hz + rcases hs with ⟨⟨⟨_, hhi⟩, _⟩, _⟩ + change z.im < B.im at hhi + have hconst : (1 - t) * B.im + t * B.im = B.im := by ring + simp only [fB] at him + rw [hconst] at him + linarith + · intro hs + obtain ⟨t, ht0, ht1, hre, him⟩ := (segCoords fA fB z).mp hz + rcases hs with ⟨⟨⟨_, _⟩, hsx⟩, _⟩ + change 0 < σ * (z.re - h) at hsx + have hconst : (1 - t) * h + t * h = h := by ring + simp only [fA, fB] at hre + rw [hconst] at hre + rw [hre] at hsx + simp at hsx + +private theorem hBoundarySub (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hσ : σ ^ 2 = 1) (hA : 0 < σ * (A.re + - h)) (hB : 0 < σ * (B.re - h)) (hAB : A.im < B.im) : (Q h A B) \ interior (Q h A B) ⊆ (E h A + B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + have hσsq : σ * σ = 1 := hσsq σ hσ + let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} + have hQsub : Q ⊆ T := hQsub h σ A B hA hB hAB + let S : Set ℂ := {z | A.im < z.im} ∩ {z | z.im < B.im} ∩ + {z | 0 < σ * (z.re - h)} ∩ {z | 0 < σ * (d z.im - z.re)} + have hInteriorEq : interior Q = S := hInteriorEq h σ A B hσ hA hB hAB + have hSegFoot (z : ℂ) (hzY₁ : A.im ≤ z.im) (hzY₂ : z.im ≤ B.im) + (hzx : z.re = h) : z ∈ segment ℝ fA fB := hSegFoot h A B hAB z hzY₁ hzY₂ hzx + have hSegDiag (z : ℂ) (hzY₁ : A.im ≤ z.im) (hzY₂ : z.im ≤ B.im) + (hzd : z.re = d z.im) : z ∈ segment ℝ A B := hSegDiag A B hAB z hzY₁ hzY₂ hzd + have hSegA (z : ℂ) (hz : z ∈ T) (hzy : z.im = A.im) : + z ∈ segment ℝ A fA := hSegA h σ A B hσ hA hAB z hz hzy + have hSegB (z : ℂ) (hz : z ∈ T) (hzy : z.im = B.im) : + z ∈ segment ℝ B fB := hSegB h σ A B hσ hB hAB z hz hzy + let E := segment ℝ A B ∪ segment ℝ A fA ∪ segment ℝ B fB ∪ + segment ℝ fA fB + change (Q \ interior Q ⊆ E) + intro z hz + rcases hz with ⟨hzQ, hnint⟩ + have hzT := hQsub hzQ + rw [hInteriorEq] at hnint + change A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re) at hzT + change z ∉ S at hnint + rcases lt_or_eq_of_le hzT.1 with hylo | hylo + · rcases lt_or_eq_of_le hzT.2.1 with hyhi | hyhi + · rcases lt_or_eq_of_le hzT.2.2.1 with hxlo | hxlo + · rcases lt_or_eq_of_le hzT.2.2.2 with hxhi | hxhi + · exfalso + apply hnint + exact ⟨⟨⟨hylo, hyhi⟩, hxlo⟩, hxhi⟩ + · have hdiag : z.re = d z.im := by + have hmul := congrArg (fun y : ℝ => σ * y) hxhi + have hzero : d z.im - z.re = 0 := by + calc + d z.im - z.re = (σ * σ) * (d z.im - z.re) := by rw [hσsq]; ring + _ = σ * (σ * (d z.im - z.re)) := by ring + _ = σ * 0 := hmul.symm + _ = 0 := by ring + linarith + change z ∈ segment ℝ A B ∪ segment ℝ A fA ∪ segment ℝ B fB ∪ + segment ℝ fA fB + exact Or.inl (Or.inl (Or.inl (hSegDiag z hzT.1 hzT.2.1 hdiag))) + · have hleft : z.re = h := by + have hmul := congrArg (fun y : ℝ => σ * y) hxlo + have hzero : z.re - h = 0 := by + calc + z.re - h = (σ * σ) * (z.re - h) := by rw [hσsq]; ring + _ = σ * (σ * (z.re - h)) := by ring + _ = σ * 0 := hmul.symm + _ = 0 := by ring + linarith + change z ∈ segment ℝ A B ∪ segment ℝ A fA ∪ segment ℝ B fB ∪ + segment ℝ fA fB + exact Or.inr (hSegFoot z hzT.1 hzT.2.1 hleft) + · have hzy : z.im = B.im := hyhi + change z ∈ segment ℝ A B ∪ segment ℝ A fA ∪ segment ℝ B fB ∪ + segment ℝ fA fB + exact Or.inl (Or.inr (hSegB z hzT hzy)) + · have hzy : z.im = A.im := hylo.symm + change z ∈ segment ℝ A B ∪ segment ℝ A fA ∪ segment ℝ B fB ∪ + segment ℝ fA fB + exact Or.inl (Or.inl (Or.inr (hSegA z hzT hzy))) + +private theorem hBoundary (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hσ : σ ^ 2 = 1) (hA : 0 < σ * (A.re - + h)) (hB : 0 < σ * (B.re - h)) (hAB : A.im < B.im) : (Q h A B) \ interior (Q h A B) = (E h A + B) := by + classical + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + let E := segment ℝ A B ∪ segment ℝ A fA ∪ segment ℝ B fB ∪ + segment ℝ fA fB + have hEsub : E ⊆ Q \ interior Q := hEsub h σ A B hσ hA hB hAB + have hBoundarySub : Q \ interior Q ⊆ E := hBoundarySub h σ A B hσ hA hB hAB + change (Q \ interior Q = E) + exact Set.Subset.antisymm hBoundarySub hEsub + +end QuadrilateralSectionsConstruction + +theorem P4953T1QuadrilateralSections (h σ : ℝ) (A B : ℂ) + (hσ : σ ^ 2 = 1) (hA : 0 < σ * (A.re - h)) + (hB : 0 < σ * (B.re - h)) (hAB : A.im < B.im) : + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + (∀ z, z ∈ Q ↔ A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)) ∧ + (∀ z, z ∈ interior Q ↔ A.im < z.im ∧ z.im < B.im ∧ + 0 < σ * (z.re - h) ∧ 0 < σ * (d z.im - z.re)) ∧ + frontier Q = segment ℝ A B ∪ segment ℝ A fA ∪ + segment ℝ B fB ∪ segment ℝ fA fB := by +-- BODY + classical + dsimp only + let fA : ℂ := ⟨h, A.im⟩ + let fB : ℂ := ⟨h, B.im⟩ + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) + have hσsq : σ * σ = 1 := QuadrilateralSectionsConstruction.hσsq σ hσ + let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ + 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} + have hconv : Convex ℝ T := QuadrilateralSectionsConstruction.hconv h σ A B hAB + have hda : d A.im = A.re := QuadrilateralSectionsConstruction.hda A B hAB + have hdb : d B.im = B.re := QuadrilateralSectionsConstruction.hdb A B hAB + have hQsub : Q ⊆ T := QuadrilateralSectionsConstruction.hQsub h σ A B hA hB hAB + have hTsub : T ⊆ Q := QuadrilateralSectionsConstruction.hTsub h σ A B hσ hA hB hAB + have hQeq : Q = T := QuadrilateralSectionsConstruction.hQeq h σ A B hσ hA hB hAB + let S : Set ℂ := {z | A.im < z.im} ∩ {z | z.im < B.im} ∩ + {z | 0 < σ * (z.re - h)} ∩ {z | 0 < σ * (d z.im - z.re)} + have hcReLip : LipschitzWith 1 (fun z : ℂ => z.re) := QuadrilateralSectionsConstruction.hcReLip + have hcImLip : LipschitzWith 1 (fun z : ℂ => z.im) := QuadrilateralSectionsConstruction.hcImLip + have hcIm : Continuous fun z : ℂ => z.im := QuadrilateralSectionsConstruction.hcIm + have hcRe : Continuous fun z : ℂ => z.re := QuadrilateralSectionsConstruction.hcRe + have hcD : Continuous fun z : ℂ => d z.im := QuadrilateralSectionsConstruction.hcD A B + have hcSide : Continuous fun z : ℂ => σ * (z.re - h) := + QuadrilateralSectionsConstruction.hcSide h σ + have hcTop : Continuous fun z : ℂ => σ * (d z.im - z.re) := + QuadrilateralSectionsConstruction.hcTop σ A B + have hSopen : IsOpen S := QuadrilateralSectionsConstruction.hSopen h σ A B + have hSsub : S ⊆ Q := QuadrilateralSectionsConstruction.hSsub h σ A B hσ hA hB hAB + have hSinter : S ⊆ interior Q := QuadrilateralSectionsConstruction.hSinter h σ A B hσ hA hB hAB + have hInteriorRev (x : ℂ) (hx : x ∈ interior Q) : x ∈ S := + QuadrilateralSectionsConstruction.hInteriorRev h σ A B hσ hA hB hAB x hx + have hInteriorEq : interior Q = S := QuadrilateralSectionsConstruction.hInteriorEq h σ A B hσ + hA hB hAB + have hTclosed : IsClosed T := QuadrilateralSectionsConstruction.hTclosed h σ A B + have hfrontier : frontier Q = Q \ interior Q := QuadrilateralSectionsConstruction.hfrontier h σ + A B hσ hA hB hAB + have segCoords (P R z : ℂ) : z ∈ segment ℝ P R ↔ + ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ + z.re = (1 - t) * P.re + t * R.re ∧ + z.im = (1 - t) * P.im + t * R.im := QuadrilateralSectionsConstruction.segCoords P R z + have hDinterp (t : ℝ) : d ((1 - t) * A.im + t * B.im) = + (1 - t) * A.re + t * B.re := QuadrilateralSectionsConstruction.hDinterp A B hAB t + have heightParam (y u v : ℝ) (huv : u < v) (hyu : u ≤ y) (hyv : y ≤ v) : + ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ y = (1 - t) * u + t * v := + QuadrilateralSectionsConstruction.heightParam y u v huv hyu hyv + have sideParam (x c : ℝ) (hc : 0 < σ * (c - h)) + (hlo : 0 ≤ σ * (x - h)) (hhi : 0 ≤ σ * (c - x)) : + ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ x = (1 - t) * c + t * h := + QuadrilateralSectionsConstruction.sideParam h σ hσ x c hc hlo hhi + have hSegFoot (z : ℂ) (hzY₁ : A.im ≤ z.im) (hzY₂ : z.im ≤ B.im) + (hzx : z.re = h) : z ∈ segment ℝ fA fB := QuadrilateralSectionsConstruction.hSegFoot h A B + hAB z hzY₁ hzY₂ hzx + have hSegDiag (z : ℂ) (hzY₁ : A.im ≤ z.im) (hzY₂ : z.im ≤ B.im) + (hzd : z.re = d z.im) : z ∈ segment ℝ A B := QuadrilateralSectionsConstruction.hSegDiag A B + hAB z hzY₁ hzY₂ hzd + have hSegA (z : ℂ) (hz : z ∈ T) (hzy : z.im = A.im) : + z ∈ segment ℝ A fA := QuadrilateralSectionsConstruction.hSegA h σ A B hσ hA hAB z hz hzy + have hSegB (z : ℂ) (hz : z ∈ T) (hzy : z.im = B.im) : + z ∈ segment ℝ B fB := QuadrilateralSectionsConstruction.hSegB h σ A B hσ hB hAB z hz hzy + let E := segment ℝ A B ∪ segment ℝ A fA ∪ segment ℝ B fB ∪ + segment ℝ fA fB + have hAin : A ∈ Q := QuadrilateralSectionsConstruction.hAin h A B + have hBin : B ∈ Q := QuadrilateralSectionsConstruction.hBin h A B + have hfAin : fA ∈ Q := QuadrilateralSectionsConstruction.hfAin h A B + have hfBin : fB ∈ Q := QuadrilateralSectionsConstruction.hfBin h A B + have hEsub : E ⊆ Q \ interior Q := QuadrilateralSectionsConstruction.hEsub h σ A B hσ hA hB hAB + have hBoundarySub : Q \ interior Q ⊆ E := QuadrilateralSectionsConstruction.hBoundarySub h σ A + B hσ hA hB hAB + have hBoundary : Q \ interior Q = E := QuadrilateralSectionsConstruction.hBoundary h σ A B hσ + hA hB hAB + refine ⟨?_, ?_, ?_⟩ + · intro z + change z ∈ Q ↔ z ∈ T + rw [hQeq] + · intro z + rw [hInteriorEq] + simp [S, d]; tauto + · calc + frontier Q = Q \ interior Q := hfrontier + _ = E := hBoundary + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean b/LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean new file mode 100644 index 0000000000..9b4901d57a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean @@ -0,0 +1,1300 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Complex.Norm +public import Mathlib.Analysis.Convex.Hull +public import Mathlib.LinearAlgebra.Complex.Module +public import Mathlib.LinearAlgebra.AffineSpace.FiniteDimensional +public import Mathlib.Analysis.Convex.Combination + +-- [TABLET NODE: P4953T1TriangleSections] + +/-! +# P4953T1TriangleSections + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TriangleSections + +private noncomputable def u (A : ℂ) := A.im + +private noncomputable def w (x : ℂ) := x.im + +private noncomputable def v (B : ℂ) := B.im + +private noncomputable def d (A : ℂ) (B : ℂ) : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) + / (B.im - A.im) + +private noncomputable def e (A : ℂ) (x : ℂ) : ℝ → ℝ := fun y => A.re + (x.re - A.re) * (y - A.im) + / (x.im - A.im) + +private noncomputable def f (x : ℂ) (B : ℂ) : ℝ → ℝ := fun y => x.re + (B.re - x.re) * (y - x.im) + / (B.im - x.im) + +private noncomputable def δ (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) := σ * ((d A B) (w x) - x.re) + +private theorem huw (A : ℂ) (x : ℂ) (hAx : A.im < x.im) : (u A) < (w x) := by + classical + let u := A.im + let w := x.im + change (u < w) + exact hAx + +private theorem hwv (x : ℂ) (B : ℂ) (hxB : x.im < B.im) : (w x) < (v B) := by + classical + let w := x.im + let v := B.im + change (w < v) + exact hxB + +private theorem huv (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) : (u A) < (v + B) := by + classical + let u := A.im + let w := x.im + let v := B.im + have huw : u < w := huw A x hAx + have hwv : w < v := hwv x B hxB + change (u < v) + exact lt_trans huw hwv + +private theorem hσmul (σ : ℝ) (hσ : σ ^ 2 = 1) : σ * σ = 1 := by + classical + nlinarith [hσ] + +private theorem hδ (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im + - A.im) / (B.im - A.im) - x.re)) : 0 < (δ σ A x B) := by + classical + let w := x.im + let d : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let δ := σ * (d w - x.re) + change (0 < δ) + simpa [δ, d] using hgap + +private theorem hden₀ (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) : B.im - + A.im ≠ 0 := by + classical + let u := A.im + let v := B.im + have huv : u < v := huv A x B hAx hxB + exact ne_of_gt (sub_pos.mpr huv) + +private theorem hden₁ (A : ℂ) (x : ℂ) (hAx : A.im < x.im) : x.im - A.im ≠ 0 := by + classical + let u := A.im + let w := x.im + have huw : u < w := huw A x hAx + exact ne_of_gt (sub_pos.mpr huw) + +private theorem hden₂ (x : ℂ) (B : ℂ) (hxB : x.im < B.im) : B.im - x.im ≠ 0 := by + classical + let w := x.im + let v := B.im + have hwv : w < v := hwv x B hxB + exact ne_of_gt (sub_pos.mpr hwv) + +private noncomputable def pts (A : ℂ) (x : ℂ) (B : ℂ) : Fin 3 → ℂ := ![x, A, B] + +private theorem hdet (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : (A.re - + x.re) * (B.im - x.im) - + (B.re - x.re) * (A.im - x.im) ≠ 0 := by + classical + let w := x.im + let d : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let δ := σ * (d w - x.re) + have hδ : 0 < δ := hδ σ A x B hgap + have hden₀ : B.im - A.im ≠ 0 := hden₀ A x B hAx hxB + have hEq : (A.re - x.re) * (B.im - x.im) - + (B.re - x.re) * (A.im - x.im) = (B.im - A.im) * (d w - x.re) := by + dsimp [d] + field_simp + ring + rw [hEq] + intro hz + have hz' : (B.im - A.im) * (d w - x.re) = 0 := hz + have hdw : d w - x.re = 0 := (mul_eq_zero.mp hz').resolve_left hden₀ + have : δ = 0 := by + simp [δ, hdw] + exact (ne_of_gt hδ) this + +private theorem hind (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : + AffineIndependent ℝ (pts A x B) := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hdet : (A.re - x.re) * (B.im - x.im) - + (B.re - x.re) * (A.im - x.im) ≠ 0 := hdet σ A x B hAx hxB hgap + change (AffineIndependent ℝ pts) + apply (affineIndependent_iff_of_fintype ℝ pts).mpr + intro c hc hsum i + rw [Finset.weightedVSub_eq_linear_combination Finset.univ hc] at hsum + have hc' : c 0 + c 1 + c 2 = 0 := by + simpa [Fin.sum_univ_succ, ← add_assoc] using hc + have hr : c 0 * x.re + c 1 * A.re + c 2 * B.re = 0 := by + simpa [Fin.sum_univ_succ, pts, ← add_assoc, Complex.mul_re, + Complex.ofReal_re, Complex.ofReal_im] using congrArg Complex.re hsum + have hi' : c 0 * x.im + c 1 * A.im + c 2 * B.im = 0 := by + simpa [Fin.sum_univ_succ, pts, ← add_assoc, Complex.mul_im, + Complex.ofReal_re, Complex.ofReal_im] using congrArg Complex.im hsum + have hr' : c 1 * (A.re - x.re) + c 2 * (B.re - x.re) = 0 := by + linear_combination hr - x.re * hc' + have hi'' : c 1 * (A.im - x.im) + c 2 * (B.im - x.im) = 0 := by + linear_combination hi' - x.im * hc' + have hc1 : c 1 = 0 := by + apply (mul_eq_zero.mp (show c 1 * ((A.re - x.re) * (B.im - x.im) - + (B.re - x.re) * (A.im - x.im)) = 0 by + linear_combination (B.im - x.im) * hr' - (B.re - x.re) * hi'')).resolve_right hdet + have hc2 : c 2 = 0 := by + apply (mul_eq_zero.mp (show c 2 * ((A.re - x.re) * (B.im - x.im) - + (B.re - x.re) * (A.im - x.im)) = 0 by + linear_combination (A.re - x.re) * hi'' - (A.im - x.im) * hr')).resolve_right hdet + have hc0 : c 0 = 0 := by linarith [hc'] + fin_cases i <;> simp [hc0, hc1, hc2] + +private theorem hspan (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : affineSpan ℝ + (Set.range (pts A x B)) = ⊤ := by + classical + let : FiniteDimensional ℝ ℂ := Complex.basisOneI.finiteDimensional_of_finite + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + change (affineSpan ℝ (Set.range pts) = ⊤) + apply hind.affineSpan_eq_top_iff_card_eq_finrank_add_one.mpr + have hfin : Module.finrank ℝ ℂ = 2 := by + rw [Module.finrank_eq_card_basis Complex.basisOneI] + simp + simp [hfin] + +private noncomputable def b (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < + B.im) (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : + AffineBasis (Fin 3) ℝ ℂ := ⟨(pts A x B), (hind σ A x B hAx hxB hgap), (hspan σ A x B hAx hxB + hgap)⟩ + +private theorem hrange (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : Set.range (b + σ A x B hAx hxB hgap) = ({x, A, B} : Set ℂ) := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + change (Set.range b = ({x, A, B} : Set ℂ)) + rw [show (b : Fin 3 → ℂ) = ![x, A, B] from rfl] + ext z + simp [] + tauto + +private noncomputable def T (A : ℂ) (x : ℂ) (B : ℂ) : Set ℂ := convexHull ℝ ({x, A, B} : Set ℂ) + +private theorem hmem (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : ∀ z, z ∈ (T + A x B) ↔ ∀ i, 0 ≤ (b σ A x B hAx hxB hgap).coord i z := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hrange : Set.range b = ({x, A, B} : Set ℂ) := hrange σ A x B hAx hxB hgap + let T : Set ℂ := convexHull ℝ ({x, A, B} : Set ℂ) + change (∀ z, z ∈ T ↔ ∀ i, 0 ≤ b.coord i z) + intro z + change z ∈ convexHull ℝ ({x, A, B} : Set ℂ) ↔ _ + rw [← hrange, b.convexHull_eq_nonneg_coord] + simp + +private theorem hcoord_sum (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < + B.im) (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) (z : ℂ) + : (b σ A x B hAx hxB hgap).coord 0 z + (b σ A x B hAx hxB hgap).coord 1 z + (b σ A x B hAx + hxB hgap).coord 2 z = 1 := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + change (b.coord 0 z + b.coord 1 z + b.coord 2 z = 1) + simpa only [Fin.sum_univ_three] using b.sum_coord_apply_eq_one z + +private theorem hcoord_point (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < + B.im) (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) (z : ℂ) : + ((b σ A x B hAx hxB hgap).coord 0 z) • x + ((b σ A x B hAx hxB hgap).coord 1 z) • A + ((b σ + A x B hAx hxB hgap).coord 2 z) • B = z := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + change ((b.coord 0 z) • x + (b.coord 1 z) • A + (b.coord 2 z) • B = z) + have hb0 : b 0 = x := rfl + have hb1 : b 1 = A := rfl + have hb2 : b 2 = B := rfl + simpa only [Fin.sum_univ_three, hb0, hb1, hb2, add_assoc] using + b.linear_combination_coord_eq_self z + +private theorem hcoord_re (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) (z : ℂ) : + z.re = (b σ A x B hAx hxB hgap).coord 0 z * x.re + (b σ A x B hAx hxB hgap).coord 1 z * + A.re + (b σ A x B hAx hxB hgap).coord 2 z * B.re := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hcoord_point (z : ℂ) : + (b.coord 0 z) • x + (b.coord 1 z) • A + (b.coord 2 z) • B = z := hcoord_point σ A x B hAx + hxB hgap z + change (z.re = b.coord 0 z * x.re + b.coord 1 z * A.re + b.coord 2 z * B.re) + have hz := congrArg Complex.re (hcoord_point z) + simpa [Complex.smul_re, add_assoc] using hz.symm + +private theorem hcoord_im (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) (z : ℂ) : + z.im = (b σ A x B hAx hxB hgap).coord 0 z * x.im + (b σ A x B hAx hxB hgap).coord 1 z * + A.im + (b σ A x B hAx hxB hgap).coord 2 z * B.im := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hcoord_point (z : ℂ) : + (b.coord 0 z) • x + (b.coord 1 z) • A + (b.coord 2 z) • B = z := hcoord_point σ A x B hAx + hxB hgap z + change (z.im = b.coord 0 z * x.im + b.coord 1 z * A.im + b.coord 2 z * B.im) + have hz := congrArg Complex.im (hcoord_point z) + simpa [Complex.smul_im, add_assoc] using hz.symm + +private theorem hg0 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) (hgap + : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) (z : ℂ) : σ * ((d A + B) z.im - z.re) = (δ σ A x B) * (b σ A x B hAx hxB hgap).coord 0 z := by + classical + let u := A.im + let w := x.im + let v := B.im + let d : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let δ := σ * (d w - x.re) + have hden₀ : B.im - A.im ≠ 0 := hden₀ A x B hAx hxB + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hcoord_sum (z : ℂ) : b.coord 0 z + b.coord 1 z + b.coord 2 z = 1 := hcoord_sum σ A x B hAx + hxB hgap z + have hcoord_re (z : ℂ) : + z.re = b.coord 0 z * x.re + b.coord 1 z * A.re + b.coord 2 z * B.re := hcoord_re σ A x B + hAx hxB hgap z + have hcoord_im (z : ℂ) : + z.im = b.coord 0 z * x.im + b.coord 1 z * A.im + b.coord 2 z * B.im := hcoord_im σ A x B + hAx hxB hgap z + change (σ * (d z.im - z.re) = δ * b.coord 0 z) + rw [hcoord_re z, hcoord_im z] + dsimp [δ, d] + field_simp [u, w, v, hden₀] + linear_combination hcoord_sum z * + (-σ * (A.re * (B.im - A.im) - (B.re - A.re) * A.im)) + +private theorem hδnum (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) : + (δ σ A x B) * ((v B) - (u A)) = + σ * (A.re * ((v B) - (u A)) + (B.re - A.re) * ((w x) - (u A)) - ((v B) - (u A)) * x.re) := by + classical + let u := A.im + let w := x.im + let v := B.im + let d : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let δ := σ * (d w - x.re) + have hden₀ : B.im - A.im ≠ 0 := hden₀ A x B hAx hxB + change (δ * (v - u) = + σ * (A.re * (v - u) + (B.re - A.re) * (w - u) - (v - u) * x.re)) + dsimp [δ, d, u, w, v] + field_simp [hden₀] + +private theorem hmul1 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) (z : ℂ) : + ((w x) - (u A)) * (σ * (z.re - (e A x) z.im)) = + (b σ A x B hAx hxB hgap).coord 2 z * ((δ σ A x B) * ((v B) - (u A))) := by + classical + let u := A.im + let w := x.im + let v := B.im + let d : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let e : ℝ → ℝ := fun y => A.re + (x.re - A.re) * (y - A.im) / (x.im - A.im) + let δ := σ * (d w - x.re) + have hden₁ : x.im - A.im ≠ 0 := hden₁ A x hAx + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hcoord_sum (z : ℂ) : b.coord 0 z + b.coord 1 z + b.coord 2 z = 1 := hcoord_sum σ A x B hAx + hxB hgap z + have hcoord_re (z : ℂ) : + z.re = b.coord 0 z * x.re + b.coord 1 z * A.re + b.coord 2 z * B.re := hcoord_re σ A x B + hAx hxB hgap z + have hcoord_im (z : ℂ) : + z.im = b.coord 0 z * x.im + b.coord 1 z * A.im + b.coord 2 z * B.im := hcoord_im σ A x B + hAx hxB hgap z + have hδnum : δ * (v - u) = + σ * (A.re * (v - u) + (B.re - A.re) * (w - u) - (v - u) * x.re) := hδnum σ A x B hAx hxB + change ((w - u) * (σ * (z.re - e z.im)) = + b.coord 2 z * (δ * (v - u))) + rw [hcoord_re z, hcoord_im z, hδnum] + dsimp [e, u, w, v] + field_simp [hden₁] + linear_combination hcoord_sum z * + (σ * (A.re * (x.im - A.im) - (x.re - A.re) * A.im)) + +private theorem hg1 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) (hgap + : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) (z : ℂ) : + σ * (z.re - (e A x) z.im) = + (δ σ A x B) * (((v B) - (u A)) / ((w x) - (u A))) * (b σ A x B hAx hxB hgap).coord 2 z := by + classical + let u := A.im + let w := x.im + let v := B.im + let d : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let e : ℝ → ℝ := fun y => A.re + (x.re - A.re) * (y - A.im) / (x.im - A.im) + let δ := σ * (d w - x.re) + have huw : u < w := huw A x hAx + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hmul1 (z : ℂ) : + (w - u) * (σ * (z.re - e z.im)) = + b.coord 2 z * (δ * (v - u)) := hmul1 σ A x B hAx hxB hgap z + change (σ * (z.re - e z.im) = + δ * ((v - u) / (w - u)) * b.coord 2 z) + calc + σ * (z.re - e z.im) = + ((w - u) * (σ * (z.re - e z.im))) / (w - u) := by + field_simp [ne_of_gt (sub_pos.mpr huw)] + _ = (b.coord 2 z * (δ * (v - u))) / (w - u) := by rw [hmul1] + _ = δ * ((v - u) / (w - u)) * b.coord 2 z := by ring + +private theorem hmul2 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) (z : ℂ) : + ((v B) - (w x)) * (σ * (z.re - (f x B) z.im)) = + (b σ A x B hAx hxB hgap).coord 1 z * ((δ σ A x B) * ((v B) - (u A))) := by + classical + let u := A.im + let w := x.im + let v := B.im + let d : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let f : ℝ → ℝ := fun y => x.re + (B.re - x.re) * (y - x.im) / (B.im - x.im) + let δ := σ * (d w - x.re) + have hden₂ : B.im - x.im ≠ 0 := hden₂ x B hxB + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hcoord_sum (z : ℂ) : b.coord 0 z + b.coord 1 z + b.coord 2 z = 1 := hcoord_sum σ A x B hAx + hxB hgap z + have hcoord_re (z : ℂ) : + z.re = b.coord 0 z * x.re + b.coord 1 z * A.re + b.coord 2 z * B.re := hcoord_re σ A x B + hAx hxB hgap z + have hcoord_im (z : ℂ) : + z.im = b.coord 0 z * x.im + b.coord 1 z * A.im + b.coord 2 z * B.im := hcoord_im σ A x B + hAx hxB hgap z + have hδnum : δ * (v - u) = + σ * (A.re * (v - u) + (B.re - A.re) * (w - u) - (v - u) * x.re) := hδnum σ A x B hAx hxB + change ((v - w) * (σ * (z.re - f z.im)) = + b.coord 1 z * (δ * (v - u))) + rw [hcoord_re z, hcoord_im z, hδnum] + dsimp [f, u, w, v] + field_simp [hden₂] + linear_combination hcoord_sum z * + (σ * (x.re * (B.im - x.im) - (B.re - x.re) * x.im)) + +private theorem hg2 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) (hgap + : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) (z : ℂ) : + σ * (z.re - (f x B) z.im) = + (δ σ A x B) * (((v B) - (u A)) / ((v B) - (w x))) * (b σ A x B hAx hxB hgap).coord 1 z := by + classical + let u := A.im + let w := x.im + let v := B.im + let d : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let f : ℝ → ℝ := fun y => x.re + (B.re - x.re) * (y - x.im) / (B.im - x.im) + let δ := σ * (d w - x.re) + have hwv : w < v := hwv x B hxB + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hmul2 (z : ℂ) : + (v - w) * (σ * (z.re - f z.im)) = + b.coord 1 z * (δ * (v - u)) := hmul2 σ A x B hAx hxB hgap z + change (σ * (z.re - f z.im) = + δ * ((v - u) / (v - w)) * b.coord 1 z) + calc + σ * (z.re - f z.im) = + ((v - w) * (σ * (z.re - f z.im))) / (v - w) := by + field_simp [ne_of_gt (sub_pos.mpr hwv)] + _ = (b.coord 1 z * (δ * (v - u))) / (v - w) := by rw [hmul2] + _ = δ * ((v - u) / (v - w)) * b.coord 1 z := by ring + +private theorem hfac1 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : 0 < (δ σ A x + B) * (((v B) - (u A)) / ((w x) - (u A))) := by + classical + let u := A.im + let w := x.im + let v := B.im + let d : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let δ := σ * (d w - x.re) + have huw : u < w := huw A x hAx + have huv : u < v := huv A x B hAx hxB + have hδ : 0 < δ := hδ σ A x B hgap + change (0 < δ * ((v - u) / (w - u))) + exact mul_pos hδ (div_pos (sub_pos.mpr huv) (sub_pos.mpr huw)) + +private theorem hfac2 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : 0 < (δ σ A x + B) * (((v B) - (u A)) / ((v B) - (w x))) := by + classical + let u := A.im + let w := x.im + let v := B.im + let d : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let δ := σ * (d w - x.re) + have hwv : w < v := hwv x B hxB + have huv : u < v := huv A x B hAx hxB + have hδ : 0 < δ := hδ σ A x B hgap + change (0 < δ * ((v - u) / (v - w))) + exact mul_pos hδ (div_pos (sub_pos.mpr huv) (sub_pos.mpr hwv)) + +private theorem hperturb (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) (z : ℂ) (i : + Fin 3) (hz : (b σ A x B hAx hxB hgap).coord i z = 0) + (ε : ℝ) (hε : 0 < ε) : ∃ y : ℂ, dist y z < ε ∧ y ∉ (T A x B) := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + let T : Set ℂ := convexHull ℝ ({x, A, B} : Set ℂ) + have hmem : ∀ z, z ∈ T ↔ ∀ i, 0 ≤ b.coord i z := hmem σ A x B hAx hxB hgap + change (∃ y : ℂ, dist y z < ε ∧ y ∉ T) + let t := ε / (‖z - b i‖ + 1) + have ht : 0 < t := div_pos hε (by positivity) + let y := AffineMap.lineMap (b i) z (1 + t) + change b.coord i z = 0 at hz + have hcoord : b.coord i y = -t := by + dsimp [y] + rw [(b.coord i).apply_lineMap, b.coord_apply_eq i, hz] + simp [AffineMap.lineMap_apply_ring] + have hdist : dist y z < ε := by + rw [dist_eq_norm] + have hy : y - z = (t : ℝ) • (z - b i) := by + change AffineMap.lineMap (b i) z (1 + t) - z = t • (z - b i) + rw [AffineMap.lineMap_apply_module'] + module + rw [hy] + have hnorm : ‖(t : ℝ) • (z - b i)‖ = |t| * ‖z - b i‖ := by + change ‖(t : ℂ) * (z - b i)‖ = _ + simp [Complex.norm_mul, Complex.norm_real, Real.norm_eq_abs, mul_comm] + rw [hnorm, abs_of_pos ht] + calc + (ε / (‖z - b i‖ + 1)) * ‖z - b i‖ < + (ε / (‖z - b i‖ + 1)) * (‖z - b i‖ + 1) := by + apply mul_lt_mul_of_pos_left _ (div_pos hε (by positivity)) + linarith [norm_nonneg (z - b i)] + _ = ε := by field_simp + have hnotmem : y ∉ T := by + intro hy + have hcoords := (hmem y).mp hy + have hneg := hcoords i + rw [hcoord] at hneg + linarith + exact ⟨y, hdist, hnotmem⟩ + +private theorem hRecont (x : ℂ) : Continuous Complex.re := by + classical + let w := x.im + rw [Metric.continuous_iff] + intro z ε hε + refine ⟨ε, hε, ?_⟩ + intro w hw + have hb : dist (w.re) (z.re) ≤ dist w z := by + rw [Real.dist_eq, ← Complex.sub_re, dist_eq_norm] + exact Complex.abs_re_le_norm (w - z) + exact lt_of_le_of_lt hb hw + +private theorem hImcont (x : ℂ) : Continuous Complex.im := by + classical + let w := x.im + rw [Metric.continuous_iff] + intro z ε hε + refine ⟨ε, hε, ?_⟩ + intro w hw + have hb : dist (w.im) (z.im) ≤ dist w z := by + rw [Real.dist_eq, ← Complex.sub_im, dist_eq_norm] + exact Complex.abs_im_le_norm (w - z) + exact lt_of_le_of_lt hb hw + +private theorem hcont0 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) : Continuous (fun z : ℂ => σ * ((d A B) + z.im - z.re)) := by + classical + let d : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + have hRecont : Continuous Complex.re := hRecont x + have hImcont : Continuous Complex.im := hImcont x + change (Continuous (fun z : ℂ => σ * (d z.im - z.re))) + dsimp [d] + have himSub : Continuous (fun z : ℂ => z.im - A.im) := + hImcont.sub continuous_const + have hterm : Continuous (fun z : ℂ => + (B.re - A.re) * (z.im - A.im) / (B.im - A.im)) := + (continuous_const.mul himSub).div_const _ + exact continuous_const.mul ((continuous_const.add hterm).sub hRecont) + +private theorem hcont1 (σ : ℝ) (A : ℂ) (x : ℂ) : Continuous (fun z : ℂ => σ * (z.re - (e A x) + z.im)) := by + classical + let e : ℝ → ℝ := fun y => A.re + (x.re - A.re) * (y - A.im) / (x.im - A.im) + have hRecont : Continuous Complex.re := hRecont x + have hImcont : Continuous Complex.im := hImcont x + change (Continuous (fun z : ℂ => σ * (z.re - e z.im))) + dsimp [e] + have himSub : Continuous (fun z : ℂ => z.im - A.im) := + hImcont.sub continuous_const + have hterm : Continuous (fun z : ℂ => + (x.re - A.re) * (z.im - A.im) / (x.im - A.im)) := + (continuous_const.mul himSub).div_const _ + exact continuous_const.mul (hRecont.sub (continuous_const.add hterm)) + +private theorem hcont2 (σ : ℝ) (x : ℂ) (B : ℂ) : Continuous (fun z : ℂ => σ * (z.re - (f x B) + z.im)) := by + classical + let f : ℝ → ℝ := fun y => x.re + (B.re - x.re) * (y - x.im) / (B.im - x.im) + have hRecont : Continuous Complex.re := hRecont x + have hImcont : Continuous Complex.im := hImcont x + change (Continuous (fun z : ℂ => σ * (z.re - f z.im))) + dsimp [f] + have himSub : Continuous (fun z : ℂ => z.im - x.im) := + hImcont.sub continuous_const + have hterm : Continuous (fun z : ℂ => + (B.re - x.re) * (z.im - x.im) / (B.im - x.im)) := + (continuous_const.mul himSub).div_const _ + exact continuous_const.mul (hRecont.sub (continuous_const.add hterm)) + +private theorem hT_eq (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : (T A x B) = + {z | 0 ≤ σ * ((d A B) z.im - z.re) ∧ + 0 ≤ σ * (z.re - (e A x) z.im) ∧ 0 ≤ σ * (z.re - (f x B) z.im)} := by + classical + let u := A.im + let w := x.im + let v := B.im + let d : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let e : ℝ → ℝ := fun y => A.re + (x.re - A.re) * (y - A.im) / (x.im - A.im) + let f : ℝ → ℝ := fun y => x.re + (B.re - x.re) * (y - x.im) / (B.im - x.im) + let δ := σ * (d w - x.re) + have hδ : 0 < δ := hδ σ A x B hgap + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + let T : Set ℂ := convexHull ℝ ({x, A, B} : Set ℂ) + have hmem : ∀ z, z ∈ T ↔ ∀ i, 0 ≤ b.coord i z := hmem σ A x B hAx hxB hgap + have hg0 (z : ℂ) : σ * (d z.im - z.re) = δ * b.coord 0 z := hg0 σ A x B hAx hxB hgap z + have hg1 (z : ℂ) : + σ * (z.re - e z.im) = + δ * ((v - u) / (w - u)) * b.coord 2 z := hg1 σ A x B hAx hxB hgap z + have hg2 (z : ℂ) : + σ * (z.re - f z.im) = + δ * ((v - u) / (v - w)) * b.coord 1 z := hg2 σ A x B hAx hxB hgap z + have hfac1 : 0 < δ * ((v - u) / (w - u)) := hfac1 σ A x B hAx hxB hgap + have hfac2 : 0 < δ * ((v - u) / (v - w)) := hfac2 σ A x B hAx hxB hgap + change (T = {z | 0 ≤ σ * (d z.im - z.re) ∧ + 0 ≤ σ * (z.re - e z.im) ∧ 0 ≤ σ * (z.re - f z.im)}) + ext z + rw [hmem z] + constructor + · intro hc + exact ⟨by simpa only [hg0] using mul_nonneg hδ.le (hc 0), + by simpa only [hg1] using mul_nonneg hfac1.le (hc 2), + by simpa only [hg2] using mul_nonneg hfac2.le (hc 1)⟩ + · rintro ⟨hz0, hz1, hz2⟩ i + fin_cases i + · change 0 ≤ b.coord 0 z + exact (mul_nonneg_iff_of_pos_left hδ).mp (by rw [← hg0 z]; exact hz0) + · change 0 ≤ b.coord 1 z + exact (mul_nonneg_iff_of_pos_left hfac2).mp (by rw [← hg2 z]; exact hz2) + · change 0 ≤ b.coord 2 z + exact (mul_nonneg_iff_of_pos_left hfac1).mp (by rw [← hg1 z]; exact hz1) + +private theorem hclosed (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : IsClosed (T + A x B) := by + classical + let d : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let e : ℝ → ℝ := fun y => A.re + (x.re - A.re) * (y - A.im) / (x.im - A.im) + let f : ℝ → ℝ := fun y => x.re + (B.re - x.re) * (y - x.im) / (B.im - x.im) + let T : Set ℂ := convexHull ℝ ({x, A, B} : Set ℂ) + have hcont0 : Continuous (fun z : ℂ => σ * (d z.im - z.re)) := hcont0 σ A x B + have hcont1 : Continuous (fun z : ℂ => σ * (z.re - e z.im)) := hcont1 σ A x + have hcont2 : Continuous (fun z : ℂ => σ * (z.re - f z.im)) := hcont2 σ x B + have hT_eq : T = {z | 0 ≤ σ * (d z.im - z.re) ∧ + 0 ≤ σ * (z.re - e z.im) ∧ 0 ≤ σ * (z.re - f z.im)} := hT_eq σ A x B hAx hxB hgap + change (IsClosed T) + rw [hT_eq] + exact (isClosed_Ici.preimage hcont0).inter + ((isClosed_Ici.preimage hcont1).inter (isClosed_Ici.preimage hcont2)) + +private theorem hint (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : ∀ z, z ∈ + interior (T A x B) ↔ ∀ i, 0 < (b σ A x B hAx hxB hgap).coord i z := by + classical + let u := A.im + let w := x.im + let v := B.im + let d : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let e : ℝ → ℝ := fun y => A.re + (x.re - A.re) * (y - A.im) / (x.im - A.im) + let f : ℝ → ℝ := fun y => x.re + (B.re - x.re) * (y - x.im) / (B.im - x.im) + let δ := σ * (d w - x.re) + have hδ : 0 < δ := hδ σ A x B hgap + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + let T : Set ℂ := convexHull ℝ ({x, A, B} : Set ℂ) + have hmem : ∀ z, z ∈ T ↔ ∀ i, 0 ≤ b.coord i z := hmem σ A x B hAx hxB hgap + have hg0 (z : ℂ) : σ * (d z.im - z.re) = δ * b.coord 0 z := hg0 σ A x B hAx hxB hgap z + have hg1 (z : ℂ) : + σ * (z.re - e z.im) = + δ * ((v - u) / (w - u)) * b.coord 2 z := hg1 σ A x B hAx hxB hgap z + have hg2 (z : ℂ) : + σ * (z.re - f z.im) = + δ * ((v - u) / (v - w)) * b.coord 1 z := hg2 σ A x B hAx hxB hgap z + have hfac1 : 0 < δ * ((v - u) / (w - u)) := hfac1 σ A x B hAx hxB hgap + have hfac2 : 0 < δ * ((v - u) / (v - w)) := hfac2 σ A x B hAx hxB hgap + have hperturb (z : ℂ) (i : Fin 3) (hz : b.coord i z = 0) + (ε : ℝ) (hε : 0 < ε) : ∃ y : ℂ, dist y z < ε ∧ y ∉ T := hperturb σ A x B hAx hxB hgap z i + hz ε hε + have hcont0 : Continuous (fun z : ℂ => σ * (d z.im - z.re)) := hcont0 σ A x B + have hcont1 : Continuous (fun z : ℂ => σ * (z.re - e z.im)) := hcont1 σ A x + have hcont2 : Continuous (fun z : ℂ => σ * (z.re - f z.im)) := hcont2 σ x B + change (∀ z, z ∈ interior T ↔ ∀ i, 0 < b.coord i z) + intro z + constructor + · intro hz i + have hcoords := (hmem z).mp (interior_subset hz) + fin_cases i + · rcases lt_or_eq_of_le (hcoords 0) with hpos | heq + · exact hpos + · rcases Metric.mem_nhds_iff.mp (isOpen_interior.mem_nhds hz) with ⟨r, hr, hsub⟩ + obtain ⟨y, hyd, hyT⟩ := hperturb z 0 heq.symm r hr + exact False.elim (hyT (interior_subset (hsub (Metric.mem_ball.mpr hyd)))) + · rcases lt_or_eq_of_le (hcoords 1) with hpos | heq + · exact hpos + · rcases Metric.mem_nhds_iff.mp (isOpen_interior.mem_nhds hz) with ⟨r, hr, hsub⟩ + obtain ⟨y, hyd, hyT⟩ := hperturb z 1 heq.symm r hr + exact False.elim (hyT (interior_subset (hsub (Metric.mem_ball.mpr hyd)))) + · rcases lt_or_eq_of_le (hcoords 2) with hpos | heq + · exact hpos + · rcases Metric.mem_nhds_iff.mp (isOpen_interior.mem_nhds hz) with ⟨r, hr, hsub⟩ + obtain ⟨y, hyd, hyT⟩ := hperturb z 2 heq.symm r hr + exact False.elim (hyT (interior_subset (hsub (Metric.mem_ball.mpr hyd)))) + · intro hc + let U : Set ℂ := {z | 0 < σ * (d z.im - z.re)} ∩ + {z | 0 < σ * (z.re - e z.im)} ∩ {z | 0 < σ * (z.re - f z.im)} + have hUopen : IsOpen U := by + change IsOpen ((fun z : ℂ => σ * (d z.im - z.re)) ⁻¹' Set.Ioi 0 ∩ + (fun z : ℂ => σ * (z.re - e z.im)) ⁻¹' Set.Ioi 0 ∩ + (fun z : ℂ => σ * (z.re - f z.im)) ⁻¹' Set.Ioi 0) + have hIoi : IsOpen (Set.Ioi (0 : ℝ)) := isOpen_Ioi + exact ((hIoi.preimage hcont0).inter (hIoi.preimage hcont1)).inter + (hIoi.preimage hcont2) + have hUsub : U ⊆ T := by + intro y hy + rcases hy with ⟨⟨hy0, hy1⟩, hy2⟩ + change 0 < σ * (d y.im - y.re) at hy0 + change 0 < σ * (y.re - e y.im) at hy1 + change 0 < σ * (y.re - f y.im) at hy2 + apply (hmem y).2 + intro i + fin_cases i + · change 0 ≤ b.coord 0 y + exact le_of_lt ((mul_pos_iff_of_pos_left hδ).mp (by rw [← hg0 y]; exact hy0)) + · change 0 ≤ b.coord 1 y + exact le_of_lt ((mul_pos_iff_of_pos_left hfac2).mp (by rw [← hg2 y]; exact hy2)) + · change 0 ≤ b.coord 2 y + exact le_of_lt ((mul_pos_iff_of_pos_left hfac1).mp (by rw [← hg1 y]; exact hy1)) + have hzU : z ∈ U := by + refine ⟨⟨?_, ?_⟩, ?_⟩ + · change 0 < σ * (d z.im - z.re) + rw [hg0 z] + exact mul_pos hδ (hc 0) + · change 0 < σ * (z.re - e z.im) + rw [hg1 z] + exact mul_pos hfac1 (hc 2) + · change 0 < σ * (z.re - f z.im) + rw [hg2 z] + exact mul_pos hfac2 (hc 1) + exact interior_maximal hUsub hUopen hzU + +private theorem hb0 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) (hgap + : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : (b σ A x B hAx hxB + hgap) 0 = x := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + change (b 0 = x) + exact rfl + +private theorem hb1 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) (hgap + : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : (b σ A x B hAx hxB + hgap) 1 = A := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + change (b 1 = A) + exact rfl + +private theorem hb2 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) (hgap + : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : (b σ A x B hAx hxB + hgap) 2 = B := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + change (b 2 = B) + exact rfl + +private theorem hcoord01 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : (b σ A x B + hAx hxB hgap).coord 0 A = 0 := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hb1 : b 1 = A := hb1 σ A x B hAx hxB hgap + change (b.coord 0 A = 0) + rw [← hb1] + exact b.coord_apply_ne (by decide) + +private theorem hcoord02 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : (b σ A x B + hAx hxB hgap).coord 0 B = 0 := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hb2 : b 2 = B := hb2 σ A x B hAx hxB hgap + change (b.coord 0 B = 0) + rw [← hb2] + exact b.coord_apply_ne (by decide) + +private theorem hcoord11 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : (b σ A x B + hAx hxB hgap).coord 1 A = 1 := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hb1 : b 1 = A := hb1 σ A x B hAx hxB hgap + change (b.coord 1 A = 1) + rw [← hb1] + exact b.coord_apply_eq 1 + +private theorem hcoord12 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : (b σ A x B + hAx hxB hgap).coord 1 B = 0 := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hb2 : b 2 = B := hb2 σ A x B hAx hxB hgap + change (b.coord 1 B = 0) + rw [← hb2] + exact b.coord_apply_ne (by decide) + +private theorem hcoord20 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : (b σ A x B + hAx hxB hgap).coord 2 A = 0 := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hb1 : b 1 = A := hb1 σ A x B hAx hxB hgap + change (b.coord 2 A = 0) + rw [← hb1] + exact b.coord_apply_ne (by decide) + +private theorem hcoord22 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : (b σ A x B + hAx hxB hgap).coord 2 B = 1 := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hb2 : b 2 = B := hb2 σ A x B hAx hxB hgap + change (b.coord 2 B = 1) + rw [← hb2] + exact b.coord_apply_eq 2 + +private theorem hcoord00 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : (b σ A x B + hAx hxB hgap).coord 0 x = 1 := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hb0 : b 0 = x := hb0 σ A x B hAx hxB hgap + change (b.coord 0 x = 1) + rw [← hb0] + exact b.coord_apply_eq 0 + +private theorem hcoord10 (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : (b σ A x B + hAx hxB hgap).coord 1 x = 0 := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hb0 : b 0 = x := hb0 σ A x B hAx hxB hgap + change (b.coord 1 x = 0) + rw [← hb0] + exact b.coord_apply_ne (by decide) + +private theorem hcoord20x (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : (b σ A x B + hAx hxB hgap).coord 2 x = 0 := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + have hb0 : b 0 = x := hb0 σ A x B hAx hxB hgap + change (b.coord 2 x = 0) + rw [← hb0] + exact b.coord_apply_ne (by decide) + +private theorem hfaceAB (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) (z : ℂ) : + z ∈ segment ℝ A B ↔ z ∈ (T A x B) ∧ (b σ A x B hAx hxB hgap).coord 0 z = 0 := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + let T : Set ℂ := convexHull ℝ ({x, A, B} : Set ℂ) + have hmem : ∀ z, z ∈ T ↔ ∀ i, 0 ≤ b.coord i z := hmem σ A x B hAx hxB hgap + have hcoord_sum (z : ℂ) : b.coord 0 z + b.coord 1 z + b.coord 2 z = 1 := hcoord_sum σ A x B hAx + hxB hgap z + have hb1 : b 1 = A := hb1 σ A x B hAx hxB hgap + have hb2 : b 2 = B := hb2 σ A x B hAx hxB hgap + have hcoord01 : b.coord 0 A = 0 := hcoord01 σ A x B hAx hxB hgap + have hcoord02 : b.coord 0 B = 0 := hcoord02 σ A x B hAx hxB hgap + have hcoord11 : b.coord 1 A = 1 := hcoord11 σ A x B hAx hxB hgap + have hcoord12 : b.coord 1 B = 0 := hcoord12 σ A x B hAx hxB hgap + have hcoord20 : b.coord 2 A = 0 := hcoord20 σ A x B hAx hxB hgap + have hcoord22 : b.coord 2 B = 1 := hcoord22 σ A x B hAx hxB hgap + change (z ∈ segment ℝ A B ↔ z ∈ T ∧ b.coord 0 z = 0) + constructor + · intro hz + rw [segment_eq_image_lineMap] at hz + rcases hz with ⟨t, ht, rfl⟩ + constructor + · apply (hmem _).2 + intro i + fin_cases i + · change 0 ≤ b.coord 0 (AffineMap.lineMap A B t) + rw [(b.coord 0).apply_lineMap, hcoord01, hcoord02] + simp [] + · change 0 ≤ b.coord 1 (AffineMap.lineMap A B t) + rw [(b.coord 1).apply_lineMap, hcoord11, hcoord12] + simp [AffineMap.lineMap_apply_ring] + linarith [ht.2] + · change 0 ≤ b.coord 2 (AffineMap.lineMap A B t) + rw [(b.coord 2).apply_lineMap, hcoord20, hcoord22] + simp? [AffineMap.lineMap_apply_ring] + exact ht.1 + · change b.coord 0 (AffineMap.lineMap A B t) = 0 + rw [(b.coord 0).apply_lineMap, hcoord01, hcoord02] + simp [] + · rintro ⟨hz, hz0⟩ + have hcn := (hmem z).mp hz + have hsum := hcoord_sum z + rw [← hb1, ← hb2, segment_eq_image_lineMap] + refine ⟨b.coord 2 z, ⟨hcn 2, ?_⟩, ?_⟩ + · linarith [hsum, hz0, hcn 1] + · apply b.ext_elem + intro i + fin_cases i + · change b.coord 0 (AffineMap.lineMap A B (b.coord 2 z)) = b.coord 0 z + rw [(b.coord 0).apply_lineMap, hcoord01, hcoord02] + simp [hz0] + · change b.coord 1 (AffineMap.lineMap A B (b.coord 2 z)) = b.coord 1 z + rw [(b.coord 1).apply_lineMap, hcoord11, hcoord12] + simp [AffineMap.lineMap_apply_ring] + linarith [hsum, hz0] + · change b.coord 2 (AffineMap.lineMap A B (b.coord 2 z)) = b.coord 2 z + rw [(b.coord 2).apply_lineMap, hcoord20, hcoord22] + simp [AffineMap.lineMap_apply_ring] + +private theorem hfacexB (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) (z : ℂ) : + z ∈ segment ℝ x B ↔ z ∈ (T A x B) ∧ (b σ A x B hAx hxB hgap).coord 1 z = 0 := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + let T : Set ℂ := convexHull ℝ ({x, A, B} : Set ℂ) + have hmem : ∀ z, z ∈ T ↔ ∀ i, 0 ≤ b.coord i z := hmem σ A x B hAx hxB hgap + have hcoord_sum (z : ℂ) : b.coord 0 z + b.coord 1 z + b.coord 2 z = 1 := hcoord_sum σ A x B hAx + hxB hgap z + have hcoord02 : b.coord 0 B = 0 := hcoord02 σ A x B hAx hxB hgap + have hcoord12 : b.coord 1 B = 0 := hcoord12 σ A x B hAx hxB hgap + have hcoord22 : b.coord 2 B = 1 := hcoord22 σ A x B hAx hxB hgap + have hcoord00 : b.coord 0 x = 1 := hcoord00 σ A x B hAx hxB hgap + have hcoord10 : b.coord 1 x = 0 := hcoord10 σ A x B hAx hxB hgap + have hcoord20x : b.coord 2 x = 0 := hcoord20x σ A x B hAx hxB hgap + change (z ∈ segment ℝ x B ↔ z ∈ T ∧ b.coord 1 z = 0) + constructor + · intro hz + rw [segment_eq_image_lineMap] at hz + rcases hz with ⟨t, ht, rfl⟩ + constructor + · apply (hmem _).2 + intro i + fin_cases i + · change 0 ≤ b.coord 0 (AffineMap.lineMap x B t) + rw [(b.coord 0).apply_lineMap, hcoord00, hcoord02] + simp [AffineMap.lineMap_apply_ring] + linarith [ht.2] + · change 0 ≤ b.coord 1 (AffineMap.lineMap x B t) + rw [(b.coord 1).apply_lineMap, hcoord10, hcoord12] + simp [] + · change 0 ≤ b.coord 2 (AffineMap.lineMap x B t) + rw [(b.coord 2).apply_lineMap, hcoord20x, hcoord22] + simp? [AffineMap.lineMap_apply_ring] + exact ht.1 + · change b.coord 1 (AffineMap.lineMap x B t) = 0 + rw [(b.coord 1).apply_lineMap, hcoord10, hcoord12] + simp [] + · rintro ⟨hz, hz1⟩ + have hcn := (hmem z).mp hz + have hsum := hcoord_sum z + rw [segment_eq_image_lineMap] + refine ⟨b.coord 2 z, ⟨hcn 2, ?_⟩, ?_⟩ + · linarith [hsum, hz1, hcn 0] + · apply b.ext_elem + intro i + fin_cases i + · change b.coord 0 (AffineMap.lineMap x B (b.coord 2 z)) = b.coord 0 z + rw [(b.coord 0).apply_lineMap, hcoord00, hcoord02] + simp [AffineMap.lineMap_apply_ring] + linarith [hsum, hz1] + · change b.coord 1 (AffineMap.lineMap x B (b.coord 2 z)) = b.coord 1 z + rw [(b.coord 1).apply_lineMap, hcoord10, hcoord12] + simp [hz1] + · change b.coord 2 (AffineMap.lineMap x B (b.coord 2 z)) = b.coord 2 z + rw [(b.coord 2).apply_lineMap, hcoord20x, hcoord22] + simp [AffineMap.lineMap_apply_ring] + +private theorem hfacexA (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) (z : ℂ) : + z ∈ segment ℝ x A ↔ z ∈ (T A x B) ∧ (b σ A x B hAx hxB hgap).coord 2 z = 0 := by + classical + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + let T : Set ℂ := convexHull ℝ ({x, A, B} : Set ℂ) + have hmem : ∀ z, z ∈ T ↔ ∀ i, 0 ≤ b.coord i z := hmem σ A x B hAx hxB hgap + have hcoord_sum (z : ℂ) : b.coord 0 z + b.coord 1 z + b.coord 2 z = 1 := hcoord_sum σ A x B hAx + hxB hgap z + have hcoord01 : b.coord 0 A = 0 := hcoord01 σ A x B hAx hxB hgap + have hcoord11 : b.coord 1 A = 1 := hcoord11 σ A x B hAx hxB hgap + have hcoord20 : b.coord 2 A = 0 := hcoord20 σ A x B hAx hxB hgap + have hcoord00 : b.coord 0 x = 1 := hcoord00 σ A x B hAx hxB hgap + have hcoord10 : b.coord 1 x = 0 := hcoord10 σ A x B hAx hxB hgap + have hcoord20x : b.coord 2 x = 0 := hcoord20x σ A x B hAx hxB hgap + change (z ∈ segment ℝ x A ↔ z ∈ T ∧ b.coord 2 z = 0) + constructor + · intro hz + rw [segment_eq_image_lineMap] at hz + rcases hz with ⟨t, ht, rfl⟩ + constructor + · apply (hmem _).2 + intro i + fin_cases i + · change 0 ≤ b.coord 0 (AffineMap.lineMap x A t) + rw [(b.coord 0).apply_lineMap, hcoord00, hcoord01] + simp [AffineMap.lineMap_apply_ring] + linarith [ht.2] + · change 0 ≤ b.coord 1 (AffineMap.lineMap x A t) + rw [(b.coord 1).apply_lineMap, hcoord10, hcoord11] + simp? [AffineMap.lineMap_apply_ring] + exact ht.1 + · change 0 ≤ b.coord 2 (AffineMap.lineMap x A t) + rw [(b.coord 2).apply_lineMap, hcoord20x, hcoord20] + simp [] + · change b.coord 2 (AffineMap.lineMap x A t) = 0 + rw [(b.coord 2).apply_lineMap, hcoord20x, hcoord20] + simp [] + · rintro ⟨hz, hz2⟩ + have hcn := (hmem z).mp hz + have hsum := hcoord_sum z + rw [segment_eq_image_lineMap] + refine ⟨b.coord 1 z, ⟨hcn 1, ?_⟩, ?_⟩ + · linarith [hsum, hz2, hcn 0] + · apply b.ext_elem + intro i + fin_cases i + · change b.coord 0 (AffineMap.lineMap x A (b.coord 1 z)) = b.coord 0 z + rw [(b.coord 0).apply_lineMap, hcoord00, hcoord01] + simp [AffineMap.lineMap_apply_ring] + linarith [hsum, hz2] + · change b.coord 1 (AffineMap.lineMap x A (b.coord 1 z)) = b.coord 1 z + rw [(b.coord 1).apply_lineMap, hcoord10, hcoord11] + simp [AffineMap.lineMap_apply_ring] + · change b.coord 2 (AffineMap.lineMap x A (b.coord 1 z)) = b.coord 2 z + rw [(b.coord 2).apply_lineMap, hcoord20x, hcoord20] + simp [hz2] + +end TriangleSections + +theorem P4953T1TriangleSections (σ : ℝ) (A x B : ℂ) + (hAx : A.im < x.im) (hxB : x.im < B.im) + (hgap : 0 < σ * (A.re + (B.re - A.re) * + (x.im - A.im) / (B.im - A.im) - x.re)) : + let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let e (y : ℝ) := A.re + (x.re - A.re) * (y - A.im) / (x.im - A.im) + let f (y : ℝ) := x.re + (B.re - x.re) * (y - x.im) / (B.im - x.im) + let T := convexHull ℝ ({x, A, B} : Set ℂ) + (∀ z, z ∈ interior T ↔ 0 < σ * (d z.im - z.re) ∧ + 0 < σ * (z.re - e z.im) ∧ 0 < σ * (z.re - f z.im)) ∧ + (∀ z, A.im ≤ z.im → z.im ≤ x.im → + (z ∈ T ↔ 0 ≤ σ * (z.re - e z.im) ∧ 0 ≤ σ * (d z.im - z.re))) ∧ + (∀ z, x.im ≤ z.im → z.im ≤ B.im → + (z ∈ T ↔ 0 ≤ σ * (z.re - f z.im) ∧ 0 ≤ σ * (d z.im - z.re))) ∧ + frontier T = segment ℝ x A ∪ segment ℝ x B ∪ segment ℝ A B := by +-- BODY + classical + dsimp only + let u := A.im + let w := x.im + let v := B.im + let d : ℝ → ℝ := fun y => A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) + let e : ℝ → ℝ := fun y => A.re + (x.re - A.re) * (y - A.im) / (x.im - A.im) + let f : ℝ → ℝ := fun y => x.re + (B.re - x.re) * (y - x.im) / (B.im - x.im) + let δ := σ * (d w - x.re) + have huw : u < w := TriangleSections.huw A x hAx + have hwv : w < v := TriangleSections.hwv x B hxB + have hδ : 0 < δ := TriangleSections.hδ σ A x B hgap + let pts : Fin 3 → ℂ := ![x, A, B] + have hind : AffineIndependent ℝ pts := TriangleSections.hind σ A x B hAx hxB hgap + have hspan : affineSpan ℝ (Set.range pts) = ⊤ := TriangleSections.hspan σ A x B hAx hxB hgap + let b : AffineBasis (Fin 3) ℝ ℂ := ⟨pts, hind, hspan⟩ + let T : Set ℂ := convexHull ℝ ({x, A, B} : Set ℂ) + have hmem : ∀ z, z ∈ T ↔ ∀ i, 0 ≤ b.coord i z := TriangleSections.hmem σ A x B hAx hxB hgap + have hcoord_sum (z : ℂ) : b.coord 0 z + b.coord 1 z + b.coord 2 z = 1 := + TriangleSections.hcoord_sum σ A x B hAx hxB hgap z + have hcoord_im (z : ℂ) : + z.im = b.coord 0 z * x.im + b.coord 1 z * A.im + b.coord 2 z * B.im := + TriangleSections.hcoord_im σ A x B hAx hxB hgap z + have hg0 (z : ℂ) : σ * (d z.im - z.re) = δ * b.coord 0 z := TriangleSections.hg0 σ A x B hAx + hxB hgap z + have hg1 (z : ℂ) : + σ * (z.re - e z.im) = + δ * ((v - u) / (w - u)) * b.coord 2 z := TriangleSections.hg1 σ A x B hAx hxB hgap z + have hg2 (z : ℂ) : + σ * (z.re - f z.im) = + δ * ((v - u) / (v - w)) * b.coord 1 z := TriangleSections.hg2 σ A x B hAx hxB hgap z + have hfac1 : 0 < δ * ((v - u) / (w - u)) := TriangleSections.hfac1 σ A x B hAx hxB hgap + have hfac2 : 0 < δ * ((v - u) / (v - w)) := TriangleSections.hfac2 σ A x B hAx hxB hgap + have hclosed : IsClosed T := TriangleSections.hclosed σ A x B hAx hxB hgap + have hint : ∀ z, z ∈ interior T ↔ ∀ i, 0 < b.coord i z := TriangleSections.hint σ A x B hAx hxB + hgap + refine ⟨?_, ?_, ?_, ?_⟩ + · intro z + rw [hint z] + constructor + · intro hc + refine ⟨?_, ?_, ?_⟩ + · rw [hg0 z] + exact mul_pos hδ (hc 0) + · rw [hg1 z] + exact mul_pos hfac1 (hc 2) + · rw [hg2 z] + exact mul_pos hfac2 (hc 1) + · rintro ⟨hz0, hz1, hz2⟩ + intro i + fin_cases i + · have hh := hz0 + change 0 < σ * (d z.im - z.re) at hh + have hp : 0 < δ * b.coord 0 z := by rw [← hg0 z]; exact hh + exact (mul_pos_iff_of_pos_left hδ).mp hp + · have hh := hz2 + change 0 < σ * (z.re - f z.im) at hh + have hp : 0 < δ * ((v - u) / (v - w)) * b.coord 1 z := by + rw [← hg2 z] + exact hh + exact (mul_pos_iff_of_pos_left hfac2).mp (by simpa [hfac2] using hp) + · have hh := hz1 + change 0 < σ * (z.re - e z.im) at hh + have hp : 0 < δ * ((v - u) / (w - u)) * b.coord 2 z := by + rw [← hg1 z] + exact hh + exact (mul_pos_iff_of_pos_left hfac1).mp (by simpa [hfac1] using hp) + · intro z hlow hhigh + rw [hmem z] + constructor + · intro hc + refine ⟨?_, ?_⟩ + · change 0 ≤ σ * (z.re - e z.im) + rw [hg1 z] + exact mul_nonneg hfac1.le (hc 2) + · change 0 ≤ σ * (d z.im - z.re) + rw [hg0 z] + exact mul_nonneg hδ.le (hc 0) + · rintro ⟨hz1, hz0⟩ + have hc0 : 0 ≤ b.coord 0 z := + (mul_nonneg_iff_of_pos_left hδ).mp (by + have hh := hz0 + change 0 ≤ σ * (d z.im - z.re) at hh + have hp : 0 ≤ δ * b.coord 0 z := by rw [← hg0 z]; exact hh + exact hp) + have hc2 : 0 ≤ b.coord 2 z := + (mul_nonneg_iff_of_pos_left hfac1).mp (by + have hh := hz1 + change 0 ≤ σ * (z.re - e z.im) at hh + have hp : 0 ≤ δ * ((v - u) / (w - u)) * b.coord 2 z := by + rw [← hg1 z] + exact hh + simpa [hfac1] using hp) + have hheight : x.im - z.im = + b.coord 1 z * (x.im - A.im) - b.coord 2 z * (B.im - x.im) := by + rw [hcoord_im z] + calc + x.im - (b.coord 0 z * x.im + b.coord 1 z * A.im + b.coord 2 z * B.im) = + x.im * (b.coord 0 z + b.coord 1 z + b.coord 2 z) - + (b.coord 0 z * x.im + b.coord 1 z * A.im + b.coord 2 z * B.im) := by + rw [hcoord_sum z] + ring + _ = b.coord 1 z * (x.im - A.im) - + b.coord 2 z * (B.im - x.im) := by ring + have hprod : 0 ≤ b.coord 1 z * (w - u) := by + nlinarith [hheight, hhigh, hc2, sub_nonneg.mpr (le_of_lt hwv)] + have hc1 : 0 ≤ b.coord 1 z := + (mul_nonneg_iff_of_pos_right (sub_pos.mpr huw)).mp hprod + intro i + fin_cases i + · exact hc0 + · exact hc1 + · exact hc2 + · intro z hlow hhigh + rw [hmem z] + constructor + · intro hc + refine ⟨?_, ?_⟩ + · change 0 ≤ σ * (z.re - f z.im) + rw [hg2 z] + exact mul_nonneg hfac2.le (hc 1) + · change 0 ≤ σ * (d z.im - z.re) + rw [hg0 z] + exact mul_nonneg hδ.le (hc 0) + · rintro ⟨hz2, hz0⟩ + have hc0 : 0 ≤ b.coord 0 z := + (mul_nonneg_iff_of_pos_left hδ).mp (by + have hh := hz0 + change 0 ≤ σ * (d z.im - z.re) at hh + have hp : 0 ≤ δ * b.coord 0 z := by rw [← hg0 z]; exact hh + exact hp) + have hc1 : 0 ≤ b.coord 1 z := + (mul_nonneg_iff_of_pos_left hfac2).mp (by + have hh := hz2 + change 0 ≤ σ * (z.re - f z.im) at hh + have hp : 0 ≤ δ * ((v - u) / (v - w)) * b.coord 1 z := by + rw [← hg2 z] + exact hh + simpa [hfac2] using hp) + have hheight : z.im - x.im = + b.coord 2 z * (B.im - x.im) - b.coord 1 z * (x.im - A.im) := by + rw [hcoord_im z] + calc + (b.coord 0 z * x.im + b.coord 1 z * A.im + b.coord 2 z * B.im) - + x.im = + (b.coord 0 z * x.im + b.coord 1 z * A.im + b.coord 2 z * B.im) - + x.im * (b.coord 0 z + b.coord 1 z + b.coord 2 z) := by + rw [hcoord_sum z] + ring + _ = b.coord 2 z * (B.im - x.im) - + b.coord 1 z * (x.im - A.im) := by ring + have hprod : 0 ≤ b.coord 2 z * (v - w) := by + nlinarith [hheight, hlow, hc1, sub_nonneg.mpr (le_of_lt huw)] + have hc2 : 0 ≤ b.coord 2 z := + (mul_nonneg_iff_of_pos_right (sub_pos.mpr hwv)).mp hprod + intro i + fin_cases i + · exact hc0 + · exact hc1 + · exact hc2 + have hfaceAB (z : ℂ) : + z ∈ segment ℝ A B ↔ z ∈ T ∧ b.coord 0 z = 0 := TriangleSections.hfaceAB σ A x B hAx hxB hgap z + have hfacexB (z : ℂ) : + z ∈ segment ℝ x B ↔ z ∈ T ∧ b.coord 1 z = 0 := TriangleSections.hfacexB σ A x B hAx hxB hgap z + have hfacexA (z : ℂ) : + z ∈ segment ℝ x A ↔ z ∈ T ∧ b.coord 2 z = 0 := TriangleSections.hfacexA σ A x B hAx hxB hgap z + rw [hclosed.frontier_eq] + ext z + constructor + · rintro ⟨hzT, hzNoInt⟩ + have hcoords := (hmem z).mp hzT + have hzero : ∃ i, b.coord i z = 0 := by + by_contra hn + have hstrict : ∀ i, 0 < b.coord i z := by + intro i + apply lt_of_le_of_ne (hcoords i) + intro hEq + exact hn ⟨i, hEq.symm⟩ + exact hzNoInt ((hint z).mpr hstrict) + rcases hzero with ⟨i, hi⟩ + fin_cases i + · exact Or.inr ((hfaceAB z).2 ⟨hzT, hi⟩) + · exact Or.inl (Or.inr ((hfacexB z).2 ⟨hzT, hi⟩)) + · exact Or.inl (Or.inl ((hfacexA z).2 ⟨hzT, hi⟩)) + · intro hz + rcases hz with hzRest | hzAB + · rcases hzRest with hzA | hzB + · have h := (hfacexA z).1 hzA + refine ⟨h.1, ?_⟩ + intro hzInt + exact (ne_of_gt ((hint z).mp hzInt 2)) h.2 + · have h := (hfacexB z).1 hzB + refine ⟨h.1, ?_⟩ + intro hzInt + exact (ne_of_gt ((hint z).mp hzInt 1)) h.2 + · have h := (hfaceAB z).1 hzAB + refine ⟨h.1, ?_⟩ + intro hzInt + exact (ne_of_gt ((hint z).mp hzInt 0)) h.2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1EdgePrescription.lean b/LeanPool/ApollonianSuperharmonic/P4981T1EdgePrescription.lean new file mode 100644 index 0000000000..ab35405106 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4981T1EdgePrescription.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation + +-- [TABLET NODE: P4981T1EdgePrescription] + +/-! +# P4981T1EdgePrescription + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A prescription on a primitive coordinate edge is one of the following data: +the line edge $((0,-1),(0,1))$; a Gaussian parameter $z$ for the edge +$((0,1),(1,1+2z+2i))$; a parameter $z$ for +$((0,-1),(1,1+2z+2i))$; a parameter $z$ for +$((1,1+2z+2i),(1,1+2z))$; or a proper quadruple $q$ together +with a parent slot $j\in\mathbb Z/3\mathbb Z$, prescribing the edge +$(q_{j+1},q_0)$. These are data indexed by the actual coordinate edge, +not an identification of different presentations. +-/ +inductive P4981T1EdgePrescription : + CircleCoordinates × CircleCoordinates → Type where +-- BODY + | line : P4981T1EdgePrescription ((0, -1), (0, 1)) + | left (z : GaussianInt) : P4981T1EdgePrescription + ((0, 1), (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt))) + | right (z : GaussianInt) : P4981T1EdgePrescription + ((0, -1), (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt))) + | unit (z : GaussianInt) : P4981T1EdgePrescription + ((1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)), (1, 1 + 2 * z)) + | proper (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (j : Fin 3) : P4981T1EdgePrescription (q j.succ, q 0) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1EdgeRank.lean b/LeanPool/ApollonianSuperharmonic/P4981T1EdgeRank.lean new file mode 100644 index 0000000000..078197a7e6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4981T1EdgeRank.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates + +-- [TABLET NODE: P4981T1EdgeRank] + +/-! +# P4981T1EdgeRank + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The rank of an ordered coordinate edge $(C,D)$ is +$\max\{\max(c_C,0),\max(c_D,0)\}$, regarded as a natural number. +In particular its rank does not depend on its direction. +-/ +def P4981T1EdgeRank (e : CircleCoordinates × CircleCoordinates) : ℕ := +-- BODY + max e.1.1.toNat e.2.1.toNat + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionCoherence.lean b/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionCoherence.lean new file mode 100644 index 0000000000..3b09008907 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionCoherence.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4981T1PrescriptionValue +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.P4828T1ParentsDistinct + +-- [TABLET NODE: P4981T1PrescriptionCoherence] + +/-! +# P4981T1PrescriptionCoherence + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4981T1PrescriptionCoherence {e : CircleCoordinates × CircleCoordinates} + (p p' : P4981T1EdgePrescription e) + (F : CircleCoordinates × CircleCoordinates → GaussianInt × GaussianInt) : + P4981T1PrescriptionValue p F = P4981T1PrescriptionValue p' F := by +-- BODY + have large (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) : + 1 < (q 0).1 := by + have facts := ProperBandCurvatureStructure q hq + have h0 := hq.2 0 + have h1 := hq.2 1 + have n0 := facts.2.1 0 + have n1 := facts.2.1 1 + by_contra hn + have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega + have bad := facts.2.2 0 1 z0 z1 + exact (by decide : (0 : Fin 3) ≠ 1) bad + have proper_equal (q q' : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) (hq' : ProperBandQuadruple q') + (j j' : Fin 3) (hc : q 0 = q' 0) (hp : q j.succ = q' j'.succ) : + P4981T1PrescriptionValue (.proper q hq j) F = + P4981T1PrescriptionValue (.proper q' hq' j') F := by + obtain ⟨r, hr, _⟩ := BandPredecessorNoCollision q q' hq hq' hc + have idx : j = j' + r := P4828T1ParentsDistinct q hq (hp.trans (hr j')) + have idx1 : j' + 1 + r = j + 1 := by omega + have idx2 : j' + 2 + r = j + 2 := by omega + simp only [P4981T1PrescriptionValue, hr, idx1, idx2, ← idx] + have parameter (z w : GaussianInt) + (h : 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt) = + 1 + 2 * w + 2 * (⟨0, 1⟩ : GaussianInt)) : z = w := by + apply Zsqrtd.ext + · have := congrArg Zsqrtd.re h + simp at this + omega + · have := congrArg Zsqrtd.im h + simp at this + omega + have general {e e' : CircleCoordinates × CircleCoordinates} + (p : P4981T1EdgePrescription e) (p' : P4981T1EdgePrescription e') + (he : e = e') : + P4981T1PrescriptionValue p F = P4981T1PrescriptionValue p' F := by + cases p <;> cases p' + all_goals try rfl + all_goals try { have hc := congrArg (fun e => e.2.1) he; norm_num at hc } + all_goals try { have hp := congrArg (fun e => e.1.1) he; norm_num at hp } + all_goals try { have hp := congrArg (fun e => e.1.2) he; norm_num at hp } + all_goals try { + have hc := congrArg (fun e => e.2.1) he + have big := large _ (by assumption) + dsimp at hc + omega } + all_goals try { + have hz := parameter _ _ (congrArg (fun e => e.2.2) he) + cases hz + rfl } + all_goals try { + have hz := parameter _ _ (congrArg (fun e => e.1.2) he) + cases hz + rfl } + exact proper_equal _ _ (by assumption) (by assumption) _ _ + (congrArg Prod.snd he) (congrArg Prod.fst he) + exact general p p' rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionLocality.lean b/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionLocality.lean new file mode 100644 index 0000000000..5178b49ead --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionLocality.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4981T1EdgeRank +public import LeanPool.ApollonianSuperharmonic.P4981T1PrescriptionValue +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure + +-- [TABLET NODE: P4981T1PrescriptionLocality] + +/-! +# P4981T1PrescriptionLocality + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4981T1PrescriptionLocality {e : CircleCoordinates × CircleCoordinates} + (p : P4981T1EdgePrescription e) + (F G : CircleCoordinates × CircleCoordinates → GaussianInt × GaussianInt) + (h : ∀ d, P4981T1EdgeRank d < P4981T1EdgeRank e → F d = G d) : + P4981T1PrescriptionValue p F = P4981T1PrescriptionValue p G := by +-- BODY + cases p with + | line => rfl + | left z => rfl + | right z => rfl + | unit z => rfl + | proper q hq j => + have pos := (ProperBandCurvatureStructure q hq).1 + have lower (k : Fin 3) : (q k.succ).1.toNat < (q 0).1.toNat := + (Int.toNat_lt_toNat pos).mpr (hq.2 k) + have small (k l : Fin 3) : + P4981T1EdgeRank (q k.succ, q l.succ) < + P4981T1EdgeRank (q j.succ, q 0) := by + dsimp only [P4981T1EdgeRank] + exact lt_of_lt_of_le (max_lt (lower k) (lower l)) (le_max_right _ _) + simp only [P4981T1PrescriptionValue, + h _ (small j (j + 2)), h _ (small (j + 1) j)] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionValue.lean b/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionValue.lean new file mode 100644 index 0000000000..2ae234d535 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionValue.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4981T1EdgePrescription + +-- [TABLET NODE: P4981T1PrescriptionValue] + +/-! +# P4981T1PrescriptionValue + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For prescription data as in `P4981T1EdgePrescription` and any +edge-value function +$F=(v,a):(\mathbb Z\times\mathbb Z[i])^2\to\mathbb Z[i]^2$, +its prescribed value is respectively +$$ + (0,1),\quad (-1,-1-z-i),\quad (-i,iz-1),\quad + (1+i,1+z-iz). +$$ +For proper data $(q,j)$ put $p_j=q_{j+1}$, with subscripts taken modulo +three, $x=F(p_j,p_{j+2})$, and $y=F(p_{j+1},p_j)$. Its value is +$(x_v-i y_v,x_a+i y_a)$. +-/ +def P4981T1PrescriptionValue {e : CircleCoordinates × CircleCoordinates} + (p : P4981T1EdgePrescription e) + (F : CircleCoordinates × CircleCoordinates → GaussianInt × GaussianInt) : + GaussianInt × GaussianInt := +-- BODY + let ii : GaussianInt := ⟨0, 1⟩ + match p with + | .line => (0, 1) + | .left z => (-1, -1 - z - ii) + | .right z => (-ii, ii * z - 1) + | .unit z => (1 + ii, 1 + z - ii * z) + | .proper q _ j => + let x := F (q j.succ, q ((j + 2).succ)) + let y := F (q ((j + 1).succ), q j.succ) + (x.1 - ii * y.1, x.2 + ii * y.2) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1ProperEquations.lean b/LeanPool/ApollonianSuperharmonic/P4981T1ProperEquations.lean new file mode 100644 index 0000000000..59f05d418e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4981T1ProperEquations.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4981T1PrescriptionValue +public import LeanPool.ApollonianSuperharmonic.P4981T1Recursion + +-- [TABLET NODE: P4981T1ProperEquations] + +/-! +# P4981T1ProperEquations + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4981T1ProperEquations + (F : CircleCoordinates × CircleCoordinates → GaussianInt × GaussianInt) + (rev : ∀ C D, PrimitiveVectorOrientation C D → + F (D, C) = ((⟨0, 1⟩ : GaussianInt) * (F (C, D)).1, + -(⟨0, 1⟩ : GaussianInt) * (F (C, D)).2)) : + (∀ q (hq : ProperBandQuadruple q) j, + F (q j.succ, q 0) = P4981T1PrescriptionValue (.proper q hq j) F) ↔ + (∀ q, ProperBandQuadruple q → P4981T1Recursion F q) := by +-- BODY + let ii : GaussianInt := ⟨0, 1⟩ + have square : ii * ii = -1 := by decide +kernel + constructor + · intro table q hq + have hin := table q hq 1 + have hout := rev (q 3) (q 0) (.parentChild hq 2) + have h2 := table q hq 2 + change F (q 3, q 0) = _ at h2 + rw [h2] at hout + change F (q 2, q 0) = + ((F (q 2, q 1)).1 - ii * (F (q 3, q 2)).1, + (F (q 2, q 1)).2 + ii * (F (q 3, q 2)).2) at hin + change F (q 0, q 3) = + (ii * ((F (q 3, q 2)).1 - ii * (F (q 1, q 3)).1), + -ii * ((F (q 3, q 2)).2 + ii * (F (q 1, q 3)).2)) at hout + refine ⟨congrArg Prod.fst hin, ?_, congrArg Prod.snd hin, ?_⟩ + · change (F (q 0, q 3)).1 = _ + rw [hout] + dsimp only + simp only [mul_sub, ← mul_assoc, square, neg_one_mul, sub_neg_eq_add] + exact add_comm _ _ + · change (F (q 0, q 3)).2 = _ + rw [hout] + dsimp only + simp only [neg_mul, mul_add, ← mul_assoc, square] + ring + · intro rec q hq j + let qr : Fin 4 → CircleCoordinates := + ![q 0, q ((j + 2).succ), q j.succ, q ((j + 1).succ)] + have hqr : ProperBandQuadruple qr := by + fin_cases j + · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1), ?_⟩ + intro k + fin_cases k + · exact hq.2 2 + · exact hq.2 0 + · exact hq.2 1 + · convert hq using 1 + funext k + fin_cases k <;> rfl + · refine ⟨SemiProperQuadruple.rotate hq.1, ?_⟩ + intro k + fin_cases k + · exact hq.2 1 + · exact hq.2 2 + · exact hq.2 0 + have equations := rec qr hqr + exact Prod.ext equations.1 equations.2.2.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1Recursion.lean b/LeanPool/ApollonianSuperharmonic/P4981T1Recursion.lean new file mode 100644 index 0000000000..5a65228259 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4981T1Recursion.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates + +-- [TABLET NODE: P4981T1Recursion] + +/-! +# P4981T1Recursion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For an edge-value function +$F=(v,a):(\mathbb Z\times\mathbb Z[i])^2\to\mathbb Z[i]^2$ +and a coordinate tuple $q$, its local +successor equations mean the four equalities +$$ + v_{20}=v_{21}-i v_{32},\qquad v_{03}=v_{13}+i v_{32},\qquad + a_{20}=a_{21}+i a_{32},\qquad a_{03}=a_{13}-i a_{32}, +$$ +where $v_{jk},a_{jk}$ are the components of $F(q_j,q_k)$. +-/ +def P4981T1Recursion + (F : CircleCoordinates × CircleCoordinates → GaussianInt × GaussianInt) + (q : Fin 4 → CircleCoordinates) : Prop := +-- BODY + let ii : GaussianInt := ⟨0, 1⟩ + (F (q 2, q 0)).1 = (F (q 2, q 1)).1 - ii * (F (q 3, q 2)).1 ∧ + (F (q 0, q 3)).1 = (F (q 1, q 3)).1 + ii * (F (q 3, q 2)).1 ∧ + (F (q 2, q 0)).2 = (F (q 2, q 1)).2 + ii * (F (q 3, q 2)).2 ∧ + (F (q 0, q 3)).2 = (F (q 1, q 3)).2 - ii * (F (q 3, q 2)).2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1RootEquations.lean b/LeanPool/ApollonianSuperharmonic/P4981T1RootEquations.lean new file mode 100644 index 0000000000..024f20c37e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4981T1RootEquations.lean @@ -0,0 +1,175 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4981T1PrescriptionValue +public import LeanPool.ApollonianSuperharmonic.P4981T1Recursion + +-- [TABLET NODE: P4981T1RootEquations] + +/-! +# P4981T1RootEquations + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4981T1RootEquations + (F : CircleCoordinates × CircleCoordinates → GaussianInt × GaussianInt) + (rev : ∀ C D, PrimitiveVectorOrientation C D → + F (D, C) = ((⟨0, 1⟩ : GaussianInt) * (F (C, D)).1, + -(⟨0, 1⟩ : GaussianInt) * (F (C, D)).2)) : + ((∀ z : GaussianInt, + let q : Fin 4 → CircleCoordinates := + ![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)), + (0, 1), (0, -1)] + (F (q 3, q 2)).1 = 0 ∧ (F (q 2, q 1)).1 = -1 ∧ + (F (q 1, q 3)).1 = 1 ∧ (F (q 3, q 2)).2 = 1 ∧ + (F (q 2, q 1)).2 = -1 - z - (⟨0, 1⟩ : GaussianInt) ∧ + (F (q 1, q 3)).2 = z + (⟨0, 1⟩ : GaussianInt)) ∧ + (∀ (z : GaussianInt) (r : Fin 3), + let p : Fin 3 → CircleCoordinates := + ![(1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)), (0, 1), (0, -1)] + P4981T1Recursion F ![(1, 1 + 2 * z), p r, p (r + 1), p (r + 2)])) ↔ + (F ((0, -1), (0, 1)) = P4981T1PrescriptionValue .line F ∧ + ∀ z, F ((0, 1), (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt))) = + P4981T1PrescriptionValue (.left z) F ∧ + F ((0, -1), (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt))) = + P4981T1PrescriptionValue (.right z) F ∧ + F ((1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)), (1, 1 + 2 * z)) = + P4981T1PrescriptionValue (.unit z) F) := by +-- BODY + let ii : GaussianInt := ⟨0, 1⟩ + change ∀ U V, PrimitiveVectorOrientation U V → + F (V, U) = (ii * (F (U, V)).1, -ii * (F (U, V)).2) at rev + have square : ii * ii = -1 := by decide +kernel + let X (z : GaussianInt) : CircleCoordinates := (1, 1 + 2 * z) + let A (z : GaussianInt) : CircleCoordinates := (1, 1 + 2 * z + 2 * ii) + let B : CircleCoordinates := (0, 1) + let C : CircleCoordinates := (0, -1) + have inv (U V : CircleCoordinates) (hp : PrimitiveVectorOrientation U V) : + F (U, V) = (-ii * (F (V, U)).1, ii * (F (V, U)).2) := by + rw [rev U V hp] + simp only [neg_mul, mul_neg, ← mul_assoc, square, neg_neg, one_mul] + constructor + · rintro ⟨base, rec⟩ + refine ⟨Prod.ext (base 0).1 (base 0).2.2.2.1, ?_⟩ + intro z + have ba : F (B, A z) = (-1, -1 - z - ii) := + Prod.ext (base z).2.1 (base z).2.2.2.2.1 + have ac : F (A z, C) = (1, z + ii) := + Prod.ext (base z).2.2.1 (base z).2.2.2.2.2 + refine ⟨ba, ?_, ?_⟩ + · have ca := inv C (A z) (.base31 z) + rw [ac] at ca + change F (C, A z) = (-ii, ii * z - 1) + rw [ca] + apply Prod.ext <;> dsimp only + · ring + · simp only [mul_add, square] + ring + · have equations := rec z 2 + change P4981T1Recursion F ![X z, C, A z, B] at equations + change F (A z, X z) = (1 + ii, 1 + z - ii * z) + apply Prod.ext + · calc + (F (A z, X z)).1 = (F (A z, C)).1 - ii * (F (B, A z)).1 := equations.1 + _ = 1 + ii := by rw [ac, ba]; dsimp only; ring + · calc + (F (A z, X z)).2 = (F (A z, C)).2 + ii * (F (B, A z)).2 := equations.2.2.1 + _ = 1 + z - ii * z := by + rw [ac, ba] + dsimp only + simp only [mul_sub, mul_neg, square, mul_one] + ring + · rintro ⟨line, table⟩ + have cb : F (C, B) = (0, 1) := line + have ba (z) : F (B, A z) = (-1, -1 - z - ii) := (table z).1 + have ca (z) : F (C, A z) = (-ii, ii * z - 1) := (table z).2.1 + have ax (z) : F (A z, X z) = (1 + ii, 1 + z - ii * z) := (table z).2.2 + have ac (z) : F (A z, C) = (1, z + ii) := by + rw [rev C (A z) (.base31 z), ca z] + apply Prod.ext <;> dsimp only + · simp only [mul_neg, square, neg_neg] + · simp only [neg_mul, mul_sub, ← mul_assoc, square, mul_one] + ring + have shift (z) : A (z - ii) = X z := by + dsimp [A, X] + congr 1 + ring + have bx (z) : F (B, X z) = (-1, -1 - z) := by + have h := ba (z - ii) + rw [shift] at h + rw [h] + congr 1 + ring + have cx (z) : F (C, X z) = (-ii, ii * z) := by + have h := ca (z - ii) + rw [shift] at h + rw [h] + congr 1 + simp only [mul_sub, square] + ring + have xc (z) : F (X z, C) = (1, z) := by + have hp : PrimitiveVectorOrientation C (X z) := by + rw [← shift z] + exact .base31 (z - ii) + rw [rev C (X z) hp, cx z] + apply Prod.ext <;> dsimp only + · simp only [mul_neg, square, neg_neg] + · simp only [neg_mul, ← mul_assoc, square, neg_neg, one_mul] + have xb (z) : F (X z, B) = (-ii, ii + ii * z) := by + have hp : PrimitiveVectorOrientation B (X z) := by + rw [← shift z] + exact .base21 (z - ii) + rw [rev B (X z) hp, bx z] + apply Prod.ext <;> dsimp only <;> ring + have xa (z) : F (X z, A z) = (-1 + ii, -z - ii - ii * z) := by + rw [rev (A z) (X z) (.base10 z), ax z] + apply Prod.ext <;> dsimp only + · simp only [mul_add, square, mul_one] + ring + · simp only [neg_mul, mul_sub, mul_add, ← mul_assoc, square, mul_one] + ring + constructor + · intro z + change (F (C, B)).1 = 0 ∧ (F (B, A z)).1 = -1 ∧ + (F (A z, C)).1 = 1 ∧ (F (C, B)).2 = 1 ∧ + (F (B, A z)).2 = -1 - z - ii ∧ (F (A z, C)).2 = z + ii + rw [cb, ba z, ac z] + exact ⟨rfl, rfl, rfl, rfl, rfl, rfl⟩ + · intro z r + change P4981T1Recursion F + ![X z, ![A z, B, C] r, ![A z, B, C] (r + 1), ![A z, B, C] (r + 2)] + fin_cases r + all_goals first + | change + (F (B, X z)).1 = (F (B, A z)).1 - ii * (F (C, B)).1 ∧ + (F (X z, C)).1 = (F (A z, C)).1 + ii * (F (C, B)).1 ∧ + (F (B, X z)).2 = (F (B, A z)).2 + ii * (F (C, B)).2 ∧ + (F (X z, C)).2 = (F (A z, C)).2 - ii * (F (C, B)).2 + | change + (F (C, X z)).1 = (F (C, B)).1 - ii * (F (A z, C)).1 ∧ + (F (X z, A z)).1 = (F (B, A z)).1 + ii * (F (A z, C)).1 ∧ + (F (C, X z)).2 = (F (C, B)).2 + ii * (F (A z, C)).2 ∧ + (F (X z, A z)).2 = (F (B, A z)).2 - ii * (F (A z, C)).2 + | change + (F (A z, X z)).1 = (F (A z, C)).1 - ii * (F (B, A z)).1 ∧ + (F (X z, B)).1 = (F (C, B)).1 + ii * (F (B, A z)).1 ∧ + (F (A z, X z)).2 = (F (A z, C)).2 + ii * (F (B, A z)).2 ∧ + (F (X z, B)).2 = (F (C, B)).2 - ii * (F (B, A z)).2 + all_goals simp only [cb, ba z, ac z, ax z, bx z, cx z, xc z, xa z, xb z] + all_goals refine ⟨?_, ?_, ?_, ?_⟩ + all_goals try simp only [mul_add, mul_sub, mul_neg, square, mul_one, mul_zero] + all_goals ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1BranchDecay.lean b/LeanPool/ApollonianSuperharmonic/P4984T1BranchDecay.lean new file mode 100644 index 0000000000..98476d8e6b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4984T1BranchDecay.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4984T1ContactDiameter +public import LeanPool.ApollonianSuperharmonic.P4828T1HistoryRealization +public import Mathlib.Analysis.SpecificLimits.Basic + +-- [TABLET NODE: P4984T1BranchDecay] + +/-! +# P4984T1BranchDecay + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4984T1BranchDecay (a : GaussianInt) (side : Bool) + (branch : Nat → Fin 3) : + let q (n : Nat) := P4828T1Evaluate a side ((List.range n).map branch) + let c (n : Nat) : Int := (q n 0).1 + StrictMono c ∧ + (∀ n : Nat, c 0 + (n : Int) ≤ c n) ∧ + Filter.Tendsto + (fun n ↦ Metric.diam (P4984T1ClosedGap (2 * (a.re : Real)) (q n))) + Filter.atTop (nhds 0) ∧ + Filter.Tendsto (fun n ↦ 1 / (c n : Real)) Filter.atTop (nhds 0) := by +-- BODY + let q (n : Nat) := P4828T1Evaluate a side ((List.range n).map branch) + let c (n : Nat) : Int := (q n 0).1 + have hq (n : Nat) := P4828T1HistoryRealization a side ((List.range n).map branch) + have hp (n : Nat) : ProperBandQuadruple (q n) := (hq n).1.1 + have hnext (n : Nat) : q (n + 1) = + P4828T1Step (P4828T1Rotate (q n) (branch n)) := by + simp [q, List.range_succ, P4828T1Evaluate, List.foldl_append] + have hstep (n : Nat) : c n < c (n + 1) := by + have hh := (hp (n + 1)).2 (0 : Fin 3) + have hfirst : q (n + 1) (Fin.succ 0) = q n 0 := by + rw [hnext]; rfl + rw [hfirst] at hh + exact hh + have hgrow (n : Nat) : c 0 + (n : Int) ≤ c n := by + induction n with + | zero => simp + | succ n ih => have := hstep n; push_cast; omega + have hpos (n : Nat) : 0 < c n := (ProperBandCurvatureStructure _ (hp n)).1 + have hc : Filter.Tendsto (fun n ↦ (c n : Real)) Filter.atTop Filter.atTop := by + apply Filter.tendsto_atTop_mono (fun n => ?_) + (tendsto_natCast_atTop_atTop (R := Real)) + have hh := hgrow n + have h0 := hpos 0 + have hh' : (n : Int) ≤ c n := by omega + exact_mod_cast hh' + have hr : Filter.Tendsto (fun n ↦ 1 / (c n : Real)) + Filter.atTop (nhds 0) := hc.const_div_atTop 1 + have hbound (n : Nat) : + Metric.diam (P4984T1ClosedGap (2 * (a.re : Real)) (q n)) ≤ + 6 * Real.sqrt (1 / (c n : Real)) := + P4984T1ContactDiameter _ _ (hp n) (hq n).1.2.1 (hq n).1.2.2 + have hlim : Filter.Tendsto (fun n ↦ 6 * Real.sqrt (1 / (c n : Real))) + Filter.atTop (nhds 0) := by + simpa using (Real.continuous_sqrt.continuousAt.tendsto.comp hr).const_mul 6 + exact ⟨strictMono_nat_of_lt_succ hstep, hgrow, + squeeze_zero (fun _ => Metric.diam_nonneg) hbound hlim, hr⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1ClosedGap.lean b/LeanPool/ApollonianSuperharmonic/P4984T1ClosedGap.lean new file mode 100644 index 0000000000..961b8a55dd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4984T1ClosedGap.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4909T1ParentPolygon + +-- [TABLET NODE: P4984T1ClosedGap] + +/-! +# P4984T1ClosedGap + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a real supporting offset $L$ and a coordinate quadruple $q$, put +$p_i=w_i/c_i$ and $r_i=1/c_i$ whenever $q_i=(c_i,w_i)$ has $c_i>0$. +The closed analytic gap is +$$ + H_L(q)=P_L(q)\cap\bigcap_{j\in\{1,2,3\},\ c_j>0} + \{z:|z-p_j|\geq r_j\}, +$$ +where $P_L(q)$ is the parent polygon of +`P4909T1ParentPolygon`. Zero-curvature entries contribute +their signed supporting line to that polygon, not a circle of radius +$1/0$. +-/ +def P4984T1ClosedGap (L : Real) (q : Fin 4 → CircleCoordinates) : Set Complex := +-- BODY + {p | p ∈ P4909T1ParentPolygon L q ∧ + ∀ j : Fin 3, 0 < (q j.succ).1 → + (1 / ((q j.succ).1 : Real)) ≤ + dist p ((q j.succ).2 / ((q j.succ).1 : Real))} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1ClosedSubdivision.lean b/LeanPool/ApollonianSuperharmonic/P4984T1ClosedSubdivision.lean new file mode 100644 index 0000000000..ae264bcb1b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4984T1ClosedSubdivision.lean @@ -0,0 +1,693 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap +public import LeanPool.ApollonianSuperharmonic.P4828T1Gap +public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.P4909T1TriangleFan +public import LeanPool.ApollonianSuperharmonic.P4909T1LineFan +public import LeanPool.ApollonianSuperharmonic.P4909T1OmittedDiskBarrier +public import LeanPool.ApollonianSuperharmonic.P4909T1TangentSegments +public import Mathlib.Analysis.Convex.Topology +public import Mathlib.Analysis.Normed.Group.Uniform +public import Mathlib.Analysis.Normed.Module.RCLike.Real +public import Mathlib.Analysis.RCLike.Basic + +-- [TABLET NODE: P4984T1ClosedSubdivision] + +/-! +# P4984T1ClosedSubdivision + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ClosedSubdivisionProof + +private theorem fan : + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), (P4828T1LineSupport L q) → ( + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + (0 < (q 0).1) → ((∀ i : Fin 3, 0 ≤ (q i.succ).1) → ((p 0 ∈ interior P) → ((∀ (i : Fin (3 : + ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) → ((∀ + b : Fin 3, F b ⊆ P ∧ + (0 < (q b.succ).1 → p b.succ ∉ F b) ∧ + frontier (F b) ⊆ P4909T1ParentEdges L (s b)) ∧ + (∀ b c : Fin 3, b ≠ c → Disjoint (interior (F b)) (interior (F c))) ∧ + P = ⋃ b : Fin 3, F b))))) := by + classical + intro L q hs p s P F hchildpos hparentsNonneg hinside hzunique + by_cases hline : ∃ l : Fin 3, (q l.succ).1 = 0 + · obtain ⟨l, hl⟩ := hline + have hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1 := by + intro i hil + have hnonneg := hparentsNonneg i + by_contra hn + have hi0 : (q i.succ).1 = 0 := by omega + have heq := hzunique i l hi0 hl + exact hil heq + have hnormal := hs.normals l.succ hl + have hside : ∀ i : Fin 4, 0 < (q i).1 → + if (q l.succ).2 = -1 then L < (p i).re + else (p i).re < L + 2 := by + intro i hi + have hi0 : (q i).1 ≠ 0 := ne_of_gt hi + have hre : (p i).re = (q i).2.re / (q i).1 := by + dsimp [p] + rw [Complex.div_re] + simp [] + field_simp [hi0] + have hh := hs.signed l.succ i hl hi + have hcurvReal : (0 : ℝ) < (q i).1 := by exact_mod_cast hi + have hrealI : ((q i).2 : ℂ).re = (q i).2.re := by norm_num + rcases hnormal with hneg | hposLine + · rw [hneg] at hh + norm_num at hh + rw [hrealI] at hh + rw [hre] + rw [hneg] + apply (lt_div_iff₀ hcurvReal).2 + nlinarith [hh] + · rw [hposLine] at hh + norm_num at hh + rw [hrealI] at hh + rw [hre] + have hcond : (q l.succ).2 ≠ -1 := by rw [hposLine]; norm_num + rw [ite_eq_right hcond] + apply (div_lt_iff₀ hcurvReal).2 + nlinarith [hh] + have hfan := P4909T1LineFan L q l hl hpos hchildpos hnormal hside hinside + simpa only [p, s, P, F] using + (show (∀ b : Fin 3, P4909T1ParentPolygon L (s b) ⊆ + P4909T1ParentPolygon L q ∧ + (0 < (q b.succ).1 → p b.succ ∉ P4909T1ParentPolygon L (s b)) ∧ + frontier (P4909T1ParentPolygon L (s b)) ⊆ + P4909T1ParentEdges L (s b)) ∧ + (∀ b c : Fin 3, b ≠ c → Disjoint + (interior (P4909T1ParentPolygon L (s b))) + (interior (P4909T1ParentPolygon L (s c)))) ∧ + P4909T1ParentPolygon L q = ⋃ b : Fin 3, + P4909T1ParentPolygon L (s b) from ⟨ + (fun b => ⟨(hfan.1 b).1, fun hb => (hfan.1 b).2.1 hb, (hfan.1 b).2.2⟩), + hfan.2.1, hfan.2.2.1⟩) + · have hpos : ∀ i : Fin 4, 0 < (q i).1 := by + intro i + fin_cases i + · exact hchildpos + · have hnonneg : 0 ≤ (q (Fin.succ 0)).1 := hparentsNonneg 0 + by_contra hnot + have hz : (q (Fin.succ 0)).1 = 0 := + le_antisymm (le_of_not_gt hnot) hnonneg + exact hline ⟨0, hz⟩ + · have hnonneg : 0 ≤ (q (Fin.succ 1)).1 := hparentsNonneg 1 + by_contra hnot + have hz : (q (Fin.succ 1)).1 = 0 := + le_antisymm (le_of_not_gt hnot) hnonneg + exact hline ⟨1, hz⟩ + · have hnonneg : 0 ≤ (q (Fin.succ 2)).1 := hparentsNonneg 2 + by_contra hnot + have hz : (q (Fin.succ 2)).1 = 0 := + le_antisymm (le_of_not_gt hnot) hnonneg + exact hline ⟨2, hz⟩ + have hfan := P4909T1TriangleFan L q hpos hinside + exact ⟨(fun b => ⟨(hfan.1 b).1, fun _ => (hfan.1 b).2.1, + (hfan.1 b).2.2⟩), hfan.2.1, hfan.2.2.1⟩ + +private theorem polygonClosed : + ∀ (L : Real), + ∀ (t : Fin 4 → CircleCoordinates), IsClosed (P4909T1ParentPolygon L t) := by + classical + intro L t + let complexNormedSpace : NormedSpace ℝ ℂ := by + refine ⟨fun a z => ?_⟩ + change ‖(a : ℂ) * z‖ ≤ ‖a‖ * ‖z‖ + have ha : ‖(a : ℂ)‖ = ‖a‖ := by norm_cast + rw [Complex.norm_mul, ha] + let center (i : Fin 3) : ℂ := (t i.succ).2 / ((t i.succ).1 : ℝ) + let foot (i k : Fin 3) : ℂ := + ⟨if (t k.succ).2 = -1 then L else L + 2, (center i).im⟩ + have hfinite : {z : ℂ | ∃ i : Fin 3, 0 < (t i.succ).1 ∧ + (z = center i ∨ ∃ k : Fin 3, (t k.succ).1 = 0 ∧ z = foot i k)}.Finite := by + apply (Set.finite_range center).union (Set.finite_range (fun ij : Fin 3 × Fin 3 => foot ij.1 + ij.2)) |>.subset + rintro z ⟨i, hi, rfl | ⟨k, hk, rfl⟩⟩ + · exact Set.mem_union_left _ ⟨i, rfl⟩ + · exact Set.mem_union_right _ ⟨(i, k), rfl⟩ + change IsClosed (convexHull ℝ {z : ℂ | ∃ i : Fin 3, 0 < (t i.succ).1 ∧ + (z = center i ∨ ∃ k : Fin 3, (t k.succ).1 = 0 ∧ z = foot i k)}) + exact hfinite.isClosed_convexHull ℝ + +private theorem gapClosed : + ∀ (L : Real), ∀ (t : Fin 4 → CircleCoordinates), IsClosed + (P4984T1ClosedGap L t) := by + classical + intro L t + have polygonClosed := ClosedSubdivisionProof.polygonClosed L + have hp := polygonClosed t + have hineq : IsClosed {z : ℂ | ∀ j : Fin 3, 0 < (t j.succ).1 → + (1 / ((t j.succ).1 : ℝ)) ≤ dist z ((t j.succ).2 / ((t j.succ).1 : ℝ))} := by + rw [Set.ofPred_forall] + apply isClosed_iInter + intro j + by_cases hj : 0 < (t j.succ).1 + · have heq : {z : ℂ | 0 < (t j.succ).1 → + (1 / ((t j.succ).1 : ℝ)) ≤ dist z ((t j.succ).2 / ((t j.succ).1 : ℝ))} = + {z : ℂ | (1 / ((t j.succ).1 : ℝ)) ≤ + dist z ((t j.succ).2 / ((t j.succ).1 : ℝ))} := by + ext z + simp [hj] + rw [heq] + exact isClosed_le continuous_const (continuous_id.dist continuous_const) + · have heq : {z : ℂ | 0 < (t j.succ).1 → + (1 / ((t j.succ).1 : ℝ)) ≤ dist z ((t j.succ).2 / ((t j.succ).1 : ℝ))} = + Set.univ := by + ext z + simp [hj] + rw [heq] + exact isClosed_univ + change IsClosed (P4909T1ParentPolygon L t ∩ {z : ℂ | ∀ j : Fin 3, + 0 < (t j.succ).1 → (1 / ((t j.succ).1 : ℝ)) ≤ + dist z ((t j.succ).2 / ((t j.succ).1 : ℝ))}) + exact hp.inter hineq + +private theorem support : + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), (P4828T1LineSupport L q) → ( + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + ∀ (k : Fin 4), ∀ (i : Fin 4), ((q k).1 = 0) → ((0 < (q i).1) → (if (q k).2 = -1 then (p i).re + = L + r i + else (p i).re = L + 2 - r i))) := by + classical + intro L q hs p r k i hk hi + have hh := hs.signed k i hk hi + have hnum : ((q i).2 : ℂ).re = (q i).2.re := by norm_num + have hci : ((q i).1 : ℝ) ≠ 0 := by exact_mod_cast ne_of_gt hi + have hre : (p i).re = (q i).2.re / (q i).1 := by simp [p] + rcases hs.normals k hk with hn | hn + · simp? [hn] + rw [hn] at hh + norm_num at hh + rw [hnum] at hh + rw [hre] + dsimp [r] + field_simp [hci] + linarith + · have hne : (q k).2 ≠ -1 := by rw [hn]; norm_num + simp only [ite_eq_right hne] + rw [hn] at hh + norm_num at hh + rw [hnum] at hh + rw [hre] + dsimp [r] + field_simp [hci] + linarith + +private theorem footDist : + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + (∀ (i : Fin 4), (0 < (q i).1) → (0 < r i)) → ((∀ (k : Fin 4), ∀ (i : Fin 4), ((q k).1 = 0) → + ((0 < (q i).1) → (if (q k).2 = -1 then (p i).re = L + r i else (p i).re = L + 2 - r i))) + → (∀ (k : Fin 4), ∀ (i : Fin 4), ((q k).1 = 0) → ((0 < (q i).1) → (dist (p i) ⟨if (q k).2 + = -1 then L else L + 2, (p i).im⟩ = r i)))) := by + classical + intro L q p r rpos support k i hk hi + have hr := (rpos i hi).le + have hh := support k i hk hi + rw [Complex.dist_eq] + by_cases hn : (q k).2 = -1 + · simp? [hn] at hh ⊢ + have hv : p i - (⟨L, (p i).im⟩ : ℂ) = (r i : ℂ) := by + apply Complex.ext <;> simp [hh] + rw [hv, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg hr] + · simp? [hn] at hh ⊢ + have hv : p i - (⟨L + 2, (p i).im⟩ : ℂ) = (-r i : ℂ) := by + apply Complex.ext <;> simp [hh] + rw [hv, norm_neg, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg hr] + +private theorem footCover : + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + (∀ (k : Fin 4), ∀ (i : Fin 4), ((q k).1 = 0) → ((0 < (q i).1) → (dist (p i) ⟨if (q k).2 = -1 + then L else L + 2, (p i).im⟩ = r i))) → (∀ (k : Fin 4), ∀ (i : Fin 4), ((q k).1 = 0) → + ((0 < (q i).1) → (segment ℝ (p i) ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ ⊆ + Metric.closedBall (p i) (r i)))) := by + classical + intro L q p r footDist k i hk hi z hz + have hd := footDist k i hk hi + rcases (P4909T1TangentSegments _ _ (r i) 0 + (by simpa only [add_zero] using hd)).1 hz with h | h + · exact h + · have heq : z = ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ := by + simpa only [Metric.mem_closedBall, dist_le_zero] using h + rw [Metric.mem_closedBall, heq, dist_comm, hd] + +private theorem lineDist : + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + (∀ (i : Fin 4), (0 < (q i).1) → (0 < r i)) → ((∀ (k : Fin 4), ∀ (i : Fin 4), ((q k).1 = 0) → + ((0 < (q i).1) → (if (q k).2 = -1 then (p i).re = L + r i else (p i).re = L + 2 - r i))) + → (∀ (k : Fin 4), ∀ (i : Fin 4), ((q k).1 = 0) → ((0 < (q i).1) → (∀ (z : ℂ), (z.re = if + (q k).2 = -1 then L else L + 2) → (r i ≤ dist z (p i)))))) := by + classical + intro L q p r rpos support k i hk hi z hz + have hh := support k i hk hi + have hab := Complex.abs_re_le_norm (z - p i) + rw [Complex.sub_re, hz] at hab + rw [Complex.dist_eq] + by_cases hn : (q k).2 = -1 + · simp? [hn] at hh hab + have heq : L - (p i).re = -r i := by linarith + rw [heq, abs_neg, abs_of_pos (rpos i hi)] at hab + exact hab + · simp? [hn] at hh hab + have heq : L + 2 - (p i).re = r i := by linarith + rw [heq, abs_of_pos (rpos i hi)] at hab + exact hab + +private theorem hdist : + ∀ (t : Fin 4 → CircleCoordinates), (SemiProperQuadruple t) → (∀ (i : Fin 4), ∀ (j : Fin 4), + (i ≠ j) → ((0 < (t i).1) → ((0 < (t j).1) → (dist (((t i).2 : ℂ) / ((t i).1 : ℝ)) (((t + j).2 : ℂ) / ((t j).1 : ℝ)) = + 1 / ((t i).1 : ℝ) + 1 / ((t j).1 : ℝ))))) := by + classical + intro t ht i j hij hi hj + let a : ℝ := (t i).1 + let b : ℝ := (t j).1 + let x : ℂ := (t i).2 + let y : ℂ := (t j).2 + change dist (((t i).2 : ℂ) / ((t i).1 : ℝ)) + (((t j).2 : ℂ) / ((t j).1 : ℝ)) = + 1 / ((t i).1 : ℝ) + 1 / ((t j).1 : ℝ) + change dist (x / a) (y / b) = 1 / a + 1 / b + have hh := TangencyCoordinateIdentity t ht i j hij + have hn : (Zsqrtd.norm ((t j).1 • (t i).2 - (t i).1 • (t j).2) : ℝ) = + ((t i).1 + (t j).1 : ℤ) ^ 2 := by exact_mod_cast hh + have hns : Complex.normSq ((b : ℝ) * x - a * y) = (a + b)^2 := by + dsimp [a, b, x, y] + norm_num [Complex.normSq_apply, Zsqrtd.norm] at hn ⊢ + nlinarith + have haPos : 0 < a := by simpa [a] using hi + have hbPos : 0 < b := by simpa [b] using hj + have ha : a ≠ 0 := ne_of_gt haPos + have hb : b ≠ 0 := ne_of_gt hbPos + have hdiv : (x / a - y / b) * (a * b) = (b : ℂ) * x - a * y := by + field_simp [ha, hb] + have hratio : x / a - y / b = ((b : ℂ) * x - a * y) / (a * b) := by + rw [← hdiv] + field_simp [ha, hb] + have hnumNorm : ‖(b : ℝ) * x - a * y‖ = a + b := by + rw [← sq_eq_sq₀ (norm_nonneg _) (add_pos haPos hbPos).le] + rw [← Complex.normSq_eq_norm_sq] + exact hns + have hA : ‖(a : ℂ)‖ = a := by simp [Complex.norm_real, abs_of_pos haPos] + have hB : ‖(b : ℂ)‖ = b := by simp [Complex.norm_real, abs_of_pos hbPos] + rw [dist_eq_norm, hratio, Complex.norm_div, hnumNorm, + Complex.norm_mul, hA, hB] + field_simp [ha, hb]; ring + +private theorem boundaryAvoid : + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ( + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + ((∀ b : Fin 3, F b ⊆ P ∧ (0 < (q b.succ).1 → p b.succ ∉ F b) ∧ frontier (F b) ⊆ + P4909T1ParentEdges L (s b)) ∧ (∀ b c : Fin 3, b ≠ c → Disjoint (interior (F b)) + (interior (F c))) ∧ P = ⋃ b : Fin 3, F b) → ( + let idx (b j : Fin 3) : Fin 4 := ![0, (b + 1).succ, (b + 2).succ] j + (∀ (b : Fin 3), ∀ (j : Fin 3), s b j.succ = q (idx b j)) → ((∀ (b : Fin 3), + Function.Injective (idx b)) → ((∀ (b : Fin 3), ∀ (j : Fin 3), idx b j ≠ b.succ) → ((∀ (k + : Fin 4), ∀ (i : Fin 4), ((q k).1 = 0) → ((0 < (q i).1) → (segment ℝ (p i) ⟨if (q k).2 = + -1 then L else L + 2, (p i).im⟩ ⊆ Metric.closedBall (p i) (r i)))) → ((∀ (k : Fin 4), ∀ + (i : Fin 4), ((q k).1 = 0) → ((0 < (q i).1) → (∀ (z : ℂ), (z.re = if (q k).2 = -1 then L + else L + 2) → (r i ≤ dist z (p i))))) → ((∀ (t : Fin 4 → CircleCoordinates), + (SemiProperQuadruple t) → (∀ (i : Fin 4), ∀ (j : Fin 4), (i ≠ j) → ((0 < (t i).1) → ((0 < + (t j).1) → (dist (((t i).2 : ℂ) / ((t i).1 : ℝ)) (((t j).2 : ℂ) / ((t j).1 : ℝ)) = 1 / + ((t i).1 : ℝ) + 1 / ((t j).1 : ℝ)))))) → (∀ (b : Fin 3), (0 < (q b.succ).1) → (∀ z ∈ + frontier (F b), z ∉ Metric.ball (p b.succ) (r b.succ)))))))))) := by + classical + intro L q hq p r s P F fan idx parent idx_inj idx_ne footCover lineDist hdist b hb z hz hball + have hedge := (fan.1 b).2.2 hz + change (∃ i j : Fin 3, i ≠ j ∧ 0 < (s b i.succ).1 ∧ + 0 < (s b j.succ).1 ∧ z ∈ segment ℝ + (((s b i.succ).2 : ℂ) / ((s b i.succ).1 : ℝ)) + (((s b j.succ).2 : ℂ) / ((s b j.succ).1 : ℝ))) ∨ + (∃ i k : Fin 3, 0 < (s b i.succ).1 ∧ (s b k.succ).1 = 0 ∧ + z ∈ segment ℝ (((s b i.succ).2 : ℂ) / ((s b i.succ).1 : ℝ)) + ⟨if (s b k.succ).2 = -1 then L else L + 2, + (((s b i.succ).2 : ℂ) / ((s b i.succ).1 : ℝ)).im⟩) ∨ + (∃ k : Fin 3, (s b k.succ).1 = 0 ∧ + z.re = if (s b k.succ).2 = -1 then L else L + 2) at hedge + have avoid (i : Fin 3) (hi : 0 < (s b i.succ).1) : + z ∉ Metric.closedBall (p (idx b i)) (r (idx b i)) := by + have hroot : 0 < (q (idx b i)).1 := by simpa only [parent] using hi + have hd := hdist q hq.1 b.succ (idx b i) (idx_ne b i).symm hb hroot + exact Set.disjoint_left.mp + (P4909T1TangentSegments _ _ _ _ hd).2 hball + simp only [parent] at hedge + rcases hedge with ⟨i, j, hij, hi, hj, hzseg⟩ | + ⟨i, k, hi, hk, hzseg⟩ | ⟨k, hk, hzline⟩ + · have hrooti : 0 < (q (idx b i)).1 := by simpa only [parent] using hi + have hrootj : 0 < (q (idx b j)).1 := by simpa only [parent] using hj + have hij' : idx b i ≠ idx b j := fun he => hij (idx_inj b he) + have hd := hdist q hq.1 (idx b i) (idx b j) hij' hrooti hrootj + rcases (P4909T1TangentSegments _ _ _ _ hd).1 hzseg with h | h + · exact avoid i (by simpa only [parent] using hrooti) h + · exact avoid j (by simpa only [parent] using hrootj) h + · have hkroot : (q (idx b k)).1 = 0 := by simpa only [parent] using hk + have hrooti : 0 < (q (idx b i)).1 := by simpa only [parent] using hi + have hclosed := footCover (idx b k) (idx b i) hkroot hrooti hzseg + exact avoid i (by simpa only [parent] using hrooti) hclosed + · have hkroot : (q (idx b k)).1 = 0 := by simpa only [parent] using hk + have hdistLine := lineDist (idx b k) b.succ hkroot hb z hzline + have hball' : dist z (p b.succ) < r b.succ := by + simpa only [Metric.mem_ball, dist_comm] using hball + exact (not_lt_of_ge hdistLine) hball' + +private theorem omittedClosed : + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + (∀ (b : Fin 3), (0 < (q b.succ).1) → (∀ z ∈ frontier (F b), z ∉ Metric.ball (p b.succ) (r + b.succ))) → ((∀ (b : Fin 3), (0 < (q b.succ).1) → (∀ z ∈ interior (F b), r b.succ < dist + z (p b.succ))) → (∀ (b : Fin 3), (0 < (q b.succ).1) → (∀ z ∈ F b, r b.succ ≤ dist z (p + b.succ)))) := by + classical + intro L q p r s F boundaryAvoid omittedInterior b hb + have polygonClosed := ClosedSubdivisionProof.polygonClosed L + intro z hz + by_cases hi : z ∈ interior (F b) + · exact (omittedInterior b hb z hi).le + · have hf : z ∈ frontier (F b) := by + rw [(polygonClosed (s b)).frontier_eq] + exact ⟨hz, hi⟩ + have hnot := boundaryAvoid b hb z hf + exact le_of_not_gt (fun hlt => hnot (Metric.mem_ball.mpr (by + simpa only [Metric.mem_ball, dist_comm] using hlt))) + +private theorem childSubset : + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let H := P4984T1ClosedGap L q + let child (b : Fin 3) := P4984T1ClosedGap L (s b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + ((∀ b : Fin 3, F b ⊆ P ∧ (0 < (q b.succ).1 → p b.succ ∉ F b) ∧ frontier (F b) ⊆ + P4909T1ParentEdges L (s b)) ∧ (∀ b c : Fin 3, b ≠ c → Disjoint (interior (F b)) + (interior (F c))) ∧ P = ⋃ b : Fin 3, F b) → ( + let idx (b j : Fin 3) : Fin 4 := ![0, (b + 1).succ, (b + 2).succ] j + (∀ (b : Fin 3), ∀ (j : Fin 3), s b j.succ = q (idx b j)) → ((∀ (b : Fin 3), ∀ (j : Fin 3), (j + ≠ b) → (∃ k : Fin 3, idx b k = j.succ)) → ((∀ (b : Fin 3), (0 < (q b.succ).1) → (∀ z ∈ F + b, r b.succ ≤ dist z (p b.succ))) → (∀ (b : Fin 3), child b ⊆ H)))) := by + classical + intro L q p r s H child P F fan idx parent oldRetained omittedClosed b z hz + change z ∈ F b ∧ ∀ j : Fin 3, 0 < (s b j.succ).1 → + 1 / ((s b j.succ).1 : ℝ) ≤ + dist z (((s b j.succ).2 : ℂ) / ((s b j.succ).1 : ℝ)) at hz + change z ∈ P ∧ ∀ j : Fin 3, 0 < (q j.succ).1 → + 1 / ((q j.succ).1 : ℝ) ≤ dist z (p j.succ) + refine ⟨(fan.1 b).1 hz.1, ?_⟩ + intro j hj + by_cases hjeq : j = b + · subst j + exact omittedClosed b hj z hz.1 + · obtain ⟨k, hk⟩ := oldRetained b j hjeq + have hp : s b k.succ = q j.succ := by rw [parent, hk] + have hh := hz.2 k (by simpa only [hp] using hj) + simpa only [hp, p, r] using hh + +private theorem openBallSubset : + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), (P4828T1Disk (q (0 : Fin (4 : ℕ))) ⊆ + P4828T1Gap L q) → ( + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let H := P4984T1ClosedGap L q + ∀ (z : ℂ), (z ∈ Metric.ball (p 0) (r 0)) → (z ∈ H)) := by + classical + intro L q hi p r H z hz + let P := P4909T1ParentPolygon L q + have hg : z ∈ P4828T1Gap L q := by + apply hi + simpa only [P4828T1Disk, Metric.mem_ball, p, r] using hz + change z ∈ P ∧ ∀ j : Fin 3, 0 < (q j.succ).1 → + 1 / ((q j.succ).1 : ℝ) ≤ dist z (p j.succ) + refine ⟨interior_subset hg.1, ?_⟩ + intro j hj + exact (hg.2 j hj).le + +private theorem makeChild : + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let child (b : Fin 3) := P4984T1ClosedGap L (s b) + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + let idx (b j : Fin 3) : Fin 4 := ![0, (b + 1).succ, (b + 2).succ] j + (∀ (b : Fin 3), ∀ (j : Fin 3), s b j.succ = q (idx b j)) → ((∀ (b : Fin 3), ∀ (j : Fin 3), + idx b j ≠ b.succ) → (∀ (b : Fin 3), ∀ (z : ℂ), (z ∈ F b) → ((r 0 ≤ dist z (p 0)) → ((∀ j + : Fin 3, 0 < (q j.succ).1 → + r j.succ ≤ dist z (p j.succ)) → (z ∈ child b))))) := by + classical + intro L q p r s child F idx parent idx_ne b z hzF hinsert hold + change z ∈ F b ∧ ∀ k : Fin 3, 0 < (s b k.succ).1 → + 1 / ((s b k.succ).1 : ℝ) ≤ + dist z (((s b k.succ).2 : ℂ) / ((s b k.succ).1 : ℝ)) + refine ⟨hzF, ?_⟩ + intro k hk + by_cases hzero : idx b k = 0 + · have hp : s b k.succ = q 0 := by rw [parent, hzero] + simpa only [hp, p, r] using hinsert + · obtain ⟨j, hj⟩ := Fin.exists_succ_eq.mpr hzero + have hjb : j ≠ b := by + intro he + subst j + exact idx_ne b k (by simp only [hj]) + have hp : s b k.succ = q j.succ := by rw [parent, hj] + have hjpos : 0 < (q j.succ).1 := by simpa only [hp] using hk + have hh := hold j hjpos + simpa only [hp, p, r] using hh + +private theorem hUnion : + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let H := P4984T1ClosedGap L q + let child (b : Fin 3) := P4984T1ClosedGap L (s b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + ((∀ b : Fin 3, F b ⊆ P ∧ (0 < (q b.succ).1 → p b.succ ∉ F b) ∧ frontier (F b) ⊆ + P4909T1ParentEdges L (s b)) ∧ (∀ b c : Fin 3, b ≠ c → Disjoint (interior (F b)) + (interior (F c))) ∧ P = ⋃ b : Fin 3, F b) → ((∀ (b : Fin 3), child b ⊆ H) → + ((Metric.closedBall (p 0) (r 0) ⊆ H) → ((∀ (b : Fin 3), ∀ (z : ℂ), (z ∈ F b) → ((r 0 ≤ + dist z (p 0)) → ((∀ j : Fin 3, 0 < (q j.succ).1 → r j.succ ≤ dist z (p j.succ)) → (z ∈ + child b)))) → ((∀ (z : ℂ), (z ∈ H) → (∀ j : Fin 3, 0 < (q j.succ).1 → r j.succ ≤ dist z + (p j.succ))) → (H = Metric.closedBall (p 0) (r 0) ∪ ⋃ b : Fin 3, child b))))) := by + classical + intro L q p r s H child P F fan childSubset closedBallSubset makeChild rootConstraints + apply Set.Subset.antisymm + · intro z hz + by_cases hball : z ∈ Metric.closedBall (p 0) (r 0) + · exact Set.mem_union_left _ hball + · have hzP : z ∈ P := by + change z ∈ P ∧ _ at hz + exact hz.1 + have hcover : z ∈ ⋃ b : Fin 3, F b := by rw [← fan.2.2]; exact hzP + obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hcover + have hnot : r 0 < dist z (p 0) := by + apply lt_of_not_ge + intro hle + exact hball (Metric.mem_closedBall.mpr (by simpa only [dist_comm] using hle)) + exact Set.mem_union_right _ (Set.mem_iUnion.mpr ⟨b, + makeChild b z hb hnot.le (rootConstraints z hz)⟩) + · intro z hz + have hz' : z ∈ Metric.closedBall (p 0) (r 0) ∨ z ∈ ⋃ b : Fin 3, child b := by + simpa only [Set.mem_union] using hz + rcases hz' with hball | hchildren + · exact closedBallSubset hball + · obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hchildren + exact childSubset b hb + +private theorem sphereSubset : + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let H := P4984T1ClosedGap L q + let child (b : Fin 3) := P4984T1ClosedGap L (s b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + ((∀ b : Fin 3, F b ⊆ P ∧ (0 < (q b.succ).1 → p b.succ ∉ F b) ∧ frontier (F b) ⊆ + P4909T1ParentEdges L (s b)) ∧ (∀ b c : Fin 3, b ≠ c → Disjoint (interior (F b)) + (interior (F c))) ∧ P = ⋃ b : Fin 3, F b) → ((Metric.closedBall (p 0) (r 0) ⊆ H) → ((∀ (b + : Fin 3), ∀ (z : ℂ), (z ∈ F b) → ((r 0 ≤ dist z (p 0)) → ((∀ j : Fin 3, 0 < (q j.succ).1 + → r j.succ ≤ dist z (p j.succ)) → (z ∈ child b)))) → ((∀ (z : ℂ), (z ∈ H) → (∀ j : Fin 3, + 0 < (q j.succ).1 → r j.succ ≤ dist z (p j.succ))) → (Metric.sphere (p 0) (r 0) ⊆ ⋃ b : + Fin 3, child b)))) := by + classical + intro L q p r s H child P F fan closedBallSubset makeChild rootConstraints z hz + have hdistSphere := Metric.mem_sphere.mp hz + have hzH : z ∈ H := closedBallSubset (Metric.mem_closedBall.mpr (by + simpa only [dist_comm] using hdistSphere.le)) + have hzP : z ∈ P := by + change z ∈ P ∧ _ at hzH + exact hzH.1 + have hcover : z ∈ ⋃ b : Fin 3, F b := by rw [← fan.2.2]; exact hzP + obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hcover + have hinsert : r 0 ≤ dist z (p 0) := by + simpa only [dist_comm] using hdistSphere.ge + exact Set.mem_iUnion.mpr ⟨b, makeChild b z hb hinsert (rootConstraints z hzH)⟩ + +end ClosedSubdivisionProof + +theorem P4984T1ClosedSubdivision (L : Real) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hs : P4828T1LineSupport L q) + (hi : P4828T1Disk (q 0) ⊆ P4828T1Gap L q) : + let H := P4984T1ClosedGap L q + let child (b : Fin 3) := + P4984T1ClosedGap L (P4828T1Step (P4828T1Rotate q b)) + let p : Complex := (q 0).2 / ((q 0).1 : Real) + let r : Real := 1 / ((q 0).1 : Real) + IsClosed H ∧ + (∀ b, child b ⊆ H) ∧ + H = Metric.closedBall p r ∪ ⋃ b, child b ∧ + Metric.sphere p r ⊆ ⋃ b, child b ∧ + (∀ b c, b ≠ c → interior (child b) ∩ interior (child c) = ∅) := by +-- BODY + classical + let complexNormedSpace : NormedSpace ℝ ℂ := by + refine ⟨fun a z => ?_⟩ + change ‖(a : ℂ) * z‖ ≤ ‖a‖ * ‖z‖ + have ha : ‖(a : ℂ)‖ = ‖a‖ := by norm_cast + rw [Complex.norm_mul, ha] + dsimp only + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) + let H := P4984T1ClosedGap L q + let child (b : Fin 3) := P4984T1ClosedGap L (s b) + let P := P4909T1ParentPolygon L q + let F (b : Fin 3) := P4909T1ParentPolygon L (s b) + have hcurv := ProperBandCurvatureStructure q hq + have hchildpos : 0 < (q 0).1 := hcurv.1 + have hparentsNonneg : ∀ i : Fin 3, 0 ≤ (q i.succ).1 := hcurv.2.1 + have hcenterIn : p 0 ∈ P4828T1Gap L q := by + have hball : p 0 ∈ P4828T1Disk (q 0) := by + change dist (((q 0).2 : ℂ) / ((q 0).1 : ℝ)) + (((q 0).2 : ℂ) / ((q 0).1 : ℝ)) < 1 / ((q 0).1 : ℝ) + rw [dist_self] + exact div_pos one_pos (by exact_mod_cast hchildpos) + exact hi hball + have hinside : p 0 ∈ interior P := hcenterIn.1 + have hzunique := hcurv.2.2 + have fan := ClosedSubdivisionProof.fan L q hs hchildpos hparentsNonneg hinside + hzunique + have polygonClosed (t : Fin 4 → CircleCoordinates) := ClosedSubdivisionProof.polygonClosed L t + have gapClosed (t : Fin 4 → CircleCoordinates) := ClosedSubdivisionProof.gapClosed L t + have hHclosed : IsClosed H := by + change IsClosed (P4984T1ClosedGap L q) + exact gapClosed q + have hchildClosed (b : Fin 3) : IsClosed (child b) := by + exact gapClosed (s b) + let idx (b j : Fin 3) : Fin 4 := ![0, (b + 1).succ, (b + 2).succ] j + have parent (b j : Fin 3) : s b j.succ = q (idx b j) := by + fin_cases b <;> fin_cases j <;> rfl + have idx_inj (b : Fin 3) : Function.Injective (idx b) := by + fin_cases b <;> decide + have idx_ne (b j : Fin 3) : idx b j ≠ b.succ := by + fin_cases b <;> fin_cases j <;> decide + have oldRetained (b j : Fin 3) (hjb : j ≠ b) : + ∃ k : Fin 3, idx b k = j.succ := by + clear * - b j hjb idx + fin_cases b <;> fin_cases j <;> simp_all? [idx] + all_goals first | exact ⟨1, rfl⟩ | exact ⟨2, rfl⟩ + have rpos (i : Fin 4) (hi : 0 < (q i).1) : 0 < r i := by + dsimp [r] + positivity + have support (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) := + ClosedSubdivisionProof.support L q hs k i hk hi + have footDist (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) := + ClosedSubdivisionProof.footDist L q rpos support k i hk hi + have footCover (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) := + ClosedSubdivisionProof.footCover L q footDist k i hk hi + have lineDist (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) + (z : ℂ) (hz : z.re = if (q k).2 = -1 then L else L + 2) := ClosedSubdivisionProof.lineDist + L q rpos support k i hk hi z hz + have hdist (t : Fin 4 → CircleCoordinates) (ht : SemiProperQuadruple t) + (i j : Fin 4) (hij : i ≠ j) (hi : 0 < (t i).1) (hj : 0 < (t j).1) := + ClosedSubdivisionProof.hdist t ht i j hij hi hj + have boundaryAvoid (b : Fin 3) (hb : 0 < (q b.succ).1) := ClosedSubdivisionProof.boundaryAvoid + L q hq fan parent idx_inj idx_ne footCover + lineDist hdist b hb + have omittedInterior (b : Fin 3) (hb : 0 < (q b.succ).1) : + ∀ z ∈ interior (F b), r b.succ < dist z (p b.succ) := by + apply P4909T1OmittedDiskBarrier (F b) (p b.succ) (r b.succ) + (rpos b.succ hb) ((fan.1 b).2.1 hb) + rw [Set.disjoint_left] + intro z hz hball + exact boundaryAvoid b hb z hz hball + have omittedClosed (b : Fin 3) (hb : 0 < (q b.succ).1) := ClosedSubdivisionProof.omittedClosed L q + boundaryAvoid omittedInterior b hb + have childSubset (b : Fin 3) := ClosedSubdivisionProof.childSubset L q fan parent + oldRetained omittedClosed b + have openBallSubset (z : ℂ) (hz : z ∈ Metric.ball (p 0) (r 0)) := + ClosedSubdivisionProof.openBallSubset L q hi z hz + have closedBallSubset : Metric.closedBall (p 0) (r 0) ⊆ H := by + intro z hz + have hopen : Metric.ball (p 0) (r 0) ⊆ H := fun w hw => openBallSubset w hw + have hzball : z ∈ closure (Metric.ball (p 0) (r 0)) := by + rw [closure_ball (p 0) (ne_of_gt (rpos 0 hchildpos))] + exact hz + have hzH : z ∈ closure H := closure_mono hopen hzball + rw [hHclosed.closure_eq] at hzH + exact hzH + have makeChild (b : Fin 3) (z : ℂ) (hzF : z ∈ F b) + (hinsert : r 0 ≤ dist z (p 0)) + (hold : ∀ j : Fin 3, 0 < (q j.succ).1 → + r j.succ ≤ dist z (p j.succ)) := ClosedSubdivisionProof.makeChild L q + parent idx_ne b z hzF hinsert hold + have rootConstraints (z : ℂ) (hz : z ∈ H) : + ∀ j : Fin 3, 0 < (q j.succ).1 → r j.succ ≤ dist z (p j.succ) := by + change z ∈ P ∧ ∀ j : Fin 3, 0 < (q j.succ).1 → + 1 / ((q j.succ).1 : ℝ) ≤ dist z (p j.succ) at hz + intro j hj + simpa only [r] using hz.2 j hj + have hUnion := ClosedSubdivisionProof.hUnion L q fan childSubset closedBallSubset makeChild + rootConstraints + have sphereSubset := ClosedSubdivisionProof.sphereSubset L q fan closedBallSubset makeChild + rootConstraints + have childPoly (b : Fin 3) : child b ⊆ F b := by + intro z hz + change z ∈ F b ∧ _ at hz + exact hz.1 + have disjointChildInterior (b c : Fin 3) (hbc : b ≠ c) : + interior (child b) ∩ interior (child c) = ∅ := by + exact Set.disjoint_iff_inter_eq_empty.mp + ((fan.2.1 b c hbc).mono (interior_mono (childPoly b)) + (interior_mono (childPoly c))) + exact ⟨hHclosed, childSubset, hUnion, sphereSubset, disjointChildInterior⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1ContactDiameter.lean b/LeanPool/ApollonianSuperharmonic/P4984T1ContactDiameter.lean new file mode 100644 index 0000000000..dfaf1735a9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4984T1ContactDiameter.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap +public import LeanPool.ApollonianSuperharmonic.P4828T1Gap +public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.P5023T1ContactHull +public import LeanPool.ApollonianSuperharmonic.P5023T1CircularSide +public import LeanPool.ApollonianSuperharmonic.P5023T1CircularEstimate +public import LeanPool.ApollonianSuperharmonic.P5023T1LineSideGeometry +public import LeanPool.ApollonianSuperharmonic.P5023T1LineEstimate +public import LeanPool.ApollonianSuperharmonic.P5023T1ConvexDiameter + +-- [TABLET NODE: P4984T1ContactDiameter] + +/-! +# P4984T1ContactDiameter + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4984T1ContactDiameter (L : Real) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hs : P4828T1LineSupport L q) + (hi : P4828T1Disk (q 0) ⊆ P4828T1Gap L q) : + Metric.diam (P4984T1ClosedGap L q) ≤ + 6 * Real.sqrt (1 / ((q 0).1 : Real)) := by +-- BODY + let p (k : Fin 4) : ℂ := (q k).2 / ((q k).1 : ℝ) + let r (k : Fin 4) : ℝ := 1 / ((q k).1 : ℝ) + let v := P5023T1ContactVertices L q + have curv := ProperBandCurvatureStructure q hq + have hR : 0 < r 0 := one_div_pos.mpr (by exact_mod_cast curv.1) + have radii (i : Fin 3) (hp : 0 < (q i.succ).1) : + 0 < r i.succ ∧ r 0 < r i.succ ∧ r i.succ ≤ 1 := by + have hpR : (0 : ℝ) < (q i.succ).1 := by exact_mod_cast hp + have hp1 : (1 : ℝ) ≤ (q i.succ).1 := by + exact_mod_cast (show (1 : ℤ) ≤ (q i.succ).1 by omega) + refine ⟨one_div_pos.mpr hpR, ?_, ?_⟩ + · exact one_div_lt_one_div_of_lt hpR (by exact_mod_cast hq.2 i) + · simpa only [one_div_one] using one_div_le_one_div_of_le (by norm_num) hp1 + have sides (i : Fin 3) : dist (v (i + 1)) (v (i + 2)) ≤ 4 * Real.sqrt (r 0) := by + by_cases hp : 0 < (q i.succ).1 + · exact (P5023T1CircularSide L q hq hs hi i hp).trans + (P5023T1CircularEstimate (r i.succ) (r 0) hR + (radii i hp).2.1 (radii i hp).2.2) + · have hz : (q i.succ).1 = 0 := by have hn := curv.2.1 i; omega + have other_pos (k : Fin 3) (hk : k ≠ i) : 0 < (q k.succ).1 := by + have hn := curv.2.1 k + by_contra hnp + have hkz : (q k.succ).1 = 0 := by omega + exact hk (curv.2.2 i k hz hkz).symm + have hj : 0 < (q (i + 1).succ).1 := + other_pos (i + 1) (by fin_cases i <;> decide) + have hk : 0 < (q (i + 2).succ).1 := + other_pos (i + 2) (by fin_cases i <;> decide) + rcases P5023T1LineSideGeometry L q hq hs hi i hz with ⟨ht, hu, hv, hd⟩ + calc + dist (v (i + 1)) (v (i + 2)) = + |(p (i + 1).succ).im - (p (i + 2).succ).im| := hd + _ ≤ 4 * Real.sqrt (r 0) := + (P5023T1LineEstimate (r 0) (r (i + 1).succ) (r (i + 2).succ) + (p 0).im (p (i + 1).succ).im (p (i + 2).succ).im hR.le + (radii (i + 1) hj).1.le (radii (i + 2) hk).1.le + (radii (i + 1) hj).2.2 (radii (i + 2) hk).2.2 ht hu hv).2 + have hD : 0 ≤ 4 * Real.sqrt (r 0) := by positivity + have pairs : ∀ i j : Fin 3, dist (v i) (v j) ≤ 4 * Real.sqrt (r 0) := by + have h01 : dist (v 0) (v 1) ≤ 4 * Real.sqrt (r 0) := by simpa using sides 2 + have h12 : dist (v 1) (v 2) ≤ 4 * Real.sqrt (r 0) := by simpa using sides 0 + have h20 : dist (v 2) (v 0) ≤ 4 * Real.sqrt (r 0) := by simpa using sides 1 + intro i j + fin_cases i <;> fin_cases j + · simpa only [dist_self] using hD + · exact h01 + · rw [dist_comm]; exact h20 + · rw [dist_comm]; exact h01 + · simpa only [dist_self] using hD + · exact h12 + · exact h20 + · rw [dist_comm]; exact h12 + · simpa only [dist_self] using hD + have hdiam := P5023T1ConvexDiameter v (P4984T1ClosedGap L q) + (4 * Real.sqrt (r 0)) hD (P5023T1ContactHull L q hq hs) pairs + calc + Metric.diam (P4984T1ClosedGap L q) ≤ 4 * Real.sqrt (r 0) := hdiam + _ ≤ 6 * Real.sqrt (1 / ((q 0).1 : ℝ)) := by + dsimp [r] + nlinarith [Real.sqrt_nonneg (1 / ((q 0).1 : ℝ))] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean b/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean new file mode 100644 index 0000000000..3f89bc7217 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean @@ -0,0 +1,846 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap +public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedSubdivision +public import LeanPool.ApollonianSuperharmonic.P4828T1Gap +public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport +public import LeanPool.ApollonianSuperharmonic.P4828T1ConstructorSupport +public import LeanPool.ApollonianSuperharmonic.P4828T1ParentsDistinct +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.P5050T1ParentSphereSection +public import LeanPool.ApollonianSuperharmonic.P5050T1OmittedHullSeparation + +-- [TABLET NODE: P4984T1IncidentArcs] + +/-! +# P4984T1IncidentArcs + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace IncidentArcGeometry + +private theorem circleDistance : + (by + classical + exact + ∀ (v : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple v → ∀ (i : Fin (4 : ℕ)), ∀ + (k : Fin (4 : ℕ)), i ≠ k → (0 : ℤ) < (v i).1 → (0 : ℤ) < (v k).1 → dist + ((GaussianInt.toComplex : GaussianInt → ℂ) (v i).2 / (↑(v i).1 : ℂ)) + ((GaussianInt.toComplex : GaussianInt → ℂ) (v k).2 / (↑(v k).1 : ℂ)) = (1 : ℝ) / (↑(v + i).1 : ℝ) + (1 : ℝ) / (↑(v k).1 : ℝ) ) := by + classical + intro v hv i k hik hi hk + let w : GaussianInt := (v k).1 • (v i).2 - (v i).1 • (v k).2 + have ht := TangencyCoordinateIdentity v hv.1 i k hik + have normCast (w : GaussianInt) : + Complex.normSq (w : Complex) = (Zsqrtd.norm w : Real) := by + simp [Complex.normSq, Zsqrtd.norm_def] + have hn : Complex.normSq (w : Complex) = + (((v i).1 + (v k).1 : ℤ)^2 : Real) := by + change Complex.normSq + (((v k).1 • (v i).2 - (v i).1 • (v k).2 : GaussianInt) : Complex) = _ + rw [normCast] + exact_mod_cast ht + have hnsq : ‖(w : Complex)‖ ^ 2 = + (((v i).1 + (v k).1 : ℤ) : Real) ^ 2 := by + rw [← Complex.normSq_eq_norm_sq, hn] + have hnorm : ‖(w : Complex)‖ = + (((v i).1 + (v k).1 : ℤ) : Real) := by + have hnonneg := norm_nonneg (w : Complex) + have hsum : 0 ≤ (((v i).1 + (v k).1 : ℤ) : Real) := by positivity + nlinarith + have hdiff : + ((v i).2 : Complex) / (v i).1 - ((v k).2 : Complex) / (v k).1 = + (w : Complex) / (((v i).1 * (v k).1 : ℤ) : Complex) := by + dsimp [w] + push_cast + simp only [map_sub, map_zsmul] + have hia : (v i).1 ≠ 0 := ne_of_gt hi + have hkb : (v k).1 ≠ 0 := ne_of_gt hk + field_simp [hia, hkb] + ring + rw [Complex.dist_eq, hdiff, Complex.norm_div, Complex.norm_intCast, hnorm] + have ha : 0 < ((v i).1 : Real) := by exact_mod_cast hi + have hb : 0 < ((v k).1 : Real) := by exact_mod_cast hk + have hab : 0 < (((v i).1 * (v k).1 : ℤ) : Real) := by + exact_mod_cast mul_pos hi hk + rw [abs_of_pos hab] + push_cast + field_simp [ne_of_gt ha, ne_of_gt hb] + ring + +private theorem hparentContactDistance : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (j : Fin 3), ((0 : ℤ) < + (q j.succ).1) → ((∀ (v : Fin 4 → CircleCoordinates), (ProperBandQuadruple v) → (∀ (i + : Fin 4), ∀ (k : Fin 4), (i ≠ k) → ((0 < (v i).1) → ((0 < (v k).1) → (dist (((v i).2 + : Complex) / (v i).1) (((v k).2 : Complex) / (v k).1) = 1 / (v i).1 + 1 / (v + k).1))))) → (dist (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)) (((q 0).2 : + Complex) / ((q 0).1 : Real)) = 1 / ((q j.succ).1 : Real) + 1 / ((q 0).1 : Real)))) ) + := by + classical + intro q hq j hj circleDistance + exact circleDistance q hq j.succ 0 (Fin.succ_ne_zero j) hj + (ProperBandCurvatureStructure q hq |>.1) + +private theorem hS : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ( + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let S := rad 0 + 0 < S) ) := by + classical + intro q hq rad S + dsimp [S, rad] + exact one_div_pos.mpr (by exact_mod_cast (ProperBandCurvatureStructure q hq).1) + +private theorem hαmul : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let R := rad j.succ + let S := rad 0 + (0 < R) → ((0 < S) → ( + let α := R / (R + S) + α * (R + S) = R)) ) := by + classical + intro q j rad R S hR hS α + dsimp [α] + exact div_mul_cancel₀ R (ne_of_gt (add_pos hR hS)) + +private theorem hcompmul : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let R := rad j.succ + let S := rad 0 + let α := R / (R + S) + (α * (R + S) = R) → ((1 - α) * (R + S) = S) ) := by + classical + intro q j rad R S α hαmul + rw [sub_mul, one_mul, hαmul] + ring + +private theorem hta : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let a := p j.succ + let x := p 0 + let R := rad j.succ + let S := rad 0 + let α := R / (R + S) + (0 < α) → ((α * (R + S) = R) → ( + let t := a + α • (x - a) + (‖x - a‖ = R + S) → (dist t a = R))) ) := by + classical + intro q j p rad a x R S α hα hαmul t hnormax + have hv : t - a = α • (x - a) := by simp [t] + have hd : dist t a = α * (R + S) := by + rw [dist_eq_norm, hv, Complex.real_smul, Complex.norm_mul, + Complex.norm_real, Real.norm_eq_abs, + abs_of_pos hα, hnormax] + rw [hd] + exact hαmul + +private theorem htx : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let a := p j.succ + let x := p 0 + let R := rad j.succ + let S := rad 0 + let α := R / (R + S) + (α < 1) → (((1 - α) * (R + S) = S) → ( + let t := a + α • (x - a) + (‖x - a‖ = R + S) → (dist t x = S))) ) := by + classical + intro q j p rad a x R S α hαlt hcompmul t hnormax + have hv : t - x = (1 - α) • (a - x) := by + apply Complex.ext + · simp [t] + ring + · simp [t] + ring + have hd : dist t x = (1 - α) * (R + S) := by + rw [dist_eq_norm, hv, Complex.real_smul, Complex.norm_mul, + Complex.norm_real, Real.norm_eq_abs, abs_of_pos (sub_pos.mpr hαlt)] + rw [← norm_sub_rev, hnormax] + rw [hd] + exact hcompmul + +private theorem hxDisk : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let x := p 0 + let S := rad 0 + (0 < S) → (x ∈ P4828T1Disk (q 0)) ) := by + classical + intro q p rad x S hS + change dist x x < S + simpa [x, p, S, rad, P4828T1Disk] using hS + +private theorem haPoly : + (by + classical + exact + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), ((0 : ℤ) < (q j.succ).1) → ( + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let a := p j.succ + a ∈ P4909T1ParentPolygon L q) ) := by + classical + intro L q j hj p a + change a ∈ convexHull Real {z | ∃ i : Fin 3, 0 < (q i.succ).1 ∧ + (z = p i.succ ∨ ∃ k : Fin 3, (q k.succ).1 = 0 ∧ + z = ⟨if (q k.succ).2 = -1 then L else L + 2, (p i.succ).im⟩)} + exact subset_convexHull Real _ ⟨j, hj, Or.inl rfl⟩ + +private theorem htseg : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let a := p j.succ + let x := p 0 + let R := rad j.succ + let S := rad 0 + let α := R / (R + S) + (0 < α) → ((α < 1) → ( + let t := a + α • (x - a) + t ∈ segment Real a x)) ) := by + classical + intro q j p rad a x R S α hα hαlt t + rw [segment_eq_image_lineMap] + refine ⟨α, ⟨le_of_lt hα, le_of_lt hαlt⟩, ?_⟩ + dsimp [t] + rw [AffineMap.lineMap_apply_module'] + simp [Complex.real_smul] + abel + +private theorem hfar : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (j : Fin 3), ((0 : ℤ) < + (q j.succ).1) → ((∀ (v : Fin 4 → CircleCoordinates), (ProperBandQuadruple v) → (∀ (i + : Fin 4), ∀ (k : Fin 4), (i ≠ k) → ((0 < (v i).1) → ((0 < (v k).1) → (dist (((v i).2 + : Complex) / (v i).1) (((v k).2 : Complex) / (v k).1) = 1 / (v i).1 + 1 / (v + k).1))))) → ( + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let a := p j.succ + let x := p 0 + let R := rad j.succ + let S := rad 0 + let α := R / (R + S) + let t := a + α • (x - a) + (dist t a = R) → (∀ (k : Fin (3 : ℕ)), (0 : ℤ) < (q k.succ).1 → rad k.succ ≤ dist t (p + k.succ))))) ) := by + classical + intro q hq j hj circleDistance p rad a x R S α t hta k hk + by_cases hkj : k = j + · subst k + simpa [rad, R, a, p] using (le_of_eq hta.symm) + · have hd := circleDistance q hq j.succ k.succ + (fun h => hkj (Fin.succ_inj.mp h).symm) hj hk + have htri := dist_triangle a t (p k.succ) + rw [dist_comm a t, hta] at htri + have hd' : dist a (p k.succ) = R + rad k.succ := by + simpa [a, R, rad, p] using hd + rw [hd'] at htri + linarith + +private theorem htGap : + (by + classical + exact + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let a := p j.succ + let x := p 0 + let R := rad j.succ + let S := rad 0 + let α := R / (R + S) + let t := a + α • (x - a) + (t ∈ P4909T1ParentPolygon L q) → ((∀ (k : Fin 3), (0 < (q k.succ).1) → (rad k.succ ≤ + dist t (p k.succ))) → (t ∈ P4984T1ClosedGap L q)) ) := by + classical + intro L q j p rad a x R S α t htPoly hfar + refine ⟨htPoly, ?_⟩ + intro k hk + exact hfar k hk + +private theorem htA : + (by + classical + exact + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let a := p j.succ + let x := p 0 + let R := rad j.succ + let S := rad 0 + let α := R / (R + S) + let t := a + α • (x - a) + (dist t a = R) → ((t ∈ P4984T1ClosedGap L q) → (t ∈ P4984T1ClosedGap L q ∩ + Metric.sphere a R)) ) := by + classical + intro L q j p rad a x R S α t hta htGap + refine ⟨htGap, Metric.mem_sphere.mpr ?_⟩ + simpa [dist_comm] using hta + +private theorem hVsub : + (by + classical + exact + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), ((0 : ℤ) < (q j.succ).1) → ( + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let foot (i k : Fin 3) : Complex := + ⟨if (q k.succ).2 = -1 then L else L + 2, (p i.succ).im⟩ + let V : Set Complex := {z | ∃ i : Fin 3, 0 < (q i.succ).1 ∧ + (z = p i.succ ∨ ∃ k : Fin 3, (q k.succ).1 = 0 ∧ z = foot i k)} + let f : Fin 3 × Fin 3 → Complex := fun ij => + if (q ij.2.succ).1 = 0 then foot ij.1 ij.2 else p ij.1.succ + V ⊆ Set.range f) ) := by + classical + intro L q j hj p foot V f + rintro z ⟨i, hi, rfl | ⟨k, hk, rfl⟩⟩ + · refine ⟨(i, j), ?_⟩ + simp [f, hj.ne'] + · exact ⟨(i, k), by simp [f, hk, foot]⟩ + +private theorem hParentClosed : + (by + classical + exact + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let foot (i k : Fin 3) : Complex := + ⟨if (q k.succ).2 = -1 then L else L + 2, (p i.succ).im⟩ + let V : Set Complex := {z | ∃ i : Fin 3, 0 < (q i.succ).1 ∧ + (z = p i.succ ∨ ∃ k : Fin 3, (q k.succ).1 = 0 ∧ z = foot i k)} + (V.Finite) → (IsClosed (P4909T1ParentPolygon L q)) ) := by + classical + intro L q p foot V hVfinite + change IsClosed (convexHull Real V) + exact hVfinite.isClosed_convexHull Real + +private theorem hClosedGap : + (by + classical + exact + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), ∀ [ IsClosed + (P4909T1ParentPolygon L q)], IsClosed (P4984T1ClosedGap L q) ) := by + classical + intro L q hParentClosed + change IsClosed (P4909T1ParentPolygon L q ∩ + {z | ∀ k : Fin 3, 0 < (q k.succ).1 → + 1 / ((q k.succ).1 : Real) ≤ + dist z (((q k.succ).2 : Complex) / ((q k.succ).1 : Real))}) + apply hParentClosed.inter + rw [Set.ofPred_forall] + apply isClosed_iInter + intro k + by_cases hk : 0 < (q k.succ).1 + · simp only [hk, true_implies] + exact isClosed_Ici.preimage + (continuous_id.dist continuous_const) + · simp [not_lt.mp hk] + +private theorem slot : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (b : Fin (3 : ℕ)), ∀ (k : Fin (3 : ℕ)), + P4828T1Step (P4828T1Rotate q b) k.succ = if k = (0 : Fin (3 : ℕ)) then q (0 : Fin + (4 : ℕ)) else q (k + b).succ ) := by + classical + intro q b k + fin_cases b <;> fin_cases k <;> rfl + +private theorem keep : + (by + classical + exact + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (j : Fin + 3), ((0 : ℤ) < (q j.succ).1) → ((dist (((q j.succ).2 : Complex) / ((q j.succ).1 : + Real)) (((q 0).2 : Complex) / ((q 0).1 : Real)) = 1 / ((q j.succ).1 : Real) + 1 / ((q + 0).1 : Real)) → ( + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let a := p j.succ + let x := p 0 + let R := rad j.succ + let S := rad 0 + (0 < R) → ((dist a x = R + S) → ( + let α := R / (R + S) + (0 < α) → ((α < 1) → ((α * (R + S) = R) → (((1 - α) * (R + S) = S) → ( + let t := a + α • (x - a) + (‖x - a‖ = R + S) → ((dist t a = R) → ((dist t x = S) → ((a ∈ P4909T1ParentPolygon L q) + → ((t ∈ segment Real a x) → ((t ∈ P4909T1ParentPolygon L q) → ((∀ (k : Fin 3), (0 < + (q k.succ).1) → (rad k.succ ≤ dist t (p k.succ))) → ((t ∈ P4984T1ClosedGap L q) → + ((t ∈ P4984T1ClosedGap L q ∩ Metric.sphere a R) → (∀ [ IsClosed + (P4984T1ClosedGap L q ∩ Metric.sphere a R)], ((P4984T1ClosedGap L q ∩ + Metric.sphere a R).Nonempty) → ((∀ (b : Fin 3), ∀ (k : Fin 3), P4828T1Step + (P4828T1Rotate q b) k.succ = if k = 0 then q 0 else q ((k + b).succ)) → (∀ (b : Fin + (3 : ℕ)), b ≠ j ↔ ∃ (k : Fin (3 : ℕ)), P4828T1Step (P4828T1Rotate q b) k.succ = q + j.succ)))))))))))))))))))) ) := by + classical + intro L q hq j hj hparentContactDistance p rad a x R S hR hax α hα hαlt hαmul hcompmul t + hnormax hta htx haPoly htseg htPoly hfar htGap htA hAclosed hANonempty slot b + constructor + · intro hb + fin_cases b <;> fin_cases j + all_goals norm_num at hb + all_goals first | exact ⟨1, rfl⟩ | exact ⟨2, rfl⟩ + · rintro ⟨k, hk⟩ hb + rw [slot] at hk + split_ifs at hk with hkzero + · have hroot : (q j.succ).1 < (q 0).1 := hq.2 j + have heq := congrArg Prod.fst hk + omega + · have hkj := (P4828T1ParentsDistinct q hq) hk + subst j + have : k = 0 := by + fin_cases k + · rfl + · fin_cases b <;> norm_num at hkj + · fin_cases b <;> norm_num at hkj + exact hkzero this + +private theorem closedGapOfParent : + (by + classical + exact + ∀ (L : Real), ∀ (u : Fin (4 : ℕ) → CircleCoordinates), ∀ (m : Fin (3 : ℕ)), (0 : ℤ) < (u + m.succ).1 → IsClosed (P4984T1ClosedGap L u) ) := by + classical + intro L u m hm + let pu (i : Fin 4) : Complex := (u i).2 / ((u i).1 : Real) + let fu (i k : Fin 3) : Complex := + ⟨if (u k.succ).2 = -1 then L else L + 2, (pu i.succ).im⟩ + let Vu : Set Complex := {z | ∃ i : Fin 3, 0 < (u i.succ).1 ∧ + (z = pu i.succ ∨ ∃ k : Fin 3, (u k.succ).1 = 0 ∧ z = fu i k)} + let gu : Fin 3 × Fin 3 → Complex := fun ik => + if (u ik.2.succ).1 = 0 then fu ik.1 ik.2 else pu ik.1.succ + have hsub : Vu ⊆ Set.range gu := by + rintro z ⟨i, hi, rfl | ⟨k, hk, rfl⟩⟩ + · exact ⟨(i, m), by simp [gu, hm.ne']⟩ + · exact ⟨(i, k), by simp [gu, hk, fu]⟩ + have hfinite : Vu.Finite := (Set.finite_range gu).subset hsub + have hpoly : IsClosed (P4909T1ParentPolygon L u) := by + change IsClosed (convexHull Real Vu) + exact hfinite.isClosed_convexHull Real + change IsClosed (P4909T1ParentPolygon L u ∩ + {z | ∀ k : Fin 3, 0 < (u k.succ).1 → + 1 / ((u k.succ).1 : Real) ≤ + dist z (((u k.succ).2 : Complex) / ((u k.succ).1 : Real))}) + apply hpoly.inter + rw [Set.ofPred_forall] + apply isClosed_iInter + intro k + by_cases hk : 0 < (u k.succ).1 + · simp only [hk, true_implies] + exact isClosed_Ici.preimage (continuous_id.dist continuous_const) + · simp [not_lt.mp hk] + +private theorem hchildCover : + (by + classical + exact + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → + ((P4828T1LineSupport L q) → ((P4828T1Disk (q (0 : Fin (4 : ℕ))) ⊆ P4828T1Gap L + q) → (∀ (j : Fin 3), + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let a := p j.succ + let x := p 0 + let R := rad j.succ + let S := rad 0 + (dist a x = R + S) → ( + let arc (b : Fin 3) := + P4984T1ClosedGap L (P4828T1Step (P4828T1Rotate q b)) ∩ + Metric.sphere a R + (P4984T1ClosedGap L q ∩ Metric.sphere a R) ⊆ ⋃ b : Fin 3, arc b)))) ) := by + classical + intro L q hq hs hi j p rad a x R S hax arc + have hsubdiv := P4984T1ClosedSubdivision L q hq hs hi + intro z hz + have hzUnion : z ∈ Metric.closedBall x S ∪ ⋃ b : Fin 3, + P4984T1ClosedGap L (P4828T1Step (P4828T1Rotate q b)) := by + rw [← hsubdiv.2.2.1] + exact hz.1 + rcases hzUnion with hzball | hzchildren + · have hza : dist a z = R := by + have hmem := Metric.mem_sphere.mp hz.2 + simpa only [dist_comm] using hmem + have htri := dist_triangle a z x + rw [hax, hza] at htri + have hzx : S ≤ dist z x := by linarith + have hrootSphere : z ∈ Metric.sphere x S := by + rw [Metric.mem_sphere] + exact le_antisymm (Metric.mem_closedBall.mp hzball) hzx + have hcovered := hsubdiv.2.2.2.1 hrootSphere + obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hcovered + exact Set.mem_iUnion.mpr ⟨b, hb, hz.2⟩ + · obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hzchildren + exact Set.mem_iUnion.mpr ⟨b, hb, hz.2⟩ + +private theorem hchildSub : + (by + classical + exact + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → + ((P4828T1LineSupport L q) → ((P4828T1Disk (q (0 : Fin (4 : ℕ))) ⊆ P4828T1Gap L + q) → (∀ (j : Fin 3), + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let a := p j.succ + let R := rad j.succ + let arc (b : Fin 3) := + P4984T1ClosedGap L (P4828T1Step (P4828T1Rotate q b)) ∩ + Metric.sphere a R + ∀ (b : Fin (3 : ℕ)), arc b ⊆ P4984T1ClosedGap L q ∩ Metric.sphere a R))) ) := by + classical + intro L q hq hs hi j p rad a R arc b + have hsubdiv := P4984T1ClosedSubdivision L q hq hs hi + intro z hz + exact ⟨hsubdiv.2.1 b hz.1, hz.2⟩ + +private theorem hAllUnion : + (by + classical + exact + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let a := p j.succ + let R := rad j.succ + let arc (b : Fin 3) := + P4984T1ClosedGap L (P4828T1Step (P4828T1Rotate q b)) ∩ + Metric.sphere a R + ((P4984T1ClosedGap L q ∩ Metric.sphere a R) ⊆ ⋃ b : Fin 3, arc b) → ((∀ (b : Fin 3), + arc b ⊆ P4984T1ClosedGap L q ∩ Metric.sphere a R) → (P4984T1ClosedGap L q ∩ + Metric.sphere a R = ⋃ b : Fin 3, arc b)) ) := by + classical + intro L q j p rad a R arc hchildCover hchildSub + apply Set.Subset.antisymm + · exact hchildCover + · intro z hz + obtain ⟨b, hb⟩ := Set.mem_iUnion.mp hz + exact hchildSub b hb + +private theorem hNotretaining : + (by + classical + exact + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → + ((P4828T1LineSupport L q) → (∀ (j : Fin 3), ((0 : ℤ) < (q j.succ).1) → ( + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let a := p j.succ + let R := rad j.succ + let arc (b : Fin 3) := + P4984T1ClosedGap L (P4828T1Step (P4828T1Rotate q b)) ∩ + Metric.sphere a R + arc j = ∅))) ) := by + classical + intro L q hq hs j hj p rad a R arc + obtain ⟨D, _, hsphere, hhull⟩ := + P5050T1OmittedHullSeparation L q hq hs j hj + ext z + simp only [Set.mem_empty_iff_false, iff_false] + intro hz + exact (not_lt_of_ge (hsphere z hz.2)) (hhull z hz.1.1) + +private theorem hEraseUnion : + (by + classical + exact + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let a := p j.succ + let R := rad j.succ + let arc (b : Fin 3) := + P4984T1ClosedGap L (P4828T1Step (P4828T1Rotate q b)) ∩ + Metric.sphere a R + (arc j = ∅) → ((⋃ b ∈ Finset.univ.erase j, arc b) = ⋃ b : Fin 3, arc b) ) := by + classical + intro L q j p rad a R arc hNotretaining + ext z + simp only [Set.mem_iUnion, Finset.mem_erase, Finset.mem_univ, and_true] + constructor + · rintro ⟨b, hb, hz⟩ + exact ⟨b, hz⟩ + · rintro ⟨b, hz⟩ + by_cases hb : b = j + · subst b + rw [hNotretaining] at hz + simp at hz + · exact ⟨b, hb, hz⟩ + +private theorem hchildArcClosed : + (by + classical + exact + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), ((0 : ℤ) < (q j.succ).1) → ( + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let a := p j.succ + let R := rad j.succ + (∀ (b : Fin 3), (b ≠ j ↔ ∃ k : Fin 3, P4828T1Step (P4828T1Rotate q b) k.succ = q + j.succ)) → ((∀ (u : Fin 4 → CircleCoordinates), ∀ (m : Fin 3), (0 < (u m.succ).1) → + (IsClosed (P4984T1ClosedGap L u))) → ( + let arc (b : Fin 3) := + P4984T1ClosedGap L (P4828T1Step (P4828T1Rotate q b)) ∩ + Metric.sphere a R + ∀ (b : Fin (3 : ℕ)), b ≠ j → IsClosed (arc b)))) ) := by + classical + intro L q j hj p rad a R keep closedGapOfParent arc b hb + obtain ⟨k, hk⟩ := (keep b).mp hb + have hkpos : 0 < (P4828T1Step (P4828T1Rotate q b) k.succ).1 := by + rw [hk] + exact hj + exact (closedGapOfParent _ k hkpos).inter Metric.isClosed_sphere + +private theorem hchildArcContains : + (by + classical + exact + ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (j : Fin + 3), ((0 : ℤ) < (q j.succ).1) → ( + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let a := p j.succ + let x := p 0 + let R := rad j.succ + let S := rad 0 + let α := R / (R + S) + let t := a + α • (x - a) + (dist t a = R) → ((dist t x = S) → ((t ∈ segment Real a x) → ((∀ (k : Fin 3), (0 < (q + k.succ).1) → (rad k.succ ≤ dist t (p k.succ))) → ((∀ (b : Fin 3), ∀ (k : Fin 3), + P4828T1Step (P4828T1Rotate q b) k.succ = if k = 0 then q 0 else q ((k + b).succ)) + → ((∀ (b : Fin 3), (b ≠ j ↔ ∃ k : Fin 3, P4828T1Step (P4828T1Rotate q b) k.succ = + q j.succ)) → ( + let arc (b : Fin 3) := + P4984T1ClosedGap L (P4828T1Step (P4828T1Rotate q b)) ∩ + Metric.sphere a R + ∀ (b : Fin (3 : ℕ)), b ≠ j → t ∈ arc b)))))))) ) := by + classical + intro L q hq j hj p rad a x R S α t hta htx htseg hfar slot keep arc b hb + let u := P4828T1Step (P4828T1Rotate q b) + obtain ⟨k, hk⟩ := (keep b).mp hb + have hroot : 0 < (q 0).1 := (ProperBandCurvatureStructure q hq).1 + have hslot0 : u (0 : Fin 3).succ = q 0 := by + simpa [u] using slot b 0 + have hslotk : u k.succ = q j.succ := by simpa [u] using hk + have hxchild : x ∈ P4909T1ParentPolygon L u := by + change x ∈ convexHull Real {z | ∃ i : Fin 3, 0 < (u i.succ).1 ∧ + (z = ((u i.succ).2 : Complex) / ((u i.succ).1 : Real) ∨ + ∃ l : Fin 3, (u l.succ).1 = 0 ∧ + z = ⟨if (u l.succ).2 = -1 then L else L + 2, + (((u i.succ).2 : Complex) / ((u i.succ).1 : Real)).im⟩)} + apply subset_convexHull Real _ + refine ⟨0, ?_, Or.inl ?_⟩ + · rw [hslot0] + exact hroot + · rw [hslot0] + have hacenter : a = ((u k.succ).2 : Complex) / ((u k.succ).1 : Real) := by + rw [hslotk] + have hapos : 0 < (u k.succ).1 := by rw [hslotk]; exact hj + have hacChild : a ∈ P4909T1ParentPolygon L u := by + change a ∈ convexHull Real {z | ∃ i : Fin 3, 0 < (u i.succ).1 ∧ + (z = ((u i.succ).2 : Complex) / ((u i.succ).1 : Real) ∨ + ∃ l : Fin 3, (u l.succ).1 = 0 ∧ + z = ⟨if (u l.succ).2 = -1 then L else L + 2, + (((u i.succ).2 : Complex) / ((u i.succ).1 : Real)).im⟩)} + exact subset_convexHull Real _ ⟨k, hapos, Or.inl hacenter⟩ + have htChildPoly : t ∈ P4909T1ParentPolygon L u := + (convex_convexHull Real _).segment_subset hacChild hxchild htseg + have hslotOld (i : Fin 3) (hi : i ≠ 0) : u i.succ = q ((i + b).succ) := by + dsimp [u] + rw [slot] + simp [hi] + have hparentLower (i : Fin 3) (hcurv : 0 < (u i.succ).1) : + 1 / ((u i.succ).1 : Real) ≤ + dist t (((u i.succ).2 : Complex) / ((u i.succ).1 : Real)) := by + by_cases hi : i = 0 + · subst i + rw [hslot0] at hcurv ⊢ + simpa [S, rad, p, x] using (le_of_eq htx.symm) + · have hslt := hslotOld i hi + have hpos : 0 < (q (i + b).succ).1 := by rw [← hslt]; exact hcurv + have hbound := hfar (i + b) hpos + simpa [hslt, p, rad] using hbound + have htChildGap : t ∈ P4984T1ClosedGap L u := by + refine ⟨htChildPoly, ?_⟩ + intro i hi + exact hparentLower i hi + have htChildArc : t ∈ P4984T1ClosedGap L u ∩ Metric.sphere a R := by + refine ⟨htChildGap, Metric.mem_sphere.mpr ?_⟩ + simpa [dist_comm] using hta + simpa [arc, u] using htChildArc + +private theorem hposAt481 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), ((0 : ℤ) < (q j.succ).1) → (∀ (b : Fin + (3 : ℕ)), ∀ (k : Fin (3 : ℕ)), (P4828T1Step (P4828T1Rotate q b) k.succ = q + j.succ) → (0 < (P4828T1Step (P4828T1Rotate q b) k.succ).1)) ) := by + classical + intro q j hj b k hk + rw [hk] + exact hj + +end IncidentArcGeometry + +theorem P4984T1IncidentArcs (L : Real) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hs : P4828T1LineSupport L q) + (hi : P4828T1Disk (q 0) ⊆ P4828T1Gap L q) + (j : Fin 3) (hj : 0 < (q j.succ).1) : + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let r (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let A := P4984T1ClosedGap L q ∩ Metric.sphere (p j.succ) (r j.succ) + let arc (b : Fin 3) := + P4984T1ClosedGap L (P4828T1Step (P4828T1Rotate q b)) ∩ + Metric.sphere (p j.succ) (r j.succ) + IsClosed A ∧ IsPreconnected A ∧ A.Nonempty ∧ + (∀ b : Fin 3, b ≠ j ↔ + ∃ k : Fin 3, P4828T1Step (P4828T1Rotate q b) k.succ = q j.succ) ∧ + ∃ t : Complex, + A = ⋃ b ∈ (Finset.univ.erase j), arc b ∧ + (∀ b ∈ (Finset.univ.erase j), + IsClosed (arc b) ∧ IsPreconnected (arc b) ∧ t ∈ arc b) ∧ + dist t (p j.succ) = r j.succ ∧ + dist t (p 0) = r 0 ∧ + dist (p j.succ) (p 0) = r j.succ + r 0 := by +-- BODY + classical + have circleDistance (v : Fin 4 → CircleCoordinates) + (hv : ProperBandQuadruple v) (i k : Fin 4) (hik : i ≠ k) + (hi : 0 < (v i).1) (hk : 0 < (v k).1) := IncidentArcGeometry.circleDistance v hv i k hik hi hk + have hparentContactDistance : + dist (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)) + (((q 0).2 : Complex) / ((q 0).1 : Real)) = + 1 / ((q j.succ).1 : Real) + 1 / ((q 0).1 : Real) := + IncidentArcGeometry.hparentContactDistance q hq j hj circleDistance + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) + let a := p j.succ + let x := p 0 + let R := rad j.succ + let S := rad 0 + have hR : 0 < R := by dsimp [R, rad]; exact one_div_pos.mpr (by exact_mod_cast hj) + have hS := IncidentArcGeometry.hS q hq + have hax : dist a x = R + S := by + simpa [a, x, p, R, S, rad] using hparentContactDistance + let α := R / (R + S) + have hα : 0 < α := div_pos hR (add_pos hR hS) + have hαlt : α < 1 := (div_lt_one (add_pos hR hS)).2 (by linarith) + have hαmul := IncidentArcGeometry.hαmul q j hR hS + have hcompmul := IncidentArcGeometry.hcompmul q j hαmul + let t := a + α • (x - a) + have hnormax : ‖x - a‖ = R + S := by + simpa [dist_eq_norm, norm_sub_rev] using hax + have hta := IncidentArcGeometry.hta q j hα hαmul hnormax + have htx := IncidentArcGeometry.htx q j hαlt hcompmul hnormax + have hxDisk := IncidentArcGeometry.hxDisk q hS + have hxGap := hi hxDisk + have hxPoly : x ∈ P4909T1ParentPolygon L q := + interior_subset (by simpa [P4828T1Gap, x, p] using hxGap.1) + have haPoly := IncidentArcGeometry.haPoly L q j hj + have htseg := IncidentArcGeometry.htseg q j hα hαlt + have htPoly : t ∈ P4909T1ParentPolygon L q := + (convex_convexHull Real _).segment_subset haPoly hxPoly htseg + have hfar (k : Fin 3) (hk : 0 < (q k.succ).1) := IncidentArcGeometry.hfar q hq j hj + circleDistance hta k hk + have htGap := IncidentArcGeometry.htGap L q j htPoly hfar + have htA := IncidentArcGeometry.htA L q j hta htGap + let foot (i k : Fin 3) : Complex := + ⟨if (q k.succ).2 = -1 then L else L + 2, (p i.succ).im⟩ + let V : Set Complex := {z | ∃ i : Fin 3, 0 < (q i.succ).1 ∧ + (z = p i.succ ∨ ∃ k : Fin 3, (q k.succ).1 = 0 ∧ z = foot i k)} + let f : Fin 3 × Fin 3 → Complex := fun ij => + if (q ij.2.succ).1 = 0 then foot ij.1 ij.2 else p ij.1.succ + have hVsub := IncidentArcGeometry.hVsub L q j hj + have hVfinite : V.Finite := (Set.finite_range f).subset hVsub + have hParentClosed := IncidentArcGeometry.hParentClosed L q hVfinite + have hClosedGap := @IncidentArcGeometry.hClosedGap L q hParentClosed + have hAclosed : IsClosed (P4984T1ClosedGap L q ∩ Metric.sphere a R) := + hClosedGap.inter Metric.isClosed_sphere + have hANonempty : (P4984T1ClosedGap L q ∩ Metric.sphere a R).Nonempty := + ⟨t, htA⟩ + have slot (b k : Fin 3) := IncidentArcGeometry.slot q b k + have keep (b : Fin 3) := @IncidentArcGeometry.keep L q hq j hj hparentContactDistance hR hax hα + hαlt hαmul hcompmul hnormax hta htx haPoly htseg htPoly hfar htGap htA hAclosed hANonempty + slot b + have closedGapOfParent (u : Fin 4 → CircleCoordinates) (m : Fin 3) + (hm : 0 < (u m.succ).1) := IncidentArcGeometry.closedGapOfParent L u m hm + let arc (b : Fin 3) := + P4984T1ClosedGap L (P4828T1Step (P4828T1Rotate q b)) ∩ + Metric.sphere a R + have hchildCover := IncidentArcGeometry.hchildCover L q hq hs hi j hax + have hchildSub (b : Fin 3) := IncidentArcGeometry.hchildSub L q hq hs hi j b + have hAllUnion := IncidentArcGeometry.hAllUnion L q j hchildCover hchildSub + have hNotretaining := IncidentArcGeometry.hNotretaining L q hq hs j hj + have hEraseUnion := IncidentArcGeometry.hEraseUnion L q j hNotretaining + have hchildArcClosed (b : Fin 3) (hb : b ≠ j) := IncidentArcGeometry.hchildArcClosed L q j hj + keep closedGapOfParent b hb + have hchildArcContains (b : Fin 3) (hb : b ≠ j) := IncidentArcGeometry.hchildArcContains L q hq + j hj hta htx htseg hfar slot keep b hb + dsimp only + refine ⟨hAclosed, ?_, hANonempty, keep, t, ?_, ?_, ?_, ?_⟩ + · exact P5050T1ParentSphereSection L q hq hs j hj + · exact hAllUnion.trans hEraseUnion.symm + · intro b hb + have hb' : b ≠ j := (Finset.mem_erase.mp hb).1 + refine ⟨hchildArcClosed b hb', ?_, hchildArcContains b hb'⟩ + obtain ⟨k, hk⟩ := (keep b).mp hb' + have hpos := IncidentArcGeometry.hposAt481 q j hj b k hk + obtain ⟨hproper, hsupport⟩ := P4828T1ConstructorSupport L q hq hs b + have hc := P5050T1ParentSphereSection L _ hproper hsupport k hpos + rw [hk] at hc + exact hc + · exact hta + · exact ⟨htx, hparentContactDistance⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1RootGaps.lean b/LeanPool/ApollonianSuperharmonic/P4984T1RootGaps.lean new file mode 100644 index 0000000000..d8a2294d09 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4984T1RootGaps.lean @@ -0,0 +1,436 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap +public import LeanPool.ApollonianSuperharmonic.P4828T1Root +public import LeanPool.ApollonianSuperharmonic.BandPackingExterior +public import LeanPool.ApollonianSuperharmonic.P4953T1LiteralHulls +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Basic.Complex.BigOperators + +-- [TABLET NODE: P4984T1RootGaps] + +/-! +# P4984T1RootGaps + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RootGapLemmas + +private theorem rectHull : + ∀ (u : ℝ), ∀ (v : ℝ), convexHull ℝ (Set.range (fun i : Fin 4 => + ![⟨u, v⟩, ⟨u + 1, v⟩, ⟨u, v + 2⟩, ⟨u + 1, v + 2⟩] i)) = + {z : ℂ | u ≤ z.re ∧ z.re ≤ u + 1 ∧ v ≤ z.im ∧ z.im ≤ v + 2} := by + classical + intro u v + let c : Fin 4 → ℂ := ![⟨u, v⟩, ⟨u + 1, v⟩, ⟨u, v + 2⟩, ⟨u + 1, v + 2⟩] + change convexHull ℝ (Set.range c) = _ + ext z + constructor + · intro hz + rw [mem_convexHull_iff_exists_fintype] at hz + rcases hz with ⟨ι, _, w, p, hw, hsum, hp, heq⟩ + let : Fintype ι := inferInstance + have hcoords (i : ι) : u ≤ (p i).re ∧ (p i).re ≤ u + 1 ∧ + v ≤ (p i).im ∧ (p i).im ≤ v + 2 := by + obtain ⟨j, hj⟩ := hp i + rw [← hj] + fin_cases j <;> simp [c] + have hre : (∑ i, w i * (p i).re) = z.re := by + have h := congrArg Complex.re heq + simpa only [Complex.re_sum, Complex.smul_re, smul_eq_mul] using h + have him : (∑ i, w i * (p i).im) = z.im := by + have h := congrArg Complex.im heq + simpa only [Complex.im_sum, Complex.smul_im, smul_eq_mul] using h + constructor + · calc + u = u * (∑ i, w i) := by rw [hsum]; ring + _ = ∑ i, w i * u := by + calc + _ = ∑ i, u * w i := by rw [Finset.mul_sum] + _ = ∑ i, w i * u := by apply Finset.sum_congr rfl; intro i hi; ring + _ ≤ ∑ i, w i * (p i).re := by + apply Finset.sum_le_sum (s := Finset.univ) + intro i hi + exact mul_le_mul_of_nonneg_left (hcoords i).1 (hw i) + _ = z.re := hre + constructor + · calc + z.re = ∑ i, w i * (p i).re := hre.symm + _ ≤ ∑ i, w i * (u + 1) := by + apply Finset.sum_le_sum (s := Finset.univ) + intro i hi + exact mul_le_mul_of_nonneg_left (hcoords i).2.1 (hw i) + _ = (u + 1) * (∑ i, w i) := by + calc + _ = ∑ i, (u + 1) * w i := by + apply Finset.sum_congr rfl + intro i hi + ring + _ = (u + 1) * ∑ i, w i := by rw [Finset.mul_sum] + _ = u + 1 := by rw [hsum]; ring + constructor + · calc + v = v * (∑ i, w i) := by rw [hsum]; ring + _ = ∑ i, w i * v := by + calc + _ = ∑ i, v * w i := by rw [Finset.mul_sum] + _ = ∑ i, w i * v := by apply Finset.sum_congr rfl; intro i hi; ring + _ ≤ ∑ i, w i * (p i).im := by + apply Finset.sum_le_sum (s := Finset.univ) + intro i hi + exact mul_le_mul_of_nonneg_left (hcoords i).2.2.1 (hw i) + _ = z.im := him + · calc + z.im = ∑ i, w i * (p i).im := him.symm + _ ≤ ∑ i, w i * (v + 2) := by + apply Finset.sum_le_sum (s := Finset.univ) + intro i hi + exact mul_le_mul_of_nonneg_left (hcoords i).2.2.2 (hw i) + _ = (v + 2) * (∑ i, w i) := by + calc + _ = ∑ i, (v + 2) * w i := by + apply Finset.sum_congr rfl + intro i hi + ring + _ = (v + 2) * ∑ i, w i := by rw [Finset.mul_sum] + _ = v + 2 := by rw [hsum]; ring + · rintro ⟨hxl, hxu, hyl, hyu⟩ + let s : ℝ := z.re - u + let t : ℝ := (z.im - v) / 2 + let w : Fin 4 → ℝ := ![(1 - s) * (1 - t), s * (1 - t), (1 - s) * t, s * t] + have hs0 : 0 ≤ s := by dsimp [s]; linarith + have hs1 : s ≤ 1 := by dsimp [s]; linarith + have ht0 : 0 ≤ t := by dsimp [t]; linarith + have ht1 : t ≤ 1 := by change (z.im - v) / 2 ≤ 1; linarith + have hw : ∀ i, 0 ≤ w i := by + intro i + fin_cases i <;> simp? [w] <;> positivity + have hsum : (∑ i : Fin 4, w i) = 1 := by + simp [Fin.sum_univ_succ, w]; ring + have heq : (∑ i : Fin 4, w i • c i) = z := by + apply Complex.ext <;> simp [c, w, s, t, Fin.sum_univ_succ, + ] <;> ring + exact mem_convexHull_of_exists_fintype w c hw hsum + (by intro i; exact ⟨i, rfl⟩) heq + +private theorem hpolyMinus : + ∀ (a : GaussianInt), P4909T1ParentPolygon (2 * (a.re : ℝ)) (P4828T1Root a false) = + convexHull ℝ (Set.range (fun i : Fin 4 => + ![⟨2 * (a.re : ℝ), 2 * (a.im : ℝ)⟩, + ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ)⟩, + ⟨2 * (a.re : ℝ), 2 * (a.im : ℝ) + 2⟩, + ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ) + 2⟩] i)) := by + classical + intro a + have h2 : GaussianInt.toComplex 2 = (2 : ℂ) := by + rw [GaussianInt.toComplex_def₂] + apply Complex.ext <;> norm_num + have haRe : (GaussianInt.toComplex a).re = (a.re : ℝ) := + (GaussianInt.intCast_re a).symm + have haIm : (GaussianInt.toComplex a).im = (a.im : ℝ) := + (GaussianInt.intCast_im a).symm + have hA : 1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a = + ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ)⟩ := by + rw [h2, GaussianInt.toComplex_def₂ a] + apply Complex.ext <;> simp; ring + have hI : GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt) = Complex.I := by + rw [GaussianInt.toComplex_def₂] + apply Complex.ext <;> simp + have hB : 1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a + + GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt) = + ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ) + 2⟩ := by + rw [h2, GaussianInt.toComplex_def₂ a, hI] + apply Complex.ext <;> simp; ring + have hA' : 1 + 2 * (a : ℂ) = + ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ)⟩ := by + simpa [h2] using hA + have hB' : 1 + 2 * (a : ℂ) + 2 * Complex.I = + ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ) + 2⟩ := by + simpa [h2, hI] using hB + apply congrArg (convexHull ℝ) + ext z + simp [P4828T1Root, Fin.exists_fin_succ] + simp only [h2, hI, hA'] + simp only [Complex.ext_iff, Complex.add_re, Complex.add_im, Complex.mul_re, + Complex.mul_im, Complex.I_re, Complex.I_im, haRe, haIm] + all_goals norm_num; ring_nf; tauto + +private theorem hpolyPlus : + ∀ (a : GaussianInt), P4909T1ParentPolygon (2 * (a.re : ℝ)) (P4828T1Root a true) = + convexHull ℝ (Set.range (fun i : Fin 4 => + ![⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ)⟩, + ⟨(2 * (a.re : ℝ) + 1) + 1, 2 * (a.im : ℝ)⟩, + ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ) + 2⟩, + ⟨(2 * (a.re : ℝ) + 1) + 1, 2 * (a.im : ℝ) + 2⟩] i)) := by + classical + intro a + have h2 : GaussianInt.toComplex 2 = (2 : ℂ) := by + rw [GaussianInt.toComplex_def₂] + apply Complex.ext <;> norm_num + have haRe : (GaussianInt.toComplex a).re = (a.re : ℝ) := + (GaussianInt.intCast_re a).symm + have haIm : (GaussianInt.toComplex a).im = (a.im : ℝ) := + (GaussianInt.intCast_im a).symm + have hA : 1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a = + ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ)⟩ := by + rw [h2, GaussianInt.toComplex_def₂ a] + apply Complex.ext <;> simp; ring + have hI : GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt) = Complex.I := by + rw [GaussianInt.toComplex_def₂] + apply Complex.ext <;> simp + have hB : 1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a + + GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt) = + ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ) + 2⟩ := by + rw [h2, GaussianInt.toComplex_def₂ a, hI] + apply Complex.ext <;> simp; ring + have hA' : 1 + 2 * (a : ℂ) = + ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ)⟩ := by + simpa [h2] using hA + have hB' : 1 + 2 * (a : ℂ) + 2 * Complex.I = + ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ) + 2⟩ := by + simpa [h2, hI] using hB + apply congrArg (convexHull ℝ) + ext z + simp [P4828T1Root, Fin.exists_fin_succ] + simp only [h2, hI, hA'] + simp only [Complex.ext_iff, Complex.add_re, Complex.add_im, Complex.mul_re, + Complex.mul_im, Complex.I_re, Complex.I_im, haRe, haIm] + all_goals norm_num; ring_nf; tauto + +private theorem hdistMinus : + ∀ (a : GaussianInt), ∀ (z : ℂ), (∀ j : Fin 3, 0 < (P4828T1Root a false j.succ).1 → + (1 / ((P4828T1Root a false j.succ).1 : ℝ)) ≤ + dist z ((P4828T1Root a false j.succ).2 / + ((P4828T1Root a false j.succ).1 : ℝ))) ↔ + 1 ≤ dist z ((1 + 2 * a : GaussianInt) : ℂ) ∧ + 1 ≤ dist z ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : ℂ) := by + classical + intro a z + constructor + · intro hd + constructor + · have h := hd 0 (by simp [P4828T1Root]) + simpa [P4828T1Root] using h + · have h := hd 2 (by simp [P4828T1Root]) + simpa [P4828T1Root] using h + · rintro ⟨h₁, h₂⟩ j hj + fin_cases j + · simpa [P4828T1Root] using h₁ + · simp [P4828T1Root] at hj + · simpa [P4828T1Root] using h₂ + +private theorem hdistPlus : + ∀ (a : GaussianInt), ∀ (z : ℂ), (∀ j : Fin 3, 0 < (P4828T1Root a true j.succ).1 → + (1 / ((P4828T1Root a true j.succ).1 : ℝ)) ≤ + dist z ((P4828T1Root a true j.succ).2 / + ((P4828T1Root a true j.succ).1 : ℝ))) ↔ + 1 ≤ dist z ((1 + 2 * a : GaussianInt) : ℂ) ∧ + 1 ≤ dist z ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : ℂ) := by + classical + intro a z + constructor + · intro hd + constructor + · have h := hd 0 (by simp [P4828T1Root]) + simpa [P4828T1Root] using h + · have h := hd 1 (by simp [P4828T1Root]) + simpa [P4828T1Root] using h + · rintro ⟨h₁, h₂⟩ j hj + fin_cases j + · simpa [P4828T1Root] using h₁ + · simpa [P4828T1Root] using h₂ + · simp [P4828T1Root] at hj + +private theorem hminusChar : + (∀ (u : ℝ), ∀ (v : ℝ), convexHull ℝ (Set.range (fun i : Fin 4 => ![⟨u, v⟩, ⟨u + 1, v⟩, ⟨u, v + + 2⟩, ⟨u + 1, v + 2⟩] i)) = {z : ℂ | u ≤ z.re ∧ z.re ≤ u + 1 ∧ v ≤ z.im ∧ z.im ≤ v + 2}) + → (∀ (a : GaussianInt), P4909T1ParentPolygon (2 * (a.re : ℝ)) (P4828T1Root a false) = + convexHull ℝ (Set.range (fun i : Fin 4 => ![⟨2 * (a.re : ℝ), 2 * (a.im : ℝ)⟩, ⟨2 * (a.re + : ℝ) + 1, 2 * (a.im : ℝ)⟩, ⟨2 * (a.re : ℝ), 2 * (a.im : ℝ) + 2⟩, ⟨2 * (a.re : ℝ) + 1, 2 * + (a.im : ℝ) + 2⟩] i))) → (∀ (a : GaussianInt), ∀ (z : ℂ), (∀ j : Fin 3, 0 < (P4828T1Root + a false j.succ).1 → (1 / ((P4828T1Root a false j.succ).1 : ℝ)) ≤ dist z ((P4828T1Root + a false j.succ).2 / ((P4828T1Root a false j.succ).1 : ℝ))) ↔ 1 ≤ dist z ((1 + 2 * a : + GaussianInt) : ℂ) ∧ 1 ≤ dist z ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : ℂ)) → ∀ (a : + GaussianInt), ∀ (z : ℂ), z ∈ P4984T1ClosedGap (2 * (a.re : ℝ)) (P4828T1Root a false) ↔ + 2 * (a.re : ℝ) ≤ z.re ∧ z.re ≤ 2 * (a.re : ℝ) + 1 ∧ + 2 * (a.im : ℝ) ≤ z.im ∧ z.im ≤ 2 * (a.im : ℝ) + 2 ∧ + 1 ≤ dist z ((1 + 2 * a : GaussianInt) : ℂ) ∧ + 1 ≤ dist z ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : ℂ) := by + classical + intro rectHull hpolyMinus hdistMinus a z + change (z ∈ P4909T1ParentPolygon (2 * (a.re : ℝ)) (P4828T1Root a false) ∧ + ∀ j : Fin 3, 0 < (P4828T1Root a false j.succ).1 → + (1 / ((P4828T1Root a false j.succ).1 : ℝ)) ≤ + dist z ((P4828T1Root a false j.succ).2 / + ((P4828T1Root a false j.succ).1 : ℝ))) ↔ _ + rw [hpolyMinus a, rectHull, hdistMinus a z] + simp only [Set.mem_ofPred_eq] + tauto + +private theorem hplusChar : + (∀ (u : ℝ), ∀ (v : ℝ), convexHull ℝ (Set.range (fun i : Fin 4 => ![⟨u, v⟩, ⟨u + 1, v⟩, ⟨u, v + + 2⟩, ⟨u + 1, v + 2⟩] i)) = {z : ℂ | u ≤ z.re ∧ z.re ≤ u + 1 ∧ v ≤ z.im ∧ z.im ≤ v + 2}) + → (∀ (a : GaussianInt), P4909T1ParentPolygon (2 * (a.re : ℝ)) (P4828T1Root a true) = + convexHull ℝ (Set.range (fun i : Fin 4 => ![⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ)⟩, ⟨(2 * + (a.re : ℝ) + 1) + 1, 2 * (a.im : ℝ)⟩, ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ) + 2⟩, ⟨(2 * + (a.re : ℝ) + 1) + 1, 2 * (a.im : ℝ) + 2⟩] i))) → (∀ (a : GaussianInt), ∀ (z : ℂ), (∀ j : + Fin 3, 0 < (P4828T1Root a true j.succ).1 → (1 / ((P4828T1Root a true j.succ).1 : ℝ)) + ≤ dist z ((P4828T1Root a true j.succ).2 / ((P4828T1Root a true j.succ).1 : ℝ))) ↔ 1 ≤ + dist z ((1 + 2 * a : GaussianInt) : ℂ) ∧ 1 ≤ dist z ((1 + 2 * a + 2 * ⟨0, 1⟩ : + GaussianInt) : ℂ)) → ∀ (a : GaussianInt), ∀ (z : ℂ), z ∈ P4984T1ClosedGap (2 * (a.re : + ℝ)) (P4828T1Root a true) ↔ + 2 * (a.re : ℝ) + 1 ≤ z.re ∧ z.re ≤ 2 * (a.re : ℝ) + 2 ∧ + 2 * (a.im : ℝ) ≤ z.im ∧ z.im ≤ 2 * (a.im : ℝ) + 2 ∧ + 1 ≤ dist z ((1 + 2 * a : GaussianInt) : ℂ) ∧ + 1 ≤ dist z ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : ℂ) := by + classical + intro rectHull hpolyPlus hdistPlus a z + change (z ∈ P4909T1ParentPolygon (2 * (a.re : ℝ)) (P4828T1Root a true) ∧ + ∀ j : Fin 3, 0 < (P4828T1Root a true j.succ).1 → + (1 / ((P4828T1Root a true j.succ).1 : ℝ)) ≤ + dist z ((P4828T1Root a true j.succ).2 / + ((P4828T1Root a true j.succ).1 : ℝ))) ↔ _ + rw [hpolyPlus a, rectHull, hdistPlus a z] + simp only [Set.mem_ofPred_eq] + ring_nf + tauto + +end RootGapLemmas + +theorem P4984T1RootGaps : + (∀ a : GaussianInt, + P4984T1ClosedGap (2 * (a.re : Real)) (P4828T1Root a false) = + {z : Complex | + 2 * (a.re : Real) ≤ z.re ∧ z.re ≤ 2 * (a.re : Real) + 1 ∧ + 2 * (a.im : Real) ≤ z.im ∧ z.im ≤ 2 * (a.im : Real) + 2 ∧ + 1 ≤ dist z ((1 + 2 * a : GaussianInt) : Complex) ∧ + 1 ≤ dist z ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)}) ∧ + (∀ a : GaussianInt, + P4984T1ClosedGap (2 * (a.re : Real)) (P4828T1Root a true) = + {z : Complex | + 2 * (a.re : Real) + 1 ≤ z.re ∧ z.re ≤ 2 * (a.re : Real) + 2 ∧ + 2 * (a.im : Real) ≤ z.im ∧ z.im ≤ 2 * (a.im : Real) + 2 ∧ + 1 ≤ dist z ((1 + 2 * a : GaussianInt) : Complex) ∧ + 1 ≤ dist z ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)}) ∧ + (∀ z : Complex, BandPackingExterior z → + ∃ a : GaussianInt, ∃ side : Bool, + z ∈ P4984T1ClosedGap (2 * (a.re : Real)) (P4828T1Root a side)) := by +-- BODY + classical + have rectHull (u v : ℝ) : + convexHull ℝ (Set.range (fun i : Fin 4 => + ![⟨u, v⟩, ⟨u + 1, v⟩, ⟨u, v + 2⟩, ⟨u + 1, v + 2⟩] i)) = + {z : ℂ | u ≤ z.re ∧ z.re ≤ u + 1 ∧ v ≤ z.im ∧ z.im ≤ v + 2} := RootGapLemmas.rectHull u v + have hpolyMinus (a : GaussianInt) : + P4909T1ParentPolygon (2 * (a.re : ℝ)) (P4828T1Root a false) = + convexHull ℝ (Set.range (fun i : Fin 4 => + ![⟨2 * (a.re : ℝ), 2 * (a.im : ℝ)⟩, + ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ)⟩, + ⟨2 * (a.re : ℝ), 2 * (a.im : ℝ) + 2⟩, + ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ) + 2⟩] i)) := RootGapLemmas.hpolyMinus a + have hpolyPlus (a : GaussianInt) : + P4909T1ParentPolygon (2 * (a.re : ℝ)) (P4828T1Root a true) = + convexHull ℝ (Set.range (fun i : Fin 4 => + ![⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ)⟩, + ⟨(2 * (a.re : ℝ) + 1) + 1, 2 * (a.im : ℝ)⟩, + ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ) + 2⟩, + ⟨(2 * (a.re : ℝ) + 1) + 1, 2 * (a.im : ℝ) + 2⟩] i)) := RootGapLemmas.hpolyPlus a + have hdistMinus (a : GaussianInt) (z : ℂ) : + (∀ j : Fin 3, 0 < (P4828T1Root a false j.succ).1 → + (1 / ((P4828T1Root a false j.succ).1 : ℝ)) ≤ + dist z ((P4828T1Root a false j.succ).2 / + ((P4828T1Root a false j.succ).1 : ℝ))) ↔ + 1 ≤ dist z ((1 + 2 * a : GaussianInt) : ℂ) ∧ + 1 ≤ dist z ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : ℂ) := RootGapLemmas.hdistMinus a z + have hdistPlus (a : GaussianInt) (z : ℂ) : + (∀ j : Fin 3, 0 < (P4828T1Root a true j.succ).1 → + (1 / ((P4828T1Root a true j.succ).1 : ℝ)) ≤ + dist z ((P4828T1Root a true j.succ).2 / + ((P4828T1Root a true j.succ).1 : ℝ))) ↔ + 1 ≤ dist z ((1 + 2 * a : GaussianInt) : ℂ) ∧ + 1 ≤ dist z ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : ℂ) := RootGapLemmas.hdistPlus a z + have hminusChar (a : GaussianInt) (z : ℂ) : + z ∈ P4984T1ClosedGap (2 * (a.re : ℝ)) (P4828T1Root a false) ↔ + 2 * (a.re : ℝ) ≤ z.re ∧ z.re ≤ 2 * (a.re : ℝ) + 1 ∧ + 2 * (a.im : ℝ) ≤ z.im ∧ z.im ≤ 2 * (a.im : ℝ) + 2 ∧ + 1 ≤ dist z ((1 + 2 * a : GaussianInt) : ℂ) ∧ + 1 ≤ dist z ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : ℂ) := RootGapLemmas.hminusChar + rectHull hpolyMinus hdistMinus a z + have hplusChar (a : GaussianInt) (z : ℂ) : + z ∈ P4984T1ClosedGap (2 * (a.re : ℝ)) (P4828T1Root a true) ↔ + 2 * (a.re : ℝ) + 1 ≤ z.re ∧ z.re ≤ 2 * (a.re : ℝ) + 2 ∧ + 2 * (a.im : ℝ) ≤ z.im ∧ z.im ≤ 2 * (a.im : ℝ) + 2 ∧ + 1 ≤ dist z ((1 + 2 * a : GaussianInt) : ℂ) ∧ + 1 ≤ dist z ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : ℂ) := RootGapLemmas.hplusChar + rectHull hpolyPlus hdistPlus a z + refine ⟨?_, ?_, ?_⟩ + · intro a + ext z + simpa only [Set.mem_ofPred_eq] using hminusChar a z + · intro a + ext z + simpa only [Set.mem_ofPred_eq] using hplusChar a z + · intro z hz + let x : ℤ := Int.floor (z.re / 2) + let y : ℤ := Int.floor (z.im / 2) + let a : GaussianInt := ⟨x, y⟩ + have hxlo : 2 * (a.re : ℝ) ≤ z.re := by + dsimp [a, x] + have h := Int.floor_le (z.re / 2) + nlinarith + have hxhi : z.re < 2 * (a.re : ℝ) + 2 := by + dsimp [a, x] + have h := Int.lt_floor_add_one (z.re / 2) + nlinarith + have hylo : 2 * (a.im : ℝ) ≤ z.im := by + dsimp [a, y] + have h := Int.floor_le (z.im / 2) + nlinarith + have hyhi : z.im < 2 * (a.im : ℝ) + 2 := by + dsimp [a, y] + have h := Int.lt_floor_add_one (z.im / 2) + nlinarith + let C₁ : BandCircle := by + refine ⟨⟨(1, 1 + 2 * a), ?_⟩, by norm_num⟩ + constructor + · exact Or.inl (by norm_num) + · refine ⟨![(1, 1 + 2 * a), (1, 1 + 2 * a + 2 * ⟨0, 1⟩), + (0, 1), (0, -1)], SemiProperQuadruple.base a, ?_⟩ + exact ⟨0, by simp⟩ + let C₂ : BandCircle := by + refine ⟨⟨(1, 1 + 2 * a + 2 * ⟨0, 1⟩), ?_⟩, by norm_num⟩ + constructor + · exact Or.inl (by norm_num) + · refine ⟨![(1, 1 + 2 * a), (1, 1 + 2 * a + 2 * ⟨0, 1⟩), + (0, 1), (0, -1)], SemiProperQuadruple.base a, ?_⟩ + exact ⟨1, by simp⟩ + have hd₁ : 1 ≤ dist z ((1 + 2 * a : GaussianInt) : ℂ) := by + have h := hz C₁ + simpa [BandPackingExterior, BandCircleEuclideanData, C₁] using h + have hd₂ : 1 ≤ dist z ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : ℂ) := by + have h := hz C₂ + simpa [BandPackingExterior, BandCircleEuclideanData, C₂] using h + by_cases hside : z.re ≤ 2 * (a.re : ℝ) + 1 + · refine ⟨a, false, ?_⟩ + apply (hminusChar a z).2 + exact ⟨hxlo, hside, hylo, hyhi.le, hd₁, hd₂⟩ + · have hleft : 2 * (a.re : ℝ) + 1 ≤ z.re := le_of_not_ge hside + refine ⟨a, true, ?_⟩ + apply (hplusChar a z).2 + refine ⟨hleft, ?_, hylo, hyhi.le, hd₁, hd₂⟩ + linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean b/LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean new file mode 100644 index 0000000000..c155f1998c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean @@ -0,0 +1,1113 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4984T1RootGaps +public import LeanPool.ApollonianSuperharmonic.P4828T1Evaluate +public import Mathlib.Analysis.Normed.Module.Connected +public import Mathlib.Analysis.SpecialFunctions.Pow.Real + +-- [TABLET NODE: P4984T1UnitIncidence] + +/-! +# P4984T1UnitIncidence + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace UnitIncidenceProof + +private theorem hdistAt190 : + ∀ (a : GaussianInt), ∀ (u : ℂ), ∀ (p : ℂ), ((p.re - u.re)^2 + (p.im - u.im)^2 = 1) → ((p.im - + u.im ≤ 1) → ((((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = ⟨u.re, u.im + 2⟩) → (1 + ≤ ‖p - ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)‖))) := by + classical + intro a u p hsum hyone hupper + have hs : Complex.normSq + (p - ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)) = + (p.re - u.re)^2 + (p.im - (u.im + 2))^2 := by + rw [hupper] + simp [Complex.normSq, Complex.sub_re, Complex.sub_im, pow_two] + have hn : ‖p - ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)‖^2 = + (p.re - u.re)^2 + (p.im - (u.im + 2))^2 := by + rw [← Complex.normSq_eq_norm_sq] + exact hs + have hnn := norm_nonneg (p - + ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)) + nlinarith [hn, hsum, hyone] + +private theorem hdistAt273 : + ∀ (a : GaussianInt), ∀ (u : ℂ), ∀ (p : ℂ), ((p.re - u.re)^2 + (p.im - u.im)^2 = 1) → ((p.im - + u.im ≤ 1) → ((((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = ⟨u.re, u.im + 2⟩) → (1 + ≤ ‖p - ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)‖))) := by + classical + intro a u p hsum hyone hupper + have hs : Complex.normSq + (p - ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)) = + (p.re - u.re)^2 + (p.im - (u.im + 2))^2 := by + rw [hupper] + simp [Complex.normSq, Complex.sub_re, Complex.sub_im, pow_two] + have hn : ‖p - ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)‖^2 = + (p.re - u.re)^2 + (p.im - (u.im + 2))^2 := by + rw [← Complex.normSq_eq_norm_sq] + exact hs + have hnn := norm_nonneg (p - + ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)) + nlinarith [hn, hsum, hyone] + +private theorem hdistAt357 : + ∀ (a : GaussianInt), ∀ (u : ℂ), ∀ (p : ℂ), ((p.re - u.re)^2 + (p.im - u.im)^2 = 1) → ((-1 ≤ + p.im - u.im) → ((((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex) = ⟨u.re, u.im - 2⟩) → + (1 ≤ ‖p - ((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex)‖))) := by + classical + intro a u p hsum hyminus hbelow + have hs : Complex.normSq + (p - ((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex)) = + (p.re - u.re)^2 + (p.im - (u.im - 2))^2 := by + rw [hbelow] + simp [Complex.normSq, Complex.sub_re, Complex.sub_im, pow_two] + have hn : ‖p - ((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex)‖^2 = + (p.re - u.re)^2 + (p.im - (u.im - 2))^2 := by + rw [← Complex.normSq_eq_norm_sq] + exact hs + have hnn := norm_nonneg (p - + ((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex)) + nlinarith [hn, hsum, hyminus] + +private theorem hdistAt445 : + ∀ (a : GaussianInt), ∀ (u : ℂ), ∀ (p : ℂ), ((p.re - u.re)^2 + (p.im - u.im)^2 = 1) → ((-1 ≤ + p.im - u.im) → ((((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex) = ⟨u.re, u.im - 2⟩) → + (1 ≤ ‖p - ((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex)‖))) := by + classical + intro a u p hsum hyminus hbelow + have hs : Complex.normSq + (p - ((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex)) = + (p.re - u.re)^2 + (p.im - (u.im - 2))^2 := by + rw [hbelow] + simp [Complex.normSq, Complex.sub_re, Complex.sub_im, pow_two] + have hn : ‖p - ((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex)‖^2 = + (p.re - u.re)^2 + (p.im - (u.im - 2))^2 := by + rw [← Complex.normSq_eq_norm_sq] + exact hs + have hnn := norm_nonneg (p - + ((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex)) + nlinarith [hn, hsum, hyminus] + +private theorem hQimage : + ∀ (a : GaussianInt), ∀ (u : ℂ), (u = (GaussianInt.toComplex : GaussianInt → ℂ) ((1 : + GaussianInt) + (2 : GaussianInt) * a)) → ( + let Q (left upper : Bool) : Set Complex := + {p | ‖p - u‖ = 1 ∧ + (if left then p.re - u.re ≤ 0 else 0 ≤ p.re - u.re) ∧ + (if upper then 0 ≤ p.im - u.im else p.im - u.im ≤ 0)} + ((u : Complex) = ⟨2 * (a.re : Real) + 1, 2 * (a.im : Real)⟩) → ( + let γ (left upper : Bool) (t : Real) : Complex := + u + (if left then -(Real.sqrt (1 - t^2) : Real) else Real.sqrt (1 - t^2)) + + ((if upper then t else -t : Real) : Complex) * Complex.I + ∀ (left : Bool), ∀ (upper : Bool), Q left upper = γ left upper '' Set.Icc (0 : ℝ) (1 : ℝ))) + := by + classical + intro a u huDef Q hu γ left upper + apply Set.ext + intro p + change (‖p - u‖ = 1 ∧ + (if left then p.re - u.re ≤ 0 else 0 ≤ p.re - u.re) ∧ + (if upper then 0 ≤ p.im - u.im else p.im - u.im ≤ 0)) ↔ + ∃ t ∈ Set.Icc (0 : Real) 1, γ left upper t = p + constructor + · rintro ⟨hnorm, hx, hy⟩ + have hs : Complex.normSq (p - u) = 1 := by + calc + Complex.normSq (p - u) = ‖p - u‖^2 := Complex.normSq_eq_norm_sq _ + _ = 1 := by rw [hnorm]; norm_num + change (p - u).re * (p - u).re + (p - u).im * (p - u).im = 1 at hs + rw [Complex.sub_re, Complex.sub_im] at hs + have hsum : (p.re - u.re)^2 + (p.im - u.im)^2 = 1 := by nlinarith [hs] + let t : Real := if upper then p.im - u.im else u.im - p.im + have ht0 : 0 ≤ t := by + dsimp [t] + cases upper <;> simp_all + have ht1 : t ≤ 1 := by + cases upper <;> dsimp [t] <;> nlinarith [hsum] + have ht : t ∈ Set.Icc (0 : Real) 1 := ⟨ht0, ht1⟩ + have htSq : t^2 = (p.im - u.im)^2 := by + cases upper <;> dsimp [t]; ring + have hsqrt : Real.sqrt (1 - t^2) = |p.re - u.re| := by + calc + Real.sqrt (1 - t^2) = Real.sqrt ((p.re - u.re)^2) := by + congr 1; nlinarith [hsum, htSq] + _ = |p.re - u.re| := Real.sqrt_sq_eq_abs _ + have hx' : (if left then -(Real.sqrt (1 - t^2)) else Real.sqrt (1 - t^2)) = + p.re - u.re := by + cases left + · simp? at hx ⊢ + have hxrel : 0 ≤ p.re - u.re := by linarith [hx] + rw [hsqrt, abs_of_nonneg hxrel] + · simp? at hx ⊢ + have hxrel : p.re - u.re ≤ 0 := by linarith [hx] + rw [hsqrt, abs_of_nonpos hxrel] + ring + have hy' : (if upper then t else -t) = p.im - u.im := by + cases upper <;> simp [t] + refine ⟨t, ht, ?_⟩ + apply Complex.ext + · simp [γ, hx'] + · simp [γ, hy'] + · rintro ⟨t, ht, rfl⟩ + have hq : 0 ≤ 1 - t^2 := by nlinarith [ht.1, ht.2] + have hs : Real.sqrt (1 - t^2)^2 = 1 - t^2 := Real.sq_sqrt hq + have hns : Complex.normSq (γ left upper t - u) = 1 := by + have hsub : γ left upper t - u = + (if left then -(Real.sqrt (1 - t^2) : Real) else Real.sqrt (1 - t^2)) + + ((if upper then t else -t : Real) : Complex) * Complex.I := by + dsimp [γ] + ring + cases left <;> cases upper <;> + simp [hsub, Complex.normSq_apply] <;> nlinarith [hs] + have hnorm' : ‖γ left upper t - u‖ = 1 := by + have hsquare : ‖γ left upper t - u‖ ^ 2 = 1 := by + simpa only [Complex.normSq_eq_norm_sq] using hns + rcases sq_eq_one_iff.mp hsquare with hnorm' | hnorm' + · exact hnorm' + · have hn := norm_nonneg (γ left upper t - u) + linarith + have hre : (γ left upper t).re = u.re + + (if left then -Real.sqrt (1 - t^2) else Real.sqrt (1 - t^2)) := by + change (u + (if left then -(Real.sqrt (1 - t^2) : Real) else + Real.sqrt (1 - t^2)) + + ((if upper then t else -t : Real) : Complex) * Complex.I).re = + u.re + (if left then -Real.sqrt (1 - t^2) else Real.sqrt (1 - t^2)) + rw [Complex.add_re, Complex.add_re] + simp only [Complex.ofReal_re, Complex.ofReal_im, Complex.mul_re, + Complex.I_re, Complex.I_im] + ring + have him : (γ left upper t).im = u.im + + (if upper then t else -t) := by + change (u + (if left then -(Real.sqrt (1 - t^2) : Real) else + Real.sqrt (1 - t^2)) + + ((if upper then t else -t : Real) : Complex) * Complex.I).im = + u.im + (if upper then t else -t) + rw [Complex.add_im, Complex.add_im] + simp only [Complex.ofReal_im, Complex.ofReal_re, Complex.mul_im, + Complex.I_re, Complex.I_im] + ring + constructor + · exact hnorm' + constructor + · cases left + · change 0 ≤ (γ false upper t).re - u.re + simp only [Bool.false_eq_true, ite_false] at hre ⊢ + rw [hre] + have hsqrt : 0 ≤ Real.sqrt (1 - t^2) := Real.sqrt_nonneg _ + linarith + · change (γ true upper t).re - u.re ≤ 0 + simp only [ite_true] at hre ⊢ + rw [hre] + have hsqrt : 0 ≤ Real.sqrt (1 - t^2) := Real.sqrt_nonneg _ + linarith + · cases upper + · simp only [Bool.false_eq_true, ite_false] at him ⊢ + rw [him] + linarith [ht.1] + · simp only [ite_eq_left] at him ⊢ + rw [him] + linarith [ht.1] + +private theorem hQcover : + ∀ (u : ℂ), + let Q (left upper : Bool) : Set Complex := + {p | ‖p - u‖ = 1 ∧ + (if left then p.re - u.re ≤ 0 else 0 ≤ p.re - u.re) ∧ + (if upper then 0 ≤ p.im - u.im else p.im - u.im ≤ 0)} + Metric.sphere u 1 = ⋃ i : Fin 4, Q (i = 0 ∨ i = 2) (i = 0 ∨ i = 1) := by + classical + intro u Q + exact (by + ext p + simp only [Metric.mem_sphere, dist_eq_norm, Set.mem_iUnion] + constructor + · intro hsphere + have hnorm : ‖p - u‖ = 1 := hsphere + have hx : p.re - u.re ≤ 0 ∨ 0 ≤ p.re - u.re := le_total _ _ + have hy : 0 ≤ p.im - u.im ∨ p.im - u.im ≤ 0 := le_total _ _ + rcases hx with hx | hx <;> rcases hy with hy | hy + · refine ⟨0, ?_⟩ + change p ∈ Q true true + change ‖p - u‖ = 1 ∧ p.re - u.re ≤ 0 ∧ 0 ≤ p.im - u.im + exact ⟨hnorm, hx, hy⟩ + · refine ⟨2, ?_⟩ + change p ∈ Q true false + change ‖p - u‖ = 1 ∧ p.re - u.re ≤ 0 ∧ p.im - u.im ≤ 0 + exact ⟨hnorm, hx, hy⟩ + · refine ⟨1, ?_⟩ + change p ∈ Q false true + change ‖p - u‖ = 1 ∧ 0 ≤ p.re - u.re ∧ 0 ≤ p.im - u.im + exact ⟨hnorm, hx, hy⟩ + · refine ⟨3, ?_⟩ + change p ∈ Q false false + change ‖p - u‖ = 1 ∧ 0 ≤ p.re - u.re ∧ p.im - u.im ≤ 0 + exact ⟨hnorm, hx, hy⟩ + · rintro ⟨i, hp⟩ + have hpNorm : ‖p - u‖ = 1 := by + change ‖p - u‖ = 1 ∧ _ ∧ _ at hp + exact hp.1 + simpa [dist_eq_norm] using hpNorm + ) + +private theorem hparent : + ∀ (a : GaussianInt), + let roots : Fin 4 → GaussianInt × Bool := + ![(a, false), (a, true), (a - ⟨0, 1⟩, false), (a - ⟨0, 1⟩, true)] + ∀ i : Fin 4, ∃ j : Fin 3, P4828T1Evaluate (roots i).1 (roots i).2 [] j.succ = (1, 1 + 2 * + a) := by + classical + intro a roots i + fin_cases i + · refine ⟨0, ?_⟩ + change (P4828T1Root a false) 1 = _ + simp [P4828T1Root] + · refine ⟨0, ?_⟩ + change (P4828T1Root a true) 1 = _ + simp [P4828T1Root] + · refine ⟨2, ?_⟩ + change (P4828T1Root (a - ⟨0, 1⟩) false) 3 = _ + simp [P4828T1Root] + ring + · refine ⟨1, ?_⟩ + change (P4828T1Root (a - ⟨0, 1⟩) true) 2 = _ + simp [P4828T1Root] + ring + +private theorem hseedUnion : + ∀ (a : GaussianInt), ∀ (u : ℂ), + let seeds : Finset (GaussianInt × Bool × List (Fin 3)) := + {(a, false, []), (a, true, []), + (a - ⟨0, 1⟩, false, []), (a - ⟨0, 1⟩, true, [])} + let arc (ι : GaussianInt × Bool × List (Fin 3)) : Set Complex := + P4984T1ClosedGap (2 * (ι.1.re : Real)) + (P4828T1Evaluate ι.1 ι.2.1 ι.2.2) ∩ Metric.sphere u 1 + let roots : Fin 4 → GaussianInt × Bool := + ![(a, false), (a, true), (a - ⟨0, 1⟩, false), (a - ⟨0, 1⟩, true)] + let A (i : Fin 4) : Set Complex := + P4984T1ClosedGap (2 * ((roots i).1.re : Real)) + (P4828T1Evaluate (roots i).1 (roots i).2 []) ∩ Metric.sphere u 1 + (arc (a, false, []) = A 0) → ((arc (a, true, []) = A 1) → ((arc (a - ⟨0, 1⟩, false, []) = A + 2) → ((arc (a - ⟨0, 1⟩, true, []) = A 3) → ((⋃ ι ∈ seeds, arc ι) = ⋃ i : Fin 4, A i)))) + := by + classical + intro a u seeds arc roots A hArc0 hArc1 hArc2 hArc3 + ext p + simp only [Set.mem_iUnion] + constructor + · rintro ⟨ι, hι, hp⟩ + simp only [seeds, Finset.mem_insert, Finset.mem_singleton] at hι + rcases hι with hι | hι | hι | hι + · subst ι + exact ⟨0, hArc0.symm ▸ hp⟩ + · subst ι + exact ⟨1, hArc1.symm ▸ hp⟩ + · subst ι + exact ⟨2, hArc2.symm ▸ hp⟩ + · subst ι + exact ⟨3, hArc3.symm ▸ hp⟩ + · rintro ⟨i, hp⟩ + fin_cases i + · refine ⟨(a, false, []), ?_, hArc0 ▸ hp⟩ + unfold seeds + exact Finset.mem_insert.mpr (Or.inl rfl) + · refine ⟨(a, true, []), ?_, hArc1 ▸ hp⟩ + unfold seeds + exact Finset.mem_insert.mpr (Or.inr (Finset.mem_insert.mpr (Or.inl rfl))) + · refine ⟨(a - ⟨0, 1⟩, false, []), ?_, hArc2 ▸ hp⟩ + unfold seeds + exact Finset.mem_insert.mpr (Or.inr (Finset.mem_insert.mpr + (Or.inr (Finset.mem_insert.mpr (Or.inl rfl)))) ) + · refine ⟨(a - ⟨0, 1⟩, true, []), ?_, hArc3 ▸ hp⟩ + unfold seeds + exact Finset.mem_insert.mpr (Or.inr (Finset.mem_insert.mpr + (Or.inr (Finset.mem_insert.mpr + (Or.inr (Finset.mem_singleton.mpr rfl))))) ) + +end UnitIncidenceProof + +namespace UnitIncidenceDetails + +private theorem hu : + ∀ (a : GaussianInt), ∀ (u : ℂ), (u = (GaussianInt.toComplex : GaussianInt → ℂ) ((1 : + GaussianInt) + (2 : GaussianInt) * a)) → ((u : Complex) = ⟨2 * (a.re : Real) + 1, 2 * + (a.im : Real)⟩) := by + classical + intro a u huDef + rw [huDef] + rw [GaussianInt.toComplex_def₂] + apply Complex.ext <;> simp [Zsqrtd.re_add, Zsqrtd.re_mul, + Zsqrtd.im_add, Zsqrtd.im_mul]; ring + +private theorem hLAt468 : + ∀ (a : GaussianInt), 2 * (GaussianInt.toComplex a).re = 2 * (a.re : Real) := by + classical + intro a + calc + _ = 2 * ((a.re : ℤ) : Real) := by rw [← GaussianInt.intCast_re] + _ = _ := rfl + +private theorem huReAt488 : + ∀ (a : GaussianInt), ∀ (u : ℂ), ((u : Complex) = ⟨2 * (a.re : Real) + 1, 2 * (a.im : Real)⟩) + → (u.re = 2 * (GaussianInt.toComplex a).re + 1) := by + classical + intro a u hu + rw [hu] + simp [GaussianInt.intCast_re] + +private theorem huImAt491 : + ∀ (a : GaussianInt), ∀ (u : ℂ), ((u : Complex) = ⟨2 * (a.re : Real) + 1, 2 * (a.im : Real)⟩) + → (u.im = 2 * (GaussianInt.toComplex a).im) := by + classical + intro a u hu + rw [hu] + simp [GaussianInt.intCast_im] + +private theorem hsumAt494 : + ∀ (u : ℂ), ∀ (p : ℂ), (‖p - u‖ = (1 : ℝ)) → ((p.re - u.re)^2 + (p.im - u.im)^2 = 1) := by + classical + intro u p hnorm + have hs : Complex.normSq (p - u) = 1 := by + calc + Complex.normSq (p - u) = ‖p - u‖^2 := Complex.normSq_eq_norm_sq _ + _ = 1 := by rw [hnorm]; norm_num + change (p - u).re * (p - u).re + (p - u).im * (p - u).im = 1 at hs + rw [Complex.sub_re, Complex.sub_im] at hs + nlinarith [hs] + +private theorem hupperAt503 : + ∀ (a : GaussianInt), ∀ (u : ℂ), ((u : Complex) = ⟨2 * (a.re : Real) + 1, 2 * (a.im : Real)⟩) + → (((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = ⟨u.re, u.im + 2⟩) := by + classical + intro a u hu + rw [GaussianInt.toComplex_def₂] + apply Complex.ext <;> simp [hu, Zsqrtd.re_add, Zsqrtd.re_mul, + Zsqrtd.im_add, Zsqrtd.im_mul]; ring + +private theorem hownAt528 : + ∀ (a : GaussianInt), ∀ (u : ℂ), (u = (GaussianInt.toComplex : GaussianInt → ℂ) ((1 : + GaussianInt) + (2 : GaussianInt) * a)) → ((1 + GaussianInt.toComplex 2 * + GaussianInt.toComplex a) = u) := by + classical + intro a u huDef + rw [huDef] + simp only [GaussianInt.toComplex_add, GaussianInt.toComplex_mul, + GaussianInt.toComplex_one] + +private theorem hupper'At534 : + ∀ (a : GaussianInt), (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a + + GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) = + GaussianInt.toComplex (1 + 2 * a + 2 * (⟨0, 1⟩ : GaussianInt)) := by + classical + intro a + simp only [GaussianInt.toComplex_add, GaussianInt.toComplex_mul, + GaussianInt.toComplex_one] + +private theorem hLAt542 : + ∀ (a : GaussianInt), 2 * (GaussianInt.toComplex a).re = 2 * (a.re : Real) := by + classical + intro a + calc + _ = 2 * ((a.re : ℤ) : Real) := by rw [← GaussianInt.intCast_re] + _ = _ := rfl + +private theorem hsumAt566 : + ∀ (u : ℂ), ∀ (p : ℂ), (‖p - u‖ = (1 : ℝ)) → ((p.re - u.re)^2 + (p.im - u.im)^2 = 1) := by + classical + intro u p hnorm + have hs : Complex.normSq (p - u) = 1 := by + calc + Complex.normSq (p - u) = ‖p - u‖^2 := Complex.normSq_eq_norm_sq _ + _ = 1 := by rw [hnorm]; norm_num + change (p - u).re * (p - u).re + (p - u).im * (p - u).im = 1 at hs + rw [Complex.sub_re, Complex.sub_im] at hs + nlinarith [hs] + +private theorem hupperAt575 : + ∀ (a : GaussianInt), ∀ (u : ℂ), ((u : Complex) = ⟨2 * (a.re : Real) + 1, 2 * (a.im : Real)⟩) + → (((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = ⟨u.re, u.im + 2⟩) := by + classical + intro a u hu + rw [GaussianInt.toComplex_def₂] + apply Complex.ext <;> simp [hu, Zsqrtd.re_add, Zsqrtd.re_mul, + Zsqrtd.im_add, Zsqrtd.im_mul]; ring + +private theorem hownAt601 : + ∀ (a : GaussianInt), ∀ (u : ℂ), (u = (GaussianInt.toComplex : GaussianInt → ℂ) ((1 : + GaussianInt) + (2 : GaussianInt) * a)) → ((1 + GaussianInt.toComplex 2 * + GaussianInt.toComplex a) = u) := by + classical + intro a u huDef + rw [huDef] + simp only [GaussianInt.toComplex_add, GaussianInt.toComplex_mul, + GaussianInt.toComplex_one] + +private theorem hupper'At607 : + ∀ (a : GaussianInt), (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a + + GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) = + GaussianInt.toComplex (1 + 2 * a + 2 * (⟨0, 1⟩ : GaussianInt)) := by + classical + intro a + simp only [GaussianInt.toComplex_add, GaussianInt.toComplex_mul, + GaussianInt.toComplex_one] + +private theorem hLzAt615 : + ∀ (a : GaussianInt), 2 * (((a - ⟨0, 1⟩ : GaussianInt).re : ℤ) : Real) = 2 * + (GaussianInt.toComplex a).re := by + classical + intro a + rw [GaussianInt.intCast_re, GaussianInt.toComplex_sub, Complex.sub_re] + simp + +private theorem hsumAt639 : + ∀ (u : ℂ), ∀ (p : ℂ), (‖p - u‖ = (1 : ℝ)) → ((p.re - u.re)^2 + (p.im - u.im)^2 = 1) := by + classical + intro u p hnorm + have hs : Complex.normSq (p - u) = 1 := by + calc + Complex.normSq (p - u) = ‖p - u‖^2 := Complex.normSq_eq_norm_sq _ + _ = 1 := by rw [hnorm]; norm_num + change (p - u).re * (p - u).re + (p - u).im * (p - u).im = 1 at hs + rw [Complex.sub_re, Complex.sub_im] at hs + nlinarith [hs] + +private theorem hbelowAt648 : + ∀ (a : GaussianInt), ∀ (u : ℂ), ((u : Complex) = ⟨2 * (a.re : Real) + 1, 2 * (a.im : Real)⟩) + → (((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex) = ⟨u.re, u.im - 2⟩) := by + classical + intro a u hu + rw [GaussianInt.toComplex_def₂] + apply Complex.ext <;> simp [hu, Zsqrtd.re_add, Zsqrtd.re_mul, + Zsqrtd.im_add, Zsqrtd.im_mul, Zsqrtd.re_sub, Zsqrtd.im_sub] <;> ring + +private theorem hbelow'At673 : + ∀ (a : GaussianInt), (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex (a - ⟨0, 1⟩ : + GaussianInt)) = GaussianInt.toComplex (1 + 2 * (a - ⟨0, 1⟩)) := by + classical + intro a + simp only [GaussianInt.toComplex_add, GaussianInt.toComplex_mul, + GaussianInt.toComplex_one] + +private theorem hown'At681 : + ∀ (a : GaussianInt), ∀ (u : ℂ), (u = (GaussianInt.toComplex : GaussianInt → ℂ) ((1 : + GaussianInt) + (2 : GaussianInt) * a)) → ((1 + GaussianInt.toComplex 2 * + GaussianInt.toComplex (a - ⟨0, 1⟩ : GaussianInt) + GaussianInt.toComplex 2 * + GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) = u) := by + classical + intro a u huDef + rw [huDef] + simp only [GaussianInt.toComplex_add, GaussianInt.toComplex_mul, + GaussianInt.toComplex_one, GaussianInt.toComplex_sub] + ring + +private theorem hLzAt692 : + ∀ (a : GaussianInt), 2 * (((a - ⟨0, 1⟩ : GaussianInt).re : ℤ) : Real) = 2 * + (GaussianInt.toComplex a).re := by + classical + intro a + rw [GaussianInt.intCast_re, GaussianInt.toComplex_sub, Complex.sub_re] + simp + +private theorem hsumAt716 : + ∀ (u : ℂ), ∀ (p : ℂ), (‖p - u‖ = (1 : ℝ)) → ((p.re - u.re)^2 + (p.im - u.im)^2 = 1) := by + classical + intro u p hnorm + have hs : Complex.normSq (p - u) = 1 := by + calc + Complex.normSq (p - u) = ‖p - u‖^2 := Complex.normSq_eq_norm_sq _ + _ = 1 := by rw [hnorm]; norm_num + change (p - u).re * (p - u).re + (p - u).im * (p - u).im = 1 at hs + rw [Complex.sub_re, Complex.sub_im] at hs + nlinarith [hs] + +private theorem hbelowAt725 : + ∀ (a : GaussianInt), ∀ (u : ℂ), ((u : Complex) = ⟨2 * (a.re : Real) + 1, 2 * (a.im : Real)⟩) + → (((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex) = ⟨u.re, u.im - 2⟩) := by + classical + intro a u hu + rw [GaussianInt.toComplex_def₂] + apply Complex.ext <;> simp [hu, Zsqrtd.re_add, Zsqrtd.re_mul, + Zsqrtd.im_add, Zsqrtd.im_mul, Zsqrtd.re_sub, Zsqrtd.im_sub] <;> ring + +private theorem hbelow'At751 : + ∀ (a : GaussianInt), (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex (a - ⟨0, 1⟩ : + GaussianInt)) = GaussianInt.toComplex (1 + 2 * (a - ⟨0, 1⟩)) := by + classical + intro a + simp only [GaussianInt.toComplex_add, GaussianInt.toComplex_mul, + GaussianInt.toComplex_one] + +private theorem hown'At759 : + ∀ (a : GaussianInt), ∀ (u : ℂ), (u = (GaussianInt.toComplex : GaussianInt → ℂ) ((1 : + GaussianInt) + (2 : GaussianInt) * a)) → ((1 + GaussianInt.toComplex 2 * + GaussianInt.toComplex (a - ⟨0, 1⟩ : GaussianInt) + GaussianInt.toComplex 2 * + GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) = u) := by + classical + intro a u huDef + rw [huDef] + simp only [GaussianInt.toComplex_add, GaussianInt.toComplex_mul, + GaussianInt.toComplex_one, GaussianInt.toComplex_sub] + ring + +private theorem hγcontinuous : + ∀ (u : ℂ), + let γ (left upper : Bool) (t : Real) : Complex := + u + (if left then -(Real.sqrt (1 - t^2) : Real) else Real.sqrt (1 - t^2)) + + ((if upper then t else -t : Real) : Complex) * Complex.I + ∀ (left : Bool), ∀ (upper : Bool), Continuous (γ left upper) := by + classical + intro u γ left upper + cases left <;> cases upper <;> unfold γ <;> + (try simp only [Bool.false_eq_true, ite_false, ite_true]) <;> + fun_prop + +private theorem hQpre : + ∀ (u : ℂ), + let Q (left upper : Bool) : Set Complex := + {p | ‖p - u‖ = 1 ∧ + (if left then p.re - u.re ≤ 0 else 0 ≤ p.re - u.re) ∧ + (if upper then 0 ≤ p.im - u.im else p.im - u.im ≤ 0)} + let γ (left upper : Bool) (t : Real) : Complex := + u + (if left then -(Real.sqrt (1 - t^2) : Real) else Real.sqrt (1 - t^2)) + + ((if upper then t else -t : Real) : Complex) * Complex.I + (∀ (left : Bool), ∀ (upper : Bool), Continuous (γ left upper)) → ((∀ (left : Bool), ∀ (upper + : Bool), Q left upper = γ left upper '' Set.Icc (0 : Real) 1) → (∀ (left : Bool), ∀ + (upper : Bool), IsPreconnected (Q left upper))) := by + classical + intro u Q γ hγcontinuous hQimage left upper + rw [hQimage left upper] + exact isPreconnected_Icc.image (γ left upper) + (hγcontinuous left upper).continuousOn + +private theorem hQclosed : + ∀ (u : ℂ), + let Q (left upper : Bool) : Set Complex := + {p | ‖p - u‖ = 1 ∧ + (if left then p.re - u.re ≤ 0 else 0 ≤ p.re - u.re) ∧ + (if upper then 0 ≤ p.im - u.im else p.im - u.im ≤ 0)} + let γ (left upper : Bool) (t : Real) : Complex := + u + (if left then -(Real.sqrt (1 - t^2) : Real) else Real.sqrt (1 - t^2)) + + ((if upper then t else -t : Real) : Complex) * Complex.I + (∀ (left : Bool), ∀ (upper : Bool), Continuous (γ left upper)) → ((∀ (left : Bool), ∀ (upper + : Bool), Q left upper = γ left upper '' Set.Icc (0 : Real) 1) → (∀ (left : Bool), ∀ + (upper : Bool), IsClosed (Q left upper))) := by + classical + intro u Q γ hγcontinuous hQimage left upper + rw [hQimage left upper] + exact (isCompact_Icc.image_of_continuousOn + (hγcontinuous left upper).continuousOn).isClosed + +private theorem hQnonempty : + ∀ (u : ℂ), + let Q (left upper : Bool) : Set Complex := + {p | ‖p - u‖ = 1 ∧ + (if left then p.re - u.re ≤ 0 else 0 ≤ p.re - u.re) ∧ + (if upper then 0 ≤ p.im - u.im else p.im - u.im ≤ 0)} + let γ (left upper : Bool) (t : Real) : Complex := + u + (if left then -(Real.sqrt (1 - t^2) : Real) else Real.sqrt (1 - t^2)) + + ((if upper then t else -t : Real) : Complex) * Complex.I + (∀ (left : Bool), ∀ (upper : Bool), Q left upper = γ left upper '' Set.Icc (0 : Real) 1) → (∀ + (left : Bool), ∀ (upper : Bool), (Q left upper).Nonempty) := by + classical + intro u Q γ hQimage left upper + rw [hQimage left upper] + exact ⟨γ left upper 0, ⟨0, ⟨by norm_num, by norm_num⟩, rfl⟩⟩ + +private theorem hcover : + ∀ (a : GaussianInt), ∀ (u : ℂ), + let Q (left upper : Bool) : Set Complex := + {p | ‖p - u‖ = 1 ∧ + (if left then p.re - u.re ≤ 0 else 0 ≤ p.re - u.re) ∧ + (if upper then 0 ≤ p.im - u.im else p.im - u.im ≤ 0)} + let roots : Fin 4 → GaussianInt × Bool := + ![(a, false), (a, true), (a - ⟨0, 1⟩, false), (a - ⟨0, 1⟩, true)] + let A (i : Fin 4) : Set Complex := + P4984T1ClosedGap (2 * ((roots i).1.re : Real)) + (P4828T1Evaluate (roots i).1 (roots i).2 []) ∩ Metric.sphere u 1 + (∀ i : Fin 4, A i = Q (i = 0 ∨ i = 2) (i = 0 ∨ i = 1)) → ((Metric.sphere u 1 = ⋃ i : Fin 4, Q + (i = 0 ∨ i = 2) (i = 0 ∨ i = 1)) → (Metric.sphere u 1 = ⋃ i : Fin 4, A i)) := by + classical + intro a u Q roots A hA hQcover + rw [hQcover] + ext p + simp only [Set.mem_iUnion] + constructor + · rintro ⟨i, hp⟩ + exact ⟨i, (hA i).symm ▸ hp⟩ + · rintro ⟨i, hp⟩ + exact ⟨i, (hA i) ▸ hp⟩ + +private theorem hclosed : + ∀ (a : GaussianInt), ∀ (u : ℂ), + let Q (left upper : Bool) : Set Complex := + {p | ‖p - u‖ = 1 ∧ + (if left then p.re - u.re ≤ 0 else 0 ≤ p.re - u.re) ∧ + (if upper then 0 ≤ p.im - u.im else p.im - u.im ≤ 0)} + let roots : Fin 4 → GaussianInt × Bool := + ![(a, false), (a, true), (a - ⟨0, 1⟩, false), (a - ⟨0, 1⟩, true)] + let A (i : Fin 4) : Set Complex := + P4984T1ClosedGap (2 * ((roots i).1.re : Real)) + (P4828T1Evaluate (roots i).1 (roots i).2 []) ∩ Metric.sphere u 1 + (∀ i : Fin 4, A i = Q (i = 0 ∨ i = 2) (i = 0 ∨ i = 1)) → ((∀ (left : Bool), ∀ (upper : Bool), + IsClosed (Q left upper)) → (∀ i : Fin 4, IsClosed (A i))) := by + classical + intro a u Q roots A hA hQclosed i + rw [hA i] + exact hQclosed (i = 0 ∨ i = 2) (i = 0 ∨ i = 1) + +private theorem hpre : + ∀ (a : GaussianInt), ∀ (u : ℂ), + let Q (left upper : Bool) : Set Complex := + {p | ‖p - u‖ = 1 ∧ + (if left then p.re - u.re ≤ 0 else 0 ≤ p.re - u.re) ∧ + (if upper then 0 ≤ p.im - u.im else p.im - u.im ≤ 0)} + let roots : Fin 4 → GaussianInt × Bool := + ![(a, false), (a, true), (a - ⟨0, 1⟩, false), (a - ⟨0, 1⟩, true)] + let A (i : Fin 4) : Set Complex := + P4984T1ClosedGap (2 * ((roots i).1.re : Real)) + (P4828T1Evaluate (roots i).1 (roots i).2 []) ∩ Metric.sphere u 1 + (∀ i : Fin 4, A i = Q (i = 0 ∨ i = 2) (i = 0 ∨ i = 1)) → ((∀ (left : Bool), ∀ (upper : Bool), + IsPreconnected (Q left upper)) → (∀ i : Fin 4, IsPreconnected (A i))) := by + classical + intro a u Q roots A hA hQpre i + rw [hA i] + exact hQpre (i = 0 ∨ i = 2) (i = 0 ∨ i = 1) + +private theorem hne : + ∀ (a : GaussianInt), ∀ (u : ℂ), + let Q (left upper : Bool) : Set Complex := + {p | ‖p - u‖ = 1 ∧ + (if left then p.re - u.re ≤ 0 else 0 ≤ p.re - u.re) ∧ + (if upper then 0 ≤ p.im - u.im else p.im - u.im ≤ 0)} + let roots : Fin 4 → GaussianInt × Bool := + ![(a, false), (a, true), (a - ⟨0, 1⟩, false), (a - ⟨0, 1⟩, true)] + let A (i : Fin 4) : Set Complex := + P4984T1ClosedGap (2 * ((roots i).1.re : Real)) + (P4828T1Evaluate (roots i).1 (roots i).2 []) ∩ Metric.sphere u 1 + (∀ i : Fin 4, A i = Q (i = 0 ∨ i = 2) (i = 0 ∨ i = 1)) → ((∀ (left : Bool), ∀ (upper : Bool), + (Q left upper).Nonempty) → (∀ i : Fin 4, (A i).Nonempty)) := by + classical + intro a u Q roots A hA hQnonempty i + rw [hA i] + exact hQnonempty (i = 0 ∨ i = 2) (i = 0 ∨ i = 1) + +end UnitIncidenceDetails + +namespace UnitRootQuadrants + +private theorem upperLeftRootGap : + (by + classical + exact + ∀ (a : GaussianInt), ∀ (u : ℂ), ∀ (huDef : u = (GaussianInt.toComplex : GaussianInt → ℂ) + ((1 : GaussianInt) + (2 : GaussianInt) * a)), let Q (left upper : Bool) : Set Complex := + {p | ‖p - u‖ = 1 ∧ + (if left then p.re - u.re ≤ 0 else 0 ≤ p.re - u.re) ∧ + (if upper then 0 ≤ p.im - u.im else p.im - u.im ≤ 0)} + let roots : Fin 4 → GaussianInt × Bool := + ![(a, false), (a, true), (a - ⟨0, 1⟩, false), (a - ⟨0, 1⟩, true)] + let A (i : Fin 4) : Set Complex := + P4984T1ClosedGap (2 * ((roots i).1.re : Real)) + (P4828T1Evaluate (roots i).1 (roots i).2 []) ∩ Metric.sphere u 1 + (u = ⟨(2 : ℝ) * (↑a.re : ℝ) + (1 : ℝ), (2 : ℝ) * (↑a.im : ℝ)⟩) → (A (0 : Fin 4) = Q ((0 : + Fin 4) = 0 ∨ (0 : Fin 4) = 2) ((0 : Fin 4) = 0 ∨ (0 : Fin 4) = 1))) := by + classical + intro a u huDef Q roots A hu + simp? [A, roots, P4828T1Evaluate] + have hL := UnitIncidenceDetails.hLAt468 a + rw [hL] + rw [P4984T1RootGaps.1 a] + ext p + simp? [Q, dist_eq_norm] + constructor + · rintro ⟨⟨hxl, hxr, hyl, hyr, _, _⟩, hnorm⟩ + refine ⟨hnorm, ?_, ?_⟩ + · rw [hu] + change p.re ≤ 2 * (a.re : Real) + 1 + rw [← GaussianInt.intCast_re a] at hxl hxr + nlinarith + · rw [hu] + change 2 * (a.im : Real) ≤ p.im + rw [← GaussianInt.intCast_im a] at hyl hyr + nlinarith + · rintro ⟨hnorm, hright, hbottom⟩ + have huRe := UnitIncidenceDetails.huReAt488 a u hu + have huIm := UnitIncidenceDetails.huImAt491 + a u hu + have hsum := UnitIncidenceDetails.hsumAt494 u + p hnorm + have hyone : p.im - u.im ≤ 1 := by nlinarith [hsum] + have hupper := UnitIncidenceDetails.hupperAt503 a u hu + have hdist := UnitIncidenceProof.hdistAt190 a u p hsum hyone hupper + refine ⟨?_, hnorm⟩ + change (2 * (GaussianInt.toComplex a).re ≤ p.re ∧ + p.re ≤ 2 * (GaussianInt.toComplex a).re + 1 ∧ + 2 * (GaussianInt.toComplex a).im ≤ p.im ∧ + p.im ≤ 2 * (GaussianInt.toComplex a).im + 2 ∧ + 1 ≤ ‖p - (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a)‖ ∧ + 1 ≤ ‖p - (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a + + GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt))‖) + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · calc + 2 * (GaussianInt.toComplex a).re = u.re - 1 := by linarith [huRe] + _ ≤ p.re := by nlinarith [hsum] + · rw [← huRe] + exact hright + · rw [← huIm] + exact hbottom + · rw [← huIm] + nlinarith [hyone] + · have hown : (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a) = u := + UnitIncidenceDetails.hownAt528 a u huDef + rw [hown] + linarith [hnorm] + · have hupper' : (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a + + GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) = + GaussianInt.toComplex (1 + 2 * a + 2 * (⟨0, 1⟩ : GaussianInt)) := + UnitIncidenceDetails.hupper'At534 a + rw [hupper'] + exact hdist + +private theorem upperRightRootGap : + (by + classical + exact + ∀ (a : GaussianInt), ∀ (u : ℂ), ∀ (huDef : u = (GaussianInt.toComplex : GaussianInt → ℂ) + ((1 : GaussianInt) + (2 : GaussianInt) * a)), let Q (left upper : Bool) : Set Complex := + {p | ‖p - u‖ = 1 ∧ + (if left then p.re - u.re ≤ 0 else 0 ≤ p.re - u.re) ∧ + (if upper then 0 ≤ p.im - u.im else p.im - u.im ≤ 0)} + let roots : Fin 4 → GaussianInt × Bool := + ![(a, false), (a, true), (a - ⟨0, 1⟩, false), (a - ⟨0, 1⟩, true)] + let A (i : Fin 4) : Set Complex := + P4984T1ClosedGap (2 * ((roots i).1.re : Real)) + (P4828T1Evaluate (roots i).1 (roots i).2 []) ∩ Metric.sphere u 1 + (u = ⟨(2 : ℝ) * (↑a.re : ℝ) + (1 : ℝ), (2 : ℝ) * (↑a.im : ℝ)⟩) → (A (1 : Fin 4) = Q ((1 : + Fin 4) = 0 ∨ (1 : Fin 4) = 2) ((1 : Fin 4) = 0 ∨ (1 : Fin 4) = 1))) := by + classical + intro a u huDef Q roots A hu + simp? [A, roots, P4828T1Evaluate] + have hL := UnitIncidenceDetails.hLAt542 a + rw [hL] + rw [P4984T1RootGaps.2.1 a] + ext p + simp? [Q, dist_eq_norm] + constructor + · rintro ⟨⟨hxl, hxr, hyl, hyr, _, _⟩, hnorm⟩ + refine ⟨hnorm, ?_, ?_⟩ + · rw [hu] + change 2 * (a.re : Real) + 1 ≤ p.re + rw [← GaussianInt.intCast_re a] at hxl hxr + linarith + · rw [hu] + change 2 * (a.im : Real) ≤ p.im + rw [← GaussianInt.intCast_im a] at hyl hyr + linarith + · rintro ⟨hnorm, hright, hbottom⟩ + have huRe : u.re = 2 * (GaussianInt.toComplex a).re + 1 := by + rw [hu]; simp [GaussianInt.intCast_re] + have huIm : u.im = 2 * (GaussianInt.toComplex a).im := by + rw [hu]; simp [GaussianInt.intCast_im] + have hsum := UnitIncidenceDetails.hsumAt566 u + p hnorm + have hyone : p.im - u.im ≤ 1 := by nlinarith [hsum] + have hupper := UnitIncidenceDetails.hupperAt575 a u hu + have hdist := UnitIncidenceProof.hdistAt273 a u p hsum hyone hupper + refine ⟨?_, hnorm⟩ + change (2 * (GaussianInt.toComplex a).re + 1 ≤ p.re ∧ + p.re ≤ 2 * (GaussianInt.toComplex a).re + 2 ∧ + 2 * (GaussianInt.toComplex a).im ≤ p.im ∧ + p.im ≤ 2 * (GaussianInt.toComplex a).im + 2 ∧ + 1 ≤ ‖p - (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a)‖ ∧ + 1 ≤ ‖p - (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a + + GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt))‖) + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · calc + 2 * (GaussianInt.toComplex a).re + 1 = u.re := by linarith [huRe] + _ ≤ p.re := by linarith [hright] + · calc + p.re ≤ u.re + 1 := by nlinarith [hsum] + _ = 2 * (GaussianInt.toComplex a).re + 2 := by linarith [huRe] + · rw [← huIm] + exact hbottom + · rw [← huIm] + nlinarith [hyone] + · have hown : (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a) = u := + UnitIncidenceDetails.hownAt601 a u huDef + rw [hown] + linarith [hnorm] + · have hupper' : (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a + + GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) = + GaussianInt.toComplex (1 + 2 * a + 2 * (⟨0, 1⟩ : GaussianInt)) := + UnitIncidenceDetails.hupper'At607 a + rw [hupper'] + exact hdist + +private theorem lowerLeftRootGap : + (by + classical + exact + ∀ (a : GaussianInt), ∀ (u : ℂ), ∀ (huDef : u = (GaussianInt.toComplex : GaussianInt → ℂ) + ((1 : GaussianInt) + (2 : GaussianInt) * a)), let Q (left upper : Bool) : Set Complex := + {p | ‖p - u‖ = 1 ∧ + (if left then p.re - u.re ≤ 0 else 0 ≤ p.re - u.re) ∧ + (if upper then 0 ≤ p.im - u.im else p.im - u.im ≤ 0)} + let roots : Fin 4 → GaussianInt × Bool := + ![(a, false), (a, true), (a - ⟨0, 1⟩, false), (a - ⟨0, 1⟩, true)] + let A (i : Fin 4) : Set Complex := + P4984T1ClosedGap (2 * ((roots i).1.re : Real)) + (P4828T1Evaluate (roots i).1 (roots i).2 []) ∩ Metric.sphere u 1 + (u = ⟨(2 : ℝ) * (↑a.re : ℝ) + (1 : ℝ), (2 : ℝ) * (↑a.im : ℝ)⟩) → (A (2 : Fin 4) = Q ((2 : + Fin 4) = 0 ∨ (2 : Fin 4) = 2) ((2 : Fin 4) = 0 ∨ (2 : Fin 4) = 1))) := by + classical + intro a u huDef Q roots A hu + simp? [A, roots, P4828T1Evaluate] + have hLz := UnitIncidenceDetails.hLzAt615 a + rw [← hLz] + rw [P4984T1RootGaps.1 (a - ⟨0, 1⟩)] + ext p + simp? [Q, dist_eq_norm] + constructor + · rintro ⟨⟨hxl, hxr, hyl, hyr, _, _⟩, hnorm⟩ + refine ⟨hnorm, ?_, ?_⟩ + · rw [hu] + change p.re ≤ 2 * (a.re : Real) + 1 + rw [← GaussianInt.intCast_re a] at hxl hxr + linarith + · rw [hu] + change p.im ≤ 2 * (a.im : Real) + rw [← GaussianInt.intCast_im a] at hyr + nlinarith [hyr] + · rintro ⟨hnorm, hright, hbottom⟩ + have huRe : u.re = 2 * (GaussianInt.toComplex a).re + 1 := by + rw [hu]; simp [GaussianInt.intCast_re] + have huIm : u.im = 2 * (GaussianInt.toComplex a).im := by + rw [hu]; simp [GaussianInt.intCast_im] + have hsum := UnitIncidenceDetails.hsumAt639 u + p hnorm + have hyminus : -1 ≤ p.im - u.im := by nlinarith [hsum] + have hbelow := UnitIncidenceDetails.hbelowAt648 a u hu + have hdist := UnitIncidenceProof.hdistAt357 a u p hsum hyminus hbelow + refine ⟨?_, hnorm⟩ + change (2 * (GaussianInt.toComplex a).re ≤ p.re ∧ + p.re ≤ 2 * (GaussianInt.toComplex a).re + 1 ∧ + 2 * ((GaussianInt.toComplex a).im - 1) ≤ p.im ∧ + p.im ≤ 2 * ((GaussianInt.toComplex a).im - 1) + 2 ∧ + 1 ≤ ‖p - (1 + GaussianInt.toComplex 2 * + (GaussianInt.toComplex a - GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)))‖ ∧ + 1 ≤ ‖p - (1 + GaussianInt.toComplex 2 * + (GaussianInt.toComplex a - GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) + + GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt))‖) + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · calc + 2 * (GaussianInt.toComplex a).re = u.re - 1 := by linarith [huRe] + _ ≤ p.re := by nlinarith [hsum] + · rw [← huRe] + exact hright + · nlinarith [hyminus, huIm] + · nlinarith [hbottom, huIm] + · have hbelow' : (1 + GaussianInt.toComplex 2 * + GaussianInt.toComplex (a - ⟨0, 1⟩ : GaussianInt)) = + GaussianInt.toComplex (1 + 2 * (a - ⟨0, 1⟩)) := + UnitIncidenceDetails.hbelow'At673 a + rw [GaussianInt.toComplex_sub] at hbelow' + rw [hbelow'] + exact hdist + · have hown' : (1 + GaussianInt.toComplex 2 * + GaussianInt.toComplex (a - ⟨0, 1⟩ : GaussianInt) + + GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) = u := + UnitIncidenceDetails.hown'At681 a u huDef + rw [GaussianInt.toComplex_sub] at hown' + rw [hown'] + linarith [hnorm] + +private theorem lowerRightRootGap : + (by + classical + exact + ∀ (a : GaussianInt), ∀ (u : ℂ), ∀ (huDef : u = (GaussianInt.toComplex : GaussianInt → ℂ) + ((1 : GaussianInt) + (2 : GaussianInt) * a)), let Q (left upper : Bool) : Set Complex := + {p | ‖p - u‖ = 1 ∧ + (if left then p.re - u.re ≤ 0 else 0 ≤ p.re - u.re) ∧ + (if upper then 0 ≤ p.im - u.im else p.im - u.im ≤ 0)} + let roots : Fin 4 → GaussianInt × Bool := + ![(a, false), (a, true), (a - ⟨0, 1⟩, false), (a - ⟨0, 1⟩, true)] + let A (i : Fin 4) : Set Complex := + P4984T1ClosedGap (2 * ((roots i).1.re : Real)) + (P4828T1Evaluate (roots i).1 (roots i).2 []) ∩ Metric.sphere u 1 + (u = ⟨(2 : ℝ) * (↑a.re : ℝ) + (1 : ℝ), (2 : ℝ) * (↑a.im : ℝ)⟩) → (A (3 : Fin 4) = Q ((3 : + Fin 4) = 0 ∨ (3 : Fin 4) = 2) ((3 : Fin 4) = 0 ∨ (3 : Fin 4) = 1))) := by + classical + intro a u huDef Q roots A hu + simp? [A, roots, P4828T1Evaluate] + have hLz := UnitIncidenceDetails.hLzAt692 a + rw [← hLz] + rw [P4984T1RootGaps.2.1 (a - ⟨0, 1⟩)] + ext p + simp? [Q, dist_eq_norm] + constructor + · rintro ⟨⟨hxl, hxr, hyl, hyr, _, _⟩, hnorm⟩ + refine ⟨hnorm, ?_, ?_⟩ + · rw [hu] + change 2 * (a.re : Real) + 1 ≤ p.re + rw [← GaussianInt.intCast_re a] at hxl hxr + linarith + · rw [hu] + change p.im ≤ 2 * (a.im : Real) + rw [← GaussianInt.intCast_im a] at hyr + nlinarith [hyr] + · rintro ⟨hnorm, hright, hbottom⟩ + have huRe : u.re = 2 * (GaussianInt.toComplex a).re + 1 := by + rw [hu]; simp [GaussianInt.intCast_re] + have huIm : u.im = 2 * (GaussianInt.toComplex a).im := by + rw [hu]; simp [GaussianInt.intCast_im] + have hsum := UnitIncidenceDetails.hsumAt716 u + p hnorm + have hyminus : -1 ≤ p.im - u.im := by nlinarith [hsum] + have hbelow := UnitIncidenceDetails.hbelowAt725 a u hu + have hdist := UnitIncidenceProof.hdistAt445 a u p hsum hyminus hbelow + refine ⟨?_, hnorm⟩ + change (2 * (GaussianInt.toComplex a).re + 1 ≤ p.re ∧ + p.re ≤ 2 * (GaussianInt.toComplex a).re + 2 ∧ + 2 * ((GaussianInt.toComplex a).im - 1) ≤ p.im ∧ + p.im ≤ 2 * ((GaussianInt.toComplex a).im - 1) + 2 ∧ + 1 ≤ ‖p - (1 + GaussianInt.toComplex 2 * + (GaussianInt.toComplex a - GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)))‖ ∧ + 1 ≤ ‖p - (1 + GaussianInt.toComplex 2 * + (GaussianInt.toComplex a - GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) + + GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt))‖) + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · calc + 2 * (GaussianInt.toComplex a).re + 1 = u.re := by linarith [huRe] + _ ≤ p.re := by linarith [hright] + · calc + p.re ≤ u.re + 1 := by nlinarith [hsum] + _ = 2 * (GaussianInt.toComplex a).re + 2 := by linarith [huRe] + · nlinarith [hyminus] + · nlinarith [hbottom, huIm] + · have hbelow' : (1 + GaussianInt.toComplex 2 * + GaussianInt.toComplex (a - ⟨0, 1⟩ : GaussianInt)) = + GaussianInt.toComplex (1 + 2 * (a - ⟨0, 1⟩)) := + UnitIncidenceDetails.hbelow'At751 a + rw [GaussianInt.toComplex_sub] at hbelow' + rw [hbelow'] + exact hdist + · have hown' : (1 + GaussianInt.toComplex 2 * + GaussianInt.toComplex (a - ⟨0, 1⟩ : GaussianInt) + + GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) = u := + UnitIncidenceDetails.hown'At759 a u huDef + rw [GaussianInt.toComplex_sub] at hown' + rw [hown'] + linarith [hnorm] + +end UnitRootQuadrants + +theorem P4984T1UnitIncidence (a : GaussianInt) : + let seeds : Finset (GaussianInt × Bool × List (Fin 3)) := + {(a, false, []), (a, true, []), + (a - ⟨0, 1⟩, false, []), (a - ⟨0, 1⟩, true, [])} + let arc (ι : GaussianInt × Bool × List (Fin 3)) := + P4984T1ClosedGap (2 * (ι.1.re : Real)) + (P4828T1Evaluate ι.1 ι.2.1 ι.2.2) ∩ + Metric.sphere ((1 + 2 * a : GaussianInt) : Complex) 1 + Metric.sphere ((1 + 2 * a : GaussianInt) : Complex) 1 = + ⋃ ι ∈ seeds, arc ι ∧ + ∀ ι ∈ seeds, + IsClosed (arc ι) ∧ IsPreconnected (arc ι) ∧ (arc ι).Nonempty ∧ + ∃ j : Fin 3, + P4828T1Evaluate ι.1 ι.2.1 ι.2.2 j.succ = (1, 1 + 2 * a) := by +-- BODY + exact (by + classical + set u : Complex := ((1 + 2 * a : GaussianInt) : Complex) with huDef + clear_value u + let seeds : Finset (GaussianInt × Bool × List (Fin 3)) := + {(a, false, []), (a, true, []), + (a - ⟨0, 1⟩, false, []), (a - ⟨0, 1⟩, true, [])} + let arc (ι : GaussianInt × Bool × List (Fin 3)) : Set Complex := + P4984T1ClosedGap (2 * (ι.1.re : Real)) + (P4828T1Evaluate ι.1 ι.2.1 ι.2.2) ∩ Metric.sphere u 1 + let Q (left upper : Bool) : Set Complex := + {p | ‖p - u‖ = 1 ∧ + (if left then p.re - u.re ≤ 0 else 0 ≤ p.re - u.re) ∧ + (if upper then 0 ≤ p.im - u.im else p.im - u.im ≤ 0)} + let roots : Fin 4 → GaussianInt × Bool := + ![(a, false), (a, true), (a - ⟨0, 1⟩, false), (a - ⟨0, 1⟩, true)] + let A (i : Fin 4) : Set Complex := + P4984T1ClosedGap (2 * ((roots i).1.re : Real)) + (P4828T1Evaluate (roots i).1 (roots i).2 []) ∩ Metric.sphere u 1 + have hu := UnitIncidenceDetails.hu a u huDef + have hA : ∀ i : Fin 4, A i = Q (i = 0 ∨ i = 2) (i = 0 ∨ i = 1) := by + intro i + fin_cases i + · exact UnitRootQuadrants.upperLeftRootGap a u huDef hu + · exact UnitRootQuadrants.upperRightRootGap a u huDef hu + · exact UnitRootQuadrants.lowerLeftRootGap a u huDef hu + · exact UnitRootQuadrants.lowerRightRootGap a u huDef hu + have hArc0 : arc (a, false, []) = A 0 := by + simp [arc, A, roots, P4828T1Evaluate] + have hArc1 : arc (a, true, []) = A 1 := by + simp [arc, A, roots, P4828T1Evaluate] + have hArc2 : arc (a - ⟨0, 1⟩, false, []) = A 2 := by + simp [arc, A, roots, P4828T1Evaluate] + have hArc3 : arc (a - ⟨0, 1⟩, true, []) = A 3 := by + simp [arc, A, roots, P4828T1Evaluate] + let γ (left upper : Bool) (t : Real) : Complex := + u + (if left then -(Real.sqrt (1 - t^2) : Real) else Real.sqrt (1 - t^2)) + + ((if upper then t else -t : Real) : Complex) * Complex.I + have hγcontinuous (left upper : Bool) := UnitIncidenceDetails.hγcontinuous u left upper + have hQimage (left upper : Bool) := UnitIncidenceProof.hQimage a u huDef hu left upper + have hclosed := UnitIncidenceDetails.hclosed a u hA (UnitIncidenceDetails.hQclosed u + hγcontinuous hQimage) + have hpre := UnitIncidenceDetails.hpre a u hA (UnitIncidenceDetails.hQpre u hγcontinuous + hQimage) + have hne := UnitIncidenceDetails.hne a u hA (UnitIncidenceDetails.hQnonempty u hQimage) + have hparent := UnitIncidenceProof.hparent a + constructor + · change Metric.sphere u 1 = ⋃ ι ∈ seeds, arc ι + rw [(UnitIncidenceDetails.hcover a u hA (UnitIncidenceProof.hQcover u))] + exact (UnitIncidenceProof.hseedUnion a u hArc0 hArc1 hArc2 hArc3).symm + · intro ι hι + simp only [Finset.mem_insert, Finset.mem_singleton] at hι + rcases hι with hι | hι | hι | hι + · subst ι + change IsClosed (arc (a, false, [])) ∧ IsPreconnected (arc (a, false, [])) ∧ + (arc (a, false, [])).Nonempty ∧ + ∃ j : Fin 3, P4828T1Evaluate a false [] j.succ = (1, 1 + 2 * a) + rw [hArc0] + exact ⟨hclosed 0, hpre 0, hne 0, by simpa [roots] using hparent 0⟩ + · subst ι + change IsClosed (arc (a, true, [])) ∧ IsPreconnected (arc (a, true, [])) ∧ + (arc (a, true, [])).Nonempty ∧ + ∃ j : Fin 3, P4828T1Evaluate a true [] j.succ = (1, 1 + 2 * a) + rw [hArc1] + exact ⟨hclosed 1, hpre 1, hne 1, by simpa [roots] using hparent 1⟩ + · subst ι + have hArc2' := hArc2 + simp only [arc] at hArc2' + simp only [] + rw [hArc2'] + exact ⟨hclosed 2, hpre 2, hne 2, by simpa [roots] using hparent 2⟩ + · subst ι + have hArc3' := hArc3 + simp only [arc] at hArc3' + simp only [] + rw [hArc3'] + exact ⟨hclosed 3, hpre 3, hne 3, by simpa [roots] using hparent 3⟩ + ) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6Chamber.lean b/LeanPool/ApollonianSuperharmonic/P4994T6Chamber.lean new file mode 100644 index 0000000000..b580e17cda --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4994T6Chamber.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4994T6Rotation + +-- [TABLET NODE: P4994T6Chamber] + +/-! +# P4994T6Chamber + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $n\geq0$ and $p\in\mathbb Z^2$, say that $p$ belongs to chamber $n$ +if $0\leq(R_np)_2\leq(R_np)_1$, where $R_n$ is +`P4994T6Rotation`. Thus chamber $n$ is the inverse image under +$R_n$ of the closed cone bounded by $(1,0)$ and $(1,1)$. +-/ +def P4994T6Chamber (n : Nat) (p : Int × Int) : Prop := +-- BODY + 0 ≤ (P4994T6Rotation n p).2 ∧ + (P4994T6Rotation n p).2 ≤ (P4994T6Rotation n p).1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6ChamberAdditions.lean b/LeanPool/ApollonianSuperharmonic/P4994T6ChamberAdditions.lean new file mode 100644 index 0000000000..df3535c291 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4994T6ChamberAdditions.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4994T6Chamber + +-- [TABLET NODE: P4994T6ChamberAdditions] + +/-! +# P4994T6ChamberAdditions + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4994T6ChamberAdditions (n : Nat) (p r : Int × Int) + (hp : P4994T6Chamber n p) (hr : P4994T6Chamber n r) : + P4994T6Chamber n (p + r) ∧ + p.1 * (p + r).2 - p.2 * (p + r).1 = p.1 * r.2 - p.2 * r.1 ∧ + (p + r).1 * r.2 - (p + r).2 * r.1 = p.1 * r.2 - p.2 * r.1 := by +-- BODY + refine ⟨?_, ?_, ?_⟩ + · unfold P4994T6Chamber at * + rw [map_add] + exact ⟨add_nonneg hp.1 hr.1, add_le_add hp.2 hr.2⟩ + · simp only [Prod.fst_add, Prod.snd_add] + ring + · simp only [Prod.fst_add, Prod.snd_add] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6ChartCovolume.lean b/LeanPool/ApollonianSuperharmonic/P4994T6ChartCovolume.lean new file mode 100644 index 0000000000..b6b13de202 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4994T6ChartCovolume.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex + +-- [TABLET NODE: P4994T6ChartCovolume] + +/-! +# P4994T6ChartCovolume + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4994T6ChartCovolume (C : BandCircle) (e f : GaussianInt) + (hdet : 0 < e.re * f.im - e.im * f.re) + (he : e ∈ TilingLattice C) (hf : f ∈ TilingLattice C) + (hcoord : ∀ w : TilingLattice C, ∃! z : Int × Int, + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f = (w : GaussianInt)) : + e.re * f.im - e.im * f.re = C.1.1.1 := by +-- BODY + classical + let K := TilingLattice C + let chart : (Fin 2 → ℤ) →ₗ[ℤ] K := + { toFun := fun x => ⟨x 0 • e + x 1 • f, + K.add_mem (K.zsmul_mem he _) (K.zsmul_mem hf _)⟩ + map_add' := by + intro x y + apply Subtype.ext + simp [zsmul_eq_mul, Int.cast_add] + ring + map_smul' := by + intro n x + apply Subtype.ext + simp [zsmul_eq_mul, Int.cast_mul] + ring } + have chart_injective : Function.Injective chart := by + intro x y hxy + have eqv := congrArg Subtype.val hxy + have hx : ((x 0 : ℤ) : GaussianInt) * e + (x 1 : GaussianInt) * f = + (chart x : GaussianInt) := by simp [chart, zsmul_eq_mul] + have hy : ((y 0 : ℤ) : GaussianInt) * e + (y 1 : GaussianInt) * f = + (chart x : GaussianInt) := by simpa [chart, zsmul_eq_mul] using eqv.symm + have eqp : (x 0, x 1) = (y 0, y 1) := (hcoord (chart x)).unique hx hy + funext j + fin_cases j + · exact congrArg Prod.fst eqp + · exact congrArg Prod.snd eqp + have chart_surjective : Function.Surjective chart := by + intro w + obtain ⟨p, hp, _⟩ := hcoord w + refine ⟨![p.1, p.2], Subtype.ext ?_⟩ + simpa [chart, zsmul_eq_mul] using hp + let coordinates : GaussianInt ≃ₗ[ℤ] (Fin 2 → ℤ) := + { toFun := fun z => ![z.re, z.im] + invFun := fun x => ⟨x 0, x 1⟩ + left_inv := by intro z; ext <;> simp + right_inv := by intro x; funext i; fin_cases i <;> simp + map_add' := by intro x y; funext i; fin_cases i <;> simp + map_smul' := by intro n x; funext i; fin_cases i <;> simp } + let chartEquiv := LinearEquiv.ofBijective chart ⟨chart_injective, chart_surjective⟩ + let basisK : Module.Basis (Fin 2) ℤ K := (Pi.basisFun ℤ (Fin 2)).map chartEquiv + let basisG : Module.Basis (Fin 2) ℤ GaussianInt := + Module.Basis.ofEquivFun coordinates + have index_value : K.index = Int.natAbs (e.re * f.im - e.im * f.re) := by + rw [AddSubgroup.index_eq_natAbs_det basisG K basisK] + congr 1 + rw [Module.Basis.det_apply, Matrix.det_fin_two] + simp [Module.Basis.toMatrix_apply, basisG, basisK, chartEquiv, chart, coordinates] + ring + obtain ⟨S, hS, hcard⟩ := TilingLatticeIndex C + let quotientMap : GaussianInt → GaussianInt ⧸ K := QuotientAddGroup.mk' K + have bijective : Function.Bijective (fun s : ↥S => quotientMap s) := by + constructor + · intro s t hst + apply Subtype.ext + exact (hS s).unique ⟨s.property, by simp⟩ + ⟨t.property, QuotientAddGroup.eq_iff_sub_mem.mp hst⟩ + · intro w + obtain ⟨z, rfl⟩ := QuotientAddGroup.mk'_surjective K w + obtain ⟨s, hs, _⟩ := hS z + exact ⟨⟨s, hs.1⟩, (QuotientAddGroup.eq_iff_sub_mem.mpr hs.2).symm⟩ + have index_card : K.index = S.card := by + rw [K.index_eq_card, ← Nat.card_congr (Equiv.ofBijective _ bijective)] + simp + have abs_eq : Int.natAbs (e.re * f.im - e.im * f.re) = C.1.1.1.natAbs := by + rw [← index_value, index_card, hcard] + have cast_eq := congrArg (fun n : Nat => (n : Int)) abs_eq + simpa [Int.natCast_natAbs, abs_of_pos hdet, abs_of_pos C.2] using cast_eq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6NonunitBirth.lean b/LeanPool/ApollonianSuperharmonic/P4994T6NonunitBirth.lean new file mode 100644 index 0000000000..45123666f4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4994T6NonunitBirth.lean @@ -0,0 +1,132 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4994T6StepChamber +public import LeanPool.ApollonianSuperharmonic.P4994T6ChartCovolume +public import LeanPool.ApollonianSuperharmonic.VectorDeterminant +public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification +public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P4994T6NonunitBirth] + +/-! +# P4994T6NonunitBirth + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4994T6NonunitBirth : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (C : BandCircle), (q 0 = + C.1.1) → ((C.1.1.1 ≠ 1) → (∀ (base : ProtoTile), (BandPrototile C.1.1 base) → (∀ (e : + GaussianInt), ∀ (f : GaussianInt), (0 < e.re * f.im - e.im * f.re) → ((e ∈ TilingLattice + C) → ((f ∈ TilingLattice C) → ((∀ w : TilingLattice C, ∃! z : Int × Int, + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f = (w : GaussianInt)) → ((∀ x y : Int × Int, + TileTouching + (TileTranslation base ((x.1 : GaussianInt) * e + (x.2 : GaussianInt) * f)) + (TileTranslation base ((y.1 : GaussianInt) * e + (y.2 : GaussianInt) * f)) ↔ + TriangularLatticeAdjacent x y) → (∀ (p : Int × Int), ∀ (r : Int × Int), ((p.1 : + GaussianInt) * e + (p.2 : GaussianInt) * f = + BandVectors.1 (q 2) (q 0)) → (((r.1 : GaussianInt) * e + (r.2 : GaussianInt) * f = + -BandVectors.1 (q 3) (q 0)) → (∃ n < 6, P4994T6Chamber n p ∧ P4994T6Chamber n + r))))))))))) := by + intro q hq C hC hnonunit base hbase e f hdet he hf hcoord hadj p r hp hr +-- BODY + let s : Fin 4 → CircleCoordinates := + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), q 0, q 2, q 3] + have hs : SemiProperQuadruple s := SemiProperQuadruple.successor hq.1 + have positive : 0 < (s (0 : Fin 3).succ).1 := by simpa [s, hC] using C.2 + have flip : (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 0) (q 3) = + -BandVectors.1 (q 3) (q 0) := by + have hf := ((VectorRecursionLaws q hq.1).2.2.2.2 hq 2).1 + change BandVectors.1 (q 0) (q 3) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 3) (q 0) at hf + rw [hf] + ext <;> simp + have signed : (BandVectors.1 (q 2) (q 0)).re * + ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 0) (q 3)).im - + (BandVectors.1 (q 2) (q 0)).im * + ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 0) (q 3)).re = -(q 0).1 := by + have real_part := congrArg (fun z : GaussianInt => z.re) + (VectorDeterminant s hs positive).1 + simp [s] at real_part ⊢ + ring_nf at real_part ⊢ + omega + rw [flip] at signed + have det_coordinates : p.1 * r.2 - p.2 * r.1 = -1 := by + have covolume := P4994T6ChartCovolume C e f hdet he hf hcoord + have hpre := congrArg (fun z : GaussianInt => z.re) hp + have hpim := congrArg (fun z : GaussianInt => z.im) hp + have hrre := congrArg (fun z : GaussianInt => z.re) hr + have hrim := congrArg (fun z : GaussianInt => z.im) hr + simp? at hpre hpim hrre hrim + have factor : + (BandVectors.1 (q 2) (q 0)).re * (-BandVectors.1 (q 3) (q 0)).im - + (BandVectors.1 (q 2) (q 0)).im * (-BandVectors.1 (q 3) (q 0)).re = + (e.re * f.im - e.im * f.re) * (p.1 * r.2 - p.2 * r.1) := by + simp only [Zsqrtd.re_neg, Zsqrtd.im_neg] + rw [← hpre, ← hpim, ← hrre, ← hrim] + ring + rw [signed, hC, covolume] at factor + have positive_curvature := C.2 + nlinarith + have steps : TriangularLatticeAdjacent 0 p ∧ + TriangularLatticeAdjacent 0 r ∧ TriangularLatticeAdjacent p r := by + let chart : Int × Int → GaussianInt := fun z => + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f + have in_family (z : Int × Int) : + TileTranslation base (chart z) ∈ RegularTileFamily base (TilingLattice C) := by + refine ⟨chart z, ?_, rfl⟩ + simpa only [chart, zsmul_eq_mul] using (TilingLattice C).add_mem + ((TilingLattice C).zsmul_mem he z.1) ((TilingLattice C).zsmul_mem hf z.2) + have centroid_difference (x y : GaussianInt) : + TileCentroid (TileTranslation base y) - + TileCentroid (TileTranslation base x) = GaussianRealPoint (y - x) := by + rw [(TileTranslationFormulas base y).2.2.2.2.1, + (TileTranslationFormulas base x).2.2.2.2.1] + ext <;> simp [GaussianRealPoint] + have edge (x y : Int × Int) (j : Fin 3) + (hxy : chart y - chart x = BandVectors.1 (q j.succ) (q 0) ∨ + chart y - chart x = -BandVectors.1 (q j.succ) (q 0)) : + TriangularLatticeAdjacent x y := by + apply (hadj x y).mp + apply (BandRegularTileTouchingClassification C q hq hC base + (by simpa only [hC] using hbase) _ _ (in_family x) (in_family y)).2 + refine ⟨j, ?_⟩ + rw [centroid_difference] + rcases hxy with positive | negative + · exact Or.inl (congrArg GaussianRealPoint positive) + · right + rw [negative] + ext <;> simp [GaussianRealPoint] + have incoming := (IncomingSuperbasisRelation q hq).1 + have sum : BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + + BandVectors.1 (q 3) (q 0) = 0 := by + simpa [Fin.sum_univ_succ, add_assoc] using incoming + have first_eq : BandVectors.1 (q 1) (q 0) = + -(BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0)) := + eq_neg_of_add_eq_zero_left (by simpa only [add_assoc] using sum) + refine ⟨edge 0 p 1 (Or.inl ?_), edge 0 r 2 (Or.inr ?_), + edge p r 0 (Or.inl ?_)⟩ + · simpa [chart] using hp + · simpa [chart] using hr + · change ((r.1 : GaussianInt) * e + (r.2 : GaussianInt) * f) - + ((p.1 : GaussianInt) * e + (p.2 : GaussianInt) * f) = + BandVectors.1 (q 1) (q 0) + rw [hp, hr, first_eq] + ring + exact P4994T6StepChamber p r steps.1 steps.2.1 steps.2.2 det_coordinates + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6NonunitChamber.lean b/LeanPool/ApollonianSuperharmonic/P4994T6NonunitChamber.lean new file mode 100644 index 0000000000..17403c4c33 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4994T6NonunitChamber.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4994T6NonunitBirth +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P4994T6ChamberAdditions +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification + +-- [TABLET NODE: P4994T6NonunitChamber] + +/-! +# P4994T6NonunitChamber + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4994T6NonunitChamber + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (C : BandCircle) (i : Fin 3) (hC : q i.succ = C.1.1) + (hnonunit : C.1.1.1 ≠ 1) + (base : ProtoTile) (hbase : BandPrototile C.1.1 base) + (e f : GaussianInt) (hdet : 0 < e.re * f.im - e.im * f.re) + (he : e ∈ TilingLattice C) (hf : f ∈ TilingLattice C) + (hcoord : ∀ w : TilingLattice C, ∃! z : Int × Int, + (z.1 : GaussianInt) * e + (z.2 : GaussianInt) * f = (w : GaussianInt)) + (hadj : ∀ x y : Int × Int, + TileTouching + (TileTranslation base ((x.1 : GaussianInt) * e + (x.2 : GaussianInt) * f)) + (TileTranslation base ((y.1 : GaussianInt) * e + (y.2 : GaussianInt) * f)) ↔ + TriangularLatticeAdjacent x y) + (p r : Int × Int) + (hp : (p.1 : GaussianInt) * e + (p.2 : GaussianInt) * f = + BandVectors.1 (q ((i + 1).succ)) (q i.succ)) + (hr : (r.1 : GaussianInt) * e + (r.2 : GaussianInt) * f = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q i.succ) (q ((i + 2).succ))) : + ∃ n < 6, P4994T6Chamber n p ∧ P4994T6Chamber n r := by +-- BODY + induction hq.1 generalizing i C p r with + | base z => + have positive := C.2 + have occurrence := congrArg (fun x : CircleCoordinates => x.1) hC + fin_cases i <;> simp at occurrence + · exact (hnonunit occurrence.symm).elim + · omega + · omega + | @rotate a ha ih => + have previous : ProperBandQuadruple a := by + refine ⟨ha, ?_⟩ + intro k + fin_cases k + · simpa using hq.2 (2 : Fin 3) + · simpa using hq.2 (0 : Fin 3) + · simpa using hq.2 (1 : Fin 3) + fin_cases i + · exact ih previous C 1 (by simpa using hC) hnonunit hbase he hf hcoord + p r (by simpa using hp) (by simpa using hr) + · exact ih previous C 2 (by simpa using hC) hnonunit hbase he hf hcoord + p r (by simpa using hp) (by simpa using hr) + · exact ih previous C 0 (by simpa using hC) hnonunit hbase he hf hcoord + p r (by simpa using hp) (by simpa using hr) + | @successor a ha ih => + rcases SemiProperForestClassification a ha with ⟨_, cases⟩ + rcases cases with root | root | root | proper + · obtain ⟨z, rfl⟩ := root + have positive := C.2 + have occurrence := congrArg (fun x : CircleCoordinates => x.1) hC + fin_cases i <;> simp at occurrence + · exact (hnonunit occurrence.symm).elim + · omega + · omega + · obtain ⟨z, rfl⟩ := root + have positive := C.2 + have occurrence := congrArg (fun x : CircleCoordinates => x.1) hC + fin_cases i <;> simp at occurrence + · exact (hnonunit occurrence.symm).elim + · omega + · exact (hnonunit occurrence.symm).elim + · obtain ⟨z, rfl⟩ := root + have positive := C.2 + have occurrence := congrArg (fun x : CircleCoordinates => x.1) hC + fin_cases i <;> simp at occurrence + · exact (hnonunit occurrence.symm).elim + · exact (hnonunit occurrence.symm).elim + · omega + · fin_cases i + · have haC : a 0 = C.1.1 := by simpa using hC + have second : (r.1 : GaussianInt) * e + (r.2 : GaussianInt) * f = + -BandVectors.1 (a 3) (a 0) := by + have flip := ((VectorRecursionLaws a ha).2.2.2.2 proper 2).1 + change BandVectors.1 (a 0) (a 3) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 3) (a 0) at flip + change (r.1 : GaussianInt) * e + (r.2 : GaussianInt) * f = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 0) (a 3) at hr + rw [hr, flip] + ext <;> simp + exact P4994T6NonunitBirth a proper C haC hnonunit base hbase + e f hdet he hf hcoord hadj p r (by simpa using hp) second + · have old_first : (p.1 : GaussianInt) * e + (p.2 : GaussianInt) * f = + BandVectors.1 (a 3) (a 2) := by simpa using hp + have second_recursion := (VectorRecursionLaws ![a 0, a 2, a 3, a 1] + (SemiProperQuadruple.rotate ha)).2.2.1 + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val_two, + Matrix.cons_val_three] at second_recursion + have second_addition : (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 2) (a 0) = + BandVectors.1 (a 3) (a 2) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 2) (a 1) := by + rw [second_recursion] + ext <;> simp <;> ring + have current : (r.1 : GaussianInt) * e + (r.2 : GaussianInt) * f = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 2) (a 0) := by simpa using hr + have old_second : ((r - p).1 : GaussianInt) * e + + ((r - p).2 : GaussianInt) * f = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 2) (a 1) := by + simp only [Prod.fst_sub, Prod.snd_sub, Int.cast_sub] + calc + _ = ((r.1 : GaussianInt) * e + (r.2 : GaussianInt) * f) - + ((p.1 : GaussianInt) * e + (p.2 : GaussianInt) * f) := by ring + _ = _ := by rw [current, old_first, second_addition]; ring + obtain ⟨n, hn, first, second⟩ := ih proper C 1 (by simpa using hC) + hnonunit hbase he hf hcoord p (r - p) old_first old_second + have eqsum : p + (r - p) = r := by ext <;> simp + exact ⟨n, hn, first, by + simpa only [eqsum] using (P4994T6ChamberAdditions n p (r - p) first second).1⟩ + · have current : (p.1 : GaussianInt) * e + (p.2 : GaussianInt) * f = + BandVectors.1 (a 0) (a 3) := by simpa using hp + have third_recursion := (VectorRecursionLaws ![a 0, a 3, a 1, a 2] + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate ha))).2.2.1 + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val_two, + Matrix.cons_val_three] at third_recursion + have flip : BandVectors.1 (a 0) (a 3) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 3) (a 0) := by + simpa using ((VectorRecursionLaws a ha).2.2.2.2 proper 2).1 + have third_addition : BandVectors.1 (a 0) (a 3) = + BandVectors.1 (a 1) (a 3) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 3) (a 2) := by + rw [flip, third_recursion] + ext <;> simp <;> ring + have old_second : (r.1 : GaussianInt) * e + (r.2 : GaussianInt) * f = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 3) (a 2) := by simpa using hr + have old_first : ((p - r).1 : GaussianInt) * e + + ((p - r).2 : GaussianInt) * f = BandVectors.1 (a 1) (a 3) := by + simp only [Prod.fst_sub, Prod.snd_sub, Int.cast_sub] + calc + _ = ((p.1 : GaussianInt) * e + (p.2 : GaussianInt) * f) - + ((r.1 : GaussianInt) * e + (r.2 : GaussianInt) * f) := by ring + _ = _ := by rw [current, old_second, third_addition]; ring + obtain ⟨n, hn, first, second⟩ := ih proper C 2 (by simpa using hC) + hnonunit hbase he hf hcoord (p - r) r old_first old_second + exact ⟨n, hn, by + simpa only [sub_add_cancel] using + (P4994T6ChamberAdditions n (p - r) r first second).1, second⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6Rotation.lean b/LeanPool/ApollonianSuperharmonic/P4994T6Rotation.lean new file mode 100644 index 0000000000..b45259f8f9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4994T6Rotation.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: P4994T6Rotation] + +/-! +# P4994T6Rotation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $n\geq0$, let $R_n$ be the additive automorphism of $\mathbb Z^2$ +defined by $R_0=\operatorname{id}$ and +$R_{n+1}(x)=((R_nx)_1-(R_nx)_2,(R_nx)_1)$. +Thus $R_n$ is the $n$th power of $R(x,y)=(x-y,x)$; the inverse of $R$ +is $(x,y)\mapsto(y,y-x)$. +-/ +def P4994T6Rotation : Nat → ((Int × Int) ≃+ (Int × Int)) := +-- BODY + fun + | 0 => AddEquiv.refl _ + | n + 1 => (P4994T6Rotation n).trans + { toFun := fun p => (p.1 - p.2, p.1) + invFun := fun p => (p.2, p.2 - p.1) + left_inv := by intro p; ext <;> simp + right_inv := by intro p; ext <;> simp + map_add' := by intro p q; ext <;> simp; omega } + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6RotationLaws.lean b/LeanPool/ApollonianSuperharmonic/P4994T6RotationLaws.lean new file mode 100644 index 0000000000..3c16e85406 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4994T6RotationLaws.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4994T6Rotation +public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TriangularSignedHeight + +-- [TABLET NODE: P4994T6RotationLaws] + +/-! +# P4994T6RotationLaws + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4994T6RotationLaws : + (∀ n x y, TriangularLatticeAdjacent (P4994T6Rotation n x) + (P4994T6Rotation n y) ↔ TriangularLatticeAdjacent x y) ∧ + (∀ n x y z, TriangularSignedHeight (P4994T6Rotation n x) + (P4994T6Rotation n y) (P4994T6Rotation n z) = + TriangularSignedHeight x y z) ∧ + (∀ p, P4994T6Rotation 6 p = p) ∧ + (∀ m n p, P4994T6Rotation (m + n) p = + P4994T6Rotation n (P4994T6Rotation m p)) := by +-- BODY + have step_adj (x y : Int × Int) : + TriangularLatticeAdjacent (x.1 - x.2, x.1) (y.1 - y.2, y.1) ↔ + TriangularLatticeAdjacent x y := by + rcases x with ⟨x₁, x₂⟩ + rcases y with ⟨y₁, y₂⟩ + simp only [TriangularLatticeAdjacent, Prod.mk_sub_mk, Prod.mk.injEq] + omega + have step_height (x y z : Int × Int) : + TriangularSignedHeight (x.1 - x.2, x.1) (y.1 - y.2, y.1) + (z.1 - z.2, z.1) = TriangularSignedHeight x y z := by + simp only [TriangularSignedHeight] + ring + refine ⟨?_, ?_, ?_, ?_⟩ + · intro n + induction n with + | zero => intro x y; rfl + | succ n ih => + intro x y + exact (step_adj (P4994T6Rotation n x) (P4994T6Rotation n y)).trans + (ih x y) + · intro n + induction n with + | zero => intro x y z; rfl + | succ n ih => + intro x y z + exact (step_height (P4994T6Rotation n x) (P4994T6Rotation n y) + (P4994T6Rotation n z)).trans (ih x y z) + · intro p + ext <;> simp [P4994T6Rotation] + · intro m n + induction n with + | zero => intro p; rfl + | succ n ih => + intro p + change ((P4994T6Rotation (m + n) p).1 - + (P4994T6Rotation (m + n) p).2, (P4994T6Rotation (m + n) p).1) = + ((P4994T6Rotation n (P4994T6Rotation m p)).1 - + (P4994T6Rotation n (P4994T6Rotation m p)).2, + (P4994T6Rotation n (P4994T6Rotation m p)).1) + rw [ih] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6StepChamber.lean b/LeanPool/ApollonianSuperharmonic/P4994T6StepChamber.lean new file mode 100644 index 0000000000..f24725d110 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4994T6StepChamber.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4994T6Chamber +public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent + +-- [TABLET NODE: P4994T6StepChamber] + +/-! +# P4994T6StepChamber + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4994T6StepChamber (p r : Int × Int) + (hp : TriangularLatticeAdjacent 0 p) + (hr : TriangularLatticeAdjacent 0 r) + (hpr : TriangularLatticeAdjacent p r) + (hdet : p.1 * r.2 - p.2 * r.1 = -1) : + ∃ n < 6, P4994T6Chamber n p ∧ P4994T6Chamber n r := by +-- BODY + simp only [TriangularLatticeAdjacent, sub_zero] at hp hr + rcases hp with rfl | rfl | rfl | rfl | rfl | rfl <;> + rcases hr with rfl | rfl | rfl | rfl | rfl | rfl + all_goals try norm_num at hdet + all_goals try norm_num [TriangularLatticeAdjacent, Prod.mk_sub_mk] at hpr + all_goals first + | (refine ⟨0, by decide, ?_⟩ + norm_num [P4994T6Chamber, P4994T6Rotation] + done) + | (refine ⟨1, by decide, ?_⟩ + norm_num [P4994T6Chamber, P4994T6Rotation] + done) + | (refine ⟨2, by decide, ?_⟩ + norm_num [P4994T6Chamber, P4994T6Rotation] + done) + | (refine ⟨3, by decide, ?_⟩ + norm_num [P4994T6Chamber, P4994T6Rotation] + done) + | (refine ⟨4, by decide, ?_⟩ + norm_num [P4994T6Chamber, P4994T6Rotation] + done) + | (refine ⟨5, by decide, ?_⟩ + norm_num [P4994T6Chamber, P4994T6Rotation] + ) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6UnitChartRotation.lean b/LeanPool/ApollonianSuperharmonic/P4994T6UnitChartRotation.lean new file mode 100644 index 0000000000..5650caaa00 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4994T6UnitChartRotation.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4994T6UnitCoordinates +public import LeanPool.ApollonianSuperharmonic.P4994T6Rotation +public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep + +-- [TABLET NODE: P4994T6UnitChartRotation] + +/-! +# P4994T6UnitChartRotation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4994T6UnitChartRotation (orientation : Bool) (e f : GaussianInt) + (hdet : 0 < e.re * f.im - e.im * f.re) + (he : UnitTriangularStep orientation e) + (hf : UnitTriangularStep orientation f) + (hsum : UnitTriangularStep orientation (e + f)) : + ∃ m < 6, ∀ p : Int × Int, + P4994T6UnitCoordinates orientation + ((p.1 : GaussianInt) * e + (p.2 : GaussianInt) * f) = + P4994T6Rotation m p := by +-- BODY + cases orientation <;> + simp only [UnitTriangularStep, Bool.false_eq_true, ↓reduceIte, + Finset.mem_insert, Finset.mem_singleton] at he hf hsum <;> + rcases he with rfl | rfl | rfl | rfl | rfl | rfl <;> + rcases hf with rfl | rfl | rfl | rfl | rfl | rfl + all_goals try norm_num at hdet + all_goals try norm_num [Zsqrtd.ext_iff] at hsum + all_goals first + | refine ⟨0, by decide, ?_⟩ + intro p; ext <;> simp [P4994T6UnitCoordinates, P4994T6Rotation] <;> omega + | refine ⟨1, by decide, ?_⟩ + intro p; ext <;> simp [P4994T6UnitCoordinates, P4994T6Rotation] <;> omega + | refine ⟨2, by decide, ?_⟩ + intro p; ext <;> simp [P4994T6UnitCoordinates, P4994T6Rotation] <;> omega + | refine ⟨3, by decide, ?_⟩ + intro p; ext <;> simp [P4994T6UnitCoordinates, P4994T6Rotation] <;> omega + | refine ⟨4, by decide, ?_⟩ + intro p; ext <;> simp [P4994T6UnitCoordinates, P4994T6Rotation] <;> omega + | refine ⟨5, by decide, ?_⟩ + intro p; ext <;> simp [P4994T6UnitCoordinates, P4994T6Rotation]; omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6UnitCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4994T6UnitCoordinates.lean new file mode 100644 index 0000000000..217c2fbc81 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4994T6UnitCoordinates.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: P4994T6UnitCoordinates] + +/-! +# P4994T6UnitCoordinates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The additive coordinate isomorphism $K_\epsilon:\mathbb Z[i]\to\mathbb Z^2$ +is $K_{\mathsf{standard}}(z)=(\Re z,\Im z)$ and +$K_{\mathsf{rotated}}(z)=(\Im z,-\Re z)$. +These are the coordinates in the positive bases $(1,i)$ and $(i,-1)$, +respectively; standard is the Boolean true and rotated is false. +-/ +def P4994T6UnitCoordinates (orientation : Bool) : GaussianInt ≃+ (Int × Int) := +-- BODY + if orientation then + { toFun := fun z => (z.re, z.im) + invFun := fun p => ⟨p.1, p.2⟩ + left_inv := by intro z; rfl + right_inv := by intro p; rfl + map_add' := by intro z w; rfl } + else + { toFun := fun z => (z.im, -z.re) + invFun := fun p => ⟨-p.2, p.1⟩ + left_inv := by intro z; ext <;> simp + right_inv := by intro p; ext <;> simp + map_add' := by intro z w; ext <;> simp; omega } + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6UnitOccurrenceChamber.lean b/LeanPool/ApollonianSuperharmonic/P4994T6UnitOccurrenceChamber.lean new file mode 100644 index 0000000000..c3fb3b1ec8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4994T6UnitOccurrenceChamber.lean @@ -0,0 +1,182 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4994T6UnitRootTable +public import LeanPool.ApollonianSuperharmonic.P4994T6UnitCoordinates +public import LeanPool.ApollonianSuperharmonic.P4994T6ChamberAdditions +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique +public import LeanPool.ApollonianSuperharmonic.P4566T1UnitPairCharts + +-- [TABLET NODE: P4994T6UnitOccurrenceChamber] + +/-! +# P4994T6UnitOccurrenceChamber + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4994T6UnitOccurrenceChamber + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (i : Fin 3) (hunit : (q i.succ).1 = 1) + (orientation : Bool) (ho : UnitOccurrenceOrientation q i orientation) : + let u := BandVectors.1 (q ((i + 1).succ)) (q i.succ) + let v := (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q i.succ) (q ((i + 2).succ)) + ∃ n < 6, + P4994T6Chamber n (P4994T6UnitCoordinates orientation u) ∧ + P4994T6Chamber n (P4994T6UnitCoordinates orientation v) := by +-- BODY + have second_update (a : Fin 4 → CircleCoordinates) (ha : ProperBandQuadruple a) + (o : Bool) + (old : ∃ n < 6, + P4994T6Chamber n (P4994T6UnitCoordinates o (BandVectors.1 (a 3) (a 2))) ∧ + P4994T6Chamber n (P4994T6UnitCoordinates o + ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 2) (a 1)))) : + ∃ n < 6, + P4994T6Chamber n (P4994T6UnitCoordinates o (BandVectors.1 (a 3) (a 2))) ∧ + P4994T6Chamber n (P4994T6UnitCoordinates o + ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 2) (a 0))) := by + obtain ⟨n, hn, hp, hr⟩ := old + have recursion := (VectorRecursionLaws ![a 0, a 2, a 3, a 1] + (SemiProperQuadruple.rotate ha.1)).2.2.1 + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val_two, + Matrix.cons_val_three] at recursion + have addition : (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 2) (a 0) = + BandVectors.1 (a 3) (a 2) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 2) (a 1) := by + rw [recursion] + ext <;> simp <;> ring + rw [addition, map_add] + exact ⟨n, hn, hp, (P4994T6ChamberAdditions n _ _ hp hr).1⟩ + have third_update (a : Fin 4 → CircleCoordinates) (ha : ProperBandQuadruple a) + (o : Bool) + (old : ∃ n < 6, + P4994T6Chamber n (P4994T6UnitCoordinates o (BandVectors.1 (a 1) (a 3))) ∧ + P4994T6Chamber n (P4994T6UnitCoordinates o + ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 3) (a 2)))) : + ∃ n < 6, + P4994T6Chamber n (P4994T6UnitCoordinates o (BandVectors.1 (a 0) (a 3))) ∧ + P4994T6Chamber n (P4994T6UnitCoordinates o + ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 3) (a 2))) := by + obtain ⟨n, hn, hp, hr⟩ := old + have recursion := (VectorRecursionLaws ![a 0, a 3, a 1, a 2] + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate ha.1))).2.2.1 + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val_two, + Matrix.cons_val_three] at recursion + have flip : BandVectors.1 (a 0) (a 3) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 3) (a 0) := by + simpa using ((VectorRecursionLaws a ha.1).2.2.2.2 ha 2).1 + have addition : BandVectors.1 (a 0) (a 3) = + BandVectors.1 (a 1) (a 3) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (a 3) (a 2) := by + rw [flip, recursion] + ext <;> simp <;> ring + rw [addition, map_add] + exact ⟨n, hn, (P4994T6ChamberAdditions n _ _ hp hr).1, hr⟩ + revert hq hunit + induction ho with + | leftLower z => + intro _ _ + have row := (P4994T6UnitRootTable z).1 + dsimp [P4828T1Root] at row + dsimp only + simp only [Fin.reduceAdd, Matrix.cons_val_succ, Matrix.cons_val_zero, + Matrix.cons_val_one, Matrix.cons_val_two, Matrix.vecHead, Matrix.vecTail, + Function.comp_apply] + rw [row.1, row.2] + refine ⟨2, by decide, ?_⟩ + norm_num [P4994T6Chamber, P4994T6Rotation, P4994T6UnitCoordinates] + | leftUpper z => + intro _ _ + have row := (P4994T6UnitRootTable z).2.1 + dsimp [P4828T1Root] at row + dsimp only + simp only [Fin.reduceAdd, Matrix.cons_val_succ, Matrix.cons_val_zero, + Matrix.cons_val_one, Matrix.cons_val_two, Matrix.vecHead, Matrix.vecTail, + Function.comp_apply] + rw [row.1, row.2] + refine ⟨0, by decide, ?_⟩ + norm_num [P4994T6Chamber, P4994T6Rotation, P4994T6UnitCoordinates] + | rightUpper z => + intro _ _ + have row := (P4994T6UnitRootTable z).2.2.1 + dsimp [P4828T1Root] at row + dsimp only + simp only [Fin.reduceAdd, Matrix.cons_val_succ, Matrix.cons_val_zero, + Matrix.cons_val_one, Matrix.cons_val_two, Matrix.vecHead, Matrix.vecTail, + Function.comp_apply] + rw [row.1, row.2] + refine ⟨0, by decide, ?_⟩ + norm_num [P4994T6Chamber, P4994T6Rotation, P4994T6UnitCoordinates] + | rightLower z => + intro _ _ + have row := (P4994T6UnitRootTable z).2.2.2 + dsimp [P4828T1Root] at row + dsimp only + simp only [Fin.reduceAdd, Matrix.cons_val_succ, Matrix.cons_val_zero, + Matrix.cons_val_one, Matrix.cons_val_two, Matrix.vecHead, Matrix.vecTail, + Function.comp_apply] + rw [row.1, row.2] + refine ⟨5, by decide, ?_⟩ + norm_num [P4994T6Chamber, P4994T6Rotation, P4994T6UnitCoordinates] + | @rotate a j o old ih => + intro ha hunit + have previous : ProperBandQuadruple a := by + refine ⟨?_, ?_⟩ + · have eta : (![a 0, a 1, a 2, a 3] : Fin 4 → CircleCoordinates) = a := by + funext k + fin_cases k <;> rfl + simpa [eta] using SemiProperQuadruple.rotate (SemiProperQuadruple.rotate ha.1) + · intro k + fin_cases k + · simpa using ha.2 (2 : Fin 3) + · simpa using ha.2 (0 : Fin 3) + · simpa using ha.2 (1 : Fin 3) + fin_cases j <;> simpa using ih previous (by simpa using hunit) + | @retainSecondOther a o ha _ old ih => + intro _ hunit + exact second_update a ha o (by simpa using ih ha (by simpa using hunit)) + | @retainThirdOther a o ha _ old ih => + intro _ hunit + exact third_update a ha o (by simpa using ih ha (by simpa using hunit)) + | @retainSecondToThird a o ha hs hd old ih => + intro _ hunit + have hu : (a 2).1 = 1 := by simpa using hunit + have expected := (P4566T1UnitPairCharts a ha 1 2 (by decide) hu hs hd).1 + have eqo : o = false := (UnitOccurrenceOrientationUnique.1 a ha 1 hu).unique old expected + subst o + exact second_update a ha false (by simpa using ih ha hu) + | @retainSecondFromThird a o ha hs hd old ih => + intro _ hunit + have hu : (a 2).1 = 1 := by simpa using hunit + have expected := (P4566T1UnitPairCharts a ha 2 1 (by decide) hs hu hd).2 + have eqo : o = true := (UnitOccurrenceOrientationUnique.1 a ha 1 hu).unique old expected + subst o + exact second_update a ha true (by simpa using ih ha hu) + | @retainThirdFromSecond a o ha hs hd old ih => + intro _ hunit + have hu : (a 3).1 = 1 := by simpa using hunit + have expected := (P4566T1UnitPairCharts a ha 1 2 (by decide) hs hu hd).2 + have eqo : o = true := (UnitOccurrenceOrientationUnique.1 a ha 2 hu).unique old expected + subst o + exact third_update a ha true (by simpa using ih ha hu) + | @retainThirdToSecond a o ha hs hd old ih => + intro _ hunit + have hu : (a 3).1 = 1 := by simpa using hunit + have expected := (P4566T1UnitPairCharts a ha 2 1 (by decide) hu hs hd).1 + have eqo : o = false := (UnitOccurrenceOrientationUnique.1 a ha 2 hu).unique old expected + subst o + exact third_update a ha false (by simpa using ih ha hu) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6UnitRootTable.lean b/LeanPool/ApollonianSuperharmonic/P4994T6UnitRootTable.lean new file mode 100644 index 0000000000..d75eecab4c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P4994T6UnitRootTable.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P4828T1Root + +-- [TABLET NODE: P4994T6UnitRootTable] + +/-! +# P4994T6UnitRootTable + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P4994T6UnitRootTable (z : GaussianInt) : + let L := P4828T1Root z false + let H := P4828T1Root z true + let I : GaussianInt := ⟨0, 1⟩ + (BandVectors.1 (L 2) (L 1) = -I ∧ + I * BandVectors.1 (L 1) (L 3) = -1 - I) ∧ + (BandVectors.1 (L 1) (L 3) = -1 + I ∧ + I * BandVectors.1 (L 3) (L 2) = I) ∧ + (BandVectors.1 (H 2) (H 1) = 1 + I ∧ + I * BandVectors.1 (H 1) (H 3) = 1) ∧ + (BandVectors.1 (H 3) (H 2) = -1 ∧ + I * BandVectors.1 (H 2) (H 1) = -1 + I) := by +-- BODY + have system : RecursiveVectorSystem BandVectors := by + simpa [BandVectors] using (Classical.choose_spec RecursiveVectorsExistUnique).1 + have base := system.2.1 z + dsimp at base + have step := system.2.2.1 _ (SemiProperQuadruple.base z) + dsimp at step + have plus_lower : BandVectors.1 (0, 1) (1, 1 + 2 * z) = -1 := by + simpa [base.1, base.2.1] using step.1 + have lower_minus : BandVectors.1 (1, 1 + 2 * z) (0, -1) = 1 := by + simpa [base.1, base.2.2.1] using step.2.1 + have upper_lower : BandVectors.1 (1, 1 + 2 * z + 2 * ⟨0, 1⟩) + (1, 1 + 2 * z) = 1 + (⟨0, 1⟩ : GaussianInt) := by + have h := (VectorRecursionLaws _ (SemiProperQuadruple.base z)).2.2.1 + simpa [base.2.1, base.2.2.1] using h + have lower_upper : BandVectors.1 (1, 1 + 2 * z) + (1, 1 + 2 * z + 2 * ⟨0, 1⟩) = -1 + (⟨0, 1⟩ : GaussianInt) := by + have h := (system.2.2.2 _ _ (PrimitiveVectorOrientation.base10 z)).1 + rw [upper_lower] at h + convert h using 1; ext <;> simp + have shift : (1, 1 + 2 * (z - (⟨0, 1⟩ : GaussianInt)) + 2 * ⟨0, 1⟩) = + ((1, 1 + 2 * z) : CircleCoordinates) := by + congr 1 + ring + have lower_plus : BandVectors.1 (1, 1 + 2 * z) (0, 1) = + -(⟨0, 1⟩ : GaussianInt) := by + have h := (system.2.2.2 _ _ + (PrimitiveVectorOrientation.base21 (z - (⟨0, 1⟩ : GaussianInt)))).1 + rw [shift, plus_lower] at h + simpa using h + have minus_lower : BandVectors.1 (0, -1) (1, 1 + 2 * z) = + -(⟨0, 1⟩ : GaussianInt) := by + have h := (system.2.2.2 _ _ + (PrimitiveVectorOrientation.base31 (z - (⟨0, 1⟩ : GaussianInt)))).1 + rw [shift, lower_minus] at h + have hre := congrArg (fun w : GaussianInt => w.re) h + have him := congrArg (fun w : GaussianInt => w.im) h + simp at hre him + ext <;> simp <;> omega + dsimp [P4828T1Root] + simp only [minus_lower, lower_upper, upper_lower, lower_plus, base.2.1, base.2.2.1] + norm_num [Zsqrtd.ext_iff] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1CircularEstimate.lean b/LeanPool/ApollonianSuperharmonic/P5023T1CircularEstimate.lean new file mode 100644 index 0000000000..87fd7a361e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5023T1CircularEstimate.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Real.Sqrt +public import Mathlib.Tactic.FieldSimp +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P5023T1CircularEstimate] + +/-! +# P5023T1CircularEstimate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5023T1CircularEstimate (r R : ℝ) (hR : 0 < R) + (hRr : R < r) (hr1 : r ≤ 1) : + 2 * r * Real.sqrt (1 - ((r - R) / (r + R)) ^ 2) ≤ 4 * Real.sqrt R := by +-- BODY + have hden : 0 < r + R := by linarith + have hquot : |(r - R) / (r + R)| ≤ 1 := by + rw [abs_div, abs_of_pos hden] + apply (div_le_iff₀ hden).2 + rw [abs_le] + constructor <;> linarith + have hrad : 0 ≤ 1 - ((r - R) / (r + R)) ^ 2 := by + have hprod : 0 ≤ + (1 - |(r - R) / (r + R)|) * (1 + |(r - R) / (r + R)|) := + mul_nonneg (sub_nonneg.mpr hquot) (by positivity) + have hsq : |(r - R) / (r + R)| ^ 2 ≤ 1 := by nlinarith + rw [← sq_abs] + nlinarith + have hidentity : + 1 - ((r - R) / (r + R)) ^ 2 = 4 * r * R / (r + R) ^ 2 := by + field_simp + ring + have hrSq : r ^ 2 ≤ (r + R) ^ 2 := by nlinarith [sq_nonneg R] + have hrCube : r ^ 3 ≤ (r + R) ^ 2 := by + calc + r ^ 3 ≤ r ^ 2 := by nlinarith [sq_nonneg r] + _ ≤ (r + R) ^ 2 := hrSq + have hmain : + (2 * r * Real.sqrt (1 - ((r - R) / (r + R)) ^ 2)) ^ 2 ≤ + (4 * Real.sqrt R) ^ 2 := by + simp only [mul_pow, Real.sq_sqrt hrad, Real.sq_sqrt hR.le] + rw [hidentity] + have hdenSq : 0 < (r + R) ^ 2 := sq_pos_of_pos hden + field_simp [ne_of_gt hdenSq] + nlinarith [mul_le_mul_of_nonneg_right hrCube hR.le] + have hleft : 0 ≤ 2 * r * Real.sqrt (1 - ((r - R) / (r + R)) ^ 2) := by + exact mul_nonneg (mul_nonneg (by norm_num) (by linarith)) (Real.sqrt_nonneg _) + have hright : 0 ≤ 4 * Real.sqrt R := by positivity + nlinarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean b/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean new file mode 100644 index 0000000000..affd670c75 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean @@ -0,0 +1,1263 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5023T1ContactVertices +public import LeanPool.ApollonianSuperharmonic.P4828T1Gap +public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity + +-- [TABLET NODE: P5023T1CircularSide] + +/-! +# P5023T1CircularSide + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CircularSideProof + +private theorem hR : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + (0 < (q 0).1) → (0 < rad 0) ) := by + classical + intro q rad hchild + dsimp [rad] + exact one_div_pos.mpr (by exact_mod_cast hchild) + +private theorem hr : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let rad (a : Fin 4) : ℝ := 1 / + ((q a).1 : ℝ) + (0 < (q i.succ).1) → (0 < rad i.succ) ) := by + classical + intro q i rad hparent + dsimp [rad] + exact one_div_pos.mpr (by exact_mod_cast hparent) + +private theorem hRr : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let rad (a : Fin 4) : ℝ := 1 / + ((q a).1 : ℝ) + (0 < (q i.succ).1) → (((q i.succ).1 < (q 0).1) → (rad 0 < rad i.succ)) ) := by + classical + intro q i rad hparent hless + dsimp [rad] + exact (one_div_lt_one_div_of_lt (by exact_mod_cast hparent) (by exact_mod_cast hless)) + +private theorem hjpos : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let j : Fin 3 := i + 1 + (∀ a : Fin 3, 0 ≤ (q a.succ).1) → (0 < (q j.succ).1 ∨ (q j.succ).1 = 0) ) := by + classical + intro q i j other_nonneg + have h := other_nonneg j + rcases lt_or_eq_of_le h with hp | hz + · exact Or.inl hp + · exact Or.inr hz.symm + +private theorem hkpos : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let k : Fin 3 := i + 2 + (∀ a : Fin 3, 0 ≤ (q a.succ).1) → (0 < (q k.succ).1 ∨ (q k.succ).1 = 0) ) := by + classical + intro q i k other_nonneg + have h := other_nonneg k + rcases lt_or_eq_of_le h with hp | hz + · exact Or.inl hp + · exact Or.inr hz.symm + +private theorem hnotbothzero : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let j : Fin 3 := i + 1 + let k : Fin 3 := i + 2 + (∀ a b : Fin 3, (q a.succ).1 = 0 → (q b.succ).1 = 0 → a = b) → ((j ≠ k) → (¬ ((q j.succ).1 = + 0 ∧ (q k.succ).1 = 0))) ) := by + classical + intro q i j k other_unique hjk hz + have heq := other_unique j k hz.1 hz.2 + exact hjk heq + +private theorem centerDistance : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → ( + let p (a : Fin 4) : ℂ := + (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + ∀ (a : Fin (4 : ℕ)), ∀ (b : Fin (4 : ℕ)), a ≠ b → (0 : ℤ) < (q a).1 → (0 : ℤ) < (q b).1 → + dist (p a) (p b) = rad a + rad b) ) := by + classical + intro q hq p rad a b hab ha hb + let w : GaussianInt := (q b).1 • (q a).2 - (q a).1 • (q b).2 + have ht := TangencyCoordinateIdentity q hq.1 a b hab + have normCast (z : GaussianInt) : Complex.normSq (z : ℂ) = (Zsqrtd.norm z : ℝ) := by + simp [Complex.normSq, Zsqrtd.norm_def] + have hn : Complex.normSq (w : ℂ) = (((q a).1 + (q b).1 : ℤ) ^ 2 : ℝ) := by + change Complex.normSq (((q b).1 • (q a).2 - (q a).1 • (q b).2 : GaussianInt) : ℂ) = _ + rw [normCast] + exact_mod_cast ht + have hnsq : ‖(w : ℂ)‖ ^ 2 = (((q a).1 + (q b).1 : ℤ) : ℝ) ^ 2 := by + rw [← Complex.normSq_eq_norm_sq, hn] + have hsum : 0 ≤ (((q a).1 + (q b).1 : ℤ) : ℝ) := by positivity + have hnorm : ‖(w : ℂ)‖ = (((q a).1 + (q b).1 : ℤ) : ℝ) := by + have := norm_nonneg (w : ℂ) + nlinarith + have hdiff : p a - p b = + (w : ℂ) / (((q a).1 * (q b).1 : ℤ) : ℂ) := by + dsimp [p, w] + push_cast + simp only [map_sub, map_zsmul] + field_simp [ne_of_gt ha, ne_of_gt hb] + ring + rw [Complex.dist_eq, hdiff, Complex.norm_div, Complex.norm_intCast, hnorm] + have haR : 0 < ((q a).1 : ℝ) := by exact_mod_cast ha + have hbR : 0 < ((q b).1 : ℝ) := by exact_mod_cast hb + have habR : 0 < (((q a).1 * (q b).1 : ℤ) : ℝ) := by exact_mod_cast mul_pos ha hb + rw [abs_of_pos habR] + push_cast + dsimp [rad] + field_simp [ne_of_gt haR, ne_of_gt hbR] + ring + +private theorem hchild_parent : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let p (a : Fin 4) : ℂ := (q + a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + (0 < (q 0).1) → ((0 < (q i.succ).1) → ((∀ (a : Fin 4), ∀ (b : Fin 4), (a ≠ b) → ((0 < (q + a).1) → ((0 < (q b).1) → (dist (p a) (p b) = rad a + rad b)))) → (dist (p 0) (p i.succ) = + rad 0 + rad i.succ))) ) := by + classical + intro q i p rad hchild hparent centerDistance + apply centerDistance 0 i.succ + · exact (Fin.succ_ne_zero i).symm + · exact hchild + · exact hparent + +private theorem capBound : + (by + classical + exact + let dot (x y : ℂ) : ℝ := x.re * y.re + x.im * y.im + ∀ (x : ℂ), ∀ (y : ℂ), ∀ (e : ℂ), ∀ (t : ℝ), (Complex.normSq : ℂ → ℝ) x = (1 : ℝ) → + (Complex.normSq : ℂ → ℝ) y = (1 + : ℝ) → (Complex.normSq : ℂ → ℝ) e = (1 : ℝ) → (0 : ℝ) ≤ t → t ≤ (1 : ℝ) → t ≤ dot x e → t + ≤ dot y e → ‖x - y‖ ≤ (2 : ℝ) * √((1 : ℝ) - t ^ (2 : ℕ)) ) := by + classical + intro dot x y e t hx hy he ht0 ht1 hxd hyd + have hsumdot : 2 * t ≤ dot (x + y) e := by + dsimp [dot] at hxd hyd ⊢ + nlinarith + have cauchy2 (v : ℂ) : dot v e ^ 2 ≤ Complex.normSq v := by + dsimp [dot] + rw [Complex.normSq_apply] + have he' := he + rw [Complex.normSq_apply] at he' + nlinarith [sq_nonneg (e.re * v.im - e.im * v.re)] + have hplus : 4 * t ^ 2 ≤ Complex.normSq (x + y) := by + have := cauchy2 (x + y) + have hnonneg : 0 ≤ dot (x + y) e := le_trans (by positivity) hsumdot + nlinarith + have hsum : Complex.normSq (x - y) + Complex.normSq (x + y) = 4 := by + repeat rw [Complex.normSq_apply] + simp only [Complex.sub_re, Complex.sub_im, Complex.add_re, Complex.add_im] + have hx' := hx + have hy' := hy + rw [Complex.normSq_apply] at hx' hy' + nlinarith [hx', hy'] + have hminus : Complex.normSq (x - y) ≤ 4 * (1 - t ^ 2) := by nlinarith + have hrad : 0 ≤ 1 - t ^ 2 := by nlinarith + have hminus' := hminus + rw [Complex.normSq_eq_norm_sq] at hminus' + have hnorm : ‖x - y‖ ^ 2 ≤ (2 * Real.sqrt (1 - t ^ 2)) ^ 2 := by + nlinarith [hminus', Real.sq_sqrt hrad] + have hleft : 0 ≤ ‖x - y‖ := norm_nonneg _ + have hright : 0 ≤ 2 * Real.sqrt (1 - t ^ 2) := by positivity + nlinarith + +private theorem hcenterNorm : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let p (a : Fin 4) : ℂ := (q + a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + (dist (p 0) (p i.succ) = rad 0 + rad i.succ) → ( + let A : ℂ := p i.succ + let X : ℂ := p 0 + ‖X - A‖ = rad i.succ + rad 0) ) := by + classical + intro q i p rad hchild_parent A X + rw [dist_eq_norm] at hchild_parent + simpa [A, X, add_comm] using hchild_parent + +private theorem heNorm : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let p (a : Fin 4) : ℂ := (q + a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + (0 < rad i.succ + rad 0) → ( + let A : ℂ := p i.succ + let X : ℂ := p 0 + let e : ℂ := (X - A) / ((rad i.succ + rad 0 : ℝ) : ℂ) + (‖X - A‖ = rad i.succ + rad 0) → (‖e‖ = 1)) ) := by + classical + intro q i p rad hden A X e hcenterNorm + dsimp [e] + rw [Complex.norm_div, Complex.norm_real, + Real.norm_eq_abs, abs_of_pos hden, hcenterNorm] + exact div_self (ne_of_gt hden) + +private theorem heSq : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let p (a : Fin 4) : ℂ := (q + a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let A : ℂ := p i.succ + let X : ℂ := p 0 + let e : ℂ := (X - A) / ((rad i.succ + rad 0 : ℝ) : ℂ) + (‖e‖ = 1) → (Complex.normSq e = 1) ) := by + classical + intro q i p rad A X e heNorm + rw [Complex.normSq_eq_norm_sq, heNorm] + norm_num + +private theorem hv₁ : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ((0 : ℤ) < (q + i.succ).1) → ( + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let j : Fin 3 := i + 1 + let k : Fin 3 := i + 2 + (0 < (q i.succ).1) → ((0 < rad i.succ) → (((q i.succ).1 < (q 0).1) → ((rad 0 < rad i.succ) → + ((0 < rad i.succ + rad 0) → ((j ≠ i) → ((k ≠ i) → ((j ≠ k) → ((0 < (q j.succ).1 ∨ (q + j.succ).1 = 0) → ((0 < (q k.succ).1 ∨ (q k.succ).1 = 0) → ((¬ ((q j.succ).1 = 0 ∧ (q + k.succ).1 = 0)) → ((dist (p 0) (p i.succ) = rad 0 + rad i.succ) → ((0 ≤ (q j.succ).1 ∧ 0 + ≤ (q k.succ).1) → ( + let A : ℂ := p i.succ + let X : ℂ := p 0 + let e : ℂ := (X - A) / ((rad i.succ + rad 0 : ℝ) : ℂ) + (‖X - A‖ = rad i.succ + rad 0) → ((‖e‖ = 1) → ((Complex.normSq e = 1) → (((q i.succ).1 ≠ + 0) → + ( + let v₁ : ℂ := P5023T1ContactVertices L q (i + 1) + v₁ = if (q k.succ).1 = 0 then ⟨if (q k.succ).2 = -1 then L else L + 2, (p i.succ).im⟩ else + ((q i.succ).2 + (q k.succ).2 : ℂ) / (((q i.succ).1 : ℝ) + ((q k.succ).1 : + ℝ)))))))))))))))))))) ) := by + classical + intro L q i hpos p rad j k hparent hr hless hRr hden hji hki hjk hjpos hkpos hnotbothzero + hchild_parent hside_nonneg A X e hcenterNorm heNorm heSq hparne v₁ + fin_cases i + · have hp : (q (1 : Fin 4)).1 ≠ 0 := by simpa using hparne + simp [v₁, P5023T1ContactVertices, p, k, hp, add_comm] + · have hp : (q (2 : Fin 4)).1 ≠ 0 := by simpa using hparne + simp [v₁, P5023T1ContactVertices, p, k, hp, add_comm] + · have hp : (q (3 : Fin 4)).1 ≠ 0 := by simpa using hparne + simp [v₁, P5023T1ContactVertices, p, k, hp, add_comm] + +private theorem hv₂ : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ((0 : ℤ) < (q + i.succ).1) → ( + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let j : Fin 3 := i + 1 + let k : Fin 3 := i + 2 + (0 < (q i.succ).1) → ((0 < rad i.succ) → (((q i.succ).1 < (q 0).1) → ((rad 0 < rad i.succ) → + ((0 < rad i.succ + rad 0) → ((j ≠ i) → ((k ≠ i) → ((j ≠ k) → ((0 < (q j.succ).1 ∨ (q + j.succ).1 = 0) → ((0 < (q k.succ).1 ∨ (q k.succ).1 = 0) → ((¬ ((q j.succ).1 = 0 ∧ (q + k.succ).1 = 0)) → ((dist (p 0) (p i.succ) = rad 0 + rad i.succ) → ((0 ≤ (q j.succ).1 ∧ 0 + ≤ (q k.succ).1) → ( + let A : ℂ := p i.succ + let X : ℂ := p 0 + let e : ℂ := (X - A) / ((rad i.succ + rad 0 : ℝ) : ℂ) + (‖X - A‖ = rad i.succ + rad 0) → ((‖e‖ = 1) → ((Complex.normSq e = 1) → (((q i.succ).1 ≠ + 0) → + ( + let v₁ : ℂ := P5023T1ContactVertices L q (i + 1) + let v₂ : ℂ := P5023T1ContactVertices L q (i + 2) + (v₁ = if (q k.succ).1 = 0 then ⟨if (q k.succ).2 = -1 then L else L + 2, (p i.succ).im⟩ else + ((q i.succ).2 + (q k.succ).2 : ℂ) / (((q i.succ).1 : ℝ) + ((q k.succ).1 : ℝ))) → (v₂ = if + (q j.succ).1 = 0 then ⟨if (q j.succ).2 = -1 then L else L + 2, (p i.succ).im⟩ else ((q + i.succ).2 + (q j.succ).2 : ℂ) / (((q i.succ).1 : ℝ) + ((q j.succ).1 : + ℝ))))))))))))))))))))) ) := by + classical + intro L q i hpos p rad j k hparent hr hless hRr hden hji hki hjk hjpos hkpos hnotbothzero + hchild_parent hside_nonneg A X e hcenterNorm heNorm heSq hparne v₁ v₂ hv₁ + fin_cases i + · have hp : (q (1 : Fin 4)).1 ≠ 0 := by simpa using hparne + simp [v₂, P5023T1ContactVertices, p, j, hp, add_comm] + · have hp : (q (2 : Fin 4)).1 ≠ 0 := by simpa using hparne + simp [v₂, P5023T1ContactVertices, p, j, hp] + · have hp : (q (3 : Fin 4)).1 ≠ 0 := by simpa using hparne + simp [v₂, P5023T1ContactVertices, p, j, hp, add_comm] + +private theorem ht0 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let rad (a : Fin 4) : ℝ := 1 / + ((q a).1 : ℝ) + (rad 0 < rad i.succ) → ((0 < rad i.succ + rad 0) → ( + let t : ℝ := (rad i.succ - rad 0) / (rad + i.succ + rad 0) + 0 ≤ t)) ) := by + classical + intro q i rad hRr hden t + dsimp [t] + exact (div_nonneg (sub_nonneg.mpr hRr.le) hden.le) + +private theorem ht1 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let rad (a : Fin 4) : ℝ := 1 / + ((q a).1 : ℝ) + (0 < rad 0) → ((0 < rad i.succ + rad 0) → ( + let t : ℝ := (rad i.succ - rad 0) / (rad i.succ + + rad 0) + t ≤ 1)) ) := by + classical + intro q i rad hR hden t + dsimp [t] + rw [div_le_one hden] + linarith + +private theorem normSqSubDot : + (by + classical + exact + let dot (x y : ℂ) : ℝ := x.re * y.re + x.im * y.im + ∀ (x : ℂ), ∀ (y : ℂ), (Complex.normSq : ℂ → ℝ) (x - y) = (Complex.normSq : ℂ → ℝ) x + + (Complex.normSq + : ℂ → ℝ) y - (2 : ℝ) * dot x y ) := by + classical + intro dot x y + rw [Complex.normSq_sub] + simp [dot, Complex.mul_re, Complex.conj_re, Complex.conj_im] + +private theorem dotDiv : + (by + classical + exact + let dot (x y : ℂ) : ℝ := x.re * y.re + x.im * y.im + ∀ (x : ℂ), ∀ (y : ℂ), ∀ (c : ℝ), ∀ (d : ℝ), c ≠ (0 : ℝ) → d ≠ (0 : ℝ) → dot (x / (↑c : + ℂ)) (y / (↑d : ℂ)) = dot x + y / (c * d) ) := by + classical + intro dot x y c d hc hd + rw [Complex.div_ofReal, Complex.div_ofReal] + simp [dot] + field_simp + + +private theorem hne4 : + (by + classical + exact + (Fin (4 : ℕ) → CircleCoordinates) → (∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : ℕ)), (a ≠ i) → + (a.succ ≠ i.succ)) ) := by + classical + intro q i a hne h + have hv := congrArg Fin.val h + simp only [Fin.val_succ] at hv + have heq : a.val = i.val := by omega + exact hne (Fin.ext heq) + +private theorem hrel : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : + ℕ)), + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + (0 < (q i.succ).1) → ( + let A : ℂ := p i.succ + ((q i.succ).1 ≠ 0) → ( + let V (a : Fin 3) : ℂ := + if (q a.succ).1 = 0 then + ⟨if (q a.succ).2 = -1 then L else L + 2, A.im⟩ + else + ((q i.succ).2 + (q a.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q a.succ).1 : ℝ)) + ((0 : ℤ) < (q a.succ).1) → ((0 < (q a.succ).1) → (V a - A = ((q a.succ).1 : ℂ) / ((((q + i.succ).1 + (q a.succ).1 : ℤ) : ℂ)) * (p a.succ - A))))) ) := by + classical + intro L q i a p hparent A hparne V hapos haposZ + dsimp [V, A, p] + rw [ite_eq_right haposZ.ne'] + push_cast + have hsumZ : (q i.succ).1 + (q a.succ).1 ≠ 0 := by omega + have hsumC : ((q i.succ).1 : ℂ) + (q a.succ).1 ≠ 0 := by + exact_mod_cast hsumZ + have hkiC : ((q i.succ).1 : ℂ) ≠ 0 := by exact_mod_cast hparne + have hkaC : ((q a.succ).1 : ℂ) ≠ 0 := by exact_mod_cast haposZ.ne' + field_simp [hkiC, hkaC, hsumC]; ring + +private theorem hsumRad : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : ℕ)), + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + (0 < (q i.succ).1) → (((0 : ℤ) < (q a.succ).1) → (rad i.succ + rad a.succ = (((q i.succ).1 + + (q a.succ).1 : ℤ) : ℝ) / (((q i.succ).1 * (q + a.succ).1 : ℤ) : ℝ))) ) := by + classical + intro q i a rad hparent hapos + dsimp [rad] + push_cast + have hsumZ : (q i.succ).1 + (q a.succ).1 ≠ 0 := by omega + field_simp [hparent.ne', hapos.ne', hsumZ]; ring + +private theorem hunitEq : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : + ℕ)), + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + (0 < (q i.succ).1) → ( + let A : ℂ := p i.succ + ((q i.succ).1 ≠ 0) → ( + let V (a : Fin 3) : ℂ := + if (q a.succ).1 = 0 then + ⟨if (q a.succ).2 = -1 then L else L + 2, A.im⟩ + else + ((q i.succ).2 + (q a.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q a.succ).1 : ℝ)) + ((0 : ℤ) < (q a.succ).1) → ((0 < (q a.succ).1) → ((V a - A = ((q a.succ).1 : ℂ) / ((((q + i.succ).1 + (q a.succ).1 : ℤ) : ℂ)) * (p a.succ - A)) → ((rad i.succ + rad a.succ = (((q + i.succ).1 + (q a.succ).1 : ℤ) : ℝ) / (((q i.succ).1 * (q a.succ).1 : ℤ) : ℝ)) → ((V a - + A) / (rad i.succ : ℂ) = (p a.succ - A) / ((rad i.succ + rad a.succ : ℝ) : ℂ))))))) ) := by + classical + intro L q i a p rad hparent A hparne V hapos haposZ hrel hsumRad + rw [hrel] + rw [hsumRad] + dsimp [rad] + push_cast + have hsumZ : (q i.succ).1 + (q a.succ).1 ≠ 0 := by omega + field_simp [hparent.ne', hapos.ne', hsumZ] + + +private theorem hdistParent : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : ℕ)), + let p (a : + Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let A : ℂ := p i.succ + (dist (p a.succ) (p i.succ) = rad a.succ + rad i.succ) → (‖p a.succ - A‖ = rad i.succ + rad + a.succ) ) := by + classical + intro q i a p rad A hcenter + rw [dist_eq_norm] at hcenter + simpa [A, add_comm] using hcenter + +private theorem hunitNorm : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : + ℕ)), + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + (0 < (q i.succ).1) → ( + let A : ℂ := p i.succ + let V (a : Fin 3) : ℂ := + if (q a.succ).1 = 0 then + ⟨if (q a.succ).2 = -1 then L else L + 2, A.im⟩ + else + ((q i.succ).2 + (q a.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q a.succ).1 : ℝ)) + ((0 : ℤ) < (q a.succ).1) → (((V a - A) / (rad i.succ : ℂ) = (p a.succ - A) / ((rad i.succ + + rad a.succ : ℝ) : ℂ)) → ((‖p a.succ - A‖ = rad i.succ + rad a.succ) → (‖(V a - A) / (rad + i.succ : ℂ)‖ = 1)))) ) := by + classical + intro L q i a p rad hparent A V hapos hunitEq hdistParent + rw [hunitEq, Complex.norm_div, hdistParent, Complex.norm_real, + Real.norm_eq_abs, abs_of_pos (by positivity : 0 < rad i.succ + rad a.succ)] + exact div_self (ne_of_gt (by positivity : 0 < rad i.succ + rad a.succ)) + +private theorem hunitSqAt360 : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : + ℕ)), + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let A : ℂ := p i.succ + let V (a : Fin 3) : ℂ := + if (q a.succ).1 = 0 then + ⟨if (q a.succ).2 = -1 then L else L + 2, A.im⟩ + else + ((q i.succ).2 + (q a.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q a.succ).1 : ℝ)) + (‖(V a - A) / (rad i.succ : ℂ)‖ = 1) → (Complex.normSq ((V a - A) / (rad i.succ : ℂ)) = + 1) ) := by + classical + intro L q i a p rad A V hunitNorm + rw [Complex.normSq_eq_norm_sq, hunitNorm] + norm_num + +private theorem hX : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (Fin (3 : ℕ)) → ( + let p (a : Fin + 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + (dist (p 0) (p i.succ) = rad 0 + rad i.succ) → ( + let A : ℂ := p i.succ + let X : ℂ := p 0 + Complex.normSq (X - A) = (rad i.succ + rad 0) ^ 2)) ) := by + classical + intro q i a p rad hchild_parent A X + rw [Complex.normSq_eq_norm_sq, ← dist_eq_norm] + have hh := congrArg (fun x : ℝ => x ^ 2) hchild_parent + simpa [X, A, add_comm] using hh + +private theorem hBX : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (a : Fin (3 : ℕ)), + let p (a : Fin 4) : ℂ := (q + a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + (dist (p a.succ) (p 0) = rad a.succ + rad 0) → ( + let X : ℂ := p 0 + Complex.normSq (p a.succ - X) = (rad a.succ + rad 0) ^ 2) ) := by + classical + intro q a p rad hchild X + rw [Complex.normSq_eq_norm_sq, ← dist_eq_norm] + have hh := congrArg (fun x : ℝ => x ^ 2) hchild + simpa [X] using hh + +private theorem hdotAt373 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : ℕ)), + let p (a : + Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let dot (x y : ℂ) : ℝ := x.re * y.re + x.im * y.im + let A : ℂ := p i.succ + let X : ℂ := p 0 + (∀ (x : ℂ), ∀ (y : ℂ), Complex.normSq (x - y) = Complex.normSq x + Complex.normSq y - 2 * + dot + x y) → ((Complex.normSq (p a.succ - A) = (rad i.succ + rad a.succ) ^ 2) → + ((Complex.normSq (X - A) = (rad i.succ + rad 0) ^ 2) → ((Complex.normSq (p a.succ - X) = + (rad a.succ + rad 0) ^ 2) → (dot (p a.succ - A) (X - A) = ((rad i.succ + rad a.succ) ^ 2 + + (rad i.succ + rad 0) ^ 2 - (rad a.succ + rad 0) ^ 2) / 2)))) ) := by + classical + intro q i a p rad dot A X normSqSubDot hA hX hBX + have hsub : (p a.succ - A) - (X - A) = p a.succ - X := by ring + have hdiff : Complex.normSq ((p a.succ - A) - (X - A)) = + (rad a.succ + rad 0) ^ 2 := by + rw [hsub, hBX] + have hformula := normSqSubDot (p a.succ - A) (X - A) + rw [hA, hX] at hformula + rw [hdiff] at hformula + linear_combination hformula / 2 + +private theorem hdotUnit : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : + ℕ)), + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + (0 < (q i.succ).1) → ((0 < rad i.succ + rad 0) → ( + let dot (x y : ℂ) : ℝ := x.re * y.re + x.im + * y.im + let A : ℂ := p i.succ + let X : ℂ := p 0 + let e : ℂ := (X - A) / ((rad i.succ + rad 0 : ℝ) : ℂ) + let V (a : Fin 3) : ℂ := + if (q a.succ).1 = 0 then + ⟨if (q a.succ).2 = -1 then L else L + 2, A.im⟩ + else + ((q i.succ).2 + (q a.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q a.succ).1 : ℝ)) + (∀ (x : ℂ), ∀ (y : ℂ), ∀ (c : ℝ), ∀ (d : ℝ), (c ≠ 0) → ((d ≠ 0) → (dot (x / (c : ℂ)) (y / (d + : ℂ)) = dot x y / (c * d)))) → (((0 : ℤ) < (q a.succ).1) → (((V a - A) / (rad i.succ : ℂ) + = (p a.succ - A) / ((rad i.succ + rad a.succ : ℝ) : ℂ)) → (dot ((V a - A) / (rad i.succ : + ℂ)) e = dot (p a.succ - A) (X - A) / ((rad i.succ + rad a.succ) * (rad i.succ + rad + 0))))))) ) := by + classical + intro L q i a p rad hparent hden dot A X e V dotDiv hapos hunitEq + rw [hunitEq] + dsimp [e] + exact dotDiv (p a.succ - A) (X - A) (rad i.succ + rad a.succ) + (rad i.succ + rad 0) (by positivity) (ne_of_gt hden) + +private theorem hextra : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : ℕ)), + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + (dist (p a.succ) (p 0) = rad a.succ + rad 0) → ((0 < (q i.succ).1) → ((0 < rad 0) → ((0 < + (rad i.succ + rad a.succ) * (rad i.succ + rad 0)) → (0 < (2 * rad i.succ * rad 0) / ((rad + i.succ + rad a.succ) * (rad i.succ + rad 0)))))) ) := by + classical + intro q i a p rad hchild hparent hR hposden + exact div_pos (by positivity) hposden + +private theorem hid : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : ℕ)), + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + (0 < (q i.succ).1) → ((0 < rad i.succ + rad 0) → ( + let t : ℝ := (rad i.succ - rad 0) / (rad i.succ + rad 0) + ((0 : ℤ) < (q a.succ).1) → ((((rad i.succ + rad a.succ) ^ 2 + (rad i.succ + rad 0) ^ 2 - + (rad + a.succ + rad 0) ^ 2) / 2) / + ((rad i.succ + rad a.succ) * (rad i.succ + rad 0)) = t + 2 * rad i.succ * rad 0 / ((rad + i.succ + rad a.succ) * (rad i.succ + rad 0))))) ) := by + classical + intro q i a rad hparent hden t hapos + dsimp [t] + have hdenA : 0 < rad i.succ + rad a.succ := by positivity + field_simp [ne_of_gt hden, ne_of_gt hdenA]; ring + +private theorem signedDistance : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (P4828T1LineSupport L q) → (∀ (a : Fin + (3 : ℕ)), + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + ((q a.succ).1 = (0 : ℤ)) → ( + let H : ℝ := if (q a.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q a.succ).2 = -1 then 1 else -1 + ((q a.succ).2 = (-1 : GaussianInt) ∨ (q a.succ).2 = (1 : GaussianInt)) → (∀ (b : Fin (4 : + ℕ)), (0 : ℤ) < (q b).1 → σ * ((p b).re - H) = rad b))) ) := by + classical + intro L q hs a p rad hazero H σ hnormal b hb + have hsgn := hs.signed a.succ b hazero hb + have hbcne : (q b).1 ≠ 0 := ne_of_gt hb + have hpre : (p b).re = (q b).2.re / (q b).1 := by + dsimp [p] + rw [Complex.div_re] + simp + field_simp [hbcne] + have hbre : ((q b).2 : ℂ).re = (q b).2.re := by norm_num + by_cases hneg : (q a.succ).2 = -1 + · rw [hneg] at hsgn + norm_num at hsgn + rw [hbre] at hsgn + simp only [H, σ, hneg, ite_eq_left, one_mul, rad] + rw [hpre] + field_simp [hbcne] + nlinarith only [hsgn] + · have hposLine : (q a.succ).2 = 1 := by + rcases hnormal with hn | hp + · exact (hneg hn).elim + · exact hp + rw [hposLine] at hsgn + norm_num at hsgn + rw [hbre] at hsgn + simp only [H, σ, hneg, ite_false, neg_one_mul, rad] + rw [hpre] + field_simp [hbcne] + nlinarith only [hsgn] + +private theorem hσsq : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (a : Fin (3 : ℕ)), + let σ : ℝ := if (q a.succ).2 = -1 then 1 else -1 + σ * σ = 1 ) := by + classical + intro q a σ + dsimp [σ] + split_ifs <;> norm_num + +private theorem hcontact : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : + ℕ)), + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + (0 < rad i.succ) → ( + let A : ℂ := p i.succ + let V (a : Fin 3) : ℂ := + if (q a.succ).1 = 0 then + ⟨if (q a.succ).2 = -1 then L else L + 2, A.im⟩ + else + ((q i.succ).2 + (q a.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q a.succ).1 : ℝ)) + let H : ℝ := if (q a.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q a.succ).2 = -1 then 1 else -1 + ((q a.succ).2 = (-1 : GaussianInt) ∨ (q a.succ).2 = (1 : GaussianInt)) → ((σ * ((p + i.succ).re + - H) = rad i.succ) → ((V a = ⟨H, A.im⟩) → ((V a - A) / (rad i.succ : ℂ) = (-σ : ℂ))))) ) + := by + classical + intro L q i a p rad hr A V H σ hnormal hAline hVline + have hdiff : V a - A = (-(σ * rad i.succ) : ℝ) := by + apply Complex.ext + · rw [hVline] + simp only [Complex.sub_re, Complex.ofReal_re] + rcases hnormal with hneg | hposLine + · have hH : H = L := by simp [H, hneg] + have hS : σ = 1 := by simp [σ, hneg] + rw [hH, hS] at hAline ⊢ + nlinarith [hAline] + · have hnotneg : (q a.succ).2 ≠ -1 := by + rw [hposLine] + norm_num + have hH : H = L + 2 := by simp [H, hnotneg] + have hS : σ = -1 := by simp [σ, hnotneg] + rw [hH, hS] at hAline ⊢ + linear_combination hAline + · rw [hVline] + simp only [Complex.sub_im, Complex.ofReal_im, sub_self] + rw [hdiff] + push_cast + have hrC : (rad i.succ : ℂ) ≠ 0 := by exact_mod_cast (ne_of_gt hr) + field_simp [hrC] + + +private theorem hunitSqAt473 : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : + ℕ)), + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let A : ℂ := p i.succ + let V (a : Fin 3) : ℂ := + if (q a.succ).1 = 0 then + ⟨if (q a.succ).2 = -1 then L else L + 2, A.im⟩ + else + ((q i.succ).2 + (q a.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q a.succ).1 : ℝ)) + let σ : ℝ := if (q a.succ).2 = -1 then 1 else -1 + (σ * σ = 1) → (((V a - A) / (rad i.succ : ℂ) = (-σ : ℂ)) → (Complex.normSq ((V a - A) / (rad + i.succ : ℂ)) = 1)) ) := by + classical + intro L q i a p rad A V σ hσsq hcontact + rw [hcontact] + simp [Complex.normSq_apply, hσsq] + +private theorem hdiffSigned : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : + ℕ)), + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let A : ℂ := p i.succ + let X : ℂ := p 0 + let H : ℝ := if (q a.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q a.succ).2 = -1 then 1 else -1 + (σ * ((p i.succ).re - H) = rad i.succ) → ((σ * ((p (0 : Fin (4 : ℕ))).re - H) = rad (0 : Fin + (4 : ℕ))) → (σ * ((X.re) - A.re) = rad 0 - rad i.succ)) ) := by + classical + intro L q i a p rad A X H σ hAline hXline + calc + σ * (X.re - A.re) = σ * (X.re - H) - σ * (A.re - H) := by ring + _ = rad 0 - rad i.succ := by rw [hXline, hAline] + +private theorem hdotSigned : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : ℕ)), + let p (a : + Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let A : ℂ := p i.succ + let X : ℂ := p 0 + let σ : ℝ := if (q a.succ).2 = -1 then 1 else -1 + (σ * ((X.re) - A.re) = rad 0 - rad i.succ) → ((-σ) * (X.re - A.re) = rad i.succ - rad 0) + ) := by + classical + intro q i a p rad A X σ hdiffSigned + calc + (-σ) * (X.re - A.re) = -(σ * (X.re - A.re)) := by ring + _ = -(rad 0 - rad i.succ) := by rw [hdiffSigned] + _ = rad i.succ - rad 0 := by abel + +private theorem hdotAt485 : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : + ℕ)), + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let dot (x y : ℂ) : ℝ := x.re * y.re + x.im * y.im + let A : ℂ := p i.succ + let X : ℂ := p 0 + let e : ℂ := (X - A) / ((rad i.succ + rad 0 : ℝ) : ℂ) + let V (a : Fin 3) : ℂ := + if (q a.succ).1 = 0 then + ⟨if (q a.succ).2 = -1 then L else L + 2, A.im⟩ + else + ((q i.succ).2 + (q a.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q a.succ).1 : ℝ)) + let t : ℝ := (rad i.succ - rad 0) / (rad i.succ + rad 0) + let σ : ℝ := if (q a.succ).2 = -1 then 1 else -1 + ((V a - A) / (rad i.succ : ℂ) = (-σ : ℂ)) → (((-σ) * (X.re - A.re) = rad i.succ - rad 0) → + (dot ((V a - A) / (rad i.succ : ℂ)) e = t)) ) := by + classical + intro L q i a p rad dot A X e V t σ hcontact hdotSigned + rw [hcontact] + dsimp [e] + have hdotDiv : dot (-σ : ℂ) ((X - A) / ((rad i.succ + rad 0 : ℝ) : ℂ)) = + ((-σ) * (X.re - A.re)) / (rad i.succ + rad 0) := by + rw [Complex.div_ofReal] + simp [dot, Complex.ofReal_re, Complex.ofReal_im]; ring + rw [hdotDiv] + dsimp [t] + rw [hdotSigned] + +private theorem hn₁ : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let p (a : Fin 4) : + ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let k : Fin 3 := i + 2 + let dot (x y : ℂ) : ℝ := x.re * y.re + x.im * y.im + let A : ℂ := p i.succ + let X : ℂ := p 0 + let e : ℂ := (X - A) / ((rad i.succ + rad 0 : ℝ) : ℂ) + let v₁ : ℂ := P5023T1ContactVertices L q (i + 1) + let V (a : Fin 3) : ℂ := + if (q a.succ).1 = 0 then + ⟨if (q a.succ).2 = -1 then L else L + 2, A.im⟩ + else + ((q i.succ).2 + (q a.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q a.succ).1 : ℝ)) + (v₁ = V k) → ( + let t : ℝ := (rad i.succ - rad 0) / (rad i.succ + rad 0) + ((Complex.normSq : ℂ → ℝ) ((V k - A) / (↑(rad i.succ) : ℂ)) = (1 : ℝ) ∧ t ≤ dot ((V k - A) / + (↑(rad i.succ) : ℂ)) e) → (Complex.normSq ((v₁ - A) / (rad i.succ : ℂ)) = 1)) ) := by + classical + intro L q i p rad k dot A X e v₁ V hv₁V t hkfacts + rw [hv₁V] + exact hkfacts.1 + +private theorem hn₂ : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let p (a : Fin 4) : + ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let j : Fin 3 := i + 1 + let dot (x y : ℂ) : ℝ := x.re * y.re + x.im * y.im + let A : ℂ := p i.succ + let X : ℂ := p 0 + let e : ℂ := (X - A) / ((rad i.succ + rad 0 : ℝ) : ℂ) + let v₂ : ℂ := P5023T1ContactVertices L q (i + 2) + let V (a : Fin 3) : ℂ := + if (q a.succ).1 = 0 then + ⟨if (q a.succ).2 = -1 then L else L + 2, A.im⟩ + else + ((q i.succ).2 + (q a.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q a.succ).1 : ℝ)) + (v₂ = V j) → ( + let t : ℝ := (rad i.succ - rad 0) / (rad i.succ + rad 0) + ((Complex.normSq : ℂ → ℝ) ((V j - A) / (↑(rad i.succ) : ℂ)) = (1 : ℝ) ∧ t ≤ dot ((V j - A) / + (↑(rad i.succ) : ℂ)) e) → (Complex.normSq ((v₂ - A) / (rad i.succ : ℂ)) = 1)) ) := by + classical + intro L q i p rad j dot A X e v₂ V hv₂V t hjfacts + rw [hv₂V] + exact hjfacts.1 + +private theorem hdot₁ : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let p (a : Fin 4) : + ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let k : Fin 3 := i + 2 + let dot (x y : ℂ) : ℝ := x.re * y.re + x.im * y.im + let A : ℂ := p i.succ + let X : ℂ := p 0 + let e : ℂ := (X - A) / ((rad i.succ + rad 0 : ℝ) : ℂ) + let v₁ : ℂ := P5023T1ContactVertices L q (i + 1) + let V (a : Fin 3) : ℂ := + if (q a.succ).1 = 0 then + ⟨if (q a.succ).2 = -1 then L else L + 2, A.im⟩ + else + ((q i.succ).2 + (q a.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q a.succ).1 : ℝ)) + (v₁ = V k) → ( + let t : ℝ := (rad i.succ - rad 0) / (rad i.succ + rad 0) + ((Complex.normSq : ℂ → ℝ) ((V k - A) / (↑(rad i.succ) : ℂ)) = (1 : ℝ) ∧ t ≤ dot ((V k - A) / + (↑(rad i.succ) : ℂ)) e) → (t ≤ dot ((v₁ - A) / (rad i.succ : ℂ)) e)) ) := by + classical + intro L q i p rad k dot A X e v₁ V hv₁V t hkfacts + rw [hv₁V] + exact hkfacts.2 + +private theorem hdot₂ : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let p (a : Fin 4) : + ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let j : Fin 3 := i + 1 + let dot (x y : ℂ) : ℝ := x.re * y.re + x.im * y.im + let A : ℂ := p i.succ + let X : ℂ := p 0 + let e : ℂ := (X - A) / ((rad i.succ + rad 0 : ℝ) : ℂ) + let v₂ : ℂ := P5023T1ContactVertices L q (i + 2) + let V (a : Fin 3) : ℂ := + if (q a.succ).1 = 0 then + ⟨if (q a.succ).2 = -1 then L else L + 2, A.im⟩ + else + ((q i.succ).2 + (q a.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q a.succ).1 : ℝ)) + (v₂ = V j) → ( + let t : ℝ := (rad i.succ - rad 0) / (rad i.succ + rad 0) + ((Complex.normSq : ℂ → ℝ) ((V j - A) / (↑(rad i.succ) : ℂ)) = (1 : ℝ) ∧ t ≤ dot ((V j - A) / + (↑(rad i.succ) : ℂ)) e) → (t ≤ dot ((v₂ - A) / (rad i.succ : ℂ)) e)) ) := by + classical + intro L q i p rad j dot A X e v₂ V hv₂V t hjfacts + rw [hv₂V] + exact hjfacts.2 + +private theorem hchord : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let p (a : Fin 4) : + ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let dot (x y : ℂ) : ℝ := x.re * y.re + x.im * y.im + (∀ (x : ℂ), ∀ (y : ℂ), ∀ (e : ℂ), ∀ (t : ℝ), (Complex.normSq x = 1) → ((Complex.normSq y + = 1) + → ((Complex.normSq e = 1) → ((0 ≤ t) → ((t ≤ 1) → ((t ≤ dot x e) → ((t ≤ dot y e) → (‖x - + y‖ ≤ 2 * Real.sqrt (1 - t ^ 2))))))))) → ( + let A : ℂ := p i.succ + let X : ℂ := p 0 + let e : ℂ := (X - A) / ((rad i.succ + rad 0 : ℝ) : ℂ) + (Complex.normSq e = 1) → ( + let v₁ : ℂ := P5023T1ContactVertices L q (i + 1) + let v₂ : ℂ := P5023T1ContactVertices L q (i + 2) + let t : ℝ := (rad i.succ - rad 0) / (rad i.succ + rad 0) + (0 ≤ t) → ((t ≤ 1) → ((Complex.normSq ((v₁ - A) / (rad i.succ : ℂ)) = 1) → ((Complex.normSq + ((v₂ - A) / (rad i.succ : ℂ)) = 1) → ((t ≤ dot ((v₁ - A) / (rad i.succ : ℂ)) e) → ((t ≤ + dot ((v₂ - A) / (rad i.succ : ℂ)) e) → (‖(v₁ - A) / (rad i.succ : ℂ) - (v₂ - A) / (rad + i.succ : ℂ)‖ ≤ 2 * Real.sqrt (1 - t ^ 2))))))))) ) := by + classical + intro L q i p rad dot capBound A X e heSq v₁ v₂ t ht0 ht1 hn₁ hn₂ hdot₁ hdot₂ + exact capBound _ _ e t hn₁ hn₂ heSq ht0 ht1 hdot₁ hdot₂ + +private theorem hscale : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + let p (a : Fin 4) : + ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + (0 < rad i.succ) → ( + let A : ℂ := p i.succ + let v₁ : ℂ := P5023T1ContactVertices L q (i + 1) + let v₂ : ℂ := P5023T1ContactVertices L q (i + 2) + (∀ (x : ℝ), x / rad i.succ * rad i.succ = x) → (dist (P5023T1ContactVertices L q (i + 1)) + (P5023T1ContactVertices L q (i + 2)) = rad i.succ * ‖(v₁ - A) / (rad i.succ : ℂ) - (v₂ + - A) / (rad i.succ : ℂ)‖)) ) := by + classical + intro L q i p rad hr A v₁ v₂ cancelRadius + change dist v₁ v₂ = rad i.succ * + ‖(v₁ - A) / (rad i.succ : ℂ) - (v₂ - A) / (rad i.succ : ℂ)‖ + rw [dist_eq_norm] + have hrC : (rad i.succ : ℂ) ≠ 0 := by exact_mod_cast (ne_of_gt hr) + have hdiff : (v₁ - A) / (rad i.succ : ℂ) - (v₂ - A) / (rad i.succ : ℂ) = + (v₁ - v₂) / (rad i.succ : ℂ) := by + field_simp [hrC]; ring + rw [hdiff, Complex.norm_div, Complex.norm_real, Real.norm_eq_abs, + abs_of_pos hr] + calc + ‖v₁ - v₂‖ = (‖v₁ - v₂‖ / rad i.succ) * rad i.succ := + (cancelRadius _).symm + _ = rad i.succ * (‖v₁ - v₂‖ / rad i.succ) := mul_comm _ _ + +end CircularSideProof + +theorem P5023T1CircularSide : + ∀ (L : ℝ), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → + ((P4828T1LineSupport L q) → ((P4828T1Disk (q 0) ⊆ P4828T1Gap L q) → (∀ (i : Fin 3), + (0 < (q i.succ).1) → (let r : ℝ := 1 / ((q i.succ).1 : ℝ) + let R : ℝ := 1 / ((q 0).1 : ℝ) + dist (P5023T1ContactVertices L q (i + 1)) + (P5023T1ContactVertices L q (i + 2)) ≤ + 2 * r * Real.sqrt (1 - ((r - R) / (r + R)) ^ 2))))) := by + intro L q hq hs hi i hpos +-- BODY + exact ((show + (let r : ℝ := 1 / ((q i.succ).1 : ℝ) + let R : ℝ := 1 / ((q 0).1 : ℝ) + dist (P5023T1ContactVertices L q (i + 1)) + (P5023T1ContactVertices L q (i + 2)) ≤ + 2 * r * Real.sqrt (1 - ((r - R) / (r + R)) ^ 2)) from by + dsimp only [] + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let j : Fin 3 := i + 1 + let k : Fin 3 := i + 2 + have curv := ProperBandCurvatureStructure q hq + have hchild : 0 < (q 0).1 := curv.1 + have hparent : 0 < (q i.succ).1 := hpos + have hR : 0 < rad 0 := CircularSideProof.hR q hchild + have hr : 0 < rad i.succ := CircularSideProof.hr q i hparent + have hless : (q i.succ).1 < (q 0).1 := hq.2 i + have hRr : rad 0 < rad i.succ := CircularSideProof.hRr q i hparent hless + have hden : 0 < rad i.succ + rad 0 := by linarith + have other_nonneg : ∀ a : Fin 3, 0 ≤ (q a.succ).1 := curv.2.1 + have other_unique : ∀ a b : Fin 3, (q a.succ).1 = 0 → + (q b.succ).1 = 0 → a = b := curv.2.2 + have hji : j ≠ i := by fin_cases i <;> decide + have hki : k ≠ i := by fin_cases i <;> decide + have hjk : j ≠ k := by fin_cases i <;> decide + have hjpos : 0 < (q j.succ).1 ∨ (q j.succ).1 = 0 := CircularSideProof.hjpos q i other_nonneg + have hkpos : 0 < (q k.succ).1 ∨ (q k.succ).1 = 0 := CircularSideProof.hkpos q i other_nonneg + have hnotbothzero : ¬ ((q j.succ).1 = 0 ∧ (q k.succ).1 = 0) := CircularSideProof.hnotbothzero q + i other_unique hjk + have centerDistance (a b : Fin 4) (hab : a ≠ b) + (ha : 0 < (q a).1) (hb : 0 < (q b).1) : dist (p a) (p b) = rad a + rad b := + CircularSideProof.centerDistance q hq a b hab ha hb + have hchild_parent : dist (p 0) (p i.succ) = rad 0 + rad i.succ := + CircularSideProof.hchild_parent q i hchild hparent centerDistance + have hside_nonneg : 0 ≤ (q j.succ).1 ∧ 0 ≤ (q k.succ).1 := + ⟨other_nonneg j, other_nonneg k⟩ + let dot (x y : ℂ) : ℝ := x.re * y.re + x.im * y.im + have capBound (x y e : ℂ) (t : ℝ) + (hx : Complex.normSq x = 1) (hy : Complex.normSq y = 1) + (he : Complex.normSq e = 1) (ht0 : 0 ≤ t) (ht1 : t ≤ 1) + (hxd : t ≤ dot x e) (hyd : t ≤ dot y e) : + ‖x - y‖ ≤ 2 * Real.sqrt (1 - t ^ 2) := CircularSideProof.capBound x y e t hx hy he ht0 ht1 + hxd hyd + let A : ℂ := p i.succ + let X : ℂ := p 0 + let e : ℂ := (X - A) / ((rad i.succ + rad 0 : ℝ) : ℂ) + have hcenterNorm : ‖X - A‖ = rad i.succ + rad 0 := CircularSideProof.hcenterNorm q i hchild_parent + have heNorm : ‖e‖ = 1 := CircularSideProof.heNorm q i hden hcenterNorm + have heSq : Complex.normSq e = 1 := CircularSideProof.heSq q i heNorm + have hparne : (q i.succ).1 ≠ 0 := ne_of_gt hparent + let v₁ : ℂ := P5023T1ContactVertices L q (i + 1) + let v₂ : ℂ := P5023T1ContactVertices L q (i + 2) + have hv₁ : v₁ = if (q k.succ).1 = 0 then + ⟨if (q k.succ).2 = -1 then L else L + 2, (p i.succ).im⟩ else + ((q i.succ).2 + (q k.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q k.succ).1 : ℝ)) := CircularSideProof.hv₁ L q i hpos hparent hr + hless hRr hden hji hki hjk hjpos hkpos hnotbothzero hchild_parent hside_nonneg + hcenterNorm heNorm heSq hparne + have hv₂ : v₂ = if (q j.succ).1 = 0 then + ⟨if (q j.succ).2 = -1 then L else L + 2, (p i.succ).im⟩ else + ((q i.succ).2 + (q j.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q j.succ).1 : ℝ)) := CircularSideProof.hv₂ L q i hpos hparent hr + hless hRr hden hji hki hjk hjpos hkpos hnotbothzero hchild_parent hside_nonneg + hcenterNorm heNorm heSq hparne hv₁ + let V (a : Fin 3) : ℂ := + if (q a.succ).1 = 0 then + ⟨if (q a.succ).2 = -1 then L else L + 2, A.im⟩ + else + ((q i.succ).2 + (q a.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q a.succ).1 : ℝ)) + have hv₁V : v₁ = V k := by + simp [hv₁, V, A, p] + have hv₂V : v₂ = V j := by + simp [hv₂, V, A, p] + let t : ℝ := (rad i.succ - rad 0) / (rad i.succ + rad 0) + have ht0 : 0 ≤ t := CircularSideProof.ht0 q i hRr hden + have ht1 : t ≤ 1 := CircularSideProof.ht1 q i hR hden + have normSqSubDot (x y : ℂ) : + Complex.normSq (x - y) = Complex.normSq x + Complex.normSq y - 2 * dot x y := + CircularSideProof.normSqSubDot x y + have dotDiv (x y : ℂ) (c d : ℝ) (hc : c ≠ 0) (hd : d ≠ 0) : + dot (x / (c : ℂ)) (y / (d : ℂ)) = dot x y / (c * d) := CircularSideProof.dotDiv x y c d hc hd + have contactFacts (a : Fin 3) (hne : a ≠ i) + (ha : 0 < (q a.succ).1 ∨ (q a.succ).1 = 0) : + Complex.normSq ((V a - A) / (rad i.succ : ℂ)) = 1 ∧ + t ≤ dot ((V a - A) / (rad i.succ : ℂ)) e := by + as_aux_lemma => + clear * - L q hq hs hR i p rad centerDistance normSqSubDot dotDiv hne ha + V A X e t dot hparent hchild hr hden hparne hchild_parent + rcases ha with hapos | hazero + · have haposZ : 0 < (q a.succ).1 := hapos + have hne4 : a.succ ≠ i.succ := CircularSideProof.hne4 q i a hne + have hcenter : dist (p a.succ) (p i.succ) = rad a.succ + rad i.succ := by + exact centerDistance a.succ i.succ hne4 haposZ hparent + have hchild : dist (p a.succ) (p 0) = rad a.succ + rad 0 := by + exact centerDistance a.succ 0 (by simp) haposZ hchild + have hrel : V a - A = + ((q a.succ).1 : ℂ) / + ((((q i.succ).1 + (q a.succ).1 : ℤ) : ℂ)) * + (p a.succ - A) := CircularSideProof.hrel L q i a hparent hparne hapos haposZ + have hsumRad : rad i.succ + rad a.succ = + (((q i.succ).1 + (q a.succ).1 : ℤ) : ℝ) / + (((q i.succ).1 * (q a.succ).1 : ℤ) : ℝ) := CircularSideProof.hsumRad q i a hparent + hapos + have hunitEq : (V a - A) / (rad i.succ : ℂ) = + (p a.succ - A) / ((rad i.succ + rad a.succ : ℝ) : ℂ) := CircularSideProof.hunitEq L q + i a hparent hparne hapos haposZ hrel hsumRad + have hdistParent : ‖p a.succ - A‖ = rad i.succ + rad a.succ := + CircularSideProof.hdistParent q i a hcenter + have hunitNorm : ‖(V a - A) / (rad i.succ : ℂ)‖ = 1 := CircularSideProof.hunitNorm L q i + a hparent hapos hunitEq hdistParent + have hunitSq : Complex.normSq ((V a - A) / (rad i.succ : ℂ)) = 1 := + CircularSideProof.hunitSqAt360 L q i a hunitNorm + have hA : Complex.normSq (p a.succ - A) = (rad i.succ + rad a.succ) ^ 2 := by + rw [Complex.normSq_eq_norm_sq, hdistParent] + have hX : Complex.normSq (X - A) = (rad i.succ + rad 0) ^ 2 := CircularSideProof.hX q i a + hchild_parent + have hBX : Complex.normSq (p a.succ - X) = (rad a.succ + rad 0) ^ 2 := + CircularSideProof.hBX q a hchild + have hdot : dot (p a.succ - A) (X - A) = + ((rad i.succ + rad a.succ) ^ 2 + (rad i.succ + rad 0) ^ 2 - + (rad a.succ + rad 0) ^ 2) / 2 := CircularSideProof.hdotAt373 q i a normSqSubDot hA + hX hBX + have hdotUnit : dot ((V a - A) / (rad i.succ : ℂ)) e = + dot (p a.succ - A) (X - A) / + ((rad i.succ + rad a.succ) * (rad i.succ + rad 0)) := CircularSideProof.hdotUnit L + q i a hparent hden dotDiv hapos hunitEq + constructor + · exact hunitSq + · rw [hdotUnit, hdot] + dsimp [t] + have hposden : 0 < (rad i.succ + rad a.succ) * (rad i.succ + rad 0) := by positivity + have hextra : 0 < (2 * rad i.succ * rad 0) / + ((rad i.succ + rad a.succ) * (rad i.succ + rad 0)) := CircularSideProof.hextra q i + a hchild hparent hR hposden + have hid : (((rad i.succ + rad a.succ) ^ 2 + (rad i.succ + rad 0) ^ 2 - + (rad a.succ + rad 0) ^ 2) / 2) / + ((rad i.succ + rad a.succ) * (rad i.succ + rad 0)) = + t + 2 * rad i.succ * rad 0 / + ((rad i.succ + rad a.succ) * (rad i.succ + rad 0)) := CircularSideProof.hid q i a + hparent hden hapos + rw [hid] + linarith [hextra] + · let H : ℝ := if (q a.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q a.succ).2 = -1 then 1 else -1 + have hnormal := hs.normals a.succ hazero + have signedDistance (b : Fin 4) (hb : 0 < (q b).1) : + σ * ((p b).re - H) = rad b := CircularSideProof.signedDistance L q hs a hazero + hnormal b hb + have hAline := signedDistance i.succ hparent + have hXline := signedDistance 0 hchild + have hσsq : σ * σ = 1 := CircularSideProof.hσsq q a + have hVline : V a = ⟨H, A.im⟩ := by + simp [V, H, hazero] + have hcontact : (V a - A) / (rad i.succ : ℂ) = (-σ : ℂ) := CircularSideProof.hcontact L q + i a hr hnormal hAline hVline + have hunitSq : Complex.normSq ((V a - A) / (rad i.succ : ℂ)) = 1 := + CircularSideProof.hunitSqAt473 L q i a hσsq hcontact + have hdiffSigned : σ * ((X.re) - A.re) = rad 0 - rad i.succ := + CircularSideProof.hdiffSigned L q i a hAline hXline + have hdotSigned : (-σ) * (X.re - A.re) = rad i.succ - rad 0 := + CircularSideProof.hdotSigned q i a hdiffSigned + have hdot : dot ((V a - A) / (rad i.succ : ℂ)) e = t := CircularSideProof.hdotAt485 L q i + a hcontact hdotSigned + exact ⟨hunitSq, le_of_eq hdot.symm⟩ + have hjfacts := contactFacts j hji hjpos + have hkfacts := contactFacts k hki hkpos + have hn₁ : Complex.normSq ((v₁ - A) / (rad i.succ : ℂ)) = 1 := CircularSideProof.hn₁ L q i hv₁V + hkfacts + have hn₂ : Complex.normSq ((v₂ - A) / (rad i.succ : ℂ)) = 1 := CircularSideProof.hn₂ L q i hv₂V + hjfacts + have hdot₁ : t ≤ dot ((v₁ - A) / (rad i.succ : ℂ)) e := CircularSideProof.hdot₁ L q i hv₁V hkfacts + have hdot₂ : t ≤ dot ((v₂ - A) / (rad i.succ : ℂ)) e := CircularSideProof.hdot₂ L q i hv₂V hjfacts + have hchord : ‖(v₁ - A) / (rad i.succ : ℂ) - (v₂ - A) / (rad i.succ : ℂ)‖ ≤ + 2 * Real.sqrt (1 - t ^ 2) := CircularSideProof.hchord L q i capBound heSq ht0 ht1 hn₁ hn₂ + hdot₁ hdot₂ + have cancelRadius (x : ℝ) : x / rad i.succ * rad i.succ = x := + div_mul_cancel₀ x (ne_of_gt hr) + have rearrange (x y : ℝ) : x * (2 * y) = 2 * x * y := by ring + have hscale : dist (P5023T1ContactVertices L q (i + 1)) + (P5023T1ContactVertices L q (i + 2)) = rad i.succ * + ‖(v₁ - A) / (rad i.succ : ℂ) - (v₂ - A) / (rad i.succ : ℂ)‖ := CircularSideProof.hscale L q + i hr cancelRadius + rw [hscale] + calc + rad i.succ * ‖(v₁ - A) / (rad i.succ : ℂ) - (v₂ - A) / (rad i.succ : ℂ)‖ ≤ + rad i.succ * (2 * Real.sqrt (1 - t ^ 2)) := + mul_le_mul_of_nonneg_left hchord hr.le + _ = 2 * rad i.succ * Real.sqrt (1 - t ^ 2) := + rearrange _ _ + )) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1ContactHull.lean b/LeanPool/ApollonianSuperharmonic/P5023T1ContactHull.lean new file mode 100644 index 0000000000..61b82618f8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5023T1ContactHull.lean @@ -0,0 +1,329 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5023T1ContactVertices +public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap +public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.P4953T1LiteralHulls +public import LeanPool.ApollonianSuperharmonic.P5090T1TangentCircleMetric +public import LeanPool.ApollonianSuperharmonic.P5090T1ThreeDiskContactTriangle +public import LeanPool.ApollonianSuperharmonic.P5090T1TwoDiskLineTriangle + +-- [TABLET NODE: P5023T1ContactHull] + +/-! +# P5023T1ContactHull + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ContactHullLemmas + +private theorem curv : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → 0 < (q 0).1 ∧ (∀ (i : Fin 3), 0 + ≤ (q i.succ).1) ∧ ∀ (i : Fin 3), ∀ (j : Fin 3), (q i.succ).1 = 0 → (q j.succ).1 = 0 → i = + j := by + classical + intro q hq + exact ProperBandCurvatureStructure q hq + +private theorem pair : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + ∀ (i : Fin 4), ∀ (j : Fin 4), (i ≠ j) → (0 < (q i).1) → (0 < (q j).1) → dist (p i) (p j) = r + i + r j ∧ + ((q i).2 + (q j).2 : ℂ) / (((q i).1 : ℝ) + ((q j).1 : ℝ)) = + (r j / (r i + r j)) • p i + (r i / (r i + r j)) • p j := by + classical + intro q hq p r i j hij hi hj + let w : GaussianInt := (q j).1 • (q i).2 - (q i).1 • (q j).2 + have ht := TangencyCoordinateIdentity q hq.1 i j hij + have normCast (z : GaussianInt) : + Complex.normSq (z : ℂ) = (Zsqrtd.norm z : ℝ) := by + simp [Complex.normSq, Zsqrtd.norm_def] + have hn : Complex.normSq (w : ℂ) = (((q i).1 + (q j).1 : ℤ) ^ 2 : ℝ) := by + rw [normCast] + exact_mod_cast ht + have hnsq : ‖(w : ℂ)‖ ^ 2 = (((q i).1 : ℝ) + ((q j).1 : ℝ)) ^ 2 := by + rw [← Complex.normSq_eq_norm_sq, hn] + push_cast + rfl + have hw : (w : ℂ) = ((q j).1 : ℂ) * (q i).2 - + ((q i).1 : ℂ) * (q j).2 := by + simp [w, zsmul_eq_mul] + rw [hw] at hnsq + simpa only [Complex.ofReal_add, p, r] using + P5090T1TangentCircleMetric ((q i).1 : ℝ) ((q j).1 : ℝ) + (q i).2 (q j).2 (by exact_mod_cast hi) (by exact_mod_cast hj) hnsq + +private theorem contact : + ∀ (L : ℝ), ∀ (q : Fin 4 → CircleCoordinates), + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + (∀ (i : Fin 4), ∀ (j : Fin 4), (i ≠ j) → (0 < (q i).1) → (0 < (q j).1) → dist (p i) (p j) = r + i + r j ∧ ((q i).2 + (q j).2 : ℂ) / (((q i).1 : ℝ) + ((q j).1 : ℝ)) = (r j / (r i + r j)) + • p i + (r i / (r i + r j)) • p j) → ∀ (k : Fin 3), (0 < (q (k + 1).succ).1) → (0 < (q (k + + 2).succ).1) → P5023T1ContactVertices L q k = + (r (k + 2).succ / (r (k + 1).succ + r (k + 2).succ)) • p (k + 1).succ + + (r (k + 1).succ / (r (k + 1).succ + r (k + 2).succ)) • p (k + 2).succ := by + classical + intro L q p r pair k ha hb + dsimp only [P5023T1ContactVertices] + rw [ite_eq_right (ne_of_gt ha), ite_eq_right (ne_of_gt hb)] + exact (pair _ _ (by fin_cases k <;> decide) ha hb).2 + +end ContactHullLemmas + +namespace ContactHullGeometry + +private theorem signedDistance : + ∀ (L : ℝ), ∀ (q : Fin 4 → CircleCoordinates), (P4828T1LineSupport L q) → + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + ∀ (i : Fin (3 : ℕ)), ((q i.succ).1 = (0 : ℤ)) → + let h : ℝ := if (q i.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q i.succ).2 = -1 then 1 else -1 + ∀ (c : Fin 4), (0 < (q c).1) → σ * ((p c).re - h) = r c := by + classical + intro L q hs p r i hi h σ c hc + have hh := hs.signed i.succ c hi hc + have hcne : (q c).1 ≠ 0 := ne_of_gt hc + have hpre : (p c).re = (q c).2.re / (q c).1 := by + dsimp [p] + rw [Complex.div_re] + simp + field_simp [hcne] + have hre : ((q c).2 : ℂ).re = (q c).2.re := by norm_num + by_cases hneg : (q i.succ).2 = -1 + · rw [hneg] at hh + norm_num at hh + rw [hre] at hh + simp only [σ, h, hneg, ite_eq_left, one_mul, r] + rw [hpre] + field_simp [hcne] + nlinarith + · have hn : (q i.succ).2 = 1 := by + rcases hs.normals i.succ hi with hn | hn + · exact (hneg hn).elim + · exact hn + rw [hn] at hh + norm_num at hh + rw [hre] at hh + simp only [σ, h, hneg, ite_false, neg_one_mul, r] + rw [hpre] + field_simp [hcne] + nlinarith + +end ContactHullGeometry + +theorem P5023T1ContactHull (L : ℝ) (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) (hs : P4828T1LineSupport L q) : + P4984T1ClosedGap L q ⊆ + convexHull ℝ (Set.range (P5023T1ContactVertices L q)) := by +-- BODY + classical + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + have curv := ContactHullLemmas.curv q hq + have pair (i j : Fin 4) (hij : i ≠ j) + (hi : 0 < (q i).1) (hj : 0 < (q j).1) : + dist (p i) (p j) = r i + r j ∧ + ((q i).2 + (q j).2 : ℂ) / (((q i).1 : ℝ) + ((q j).1 : ℝ)) = + (r j / (r i + r j)) • p i + (r i / (r i + r j)) • p j := ContactHullLemmas.pair q hq i j + hij hi hj + have contact (k : Fin 3) + (ha : 0 < (q (k + 1).succ).1) (hb : 0 < (q (k + 2).succ).1) : + P5023T1ContactVertices L q k = + (r (k + 2).succ / (r (k + 1).succ + r (k + 2).succ)) • p (k + 1).succ + + (r (k + 1).succ / (r (k + 1).succ + r (k + 2).succ)) • p (k + 2).succ := + ContactHullLemmas.contact L q pair k ha hb + intro z hz + rcases hz with ⟨hzPoly, hzOutside⟩ + by_cases hline : ∃ i : Fin 3, (q i.succ).1 = 0 + · obtain ⟨i, hi⟩ := hline + let j : Fin 3 := i + 1 + let k : Fin 3 := i + 2 + have hji : j ≠ i := by fin_cases i <;> decide + have hki : k ≠ i := by fin_cases i <;> decide + have hjk : j ≠ k := by fin_cases i <;> decide + have positive (a : Fin 3) (hai : a ≠ i) : 0 < (q a.succ).1 := by + have hn := curv.2.1 a + have hne : (q a.succ).1 ≠ 0 := fun h => hai (curv.2.2 a i h hi) + omega + have hj := positive j hji + have hk := positive k hki + let a := r j.succ + let b := r k.succ + have ha : 0 < a := one_div_pos.mpr (by exact_mod_cast hj) + have hb : 0 < b := one_div_pos.mpr (by exact_mod_cast hk) + let h : ℝ := if (q i.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q i.succ).2 = -1 then 1 else -1 + let A := p j.succ + let B := p k.succ + let F : ℂ := ⟨h, A.im⟩ + let G : ℂ := ⟨h, B.im⟩ + have hσsq : σ ^ 2 = 1 := by dsimp [σ]; split_ifs <;> norm_num + have signedDistance (c : Fin 4) (hc : 0 < (q c).1) : + σ * ((p c).re - h) = r c := ContactHullGeometry.signedDistance L q hs i hi c hc + let f : ℂ →ᵃ[ℝ] ℂ := + { toFun := fun x => ⟨σ * (x.re - h), x.im⟩ + linear := + { toFun := fun x => ⟨σ * x.re, x.im⟩ + map_add' := by + intro x y + apply Complex.ext <;> simp; ring + map_smul' := by + intro t x + apply Complex.ext <;> simp []; ring } + map_vadd' := by + intro x y + apply Complex.ext <;> simp; ring } + have fd (x y : ℂ) : dist (f x) (f y) = dist x y := by + rw [Complex.dist_eq_re_im, Complex.dist_eq_re_im] + congr 1 + change (σ * (x.re - h) - σ * (y.re - h)) ^ 2 + (x.im - y.im) ^ 2 = _ + rw [show σ * (x.re - h) - σ * (y.re - h) = σ * (x.re - y.re) by ring, + mul_pow, hσsq, one_mul] + have finj : Function.Injective f := by + intro x y hxy + apply dist_eq_zero.mp + rw [← fd, hxy, dist_self] + have fA : f A = (⟨a, A.im⟩ : ℂ) := by + apply Complex.ext + · exact signedDistance j.succ hj + · rfl + have fB : f B = (⟨b, B.im⟩ : ℂ) := by + apply Complex.ext + · exact signedDistance k.succ hk + · rfl + have fF : f F = (⟨0, A.im⟩ : ℂ) := by simp [f, F] + have fG : f G = (⟨0, B.im⟩ : ℂ) := by simp [f, G] + have hpoly := (P4953T1LiteralHulls L q i j k hji hki hjk hi hj hk curv.1).1 + have hzf : f z ∈ convexHull ℝ + ({⟨a, A.im⟩, ⟨b, B.im⟩, ⟨0, A.im⟩, ⟨0, B.im⟩} : Set ℂ) := by + have hz' : z ∈ convexHull ℝ ({A, B, F, G} : Set ℂ) := by + rw [← hpoly] + exact hzPoly + have himage := f.image_convexHull ({A, B, F, G} : Set ℂ) + have hm : f z ∈ f '' convexHull ℝ ({A, B, F, G} : Set ℂ) := ⟨z, hz', rfl⟩ + rw [himage] at hm + simpa only [Set.image_insert_eq, Set.image_singleton, fA, fB, fF, fG] using hm + have hAB : dist A B = a + b := + (pair _ _ (fun heq => hjk (Fin.succ_inj.mp heq)) hj hk).1 + have hheight : (A.im - B.im) ^ 2 = 4 * a * b := by + have hh := hAB + rw [← fd, fA, fB, Complex.dist_eq_re_im] at hh + have hh' := congrArg (fun x : ℝ => x ^ 2) hh + rw [Real.sq_sqrt (by positivity)] at hh' + nlinarith only [hh'] + have hheightpos : 0 < (A.im - B.im) ^ 2 := by rw [hheight]; positivity + have htri := P5090T1TwoDiskLineTriangle a b A.im B.im (f z) ha hb + (by rw [← fA, ← fB, fd]; exact hAB) hzf + (by rw [← fA, fd]; exact hzOutside j hj) + (by rw [← fB, fd]; exact hzOutside k hk) + let K := (b / (a + b)) • A + (a / (a + b)) • B + have hweights : b / (a + b) + a / (a + b) = 1 := by + field_simp; ring + have fK : f K = (b / (a + b)) • (f A) + (a / (a + b)) • (f B) := by + apply Complex.ext + · change σ * (K.re - h) = _ + simp only [K, Complex.add_re, Complex.smul_re, smul_eq_mul] + change σ * (b / (a + b) * A.re + a / (a + b) * B.re - h) = + b / (a + b) * (σ * (A.re - h)) + a / (a + b) * (σ * (B.re - h)) + linear_combination (σ * h) * hweights + · simp only [Complex.add_im, Complex.real_smul, Complex.mul_im, + Complex.ofReal_re, Complex.ofReal_im, zero_mul, add_zero] + change K.im = b / (a + b) * A.im + a / (a + b) * B.im + simp only [K, Complex.add_im, Complex.smul_im, smul_eq_mul] + have hK : P5023T1ContactVertices L q i = K := contact i hj hk + have hfeet : + P5023T1ContactVertices L q j = G ∧ + P5023T1ContactVertices L q k = F := by + fin_cases i + all_goals dsimp [j, k] at hi hj hk ⊢ + all_goals constructor + all_goals simp [P5023T1ContactVertices, hi, ne_of_gt hk, + F, G, A, B, p, h, j, k] + have hset : Set.range (P5023T1ContactVertices L q) = ({F, K, G} : Set ℂ) := by + ext x + constructor + · rintro ⟨t, rfl⟩ + have ht : t = i ∨ t = j ∨ t = k := by + fin_cases i <;> fin_cases t <;> simp [j, k] + rcases ht with rfl | rfl | rfl <;> simp [hK, hfeet] + · simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + rintro (rfl | rfl | rfl) + · exact ⟨k, hfeet.2⟩ + · exact ⟨i, hK⟩ + · exact ⟨j, hfeet.1⟩ + rw [hset] + have hmap : f '' ({F, K, G} : Set ℂ) = + ({⟨0, A.im⟩, (b / (a + b)) • (⟨a, A.im⟩ : ℂ) + + (a / (a + b)) • (⟨b, B.im⟩ : ℂ), ⟨0, B.im⟩} : Set ℂ) := by + simp only [Set.image_insert_eq, Set.image_singleton, fF, fG, fK, fA, fB] + rw [← hmap, ← f.image_convexHull] at htri + obtain ⟨x, hx, hfx⟩ := htri + exact finj hfx ▸ hx + · have hpos (i : Fin 3) : 0 < (q i.succ).1 := by + have hn := curv.2.1 i + have hne : (q i.succ).1 ≠ 0 := fun hi => hline ⟨i, hi⟩ + omega + have hpoly : P4909T1ParentPolygon L q = + convexHull ℝ ({p 1, p 2, p 3} : Set ℂ) := by + unfold P4909T1ParentPolygon + apply congrArg (convexHull ℝ) + ext x + constructor + · rintro ⟨i, _, hxi | ⟨k, hk, _⟩⟩ + · fin_cases i <;> simp_all [p] + · exact (ne_of_gt (hpos k) hk).elim + · simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + rintro (rfl | rfl | rfl) + · exact ⟨0, hpos 0, Or.inl rfl⟩ + · exact ⟨1, hpos 1, Or.inl rfl⟩ + · exact ⟨2, hpos 2, Or.inl rfl⟩ + have htri := P5090T1ThreeDiskContactTriangle (p 1) (p 2) (p 3) z + (r 1) (r 2) (r 3) + (one_div_pos.mpr (by exact_mod_cast hpos 0)) + (one_div_pos.mpr (by exact_mod_cast hpos 1)) + (one_div_pos.mpr (by exact_mod_cast hpos 2)) + (pair 1 2 (by decide) (hpos 0) (hpos 1)).1 + (pair 1 3 (by decide) (hpos 0) (hpos 2)).1 + (pair 2 3 (by decide) (hpos 1) (hpos 2)).1 + (hpoly ▸ hzPoly) (hzOutside 0 (hpos 0)) + (hzOutside 1 (hpos 1)) (hzOutside 2 (hpos 2)) + have hC0 := contact 0 (hpos 1) (hpos 2) + have hC1 := contact 1 (hpos 2) (hpos 0) + have hC2 := contact 2 (hpos 0) (hpos 1) + change P5023T1ContactVertices L q 0 = + (r 3 / (r 2 + r 3)) • p 2 + (r 2 / (r 2 + r 3)) • p 3 at hC0 + change P5023T1ContactVertices L q 2 = + (r 2 / (r 1 + r 2)) • p 1 + (r 1 / (r 1 + r 2)) • p 2 at hC2 + have hC1' : P5023T1ContactVertices L q 1 = + (r 3 / (r 1 + r 3)) • p 1 + (r 1 / (r 1 + r 3)) • p 3 := by + simpa only [show (1 + 1 : Fin 3).succ = 3 by rfl, + show (1 + 2 : Fin 3).succ = 1 by rfl, add_comm] using hC1 + rw [← hC2, ← hC1', ← hC0] at htri + apply convexHull_mono _ htri + intro x hx + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hx + rcases hx with rfl | rfl | rfl + · exact ⟨2, rfl⟩ + · exact ⟨1, rfl⟩ + · exact ⟨0, rfl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1ContactVertices.lean b/LeanPool/ApollonianSuperharmonic/P5023T1ContactVertices.lean new file mode 100644 index 0000000000..12b6551e2a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5023T1ContactVertices.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4909T1ParentPolygon + +-- [TABLET NODE: P5023T1ContactVertices] + +/-! +# P5023T1ContactVertices + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For arbitrary $L\in\mathbb R$ and $q$, index the parents by +$i\in\mathbb Z/3\mathbb Z$, so that $q_{i+1}=(c_i,w_i)$, and put +$p_i=w_i/c_i$. For distinct parent indices define the total expression +$$ + d_{ij}=\begin{cases} + (h_i,\operatorname{Im}p_j),&c_i=0,\\ + (h_j,\operatorname{Im}p_i),&c_i\ne0,\ c_j=0,\\ + (w_i+w_j)/(c_i+c_j),&c_i\ne0,\ c_j\ne0, + \end{cases}\qquad + h_i=\begin{cases}L,&w_i=-1,\\ L+2,&w_i\ne-1.\end{cases} +$$ +Set $v_k=d_{k+1,k+2}$, with the subscripts on $d$ taken modulo three. +This function is `P5023T1ContactVertices`. +The conventions for $h_i$ agree with +`P4909T1ParentPolygon`. As usual, field division by zero +is interpreted by its total field definition; no geometric meaning +is asserted for arbitrary raw inputs. +When the parents are externally tangent positive circles, or two +positive circles tangent from the inward side to one signed band line, +these are their three pairwise contacts. In particular $v_{i+1}$ and +$v_{i+2}$ are the two contacts on parent $i$, also when that parent is +the line. This last description is conditional, not an additional +assumption in the total definition. +-/ +noncomputable def P5023T1ContactVertices (L : ℝ) + (q : Fin 4 → CircleCoordinates) : Fin 3 → ℂ := +-- BODY + let contact (i j : Fin 3) : ℂ := + if (q i.succ).1 = 0 then + ⟨if (q i.succ).2 = -1 then L else L + 2, + ((q j.succ).2 / ((q j.succ).1 : ℝ) : ℂ).im⟩ + else if (q j.succ).1 = 0 then + ⟨if (q j.succ).2 = -1 then L else L + 2, + ((q i.succ).2 / ((q i.succ).1 : ℝ) : ℂ).im⟩ + else + ((q i.succ).2 + (q j.succ).2 : ℂ) / + (((q i.succ).1 : ℝ) + ((q j.succ).1 : ℝ)) + fun k => contact (k + 1) (k + 2) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1ConvexDiameter.lean b/LeanPool/ApollonianSuperharmonic/P5023T1ConvexDiameter.lean new file mode 100644 index 0000000000..84c83c3b34 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5023T1ConvexDiameter.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Complex.Basic +public import Mathlib.Analysis.Normed.Module.Convex + +-- [TABLET NODE: P5023T1ConvexDiameter] + +/-! +# P5023T1ConvexDiameter + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5023T1ConvexDiameter (v : Fin 3 → ℂ) (s : Set ℂ) (D : ℝ) + (hD : 0 ≤ D) (hs : s ⊆ convexHull ℝ (Set.range v)) + (hv : ∀ i j : Fin 3, dist (v i) (v j) ≤ D) : + Metric.diam s ≤ D := by +-- BODY + have hbounded : Bornology.IsBounded (convexHull ℝ (Set.range v)) := + (isBounded_convexHull (s := Set.range v)).mpr (Set.finite_range v).isBounded + have hbase : Metric.diam (Set.range v) ≤ D := by + apply Metric.diam_le_of_forall_dist_le hD + rintro x ⟨i, rfl⟩ y ⟨j, rfl⟩ + exact hv i j + calc + Metric.diam s ≤ Metric.diam (convexHull ℝ (Set.range v)) := + Metric.diam_mono hs hbounded + _ = Metric.diam (Set.range v) := convexHull_diam _ + _ ≤ D := hbase + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1LineEstimate.lean b/LeanPool/ApollonianSuperharmonic/P5023T1LineEstimate.lean new file mode 100644 index 0000000000..d0e00501b8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5023T1LineEstimate.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Real.Sqrt +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P5023T1LineEstimate] + +/-! +# P5023T1LineEstimate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5023T1LineEstimate (R a b t u v : ℝ) + (hR : 0 ≤ R) (ha : 0 ≤ a) (hb : 0 ≤ b) (ha1 : a ≤ 1) (hb1 : b ≤ 1) + (ht : min u v < t ∧ t < max u v) + (hu : (t - u) ^ 2 = 4 * R * a) (hv : (t - v) ^ 2 = 4 * R * b) : + |u - v| = 2 * Real.sqrt (R * a) + 2 * Real.sqrt (R * b) ∧ + |u - v| ≤ 4 * Real.sqrt R := by +-- BODY + have hsu : |t - u| = 2 * Real.sqrt (R * a) := by + have hs := Real.sq_sqrt (mul_nonneg hR ha) + have habs := sq_abs (t - u) + have hn := abs_nonneg (t - u) + have hp := Real.sqrt_nonneg (R * a) + nlinarith + have hsv : |t - v| = 2 * Real.sqrt (R * b) := by + have hs := Real.sq_sqrt (mul_nonneg hR hb) + have habs := sq_abs (t - v) + have hn := abs_nonneg (t - v) + have hp := Real.sqrt_nonneg (R * b) + nlinarith + have hsum : |u - v| = |t - u| + |t - v| := by + rcases le_total u v with huv | hvu + · rw [min_eq_left huv, max_eq_right huv] at ht + rw [abs_of_nonpos (sub_nonpos.mpr huv), + abs_of_pos (sub_pos.mpr ht.1), abs_of_neg (sub_neg.mpr ht.2)] + ring + · rw [min_eq_right hvu, max_eq_left hvu] at ht + rw [abs_of_nonneg (sub_nonneg.mpr hvu), + abs_of_neg (sub_neg.mpr ht.2), abs_of_pos (sub_pos.mpr ht.1)] + ring + have hsa : Real.sqrt (R * a) ≤ Real.sqrt R := + Real.sqrt_le_sqrt (by nlinarith [mul_le_mul_of_nonneg_left ha1 hR]) + have hsb : Real.sqrt (R * b) ≤ Real.sqrt R := + Real.sqrt_le_sqrt (by nlinarith [mul_le_mul_of_nonneg_left hb1 hR]) + rw [hsu, hsv] at hsum + exact ⟨hsum, by linarith⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1LineSideGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5023T1LineSideGeometry.lean new file mode 100644 index 0000000000..12616bb2ab --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5023T1LineSideGeometry.lean @@ -0,0 +1,176 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5023T1ContactVertices +public import LeanPool.ApollonianSuperharmonic.P4828T1Gap +public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.P4953T1LiteralHulls +public import LeanPool.ApollonianSuperharmonic.P4953T1HullHeight + +-- [TABLET NODE: P5023T1LineSideGeometry] + +/-! +# P5023T1LineSideGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5023T1LineSideGeometry (L : ℝ) (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) (hs : P4828T1LineSupport L q) + (hi : P4828T1Disk (q 0) ⊆ P4828T1Gap L q) + (i : Fin 3) (hzero : (q i.succ).1 = 0) : + let p (j : Fin 4) : ℂ := (q j).2 / ((q j).1 : ℝ) + let r (j : Fin 4) : ℝ := 1 / ((q j).1 : ℝ) + let j : Fin 3 := i + 1 + let k : Fin 3 := i + 2 + (min (p j.succ).im (p k.succ).im < (p 0).im ∧ + (p 0).im < max (p j.succ).im (p k.succ).im) ∧ + ((p 0).im - (p j.succ).im) ^ 2 = 4 * r 0 * r j.succ ∧ + ((p 0).im - (p k.succ).im) ^ 2 = 4 * r 0 * r k.succ ∧ + dist (P5023T1ContactVertices L q (i + 1)) + (P5023T1ContactVertices L q (i + 2)) = + |(p j.succ).im - (p k.succ).im| := by +-- BODY + let p (k : Fin 4) : ℂ := (q k).2 / ((q k).1 : ℝ) + let r (k : Fin 4) : ℝ := 1 / ((q k).1 : ℝ) + let j : Fin 3 := i + 1 + let k : Fin 3 := i + 2 + let h : ℝ := if (q i.succ).2 = -1 then L else L + 2 + have curv := ProperBandCurvatureStructure q hq + have hR : 0 < r 0 := one_div_pos.mpr (by exact_mod_cast curv.1) + have hjne : j ≠ i := by fin_cases i <;> decide + have hkne : k ≠ i := by fin_cases i <;> decide + have hjk : j ≠ k := by fin_cases i <;> decide + have other_pos (a : Fin 3) (ha : a ≠ i) : 0 < (q a.succ).1 := by + have hn := curv.2.1 a + by_contra hnp + have hz : (q a.succ).1 = 0 := by omega + exact ha (curv.2.2 i a hzero hz).symm + have hj := other_pos j hjne + have hk := other_pos k hkne + have centerDistance (a b : Fin 4) (hab : a ≠ b) + (ha : 0 < (q a).1) (hb : 0 < (q b).1) : + dist (p a) (p b) = r a + r b := by + let w : GaussianInt := (q b).1 • (q a).2 - (q a).1 • (q b).2 + have ht := TangencyCoordinateIdentity q hq.1 a b hab + have normCast (z : GaussianInt) : + Complex.normSq (z : ℂ) = (Zsqrtd.norm z : ℝ) := by + simp [Complex.normSq, Zsqrtd.norm_def] + have hn : Complex.normSq (w : ℂ) = (((q a).1 + (q b).1 : ℤ) ^ 2 : ℝ) := by + change Complex.normSq + (((q b).1 • (q a).2 - (q a).1 • (q b).2 : GaussianInt) : ℂ) = _ + rw [normCast] + exact_mod_cast ht + have hnsq : ‖(w : ℂ)‖ ^ 2 = (((q a).1 + (q b).1 : ℤ) : ℝ) ^ 2 := by + rw [← Complex.normSq_eq_norm_sq, hn] + have hnorm : ‖(w : ℂ)‖ = (((q a).1 + (q b).1 : ℤ) : ℝ) := by + have hnonneg := norm_nonneg (w : ℂ) + have hsum : 0 ≤ (((q a).1 + (q b).1 : ℤ) : ℝ) := by positivity + nlinarith + have hdiff : p a - p b = + (w : ℂ) / (((q a).1 * (q b).1 : ℤ) : ℂ) := by + dsimp [p, w] + push_cast + simp only [map_sub, map_zsmul] + field_simp [ne_of_gt ha, ne_of_gt hb] + ring + rw [Complex.dist_eq, hdiff, Complex.norm_div, Complex.norm_intCast, hnorm] + have haR : 0 < ((q a).1 : ℝ) := by exact_mod_cast ha + have hbR : 0 < ((q b).1 : ℝ) := by exact_mod_cast hb + have habR : 0 < (((q a).1 * (q b).1 : ℤ) : ℝ) := by + exact_mod_cast mul_pos ha hb + rw [abs_of_pos habR] + push_cast + dsimp [r] + field_simp [ne_of_gt haR, ne_of_gt hbR] + ring + have signedDistance (a : Fin 4) (ha : 0 < (q a).1) : + (if (q i.succ).2 = -1 then 1 else -1) * ((p a).re - h) = r a := by + have hnormal := hs.normals i.succ hzero + have hh := hs.signed i.succ a hzero ha + have hcne : (q a).1 ≠ 0 := ne_of_gt ha + have hpre : (p a).re = (q a).2.re / (q a).1 := by + dsimp [p] + rw [Complex.div_re] + simp + field_simp [hcne] + have hre : ((q a).2 : ℂ).re = (q a).2.re := by norm_num + by_cases hneg : (q i.succ).2 = -1 + · rw [hneg] at hh + norm_num at hh + rw [hre] at hh + simp only [h, hneg, ite_eq_left, one_mul, r] + rw [hpre] + field_simp [hcne] + nlinarith + · have hpos : (q i.succ).2 = 1 := by rcases hnormal with h' | h' <;> tauto + rw [hpos] at hh + norm_num at hh + rw [hre] at hh + simp only [h, hneg, ite_false, neg_one_mul, r] + rw [hpre] + field_simp [hcne] + nlinarith + have verticalSquare (a b : Fin 4) (ha : 0 < (q a).1) + (hb : 0 < (q b).1) (hab : a ≠ b) : + ((p a).im - (p b).im) ^ 2 = 4 * r a * r b := by + let σ : ℝ := if (q i.succ).2 = -1 then 1 else -1 + have hσ : σ * σ = 1 := by dsimp [σ]; split_ifs <;> norm_num + have hd := centerDistance a b hab ha hb + have hn : ‖p a - p b‖ = r a + r b := by simpa [dist_eq_norm] using hd + have hn2 := congrArg (fun x : ℝ => x ^ 2) hn + rw [← Complex.normSq_eq_norm_sq, Complex.normSq_apply, Complex.sub_re, + Complex.sub_im] at hn2 + have hsa := signedDistance a ha + have hsb := signedDistance b hb + have hdiff : σ * ((p a).re - (p b).re) = r a - r b := by + dsimp [σ] at hsa hsb ⊢ + linear_combination hsa - hsb + have hre : (p a).re - (p b).re = σ * (r a - r b) := by + calc + (p a).re - (p b).re = σ * σ * ((p a).re - (p b).re) := by rw [hσ]; ring + _ = σ * (σ * ((p a).re - (p b).re)) := by ring + _ = σ * (r a - r b) := by rw [hdiff] + rw [hre] at hn2 + nlinarith [hσ] + have hc : p 0 ∈ interior (P4909T1ParentPolygon L q) := by + have hb : p 0 ∈ P4828T1Disk (q 0) := by + change dist (p 0) (p 0) < r 0 + simpa only [dist_self] using hR + exact (hi hb).1 + have hull : P4909T1ParentPolygon L q = + convexHull ℝ ({p j.succ, p k.succ, ⟨h, (p j.succ).im⟩, + ⟨h, (p k.succ).im⟩} : Set ℂ) := + (P4953T1LiteralHulls L q i j k hjne hkne hjk hzero hj hk curv.1).1 + have hheight : min (p j.succ).im (p k.succ).im < (p 0).im ∧ + (p 0).im < max (p j.succ).im (p k.succ).im := by + apply P4953T1HullHeight h (p j.succ) (p k.succ) (p 0) + rw [← hull] + exact hc + refine ⟨hheight, verticalSquare 0 j.succ curv.1 hj (Fin.succ_ne_zero j).symm, + verticalSquare 0 k.succ curv.1 hk (Fin.succ_ne_zero k).symm, ?_⟩ + have hjz : (q j.succ).1 ≠ 0 := ne_of_gt hj + have hkz : (q k.succ).1 ≠ 0 := ne_of_gt hk + have hfeet : + dist (P5023T1ContactVertices L q (i + 1)) + (P5023T1ContactVertices L q (i + 2)) = + dist (⟨h, (p k.succ).im⟩ : ℂ) (⟨h, (p j.succ).im⟩ : ℂ) := by + fin_cases i <;> + simp_all [P5023T1ContactVertices, j, k, h, p] + rw [hfeet, Complex.dist_eq_re_im] + simp [Real.sqrt_sq_eq_abs, abs_sub_comm, p, j, k] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean b/LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean new file mode 100644 index 0000000000..6247676802 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean @@ -0,0 +1,571 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap +public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport +public import LeanPool.ApollonianSuperharmonic.P4828T1Step +public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate +public import LeanPool.ApollonianSuperharmonic.P4953T1LiteralHulls +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import Mathlib.Analysis.Complex.Basic +public import Mathlib.Analysis.Convex.Topology + +-- [TABLET NODE: P5050T1OmittedHullSeparation] + +/-! +# P5050T1OmittedHullSeparation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OmittedHullLemmas + +private theorem circleDistance : + ∀ (v : Fin 4 → CircleCoordinates), (ProperBandQuadruple v) → ∀ (i : Fin 4), ∀ (k : Fin 4), (i + ≠ k) → (0 < (v i).1) → (0 < (v k).1) → dist (((v i).2 : Complex) / (v i).1) + (((v k).2 : Complex) / (v k).1) = + 1 / (v i).1 + 1 / (v k).1 := by + classical + intro v hv i k hik hi hk + let w : GaussianInt := (v k).1 • (v i).2 - (v i).1 • (v k).2 + have ht := TangencyCoordinateIdentity v hv.1 i k hik + have normCast (w : GaussianInt) : + Complex.normSq (w : Complex) = (Zsqrtd.norm w : Real) := by + simp [Complex.normSq, Zsqrtd.norm_def] + have hn : Complex.normSq (w : Complex) = + (((v i).1 + (v k).1 : ℤ)^2 : Real) := by + change Complex.normSq + (((v k).1 • (v i).2 - (v i).1 • (v k).2 : GaussianInt) : Complex) = _ + rw [normCast] + exact_mod_cast ht + have hnsq : ‖(w : Complex)‖ ^ 2 = + (((v i).1 + (v k).1 : ℤ) : Real) ^ 2 := by + rw [← Complex.normSq_eq_norm_sq, hn] + have hnorm : ‖(w : Complex)‖ = + (((v i).1 + (v k).1 : ℤ) : Real) := by + have hnonneg := norm_nonneg (w : Complex) + have hsum : 0 ≤ (((v i).1 + (v k).1 : ℤ) : Real) := by positivity + nlinarith + have hdiff : + ((v i).2 : Complex) / (v i).1 - ((v k).2 : Complex) / (v k).1 = + (w : Complex) / (((v i).1 * (v k).1 : ℤ) : Complex) := by + dsimp [w] + push_cast + simp only [map_sub, map_zsmul] + have hia : (v i).1 ≠ 0 := ne_of_gt hi + have hkb : (v k).1 ≠ 0 := ne_of_gt hk + field_simp [hia, hkb] + ring + rw [Complex.dist_eq, hdiff, Complex.norm_div, Complex.norm_intCast, hnorm] + have ha : 0 < ((v i).1 : Real) := by exact_mod_cast hi + have hb : 0 < ((v k).1 : Real) := by exact_mod_cast hk + have hab : 0 < (((v i).1 * (v k).1 : ℤ) : Real) := by + exact_mod_cast mul_pos hi hk + rw [abs_of_pos hab] + push_cast + field_simp [ne_of_gt ha, ne_of_gt hb] + ring + +private theorem projectionAffine : + ∀ (a : Complex), ∀ (x : Complex), ∀ (d : Real), (d ≠ 0) → ∃ D : Complex →ᵃ[Real] Real, + ∀ z, D z = ((x - a) * (starRingEnd Complex) (z - a)).re / d := by + classical + intro a x d hd + let L : Complex →ₗ[Real] Real := + { toFun := fun z => ((x - a) * (starRingEnd Complex) z).re / d + map_add' := by + intro z w + simp only [map_add, mul_add, Complex.add_re] + ring + map_smul' := by + intro c z + rw [Complex.real_smul] + simp only [map_mul] + rw [show (starRingEnd Complex) (c : Complex) = (c : Complex) by simp] + simp only [Complex.mul_re, Complex.mul_im, Complex.ofReal_re, + Complex.ofReal_im, RingHom.id_apply] + ring } + let F : Complex → Real := fun z => L (z - a) + have hF : ∀ z : Complex, F z = L (z -ᵥ a) +ᵥ F a := by + intro z + simp [F] + let D := AffineMap.mk' F L a hF + refine ⟨D, ?_⟩ + intro z + rfl + +private theorem projectionSphereBound : + ∀ (a : Complex), ∀ (x : Complex), ∀ (z : Complex), ∀ (ρ : Real), ∀ (R : Real), (0 < ρ) → (0 < + ρ + R) → (dist a x = ρ + R) → (dist z a = ρ) → ((x - a) * (starRingEnd Complex) (z - + a)).re / (ρ + R) ≤ ρ := by + classical + intro a x z ρ R hρ hden hax hz + have hnormx : ‖x - a‖ = ρ + R := by + simpa [dist_eq_norm, norm_sub_rev] using hax + have hnormz : ‖z - a‖ = ρ := by + simpa [dist_eq_norm, norm_sub_rev] using hz + have hprod : ‖(x - a) * (starRingEnd Complex) (z - a)‖ = (ρ + R) * ρ := by + rw [Complex.norm_mul] + rw [Complex.norm_conj, hnormx, hnormz] + have habs : |((x - a) * (starRingEnd Complex) (z - a)).re| ≤ + ‖(x - a) * (starRingEnd Complex) (z - a)‖ := + Complex.abs_re_le_norm _ + have hreal : ((x - a) * (starRingEnd Complex) (z - a)).re ≤ (ρ + R) * ρ := by + calc + _ ≤ |((x - a) * (starRingEnd Complex) (z - a)).re| := le_abs_self _ + _ ≤ ‖(x - a) * (starRingEnd Complex) (z - a)‖ := habs + _ = (ρ + R) * ρ := hprod + apply (div_le_iff₀ hden).2 + nlinarith [hreal] + +private theorem externalProjection : + ∀ (a : Complex), ∀ (x : Complex), ∀ (z : Complex), ∀ (ρ : Real), ∀ (R : Real), ∀ (s : Real), + (0 < ρ + R) → (dist a x = ρ + R) → (dist a z = ρ + s) → (dist x z = R + s) → ((x - a) * + (starRingEnd Complex) (z - a)).re / (ρ + R) = + ρ + s * (ρ - R) / (ρ + R) := by + classical + intro a x z ρ R s hpos hax haz hxz + have hnorm (u v : Complex) (d : Real) (hd : dist u v = d) : + Complex.normSq (u - v) = d ^ 2 := by + rw [Complex.normSq_eq_norm_sq, ← dist_eq_norm, hd] + have h1 : Complex.normSq (x - a) = (ρ + R) ^ 2 := + hnorm x a (ρ + R) (by simpa [dist_comm] using hax) + have h2 : Complex.normSq (z - a) = (ρ + s) ^ 2 := + hnorm z a (ρ + s) (by simpa [dist_comm] using haz) + have h3 : Complex.normSq ((x - a) - (z - a)) = (R + s) ^ 2 := by + have hv : (x - a) - (z - a) = x - z := by abel + rw [hv] + exact hnorm x z (R + s) hxz + have hdot : ((x - a) * (starRingEnd Complex) (z - a)).re = + (Complex.normSq (x - a) + Complex.normSq (z - a) - + Complex.normSq ((x - a) - (z - a))) / 2 := by + have hf := Complex.normSq_sub (x - a) (z - a) + nlinarith [hf] + rw [hdot, h1, h2, h3] + field_simp [ne_of_gt hpos] + ring + +private theorem hr : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), (0 < (q j.succ).1) → + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + 0 < r j.succ := by + classical + intro q j hj r + exact one_div_pos.mpr (by exact_mod_cast hj) + +private theorem hR : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + 0 < r 0 := by + classical + intro q hq r + exact one_div_pos.mpr + (by exact_mod_cast (ProperBandCurvatureStructure q hq).1) + +private theorem hden : + ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + (0 < r j.succ) → (0 < r 0) → 0 < r j.succ + r 0 := by + classical + intro q j r hr hR + exact add_pos hr hR + +private theorem hax : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ∀ (j : Fin 3), (0 < (q + j.succ).1) → (∀ (v : Fin 4 → CircleCoordinates), (ProperBandQuadruple v) → ∀ (i : Fin 4), + ∀ (k : Fin 4), (i ≠ k) → (0 < (v i).1) → (0 < (v k).1) → dist (((v i).2 : Complex) / (v + i).1) (((v k).2 : Complex) / (v k).1) = 1 / (v i).1 + 1 / (v k).1) → + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + dist (p j.succ) (p 0) = r j.succ + r 0 := by + classical + intro q hq j hj circleDistance p r + exact circleDistance q hq j.succ 0 (Fin.succ_ne_zero j) hj + (ProperBandCurvatureStructure q hq).1 + +end OmittedHullLemmas + +namespace OmittedHullGeometry + +private theorem signed : + ∀ (L : ℝ), ∀ (q : Fin 4 → CircleCoordinates), (P4828T1LineSupport L q) → + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + ∀ (l : Fin (3 : ℕ)), ((q l.succ).1 = (0 : ℤ)) → + let h : ℝ := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + ∀ (i : Fin 4), (0 < (q i).1) → σ * ((p i).re - h) = r i := by + classical + intro L q hs p r l hl h σ i hi + have hh := hs.signed l.succ i hl hi + have hc : ((q i).1 : ℝ) ≠ 0 := by exact_mod_cast ne_of_gt hi + have hp : (p i).re = (q i).2.re / (q i).1 := by + simp [p] + rcases hs.normals l.succ hl with hn | hn + · simp [σ, h, hn, hp, r] + rw [hn] at hh + norm_num at hh + field_simp [hc] + linarith + · have hne : (q l.succ).2 ≠ -1 := by rw [hn]; norm_num + simp [σ, h, hne, hp, r] + rw [hn] at hh + norm_num at hh + field_simp [hc] + linarith + +private theorem hfootx : + ∀ (L : ℝ), ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + (0 < r j.succ) → (0 < r 0) → ∀ (D : ℂ →ᵃ[ℝ] ℝ), (∀ (z : ℂ), (D : ℂ → ℝ) z = ((p (0 : Fin (4 : + ℕ)) - p j.succ) * (starRingEnd ℂ : ℂ → ℂ) (z - p j.succ)).re / (r j.succ + r (0 : Fin (4 + : ℕ)))) → ∀ (l : Fin (3 : ℕ)), + let h : ℝ := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + (σ ^ 2 = 1) → ((p 0).re = h + σ * r 0) → ((p j.succ).re = h + σ * r j.succ) → (((p 0).im - (p + j.succ).im) ^ 2 = 4 * r j.succ * r 0) → D (foot (p 0)) = r j.succ + + 2 * r j.succ * r 0 / (r j.succ + r 0) := by + classical + intro L q j p r hr hR D hD l h σ foot hσ coord0 coorda hd2 + have hden : 0 < r j.succ + r 0 := add_pos hr hR + rw [hD] + have hre : (p 0).re - (p j.succ).re = + σ * (r 0 - r j.succ) := by rw [coord0, coorda]; ring + have hrf : h - (p j.succ).re = -σ * r j.succ := by + rw [coorda] + ring + simp only [foot, Complex.mul_re, Complex.sub_re, Complex.sub_im, + Complex.conj_re, Complex.conj_im, mul_neg] + rw [hre, hrf] + field_simp [ne_of_gt hden] + rw [hσ] + nlinarith only [hd2] + +private theorem hfootb : + ∀ (L : ℝ), ∀ (q : Fin 4 → CircleCoordinates), ∀ (j : Fin 3), + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + (0 < r j.succ) → (0 < r 0) → ∀ (D : ℂ →ᵃ[ℝ] ℝ), (∀ (z : ℂ), (D : ℂ → ℝ) z = ((p (0 : Fin (4 : + ℕ)) - p j.succ) * (starRingEnd ℂ : ℂ → ℂ) (z - p j.succ)).re / (r j.succ + r (0 : Fin (4 + : ℕ)))) → ∀ (l : Fin (3 : ℕ)), ∀ (b : Fin (3 : ℕ)), + let h : ℝ := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + (σ ^ 2 = 1) → ((p 0).re = h + σ * r 0) → ((p j.succ).re = h + σ * r j.succ) → (((p 0).im - (p + j.succ).im) * ((p b.succ).im - (p j.succ).im) = 2 * r j.succ * r 0 + 2 * r j.succ * r + b.succ - 2 * r 0 * r b.succ) → D (foot (p b.succ)) = r j.succ + + 2 * r b.succ * (r j.succ - r 0) / + (r j.succ + r 0) := by + classical + intro L q j p r hr hR D hD l b h σ foot hσ coord0 coorda hde + have hden : 0 < r j.succ + r 0 := add_pos hr hR + rw [hD] + have hrf : h - (p j.succ).re = -σ * r j.succ := by + rw [coorda] + ring + have hre : (p 0).re - (p j.succ).re = + σ * (r 0 - r j.succ) := by rw [coord0, coorda]; ring + simp only [foot, Complex.mul_re, Complex.sub_re, Complex.sub_im, + Complex.conj_re, Complex.conj_im, mul_neg] + rw [hre, hrf] + field_simp [ne_of_gt hden] + rw [hσ] + nlinarith only [hde] + +private theorem hcB : + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ∀ (j : Fin 3), (0 < (q + j.succ).1) → (∀ (a : Complex), ∀ (x : Complex), ∀ (z : Complex), ∀ (ρ : Real), ∀ (R : + Real), ∀ (s : Real), (0 < ρ + R) → (dist a x = ρ + R) → (dist a z = ρ + s) → (dist x z = + R + s) → ((x - a) * (starRingEnd Complex) (z - a)).re / (ρ + R) = ρ + s * (ρ - R) / (ρ + + R)) → + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + (0 < r j.succ + r 0) → (dist (p j.succ) (p 0) = r j.succ + r 0) → ∀ (D : ℂ →ᵃ[ℝ] ℝ), (∀ (z : + ℂ), (D : ℂ → ℝ) z = ((p (0 : Fin (4 : ℕ)) - p j.succ) * (starRingEnd ℂ : ℂ → ℂ) (z - p + j.succ)).re / (r j.succ + r (0 : Fin (4 : ℕ)))) → ∀ (b : Fin (3 : ℕ)), (0 < (q b.succ).1) + → (dist (p j.succ) (p b.succ) = r j.succ + r b.succ) → (dist (p 0) (p b.succ) = r 0 + r + b.succ) → r j.succ < D (p b.succ) := by + classical + intro q hq j hj externalProjection p r hden hax D hD b hb hab hxb + rw [hD, externalProjection (p j.succ) (p 0) (p b.succ) + (r j.succ) (r 0) (r b.succ) hden hax hab hxb] + have hlt : r 0 < r j.succ := by + apply one_div_lt_one_div_of_lt (by exact_mod_cast hj) + exact_mod_cast hq.2 j + have hs : 0 < r b.succ := one_div_pos.mpr (by exact_mod_cast hb) + have hh : 0 < r b.succ * (r j.succ - r 0) / + (r j.succ + r 0) := div_pos (mul_pos hs (sub_pos.mpr hlt)) hden + linarith + +end OmittedHullGeometry + +namespace OmittedHullBound + +private theorem hull_bound : + ∀ (L : ℝ), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (P4828T1LineSupport + L q) → ∀ (j : Fin 3), (0 < (q j.succ).1) → (∀ (v : Fin 4 → CircleCoordinates), + (ProperBandQuadruple v) → ∀ (i : Fin 4), ∀ (k : Fin 4), (i ≠ k) → (0 < (v i).1) → (0 < (v + k).1) → dist (((v i).2 : Complex) / (v i).1) (((v k).2 : Complex) / (v k).1) = 1 / (v + i).1 + 1 / (v k).1) → (∀ (a : Complex), ∀ (x : Complex), ∀ (z : Complex), ∀ (ρ : Real), ∀ + (R : Real), ∀ (s : Real), (0 < ρ + R) → (dist a x = ρ + R) → (dist a z = ρ + s) → (dist x + z = R + s) → ((x - a) * (starRingEnd Complex) (z - a)).re / (ρ + R) = ρ + s * (ρ - R) / + (ρ + R)) → + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + (0 < r j.succ) → (0 < r 0) → (0 < r j.succ + r 0) → (dist (p j.succ) (p 0) = r j.succ + r 0) + → ∀ (D : ℂ →ᵃ[ℝ] ℝ), (∀ (z : ℂ), (D : ℂ → ℝ) z = ((p (0 : Fin (4 : ℕ)) - p j.succ) * + (starRingEnd ℂ : ℂ → ℂ) (z - p j.succ)).re / (r j.succ + r (0 : Fin (4 : ℕ)))) → ∀ z ∈ + P4909T1ParentPolygon L (P4828T1Step (P4828T1Rotate q j)), + r j.succ < D z := by + classical + intro L q hq hs j hj circleDistance externalProjection p r hr hR hden hax D hD + have hroot := (ProperBandCurvatureStructure q hq).1 + have hlt : r 0 < r j.succ := by + apply one_div_lt_one_div_of_lt (by exact_mod_cast hj) + exact_mod_cast hq.2 j + have hnorm : ‖p 0 - p j.succ‖ = r j.succ + r 0 := by + simpa only [dist_eq_norm, norm_sub_rev] using hax + have hDx : D (p 0) = r j.succ + r 0 := by + rw [hD, Complex.mul_conj, Complex.ofReal_re, Complex.normSq_eq_norm_sq, hnorm] + field_simp + let u := P4828T1Step (P4828T1Rotate q j) + have slot (k : Fin 3) : u k.succ = + if k = 0 then q 0 else q ((k + j).succ) := by + fin_cases k <;> fin_cases j <;> rfl + by_cases hall : ∀ i : Fin 3, 0 < (q i.succ).1 + · have hupos (k : Fin 3) : 0 < (u k.succ).1 := by + rw [slot] + split_ifs + · exact hroot + · exact hall (k + j) + have hc (k : Fin 3) : r j.succ < + D ((u k.succ).2 / ((u k.succ).1 : ℝ)) := by + rw [slot] + split_ifs with hk + · change r j.succ < D (p 0) + rw [hDx] + linarith + · have hkj : k + j ≠ j := by + intro he + have hv := congrArg Fin.val he + omega + have ha := circleDistance q hq j.succ (k + j).succ + (fun he => hkj (Fin.succ_inj.mp he).symm) hj (hall _) + have hx := circleDistance q hq 0 (k + j).succ + (Fin.succ_ne_zero _).symm hroot (hall _) + change r j.succ < D (p (k + j).succ) + rw [hD, externalProjection (p j.succ) (p 0) (p (k + j).succ) + (r j.succ) (r 0) (r (k + j).succ) hden hax ha hx] + have hrk : 0 < r (k + j).succ := + one_div_pos.mpr (by exact_mod_cast hall (k + j)) + have hh : 0 < r (k + j).succ * (r j.succ - r 0) / + (r j.succ + r 0) := + div_pos (mul_pos hrk (sub_pos.mpr hlt)) hden + linarith + have hhalf : Convex ℝ {z : ℂ | r j.succ < D z} := + (convex_Ioi (r j.succ)).affine_preimage D + have hHull : P4909T1ParentPolygon L u ⊆ {z : ℂ | r j.succ < D z} := by + apply convexHull_min ?_ hhalf + rintro z ⟨k, hk, rfl | ⟨l, hl, _⟩⟩ + · exact hc k + · exact ((ne_of_gt (hupos l)) hl).elim + exact hHull + · have facts := ProperBandCurvatureStructure q hq + obtain ⟨l, hl⟩ : ∃ l : Fin 3, (q l.succ).1 = 0 := by + by_contra hn + push Not at hn + exact hall (fun i => lt_of_le_of_ne (facts.2.1 i) (Ne.symm (hn i))) + have hjl : j ≠ l := by + intro he + subst j + omega + obtain ⟨b, hbl, hbj⟩ : ∃ b : Fin 3, b ≠ l ∧ b ≠ j := by + fin_cases l <;> fin_cases j + all_goals try exact (hjl rfl).elim + all_goals first + | exact ⟨0, by decide, by decide⟩ + | exact ⟨1, by decide, by decide⟩ + | exact ⟨2, by decide, by decide⟩ + have hb : 0 < (q b.succ).1 := by + have hn : (q b.succ).1 ≠ 0 := fun he => hbl (facts.2.2 b l he hl) + exact lt_of_le_of_ne (facts.2.1 b) (Ne.symm hn) + let h : ℝ := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ + have hσ : σ ^ 2 = 1 := by dsimp [σ]; split_ifs <;> norm_num + have hσmul : σ * σ = 1 := by nlinarith [hσ] + have signed (i : Fin 4) (hi : 0 < (q i).1) : + σ * ((p i).re - h) = r i := OmittedHullGeometry.signed L q hs l hl i hi + have hab : dist (p j.succ) (p b.succ) = r j.succ + r b.succ := + circleDistance q hq j.succ b.succ + (fun he => hbj (Fin.succ_inj.mp he).symm) hj hb + have hxb : dist (p 0) (p b.succ) = r 0 + r b.succ := + circleDistance q hq 0 b.succ (Fin.succ_ne_zero _).symm hroot hb + have hhull := (P4953T1LiteralHulls L q l j b hjl hbl hbj.symm + hl hj hb hroot).2.2.1 + change P4909T1ParentPolygon L (P4828T1Step (P4828T1Rotate q j)) = + convexHull ℝ ({p 0, p b.succ, foot (p 0), foot (p b.succ)} : Set ℂ) at hhull + have hsq (v w : ℂ) (t : ℝ) (ht : dist v w = t) : + (v.re - w.re) ^ 2 + (v.im - w.im) ^ 2 = t ^ 2 := by + have hn : Complex.normSq (v - w) = t ^ 2 := by + rw [Complex.normSq_eq_norm_sq, ← dist_eq_norm, ht] + rw [Complex.normSq_sub] at hn + simp [Complex.normSq, Complex.mul_re, Complex.conj_re, Complex.conj_im] at hn + nlinarith + have haxSq := hsq (p j.succ) (p 0) (r j.succ + r 0) hax + have habSq := hsq (p j.succ) (p b.succ) (r j.succ + r b.succ) hab + have hxbSq := hsq (p 0) (p b.succ) (r 0 + r b.succ) hxb + have rel (i : Fin 4) (hi : 0 < (q i).1) : + (p i).re - h = σ * r i := by + calc + (p i).re - h = σ * (σ * ((p i).re - h)) := by + rw [← mul_assoc, hσmul] + ring + _ = σ * r i := by rw [signed i hi] + have coord0 : (p 0).re = h + σ * r 0 := by linarith [rel 0 hroot] + have coorda : (p j.succ).re = h + σ * r j.succ := by linarith [rel j.succ hj] + have coordb : (p b.succ).re = h + σ * r b.succ := by linarith [rel b.succ hb] + have haxRe : (p j.succ).re - (p 0).re = + σ * (r j.succ - r 0) := by + rw [coorda, coord0] + ring + have habRe : (p j.succ).re - (p b.succ).re = + σ * (r j.succ - r b.succ) := by + rw [coorda, coordb] + ring + have hxbRe : (p 0).re - (p b.succ).re = + σ * (r 0 - r b.succ) := by + rw [coord0, coordb] + ring + have haxReSq : ((p j.succ).re - (p 0).re) ^ 2 = + (r j.succ - r 0) ^ 2 := by + calc + _ = (σ * (r j.succ - r 0)) ^ 2 := by rw [haxRe] + _ = _ := by rw [mul_pow, hσ]; ring + have habReSq : ((p j.succ).re - (p b.succ).re) ^ 2 = + (r j.succ - r b.succ) ^ 2 := by + calc + _ = (σ * (r j.succ - r b.succ)) ^ 2 := by rw [habRe] + _ = _ := by rw [mul_pow, hσ]; ring + have hxbReSq : ((p 0).re - (p b.succ).re) ^ 2 = + (r 0 - r b.succ) ^ 2 := by + calc + _ = (σ * (r 0 - r b.succ)) ^ 2 := by rw [hxbRe] + _ = _ := by rw [mul_pow, hσ]; ring + have hd2 : ((p 0).im - (p j.succ).im) ^ 2 = 4 * r j.succ * r 0 := by + nlinarith only [haxSq, haxReSq] + have he2 : ((p b.succ).im - (p j.succ).im) ^ 2 = + 4 * r j.succ * r b.succ := by + nlinarith only [habSq, habReSq] + have hde : ((p 0).im - (p j.succ).im) * + ((p b.succ).im - (p j.succ).im) = + 2 * r j.succ * r 0 + 2 * r j.succ * r b.succ - + 2 * r 0 * r b.succ := by + have hv : ((p 0).im - (p b.succ).im) ^ 2 = + 4 * r 0 * r b.succ := by nlinarith only [hxbSq, hxbReSq] + nlinarith only [hd2, he2, hv] + have hfootx : D (foot (p 0)) = r j.succ + + 2 * r j.succ * r 0 / (r j.succ + r 0) := OmittedHullGeometry.hfootx L q j hr hR D hD l hσ + coord0 coorda hd2 + have hfootb : D (foot (p b.succ)) = r j.succ + + 2 * r b.succ * (r j.succ - r 0) / + (r j.succ + r 0) := OmittedHullGeometry.hfootb L q j hr hR D hD l b hσ coord0 coorda hde + have hcB : r j.succ < D (p b.succ) := OmittedHullGeometry.hcB q hq j hj externalProjection + hden hax D hD b hb hab hxb + have hfx : r j.succ < D (foot (p 0)) := by + rw [hfootx] + have : 0 < 2 * r j.succ * r 0 / (r j.succ + r 0) := by positivity + linarith + have hfb : r j.succ < D (foot (p b.succ)) := by + rw [hfootb] + have hlt : r 0 < r j.succ := by + apply one_div_lt_one_div_of_lt (by exact_mod_cast hj) + exact_mod_cast hq.2 j + have : 0 < 2 * r b.succ * (r j.succ - r 0) / + (r j.succ + r 0) := by positivity + linarith + have hhalf : Convex ℝ {z : ℂ | r j.succ < D z} := + (convex_Ioi (r j.succ)).affine_preimage D + rw [hhull] + apply convexHull_min ?_ hhalf + simp only [Set.insert_subset_iff, Set.singleton_subset_iff] + constructor + · change r j.succ < D (p 0) + rw [hDx] + linarith + constructor + · exact hcB + constructor + · exact hfx + · exact hfb + +end OmittedHullBound + +theorem P5050T1OmittedHullSeparation (L : ℝ) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hs : P4828T1LineSupport L q) (j : Fin 3) (hj : 0 < (q j.succ).1) : + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + ∃ D : ℂ →ᵃ[ℝ] ℝ, + (∀ z, D z = ((p 0 - p j.succ) * + (starRingEnd ℂ) (z - p j.succ)).re / (r j.succ + r 0)) ∧ + (∀ z ∈ Metric.sphere (p j.succ) (r j.succ), D z ≤ r j.succ) ∧ + ∀ z ∈ P4909T1ParentPolygon L (P4828T1Step (P4828T1Rotate q j)), + r j.succ < D z := by +-- BODY + have circleDistance (v : Fin 4 → CircleCoordinates) + (hv : ProperBandQuadruple v) (i k : Fin 4) (hik : i ≠ k) + (hi : 0 < (v i).1) (hk : 0 < (v k).1) : + dist (((v i).2 : Complex) / (v i).1) + (((v k).2 : Complex) / (v k).1) = + 1 / (v i).1 + 1 / (v k).1 := OmittedHullLemmas.circleDistance v hv i k hik hi hk + have projectionAffine (a x : Complex) (d : Real) (hd : d ≠ 0) : + ∃ D : Complex →ᵃ[Real] Real, + ∀ z, D z = ((x - a) * (starRingEnd Complex) (z - a)).re / d := + OmittedHullLemmas.projectionAffine a x d hd + have projectionSphereBound (a x z : Complex) (ρ R : Real) + (hρ : 0 < ρ) (hden : 0 < ρ + R) (hax : dist a x = ρ + R) + (hz : dist z a = ρ) : + ((x - a) * (starRingEnd Complex) (z - a)).re / (ρ + R) ≤ ρ := + OmittedHullLemmas.projectionSphereBound a x z ρ R hρ hden hax hz + have externalProjection (a x z : Complex) (ρ R s : Real) + (hpos : 0 < ρ + R) + (hax : dist a x = ρ + R) (haz : dist a z = ρ + s) + (hxz : dist x z = R + s) : + ((x - a) * (starRingEnd Complex) (z - a)).re / (ρ + R) = + ρ + s * (ρ - R) / (ρ + R) := OmittedHullLemmas.externalProjection a x z ρ R s hpos hax + haz hxz + dsimp only + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + have hr : 0 < r j.succ := OmittedHullLemmas.hr q j hj + have hR : 0 < r 0 := OmittedHullLemmas.hR q hq + have hden : 0 < r j.succ + r 0 := OmittedHullLemmas.hden q j hr hR + have hax : dist (p j.succ) (p 0) = r j.succ + r 0 := OmittedHullLemmas.hax q hq j hj + circleDistance + obtain ⟨D, hD⟩ := projectionAffine (p j.succ) (p 0) + (r j.succ + r 0) (ne_of_gt hden) + have hull_bound : ∀ z ∈ + P4909T1ParentPolygon L (P4828T1Step (P4828T1Rotate q j)), + r j.succ < D z := OmittedHullBound.hull_bound L q hq hs j hj circleDistance + externalProjection hr hR hden hax D hD + refine ⟨D, hD, ?_, hull_bound⟩ + · intro z hz + rw [hD] + exact projectionSphereBound _ _ _ _ _ hr hden hax (Metric.mem_sphere.mp hz) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5050T1ParentSphereSection.lean b/LeanPool/ApollonianSuperharmonic/P5050T1ParentSphereSection.lean new file mode 100644 index 0000000000..1926e450a9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5050T1ParentSphereSection.lean @@ -0,0 +1,365 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap +public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport +public import LeanPool.ApollonianSuperharmonic.P4953T1LiteralHulls +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.P5050T1TangentTriangleSection +public import LeanPool.ApollonianSuperharmonic.P5050T1TangentLineSection + +-- [TABLET NODE: P5050T1ParentSphereSection] + +/-! +# P5050T1ParentSphereSection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ParentSphereProof + +private theorem circleDistance : + (by + classical + exact + ∀ (v : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple v → ∀ (i : Fin (4 : ℕ)), ∀ + (k : Fin (4 : ℕ)), i ≠ k → (0 : ℤ) < (v i).1 → (0 : ℤ) < (v k).1 → dist + ((GaussianInt.toComplex : GaussianInt → ℂ) (v i).2 / (↑(v i).1 : ℂ)) + ((GaussianInt.toComplex : GaussianInt → ℂ) (v k).2 / (↑(v k).1 : ℂ)) = (1 : ℝ) / (↑(v + i).1 : ℝ) + (1 : ℝ) / (↑(v k).1 : ℝ) ) := by + classical + intro v hv i k hik hi hk + let w : GaussianInt := (v k).1 • (v i).2 - (v i).1 • (v k).2 + have ht := TangencyCoordinateIdentity v hv.1 i k hik + have normCast (w : GaussianInt) : + Complex.normSq (w : Complex) = (Zsqrtd.norm w : Real) := by + simp [Complex.normSq, Zsqrtd.norm_def] + have hn : Complex.normSq (w : Complex) = + (((v i).1 + (v k).1 : ℤ)^2 : Real) := by + change Complex.normSq + (((v k).1 • (v i).2 - (v i).1 • (v k).2 : GaussianInt) : Complex) = _ + rw [normCast] + exact_mod_cast ht + have hnsq : ‖(w : Complex)‖ ^ 2 = + (((v i).1 + (v k).1 : ℤ) : Real) ^ 2 := by + rw [← Complex.normSq_eq_norm_sq, hn] + have hnorm : ‖(w : Complex)‖ = + (((v i).1 + (v k).1 : ℤ) : Real) := by + have hnonneg := norm_nonneg (w : Complex) + have hsum : 0 ≤ (((v i).1 + (v k).1 : ℤ) : Real) := by positivity + nlinarith + have hdiff : + ((v i).2 : Complex) / (v i).1 - ((v k).2 : Complex) / (v k).1 = + (w : Complex) / (((v i).1 * (v k).1 : ℤ) : Complex) := by + dsimp [w] + push_cast + simp only [map_sub, map_zsmul] + have hia : (v i).1 ≠ 0 := ne_of_gt hi + have hkb : (v k).1 ≠ 0 := ne_of_gt hk + field_simp [hia, hkb] + ring + rw [Complex.dist_eq, hdiff, Complex.norm_div, Complex.norm_intCast, hnorm] + have ha : 0 < ((v i).1 : Real) := by exact_mod_cast hi + have hb : 0 < ((v k).1 : Real) := by exact_mod_cast hk + have hab : 0 < (((v i).1 * (v k).1 : ℤ) : Real) := by + exact_mod_cast mul_pos hi hk + rw [abs_of_pos hab] + push_cast + field_simp [ne_of_gt ha, ne_of_gt hb] + ring + +private theorem parentHull : + (by + classical + exact + ∀ (L : ℝ), ∀ (v : Fin (4 : ℕ) → CircleCoordinates), (∀ (i : Fin (3 : ℕ)), (0 : ℤ) < (v + i.succ).1) → P4909T1ParentPolygon L v = (convexHull ℝ : Set ℂ → Set ℂ) (Set.range + fun (i : Fin (3 : ℕ)) => (GaussianInt.toComplex : GaussianInt → ℂ) (v i.succ).2 / + (↑(↑(v i.succ).1 : ℝ) : ℂ)) ) := by + classical + intro L v hv + unfold P4909T1ParentPolygon + apply congrArg (convexHull Real) + ext z + constructor + · rintro ⟨i, hi, hz | ⟨k, hk, hz⟩⟩ + · exact ⟨i, hz.symm⟩ + · exact False.elim ((ne_of_gt (hv k)) hk) + · rintro ⟨i, rfl⟩ + exact ⟨i, hv i, Or.inl rfl⟩ + +private theorem positiveSection : + (by + classical + exact + ∀ (L : ℝ), (∀ (v : Fin 4 → CircleCoordinates), (ProperBandQuadruple v) → (∀ (i : Fin 4), + ∀ (k : Fin 4), (i ≠ k) → ((0 < (v i).1) → ((0 < (v k).1) → (dist (((v i).2 : Complex) + / (v i).1) (((v k).2 : Complex) / (v k).1) = 1 / (v i).1 + 1 / (v k).1))))) → ((∀ (v + : Fin 4 → CircleCoordinates), (∀ i : Fin 3, 0 < (v i.succ).1) → + (P4909T1ParentPolygon L v = convexHull Real (Set.range fun i : Fin 3 => ((v + i.succ).2 : Complex) / ((v i.succ).1 : Real)))) → (∀ (v : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple v → ∀ (m : Fin (3 : ℕ)), (0 : ℤ) < (v + m.succ).1 → (∀ (i : Fin (3 : ℕ)), (0 : ℤ) < (v i.succ).1) → IsPreconnected + (P4984T1ClosedGap L v ∩ Metric.sphere ((GaussianInt.toComplex : GaussianInt → ℂ) (v + m.succ).2 / (↑(↑(v m.succ).1 : ℝ) : ℂ)) ((1 : ℝ) / (↑(v m.succ).1 : ℝ))))) ) := by + classical + intro L circleDistance parentHull v hv m hm hall + let pv (i : Fin 4) : Complex := (v i).2 / ((v i).1 : Real) + let rv (i : Fin 4) : Real := 1 / ((v i).1 : Real) + let center := pv m.succ + let ρ := rv m.succ + let b : Fin 3 := if m = 0 then 1 else 0 + let c : Fin 3 := if m = 2 then 1 else 2 + have hb : b ≠ m := by fin_cases m <;> simp [b] + have hc : c ≠ m := by fin_cases m <;> simp [c] + have hbc : b ≠ c := by fin_cases m <;> simp [b, c] + have hcenters : Set.range (fun i : Fin 3 => pv i.succ) = + {center, pv b.succ, pv c.succ} := by + fin_cases m + · ext z + simp only [Set.mem_range, Set.mem_insert_iff, Set.mem_singleton_iff, + center, b, c, pv] + constructor + · rintro ⟨i, hi⟩ + fin_cases i + · subst z; exact Or.inl rfl + · subst z; exact Or.inr (Or.inl rfl) + · subst z; exact Or.inr (Or.inr rfl) + · rintro (rfl | rfl | rfl) + · exact ⟨0, rfl⟩ + · exact ⟨1, rfl⟩ + · exact ⟨2, rfl⟩ + · ext z + simp only [Set.mem_range, Set.mem_insert_iff, Set.mem_singleton_iff, + center, b, c, pv] + constructor + · rintro ⟨i, hi⟩ + fin_cases i + · subst z; exact Or.inr (Or.inl rfl) + · subst z; exact Or.inl rfl + · subst z; exact Or.inr (Or.inr rfl) + · rintro (rfl | rfl | rfl) + · exact ⟨1, rfl⟩ + · exact ⟨0, rfl⟩ + · exact ⟨2, rfl⟩ + · ext z + simp only [Set.mem_range, Set.mem_insert_iff, Set.mem_singleton_iff, + center, b, c, pv] + constructor + · rintro ⟨i, hi⟩ + fin_cases i + · subst z; exact Or.inr (Or.inl rfl) + · subst z; exact Or.inr (Or.inr rfl) + · subst z; exact Or.inl rfl + · rintro (rfl | rfl | rfl) + · exact ⟨2, rfl⟩ + · exact ⟨0, rfl⟩ + · exact ⟨1, rfl⟩ + have hpoly : P4909T1ParentPolygon L v = + convexHull Real ({center, pv b.succ, pv c.succ} : Set Complex) := by + rw [parentHull v hall, ← hcenters] + have hgapEq : P4984T1ClosedGap L v ∩ Metric.sphere center ρ = + Metric.sphere center ρ ∩ P4909T1ParentPolygon L v := by + ext z + constructor + · rintro ⟨⟨hzpoly, _⟩, hz⟩ + exact ⟨hz, hzpoly⟩ + · rintro ⟨hz, hzpoly⟩ + refine ⟨⟨hzpoly, ?_⟩, hz⟩ + intro k hk + by_cases hkm : k = m + · subst k + have hdist : dist z center = ρ := Metric.mem_sphere.mp hz + simpa [pv, rv, center, ρ] using (le_of_eq hdist.symm) + · have hdist := circleDistance v hv m.succ k.succ + (fun heq => hkm (Fin.succ_inj.mp heq).symm) hm (hall k) + have htri := dist_triangle center z (pv k.succ) + have hcz : dist center z = ρ := by + simpa [dist_comm] using (Metric.mem_sphere.mp hz) + rw [hcz] at htri + have hradDist : dist center (pv k.succ) = ρ + rv k.succ := by + simpa [center, pv, ρ, rv] using hdist + rw [hradDist] at htri + dsimp [P4984T1ClosedGap] + have hradle : rv k.succ ≤ dist z (pv k.succ) := + (add_le_add_iff_left ρ).mp htri + simpa [rv, pv] using hradle + have hdistab : dist center (pv b.succ) = ρ + rv b.succ := by + have hd := circleDistance v hv m.succ b.succ + (fun heq => hb (Fin.succ_inj.mp heq).symm) hm (hall b) + simpa [center, ρ, rv, pv] using hd + have hdistac : dist center (pv c.succ) = ρ + rv c.succ := by + have hd := circleDistance v hv m.succ c.succ + (fun heq => hc (Fin.succ_inj.mp heq).symm) hm (hall c) + simpa [center, ρ, rv, pv] using hd + have hdistbc : dist (pv b.succ) (pv c.succ) = rv b.succ + rv c.succ := by + have hd := circleDistance v hv b.succ c.succ + (fun heq => hbc (Fin.succ_inj.mp heq)) (hall b) (hall c) + simpa [rv, pv] using hd + have htri := P5050T1TangentTriangleSection center (pv b.succ) (pv c.succ) ρ + (rv b.succ) (rv c.succ) + (one_div_pos.mpr (by exact_mod_cast hm : 0 < ((v m.succ).1 : Real))) + (le_of_lt (one_div_pos.mpr + (by exact_mod_cast hall b : 0 < ((v b.succ).1 : Real)))) + (le_of_lt (one_div_pos.mpr + (by exact_mod_cast hall c : 0 < ((v c.succ).1 : Real)))) + hdistab hdistac hdistbc + rw [hgapEq, hpoly] + exact htri + +private theorem signed : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin 4 → CircleCoordinates), (P4828T1LineSupport L q) → (∀ (l : Fin (3 + : ℕ)), ((q l.succ).1 = (0 : ℤ)) → ( + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let h : ℝ := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + ∀ (i : Fin (4 : ℕ)), (0 : ℤ) < (q i).1 → σ * ((p i).re - h) = r i)) ) := by + classical + intro L q hs l hl p r h σ i hi + have hh := hs.signed l.succ i hl hi + have hc : ((q i).1 : ℝ) ≠ 0 := by exact_mod_cast ne_of_gt hi + have hp : (p i).re = (q i).2.re / (q i).1 := by + simp [p] + rcases hs.normals l.succ hl with hn | hn + · simp [σ, h, hn, hp, r] + rw [hn] at hh + norm_num at hh + field_simp [hc] + linarith + · have hne : (q l.succ).2 ≠ -1 := by rw [hn]; norm_num + simp [σ, h, hne, hp, r] + rw [hn] at hh + norm_num at hh + field_simp [hc] + linarith + +private theorem heq : + (by + classical + exact + ∀ (L : ℝ), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (j : Fin 3), + ((0 : ℤ) < (q j.succ).1) → ((∀ (v : Fin 4 → CircleCoordinates), (ProperBandQuadruple + v) → (∀ (i : Fin 4), ∀ (k : Fin 4), (i ≠ k) → ((0 < (v i).1) → ((0 < (v k).1) → (dist + (((v i).2 : Complex) / (v i).1) (((v k).2 : Complex) / (v k).1) = 1 / (v i).1 + 1 / + (v k).1))))) → ( + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + P4984T1ClosedGap L q ∩ Metric.sphere (p j.succ) (r j.succ) = Metric.sphere (p j.succ) + (r j.succ) ∩ P4909T1ParentPolygon L q))) ) := by + classical + intro L q hq j hj circleDistance p r + ext z + constructor + · rintro ⟨⟨hz, _⟩, hsph⟩ + exact ⟨hsph, hz⟩ + · rintro ⟨hsph, hz⟩ + refine ⟨⟨hz, ?_⟩, hsph⟩ + intro k hk + have hdist : dist z (p j.succ) = r j.succ := Metric.mem_sphere.mp hsph + by_cases hkj : k = j + · subst k + exact hdist.ge + · have hd := circleDistance q hq j.succ k.succ + (fun he => hkj (Fin.succ_inj.mp he).symm) hj hk + have ht := dist_triangle (p j.succ) z (p k.succ) + rw [dist_comm (p j.succ) z, hdist] at ht + change dist (p j.succ) (p k.succ) = r j.succ + r k.succ at hd + rw [hd] at ht + change r k.succ ≤ dist z (p k.succ) + linarith + +end ParentSphereProof + +theorem P5050T1ParentSphereSection (L : ℝ) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hs : P4828T1LineSupport L q) (j : Fin 3) (hj : 0 < (q j.succ).1) : + IsPreconnected (P4984T1ClosedGap L q ∩ + Metric.sphere ((q j.succ).2 / ((q j.succ).1 : ℝ)) + (1 / ((q j.succ).1 : ℝ))) := by +-- BODY + classical + have circleDistance (v : Fin 4 → CircleCoordinates) + (hv : ProperBandQuadruple v) (i k : Fin 4) (hik : i ≠ k) + (hi : 0 < (v i).1) (hk : 0 < (v k).1) : + dist (((v i).2 : Complex) / (v i).1) + (((v k).2 : Complex) / (v k).1) = + 1 / (v i).1 + 1 / (v k).1 := ParentSphereProof.circleDistance v hv i k hik hi hk + have parentHull (v : Fin 4 → CircleCoordinates) + (hv : ∀ i : Fin 3, 0 < (v i.succ).1) : + P4909T1ParentPolygon L v = + convexHull Real (Set.range fun i : Fin 3 => + ((v i.succ).2 : Complex) / ((v i.succ).1 : Real)) := ParentSphereProof.parentHull L v hv + have positiveSection (v : Fin 4 → CircleCoordinates) + (hv : ProperBandQuadruple v) (m : Fin 3) + (hm : 0 < (v m.succ).1) + (hall : ∀ i : Fin 3, 0 < (v i.succ).1) : + IsPreconnected + (P4984T1ClosedGap L v ∩ + Metric.sphere ((v m.succ).2 / ((v m.succ).1 : Real)) + (1 / ((v m.succ).1 : Real))) := ParentSphereProof.positiveSection L circleDistance + parentHull v hv m hm hall + by_cases hall : ∀ i : Fin 3, 0 < (q i.succ).1 + · exact positiveSection q hq j hj hall + · have facts := ProperBandCurvatureStructure q hq + obtain ⟨l, hl⟩ : ∃ l : Fin 3, (q l.succ).1 = 0 := by + by_contra hn + push Not at hn + exact hall (fun i => lt_of_le_of_ne (facts.2.1 i) (Ne.symm (hn i))) + have hjl : j ≠ l := by + intro he + subst j + omega + obtain ⟨b, hbl, hbj⟩ : ∃ b : Fin 3, b ≠ l ∧ b ≠ j := by + fin_cases l <;> fin_cases j + all_goals try exact (hjl rfl).elim + all_goals first + | exact ⟨0, by decide, by decide⟩ + | exact ⟨1, by decide, by decide⟩ + | exact ⟨2, by decide, by decide⟩ + have hb : 0 < (q b.succ).1 := by + have hn : (q b.succ).1 ≠ 0 := fun he => hbl (facts.2.2 b l he hl) + exact lt_of_le_of_ne (facts.2.1 b) (Ne.symm hn) + let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) + let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) + let h : ℝ := if (q l.succ).2 = -1 then L else L + 2 + let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 + have hσ : σ ^ 2 = 1 := by + dsimp [σ] + split_ifs <;> norm_num + have signed (i : Fin 4) (hi : 0 < (q i).1) : + σ * ((p i).re - h) = r i := ParentSphereProof.signed L q hs l hl i hi + have hab : dist (p j.succ) (p b.succ) = r j.succ + r b.succ := + circleDistance q hq j.succ b.succ + (fun he => hbj (Fin.succ_inj.mp he).symm) hj hb + have hhull := (P4953T1LiteralHulls L q l j b hjl hbl hbj.symm + hl hj hb facts.1).1 + have hsec := (P5050T1TangentLineSection h σ (p j.succ) (p b.succ) + (r j.succ) (r b.succ) hσ + (one_div_pos.mpr (by exact_mod_cast hj)) + (one_div_pos.mpr (by exact_mod_cast hb)) + (signed j.succ hj) (signed b.succ hb) hab).2.2 + have heq : P4984T1ClosedGap L q ∩ Metric.sphere (p j.succ) (r j.succ) = + Metric.sphere (p j.succ) (r j.succ) ∩ P4909T1ParentPolygon L q := ParentSphereProof.heq + L q hq j hj circleDistance + change IsPreconnected (P4984T1ClosedGap L q ∩ + Metric.sphere (p j.succ) (r j.succ)) + rw [heq, hhull] + exact hsec + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5050T1RadialSection.lean b/LeanPool/ApollonianSuperharmonic/P5050T1RadialSection.lean new file mode 100644 index 0000000000..7803318f1e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5050T1RadialSection.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Convex.PathConnected +public import Mathlib.Analysis.Convex.Join +public import Mathlib.Analysis.Complex.Basic + +-- [TABLET NODE: P5050T1RadialSection] + +/-! +# P5050T1RadialSection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5050T1RadialSection (a : Complex) (ρ : Real) (S : Set Complex) + (hρ : 0 < ρ) (hS : S.Nonempty) + (hsep : ∀ w ∈ convexHull Real S, ρ ≤ ‖w - a‖) : + Metric.sphere a ρ ∩ convexHull Real (insert a S) = + (fun w => a + (ρ / ‖w - a‖) • (w - a)) '' convexHull Real S ∧ + IsPreconnected (Metric.sphere a ρ ∩ convexHull Real (insert a S)) := by +-- BODY + let K := convexHull Real S + let F : Complex → Complex := fun w => a + (ρ / ‖w - a‖) • (w - a) + have hK : IsPreconnected K := by + apply Convex.isPreconnected + exact convex_convexHull Real S + have hcont : ContinuousOn F K := by + have hsub : Continuous (fun w : Complex => w - a) := by fun_prop + have hsq : Continuous (fun w : Complex => Complex.normSq (w - a)) := + Complex.continuous_normSq.comp hsub + have hn : Continuous (fun w : Complex => ‖w - a‖) := by + convert Real.continuous_sqrt.comp hsq using 1 + ext w + change ‖w - a‖ = Real.sqrt (Complex.normSq (w - a)) + rw [Complex.normSq_eq_norm_sq, Real.sqrt_sq_eq_abs, + abs_of_nonneg (norm_nonneg (w - a))] + have hq : ContinuousOn (fun w : Complex => ρ / ‖w - a‖) K := by + apply ContinuousOn.div continuousOn_const hn.continuousOn + intro w hw + exact ne_of_gt (lt_of_lt_of_le hρ (hsep w hw)) + change ContinuousOn (fun w : Complex => a + (ρ / ‖w - a‖) • (w - a)) K + exact continuousOn_const.add (hq.smul (continuousOn_id.sub continuousOn_const)) + have heq : Metric.sphere a ρ ∩ convexHull Real (insert a S) = F '' K := by + ext z + constructor + · rintro ⟨hz, hzK⟩ + rw [convexHull_insert hS, mem_convexJoin] at hzK + rcases hzK with ⟨x, hx, w, hw, hzw⟩ + simp only [Set.mem_singleton_iff] at hx + subst x + rw [segment_eq_image_lineMap] at hzw + rcases hzw with ⟨t, ht, hzt⟩ + have hzt' : z - a = t • (w - a) := by + calc + z - a = AffineMap.lineMap a w t - a := by rw [hzt] + _ = t • (w - a) := by rw [AffineMap.lineMap_apply_module']; module + have hn : ρ = t * ‖w - a‖ := by + have hz' : ‖z - a‖ = ρ := by + simpa [Metric.mem_sphere, dist_eq_norm] using hz + rw [← hz', hzt', Complex.real_smul, Complex.norm_mul, Complex.norm_real, + Real.norm_eq_abs, abs_of_nonneg ht.1] + have hden : ‖w - a‖ ≠ 0 := ne_of_gt (lt_of_lt_of_le hρ (hsep w hw)) + have htval : t = ρ / ‖w - a‖ := by + rw [hn] + field_simp + refine ⟨w, hw, ?_⟩ + have hline : a + (ρ / ‖w - a‖) • (w - a) = AffineMap.lineMap a w t := by + rw [AffineMap.lineMap_apply_module', ← htval] + module + simpa [F] using hline.trans hzt + · rintro ⟨w, hw, rfl⟩ + have hden : 0 < ‖w - a‖ := lt_of_lt_of_le hρ (hsep w hw) + have hu : 0 < ρ / ‖w - a‖ := div_pos hρ hden + have hu1 : ρ / ‖w - a‖ ≤ 1 := (div_le_one hden).2 (hsep w hw) + have hseg : F w ∈ segment Real a w := by + rw [segment_eq_image_lineMap] + refine ⟨ρ / ‖w - a‖, ⟨le_of_lt hu, hu1⟩, ?_⟩ + change AffineMap.lineMap a w (ρ / ‖w - a‖) = _ + rw [AffineMap.lineMap_apply_module'] + module + have hconv : Convex Real (convexHull Real (insert a S)) := + convex_convexHull Real (insert a S) + have ha : a ∈ convexHull Real (insert a S) := subset_convexHull Real _ (by simp) + have hw' : w ∈ convexHull Real (insert a S) := + (convexHull_mono (Set.subset_insert a S)) hw + refine ⟨?_, hconv.segment_subset ha hw' hseg⟩ + rw [Metric.mem_sphere, dist_eq_norm] + change ‖a + (ρ / ‖w - a‖) • (w - a) - a‖ = ρ + rw [show a + (ρ / ‖w - a‖) • (w - a) - a = + (ρ / ‖w - a‖) • (w - a) by module] + rw [Complex.real_smul, Complex.norm_mul, Complex.norm_real, + Real.norm_eq_abs, abs_of_pos hu] + field_simp + exact ⟨heq, heq ▸ hK.image F hcont⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5050T1TangentLineSection.lean b/LeanPool/ApollonianSuperharmonic/P5050T1TangentLineSection.lean new file mode 100644 index 0000000000..88f6d23b4a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5050T1TangentLineSection.lean @@ -0,0 +1,491 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5050T1RadialSection +public import LeanPool.ApollonianSuperharmonic.P4953T1QuadrilateralSections +public import Mathlib.Analysis.Normed.Module.Convex + +-- [TABLET NODE: P5050T1TangentLineSection] + +/-! +# P5050T1TangentLineSection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TangentLineSectionProof + +private theorem hmem : + ∀ (h : ℝ), ∀ (σ : ℝ), ∀ (a : ℂ), ∀ (b : ℂ), ∀ (r : ℝ), ∀ (s : ℝ), (σ ^ (2 : ℕ) = (1 : ℝ)) → + (((0 : ℝ) < r) → (((0 : ℝ) < s) → ((σ * (a.re - h) = r) → ((σ * (b.re - h) = s) → ( + let fa : ℂ := ⟨h, a.im⟩ + let fb : ℂ := ⟨h, b.im⟩ + let Q := convexHull ℝ ({a, b, fa, fb} : Set ℂ) + (b.im - a.im ≠ 0) → ((σ * σ = 1) → ((∀ x : ℝ, σ * (σ * x) = x) → (∀ z ∈ Q, + min a.im b.im ≤ z.im ∧ z.im ≤ max a.im b.im ∧ + 0 ≤ σ * (z.re - h) ∧ + σ * (z.re - h) ≤ r * (1 - (z.im - a.im) / (b.im - a.im)) + + s * ((z.im - a.im) / (b.im - a.im)))))))))) := by + classical + intro h σ a b r s hσ hr hs ha hb fa fb Q hdne hσsq hσmul z hz + by_cases habh : a.im < b.im + · have hq := P4953T1QuadrilateralSections h σ a b hσ + (by simpa [ha] using hr) (by simpa [hb] using hs) habh + have hz' : z ∈ convexHull ℝ ({a,b,⟨h,a.im⟩,⟨h,b.im⟩} : Set ℂ) := by + simpa [fa, fb] using hz + have hm := (hq.1 z).mp hz' + have hupper : σ * (z.re - h) ≤ + r * (1 - (z.im - a.im) / (b.im - a.im)) + + s * ((z.im - a.im) / (b.im - a.im)) := by + have hlin := hm.2.2.2 + change 0 ≤ σ * (a.re + (b.re-a.re) * (z.im-a.im) / + (b.im-a.im) - z.re) at hlin + have hσa : a.re = h + σ * r := by + calc + a.re = h + (a.re-h) := by ring + _ = h + σ * (σ * (a.re-h)) := by rw [hσmul] + _ = h + σ * r := by rw [ha] + have hσb : b.re = h + σ * s := by + calc + b.re = h + (b.re-h) := by ring + _ = h + σ * (σ * (b.re-h)) := by rw [hσmul] + _ = h + σ * s := by rw [hb] + have hinterp : + a.re + (b.re - a.re) * (z.im - a.im) / (b.im - a.im) = + h + σ * (r * (1 - (z.im - a.im) / (b.im - a.im)) + + s * ((z.im - a.im) / (b.im - a.im))) := by + rw [hσa, hσb] + field_simp + ring + rw [hinterp] at hlin + have hsign : σ * (h + σ * (r * (1 - (z.im-a.im)/(b.im-a.im)) + + s * ((z.im-a.im)/(b.im-a.im))) - z.re) = + r * (1 - (z.im-a.im)/(b.im-a.im)) + + s * ((z.im-a.im)/(b.im-a.im)) - σ * (z.re-h) := by + calc + _ = (σ*σ) * (r * (1 - (z.im-a.im)/(b.im-a.im)) + + s * ((z.im-a.im)/(b.im-a.im))) - σ*(z.re-h) := by ring + _ = _ := by rw [hσsq]; ring + rw [hsign] at hlin + linarith + exact ⟨(min_le_iff.mpr (Or.inl hm.1)), (le_max_iff.mpr (Or.inr hm.2.1)), + hm.2.2.1, hupper⟩ + · have hba : b.im < a.im := by + have hle : b.im ≤ a.im := le_of_not_gt habh + have hne : b.im ≠ a.im := by + intro he + apply hdne + linarith + exact lt_of_le_of_ne hle hne + have hq := P4953T1QuadrilateralSections h σ b a hσ + (by simpa [hb] using hs) (by simpa [ha] using hr) hba + have hz' : z ∈ convexHull ℝ ({b,a,⟨h,b.im⟩,⟨h,a.im⟩} : Set ℂ) := by + apply convexHull_mono (s := ({a,b,fa,fb} : Set ℂ)) + · intro w hw + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hw ⊢ + tauto + · exact hz + have hm := (hq.1 z).mp hz' + have hupper : σ * (z.re - h) ≤ + r * (1 - (z.im - a.im) / (b.im - a.im)) + + s * ((z.im - a.im) / (b.im - a.im)) := by + have hlin := hm.2.2.2 + change 0 ≤ σ * (b.re + (a.re-b.re) * (z.im-b.im) / + (a.im-b.im) - z.re) at hlin + have hσa : a.re = h + σ * r := by + calc + a.re = h + (a.re-h) := by ring + _ = h + σ * (σ * (a.re-h)) := by rw [hσmul] + _ = h + σ * r := by rw [ha] + have hσb : b.re = h + σ * s := by + calc + b.re = h + (b.re-h) := by ring + _ = h + σ * (σ * (b.re-h)) := by rw [hσmul] + _ = h + σ * s := by rw [hb] + have hparam : (z.im-b.im)/(a.im-b.im) = + 1 - (z.im-a.im)/(b.im-a.im) := by + have hne : a.im-b.im ≠ 0 := by linarith [hba] + field_simp [hdne, hne] + ring + have hinterp : + b.re + (a.re - b.re) * (z.im - b.im) / (a.im - b.im) = + h + σ * (r * (1 - (z.im - a.im) / (b.im - a.im)) + + s * ((z.im - a.im) / (b.im - a.im))) := by + rw [show (a.re-b.re)*(z.im-b.im)/(a.im-b.im) = + (a.re-b.re)*((z.im-b.im)/(a.im-b.im)) by ring, hparam, hσa, hσb] + ring + rw [hinterp] at hlin + have hsign : σ * (h + σ * (r * (1 - (z.im-a.im)/(b.im-a.im)) + + s * ((z.im-a.im)/(b.im-a.im))) - z.re) = + r * (1 - (z.im-a.im)/(b.im-a.im)) + + s * ((z.im-a.im)/(b.im-a.im)) - σ * (z.re-h) := by + calc + _ = (σ*σ) * (r * (1 - (z.im-a.im)/(b.im-a.im)) + + s * ((z.im-a.im)/(b.im-a.im))) - σ*(z.re-h) := by ring + _ = _ := by rw [hσsq]; ring + rw [hsign] at hlin + linarith + exact ⟨(min_le_iff.mpr (Or.inr hm.1)), (le_max_iff.mpr (Or.inl hm.2.1)), + hm.2.2.1, hupper⟩ + +private theorem ht0 : + ∀ (h : ℝ), ∀ (σ : ℝ), ∀ (a : ℂ), ∀ (b : ℂ), ∀ (r : ℝ), ∀ (s : ℝ), (b.im - a.im ≠ 0) → (∀ (z : + ℂ), (min a.im b.im ≤ z.im ∧ z.im ≤ max a.im b.im ∧ (0 : ℝ) ≤ σ * (z.re - h) ∧ σ * (z.re - + h) ≤ r * ((1 : ℝ) - (z.im - a.im) / (b.im - a.im)) + s * ((z.im - a.im) / (b.im - a.im))) + → ( + let t := (z.im - a.im) / (b.im - a.im) + 0 ≤ t)) := by + classical + intro h σ a b r s hdne z hm t + dsimp [t] + by_cases hdb : 0 < b.im - a.im + · have habh : a.im < b.im := by linarith + have hzge : a.im ≤ z.im := by + simpa [min_eq_left habh.le] using hm.1 + exact div_nonneg (sub_nonneg.mpr hzge) hdb.le + · have hdvals : b.im ≠ a.im := by + intro hh + apply hdne + linarith + have hdb' : b.im - a.im < 0 := lt_of_le_of_ne (le_of_not_gt hdb) hdne + have hzle : z.im ≤ a.im := by + rcases le_max_iff.mp hm.2.1 with hza | hzb + · exact hza + · linarith + exact div_nonneg_of_nonpos (by linarith) hdb'.le + +private theorem ht1 : + ∀ (h : ℝ), ∀ (σ : ℝ), ∀ (a : ℂ), ∀ (b : ℂ), ∀ (r : ℝ), ∀ (s : ℝ), (b.im - a.im ≠ 0) → (∀ (z : + ℂ), (min a.im b.im ≤ z.im ∧ z.im ≤ max a.im b.im ∧ (0 : ℝ) ≤ σ * (z.re - h) ∧ σ * (z.re - + h) ≤ r * ((1 : ℝ) - (z.im - a.im) / (b.im - a.im)) + s * ((z.im - a.im) / (b.im - a.im))) + → ( + let t := (z.im - a.im) / (b.im - a.im) + t ≤ 1)) := by + classical + intro h σ a b r s hdne z hm t + dsimp [t] + by_cases hdb : 0 < b.im - a.im + · have hzle : z.im ≤ b.im := by + rcases le_max_iff.mp hm.2.1 with hza | hzb + · linarith + · exact hzb + exact (div_le_one₀ hdb).2 (by linarith) + · have hdvals : b.im ≠ a.im := by + intro hh + apply hdne + linarith + have hdb' : b.im - a.im < 0 := lt_of_le_of_ne (le_of_not_gt hdb) hdne + have hzge : b.im ≤ z.im := by + rcases min_le_iff.mp hm.1 with hza | hzb + · exact (sub_nonpos.mp hdb'.le).trans hza + · exact hzb + exact (div_le_iff_of_neg hdb').2 (by linarith [hzge]) + +private theorem hzcoordAt300 : + ∀ (h : ℝ), ∀ (σ : ℝ), ∀ (a : ℂ), ∀ (b : ℂ), ∀ (r : ℝ), ∀ (s : ℝ), ((0 : ℝ) < s) → ((σ * (a.re + - h) = r) → ((σ * (b.re - h) = s) → ( + let fb : ℂ := ⟨h, b.im⟩ + (b.im - a.im ≠ 0) → ((∀ x : ℝ, σ * (σ * x) = x) → (∀ (z : ℂ), + let t := (z.im - a.im) / (b.im - a.im) + let X := σ * (z.re - h) + let v := (X - r * (1 - t)) / s + z = + (1 - t) • a + v • b + (t - v) • fb))))) := by + classical + intro h σ a b r s hs ha hb fb hdne hσmul z t X v + apply Complex.ext + · simp only [Complex.add_re, Complex.smul_re, + fb, smul_eq_mul] + have haR : a.re = h + σ * r := by + calc + a.re = h + (a.re-h) := by ring + _ = h + σ * (σ * (a.re-h)) := by rw [hσmul] + _ = h + σ * r := by rw [ha] + have hbR : b.re = h + σ * s := by + calc + b.re = h + (b.re-h) := by ring + _ = h + σ * (σ * (b.re-h)) := by rw [hσmul] + _ = h + σ * s := by rw [hb] + have hzR : z.re = h + σ * X := by dsimp [X]; rw [hσmul]; ring + rw [haR, hbR, hzR] + have hx : X = r * (1-t) + s*v := by + dsimp [v] + field_simp [ne_of_gt hs] + ring + rw [hx] + ring + · simp only [Complex.add_im, Complex.smul_im, + fb, smul_eq_mul] + have hzI : z.im = a.im + t * (b.im - a.im) := by + dsimp [t] + field_simp [hdne] + ring + rw [hzI] + ring + +private theorem hwAt331 : + ∀ (h : ℝ), ∀ (σ : ℝ), ∀ (a : ℂ), ∀ (b : ℂ), ∀ (r : ℝ), ∀ (s : ℝ), + let fb : ℂ := ⟨h, b.im⟩ + ∀ (z : ℂ), + let t := (z.im - a.im) / (b.im - a.im) + let X := σ * (z.re - h) + (t ≤ 1) → ( + let v := (X - r * (1 - t)) / s + (0 ≤ v) → ((v ≤ t) → ((1 - t) • a + v • b + (t-v) • fb ∈ + convexHull ℝ ({a,b,fb} : Set ℂ)))) := by + classical + intro h σ a b r s fb z t X ht1 v hv0 hvt + apply mem_convexHull_of_exists_fintype (ι := Fin 3) + ![1-t,v,t-v] ![a,b,fb] + · intro i + fin_cases i <;> simp <;> linarith + · simp [Fin.sum_univ_succ] + · intro i + fin_cases i <;> simp + · simp [Fin.sum_univ_succ, add_assoc] + +private theorem hzcoordAt349 : + ∀ (h : ℝ), ∀ (σ : ℝ), ∀ (a : ℂ), ∀ (b : ℂ), ∀ (r : ℝ), ((0 : ℝ) < r) → ((σ * (a.re - h) = r) → ( + let fa : ℂ := ⟨h, a.im⟩ + let fb : ℂ := ⟨h, b.im⟩ + (b.im - a.im ≠ 0) → ((∀ x : ℝ, σ * (σ * x) = x) → (∀ (z : ℂ), + let t := (z.im - a.im) / (b.im - a.im) + let X := σ * (z.re - h) + let u := X / r + z = u • a + t • fb + (1-t-u) • fa)))) := by + classical + intro h σ a b r hr ha fa fb hdne hσmul z t X u + apply Complex.ext + · simp only [Complex.add_re, Complex.smul_re, + fa, fb, smul_eq_mul] + have haR : a.re = h + σ * r := by + calc + a.re = h + (a.re-h) := by ring + _ = h + σ * (σ * (a.re-h)) := by rw [hσmul] + _ = h + σ * r := by rw [ha] + have hzR : z.re = h + σ * X := by dsimp [X]; rw [hσmul]; ring + rw [haR, hzR] + have hx : u * r = X := by + dsimp [u] + field_simp [ne_of_gt hr] + calc + h + σ * X = h + σ * (u * r) := by rw [hx] + _ = u * (h + σ * r) + t * h + (1-t-u) * h := by ring + · simp only [Complex.add_im, Complex.smul_im, + fa, fb, smul_eq_mul] + have hzI : z.im = a.im + t * (b.im - a.im) := by + dsimp [t] + field_simp [hdne] + ring + rw [hzI] + ring + +private theorem hwAt374 : + ∀ (h : ℝ), ∀ (σ : ℝ), ∀ (a : ℂ), ∀ (b : ℂ), ∀ (r : ℝ), + let fa : ℂ := ⟨h, a.im⟩ + let fb : ℂ := ⟨h, b.im⟩ + ∀ (z : ℂ), + let t := (z.im - a.im) / (b.im - a.im) + let X := σ * (z.re - h) + (0 ≤ t) → ( + let u := X / r + (0 ≤ u) → ((u ≤ 1-t) → (u • a + t • fb + (1-t-u) • fa ∈ + convexHull ℝ ({a,fb,fa} : Set ℂ)))) := by + classical + intro h σ a b r fa fb z t X ht0 u hu0 hu1 + apply mem_convexHull_of_exists_fintype (ι := Fin 3) + ![u,t,1-t-u] ![a,fb,fa] + · intro i + fin_cases i <;> simp <;> linarith + · simpa [Fin.sum_univ_succ, add_assoc] using + (show u+t+(1-t-u)=1 by ring) + · intro i + fin_cases i <;> simp + · simp [Fin.sum_univ_succ, add_assoc] + +private theorem sepOne : + ∀ (h : ℝ), ∀ (a : ℂ), ∀ (b : ℂ), ∀ (r : ℝ), ∀ (s : ℝ), ((0 : ℝ) < s) → ((dist a b = r + s) → ( + let fb : ℂ := ⟨h, b.im⟩ + (dist b fb = s) → (∀ w ∈ convexHull ℝ ({b, fb} : Set ℂ), r ≤ ‖w - a‖))) := by + classical + intro h a b r s hs hab fb hbf w hw + rw [convexHull_pair] at hw + have hwb : w ∈ Metric.closedBall b s := + (convex_closedBall b s).segment_subset + (Metric.mem_closedBall.mpr (by simpa using hs.le)) + (Metric.mem_closedBall.mpr (by simpa only [dist_comm] using hbf.le)) hw + have ht := dist_triangle a w b + rw [hab] at ht + have hwa : dist a w = ‖w - a‖ := by rw [dist_eq_norm, norm_sub_rev] + have hbnd := Metric.mem_closedBall.mp hwb + linarith + +private theorem sepTwo : + ∀ (h : ℝ), ∀ (σ : ℝ), ∀ (a : ℂ), ∀ (b : ℂ), ∀ (r : ℝ), ((0 : ℝ) < r) → ((σ * (a.re - h) = r) → ( + let fa : ℂ := ⟨h, a.im⟩ + let fb : ℂ := ⟨h, b.im⟩ + (∀ (y : ℝ), ∀ (t : ℝ), (0 < t) → ((σ * (y - h) = t) → (|y - h| = t))) → (∀ w ∈ convexHull ℝ + ({fb, fa} : Set ℂ), r ≤ ‖w - a‖))) := by + classical + intro h σ a b r hr ha fa fb absSigned w hw + rw [convexHull_pair, segment_eq_image] at hw + obtain ⟨t, _, rfl⟩ := hw + have hre : ((1 - t) • fb + t • fa).re = h := by + simp only [Complex.add_re, Complex.smul_re, fa, fb, smul_eq_mul] + ring + have hh := Complex.abs_re_le_norm ((1 - t) • fb + t • fa - a) + rw [Complex.sub_re, hre, abs_sub_comm] at hh + rw [absSigned a.re r hr ha] at hh + exact hh + +end TangentLineSectionProof + +theorem P5050T1TangentLineSection (h σ : ℝ) (a b : ℂ) (r s : ℝ) + (hσ : σ ^ 2 = 1) (hr : 0 < r) (hs : 0 < s) + (ha : σ * (a.re - h) = r) (hb : σ * (b.re - h) = s) + (hab : dist a b = r + s) : + let fa : ℂ := ⟨h, a.im⟩ + let fb : ℂ := ⟨h, b.im⟩ + let F (w : ℂ) := a + (r / ‖w - a‖) • (w - a) + let Q := convexHull ℝ ({a, b, fa, fb} : Set ℂ) + Q = convexHull ℝ ({a, b, fb} : Set ℂ) ∪ + convexHull ℝ ({a, fb, fa} : Set ℂ) ∧ + Metric.sphere a r ∩ Q = F '' segment ℝ b fb ∪ F '' segment ℝ fb fa ∧ + IsPreconnected (Metric.sphere a r ∩ Q) := by +-- BODY + exact (by + dsimp only + let fa : ℂ := ⟨h, a.im⟩ + let fb : ℂ := ⟨h, b.im⟩ + let F (w : ℂ) := a + (r / ‖w - a‖) • (w - a) + let Q := convexHull ℝ ({a, b, fa, fb} : Set ℂ) + have hsplit : Q = convexHull ℝ ({a, b, fb} : Set ℂ) ∪ + convexHull ℝ ({a, fb, fa} : Set ℂ) := by + classical + have hnorm : ‖a - b‖ = r + s := by + simpa [dist_eq_norm] using hab + have hnorm2 := congrArg (fun x : ℝ => x ^ 2) hnorm + rw [← Complex.normSq_eq_norm_sq, Complex.normSq_apply, Complex.sub_re, + Complex.sub_im] at hnorm2 + have hre : (a.re - b.re) ^ 2 = (r - s) ^ 2 := by + have hσsq : σ * σ = 1 := by nlinarith [hσ] + nlinarith [ha, hb] + have hd2 : (b.im - a.im) ^ 2 = 4 * r * s := by nlinarith [hnorm2, hre] + have hdne : b.im - a.im ≠ 0 := by + intro hz + rw [hz] at hd2 + nlinarith [mul_pos hr hs] + have hσsq : σ * σ = 1 := by nlinarith [hσ] + have hσmul : ∀ x : ℝ, σ * (σ * x) = x := by + intro x + calc + σ * (σ * x) = (σ * σ) * x := by ring + _ = x := by rw [hσsq]; ring + have hmem : ∀ z ∈ Q, + min a.im b.im ≤ z.im ∧ z.im ≤ max a.im b.im ∧ + 0 ≤ σ * (z.re - h) ∧ + σ * (z.re - h) ≤ r * (1 - (z.im - a.im) / (b.im - a.im)) + + s * ((z.im - a.im) / (b.im - a.im)) := TangentLineSectionProof.hmem h σ a b r s hσ hr + hs ha hb hdne hσsq hσmul + apply Set.Subset.antisymm + · intro z hz + have hm := hmem z hz + let t := (z.im - a.im) / (b.im - a.im) + let X := σ * (z.re - h) + have ht0 : 0 ≤ t := TangentLineSectionProof.ht0 h σ a b r s hdne z hm + have ht1 : t ≤ 1 := TangentLineSectionProof.ht1 h σ a b r s hdne z hm + have hX0 : 0 ≤ X := by exact hm.2.2.1 + have hXupper : X ≤ r * (1 - t) + s * t := by exact hm.2.2.2 + by_cases hcut : r * (1 - t) ≤ X + · let v := (X - r * (1 - t)) / s + have hv0 : 0 ≤ v := by dsimp [v]; exact div_nonneg (by linarith) hs.le + have hvt : v ≤ t := by + dsimp [v] + apply (div_le_iff₀ hs).2 + nlinarith [hXupper] + have hzcoord : z = + (1 - t) • a + v • b + (t - v) • fb := TangentLineSectionProof.hzcoordAt300 h σ a b r + s hs ha hb hdne hσmul z + have hw : (1 - t) • a + v • b + (t-v) • fb ∈ + convexHull ℝ ({a,b,fb} : Set ℂ) := TangentLineSectionProof.hwAt331 h σ a b r s z ht1 + hv0 hvt + rw [hzcoord] + exact Or.inl hw + · let u := X / r + have hu0 : 0 ≤ u := by dsimp [u]; exact div_nonneg hX0 hr.le + have hu1 : u ≤ 1-t := by + dsimp [u] + apply (div_le_iff₀ hr).2 + linarith + have hzcoord : z = u • a + t • fb + (1-t-u) • fa := TangentLineSectionProof.hzcoordAt349 + h σ a b r hr ha hdne hσmul z + have hw : u • a + t • fb + (1-t-u) • fa ∈ + convexHull ℝ ({a,fb,fa} : Set ℂ) := TangentLineSectionProof.hwAt374 h σ a b r z ht0 + hu0 hu1 + rw [hzcoord] + exact Or.inr hw + · intro z hz + rcases hz with hzOne | hzTwo + · have hs : ({a,b,fb} : Set ℂ) ⊆ ({a,b,fa,fb} : Set ℂ) := by + exact Set.insert_subset_insert + (Set.insert_subset_insert (Set.subset_insert fa ({fb} : Set ℂ))) + exact convexHull_mono hs hzOne + · have hperm : ({a,fb,fa} : Set ℂ) = ({a,fa,fb} : Set ℂ) := by + ext w + simp [eq_comm, or_comm] + have hsub : ({a,fa,fb} : Set ℂ) ⊆ ({a,b,fa,fb} : Set ℂ) := by + exact Set.insert_subset_insert (Set.subset_insert b (insert fa ({fb} : Set ℂ))) + have hs : ({a,fb,fa} : Set ℂ) ⊆ ({a,b,fa,fb} : Set ℂ) := by + rw [hperm] + exact hsub + exact convexHull_mono hs hzTwo + have hσsqOuter : σ * σ = 1 := by nlinarith [hσ] + have hσmulOuter : ∀ x : ℝ, σ * (σ * x) = x := by + intro x + calc + σ * (σ * x) = (σ * σ) * x := by ring + _ = x := by rw [hσsqOuter]; ring + have absSigned (y t : ℝ) (ht : 0 < t) (hy : σ * (y - h) = t) : + |y - h| = t := by + have hh := congrArg (fun x : ℝ => x ^ 2) hy + rw [mul_pow, hσ, one_mul] at hh + nlinarith [sq_abs (y - h), abs_nonneg (y - h)] + have hbf : dist b fb = s := by + rw [Complex.dist_eq] + have hv : b - fb = ((b.re - h : ℝ) : ℂ) := by + apply Complex.ext <;> simp [fb] + rw [hv, Complex.norm_real, Real.norm_eq_abs] + exact absSigned b.re s hs hb + have sepOne : ∀ w ∈ convexHull ℝ ({b, fb} : Set ℂ), r ≤ ‖w - a‖ := + TangentLineSectionProof.sepOne h a b r s hs hab hbf + have sepTwo : ∀ w ∈ convexHull ℝ ({fb, fa} : Set ℂ), r ≤ ‖w - a‖ := + TangentLineSectionProof.sepTwo h σ a b r hr ha absSigned + have hOne := P5050T1RadialSection a r {b, fb} hr ⟨b, by simp⟩ sepOne + have hTwo := P5050T1RadialSection a r {fb, fa} hr ⟨fb, by simp⟩ sepTwo + have heq : Metric.sphere a r ∩ Q = F '' segment ℝ b fb ∪ F '' segment ℝ fb fa := by + rw [hsplit, Set.inter_union_distrib_left, hOne.1, hTwo.1, convexHull_pair, + convexHull_pair] + refine ⟨hsplit, heq, ?_⟩ + have hmOne : F fb ∈ Metric.sphere a r ∩ convexHull ℝ ({a, b, fb} : Set ℂ) := by + rw [hOne.1] + exact ⟨fb, by rw [convexHull_pair]; exact right_mem_segment ℝ b fb, rfl⟩ + have hmTwo : F fb ∈ Metric.sphere a r ∩ convexHull ℝ ({a, fb, fa} : Set ℂ) := by + rw [hTwo.1] + exact ⟨fb, by rw [convexHull_pair]; exact left_mem_segment ℝ fb fa, rfl⟩ + change IsPreconnected (Metric.sphere a r ∩ Q) + rw [hsplit, Set.inter_union_distrib_left] + exact IsPreconnected.union (F fb) hmOne hmTwo hOne.2 hTwo.2 + ) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5050T1TangentTriangleSection.lean b/LeanPool/ApollonianSuperharmonic/P5050T1TangentTriangleSection.lean new file mode 100644 index 0000000000..5c30a2b256 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5050T1TangentTriangleSection.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5050T1RadialSection +public import LeanPool.ApollonianSuperharmonic.P4909T1TangentSegments + +-- [TABLET NODE: P5050T1TangentTriangleSection] + +/-! +# P5050T1TangentTriangleSection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5050T1TangentTriangleSection : + ∀ (a : Complex), ∀ (b : Complex), ∀ (c : Complex), ∀ (ρ : Real), ∀ (s : Real), ∀ (t : Real), + (0 < ρ) → ((0 ≤ s) → ((0 ≤ t) → ((dist a b = ρ + s) → ((dist a c = ρ + t) → ((dist b c = + s + t) → (IsPreconnected (Metric.sphere a ρ ∩ + convexHull Real ({a, b, c} : Set Complex)))))))) := by + intro a b c ρ s t hρ hs ht hab hac hbc +-- BODY + have hseg := P4909T1TangentSegments b c s t hbc + have hsep : ∀ w ∈ convexHull Real ({b, c} : Set Complex), + ρ ≤ ‖w - a‖ := by + intro w hw + rw [convexHull_pair] at hw + rcases hseg.1 hw with hb | hc + · have hwb : dist w b ≤ s := Metric.mem_closedBall.mp hb + have htri := dist_triangle a w b + rw [hab] at htri + have hnorm : dist a w = ‖w - a‖ := by + rw [dist_eq_norm, norm_sub_rev] + linarith [hnorm] + · have hwc : dist w c ≤ t := Metric.mem_closedBall.mp hc + have htri := dist_triangle a w c + rw [hac] at htri + have hnorm : dist a w = ‖w - a‖ := by + rw [dist_eq_norm, norm_sub_rev] + linarith [hnorm] + have hnonempty : ({b, c} : Set Complex).Nonempty := ⟨b, by simp⟩ + have hrad := (P5050T1RadialSection a ρ {b, c} hρ hnonempty hsep).2 + have hset : ({a, b, c} : Set Complex) = insert a ({b, c} : Set Complex) := by + ext z + simp [] + rw [hset] at hrad + exact hrad + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5064T3CrossParentSupport.lean b/LeanPool/ApollonianSuperharmonic/P5064T3CrossParentSupport.lean new file mode 100644 index 0000000000..13f3946765 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5064T3CrossParentSupport.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5064T3Rectangles +public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P5064T3CrossParentSupport] + +/-! +# P5064T3CrossParentSupport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5064T3CrossParentSupport (r s : Nat) (hs : 0 < s) (hrs : s < r) : + FootprintVertices (P5064T3Rectangles r s 0 true) ∩ + FootprintVertices (P5064T3Rectangles r s 1 true) = + {z | z.re = (r : Int) ∧ 0 ≤ z.im ∧ z.im ≤ (s : Int)} ∧ + FootprintVertices (P5064T3Rectangles r s 0 true) ∩ + FootprintVertices (P5064T3Rectangles r s 1 true) ⊆ + FootprintVertices (P5064T3Rectangles (r - s) s 1 true) ∩ + FootprintVertices (P5064T3Rectangles r s 1 true) := by +-- BODY + have shift (n : Nat) (hn : 0 < n) (a b : Int) : + FootprintVertices (TileTranslation (FordTile n) ⟨a, b⟩) = + {z | a ≤ z.re ∧ z.re ≤ a + (n : Int) ∧ + b ≤ z.im ∧ z.im ≤ b + (n : Int)} := by + rw [(TileTranslationFormulas _ _).2.2.2.2.2.1, + (P4062T1CanonicalSupport n hn).1] + ext z + constructor + · rintro ⟨w, hw, rfl⟩ + change 0 ≤ w.re ∧ w.re ≤ (n : Int) ∧ + 0 ≤ w.im ∧ w.im ≤ (n : Int) at hw + simp only [Set.mem_ofPred_eq, GaussianTranslation, Zsqrtd.re_add, + Zsqrtd.im_add] + omega + · intro hz + refine ⟨z - ⟨a, b⟩, ?_, ?_⟩ + · change 0 ≤ (z - ⟨a, b⟩).re ∧ (z - ⟨a, b⟩).re ≤ (n : Int) ∧ + 0 ≤ (z - ⟨a, b⟩).im ∧ (z - ⟨a, b⟩).im ≤ (n : Int) + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + change a ≤ z.re ∧ z.re ≤ a + (n : Int) ∧ + b ≤ z.im ∧ z.im ≤ b + (n : Int) at hz + omega + · simp [GaussianTranslation] + have root := (P4062T1CanonicalSupport r (by omega)).1 + change FootprintVertices (FordTile r) = + {z | 0 ≤ z.re ∧ z.re ≤ (r : Int) ∧ 0 ≤ z.im ∧ z.im ≤ (r : Int)} at root + change FootprintVertices (FordTile r) ∩ + FootprintVertices (TileTranslation (FordTile s) ⟨(r : Int), 0⟩) = _ ∧ + FootprintVertices (FordTile r) ∩ + FootprintVertices (TileTranslation (FordTile s) ⟨(r : Int), 0⟩) ⊆ + FootprintVertices (TileTranslation (FordTile s) ⟨((r - s : Nat) : Int), 0⟩) ∩ + FootprintVertices (TileTranslation (FordTile s) ⟨(r : Int), 0⟩) + rw [root, shift s hs (r : Int) 0, shift s hs ((r - s : Nat) : Int) 0] + constructor + · ext z + simp only [Set.mem_inter_iff, Set.mem_ofPred_eq] + omega + · intro z hz + simp only [Set.mem_inter_iff, Set.mem_ofPred_eq] at hz ⊢ + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5064T3LiteralLocalization.lean b/LeanPool/ApollonianSuperharmonic/P5064T3LiteralLocalization.lean new file mode 100644 index 0000000000..513ebf9f3a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5064T3LiteralLocalization.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5064T3Rectangles +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.FootprintEdges + +-- [TABLET NODE: P5064T3LiteralLocalization] + +/-! +# P5064T3LiteralLocalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5064T3LiteralLocalization (P : FordFareyParameter) (hq : 1 < P.q) + (T : ProtoTile) (t : GaussianInt) + (hcent : TileCentroid T = TileCentroid (TileTranslation (FordTile P.q) t)) + (S : Fin 3 → Bool → ProtoTile) + (hS : ∀ i b, BandSubtileOccurrence (FordRecursiveQuadruple P) T i b (S i b)) : + ∀ i b, + let U := TileTranslation (P5064T3Rectangles P.q₁ P.q₂ i b) t + (S i b).cells = U.cells ∧ + ((S i b).cells = ∅ → (S i b).anchor = U.anchor) ∧ + FootprintVertices (S i b) = FootprintVertices U ∧ + FootprintEdges (S i b) = FootprintEdges U ∧ + TileCentroid (S i b) = TileCentroid U := by +-- BODY + classical + obtain ⟨_, W, hw, _, hA, hB, hC, hD, hE, haE, hF, haF⟩ := + (FordTileRecursiveIdentification P).2.2 hq + have q1pos : 0 < P.q₁ := by + by_contra hn + have hz : P.q₁ = 0 := by omega + have hd := P.det₁ + simp [hz] at hd + have hdv : (P.q : Int) ∣ 1 := ⟨P.p₁, by simpa [mul_comm] using hd.symm⟩ + have := Int.eq_one_of_dvd_one (by omega) hdv + omega + have ne (n : Nat) (hn : 0 < n) : (FordTile n).cells.Nonempty := by + refine ⟨0, ?_⟩ + change 0 ∈ ((Finset.range n).product (Finset.range n)).image + (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) + exact Finset.mem_image.mpr ⟨(0, 0), by simp [hn], rfl⟩ + have n1 := Finset.nonempty_iff_ne_empty.mp (ne P.q₁ q1pos) + have n2 := Finset.nonempty_iff_ne_empty.mp (ne P.q₂ P.q₂_pos) + have cells (i : Fin 3) (b : Bool) : + (W i b).cells = (P5064T3Rectangles P.q₁ P.q₂ i b).cells := by + fin_cases i <;> cases b <;> + simp [P5064T3Rectangles, hA, hB, hC, hD, hE, hF] + have anchors (i : Fin 3) (b : Bool) (he : (W i b).cells = ∅) : + (W i b).anchor = (P5064T3Rectangles P.q₁ P.q₂ i b).anchor := by + have hem := (cells i b).symm.trans he + fin_cases i <;> cases b <;> + simp [P5064T3Rectangles, TileTranslation, n1, n2] at hem + · exact haF + · simpa [P5064T3Rectangles, P.sum_q] using haE + intro i b + have hc : + (TileTranslation (W i b) t).cells = + (TileTranslation (P5064T3Rectangles P.q₁ P.q₂ i b) t).cells := by + change (W i b).cells.image _ = (P5064T3Rectangles P.q₁ P.q₂ i b).cells.image _ + rw [cells] + have ha (he : (TileTranslation (W i b) t).cells = ∅) : + (TileTranslation (W i b) t).anchor = + (TileTranslation (P5064T3Rectangles P.q₁ P.q₂ i b) t).anchor := by + have he' := (TileTranslationFormulas (W i b) t).2.2.1.mp he + change GaussianTranslation t (W i b).anchor = + GaussianTranslation t (P5064T3Rectangles P.q₁ P.q₂ i b).anchor + rw [anchors i b he'] + have hd := (hS i b).2.2.trans (hw i b).2.2.symm + have hcent' : TileCentroid (S i b) = TileCentroid (TileTranslation (W i b) t) := by + rw [(TileTranslationFormulas _ _).2.2.2.2.1] at hcent ⊢ + apply Prod.ext + · have hd1 := congrArg Prod.fst hd + have hr1 := congrArg Prod.fst hcent + change (TileCentroid (S i b)).1 - (TileCentroid T).1 = + (TileCentroid (W i b)).1 - (TileCentroid (FordTile P.q)).1 at hd1 + change (TileCentroid T).1 = + (TileCentroid (FordTile P.q)).1 + (t.re : Int) at hr1 + change (TileCentroid (S i b)).1 = (TileCentroid (W i b)).1 + (t.re : Int) + linarith + · have hd2 := congrArg Prod.snd hd + have hr2 := congrArg Prod.snd hcent + change (TileCentroid (S i b)).2 - (TileCentroid T).2 = + (TileCentroid (W i b)).2 - (TileCentroid (FordTile P.q)).2 at hd2 + change (TileCentroid T).2 = + (TileCentroid (FordTile P.q)).2 + (t.im : Int) at hr2 + change (TileCentroid (S i b)).2 = (TileCentroid (W i b)).2 + (t.im : Int) + linarith + have hu := BandPrototileCentroidUnique _ _ _ (hS i b).1 + (BandPrototileTranslation _ _ t (hw i b).1) hcent' + have finalCells := hu.1.trans hc + have finalAnchor (he : (S i b).cells = ∅) : + (S i b).anchor = + (TileTranslation (P5064T3Rectangles P.q₁ P.q₂ i b) t).anchor := + (hu.2 he).trans (ha (hu.1.symm.trans he)) + have obs := ProtoTileObservableExtensionality _ _ finalCells finalAnchor + refine ⟨finalCells, finalAnchor, obs.1, ?_, obs.2.2.2.2⟩ + simp only [FootprintEdges] + rw [finalCells] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5064T3OrderedPredecessor.lean b/LeanPool/ApollonianSuperharmonic/P5064T3OrderedPredecessor.lean new file mode 100644 index 0000000000..5ff8a502ea --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5064T3OrderedPredecessor.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision + +-- [TABLET NODE: P5064T3OrderedPredecessor] + +/-! +# P5064T3OrderedPredecessor + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5064T3OrderedPredecessor (P : FordFareyParameter) + (r : Fin 4 → CircleCoordinates) (hr : ProperBandQuadruple r) + (hr0 : r 0 = (FordRecursiveQuadruple P) 1) + (hr2 : r 2 = (FordRecursiveQuadruple P) 2) + (hr3 : r 3 = (FordRecursiveQuadruple P) 3) + (h12 : ((FordRecursiveQuadruple P) 2).1 ≤ + ((FordRecursiveQuadruple P) 1).1) + (h2large : 1 < ((FordRecursiveQuadruple P) 2).1) : + 2 ≤ P.q₂ ∧ P.q₂ < P.q₁ ∧ 0 < P.q₁ - P.q₂ ∧ + ∃ P₁ : FordFareyParameter, + P₁.p = P.p₁ ∧ P₁.q = P.q₁ ∧ + P₁.p₁ = P.p₁ - P.p₂ ∧ P₁.q₁ = P.q₁ - P.q₂ ∧ + P₁.p₂ = P.p₂ ∧ P₁.q₂ = P.q₂ ∧ + r = FordRecursiveQuadruple P₁ := by +-- BODY + have h2 : 1 < (P.q₂ : Int) * (P.q₂ : Int) := by + simpa [FordRecursiveQuadruple, FordCircleCoordinate] using h2large + have hs : 2 ≤ P.q₂ := by + by_contra h + have hz : P.q₂ = 0 ∨ P.q₂ = 1 := by omega + rcases hz with hz | hz <;> norm_num [hz] at h2 + have hn : P.q₁ ≠ 0 := by + intro hz + have hh := h12 + simp [FordRecursiveQuadruple, FordCircleCoordinate, hz] at hh + nlinarith [hh] + have hle : P.q₂ ≤ P.q₁ := by + have hh : (P.q₂ : Int) * (P.q₂ : Int) ≤ (P.q₁ : Int) * (P.q₁ : Int) := by + simpa [FordRecursiveQuadruple, FordCircleCoordinate, hn] using h12 + by_contra h + have hgt : (P.q₁ : Int) < (P.q₂ : Int) := by omega + nlinarith [Nat.cast_nonneg (α := Int) P.q₁, + Nat.cast_nonneg (α := Int) P.q₂] + have cross : P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 := by + have h := P.det₁ + rw [P.sum_q, P.sum_p, Nat.cast_add] at h + nlinarith [h] + have hrs : P.q₂ < P.q₁ := by + by_contra h + have he : P.q₁ = P.q₂ := by omega + have hd : (P.q₂ : Int) ∣ 1 := ⟨P.p₁ - P.p₂, by + rw [he] at cross + nlinarith [cross]⟩ + have := Int.eq_one_of_dvd_one (by omega) hd + omega + have red : Nat.Coprime P.q₁ P.p₁.natAbs := by + rw [Nat.coprime_iff_gcd_eq_one] + apply Nat.dvd_one.mp + let g := Nat.gcd P.q₁ P.p₁.natAbs + have gb : (g : Int) ∣ (P.q₁ : Int) := by + exact_mod_cast Nat.gcd_dvd_left P.q₁ P.p₁.natAbs + have ga : (g : Int) ∣ P.p₁ := + Int.dvd_natAbs.mp (by exact_mod_cast Nat.gcd_dvd_right P.q₁ P.p₁.natAbs) + have gd : (g : Int) ∣ 1 := by + rw [← cross] + exact dvd_sub (dvd_mul_of_dvd_left ga _) (dvd_mul_of_dvd_left gb _) + have hg : (g : Int) = 1 := Int.eq_one_of_dvd_one (by omega) gd + have hg' : g = 1 := by exact_mod_cast hg + change g ∣ 1 + rw [hg'] + let P₁ : FordFareyParameter := { + p := P.p₁ + q := P.q₁ + q_pos := by omega + reduced := red + p₁ := P.p₁ - P.p₂ + q₁ := P.q₁ - P.q₂ + p₂ := P.p₂ + q₂ := P.q₂ + sum_p := by ring + sum_q := by omega + det₁ := by + rw [Nat.cast_sub hrs.le] + nlinarith [cross] + det₂ := by nlinarith [cross] + q₁_lt := by omega + q₂_pos := P.q₂_pos + unit_case := by intro h; omega } + have child : (FordRecursiveQuadruple P₁) 0 = (FordRecursiveQuadruple P) 1 := by + simp [FordRecursiveQuadruple, P₁, hn] + have hp := ((FordCoordinateConfiguration P₁).2 (by change 1 < P.q₁; omega)).1 + obtain ⟨k, hk, _⟩ := BandPredecessorNoCollision + (FordRecursiveQuadruple P₁) r hp hr (child.trans hr0.symm) + have hk0 : k = 0 := by + fin_cases k + · rfl + · have h := hk 1 + change r 2 = (FordRecursiveQuadruple P₁) 3 at h + rw [hr2] at h + have hc := congrArg Prod.fst h + simp [FordRecursiveQuadruple, FordCircleCoordinate] at hc + nlinarith [hc] + · have h := hk 2 + change r 3 = (FordRecursiveQuadruple P₁) 2 at h + rw [hr3] at h + have hc := congrArg Prod.fst h + simp [FordRecursiveQuadruple, FordCircleCoordinate, P₁] at hc + nlinarith [hc] + refine ⟨hs, hrs, by omega, P₁, rfl, rfl, rfl, rfl, rfl, rfl, ?_⟩ + rw [hk0] at hk + simp only [add_zero] at hk + funext i + fin_cases i + · exact hr0.trans child.symm + · exact hk 0 + · exact hk 1 + · exact hk 2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5064T3PrecursorSupport.lean b/LeanPool/ApollonianSuperharmonic/P5064T3PrecursorSupport.lean new file mode 100644 index 0000000000..f924e33f7d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5064T3PrecursorSupport.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5064T3Rectangles +public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P5064T3PrecursorSupport] + +/-! +# P5064T3PrecursorSupport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5064T3PrecursorSupport (r s : Nat) (hs : 0 < s) (hrs : s < r) : + FootprintVertices (P5064T3Rectangles r s 0 true) ∩ + FootprintVertices (P5064T3Rectangles r s 0 false) = + {z | (s : Int) ≤ z.re ∧ z.re ≤ (r : Int) ∧ + (s : Int) ≤ z.im ∧ z.im ≤ (r : Int)} ∧ + FootprintVertices (P5064T3Rectangles r s 0 true) ∩ + FootprintVertices (P5064T3Rectangles r s 0 false) = + FootprintVertices (P5064T3Rectangles (r - s) s 0 false) := by +-- BODY + have shift (n : Nat) (hn : 0 < n) (a b : Int) : + FootprintVertices (TileTranslation (FordTile n) ⟨a, b⟩) = + {z | a ≤ z.re ∧ z.re ≤ a + (n : Int) ∧ + b ≤ z.im ∧ z.im ≤ b + (n : Int)} := by + rw [(TileTranslationFormulas _ _).2.2.2.2.2.1, + (P4062T1CanonicalSupport n hn).1] + ext z + constructor + · rintro ⟨w, hw, rfl⟩ + change 0 ≤ w.re ∧ w.re ≤ (n : Int) ∧ + 0 ≤ w.im ∧ w.im ≤ (n : Int) at hw + simp only [Set.mem_ofPred_eq, GaussianTranslation, Zsqrtd.re_add, + Zsqrtd.im_add] + omega + · intro hz + refine ⟨z - ⟨a, b⟩, ?_, ?_⟩ + · change 0 ≤ (z - ⟨a, b⟩).re ∧ (z - ⟨a, b⟩).re ≤ (n : Int) ∧ + 0 ≤ (z - ⟨a, b⟩).im ∧ (z - ⟨a, b⟩).im ≤ (n : Int) + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + change a ≤ z.re ∧ z.re ≤ a + (n : Int) ∧ + b ≤ z.im ∧ z.im ≤ b + (n : Int) at hz + omega + · simp [GaussianTranslation] + have root := (P4062T1CanonicalSupport r (by omega)).1 + change FootprintVertices (FordTile r) = + {z | 0 ≤ z.re ∧ z.re ≤ (r : Int) ∧ 0 ≤ z.im ∧ z.im ≤ (r : Int)} at root + change FootprintVertices (FordTile r) ∩ + FootprintVertices (TileTranslation (FordTile r) ⟨(s : Int), (s : Int)⟩) = _ ∧ + FootprintVertices (FordTile r) ∩ + FootprintVertices (TileTranslation (FordTile r) ⟨(s : Int), (s : Int)⟩) = + FootprintVertices (TileTranslation (FordTile (r - s)) ⟨(s : Int), (s : Int)⟩) + rw [root, shift r (by omega) (s : Int) (s : Int), + shift (r - s) (by omega) (s : Int) (s : Int)] + constructor <;> ext z <;> simp only [Set.mem_inter_iff, Set.mem_ofPred_eq] <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5064T3RectangleContacts.lean b/LeanPool/ApollonianSuperharmonic/P5064T3RectangleContacts.lean new file mode 100644 index 0000000000..53f7b1faec --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5064T3RectangleContacts.lean @@ -0,0 +1,233 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5064T3Rectangles +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport +public import LeanPool.ApollonianSuperharmonic.P5098T1SquareIntersection +public import LeanPool.ApollonianSuperharmonic.P5098T1OccurrenceSquares +public import LeanPool.ApollonianSuperharmonic.P5098T1EqualIntervals +public import LeanPool.ApollonianSuperharmonic.P5098T1ABIntervals +public import LeanPool.ApollonianSuperharmonic.P5098T1ACIntervals +public import LeanPool.ApollonianSuperharmonic.P5098T1ADIntervals +public import LeanPool.ApollonianSuperharmonic.P5098T1BCIntervals +public import LeanPool.ApollonianSuperharmonic.P5098T1BDIntervals +public import LeanPool.ApollonianSuperharmonic.P5098T1CDIntervals + +-- [TABLET NODE: P5064T3RectangleContacts] + +/-! +# P5064T3RectangleContacts + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5064T3RectangleContacts (r s : Nat) (hs : 2 ≤ s) (hrs : s < r) : + let M := P5064T3Rectangles r s + let u : GaussianInt := ⟨-(r : Int), ((r + s : Nat) : Int)⟩ + let v : GaussianInt := ⟨-(s : Int), -((r + s : Nat) : Int)⟩ + ∀ a b : PeriodicSubtileIndex, a ≠ b → + ((FootprintEdges (SubtileOccurrenceInterpretation M u v a) ∩ + FootprintEdges (SubtileOccurrenceInterpretation M u v b)).Nonempty → + AllowedSubtileIncidence a b) ∧ + (¬ AllowedSubtileIncidence a b → + FootprintVertices (SubtileOccurrenceInterpretation M u v a) ∩ + FootprintVertices (SubtileOccurrenceInterpretation M u v b) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation M u v a) ∩ + FootprintVertices (SubtileOccurrenceInterpretation M u v b)).Subsingleton) := by +-- BODY + classical + let M := P5064T3Rectangles r s + let u : GaussianInt := ⟨-(r : Int), ((r + s : Nat) : Int)⟩ + let v : GaussianInt := ⟨-(s : Int), -((r + s : Nat) : Int)⟩ + let occ := SubtileOccurrenceInterpretation M u v + let d : SixSubtileLabel → Nat := fun l => match l with + | .A | .B => r + | .C | .D => s + | .E | .F => 0 + let c : SixSubtileLabel → GaussianInt := fun l => match l with + | .A => 0 + | .B => ⟨(s : Int), (s : Int)⟩ + | .C => ⟨(r : Int), 0⟩ + | .D => ⟨0, (r : Int)⟩ + | .E => ⟨(s : Int), (r + s : Nat)⟩ + | .F => ⟨(r : Int), 0⟩ + let shift (m n : Int) : GaussianInt := + ⟨-m * r - n * s, (r + s) * (m - n)⟩ + let corner (o : PeriodicSubtileIndex) := c o.label + shift o.first o.second + let rank : SixSubtileLabel → Nat := fun l => match l with + | .A => 0 | .B => 1 | .C => 2 | .D => 3 | .E => 4 | .F => 5 + have hsI : (2 : Int) ≤ s := by exact_mod_cast hs + have hrsI : (s : Int) < r := by exact_mod_cast hrs + have normal (o : PeriodicSubtileIndex) : + occ o = TileTranslation (FordTile (d o.label)) (corner o) := by + exact P5098T1OccurrenceSquares r s o + have zero_edges (o : PeriodicSubtileIndex) (hz : d o.label = 0) : + FootprintEdges (occ o) = ∅ := by + rw [normal, hz] + simp [FordTile, FordCellDomain, TileTranslation, FootprintEdges] + have zero_vertices (o : PeriodicSubtileIndex) (hz : d o.label = 0) : + (FootprintVertices (occ o)).Subsingleton := by + rw [normal, hz] + simp [FordTile, FordCellDomain, TileTranslation, FootprintVertices] + have ordered (a b : PeriodicSubtileIndex) (hne : a ≠ b) + (horder : rank a.label ≤ rank b.label) + (hedge : (FootprintEdges (occ a) ∩ FootprintEdges (occ b)).Nonempty) : + AllowedSubtileIncidence a b := by + by_cases hza : d a.label = 0 + · simp [zero_edges a hza] at hedge + by_cases hzb : d b.label = 0 + · simp [zero_edges b hzb] at hedge + have hpa : 0 < d a.label := Nat.pos_of_ne_zero hza + have hpb : 0 < d b.label := Nat.pos_of_ne_zero hzb + have hrect := (P5098T1SquareIntersection (d a.label) (d b.label) + hpa hpb (corner a) (corner b)).1.mp + (by simpa only [normal] using hedge) + have dx : (corner b - corner a).re = + (c b.label).re - (c a.label).re - + (b.first - a.first) * (r + s) + + ((b.first - a.first) - (b.second - a.second)) * s := by + dsimp [corner, shift] + ring + have dy : (corner b - corner a).im = + (c b.label).im - (c a.label).im + + (r + s) * ((b.first - a.first) - (b.second - a.second)) := by + dsimp [corner, shift] + ring + rw [dx, dy] at hrect + rcases a with ⟨la, m, n⟩ + rcases b with ⟨lb, p, t⟩ + cases la <;> cases lb + all_goals simp only [d, c, rank, Zsqrtd.re_zero, Zsqrtd.im_zero] at hpa hpb horder hrect + all_goals try omega + case A.A => + obtain ⟨hi, hk⟩ := P5098T1EqualIntervals r s r (p - m) + ((p - m) - (t - n)) hsI hrsI (Or.inl rfl) + (by simpa only [sub_self, zero_sub, zero_add, neg_mul] using hrect) + apply False.elim + apply hne + congr <;> omega + case B.B => + obtain ⟨hi, hk⟩ := P5098T1EqualIntervals r s r (p - m) + ((p - m) - (t - n)) hsI hrsI (Or.inl rfl) + (by simpa only [sub_self, zero_sub, zero_add, neg_mul] using hrect) + apply False.elim + apply hne + congr <;> omega + case C.C => + obtain ⟨hi, hk⟩ := P5098T1EqualIntervals r s s (p - m) + ((p - m) - (t - n)) hsI hrsI (Or.inr rfl) + (by simpa only [sub_self, zero_sub, zero_add, neg_mul] using hrect) + apply False.elim + apply hne + congr <;> omega + case D.D => + obtain ⟨hi, hk⟩ := P5098T1EqualIntervals r s s (p - m) + ((p - m) - (t - n)) hsI hrsI (Or.inr rfl) + (by simpa only [sub_self, zero_sub, zero_add, neg_mul] using hrect) + apply False.elim + apply hne + congr <;> omega + case A.B => + have hrow := P5098T1ABIntervals r s (p - m) ((p - m) - (t - n)) + hsI hrsI (by simpa only [sub_zero] using hrect) + rcases hrow with ⟨hi, hk⟩ | ⟨hi, hk⟩ | ⟨hi, hk⟩ + · have hp : p = m := by omega + have ht : t = n := by omega + subst p; subst t + exact .AB m n + · have hp : p = m := by omega + have ht : t = n + 1 := by omega + subst p; subst t + exact .AB01 m n + · have hp : p = m + 1 := by omega + have ht : t = n + 1 := by omega + subst p; subst t + exact .AB11 m n + case A.C => + have hrow := P5098T1ACIntervals r s (p - m) ((p - m) - (t - n)) + hsI hrsI (by simpa only [sub_zero, zero_add] using hrect) + rcases hrow with ⟨hi, hk⟩ | ⟨hi, hk⟩ + · have hp : p = m := by omega + have ht : t = n := by omega + subst p; subst t + exact .AC m n + · have hp : p = m + 1 := by omega + have ht : t = n + 1 := by omega + subst p; subst t + exact .AC11 m n + case A.D => + obtain ⟨hi, hk⟩ := P5098T1ADIntervals r s (p - m) ((p - m) - (t - n)) + hsI hrsI (by simpa only [sub_zero, zero_sub, neg_mul] using hrect) + have hp : p = m := by omega + have ht : t = n := by omega + subst p; subst t + exact .AD m n + case B.C => + obtain ⟨hi, hk⟩ := P5098T1BCIntervals r s (p - m) ((p - m) - (t - n)) + hsI hrsI (by simpa only [zero_sub] using hrect) + have hp : p = m := by omega + have ht : t = n := by omega + subst p; subst t + exact .BC m n + case B.D => + have hrow := P5098T1BDIntervals r s (p - m) ((p - m) - (t - n)) + hsI hrsI (by simpa only [zero_sub] using hrect) + rcases hrow with ⟨hi, hk⟩ | ⟨hi, hk⟩ + · have hp : p = m - 1 := by omega + have ht : t = n - 1 := by omega + subst p; subst t + exact .BDm1m1 m n + · have hp : p = m := by omega + have ht : t = n := by omega + subst p; subst t + exact .BD m n + case C.D => + obtain ⟨hi, hk⟩ := P5098T1CDIntervals r s (p - m) ((p - m) - (t - n)) + hsI hrsI (by simpa only [zero_sub, sub_zero] using hrect) + have hp : p = m - 1 := by omega + have ht : t = n := by omega + subst p; subst t + exact .CDm10 m n + have classify (a b : PeriodicSubtileIndex) (hne : a ≠ b) + (hedge : (FootprintEdges (occ a) ∩ FootprintEdges (occ b)).Nonempty) : + AllowedSubtileIncidence a b := by + rcases le_total (rank a.label) (rank b.label) with hab | hba + · exact ordered a b hne hab hedge + · exact .symm (ordered b a hne.symm hba (by rwa [Set.inter_comm])) + dsimp only + intro a b hne + change ((FootprintEdges (occ a) ∩ FootprintEdges (occ b)).Nonempty → _) ∧ _ + refine ⟨classify a b hne, ?_⟩ + intro hnot + right + change (FootprintVertices (occ a) ∩ FootprintVertices (occ b)).Subsingleton + by_cases hza : d a.label = 0 + · intro x hx y hy + exact zero_vertices a hza hx.1 hy.1 + by_cases hzb : d b.label = 0 + · intro x hx y hy + exact zero_vertices b hzb hx.2 hy.2 + have hno : ¬ (FootprintEdges (occ a) ∩ FootprintEdges (occ b)).Nonempty := + fun he => hnot (classify a b hne he) + simpa only [normal] using + (P5098T1SquareIntersection (d a.label) (d b.label) + (Nat.pos_of_ne_zero hza) (Nat.pos_of_ne_zero hzb) (corner a) (corner b)).2 + (by simpa only [normal] using hno) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5064T3Rectangles.lean b/LeanPool/ApollonianSuperharmonic/P5064T3Rectangles.lean new file mode 100644 index 0000000000..6a248f6f03 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5064T3Rectangles.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.TileTranslation + +-- [TABLET NODE: P5064T3Rectangles] + +/-! +# P5064T3Rectangles + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For nonnegative integers $r,s$, define the six-record family +$M(r,s)$, indexed by a parent slot $0,1,2$ and a Boolean sign, by +$$ +\begin{array}{lll} + M_0^+=T_r,&M_0^-=T_r+(s,s),\\ + M_1^+=T_s+(r,0),&M_1^-=T_s+(0,r),\\ + M_2^+=\langle\varnothing,(s,r+s)\rangle, + &M_2^-=\langle\varnothing,(r,0)\rangle. +\end{array} +$$ +Here $T_n$ is the explicit Ford square, addition denotes tile translation, +and the last two records have no cells and the displayed auxiliary anchors. +The signs $+$ and $-$ mean Boolean true and false, respectively. These are +the canonical coordinate representatives for the signed Ford occurrences; +they do not fix the auxiliary anchors of other nonempty representatives. +-/ +def P5064T3Rectangles (r s : Nat) : Fin 3 → Bool → ProtoTile := +-- BODY + ![fun b => if b then FordTile r else + TileTranslation (FordTile r) ⟨(s : Int), (s : Int)⟩, + fun b => if b then TileTranslation (FordTile s) ⟨(r : Int), 0⟩ else + TileTranslation (FordTile s) ⟨0, (r : Int)⟩, + fun b => if b then ⟨∅, ⟨(s : Int), ((r + s : Nat) : Int)⟩⟩ else + ⟨∅, ⟨(r : Int), 0⟩⟩] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5090T1TangentCircleMetric.lean b/LeanPool/ApollonianSuperharmonic/P5090T1TangentCircleMetric.lean new file mode 100644 index 0000000000..b2644087e7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5090T1TangentCircleMetric.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Complex.Norm +public import Mathlib.LinearAlgebra.Complex.Module + +-- [TABLET NODE: P5090T1TangentCircleMetric] + +/-! +# P5090T1TangentCircleMetric + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5090T1TangentCircleMetric (c d : ℝ) (w v : ℂ) (hc : 0 < c) (hd : 0 < d) + (hn : ‖(d : ℂ) * w - (c : ℂ) * v‖ ^ 2 = (c + d) ^ 2) : + dist (w / c) (v / d) = 1 / c + 1 / d ∧ + (w + v) / ((c + d : ℝ) : ℂ) = + ((1 / d) / (1 / c + 1 / d)) • (w / c) + + ((1 / c) / (1 / c + 1 / d)) • (v / d) := by +-- BODY + have hcC : (c : ℂ) ≠ 0 := Complex.ofReal_ne_zero.mpr (ne_of_gt hc) + have hdC : (d : ℂ) ≠ 0 := Complex.ofReal_ne_zero.mpr (ne_of_gt hd) + have hcdC : ((c + d : ℝ) : ℂ) ≠ 0 := + Complex.ofReal_ne_zero.mpr (ne_of_gt (add_pos hc hd)) + have hnorm : ‖(d : ℂ) * w - (c : ℂ) * v‖ = c + d := by + nlinarith [norm_nonneg ((d : ℂ) * w - (c : ℂ) * v)] + constructor + · have heq : w / c - v / d = + ((d : ℂ) * w - (c : ℂ) * v) / ((c : ℂ) * d) := by + field_simp + rw [dist_eq_norm, heq, Complex.norm_div, hnorm, Complex.norm_mul, + Complex.norm_real, Complex.norm_real, Real.norm_eq_abs, Real.norm_eq_abs, + abs_of_pos hc, abs_of_pos hd] + field_simp; ring + · have hr (x y : ℝ) (hx : 0 < x) (hy : 0 < y) : + (1 / y) / (1 / x + 1 / y) = x / (x + y) := by + field_simp; ring + rw [hr c d hc hd, add_comm (1 / c) (1 / d), hr d c hd hc, add_comm d c] + simp only [Complex.real_smul, Complex.ofReal_div] + field_simp + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5090T1ThreeDiskContactTriangle.lean b/LeanPool/ApollonianSuperharmonic/P5090T1ThreeDiskContactTriangle.lean new file mode 100644 index 0000000000..026149676a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5090T1ThreeDiskContactTriangle.lean @@ -0,0 +1,177 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Analysis.Complex.Norm +public import Mathlib.LinearAlgebra.Complex.Module +public import Mathlib.Analysis.Normed.Module.Basic + +-- [TABLET NODE: P5090T1ThreeDiskContactTriangle] + +/-! +# P5090T1ThreeDiskContactTriangle + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5090T1ThreeDiskContactTriangle (A B C z : ℂ) (a b c : ℝ) + (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) + (hAB : dist A B = a + b) (hAC : dist A C = a + c) + (hBC : dist B C = b + c) + (hz : z ∈ convexHull ℝ ({A, B, C} : Set ℂ)) + (hzA : a ≤ dist z A) (hzB : b ≤ dist z B) (hzC : c ≤ dist z C) : + z ∈ convexHull ℝ + ({(b / (a + b)) • A + (a / (a + b)) • B, + (c / (a + c)) • A + (a / (a + c)) • C, + (c / (b + c)) • B + (b / (b + c)) • C} : Set ℂ) := by +-- BODY + have triangleWeights (A B C z : ℂ) (hz : + z ∈ convexHull ℝ ({A, B, C} : Set ℂ)) : + ∃ α β γ : ℝ, 0 ≤ α ∧ 0 ≤ β ∧ 0 ≤ γ ∧ α + β + γ = 1 ∧ + z = α • A + β • B + γ • C := by + let T : Set ℂ := {z | ∃ α β γ : ℝ, 0 ≤ α ∧ 0 ≤ β ∧ 0 ≤ γ ∧ + α + β + γ = 1 ∧ z = α • A + β • B + γ • C} + have hT : Convex ℝ T := by + intro x hx y hy u v hu hv huv + rcases hx with ⟨α, β, γ, hα, hβ, hγ, hsum, rfl⟩ + rcases hy with ⟨α', β', γ', hα', hβ', hγ', hsum', rfl⟩ + refine ⟨u * α + v * α', u * β + v * β', u * γ + v * γ', ?_, ?_, ?_, ?_, ?_⟩ + · positivity + · positivity + · positivity + · calc + (u * α + v * α') + (u * β + v * β') + (u * γ + v * γ') = + u * (α + β + γ) + v * (α' + β' + γ') := by ring + _ = 1 := by rw [hsum, hsum']; nlinarith + · module + have hsub : ({A, B, C} : Set ℂ) ⊆ T := by + intro w hw + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hw + rcases hw with rfl | rfl | rfl + · exact ⟨1, 0, 0, by norm_num, by norm_num, by norm_num, by norm_num, by module⟩ + · exact ⟨0, 1, 0, by norm_num, by norm_num, by norm_num, by norm_num, by module⟩ + · exact ⟨0, 0, 1, by norm_num, by norm_num, by norm_num, by norm_num, by module⟩ + have hzt : z ∈ T := (convexHull_min hsub hT) hz + simpa only [T, Set.mem_ofPred_eq] using hzt + have contactCombo (A B C : ℂ) (a b c α β γ : ℝ) + (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) + (hα : 0 ≤ α) (hβ : 0 ≤ β) (hγ : 0 ≤ γ) + (hsum : α + β + γ = 1) + (hA : a ≤ β * (a + b) + γ * (a + c)) + (hB : b ≤ α * (a + b) + γ * (b + c)) + (hC : c ≤ α * (a + c) + β * (b + c)) : + ∃ μD μE μF : ℝ, 0 ≤ μD ∧ 0 ≤ μE ∧ 0 ≤ μF ∧ + μD + μE + μF = 1 ∧ + α • A + β • B + γ • C = + μD • ((b / (a + b)) • A + (a / (a + b)) • B) + + μE • ((c / (a + c)) • A + (a / (a + c)) • C) + + μF • ((c / (b + c)) • B + (b / (b + c)) • C) := by + let μD := (a + b) * (α * (a + c) + β * (b + c) - c) / (2 * a * b) + let μE := (a + c) * (α * (a + b) + γ * (b + c) - b) / (2 * a * c) + let μF := (b + c) * (β * (a + b) + γ * (a + c) - a) / (2 * b * c) + have hγeq : γ = 1 - α - β := by linarith [hsum] + have hμD : 0 ≤ μD := by + dsimp [μD] + apply div_nonneg + · apply mul_nonneg (by positivity) + nlinarith [hC] + · positivity + have hμE : 0 ≤ μE := by + dsimp [μE] + apply div_nonneg + · apply mul_nonneg (by positivity) + nlinarith [hB] + · positivity + have hμF : 0 ≤ μF := by + dsimp [μF] + apply div_nonneg + · apply mul_nonneg (by positivity) + nlinarith [hA] + · positivity + have hsumμ : μD + μE + μF = 1 := by + dsimp [μD, μE, μF] + rw [hγeq] + field_simp [ne_of_gt ha, ne_of_gt hb, ne_of_gt hc, + ne_of_gt (add_pos ha hb), ne_of_gt (add_pos ha hc), ne_of_gt (add_pos hb hc)] + ring + have hcomb : + α • A + β • B + γ • C = + μD • ((b / (a + b)) • A + (a / (a + b)) • B) + + μE • ((c / (a + c)) • A + (a / (a + c)) • C) + + μF • ((c / (b + c)) • B + (b / (b + c)) • C) := by + have hD : μD * (b / (a + b)) + μE * (c / (a + c)) = α := by + dsimp [μD, μE] + rw [hγeq] + field_simp [ne_of_gt ha, ne_of_gt hb, ne_of_gt hc, + ne_of_gt (add_pos ha hb), ne_of_gt (add_pos ha hc)] + ring + have hB : μD * (a / (a + b)) + μF * (c / (b + c)) = β := by + dsimp [μD, μF] + rw [hγeq] + field_simp [ne_of_gt ha, ne_of_gt hb, ne_of_gt hc, + ne_of_gt (add_pos ha hb), ne_of_gt (add_pos hb hc)] + ring + have hC' : μE * (a / (a + c)) + μF * (b / (b + c)) = γ := by + dsimp [μE, μF] + rw [hγeq] + field_simp [ne_of_gt ha, ne_of_gt hb, ne_of_gt hc, + ne_of_gt (add_pos ha hc), ne_of_gt (add_pos hb hc)] + ring + simp only [smul_add, smul_smul] + rw [← hD, ← hB, ← hC'] + module + exact ⟨μD, μE, μF, hμD, hμE, hμF, hsumμ, hcomb⟩ + obtain ⟨α, β, γ, hα, hβ, hγ, hsum, hx⟩ := triangleWeights A B C z hz + have bound (X Y Z x : ℂ) (α β γ : ℝ) + (hβ : 0 ≤ β) (hγ : 0 ≤ γ) (hs : α + β + γ = 1) + (hx : x = α • X + β • Y + γ • Z) : + dist x X ≤ β * dist X Y + γ * dist X Z := by + have heq : x - X = β • (Y - X) + γ • (Z - X) := by + rw [hx] + have hα : α = 1 - β - γ := by linarith + rw [hα] + module + rw [dist_eq_norm, heq] + calc + ‖β • (Y - X) + γ • (Z - X)‖ ≤ ‖β • (Y - X)‖ + ‖γ • (Z - X)‖ := + norm_add_le _ _ + _ = β * dist X Y + γ * dist X Z := by + simp only [Complex.real_smul, Complex.norm_mul, Complex.norm_real, + Real.norm_eq_abs, abs_of_nonneg hβ, abs_of_nonneg hγ] + rw [← dist_eq_norm, ← dist_eq_norm, dist_comm Y X, dist_comm Z X] + have hA := hzA.trans (bound A B C z α β γ hβ hγ hsum hx) + rw [hAB, hAC] at hA + have hxB : z = β • B + α • A + γ • C := by rw [hx]; module + have hB := hzB.trans (bound B A C z β α γ hα hγ (by linarith) hxB) + rw [dist_comm B A, hAB, hBC] at hB + have hxC : z = γ • C + α • A + β • B := by rw [hx]; module + have hC := hzC.trans (bound C A B z γ α β hα hβ (by linarith) hxC) + rw [dist_comm C A, dist_comm C B, hAC, hBC] at hC + obtain ⟨μD, μE, μF, hμD, hμE, hμF, hμsum, hcomb⟩ := + contactCombo A B C a b c α β γ ha hb hc hα hβ hγ hsum hA hB hC + apply mem_convexHull_of_exists_fintype (w := ![μD, μE, μF]) + (z := ![(b / (a + b)) • A + (a / (a + b)) • B, + (c / (a + c)) • A + (a / (a + c)) • C, + (c / (b + c)) • B + (b / (b + c)) • C]) + · intro i + fin_cases i <;> assumption + · simpa [Fin.sum_univ_succ, add_assoc] using hμsum + · intro i + fin_cases i <;> simp + · simp only [Fin.sum_univ_succ, Fin.sum_univ_zero, Matrix.cons_val_zero, + Matrix.cons_val_succ, add_zero] + simpa only [add_assoc] using hcomb.symm.trans hx.symm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5090T1TwoDiskLineTriangle.lean b/LeanPool/ApollonianSuperharmonic/P5090T1TwoDiskLineTriangle.lean new file mode 100644 index 0000000000..c909c03f9b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5090T1TwoDiskLineTriangle.lean @@ -0,0 +1,177 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Analysis.Complex.Norm +public import Mathlib.LinearAlgebra.Complex.Module + +-- [TABLET NODE: P5090T1TwoDiskLineTriangle] + +/-! +# P5090T1TwoDiskLineTriangle + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5090T1TwoDiskLineTriangle (a b u v : ℝ) (z : ℂ) + (ha : 0 < a) (hb : 0 < b) + (ht : dist (⟨a, u⟩ : ℂ) ⟨b, v⟩ = a + b) + (hz : z ∈ convexHull ℝ + ({⟨a, u⟩, ⟨b, v⟩, ⟨0, u⟩, ⟨0, v⟩} : Set ℂ)) + (hzA : a ≤ dist z (⟨a, u⟩ : ℂ)) + (hzB : b ≤ dist z (⟨b, v⟩ : ℂ)) : + z ∈ convexHull ℝ + ({⟨0, u⟩, + (b / (a + b)) • (⟨a, u⟩ : ℂ) + + (a / (a + b)) • (⟨b, v⟩ : ℂ), ⟨0, v⟩} : Set ℂ) := by +-- BODY + classical + let A : ℂ := ⟨a, u⟩ + let B : ℂ := ⟨b, v⟩ + let F : ℂ := ⟨0, u⟩ + let G : ℂ := ⟨0, v⟩ + have weights (A B F G z : ℂ) + (hz : z ∈ convexHull ℝ ({A, B, F, G} : Set ℂ)) : + ∃ α β φ γ : ℝ, 0 ≤ α ∧ 0 ≤ β ∧ 0 ≤ φ ∧ 0 ≤ γ ∧ + α + β + φ + γ = 1 ∧ z = α • A + β • B + φ • F + γ • G := by + let T : Set ℂ := {x | ∃ α β φ γ : ℝ, + 0 ≤ α ∧ 0 ≤ β ∧ 0 ≤ φ ∧ 0 ≤ γ ∧ α + β + φ + γ = 1 ∧ + x = α • A + β • B + φ • F + γ • G} + have hT : Convex ℝ T := by + intro x hx y hy s t hs ht hst + obtain ⟨α, β, φ, γ, hα, hβ, hφ, hγ, hsum, rfl⟩ := hx + obtain ⟨α', β', φ', γ', hα', hβ', hφ', hγ', hsum', rfl⟩ := hy + refine ⟨s * α + t * α', s * β + t * β', s * φ + t * φ', + s * γ + t * γ', by positivity, by positivity, by positivity, + by positivity, ?_, ?_⟩ + · calc + _ = s * (α + β + φ + γ) + t * (α' + β' + φ' + γ') := by ring + _ = 1 := by rw [hsum, hsum']; linarith + · module + have hsub : ({A, B, F, G} : Set ℂ) ⊆ T := by + intro x hx + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hx + rcases hx with rfl | rfl | rfl | rfl + · exact ⟨1, 0, 0, 0, by norm_num, le_rfl, le_rfl, le_rfl, by norm_num, by module⟩ + · exact ⟨0, 1, 0, 0, le_rfl, by norm_num, le_rfl, le_rfl, by norm_num, by module⟩ + · exact ⟨0, 0, 1, 0, le_rfl, le_rfl, by norm_num, le_rfl, by norm_num, by module⟩ + · exact ⟨0, 0, 0, 1, le_rfl, le_rfl, le_rfl, by norm_num, by norm_num, by module⟩ + exact (convexHull_min hsub hT) hz + obtain ⟨α, β, φ, γ, hα, hβ, hφ, hγ, hsum, hx⟩ := weights A B F G z hz + let s := β + γ + let t := φ + (b / a) * γ + let s' := α + φ + let t' := γ + (a / b) * φ + have hs : 0 ≤ s := add_nonneg hβ hγ + have ht' : 0 ≤ t := by dsimp [t]; positivity + have hs' : 0 ≤ s' := add_nonneg hα hφ + have ht'' : 0 ≤ t' := by dsimp [t']; positivity + have hαeq : α = 1 - β - φ - γ := by linarith + have hconeA : z - A = s • (B - A) + t • (F - A) := by + rw [hx, hαeq] + apply Complex.ext + · simp only [A, B, F, G, s, t, Complex.add_re, Complex.sub_re, + Complex.smul_re, smul_eq_mul] + field_simp; ring + · simp only [A, B, F, G, s, t, Complex.add_im, Complex.sub_im, + Complex.smul_im, smul_eq_mul] + ring + have hconeB : z - B = s' • (A - B) + t' • (G - B) := by + rw [hx, hαeq] + apply Complex.ext + · simp only [A, B, F, G, s', t', hαeq, Complex.add_re, Complex.sub_re, + Complex.smul_re, smul_eq_mul] + field_simp; ring + · simp only [A, B, F, G, s', t', hαeq, Complex.add_im, Complex.sub_im, + Complex.smul_im, smul_eq_mul] + ring + have coneBound (X Y Z x : ℂ) (s t : ℝ) (hs : 0 ≤ s) (ht : 0 ≤ t) + (hx : x - X = s • (Y - X) + t • (Z - X)) : + dist x X ≤ s * dist X Y + t * dist X Z := by + rw [dist_eq_norm, hx] + calc + ‖s • (Y - X) + t • (Z - X)‖ ≤ ‖s • (Y - X)‖ + ‖t • (Z - X)‖ := norm_add_le _ _ + _ = s * dist X Y + t * dist X Z := by + simp only [Complex.real_smul, Complex.norm_mul, Complex.norm_real, + Real.norm_eq_abs, abs_of_nonneg hs, abs_of_nonneg ht] + rw [← dist_eq_norm, ← dist_eq_norm, dist_comm Y X, dist_comm Z X] + have hAF : dist A F = a := by + simp [A, F, Complex.dist_eq_re_im, Real.sqrt_sq_eq_abs, abs_of_pos ha] + have hBG : dist B G = b := by + simp [B, G, Complex.dist_eq_re_im, Real.sqrt_sq_eq_abs, abs_of_pos hb] + have houtA := hzA.trans (coneBound A B F z s t hs ht' hconeA) + rw [ht, hAF] at houtA + have houtB := hzB.trans (coneBound B A G z s' t' hs' ht'' hconeB) + rw [dist_comm B A, ht, hBG] at houtB + have hX : z.re = a + (b - a) * s - a * t := by + have hh := congrArg Complex.re hconeA + simp only [A, B, F, Complex.sub_re, Complex.add_re, Complex.smul_re, + smul_eq_mul] at hh + linarith + have hY : z.im = (1 - s) * u + s * v := by + have hh := congrArg Complex.im hconeA + simp only [A, B, F, Complex.sub_im, Complex.add_im, Complex.smul_im, + smul_eq_mul] at hh + linarith + have hXpos : 0 ≤ z.re := by + rw [hx] + simp only [A, B, F, G, Complex.add_re, Complex.smul_re, smul_eq_mul] + positivity + have hsrelation : s' = 1 - s := by dsimp [s, s']; linarith + have htrelation : t' * b = a * t := by + dsimp [t', t] + field_simp; ring + have hXG : z.re ≤ 2 * b * s := by nlinarith only [houtA, hX] + have hXF : z.re ≤ 2 * a * (1 - s) := by + rw [hsrelation, htrelation] at houtB + nlinarith only [houtB, hX] + let μF := 1 - s - z.re / (2 * a) + let μK := (a + b) * z.re / (2 * a * b) + let μG := s - z.re / (2 * b) + have hμF : 0 ≤ μF := by + dsimp [μF] + have hh : z.re / (2 * a) ≤ 1 - s := + (div_le_iff₀ (by positivity : 0 < 2 * a)).mpr (by nlinarith only [hXF]) + linarith + have hμK : 0 ≤ μK := by dsimp [μK]; positivity + have hμG : 0 ≤ μG := by + dsimp [μG] + have hh : z.re / (2 * b) ≤ s := + (div_le_iff₀ (by positivity : 0 < 2 * b)).mpr (by nlinarith only [hXG]) + linarith + have hμsum : μF + μK + μG = 1 := by + dsimp [μF, μK, μG] + field_simp; ring + have hcomb : μF • F + μK • ((b / (a + b)) • A + (a / (a + b)) • B) + μG • G = z := by + apply Complex.ext + · simp only [Complex.add_re, Complex.smul_re, smul_eq_mul] + dsimp [A, B, F, G, μF, μK, μG] + field_simp; ring + · simp only [Complex.add_im, Complex.smul_im, smul_eq_mul] + dsimp [A, B, F, G, μF, μK, μG] + rw [hY] + field_simp; ring + apply mem_convexHull_of_exists_fintype (w := ![μF, μK, μG]) + (z := ![F, (b / (a + b)) • A + (a / (a + b)) • B, G]) + · intro i + fin_cases i <;> assumption + · simpa [Fin.sum_univ_succ, add_assoc] using hμsum + · intro i + fin_cases i <;> simp [A, B, F, G] + · simp only [Fin.sum_univ_succ, Fin.sum_univ_zero, Matrix.cons_val_zero, + Matrix.cons_val_succ, add_zero] + simpa only [add_assoc] using hcomb + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1ABIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5098T1ABIntervals.lean new file mode 100644 index 0000000000..eed8c000f9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5098T1ABIntervals.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5098T1PeriodWindow +public import Mathlib.Tactic.IntervalCases + +-- [TABLET NODE: P5098T1ABIntervals] + +/-! +# P5098T1ABIntervals + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5098T1ABIntervals (r s m k : Int) (hs : 2 ≤ s) (hrs : s < r) + (h : ((-r < s - m * (r + s) + k * s ∧ s - m * (r + s) + k * s < r) ∧ + (-r ≤ s + (r + s) * k ∧ s + (r + s) * k ≤ r)) ∨ + ((-r ≤ s - m * (r + s) + k * s ∧ s - m * (r + s) + k * s ≤ r) ∧ + (-r < s + (r + s) * k ∧ s + (r + s) * k < r))) : + (m = 0 ∧ k = 0) ∨ (m = 0 ∧ k = -1) ∨ (m = 1 ∧ k = 0) := by +-- BODY + have hw := P5098T1PeriodWindow (r + s) s m k (by omega) (by omega) + (by omega) (by omega) + obtain ⟨⟨hk0, hk1⟩, hm0, hm1⟩ := hw + interval_cases k <;> interval_cases m <;> norm_num at h ⊢ <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1ACIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5098T1ACIntervals.lean new file mode 100644 index 0000000000..9f8298229e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5098T1ACIntervals.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5098T1PeriodWindow +public import Mathlib.Tactic.IntervalCases + +-- [TABLET NODE: P5098T1ACIntervals] + +/-! +# P5098T1ACIntervals + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5098T1ACIntervals (r s m k : Int) (hs : 2 ≤ s) (hrs : s < r) + (h : ((-s < r - m * (r + s) + k * s ∧ r - m * (r + s) + k * s < r) ∧ + (-s ≤ (r + s) * k ∧ (r + s) * k ≤ r)) ∨ + ((-s ≤ r - m * (r + s) + k * s ∧ r - m * (r + s) + k * s ≤ r) ∧ + (-s < (r + s) * k ∧ (r + s) * k < r))) : + (m = 0 ∧ k = 0) ∨ (m = 1 ∧ k = 0) := by +-- BODY + have hw := P5098T1PeriodWindow (r + s) s m k (by omega) (by omega) + (by omega) (by omega) + obtain ⟨⟨hk0, hk1⟩, hm0, hm1⟩ := hw + interval_cases k <;> interval_cases m <;> norm_num at h ⊢ <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1ADIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5098T1ADIntervals.lean new file mode 100644 index 0000000000..a1b6d25cb1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5098T1ADIntervals.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5098T1PeriodWindow +public import Mathlib.Tactic.IntervalCases + +-- [TABLET NODE: P5098T1ADIntervals] + +/-! +# P5098T1ADIntervals + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5098T1ADIntervals (r s m k : Int) (hs : 2 ≤ s) (hrs : s < r) + (h : ((-s < -m * (r + s) + k * s ∧ -m * (r + s) + k * s < r) ∧ + (-s ≤ r + (r + s) * k ∧ r + (r + s) * k ≤ r)) ∨ + ((-s ≤ -m * (r + s) + k * s ∧ -m * (r + s) + k * s ≤ r) ∧ + (-s < r + (r + s) * k ∧ r + (r + s) * k < r))) : + m = 0 ∧ k = 0 := by +-- BODY + try simp only [neg_mul] at h + have hw := P5098T1PeriodWindow (r + s) s m k (by omega) (by omega) + (by omega) (by omega) + obtain ⟨⟨hk0, hk1⟩, hm0, hm1⟩ := hw + interval_cases k <;> interval_cases m <;> norm_num at h <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1BCIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5098T1BCIntervals.lean new file mode 100644 index 0000000000..2aa446ed66 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5098T1BCIntervals.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5098T1PeriodWindow +public import Mathlib.Tactic.IntervalCases + +-- [TABLET NODE: P5098T1BCIntervals] + +/-! +# P5098T1BCIntervals + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5098T1BCIntervals (r s m k : Int) (hs : 2 ≤ s) (hrs : s < r) + (h : ((-s < r - s - m * (r + s) + k * s ∧ r - s - m * (r + s) + k * s < r) ∧ + (-s ≤ -s + (r + s) * k ∧ -s + (r + s) * k ≤ r)) ∨ + ((-s ≤ r - s - m * (r + s) + k * s ∧ r - s - m * (r + s) + k * s ≤ r) ∧ + (-s < -s + (r + s) * k ∧ -s + (r + s) * k < r))) : + m = 0 ∧ k = 0 := by +-- BODY + have hw := P5098T1PeriodWindow (r + s) s m k (by omega) (by omega) + (by omega) (by omega) + obtain ⟨⟨hk0, hk1⟩, hm0, hm1⟩ := hw + interval_cases k <;> interval_cases m <;> norm_num at h <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1BDIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5098T1BDIntervals.lean new file mode 100644 index 0000000000..9792b9a740 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5098T1BDIntervals.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5098T1PeriodWindow +public import Mathlib.Tactic.IntervalCases + +-- [TABLET NODE: P5098T1BDIntervals] + +/-! +# P5098T1BDIntervals + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5098T1BDIntervals (r s m k : Int) (hs : 2 ≤ s) (hrs : s < r) + (h : ((-s < -s - m * (r + s) + k * s ∧ -s - m * (r + s) + k * s < r) ∧ + (-s ≤ r - s + (r + s) * k ∧ r - s + (r + s) * k ≤ r)) ∨ + ((-s ≤ -s - m * (r + s) + k * s ∧ -s - m * (r + s) + k * s ≤ r) ∧ + (-s < r - s + (r + s) * k ∧ r - s + (r + s) * k < r))) : + (m = -1 ∧ k = 0) ∨ (m = 0 ∧ k = 0) := by +-- BODY + have hw := P5098T1PeriodWindow (r + s) s m k (by omega) (by omega) + (by omega) (by omega) + obtain ⟨⟨hk0, hk1⟩, hm0, hm1⟩ := hw + interval_cases k <;> interval_cases m <;> norm_num at h ⊢ <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1CDIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5098T1CDIntervals.lean new file mode 100644 index 0000000000..c121e6a230 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5098T1CDIntervals.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5098T1PeriodWindow +public import Mathlib.Tactic.IntervalCases + +-- [TABLET NODE: P5098T1CDIntervals] + +/-! +# P5098T1CDIntervals + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5098T1CDIntervals (r s m k : Int) (hs : 2 ≤ s) (hrs : s < r) + (h : ((-s < -r - m * (r + s) + k * s ∧ -r - m * (r + s) + k * s < s) ∧ + (-s ≤ r + (r + s) * k ∧ r + (r + s) * k ≤ s)) ∨ + ((-s ≤ -r - m * (r + s) + k * s ∧ -r - m * (r + s) + k * s ≤ s) ∧ + (-s < r + (r + s) * k ∧ r + (r + s) * k < s))) : + m = -1 ∧ k = -1 := by +-- BODY + have hw := P5098T1PeriodWindow (r + s) s m k (by omega) (by omega) + (by omega) (by omega) + obtain ⟨⟨hk0, hk1⟩, hm0, hm1⟩ := hw + interval_cases k <;> interval_cases m <;> norm_num at h ⊢ <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1EqualIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5098T1EqualIntervals.lean new file mode 100644 index 0000000000..91e412749f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5098T1EqualIntervals.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5098T1PeriodWindow +public import Mathlib.Tactic.IntervalCases + +-- [TABLET NODE: P5098T1EqualIntervals] + +/-! +# P5098T1EqualIntervals + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5098T1EqualIntervals (r s d m k : Int) (hs : 2 ≤ s) (hrs : s < r) + (hd : d = r ∨ d = s) + (h : ((-d < -m * (r + s) + k * s ∧ -m * (r + s) + k * s < d) ∧ + (-d ≤ (r + s) * k ∧ (r + s) * k ≤ d)) ∨ + ((-d ≤ -m * (r + s) + k * s ∧ -m * (r + s) + k * s ≤ d) ∧ + (-d < (r + s) * k ∧ (r + s) * k < d))) : + m = 0 ∧ k = 0 := by +-- BODY + try simp only [neg_mul] at h + have hw := P5098T1PeriodWindow (r + s) s m k (by omega) (by omega) + (by rcases hd with rfl | rfl <;> omega) + (by rcases hd with rfl | rfl <;> omega) + obtain ⟨⟨hk0, hk1⟩, hm0, hm1⟩ := hw + rcases hd with rfl | rfl + all_goals interval_cases k <;> interval_cases m <;> norm_num at h ⊢ <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1OccurrenceSquares.lean b/LeanPool/ApollonianSuperharmonic/P5098T1OccurrenceSquares.lean new file mode 100644 index 0000000000..ab048b53cc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5098T1OccurrenceSquares.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5064T3Rectangles +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P5098T1OccurrenceSquares] + +/-! +# P5098T1OccurrenceSquares + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5098T1OccurrenceSquares (r s : Nat) (o : PeriodicSubtileIndex) : + let d := match o.label with + | .A | .B => r + | .C | .D => s + | .E | .F => 0 + let c : GaussianInt := match o.label with + | .A => 0 + | .B => ⟨(s : Int), (s : Int)⟩ + | .C => ⟨(r : Int), 0⟩ + | .D => ⟨0, (r : Int)⟩ + | .E => ⟨(s : Int), (r + s : Nat)⟩ + | .F => ⟨(r : Int), 0⟩ + SubtileOccurrenceInterpretation (P5064T3Rectangles r s) + ⟨-(r : Int), ((r + s : Nat) : Int)⟩ + ⟨-(s : Int), -((r + s : Nat) : Int)⟩ o = + TileTranslation (FordTile d) + (c + ⟨-o.first * r - o.second * s, (r + s) * (o.first - o.second)⟩) := by +-- BODY + rcases o with ⟨l, m, n⟩ + cases l + all_goals + simp? [SubtileOccurrenceInterpretation, P5064T3Rectangles, + TileTranslation, GaussianTranslation, FordTile, FordCellDomain, + Finset.image_image] + try { constructor + · apply Finset.image_congr + intro x hx + apply Zsqrtd.ext <;> simp [Function.comp_def, GaussianTranslation] <;> ring + · constructor <;> ring } + try { constructor <;> ring } + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1PeriodWindow.lean b/LeanPool/ApollonianSuperharmonic/P5098T1PeriodWindow.lean new file mode 100644 index 0000000000..06f0107d80 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5098T1PeriodWindow.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P5098T1PeriodWindow] + +/-! +# P5098T1PeriodWindow + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5098T1PeriodWindow (q s m k : Int) (hs : 0 < s) (hsq : s < q) + (hy : -q ≤ q * k ∧ q * k ≤ q) + (hx : -q ≤ -(m * q) + k * s ∧ -(m * q) + k * s ≤ q) : + (-1 ≤ k ∧ k ≤ 1) ∧ (-1 ≤ m ∧ m ≤ 1) := by +-- BODY + have hq : 0 < q := by omega + have hk : -1 ≤ k ∧ k ≤ 1 := by + constructor + · by_contra h + have hh : k ≤ -2 := by omega + have := mul_le_mul_of_nonneg_left hh hq.le + nlinarith [hy.1] + · by_contra h + have hh : 2 ≤ k := by omega + have := mul_le_mul_of_nonneg_left hh hq.le + nlinarith [hy.2] + have hks : -s ≤ k * s ∧ k * s ≤ s := by + constructor + · have := mul_le_mul_of_nonneg_right hk.1 hs.le + linarith + · have := mul_le_mul_of_nonneg_right hk.2 hs.le + linarith + refine ⟨hk, ?_, ?_⟩ + · by_contra h + have hh : m ≤ -2 := by omega + have := mul_le_mul_of_nonneg_right hh hq.le + nlinarith [hx.2, hks.1] + · by_contra h + have hh : 2 ≤ m := by omega + have := mul_le_mul_of_nonneg_right hh hq.le + nlinarith [hx.1, hks.2] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1SquareIntersection.lean b/LeanPool/ApollonianSuperharmonic/P5098T1SquareIntersection.lean new file mode 100644 index 0000000000..57ecbf7de1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5098T1SquareIntersection.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport +public import LeanPool.ApollonianSuperharmonic.P4456T2SquareEdges + +-- [TABLET NODE: P5098T1SquareIntersection] + +/-! +# P5098T1SquareIntersection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5098T1SquareIntersection (p q : Nat) (hp : 0 < p) (hq : 0 < q) + (a b : GaussianInt) : + let A := TileTranslation (FordTile p) a + let B := TileTranslation (FordTile q) b + ((FootprintEdges A ∩ FootprintEdges B).Nonempty ↔ + ((-(q : Int) < (b - a).re ∧ (b - a).re < p) ∧ + (-(q : Int) ≤ (b - a).im ∧ (b - a).im ≤ p)) ∨ + ((-(q : Int) ≤ (b - a).re ∧ (b - a).re ≤ p) ∧ + (-(q : Int) < (b - a).im ∧ (b - a).im < p))) ∧ + (¬ (FootprintEdges A ∩ FootprintEdges B).Nonempty → + (FootprintVertices A ∩ FootprintVertices B).Subsingleton) := by +-- BODY + classical + dsimp only + have box (n : Nat) (hn : 0 < n) (c z : GaussianInt) : + z ∈ FootprintVertices (TileTranslation (FordTile n) c) ↔ + c.re ≤ z.re ∧ z.re ≤ c.re + n ∧ + c.im ≤ z.im ∧ z.im ≤ c.im + n := by + rw [(TileTranslationFormulas _ _).2.2.2.2.2.1, + (P4062T1CanonicalSupport n hn).1] + constructor + · rintro ⟨w, hw, rfl⟩ + simp only [FordVertexDomain, Set.mem_ofPred_eq] at hw + simp only [GaussianTranslation, Zsqrtd.re_add, Zsqrtd.im_add] + omega + · intro hz + refine ⟨z - c, ?_, by simp [GaussianTranslation]⟩ + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub] + omega + have ends (T : ProtoTile) (e : Finset GaussianInt) (he : e ∈ FootprintEdges T) : + (∀ z ∈ e, z ∈ FootprintVertices T) ∧ + ∃ x y, x ∈ e ∧ y ∈ e ∧ (y = x + 1 ∨ y = x + ⟨0, 1⟩) := by + rcases he with ⟨c, hc, rfl | rfl | rfl | rfl⟩ + all_goals + have hn : T.cells.Nonempty := ⟨c, hc⟩ + constructor + · intro z hz + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + simp only [FootprintVertices, ite_eq_left hn, Set.mem_ofPred_eq] + rcases hz with hz | hz + all_goals exact ⟨c, hc, by rw [hz]; simp⟩ + · exact ⟨c, c + 1, by simp, by simp, Or.inl rfl⟩ + · exact ⟨c, c + ⟨0, 1⟩, by simp, by simp, Or.inr rfl⟩ + · exact ⟨c + 1, c + 1 + ⟨0, 1⟩, by simp, by simp, Or.inr rfl⟩ + · refine ⟨c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩, by simp, by simp, Or.inl ?_⟩ + abel + have supported (x y : GaussianInt) + (hx : x ∈ FootprintVertices (TileTranslation (FordTile p) a) ∩ + FootprintVertices (TileTranslation (FordTile q) b)) + (hy : y ∈ FootprintVertices (TileTranslation (FordTile p) a) ∩ + FootprintVertices (TileTranslation (FordTile q) b)) + (hxy : FourNeighborAdjacent x y) : + (FootprintEdges (TileTranslation (FordTile p) a) ∩ + FootprintEdges (TileTranslation (FordTile q) b)).Nonempty := by + exact ⟨{x, y}, (P4456T2SquareEdges p hp a _ rfl).2 x hx.1 y hy.1 hxy, + (P4456T2SquareEdges q hq b _ rfl).2 x hx.2 y hy.2 hxy⟩ + have segment (x y : GaussianInt) + (hx : x ∈ FootprintVertices (TileTranslation (FordTile p) a) ∩ + FootprintVertices (TileTranslation (FordTile q) b)) + (hy : y ∈ FootprintVertices (TileTranslation (FordTile p) a) ∩ + FootprintVertices (TileTranslation (FordTile q) b)) (hne : x ≠ y) : + (FootprintEdges (TileTranslation (FordTile p) a) ∩ + FootprintEdges (TileTranslation (FordTile q) b)).Nonempty := by + have hxA := (box p hp a x).mp hx.1 + have hxB := (box q hq b x).mp hx.2 + have hyA := (box p hp a y).mp hy.1 + have hyB := (box q hq b y).mp hy.2 + have in_box (z : GaussianInt) + (hz : min x.re y.re ≤ z.re ∧ z.re ≤ max x.re y.re ∧ + min x.im y.im ≤ z.im ∧ z.im ≤ max x.im y.im) : + z ∈ FootprintVertices (TileTranslation (FordTile p) a) ∩ + FootprintVertices (TileTranslation (FordTile q) b) := by + constructor + · apply (box p hp a z).mpr + constructor <;> try constructor + all_goals omega + · apply (box q hq b z).mpr + constructor <;> try constructor + all_goals omega + by_cases hr : x.re = y.re + · have hi : x.im ≠ y.im := by + intro hi + exact hne (Zsqrtd.ext hr hi) + let z : GaussianInt := ⟨x.re, min x.im y.im⟩ + apply supported z (z + ⟨0, 1⟩) + · apply in_box + dsimp [z] + omega + · apply in_box + simp only [Zsqrtd.re_add, Zsqrtd.im_add] + dsimp [z] + omega + · exact Or.inr (Or.inr (Or.inl rfl)) + · let z : GaussianInt := ⟨min x.re y.re, x.im⟩ + apply supported z (z + 1) + · apply in_box + dsimp [z] + omega + · apply in_box + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one] + dsimp [z] + omega + · exact Or.inl rfl + constructor + · constructor + · rintro ⟨e, heA, heB⟩ + obtain ⟨allA, x, y, hx, hy, hstep⟩ := ends _ e heA + have allB := (ends _ e heB).1 + have hxA := (box p hp a x).mp (allA x hx) + have hxB := (box q hq b x).mp (allB x hx) + have hyA := (box p hp a y).mp (allA y hy) + have hyB := (box q hq b y).mp (allB y hy) + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + rcases hstep with rfl | rfl + · left + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one] at hyA hyB + omega + · right + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at hyA hyB + norm_num at hyA hyB + omega + · intro h + let z : GaussianInt := ⟨max a.re b.re, max a.im b.im⟩ + have hz : z ∈ FootprintVertices (TileTranslation (FordTile p) a) ∩ + FootprintVertices (TileTranslation (FordTile q) b) := by + constructor <;> apply (box _ (by assumption) _ _).mpr + all_goals dsimp [z]; simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] at h; omega + rcases h with h | h + · apply supported z (z + 1) hz + · constructor <;> apply (box _ (by assumption) _ _).mpr + all_goals simp [z] at *; omega + · exact Or.inl rfl + · apply supported z (z + ⟨0, 1⟩) hz + · constructor <;> apply (box _ (by assumption) _ _).mpr + all_goals simp [z] at *; omega + · exact Or.inr (Or.inr (Or.inl rfl)) + · intro he x hx y hy + by_contra hn + exact he (segment x y hx hy hn) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5104T1CornerDeletionDisk.lean b/LeanPool/ApollonianSuperharmonic/P5104T1CornerDeletionDisk.lean new file mode 100644 index 0000000000..2803547e54 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5104T1CornerDeletionDisk.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FinitePolyominoDiskCriterion +public import + LeanPool.ApollonianSuperharmonic.P5617T1RectangleReachabilityAndBasepointConnectivity + +-- [TABLET NODE: P5104T1CornerDeletionDisk] + +/-! +# P5104T1CornerDeletionDisk + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5104T1CornerDeletionDisk : + ∀ (T : ProtoTile), ∀ (q : Int), ∀ (a : Int), ∀ (b : Int), (0 < a) → ((a < q) → ((0 < b) → ((b + < q) → (∀ (left : Bool), ∀ (bottom : Bool), (∀ z : GaussianInt, z ∈ T.cells ↔ + (0 ≤ z.re ∧ z.re < q ∧ 0 ≤ z.im ∧ z.im < q) ∧ + ¬ ((if left then z.re < a else a ≤ z.re) ∧ + (if bottom then z.im < b else b ≤ z.im))) → (LatticeTile T))))) := by + intro T q a b ha haq hb hbq left bottom hcells +-- BODY + classical + let reach (A : Set LatticeCell) := Relation.ReflTransGen + (fun x y => FourNeighborAdjacent x y ∧ x ∈ A ∧ y ∈ A) + obtain ⟨rect, connected⟩ := P5617T1RectangleReachabilityAndBasepointConnectivity + let A : Set LatticeCell := T.cells + let o : LatticeCell := ⟨if left then q - 1 else 0, + if bottom then q - 1 else 0⟩ + have ho : o ∈ A := by + change o ∈ T.cells + rw [hcells] + cases left <;> cases bottom <;> simp [o] <;> omega + have inside : FourNeighborConnected A := by + apply connected A o ho + intro x hx + have hx' := (hcells x).mp hx + let m : LatticeCell := ⟨o.re, x.im⟩ + apply Relation.ReflTransGen.trans (rect A x m ?_) (rect A m o ?_) + all_goals + intro z hl hu hb' ht + change z ∈ T.cells + rw [hcells] + cases left <;> cases bottom <;> + dsimp [m, o] at hl hu hb' ht hx' ⊢ <;> omega + let e : LatticeCell := ⟨-1, -1⟩ + have exterior (x : LatticeCell) + (hx : ¬ (0 ≤ x.re ∧ x.re < q ∧ 0 ≤ x.im ∧ x.im < q)) : + reach Aᶜ x e := by + have path (x y : LatticeCell) + (h : ∀ z : LatticeCell, + min x.re y.re ≤ z.re → z.re ≤ max x.re y.re → + min x.im y.im ≤ z.im → z.im ≤ max x.im y.im → + ¬ (0 ≤ z.re ∧ z.re < q ∧ 0 ≤ z.im ∧ z.im < q)) : + reach Aᶜ x y := by + apply rect + intro z hl hu hb' ht + change z ∉ T.cells + rw [hcells] + exact fun hz => h z hl hu hb' ht hz.1 + by_cases hl : x.re < 0 + · let m : LatticeCell := ⟨-1, x.im⟩ + exact (path x m (by intro z h1 h2 h3 h4; dsimp [m] at *; omega)).trans + (path m e (by intro z h1 h2 h3 h4; dsimp [m, e] at *; omega)) + by_cases hr : q ≤ x.re + · let m : LatticeCell := ⟨x.re, -1⟩ + exact (path x m (by intro z h1 h2 h3 h4; dsimp [m] at *; omega)).trans + (path m e (by intro z h1 h2 h3 h4; dsimp [m, e] at *; omega)) + by_cases hb' : x.im < 0 + · exact path x e (by intro z h1 h2 h3 h4; dsimp [e] at *; omega) + · let m : LatticeCell := ⟨-1, x.im⟩ + exact (path x m (by intro z h1 h2 h3 h4; dsimp [m] at *; omega)).trans + (path m e (by intro z h1 h2 h3 h4; dsimp [m, e] at *; omega)) + have outside : FourNeighborConnected Aᶜ := by + apply connected Aᶜ e + · change e ∉ T.cells + rw [hcells] + simp [e] + · intro x hx + by_cases hbox : 0 ≤ x.re ∧ x.re < q ∧ 0 ≤ x.im ∧ x.im < q + · let m : LatticeCell := ⟨if left then -1 else q, x.im⟩ + apply Relation.ReflTransGen.trans (rect Aᶜ x m ?_) (exterior m ?_) + · intro z hl hu hb' ht + change z ∉ T.cells + change x ∉ T.cells at hx + rw [hcells] at hx ⊢ + cases left <;> cases bottom <;> + dsimp [m] at hl hu hb' ht hx ⊢ <;> omega + · cases left <;> simp [m] + · exact exterior x hbox + have checker : NoCheckerboardCellVertex A := by + intro z + simp only [A, Finset.mem_coe, hcells, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, + Zsqrtd.im_one] + cases left <;> cases bottom <;> simp <;> omega + exact FinitePolyominoDiskCriterion T inside outside checker + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5110T1AnchoredTriples.lean b/LeanPool/ApollonianSuperharmonic/P5110T1AnchoredTriples.lean new file mode 100644 index 0000000000..99c4d4391d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5110T1AnchoredTriples.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5110T1ParentModel +public import LeanPool.ApollonianSuperharmonic.P5110T1SquareInterface +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations + +-- [TABLET NODE: P5110T1AnchoredTriples] + +/-! +# P5110T1AnchoredTriples + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5110T1AnchoredTriples (r s : Nat) (hr : 0 < r) (hs : 0 < s) : + let q := r + s + let A := FordTile q + TouchingTriple A (TileTranslation A ⟨0, -(q : Int)⟩) + (P5110T1ParentModel r s 2 true) ∧ + TouchingTriple A (P5110T1ParentModel r s 1 true) + (P5110T1ParentModel r s 2 false) ∧ + TouchingTriple A (P5110T1ParentModel r s 2 true) + (P5110T1ParentModel r s 0 false) := by +-- BODY + have qpos : 0 < r + s := by omega + have zero_shift : TileTranslation (FordTile (r + s)) 0 = FordTile (r + s) := by + have h : GaussianTranslation 0 = id := by funext z; simp [GaussianTranslation] + simp [TileTranslation, h] + have swap (A B : ProtoTile) (h : TileTouching A B) : TileTouching B A := by + rcases h with h | h | h + · exact Or.inl ⟨h.2.1, h.1, h.2.2.1.symm, by simpa [Set.inter_comm] using h.2.2.2⟩ + · exact Or.inr (Or.inr h) + · exact Or.inr (Or.inl h) + have with_empty (A B : ProtoTile) (a : GaussianInt) (h : TileTouching A B) + (ha : a ∈ BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B) : + TouchingTriple A B ⟨∅, a⟩ := by + refine ⟨h, Or.inr (Or.inr ⟨rfl, ha.2⟩), + Or.inr (Or.inl ⟨rfl, ha.1⟩), a, ?_, ?_⟩ + · exact ⟨ha.1, ha.2, by simp [BoundaryFootprintVertices]⟩ + · intro y hy + simpa [BoundaryFootprintVertices] using hy.2.2 + let q := r + s + let A := FordTile q + dsimp only + refine ⟨?_, ?_, ?_⟩ + · let B := TileTranslation A ⟨0, -(q : Int)⟩ + change TouchingTriple A B ⟨∅, ⟨(q : Int), 0⟩⟩ + rcases P5110T1SquareInterface q q qpos qpos + ⟨0, -(q : Int)⟩ 0 false (by dsimp; omega) + (by dsimp [q]; omega) with ⟨nb, na, dba, vba, _, _, _, _, pba⟩ + rw [zero_shift] at na dba vba pba + apply with_empty A B ⟨(q : Int), 0⟩ + (swap _ _ (Or.inl ⟨nb, na, dba, pba⟩)) + have hba : (⟨(q : Int), 0⟩ : GaussianInt) ∈ + BoundaryFootprintVertices B ∩ BoundaryFootprintVertices A := by + rw [vba]; dsimp [q]; omega + exact ⟨hba.2, hba.1⟩ + · let B := TileTranslation (FordTile s) ⟨-(s : Int), 0⟩ + change TouchingTriple A B ⟨∅, 0⟩ + rcases P5110T1SquareInterface s q hs qpos + ⟨-(s : Int), 0⟩ 0 true (by dsimp; omega) + (by dsimp [q]; omega) with ⟨nb, na, dba, vba, _, _, _, _, pba⟩ + rw [zero_shift] at na dba vba pba + apply with_empty A B 0 (swap _ _ (Or.inl ⟨nb, na, dba, pba⟩)) + have hba : (0 : GaussianInt) ∈ + BoundaryFootprintVertices B ∩ BoundaryFootprintVertices A := by + rw [vba]; dsimp [q]; omega + exact ⟨hba.2, hba.1⟩ + · let B := TileTranslation (FordTile r) ⟨(q : Int), 0⟩ + change TouchingTriple A ⟨∅, ⟨(q : Int), 0⟩⟩ B + rcases P5110T1SquareInterface q r qpos hr + 0 ⟨(q : Int), 0⟩ true (by simp) + (by dsimp [q]; omega) with ⟨na, nb, dab, vab, _, _, _, _, pab⟩ + rw [zero_shift] at na dab vab pab + apply (TouchingTriplePermutations A B ⟨∅, ⟨(q : Int), 0⟩⟩).mp _ |>.1 + apply with_empty A B ⟨(q : Int), 0⟩ (Or.inl ⟨na, nb, dab, pab⟩) + rw [vab]; dsimp [q]; omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5110T1ParentLocalization.lean b/LeanPool/ApollonianSuperharmonic/P5110T1ParentLocalization.lean new file mode 100644 index 0000000000..9a40d99769 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5110T1ParentLocalization.lean @@ -0,0 +1,163 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5110T1ParentModel +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P5110T1ParentLocalization] + +/-! +# P5110T1ParentLocalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5110T1ParentLocalization (P : FordFareyParameter) (hq : 1 < P.q) + (i : Fin 3) (plus : Bool) (U : ProtoTile) + (hU : BandPrototile ((FordRecursiveQuadruple P) i.succ) U) + (hcent : TileCentroid U - TileCentroid (FordTile P.q) = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 ((FordRecursiveQuadruple P) i.succ) + ((FordRecursiveQuadruple P) 0)) + + (if plus then + GaussianRealPoint (BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) i.succ)) + else -GaussianRealPoint (BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) i.succ))))) : + U.cells = (P5110T1ParentModel P.q₁ P.q₂ i plus).cells ∧ + (U.cells = ∅ → U.anchor = (P5110T1ParentModel P.q₁ P.q₂ i plus).anchor) := by +-- BODY + have hr : 0 < P.q₁ := by + by_contra h + have hz : P.q₁ = 0 := by omega + have hd := P.det₁ + simp only [hz, Nat.cast_zero, zero_mul, sub_zero] at hd + have hdv : (P.q : Int) ∣ 1 := ⟨P.p₁, by simpa [mul_comm] using hd.symm⟩ + have := Int.eq_one_of_dvd_one (by omega : 0 ≤ (P.q : Int)) hdv + omega + obtain ⟨proper, S, hS, _, h0, _, h1, _, _, _, h2, ha2⟩ := + (FordTileRecursiveIdentification P).2.2 hq + let N : Fin 3 → Bool → ProtoTile := fun j b => + if b then + ![TileTranslation (S 0 true) ⟨(P.q₂ : Int), (P.q : Int)⟩, + TileTranslation (S 1 true) ⟨-(P.q : Int), 0⟩, + TileTranslation (S 2 false) ⟨(P.q₂ : Int), 0⟩] j + else + ![TileTranslation (S 0 true) ⟨(P.q : Int), 0⟩, + TileTranslation (S 1 true) ⟨-(P.q₁ : Int), (P.q : Int)⟩, + TileTranslation (S 2 false) ⟨-(P.q₁ : Int), 0⟩] j + have hN (j : Fin 3) (b : Bool) : + BandPrototile ((FordRecursiveQuadruple P) j.succ) (N j b) := by + fin_cases j <;> cases b + · exact BandPrototileTranslation _ _ _ (hS 0 true).1 + · exact BandPrototileTranslation _ _ _ (hS 0 true).1 + · exact BandPrototileTranslation _ _ _ (hS 1 true).1 + · exact BandPrototileTranslation _ _ _ (hS 1 true).1 + · exact BandPrototileTranslation _ _ _ (hS 2 false).1 + · exact BandPrototileTranslation _ _ _ (hS 2 false).1 + have ncells (j : Fin 3) (b : Bool) : + (N j b).cells = (P5110T1ParentModel P.q₁ P.q₂ j b).cells := by + fin_cases j <;> cases b + all_goals simp? [N, P5110T1ParentModel, TileTranslation, h0, h1, h2, + Finset.image_image, ← P.sum_q] + all_goals + apply Finset.image_congr + intro z hz + have hsum := P.sum_q + apply Zsqrtd.ext + all_goals simp? [GaussianTranslation] + all_goals omega + have square_nonempty (n : Nat) (hn : 0 < n) (u : GaussianInt) : + (TileTranslation (FordTile n) u).cells.Nonempty := by + have hbase : (0 : GaussianInt) ∈ (FordTile n).cells := + (P4210T1FordCellRectangles n 0).1.mpr (by simp; omega) + exact ⟨GaussianTranslation u 0, Finset.mem_image.mpr ⟨0, hbase, rfl⟩⟩ + have nanchor (j : Fin 3) (b : Bool) (hempty : (N j b).cells = ∅) : + (N j b).anchor = (P5110T1ParentModel P.q₁ P.q₂ j b).anchor := by + have hmempty := (ncells j b).symm.trans hempty + fin_cases j <;> cases b + · exact ((square_nonempty P.q₁ hr _).ne_empty hmempty).elim + · exact ((square_nonempty P.q₁ hr _).ne_empty hmempty).elim + · exact ((square_nonempty P.q₂ P.q₂_pos _).ne_empty hmempty).elim + · exact ((square_nonempty P.q₂ P.q₂_pos _).ne_empty hmempty).elim + · simp? [N, P5110T1ParentModel, TileTranslation, ha2, GaussianTranslation] + ext <;> simp + · simp [N, P5110T1ParentModel, TileTranslation, ha2, GaussianTranslation] + have ncent : TileCentroid (N i plus) = + TileCentroid (P5110T1ParentModel P.q₁ P.q₂ i plus) := + (ProtoTileObservableExtensionality _ _ (ncells i plus) (nanchor i plus)).2.2.2.2 + obtain ⟨_, h10, h20, h30, _⟩ := (FordCoordinateConfiguration P).2 hq + have flips := (VectorRecursionLaws _ proper.1).2.2.2.2 proper + have f0 : BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 1) = + ⟨-(P.q₁ : Int), (P.q : Int)⟩ := by + calc + _ = (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 ((FordRecursiveQuadruple P) 1) ((FordRecursiveQuadruple P) 0) := + (flips 0).1 + _ = _ := by rw [h10]; ext <;> simp + have f1 : BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 2) = + ⟨-(P.q₂ : Int), -(P.q : Int)⟩ := by + calc + _ = (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 ((FordRecursiveQuadruple P) 2) ((FordRecursiveQuadruple P) 0) := + (flips 1).1 + _ = _ := by rw [h20]; ext <;> simp + have f2 : BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 3) = + ⟨(P.q : Int), 0⟩ := by + calc + _ = (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 ((FordRecursiveQuadruple P) 3) ((FordRecursiveQuadruple P) 0) := + (flips 2).1 + _ = _ := by rw [h30]; ext <;> simp + have ct (n : Nat) (u : GaussianInt) : + TileCentroid (TileTranslation (FordTile n) u) = + ((TileCentroid (FordTile n)).1 + (u.re : Int), + (TileCentroid (FordTile n)).2 + (u.im : Int)) := + (TileTranslationFormulas _ _).2.2.2.2.1 + have ce (a : GaussianInt) : TileCentroid (⟨∅, a⟩ : ProtoTile) = GaussianRealPoint a := by + simp [TileCentroid, GaussianRealPoint] + have croot := P4210T1FordSquareCentroid P.q P.q_pos + have c1 := P4210T1FordSquareCentroid P.q₁ hr + have c2 := P4210T1FordSquareCentroid P.q₂ P.q₂_pos + have model_cent : + TileCentroid (P5110T1ParentModel P.q₁ P.q₂ i plus) - + TileCentroid (FordTile P.q) = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 ((FordRecursiveQuadruple P) i.succ) + ((FordRecursiveQuadruple P) 0)) + + (if plus then GaussianRealPoint (BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) i.succ)) + else -GaussianRealPoint (BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) i.succ)))) := by + fin_cases i <;> cases plus + all_goals + simp? [P5110T1ParentModel, ct, ce, croot, c1, c2, + f0, f1, f2, h10, h20, h30, GaussianRealPoint] + have hsum : (P.q : Real) = (P.q₁ : Real) + (P.q₂ : Real) := by + exact_mod_cast P.sum_q + first | (constructor <;> linarith) | linarith + have hUN : TileCentroid U = TileCentroid (N i plus) := by + rw [ncent] + exact sub_left_injective (hcent.trans model_cent.symm) + have obs := BandPrototileCentroidUnique _ U (N i plus) hU (hN i plus) hUN + exact ⟨obs.1.trans (ncells i plus), fun he => + (obs.2 he).trans (nanchor i plus (obs.1.symm.trans he))⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5110T1ParentModel.lean b/LeanPool/ApollonianSuperharmonic/P5110T1ParentModel.lean new file mode 100644 index 0000000000..f98b5f8d3e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5110T1ParentModel.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordTile +public import LeanPool.ApollonianSuperharmonic.TileTranslation + +-- [TABLET NODE: P5110T1ParentModel] + +/-! +# P5110T1ParentModel + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For natural numbers $r,s$, put $q=r+s$ and write +$Q_n(a,b)=\operatorname{FordTile}(n)+(a,b)$, with its literal translated +anchor. The models $M_i^\epsilon$ for $i=0,1,2$ and a Boolean +$\epsilon$ are the following prototile records: +$$ +\begin{array}{c|cc} +i&M_i^{\mathrm{true}}&M_i^{\mathrm{false}}\\\hline +0&Q_r(s,q)&Q_r(q,0)\\ +1&Q_s(-s,0)&Q_s(0,q)\\ +2&\varnothing@(q,0)&\varnothing@(0,0). +\end{array} +$$ +Here $\varnothing@a$ is the record with empty cell set and anchor $a$. +These are the plus- and minus-centroid parent placements used in the Ford +T4 and T5 calculations, not the signed subtiles inside the child. +-/ +def P5110T1ParentModel (r s : Nat) (i : Fin 3) (plus : Bool) : ProtoTile := +-- BODY + if plus then + ![TileTranslation (FordTile r) ⟨(s : Int), ((r + s : Nat) : Int)⟩, + TileTranslation (FordTile s) ⟨-(s : Int), 0⟩, + (⟨∅, ⟨((r + s : Nat) : Int), 0⟩⟩ : ProtoTile)] i + else + ![TileTranslation (FordTile r) ⟨((r + s : Nat) : Int), 0⟩, + TileTranslation (FordTile s) ⟨0, ((r + s : Nat) : Int)⟩, + (⟨∅, 0⟩ : ProtoTile)] i + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5110T1PositiveParentTriples.lean b/LeanPool/ApollonianSuperharmonic/P5110T1PositiveParentTriples.lean new file mode 100644 index 0000000000..6ffa75196d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5110T1PositiveParentTriples.lean @@ -0,0 +1,148 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5110T1ParentModel +public import LeanPool.ApollonianSuperharmonic.P5110T1SquareInterface +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: P5110T1PositiveParentTriples] + +/-! +# P5110T1PositiveParentTriples + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5110T1PositiveParentTriples (r s : Nat) (hr : 0 < r) (hs : 0 < s) : + let q := r + s + let A := FordTile q + TouchingTriple A (TileTranslation A ⟨(q : Int), (r : Int)⟩) + (P5110T1ParentModel r s 0 true) ∧ + TouchingTriple A (TileTranslation A ⟨-(q : Int), (s : Int)⟩) + (P5110T1ParentModel r s 1 true) ∧ + TouchingTriple A (P5110T1ParentModel r s 0 true) + (P5110T1ParentModel r s 1 false) := by +-- BODY + have qpos : 0 < r + s := by omega + have zero_shift : TileTranslation (FordTile (r + s)) 0 = FordTile (r + s) := by + have h : GaussianTranslation 0 = id := by funext z; simp [GaussianTranslation] + simp [TileTranslation, h] + have swap (A B : ProtoTile) (h : TileTouching A B) : TileTouching B A := by + rcases h with h | h | h + · exact Or.inl ⟨h.2.1, h.1, h.2.2.1.symm, by simpa [Set.inter_comm] using h.2.2.2⟩ + · exact Or.inr (Or.inr h) + · exact Or.inr (Or.inl h) + let q := r + s + let A := FordTile q + dsimp only + refine ⟨?_, ?_, ?_⟩ + · let B := TileTranslation A ⟨(q : Int), (r : Int)⟩ + let C := TileTranslation (FordTile r) ⟨(s : Int), (q : Int)⟩ + change TouchingTriple A B C + rcases P5110T1SquareInterface q q qpos qpos + 0 ⟨(q : Int), (r : Int)⟩ true (by simp) + (by dsimp [q]; omega) with ⟨na, nb, dab, vab, _, _, _, _, pab⟩ + rcases P5110T1SquareInterface r q hr qpos + ⟨(s : Int), (q : Int)⟩ ⟨(q : Int), (r : Int)⟩ true + (by dsimp [q]; omega) (by dsimp [q]; omega) + with ⟨nc, _, dcb, vcb, _, _, _, _, pcb⟩ + rcases P5110T1SquareInterface q r qpos hr + 0 ⟨(s : Int), (q : Int)⟩ false (by simp) + (by dsimp [q]; omega) with ⟨_, _, dac, vac, _, _, _, _, pac⟩ + rw [zero_shift] at na dab vab pab dac vac pac + refine ⟨Or.inl ⟨na, nb, dab, pab⟩, + swap _ _ (Or.inl ⟨nc, nb, dcb, pcb⟩), + swap _ _ (Or.inl ⟨na, nc, dac, pac⟩), ⟨(q : Int), (q : Int)⟩, ?_, ?_⟩ + · have hab : (⟨(q : Int), (q : Int)⟩ : GaussianInt) ∈ + BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B := by + rw [vab]; dsimp [q]; omega + have hcb : (⟨(q : Int), (q : Int)⟩ : GaussianInt) ∈ + BoundaryFootprintVertices C ∩ BoundaryFootprintVertices B := by + rw [vcb]; dsimp [q]; omega + exact ⟨hab.1, hab.2, hcb.1⟩ + · intro z hz + have hab : z ∈ BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B := + ⟨hz.1, hz.2.1⟩ + have hcb : z ∈ BoundaryFootprintVertices C ∩ BoundaryFootprintVertices B := + ⟨hz.2.2, hz.2.1⟩ + rw [vab] at hab + rw [vcb] at hcb + dsimp [q] at hab hcb ⊢ + apply Zsqrtd.ext <;> dsimp <;> omega + · let B := TileTranslation A ⟨-(q : Int), (s : Int)⟩ + let C := TileTranslation (FordTile s) ⟨-(s : Int), 0⟩ + change TouchingTriple A B C + rcases P5110T1SquareInterface q q qpos qpos + ⟨-(q : Int), (s : Int)⟩ 0 true (by dsimp; omega) + (by dsimp [q]; omega) with ⟨nb, na, dba, vba, _, _, _, _, pba⟩ + rcases P5110T1SquareInterface s q hs qpos + ⟨-(s : Int), 0⟩ ⟨-(q : Int), (s : Int)⟩ false (by simp) + (by dsimp [q]; omega) with ⟨nc, _, dcb, vcb, _, _, _, _, pcb⟩ + rcases P5110T1SquareInterface s q hs qpos + ⟨-(s : Int), 0⟩ 0 true (by dsimp; omega) + (by dsimp [q]; omega) with ⟨_, _, dca, vca, _, _, _, _, pca⟩ + rw [zero_shift] at na dba vba pba dca vca pca + refine ⟨swap _ _ (Or.inl ⟨nb, na, dba, pba⟩), + swap _ _ (Or.inl ⟨nc, nb, dcb, pcb⟩), Or.inl ⟨nc, na, dca, pca⟩, + ⟨0, (s : Int)⟩, ?_, ?_⟩ + · have hba : (⟨0, (s : Int)⟩ : GaussianInt) ∈ + BoundaryFootprintVertices B ∩ BoundaryFootprintVertices A := by + rw [vba]; dsimp [q]; omega + have hca : (⟨0, (s : Int)⟩ : GaussianInt) ∈ + BoundaryFootprintVertices C ∩ BoundaryFootprintVertices A := by + rw [vca]; dsimp [q]; omega + exact ⟨hba.2, hba.1, hca.1⟩ + · intro z hz + have hba : z ∈ BoundaryFootprintVertices B ∩ BoundaryFootprintVertices A := + ⟨hz.2.1, hz.1⟩ + have hca : z ∈ BoundaryFootprintVertices C ∩ BoundaryFootprintVertices A := + ⟨hz.2.2, hz.1⟩ + rw [vba] at hba + rw [vca] at hca + dsimp [q] at hba hca ⊢ + apply Zsqrtd.ext <;> dsimp <;> omega + · let B := TileTranslation (FordTile r) ⟨(s : Int), (q : Int)⟩ + let C := TileTranslation (FordTile s) ⟨0, (q : Int)⟩ + change TouchingTriple A B C + rcases P5110T1SquareInterface q r qpos hr + 0 ⟨(s : Int), (q : Int)⟩ false (by simp) + (by dsimp [q]; omega) with ⟨na, nb, dab, vab, _, _, _, _, pab⟩ + rcases P5110T1SquareInterface s r hs hr + ⟨0, (q : Int)⟩ ⟨(s : Int), (q : Int)⟩ true (by simp) + (by dsimp [q]; omega) with ⟨nc, _, dcb, vcb, _, _, _, _, pcb⟩ + rcases P5110T1SquareInterface q s qpos hs + 0 ⟨0, (q : Int)⟩ false (by simp) + (by dsimp [q]; omega) with ⟨_, _, dac, vac, _, _, _, _, pac⟩ + rw [zero_shift] at na dab vab pab dac vac pac + refine ⟨Or.inl ⟨na, nb, dab, pab⟩, + swap _ _ (Or.inl ⟨nc, nb, dcb, pcb⟩), + swap _ _ (Or.inl ⟨na, nc, dac, pac⟩), ⟨(s : Int), (q : Int)⟩, ?_, ?_⟩ + · have hab : (⟨(s : Int), (q : Int)⟩ : GaussianInt) ∈ + BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B := by + rw [vab]; dsimp [q]; omega + have hac : (⟨(s : Int), (q : Int)⟩ : GaussianInt) ∈ + BoundaryFootprintVertices A ∩ BoundaryFootprintVertices C := by + rw [vac]; dsimp [q]; omega + exact ⟨hab.1, hab.2, hac.2⟩ + · intro z hz + have hab : z ∈ BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B := + ⟨hz.1, hz.2.1⟩ + have hac : z ∈ BoundaryFootprintVertices A ∩ BoundaryFootprintVertices C := + ⟨hz.1, hz.2.2⟩ + rw [vab] at hab + rw [vac] at hac + dsimp [q] at hab hac ⊢ + apply Zsqrtd.ext <;> dsimp <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean b/LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean new file mode 100644 index 0000000000..0db5168eb7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean @@ -0,0 +1,807 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport +public import Mathlib.Data.List.Chain + +-- [TABLET NODE: P5110T1SquareInterface] + +/-! +# P5110T1SquareInterface + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SquareInterfaceConstruction + +private theorem cell (h + : Nat) (c z : GaussianInt) : + z ∈ (TileTranslation (FordTile h) c).cells ↔ + c.re ≤ z.re ∧ z.re < c.re + (h : Int) ∧ + c.im ≤ z.im ∧ z.im < c.im + (h : Int) := by + classical + have translated : z ∈ (TileTranslation (FordTile h) c).cells ↔ + z - c ∈ (FordTile h).cells := by + constructor + · rintro hz + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hy + · intro hz + exact Finset.mem_image.mpr ⟨z - c, hz, by simp [GaussianTranslation]⟩ + rw [translated, (P4210T1FordCellRectangles h (z - c)).1] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + omega + +private theorem vertex (h : Nat) (hh : 0 < h) (c z : GaussianInt) : + z ∈ BoundaryFootprintVertices (TileTranslation (FordTile h) c) ↔ + c.re ≤ z.re ∧ z.re ≤ c.re + (h : Int) ∧ + c.im ≤ z.im ∧ z.im ≤ c.im + (h : Int) ∧ + (z.re = c.re ∨ z.re = c.re + (h : Int) ∨ + z.im = c.im ∨ z.im = c.im + (h : Int)) := by + classical + rw [(TileTranslationFormulas _ _).2.2.2.2.2.2.2.1, + (P4062T1CanonicalSupport h hh).2] + constructor + · rintro ⟨y, hy, rfl⟩ + dsimp [GaussianTranslation] at * + omega + · intro hz + refine ⟨z - c, ?_, by simp [GaussianTranslation]⟩ + dsimp + omega + +private theorem edge (h + : Nat) (hh : 0 < h) (c : GaussianInt) (e : Finset GaussianInt) : + e ∈ BoundaryFootprintEdges (TileTranslation (FordTile h) c) ↔ + (∃ z : GaussianInt, e = {z, z + 1} ∧ + c.re ≤ z.re ∧ z.re < c.re + (h : Int) ∧ + (z.im = c.im ∨ z.im = c.im + (h : Int))) ∨ + (∃ z : GaussianInt, e = {z, z + ⟨0, 1⟩} ∧ + c.im ≤ z.im ∧ z.im < c.im + (h : Int) ∧ + (z.re = c.re ∨ z.re = c.re + (h : Int))) := by + classical + have cell (h : Nat) (c z : GaussianInt) : + z ∈ (TileTranslation (FordTile h) c).cells ↔ + c.re ≤ z.re ∧ z.re < c.re + (h : Int) ∧ + c.im ≤ z.im ∧ z.im < c.im + (h : Int) := cell h c z + simp only [BoundaryFootprintEdges, Set.mem_ofPred_eq, cell, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + constructor + · rintro ⟨z, hz⟩ + rcases hz with ⟨he, hz⟩ | ⟨he, hz⟩ + · exact Or.inl ⟨z, he, by omega⟩ + · exact Or.inr ⟨z, he, by omega⟩ + · rintro (⟨z, he, hz⟩ | ⟨z, he, hz⟩) + · exact ⟨z, Or.inl ⟨he, by omega⟩⟩ + · exact ⟨z, Or.inr ⟨he, by omega⟩⟩ + +private noncomputable abbrev A (n : Nat) (a : GaussianInt) := TileTranslation (FordTile n) a + +private noncomputable abbrev B (m : Nat) (b : GaussianInt) := TileTranslation (FordTile m) b + +private noncomputable abbrev l (a : GaussianInt) (b : GaussianInt) (vertical : Bool) := max (if + vertical then a.im else a.re) (if vertical then b.im else b.re) + +private noncomputable abbrev u (n : Nat) (m : Nat) (a : GaussianInt) (b : GaussianInt) (vertical + : Bool) := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + +private noncomputable abbrev f (a : GaussianInt) (b : GaussianInt) (vertical : Bool) := fun k : + Nat => if vertical then (⟨b.re, (l a b vertical) + (k : Int)⟩ : GaussianInt) + else (⟨(l a b vertical) + (k : Int), b.im⟩ : GaussianInt) + +private noncomputable abbrev p (n : Nat) (m : Nat) (a : GaussianInt) (b : GaussianInt) (vertical + : Bool) := (List.range (((u n m a b vertical) - (l a b vertical)).toNat + 1)).map (f a b + vertical) + +private theorem na (n : Nat) (hn : 0 < n) (a : GaussianInt) : (A n a).cells.Nonempty := by + classical + have cell (h : Nat) (c z : GaussianInt) : + z ∈ (TileTranslation (FordTile h) c).cells ↔ + c.re ≤ z.re ∧ z.re < c.re + (h : Int) ∧ + c.im ≤ z.im ∧ z.im < c.im + (h : Int) := cell h c z + let A := TileTranslation (FordTile n) a + change (A.cells.Nonempty) + exact ⟨a, (cell n a a).mpr (by omega)⟩ + +private theorem nb (m : Nat) (hm : 0 < m) (b : GaussianInt) : (B m b).cells.Nonempty := by + classical + have cell (h : Nat) (c z : GaussianInt) : + z ∈ (TileTranslation (FordTile h) c).cells ↔ + c.re ≤ z.re ∧ z.re < c.re + (h : Int) ∧ + c.im ≤ z.im ∧ z.im < c.im + (h : Int) := cell h c z + let B := TileTranslation (FordTile m) b + change (B.cells.Nonempty) + exact ⟨b, (cell m b b).mpr (by omega)⟩ + +private theorem disj (n : Nat) (m : Nat) (a : GaussianInt) (b : GaussianInt) (vertical : Bool) + (hside : if vertical then b.re = a.re + (n : Int) else b.im = a.im + (n : Int)) (hoverlap : + max (if vertical then a.im else a.re) (if vertical then b.im else b.re) < min ((if vertical + then a.im else a.re) + (n : Int)) ((if vertical then b.im else b.re) + (m : Int))) : Disjoint + (A n a).cells (B m b).cells := by + classical + have cell (h : Nat) (c z : GaussianInt) : + z ∈ (TileTranslation (FordTile h) c).cells ↔ + c.re ≤ z.re ∧ z.re < c.re + (h : Int) ∧ + c.im ≤ z.im ∧ z.im < c.im + (h : Int) := cell h c z + let A := TileTranslation (FordTile n) a + let B := TileTranslation (FordTile m) b + change (Disjoint A.cells B.cells) + apply Finset.disjoint_left.mpr + intro z hza hzb + have ha := (cell n a z).mp hza + have hb := (cell m b z).mp hzb + cases vertical <;> dsimp at hside <;> omega + +private theorem vertices (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : + GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else b.im = + a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im + else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else + b.re) + (m : Int))) : BoundaryFootprintVertices (A n a) ∩ BoundaryFootprintVertices (B m b) = + {z | if vertical then z.re = b.re ∧ (l a b vertical) ≤ z.im ∧ z.im ≤ (u n m a b vertical) + else z.im = b.im ∧ (l a b vertical) ≤ z.re ∧ z.re ≤ (u n m a b vertical)} := by + classical + have vertex (h : Nat) (hh : 0 < h) (c z : GaussianInt) : + z ∈ BoundaryFootprintVertices (TileTranslation (FordTile h) c) ↔ + c.re ≤ z.re ∧ z.re ≤ c.re + (h : Int) ∧ + c.im ≤ z.im ∧ z.im ≤ c.im + (h : Int) ∧ + (z.re = c.re ∨ z.re = c.re + (h : Int) ∨ + z.im = c.im ∨ z.im = c.im + (h : Int)) := vertex h hh c z + let A := TileTranslation (FordTile n) a + let B := TileTranslation (FordTile m) b + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + change (BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u + else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u}) + ext z + simp only [A, B, Set.mem_inter_iff, vertex n hn a z, vertex m hm b z, + Set.mem_ofPred_eq] + cases vertical <;> simp only [l, u, Bool.false_eq_true, ↓reduceIte] at hside ⊢ + all_goals omega + +private theorem endpoints (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : + GaussianInt) (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges (A n a) ∩ BoundaryFootprintEdges (B m b)) + (z : GaussianInt) (hz : z ∈ e) : + z ∈ BoundaryFootprintVertices (A n a) ∩ BoundaryFootprintVertices (B m b) := by + classical + let A := TileTranslation (FordTile n) a + let B := TileTranslation (FordTile m) b + have na : A.cells.Nonempty := na n hn a + have nb : B.cells.Nonempty := nb m hm b + change (z ∈ BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B) + constructor + · rw [BoundaryFootprintVertices, ite_eq_left na] + exact ⟨e, he.1, hz⟩ + · rw [BoundaryFootprintVertices, ite_eq_left nb] + exact ⟨e, he.2, hz⟩ + +private theorem edges (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : + GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else b.im = + a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im + else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else + b.re) + (m : Int))) : BoundaryFootprintEdges (A n a) ∩ BoundaryFootprintEdges (B m b) = + {e | ∃ t : Int, (l a b vertical) ≤ t ∧ t < (u n m a b vertical) ∧ e = if vertical then + {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} + else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := by + classical + have edge (h : Nat) (hh : 0 < h) (c : GaussianInt) (e : Finset GaussianInt) : + e ∈ BoundaryFootprintEdges (TileTranslation (FordTile h) c) ↔ + (∃ z : GaussianInt, e = {z, z + 1} ∧ + c.re ≤ z.re ∧ z.re < c.re + (h : Int) ∧ + (z.im = c.im ∨ z.im = c.im + (h : Int))) ∨ + (∃ z : GaussianInt, e = {z, z + ⟨0, 1⟩} ∧ + c.im ≤ z.im ∧ z.im < c.im + (h : Int) ∧ + (z.re = c.re ∨ z.re = c.re + (h : Int))) := edge h hh c e + let A := TileTranslation (FordTile n) a + let B := TileTranslation (FordTile m) b + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + have vertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u + else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} := vertices n m hn hm a b vertical hside hoverlap + have endpoints (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B) + (z : GaussianInt) (hz : z ∈ e) : + z ∈ BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B := endpoints n m hn hm a b e + he z hz + change (BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = + {e | ∃ t : Int, l ≤ t ∧ t < u ∧ e = if vertical then + {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} + else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}}) + ext e + constructor + · intro he + have hea := (edge n hn a e).mp he.1 + rcases hea with ⟨z, rfl, _⟩ | ⟨z, rfl, _⟩ + · have h0 := endpoints _ he z (by simp) + have h1 := endpoints _ he (z + 1) (by simp) + rw [vertices] at h0 h1 + cases vertical + · dsimp at h0 h1 ⊢ + refine ⟨z.re, h0.2.1, ?_, ?_⟩ + · omega + · apply congrArg₂ (fun x y : GaussianInt => ({x, y} : Finset GaussianInt)) <;> + apply Zsqrtd.ext <;> dsimp <;> omega + · dsimp at h0 h1 + omega + · have h0 := endpoints _ he z (by simp) + have h1 := endpoints _ he (z + ⟨0, 1⟩) (by simp) + rw [vertices] at h0 h1 + cases vertical + · dsimp at h0 h1 + omega + · dsimp at h0 h1 ⊢ + refine ⟨z.im, h0.2.1, ?_, ?_⟩ + · omega + · apply congrArg₂ (fun x y : GaussianInt => ({x, y} : Finset GaussianInt)) <;> + apply Zsqrtd.ext <;> dsimp <;> omega + · rintro ⟨t, ht, htu, rfl⟩ + cases vertical + · dsimp [l, u] at ht htu hside ⊢ + constructor + · apply (edge n hn a _).mpr + left + refine ⟨⟨t, b.im⟩, ?_, ?_⟩ + · apply congrArg₂ (fun x y : GaussianInt => ({x, y} : Finset GaussianInt)) <;> + apply Zsqrtd.ext <;> simp + · dsimp; omega + · apply (edge m hm b _).mpr + left + refine ⟨⟨t, b.im⟩, ?_, ?_⟩ + · apply congrArg₂ (fun x y : GaussianInt => ({x, y} : Finset GaussianInt)) <;> + apply Zsqrtd.ext <;> simp + · dsimp; omega + · dsimp [l, u] at ht htu hside ⊢ + constructor + · apply (edge n hn a _).mpr + right + refine ⟨⟨b.re, t⟩, ?_, ?_⟩ + · apply congrArg₂ (fun x y : GaussianInt => ({x, y} : Finset GaussianInt)) <;> + apply Zsqrtd.ext <;> simp + · dsimp; omega + · apply (edge m hm b _).mpr + right + refine ⟨⟨b.re, t⟩, ?_, ?_⟩ + · apply congrArg₂ (fun x y : GaussianInt => ({x, y} : Finset GaussianInt)) <;> + apply Zsqrtd.ext <;> simp + · dsimp; omega + +private theorem hlu (n : Nat) (m : Nat) (a : GaussianInt) (b : GaussianInt) (vertical : Bool) + (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im else b.re) < min + ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else b.re) + (m : + Int))) : (l a b vertical) < (u n m a b vertical) := by + classical + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + change (l < u) + exact hoverlap + +private theorem hdelta (n : Nat) (m : Nat) (a : GaussianInt) (b : GaussianInt) (vertical : Bool) + (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im else b.re) < min + ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else b.re) + (m : + Int))) : ((((u n m a b vertical) - (l a b vertical)).toNat : Nat) : Int) = (u n m a b + vertical) - (l a b vertical) := by + classical + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + change ((((u - l).toNat : Nat) : Int) = u - l) + omega + +private theorem positive_length (n : Nat) (m : Nat) (a : GaussianInt) (b : GaussianInt) (vertical + : Bool) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im else b.re) < + min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else b.re) + (m : + Int))) : 0 < ((u n m a b vertical) - (l a b vertical)).toNat := by + classical + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + have hdelta : (((u - l).toNat : Nat) : Int) = u - l := hdelta n m a b vertical hoverlap + change (0 < (u - l).toNat) + omega + +private theorem finj (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : + GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else b.im = + a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im + else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else + b.re) + (m : Int))) : Function.Injective (f a b vertical) := by + classical + let A := TileTranslation (FordTile n) a + let B := TileTranslation (FordTile m) b + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) + else (⟨l + (k : Int), b.im⟩ : GaussianInt) + have vertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u + else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} := vertices n m hn hm a b vertical hside hoverlap + have edges : BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = + {e | ∃ t : Int, l ≤ t ∧ t < u ∧ e = if vertical then + {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} + else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := edges n m hn hm a b vertical hside + hoverlap + have hlu : l < u := hlu n m a b vertical hoverlap + have hdelta : (((u - l).toNat : Nat) : Int) = u - l := hdelta n m a b vertical hoverlap + have positive_length : 0 < (u - l).toNat := positive_length n m a b vertical hoverlap + change (Function.Injective f) + intro j k he + cases vertical + · have h := congrArg Zsqrtd.re he + dsimp [f] at h + omega + · have h := congrArg Zsqrtd.im he + dsimp [f] at h + omega + +private theorem pnd (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : + GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else b.im = + a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im + else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else + b.re) + (m : Int))) : (p n m a b vertical).Nodup := by + classical + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) + else (⟨l + (k : Int), b.im⟩ : GaussianInt) + let p := (List.range ((u - l).toNat + 1)).map f + have finj : Function.Injective f := finj n m hn hm a b vertical hside hoverlap + change (p.Nodup) + exact List.nodup_range.map finj + +private theorem plen (n : Nat) (m : Nat) (a : GaussianInt) (b : GaussianInt) (vertical : Bool) + (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im else b.re) < min + ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else b.re) + (m : + Int))) : 2 ≤ (p n m a b vertical).length := by + classical + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) + else (⟨l + (k : Int), b.im⟩ : GaussianInt) + let p := (List.range ((u - l).toNat + 1)).map f + have hdelta : (((u - l).toNat : Nat) : Int) = u - l := hdelta n m a b vertical hoverlap + change (2 ≤ p.length) + simp only [p, List.length_map, List.length_range]; omega + +private theorem pvertices (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : + GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else b.im = + a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im + else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else + b.re) + (m : Int))) : BoundaryFootprintVertices (A n a) ∩ BoundaryFootprintVertices (B m b) = + ((p n m a b vertical).toFinset : Set GaussianInt) := by + classical + let A := TileTranslation (FordTile n) a + let B := TileTranslation (FordTile m) b + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) + else (⟨l + (k : Int), b.im⟩ : GaussianInt) + let p := (List.range ((u - l).toNat + 1)).map f + have vertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u + else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} := vertices n m hn hm a b vertical hside hoverlap + have edges : BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = + {e | ∃ t : Int, l ≤ t ∧ t < u ∧ e = if vertical then + {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} + else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := edges n m hn hm a b vertical hside + hoverlap + have hlu : l < u := hlu n m a b vertical hoverlap + have hdelta : (((u - l).toNat : Nat) : Int) = u - l := hdelta n m a b vertical hoverlap + have positive_length : 0 < (u - l).toNat := positive_length n m a b vertical hoverlap + have finj : Function.Injective f := finj n m hn hm a b vertical hside hoverlap + have pnd : p.Nodup := pnd n m hn hm a b vertical hside hoverlap + have plen : 2 ≤ p.length := plen n m a b vertical hoverlap + change (BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + (p.toFinset : Set GaussianInt)) + ext z + rw [vertices] + simp only [Set.mem_ofPred_eq, Finset.mem_coe, List.mem_toFinset, p, List.mem_map, + List.mem_range] + constructor + · intro hz + cases vertical + · dsimp at hz + refine ⟨(z.re - l).toNat, by omega, ?_⟩ + apply Zsqrtd.ext <;> dsimp [f] <;> omega + · dsimp at hz + refine ⟨(z.im - l).toNat, by omega, ?_⟩ + apply Zsqrtd.ext <;> dsimp [f] <;> omega + · rintro ⟨k, hk, rfl⟩ + cases vertical <;> dsimp [f] <;> omega + +private noncomputable abbrev adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + +private theorem fstep (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : + GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else b.im = + a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im + else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else + b.re) + (m : Int))) (k : Nat) : adj ((f a b vertical) k) ((f a b vertical) (k + 1)) := by + classical + let A := TileTranslation (FordTile n) a + let B := TileTranslation (FordTile m) b + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) + else (⟨l + (k : Int), b.im⟩ : GaussianInt) + let p := (List.range ((u - l).toNat + 1)).map f + have vertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u + else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} := vertices n m hn hm a b vertical hside hoverlap + have edges : BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = + {e | ∃ t : Int, l ≤ t ∧ t < u ∧ e = if vertical then + {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} + else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := edges n m hn hm a b vertical hside + hoverlap + have hlu : l < u := hlu n m a b vertical hoverlap + have hdelta : (((u - l).toNat : Nat) : Int) = u - l := hdelta n m a b vertical hoverlap + have positive_length : 0 < (u - l).toNat := positive_length n m a b vertical hoverlap + have finj : Function.Injective f := finj n m hn hm a b vertical hside hoverlap + have pnd : p.Nodup := pnd n m hn hm a b vertical hside hoverlap + have plen : 2 ≤ p.length := plen n m a b vertical hoverlap + have pvertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + (p.toFinset : Set GaussianInt) := pvertices n m hn hm a b vertical hside hoverlap + let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + change (adj (f k) (f (k + 1))) + cases vertical + · left; apply Zsqrtd.ext <;> simp [f, add_assoc] + · right; right; left; apply Zsqrtd.ext <;> simp [f, add_assoc] + +private theorem chain (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : + GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else b.im = + a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im + else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else + b.re) + (m : Int))) : (p n m a b vertical).IsChain adj := by + classical + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) + else (⟨l + (k : Int), b.im⟩ : GaussianInt) + let p := (List.range ((u - l).toNat + 1)).map f + let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + have fstep (k : Nat) : adj (f k) (f (k + 1)) := fstep n m hn hm a b vertical hside hoverlap k + change (p.IsChain adj) + apply (List.isChain_map f).mpr + exact (List.isChain_range_succ _ (u - l).toNat).mpr (fun k _ => fstep k) + +private theorem step (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : + GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else b.im = + a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im + else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else + b.re) + (m : Int))) : ∀ x y l₁ l₂, (p n m a b vertical) = l₁ ++ x :: y :: l₂ → adj x y := by + classical + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) + else (⟨l + (k : Int), b.im⟩ : GaussianInt) + let p := (List.range ((u - l).toNat + 1)).map f + let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + have chain : p.IsChain adj := chain n m hn hm a b vertical hside hoverlap + change (∀ x y l₁ l₂, p = l₁ ++ x :: y :: l₂ → adj x y) + exact List.isChain_iff_forall_rel_of_append_cons_cons.mp chain + +private theorem occurs (n : Nat) (m : Nat) (a : GaussianInt) (b : GaussianInt) (vertical : Bool) + (k : Nat) (hk : k < ((u n m a b vertical) - (l a b vertical)).toNat) : + ∃ l₁ l₂, (p n m a b vertical) = l₁ ++ (f a b vertical) k :: (f a b vertical) (k + 1) :: l₂ + := by + classical + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) + else (⟨l + (k : Int), b.im⟩ : GaussianInt) + let p := (List.range ((u - l).toNat + 1)).map f + change k < (u - l).toNat at hk + change (∃ l₁ l₂, p = l₁ ++ f k :: f (k + 1) :: l₂) + have hk' : k < p.length := by simp only [p, List.length_map, List.length_range]; omega + have hk'' : k + 1 < p.length := by simp only [p, List.length_map, List.length_range]; omega + refine ⟨p.take k, p.drop (k + 2), ?_⟩ + conv_lhs => rw [← List.take_append_drop k p] + rw [List.drop_eq_getElem_cons hk', List.drop_eq_getElem_cons hk''] + simp [p] + +private theorem edge_step (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : + GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else b.im = + a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im + else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else + b.re) + (m : Int))) (k : Nat) (hk : k < ((u n m a b vertical) - (l a b vertical)).toNat) : + {(f a b vertical) k, (f a b vertical) (k + 1)} ∈ BoundaryFootprintEdges (A n a) ∩ + BoundaryFootprintEdges (B m b) := by + classical + let A := TileTranslation (FordTile n) a + let B := TileTranslation (FordTile m) b + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) + else (⟨l + (k : Int), b.im⟩ : GaussianInt) + let p := (List.range ((u - l).toNat + 1)).map f + have vertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u + else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} := vertices n m hn hm a b vertical hside hoverlap + have edges : BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = + {e | ∃ t : Int, l ≤ t ∧ t < u ∧ e = if vertical then + {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} + else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := edges n m hn hm a b vertical hside + hoverlap + have hlu : l < u := hlu n m a b vertical hoverlap + have hdelta : (((u - l).toNat : Nat) : Int) = u - l := hdelta n m a b vertical hoverlap + have positive_length : 0 < (u - l).toNat := positive_length n m a b vertical hoverlap + have finj : Function.Injective f := finj n m hn hm a b vertical hside hoverlap + have pnd : p.Nodup := pnd n m hn hm a b vertical hside hoverlap + have plen : 2 ≤ p.length := plen n m a b vertical hoverlap + have pvertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + (p.toFinset : Set GaussianInt) := pvertices n m hn hm a b vertical hside hoverlap + let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + have fstep (k : Nat) : adj (f k) (f (k + 1)) := fstep n m hn hm a b vertical hside hoverlap k + have chain : p.IsChain adj := chain n m hn hm a b vertical hside hoverlap + have step : ∀ x y l₁ l₂, p = l₁ ++ x :: y :: l₂ → adj x y := step n m hn hm a b vertical hside + hoverlap + have occurs (k : Nat) (hk : k < (u - l).toNat) : + ∃ l₁ l₂, p = l₁ ++ f k :: f (k + 1) :: l₂ := occurs n m a b vertical k hk + change k < (u - l).toNat at hk + change ({f k, f (k + 1)} ∈ BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B) + rw [edges] + refine ⟨l + (k : Int), by omega, by omega, ?_⟩ + cases vertical <;> simp [f, add_assoc] + +private theorem adjacent_indices (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) + (b : GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else + b.im = a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then + b.im else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im + else b.re) + (m : Int))) (j k : Nat) (h : adj ((f a b vertical) j) ((f a b vertical) k)) : + k = j + 1 ∨ j = k + 1 := by + classical + let A := TileTranslation (FordTile n) a + let B := TileTranslation (FordTile m) b + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) + else (⟨l + (k : Int), b.im⟩ : GaussianInt) + let p := (List.range ((u - l).toNat + 1)).map f + have vertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u + else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} := vertices n m hn hm a b vertical hside hoverlap + have edges : BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = + {e | ∃ t : Int, l ≤ t ∧ t < u ∧ e = if vertical then + {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} + else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := edges n m hn hm a b vertical hside + hoverlap + have hlu : l < u := hlu n m a b vertical hoverlap + have hdelta : (((u - l).toNat : Nat) : Int) = u - l := hdelta n m a b vertical hoverlap + have positive_length : 0 < (u - l).toNat := positive_length n m a b vertical hoverlap + have finj : Function.Injective f := finj n m hn hm a b vertical hside hoverlap + have pnd : p.Nodup := pnd n m hn hm a b vertical hside hoverlap + have plen : 2 ≤ p.length := plen n m a b vertical hoverlap + have pvertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + (p.toFinset : Set GaussianInt) := pvertices n m hn hm a b vertical hside hoverlap + let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + have fstep (k : Nat) : adj (f k) (f (k + 1)) := fstep n m hn hm a b vertical hside hoverlap k + have chain : p.IsChain adj := chain n m hn hm a b vertical hside hoverlap + have step : ∀ x y l₁ l₂, p = l₁ ++ x :: y :: l₂ → adj x y := step n m hn hm a b vertical hside + hoverlap + have occurs (k : Nat) (hk : k < (u - l).toNat) : + ∃ l₁ l₂, p = l₁ ++ f k :: f (k + 1) :: l₂ := occurs n m a b vertical k hk + have edge_step (k : Nat) (hk : k < (u - l).toNat) : + {f k, f (k + 1)} ∈ BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B := edge_step n m hn + hm a b vertical hside hoverlap k hk + change adj (f j) (f k) at h + cases vertical <;> simp [adj, f, Zsqrtd.ext_iff] at h <;> omega + +private theorem path (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : + GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else b.im = + a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im + else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else + b.re) + (m : Int))) : SimpleGridPath (BoundaryFootprintVertices (A n a) ∩ + BoundaryFootprintVertices (B m b)) + (BoundaryFootprintEdges (A n a) ∩ BoundaryFootprintEdges (B m b)) := by + classical + let A := TileTranslation (FordTile n) a + let B := TileTranslation (FordTile m) b + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) + else (⟨l + (k : Int), b.im⟩ : GaussianInt) + let p := (List.range ((u - l).toNat + 1)).map f + have vertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u + else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} := vertices n m hn hm a b vertical hside hoverlap + have edges : BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = + {e | ∃ t : Int, l ≤ t ∧ t < u ∧ e = if vertical then + {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} + else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := edges n m hn hm a b vertical hside + hoverlap + have hlu : l < u := hlu n m a b vertical hoverlap + have hdelta : (((u - l).toNat : Nat) : Int) = u - l := hdelta n m a b vertical hoverlap + have positive_length : 0 < (u - l).toNat := positive_length n m a b vertical hoverlap + have finj : Function.Injective f := finj n m hn hm a b vertical hside hoverlap + have pnd : p.Nodup := pnd n m hn hm a b vertical hside hoverlap + have plen : 2 ≤ p.length := plen n m a b vertical hoverlap + have pvertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + (p.toFinset : Set GaussianInt) := pvertices n m hn hm a b vertical hside hoverlap + let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + have fstep (k : Nat) : adj (f k) (f (k + 1)) := fstep n m hn hm a b vertical hside hoverlap k + have chain : p.IsChain adj := chain n m hn hm a b vertical hside hoverlap + have step : ∀ x y l₁ l₂, p = l₁ ++ x :: y :: l₂ → adj x y := step n m hn hm a b vertical hside + hoverlap + have occurs (k : Nat) (hk : k < (u - l).toNat) : + ∃ l₁ l₂, p = l₁ ++ f k :: f (k + 1) :: l₂ := occurs n m a b vertical k hk + have edge_step (k : Nat) (hk : k < (u - l).toNat) : + {f k, f (k + 1)} ∈ BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B := edge_step n m hn + hm a b vertical hside hoverlap k hk + have adjacent_indices (j k : Nat) (h : adj (f j) (f k)) : + k = j + 1 ∨ j = k + 1 := adjacent_indices n m hn hm a b vertical hside hoverlap j k h + change (SimpleGridPath (BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B) + (BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B)) + refine ⟨p, pnd, plen, pvertices, step, ?_⟩ + intro e + constructor + · intro he + rw [edges] at he + obtain ⟨t, htl, htu, het⟩ := he + let k := (t - l).toNat + have hk : k < (u - l).toNat := by dsimp [k]; omega + obtain ⟨l₁, l₂, hp⟩ := occurs k hk + refine ⟨f k, f (k + 1), l₁, l₂, hp, ?_⟩ + rw [het] + cases vertical <;> + apply congrArg₂ (fun x y : GaussianInt => ({x, y} : Finset GaussianInt)) <;> + apply Zsqrtd.ext <;> dsimp [f, k] <;> omega + · rintro ⟨x, y, l₁, l₂, hp, rfl⟩ + have hx : x ∈ p := by rw [hp]; simp + have hy : y ∈ p := by rw [hp]; simp + obtain ⟨j, hj, rfl⟩ : ∃ j < (u - l).toNat + 1, f j = x := by + simpa only [p, List.mem_map, List.mem_range] using hx + obtain ⟨k, hk, rfl⟩ : ∃ k < (u - l).toNat + 1, f k = y := by + simpa only [p, List.mem_map, List.mem_range] using hy + rcases adjacent_indices j k (step _ _ _ _ hp) with h | h + · subst k + exact edge_step j (by omega) + · subst j + simpa only [Finset.pair_comm] using edge_step k (by omega) + +end SquareInterfaceConstruction + +theorem P5110T1SquareInterface (n m : Nat) (hn : 0 < n) (hm : 0 < m) + (a b : GaussianInt) (vertical : Bool) + (hside : if vertical then b.re = a.re + (n : Int) + else b.im = a.im + (n : Int)) + (hoverlap : + max (if vertical then a.im else a.re) (if vertical then b.im else b.re) < + min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int))) : + let A := TileTranslation (FordTile n) a + let B := TileTranslation (FordTile m) b + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + let p := (List.range ((u - l).toNat + 1)).map (fun k : Nat => + if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) + else (⟨l + (k : Int), b.im⟩ : GaussianInt)) + A.cells.Nonempty ∧ B.cells.Nonempty ∧ Disjoint A.cells B.cells ∧ + BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u + else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} ∧ + BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = + {e | ∃ t : Int, l ≤ t ∧ t < u ∧ + e = if vertical then + {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} + else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} ∧ + p.Nodup ∧ 2 ≤ p.length ∧ + BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + (p.toFinset : Set GaussianInt) ∧ + SimpleGridPath (BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B) + (BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B) := by +-- BODY + have cell (h : Nat) (c z : GaussianInt) : + z ∈ (TileTranslation (FordTile h) c).cells ↔ + c.re ≤ z.re ∧ z.re < c.re + (h : Int) ∧ + c.im ≤ z.im ∧ z.im < c.im + (h : Int) := SquareInterfaceConstruction.cell h c z + have vertex (h : Nat) (hh : 0 < h) (c z : GaussianInt) : + z ∈ BoundaryFootprintVertices (TileTranslation (FordTile h) c) ↔ + c.re ≤ z.re ∧ z.re ≤ c.re + (h : Int) ∧ + c.im ≤ z.im ∧ z.im ≤ c.im + (h : Int) ∧ + (z.re = c.re ∨ z.re = c.re + (h : Int) ∨ + z.im = c.im ∨ z.im = c.im + (h : Int)) := SquareInterfaceConstruction.vertex h hh c z + have edge (h : Nat) (hh : 0 < h) (c : GaussianInt) (e : Finset GaussianInt) : + e ∈ BoundaryFootprintEdges (TileTranslation (FordTile h) c) ↔ + (∃ z : GaussianInt, e = {z, z + 1} ∧ + c.re ≤ z.re ∧ z.re < c.re + (h : Int) ∧ + (z.im = c.im ∨ z.im = c.im + (h : Int))) ∨ + (∃ z : GaussianInt, e = {z, z + ⟨0, 1⟩} ∧ + c.im ≤ z.im ∧ z.im < c.im + (h : Int) ∧ + (z.re = c.re ∨ z.re = c.re + (h : Int))) := SquareInterfaceConstruction.edge h hh c e + let A := TileTranslation (FordTile n) a + let B := TileTranslation (FordTile m) b + let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) + let u := min ((if vertical then a.im else a.re) + (n : Int)) + ((if vertical then b.im else b.re) + (m : Int)) + let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) + else (⟨l + (k : Int), b.im⟩ : GaussianInt) + let p := (List.range ((u - l).toNat + 1)).map f + have na : A.cells.Nonempty := SquareInterfaceConstruction.na n hn a + have nb : B.cells.Nonempty := SquareInterfaceConstruction.nb m hm b + have disj : Disjoint A.cells B.cells := SquareInterfaceConstruction.disj n m a b vertical hside + hoverlap + have vertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u + else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} := SquareInterfaceConstruction.vertices n m hn hm + a b vertical hside hoverlap + have endpoints (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B) + (z : GaussianInt) (hz : z ∈ e) : + z ∈ BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B := + SquareInterfaceConstruction.endpoints n m hn hm a b e he z hz + have edges : BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = + {e | ∃ t : Int, l ≤ t ∧ t < u ∧ e = if vertical then + {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} + else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := SquareInterfaceConstruction.edges n m + hn hm a b vertical hside hoverlap + have hlu : l < u := SquareInterfaceConstruction.hlu n m a b vertical hoverlap + have hdelta : (((u - l).toNat : Nat) : Int) = u - l := SquareInterfaceConstruction.hdelta n m a + b vertical hoverlap + have positive_length : 0 < (u - l).toNat := SquareInterfaceConstruction.positive_length n m a b + vertical hoverlap + have finj : Function.Injective f := SquareInterfaceConstruction.finj n m hn hm a b vertical + hside hoverlap + have pnd : p.Nodup := SquareInterfaceConstruction.pnd n m hn hm a b vertical hside hoverlap + have plen : 2 ≤ p.length := SquareInterfaceConstruction.plen n m a b vertical hoverlap + have pvertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = + (p.toFinset : Set GaussianInt) := SquareInterfaceConstruction.pvertices n m hn hm a b + vertical hside hoverlap + let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + have fstep (k : Nat) : adj (f k) (f (k + 1)) := SquareInterfaceConstruction.fstep n m hn hm a b + vertical hside hoverlap k + have chain : p.IsChain adj := SquareInterfaceConstruction.chain n m hn hm a b vertical hside + hoverlap + have step : ∀ x y l₁ l₂, p = l₁ ++ x :: y :: l₂ → adj x y := SquareInterfaceConstruction.step n + m hn hm a b vertical hside hoverlap + have occurs (k : Nat) (hk : k < (u - l).toNat) : + ∃ l₁ l₂, p = l₁ ++ f k :: f (k + 1) :: l₂ := SquareInterfaceConstruction.occurs n m a b + vertical k hk + have edge_step (k : Nat) (hk : k < (u - l).toNat) : + {f k, f (k + 1)} ∈ BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B := + SquareInterfaceConstruction.edge_step n m hn hm a b vertical hside hoverlap k hk + have adjacent_indices (j k : Nat) (h : adj (f j) (f k)) : + k = j + 1 ∨ j = k + 1 := SquareInterfaceConstruction.adjacent_indices n m hn hm a b + vertical hside hoverlap j k h + have path : SimpleGridPath (BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B) + (BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B) := SquareInterfaceConstruction.path n + m hn hm a b vertical hside hoverlap + exact ⟨na, nb, disj, vertices, edges, pnd, plen, pvertices, path⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5110T1TranslationTriples.lean b/LeanPool/ApollonianSuperharmonic/P5110T1TranslationTriples.lean new file mode 100644 index 0000000000..950b8224e3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5110T1TranslationTriples.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5110T1SquareInterface +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: P5110T1TranslationTriples] + +/-! +# P5110T1TranslationTriples + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5110T1TranslationTriples (r s : Nat) (hr : 0 < r) (hs : 0 < s) : + let q := r + s + let A := FordTile q + TouchingTriple A (TileTranslation A ⟨(q : Int), (r : Int)⟩) + (TileTranslation A ⟨(q : Int), -(s : Int)⟩) ∧ + TouchingTriple A (TileTranslation A ⟨-(q : Int), (s : Int)⟩) + (TileTranslation A ⟨0, (q : Int)⟩) ∧ + TouchingTriple A (TileTranslation A ⟨0, -(q : Int)⟩) + (TileTranslation A ⟨-(q : Int), -(r : Int)⟩) := by +-- BODY + have qpos : 0 < r + s := by omega + have zero_shift : TileTranslation (FordTile (r + s)) 0 = FordTile (r + s) := by + have h : GaussianTranslation 0 = id := by funext z; simp [GaussianTranslation] + simp [TileTranslation, h] + have swap (A B : ProtoTile) (h : TileTouching A B) : TileTouching B A := by + rcases h with h | h | h + · exact Or.inl ⟨h.2.1, h.1, h.2.2.1.symm, by simpa [Set.inter_comm] using h.2.2.2⟩ + · exact Or.inr (Or.inr h) + · exact Or.inr (Or.inl h) + dsimp only + refine ⟨?_, ?_, ?_⟩ + · rcases P5110T1SquareInterface (r + s) (r + s) qpos qpos + 0 ⟨((r + s : Nat) : Int), (r : Int)⟩ true (by simp) + (by dsimp; omega) with ⟨na, nb, dab, vab, _, _, _, _, pab⟩ + rcases P5110T1SquareInterface (r + s) (r + s) qpos qpos + ⟨((r + s : Nat) : Int), -(s : Int)⟩ + ⟨((r + s : Nat) : Int), (r : Int)⟩ false (by dsimp; omega) + (by dsimp; omega) with ⟨nc, nb', dcb, vcb, _, _, _, _, pcb⟩ + rcases P5110T1SquareInterface (r + s) (r + s) qpos qpos + 0 ⟨((r + s : Nat) : Int), -(s : Int)⟩ true (by simp) + (by dsimp; omega) with ⟨_, _, dac, vac, _, _, _, _, pac⟩ + rw [zero_shift] at na dab vab pab dac vac pac + refine ⟨Or.inl ⟨na, nb, dab, pab⟩, + swap _ _ (Or.inl ⟨nc, nb', dcb, pcb⟩), + swap _ _ (Or.inl ⟨na, nc, dac, pac⟩), + ⟨((r + s : Nat) : Int), (r : Int)⟩, ?_, ?_⟩ + · have hab : (⟨((r + s : Nat) : Int), (r : Int)⟩ : GaussianInt) ∈ + BoundaryFootprintVertices (FordTile (r + s)) ∩ + BoundaryFootprintVertices (TileTranslation (FordTile (r + s)) + ⟨((r + s : Nat) : Int), (r : Int)⟩) := by + rw [vab]; dsimp; omega + have hac : (⟨((r + s : Nat) : Int), (r : Int)⟩ : GaussianInt) ∈ + BoundaryFootprintVertices (FordTile (r + s)) ∩ + BoundaryFootprintVertices (TileTranslation (FordTile (r + s)) + ⟨((r + s : Nat) : Int), -(s : Int)⟩) := by + rw [vac]; dsimp; omega + exact ⟨hab.1, hab.2, hac.2⟩ + · intro z hz + have hab : z ∈ _ := show z ∈ BoundaryFootprintVertices (FordTile (r + s)) ∩ + BoundaryFootprintVertices (TileTranslation (FordTile (r + s)) + ⟨((r + s : Nat) : Int), (r : Int)⟩) from ⟨hz.1, hz.2.1⟩ + have hac : z ∈ _ := show z ∈ BoundaryFootprintVertices (FordTile (r + s)) ∩ + BoundaryFootprintVertices (TileTranslation (FordTile (r + s)) + ⟨((r + s : Nat) : Int), -(s : Int)⟩) from ⟨hz.1, hz.2.2⟩ + rw [vab] at hab + rw [vac] at hac + dsimp at hab hac + apply Zsqrtd.ext <;> dsimp <;> omega + · rcases P5110T1SquareInterface (r + s) (r + s) qpos qpos + ⟨-((r + s : Nat) : Int), (s : Int)⟩ 0 true (by dsimp; omega) + (by dsimp; omega) with ⟨nb, na, dba, vba, _, _, _, _, pba⟩ + rcases P5110T1SquareInterface (r + s) (r + s) qpos qpos + ⟨-((r + s : Nat) : Int), (s : Int)⟩ + ⟨0, ((r + s : Nat) : Int)⟩ true (by dsimp; omega) + (by dsimp; omega) with ⟨_, nc, dbc, vbc, _, _, _, _, pbc⟩ + rcases P5110T1SquareInterface (r + s) (r + s) qpos qpos + 0 ⟨0, ((r + s : Nat) : Int)⟩ false (by simp) + (by dsimp; omega) with ⟨_, _, dac, vac, _, _, _, _, pac⟩ + rw [zero_shift] at na dba vba pba dac vac pac + refine ⟨swap _ _ (Or.inl ⟨nb, na, dba, pba⟩), + Or.inl ⟨nb, nc, dbc, pbc⟩, swap _ _ (Or.inl ⟨na, nc, dac, pac⟩), + ⟨0, ((r + s : Nat) : Int)⟩, ?_, ?_⟩ + · have hba : (⟨0, ((r + s : Nat) : Int)⟩ : GaussianInt) ∈ + BoundaryFootprintVertices (TileTranslation (FordTile (r + s)) + ⟨-((r + s : Nat) : Int), (s : Int)⟩) ∩ + BoundaryFootprintVertices (FordTile (r + s)) := by + rw [vba]; dsimp; omega + have hbc : (⟨0, ((r + s : Nat) : Int)⟩ : GaussianInt) ∈ + BoundaryFootprintVertices (TileTranslation (FordTile (r + s)) + ⟨-((r + s : Nat) : Int), (s : Int)⟩) ∩ + BoundaryFootprintVertices (TileTranslation (FordTile (r + s)) + ⟨0, ((r + s : Nat) : Int)⟩) := by + rw [vbc]; dsimp; omega + exact ⟨hba.2, hba.1, hbc.2⟩ + · intro z hz + have hba : z ∈ _ := show z ∈ BoundaryFootprintVertices + (TileTranslation (FordTile (r + s)) ⟨-((r + s : Nat) : Int), (s : Int)⟩) ∩ + BoundaryFootprintVertices (FordTile (r + s)) from ⟨hz.2.1, hz.1⟩ + have hbc : z ∈ _ := show z ∈ BoundaryFootprintVertices + (TileTranslation (FordTile (r + s)) ⟨-((r + s : Nat) : Int), (s : Int)⟩) ∩ + BoundaryFootprintVertices (TileTranslation (FordTile (r + s)) + ⟨0, ((r + s : Nat) : Int)⟩) from ⟨hz.2.1, hz.2.2⟩ + rw [vba] at hba + rw [vbc] at hbc + dsimp at hba hbc + apply Zsqrtd.ext <;> dsimp <;> omega + · rcases P5110T1SquareInterface (r + s) (r + s) qpos qpos + ⟨0, -((r + s : Nat) : Int)⟩ 0 false (by dsimp; omega) + (by dsimp; omega) with ⟨nb, na, dba, vba, _, _, _, _, pba⟩ + rcases P5110T1SquareInterface (r + s) (r + s) qpos qpos + ⟨-((r + s : Nat) : Int), -(r : Int)⟩ + ⟨0, -((r + s : Nat) : Int)⟩ true (by dsimp; omega) + (by dsimp; omega) with ⟨nc, _, dcb, vcb, _, _, _, _, pcb⟩ + rcases P5110T1SquareInterface (r + s) (r + s) qpos qpos + ⟨-((r + s : Nat) : Int), -(r : Int)⟩ 0 true (by dsimp; omega) + (by dsimp; omega) with ⟨_, _, dca, vca, _, _, _, _, pca⟩ + rw [zero_shift] at na dba vba pba dca vca pca + refine ⟨swap _ _ (Or.inl ⟨nb, na, dba, pba⟩), + swap _ _ (Or.inl ⟨nc, nb, dcb, pcb⟩), Or.inl ⟨nc, na, dca, pca⟩, + 0, ?_, ?_⟩ + · have hcb : (0 : GaussianInt) ∈ BoundaryFootprintVertices + (TileTranslation (FordTile (r + s)) ⟨-((r + s : Nat) : Int), -(r : Int)⟩) ∩ + BoundaryFootprintVertices (TileTranslation (FordTile (r + s)) + ⟨0, -((r + s : Nat) : Int)⟩) := by + rw [vcb]; dsimp; omega + have hca : (0 : GaussianInt) ∈ BoundaryFootprintVertices + (TileTranslation (FordTile (r + s)) ⟨-((r + s : Nat) : Int), -(r : Int)⟩) ∩ + BoundaryFootprintVertices (FordTile (r + s)) := by + rw [vca]; dsimp; omega + exact ⟨hca.2, hcb.2, hca.1⟩ + · intro z hz + have hcb : z ∈ _ := show z ∈ BoundaryFootprintVertices + (TileTranslation (FordTile (r + s)) ⟨-((r + s : Nat) : Int), -(r : Int)⟩) ∩ + BoundaryFootprintVertices (TileTranslation (FordTile (r + s)) + ⟨0, -((r + s : Nat) : Int)⟩) from ⟨hz.2.2, hz.2.1⟩ + have hca : z ∈ _ := show z ∈ BoundaryFootprintVertices + (TileTranslation (FordTile (r + s)) ⟨-((r + s : Nat) : Int), -(r : Int)⟩) ∩ + BoundaryFootprintVertices (FordTile (r + s)) from ⟨hz.2.2, hz.1⟩ + rw [vcb] at hcb + rw [vca] at hca + dsimp at hcb hca + apply Zsqrtd.ext <;> dsimp <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5116T1PredecessorDeletionDisk.lean b/LeanPool/ApollonianSuperharmonic/P5116T1PredecessorDeletionDisk.lean new file mode 100644 index 0000000000..e6449eb384 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5116T1PredecessorDeletionDisk.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FinitePolyominoDiskCriterion +public import + LeanPool.ApollonianSuperharmonic.P5617T1RectangleReachabilityAndBasepointConnectivity +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P5116T1PredecessorDeletionDisk] + +/-! +# P5116T1PredecessorDeletionDisk + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5116T1PredecessorDeletionDisk (k : Nat) (hk : 1 < k) + (shifted : Bool) (T : ProtoTile) + (hcells : T.cells = (DiamondTile k).cells \ + (if shifted then TileTranslation (DiamondTile (k - 1)) ⟨0, 2⟩ + else DiamondTile (k - 1)).cells) : + LatticeTile T := by +-- BODY + classical + let reach (A : Set LatticeCell) := Relation.ReflTransGen + (fun x y => FourNeighborAdjacent x y ∧ x ∈ A ∧ y ∈ A) + have single (A : Set LatticeCell) {x y : LatticeCell} + (hx : x ∈ A) (hy : y ∈ A) (hxy : FourNeighborAdjacent x y) : + reach A x y := Relation.ReflTransGen.single ⟨hxy, hx, hy⟩ + obtain ⟨rect, connected⟩ := P5617T1RectangleReachabilityAndBasepointConnectivity + have diamond (m : Nat) (z : LatticeCell) : z ∈ (DiamondTile m).cells ↔ + 0 ≤ z.im ∧ z.im < 2 * (m : Int) ∧ + -(z.im + 1) ≤ z.re ∧ z.re < z.im + 1 ∧ + -(2 * (m : Int) - z.im) ≤ z.re ∧ z.re < 2 * (m : Int) - z.im := + (P4194T1DiamondCellRows m z).1 + let B : Set LatticeCell := + {z | z ∈ (DiamondTile k).cells ∧ z ∉ (DiamondTile (k - 1)).cells} + have bmem (z : LatticeCell) : z ∈ B ↔ + z ∈ (DiamondTile k).cells ∧ z ∉ (DiamondTile (k - 1)).cells := Iff.rfl + let o : LatticeCell := ⟨0, 2 * (k : Int) - 2⟩ + have ho : o ∈ B := by + simp only [bmem, diamond] + norm_num [o] + omega + have climb : ∀ h : Int, ∀ p : LatticeCell, p.im = h → p ∈ B → reach B p o := by + intro h + induction h using Int.inductionOn' (b := 2 * (k : Int) - 2) with + | zero => + intro p hpi hp + apply rect B p o + intro z h1 h2 h3 h4 + simp only [bmem, diamond] at hp ⊢ + dsimp [o] at h1 h2 h3 h4 + omega + | succ h hh ih => + intro p hpi hp + apply rect B p o + intro z h1 h2 h3 h4 + simp only [bmem, diamond] at hp ⊢ + dsimp [o] at h1 h2 h3 h4 + omega + | pred h hh ih => + intro p hpi hp + let a : Int := if p.re < 0 then p.im - 2 * (k : Int) + 1 + else 2 * (k : Int) - p.im - 2 + let m : LatticeCell := ⟨a, p.im⟩ + let n : LatticeCell := ⟨a, h⟩ + have hm : m ∈ B := by + simp only [bmem, diamond] at hp ⊢ + dsimp [m, a] + split_ifs <;> omega + have hn : n ∈ B := by + simp only [bmem, diamond] at hp ⊢ + dsimp [n, a] + split_ifs <;> omega + have hr : reach B p m := by + apply rect B p m + intro z h1 h2 h3 h4 + simp only [bmem, diamond] at hp ⊢ + dsimp [m, a] at h1 h2 h3 h4 + split_ifs at * <;> omega + exact hr.trans ((single B hm hn (by + apply Or.inr; apply Or.inr; apply Or.inl + apply Zsqrtd.ext <;> dsimp [n, m] <;> omega)).trans (ih n rfl hn)) + let e : LatticeCell := ⟨(k : Int) + 1, -1⟩ + have exterior (p : LatticeCell) (hp : p ∉ (DiamondTile k).cells) : + reach Bᶜ p e := by + let a : Int := if p.re < 0 then -(k : Int) - 1 else (k : Int) + 1 + let m : LatticeCell := ⟨a, p.im⟩ + let n : LatticeCell := ⟨a, -1⟩ + apply (rect Bᶜ p m ?_).trans ((rect Bᶜ m n ?_).trans (rect Bᶜ n e ?_)) + all_goals + intro z h1 h2 h3 h4 + change z ∉ B + rw [bmem, diamond] + rw [diamond] at hp + dsimp [m, n, e, a] at h1 h2 h3 h4 + split_ifs at * <;> omega + have he : e ∈ Bᶜ := by + change e ∉ B + simp only [bmem, diamond] + norm_num [e] + have escape (p : LatticeCell) (hp : p ∈ Bᶜ) : reach Bᶜ p e := by + by_cases hpD : p ∈ (DiamondTile k).cells + · have hpP : p ∈ (DiamondTile (k - 1)).cells := by + change p ∉ B at hp + rw [bmem] at hp + tauto + let m : LatticeCell := ⟨0, p.im⟩ + let n : LatticeCell := ⟨0, -1⟩ + apply (rect Bᶜ p m ?_).trans + ((rect Bᶜ m n ?_).trans (exterior n (by rw [diamond]; norm_num [n]))) + all_goals + intro z h1 h2 h3 h4 + change z ∉ B + simp only [bmem, diamond] + rw [diamond] at hpP + dsimp [m, n] at h1 h2 h3 h4 + omega + · exact exterior p hpD + let A : Set LatticeCell := T.cells + let f : LatticeCell → LatticeCell := fun z => + ⟨z.re, if shifted then 2 * (k : Int) - 1 - z.im else z.im⟩ + have invol (z : LatticeCell) : f (f z) = z := by + apply Zsqrtd.ext <;> cases shifted <;> simp [f] + have adj (p q : LatticeCell) (hpq : FourNeighborAdjacent p q) : + FourNeighborAdjacent (f p) (f q) := by + rcases hpq with h | h | h | h <;> subst q <;> cases shifted <;> + simp [FourNeighborAdjacent, f, Zsqrtd.ext_iff] <;> omega + have translated_mem (z : GaussianInt) : + z ∈ (TileTranslation (DiamondTile (k - 1)) ⟨0, 2⟩).cells ↔ + z - ⟨0, 2⟩ ∈ (DiamondTile (k - 1)).cells := by + change z ∈ (DiamondTile (k - 1)).cells.image (GaussianTranslation ⟨0, 2⟩) ↔ _ + constructor + · intro hz + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hy + · intro hz + exact Finset.mem_image.mpr ⟨z - ⟨0, 2⟩, hz, by simp [GaussianTranslation]⟩ + have amem (z : LatticeCell) : z ∈ A ↔ f z ∈ B := by + change z ∈ T.cells ↔ _ + rw [hcells, Finset.mem_sdiff] + cases shifted <;> simp only [Bool.false_eq_true, ↓reduceIte, + translated_mem, bmem, diamond] <;> + norm_num [f]; omega + have mapped (U V : Set LatticeCell) + (hm : ∀ z ∈ U, f z ∈ V) {p q : LatticeCell} (hpq : reach U p q) : + reach V (f p) (f q) := by + induction hpq with + | refl => exact Relation.ReflTransGen.refl + | tail h hstep ih => + exact ih.trans (single V (hm _ hstep.2.1) (hm _ hstep.2.2) + (adj _ _ hstep.1)) + have intoA (z : LatticeCell) (hz : z ∈ B) : f z ∈ A := by + rw [amem, invol] + exact hz + have intoAc (z : LatticeCell) (hz : z ∈ Bᶜ) : f z ∈ Aᶜ := by + change f z ∉ A + rw [amem, invol] + exact hz + have inside : FourNeighborConnected A := by + apply connected A (f o) (intoA o ho) + intro p hp + have h := mapped B A intoA (climb (f p).im (f p) rfl ((amem p).mp hp)) + simpa only [invol] using h + have outside : FourNeighborConnected Aᶜ := by + apply connected Aᶜ (f e) (intoAc e he) + intro p hp + have hfp : f p ∈ Bᶜ := by + change f p ∉ B + exact fun h => hp ((amem p).mpr h) + have h := mapped Bᶜ Aᶜ intoAc (escape (f p) hfp) + simpa only [invol] using h + have checker : NoCheckerboardCellVertex A := by + intro z + simp only [amem, bmem, diamond] + cases shifted <;> + norm_num [f, Zsqrtd.re_sub, Zsqrtd.im_sub] <;> omega + exact FinitePolyominoDiskCriterion T inside outside checker + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5116T1UnitDeletionDisk.lean b/LeanPool/ApollonianSuperharmonic/P5116T1UnitDeletionDisk.lean new file mode 100644 index 0000000000..f263dc57bb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5116T1UnitDeletionDisk.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FinitePolyominoDiskCriterion +public import LeanPool.ApollonianSuperharmonic.P5617T1RectangleReachabilityAndBasepointConnectivity +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows + +-- [TABLET NODE: P5116T1UnitDeletionDisk] + +/-! +# P5116T1UnitDeletionDisk + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5116T1UnitDeletionDisk (k : Nat) (hk : 0 < k) + (x : GaussianInt) + (hx : (x.re = -(k : Int) ∨ x.re = (k : Int) - 1) ∧ + (x.im = (k : Int) - 1 ∨ x.im = (k : Int))) + (T : ProtoTile) (hcells : T.cells = (DiamondTile k).cells \ {x}) : + LatticeTile T := by +-- BODY + classical + let reach (A : Set LatticeCell) := Relation.ReflTransGen + (fun x y => FourNeighborAdjacent x y ∧ x ∈ A ∧ y ∈ A) + have single (A : Set LatticeCell) {x y : LatticeCell} + (hx : x ∈ A) (hy : y ∈ A) (hxy : FourNeighborAdjacent x y) : + reach A x y := Relation.ReflTransGen.single ⟨hxy, hx, hy⟩ + obtain ⟨rect, connected⟩ := P5617T1RectangleReachabilityAndBasepointConnectivity + have diamond (z : LatticeCell) : z ∈ (DiamondTile k).cells ↔ + 0 ≤ z.im ∧ z.im < 2 * (k : Int) ∧ + -(z.im + 1) ≤ z.re ∧ z.re < z.im + 1 ∧ + -(2 * (k : Int) - z.im) ≤ z.re ∧ z.re < 2 * (k : Int) - z.im := + (P4194T1DiamondCellRows k z).1 + let A : Set LatticeCell := T.cells + have mem (z : LatticeCell) : z ∈ A ↔ z ∈ (DiamondTile k).cells ∧ z ≠ x := by + simp [A, hcells] + let c : Int := if x.re = 0 then -1 else 0 + let o : LatticeCell := ⟨c, 0⟩ + have ho : o ∈ A := by + rw [mem, diamond] + simp only [o, ne_eq, Zsqrtd.ext_iff] + dsimp [c] + split_ifs <;> omega + have inside : FourNeighborConnected A := by + apply connected A o ho + intro p hp + have hp' := (mem p).mp hp + rw [diamond] at hp' + let m : LatticeCell := ⟨c, p.im⟩ + apply (rect A p m ?_).trans (rect A m o ?_) + all_goals + intro z h1 h2 h3 h4 + rw [mem, diamond] + simp only [ne_eq, Zsqrtd.ext_iff] at hp' ⊢ + dsimp [m, o, c] at h1 h2 h3 h4 ⊢ + split_ifs at * <;> rcases hx with ⟨hx1 | hx1, hx2 | hx2⟩ <;> omega + let e : LatticeCell := ⟨(k : Int) + 1, -1⟩ + have exterior (p : LatticeCell) (hp : p ∉ (DiamondTile k).cells) : + reach Aᶜ p e := by + let a : Int := if p.re < 0 then -(k : Int) - 1 else (k : Int) + 1 + let m : LatticeCell := ⟨a, p.im⟩ + let n : LatticeCell := ⟨a, -1⟩ + apply (rect Aᶜ p m ?_).trans ((rect Aᶜ m n ?_).trans (rect Aᶜ n e ?_)) + all_goals + intro z h1 h2 h3 h4 + change z ∉ A + rw [mem, diamond] + rw [diamond] at hp + dsimp [m, n, e, a] at h1 h2 h3 h4 + split_ifs at * <;> omega + have he : e ∈ Aᶜ := by + change e ∉ A + rw [mem, diamond] + simp [e] + have outside : FourNeighborConnected Aᶜ := by + apply connected Aᶜ e he + intro p hp + by_cases hpD : p ∈ (DiamondTile k).cells + · have hpx : p = x := by + change p ∉ A at hp + rw [mem] at hp + tauto + subst p + let n : LatticeCell := if x.re < 0 then x - 1 else x + 1 + have hnD : n ∉ (DiamondTile k).cells := by + rw [diamond] + dsimp [n] + split_ifs <;> simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, + Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one] <;> + rcases hx with ⟨hx1 | hx1, hx2 | hx2⟩ <;> omega + have hn : n ∈ Aᶜ := by + change n ∉ A + rw [mem] + tauto + exact (single Aᶜ hp hn (by + dsimp [n]; split_ifs <;> simp [FourNeighborAdjacent])).trans (exterior n hnD) + · exact exterior p hpD + have checker : NoCheckerboardCellVertex A := by + intro z + simp only [mem, diamond, ne_eq, Zsqrtd.ext_iff, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_one, Zsqrtd.im_one] + norm_num + rcases hx with ⟨hx1 | hx1, hx2 | hx2⟩ <;> omega + exact FinitePolyominoDiskCriterion T inside outside checker + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5124T1BoundaryGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5124T1BoundaryGeometry.lean new file mode 100644 index 0000000000..c906fff977 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5124T1BoundaryGeometry.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P5124T1BoundaryGeometry] + +/-! +# P5124T1BoundaryGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5124T1BoundaryGeometry (k : Nat) (hk : 0 < k) : + let r := fun b : Int => min (b + 1) (2 * (k : Int) - b) + let H := fun a b : Int => + ((b = 0 ∨ b = 2 * (k : Int)) ∧ -1 ≤ a ∧ a < 1) ∨ + (1 ≤ b ∧ b < (k : Int) ∧ (a = -b - 1 ∨ a = b)) ∨ + ((k : Int) < b ∧ b < 2 * (k : Int) ∧ + (a = b - 2 * (k : Int) - 1 ∨ a = 2 * (k : Int) - b)) + let E : Set (Finset GaussianInt) := {e | ∃ a b : Int, + (H a b ∧ e = {⟨a, b⟩, ⟨a + 1, b⟩}) ∨ + (0 ≤ b ∧ b < 2 * (k : Int) ∧ (a = -r b ∨ a = r b) ∧ + e = {⟨a, b⟩, ⟨a, b + 1⟩})} + BoundaryFootprintEdges (DiamondTile k) = E ∧ + BoundaryFootprintVertices (DiamondTile k) = {z | ∃ e ∈ E, z ∈ e} := by +-- BODY + classical + let r := fun b : Int => min (b + 1) (2 * (k : Int) - b) + let H := fun a b : Int => + ((b = 0 ∨ b = 2 * (k : Int)) ∧ -1 ≤ a ∧ a < 1) ∨ + (1 ≤ b ∧ b < (k : Int) ∧ (a = -b - 1 ∨ a = b)) ∨ + ((k : Int) < b ∧ b < 2 * (k : Int) ∧ + (a = b - 2 * (k : Int) - 1 ∨ a = 2 * (k : Int) - b)) + let E : Set (Finset GaussianInt) := {e | ∃ a b : Int, + (H a b ∧ e = {⟨a, b⟩, ⟨a + 1, b⟩}) ∨ + (0 ≤ b ∧ b < 2 * (k : Int) ∧ (a = -r b ∨ a = r b) ∧ + e = {⟨a, b⟩, ⟨a, b + 1⟩})} + change BoundaryFootprintEdges (DiamondTile k) = E ∧ + BoundaryFootprintVertices (DiamondTile k) = {z | ∃ e ∈ E, z ∈ e} + have horizontal (z : GaussianInt) : + ((z ∈ (DiamondTile k).cells ∧ z - ⟨0, 1⟩ ∉ (DiamondTile k).cells) ∨ + (z ∉ (DiamondTile k).cells ∧ z - ⟨0, 1⟩ ∈ (DiamondTile k).cells)) ↔ + H z.re z.im := by + simp only [DiamondTile, (P4194T1DiamondCellRows _ _).1, + Zsqrtd.re_sub, Zsqrtd.im_sub] + dsimp [H] + omega + have vertical (z : GaussianInt) : + ((z ∈ (DiamondTile k).cells ∧ z - 1 ∉ (DiamondTile k).cells) ∨ + (z ∉ (DiamondTile k).cells ∧ z - 1 ∈ (DiamondTile k).cells)) ↔ + 0 ≤ z.im ∧ z.im < 2 * (k : Int) ∧ + (z.re = -r z.im ∨ z.re = r z.im) := by + simp only [DiamondTile, (P4194T1DiamondCellRows _ _).1, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + dsimp [r] + omega + have he : BoundaryFootprintEdges (DiamondTile k) = E := by + have eta (z : GaussianInt) : (⟨z.re, z.im⟩ : GaussianInt) = z := by + cases z + rfl + have h1 (z : GaussianInt) : z + 1 = ⟨z.re + 1, z.im⟩ := by + ext <;> simp + have hi (z : GaussianInt) : z + ⟨0, 1⟩ = ⟨z.re, z.im + 1⟩ := by + ext <;> simp + ext e + constructor + · rintro ⟨z, ⟨he, hz⟩ | ⟨he, hz⟩⟩ + · exact ⟨z.re, z.im, Or.inl ⟨(horizontal z).mp hz, + by simpa only [h1, hi, eta] using he⟩⟩ + · obtain ⟨hb0, hb, ha⟩ := (vertical z).mp hz + exact ⟨z.re, z.im, Or.inr ⟨hb0, hb, ha, + by simpa only [h1, hi, eta] using he⟩⟩ + · rintro ⟨a, b, ⟨hz, he⟩ | ⟨hb0, hb, ha, he⟩⟩ + · exact ⟨⟨a, b⟩, Or.inl ⟨by simpa only [h1, hi] using he, + (horizontal ⟨a, b⟩).mpr hz⟩⟩ + · exact ⟨⟨a, b⟩, Or.inr ⟨by simpa only [h1, hi] using he, + (vertical ⟨a, b⟩).mpr ⟨hb0, hb, ha⟩⟩⟩ + have hne : (DiamondTile k).cells.Nonempty := by + refine ⟨0, (P4194T1DiamondCellRows k 0).1.mpr ?_⟩ + norm_num + omega + exact ⟨he, by simp only [BoundaryFootprintVertices, ite_eq_left hne, he]⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5124T1EmptyParents.lean b/LeanPool/ApollonianSuperharmonic/P5124T1EmptyParents.lean new file mode 100644 index 0000000000..b88571d7fc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5124T1EmptyParents.lean @@ -0,0 +1,932 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5124T1ParentModel +public import LeanPool.ApollonianSuperharmonic.P5124T1BoundaryGeometry +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: P5124T1EmptyParents] + +/-! +# P5124T1EmptyParents + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace EmptyParentGeometry + +private theorem hDe : + let D := DiamondTile 1 + let sqE : Set (Finset GaussianInt) := {e | + e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩} ∨ + e = {⟨-1, 2⟩, ⟨0, 2⟩} ∨ e = {⟨0, 2⟩, ⟨1, 2⟩} ∨ + e = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ e = {⟨1, 0⟩, ⟨1, 1⟩} ∨ + e = {⟨-1, 1⟩, ⟨-1, 2⟩} ∨ e = {⟨1, 1⟩, ⟨1, 2⟩}} + let r : Int → Int := fun b => min (b + 1) (2 * (1 : Int) - b) + let H : Int → Int → Prop := fun a b => + ((b = 0 ∨ b = 2 * (1 : Int)) ∧ -1 ≤ a ∧ a < 1) ∨ + (1 ≤ b ∧ b < 1 ∧ (a = -b - 1 ∨ a = b)) ∨ + ((1 : Int) < b ∧ b < 2 * (1 : Int) ∧ + (a = b - 2 * (1 : Int) - 1 ∨ a = 2 * (1 : Int) - b)) + let E : Set (Finset GaussianInt) := {e | ∃ a b : Int, + (H a b ∧ e = {⟨a, b⟩, ⟨a + 1, b⟩}) ∨ + (0 ≤ b ∧ b < 2 * (1 : Int) ∧ (a = -r b ∨ a = r b) ∧ + e = {⟨a, b⟩, ⟨a, b + 1⟩})} + (BoundaryFootprintEdges D = E ∧ BoundaryFootprintVertices D = {z : GaussianInt | ∃ e ∈ E, z ∈ + e}) → BoundaryFootprintEdges D = sqE := by + classical + intro D sqE r H E hgeom + change BoundaryFootprintEdges (DiamondTile 1) = sqE + rw [hgeom.1] + ext e + constructor + · rintro ⟨a, b, h⟩ + rcases h with ⟨hh, rfl⟩ | ⟨hb0, hb2, ha, rfl⟩ + · rcases hh with ⟨hrow, hlo, hhi⟩ | ⟨hb1, hb2, ha⟩ | ⟨hb1, hb2, ha⟩ + · rcases hrow with hrow | hrow + · subst b + have : a = -1 ∨ a = 0 := by omega + rcases this with rfl | rfl <;> simp [sqE] + · subst b + have : a = -1 ∨ a = 0 := by omega + rcases this with rfl | rfl <;> simp [sqE] + · omega + · omega + · have hb : b = 0 ∨ b = 1 := by omega + rcases hb with rfl | rfl <;> + rcases ha with ha | ha <;> subst a <;> simp [sqE, r] + · intro he + rcases he with h | h | h | h | h | h | h | h <;> subst e + · exact ⟨-1, 0, Or.inl ⟨by norm_num [H], by norm_num⟩⟩ + · exact ⟨0, 0, Or.inl ⟨by norm_num [H], by norm_num⟩⟩ + · exact ⟨-1, 2, Or.inl ⟨by norm_num [H], by norm_num⟩⟩ + · exact ⟨0, 2, Or.inl ⟨by norm_num [H], by norm_num⟩⟩ + · exact ⟨-1, 0, Or.inr ⟨by norm_num, by norm_num, Or.inl (by norm_num [r]), by norm_num⟩⟩ + · exact ⟨1, 0, Or.inr ⟨by norm_num, by norm_num, Or.inr (by norm_num [r]), by norm_num⟩⟩ + · exact ⟨-1, 1, Or.inr ⟨by norm_num, by norm_num, Or.inl (by norm_num [r]), by norm_num⟩⟩ + · exact ⟨1, 1, Or.inr ⟨by norm_num, by norm_num, Or.inr (by norm_num [r]), by norm_num⟩⟩ + +private theorem hDv : + let D := DiamondTile 1 + let sqE : Set (Finset GaussianInt) := {e | + e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩} ∨ + e = {⟨-1, 2⟩, ⟨0, 2⟩} ∨ e = {⟨0, 2⟩, ⟨1, 2⟩} ∨ + e = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ e = {⟨1, 0⟩, ⟨1, 1⟩} ∨ + e = {⟨-1, 1⟩, ⟨-1, 2⟩} ∨ e = {⟨1, 1⟩, ⟨1, 2⟩}} + let sqV : Set GaussianInt := {⟨-1, 0⟩, ⟨0, 0⟩, ⟨1, 0⟩, + ⟨-1, 1⟩, ⟨1, 1⟩, ⟨-1, 2⟩, ⟨0, 2⟩, ⟨1, 2⟩} + let r : Int → Int := fun b => min (b + 1) (2 * (1 : Int) - b) + let H : Int → Int → Prop := fun a b => + ((b = 0 ∨ b = 2 * (1 : Int)) ∧ -1 ≤ a ∧ a < 1) ∨ + (1 ≤ b ∧ b < 1 ∧ (a = -b - 1 ∨ a = b)) ∨ + ((1 : Int) < b ∧ b < 2 * (1 : Int) ∧ + (a = b - 2 * (1 : Int) - 1 ∨ a = 2 * (1 : Int) - b)) + let E : Set (Finset GaussianInt) := {e | ∃ a b : Int, + (H a b ∧ e = {⟨a, b⟩, ⟨a + 1, b⟩}) ∨ + (0 ≤ b ∧ b < 2 * (1 : Int) ∧ (a = -r b ∨ a = r b) ∧ + e = {⟨a, b⟩, ⟨a, b + 1⟩})} + (BoundaryFootprintEdges D = E ∧ BoundaryFootprintVertices D = {z : GaussianInt | ∃ e ∈ E, z ∈ + e}) → (BoundaryFootprintEdges D = sqE) → BoundaryFootprintVertices D = sqV := by + classical + intro D sqE sqV r H E hgeom hDe + have hE : E = sqE := hgeom.1.symm.trans hDe + rw [hgeom.2, hE] + ext z + simp only [Set.mem_ofPred_eq, sqE, sqV] + constructor + · rintro ⟨e, (h | h | h | h | h | h | h | h), hz⟩ <;> subst e + all_goals + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with hz | hz <;> subst z <;> simp [] + · intro hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with hz | hz | hz | hz | hz | hz | hz | hz + · subst z; exact ⟨{⟨-1, 0⟩, ⟨0, 0⟩}, by simp [], by simp⟩ + · subst z; exact ⟨{⟨0, 0⟩, ⟨1, 0⟩}, by simp [], by simp⟩ + · subst z; exact ⟨{⟨1, 0⟩, ⟨1, 1⟩}, by simp [], by simp⟩ + · subst z; exact ⟨{⟨-1, 0⟩, ⟨-1, 1⟩}, by simp [], by simp⟩ + · subst z; exact ⟨{⟨1, 0⟩, ⟨1, 1⟩}, by simp [], by simp⟩ + · subst z; exact ⟨{⟨-1, 1⟩, ⟨-1, 2⟩}, by simp [], by simp⟩ + · subst z; exact ⟨{⟨-1, 2⟩, ⟨0, 2⟩}, by simp [], by simp⟩ + · subst z; exact ⟨{⟨0, 2⟩, ⟨1, 2⟩}, by simp [], by simp⟩ + +private theorem hBv : + let D := DiamondTile 1 + let B := TileTranslation D ⟨0, -2⟩ + let sqV : Set GaussianInt := {⟨-1, 0⟩, ⟨0, 0⟩, ⟨1, 0⟩, + ⟨-1, 1⟩, ⟨1, 1⟩, ⟨-1, 2⟩, ⟨0, 2⟩, ⟨1, 2⟩} + (BoundaryFootprintVertices D = sqV) → + let lowV : Set GaussianInt := {⟨-1, -2⟩, ⟨0, -2⟩, ⟨1, -2⟩, + ⟨-1, -1⟩, ⟨1, -1⟩, ⟨-1, 0⟩, ⟨0, 0⟩, ⟨1, 0⟩} + (BoundaryFootprintVertices (TileTranslation D ⟨(0 : ℤ), (-2 : ℤ)⟩) = + GaussianTranslation ⟨(0 : ℤ), (-2 : ℤ)⟩ '' BoundaryFootprintVertices D) → + BoundaryFootprintVertices B = lowV := by + classical + intro D B sqV hDv lowV hBV + rw [hBV, hDv] + ext z + simp only [Set.mem_image] + constructor + · rintro ⟨x, hx, rfl⟩ + simp only [sqV, Set.mem_insert_iff, Set.mem_singleton_iff] at hx + rcases hx with hx | hx | hx | hx | hx | hx | hx | hx <;> + subst x <;> simp [GaussianTranslation, lowV, Zsqrtd.ext_iff] + · intro hz + simp only [lowV, Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with hz | hz | hz | hz | hz | hz | hz | hz <;> subst z + · exact ⟨⟨-1, 0⟩, by simp [sqV], by simp [GaussianTranslation]⟩ + · exact ⟨⟨0, 0⟩, by simp [sqV], by simp [GaussianTranslation]⟩ + · exact ⟨⟨1, 0⟩, by simp [sqV], by simp [GaussianTranslation]⟩ + · exact ⟨⟨-1, 1⟩, by simp [sqV], by simp [GaussianTranslation]⟩ + · exact ⟨⟨1, 1⟩, by simp [sqV], by simp [GaussianTranslation]⟩ + · exact ⟨⟨-1, 2⟩, by simp [sqV], by simp [GaussianTranslation]⟩ + · exact ⟨⟨0, 2⟩, by simp [sqV], by simp [GaussianTranslation]⟩ + · exact ⟨⟨1, 2⟩, by simp [sqV], by simp [GaussianTranslation]⟩ + +private theorem pairEq : + ∀ {α : Type}, ∀ [DecidableEq α], ∀ (a : α), ∀ (b : α), ∀ (c : α), ∀ (d : α), ({a, b} : Finset + α) = {c, d} ↔ + (a = c ∧ b = d) ∨ (a = d ∧ b = c) := by + classical + intro α typeDecidability a b c d + constructor + · intro h + have hs : ({a, b} : Set α) = {c, d} := by + simpa only [Finset.coe_insert, Finset.coe_singleton] using + congrArg (fun s : Finset α => (s : Set α)) h + exact Set.pair_eq_pair_iff.mp hs + · rintro (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩) + · rfl + · exact Finset.pair_comm _ _ + +private theorem hDBe : + let D := DiamondTile 1 + let B := TileTranslation D ⟨0, -2⟩ + let sqE : Set (Finset GaussianInt) := {e | + e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩} ∨ + e = {⟨-1, 2⟩, ⟨0, 2⟩} ∨ e = {⟨0, 2⟩, ⟨1, 2⟩} ∨ + e = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ e = {⟨1, 0⟩, ⟨1, 1⟩} ∨ + e = {⟨-1, 1⟩, ⟨-1, 2⟩} ∨ e = {⟨1, 1⟩, ⟨1, 2⟩}} + (BoundaryFootprintEdges D = sqE) → + let lowE : Set (Finset GaussianInt) := {e | + e = {⟨-1, -2⟩, ⟨0, -2⟩} ∨ e = {⟨0, -2⟩, ⟨1, -2⟩} ∨ + e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩} ∨ + e = {⟨-1, -2⟩, ⟨-1, -1⟩} ∨ e = {⟨1, -2⟩, ⟨1, -1⟩} ∨ + e = {⟨-1, -1⟩, ⟨-1, 0⟩} ∨ e = {⟨1, -1⟩, ⟨1, 0⟩}} + (BoundaryFootprintEdges B = lowE) → + let capE : Set (Finset GaussianInt) := {e | + e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩}} + (∀ {α : Type}, ∀ [DecidableEq α], ∀ (a : α), ∀ (b : α), ∀ (c : α), ∀ (d : α), ({a, b} : + Finset α) = {c, d} ↔ (a = c ∧ b = d) ∨ (a = d ∧ b = c)) → BoundaryFootprintEdges D ∩ + BoundaryFootprintEdges B = capE := by + classical + intro D B sqE hDe lowE hBe capE pairEq + rw [hDe, hBe] + ext e + change (e ∈ sqE ∧ e ∈ lowE) ↔ e ∈ capE + constructor + · rintro ⟨hd, hb⟩ + change e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩} ∨ + e = {⟨-1, 2⟩, ⟨0, 2⟩} ∨ e = {⟨0, 2⟩, ⟨1, 2⟩} ∨ + e = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ e = {⟨1, 0⟩, ⟨1, 1⟩} ∨ + e = {⟨-1, 1⟩, ⟨-1, 2⟩} ∨ e = {⟨1, 1⟩, ⟨1, 2⟩} at hd + change e = {⟨-1, -2⟩, ⟨0, -2⟩} ∨ e = {⟨0, -2⟩, ⟨1, -2⟩} ∨ + e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩} ∨ + e = {⟨-1, -2⟩, ⟨-1, -1⟩} ∨ e = {⟨1, -2⟩, ⟨1, -1⟩} ∨ + e = {⟨-1, -1⟩, ⟨-1, 0⟩} ∨ e = {⟨1, -1⟩, ⟨1, 0⟩} at hb + change e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩} + rcases hb with hb | hb | hb | hb | hb | hb | hb | hb + all_goals + rw [hb] at hd ⊢ + first + | exact Or.inl rfl + | exact Or.inr rfl + | exfalso + rcases hd with hd | hd | hd | hd | hd | hd | hd | hd + all_goals + have hp := (pairEq _ _ _ _).mp hd + rcases hp with ⟨h1, h2⟩ | ⟨h1, h2⟩ + all_goals + simp only [Zsqrtd.ext_iff] at h1 h2 + omega + · intro he + change e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩} at he + rcases he with he | he + · subst e + constructor <;> decide +kernel + · subst e + constructor <;> decide +kernel + +private theorem hUe : + let U := P5124T1ParentModel 1 1 true + (U.cells = {⟨-2, 0⟩}) → + let unitE : Set (Finset GaussianInt) := {e | + e = {⟨-2, 0⟩, ⟨-1, 0⟩} ∨ e = {⟨-2, 0⟩, ⟨-2, 1⟩} ∨ + e = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ e = {⟨-2, 1⟩, ⟨-1, 1⟩}} + BoundaryFootprintEdges U = unitE := by + classical + intro U hUc unitE + ext e + constructor + · intro he + change ∃ z : GaussianInt, _ at he + rcases he with ⟨z, he⟩ + cases z with + | mk x y => + simp? [hUc, Zsqrtd.ext_iff, + sub_eq_add_neg, add_comm] at he + rcases he with ⟨he, hc⟩ | ⟨he, hc⟩ + all_goals + rcases hc with hc | hc + all_goals + have hx : x = -2 ∨ x = -1 := by omega + have hy : y = 0 ∨ y = 1 := by omega + rcases hx with hx | hx <;> rcases hy with hy | hy <;> + subst x <;> subst y <;> subst e <;> first | omega | decide +kernel + · intro he + simp only [unitE, Set.mem_ofPred_eq] at he + rcases he with he | he | he | he <;> subst e + · exact ⟨⟨-2, 0⟩, by decide +kernel⟩ + · exact ⟨⟨-2, 0⟩, by decide +kernel⟩ + · exact ⟨⟨-1, 0⟩, by decide +kernel⟩ + · exact ⟨⟨-2, 1⟩, by decide +kernel⟩ + +private theorem hUv : + let U := P5124T1ParentModel 1 1 true + let unitE : Set (Finset GaussianInt) := {e | + e = {⟨-2, 0⟩, ⟨-1, 0⟩} ∨ e = {⟨-2, 0⟩, ⟨-2, 1⟩} ∨ + e = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ e = {⟨-2, 1⟩, ⟨-1, 1⟩}} + let unitV : Set GaussianInt := {⟨-2, 0⟩, ⟨-1, 0⟩, ⟨-2, 1⟩, ⟨-1, 1⟩} + (BoundaryFootprintEdges U = unitE) → (U.cells.Nonempty) → BoundaryFootprintVertices U = unitV + := by + classical + intro U unitE unitV hUe hUne + rw [BoundaryFootprintVertices, ite_eq_left hUne, hUe] + ext z + change (∃ e, e ∈ unitE ∧ z ∈ e) ↔ z ∈ unitV + constructor + · rintro ⟨e, he, hz⟩ + simp only [unitE, Set.mem_ofPred_eq] at he + rcases he with he | he | he | he + all_goals + subst e + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with hz | hz <;> subst z <;> simp [unitV] + · intro hz + simp only [unitV, Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with hz | hz | hz | hz <;> subst z + · exact ⟨{⟨-2, 0⟩, ⟨-1, 0⟩}, Or.inl rfl, by simp⟩ + · exact ⟨{⟨-2, 0⟩, ⟨-1, 0⟩}, Or.inl rfl, by simp⟩ + · exact ⟨{⟨-2, 1⟩, ⟨-1, 1⟩}, Or.inr (Or.inr (Or.inr rfl)), by simp⟩ + · exact ⟨{⟨-1, 0⟩, ⟨-1, 1⟩}, Or.inr (Or.inr (Or.inl rfl)), by simp⟩ + +private theorem hWe : + let U := P5124T1ParentModel 1 1 true + let W := P5124T1ParentModel 1 0 false + let unitE : Set (Finset GaussianInt) := {e | + e = {⟨-2, 0⟩, ⟨-1, 0⟩} ∨ e = {⟨-2, 0⟩, ⟨-2, 1⟩} ∨ + e = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ e = {⟨-2, 1⟩, ⟨-1, 1⟩}} + (BoundaryFootprintEdges U = unitE) → (W = TileTranslation U ⟨3, 0⟩) → (BoundaryFootprintEdges + (TileTranslation U ⟨(3 : ℤ), (0 : ℤ)⟩) = (fun (e : Finset GaussianInt) => + Finset.image (GaussianTranslation ⟨(3 : ℤ), (0 : ℤ)⟩) e) '' + BoundaryFootprintEdges U) → + let rightE : Set (Finset GaussianInt) := {e | + e = {⟨1, 0⟩, ⟨2, 0⟩} ∨ e = {⟨1, 0⟩, ⟨1, 1⟩} ∨ + e = {⟨2, 0⟩, ⟨2, 1⟩} ∨ e = {⟨1, 1⟩, ⟨2, 1⟩}} + (GaussianTranslation ⟨3, 0⟩ ⟨-2, 0⟩ = ⟨1, 0⟩) → (GaussianTranslation ⟨3, 0⟩ ⟨-1, 0⟩ = ⟨2, 0⟩) + → (GaussianTranslation ⟨3, 0⟩ ⟨-2, 1⟩ = ⟨1, 1⟩) → (GaussianTranslation ⟨3, 0⟩ ⟨-1, 1⟩ = + ⟨2, 1⟩) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : + GaussianInt), (GaussianTranslation ⟨3, 0⟩ a = c) → (GaussianTranslation ⟨3, 0⟩ b = d) → + ({a, b} : Finset GaussianInt).image (GaussianTranslation ⟨3, 0⟩) = {c, d}) → + BoundaryFootprintEdges W = rightE := by + classical + intro U W unitE hUe hWt hWtE rightE gt20 gt10 gt21 gt11 imagePair + rw [hWt, hWtE, hUe] + ext e + change (∃ f, f ∈ unitE ∧ + f.image (GaussianTranslation ⟨3, 0⟩) = e) ↔ e ∈ rightE + constructor + · rintro ⟨f, hf, rfl⟩ + change f = {⟨-2, 0⟩, ⟨-1, 0⟩} ∨ + f = {⟨-2, 0⟩, ⟨-2, 1⟩} ∨ + f = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ + f = {⟨-2, 1⟩, ⟨-1, 1⟩} at hf + rcases hf with hf | hf | hf | hf + · subst f + rw [imagePair _ _ _ _ gt20 gt10] + exact Or.inl rfl + · subst f + rw [imagePair _ _ _ _ gt20 gt21] + exact Or.inr (Or.inl rfl) + · subst f + rw [imagePair _ _ _ _ gt10 gt11] + exact Or.inr (Or.inr (Or.inl rfl)) + · subst f + rw [imagePair _ _ _ _ gt21 gt11] + exact Or.inr (Or.inr (Or.inr rfl)) + · intro he + change e = {⟨1, 0⟩, ⟨2, 0⟩} ∨ e = {⟨1, 0⟩, ⟨1, 1⟩} ∨ + e = {⟨2, 0⟩, ⟨2, 1⟩} ∨ e = {⟨1, 1⟩, ⟨2, 1⟩} at he + rcases he with he | he | he | he + · subst e + refine ⟨({⟨-2, 0⟩, ⟨-1, 0⟩} : Finset GaussianInt), + ?_, imagePair _ _ _ _ gt20 gt10⟩ + change ({⟨-2, 0⟩, ⟨-1, 0⟩} : Finset GaussianInt) = _ ∨ _ ∨ _ ∨ _ + exact Or.inl rfl + · subst e + refine ⟨({⟨-2, 0⟩, ⟨-2, 1⟩} : Finset GaussianInt), + ?_, imagePair _ _ _ _ gt20 gt21⟩ + change _ ∨ ({⟨-2, 0⟩, ⟨-2, 1⟩} : Finset GaussianInt) = _ ∨ _ ∨ _ + exact Or.inr (Or.inl rfl) + · subst e + refine ⟨({⟨-1, 0⟩, ⟨-1, 1⟩} : Finset GaussianInt), + ?_, imagePair _ _ _ _ gt10 gt11⟩ + change _ ∨ _ ∨ ({⟨-1, 0⟩, ⟨-1, 1⟩} : Finset GaussianInt) = _ ∨ _ + exact Or.inr (Or.inr (Or.inl rfl)) + · subst e + refine ⟨({⟨-2, 1⟩, ⟨-1, 1⟩} : Finset GaussianInt), + ?_, imagePair _ _ _ _ gt21 gt11⟩ + change _ ∨ _ ∨ _ ∨ + ({⟨-2, 1⟩, ⟨-1, 1⟩} : Finset GaussianInt) = _ + exact Or.inr (Or.inr (Or.inr rfl)) + +private theorem hWv : + let U := P5124T1ParentModel 1 1 true + let W := P5124T1ParentModel 1 0 false + let unitV : Set GaussianInt := {⟨-2, 0⟩, ⟨-1, 0⟩, ⟨-2, 1⟩, ⟨-1, 1⟩} + (BoundaryFootprintVertices U = unitV) → (W = TileTranslation U ⟨3, 0⟩) → + (BoundaryFootprintVertices (TileTranslation U ⟨(3 : ℤ), (0 : ℤ)⟩) = + GaussianTranslation ⟨(3 : ℤ), (0 : ℤ)⟩ '' BoundaryFootprintVertices U) → + let rightV : Set GaussianInt := {⟨1, 0⟩, ⟨2, 0⟩, ⟨1, 1⟩, ⟨2, 1⟩} + (GaussianTranslation ⟨3, 0⟩ ⟨-2, 0⟩ = ⟨1, 0⟩) → (GaussianTranslation ⟨3, 0⟩ ⟨-1, 0⟩ = ⟨2, 0⟩) + → (GaussianTranslation ⟨3, 0⟩ ⟨-2, 1⟩ = ⟨1, 1⟩) → (GaussianTranslation ⟨3, 0⟩ ⟨-1, 1⟩ = + ⟨2, 1⟩) → BoundaryFootprintVertices W = rightV := by + classical + intro U W unitV hUv hWt hWtV rightV gt20 gt10 gt21 gt11 + rw [hWt, hWtV, hUv] + ext z + simp only [Set.mem_image] + constructor + · rintro ⟨x, hx, rfl⟩ + simp only [unitV, Set.mem_insert_iff, Set.mem_singleton_iff] at hx + rcases hx with hx | hx | hx | hx <;> + subst x <;> decide +kernel + · intro hz + simp only [rightV, Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with hz | hz | hz | hz <;> subst z + · refine ⟨⟨-2, 0⟩, ?_, gt20⟩ + change (⟨-2, 0⟩ : GaussianInt) = ⟨-2, 0⟩ ∨ _ + exact Or.inl rfl + · refine ⟨⟨-1, 0⟩, ?_, gt10⟩ + change _ ∨ (⟨-1, 0⟩ : GaussianInt) = ⟨-1, 0⟩ ∨ _ + exact Or.inr (Or.inl rfl) + · refine ⟨⟨-2, 1⟩, ?_, gt21⟩ + change _ ∨ _ ∨ (⟨-2, 1⟩ : GaussianInt) = ⟨-2, 1⟩ ∨ _ + exact Or.inr (Or.inr (Or.inl rfl)) + · refine ⟨⟨-1, 1⟩, ?_, gt11⟩ + change _ ∨ _ ∨ _ ∨ (⟨-1, 1⟩ : GaussianInt) = ⟨-1, 1⟩ + exact Or.inr (Or.inr (Or.inr rfl)) + +private theorem hDUe : + let D := DiamondTile 1 + let U := P5124T1ParentModel 1 1 true + let sqE : Set (Finset GaussianInt) := {e | + e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩} ∨ + e = {⟨-1, 2⟩, ⟨0, 2⟩} ∨ e = {⟨0, 2⟩, ⟨1, 2⟩} ∨ + e = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ e = {⟨1, 0⟩, ⟨1, 1⟩} ∨ + e = {⟨-1, 1⟩, ⟨-1, 2⟩} ∨ e = {⟨1, 1⟩, ⟨1, 2⟩}} + (BoundaryFootprintEdges D = sqE) → + let unitE : Set (Finset GaussianInt) := {e | + e = {⟨-2, 0⟩, ⟨-1, 0⟩} ∨ e = {⟨-2, 0⟩, ⟨-2, 1⟩} ∨ + e = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ e = {⟨-2, 1⟩, ⟨-1, 1⟩}} + (BoundaryFootprintEdges U = unitE) → + let leftE : Set (Finset GaussianInt) := {e | e = {⟨-1, 0⟩, ⟨-1, 1⟩}} + BoundaryFootprintEdges D ∩ BoundaryFootprintEdges U = leftE := by + classical + intro D U sqE hDe unitE hUe leftE + rw [hDe, hUe] + ext e + change (e ∈ sqE ∧ e ∈ unitE) ↔ e ∈ leftE + constructor + · rintro ⟨hd, hu⟩ + change e = {⟨-2, 0⟩, ⟨-1, 0⟩} ∨ e = {⟨-2, 0⟩, ⟨-2, 1⟩} ∨ + e = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ e = {⟨-2, 1⟩, ⟨-1, 1⟩} at hu + rcases hu with hu | hu | hu | hu + all_goals + first + | rw [hu] + decide +kernel + | have hno : e ∉ sqE := by rw [hu]; decide +kernel + exact False.elim (hno hd) + · intro he + subst e + exact ⟨by decide +kernel, by decide +kernel⟩ + +private theorem hDWe : + let D := DiamondTile 1 + let W := P5124T1ParentModel 1 0 false + let sqE : Set (Finset GaussianInt) := {e | + e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩} ∨ + e = {⟨-1, 2⟩, ⟨0, 2⟩} ∨ e = {⟨0, 2⟩, ⟨1, 2⟩} ∨ + e = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ e = {⟨1, 0⟩, ⟨1, 1⟩} ∨ + e = {⟨-1, 1⟩, ⟨-1, 2⟩} ∨ e = {⟨1, 1⟩, ⟨1, 2⟩}} + (BoundaryFootprintEdges D = sqE) → + let rightE : Set (Finset GaussianInt) := {e | + e = {⟨1, 0⟩, ⟨2, 0⟩} ∨ e = {⟨1, 0⟩, ⟨1, 1⟩} ∨ + e = {⟨2, 0⟩, ⟨2, 1⟩} ∨ e = {⟨1, 1⟩, ⟨2, 1⟩}} + (BoundaryFootprintEdges W = rightE) → + let rightTouchE : Set (Finset GaussianInt) := {e | e = {⟨1, 0⟩, ⟨1, 1⟩}} + BoundaryFootprintEdges D ∩ BoundaryFootprintEdges W = rightTouchE := by + classical + intro D W sqE hDe rightE hWe rightTouchE + rw [hDe, hWe] + ext e + change (e ∈ sqE ∧ e ∈ rightE) ↔ e ∈ rightTouchE + constructor + · rintro ⟨hd, hw⟩ + change e = {⟨1, 0⟩, ⟨2, 0⟩} ∨ e = {⟨1, 0⟩, ⟨1, 1⟩} ∨ + e = {⟨2, 0⟩, ⟨2, 1⟩} ∨ e = {⟨1, 1⟩, ⟨2, 1⟩} at hw + rcases hw with hw | hw | hw | hw + all_goals + first + | rw [hw] + decide +kernel + | have hno : e ∉ sqE := by rw [hw]; decide +kernel + exact False.elim (hno hd) + · intro he + subst e + exact ⟨by decide +kernel, by decide +kernel⟩ + +private theorem path2Decomp : + ∀ {x : GaussianInt}, ∀ {y : GaussianInt}, ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {l₁ : + List GaussianInt}, ∀ {l₂ : List GaussianInt}, ([x, y] = l₁ ++ a :: b :: l₂) → a = x ∧ b = + y ∧ l₁ = [] ∧ l₂ = [] := by + classical + intro x y a b l₁ l₂ hp + have hlen := congrArg List.length hp + simp only [List.length_append, List.length_cons, List.length_nil] at hlen + have hl : l₁.length + l₂.length = 0 := by omega + cases l₁ with + | nil => + cases l₂ with + | nil => + simp only [List.nil_append, List.cons.injEq] at hp + rcases hp with ⟨hxa, hyb, _⟩ + subst a + subst b + exact ⟨rfl, rfl, rfl, rfl⟩ + | cons z zs => + simp only [List.length_cons] at hl + have hpos : 0 < (z :: zs).length := by simp + omega + | cons z zs => + simp only [List.length_cons] at hl + have hpos : 0 < (z :: zs).length := by simp + omega + +private theorem path3Decomp : + ∀ {x : GaussianInt}, ∀ {y : GaussianInt}, ∀ {z : GaussianInt}, ∀ {a : GaussianInt}, ∀ {b : + GaussianInt}, ∀ {l₁ : List GaussianInt}, ∀ {l₂ : List GaussianInt}, ([x, y, z] = l₁ ++ a + :: b :: l₂) → (a = x ∧ b = y ∧ l₁ = [] ∧ l₂ = [z]) ∨ + (a = y ∧ b = z ∧ l₁ = [x] ∧ l₂ = []) := by + classical + intro x y z a b l₁ l₂ hp + have hlen := congrArg List.length hp + simp only [List.length_append, List.length_cons, List.length_nil] at hlen + have hl : l₁.length + l₂.length = 1 := by omega + cases l₁ with + | nil => + cases l₂ with + | nil => omega + | cons c cs => + have hcs : cs = [] := by + cases cs with + | nil => rfl + | cons d ds => + simp only [List.length_cons] at hl + have hpos : 0 < (d :: ds).length := by simp + omega + subst cs + simp only [List.nil_append, List.cons.injEq] at hp + rcases hp with ⟨hxa, hyb, hzc, _⟩ + subst a + subst b + subst c + exact Or.inl ⟨rfl, rfl, rfl, rfl⟩ + | cons c cs => + have hcs : cs = [] := by + cases cs with + | nil => rfl + | cons d ds => + simp only [List.length_cons] at hl + have hpos : 0 < (d :: ds).length := by simp + omega + subst cs + cases l₂ with + | nil => + simp only [List.cons_append, List.nil_append, List.cons.injEq] at hp + rcases hp with ⟨hxa, hyb, hzc, _⟩ + subst a + subst b + subst c + exact Or.inr ⟨rfl, rfl, rfl, rfl⟩ + | cons d ds => + simp only [List.length_cons] at hl + have hpos : 0 < (d :: ds).length := by simp + omega + +private theorem simplePath2 : + (∀ {x : GaussianInt}, ∀ {y : GaussianInt}, ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {l₁ : + List GaussianInt}, ∀ {l₂ : List GaussianInt}, ([x, y] = l₁ ++ a :: b :: l₂) → a = x ∧ b = + y ∧ l₁ = [] ∧ l₂ = []) → ∀ (x : GaussianInt), ∀ (y : GaussianInt), ([x, y].Nodup) → (y = + x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → SimpleGridPath ({x, y} : Set + GaussianInt) {e : Finset GaussianInt | e = {x, y}} := by + classical + intro path2Decomp x y hnodup hstep + refine ⟨[x, y], hnodup, by simp, by simp, ?_, ?_⟩ + · intro a b l₁ l₂ hp + obtain ⟨rfl, rfl, rfl, rfl⟩ := path2Decomp hp + exact hstep + · intro e + constructor + · intro he + change e = {x, y} at he + subst e + exact ⟨x, y, [], [], by simp, rfl⟩ + · rintro ⟨a, b, l₁, l₂, hp, he⟩ + obtain ⟨rfl, rfl, rfl, rfl⟩ := path2Decomp hp + simpa using he + +private theorem simplePath3 : + (∀ {x : GaussianInt}, ∀ {y : GaussianInt}, ∀ {z : GaussianInt}, ∀ {a : GaussianInt}, ∀ {b : + GaussianInt}, ∀ {l₁ : List GaussianInt}, ∀ {l₂ : List GaussianInt}, ([x, y, z] = l₁ ++ a + :: b :: l₂) → (a = x ∧ b = y ∧ l₁ = [] ∧ l₂ = [z]) ∨ (a = y ∧ b = z ∧ l₁ = [x] ∧ l₂ = + [])) → ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), ([x, y, z].Nodup) → + (y = x + 1) → (z = y + 1) → SimpleGridPath ({x, y, z} : Set GaussianInt) + {e : Finset GaussianInt | e = {x, y} ∨ e = {y, z}} := by + classical + intro path3Decomp x y z hnodup hxy hyz + refine ⟨[x, y, z], hnodup, by simp, by simp, ?_, ?_⟩ + · intro a b l₁ l₂ hp + rcases path3Decomp hp with ⟨rfl, rfl, rfl, rfl⟩ | ⟨rfl, rfl, rfl, rfl⟩ + · exact Or.inl hxy + · exact Or.inl hyz + · intro e + constructor + · intro he + change e = {x, y} ∨ e = {y, z} at he + rcases he with he | he + · subst e; exact ⟨x, y, [], [z], by simp, rfl⟩ + · subst e; exact ⟨y, z, [x], [], by simp, rfl⟩ + · rintro ⟨a, b, l₁, l₂, hp, he⟩ + rcases path3Decomp hp with ⟨rfl, rfl, rfl, rfl⟩ | ⟨rfl, rfl, rfl, rfl⟩ + · exact Or.inl he + · exact Or.inr he + +end EmptyParentGeometry + +namespace EmptyParentContacts + +private theorem lower_contact : + let D := DiamondTile 1 + let B := TileTranslation D ⟨0, -2⟩ + let C := P5124T1ParentModel 1 2 true + (C.cells = ∅) → (C.anchor = ⟨1, 0⟩) → (¬ C.cells.Nonempty) → (BoundaryFootprintVertices + (DiamondTile (1 : ℕ)) = {⟨(-1 : ℤ), (0 : ℤ)⟩, ⟨(0 : ℤ), (0 : + ℤ)⟩, ⟨(1 : ℤ), (0 : ℤ)⟩, ⟨(-1 : ℤ), (1 : ℤ)⟩, ⟨(1 : + ℤ), (1 : ℤ)⟩, ⟨(-1 : ℤ), (2 : ℤ)⟩, ⟨(0 : ℤ), (2 : ℤ)⟩, + ⟨(1 : ℤ), (2 : ℤ)⟩}) → (BoundaryFootprintVertices (TileTranslation + (DiamondTile (1 : ℕ)) ⟨(0 : ℤ), (-2 : ℤ)⟩) = {⟨(-1 : ℤ), (-2 : + ℤ)⟩, ⟨(0 : ℤ), (-2 : ℤ)⟩, ⟨(1 : ℤ), (-2 : ℤ)⟩, ⟨(-1 : + ℤ), (-1 : ℤ)⟩, ⟨(1 : ℤ), (-1 : ℤ)⟩, ⟨(-1 : ℤ), (0 : ℤ)⟩, ⟨(0 : ℤ), (0 : ℤ)⟩, ⟨(1 : ℤ), (0 + : ℤ)⟩}) → + (D.cells.Nonempty) → (B.cells.Nonempty) → (Disjoint D.cells B.cells) → (SimpleGridPath + (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices B) (BoundaryFootprintEdges D ∩ + BoundaryFootprintEdges B)) → TouchingTriple D B C := by + classical + intro D B C hCc hCa hCne hDv hBv hDn hBn hDBdis pDB + let sqV : Set GaussianInt := {⟨-1, 0⟩, ⟨0, 0⟩, ⟨1, 0⟩, + ⟨-1, 1⟩, ⟨1, 1⟩, ⟨-1, 2⟩, ⟨0, 2⟩, ⟨1, 2⟩} + let lowV : Set GaussianInt := {⟨-1, -2⟩, ⟨0, -2⟩, ⟨1, -2⟩, + ⟨-1, -1⟩, ⟨1, -1⟩, ⟨-1, 0⟩, ⟨0, 0⟩, ⟨1, 0⟩} + unfold TouchingTriple + refine ⟨Or.inl ⟨hDn, hBn, hDBdis, pDB⟩, + Or.inr (Or.inr ⟨hCc, ?_⟩), Or.inr (Or.inl ⟨hCc, ?_⟩), ?_⟩ + · rw [hCa, hBv] + change (⟨1, 0⟩ : GaussianInt) ∈ lowV + decide +kernel + · rw [hCa, hDv] + change (⟨1, 0⟩ : GaussianInt) ∈ sqV + decide +kernel + · refine ⟨(⟨1, 0⟩ : GaussianInt), ?_, ?_⟩ + · refine ⟨?_, ?_, ?_⟩ + · rw [hDv] + change (⟨1, 0⟩ : GaussianInt) ∈ sqV + decide +kernel + · rw [hBv] + change (⟨1, 0⟩ : GaussianInt) ∈ lowV + decide +kernel + · change (⟨1, 0⟩ : GaussianInt) ∈ BoundaryFootprintVertices C + unfold BoundaryFootprintVertices + rw [ite_eq_right hCne, hCa] + simp + · intro x hx + have hxC := hx.2.2 + unfold BoundaryFootprintVertices at hxC + rw [ite_eq_right hCne, hCa] at hxC + simpa using hxC + +private theorem left_contact : + let D := DiamondTile 1 + let U := P5124T1ParentModel 1 1 true + let V := P5124T1ParentModel 1 2 false + (V.cells = ∅) → (V.anchor = ⟨-1, 0⟩) → (¬ V.cells.Nonempty) → (BoundaryFootprintVertices + (DiamondTile (1 : ℕ)) = {⟨(-1 : ℤ), (0 : ℤ)⟩, ⟨(0 : ℤ), (0 : + ℤ)⟩, ⟨(1 : ℤ), (0 : ℤ)⟩, ⟨(-1 : ℤ), (1 : ℤ)⟩, ⟨(1 : + ℤ), (1 : ℤ)⟩, ⟨(-1 : ℤ), (2 : ℤ)⟩, ⟨(0 : ℤ), (2 : ℤ)⟩, + ⟨(1 : ℤ), (2 : ℤ)⟩}) → (U.cells.Nonempty) → (BoundaryFootprintVertices + (P5124T1ParentModel (1 : ℕ) (1 : Fin (3 : ℕ)) true) = {⟨(-2 : ℤ), (0 : ℤ)⟩, ⟨(-1 : ℤ), + (0 : ℤ)⟩, ⟨(-2 : ℤ), (1 : ℤ)⟩, ⟨(-1 : + ℤ), (1 : ℤ)⟩}) → (D.cells.Nonempty) → (Disjoint D.cells U.cells) → (SimpleGridPath + (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices U) (BoundaryFootprintEdges D ∩ + BoundaryFootprintEdges U)) → TouchingTriple D U V := by + classical + intro D U V hVc hVa hVne hDv hUne hUv hDn hDUdis pDU + let sqV : Set GaussianInt := {⟨-1, 0⟩, ⟨0, 0⟩, ⟨1, 0⟩, + ⟨-1, 1⟩, ⟨1, 1⟩, ⟨-1, 2⟩, ⟨0, 2⟩, ⟨1, 2⟩} + let unitV : Set GaussianInt := {⟨-2, 0⟩, ⟨-1, 0⟩, ⟨-2, 1⟩, ⟨-1, 1⟩} + unfold TouchingTriple + refine ⟨Or.inl ⟨hDn, hUne, hDUdis, pDU⟩, + Or.inr (Or.inr ⟨hVc, ?_⟩), Or.inr (Or.inl ⟨hVc, ?_⟩), ?_⟩ + · rw [hVa, hUv] + change (⟨-1, 0⟩ : GaussianInt) ∈ unitV + decide +kernel + · rw [hVa, hDv] + change (⟨-1, 0⟩ : GaussianInt) ∈ sqV + decide +kernel + · refine ⟨(⟨-1, 0⟩ : GaussianInt), ?_, ?_⟩ + · refine ⟨?_, ?_, ?_⟩ + · rw [hDv] + change (⟨-1, 0⟩ : GaussianInt) ∈ sqV + decide +kernel + · rw [hUv] + change (⟨-1, 0⟩ : GaussianInt) ∈ unitV + decide +kernel + · change (⟨-1, 0⟩ : GaussianInt) ∈ BoundaryFootprintVertices V + unfold BoundaryFootprintVertices + rw [ite_eq_right hVne, hVa] + simp + · intro x hx + have hxV := hx.2.2 + unfold BoundaryFootprintVertices at hxV + rw [ite_eq_right hVne, hVa] at hxV + simpa using hxV + +private theorem right_contact : + let D := DiamondTile 1 + let C := P5124T1ParentModel 1 2 true + let W := P5124T1ParentModel 1 0 false + (D.cells = {⟨-1, 0⟩, ⟨0, 0⟩, ⟨-1, 1⟩, ⟨0, 1⟩}) → (C.cells = ∅) → (C.anchor = ⟨1, 0⟩) → (¬ + C.cells.Nonempty) → (W.cells = {⟨1, 0⟩}) → (BoundaryFootprintVertices (DiamondTile (1 : + ℕ)) = {⟨(-1 : ℤ), (0 : ℤ)⟩, ⟨(0 : ℤ), (0 : ℤ)⟩, ⟨(1 : + ℤ), (0 : ℤ)⟩, ⟨(-1 : ℤ), (1 : ℤ)⟩, ⟨(1 : ℤ), (1 : ℤ)⟩, + ⟨(-1 : ℤ), (2 : ℤ)⟩, ⟨(0 : ℤ), (2 : ℤ)⟩, ⟨(1 : ℤ), (2 : ℤ)⟩}) → + (BoundaryFootprintVertices (P5124T1ParentModel (1 : ℕ) (0 : Fin (3 : + ℕ)) false) = {⟨(1 : ℤ), (0 : ℤ)⟩, ⟨(2 : ℤ), (0 : ℤ)⟩, ⟨(1 : ℤ), (1 : ℤ)⟩, ⟨(2 : ℤ), (1 : + ℤ)⟩}) → (D.cells.Nonempty) → + (W.cells.Nonempty) → (SimpleGridPath (BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices W) (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges W)) → + TouchingTriple D C W := by + classical + intro D C W hDc hCc hCa hCne hWc hDv hWv hDn hWn pDW + let sqV : Set GaussianInt := {⟨-1, 0⟩, ⟨0, 0⟩, ⟨1, 0⟩, + ⟨-1, 1⟩, ⟨1, 1⟩, ⟨-1, 2⟩, ⟨0, 2⟩, ⟨1, 2⟩} + let rightV : Set GaussianInt := {⟨1, 0⟩, ⟨2, 0⟩, ⟨1, 1⟩, ⟨2, 1⟩} + unfold TouchingTriple + refine ⟨Or.inr (Or.inr ⟨hCc, ?_⟩), + Or.inr (Or.inl ⟨hCc, ?_⟩), + Or.inl ⟨hWn, hDn, ?_, by simpa [Set.inter_comm] using pDW⟩, ?_⟩ + · rw [hCa, hDv] + change (⟨1, 0⟩ : GaussianInt) ∈ sqV + decide +kernel + · rw [hCa, hWv] + change (⟨1, 0⟩ : GaussianInt) ∈ rightV + decide +kernel + · rw [hDc, hWc]; decide +kernel + · refine ⟨(⟨1, 0⟩ : GaussianInt), ?_, ?_⟩ + · refine ⟨?_, ?_, ?_⟩ + · rw [hDv] + change (⟨1, 0⟩ : GaussianInt) ∈ sqV + decide +kernel + · change (⟨1, 0⟩ : GaussianInt) ∈ BoundaryFootprintVertices C + unfold BoundaryFootprintVertices + rw [ite_eq_right hCne, hCa] + simp + · rw [hWv] + change (⟨1, 0⟩ : GaussianInt) ∈ rightV + decide +kernel + · intro x hx + have hxC := hx.2.1 + unfold BoundaryFootprintVertices at hxC + rw [ite_eq_right hCne, hCa] at hxC + simpa using hxC + +end EmptyParentContacts + +theorem P5124T1EmptyParents : + TouchingTriple (DiamondTile 1) + (TileTranslation (DiamondTile 1) ⟨0, -2⟩) + (P5124T1ParentModel 1 2 true) ∧ + TouchingTriple (DiamondTile 1) (P5124T1ParentModel 1 1 true) + (P5124T1ParentModel 1 2 false) ∧ + TouchingTriple (DiamondTile 1) (P5124T1ParentModel 1 2 true) + (P5124T1ParentModel 1 0 false) := by +-- BODY + have finalProof : + TouchingTriple (DiamondTile 1) + (TileTranslation (DiamondTile 1) ⟨0, -2⟩) + (P5124T1ParentModel 1 2 true) ∧ + TouchingTriple (DiamondTile 1) (P5124T1ParentModel 1 1 true) + (P5124T1ParentModel 1 2 false) ∧ + TouchingTriple (DiamondTile 1) (P5124T1ParentModel 1 2 true) + (P5124T1ParentModel 1 0 false) := by + classical + let D := DiamondTile 1 + let B := TileTranslation D ⟨0, -2⟩ + let C := P5124T1ParentModel 1 2 true + let U := P5124T1ParentModel 1 1 true + let V := P5124T1ParentModel 1 2 false + let W := P5124T1ParentModel 1 0 false + have hDc : D.cells = {⟨-1, 0⟩, ⟨0, 0⟩, ⟨-1, 1⟩, ⟨0, 1⟩} := by + dsimp [D, DiamondTile, DiamondCellDomain] + decide +kernel + have hBc : B.cells = {⟨-1, -2⟩, ⟨0, -2⟩, ⟨-1, -1⟩, ⟨0, -1⟩} := by + dsimp [B, D, TileTranslation, DiamondTile, DiamondCellDomain, GaussianTranslation] + decide +kernel + have hCc : C.cells = ∅ := by dsimp [C, P5124T1ParentModel]; decide +kernel + have hCa : C.anchor = ⟨1, 0⟩ := by dsimp [C, P5124T1ParentModel]; decide +kernel + have hCne : ¬ C.cells.Nonempty := by rw [hCc]; simp + have hUc : U.cells = {⟨-2, 0⟩} := by dsimp [U, P5124T1ParentModel] + have hVc : V.cells = ∅ := by dsimp [V, P5124T1ParentModel]; decide +kernel + have hVa : V.anchor = ⟨-1, 0⟩ := by dsimp [V, P5124T1ParentModel]; decide +kernel + have hVne : ¬ V.cells.Nonempty := by rw [hVc]; simp + have hWc : W.cells = {⟨1, 0⟩} := by dsimp [W, P5124T1ParentModel] + let sqE : Set (Finset GaussianInt) := {e | + e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩} ∨ + e = {⟨-1, 2⟩, ⟨0, 2⟩} ∨ e = {⟨0, 2⟩, ⟨1, 2⟩} ∨ + e = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ e = {⟨1, 0⟩, ⟨1, 1⟩} ∨ + e = {⟨-1, 1⟩, ⟨-1, 2⟩} ∨ e = {⟨1, 1⟩, ⟨1, 2⟩}} + let sqV : Set GaussianInt := {⟨-1, 0⟩, ⟨0, 0⟩, ⟨1, 0⟩, + ⟨-1, 1⟩, ⟨1, 1⟩, ⟨-1, 2⟩, ⟨0, 2⟩, ⟨1, 2⟩} + let r : Int → Int := fun b => min (b + 1) (2 * (1 : Int) - b) + let H : Int → Int → Prop := fun a b => + ((b = 0 ∨ b = 2 * (1 : Int)) ∧ -1 ≤ a ∧ a < 1) ∨ + (1 ≤ b ∧ b < 1 ∧ (a = -b - 1 ∨ a = b)) ∨ + ((1 : Int) < b ∧ b < 2 * (1 : Int) ∧ + (a = b - 2 * (1 : Int) - 1 ∨ a = 2 * (1 : Int) - b)) + let E : Set (Finset GaussianInt) := {e | ∃ a b : Int, + (H a b ∧ e = {⟨a, b⟩, ⟨a + 1, b⟩}) ∨ + (0 ≤ b ∧ b < 2 * (1 : Int) ∧ (a = -r b ∨ a = r b) ∧ + e = {⟨a, b⟩, ⟨a, b + 1⟩})} + have hgeom := P5124T1BoundaryGeometry 1 (by decide) + change BoundaryFootprintEdges D = E ∧ + BoundaryFootprintVertices D = {z | ∃ e ∈ E, z ∈ e} at hgeom + have hDe := EmptyParentGeometry.hDe hgeom + have hDv := EmptyParentGeometry.hDv hgeom hDe + let lowE : Set (Finset GaussianInt) := {e | + e = {⟨-1, -2⟩, ⟨0, -2⟩} ∨ e = {⟨0, -2⟩, ⟨1, -2⟩} ∨ + e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩} ∨ + e = {⟨-1, -2⟩, ⟨-1, -1⟩} ∨ e = {⟨1, -2⟩, ⟨1, -1⟩} ∨ + e = {⟨-1, -1⟩, ⟨-1, 0⟩} ∨ e = {⟨1, -1⟩, ⟨1, 0⟩}} + let lowV : Set GaussianInt := {⟨-1, -2⟩, ⟨0, -2⟩, ⟨1, -2⟩, + ⟨-1, -1⟩, ⟨1, -1⟩, ⟨-1, 0⟩, ⟨0, 0⟩, ⟨1, 0⟩} + obtain ⟨_, _, _, _, _, _, _, hBV, hBE⟩ := TileTranslationFormulas D ⟨0, -2⟩ + have hBe : BoundaryFootprintEdges B = lowE := by + change BoundaryFootprintEdges (TileTranslation D ⟨0, -2⟩) = lowE + rw [hBE, hDe] + ext e + simp [lowE, GaussianTranslation, Finset.image_insert, eq_comm] + have hBv := EmptyParentGeometry.hBv hDv hBV + let capV : Set GaussianInt := {⟨-1, 0⟩, ⟨0, 0⟩, ⟨1, 0⟩} + have hDBv : BoundaryFootprintVertices D ∩ BoundaryFootprintVertices B = capV := by + rw [hDv, hBv] + ext z + simp only [Set.mem_inter_iff, capV, Set.mem_insert_iff, + Set.mem_singleton_iff, Zsqrtd.ext_iff] + omega + let capE : Set (Finset GaussianInt) := {e | + e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩}} + have pairEq {α : Type} [DecidableEq α] (a b c d : α) := EmptyParentGeometry.pairEq (α := α) a + b c d + have hDBe := EmptyParentGeometry.hDBe hDe hBe pairEq + let unitE : Set (Finset GaussianInt) := {e | + e = {⟨-2, 0⟩, ⟨-1, 0⟩} ∨ e = {⟨-2, 0⟩, ⟨-2, 1⟩} ∨ + e = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ e = {⟨-2, 1⟩, ⟨-1, 1⟩}} + let unitV : Set GaussianInt := {⟨-2, 0⟩, ⟨-1, 0⟩, ⟨-2, 1⟩, ⟨-1, 1⟩} + have hUe := EmptyParentGeometry.hUe hUc + have hUne : U.cells.Nonempty := by rw [hUc]; simp + have hUv := EmptyParentGeometry.hUv hUe hUne + have hWt : W = TileTranslation U ⟨3, 0⟩ := by + simp only [W, U, P5124T1ParentModel, TileTranslation] + constructor + obtain ⟨_, _, _, _, _, _, _, hWtV, hWtE⟩ := TileTranslationFormulas U ⟨3, 0⟩ + let rightE : Set (Finset GaussianInt) := {e | + e = {⟨1, 0⟩, ⟨2, 0⟩} ∨ e = {⟨1, 0⟩, ⟨1, 1⟩} ∨ + e = {⟨2, 0⟩, ⟨2, 1⟩} ∨ e = {⟨1, 1⟩, ⟨2, 1⟩}} + let rightV : Set GaussianInt := {⟨1, 0⟩, ⟨2, 0⟩, ⟨1, 1⟩, ⟨2, 1⟩} + have gt20 : GaussianTranslation ⟨3, 0⟩ ⟨-2, 0⟩ = ⟨1, 0⟩ := by decide +kernel + have gt10 : GaussianTranslation ⟨3, 0⟩ ⟨-1, 0⟩ = ⟨2, 0⟩ := by decide +kernel + have gt21 : GaussianTranslation ⟨3, 0⟩ ⟨-2, 1⟩ = ⟨1, 1⟩ := by decide +kernel + have gt11 : GaussianTranslation ⟨3, 0⟩ ⟨-1, 1⟩ = ⟨2, 1⟩ := by decide +kernel + have imagePair (a b c d : GaussianInt) + (ha : GaussianTranslation ⟨3, 0⟩ a = c) + (hb : GaussianTranslation ⟨3, 0⟩ b = d) : + ({a, b} : Finset GaussianInt).image + (GaussianTranslation ⟨3, 0⟩) = {c, d} := by + rw [Finset.image_insert, Finset.image_singleton, ha, hb] + have hWe := EmptyParentGeometry.hWe hUe hWt hWtE gt20 + gt10 gt21 gt11 imagePair + have hWv := EmptyParentGeometry.hWv hUv hWt hWtV gt20 + gt10 gt21 gt11 + let leftE : Set (Finset GaussianInt) := {e | e = {⟨-1, 0⟩, ⟨-1, 1⟩}} + let leftV : Set GaussianInt := {⟨-1, 0⟩, ⟨-1, 1⟩} + have hDUe := EmptyParentGeometry.hDUe hDe hUe + have hDUv : BoundaryFootprintVertices D ∩ BoundaryFootprintVertices U = leftV := by + rw [hDv, hUv] + ext z + simp only [Set.mem_inter_iff, leftV, Set.mem_insert_iff, + Set.mem_singleton_iff, Zsqrtd.ext_iff] + omega + let rightTouchE : Set (Finset GaussianInt) := {e | e = {⟨1, 0⟩, ⟨1, 1⟩}} + let rightTouchV : Set GaussianInt := {⟨1, 0⟩, ⟨1, 1⟩} + have hDWe := EmptyParentGeometry.hDWe hDe hWe + have hDWv : BoundaryFootprintVertices D ∩ BoundaryFootprintVertices W = rightTouchV := by + rw [hDv, hWv] + ext z + simp only [Set.mem_inter_iff, rightTouchV, Set.mem_insert_iff, + Set.mem_singleton_iff, Zsqrtd.ext_iff] + omega + have path2Decomp {x y a b : GaussianInt} {l₁ l₂ : List GaussianInt} + (hp : [x, y] = l₁ ++ a :: b :: l₂) := EmptyParentGeometry.path2Decomp (x := x) (y := y) (a + := a) (b := b) (l₁ := l₁) (l₂ := l₂) hp + have path3Decomp {x y z a b : GaussianInt} {l₁ l₂ : List GaussianInt} + (hp : [x, y, z] = l₁ ++ a :: b :: l₂) := EmptyParentGeometry.path3Decomp (x := x) (y := y) + (z := z) (a := a) (b := b) (l₁ := l₁) (l₂ := l₂) hp + have simplePath2 (x y : GaussianInt) (hnodup : [x, y].Nodup) + (hstep : y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) := + EmptyParentGeometry.simplePath2 path2Decomp x y hnodup hstep + have simplePath3 (x y z : GaussianInt) (hnodup : [x, y, z].Nodup) + (hxy : y = x + 1) (hyz : z = y + 1) := EmptyParentGeometry.simplePath3 + path3Decomp x y z hnodup hxy hyz + have hDn : D.cells.Nonempty := by rw [hDc]; simp + have hBn : B.cells.Nonempty := by rw [hBc]; simp + have hWn : W.cells.Nonempty := by rw [hWc]; simp + have hDBdis : Disjoint D.cells B.cells := by rw [hDc, hBc]; decide +kernel + have hDUdis : Disjoint D.cells U.cells := by rw [hDc, hUc]; decide +kernel + have hDWdis : Disjoint D.cells W.cells := by rw [hDc, hWc]; decide +kernel + have pDB : SimpleGridPath + (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices B) + (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges B) := by + rw [hDBv, hDBe] + change SimpleGridPath capV capE + apply simplePath3 ⟨-1, 0⟩ ⟨0, 0⟩ ⟨1, 0⟩ + · decide +kernel + · ext <;> simp + · ext <;> simp + have pDU : SimpleGridPath + (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices U) + (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges U) := by + rw [hDUv, hDUe] + change SimpleGridPath leftV leftE + apply simplePath2 ⟨-1, 0⟩ ⟨-1, 1⟩ + · decide +kernel + · right; right; left; ext <;> simp + have pDW : SimpleGridPath + (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices W) + (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges W) := by + rw [hDWv, hDWe] + change SimpleGridPath rightTouchV rightTouchE + apply simplePath2 ⟨1, 0⟩ ⟨1, 1⟩ + · decide +kernel + · right; right; left; ext <;> simp + have lower_contact : TouchingTriple D B C := EmptyParentContacts.lower_contact hCc hCa hCne + hDv hBv hDn hBn hDBdis pDB + have left_contact : TouchingTriple D U V := EmptyParentContacts.left_contact hVc hVa hVne hDv + hUne hUv hDn hDUdis pDU + have right_contact : TouchingTriple D C W := EmptyParentContacts.right_contact hDc hCc hCa + hCne hWc hDv hWv hDn hWn pDW + exact ⟨lower_contact, left_contact, right_contact⟩ + exact finalProof + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5124T1ParentModel.lean b/LeanPool/ApollonianSuperharmonic/P5124T1ParentModel.lean new file mode 100644 index 0000000000..e3e3d72bd9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5124T1ParentModel.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.TileTranslation + +-- [TABLET NODE: P5124T1ParentModel] + +/-! +# P5124T1ParentModel + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For an integer $k\geq0$, let $D_n$ be the explicit diamond prototile and +let $s_z=\langle\{z\},z\rangle$ be the canonical singleton prototile. +With zero-based parent slots, define +$$ +\begin{array}{c|cc} +i&P_i^+(k)&P_i^-(k)\\ \hline +0&s_{2ki}&s_{k+(k-1)i}\\ +1&s_{-(k+1)+(k-1)i}&s_{-1+2ki}\\ +2&D_{k-1}+k+(1-k)i&D_{k-1}-k+(1-k)i. +\end{array} +$$ +Here the predecessor index is natural truncated subtraction; translation +acts on both cells and anchors. The Boolean argument is true for $+$ and +false for $-$. In particular, at $k=1$ the two models in slot $2$ are +empty with anchors $1$ and $-1$, respectively. +-/ +def P5124T1ParentModel (k : Nat) (i : Fin 3) (s : Bool) : ProtoTile := +-- BODY + if s then + ![⟨{⟨0, 2 * (k : Int)⟩}, ⟨0, 2 * (k : Int)⟩⟩, + ⟨{⟨-(k : Int) - 1, (k : Int) - 1⟩}, + ⟨-(k : Int) - 1, (k : Int) - 1⟩⟩, + TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩] i + else + ![⟨{⟨(k : Int), (k : Int) - 1⟩}, ⟨(k : Int), (k : Int) - 1⟩⟩, + ⟨{⟨-1, 2 * (k : Int)⟩}, ⟨-1, 2 * (k : Int)⟩⟩, + TileTranslation (DiamondTile (k - 1)) ⟨-(k : Int), 1 - (k : Int)⟩] i + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5124T1ParentPlacement.lean b/LeanPool/ApollonianSuperharmonic/P5124T1ParentPlacement.lean new file mode 100644 index 0000000000..52c0db1a38 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5124T1ParentPlacement.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5124T1ParentModel +public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCentroid + +-- [TABLET NODE: P5124T1ParentPlacement] + +/-! +# P5124T1ParentPlacement + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5124T1ParentPlacement (K : DiamondParameter) (i : Fin 3) (s : Bool) : + let q := DiamondRecursiveQuadruple K + let P := P5124T1ParentModel K.1 i s + BandPrototile (q i.succ) P ∧ + TileCentroid P - TileCentroid (DiamondTile K.1) = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + (if s then GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) + else -GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))) := by +-- BODY + classical + have centroid (n : Nat) : TileCentroid (DiamondTile n) = (0, (n : Real)) := by + by_cases hn : 0 < n + · exact P4194T1DiamondCentroid n hn + · have hn0 : n = 0 := by omega + subst n + simp [TileCentroid, DiamondTile, DiamondCellDomain] + have singleton_centroid (x : GaussianInt) : + TileCentroid (⟨{x}, x⟩ : ProtoTile) = + ((x.re : Real) + 1 / 2, (x.im : Real) + 1 / 2) := by + simp [TileCentroid] + obtain ⟨_, hq, hv0, hv1, hv2, _⟩ := DiamondCoordinateConfiguration K + have flip := (VectorRecursionLaws _ hq.1).2.2.2.2 hq + have hunit : (1 : GaussianInt) + 2 * ⟨0, 1⟩ = ⟨1, 2⟩ := by + ext <;> norm_num + constructor + · fin_cases i + · cases s <;> + simpa [P5124T1ParentModel, DiamondRecursiveQuadruple, hunit] using + (BandPrototile.unit (⟨0, 1⟩ : GaussianInt) _ _) + · cases s <;> + simpa [P5124T1ParentModel, DiamondRecursiveQuadruple] using + (BandPrototile.unit (0 : GaussianInt) _ _) + · obtain ⟨_, S, hS, _, _, _, _, _, hprev, _⟩ := + DiamondTileRecursiveIdentification K + have hp := (hS 2 false).1 + rw [hprev] at hp + cases s <;> + exact BandPrototileTranslation _ _ _ hp + · have hk : 1 ≤ K.1 := K.2 + have ht (w : GaussianInt) := + (TileTranslationFormulas (DiamondTile (K.1 - 1)) w).2.2.2.2.1 + rw [(flip i).1] + fin_cases i <;> cases s <;> + simp [P5124T1ParentModel, singleton_centroid, centroid, ht, + hv0, hv1, hv2, GaussianRealPoint, Prod.ext_iff, Nat.cast_sub hk] <;> + ring <;> simp + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5124T1SmallerParents.lean b/LeanPool/ApollonianSuperharmonic/P5124T1SmallerParents.lean new file mode 100644 index 0000000000..2f20e4951f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5124T1SmallerParents.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5124T1ParentModel +public import LeanPool.ApollonianSuperharmonic.P5124T1TranslatedDiamonds +public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase +public import LeanPool.ApollonianSuperharmonic.P5157T1DiamondStaircaseIntersections +public import LeanPool.ApollonianSuperharmonic.P5157T1DiamondSingletonIntersections + +-- [TABLET NODE: P5124T1SmallerParents] + +/-! +# P5124T1SmallerParents + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5124T1SmallerParents (k : Nat) (hk : 1 < k) : + let D := DiamondTile k + TouchingTriple D (TileTranslation D ⟨0, -(2 * (k : Int))⟩) + (P5124T1ParentModel k 2 true) ∧ + TouchingTriple D (P5124T1ParentModel k 1 true) + (P5124T1ParentModel k 2 false) ∧ + TouchingTriple D (P5124T1ParentModel k 2 true) + (P5124T1ParentModel k 0 false) := by +-- BODY + let D := DiamondTile k + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + let Eplus := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let Eminus := TileTranslation (DiamondTile (k - 1)) ⟨-(k : Int), 1 - (k : Int)⟩ + let a : GaussianInt := ⟨-(k : Int) - 1, (k : Int) - 1⟩ + let b : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ + let A : ProtoTile := ⟨{a}, a⟩ + let B : ProtoTile := ⟨{b}, b⟩ + let N := 2 * (k - 1) + change TouchingTriple D L Eplus ∧ TouchingTriple D A Eminus ∧ + TouchingTriple D Eplus B + obtain ⟨⟨dp, vp, ep⟩, ⟨dq, vq, eq⟩, ⟨dr, vr, er⟩⟩ := + P5157T1DiamondStaircaseIntersections k hk + obtain ⟨⟨da, va, ea⟩, ⟨dma, vma, ema⟩, ⟨db, vb, eb⟩, ⟨dpb, vpb, epb⟩⟩ := + P5157T1DiamondSingletonIntersections k hk + have diamondNonempty (n : Nat) (hn : 0 < n) : (DiamondTile n).cells.Nonempty := by + refine ⟨0, (P4194T1DiamondCellRows n 0).1.mpr ?_⟩ + norm_num + omega + have dne := diamondNonempty k (by omega) + have ene := diamondNonempty (k - 1) (by omega) + have lne : L.cells.Nonempty := by + simpa only [L, TileTranslation, Finset.image_nonempty] using dne + have epne : Eplus.cells.Nonempty := by + simpa only [Eplus, TileTranslation, Finset.image_nonempty] using ene + have emne : Eminus.cells.Nonempty := by + simpa only [Eminus, TileTranslation, Finset.image_nonempty] using ene + have ane : A.cells.Nonempty := Finset.singleton_nonempty a + have bne : B.cells.Nonempty := Finset.singleton_nonempty b + have hp := (P5157T1AlternatingStaircase 1 false 1 (Or.inl rfl) N (by dsimp [N]; omega)).2 + have hq := (P5157T1AlternatingStaircase 1 false (-1) (Or.inr rfl) N (by dsimp [N]; omega)).2 + have hr := (P5157T1AlternatingStaircase ⟨-(k : Int), (k : Int) - 1⟩ + true (-1) (Or.inr rfl) N (by dsimp [N]; omega)).2 + have horizontalPath (z : GaussianInt) : + SimpleGridPath {z, z + 1} {{z, z + 1}} := by + have H := (P5157T1AlternatingStaircase z true 1 (Or.inl rfl) 1 (by decide)).2 + simp? [P5157T1StaircasePoint, Nat.le_one_iff_eq_zero_or_eq_one, + or_and_right, exists_or, show (⟨0, 0⟩ : GaussianInt) = 0 from rfl, + show (⟨1, 0⟩ : GaussianInt) = 1 from rfl] at H + convert H using 1; ext v; simp + have verticalPath (z : GaussianInt) : + SimpleGridPath {z, z + ⟨0, 1⟩} {{z, z + ⟨0, 1⟩}} := by + have H := (P5157T1AlternatingStaircase z false 1 (Or.inl rfl) 1 (by decide)).2 + simp? [P5157T1StaircasePoint, Nat.le_one_iff_eq_zero_or_eq_one, + or_and_right, exists_or, show (⟨0, 0⟩ : GaussianInt) = 0 from rfl] at H + convert H using 1; ext v; simp + have tp : TileTouching D Eplus := Or.inl ⟨dne, epne, dp, by rw [vp, ep]; exact hp⟩ + have tq : TileTouching L Eplus := Or.inl ⟨lne, epne, dq, by rw [vq, eq]; exact hq⟩ + have tr : TileTouching D Eminus := Or.inl ⟨dne, emne, dr, by rw [vr, er]; exact hr⟩ + have ta : TileTouching D A := Or.inl ⟨dne, ane, da, by rw [va, ea]; exact verticalPath (a + 1)⟩ + have tma : TileTouching Eminus A := by + refine Or.inl ⟨emne, ane, dma, ?_⟩ + rw [vma, ema] + exact horizontalPath a + have tb : TileTouching D B := Or.inl ⟨dne, bne, db, by rw [vb, eb]; exact verticalPath b⟩ + have tpb : TileTouching Eplus B := by + refine Or.inl ⟨epne, bne, dpb, ?_⟩ + rw [vpb, epb] + exact horizontalPath b + have swapTouch (T U : ProtoTile) (h : TileTouching T U) : TileTouching U T := by + rcases h with ⟨hT, hU, hd, hpath⟩ | h | h + · exact Or.inl ⟨hU, hT, hd.symm, by simpa only [Set.inter_comm] using hpath⟩ + · exact Or.inr (Or.inr h) + · exact Or.inr (Or.inl h) + obtain ⟨_, _, t2⟩ := P5124T1TranslatedDiamonds k (by omega) + refine ⟨⟨t2.1, tq, swapTouch _ _ tp, ?_⟩, + ⟨ta, swapTouch _ _ tma, swapTouch _ _ tr, ?_⟩, + ⟨tp, tpb, swapTouch _ _ tb, ?_⟩⟩ + · have hp0 : (1 : GaussianInt) ∈ BoundaryFootprintVertices D ∩ BoundaryFootprintVertices Eplus + := by + rw [vp] + exact ⟨0, by omega, by simp [P5157T1StaircasePoint, Zsqrtd.ext_iff]⟩ + have hq0 : (1 : GaussianInt) ∈ BoundaryFootprintVertices L ∩ BoundaryFootprintVertices Eplus + := by + rw [vq] + exact ⟨0, by omega, by simp [P5157T1StaircasePoint, Zsqrtd.ext_iff]⟩ + refine ⟨1, ⟨hp0.1, hq0.1, hp0.2⟩, ?_⟩ + intro x hx + have hxp : x ∈ BoundaryFootprintVertices D ∩ BoundaryFootprintVertices Eplus := ⟨hx.1, hx.2.2⟩ + have hxq : x ∈ BoundaryFootprintVertices L ∩ BoundaryFootprintVertices Eplus := hx.2 + rw [vp] at hxp + rw [vq] at hxq + obtain ⟨i, _, hi⟩ := hxp + obtain ⟨j, _, hj⟩ := hxq + have hir := congrArg Zsqrtd.re hi + have hii := congrArg Zsqrtd.im hi + have hji := congrArg Zsqrtd.im hj + simp [P5157T1StaircasePoint] at hir hii hji + apply Zsqrtd.ext <;> simp <;> omega + · have hav : a + 1 ∈ BoundaryFootprintVertices D ∩ BoundaryFootprintVertices A := by + rw [va]; simp [a, Zsqrtd.ext_iff] + have ham : a + 1 ∈ BoundaryFootprintVertices Eminus ∩ BoundaryFootprintVertices A := by + rw [vma]; simp [a] + refine ⟨a + 1, ⟨hav.1, hav.2, ham.1⟩, ?_⟩ + intro x hx + have hva : x ∈ BoundaryFootprintVertices D ∩ BoundaryFootprintVertices A := ⟨hx.1, hx.2.1⟩ + have hvm : x ∈ BoundaryFootprintVertices Eminus ∩ BoundaryFootprintVertices A := ⟨hx.2.2, + hx.2.1⟩ + rw [va] at hva + rw [vma] at hvm + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hva hvm + rcases hva with h | h + · exact h + · rcases hvm with h' | h' <;> simp [Zsqrtd.ext_iff] at h h' ⊢ <;> omega + · have hbv : b ∈ BoundaryFootprintVertices D ∩ BoundaryFootprintVertices B := by + rw [vb]; simp [b, Zsqrtd.ext_iff] + have hbp : b ∈ BoundaryFootprintVertices Eplus ∩ BoundaryFootprintVertices B := by + rw [vpb]; simp [b] + refine ⟨b, ⟨hbv.1, hbp.1, hbv.2⟩, ?_⟩ + intro x hx + have hvb : x ∈ BoundaryFootprintVertices D ∩ BoundaryFootprintVertices B := ⟨hx.1, hx.2.2⟩ + have hvp : x ∈ BoundaryFootprintVertices Eplus ∩ BoundaryFootprintVertices B := hx.2 + rw [vb] at hvb + rw [vpb] at hvp + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hvb hvp + rcases hvb with h | h + · exact h + · rcases hvp with h' | h' <;> simp [Zsqrtd.ext_iff] at h h' ⊢ <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5124T1TranslatedDiamonds.lean b/LeanPool/ApollonianSuperharmonic/P5124T1TranslatedDiamonds.lean new file mode 100644 index 0000000000..4e9515de8a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5124T1TranslatedDiamonds.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5203T1IncreasingInterface +public import LeanPool.ApollonianSuperharmonic.P5203T1DecreasingInterface +public import LeanPool.ApollonianSuperharmonic.P5203T1CapInterface +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: P5124T1TranslatedDiamonds] + +/-! +# P5124T1TranslatedDiamonds + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5124T1TranslatedDiamonds (k : Nat) (hk : 0 < k) : + let D := DiamondTile k + TouchingTriple D + (TileTranslation D ⟨(k : Int) + 1, (k : Int)⟩) + (TileTranslation D ⟨(k : Int) + 1, -(k : Int)⟩) ∧ + TouchingTriple D + (TileTranslation D ⟨-(k : Int) - 1, (k : Int)⟩) + (TileTranslation D ⟨0, 2 * (k : Int)⟩) ∧ + TouchingTriple D + (TileTranslation D ⟨0, -(2 * (k : Int))⟩) + (TileTranslation D ⟨-(k : Int) - 1, -(k : Int)⟩) := by +-- BODY + classical + let a : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + let b : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + let d : GaussianInt := ⟨0, 2 * (k : Int)⟩ + let T := fun u => TileTranslation (DiamondTile k) u + have ba : b + d = a := by ext <;> simp [a, b, d]; ring + have ma : -b + a = d := by ext <;> simp [a, b, d]; ring + have mb : -a + b = -d := by ext <;> simp [a, b, d]; ring + have touching (X Y : ProtoTile) (V : Set GaussianInt) + (E : Set (Finset GaussianInt)) (hX : X.cells.Nonempty) + (hY : Y.cells.Nonempty) (hd : Disjoint X.cells Y.cells) + (hv : BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y = V) + (he : BoundaryFootprintEdges X ∩ BoundaryFootprintEdges Y = E) + (hp : SimpleGridPath V E) : TileTouching X Y ∧ TileTouching Y X := by + have path : SimpleGridPath + (BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y) + (BoundaryFootprintEdges X ∩ BoundaryFootprintEdges Y) := by + rw [hv, he] + exact hp + exact ⟨Or.inl ⟨hX, hY, hd, path⟩, + Or.inl ⟨hY, hX, hd.symm, by simpa only [Set.inter_comm] using path⟩⟩ + have increasing (u : GaussianInt) : + TileTouching (T u) (T (u + b)) ∧ TileTouching (T (u + b)) (T u) := by + obtain ⟨hX, hY, hd, hv, he, hp⟩ := P5203T1IncreasingInterface k hk u + exact touching _ _ _ _ hX hY hd hv he hp + have decreasing (u : GaussianInt) : + TileTouching (T u) (T (u + a)) ∧ TileTouching (T (u + a)) (T u) := by + obtain ⟨hX, hY, hd, hv, he, hp⟩ := P5203T1DecreasingInterface k hk u + exact touching _ _ _ _ hX hY hd hv he hp + have cap (u : GaussianInt) : + TileTouching (T u) (T (u + d)) ∧ TileTouching (T (u + d)) (T u) := by + obtain ⟨hX, hY, hd, hv, he, hp⟩ := P5203T1CapInterface k hk u + exact touching _ _ _ _ hX hY hd hv he hp + have vi (u z : GaussianInt) : + (z ∈ BoundaryFootprintVertices (T u) ∧ + z ∈ BoundaryFootprintVertices (T (u + b))) ↔ + 1 ≤ (z - u).re ∧ (z - u).re ≤ k ∧ + (z - u).re - 1 ≤ (z - u).im ∧ (z - u).im ≤ (z - u).re := by + change z ∈ (BoundaryFootprintVertices (T u) ∩ + BoundaryFootprintVertices (T (u + b))) ↔ _ + rw [(P5203T1IncreasingInterface k hk u).2.2.2.1] + rfl + have vd (u z : GaussianInt) : + (z ∈ BoundaryFootprintVertices (T u) ∧ + z ∈ BoundaryFootprintVertices (T (u + a))) ↔ + 1 ≤ (z - u).re ∧ (z - u).re ≤ k ∧ + 2 * (k : Int) ≤ (z - u).re + (z - u).im ∧ + (z - u).re + (z - u).im ≤ 2 * (k : Int) + 1 := by + change z ∈ (BoundaryFootprintVertices (T u) ∩ + BoundaryFootprintVertices (T (u + a))) ↔ _ + rw [(P5203T1DecreasingInterface k hk u).2.2.2.1] + rfl + have vc (u z : GaussianInt) : + (z ∈ BoundaryFootprintVertices (T u) ∧ + z ∈ BoundaryFootprintVertices (T (u + d))) ↔ + (z - u).im = 2 * (k : Int) ∧ -1 ≤ (z - u).re ∧ (z - u).re ≤ 1 := by + change z ∈ (BoundaryFootprintVertices (T u) ∩ + BoundaryFootprintVertices (T (u + d))) ↔ _ + rw [(P5203T1CapInterface k hk u).2.2.2.1] + rfl + have row0 : TouchingTriple (T 0) (T a) (T b) := by + refine ⟨by simpa only [zero_add] using (decreasing 0).1, + by simpa only [ba] using (cap b).2, + by simpa only [zero_add] using (increasing 0).2, ?_⟩ + refine ⟨⟨(k : Int), (k : Int)⟩, ?_, ?_⟩ + · have hA := (vd 0 ⟨(k : Int), (k : Int)⟩).mpr (by simp; omega) + have hB := (vi 0 ⟨(k : Int), (k : Int)⟩).mpr (by simp; omega) + exact ⟨hA.1, by simpa only [zero_add] using hA.2, + by simpa only [zero_add] using hB.2⟩ + · intro z hz + have hA := (vd 0 z).mp ⟨hz.1, by simpa only [zero_add] using hz.2.1⟩ + have hC := (vc b z).mp ⟨hz.2.2, by simpa only [ba] using hz.2.1⟩ + simp only [sub_zero, Zsqrtd.re_sub, Zsqrtd.im_sub, b] at hA hC + apply Zsqrtd.ext <;> dsimp <;> omega + have row1 : TouchingTriple (T 0) (T (-b)) (T d) := by + refine ⟨by simpa only [neg_add_cancel] using (increasing (-b)).2, + by simpa only [ma] using (decreasing (-b)).1, + by simpa only [zero_add] using (cap 0).2, ?_⟩ + refine ⟨⟨-1, 2 * (k : Int)⟩, ?_, ?_⟩ + · have hA := (vi (-b) ⟨-1, 2 * (k : Int)⟩).mpr (by + simp [b]; omega) + have hC := (vc 0 ⟨-1, 2 * (k : Int)⟩).mpr (by simp) + exact ⟨hC.1, hA.1, by simpa only [zero_add] using hC.2⟩ + · intro z hz + have hA := (vi (-b) z).mp + ⟨hz.2.1, by simpa only [neg_add_cancel] using hz.1⟩ + have hC := (vc 0 z).mp ⟨hz.1, by simpa only [zero_add] using hz.2.2⟩ + simp only [sub_zero, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_neg, + Zsqrtd.im_neg, b] at hA hC + apply Zsqrtd.ext <;> dsimp <;> omega + have row2 : TouchingTriple (T 0) (T (-d)) (T (-a)) := by + refine ⟨by simpa only [neg_add_cancel] using (cap (-d)).2, + by simpa only [mb] using (increasing (-a)).2, + by simpa only [neg_add_cancel] using (decreasing (-a)).1, ?_⟩ + refine ⟨⟨-1, 0⟩, ?_, ?_⟩ + · have hA := (vd (-a) ⟨-1, 0⟩).mpr (by simp [a]; omega) + have hC := (vc (-d) ⟨-1, 0⟩).mpr (by simp [d]) + exact ⟨by simpa only [neg_add_cancel] using hC.2, hC.1, hA.1⟩ + · intro z hz + have hA := (vd (-a) z).mp + ⟨hz.2.2, by simpa only [neg_add_cancel] using hz.1⟩ + have hC := (vc (-d) z).mp + ⟨hz.2.1, by simpa only [neg_add_cancel] using hz.1⟩ + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_neg, + Zsqrtd.im_neg, a, d] at hA hC + apply Zsqrtd.ext <;> dsimp <;> omega + have zero_tile : T 0 = DiamondTile k := by + have hf : GaussianTranslation 0 = id := by + funext z + simp [GaussianTranslation] + dsimp [T, TileTranslation] + rw [hf, Finset.image_id] + rfl + have na : -a = (⟨-(k : Int) - 1, -(k : Int)⟩ : GaussianInt) := by + ext <;> simp [a]; ring + have nb : -b = (⟨-(k : Int) - 1, (k : Int)⟩ : GaussianInt) := by + ext <;> simp [b]; ring + have nd : -d = (⟨0, -(2 * (k : Int))⟩ : GaussianInt) := by + ext <;> simp [d] + simpa only [zero_tile, na, nb, nd, T, a, b, d] using + And.intro row0 (And.intro row1 row2) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5124T1UnitParents.lean b/LeanPool/ApollonianSuperharmonic/P5124T1UnitParents.lean new file mode 100644 index 0000000000..a2314b819a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5124T1UnitParents.lean @@ -0,0 +1,163 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5124T1ParentModel +public import LeanPool.ApollonianSuperharmonic.P5124T1TranslatedDiamonds +public import LeanPool.ApollonianSuperharmonic.P5253T1SingletonBoundary +public import LeanPool.ApollonianSuperharmonic.P5253T1OneEdgeInterface +public import LeanPool.ApollonianSuperharmonic.P5253T1TopSquareContacts +public import LeanPool.ApollonianSuperharmonic.P5253T1LeftSquareContacts +public import LeanPool.ApollonianSuperharmonic.P5253T1BottomSquareContact + +-- [TABLET NODE: P5124T1UnitParents] + +/-! +# P5124T1UnitParents + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5124T1UnitParents (k : Nat) (hk : 0 < k) : + let D := DiamondTile k + TouchingTriple D + (TileTranslation D ⟨(k : Int) + 1, (k : Int)⟩) + (P5124T1ParentModel k 0 true) ∧ + TouchingTriple D + (TileTranslation D ⟨-(k : Int) - 1, (k : Int)⟩) + (P5124T1ParentModel k 1 true) ∧ + TouchingTriple D (P5124T1ParentModel k 0 true) + (P5124T1ParentModel k 1 false) := by +-- BODY + classical + let D := DiamondTile k + let a : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + let b : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + let z : GaussianInt := ⟨0, 2 * (k : Int)⟩ + let l : GaussianInt := ⟨-1, 2 * (k : Int)⟩ + let w : GaussianInt := ⟨-(k : Int) - 1, (k : Int) - 1⟩ + let unit := fun c : GaussianInt => (⟨{c}, c⟩ : ProtoTile) + have zero (T : ProtoTile) : TileTranslation T 0 = T := by + have hg : GaussianTranslation (0 : GaussianInt) = id := by + funext x + exact add_zero x + cases T + simp [TileTranslation, hg] + have top := P5253T1TopSquareContacts k hk 0 0 (Or.inr rfl) + have topLeft := P5253T1TopSquareContacts k hk 0 (-1) (Or.inl rfl) + simp only [zero, zero_add] at top topLeft + have left := P5253T1LeftSquareContacts k hk 0 ((k : Int) - 1) (Or.inl rfl) + simp only [zero, zero_add] at left + have az : a + (⟨-(k : Int) - 1, (k : Int)⟩ : GaussianInt) = z := by + ext <;> simp [a, z]; ring + have right := P5253T1LeftSquareContacts k hk a (k : Int) (Or.inr rfl) + dsimp only at right + rw [az] at right + have bw : b - (⟨0, 1⟩ : GaussianInt) = w := by ext <;> simp [b, w] + have bi : b = w + (⟨0, 1⟩ : GaussianInt) := by ext <;> simp [b, w] + have bottom := P5253T1BottomSquareContact k hk b + dsimp only at bottom + rw [bw] at bottom + have finish (T : ProtoTile) (c x y : GaussianInt) + (h : T.cells.Nonempty ∧ Disjoint T.cells (unit c).cells ∧ + BoundaryFootprintVertices T ∩ BoundaryFootprintVertices (unit c) = {x, y} ∧ + {x, y} ∈ BoundaryFootprintEdges T) + (he : {x, y} ∈ BoundaryFootprintEdges (unit c)) + (ha : y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) : + TileTouching T (unit c) ∧ TileTouching (unit c) T := by + exact (P5253T1OneEdgeInterface T (unit c) x y h.1 + (Finset.singleton_nonempty c) h.2.1 h.2.2.1 h.2.2.2 he ha).2.2 + have unitEdge (c : GaussianInt) (e : Finset GaussianInt) : + e ∈ BoundaryFootprintEdges (unit c) ↔ + e = {c, c + 1} ∨ e = {c, c + ⟨0, 1⟩} ∨ + e = {c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩} ∨ + e = {c + 1, c + 1 + ⟨0, 1⟩} := by + rw [(P5253T1SingletonBoundary c c).2] + rfl + have du := finish D z z (z + 1) top + ((unitEdge z _).mpr (Or.inl rfl)) (Or.inl rfl) + have dl := finish D l l (l + 1) topLeft + ((unitEdge l _).mpr (Or.inl rfl)) (Or.inl rfl) + have dv := finish D w (w + 1) (w + 1 + ⟨0, 1⟩) left + ((unitEdge w _).mpr (Or.inr (Or.inr (Or.inr rfl)))) + (Or.inr (Or.inr (Or.inl rfl))) + have ru := finish (TileTranslation D a) z (z + 1) (z + 1 + ⟨0, 1⟩) right + ((unitEdge z _).mpr (Or.inr (Or.inr (Or.inr rfl)))) + (Or.inr (Or.inr (Or.inl rfl))) + have lv := finish (TileTranslation D b) w b (b + 1) bottom + ((unitEdge w _).mpr (Or.inr (Or.inr (Or.inl (by rw [bi]; congr 1; abel))))) + (Or.inl rfl) + have ulVertices : BoundaryFootprintVertices (unit z) ∩ + BoundaryFootprintVertices (unit l) = {z, z + ⟨0, 1⟩} := by + ext v + rw [(P5253T1SingletonBoundary z z).1, + (P5253T1SingletonBoundary l l).1] + simp only [Set.mem_inter_iff, Set.mem_insert_iff, Set.mem_singleton_iff, + Zsqrtd.ext_iff, z, l, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one] + omega + have ul : TileTouching (unit z) (unit l) := by + have hd : Disjoint (unit z).cells (unit l).cells := by + simp [unit, z, l, Zsqrtd.ext_iff] + have ez := (unitEdge z {z, z + ⟨0, 1⟩}).mpr (Or.inr (Or.inl rfl)) + have el : {z, z + ⟨0, 1⟩} ∈ BoundaryFootprintEdges (unit l) := by + have lz : l + 1 = z := by ext <;> simp [l, z] + exact (unitEdge l _).mpr (Or.inr (Or.inr (Or.inr (by rw [lz])))) + exact (P5253T1OneEdgeInterface (unit z) (unit l) z (z + ⟨0, 1⟩) + (Finset.singleton_nonempty z) (Finset.singleton_nonempty l) + hd ulVertices ez el (Or.inr (Or.inr (Or.inl rfl)))).2.2.1 + have unique (A B C : ProtoTile) (x y t : GaussianInt) + (hAC : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices C = {x, y}) + (hBC : BoundaryFootprintVertices B ∩ BoundaryFootprintVertices C = {t, y}) + (hxy : x ≠ y) (hxt : x ≠ t) : + ∃! v, v ∈ BoundaryFootprintVertices A ∧ v ∈ BoundaryFootprintVertices B ∧ + v ∈ BoundaryFootprintVertices C := by + have hyA : y ∈ BoundaryFootprintVertices A ∩ BoundaryFootprintVertices C := by + rw [hAC]; simp + have hyB : y ∈ BoundaryFootprintVertices B ∩ BoundaryFootprintVertices C := by + rw [hBC]; simp + refine ⟨y, ⟨hyA.1, hyB.1, hyA.2⟩, ?_⟩ + intro v hv + have hA : v ∈ ({x, y} : Set GaussianInt) := by rw [← hAC]; exact ⟨hv.1, hv.2.2⟩ + have hB : v ∈ ({t, y} : Set GaussianInt) := by rw [← hBC]; exact ⟨hv.2.1, hv.2.2⟩ + rcases hA with hA | hA + · rcases hB with hB | hB + · exact False.elim (hxt (hA.symm.trans hB)) + · exact hB + · exact hA + have j0 := unique D (TileTranslation D a) (unit z) z (z + 1) + (z + 1 + ⟨0, 1⟩) top.2.2.1 + (by simpa only [Set.pair_comm] using right.2.2.1) + (by simp []) (by simp [Zsqrtd.ext_iff]) + have j1 := unique D (TileTranslation D b) (unit w) (w + 1) + (w + 1 + ⟨0, 1⟩) (w + ⟨0, 1⟩) left.2.2.1 + (by simpa only [bi, add_assoc, add_comm, add_left_comm] using bottom.2.2.1) + (by simp [Zsqrtd.ext_iff]) (by simp [Zsqrtd.ext_iff]) + have j2 := unique (unit z) (unit l) D (z + 1) z l + (by simpa only [Set.inter_comm, Set.pair_comm] using top.2.2.1) + (by + have lz : l + 1 = z := by ext <;> simp [l, z] + have h : BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (unit l) = + {l, l + 1} := topLeft.2.2.1 + rw [lz] at h + simpa only [Set.inter_comm] using h) + (by simp []) (by simp [z, l, Zsqrtd.ext_iff]) + obtain ⟨t0, t1, _⟩ := P5124T1TranslatedDiamonds k hk + have result : TouchingTriple D (TileTranslation D a) (unit z) ∧ + TouchingTriple D (TileTranslation D b) (unit w) ∧ + TouchingTriple D (unit z) (unit l) := + ⟨⟨t0.1, ru.1, du.2, j0⟩, ⟨t1.1, lv.1, dv.2, j1⟩, + ⟨du.1, ul, dl.2, by simpa only [and_assoc, and_comm, and_left_comm] using j2⟩⟩ + exact result + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5BoundaryConsistency.lean b/LeanPool/ApollonianSuperharmonic/P5130T5BoundaryConsistency.lean new file mode 100644 index 0000000000..19b4f6daa8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5130T5BoundaryConsistency.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5130T5Prescription +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import LeanPool.ApollonianSuperharmonic.P5188T1E1Boundary +public import LeanPool.ApollonianSuperharmonic.P5188T1E2Boundary +public import LeanPool.ApollonianSuperharmonic.P5188T1E3E4Boundary + +-- [TABLET NODE: P5130T5BoundaryConsistency] + +/-! +# P5130T5BoundaryConsistency + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5130T5BoundaryConsistency (P P₁ P₂ : FordFareyParameter) + (hq : 1 < P.q) (hp₁ : P₁.p = P.p₁) (hq₁ : P₁.q = P.q₁) + (hp₂ : P₂.p = P.p₂) (hq₂ : P₂.q = P.q₂) + (g₁ g₂ : IntegerLatticeFunction) + (h₁ : ∀ x ∈ FordDoubledBoundary P₁.q, + g₁ x = IntegerCeilDiv (P₁.p * x.re * x.im) P₁.q (by exact_mod_cast P₁.q_pos.ne')) + (h₂ : ∀ x ∈ FordDoubledBoundary P₂.q, + g₂ x = IntegerCeilDiv (P₂.p * x.re * x.im) P₂.q (by exact_mod_cast P₂.q_pos.ne')) : + ∀ i x, x ∈ FordRecursiveVertexDomains P i → x ∈ FordDoubledBoundary P.q → + P5130T5Prescription P g₁ g₂ i x = + IntegerCeilDiv (P.p * x.re * x.im) P.q (by exact_mod_cast P.q_pos.ne') := by +-- BODY + have hlast := P5188T1E3E4Boundary P P₂ hq hp₂ hq₂ g₂ h₂ + intro i x hdom hbd + fin_cases i + · exact P5188T1E1Boundary P P₁ hq hp₁ hq₁ g₁ h₁ x hdom hbd + · exact P5188T1E2Boundary P P₁ hq hp₁ hq₁ g₁ h₁ x hdom hbd + · exact hlast.1 x hdom hbd + · exact hlast.2 x hdom hbd + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5DomainCover.lean b/LeanPool/ApollonianSuperharmonic/P5130T5DomainCover.lean new file mode 100644 index 0000000000..a99ef0b2e6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5130T5DomainCover.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import Mathlib.Tactic.FinCases + +-- [TABLET NODE: P5130T5DomainCover] + +/-! +# P5130T5DomainCover + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5130T5DomainCover (P : FordFareyParameter) : + (∀ x ∈ FordVertexDomain P.q, ∃ i, x ∈ FordRecursiveVertexDomains P i) ∧ + (∀ i x, x ∈ FordRecursiveVertexDomains P i → x ∈ FordVertexDomain P.q) := by +-- BODY + have hs : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q + constructor + · intro x hx + rcases hx with ⟨ha, hb, hc, hd⟩ + by_cases h₁ : x.re ≤ (P.q₁ : Int) ∧ x.im ≤ (P.q₁ : Int) + · exact ⟨0, by simpa [FordRecursiveVertexDomains] using ⟨ha, h₁.1, hc, h₁.2⟩⟩ + by_cases h₂ : (P.q₂ : Int) ≤ x.re ∧ (P.q₂ : Int) ≤ x.im + · exact ⟨1, by simpa [FordRecursiveVertexDomains] using ⟨h₂.1, hb, h₂.2, hd⟩⟩ + by_cases h₃ : (P.q₁ : Int) ≤ x.re ∧ x.im ≤ (P.q₂ : Int) + · exact ⟨2, by simpa [FordRecursiveVertexDomains] using ⟨h₃.1, hb, hc, h₃.2⟩⟩ + · exact ⟨3, by simp [FordRecursiveVertexDomains]; omega⟩ + · intro i x hx + fin_cases i <;> simp [FordRecursiveVertexDomains] at hx <;> + simp only [FordVertexDomain, Set.mem_ofPred_eq] <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5MixedOverlaps.lean b/LeanPool/ApollonianSuperharmonic/P5130T5MixedOverlaps.lean new file mode 100644 index 0000000000..e534fd5bba --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5130T5MixedOverlaps.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5130T5Prescription +public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P5130T5MixedOverlaps] + +/-! +# P5130T5MixedOverlaps + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5130T5MixedOverlaps (P P₁ P₂ : FordFareyParameter) + (hq : 1 < P.q) (hp₁ : P₁.p = P.p₁) (hq₁ : P₁.q = P.q₁) + (hp₂ : P₂.p = P.p₂) (hq₂ : P₂.q = P.q₂) + (g₁ g₂ : IntegerLatticeFunction) + (h₁ : ∀ x ∈ FordDoubledBoundary P₁.q, + g₁ x = IntegerCeilDiv (P₁.p * x.re * x.im) P₁.q (by exact_mod_cast P₁.q_pos.ne')) + (h₂ : ∀ x ∈ FordDoubledBoundary P₂.q, + g₂ x = IntegerCeilDiv (P₂.p * x.re * x.im) P₂.q (by exact_mod_cast P₂.q_pos.ne')) : + let F := P5130T5Prescription P g₁ g₂ + (∀ x, x ∈ FordRecursiveVertexDomains P 0 → x ∈ FordRecursiveVertexDomains P 2 → F 0 x = F 2 x) ∧ + (∀ x, x ∈ FordRecursiveVertexDomains P 0 → x ∈ FordRecursiveVertexDomains P 3 → F 0 x = F 3 x) ∧ + (∀ x, x ∈ FordRecursiveVertexDomains P 1 → x ∈ FordRecursiveVertexDomains P 2 → F 1 x = F 2 x) ∧ + (∀ x, x ∈ FordRecursiveVertexDomains P 1 → x ∈ FordRecursiveVertexDomains P 3 → F 1 x = F 3 + x) := by +-- BODY + have edges (R : FordFareyParameter) (g : IntegerLatticeFunction) + (h : ∀ x ∈ FordDoubledBoundary R.q, + g x = IntegerCeilDiv (R.p * x.re * x.im) R.q (by exact_mod_cast R.q_pos.ne')) + (t : Int) (ht : 0 ≤ t) (htq : t ≤ (R.q : Int)) : + g ⟨R.q, t⟩ = R.p * t ∧ g ⟨t, R.q⟩ = R.p * t ∧ + g ⟨0, t⟩ = 0 ∧ g ⟨t, 0⟩ = 0 := by + have hq : 0 < (R.q : Int) := by exact_mod_cast R.q_pos + have bound (u v : Int) (hu : 0 ≤ u) (huq : u ≤ (R.q : Int)) + (hv : 0 ≤ v) (hvq : v ≤ (R.q : Int)) + (he : u = 0 ∨ u = (R.q : Int) ∨ v = 0 ∨ v = (R.q : Int)) : + (⟨u, v⟩ : GaussianInt) ∈ FordDoubledBoundary R.q := by + change (0 ≤ u ∧ u ≤ (R.q : Int) ∧ 0 ≤ v ∧ v ≤ (R.q : Int)) ∧ + ¬(2 ≤ u ∧ u ≤ (R.q : Int) - 2 ∧ 2 ≤ v ∧ v ≤ (R.q : Int) - 2) + exact ⟨⟨hu, huq, hv, hvq⟩, by omega⟩ + have e₁ := h ⟨R.q, t⟩ (bound _ _ hq.le le_rfl ht htq (Or.inr (Or.inl rfl))) + have e₂ := h ⟨t, R.q⟩ (bound _ _ ht htq hq.le le_rfl (Or.inr (Or.inr (Or.inr rfl)))) + have e₃ := h ⟨0, t⟩ (bound _ _ le_rfl hq.le ht htq (Or.inl rfl)) + have e₄ := h ⟨t, 0⟩ (bound _ _ ht htq le_rfl hq.le (Or.inr (Or.inr (Or.inl rfl)))) + have div₁ : IntegerCeilDiv (R.p * (R.q : Int) * t) R.q (by omega) = R.p * t := by + dsimp only [IntegerCeilDiv] + have he : -(R.p * (R.q : Int) * t) = (R.q : Int) * (-R.p * t) := by ring + rw [he, Int.mul_ediv_cancel_left _ hq.ne'] + ring + have div₂ : IntegerCeilDiv (R.p * t * (R.q : Int)) R.q (by omega) = R.p * t := by + rw [show R.p * t * (R.q : Int) = R.p * (R.q : Int) * t by ring] + exact div₁ + exact ⟨e₁.trans div₁, e₂.trans div₂, by simpa [IntegerCeilDiv] using e₃, + by simpa [IntegerCeilDiv] using e₄⟩ + have ea (t : Int) (ht : 0 ≤ t) (htq : t ≤ (P.q₁ : Int)) : + g₁ ⟨P.q₁, t⟩ = P.p₁ * t ∧ g₁ ⟨t, P.q₁⟩ = P.p₁ * t ∧ + g₁ ⟨0, t⟩ = 0 ∧ g₁ ⟨t, 0⟩ = 0 := by + simpa only [hp₁, hq₁] using edges P₁ g₁ h₁ t ht (by simpa only [hq₁] using htq) + have eb (t : Int) (ht : 0 ≤ t) (htq : t ≤ (P.q₂ : Int)) : + g₂ ⟨P.q₂, t⟩ = P.p₂ * t ∧ g₂ ⟨t, P.q₂⟩ = P.p₂ * t ∧ + g₂ ⟨0, t⟩ = 0 ∧ g₂ ⟨t, 0⟩ = 0 := by + simpa only [hp₂, hq₂] using edges P₂ g₂ h₂ t ht (by simpa only [hq₂] using htq) + have hsum : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q + have hcross := (P5130T5ParentArithmetic P hq).2.2.2.2.2.2 + refine ⟨?_, ?_, ?_, ?_⟩ + · intro x hx hy + simp? [FordRecursiveVertexDomains] at hx hy + have hr : x.re = (P.q₁ : Int) := by omega + have ex : x = ⟨P.q₁, x.im⟩ := by ext <;> simp [hr] + have ey : x - ⟨(P.q₁ : Int), 0⟩ = (⟨0, x.im⟩ : GaussianInt) := by + ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub, hr] + change g₁ x = g₂ (x - ⟨(P.q₁ : Int), 0⟩) + P.p₁ * x.im + calc + g₁ x = g₁ ⟨P.q₁, x.im⟩ := congrArg g₁ ex + _ = P.p₁ * x.im := (ea x.im (by omega) (by omega)).1 + _ = g₂ (x - ⟨(P.q₁ : Int), 0⟩) + P.p₁ * x.im := by + rw [ey, (eb x.im (by omega) (by omega)).2.2.1, zero_add] + · intro x hx hy + simp? [FordRecursiveVertexDomains] at hx hy + have hi : x.im = (P.q₁ : Int) := by omega + have ex : x = ⟨x.re, P.q₁⟩ := by ext <;> simp [hi] + have ey : x - ⟨0, (P.q₁ : Int)⟩ = (⟨x.re, 0⟩ : GaussianInt) := by + ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub, hi] + change g₁ x = g₂ (x - ⟨0, (P.q₁ : Int)⟩) + P.p₁ * x.re + calc + g₁ x = g₁ ⟨x.re, P.q₁⟩ := congrArg g₁ ex + _ = P.p₁ * x.re := (ea x.re (by omega) (by omega)).2.1 + _ = g₂ (x - ⟨0, (P.q₁ : Int)⟩) + P.p₁ * x.re := by + rw [ey, (eb x.re (by omega) (by omega)).2.2.2, zero_add] + · intro x hx hy + simp? [FordRecursiveVertexDomains] at hx hy + have hi : x.im = (P.q₂ : Int) := by omega + have ex : x - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ = (⟨x.re - P.q₂, 0⟩ : GaussianInt) := by + ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub, hi] + have ey : x - ⟨(P.q₁ : Int), 0⟩ = (⟨x.re - P.q₁, P.q₂⟩ : GaussianInt) := by + ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub, hi] + change g₁ (x - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩) + + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (P.q₂ : Int) + 1 = + g₂ (x - ⟨(P.q₁ : Int), 0⟩) + P.p₁ * x.im + rw [ex, ey, (ea (x.re - P.q₂) (by omega) (by omega)).2.2.2, + (eb (x.re - P.q₁) (by omega) (by omega)).2.1, hi] + nlinarith [hcross] + · intro x hx hy + simp? [FordRecursiveVertexDomains] at hx hy + have hr : x.re = (P.q₂ : Int) := by omega + have ex : x - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ = (⟨0, x.im - P.q₂⟩ : GaussianInt) := by + ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub, hr] + have ey : x - ⟨0, (P.q₁ : Int)⟩ = (⟨P.q₂, x.im - P.q₁⟩ : GaussianInt) := by + ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub, hr] + change g₁ (x - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩) + + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (P.q₂ : Int) + 1 = + g₂ (x - ⟨0, (P.q₁ : Int)⟩) + P.p₁ * x.re + rw [ex, ey, (ea (x.im - P.q₂) (by omega) (by omega)).2.2.1, + (eb (x.im - P.q₁) (by omega) (by omega)).1, hr] + nlinarith [hcross] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5ParentArithmetic.lean b/LeanPool/ApollonianSuperharmonic/P5130T5ParentArithmetic.lean new file mode 100644 index 0000000000..d93abb1f76 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5130T5ParentArithmetic.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import Mathlib.Tactic.Linarith + +-- [TABLET NODE: P5130T5ParentArithmetic] + +/-! +# P5130T5ParentArithmetic + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5130T5ParentArithmetic (P : FordFareyParameter) (hq : 1 < P.q) : + 0 < P.q₁ ∧ P.q₁ < P.q ∧ 0 < P.q₂ ∧ P.q₂ < P.q ∧ + Nat.Coprime P.q₁ P.p₁.natAbs ∧ Nat.Coprime P.q₂ P.p₂.natAbs ∧ + P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1 := by +-- BODY + have hs : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q + have hd := P.det₁ + have hp := P.sum_p + have hcross : P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1 := by + rw [hs, hp] at hd + nlinarith [hd] + have hpos : 0 < P.q₁ := by + by_contra hn + have hz : P.q₁ = 0 := by omega + rw [hz] at hd + simp only [Nat.cast_zero, zero_mul, sub_zero] at hd + have hqi : (1 : Int) < P.q := by exact_mod_cast hq + have : (P.q : Int) ∣ 1 := ⟨P.p₁, by nlinarith [hd]⟩ + have := Int.le_of_dvd (by norm_num : (0 : Int) < 1) this + omega + have hcop₁ : Int.gcd (P.q₁ : Int) P.p₁ = 1 := by + have hdiv : (Int.gcd (P.q₁ : Int) P.p₁ : Int) ∣ 1 := by + rw [← hcross] + exact dvd_sub (dvd_mul_of_dvd_left (Int.gcd_dvd_right _ _) _) + (dvd_mul_of_dvd_right (Int.gcd_dvd_left _ _) _) + have hn : Int.natAbs (Int.gcd (P.q₁ : Int) P.p₁ : Int) = 1 := + Int.isUnit_iff_natAbs_eq.mp (isUnit_of_dvd_one hdiv) + simpa using hn + have hcop₂ : Int.gcd (P.q₂ : Int) P.p₂ = 1 := by + have hdiv : (Int.gcd (P.q₂ : Int) P.p₂ : Int) ∣ 1 := by + rw [← hcross] + exact dvd_sub (dvd_mul_of_dvd_right (Int.gcd_dvd_left _ _) _) + (dvd_mul_of_dvd_left (Int.gcd_dvd_right _ _) _) + have hn : Int.natAbs (Int.gcd (P.q₂ : Int) P.p₂ : Int) = 1 := + Int.isUnit_iff_natAbs_eq.mp (isUnit_of_dvd_one hdiv) + simpa using hn + refine ⟨hpos, P.q₁_lt, P.q₂_pos, by have := P.sum_q; omega, ?_, ?_, hcross⟩ + · simpa [Int.gcd] using hcop₁ + · simpa [Int.gcd] using hcop₂ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5PeriodicExtension.lean b/LeanPool/ApollonianSuperharmonic/P5130T5PeriodicExtension.lean new file mode 100644 index 0000000000..8d9d57d739 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5130T5PeriodicExtension.lean @@ -0,0 +1,406 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import LeanPool.ApollonianSuperharmonic.P4818T1AffineTransversalExtension +public import Mathlib.Tactic.Ring +public import Mathlib.Tactic.Abel + +-- [TABLET NODE: P5130T5PeriodicExtension] + +/-! +# P5130T5PeriodicExtension + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PeriodicExtensionConstruction + +private noncomputable abbrev q (P : FordFareyParameter) : Int := by + classical + let q : Int := P.q + exact q + +private theorem hq (P : FordFareyParameter) : 0 < (q P) := by + classical + let q : Int := P.q + change (0 < q) + dsimp [q]; exact_mod_cast P.q_pos + +private theorem hq₁lt (P : FordFareyParameter) : (P.q₁ : Int) < (q P) := by + classical + let q : Int := P.q + change ((P.q₁ : Int) < q) + change (P.q₁ : Int) < (P.q : Int) + exact_mod_cast P.q₁_lt + +private noncomputable abbrev H (P : FordFareyParameter) : Set GaussianInt := by + classical + let q : Int := P.q + let H : Set GaussianInt := {z | 0 ≤ z.re ∧ z.re < q ∧ 0 ≤ z.im ∧ z.im < q} + exact H + +private noncomputable abbrev a (P : FordFareyParameter) : GaussianInt := by + classical + let q : Int := P.q + let a : GaussianInt := ⟨0, -q⟩ + exact a + +private noncomputable abbrev b (P : FordFareyParameter) : GaussianInt := by + classical + let q : Int := P.q + let b : GaussianInt := ⟨q, P.q₁⟩ + exact b + +private noncomputable abbrev α (P : FordFareyParameter) : GaussianInt →+ Int := by + classical + let α : GaussianInt →+ Int := + { toFun := fun x => -P.p * x.re + map_zero' := by simp + map_add' := by intro x y; simp [mul_add] } + exact α + +private noncomputable abbrev β (P : FordFareyParameter) : GaussianInt →+ Int := by + classical + let β : GaussianInt →+ Int := + { toFun := fun x => P.p₁ * x.re + P.p * x.im + map_zero' := by simp + map_add' := by intro x y; simp [mul_add]; ring } + exact β + +private theorem hcomm (P : FordFareyParameter) : (α P) (b P) = (β P) (a P) := by + classical + let q : Int := P.q + let a : GaussianInt := ⟨0, -q⟩ + let b : GaussianInt := ⟨q, P.q₁⟩ + let α : GaussianInt →+ Int := + { toFun := fun x => -P.p * x.re + map_zero' := by simp + map_add' := by intro x y; simp [mul_add] } + let β : GaussianInt →+ Int := + { toFun := fun x => P.p₁ * x.re + P.p * x.im + map_zero' := by simp + map_add' := by intro x y; simp [mul_add]; ring } + change (α b = β a) + simp [α, β, a, b] + +private theorem hrep (P : FordFareyParameter) (hq : 0 < (q P)) (x : GaussianInt) : ∃! t : + GaussianInt × (Int × Int), + t.1 ∈ (H P) ∧ x = t.1 + t.2.1 • (a P) + t.2.2 • (b P) := by + classical + let q : Int := P.q + let H : Set GaussianInt := {z | 0 ≤ z.re ∧ z.re < q ∧ 0 ≤ z.im ∧ z.im < q} + let a : GaussianInt := ⟨0, -q⟩ + let b : GaussianInt := ⟨q, P.q₁⟩ + change (0 < q) at hq + change (∃! t : GaussianInt × (Int × Int), + t.1 ∈ H ∧ x = t.1 + t.2.1 • a + t.2.2 • b) + let n : Int := x.re / q + let u : Int := x.re % q + let k : Int := (x.im - n * P.q₁) / q + let v : Int := (x.im - n * P.q₁) % q + let z : GaussianInt := ⟨u, v⟩ + have hu0 : 0 ≤ u := by dsimp [u]; exact Int.emod_nonneg _ (by omega) + have hult : u < q := by dsimp [u]; exact Int.emod_lt_of_pos _ hq + have hv0 : 0 ≤ v := by dsimp [v]; exact Int.emod_nonneg _ (by omega) + have hvlt : v < q := by dsimp [v]; exact Int.emod_lt_of_pos _ hq + have hre : x.re = u + n * q := by + have hh := (Int.emod_add_mul_ediv x.re q).symm + calc + x.re = x.re % q + q * (x.re / q) := hh + _ = u + n * q := by dsimp [u, n]; ring + have him : x.im = v + k * q + n * P.q₁ := by + have hh := Int.emod_add_mul_ediv (x.im - n * P.q₁) q + change v + q * k = x.im - n * P.q₁ at hh + nlinarith + have hz : z ∈ H := by simp [H, z, hu0, hult, hv0, hvlt] + have hx : x = z + (-k) • a + n • b := by + apply Zsqrtd.ext <;> simp [z, a, b, zsmul_eq_mul, hre, him] + refine ⟨(z, (-k, n)), ⟨hz, hx⟩, ?_⟩ + intro t ht + rcases t with ⟨w, m, l⟩ + rcases ht with ⟨hw, hwt⟩ + change 0 ≤ w.re ∧ w.re < q ∧ 0 ≤ w.im ∧ w.im < q at hw + rcases hw with ⟨hwr0, hwr1, hwi0, hwi1⟩ + have hwr : 0 ≤ w.re ∧ w.re < q := ⟨hwr0, hwr1⟩ + have hwi : 0 ≤ w.im ∧ w.im < q := ⟨hwi0, hwi1⟩ + have hwrep := congr_arg Zsqrtd.re hwt + have himrep := congr_arg Zsqrtd.im hwt + simp? [a, b, zsmul_eq_mul] at hwrep himrep + have hdivr : x.re / q = l := by + apply (Int.ediv_eq_iff_of_pos hq).2 + constructor <;> rw [hwrep] <;> nlinarith [hwr.1, hwr.2] + have hmodr : x.re % q = w.re := by + rw [hwrep, show w.re + l * q = w.re + q * l by ring, + Int.add_mul_emod_self_left, Int.emod_eq_of_lt hwr.1 hwr.2] + have hn_eq : l = n := by + dsimp [n] + exact hdivr.symm + subst l + have hu_eq : w.re = u := by + dsimp [u] + exact hmodr.symm + have hm_eq : m = -k := by + have heq : x.im - n * P.q₁ = w.im + q * (-m) := by + rw [himrep] + ring + have hd : (x.im - n * P.q₁) / q = -m := by + apply (Int.ediv_eq_iff_of_pos hq).2 + constructor <;> rw [heq] <;> nlinarith [hwi.1, hwi.2] + dsimp [k] + linarith + have hv_eq : w.im = v := by + have heq : x.im - n * P.q₁ = w.im + q * (-m) := by + rw [himrep] + ring + have hd : (x.im - n * P.q₁) % q = w.im := by + rw [heq, Int.add_mul_emod_self_left, Int.emod_eq_of_lt hwi.1 hwi.2] + dsimp [v] + exact hd.symm + subst m + apply Prod.ext + · apply Zsqrtd.ext <;> simp [z, hu_eq, hv_eq] + · apply Prod.ext <;> simp [hn_eq] + +private theorem ext (P : FordFareyParameter) (f : IntegerLatticeFunction) (hcomm : ((α P) : + GaussianInt → ℤ) (b P) = ((β P) : GaussianInt → ℤ) (a P)) (hrep : ∀ (x : GaussianInt), ∃! t : + GaussianInt × ℤ × ℤ, t.1 ∈ (H P) ∧ x = t.1 + t.2.1 • (a P) + t.2.2 • (b P)) : ∃ (g : + IntegerLatticeFunction), (∀ h ∈ (H P), g h = f h) ∧ (∀ (x : GaussianInt), g (x + (a P)) = g x + + ((α P) : GaussianInt → ℤ) x + 0) ∧ (∀ (x : GaussianInt), g (x + (b P)) = g x + ((β P) : + GaussianInt → ℤ) x + (↑P.q₁ : ℤ) * P.p) ∧ (∀ h ∈ (H P), ∀ (m n : ℤ), g (h + m • (a P) + n • + (b P)) = f h + m * (((α P) : GaussianInt → ℤ) h + 0) + m * (m - 1) / 2 * ((α P) : GaussianInt + → ℤ) (a P) + n * (((β P) : GaussianInt → ℤ) h + (↑P.q₁ : ℤ) * P.p) + n * (n - 1) / 2 * ((β P) + : GaussianInt → ℤ) (b P) + m * n * ((β P) : GaussianInt → ℤ) (a P)) ∧ ∀ (g' : + IntegerLatticeFunction), (∀ (x : GaussianInt), g' (x + (a P)) = g' x + ((α P) : GaussianInt → + ℤ) x + 0) → (∀ (x : GaussianInt), g' (x + (b P)) = g' x + ((β P) : GaussianInt → ℤ) x + + (↑P.q₁ : ℤ) * P.p) → (∀ h ∈ (H P), g' h = f h) → g' = g := by + classical + let q : Int := P.q + let H : Set GaussianInt := {z | 0 ≤ z.re ∧ z.re < q ∧ 0 ≤ z.im ∧ z.im < q} + let a : GaussianInt := ⟨0, -q⟩ + let b : GaussianInt := ⟨q, P.q₁⟩ + let α : GaussianInt →+ Int := + { toFun := fun x => -P.p * x.re + map_zero' := by simp + map_add' := by intro x y; simp [mul_add] } + let β : GaussianInt →+ Int := + { toFun := fun x => P.p₁ * x.re + P.p * x.im + map_zero' := by simp + map_add' := by intro x y; simp [mul_add]; ring } + change ((α : GaussianInt → ℤ) b = (β : GaussianInt → ℤ) a) at hcomm + change (∀ (x : GaussianInt), ∃! t : GaussianInt × ℤ × ℤ, t.1 ∈ H ∧ x = t.1 + t.2.1 • a + t.2.2 + • b) at hrep + change (∃ (g : IntegerLatticeFunction), (∀ h ∈ H, g h = f h) ∧ (∀ (x : GaussianInt), g (x + a) + = g x + (α : GaussianInt → ℤ) x + 0) ∧ (∀ (x : GaussianInt), g (x + b) = g x + (β : + GaussianInt → ℤ) x + (↑P.q₁ : ℤ) * P.p) ∧ (∀ h ∈ H, ∀ (m n : ℤ), g (h + m • a + n • b) = f + h + m * ((α : GaussianInt → ℤ) h + 0) + m * (m - 1) / 2 * (α : GaussianInt → ℤ) a + n * ((β + : GaussianInt → ℤ) h + (↑P.q₁ : ℤ) * P.p) + n * (n - 1) / 2 * (β : GaussianInt → ℤ) b + m * + n * (β : GaussianInt → ℤ) a) ∧ ∀ (g' : IntegerLatticeFunction), (∀ (x : GaussianInt), g' (x + + a) = g' x + (α : GaussianInt → ℤ) x + 0) → (∀ (x : GaussianInt), g' (x + b) = g' x + (β : + GaussianInt → ℤ) x + (↑P.q₁ : ℤ) * P.p) → (∀ h ∈ H, g' h = f h) → g' = g) + exact P4818T1AffineTransversalExtension H a b α β 0 (P.q₁ * P.p) f hrep hcomm + +private theorem fEdges (P : FordFareyParameter) (f : IntegerLatticeFunction) (hB : ∀ x ∈ + FordDoubledBoundary P.q, f x = IntegerCeilDiv (P.p * x.re * x.im) (↑P.q : ℤ) (by + exact_mod_cast P.q_pos.ne')) (hq : 0 < (q + P)) (r : Int) (hr0 : 0 ≤ r) (hrq : r ≤ (q P)) : + f ⟨r, 0⟩ = 0 ∧ f ⟨0, r⟩ = 0 ∧ + f ⟨r, (q P)⟩ = P.p * r ∧ f ⟨(q P), r⟩ = P.p * r := by + classical + let q : Int := P.q + change (0 < q) at hq + change r ≤ q at hrq + change (f ⟨r, 0⟩ = 0 ∧ f ⟨0, r⟩ = 0 ∧ + f ⟨r, q⟩ = P.p * r ∧ f ⟨q, r⟩ = P.p * r) + have mbot : (⟨r, 0⟩ : GaussianInt) ∈ FordDoubledBoundary P.q := by + change (0 ≤ r ∧ r ≤ q ∧ 0 ≤ (0:Int) ∧ (0:Int) ≤ q) ∧ + ¬(2 ≤ r ∧ r ≤ q - 2 ∧ 2 ≤ (0:Int) ∧ (0:Int) ≤ q - 2) + constructor <;> omega + have mleft : (⟨0, r⟩ : GaussianInt) ∈ FordDoubledBoundary P.q := by + change (0 ≤ (0:Int) ∧ (0:Int) ≤ q ∧ 0 ≤ r ∧ r ≤ q) ∧ + ¬(2 ≤ (0:Int) ∧ (0:Int) ≤ q - 2 ∧ 2 ≤ r ∧ r ≤ q - 2) + constructor <;> omega + have mtop : (⟨r, q⟩ : GaussianInt) ∈ FordDoubledBoundary P.q := by + change (0 ≤ r ∧ r ≤ q ∧ 0 ≤ q ∧ q ≤ q) ∧ + ¬(2 ≤ r ∧ r ≤ q - 2 ∧ 2 ≤ q ∧ q ≤ q - 2) + constructor <;> omega + have mright : (⟨q, r⟩ : GaussianInt) ∈ FordDoubledBoundary P.q := by + change (0 ≤ q ∧ q ≤ q ∧ 0 ≤ r ∧ r ≤ q) ∧ + ¬(2 ≤ q ∧ q ≤ q - 2 ∧ 2 ≤ r ∧ r ≤ q - 2) + constructor <;> omega + have hcTop : IntegerCeilDiv (P.p * r * q) q (ne_of_gt hq) = P.p * r := by + unfold IntegerCeilDiv + have he : -(P.p * r * q) = q * (-(P.p * r)) := by ring + rw [he, Int.mul_ediv_cancel_left _ (ne_of_gt hq)] + simp + have hcRight : IntegerCeilDiv (P.p * q * r) q (ne_of_gt hq) = P.p * r := by + have hh : P.p * q * r = P.p * r * q := by ring + rw [hh] + exact hcTop + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa [IntegerCeilDiv] using hB ⟨r, 0⟩ mbot + · simpa [IntegerCeilDiv] using hB ⟨0, r⟩ mleft + · exact (hB ⟨r, q⟩ mtop).trans hcTop + · exact (hB ⟨q, r⟩ mright).trans hcRight + +end PeriodicExtensionConstruction + +theorem P5130T5PeriodicExtension (P : FordFareyParameter) + (f : IntegerLatticeFunction) + (hB : ∀ x ∈ FordDoubledBoundary P.q, + f x = IntegerCeilDiv (P.p * x.re * x.im) P.q (by exact_mod_cast P.q_pos.ne')) : + ∃! g : IntegerLatticeFunction, + (∀ x ∈ FordVertexDomain P.q, g x = f x) ∧ + (∀ x, g (x + ⟨0, -(P.q : Int)⟩) = g x - P.p * x.re) ∧ + (∀ x, g (x + ⟨(P.q : Int), (P.q₁ : Int)⟩) = + g x + P.p₁ * x.re + P.p * x.im + (P.q₁ : Int) * P.p) ∧ + (∀ x, g (x + ⟨-(P.q : Int), (P.q₂ : Int)⟩) = + g x + P.p₂ * x.re - P.p * x.im - (P.q : Int) * P.p₂) := by +-- BODY + classical + let q : Int := P.q + have hq : 0 < q := PeriodicExtensionConstruction.hq P + have hq₁lt : (P.q₁ : Int) < q := PeriodicExtensionConstruction.hq₁lt P + let H : Set GaussianInt := {z | 0 ≤ z.re ∧ z.re < q ∧ 0 ≤ z.im ∧ z.im < q} + let a : GaussianInt := ⟨0, -q⟩ + let b : GaussianInt := ⟨q, P.q₁⟩ + let α : GaussianInt →+ Int := + { toFun := fun x => -P.p * x.re + map_zero' := by simp + map_add' := by intro x y; simp [mul_add] } + let β : GaussianInt →+ Int := + { toFun := fun x => P.p₁ * x.re + P.p * x.im + map_zero' := by simp + map_add' := by intro x y; simp [mul_add]; ring } + have hcomm : α b = β a := PeriodicExtensionConstruction.hcomm P + have hrep (x : GaussianInt) : ∃! t : GaussianInt × (Int × Int), + t.1 ∈ H ∧ x = t.1 + t.2.1 • a + t.2.2 • b := PeriodicExtensionConstruction.hrep P hq x + have ext := PeriodicExtensionConstruction.ext P f hcomm hrep + rcases ext with ⟨g, hH, ha, hb, _, huniq⟩ + have fEdges (r : Int) (hr0 : 0 ≤ r) (hrq : r ≤ q) : + f ⟨r, 0⟩ = 0 ∧ f ⟨0, r⟩ = 0 ∧ + f ⟨r, q⟩ = P.p * r ∧ f ⟨q, r⟩ = P.p * r := PeriodicExtensionConstruction.fEdges P f hB hq r + hr0 hrq + refine ⟨g, ⟨?_, ?_, ?_, ?_⟩, ?_⟩ + · intro x hx + change 0 ≤ x.re ∧ x.re ≤ q ∧ 0 ≤ x.im ∧ x.im ≤ q at hx + rcases hx with ⟨hr0, hrq, hi0, hiq⟩ + by_cases hr : x.re = q + · have hx : x = ⟨q, x.im⟩ := by apply Zsqrtd.ext <;> simp [hr] + rw [hx] + have hright := fEdges x.im hi0 hiq + have gzero : g ⟨0, x.im - P.q₁⟩ = 0 := by + by_cases hlow : 0 ≤ x.im - P.q₁ + · by_cases hhigh : x.im - P.q₁ < q + · have hmem : (⟨0, x.im - P.q₁⟩ : GaussianInt) ∈ H := by + simp [H]; omega + rw [hH _ hmem] + have hv := fEdges (x.im - P.q₁) hlow (by omega) + exact hv.2.1 + · have heq : x.im - P.q₁ = q := by omega + have hdown := ha ⟨0, q⟩ + have hzero : g ⟨0, 0⟩ = 0 := by + rw [hH _ (by simp []; omega)] + exact (fEdges 0 (by omega) (by omega)).2.1 + have hdown' : g ⟨0, 0⟩ = g ⟨0, q⟩ := by + simpa [a, α, q] using hdown + simpa [heq] using hdown'.symm.trans hzero + · have hlow' : 0 ≤ x.im - P.q₁ + q ∧ x.im - P.q₁ + q < q := by omega + have hmem : (⟨0, x.im - P.q₁ + q⟩ : GaussianInt) ∈ H := by + simp [H]; omega + have hadd := ha ⟨0, x.im - P.q₁ + q⟩ + have hshift : (⟨0, x.im - P.q₁ + q⟩ : GaussianInt) + a = ⟨0, x.im - P.q₁⟩ := by + apply Zsqrtd.ext <;> simp [a, q] + rw [hshift] at hadd + have hbase : g ⟨0, x.im - P.q₁ + q⟩ = 0 := by + rw [hH _ hmem] + exact (fEdges (x.im - P.q₁ + q) hlow'.1 (le_of_lt hlow'.2)).2.1 + have ha0 : α ⟨0, x.im - P.q₁ + q⟩ = 0 := by simp [α] + rw [ha0, hbase] at hadd + exact hadd + have hstep := hb ⟨0, x.im - P.q₁⟩ + have hcoords : (⟨0, x.im - P.q₁⟩ : GaussianInt) + b = ⟨q, x.im⟩ := by + apply Zsqrtd.ext <;> simp [b, q] + rw [hcoords] at hstep + rw [hright.2.2.2] + rw [hstep, gzero] + simp [] + nlinarith + · by_cases hi : x.im = q + · have hx : x = ⟨x.re, q⟩ := by apply Zsqrtd.ext <;> simp [hi] + rw [hx] + have htop := fEdges x.re hr0 hrq + have hbase : (⟨x.re, 0⟩ : GaussianInt) ∈ H := by simp [H]; omega + have hdown := ha ⟨x.re, q⟩ + have hshift : (⟨x.re, q⟩ : GaussianInt) + a = ⟨x.re, 0⟩ := by + apply Zsqrtd.ext <;> simp [a, q] + rw [hshift] at hdown + have haTop : α ⟨x.re, q⟩ = -P.p * x.re := by simp [α] + rw [haTop, hH _ hbase, htop.1] at hdown + rw [htop.2.2.1] + linarith + · have hmem : x ∈ H := by simp [H]; omega + exact hH x hmem + · intro x + change g (x + a) = g x - P.p * x.re + rw [ha x] + simp [] + ring + · intro x + change g (x + b) = g x + P.p₁ * x.re + P.p * x.im + (P.q₁ : Int) * P.p + rw [hb x] + simp [] + ring + · intro x + let y : GaussianInt := x + ⟨-(P.q : Int), (P.q₂ : Int)⟩ + have hqs : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by exact_mod_cast P.sum_q + have hrel : y + a + b = x := by + apply Zsqrtd.ext + · simp [y, a, b, q] + · simp? [y, a, b, q] + rw [hqs] + ring + have hstep : g x = g y + α y + β (y + a) + (P.q₁ : Int) * P.p := by + calc + g x = g (y + a + b) := by rw [hrel] + _ = g (y + a) + β (y + a) + (P.q₁ : Int) * P.p := hb (y + a) + _ = g y + α y + β (y + a) + (P.q₁ : Int) * P.p := by rw [ha y]; ring + rw [hstep] + simp? [α, β, y, a, q] + have hps : P.p = P.p₁ + P.p₂ := P.sum_p + rw [hqs, hps] + ring + · intro g' hg' + rcases hg' with ⟨hagree, ha', hb', _⟩ + have hga : ∀ x, g' (x + a) = g' x + α x + 0 := by + intro x + rw [ha' x] + simp [α] + ring + have hgb : ∀ x, g' (x + b) = g' x + β x + P.q₁ * P.p := by + intro x + rw [hb' x] + simp [β] + ring + apply huniq g' hga hgb + intro h hh + have hdom : h ∈ FordVertexDomain P.q := by + change 0 ≤ h.re ∧ h.re ≤ (P.q : Int) ∧ 0 ≤ h.im ∧ h.im ≤ (P.q : Int) + rcases hh with ⟨hr0, hr1, hi0, hi1⟩ + constructor <;> omega + exact hagree h hdom + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5Prescription.lean b/LeanPool/ApollonianSuperharmonic/P5130T5Prescription.lean new file mode 100644 index 0000000000..13cc757fd2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5130T5Prescription.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains + +-- [TABLET NODE: P5130T5Prescription] + +/-! +# P5130T5Prescription + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a Ford--Farey parameter $P$ and two integer lattice functions $g_1,g_2$, +define the four recursive prescriptions $F_i=F_i(P;g_1,g_2)$ by +$$ +\begin{aligned} + F_0(x)&=g_1(x),\\ + F_1(x)&=g_1(x-(q_2,q_2))+p_2x_1+p_2x_2-p_2q_2+1,\\ + F_2(x)&=g_2(x-(q_1,0))+p_1x_2,\\ + F_3(x)&=g_2(x-(0,q_1))+p_1x_1. +\end{aligned} +$$ +They are total functions; their prescribed domains are, respectively, +$E_1,E_2,E_3,E_4$ of `FordRecursiveVertexDomains`. +-/ +def P5130T5Prescription (P : FordFareyParameter) + (g₁ g₂ : IntegerLatticeFunction) : Fin 4 → IntegerLatticeFunction := +-- BODY + ![g₁, + fun x => g₁ (x - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩) + + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (P.q₂ : Int) + 1, + fun x => g₂ (x - ⟨(P.q₁ : Int), 0⟩) + P.p₁ * x.im, + fun x => g₂ (x - ⟨0, (P.q₁ : Int)⟩) + P.p₁ * x.re] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean b/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean new file mode 100644 index 0000000000..f6bdc8e89a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean @@ -0,0 +1,450 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5130T5Prescription +public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic +public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv + +-- [TABLET NODE: P5130T5SameParentOverlaps] + +/-! +# P5130T5SameParentOverlaps + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SameParentOverlapLemmas + +private theorem harith : + ∀ (P : FordFareyParameter), (1 < P.q) → 0 < P.q₁ ∧ + P.q₁ < P.q ∧ + 0 < P.q₂ ∧ + P.q₂ < P.q ∧ P.q₁.Coprime P.p₁.natAbs ∧ P.q₂.Coprime P.p₂.natAbs ∧ P.p₁ * (↑P.q₂ : ℤ) - + P.p₂ * (↑P.q₁ : ℤ) = 1 := by + classical + intro P hq + exact P5130T5ParentArithmetic P hq + +private theorem hq1 : + ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → P₁.q = P.q₁ := by + classical + intro P P₁ hq₁ + exact hq₁ + +private theorem hq2 : + ∀ (P : FordFareyParameter), ∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) → P₂.q = P.q₂ := by + classical + intro P P₂ hq₂ + exact hq₂ + +private theorem hp1 : + ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (P₁.p = P.p₁) → P₁.p = P.p₁ := by + classical + intro P P₁ hp₁ + exact hp₁ + +private theorem hp2 : + ∀ (P : FordFareyParameter), ∀ (P₂ : FordFareyParameter), (P₂.p = P.p₂) → P₂.p = P.p₂ := by + classical + intro P P₂ hp₂ + exact hp₂ + +private theorem hq1pos' : + ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (FordFareyParameter) → (P₁.q = P.q₁) + → (0 < P.q₁) → 0 < P₁.q := by + classical + intro P P₁ P₂ hq₁ hq1pos + omega + +private theorem hq2pos' : + ∀ (P : FordFareyParameter), (FordFareyParameter) → ∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) + → (0 < P.q₂) → 0 < P₂.q := by + classical + intro P P₁ P₂ hq₂ hq2pos + omega + +private theorem hq1lt' : + ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (FordFareyParameter) → (P₁.q = P.q₁) + → (P.q₁ < P.q) → P₁.q < P.q := by + classical + intro P P₁ P₂ hq₁ hq1lt + omega + +private theorem hq2lt' : + ∀ (P : FordFareyParameter), (FordFareyParameter) → ∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) + → (P.q₂ < P.q) → P₂.q < P.q := by + classical + intro P P₁ P₂ hq₂ hq2lt + omega + +end SameParentOverlapLemmas + +namespace FirstParentOverlap + +private theorem first_parent_overlap : + ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), ∀ (P₂ : FordFareyParameter), (P₁.p = + P.p₁) → (P₁.q = P.q₁) → (P₂.p = P.p₂) → (P₂.q = P.q₂) → ∀ (G : FordFareyParameter → + IntegerLatticeFunction), (∀ R, R.q < P.q → ∀ x ∈ FordDoubledBoundary R.q, G R x = + IntegerCeilDiv (R.p * x.re * x.im) R.q (by exact_mod_cast R.q_pos.ne')) → (∀ R A B, R.q < + P.q → 1 < R.q → A.p = R.p₁ → A.q = R.q₁ → B.p = R.p₂ → B.q = R.q₂ → ∀ i x, x ∈ + FordRecursiveVertexDomains R i → G R x = P5130T5Prescription R (G A) (G B) i x) → ((0 : + ℕ) < P.q₁) → ((0 : ℕ) < P.q₂) → (P.p₁ * (↑P.q₂ : ℤ) - P.p₂ * (↑P.q₁ : ℤ) = (1 : ℤ)) → + (P₁.q = P.q₁) → (P₂.q = P.q₂) → (P₁.p = P.p₁) → (P₂.p = P.p₂) → (P₁.q < P.q) → (P₂.q < + P.q) → ∀ x, + x ∈ FordRecursiveVertexDomains P 0 → x ∈ FordRecursiveVertexDomains P 1 → + P5130T5Prescription P (G P₁) (G P₂) 0 x = + P5130T5Prescription P (G P₁) (G P₂) 1 x := by + classical + intro P P₁ P₂ hp₁ hq₁ hp₂ hq₂ G hB hR hq1pos hq2pos hcross hq1 hq2 hp1 hp2 hq1lt' hq2lt' x hx0 hx1 + by_cases hgt : P.q₁ > P.q₂ + · have hqdiff : P.q₂ + (P.q₁ - P.q₂) = P.q₁ := Nat.add_sub_of_le hgt.le + let q3 : Nat := P.q₁ - P.q₂ + let p3 : Int := P.p₁ - P.p₂ + have hq3pos : 0 < q3 := by dsimp [q3]; omega + have hq3lt : q3 < P.q₁ := by dsimp [q3]; omega + have hq3cast : (P.q₁ : Int) = (P.q₂ : Int) + (q3 : Int) := by + dsimp [q3] + rw [Nat.cast_sub hgt.le] + omega + have hdet3a : p3 * (P.q₂ : Int) - P.p₂ * (q3 : Int) = 1 := by + calc + p3 * (P.q₂ : Int) - P.p₂ * (q3 : Int) = + P.p₁ * (P.q₂ : Int) - P.p₂ * ((P.q₂ : Int) + (q3 : Int)) := by + dsimp [p3]; ring + _ = P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) := by rw [← hq3cast] + _ = 1 := hcross + have hdet3b : p3 * (P.q₁ : Int) - (q3 : Int) * P.p₁ = 1 := by + calc + p3 * (P.q₁ : Int) - (q3 : Int) * P.p₁ = + P.p₁ * ((P.q₁ : Int) - (q3 : Int)) - P.p₂ * (P.q₁ : Int) := by + dsimp [p3]; ring + _ = P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) := by rw [hq3cast]; ring + _ = 1 := hcross + have hdetP1₂ : P.p₂ * (P.q₁ : Int) - (P.q₂ : Int) * P.p₁ = -1 := by + calc + P.p₂ * (P.q₁ : Int) - (P.q₂ : Int) * P.p₁ = + -(P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int)) := by ring + _ = -1 := by rw [hcross] + have hred3 : Nat.Coprime q3 p3.natAbs := by + have hdvd : (Int.gcd (q3 : Int) p3 : Int) ∣ (1 : Int) := by + have hga : (Int.gcd (q3 : Int) p3 : Int) ∣ p3 := Int.gcd_dvd_right _ _ + have hgb : (Int.gcd (q3 : Int) p3 : Int) ∣ (q3 : Int) := Int.gcd_dvd_left _ _ + have hdiv : (Int.gcd (q3 : Int) p3 : Int) ∣ + p3 * (P.q₂ : Int) - P.p₂ * (q3 : Int) := + dvd_sub (dvd_mul_of_dvd_left hga _) (dvd_mul_of_dvd_right hgb _) + rw [hdet3a] at hdiv + exact hdiv + have hn : Int.natAbs (Int.gcd (q3 : Int) p3) = 1 := + Int.isUnit_iff_natAbs_eq.mp (isUnit_of_dvd_one hdvd) + simpa [Int.gcd] using hn + obtain ⟨P₃, hP₃, _⟩ := FordFareyParentsExist p3 q3 hq3pos hred3 + let T : FordFareyParameter := { + p := P₁.p, q := P₁.q, q_pos := P₁.q_pos, reduced := P₁.reduced, + p₁ := p3, q₁ := q3, p₂ := P₂.p, q₂ := P₂.q, + sum_p := by dsimp [p3]; rw [hp1, hp2]; have hs := P.sum_p; omega, + sum_q := by dsimp [q3]; rw [hq1, hq2]; have hs := P.sum_q; omega, + det₁ := by dsimp [p3]; rw [hp1, hq1]; exact hdet3b, + det₂ := by rw [hp2, hq2, hp1, hq1]; exact hdetP1₂, + q₁_lt := by dsimp [q3]; rw [hq1]; omega, + q₂_pos := P₂.q_pos, + unit_case := by intro hu; have := hq3pos; have := P₂.q_pos; omega } + obtain ⟨W, hW, huniq⟩ := FordFareyParentsExist P₁.p P₁.q P₁.q_pos P₁.reduced + have hTP1 : T = P₁ := (huniq T ⟨rfl, rfl⟩).trans (huniq P₁ ⟨rfl, rfl⟩).symm + have hp31 : P₁.p₁ = p3 := by + have h := congrArg FordFareyParameter.p₁ hTP1 + simpa [T] using h.symm + have hq31 : P₁.q₁ = q3 := by + have h := congrArg FordFareyParameter.q₁ hTP1 + simpa [T] using h.symm + have hp32 : P₁.p₂ = P₂.p := by + have h := congrArg FordFareyParameter.p₂ hTP1 + simpa [T] using h.symm + have hq32 : P₁.q₂ = P₂.q := by + have h := congrArg FordFareyParameter.q₂ hTP1 + simpa [T] using h.symm + simp only [FordRecursiveVertexDomains] at hx0 hx1 + rcases hx0 with ⟨hx0r, hx0r', hx0i, hx0i'⟩ + rcases hx1 with ⟨hx1r, hx1r', hx1i, hx1i'⟩ + let y : GaussianInt := x - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ + have hy0 : y ∈ FordRecursiveVertexDomains P₁ 0 := by + simp only [FordRecursiveVertexDomains, Matrix.cons_val_zero, Set.mem_ofPred_eq] + rw [hq31] + constructor + · simp [y, sub_eq_add_neg]; omega + constructor + · simp [y, sub_eq_add_neg]; omega + constructor + · simp [y, sub_eq_add_neg]; omega + · simp [y, sub_eq_add_neg]; omega + have hx1P : x ∈ FordRecursiveVertexDomains P₁ 1 := by + simp only [FordRecursiveVertexDomains, Matrix.cons_val_one] + change (P₁.q₂ : Int) ≤ x.re ∧ x.re ≤ (P₁.q : Int) ∧ + (P₁.q₂ : Int) ≤ x.im ∧ x.im ≤ (P₁.q : Int) + exact ⟨by simpa [hq32, hq2] using hx1r, by simpa [hq1] using hx0r', + by simpa [hq32, hq2] using hx1i, by simpa [hq1] using hx0i'⟩ + have hP1gt : 1 < P₁.q := by rw [hq1]; omega + have hrx := hR P₁ P₃ P₂ hq1lt' hP1gt + (by exact hP₃.1.trans hp31.symm) + (by exact hP₃.2.trans hq31.symm) + hp32.symm hq32.symm 1 x hx1P + have hry := hR P₁ P₃ P₂ hq1lt' hP1gt + (by exact hP₃.1.trans hp31.symm) + (by exact hP₃.2.trans hq31.symm) + hp32.symm hq32.symm 0 y hy0 + simp only [P5130T5Prescription, Matrix.cons_val_zero, Matrix.cons_val_one] + change G P₁ x = G P₁ y + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (P.q₂ : Int) + 1 + have hrx' : G P₁ x = G P₃ y + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (P.q₂ : Int) + 1 := by + simpa [P5130T5Prescription, y, hp32, hq32, hp2, hq2] using hrx + have hry' : G P₁ y = G P₃ y := by simpa [P5130T5Prescription] using hry + rw [hrx', hry'] + · by_cases hlt : P.q₂ > P.q₁ + · simp only [FordRecursiveVertexDomains] at hx0 hx1 + rcases hx0 with ⟨_, hx0r, _, hx0i⟩ + rcases hx1 with ⟨hx1r, _, hx1i, _⟩ + omega + · have hden : P.q₁ = P.q₂ := by omega + simp only [FordRecursiveVertexDomains] at hx0 hx1 + rcases hx0 with ⟨hx0r, hx0r', hx0i, hx0i'⟩ + rcases hx1 with ⟨hx1r, hx1r', hx1i, hx1i'⟩ + have hmul : (P.q₁ : Int) * (P.p₁ - P.p₂) = 1 := by + have hcross' := hcross + rw [← hden] at hcross' + calc + (P.q₁ : Int) * (P.p₁ - P.p₂) = P.p₁ * (P.q₁ : Int) - P.p₂ * (P.q₁ : Int) := by ring + _ = 1 := hcross' + have hdiv : (P.q₁ : Int) ∣ (1 : Int) := ⟨P.p₁ - P.p₂, hmul.symm⟩ + have hqle : (P.q₁ : Int) ≤ 1 := Int.le_of_dvd (by norm_num) hdiv + have hqone : P.q₁ = 1 := by omega + have hq2one : P.q₂ = 1 := by omega + have hq1int : (P.q₁ : Int) = 1 := by exact_mod_cast hqone + have hq2int : (P.q₂ : Int) = 1 := by exact_mod_cast hq2one + have hxre : x.re = 1 := by omega + have hxim : x.im = 1 := by omega + let c : GaussianInt := ⟨1, 1⟩ + have hxc : x = c := by ext <;> simp [c, hxre, hxim] + have hpone : P.p₁ = P.p₂ + 1 := by nlinarith [hmul, hqone] + have hPq : P.q = 2 := by have hs := P.sum_q; omega + have hP1q : P₁.q = 1 := by omega + have hP2q : P₂.q = 1 := by omega + let z : GaussianInt := ⟨0, 0⟩ + let u : GaussianInt := ⟨0, 1⟩ + let v : GaussianInt := ⟨1, 0⟩ + have hz1 : G P₁ z = 0 := by + have hb := hB P₁ (by omega) z (by simp [z, FordDoubledBoundary, FordVertexDomain]) + simpa [z, IntegerCeilDiv] using hb + have hc1 : G P₁ c = P₁.p := by + have hb := hB P₁ (by omega) c (by simp [c, hP1q, FordDoubledBoundary, FordVertexDomain]) + simpa [c, IntegerCeilDiv, hP1q] using hb + have hu2 : G P₂ u = 0 := by + have hb := hB P₂ (by omega) u (by simp [u, hP2q, FordDoubledBoundary, FordVertexDomain]) + simpa [u, IntegerCeilDiv] using hb + have hv2 : G P₂ v = 0 := by + have hb := hB P₂ (by omega) v (by simp [v, hP2q, FordDoubledBoundary, FordVertexDomain]) + simpa [v, IntegerCeilDiv] using hb + have hval : P₁.p = P₂.p + 1 := by omega + rw [hxc] + simp only [P5130T5Prescription, Matrix.cons_val_zero, Matrix.cons_val_one, + ] + have hshift : c - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ = z := by + ext <;> simp [c, z, hq2int] + rw [hshift] + simp [c, z, hq2int, + hval, hz1, hc1, hp2] + +end FirstParentOverlap + +theorem P5130T5SameParentOverlaps (P P₁ P₂ : FordFareyParameter) + (hq : 1 < P.q) (hp₁ : P₁.p = P.p₁) (hq₁ : P₁.q = P.q₁) + (hp₂ : P₂.p = P.p₂) (hq₂ : P₂.q = P.q₂) + (G : FordFareyParameter → IntegerLatticeFunction) + (hB : ∀ R, R.q < P.q → ∀ x ∈ FordDoubledBoundary R.q, + G R x = IntegerCeilDiv (R.p * x.re * x.im) R.q (by exact_mod_cast R.q_pos.ne')) + (hR : ∀ R A B, R.q < P.q → 1 < R.q → + A.p = R.p₁ → A.q = R.q₁ → B.p = R.p₂ → B.q = R.q₂ → + ∀ i x, x ∈ FordRecursiveVertexDomains R i → + G R x = P5130T5Prescription R (G A) (G B) i x) : + let F := P5130T5Prescription P (G P₁) (G P₂) + (∀ x, x ∈ FordRecursiveVertexDomains P 0 → x ∈ FordRecursiveVertexDomains P 1 → F 0 x = F 1 x) ∧ + (∀ x, x ∈ FordRecursiveVertexDomains P 2 → x ∈ FordRecursiveVertexDomains P 3 → F 2 x = F 3 + x) := by +-- BODY + dsimp + have harith := SameParentOverlapLemmas.harith P hq + rcases harith with ⟨hq1pos, hq1lt, hq2pos, hq2lt, hred1, hred2, hcross⟩ + have hq1 : P₁.q = P.q₁ := SameParentOverlapLemmas.hq1 P P₁ hq₁ + have hq2 : P₂.q = P.q₂ := SameParentOverlapLemmas.hq2 P P₂ hq₂ + have hp1 : P₁.p = P.p₁ := SameParentOverlapLemmas.hp1 P P₁ hp₁ + have hp2 : P₂.p = P.p₂ := SameParentOverlapLemmas.hp2 P P₂ hp₂ + have hq1pos' : 0 < P₁.q := SameParentOverlapLemmas.hq1pos' P P₁ P₂ hq₁ hq1pos + have hq2pos' : 0 < P₂.q := SameParentOverlapLemmas.hq2pos' P P₁ P₂ hq₂ hq2pos + have hq1lt' : P₁.q < P.q := SameParentOverlapLemmas.hq1lt' P P₁ P₂ hq₁ hq1lt + have hq2lt' : P₂.q < P.q := SameParentOverlapLemmas.hq2lt' P P₁ P₂ hq₂ hq2lt + have first_parent_overlap : ∀ x, + x ∈ FordRecursiveVertexDomains P 0 → x ∈ FordRecursiveVertexDomains P 1 → + P5130T5Prescription P (G P₁) (G P₂) 0 x = + P5130T5Prescription P (G P₁) (G P₂) 1 x := FirstParentOverlap.first_parent_overlap P P₁ + P₂ hp₁ hq₁ hp₂ hq₂ G hB hR hq1pos hq2pos hcross hq1 hq2 hp1 hp2 hq1lt' hq2lt' + refine ⟨first_parent_overlap, ?_⟩ + intro x hx2 hx3 + by_cases hlt : P.q₂ > P.q₁ + · have hqdiff : P.q₁ + (P.q₂ - P.q₁) = P.q₂ := Nat.add_sub_of_le hlt.le + let q4 : Nat := P.q₂ - P.q₁ + let p4 : Int := P.p₂ - P.p₁ + have hq4pos : 0 < q4 := by dsimp [q4]; omega + have hq4lt : q4 < P.q₂ := by dsimp [q4]; omega + have hq4cast : (P.q₂ : Int) = (P.q₁ : Int) + (q4 : Int) := by + dsimp [q4] + rw [Nat.cast_sub hlt.le] + omega + have hdet4a : P.p₁ * (q4 : Int) - p4 * (P.q₁ : Int) = 1 := by + calc + P.p₁ * (q4 : Int) - p4 * (P.q₁ : Int) = + P.p₁ * (q4 : Int) - (P.p₂ - P.p₁) * (P.q₁ : Int) := by rfl + _ = P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) := by rw [hq4cast]; ring + _ = 1 := hcross + have hdet4b : p4 * (P.q₂ : Int) - (q4 : Int) * P.p₂ = -1 := by + calc + p4 * (P.q₂ : Int) - (q4 : Int) * P.p₂ = + P.p₂ * ((P.q₂ : Int) - (q4 : Int)) - P.p₁ * (P.q₂ : Int) := by dsimp [p4]; ring + _ = P.p₂ * (P.q₁ : Int) - P.p₁ * (P.q₂ : Int) := by rw [hq4cast]; ring + _ = -(P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int)) := by ring + _ = -1 := by rw [hcross] + have hred4 : Nat.Coprime q4 p4.natAbs := by + have hdvd : (Int.gcd (q4 : Int) p4 : Int) ∣ (1 : Int) := by + have hga : (Int.gcd (q4 : Int) p4 : Int) ∣ p4 := Int.gcd_dvd_right _ _ + have hgb : (Int.gcd (q4 : Int) p4 : Int) ∣ (q4 : Int) := Int.gcd_dvd_left _ _ + have hdiv : (Int.gcd (q4 : Int) p4 : Int) ∣ + P.p₁ * (q4 : Int) - p4 * (P.q₁ : Int) := + dvd_sub (dvd_mul_of_dvd_right hgb _) (dvd_mul_of_dvd_left hga _) + rw [hdet4a] at hdiv + exact hdiv + have hn : Int.natAbs (Int.gcd (q4 : Int) p4) = 1 := + Int.isUnit_iff_natAbs_eq.mp (isUnit_of_dvd_one hdvd) + simpa [Int.gcd] using hn + obtain ⟨P₄, hP₄, _⟩ := FordFareyParentsExist p4 q4 hq4pos hred4 + let T : FordFareyParameter := { + p := P₂.p, q := P₂.q, q_pos := P₂.q_pos, reduced := P₂.reduced, + p₁ := P₁.p, q₁ := P₁.q, p₂ := p4, q₂ := q4, + sum_p := by dsimp [p4]; rw [hp1, hp2]; have hs := P.sum_p; omega, + sum_q := by dsimp [q4]; rw [hq1, hq2]; have hs := P.sum_q; omega, + det₁ := by rw [hp1, hq1, hp2, hq2]; simpa [mul_comm] using hcross, + det₂ := by dsimp [p4]; rw [hp2, hq2]; exact hdet4b, + q₁_lt := by rw [hq1]; omega, + q₂_pos := hq4pos, + unit_case := by intro hu; have := hq4pos; have := P₁.q_pos; omega } + obtain ⟨W, hW, huniq⟩ := FordFareyParentsExist P₂.p P₂.q P₂.q_pos P₂.reduced + have hTP2 : T = P₂ := (huniq T ⟨rfl, rfl⟩).trans (huniq P₂ ⟨rfl, rfl⟩).symm + have hp41 : P₂.p₁ = P₁.p := by + have h := congrArg FordFareyParameter.p₁ hTP2 + simpa [T] using h.symm + have hq41 : P₂.q₁ = P₁.q := by + have h := congrArg FordFareyParameter.q₁ hTP2 + simpa [T] using h.symm + have hp42 : P₂.p₂ = p4 := by + have h := congrArg FordFareyParameter.p₂ hTP2 + simpa [T] using h.symm + have hq42 : P₂.q₂ = q4 := by + have h := congrArg FordFareyParameter.q₂ hTP2 + simpa [T] using h.symm + simp only [FordRecursiveVertexDomains] at hx2 hx3 + rcases hx2 with ⟨hx2r, hx2r', hx2i, hx2i'⟩ + rcases hx3 with ⟨hx3r, hx3r', hx3i, hx3i'⟩ + let u : GaussianInt := x - ⟨(P.q₁ : Int), 0⟩ + let v : GaussianInt := x - ⟨0, (P.q₁ : Int)⟩ + let w : GaussianInt := x - ⟨(P.q₁ : Int), (P.q₁ : Int)⟩ + have hu3 : u ∈ FordRecursiveVertexDomains P₂ 3 := by + simp only [FordRecursiveVertexDomains, Matrix.cons_val_three] + change 0 ≤ u.re ∧ u.re ≤ (P₂.q₂ : Int) ∧ + (P₂.q₁ : Int) ≤ u.im ∧ u.im ≤ (P₂.q : Int) + rw [hq42, hq41, hq2, hq1] + simp [u, sub_eq_add_neg] + omega + have hv2 : v ∈ FordRecursiveVertexDomains P₂ 2 := by + simp only [FordRecursiveVertexDomains, Matrix.cons_val_two] + change (P₂.q₁ : Int) ≤ v.re ∧ v.re ≤ (P₂.q : Int) ∧ + 0 ≤ v.im ∧ v.im ≤ (P₂.q₂ : Int) + rw [hq41, hq42, hq2, hq1] + simp [v, sub_eq_add_neg] + omega + have hP2gt : 1 < P₂.q := by rw [hq2]; omega + have hru := hR P₂ P₁ P₄ hq2lt' hP2gt hp41.symm hq41.symm + (by exact hP₄.1.trans hp42.symm) (by exact hP₄.2.trans hq42.symm) 3 u hu3 + have hrv := hR P₂ P₁ P₄ hq2lt' hP2gt hp41.symm hq41.symm + (by exact hP₄.1.trans hp42.symm) (by exact hP₄.2.trans hq42.symm) 2 v hv2 + simp only [P5130T5Prescription, Matrix.cons_val_two, Matrix.cons_val_three] + change G P₂ u + P.p₁ * x.im = G P₂ v + P.p₁ * x.re + have hru' : G P₂ u = G P₄ (u - ⟨0, (P₁.q : Int)⟩) + P.p₁ * u.re := by + simpa [P5130T5Prescription, hp41, hq41, hp1] using hru + have hrv' : G P₂ v = G P₄ (v - ⟨(P₁.q : Int), 0⟩) + P.p₁ * v.im := by + simpa [P5130T5Prescription, hp41, hq41, hp1] using hrv + have hcomm : u - ⟨0, (P₁.q : Int)⟩ = v - ⟨(P₁.q : Int), 0⟩ := by + ext <;> simp [u, v, sub_eq_add_neg, hq1] + rw [hru', hrv'] + rw [hcomm] + simp [u, v] + ring + · by_cases hgt : P.q₁ > P.q₂ + · simp only [FordRecursiveVertexDomains] at hx2 hx3 + rcases hx2 with ⟨_, hx2r, _, hx2i⟩ + rcases hx3 with ⟨hx3r, _, hx3i, _⟩ + omega + · have hden : P.q₁ = P.q₂ := by omega + have hmul : (P.q₁ : Int) * (P.p₁ - P.p₂) = 1 := by + have hcross' := hcross + rw [← hden] at hcross' + calc + (P.q₁ : Int) * (P.p₁ - P.p₂) = P.p₁ * (P.q₁ : Int) - P.p₂ * (P.q₁ : Int) := by ring + _ = 1 := hcross' + have hdiv : (P.q₁ : Int) ∣ (1 : Int) := ⟨P.p₁ - P.p₂, hmul.symm⟩ + have hqle : (P.q₁ : Int) ≤ 1 := Int.le_of_dvd (by norm_num) hdiv + have hqone : P.q₁ = 1 := by omega + have hq2one : P.q₂ = 1 := by omega + simp only [FordRecursiveVertexDomains] at hx2 hx3 + rcases hx2 with ⟨hx2r, hx2r', hx2i, hx2i'⟩ + rcases hx3 with ⟨hx3r, hx3r', hx3i, hx3i'⟩ + have hq1int : (P.q₁ : Int) = 1 := by exact_mod_cast hqone + have hq2int : (P.q₂ : Int) = 1 := by exact_mod_cast hq2one + have hxre : x.re = 1 := by omega + have hxim : x.im = 1 := by omega + let c : GaussianInt := ⟨1, 1⟩ + have hxc : x = c := by ext <;> simp [c, hxre, hxim] + have hpone : P.p₁ = P.p₂ + 1 := by nlinarith [hmul, hqone] + have hPq : P.q = 2 := by have hs := P.sum_q; omega + have hP1q : P₁.q = 1 := by omega + have hP2q : P₂.q = 1 := by omega + let u : GaussianInt := ⟨0, 1⟩ + let v : GaussianInt := ⟨1, 0⟩ + have hc1 : G P₁ c = P₁.p := by + have hb := hB P₁ (by omega) c (by simp [c, hP1q, FordDoubledBoundary, FordVertexDomain]) + simpa [c, IntegerCeilDiv, hP1q] using hb + have hu2 : G P₂ u = 0 := by + have hb := hB P₂ (by omega) u (by simp [u, hP2q, FordDoubledBoundary, FordVertexDomain]) + simpa [u, IntegerCeilDiv] using hb + have hv2 : G P₂ v = 0 := by + have hb := hB P₂ (by omega) v (by simp [v, hP2q, FordDoubledBoundary, FordVertexDomain]) + simpa [v, IntegerCeilDiv] using hb + have hval : P₁.p = P₂.p + 1 := by omega + rw [hxc] + simp only [P5130T5Prescription, + Matrix.cons_val_two, Matrix.cons_val_three] + change G P₂ (c - ⟨(P.q₁ : Int), 0⟩) + P.p₁ * c.im = + G P₂ (c - ⟨0, (P.q₁ : Int)⟩) + P.p₁ * c.re + have hshift₂ : c - ⟨(P.q₁ : Int), 0⟩ = u := by ext <;> simp [c, u, hq1int] + have hshift₃ : c - ⟨0, (P.q₁ : Int)⟩ = v := by ext <;> simp [c, v, hq1int] + rw [hshift₂, hshift₃] + simp [c, u, v, hu2, hv2] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5UnitCase.lean b/LeanPool/ApollonianSuperharmonic/P5130T5UnitCase.lean new file mode 100644 index 0000000000..c5791a97be --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5130T5UnitCase.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P5130T5UnitCase] + +/-! +# P5130T5UnitCase + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5130T5UnitCase (P : FordFareyParameter) (hq : P.q = 1) : + let g : IntegerLatticeFunction := fun x => x.re * (x.re - 1) / 2 + P.p * x.re * x.im + (∀ x ∈ FordDoubledBoundary P.q, + g x = IntegerCeilDiv (P.p * x.re * x.im) P.q (by exact_mod_cast P.q_pos.ne')) ∧ + (∀ x, g (x + ⟨0, -(P.q : Int)⟩) = g x - P.p * x.re) ∧ + (∀ x, g (x + ⟨(P.q : Int), (P.q₁ : Int)⟩) = + g x + P.p₁ * x.re + P.p * x.im + (P.q₁ : Int) * P.p) ∧ + (∀ x, g (x + ⟨-(P.q : Int), (P.q₂ : Int)⟩) = + g x + P.p₂ * x.re - P.p * x.im - (P.q : Int) * P.p₂) := by +-- BODY + rcases P.unit_case hq with ⟨hp₁, hq₁, hp₂, hq₂⟩ + dsimp only + refine ⟨?_, ?_, ?_, ?_⟩ + · intro x hx + simp only [FordDoubledBoundary, FordVertexDomain, Set.mem_ofPred_eq, hq, + Nat.cast_one] at hx + have hre : x.re = 0 ∨ x.re = 1 := by omega + have him : x.im = 0 ∨ x.im = 1 := by omega + rcases hre with hr | hr <;> rcases him with hi | hi <;> + simp [hr, hi, IntegerCeilDiv, hq] + · intro x + simp only [Zsqrtd.re_add, Zsqrtd.im_add, hq, Nat.cast_one, add_zero] + ring + · intro x + simp only [Zsqrtd.re_add, Zsqrtd.im_add, hq, hp₁, hq₁, Nat.cast_one, + Nat.cast_zero, add_zero, one_mul, zero_mul] + have hnum : (x.re + 1) * (x.re + 1 - 1) = x.re * (x.re - 1) + 2 * x.re := by ring + rw [hnum, Int.add_mul_ediv_left _ _ (by norm_num : (2 : Int) ≠ 0)] + ring + · intro x + simp only [Zsqrtd.re_add, Zsqrtd.im_add, hq, hp₂, hq₂, Nat.cast_one] + have hnum : (x.re + -1) * (x.re + -1 - 1) = x.re * (x.re - 1) + 2 * (1 - x.re) := by ring + rw [hnum, Int.add_mul_ediv_left _ _ (by norm_num : (2 : Int) ≠ 0)] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5157T1AlternatingStaircase.lean b/LeanPool/ApollonianSuperharmonic/P5157T1AlternatingStaircase.lean new file mode 100644 index 0000000000..b499f5da12 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5157T1AlternatingStaircase.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5157T1StaircasePoint +public import Mathlib.Data.List.ChainOfFn +public import Mathlib.Data.List.FinRange + +-- [TABLET NODE: P5157T1AlternatingStaircase] + +/-! +# P5157T1AlternatingStaircase + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5157T1AlternatingStaircase (z : GaussianInt) (h : Bool) + (s : Int) (hs : s = 1 ∨ s = -1) (N : Nat) (hN : 0 < N) : + let p := P5157T1StaircasePoint z h s + Function.Injective p ∧ + SimpleGridPath {v | ∃ j ≤ N, v = p j} + {e | ∃ j < N, e = {p j, p (j + 1)}} := by +-- BODY + dsimp only + let p := P5157T1StaircasePoint z h s + have inj : Function.Injective p := by + intro a b hab + have hr := congrArg Zsqrtd.re hab + have hi := congrArg Zsqrtd.im hab + rcases hs with rfl | rfl <;> cases h <;> + simp [p, P5157T1StaircasePoint] at hr hi <;> omega + have step (j : Nat) : + p (j + 1) = p j + 1 ∨ p (j + 1) = p j - 1 ∨ + p (j + 1) = p j + ⟨0, 1⟩ ∨ p (j + 1) = p j - ⟨0, 1⟩ := by + rcases hs with rfl | rfl <;> cases h <;> + simp [p, P5157T1StaircasePoint, Zsqrtd.ext_iff] <;> omega + let l := List.ofFn (fun j : Fin (N + 1) => p j) + have hl : l.length = N + 1 := List.length_ofFn + have chain : l.IsChain (fun a b => ∃ j < N, a = p j ∧ b = p (j + 1)) := by + apply List.isChain_ofFn.mpr + intro j hj + exact ⟨j, by omega, rfl, rfl⟩ + have consecutive (a b : GaussianInt) (l₁ l₂ : List GaussianInt) + (heq : l = l₁ ++ a :: b :: l₂) : + ∃ j < N, a = p j ∧ b = p (j + 1) := + List.isChain_iff_forall_rel_of_append_cons_cons.mp chain heq + refine ⟨inj, l, List.nodup_ofFn.mpr ?_, by omega, ?_, ?_, ?_⟩ + · intro a b hab + exact Fin.ext (inj hab) + · ext v + simp only [Set.mem_ofPred_eq, Finset.mem_coe, List.mem_toFinset, l, List.mem_ofFn] + constructor + · rintro ⟨j, hj, rfl⟩ + exact ⟨⟨j, by omega⟩, rfl⟩ + · rintro ⟨j, rfl⟩ + exact ⟨j, by omega, rfl⟩ + · intro a b l₁ l₂ heq + obtain ⟨j, _, rfl, rfl⟩ := consecutive a b l₁ l₂ heq + exact step j + · intro e + constructor + · rintro ⟨j, hj, rfl⟩ + have hjl : j < l.length := by omega + have hjl' : j + 1 < l.length := by omega + refine ⟨p j, p (j + 1), l.take j, l.drop (j + 2), ?_, rfl⟩ + have hd := List.getElem_cons_drop hjl + have hd' := List.getElem_cons_drop hjl' + have heq : l = l.take j ++ l[j] :: l[j + 1] :: l.drop (j + 2) := by + rw [show j + 2 = j + 1 + 1 by omega, hd', hd, List.take_append_drop] + simpa only [l, List.getElem_ofFn] using heq + · rintro ⟨a, b, l₁, l₂, heq, rfl⟩ + obtain ⟨j, hj, rfl, rfl⟩ := consecutive a b l₁ l₂ heq + exact ⟨j, hj, rfl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5157T1DiamondSingletonIntersections.lean b/LeanPool/ApollonianSuperharmonic/P5157T1DiamondSingletonIntersections.lean new file mode 100644 index 0000000000..7ee395a45c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5157T1DiamondSingletonIntersections.lean @@ -0,0 +1,281 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5124T1BoundaryGeometry +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P5157T1DiamondSingletonIntersections] + +/-! +# P5157T1DiamondSingletonIntersections + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiamondSingletonGeometry + +private theorem translateMem (T : ProtoTile) (u z : GaussianInt) : + z ∈ (TileTranslation T u).cells ↔ z - u ∈ T.cells := by + classical + rw [(TileTranslationFormulas T u).1] + simp only [Finset.mem_image, GaussianTranslation] + constructor + · rintro ⟨w, hw, he⟩ + have hwz : w = z - u := (eq_sub_iff_add_eq).mpr he + simpa only [← hwz] using hw + · intro hz + exact ⟨z - u, hz, sub_add_cancel z u⟩ + +private theorem bounds (T : ProtoTile) (hne : T.cells.Nonempty) (lo hi : GaussianInt) + (hcells : ∀ w ∈ T.cells, + lo.re ≤ w.re ∧ w.re ≤ hi.re ∧ lo.im ≤ w.im ∧ w.im ≤ hi.im) + (v : GaussianInt) (hv : v ∈ BoundaryFootprintVertices T) : + lo.re ≤ v.re ∧ v.re ≤ hi.re + 1 ∧ lo.im ≤ v.im ∧ v.im ≤ hi.im + 1 := by + classical + rw [BoundaryFootprintVertices, ite_eq_left hne] at hv + obtain ⟨e, ⟨w, he⟩, hv⟩ := hv + rcases he with ⟨rfl, hw⟩ | ⟨rfl, hw⟩ + all_goals + simp only [Finset.mem_insert, Finset.mem_singleton] at hv + rcases hw with ⟨hw, _⟩ | ⟨_, hw⟩ <;> + have hb := hcells _ hw <;> + rcases hv with rfl | rfl <;> + (try simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, + Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one] at hb ⊢) <;> omega + +private theorem unitBounds (c v : GaussianInt) + (hv : v ∈ BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile)) : + c.re ≤ v.re ∧ v.re ≤ c.re + 1 ∧ c.im ≤ v.im ∧ v.im ≤ c.im + 1 := by + classical + have bounds (T : ProtoTile) (hne : T.cells.Nonempty) (lo hi : GaussianInt) + (hcells : ∀ w ∈ T.cells, + lo.re ≤ w.re ∧ w.re ≤ hi.re ∧ lo.im ≤ w.im ∧ w.im ≤ hi.im) + (v : GaussianInt) (hv : v ∈ BoundaryFootprintVertices T) : + lo.re ≤ v.re ∧ v.re ≤ hi.re + 1 ∧ lo.im ≤ v.im ∧ v.im ≤ hi.im + 1 := bounds T hne lo hi + hcells v hv + apply bounds _ (Finset.singleton_nonempty _) c c _ v hv + intro w hw + simpa only [Finset.mem_singleton.mp hw] using + (show c.re ≤ c.re ∧ c.re ≤ c.re ∧ c.im ≤ c.im ∧ c.im ≤ c.im from + ⟨le_rfl, le_rfl, le_rfl, le_rfl⟩) + +end DiamondSingletonGeometry + +theorem P5157T1DiamondSingletonIntersections (k : Nat) (hk : 1 < k) : + let D := DiamondTile k + let Eplus := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let Eminus := TileTranslation (DiamondTile (k - 1)) ⟨-(k : Int), 1 - (k : Int)⟩ + let a : GaussianInt := ⟨-(k : Int) - 1, (k : Int) - 1⟩ + let b : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ + let A : ProtoTile := ⟨{a}, a⟩ + let B : ProtoTile := ⟨{b}, b⟩ + (Disjoint D.cells A.cells ∧ + BoundaryFootprintVertices D ∩ BoundaryFootprintVertices A = {a + 1, a + 1 + ⟨0, 1⟩} ∧ + BoundaryFootprintEdges D ∩ BoundaryFootprintEdges A = {{a + 1, a + 1 + ⟨0, 1⟩}}) ∧ + (Disjoint Eminus.cells A.cells ∧ + BoundaryFootprintVertices Eminus ∩ BoundaryFootprintVertices A = {a, a + 1} ∧ + BoundaryFootprintEdges Eminus ∩ BoundaryFootprintEdges A = {{a, a + 1}}) ∧ + (Disjoint D.cells B.cells ∧ + BoundaryFootprintVertices D ∩ BoundaryFootprintVertices B = {b, b + ⟨0, 1⟩} ∧ + BoundaryFootprintEdges D ∩ BoundaryFootprintEdges B = {{b, b + ⟨0, 1⟩}}) ∧ + (Disjoint Eplus.cells B.cells ∧ + BoundaryFootprintVertices Eplus ∩ BoundaryFootprintVertices B = {b, b + 1} ∧ + BoundaryFootprintEdges Eplus ∩ BoundaryFootprintEdges B = {{b, b + 1}}) := by +-- BODY + classical + dsimp only + let D := DiamondTile k + let Eplus := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let Eminus := TileTranslation (DiamondTile (k - 1)) ⟨-(k : Int), 1 - (k : Int)⟩ + let a : GaussianInt := ⟨-(k : Int) - 1, (k : Int) - 1⟩ + let b : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ + have translateMem (T : ProtoTile) (u z : GaussianInt) : + z ∈ (TileTranslation T u).cells ↔ z - u ∈ T.cells := DiamondSingletonGeometry.translateMem + T u z + have dcell (z : GaussianInt) := (P4194T1DiamondCellRows k z).1 + have ecell (z : GaussianInt) := (P4194T1DiamondCellRows (k - 1) z).1 + have da : a ∉ D.cells := by + change a ∉ DiamondCellDomain k + rw [dcell] + simp only [a] + omega + have db : b ∉ D.cells := by + change b ∉ DiamondCellDomain k + rw [dcell] + simp only [b] + omega + have dma : a ∉ Eminus.cells := by + rw [translateMem] + change a - ⟨-(k : Int), 1 - (k : Int)⟩ ∉ DiamondCellDomain (k - 1) + rw [ecell] + simp [a] + omega + have dpb : b ∉ Eplus.cells := by + rw [translateMem] + change b - ⟨(k : Int), 1 - (k : Int)⟩ ∉ DiamondCellDomain (k - 1) + rw [ecell] + simp [b] + omega + have dleft : a + 1 ∈ D.cells := by + change a + 1 ∈ DiamondCellDomain k + rw [dcell] + simp [a] + omega + have dright : b - 1 ∈ D.cells := by + change b - 1 ∈ DiamondCellDomain k + rw [dcell] + simp [b] + omega + have emtop : a - ⟨0, 1⟩ ∈ Eminus.cells := by + rw [translateMem] + change a - ⟨0, 1⟩ - ⟨-(k : Int), 1 - (k : Int)⟩ ∈ DiamondCellDomain (k - 1) + rw [ecell] + simp [a] + omega + have eptop : b - ⟨0, 1⟩ ∈ Eplus.cells := by + rw [translateMem] + change b - ⟨0, 1⟩ - ⟨(k : Int), 1 - (k : Int)⟩ ∈ DiamondCellDomain (k - 1) + rw [ecell] + simp [b] + omega + have bounds (T : ProtoTile) (hne : T.cells.Nonempty) (lo hi : GaussianInt) + (hcells : ∀ w ∈ T.cells, + lo.re ≤ w.re ∧ w.re ≤ hi.re ∧ lo.im ≤ w.im ∧ w.im ≤ hi.im) + (v : GaussianInt) (hv : v ∈ BoundaryFootprintVertices T) : + lo.re ≤ v.re ∧ v.re ≤ hi.re + 1 ∧ lo.im ≤ v.im ∧ v.im ≤ hi.im + 1 := + DiamondSingletonGeometry.bounds T hne lo hi hcells v hv + have unitBounds (c v : GaussianInt) + (hv : v ∈ BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile)) : + c.re ≤ v.re ∧ v.re ≤ c.re + 1 ∧ c.im ≤ v.im ∧ v.im ≤ c.im + 1 := + DiamondSingletonGeometry.unitBounds c v hv + have dBounds (v : GaussianInt) (hv : v ∈ BoundaryFootprintVertices D) : + -(k : Int) ≤ v.re ∧ v.re ≤ (k : Int) := by + have hb := bounds D ⟨_, dleft⟩ ⟨-(k : Int), 0⟩ + ⟨(k : Int) - 1, 2 * (k : Int) - 1⟩ (by + intro w hw + have hh := (dcell w).mp hw + dsimp + omega) v hv + exact ⟨hb.1, by simpa using hb.2.1⟩ + have eBounds (u : GaussianInt) (hu : u.im = 1 - (k : Int)) (v : GaussianInt) + (hv : v ∈ BoundaryFootprintVertices (TileTranslation (DiamondTile (k - 1)) u)) : + v.im ≤ (k : Int) - 1 := by + have ht : (TileTranslation (DiamondTile (k - 1)) u).cells.Nonempty := by + refine ⟨u, (translateMem _ _ _).mpr ?_⟩ + change u - u ∈ DiamondCellDomain (k - 1) + rw [sub_self, ecell] + norm_num + omega + have hb := bounds _ ht ⟨u.re - 2 * (k : Int), 1 - (k : Int)⟩ + ⟨u.re + 2 * (k : Int), (k : Int) - 2⟩ (by + intro w hw + have hh := (ecell (w - u)).mp ((translateMem _ _ _).mp hw) + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, hu] at hh + dsimp + omega) v hv + have hh := hb.2.2.2 + dsimp at hh + omega + have finish (T : ProtoTile) (c x y : GaussianInt) (hc : c ∉ T.cells) + (hxy : x ≠ y) (hT : {x, y} ∈ BoundaryFootprintEdges T) + (hU : {x, y} ∈ BoundaryFootprintEdges (⟨{c}, c⟩ : ProtoTile)) + (hsub : ∀ v, v ∈ BoundaryFootprintVertices T → + v ∈ BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) → v = x ∨ v = y) : + Disjoint T.cells (⟨{c}, c⟩ : ProtoTile).cells ∧ + BoundaryFootprintVertices T ∩ BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) = {x, y} ∧ + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges (⟨{c}, c⟩ : ProtoTile) = {{x, y}} := by + have hne : T.cells.Nonempty := by + obtain ⟨w, ⟨_, hw⟩ | ⟨_, hw⟩⟩ := hT + all_goals rcases hw with ⟨hw, _⟩ | ⟨_, hw⟩ <;> exact ⟨_, hw⟩ + have endpoint (U : ProtoTile) (hU : U.cells.Nonempty) (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges U) (v : GaussianInt) (hv : v ∈ e) : + v ∈ BoundaryFootprintVertices U := by + rw [BoundaryFootprintVertices, ite_eq_left hU] + exact ⟨e, he, hv⟩ + have hvertices : BoundaryFootprintVertices T ∩ + BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) = {x, y} := by + ext v + constructor + · intro hv + exact hsub v hv.1 hv.2 + · intro hv + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hv + have hve : v ∈ ({x, y} : Finset GaussianInt) := by simpa using hv + exact ⟨endpoint T hne _ hT v hve, + endpoint _ (Finset.singleton_nonempty c) _ hU v hve⟩ + refine ⟨Finset.disjoint_singleton_right.mpr hc, hvertices, ?_⟩ + ext e + constructor + · intro he + have hcard : e.card = 2 := by + obtain ⟨w, ⟨rfl, _⟩ | ⟨rfl, _⟩⟩ := he.1 + all_goals simp [Zsqrtd.ext_iff] + have hsubset : e ⊆ {x, y} := by + intro v hv + have hv' : v ∈ BoundaryFootprintVertices T ∩ + BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) := + ⟨endpoint T hne e he.1 v hv, + endpoint _ (Finset.singleton_nonempty c) e he.2 v hv⟩ + rw [hvertices] at hv' + simpa using hv' + have heq : e = {x, y} := Finset.eq_of_subset_of_card_le hsubset (by simp [hxy, hcard]) + exact Set.mem_singleton_iff.mpr heq + · rintro rfl + exact ⟨hT, hU⟩ + have unitBottom (c : GaussianInt) : + {c, c + 1} ∈ BoundaryFootprintEdges (⟨{c}, c⟩ : ProtoTile) := by + refine ⟨c, Or.inl ⟨rfl, Or.inl ⟨by simp, ?_⟩⟩⟩ + simp [Zsqrtd.ext_iff] + have unitLeft (c : GaussianInt) : + {c, c + ⟨0, 1⟩} ∈ BoundaryFootprintEdges (⟨{c}, c⟩ : ProtoTile) := by + refine ⟨c, Or.inr ⟨rfl, Or.inl ⟨by simp, ?_⟩⟩⟩ + simp [] + have unitRight (c : GaussianInt) : + {c + 1, c + 1 + ⟨0, 1⟩} ∈ BoundaryFootprintEdges (⟨{c}, c⟩ : ProtoTile) := by + refine ⟨c + 1, Or.inr ⟨rfl, Or.inr ⟨?_, by simp⟩⟩⟩ + simp [] + refine ⟨finish D a (a + 1) (a + 1 + ⟨0, 1⟩) da (by simp [Zsqrtd.ext_iff]) + ?_ (unitRight a) ?_, + finish Eminus a a (a + 1) dma (by simp []) + ?_ (unitBottom a) ?_, + finish D b b (b + ⟨0, 1⟩) db (by simp [Zsqrtd.ext_iff]) + ?_ (unitLeft b) ?_, + finish Eplus b b (b + 1) dpb (by simp []) + ?_ (unitBottom b) ?_⟩ + · exact ⟨a + 1, Or.inr ⟨rfl, Or.inl ⟨dleft, by simpa using da⟩⟩⟩ + · intro v hv hu + have ht := dBounds v hv + have hh := unitBounds a v hu + simp [a, Zsqrtd.ext_iff] at hh ⊢ + omega + · exact ⟨a, Or.inl ⟨rfl, Or.inr ⟨dma, emtop⟩⟩⟩ + · intro v hv hu + have ht := eBounds _ rfl v hv + have hh := unitBounds a v hu + simp [a, Zsqrtd.ext_iff] at hh ⊢ + omega + · exact ⟨b, Or.inr ⟨rfl, Or.inr ⟨db, dright⟩⟩⟩ + · intro v hv hu + have ht := dBounds v hv + have hh := unitBounds b v hu + simp [b, Zsqrtd.ext_iff] at hh ⊢ + omega + · exact ⟨b, Or.inl ⟨rfl, Or.inr ⟨dpb, eptop⟩⟩⟩ + · intro v hv hu + have ht := eBounds _ rfl v hv + have hh := unitBounds b v hu + simp [b, Zsqrtd.ext_iff] at hh ⊢ + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5157T1DiamondStaircaseIntersections.lean b/LeanPool/ApollonianSuperharmonic/P5157T1DiamondStaircaseIntersections.lean new file mode 100644 index 0000000000..2d82da1c2b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5157T1DiamondStaircaseIntersections.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5250T1SeparatedCells +public import LeanPool.ApollonianSuperharmonic.P5250T1CommonVertices +public import LeanPool.ApollonianSuperharmonic.P5250T1ConsecutiveEdges +public import LeanPool.ApollonianSuperharmonic.P5250T1RankedCommonEdges + +-- [TABLET NODE: P5157T1DiamondStaircaseIntersections] + +/-! +# P5157T1DiamondStaircaseIntersections + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5157T1DiamondStaircaseIntersections (k : Nat) (hk : 1 < k) : + let D := DiamondTile k + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + let Eplus := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let Eminus := TileTranslation (DiamondTile (k - 1)) ⟨-(k : Int), 1 - (k : Int)⟩ + let N := 2 * (k - 1) + let p := P5157T1StaircasePoint 1 false 1 + let q := P5157T1StaircasePoint 1 false (-1) + let r := P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) + (Disjoint D.cells Eplus.cells ∧ + BoundaryFootprintVertices D ∩ BoundaryFootprintVertices Eplus = + {v | ∃ j ≤ N, v = p j} ∧ + BoundaryFootprintEdges D ∩ BoundaryFootprintEdges Eplus = + {e | ∃ j < N, e = {p j, p (j + 1)}}) ∧ + (Disjoint L.cells Eplus.cells ∧ + BoundaryFootprintVertices L ∩ BoundaryFootprintVertices Eplus = + {v | ∃ j ≤ N, v = q j} ∧ + BoundaryFootprintEdges L ∩ BoundaryFootprintEdges Eplus = + {e | ∃ j < N, e = {q j, q (j + 1)}}) ∧ + (Disjoint D.cells Eminus.cells ∧ + BoundaryFootprintVertices D ∩ BoundaryFootprintVertices Eminus = + {v | ∃ j ≤ N, v = r j} ∧ + BoundaryFootprintEdges D ∩ BoundaryFootprintEdges Eminus = + {e | ∃ j < N, e = {r j, r (j + 1)}}) := by +-- BODY + classical + have ne (m : Nat) (hm : 0 < m) : (DiamondTile m).cells.Nonempty := by + refine ⟨0, (P4194T1DiamondCellRows m 0).1.mpr ?_⟩ + norm_num + omega + have neTr (m : Nat) (hm : 0 < m) (u : GaussianInt) : + (TileTranslation (DiamondTile m) u).cells.Nonempty := by + rw [(TileTranslationFormulas (DiamondTile m) u).1] + exact (ne m hm).image _ + have edges (X Y : ProtoTile) (hX : X.cells.Nonempty) (hY : Y.cells.Nonempty) + (f : Nat → GaussianInt) (N : Nat) (s c : Int) (hs : s = 1 ∨ s = -1) + (hV : BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y = + {v | ∃ j ≤ N, v = f j}) + (hE : ∀ j < N, ({f j, f (j + 1)} : Finset GaussianInt) ∈ + BoundaryFootprintEdges X ∩ BoundaryFootprintEdges Y) + (hrank : ∀ j ≤ N, (f j).re + s * (f j).im + c = (j : Int)) : + BoundaryFootprintEdges X ∩ BoundaryFootprintEdges Y = + {e | ∃ j < N, e = {f j, f (j + 1)}} := by + apply Set.Subset.antisymm + · exact P5250T1RankedCommonEdges X Y hX hY f N s c hs hV hrank + · rintro e ⟨j, hj, rfl⟩ + exact hE j hj + have disj := P5250T1SeparatedCells k hk + have vertices := P5250T1CommonVertices k hk + have actual := P5250T1ConsecutiveEdges k hk + dsimp only at disj vertices actual ⊢ + refine ⟨⟨disj.1, vertices.1, ?_⟩, + ⟨disj.2.1, vertices.2.1, ?_⟩, ⟨disj.2.2, vertices.2.2, ?_⟩⟩ + · apply edges _ _ (ne k (by omega)) (neTr (k - 1) (by omega) _) + _ _ 1 (-1) (Or.inl rfl) vertices.1 actual.1 + intro j hj + simp [P5157T1StaircasePoint] + omega + · apply edges _ _ (neTr k (by omega) _) (neTr (k - 1) (by omega) _) + _ _ (-1) (-1) (Or.inr rfl) vertices.2.1 actual.2.1 + intro j hj + simp [P5157T1StaircasePoint] + omega + · apply edges _ _ (ne k (by omega)) (neTr (k - 1) (by omega) _) + _ _ (-1) (2 * (k : Int) - 1) (Or.inr rfl) vertices.2.2 actual.2.2 + intro j hj + simp [P5157T1StaircasePoint] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5157T1StaircasePoint.lean b/LeanPool/ApollonianSuperharmonic/P5157T1StaircasePoint.lean new file mode 100644 index 0000000000..810b25c7a0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5157T1StaircasePoint.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath + +-- [TABLET NODE: P5157T1StaircasePoint] + +/-! +# P5157T1StaircasePoint + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a Gaussian integer $z$, a Boolean $h$, an integer $s$, and $j\geq0$, put +$$ + p(z,h,s,j)= + \begin{cases} + z+(\lceil j/2\rceil,s\lfloor j/2\rfloor),&h=\mathrm{true},\\ + z+(\lfloor j/2\rfloor,s\lceil j/2\rceil),&h=\mathrm{false}. + \end{cases} +$$ +Thus, when $s=\pm1$, the staircase alternates a rightward unit step +and a vertical step of sign $s$, starting horizontally exactly when $h$ is true. +-/ +def P5157T1StaircasePoint (z : GaussianInt) (horizontalFirst : Bool) + (s : Int) (j : Nat) : GaussianInt := +-- BODY + z + ⟨(if horizontalFirst then (j + 1) / 2 else j / 2 : Nat), + s * (if horizontalFirst then j / 2 else (j + 1) / 2 : Nat)⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1CeilingBelow.lean b/LeanPool/ApollonianSuperharmonic/P5188T1CeilingBelow.lean new file mode 100644 index 0000000000..b467beb50c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5188T1CeilingBelow.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P5188T1CeilingBelow] + +/-! +# P5188T1CeilingBelow + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5188T1CeilingBelow (K E q : Int) (hq : 0 < q) (hE : 0 ≤ E) (hEq : E < q) : + IntegerCeilDiv (K * q - E) q (by omega) = K := by +-- BODY + dsimp only [IntegerCeilDiv] + have he : -(K * q - E) = E + (-K) * q := by ring + rw [he, show E + (-K) * q = (-K) * q + E by ring, + Int.mul_add_ediv_right _ _ hq.ne'] + have hdiv : E / q = 0 := Int.ediv_eq_zero_of_lt hE (by omega) + simp [hdiv] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1CeilingShift.lean b/LeanPool/ApollonianSuperharmonic/P5188T1CeilingShift.lean new file mode 100644 index 0000000000..ec49e5b196 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5188T1CeilingShift.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P5188T1CeilingShift] + +/-! +# P5188T1CeilingShift + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5188T1CeilingShift (M C q : Int) (hq : q ≠ 0) : + IntegerCeilDiv (M + C * q) q (by omega) = + IntegerCeilDiv M q (by omega) + C := by +-- BODY + dsimp only [IntegerCeilDiv] + have he : -(M + C * q) = (-M) + (-C) * q := by ring + rw [he, show (-M) + (-C) * q = (-M) + q * (-C) by ring, + Int.add_mul_ediv_left _ _ hq] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1CeilingStability.lean b/LeanPool/ApollonianSuperharmonic/P5188T1CeilingStability.lean new file mode 100644 index 0000000000..9d2092d59e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5188T1CeilingStability.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P5188T1CeilingStability] + +/-! +# P5188T1CeilingStability + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5188T1CeilingStability (N M d q E : Int) (hd : 0 < d) (hdq : d < q) + (hE0 : 0 ≤ E) (hEd : E ≤ d) (hrel : M * d = N * q - E) : + IntegerCeilDiv M q (by omega) = IntegerCeilDiv N d (by omega) := by +-- BODY + let k := N / d + let r := N % d + have hdecomp : N = d * k + r := by + dsimp [k, r] + have := Int.mul_ediv_add_emod N d + nlinarith + have hr0 : 0 ≤ r := Int.emod_nonneg _ (by omega) + have hrd : r < d := Int.emod_lt_of_pos _ hd + by_cases hr : r = 0 + · have hMlo : k * q - q < M := by + have := hrel + rw [hdecomp, hr] at this + nlinarith [hdq, hd] + have hMhi : M ≤ k * q := by + rw [hdecomp, hr] at hrel + nlinarith [hEd, hE0] + have hdivN : (-N) / d = -k := by + rw [Int.ediv_eq_iff_of_pos hd] + rw [hdecomp, hr] + constructor <;> nlinarith + have hdivM : (-M) / q = -k := by + rw [Int.ediv_eq_iff_of_pos (by omega)] + constructor <;> nlinarith [hMlo, hMhi] + change -((-M) / q) = -((-N) / d) + rw [hdivM, hdivN] + · have hrpos : 0 < r := by omega + have hdivN : (-N) / d = -(k + 1) := by + rw [Int.ediv_eq_iff_of_pos hd] + rw [hdecomp] + constructor <;> nlinarith [hrpos, hrd] + have hMlo : k * q < M := by + rw [hdecomp] at hrel + nlinarith [hdq, hrpos, hEd] + have hMhi : M < k * q + q := by + rw [hdecomp] at hrel + nlinarith [hdq, hrpos, hrd, hEd] + have hdivM : (-M) / q = -(k + 1) := by + rw [Int.ediv_eq_iff_of_pos (by omega)] + constructor <;> nlinarith [hMlo, hMhi] + change -((-M) / q) = -((-N) / d) + rw [hdivM, hdivN] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1E1Boundary.lean b/LeanPool/ApollonianSuperharmonic/P5188T1E1Boundary.lean new file mode 100644 index 0000000000..5db1bb0425 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5188T1E1Boundary.lean @@ -0,0 +1,176 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingStability +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingBelow +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P5188T1E1Boundary] + +/-! +# P5188T1E1Boundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5188T1E1Boundary (P P₁ : FordFareyParameter) + (hq : 1 < P.q) (hp₁ : P₁.p = P.p₁) (hq₁ : P₁.q = P.q₁) + (g₁ : IntegerLatticeFunction) + (h₁ : ∀ x ∈ FordDoubledBoundary P₁.q, + g₁ x = IntegerCeilDiv (P₁.p * x.re * x.im) P₁.q (by exact_mod_cast P₁.q_pos.ne')) + (x : GaussianInt) + (hdom : 0 ≤ x.re ∧ x.re ≤ (P.q₁ : Int) ∧ 0 ≤ x.im ∧ x.im ≤ (P.q₁ : Int)) + (hbd : x ∈ FordDoubledBoundary P.q) : + g₁ x = + IntegerCeilDiv (P.p * x.re * x.im) P.q (by exact_mod_cast P.q_pos.ne') := by +-- BODY + have hsum : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q + have hps : P.p = P.p₁ + P.p₂ := P.sum_p + have hcross := (P5130T5ParentArithmetic P hq).2.2.2.2.2.2 + have hdet₁ := P.det₁ + have hdet₂ := P.det₂ + have hqpos : 0 < (P.q : Int) := by exact_mod_cast P.q_pos + have ha : 0 < (P.q₁ : Int) := by have := (P5130T5ParentArithmetic P hq).1; exact_mod_cast this + have hb : 0 < (P.q₂ : Int) := by have := P.q₂_pos; exact_mod_cast this + have hab : (P.q₁ : Int) < P.q := by have := P.q₁_lt; exact_mod_cast this + have hbb : (P.q₂ : Int) < P.q := by rw [hsum]; omega + let a : Int := P.q₁ + let b : Int := P.q₂ + let A : Int := P.p₁ + let D : Int := P.p₂ + have haq : a + b = P.q := by dsimp [a, b]; exact hsum.symm + have hpq : A + D = P.p := by dsimp [A, D]; exact hps.symm + have hAq : A * P.q - a * P.p = 1 := by simpa [a, A] using hdet₁ + have hpqa : P.p * a = A * P.q - 1 := by + have haux : A * P.q - P.p * a = 1 := by + rw [mul_comm P.p a] + exact hAq + omega + have hDq : D * P.q - b * P.p = -1 := by simpa [b, D] using hdet₂ + have hAB : A * b - D * a = 1 := by simpa [a, b, A, D] using hcross + have ceilPerturb := P5188T1CeilingStability + have ceilBelow := P5188T1CeilingBelow + have ceilMul (c t d : Int) (hd : d ≠ 0) : + IntegerCeilDiv (c * d * t) d (by omega) = c * t := by + dsimp only [IntegerCeilDiv] + have he : -(c * d * t) = d * (-c * t) := by ring + rw [he, Int.mul_ediv_cancel_left _ hd] + ring + have g₁val (u v : Int) (hu0 : 0 ≤ u) (hu : u ≤ a) + (hv0 : 0 ≤ v) (hv : v ≤ a) + (hs : u = 0 ∨ u = 1 ∨ u = a - 1 ∨ u = a ∨ + v = 0 ∨ v = 1 ∨ v = a - 1 ∨ v = a) : + g₁ ⟨u, v⟩ = IntegerCeilDiv (A * u * v) a (by omega) := by + have hbd : (⟨u, v⟩ : GaussianInt) ∈ FordDoubledBoundary P₁.q := by + change (0 ≤ u ∧ u ≤ (P₁.q : Int) ∧ 0 ≤ v ∧ v ≤ (P₁.q : Int)) ∧ _ + refine ⟨⟨hu0, ?_, hv0, ?_⟩, ?_⟩ + · simpa [a, hq₁] using hu + · simpa [a, hq₁] using hv + intro hi + simp at hi + rcases hs with h | h | h | h | h | h | h | h <;> omega + simpa [a, A, hp₁, hq₁] using h₁ ⟨u, v⟩ hbd + have hbox : x ∈ FordVertexDomain P.q := hbd.1 + have hside : x.re = 0 ∨ x.re = 1 ∨ x.re = (P.q : Int) - 1 ∨ x.re = P.q ∨ + x.im = 0 ∨ x.im = 1 ∨ x.im = (P.q : Int) - 1 ∨ x.im = P.q := by + change x ∈ FordVertexDomain P.q ∧ _ at hbd + rcases hbd with ⟨_, hn⟩ + simp only [FordVertexDomain] at hbox + rcases hbox with ⟨hr0, hrq, hi0, hiq⟩ + by_contra hnside + push Not at hnside + apply hn + exact ⟨by omega, by omega, by omega, by omega⟩ + change (0 ≤ x.re ∧ x.re ≤ P.q₁ ∧ 0 ≤ x.im ∧ x.im ≤ P.q₁) at hdom + change g₁ x = IntegerCeilDiv (P.p * x.re * x.im) P.q _ + have hE1side : x.re = 0 ∨ x.re = 1 ∨ x.re = P.q - 1 ∨ + x.im = 0 ∨ x.im = 1 ∨ x.im = P.q - 1 := by + rcases hside with hr | hr | hr | hr | hi | hi | hi | hi + · exact Or.inl hr + · exact Or.inr (Or.inl hr) + · exact Or.inr (Or.inr (Or.inl hr)) + · omega + · exact Or.inr (Or.inr (Or.inr (Or.inl hi))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl hi)))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr hi)))) + · omega + rcases hE1side with hr0 | hr1 | hrq | hi0 | hi1 | hiq + · have hx : x = ⟨0, x.im⟩ := by ext <;> simp [hr0] + rw [hx] + change g₁ ⟨0, x.im⟩ = IntegerCeilDiv (P.p * 0 * x.im) P.q _ + rw [g₁val 0 x.im (by omega) (by omega) (by omega) (by omega) + (Or.inl rfl)] + simp [IntegerCeilDiv] + · have hx : x = ⟨1, x.im⟩ := by ext <;> simp [hr1] + rw [hx] + change g₁ ⟨1, x.im⟩ = IntegerCeilDiv (P.p * 1 * x.im) P.q _ + rw [g₁val 1 x.im (by omega) (by omega) (by omega) (by omega) + (Or.inr (Or.inl rfl))] + have hrel : (P.p * x.im) * a = (A * x.im) * P.q - x.im := by + calc + (P.p * x.im) * a = (P.p * a) * x.im := by ring + _ = (A * P.q - 1) * x.im := by rw [hpqa] + _ = (A * x.im) * P.q - x.im := by ring + simpa only [mul_one] using (ceilPerturb (A * x.im) (P.p * x.im) a P.q x.im ha hab + (by omega) (by omega) hrel).symm + · have hb1 : b = 1 := by omega + have hra : x.re = a := by omega + have hx : x = ⟨a, x.im⟩ := by ext <;> simp [hra] + rw [hx] + change g₁ ⟨a, x.im⟩ = IntegerCeilDiv (P.p * a * x.im) P.q _ + rw [g₁val a x.im (by omega) (by omega) (by omega) (by omega) + (Or.inr (Or.inr (Or.inr (Or.inl rfl))))] + have hnum : P.p * a * x.im = (A * x.im) * P.q - x.im := by + rw [hpqa] + ring + rw [hnum, ceilBelow (A * x.im) x.im P.q hqpos (by omega) (by omega)] + simpa [mul_assoc, mul_left_comm, mul_comm] using ceilMul A x.im a (by omega) + · have hx : x = ⟨x.re, 0⟩ := by ext <;> simp [hi0] + rw [hx] + change g₁ ⟨x.re, 0⟩ = IntegerCeilDiv (P.p * x.re * 0) P.q _ + rw [g₁val x.re 0 (by omega) (by omega) (by omega) (by omega) + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl)) )))] + simp [IntegerCeilDiv] + · have hx : x = ⟨x.re, 1⟩ := by ext <;> simp [hi1] + rw [hx] + change g₁ ⟨x.re, 1⟩ = IntegerCeilDiv (P.p * x.re * 1) P.q _ + rw [g₁val x.re 1 (by omega) (by omega) (by omega) (by omega) + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl)) ))))] + have hrel : (P.p * x.re) * a = (A * x.re) * P.q - x.re := by + calc + (P.p * x.re) * a = (P.p * a) * x.re := by ring + _ = (A * P.q - 1) * x.re := by rw [hpqa] + _ = (A * x.re) * P.q - x.re := by ring + simpa only [mul_one] using (ceilPerturb (A * x.re) (P.p * x.re) a P.q x.re ha hab + (by omega) (by omega) hrel).symm + · have hb1 : b = 1 := by omega + have hia : x.im = a := by omega + have hx : x = ⟨x.re, a⟩ := by ext <;> simp [hia] + rw [hx] + change g₁ ⟨x.re, a⟩ = IntegerCeilDiv (P.p * x.re * a) P.q _ + rw [g₁val x.re a (by omega) (by omega) (by omega) (by omega) + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr rfl)))))))] + have hnum : P.p * x.re * a = (A * x.re) * P.q - x.re := by + calc + P.p * x.re * a = (P.p * a) * x.re := by ring + _ = (A * P.q - 1) * x.re := by rw [hpqa] + _ = (A * x.re) * P.q - x.re := by ring + rw [hnum] + rw [ceilBelow (A * x.re) x.re P.q hqpos (by omega) (by omega)] + simpa [mul_assoc, mul_left_comm, mul_comm] using ceilMul A x.re a (by omega) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean b/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean new file mode 100644 index 0000000000..26879b464b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean @@ -0,0 +1,524 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingStability +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingBelow +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift +public import Mathlib.Tactic.LinearCombination + +-- [TABLET NODE: P5188T1E2Boundary] + +/-! +# P5188T1E2Boundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SecondEdgeBoundaryConstruction + +private theorem hsum (P : FordFareyParameter) : (P.q : Int) = P.q₁ + P.q₂ := by + classical + exact_mod_cast P.sum_q + +private theorem hps (P : FordFareyParameter) : P.p = P.p₁ + P.p₂ := by + classical + exact P.sum_p + +private theorem hcross (P : FordFareyParameter) (hq : 1 < P.q) : P.p₁ * (↑P.q₂ : ℤ) - P.p₂ * + (↑P.q₁ : ℤ) = 1 := by + classical + exact (P5130T5ParentArithmetic P hq).2.2.2.2.2.2 + +private theorem hdet₁ (P : FordFareyParameter) : P.p₁ * (↑P.q : ℤ) - (↑P.q₁ : ℤ) * P.p = 1 := by + classical + exact P.det₁ + +private theorem hdet₂ (P : FordFareyParameter) : P.p₂ * (↑P.q : ℤ) - (↑P.q₂ : ℤ) * P.p = -1 := by + classical + exact P.det₂ + +private theorem hqpos (P : FordFareyParameter) : 0 < (P.q : Int) := by + classical + exact_mod_cast P.q_pos + +private theorem ha (P : FordFareyParameter) (hq : 1 < P.q) : 0 < (P.q₁ : Int) := by + classical + have := (P5130T5ParentArithmetic P hq).1; exact_mod_cast this + +private theorem hb (P : FordFareyParameter) : 0 < (P.q₂ : Int) := by + classical + have := P.q₂_pos; exact_mod_cast this + +private theorem hab (P : FordFareyParameter) : (P.q₁ : Int) < P.q := by + classical + have := P.q₁_lt; exact_mod_cast this + +private theorem hbb (P : FordFareyParameter) (hsum : + (↑P.q : ℤ) = (↑P.q₁ : ℤ) + (↑P.q₂ : ℤ)) (ha : 0 < (↑P.q₁ : ℤ)) : (P.q₂ : Int) < P.q := by + classical + rw [hsum]; omega + +private noncomputable abbrev a (P : FordFareyParameter) : Int := by + classical + let a : Int := P.q₁ + exact a + +private noncomputable abbrev b (P : FordFareyParameter) : Int := by + classical + let b : Int := P.q₂ + exact b + +private noncomputable abbrev A (P : FordFareyParameter) : Int := by + classical + let A : Int := P.p₁ + exact A + +private noncomputable abbrev D (P : FordFareyParameter) : Int := by + classical + let D : Int := P.p₂ + exact D + +private theorem haq (P : FordFareyParameter) (hsum : (↑P.q : ℤ) = (↑P.q₁ : ℤ) + (↑P.q₂ : ℤ)) : (a + P) + (b P) = P.q := by + classical + let a : Int := P.q₁ + let b : Int := P.q₂ + change (a + b = P.q) + dsimp [a, b]; exact hsum.symm + +private theorem hpq (P : FordFareyParameter) (hps : P.p = P.p₁ + P.p₂) : (A P) + (D P) = P.p := by + classical + let A : Int := P.p₁ + let D : Int := P.p₂ + change (A + D = P.p) + dsimp [A, D]; exact hps.symm + +private theorem hAq (P : FordFareyParameter) (hdet₁ : P.p₁ * (↑P.q : ℤ) - (↑P.q₁ : ℤ) * P.p = 1) + : (A P) * P.q - (a P) * P.p = 1 := by + classical + let a : Int := P.q₁ + let A : Int := P.p₁ + change (A * P.q - a * P.p = 1) + simpa [a, A] using hdet₁ + +private theorem hpqa (P : FordFareyParameter) (hAq : + (A P) * (↑P.q : ℤ) - (a P) * P.p = 1) : P.p * (a P) = (A P) * P.q - 1 := by + classical + let a : Int := P.q₁ + let A : Int := P.p₁ + change (A * (↑P.q : ℤ) - a * P.p = 1) at hAq + change (P.p * a = A * P.q - 1) + have haux : A * P.q - P.p * a = 1 := by + rw [mul_comm P.p a] + exact hAq + omega + +private theorem hDq (P : FordFareyParameter) (hdet₂ : P.p₂ * (↑P.q : ℤ) - (↑P.q₂ : ℤ) * P.p = -1) + : (D P) * P.q - (b P) * P.p = -1 := by + classical + let b : Int := P.q₂ + let D : Int := P.p₂ + change (D * P.q - b * P.p = -1) + simpa [b, D] using hdet₂ + +private theorem hAB (P : FordFareyParameter) (hcross : P.p₁ * (↑P.q₂ : ℤ) - P.p₂ * (↑P.q₁ : ℤ) = + 1) : (A P) * (b P) - (D P) * (a P) = 1 := by + classical + let a : Int := P.q₁ + let b : Int := P.q₂ + let A : Int := P.p₁ + let D : Int := P.p₂ + change (A * b - D * a = 1) + simpa [a, b, A, D] using hcross + +private theorem ceilPerturb : ∀ (N M d q E : ℤ) (hd : 0 < d) (hdq : d < q), 0 ≤ E → E ≤ d → M * d + = N * q - E → IntegerCeilDiv M q (by omega) = IntegerCeilDiv N d (by omega) := by + classical + exact P5188T1CeilingStability + +private theorem ceilShift : ∀ (M C q : ℤ) (hq : q ≠ 0), IntegerCeilDiv (M + C * q) q hq = + IntegerCeilDiv M q hq + C := by + classical + exact P5188T1CeilingShift + +private theorem ceilZero (d : Int) (hd : d ≠ 0) : IntegerCeilDiv 0 d hd = 0 := by + classical + simp [IntegerCeilDiv] + +private theorem ceilMul (c t d : Int) (hd : d ≠ 0) : + IntegerCeilDiv (c * d * t) d (by omega) = c * t := by + classical + dsimp only [IntegerCeilDiv] + have he : -(c * d * t) = d * (-c * t) := by ring + rw [he, Int.mul_ediv_cancel_left _ hd] + ring + +private theorem g₁val (P : FordFareyParameter) (P₁ : FordFareyParameter) (hp₁ : P₁.p = P.p₁) (hq₁ + : P₁.q = P.q₁) (g₁ : IntegerLatticeFunction) (h₁ : ∀ x ∈ FordDoubledBoundary P₁.q, g₁ x = + IntegerCeilDiv (P₁.p * x.re * x.im) (↑P₁.q : ℤ) (by exact_mod_cast P₁.q_pos.ne')) (ha : 0 < + (↑P.q₁ : ℤ)) + (u v : Int) (hu0 : 0 ≤ u) (hu : u ≤ (a P)) + (hv0 : 0 ≤ v) (hv : v ≤ (a P)) + (hs : u = 0 ∨ u = 1 ∨ u = (a P) - 1 ∨ u = (a P) ∨ + v = 0 ∨ v = 1 ∨ v = (a P) - 1 ∨ v = (a P)) : + g₁ ⟨u, v⟩ = IntegerCeilDiv ((A P) * u * v) (a P) (by exact ne_of_gt ha) := by + classical + let a : Int := P.q₁ + let A : Int := P.p₁ + change u ≤ a at hu + change v ≤ a at hv + change (u = 0 ∨ u = 1 ∨ u = a - 1 ∨ u = a ∨ + v = 0 ∨ v = 1 ∨ v = a - 1 ∨ v = a) at hs + change (g₁ ⟨u, v⟩ = IntegerCeilDiv (A * u * v) a (by exact ne_of_gt ha)) + have hbd : (⟨u, v⟩ : GaussianInt) ∈ FordDoubledBoundary P₁.q := by + change (0 ≤ u ∧ u ≤ (P₁.q : Int) ∧ 0 ≤ v ∧ v ≤ (P₁.q : Int)) ∧ _ + refine ⟨⟨hu0, ?_, hv0, ?_⟩, ?_⟩ + · simpa [a, hq₁] using hu + · simpa [a, hq₁] using hv + intro hi + simp at hi + rcases hs with h | h | h | h | h | h | h | h <;> omega + simpa [a, A, hp₁, hq₁] using h₁ ⟨u, v⟩ hbd + +private theorem hbox (P : FordFareyParameter) (x : GaussianInt) (hbd : x ∈ FordDoubledBoundary + P.q) : x ∈ FordVertexDomain P.q := by + classical + exact hbd.1 + +private theorem hside (P : FordFareyParameter) (x : GaussianInt) (hdom + : (↑P.q₂ : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q : ℤ) ∧ (↑P.q₂ : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q : ℤ)) (hbd : x ∈ + FordDoubledBoundary P.q) (hsum : (↑P.q : ℤ) = (↑P.q₁ : ℤ) + (↑P.q₂ : ℤ)) (hb : 0 < (↑P.q₂ : + ℤ)) (hbox : x ∈ FordVertexDomain P.q) : x.re = 0 ∨ x.re = 1 ∨ x.re = (P.q : Int) - 1 ∨ x.re = + P.q ∨ + x.im = 0 ∨ x.im = 1 ∨ x.im = (P.q : Int) - 1 ∨ x.im = P.q := by + classical + change x ∈ FordVertexDomain P.q ∧ _ at hbd + rcases hbd with ⟨_, hn⟩ + simp only [FordVertexDomain] at hbox + rcases hbox with ⟨hr0, hrq, hi0, hiq⟩ + by_contra hnside + push Not at hnside + apply hn + exact ⟨by omega, by omega, by omega, by omega⟩ + +private noncomputable abbrev r (P : FordFareyParameter) (x : GaussianInt) : Int := by + classical + let b : Int := P.q₂ + let r : Int := x.re - b + exact r + +private noncomputable abbrev s (P : FordFareyParameter) (x : GaussianInt) : Int := by + classical + let b : Int := P.q₂ + let s : Int := x.im - b + exact s + +private theorem hr0 (P : FordFareyParameter) (x : GaussianInt) (hdom : + (↑P.q₂ : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q : ℤ) ∧ (↑P.q₂ : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q : ℤ)) : 0 ≤ (r P + x) := by + classical + let b : Int := P.q₂ + let r : Int := x.re - b + change (0 ≤ r) + dsimp [r]; omega + +private theorem hsa0 (P : FordFareyParameter) (x : GaussianInt) (hdom : + (↑P.q₂ : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q : ℤ) ∧ (↑P.q₂ : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q : ℤ)) : 0 ≤ (s P + x) := by + classical + let b : Int := P.q₂ + let s : Int := x.im - b + change (0 ≤ s) + dsimp [s]; omega + +private theorem hra (P : FordFareyParameter) (x : GaussianInt) (hsum : + (↑P.q : ℤ) = (↑P.q₁ : ℤ) + (↑P.q₂ : ℤ)) (hdom : (↑P.q₂ : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q : ℤ) ∧ + (↑P.q₂ : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q : ℤ)) : (r P x) ≤ (a P) := by + classical + let a : Int := P.q₁ + let b : Int := P.q₂ + let r : Int := x.re - b + change (r ≤ a) + dsimp [r]; omega + +private theorem hsa (P : FordFareyParameter) (x : GaussianInt) (hsum : + (↑P.q : ℤ) = (↑P.q₁ : ℤ) + (↑P.q₂ : ℤ)) (hdom : (↑P.q₂ : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q : ℤ) ∧ + (↑P.q₂ : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q : ℤ)) : (s P x) ≤ (a P) := by + classical + let a : Int := P.q₁ + let b : Int := P.q₂ + let s : Int := x.im - b + change (s ≤ a) + dsimp [s]; omega + +private theorem hx (P : FordFareyParameter) (x : GaussianInt) : x = ⟨(b P) + (r P x), (b P) + (s + P x)⟩ := by + classical + let b : Int := P.q₂ + let r : Int := x.re - b + let s : Int := x.im - b + change (x = ⟨b + r, b + s⟩) + ext <;> simp [r, s] + +private theorem hshift (P : FordFareyParameter) (x : GaussianInt) : (⟨(b P) + (r P x), (b P) + (s + P x)⟩ : GaussianInt) - ⟨(b P), (b P)⟩ = ⟨(r P x), (s P x)⟩ := by + classical + let b : Int := P.q₂ + let r : Int := x.re - b + let s : Int := x.im - b + change ((⟨b + r, b + s⟩ : GaussianInt) - ⟨b, b⟩ = ⟨r, s⟩) + ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub] + +private theorem hE2side (P : FordFareyParameter) (x : GaussianInt) + (hsum : (↑P.q : ℤ) = (↑P.q₁ : ℤ) + (↑P.q₂ : ℤ)) (ha : 0 < (↑P.q₁ : ℤ)) (hb : 0 < (↑P.q₂ : ℤ)) + (hside : x.re = 0 ∨ x.re = 1 ∨ x.re = (↑P.q : ℤ) - 1 ∨ x.re = (↑P.q : ℤ) ∨ x.im = 0 ∨ x.im = + 1 ∨ x.im = (↑P.q : ℤ) - 1 ∨ x.im = (↑P.q : ℤ)) (hdom : (↑P.q₂ : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q : ℤ) + ∧ (↑P.q₂ : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q : ℤ)) : (r P x) = (a P) ∨ (r P x) = (a P) - 1 ∨ ((r P x) + = 0 ∧ (b P) = 1) ∨ + (s P x) = (a P) ∨ (s P x) = (a P) - 1 ∨ ((s P x) = 0 ∧ (b P) = 1) := by + classical + let a : Int := P.q₁ + let b : Int := P.q₂ + let r : Int := x.re - b + let s : Int := x.im - b + change (r = a ∨ r = a - 1 ∨ (r = 0 ∧ b = 1) ∨ + s = a ∨ s = a - 1 ∨ (s = 0 ∧ b = 1)) + rcases hside with hr | hr | hr | hr | hi | hi | hi | hi + · dsimp [r]; omega + · have hble : (P.q₂ : Int) ≤ 1 := by simpa [hr] using hdom.1 + have hb1 : b = 1 := by dsimp [b]; omega + have hr0' : r = 0 := by dsimp [r, b]; omega + exact Or.inr (Or.inr (Or.inl ⟨hr0', hb1⟩)) + · refine Or.inr (Or.inl ?_); dsimp [r]; omega + · exact Or.inl (by dsimp [r]; omega) + · dsimp [s]; omega + · have hble : (P.q₂ : Int) ≤ 1 := by simpa [hi] using hdom.2.2.1 + have hb1 : b = 1 := by dsimp [b]; omega + have hs0' : s = 0 := by dsimp [s, b]; omega + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr ⟨hs0', hb1⟩)))) + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ?_)))); dsimp [s]; omega + · refine Or.inr (Or.inr (Or.inr ?_)); dsimp [s]; omega + +end SecondEdgeBoundaryConstruction + +theorem P5188T1E2Boundary (P P₁ : FordFareyParameter) + (hq : 1 < P.q) (hp₁ : P₁.p = P.p₁) (hq₁ : P₁.q = P.q₁) + (g₁ : IntegerLatticeFunction) + (h₁ : ∀ x ∈ FordDoubledBoundary P₁.q, + g₁ x = IntegerCeilDiv (P₁.p * x.re * x.im) P₁.q (by exact_mod_cast P₁.q_pos.ne')) + (x : GaussianInt) + (hdom : (P.q₂ : Int) ≤ x.re ∧ x.re ≤ (P.q : Int) ∧ + (P.q₂ : Int) ≤ x.im ∧ x.im ≤ (P.q : Int)) + (hbd : x ∈ FordDoubledBoundary P.q) : + g₁ (x - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩) + + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (P.q₂ : Int) + 1 = + IntegerCeilDiv (P.p * x.re * x.im) P.q (by exact_mod_cast P.q_pos.ne') := by +-- BODY + have hsum : (P.q : Int) = P.q₁ + P.q₂ := SecondEdgeBoundaryConstruction.hsum P + have hps : P.p = P.p₁ + P.p₂ := SecondEdgeBoundaryConstruction.hps P + have hcross := SecondEdgeBoundaryConstruction.hcross P hq + have hdet₁ := SecondEdgeBoundaryConstruction.hdet₁ P + have hdet₂ := SecondEdgeBoundaryConstruction.hdet₂ P + have hqpos : 0 < (P.q : Int) := SecondEdgeBoundaryConstruction.hqpos P + have ha : 0 < (P.q₁ : Int) := SecondEdgeBoundaryConstruction.ha P hq + have hb : 0 < (P.q₂ : Int) := SecondEdgeBoundaryConstruction.hb P + have hab : (P.q₁ : Int) < P.q := SecondEdgeBoundaryConstruction.hab P + have hbb : (P.q₂ : Int) < P.q := SecondEdgeBoundaryConstruction.hbb P hsum ha + let a : Int := P.q₁ + let b : Int := P.q₂ + let A : Int := P.p₁ + let D : Int := P.p₂ + have haq : a + b = P.q := SecondEdgeBoundaryConstruction.haq P hsum + have hpq : A + D = P.p := SecondEdgeBoundaryConstruction.hpq P hps + have hAq : A * P.q - a * P.p = 1 := SecondEdgeBoundaryConstruction.hAq P hdet₁ + have hpqa : P.p * a = A * P.q - 1 := SecondEdgeBoundaryConstruction.hpqa P hAq + have hDq : D * P.q - b * P.p = -1 := SecondEdgeBoundaryConstruction.hDq P hdet₂ + have hAB : A * b - D * a = 1 := SecondEdgeBoundaryConstruction.hAB P hcross + have ceilPerturb := SecondEdgeBoundaryConstruction.ceilPerturb + have ceilShift := SecondEdgeBoundaryConstruction.ceilShift + have ceilZero (d : Int) (hd : d ≠ 0) : IntegerCeilDiv 0 d hd = 0 := + SecondEdgeBoundaryConstruction.ceilZero d hd + have ceilMul (c t d : Int) (hd : d ≠ 0) : + IntegerCeilDiv (c * d * t) d (by omega) = c * t := SecondEdgeBoundaryConstruction.ceilMul c + t d hd + have g₁val (u v : Int) (hu0 : 0 ≤ u) (hu : u ≤ a) + (hv0 : 0 ≤ v) (hv : v ≤ a) + (hs : u = 0 ∨ u = 1 ∨ u = a - 1 ∨ u = a ∨ + v = 0 ∨ v = 1 ∨ v = a - 1 ∨ v = a) : + g₁ ⟨u, v⟩ = IntegerCeilDiv (A * u * v) a (by omega) := SecondEdgeBoundaryConstruction.g₁val + P P₁ hp₁ hq₁ g₁ h₁ ha u v hu0 hu hv0 hv hs + have hbox : x ∈ FordVertexDomain P.q := SecondEdgeBoundaryConstruction.hbox P x hbd + have hside : x.re = 0 ∨ x.re = 1 ∨ x.re = (P.q : Int) - 1 ∨ x.re = P.q ∨ + x.im = 0 ∨ x.im = 1 ∨ x.im = (P.q : Int) - 1 ∨ x.im = P.q := + SecondEdgeBoundaryConstruction.hside P x hdom hbd hsum hb hbox + change ((P.q₂ : Int) ≤ x.re ∧ x.re ≤ P.q ∧ + (P.q₂ : Int) ≤ x.im ∧ x.im ≤ P.q) at hdom + let r : Int := x.re - b + let s : Int := x.im - b + have hr0 : 0 ≤ r := SecondEdgeBoundaryConstruction.hr0 P x hdom + have hsa0 : 0 ≤ s := SecondEdgeBoundaryConstruction.hsa0 P x hdom + have hra : r ≤ a := SecondEdgeBoundaryConstruction.hra P x hsum hdom + have hsa : s ≤ a := SecondEdgeBoundaryConstruction.hsa P x hsum hdom + have hx : x = ⟨b + r, b + s⟩ := SecondEdgeBoundaryConstruction.hx P x + have hshift : (⟨b + r, b + s⟩ : GaussianInt) - ⟨b, b⟩ = ⟨r, s⟩ := + SecondEdgeBoundaryConstruction.hshift P x + rw [hx, hshift] + change g₁ ⟨r, s⟩ + D * (b + r) + D * (b + s) - D * b + 1 = + IntegerCeilDiv (P.p * (b + r) * (b + s)) P.q _ + have hE2side : r = a ∨ r = a - 1 ∨ (r = 0 ∧ b = 1) ∨ + s = a ∨ s = a - 1 ∨ (s = 0 ∧ b = 1) := SecondEdgeBoundaryConstruction.hE2side P x hsum ha + hb hside hdom + rcases hE2side with hrA | hrA1 | hrzeroPair | hsA | hsA1 | hsZeroPair + · rw [g₁val r s hr0 hra hsa0 hsa (Or.inr (Or.inr (Or.inr (Or.inl hrA))))] + have hpedge : IntegerCeilDiv (A * a * s) a (by omega) = A * s := by + simpa [mul_assoc, mul_left_comm, mul_comm] using ceilMul A s a (by omega) + have hqedge : IntegerCeilDiv (P.p * P.q * (b + s)) P.q (by omega) = + P.p * (b + s) := by + simpa [mul_assoc] using ceilMul P.p (b + s) P.q (by omega) + have hpb : P.p * b = D * P.q + 1 := by + have haux : D * P.q - P.p * b = -1 := by + rw [← mul_comm b P.p] + exact hDq + omega + have hcorner : P.p * (b + s) = A * s + D * (b + a + s) + 1 := by + calc + P.p * (b + s) = P.p * b + P.p * s := by ring + _ = (D * P.q + 1) + (A + D) * s := by rw [hpb, ← hpq] + _ = A * s + D * (b + a + s) + 1 := by rw [show P.q = a + b by omega]; ring + have hparent : IntegerCeilDiv (A * r * s) a (by omega) = A * s := by + rw [hrA] + exact hpedge + rw [hparent, hrA, show b + a = P.q by omega, hqedge] + calc + A * s + D * P.q + D * (b + s) - D * b + 1 = + A * s + D * (b + a + s) + 1 := by rw [show P.q = a + b by omega]; ring + _ = P.p * (b + s) := hcorner.symm + · let C : Int := D * (b + (a - 1) + s) + 1 + let M₀ : Int := P.p * (b + (a - 1)) * (b + s) - C * P.q + rw [g₁val r s hr0 hra hsa0 hsa (Or.inr (Or.inr (Or.inl hrA1)))] + have hrel : M₀ * a = (A * (a - 1) * s) * P.q - (a - s) := by + dsimp [M₀, C] + rw [← hpq, ← haq] + linear_combination (a * (a + b - 1) + s) * hAB + have hmain := ceilPerturb (A * (a - 1) * s) M₀ a P.q (a - s) + ha hab (by omega) (by omega) hrel + have hmove : P.p * (b + (a - 1)) * (b + s) = M₀ + C * P.q := by + dsimp [M₀] + ring + have hmove' : P.p * (b + r) * (b + s) = M₀ + C * P.q := by + rw [hrA1] + exact hmove + rw [hmove', ceilShift M₀ C P.q (by omega)] + have hpar : IntegerCeilDiv (A * r * s) a (by omega) = + IntegerCeilDiv (A * (a - 1) * s) a (by omega) := by + rw [hrA1] + rw [hpar, hrA1, hmain] + ring + · rcases hrzeroPair with ⟨hrzero', hb1⟩ + rw [g₁val r s hr0 hra hsa0 hsa (Or.inl hrzero')] + have hpd : P.p = D * P.q + 1 := by + have hDq' : D * P.q - P.p = -1 := by simpa [hb1] using hDq + omega + have hnum : P.p * (b + r) * (b + s) = + (D * (1 + s)) * P.q + (1 + s) := by + simp only [hb1, hrzero', hpd] + ring + rw [show A * r * s = 0 by simp [hrzero'], hnum] + have hEpos : 0 < 1 + s := by omega + have hEq : 1 + s ≤ P.q := by dsimp [s]; omega + have htop := P5188T1CeilingBelow (D * (1 + s) + 1) + ((P.q : Int) - (1 + s)) P.q hqpos (by omega) (by omega) + have hcomp : (D * (1 + s) + 1) * P.q - ((P.q : Int) - (1 + s)) = + (D * (1 + s)) * P.q + (1 + s) := by ring + rw [hcomp] at htop + rw [htop] + simp [IntegerCeilDiv, hrzero', hb1] + · have hsideval : r = 0 ∨ r = 1 ∨ r = a - 1 ∨ r = a ∨ + s = 0 ∨ s = 1 ∨ s = a - 1 ∨ s = a := by + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr hsA)))))) + rw [g₁val r s hr0 hra hsa0 hsa hsideval] + have hpedge : IntegerCeilDiv (A * r * a) a (by omega) = A * r := by + simpa [mul_assoc, mul_left_comm, mul_comm] using ceilMul A r a (by omega) + have hqedge : IntegerCeilDiv (P.p * (b + r) * P.q) P.q (by omega) = + P.p * (b + r) := by + simpa [mul_assoc, mul_left_comm, mul_comm] using ceilMul P.p (b + r) P.q (by omega) + have hpb : P.p * b = D * P.q + 1 := by + have haux : D * P.q - P.p * b = -1 := by + rw [← mul_comm b P.p] + exact hDq + omega + have hcorner : P.p * (b + r) = A * r + D * (b + r) + D * a + 1 := by + calc + P.p * (b + r) = P.p * b + P.p * r := by ring + _ = (D * P.q + 1) + (A + D) * r := by rw [hpb, ← hpq] + _ = A * r + D * (b + r) + D * a + 1 := by rw [show P.q = a + b by omega]; ring + rw [hsA, show b + a = P.q by omega, hqedge] + rw [hpedge] + calc + A * r + D * (b + r) + D * P.q - D * b + 1 = + A * r + D * (b + r) + D * a + 1 := by rw [show P.q = a + b by omega]; ring + _ = P.p * (b + r) := hcorner.symm + · let C : Int := D * (b + r + (a - 1)) + 1 + let M₀ : Int := P.p * (b + r) * (b + (a - 1)) - C * P.q + rw [g₁val r s hr0 hra hsa0 hsa (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + hsA1)))))))] + have hrel : M₀ * a = (A * r * (a - 1)) * P.q - (a - r) := by + dsimp [M₀, C] + rw [← hpq, ← haq] + linear_combination (a * (a + b - 1) + r) * hAB + have hmain := ceilPerturb (A * r * (a - 1)) M₀ a P.q (a - r) + ha hab (by omega) (by omega) hrel + have hmove : P.p * (b + r) * (b + (a - 1)) = M₀ + C * P.q := by + dsimp [M₀] + ring + have hmove' : P.p * (b + r) * (b + s) = M₀ + C * P.q := by + rw [hsA1] + exact hmove + rw [hmove', ceilShift M₀ C P.q (by omega)] + have hpar : IntegerCeilDiv (A * r * s) a (by omega) = + IntegerCeilDiv (A * r * (a - 1)) a (by omega) := by rw [hsA1] + rw [hpar, hsA1, hmain] + ring + · rcases hsZeroPair with ⟨hszero, hb1⟩ + rw [g₁val r s hr0 hra hsa0 hsa + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl hszero)))))] + have hpd : P.p = D * P.q + 1 := by + have hDq' : D * P.q - P.p = -1 := by simpa [hb1] using hDq + omega + have hnum : P.p * (b + r) * (b + s) = + (D * (1 + r)) * P.q + (1 + r) := by + simp only [hb1, hszero, hpd] + ring + have hnumzero : A * r * s = 0 := by + calc + A * r * s = A * r * 0 := congrArg (fun z : Int => A * r * z) hszero + _ = 0 := mul_zero _ + rw [hnumzero, hnum] + have hEpos : 0 < 1 + r := by omega + have hEq : 1 + r ≤ P.q := by dsimp [r]; omega + have htop := P5188T1CeilingBelow (D * (1 + r) + 1) + ((P.q : Int) - (1 + r)) P.q hqpos (by omega) (by omega) + have hcomp : (D * (1 + r) + 1) * P.q - ((P.q : Int) - (1 + r)) = + (D * (1 + r)) * P.q + (1 + r) := by ring + rw [hcomp] at htop + rw [htop] + rw [hb1, hszero] + rw [ceilZero a ha.ne'] + change 0 + D * (1 + r) + D * 1 - D * 1 + 1 = D * (1 + r) + 1 + rw [zero_add, add_sub_cancel_right] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1E3E4Boundary.lean b/LeanPool/ApollonianSuperharmonic/P5188T1E3E4Boundary.lean new file mode 100644 index 0000000000..19055ef22c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5188T1E3E4Boundary.lean @@ -0,0 +1,236 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingStability +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingBelow +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift +public import Mathlib.Tactic.LinearCombination + +-- [TABLET NODE: P5188T1E3E4Boundary] + +/-! +# P5188T1E3E4Boundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5188T1E3E4Boundary (P P₂ : FordFareyParameter) + (hq : 1 < P.q) (hp₂ : P₂.p = P.p₂) (hq₂ : P₂.q = P.q₂) + (g₂ : IntegerLatticeFunction) + (h₂ : ∀ x ∈ FordDoubledBoundary P₂.q, + g₂ x = IntegerCeilDiv (P₂.p * x.re * x.im) P₂.q (by exact_mod_cast P₂.q_pos.ne')) : + (∀ x : GaussianInt, + (P.q₁ : Int) ≤ x.re ∧ x.re ≤ (P.q : Int) ∧ 0 ≤ x.im ∧ x.im ≤ (P.q₂ : Int) → + x ∈ FordDoubledBoundary P.q → + g₂ (x - ⟨(P.q₁ : Int), 0⟩) + P.p₁ * x.im = + IntegerCeilDiv (P.p * x.re * x.im) P.q (by exact_mod_cast P.q_pos.ne')) ∧ + (∀ x : GaussianInt, + 0 ≤ x.re ∧ x.re ≤ (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ x.im ∧ x.im ≤ (P.q : Int) → + x ∈ FordDoubledBoundary P.q → + g₂ (x - ⟨0, (P.q₁ : Int)⟩) + P.p₁ * x.re = + IntegerCeilDiv (P.p * x.re * x.im) P.q (by exact_mod_cast P.q_pos.ne')) := by +-- BODY + have hsum : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q + have hps : P.p = P.p₁ + P.p₂ := P.sum_p + have hcross := (P5130T5ParentArithmetic P hq).2.2.2.2.2.2 + have hdet₁ := P.det₁ + have hdet₂ := P.det₂ + have hqpos : 0 < (P.q : Int) := by exact_mod_cast P.q_pos + have ha : 0 < (P.q₁ : Int) := by have := (P5130T5ParentArithmetic P hq).1; exact_mod_cast this + have hb : 0 < (P.q₂ : Int) := by have := P.q₂_pos; exact_mod_cast this + have hab : (P.q₁ : Int) < P.q := by have := P.q₁_lt; exact_mod_cast this + have hbb : (P.q₂ : Int) < P.q := by rw [hsum]; omega + let a : Int := P.q₁ + let b : Int := P.q₂ + let A : Int := P.p₁ + let D : Int := P.p₂ + have haq : a + b = P.q := by dsimp [a, b]; exact hsum.symm + have hpq : A + D = P.p := by dsimp [A, D]; exact hps.symm + have hAq : A * P.q - a * P.p = 1 := by simpa [a, A] using hdet₁ + have hpqa : P.p * a = A * P.q - 1 := by + have haux : A * P.q - P.p * a = 1 := by + rw [mul_comm P.p a] + exact hAq + omega + have hDq : D * P.q - b * P.p = -1 := by simpa [b, D] using hdet₂ + have hAB : A * b - D * a = 1 := by simpa [a, b, A, D] using hcross + have ceilPerturb := P5188T1CeilingStability + have ceilBelow := P5188T1CeilingBelow + have ceilShift := P5188T1CeilingShift + have ceilZero (d : Int) (hd : d ≠ 0) : IntegerCeilDiv 0 d hd = 0 := by + simp [IntegerCeilDiv] + have ceilMul (c t d : Int) (hd : d ≠ 0) : + IntegerCeilDiv (c * d * t) d (by omega) = c * t := by + dsimp only [IntegerCeilDiv] + have he : -(c * d * t) = d * (-c * t) := by ring + rw [he, Int.mul_ediv_cancel_left _ hd] + ring + have e3 (g₂ : IntegerLatticeFunction) + (h₂ : ∀ x ∈ FordDoubledBoundary P₂.q, + g₂ x = IntegerCeilDiv (P₂.p * x.re * x.im) P₂.q (by exact_mod_cast P₂.q_pos.ne')) + (x : GaussianInt) + (hdom : (P.q₁ : Int) ≤ x.re ∧ x.re ≤ (P.q : Int) ∧ + 0 ≤ x.im ∧ x.im ≤ (P.q₂ : Int)) + (hbd : x ∈ FordDoubledBoundary P.q) : + g₂ (x - ⟨(P.q₁ : Int), 0⟩) + P.p₁ * x.im = + IntegerCeilDiv (P.p * x.re * x.im) P.q (by exact_mod_cast P.q_pos.ne') := by + have g₂val (u v : Int) (hu0 : 0 ≤ u) (hu : u ≤ b) + (hv0 : 0 ≤ v) (hv : v ≤ b) + (hs : u = 0 ∨ u = 1 ∨ u = b - 1 ∨ u = b ∨ + v = 0 ∨ v = 1 ∨ v = b - 1 ∨ v = b) : + g₂ ⟨u, v⟩ = IntegerCeilDiv (D * u * v) b (by omega) := by + have hbd : (⟨u, v⟩ : GaussianInt) ∈ FordDoubledBoundary P₂.q := by + change (0 ≤ u ∧ u ≤ (P₂.q : Int) ∧ 0 ≤ v ∧ v ≤ (P₂.q : Int)) ∧ _ + refine ⟨⟨hu0, ?_, hv0, ?_⟩, ?_⟩ + · simpa [b, hq₂] using hu + · simpa [b, hq₂] using hv + intro hi + simp at hi + rcases hs with h | h | h | h | h | h | h | h <;> omega + simpa [b, D, hp₂, hq₂] using h₂ ⟨u, v⟩ hbd + have hbox : x ∈ FordVertexDomain P.q := hbd.1 + have hside : x.re = 0 ∨ x.re = 1 ∨ x.re = (P.q : Int) - 1 ∨ x.re = P.q ∨ + x.im = 0 ∨ x.im = 1 ∨ x.im = (P.q : Int) - 1 ∨ x.im = P.q := by + change x ∈ FordVertexDomain P.q ∧ _ at hbd + rcases hbd with ⟨_, hn⟩ + simp only [FordVertexDomain] at hbox + rcases hbox with ⟨hr0, hrq, hi0, hiq⟩ + by_contra hnside + push Not at hnside + apply hn + exact ⟨by omega, by omega, by omega, by omega⟩ + change ((P.q₁ : Int) ≤ x.re ∧ x.re ≤ P.q ∧ + 0 ≤ x.im ∧ x.im ≤ P.q₂) at hdom + change g₂ (x - ⟨(P.q₁ : Int), 0⟩) + P.p₁ * x.im = + IntegerCeilDiv (P.p * x.re * x.im) P.q _ + set r : Int := x.re - a with r_def + set s : Int := x.im with s_def + have hr0 : 0 ≤ r := by rw [r_def]; omega + have hrs : r ≤ b := by rw [r_def]; omega + have hs0 : 0 ≤ s := by rw [s_def]; omega + have hsb : s ≤ b := by rw [s_def]; omega + have hx : x = ⟨a + r, s⟩ := by ext <;> simp [r_def, s_def] + have hshift : (⟨a + r, s⟩ : GaussianInt) - ⟨a, 0⟩ = ⟨r, s⟩ := by + ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub] + rw [hx, hshift] + change g₂ ⟨r, s⟩ + A * s = IntegerCeilDiv (P.p * (a + r) * s) P.q _ + have hE3data : + (s = 0 ∨ s = 1 ∨ r = b ∨ r = b - 1 ∨ + (r = 0 ∧ a = 1) ∨ (s = b ∧ a = 1)) ∧ + (r = 0 ∨ r = 1 ∨ r = b - 1 ∨ r = b ∨ + s = 0 ∨ s = 1 ∨ s = b - 1 ∨ s = b) := by + rcases hside with hr | hr | hr | hr | hi | hi | hi | hi + · omega + · have ha1 : a = 1 := by omega + have hr0' : r = 0 := by omega + exact ⟨Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨hr0', ha1⟩)))), + Or.inl hr0'⟩ + · have hrb1 : r = b - 1 := by omega + exact ⟨Or.inr (Or.inr (Or.inr (Or.inl hrb1))), + Or.inr (Or.inr (Or.inl hrb1))⟩ + · have hrb : r = b := by omega + exact ⟨Or.inr (Or.inr (Or.inl hrb)), Or.inr (Or.inr (Or.inr (Or.inl hrb)))⟩ + · exact ⟨Or.inl hi, Or.inr (Or.inr (Or.inr (Or.inr (Or.inl hi))))⟩ + · exact ⟨Or.inr (Or.inl hi), Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl hi)))))⟩ + · have ha1 : a = 1 := by dsimp [a]; omega + have hsb' : s = b := by rw [s_def]; omega + exact ⟨Or.inr (Or.inr (Or.inr (Or.inr (Or.inr ⟨hsb', ha1⟩)))), + Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr hsb'))))))⟩ + · omega + have hparentVal : g₂ ⟨r, s⟩ = IntegerCeilDiv (D * r * s) b hb.ne' := + g₂val r s hr0 hrs hs0 hsb hE3data.2 + rw [hparentVal] + rcases hE3data.1 with hs0' | hs1 | hrb | hrb1 | ⟨hrzero, ha1⟩ | ⟨hsb', ha1⟩ + · simp only [hs0', mul_zero, ceilZero, zero_add] + · simp only [hs1, mul_one] + have hrel : (P.p * r - 1) * b = D * r * P.q - (b - r) := by + rw [← hpq, ← haq] + linear_combination r * hAB + have hmain := ceilPerturb (D * r) (P.p * r - 1) b P.q (b - r) + hb hbb (by omega) (by omega) hrel + have hmove : P.p * (a + r) = (P.p * r - 1) + A * P.q := by + rw [Int.mul_add, hpqa] + omega + rw [hmove, ceilShift (P.p * r - 1) A P.q hqpos.ne', hmain] + · rw [hrb, show a + b = (P.q : Int) from haq, + ceilMul D s b hb.ne', ceilMul P.p s P.q hqpos.ne', ← hpq] + ring + · rw [hrb1, show a + (b - 1) = (P.q : Int) - 1 by omega] + let M : Int := P.p * (P.q - 1) * s - A * s * P.q + have hrel : M * b = (D * (b - 1) * s) * P.q - s := by + dsimp [M] + rw [← hpq, ← haq] + linear_combination -s * hAB + have hmain := ceilPerturb (D * (b - 1) * s) M b P.q s + hb hbb hs0 hsb hrel + have hmove : P.p * (P.q - 1) * s = M + (A * s) * P.q := by + dsimp [M] + ring + rw [hmove, ceilShift M (A * s) P.q hqpos.ne', hmain] + · have hpunit : P.p = A * P.q - 1 := by + rw [ha1] at hpqa + simpa using hpqa + have hnum : P.p * (a + r) * s = (A * s) * P.q - s := by + rw [ha1, hrzero, hpunit] + ring + rw [hnum, ceilBelow (A * s) s P.q hqpos hs0 (by omega)] + simp only [hrzero, mul_zero, zero_mul, ceilZero, zero_add] + · have hDa : D = A * b - 1 := by rw [ha1] at hAB; nlinarith [hAB] + have hq1 : (P.q : Int) = b + 1 := by rw [ha1] at haq; omega + have hp1 : P.p = A * P.q - 1 := by rw [ha1] at hpqa; simpa using hpqa + have htopnum : P.p * (1 + r) * b = + (D * r + A * b - 1) * P.q + (1 + r) := by + rw [hp1, hDa, hq1] + ring + have htop := ceilBelow ((D * r + A * b - 1) + 1) ((P.q : Int) - (1 + r)) P.q hqpos + (by omega) (by omega) + have hcomplement : ((D * r + A * b - 1) + 1) * P.q - ((P.q : Int) - (1 + r)) = + (D * r + A * b - 1) * P.q + (1 + r) := by ring + rw [hcomplement] at htop + have hparent : IntegerCeilDiv (D * r * b) b hb.ne' = D * r := by + simpa only [mul_assoc, mul_left_comm, mul_comm] using ceilMul D r b hb.ne' + rw [hsb', ha1, htopnum, htop, hparent] + ring + refine ⟨e3 g₂ h₂, ?_⟩ + intro x hdom hbd + let swap : GaussianInt → GaussianInt := fun z => ⟨z.im, z.re⟩ + let gswap : IntegerLatticeFunction := fun z => g₂ (swap z) + have hswapbd (n : Nat) (z : GaussianInt) (hz : z ∈ FordDoubledBoundary n) : + swap z ∈ FordDoubledBoundary n := by + change (0 ≤ z.re ∧ z.re ≤ (n : Int) ∧ 0 ≤ z.im ∧ z.im ≤ (n : Int)) ∧ _ at hz + change (0 ≤ z.im ∧ z.im ≤ (n : Int) ∧ 0 ≤ z.re ∧ z.re ≤ (n : Int)) ∧ _ + exact ⟨⟨hz.1.2.2.1, hz.1.2.2.2, hz.1.1, hz.1.2.1⟩, + fun hi => hz.2 ⟨hi.2.2.1, hi.2.2.2, hi.1, hi.2.1⟩⟩ + have hgswap : ∀ z ∈ FordDoubledBoundary P₂.q, + gswap z = IntegerCeilDiv (P₂.p * z.re * z.im) P₂.q + (by exact_mod_cast P₂.q_pos.ne') := by + intro z hz + have hv := h₂ (swap z) (hswapbd P₂.q z hz) + simpa only [gswap, swap, mul_assoc, mul_left_comm, mul_comm] using hv + have hdomswap : (P.q₁ : Int) ≤ (swap x).re ∧ + (swap x).re ≤ (P.q : Int) ∧ 0 ≤ (swap x).im ∧ (swap x).im ≤ (P.q₂ : Int) := + ⟨hdom.2.2.1, hdom.2.2.2, hdom.1, hdom.2.1⟩ + have hv := e3 gswap hgswap (swap x) hdomswap (hswapbd P.q x hbd) + have hpoint : swap (swap x - ⟨(P.q₁ : Int), 0⟩) = + x - ⟨0, (P.q₁ : Int)⟩ := by + ext <;> simp [swap, Zsqrtd.re_sub, Zsqrtd.im_sub] + change g₂ (swap (swap x - ⟨(P.q₁ : Int), 0⟩)) + P.p₁ * x.re = + IntegerCeilDiv (P.p * x.im * x.re) P.q _ at hv + rw [hpoint] at hv + simpa only [mul_assoc, mul_left_comm, mul_comm] using hv + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean b/LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean new file mode 100644 index 0000000000..9009ecc589 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean @@ -0,0 +1,351 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence +public import LeanPool.ApollonianSuperharmonic.P5124T1BoundaryGeometry +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance + +-- [TABLET NODE: P5203T1CapInterface] + +/-! +# P5203T1CapInterface + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CapInterfaceProof + +private theorem footprint : + (by + classical + exact + ∀ (k : Nat), ((0 : ℕ) < k) → (∀ (z : GaussianInt), z ∈ FootprintVertices (DiamondTile k) + ↔ (0 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑k : ℤ) ∧ -(↑k : ℤ) ≤ z.re ∧ z.re ≤ (↑k : ℤ) ∧ + -(z.im + (1 : ℤ)) ≤ z.re ∧ z.re ≤ z.im + (1 : ℤ) ∧ -((2 : ℤ) * (↑k : ℤ) - z.im + (1 : + ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * (↑k : ℤ) - z.im + (1 : ℤ)) + ) := by + classical + intro k hk z + rw [(P4194T1DiamondVertexIncidence k hk z).1] + simp only [Fin.exists_fin_succ, Fin.exists_fin_succ, Fin.exists_fin_succ, + Fin.exists_fin_succ] + rw [show LatticeVertexIncidentCell z 0 = z by rfl, + show LatticeVertexIncidentCell z (Fin.succ 0) = z - 1 by rfl, + show LatticeVertexIncidentCell z (Fin.succ 0).succ = z - 1 - ⟨0, 1⟩ by rfl, + show LatticeVertexIncidentCell z (Fin.succ 0).succ.succ = z - ⟨0, 1⟩ by rfl] + rw [(P4194T1DiamondCellRows k z).1, + (P4194T1DiamondCellRows k (z - 1)).1, + (P4194T1DiamondCellRows k (z - 1 - ⟨0, 1⟩)).1, + (P4194T1DiamondCellRows k (z - ⟨0, 1⟩)).1] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, + ] + simp [] + omega + +private theorem bounds : + (by + classical + exact + ∀ (k : Nat), ((0 : ℕ) < k) → ((∀ (z : GaussianInt), z ∈ FootprintVertices (DiamondTile k) + ↔ 0 ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ -(k : Int) ≤ z.re ∧ z.re ≤ k ∧ -(z.im + 1) ≤ z.re + ∧ z.re ≤ z.im + 1 ∧ -(2 * (k : Int) - z.im + 1) ≤ z.re ∧ z.re ≤ 2 * (k : Int) - z.im + + 1) → ( + let D := DiamondTile k + (∀ (w : GaussianInt), ∀ (z : GaussianInt), z ∈ BoundaryFootprintVertices (TileTranslation + D w) ↔ z - w ∈ BoundaryFootprintVertices D) → (∀ (w : GaussianInt), ∀ (z : + GaussianInt), z ∈ BoundaryFootprintVertices (TileTranslation D w) → (0 : ℤ) ≤ (z - + w).im ∧ (z - w).im ≤ (2 : ℤ) * (↑k : ℤ) ∧ -(↑k : ℤ) ≤ (z - w).re ∧ (z - w).re ≤ (↑k : + ℤ) ∧ -((z - w).im + (1 : ℤ)) ≤ (z - w).re ∧ (z - w).re ≤ (z - w).im + (1 : ℤ) ∧ -((2 + : ℤ) * (↑k : ℤ) - (z - w).im + (1 : ℤ)) ≤ (z - w).re ∧ (z - w).re ≤ (2 : ℤ) * (↑k : + ℤ) - (z - w).im + (1 : ℤ)))) + ) := by + classical + intro k hk footprint D boundary_local w z hz + apply (footprint (z - w)).mp + apply (P4194T1DiamondVertexIncidence k hk (z - w)).1.mpr + exact ((P4194T1DiamondVertexIncidence k hk (z - w)).2.mp + ((boundary_local w z).mp hz)).1 + +private theorem hv : + (by + classical + exact + ∀ (k : Nat), ∀ (u : GaussianInt), + let D := DiamondTile k + let d : GaussianInt := ⟨0, 2 * (k : Int)⟩ + let T := TileTranslation D u + let U := TileTranslation D (u + d) + let V : Set GaussianInt := {z | (z - u).im = 2 * (k : Int) ∧ + -1 ≤ (z - u).re ∧ (z - u).re ≤ 1} + (∀ (w : GaussianInt), ∀ (z : GaussianInt), (z ∈ BoundaryFootprintVertices + (TileTranslation D w)) → (0 ≤ (z - w).im ∧ (z - w).im ≤ 2 * (k : Int) ∧ -(k : Int) ≤ + (z - w).re ∧ (z - w).re ≤ k ∧ -((z - w).im + 1) ≤ (z - w).re ∧ (z - w).re ≤ (z - + w).im + 1 ∧ -(2 * (k : Int) - (z - w).im + 1) ≤ (z - w).re ∧ (z - w).re ≤ 2 * (k : + Int) - (z - w).im + 1)) → ((∀ (a : Int), (-1 ≤ a) → ((a < 1) → (({u + ⟨a, + 2 * (k : Int)⟩, u + ⟨a + 1, 2 * (k : Int)⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U))) → ((∀ (e : Finset + GaussianInt), (e ∈ BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) → (∀ (z : + GaussianInt), (z ∈ e) → (z ∈ BoundaryFootprintVertices T ∩ BoundaryFootprintVertices + U))) → ((∀ (z : GaussianInt), ((z - u).im = 2 * (k : Int)) → (z = u + ⟨(z - u).re, 2 + * (k : Int)⟩)) → (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = V)))) + ) := by + classical + intro k u D d T U V bounds common endpoint place + ext z + constructor + · intro hz + have hT := bounds u z hz.1 + have hU := bounds (u + d) z hz.2 + change (z - u).im = 2 * (k : Int) ∧ -1 ≤ (z - u).re ∧ (z - u).re ≤ 1 + simp only [Zsqrtd.im_sub, Zsqrtd.im_add, Zsqrtd.re_sub, Zsqrtd.re_add, + d] at hT hU ⊢ + omega + · intro hz + have hz' : (z - u).im = 2 * (k : Int) ∧ + -1 ≤ (z - u).re ∧ (z - u).re ≤ 1 := hz + have eqz := place z hz'.1 + rcases (show (z - u).re = -1 ∨ (z - u).re = 0 ∨ (z - u).re = 1 by omega) with + hx | hx | hx + · apply endpoint _ (common (-1) (by omega) (by omega)) z + exact Finset.mem_insert.mpr (Or.inl (by simpa only [hx] using eqz)) + · apply endpoint _ (common 0 (by omega) (by omega)) z + exact Finset.mem_insert.mpr (Or.inl (by simpa only [hx] using eqz)) + · apply endpoint _ (common 0 (by omega) (by omega)) z + exact Finset.mem_insert.mpr (Or.inr (Finset.mem_singleton.mpr + (by simpa only [hx, zero_add] using eqz))) + +private theorem he : + (by + classical + exact + ∀ (k : Nat), ∀ (u : GaussianInt), + let D := DiamondTile k + let d : GaussianInt := ⟨0, 2 * (k : Int)⟩ + let T := TileTranslation D u + let U := TileTranslation D (u + d) + let V : Set GaussianInt := {z | (z - u).im = 2 * (k : Int) ∧ + -1 ≤ (z - u).re ∧ (z - u).re ≤ 1} + let E : Set (Finset GaussianInt) := {e | ∃ a : Int, -1 ≤ a ∧ a < 1 ∧ + e = {u + ⟨a, 2 * (k : Int)⟩, u + ⟨a + 1, 2 * (k : Int)⟩}} + (∀ (a : Int), (-1 ≤ a) → ((a < 1) → (({u + ⟨a, 2 * (k : Int)⟩, u + ⟨a + 1, + 2 * (k : Int)⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ∩ + BoundaryFootprintEdges U))) → ((∀ (e : Finset GaussianInt), (e ∈ + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) → (∀ (z : GaussianInt), (z ∈ e) + → (z ∈ BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U))) → ((∀ (z : + GaussianInt), ((z - u).im = 2 * (k : Int)) → (z = u + ⟨(z - u).re, 2 * (k : Int)⟩)) → + ((BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = V) → + (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = E)))) + ) := by + classical + intro k u D d T U V E common endpoint place hv + ext e + constructor + · intro hh + have ep (z : GaussianInt) (hz : z ∈ e) : + (z - u).im = 2 * (k : Int) ∧ -1 ≤ (z - u).re ∧ (z - u).re ≤ 1 := by + have := endpoint e hh z hz + rw [hv] at this + exact this + obtain ⟨z, hz⟩ := hh.1 + rcases hz with ⟨rfl, _⟩ | ⟨rfl, _⟩ + · have h0 := ep z (by simp) + have h1 := ep (z + 1) (by simp) + refine ⟨(z - u).re, h0.2.1, ?_, ?_⟩ + · simp only [Zsqrtd.re_sub, Zsqrtd.re_add, Zsqrtd.re_one] at h0 h1 ⊢ + omega + · have eqz := place z h0.1 + have eqz' : z + 1 = u + ⟨(z - u).re + 1, 2 * (k : Int)⟩ := by + convert place (z + 1) h1.1 using 1; + simp [Zsqrtd.re_sub, Zsqrtd.re_add]; ring + exact congrArg₂ (fun x y : GaussianInt => ({x, y} : Finset GaussianInt)) eqz eqz' + · have h0 := ep z (by simp) + have h1 := ep (z + ⟨0, 1⟩) (by simp) + simp only [Zsqrtd.im_sub, Zsqrtd.im_add] at h0 h1 + omega + · rintro ⟨a, ha, ha', rfl⟩ + exact common a ha ha' + +private theorem vert : + (by + classical + exact + ∀ (k : Nat), ∀ (u : GaussianInt), + let V : Set GaussianInt := {z | (z - u).im = 2 * (k : Int) ∧ + -1 ≤ (z - u).re ∧ (z - u).re ≤ 1} + (∀ (z : GaussianInt), ((z - u).im = 2 * (k : Int)) → (z = u + ⟨(z - u).re, 2 * (k : + Int)⟩)) → ( + let p0 : GaussianInt := u + ⟨-1, 2 * (k : Int)⟩ + let p1 : GaussianInt := u + ⟨0, 2 * (k : Int)⟩ + let p2 : GaussianInt := u + ⟨1, 2 * (k : Int)⟩ + V = ({p0, p1, p2} : Set GaussianInt)) + ) := by + classical + intro k u V place p0 p1 p2 + ext z + simp only [V, Set.mem_ofPred_eq, Set.mem_insert_iff, Set.mem_singleton_iff] + constructor + · intro hz + have eqz := place z hz.1 + rcases (show (z - u).re = -1 ∨ (z - u).re = 0 ∨ (z - u).re = 1 by omega) with + hx | hx | hx + · exact Or.inl (by simpa only [hx] using eqz) + · exact Or.inr (Or.inl (by simpa only [hx] using eqz)) + · exact Or.inr (Or.inr (by simpa only [hx] using eqz)) + · rintro (rfl | rfl | rfl) <;> simp [p0, p1, p2] + +end CapInterfaceProof + +theorem P5203T1CapInterface (k : Nat) (hk : 0 < k) (u : GaussianInt) : + let T := TileTranslation (DiamondTile k) u + let U := TileTranslation (DiamondTile k) (u + ⟨0, 2 * (k : Int)⟩) + let V : Set GaussianInt := {z | (z - u).im = 2 * (k : Int) ∧ + -1 ≤ (z - u).re ∧ (z - u).re ≤ 1} + let E : Set (Finset GaussianInt) := {e | ∃ a : Int, -1 ≤ a ∧ a < 1 ∧ + e = {u + ⟨a, 2 * (k : Int)⟩, u + ⟨a + 1, 2 * (k : Int)⟩}} + T.cells.Nonempty ∧ U.cells.Nonempty ∧ Disjoint T.cells U.cells ∧ + BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = V ∧ + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = E ∧ + SimpleGridPath V E := by +-- BODY + classical + have footprint (z : GaussianInt) : + z ∈ FootprintVertices (DiamondTile k) ↔ + 0 ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ + -(k : Int) ≤ z.re ∧ z.re ≤ k ∧ + -(z.im + 1) ≤ z.re ∧ z.re ≤ z.im + 1 ∧ + -(2 * (k : Int) - z.im + 1) ≤ z.re ∧ + z.re ≤ 2 * (k : Int) - z.im + 1 := CapInterfaceProof.footprint k hk z + let D := DiamondTile k + let d : GaussianInt := ⟨0, 2 * (k : Int)⟩ + let T := TileTranslation D u + let U := TileTranslation D (u + d) + let V : Set GaussianInt := {z | (z - u).im = 2 * (k : Int) ∧ + -1 ≤ (z - u).re ∧ (z - u).re ≤ 1} + let E : Set (Finset GaussianInt) := {e | ∃ a : Int, -1 ≤ a ∧ a < 1 ∧ + e = {u + ⟨a, 2 * (k : Int)⟩, u + ⟨a + 1, 2 * (k : Int)⟩}} + change T.cells.Nonempty ∧ U.cells.Nonempty ∧ Disjoint T.cells U.cells ∧ + BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = V ∧ + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = E ∧ SimpleGridPath V E + have cell (w z : GaussianInt) : + z ∈ (TileTranslation D w).cells ↔ z - w ∈ DiamondCellDomain k := by + change z ∈ (DiamondCellDomain k).image (GaussianTranslation w) ↔ _ + constructor + · rintro hz + obtain ⟨x, hx, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hx + · intro hz + exact Finset.mem_image.mpr ⟨z - w, hz, by simp [GaussianTranslation]⟩ + have ne (w : GaussianInt) : (TileTranslation D w).cells.Nonempty := by + refine ⟨w, (cell w w).mpr ?_⟩ + rw [sub_self] + exact (P4194T1DiamondCellRows k 0).1.mpr (by norm_num; omega) + have disj : Disjoint T.cells U.cells := by + apply Finset.disjoint_left.mpr + intro z hT hU + have hT := (P4194T1DiamondCellRows k (z - u)).1.mp ((cell u z).mp hT) + have hU := (P4194T1DiamondCellRows k (z - (u + d))).1.mp + ((cell (u + d) z).mp hU) + simp only [Zsqrtd.im_sub, Zsqrtd.im_add, d] at hT hU + omega + have boundary_local (w z : GaussianInt) : + z ∈ BoundaryFootprintVertices (TileTranslation D w) ↔ + z - w ∈ BoundaryFootprintVertices D := by + rw [(TileTranslationFormulas D w).2.2.2.2.2.2.2.1] + constructor + · rintro ⟨x, hx, rfl⟩ + simpa [GaussianTranslation] using hx + · intro hz + exact ⟨z - w, hz, by simp [GaussianTranslation]⟩ + have bounds (w z : GaussianInt) + (hz : z ∈ BoundaryFootprintVertices (TileTranslation D w)) : + 0 ≤ (z - w).im ∧ (z - w).im ≤ 2 * (k : Int) ∧ + -(k : Int) ≤ (z - w).re ∧ (z - w).re ≤ k ∧ + -((z - w).im + 1) ≤ (z - w).re ∧ (z - w).re ≤ (z - w).im + 1 ∧ + -(2 * (k : Int) - (z - w).im + 1) ≤ (z - w).re ∧ + (z - w).re ≤ 2 * (k : Int) - (z - w).im + 1 := CapInterfaceProof.bounds k hk footprint + boundary_local w z hz + have horizontal (w : GaussianInt) (a b : Int) (ha : -1 ≤ a) (ha' : a < 1) + (hb : b = 0 ∨ b = 2 * (k : Int)) : + ({w + ⟨a, b⟩, w + ⟨a + 1, b⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges (TileTranslation D w) := by + rw [(TileTranslationFormulas D w).2.2.2.2.2.2.2.2] + refine ⟨{⟨a, b⟩, ⟨a + 1, b⟩}, ?_, ?_⟩ + · rw [(P5124T1BoundaryGeometry k hk).1] + exact ⟨a, b, Or.inl ⟨Or.inl ⟨hb, ha, ha'⟩, rfl⟩⟩ + · simp [GaussianTranslation, add_comm] + have common (a : Int) (ha : -1 ≤ a) (ha' : a < 1) : + ({u + ⟨a, 2 * (k : Int)⟩, u + ⟨a + 1, 2 * (k : Int)⟩} : + Finset GaussianInt) ∈ BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U := by + refine ⟨horizontal u a _ ha ha' (Or.inr rfl), ?_⟩ + have hz (x : Int) : (u + d) + (⟨x, 0⟩ : GaussianInt) = + u + ⟨x, 2 * (k : Int)⟩ := by ext <;> simp [d] + simpa only [hz] using horizontal (u + d) a 0 ha ha' (Or.inl rfl) + have endpoint (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) + (z : GaussianInt) (hz : z ∈ e) : + z ∈ BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U := by + exact ⟨by rw [BoundaryFootprintVertices, ite_eq_left (ne u)]; exact ⟨e, he.1, hz⟩, + by rw [BoundaryFootprintVertices, ite_eq_left (ne (u + d))]; exact ⟨e, he.2, hz⟩⟩ + have place (z : GaussianInt) (hy : (z - u).im = 2 * (k : Int)) : + z = u + ⟨(z - u).re, 2 * (k : Int)⟩ := by + apply Zsqrtd.ext + · simp + · change z.im = u.im + 2 * (k : Int) + change z.im - u.im = 2 * (k : Int) at hy + omega + have hv : BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = V := CapInterfaceProof.hv + k u bounds common endpoint place + have he : BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = E := CapInterfaceProof.he k u + common endpoint place hv + let p0 : GaussianInt := u + ⟨-1, 2 * (k : Int)⟩ + let p1 : GaussianInt := u + ⟨0, 2 * (k : Int)⟩ + let p2 : GaussianInt := u + ⟨1, 2 * (k : Int)⟩ + have hp0 : p1 = p0 + 1 := by ext <;> simp [p0, p1] + have hp1 : p2 = p1 + 1 := by ext <;> simp [p1, p2] + have vert : V = ({p0, p1, p2} : Set GaussianInt) := CapInterfaceProof.vert k u place + have edge (e : Finset GaussianInt) : e ∈ E ↔ e = {p0, p1} ∨ e = {p1, p2} := by + constructor + · rintro ⟨a, ha, ha', rfl⟩ + rcases (show a = -1 ∨ a = 0 by omega) with rfl | rfl + · exact Or.inl rfl + · exact Or.inr rfl + · rintro (rfl | rfl) + · exact ⟨-1, by omega, by omega, rfl⟩ + · exact ⟨0, by omega, by omega, rfl⟩ + have chain : [p0, p1, p2].IsChain (fun x y => + (x = p0 ∧ y = p1) ∨ (x = p1 ∧ y = p2)) := by + simp + refine ⟨ne u, ne (u + d), disj, hv, he, [p0, p1, p2], ?_, by simp, ?_, ?_, ?_⟩ + · simp [p0, p1, p2, Zsqrtd.ext_iff] + · rw [vert] + ext z + simp + · intro x y l r h + rcases List.isChain_iff_forall_rel_of_append_cons_cons.mp chain h with + ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact Or.inl hp0 + · exact Or.inl hp1 + · intro e + rw [edge] + constructor + · rintro (rfl | rfl) + · exact ⟨p0, p1, [], [p2], rfl, rfl⟩ + · exact ⟨p1, p2, [p0], [], rfl, rfl⟩ + · rintro ⟨x, y, l, r, h, rfl⟩ + rcases List.isChain_iff_forall_rel_of_append_cons_cons.mp chain h with + ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact Or.inl rfl + · exact Or.inr rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean b/LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean new file mode 100644 index 0000000000..5bbdf62dc7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean @@ -0,0 +1,403 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence +public import LeanPool.ApollonianSuperharmonic.P5124T1BoundaryGeometry +public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance + +-- [TABLET NODE: P5203T1DecreasingInterface] + +/-! +# P5203T1DecreasingInterface + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DecreasingInterfaceProof + +private theorem footprint : + (by + classical + exact + ∀ (k : Nat), ((0 : ℕ) < k) → (∀ (z : GaussianInt), z ∈ FootprintVertices (DiamondTile k) + ↔ (0 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑k : ℤ) ∧ -(↑k : ℤ) ≤ z.re ∧ z.re ≤ (↑k : ℤ) ∧ + -(z.im + (1 : ℤ)) ≤ z.re ∧ z.re ≤ z.im + (1 : ℤ) ∧ -((2 : ℤ) * (↑k : ℤ) - z.im + (1 : + ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * (↑k : ℤ) - z.im + (1 : ℤ)) + ) := by + classical + intro k hk z + rw [(P4194T1DiamondVertexIncidence k hk z).1] + simp only [Fin.exists_fin_succ, Fin.exists_fin_succ, Fin.exists_fin_succ, + Fin.exists_fin_succ] + rw [show LatticeVertexIncidentCell z 0 = z by rfl, + show LatticeVertexIncidentCell z (Fin.succ 0) = z - 1 by rfl, + show LatticeVertexIncidentCell z (Fin.succ 0).succ = z - 1 - ⟨0, 1⟩ by rfl, + show LatticeVertexIncidentCell z (Fin.succ 0).succ.succ = z - ⟨0, 1⟩ by rfl] + rw [(P4194T1DiamondCellRows k z).1, + (P4194T1DiamondCellRows k (z - 1)).1, + (P4194T1DiamondCellRows k (z - 1 - ⟨0, 1⟩)).1, + (P4194T1DiamondCellRows k (z - ⟨0, 1⟩)).1] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, + ] + simp [] + omega + +private theorem boundary : + (by + classical + exact + ∀ (k : Nat), ((0 : ℕ) < k) → ((∀ (z : GaussianInt), z ∈ FootprintVertices (DiamondTile k) + ↔ 0 ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ -(k : Int) ≤ z.re ∧ z.re ≤ k ∧ -(z.im + 1) ≤ z.re + ∧ z.re ≤ z.im + 1 ∧ -(2 * (k : Int) - z.im + 1) ≤ z.re ∧ z.re ≤ 2 * (k : Int) - z.im + + 1) → ( + let D := DiamondTile k + let F := fun z : GaussianInt => + 0 ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ -(k : Int) ≤ z.re ∧ z.re ≤ k ∧ + -(z.im + 1) ≤ z.re ∧ z.re ≤ z.im + 1 ∧ + -(2 * (k : Int) - z.im + 1) ≤ z.re ∧ z.re ≤ 2 * (k : Int) - z.im + 1 + let I := fun z : GaussianInt => + 1 ≤ z.im ∧ z.im ≤ 2 * (k : Int) - 1 ∧ + -(z.im - 1) ≤ z.re ∧ z.re ≤ z.im - 1 ∧ + -(2 * (k : Int) - z.im - 1) ≤ z.re ∧ z.re ≤ 2 * (k : Int) - z.im - 1 + ∀ (w : GaussianInt), ∀ (z : GaussianInt), z ∈ BoundaryFootprintVertices (TileTranslation + D w) ↔ F (z - w) ∧ ¬I (z - w))) + ) := by + classical + intro k hk footprint D F I w z + have local_formula (x : GaussianInt) : x ∈ BoundaryFootprintVertices D ↔ F x ∧ ¬I x := by + rw [(P4194T1DiamondVertexIncidence k hk x).2] + apply and_congr + · exact ((P4194T1DiamondVertexIncidence k hk x).1).symm.trans + (footprint x) + · rw [← not_forall] + exact not_congr (P4194T1DiamondCellRows k x).2 + rw [(TileTranslationFormulas D w).2.2.2.2.2.2.2.1] + constructor + · rintro ⟨x, hx, rfl⟩ + simpa [GaussianTranslation] using (local_formula x).mp hx + · intro hz + exact ⟨z - w, (local_formula (z - w)).mpr hz, by simp [GaussianTranslation]⟩ + +private theorem vp : + (by + classical + exact + ∀ (k : Nat), ((0 : ℕ) < k) → (∀ (u : GaussianInt), + let p := fun j : Nat => u + (⟨(k : Int) - (j / 2 : Nat), + (k : Int) + ((j + 1) / 2 : Nat)⟩ : GaussianInt) + let V : Set GaussianInt := {z | 1 ≤ (z - u).re ∧ (z - u).re ≤ k ∧ + 2 * (k : Int) ≤ (z - u).re + (z - u).im ∧ + (z - u).re + (z - u).im ≤ 2 * (k : Int) + 1} + V = {z | ∃ j ≤ 2 * k - 1, z = p j}) + ) := by + classical + intro k hk u p V + ext z + constructor + · intro hz + have hz : 1 ≤ (z - u).re ∧ (z - u).re ≤ k ∧ + 2 * (k : Int) ≤ (z - u).re + (z - u).im ∧ + (z - u).re + (z - u).im ≤ 2 * (k : Int) + 1 := hz + let j := ((z - u).im - (z - u).re).toNat + have hj : (j : Int) = (z - u).im - (z - u).re := + Int.toNat_of_nonneg (by omega) + refine ⟨j, by omega, ?_⟩ + apply Zsqrtd.ext <;> + simp only [p, Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, Zsqrtd.im_sub] at * <;> + omega + · rintro ⟨j, hj, rfl⟩ + simp only [V, Set.mem_ofPred_eq, p, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_sub, Zsqrtd.im_sub] + omega + +private theorem path : + (by + classical + exact + ∀ (k : Nat), ((0 : ℕ) < k) → (∀ (u : GaussianInt), + let p := fun j : Nat => u + (⟨(k : Int) - (j / 2 : Nat), + (k : Int) + ((j + 1) / 2 : Nat)⟩ : GaussianInt) + let V : Set GaussianInt := {z | 1 ≤ (z - u).re ∧ (z - u).re ≤ k ∧ + 2 * (k : Int) ≤ (z - u).re + (z - u).im ∧ + (z - u).re + (z - u).im ≤ 2 * (k : Int) + 1} + let E : Set (Finset GaussianInt) := {e | ∃ j < 2 * k - 1, e = {p j, p (j + 1)}} + (V = {z | ∃ j ≤ 2 * k - 1, z = p j}) → (SimpleGridPath V E)) + ) := by + classical + intro k hk u p V E vp + let q := P5157T1StaircasePoint ⟨(k : Int), -(k : Int)⟩ true 1 + let V0 : Set GaussianInt := {z | ∃ j ≤ 2 * k - 1, z = q j} + let E0 : Set (Finset GaussianInt) := {e | ∃ j < 2 * k - 1, e = {q j, q (j + 1)}} + have hq : SimpleGridPath V0 E0 := + (P5157T1AlternatingStaircase ⟨(k : Int), -(k : Int)⟩ true 1 + (Or.inl rfl) (2 * k - 1) (by omega)).2 + have peq (j : Nat) : GaussianTranslation u (GaussianQuarterTurn (q j)) = p j := by + ext <;> simp [q, P5157T1StaircasePoint, GaussianQuarterTurn, + GaussianTranslation, p] <;> ring + have vertices : GaussianTranslation u '' (GaussianQuarterTurn '' V0) = + {z | ∃ j ≤ 2 * k - 1, z = p j} := by + ext z + constructor + · rintro ⟨_, ⟨_, ⟨j, hj, rfl⟩, rfl⟩, rfl⟩ + exact ⟨j, hj, peq j⟩ + · rintro ⟨j, hj, rfl⟩ + exact ⟨GaussianQuarterTurn (q j), ⟨q j, ⟨j, hj, rfl⟩, rfl⟩, peq j⟩ + have edges : (fun e : Finset GaussianInt => e.image (GaussianTranslation u)) '' + ((fun e : Finset GaussianInt => e.image GaussianQuarterTurn) '' E0) = E := by + ext e + constructor + · rintro ⟨_, ⟨_, ⟨j, hj, rfl⟩, rfl⟩, rfl⟩ + exact ⟨j, hj, by simp only [Finset.image_insert, Finset.image_singleton, peq]⟩ + · rintro ⟨j, hj, rfl⟩ + refine ⟨({q j, q (j + 1)} : Finset GaussianInt).image GaussianQuarterTurn, + ⟨{q j, q (j + 1)}, ⟨j, hj, rfl⟩, rfl⟩, ?_⟩ + simp only [Finset.image_insert, Finset.image_singleton, peq] + have hr := (SimpleGridPathEquivariance V0 E0 u).2.1.mp hq + have ht := (SimpleGridPathEquivariance _ _ u).1.mp hr + rw [vertices, edges, ← vp] at ht + exact ht + +private theorem vertical : + (by + classical + exact + ∀ (k : Nat), ((0 : ℕ) < k) → (∀ (u : GaussianInt), + let D := DiamondTile k + let a : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + let T := TileTranslation D u + let U := TileTranslation D (u + a) + let p := fun j : Nat => u + (⟨(k : Int) - (j / 2 : Nat), + (k : Int) + ((j + 1) / 2 : Nat)⟩ : GaussianInt) + (∀ (w : GaussianInt), ∀ (z : GaussianInt), z ∈ (TileTranslation D w).cells ↔ z - w ∈ + DiamondCellDomain k) → ((∀ (t : Nat), p (2 * t) = u + (⟨(k : Int) - (t : Int), (k : + Int) + (t : Int)⟩ : GaussianInt)) → ((∀ (t : Nat), p (2 * t + 1) = u + (⟨(k : Int) - + (t : Int), (k : Int) + (t : Int) + 1⟩ : GaussianInt)) → (∀ t < k, {p ((2 : ℕ) * t), + p ((2 : ℕ) * t + (1 : ℕ))} ∈ BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U)))) + ) := by + classical + intro k hk u D a T U p cell even odd t ht + have step : p (2 * t + 1) = p (2 * t) + ⟨0, 1⟩ := by + rw [even, odd] + ext <;> simp; ring + rw [step] + constructor + · refine ⟨p (2 * t), Or.inr ⟨rfl, Or.inr ?_⟩⟩ + simp only [T, cell, (P4194T1DiamondCellRows _ _).1, even, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one] + omega + · refine ⟨p (2 * t), Or.inr ⟨rfl, Or.inl ?_⟩⟩ + simp only [U, cell, (P4194T1DiamondCellRows _ _).1, even, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, a] + omega + +private theorem horizontal : + (by + classical + exact + ∀ (k : Nat), ((0 : ℕ) < k) → (∀ (u : GaussianInt), + let D := DiamondTile k + let a : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + let T := TileTranslation D u + let U := TileTranslation D (u + a) + let p := fun j : Nat => u + (⟨(k : Int) - (j / 2 : Nat), + (k : Int) + ((j + 1) / 2 : Nat)⟩ : GaussianInt) + (∀ (w : GaussianInt), ∀ (z : GaussianInt), z ∈ (TileTranslation D w).cells ↔ z - w ∈ + DiamondCellDomain k) → ((∀ (t : Nat), p (2 * t) = u + (⟨(k : Int) - (t : Int), (k : + Int) + (t : Int)⟩ : GaussianInt)) → ((∀ (t : Nat), p (2 * t + 1) = u + (⟨(k : Int) - + (t : Int), (k : Int) + (t : Int) + 1⟩ : GaussianInt)) → (∀ (t : ℕ), t + (1 : ℕ) < k → + {p ((2 : ℕ) * t + (1 : ℕ)), p ((2 : ℕ) * (t + (1 : ℕ)))} ∈ BoundaryFootprintEdges T ∩ + BoundaryFootprintEdges U)))) + ) := by + classical + intro k hk u D a T U p cell even odd t ht + have step : p (2 * t + 1) = p (2 * (t + 1)) + 1 := by + rw [even, odd] + ext <;> simp <;> ring + rw [step, Finset.pair_comm] + constructor + · refine ⟨p (2 * (t + 1)), Or.inl ⟨rfl, Or.inr ?_⟩⟩ + simp only [T, cell, (P4194T1DiamondCellRows _ _).1, even, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] + omega + · refine ⟨p (2 * (t + 1)), Or.inl ⟨rfl, Or.inl ?_⟩⟩ + simp only [U, cell, (P4194T1DiamondCellRows _ _).1, even, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, a] + omega + +private theorem he : + (by + classical + exact + ∀ (k : Nat), ((0 : ℕ) < k) → (∀ (u : GaussianInt), + let D := DiamondTile k + let a : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + let T := TileTranslation D u + let U := TileTranslation D (u + a) + let p := fun j : Nat => u + (⟨(k : Int) - (j / 2 : Nat), + (k : Int) + ((j + 1) / 2 : Nat)⟩ : GaussianInt) + let V : Set GaussianInt := {z | 1 ≤ (z - u).re ∧ (z - u).re ≤ k ∧ + 2 * (k : Int) ≤ (z - u).re + (z - u).im ∧ + (z - u).re + (z - u).im ≤ 2 * (k : Int) + 1} + let E : Set (Finset GaussianInt) := {e | ∃ j < 2 * k - 1, e = {p j, p (j + 1)}} + (∀ (w : GaussianInt), (TileTranslation D w).cells.Nonempty) → ((BoundaryFootprintVertices + T ∩ BoundaryFootprintVertices U = V) → ((V = {z | ∃ j ≤ 2 * k - 1, z = p j}) → ((∀ (t + : Nat), (t < k) → (({p (2 * t), p (2 * t + 1)} : Finset GaussianInt) ∈ + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U)) → ((∀ (t : Nat), (t + 1 < k) → + (({p (2 * t + 1), p (2 * (t + 1))} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ∩ + BoundaryFootprintEdges U)) → ((∀ (j : Nat), (p j - u).im - (p j - u).re = (j : Int)) + → (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = E))))))) + ) := by + classical + intro k hk u D a T U p V E ne hv vp vertical horizontal rank + ext e + constructor + · intro hh + have ep (z : GaussianInt) (hz : z ∈ e) : ∃ j ≤ 2 * k - 1, z = p j := by + have hb : z ∈ BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U := + ⟨by rw [BoundaryFootprintVertices, ite_eq_left (ne u)]; exact ⟨e, hh.1, hz⟩, + by rw [BoundaryFootprintVertices, ite_eq_left (ne (u + a))]; exact ⟨e, hh.2, hz⟩⟩ + rw [hv, vp] at hb + exact hb + obtain ⟨z, hz⟩ := hh.1 + rcases hz with ⟨rfl, _⟩ | ⟨rfl, _⟩ + · obtain ⟨i, hi, h0⟩ := ep z (by simp) + obtain ⟨j, hj, h1⟩ := ep (z + 1) (by simp) + have r0 := rank i + have r1 := rank j + rw [← h0] at r0 + rw [← h1] at r1 + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one] at r0 r1 + have ij : i = j + 1 := by omega + exact ⟨j, by omega, by rw [h1, h0, ij, Finset.pair_comm]⟩ + · obtain ⟨i, hi, h0⟩ := ep z (by simp) + obtain ⟨j, hj, h1⟩ := ep (z + ⟨0, 1⟩) (by simp) + have r0 := rank i + have r1 := rank j + rw [← h0] at r0 + rw [← h1] at r1 + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] at r0 r1 + have ij : j = i + 1 := by omega + exact ⟨i, by omega, by rw [h1, h0, ij]⟩ + · rintro ⟨j, hj, rfl⟩ + obtain ⟨t, ht | ht⟩ : ∃ t : Nat, j = 2 * t ∨ j = 2 * t + 1 := + ⟨j / 2, by omega⟩ + · subst j + exact vertical t (by omega) + · subst j + rw [show 2 * t + 1 + 1 = 2 * (t + 1) by omega] + exact horizontal t (by omega) + +end DecreasingInterfaceProof + +theorem P5203T1DecreasingInterface (k : Nat) (hk : 0 < k) (u : GaussianInt) : + let T := TileTranslation (DiamondTile k) u + let U := TileTranslation (DiamondTile k) (u + ⟨(k : Int) + 1, (k : Int)⟩) + let p := fun j : Nat => u + (⟨(k : Int) - (j / 2 : Nat), + (k : Int) + ((j + 1) / 2 : Nat)⟩ : GaussianInt) + let V : Set GaussianInt := {z | 1 ≤ (z - u).re ∧ (z - u).re ≤ k ∧ + 2 * (k : Int) ≤ (z - u).re + (z - u).im ∧ + (z - u).re + (z - u).im ≤ 2 * (k : Int) + 1} + let E : Set (Finset GaussianInt) := {e | ∃ j < 2 * k - 1, e = {p j, p (j + 1)}} + T.cells.Nonempty ∧ U.cells.Nonempty ∧ Disjoint T.cells U.cells ∧ + BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = V ∧ + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = E ∧ + SimpleGridPath V E := by +-- BODY + classical + have footprint (z : GaussianInt) : + z ∈ FootprintVertices (DiamondTile k) ↔ + 0 ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ + -(k : Int) ≤ z.re ∧ z.re ≤ k ∧ + -(z.im + 1) ≤ z.re ∧ z.re ≤ z.im + 1 ∧ + -(2 * (k : Int) - z.im + 1) ≤ z.re ∧ + z.re ≤ 2 * (k : Int) - z.im + 1 := DecreasingInterfaceProof.footprint k hk z + let D := DiamondTile k + let a : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + let T := TileTranslation D u + let U := TileTranslation D (u + a) + let p := fun j : Nat => u + (⟨(k : Int) - (j / 2 : Nat), + (k : Int) + ((j + 1) / 2 : Nat)⟩ : GaussianInt) + let V : Set GaussianInt := {z | 1 ≤ (z - u).re ∧ (z - u).re ≤ k ∧ + 2 * (k : Int) ≤ (z - u).re + (z - u).im ∧ + (z - u).re + (z - u).im ≤ 2 * (k : Int) + 1} + let E : Set (Finset GaussianInt) := {e | ∃ j < 2 * k - 1, e = {p j, p (j + 1)}} + let F := fun z : GaussianInt => + 0 ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ -(k : Int) ≤ z.re ∧ z.re ≤ k ∧ + -(z.im + 1) ≤ z.re ∧ z.re ≤ z.im + 1 ∧ + -(2 * (k : Int) - z.im + 1) ≤ z.re ∧ z.re ≤ 2 * (k : Int) - z.im + 1 + let I := fun z : GaussianInt => + 1 ≤ z.im ∧ z.im ≤ 2 * (k : Int) - 1 ∧ + -(z.im - 1) ≤ z.re ∧ z.re ≤ z.im - 1 ∧ + -(2 * (k : Int) - z.im - 1) ≤ z.re ∧ z.re ≤ 2 * (k : Int) - z.im - 1 + change T.cells.Nonempty ∧ U.cells.Nonempty ∧ Disjoint T.cells U.cells ∧ + BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = V ∧ + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = E ∧ SimpleGridPath V E + have cell (w z : GaussianInt) : + z ∈ (TileTranslation D w).cells ↔ z - w ∈ DiamondCellDomain k := by + change z ∈ (DiamondCellDomain k).image (GaussianTranslation w) ↔ _ + constructor + · intro hz + obtain ⟨x, hx, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hx + · intro hz + exact Finset.mem_image.mpr ⟨z - w, hz, by simp [GaussianTranslation]⟩ + have ne (w : GaussianInt) : (TileTranslation D w).cells.Nonempty := by + refine ⟨w, (cell w w).mpr ?_⟩ + rw [sub_self] + exact (P4194T1DiamondCellRows k 0).1.mpr (by norm_num; omega) + have disj : Disjoint T.cells U.cells := by + apply Finset.disjoint_left.mpr + intro z hT hU + have hT := (P4194T1DiamondCellRows k (z - u)).1.mp ((cell u z).mp hT) + have hU := (P4194T1DiamondCellRows k (z - (u + a))).1.mp + ((cell (u + a) z).mp hU) + simp only [Zsqrtd.im_sub, Zsqrtd.im_add, Zsqrtd.re_sub, Zsqrtd.re_add, a] at hT hU + omega + have boundary (w z : GaussianInt) : + z ∈ BoundaryFootprintVertices (TileTranslation D w) ↔ F (z - w) ∧ ¬I (z - w) := + DecreasingInterfaceProof.boundary k hk footprint w z + have hv : BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = V := by + ext z + dsimp only [T, U] + simp only [Set.mem_inter_iff, boundary] + dsimp [V, F, I, a] + omega + have vp : V = {z | ∃ j ≤ 2 * k - 1, z = p j} := DecreasingInterfaceProof.vp k hk u + have path : SimpleGridPath V E := DecreasingInterfaceProof.path k hk u vp + have even (t : Nat) : p (2 * t) = + u + (⟨(k : Int) - (t : Int), (k : Int) + (t : Int)⟩ : GaussianInt) := by + ext <;> simp [p]; omega + have odd (t : Nat) : p (2 * t + 1) = + u + (⟨(k : Int) - (t : Int), (k : Int) + (t : Int) + 1⟩ : GaussianInt) := by + ext <;> simp [p] <;> omega + have vertical (t : Nat) (ht : t < k) : + ({p (2 * t), p (2 * t + 1)} : Finset GaussianInt) ∈ + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U := DecreasingInterfaceProof.vertical + k hk u cell even odd t ht + have horizontal (t : Nat) (ht : t + 1 < k) : + ({p (2 * t + 1), p (2 * (t + 1))} : Finset GaussianInt) ∈ + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U := + DecreasingInterfaceProof.horizontal k hk u cell even odd t ht + have rank (j : Nat) : (p j - u).im - (p j - u).re = (j : Int) := by + simp only [p, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] + omega + have he : BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = E := + DecreasingInterfaceProof.he k hk u ne hv vp vertical horizontal rank + exact ⟨ne u, ne (u + a), disj, hv, he, path⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5203T1IncreasingInterface.lean b/LeanPool/ApollonianSuperharmonic/P5203T1IncreasingInterface.lean new file mode 100644 index 0000000000..1c153fc260 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5203T1IncreasingInterface.lean @@ -0,0 +1,231 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence +public import LeanPool.ApollonianSuperharmonic.P5124T1BoundaryGeometry +public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance + +-- [TABLET NODE: P5203T1IncreasingInterface] + +/-! +# P5203T1IncreasingInterface + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5203T1IncreasingInterface (k : Nat) (hk : 0 < k) (u : GaussianInt) : + let T := TileTranslation (DiamondTile k) u + let U := TileTranslation (DiamondTile k) (u + ⟨(k : Int) + 1, -(k : Int)⟩) + let p := fun j : Nat => u + (⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ : GaussianInt) + let V : Set GaussianInt := {z | 1 ≤ (z - u).re ∧ (z - u).re ≤ k ∧ + (z - u).re - 1 ≤ (z - u).im ∧ (z - u).im ≤ (z - u).re} + let E : Set (Finset GaussianInt) := {e | ∃ j < 2 * k - 1, e = {p j, p (j + 1)}} + T.cells.Nonempty ∧ U.cells.Nonempty ∧ Disjoint T.cells U.cells ∧ + BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = V ∧ + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = E ∧ + SimpleGridPath V E := by +-- BODY + classical + have footprint (z : GaussianInt) : + z ∈ FootprintVertices (DiamondTile k) ↔ + 0 ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ + -(k : Int) ≤ z.re ∧ z.re ≤ k ∧ + -(z.im + 1) ≤ z.re ∧ z.re ≤ z.im + 1 ∧ + -(2 * (k : Int) - z.im + 1) ≤ z.re ∧ + z.re ≤ 2 * (k : Int) - z.im + 1 := by + rw [(P4194T1DiamondVertexIncidence k hk z).1] + simp only [Fin.exists_fin_succ, Fin.exists_fin_succ, Fin.exists_fin_succ, + Fin.exists_fin_succ] + rw [show LatticeVertexIncidentCell z 0 = z by rfl, + show LatticeVertexIncidentCell z (Fin.succ 0) = z - 1 by rfl, + show LatticeVertexIncidentCell z (Fin.succ 0).succ = z - 1 - ⟨0, 1⟩ by rfl, + show LatticeVertexIncidentCell z (Fin.succ 0).succ.succ = z - ⟨0, 1⟩ by rfl] + rw [(P4194T1DiamondCellRows k z).1, + (P4194T1DiamondCellRows k (z - 1)).1, + (P4194T1DiamondCellRows k (z - 1 - ⟨0, 1⟩)).1, + (P4194T1DiamondCellRows k (z - ⟨0, 1⟩)).1] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, + ] + simp [] + omega + let D := DiamondTile k + let b : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + let T := TileTranslation D u + let U := TileTranslation D (u + b) + let p := fun j : Nat => u + (⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ : GaussianInt) + let V : Set GaussianInt := {z | 1 ≤ (z - u).re ∧ (z - u).re ≤ k ∧ + (z - u).re - 1 ≤ (z - u).im ∧ (z - u).im ≤ (z - u).re} + let E : Set (Finset GaussianInt) := {e | ∃ j < 2 * k - 1, e = {p j, p (j + 1)}} + let F := fun z : GaussianInt => + 0 ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ -(k : Int) ≤ z.re ∧ z.re ≤ k ∧ + -(z.im + 1) ≤ z.re ∧ z.re ≤ z.im + 1 ∧ + -(2 * (k : Int) - z.im + 1) ≤ z.re ∧ z.re ≤ 2 * (k : Int) - z.im + 1 + let I := fun z : GaussianInt => + 1 ≤ z.im ∧ z.im ≤ 2 * (k : Int) - 1 ∧ + -(z.im - 1) ≤ z.re ∧ z.re ≤ z.im - 1 ∧ + -(2 * (k : Int) - z.im - 1) ≤ z.re ∧ z.re ≤ 2 * (k : Int) - z.im - 1 + change T.cells.Nonempty ∧ U.cells.Nonempty ∧ Disjoint T.cells U.cells ∧ + BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = V ∧ + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = E ∧ SimpleGridPath V E + have cell (w z : GaussianInt) : + z ∈ (TileTranslation D w).cells ↔ z - w ∈ DiamondCellDomain k := by + change z ∈ (DiamondCellDomain k).image (GaussianTranslation w) ↔ _ + constructor + · intro hz + obtain ⟨x, hx, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hx + · intro hz + exact Finset.mem_image.mpr ⟨z - w, hz, by simp [GaussianTranslation]⟩ + have ne (w : GaussianInt) : (TileTranslation D w).cells.Nonempty := by + refine ⟨w, (cell w w).mpr ?_⟩ + rw [sub_self] + exact (P4194T1DiamondCellRows k 0).1.mpr (by norm_num; omega) + have disj : Disjoint T.cells U.cells := by + apply Finset.disjoint_left.mpr + intro z hT hU + have hT := (P4194T1DiamondCellRows k (z - u)).1.mp ((cell u z).mp hT) + have hU := (P4194T1DiamondCellRows k (z - (u + b))).1.mp + ((cell (u + b) z).mp hU) + simp only [Zsqrtd.im_sub, Zsqrtd.im_add, Zsqrtd.re_sub, Zsqrtd.re_add, b] at hT hU + omega + have boundary (w z : GaussianInt) : + z ∈ BoundaryFootprintVertices (TileTranslation D w) ↔ F (z - w) ∧ ¬I (z - w) := by + have local_formula (x : GaussianInt) : x ∈ BoundaryFootprintVertices D ↔ F x ∧ ¬I x := by + rw [(P4194T1DiamondVertexIncidence k hk x).2] + apply and_congr + · exact ((P4194T1DiamondVertexIncidence k hk x).1).symm.trans + (footprint x) + · rw [← not_forall] + exact not_congr (P4194T1DiamondCellRows k x).2 + rw [(TileTranslationFormulas D w).2.2.2.2.2.2.2.1] + constructor + · rintro ⟨x, hx, rfl⟩ + simpa [GaussianTranslation] using (local_formula x).mp hx + · intro hz + exact ⟨z - w, (local_formula (z - w)).mpr hz, by simp [GaussianTranslation]⟩ + have hv : BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = V := by + ext z + dsimp only [T, U] + simp only [Set.mem_inter_iff, boundary] + dsimp [V, F, I, b] + omega + have vp : V = {z | ∃ j ≤ 2 * k - 1, z = p j} := by + ext z + constructor + · intro hz + have hz : 1 ≤ (z - u).re ∧ (z - u).re ≤ k ∧ + (z - u).re - 1 ≤ (z - u).im ∧ (z - u).im ≤ (z - u).re := hz + let j := ((z - u).re + (z - u).im - 1).toNat + have hj : (j : Int) = (z - u).re + (z - u).im - 1 := + Int.toNat_of_nonneg (by omega) + refine ⟨j, by omega, ?_⟩ + apply Zsqrtd.ext <;> + simp only [p, Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, Zsqrtd.im_sub] at * <;> + omega + · rintro ⟨j, hj, rfl⟩ + simp only [V, Set.mem_ofPred_eq, p, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_sub, Zsqrtd.im_sub] + omega + have peq (j : Nat) : P5157T1StaircasePoint (u + 1) false 1 j = p j := by + ext <;> simp [P5157T1StaircasePoint, p]; ring + have path : SimpleGridPath V E := by + rw [vp] + simpa only [peq] using + (P5157T1AlternatingStaircase (u + 1) false 1 (Or.inl rfl) + (2 * k - 1) (by omega)).2 + have even (t : Nat) : p (2 * t) = u + (⟨1 + (t : Int), (t : Int)⟩ : GaussianInt) := by + ext <;> simp [p]; omega + have odd (t : Nat) : p (2 * t + 1) = + u + (⟨1 + (t : Int), (t : Int) + 1⟩ : GaussianInt) := by + ext <;> simp [p] <;> omega + have vertical (t : Nat) (ht : t < k) : + ({p (2 * t), p (2 * t + 1)} : Finset GaussianInt) ∈ + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U := by + have step : p (2 * t + 1) = p (2 * t) + ⟨0, 1⟩ := by + rw [even, odd] + ext <;> simp; ring + rw [step] + constructor + · refine ⟨p (2 * t), Or.inr ⟨rfl, Or.inr ?_⟩⟩ + simp only [T, cell, (P4194T1DiamondCellRows _ _).1, even, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one] + omega + · refine ⟨p (2 * t), Or.inr ⟨rfl, Or.inl ?_⟩⟩ + simp only [U, cell, (P4194T1DiamondCellRows _ _).1, even, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, b] + omega + have horizontal (t : Nat) (ht : t + 1 < k) : + ({p (2 * t + 1), p (2 * (t + 1))} : Finset GaussianInt) ∈ + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U := by + have step : p (2 * (t + 1)) = p (2 * t + 1) + 1 := by + rw [even, odd] + ext <;> simp; ring + rw [step] + constructor + · refine ⟨p (2 * t + 1), Or.inl ⟨rfl, Or.inl ?_⟩⟩ + simp only [T, cell, (P4194T1DiamondCellRows _ _).1, odd, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] + omega + · refine ⟨p (2 * t + 1), Or.inl ⟨rfl, Or.inr ?_⟩⟩ + simp only [U, cell, (P4194T1DiamondCellRows _ _).1, odd, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, b] + omega + have rank (j : Nat) : (p j - u).re + (p j - u).im - 1 = (j : Int) := by + simp only [p, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] + omega + have he : BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = E := by + ext e + constructor + · intro hh + have ep (z : GaussianInt) (hz : z ∈ e) : ∃ j ≤ 2 * k - 1, z = p j := by + have hb : z ∈ BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U := + ⟨by rw [BoundaryFootprintVertices, ite_eq_left (ne u)]; exact ⟨e, hh.1, hz⟩, + by rw [BoundaryFootprintVertices, ite_eq_left (ne (u + b))]; exact ⟨e, hh.2, hz⟩⟩ + rw [hv, vp] at hb + exact hb + obtain ⟨z, hz⟩ := hh.1 + rcases hz with ⟨rfl, _⟩ | ⟨rfl, _⟩ + · obtain ⟨i, hi, h0⟩ := ep z (by simp) + obtain ⟨j, hj, h1⟩ := ep (z + 1) (by simp) + have r0 := rank i + have r1 := rank j + rw [← h0] at r0 + rw [← h1] at r1 + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one] at r0 r1 + have ij : j = i + 1 := by omega + exact ⟨i, by omega, by rw [h1, h0, ij]⟩ + · obtain ⟨i, hi, h0⟩ := ep z (by simp) + obtain ⟨j, hj, h1⟩ := ep (z + ⟨0, 1⟩) (by simp) + have r0 := rank i + have r1 := rank j + rw [← h0] at r0 + rw [← h1] at r1 + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] at r0 r1 + have ij : j = i + 1 := by omega + exact ⟨i, by omega, by rw [h1, h0, ij]⟩ + · rintro ⟨j, hj, rfl⟩ + obtain ⟨t, ht | ht⟩ : ∃ t : Nat, j = 2 * t ∨ j = 2 * t + 1 := + ⟨j / 2, by omega⟩ + · subst j + exact vertical t (by omega) + · subst j + rw [show 2 * t + 1 + 1 = 2 * (t + 1) by omega] + exact horizontal t (by omega) + exact ⟨ne u, ne (u + b), disj, hv, he, path⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5250T1CommonVertices.lean b/LeanPool/ApollonianSuperharmonic/P5250T1CommonVertices.lean new file mode 100644 index 0000000000..4558b89169 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5250T1CommonVertices.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.P5157T1StaircasePoint + +-- [TABLET NODE: P5250T1CommonVertices] + +/-! +# P5250T1CommonVertices + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5250T1CommonVertices (k : Nat) (hk : 1 < k) : + let D := DiamondTile k + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + let Eplus := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let Eminus := TileTranslation (DiamondTile (k - 1)) ⟨-(k : Int), 1 - (k : Int)⟩ + let N := 2 * (k - 1) + let p := P5157T1StaircasePoint 1 false 1 + let q := P5157T1StaircasePoint 1 false (-1) + let r := P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) + BoundaryFootprintVertices D ∩ BoundaryFootprintVertices Eplus = + {v | ∃ j ≤ N, v = p j} ∧ + BoundaryFootprintVertices L ∩ BoundaryFootprintVertices Eplus = + {v | ∃ j ≤ N, v = q j} ∧ + BoundaryFootprintVertices D ∩ BoundaryFootprintVertices Eminus = + {v | ∃ j ≤ N, v = r j} := by +-- BODY + classical + have footprint (m : Nat) (hm : 0 < m) (z : GaussianInt) : + z ∈ FootprintVertices (DiamondTile m) ↔ + 0 ≤ z.im ∧ z.im ≤ 2 * (m : Int) ∧ + -(m : Int) ≤ z.re ∧ z.re ≤ m ∧ + -(z.im + 1) ≤ z.re ∧ z.re ≤ z.im + 1 ∧ + -(2 * (m : Int) - z.im + 1) ≤ z.re ∧ + z.re ≤ 2 * (m : Int) - z.im + 1 := by + rw [(P4194T1DiamondVertexIncidence m hm z).1] + simp only [Fin.exists_fin_succ, Fin.exists_fin_succ, Fin.exists_fin_succ, + Fin.exists_fin_succ] + rw [show LatticeVertexIncidentCell z 0 = z by rfl, + show LatticeVertexIncidentCell z (Fin.succ 0) = z - 1 by rfl, + show LatticeVertexIncidentCell z (Fin.succ 0).succ = z - 1 - ⟨0, 1⟩ by rfl, + show LatticeVertexIncidentCell z (Fin.succ 0).succ.succ = z - ⟨0, 1⟩ by rfl] + rw [(P4194T1DiamondCellRows m z).1, + (P4194T1DiamondCellRows m (z - 1)).1, + (P4194T1DiamondCellRows m (z - 1 - ⟨0, 1⟩)).1, + (P4194T1DiamondCellRows m (z - ⟨0, 1⟩)).1] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + simp [] + omega + let F := fun (m : Nat) (z : GaussianInt) => + 0 ≤ z.im ∧ z.im ≤ 2 * (m : Int) ∧ -(m : Int) ≤ z.re ∧ z.re ≤ m ∧ + -(z.im + 1) ≤ z.re ∧ z.re ≤ z.im + 1 ∧ + -(2 * (m : Int) - z.im + 1) ≤ z.re ∧ z.re ≤ 2 * (m : Int) - z.im + 1 + let I := fun (m : Nat) (z : GaussianInt) => + 1 ≤ z.im ∧ z.im ≤ 2 * (m : Int) - 1 ∧ + -(z.im - 1) ≤ z.re ∧ z.re ≤ z.im - 1 ∧ + -(2 * (m : Int) - z.im - 1) ≤ z.re ∧ z.re ≤ 2 * (m : Int) - z.im - 1 + have boundary (m : Nat) (hm : 0 < m) (z : GaussianInt) : + z ∈ BoundaryFootprintVertices (DiamondTile m) ↔ F m z ∧ ¬I m z := by + rw [(P4194T1DiamondVertexIncidence m hm z).2] + apply and_congr + · exact ((P4194T1DiamondVertexIncidence m hm z).1).symm.trans + (footprint m hm z) + · rw [← not_forall] + exact not_congr (P4194T1DiamondCellRows m z).2 + have boundaryTr (m : Nat) (hm : 0 < m) (u z : GaussianInt) : + z ∈ BoundaryFootprintVertices (TileTranslation (DiamondTile m) u) ↔ + F m (z - u) ∧ ¬I m (z - u) := by + rw [(TileTranslationFormulas (DiamondTile m) u).2.2.2.2.2.2.2.1] + constructor + · rintro ⟨w, hw, rfl⟩ + simpa [GaussianTranslation] using (boundary m hm w).mp hw + · intro hz + exact ⟨z - u, (boundary m hm (z - u)).mpr hz, + by simp [GaussianTranslation]⟩ + have kp : 0 < k := by omega + have np : 0 < k - 1 := by omega + have coordP (z : GaussianInt) : + (1 ≤ z.re ∧ z.re ≤ (k : Int) ∧ 0 ≤ z.im ∧ + z.im ≤ (k : Int) - 1 ∧ 0 ≤ z.re - z.im ∧ z.re - z.im ≤ 1) ↔ + ∃ j ≤ 2 * (k - 1), z = P5157T1StaircasePoint 1 false 1 j := by + constructor + · intro hz + let j := (z.re + z.im - 1).toNat + have hj : (j : Int) = z.re + z.im - 1 := Int.toNat_of_nonneg (by omega) + refine ⟨j, by omega, ?_⟩ + ext <;> simp [P5157T1StaircasePoint] <;> omega + · rintro ⟨j, hj, rfl⟩ + simp [P5157T1StaircasePoint]; omega + have coordQ (z : GaussianInt) : + (1 ≤ z.re ∧ z.re ≤ (k : Int) ∧ 1 - (k : Int) ≤ z.im ∧ + z.im ≤ 0 ∧ 0 ≤ z.re + z.im ∧ z.re + z.im ≤ 1) ↔ + ∃ j ≤ 2 * (k - 1), z = P5157T1StaircasePoint 1 false (-1) j := by + constructor + · intro hz + let j := (z.re - z.im - 1).toNat + have hj : (j : Int) = z.re - z.im - 1 := Int.toNat_of_nonneg (by omega) + refine ⟨j, by omega, ?_⟩ + ext <;> simp [P5157T1StaircasePoint] <;> omega + · rintro ⟨j, hj, rfl⟩ + simp [P5157T1StaircasePoint]; omega + have coordR (z : GaussianInt) : + (-(k : Int) ≤ z.re ∧ z.re ≤ -1 ∧ 0 ≤ z.im ∧ + z.im ≤ (k : Int) - 1 ∧ -1 ≤ z.re + z.im ∧ z.re + z.im ≤ 0) ↔ + ∃ j ≤ 2 * (k - 1), z = + P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) j := by + constructor + · intro hz + let j := (z.re - z.im + 2 * (k : Int) - 1).toNat + have hj : (j : Int) = z.re - z.im + 2 * (k : Int) - 1 := + Int.toNat_of_nonneg (by omega) + refine ⟨j, by omega, ?_⟩ + ext <;> simp [P5157T1StaircasePoint] <;> omega + · rintro ⟨j, hj, rfl⟩ + simp [P5157T1StaircasePoint]; omega + dsimp only + refine ⟨?_, ?_, ?_⟩ + · ext z + simp only [Set.mem_ofPred_eq] + rw [← coordP] + simp only [Set.mem_inter_iff, boundary k kp, boundaryTr (k - 1) np] + dsimp [F, I] + omega + · ext z + simp only [Set.mem_ofPred_eq] + rw [← coordQ] + simp only [Set.mem_inter_iff, boundaryTr k kp, boundaryTr (k - 1) np] + dsimp [F, I] + omega + · ext z + simp only [Set.mem_ofPred_eq] + rw [← coordR] + simp only [Set.mem_inter_iff, boundary k kp, boundaryTr (k - 1) np] + dsimp [F, I] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5250T1ConsecutiveEdges.lean b/LeanPool/ApollonianSuperharmonic/P5250T1ConsecutiveEdges.lean new file mode 100644 index 0000000000..d0f54a3843 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5250T1ConsecutiveEdges.lean @@ -0,0 +1,176 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5124T1BoundaryGeometry +public import LeanPool.ApollonianSuperharmonic.P5157T1StaircasePoint + +-- [TABLET NODE: P5250T1ConsecutiveEdges] + +/-! +# P5250T1ConsecutiveEdges + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5250T1ConsecutiveEdges (k : Nat) (hk : 1 < k) : + let D := DiamondTile k + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + let Eplus := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let Eminus := TileTranslation (DiamondTile (k - 1)) ⟨-(k : Int), 1 - (k : Int)⟩ + let N := 2 * (k - 1) + let p := P5157T1StaircasePoint 1 false 1 + let q := P5157T1StaircasePoint 1 false (-1) + let r := P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) + (∀ j < N, ({p j, p (j + 1)} : Finset GaussianInt) ∈ + BoundaryFootprintEdges D ∩ BoundaryFootprintEdges Eplus) ∧ + (∀ j < N, ({q j, q (j + 1)} : Finset GaussianInt) ∈ + BoundaryFootprintEdges L ∩ BoundaryFootprintEdges Eplus) ∧ + (∀ j < N, ({r j, r (j + 1)} : Finset GaussianInt) ∈ + BoundaryFootprintEdges D ∩ BoundaryFootprintEdges Eminus) := by +-- BODY + classical + have hor (m : Nat) (hm : 0 < m) (u : GaussianInt) (a b : Int) + (h : (((b - u.im = 0 ∨ b - u.im = 2 * (m : Int)) ∧ + -1 ≤ a - u.re ∧ a - u.re < 1) ∨ + (1 ≤ b - u.im ∧ b - u.im < (m : Int) ∧ + (a - u.re = -(b - u.im) - 1 ∨ a - u.re = b - u.im)) ∨ + ((m : Int) < b - u.im ∧ b - u.im < 2 * (m : Int) ∧ + (a - u.re = b - u.im - 2 * (m : Int) - 1 ∨ + a - u.re = 2 * (m : Int) - (b - u.im))))) : + ({⟨a, b⟩, ⟨a + 1, b⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges (TileTranslation (DiamondTile m) u) := by + rw [(TileTranslationFormulas (DiamondTile m) u).2.2.2.2.2.2.2.2] + refine ⟨{⟨a - u.re, b - u.im⟩, ⟨a - u.re + 1, b - u.im⟩}, ?_, ?_⟩ + · rw [(P5124T1BoundaryGeometry m hm).1] + exact ⟨a - u.re, b - u.im, Or.inl ⟨h, rfl⟩⟩ + · have h0 : GaussianTranslation u ⟨a - u.re, b - u.im⟩ = ⟨a, b⟩ := by + ext <;> simp [GaussianTranslation] + have h1 : GaussianTranslation u ⟨a - u.re + 1, b - u.im⟩ = ⟨a + 1, b⟩ := by + ext <;> simp [GaussianTranslation]; ring + simp only [Finset.image_insert, Finset.image_singleton, h0, h1] + have ver (m : Nat) (hm : 0 < m) (u : GaussianInt) (a b : Int) + (h : 0 ≤ b - u.im ∧ b - u.im < 2 * (m : Int) ∧ + (a - u.re = -min (b - u.im + 1) (2 * (m : Int) - (b - u.im)) ∨ + a - u.re = min (b - u.im + 1) (2 * (m : Int) - (b - u.im)))) : + ({⟨a, b⟩, ⟨a, b + 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges (TileTranslation (DiamondTile m) u) := by + rw [(TileTranslationFormulas (DiamondTile m) u).2.2.2.2.2.2.2.2] + refine ⟨{⟨a - u.re, b - u.im⟩, ⟨a - u.re, b - u.im + 1⟩}, ?_, ?_⟩ + · rw [(P5124T1BoundaryGeometry m hm).1] + exact ⟨a - u.re, b - u.im, Or.inr ⟨h.1, h.2.1, h.2.2, rfl⟩⟩ + · have h0 : GaussianTranslation u ⟨a - u.re, b - u.im⟩ = ⟨a, b⟩ := by + ext <;> simp [GaussianTranslation] + have h1 : GaussianTranslation u ⟨a - u.re, b - u.im + 1⟩ = ⟨a, b + 1⟩ := by + ext <;> simp [GaussianTranslation]; ring + simp only [Finset.image_insert, Finset.image_singleton, h0, h1] + have zero (m : Nat) : TileTranslation (DiamondTile m) 0 = DiamondTile m := by + have h : GaussianTranslation (0 : GaussianInt) = id := by + funext z + simp [GaussianTranslation] + simp [TileTranslation, h] + have kp : 0 < k := by omega + have np : 0 < k - 1 := by omega + let p := P5157T1StaircasePoint 1 false 1 + let q := P5157T1StaircasePoint 1 false (-1) + let r := P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) + have pe (t : Nat) : p (2 * t) = ⟨1 + (t : Int), (t : Int)⟩ := by + ext <;> simp [p, P5157T1StaircasePoint]; omega + have po (t : Nat) : p (2 * t + 1) = ⟨1 + (t : Int), (t : Int) + 1⟩ := by + ext <;> simp [p, P5157T1StaircasePoint] <;> omega + have qe (t : Nat) : q (2 * t) = ⟨1 + (t : Int), -(t : Int)⟩ := by + ext <;> simp [q, P5157T1StaircasePoint]; omega + have qo (t : Nat) : q (2 * t + 1) = ⟨1 + (t : Int), -(t : Int) - 1⟩ := by + ext <;> simp [q, P5157T1StaircasePoint] <;> omega + have re (t : Nat) : r (2 * t) = ⟨-(k : Int) + t, (k : Int) - 1 - t⟩ := by + ext <;> simp [r, P5157T1StaircasePoint] <;> omega + have ro (t : Nat) : r (2 * t + 1) = + ⟨-(k : Int) + t + 1, (k : Int) - 1 - t⟩ := by + ext <;> simp [r, P5157T1StaircasePoint] <;> omega + dsimp only + change (∀ j < 2 * (k - 1), ({p j, p (j + 1)} : Finset GaussianInt) ∈ _ ∩ _) ∧ + (∀ j < 2 * (k - 1), ({q j, q (j + 1)} : Finset GaussianInt) ∈ _ ∩ _) ∧ + (∀ j < 2 * (k - 1), ({r j, r (j + 1)} : Finset GaussianInt) ∈ _ ∩ _) + refine ⟨?_, ?_, ?_⟩ + · intro j hj + obtain ⟨t, ht | ht⟩ : ∃ t : Nat, j = 2 * t ∨ j = 2 * t + 1 := + ⟨j / 2, by omega⟩ + · subst j + rw [pe, po] + constructor + · simpa only [zero] using ver k kp 0 (1 + t) t (by dsimp; omega) + · exact ver (k - 1) np ⟨(k : Int), 1 - (k : Int)⟩ + (1 + t) t (by dsimp; omega) + · subst j + rw [show 2 * t + 1 + 1 = 2 * (t + 1) by omega, po, pe] + have hcoord : (1 + ((t + 1 : Nat) : Int)) = (1 + (t : Int)) + 1 := by omega + simp only [Nat.cast_add, Nat.cast_one] at hcoord ⊢ + constructor + · simpa only [zero, hcoord] using hor k kp 0 (1 + t) (t + 1) (by dsimp; omega) + · simpa only [hcoord] using hor (k - 1) np ⟨(k : Int), 1 - (k : Int)⟩ + (1 + t) (t + 1) (by dsimp; omega) + · intro j hj + obtain ⟨t, ht | ht⟩ : ∃ t : Nat, j = 2 * t ∨ j = 2 * t + 1 := + ⟨j / 2, by omega⟩ + · subst j + rw [qe, qo, Finset.pair_comm] + have hcoord : (⟨1 + (t : Int), -(t : Int) - 1 + 1⟩ : GaussianInt) = + ⟨1 + (t : Int), -(t : Int)⟩ := by ext <;> simp + constructor + · simpa only [hcoord] using ver k kp ⟨0, -(2 * (k : Int))⟩ + (1 + t) (-(t : Int) - 1) (by dsimp; omega) + · simpa only [hcoord] using ver (k - 1) np ⟨(k : Int), 1 - (k : Int)⟩ + (1 + t) (-(t : Int) - 1) (by dsimp; omega) + · subst j + rw [show 2 * t + 1 + 1 = 2 * (t + 1) by omega, qo, qe] + have e : ({⟨1 + (t : Int), -(t : Int) - 1⟩, + ⟨1 + ((t + 1 : Nat) : Int), -((t + 1 : Nat) : Int)⟩} : Finset GaussianInt) = + {⟨1 + (t : Int), -(t : Int) - 1⟩, + ⟨(1 + (t : Int)) + 1, -(t : Int) - 1⟩} := by + have hx : (1 + ((t + 1 : Nat) : Int)) = (1 + (t : Int)) + 1 := by omega + have hy : -((t + 1 : Nat) : Int) = -(t : Int) - 1 := by omega + rw [hx, hy] + rw [e] + exact ⟨hor k kp ⟨0, -(2 * (k : Int))⟩ (1 + t) (-(t : Int) - 1) + (by dsimp; omega), + hor (k - 1) np ⟨(k : Int), 1 - (k : Int)⟩ (1 + t) (-(t : Int) - 1) + (by dsimp; omega)⟩ + · intro j hj + obtain ⟨t, ht | ht⟩ : ∃ t : Nat, j = 2 * t ∨ j = 2 * t + 1 := + ⟨j / 2, by omega⟩ + · subst j + rw [re, ro] + constructor + · simpa only [zero] using hor k kp 0 (-(k : Int) + t) ((k : Int) - 1 - t) + (by dsimp; omega) + · exact hor (k - 1) np ⟨-(k : Int), 1 - (k : Int)⟩ + (-(k : Int) + t) ((k : Int) - 1 - t) (by dsimp; omega) + · subst j + rw [show 2 * t + 1 + 1 = 2 * (t + 1) by omega, ro, re, Finset.pair_comm] + have e : ({⟨-(k : Int) + ((t + 1 : Nat) : Int), + (k : Int) - 1 - ((t + 1 : Nat) : Int)⟩, + ⟨-(k : Int) + t + 1, (k : Int) - 1 - t⟩} : Finset GaussianInt) = + {⟨-(k : Int) + t + 1, (k : Int) - 2 - t⟩, + ⟨-(k : Int) + t + 1, ((k : Int) - 2 - t) + 1⟩} := by + have hx : -(k : Int) + ((t + 1 : Nat) : Int) = -(k : Int) + t + 1 := by omega + have hy : (k : Int) - 1 - ((t + 1 : Nat) : Int) = (k : Int) - 2 - t := by omega + have hy' : (k : Int) - 1 - t = ((k : Int) - 2 - t) + 1 := by omega + rw [hx, hy, hy'] + rw [e] + constructor + · simpa only [zero] using ver k kp 0 (-(k : Int) + t + 1) ((k : Int) - 2 - t) + (by dsimp; omega) + · exact ver (k - 1) np ⟨-(k : Int), 1 - (k : Int)⟩ + (-(k : Int) + t + 1) ((k : Int) - 2 - t) (by dsimp; omega) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5250T1RankedCommonEdges.lean b/LeanPool/ApollonianSuperharmonic/P5250T1RankedCommonEdges.lean new file mode 100644 index 0000000000..72db7587c8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5250T1RankedCommonEdges.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices + +-- [TABLET NODE: P5250T1RankedCommonEdges] + +/-! +# P5250T1RankedCommonEdges + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5250T1RankedCommonEdges (X Y : ProtoTile) + (hX : X.cells.Nonempty) (hY : Y.cells.Nonempty) + (f : Nat → GaussianInt) (N : Nat) (s c : Int) (hs : s = 1 ∨ s = -1) + (hV : BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y = + {v | ∃ j ≤ N, v = f j}) + (hrank : ∀ j ≤ N, (f j).re + s * (f j).im + c = (j : Int)) : + BoundaryFootprintEdges X ∩ BoundaryFootprintEdges Y ⊆ + {e | ∃ j < N, e = {f j, f (j + 1)}} := by +-- BODY + classical + intro e he + have ep (z : GaussianInt) (hz : z ∈ e) : ∃ j ≤ N, z = f j := by + have hb : z ∈ BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y := + ⟨by rw [BoundaryFootprintVertices, ite_eq_left hX]; exact ⟨e, he.1, hz⟩, + by rw [BoundaryFootprintVertices, ite_eq_left hY]; exact ⟨e, he.2, hz⟩⟩ + rw [hV] at hb + exact hb + obtain ⟨z, hz⟩ := he.1 + rcases hz with ⟨rfl, _⟩ | ⟨rfl, _⟩ + · obtain ⟨i, hi, h0⟩ := ep z (by simp) + obtain ⟨j, hj, h1⟩ := ep (z + 1) (by simp) + have r0 := hrank i hi + have r1 := hrank j hj + rw [← h0] at r0 + rw [← h1] at r1 + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one, + add_zero] at r1 + have ij : j = i + 1 := by omega + exact ⟨i, by omega, by rw [h1, h0, ij]⟩ + · obtain ⟨i, hi, h0⟩ := ep z (by simp) + obtain ⟨j, hj, h1⟩ := ep (z + ⟨0, 1⟩) (by simp) + have r0 := hrank i hi + have r1 := hrank j hj + rw [← h0] at r0 + rw [← h1] at r1 + rcases hs with rfl | rfl + · simp only [Zsqrtd.re_add, Zsqrtd.im_add, add_zero, one_mul] at r0 r1 + have ij : j = i + 1 := by omega + exact ⟨i, by omega, by rw [h1, h0, ij]⟩ + · simp only [Zsqrtd.re_add, Zsqrtd.im_add, add_zero, neg_one_mul] at r0 r1 + have ji : i = j + 1 := by omega + exact ⟨j, by omega, by rw [h1, h0, ji, Finset.pair_comm]⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5250T1SeparatedCells.lean b/LeanPool/ApollonianSuperharmonic/P5250T1SeparatedCells.lean new file mode 100644 index 0000000000..cec9203409 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5250T1SeparatedCells.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P5250T1SeparatedCells] + +/-! +# P5250T1SeparatedCells + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5250T1SeparatedCells (k : Nat) (hk : 1 < k) : + let D := DiamondTile k + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + let Eplus := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let Eminus := TileTranslation (DiamondTile (k - 1)) ⟨-(k : Int), 1 - (k : Int)⟩ + Disjoint D.cells Eplus.cells ∧ Disjoint L.cells Eplus.cells ∧ + Disjoint D.cells Eminus.cells := by +-- BODY + classical + have cell (T : ProtoTile) (u z : GaussianInt) : + z ∈ (TileTranslation T u).cells ↔ z - u ∈ T.cells := by + rw [(TileTranslationFormulas T u).1] + constructor + · rintro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hw + · intro hz + exact Finset.mem_image.mpr ⟨z - u, hz, by simp [GaussianTranslation]⟩ + dsimp only + refine ⟨Finset.disjoint_left.mpr ?_, Finset.disjoint_left.mpr ?_, + Finset.disjoint_left.mpr ?_⟩ + · intro z hD hE + have hD := (P4194T1DiamondCellRows k z).1.mp hD + have hE := (P4194T1DiamondCellRows (k - 1) + (z - ⟨(k : Int), 1 - (k : Int)⟩)).1.mp ((cell _ _ _).mp hE) + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] at hE + omega + · intro z hL hE + have hL := (P4194T1DiamondCellRows k + (z - ⟨0, -(2 * (k : Int))⟩)).1.mp ((cell _ _ _).mp hL) + have hE := (P4194T1DiamondCellRows (k - 1) + (z - ⟨(k : Int), 1 - (k : Int)⟩)).1.mp ((cell _ _ _).mp hE) + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] at hL hE + omega + · intro z hD hE + have hD := (P4194T1DiamondCellRows k z).1.mp hD + have hE := (P4194T1DiamondCellRows (k - 1) + (z - ⟨-(k : Int), 1 - (k : Int)⟩)).1.mp ((cell _ _ _).mp hE) + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] at hE + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5253T1BottomSquareContact.lean b/LeanPool/ApollonianSuperharmonic/P5253T1BottomSquareContact.lean new file mode 100644 index 0000000000..7f8ca62be8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5253T1BottomSquareContact.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5253T1SingletonBoundary +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P5253T1BottomSquareContact] + +/-! +# P5253T1BottomSquareContact + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5253T1BottomSquareContact (k : Nat) (hk : 0 < k) (u : GaussianInt) : + let D := TileTranslation (DiamondTile k) u + let c := u - (⟨0, 1⟩ : GaussianInt) + let U : ProtoTile := ⟨{c}, c⟩ + D.cells.Nonempty ∧ Disjoint D.cells U.cells ∧ + BoundaryFootprintVertices D ∩ BoundaryFootprintVertices U = {u, u + 1} ∧ + {u, u + 1} ∈ BoundaryFootprintEdges D := by +-- BODY + classical + let D := TileTranslation (DiamondTile k) u + let c := u - (⟨0, 1⟩ : GaussianInt) + have cell (z : GaussianInt) : z ∈ D.cells ↔ + 0 ≤ (z - u).im ∧ (z - u).im < 2 * (k : Int) ∧ + -((z - u).im + 1) ≤ (z - u).re ∧ (z - u).re < (z - u).im + 1 ∧ + -(2 * (k : Int) - (z - u).im) ≤ (z - u).re ∧ + (z - u).re < 2 * (k : Int) - (z - u).im := by + rw [← (P4194T1DiamondCellRows k (z - u)).1] + change z ∈ (DiamondCellDomain k).image (GaussianTranslation u) ↔ _ + constructor + · rintro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hw + · intro hz + exact Finset.mem_image.mpr ⟨z - u, hz, by simp [GaussianTranslation]⟩ + have inside : u ∈ D.cells := by + rw [cell] + simp only [sub_self] + norm_num + omega + have outside : c ∉ D.cells := by + rw [cell] + simp [c] + have hn : D.cells.Nonempty := ⟨_, inside⟩ + have edge : {u, u + 1} ∈ BoundaryFootprintEdges D := + ⟨u, Or.inl ⟨rfl, Or.inl ⟨inside, outside⟩⟩⟩ + have no (v : GaussianInt) (hv : (v - u).im = -1) : + v ∉ BoundaryFootprintVertices D := by + simp only [Zsqrtd.im_sub] at hv + rw [(TileTranslationFormulas _ _).2.2.2.2.2.2.2.1] + rintro ⟨w, hw, heq⟩ + have hwv : w = v - u := (eq_sub_iff_add_eq).mpr heq + rw [hwv, (P4194T1DiamondVertexIncidence k hk (v - u)).2] at hw + obtain ⟨⟨j, hj⟩, _⟩ := hw + fin_cases j <;> + simp only [LatticeVertexIncidentCell, (P4194T1DiamondCellRows _ _).1, + ] at hj <;> + norm_num at hj <;> omega + have vertices : BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) = {u, u + 1} := by + ext v + rw [Set.mem_inter_iff, (P5253T1SingletonBoundary c c).1] + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + have hc : c + ⟨0, 1⟩ = u := sub_add_cancel _ _ + have hc1 : c + 1 + ⟨0, 1⟩ = u + 1 := by dsimp [c]; abel + rw [hc, hc1] + constructor + · rintro ⟨hv, rfl | rfl | rfl | rfl⟩ + · exact False.elim (no _ (by simp [c]) hv) + · exact False.elim (no _ (by simp [c]) hv) + · exact Or.inl rfl + · exact Or.inr rfl + · intro hv + have hb : v ∈ BoundaryFootprintVertices D := by + rw [BoundaryFootprintVertices, ite_eq_left hn] + exact ⟨_, edge, by simpa using hv⟩ + exact ⟨hb, by tauto⟩ + exact ⟨hn, Finset.disjoint_singleton_right.mpr outside, vertices, edge⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5253T1LeftSquareContacts.lean b/LeanPool/ApollonianSuperharmonic/P5253T1LeftSquareContacts.lean new file mode 100644 index 0000000000..77a31c8d13 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5253T1LeftSquareContacts.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5253T1SingletonBoundary +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P5253T1LeftSquareContacts] + +/-! +# P5253T1LeftSquareContacts + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5253T1LeftSquareContacts (k : Nat) (hk : 0 < k) + (u : GaussianInt) (h : Int) (hh : h = (k : Int) - 1 ∨ h = k) : + let D := TileTranslation (DiamondTile k) u + let c := u + (⟨-(k : Int) - 1, h⟩ : GaussianInt) + let U : ProtoTile := ⟨{c}, c⟩ + D.cells.Nonempty ∧ Disjoint D.cells U.cells ∧ + BoundaryFootprintVertices D ∩ BoundaryFootprintVertices U = + {c + 1, c + 1 + ⟨0, 1⟩} ∧ + {c + 1, c + 1 + ⟨0, 1⟩} ∈ BoundaryFootprintEdges D := by +-- BODY + classical + let D := TileTranslation (DiamondTile k) u + let c := u + (⟨-(k : Int) - 1, h⟩ : GaussianInt) + have cell (z : GaussianInt) : z ∈ D.cells ↔ + 0 ≤ (z - u).im ∧ (z - u).im < 2 * (k : Int) ∧ + -((z - u).im + 1) ≤ (z - u).re ∧ (z - u).re < (z - u).im + 1 ∧ + -(2 * (k : Int) - (z - u).im) ≤ (z - u).re ∧ + (z - u).re < 2 * (k : Int) - (z - u).im := by + rw [← (P4194T1DiamondCellRows k (z - u)).1] + change z ∈ (DiamondCellDomain k).image (GaussianTranslation u) ↔ _ + constructor + · rintro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hw + · intro hz + exact Finset.mem_image.mpr ⟨z - u, hz, by simp [GaussianTranslation]⟩ + have inside : c + 1 ∈ D.cells := by + rw [cell] + simp only [c, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one] + rcases hh with rfl | rfl <;> omega + have outside : c ∉ D.cells := by + rw [cell] + simp only [c, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] + omega + have hn : D.cells.Nonempty := ⟨_, inside⟩ + have edge : {c + 1, c + 1 + ⟨0, 1⟩} ∈ BoundaryFootprintEdges D := by + refine ⟨c + 1, Or.inr ⟨rfl, Or.inl ⟨inside, ?_⟩⟩⟩ + simpa using outside + have no (v : GaussianInt) (hv : (v - u).re = -(k : Int) - 1) : + v ∉ BoundaryFootprintVertices D := by + simp only [Zsqrtd.re_sub] at hv + rw [(TileTranslationFormulas _ _).2.2.2.2.2.2.2.1] + rintro ⟨w, hw, heq⟩ + have hwv : w = v - u := (eq_sub_iff_add_eq).mpr heq + rw [hwv, (P4194T1DiamondVertexIncidence k hk (v - u)).2] at hw + obtain ⟨⟨j, hj⟩, _⟩ := hw + fin_cases j <;> + simp only [LatticeVertexIncidentCell, (P4194T1DiamondCellRows _ _).1, + ] at hj <;> + norm_num at hj <;> omega + have vertices : BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) = + {c + 1, c + 1 + ⟨0, 1⟩} := by + ext v + rw [Set.mem_inter_iff, (P5253T1SingletonBoundary c c).1] + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + constructor + · rintro ⟨hv, rfl | rfl | rfl | rfl⟩ + · exact False.elim (no _ (by simp [c]) hv) + · exact Or.inl rfl + · exact False.elim (no _ (by simp [c]) hv) + · exact Or.inr rfl + · intro hv + have hb : v ∈ BoundaryFootprintVertices D := by + rw [BoundaryFootprintVertices, ite_eq_left hn] + exact ⟨_, edge, by simpa using hv⟩ + exact ⟨hb, by tauto⟩ + exact ⟨hn, Finset.disjoint_singleton_right.mpr outside, vertices, edge⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5253T1OneEdgeInterface.lean b/LeanPool/ApollonianSuperharmonic/P5253T1OneEdgeInterface.lean new file mode 100644 index 0000000000..7d71b394c7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5253T1OneEdgeInterface.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import Mathlib.Tactic.NormNum + +-- [TABLET NODE: P5253T1OneEdgeInterface] + +/-! +# P5253T1OneEdgeInterface + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5253T1OneEdgeInterface (T U : ProtoTile) (x y : GaussianInt) + (hnT : T.cells.Nonempty) (hnU : U.cells.Nonempty) + (hd : Disjoint T.cells U.cells) + (hv : BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = {x, y}) + (heT : {x, y} ∈ BoundaryFootprintEdges T) + (heU : {x, y} ∈ BoundaryFootprintEdges U) + (ha : y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) : + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = {{x, y}} ∧ + SimpleGridPath {x, y} {{x, y}} ∧ TileTouching T U ∧ TileTouching U T := by +-- BODY + classical + have hxy : x ≠ y := by + rcases ha with h | h | h | h <;> + intro he <;> rw [← he] at h <;> + have hr := congrArg Zsqrtd.re h <;> + have hi := congrArg Zsqrtd.im h <;> simp at hr hi <;> omega + have edges : BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = {{x, y}} := by + ext e + constructor + · intro he + have hc : e.card = 2 := by + obtain ⟨z, ⟨rfl, _⟩ | ⟨rfl, _⟩⟩ := he.1 + all_goals simp [Zsqrtd.ext_iff] + have hs : e ⊆ {x, y} := by + intro v hm + have hb : v ∈ BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U := by + constructor + · rw [BoundaryFootprintVertices, ite_eq_left hnT] + exact ⟨e, he.1, hm⟩ + · rw [BoundaryFootprintVertices, ite_eq_left hnU] + exact ⟨e, he.2, hm⟩ + rw [hv] at hb + simpa using hb + exact Finset.eq_of_subset_of_card_le hs (by simp [hxy, hc]) + · rintro rfl + exact ⟨heT, heU⟩ + have path : SimpleGridPath {x, y} {{x, y}} := by + refine ⟨[x, y], by simp [hxy], by simp, by simp, ?_, ?_⟩ + · intro a b l₁ l₂ hl + have llen := congrArg List.length hl + simp only [List.length_cons, List.length_nil, List.length_append] at llen + have h₁ : l₁ = [] := List.eq_nil_of_length_eq_zero (by omega) + have h₂ : l₂ = [] := List.eq_nil_of_length_eq_zero (by omega) + subst l₁ + subst l₂ + simp only [List.nil_append, List.cons.injEq, and_true] at hl + rcases hl with ⟨rfl, rfl⟩ + exact ha + · intro e + constructor + · rintro rfl + exact ⟨x, y, [], [], rfl, rfl⟩ + · rintro ⟨a, b, l₁, l₂, hl, rfl⟩ + have llen := congrArg List.length hl + simp only [List.length_cons, List.length_nil, List.length_append] at llen + have h₁ : l₁ = [] := List.eq_nil_of_length_eq_zero (by omega) + have h₂ : l₂ = [] := List.eq_nil_of_length_eq_zero (by omega) + subst l₁ + subst l₂ + simp only [List.nil_append, List.cons.injEq, and_true] at hl + rcases hl with ⟨rfl, rfl⟩ + rfl + have p : SimpleGridPath (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) + (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) := by + rw [hv, edges] + exact path + exact ⟨edges, path, Or.inl ⟨hnT, hnU, hd, p⟩, + Or.inl ⟨hnU, hnT, hd.symm, by simpa only [Set.inter_comm] using p⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5253T1SingletonBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5253T1SingletonBoundary.lean new file mode 100644 index 0000000000..9a7dde1944 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5253T1SingletonBoundary.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import Mathlib.Tactic.Tauto + +-- [TABLET NODE: P5253T1SingletonBoundary] + +/-! +# P5253T1SingletonBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5253T1SingletonBoundary (c a : GaussianInt) : + let U : ProtoTile := ⟨{c}, a⟩ + BoundaryFootprintVertices U = {c, c + 1, c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩} ∧ + BoundaryFootprintEdges U = + {{c, c + 1}, {c, c + ⟨0, 1⟩}, + {c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩}, {c + 1, c + 1 + ⟨0, 1⟩}} := by +-- BODY + classical + dsimp only + have edges : BoundaryFootprintEdges (⟨{c}, a⟩ : ProtoTile) = + {{c, c + 1}, {c, c + ⟨0, 1⟩}, + {c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩}, {c + 1, c + 1 + ⟨0, 1⟩}} := by + ext e + constructor + · rintro ⟨z, ⟨rfl, hz⟩ | ⟨rfl, hz⟩⟩ + · rcases hz with ⟨hz, _⟩ | ⟨_, hz⟩ + · have : z = c := Finset.mem_singleton.mp hz + subst z + simp + · have hz : z = c + ⟨0, 1⟩ := + (sub_eq_iff_eq_add).mp (Finset.mem_singleton.mp hz) + subst z + simp [add_assoc, add_comm, add_left_comm] + · rcases hz with ⟨hz, _⟩ | ⟨_, hz⟩ + · have : z = c := Finset.mem_singleton.mp hz + subst z + simp + · have hz : z = c + 1 := + (sub_eq_iff_eq_add).mp (Finset.mem_singleton.mp hz) + subst z + simp + · intro he + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at he + rcases he with rfl | rfl | rfl | rfl + · refine ⟨c, Or.inl ⟨rfl, Or.inl ⟨by simp, ?_⟩⟩⟩ + simp [Zsqrtd.ext_iff] + · refine ⟨c, Or.inr ⟨rfl, Or.inl ⟨by simp, ?_⟩⟩⟩ + simp [] + · refine ⟨c + ⟨0, 1⟩, Or.inl ⟨?_, Or.inr ⟨?_, by simp⟩⟩⟩ + · simp [add_assoc, add_comm, add_left_comm] + · simp [Zsqrtd.ext_iff] + · refine ⟨c + 1, Or.inr ⟨rfl, Or.inr ⟨?_, by simp⟩⟩⟩ + simp [] + refine ⟨?_, edges⟩ + rw [BoundaryFootprintVertices, ite_eq_left (Finset.singleton_nonempty c)] + ext v + simp only [Set.mem_ofPred_eq, edges, Set.mem_insert_iff, Set.mem_singleton_iff, + exists_eq_or_imp, exists_eq_left, Finset.mem_insert, Finset.mem_singleton] + tauto + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5253T1TopSquareContacts.lean b/LeanPool/ApollonianSuperharmonic/P5253T1TopSquareContacts.lean new file mode 100644 index 0000000000..1f6fa61c76 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5253T1TopSquareContacts.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5253T1SingletonBoundary +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P5253T1TopSquareContacts] + +/-! +# P5253T1TopSquareContacts + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5253T1TopSquareContacts (k : Nat) (hk : 0 < k) + (u : GaussianInt) (s : Int) (hs : s = -1 ∨ s = 0) : + let D := TileTranslation (DiamondTile k) u + let c := u + (⟨s, 2 * (k : Int)⟩ : GaussianInt) + let U : ProtoTile := ⟨{c}, c⟩ + D.cells.Nonempty ∧ Disjoint D.cells U.cells ∧ + BoundaryFootprintVertices D ∩ BoundaryFootprintVertices U = {c, c + 1} ∧ + {c, c + 1} ∈ BoundaryFootprintEdges D := by +-- BODY + classical + let D := TileTranslation (DiamondTile k) u + let c := u + (⟨s, 2 * (k : Int)⟩ : GaussianInt) + have cell (z : GaussianInt) : z ∈ D.cells ↔ + 0 ≤ (z - u).im ∧ (z - u).im < 2 * (k : Int) ∧ + -((z - u).im + 1) ≤ (z - u).re ∧ (z - u).re < (z - u).im + 1 ∧ + -(2 * (k : Int) - (z - u).im) ≤ (z - u).re ∧ + (z - u).re < 2 * (k : Int) - (z - u).im := by + rw [← (P4194T1DiamondCellRows k (z - u)).1] + change z ∈ (DiamondCellDomain k).image (GaussianTranslation u) ↔ _ + constructor + · rintro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hw + · intro hz + exact Finset.mem_image.mpr ⟨z - u, hz, by simp [GaussianTranslation]⟩ + have boundary (z : GaussianInt) : z ∈ BoundaryFootprintVertices D ↔ + (∃ j : Fin 4, LatticeVertexIncidentCell (z - u) j ∈ DiamondCellDomain k) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell (z - u) j ∉ DiamondCellDomain k) := by + rw [show BoundaryFootprintVertices D = + GaussianTranslation u '' BoundaryFootprintVertices (DiamondTile k) from + (TileTranslationFormulas _ _).2.2.2.2.2.2.2.1] + rw [← (P4194T1DiamondVertexIncidence k hk (z - u)).2] + constructor + · rintro ⟨w, hw, rfl⟩ + simpa [GaussianTranslation] using hw + · intro hz + exact ⟨z - u, hz, by simp [GaussianTranslation]⟩ + have bottom : c - ⟨0, 1⟩ ∈ D.cells := by + rw [cell] + simp only [c, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] + rcases hs with rfl | rfl <;> omega + have outside : c ∉ D.cells := by + rw [cell] + simp only [c, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] + omega + have hn : D.cells.Nonempty := ⟨_, bottom⟩ + have edge : {c, c + 1} ∈ BoundaryFootprintEdges D := + ⟨c, Or.inl ⟨rfl, Or.inr ⟨outside, bottom⟩⟩⟩ + have corners (z : GaussianInt) : + z ∈ BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) ↔ + z = c ∨ z = c + 1 := by + rw [Set.mem_inter_iff, (P5253T1SingletonBoundary c c).1] + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + have b0 : c ∈ BoundaryFootprintVertices D := by + rw [BoundaryFootprintVertices, ite_eq_left hn] + exact ⟨_, edge, by simp⟩ + have b1 : c + 1 ∈ BoundaryFootprintVertices D := by + rw [BoundaryFootprintVertices, ite_eq_left hn] + exact ⟨_, edge, by simp⟩ + have no (v : GaussianInt) (hv : v.im = u.im + 2 * (k : Int) + 1) : + v ∉ BoundaryFootprintVertices D := by + rw [boundary] + rintro ⟨⟨j, hj⟩, _⟩ + fin_cases j <;> + simp only [LatticeVertexIncidentCell, (P4194T1DiamondCellRows _ _).1, + ] at hj <;> + norm_num at hj <;> omega + constructor + · rintro ⟨hz, rfl | rfl | rfl | rfl⟩ + · exact Or.inl rfl + · exact Or.inr rfl + · exact False.elim (no _ (by simp [c] ) hz) + · exact False.elim (no _ (by simp [c] ) hz) + · rintro (rfl | rfl) <;> simp [b0, b1] + exact ⟨hn, Finset.disjoint_singleton_right.mpr outside, Set.ext corners, edge⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5260T1LiteralPlacement.lean b/LeanPool/ApollonianSuperharmonic/P5260T1LiteralPlacement.lean new file mode 100644 index 0000000000..631e1baa0e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5260T1LiteralPlacement.lean @@ -0,0 +1,257 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.P5124T1ParentPlacement +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.P5300T1CanonicalRowArithmetic +public import LeanPool.ApollonianSuperharmonic.P5300T1CenteredCellGeometry +public import LeanPool.ApollonianSuperharmonic.P5300T1AffineCellObservables + +-- [TABLET NODE: P5260T1LiteralPlacement] + +/-! +# P5260T1LiteralPlacement + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5260T1LiteralPlacement : + ∀ (K : DiamondParameter), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W : ProtoTile), + ∀ (Z : ProtoTile), (BandPrototile ((DiamondRecursiveQuadruple K) 0) U) → ((BandPrototile + ((DiamondRecursiveQuadruple K) i.succ) W) → ((BandPrototile + ((DiamondRecursiveQuadruple K) + ((if Even s.val then i - 1 else i + 1).succ)) Z) → ((0 < ((DiamondRecursiveQuadruple K) + 0).1) → ((0 < ((DiamondRecursiveQuadruple K) i.succ).1) → ((0 < + ((DiamondRecursiveQuadruple K) + ((if Even s.val then i - 1 else i + 1).succ)).1) → ((TileCentroid W - TileCentroid U = (1 / + 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 ((DiamondRecursiveQuadruple K) i.succ) + ((DiamondRecursiveQuadruple K) 0) + + BandVectors.1 ((DiamondRecursiveQuadruple K) 0) + ((DiamondRecursiveQuadruple K) i.succ)))) → ((TileCentroid Z - TileCentroid U = (1 / + 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 ((DiamondRecursiveQuadruple K) 0) + ((DiamondRecursiveQuadruple K) ((i - 1).succ)) - + BandVectors.1 ((DiamondRecursiveQuadruple K) ((i - 1).succ)) + ((DiamondRecursiveQuadruple K) 0) + else BandVectors.1 ((DiamondRecursiveQuadruple K) ((i + 1).succ)) + ((DiamondRecursiveQuadruple K) 0) - + BandVectors.1 ((DiamondRecursiveQuadruple K) 0) + ((DiamondRecursiveQuadruple K) ((i + 1).succ))))) → ( + let q := DiamondRecursiveQuadruple K + let b : Bool := decide (s.val % 2 = 1) + let M := P5260T1PlacementLedger K.1 i b + let D := DiamondTile K.1 + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) + let uL := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q i.succ) (q 0) + else BandVectors.1 (q 0) (q i.succ)) + let source : Fin 5 → ProtoTile := + ![D, TileTranslation D M.2.1.1, TileTranslation D M.2.1.2, M.1.1, M.1.2] + let target : Fin 5 → ProtoTile := + ![U, TileTranslation U uR, TileTranslation U uL, W, Z] + (1 < K.1 ∨ (i = 1 ∧ b = false) ∨ (i = 0 ∧ b = true)) ∧ + ∃ a : GaussianInt, + let f := fun z : GaussianInt => + a + (if s.val < 2 then z else ⟨0, 2 * (K.1 : Int)⟩ - z) + Function.Injective f ∧ + (∀ x y : GaussianInt, + (y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → + (f y = f x + 1 ∨ f y = f x - 1 ∨ + f y = f x + ⟨0, 1⟩ ∨ f y = f x - ⟨0, 1⟩)) ∧ + (∀ j, FootprintVertices (target j) = f '' FootprintVertices (source j)) ∧ + (∀ j, FootprintEdges (target j) = + (fun e : Finset GaussianInt => e.image f) '' FootprintEdges (source j)))))))))) := by + intro K i s U W Z hU hW hZ hposU hposW hposZ hcentW hcentZ +-- BODY + classical + dsimp only + let q := DiamondRecursiveQuadruple K + let b : Bool := decide (s.val % 2 = 1) + let j : Fin 3 := if Even s.val then i - 1 else i + 1 + let M := P5260T1PlacementLedger K.1 i b + let D := DiamondTile K.1 + let C : GaussianInt := ⟨0, 2 * (K.1 : Int)⟩ + let c : Fin 3 → GaussianInt := + ![⟨1, 4 * (K.1 : Int) + 1⟩, + ⟨-2 * (K.1 : Int) - 1, 2 * (K.1 : Int) - 1⟩, + ⟨2 * (K.1 : Int), 0⟩] + let P := fun t => P5124T1ParentModel K.1 t true + let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) + let uL := (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q i.succ) (q 0) + else BandVectors.1 (q 0) (q i.succ)) + obtain ⟨hcase, hR, hL, tW, tZ, hMW, hMZ, hCW, hCZ⟩ := + P5300T1CanonicalRowArithmetic K i s hposW hposZ + obtain ⟨hnD, hsymD, hparents⟩ := P5300T1CenteredCellGeometry K + obtain ⟨a, hcU, haU⟩ := BandPrototileTranslationNormalForm _ U D hU + (DiamondTileRecursiveIdentification K).1 + have hcentU : TileCentroid U = TileCentroid (TileTranslation D a) := + (ProtoTileObservableExtensionality _ _ hcU haU).2.2.2.2 + let g := fun z : GaussianInt => + a + (if s.val < 2 then z else C - z - 1 - ⟨0, 1⟩) + let f := fun z : GaussianInt => a + (if s.val < 2 then z else C - z) + have image_place (S : Finset GaussianInt) (center v : GaussianInt) + (hsym : S.image (fun z => center - z - 1 - ⟨0, 1⟩) = S) : + (S.image (GaussianTranslation + (if s.val < 2 then v else C - v - center))).image (GaussianTranslation a) = + (S.image (GaussianTranslation v)).image g := by + by_cases hs : s.val < 2 + · simp only [ite_eq_left hs, Finset.image_image, g] + congr 1 + funext z + simp [GaussianTranslation, add_comm] + · simp only [ite_eq_right hs, Finset.image_image] + calc + S.image (GaussianTranslation a ∘ GaussianTranslation (C - v - center)) = + (S.image (fun z => center - z - 1 - ⟨0, 1⟩)).image + (g ∘ GaussianTranslation v) := by + rw [Finset.image_image] + congr 1 + funext z + dsimp [GaussianTranslation, g] + rw [ite_eq_right hs] + abel + _ = S.image (g ∘ GaussianTranslation v) := by rw [hsym] + have hUmap : U.cells = D.cells.image g := by + have h := image_place D.cells C 0 hsymD + have h' : (TileTranslation D a).cells = D.cells.image g := by + have hzero : D.cells.image (GaussianTranslation 0) = D.cells := by + ext z + simp only [Finset.mem_image] + constructor + · rintro ⟨w, hw, he⟩ + have : w = z := by simpa only [GaussianTranslation, add_zero] using he + exact this ▸ hw + · intro hz + exact ⟨z, hz, add_zero z⟩ + change D.cells.image (GaussianTranslation a) = D.cells.image g + simpa only [sub_zero, sub_self, ite_self, hzero] using h + exact hcU.trans h' + have parent_match (t : Fin 3) (A B : ProtoTile) (v : GaussianInt) + (hp : 0 < (q t.succ).1) (hB : BandPrototile (q t.succ) B) + (hA : A.cells = (TileTranslation (P t) v).cells) + (hcent : TileCentroid B - TileCentroid U = + TileCentroid (TileTranslation (P t) + (if s.val < 2 then v else C - v - c t)) - TileCentroid D) : + A.cells.Nonempty ∧ B.cells = A.cells.image g := by + let V := TileTranslation (P t) (if s.val < 2 then v else C - v - c t) + have hV : BandPrototile (q t.succ) V := + BandPrototileTranslation _ _ _ (P5124T1ParentPlacement K t true).1 + have hn := (hparents t hp).1 + have hsym := (hparents t hp).2 + have hnA : A.cells.Nonempty := by + rw [hA] + exact hn.image _ + have hCB : TileCentroid B = TileCentroid (TileTranslation V a) := by + rw [(TileTranslationFormulas V a).2.2.2.2.1] + have hcu := hcentU + rw [(TileTranslationFormulas D a).2.2.2.2.1] at hcu + apply Prod.ext + · have h1 := congrArg Prod.fst hcent + have h2 := congrArg Prod.fst hcu + dsimp [V] at h1 h2 ⊢ + linarith + · have h1 := congrArg Prod.snd hcent + have h2 := congrArg Prod.snd hcu + dsimp [V] at h1 h2 ⊢ + linarith + have hcells := (BandPrototileCentroidUnique _ B (TileTranslation V a) + hB (BandPrototileTranslation _ _ _ hV) hCB).1 + refine ⟨hnA, hcells.trans ?_⟩ + rw [hA] + exact image_place (P t).cells (c t) v hsym + have hWdiff : TileCentroid W - TileCentroid U = + TileCentroid (TileTranslation (P i) + (if s.val < 2 then tW else C - tW - c i)) - TileCentroid D := + hcentW.trans hCW.symm + have hZdiff : TileCentroid Z - TileCentroid U = + TileCentroid (TileTranslation (P j) + (if s.val < 2 then tZ else C - tZ - c j)) - TileCentroid D := + hcentZ.trans hCZ.symm + obtain ⟨hnMW, hWmap⟩ := parent_match i M.1.1 W tW hposW hW hMW hWdiff + obtain ⟨hnMZ, hZmap⟩ := parent_match j M.1.2 Z tZ hposZ hZ hMZ hZdiff + have translated (v w : GaussianInt) + (hw : w = if s.val < 2 then v else -v) : + (TileTranslation U w).cells = (TileTranslation D v).cells.image g := by + change U.cells.image (GaussianTranslation w) = + (D.cells.image (GaussianTranslation v)).image g + rw [hUmap, Finset.image_image, Finset.image_image] + congr 1 + funext z + dsimp [GaussianTranslation, g] + by_cases hs : s.val < 2 <;> simp only [hs, ite_true, ite_false] at hw ⊢ <;> + rw [hw] <;> abel + have all_cells : ∀ n : Fin 5, + (![U, TileTranslation U uR, TileTranslation U uL, W, Z] n).cells = + (![D, TileTranslation D M.2.1.1, TileTranslation D M.2.1.2, + M.1.1, M.1.2] n).cells.image g := by + intro n + fin_cases n + · exact hUmap + · exact translated _ _ hR + · exact translated _ _ hL + · exact hWmap + · exact hZmap + have all_nonempty : ∀ n : Fin 5, + (![D, TileTranslation D M.2.1.1, TileTranslation D M.2.1.2, + M.1.1, M.1.2] n).cells.Nonempty := by + intro n + fin_cases n + · exact hnD + · exact hnD.image _ + · exact hnD.image _ + · exact hnMW + · exact hnMZ + have obs (n : Fin 5) := P5300T1AffineCellObservables _ _ a C + (decide (¬s.val < 2)) (all_nonempty n) + (by by_cases hs : s.val < 2 <;> simpa [g, hs] using all_cells n) + refine ⟨hcase, a, ?_, ?_, ?_, ?_⟩ + · intro x y h + by_cases hs : s.val < 2 + · simpa [hs] using h + · have h' := add_left_cancel h + simp only [ite_eq_right hs] at h' + exact sub_right_injective h' + · intro x y h + rcases h with rfl | rfl | rfl | rfl <;> by_cases hs : s.val < 2 + · exact Or.inl (by simp only [ite_eq_left hs]; abel) + · exact Or.inr (Or.inl (by simp only [ite_eq_right hs]; abel)) + · exact Or.inr (Or.inl (by simp only [ite_eq_left hs]; abel)) + · exact Or.inl (by simp only [ite_eq_right hs]; abel) + · exact Or.inr (Or.inr (Or.inl (by simp only [ite_eq_left hs]; abel))) + · exact Or.inr (Or.inr (Or.inr (by simp only [ite_eq_right hs]; abel))) + · exact Or.inr (Or.inr (Or.inr (by simp only [ite_eq_left hs]; abel))) + · exact Or.inr (Or.inr (Or.inl (by simp only [ite_eq_right hs]; abel))) + · intro n + by_cases hs : s.val < 2 <;> + simpa [hs, C, D, M, b, uR, uL, q] using (obs n).1 + · intro n + by_cases hs : s.val < 2 <;> + simpa [hs, C, D, M, b, uR, uL, q] using (obs n).2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5260T1PlacementLedger.lean b/LeanPool/ApollonianSuperharmonic/P5260T1PlacementLedger.lean new file mode 100644 index 0000000000..0af72b626f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5260T1PlacementLedger.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5124T1ParentModel + +-- [TABLET NODE: P5260T1PlacementLedger] + +/-! +# P5260T1PlacementLedger + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $k\geq0$, $i\in\{0,1,2\}$ and a Boolean $b$, define +$M(k,i,b)=((W,Z),(r,l),(x,y))$ by the following table. +Here $D'=\operatorname{DiamondTile}(k-1)$ (natural truncated subtraction), +$[a]$ is the prototile with singleton cell base and anchor $a$, and +every translate is `TileTranslation`. The first three $W$ +entries are exactly the positive models of +`P5124T1ParentModel`, not new versions of those models. +$$ +\begin{array}{c|c|c|c|c|c|c|c} +b&i&W&Z&r&l&x&y\\ \hline +0& 0& [2k\mathrm{i}]& D'+k+(k+1)\mathrm{i}& -k+(k+1)\mathrm{i}& (k+1)+k\mathrm{i}& 2k\mathrm{i}& +1+2k\mathrm{i}\\ +0& 1& [-k-1+(k-1)\mathrm{i}]& [-k-1+k\mathrm{i}]& -k-(k+1)\mathrm{i}& -k-1+k\mathrm{i}& +-k+(k-1)\mathrm{i}& -k+k\mathrm{i}\\ +0&2&D'+k+(1-k)\mathrm{i}&[-\mathrm{i}]&2k&-2k\mathrm{i}&k+(k-1)\mathrm{i}&1\\ +1& 0& [-k-1+k\mathrm{i}]& [-k-1+(k-1)\mathrm{i}]& -k+(k+1)\mathrm{i}& -k-1-k\mathrm{i}& +-k+(k+1)\mathrm{i}& -k+k\mathrm{i}\\ +1&1&[-\mathrm{i}]&D'+k+(1-k)\mathrm{i}&-k-(k+1)\mathrm{i}&(k+1)-k\mathrm{i}&0&1\\ +1&2&D'+k+(k+1)\mathrm{i}&[2k\mathrm{i}]&2k&2k\mathrm{i}&k+(k+1)\mathrm{i}&1+2k\mathrm{i}. +\end{array} +$$ +This is coordinate data only: $x,y$ specify the proposed right and +incoming junctions; their interface properties are not part of the definition. +-/ +def P5260T1PlacementLedger (k : Nat) (i : Fin 3) (odd : Bool) : + (ProtoTile × ProtoTile) × (GaussianInt × GaussianInt) × + (GaussianInt × GaussianInt) := +-- BODY + let unit := fun z : GaussianInt => (⟨{z}, z⟩ : ProtoTile) + let pred := DiamondTile (k - 1) + if odd then + ![((unit ⟨-(k : Int) - 1, (k : Int)⟩, + unit ⟨-(k : Int) - 1, (k : Int) - 1⟩), + (⟨-(k : Int), (k : Int) + 1⟩, ⟨-(k : Int) - 1, -(k : Int)⟩), + (⟨-(k : Int), (k : Int) + 1⟩, ⟨-(k : Int), (k : Int)⟩)), + ((unit ⟨0, -1⟩, TileTranslation pred ⟨(k : Int), 1 - (k : Int)⟩), + (⟨-(k : Int), -(k : Int) - 1⟩, ⟨(k : Int) + 1, -(k : Int)⟩), + (0, 1)), + ((TileTranslation pred ⟨(k : Int), (k : Int) + 1⟩, + unit ⟨0, 2 * (k : Int)⟩), + (⟨2 * (k : Int), 0⟩, ⟨0, 2 * (k : Int)⟩), + (⟨(k : Int), (k : Int) + 1⟩, ⟨1, 2 * (k : Int)⟩))] i + else + ![((P5124T1ParentModel k 0 true, + TileTranslation pred ⟨(k : Int), (k : Int) + 1⟩), + (⟨-(k : Int), (k : Int) + 1⟩, ⟨(k : Int) + 1, (k : Int)⟩), + (⟨0, 2 * (k : Int)⟩, ⟨1, 2 * (k : Int)⟩)), + ((P5124T1ParentModel k 1 true, + unit ⟨-(k : Int) - 1, (k : Int)⟩), + (⟨-(k : Int), -(k : Int) - 1⟩, ⟨-(k : Int) - 1, (k : Int)⟩), + (⟨-(k : Int), (k : Int) - 1⟩, ⟨-(k : Int), (k : Int)⟩)), + ((P5124T1ParentModel k 2 true, unit ⟨0, -1⟩), + (⟨2 * (k : Int), 0⟩, ⟨0, -2 * (k : Int)⟩), + (⟨(k : Int), (k : Int) - 1⟩, 1))] i + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean b/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean new file mode 100644 index 0000000000..3a506d8b9f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean @@ -0,0 +1,3255 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.P5203T1CapInterface +public import LeanPool.ApollonianSuperharmonic.P5157T1DiamondStaircaseIntersections +public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase +public import LeanPool.ApollonianSuperharmonic.P5253T1BottomSquareContact +public import LeanPool.ApollonianSuperharmonic.P5253T1LeftSquareContacts +public import LeanPool.ApollonianSuperharmonic.P5253T1OneEdgeInterface +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary +public import LeanPool.ApollonianSuperharmonic.DiamondBaseT2 +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCentroid +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.P5124T1SmallerParents +public import LeanPool.ApollonianSuperharmonic.P5691T1DiamondReflectionFootprints + +-- [TABLET NODE: P5260T1PredecessorInterfaces] + +/-! +# P5260T1PredecessorInterfaces + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PredecessorInterfaceGeometry + +private theorem rawBoundaryVertices : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → ((Y.cells.Nonempty) → + ((Disjoint X.cells Y.cells) → (FootprintVertices X ∩ FootprintVertices Y = + BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y))) ) := by + classical + intro X Y hX hY hdisj + ext z + constructor + · intro hz + have incident (T : ProtoTile) (hT : T.cells.Nonempty) + (hmem : z ∈ FootprintVertices T) : + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ T.cells := by + simp only [FootprintVertices, ite_eq_left hT, Set.mem_ofPred_eq] at hmem + obtain ⟨c, hc, hcorner⟩ := hmem + rcases hcorner with hcorner | hcorner | hcorner | hcorner + · subst z + exact ⟨0, by simpa [LatticeVertexIncidentCell] using hc⟩ + · subst z + exact ⟨1, by simpa [LatticeVertexIncidentCell] using hc⟩ + · subst z + exact ⟨3, by simpa [LatticeVertexIncidentCell] using hc⟩ + · subst z + have hcell : LatticeVertexIncidentCell (c + 1 + ⟨0, 1⟩) 2 = c := by + simp [LatticeVertexIncidentCell] + abel + exact ⟨2, by rw [hcell]; exact hc⟩ + obtain ⟨ix, hx⟩ := incident X hX hz.1 + obtain ⟨iy, hy⟩ := incident Y hY hz.2 + have hyX : LatticeVertexIncidentCell z iy ∉ X.cells := by + intro hbad + exact (Finset.disjoint_left.mp hdisj hbad) hy + have hxY : LatticeVertexIncidentCell z ix ∉ Y.cells := by + intro hbad + exact (Finset.disjoint_left.mp hdisj.symm hbad) hx + exact ⟨P3161T2IncidentBoundary X z ⟨ix, hx⟩ ⟨iy, hyX⟩, + P3161T2IncidentBoundary Y z ⟨iy, hy⟩ ⟨ix, hxY⟩⟩ + · intro hz + have boundaryRaw (T : ProtoTile) (hT : T.cells.Nonempty) + (hv : z ∈ BoundaryFootprintVertices T) : z ∈ FootprintVertices T := by + simp only [BoundaryFootprintVertices, ite_eq_left hT, Set.mem_ofPred_eq] at hv + obtain ⟨e, he, hze⟩ := hv + rcases he with ⟨c, ⟨heq, hsupport⟩ | ⟨heq, hsupport⟩⟩ + · subst e + rcases hsupport with ⟨hc, _⟩ | ⟨_, hc⟩ + · simp only [FootprintVertices, ite_eq_left hT, Set.mem_ofPred_eq] + refine ⟨c, hc, ?_⟩ + simp only [Finset.mem_insert, Finset.mem_singleton] at hze + rcases hze with h | h <;> subst z <;> + simp [add_assoc] + · have hc' : c - ⟨0, 1⟩ ∈ T.cells := hc + simp only [FootprintVertices, ite_eq_left hT, Set.mem_ofPred_eq] + refine ⟨c - ⟨0, 1⟩, hc', ?_⟩ + simp only [Finset.mem_insert, Finset.mem_singleton] at hze + rcases hze with h | h <;> subst z <;> + simp [sub_eq_add_neg, add_comm, add_left_comm] + · subst e + rcases hsupport with ⟨hc, _⟩ | ⟨_, hc⟩ + · simp only [FootprintVertices, ite_eq_left hT, Set.mem_ofPred_eq] + refine ⟨c, hc, ?_⟩ + simp only [Finset.mem_insert, Finset.mem_singleton] at hze + rcases hze with h | h <;> subst z <;> + simp [add_assoc] + · have hc' : c - 1 ∈ T.cells := hc + simp only [FootprintVertices, ite_eq_left hT, Set.mem_ofPred_eq] + refine ⟨c - 1, hc', ?_⟩ + simp only [Finset.mem_insert, Finset.mem_singleton] at hze + rcases hze with h | h <;> subst z <;> + simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + exact ⟨boundaryRaw X hX hz.1, boundaryRaw Y hY hz.2⟩ + +private theorem rawBoundaryEdges : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (Disjoint X.cells Y.cells) → (FootprintEdges X ∩ + FootprintEdges Y = BoundaryFootprintEdges X ∩ BoundaryFootprintEdges Y) ) := by + classical + intro X Y hdisj + exact CellDisjointCommonEdgesBoundary X Y hdisj + +private theorem staircaseBetween : + (by + classical + exact + (Nat) → (∀ (z : GaussianInt), ∀ (horizontalFirst : Bool), ∀ (s : Int), (s = 1 ∨ s = -1) → + (∀ (N : Nat), (0 < N) → (SimpleGridPathBetween {v | ∃ j ≤ N, v = + P5157T1StaircasePoint z horizontalFirst s j} {e | ∃ j < N, e = + {P5157T1StaircasePoint z horizontalFirst s j, + P5157T1StaircasePoint z horizontalFirst s (j + 1)}} (P5157T1StaircasePoint z + horizontalFirst s 0) (P5157T1StaircasePoint z horizontalFirst s N)))) ) := by + classical + intro k z horizontalFirst s hs N hN + let p := P5157T1StaircasePoint z horizontalFirst s + let l := List.ofFn (fun j : Fin (N + 1) => p j) + have inj : Function.Injective p := + (P5157T1AlternatingStaircase z horizontalFirst s hs N hN).1 + have step (j : Nat) : + p (j + 1) = p j + 1 ∨ p (j + 1) = p j - 1 ∨ + p (j + 1) = p j + ⟨0, 1⟩ ∨ p (j + 1) = p j - ⟨0, 1⟩ := by + rcases hs with rfl | rfl <;> cases horizontalFirst <;> + simp [p, P5157T1StaircasePoint, Zsqrtd.ext_iff] <;> omega + have chain : l.IsChain (fun a b => ∃ j < N, a = p j ∧ b = p (j + 1)) := by + apply List.isChain_ofFn.mpr + intro j hj + exact ⟨j, by omega, rfl, rfl⟩ + have consecutive (a b : GaussianInt) (l₁ l₂ : List GaussianInt) + (heq : l = l₁ ++ a :: b :: l₂) : + ∃ j < N, a = p j ∧ b = p (j + 1) := + List.isChain_iff_forall_rel_of_append_cons_cons.mp chain heq + have hhead : l.head? = some (p 0) := by simp [l] + have hlast : l.getLast? = some (p N) := by + calc + l.getLast? = some (l.getLast (by simp [l])) := + List.getLast?_eq_getLast_of_ne_nil (by simp [l]) + _ = some (p N) := by + simp only [l, List.getLast_ofFn_succ] + congr 1 + refine ⟨l, ?_⟩ + constructor + · apply List.nodup_ofFn.mpr + intro a b hab + exact Fin.ext (inj hab) + constructor + · simp [l] + omega + constructor + · exact hhead + constructor + · exact hlast + constructor + · ext v + simp only [Set.mem_ofPred_eq, Finset.mem_coe, List.mem_toFinset, l, + List.mem_ofFn] + constructor + · rintro ⟨j, hj, rfl⟩ + exact ⟨⟨j, by omega⟩, rfl⟩ + · rintro ⟨j, rfl⟩ + exact ⟨j, by omega, rfl⟩ + constructor + · intro a b l₁ l₂ heq + obtain ⟨j, _, rfl, rfl⟩ := consecutive a b l₁ l₂ heq + exact step j + · intro e + constructor + · rintro ⟨j, hj, rfl⟩ + have hjl : j < l.length := by simp [l]; omega + have hjl' : j + 1 < l.length := by simp [l]; omega + refine ⟨p j, p (j + 1), l.take j, l.drop (j + 2), ?_, rfl⟩ + have hd := List.getElem_cons_drop hjl + have hd' := List.getElem_cons_drop hjl' + have heq : l = l.take j ++ l[j] :: l[j + 1] :: l.drop (j + 2) := by + rw [show j + 2 = j + 1 + 1 by omega, hd', hd, List.take_append_drop] + simpa only [l, List.getElem_ofFn] using heq + · rintro ⟨a, b, l₁, l₂, heq, rfl⟩ + obtain ⟨j, hj, rfl, rfl⟩ := consecutive a b l₁ l₂ heq + exact ⟨j, hj, rfl⟩ + +private theorem capBetween : + (by + classical + exact + (Nat) → (∀ (m : Nat), (0 < m) → (∀ (u : GaussianInt), SimpleGridPathBetween + (BoundaryFootprintVertices (TileTranslation (DiamondTile m) u) ∩ + BoundaryFootprintVertices (TileTranslation (DiamondTile m) (u + ⟨0, 2 * (m : Int)⟩))) + (BoundaryFootprintEdges (TileTranslation (DiamondTile m) u) ∩ BoundaryFootprintEdges + (TileTranslation (DiamondTile m) (u + ⟨0, 2 * (m : Int)⟩))) (u + ⟨-1, 2 * (m : Int)⟩) + (u + ⟨1, 2 * (m : Int)⟩))) ) := by + classical + intro k m hm u + have hcap := P5203T1CapInterface m hm u + dsimp only at hcap + obtain ⟨hneT, hneU, hdisj, hV, hE, _⟩ := hcap + let p0 : GaussianInt := u + ⟨-1, 2 * (m : Int)⟩ + let p1 : GaussianInt := u + ⟨0, 2 * (m : Int)⟩ + let p2 : GaussianInt := u + ⟨1, 2 * (m : Int)⟩ + have hverts : {z | (z - u).im = 2 * (m : Int) ∧ + -1 ≤ (z - u).re ∧ (z - u).re ≤ 1} = + ({p0, p1, p2} : Set GaussianInt) := by + ext z + constructor + · rintro ⟨him, hlow, hhigh⟩ + have him' : z.im - u.im = 2 * (m : Int) := by + simpa only [Zsqrtd.im_sub] using him + have hre' : z.re - u.re = (z - u).re := by simp + have hlo' : -1 ≤ z.re - u.re := by simpa only [Zsqrtd.re_sub] using hlow + have hhi' : z.re - u.re ≤ 1 := by simpa only [Zsqrtd.re_sub] using hhigh + have hre : (z - u).re = -1 ∨ (z - u).re = 0 ∨ (z - u).re = 1 := by omega + rcases hre with h | h | h + · left + have hreal : z.re - u.re = -1 := by rw [hre']; exact h + have himag : z.im - u.im = 2 * (m : Int) := him' + apply Zsqrtd.ext_iff.mpr + constructor <;> simp [p0] <;> omega + · right; left + have hreal : z.re - u.re = 0 := by rw [hre']; exact h + have himag : z.im - u.im = 2 * (m : Int) := him' + apply Zsqrtd.ext_iff.mpr + constructor <;> simp [p1] <;> omega + · right; right + have hreal : z.re - u.re = 1 := by rw [hre']; exact h + have himag : z.im - u.im = 2 * (m : Int) := him' + apply Zsqrtd.ext_iff.mpr + constructor <;> simp [p2] <;> omega + · simp only [Set.mem_insert_iff, Set.mem_singleton_iff, p0, p1, p2] + rintro (rfl | rfl | rfl) <;> + simp [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, + Zsqrtd.im_add] <;> omega + have hedges : {e : Finset GaussianInt | ∃ a : Int, -1 ≤ a ∧ a < 1 ∧ + e = {u + ⟨a, 2 * (m : Int)⟩, u + ⟨a + 1, 2 * (m : Int)⟩}} = + ({{p0, p1}, {p1, p2}} : Set (Finset GaussianInt)) := by + ext e + constructor + · rintro ⟨a, ha, ha', rfl⟩ + rcases (show a = -1 ∨ a = 0 by omega) with rfl | rfl + · simp [p0, p1] + · simp [p1, p2] + · simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + rintro (rfl | rfl) + · exact ⟨-1, by omega, by omega, by simp [p0, p1]⟩ + · exact ⟨0, by omega, by omega, by simp [p1, p2]⟩ + have hp0 : p1 = p0 + 1 := by + apply Zsqrtd.ext <;> simp [p0, p1] + have hp1 : p2 = p1 + 1 := by + apply Zsqrtd.ext <;> simp [p1, p2] + have chain : [p0, p1, p2].IsChain (fun x y => + (x = p0 ∧ y = p1) ∨ (x = p1 ∧ y = p2)) := by simp + rw [hV, hE, hverts, hedges] + refine ⟨[p0, p1, p2], ?_⟩ + constructor + · simp [p0, p1, p2, Zsqrtd.ext_iff] + constructor + · norm_num + constructor + · rfl + constructor + · rfl + constructor + · ext z + simp + constructor + · intro x y l r h + rcases List.isChain_iff_forall_rel_of_append_cons_cons.mp chain h with + ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · simpa [p0, p1] using (Or.inl hp0 : p1 = p0 + 1 ∨ _) + · simpa [p1, p2] using (Or.inl hp1 : p2 = p1 + 1 ∨ _) + · intro e + constructor + · simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + rintro (rfl | rfl) + · exact ⟨p0, p1, [], [p2], rfl, rfl⟩ + · exact ⟨p1, p2, [p0], [], rfl, rfl⟩ + · rintro ⟨x, y, l, r, h, rfl⟩ + rcases List.isChain_iff_forall_rel_of_append_cons_cons.mp chain h with + ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · simp + · simp + +private theorem rawStaircase : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → ((Y.cells.Nonempty) → + ((Disjoint X.cells Y.cells) → (FootprintVertices X ∩ FootprintVertices Y = + BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y)))) → ((∀ (X : ProtoTile), + ∀ (Y : ProtoTile), (Disjoint X.cells Y.cells) → (FootprintEdges X ∩ FootprintEdges Y + = BoundaryFootprintEdges X ∩ BoundaryFootprintEdges Y)) → ((∀ (z : GaussianInt), ∀ + (horizontalFirst : Bool), ∀ (s : Int), (s = 1 ∨ s = -1) → (∀ (N : Nat), (0 < N) → + (SimpleGridPathBetween {v | ∃ j ≤ N, v = P5157T1StaircasePoint z horizontalFirst s + j} {e | ∃ j < N, e = {P5157T1StaircasePoint z horizontalFirst s j, + P5157T1StaircasePoint z horizontalFirst s (j + 1)}} (P5157T1StaircasePoint z + horizontalFirst s 0) (P5157T1StaircasePoint z horizontalFirst s N)))) → (∀ (X : + ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → ((Y.cells.Nonempty) → ((Disjoint + X.cells Y.cells) → (∀ (z : GaussianInt), ∀ (horizontalFirst : Bool), ∀ (s : Int), (s + = 1 ∨ s = -1) → (∀ (N : Nat), (0 < N) → ((BoundaryFootprintVertices X ∩ + BoundaryFootprintVertices Y = + {v | ∃ j ≤ N, v = P5157T1StaircasePoint z horizontalFirst s j}) → + ((BoundaryFootprintEdges X ∩ BoundaryFootprintEdges Y = + {e | ∃ j < N, e = {P5157T1StaircasePoint z horizontalFirst s j, + P5157T1StaircasePoint z horizontalFirst s (j + 1)}}) → (SimpleGridPathBetween + (FootprintVertices X ∩ FootprintVertices Y) (FootprintEdges X ∩ FootprintEdges + Y) (P5157T1StaircasePoint z horizontalFirst s 0) (P5157T1StaircasePoint z + horizontalFirst s N))))))))))) ) := by + classical + intro rawBoundaryVertices rawBoundaryEdges staircaseBetween X Y hX hY hdisj z horizontalFirst s + hs N hN hV hE + rw [rawBoundaryVertices X Y hX hY hdisj, hV, + rawBoundaryEdges X Y hdisj, hE] + exact staircaseBetween z horizontalFirst s hs N hN + +private theorem rawCapBetween : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → ((Y.cells.Nonempty) → + ((Disjoint X.cells Y.cells) → (FootprintVertices X ∩ FootprintVertices Y = + BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y)))) → ((∀ (X : ProtoTile), + ∀ (Y : ProtoTile), (Disjoint X.cells Y.cells) → (FootprintEdges X ∩ FootprintEdges Y + = BoundaryFootprintEdges X ∩ BoundaryFootprintEdges Y)) → ((∀ (m : Nat), (0 < m) → (∀ + (u : GaussianInt), SimpleGridPathBetween (BoundaryFootprintVertices (TileTranslation + (DiamondTile m) u) ∩ BoundaryFootprintVertices (TileTranslation (DiamondTile m) (u + + ⟨0, 2 * (m : Int)⟩))) (BoundaryFootprintEdges (TileTranslation (DiamondTile m) u) ∩ + BoundaryFootprintEdges (TileTranslation (DiamondTile m) (u + ⟨0, 2 * (m : Int)⟩))) (u + + ⟨-1, 2 * (m : Int)⟩) (u + ⟨1, 2 * (m : Int)⟩))) → (∀ (m : Nat), (0 < m) → (∀ (u : + GaussianInt), (Disjoint (TileTranslation (DiamondTile m) u).cells + (TileTranslation (DiamondTile m) (u + ⟨0, 2 * (m : Int)⟩)).cells) → + (SimpleGridPathBetween (FootprintVertices (TileTranslation (DiamondTile m) u) ∩ + FootprintVertices (TileTranslation (DiamondTile m) (u + ⟨0, 2 * (m : Int)⟩))) + (FootprintEdges (TileTranslation (DiamondTile m) u) ∩ FootprintEdges + (TileTranslation (DiamondTile m) (u + ⟨0, 2 * (m : Int)⟩))) (u + ⟨-1, 2 * (m : + Int)⟩) (u + ⟨1, 2 * (m : Int)⟩)))))) ) := by + classical + intro rawBoundaryVertices rawBoundaryEdges capBetween m hm u hdisj + have hcap := P5203T1CapInterface m hm u + dsimp only at hcap + rcases hcap with ⟨hneT, hneU, _, _, _, _⟩ + rw [rawBoundaryVertices _ _ hneT hneU hdisj, + rawBoundaryEdges _ _ hdisj] + exact capBetween m hm u + +private theorem twoVertexPath : + (by + classical + exact + (Nat) → (∀ (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (x : GaussianInt), + ∀ (y : GaussianInt), (x ≠ y) → ((V = {x, y}) → ((E = {{x, y}}) → ((y = x + 1 ∨ y = x + - 1 ∨ y = x + ⟨0, 1⟩ ∨ + y = x - ⟨0, 1⟩) → (SimpleGridPathBetween V E x y))))) ) := by + classical + intro k V E x y hne hV hE hstep + rw [hV, hE] + refine ⟨[x, y], ?_⟩ + constructor + · simp [hne] + constructor + · norm_num + constructor + · rfl + constructor + · rfl + constructor + · ext z + simp + constructor + · intro a b l₁ l₂ heq + have llen := congrArg List.length heq + simp only [List.length_cons, List.length_nil, List.length_append] at llen + have h₁ : l₁ = [] := List.eq_nil_of_length_eq_zero (by omega) + have h₂ : l₂ = [] := List.eq_nil_of_length_eq_zero (by omega) + subst l₁ + subst l₂ + simp only [List.nil_append, List.cons.injEq, and_true] at heq + rcases heq with ⟨rfl, rfl⟩ + exact hstep + · intro e + constructor + · rintro rfl + exact ⟨x, y, [], [], rfl, rfl⟩ + · rintro ⟨a, b, l₁, l₂, heq, rfl⟩ + have llen := congrArg List.length heq + simp only [List.length_cons, List.length_nil, List.length_append] at llen + have h₁ : l₁ = [] := List.eq_nil_of_length_eq_zero (by omega) + have h₂ : l₂ = [] := List.eq_nil_of_length_eq_zero (by omega) + subst l₁ + subst l₂ + simp only [List.nil_append, List.cons.injEq, and_true] at heq + rcases heq with ⟨rfl, rfl⟩ + rfl + +private theorem diamondCellsNonempty : + (by + classical + exact + ∀ (m : Nat), (0 < m) → ((DiamondTile m).cells.Nonempty) ) := by + classical + intro m hm + refine ⟨0, (P4194T1DiamondCellRows m 0).1.mpr ?_⟩ + norm_num + omega + +private theorem reversePath : + (by + classical + exact + ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween V E y x) + ) := by + classical + intro V E x y hp + rcases hp with ⟨p, hn, hl, hh, ht, hV, hs, he⟩ + have revstep : ∀ a b l₁ l₂, p.reverse = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ := by + intro a b l₁ l₂ h + have h' : p = l₂.reverse ++ b :: a :: l₁.reverse := by + have := congrArg List.reverse h + simpa [List.reverse_append, List.append_assoc] using this + rcases hs b a _ _ h' with h | h | h | h + · exact Or.inr (Or.inl (by rw [h]; simp)) + · exact Or.inl (by rw [h]; simp) + · exact Or.inr (Or.inr (Or.inr (by rw [h]; simp))) + · exact Or.inr (Or.inr (Or.inl (by rw [h]; simp))) + have revocc (q : List GaussianInt) (e : Finset GaussianInt) + (ho : ∃ a b l₁ l₂, q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) : + ∃ a b l₁ l₂, q.reverse = l₁ ++ a :: b :: l₂ ∧ e = {a, b} := by + rcases ho with ⟨a, b, l₁, l₂, rfl, rfl⟩ + exact ⟨b, a, l₂.reverse, l₁.reverse, + by simp [List.reverse_append, List.append_assoc], Finset.pair_comm _ _⟩ + refine ⟨p.reverse, List.nodup_reverse.mpr hn, by simpa using hl, + by simpa using ht, by simpa using hh, by simpa using hV, revstep, ?_⟩ + intro e + exact ⟨fun h => revocc p e ((he e).mp h), fun h => + (he e).mpr (by simpa using revocc p.reverse e h)⟩ + +private theorem translatedDiamondCellsNonempty : + (by + classical + exact + (∀ (m : Nat), (0 < m) → ((DiamondTile m).cells.Nonempty)) → (∀ (m : Nat), (0 < m) → (∀ (u + : GaussianInt), (TileTranslation (DiamondTile m) u).cells.Nonempty)) ) := by + classical + intro diamondCellsNonempty m hm u + rw [(TileTranslationFormulas (DiamondTile m) u).1] + exact (diamondCellsNonempty m hm).image _ + +private theorem pathDW : + (by + classical + exact + ∀ (k : Nat), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → + ((Y.cells.Nonempty) → ((Disjoint X.cells Y.cells) → (∀ (z : GaussianInt), ∀ + (horizontalFirst : Bool), ∀ (s : Int), (s = 1 ∨ s = -1) → (∀ (N : Nat), (0 < N) → + ((BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y = {v | ∃ j ≤ N, v = + P5157T1StaircasePoint z horizontalFirst s j}) → ((BoundaryFootprintEdges X ∩ + BoundaryFootprintEdges Y = {e | ∃ j < N, e = + {P5157T1StaircasePoint z horizontalFirst s j, + P5157T1StaircasePoint z horizontalFirst s (j + 1)}}) → (SimpleGridPathBetween + (FootprintVertices X ∩ FootprintVertices Y) (FootprintEdges X ∩ FootprintEdges Y) + (P5157T1StaircasePoint z horizontalFirst s 0) (P5157T1StaircasePoint z + horizontalFirst s N))))))))) → ((∀ (m : Nat), (0 < m) → ((DiamondTile + m).cells.Nonempty)) → ((∀ (m : Nat), (0 < m) → (∀ (u : GaussianInt), (TileTranslation + (DiamondTile m) u).cells.Nonempty)) → ((0 < k) → ((0 < k - 1) → ( + let N : Nat := 2 * (k - 1) + (0 < N) → ( + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + (Disjoint (DiamondTile k).cells (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), + (1 : ℤ) - (↑k : ℤ)⟩ : GaussianInt)).cells) → ((BoundaryFootprintVertices (DiamondTile + k) ∩ BoundaryFootprintVertices (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : + ℤ), (1 : ℤ) - (↑k : ℤ)⟩ : GaussianInt)) = {v : GaussianInt | ∃ j ≤ (2 : ℕ) * (k - (1 + : ℕ)), v = P5157T1StaircasePoint (1 : GaussianInt) false (1 : ℤ) j}) → + ((BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation + (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 : ℤ) - (↑k : ℤ)⟩ : GaussianInt)) = {e : + Finset GaussianInt | ∃ j < (2 : ℕ) * (k - (1 : ℕ)), e = + {P5157T1StaircasePoint (1 : GaussianInt) false (1 : ℤ) j, + P5157T1StaircasePoint (1 : GaussianInt) false (1 : ℤ) (j + (1 : ℕ))}}) → + (SimpleGridPathBetween (FootprintVertices D ∩ FootprintVertices W) (FootprintEdges D + ∩ FootprintEdges W) (P5157T1StaircasePoint 1 false 1 0) (P5157T1StaircasePoint 1 + false 1 N)))))))))) ) := by + classical + intro k rawStaircase diamondCellsNonempty translatedDiamondCellsNonempty hkpos hsmall N hN D W + hDWd hDWv hDWe + exact rawStaircase D W (diamondCellsNonempty k hkpos) + (translatedDiamondCellsNonempty (k - 1) hsmall _) hDWd + 1 false 1 (Or.inl rfl) N hN hDWv hDWe + +private theorem pathLW : + (by + classical + exact + ∀ (k : Nat), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → + ((Y.cells.Nonempty) → ((Disjoint X.cells Y.cells) → (∀ (z : GaussianInt), ∀ + (horizontalFirst : Bool), ∀ (s : Int), (s = 1 ∨ s = -1) → (∀ (N : Nat), (0 < N) → + ((BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y = {v | ∃ j ≤ N, v = + P5157T1StaircasePoint z horizontalFirst s j}) → ((BoundaryFootprintEdges X ∩ + BoundaryFootprintEdges Y = {e | ∃ j < N, e = + {P5157T1StaircasePoint z horizontalFirst s j, + P5157T1StaircasePoint z horizontalFirst s (j + 1)}}) → (SimpleGridPathBetween + (FootprintVertices X ∩ FootprintVertices Y) (FootprintEdges X ∩ FootprintEdges Y) + (P5157T1StaircasePoint z horizontalFirst s 0) (P5157T1StaircasePoint z + horizontalFirst s N))))))))) → ((∀ (m : Nat), (0 < m) → (∀ (u : GaussianInt), + (TileTranslation (DiamondTile m) u).cells.Nonempty)) → ((0 < k) → ((0 < k - 1) → ( + let N : Nat := 2 * (k - 1) + (0 < N) → ( + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + (Disjoint (TileTranslation (DiamondTile k) (⟨(0 : ℤ), -((2 : ℤ) * (↑k : ℤ))⟩ : + GaussianInt)).cells (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 : ℤ) + - (↑k : ℤ)⟩ : GaussianInt)).cells) → ((BoundaryFootprintVertices (TileTranslation + (DiamondTile k) (⟨(0 : ℤ), -((2 : ℤ) * (↑k : ℤ))⟩ : GaussianInt)) ∩ + BoundaryFootprintVertices (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 + : ℤ) - (↑k : ℤ)⟩ : GaussianInt)) = {v : GaussianInt | ∃ j ≤ (2 : ℕ) * (k - (1 : ℕ)), + v = P5157T1StaircasePoint (1 : GaussianInt) false (-1 : ℤ) j}) → + ((BoundaryFootprintEdges (TileTranslation (DiamondTile k) (⟨(0 : ℤ), -((2 : ℤ) * (↑k + : ℤ))⟩ : GaussianInt)) ∩ BoundaryFootprintEdges (TileTranslation (DiamondTile (k - (1 + : ℕ))) (⟨(↑k : ℤ), (1 : ℤ) - (↑k : ℤ)⟩ : GaussianInt)) = {e : Finset GaussianInt | ∃ + j < (2 : ℕ) * (k - (1 : ℕ)), e = + {P5157T1StaircasePoint (1 : GaussianInt) false (-1 : ℤ) j, + P5157T1StaircasePoint (1 : GaussianInt) false (-1 : ℤ) (j + (1 : ℕ))}}) → + (SimpleGridPathBetween (FootprintVertices L ∩ FootprintVertices W) (FootprintEdges L + ∩ FootprintEdges W) (P5157T1StaircasePoint 1 false (-1) 0) (P5157T1StaircasePoint + 1 false (-1) N))))))))) ) := by + classical + intro k rawStaircase translatedDiamondCellsNonempty hkpos hsmall N hN D W L hLWd hLWv hLWe + exact rawStaircase L W + (translatedDiamondCellsNonempty k hkpos _) + (translatedDiamondCellsNonempty (k - 1) hsmall _) hLWd + 1 false (-1) (Or.inr rfl) N hN hLWv hLWe + +private theorem pathDEm : + (by + classical + exact + ∀ (k : Nat), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → + ((Y.cells.Nonempty) → ((Disjoint X.cells Y.cells) → (∀ (z : GaussianInt), ∀ + (horizontalFirst : Bool), ∀ (s : Int), (s = 1 ∨ s = -1) → (∀ (N : Nat), (0 < N) → + ((BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y = {v | ∃ j ≤ N, v = + P5157T1StaircasePoint z horizontalFirst s j}) → ((BoundaryFootprintEdges X ∩ + BoundaryFootprintEdges Y = {e | ∃ j < N, e = + {P5157T1StaircasePoint z horizontalFirst s j, + P5157T1StaircasePoint z horizontalFirst s (j + 1)}}) → (SimpleGridPathBetween + (FootprintVertices X ∩ FootprintVertices Y) (FootprintEdges X ∩ FootprintEdges Y) + (P5157T1StaircasePoint z horizontalFirst s 0) (P5157T1StaircasePoint z + horizontalFirst s N))))))))) → ((∀ (m : Nat), (0 < m) → ((DiamondTile + m).cells.Nonempty)) → ((∀ (m : Nat), (0 < m) → (∀ (u : GaussianInt), (TileTranslation + (DiamondTile m) u).cells.Nonempty)) → ((0 < k) → ((0 < k - 1) → ( + let N : Nat := 2 * (k - 1) + (0 < N) → ( + let D := DiamondTile k + let Em := TileTranslation (DiamondTile (k - 1)) ⟨-(k : Int), 1 - (k : Int)⟩ + (Disjoint (DiamondTile k).cells (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨-(↑k : ℤ), + (1 : ℤ) - (↑k : ℤ)⟩ : GaussianInt)).cells) → ((BoundaryFootprintVertices (DiamondTile + k) ∩ BoundaryFootprintVertices (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨-(↑k : + ℤ), (1 : ℤ) - (↑k : ℤ)⟩ : GaussianInt)) = {v : GaussianInt | ∃ j ≤ (2 : ℕ) * (k - (1 + : ℕ)), v = P5157T1StaircasePoint (⟨-(↑k : ℤ), (↑k : ℤ) - (1 : ℤ)⟩ : GaussianInt) + true (-1 : ℤ) j}) → ((BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges + (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨-(↑k : ℤ), (1 : ℤ) - (↑k : ℤ)⟩ : + GaussianInt)) = {e : Finset GaussianInt | ∃ j < (2 : ℕ) * (k - (1 : ℕ)), e = + {P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) j, + P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) (j + 1)}}) → + (SimpleGridPathBetween (FootprintVertices D ∩ FootprintVertices Em) (FootprintEdges D + ∩ FootprintEdges Em) (P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) + 0) (P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) N)))))))))) ) := by + classical + intro k rawStaircase diamondCellsNonempty translatedDiamondCellsNonempty hkpos hsmall N hN D Em + hDEd hDEv hDEe + exact rawStaircase D Em (diamondCellsNonempty k hkpos) + (translatedDiamondCellsNonempty (k - 1) hsmall _) hDEd + ⟨-(k : Int), (k : Int) - 1⟩ true (-1) (Or.inr rfl) N hN hDEv hDEe + +private theorem translatedPath : + (by + classical + exact + ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, ∀ (u : GaussianInt), (SimpleGridPathBetween V E x y) → + (SimpleGridPathBetween (GaussianTranslation u '' V) ((fun e : Finset GaussianInt => + e.image (GaussianTranslation u)) '' E) (GaussianTranslation u x) (GaussianTranslation + u y)) ) := by + classical + intro V E x y u hp + apply P4055T1GridPathImage (GaussianTranslation u) + · intro a b hab + exact add_right_cancel hab + · intro a b h + rcases h with h | h | h | h + · subst b; left; apply Zsqrtd.ext <;> simp [GaussianTranslation]; abel + · subst b; right; left; apply Zsqrtd.ext <;> simp [GaussianTranslation]; abel + · subst b; right; right; left; apply Zsqrtd.ext <;> simp [GaussianTranslation]; abel + · subst b; right; right; right; apply Zsqrtd.ext <;> simp [GaussianTranslation]; abel + · exact hp + +private theorem translatePathTiles : + (by + classical + exact + (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, ∀ (u : GaussianInt), (SimpleGridPathBetween V E x y) → + (SimpleGridPathBetween (GaussianTranslation u '' V) ((fun e : Finset GaussianInt => + e.image (GaussianTranslation u)) '' E) (GaussianTranslation u x) (GaussianTranslation + u y))) → (∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (u : GaussianInt), ∀ + {x : GaussianInt}, ∀ {y : GaussianInt}, (SimpleGridPathBetween (FootprintVertices X ∩ + FootprintVertices Y) + (FootprintEdges X ∩ FootprintEdges Y) x y) → (SimpleGridPathBetween + (FootprintVertices (TileTranslation X u) ∩ FootprintVertices (TileTranslation Y + u)) (FootprintEdges (TileTranslation X u) ∩ FootprintEdges (TileTranslation Y u)) + (GaussianTranslation u x) (GaussianTranslation u y))) ) := by + classical + intro translatedPath X Y u x y hp + have hinj : Function.Injective (GaussianTranslation u) := by + intro a b hab + exact add_right_cancel hab + have heinj : Function.Injective + (fun e : Finset GaussianInt => e.image (GaussianTranslation u)) := + Finset.image_injective hinj + have hi := translatedPath u hp + rw [Set.image_inter hinj, Set.image_inter heinj] at hi + simpa only [(TileTranslationFormulas X u).2.2.2.2.2.1, + (TileTranslationFormulas Y u).2.2.2.2.2.1, + (TileTranslationFormulas X u).2.2.2.2.2.2.1, + (TileTranslationFormulas Y u).2.2.2.2.2.2.1] using hi + +private theorem translateComp : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), TileTranslation + (TileTranslation T u) v = TileTranslation T (u + v) ) := by + classical + intro T u v + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · simp only [TileTranslation] + rw [Finset.image_image] + congr 1 + funext z + simp [GaussianTranslation, add_comm, add_left_comm] + · simp [TileTranslation, GaussianTranslation, add_comm, + add_left_comm] + +private theorem hEmShift : + (by + classical + exact + ∀ (k : Nat), + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let Em := TileTranslation (DiamondTile (k - 1)) ⟨-(k : Int), 1 - (k : Int)⟩ + (∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), TileTranslation + (TileTranslation T u) v = TileTranslation T (u + v)) → ( + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + TileTranslation Em shiftR = W) ) := by + classical + intro k W Em translateComp shiftR + rw [show Em = TileTranslation (DiamondTile (k - 1)) + ⟨-(k : Int), 1 - (k : Int)⟩ by rfl, + translateComp] + congr 1 + apply Zsqrtd.ext <;> simp [shiftR]; omega + +private theorem pathRBC : + (by + classical + exact + ∀ (k : Nat), + let N : Nat := 2 * (k - 1) + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let Em := TileTranslation (DiamondTile (k - 1)) ⟨-(k : Int), 1 - (k : Int)⟩ + (SimpleGridPathBetween (FootprintVertices D ∩ FootprintVertices Em) (FootprintEdges D ∩ + FootprintEdges Em) (P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) 0) + (P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) N)) → ((∀ (X : + ProtoTile), ∀ (Y : ProtoTile), ∀ (u : GaussianInt), ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, (SimpleGridPathBetween (FootprintVertices X ∩ FootprintVertices Y) + (FootprintEdges X ∩ FootprintEdges Y) x y) → (SimpleGridPathBetween + (FootprintVertices (TileTranslation X u) ∩ FootprintVertices (TileTranslation Y u)) + (FootprintEdges (TileTranslation X u) ∩ FootprintEdges (TileTranslation Y u)) + (GaussianTranslation u x) (GaussianTranslation u y))) → ( + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + (TileTranslation Em shiftR = W) → (SimpleGridPathBetween (FootprintVertices + (TileTranslation D shiftR) ∩ FootprintVertices W) (FootprintEdges (TileTranslation D + shiftR) ∩ FootprintEdges W) (P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true + (-1) 0 + shiftR) (P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) N + + shiftR)))) ) := by + classical + intro k N D W Em pathDEm translatePathTiles shiftR hEmShift + have hpath := translatePathTiles D Em shiftR pathDEm + rw [hEmShift] at hpath + simpa only [GaussianTranslation] using hpath + +private theorem hpStart : + (by + classical + exact + P5157T1StaircasePoint 1 false 1 0 = 1 ) := by + classical + apply Zsqrtd.ext_iff.mpr + constructor <;> simp [P5157T1StaircasePoint] + +private theorem hpEnd : + (by + classical + exact + ∀ (k : Nat), ((1 : ℕ) < k) → ( + let N : Nat := 2 * (k - 1) + P5157T1StaircasePoint 1 false 1 N = ⟨(k : Int), (k : Int) - 1⟩) ) := by + classical + intro k hk N + apply Zsqrtd.ext_iff.mpr + constructor <;> simp [P5157T1StaircasePoint, N] <;> omega + +private theorem hqStart : + (by + classical + exact + P5157T1StaircasePoint 1 false (-1) 0 = 1 ) := by + classical + apply Zsqrtd.ext_iff.mpr + constructor <;> simp [P5157T1StaircasePoint] + +private theorem hqEnd : + (by + classical + exact + ∀ (k : Nat), ((1 : ℕ) < k) → ( + let N : Nat := 2 * (k - 1) + P5157T1StaircasePoint 1 false (-1) N = ⟨(k : Int), 1 - (k : Int)⟩) ) := by + classical + intro k hk N + apply Zsqrtd.ext_iff.mpr + constructor <;> simp [P5157T1StaircasePoint, N] <;> omega + +private theorem htStart : + (by + classical + exact + ∀ (k : Nat), + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + GaussianTranslation shiftR (P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) + 0) = ⟨(k : Int), (k : Int) - 1⟩ ) := by + classical + intro k shiftR + apply Zsqrtd.ext <;> simp [GaussianTranslation, P5157T1StaircasePoint, + shiftR]; omega + +private theorem htEnd : + (by + classical + exact + ∀ (k : Nat), ((1 : ℕ) < k) → ( + let N : Nat := 2 * (k - 1) + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + GaussianTranslation shiftR (P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) + N) = ⟨2 * (k : Int) - 1, 0⟩) ) := by + classical + intro k hk N shiftR + apply Zsqrtd.ext <;> simp [GaussianTranslation, P5157T1StaircasePoint, + shiftR, N] <;> omega + +private theorem pathWD : + (by + classical + exact + ∀ (k : Nat), + let N : Nat := 2 * (k - 1) + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + (SimpleGridPathBetween (FootprintVertices D ∩ FootprintVertices W) (FootprintEdges D ∩ + FootprintEdges W) (P5157T1StaircasePoint 1 false 1 0) (P5157T1StaircasePoint 1 + false 1 N)) → (SimpleGridPathBetween (FootprintVertices W ∩ FootprintVertices D) + (FootprintEdges W ∩ FootprintEdges D) (P5157T1StaircasePoint 1 false 1 0) + (P5157T1StaircasePoint 1 false 1 N)) ) := by + classical + intro k N D W pathDW + simpa only [Set.inter_comm] using pathDW + +private theorem pathWDrev : + (by + classical + exact + ∀ (k : Nat), (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ + {x : GaussianInt}, ∀ {y : GaussianInt}, (SimpleGridPathBetween V E x y) → + (SimpleGridPathBetween V E y x)) → ( + let N : Nat := 2 * (k - 1) + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + (SimpleGridPathBetween (FootprintVertices D ∩ FootprintVertices W) (FootprintEdges D ∩ + FootprintEdges W) (P5157T1StaircasePoint 1 false 1 0) (P5157T1StaircasePoint 1 + false 1 N)) → (SimpleGridPathBetween (FootprintVertices W ∩ FootprintVertices D) + (FootprintEdges W ∩ FootprintEdges D) (P5157T1StaircasePoint 1 false 1 N) + (P5157T1StaircasePoint 1 false 1 0))) ) := by + classical + intro k reversePath N D W pathDW + simpa only [Set.inter_comm] using reversePath pathDW + +private theorem translateZero : + (by + classical + exact + ∀ (T : ProtoTile), TileTranslation T 0 = T ) := by + classical + intro T + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · change Finset.image (fun z => z + (0 : GaussianInt)) cells = cells + simp + · simp [GaussianTranslation] + +private theorem hlowTile : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + (∀ (T : ProtoTile), TileTranslation T 0 = T) → ( + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + (shiftLow + ⟨0, 2 * (k : Int)⟩ = 0) → (TileTranslation D (shiftLow + ⟨0, 2 * (k : Int)⟩) + = D)) ) := by + classical + intro k D translateZero shiftLow hlowZero + rw [hlowZero] + exact translateZero D + +private theorem pathDL : + (by + classical + exact + ∀ (k : Nat), (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ + {x : GaussianInt}, ∀ {y : GaussianInt}, (SimpleGridPathBetween V E x y) → + (SimpleGridPathBetween V E y x)) → ( + let D := DiamondTile k + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + (SimpleGridPathBetween (FootprintVertices (TileTranslation (DiamondTile k) shiftLow) ∩ + FootprintVertices D) (FootprintEdges (TileTranslation (DiamondTile k) shiftLow) ∩ + FootprintEdges D) (shiftLow + (⟨(-1 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt)) + (shiftLow + (⟨(1 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt))) → (SimpleGridPathBetween + (FootprintVertices D ∩ FootprintVertices L) (FootprintEdges D ∩ FootprintEdges L) + (shiftLow + ⟨1, 2 * (k : Int)⟩) (shiftLow + ⟨-1, 2 * (k : Int)⟩))) ) := by + classical + intro k reversePath D L shiftLow pathLow + simpa only [Set.inter_comm, L] using reversePath pathLow + +private theorem huEq : + (by + classical + exact + ∀ (k : Nat), ∀ (u : GaussianInt), (((GaussianInt.toComplex : GaussianInt → ℂ) u).re = (↑k + : ℝ) ∧ ((GaussianInt.toComplex : GaussianInt → ℂ) u).im = (↑k : ℝ)) → (u = ⟨(k : + Int), (k : Int)⟩) ) := by + classical + intro k u hu + rcases hu with ⟨hre, him⟩ + apply Zsqrtd.ext + · have h : (u.re : Int) = k := by + rw [← GaussianInt.intCast_re u] at hre + exact_mod_cast hre + exact h + · have h : (u.im : Int) = k := by + rw [← GaussianInt.intCast_im u] at him + exact_mod_cast him + exact h + +private theorem F_inj : + (by + classical + exact + (Nat) → (∀ (u : GaussianInt), + let Q : GaussianInt → GaussianInt := GaussianQuarterTurn + let F : GaussianInt → GaussianInt := fun z => Q z + u + Function.Injective F) ) := by + classical + intro k u Q F a b hab + have hq : Q a = Q b := add_right_cancel hab + apply Zsqrtd.ext + · have h := congrArg (fun z : GaussianInt => z.im) hq + simpa [Q, GaussianQuarterTurn] using h + · have h := congrArg (fun z : GaussianInt => z.re) hq + have h' : -a.im = -b.im := by simpa [Q, GaussianQuarterTurn] using h + omega + +private theorem F_step : + (by + classical + exact + (Nat) → (∀ (u : GaussianInt), + let Q : GaussianInt → GaussianInt := GaussianQuarterTurn + let F : GaussianInt → GaussianInt := fun z => Q z + u + ∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → (F b = F + a + 1 ∨ F b = F a - 1 ∨ F b = F a + ⟨0, 1⟩ ∨ F b = F a - ⟨0, 1⟩)) ) := by + classical + intro k u Q F a b hab + rcases hab with h | h | h | h + · subst b; right; right; left; apply Zsqrtd.ext <;> simp [F, Q, GaussianQuarterTurn]; omega + · subst b; right; right; right; apply Zsqrtd.ext <;> simp [F, Q, GaussianQuarterTurn]; + omega + · subst b; right; left; apply Zsqrtd.ext <;> simp [F, Q, GaussianQuarterTurn]; omega + · subst b; left; apply Zsqrtd.ext <;> simp [F, Q, GaussianQuarterTurn]; omega + +private theorem quarterVertices : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + ∀ (u : GaussianInt), + let Q : GaussianInt → GaussianInt := GaussianQuarterTurn + let F : GaussianInt → GaussianInt := fun z => Q z + u + ∀ (d : GaussianInt), F '' FootprintVertices (TileTranslation D d) = FootprintVertices + (TileTranslation (TileQuarterTurn D) (u + Q d)) ) := by + classical + intro k D u Q F d + rw [(TileTranslationFormulas D d).2.2.2.2.2.1, + (TileTranslationFormulas (TileQuarterTurn D) (u + Q d)).2.2.2.2.2.1, + (TileQuarterTurnFormulas D).2.2.2.2.2.1] + rw [Set.image_image, Set.image_image] + congr 1 + funext z + simp [F, Q, GaussianTranslation, GaussianQuarterTurn, add_assoc, add_comm, + ] + +private theorem quarterEdges : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + ∀ (u : GaussianInt), + let Q : GaussianInt → GaussianInt := GaussianQuarterTurn + let F : GaussianInt → GaussianInt := fun z => Q z + u + ∀ (d : GaussianInt), (fun e : Finset GaussianInt => e.image F) '' FootprintEdges + (TileTranslation D d) = FootprintEdges (TileTranslation (TileQuarterTurn D) (u + Q + d)) ) := by + classical + intro k D u Q F d + rw [(TileTranslationFormulas D d).2.2.2.2.2.2.1, + (TileTranslationFormulas (TileQuarterTurn D) (u + Q d)).2.2.2.2.2.2.1, + (TileQuarterTurnFormulas D).2.2.2.2.2.2.1] + rw [Set.image_image, Set.image_image] + congr 1 + funext e + ext z + simp [F, Q, GaussianTranslation, GaussianQuarterTurn, + add_comm, add_left_comm] + +private theorem quarterBaseVertices : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + ∀ (u : GaussianInt), (FootprintVertices (TileTranslation (TileQuarterTurn D) u) = + FootprintVertices D) → (FootprintVertices (TileTranslation (TileQuarterTurn D) u) = + FootprintVertices D) ) := by + classical + intro k D u hquarterVertices + exact hquarterVertices + +private theorem quarterBaseEdges : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + ∀ (u : GaussianInt), ((TileTranslation (TileQuarterTurn D) u).cells = D.cells) → + (FootprintEdges (TileTranslation (TileQuarterTurn D) u) = FootprintEdges D) ) := by + classical + intro k D u hquarterCells + unfold FootprintEdges + rw [hquarterCells] + +private theorem quarterCellsAt : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + (∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), TileTranslation + (TileTranslation T u) v = TileTranslation T (u + v)) → (∀ (u : GaussianInt), + ((TileTranslation (TileQuarterTurn D) u).cells = D.cells) → (∀ (d : GaussianInt), + (TileTranslation (TileQuarterTurn D) (u + d)).cells = (TileTranslation D d).cells)) ) + := by + classical + intro k D translateComp u hquarterCells d + rw [← translateComp (TileQuarterTurn D) u d] + rw [(TileTranslationFormulas (TileTranslation (TileQuarterTurn D) u) d).1, + (TileTranslationFormulas D d).1, hquarterCells] + +private theorem quarterVerticesAt : + (by + classical + exact + ∀ (k : Nat), (∀ (m : Nat), (0 < m) → (∀ (u : GaussianInt), (TileTranslation (DiamondTile + m) u).cells.Nonempty)) → ((0 < k) → ( + let D := DiamondTile k + ∀ (u : GaussianInt), (∀ (d : GaussianInt), (TileTranslation (TileQuarterTurn D) (u + + d)).cells = (TileTranslation D d).cells) → (∀ (d : GaussianInt), FootprintVertices + (TileTranslation (TileQuarterTurn D) (u + d)) = FootprintVertices (TileTranslation D + d)))) ) := by + classical + intro k translatedDiamondCellsNonempty hkpos D u quarterCellsAt d + have hne : (TileTranslation D d).cells.Nonempty := + translatedDiamondCellsNonempty k hkpos d + unfold FootprintVertices + rw [ite_eq_left (by rw [quarterCellsAt d]; exact hne), ite_eq_left hne, + quarterCellsAt d] + +private theorem quarterEdgesAt : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + ∀ (u : GaussianInt), (∀ (d : GaussianInt), (TileTranslation (TileQuarterTurn D) (u + + d)).cells = (TileTranslation D d).cells) → (∀ (d : GaussianInt), FootprintEdges + (TileTranslation (TileQuarterTurn D) (u + d)) = FootprintEdges (TileTranslation D d)) + ) := by + classical + intro k D u quarterCellsAt d + simp only [FootprintEdges, quarterCellsAt d] + +private theorem pathRAB0 : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + (∀ (T : ProtoTile), TileTranslation T 0 = T) → ( + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + (SimpleGridPathBetween (FootprintVertices (TileTranslation (DiamondTile k) shiftLow) ∩ + FootprintVertices D) (FootprintEdges (TileTranslation (DiamondTile k) shiftLow) ∩ + FootprintEdges D) (shiftLow + (⟨(-1 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt)) + (shiftLow + (⟨(1 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt))) → (∀ (u : GaussianInt), + let Q : GaussianInt → GaussianInt := GaussianQuarterTurn + let F : GaussianInt → GaussianInt := fun z => Q z + u + (Function.Injective F) → ((∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ + b = a - ⟨0, 1⟩) → (F b = F a + 1 ∨ F b = F a - 1 ∨ F b = F a + ⟨0, 1⟩ ∨ F b = F a - + ⟨0, 1⟩)) → ((∀ (d : GaussianInt), F '' FootprintVertices (TileTranslation D d) = + FootprintVertices (TileTranslation (TileQuarterTurn D) (u + Q d))) → ((∀ (d : + GaussianInt), (fun e : Finset GaussianInt => e.image F) '' FootprintEdges + (TileTranslation D d) = FootprintEdges (TileTranslation (TileQuarterTurn D) (u + Q + d))) → ((FootprintVertices (TileTranslation (TileQuarterTurn D) u) = + FootprintVertices D) → ((FootprintEdges (TileTranslation (TileQuarterTurn D) u) = + FootprintEdges D) → ((∀ (d : GaussianInt), FootprintVertices (TileTranslation + (TileQuarterTurn D) (u + d)) = FootprintVertices (TileTranslation D d)) → ((∀ (d : + GaussianInt), FootprintEdges (TileTranslation (TileQuarterTurn D) (u + d)) = + FootprintEdges (TileTranslation D d)) → ((Q shiftLow = shiftR) → + (SimpleGridPathBetween (FootprintVertices (TileTranslation D shiftR) ∩ + FootprintVertices D) (FootprintEdges (TileTranslation D shiftR) ∩ FootprintEdges D) + (F (shiftLow + ⟨-1, 2 * (k : Int)⟩)) (F (shiftLow + ⟨1, 2 * (k : Int)⟩))))))))))))) ) + := by + classical + intro k D shiftR translateZero shiftLow pathLow u Q F F_inj F_step quarterVertices quarterEdges + quarterBaseVertices quarterBaseEdges quarterVerticesAt quarterEdgesAt shiftQuarter + have hi := P4055T1GridPathImage F F_inj F_step _ _ _ _ pathLow + have hedgeInj : Function.Injective + (fun e : Finset GaussianInt => e.image F) := Finset.image_injective F_inj + rw [Set.image_inter F_inj, Set.image_inter hedgeInj] at hi + rw [← translateZero D] at hi + rw [quarterVertices shiftLow, quarterVertices 0, + quarterEdges shiftLow, quarterEdges 0] at hi + simp? [Q, GaussianQuarterTurn] at hi + have hQshift : (⟨-shiftLow.im, shiftLow.re⟩ : GaussianInt) = shiftR := by + simpa [Q, GaussianQuarterTurn] using shiftQuarter + rw [show u + (⟨-shiftLow.im, shiftLow.re⟩ : GaussianInt) = u + shiftR by + rw [hQshift]] at hi + simp only [show (⟨0, 0⟩ : GaussianInt) = 0 by rfl, add_zero] at hi + rw [quarterVerticesAt shiftR, quarterEdgesAt shiftR, + quarterBaseVertices, quarterBaseEdges] at hi + simpa [translateZero, Set.inter_comm] using hi + +private theorem hxlow : + (by + classical + exact + ∀ (k : Nat), + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + ∀ (u : GaussianInt), (u = ⟨(k : Int), (k : Int)⟩) → ( + let Q : GaussianInt → GaussianInt := GaussianQuarterTurn + let F : GaussianInt → GaussianInt := fun z => Q z + u + F (shiftLow + ⟨-1, 2 * (k : Int)⟩) = ⟨(k : Int), (k : Int) - 1⟩) ) := by + classical + intro k shiftLow u huEq Q F + dsimp [F] + rw [huEq] + apply Zsqrtd.ext <;> simp [Q, GaussianQuarterTurn, shiftLow]; omega + +private theorem hxhigh : + (by + classical + exact + ∀ (k : Nat), + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + ∀ (u : GaussianInt), (u = ⟨(k : Int), (k : Int)⟩) → ( + let Q : GaussianInt → GaussianInt := GaussianQuarterTurn + let F : GaussianInt → GaussianInt := fun z => Q z + u + F (shiftLow + ⟨1, 2 * (k : Int)⟩) = ⟨(k : Int), (k : Int) + 1⟩) ) := by + classical + intro k shiftLow u huEq Q F + dsimp [F] + rw [huEq] + apply Zsqrtd.ext <;> simp [Q, GaussianQuarterTurn, shiftLow]; omega + +private theorem pathRAB : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + ∀ (u : GaussianInt), + let Q : GaussianInt → GaussianInt := GaussianQuarterTurn + let F : GaussianInt → GaussianInt := fun z => Q z + u + (SimpleGridPathBetween (FootprintVertices (TileTranslation D shiftR) ∩ FootprintVertices + D) (FootprintEdges (TileTranslation D shiftR) ∩ FootprintEdges D) (F (shiftLow + ⟨-1, + 2 * (k : Int)⟩)) (F (shiftLow + ⟨1, 2 * (k : Int)⟩))) → ((F (shiftLow + ⟨-1, 2 * (k : + Int)⟩) = ⟨(k : Int), (k : Int) - 1⟩) → ((F (shiftLow + ⟨1, 2 * (k : Int)⟩) = ⟨(k : + Int), (k : Int) + 1⟩) → (SimpleGridPathBetween (FootprintVertices D ∩ + FootprintVertices (TileTranslation D shiftR)) (FootprintEdges D ∩ FootprintEdges + (TileTranslation D shiftR)) ⟨(k : Int), (k : Int) - 1⟩ ⟨(k : Int), (k : Int) + 1⟩))) + ) := by + classical + intro k D shiftR shiftLow u Q F pathRAB0 hxlow hxhigh + simpa only [Set.inter_comm, hxlow, hxhigh] using pathRAB0 + +private theorem capBoundaryVerticesEq : + (by + classical + exact + (Nat) → (∀ (m : Nat), (0 < m) → (∀ (v : GaussianInt), BoundaryFootprintVertices + (TileTranslation (DiamondTile m) v) ∩ BoundaryFootprintVertices (TileTranslation + (DiamondTile m) (v + ⟨0, 2 * (m : Int)⟩)) = {v + ⟨-1, 2 * (m : Int)⟩, v + ⟨0, + 2 * (m : Int)⟩, v + ⟨1, 2 * (m : Int)⟩})) ) := by + classical + intro k m hm v + exact (by + have hcap := P5203T1CapInterface m hm v + dsimp only at hcap + rcases hcap with ⟨_, _, _, hV, _, _⟩ + rw [hV] + ext z + constructor + · rintro ⟨him, hlo, hhi⟩ + have him' : z.im - v.im = 2 * (m : Int) := by + simpa only [Zsqrtd.im_sub] using him + have hlo' : -1 ≤ z.re - v.re := by simpa only [Zsqrtd.re_sub] using hlo + have hhi' : z.re - v.re ≤ 1 := by simpa only [Zsqrtd.re_sub] using hhi + have hcase : (z - v).re = -1 ∨ (z - v).re = 0 ∨ (z - v).re = 1 := by + omega + rcases hcase with h | h | h + · left + apply Zsqrtd.ext_iff.mpr + constructor + · change z.re = v.re - 1 + have h' : (z - v).re = -1 := h + simp only [Zsqrtd.re_sub] at h' + omega + · change z.im = v.im + 2 * (m : Int) + have h' : (z - v).im = 2 * (m : Int) := him + simp only [Zsqrtd.im_sub] at h' + omega + · right; left + apply Zsqrtd.ext_iff.mpr + constructor + · change z.re = v.re + 0 + have h' : (z - v).re = 0 := h + simp only [Zsqrtd.re_sub] at h' + omega + · change z.im = v.im + 2 * (m : Int) + have h' : (z - v).im = 2 * (m : Int) := him + simp only [Zsqrtd.im_sub] at h' + omega + · right; right + apply Zsqrtd.ext_iff.mpr + constructor + · change z.re = v.re + 1 + have h' : (z - v).re = 1 := h + simp only [Zsqrtd.re_sub] at h' + omega + · change z.im = v.im + 2 * (m : Int) + have h' : (z - v).im = 2 * (m : Int) := him + simp only [Zsqrtd.im_sub] at h' + omega + · simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + rintro (rfl | rfl | rfl) + all_goals + simp only [Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_add, Zsqrtd.im_add] + omega + ) + +private theorem hcapLowRawVertices : + (by + classical + exact + ∀ (k : Nat), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → + ((Y.cells.Nonempty) → ((Disjoint X.cells Y.cells) → (FootprintVertices X ∩ + FootprintVertices Y = BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y)))) → + ((0 < k) → ( + let D := DiamondTile k + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + (Finset.Nonempty (TileTranslation (DiamondTile k) shiftLow).cells ∧ Finset.Nonempty + (TileTranslation (DiamondTile k) (shiftLow + (⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : + GaussianInt))).cells ∧ Disjoint (TileTranslation (DiamondTile k) shiftLow).cells + (TileTranslation (DiamondTile k) (shiftLow + (⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : + GaussianInt))).cells ∧ BoundaryFootprintVertices (TileTranslation (DiamondTile k) + shiftLow) ∩ BoundaryFootprintVertices (TileTranslation (DiamondTile k) (shiftLow + + (⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt))) = {z : GaussianInt | (z - + shiftLow).im = (2 : ℤ) * (↑k : ℤ) ∧ (-1 : ℤ) ≤ (z - shiftLow).re ∧ (z - shiftLow).re + ≤ (1 : ℤ)} ∧ BoundaryFootprintEdges (TileTranslation (DiamondTile k) shiftLow) ∩ + BoundaryFootprintEdges (TileTranslation (DiamondTile k) (shiftLow + (⟨(0 : ℤ), (2 : + ℤ) * (↑k : ℤ)⟩ : GaussianInt))) = {e : Finset GaussianInt | ∃ (a : ℤ), (-1 : ℤ) ≤ a ∧ + a < (1 : ℤ) ∧ e = {shiftLow + (⟨a, (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt), + shiftLow + (⟨a + (1 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt)}} ∧ SimpleGridPath {z : + GaussianInt | (z - shiftLow).im = (2 : ℤ) * (↑k : ℤ) ∧ (-1 : ℤ) ≤ (z - shiftLow).re ∧ + (z - shiftLow).re ≤ (1 : ℤ)} {e : Finset GaussianInt | ∃ (a : ℤ), (-1 : ℤ) ≤ a ∧ a < + (1 : ℤ) ∧ e = {shiftLow + (⟨a, (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt), + shiftLow + (⟨a + (1 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt)}}) → ((TileTranslation D + (shiftLow + (⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt)) = D) → ((∀ (m : Nat), (0 < + m) → (∀ (v : GaussianInt), BoundaryFootprintVertices (TileTranslation (DiamondTile m) + v) ∩ BoundaryFootprintVertices (TileTranslation (DiamondTile m) (v + ⟨0, 2 * (m : + Int)⟩)) = {v + ⟨-1, 2 * (m : Int)⟩, v + ⟨0, 2 * (m : Int)⟩, v + ⟨1, 2 * (m : Int)⟩})) + → (FootprintVertices (TileTranslation D shiftLow) ∩ FootprintVertices D = + {shiftLow + ⟨-1, 2 * (k : Int)⟩, shiftLow + ⟨0, 2 * (k : Int)⟩, shiftLow + ⟨1, + 2 * (k : Int)⟩}))))) ) := by + classical + intro k rawBoundaryVertices hkpos D shiftLow hcapLow hlowTile capBoundaryVerticesEq + have hupper : TileTranslation (DiamondTile k) + (shiftLow + ⟨0, 2 * (k : Int)⟩) = D := by + simpa [D] using hlowTile + have hupperNe : D.cells.Nonempty := by + simpa only [hupper] using hcapLow.2.1 + have hlowDisj : Disjoint (TileTranslation D shiftLow).cells D.cells := by + simpa only [hupper] using hcapLow.2.2.1 + calc + _ = BoundaryFootprintVertices (TileTranslation D shiftLow) ∩ + BoundaryFootprintVertices D := + rawBoundaryVertices _ _ hcapLow.1 hupperNe hlowDisj + _ = BoundaryFootprintVertices (TileTranslation D shiftLow) ∩ + BoundaryFootprintVertices + (TileTranslation D (shiftLow + ⟨0, 2 * (k : Int)⟩)) := by + exact congrArg (fun S : Set GaussianInt => + BoundaryFootprintVertices (TileTranslation D shiftLow) ∩ S) + (congrArg BoundaryFootprintVertices hupper).symm + _ = _ := capBoundaryVerticesEq k hkpos shiftLow + +private theorem quarterVerticesZero : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + (∀ (T : ProtoTile), TileTranslation T 0 = T) → (∀ (u : GaussianInt), + let Q : GaussianInt → GaussianInt := GaussianQuarterTurn + let F : GaussianInt → GaussianInt := fun z => Q z + u + (∀ (d : GaussianInt), F '' FootprintVertices (TileTranslation D d) = FootprintVertices + (TileTranslation (TileQuarterTurn D) (u + Q d))) → (F '' FootprintVertices D = + FootprintVertices (TileTranslation (TileQuarterTurn D) u))) ) := by + classical + intro k D translateZero u Q F quarterVertices + have h := quarterVertices 0 + have hq0 : Q 0 = 0 := by apply Zsqrtd.ext <;> simp [Q, GaussianQuarterTurn] + simpa only [translateZero, hq0, add_zero] using h + +private theorem hRABimage : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + ∀ (u : GaussianInt), + let Q : GaussianInt → GaussianInt := GaussianQuarterTurn + let F : GaussianInt → GaussianInt := fun z => Q z + u + (Function.Injective F) → ((∀ (d : GaussianInt), F '' FootprintVertices (TileTranslation D + d) = FootprintVertices (TileTranslation (TileQuarterTurn D) (u + Q d))) → + ((FootprintVertices (TileTranslation (TileQuarterTurn D) u) = FootprintVertices D) → + ((∀ (d : GaussianInt), FootprintVertices (TileTranslation (TileQuarterTurn D) (u + + d)) = FootprintVertices (TileTranslation D d)) → ((Q shiftLow = shiftR) → ((F '' + FootprintVertices D = FootprintVertices (TileTranslation (TileQuarterTurn D) u)) → (F + '' (FootprintVertices (TileTranslation D shiftLow) ∩ FootprintVertices D) = + FootprintVertices (TileTranslation D shiftR) ∩ FootprintVertices D)))))) ) := by + classical + intro k D shiftR shiftLow u Q F F_inj quarterVertices quarterBaseVertices quarterVerticesAt + shiftQuarter quarterVerticesZero + rw [Set.image_inter F_inj, quarterVertices shiftLow, quarterVerticesZero] + simp only [Q, GaussianQuarterTurn] + rw [show u + (⟨-shiftLow.im, shiftLow.re⟩ : GaussianInt) = u + shiftR by + rw [show (⟨-shiftLow.im, shiftLow.re⟩ : GaussianInt) = shiftR by + simpa [Q, GaussianQuarterTurn] using shiftQuarter]] + rw [quarterVerticesAt shiftR, quarterBaseVertices] + +private theorem hRABraw : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + ∀ (u : GaussianInt), (u = ⟨(k : Int), (k : Int)⟩) → ( + let Q : GaussianInt → GaussianInt := GaussianQuarterTurn + let F : GaussianInt → GaussianInt := fun z => Q z + u + (F (shiftLow + ⟨-1, 2 * (k : Int)⟩) = ⟨(k : Int), (k : Int) - 1⟩) → ((F (shiftLow + ⟨1, 2 + * (k : Int)⟩) = ⟨(k : Int), (k : Int) + 1⟩) → ((FootprintVertices (TileTranslation D + shiftLow) ∩ FootprintVertices D = {shiftLow + ⟨-1, 2 * (k : Int)⟩, shiftLow + ⟨0, + 2 * (k : Int)⟩, shiftLow + ⟨1, 2 * (k : Int)⟩}) → ((F '' (FootprintVertices + (TileTranslation D shiftLow) ∩ FootprintVertices D) = FootprintVertices + (TileTranslation D shiftR) ∩ FootprintVertices D) → (FootprintVertices D ∩ + FootprintVertices (TileTranslation D shiftR) = {⟨(k : Int), (k : Int) - 1⟩, + ⟨(k : Int), (k : Int)⟩, ⟨(k : Int), (k : Int) + 1⟩}))))) ) := by + classical + intro k D shiftR shiftLow u huEq Q F hxlow hxhigh hcapLowRawVertices hRABimage + rw [Set.inter_comm, ← hRABimage, hcapLowRawVertices] + have hmid : F (shiftLow + ⟨0, 2 * (k : Int)⟩) = + ⟨(k : Int), (k : Int)⟩ := by + dsimp [F] + rw [huEq] + apply Zsqrtd.ext <;> simp [Q, GaussianQuarterTurn, shiftLow] + rw [Set.image_insert_eq, Set.image_insert_eq, Set.image_singleton, + hxlow, hmid, hxhigh] + +private theorem hcontactCell : + (by + classical + exact + ∀ (k : Nat), ((1 : ℕ) < k) → ((⟨(k : Int), 1 - (k : Int)⟩ : GaussianInt) + ⟨-((k - 1 : + Nat) : Int) - 1, (k : Int) - 2⟩ = ⟨0, -1⟩) ) := by + classical + intro k hk + apply Zsqrtd.ext <;> simp; omega + +private theorem hUne : + (by + classical + exact + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + U.cells.Nonempty ) := by + classical + intro U + refine ⟨⟨0, -1⟩, ?_⟩ + simp [U] + +private theorem hWUv' : + (by + classical + exact + ∀ (k : Nat), + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + (BoundaryFootprintVertices (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 : + ℤ) - (↑k : ℤ)⟩ : GaussianInt)) ∩ BoundaryFootprintVertices (⟨{(⟨(0 : ℤ), + (-1 : ℤ)⟩ : GaussianInt)}, (⟨(0 : ℤ), (-1 : ℤ)⟩ : GaussianInt)⟩ : ProtoTile) = + {(⟨(0 : ℤ), (-1 : ℤ)⟩ : GaussianInt) + (1 : GaussianInt), (⟨(0 : ℤ), + (-1 : ℤ)⟩ : GaussianInt) + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)}) → + (BoundaryFootprintVertices W ∩ BoundaryFootprintVertices U = {1 + ⟨0, -1⟩, 1 + ⟨0, + 0⟩}) ) := by + classical + intro k W U hWUv + simpa [U, W, add_comm, add_assoc, add_left_comm] using hWUv + +private theorem hWedge' : + (by + classical + exact + ∀ (k : Nat), + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + ({(⟨(0 : ℤ), (-1 : ℤ)⟩ : GaussianInt) + (1 : GaussianInt), (⟨(0 : ℤ), + (-1 : ℤ)⟩ : GaussianInt) + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ + BoundaryFootprintEdges (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 : + ℤ) - (↑k : ℤ)⟩ : GaussianInt))) → (({1 + ⟨0, -1⟩, 1 + ⟨0, 0⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges W) ) := by + classical + intro k W hWUedge + simpa [W, add_comm, add_assoc, add_left_comm] using hWUedge + +private theorem hUedge' : + (by + classical + exact + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + ({1 + ⟨0, -1⟩, 1 + ⟨0, 0⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges U ) := by + classical + intro U + have hsing := P5253T1SingletonBoundary ⟨0, -1⟩ ⟨0, -1⟩ + rw [hsing.2] + simp [Finset.pair_comm, add_comm, add_left_comm] + +private theorem hWUpath : + (by + classical + exact + ∀ (k : Nat), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → + ((Y.cells.Nonempty) → ((Disjoint X.cells Y.cells) → (FootprintVertices X ∩ + FootprintVertices Y = BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y)))) → + ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), (Disjoint X.cells Y.cells) → (FootprintEdges + X ∩ FootprintEdges Y = BoundaryFootprintEdges X ∩ BoundaryFootprintEdges Y)) → ((∀ (V + : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), (x ≠ y) → ((V = {x, y}) → ((E = {{x, y}}) → ((y = x + 1 ∨ y = x - 1 ∨ y + = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → (SimpleGridPathBetween V E x y))))) → ( + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + (Finset.Nonempty (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 : ℤ) - (↑k : + ℤ)⟩ : GaussianInt)).cells) → ((Disjoint W.cells U.cells) → ((U.cells.Nonempty) → + ((BoundaryFootprintVertices W ∩ BoundaryFootprintVertices U = {1 + ⟨0, -1⟩, 1 + ⟨0, + 0⟩}) → ((({1 + ⟨0, -1⟩, 1 + ⟨0, 0⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges W) + → ((({1 + ⟨0, -1⟩, 1 + ⟨0, 0⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges U) → + (SimpleGridPathBetween (FootprintVertices W ∩ FootprintVertices U) (FootprintEdges W + ∩ FootprintEdges U) (1 + ⟨0, -1⟩) (1 + ⟨0, 0⟩)))))))))) ) := by + classical + intro k rawBoundaryVertices rawBoundaryEdges twoVertexPath W U hWne hWUdisj hUne hWUv' hWedge' + hUedge' + have hone := P5253T1OneEdgeInterface W U (1 + ⟨0, -1⟩) (1 + ⟨0, 0⟩) + hWne hUne hWUdisj hWUv' hWedge' hUedge' + (by right; right; left; apply Zsqrtd.ext <;> simp) + have hV : FootprintVertices W ∩ FootprintVertices U = + {1 + ⟨0, -1⟩, 1 + ⟨0, 0⟩} := by + rw [rawBoundaryVertices W U hWne hUne hWUdisj, hWUv'] + have hE : FootprintEdges W ∩ FootprintEdges U = + {{1 + ⟨0, -1⟩, 1 + ⟨0, 0⟩}} := by + rw [rawBoundaryEdges W U hWUdisj] + exact hone.1 + exact twoVertexPath _ _ _ _ (by norm_num [Zsqrtd.ext_iff]) hV hE + (by right; right; left; apply Zsqrtd.ext <;> simp) + +private theorem hDUv : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + (∀ (T : ProtoTile), TileTranslation T 0 = T) → ( + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + (Finset.Nonempty (TileTranslation (DiamondTile k) (0 : GaussianInt)).cells ∧ Disjoint + (TileTranslation (DiamondTile k) (0 : GaussianInt)).cells {(⟨(0 : ℤ), + (-1 : ℤ)⟩ : GaussianInt)} ∧ BoundaryFootprintVertices (TileTranslation (DiamondTile + k) (0 : GaussianInt)) ∩ BoundaryFootprintVertices (⟨{(⟨(0 : ℤ), + (-1 : ℤ)⟩ : GaussianInt)}, (⟨(0 : ℤ), (-1 : ℤ)⟩ : GaussianInt)⟩ : ProtoTile) = + {(0 : GaussianInt), (0 : GaussianInt) + (1 : GaussianInt)} ∧ {(0 : GaussianInt), + (0 : GaussianInt) + (1 : GaussianInt)} ∈ BoundaryFootprintEdges (TileTranslation + (DiamondTile k) (0 : GaussianInt))) → (BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices U = {0, 0 + 1})) ) := by + classical + intro k D translateZero U hbot + simpa [D, U, translateZero] using hbot.2.2.1 + +private theorem hUedgeBot : + (by + classical + exact + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + {0, 1} ∈ BoundaryFootprintEdges U ) := by + classical + intro U + have hsing := P5253T1SingletonBoundary ⟨0, -1⟩ ⟨0, -1⟩ + have hmem : ({0, 0 + 1} : Finset GaussianInt) ∈ + BoundaryFootprintEdges U := by + rw [hsing.2] + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + right + right + left + ext z; simp [Zsqrtd.ext_iff] + exact hmem + +private theorem hDUpath : + (by + classical + exact + ∀ (k : Nat), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → + ((Y.cells.Nonempty) → ((Disjoint X.cells Y.cells) → (FootprintVertices X ∩ + FootprintVertices Y = BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y)))) → + ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), (Disjoint X.cells Y.cells) → (FootprintEdges + X ∩ FootprintEdges Y = BoundaryFootprintEdges X ∩ BoundaryFootprintEdges Y)) → ((∀ (V + : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), (x ≠ y) → ((V = {x, y}) → ((E = {{x, y}}) → ((y = x + 1 ∨ y = x - 1 ∨ y + = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → (SimpleGridPathBetween V E x y))))) → ((∀ (m : Nat), + (0 < m) → ((DiamondTile m).cells.Nonempty)) → ((0 < k) → ( + let D := DiamondTile k + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + (U.cells.Nonempty) → ((Disjoint D.cells U.cells) → ((BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices U = {0, 1}) → (({0, 1} ∈ BoundaryFootprintEdges D) → (({0, + 1} ∈ BoundaryFootprintEdges U) → (SimpleGridPathBetween (FootprintVertices D ∩ + FootprintVertices U) (FootprintEdges D ∩ FootprintEdges U) 0 1)))))))))) ) := by + classical + intro k rawBoundaryVertices rawBoundaryEdges twoVertexPath diamondCellsNonempty hkpos D U hUne + hDULdisj hDUv' hDUedge' hUedgeBot' + have hone := P5253T1OneEdgeInterface D U 0 1 + (diamondCellsNonempty k hkpos) hUne hDULdisj hDUv' + hDUedge' hUedgeBot' (by left; simp) + have hV : FootprintVertices D ∩ FootprintVertices U = {0, 1} := by + rw [rawBoundaryVertices D U (diamondCellsNonempty k hkpos) hUne hDULdisj, + hDUv'] + have hE : FootprintEdges D ∩ FootprintEdges U = {{0, 1}} := by + rw [rawBoundaryEdges D U hDULdisj] + exact hone.1 + exact twoVertexPath _ _ _ _ (by norm_num [Zsqrtd.ext_iff]) hV hE + (by left; simp) + +private theorem hDLboundary : + (by + classical + exact + ∀ (k : Nat), (0 < k) → ( + let D := DiamondTile k + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + (TileTranslation D (shiftLow + (⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt)) = D) → ((∀ + (m : Nat), (0 < m) → (∀ (v : GaussianInt), BoundaryFootprintVertices (TileTranslation + (DiamondTile m) v) ∩ BoundaryFootprintVertices (TileTranslation (DiamondTile m) (v + + ⟨0, 2 * (m : Int)⟩)) = {v + ⟨-1, 2 * (m : Int)⟩, v + ⟨0, 2 * (m : Int)⟩, v + ⟨1, + 2 * (m : Int)⟩})) → (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices L = + {shiftLow + ⟨-1, 2 * (k : Int)⟩, shiftLow + ⟨0, 2 * (k : Int)⟩, shiftLow + ⟨1, + 2 * (k : Int)⟩}))) ) := by + classical + intro k hkpos D L shiftLow hlowTile capBoundaryVerticesEq + have hupper : TileTranslation (DiamondTile k) + (shiftLow + ⟨0, 2 * (k : Int)⟩) = D := by + simpa [D] using hlowTile + have h := capBoundaryVerticesEq k hkpos shiftLow + rw [hupper] at h + calc + _ = BoundaryFootprintVertices L ∩ BoundaryFootprintVertices D := by + exact Set.inter_comm _ _ + _ = {shiftLow + ⟨-1, 2 * (k : Int)⟩, + shiftLow + ⟨0, 2 * (k : Int)⟩, shiftLow + ⟨1, 2 * (k : Int)⟩} := by + simpa [L] using h + +private theorem hcapRight : + (by + classical + exact + ∀ (k : Nat), + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + (1 : GaussianInt) = shiftLow + ⟨1, 2 * (k : Int)⟩ ) := by + classical + intro k shiftLow + apply Zsqrtd.ext <;> simp [shiftLow] + +private theorem hyDL : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices L = {shiftLow + ⟨-1, + 2 * (k : Int)⟩, shiftLow + ⟨0, 2 * (k : Int)⟩, shiftLow + ⟨1, 2 * (k : Int)⟩}) → (((1 + : GaussianInt) = shiftLow + ⟨1, 2 * (k : Int)⟩) → ((1 : GaussianInt) ∈ + BoundaryFootprintVertices D ∩ BoundaryFootprintVertices L)) ) := by + classical + intro k D L shiftLow hDLboundary hcapRight + rw [hDLboundary] + simp [hcapRight] + +private theorem hyDW : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices (TileTranslation + (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 : ℤ) - (↑k : ℤ)⟩ : GaussianInt)) = {v : + GaussianInt | ∃ j ≤ (2 : ℕ) * (k - (1 : ℕ)), v = P5157T1StaircasePoint (1 : + GaussianInt) false (1 : ℤ) j}) → ((1 : GaussianInt) ∈ BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices W) ) := by + classical + intro k D W hDWv + rw [hDWv] + exact ⟨0, Nat.zero_le _, + by simp [P5157T1StaircasePoint, Zsqrtd.ext_iff]⟩ + +private theorem hyLW : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + (BoundaryFootprintVertices (TileTranslation (DiamondTile k) (⟨(0 : ℤ), -((2 : ℤ) * (↑k : + ℤ))⟩ : GaussianInt)) ∩ BoundaryFootprintVertices (TileTranslation (DiamondTile (k - + (1 : ℕ))) (⟨(↑k : ℤ), (1 : ℤ) - (↑k : ℤ)⟩ : GaussianInt)) = {v : GaussianInt | ∃ j ≤ + (2 : ℕ) * (k - (1 : ℕ)), v = P5157T1StaircasePoint (1 : GaussianInt) false (-1 : ℤ) + j}) → ((1 : GaussianInt) ∈ BoundaryFootprintVertices L ∩ BoundaryFootprintVertices W) + ) := by + classical + intro k D W L hLWv + rw [hLWv] + exact ⟨0, Nat.zero_le _, + by simp [P5157T1StaircasePoint, Zsqrtd.ext_iff]⟩ + +private theorem hsmallI : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + ( + let D := DiamondTile k; TouchingTriple D (TileTranslation D (⟨(0 : ℤ), -((2 : ℤ) * (↑k : + ℤ))⟩ : GaussianInt)) (P5124T1ParentModel k (2 : Fin (3 : ℕ)) true) ∧ TouchingTriple + D (P5124T1ParentModel k (1 : Fin (3 : ℕ)) true) (P5124T1ParentModel k (2 : Fin (3 + : ℕ)) false) ∧ TouchingTriple D (P5124T1ParentModel k (2 : Fin (3 : ℕ)) true) + (P5124T1ParentModel k (0 : Fin (3 : ℕ)) false)) → (TouchingTriple D L W) ) := by + classical + intro k D W L hsmallTriple + change TouchingTriple D L W ∧ _ ∧ _ at hsmallTriple + exact hsmallTriple.1 + +private theorem hIboundaryUnique : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + ((1 : GaussianInt) ∈ BoundaryFootprintVertices D ∩ BoundaryFootprintVertices L) → (((1 : + GaussianInt) ∈ BoundaryFootprintVertices L ∩ BoundaryFootprintVertices W) → + ((TouchingTriple D L W) → (∀ z, (z ∈ BoundaryFootprintVertices D ∧ z ∈ + BoundaryFootprintVertices L ∧ z ∈ BoundaryFootprintVertices W) ↔ z = 1))) ) := by + classical + intro k D W L hyDL hyLW hsmallI + have huniq := hsmallI.2.2.2 + rcases huniq with ⟨p, hp, hunique⟩ + have hpOne : p = 1 := by + have h := hunique 1 ⟨hyDL.1, hyDL.2, hyLW.2⟩ + exact h.symm + intro z + constructor + · intro hz + have h := hunique z hz + exact h.trans hpOne + · intro hz + subst z + exact ⟨hyDL.1, hyDL.2, hyLW.2⟩ + +private theorem Jcoordinate : + (by + classical + exact + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + ∀ (z : GaussianInt), J z = ⟨z.re, 2 * (k : Int) - z.im⟩ ) := by + classical + intro k J z + apply Zsqrtd.ext <;> simp [J, GaussianTranslation, GaussianReflection]; omega + +private theorem reflectedPath : + (by + classical + exact + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween (J '' V) + ((fun e : Finset GaussianInt => e.image J) '' E) (J x) (J y)) ) := by + classical + intro k J V E x y hp + apply P4055T1GridPathImage J + · intro a b hab + have hR (z : GaussianInt) : GaussianReflection (GaussianReflection z) = z := by + apply Zsqrtd.ext <;> simp [GaussianReflection] + have hinjR : Function.Injective GaussianReflection := by + intro u v huv + calc + u = GaussianReflection (GaussianReflection u) := (hR u).symm + _ = GaussianReflection (GaussianReflection v) := congrArg GaussianReflection huv + _ = v := hR v + exact hinjR (add_right_cancel hab) + · intro a b h + rcases h with h | h | h | h + · subst b; left; apply Zsqrtd.ext <;> simp [J, GaussianTranslation, GaussianReflection] + · subst b; right; left; apply Zsqrtd.ext <;> simp [J, GaussianTranslation, + GaussianReflection] + · subst b; right; right; right; apply Zsqrtd.ext <;> simp [J, GaussianTranslation, + GaussianReflection]; abel + · subst b; right; right; left; apply Zsqrtd.ext <;> simp [J, GaussianTranslation, + GaussianReflection]; abel + · exact hp + +private theorem Jx : + (by + classical + exact + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + (∀ (z : GaussianInt), J z = ⟨z.re, 2 * (k : Int) - z.im⟩) → ( + let x : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ + J x = ⟨(k : Int), (k : Int) + 1⟩) ) := by + classical + intro k J Jcoordinate x + rw [Jcoordinate] + apply Zsqrtd.ext + · rfl + · change 2 * (k : Int) - ((k : Int) - 1) = (k : Int) + 1 + ring + +private theorem Jy : + (by + classical + exact + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + (∀ (z : GaussianInt), J z = ⟨z.re, 2 * (k : Int) - z.im⟩) → ( + let y : GaussianInt := 1 + J y = ⟨1, 2 * (k : Int)⟩) ) := by + classical + intro k J Jcoordinate y + rw [Jcoordinate] + apply Zsqrtd.ext <;> simp [y] + +private theorem hDWraw : + (by + classical + exact + ∀ (k : Nat), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → + ((Y.cells.Nonempty) → ((Disjoint X.cells Y.cells) → (FootprintVertices X ∩ + FootprintVertices Y = BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y)))) → + ((∀ (m : Nat), (0 < m) → ((DiamondTile m).cells.Nonempty)) → ((0 < k) → ( + let N : Nat := 2 * (k - 1) + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + (Disjoint (DiamondTile k).cells (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), + (1 : ℤ) - (↑k : ℤ)⟩ : GaussianInt)).cells) → ((BoundaryFootprintVertices (DiamondTile + k) ∩ BoundaryFootprintVertices (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : + ℤ), (1 : ℤ) - (↑k : ℤ)⟩ : GaussianInt)) = {v : GaussianInt | ∃ j ≤ (2 : ℕ) * (k - (1 + : ℕ)), v = P5157T1StaircasePoint (1 : GaussianInt) false (1 : ℤ) j}) → + ((Finset.Nonempty (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 : ℤ) - + (↑k : ℤ)⟩ : GaussianInt)).cells) → (FootprintVertices D ∩ FootprintVertices W = {v | + ∃ j ≤ N, v = P5157T1StaircasePoint 1 false 1 j})))))) ) := by + classical + intro k rawBoundaryVertices diamondCellsNonempty hkpos N D W hDWd hDWv hWne + rw [rawBoundaryVertices D W (diamondCellsNonempty k hkpos) hWne hDWd, + hDWv] + +private theorem hLWraw : + (by + classical + exact + ∀ (k : Nat), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → + ((Y.cells.Nonempty) → ((Disjoint X.cells Y.cells) → (FootprintVertices X ∩ + FootprintVertices Y = BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y)))) → + ((∀ (m : Nat), (0 < m) → (∀ (u : GaussianInt), (TileTranslation (DiamondTile m) + u).cells.Nonempty)) → ((0 < k) → ( + let N : Nat := 2 * (k - 1) + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + (Disjoint (TileTranslation (DiamondTile k) (⟨(0 : ℤ), -((2 : ℤ) * (↑k : ℤ))⟩ : + GaussianInt)).cells (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 : ℤ) + - (↑k : ℤ)⟩ : GaussianInt)).cells) → ((BoundaryFootprintVertices (TileTranslation + (DiamondTile k) (⟨(0 : ℤ), -((2 : ℤ) * (↑k : ℤ))⟩ : GaussianInt)) ∩ + BoundaryFootprintVertices (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 + : ℤ) - (↑k : ℤ)⟩ : GaussianInt)) = {v : GaussianInt | ∃ j ≤ (2 : ℕ) * (k - (1 : ℕ)), + v = P5157T1StaircasePoint (1 : GaussianInt) false (-1 : ℤ) j}) → ((Finset.Nonempty + (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 : ℤ) - (↑k : ℤ)⟩ : + GaussianInt)).cells) → (FootprintVertices L ∩ FootprintVertices W = {v | ∃ j ≤ N, v = + P5157T1StaircasePoint 1 false (-1) j})))))) ) := by + classical + intro k rawBoundaryVertices translatedDiamondCellsNonempty hkpos N D W L hLWd hLWv hWne + rw [rawBoundaryVertices L W (translatedDiamondCellsNonempty k hkpos _) + hWne hLWd, hLWv] + +private theorem hWURaw : + (by + classical + exact + ∀ (k : Nat), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → + ((Y.cells.Nonempty) → ((Disjoint X.cells Y.cells) → (FootprintVertices X ∩ + FootprintVertices Y = BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y)))) → ( + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + (Finset.Nonempty (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 : ℤ) - (↑k : + ℤ)⟩ : GaussianInt)).cells) → ((Disjoint W.cells U.cells) → ((U.cells.Nonempty) → + ((BoundaryFootprintVertices W ∩ BoundaryFootprintVertices U = {1 + ⟨0, -1⟩, 1 + ⟨0, + 0⟩}) → (FootprintVertices W ∩ FootprintVertices U = {1 + ⟨0, -1⟩, 1 + ⟨0, 0⟩}))))) ) + := by + classical + intro k rawBoundaryVertices W U hWne hWUdisj hUne hWUv' + rw [rawBoundaryVertices W U hWne hUne hWUdisj, hWUv'] + +private theorem hDURaw : + (by + classical + exact + ∀ (k : Nat), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → + ((Y.cells.Nonempty) → ((Disjoint X.cells Y.cells) → (FootprintVertices X ∩ + FootprintVertices Y = BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y)))) → + ((∀ (m : Nat), (0 < m) → ((DiamondTile m).cells.Nonempty)) → ((0 < k) → ( + let D := DiamondTile k + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + (U.cells.Nonempty) → ((Disjoint D.cells U.cells) → ((BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices U = {0, 1}) → (FootprintVertices D ∩ FootprintVertices U = + {0, 1})))))) ) := by + classical + intro k rawBoundaryVertices diamondCellsNonempty hkpos D U hUne hDULdisj hDUv' + rw [rawBoundaryVertices D U (diamondCellsNonempty k hkpos) hUne hDULdisj, + hDUv'] + +private theorem hAunique : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + (FootprintVertices W ∩ FootprintVertices U = {1 + ⟨0, -1⟩, 1 + ⟨0, 0⟩}) → + ((FootprintVertices D ∩ FootprintVertices U = {0, 1}) → (∀ z, z ∈ FootprintVertices D + ∩ FootprintVertices W ∩ FootprintVertices U ↔ z = 1)) ) := by + classical + intro k D W U hWURaw hDURaw z + constructor + · intro hz + have hz' := hz + simp only [Set.mem_inter_iff] at hz' + have hWU : z ∈ FootprintVertices W ∩ FootprintVertices U := + ⟨hz'.1.2, hz'.2⟩ + have hDU : z ∈ FootprintVertices D ∩ FootprintVertices U := + ⟨hz'.1.1, hz'.2⟩ + rw [hWURaw] at hWU + rw [hDURaw] at hDU + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hWU hDU + rcases hWU with hWU | hWU + · rcases hDU with hDU | hDU + · have hbad : (1 + (⟨0, -1⟩ : GaussianInt)) = 0 := + hWU.symm.trans hDU + norm_num [Zsqrtd.ext_iff] at hbad + · have hbad : (1 + (⟨0, -1⟩ : GaussianInt)) = 1 := + hWU.symm.trans hDU + norm_num [Zsqrtd.ext_iff] at hbad + · rcases hDU with hDU | hDU + · have hbad : (1 : GaussianInt) = 0 := hWU.symm.trans hDU + norm_num [Zsqrtd.ext_iff] at hbad + · exact hDU + · intro hz + subst z + have hWU : (1 : GaussianInt) ∈ FootprintVertices W ∩ FootprintVertices U := by + rw [hWURaw] + simp [Zsqrtd.ext_iff] + have hDU : (1 : GaussianInt) ∈ FootprintVertices D ∩ FootprintVertices U := by + rw [hDURaw] + simp + exact ⟨⟨hDU.1, hWU.1⟩, hDU.2⟩ + +private theorem pathIAB : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + (SimpleGridPathBetween (FootprintVertices D ∩ FootprintVertices L) (FootprintEdges D ∩ + FootprintEdges L) (shiftLow + ⟨1, 2 * (k : Int)⟩) (shiftLow + ⟨-1, 2 * (k : Int)⟩)) → + ((shiftLow + ⟨1, 2 * (k : Int)⟩ = 1) → ((shiftLow + ⟨-1, 2 * (k : Int)⟩ = -1) → + (SimpleGridPathBetween (FootprintVertices D ∩ FootprintVertices L) (FootprintEdges D + ∩ FootprintEdges L) 1 (-1)))) ) := by + classical + intro k D L shiftLow pathDL hlowStart hlowEnd + simpa only [hlowStart, hlowEnd] using pathDL + +private theorem pathICA : + (by + classical + exact + ∀ (k : Nat), + let N : Nat := 2 * (k - 1) + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + (SimpleGridPathBetween (FootprintVertices D ∩ FootprintVertices W) (FootprintEdges D ∩ + FootprintEdges W) (P5157T1StaircasePoint 1 false 1 0) (P5157T1StaircasePoint 1 + false 1 N)) → ((P5157T1StaircasePoint 1 false 1 0 = 1) → ((P5157T1StaircasePoint + 1 false 1 N = ⟨(k : Int), (k : Int) - 1⟩) → ( + let x : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ + SimpleGridPathBetween (FootprintVertices W ∩ FootprintVertices D) (FootprintEdges W ∩ + FootprintEdges D) 1 x))) ) := by + classical + intro k N D W pathDW hpStart hpEnd x + simpa only [Set.inter_comm, hpStart, hpEnd, x] using pathDW + +private theorem pathAAB : + (by + classical + exact + ∀ (k : Nat), + let N : Nat := 2 * (k - 1) + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + (SimpleGridPathBetween (FootprintVertices D ∩ FootprintVertices W) (FootprintEdges D ∩ + FootprintEdges W) (P5157T1StaircasePoint 1 false 1 0) (P5157T1StaircasePoint 1 + false 1 N)) → ((P5157T1StaircasePoint 1 false 1 0 = 1) → ((P5157T1StaircasePoint + 1 false 1 N = ⟨(k : Int), (k : Int) - 1⟩) → ( + let x : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ + SimpleGridPathBetween (FootprintVertices D ∩ FootprintVertices W) (FootprintEdges D ∩ + FootprintEdges W) 1 x))) ) := by + classical + intro k N D W pathDW hpStart hpEnd x + simpa only [hpStart, hpEnd, x] using pathDW + +private theorem pathABC : + (by + classical + exact + ∀ (k : Nat), (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ + {x : GaussianInt}, ∀ {y : GaussianInt}, (SimpleGridPathBetween V E x y) → + (SimpleGridPathBetween V E y x)) → ( + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + (SimpleGridPathBetween (FootprintVertices W ∩ FootprintVertices U) (FootprintEdges W ∩ + FootprintEdges U) (1 + ⟨0, -1⟩) (1 + ⟨0, 0⟩)) → (SimpleGridPathBetween + (FootprintVertices W ∩ FootprintVertices U) (FootprintEdges W ∩ FootprintEdges U) 1 + (1 + ⟨0, -1⟩))) ) := by + classical + intro k reversePath W U hWUpath + have hOne : (1 + ⟨0, 0⟩ : GaussianInt) = 1 := by + apply Zsqrtd.ext <;> simp + simpa only [hOne] using reversePath hWUpath + +private theorem pathACA : + (by + classical + exact + ∀ (k : Nat), (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ + {x : GaussianInt}, ∀ {y : GaussianInt}, (SimpleGridPathBetween V E x y) → + (SimpleGridPathBetween V E y x)) → ( + let D := DiamondTile k + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + (SimpleGridPathBetween (FootprintVertices D ∩ FootprintVertices U) (FootprintEdges D ∩ + FootprintEdges U) 0 1) → (SimpleGridPathBetween (FootprintVertices U ∩ + FootprintVertices D) (FootprintEdges U ∩ FootprintEdges D) 1 0)) ) := by + classical + intro k reversePath D U hDUpath + simpa only [Set.inter_comm] using reversePath hDUpath + +private theorem hRBC : + (by + classical + exact + ∀ (k : Nat), + let N : Nat := 2 * (k - 1) + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + (SimpleGridPathBetween (FootprintVertices (TileTranslation D shiftR) ∩ FootprintVertices + W) (FootprintEdges (TileTranslation D shiftR) ∩ FootprintEdges W) + (P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) 0 + shiftR) + (P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) N + shiftR)) → + ((GaussianTranslation shiftR (P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ + true (-1) 0) = ⟨(k : Int), (k : Int) - 1⟩) → ((GaussianTranslation shiftR + (P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) N) = ⟨2 * (k : Int) - + 1, 0⟩) → ( + let x : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ + SimpleGridPathBetween (FootprintVertices (TileTranslation D shiftR) ∩ FootprintVertices + W) (FootprintEdges (TileTranslation D shiftR) ∩ FootprintEdges W) x ⟨2 * (k : Int) - + 1, 0⟩))) ) := by + classical + intro k N D W shiftR pathRBC htStart htEnd x + have hstart : P5157T1StaircasePoint + ⟨-(k : Int), (k : Int) - 1⟩ true (-1) 0 + shiftR = x := by + change GaussianTranslation shiftR + (P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) 0) = x + exact htStart + have hend : P5157T1StaircasePoint + ⟨-(k : Int), (k : Int) - 1⟩ true (-1) N + shiftR = + ⟨2 * (k : Int) - 1, 0⟩ := by + change GaussianTranslation shiftR + (P5157T1StaircasePoint ⟨-(k : Int), (k : Int) - 1⟩ true (-1) N) = _ + exact htEnd + rw [hstart, hend] at pathRBC + exact pathRBC + +private theorem hIABoundary : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + (∀ z, (z ∈ BoundaryFootprintVertices D ∧ z ∈ BoundaryFootprintVertices L ∧ z ∈ + BoundaryFootprintVertices W) ↔ z = 1) → (∀ z, (z ∈ BoundaryFootprintVertices D ∧ z ∈ + BoundaryFootprintVertices L ∧ z ∈ BoundaryFootprintVertices W) ↔ z = 1) ) := by + classical + intro k D W L hIboundaryUnique + exact hIboundaryUnique + +private theorem hIuniqueRaw : + (by + classical + exact + ∀ (k : Nat), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → + ((Y.cells.Nonempty) → ((Disjoint X.cells Y.cells) → (FootprintVertices X ∩ + FootprintVertices Y = BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y)))) → + ((∀ (m : Nat), (0 < m) → ((DiamondTile m).cells.Nonempty)) → ((∀ (m : Nat), (0 < m) → + (∀ (u : GaussianInt), (TileTranslation (DiamondTile m) u).cells.Nonempty)) → ((0 < k) + → ( + let N : Nat := 2 * (k - 1) + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + (Disjoint (TileTranslation (DiamondTile k) (⟨(0 : ℤ), -((2 : ℤ) * (↑k : ℤ))⟩ : + GaussianInt)).cells (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 : ℤ) + - (↑k : ℤ)⟩ : GaussianInt)).cells) → ( + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + (Finset.Nonempty (TileTranslation (DiamondTile k) shiftLow).cells ∧ Finset.Nonempty + (TileTranslation (DiamondTile k) (shiftLow + (⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : + GaussianInt))).cells ∧ Disjoint (TileTranslation (DiamondTile k) shiftLow).cells + (TileTranslation (DiamondTile k) (shiftLow + (⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : + GaussianInt))).cells ∧ BoundaryFootprintVertices (TileTranslation (DiamondTile k) + shiftLow) ∩ BoundaryFootprintVertices (TileTranslation (DiamondTile k) (shiftLow + + (⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt))) = {z : GaussianInt | (z - + shiftLow).im = (2 : ℤ) * (↑k : ℤ) ∧ (-1 : ℤ) ≤ (z - shiftLow).re ∧ (z - shiftLow).re + ≤ (1 : ℤ)} ∧ BoundaryFootprintEdges (TileTranslation (DiamondTile k) shiftLow) ∩ + BoundaryFootprintEdges (TileTranslation (DiamondTile k) (shiftLow + (⟨(0 : ℤ), (2 : + ℤ) * (↑k : ℤ)⟩ : GaussianInt))) = {e : Finset GaussianInt | ∃ (a : ℤ), (-1 : ℤ) ≤ a ∧ + a < (1 : ℤ) ∧ e = {shiftLow + (⟨a, (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt), + shiftLow + (⟨a + (1 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt)}} ∧ SimpleGridPath {z : + GaussianInt | (z - shiftLow).im = (2 : ℤ) * (↑k : ℤ) ∧ (-1 : ℤ) ≤ (z - shiftLow).re ∧ + (z - shiftLow).re ≤ (1 : ℤ)} {e : Finset GaussianInt | ∃ (a : ℤ), (-1 : ℤ) ≤ a ∧ a < + (1 : ℤ) ∧ e = {shiftLow + (⟨a, (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt), + shiftLow + (⟨a + (1 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt)}}) → ((TileTranslation D + (shiftLow + (⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt)) = D) → ((Finset.Nonempty + (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 : ℤ) - (↑k : ℤ)⟩ : + GaussianInt)).cells) → (((1 : GaussianInt) ∈ BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices L) → ((∀ z, (z ∈ BoundaryFootprintVertices D ∧ z ∈ + BoundaryFootprintVertices L ∧ z ∈ BoundaryFootprintVertices W) ↔ z = 1) → + ((FootprintVertices D ∩ FootprintVertices W = {v | ∃ j ≤ N, v = + P5157T1StaircasePoint 1 false 1 j}) → (∀ z, z ∈ FootprintVertices D ∩ + FootprintVertices L ∩ FootprintVertices W ↔ z = 1))))))))))) ) := by + classical + intro k rawBoundaryVertices diamondCellsNonempty translatedDiamondCellsNonempty hkpos N D W L + hLWd shiftLow hcapLow hlowTile hWne hyDL hIboundaryUnique hDWraw z + constructor + · intro hz + have hz' := hz + simp only [Set.mem_inter_iff] at hz' + have hDL : z ∈ FootprintVertices D ∩ FootprintVertices L := + hz'.1 + have hLW : z ∈ FootprintVertices L ∩ FootprintVertices W := + ⟨hz'.1.2, hz'.2⟩ + have hcapLowDisj : Disjoint D.cells L.cells := by + have hupper : TileTranslation (DiamondTile k) + (shiftLow + ⟨0, 2 * (k : Int)⟩) = D := by + simpa [D] using hlowTile + have h' : Disjoint (TileTranslation (DiamondTile k) shiftLow).cells D.cells := by + simpa only [hupper] using hcapLow.2.2.1 + simpa [L] using h'.symm + rw [rawBoundaryVertices D L (diamondCellsNonempty k hkpos) + (translatedDiamondCellsNonempty k hkpos _) hcapLowDisj] at hDL + rw [rawBoundaryVertices L W (translatedDiamondCellsNonempty k hkpos _) + hWne hLWd] at hLW + exact (hIboundaryUnique z).mp ⟨hDL.1, hDL.2, hLW.2⟩ + · intro hz + subst z + have hupper : TileTranslation (DiamondTile k) + (shiftLow + ⟨0, 2 * (k : Int)⟩) = D := by + simpa [D] using hlowTile + have hDLdisj : Disjoint D.cells L.cells := by + have h := hcapLow.2.2.1 + rw [hupper] at h + simpa [L] using h.symm + have hDLraw : (1 : GaussianInt) ∈ + FootprintVertices D ∩ FootprintVertices L := by + rw [rawBoundaryVertices D L (diamondCellsNonempty k hkpos) + (translatedDiamondCellsNonempty k hkpos _) hDLdisj] + exact ⟨hyDL.1, hyDL.2⟩ + exact ⟨hDLraw, (by + have hDW : (1 : GaussianInt) ∈ FootprintVertices D ∩ FootprintVertices W := by + rw [hDWraw] + exact ⟨0, Nat.zero_le _, by simp [P5157T1StaircasePoint, + Zsqrtd.ext_iff]⟩ + exact hDW.2)⟩ + +private theorem pImagBound : + (by + classical + exact + ∀ (k : Nat), ((1 : ℕ) < k) → ( + let N : Nat := 2 * (k - 1) + ∀ (j : Nat), (j ≤ N) → ((P5157T1StaircasePoint 1 false 1 j).im ≤ (k : Int) - 1)) ) := by + classical + intro k hk N j hj + simp only [P5157T1StaircasePoint, Zsqrtd.im_add] + dsimp [N] at hj ⊢ + omega + +private theorem hRunique : + (by + classical + exact + ∀ (k : Nat), + let N : Nat := 2 * (k - 1) + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + (P5157T1StaircasePoint 1 false 1 N = ⟨(k : Int), (k : Int) - 1⟩) → ((FootprintVertices + D ∩ FootprintVertices (TileTranslation D shiftR) = {⟨(k : Int), (k : Int) - 1⟩, + ⟨(k : Int), (k : Int)⟩, ⟨(k : Int), (k : Int) + 1⟩}) → ( + let x : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ + (FootprintVertices D ∩ FootprintVertices W = {v | ∃ j ≤ N, v = P5157T1StaircasePoint 1 + false 1 j}) → ((∀ (j : Nat), (j ≤ N) → ((P5157T1StaircasePoint 1 false 1 j).im ≤ (k + : Int) - 1)) → (∀ z, z ∈ FootprintVertices D ∩ FootprintVertices (TileTranslation D + shiftR) ∩ FootprintVertices W ↔ z = x)))) ) := by + classical + intro k N D W shiftR hpEnd hRABraw x hDWraw pImagBound z + constructor + · intro hz + have hz' := hz + simp only [Set.mem_inter_iff] at hz' + have hAB : z ∈ FootprintVertices D ∩ + FootprintVertices (TileTranslation D shiftR) := ⟨hz'.1.1, hz'.1.2⟩ + have hDW : z ∈ FootprintVertices D ∩ FootprintVertices W := + ⟨hz'.1.1, hz'.2⟩ + rw [hRABraw] at hAB + rw [hDWraw] at hDW + obtain ⟨j, hj, hpoint⟩ := hDW + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hAB + rcases hAB with hab | hab | hab + · simpa [x] using hab + · have him : z.im = (k : Int) := by + simpa using congrArg Zsqrtd.im hab + have hjim : z.im ≤ (k : Int) - 1 := by + rw [hpoint] + exact pImagBound j hj + omega + · have him : z.im = (k : Int) + 1 := by + simpa using congrArg Zsqrtd.im hab + have hjim : z.im ≤ (k : Int) - 1 := by + rw [hpoint] + exact pImagBound j hj + omega + · intro hz + subst z + have hxAB : x ∈ FootprintVertices D ∩ + FootprintVertices (TileTranslation D shiftR) := by + rw [hRABraw] + simp [x, Zsqrtd.ext_iff] + have hxDW : x ∈ FootprintVertices D ∩ FootprintVertices W := by + rw [hDWraw] + exact ⟨N, le_rfl, hpEnd.symm⟩ + exact ⟨hxAB, hxDW.2⟩ + +private theorem sameCellObs : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (T' : ProtoTile), (T.cells = T'.cells) → ((T.cells.Nonempty) → + (FootprintVertices T = FootprintVertices T' ∧ FootprintEdges T = FootprintEdges T')) + ) := by + classical + intro T T' hc hne + cases T with + | mk tc ta => + cases T' with + | mk uc ua => + dsimp only at hc + subst uc + have hne' : tc.Nonempty := hne + simp [FootprintVertices, FootprintEdges, hne] + +private theorem JtranslatedVertices : + (by + classical + exact + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + ∀ (m : Nat), (0 < m) → (∀ (s : GaussianInt), ∀ (t : GaussianInt), (t = ⟨s.re, 2 * (k : + Int) - + 2 * (m : Int) - s.im⟩) → (J '' FootprintVertices (TileTranslation (DiamondTile m) s) + = FootprintVertices (TileTranslation (DiamondTile m) t))) ) := by + classical + intro k J m hm s t hst + exact (P5691T1DiamondReflectionFootprints k m hm s t hst).1 + +private theorem JtranslatedEdges : + (by + classical + exact + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + ∀ (m : Nat), (0 < m) → (∀ (s : GaussianInt), ∀ (t : GaussianInt), (t = ⟨s.re, 2 * (k : + Int) - + 2 * (m : Int) - s.im⟩) → ((fun e : Finset GaussianInt => e.image J) '' FootprintEdges + (TileTranslation (DiamondTile m) s) = FootprintEdges (TileTranslation + (DiamondTile m) t))) ) := by + classical + intro k J m hm s t hst + exact (P5691T1DiamondReflectionFootprints k m hm s t hst).2 + +private theorem JtileVertices : + (by + classical + exact + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + ∀ (T : ProtoTile), FootprintVertices (TileTranslation (TileReflection T) ⟨0, 2 * (k : + Int)⟩) = J '' FootprintVertices T ) := by + classical + intro k J T + have ht := (TileTranslationFormulas (TileReflection T) + ⟨0, 2 * (k : Int)⟩).2.2.2.2.2.1 + have hr := (TileReflectionFormulas T).2.2.2.2.2.1 + rw [ht, hr, Set.image_image] + +private theorem JtileEdges : + (by + classical + exact + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + ∀ (T : ProtoTile), (fun e : Finset GaussianInt => e.image J) '' FootprintEdges T = + FootprintEdges (TileTranslation (TileReflection T) ⟨0, 2 * (k : Int)⟩) ) := by + classical + intro k J T + have ht := (TileTranslationFormulas (TileReflection T) + ⟨0, 2 * (k : Int)⟩).2.2.2.2.2.2.1 + have hr := (TileReflectionFormulas T).2.2.2.2.2.2.1 + rw [ht, hr, Set.image_image] + have hfun : (fun e : Finset GaussianInt => e.image J) = + (fun e => (e.image GaussianReflection).image + (GaussianTranslation ⟨0, 2 * (k : Int)⟩)) := by + funext e + rw [Finset.image_image] + rfl + rw [hfun] + +private theorem hFalse : + (by + classical + exact + ∀ (k : Nat), ((1 : ℕ) < k) → ( + let N : Nat := 2 * (k - 1) + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + (SimpleGridPathBetween (FootprintVertices L ∩ FootprintVertices W) (FootprintEdges L ∩ + FootprintEdges W) (P5157T1StaircasePoint 1 false (-1) 0) (P5157T1StaircasePoint 1 + false (-1) N)) → ( + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + (P5157T1StaircasePoint 1 false 1 0 = 1) → ((P5157T1StaircasePoint 1 false 1 N = ⟨(k : + Int), (k : Int) - 1⟩) → ((P5157T1StaircasePoint 1 false (-1) 0 = 1) → + ((P5157T1StaircasePoint 1 false (-1) N = ⟨(k : Int), 1 - (k : Int)⟩) → + ((SimpleGridPathBetween (FootprintVertices W ∩ FootprintVertices D) (FootprintEdges W + ∩ FootprintEdges D) (P5157T1StaircasePoint 1 false 1 N) (P5157T1StaircasePoint 1 + false 1 0)) → ((SimpleGridPathBetween (FootprintVertices D ∩ FootprintVertices + (TileTranslation D shiftR)) (FootprintEdges D ∩ FootprintEdges (TileTranslation D + shiftR)) ⟨(k : Int), (k : Int) - 1⟩ ⟨(k : Int), (k : Int) + 1⟩) → ( + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + let x : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ + (∀ z, z ∈ FootprintVertices D ∩ FootprintVertices W ∩ FootprintVertices U ↔ z = 1) → + ((SimpleGridPathBetween (FootprintVertices D ∩ FootprintVertices L) (FootprintEdges D + ∩ FootprintEdges L) 1 (-1)) → ((SimpleGridPathBetween (FootprintVertices W ∩ + FootprintVertices D) (FootprintEdges W ∩ FootprintEdges D) 1 x) → + ((SimpleGridPathBetween (FootprintVertices D ∩ FootprintVertices W) (FootprintEdges D + ∩ FootprintEdges W) 1 x) → ((SimpleGridPathBetween (FootprintVertices W ∩ + FootprintVertices U) (FootprintEdges W ∩ FootprintEdges U) 1 (1 + ⟨0, -1⟩)) → + ((SimpleGridPathBetween (FootprintVertices U ∩ FootprintVertices D) (FootprintEdges U + ∩ FootprintEdges D) 1 0) → ((SimpleGridPathBetween (FootprintVertices + (TileTranslation D shiftR) ∩ FootprintVertices W) (FootprintEdges (TileTranslation D + shiftR) ∩ FootprintEdges W) x ⟨2 * (k : Int) - 1, 0⟩) → ((∀ z, z ∈ FootprintVertices + D ∩ FootprintVertices L ∩ FootprintVertices W ↔ z = 1) → ((∀ z, z ∈ FootprintVertices + D ∩ FootprintVertices (TileTranslation D shiftR) ∩ FootprintVertices W ↔ z = x) → (( + let M := P5260T1PlacementLedger k 2 false + let D := DiamondTile k + ∃ R : ExactTileInterfaceTriple D (TileTranslation D M.2.1.1) M.1.1, + ∃ I : ExactTileInterfaceTriple D (TileTranslation D M.2.1.2) M.1.1, + ∃ A : ExactTileInterfaceTriple D M.1.1 M.1.2, + R.point = M.2.2.1 ∧ I.point = M.2.2.2 ∧ + A.point = M.2.2.2 ∧ R.otherCA = M.2.2.2 ∧ + I.otherCA = M.2.2.1 ∧ A.otherAB = M.2.2.1 ∧ + M.2.2.1 ≠ M.2.2.2)))))))))))))))))) ) := by + classical + intro k hk N D W L pathLW shiftR hpStart hpEnd hqStart hqEnd pathWDrev pathRAB U x hAunique + pathIAB pathICA pathAAB pathABC pathACA hRBC hIuniqueRaw hRunique + exact (by + dsimp [P5260T1PlacementLedger, P5124T1ParentModel] + have pathRCA : SimpleGridPathBetween + (FootprintVertices W ∩ FootprintVertices D) + (FootprintEdges W ∩ FootprintEdges D) x 1 := by + simpa only [hpStart, hpEnd, x] using pathWDrev + have pathIBC : SimpleGridPathBetween + (FootprintVertices L ∩ FootprintVertices W) + (FootprintEdges L ∩ FootprintEdges W) 1 + ⟨(k : Int), 1 - (k : Int)⟩ := by + simpa only [hqStart, hqEnd] using pathLW + refine ⟨⟨x, ⟨(k : Int), (k : Int) + 1⟩, + ⟨2 * (k : Int) - 1, 0⟩, 1, + pathRAB, hRBC, pathRCA, hRunique⟩, + ⟨⟨1, -1, ⟨(k : Int), 1 - (k : Int)⟩, x, + pathIAB, pathIBC, pathICA, hIuniqueRaw⟩, + ⟨⟨1, x, 1 + ⟨0, -1⟩, 0, + pathAAB, pathABC, pathACA, hAunique⟩, + ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩⟩⟩ + · rfl + · rfl + · rfl + · rfl + · rfl + · rfl + · intro hxy + have hre := congrArg Zsqrtd.re hxy + simp [] at hre + omega) + +private theorem Jinj : + (by + classical + exact + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + Function.Injective J ) := by + classical + intro k J u v huv + have htrans := congrArg (GaussianTranslation ⟨0, -2 * (k : Int)⟩) huv + have href (z : GaussianInt) : GaussianReflection (GaussianReflection z) = z := by + apply Zsqrtd.ext <;> simp [GaussianReflection] + have hR : GaussianReflection u = GaussianReflection v := by + simpa [J, GaussianTranslation] using htrans + calc + u = GaussianReflection (GaussianReflection u) := (href u).symm + _ = GaussianReflection (GaussianReflection v) := congrArg GaussianReflection hR + _ = v := href v + +private theorem Jstep : + (by + classical + exact + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + ∀ a c : GaussianInt, (c = a + 1 ∨ c = a - 1 ∨ c = a + ⟨0, 1⟩ ∨ c = a - ⟨0, 1⟩) → (J c = J + a + 1 ∨ J c = J a - 1 ∨ J c = J a + ⟨0, 1⟩ ∨ J c = J a - ⟨0, 1⟩) ) := by + classical + intro k J a c h + rcases h with h | h | h | h + · subst c; left; apply Zsqrtd.ext <;> simp [J, GaussianTranslation, GaussianReflection] + · subst c; right; left; apply Zsqrtd.ext <;> simp [J, GaussianTranslation, GaussianReflection] + · subst c; right; right; right; apply Zsqrtd.ext <;> + simp [J, GaussianTranslation, GaussianReflection]; omega + · subst c; right; right; left; apply Zsqrtd.ext <;> + simp [J, GaussianTranslation, GaussianReflection]; omega + +private theorem hzero : + (by + classical + exact + ∀ (k : Nat), (0 : GaussianInt) = ⟨0, 2 * (k : Int) - 2 * (k : Int) - 0⟩ ) := by + classical + intro k + apply Zsqrtd.ext <;> simp + +private theorem hJDe : + (by + classical + exact + ∀ (k : Nat), (0 < k) → ( + let D := DiamondTile k + (∀ (T : ProtoTile), TileTranslation T 0 = T) → ( + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + (∀ (m : Nat), (0 < m) → (∀ (s : GaussianInt), ∀ (t : GaussianInt), (t = ⟨s.re, 2 * (k : + Int) - 2 * (m : Int) - s.im⟩) → ((fun e : Finset GaussianInt => e.image J) '' + FootprintEdges (TileTranslation (DiamondTile m) s) = FootprintEdges (TileTranslation + (DiamondTile m) t)))) → (((0 : GaussianInt) = ⟨0, 2 * (k : Int) - 2 * (k : Int) - 0⟩) + → ((fun e : Finset GaussianInt => e.image J) '' FootprintEdges D = FootprintEdges + D)))) ) := by + classical + intro k hkpos D translateZero J JtranslatedEdges hzero + simpa only [translateZero] using JtranslatedEdges k hkpos 0 0 hzero + +private theorem hshiftR : + (by + classical + exact + ∀ (k : Nat), + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + shiftR = ⟨shiftR.re, 2 * (k : Int) - 2 * (k : Int) - shiftR.im⟩ ) := by + classical + intro k shiftR + apply Zsqrtd.ext <;> simp [shiftR] + +private theorem hJRSv : + (by + classical + exact + ∀ (k : Nat), (0 < k) → ( + let D := DiamondTile k + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + (∀ (m : Nat), (0 < m) → (∀ (s : GaussianInt), ∀ (t : GaussianInt), (t = ⟨s.re, 2 * (k : + Int) - 2 * (m : Int) - s.im⟩) → (J '' FootprintVertices (TileTranslation (DiamondTile + m) s) = FootprintVertices (TileTranslation (DiamondTile m) t)))) → ((shiftR = + ⟨shiftR.re, 2 * (k : Int) - 2 * (k : Int) - shiftR.im⟩) → (J '' FootprintVertices + (TileTranslation D shiftR) = FootprintVertices (TileTranslation D shiftR)))) ) := by + classical + intro k hkpos D shiftR J JtranslatedVertices hshiftR + exact JtranslatedVertices k hkpos shiftR shiftR hshiftR + +private theorem hJRSe : + (by + classical + exact + ∀ (k : Nat), (0 < k) → ( + let D := DiamondTile k + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + (∀ (m : Nat), (0 < m) → (∀ (s : GaussianInt), ∀ (t : GaussianInt), (t = ⟨s.re, 2 * (k : + Int) - 2 * (m : Int) - s.im⟩) → ((fun e : Finset GaussianInt => e.image J) '' + FootprintEdges (TileTranslation (DiamondTile m) s) = FootprintEdges (TileTranslation + (DiamondTile m) t)))) → ((shiftR = ⟨shiftR.re, 2 * (k : Int) - 2 * (k : Int) - + shiftR.im⟩) → ((fun e : Finset GaussianInt => e.image J) '' FootprintEdges + (TileTranslation D shiftR) = FootprintEdges (TileTranslation D shiftR)))) ) := by + classical + intro k hkpos D shiftR J JtranslatedEdges hshiftR + exact JtranslatedEdges k hkpos shiftR shiftR hshiftR + +private theorem hJRSe' : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + ((fun e : Finset GaussianInt => e.image J) '' FootprintEdges (TileTranslation D shiftR) = + FootprintEdges (TileTranslation D shiftR)) → (FootprintEdges (TileTranslation D + shiftR) = (fun e : Finset GaussianInt => e.image J) '' FootprintEdges + (TileTranslation D shiftR)) ) := by + classical + intro k D shiftR J hJRSe + exact hJRSe.symm + +private theorem hJDLv : + (by + classical + exact + ∀ (k : Nat), (0 < k) → ( + let D := DiamondTile k + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + (∀ (m : Nat), (0 < m) → (∀ (s : GaussianInt), ∀ (t : GaussianInt), (t = ⟨s.re, 2 * (k : + Int) - 2 * (m : Int) - s.im⟩) → (J '' FootprintVertices (TileTranslation (DiamondTile + m) s) = FootprintVertices (TileTranslation (DiamondTile m) t)))) → ( + let shiftHigh : GaussianInt := ⟨0, 2 * (k : Int)⟩ + J '' FootprintVertices (TileTranslation D shiftLow) = FootprintVertices (TileTranslation + D shiftHigh))) ) := by + classical + intro k hkpos D shiftLow J JtranslatedVertices shiftHigh + apply JtranslatedVertices k hkpos shiftLow shiftHigh + apply Zsqrtd.ext <;> simp [shiftLow, shiftHigh] + +private theorem hJDLe : + (by + classical + exact + ∀ (k : Nat), (0 < k) → ( + let D := DiamondTile k + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + (∀ (m : Nat), (0 < m) → (∀ (s : GaussianInt), ∀ (t : GaussianInt), (t = ⟨s.re, 2 * (k : + Int) - 2 * (m : Int) - s.im⟩) → ((fun e : Finset GaussianInt => e.image J) '' + FootprintEdges (TileTranslation (DiamondTile m) s) = FootprintEdges (TileTranslation + (DiamondTile m) t)))) → ( + let shiftHigh : GaussianInt := ⟨0, 2 * (k : Int)⟩ + (fun e : Finset GaussianInt => e.image J) '' FootprintEdges (TileTranslation D shiftLow) + = FootprintEdges (TileTranslation D shiftHigh))) ) := by + classical + intro k hkpos D shiftLow J JtranslatedEdges shiftHigh + apply JtranslatedEdges k hkpos shiftLow shiftHigh + apply Zsqrtd.ext <;> simp [shiftLow, shiftHigh] + +private theorem hJDLe' : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + let shiftHigh : GaussianInt := ⟨0, 2 * (k : Int)⟩ + ((fun e : Finset GaussianInt => e.image J) '' FootprintEdges (TileTranslation D shiftLow) + = FootprintEdges (TileTranslation D shiftHigh)) → (FootprintEdges (TileTranslation D + shiftHigh) = (fun e : Finset GaussianInt => e.image J) '' FootprintEdges + (TileTranslation D shiftLow)) ) := by + classical + intro k D shiftLow J shiftHigh hJDLe + exact hJDLe.symm + +private theorem hWtopV : + (by + classical + exact + ∀ (k : Nat), ((1 : ℕ) < k) → ((0 < k - 1) → ( + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + (∀ (m : Nat), (0 < m) → (∀ (s : GaussianInt), ∀ (t : GaussianInt), (t = ⟨s.re, 2 * (k : + Int) - 2 * (m : Int) - s.im⟩) → (J '' FootprintVertices (TileTranslation (DiamondTile + m) s) = FootprintVertices (TileTranslation (DiamondTile m) t)))) → ( + let Wtop : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + J '' FootprintVertices W = FootprintVertices Wtop))) ) := by + classical + intro k hk hsmall W J JtranslatedVertices Wtop + apply JtranslatedVertices (k - 1) hsmall + ⟨(k : Int), 1 - (k : Int)⟩ ⟨(k : Int), (k : Int) + 1⟩ + apply Zsqrtd.ext + · rfl + · push_cast + omega + +private theorem hWtopE : + (by + classical + exact + ∀ (k : Nat), ((1 : ℕ) < k) → ((0 < k - 1) → ( + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + (∀ (m : Nat), (0 < m) → (∀ (s : GaussianInt), ∀ (t : GaussianInt), (t = ⟨s.re, 2 * (k : + Int) - 2 * (m : Int) - s.im⟩) → ((fun e : Finset GaussianInt => e.image J) '' + FootprintEdges (TileTranslation (DiamondTile m) s) = FootprintEdges (TileTranslation + (DiamondTile m) t)))) → ( + let Wtop : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + (fun e : Finset GaussianInt => e.image J) '' FootprintEdges W = FootprintEdges Wtop))) ) + := by + classical + intro k hk hsmall W J JtranslatedEdges Wtop + apply JtranslatedEdges (k - 1) hsmall + ⟨(k : Int), 1 - (k : Int)⟩ ⟨(k : Int), (k : Int) + 1⟩ + apply Zsqrtd.ext + · rfl + · push_cast + omega + +private theorem hUtopCells : + (by + classical + exact + ∀ (k : Nat), + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + let Utop : ProtoTile := ⟨{⟨0, 2 * (k : Int)⟩}, ⟨0, 2 * (k : Int)⟩⟩ + (TileTranslation (TileReflection U) ⟨0, 2 * (k : Int)⟩).cells = Utop.cells ) := by + classical + intro k U Utop + simp [U, Utop, TileTranslation, TileReflection, GaussianTranslation, + GaussianReflection] + +private theorem hUtopNe : + (by + classical + exact + ∀ (k : Nat), + let Utop : ProtoTile := ⟨{⟨0, 2 * (k : Int)⟩}, ⟨0, 2 * (k : Int)⟩⟩ + Utop.cells.Nonempty ) := by + classical + intro k Utop + refine ⟨⟨0, 2 * (k : Int)⟩, ?_⟩ + simp [Utop] + +private theorem hJUV : + (by + classical + exact + ∀ (k : Nat), + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + (∀ (T : ProtoTile), ∀ (T' : ProtoTile), (T.cells = T'.cells) → ((T.cells.Nonempty) → + (FootprintVertices T = FootprintVertices T' ∧ FootprintEdges T = FootprintEdges T'))) + → ((∀ (T : ProtoTile), FootprintVertices (TileTranslation (TileReflection T) ⟨0, 2 * + (k : Int)⟩) = J '' FootprintVertices T) → ( + let Utop : ProtoTile := ⟨{⟨0, 2 * (k : Int)⟩}, ⟨0, 2 * (k : Int)⟩⟩ + ((TileTranslation (TileReflection U) ⟨0, 2 * (k : Int)⟩).cells = Utop.cells) → + ((Utop.cells.Nonempty) → (J '' FootprintVertices U = FootprintVertices Utop)))) ) := by + classical + intro k U J sameCellObs JtileVertices Utop hUtopCells hUtopNe + have hne : (TileTranslation (TileReflection U) + ⟨0, 2 * (k : Int)⟩).cells.Nonempty := by + rw [hUtopCells] + exact hUtopNe + have hobs := sameCellObs (TileTranslation (TileReflection U) + ⟨0, 2 * (k : Int)⟩) Utop hUtopCells hne + exact JtileVertices U |>.symm.trans hobs.1 + +private theorem hJUE : + (by + classical + exact + ∀ (k : Nat), + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + (∀ (T : ProtoTile), ∀ (T' : ProtoTile), (T.cells = T'.cells) → ((T.cells.Nonempty) → + (FootprintVertices T = FootprintVertices T' ∧ FootprintEdges T = FootprintEdges T'))) + → ((∀ (T : ProtoTile), (fun e : Finset GaussianInt => e.image J) '' FootprintEdges T + = FootprintEdges (TileTranslation (TileReflection T) ⟨0, 2 * (k : Int)⟩)) → ( + let Utop : ProtoTile := ⟨{⟨0, 2 * (k : Int)⟩}, ⟨0, 2 * (k : Int)⟩⟩ + ((TileTranslation (TileReflection U) ⟨0, 2 * (k : Int)⟩).cells = Utop.cells) → + ((Utop.cells.Nonempty) → ((fun e : Finset GaussianInt => e.image J) '' FootprintEdges + U = FootprintEdges Utop)))) ) := by + classical + intro k U J sameCellObs JtileEdges Utop hUtopCells hUtopNe + have hne : (TileTranslation (TileReflection U) + ⟨0, 2 * (k : Int)⟩).cells.Nonempty := by + rw [hUtopCells] + exact hUtopNe + have hobs := sameCellObs (TileTranslation (TileReflection U) + ⟨0, 2 * (k : Int)⟩) Utop hUtopCells hne + exact (JtileEdges U).trans hobs.2 + +private theorem hRimgExists : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + (Function.Injective J) → ((∀ a c : GaussianInt, (c = a + 1 ∨ c = a - 1 ∨ c = a + ⟨0, 1⟩ ∨ + c = a - ⟨0, 1⟩) → (J c = J a + 1 ∨ J c = J a - 1 ∨ J c = J a + ⟨0, 1⟩ ∨ J c = J a - + ⟨0, 1⟩)) → ((FootprintVertices D = J '' FootprintVertices D) → ((FootprintEdges D = + (fun e : Finset GaussianInt => e.image J) '' FootprintEdges D) → ((FootprintVertices + (TileTranslation D shiftR) = J '' FootprintVertices (TileTranslation D shiftR)) → + ((FootprintEdges (TileTranslation D shiftR) = (fun e : Finset GaussianInt => e.image + J) '' FootprintEdges (TileTranslation D shiftR)) → ( + let Wtop : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + (FootprintVertices Wtop = J '' FootprintVertices W) → ((FootprintEdges Wtop = (fun e : + Finset GaussianInt => e.image J) '' FootprintEdges W) → (∀ (R : + ExactTileInterfaceTriple D (TileTranslation D shiftR) W), ∃ (d' : + ExactTileInterfaceTriple D (TileTranslation D shiftR) Wtop), d'.point = J R.point ∧ + d'.otherAB = J R.otherAB ∧ d'.otherBC = J R.otherBC ∧ d'.otherCA = J + R.otherCA)))))))) ) := by + classical + intro k D W shiftR J Jinj Jstep hJDv' hJDe' hJRSv' hJRSe' Wtop hWtopV' hWtopE' R + exact P4055T1ExactTripleImage J Jinj Jstep + D (TileTranslation D shiftR) W + D (TileTranslation D shiftR) Wtop + hJDv' hJRSv' hWtopV' hJDe' hJRSe' hWtopE' R + +private theorem hIimgExists : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + (Function.Injective J) → ((∀ a c : GaussianInt, (c = a + 1 ∨ c = a - 1 ∨ c = a + ⟨0, 1⟩ ∨ + c = a - ⟨0, 1⟩) → (J c = J a + 1 ∨ J c = J a - 1 ∨ J c = J a + ⟨0, 1⟩ ∨ J c = J a - + ⟨0, 1⟩)) → ((FootprintVertices D = J '' FootprintVertices D) → ((FootprintEdges D = + (fun e : Finset GaussianInt => e.image J) '' FootprintEdges D) → ( + let shiftHigh : GaussianInt := ⟨0, 2 * (k : Int)⟩ + (FootprintVertices (TileTranslation D shiftHigh) = J '' FootprintVertices + (TileTranslation D shiftLow)) → ((FootprintEdges (TileTranslation D shiftHigh) = (fun + e : Finset GaussianInt => e.image J) '' FootprintEdges (TileTranslation D shiftLow)) → ( + let Wtop : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + (FootprintVertices Wtop = J '' FootprintVertices W) → ((FootprintEdges Wtop = (fun e : + Finset GaussianInt => e.image J) '' FootprintEdges W) → (∀ (I : + ExactTileInterfaceTriple D (TileTranslation D shiftLow) W), ∃ (d' : + ExactTileInterfaceTriple D (TileTranslation D shiftHigh) Wtop), d'.point = J I.point + ∧ d'.otherAB = J I.otherAB ∧ d'.otherBC = J I.otherBC ∧ d'.otherCA = J + I.otherCA)))))))) ) := by + classical + intro k D W shiftLow J Jinj Jstep hJDv' hJDe' shiftHigh hJDLv' hJDLe' Wtop hWtopV' hWtopE' I + exact P4055T1ExactTripleImage J Jinj Jstep + D (TileTranslation D shiftLow) W + D (TileTranslation D shiftHigh) Wtop + hJDv' hJDLv' hWtopV' hJDe' hJDLe' hWtopE' I + +private theorem hRp : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + let x : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ + (J x = ⟨(k : Int), (k : Int) + 1⟩) → ( + let Wtop : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + ∀ (R : ExactTileInterfaceTriple D (TileTranslation D shiftR) W), (R.point = x) → (∀ (R' : + ExactTileInterfaceTriple D (TileTranslation D shiftR) Wtop), (R'.point = J R.point ∧ + R'.otherAB = J R.otherAB ∧ R'.otherBC = J R.otherBC ∧ R'.otherCA = J R.otherCA) → + (R'.point = ⟨(k : Int), (k : Int) + 1⟩))) ) := by + classical + intro k D W shiftR J x Jx Wtop R hRpoint R' hRimg + calc + R'.point = J R.point := hRimg.1 + _ = J x := congrArg J hRpoint + _ = _ := Jx + +private theorem hIp : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + let y : GaussianInt := 1 + (J y = ⟨1, 2 * (k : Int)⟩) → ( + let shiftHigh : GaussianInt := ⟨0, 2 * (k : Int)⟩ + let Wtop : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + ∀ (I : ExactTileInterfaceTriple D (TileTranslation D shiftLow) W), (I.point = (1 : + GaussianInt)) → (∀ (I' : ExactTileInterfaceTriple D (TileTranslation D shiftHigh) + Wtop), (I'.point = J I.point ∧ I'.otherAB = J I.otherAB ∧ I'.otherBC = J I.otherBC ∧ + I'.otherCA = J I.otherCA) → (I'.point = ⟨1, 2 * (k : Int)⟩))) ) := by + classical + intro k D W shiftLow J y Jy shiftHigh Wtop I hIpoint I' hIimg + calc + I'.point = J I.point := hIimg.1 + _ = J y := congrArg J hIpoint + _ = _ := Jy + +private theorem hAp : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + let y : GaussianInt := 1 + (J y = ⟨1, 2 * (k : Int)⟩) → ( + let Wtop : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + let Utop : ProtoTile := ⟨{⟨0, 2 * (k : Int)⟩}, ⟨0, 2 * (k : Int)⟩⟩ + ∀ (A : ExactTileInterfaceTriple D W U), (A.point = (1 : GaussianInt)) → (∀ (A' : + ExactTileInterfaceTriple D Wtop Utop), (A'.point = J A.point ∧ A'.otherAB = J + A.otherAB ∧ A'.otherBC = J A.otherBC ∧ A'.otherCA = J A.otherCA) → (A'.point = ⟨1, 2 + * (k : Int)⟩))) ) := by + classical + intro k D W U J y Jy Wtop Utop A hApoint A' hAimg + calc + A'.point = J A.point := hAimg.1 + _ = J y := congrArg J hApoint + _ = _ := Jy + +private theorem hRca' : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + let y : GaussianInt := 1 + (J y = ⟨1, 2 * (k : Int)⟩) → ( + let Wtop : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + ∀ (R : ExactTileInterfaceTriple D (TileTranslation D shiftR) W), (R.otherCA = (1 : + GaussianInt)) → (∀ (R' : ExactTileInterfaceTriple D (TileTranslation D shiftR) Wtop), + (R'.point = J R.point ∧ R'.otherAB = J R.otherAB ∧ R'.otherBC = J R.otherBC ∧ + R'.otherCA = J R.otherCA) → (R'.otherCA = ⟨1, 2 * (k : Int)⟩))) ) := by + classical + intro k D W shiftR J y Jy Wtop R hRca R' hRimg + calc + R'.otherCA = J R.otherCA := hRimg.2.2.2 + _ = J y := congrArg J hRca + _ = _ := Jy + +private theorem hIca' : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + let x : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ + (J x = ⟨(k : Int), (k : Int) + 1⟩) → ( + let shiftHigh : GaussianInt := ⟨0, 2 * (k : Int)⟩ + let Wtop : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + ∀ (I : ExactTileInterfaceTriple D (TileTranslation D shiftLow) W), (I.otherCA = x) → (∀ + (I' : ExactTileInterfaceTriple D (TileTranslation D shiftHigh) Wtop), (I'.point = J + I.point ∧ I'.otherAB = J I.otherAB ∧ I'.otherBC = J I.otherBC ∧ I'.otherCA = J + I.otherCA) → (I'.otherCA = ⟨(k : Int), (k : Int) + 1⟩))) ) := by + classical + intro k D W shiftLow J x Jx shiftHigh Wtop I hIca I' hIimg + calc + I'.otherCA = J I.otherCA := hIimg.2.2.2 + _ = J x := congrArg J hIca + _ = _ := Jx + +private theorem hAab' : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + let x : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ + (J x = ⟨(k : Int), (k : Int) + 1⟩) → ( + let Wtop : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + let Utop : ProtoTile := ⟨{⟨0, 2 * (k : Int)⟩}, ⟨0, 2 * (k : Int)⟩⟩ + ∀ (A : ExactTileInterfaceTriple D W U), (A.otherAB = x) → (∀ (A' : + ExactTileInterfaceTriple D Wtop Utop), (A'.point = J A.point ∧ A'.otherAB = J + A.otherAB ∧ A'.otherBC = J A.otherBC ∧ A'.otherCA = J A.otherCA) → (A'.otherAB = ⟨(k + : Int), (k : Int) + 1⟩))) ) := by + classical + intro k D W U J x Jx Wtop Utop A hAab A' hAimg + calc + A'.otherAB = J A.otherAB := hAimg.2.1 + _ = J x := congrArg J hAab + _ = _ := Jx + +private theorem hnew : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + let shiftHigh : GaussianInt := ⟨0, 2 * (k : Int)⟩ + let Wtop : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + ∀ (R' : ExactTileInterfaceTriple D (TileTranslation D shiftR) Wtop), ∀ (I' : + ExactTileInterfaceTriple D (TileTranslation D shiftHigh) Wtop), (R'.point = ⟨(k : + Int), (k : Int) + 1⟩) → ((I'.point = ⟨1, 2 * (k : Int)⟩) → (((⟨(↑k : ℤ), (↑k : ℤ) + + (1 : ℤ)⟩ : GaussianInt) = (⟨(1 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt)) → (R'.point + = I'.point))) ) := by + classical + intro k D shiftR shiftHigh Wtop R' I' hRp hIp heq + calc + R'.point = ⟨(k : Int), (k : Int) + 1⟩ := hRp + _ = ⟨1, 2 * (k : Int)⟩ := heq + _ = I'.point := hIp.symm + +private theorem hji : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + let shiftHigh : GaussianInt := ⟨0, 2 * (k : Int)⟩ + let Wtop : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + ∀ (R : ExactTileInterfaceTriple D (TileTranslation D shiftR) W), ∀ (I : + ExactTileInterfaceTriple D (TileTranslation D shiftLow) W), ∀ (R' : + ExactTileInterfaceTriple D (TileTranslation D shiftR) Wtop), (R'.point = J R.point ∧ + R'.otherAB = J R.otherAB ∧ R'.otherBC = J R.otherBC ∧ R'.otherCA = J R.otherCA) → (∀ + (I' : ExactTileInterfaceTriple D (TileTranslation D shiftHigh) Wtop), (I'.point = J + I.point ∧ I'.otherAB = J I.otherAB ∧ I'.otherBC = J I.otherBC ∧ I'.otherCA = J + I.otherCA) → ((R'.point = I'.point) → (J R.point = J I.point))) ) := by + classical + intro k D W shiftR shiftLow J shiftHigh Wtop R I R' hRimg I' hIimg hnew + calc + J R.point = R'.point := hRimg.1.symm + _ = I'.point := hnew + _ = J I.point := hIimg.1 + +end PredecessorInterfaceGeometry + +namespace PredecessorReflection + +private theorem reflectedInterfaces : + (by + classical + exact + ∀ (k : Nat), ((1 : ℕ) < k) → (∀ (b : Bool), (0 < k) → ((0 < k - 1) → ( + (∀ (T : ProtoTile), TileTranslation T 0 = T) → ( + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + ( + let x := (⟨(↑k : ℤ), (↑k : ℤ) - (1 : ℤ)⟩ : GaussianInt); (fun (z : GaussianInt) => + GaussianTranslation (⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt) (GaussianReflection + z)) x = (⟨(↑k : ℤ), (↑k : ℤ) + (1 : ℤ)⟩ : GaussianInt)) → (( + let y := (1 : GaussianInt); (fun (z : GaussianInt) => GaussianTranslation (⟨(0 : ℤ), (2 : + ℤ) * (↑k : ℤ)⟩ : GaussianInt) (GaussianReflection z)) y = (⟨(1 : ℤ), (2 : ℤ) * (↑k : + ℤ)⟩ : GaussianInt)) → ((∀ (T : ProtoTile), ∀ (T' : ProtoTile), T.cells = T'.cells → + Finset.Nonempty T.cells → FootprintVertices T = FootprintVertices T' ∧ FootprintEdges + T = FootprintEdges T') → ((∀ (m : Nat), (0 < m) → (∀ (s : GaussianInt), ∀ (t : + GaussianInt), (t = ⟨s.re, 2 * (k : Int) - 2 * (m : Int) - s.im⟩) → (J '' + FootprintVertices (TileTranslation (DiamondTile m) s) = FootprintVertices + (TileTranslation (DiamondTile m) t)))) → (( + let J := fun (z : GaussianInt) => GaussianTranslation (⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : + GaussianInt) (GaussianReflection z); ∀ (m : ℕ), (0 : ℕ) < m → ∀ (s : GaussianInt), ∀ + (t : GaussianInt), t = (⟨s.re, (2 : ℤ) * (↑k : ℤ) - (2 : ℤ) * (↑m : ℤ) - s.im⟩ : + GaussianInt) → (fun (e : Finset GaussianInt) => Finset.image J e) '' FootprintEdges + (TileTranslation (DiamondTile m) s) = FootprintEdges (TileTranslation (DiamondTile m) + t)) → (( + let J := fun (z : GaussianInt) => GaussianTranslation (⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : + GaussianInt) (GaussianReflection z); ∀ (T : ProtoTile), FootprintVertices + (TileTranslation (TileReflection T) (⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt)) = + J '' FootprintVertices T) → (( + let J := fun (z : GaussianInt) => GaussianTranslation (⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : + GaussianInt) (GaussianReflection z); ∀ (T : ProtoTile), (fun (e : Finset GaussianInt) + => Finset.image J e) '' FootprintEdges T = FootprintEdges (TileTranslation + (TileReflection T) (⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩ : GaussianInt))) → ((( + let M := P5260T1PlacementLedger k 2 false + let D := DiamondTile k + ∃ R : ExactTileInterfaceTriple D (TileTranslation D M.2.1.1) M.1.1, + ∃ I : ExactTileInterfaceTriple D (TileTranslation D M.2.1.2) M.1.1, + ∃ A : ExactTileInterfaceTriple D M.1.1 M.1.2, + R.point = M.2.2.1 ∧ I.point = M.2.2.2 ∧ + A.point = M.2.2.2 ∧ R.otherCA = M.2.2.2 ∧ + I.otherCA = M.2.2.1 ∧ A.otherAB = M.2.2.1 ∧ + M.2.2.1 ≠ M.2.2.2)) → ( + let M := P5260T1PlacementLedger k 2 b + let D := DiamondTile k + ∃ R : ExactTileInterfaceTriple D (TileTranslation D M.2.1.1) M.1.1, + ∃ I : ExactTileInterfaceTriple D (TileTranslation D M.2.1.2) M.1.1, + ∃ A : ExactTileInterfaceTriple D M.1.1 M.1.2, + R.point = M.2.2.1 ∧ I.point = M.2.2.2 ∧ + A.point = M.2.2.2 ∧ R.otherCA = M.2.2.2 ∧ + I.otherCA = M.2.2.1 ∧ A.otherAB = M.2.2.1 ∧ + M.2.2.1 ≠ M.2.2.2)))))))))))) ) := by + classical + intro k hk b hkpos hsmall translateZero J Jx Jy sameCellObs JtranslatedVertices + JtranslatedEdges JtileVertices JtileEdges hFalse + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + let x : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ + let y : GaussianInt := 1 + have Jinj := PredecessorInterfaceGeometry.Jinj k + have Jstep := PredecessorInterfaceGeometry.Jstep k + have hzero : (0 : GaussianInt) = + ⟨0, 2 * (k : Int) - 2 * (k : Int) - 0⟩ := PredecessorInterfaceGeometry.hzero k + have hJDv : J '' FootprintVertices D = FootprintVertices D := by + simpa only [translateZero] using JtranslatedVertices k hkpos 0 0 hzero + have hJDv' : FootprintVertices D = J '' FootprintVertices D := hJDv.symm + have hJDe := PredecessorInterfaceGeometry.hJDe k hkpos translateZero JtranslatedEdges hzero + have hJDe' : FootprintEdges D = + (fun e : Finset GaussianInt => e.image J) '' FootprintEdges D := hJDe.symm + have hshiftR := PredecessorInterfaceGeometry.hshiftR k + have hJRSv := PredecessorInterfaceGeometry.hJRSv k hkpos JtranslatedVertices hshiftR + have hJRSv' : FootprintVertices (TileTranslation D shiftR) = + J '' FootprintVertices (TileTranslation D shiftR) := hJRSv.symm + have hJRSe := PredecessorInterfaceGeometry.hJRSe k hkpos JtranslatedEdges hshiftR + have hJRSe' := PredecessorInterfaceGeometry.hJRSe' k hJRSe + let shiftHigh : GaussianInt := ⟨0, 2 * (k : Int)⟩ + have hJDLv := PredecessorInterfaceGeometry.hJDLv k hkpos JtranslatedVertices + have hJDLv' : FootprintVertices (TileTranslation D shiftHigh) = + J '' FootprintVertices (TileTranslation D shiftLow) := hJDLv.symm + have hJDLe := PredecessorInterfaceGeometry.hJDLe k hkpos JtranslatedEdges + have hJDLe' := PredecessorInterfaceGeometry.hJDLe' k hJDLe + let Wtop : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + have hWtopV := PredecessorInterfaceGeometry.hWtopV k hk hsmall JtranslatedVertices + have hWtopV' : FootprintVertices Wtop = J '' FootprintVertices W := hWtopV.symm + have hWtopE := PredecessorInterfaceGeometry.hWtopE k hk hsmall JtranslatedEdges + have hWtopE' : FootprintEdges Wtop = + (fun e : Finset GaussianInt => e.image J) '' FootprintEdges W := hWtopE.symm + let Utop : ProtoTile := ⟨{⟨0, 2 * (k : Int)⟩}, ⟨0, 2 * (k : Int)⟩⟩ + have hUtopCells := PredecessorInterfaceGeometry.hUtopCells k + have hUtopNe := PredecessorInterfaceGeometry.hUtopNe k + have hJUV := PredecessorInterfaceGeometry.hJUV k sameCellObs JtileVertices hUtopCells hUtopNe + have hJUV' : FootprintVertices Utop = J '' FootprintVertices U := hJUV.symm + have hJUE := PredecessorInterfaceGeometry.hJUE k sameCellObs JtileEdges hUtopCells hUtopNe + have hJUE' : FootprintEdges Utop = + (fun e : Finset GaussianInt => e.image J) '' FootprintEdges U := hJUE.symm + cases b + · exact hFalse + · dsimp [P5260T1PlacementLedger, P5124T1ParentModel] + obtain ⟨R, I, A, hRpoint, hIpoint, hApoint, hRca, hIca, hAab, hxy⟩ := hFalse + simp only [P5260T1PlacementLedger] at hRpoint hIpoint hApoint hRca hIca hAab hxy + change R.point = x at hRpoint + change I.point = 1 at hIpoint + change A.point = 1 at hApoint + change R.otherCA = 1 at hRca + change I.otherCA = x at hIca + change A.otherAB = x at hAab + change x ≠ 1 at hxy + change ExactTileInterfaceTriple D (TileTranslation D shiftR) W at R + change ExactTileInterfaceTriple D (TileTranslation D shiftLow) W at I + change ExactTileInterfaceTriple D W U at A + have hRimgExists := PredecessorInterfaceGeometry.hRimgExists k Jinj Jstep hJDv' hJDe' + hJRSv' hJRSe' hWtopV' hWtopE' R + obtain ⟨R', hRimg⟩ := hRimgExists + have hIimgExists := PredecessorInterfaceGeometry.hIimgExists k Jinj Jstep hJDv' hJDe' + hJDLv' hJDLe' hWtopV' hWtopE' I + obtain ⟨I', hIimg⟩ := hIimgExists + have hAimgExists := P4055T1ExactTripleImage J Jinj Jstep + D W U D Wtop Utop hJDv' hWtopV' hJUV' hJDe' hWtopE' hJUE' A + obtain ⟨A', hAimg⟩ := hAimgExists + have hRp := PredecessorInterfaceGeometry.hRp k Jx R hRpoint R' hRimg + have hIp := PredecessorInterfaceGeometry.hIp k Jy I hIpoint I' hIimg + have hAp := PredecessorInterfaceGeometry.hAp k Jy A hApoint A' hAimg + have hRca' := PredecessorInterfaceGeometry.hRca' k Jy R hRca R' hRimg + have hIca' := PredecessorInterfaceGeometry.hIca' k Jx I hIca I' hIimg + have hAab' := PredecessorInterfaceGeometry.hAab' k Jx A hAab A' hAimg + refine ⟨R', ⟨I', ⟨A', ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩⟩⟩ + · exact hRp + · exact hIp + · exact hAp + · exact hRca' + · exact hIca' + · exact hAab' + · intro heq + have hnew := PredecessorInterfaceGeometry.hnew k R' I' hRp hIp heq + have hji := PredecessorInterfaceGeometry.hji k R I R' hRimg I' hIimg hnew + have hsource : R.point = I.point := Jinj hji + apply hxy + calc + _ = R.point := hRpoint.symm + _ = I.point := hsource + _ = _ := hIpoint + +end PredecessorReflection + +theorem P5260T1PredecessorInterfaces (k : Nat) (hk : 1 < k) (b : Bool) : + let M := P5260T1PlacementLedger k 2 b + let D := DiamondTile k + ∃ R : ExactTileInterfaceTriple D (TileTranslation D M.2.1.1) M.1.1, + ∃ I : ExactTileInterfaceTriple D (TileTranslation D M.2.1.2) M.1.1, + ∃ A : ExactTileInterfaceTriple D M.1.1 M.1.2, + R.point = M.2.2.1 ∧ I.point = M.2.2.2 ∧ + A.point = M.2.2.2 ∧ R.otherCA = M.2.2.2 ∧ + I.otherCA = M.2.2.1 ∧ A.otherAB = M.2.2.1 ∧ + M.2.2.1 ≠ M.2.2.2 := by +-- BODY + classical + have rawBoundaryVertices := PredecessorInterfaceGeometry.rawBoundaryVertices + have rawBoundaryEdges := PredecessorInterfaceGeometry.rawBoundaryEdges + have rawStaircase := PredecessorInterfaceGeometry.rawStaircase rawBoundaryVertices + rawBoundaryEdges (PredecessorInterfaceGeometry.staircaseBetween k) + have twoVertexPath := PredecessorInterfaceGeometry.twoVertexPath k + have diamondCellsNonempty := PredecessorInterfaceGeometry.diamondCellsNonempty + have reversePath {V : Set GaussianInt} {E : Set (Finset GaussianInt)} + {x y : GaussianInt} (hp : SimpleGridPathBetween V E x y) := + PredecessorInterfaceGeometry.reversePath (V := V) (E := E) (x := x) (y := y) hp + have translatedDiamondCellsNonempty := + PredecessorInterfaceGeometry.translatedDiamondCellsNonempty diamondCellsNonempty + have hkpos : 0 < k := by omega + have hsmall : 0 < k - 1 := by omega + let N : Nat := 2 * (k - 1) + have hN : 0 < N := by dsimp [N]; omega + let D := DiamondTile k + let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ + let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ + let Em := TileTranslation (DiamondTile (k - 1)) ⟨-(k : Int), 1 - (k : Int)⟩ + have hstair := P5157T1DiamondStaircaseIntersections k hk + dsimp only [D, W, L, Em, N] at hstair + obtain ⟨⟨hDWd, hDWv, hDWe⟩, + ⟨hLWd, hLWv, hLWe⟩, ⟨hDEd, hDEv, hDEe⟩⟩ := hstair + have pathDW := PredecessorInterfaceGeometry.pathDW k rawStaircase diamondCellsNonempty + translatedDiamondCellsNonempty hkpos hsmall hN hDWd hDWv hDWe + have translateComp := PredecessorInterfaceGeometry.translateComp + let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ + have hpStart := PredecessorInterfaceGeometry.hpStart + have hpEnd := PredecessorInterfaceGeometry.hpEnd k hk + have pathWD := PredecessorInterfaceGeometry.pathWD k pathDW + have translateZero (T : ProtoTile) : TileTranslation T 0 = T := + PredecessorInterfaceGeometry.translateZero T + let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ + have hcapLow := P5203T1CapInterface k hkpos shiftLow + dsimp only at hcapLow + have pathLow := (PredecessorInterfaceGeometry.rawCapBetween rawBoundaryVertices + rawBoundaryEdges (PredecessorInterfaceGeometry.capBetween k)) k hkpos shiftLow hcapLow.2.2.1 + have hlowZero : shiftLow + ⟨0, 2 * (k : Int)⟩ = 0 := by + apply Zsqrtd.ext <;> simp [shiftLow] + have hlowTile : TileTranslation D + (shiftLow + ⟨0, 2 * (k : Int)⟩) = D := PredecessorInterfaceGeometry.hlowTile k + translateZero hlowZero + rw [hlowTile] at pathLow + obtain ⟨u, hu, hquarterCells, _, hquarterVertices, _⟩ := + QuarterTurnSymmetricCenteredTransport D (DiamondBaseT2 ⟨k, hkpos⟩) + have hcentroid := P4194T1DiamondCentroid k hkpos + rw [hcentroid] at hu + simp? [GaussianRealPoint] at hu + have huEq := PredecessorInterfaceGeometry.huEq k u hu + let Q : GaussianInt → GaussianInt := GaussianQuarterTurn + let F : GaussianInt → GaussianInt := fun z => Q z + u + have F_inj := PredecessorInterfaceGeometry.F_inj k u + have quarterVertices := PredecessorInterfaceGeometry.quarterVertices k u + have quarterBaseVertices := PredecessorInterfaceGeometry.quarterBaseVertices k u + hquarterVertices + have quarterCellsAt := PredecessorInterfaceGeometry.quarterCellsAt k translateComp u hquarterCells + have quarterVerticesAt := PredecessorInterfaceGeometry.quarterVerticesAt k + translatedDiamondCellsNonempty hkpos u quarterCellsAt + have shiftQuarter : Q shiftLow = shiftR := by + apply Zsqrtd.ext <;> simp [Q, GaussianQuarterTurn, shiftLow, shiftR] + have hxlow := PredecessorInterfaceGeometry.hxlow k u huEq + have hxhigh := PredecessorInterfaceGeometry.hxhigh k u huEq + have capBoundaryVerticesEq := PredecessorInterfaceGeometry.capBoundaryVerticesEq k + let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ + have hleft := P5253T1LeftSquareContacts (k - 1) hsmall + ⟨(k : Int), 1 - (k : Int)⟩ ((k : Int) - 2) (Or.inl (by omega)) + dsimp only [U, W] at hleft ⊢ + obtain ⟨hWne, hWUdisj, hWUv, hWUedge⟩ := hleft + have hcontactCell : (⟨(k : Int), 1 - (k : Int)⟩ : GaussianInt) + + ⟨-((k - 1 : Nat) : Int) - 1, (k : Int) - 2⟩ = ⟨0, -1⟩ := + PredecessorInterfaceGeometry.hcontactCell k hk + rw [hcontactCell] at hWUdisj hWUv hWUedge + change Disjoint W.cells U.cells at hWUdisj + have hUne := PredecessorInterfaceGeometry.hUne + have hWUv' := PredecessorInterfaceGeometry.hWUv' k hWUv + have hbot := P5253T1BottomSquareContact k hkpos 0 + dsimp only at hbot + have hneg : (0 : GaussianInt) - ⟨0, 1⟩ = ⟨0, -1⟩ := by + apply Zsqrtd.ext <;> simp + rw [hneg] at hbot + have hDULdisj : Disjoint D.cells U.cells := by + simpa [D, U, translateZero] using hbot.2.1 + have hDUv : BoundaryFootprintVertices D ∩ BoundaryFootprintVertices U = + {0, 0 + 1} := PredecessorInterfaceGeometry.hDUv k translateZero hbot + have hDUedge : {0, 0 + 1} ∈ BoundaryFootprintEdges D := by + simpa [D, U, translateZero] using hbot.2.2.2 + have hDUv' : BoundaryFootprintVertices D ∩ BoundaryFootprintVertices U = + {0, 1} := by simpa using hDUv + have hDUedge' : {0, 1} ∈ BoundaryFootprintEdges D := by + simpa using hDUedge + have hUedgeBot' : {0, 1} ∈ BoundaryFootprintEdges U := (PredecessorInterfaceGeometry.hUedgeBot) + have hyDL := PredecessorInterfaceGeometry.hyDL k (PredecessorInterfaceGeometry.hDLboundary k + hkpos hlowTile capBoundaryVerticesEq) (PredecessorInterfaceGeometry.hcapRight k) + have hyDW := PredecessorInterfaceGeometry.hyDW k hDWv + have hsmallTriple := P5124T1SmallerParents k hk + have hIboundaryUnique := PredecessorInterfaceGeometry.hIboundaryUnique k hyDL + (PredecessorInterfaceGeometry.hyLW k hLWv) (PredecessorInterfaceGeometry.hsmallI k + hsmallTriple) + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + have Jcoordinate := PredecessorInterfaceGeometry.Jcoordinate k + have reflectedPath {V : Set GaussianInt} {E : Set (Finset GaussianInt)} + {x y : GaussianInt} (hp : SimpleGridPathBetween V E x y) := + PredecessorInterfaceGeometry.reflectedPath k (V := V) (E := E) (x := x) (y := y) hp + let x : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ + let y : GaussianInt := 1 + have hDWraw := PredecessorInterfaceGeometry.hDWraw k rawBoundaryVertices diamondCellsNonempty + hkpos hDWd hDWv hWne + have hLWraw := PredecessorInterfaceGeometry.hLWraw k rawBoundaryVertices + translatedDiamondCellsNonempty hkpos hLWd hLWv hWne + have hlowStart : shiftLow + ⟨1, 2 * (k : Int)⟩ = 1 := by + apply Zsqrtd.ext <;> simp [shiftLow] + have hlowEnd : shiftLow + ⟨-1, 2 * (k : Int)⟩ = -1 := by + apply Zsqrtd.ext <;> simp [shiftLow] + have hIABoundary := PredecessorInterfaceGeometry.hIABoundary k hIboundaryUnique + exact (PredecessorReflection.reflectedInterfaces k hk b hkpos hsmall translateZero + (PredecessorInterfaceGeometry.Jx k Jcoordinate) (PredecessorInterfaceGeometry.Jy k + Jcoordinate) (PredecessorInterfaceGeometry.sameCellObs) + (PredecessorInterfaceGeometry.JtranslatedVertices k) + (PredecessorInterfaceGeometry.JtranslatedEdges k) + (PredecessorInterfaceGeometry.JtileVertices k) (PredecessorInterfaceGeometry.JtileEdges k) + (PredecessorInterfaceGeometry.hFalse k hk (PredecessorInterfaceGeometry.pathLW k + rawStaircase translatedDiamondCellsNonempty hkpos hsmall hN hLWd hLWv hLWe) hpStart hpEnd + (PredecessorInterfaceGeometry.hqStart) (PredecessorInterfaceGeometry.hqEnd k hk) + (PredecessorInterfaceGeometry.pathWDrev k reversePath pathDW) + (PredecessorInterfaceGeometry.pathRAB k u (PredecessorInterfaceGeometry.pathRAB0 k + translateZero pathLow u F_inj (PredecessorInterfaceGeometry.F_step k u) quarterVertices + (PredecessorInterfaceGeometry.quarterEdges k u) quarterBaseVertices + (PredecessorInterfaceGeometry.quarterBaseEdges k u hquarterCells) quarterVerticesAt + (PredecessorInterfaceGeometry.quarterEdgesAt k u quarterCellsAt) shiftQuarter) hxlow + hxhigh) (PredecessorInterfaceGeometry.hAunique k (PredecessorInterfaceGeometry.hWURaw k + rawBoundaryVertices hWne hWUdisj hUne hWUv') (PredecessorInterfaceGeometry.hDURaw k + rawBoundaryVertices diamondCellsNonempty hkpos hUne hDULdisj hDUv')) + (PredecessorInterfaceGeometry.pathIAB k (PredecessorInterfaceGeometry.pathDL k reversePath + pathLow) hlowStart hlowEnd) (PredecessorInterfaceGeometry.pathICA k pathDW hpStart hpEnd) + (PredecessorInterfaceGeometry.pathAAB k pathDW hpStart hpEnd) + (PredecessorInterfaceGeometry.pathABC k reversePath (PredecessorInterfaceGeometry.hWUpath k + rawBoundaryVertices rawBoundaryEdges twoVertexPath hWne hWUdisj hUne hWUv' + (PredecessorInterfaceGeometry.hWedge' k hWUedge) (PredecessorInterfaceGeometry.hUedge'))) + (PredecessorInterfaceGeometry.pathACA k reversePath (PredecessorInterfaceGeometry.hDUpath k + rawBoundaryVertices rawBoundaryEdges twoVertexPath diamondCellsNonempty hkpos hUne hDULdisj + hDUv' hDUedge' hUedgeBot')) (PredecessorInterfaceGeometry.hRBC k + (PredecessorInterfaceGeometry.pathRBC k (PredecessorInterfaceGeometry.pathDEm k + rawStaircase diamondCellsNonempty translatedDiamondCellsNonempty hkpos hsmall hN hDEd hDEv + hDEe) (PredecessorInterfaceGeometry.translatePathTiles + (PredecessorInterfaceGeometry.translatedPath)) (PredecessorInterfaceGeometry.hEmShift k + translateComp)) (PredecessorInterfaceGeometry.htStart k) + (PredecessorInterfaceGeometry.htEnd k hk)) (PredecessorInterfaceGeometry.hIuniqueRaw k + rawBoundaryVertices diamondCellsNonempty translatedDiamondCellsNonempty hkpos hLWd hcapLow + hlowTile hWne hyDL hIboundaryUnique hDWraw) (PredecessorInterfaceGeometry.hRunique k hpEnd + (PredecessorInterfaceGeometry.hRABraw k u huEq hxlow hxhigh + (PredecessorInterfaceGeometry.hcapLowRawVertices k rawBoundaryVertices hkpos hcapLow + hlowTile capBoundaryVerticesEq) (PredecessorInterfaceGeometry.hRABimage k u F_inj + quarterVertices quarterBaseVertices quarterVerticesAt shiftQuarter + (PredecessorInterfaceGeometry.quarterVerticesZero k translateZero u quarterVertices))) + hDWraw (PredecessorInterfaceGeometry.pImagBound k hk)))) + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5260T1UnitInterfaces.lean b/LeanPool/ApollonianSuperharmonic/P5260T1UnitInterfaces.lean new file mode 100644 index 0000000000..75ff6c79b6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5260T1UnitInterfaces.lean @@ -0,0 +1,253 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.P5203T1IncreasingInterface +public import LeanPool.ApollonianSuperharmonic.P5203T1DecreasingInterface +public import LeanPool.ApollonianSuperharmonic.P5253T1TopSquareContacts +public import LeanPool.ApollonianSuperharmonic.P5253T1LeftSquareContacts +public import LeanPool.ApollonianSuperharmonic.P5253T1BottomSquareContact +public import LeanPool.ApollonianSuperharmonic.P5253T1OneEdgeInterface +public import LeanPool.ApollonianSuperharmonic.P5157T1DiamondStaircaseIntersections +public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.P5290T1RawBoundaryInterfaces +public import LeanPool.ApollonianSuperharmonic.P5290T1EqualDiamondPaths +public import LeanPool.ApollonianSuperharmonic.P5290T1UnitContactPaths +public import LeanPool.ApollonianSuperharmonic.P5290T1PredecessorPath +public import LeanPool.ApollonianSuperharmonic.P5290T1ColumnReflection + +-- [TABLET NODE: P5260T1UnitInterfaces] + +/-! +# P5260T1UnitInterfaces + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5260T1UnitInterfaces (k : Nat) (hk : 0 < k) + (i : Fin 3) (b : Bool) (hi : i ≠ 2) + (hreg : 1 < k ∨ (i = 1 ∧ b = false) ∨ (i = 0 ∧ b = true)) : + let M := P5260T1PlacementLedger k i b + let D := DiamondTile k + ∃ R : ExactTileInterfaceTriple D (TileTranslation D M.2.1.1) M.1.1, + ∃ I : ExactTileInterfaceTriple D (TileTranslation D M.2.1.2) M.1.1, + ∃ A : ExactTileInterfaceTriple D M.1.1 M.1.2, + R.point = M.2.2.1 ∧ I.point = M.2.2.2 ∧ + A.point = M.2.2.2 ∧ R.otherCA = M.2.2.2 ∧ + I.otherCA = M.2.2.1 ∧ A.otherAB = M.2.2.1 ∧ + M.2.2.1 ≠ M.2.2.2 := by +-- BODY + have raw (T U : ProtoTile) (a c : GaussianInt) + (h : T.cells.Nonempty ∧ U.cells.Nonempty ∧ Disjoint T.cells U.cells ∧ + SimpleGridPathBetween + (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) + (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) a c) : + SimpleGridPathBetween (FootprintVertices T ∩ FootprintVertices U) + (FootprintEdges T ∩ FootprintEdges U) a c := by as_aux_lemma => + have eqs := P5290T1RawBoundaryInterfaces T U h.1 h.2.1 h.2.2.1 + simpa only [eqs.1, eqs.2] using h.2.2.2 + have even (i : Fin 3) (hi : i ≠ 2) (hreg : 1 < k ∨ i = 1) : + let M := P5260T1PlacementLedger k i false + let D := DiamondTile k + ∃ R : ExactTileInterfaceTriple D (TileTranslation D M.2.1.1) M.1.1, + ∃ I : ExactTileInterfaceTriple D (TileTranslation D M.2.1.2) M.1.1, + ∃ A : ExactTileInterfaceTriple D M.1.1 M.1.2, + R.point = M.2.2.1 ∧ I.point = M.2.2.2 ∧ + A.point = M.2.2.2 ∧ R.otherCA = M.2.2.2 ∧ + I.otherCA = M.2.2.1 ∧ A.otherAB = M.2.2.1 ∧ + M.2.2.1 ≠ M.2.2.2 := by as_aux_lemma => + let M := P5260T1PlacementLedger k i false + let D := DiamondTile k + let W := M.1.1 + let Z := M.1.2 + let Dr := TileTranslation D M.2.1.1 + let Dl := TileTranslation D M.2.1.2 + let x := M.2.2.1 + let y := M.2.2.2 + let d : GaussianInt := if i = 0 then ⟨0, 1⟩ else -1 + let eR : GaussianInt := if i = 0 then ⟨-(k : Int), (k : Int) + 1⟩ else 0 + let eI : GaussianInt := if i = 0 then ⟨(k : Int), (k : Int)⟩ else ⟨-1, 2 * (k : Int)⟩ + obtain ⟨long, vR, vI⟩ := P5290T1EqualDiamondPaths k hk i hi + obtain ⟨short, vDW, vWZ, unitZD⟩ := P5290T1UnitContactPaths k hk i hi hreg + have rAB := long D Dr x eR (by simp only [List.mem_cons]; exact Or.inl rfl) + have iAB := long D Dl y eI (by simp only [List.mem_cons]; exact Or.inr (Or.inl rfl)) + have dwXY := short D W x y (by simp only [List.mem_cons]; exact Or.inl rfl) + have dwYX := short D W y x (by simp only [List.mem_cons]; exact Or.inr (Or.inl rfl)) + have rBC := short Dr W x (x + d) (by + simp only [List.mem_cons]; exact Or.inr (Or.inr (Or.inl rfl))) + have iBC := short Dl W y (y + d) (by + simp only [List.mem_cons]; exact Or.inr (Or.inr (Or.inr (Or.inl rfl)))) + have aBC := short W Z y (y + d) (by + simp only [List.mem_cons]; exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl))))) + have vR' := (P5290T1RawBoundaryInterfaces D Dr rAB.1 rAB.2.1 rAB.2.2.1).1.trans vR + have vI' := (P5290T1RawBoundaryInterfaces D Dl iAB.1 iAB.2.1 iAB.2.2.1).1.trans vI + have vDW' : FootprintVertices D ∩ FootprintVertices W = {x, y} := + (P5290T1RawBoundaryInterfaces D W dwXY.1 dwXY.2.1 dwXY.2.2.1).1.trans vDW + have vWZ' : FootprintVertices W ∩ FootprintVertices Z = {y, y + d} := + (P5290T1RawBoundaryInterfaces W Z aBC.1 aBC.2.1 aBC.2.2.1).1.trans vWZ + have rEnds : x ∈ FootprintVertices D ∩ FootprintVertices Dr ∧ + y ∉ FootprintVertices D ∩ FootprintVertices Dr := by as_aux_lemma => + rw [vR'] + fin_cases i <;> + simp [x, y, M, P5260T1PlacementLedger] at hi ⊢ <;> omega + have iEnds : y ∈ FootprintVertices D ∩ FootprintVertices Dl ∧ + x ∉ FootprintVertices D ∩ FootprintVertices Dl := by as_aux_lemma => + rw [vI'] + fin_cases i <;> + simp [x, y, M, P5260T1PlacementLedger] at hi ⊢ <;> omega + have sep : x ≠ y ∧ x ≠ y + d := by as_aux_lemma => + fin_cases i <;> + simp [x, y, d, M, P5260T1PlacementLedger, Zsqrtd.ext_iff] at hi ⊢ + have xDW : x ∈ FootprintVertices D ∩ FootprintVertices W := by rw [vDW']; simp + have yDW : y ∈ FootprintVertices D ∩ FootprintVertices W := by rw [vDW']; simp + have yWZ : y ∈ FootprintVertices W ∩ FootprintVertices Z := by rw [vWZ']; simp + have uniqueR (z : GaussianInt) : + z ∈ FootprintVertices D ∩ FootprintVertices Dr ∩ FootprintVertices W ↔ z = x := + by as_aux_lemma => + constructor + · intro hz + have hzDW : z ∈ ({x, y} : Set GaussianInt) := by + rw [← vDW']; exact ⟨hz.1.1, hz.2⟩ + rcases (show z = x ∨ z = y from by simpa using hzDW) with h | h + · exact h + · subst z; exact (rEnds.2 hz.1).elim + · rintro rfl + exact ⟨rEnds.1, xDW.2⟩ + have uniqueI (z : GaussianInt) : + z ∈ FootprintVertices D ∩ FootprintVertices Dl ∩ FootprintVertices W ↔ z = y := + by as_aux_lemma => + constructor + · intro hz + have hzDW : z ∈ ({x, y} : Set GaussianInt) := by + rw [← vDW']; exact ⟨hz.1.1, hz.2⟩ + rcases (show z = x ∨ z = y from by simpa using hzDW) with h | h + · subst z; exact (iEnds.2 hz.1).elim + · exact h + · rintro rfl + exact ⟨iEnds.1, yDW.2⟩ + have uniqueA (z : GaussianInt) : + z ∈ FootprintVertices D ∩ FootprintVertices W ∩ FootprintVertices Z ↔ z = y := + by as_aux_lemma => + constructor + · intro hz + have hzDW := hz.1 + rw [vDW'] at hzDW + rcases (show z = x ∨ z = y from by simpa using hzDW) with h | h + · subst z + have hxWZ : x ∈ ({y, y + d} : Set GaussianInt) := by + rw [← vWZ']; exact ⟨hz.1.2, hz.2⟩ + rcases (show x = y ∨ x = y + d from by simpa using hxWZ) with h | h + · exact (sep.1 h).elim + · exact (sep.2 h).elim + · exact h + · rintro rfl + exact ⟨yDW, yWZ.2⟩ + obtain ⟨eA, aCA⟩ : ∃ eA, SimpleGridPathBetween + (FootprintVertices Z ∩ FootprintVertices D) + (FootprintEdges Z ∩ FootprintEdges D) y eA := by + by_cases hi0 : i = 0 + · subst i + have hbig : 1 < k := hreg.resolve_right (by decide) + have h := P5290T1PredecessorPath k hbig + refine ⟨⟨(k : Int), (k : Int) + 1⟩, ?_⟩ + simpa [Z, D, y, M, P5260T1PlacementLedger] using raw _ _ _ _ h + · have hi1 : i = 1 := by omega + exact ⟨y + ⟨0, 1⟩, raw Z D y _ (unitZD hi1)⟩ + let R : ExactTileInterfaceTriple D Dr W := + ⟨x, eR, x + d, y, raw _ _ _ _ rAB, raw _ _ _ _ rBC, + by simpa only [Set.inter_comm] using raw _ _ _ _ dwXY, uniqueR⟩ + let I : ExactTileInterfaceTriple D Dl W := + ⟨y, eI, y + d, x, raw _ _ _ _ iAB, raw _ _ _ _ iBC, + by simpa only [Set.inter_comm] using raw _ _ _ _ dwYX, uniqueI⟩ + let A : ExactTileInterfaceTriple D W Z := + ⟨y, x, y + d, eA, raw _ _ _ _ dwYX, raw _ _ _ _ aBC, aCA, uniqueA⟩ + exact ⟨R, I, A, rfl, rfl, rfl, rfl, rfl, rfl, sep.1⟩ + cases b with + | false => + apply even i hi + rcases hreg with h | ⟨h, _⟩ | ⟨_, h⟩ + · exact Or.inl h + · exact Or.inr h + · cases h + | true => + let j : Fin 3 := if i = 0 then 1 else 0 + have hj : j ≠ 2 := by dsimp [j]; split <;> decide + have reg : 1 < k ∨ j = 1 := by + fin_cases i + · exact Or.inr rfl + · exact Or.inl (hreg.resolve_right (by simp)) + · exact (hi rfl).elim + have hji : (if j = 0 then (1 : Fin 3) else 0) = i := by + fin_cases i + · rfl + · rfl + · exact (hi rfl).elim + let S := P5260T1PlacementLedger k j false + let T := P5260T1PlacementLedger k i true + let D := DiamondTile k + let J := fun z : GaussianInt => (⟨z.re, 2 * (k : Int) - z.im⟩ : GaussianInt) + have hf : Function.Injective J := by + intro a c h + have hr := congrArg Zsqrtd.re h + have hc := congrArg Zsqrtd.im h + apply Zsqrtd.ext <;> simp only [J] at hr hc ⊢ <;> omega + have hs (a c : GaussianInt) + (h : c = a + 1 ∨ c = a - 1 ∨ c = a + ⟨0, 1⟩ ∨ c = a - ⟨0, 1⟩) : + J c = J a + 1 ∨ J c = J a - 1 ∨ + J c = J a + ⟨0, 1⟩ ∨ J c = J a - ⟨0, 1⟩ := by + rcases h with rfl | rfl | rfl | rfl + · exact Or.inl (by ext <;> simp [J]) + · exact Or.inr (Or.inl (by ext <;> simp [J])) + · exact Or.inr (Or.inr (Or.inr (by ext <;> simp [J]; ring))) + · exact Or.inr (Or.inr (Or.inl (by ext <;> simp [J]; ring))) + obtain ⟨R, I, A, hRp, hIp, hAp, hRc, hIc, hAa, hxy⟩ := even j hj reg + have images := P5290T1ColumnReflection k hk j hj reg + dsimp only at images + rw [hji] at images + obtain ⟨maps, hx, hy⟩ := images + have mD := maps D D (by simp [D]) + have mR := maps (TileTranslation D S.2.1.1) (TileTranslation D T.2.1.1) + (by simp [D, S, T]) + have mI := maps (TileTranslation D S.2.1.2) (TileTranslation D T.2.1.2) + (by simp [D, S, T]) + have mW := maps S.1.1 T.1.1 (by simp [S, T]) + have mZ := maps S.1.2 T.1.2 (by simp [S, T]) + obtain ⟨R', hRp', hRab', hRbc', hRc'⟩ := P4055T1ExactTripleImage J hf hs + D (TileTranslation D S.2.1.1) S.1.1 + D (TileTranslation D T.2.1.1) T.1.1 + mD.1 mR.1 mW.1 mD.2 mR.2 mW.2 R + obtain ⟨I', hIp', hIab', hIbc', hIc'⟩ := P4055T1ExactTripleImage J hf hs + D (TileTranslation D S.2.1.2) S.1.1 + D (TileTranslation D T.2.1.2) T.1.1 + mD.1 mI.1 mW.1 mD.2 mI.2 mW.2 I + obtain ⟨A', hAp', hAa', hAbc', hAc'⟩ := P4055T1ExactTripleImage J hf hs + D S.1.1 S.1.2 D T.1.1 T.1.2 + mD.1 mW.1 mZ.1 mD.2 mW.2 mZ.2 A + refine ⟨R', I', A', ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · exact hRp'.trans ((congrArg J hRp).trans hx) + · exact hIp'.trans ((congrArg J hIp).trans hy) + · exact hAp'.trans ((congrArg J hAp).trans hy) + · exact hRc'.trans ((congrArg J hRc).trans hy) + · exact hIc'.trans ((congrArg J hIc).trans hx) + · exact hAa'.trans ((congrArg J hAa).trans hx) + · intro h + apply hxy + exact hf (hx.trans (h.trans hy.symm)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5269T1CenteredSquareTripleTransport.lean b/LeanPool/ApollonianSuperharmonic/P5269T1CenteredSquareTripleTransport.lean new file mode 100644 index 0000000000..9506d20a16 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5269T1CenteredSquareTripleTransport.lean @@ -0,0 +1,140 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P5269T1CenteredSquareTripleTransport] + +/-! +# P5269T1CenteredSquareTripleTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5269T1CenteredSquareTripleTransport (q : Int) (flip : Bool) + (t : GaussianInt) (N : Fin 3 → Nat) (X : Fin 3 → GaussianInt) + (hN : ∀ k, 0 < N k) (T : Fin 3 → ProtoTile) + (hc : ∀ k, (T k).cells = + (TileTranslation (FordTile (N k)) + ((if flip then (⟨q, q⟩ : GaussianInt) - X k - ⟨N k, N k⟩ else X k) + t)).cells) + (E : ExactTileInterfaceTriple (TileTranslation (FordTile (N 0)) (X 0)) + (TileTranslation (FordTile (N 1)) (X 1)) + (TileTranslation (FordTile (N 2)) (X 2))) : + let f := fun z : GaussianInt => (if flip then (⟨q, q⟩ : GaussianInt) - z else z) + t + ∃ E' : ExactTileInterfaceTriple (T 0) (T 1) (T 2), + E'.point = f E.point ∧ E'.otherAB = f E.otherAB ∧ + E'.otherBC = f E.otherBC ∧ E'.otherCA = f E.otherCA := by +-- BODY + let f := fun z : GaussianInt => (if flip then (⟨q, q⟩ : GaussianInt) - z else z) + t + let tr := fun A : ProtoTile => if flip then + TileTranslation (TileQuarterTurn (TileQuarterTurn A)) (⟨q, q⟩ + t) + else TileTranslation A t + let g := fun z : GaussianInt => if flip then (⟨q, q⟩ : GaussianInt) - z - 1 - ⟨0,1⟩ + t + else z + t + have cell (n : Nat) (a z : GaussianInt) : + z ∈ (TileTranslation (FordTile n) a).cells ↔ + a.re ≤ z.re ∧ z.re < a.re + n ∧ a.im ≤ z.im ∧ z.im < a.im + n := by + change z ∈ (FordTile n).cells.image (GaussianTranslation a) ↔ _ + constructor + · rintro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + have hw := (P4210T1FordCellRectangles n w).1.mp hw + dsimp [GaussianTranslation] + omega + · intro hz + refine Finset.mem_image.mpr ⟨z-a, (P4210T1FordCellRectangles n _).1.mpr ?_, ?_⟩ + · dsimp; omega + · simp [GaussianTranslation] + have trcells (A : ProtoTile) : (tr A).cells = A.cells.image g := by + cases flip + · rfl + · simp only [tr,ite_true,TileTranslation,TileQuarterTurn,Finset.image_image] + apply Finset.image_congr + intro z hz + ext <;> simp [g,GaussianQuarterTurn,GaussianTranslation,Function.comp_def] <;> ring + have square (n : Nat) (a : GaussianInt) : + (tr (TileTranslation (FordTile n) a)).cells = + (TileTranslation (FordTile n) + ((if flip then (⟨q, q⟩ : GaussianInt) - a - ⟨n,n⟩ else a) + t)).cells := by + rw [trcells] + ext z + rw [cell] + constructor + · rintro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + have hw := (cell n a w).mp hw + cases flip <;> dsimp [g] at * <;> omega + · intro hz + cases flip + · refine Finset.mem_image.mpr ⟨z-t, (cell n a _).mpr ?_, ?_⟩ + · dsimp at hz ⊢; omega + · simp [g] + · refine Finset.mem_image.mpr ⟨⟨q, q⟩ - z - 1 - ⟨0,1⟩ + t, + (cell n a _).mpr ?_, ?_⟩ + · dsimp at hz ⊢; omega + · simp [g]; abel + have vertices (A : ProtoTile) : FootprintVertices (tr A) = f '' FootprintVertices A := by + cases flip + · exact (TileTranslationFormulas A t).2.2.2.2.2.1 + · rw [show tr A = TileTranslation (TileQuarterTurn (TileQuarterTurn A)) (⟨q, q⟩+t) from rfl, + (TileTranslationFormulas _ _).2.2.2.2.2.1, + (TileQuarterTurnFormulas _).2.2.2.2.2.1, + (TileQuarterTurnFormulas _).2.2.2.2.2.1] + simp only [Set.image_image] + congr 1 + funext z + ext <;> simp [f,GaussianQuarterTurn,GaussianTranslation] <;> ring + have edges (A : ProtoTile) : FootprintEdges (tr A) = + (fun e : Finset GaussianInt => e.image f) '' FootprintEdges A := by + cases flip + · exact (TileTranslationFormulas A t).2.2.2.2.2.2.1 + · rw [show tr A = TileTranslation (TileQuarterTurn (TileQuarterTurn A)) (⟨q, q⟩+t) from rfl, + (TileTranslationFormulas _ _).2.2.2.2.2.2.1, + (TileQuarterTurnFormulas _).2.2.2.2.2.2.1, + (TileQuarterTurnFormulas _).2.2.2.2.2.2.1] + simp only [Set.image_image] + congr 1 + funext e + simp only [Function.comp_def,Finset.image_image] + apply Finset.image_congr + intro z hz + ext <;> simp [f,GaussianQuarterTurn,GaussianTranslation] <;> ring + have hv (k : Fin 3) : FootprintVertices (T k) = + f '' FootprintVertices (TileTranslation (FordTile (N k)) (X k)) := by + have hne : (tr (TileTranslation (FordTile (N k)) (X k))).cells.Nonempty := by + rw [square] + exact ⟨((if flip then (⟨q, q⟩ : GaussianInt) - X k - ⟨N k, N k⟩ else X k) + t), + (cell _ _ _).mpr (by dsimp; have := hN k; omega)⟩ + have hc' := (hc k).trans (square (N k) (X k)).symm + exact (ProtoTileObservableExtensionality _ _ hc' + (by intro h; rw [h] at hc'; exact (hne.ne_empty hc'.symm).elim)).1.trans (vertices _) + have he (k : Fin 3) : FootprintEdges (T k) = + (fun e : Finset GaussianInt => e.image f) '' + FootprintEdges (TileTranslation (FordTile (N k)) (X k)) := by + have hc' := (hc k).trans (square (N k) (X k)).symm + have ho : FootprintEdges (T k) = FootprintEdges (tr (TileTranslation (FordTile (N k)) (X k))) + := by + simp only [FootprintEdges,hc'] + exact ho.trans (edges _) + apply P4055T1ExactTripleImage f _ _ _ _ _ _ _ _ (hv 0) (hv 1) (hv 2) (he 0) (he 1) (he 2) E + · cases flip <;> intro x y h <;> simpa [f] using h + · intro x y h + cases flip <;> simp only [f,Bool.false_eq_true,ite_false,ite_true,Zsqrtd.ext_iff] at * <;> + dsimp at * <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5269T1FordSquareNormalForm.lean b/LeanPool/ApollonianSuperharmonic/P5269T1FordSquareNormalForm.lean new file mode 100644 index 0000000000..1fcf9b9fcb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5269T1FordSquareNormalForm.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P5269T1FordSquareNormalForm] + +/-! +# P5269T1FordSquareNormalForm + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5269T1FordSquareNormalForm (P : FordFareyParameter) (hq : 1 < P.q) + (k : Fin 4) (T : ProtoTile) + (hT : BandPrototile (FordRecursiveQuadruple P k) T) + (hpos : 0 < (FordRecursiveQuadruple P k).1) : + ∃ w : GaussianInt, + T.cells = (TileTranslation (FordTile (![P.q, P.q₁, P.q₂, 0] k)) w).cells := by +-- BODY + have trzero (n : Nat) : (TileTranslation (FordTile n) 0).cells = + (FordTile n).cells := by + change (FordTile n).cells.image (GaussianTranslation 0) = _ + rw [show GaussianTranslation 0 = id by funext z; simp [GaussianTranslation]] + exact Finset.image_id + obtain ⟨hroot, _, hrec⟩ := FordTileRecursiveIdentification P + obtain ⟨_, S, hS, _, hS0, _, hS1, _⟩ := hrec hq + have normal (C : CircleCoordinates) (E : ProtoTile) (n : Nat) + (v : GaussianInt) (hE : BandPrototile C E) (hT : BandPrototile C T) + (hc : E.cells = (TileTranslation (FordTile n) v).cells) : + ∃ w : GaussianInt, T.cells = (TileTranslation (FordTile n) w).cells := by + obtain ⟨u, hu, _⟩ := BandPrototileTranslationNormalForm C T E hT hE + refine ⟨v + u, hu.trans ?_⟩ + change E.cells.image (GaussianTranslation u) = _ + rw [hc] + simp only [TileTranslation, Finset.image_image] + apply Finset.image_congr + intro z hz + simp [GaussianTranslation, add_assoc] + fin_cases k + · exact normal _ (FordTile P.q) P.q 0 + (by simpa [FordRecursiveQuadruple] using hroot) hT + (trzero P.q).symm + · exact normal _ (S 0 true) P.q₁ 0 (hS 0 true).1 hT + (hS0.trans (trzero P.q₁).symm) + · exact normal _ (S 1 true) P.q₂ ⟨P.q₁, 0⟩ (hS 1 true).1 hT hS1 + · norm_num [FordRecursiveQuadruple] at hpos + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5269T1IncomingSquareJunctions.lean b/LeanPool/ApollonianSuperharmonic/P5269T1IncomingSquareJunctions.lean new file mode 100644 index 0000000000..8fbba2b351 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5269T1IncomingSquareJunctions.lean @@ -0,0 +1,153 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5682T1AlignedSquareRawInterfaces +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleLatticeTouching +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance + +-- [TABLET NODE: P5269T1IncomingSquareJunctions] + +/-! +# P5269T1IncomingSquareJunctions + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5269T1IncomingSquareJunctions (r s : Nat) (hr : 0 < r) (hs : 0 < s) + (j : Fin 4) : + let q := r + s + let A := TileTranslation (FordTile q) 0 + let B := TileTranslation (FordTile q) + (![⟨q, r⟩, ⟨-(q : Int), s⟩, ⟨-(q : Int), -(r : Int)⟩, + ⟨q, -(s : Int)⟩] j) + let C := TileTranslation (FordTile (![r, s, r, s] j)) + (![⟨s, q⟩, ⟨-(s : Int), 0⟩, ⟨-(r : Int), s⟩, ⟨r, -(s : Int)⟩] j) + ∃ E : ExactTileInterfaceTriple A B C, + E.point = (![⟨q, q⟩, ⟨0, s⟩, ⟨0, s⟩, ⟨q, 0⟩] j) ∧ + TouchingTriple A B C := by +-- BODY + classical + let sq := fun (n : Nat) (a : GaussianInt) => TileTranslation (FordTile n) a + obtain ⟨vertex, contact⟩ := P5682T1AlignedSquareRawInterfaces + change ∀ (n : Nat) (_ : 0 < n) (a z : GaussianInt), + z ∈ FootprintVertices (sq n a) ↔ + a.re ≤ z.re ∧ z.re ≤ a.re + n ∧ a.im ≤ z.im ∧ z.im ≤ a.im + n at vertex + have disk (n : Nat) (hn : 0 < n) (a : GaussianInt) : LatticeTile (sq n a) := + (TileDiskAreaCovariance (FordTile n) a).1.mp (FordTileGeometry n hn).1 + have hq : 0 < r+s := by omega + dsimp only + simp only [Nat.cast_add] + fin_cases j + · obtain ⟨hab, ab, abr⟩ := contact (r+s) (r+s) hq hq 0 ⟨r+s,r⟩ true + (by simp) (by dsimp; omega) + obtain ⟨hcb, cb, bc⟩ := contact r (r+s) hr hq ⟨s,r+s⟩ ⟨r+s,r⟩ true + (by dsimp; omega) (by dsimp; omega) + obtain ⟨hac, ac, ca⟩ := contact (r+s) r hq hr 0 ⟨s,r+s⟩ false + (by simp) (by dsimp; omega) + simp only [Bool.false_eq_true,ite_false,ite_true,Zsqrtd.re_zero,Zsqrtd.im_zero, + Nat.cast_add] at ab abr cb bc ac ca + let E : ExactTileInterfaceTriple (sq (r+s) 0) (sq (r+s) ⟨r+s,r⟩) (sq r ⟨s,r+s⟩) := + { point := ⟨r+s,r+s⟩ + otherAB := ⟨r+s,r⟩ + otherBC := ⟨r+s,2*r+s⟩ + otherCA := ⟨s,r+s⟩ + pathAB := by convert abr using 1 <;> congr 1; omega + pathBC := by simpa only [Set.inter_comm] using (by + convert cb using 1 <;> congr 1 <;> omega) + pathCA := by simpa only [Set.inter_comm] using (by + convert ca using 1 <;> congr 1; omega) + unique_common := by + intro z + simp only [Set.mem_inter_iff, vertex _ hq, vertex _ hr, Zsqrtd.ext_iff] + dsimp + omega } + exact ⟨E, rfl, ExactTileInterfaceTripleLatticeTouching _ _ _ E + (disk _ hq _) (disk _ hq _) (disk _ hr _) hab hcb.symm hac.symm⟩ + · obtain ⟨hba, ba, ab⟩ := contact (r+s) (r+s) hq hq ⟨-(r+s:Int),s⟩ 0 true + (by dsimp; omega) (by dsimp; omega) + obtain ⟨hcb, cb, bc⟩ := contact s (r+s) hs hq ⟨-(s:Int),0⟩ ⟨-(r+s:Int),s⟩ false + (by dsimp; omega) (by dsimp; omega) + obtain ⟨hca, ca, ac⟩ := contact s (r+s) hs hq ⟨-(s:Int),0⟩ 0 true + (by dsimp; omega) (by dsimp; omega) + simp only [Bool.false_eq_true,ite_false,ite_true,Zsqrtd.re_zero,Zsqrtd.im_zero, + Nat.cast_add] at ba ab cb bc ca ac + let E : ExactTileInterfaceTriple (sq (r+s) 0) (sq (r+s) ⟨-(r+s:Int),s⟩) (sq s ⟨-(s:Int),0⟩) := + { point := ⟨0,s⟩ + otherAB := ⟨0,r+s⟩ + otherBC := ⟨-(s:Int),s⟩ + otherCA := ⟨0,0⟩ + pathAB := by + convert ba using 1 <;> first | exact Set.inter_comm _ _ | (congr 1; omega) + pathBC := by simpa only [Set.inter_comm] using (by + convert bc using 1 <;> congr 1 <;> omega) + pathCA := by convert ac using 1 <;> congr 1; omega + unique_common := by + intro z + simp only [Set.mem_inter_iff, vertex _ hq, vertex _ hs, Zsqrtd.ext_iff] + dsimp + omega } + exact ⟨E, rfl, ExactTileInterfaceTripleLatticeTouching _ _ _ E + (disk _ hq _) (disk _ hq _) (disk _ hs _) hba.symm hcb.symm hca⟩ + · obtain ⟨hba, ba, ab⟩ := contact (r+s) (r+s) hq hq ⟨-(r+s:Int),-(r:Int)⟩ 0 true + (by dsimp; omega) (by dsimp; omega) + obtain ⟨hbc, bc, cb⟩ := contact (r+s) r hq hr ⟨-(r+s:Int),-(r:Int)⟩ ⟨-(r:Int),s⟩ false + (by dsimp; omega) (by dsimp; omega) + obtain ⟨hca, ca, ac⟩ := contact r (r+s) hr hq ⟨-(r:Int),s⟩ 0 true + (by dsimp; omega) (by dsimp; omega) + simp only [Bool.false_eq_true,ite_false,ite_true,Zsqrtd.re_zero,Zsqrtd.im_zero, + Nat.cast_add] at ba ab bc cb ca ac + let E : ExactTileInterfaceTriple (sq (r+s) 0) (sq (r+s) ⟨-(r+s:Int),-(r:Int)⟩) (sq r + ⟨-(r:Int),s⟩) := + { point := ⟨0,s⟩ + otherAB := ⟨0,0⟩ + otherBC := ⟨-(r:Int),s⟩ + otherCA := ⟨0,r+s⟩ + pathAB := by + convert ab using 1 <;> first | exact Set.inter_comm _ _ | (congr 1; omega) + pathBC := by convert cb using 1 <;> congr 1 <;> omega + pathCA := by convert ca using 1 <;> congr 1 <;> omega + unique_common := by + intro z + simp only [Set.mem_inter_iff, vertex _ hq, vertex _ hr, Zsqrtd.ext_iff] + dsimp + omega } + exact ⟨E, rfl, ExactTileInterfaceTripleLatticeTouching _ _ _ E + (disk _ hq _) (disk _ hq _) (disk _ hr _) hba.symm hbc hca⟩ + · obtain ⟨hab, ab, ba⟩ := contact (r+s) (r+s) hq hq 0 ⟨r+s,-(s:Int)⟩ true + (by simp) (by dsimp; omega) + obtain ⟨hcb, cb, bc⟩ := contact s (r+s) hs hq ⟨r,-(s:Int)⟩ ⟨r+s,-(s:Int)⟩ true + (by dsimp ) (by dsimp; omega) + obtain ⟨hca, ca, ac⟩ := contact s (r+s) hs hq ⟨r,-(s:Int)⟩ 0 false + (by dsimp; omega) (by dsimp; omega) + simp only [Bool.false_eq_true,ite_false,ite_true,Zsqrtd.re_zero,Zsqrtd.im_zero, + Nat.cast_add] at ab ba cb bc ca ac + let E : ExactTileInterfaceTriple (sq (r+s) 0) (sq (r+s) ⟨r+s,-(s:Int)⟩) (sq s ⟨r,-(s:Int)⟩) := + { point := ⟨r+s,0⟩ + otherAB := ⟨r+s,r⟩ + otherBC := ⟨r+s,-(s:Int)⟩ + otherCA := ⟨r,0⟩ + pathAB := by convert ab using 1 <;> congr 1 <;> omega + pathBC := by simpa only [Set.inter_comm] using (by + convert bc using 1 <;> congr 1 <;> omega) + pathCA := by convert ac using 1 <;> congr 1 <;> omega + unique_common := by + intro z + simp only [Set.mem_inter_iff, vertex _ hq, vertex _ hs, Zsqrtd.ext_iff] + dsimp + omega } + exact ⟨E, rfl, ExactTileInterfaceTripleLatticeTouching _ _ _ E + (disk _ hq _) (disk _ hq _) (disk _ hs _) hab hcb.symm hca⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1ColumnReflection.lean b/LeanPool/ApollonianSuperharmonic/P5290T1ColumnReflection.lean new file mode 100644 index 0000000000..d89ea33621 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5290T1ColumnReflection.lean @@ -0,0 +1,174 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows + +-- [TABLET NODE: P5290T1ColumnReflection] + +/-! +# P5290T1ColumnReflection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5290T1ColumnReflection (k : Nat) (hk : 0 < k) + (i : Fin 3) (hi : i ≠ 2) (hreg : 1 < k ∨ i = 1) : + let j : Fin 3 := if i = 0 then 1 else 0 + let S := P5260T1PlacementLedger k i false + let T := P5260T1PlacementLedger k j true + let D := DiamondTile k + let J := fun z : GaussianInt => (⟨z.re, 2 * (k : Int) - z.im⟩ : GaussianInt) + let rows : List (ProtoTile × ProtoTile) := + [(D, D), + (TileTranslation D S.2.1.1, TileTranslation D T.2.1.1), + (TileTranslation D S.2.1.2, TileTranslation D T.2.1.2), + (S.1.1, T.1.1), (S.1.2, T.1.2)] + (∀ A B, (A, B) ∈ rows → + FootprintVertices B = J '' FootprintVertices A ∧ + FootprintEdges B = (fun e : Finset GaussianInt => e.image J) '' FootprintEdges A) ∧ + J S.2.2.1 = T.2.2.1 ∧ J S.2.2.2 = T.2.2.2 := by +-- BODY + classical + let J := fun z : GaussianInt => (⟨z.re, 2 * (k : Int) - z.im⟩ : GaussianInt) + let C := fun z : GaussianInt => (⟨z.re, 2 * (k : Int) - 1 - z.im⟩ : GaussianInt) + have invol (z : GaussianInt) : C (C z) = z := by ext <;> simp [C] + have image_mem (A : Finset GaussianInt) (z : GaussianInt) : + z ∈ A.image C ↔ C z ∈ A := by + constructor + · rintro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + simpa only [invol] using hw + · intro hz + exact Finset.mem_image.mpr ⟨C z, hz, invol z⟩ + have cell (m : Nat) (u z : GaussianInt) : + z ∈ (TileTranslation (DiamondTile m) u).cells ↔ z - u ∈ DiamondCellDomain m := by + change z ∈ (DiamondCellDomain m).image (GaussianTranslation u) ↔ _ + constructor + · intro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hw + · intro hz + exact Finset.mem_image.mpr ⟨z - u, hz, by simp [GaussianTranslation]⟩ + have diamond_cells (m : Nat) (u : GaussianInt) : + (TileTranslation (DiamondTile m) + ⟨u.re, 2 * (k : Int) - 2 * (m : Int) - u.im⟩).cells = + (TileTranslation (DiamondTile m) u).cells.image C := by + ext z + rw [image_mem, cell, cell] + rw [(P4194T1DiamondCellRows m _).1, (P4194T1DiamondCellRows m _).1] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, C] + omega + have ne (m : Nat) (hm : 0 < m) (u : GaussianInt) : + (TileTranslation (DiamondTile m) u).cells.Nonempty := by + refine ⟨u, (cell m u u).mpr ?_⟩ + rw [sub_self, (P4194T1DiamondCellRows m 0).1] + norm_num + omega + have zeroTr (A : ProtoTile) : TileTranslation A 0 = A := by + have hz : GaussianTranslation (0 : GaussianInt) = id := by + funext z; simp [GaussianTranslation] + cases A + simp [TileTranslation, hz, GaussianTranslation] + have observables (A B : ProtoTile) (hA : A.cells.Nonempty) + (hc : B.cells = A.cells.image C) : + FootprintVertices B = J '' FootprintVertices A ∧ + FootprintEdges B = (fun e : Finset GaussianInt => e.image J) '' FootprintEdges A := by + let F := TileTranslation (TileReflection A) ⟨0, 2 * (k : Int)⟩ + have fc : F.cells = A.cells.image C := by + rw [(TileTranslationFormulas (TileReflection A) _).1, + (TileReflectionFormulas A).1, Finset.image_image] + congr 1 + funext z + ext <;> simp [GaussianTranslation, GaussianReflection, C]; ring + have hB : B.cells.Nonempty := by rw [hc]; exact hA.image C + have hF : F.cells.Nonempty := by rw [fc]; exact hA.image C + have vc : FootprintVertices B = FootprintVertices F := by + unfold FootprintVertices + rw [ite_eq_left hB, ite_eq_left hF, hc, fc] + have ec : FootprintEdges B = FootprintEdges F := by + simp only [FootprintEdges, hc, fc] + have fJ : (fun z => GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z)) = J := by + funext z + ext <;> simp [GaussianTranslation, GaussianReflection, J]; ring + constructor + · rw [vc, (TileTranslationFormulas (TileReflection A) _).2.2.2.2.2.1, + (TileReflectionFormulas A).2.2.2.2.2.1, Set.image_image] + simp only [fJ] + · rw [ec, (TileTranslationFormulas (TileReflection A) _).2.2.2.2.2.2.1, + (TileReflectionFormulas A).2.2.2.2.2.2.1, Set.image_image] + have fE : (fun e : Finset GaussianInt => + (e.image GaussianReflection).image (GaussianTranslation ⟨0, 2 * (k : Int)⟩)) = + (fun e : Finset GaussianInt => e.image J) := by + funext e + rw [Finset.image_image] + simp only [Function.comp_def, fJ] + simp only [fE] + have diamonds (m : Nat) (hm : 0 < m) (u v : GaussianInt) + (hv : v = ⟨u.re, 2 * (k : Int) - 2 * (m : Int) - u.im⟩) : + FootprintVertices (TileTranslation (DiamondTile m) v) = + J '' FootprintVertices (TileTranslation (DiamondTile m) u) ∧ + FootprintEdges (TileTranslation (DiamondTile m) v) = + (fun e : Finset GaussianInt => e.image J) '' + FootprintEdges (TileTranslation (DiamondTile m) u) := by + subst v + exact observables _ _ (ne m hm u) (diamond_cells m u) + have units (z w : GaussianInt) (hw : w = C z) : + FootprintVertices (⟨{w}, w⟩ : ProtoTile) = + J '' FootprintVertices (⟨{z}, z⟩ : ProtoTile) ∧ + FootprintEdges (⟨{w}, w⟩ : ProtoTile) = + (fun e : Finset GaussianInt => e.image J) '' FootprintEdges (⟨{z}, z⟩ : ProtoTile) := by + subst w + exact observables _ _ ⟨z, by simp⟩ (by simp) + dsimp only + fin_cases i + · have hbig : 1 < k := hreg.resolve_right (by decide) + refine ⟨?_, ?_, ?_⟩ + · intro A B hrow + simp only [P5260T1PlacementLedger, Bool.false_eq_true, ↓reduceIte, + Matrix.cons_val_zero, Matrix.cons_val_one, P5124T1ParentModel, + List.mem_cons, List.not_mem_nil, or_false] at hrow + rcases hrow with h | h | h | h | h <;> cases h + · simpa only [zeroTr] using diamonds k hk 0 0 (by ext <;> simp) + · exact diamonds k hk ⟨-(k : Int), (k : Int) + 1⟩ ⟨-(k : Int), -(k : Int) - 1⟩ + (by ext <;> simp; omega) + · exact diamonds k hk ⟨(k : Int) + 1, (k : Int)⟩ ⟨(k : Int) + 1, -(k : Int)⟩ + (by ext <;> simp ) + · exact units ⟨0, 2 * (k : Int)⟩ ⟨0, -1⟩ (by ext <;> simp [C]) + · exact diamonds (k - 1) (by omega) ⟨(k : Int), (k : Int) + 1⟩ ⟨(k : Int), 1 - (k : Int)⟩ + (by ext <;> simp; omega) + · ext <;> simp [P5260T1PlacementLedger] + · ext <;> simp [P5260T1PlacementLedger] + · refine ⟨?_, ?_, ?_⟩ + · intro A B hrow + simp only [P5260T1PlacementLedger, Bool.false_eq_true, ↓reduceIte, + Matrix.cons_val_zero, Matrix.cons_val_one, P5124T1ParentModel, + List.mem_cons, List.not_mem_nil, or_false] at hrow + rcases hrow with h | h | h | h | h <;> cases h + · simpa only [zeroTr] using diamonds k hk 0 0 (by ext <;> simp) + · exact diamonds k hk ⟨-(k : Int), -(k : Int) - 1⟩ ⟨-(k : Int), (k : Int) + 1⟩ + (by ext <;> simp; omega) + · exact diamonds k hk ⟨-(k : Int) - 1, (k : Int)⟩ ⟨-(k : Int) - 1, -(k : Int)⟩ + (by ext <;> simp ) + · exact units ⟨-(k : Int) - 1, (k : Int) - 1⟩ ⟨-(k : Int) - 1, (k : Int)⟩ + (by ext <;> simp [C]; omega) + · exact units ⟨-(k : Int) - 1, (k : Int)⟩ ⟨-(k : Int) - 1, (k : Int) - 1⟩ + (by ext <;> simp [C]; omega) + · ext <;> simp [P5260T1PlacementLedger]; omega + · ext <;> simp [P5260T1PlacementLedger]; omega + · exact (hi rfl).elim + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean b/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean new file mode 100644 index 0000000000..eb045d33c1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean @@ -0,0 +1,2542 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger +public import LeanPool.ApollonianSuperharmonic.P5203T1IncreasingInterface +public import LeanPool.ApollonianSuperharmonic.P5203T1DecreasingInterface +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.P4055T1GridPathImage +public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.DiamondBaseT2 +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCentroid + +-- [TABLET NODE: P5290T1EqualDiamondPaths] + +/-! +# P5290T1EqualDiamondPaths + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiamondPathComparison + +private theorem staircaseBetween : + (by + classical + exact + (Nat) → (∀ (z : GaussianInt), ∀ (h : Bool), ∀ (s : Int), (s = 1 ∨ s = -1) → (∀ (N : Nat), + (0 < N) → ( + let p := P5157T1StaircasePoint z h s; + SimpleGridPathBetween {v | ∃ j ≤ N, v = p j} + {e | ∃ j < N, e = {p j, p (j + 1)}} (p 0) (p N)))) ) := by + classical + intro k z h s hs N hN + dsimp only + let p := P5157T1StaircasePoint z h s; + have inj := (P5157T1AlternatingStaircase z h s hs N hN).1 + have step (j : Nat) : + p (j + 1) = p j + 1 ∨ p (j + 1) = p j - 1 ∨ + p (j + 1) = p j + ⟨0, 1⟩ ∨ p (j + 1) = p j - ⟨0, 1⟩ := by + rcases hs with rfl | rfl <;> cases h <;> + simp [p, P5157T1StaircasePoint, Zsqrtd.ext_iff] <;> omega + let l := List.ofFn (fun j : Fin (N + 1) => p j) + have hl : l.length = N + 1 := List.length_ofFn + have chain : l.IsChain (fun a b => ∃ j < N, a = p j ∧ b = p (j + 1)) := by + apply List.isChain_ofFn.mpr + intro j hj + exact ⟨j, by omega, rfl, rfl⟩ + have consecutive (a b : GaussianInt) (l₁ l₂ : List GaussianInt) + (heq : l = l₁ ++ a :: b :: l₂) : + ∃ j < N, a = p j ∧ b = p (j + 1) := + List.isChain_iff_forall_rel_of_append_cons_cons.mp chain heq + refine ⟨l, List.nodup_ofFn.mpr ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro a b hab + exact Fin.ext (inj hab) + · rw [hl] + omega + · simp [l] + rfl + · change (List.ofFn (fun j : Fin (N + 1) => p j)).getLast? = some (p N) + rw [List.getLast?_eq_getLast_of_ne_nil (by simp)] + rw [List.getLast_ofFn_succ] + rfl + · ext v + simp only [Set.mem_ofPred_eq, Finset.mem_coe, List.mem_toFinset, + l, List.mem_ofFn] + constructor + · rintro ⟨j, hj, rfl⟩ + exact ⟨⟨j, by omega⟩, rfl⟩ + · rintro ⟨j, rfl⟩ + exact ⟨j, by omega, rfl⟩ + · intro a b l₁ l₂ heq + obtain ⟨j, hj, rfl, rfl⟩ := consecutive a b l₁ l₂ heq + exact step j + · intro e + constructor + · rintro ⟨j, hj, rfl⟩ + have hjl : j < l.length := by rw [hl]; omega + have hlen : j + 1 < l.length := by rw [hl]; omega + refine ⟨p j, p (j + 1), l.take j, l.drop (j + 2), ?_, rfl⟩ + have hd := List.getElem_cons_drop hjl + have hd' := List.getElem_cons_drop hlen + have heq : l = l.take j ++ l[j] :: l[j + 1] :: l.drop (j + 2) := by + rw [show j + 2 = j + 1 + 1 by omega, hd', hd, List.take_append_drop] + simpa only [l, List.getElem_ofFn] using heq + · rintro ⟨a, b, l₁, l₂, heq, rfl⟩ + obtain ⟨j, hj, rfl, rfl⟩ := consecutive a b l₁ l₂ heq + exact ⟨j, hj, rfl⟩ + +private theorem reversePath : + (by + classical + exact + ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, SimpleGridPathBetween V E x y → SimpleGridPathBetween V E y x ) := by + classical + intro V E x y hp + rcases hp with ⟨p, hn, hl, hh, ht, hV, hs, he⟩ + have revstep : ∀ a b l₁ l₂, p.reverse = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ := by + intro a b l₁ l₂ h + have h' : p = l₂.reverse ++ b :: a :: l₁.reverse := by + have := congrArg List.reverse h + simpa [List.reverse_append, List.append_assoc] using this + rcases hs b a _ _ h' with hh | hh | hh | hh + · exact Or.inr (Or.inl (by rw [hh]; simp)) + · exact Or.inl (by rw [hh]; simp) + · exact Or.inr (Or.inr (Or.inr (by rw [hh]; simp))) + · exact Or.inr (Or.inr (Or.inl (by rw [hh]; simp))) + have revocc (q : List GaussianInt) (e : Finset GaussianInt) + (ho : ∃ a b l₁ l₂, q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) : + ∃ a b l₁ l₂, q.reverse = l₁ ++ a :: b :: l₂ ∧ e = {a, b} := by + rcases ho with ⟨a, b, l₁, l₂, rfl, rfl⟩ + exact ⟨b, a, l₂.reverse, l₁.reverse, + by simp [List.reverse_append, List.append_assoc], Finset.pair_comm _ _⟩ + refine ⟨p.reverse, List.nodup_reverse.mpr hn, by simpa using hl, + by simpa using ht, by simpa using hh, by simpa using hV, revstep, ?_⟩ + intro e + exact ⟨fun h => revocc p e ((he e).mp h), fun h => + (he e).mpr (by simpa using revocc p.reverse e h)⟩ + +private theorem qstep : + (by + classical + exact + (Nat) → (∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + GaussianQuarterTurn b = GaussianQuarterTurn a + 1 ∨ GaussianQuarterTurn b = + GaussianQuarterTurn a - 1 ∨ GaussianQuarterTurn b = GaussianQuarterTurn a + ⟨0, 1⟩ ∨ + GaussianQuarterTurn b = GaussianQuarterTurn a - ⟨0, 1⟩) ) := by + classical + intro k a b hh + rcases hh with h | h | h | h + · subst b; right; right; left; apply Zsqrtd.ext <;> + simp [GaussianQuarterTurn] + · subst b; right; right; right; apply Zsqrtd.ext <;> + simp [GaussianQuarterTurn] + · subst b; right; left; apply Zsqrtd.ext <;> + simp [GaussianQuarterTurn]; omega + · subst b; left; apply Zsqrtd.ext <;> + simp [GaussianQuarterTurn]; omega + +private theorem qinj : + (by + classical + exact + (Nat) → (Function.Injective GaussianQuarterTurn) ) := by + classical + intro k a b hab + apply Zsqrtd.ext + · have h := congrArg (fun z : GaussianInt => z.im) hab + simpa [GaussianQuarterTurn] using h + · have h := congrArg (fun z : GaussianInt => z.re) hab + have h' : -a.im = -b.im := by simpa [GaussianQuarterTurn] using h + omega + +private theorem qenum : + (by + classical + exact + ∀ (k : Nat), + let q : Nat → GaussianInt := + P5157T1StaircasePoint ⟨(k : Int), -(k : Int)⟩ true 1 + ∀ (j : ℕ), GaussianQuarterTurn (q j) = ⟨(↑k : ℤ) - (↑(j / (2 : ℕ)) : ℤ), (↑k : ℤ) + (↑((j + + (1 : ℕ)) / (2 : ℕ)) : ℤ)⟩ ) := by + classical + intro k q j + apply Zsqrtd.ext <;> + simp [q, P5157T1StaircasePoint, GaussianQuarterTurn]; omega + +private theorem qendpoint₀ : + (by + classical + exact + ∀ (k : Nat), + let q : Nat → GaussianInt := + P5157T1StaircasePoint ⟨(k : Int), -(k : Int)⟩ true 1 + (∀ (j : Nat), GaussianQuarterTurn (q j) = ⟨(k : Int) - (j / 2 : Nat), (k : Int) + ((j + + 1) / 2 : Nat)⟩) → (GaussianQuarterTurn (q 0) = ⟨(k : Int), (k : Int)⟩) ) := by + classical + intro k q qenum + rw [qenum] + norm_num + +private theorem qendpoint₁ : + (by + classical + exact + ∀ (k : Nat), ((0 : ℕ) < k) → ( + let q : Nat → GaussianInt := + P5157T1StaircasePoint ⟨(k : Int), -(k : Int)⟩ true 1 + let N : Nat := 2 * k - 1 + (∀ (j : Nat), GaussianQuarterTurn (q j) = ⟨(k : Int) - (j / 2 : Nat), (k : Int) + ((j + + 1) / 2 : Nat)⟩) → (GaussianQuarterTurn (q N) = ⟨1, 2 * (k : Int)⟩)) ) := by + classical + intro k hk q N qenum + rw [qenum] + dsimp [N] + have heven : (2 * k - 1) / 2 = k - 1 := by omega + have hceil : (2 * k - 1 + 1) / 2 = k := by omega + apply Zsqrtd.ext <;> simp <;> omega + +private theorem dVenum : + (by + classical + exact + ∀ (k : Nat), ((0 : ℕ) < k) → ( + let N : Nat := 2 * k - 1 + (0 < N) → ( + let dV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1} + let dP : Nat → GaussianInt := fun j => + ⟨(k : Int) - (j / 2 : Nat), (k : Int) + ((j + 1) / 2 : Nat)⟩ + dV = {z | ∃ j ≤ N, z = dP j})) ) := by + classical + intro k hk N hN dV dP + ext z + constructor + · intro hz + have hz' : 1 ≤ z.re ∧ z.re ≤ k ∧ + 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1 := by + simpa [dV] using hz + let j := (z.im - z.re).toNat + have hj : (j : Int) = z.im - z.re := + Int.toNat_of_nonneg (by omega) + refine ⟨j, ?_, ?_⟩ + · change j ≤ 2 * k - 1 + omega + · apply Zsqrtd.ext + · simp [dP] + omega + · simp [dP] + omega + · rintro ⟨j, hj, rfl⟩ + simp only [dV, Set.mem_ofPred_eq, dP] + omega + +private theorem dVimage : + (by + classical + exact + ∀ (k : Nat), + let q : Nat → GaussianInt := + P5157T1StaircasePoint ⟨(k : Int), -(k : Int)⟩ true 1 + let N : Nat := 2 * k - 1 + let dV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1} + let dP : Nat → GaussianInt := fun j => + ⟨(k : Int) - (j / 2 : Nat), (k : Int) + ((j + 1) / 2 : Nat)⟩ + (∀ (j : Nat), GaussianQuarterTurn (q j) = dP j) → ((dV = {z | ∃ j ≤ N, z = dP j}) → + (GaussianQuarterTurn '' {z | ∃ j ≤ N, z = q j} = dV)) ) := by + classical + intro k q N dV dP dq dVenum + rw [dVenum] + ext z + constructor + · rintro ⟨w, ⟨j, hj, rfl⟩, rfl⟩ + exact ⟨j, hj, dq j⟩ + · rintro ⟨j, hj, rfl⟩ + exact ⟨q j, ⟨j, hj, rfl⟩, dq j⟩ + +private theorem dEimage : + (by + classical + exact + ∀ (k : Nat), + let q : Nat → GaussianInt := + P5157T1StaircasePoint ⟨(k : Int), -(k : Int)⟩ true 1 + let N : Nat := 2 * k - 1 + let dP : Nat → GaussianInt := fun j => + ⟨(k : Int) - (j / 2 : Nat), (k : Int) + ((j + 1) / 2 : Nat)⟩ + let dE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {dP j, dP (j + 1)}} + (∀ (j : Nat), GaussianQuarterTurn (q j) = dP j) → ((fun e : Finset GaussianInt => e.image + GaussianQuarterTurn) '' {e | ∃ j < N, e = {q j, q (j + 1)}} = dE) ) := by + classical + intro k q N dP dE dq + ext e + constructor + · rintro ⟨f, ⟨j, hj, rfl⟩, rfl⟩ + exact ⟨j, hj, by simp [dq]⟩ + · rintro ⟨j, hj, rfl⟩ + refine ⟨{q j, q (j + 1)}, ⟨j, hj, rfl⟩, ?_⟩ + simp [dq] + +private theorem decPath : + (by + classical + exact + ∀ (k : Nat), + let q : Nat → GaussianInt := + P5157T1StaircasePoint ⟨(k : Int), -(k : Int)⟩ true 1 + let N : Nat := 2 * k - 1 + (SimpleGridPathBetween (GaussianQuarterTurn '' {v : GaussianInt | ∃ j ≤ N, v = + P5157T1StaircasePoint ⟨(↑k : ℤ), -(↑k : ℤ)⟩ true (1 : ℤ) j}) ((fun (e : Finset + GaussianInt) => Finset.image GaussianQuarterTurn e) '' {e : Finset GaussianInt | ∃ j + < N, e = {P5157T1StaircasePoint ⟨(↑k : ℤ), -(↑k : ℤ)⟩ true (1 : ℤ) j, + P5157T1StaircasePoint ⟨(↑k : ℤ), -(↑k : ℤ)⟩ true (1 : ℤ) (j + (1 : ℕ))}}) + (GaussianQuarterTurn (P5157T1StaircasePoint ⟨(↑k : ℤ), -(↑k : ℤ)⟩ true (1 : ℤ) (0 : + ℕ))) (GaussianQuarterTurn (P5157T1StaircasePoint ⟨(↑k : ℤ), -(↑k : ℤ)⟩ true (1 : ℤ) + N))) → ((GaussianQuarterTurn (q 0) = ⟨(k : Int), (k : Int)⟩) → ((GaussianQuarterTurn + (q N) = ⟨1, 2 * (k : Int)⟩) → ( + let dV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1} + let dP : Nat → GaussianInt := fun j => + ⟨(k : Int) - (j / 2 : Nat), (k : Int) + ((j + 1) / 2 : Nat)⟩ + let dE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {dP j, dP (j + 1)}} + (GaussianQuarterTurn '' {z | ∃ j ≤ N, z = q j} = dV) → (((fun e : Finset GaussianInt => + e.image GaussianQuarterTurn) '' {e | ∃ j < N, e = {q j, q (j + 1)}} = dE) → + (SimpleGridPathBetween dV dE ⟨(k : Int), (k : Int)⟩ ⟨1, 2 * (k : Int)⟩))))) ) := by + classical + intro k q N qImagePath qendpoint₀ qendpoint₁ dV dP dE dVimage dEimage + have h := qImagePath + rw [dVimage, dEimage, qendpoint₀, qendpoint₁] at h + exact h + +private theorem dzero : + (by + classical + exact + ∀ (k : Nat), TileTranslation (DiamondTile k) 0 = DiamondTile k ) := by + classical + intro k + change (⟨(DiamondCellDomain k).image (GaussianTranslation 0), + GaussianTranslation 0 0⟩ : ProtoTile) = ⟨DiamondCellDomain k, 0⟩ + simp only [ProtoTile.mk.injEq] + constructor + · have hfun : GaussianTranslation 0 = id := by + funext z + simp [GaussianTranslation] + rw [hfun, Finset.image_id] + · simp [GaussianTranslation] + +private theorem decVertices : + (by + classical + exact + ∀ (k : Nat), + let dV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1} + (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices (TileTranslation + (DiamondTile k) ((0 : GaussianInt) + ⟨(↑k : ℤ) + (1 : ℤ), (↑k : ℤ)⟩)) = {z : + GaussianInt | (1 : ℤ) ≤ (z - (0 : GaussianInt)).re ∧ (z - (0 : GaussianInt)).re ≤ (↑k + : ℤ) ∧ (2 : ℤ) * (↑k : ℤ) ≤ (z - (0 : GaussianInt)).re + (z - (0 : GaussianInt)).im ∧ + (z - (0 : GaussianInt)).re + (z - (0 : GaussianInt)).im ≤ (2 : ℤ) * (↑k : ℤ) + (1 : + ℤ)}) → (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices + (TileTranslation (DiamondTile k) ⟨(k : Int) + 1, (k : Int)⟩) = dV) ) := by + classical + intro k dV dvertices + simpa [dV] using dvertices + +private theorem decEdges : + (by + classical + exact + ∀ (k : Nat), + let N : Nat := 2 * k - 1 + let dP : Nat → GaussianInt := fun j => + ⟨(k : Int) - (j / 2 : Nat), (k : Int) + ((j + 1) / 2 : Nat)⟩ + let dE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {dP j, dP (j + 1)}} + (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation + (DiamondTile k) ((0 : GaussianInt) + ⟨(↑k : ℤ) + (1 : ℤ), (↑k : ℤ)⟩)) = {e : Finset + GaussianInt | ∃ j < (2 : ℕ) * k - (1 : ℕ), e = + {(0 : GaussianInt) + ⟨(↑k : ℤ) - (↑(j / (2 : ℕ)) : ℤ), + (↑k : ℤ) + (↑((j + (1 : ℕ)) / (2 : ℕ)) : ℤ)⟩, (0 : GaussianInt) + ⟨(↑k : ℤ) - (↑((j + + (1 : ℕ)) / (2 : ℕ)) : ℤ), (↑k : ℤ) + (↑((j + (1 : ℕ) + (1 : ℕ)) / (2 : ℕ)) : ℤ)⟩}}) → + (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation + (DiamondTile k) ⟨(k : Int) + 1, (k : Int)⟩) = dE) ) := by + classical + intro k N dP dE dedges + simpa [dE, dP, N] using dedges + +private theorem decBetween : + (by + classical + exact + ∀ (k : Nat), + let N : Nat := 2 * k - 1 + let dV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1} + let dP : Nat → GaussianInt := fun j => + ⟨(k : Int) - (j / 2 : Nat), (k : Int) + ((j + 1) / 2 : Nat)⟩ + let dE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {dP j, dP (j + 1)}} + (SimpleGridPathBetween dV dE ⟨(k : Int), (k : Int)⟩ ⟨1, 2 * (k : Int)⟩) → + ((BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices + (TileTranslation (DiamondTile k) ⟨(k : Int) + 1, (k : Int)⟩) = dV) → + ((BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation + (DiamondTile k) ⟨(k : Int) + 1, (k : Int)⟩) = dE) → (SimpleGridPathBetween + (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices + (TileTranslation (DiamondTile k) ⟨(k : Int) + 1, (k : Int)⟩)) (BoundaryFootprintEdges + (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation (DiamondTile k) ⟨(k : Int) + + 1, (k : Int)⟩)) ⟨(k : Int), (k : Int)⟩ ⟨1, 2 * (k : Int)⟩))) ) := by + classical + intro k N dV dP dE decPath decVertices decEdges + rw [decVertices, decEdges] + exact decPath + +private theorem iVenum : + (by + classical + exact + ∀ (k : Nat), ((0 : ℕ) < k) → ( + let N : Nat := 2 * k - 1 + (0 < N) → ( + let iV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + z.re - 1 ≤ z.im ∧ z.im ≤ z.re} + let iP : Nat → GaussianInt := fun j => + ⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ + iV = {z | ∃ j ≤ N, z = iP j})) ) := by + classical + intro k hk N hN iV iP + ext z + constructor + · intro hz + have hz' : 1 ≤ z.re ∧ z.re ≤ k ∧ + z.re - 1 ≤ z.im ∧ z.im ≤ z.re := by simpa [iV] using hz + let j := (z.re + z.im - 1).toNat + have hj : (j : Int) = z.re + z.im - 1 := + Int.toNat_of_nonneg (by omega) + refine ⟨j, ?_, ?_⟩ + · change j ≤ 2 * k - 1 + omega + · apply Zsqrtd.ext + · simp [iP] + omega + · simp [iP] + omega + · rintro ⟨j, hj, rfl⟩ + simp only [iV, Set.mem_ofPred_eq, iP] + omega + +private theorem iEeq : + (by + classical + exact + ∀ (k : Nat), + let N : Nat := 2 * k - 1 + let iP : Nat → GaussianInt := fun j => + ⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ + let iE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {iP j, iP (j + 1)}} + let iq : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 + (∀ (j : Nat), iq j = iP j) → (iE = {e | ∃ j < N, e = {iq j, iq (j + 1)}}) ) := by + classical + intro k N iP iE iq iqenum + ext e + constructor + · rintro ⟨j, hj, rfl⟩ + exact ⟨j, hj, by simp [iqenum]⟩ + · rintro ⟨j, hj, rfl⟩ + exact ⟨j, hj, by simp [iqenum]⟩ + +private theorem incEnumPath : + (by + classical + exact + ∀ (k : Nat), ((0 : ℕ) < k) → ((∀ (z : GaussianInt), ∀ (h : Bool), ∀ (s : Int), (s = 1 ∨ s + = -1) → (∀ (N : Nat), (0 < N) → ( + let p := P5157T1StaircasePoint z h s; + SimpleGridPathBetween {v | ∃ j ≤ N, v = p j} + {e | ∃ j < N, e = {p j, p (j + 1)}} (p 0) (p N)))) → ( + let N : Nat := 2 * k - 1 + (0 < N) → ( + let iV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + z.re - 1 ≤ z.im ∧ z.im ≤ z.re} + let iP : Nat → GaussianInt := fun j => + ⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ + let iE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {iP j, iP (j + 1)}} + (iV = {z | ∃ j ≤ N, z = iP j}) → (SimpleGridPathBetween iV iE ⟨1, 0⟩ ⟨(k : Int), (k : + Int)⟩)))) ) := by + classical + intro k hk staircaseBetween N hN iV iP iE iVenum + have hpi (j : Nat) : P5157T1StaircasePoint 1 false 1 j = iP j := by + apply Zsqrtd.ext <;> simp [P5157T1StaircasePoint, iP] + have hp := staircaseBetween 1 false 1 (Or.inl rfl) N hN + have hp' : SimpleGridPathBetween {v | ∃ j ≤ N, v = iP j} + {e | ∃ j < N, e = {iP j, iP (j + 1)}} (iP 0) (iP N) := by + simpa only [hpi] using hp + have hEi : iE = {e | ∃ j < N, e = {iP j, iP (j + 1)}} := by + rfl + have iend : iP N = ⟨(k : Int), (k : Int)⟩ := by + apply Zsqrtd.ext <;> simp [iP, N] <;> omega + rw [← iVenum, ← hEi] at hp' + rw [iend] at hp' + simpa [iP] using hp' + +private theorem incVertices : + (by + classical + exact + ∀ (k : Nat), + let iV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + z.re - 1 ≤ z.im ∧ z.im ≤ z.re} + (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices (TileTranslation + (DiamondTile k) ((0 : GaussianInt) + ⟨(↑k : ℤ) + (1 : ℤ), -(↑k : ℤ)⟩)) = {z : + GaussianInt | (1 : ℤ) ≤ (z - (0 : GaussianInt)).re ∧ (z - (0 : GaussianInt)).re ≤ (↑k + : ℤ) ∧ (z - (0 : GaussianInt)).re - (1 : ℤ) ≤ (z - (0 : GaussianInt)).im ∧ (z - (0 : + GaussianInt)).im ≤ (z - (0 : GaussianInt)).re}) → (BoundaryFootprintVertices + (DiamondTile k) ∩ BoundaryFootprintVertices (TileTranslation (DiamondTile k) ⟨(k : + Int) + 1, -(k : Int)⟩) = iV) ) := by + classical + intro k iV ivertex0 + simpa [iV] using ivertex0 + +private theorem incEdges : + (by + classical + exact + ∀ (k : Nat), + let N : Nat := 2 * k - 1 + let iP : Nat → GaussianInt := fun j => + ⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ + let iE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {iP j, iP (j + 1)}} + (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation + (DiamondTile k) ((0 : GaussianInt) + ⟨(↑k : ℤ) + (1 : ℤ), -(↑k : ℤ)⟩)) = {e : Finset + GaussianInt | ∃ j < (2 : ℕ) * k - (1 : ℕ), e = + {(0 : GaussianInt) + ⟨(1 : ℤ) + (↑(j / (2 : ℕ)) : ℤ), + (↑((j + (1 : ℕ)) / (2 : ℕ)) : ℤ)⟩, (0 : GaussianInt) + ⟨(1 : ℤ) + (↑((j + (1 : ℕ)) / + (2 : ℕ)) : ℤ), (↑((j + (1 : ℕ) + (1 : ℕ)) / (2 : ℕ)) : ℤ)⟩}}) → + (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation + (DiamondTile k) ⟨(k : Int) + 1, -(k : Int)⟩) = iE) ) := by + classical + intro k N iP iE iedge0 + simpa [iE, iP, N] using iedge0 + +private theorem incBetween : + (by + classical + exact + ∀ (k : Nat), + let N : Nat := 2 * k - 1 + let iV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + z.re - 1 ≤ z.im ∧ z.im ≤ z.re} + let iP : Nat → GaussianInt := fun j => + ⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ + let iE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {iP j, iP (j + 1)}} + (SimpleGridPathBetween iV iE ⟨1, 0⟩ ⟨(k : Int), (k : Int)⟩) → ((BoundaryFootprintVertices + (DiamondTile k) ∩ BoundaryFootprintVertices (TileTranslation (DiamondTile k) ⟨(k : + Int) + 1, -(k : Int)⟩) = iV) → ((BoundaryFootprintEdges (DiamondTile k) ∩ + BoundaryFootprintEdges (TileTranslation (DiamondTile k) ⟨(k : Int) + 1, -(k : Int)⟩) + = iE) → (SimpleGridPathBetween (BoundaryFootprintVertices (DiamondTile k) ∩ + BoundaryFootprintVertices (TileTranslation (DiamondTile k) ⟨(k : Int) + 1, -(k : + Int)⟩)) (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges + (TileTranslation (DiamondTile k) ⟨(k : Int) + 1, -(k : Int)⟩)) ⟨1, 0⟩ ⟨(k : Int), (k + : Int)⟩))) ) := by + classical + intro k N iV iP iE incEnumPath incVertices incEdges + rw [incVertices, incEdges] + exact incEnumPath + +private theorem dzeroD' : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + TileTranslation D ⟨0, 0⟩ = D ) := by + classical + intro k D + change (⟨(DiamondCellDomain k).image + (GaussianTranslation ⟨0, 0⟩), + GaussianTranslation ⟨0, 0⟩ 0⟩ : ProtoTile) = + ⟨DiamondCellDomain k, 0⟩ + simp only [ProtoTile.mk.injEq] + have hzero : (⟨0, 0⟩ : GaussianInt) = 0 := rfl + constructor + · have hfun : GaussianTranslation ⟨0, 0⟩ = id := by + funext z + simp [GaussianTranslation, hzero] + rw [hfun, Finset.image_id] + · simp [GaussianTranslation, hzero] + +private theorem hcEq : + (by + classical + exact + ∀ (k : Nat), ((0 : ℕ) < k) → ( + let D := DiamondTile k + ∀ (c : GaussianInt), (GaussianRealPoint c = ((TileCentroid D).1 + (TileCentroid D).2, + (TileCentroid D).2 - (TileCentroid D).1)) → (c = ⟨(k : Int), (k : Int)⟩)) ) := by + classical + intro k hk D c hc + have hcent := P4194T1DiamondCentroid k hk + rw [hcent] at hc + simp? [GaussianRealPoint] at hc + rcases hc with ⟨hr, hi⟩ + apply Zsqrtd.ext + · rw [← GaussianInt.intCast_re c] at hr + exact_mod_cast hr + · rw [← GaussianInt.intCast_im c] at hi + exact_mod_cast hi + +private theorem F_inj : + (by + classical + exact + (Function.Injective GaussianQuarterTurn) → ( + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let F : GaussianInt → GaussianInt := fun z => Q z + c + Function.Injective F) ) := by + classical + intro qinj Q c F a b hab + apply qinj + exact add_right_cancel hab + +private theorem F_cell_inj : + (by + classical + exact + (Function.Injective GaussianQuarterTurn) → ( + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let Fc : GaussianInt → GaussianInt := fun z => Q z - 1 + c + Function.Injective Fc) ) := by + classical + intro qinj Q c Fc a b hab + have hq : Q a = Q b := by + have := add_right_cancel (show Q a - 1 + c = Q b - 1 + c from hab) + exact add_right_cancel (show Q a - 1 = Q b - 1 from this) + exact qinj hq + +private theorem F_step : + (by + classical + exact + (Nat) → ( + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let F : GaussianInt → GaussianInt := fun z => Q z + c + ∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → F b = F + a + 1 ∨ F b = F a - 1 ∨ F b = F a + ⟨0, 1⟩ ∨ F b = F a - ⟨0, 1⟩) ) := by + classical + intro k Q c F a b hh + rcases hh with h | h | h | h + · subst b; right; right; left; apply Zsqrtd.ext <;> + simp [F, Q, GaussianQuarterTurn]; omega + · subst b; right; right; right; apply Zsqrtd.ext <;> + simp [F, Q, GaussianQuarterTurn]; omega + · subst b; right; left; apply Zsqrtd.ext <;> + simp [F, Q, GaussianQuarterTurn]; omega + · subst b; left; apply Zsqrtd.ext <;> + simp [F, Q, GaussianQuarterTurn]; omega + +private theorem translateCells : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), (TileTranslation T (u + + v)).cells = (TileTranslation (TileTranslation T u) v).cells ) := by + classical + intro T u v + rw [(TileTranslationFormulas T (u + v)).1, + (TileTranslationFormulas (TileTranslation T u) v).1, + (TileTranslationFormulas T u).1] + rw [Finset.image_image] + congr 1 + funext z + simp [GaussianTranslation, add_comm, add_left_comm] + +private theorem quarterCells : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), ((TileTranslation (TileQuarterTurn D) ⟨(↑k : ℤ), (↑k : ℤ)⟩).cells = + D.cells) → ((c = ⟨(↑k : ℤ), (↑k : ℤ)⟩) → ((∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ + (v : GaussianInt), (TileTranslation T (u + v)).cells = (TileTranslation + (TileTranslation T u) v).cells) → (∀ (d : GaussianInt), (TileTranslation D (Q + d)).cells = (TileTranslation (TileQuarterTurn D) (c + Q d)).cells))) ) := by + classical + intro k D Q c hcCells hcEq translateCells d + rw [translateCells (TileQuarterTurn D) c (Q d)] + rw [(TileTranslationFormulas D (Q d)).1, + (TileTranslationFormulas (TileTranslation (TileQuarterTurn D) c) (Q d)).1, + hcEq, hcCells] + +private theorem quarterCellMap : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let Fc : GaussianInt → GaussianInt := fun z => Q z - 1 + c + (∀ (d : GaussianInt), (TileTranslation D (Q d)).cells = (TileTranslation (TileQuarterTurn + D) (c + Q d)).cells) → (∀ (d : GaussianInt), (TileTranslation D (Q d)).cells = + Finset.image Fc (TileTranslation D d).cells) ) := by + classical + intro k D Q c Fc quarterCells d + rw [quarterCells d, + (TileTranslationFormulas (TileQuarterTurn D) (c + Q d)).1, + (TileQuarterTurnFormulas D).1, + (TileTranslationFormulas D d).1] + simp only [Finset.image_image] + congr 1 + funext z + apply Zsqrtd.ext <;> + simp [Fc, Q, GaussianTranslation, GaussianQuarterTurn] <;> ring + +private theorem edgeCellsEq : + (by + classical + exact + ∀ {A : ProtoTile}, ∀ {B : ProtoTile}, A.cells = B.cells → BoundaryFootprintEdges A = + BoundaryFootprintEdges B ) := by + classical + intro A B hab + unfold BoundaryFootprintEdges + rw [hab] + +private theorem vertexCellsEq : + (by + classical + exact + ∀ {A : ProtoTile}, ∀ {B : ProtoTile}, A.cells = B.cells → Finset.Nonempty B.cells → + BoundaryFootprintVertices A = BoundaryFootprintVertices B ) := by + classical + intro A B hab hne + have hneA : A.cells.Nonempty := by rw [hab]; exact hne + simp only [BoundaryFootprintVertices, ite_eq_left hneA, ite_eq_left hne] + unfold BoundaryFootprintEdges + rw [hab] + +private theorem hDne : + (by + classical + exact + ∀ (k : Nat), (Finset.Nonempty (TileTranslation (DiamondTile k) (0 : GaussianInt)).cells) + → ((TileTranslation (DiamondTile k) (0 : GaussianInt) = DiamondTile k) → ( + let D := DiamondTile k + D.cells.Nonempty)) ) := by + classical + intro k dne dzero D + have hn := dne + rw [dzero] at hn + exact hn + +private theorem translatedDne : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + (D.cells.Nonempty) → (∀ (d : GaussianInt), Finset.Nonempty (TileTranslation D d).cells) ) + := by + classical + intro k D hDne d + rw [(TileTranslationFormulas D d).1] + exact hDne.image _ + +private theorem quarterTranslatedDne : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), (∀ (d : GaussianInt), (TileTranslation D (Q d)).cells = + (TileTranslation (TileQuarterTurn D) (c + Q d)).cells) → ((∀ (d : GaussianInt), + (TileTranslation D d).cells.Nonempty) → (∀ (d : GaussianInt), Finset.Nonempty + (TileTranslation (TileQuarterTurn D) (c + Q d)).cells)) ) := by + classical + intro k D Q c quarterCells translatedDne d + rw [← quarterCells d] + exact translatedDne (Q d) + +private theorem quarterVerticesAt : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let F : GaussianInt → GaussianInt := fun z => Q z + c + (∀ (d : GaussianInt), (TileTranslation D (Q d)).cells = (TileTranslation (TileQuarterTurn + D) (c + Q d)).cells) → ((∀ {A : ProtoTile}, ∀ {B : ProtoTile}, (A.cells = B.cells) → + ((B.cells.Nonempty) → (BoundaryFootprintVertices A = BoundaryFootprintVertices B))) → + ((∀ (d : GaussianInt), (TileTranslation (TileQuarterTurn D) (c + Q + d)).cells.Nonempty) → (∀ (d : GaussianInt), BoundaryFootprintVertices + (TileTranslation D (Q d)) = F '' BoundaryFootprintVertices (TileTranslation D d)))) ) + := by + classical + intro k D Q c F quarterCells vertexCellsEq quarterTranslatedDne d + rw [vertexCellsEq (quarterCells d) (quarterTranslatedDne d), + (TileTranslationFormulas (TileQuarterTurn D) (c + Q d)).2.2.2.2.2.2.2.1, + (TileQuarterTurnFormulas D).2.2.2.2.2.2.2.1, + (TileTranslationFormulas D d).2.2.2.2.2.2.2.1] + rw [Set.image_image, Set.image_image] + congr 1 + funext z + simp [F, GaussianTranslation, GaussianQuarterTurn, Q, add_assoc, + add_comm] + +private theorem quarterEdgesAt : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let F : GaussianInt → GaussianInt := fun z => Q z + c + (∀ (d : GaussianInt), (TileTranslation D (Q d)).cells = (TileTranslation (TileQuarterTurn + D) (c + Q d)).cells) → ((∀ {A : ProtoTile}, ∀ {B : ProtoTile}, (A.cells = B.cells) → + (BoundaryFootprintEdges A = BoundaryFootprintEdges B)) → (∀ (d : GaussianInt), + BoundaryFootprintEdges (TileTranslation D (Q d)) = (fun (e : Finset GaussianInt) => + Finset.image F e) '' BoundaryFootprintEdges (TileTranslation D d))) ) := by + classical + intro k D Q c F quarterCells edgeCellsEq d + rw [edgeCellsEq (quarterCells d), + (TileTranslationFormulas (TileQuarterTurn D) (c + Q d)).2.2.2.2.2.2.2.2, + (TileQuarterTurnFormulas D).2.2.2.2.2.2.2.2, + (TileTranslationFormulas D d).2.2.2.2.2.2.2.2] + rw [Set.image_image, Set.image_image] + congr 1 + funext e + ext z + simp [F, GaussianTranslation, GaussianQuarterTurn, Q, + Finset.image_image, add_assoc, add_comm] + +private theorem dShift : + (by + classical + exact + ∀ (k : Nat), + let Q := GaussianQuarterTurn + Q ⟨(k : Int) + 1, (k : Int)⟩ = ⟨-(k : Int), (k : Int) + 1⟩ ) := by + classical + intro k Q + apply Zsqrtd.ext <;> simp [Q, GaussianQuarterTurn] + +private theorem firstTurn : + (by + classical + exact + ∀ (k : Nat), (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ + {x : GaussianInt}, ∀ {y : GaussianInt}, ∀ (f : GaussianInt → GaussianInt), + (Function.Injective f) → ((∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, + 1⟩ ∨ b = a - ⟨0, 1⟩) → f b = f a + 1 ∨ f b = f a - 1 ∨ f b = f a + ⟨0, 1⟩ ∨ f b = f a + - ⟨0, 1⟩) → ((SimpleGridPathBetween V E x y) → (SimpleGridPathBetween (f '' V) ((fun + e : Finset GaussianInt => e.image f) '' E) (f x) (f y))))) → ((SimpleGridPathBetween + (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices + (TileTranslation (DiamondTile k) ⟨(k : Int) + 1, (k : Int)⟩)) (BoundaryFootprintEdges + (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation (DiamondTile k) ⟨(k : Int) + + 1, (k : Int)⟩)) ⟨(k : Int), (k : Int)⟩ ⟨1, 2 * (k : Int)⟩) → ( + let D := DiamondTile k + let Q := GaussianQuarterTurn + (TileTranslation D 0 = D) → (∀ (c : GaussianInt), (c = ⟨(↑k : ℤ), (↑k : ℤ)⟩) → ( + let F : GaussianInt → GaussianInt := fun z => Q z + c + (Function.Injective F) → ((∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ + b = a - ⟨0, 1⟩) → F b = F a + 1 ∨ F b = F a - 1 ∨ F b = F a + ⟨0, 1⟩ ∨ F b = F a - + ⟨0, 1⟩) → ((∀ (d : GaussianInt), BoundaryFootprintVertices (TileTranslation D (Q d)) + = F '' BoundaryFootprintVertices (TileTranslation D d)) → ((∀ (d : GaussianInt), + BoundaryFootprintEdges (TileTranslation D (Q d)) = (fun e : Finset GaussianInt => + e.image F) '' BoundaryFootprintEdges (TileTranslation D d)) → ((Q ⟨(k : Int) + 1, (k + : Int)⟩ = ⟨-(k : Int), (k : Int) + 1⟩) → (SimpleGridPathBetween + (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D ⟨-(k : + Int), (k : Int) + 1⟩)) (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges + (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩)) ⟨0, 2 * (k : Int)⟩ ⟨-(k : Int), (k : + Int) + 1⟩))))))))) ) := by + classical + intro k imagePath decBetween D Q dzeroD c hcEq F F_inj F_step quarterVerticesAt quarterEdgesAt + dShift + have h := imagePath F F_inj F_step decBetween + have eF : Function.Injective + (fun e : Finset GaussianInt => e.image F) := Finset.image_injective F_inj + have q0 : Q 0 = (0 : GaussianInt) := by + apply Zsqrtd.ext <;> simp [Q, GaussianQuarterTurn] + have qv0 : BoundaryFootprintVertices D = + F '' BoundaryFootprintVertices D := by + simpa [D, Q, GaussianQuarterTurn, dzeroD, dzeroD', q0] using quarterVerticesAt 0 + have qe0 : BoundaryFootprintEdges D = + (fun e : Finset GaussianInt => e.image F) '' + BoundaryFootprintEdges D := by + simpa [D, Q, GaussianQuarterTurn, dzeroD, dzeroD', q0] using quarterEdgesAt 0 + have qvA : BoundaryFootprintVertices + (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩) = + F '' BoundaryFootprintVertices + (TileTranslation D ⟨(k : Int) + 1, (k : Int)⟩) := by + rw [← dShift] + exact quarterVerticesAt _ + have qeA : BoundaryFootprintEdges + (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩) = + (fun e : Finset GaussianInt => e.image F) '' + BoundaryFootprintEdges + (TileTranslation D ⟨(k : Int) + 1, (k : Int)⟩) := by + rw [← dShift] + exact quarterEdgesAt _ + rw [Set.image_inter F_inj, Set.image_inter eF, + ← qv0, ← qvA, ← qe0, ← qeA] at h + have hstart : F ⟨(k : Int), (k : Int)⟩ = ⟨0, 2 * (k : Int)⟩ := by + apply Zsqrtd.ext <;> simp [F, Q, GaussianQuarterTurn, hcEq]; ring + have hend : F ⟨1, 2 * (k : Int)⟩ = + ⟨-(k : Int), (k : Int) + 1⟩ := by + apply Zsqrtd.ext <;> simp [F, Q, GaussianQuarterTurn, hcEq] <;> ring + rw [hstart, hend] at h + exact h + +private theorem G_inj : + (by + classical + exact + ∀ (k : Nat), + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let F : GaussianInt → GaussianInt := fun z => Q z + c + let G : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - z.re⟩ + (∀ (z : GaussianInt), F (G z) = z) → (Function.Injective G) ) := by + classical + intro k Q c F G FG a b hab + calc + a = F (G a) := (FG a).symm + _ = F (G b) := congrArg F hab + _ = b := FG b + +private theorem Gc_inj : + (by + classical + exact + ∀ (k : Nat), + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let Fc : GaussianInt → GaussianInt := fun z => Q z - 1 + c + let Gc : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - 1 - z.re⟩ + (∀ (z : GaussianInt), Fc (Gc z) = z) → (Function.Injective Gc) ) := by + classical + intro k Q c Fc Gc FcGc a b hab + calc + a = Fc (Gc a) := (FcGc a).symm + _ = Fc (Gc b) := congrArg Fc hab + _ = b := FcGc b + +private theorem G_step : + (by + classical + exact + ∀ (k : Nat), + let G : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - z.re⟩ + ∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → G b = G + a + 1 ∨ G b = G a - 1 ∨ G b = G a + ⟨0, 1⟩ ∨ G b = G a - ⟨0, 1⟩ ) := by + classical + intro k G a b hh + rcases hh with h | h | h | h + · subst b; right; right; right; apply Zsqrtd.ext <;> simp [G]; ring + · subst b; right; right; left; apply Zsqrtd.ext <;> simp [G]; ring + · subst b; left; apply Zsqrtd.ext <;> simp [G]; ring + · subst b; right; left; apply Zsqrtd.ext <;> simp [G]; ring + +private theorem inverseVerticesAt : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let F : GaussianInt → GaussianInt := fun z => Q z + c + (∀ (d : GaussianInt), BoundaryFootprintVertices (TileTranslation D (Q d)) = F '' + BoundaryFootprintVertices (TileTranslation D d)) → ( + let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + let G : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - z.re⟩ + (∀ (z : GaussianInt), Q (Qinv z) = z) → ((∀ (z : GaussianInt), G (F z) = z) → (∀ (d : + GaussianInt), G '' BoundaryFootprintVertices (TileTranslation D d) = + BoundaryFootprintVertices (TileTranslation D (Qinv d))))) ) := by + classical + intro k D Q c F quarterVerticesAt Qinv G qInvLeft GF d + have h := quarterVerticesAt (Qinv d) + rw [qInvLeft d] at h + have hi := congrArg (Set.image G) h + rw [Set.image_image] at hi + simpa [Function.comp_def, GF] using hi + +private theorem inverseEdgesAt : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let F : GaussianInt → GaussianInt := fun z => Q z + c + (∀ (d : GaussianInt), BoundaryFootprintEdges (TileTranslation D (Q d)) = (fun e : Finset + GaussianInt => e.image F) '' BoundaryFootprintEdges (TileTranslation D d)) → ( + let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + let G : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - z.re⟩ + (∀ (z : GaussianInt), Q (Qinv z) = z) → ((∀ (z : GaussianInt), G (F z) = z) → (∀ (d : + GaussianInt), (fun (e : Finset GaussianInt) => Finset.image G e) '' + BoundaryFootprintEdges (TileTranslation D d) = BoundaryFootprintEdges + (TileTranslation D (Qinv d))))) ) := by + classical + intro k D Q c F quarterEdgesAt Qinv G qInvLeft GF d + have h := quarterEdgesAt (Qinv d) + rw [qInvLeft d] at h + have hi := congrArg + (Set.image (fun e : Finset GaussianInt => e.image G)) h + rw [Set.image_image] at hi + have himage : (fun e : Finset GaussianInt => (e.image F).image G) = id := by + funext e + rw [Finset.image_image] + simp [Function.comp_def, GF] + rw [himage] at hi + simpa using hi + +private theorem inverseCellAt : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let Fc : GaussianInt → GaussianInt := fun z => Q z - 1 + c + (∀ (d : GaussianInt), (TileTranslation D (Q d)).cells = ((TileTranslation D + d).cells.image Fc)) → ( + let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + let Gc : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - 1 - z.re⟩ + (∀ (z : GaussianInt), Q (Qinv z) = z) → ((∀ (z : GaussianInt), Gc (Fc z) = z) → (∀ (d : + GaussianInt), (TileTranslation D (Qinv d)).cells = Finset.image Gc (TileTranslation D + d).cells))) ) := by + classical + intro k D Q c Fc quarterCellMap Qinv Gc qInvLeft GcFc d + have h := quarterCellMap (Qinv d) + rw [qInvLeft d] at h + have hi := congrArg (fun s : Finset GaussianInt => s.image Gc) h + rw [Finset.image_image] at hi + have hcomp : Gc ∘ Fc = id := by funext z; exact GcFc z + rw [hcomp, Finset.image_id] at hi + simpa using hi.symm + +private theorem inverseVerticesZero : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + (TileTranslation D 0 = D) → ( + let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + let G : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - z.re⟩ + (∀ (d : GaussianInt), G '' BoundaryFootprintVertices (TileTranslation D d) = + BoundaryFootprintVertices (TileTranslation D (Qinv d))) → ((Qinv 0 = 0) → (G '' + BoundaryFootprintVertices D = BoundaryFootprintVertices D))) ) := by + classical + intro k D dzeroD Qinv G inverseVerticesAt qInvZero + simpa [Qinv, qInvZero, dzeroD, dzeroD', D] using inverseVerticesAt 0 + +private theorem inverseEdgesZero : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + (TileTranslation D 0 = D) → ( + let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + let G : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - z.re⟩ + (∀ (d : GaussianInt), (fun e : Finset GaussianInt => e.image G) '' BoundaryFootprintEdges + (TileTranslation D d) = BoundaryFootprintEdges (TileTranslation D (Qinv d))) → ((Qinv + 0 = 0) → ((fun e : Finset GaussianInt => e.image G) '' BoundaryFootprintEdges D = + BoundaryFootprintEdges D))) ) := by + classical + intro k D dzeroD Qinv G inverseEdgesAt qInvZero + simpa [Qinv, qInvZero, dzeroD, dzeroD', D] using inverseEdgesAt 0 + +private theorem thirdTurn : + (by + classical + exact + ∀ (k : Nat), (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ + {x : GaussianInt}, ∀ {y : GaussianInt}, ∀ (f : GaussianInt → GaussianInt), + (Function.Injective f) → ((∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, + 1⟩ ∨ b = a - ⟨0, 1⟩) → f b = f a + 1 ∨ f b = f a - 1 ∨ f b = f a + ⟨0, 1⟩ ∨ f b = f a + - ⟨0, 1⟩) → ((SimpleGridPathBetween V E x y) → (SimpleGridPathBetween (f '' V) ((fun + e : Finset GaussianInt => e.image f) '' E) (f x) (f y))))) → ((SimpleGridPathBetween + (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices + (TileTranslation (DiamondTile k) ⟨(k : Int) + 1, -(k : Int)⟩)) + (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation + (DiamondTile k) ⟨(k : Int) + 1, -(k : Int)⟩)) ⟨1, 0⟩ ⟨(k : Int), (k : Int)⟩) → ( + let D := DiamondTile k + let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + let G : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - z.re⟩ + (Function.Injective G) → ((∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ + b = a - ⟨0, 1⟩) → G b = G a + 1 ∨ G b = G a - 1 ∨ G b = G a + ⟨0, 1⟩ ∨ G b = G a - + ⟨0, 1⟩) → ((∀ (d : GaussianInt), G '' BoundaryFootprintVertices (TileTranslation D d) + = BoundaryFootprintVertices (TileTranslation D (Qinv d))) → ((∀ (d : GaussianInt), + (fun e : Finset GaussianInt => e.image G) '' BoundaryFootprintEdges (TileTranslation + D d) = BoundaryFootprintEdges (TileTranslation D (Qinv d))) → ((G '' + BoundaryFootprintVertices D = BoundaryFootprintVertices D) → (((fun e : Finset + GaussianInt => e.image G) '' BoundaryFootprintEdges D = BoundaryFootprintEdges D) → + (SimpleGridPathBetween (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices + (TileTranslation D (Qinv ⟨(k : Int) + 1, -(k : Int)⟩))) (BoundaryFootprintEdges D ∩ + BoundaryFootprintEdges (TileTranslation D (Qinv ⟨(k : Int) + 1, -(k : Int)⟩))) ⟨-(k : + Int), (k : Int) - 1⟩ 0)))))))) ) := by + classical + intro k imagePath incBetween D Qinv G G_inj G_step inverseVerticesAt inverseEdgesAt + inverseVerticesZero inverseEdgesZero + have h := imagePath G G_inj G_step incBetween + have eG : Function.Injective + (fun e : Finset GaussianInt => e.image G) := Finset.image_injective G_inj + rw [Set.image_inter G_inj, Set.image_inter eG, + inverseVerticesZero, + inverseVerticesAt ⟨(k : Int) + 1, -(k : Int)⟩, + inverseEdgesZero, inverseEdgesAt ⟨(k : Int) + 1, -(k : Int)⟩] at h + have hstart : G ⟨1, 0⟩ = ⟨-(k : Int), (k : Int) - 1⟩ := by + apply Zsqrtd.ext <;> simp [G] + have hend : G ⟨(k : Int), (k : Int)⟩ = 0 := by + apply Zsqrtd.ext <;> simp [G] + rw [hstart, hend] at h + simpa [Qinv, GaussianQuarterTurn] using h + +private theorem cellMapRight : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let Fc : GaussianInt → GaussianInt := fun z => Q z - 1 + c + (∀ (d : GaussianInt), (TileTranslation D (Q d)).cells = ((TileTranslation D + d).cells.image Fc)) → ((Q ⟨(k : Int) + 1, (k : Int)⟩ = ⟨-(k : Int), (k : Int) + 1⟩) → ( + let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩).cells = (TileTranslation D + da).cells.image Fc)) ) := by + classical + intro k D Q c Fc quarterCellMap dShift da + rw [← dShift] + exact quarterCellMap da + +private theorem ddisjD : + (by + classical + exact + ∀ (k : Nat), (Disjoint (TileTranslation (DiamondTile k) (0 : GaussianInt)).cells + (TileTranslation (DiamondTile k) ((0 : GaussianInt) + ⟨(↑k : ℤ) + (1 : ℤ), (↑k : + ℤ)⟩)).cells) → ( + let D := DiamondTile k + (TileTranslation D 0 = D) → ( + let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + Disjoint D.cells (TileTranslation D da).cells)) ) := by + classical + intro k ddisj D dzeroD da + have h := ddisj + rw [dzeroD] at h + simpa only [zero_add] using h + +private theorem disjointImage : + (by + classical + exact + ∀ {α : Type}, ∀ [inst : DecidableEq α], ∀ {s : Finset α}, ∀ {t : Finset α}, ∀ (f : α → + α), Function.Injective f → Disjoint s t → Disjoint (Finset.image f s) (Finset.image f + t) ) := by + classical + intro α typeclassInstance0 s t f hf hdis + apply Finset.disjoint_left.mpr + intro z hz₁ hz₂ + rcases Finset.mem_image.mp hz₁ with ⟨a, ha, rfl⟩ + rcases Finset.mem_image.mp hz₂ with ⟨b, hb, hab⟩ + have hab' : b = a := hf hab + subst b + exact (Finset.disjoint_left.mp hdis) ha hb + +private theorem firstCells₁ : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let Fc : GaussianInt → GaussianInt := fun z => Q z - 1 + c + let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + ((TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩).cells = (TileTranslation D + da).cells.image Fc) → (((TileTranslation D da).cells.Nonempty) → ((TileTranslation D + ⟨-(k : Int), (k : Int) + 1⟩).cells.Nonempty)) ) := by + classical + intro k D Q c Fc da cellMapRight dneDright + rw [cellMapRight] + exact dneDright.image _ + +private theorem firstCellsDisj : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let Fc : GaussianInt → GaussianInt := fun z => Q z - 1 + c + (Function.Injective Fc) → ((D.cells = D.cells.image Fc) → ( + let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + ((TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩).cells = (TileTranslation D + da).cells.image Fc) → ((Disjoint D.cells (TileTranslation D da).cells) → ((∀ + {α : Type}, ∀ [DecidableEq α], ∀ {s : Finset α}, ∀ {t : Finset α}, ∀ (f : α → α), + (Function.Injective f) → ((Disjoint s t) → (Disjoint (s.image f) (t.image f)))) → + (Disjoint D.cells (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩).cells))))) ) := by + classical + intro k D Q c Fc F_cell_inj cellMapZero da cellMapRight ddisjD disjointImage + rw [cellMapZero, cellMapRight] + exact disjointImage Fc F_cell_inj ddisjD + +private theorem idisjD : + (by + classical + exact + ∀ (k : Nat), (Disjoint (TileTranslation (DiamondTile k) (0 : GaussianInt)).cells + (TileTranslation (DiamondTile k) ((0 : GaussianInt) + ⟨(↑k : ℤ) + (1 : ℤ), -(↑k : + ℤ)⟩)).cells) → ( + let D := DiamondTile k + (TileTranslation D 0 = D) → ( + let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + Disjoint D.cells (TileTranslation D ia).cells)) ) := by + classical + intro k idisj D dzeroD ia + have h := idisj + rw [dzeroD] at h + simpa only [zero_add] using h + +private theorem thirdCells₁ : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + let Gc : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - 1 - z.re⟩ + let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + ((TileTranslation D (Qinv ia)).cells = (TileTranslation D ia).cells.image Gc) → + (((TileTranslation D ia).cells.Nonempty) → ((TileTranslation D (Qinv + ia)).cells.Nonempty)) ) := by + classical + intro k D Qinv Gc ia inverseCellRight ineDright + rw [inverseCellRight] + exact ineDright.image _ + +private theorem thirdCellsDisj : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + let Gc : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - 1 - z.re⟩ + (Function.Injective Gc) → ((∀ {α : Type}, ∀ [DecidableEq α], ∀ {s : Finset α}, ∀ + {t : Finset α}, ∀ (f : α → α), (Function.Injective f) → ((Disjoint s t) → (Disjoint + (s.image f) (t.image f)))) → ((D.cells = D.cells.image Gc) → ( + let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + ((TileTranslation D (Qinv ia)).cells = (TileTranslation D ia).cells.image Gc) → + ((Disjoint D.cells (TileTranslation D ia).cells) → (Disjoint D.cells (TileTranslation + D (Qinv ia)).cells))))) ) := by + classical + intro k D Qinv Gc Gc_inj disjointImage inverseCellZero ia inverseCellRight idisjD + rw [inverseCellZero, inverseCellRight] + exact disjointImage Gc Gc_inj idisjD + +private theorem translateStep : + (by + classical + exact + ∀ (u : GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), b = a + (1 : GaussianInt) + ∨ b = a - (1 : GaussianInt) ∨ b = a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ b = a - ⟨(0 : ℤ), (1 : ℤ)⟩ + → GaussianTranslation u b = GaussianTranslation u a + (1 : GaussianInt) ∨ + GaussianTranslation u b = GaussianTranslation u a - (1 : GaussianInt) ∨ + GaussianTranslation u b = GaussianTranslation u a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ + GaussianTranslation u b = GaussianTranslation u a - ⟨(0 : ℤ), (1 : ℤ)⟩ ) := by + classical + intro u a b hh + rcases hh with h | h | h | h + · subst b; left; apply Zsqrtd.ext <;> simp [GaussianTranslation]; ring + · subst b; right; left; apply Zsqrtd.ext <;> simp [GaussianTranslation]; ring + · subst b; right; right; left; apply Zsqrtd.ext <;> simp [GaussianTranslation]; ring + · subst b; right; right; right; apply Zsqrtd.ext <;> simp [GaussianTranslation]; ring + +private theorem translateInj : + (by + classical + exact + ∀ (u : GaussianInt), Function.Injective (GaussianTranslation u) ) := by + classical + intro u a b hab + exact add_right_cancel hab + +private theorem shiftPath : + (by + classical + exact + ∀ (k : Nat), (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ + {x : GaussianInt}, ∀ {y : GaussianInt}, ∀ (f : GaussianInt → GaussianInt), + (Function.Injective f) → ((∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, + 1⟩ ∨ b = a - ⟨0, 1⟩) → f b = f a + 1 ∨ f b = f a - 1 ∨ f b = f a + ⟨0, 1⟩ ∨ f b = f a + - ⟨0, 1⟩) → ((SimpleGridPathBetween V E x y) → (SimpleGridPathBetween (f '' V) ((fun + e : Finset GaussianInt => e.image f) '' E) (f x) (f y))))) → ((SimpleGridPathBetween + (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices + (TileTranslation (DiamondTile k) ⟨(k : Int) + 1, -(k : Int)⟩)) + (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation + (DiamondTile k) ⟨(k : Int) + 1, -(k : Int)⟩)) ⟨1, 0⟩ ⟨(k : Int), (k : Int)⟩) → ( + let D := DiamondTile k + (TileTranslation D 0 = D) → ((∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), (TileTranslation T (u + v)).cells = (TileTranslation (TileTranslation T + u) v).cells) → ((∀ {A : ProtoTile}, ∀ {B : ProtoTile}, (A.cells = B.cells) → + (BoundaryFootprintEdges A = BoundaryFootprintEdges B)) → ((∀ {A : ProtoTile}, ∀ + {B : ProtoTile}, (A.cells = B.cells) → ((B.cells.Nonempty) → + (BoundaryFootprintVertices A = BoundaryFootprintVertices B))) → ((D.cells.Nonempty) → ( + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + (∀ (u : GaussianInt), ∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = + a - ⟨0, 1⟩) → GaussianTranslation u b = GaussianTranslation u a + 1 ∨ + GaussianTranslation u b = GaussianTranslation u a - 1 ∨ GaussianTranslation u b = + GaussianTranslation u a + ⟨0, 1⟩ ∨ GaussianTranslation u b = GaussianTranslation u a + - ⟨0, 1⟩) → ((∀ (u : GaussianInt), Function.Injective (GaussianTranslation u)) → + (SimpleGridPathBetween (BoundaryFootprintVertices (TileTranslation D shift) ∩ + BoundaryFootprintVertices D) (BoundaryFootprintEdges (TileTranslation D shift) ∩ + BoundaryFootprintEdges D) ⟨-(k : Int), (k : Int)⟩ ⟨-1, 2 * (k : Int)⟩))))))))) ) := by + classical + intro k imagePath incBetween D dzeroD translateCells edgeCellsEq vertexCellsEq hDne shift + translateStep translateInj + let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + have h := imagePath (GaussianTranslation shift) (translateInj shift) + (translateStep shift) incBetween + have eT : Function.Injective + (fun e : Finset GaussianInt => e.image (GaussianTranslation shift)) := + Finset.image_injective (translateInj shift) + have hsum : shift + ia = 0 := by + apply Zsqrtd.ext <;> simp [shift, ia] + have hsum' : ia + shift = 0 := by rw [add_comm]; exact hsum + have hnested : (TileTranslation (TileTranslation D ia) shift).cells = D.cells := by + rw [← translateCells D ia shift, hsum', dzeroD] + have hnestedV : BoundaryFootprintVertices + (TileTranslation (TileTranslation D ia) shift) = BoundaryFootprintVertices D := + vertexCellsEq hnested hDne + have hnestedE : BoundaryFootprintEdges + (TileTranslation (TileTranslation D ia) shift) = BoundaryFootprintEdges D := + edgeCellsEq hnested + rw [Set.image_inter (translateInj shift), Set.image_inter eT] at h + rw [← (TileTranslationFormulas D shift).2.2.2.2.2.2.2.1, + ← (TileTranslationFormulas D shift).2.2.2.2.2.2.2.2, + ← (TileTranslationFormulas (TileTranslation D ia) shift).2.2.2.2.2.2.2.1, + ← (TileTranslationFormulas (TileTranslation D ia) shift).2.2.2.2.2.2.2.2, + hnestedV, hnestedE] at h + have hs : GaussianTranslation shift ⟨1, 0⟩ = ⟨-(k : Int), (k : Int)⟩ := by + apply Zsqrtd.ext <;> simp [GaussianTranslation, shift] + have he : GaussianTranslation shift ⟨(k : Int), (k : Int)⟩ = + ⟨-1, 2 * (k : Int)⟩ := by + apply Zsqrtd.ext <;> simp [GaussianTranslation, shift] <;> ring + have h' : SimpleGridPathBetween + (BoundaryFootprintVertices (TileTranslation D shift) ∩ + BoundaryFootprintVertices D) + (BoundaryFootprintEdges (TileTranslation D shift) ∩ + BoundaryFootprintEdges D) + (GaussianTranslation shift ⟨1, 0⟩) + (GaussianTranslation shift ⟨(k : Int), (k : Int)⟩) := h + rw [hs, he] at h' + exact h' + +private theorem shiftCellsOne : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + (TileTranslation D shift).cells = (D.cells.image (GaussianTranslation shift)) ) := by + classical + intro k D shift + exact (TileTranslationFormulas D shift).1 + +private theorem shiftCellsTwo : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + (TileTranslation D 0 = D) → ((∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), (TileTranslation T (u + v)).cells = (TileTranslation (TileTranslation T + u) v).cells) → ( + let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + D.cells = ((TileTranslation D ia).cells.image (GaussianTranslation shift)))) ) := by + classical + intro k D dzeroD translateCells ia shift + have hsum : ia + shift = 0 := by + apply Zsqrtd.ext <;> simp [ia, shift] + have h := translateCells D ia shift + rw [hsum, dzeroD] at h + rw [(TileTranslationFormulas (TileTranslation D ia) shift).1] at h + exact h + +private theorem shiftCellsNonempty : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + (D.cells.Nonempty) → ( + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + ((TileTranslation D shift).cells = (D.cells.image (GaussianTranslation shift))) → + ((TileTranslation D shift).cells.Nonempty)) ) := by + classical + intro k D hDne shift shiftCellsOne + rw [shiftCellsOne] + exact hDne.image _ + +private theorem shiftCellsDisjoint : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + (∀ {α : Type}, ∀ [DecidableEq α], ∀ {s : Finset α}, ∀ {t : Finset α}, ∀ (f : α → α), + (Function.Injective f) → ((Disjoint s t) → (Disjoint (s.image f) (t.image f)))) → ( + let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + (Disjoint D.cells (TileTranslation D ia).cells) → ( + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + (∀ (u : GaussianInt), Function.Injective (GaussianTranslation u)) → (((TileTranslation D + shift).cells = (D.cells.image (GaussianTranslation shift))) → ((D.cells = + ((TileTranslation D ia).cells.image (GaussianTranslation shift))) → (Disjoint D.cells + (TileTranslation D shift).cells))))) ) := by + classical + intro k D disjointImage ia idisjD shift translateInj shiftCellsOne shiftCellsTwo + rw [shiftCellsOne] + have h := (disjointImage (GaussianTranslation shift) (translateInj shift) idisjD).symm + simpa only [← shiftCellsTwo] using h + +private theorem shiftVertices : + (by + classical + exact + ∀ (k : Nat), + let iV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + z.re - 1 ≤ z.im ∧ z.im ≤ z.re} + (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices (TileTranslation + (DiamondTile k) ⟨(k : Int) + 1, -(k : Int)⟩) = iV) → ( + let D := DiamondTile k + let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + (∀ (u : GaussianInt), Function.Injective (GaussianTranslation u)) → + ((BoundaryFootprintVertices (TileTranslation (TileTranslation D ia) shift) = + BoundaryFootprintVertices D) → (BoundaryFootprintVertices (TileTranslation D shift) ∩ + BoundaryFootprintVertices D = GaussianTranslation shift '' iV))) ) := by + classical + intro k iV incVertices D ia shift translateInj hnestedV + rw [← hnestedV, + (TileTranslationFormulas D shift).2.2.2.2.2.2.2.1, + (TileTranslationFormulas (TileTranslation D ia) shift).2.2.2.2.2.2.2.1, + ← Set.image_inter (translateInj shift), incVertices] + +private theorem shiftEdges : + (by + classical + exact + ∀ (k : Nat), + let N : Nat := 2 * k - 1 + let iP : Nat → GaussianInt := fun j => + ⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ + let iE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {iP j, iP (j + 1)}} + (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation + (DiamondTile k) ⟨(k : Int) + 1, -(k : Int)⟩) = iE) → ( + let D := DiamondTile k + let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + (∀ (u : GaussianInt), Function.Injective (GaussianTranslation u)) → + ((BoundaryFootprintEdges (TileTranslation (TileTranslation D ia) shift) = + BoundaryFootprintEdges D) → (BoundaryFootprintEdges (TileTranslation D shift) ∩ + BoundaryFootprintEdges D = (fun e : Finset GaussianInt => e.image + (GaussianTranslation shift)) '' iE))) ) := by + classical + intro k N iP iE incEdges D ia shift translateInj hnestedE + let et : Finset GaussianInt → Finset GaussianInt := + fun e => e.image (GaussianTranslation shift) + have eti : Function.Injective et := Finset.image_injective (translateInj shift) + rw [← hnestedE, + (TileTranslationFormulas D shift).2.2.2.2.2.2.2.2, + (TileTranslationFormulas (TileTranslation D ia) shift).2.2.2.2.2.2.2.2, + ← Set.image_inter eti, incEdges] + +private theorem fourthPath : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + (SimpleGridPathBetween (BoundaryFootprintVertices (TileTranslation D shift) ∩ + BoundaryFootprintVertices D) (BoundaryFootprintEdges (TileTranslation D shift) ∩ + BoundaryFootprintEdges D) ⟨-(k : Int), (k : Int)⟩ ⟨-1, 2 * (k : Int)⟩) → + (SimpleGridPathBetween (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices + (TileTranslation D shift)) (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges + (TileTranslation D shift)) ⟨-(k : Int), (k : Int)⟩ ⟨-1, 2 * (k : Int)⟩) ) := by + classical + intro k D shift shiftPath + simpa only [Set.inter_comm] using shiftPath + +private theorem zeroFvertices : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Q := GaussianQuarterTurn + (TileTranslation D 0 = D) → (∀ (c : GaussianInt), + let F : GaussianInt → GaussianInt := fun z => Q z + c + (∀ (d : GaussianInt), BoundaryFootprintVertices (TileTranslation D (Q d)) = F '' + BoundaryFootprintVertices (TileTranslation D d)) → ((Q 0 = 0) → + (BoundaryFootprintVertices D = F '' BoundaryFootprintVertices D))) ) := by + classical + intro k D Q dzeroD c F quarterVerticesAt zeroQ + simpa [D, Q, GaussianQuarterTurn, dzeroD, dzeroD', zeroQ] using quarterVerticesAt 0 + +private theorem zeroFedges : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Q := GaussianQuarterTurn + (TileTranslation D 0 = D) → (∀ (c : GaussianInt), + let F : GaussianInt → GaussianInt := fun z => Q z + c + (∀ (d : GaussianInt), BoundaryFootprintEdges (TileTranslation D (Q d)) = (fun e : Finset + GaussianInt => e.image F) '' BoundaryFootprintEdges (TileTranslation D d)) → ((Q 0 = + 0) → (BoundaryFootprintEdges D = (fun e : Finset GaussianInt => e.image F) '' + BoundaryFootprintEdges D))) ) := by + classical + intro k D Q dzeroD c F quarterEdgesAt zeroQ + simpa [D, Q, GaussianQuarterTurn, dzeroD, dzeroD', zeroQ] using quarterEdgesAt 0 + +private theorem rightFvertices : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let F : GaussianInt → GaussianInt := fun z => Q z + c + (∀ (d : GaussianInt), BoundaryFootprintVertices (TileTranslation D (Q d)) = F '' + BoundaryFootprintVertices (TileTranslation D d)) → ((Q ⟨(k : Int) + 1, (k : Int)⟩ = + ⟨-(k : Int), (k : Int) + 1⟩) → ( + let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + BoundaryFootprintVertices (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩) = F '' + BoundaryFootprintVertices (TileTranslation D da))) ) := by + classical + intro k D Q c F quarterVerticesAt dShift da + rw [← dShift] + exact quarterVerticesAt da + +private theorem rightFedges : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let F : GaussianInt → GaussianInt := fun z => Q z + c + (∀ (d : GaussianInt), BoundaryFootprintEdges (TileTranslation D (Q d)) = (fun e : Finset + GaussianInt => e.image F) '' BoundaryFootprintEdges (TileTranslation D d)) → ((Q ⟨(k + : Int) + 1, (k : Int)⟩ = ⟨-(k : Int), (k : Int) + 1⟩) → ( + let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + BoundaryFootprintEdges (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩) = (fun e : Finset + GaussianInt => e.image F) '' BoundaryFootprintEdges (TileTranslation D da))) ) := by + classical + intro k D Q c F quarterEdgesAt dShift da + rw [← dShift] + exact quarterEdgesAt da + +private theorem firstVertices : + (by + classical + exact + ∀ (k : Nat), + let dV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1} + (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices (TileTranslation + (DiamondTile k) ⟨(k : Int) + 1, (k : Int)⟩) = dV) → ( + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let F : GaussianInt → GaussianInt := fun z => Q z + c + (Function.Injective F) → ( + let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + (BoundaryFootprintVertices D = F '' BoundaryFootprintVertices D) → + ((BoundaryFootprintVertices (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩) = F '' + BoundaryFootprintVertices (TileTranslation D da)) → (BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩) = F '' + dV)))) ) := by + classical + intro k dV decVertices D Q c F F_inj da zeroFvertices rightFvertices + rw [zeroFvertices, rightFvertices, ← Set.image_inter F_inj, decVertices] + +private theorem thirdVertices : + (by + classical + exact + ∀ (k : Nat), + let iV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + z.re - 1 ≤ z.im ∧ z.im ≤ z.re} + (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices (TileTranslation + (DiamondTile k) ⟨(k : Int) + 1, -(k : Int)⟩) = iV) → ( + let D := DiamondTile k + let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + let G : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - z.re⟩ + (Function.Injective G) → ((∀ (d : GaussianInt), G '' BoundaryFootprintVertices + (TileTranslation D d) = BoundaryFootprintVertices (TileTranslation D (Qinv d))) → ((G + '' BoundaryFootprintVertices D = BoundaryFootprintVertices D) → ( + let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D (Qinv ia)) = G + '' iV)))) ) := by + classical + intro k iV incVertices D Qinv G G_inj inverseVerticesAt inverseVerticesZero ia + rw [← inverseVerticesZero, ← inverseVerticesAt ia, + ← Set.image_inter G_inj, incVertices] + +private theorem fourthVertices : + (by + classical + exact + ∀ (k : Nat), + let iV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + z.re - 1 ≤ z.im ∧ z.im ≤ z.re} + let D := DiamondTile k + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + (BoundaryFootprintVertices (TileTranslation D shift) ∩ BoundaryFootprintVertices D = + GaussianTranslation shift '' iV) → (BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (TileTranslation D shift) = GaussianTranslation shift '' + iV) ) := by + classical + intro k iV D shift shiftVertices + rw [Set.inter_comm, shiftVertices] + +private theorem firstSet : + (by + classical + exact + ∀ (k : Nat), + let dV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1} + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), (c = ⟨(↑k : ℤ), (↑k : ℤ)⟩) → ( + let F : GaussianInt → GaussianInt := fun z => Q z + c + F '' dV = {z : GaussianInt | -(k : Int) ≤ z.re ∧ z.re ≤ 0 ∧ (k : Int) + 1 ≤ z.im ∧ z.im ≤ + 2 * (k : Int) ∧ 2 * (k : Int) ≤ z.im - z.re ∧ z.im - z.re ≤ 2 * (k : Int) + 1}) ) := by + classical + intro k dV Q c hcEq F + ext z + constructor + · rintro ⟨w, hw, rfl⟩ + simp only [Set.mem_ofPred_eq, dV] at hw ⊢ + simp [F, Q, GaussianQuarterTurn, hcEq] + omega + · intro hz + simp only [Set.mem_ofPred_eq] at hz + let w : GaussianInt := ⟨z.im - (k : Int), (k : Int) - z.re⟩ + have hw : w ∈ dV := by + simp [w, dV] + omega + refine ⟨w, hw, ?_⟩ + apply Zsqrtd.ext <;> simp [w, F, Q, GaussianQuarterTurn, hcEq] + +private theorem secondSet : + (by + classical + exact + ∀ (k : Nat), + let dV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1} + dV = {z : GaussianInt | 1 ≤ z.re ∧ z.re ≤ (k : Int) ∧ (k : Int) ≤ z.im ∧ z.im ≤ 2 * (k : + Int) ∧ 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1} ) := by + classical + intro k dV + ext z + simp only [dV, Set.mem_ofPred_eq] + constructor <;> omega + +private theorem thirdSet : + (by + classical + exact + ∀ (k : Nat), + let iV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + z.re - 1 ≤ z.im ∧ z.im ≤ z.re} + let G : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - z.re⟩ + G '' iV = {z : GaussianInt | -(k : Int) ≤ z.re ∧ z.re ≤ 0 ∧ 0 ≤ z.im ∧ z.im ≤ (k : Int) - + 1 ∧ -1 ≤ z.re + z.im ∧ z.re + z.im ≤ 0} ) := by + classical + intro k iV G + ext z + constructor + · rintro ⟨w, hw, rfl⟩ + simp only [Set.mem_ofPred_eq, iV] at hw ⊢ + simp [G] + omega + · intro hz + simp only [Set.mem_ofPred_eq] at hz + let w : GaussianInt := ⟨(k : Int) - z.im, z.re + (k : Int)⟩ + have hw : w ∈ iV := by + simp [w, iV] + omega + refine ⟨w, hw, ?_⟩ + apply Zsqrtd.ext <;> simp [w, G] + +private theorem fourthSet : + (by + classical + exact + ∀ (k : Nat), + let iV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + z.re - 1 ≤ z.im ∧ z.im ≤ z.re} + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + GaussianTranslation shift '' iV = {z : GaussianInt | -(k : Int) ≤ z.re ∧ z.re ≤ -1 ∧ (k : + Int) ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ 2 * (k : Int) ≤ z.im - z.re ∧ z.im - z.re ≤ 2 * + (k : Int) + 1} ) := by + classical + intro k iV shift + ext z + constructor + · rintro ⟨w, hw, rfl⟩ + simp only [Set.mem_ofPred_eq, iV] at hw ⊢ + simp [GaussianTranslation, shift] + omega + · intro hz + simp only [Set.mem_ofPred_eq] at hz + let w : GaussianInt := ⟨z.re + (k : Int) + 1, z.im - (k : Int)⟩ + have hw : w ∈ iV := by + simp [w, iV] + omega + refine ⟨w, hw, ?_⟩ + apply Zsqrtd.ext <;> simp [w, GaussianTranslation, shift] + +private theorem firstEdges : + (by + classical + exact + ∀ (k : Nat), + let N : Nat := 2 * k - 1 + let dP : Nat → GaussianInt := fun j => + ⟨(k : Int) - (j / 2 : Nat), (k : Int) + ((j + 1) / 2 : Nat)⟩ + let dE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {dP j, dP (j + 1)}} + (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation + (DiamondTile k) ⟨(k : Int) + 1, (k : Int)⟩) = dE) → ( + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let F : GaussianInt → GaussianInt := fun z => Q z + c + (Function.Injective F) → ( + let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + (BoundaryFootprintEdges D = (fun e : Finset GaussianInt => e.image F) '' + BoundaryFootprintEdges D) → ((BoundaryFootprintEdges (TileTranslation D ⟨-(k : Int), + (k : Int) + 1⟩) = (fun e : Finset GaussianInt => e.image F) '' BoundaryFootprintEdges + (TileTranslation D da)) → (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges + (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩) = (fun e : Finset GaussianInt => + e.image F) '' dE)))) ) := by + classical + intro k N dP dE decEdges D Q c F F_inj da zeroFedges rightFedges + rw [zeroFedges, rightFedges, ← Set.image_inter (Finset.image_injective F_inj), decEdges] + +private theorem thirdEdges : + (by + classical + exact + ∀ (k : Nat), + let N : Nat := 2 * k - 1 + let iP : Nat → GaussianInt := fun j => + ⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ + let iE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {iP j, iP (j + 1)}} + (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation + (DiamondTile k) ⟨(k : Int) + 1, -(k : Int)⟩) = iE) → ( + let D := DiamondTile k + let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + let G : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - z.re⟩ + (Function.Injective G) → ((∀ (d : GaussianInt), (fun e : Finset GaussianInt => e.image G) + '' BoundaryFootprintEdges (TileTranslation D d) = BoundaryFootprintEdges + (TileTranslation D (Qinv d))) → (((fun e : Finset GaussianInt => e.image G) '' + BoundaryFootprintEdges D = BoundaryFootprintEdges D) → ( + let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + BoundaryFootprintEdges D ∩ BoundaryFootprintEdges (TileTranslation D (Qinv ia)) = (fun e + : Finset GaussianInt => e.image G) '' iE)))) ) := by + classical + intro k N iP iE incEdges D Qinv G G_inj inverseEdgesAt inverseEdgesZero ia + rw [← inverseEdgesZero, ← inverseEdgesAt ia, + ← Set.image_inter (Finset.image_injective G_inj), incEdges] + +private theorem fourthEdges : + (by + classical + exact + ∀ (k : Nat), + let N : Nat := 2 * k - 1 + let iP : Nat → GaussianInt := fun j => + ⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ + let iE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {iP j, iP (j + 1)}} + let D := DiamondTile k + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + (BoundaryFootprintEdges (TileTranslation D shift) ∩ BoundaryFootprintEdges D = (fun e : + Finset GaussianInt => e.image (GaussianTranslation shift)) '' iE) → + (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges (TileTranslation D shift) = (fun e + : Finset GaussianInt => e.image (GaussianTranslation shift)) '' iE) ) := by + classical + intro k N iP iE D shift shiftEdges + rw [Set.inter_comm, shiftEdges] + +private theorem rows0 : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + (Finset.Nonempty D.cells ∧ Finset.Nonempty (TileTranslation D ⟨-(k : Int), (k : Int) + + 1⟩).cells ∧ Disjoint D.cells (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩).cells ∧ + SimpleGridPathBetween (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices + (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩)) (BoundaryFootprintEdges D ∩ + BoundaryFootprintEdges (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩)) ⟨0, 2 * (k : + Int)⟩ ⟨-(k : Int), (k : Int) + 1⟩) → ((Finset.Nonempty D.cells ∧ Finset.Nonempty + (TileTranslation D da).cells ∧ Disjoint D.cells (TileTranslation D da).cells ∧ + SimpleGridPathBetween (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices + (TileTranslation D da)) (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges + (TileTranslation D da)) ⟨1, 2 * (k : Int)⟩ ⟨(k : Int), (k : Int)⟩) → (∀ T, ∀ U, ∀ a, + ∀ e, (T, U, a, e) ∈ [(D, TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩, (⟨0, 2 * (k : + Int)⟩ : GaussianInt), ⟨-(k : Int), (k : Int) + 1⟩), (D, TileTranslation D da, (⟨1, 2 + * (k : Int)⟩ : GaussianInt), ⟨(k : Int), (k : Int)⟩)] → Finset.Nonempty T.cells ∧ + Finset.Nonempty U.cells ∧ Disjoint T.cells U.cells ∧ SimpleGridPathBetween + (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) (BoundaryFootprintEdges T + ∩ BoundaryFootprintEdges U) a e)) ) := by + classical + intro k D da rowFirst0 rowSecond0 T U a e hm + simp only [List.mem_cons, List.not_mem_nil, or_false] at hm + rcases hm with hm | hm + · simp only [Prod.mk.injEq] at hm + rcases hm with ⟨rfl, rfl, rfl, rfl⟩ + exact rowFirst0 + · simp only [Prod.mk.injEq] at hm + rcases hm with ⟨rfl, rfl, rfl, rfl⟩ + exact rowSecond0 + +private theorem rows1 : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + (Finset.Nonempty D.cells ∧ Finset.Nonempty (TileTranslation D (Qinv ia)).cells ∧ Disjoint + D.cells (TileTranslation D (Qinv ia)).cells ∧ SimpleGridPathBetween + (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D (Qinv + ia))) (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges (TileTranslation D (Qinv + ia))) ⟨-(k : Int), (k : Int) - 1⟩ 0) → ((Finset.Nonempty D.cells ∧ Finset.Nonempty + (TileTranslation D shift).cells ∧ Disjoint D.cells (TileTranslation D shift).cells ∧ + SimpleGridPathBetween (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices + (TileTranslation D shift)) (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges + (TileTranslation D shift)) ⟨-(k : Int), (k : Int)⟩ ⟨-1, 2 * (k : Int)⟩) → (∀ T, ∀ U, + ∀ a, ∀ e, (T, U, a, e) ∈ [(D, TileTranslation D (Qinv ia), (⟨-(k : Int), (k : Int) - + 1⟩ : GaussianInt), 0), (D, TileTranslation D shift, (⟨-(k : Int), (k : Int)⟩ : + GaussianInt), ⟨-1, 2 * (k : Int)⟩)] → Finset.Nonempty T.cells ∧ Finset.Nonempty + U.cells ∧ Disjoint T.cells U.cells ∧ SimpleGridPathBetween (BoundaryFootprintVertices + T ∩ BoundaryFootprintVertices U) (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges + U) a e)) ) := by + classical + intro k D Qinv ia shift rowFirst1 rowSecond1 T U a e hm + simp only [List.mem_cons, List.not_mem_nil, or_false] at hm + rcases hm with hm | hm + · simp only [Prod.mk.injEq] at hm + rcases hm with ⟨rfl, rfl, rfl, rfl⟩ + exact rowFirst1 + · simp only [Prod.mk.injEq] at hm + rcases hm with ⟨rfl, rfl, rfl, rfl⟩ + exact rowSecond1 + +private theorem h0 : + (by + classical + exact + ∀ (k : Nat), + let dV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1} + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let F : GaussianInt → GaussianInt := fun z => Q z + c + let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D ⟨-(k : Int), + (k : Int) + 1⟩) = F '' dV) → ((BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (TileTranslation D da) = dV) → ((F '' dV = {z : GaussianInt + | -(k : Int) ≤ z.re ∧ z.re ≤ 0 ∧ (k : Int) + 1 ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ 2 * (k + : Int) ≤ z.im - z.re ∧ z.im - z.re ≤ 2 * (k : Int) + 1}) → ((dV = {z : GaussianInt | + 1 ≤ z.re ∧ z.re ≤ (k : Int) ∧ (k : Int) ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ 2 * (k : Int) + ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1}) → ((∀ T, ∀ U, ∀ a, ∀ e, (T, U, a, + e) ∈ [(D, TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩, (⟨0, 2 * (k : Int)⟩ : + GaussianInt), ⟨-(k : Int), (k : Int) + 1⟩), (D, TileTranslation D da, (⟨1, 2 * (k : + Int)⟩ : GaussianInt), ⟨(k : Int), (k : Int)⟩)] → Finset.Nonempty T.cells ∧ + Finset.Nonempty U.cells ∧ Disjoint T.cells U.cells ∧ SimpleGridPathBetween + (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) (BoundaryFootprintEdges T + ∩ BoundaryFootprintEdges U) a e) → ((∀ T, ∀ U, ∀ a, ∀ e, (T, U, a, e) ∈ [(D, + TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩, (⟨0, 2 * (k : Int)⟩ : GaussianInt), + ⟨-(k : Int), (k : Int) + 1⟩), (D, TileTranslation D da, (⟨1, 2 * (k : Int)⟩ : + GaussianInt), ⟨(k : Int), (k : Int)⟩)] → Finset.Nonempty T.cells ∧ Finset.Nonempty + U.cells ∧ Disjoint T.cells U.cells ∧ SimpleGridPathBetween (BoundaryFootprintVertices + T ∩ BoundaryFootprintVertices U) (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges + U) a e) ∧ (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D + ⟨-(k : Int), (k : Int) + 1⟩) = {z | -(k : Int) ≤ z.re ∧ z.re ≤ 0 ∧ (k : Int) + 1 ≤ + z.im ∧ z.im ≤ 2 * (k : Int) ∧ 2 * (k : Int) ≤ z.im - z.re ∧ z.im - z.re ≤ 2 * (k : + Int) + 1}) ∧ (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices + (TileTranslation D da) = {z | 1 ≤ z.re ∧ z.re ≤ (k : Int) ∧ (k : Int) ≤ z.im ∧ z.im ≤ + 2 * (k : Int) ∧ 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1})))))) + ) := by + classical + intro k dV D Q c F da firstVertices secondVertices firstSet secondSet rows0 + exact ⟨rows0, by rw [firstVertices, firstSet], by rw [secondVertices, secondSet]⟩ + +private theorem h1 : + (by + classical + exact + ∀ (k : Nat), + let iV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + z.re - 1 ≤ z.im ∧ z.im ≤ z.re} + let D := DiamondTile k + let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + let G : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - z.re⟩ + let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D (Qinv ia)) = + G '' iV) → ((BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation + D shift) = GaussianTranslation shift '' iV) → ((G '' iV = {z : GaussianInt | -(k : + Int) ≤ z.re ∧ z.re ≤ 0 ∧ 0 ≤ z.im ∧ z.im ≤ (k : Int) - 1 ∧ -1 ≤ z.re + z.im ∧ z.re + + z.im ≤ 0}) → ((GaussianTranslation shift '' iV = {z : GaussianInt | -(k : Int) ≤ z.re + ∧ z.re ≤ -1 ∧ (k : Int) ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ 2 * (k : Int) ≤ z.im - z.re ∧ + z.im - z.re ≤ 2 * (k : Int) + 1}) → ((∀ T, ∀ U, ∀ a, ∀ e, (T, U, a, e) ∈ [(D, + TileTranslation D (Qinv ia), (⟨-(k : Int), (k : Int) - 1⟩ : GaussianInt), 0), (D, + TileTranslation D shift, (⟨-(k : Int), (k : Int)⟩ : GaussianInt), ⟨-1, 2 * (k : + Int)⟩)] → Finset.Nonempty T.cells ∧ Finset.Nonempty U.cells ∧ Disjoint T.cells + U.cells ∧ SimpleGridPathBetween (BoundaryFootprintVertices T ∩ + BoundaryFootprintVertices U) (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) a + e) → ((∀ T, ∀ U, ∀ a, ∀ e, (T, U, a, e) ∈ [(D, TileTranslation D (Qinv ia), (⟨-(k : + Int), (k : Int) - 1⟩ : GaussianInt), 0), (D, TileTranslation D shift, (⟨-(k : Int), + (k : Int)⟩ : GaussianInt), ⟨-1, 2 * (k : Int)⟩)] → Finset.Nonempty T.cells ∧ + Finset.Nonempty U.cells ∧ Disjoint T.cells U.cells ∧ SimpleGridPathBetween + (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) (BoundaryFootprintEdges T + ∩ BoundaryFootprintEdges U) a e) ∧ (BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (TileTranslation D (Qinv ia)) = {z | -(k : Int) ≤ z.re ∧ + z.re ≤ 0 ∧ 0 ≤ z.im ∧ z.im ≤ (k : Int) - 1 ∧ -1 ≤ z.re + z.im ∧ z.re + z.im ≤ 0}) ∧ + (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D shift) = + {z | -(k : Int) ≤ z.re ∧ z.re ≤ -1 ∧ (k : Int) ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ 2 * (k + : Int) ≤ z.im - z.re ∧ z.im - z.re ≤ 2 * (k : Int) + 1})))))) ) := by + classical + intro k iV D Qinv G ia shift thirdVertices fourthVertices thirdSet fourthSet rows1 + exact ⟨rows1, by rw [thirdVertices, thirdSet], by rw [fourthVertices, fourthSet]⟩ + +end DiamondPathComparison + +namespace DiamondRowConclusions + +private theorem imagePath : + (by + classical + exact + ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ + {y : GaussianInt}, ∀ (f : GaussianInt → GaussianInt), Function.Injective f → (∀ (a : + GaussianInt), ∀ (b : GaussianInt), b = a + (1 : GaussianInt) ∨ b = a - (1 : + GaussianInt) ∨ b = a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ b = a - ⟨(0 : ℤ), (1 : ℤ)⟩ → f b = f a + + (1 : GaussianInt) ∨ f b = f a - (1 : GaussianInt) ∨ f b = f a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ + f b = f a - ⟨(0 : ℤ), (1 : ℤ)⟩) → SimpleGridPathBetween V E x y → + SimpleGridPathBetween (f '' V) ((fun (e : Finset GaussianInt) => Finset.image f e) '' + E) (f x) (f y) ) := by + classical + intro V E x y f hf hstep hp + exact P4055T1GridPathImage f hf hstep V E x y hp + +private theorem rowFirst0 : + (by + classical + exact + ∀ (k : Nat), (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ + {x : GaussianInt}, ∀ {y : GaussianInt}, ∀ (f : GaussianInt → GaussianInt), + (Function.Injective f) → ((∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, + 1⟩ ∨ b = a - ⟨0, 1⟩) → f b = f a + 1 ∨ f b = f a - 1 ∨ f b = f a + ⟨0, 1⟩ ∨ f b = f a + - ⟨0, 1⟩) → ((SimpleGridPathBetween V E x y) → (SimpleGridPathBetween (f '' V) ((fun + e : Finset GaussianInt => e.image f) '' E) (f x) (f y))))) → ((Function.Injective + GaussianQuarterTurn) → ((SimpleGridPathBetween (BoundaryFootprintVertices + (DiamondTile k) ∩ BoundaryFootprintVertices (TileTranslation (DiamondTile k) ⟨(↑k : + ℤ) + (1 : ℤ), (↑k : ℤ)⟩)) (BoundaryFootprintEdges (DiamondTile k) ∩ + BoundaryFootprintEdges (TileTranslation (DiamondTile k) ⟨(↑k : ℤ) + (1 : ℤ), (↑k : + ℤ)⟩)) ⟨(↑k : ℤ), (↑k : ℤ)⟩ ⟨(1 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩) → ( + let D := DiamondTile k + let Q := GaussianQuarterTurn + (TileTranslation D 0 = D) → (∀ (c : GaussianInt), (c = ⟨(↑k : ℤ), (↑k : ℤ)⟩) → ( + let Fc : GaussianInt → GaussianInt := fun z => Q z - 1 + c + ( + let F := fun (z : GaussianInt) => GaussianQuarterTurn z + c; Function.Injective F) → (( + let D := DiamondTile k; Finset.Nonempty D.cells) → ((∀ (d : GaussianInt), + BoundaryFootprintVertices (TileTranslation (DiamondTile k) (GaussianQuarterTurn d)) = + (fun (z : GaussianInt) => GaussianQuarterTurn z + c) '' BoundaryFootprintVertices + (TileTranslation (DiamondTile k) d)) → ((∀ (d : GaussianInt), BoundaryFootprintEdges + (TileTranslation (DiamondTile k) (GaussianQuarterTurn d)) = (fun (e : Finset + GaussianInt) => Finset.image (fun (z : GaussianInt) => GaussianQuarterTurn z + c) e) + '' BoundaryFootprintEdges (TileTranslation (DiamondTile k) d)) → (( + let Q := GaussianQuarterTurn; Q ⟨(↑k : ℤ) + (1 : ℤ), (↑k : ℤ)⟩ = ⟨-(↑k : ℤ), (↑k : ℤ) + + (1 : ℤ)⟩) → ((D.cells = D.cells.image Fc) → ( + let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + ( + let da := ⟨(↑k : ℤ) + (1 : ℤ), (↑k : ℤ)⟩; (TileTranslation (DiamondTile k) ⟨-(↑k : ℤ), + (↑k : ℤ) + (1 : ℤ)⟩).cells = Finset.image (fun (z : GaussianInt) => + GaussianQuarterTurn z - (1 : GaussianInt) + c) (TileTranslation (DiamondTile k) + da).cells) → (( + let da := ⟨(↑k : ℤ) + (1 : ℤ), (↑k : ℤ)⟩; Disjoint (DiamondTile k).cells (TileTranslation + (DiamondTile k) da).cells) → (((TileTranslation D da).cells.Nonempty) → ((∀ + {α : Type}, ∀ [inst : DecidableEq α], ∀ {s : Finset α}, ∀ {t : Finset α}, ∀ (f : α → + α), Function.Injective f → Disjoint s t → Disjoint (Finset.image f s) (Finset.image f + t)) → (Finset.Nonempty D.cells ∧ Finset.Nonempty (TileTranslation D ⟨-(k : Int), (k : + Int) + 1⟩).cells ∧ Disjoint D.cells (TileTranslation D ⟨-(k : Int), (k : Int) + + 1⟩).cells ∧ SimpleGridPathBetween (BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩)) + (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges (TileTranslation D ⟨-(k : Int), (k + : Int) + 1⟩)) ⟨0, 2 * (k : Int)⟩ ⟨-(k : Int), (k : Int) + 1⟩))))))))))))))) ) := by + classical + intro k imagePath qinj decBetween D Q dzeroD c hcEq Fc F_inj hDne quarterVerticesAt + quarterEdgesAt dShift cellMapZero da cellMapRight ddisjD dneDright disjointImage + let F : GaussianInt → GaussianInt := fun z => Q z + c + exact ⟨hDne, (DiamondPathComparison.firstCells₁ k c cellMapRight dneDright), + (DiamondPathComparison.firstCellsDisj k c (DiamondPathComparison.F_cell_inj qinj c) + cellMapZero cellMapRight ddisjD disjointImage), (DiamondPathComparison.firstTurn k + imagePath decBetween dzeroD c hcEq F_inj (DiamondPathComparison.F_step k c) + quarterVerticesAt quarterEdgesAt dShift)⟩ + +private theorem rowFirst1 : + (by + classical + exact + ∀ (k : Nat), (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ + {x : GaussianInt}, ∀ {y : GaussianInt}, ∀ (f : GaussianInt → GaussianInt), + (Function.Injective f) → ((∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, + 1⟩ ∨ b = a - ⟨0, 1⟩) → f b = f a + 1 ∨ f b = f a - 1 ∨ f b = f a + ⟨0, 1⟩ ∨ f b = f a + - ⟨0, 1⟩) → ((SimpleGridPathBetween V E x y) → (SimpleGridPathBetween (f '' V) ((fun + e : Finset GaussianInt => e.image f) '' E) (f x) (f y))))) → ((SimpleGridPathBetween + (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices + (TileTranslation (DiamondTile k) ⟨(↑k : ℤ) + (1 : ℤ), -(↑k : ℤ)⟩)) + (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation + (DiamondTile k) ⟨(↑k : ℤ) + (1 : ℤ), -(↑k : ℤ)⟩)) ⟨(1 : ℤ), (0 : ℤ)⟩ ⟨(↑k : ℤ), (↑k : + ℤ)⟩) → ( + let D := DiamondTile k + let Q := GaussianQuarterTurn + ∀ (c : GaussianInt), + let Fc : GaussianInt → GaussianInt := fun z => Q z - 1 + c + ( + let D := DiamondTile k; Finset.Nonempty D.cells) → ( + let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + let Gc : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - 1 - z.re⟩ + (∀ (z : GaussianInt), Fc (Gc z) = z) → ((Function.Injective fun (z : GaussianInt) => + (⟨z.im - (↑k : ℤ), (↑k : ℤ) - z.re⟩ : GaussianInt)) → ((∀ (d : GaussianInt), (fun (z + : GaussianInt) => (⟨z.im - (↑k : ℤ), (↑k : ℤ) - z.re⟩ : GaussianInt)) '' + BoundaryFootprintVertices (TileTranslation + (DiamondTile k) d) = BoundaryFootprintVertices (TileTranslation (DiamondTile k) ((fun + (z : GaussianInt) => (⟨z.im, -z.re⟩ : GaussianInt)) d))) → ((∀ (d : GaussianInt), + (fun (e : Finset + GaussianInt) => Finset.image (fun (z : GaussianInt) => (⟨z.im - (↑k : ℤ), (↑k : ℤ) - + z.re⟩ : GaussianInt)) e) '' BoundaryFootprintEdges (TileTranslation (DiamondTile k) d) = + BoundaryFootprintEdges (TileTranslation (DiamondTile k) ((fun (z : GaussianInt) => + (⟨z.im, -z.re⟩ : GaussianInt)) d))) → (((fun (z : GaussianInt) => (⟨z.im - (↑k : + ℤ), (↑k : ℤ) - z.re⟩ : GaussianInt)) + '' BoundaryFootprintVertices (DiamondTile k) = BoundaryFootprintVertices (DiamondTile + k)) → (((fun (e : Finset GaussianInt) => Finset.image (fun (z : GaussianInt) => (⟨z.im + - (↑k : ℤ), (↑k : ℤ) - z.re⟩ : GaussianInt)) e) '' BoundaryFootprintEdges + (DiamondTile k) = + BoundaryFootprintEdges (DiamondTile k)) → ((∀ {α : Type}, ∀ [inst : DecidableEq α], ∀ + {s : Finset α}, ∀ {t : Finset α}, ∀ (f : α → α), Function.Injective f → Disjoint s t + → Disjoint (Finset.image f s) (Finset.image f t)) → ((D.cells = D.cells.image Gc) → ( + let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + ((TileTranslation D (Qinv ia)).cells = (TileTranslation D ia).cells.image Gc) → (( + let ia := ⟨(↑k : ℤ) + (1 : ℤ), -(↑k : ℤ)⟩; Disjoint (DiamondTile k).cells + (TileTranslation (DiamondTile k) ia).cells) → (((TileTranslation D + ia).cells.Nonempty) → (Finset.Nonempty D.cells ∧ Finset.Nonempty (TileTranslation D + (Qinv ia)).cells ∧ Disjoint D.cells (TileTranslation D (Qinv ia)).cells ∧ + SimpleGridPathBetween (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices + (TileTranslation D (Qinv ia))) (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges + (TileTranslation D (Qinv ia))) ⟨-(k : Int), (k : Int) - 1⟩ 0)))))))))))))) ) := by + classical + intro k imagePath incBetween D Q c Fc hDne Qinv Gc FcGc G_inj inverseVerticesAt inverseEdgesAt + inverseVerticesZero inverseEdgesZero disjointImage inverseCellZero ia inverseCellRight + idisjD ineDright + exact ⟨hDne, (DiamondPathComparison.thirdCells₁ k inverseCellRight ineDright), + (DiamondPathComparison.thirdCellsDisj k (DiamondPathComparison.Gc_inj k c FcGc) + disjointImage inverseCellZero inverseCellRight idisjD), (DiamondPathComparison.thirdTurn + k imagePath incBetween G_inj (DiamondPathComparison.G_step k) inverseVerticesAt + inverseEdgesAt inverseVerticesZero inverseEdgesZero)⟩ + +private theorem rowSecond1 : + (by + classical + exact + ∀ (k : Nat), (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ + {x : GaussianInt}, ∀ {y : GaussianInt}, ∀ (f : GaussianInt → GaussianInt), + (Function.Injective f) → ((∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, + 1⟩ ∨ b = a - ⟨0, 1⟩) → f b = f a + 1 ∨ f b = f a - 1 ∨ f b = f a + ⟨0, 1⟩ ∨ f b = f a + - ⟨0, 1⟩) → ((SimpleGridPathBetween V E x y) → (SimpleGridPathBetween (f '' V) ((fun + e : Finset GaussianInt => e.image f) '' E) (f x) (f y))))) → ((SimpleGridPathBetween + (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices + (TileTranslation (DiamondTile k) ⟨(↑k : ℤ) + (1 : ℤ), -(↑k : ℤ)⟩)) + (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation + (DiamondTile k) ⟨(↑k : ℤ) + (1 : ℤ), -(↑k : ℤ)⟩)) ⟨(1 : ℤ), (0 : ℤ)⟩ ⟨(↑k : ℤ), (↑k : + ℤ)⟩) → ( + let D := DiamondTile k + (TileTranslation D 0 = D) → ((∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (v : + GaussianInt), (TileTranslation T (u + v)).cells = (TileTranslation (TileTranslation T + u) v).cells) → ((∀ {A : ProtoTile}, ∀ {B : ProtoTile}, A.cells = B.cells → + BoundaryFootprintEdges A = BoundaryFootprintEdges B) → ((∀ {A : ProtoTile}, ∀ + {B : ProtoTile}, A.cells = B.cells → Finset.Nonempty B.cells → + BoundaryFootprintVertices A = BoundaryFootprintVertices B) → (( + let D := DiamondTile k; Finset.Nonempty D.cells) → ( + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + (∀ (u : GaussianInt), Function.Injective (GaussianTranslation u)) → (((TileTranslation D + shift).cells.Nonempty) → ((Disjoint D.cells (TileTranslation D shift).cells) → + (Finset.Nonempty D.cells ∧ Finset.Nonempty (TileTranslation D shift).cells ∧ Disjoint + D.cells (TileTranslation D shift).cells ∧ SimpleGridPathBetween + (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D shift)) + (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges (TileTranslation D shift)) ⟨-(k : + Int), (k : Int)⟩ ⟨-1, 2 * (k : Int)⟩)))))))))) ) := by + classical + intro k imagePath incBetween D dzeroD translateCells edgeCellsEq vertexCellsEq hDne shift + translateInj fourthCells₂ fourthCellsDisj + exact ⟨hDne, fourthCells₂, fourthCellsDisj, (DiamondPathComparison.fourthPath k + (DiamondPathComparison.shiftPath k imagePath incBetween dzeroD translateCells edgeCellsEq + vertexCellsEq hDne (DiamondPathComparison.translateStep) translateInj))⟩ + +private theorem h0 : + (by + classical + exact + ∀ (k : Nat), + let dV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1} + (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices (TileTranslation + (DiamondTile k) ⟨(↑k : ℤ) + (1 : ℤ), (↑k : ℤ)⟩) = {z : GaussianInt | (1 : ℤ) ≤ z.re ∧ + z.re ≤ (↑k : ℤ) ∧ (2 : ℤ) * (↑k : ℤ) ≤ z.re + z.im ∧ z.re + z.im ≤ (2 : ℤ) * (↑k : ℤ) + + (1 : ℤ)}) → ( + let D := DiamondTile k + let Q := GaussianQuarterTurn + (TileTranslation D 0 = D) → (∀ (c : GaussianInt), (c = ⟨(↑k : ℤ), (↑k : ℤ)⟩) → ( + ( + let F := fun (z : GaussianInt) => GaussianQuarterTurn z + c; Function.Injective F) → ((∀ + (d : GaussianInt), BoundaryFootprintVertices (TileTranslation (DiamondTile k) + (GaussianQuarterTurn d)) = (fun (z : GaussianInt) => GaussianQuarterTurn z + c) '' + BoundaryFootprintVertices (TileTranslation (DiamondTile k) d)) → (( + let Q := GaussianQuarterTurn; Q ⟨(↑k : ℤ) + (1 : ℤ), (↑k : ℤ)⟩ = ⟨-(↑k : ℤ), (↑k : ℤ) + + (1 : ℤ)⟩) → ((Q 0 = 0) → ( + let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D da) = dV) → + ((Finset.Nonempty D.cells ∧ Finset.Nonempty (TileTranslation D ⟨-(k : Int), (k : Int) + + 1⟩).cells ∧ Disjoint D.cells (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩).cells + ∧ SimpleGridPathBetween (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices + (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩)) (BoundaryFootprintEdges D ∩ + BoundaryFootprintEdges (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩)) ⟨0, 2 * (k : + Int)⟩ ⟨-(k : Int), (k : Int) + 1⟩) → ((Finset.Nonempty D.cells ∧ Finset.Nonempty + (TileTranslation D da).cells ∧ Disjoint D.cells (TileTranslation D da).cells ∧ + SimpleGridPathBetween (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices + (TileTranslation D da)) (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges + (TileTranslation D da)) ⟨1, 2 * (k : Int)⟩ ⟨(k : Int), (k : Int)⟩) → ((∀ T, ∀ U, ∀ a, + ∀ e, (T, U, a, e) ∈ [(D, TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩, (⟨0, 2 * (k : + Int)⟩ : GaussianInt), ⟨-(k : Int), (k : Int) + 1⟩), (D, TileTranslation D da, (⟨1, 2 + * (k : Int)⟩ : GaussianInt), ⟨(k : Int), (k : Int)⟩)] → Finset.Nonempty T.cells ∧ + Finset.Nonempty U.cells ∧ Disjoint T.cells U.cells ∧ SimpleGridPathBetween + (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) (BoundaryFootprintEdges T + ∩ BoundaryFootprintEdges U) a e) ∧ (BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩) = {z | -(k + : Int) ≤ z.re ∧ z.re ≤ 0 ∧ (k : Int) + 1 ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ 2 * (k : + Int) ≤ z.im - z.re ∧ z.im - z.re ≤ 2 * (k : Int) + 1}) ∧ (BoundaryFootprintVertices D + ∩ BoundaryFootprintVertices (TileTranslation D da) = {z | 1 ≤ z.re ∧ z.re ≤ (k : Int) + ∧ (k : Int) ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im + ≤ 2 * (k : Int) + 1}))))))))))) ) := by + classical + intro k dV decVertices D Q dzeroD c hcEq F_inj quarterVerticesAt dShift zeroQ da secondVertices + rowFirst0 rowSecond0 + let F : GaussianInt → GaussianInt := fun z => Q z + c + exact DiamondPathComparison.h0 k c + (DiamondPathComparison.firstVertices k decVertices c F_inj + (DiamondPathComparison.zeroFvertices k dzeroD c quarterVerticesAt zeroQ) + (DiamondPathComparison.rightFvertices k c quarterVerticesAt dShift)) + secondVertices (DiamondPathComparison.firstSet k c hcEq) + (DiamondPathComparison.secondSet k) (DiamondPathComparison.rows0 k + rowFirst0 rowSecond0) + +private theorem h1 : + (by + classical + exact + ∀ (k : Nat), (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices + (TileTranslation (DiamondTile k) ⟨(↑k : ℤ) + (1 : ℤ), -(↑k : ℤ)⟩) = {z : GaussianInt + | (1 : ℤ) ≤ z.re ∧ z.re ≤ (↑k : ℤ) ∧ z.re - (1 : ℤ) ≤ z.im ∧ z.im ≤ z.re}) → ( + let D := DiamondTile k + let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + (Function.Injective fun (z : GaussianInt) => (⟨z.im - (↑k : ℤ), (↑k : ℤ) - z.re⟩ : + GaussianInt)) → ((∀ (d + : GaussianInt), (fun (z : GaussianInt) => (⟨z.im - (↑k : ℤ), (↑k : ℤ) - z.re⟩ : + GaussianInt)) '' + BoundaryFootprintVertices (TileTranslation (DiamondTile k) d) = + BoundaryFootprintVertices (TileTranslation (DiamondTile k) ((fun (z : GaussianInt) => + (⟨z.im, -z.re⟩ : GaussianInt)) d))) → (((fun (z : GaussianInt) => (⟨z.im - (↑k : + ℤ), (↑k : ℤ) - z.re⟩ : GaussianInt)) + '' BoundaryFootprintVertices (DiamondTile k) = BoundaryFootprintVertices (DiamondTile + k)) → ( + let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + (∀ (u : GaussianInt), Function.Injective (GaussianTranslation u)) → + ((BoundaryFootprintVertices (TileTranslation (TileTranslation D ia) shift) = + BoundaryFootprintVertices D) → ((Finset.Nonempty D.cells ∧ Finset.Nonempty + (TileTranslation D (Qinv ia)).cells ∧ Disjoint D.cells (TileTranslation D (Qinv + ia)).cells ∧ SimpleGridPathBetween (BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (TileTranslation D (Qinv ia))) (BoundaryFootprintEdges D ∩ + BoundaryFootprintEdges (TileTranslation D (Qinv ia))) ⟨-(k : Int), (k : Int) - 1⟩ 0) + → ((Finset.Nonempty D.cells ∧ Finset.Nonempty (TileTranslation D shift).cells ∧ + Disjoint D.cells (TileTranslation D shift).cells ∧ SimpleGridPathBetween + (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D shift)) + (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges (TileTranslation D shift)) ⟨-(k : + Int), (k : Int)⟩ ⟨-1, 2 * (k : Int)⟩) → ((∀ T, ∀ U, ∀ a, ∀ e, (T, U, a, e) ∈ [(D, + TileTranslation D (Qinv ia), (⟨-(k : Int), (k : Int) - 1⟩ : GaussianInt), 0), (D, + TileTranslation D shift, (⟨-(k : Int), (k : Int)⟩ : GaussianInt), ⟨-1, 2 * (k : + Int)⟩)] → Finset.Nonempty T.cells ∧ Finset.Nonempty U.cells ∧ Disjoint T.cells + U.cells ∧ SimpleGridPathBetween (BoundaryFootprintVertices T ∩ + BoundaryFootprintVertices U) (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) a + e) ∧ (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D + (Qinv ia)) = {z | -(k : Int) ≤ z.re ∧ z.re ≤ 0 ∧ 0 ≤ z.im ∧ z.im ≤ (k : Int) - 1 ∧ -1 + ≤ z.re + z.im ∧ z.re + z.im ≤ 0}) ∧ (BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (TileTranslation D shift) = {z | -(k : Int) ≤ z.re ∧ z.re ≤ + -1 ∧ (k : Int) ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ 2 * (k : Int) ≤ z.im - z.re ∧ z.im - + z.re ≤ 2 * (k : Int) + 1}))))))))) ) := by + classical + intro k incVertices D Qinv G_inj inverseVerticesAt inverseVerticesZero ia shift translateInj + hnestedV rowFirst1 rowSecond1 + exact DiamondPathComparison.h1 k + (DiamondPathComparison.thirdVertices k incVertices G_inj inverseVerticesAt + inverseVerticesZero) + (DiamondPathComparison.fourthVertices k (DiamondPathComparison.shiftVertices k + incVertices translateInj hnestedV)) (DiamondPathComparison.thirdSet k) + (DiamondPathComparison.fourthSet k) (DiamondPathComparison.rows1 k + rowFirst1 rowSecond1) + +end DiamondRowConclusions + +namespace DiamondRowPaths + +private theorem secondPath : + (by + classical + exact + ∀ (k : Nat), (SimpleGridPathBetween (BoundaryFootprintVertices (DiamondTile k) ∩ + BoundaryFootprintVertices (TileTranslation (DiamondTile k) (⟨(↑k : ℤ) + (1 : ℤ), (↑k + : ℤ)⟩ : GaussianInt))) (BoundaryFootprintEdges (DiamondTile k) ∩ + BoundaryFootprintEdges (TileTranslation (DiamondTile k) (⟨(↑k : ℤ) + (1 : ℤ), (↑k : + ℤ)⟩ : GaussianInt))) (⟨(↑k : ℤ), (↑k : ℤ)⟩ : GaussianInt) (⟨(1 : ℤ), (2 : ℤ) * (↑k : + ℤ)⟩ : GaussianInt)) → ( + let D := DiamondTile k + let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + SimpleGridPathBetween (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices + (TileTranslation D da)) (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges + (TileTranslation D da)) ⟨1, 2 * (k : Int)⟩ ⟨(k : Int), (k : Int)⟩) ) := by + classical + intro k decBetween D da + exact (DiamondPathComparison.reversePath) decBetween + +private theorem rowSecond0 : + (by + classical + exact + ∀ (k : Nat), + let D := DiamondTile k + ( + let D := DiamondTile k; Finset.Nonempty D.cells) → ( + let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + (SimpleGridPathBetween (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices + (TileTranslation D da)) (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges + (TileTranslation D da)) ⟨1, 2 * (k : Int)⟩ ⟨(k : Int), (k : Int)⟩) → ((Disjoint + D.cells (TileTranslation D da).cells) → (((TileTranslation D da).cells.Nonempty) → + (Finset.Nonempty D.cells ∧ Finset.Nonempty (TileTranslation D da).cells ∧ Disjoint + D.cells (TileTranslation D da).cells ∧ SimpleGridPathBetween + (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D da)) + (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges (TileTranslation D da)) ⟨1, 2 * (k + : Int)⟩ ⟨(k : Int), (k : Int)⟩)))) ) := by + classical + intro k D hDne da secondPath secondCellsDisj secondCells₂ + exact ⟨hDne, secondCells₂, secondCellsDisj, secondPath⟩ + +end DiamondRowPaths + +theorem P5290T1EqualDiamondPaths (k : Nat) (hk : 0 < k) + (i : Fin 3) (hi : i ≠ 2) : + let M := P5260T1PlacementLedger k i false + let D := DiamondTile k + let x := M.2.2.1 + let y := M.2.2.2 + let eR : GaussianInt := if i = 0 then ⟨-(k : Int), (k : Int) + 1⟩ else 0 + let eI : GaussianInt := if i = 0 then ⟨(k : Int), (k : Int)⟩ else ⟨-1, 2 * (k : Int)⟩ + let rows : List (ProtoTile × ProtoTile × GaussianInt × GaussianInt) := + [(D, TileTranslation D M.2.1.1, x, eR), + (D, TileTranslation D M.2.1.2, y, eI)] + (∀ T U a c, (T, U, a, c) ∈ rows → + T.cells.Nonempty ∧ U.cells.Nonempty ∧ Disjoint T.cells U.cells ∧ + SimpleGridPathBetween + (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) + (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) a c) ∧ + BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (TileTranslation D M.2.1.1) = + {z | if i = 0 then + -(k : Int) ≤ z.re ∧ z.re ≤ 0 ∧ (k : Int) + 1 ≤ z.im ∧ + z.im ≤ 2 * (k : Int) ∧ 2 * (k : Int) ≤ z.im - z.re ∧ + z.im - z.re ≤ 2 * (k : Int) + 1 + else + -(k : Int) ≤ z.re ∧ z.re ≤ 0 ∧ 0 ≤ z.im ∧ + z.im ≤ (k : Int) - 1 ∧ -1 ≤ z.re + z.im ∧ z.re + z.im ≤ 0} ∧ + BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (TileTranslation D M.2.1.2) = + {z | if i = 0 then + 1 ≤ z.re ∧ z.re ≤ (k : Int) ∧ (k : Int) ≤ z.im ∧ + z.im ≤ 2 * (k : Int) ∧ 2 * (k : Int) ≤ z.re + z.im ∧ + z.re + z.im ≤ 2 * (k : Int) + 1 + else + -(k : Int) ≤ z.re ∧ z.re ≤ -1 ∧ (k : Int) ≤ z.im ∧ + z.im ≤ 2 * (k : Int) ∧ 2 * (k : Int) ≤ z.im - z.re ∧ + z.im - z.re ≤ 2 * (k : Int) + 1} := by +-- BODY + classical + have staircaseBetween (z : GaussianInt) (h : Bool) (s : Int) + (hs : s = 1 ∨ s = -1) (N : Nat) (hN : 0 < N) := DiamondPathComparison.staircaseBetween k z + h s hs N hN + have imagePath {V : Set GaussianInt} {E : Set (Finset GaussianInt)} + {x y : GaussianInt} (f : GaussianInt → GaussianInt) + (hf : Function.Injective f) + (hstep : ∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + f b = f a + 1 ∨ f b = f a - 1 ∨ + f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩) + (hp : SimpleGridPathBetween V E x y) := DiamondRowConclusions.imagePath (V := V) (E := E) + (x := x) (y := y) f hf hstep hp + let q : Nat → GaussianInt := + P5157T1StaircasePoint ⟨(k : Int), -(k : Int)⟩ true 1 + let N : Nat := 2 * k - 1 + have hN : 0 < N := by dsimp [N]; omega + have qbase := staircaseBetween ⟨(k : Int), -(k : Int)⟩ true 1 + (Or.inl rfl) N hN + have qinj := DiamondPathComparison.qinj k + have qImagePath := imagePath GaussianQuarterTurn qinj (DiamondPathComparison.qstep k) qbase + have qenum (j : Nat) := DiamondPathComparison.qenum k j + let dV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1} + let dP : Nat → GaussianInt := fun j => + ⟨(k : Int) - (j / 2 : Nat), (k : Int) + ((j + 1) / 2 : Nat)⟩ + let dE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {dP j, dP (j + 1)}} + have dq (j : Nat) : GaussianQuarterTurn (q j) = dP j := by + exact qenum j + have dec := P5203T1DecreasingInterface k hk 0 + dsimp only at dec + rcases dec with ⟨dne, dne', ddisj, dvertices, dedges, _⟩ + have dzero : TileTranslation (DiamondTile k) 0 = DiamondTile k := DiamondPathComparison.dzero k + rw [dzero] at dvertices dedges + have decVertices := DiamondPathComparison.decVertices k dvertices + have decEdges := DiamondPathComparison.decEdges k dedges + have decBetween := DiamondPathComparison.decBetween k (DiamondPathComparison.decPath k + qImagePath (DiamondPathComparison.qendpoint₀ k qenum) (DiamondPathComparison.qendpoint₁ k + hk qenum) (DiamondPathComparison.dVimage k dq (DiamondPathComparison.dVenum k hk hN)) + (DiamondPathComparison.dEimage k dq)) decVertices decEdges + let iV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ + z.re - 1 ≤ z.im ∧ z.im ≤ z.re} + let iP : Nat → GaussianInt := fun j => + ⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ + let iE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {iP j, iP (j + 1)}} + let iq : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 + have iqenum (j : Nat) : iq j = iP j := by + apply Zsqrtd.ext <;> simp [iq, iP, P5157T1StaircasePoint] + have iEeq := DiamondPathComparison.iEeq k iqenum + have inc := P5203T1IncreasingInterface k hk 0 + dsimp only at inc + rcases inc with ⟨ine, ine', idisj, ivertex0, iedge0, _⟩ + have izero : TileTranslation (DiamondTile k) 0 = DiamondTile k := dzero + rw [izero] at ivertex0 iedge0 + have incVertices := DiamondPathComparison.incVertices k ivertex0 + have incEdges := DiamondPathComparison.incEdges k iedge0 + have incBetween := DiamondPathComparison.incBetween k (DiamondPathComparison.incEnumPath k hk + staircaseBetween hN (DiamondPathComparison.iVenum k hk hN)) incVertices incEdges + let D := DiamondTile k + let Q := GaussianQuarterTurn + have dzeroD : TileTranslation D 0 = D := by + simpa [D] using dzero + have dzeroD' : TileTranslation D ⟨0, 0⟩ = D := DiamondPathComparison.dzeroD' k + obtain ⟨c, hc, hcCells, _, _, _⟩ := + QuarterTurnSymmetricCenteredTransport D (DiamondBaseT2 ⟨k, hk⟩) + have hcEq : c = ⟨(k : Int), (k : Int)⟩ := DiamondPathComparison.hcEq k hk c hc + rw [hcEq] at hcCells + let F : GaussianInt → GaussianInt := fun z => Q z + c + let Fc : GaussianInt → GaussianInt := fun z => Q z - 1 + c + have F_inj := DiamondPathComparison.F_inj qinj c + have translateCells (T : ProtoTile) (u v : GaussianInt) : + (TileTranslation T (u + v)).cells = + (TileTranslation (TileTranslation T u) v).cells := DiamondPathComparison.translateCells T + u v + have quarterCells (d : GaussianInt) := DiamondPathComparison.quarterCells k c hcCells hcEq + translateCells d + have quarterCellMap (d : GaussianInt) : + (TileTranslation D (Q d)).cells = + ((TileTranslation D d).cells.image Fc) := DiamondPathComparison.quarterCellMap k c + quarterCells d + have edgeCellsEq {A B : ProtoTile} (hab : A.cells = B.cells) := + DiamondPathComparison.edgeCellsEq (A := A) (B := B) hab + have vertexCellsEq {A B : ProtoTile} (hab : A.cells = B.cells) + (hne : B.cells.Nonempty) := DiamondPathComparison.vertexCellsEq (A := A) (B := B) hab hne + have hDne := DiamondPathComparison.hDne k dne dzero + have quarterVerticesAt (d : GaussianInt) := DiamondPathComparison.quarterVerticesAt k c + quarterCells vertexCellsEq (DiamondPathComparison.quarterTranslatedDne k c quarterCells + (DiamondPathComparison.translatedDne k hDne)) d + have quarterEdgesAt (d : GaussianInt) := DiamondPathComparison.quarterEdgesAt k c quarterCells + edgeCellsEq d + have dShift := DiamondPathComparison.dShift k + let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + let G : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - z.re⟩ + let Gc : GaussianInt → GaussianInt := fun z => + ⟨z.im - (k : Int), (k : Int) - 1 - z.re⟩ + have qInvLeft (z : GaussianInt) : Q (Qinv z) = z := by + apply Zsqrtd.ext <;> simp [Q, Qinv, GaussianQuarterTurn] + have qInvRight (z : GaussianInt) : Qinv (Q z) = z := by + apply Zsqrtd.ext <;> simp [Q, Qinv, GaussianQuarterTurn] + have GF (z : GaussianInt) : G (F z) = z := by + apply Zsqrtd.ext <;> simp [G, F, Q, GaussianQuarterTurn, hcEq] + have FG (z : GaussianInt) : F (G z) = z := by + apply Zsqrtd.ext <;> simp [G, F, Q, GaussianQuarterTurn, hcEq] + have GcFc (z : GaussianInt) : Gc (Fc z) = z := by + apply Zsqrtd.ext <;> simp [Gc, Fc, Q, GaussianQuarterTurn, hcEq]; ring + have FcGc (z : GaussianInt) : Fc (Gc z) = z := by + apply Zsqrtd.ext <;> simp [Gc, Fc, Q, GaussianQuarterTurn, hcEq]; ring + have G_inj := DiamondPathComparison.G_inj k c FG + have inverseVerticesAt (d : GaussianInt) := DiamondPathComparison.inverseVerticesAt k c + quarterVerticesAt qInvLeft GF d + have inverseEdgesAt (d : GaussianInt) := DiamondPathComparison.inverseEdgesAt k c + quarterEdgesAt qInvLeft GF d + have inverseCellAt (d : GaussianInt) : + (TileTranslation D (Qinv d)).cells = + ((TileTranslation D d).cells.image Gc) := DiamondPathComparison.inverseCellAt k c + quarterCellMap qInvLeft GcFc d + have qInvZero : Qinv 0 = 0 := by + apply Zsqrtd.ext <;> simp [Qinv] + have inverseVerticesZero := DiamondPathComparison.inverseVerticesZero k dzeroD + inverseVerticesAt qInvZero + have inverseEdgesZero := DiamondPathComparison.inverseEdgesZero k dzeroD inverseEdgesAt qInvZero + have zeroQ : Q 0 = 0 := by + apply Zsqrtd.ext <;> simp [Q, GaussianQuarterTurn] + have cellMapZero : D.cells = D.cells.image Fc := by + simpa [zeroQ, dzeroD, dzeroD', D] using quarterCellMap 0 + let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + have cellMapRight := DiamondPathComparison.cellMapRight k c quarterCellMap dShift + have ddisjD := DiamondPathComparison.ddisjD k ddisj dzeroD + have dneDright : (TileTranslation D da).cells.Nonempty := by + simpa only [zero_add] using dne' + have disjointImage {α : Type} [DecidableEq α] {s t : Finset α} (f : α → α) + (hf : Function.Injective f) (hdis : Disjoint s t) := DiamondPathComparison.disjointImage (α + := α) (s := s) (t := t) f hf hdis + have inverseCellZero : D.cells = D.cells.image Gc := by + simpa [Qinv, qInvZero, dzeroD, dzeroD', D] using inverseCellAt 0 + let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ + have inverseCellRight : (TileTranslation D (Qinv ia)).cells = + (TileTranslation D ia).cells.image Gc := inverseCellAt ia + have idisjD := DiamondPathComparison.idisjD k idisj dzeroD + have ineDright : (TileTranslation D ia).cells.Nonempty := by + simpa only [zero_add] using ine' + have iaTurn : Qinv ia = ⟨-(k : Int), -(k : Int) - 1⟩ := by + apply Zsqrtd.ext <;> simp [Qinv, ia]; ring + have iaNeg : ⟨-(k : Int) - 1, (k : Int)⟩ + ia = 0 := by + apply Zsqrtd.ext <;> simp [ia] + let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + have translateInj (u : GaussianInt) := DiamondPathComparison.translateInj u + have shiftCellsOne := DiamondPathComparison.shiftCellsOne k + have hsum : ia + shift = 0 := by + apply Zsqrtd.ext <;> simp [ia, shift] + have hnested : (TileTranslation (TileTranslation D ia) shift).cells = D.cells := by + rw [← translateCells D ia shift, hsum, dzeroD] + have hnestedV : BoundaryFootprintVertices + (TileTranslation (TileTranslation D ia) shift) = BoundaryFootprintVertices D := + vertexCellsEq hnested hDne + have hnestedE : BoundaryFootprintEdges + (TileTranslation (TileTranslation D ia) shift) = BoundaryFootprintEdges D := + edgeCellsEq hnested + have secondPath := DiamondRowPaths.secondPath k decBetween + have secondCellsDisj : Disjoint D.cells (TileTranslation D da).cells := ddisjD + have secondCells₂ : (TileTranslation D da).cells.Nonempty := dneDright + have fourthCells₂ : (TileTranslation D shift).cells.Nonempty := + (DiamondPathComparison.shiftCellsNonempty k hDne shiftCellsOne) + have fourthCellsDisj : Disjoint D.cells (TileTranslation D shift).cells := + (DiamondPathComparison.shiftCellsDisjoint k disjointImage idisjD translateInj shiftCellsOne + (DiamondPathComparison.shiftCellsTwo k dzeroD translateCells)) + have secondVertices : BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (TileTranslation D da) = dV := decVertices + have firstEdges := DiamondPathComparison.firstEdges k decEdges c F_inj + (DiamondPathComparison.zeroFedges k dzeroD c quarterEdgesAt zeroQ) + (DiamondPathComparison.rightFedges k c quarterEdgesAt dShift) + have thirdEdges := DiamondPathComparison.thirdEdges k incEdges G_inj inverseEdgesAt + inverseEdgesZero + have fourthEdges := DiamondPathComparison.fourthEdges k (DiamondPathComparison.shiftEdges k + incEdges translateInj hnestedE) + have rowFirst0 := DiamondRowConclusions.rowFirst0 k imagePath qinj decBetween dzeroD c hcEq + F_inj hDne quarterVerticesAt quarterEdgesAt dShift cellMapZero cellMapRight ddisjD + dneDright disjointImage + have rowSecond0 := DiamondRowPaths.rowSecond0 k hDne secondPath secondCellsDisj secondCells₂ + have rowFirst1 := DiamondRowConclusions.rowFirst1 k imagePath incBetween c hDne FcGc G_inj + inverseVerticesAt inverseEdgesAt inverseVerticesZero inverseEdgesZero disjointImage + inverseCellZero inverseCellRight idisjD ineDright + have rowSecond1 := DiamondRowConclusions.rowSecond1 k imagePath incBetween dzeroD + translateCells edgeCellsEq vertexCellsEq hDne translateInj fourthCells₂ fourthCellsDisj + fin_cases i + · have h0 := DiamondRowConclusions.h0 k decVertices dzeroD + c hcEq F_inj quarterVerticesAt dShift zeroQ secondVertices rowFirst0 rowSecond0 + simpa [P5260T1PlacementLedger] using h0 + · have h1 := DiamondRowConclusions.h1 k incVertices G_inj + inverseVerticesAt inverseVerticesZero translateInj hnestedV rowFirst1 rowSecond1 + simpa [P5260T1PlacementLedger, iaTurn, shift, Qinv, sub_eq_add_neg, add_comm] using h1 + · exact (hi rfl).elim + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean b/LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean new file mode 100644 index 0000000000..63bef50983 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean @@ -0,0 +1,902 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5157T1DiamondStaircaseIntersections +public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween + +-- [TABLET NODE: P5290T1PredecessorPath] + +/-! +# P5290T1PredecessorPath + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PredecessorPathProof + +private theorem hDsym : + ∀ (k : Nat), + let D : ProtoTile := DiamondTile k + let K : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - 1 - z.im⟩ + (∀ (m : Nat), ∀ (z : GaussianInt), z ∈ DiamondCellDomain m ↔ ⟨z.re, 2 * (m : Int) - 1 - z.im⟩ + ∈ DiamondCellDomain m) → ((∀ (z : GaussianInt), K (K z) = z) → (D.cells.image K = + D.cells)) := by + classical + intro k D K domain_sym k_invol + change (DiamondCellDomain k).image K = DiamondCellDomain k + have hdom : (DiamondCellDomain k).image K = DiamondCellDomain k := by + ext z + simp only [Finset.mem_image] + constructor + · rintro ⟨w, hw, rfl⟩ + have hs := (domain_sym k w).mp hw + convert hs using 1 + · intro hz + exact ⟨K z, by + have hs := (domain_sym k z).mp hz + convert hs using 1 , + k_invol z⟩ + exact hdom + +private theorem hScells : + ∀ (k : Nat), + let D : ProtoTile := DiamondTile k + let S : ProtoTile := TileTranslation (TileReflection D) ⟨0, 2 * (k : Int)⟩ + let K : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - 1 - z.im⟩ + (D.cells.image K = D.cells) → (S.cells = D.cells) := by + classical + intro k D S K hDsym + simp only [S, D, TileTranslation, TileReflection, DiamondTile] + rw [Finset.image_image] + change (DiamondCellDomain k).image + (GaussianTranslation ⟨0, 2 * (k : Int)⟩ ∘ + (fun z => GaussianReflection z - ⟨0, 1⟩)) = DiamondCellDomain k + rw [show (GaussianTranslation ⟨0, 2 * (k : Int)⟩ ∘ + (fun z => GaussianReflection z - ⟨0, 1⟩)) = K from by + funext z + apply Zsqrtd.ext <;> simp [K, GaussianTranslation, GaussianReflection]; ring] + exact hDsym + +private theorem hRimage : + ∀ (k : Nat), + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + let R : ProtoTile := TileTranslation (TileReflection E) ⟨0, 2 * (k : Int)⟩ + let K : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - 1 - z.im⟩ + (R.cells = (DiamondCellDomain (k - 1)).image (fun a => ⟨a.re + (k : Int), 3 * (k : Int) - 2 - + a.im⟩)) → (R.cells = E.cells.image K) := by + classical + intro k E R K hRcells + rw [hRcells] + change (DiamondCellDomain (k - 1)).image + (fun a => ⟨a.re + (k : Int), 3 * (k : Int) - 2 - a.im⟩) = + ((DiamondCellDomain (k - 1)).image + (GaussianTranslation ⟨(k : Int), 1 - (k : Int)⟩)).image K + rw [Finset.image_image] + apply Finset.image_congr + intro a ha + apply Zsqrtd.ext <;> simp [K, GaussianTranslation]; ring + +private theorem hRedges : + ∀ (k : Nat), + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + let R : ProtoTile := TileTranslation (TileReflection E) ⟨0, 2 * (k : Int)⟩ + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + BoundaryFootprintEdges R = + (fun e : Finset GaussianInt => e.image J) '' BoundaryFootprintEdges E := by + classical + intro k E R J + rcases TileReflectionFormulas E with ⟨_, _, _, _, _, _, _, hrv, hre⟩ + rcases TileTranslationFormulas (TileReflection E) ⟨0, 2 * (k : Int)⟩ with + ⟨_, _, _, _, _, _, _, htv, hte⟩ + rw [hte, hre, Set.image_image] + apply Set.image_congr + intro e he + rw [Finset.image_image] + apply Finset.image_congr + intro z hz + apply Zsqrtd.ext <;> simp [J, GaussianTranslation, GaussianReflection]; ring + +private theorem hSedges : + ∀ (k : Nat), + let D : ProtoTile := DiamondTile k + let S : ProtoTile := TileTranslation (TileReflection D) ⟨0, 2 * (k : Int)⟩ + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + BoundaryFootprintEdges S = + (fun e : Finset GaussianInt => e.image J) '' BoundaryFootprintEdges D := by + classical + intro k D S J + rcases TileReflectionFormulas D with ⟨_, _, _, _, _, _, _, hrv, hre⟩ + rcases TileTranslationFormulas (TileReflection D) ⟨0, 2 * (k : Int)⟩ with + ⟨_, _, _, _, _, _, _, htv, hte⟩ + rw [hte, hre, Set.image_image] + apply Set.image_congr + intro e he + rw [Finset.image_image] + apply Finset.image_congr + intro z hz + apply Zsqrtd.ext <;> simp [J, GaussianTranslation, GaussianReflection]; ring + +private theorem hJEinj : + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + (Function.Injective J) → ( + let JE : Finset GaussianInt → Finset GaussianInt := fun e => e.image J + Function.Injective JE) := by + classical + intro k J hJinj JE e f hef + change e.image J = f.image J at hef + ext z + constructor + · intro hz + have hz' : J z ∈ e.image J := Finset.mem_image.mpr ⟨z, hz, rfl⟩ + rw [hef] at hz' + rcases Finset.mem_image.mp hz' with ⟨w, hw, hzw⟩ + have : w = z := hJinj hzw + simpa [this] using hw + · intro hz + have hz' : J z ∈ f.image J := Finset.mem_image.mpr ⟨z, hz, rfl⟩ + rw [← hef] at hz' + rcases Finset.mem_image.mp hz' with ⟨w, hw, hzw⟩ + have : w = z := hJinj hzw + simpa [this] using hw + +private theorem hVerticesInter : + ∀ (k : Nat), + let D : ProtoTile := DiamondTile k + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + let Z : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + (Function.Injective J) → ((BoundaryFootprintVertices Z = J '' BoundaryFootprintVertices E) → + ((BoundaryFootprintVertices D = J '' BoundaryFootprintVertices D) → + (BoundaryFootprintVertices Z ∩ BoundaryFootprintVertices D = + J '' (BoundaryFootprintVertices E ∩ BoundaryFootprintVertices D)))) := by + classical + intro k D E Z J hJinj hZvertices hDvertices + have hDvertexInv : J '' BoundaryFootprintVertices D = BoundaryFootprintVertices D := + hDvertices.symm + calc + BoundaryFootprintVertices Z ∩ BoundaryFootprintVertices D = + J '' BoundaryFootprintVertices E ∩ BoundaryFootprintVertices D := by + rw [hZvertices] + _ = J '' BoundaryFootprintVertices E ∩ J '' BoundaryFootprintVertices D := by + rw [hDvertexInv] + _ = J '' (BoundaryFootprintVertices E ∩ BoundaryFootprintVertices D) := + (Set.image_inter hJinj).symm + +private theorem hEdgesInter : + ∀ (k : Nat), + let D : ProtoTile := DiamondTile k + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + let Z : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + (BoundaryFootprintEdges Z = (fun e : Finset GaussianInt => e.image J) '' + BoundaryFootprintEdges E) → ((BoundaryFootprintEdges D = (fun e : Finset GaussianInt => + e.image J) '' BoundaryFootprintEdges D) → ( + let JE : Finset GaussianInt → Finset GaussianInt := fun e => e.image J + (Function.Injective JE) → (BoundaryFootprintEdges Z ∩ BoundaryFootprintEdges D = + JE '' (BoundaryFootprintEdges E ∩ BoundaryFootprintEdges D)))) := by + classical + intro k D E Z J hZedges hDedges JE hJEinj + have hDedgeInv : JE '' BoundaryFootprintEdges D = BoundaryFootprintEdges D := + hDedges.symm + calc + BoundaryFootprintEdges Z ∩ BoundaryFootprintEdges D = + JE '' BoundaryFootprintEdges E ∩ BoundaryFootprintEdges D := by + rw [hZedges] + _ = JE '' BoundaryFootprintEdges E ∩ JE '' BoundaryFootprintEdges D := by + rw [hDedgeInv] + _ = JE '' (BoundaryFootprintEdges E ∩ BoundaryFootprintEdges D) := by + exact (Set.image_inter hJEinj).symm + +private theorem hVerticesExact : + ∀ (k : Nat), + let D : ProtoTile := DiamondTile k + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + let Z : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + (BoundaryFootprintVertices Z ∩ BoundaryFootprintVertices D = J '' (BoundaryFootprintVertices + E ∩ BoundaryFootprintVertices D)) → ( + let n : Nat := 2 * (k - 1) + let p : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 + (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices (TileTranslation + (DiamondTile (k - (1 : ℕ))) ⟨(↑k : ℤ), (1 : ℤ) - (↑k : ℤ)⟩) = {v : GaussianInt | ∃ j ≤ (2 + : ℕ) * (k - (1 : ℕ)), v = P5157T1StaircasePoint (1 : GaussianInt) false (1 : ℤ) j}) → + (BoundaryFootprintVertices Z ∩ BoundaryFootprintVertices D = + {v | ∃ j ≤ n, v = J (p j)})) := by + classical + intro k D E Z J hVerticesInter n p sourceV + rw [hVerticesInter, Set.inter_comm, sourceV] + simp only [n] + ext v + simp only [Set.mem_image, Set.mem_ofPred_eq] + constructor + · rintro ⟨w, ⟨j, hj, rfl⟩, rfl⟩ + exact ⟨j, hj, rfl⟩ + · rintro ⟨j, hj, rfl⟩ + exact ⟨p j, ⟨j, hj, by simp [p]⟩, rfl⟩ + +private theorem hEdgesExact : + ∀ (k : Nat), + let D : ProtoTile := DiamondTile k + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + let Z : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + let JE : Finset GaussianInt → Finset GaussianInt := fun e => e.image J + (BoundaryFootprintEdges Z ∩ BoundaryFootprintEdges D = JE '' (BoundaryFootprintEdges E ∩ + BoundaryFootprintEdges D)) → ( + let n : Nat := 2 * (k - 1) + let p : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 + (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation + (DiamondTile (k - (1 : ℕ))) ⟨(↑k : ℤ), (1 : ℤ) - (↑k : ℤ)⟩) = {e : Finset GaussianInt | ∃ + j < (2 : ℕ) * (k - (1 : ℕ)), e = + {P5157T1StaircasePoint (1 : GaussianInt) false (1 : ℤ) j, + P5157T1StaircasePoint (1 : GaussianInt) false (1 : ℤ) (j + (1 : ℕ))}}) → + (BoundaryFootprintEdges Z ∩ BoundaryFootprintEdges D = + {e | ∃ j < n, e = {J (p j), J (p (j + 1))}})) := by + classical + intro k D E Z J JE hEdgesInter n p sourceE + rw [hEdgesInter, Set.inter_comm, sourceE] + ext e + simp only [Set.mem_image, Set.mem_ofPred_eq] + constructor + · rintro ⟨w, ⟨j, hj, rfl⟩, rfl⟩ + refine ⟨j, hj, ?_⟩ + simpa only [p] using (show + JE {P5157T1StaircasePoint 1 false 1 j, + P5157T1StaircasePoint 1 false 1 (j + 1)} = + {J (P5157T1StaircasePoint 1 false 1 j), + J (P5157T1StaircasePoint 1 false 1 (j + 1))} by + simp [JE, Finset.image_insert, Finset.image_singleton]) + · rintro ⟨j, hj, rfl⟩ + refine ⟨{p j, p (j + 1)}, ⟨j, hj, rfl⟩, ?_⟩ + simp [JE, p, Finset.image_insert, Finset.image_singleton] + +private theorem lverts : + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + let n : Nat := 2 * (k - 1) + let p : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 + let q : Nat → GaussianInt := fun j => J (p j) + let l : List GaussianInt := List.ofFn (fun i : Fin (n + 1) => q i) + (l.toFinset : Set GaussianInt) = + {v | ∃ j ≤ n, v = q j} := by + classical + intro k J n p q l + ext v + simp only [Set.mem_ofPred_eq, Finset.mem_coe, List.mem_toFinset, l, + List.mem_ofFn] + constructor + · rintro ⟨j, rfl⟩ + exact ⟨j, by omega, rfl⟩ + · rintro ⟨j, hj, rfl⟩ + exact ⟨⟨j, by omega⟩, rfl⟩ + +end PredecessorPathProof + +namespace PredecessorPathDetails + +private theorem domain_sym : + (Nat) → (∀ (m : ℕ), ∀ (z : GaussianInt), z ∈ DiamondCellDomain m ↔ { re := z.re, im := (2 : + ℤ) * (↑m : ℤ) - (1 : ℤ) - z.im } ∈ DiamondCellDomain m) := by + classical + intro k m z + rw [(P4194T1DiamondCellRows m z).1, + (P4194T1DiamondCellRows m ⟨z.re, 2 * (m : Int) - 1 - z.im⟩).1] + simp only + omega + +private theorem dom_sym : + ∀ (k : Nat), ((1 : ℕ) < k) → ( + let Jc : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - 3 - z.im⟩ + (∀ (m : Nat), ∀ (z : GaussianInt), z ∈ DiamondCellDomain m ↔ ⟨z.re, 2 * (m : Int) - 1 - z.im⟩ + ∈ DiamondCellDomain m) → (∀ (z : GaussianInt), z ∈ DiamondCellDomain (k - (1 : ℕ)) ↔ Jc z + ∈ DiamondCellDomain (k - (1 : ℕ)))) := by + classical + intro k hk Jc domain_sym z + have hcast : ((k - 1 : Nat) : Int) = (k : Int) - 1 := by omega + have hcoord : 2 * ((k - 1 : Nat) : Int) - 1 = 2 * (k : Int) - 3 := by + rw [hcast] + ring + simpa [Jc, hcoord] using domain_sym (k - 1) z + +private theorem neD : + ∀ (k : Nat), ((1 : ℕ) < k) → ( + let D : ProtoTile := DiamondTile k + D.cells.Nonempty) := by + classical + intro k hk D + change (DiamondTile k).cells.Nonempty + refine ⟨0, ?_⟩ + exact (P4194T1DiamondCellRows k 0).1.mpr (by norm_num; omega) + +private theorem nePrev : + ∀ (k : Nat), ((1 : ℕ) < k) → ((DiamondTile (k - 1)).cells.Nonempty) := by + classical + intro k hk + refine ⟨0, ?_⟩ + exact (P4194T1DiamondCellRows (k - 1) 0).1.mpr (by norm_num; omega) + +private theorem neE : + ∀ (k : Nat), + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + ((DiamondTile (k - 1)).cells.Nonempty) → (E.cells.Nonempty) := by + classical + intro k E nePrev + change (TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩).cells.Nonempty + rw [(TileTranslationFormulas _ _).1] + exact nePrev.image _ + +private theorem hG : + ∀ (k : Nat), + let Jc : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - 3 - z.im⟩ + (∀ (z : GaussianInt), z ∈ DiamondCellDomain (k - 1) ↔ Jc z ∈ DiamondCellDomain (k - 1)) → ((∀ + (z : GaussianInt), Jc (Jc z) = z) → ((DiamondCellDomain (k - 1)).image Jc = + DiamondCellDomain (k - 1))) := by + classical + intro k Jc dom_sym g_invol + ext z + simp only [Finset.mem_image] + constructor + · rintro ⟨w, hw, rfl⟩ + exact (dom_sym w).mp hw + · intro hz + exact ⟨Jc z, (dom_sym z).mp hz, g_invol z⟩ + +private theorem hRcells : + ∀ (k : Nat), + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + let R : ProtoTile := TileTranslation (TileReflection E) ⟨0, 2 * (k : Int)⟩ + R.cells = (DiamondCellDomain (k - 1)).image + (fun a => ⟨a.re + (k : Int), 3 * (k : Int) - 2 - a.im⟩) := by + classical + intro k E R + simp only [R, E, TileTranslation, TileReflection, DiamondTile, + Finset.image_image, GaussianTranslation, GaussianReflection] + apply Finset.image_congr + intro a ha + apply Zsqrtd.ext <;> simp [GaussianTranslation]; ring + +private theorem hZcells : + ∀ (k : Nat), + let Z : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + Z.cells = (DiamondCellDomain (k - 1)).image + (fun a => ⟨a.re + (k : Int), a.im + (k : Int) + 1⟩) := by + classical + intro k Z + change (DiamondCellDomain (k - 1)).image + (GaussianTranslation ⟨(k : Int), (k : Int) + 1⟩) = _ + apply Finset.image_congr + intro a ha + apply Zsqrtd.ext <;> simp [GaussianTranslation]; ring + +private theorem hmaps : + ∀ (k : Nat), + let Jc : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - 3 - z.im⟩ + (fun a : GaussianInt => + (⟨a.re + (k : Int), 3 * (k : Int) - 2 - a.im⟩ : GaussianInt)) = + (fun a : GaussianInt => + (⟨a.re + (k : Int), (Jc a).im + (k : Int) + 1⟩ : GaussianInt)) := by + classical + intro k Jc + funext a + apply Zsqrtd.ext <;> simp [Jc]; ring + +private theorem cellsRZ : + ∀ (k : Nat), + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + let Z : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + let R : ProtoTile := TileTranslation (TileReflection E) ⟨0, 2 * (k : Int)⟩ + let Jc : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - 3 - z.im⟩ + ((DiamondCellDomain (k - 1)).image Jc = DiamondCellDomain (k - 1)) → ((R.cells = + (DiamondCellDomain (k - 1)).image (fun a => ⟨a.re + (k : Int), 3 * (k : Int) - 2 - + a.im⟩)) → ((Z.cells = (DiamondCellDomain (k - 1)).image (fun a => ⟨a.re + (k : Int), a.im + + (k : Int) + 1⟩)) → (((fun a : GaussianInt => (⟨a.re + (k : Int), 3 * (k : Int) - 2 - + a.im⟩ : GaussianInt)) = (fun a : GaussianInt => (⟨a.re + (k : Int), (Jc a).im + (k : Int) + + 1⟩ : GaussianInt))) → (R.cells = Z.cells)))) := by + classical + intro k E Z R Jc hG hRcells hZcells hmaps + rw [hRcells, hZcells, hmaps] + simpa only [Finset.image_image, Function.comp_def] using + congrArg (Finset.image (fun a : GaussianInt => + (⟨a.re + (k : Int), a.im + (k : Int) + 1⟩ : GaussianInt))) hG + +private theorem k_inj : + ∀ (k : Nat), + let K : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - 1 - z.im⟩ + (∀ (z : GaussianInt), K (K z) = z) → (Function.Injective K) := by + classical + intro k K k_invol a b hab + have := congrArg K hab + simpa only [k_invol] using this + +private theorem hReflectDisj : + ∀ (k : Nat), + let D : ProtoTile := DiamondTile k + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + let R : ProtoTile := TileTranslation (TileReflection E) ⟨0, 2 * (k : Int)⟩ + let S : ProtoTile := TileTranslation (TileReflection D) ⟨0, 2 * (k : Int)⟩ + let K : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - 1 - z.im⟩ + (Function.Injective K) → ((Disjoint D.cells E.cells) → (((TileTranslation (TileReflection + (TileTranslation (DiamondTile (k - (1 : ℕ))) ⟨(↑k : ℤ), (1 : ℤ) - (↑k : ℤ)⟩)) ⟨(0 : ℤ), + (2 : ℤ) * (↑k : ℤ)⟩).cells = Finset.image (fun (z : GaussianInt) => ⟨z.re, (2 : ℤ) * (↑k + : ℤ) - (1 : ℤ) - z.im⟩) (TileTranslation (DiamondTile (k - (1 : ℕ))) ⟨(↑k : ℤ), (1 : ℤ) - + (↑k : ℤ)⟩).cells) → ((S.cells = D.cells.image K) → (Disjoint S.cells R.cells)))) := by + classical + intro k D E R S K k_inj hSourceDisj hRimage hSimage + rw [hSimage, hRimage] + apply Finset.disjoint_left.mpr + intro z hzS hzR + rcases Finset.mem_image.mp hzS with ⟨a, ha, haz⟩ + rcases Finset.mem_image.mp hzR with ⟨b, hb, hbz⟩ + have hab : a = b := k_inj (haz.trans hbz.symm) + subst b + exact (Finset.disjoint_left.mp hSourceDisj) ha hb + +private theorem neR : + ∀ (k : Nat), + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + let R : ProtoTile := TileTranslation (TileReflection E) ⟨0, 2 * (k : Int)⟩ + (E.cells.Nonempty) → (((TileTranslation (TileReflection (TileTranslation (DiamondTile (k - (1 + : ℕ))) ⟨(↑k : ℤ), (1 : ℤ) - (↑k : ℤ)⟩)) ⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩).cells = + Finset.image (fun (z : GaussianInt) => ⟨z.re, (2 : ℤ) * (↑k : ℤ) - (1 : ℤ) - z.im⟩) + (TileTranslation (DiamondTile (k - (1 : ℕ))) ⟨(↑k : ℤ), (1 : ℤ) - (↑k : ℤ)⟩).cells) → + (R.cells.Nonempty)) := by + classical + intro k E R neE hRimage + let K : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - 1 - z.im⟩ + rw [hRimage] + exact neE.image K + +private theorem neZ : + ∀ (k : Nat), + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + let Z : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + let R : ProtoTile := TileTranslation (TileReflection E) ⟨0, 2 * (k : Int)⟩ + (R.cells = Z.cells) → ((R.cells.Nonempty) → (Z.cells.Nonempty)) := by + classical + intro k E Z R cellsRZ neR + rw [← cellsRZ] + exact neR + +private theorem hTargetDisj : + ∀ (k : Nat), + let D : ProtoTile := DiamondTile k + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + let Z : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + let R : ProtoTile := TileTranslation (TileReflection E) ⟨0, 2 * (k : Int)⟩ + let S : ProtoTile := TileTranslation (TileReflection D) ⟨0, 2 * (k : Int)⟩ + (R.cells = Z.cells) → (((TileTranslation (TileReflection (DiamondTile k)) ⟨(0 : ℤ), (2 : ℤ) * + (↑k : ℤ)⟩).cells = (DiamondTile k).cells) → ((Disjoint S.cells R.cells) → (Disjoint + Z.cells D.cells))) := by + classical + intro k D E Z R S cellsRZ hScells hReflectDisj + rw [← cellsRZ, ← hScells] + exact hReflectDisj.symm + +private theorem hJinj : + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + Function.Injective J := by + classical + intro k J a b hab + have hre := congrArg Zsqrtd.re hab + have him := congrArg Zsqrtd.im hab + simp [J] at hre him + apply Zsqrtd.ext <;> assumption + +private theorem hRvertices : + ∀ (k : Nat), + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + let R : ProtoTile := TileTranslation (TileReflection E) ⟨0, 2 * (k : Int)⟩ + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + BoundaryFootprintVertices R = J '' BoundaryFootprintVertices E := by + classical + intro k E R J + rcases TileReflectionFormulas E with ⟨_, _, _, _, _, _, _, hrv, hre⟩ + rcases TileTranslationFormulas (TileReflection E) ⟨0, 2 * (k : Int)⟩ with + ⟨_, _, _, _, _, _, _, htv, hte⟩ + rw [htv, hrv, Set.image_image] + congr 1 + funext z + apply Zsqrtd.ext <;> simp [J, GaussianTranslation, GaussianReflection]; ring + +private theorem hSvertices : + ∀ (k : Nat), + let D : ProtoTile := DiamondTile k + let S : ProtoTile := TileTranslation (TileReflection D) ⟨0, 2 * (k : Int)⟩ + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + BoundaryFootprintVertices S = J '' BoundaryFootprintVertices D := by + classical + intro k D S J + rcases TileReflectionFormulas D with ⟨_, _, _, _, _, _, _, hrv, hre⟩ + rcases TileTranslationFormulas (TileReflection D) ⟨0, 2 * (k : Int)⟩ with + ⟨_, _, _, _, _, _, _, htv, hte⟩ + rw [htv, hrv, Set.image_image] + congr 1 + funext z + apply Zsqrtd.ext <;> simp [J, GaussianTranslation, GaussianReflection]; ring + +private theorem hBoundaryE : + ∀ (T : ProtoTile), ∀ (U : ProtoTile), T.cells = U.cells → BoundaryFootprintEdges T = + BoundaryFootprintEdges U := by + classical + intro T U hc + unfold BoundaryFootprintEdges + rw [hc] + +private theorem hBoundaryV : + (∀ (T : ProtoTile), ∀ (U : ProtoTile), (T.cells = U.cells) → (BoundaryFootprintEdges T = + BoundaryFootprintEdges U)) → (∀ (T : ProtoTile), ∀ (U : ProtoTile), T.cells = U.cells → + Finset.Nonempty T.cells → Finset.Nonempty U.cells → BoundaryFootprintVertices T = + BoundaryFootprintVertices U) := by + classical + intro hBoundaryE T U hc ht hu + unfold BoundaryFootprintVertices + rw [ite_eq_left ht, ite_eq_left hu] + rw [hBoundaryE T U hc] + +private theorem hZedges : + ∀ (k : Nat), + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + let Z : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + let R : ProtoTile := TileTranslation (TileReflection E) ⟨0, 2 * (k : Int)⟩ + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + (R.cells = Z.cells) → ((have E := TileTranslation (DiamondTile (k - (1 : ℕ))) ⟨(↑k : ℤ), (1 : + ℤ) - (↑k : ℤ)⟩; have R := TileTranslation (TileReflection E) ⟨(0 : ℤ), (2 : ℤ) * (↑k : + ℤ)⟩; have J := fun (z : GaussianInt) => ⟨z.re, (2 : ℤ) * (↑k : ℤ) - z.im⟩; + BoundaryFootprintEdges R = (fun (e : Finset GaussianInt) => Finset.image J e) '' + BoundaryFootprintEdges E) → ((∀ (T : ProtoTile), ∀ (U : ProtoTile), (T.cells = U.cells) → + (BoundaryFootprintEdges T = BoundaryFootprintEdges U)) → (BoundaryFootprintEdges Z = + (fun e : Finset GaussianInt => e.image J) '' BoundaryFootprintEdges E))) := by + classical + intro k E Z R J cellsRZ hRedges hBoundaryE + rw [← hBoundaryE R Z cellsRZ, hRedges] + +private theorem hDvertices : + ∀ (k : Nat), + let D : ProtoTile := DiamondTile k + let S : ProtoTile := TileTranslation (TileReflection D) ⟨0, 2 * (k : Int)⟩ + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + (D.cells.Nonempty) → (((TileTranslation (TileReflection (DiamondTile k)) ⟨(0 : ℤ), (2 : ℤ) * + (↑k : ℤ)⟩).cells = (DiamondTile k).cells) → ((BoundaryFootprintVertices S = J '' + BoundaryFootprintVertices D) → ((∀ (T : ProtoTile), ∀ (U : ProtoTile), (T.cells = + U.cells) → ((T.cells.Nonempty) → ((U.cells.Nonempty) → (BoundaryFootprintVertices T = + BoundaryFootprintVertices U)))) → (BoundaryFootprintVertices D = J '' + BoundaryFootprintVertices D)))) := by + classical + intro k D S J neD hScells hSvertices hBoundaryV + calc + BoundaryFootprintVertices D = BoundaryFootprintVertices S := + (hBoundaryV S D hScells (by rw [hScells]; exact neD) neD).symm + _ = J '' BoundaryFootprintVertices D := hSvertices + +private theorem hDedges : + ∀ (k : Nat), + let D : ProtoTile := DiamondTile k + let S : ProtoTile := TileTranslation (TileReflection D) ⟨0, 2 * (k : Int)⟩ + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + ((TileTranslation (TileReflection (DiamondTile k)) ⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩).cells = + (DiamondTile k).cells) → ((BoundaryFootprintEdges S = + (fun e : Finset GaussianInt => e.image J) '' BoundaryFootprintEdges D)) → ((∀ (T : + ProtoTile), ∀ + (U : ProtoTile), (T.cells = U.cells) → (BoundaryFootprintEdges T = BoundaryFootprintEdges + U)) → (BoundaryFootprintEdges D = + (fun e : Finset GaussianInt => e.image J) '' BoundaryFootprintEdges D)) := by + classical + intro k D S J hScells hSedges hBoundaryE + calc + BoundaryFootprintEdges D = BoundaryFootprintEdges S := + (hBoundaryE S D hScells).symm + _ = (fun e : Finset GaussianInt => e.image J) '' BoundaryFootprintEdges D := hSedges + +private theorem qinj : + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + (Function.Injective J) → ( + let p : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 + (Function.Injective p) → ( + let q : Nat → GaussianInt := fun j => J (p j) + Function.Injective q)) := by + classical + intro k J hJinj p pinj q a b hab + apply pinj + exact hJinj hab + +private theorem pstep : + (Nat) → ( + let p : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 + ∀ (j : ℕ), p (j + (1 : ℕ)) = p j + (1 : GaussianInt) ∨ p (j + (1 : ℕ)) = p j + ⟨(0 : + ℤ), (1 : ℤ)⟩) := by + classical + intro k p j + simp [p, P5157T1StaircasePoint, Zsqrtd.ext_iff]; omega + +private theorem qstep : + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + let p : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 + let q : Nat → GaussianInt := fun j => J (p j) + (∀ (j : Nat), p (j + 1) = p j + 1 ∨ p (j + 1) = p j + ⟨0, 1⟩) → ((∀ (z : GaussianInt), J (z + + 1) = J z + 1) → ((∀ (z : GaussianInt), J (z + ⟨0, 1⟩) = J z - ⟨0, 1⟩) → (∀ (j : ℕ), q (j + + (1 : ℕ)) = q j + (1 : GaussianInt) ∨ q (j + (1 : ℕ)) = q j - { re := (0 : ℤ), im := (1 + : ℤ) }))) := by + classical + intro k J p q pstep Jright Jup j + rcases pstep j with h | h + · left + dsimp [q] + rw [h, Jright] + · right + dsimp [q] + rw [h, Jup] + +private theorem lNodup : + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + let n : Nat := 2 * (k - 1) + let p : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 + let q : Nat → GaussianInt := fun j => J (p j) + (Function.Injective q) → ( + let l : List GaussianInt := List.ofFn (fun i : Fin (n + 1) => q i) + l.Nodup) := by + classical + intro k J n p q qinj l + apply List.nodup_ofFn.mpr + intro i j hij + exact Fin.ext (qinj hij) + +private theorem lchain : + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + let n : Nat := 2 * (k - 1) + let p : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 + let q : Nat → GaussianInt := fun j => J (p j) + let l : List GaussianInt := List.ofFn (fun i : Fin (n + 1) => q i) + l.IsChain (fun a b => ∃ j < n, a = q j ∧ b = q (j + 1)) := by + classical + intro k J n p q l + apply List.isChain_ofFn.mpr + intro j hj + exact ⟨j, by omega, rfl, rfl⟩ + +private theorem qn : + ∀ (k : Nat), ((1 : ℕ) < k) → ( + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + let n : Nat := 2 * (k - 1) + let p : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 + let q : Nat → GaussianInt := fun j => J (p j) + q n = ⟨(k : Int), (k : Int) + 1⟩) := by + classical + intro k hk J n p q + simp [q, p, J, P5157T1StaircasePoint, n] + omega + +private theorem lhead : + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + let n : Nat := 2 * (k - 1) + let p : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 + let q : Nat → GaussianInt := fun j => J (p j) + let l : List GaussianInt := List.ofFn (fun i : Fin (n + 1) => q i) + (q 0 = ⟨1, 2 * (k : Int)⟩) → (l.head? = some ⟨1, 2 * (k : Int)⟩) := by + classical + intro k J n p q l q0 + simp only [l, List.ofFn_succ, List.head?_cons] + simpa using congrArg some q0 + +private theorem llast : + ∀ (k : Nat), + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + let n : Nat := 2 * (k - 1) + let p : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 + let q : Nat → GaussianInt := fun j => J (p j) + let l : List GaussianInt := List.ofFn (fun i : Fin (n + 1) => q i) + (l.length = n + 1) → ((q n = ⟨(k : Int), (k : Int) + 1⟩) → (l.getLast? = some ⟨(k : Int), (k + : Int) + 1⟩)) := by + classical + intro k J n p q l llength qn + have hne : l ≠ [] := by + intro h + have := congrArg List.length h + simp [llength] at this + rw [List.getLast?_eq_getLast_of_ne_nil hne, List.getLast_ofFn_succ] + simp [q, qn] + +end PredecessorPathDetails + +theorem P5290T1PredecessorPath (k : Nat) (hk : 1 < k) : + let D := DiamondTile k + let Z := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), (k : Int) + 1⟩ + let y : GaussianInt := ⟨1, 2 * (k : Int)⟩ + Z.cells.Nonempty ∧ D.cells.Nonempty ∧ Disjoint Z.cells D.cells ∧ + SimpleGridPathBetween + (BoundaryFootprintVertices Z ∩ BoundaryFootprintVertices D) + (BoundaryFootprintEdges Z ∩ BoundaryFootprintEdges D) + y ⟨(k : Int), (k : Int) + 1⟩ := by +-- BODY + classical + dsimp only + let D : ProtoTile := DiamondTile k + let E : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), 1 - (k : Int)⟩ + let Z : ProtoTile := TileTranslation (DiamondTile (k - 1)) + ⟨(k : Int), (k : Int) + 1⟩ + let R : ProtoTile := TileTranslation (TileReflection E) ⟨0, 2 * (k : Int)⟩ + let S : ProtoTile := TileTranslation (TileReflection D) ⟨0, 2 * (k : Int)⟩ + let J : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - z.im⟩ + let K : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - 1 - z.im⟩ + let Jc : GaussianInt → GaussianInt := fun z => ⟨z.re, 2 * (k : Int) - 3 - z.im⟩ + have domain_sym (m : Nat) (z : GaussianInt) : + z ∈ DiamondCellDomain m ↔ + ⟨z.re, 2 * (m : Int) - 1 - z.im⟩ ∈ DiamondCellDomain m := + PredecessorPathDetails.domain_sym k m z + have dom_sym (z : GaussianInt) : + z ∈ DiamondCellDomain (k - 1) ↔ Jc z ∈ DiamondCellDomain (k - 1) := + PredecessorPathDetails.dom_sym k hk domain_sym z + have neD : D.cells.Nonempty := PredecessorPathDetails.neD k hk + have nePrev : (DiamondTile (k - 1)).cells.Nonempty := PredecessorPathDetails.nePrev k hk + have neE : E.cells.Nonempty := PredecessorPathDetails.neE k nePrev + have g_invol (z : GaussianInt) : Jc (Jc z) = z := by + apply Zsqrtd.ext <;> simp [Jc] + have hG : (DiamondCellDomain (k - 1)).image Jc = DiamondCellDomain (k - 1) := + PredecessorPathDetails.hG k dom_sym g_invol + have hRcells : R.cells = (DiamondCellDomain (k - 1)).image + (fun a => ⟨a.re + (k : Int), 3 * (k : Int) - 2 - a.im⟩) := PredecessorPathDetails.hRcells k + have hZcells : Z.cells = (DiamondCellDomain (k - 1)).image + (fun a => ⟨a.re + (k : Int), a.im + (k : Int) + 1⟩) := PredecessorPathDetails.hZcells k + have hmaps : (fun a : GaussianInt => + (⟨a.re + (k : Int), 3 * (k : Int) - 2 - a.im⟩ : GaussianInt)) = + (fun a : GaussianInt => + (⟨a.re + (k : Int), (Jc a).im + (k : Int) + 1⟩ : GaussianInt)) := + PredecessorPathDetails.hmaps k + have cellsRZ : R.cells = Z.cells := PredecessorPathDetails.cellsRZ k hG hRcells hZcells hmaps + have k_invol (z : GaussianInt) : K (K z) = z := by + apply Zsqrtd.ext <;> simp [K] + have hDsym := PredecessorPathProof.hDsym k domain_sym k_invol + have hScells := PredecessorPathProof.hScells k hDsym + have k_inj : Function.Injective K := PredecessorPathDetails.k_inj k k_invol + have source := P5157T1DiamondStaircaseIntersections k hk + dsimp only at source + have hSourceDisj : Disjoint D.cells E.cells := source.1.1 + have hRimage := PredecessorPathProof.hRimage k hRcells + have hSimage : S.cells = D.cells.image K := by + rw [hScells, hDsym] + have hReflectDisj : Disjoint S.cells R.cells := PredecessorPathDetails.hReflectDisj k k_inj + hSourceDisj hRimage hSimage + have neR : R.cells.Nonempty := PredecessorPathDetails.neR k neE hRimage + have neZ : Z.cells.Nonempty := PredecessorPathDetails.neZ k cellsRZ neR + have hTargetDisj : Disjoint Z.cells D.cells := PredecessorPathDetails.hTargetDisj k cellsRZ + hScells hReflectDisj + have hJinj : Function.Injective J := PredecessorPathDetails.hJinj k + have hRvertices : BoundaryFootprintVertices R = J '' BoundaryFootprintVertices E := + PredecessorPathDetails.hRvertices k + have hRedges := PredecessorPathProof.hRedges k + have hSvertices : BoundaryFootprintVertices S = J '' BoundaryFootprintVertices D := + PredecessorPathDetails.hSvertices k + have hSedges := PredecessorPathProof.hSedges k + have hBoundaryE (T U : ProtoTile) (hc : T.cells = U.cells) : + BoundaryFootprintEdges T = BoundaryFootprintEdges U := PredecessorPathDetails.hBoundaryE T + U hc + have hBoundaryV (T U : ProtoTile) (hc : T.cells = U.cells) + (ht : T.cells.Nonempty) (hu : U.cells.Nonempty) : + BoundaryFootprintVertices T = BoundaryFootprintVertices U := + PredecessorPathDetails.hBoundaryV hBoundaryE T U hc ht hu + have hZvertices : BoundaryFootprintVertices Z = J '' BoundaryFootprintVertices E := by + rw [← hBoundaryV R Z cellsRZ neR neZ, hRvertices] + have hZedges : BoundaryFootprintEdges Z = + (fun e : Finset GaussianInt => e.image J) '' BoundaryFootprintEdges E := + PredecessorPathDetails.hZedges k cellsRZ hRedges hBoundaryE + have hDvertices : BoundaryFootprintVertices D = J '' BoundaryFootprintVertices D := + PredecessorPathDetails.hDvertices k neD hScells hSvertices hBoundaryV + have hDedges : BoundaryFootprintEdges D = + (fun e : Finset GaussianInt => e.image J) '' BoundaryFootprintEdges D := + PredecessorPathDetails.hDedges k hScells hSedges hBoundaryE + let JE : Finset GaussianInt → Finset GaussianInt := fun e => e.image J + have hJEinj := PredecessorPathProof.hJEinj k hJinj + have hVerticesInter := PredecessorPathProof.hVerticesInter k hJinj hZvertices hDvertices + have hEdgesInter := PredecessorPathProof.hEdgesInter k hZedges hDedges hJEinj + let n : Nat := 2 * (k - 1) + let p : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 + have sourceV := source.1.2.1 + have sourceE := source.1.2.2 + have hVerticesExact := PredecessorPathProof.hVerticesExact k hVerticesInter sourceV + have hEdgesExact := PredecessorPathProof.hEdgesExact k + hEdgesInter sourceE + have hn : 0 < n := by dsimp [n]; omega + have alt := P5157T1AlternatingStaircase 1 false 1 (Or.inl rfl) n hn + dsimp only at alt + have pinj : Function.Injective p := by + simpa [p] using alt.1 + let q : Nat → GaussianInt := fun j => J (p j) + have qinj : Function.Injective q := PredecessorPathDetails.qinj k hJinj pinj + have pstep (j : Nat) : p (j + 1) = p j + 1 ∨ + p (j + 1) = p j + ⟨0, 1⟩ := PredecessorPathDetails.pstep k j + have Jright (z : GaussianInt) : J (z + 1) = J z + 1 := by + apply Zsqrtd.ext <;> simp [J] + have Jup (z : GaussianInt) : J (z + ⟨0, 1⟩) = J z - ⟨0, 1⟩ := by + apply Zsqrtd.ext <;> simp [J]; ring + have qstep (j : Nat) : q (j + 1) = q j + 1 ∨ + q (j + 1) = q j - ⟨0, 1⟩ := PredecessorPathDetails.qstep k pstep Jright Jup j + let l : List GaussianInt := List.ofFn (fun i : Fin (n + 1) => q i) + have lNodup : l.Nodup := PredecessorPathDetails.lNodup k qinj + have llength : l.length = n + 1 := by simp [l] + have lchain : l.IsChain (fun a b => ∃ j < n, a = q j ∧ b = q (j + 1)) := + PredecessorPathDetails.lchain k + have consecutive (a b : GaussianInt) (l₁ l₂ : List GaussianInt) + (heq : l = l₁ ++ a :: b :: l₂) : + ∃ j < n, a = q j ∧ b = q (j + 1) := + List.isChain_iff_forall_rel_of_append_cons_cons.mp lchain heq + have q0 : q 0 = ⟨1, 2 * (k : Int)⟩ := by + simp [q, p, J, P5157T1StaircasePoint] + have qn : q n = ⟨(k : Int), (k : Int) + 1⟩ := PredecessorPathDetails.qn k hk + have lhead : l.head? = some ⟨1, 2 * (k : Int)⟩ := PredecessorPathDetails.lhead k q0 + have llast : l.getLast? = some ⟨(k : Int), (k : Int) + 1⟩ := PredecessorPathDetails.llast k + llength qn + have lverts := PredecessorPathProof.lverts k + refine ⟨neZ, neD, hTargetDisj, ?_⟩ + refine ⟨l, lNodup, ?_, lhead, llast, ?_, ?_, ?_⟩ + · rw [llength] + omega + · rw [hVerticesExact] + simpa [q, l] using lverts.symm + · intro a b l₁ l₂ heq + obtain ⟨j, hj, rfl, rfl⟩ := consecutive a b l₁ l₂ heq + rcases qstep j with h | h + · exact Or.inl h + · exact Or.inr (Or.inr (Or.inr h)) + · intro e + rw [hEdgesExact] + constructor + · rintro ⟨j, hj, rfl⟩ + have hjl : j < l.length := by rw [llength]; omega + have hjl' : j + 1 < l.length := by rw [llength]; omega + refine ⟨q j, q (j + 1), l.take j, l.drop (j + 2), ?_, rfl⟩ + have hd := List.getElem_cons_drop hjl + have hd' := List.getElem_cons_drop hjl' + have heq : l = l.take j ++ l[j] :: l[j + 1] :: l.drop (j + 2) := by + rw [show j + 2 = j + 1 + 1 by omega, hd', hd, List.take_append_drop] + simpa only [l, List.getElem_ofFn] using heq + · rintro ⟨a, b, l₁, l₂, heq, rfl⟩ + obtain ⟨j, hj, rfl, rfl⟩ := consecutive a b l₁ l₂ heq + exact ⟨j, hj, rfl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1RawBoundaryInterfaces.lean b/LeanPool/ApollonianSuperharmonic/P5290T1RawBoundaryInterfaces.lean new file mode 100644 index 0000000000..acc8657597 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5290T1RawBoundaryInterfaces.lean @@ -0,0 +1,89 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import LeanPool.ApollonianSuperharmonic.FootprintVertices + +-- [TABLET NODE: P5290T1RawBoundaryInterfaces] + +/-! +# P5290T1RawBoundaryInterfaces + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5290T1RawBoundaryInterfaces (T U : ProtoTile) + (hT : T.cells.Nonempty) (hU : U.cells.Nonempty) + (hd : Disjoint T.cells U.cells) : + FootprintVertices T ∩ FootprintVertices U = + BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U ∧ + FootprintEdges T ∩ FootprintEdges U = + BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U := by +-- BODY + have incident (A : ProtoTile) (hne : A.cells.Nonempty) (z : GaussianInt) : + z ∈ FootprintVertices A ↔ + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ A.cells := by + rw [FootprintVertices, ite_eq_left hne] + constructor + · rintro ⟨c, hc, rfl | rfl | rfl | rfl⟩ + · exact ⟨0, hc⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨2, by simpa [LatticeVertexIncidentCell, add_sub_assoc, + add_comm, add_left_comm, add_assoc] using hc⟩ + · rintro ⟨j, hj⟩ + fin_cases j + · exact ⟨z, hj, Or.inl rfl⟩ + · exact ⟨z - 1, hj, Or.inr (Or.inl (by simp))⟩ + · exact ⟨z - 1 - ⟨0, 1⟩, hj, + Or.inr (Or.inr (Or.inr (by abel)))⟩ + · exact ⟨z - ⟨0, 1⟩, hj, Or.inr (Or.inr (Or.inl (by simp)))⟩ + have boundary_raw (A : ProtoTile) (hne : A.cells.Nonempty) + (z : GaussianInt) (hz : z ∈ BoundaryFootprintVertices A) : + z ∈ FootprintVertices A := by + rw [BoundaryFootprintVertices, ite_eq_left hne] at hz + obtain ⟨e, ⟨c, he⟩, hz⟩ := hz + rw [FootprintVertices, ite_eq_left hne] + rcases he with ⟨rfl, hc⟩ | ⟨rfl, hc⟩ + · rcases hc with ⟨hc, _⟩ | ⟨_, hc⟩ + · have hz : z = c ∨ z = c + 1 := by simpa using hz + exact ⟨c, hc, hz.elim Or.inl (fun h => Or.inr (Or.inl h))⟩ + · have hz : z = c ∨ z = c + 1 := by simpa using hz + refine ⟨c - ⟨0, 1⟩, hc, ?_⟩ + rcases hz with rfl | rfl + · exact Or.inr (Or.inr (Or.inl (by simp))) + · exact Or.inr (Or.inr (Or.inr (by simp [sub_add_eq_add_sub]))) + · rcases hc with ⟨hc, _⟩ | ⟨_, hc⟩ + · have hz : z = c ∨ z = c + ⟨0, 1⟩ := by simpa using hz + exact ⟨c, hc, hz.elim Or.inl (fun h => Or.inr (Or.inr (Or.inl h)))⟩ + · have hz : z = c ∨ z = c + ⟨0, 1⟩ := by simpa using hz + refine ⟨c - 1, hc, ?_⟩ + rcases hz with rfl | rfl + · exact Or.inr (Or.inl (by simp)) + · exact Or.inr (Or.inr (Or.inr (by simp))) + refine ⟨?_, CellDisjointCommonEdgesBoundary T U hd⟩ + ext z + constructor + · rintro ⟨hzT, hzU⟩ + obtain ⟨i, hi⟩ := (incident T hT z).mp hzT + obtain ⟨j, hj⟩ := (incident U hU z).mp hzU + exact ⟨P3161T2IncidentBoundary T z ⟨i, hi⟩ + ⟨j, fun hh => Finset.disjoint_left.mp hd hh hj⟩, + P3161T2IncidentBoundary U z ⟨j, hj⟩ + ⟨i, fun hh => Finset.disjoint_left.mp hd hi hh⟩⟩ + · rintro ⟨hzT, hzU⟩ + exact ⟨boundary_raw T hT z hzT, boundary_raw U hU z hzU⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean b/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean new file mode 100644 index 0000000000..d70a269411 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean @@ -0,0 +1,613 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger +public import LeanPool.ApollonianSuperharmonic.P5253T1TopSquareContacts +public import LeanPool.ApollonianSuperharmonic.P5253T1LeftSquareContacts +public import LeanPool.ApollonianSuperharmonic.P5253T1BottomSquareContact +public import LeanPool.ApollonianSuperharmonic.P5253T1OneEdgeInterface +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween + +-- [TABLET NODE: P5290T1UnitContactPaths] + +/-! +# P5290T1UnitContactPaths + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace UnitContactProof + +private theorem makePath : + (Nat) → (∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + Finset.Nonempty T.cells → Finset.Nonempty U.cells → Disjoint T.cells U.cells → + BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = {a, b} → {a, b} ∈ + BoundaryFootprintEdges T → {a, b} ∈ BoundaryFootprintEdges U → b = a + (1 : GaussianInt) + ∨ b = a - (1 : GaussianInt) ∨ b = a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ b = a - ⟨(0 : ℤ), (1 : ℤ)⟩ → + Finset.Nonempty T.cells ∧ Finset.Nonempty U.cells ∧ Disjoint T.cells U.cells ∧ + SimpleGridPathBetween (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) + (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) a b) := by + classical + intro k T U a b hT hU hd hv heT heU ha + have interface := P5253T1OneEdgeInterface T U a b hT hU hd hv heT heU ha + have hab : a ≠ b := by + rcases ha with h | h | h | h <;> + intro he <;> rw [← he] at h <;> + have hr := congrArg Zsqrtd.re h <;> + have hi := congrArg Zsqrtd.im h <;> simp at hr hi <;> omega + have path : SimpleGridPathBetween + (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) + (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) a b := by + refine ⟨[a, b], by simp [hab], by simp, by simp, by simp, ?_, ?_, ?_⟩ + · rw [hv] + ext z + simp + · intro z w l₁ l₂ h + have llen := congrArg List.length h + simp only [List.length_cons, List.length_nil, List.length_append] at llen + have h₁ : l₁ = [] := List.eq_nil_of_length_eq_zero (by omega) + have h₂ : l₂ = [] := List.eq_nil_of_length_eq_zero (by omega) + subst l₁ + subst l₂ + simp only [List.nil_append, List.cons.injEq, and_true] at h + rcases h with ⟨rfl, rfl⟩ + exact ha + · intro e + constructor + · intro he + have he' : e = {a, b} := by + have : e ∈ ({{a, b}} : Set (Finset GaussianInt)) := by + rw [← interface.1] + exact he + simpa using this + subst e + exact ⟨a, b, [], [], rfl, rfl⟩ + · rintro ⟨z, w, l₁, l₂, h, he⟩ + have llen := congrArg List.length h + simp only [List.length_cons, List.length_nil, List.length_append] at llen + have h₁ : l₁ = [] := List.eq_nil_of_length_eq_zero (by omega) + have h₂ : l₂ = [] := List.eq_nil_of_length_eq_zero (by omega) + subst l₁ + subst l₂ + simp only [List.nil_append, List.cons.injEq, and_true] at h + rcases h with ⟨rfl, rfl⟩ + subst e + exact ⟨heT, heU⟩ + exact ⟨hT, hU, hd, path⟩ + +private theorem rightContact : + ∀ (k : Nat), ((0 : ℕ) < k) → (∀ (u : GaussianInt), ∀ (h : Int), (h = (k : Int) - 1 ∨ h = k) → ( + let D' := TileTranslation (DiamondTile k) u + let c := u + (⟨(k : Int), h⟩ : GaussianInt) + D'.cells.Nonempty ∧ Disjoint D'.cells {c} ∧ + BoundaryFootprintVertices D' ∩ + BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) = {c, c + ⟨0, 1⟩} ∧ + {c, c + ⟨0, 1⟩} ∈ BoundaryFootprintEdges D')) := by + classical + intro k hk u h hh + classical + dsimp only + let D' := TileTranslation (DiamondTile k) u + let c := u + (⟨(k : Int), h⟩ : GaussianInt) + have cell (z : GaussianInt) : z ∈ D'.cells ↔ + 0 ≤ (z - u).im ∧ (z - u).im < 2 * (k : Int) ∧ + -((z - u).im + 1) ≤ (z - u).re ∧ (z - u).re < (z - u).im + 1 ∧ + -(2 * (k : Int) - (z - u).im) ≤ (z - u).re ∧ + (z - u).re < 2 * (k : Int) - (z - u).im := by + rw [← (P4194T1DiamondCellRows k (z - u)).1] + change z ∈ (DiamondCellDomain k).image (GaussianTranslation u) ↔ _ + constructor + · rintro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hw + · intro hz + exact Finset.mem_image.mpr ⟨z - u, hz, by simp [GaussianTranslation]⟩ + have inside : c - 1 ∈ D'.cells := by + rw [cell] + simp only [c, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one] + rcases hh with rfl | rfl <;> omega + have outside : c ∉ D'.cells := by + rw [cell] + simp only [c, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] + rcases hh with rfl | rfl <;> omega + have hn : D'.cells.Nonempty := ⟨c - 1, inside⟩ + have edge : {c, c + ⟨0, 1⟩} ∈ BoundaryFootprintEdges D' := by + refine ⟨c, Or.inr ⟨rfl, Or.inr ⟨outside, ?_⟩⟩⟩ + simpa using inside + have no (v : GaussianInt) (hv : (v - u).re = (k : Int) + 1) : + v ∉ BoundaryFootprintVertices D' := by + simp only [Zsqrtd.re_sub] at hv + rw [(TileTranslationFormulas _ _).2.2.2.2.2.2.2.1] + rintro ⟨w, hw, heq⟩ + have hwv : w = v - u := (eq_sub_iff_add_eq).mpr heq + rw [hwv, (P4194T1DiamondVertexIncidence k hk (v - u)).2] at hw + obtain ⟨⟨j, hj⟩, _⟩ := hw + fin_cases j <;> + simp only [LatticeVertexIncidentCell, (P4194T1DiamondCellRows _ _).1, + ] at hj <;> + norm_num at hj <;> omega + have vertices : BoundaryFootprintVertices D' ∩ + BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) = + {c, c + ⟨0, 1⟩} := by + ext v + rw [Set.mem_inter_iff, (P5253T1SingletonBoundary c c).1] + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + constructor + · rintro ⟨hv, rfl | rfl | rfl | rfl⟩ + · exact Or.inl rfl + · have hc : ((c + 1 - u).re : Int) = (k : Int) + 1 := by + simp [c] + ring + exact False.elim (no _ hc hv) + · exact Or.inr rfl + · have hc : ((c + 1 + ⟨0, 1⟩ - u).re : Int) = (k : Int) + 1 := by + simp [c] + ring + exact False.elim (no _ hc hv) + · rintro (rfl | rfl) + · have hb : c ∈ BoundaryFootprintVertices D' := by + rw [BoundaryFootprintVertices, ite_eq_left hn] + exact ⟨_, edge, by simp⟩ + exact ⟨hb, by simp⟩ + · have hb : c + ⟨0, 1⟩ ∈ BoundaryFootprintVertices D' := by + rw [BoundaryFootprintVertices, ite_eq_left hn] + exact ⟨_, edge, by simp⟩ + exact ⟨hb, by simp⟩ + exact ⟨hn, Finset.disjoint_singleton_right.mpr outside, vertices, edge⟩ + +private theorem singletonPath : + (∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + (T.cells.Nonempty) → ((U.cells.Nonempty) → ((Disjoint T.cells U.cells) → + ((BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = {a, b}) → (({a, b} ∈ + BoundaryFootprintEdges T) → (({a, b} ∈ BoundaryFootprintEdges U) → ((b = a + 1 ∨ b = a - + 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → (T.cells.Nonempty ∧ U.cells.Nonempty ∧ Disjoint + T.cells U.cells ∧ SimpleGridPathBetween (BoundaryFootprintVertices T ∩ + BoundaryFootprintVertices U) (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) a + b)))))))) → (∀ (T : ProtoTile), ∀ (c : GaussianInt), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), Finset.Nonempty T.cells → Disjoint T.cells {c} → BoundaryFootprintVertices + T ∩ BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) = {a, b} → {a, b} ∈ + BoundaryFootprintEdges T → {a, b} ∈ BoundaryFootprintEdges (⟨{c}, c⟩ : ProtoTile) + → b = a + (1 : GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ b + = a - ⟨(0 : ℤ), (1 : ℤ)⟩ → Finset.Nonempty T.cells ∧ Finset.Nonempty (⟨{c}, c⟩ : + ProtoTile).cells ∧ Disjoint T.cells (⟨{c}, c⟩ : ProtoTile).cells ∧ + SimpleGridPathBetween (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices (⟨{c}, c⟩ + : ProtoTile)) (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges (⟨{c}, c⟩ : + ProtoTile)) a b) := by + classical + intro makePath T c a b hT hd hv heT heU ha + exact makePath T (⟨{c}, c⟩ : ProtoTile) a b hT (by simp) hd hv heT heU ha + +private theorem hTop' : + ∀ (k : Nat), + let D := DiamondTile k + let x0 : GaussianInt := ⟨0, 2 * (k : Int)⟩ + let y0 : GaussianInt := ⟨1, 2 * (k : Int)⟩ + (y0 = x0 + 1) → ((have D := TileTranslation (DiamondTile k) (0 : GaussianInt); have c := (0 : + GaussianInt) + ⟨(0 : ℤ), (2 : ℤ) * (↑k : ℤ)⟩; have U := (⟨{c}, c⟩ : ProtoTile); + Finset.Nonempty D.cells ∧ Disjoint D.cells U.cells ∧ BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices U = {c, c + (1 : GaussianInt)} ∧ {c, c + (1 : GaussianInt)} ∈ + BoundaryFootprintEdges D) → ((TileTranslation D 0 = D) → (D.cells.Nonempty ∧ Disjoint + D.cells {x0} ∧ BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (⟨{x0}, x0⟩ : + ProtoTile) = {x0, y0} ∧ {x0, y0} ∈ BoundaryFootprintEdges D))) := by + classical + intro k D x0 y0 hxy hTop transZero + have hc : (0 : GaussianInt) + ⟨0, 2 * (k : Int)⟩ = x0 := by + ext <;> simp [x0] + have hc1 : + ((0 : GaussianInt) + ⟨0, 2 * (k : Int)⟩) + 1 = y0 := by + ext <;> simp [y0] + simpa [D, transZero, hc, hc1, hxy] using hTop + +end UnitContactProof + +private def unitContactConclusion (k : Nat) (i : Fin 3) : Prop := + let M := P5260T1PlacementLedger k i false + let D := DiamondTile k + let W := M.1.1 + let Z := M.1.2 + let x := M.2.2.1 + let y := M.2.2.2 + let d : GaussianInt := if i = 0 then ⟨0, 1⟩ else -1 + let rows : List (ProtoTile × ProtoTile × GaussianInt × GaussianInt) := + [(D, W, x, y), (D, W, y, x), + (TileTranslation D M.2.1.1, W, x, x + d), + (TileTranslation D M.2.1.2, W, y, y + d), + (W, Z, y, y + d)] + (∀ T U a c, (T, U, a, c) ∈ rows → + T.cells.Nonempty ∧ U.cells.Nonempty ∧ Disjoint T.cells U.cells ∧ + SimpleGridPathBetween + (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) + (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) a c) ∧ + BoundaryFootprintVertices D ∩ BoundaryFootprintVertices W = {x, y} ∧ + BoundaryFootprintVertices W ∩ BoundaryFootprintVertices Z = {y, y + d} ∧ + (i = 1 → Z.cells.Nonempty ∧ D.cells.Nonempty ∧ Disjoint Z.cells D.cells ∧ + SimpleGridPathBetween + (BoundaryFootprintVertices Z ∩ BoundaryFootprintVertices D) + (BoundaryFootprintEdges Z ∩ BoundaryFootprintEdges D) y (y + ⟨0, 1⟩)) + +private theorem zeroUnitContacts (k : Nat) (hk : 0 < k) (hk1 : 1 < k) : + unitContactConclusion k 0 := by + classical + have makePath := UnitContactProof.makePath k + have rightContact := UnitContactProof.rightContact k hk + have singletonPath := UnitContactProof.singletonPath makePath + let M := P5260T1PlacementLedger k 0 false + let D := DiamondTile k + let W := M.1.1 + let Z := M.1.2 + let x := M.2.2.1 + let y := M.2.2.2 + let d : GaussianInt := if (0 : Fin 3) = 0 then ⟨0, 1⟩ else -1 + have hkPred : 0 < k - 1 := by omega + let x0 : GaussianInt := ⟨0, 2 * (k : Int)⟩ + let y0 : GaussianInt := ⟨1, 2 * (k : Int)⟩ + have hxy : y0 = x0 + 1 := by + ext <;> simp [x0, y0] + have sqEdges (c : GaussianInt) : + {c, c + 1} ∈ BoundaryFootprintEdges (⟨{c}, c⟩ : ProtoTile) ∧ + {c, c + ⟨0, 1⟩} ∈ BoundaryFootprintEdges (⟨{c}, c⟩ : ProtoTile) ∧ + {c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩} ∈ + BoundaryFootprintEdges (⟨{c}, c⟩ : ProtoTile) ∧ + {c + 1, c + 1 + ⟨0, 1⟩} ∈ + BoundaryFootprintEdges (⟨{c}, c⟩ : ProtoTile) := by + rw [(P5253T1SingletonBoundary c c).2] + simp [Finset.pair_comm] + have hTop := P5253T1TopSquareContacts k hk 0 0 (Or.inr rfl) + have transZero : TileTranslation D 0 = D := by + cases D with + | mk cells anchor => + have hf : GaussianTranslation 0 = id := by + funext z + simp [GaussianTranslation] + simp [TileTranslation, hf, Finset.image_id] + have hTop' : D.cells.Nonempty ∧ Disjoint D.cells {x0} ∧ + BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (⟨{x0}, x0⟩ : ProtoTile) = {x0, y0} ∧ + {x0, y0} ∈ BoundaryFootprintEdges D := UnitContactProof.hTop' k hxy hTop transZero + have hTopPath := singletonPath D x0 x0 y0 hTop'.1 hTop'.2.1 + hTop'.2.2.1 hTop'.2.2.2 (sqEdges x0).1 (Or.inl hxy) + have hTopPathRev := singletonPath D x0 y0 x0 hTop'.1 hTop'.2.1 + (by rw [hTop'.2.2.1]; ext z; simp [or_comm]) + (by simpa [Finset.pair_comm] using hTop'.2.2.2) + (by simpa [Finset.pair_comm, hxy] using (sqEdges x0).1) + (Or.inr (Or.inl (by rw [hxy]; abel))) + let r : GaussianInt := ⟨-(k : Int), (k : Int) + 1⟩ + have hrc : r + ⟨(k : Int), (k : Int) - 1⟩ = x0 := by + ext <;> simp [r, x0]; ring + have hRight := rightContact r ((k : Int) - 1) (Or.inl rfl) + have hRight' : + (TileTranslation D r).cells.Nonempty ∧ + Disjoint (TileTranslation D r).cells {x0} ∧ + BoundaryFootprintVertices (TileTranslation D r) ∩ + BoundaryFootprintVertices (⟨{x0}, x0⟩ : ProtoTile) = + {x0, x0 + ⟨0, 1⟩} ∧ + {x0, x0 + ⟨0, 1⟩} ∈ BoundaryFootprintEdges (TileTranslation D r) := by + simpa [D, r, hrc] using hRight + have hRightPath := singletonPath (TileTranslation D r) x0 x0 + (x0 + ⟨0, 1⟩) hRight'.1 hRight'.2.1 hRight'.2.2.1 hRight'.2.2.2 + (sqEdges x0).2.1 (Or.inr (Or.inr (Or.inl rfl))) + let l : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ + have hlc : l + ⟨-(k : Int) - 1, (k : Int)⟩ = x0 := by + ext <;> simp [l, x0]; ring + have hLeft := P5253T1LeftSquareContacts k hk l (k : Int) (Or.inr rfl) + have hLeft' : + (TileTranslation D l).cells.Nonempty ∧ + Disjoint (TileTranslation D l).cells {x0} ∧ + BoundaryFootprintVertices (TileTranslation D l) ∩ + BoundaryFootprintVertices (⟨{x0}, x0⟩ : ProtoTile) = + {y0, y0 + ⟨0, 1⟩} ∧ + {y0, y0 + ⟨0, 1⟩} ∈ BoundaryFootprintEdges (TileTranslation D l) := by + simpa [D, l, hlc, hxy] using hLeft + have hLeftPath := singletonPath (TileTranslation D l) x0 y0 + (y0 + ⟨0, 1⟩) hLeft'.1 hLeft'.2.1 hLeft'.2.2.1 hLeft'.2.2.2 + ((sqEdges x0).2.2.2) (Or.inr (Or.inr (Or.inl rfl))) + let t : GaussianInt := ⟨(k : Int), (k : Int) + 1⟩ + have htc : t + ⟨-((k - 1 : Nat) : Int) - 1, ((k - 1 : Nat) : Int)⟩ = x0 := by + ext <;> simp [t, x0] <;> omega + have hPred := P5253T1LeftSquareContacts (k - 1) hkPred t + ((k - 1 : Nat) : Int) (Or.inr rfl) + have hPred' : + (TileTranslation (DiamondTile (k - 1)) t).cells.Nonempty ∧ + Disjoint (TileTranslation (DiamondTile (k - 1)) t).cells {x0} ∧ + BoundaryFootprintVertices (TileTranslation (DiamondTile (k - 1)) t) ∩ + BoundaryFootprintVertices (⟨{x0}, x0⟩ : ProtoTile) = + {y0, y0 + ⟨0, 1⟩} ∧ + {y0, y0 + ⟨0, 1⟩} ∈ + BoundaryFootprintEdges (TileTranslation (DiamondTile (k - 1)) t) := by + simpa [t, htc, hxy] using hPred + have hPredPath := makePath (⟨{x0}, x0⟩ : ProtoTile) + (TileTranslation (DiamondTile (k - 1)) t) y0 (y0 + ⟨0, 1⟩) + (by simp) hPred'.1 hPred'.2.1.symm + (by rw [Set.inter_comm]; exact hPred'.2.2.1) + (sqEdges x0).2.2.2 hPred'.2.2.2 + (Or.inr (Or.inr (Or.inl rfl))) + refine ⟨?_, ?_, ?_, ?_⟩ + · intro T U a b hmem + simp? [P5260T1PlacementLedger, + P5124T1ParentModel] at hmem + rcases hmem with hmem | hmem | hmem | hmem | hmem + · rcases hmem with ⟨rfl, rfl, rfl, rfl⟩ + simpa [D, x0, y0] using hTopPath + · rcases hmem with ⟨rfl, rfl, rfl, rfl⟩ + simpa [D, x0, y0] using hTopPathRev + · rcases hmem with ⟨rfl, rfl, rfl, rfl⟩ + simpa [D, r, x0] using hRightPath + · rcases hmem with ⟨rfl, rfl, rfl, rfl⟩ + simpa [D, l, x0, y0] using hLeftPath + · rcases hmem with ⟨rfl, rfl, rfl, rfl⟩ + simpa [x0, y0, t] using hPredPath + · simpa [M, W, Z, x, y, d, D, x0, y0, P5260T1PlacementLedger, + P5124T1ParentModel] using hTop'.2.2.1 + · simpa [M, W, Z, x, y, d, t, x0, y0, P5260T1PlacementLedger, + P5124T1ParentModel, Set.inter_comm] using hPred'.2.2.1 + · simp + +private theorem singletonSquareEdges (c : GaussianInt) : + {c, c + 1} ∈ BoundaryFootprintEdges (⟨{c}, c⟩ : ProtoTile) ∧ + {c, c + ⟨0, 1⟩} ∈ BoundaryFootprintEdges (⟨{c}, c⟩ : ProtoTile) ∧ + {c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩} ∈ + BoundaryFootprintEdges (⟨{c}, c⟩ : ProtoTile) ∧ + {c + 1, c + 1 + ⟨0, 1⟩} ∈ + BoundaryFootprintEdges (⟨{c}, c⟩ : ProtoTile) := by + rw [(P5253T1SingletonBoundary c c).2] + simp [Finset.pair_comm] + +private theorem tileTranslationZero (T : ProtoTile) : TileTranslation T 0 = T := by + cases T with + | mk cells anchor => + have hf : GaussianTranslation 0 = id := by + funext z + simp [GaussianTranslation] + simp [TileTranslation, hf, Finset.image_id] + +private theorem oneUnitContacts (k : Nat) (hk : 0 < k) : + unitContactConclusion k 1 := by + classical + have makePath := UnitContactProof.makePath k + have rightContact := UnitContactProof.rightContact k hk + have singletonPath := UnitContactProof.singletonPath makePath + let M := P5260T1PlacementLedger k 1 false + let D := DiamondTile k + let W := M.1.1 + let Z := M.1.2 + let x := M.2.2.1 + let y := M.2.2.2 + let d : GaussianInt := if (1 : Fin 3) = 0 then ⟨0, 1⟩ else -1 + have hW : W = (⟨{(⟨-(k : Int) - 1, (k : Int) - 1⟩ : GaussianInt)}, + ⟨-(k : Int) - 1, (k : Int) - 1⟩⟩ : ProtoTile) := by + simp [W, M, P5260T1PlacementLedger, P5124T1ParentModel] + have hZ : Z = (⟨{(⟨-(k : Int) - 1, (k : Int)⟩ : GaussianInt)}, + ⟨-(k : Int) - 1, (k : Int)⟩⟩ : ProtoTile) := by + simp [Z, M, P5260T1PlacementLedger, P5124T1ParentModel] + have hx : x = (⟨-(k : Int), (k : Int) - 1⟩ : GaussianInt) := by + simp [x, M, P5260T1PlacementLedger] + have hy : y = (⟨-(k : Int), (k : Int)⟩ : GaussianInt) := by + simp [y, M, P5260T1PlacementLedger] + let x1 : GaussianInt := ⟨-(k : Int), (k : Int) - 1⟩ + let y1 : GaussianInt := ⟨-(k : Int), (k : Int)⟩ + let c1 : GaussianInt := ⟨-(k : Int) - 1, (k : Int) - 1⟩ + have hxy : y1 = x1 + ⟨0, 1⟩ := by + ext <;> simp [x1, y1] + have sqEdges1 := singletonSquareEdges + have transZero := tileTranslationZero D + have hLeftDW := P5253T1LeftSquareContacts k hk 0 + ((k : Int) - 1) (Or.inl rfl) + have hcLeft : (0 : GaussianInt) + ⟨-(k : Int) - 1, + (k : Int) - 1⟩ = c1 := by + ext <;> simp [c1] + have hcLeft1 : c1 + 1 = x1 := by + ext <;> simp [c1, x1] + have hcLeft2 : c1 + 1 + ⟨0, 1⟩ = y1 := by + ext <;> simp [c1, y1] + have hLeftDW' : D.cells.Nonempty ∧ Disjoint D.cells {c1} ∧ + BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (⟨{c1}, c1⟩ : ProtoTile) = {x1, y1} ∧ + {x1, y1} ∈ BoundaryFootprintEdges D := by + simpa only [D, transZero, hcLeft, hcLeft1, hcLeft2, hxy] using hLeftDW + have hDWPath := singletonPath D c1 x1 y1 hLeftDW'.1 hLeftDW'.2.1 + hLeftDW'.2.2.1 hLeftDW'.2.2.2 + (by simpa [hcLeft1, hcLeft2, hxy] using (sqEdges1 c1).2.2.2) + (Or.inr (Or.inr (Or.inl hxy))) + have hDWPathRev := singletonPath D c1 y1 x1 hLeftDW'.1 hLeftDW'.2.1 + (by rw [hLeftDW'.2.2.1]; ext z; simp [or_comm]) + (by simpa [Finset.pair_comm] using hLeftDW'.2.2.2) + (by simpa [hcLeft1, hcLeft2, hxy, Finset.pair_comm] using (sqEdges1 c1).2.2.2) + (Or.inr (Or.inr (Or.inr (by rw [hxy]; abel)))) + let r1 : GaussianInt := ⟨-(k : Int), -(k : Int) - 1⟩ + have hr1c : r1 + ⟨-1, 2 * (k : Int)⟩ = c1 := by + ext <;> simp [r1, c1] <;> ring + have hTopR := P5253T1TopSquareContacts k hk r1 (-1) (Or.inl rfl) + have hTopRPair : ({c1, x1} : Set GaussianInt) = {x1, c1} := by + ext z + simp [or_comm] + have hTopRFinsetPair : ({c1, x1} : Finset GaussianInt) = {x1, c1} := by + ext z + simp [or_comm] + have hTopR' : (TileTranslation D r1).cells.Nonempty ∧ + Disjoint (TileTranslation D r1).cells {c1} ∧ + BoundaryFootprintVertices (TileTranslation D r1) ∩ + BoundaryFootprintVertices (⟨{c1}, c1⟩ : ProtoTile) = {x1, c1} ∧ + {x1, c1} ∈ BoundaryFootprintEdges (TileTranslation D r1) := by + simpa [D, r1, hr1c, hcLeft1, hTopRPair, hTopRFinsetPair] using hTopR + have hTopRPath := singletonPath (TileTranslation D r1) c1 x1 c1 + hTopR'.1 hTopR'.2.1 hTopR'.2.2.1 hTopR'.2.2.2 + (by simpa [hcLeft1, Finset.pair_comm] using (sqEdges1 c1).1) + (Or.inr (Or.inl (by rw [← hcLeft1]; abel))) + let l1 : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + have hl1c : l1 - ⟨0, 1⟩ = c1 := by + ext <;> simp [l1, c1] + have hc1prev : c1 = x1 - 1 := by + rw [← hcLeft1] + abel + have hxprevC1 : x1 - 1 = c1 := hc1prev.symm + have hxaddC1 : x1 + (-1 : GaussianInt) = c1 := by + simpa only [sub_eq_add_neg] using hxprevC1 + have hBottomL := P5253T1BottomSquareContact k hk l1 + have hBottomL' : (TileTranslation D l1).cells.Nonempty ∧ + Disjoint (TileTranslation D l1).cells {c1} ∧ + BoundaryFootprintVertices (TileTranslation D l1) ∩ + BoundaryFootprintVertices (⟨{c1}, c1⟩ : ProtoTile) = + {y1 - 1, y1} ∧ + {y1 - 1, y1} ∈ BoundaryFootprintEdges (TileTranslation D l1) := by + have hyedge : l1 = y1 - 1 := by + ext <;> simp [l1, y1] + have hcBottom : (y1 - 1) - ⟨0, 1⟩ = c1 := by + ext <;> simp [c1, y1] + simpa [D, l1, hl1c, hyedge, hcBottom] using hBottomL + have hBottomPath := singletonPath (TileTranslation D l1) c1 y1 (y1 - 1) + hBottomL'.1 hBottomL'.2.1 + (by calc + _ = {y1 - 1, y1} := hBottomL'.2.2.1 + _ = {y1, y1 - 1} := by ext z; simp [or_comm]) + (by simpa [Finset.pair_comm] using hBottomL'.2.2.2) + (by + have hc1i : c1 + ⟨0, 1⟩ = y1 - 1 := by + ext <;> simp [c1, y1] + have hc1i1 : c1 + 1 + ⟨0, 1⟩ = y1 := hcLeft2 + simpa [hc1i, hc1i1, Finset.pair_comm] using (sqEdges1 c1).2.2.1) + (Or.inr (Or.inl rfl)) + have c1ne : c1 ≠ c1 + ⟨0, 1⟩ := by + intro h + have hi := congrArg Zsqrtd.im h + simp [c1] at hi + have hPairDisj : Disjoint ({c1} : Finset GaussianInt) {c1 + ⟨0, 1⟩} := by + exact Finset.disjoint_singleton.mpr c1ne + have hPairVertices : + BoundaryFootprintVertices (⟨{c1}, c1⟩ : ProtoTile) ∩ + BoundaryFootprintVertices (⟨{c1 + ⟨0, 1⟩}, c1 + ⟨0, 1⟩⟩ : ProtoTile) = + {y1 - 1, y1} := by + rw [(P5253T1SingletonBoundary c1 c1).1, + (P5253T1SingletonBoundary (c1 + ⟨0, 1⟩) (c1 + ⟨0, 1⟩)).1] + ext z + rcases z with ⟨a, b⟩ + simp [c1, y1, Set.mem_insert_iff, Set.mem_singleton_iff, + Zsqrtd.ext_iff]; omega + have hPairSwap : ({y1 - 1, y1} : Set GaussianInt) = {y1, y1 - 1} := by + ext z + simp [or_comm] + have hPairEdgeLeft : {y1 - 1, y1} ∈ + BoundaryFootprintEdges (⟨{c1}, c1⟩ : ProtoTile) := by + have hc1i : c1 + ⟨0, 1⟩ = y1 - 1 := by + ext <;> simp [c1, y1] + have hc1i1 : c1 + 1 + ⟨0, 1⟩ = y1 := by + ext <;> simp [c1, y1] + simpa [hc1i, hc1i1, Finset.pair_comm] using (sqEdges1 c1).2.2.1 + have hPairEdgeRight : {y1 - 1, y1} ∈ + BoundaryFootprintEdges (⟨{c1 + ⟨0, 1⟩}, c1 + ⟨0, 1⟩⟩ : ProtoTile) := by + have hc1i : c1 + ⟨0, 1⟩ + 1 = y1 := by + ext <;> simp [c1, y1] + have hc1i' : c1 + ⟨0, 1⟩ = y1 - 1 := by + ext <;> simp [c1, y1] + simpa [hc1i, hc1i', Finset.pair_comm] using + (sqEdges1 (c1 + ⟨0, 1⟩)).1 + have hPairPath := makePath (⟨{c1}, c1⟩ : ProtoTile) + (⟨{c1 + ⟨0, 1⟩}, c1 + ⟨0, 1⟩⟩ : ProtoTile) y1 (y1 - 1) + (by simp) (by simp) hPairDisj + (by calc + _ = {y1 - 1, y1} := hPairVertices + _ = {y1, y1 - 1} := by ext z; simp [or_comm]) + (by simpa [Finset.pair_comm] using hPairEdgeLeft) + (by simpa [Finset.pair_comm] using hPairEdgeRight) + (Or.inr (Or.inl rfl)) + let z1 : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ + have hPairBase : c1 + ⟨0, 1⟩ = z1 := by + ext <;> simp [c1, z1] + have hPairBaseCoord : + (⟨-(k : Int) - 1, (k : Int) - 1⟩ : GaussianInt) + ⟨0, 1⟩ = + ⟨-(k : Int) - 1, (k : Int)⟩ := by + ext <;> simp + have hLeftZD := P5253T1LeftSquareContacts k hk 0 (k : Int) (Or.inr rfl) + have hz1a : z1 + 1 = y1 := by + ext <;> simp [z1, y1] + have hz1b : z1 + 1 + ⟨0, 1⟩ = y1 + ⟨0, 1⟩ := by + rw [hz1a] + have hLeftZD' : D.cells.Nonempty ∧ Disjoint D.cells {z1} ∧ + BoundaryFootprintVertices D ∩ + BoundaryFootprintVertices (⟨{z1}, z1⟩ : ProtoTile) = + {y1, y1 + ⟨0, 1⟩} ∧ + {y1, y1 + ⟨0, 1⟩} ∈ BoundaryFootprintEdges D := by + simpa [D, transZero, z1, y1, hz1a, hz1b, hx, hy] using hLeftZD + have hZDPath := makePath (⟨{z1}, z1⟩ : ProtoTile) D y1 + (y1 + ⟨0, 1⟩) (by simp) hLeftZD'.1 hLeftZD'.2.1.symm + (by rw [Set.inter_comm]; exact hLeftZD'.2.2.1) + (by simpa [z1, y1, hz1a, hz1b, Finset.pair_comm] using (sqEdges1 z1).2.2.2) + hLeftZD'.2.2.2 + (Or.inr (Or.inr (Or.inl rfl))) + refine ⟨?_, ?_, ?_, ?_⟩ + · intro T U a b hmem + simp? [P5260T1PlacementLedger, + P5124T1ParentModel] at hmem + rcases hmem with hmem | hmem | hmem | hmem | hmem + · rcases hmem with ⟨rfl, rfl, rfl, rfl⟩ + simpa [D, c1, x1, y1] using hDWPath + · rcases hmem with ⟨rfl, rfl, rfl, rfl⟩ + simpa [D, c1, x1, y1] using hDWPathRev + · rcases hmem with ⟨rfl, rfl, rfl, rfl⟩ + simpa only [D, r1, c1, x1, hxaddC1] using hTopRPath + · rcases hmem with ⟨rfl, rfl, rfl, rfl⟩ + simpa only [D, l1, c1, y1, sub_eq_add_neg] using hBottomPath + · rcases hmem with ⟨rfl, rfl, rfl, rfl⟩ + simpa [c1, y1, hPairBaseCoord, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hPairPath + · simpa [M, W, Z, x, y, d, D, c1, x1, y1, + P5260T1PlacementLedger, P5124T1ParentModel] using hLeftDW'.2.2.1 + · change BoundaryFootprintVertices W ∩ BoundaryFootprintVertices Z = {y, y + d} + simpa [hW, hZ, hy, d, c1, y1, hPairBaseCoord, sub_eq_add_neg] using + hPairVertices.trans hPairSwap + · intro _ + simpa [M, W, Z, x, y, d, D, z1, y1, P5260T1PlacementLedger, + P5124T1ParentModel] using hZDPath + +theorem P5290T1UnitContactPaths (k : Nat) (hk : 0 < k) + (i : Fin 3) (hi : i ≠ 2) (hreg : 1 < k ∨ i = 1) : + let M := P5260T1PlacementLedger k i false + let D := DiamondTile k + let W := M.1.1 + let Z := M.1.2 + let x := M.2.2.1 + let y := M.2.2.2 + let d : GaussianInt := if i = 0 then ⟨0, 1⟩ else -1 + let rows : List (ProtoTile × ProtoTile × GaussianInt × GaussianInt) := + [(D, W, x, y), (D, W, y, x), + (TileTranslation D M.2.1.1, W, x, x + d), + (TileTranslation D M.2.1.2, W, y, y + d), + (W, Z, y, y + d)] + (∀ T U a c, (T, U, a, c) ∈ rows → + T.cells.Nonempty ∧ U.cells.Nonempty ∧ Disjoint T.cells U.cells ∧ + SimpleGridPathBetween + (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) + (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) a c) ∧ + BoundaryFootprintVertices D ∩ BoundaryFootprintVertices W = {x, y} ∧ + BoundaryFootprintVertices W ∩ BoundaryFootprintVertices Z = {y, y + d} ∧ + (i = 1 → Z.cells.Nonempty ∧ D.cells.Nonempty ∧ Disjoint Z.cells D.cells ∧ + SimpleGridPathBetween + (BoundaryFootprintVertices Z ∩ BoundaryFootprintVertices D) + (BoundaryFootprintEdges Z ∩ BoundaryFootprintEdges D) y (y + ⟨0, 1⟩)) := by +-- BODY + change unitContactConclusion k i + have hi01 : i = 0 ∨ i = 1 := by + fin_cases i <;> simp_all + rcases hi01 with h0 | h1 + · subst i + apply zeroUnitContacts k hk + rcases hreg with h | h + · exact h + · cases h + · subst i + exact oneUnitContacts k hk + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5300T1AffineCellObservables.lean b/LeanPool/ApollonianSuperharmonic/P5300T1AffineCellObservables.lean new file mode 100644 index 0000000000..b472a68f51 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5300T1AffineCellObservables.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas + +-- [TABLET NODE: P5300T1AffineCellObservables] + +/-! +# P5300T1AffineCellObservables + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5300T1AffineCellObservables (T V : ProtoTile) + (a C : GaussianInt) (neg : Bool) (hne : T.cells.Nonempty) + (hc : V.cells = T.cells.image (fun z => + a + (if neg then C - z - 1 - ⟨0, 1⟩ else z))) : + let f := fun z : GaussianInt => a + (if neg then C - z else z) + FootprintVertices V = f '' FootprintVertices T ∧ + FootprintEdges V = + (fun e : Finset GaussianInt => e.image f) '' FootprintEdges T := by +-- BODY + classical + let R := if neg then TileQuarterTurn (TileQuarterTurn T) else T + let d := if neg then a + C else a + let B := TileTranslation R d + have hb : B.cells = T.cells.image (fun z => + a + (if neg then C - z - 1 - ⟨0, 1⟩ else z)) := by + cases neg <;> + simp only [B, R, d, Bool.false_eq_true, ite_false, ite_true, TileTranslation, + TileQuarterTurn, Finset.image_image, Function.comp_def] + · congr 1 + funext z + simp [GaussianTranslation, add_comm] + · congr 1 + funext z + ext <;> simp [GaussianTranslation, GaussianQuarterTurn] <;> ring + have hVB : V.cells = B.cells := hc.trans hb.symm + have hnV : V.cells.Nonempty := by rw [hc]; exact hne.image _ + have hv := (ProtoTileObservableExtensionality V B hVB + (by intro he; exact (hnV.ne_empty he).elim)).1 + have he : FootprintEdges V = FootprintEdges B := by + unfold FootprintEdges + rw [hVB] + dsimp only + rw [hv, he] + cases neg + · change FootprintVertices (TileTranslation T a) = + (fun z => a + z) '' FootprintVertices T ∧ + FootprintEdges (TileTranslation T a) = + (fun e => e.image (fun z => a + z)) '' FootprintEdges T + constructor + · rw [(TileTranslationFormulas T a).2.2.2.2.2.1] + congr 1 + funext z + exact add_comm z a + · rw [(TileTranslationFormulas T a).2.2.2.2.2.2.1] + congr 1 + funext e + congr 1 + funext z + exact add_comm z a + · change FootprintVertices + (TileTranslation (TileQuarterTurn (TileQuarterTurn T)) (a + C)) = _ ∧ + FootprintEdges + (TileTranslation (TileQuarterTurn (TileQuarterTurn T)) (a + C)) = _ + have qv (S : ProtoTile) := (TileQuarterTurnFormulas S).2.2.2.2.2.1 + have qe (S : ProtoTile) := (TileQuarterTurnFormulas S).2.2.2.2.2.2.1 + constructor + · rw [(TileTranslationFormulas _ _).2.2.2.2.2.1, qv, qv, + Set.image_image, Set.image_image] + congr 1 + funext z + ext <;> simp [GaussianTranslation, GaussianQuarterTurn] <;> ring + · rw [(TileTranslationFormulas _ _).2.2.2.2.2.2.1, qe, qe, + Set.image_image, Set.image_image] + congr 1 + funext e + simp only [Finset.image_image, Function.comp_def] + congr 1 + funext z + ext <;> simp [GaussianTranslation, GaussianQuarterTurn] <;> ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5300T1CanonicalRowArithmetic.lean b/LeanPool/ApollonianSuperharmonic/P5300T1CanonicalRowArithmetic.lean new file mode 100644 index 0000000000..048ae0c333 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5300T1CanonicalRowArithmetic.lean @@ -0,0 +1,198 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger +public import LeanPool.ApollonianSuperharmonic.P5124T1ParentPlacement +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCentroid + +-- [TABLET NODE: P5300T1CanonicalRowArithmetic] + +/-! +# P5300T1CanonicalRowArithmetic + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5300T1CanonicalRowArithmetic (K : DiamondParameter) + (i : Fin 3) (s : Fin 4) + (hp : 0 < ((DiamondRecursiveQuadruple K) i.succ).1) + (hj : 0 < ((DiamondRecursiveQuadruple K) + ((if Even s.val then i - 1 else i + 1).succ)).1) : + let q := DiamondRecursiveQuadruple K + let b : Bool := decide (s.val % 2 = 1) + let j := if Even s.val then i - 1 else i + 1 + let M := P5260T1PlacementLedger K.1 i b + let C : GaussianInt := ⟨0, 2 * (K.1 : Int)⟩ + let c : Fin 3 → GaussianInt := + ![⟨1, 4 * (K.1 : Int) + 1⟩, + ⟨-2 * (K.1 : Int) - 1, 2 * (K.1 : Int) - 1⟩, + ⟨2 * (K.1 : Int), 0⟩] + let P := fun t => P5124T1ParentModel K.1 t true + (1 < K.1 ∨ (i = 1 ∧ b = false) ∨ (i = 0 ∧ b = true)) ∧ + (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) = + (if s.val < 2 then M.2.1.1 else -M.2.1.1) ∧ + (⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q i.succ) (q 0) + else BandVectors.1 (q 0) (q i.succ)) = + (if s.val < 2 then M.2.1.2 else -M.2.1.2) ∧ + ∃ tW tZ : GaussianInt, + M.1.1.cells = (TileTranslation (P i) tW).cells ∧ + M.1.2.cells = (TileTranslation (P j) tZ).cells ∧ + TileCentroid (TileTranslation (P i) + (if s.val < 2 then tW else C - tW - c i)) - + TileCentroid (DiamondTile K.1) = + (1 / 2 : Real) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) ∧ + TileCentroid (TileTranslation (P j) + (if s.val < 2 then tZ else C - tZ - c j)) - + TileCentroid (DiamondTile K.1) = + (1 / 2 : Real) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then + BandVectors.1 (q 0) (q (i - 1).succ) - + BandVectors.1 (q (i - 1).succ) (q 0) + else BandVectors.1 (q (i + 1).succ) (q 0) - + BandVectors.1 (q 0) (q (i + 1).succ))) := by +-- BODY + classical + dsimp only + let q := DiamondRecursiveQuadruple K + let b : Bool := decide (s.val % 2 = 1) + let j : Fin 3 := if Even s.val then i - 1 else i + 1 + let M := P5260T1PlacementLedger K.1 i b + let C : GaussianInt := ⟨0, 2 * (K.1 : Int)⟩ + let c : Fin 3 → GaussianInt := + ![⟨1, 4 * (K.1 : Int) + 1⟩, + ⟨-2 * (K.1 : Int) - 1, 2 * (K.1 : Int) - 1⟩, + ⟨2 * (K.1 : Int), 0⟩] + let P := fun t => P5124T1ParentModel K.1 t true + let tW : GaussianInt := if b then + ![⟨-(K.1 : Int) - 1, -(K.1 : Int)⟩, + ⟨(K.1 : Int) + 1, -(K.1 : Int)⟩, ⟨0, 2 * (K.1 : Int)⟩] i else 0 + let tZ : GaussianInt := if b then 0 else + ![⟨0, 2 * (K.1 : Int)⟩, ⟨-(K.1 : Int) - 1, -(K.1 : Int)⟩, + ⟨(K.1 : Int) + 1, -(K.1 : Int)⟩] i + have hk : 1 ≤ K.1 := K.2 + obtain ⟨_, hproper, hv0, hv1, hv2, _⟩ := DiamondCoordinateConfiguration K + have flip := (VectorRecursionLaws _ hproper.1).2.2.2.2 hproper + have hv (t : Fin 3) : BandVectors.1 ((DiamondRecursiveQuadruple K) t.succ) + ((DiamondRecursiveQuadruple K) 0) = + ![⟨(K.1 : Int) + 1, (K.1 : Int)⟩, + ⟨-(K.1 : Int) - 1, (K.1 : Int)⟩, + ⟨0, -2 * (K.1 : Int)⟩] t := by + fin_cases t + · exact hv0 + · exact hv1 + · exact hv2 + have hv' (t : Fin 3) : BandVectors.1 ((DiamondRecursiveQuadruple K) 0) + ((DiamondRecursiveQuadruple K) t.succ) = + ![⟨-(K.1 : Int), (K.1 : Int) + 1⟩, + ⟨-(K.1 : Int), -(K.1 : Int) - 1⟩, + ⟨2 * (K.1 : Int), 0⟩] t := by + rw [(flip t).1, hv] + fin_cases t <;> ext <;> simp [Zsqrtd.re_mul, Zsqrtd.im_mul] + have centroid (n : Nat) : TileCentroid (DiamondTile n) = (0, (n : Real)) := by + by_cases hn : 0 < n + · exact P4194T1DiamondCentroid n hn + · have : n = 0 := by omega + subst n + simp [DiamondTile, DiamondCellDomain, TileCentroid] + have singleton (z : GaussianInt) : TileCentroid (⟨{z}, z⟩ : ProtoTile) = + ((z.re : Real) + 1 / 2, (z.im : Real) + 1 / 2) := by + simp [TileCentroid] + have ht (T : ProtoTile) (v : GaussianInt) := + (TileTranslationFormulas T v).2.2.2.2.1 + have hpc (t : Fin 3) : TileCentroid (P t) = + ![((1 / 2 : Real), 2 * (K.1 : Real) + 1 / 2), + (-(K.1 : Real) - 1 / 2, (K.1 : Real) - 1 / 2), + ((K.1 : Real), 0)] t := by + fin_cases t <;> + simp? [P, P5124T1ParentModel, singleton, ht, centroid, Nat.cast_sub hk]; + first | (constructor <;> ring) + have image_add (A : Finset GaussianInt) (u v : GaussianInt) : + (A.image (GaussianTranslation u)).image (GaussianTranslation v) = + A.image (GaussianTranslation (u + v)) := by + rw [Finset.image_image] + congr 1 + funext x + simp [GaussianTranslation, add_assoc] + have hI2 : (⟨0, 1⟩ : GaussianInt) ^ 2 = -1 := by + norm_num [pow_two, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul] + have hI3 : (⟨0, 1⟩ : GaussianInt) ^ 3 = -⟨0, 1⟩ := by + rw [pow_succ, hI2] + simp + have hp0 : (0 : Fin 3) - 1 = 2 := by decide + have hp1 : (1 : Fin 3) - 1 = 0 := by decide + have hp2 : (2 : Fin 3) - 1 = 1 := by decide + have hn0 : (0 : Fin 3) + 1 = 1 := by decide + have hn1 : (1 : Fin 3) + 1 = 2 := by decide + have hn2 : (2 : Fin 3) + 1 = 0 := by decide + refine ⟨?_, ?_, ?_, tW, tZ, ?_, ?_, ?_, ?_⟩ + · by_cases h : 1 < K.1 + · exact Or.inl h + · have heq : K.1 = 1 := by omega + fin_cases i <;> fin_cases s <;> + simp_all [DiamondRecursiveQuadruple, Nat.even_iff, + ] + · simp only [hv, hv'] + fin_cases i <;> fin_cases s <;> + norm_num [P5260T1PlacementLedger, Nat.even_iff, Zsqrtd.ext_iff, + hI2, hI3, Zsqrtd.re_mul, Zsqrtd.im_mul] + · simp only [hv, hv'] + fin_cases i <;> fin_cases s <;> + norm_num [P5260T1PlacementLedger, Nat.even_iff, Zsqrtd.ext_iff, + hI2, hI3, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> + first | ring1 + · change M.1.1.cells = (TileTranslation (P i) tW).cells + fin_cases i <;> fin_cases s <;> + simp? [M, b, P, tW, P5260T1PlacementLedger, P5124T1ParentModel, + TileTranslation, GaussianTranslation, image_add, Zsqrtd.ext_iff] <;> + ring + · change M.1.2.cells = (TileTranslation (P j) tZ).cells + fin_cases i <;> fin_cases s <;> + simp? [M, b, P, j, tZ, P5260T1PlacementLedger, P5124T1ParentModel, + TileTranslation, GaussianTranslation, image_add, Nat.even_iff, + hp0, hp2, hn0, hn1, hn2, + Zsqrtd.ext_iff] <;> + ring + · change TileCentroid (TileTranslation (P i) + (if s.val < 2 then tW else C - tW - c i)) - + TileCentroid (DiamondTile K.1) = _ + rw [ht, hpc, centroid] + simp only [hv, hv'] + fin_cases i <;> fin_cases s <;> + norm_num [tW, b, C, c, GaussianRealPoint, Prod.ext_iff, hI2, hI3, + GaussianInt.toComplex_def, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> + first | ring1 | (constructor <;> ring1) + · change TileCentroid (TileTranslation (P j) + (if s.val < 2 then tZ else C - tZ - c j)) - + TileCentroid (DiamondTile K.1) = _ + rw [ht, hpc, centroid] + simp only [hv, hv'] + fin_cases i <;> fin_cases s <;> + norm_num [j, Nat.even_iff, hp0, hp1, hp2, hn0, hn1, hn2, + Matrix.cons_val_two, Matrix.vecHead, Matrix.vecTail] + all_goals + norm_num [tZ, b, C, c, GaussianRealPoint, Prod.ext_iff, hI2, hI3, + GaussianInt.toComplex_def, Zsqrtd.re_mul, Zsqrtd.im_mul, + -GaussianInt.intCast_re, -GaussianInt.intCast_im, + hp0, hp1, hp2, hn0, hn1, hn2, Matrix.cons_val_two, + Matrix.vecHead, Matrix.vecTail, Fin.add_def, Fin.sub_def]; + first | ring1 | (constructor <;> ring1) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5300T1CenteredCellGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5300T1CenteredCellGeometry.lean new file mode 100644 index 0000000000..a8aa13488d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5300T1CenteredCellGeometry.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5124T1ParentModel +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows +public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple + +-- [TABLET NODE: P5300T1CenteredCellGeometry] + +/-! +# P5300T1CenteredCellGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5300T1CenteredCellGeometry (K : DiamondParameter) : + let k := K.1 + let C : GaussianInt := ⟨0, 2 * (k : Int)⟩ + let c : Fin 3 → GaussianInt := + ![⟨1, 4 * (k : Int) + 1⟩, + ⟨-2 * (k : Int) - 1, 2 * (k : Int) - 1⟩, + ⟨2 * (k : Int), 0⟩] + (DiamondTile k).cells.Nonempty ∧ + (DiamondTile k).cells.image (fun z => C - z - 1 - ⟨0, 1⟩) = + (DiamondTile k).cells ∧ + ∀ t : Fin 3, 0 < ((DiamondRecursiveQuadruple K) t.succ).1 → + let P := P5124T1ParentModel k t true + P.cells.Nonempty ∧ + P.cells.image (fun z => c t - z - 1 - ⟨0, 1⟩) = P.cells := by +-- BODY + classical + have diamond (m : Nat) : + (DiamondTile m).cells.image + (fun z => (⟨0, 2 * (m : Int)⟩ : GaussianInt) - z - 1 - ⟨0, 1⟩) = + (DiamondTile m).cells := by + have mem (z : GaussianInt) : z ∈ DiamondCellDomain m ↔ + (⟨0, 2 * (m : Int)⟩ : GaussianInt) - z - 1 - ⟨0, 1⟩ ∈ + DiamondCellDomain m := by + rw [(P4194T1DiamondCellRows m z).1, + (P4194T1DiamondCellRows m _).1] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + omega + change (DiamondCellDomain m).image _ = DiamondCellDomain m + ext z + simp only [Finset.mem_image] + constructor + · rintro ⟨x, hx, rfl⟩ + exact (mem x).mp hx + · intro hz + refine ⟨(⟨0, 2 * (m : Int)⟩ : GaussianInt) - z - 1 - ⟨0, 1⟩, + (mem z).mp hz, ?_⟩ + abel + have nonempty (m : Nat) (hm : 0 < m) : (DiamondTile m).cells.Nonempty := by + refine ⟨0, (P4194T1DiamondCellRows m 0).1.mpr ?_⟩ + norm_num + omega + dsimp only + refine ⟨nonempty K.1 K.2, diamond K.1, ?_⟩ + intro t hp + fin_cases t + · constructor + · simp [P5124T1ParentModel] + · simp [P5124T1ParentModel, Zsqrtd.ext_iff] + ring + · constructor + · simp [P5124T1ParentModel] + · simp [P5124T1ParentModel, Zsqrtd.ext_iff] + constructor <;> ring + · have hm : 0 < K.1 - 1 := by + simp [DiamondRecursiveQuadruple] at hp + by_contra hn + have hz : K.1 - 1 = 0 := by omega + simp [hz] at hp + constructor + · exact (nonempty (K.1 - 1) hm).image _ + · change ((DiamondTile (K.1 - 1)).cells.image + (GaussianTranslation ⟨(K.1 : Int), 1 - (K.1 : Int)⟩)).image _ = _ + rw [Finset.image_image] + have hfun : (fun z : GaussianInt => + (⟨2 * (K.1 : Int), 0⟩ : GaussianInt) - + GaussianTranslation ⟨(K.1 : Int), 1 - (K.1 : Int)⟩ z - 1 - ⟨0, 1⟩) = + GaussianTranslation ⟨(K.1 : Int), 1 - (K.1 : Int)⟩ ∘ + (fun z : GaussianInt => + (⟨0, 2 * ((K.1 - 1 : Nat) : Int)⟩ : GaussianInt) - z - 1 - ⟨0, 1⟩) := by + funext z + ext <;> simp [GaussianTranslation, + Nat.cast_sub K.2] <;> ring + change (DiamondTile (K.1 - 1)).cells.image + (fun z : GaussianInt => + (⟨2 * (K.1 : Int), 0⟩ : GaussianInt) - + GaussianTranslation ⟨(K.1 : Int), 1 - (K.1 : Int)⟩ z - 1 - ⟨0, 1⟩) = _ + rw [hfun, ← Finset.image_image, diamond] + rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5327T1RightSquareJunctions.lean b/LeanPool/ApollonianSuperharmonic/P5327T1RightSquareJunctions.lean new file mode 100644 index 0000000000..f377c14810 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5327T1RightSquareJunctions.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5682T1AlignedSquareRawInterfaces +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple + +-- [TABLET NODE: P5327T1RightSquareJunctions] + +/-! +# P5327T1RightSquareJunctions + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5327T1RightSquareJunctions (r t : Nat) (hr : 0 < r) (ht : 0 < t) + (j : Fin 4) : + let q := r + t + let A := TileTranslation (FordTile q) 0 + let B := TileTranslation (FordTile q) + (![⟨-(r : Int), q⟩, ⟨-(r : Int), q⟩, + ⟨-(t : Int), -(q : Int)⟩, ⟨-(t : Int), -(q : Int)⟩] j) + let C := TileTranslation (FordTile (![r, r, t, t] j)) + (![⟨t, q⟩, ⟨-(r : Int), t⟩, ⟨-(t : Int), 0⟩, + ⟨r, -(t : Int)⟩] j) + ∃ E : ExactTileInterfaceTriple A B C, + E.point = (![⟨t, q⟩, ⟨0, q⟩, ⟨0, 0⟩, ⟨r, 0⟩] j) ∧ + E.otherAB = (![⟨0, q⟩, ⟨t, q⟩, ⟨r, 0⟩, ⟨0, 0⟩] j) ∧ + E.otherBC = (![⟨t, q+r⟩, ⟨-(r : Int), q⟩, + ⟨-(t : Int), 0⟩, ⟨r, -(t : Int)⟩] j) ∧ + E.otherCA = (![⟨q, q⟩, ⟨0, t⟩, ⟨0, t⟩, ⟨q, 0⟩] j) := by +-- BODY + classical + let sq := fun (n : Nat) (a : GaussianInt) => TileTranslation (FordTile n) a + obtain ⟨vertex, contact⟩ := P5682T1AlignedSquareRawInterfaces + change ∀ (n : Nat) (_ : 0 < n) (a z : GaussianInt), + z ∈ FootprintVertices (sq n a) ↔ + a.re ≤ z.re ∧ z.re ≤ a.re + n ∧ a.im ≤ z.im ∧ z.im ≤ a.im + n at vertex + have hq : 0 < r+t := by omega + dsimp only + simp only [Nat.cast_add] + fin_cases j + · obtain ⟨_, ab, ba⟩ := contact (r+t) (r+t) hq hq 0 ⟨-(r:Int),r+t⟩ false + (by simp) (by dsimp; omega) + obtain ⟨_, bc, cb⟩ := contact (r+t) r hq hr ⟨-(r:Int),r+t⟩ ⟨t,r+t⟩ true + (by dsimp; omega) (by dsimp; omega) + obtain ⟨_, ac, ca⟩ := contact (r+t) r hq hr 0 ⟨t,r+t⟩ false + (by simp) (by dsimp; omega) + simp only [Bool.false_eq_true,ite_false,ite_true,Zsqrtd.re_zero,Zsqrtd.im_zero, + Nat.cast_add] at ab ba bc cb ac ca + let E : ExactTileInterfaceTriple (sq (r+t) 0) (sq (r+t) ⟨-(r:Int),r+t⟩) + (sq r ⟨t,r+t⟩) := + { point := ⟨t,r+t⟩ + otherAB := ⟨0,r+t⟩ + otherBC := ⟨t,2*r+t⟩ + otherCA := ⟨r+t,r+t⟩ + pathAB := by convert ba using 1 <;> congr 1 <;> omega + pathBC := by convert bc using 1 <;> congr 1 <;> omega + pathCA := by simpa only [Set.inter_comm] using (by + convert ac using 1 <;> congr 1; omega) + unique_common := by + intro z + simp only [Set.mem_inter_iff, vertex _ hq, vertex _ hr, Zsqrtd.ext_iff] + dsimp + omega } + exact ⟨E, rfl, rfl, by dsimp [E]; ext <;> dsimp; omega, rfl⟩ + · obtain ⟨_, ab, ba⟩ := contact (r+t) (r+t) hq hq 0 ⟨-(r:Int),r+t⟩ false + (by simp) (by dsimp; omega) + obtain ⟨_, cb, bc⟩ := contact r (r+t) hr hq ⟨-(r:Int),t⟩ ⟨-(r:Int),r+t⟩ false + (by dsimp; omega) (by dsimp; omega) + obtain ⟨_, ca, ac⟩ := contact r (r+t) hr hq ⟨-(r:Int),t⟩ 0 true + (by dsimp; omega) (by dsimp; omega) + simp only [Bool.false_eq_true,ite_false,ite_true,Zsqrtd.re_zero,Zsqrtd.im_zero, + Nat.cast_add] at ab ba cb bc ca ac + let E : ExactTileInterfaceTriple (sq (r+t) 0) (sq (r+t) ⟨-(r:Int),r+t⟩) + (sq r ⟨-(r:Int),t⟩) := + { point := ⟨0,r+t⟩ + otherAB := ⟨t,r+t⟩ + otherBC := ⟨-(r:Int),r+t⟩ + otherCA := ⟨0,t⟩ + pathAB := by convert ab using 1 <;> congr 1 <;> omega + pathBC := by simpa only [Set.inter_comm] using (by + convert bc using 1 <;> congr 1 <;> omega) + pathCA := by convert ac using 1 <;> congr 1 <;> omega + unique_common := by + intro z + simp only [Set.mem_inter_iff, vertex _ hq, vertex _ hr, Zsqrtd.ext_iff] + dsimp + omega } + exact ⟨E, rfl, rfl, rfl, rfl⟩ + · obtain ⟨_, ba, ab⟩ := contact (r+t) (r+t) hq hq ⟨-(t:Int),-(r+t:Int)⟩ 0 false + (by dsimp; omega) (by dsimp; omega) + obtain ⟨_, bc, cb⟩ := contact (r+t) t hq ht + ⟨-(t:Int),-(r+t:Int)⟩ ⟨-(t:Int),0⟩ false + (by dsimp; omega) (by dsimp; omega) + obtain ⟨_, ca, ac⟩ := contact t (r+t) ht hq ⟨-(t:Int),0⟩ 0 true + (by dsimp; omega) (by dsimp; omega) + simp only [Bool.false_eq_true,ite_false,ite_true,Zsqrtd.re_zero,Zsqrtd.im_zero, + Nat.cast_add] at ba ab bc cb ca ac + let E : ExactTileInterfaceTriple (sq (r+t) 0) (sq (r+t) ⟨-(t:Int),-(r+t:Int)⟩) + (sq t ⟨-(t:Int),0⟩) := + { point := ⟨0,0⟩ + otherAB := ⟨r,0⟩ + otherBC := ⟨-(t:Int),0⟩ + otherCA := ⟨0,t⟩ + pathAB := by + convert ba using 1 <;> first | exact Set.inter_comm _ _ | (congr 1; omega) + pathBC := by convert cb using 1 <;> congr 1 <;> omega + pathCA := by convert ca using 1 <;> congr 1; omega + unique_common := by + intro z + simp only [Set.mem_inter_iff, vertex _ hq, vertex _ ht, Zsqrtd.ext_iff] + dsimp + omega } + exact ⟨E, rfl, rfl, rfl, rfl⟩ + · obtain ⟨_, ba, ab⟩ := contact (r+t) (r+t) hq hq ⟨-(t:Int),-(r+t:Int)⟩ 0 false + (by dsimp; omega) (by dsimp; omega) + obtain ⟨_, bc, cb⟩ := contact (r+t) t hq ht + ⟨-(t:Int),-(r+t:Int)⟩ ⟨r,-(t:Int)⟩ true + (by dsimp; omega) (by dsimp; omega) + obtain ⟨_, ca, ac⟩ := contact t (r+t) ht hq ⟨r,-(t:Int)⟩ 0 false + (by dsimp; omega) (by dsimp; omega) + simp only [Bool.false_eq_true,ite_false,ite_true,Zsqrtd.re_zero,Zsqrtd.im_zero, + Nat.cast_add] at ba ab bc cb ca ac + let E : ExactTileInterfaceTriple (sq (r+t) 0) (sq (r+t) ⟨-(t:Int),-(r+t:Int)⟩) + (sq t ⟨r,-(t:Int)⟩) := + { point := ⟨r,0⟩ + otherAB := ⟨0,0⟩ + otherBC := ⟨r,-(t:Int)⟩ + otherCA := ⟨r+t,0⟩ + pathAB := by + convert ab using 1 <;> first | exact Set.inter_comm _ _ | (congr 1; omega) + pathBC := by convert cb using 1 <;> congr 1 <;> omega + pathCA := by convert ca using 1 <;> congr 1 <;> omega + unique_common := by + intro z + simp only [Set.mem_inter_iff, vertex _ hq, vertex _ ht, Zsqrtd.ext_iff] + dsimp + omega } + exact ⟨E, rfl, rfl, rfl, rfl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1LiteralNormalization.lean b/LeanPool/ApollonianSuperharmonic/P5332T1LiteralNormalization.lean new file mode 100644 index 0000000000..3481ee781e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1LiteralNormalization.lean @@ -0,0 +1,230 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport +public import LeanPool.ApollonianSuperharmonic.P4217T2SquareGeometry +public import LeanPool.ApollonianSuperharmonic.P4217T2RectangularBoundarySlope +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian + +-- [TABLET NODE: P5332T1LiteralNormalization] + +/-! +# P5332T1LiteralNormalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5332T1LiteralNormalization (A D : FordFareyParameter) + (T U : ProtoTile) (h k : PartialOdometer) (p p' : ℝ × ℝ) + (g : IntegerLatticeFunction) + (hT : TileOdometer (FordCircleCoordinate A.p A.q) T h) + (hU : TileOdometer (FordCircleCoordinate D.p D.q) U k) + (hp : PartialOdometerSlope h = some p) + (hp' : PartialOdometerSlope k = some p') + (he : GlobalOdometerExtends g h) (he' : GlobalOdometerExtends g k) : + ∃ (u d a : GaussianInt) (B : Int) (f : IntegerLatticeFunction), + (∀ x, x ∈ h.domain ↔ x - u ∈ FordVertexDomain A.q) ∧ + (∀ x, x ∈ k.domain ↔ x - u - d ∈ FordVertexDomain D.q) ∧ + (∀ x, x ∈ T.cells ↔ x - u ∈ (FordTile A.q).cells) ∧ + (∀ x, x ∈ U.cells ↔ x - u - d ∈ (FordTile D.q).cells) ∧ + (∀ x w, x ∈ FootprintVertices (TileTranslation T w) ↔ + x - u - w ∈ FordVertexDomain A.q) ∧ + TileCentroid U - TileCentroid T = + (((D.q : ℝ) - A.q) / 2 + d.re, ((D.q : ℝ) - A.q) / 2 + d.im) ∧ + p'.1 - p.1 = ((D.p : ℝ) - A.p) / 2 + a.re ∧ + p'.2 - p.2 = ((D.p : ℝ) - A.p) / 2 + a.im ∧ + (∀ y, y ∈ FordVertexDomain A.q → f y = FordOdometer A y) ∧ + (∀ y, y - d ∈ FordVertexDomain D.q → + f y = FordOdometer D (y - d) + a.re * y.re + a.im * y.im + B) ∧ + (∀ x, FourNeighborLaplacian g x = FourNeighborLaplacian f (x - u)) := by +-- BODY + classical + have memtr (F : ProtoTile) (u x : GaussianInt) : + x ∈ (TileTranslation F u).cells ↔ x-u ∈ F.cells := by + change x ∈ F.cells.image (GaussianTranslation u) ↔ _ + constructor + · rintro hx + obtain ⟨z, hz, rfl⟩ := Finset.mem_image.mp hx + simpa [GaussianTranslation] using hz + · intro hx + exact Finset.mem_image.mpr ⟨x-u, hx, by simp [GaussianTranslation]⟩ + have memimage (S : Set GaussianInt) (u x : GaussianInt) : + x ∈ GaussianTranslation u '' S ↔ x-u ∈ S := by + constructor + · rintro ⟨z, hz, rfl⟩ + simpa [GaussianTranslation] using hz + · intro hx + exact ⟨x-u, hx, by simp [GaussianTranslation]⟩ + have nonempty (n : Nat) (hn : 0 < n) : (FordTile n).cells.Nonempty := by + refine ⟨0, ((P4210T1FordCellRectangles n 0).1).mpr ?_⟩ + simp only [Zsqrtd.re_zero, Zsqrtd.im_zero] + exact ⟨le_rfl, by exact_mod_cast hn, le_rfl, by exact_mod_cast hn⟩ + have normal (R : FordFareyParameter) (S : ProtoTile) (H : PartialOdometer) + (p : ℝ × ℝ) (hS : TileOdometer (FordCircleCoordinate R.p R.q) S H) + (hp : PartialOdometerSlope H = some p) (he : GlobalOdometerExtends g H) : + ∃ (u a : GaussianInt) (b : Int), + S.cells = (TileTranslation (FordTile R.q) u).cells ∧ + (∀ x, x ∈ H.domain ↔ x-u ∈ FordVertexDomain R.q) ∧ + (∀ x, x ∈ H.domain → + g x = FordOdometer R (x-u) + a.re*x.re + a.im*x.im + b) ∧ + TileCentroid S = ((R.q : ℝ)/2+u.re, (R.q : ℝ)/2+u.im) ∧ + p = ((R.p : ℝ)/2+a.re, (R.p : ℝ)/2+a.im) := by + obtain ⟨K, hK, hD, hV⟩ := FordTileOdometerRestriction R + have mem (x : GaussianInt) : x ∈ K.domain ↔ x ∈ FordVertexDomain R.q := + Set.ext_iff.mp hD x + have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + change (∀ R x, R.q = 1 → FordOdometer R x = _) ∧ _ at laws + have boundary (x : GaussianInt) (hx : x ∈ FordVertexDomain R.q) + (hs : x.re = 0 ∨ x.re = R.q ∨ x.im = 0 ∨ x.im = R.q) : + K.value x = IntegerCeilDiv (R.p*x.re*x.im) R.q + (by exact_mod_cast R.q_pos.ne') := by + rw [hV x ((mem x).mpr hx)] + apply laws.2.1 + refine ⟨hx, ?_⟩ + rcases hs with hs | hs | hs | hs <;> simp only [hs] <;> omega + have left (y : Int) (hy : 0 ≤ y) (hyq : y ≤ R.q) : K.value ⟨0,y⟩ = 0 := by + rw [boundary _ (by exact ⟨le_rfl, by dsimp; omega, hy, hyq⟩) (Or.inl rfl)] + simp [IntegerCeilDiv] + have right (y : Int) (hy : 0 ≤ y) (hyq : y ≤ R.q) : + K.value ⟨(R.q : Int),y⟩ = R.p*y := by + rw [boundary _ (by exact ⟨by dsimp; omega, le_rfl, hy, hyq⟩) (Or.inr (Or.inl rfl))] + simp only [IntegerCeilDiv] + rw [show -(R.p*(R.q : Int)*y) = -(R.p*y)*(R.q : Int) by ring, + Int.mul_ediv_cancel _ (by exact_mod_cast R.q_pos.ne')] + simp + have bottom (x : Int) (hx : 0 ≤ x) (hxq : x ≤ R.q) : K.value ⟨x,0⟩ = 0 := by + rw [boundary _ (by exact ⟨hx, hxq, le_rfl, by dsimp; omega⟩) (Or.inr (Or.inr (Or.inl rfl)))] + simp [IntegerCeilDiv] + have top (x : Int) (hx : 0 ≤ x) (hxq : x ≤ R.q) : + K.value ⟨x,(R.q : Int)⟩ = R.p*x := by + rw [boundary _ (by exact ⟨hx, hxq, by dsimp; omega, le_rfl⟩) (Or.inr (Or.inr (Or.inr rfl)))] + change -(-(R.p*x*(R.q : Int))/(R.q : Int)) = R.p*x + rw [← neg_mul, Int.mul_ediv_cancel _ (by exact_mod_cast R.q_pos.ne')] + simp + have slopeK : PartialOdometerSlope K = some ((R.p : ℝ)/2,(R.p : ℝ)/2) := by + have hs := P4217T2RectangularBoundarySlope K R.q R.q R.q_pos R.q_pos R.p R.p + hD left right bottom top + have hn : (R.q : ℝ) ≠ 0 := by exact_mod_cast R.q_pos.ne' + convert hs using 1; congr 2 <;> field_simp + have hcurv : 0 < (FordCircleCoordinate R.p R.q).1 := by + dsimp [FordCircleCoordinate] + have := R.q_pos + positivity + obtain ⟨u, ⟨hc, _, a, b, hd, hv⟩, _⟩ := + TileOdometerTranslationUniqueness _ S (FordTile R.q) H K hcurv hS hK + have hn := (nonempty R.q R.q_pos).image (GaussianTranslation u) + have hcent : TileCentroid S = TileCentroid (TileTranslation (FordTile R.q) u) := by + have hnS : S.cells.Nonempty := by rw [hc]; exact hn + have hnU : (TileTranslation (FordTile R.q) u).cells.Nonempty := hn + rw [TileCentroid, ite_eq_left hnS, TileCentroid, ite_eq_left hnU, hc] + have H_eq : H = PartialOdometerAffineTranslate K u a b := by + have hde : H.domain = (PartialOdometerAffineTranslate K u a b).domain := by + ext x + exact (hd x).trans ((PartialOdometerAffineTranslateFormulas K u a b).2.1 x).symm + have hve : H.value = (PartialOdometerAffineTranslate K u a b).value := by + funext x + by_cases hx : x ∈ H.domain + · exact (hv x hx).trans + ((PartialOdometerAffineTranslateFormulas K u a b).2.2.1 x (hde ▸ hx)).symm + · rw [H.value_outside x hx, + (PartialOdometerAffineTranslate K u a b).value_outside x (by rwa [← hde])] + have ext (H K : PartialOdometer) (hd : H.domain = K.domain) + (hv : H.value = K.value) : H = K := by + cases H + cases K + cases hd + cases hv + rfl + exact ext _ _ hde hve + have hp' : p = ((R.p : ℝ)/2+a.re,(R.p : ℝ)/2+a.im) := by + have hh := congrArg PartialOdometerSlope H_eq + rw [hp, (PartialOdometerAffineTranslateFormulas K u a b).2.2.2.2.2, slopeK] at hh + exact Option.some.inj hh + obtain ⟨e, he⟩ := he + refine ⟨u,a,b+e,hc,?_,?_,?_,hp'⟩ + · intro x + exact (hd x).trans (mem (x-u)) + · intro x hx + rw [he x hx, hv x hx, hV (x-u) ((hd x).mp hx)] + ring + · rw [hcent, (TileTranslationFormulas (FordTile R.q) u).2.2.2.2.1, + P4210T1FordSquareCentroid R.q R.q_pos] + obtain ⟨u, l, b, hc, hd, hv, hcent, hslope⟩ := normal A T h p hT hp he + obtain ⟨v, m, c, hc', hd', hv', hcent', hslope'⟩ := normal D U k p' hU hp' he' + let f : IntegerLatticeFunction := fun z => + g (z+u) - l.re*(z+u).re - l.im*(z+u).im - b + refine ⟨u,v-u,m-l,(m-l).re*u.re+(m-l).im*u.im+c-b,f,hd,?_,?_,?_,?_,?_,?_,?_,?_,?_,?_⟩ + · intro x + have eq : x-u-(v-u) = x-v := by abel + simpa only [eq] using hd' x + · intro x + rw [hc] + exact memtr _ _ _ + · intro x + rw [hc', memtr] + have eq : x-u-(v-u) = x-v := by abel + rw [eq] + · intro x w + have hn := (nonempty A.q A.q_pos).image (GaussianTranslation u) + have hf : FootprintVertices T = FootprintVertices (TileTranslation (FordTile A.q) u) := by + have hnT : T.cells.Nonempty := by rw [hc]; exact hn + have hnU : (TileTranslation (FordTile A.q) u).cells.Nonempty := hn + rw [FootprintVertices, ite_eq_left hnT, FootprintVertices, ite_eq_left hnU, hc] + rw [(TileTranslationFormulas T w).2.2.2.2.2.1, memimage, hf, + (TileTranslationFormulas (FordTile A.q) u).2.2.2.2.2.1, memimage, + (P4062T1CanonicalSupport A.q A.q_pos).1] + simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + · rw [hcent, hcent'] + ext <;> simp only [Prod.fst_sub, Prod.snd_sub, Zsqrtd.re_sub, + Zsqrtd.im_sub, Int.cast_sub] <;> ring + · rw [hslope, hslope'] + simp only [Zsqrtd.re_sub, Int.cast_sub] + ring + · rw [hslope, hslope'] + simp only [Zsqrtd.im_sub, Int.cast_sub] + ring + · intro y hy + have hy' : y+u ∈ h.domain := (hd _).mpr (by simpa using hy) + dsimp only [f] + rw [hv _ hy'] + simp only [add_sub_cancel_right] + ring + · intro y hy + have hy' : y+u ∈ k.domain := (hd' _).mpr (by + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hy) + dsimp only [f] + rw [hv' _ hy'] + have eq : y+u-v = y-(v-u) := by abel + rw [eq] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] + ring + · intro x + unfold FourNeighborLaplacian + dsimp only [f] + simp only [sub_add_cancel] + have e1 : x-u+1+u = x+1 := by abel + have e2 : x-u-1+u = x-1 := by abel + have e3 : x-u+⟨0,1⟩+u = x+⟨0,1⟩ := by abel + have e4 : x-u-⟨0,1⟩+u = x-⟨0,1⟩ := by abel + rw [e1,e2,e3,e4] + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_one, Zsqrtd.im_one] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation0Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation0Values.lean new file mode 100644 index 0000000000..2867b7bf58 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation0Values.lean @@ -0,0 +1,250 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift +public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic + +-- [TABLET NODE: P5332T1Parent1Rotation0Values] + +/-! +# P5332T1Parent1Rotation0Values + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5332T1Parent1Rotation0Values (P A : FordFareyParameter) (hq : 1 < P.q) + (hAp : A.p = P.p₁) (hAq : A.q = P.q₁) + (f : IntegerLatticeFunction) (B : Int) (x : GaussianInt) + (hbase : ∀ y, y ∈ FordVertexDomain P.q → f y = FordOdometer P y) + (hother : ∀ y, + y - (P5332T1ParentRows P 0 0 0).displacement ∈ FordVertexDomain A.q → + f y = FordOdometer A (y - (P5332T1ParentRows P 0 0 0).displacement) + + (P5332T1ParentRows P 0 0 0).linear.re * y.re + + (P5332T1ParentRows P 0 0 0).linear.im * y.im + B) + (hx : x ∈ FordVertexDomain P.q) + (hx' : x - (P5332T1ParentRows P 0 0 0).displacement ∈ FordVertexDomain A.q) + (hstar : ∀ l : Fin 5, + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) ∈ FordVertexDomain P.q ∨ + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) - + (P5332T1ParentRows P 0 0 0).displacement ∈ FordVertexDomain A.q) : + ∃ t : Int, 0 ≤ t ∧ t < (P.q₁ : Int) ∧ + x = (P5332T1ParentRows P 0 0 t).center ∧ B = -P.p₂ * (P.q : Int) ∧ + (∀ l : Fin 5, f (x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l)) = + (P5332T1ParentRows P 0 0 t).values l) ∧ + (x - (P5332T1ParentRows P 0 0 0).companion ∈ FordVertexDomain P.q ↔ + t = 0 ∧ Even (0+0 : Nat)) := by +-- BODY + classical + have hq' : 1 < (P.q : Int) := by exact_mod_cast hq + have hqn : (P.q : Int) ≠ 0 := by omega + have par := P5130T5ParentArithmetic P hq + have hr : 0 < (P.q₁ : Int) := by exact_mod_cast par.1 + have hs : 0 < (P.q₂ : Int) := Int.natCast_pos.mpr P.q₂_pos + have hrs : (P.q₁ : Int) + P.q₂ = P.q := by exact_mod_cast P.sum_q.symm + have hpa : P.p₁ * P.q - (P.q₁ : Int) * P.p = 1 := P.det₁ + have hpb : P.p₂ * P.q - (P.q₂ : Int) * P.p = -1 := P.det₂ + have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ _ at laws + have boundary (N : FordFareyParameter) (r t : Int) + (hr0 : 0 ≤ r) (hrq : r ≤ (N.q : Int)) + (ht0 : 0 ≤ t) (htq : t ≤ (N.q : Int)) + (hsb : r ≤ 1 ∨ (N.q : Int)-1 ≤ r ∨ t ≤ 1 ∨ (N.q : Int)-1 ≤ t) : + FordOdometer N ⟨r,t⟩ = IntegerCeilDiv (N.p*r*t) N.q (by exact_mod_cast N.q_pos.ne') := by + apply laws.2.1 + change (0 ≤ r ∧ r ≤ (N.q : Int) ∧ 0 ≤ t ∧ t ≤ (N.q : Int)) ∧ + ¬(2 ≤ r ∧ r ≤ (N.q : Int)-2 ∧ 2 ≤ t ∧ t ≤ (N.q : Int)-2) + omega + rcases x with ⟨X,Y⟩ + have hx0 := hx + change 0 ≤ X ∧ X ≤ (P.q : Int) ∧ 0 ≤ Y ∧ Y ≤ (P.q : Int) at hx0 + have hchild := hx' + change 0 ≤ X-(P.q₂ : Int) ∧ X-(P.q₂ : Int) ≤ (A.q : Int) ∧ + 0 ≤ Y-(P.q : Int) ∧ Y-(P.q : Int) ≤ (A.q : Int) at hchild + have hAq : (A.q : Int) = P.q₁ := by exact_mod_cast hAq + have hAp : A.p = P.p₁ := hAp + have hY : Y = (P.q : Int) := by + have := hx0.2.2.2 + have := hchild.2.2.2 + omega + let t : Int := X - (P.q₂ : Int) + have ht0 : 0 ≤ t := by dsimp [t]; omega + have htr0 : t ≤ (P.q₁ : Int) := by + have := hchild.2.1 + have hAq' : (A.q : Int) = P.q₁ := by exact_mod_cast hAq + dsimp [t] + omega + have hstarTop := hstar 3 + have hstarRight := hstar 1 + dsimp [P5332T1ParentRows] at hstarTop hstarRight + norm_num [FordVertexDomain] at hstarTop hstarRight + have htlt : t < (P.q₁ : Int) := by + rcases hstarTop with h | h + · have := h.2.2.2 + dsimp [t] at * + omega + · have := h.2.2.2 + dsimp [t] at * + omega + have hcenter : (⟨X,Y⟩ : GaussianInt) = (P5332T1ParentRows P 0 0 t).center := by + ext <;> simp [P5332T1ParentRows, t, hY] + have hcenter0 := hbase (⟨X,Y⟩ : GaussianInt) hx + have hcenter1 := hother (⟨X,Y⟩ : GaussianInt) (by + change 0 ≤ X-(P.q₂ : Int) ∧ X-(P.q₂ : Int) ≤ (A.q : Int) ∧ + 0 ≤ Y-(P.q : Int) ∧ Y-(P.q : Int) ≤ (A.q : Int) + omega) + have top (N : FordFareyParameter) (u : Int) + (hu : 0 ≤ u) (huq : u ≤ (N.q : Int)) : + FordOdometer N ⟨u,(N.q : Int)⟩ = N.p*u := by + rw [boundary N u (N.q : Int) hu huq (by omega) (by omega) (by omega)] + dsimp [IntegerCeilDiv] + have he : -(N.p*u*(N.q : Int)) = (-N.p*u)*(N.q : Int) := by ring + rw [he, Int.mul_ediv_cancel _ (by exact_mod_cast N.q_pos.ne')] + ring + have left (N : FordFareyParameter) (v : Int) + (hv : 0 ≤ v) (hvq : v ≤ (N.q : Int)) : + FordOdometer N ⟨0,v⟩ = 0 := by + rw [boundary N 0 v (by omega) (by omega) hv hvq (by omega)] + simp [IntegerCeilDiv] + have bottom (N : FordFareyParameter) (u : Int) + (hu : 0 ≤ u) (huq : u ≤ (N.q : Int)) : + FordOdometer N ⟨u,0⟩ = 0 := by + rw [boundary N u 0 hu huq (by omega) (by omega) (by omega)] + simp [IntegerCeilDiv] + have centerarg : (⟨X,Y⟩ : GaussianInt) - + (P5332T1ParentRows P 0 0 0).displacement = ⟨t,0⟩ := by + ext <;> simp [P5332T1ParentRows, t, hY] + have hcenter0' : f (⟨X,Y⟩ : GaussianInt) = P.p*(P.q₂ + t) := by + rw [hbase _ hx] + have hc : (⟨X,Y⟩ : GaussianInt) = ⟨P.q₂+t,(P.q : Int)⟩ := by + ext <;> simp [t, hY] + rw [hc] + exact top P _ (by omega) (by omega) + have hcenter1' : f (⟨X,Y⟩ : GaussianInt) = + 0 + P.p*(P.q₂+t) + P.p₂*(P.q : Int) + B := by + rw [hother _ (by + change 0 ≤ X-(P.q₂ : Int) ∧ X-(P.q₂ : Int) ≤ (A.q : Int) ∧ + 0 ≤ Y-(P.q : Int) ∧ Y-(P.q : Int) ≤ (A.q : Int) + omega)] + rw [centerarg] + rw [bottom A t (by omega) (by omega)] + simp [P5332T1ParentRows, hY, t] + have hB : B = -P.p₂*(P.q : Int) := by + rw [hcenter0'] at hcenter1' + nlinarith [hcenter1'] + subst B + let u : Int := P.q₂ + t + have hu0 : 0 ≤ u := by dsimp [u]; omega + have huq : u + 1 ≤ (P.q : Int) := by dsimp [u]; omega + have huq' : u - 1 ≥ 0 := by dsimp [u]; omega + have hxcoord : (⟨X,Y⟩ : GaussianInt) = ⟨u,(P.q : Int)⟩ := by + ext <;> simp [u, t, hY] + have topValue (v : Int) (hv : 0 ≤ v) (hvq : v ≤ (P.q : Int)) : + f ⟨v,(P.q : Int)⟩ = P.p*v := by + apply (hbase _ ?_).trans + · exact top P v hv hvq + · change 0 ≤ v ∧ v ≤ (P.q : Int) ∧ 0 ≤ (P.q : Int) ∧ + (P.q : Int) ≤ (P.q : Int) + omega + have hval0 : f (⟨X,Y⟩ : GaussianInt) = P.p*u := by + rw [hxcoord] + exact topValue u hu0 (by omega) + have hval1 : f ((⟨X,Y⟩ : GaussianInt) + 1) = P.p*(u+1) := by + have he : (⟨X,Y⟩ : GaussianInt)+1 = ⟨u+1,(P.q : Int)⟩ := by + ext <;> simp [hxcoord] + rw [he] + exact topValue (u+1) (by omega) huq + have hval2 : f ((⟨X,Y⟩ : GaussianInt) - 1) = P.p*(u-1) := by + have he : (⟨X,Y⟩ : GaussianInt)-1 = ⟨u-1,(P.q : Int)⟩ := by + ext <;> simp [hxcoord] + rw [he] + exact topValue (u-1) huq' (by omega) + have argN : (⟨X,Y⟩ : GaussianInt) + ⟨0,1⟩ - + (P5332T1ParentRows P 0 0 0).displacement = ⟨t,1⟩ := by + ext <;> simp [P5332T1ParentRows, t, hY] + have hq1n : (P.q₁ : Int) ≠ 0 := ne_of_gt hr + have hval3 : f ((⟨X,Y⟩ : GaussianInt) + ⟨0,1⟩) = + P.p*u + P.p₂ + IntegerCeilDiv (P.p₁*t) (P.q₁ : Int) hq1n := by + rw [hother _ (by + rw [argN] + change 0 ≤ t ∧ t ≤ (A.q : Int) ∧ 0 ≤ (1 : Int) ∧ 1 ≤ (A.q : Int) + rw [hAq] + omega)] + rw [argN, boundary A t 1 (by omega) (by omega) (by omega) (by omega) (by omega)] + simp [P5332T1ParentRows, u, t, hY, hAp, hAq, IntegerCeilDiv] + ring + have hpu : P.p*u = P.p₂*(P.q : Int) + (P.p*t+1) := by + have hps : P.p*(P.q₂ : Int) = P.p₂*(P.q : Int)+1 := by + linear_combination -hpb + calc + P.p*u = P.p*((P.q₂ : Int)+t) := rfl + _ = P.p*(P.q₂ : Int)+P.p*t := by ring + _ = P.p₂*(P.q : Int)+(P.p*t+1) := by rw [hps]; ring + have hceilNeg : IntegerCeilDiv (-(P.p*u)) P.q hqn = + -P.p₂ - ((P.p*t+1)/(P.q : Int)) := by + have hn : -(P.p*u) = -(P.p*t+1) + (-P.p₂)*(P.q : Int) := by + linear_combination -hpu + rw [hn, P5188T1CeilingShift _ _ _ hqn] + simp [IntegerCeilDiv] + ring + have hval4 : f ((⟨X,Y⟩ : GaussianInt) - ⟨0,1⟩) = + P.p*u - P.p₂ - ((P.p*t+1)/(P.q : Int)) := by + have he : (⟨X,Y⟩ : GaussianInt)-⟨0,1⟩ = ⟨u,(P.q : Int)-1⟩ := by + ext <;> simp [hxcoord] + rw [he] + have hbnd := boundary P u ((P.q : Int)-1) hu0 (by omega) (by omega) (by omega) (by omega) + rw [hbase _ (by + change 0 ≤ u ∧ u ≤ (P.q : Int) ∧ 0 ≤ (P.q : Int)-1 ∧ + (P.q : Int)-1 ≤ (P.q : Int) + omega), hbnd] + have hnum : P.p*u*((P.q : Int)-1) = -(P.p*u) + (P.p*u)*(P.q : Int) := by ring + rw [hnum, P5188T1CeilingShift _ _ _ hqn, hceilNeg] + ring + refine ⟨t, ht0, htlt, hcenter, rfl, ?_, ?_⟩ + · intro l + fin_cases l + · simpa [P5332T1ParentRows, Matrix.cons_val_zero, Matrix.head_cons, + Matrix.tail_cons, u] using hval0 + · simpa [P5332T1ParentRows, Matrix.cons_val_one, Matrix.head_cons, + Matrix.tail_cons, u] using hval1 + · simpa [P5332T1ParentRows, Matrix.cons_val_two, Matrix.head_cons, + Matrix.tail_cons, u, sub_eq_add_neg] using hval2 + · simpa [P5332T1ParentRows, Matrix.cons_val_three, Matrix.head_cons, + Matrix.tail_cons, u, IntegerCeilDiv] using hval3 + · simpa [P5332T1ParentRows, Matrix.cons_val_four, Matrix.head_cons, + Matrix.tail_cons, u, sub_eq_add_neg] using hval4 + · constructor + · intro hm + have hcomp : (⟨X,Y⟩ : GaussianInt) - + (P5332T1ParentRows P 0 0 0).companion = ⟨(P.q : Int)+t,0⟩ := by + ext <;> simp [P5332T1ParentRows, t, hY]; omega + rw [hcomp] at hm + change 0 ≤ (P.q : Int)+t ∧ (P.q : Int)+t ≤ (P.q : Int) ∧ + 0 ≤ (0 : Int) ∧ (0 : Int) ≤ (P.q : Int) at hm + have htzero : t = 0 := by omega + exact ⟨htzero, by norm_num⟩ + · rintro ⟨htzero, _⟩ + have hcomp : (⟨X,Y⟩ : GaussianInt) - + (P5332T1ParentRows P 0 0 0).companion = ⟨(P.q : Int),0⟩ := by + ext <;> simp [P5332T1ParentRows, hY]; omega + rw [hcomp] + change 0 ≤ (P.q : Int) ∧ (P.q : Int) ≤ (P.q : Int) ∧ + 0 ≤ (0 : Int) ∧ (0 : Int) ≤ (P.q : Int) + exact ⟨by omega, le_rfl, le_rfl, by omega⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation1Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation1Values.lean new file mode 100644 index 0000000000..dfa21fb7f6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation1Values.lean @@ -0,0 +1,280 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift + +-- [TABLET NODE: P5332T1Parent1Rotation1Values] + +/-! +# P5332T1Parent1Rotation1Values + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ParentRotationValuesProof + +private theorem hB : + ∀ (P : FordFareyParameter), ∀ (A : FordFareyParameter), (A.p = P.p₁) → (((A.q : Int) = P.q₁) + → (∀ (f : IntegerLatticeFunction), ∀ (B : Int), ((0 : ℕ) < P.q₁) → ((∀ (Q : + FordFareyParameter), ∀ (u : Int), ∀ (v : Int), (0 ≤ u) → ((u ≤ Q.q) → ((0 ≤ v) → ((v ≤ + Q.q) → ((u ≤ 1 ∨ (Q.q : Int)-1 ≤ u ∨ v ≤ 1 ∨ (Q.q : Int)-1 ≤ v) → (FordOdometer Q ⟨u,v⟩ = + IntegerCeilDiv (Q.p*u*v) Q.q (by exact_mod_cast Q.q_pos.ne'))))))) → (∀ (Y : ℤ), (A.q = + P.q₁) → ( + let t : Int := Y-P.q₂ + (0 ≤ t) → ((t ≤ (P.q₁ : Int)) → ((f ⟨0,Y⟩ = 0) → ((f ⟨(0 : ℤ), Y⟩ = FordOdometer A ⟨(↑P.q₁ : + ℤ), t⟩ + P.p₂ * (0 : ℤ) + -P.p₁ * Y + B) → (B = P.p₁ * P.q₂))))))))) := by + classical + intro P A hAp hAq f B rposN boundary Y hAqNat t ht0 htr hcenterbase hcenterother + have htrA : t ≤ (A.q : Int) := by rw [hAq]; exact htr + have hbnd := boundary A (P.q₁ : Int) t (by omega) (by rw [hAq]) + ht0 htrA (by omega) + rw [hbnd] at hcenterother + simp only [hAp, hAqNat] at hcenterother + simp only [IntegerCeilDiv] at hcenterother + have hceil : -(-(P.p₁*(P.q₁ : Int)*t) / (P.q₁ : Int)) = P.p₁*t := by + rw [show -(P.p₁*(P.q₁ : Int)*t) = (-P.p₁*t)*(P.q₁ : Int) by ring, + Int.mul_ediv_cancel _ (by omega)] + ring + rw [hceil] at hcenterother + rw [hcenterbase] at hcenterother + simp only [mul_zero, add_zero] at hcenterother + have hY : Y = (P.q₂ : Int) + t := by dsimp [t]; ring + nlinarith [hY] + +end ParentRotationValuesProof + +theorem P5332T1Parent1Rotation1Values (P A : FordFareyParameter) (hq : 1 < P.q) + (hAp : A.p = P.p₁) (hAq : A.q = P.q₁) + (f : IntegerLatticeFunction) (B : Int) (x : GaussianInt) + (hbase : ∀ y, y ∈ FordVertexDomain P.q → f y = FordOdometer P y) + (hother : ∀ y, + y - (P5332T1ParentRows P 0 1 0).displacement ∈ FordVertexDomain A.q → + f y = FordOdometer A (y - (P5332T1ParentRows P 0 1 0).displacement) + + (P5332T1ParentRows P 0 1 0).linear.re * y.re + + (P5332T1ParentRows P 0 1 0).linear.im * y.im + B) + (hx : x ∈ FordVertexDomain P.q) + (hx' : x - (P5332T1ParentRows P 0 1 0).displacement ∈ FordVertexDomain A.q) + (hstar : ∀ l : Fin 5, + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) ∈ FordVertexDomain P.q ∨ + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) - + (P5332T1ParentRows P 0 1 0).displacement ∈ FordVertexDomain A.q) : + ∃ t : Int, 0 ≤ t ∧ t < (P.q₁ : Int) ∧ + x = (P5332T1ParentRows P 0 1 t).center ∧ B = P.p₁ * (P.q₂ : Int) ∧ + (∀ l : Fin 5, f (x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l)) = + (P5332T1ParentRows P 0 1 t).values l) ∧ + (x - (P5332T1ParentRows P 0 1 0).companion ∈ FordVertexDomain P.q ↔ + t = 0 ∧ Even (1+0 : Nat)) := by +-- BODY + classical + have hq' : 1 < (P.q : Int) := by exact_mod_cast hq + have hqn : (P.q : Int) ≠ 0 := by omega + have rposN := (P5130T5ParentArithmetic P hq).1 + have rpos : 0 < (P.q₁ : Int) := by exact_mod_cast rposN + have spos : 0 < (P.q₂ : Int) := by exact_mod_cast P.q₂_pos + have rq : (P.q₁ : Int) + P.q₂ = P.q := by + have := P.sum_q + exact_mod_cast this.symm + have pp : P.p = P.p₁ + P.p₂ := P.sum_p + have d1 : P.p₁ * (P.q : Int) - (P.q₁ : Int) * P.p = 1 := P.det₁ + have d2 : P.p₂ * (P.q : Int) - P.q₂ * P.p = -1 := P.det₂ + have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ _ at laws + have boundary (Q : FordFareyParameter) (u v : Int) + (hu : 0 ≤ u) (huq : u ≤ Q.q) (hv : 0 ≤ v) (hvq : v ≤ Q.q) + (hs : u ≤ 1 ∨ (Q.q : Int)-1 ≤ u ∨ v ≤ 1 ∨ (Q.q : Int)-1 ≤ v) : + FordOdometer Q ⟨u,v⟩ = IntegerCeilDiv (Q.p*u*v) Q.q + (by exact_mod_cast Q.q_pos.ne') := by + apply laws.2.1 + change (0 ≤ u ∧ u ≤ (Q.q : Int) ∧ 0 ≤ v ∧ v ≤ (Q.q : Int)) ∧ + ¬(2 ≤ u ∧ u ≤ (Q.q : Int)-2 ∧ 2 ≤ v ∧ v ≤ (Q.q : Int)-2) + omega + rcases x with ⟨X,Y⟩ + have hx0 := hx + have hx'0 := hx' + change 0 ≤ X ∧ X ≤ (P.q : Int) ∧ 0 ≤ Y ∧ Y ≤ (P.q : Int) at hx0 + dsimp [P5332T1ParentRows] at hx'0 + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub] at hx'0 + have hAqNat : A.q = P.q₁ := hAq + have hAq : (A.q : Int) = P.q₁ := by exact_mod_cast hAqNat + have hAp' : A.p = P.p₁ := hAp + have hX : X = 0 := by omega + subst X + let t : Int := Y-P.q₂ + have ht0 : 0 ≤ t := by dsimp [t]; omega + have htr : t ≤ (P.q₁ : Int) := by dsimp [t]; omega + have htrlt : t < (P.q₁ : Int) := by + have hs := hstar 3 + dsimp [P5332T1ParentRows] at hs + norm_num [FordVertexDomain] at hs + dsimp [t] + omega + have hY : Y = P.q₂+t := by dsimp [t]; omega + have hcenter : (⟨0,Y⟩ : GaussianInt) = + (P5332T1ParentRows P 0 1 t).center := by + simp [P5332T1ParentRows, hY] + have hcenterbase : f ⟨0,Y⟩ = 0 := by + rw [hbase _ hx] + rw [boundary P 0 Y (by omega) (by omega) (by omega) (by omega) (by omega)] + simp [IntegerCeilDiv] + have hcenterother := hother ⟨0,Y⟩ hx' + have harg : (⟨0,Y⟩ : GaussianInt) - (P5332T1ParentRows P 0 1 0).displacement = + ⟨(P.q₁ : Int),t⟩ := by + dsimp [P5332T1ParentRows] + ext <;> simp [t] + rw [harg] at hcenterother + dsimp [P5332T1ParentRows] at hcenterother + have hB : B = P.p₁ * P.q₂ := ParentRotationValuesProof.hB P A hAp hAq f B rposN boundary Y + hAqNat ht0 htr hcenterbase hcenterother + have hps : P.p * P.q₂ = 1 + P.p₂ * (P.q : Int) := by + nlinarith [d1, pp, rq] + have hplusbase : f ⟨1,Y⟩ = FordOdometer P ⟨1,Y⟩ := by + apply hbase + change 0 ≤ (1 : Int) ∧ 1 ≤ (P.q : Int) ∧ 0 ≤ Y ∧ Y ≤ (P.q : Int) + omega + have hplusbnd := boundary P 1 Y (by norm_num) (by omega) (by omega) (by omega) + (Or.inl (by norm_num)) + have hplus : f (⟨0,Y⟩ + 1) = + IntegerCeilDiv (P.p * Y) P.q hqn := by + have hcoord : (⟨0,Y⟩ : GaussianInt) + 1 = ⟨1,Y⟩ := by ext <;> simp + rw [hcoord, hplusbase, hplusbnd] + simp only [mul_one] + have hnum : P.p * Y = P.p * t + 1 + P.p₂ * (P.q : Int) := by + rw [hY] + nlinarith [hps] + have hplusShift : IntegerCeilDiv (P.p * Y) P.q hqn = + IntegerCeilDiv (P.p * t + 1) P.q hqn + P.p₂ := by + rw [hnum] + exact P5188T1CeilingShift (P.p*t+1) P.p₂ (P.q : Int) hqn + have hminusArg : (⟨0,Y⟩ : GaussianInt) - 1 - + (P5332T1ParentRows P 0 1 0).displacement = + ⟨(P.q₁ : Int)-1,t⟩ := by + dsimp [P5332T1ParentRows] + ext <;> simp [t]; ring + have hminusMem : (⟨0,Y⟩ : GaussianInt) - 1 - + (P5332T1ParentRows P 0 1 0).displacement ∈ FordVertexDomain A.q := by + rw [hminusArg] + change 0 ≤ (P.q₁ : Int)-1 ∧ (P.q₁ : Int)-1 ≤ (A.q : Int) ∧ + 0 ≤ t ∧ t ≤ (A.q : Int) + rw [hAq] + omega + have hminus := hother (⟨0,Y⟩ - 1) hminusMem + rw [hminusArg] at hminus + dsimp [P5332T1ParentRows] at hminus + have hminusBnd := boundary A ((P.q₁ : Int)-1) t (by omega) + (by rw [hAq]; omega) ht0 (by rw [hAq]; omega) (by + right + left + simp [hAq]) + rw [hminusBnd] at hminus + simp only [hAp, hAqNat] at hminus + have hceilMinus : IntegerCeilDiv + (P.p₁*((P.q₁ : Int)-1)*t) (P.q₁ : Int) (by omega) = + P.p₁*t - (P.p₁*t)/(P.q₁ : Int) := by + have hnum' : P.p₁*((P.q₁ : Int)-1)*t = + -(P.p₁*t) + (P.p₁*t)*(P.q₁ : Int) := by ring + rw [hnum'] + rw [P5188T1CeilingShift (-(P.p₁*t)) (P.p₁*t) (P.q₁ : Int) (by omega)] + simp only [IntegerCeilDiv, neg_neg] + ring + rw [hceilMinus] at hminus + have hminusValue : f (⟨0,Y⟩ - 1) = + -P.p₂ - (P.p₁*t)/(P.q₁ : Int) := by + rw [hB] at hminus + simp only [ + Int.sub_zero, mul_neg_one] at hminus + nlinarith only [hminus, hB] + have outerLeft (z : Int) (hz : 0 ≤ z) (hzq : z ≤ (P.q : Int)) : + f ⟨0,z⟩ = 0 := by + rw [hbase _ (by change 0 ≤ (0:Int) ∧ 0 ≤ (P.q:Int) ∧ 0 ≤ z ∧ z ≤ (P.q:Int); omega)] + rw [boundary P 0 z (by norm_num) (by omega) hz hzq (Or.inl (by norm_num))] + simp [IntegerCeilDiv] + have rowValue0 : (P5332T1ParentRows P 0 1 t).values 0 = 0 := rfl + have rowValue1 : (P5332T1ParentRows P 0 1 t).values 1 = + P.p₂ + IntegerCeilDiv (P.p*t+1) P.q (by exact_mod_cast P.q_pos.ne') := rfl + have rowValue2 : (P5332T1ParentRows P 0 1 t).values 2 = + -P.p₂ - (P.p₁*t)/(P.q₁ : Int) := rfl + have rowValue3 : (P5332T1ParentRows P 0 1 t).values 3 = 0 := rfl + have rowValue4 : (P5332T1ParentRows P 0 1 t).values 4 = 0 := rfl + have rowCompanion : (P5332T1ParentRows P 0 1 0).companion = + ⟨-(P.q₁ : Int),(P.q : Int)⟩ := rfl + refine ⟨t, ht0, htrlt, ?_, hB, ?_, ?_⟩ + · simp [P5332T1ParentRows, hY] + · intro l + fin_cases l + · have hs : (![0, 1, -1, (⟨0,1⟩ : GaussianInt), -⟨0,1⟩] + (0 : Fin 5) : GaussianInt) = 0 := rfl + simp only [] + change f (⟨0,Y⟩ + (![0, 1, -1, (⟨0,1⟩ : GaussianInt), -⟨0,1⟩] + (0 : Fin 5))) = (P5332T1ParentRows P 0 1 t).values (0 : Fin 5) + rw [hs, rowValue0] + simpa using hcenterbase + · have hs : (![0, 1, -1, (⟨0,1⟩ : GaussianInt), -⟨0,1⟩] + (1 : Fin 5) : GaussianInt) = 1 := rfl + simp only [] + change f (⟨0,Y⟩ + (![0, 1, -1, (⟨0,1⟩ : GaussianInt), -⟨0,1⟩] + (1 : Fin 5))) = (P5332T1ParentRows P 0 1 t).values (1 : Fin 5) + rw [hs, rowValue1] + change f (⟨0,Y⟩ + 1) = + P.p₂ + IntegerCeilDiv (P.p*t+1) P.q (by exact_mod_cast P.q_pos.ne') + simpa [add_comm] using hplus.trans hplusShift + · have hs : (![0, 1, -1, (⟨0,1⟩ : GaussianInt), -⟨0,1⟩] + (2 : Fin 5) : GaussianInt) = -1 := rfl + simp only [] + change f (⟨0,Y⟩ + (![0, 1, -1, (⟨0,1⟩ : GaussianInt), -⟨0,1⟩] + (2 : Fin 5))) = (P5332T1ParentRows P 0 1 t).values (2 : Fin 5) + rw [hs, rowValue2] + simpa [sub_eq_add_neg] using hminusValue + · have hu := outerLeft (Y+1) (by omega) (by omega) + have hs : (![0, 1, -1, (⟨0,1⟩ : GaussianInt), -⟨0,1⟩] + (3 : Fin 5) : GaussianInt) = ⟨0,1⟩ := rfl + simp only [] + change f (⟨0,Y⟩ + (![0, 1, -1, (⟨0,1⟩ : GaussianInt), -⟨0,1⟩] + (3 : Fin 5))) = (P5332T1ParentRows P 0 1 t).values (3 : Fin 5) + rw [hs, rowValue3] + change f (⟨0,Y⟩ + ⟨0,1⟩) = 0 + have hcoord : (⟨0,Y⟩ : GaussianInt) + ⟨0,1⟩ = ⟨0,Y+1⟩ := by ext <;> simp + rw [hcoord] + exact hu + · have hu := outerLeft (Y-1) (by omega) (by omega) + have hs : (![0, 1, -1, (⟨0,1⟩ : GaussianInt), -⟨0,1⟩] + (4 : Fin 5) : GaussianInt) = -⟨0,1⟩ := rfl + simp only [] + change f (⟨0,Y⟩ + (![0, 1, -1, (⟨0,1⟩ : GaussianInt), -⟨0,1⟩] + (4 : Fin 5))) = (P5332T1ParentRows P 0 1 t).values (4 : Fin 5) + rw [hs, rowValue4] + change f (⟨0,Y⟩ + -⟨0,1⟩) = 0 + have hcoord : (⟨0,Y⟩ : GaussianInt) + -⟨0,1⟩ = ⟨0,Y-1⟩ := by + ext <;> simp; ring + rw [hcoord] + exact hu + · have hnot : (⟨0,Y⟩ : GaussianInt) - + (P5332T1ParentRows P 0 1 0).companion ∉ FordVertexDomain P.q := + by + rw [rowCompanion] + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub] + have hbelow : Y < (P.q : Int) := by rw [hY]; omega + intro h + omega + constructor + · intro hm + exact False.elim (hnot hm) + · intro hh + norm_num at hh + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation2Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation2Values.lean new file mode 100644 index 0000000000..94c6ae1084 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation2Values.lean @@ -0,0 +1,233 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift + +-- [TABLET NODE: P5332T1Parent1Rotation2Values] + +/-! +# P5332T1Parent1Rotation2Values + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5332T1Parent1Rotation2Values (P A : FordFareyParameter) (hq : 1 < P.q) + (hAp : A.p = P.p₁) (hAq : A.q = P.q₁) + (f : IntegerLatticeFunction) (B : Int) (x : GaussianInt) + (hbase : ∀ y, y ∈ FordVertexDomain P.q → f y = FordOdometer P y) + (hother : ∀ y, + y - (P5332T1ParentRows P 0 2 0).displacement ∈ FordVertexDomain A.q → + f y = FordOdometer A (y - (P5332T1ParentRows P 0 2 0).displacement) + + (P5332T1ParentRows P 0 2 0).linear.re * y.re + + (P5332T1ParentRows P 0 2 0).linear.im * y.im + B) + (hx : x ∈ FordVertexDomain P.q) + (hx' : x - (P5332T1ParentRows P 0 2 0).displacement ∈ FordVertexDomain A.q) + (hstar : ∀ l : Fin 5, + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) ∈ FordVertexDomain P.q ∨ + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) - + (P5332T1ParentRows P 0 2 0).displacement ∈ FordVertexDomain A.q) : + ∃ t : Int, 0 ≤ t ∧ t < (P.q₁ : Int) ∧ + x = (P5332T1ParentRows P 0 2 t).center ∧ B = 0 ∧ + (∀ l : Fin 5, f (x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l)) = + (P5332T1ParentRows P 0 2 t).values l) ∧ + (x - (P5332T1ParentRows P 0 2 0).companion ∈ FordVertexDomain P.q ↔ + t = 0 ∧ Even (2+0 : Nat)) := by +-- BODY + classical + have hq' : 1 < (P.q : Int) := by exact_mod_cast hq + have hqtwo : 2 ≤ (P.q : Int) := by omega + have hqn : (P.q : Int) ≠ 0 := by omega + have hrpos : 0 < P.q₁ := by + by_contra h + have : P.q₁ = 0 := by omega + have hd := P.det₁ + rw [this] at hd + norm_num at hd + by_cases hp : P.p₁ ≤ 0 + · have hprod : P.p₁ * (P.q : Int) ≤ 0 := + mul_nonpos_of_nonpos_of_nonneg hp (by omega) + linarith + · have hp' : 1 ≤ P.p₁ := by omega + have hq0 : 0 ≤ (P.q : Int) := by omega + have hmul := mul_le_mul_of_nonneg_right hp' hq0 + have hmul' : (P.q : Int) ≤ P.p₁ * (P.q : Int) := by simpa using hmul + have hprod : 2 ≤ P.p₁ * (P.q : Int) := by + exact hqtwo.trans hmul' + nlinarith [hd, hprod] + have hrLtqInt : (P.q₁ : Int) < (P.q : Int) := by exact_mod_cast P.q₁_lt + have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ _ at laws + have boundaryP (u v : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) + (hv : 0 ≤ v) (hvq : v ≤ P.q) + (hs : u ≤ 1 ∨ (P.q : Int)-1 ≤ u ∨ v ≤ 1 ∨ (P.q : Int)-1 ≤ v) : + FordOdometer P ⟨u,v⟩ = IntegerCeilDiv (P.p*u*v) P.q hqn := by + apply laws.2.1 + change (0 ≤ u ∧ u ≤ (P.q : Int) ∧ 0 ≤ v ∧ v ≤ (P.q : Int)) ∧ + ¬(2 ≤ u ∧ u ≤ (P.q : Int)-2 ∧ 2 ≤ v ∧ v ≤ (P.q : Int)-2) + rcases hs with h | h | h | h <;> omega + have hra : (P.q₁ : Int) ≠ 0 := by omega + have boundaryA (u v : Int) (hu : 0 ≤ u) (huq : u ≤ P.q₁) + (hv : 0 ≤ v) (hvq : v ≤ P.q₁) + (hs : u ≤ 1 ∨ (P.q₁ : Int)-1 ≤ u ∨ v ≤ 1 ∨ (P.q₁ : Int)-1 ≤ v) : + FordOdometer A ⟨u,v⟩ = IntegerCeilDiv (A.p*u*v) P.q₁ hra := by + have hn : (A.q : Int) ≠ 0 := by rw [hAq]; exact hra + have hb := laws.2.1 A ⟨u,v⟩ + have hmem : (⟨u,v⟩ : GaussianInt) ∈ FordDoubledBoundary A.q := by + change (0 ≤ u ∧ u ≤ (A.q : Int) ∧ 0 ≤ v ∧ v ≤ (A.q : Int)) ∧ + ¬(2 ≤ u ∧ u ≤ (A.q : Int)-2 ∧ 2 ≤ v ∧ v ≤ (A.q : Int)-2) + rw [hAq] + omega + have hb' := hb hmem + change FordOdometer A ⟨u,v⟩ = + IntegerCeilDiv (A.p*u*v) A.q (by exact_mod_cast A.q_pos.ne') at hb' + convert hb' using 1; simp [hAp, hAq] + rcases x with ⟨X,Y⟩ + have hx0 := hx + have hx'0 := hx' + change 0 ≤ X ∧ X ≤ (P.q : Int) ∧ 0 ≤ Y ∧ Y ≤ (P.q : Int) at hx0 + simp? [P5332T1ParentRows, FordVertexDomain] at hx'0 + have hY : Y = 0 := by omega + subst Y + have hXr : X ≤ (P.q₁ : Int) := by simpa [hAq] using hx'0.2.1 + have hXpos : 0 < X := by + by_contra h + have : X = 0 := by omega + subst X + have hstarLeft := hstar 2 + dsimp [P5332T1ParentRows] at hstarLeft + simp [FordVertexDomain] at hstarLeft + let t : Int := (P.q₁ : Int) - X + let x0 : GaussianInt := ⟨X,0⟩ + have ht0 : 0 ≤ t := by dsimp [t]; omega + have htlt : t < (P.q₁ : Int) := by dsimp [t]; omega + have hX : X = (P.q₁ : Int) - t := by dsimp [t]; omega + have hcenter : x0 = (P5332T1ParentRows P 0 2 t).center := by + change (⟨X,0⟩ : GaussianInt) = _ + simp [P5332T1ParentRows, hX] + have hparentCenter := hother x0 (by + simp [x0, P5332T1ParentRows, FordVertexDomain] + omega) + have hbaseCenter := hbase x0 (by simpa [x0] using hx) + have leftA (z : Int) (hz : 0 ≤ z) (hzr : z ≤ P.q₁) : + FordOdometer A ⟨z,(P.q₁ : Int)⟩ = A.p*z := by + rw [boundaryA z (P.q₁ : Int) hz hzr (by omega) le_rfl (by omega)] + unfold IntegerCeilDiv + rw [show -(A.p*z*(P.q₁ : Int)) = -(A.p*z)*(P.q₁ : Int) by ring, + Int.mul_ediv_cancel _ hra] + ring + have bottomP (z : Int) (hz : 0 ≤ z) (hzq : z ≤ P.q) : + FordOdometer P ⟨z,0⟩ = 0 := by + rw [boundaryP z 0 hz hzq (by omega) (by omega) (by omega)] + simp [IntegerCeilDiv] + have centerarg : x0 - + (P5332T1ParentRows P 0 2 0).displacement = + ⟨X,(P.q₁ : Int)⟩ := by + change (⟨X,0⟩ : GaussianInt) - ⟨0,-(P.q₁ : Int)⟩ = _ + ext <;> simp + rw [centerarg] at hparentCenter + rw [leftA X (by omega) hXr] at hparentCenter + change f x0 = A.p*X + (-P.p₁)*X + 0*0 + B at hparentCenter + rw [bottomP X (by omega) (by omega)] at hbaseCenter + have B0 : B = 0 := by + rw [hAp] at hparentCenter + ring_nf at hparentCenter + linarith [hbaseCenter] + subst B + have valueBottom (z : Int) (hz : 0 ≤ z) (hzq : z ≤ P.q) : + f ⟨z,0⟩ = 0 := by + have hm : (⟨z,0⟩ : GaussianInt) ∈ FordVertexDomain P.q := by + simp [FordVertexDomain] + omega + exact (hbase ⟨z,0⟩ hm).trans + (bottomP z hz hzq) + have valueUp : f (x0 + ⟨0,1⟩) = IntegerCeilDiv (P.p*X) P.q hqn := by + have arg : x0 + ⟨0,1⟩ - + (P5332T1ParentRows P 0 2 0).displacement = + ⟨X,1+(P.q₁ : Int)⟩ := by + change (⟨X,0⟩ : GaussianInt) + ⟨0,1⟩ - ⟨0,-(P.q₁ : Int)⟩ = _ + ext <;> simp + have hdom : x0 + ⟨0,1⟩ ∈ FordVertexDomain P.q := by + simp [FordVertexDomain, x0] + omega + have hu := hbase (x0 + ⟨0,1⟩) hdom + have sourceEq : x0 + ⟨0,1⟩ = (⟨X,1⟩ : GaussianInt) := by + change (⟨X,0⟩ : GaussianInt) + ⟨0,1⟩ = _ + ext <;> simp + rw [sourceEq, boundaryP X 1 (by omega) (by omega) (by omega) + (by omega) (by omega)] at hu + rw [← sourceEq] at hu + have heq : P.p*X*1 = P.p*X := by ring + rw [heq] at hu + simpa [P5332T1ParentRows] using hu + have valueDown : f (x0 - ⟨0,1⟩) = -(P.p₁*X/(P.q₁ : Int)) := by + have arg : x0 - ⟨0,1⟩ - + (P5332T1ParentRows P 0 2 0).displacement = + ⟨X,(P.q₁ : Int)-1⟩ := by + ext <;> simp [x0, P5332T1ParentRows]; ring + have hd := hother (x0 - ⟨0,1⟩) (by + rw [arg] + simp only [FordVertexDomain, Set.mem_ofPred_eq] + rw [hAq] + omega) + rw [arg, boundaryA X ((P.q₁ : Int)-1) (by omega) (by omega) (by omega) + (by omega) (by omega)] at hd + dsimp [P5332T1ParentRows] at hd + rw [hAp] at hd + have hshift := P5188T1CeilingShift (-(P.p₁*X)) (P.p₁*X) P.q₁ hra + have harg : P.p₁*X*((P.q₁ : Int)-1) = + -(P.p₁*X)+(P.p₁*X)*(P.q₁ : Int) := by ring + rw [harg, hshift] at hd + dsimp [IntegerCeilDiv] at hd + have hval : -((- (-(P.p₁*X)))/(P.q₁ : Int)) = + -(P.p₁*X/(P.q₁ : Int)) := by norm_num + rw [hval] at hd + have hxcoord : x0.re = X := rfl + rw [hxcoord] at hd + ring_nf at hd + exact hd + refine ⟨t, ht0, htlt, ?_, rfl, ?_, ?_⟩ + · simpa [x0] using hcenter + · intro l + fin_cases l + · simpa [P5332T1ParentRows, x0] using valueBottom X (by omega) (by omega) + · have harg : x0 + 1 = ⟨X+1,0⟩ := by + change (⟨X,0⟩ : GaussianInt) + 1 = _ + ext <;> simp + have hv : f (x0+1) = 0 := by rw [harg]; exact valueBottom (X+1) (by omega) (by omega) + simpa [P5332T1ParentRows, x0] using hv + · have harg : x0 + (-1) = ⟨X-1,0⟩ := by + change (⟨X,0⟩ : GaussianInt) + (-1) = _ + ext <;> simp; ring + have hv : f (x0+(-1)) = 0 := by rw [harg]; exact valueBottom (X-1) (by omega) (by omega) + simpa [P5332T1ParentRows, x0] using hv + · simpa [P5332T1ParentRows, x0, ← hX, IntegerCeilDiv, Matrix.cons_val_three, Matrix.head_cons, + Matrix.tail_cons] using valueUp + · simpa [P5332T1ParentRows, x0, hX, Matrix.cons_val_four, Matrix.head_cons, + Matrix.tail_cons, sub_eq_add_neg] using valueDown + · constructor + · intro hmem + simp [P5332T1ParentRows, FordVertexDomain] at hmem + have htzero : t = 0 := by omega + exact ⟨htzero, by decide⟩ + · intro h + rcases h with ⟨htzero, _⟩ + simp [P5332T1ParentRows, FordVertexDomain] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation3Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation3Values.lean new file mode 100644 index 0000000000..279a2b742d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation3Values.lean @@ -0,0 +1,198 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift + +-- [TABLET NODE: P5332T1Parent1Rotation3Values] + +/-! +# P5332T1Parent1Rotation3Values + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5332T1Parent1Rotation3Values (P A : FordFareyParameter) (hq : 1 < P.q) + (hAp : A.p = P.p₁) (hAq : A.q = P.q₁) + (f : IntegerLatticeFunction) (B : Int) (x : GaussianInt) + (hbase : ∀ y, y ∈ FordVertexDomain P.q → f y = FordOdometer P y) + (hother : ∀ y, + y - (P5332T1ParentRows P 0 3 0).displacement ∈ FordVertexDomain A.q → + f y = FordOdometer A (y - (P5332T1ParentRows P 0 3 0).displacement) + + (P5332T1ParentRows P 0 3 0).linear.re * y.re + + (P5332T1ParentRows P 0 3 0).linear.im * y.im + B) + (hx : x ∈ FordVertexDomain P.q) + (hx' : x - (P5332T1ParentRows P 0 3 0).displacement ∈ FordVertexDomain A.q) + (hstar : ∀ l : Fin 5, + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) ∈ FordVertexDomain P.q ∨ + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) - + (P5332T1ParentRows P 0 3 0).displacement ∈ FordVertexDomain A.q) : + ∃ t : Int, 0 ≤ t ∧ t < (P.q₁ : Int) ∧ + x = (P5332T1ParentRows P 0 3 t).center ∧ B = 0 ∧ + (∀ l : Fin 5, f (x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l)) = + (P5332T1ParentRows P 0 3 t).values l) ∧ + (x - (P5332T1ParentRows P 0 3 0).companion ∈ FordVertexDomain P.q ↔ + t = 0 ∧ Even (3+0 : Nat)) := by +-- BODY + classical + have hq1_lt : P.q₁ < P.q := P.q₁_lt + have hq1_pos : 0 < P.q₁ := by + by_contra h + have hz : P.q₁ = 0 := by omega + have : P.p₁ * (P.q : Int) = 1 := by + simpa [hz] using P.det₁ + have hqpos : 1 < (P.q : Int) := by exact_mod_cast hq + by_cases hp : P.p₁ ≤ 0 + · nlinarith + · have hp1 : 1 ≤ P.p₁ := by omega + have hprod : 0 ≤ (P.p₁ - 1) * ((P.q : Int) - 1) := + mul_nonneg (by omega) (by omega) + nlinarith + have hA : (A.q : Int) = (P.q₁ : Int) := by exact_mod_cast hAq + rcases x with ⟨X,Y⟩ + change 0 ≤ X ∧ X ≤ (P.q : Int) ∧ 0 ≤ Y ∧ Y ≤ (P.q : Int) at hx + have hx'0 := hx' + dsimp [P5332T1ParentRows] at hx'0 + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub, + sub_zero] at hx'0 + change 0 ≤ X - P.q ∧ X - P.q ≤ (A.q : Int) ∧ + 0 ≤ Y ∧ Y ≤ (A.q : Int) at hx'0 + have hX : X = P.q := by omega + subst X + have hYlow : 0 ≤ Y := hx.2.2.1 + have hYhigh : Y ≤ P.q₁ := by simpa [hA] using hx'0.2.2.2 + have hsouth := hstar 4 + dsimp [P5332T1ParentRows] at hsouth + have hYpos : 1 ≤ Y := by + by_contra hy + have hy0 : Y = 0 := by omega + subst Y + norm_num [FordVertexDomain, P5332T1ParentRows] at hsouth + let t : Int := P.q₁ - Y + have ht0 : 0 ≤ t := by dsimp [t]; omega + have htr : t < (P.q₁ : Int) := by dsimp [t]; omega + have hY : Y = P.q₁ - t := by dsimp [t]; omega + have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ _ at laws + have boundary (R : FordFareyParameter) (u v : Int) + (hu : 0 ≤ u) (huq : u ≤ R.q) (hv : 0 ≤ v) (hvq : v ≤ R.q) + (hs : u ≤ 1 ∨ (R.q : Int)-1 ≤ u ∨ v ≤ 1 ∨ (R.q : Int)-1 ≤ v) : + FordOdometer R ⟨u,v⟩ = IntegerCeilDiv (R.p*u*v) R.q (by + have hR : 0 < (R.q : Int) := by exact_mod_cast R.q_pos + omega) := by + apply laws.2.1 + change (0 ≤ u ∧ u ≤ (R.q : Int) ∧ 0 ≤ v ∧ v ≤ (R.q : Int)) ∧ + ¬(2 ≤ u ∧ u ≤ (R.q : Int)-2 ∧ 2 ≤ v ∧ v ≤ (R.q : Int)-2) + omega + have rightChild (v : Int) (hv : 0 ≤ v) (hvq : v ≤ P.q) : + FordOdometer P ⟨(P.q : Int),v⟩ = P.p*v := by + rw [boundary P _ _ (by omega) (by omega) hv hvq (by omega)] + unfold IntegerCeilDiv + rw [show -(P.p*(P.q : Int)*v) = -(P.p*v)*(P.q : Int) by ring, + Int.mul_ediv_cancel _ (by omega)] + ring + have leftParent (v : Int) (hv : 0 ≤ v) (hvq : v ≤ P.q₁) : + FordOdometer A ⟨0,v⟩ = 0 := by + have hvqA : v ≤ A.q := by simpa [hA] using hvq + rw [boundary A _ _ (by omega) (by omega) hv hvqA (Or.inl (by omega))] + simp [IntegerCeilDiv] + have hcenterBase := hbase ⟨(P.q : Int),Y⟩ (by + change 0 ≤ (P.q : Int) ∧ (P.q : Int) ≤ P.q ∧ 0 ≤ Y ∧ Y ≤ P.q + omega) + have harg : (⟨(P.q : Int),Y⟩ : GaussianInt) - ⟨(P.q : Int),0⟩ = ⟨0,Y⟩ := by + ext <;> simp + have hcenterOther := hother ⟨(P.q : Int),Y⟩ (by + dsimp [P5332T1ParentRows] + rw [harg] + change 0 ≤ (0 : Int) ∧ (0 : Int) ≤ (A.q : Int) ∧ 0 ≤ Y ∧ Y ≤ (A.q : Int) + exact ⟨by omega, by omega, hYlow, by simpa [hA] using hYhigh⟩) + dsimp [P5332T1ParentRows] at hcenterOther + rw [harg, leftParent Y hYlow hYhigh] at hcenterOther + rw [rightChild Y hYlow (by omega)] at hcenterBase + simp only [zero_mul, zero_add, add_zero] at hcenterOther + have hB : B = 0 := by omega + have hB0 := hB + subst B + have valueR (z : Int) (hz : 0 ≤ z) (hzq : z ≤ P.q) : + f ⟨(P.q : Int),z⟩ = P.p*z := by + exact (hbase ⟨(P.q : Int),z⟩ (by + change 0 ≤ (P.q : Int) ∧ (P.q : Int) ≤ P.q ∧ 0 ≤ z ∧ z ≤ P.q + omega)).trans (rightChild z hz hzq) + have valueE : f ((⟨(P.q : Int),Y⟩ : GaussianInt)+1) = + P.p*Y + IntegerCeilDiv (P.p₁*Y) P.q₁ (by omega) := by + have arg : (⟨(P.q : Int),Y⟩ : GaussianInt)+1-⟨(P.q : Int),0⟩ = ⟨1,Y⟩ := by + ext <;> simp + have he := hother (⟨(P.q : Int),Y⟩+1) (by + dsimp [P5332T1ParentRows] + rw [arg] + change 0 ≤ (1 : Int) ∧ (1 : Int) ≤ (A.q : Int) ∧ + 0 ≤ Y ∧ Y ≤ (A.q : Int) + have hrA : 0 < (A.q : Int) := by rw [hA]; exact_mod_cast hq1_pos + exact ⟨by omega, by omega, hYlow, by simpa [hA] using hYhigh⟩) + dsimp [P5332T1ParentRows] at he + rw [arg, boundary A 1 Y (by omega) (by omega) hYlow + (by simpa [hA] using hYhigh) (Or.inl (by omega))] at he + simp only [zero_mul, add_zero] at he + have he' : f ((⟨(P.q : Int),Y⟩ : GaussianInt)+1) = + P.p*Y + IntegerCeilDiv (P.p₁*Y) P.q₁ (by omega) := by + simpa [hAp, hAq, one_mul, mul_one, add_comm] using he + exact he' + have valueW : f ((⟨(P.q : Int),Y⟩ : GaussianInt)-1) = + P.p*Y - P.p*Y/(P.q : Int) := by + have arg : (⟨(P.q : Int),Y⟩ : GaussianInt)-1 = ⟨(P.q : Int)-1,Y⟩ := by + ext <;> simp + rw [arg, hbase (⟨(P.q : Int)-1,Y⟩ : GaussianInt) (by + change 0 ≤ (P.q : Int)-1 ∧ (P.q : Int)-1 ≤ P.q ∧ 0 ≤ Y ∧ Y ≤ P.q + omega)] + rw [boundary P ((P.q : Int)-1) Y (by omega) (by omega) hYlow (by omega) + (Or.inr (Or.inl (by omega)))] + have hnum : P.p*((P.q : Int)-1)*Y = -(P.p*Y)+(P.p*Y)*(P.q : Int) := by ring + rw [hnum, P5188T1CeilingShift (-(P.p*Y)) (P.p*Y) P.q (by omega)] + simp [IntegerCeilDiv] + ring + refine ⟨t, ht0, htr, ?_, hB0, ?_, ?_⟩ + · dsimp [P5332T1ParentRows] + ext <;> simp [hY] + · intro l + fin_cases l + · simpa [P5332T1ParentRows, hY] using valueR Y hYlow (by omega) + · simpa [P5332T1ParentRows, hY, IntegerCeilDiv] using valueE + · norm_num + change f ((⟨(P.q : Int),Y⟩ : GaussianInt)-1) = _ + simpa [P5332T1ParentRows, hY] using valueW + · norm_num + simpa [P5332T1ParentRows, hY] using valueR (Y+1) (by omega) (by omega) + · have hs : (⟨(P.q : Int),Y⟩ : GaussianInt)-⟨0,1⟩ = ⟨(P.q : Int),Y-1⟩ := by + ext <;> simp + norm_num + change f ((⟨(P.q : Int),Y⟩ : GaussianInt)-⟨0,1⟩) = _ + rw [hs] + simpa [P5332T1ParentRows, hY] using valueR (Y-1) (by omega) (by omega) + · constructor + · intro hmem + dsimp [P5332T1ParentRows] at hmem + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, + Zsqrtd.im_sub] at hmem + omega + · intro h + rcases h with ⟨_, hEven⟩ + rcases hEven with ⟨n, hn⟩ + have : False := by omega + exact this.elim + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean new file mode 100644 index 0000000000..32a4acaadf --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean @@ -0,0 +1,321 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift + +-- [TABLET NODE: P5332T1Parent2Rotation0Values] + +/-! +# P5332T1Parent2Rotation0Values + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace Parent2Rotation0Proof + +private theorem rpos : + ∀ (P : FordFareyParameter), (FordFareyParameter) → (((1 : ℕ) < P.q) → ((1 < (P.q : Int)) → (0 + < (P.q₁ : Int)))) := by + classical + intro P A hq hq' + by_contra hn + have hz : (P.q₁ : Int) = 0 := by omega + have : P.p₁ * (P.q : Int) = 1 := by rw [← P.det₁]; simp [hz] + by_cases hp : P.p₁ ≤ 0 + · have hq2 : 2 ≤ (P.q : Int) := hq' + nlinarith + · have hp' : 1 ≤ P.p₁ := by omega + have hq2 : 2 ≤ (P.q : Int) := hq' + nlinarith + +private theorem hcenterB : + ∀ (P : FordFareyParameter), ∀ (A : FordFareyParameter), ∀ (f : IntegerLatticeFunction), ∀ (B + : Int), (∀ y ∈ FordVertexDomain P.q, f y = FordOdometer P y) → ((∀ (y : GaussianInt), y - + (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (0 : Fin (4 : ℕ)) (0 : ℤ)).displacement ∈ + FordVertexDomain A.q → f y = FordOdometer A (y - (P5332T1ParentRows P (1 : Fin (2 : ℕ)) + (0 : Fin (4 : ℕ)) (0 : ℤ)).displacement) + (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (0 : + Fin (4 : ℕ)) (0 : ℤ)).linear.re * y.re + (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (0 : + Fin (4 : ℕ)) (0 : ℤ)).linear.im * y.im + B) → (((P.q : Int) = (P.q₁ : Int) + (P.q₂ : + Int)) → ((0 < (P.q₂ : Int)) → (((P.q₂ : Int) ≠ 0) → (∀ (Y : ℤ), ((↑A.q : ℤ) = (↑P.q₂ : + ℤ)) → (((P5332T1ParentRows P (1 : Fin (2 : ℕ)) (0 : Fin (4 : ℕ)) (0 : ℤ)).displacement + = ⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩) → (((0 : ℤ) ≤ (0 : ℤ) ∧ (0 : ℤ) ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ Y ∧ Y + ≤ (↑P.q : ℤ)) → (((0 : ℤ) ≤ (0 : ℤ) + (↑P.q₂ : ℤ) ∧ (0 : ℤ) + (↑P.q₂ : ℤ) ≤ (↑P.q₂ : ℤ) ∧ + (0 : ℤ) ≤ Y ∧ Y ≤ (↑P.q₂ : ℤ)) → ((Y ≤ (P.q₂ : Int)) → ((1 ≤ Y) → ((∀ (v : Int), (0 ≤ v) + → ((v ≤ P.q) → (FordOdometer P ⟨0,v⟩ = 0))) → ((∀ (u : Int), ∀ (v : Int), (0 ≤ u) → ((u ≤ + P.q₂) → ((0 ≤ v) → ((v ≤ P.q₂) → ((u ≤ 1 ∨ (P.q₂ : Int)-1 ≤ u ∨ v ≤ 1 ∨ (P.q₂ : Int)-1 ≤ + v) → (FordOdometer A ⟨u,v⟩ = IntegerCeilDiv (P.p₂*u*v) P.q₂ (by exact_mod_cast + P.q₂_pos.ne'))))))) → (B = 0))))))))))))) := by + classical + intro P A f B hbase hother qsum spos hsn Y hAqInt hdisp hx0 hx'0 hY hlow valLeft valA + have hc := hbase ⟨0,Y⟩ ⟨by simp, by simp, by exact hx0.2.2.1, by exact hx0.2.2.2⟩ + have ho := hother ⟨0,Y⟩ (by + rw [hdisp] + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub, + sub_zero] + rw [hAqInt] + omega) + rw [hdisp] at ho + have arg : (⟨0,Y⟩ : GaussianInt) - ⟨-(P.q₂ : Int),0⟩ = ⟨(P.q₂ : Int),Y⟩ := by + ext <;> simp + rw [arg] at ho + have hlinR : (P5332T1ParentRows P 1 0 0).linear.re = 0 := by rfl + have hlinI : (P5332T1ParentRows P 1 0 0).linear.im = -P.p₂ := by rfl + rw [hlinR, hlinI] at ho + simp only [zero_mul, neg_mul, add_zero] at ho + rw [valLeft Y (by omega) (by omega)] at hc + have hvA := valA (P.q₂ : Int) Y (by omega) (by omega) (by omega) (by omega) (by omega) + rw [hvA] at ho + have hceil : IntegerCeilDiv (P.p₂*(P.q₂ : Int)*Y) P.q₂ + (by exact_mod_cast P.q₂_pos.ne') = P.p₂*Y := by + unfold IntegerCeilDiv + rw [show -(P.p₂*(P.q₂ : Int)*Y) = -(P.p₂*Y)*(P.q₂ : Int) by ring, + Int.mul_ediv_cancel _ hsn] + ring + rw [hceil] at ho + linarith [ho, hc] + +private theorem values : + ∀ (P : FordFareyParameter), ∀ (A : FordFareyParameter), ((1 : ℕ) < P.q) → (∀ (f : + IntegerLatticeFunction), (∀ y ∈ FordVertexDomain P.q, f y = FordOdometer P y) → (((P.q : + Int) = (P.q₁ : Int) + (P.q₂ : Int)) → ((0 < (P.q₁ : Int)) → ((0 < (P.q₂ : Int)) → (((P.q₂ + : Int) ≠ 0) → (∀ (Y : ℤ), ((↑A.q : ℤ) = (↑P.q₂ : ℤ)) → (((P5332T1ParentRows P (1 : Fin + (2 : ℕ)) (0 : Fin (4 : ℕ)) (0 : ℤ)).displacement = ⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩) → (((0 : ℤ) ≤ + (0 : ℤ) ∧ (0 : ℤ) ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ Y ∧ Y ≤ (↑P.q : ℤ)) → (((0 : ℤ) ≤ (0 : ℤ) + + (↑P.q₂ : ℤ) ∧ (0 : ℤ) + (↑P.q₂ : ℤ) ≤ (↑P.q₂ : ℤ) ∧ (0 : ℤ) ≤ Y ∧ Y ≤ (↑P.q₂ : ℤ)) → ((Y + ≤ (P.q₂ : Int)) → ((1 ≤ Y) → ( + let t : Int := (P.q₂ : Int) - Y + (∀ (v : Int), (0 ≤ v) → ((v ≤ P.q) → (FordOdometer P ⟨0,v⟩ = 0))) → ((∀ (v : Int), (0 ≤ v) → + ((v ≤ P.q) → (FordOdometer P ⟨1,v⟩ = IntegerCeilDiv (P.p*v) P.q (by exact_mod_cast + P.q_pos.ne')))) → ((∀ (u : Int), ∀ (v : Int), (0 ≤ u) → ((u ≤ P.q₂) → ((0 ≤ v) → ((v ≤ + P.q₂) → ((u ≤ 1 ∨ (P.q₂ : Int)-1 ≤ u ∨ v ≤ 1 ∨ (P.q₂ : Int)-1 ≤ v) → (FordOdometer A + ⟨u,v⟩ = IntegerCeilDiv (P.p₂*u*v) P.q₂ (by exact_mod_cast P.q₂_pos.ne'))))))) → ((∀ (y : + GaussianInt), y - (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (0 : Fin (4 : ℕ)) (0 : + ℤ)).displacement ∈ FordVertexDomain A.q → f y = FordOdometer A (y - (P5332T1ParentRows + P (1 : Fin (2 : ℕ)) (0 : Fin (4 : ℕ)) (0 : ℤ)).displacement) + (P5332T1ParentRows P (1 + : Fin (2 : ℕ)) (0 : Fin (4 : ℕ)) (0 : ℤ)).linear.re * y.re + (P5332T1ParentRows P (1 : + Fin (2 : ℕ)) (0 : Fin (4 : ℕ)) (0 : ℤ)).linear.im * y.im + (0 : ℤ)) → (∀ l : Fin 5, f + ((⟨0,Y⟩ : GaussianInt) + (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] l)) = + (P5332T1ParentRows P 1 0 t).values l)))))))))))))))) := by + classical + intro P A hq f hbase qsum rpos spos hsn Y hAqInt hdisp hx0 hx'0 hY hlow t valLeft valChildEast + valA hother l + fin_cases l + · simp? [] + have hh := hbase ⟨0,Y⟩ hx0 + rw [hh, valLeft Y (by omega) (by omega)] + simp [P5332T1ParentRows] + · simp? [] + have eastArg : (⟨0,Y⟩ : GaussianInt) + 1 = ⟨1,Y⟩ := by ext <;> simp + rw [eastArg] + have hh := hbase ⟨1,Y⟩ (by + change 0 ≤ (1 : Int) ∧ 1 ≤ (P.q : Int) ∧ 0 ≤ Y ∧ Y ≤ P.q + omega) + rw [hh, valChildEast Y (by omega) (by omega)] + simp? [P5332T1ParentRows, IntegerCeilDiv] + have hy : Y = (P.q₂ : Int)-t := by dsimp [t]; omega + rw [hy] + · simp? [Fin.reduceFinMk] + have arg : (⟨0,Y⟩ : GaussianInt)-1 = ⟨-1,Y⟩ := by ext <;> simp + have hp := hother (⟨0,Y⟩-1) (by + rw [arg] + rw [hdisp] + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub, + sub_zero] + rw [hAqInt] + omega) + rw [hdisp] at hp + have parg : (⟨-1,Y⟩ : GaussianInt)-⟨-(P.q₂ : Int),0⟩ = ⟨(P.q₂ : Int)-1,Y⟩ := by + ext <;> simp; omega + rw [arg, parg] at hp + have hlinI : (P5332T1ParentRows P 1 0 0).linear.im = -P.p₂ := by rfl + have hlinR : (P5332T1ParentRows P 1 0 0).linear.re = 0 := by rfl + rw [hlinI, hlinR] at hp + simp only [zero_mul, neg_mul, add_zero] at hp + have hbnd := valA ((P.q₂ : Int)-1) Y (by omega) (by omega) + (by omega) (by omega) (by omega) + rw [hbnd] at hp + have hnum : P.p₂*((P.q₂ : Int)-1)*Y = -P.p₂*Y+(P.p₂*Y)*(P.q₂ : Int) := by ring + rw [hnum, P5188T1CeilingShift (-P.p₂*Y) (P.p₂*Y) P.q₂ hsn] at hp + simp only [IntegerCeilDiv, neg_mul, neg_neg] at hp + ring_nf at hp + have hy : Y = (P.q₂ : Int)-t := by dsimp [t]; omega + have westPlus : (⟨0,Y⟩ : GaussianInt) + (-1) = ⟨-1,Y⟩ := by ext <;> simp + rw [westPlus, hy] + have hrowval : (P5332T1ParentRows P 1 0 t).values 2 = + -(P.p₂*((P.q₂ : Int)-t)/(P.q₂ : Int)) := by rfl + rw [hrowval] + simpa only [hy] using hp + · simp? [Fin.reduceFinMk] + have northArg : (⟨0,Y⟩ : GaussianInt) + ⟨0,1⟩ = ⟨0,Y+1⟩ := by ext <;> simp + have hh := hbase ⟨0,Y+1⟩ (by + change (0 : Int) ≤ 0 ∧ 0 ≤ (P.q : Int) ∧ 0 ≤ Y+1 ∧ Y+1 ≤ (P.q : Int) + omega) + rw [hh, valLeft (Y+1) (by omega) (by omega)] + simp [P5332T1ParentRows] + · simp? [Fin.reduceFinMk] + have southArg : (⟨0,Y⟩ : GaussianInt) - ⟨0,1⟩ = ⟨0,Y-1⟩ := by ext <;> simp + have southPlus : (⟨0,Y⟩ : GaussianInt) + (-⟨0,1⟩) = ⟨0,Y-1⟩ := by + ext <;> simp; ring + rw [southPlus] + have hh := hbase ⟨0,Y-1⟩ (by + change (0 : Int) ≤ 0 ∧ 0 ≤ (P.q : Int) ∧ 0 ≤ Y-1 ∧ Y-1 ≤ (P.q : Int) + omega) + rw [hh, valLeft (Y-1) (by omega) (by omega)] + simp [P5332T1ParentRows] + +private theorem companion : + ∀ (P : FordFareyParameter), (FordFareyParameter) → (((P.q : Int) = (P.q₁ : Int) + (P.q₂ : + Int)) → (∀ (Y : ℤ), ((0 : ℤ) ≤ (0 : ℤ) ∧ (0 : ℤ) ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ Y ∧ Y ≤ (↑P.q : + ℤ)) → ((1 ≤ Y) → ( + let t : Int := (P.q₂ : Int) - Y + (⟨0,Y⟩ : GaussianInt) - (P5332T1ParentRows P 1 0 0).companion ∈ FordVertexDomain P.q ↔ t = + 0 ∧ Even (0+1 : Nat))))) := by + classical + intro P A qsum Y hx0 hlow t + have hn : ¬ Even (0+1 : Nat) := by norm_num + have hcomp : (P5332T1ParentRows P 1 0 0).companion = + ⟨-(P.q₂ : Int),-(P.q : Int)⟩ := by rfl + constructor + · intro h + rw [hcomp] at h + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, + Zsqrtd.im_sub] at h + have hy : Y ≥ 0 := hx0.2.2.1 + have hqnat : (P.q : Int) = (P.q₁ : Int)+(P.q₂ : Int) := qsum + omega + · rintro ⟨_, he⟩ + exact (hn he).elim + +end Parent2Rotation0Proof + +theorem P5332T1Parent2Rotation0Values (P A : FordFareyParameter) (hq : 1 < P.q) + (hAp : A.p = P.p₂) (hAq : A.q = P.q₂) + (f : IntegerLatticeFunction) (B : Int) (x : GaussianInt) + (hbase : ∀ y, y ∈ FordVertexDomain P.q → f y = FordOdometer P y) + (hother : ∀ y, + y - (P5332T1ParentRows P 1 0 0).displacement ∈ FordVertexDomain A.q → + f y = FordOdometer A (y - (P5332T1ParentRows P 1 0 0).displacement) + + (P5332T1ParentRows P 1 0 0).linear.re * y.re + + (P5332T1ParentRows P 1 0 0).linear.im * y.im + B) + (hx : x ∈ FordVertexDomain P.q) + (hx' : x - (P5332T1ParentRows P 1 0 0).displacement ∈ FordVertexDomain A.q) + (hstar : ∀ l : Fin 5, + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) ∈ FordVertexDomain P.q ∨ + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) - + (P5332T1ParentRows P 1 0 0).displacement ∈ FordVertexDomain A.q) : + ∃ t : Int, 0 ≤ t ∧ t < (P.q₂ : Int) ∧ + x = (P5332T1ParentRows P 1 0 t).center ∧ B = 0 ∧ + (∀ l : Fin 5, f (x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l)) = + (P5332T1ParentRows P 1 0 t).values l) ∧ + (x - (P5332T1ParentRows P 1 0 0).companion ∈ FordVertexDomain P.q ↔ + t = 0 ∧ Even (0+1 : Nat)) := by +-- BODY + classical + have hq' : 1 < (P.q : Int) := by exact_mod_cast hq + have qsum : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by exact_mod_cast P.sum_q + have rpos : 0 < (P.q₁ : Int) := Parent2Rotation0Proof.rpos P A hq hq' + have spos : 0 < (P.q₂ : Int) := by exact_mod_cast P.q₂_pos + have rlt : (P.q₁ : Int) < P.q := by exact_mod_cast P.q₁_lt + have slt : (P.q₂ : Int) < P.q := by omega + have hqn : (P.q : Int) ≠ 0 := by omega + have hsn : (P.q₂ : Int) ≠ 0 := by omega + have hdet : P.p₂ * (P.q : Int) - (P.q₂ : Int) * P.p = -1 := P.det₂ + have hsumP : P.p = P.p₁ + P.p₂ := P.sum_p + have hcross : P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1 := by + nlinarith [P.det₁, P.det₂, P.sum_q, P.sum_p] + have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ + (∀ P x, x ∈ FordDoubledBoundary P.q → FordOdometer P x = _) ∧ _ at laws + have boundary (R : FordFareyParameter) (u v : Int) + (hu : 0 ≤ u) (huq : u ≤ R.q) (hv : 0 ≤ v) (hvq : v ≤ R.q) + (hs : u ≤ 1 ∨ (R.q : Int)-1 ≤ u ∨ v ≤ 1 ∨ (R.q : Int)-1 ≤ v) : + FordOdometer R ⟨u,v⟩ = IntegerCeilDiv (R.p*u*v) R.q + (by exact_mod_cast R.q_pos.ne') := by + apply laws.2.1 + change (0 ≤ u ∧ u ≤ (R.q : Int) ∧ 0 ≤ v ∧ v ≤ (R.q : Int)) ∧ + ¬ (2 ≤ u ∧ u ≤ (R.q : Int)-2 ∧ 2 ≤ v ∧ v ≤ (R.q : Int)-2) + omega + rcases x with ⟨X,Y⟩ + have hx0 := hx + have hx'0 := hx' + change 0 ≤ X ∧ X ≤ P.q ∧ 0 ≤ Y ∧ Y ≤ P.q at hx0 + have hAqInt : (A.q : Int) = (P.q₂ : Int) := by exact_mod_cast hAq + have hdisp : (P5332T1ParentRows P 1 0 0).displacement = ⟨-(P.q₂ : Int),0⟩ := by rfl + rw [hdisp] at hx'0 + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, + Zsqrtd.im_sub] at hx'0 + rw [hAqInt] at hx'0 + simp only [sub_neg_eq_add, sub_zero] at hx'0 + have hX : X = 0 := by + omega + subst X + have hY : Y ≤ (P.q₂ : Int) := by + omega + have hlow : 1 ≤ Y := by + have hsouth := hstar (4 : Fin 5) + have hstencil : (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] (4 : Fin 5)) = -⟨0,1⟩ := by rfl + rw [hstencil] at hsouth + rw [hdisp] at hsouth + norm_num [FordVertexDomain] at hsouth + rw [hAqInt] at hsouth + omega + let t : Int := (P.q₂ : Int) - Y + have ht0 : 0 ≤ t := by dsimp [t]; omega + have hts : t < (P.q₂ : Int) := by dsimp [t]; omega + have hxcenter : (⟨0,Y⟩ : GaussianInt) = (P5332T1ParentRows P 1 0 t).center := by + dsimp [P5332T1ParentRows, t] + ext <;> simp + have valLeft (v : Int) (hv : 0 ≤ v) (hvq : v ≤ P.q) : + FordOdometer P ⟨0,v⟩ = 0 := by + rw [boundary P 0 v (by omega) (by omega) hv hvq (by omega)] + simp [IntegerCeilDiv] + have valRight (v : Int) (hv : 0 ≤ v) (hvq : v ≤ P.q) : + FordOdometer P ⟨(P.q : Int),v⟩ = P.p*v := by + rw [boundary P P.q v (by omega) (by omega) hv hvq (by omega)] + unfold IntegerCeilDiv + rw [show -(P.p*(P.q : Int)*v) = -(P.p*v)*(P.q : Int) by ring, + Int.mul_ediv_cancel _ hqn] + ring + have valChildEast (v : Int) (hv : 0 ≤ v) (hvq : v ≤ P.q) : + FordOdometer P ⟨1,v⟩ = IntegerCeilDiv (P.p*v) P.q (by exact_mod_cast P.q_pos.ne') := by + rw [boundary P 1 v (by omega) (by omega) hv hvq (by omega)] + congr 1 + ring + have valA (u v : Int) (hu : 0 ≤ u) (huq : u ≤ P.q₂) + (hv : 0 ≤ v) (hvq : v ≤ P.q₂) + (hs : u ≤ 1 ∨ (P.q₂ : Int)-1 ≤ u ∨ v ≤ 1 ∨ (P.q₂ : Int)-1 ≤ v) : + FordOdometer A ⟨u,v⟩ = IntegerCeilDiv (P.p₂*u*v) P.q₂ (by exact_mod_cast P.q₂_pos.ne') := by + have hb := boundary A u v hu (by simpa only [hAqInt] using huq) + hv (by simpa only [hAqInt] using hvq) (by simpa only [hAqInt] using hs) + simpa only [hAp, hAq] using hb + have hcenterB : B = 0 := Parent2Rotation0Proof.hcenterB P A f B hbase hother qsum spos hsn Y + hAqInt hdisp hx0 hx'0 hY hlow valLeft valA + subst B + have values : ∀ l : Fin 5, + f ((⟨0,Y⟩ : GaussianInt) + (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] l)) = + (P5332T1ParentRows P 1 0 t).values l := Parent2Rotation0Proof.values P A hq f hbase + qsum rpos spos hsn Y hAqInt hdisp hx0 hx'0 hY hlow valLeft valChildEast valA hother + have companion : (⟨0,Y⟩ : GaussianInt) - + (P5332T1ParentRows P 1 0 0).companion ∈ FordVertexDomain P.q ↔ + t = 0 ∧ Even (0+1 : Nat) := Parent2Rotation0Proof.companion P A qsum Y hx0 hlow + refine ⟨t, ht0, hts, hxcenter, rfl, ?_, companion⟩ + intro l + exact values l + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean new file mode 100644 index 0000000000..56ba37b7e1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean @@ -0,0 +1,312 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift + +-- [TABLET NODE: P5332T1Parent2Rotation1Values] + +/-! +# P5332T1Parent2Rotation1Values + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ParentTwoRotationOneProof + +private theorem hrpos : + ∀ (P : FordFareyParameter), (FordFareyParameter) → (((1 : ℕ) < P.q) → (0 < P.q₁)) := by + classical + intro P A hq + by_contra h; have hr0 : P.q₁ = 0 := by omega + have := P.det₁ + rw [hr0] at this + have hpq : P.p₁ * (P.q : Int) = 1 := by omega + have hp1 : P.q = 1 := by + have hdvd : (P.q : Int) ∣ 1 := ⟨P.p₁, by nlinarith⟩ + have hle : (P.q : Int) ≤ 1 := Int.le_of_dvd (by norm_num) hdvd + have : P.q ≤ 1 := by exact_mod_cast hle + omega + omega + +private theorem hcenterA : + ∀ (P : FordFareyParameter), ∀ (A : FordFareyParameter), (A.p = P.p₂) → ((A.q = + P.q₂) → ((IntegerLatticeFunction) → ((Int) → ((0 < P.q₂) → ((∀ (r : Int), ∀ (z : Int), (0 + ≤ r) → ((r ≤ A.q) → ((0 ≤ z) → ((z ≤ A.q) → ((r ≤ 1 ∨ (A.q : Int)-1 ≤ r ∨ z ≤ 1 ∨ + (A.q : Int)-1 ≤ z) → (FordOdometer A ⟨r,z⟩ = + IntegerCeilDiv (A.p*r*z) A.q (by exact_mod_cast A.q_pos.ne'))))))) → (∀ (X : ℤ), (ℤ) → + (((A.q + : Int) = P.q₂) → ( + let t : Int := X-(P.q₁ : Int) + (0 ≤ t) → ((t < P.q₂) → (FordOdometer A ⟨t,P.q₂⟩ = P.p₂*t)))))))))) := by + classical + intro P A hAp hAq f B hspos boundaryA X Y hAqInt t ht0 hstrict + have hbA := boundaryA t P.q₂ ht0 (by omega) (by omega) (by omega) (by omega) + have hbA' : FordOdometer A ⟨t,P.q₂⟩ = + IntegerCeilDiv (P.p₂*t*P.q₂) P.q₂ (by omega) := by + simpa [hAp, hAqInt] using hbA + rw [hbA'] + simp only [IntegerCeilDiv] + rw [show -(P.p₂*t*P.q₂) = (-(P.p₂*t))*P.q₂ by ring, + Int.mul_ediv_cancel _ (by omega)] + ring + +private theorem southVal : + ∀ (P : FordFareyParameter), ∀ (A : FordFareyParameter), (A.p = P.p₂) → ((A.q = + P.q₂) → (∀ (f : IntegerLatticeFunction), ((P.q : Int) ≠ 0) → ((0 < P.q₂) → ((∀ (r : Int), + ∀ (z : Int), (0 ≤ r) → ((r ≤ A.q) → ((0 ≤ z) → ((z + ≤ A.q) → ((r ≤ 1 ∨ (A.q : Int)-1 ≤ r ∨ z ≤ 1 ∨ (A.q : Int)-1 ≤ z) → (FordOdometer A + ⟨r,z⟩ = IntegerCeilDiv (A.p*r*z) A.q (by exact_mod_cast A.q_pos.ne'))))))) → (∀ (X : ℤ), + ∀ (Y : ℤ), ((0 : ℤ) ≤ X - (↑P.q₁ : ℤ) ∧ X - (↑P.q₁ : ℤ) ≤ (↑A.q : ℤ) ∧ (0 : ℤ) ≤ Y - + -(↑P.q₂ : + ℤ) ∧ Y - -(↑P.q₂ : ℤ) ≤ (↑A.q : ℤ)) → (((P5332T1ParentRows P (1 : Fin (2 : ℕ)) (1 : Fin + (4 : ℕ)) (0 : ℤ)).displacement = ⟨(↑P.q₁ : ℤ), -(↑P.q₂ : ℤ)⟩) → (((A.q : Int) = P.q₂) → + ((Y = 0) → ( + let t : Int := X-(P.q₁ : Int) + (0 ≤ t) → ((X = P.q₁ + t) → ((t < P.q₂) → (((P5332T1ParentRows P 1 1 0).linear = + ⟨-P.p₂,P.p₁⟩) → ((∀ (y : GaussianInt), y - (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (1 : + Fin (4 : ℕ)) (0 : ℤ)).displacement ∈ FordVertexDomain A.q → f y = FordOdometer A (y - + (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (1 : Fin (4 : ℕ)) (0 : ℤ)).displacement) + + (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (1 : Fin (4 : ℕ)) (0 : ℤ)).linear.re * y.re + + (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (1 : Fin (4 : ℕ)) (0 : ℤ)).linear.im * y.im + + P.p₂ * (↑P.q₁ : ℤ)) → (((⟨X,Y⟩ : GaussianInt)-⟨0,1⟩ = ⟨X,Y-1⟩) → (f (⟨X,Y⟩-⟨0,1⟩) = -P.p₁ + - (P.p₂*t / P.q₂)))))))))))))))) := by + classical + intro P A hAp hAq f hqn hspos boundaryA X Y hx' hdis hAqInt hy t ht0 hX hstrict hrow0 hother + southArg + have hsource : (⟨X,Y⟩-⟨0,1⟩ : GaussianInt) = ⟨P.q₁+t,-1⟩ := by + rw [southArg, hX, hy] + ext <;> simp + have yarg : (⟨X,Y⟩-⟨0,1⟩ : GaussianInt) - + (P5332T1ParentRows P 1 1 0).displacement = ⟨t,P.q₂-1⟩ := by + rw [hsource, hdis] + ext <;> simp [t]; omega + have hychild : (⟨t,P.q₂-1⟩ : GaussianInt) ∈ FordVertexDomain A.q := by + simp only [FordVertexDomain, Set.mem_ofPred_eq] + omega + have yarg2 : (⟨P.q₁+t,-1⟩ : GaussianInt) - + (P5332T1ParentRows P 1 1 0).displacement = ⟨t,P.q₂-1⟩ := by + rw [hdis] + ext <;> simp [t]; omega + have hsouth := hother ⟨P.q₁+t,-1⟩ (by rw [yarg2]; exact hychild) + rw [yarg2] at hsouth + simp only [hrow0] at hsouth + have hbS : FordOdometer A ⟨t,P.q₂-1⟩ = + IntegerCeilDiv (P.p₂*t*(P.q₂-1)) P.q₂ (by omega) := by + have htmp := boundaryA t (P.q₂-1) ht0 (by omega) (by omega) (by omega) (by omega) + simpa [hAp, hAqInt] using htmp + rw [hbS] at hsouth + have hceil : IntegerCeilDiv (P.p₂*t*(P.q₂-1)) P.q₂ (by omega) = + P.p₂*t - P.p₂*t / P.q₂ := by + dsimp [IntegerCeilDiv] + have hh : -(P.p₂*t*(P.q₂-1)) = P.p₂*t + P.q₂ * (-(P.p₂*t)) := by ring + rw [hh, Int.add_mul_ediv_left _ _ (by omega)] + ring + rw [hceil] at hsouth + norm_num at hsouth + rw [← hsource] at hsouth + nlinarith + +private theorem hnorth : + ∀ (P : FordFareyParameter), ∀ (f : IntegerLatticeFunction), ∀ (hqn : (P.q : Int) ≠ 0), (P.p₁ + * (P.q : Int) - (P.q₁ : Int) * P.p = 1) → (∀ (X : ℤ), ∀ (Y : ℤ), (Y = 0) → ( + let t : Int := X-(P.q₁ : Int) + (X = P.q₁ + t) → (((⟨X,Y⟩ : GaussianInt)+⟨0,1⟩ = ⟨X,Y+1⟩) → ((f (⟨X,Y⟩+⟨0,1⟩) = + IntegerCeilDiv (P.p*X) P.q hqn) → (f (⟨X,Y⟩+⟨0,1⟩) = P.p₁ + IntegerCeilDiv (P.p*t-1) P.q + hqn))))) := by + classical + intro P f hqn hdet1 X Y hy t hX northArg northVal + have hraw := northVal + rw [hX, hy] at hraw + have hpq1 : P.p * (P.q₁ : Int) = P.p₁ * P.q - 1 := by + linear_combination -hdet1 + have hshift : P.p*(P.q₁+t) = P.p₁*P.q + (P.p*t-1) := by + rw [Int.mul_add, hpq1] + ring + rw [hshift] at hraw + rw [show P.p₁*P.q + (P.p*t-1) = (P.p*t-1) + P.p₁*P.q by ring] at hraw + rw [P5188T1CeilingShift (P.p*t-1) P.p₁ P.q hqn] at hraw + rw [northArg, hX, hy] + simpa [add_comm] using hraw + +end ParentTwoRotationOneProof + +theorem P5332T1Parent2Rotation1Values (P A : FordFareyParameter) (hq : 1 < P.q) + (hAp : A.p = P.p₂) (hAq : A.q = P.q₂) + (f : IntegerLatticeFunction) (B : Int) (x : GaussianInt) + (hbase : ∀ y, y ∈ FordVertexDomain P.q → f y = FordOdometer P y) + (hother : ∀ y, + y - (P5332T1ParentRows P 1 1 0).displacement ∈ FordVertexDomain A.q → + f y = FordOdometer A (y - (P5332T1ParentRows P 1 1 0).displacement) + + (P5332T1ParentRows P 1 1 0).linear.re * y.re + + (P5332T1ParentRows P 1 1 0).linear.im * y.im + B) + (hx : x ∈ FordVertexDomain P.q) + (hx' : x - (P5332T1ParentRows P 1 1 0).displacement ∈ FordVertexDomain A.q) + (hstar : ∀ l : Fin 5, + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) ∈ FordVertexDomain P.q ∨ + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) - + (P5332T1ParentRows P 1 1 0).displacement ∈ FordVertexDomain A.q) : + ∃ t : Int, 0 ≤ t ∧ t < (P.q₂ : Int) ∧ + x = (P5332T1ParentRows P 1 1 t).center ∧ B = P.p₂ * (P.q₁ : Int) ∧ + (∀ l : Fin 5, f (x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l)) = + (P5332T1ParentRows P 1 1 t).values l) ∧ + (x - (P5332T1ParentRows P 1 1 0).companion ∈ FordVertexDomain P.q ↔ + t = 0 ∧ Even (1+1 : Nat)) := by +-- BODY + classical + have hq' : 1 < (P.q : Int) := by exact_mod_cast hq + have hqn : (P.q : Int) ≠ 0 := by omega + have hrpos : 0 < P.q₁ := ParentTwoRotationOneProof.hrpos P A hq + have hspos : 0 < P.q₂ := P.q₂_pos + have hsumq : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by exact_mod_cast P.sum_q + have hpairs : P.p = P.p₁ + P.p₂ := P.sum_p + have hdet1 : P.p₁ * (P.q : Int) - (P.q₁ : Int) * P.p = 1 := P.det₁ + have hdet2 : P.p₂ * (P.q : Int) - (P.q₂ : Int) * P.p = -1 := P.det₂ + have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ _ at laws + have boundaryP (r z : Int) (hr : 0 ≤ r) (hrq : r ≤ P.q) + (hz : 0 ≤ z) (hzq : z ≤ P.q) + (hs : r ≤ 1 ∨ (P.q : Int)-1 ≤ r ∨ z ≤ 1 ∨ (P.q : Int)-1 ≤ z) : + FordOdometer P ⟨r,z⟩ = IntegerCeilDiv (P.p*r*z) P.q hqn := by + apply laws.2.1 + change (0 ≤ r ∧ r ≤ (P.q : Int) ∧ 0 ≤ z ∧ z ≤ (P.q : Int)) ∧ + ¬ (2 ≤ r ∧ r ≤ (P.q : Int)-2 ∧ 2 ≤ z ∧ z ≤ (P.q : Int)-2) + omega + have boundaryA (r z : Int) (hr : 0 ≤ r) (hrq : r ≤ A.q) + (hz : 0 ≤ z) (hzq : z ≤ A.q) + (hs : r ≤ 1 ∨ (A.q : Int)-1 ≤ r ∨ z ≤ 1 ∨ (A.q : Int)-1 ≤ z) : + FordOdometer A ⟨r,z⟩ = IntegerCeilDiv (A.p*r*z) A.q (by exact_mod_cast A.q_pos.ne') := by + apply laws.2.1 + change (0 ≤ r ∧ r ≤ (A.q : Int) ∧ 0 ≤ z ∧ z ≤ (A.q : Int)) ∧ + ¬ (2 ≤ r ∧ r ≤ (A.q : Int)-2 ∧ 2 ≤ z ∧ z ≤ (A.q : Int)-2) + omega + have hr : 0 < (P.q₁ : Int) := by omega + have hs : 0 < (P.q₂ : Int) := by exact_mod_cast hspos + have hqsum : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := hsumq + rcases x with ⟨X,Y⟩ + have hxcoord := hx + change 0 ≤ X ∧ X ≤ (P.q : Int) ∧ 0 ≤ Y ∧ Y ≤ (P.q : Int) at hxcoord + have hdis : (P5332T1ParentRows P 1 1 0).displacement = ⟨(P.q₁ : Int), -(P.q₂ : Int)⟩ := by + rfl + rw [hdis] at hx' + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub, + ] at hx' + have hAqInt : (A.q : Int) = P.q₂ := by exact_mod_cast hAq + have hy : Y = 0 := by omega + have hXlo : (P.q₁ : Int) ≤ X := by omega + have hXhi : X ≤ (P.q : Int) := hxcoord.2.1 + have htdef : 0 ≤ X-(P.q₁ : Int) ∧ X-(P.q₁ : Int) ≤ P.q₂ := by omega + let t : Int := X-(P.q₁ : Int) + have ht0 : 0 ≤ t := htdef.1 + have htle : t ≤ P.q₂ := htdef.2 + have hX : X = P.q₁ + t := by dsimp [t]; omega + have hxrow : (⟨X,Y⟩ : GaussianInt) = (P5332T1ParentRows P 1 1 t).center := by + rw [hX, hy] + rfl + have hstrict : t < P.q₂ := by + by_contra hn + have hteq : t = P.q₂ := by omega + have hsstar := hstar 1 + dsimp [P5332T1ParentRows, FordVertexDomain] at hsstar + rw [hX, hteq, hy, hqsum, hAqInt] at hsstar + norm_num at hsstar + omega + have hxcenter : f ⟨X,Y⟩ = FordOdometer P ⟨X,Y⟩ := hbase _ hx + have hcenterarg : (⟨X,Y⟩ : GaussianInt) - (P5332T1ParentRows P 1 1 0).displacement = ⟨t,P.q₂⟩ + := by + rw [hdis, hX, hy] + ext <;> simp [t] + have hxother := hother ⟨X,Y⟩ hx' + rw [hcenterarg] at hxother + have hrow0 : (P5332T1ParentRows P 1 1 0).linear = ⟨-P.p₂,P.p₁⟩ := by rfl + simp only [hrow0] at hxother + rw [hX, hy] at hxother + have hpnum : P.p₂ * (P.q : Int) - P.q₂ * P.p = -1 := hdet2 + have hcenterP : FordOdometer P ⟨X,Y⟩ = 0 := by + rw [hX, hy, boundaryP (P.q₁+t) 0 (by omega) (by omega) (by omega) (by omega) (by omega)] + simp [IntegerCeilDiv] + have hcenterA : FordOdometer A ⟨t,P.q₂⟩ = P.p₂*t := ParentTwoRotationOneProof.hcenterA P A hAp + hAq f B hspos boundaryA X Y hAqInt ht0 hstrict + have hB : B = P.p₂ * (P.q₁ : Int) := by + rw [hcenterP] at hxcenter + rw [hcenterA] at hxother + rw [hX, hy] at hxcenter + linear_combination hxcenter - hxother + subst B + have valueChild (u v : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) + (hv : 0 ≤ v) (hvq : v ≤ P.q) + (hb : u ≤ 1 ∨ P.q-1 ≤ u ∨ v ≤ 1 ∨ P.q-1 ≤ v) : + f ⟨u,v⟩ = IntegerCeilDiv (P.p*u*v) P.q hqn := by + exact (hbase ⟨u,v⟩ ⟨hu,huq,hv,hvq⟩).trans (boundaryP u v hu huq hv hvq hb) + have centerVal : f ⟨X,Y⟩ = 0 := by rw [hbase _ hx, hcenterP] + have eastArg : (⟨X,Y⟩ : GaussianInt)+1 = ⟨X+1,Y⟩ := by ext <;> simp + have westArg : (⟨X,Y⟩ : GaussianInt)-1 = ⟨X-1,Y⟩ := by ext <;> simp + have northArg : (⟨X,Y⟩ : GaussianInt)+⟨0,1⟩ = ⟨X,Y+1⟩ := by ext <;> simp + have southArg : (⟨X,Y⟩ : GaussianInt)-⟨0,1⟩ = ⟨X,Y-1⟩ := by ext <;> simp + have eastVal : f (⟨X,Y⟩+1) = 0 := by + have mem : (⟨X+1,Y⟩ : GaussianInt) ∈ FordVertexDomain P.q := by + change 0 ≤ X+1 ∧ X+1 ≤ P.q ∧ 0 ≤ Y ∧ Y ≤ P.q + omega + rw [eastArg, hbase _ mem, hy] + rw [boundaryP (X+1) 0 (by omega) (by omega) (by omega) (by omega) (by omega)] + simp [IntegerCeilDiv] + have westVal : f (⟨X,Y⟩-1) = 0 := by + have mem : (⟨X-1,Y⟩ : GaussianInt) ∈ FordVertexDomain P.q := by + change 0 ≤ X-1 ∧ X-1 ≤ P.q ∧ 0 ≤ Y ∧ Y ≤ P.q + omega + rw [westArg, hbase _ mem, hy] + rw [boundaryP (X-1) 0 (by omega) (by omega) (by omega) (by omega) (by omega)] + simp [IntegerCeilDiv] + have northVal : f (⟨X,Y⟩+⟨0,1⟩) = IntegerCeilDiv (P.p*X) P.q hqn := by + have mem : (⟨X,Y+1⟩ : GaussianInt) ∈ FordVertexDomain P.q := by + change 0 ≤ X ∧ X ≤ P.q ∧ 0 ≤ Y+1 ∧ Y+1 ≤ P.q + omega + rw [northArg, hbase _ mem, hy] + norm_num + rw [boundaryP X 1 (by omega) (by omega) (by norm_num) (by omega) (by omega)] + simp + have southVal : f (⟨X,Y⟩-⟨0,1⟩) = + -P.p₁ - (P.p₂*t / P.q₂) := ParentTwoRotationOneProof.southVal P A hAp hAq f hqn hspos + boundaryA X Y hx' hdis hAqInt hy ht0 hX hstrict hrow0 hother southArg + have hnorth : f (⟨X,Y⟩+⟨0,1⟩) = P.p₁ + IntegerCeilDiv (P.p*t-1) P.q hqn := + ParentTwoRotationOneProof.hnorth P f hqn hdet1 X Y hy hX northArg northVal + refine ⟨t, ht0, hstrict, hxrow, rfl, ?_, ?_⟩ + · intro l + fin_cases l + · simp [centerVal, P5332T1ParentRows] + · simpa [P5332T1ParentRows, IntegerCeilDiv] using eastVal + · simpa [P5332T1ParentRows, IntegerCeilDiv, sub_eq_add_neg] using westVal + · simpa [P5332T1ParentRows, IntegerCeilDiv] using hnorth + · simpa [P5332T1ParentRows, sub_eq_add_neg] using southVal + · constructor + · intro hmem + have hcoord := hmem + have hcomp : (P5332T1ParentRows P 1 1 0).companion = ⟨-(P.q₂ : Int),-(P.q : Int)⟩ := by rfl + rw [hcomp] at hcoord + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub] at hcoord + rw [hX, hy] at hcoord + constructor + · omega + · exact ⟨1, by norm_num⟩ + · rintro ⟨htzero, _⟩ + have hcomp : (P5332T1ParentRows P 1 1 0).companion = ⟨-(P.q₂ : Int),-(P.q : Int)⟩ := by rfl + rw [hcomp, hX, hy, htzero] + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean new file mode 100644 index 0000000000..9cc0d4ed46 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean @@ -0,0 +1,405 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic + +-- [TABLET NODE: P5332T1Parent2Rotation2Values] + +/-! +# P5332T1Parent2Rotation2Values + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace Parent2Rotation2Proof + +private theorem baseBd : + ∀ (P : FordFareyParameter), (FordFareyParameter) → ( + let q : Int := P.q + let r : Int := P.q₁ + let s : Int := P.q₂ + let p : Int := P.p + (q = r + s) → (∀ (hqn : q ≠ 0), ((∀ (P : FordFareyParameter), ∀ (x : GaussianInt), P.q = (1 : + ℕ) → FordOdometer P x = x.re * (x.re - (1 : ℤ)) / (2 : ℤ) + P.p * x.re * x.im) ∧ (∀ (P : + FordFareyParameter), ∀ x ∈ FordDoubledBoundary P.q, Classical.choose + FordOdometerFamilyExistsUnique P x = IntegerCeilDiv (P.p * x.re * x.im) (↑P.q : ℤ) (by + exact_mod_cast P.q_pos.ne')) ∧ (∀ (P : FordFareyParameter), ∀ (x : GaussianInt), + Classical.choose FordOdometerFamilyExistsUnique P (x + ⟨(0 : ℤ), -(↑P.q : ℤ)⟩) = + Classical.choose FordOdometerFamilyExistsUnique P x - P.p * x.re) ∧ (∀ (P : + FordFareyParameter), ∀ (x : GaussianInt), Classical.choose + FordOdometerFamilyExistsUnique + P (x + ⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩) = Classical.choose FordOdometerFamilyExistsUnique P x + + P.p₁ * x.re + P.p * x.im + (↑P.q₁ : ℤ) * P.p) ∧ (∀ (P : FordFareyParameter), ∀ (x : + GaussianInt), Classical.choose FordOdometerFamilyExistsUnique P (x + ⟨-(↑P.q : ℤ), + (↑P.q₂ + : ℤ)⟩) = Classical.choose FordOdometerFamilyExistsUnique P x + P.p₂ * x.re - P.p * x.im - + (↑P.q : ℤ) * P.p₂) ∧ ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), ∀ (P₂ : + FordFareyParameter), (1 : ℕ) < P.q → P₁.p = P.p₁ → P₁.q = P.q₁ → P₂.p = P.p₂ → P₂.q = + P.q₂ → (∀ x ∈ FordRecursiveVertexDomains P (0 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique P₁ + x) ∧ (∀ x ∈ FordRecursiveVertexDomains P (1 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique P₁ + (x - ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (↑P.q₂ : ℤ) + (1 : + ℤ)) ∧ (∀ x ∈ FordRecursiveVertexDomains P (2 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique P₂ + (x - ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩) + P.p₁ * x.im) ∧ ∀ x ∈ FordRecursiveVertexDomains P (3 : Fin + (4 : ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = Classical.choose + FordOdometerFamilyExistsUnique P₂ (x - ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩) + P.p₁ * x.re) → (∀ (u : + ℤ), ∀ (v : ℤ), (0 : ℤ) ≤ u → u ≤ q → (0 : ℤ) ≤ v → v ≤ q → u ≤ (1 : ℤ) ∨ q - (1 : ℤ) ≤ u + ∨ v ≤ (1 : ℤ) ∨ q - (1 : ℤ) ≤ v → FordOdometer P ⟨u, v⟩ = IntegerCeilDiv (p * u * v) q + hqn))) := by + classical + intro P A q r s p hsum hqn laws u v hu huq hv hvq hedge + apply laws.2.1 + change (0 ≤ u ∧ u ≤ (P.q : Int) ∧ 0 ≤ v ∧ v ≤ (P.q : Int)) ∧ + ¬ (2 ≤ u ∧ u ≤ (P.q : Int)-2 ∧ 2 ≤ v ∧ v ≤ (P.q : Int)-2) + constructor + · exact ⟨hu,huq,hv,hvq⟩ + · intro h + change 2 ≤ u ∧ u ≤ q-2 ∧ 2 ≤ v ∧ v ≤ q-2 at h + rcases h with ⟨hu2,hu2q,hv2,hv2q⟩ + rcases hedge with h1 | h2 | h3 | h4 <;> omega + +private theorem parentBd : + ∀ (P : FordFareyParameter), ∀ (A : FordFareyParameter), (A.p = P.p₂) → ((A.q = P.q₂) → ( + let s : Int := P.q₂ + let b : Int := P.p₂ + ∀ (hsn : s ≠ 0), ((∀ (P : FordFareyParameter), ∀ (x : GaussianInt), P.q = (1 : ℕ) → + FordOdometer P x = x.re * (x.re - (1 : ℤ)) / (2 : ℤ) + P.p * x.re * x.im) ∧ (∀ (P : + FordFareyParameter), ∀ x ∈ FordDoubledBoundary P.q, Classical.choose + FordOdometerFamilyExistsUnique P x = IntegerCeilDiv (P.p * x.re * x.im) (↑P.q : ℤ) (by + exact_mod_cast P.q_pos.ne')) ∧ (∀ (P : FordFareyParameter), ∀ (x : GaussianInt), + Classical.choose FordOdometerFamilyExistsUnique P (x + ⟨(0 : ℤ), -(↑P.q : ℤ)⟩) = + Classical.choose FordOdometerFamilyExistsUnique P x - P.p * x.re) ∧ (∀ (P : + FordFareyParameter), ∀ (x : GaussianInt), Classical.choose + FordOdometerFamilyExistsUnique + P (x + ⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩) = Classical.choose FordOdometerFamilyExistsUnique P x + + P.p₁ * x.re + P.p * x.im + (↑P.q₁ : ℤ) * P.p) ∧ (∀ (P : FordFareyParameter), ∀ (x : + GaussianInt), Classical.choose FordOdometerFamilyExistsUnique P (x + ⟨-(↑P.q : ℤ), + (↑P.q₂ + : ℤ)⟩) = Classical.choose FordOdometerFamilyExistsUnique P x + P.p₂ * x.re - P.p * x.im - + (↑P.q : ℤ) * P.p₂) ∧ ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), ∀ (P₂ : + FordFareyParameter), (1 : ℕ) < P.q → P₁.p = P.p₁ → P₁.q = P.q₁ → P₂.p = P.p₂ → P₂.q = + P.q₂ → (∀ x ∈ FordRecursiveVertexDomains P (0 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique P₁ + x) ∧ (∀ x ∈ FordRecursiveVertexDomains P (1 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique P₁ + (x - ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (↑P.q₂ : ℤ) + (1 : + ℤ)) ∧ (∀ x ∈ FordRecursiveVertexDomains P (2 : Fin (4 : ℕ)), Classical.choose + FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique P₂ + (x - ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩) + P.p₁ * x.im) ∧ ∀ x ∈ FordRecursiveVertexDomains P (3 : Fin + (4 : ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = Classical.choose + FordOdometerFamilyExistsUnique P₂ (x - ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩) + P.p₁ * x.re) → (∀ (u : + ℤ), ∀ (v : ℤ), (0 : ℤ) ≤ u → u ≤ s → (0 : ℤ) ≤ v → v ≤ s → u ≤ (1 : ℤ) ∨ s - (1 : ℤ) ≤ u + ∨ v ≤ (1 : ℤ) ∨ s - (1 : ℤ) ≤ v → FordOdometer A ⟨u, v⟩ = IntegerCeilDiv (b * u * v) s + hsn))) := by + classical + intro P A hAp hAq s b hsn laws u v hu hus hv hvs hedge + have hAn : (A.q : Int) = s := by dsimp [s]; exact_mod_cast hAq + have hAp' : A.p = b := by dsimp [b]; exact hAp + have hAnz : (A.q : Int) ≠ 0 := by rw [hAn]; exact hsn + have hbdy : (⟨u,v⟩ : GaussianInt) ∈ FordDoubledBoundary A.q := by + change (0 ≤ u ∧ u ≤ (A.q : Int) ∧ 0 ≤ v ∧ v ≤ (A.q : Int)) ∧ ¬ _ + rw [hAn] + constructor + · exact ⟨hu,hus,hv,hvs⟩ + · intro h + change 2 ≤ u ∧ u ≤ s-2 ∧ 2 ≤ v ∧ v ≤ s-2 at h + rcases h with ⟨hu2,hus2,hv2,hvs2⟩ + rcases hedge with h1 | h2 | h3 | h4 <;> omega + have hb := laws.2.1 A ⟨u,v⟩ hbdy + change FordOdometer A ⟨u,v⟩ = IntegerCeilDiv (A.p*u*v) (A.q : Int) (by omega) at hb + simpa [hAp', hAn] using hb + +private theorem htStrict : + ∀ (P : FordFareyParameter), ∀ (A : FordFareyParameter), + let q : Int := P.q + let r : Int := P.q₁ + let s : Int := P.q₂ + (q = r + s) → (∀ (Y : ℤ), ((P5332T1ParentRows P (1 : Fin (2 : ℕ)) (2 : Fin (4 : ℕ)) (0 : + ℤ)).displacement = ⟨q, r⟩) → (((↑A.q : ℤ) = s) → ( + let t : Int := Y-r + (Y = r+t) → ((∀ (l : Fin (5 : ℕ)), ⟨q, Y⟩ + ![(0 : ℤ√(-1 : ℤ)), (1 : ℤ√(-1 : ℤ)), (-1 : ℤ√(-1 + : ℤ)), ⟨(0 : ℤ), (1 : ℤ)⟩, -⟨(0 : ℤ), (1 : ℤ)⟩] l ∈ FordVertexDomain P.q ∨ ⟨q, Y⟩ + ![(0 + : ℤ√(-1 : ℤ)), (1 : ℤ√(-1 : ℤ)), (-1 : ℤ√(-1 : ℤ)), ⟨(0 : ℤ), (1 : ℤ)⟩, -⟨(0 : ℤ), (1 : + ℤ)⟩] l - (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (2 : Fin (4 : ℕ)) (0 : ℤ)).displacement + ∈ FordVertexDomain A.q) → (t < s))))) := by + classical + intro P A q r s hsum Y hdisp hAn t hY hstar + have htop := hstar 3 + rw [hY] at htop + rw [hdisp] at htop + change (⟨q,r+t⟩ : GaussianInt)+⟨0,1⟩ ∈ FordVertexDomain P.q ∨ + (⟨q,r+t⟩ : GaussianInt)+⟨0,1⟩-⟨q,r⟩ ∈ FordVertexDomain A.q at htop + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_sub, Zsqrtd.im_sub] at htop + rcases htop with htop | htop + · change 0 ≤ q ∧ q ≤ (P.q : Int) ∧ 0 ≤ r+t+1 ∧ r+t+1 ≤ (P.q : Int) at htop + dsimp [q] at htop + omega + · change 0 ≤ q-q ∧ q-q ≤ (A.q : Int) ∧ 0 ≤ r+t+1-r ∧ r+t+1-r ≤ (A.q : Int) at htop + rw [hAn] at htop + omega + +private theorem valueEast : + ∀ (P : FordFareyParameter), ∀ (A : FordFareyParameter), ∀ (f : IntegerLatticeFunction), ∀ (B + : Int), (∀ (y : GaussianInt), y - (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (2 : Fin (4 : + ℕ)) (0 : ℤ)).displacement ∈ FordVertexDomain A.q → f y = FordOdometer A (y - + (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (2 : Fin (4 : ℕ)) (0 : ℤ)).displacement) + + (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (2 : Fin (4 : ℕ)) (0 : ℤ)).linear.re * y.re + + (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (2 : Fin (4 : ℕ)) (0 : ℤ)).linear.im * y.im + B) + → ( + let q : Int := P.q + let r : Int := P.q₁ + let s : Int := P.q₂ + let p : Int := P.p + let a : Int := P.p₁ + let b : Int := P.p₂ + (0 < s) → (∀ (hsn : s ≠ 0), (∀ (u : Int), ∀ (v : Int), (0 ≤ u) → ((u ≤ s) → ((0 ≤ v) → ((v ≤ + s) → ((u ≤ 1 ∨ s-1 ≤ u ∨ v ≤ 1 ∨ s-1 ≤ v) → (FordOdometer A ⟨u,v⟩ = IntegerCeilDiv + (b*u*v) s hsn)))))) → (∀ (Y : ℤ), ((P5332T1ParentRows P (1 : Fin (2 : ℕ)) (2 : Fin (4 : + ℕ)) (0 : ℤ)).displacement = ⟨q, r⟩) → (((↑A.q : ℤ) = s) → ( + let t : Int := Y-r + (0 ≤ t) → ((t ≤ s) → ((B = -a*q) → (f ⟨q+1,r+t⟩ = p*(r+t)+a+IntegerCeilDiv (b*t) s + hsn)))))))) := by + classical + intro P A f B hother q r s p a b hs hsn parentBd Y hdisp hAn t ht0 htS hB + have arg : (⟨q+1,r+t⟩ : GaussianInt) - + (P5332T1ParentRows P 1 2 0).displacement = ⟨1,t⟩ := by + rw [hdisp] + ext <;> simp + have hdom : (⟨q+1,r+t⟩ : GaussianInt)- + (P5332T1ParentRows P 1 2 0).displacement ∈ FordVertexDomain A.q := by + rw [arg] + change 0 ≤ 1 ∧ 1 ≤ (A.q : Int) ∧ 0 ≤ t ∧ t ≤ (A.q : Int) + rw [hAn] + exact ⟨by omega, by omega, ht0, by omega⟩ + have hv := hother ⟨q+1,r+t⟩ hdom + rw [arg] at hv + change f ⟨q+1,r+t⟩ = FordOdometer A ⟨1,t⟩ + a*(q+1) + p*(r+t) + B at hv + rw [parentBd 1 t (by omega) (by omega) ht0 (by omega) (by omega), hB] at hv + convert hv using 1; ring + +private theorem valueWest : + ∀ (P : FordFareyParameter), (FordFareyParameter) → (((1 : ℕ) < P.q) → (∀ (f : + IntegerLatticeFunction), (Int) → ((∀ y ∈ FordVertexDomain P.q, f y = FordOdometer P y) → ( + let q : Int := P.q + let r : Int := P.q₁ + let s : Int := P.q₂ + let p : Int := P.p + (q = r + s) → (∀ (hqn : q ≠ 0), (s ≠ 0) → ((∀ (u : Int), ∀ (v : Int), (0 ≤ u) → ((u ≤ q) → + ((0 ≤ v) → ((v ≤ q) → ((u ≤ 1 ∨ q-1 ≤ u ∨ v ≤ 1 ∨ q-1 ≤ v) → (FordOdometer P ⟨u,v⟩ = + IntegerCeilDiv (p*u*v) q hqn)))))) → (∀ (Y : ℤ), + let t : Int := Y-r + ((0 : ℤ) ≤ q ∧ q ≤ q ∧ (0 : ℤ) ≤ Y ∧ Y ≤ q) → ((t < s) → (f ⟨q-1,r+t⟩ = p*(r+t) - + (p*(r+t))/q))))))))) := by + classical + intro P A hq f B hbase q r s p hsum hqn hsn baseBd Y t hx0 htStrict + have hv := hbase ⟨q-1,r+t⟩ (by change 0 ≤ q-1 ∧ q-1 ≤ q ∧ 0 ≤ r+t ∧ r+t ≤ q; omega) + rw [baseBd (q-1) (r+t) (by omega) (by omega) (by omega) (by omega) (by omega)] at hv + have hcdiv : IntegerCeilDiv (p*(q-1)*(r+t)) q hqn = + p*(r+t) - (p*(r+t))/q := by + rw [show p*(q-1)*(r+t) = (-p*(r+t)) + (p*(r+t))*q by ring, + P5188T1CeilingShift (-p*(r+t)) (p*(r+t)) q hqn] + simp [IntegerCeilDiv] + ring + exact hv.trans hcdiv + +private theorem rowValues : + ∀ (P : FordFareyParameter), ∀ (f : IntegerLatticeFunction), + let q : Int := P.q + let r : Int := P.q₁ + let s : Int := P.q₂ + let p : Int := P.p + let a : Int := P.p₁ + let b : Int := P.p₂ + ∀ (hsn : s ≠ 0), ∀ (Y : ℤ), + let t : Int := Y-r + (f ⟨q,r+t⟩ = p*(r+t)) → ((f ⟨q+1,r+t⟩ = p*(r+t)+a+IntegerCeilDiv (b*t) s hsn) → ((f ⟨q-1,r+t⟩ + = p*(r+t) - a - ((p*t-1)/q)) → ((f ⟨q,r+t+1⟩ = p*(r+t+1)) → ((f ⟨q,r+t-1⟩ = p*(r+t-1)) → + (∀ l : Fin 5, f (⟨q,r+t⟩ + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l)) = + (P5332T1ParentRows P 1 2 t).values l))))) := by + classical + intro P f q r s p a b hsn Y t valueCenter valueEast valueWestRow valueNorth valueSouth l + fin_cases l + · simpa [P5332T1ParentRows,q,r,p] using valueCenter + · have arg : (⟨q,r+t⟩ : GaussianInt) + 1 = ⟨q+1,r+t⟩ := by ext <;> simp + simpa [P5332T1ParentRows,q,r,p,a,b,s, IntegerCeilDiv, + Matrix.cons_val_one, Matrix.head_cons, Matrix.tail_cons, arg] using valueEast + · have arg : (⟨q,r+t⟩ : GaussianInt) + (-1) = ⟨q-1,r+t⟩ := by + ext <;> simp; ring + simpa [P5332T1ParentRows,q,r,p,a,b,s, + Matrix.cons_val_two, Matrix.head_cons, Matrix.tail_cons, arg] using valueWestRow + · have arg : (⟨q,r+t⟩ : GaussianInt) + ⟨0,1⟩ = ⟨q,r+t+1⟩ := by ext <;> simp + simpa [P5332T1ParentRows,q,r,p, + Matrix.cons_val_three, Matrix.head_cons, Matrix.tail_cons, arg] using valueNorth + · have arg : (⟨q,r+t⟩ : GaussianInt) - ⟨0,1⟩ = ⟨q,r+t-1⟩ := by ext <;> simp + simpa [P5332T1ParentRows,q,r,p, + Matrix.cons_val_four, Matrix.head_cons, Matrix.tail_cons, arg, + ← sub_eq_add_neg] using valueSouth + +end Parent2Rotation2Proof + +theorem P5332T1Parent2Rotation2Values (P A : FordFareyParameter) (hq : 1 < P.q) + (hAp : A.p = P.p₂) (hAq : A.q = P.q₂) + (f : IntegerLatticeFunction) (B : Int) (x : GaussianInt) + (hbase : ∀ y, y ∈ FordVertexDomain P.q → f y = FordOdometer P y) + (hother : ∀ y, + y - (P5332T1ParentRows P 1 2 0).displacement ∈ FordVertexDomain A.q → + f y = FordOdometer A (y - (P5332T1ParentRows P 1 2 0).displacement) + + (P5332T1ParentRows P 1 2 0).linear.re * y.re + + (P5332T1ParentRows P 1 2 0).linear.im * y.im + B) + (hx : x ∈ FordVertexDomain P.q) + (hx' : x - (P5332T1ParentRows P 1 2 0).displacement ∈ FordVertexDomain A.q) + (hstar : ∀ l : Fin 5, + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) ∈ FordVertexDomain P.q ∨ + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) - + (P5332T1ParentRows P 1 2 0).displacement ∈ FordVertexDomain A.q) : + ∃ t : Int, 0 ≤ t ∧ t < (P.q₂ : Int) ∧ + x = (P5332T1ParentRows P 1 2 t).center ∧ B = -P.p₁ * (P.q : Int) ∧ + (∀ l : Fin 5, f (x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l)) = + (P5332T1ParentRows P 1 2 t).values l) ∧ + (x - (P5332T1ParentRows P 1 2 0).companion ∈ FordVertexDomain P.q ↔ + t = 0 ∧ Even (2+1 : Nat)) := by +-- BODY + classical + let q : Int := P.q + let r : Int := P.q₁ + let s : Int := P.q₂ + let p : Int := P.p + let a : Int := P.p₁ + let b : Int := P.p₂ + have hqI : 1 < q := by dsimp [q]; exact_mod_cast hq + have hsum : q = r + s := by + dsimp [q, r, s] + exact_mod_cast P.sum_q + have hpsum : p = a + b := by dsimp [p,a,b]; exact P.sum_p + have hr : 0 < r := by + have hpos := (P5130T5ParentArithmetic P hq).1 + dsimp [r] + exact_mod_cast hpos + have hs : 0 < s := by dsimp [s]; exact_mod_cast P.q₂_pos + have hrq : r < q := by omega + have hsq : s < q := by omega + have hdet₁ : a*q - r*p = 1 := by + exact P.det₁ + have hdet₂ : b*q - s*p = -1 := by + change P.p₂ * (P.q : Int) - (P.q₂ : Int) * P.p = -1 + exact P.det₂ + have hqn : q ≠ 0 := by omega + have hsn : s ≠ 0 := by omega + have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ _ at laws + have baseBd (u v : Int) (hu : 0 ≤ u) (huq : u ≤ q) + (hv : 0 ≤ v) (hvq : v ≤ q) + (hedge : u ≤ 1 ∨ q-1 ≤ u ∨ v ≤ 1 ∨ q-1 ≤ v) : + FordOdometer P ⟨u,v⟩ = IntegerCeilDiv (p*u*v) q hqn := Parent2Rotation2Proof.baseBd P A + hsum hqn laws u v hu huq hv hvq hedge + have parentBd (u v : Int) (hu : 0 ≤ u) (hus : u ≤ s) + (hv : 0 ≤ v) (hvs : v ≤ s) + (hedge : u ≤ 1 ∨ s-1 ≤ u ∨ v ≤ 1 ∨ s-1 ≤ v) : + FordOdometer A ⟨u,v⟩ = IntegerCeilDiv (b*u*v) s hsn := Parent2Rotation2Proof.parentBd P A + hAp hAq hsn laws u v hu hus hv hvs hedge + have sideRight (u : Int) (hu : 0 ≤ u) (huq : u ≤ q) : + FordOdometer P ⟨q,u⟩ = p*u := by + rw [baseBd q u (by omega) (by omega) hu huq (by omega)] + dsimp [IntegerCeilDiv] + rw [show -(p*q*u) = (-p*u)*q by ring, Int.mul_ediv_cancel _ hqn] + ring + rcases x with ⟨X,Y⟩ + have hx0 := hx + change 0 ≤ X ∧ X ≤ q ∧ 0 ≤ Y ∧ Y ≤ q at hx0 + have hdisp : (P5332T1ParentRows P 1 2 0).displacement = ⟨q,r⟩ := by + simp [P5332T1ParentRows,q,r] + rw [hdisp] at hx' + change 0 ≤ X-q ∧ X-q ≤ (A.q : Int) ∧ 0 ≤ Y-r ∧ Y-r ≤ (A.q : Int) at hx' + have hAn : (A.q : Int) = s := by dsimp [s]; exact_mod_cast hAq + rw [hAn] at hx' + have hX : X = q := by omega + let t : Int := Y-r + have ht0 : 0 ≤ t := by dsimp [t]; omega + have htS : t ≤ s := by dsimp [t]; omega + have hY : Y = r+t := by dsimp [t]; omega + subst X + have htStrict : t < s := Parent2Rotation2Proof.htStrict P A hsum Y hdisp hAn hY hstar + have centerArg : (⟨q,r+t⟩ : GaussianInt)-⟨q,r⟩ = ⟨0,t⟩ := by ext <;> simp + have hc := hbase ⟨q,r+t⟩ (by change 0 ≤ q ∧ q ≤ q ∧ 0 ≤ r+t ∧ r+t ≤ q; omega) + have hp := hother ⟨q,r+t⟩ (by + change (⟨q,r+t⟩ : GaussianInt)-⟨q,r⟩ ∈ FordVertexDomain A.q + rw [centerArg] + change 0 ≤ (0 : Int) ∧ (0 : Int) ≤ (A.q : Int) ∧ 0 ≤ t ∧ t ≤ (A.q : Int) + rw [hAn] + exact ⟨by omega, by omega, ht0, by omega⟩) + have centerChild : FordOdometer P ⟨q,r+t⟩ = p*(r+t) := sideRight (r+t) (by omega) (by omega) + have centerParent : FordOdometer A ⟨0,t⟩ = 0 := by + rw [parentBd 0 t (by omega) (by omega) ht0 (by omega) (by omega)] + simp [IntegerCeilDiv] + rw [centerChild] at hc + change f ⟨q,r+t⟩ = FordOdometer A ((⟨q,r+t⟩ : GaussianInt)-⟨q,r⟩) + + a*q + p*(r+t) + B at hp + rw [centerArg, centerParent] at hp + have hcentEq := hc.symm.trans hp + change p*(r+t) = 0 + a*q + p*(r+t) + B at hcentEq + have hB : B = -a*q := by + linarith [hcentEq] + have rowCenter : (P5332T1ParentRows P 1 2 t).center = ⟨q,r+t⟩ := by + simp [P5332T1ParentRows,q,r,t] + have valueCenter : f ⟨q,r+t⟩ = p*(r+t) := hc + have valueEast : f ⟨q+1,r+t⟩ = p*(r+t)+a+IntegerCeilDiv (b*t) s hsn := + Parent2Rotation2Proof.valueEast P A f B hother hs hsn parentBd Y hdisp hAn ht0 htS hB + have valueWest : f ⟨q-1,r+t⟩ = p*(r+t) - (p*(r+t))/q := Parent2Rotation2Proof.valueWest P A hq + f B hbase hsum hqn hsn baseBd Y hx0 htStrict + have hdiv : (p*(r+t))/q = (p*t-1)/q + a := by + have hnum : p*(r+t) = (p*t-1) + a*q := by nlinarith [hdet₁] + rw [hnum, show (p*t-1) + a*q = (p*t-1) + q*a by ring, + Int.add_mul_ediv_left _ _ hqn] + have valueWestRow : f ⟨q-1,r+t⟩ = p*(r+t) - a - ((p*t-1)/q) := by + rw [valueWest, hdiv] + omega + have valueNorth : f ⟨q,r+t+1⟩ = p*(r+t+1) := by + have hv := hbase ⟨q,r+t+1⟩ (by change 0 ≤ q ∧ q ≤ q ∧ 0 ≤ r+t+1 ∧ r+t+1 ≤ q; omega) + exact hv.trans (sideRight (r+t+1) (by omega) (by omega)) + have valueSouth : f ⟨q,r+t-1⟩ = p*(r+t-1) := by + have hv := hbase ⟨q,r+t-1⟩ (by change 0 ≤ q ∧ q ≤ q ∧ 0 ≤ r+t-1 ∧ r+t-1 ≤ q; omega) + exact hv.trans (sideRight (r+t-1) (by omega) (by omega)) + have rowValues : ∀ l : Fin 5, + f (⟨q,r+t⟩ + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l)) = + (P5332T1ParentRows P 1 2 t).values l := Parent2Rotation2Proof.rowValues P f hsn Y + valueCenter valueEast valueWestRow valueNorth valueSouth + refine ⟨t, ht0, htStrict, ?_, hB, ?_, ?_⟩ + · simpa [rowCenter] + · intro l + rw [hY] + exact rowValues l + · constructor + · intro h + rw [hY] at h + have hcomp : (⟨q,r+t⟩ : GaussianInt) - (P5332T1ParentRows P 1 2 0).companion ∈ + FordVertexDomain P.q := h + have hw : (P5332T1ParentRows P 1 2 0).companion = ⟨s,q⟩ := by + simp [P5332T1ParentRows,q,s] + rw [hw] at hcomp + change 0 ≤ q-s ∧ q-s ≤ q ∧ 0 ≤ r+t-q ∧ r+t-q ≤ q at hcomp + omega + · rintro ⟨htzero, heven⟩ + have hn : ¬ Even (2+1 : Nat) := by decide + exact (hn heven).elim + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation3Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation3Values.lean new file mode 100644 index 0000000000..d503c1b343 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation3Values.lean @@ -0,0 +1,231 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift + +-- [TABLET NODE: P5332T1Parent2Rotation3Values] + +/-! +# P5332T1Parent2Rotation3Values + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5332T1Parent2Rotation3Values (P A : FordFareyParameter) (hq : 1 < P.q) + (hAp : A.p = P.p₂) (hAq : A.q = P.q₂) + (f : IntegerLatticeFunction) (B : Int) (x : GaussianInt) + (hbase : ∀ y, y ∈ FordVertexDomain P.q → f y = FordOdometer P y) + (hother : ∀ y, + y - (P5332T1ParentRows P 1 3 0).displacement ∈ FordVertexDomain A.q → + f y = FordOdometer A (y - (P5332T1ParentRows P 1 3 0).displacement) + + (P5332T1ParentRows P 1 3 0).linear.re * y.re + + (P5332T1ParentRows P 1 3 0).linear.im * y.im + B) + (hx : x ∈ FordVertexDomain P.q) + (hx' : x - (P5332T1ParentRows P 1 3 0).displacement ∈ FordVertexDomain A.q) + (hstar : ∀ l : Fin 5, + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) ∈ FordVertexDomain P.q ∨ + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) - + (P5332T1ParentRows P 1 3 0).displacement ∈ FordVertexDomain A.q) : + ∃ t : Int, 0 ≤ t ∧ t < (P.q₂ : Int) ∧ + x = (P5332T1ParentRows P 1 3 t).center ∧ B = 0 ∧ + (∀ l : Fin 5, f (x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l)) = + (P5332T1ParentRows P 1 3 t).values l) ∧ + (x - (P5332T1ParentRows P 1 3 0).companion ∈ FordVertexDomain P.q ↔ + t = 0 ∧ Even (3+1 : Nat)) := by +-- BODY + classical + have hqI : 1 < (P.q : Int) := by exact_mod_cast hq + have hqn : (P.q : Int) ≠ 0 := by omega + have hrpos : 0 < P.q₁ := by + by_contra hn + have hz : P.q₁ = 0 := by omega + have hd := P.det₁ + simp [hz] at hd + have hdv : (P.q : Int) ∣ 1 := ⟨P.p₁, by simpa [mul_comm] using hd.symm⟩ + have hqone : (P.q : Int) = 1 := Int.eq_one_of_dvd_one (by omega) hdv + omega + have hspos : 0 < P.q₂ := P.q₂_pos + have hsum : (P.q₁ : Int) + (P.q₂ : Int) = (P.q : Int) := by + exact_mod_cast P.sum_q.symm + have hq2le : (P.q₂ : Int) ≤ P.q := by omega + have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ _ at laws + -- The parameter record for the child is P itself; use its principal boundary law. + have pboundary (u v : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) + (hv : 0 ≤ v) (hvq : v ≤ P.q) + (hb : u ≤ 1 ∨ (P.q : Int)-1 ≤ u ∨ v ≤ 1 ∨ (P.q : Int)-1 ≤ v) : + FordOdometer P ⟨u,v⟩ = IntegerCeilDiv (P.p*u*v) P.q (by exact_mod_cast P.q_pos.ne') := by + apply laws.2.1 + change (0 ≤ u ∧ u ≤ (P.q : Int) ∧ 0 ≤ v ∧ v ≤ (P.q : Int)) ∧ + ¬ (2 ≤ u ∧ u ≤ (P.q : Int)-2 ∧ 2 ≤ v ∧ v ≤ (P.q : Int)-2) + omega + have top (u : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) : + FordOdometer P ⟨u,(P.q : Int)⟩ = P.p*u := by + rw [pboundary u P.q hu huq (by omega) le_rfl (by omega)] + unfold IntegerCeilDiv + rw [show -(P.p*u*(P.q : Int)) = -(P.p*u)*(P.q : Int) by ring, + Int.mul_ediv_cancel _ hqn] + simp + rcases x with ⟨X,Y⟩ + let x' : GaussianInt := ⟨X,Y⟩ + change 0 ≤ X ∧ X ≤ P.q ∧ 0 ≤ Y ∧ Y ≤ P.q at hx + have hx'0 := hx' + simp only [P5332T1ParentRows, Matrix.cons_val_zero, Matrix.cons_val_one, + Matrix.cons_val_three, + Matrix.head_cons, Matrix.tail_cons, FordVertexDomain, Set.mem_ofPred_eq, + Zsqrtd.re_sub, Zsqrtd.im_sub, sub_zero] at hx'0 + change 0 ≤ X ∧ X ≤ (A.q : Int) ∧ 0 ≤ Y - P.q ∧ Y - P.q ≤ (A.q : Int) at hx'0 + have hXle : X ≤ (P.q₂ : Int) := by omega + have hY : Y = P.q := by omega + have htdef : 0 ≤ (P.q₂ : Int) - X := by omega + let t : Int := (P.q₂ : Int) - X + have ht0 : 0 ≤ t := by dsimp [t]; omega + have htle : t ≤ P.q₂ := by dsimp [t]; omega + have hstrict : t < P.q₂ := by + have hbad := hstar (⟨2, by omega⟩ : Fin 5) + dsimp at hbad + have hdisp : (P5332T1ParentRows P 1 3 0).displacement = ⟨0,(P.q : Int)⟩ := by rfl + have hAqI : (A.q : Int) = P.q₂ := by exact_mod_cast hAq + by_contra hlt + have heq : t = P.q₂ := by omega + have hXzero : X = 0 := by dsimp [t] at heq; omega + rcases hbad with h | h + · simp [FordVertexDomain, hXzero] at h + · simp [FordVertexDomain, hdisp, hXzero, hY] at h + have hX : X = (P.q₂ : Int) - t := by dsimp [t]; omega + have hcenter : x' = (P5332T1ParentRows P 1 3 t).center := by + change x' = ⟨(P.q₂ : Int)-t,(P.q : Int)⟩ + apply Zsqrtd.ext + · change X = (P.q₂ : Int)-t + exact hX + · change Y = (P.q : Int) + exact hY + have hcenterbase : f x' = P.p * X := by + rw [hbase x' hx] + change FordOdometer P ⟨X,Y⟩ = P.p * X + rw [hY] + exact top X (by omega) (by omega) + have hcenterother : f x' = P.p * X + B := by + have hxA : x' - (P5332T1ParentRows P 1 3 0).displacement ∈ FordVertexDomain A.q := hx' + have hh := hother x' hxA + dsimp [P5332T1ParentRows] at hh + have harg : x' - ⟨0,(P.q : Int)⟩ = ⟨X,0⟩ := by + ext <;> simp [x', hY] + rw [harg] at hh + have hz : FordOdometer A ⟨X,0⟩ = 0 := by + have hab := (Classical.choose_spec FordOdometerFamilyExistsUnique).1.2.1 A ⟨X,0⟩ + have hAqI : (A.q : Int) = P.q₂ := by exact_mod_cast hAq + have hmem : ⟨X,0⟩ ∈ FordDoubledBoundary A.q := by + change (0 ≤ X ∧ X ≤ (A.q : Int) ∧ 0 ≤ (0:Int) ∧ 0 ≤ (A.q : Int)) ∧ _ + have hn : ¬ (2 ≤ X ∧ X ≤ (A.q : Int)-2 ∧ 2 ≤ (0:Int) ∧ 0 ≤ (A.q : Int)-2) := by omega + exact ⟨by omega, hn⟩ + have hzbd := hab hmem + simp? [IntegerCeilDiv] at hzbd + exact hzbd + rw [hz] at hh + norm_num at hh ⊢ + omega + have hB : B = 0 := by omega + have htopfun (u : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) : f ⟨u,(P.q : Int)⟩ = P.p*u := by + apply (hbase _ ⟨hu, huq, (show 0 ≤ (P.q : Int) by exact_mod_cast P.q_pos.le), le_rfl⟩).trans + exact top u hu huq + have vals : ∀ l : Fin 5, + f (x' + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l)) = + (P5332T1ParentRows P 1 3 t).values l := by + intro l + fin_cases l + all_goals dsimp + · rw [add_zero] + change f x' = P.p*((P.q₂ : Int)-t) + simpa [hX] using hcenterbase + · change f (x'+1) = P.p*((P.q₂ : Int)-t+1) + have heq : x'+1 = ⟨X+1,(P.q : Int)⟩ := by ext <;> simp [x', hY] + rw [heq, htopfun (X+1) (by omega) (by omega), hX] + · change f (x'-1) = P.p*((P.q₂ : Int)-t-1) + have heq : x'-1 = ⟨X-1,(P.q : Int)⟩ := by ext <;> simp [x', hY] + rw [heq, htopfun (X-1) (by omega) (by omega), hX] + · change f (x'+⟨0,1⟩) = P.p*((P.q₂ : Int)-t) + IntegerCeilDiv + (P.p₂*((P.q₂ : Int)-t)) P.q₂ (by exact_mod_cast P.q₂_pos.ne') + have heq : x'+⟨0,1⟩ = (⟨X,Y+1⟩ : GaussianInt) := by ext <;> simp [x'] + rw [heq] + have ha : (⟨X,Y+1⟩ : GaussianInt) - ⟨0,(P.q : Int)⟩ = ⟨X,1⟩ := by ext <;> simp [hY] + have hAqI : (A.q : Int) = P.q₂ := by exact_mod_cast hAq + have hpdom : ⟨X,1⟩ ∈ FordVertexDomain A.q := by + change 0 ≤ X ∧ X ≤ (A.q : Int) ∧ 0 ≤ (1:Int) ∧ 1 ≤ (A.q : Int) + omega + have hd : (P5332T1ParentRows P 1 3 0).displacement = ⟨0,(P.q : Int)⟩ := by rfl + have hv := hother ⟨X,Y+1⟩ (by simpa [hd, ha] using hpdom) + dsimp [P5332T1ParentRows] at hv + rw [ha, hB] at hv + have hbnd := (Classical.choose_spec FordOdometerFamilyExistsUnique).1.2.1 A ⟨X,1⟩ + have hbmem : ⟨X,1⟩ ∈ FordDoubledBoundary A.q := by + change (0 ≤ X ∧ X ≤ (A.q : Int) ∧ 0 ≤ (1:Int) ∧ 1 ≤ (A.q : Int)) ∧ _ + have hn : ¬ (2 ≤ X ∧ X ≤ (A.q : Int)-2 ∧ 2 ≤ (1:Int) ∧ 1 ≤ (A.q : Int)-2) := by omega + exact ⟨by omega, hn⟩ + have hceil := hbnd hbmem + change FordOdometer A ⟨X,1⟩ = IntegerCeilDiv + (A.p*X*1) (A.q : Int) (by exact_mod_cast A.q_pos.ne') at hceil + have hceil' : FordOdometer A ⟨X,1⟩ = IntegerCeilDiv + (P.p₂*X*1) (P.q₂ : Int) (by exact_mod_cast P.q₂_pos.ne') := by + simpa only [hAp, hAq] using hceil + rw [hceil'] at hv + rw [← hX] + simpa [IntegerCeilDiv, add_comm] using hv + · change f (x'-⟨0,1⟩) = P.p*((P.q₂ : Int)-t) - + P.p*((P.q₂ : Int)-t)/P.q + have heq : x'-⟨0,1⟩ = (⟨X,Y-1⟩ : GaussianInt) := by ext <;> simp [x'] + rw [heq, hY] + have hu : 0 ≤ X := by omega + have huq : X ≤ P.q := by omega + have hdom : (⟨X,(P.q : Int)-1⟩ : GaussianInt) ∈ FordVertexDomain P.q := by + change 0 ≤ X ∧ X ≤ (P.q : Int) ∧ 0 ≤ (P.q : Int)-1 ∧ (P.q : Int)-1 ≤ (P.q : Int) + omega + rw [hbase _ hdom] + rw [pboundary X ((P.q : Int)-1) hu (by omega) (by omega) (by omega) (by omega)] + rw [hX] + have hceil := P5188T1CeilingShift (-(P.p*((P.q₂ : Int)-t))) + (P.p*((P.q₂ : Int)-t)) (P.q : Int) hqn + calc + IntegerCeilDiv (P.p*((P.q₂ : Int)-t)*((P.q : Int)-1)) (P.q : Int) (by exact_mod_cast + P.q_pos.ne') = + IntegerCeilDiv (-(P.p*((P.q₂ : Int)-t)) + P.p*((P.q₂ : Int)-t)*(P.q : Int)) + (P.q : Int) (by exact_mod_cast P.q_pos.ne') := by congr 1; ring + _ = IntegerCeilDiv (-(P.p*((P.q₂ : Int)-t))) (P.q : Int) (by exact_mod_cast P.q_pos.ne') + + P.p*((P.q₂ : Int)-t) := hceil + _ = P.p*((P.q₂ : Int)-t) - P.p*((P.q₂ : Int)-t)/(P.q : Int) := by + simp [IntegerCeilDiv] + ring + refine ⟨t, ht0, hstrict, hcenter, hB, vals, ?_⟩ + constructor + · intro hmem + simp only [P5332T1ParentRows, Matrix.cons_val_zero, Matrix.cons_val_one, + Matrix.cons_val_three, + Matrix.head_cons, Matrix.tail_cons, FordVertexDomain, Set.mem_ofPred_eq, + Zsqrtd.re_sub, Zsqrtd.im_sub, sub_zero] at hmem + have htzero : t = 0 := by rw [hX] at hmem; omega + exact ⟨htzero, ⟨2, by norm_num⟩⟩ + · rintro ⟨ht, _⟩ + have hw : (P5332T1ParentRows P 1 3 0).companion = ⟨(P.q₂ : Int),(P.q : Int)⟩ := by rfl + rw [hw] + change 0 ≤ X-P.q₂ ∧ X-P.q₂ ≤ P.q ∧ 0 ≤ Y-P.q ∧ Y-P.q ≤ P.q + have hXzero : X = P.q₂ := by rw [hX, ht]; ring + rw [hXzero, hY] + norm_num + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1ParentRounding.lean b/LeanPool/ApollonianSuperharmonic/P5332T1ParentRounding.lean new file mode 100644 index 0000000000..f1765cca4f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1ParentRounding.lean @@ -0,0 +1,121 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows +public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic +public import LeanPool.ApollonianSuperharmonic.P5332T1SignedParentIntervals + +-- [TABLET NODE: P5332T1ParentRounding] + +/-! +# P5332T1ParentRounding + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5332T1ParentRounding (P : FordFareyParameter) (hq : 1 < P.q) + (j : Fin 2) (k : Fin 4) (t : Int) (ht : 0 ≤ t) + (ht' : t < ((![P.q₁, P.q₂] j : Nat) : Int)) : + let V := (P5332T1ParentRows P j k t).values + V 1 + V 2 + V 3 + V 4 - 4 * V 0 = + if t = 0 ∧ Even (k.val + j.val) then 0 else 1 := by +-- BODY + obtain ⟨hr, hrl, hs, hsl, _⟩ := P5130T5ParentArithmetic P hq + have hq' : 1 < (P.q : Int) := by exact_mod_cast hq + have hr' : 0 < (P.q₁ : Int) := by exact_mod_cast hr + have hs' : 0 < (P.q₂ : Int) := by exact_mod_cast hs + have hrl' : (P.q₁ : Int) < P.q := by exact_mod_cast hrl + have hsl' : (P.q₂ : Int) < P.q := by exact_mod_cast hsl + have det1 : P.p₁ * (P.q : Int) - P.p * (P.q₁ : Int) = 1 := by + nlinarith [P.det₁] + have det2 : P.p₂ * (P.q : Int) - P.p * (P.q₂ : Int) = -1 := by + nlinarith [P.det₂] + have fm (K : Int) : (K*(P.q : Int)-1)/(P.q : Int) = K-1 := by + apply (Int.ediv_eq_iff_of_pos (by omega)).mpr + constructor <;> nlinarith + have fp (K : Int) : (K*(P.q : Int)+1)/(P.q : Int) = K := by + apply (Int.ediv_eq_iff_of_pos (by omega)).mpr + constructor <;> nlinarith + have cm (K : Int) : -((-(K*(P.q : Int)-1))/(P.q : Int)) = K := by + have hh : (-(K*(P.q : Int)-1))/(P.q : Int) = -K := by + apply (Int.ediv_eq_iff_of_pos (by omega)).mpr + constructor <;> nlinarith + rw [hh] + ring + have cp (K : Int) : -((-(K*(P.q : Int)+1))/(P.q : Int)) = K+1 := by + have hh : (-(K*(P.q : Int)+1))/(P.q : Int) = -(K+1) := by + apply (Int.ediv_eq_iff_of_pos (by omega)).mpr + constructor <;> nlinarith + rw [hh] + ring + by_cases ht0 : t = 0 + · subst t + have hpr : P.p * (P.q₁ : Int) = P.p₁ * (P.q : Int) - 1 := by omega + have hps : P.p * (P.q₂ : Int) = P.p₂ * (P.q : Int) + 1 := by omega + have cq1 : -((-1)/(P.q : Int)) = 1 := by simpa using cp 0 + have cqneg1 : -(1/(P.q : Int)) = 0 := by simpa using cm 0 + have fq1 : 1/(P.q : Int) = 0 := by simpa using fp 0 + have fqneg1 : (-1)/(P.q : Int) = -1 := by simpa using fm 0 + have fnm (K : Int) : (1-K*(P.q : Int))/(P.q : Int) = -K := by + apply (Int.ediv_eq_iff_of_pos (by omega)).mpr + constructor <;> nlinarith + have fnp (K : Int) : (-1-K*(P.q : Int))/(P.q : Int) = -(K+1) := by + apply (Int.ediv_eq_iff_of_pos (by omega)).mpr + constructor <;> nlinarith + have dr (K : Int) : K*(P.q₁ : Int)/(P.q₁ : Int) = K := + Int.mul_ediv_cancel K hr'.ne' + have ds (K : Int) : K*(P.q₂ : Int)/(P.q₂ : Int) = K := + Int.mul_ediv_cancel K hs'.ne' + have cr (K : Int) : -((-(K*(P.q₁ : Int)))/(P.q₁ : Int)) = K := by + rw [← neg_mul, dr] + ring + have cs (K : Int) : -((-(K*(P.q₂ : Int)))/(P.q₂ : Int)) = K := by + rw [← neg_mul, ds] + ring + have fnp' (K : Int) : (-1 + -(K*(P.q : Int)))/(P.q : Int) = -(K+1) := by + simpa only [sub_eq_add_neg] using fnp K + fin_cases j <;> fin_cases k <;> dsimp [P5332T1ParentRows] <;> + norm_num only [add_zero, sub_zero, mul_zero, zero_mul, neg_zero, Int.zero_ediv, + true_and, and_false, ite_true, ite_false, + hpr, hps, cm, cp, fm, fp, + cq1, cqneg1, fq1, fqneg1, fnm, fnp, fnp', dr, ds, cr, cs, + hr'.ne', hs'.ne', show Even 0 from ⟨0,rfl⟩, show ¬Even 1 by decide, + show Even 2 from ⟨1,rfl⟩, show ¬Even 3 by decide, + show Even 4 from ⟨2,rfl⟩] <;> nlinarith only [hpr, hps] + · have htpos : 0 < t := by omega + fin_cases j + · change t < (P.q₁ : Int) at ht' + have h := P5332T1SignedParentIntervals P.p₁ P.p P.q₁ P.q t 1 + hr' hrl' htpos ht' (Or.inl rfl) det1 + have h' := P5332T1SignedParentIntervals P.p₁ P.p P.q₁ P.q (P.q₁-t) 1 + hr' hrl' (by omega) (by omega) (Or.inl rfl) det1 + dsimp only at h h' + try + fin_cases k <;> dsimp [P5332T1ParentRows] <;> + norm_num only [ht0, false_and, ite_false, h.1, h.2.1, h.2.2.1, + h.2.2.2.1, h.2.2.2.2, h'.1, h'.2.1, h'.2.2.1, + h'.2.2.2.1, h'.2.2.2.2] <;> ring + · change t < (P.q₂ : Int) at ht' + have h := P5332T1SignedParentIntervals P.p₂ P.p P.q₂ P.q t (-1) + hs' hsl' htpos ht' (Or.inr rfl) det2 + have h' := P5332T1SignedParentIntervals P.p₂ P.p P.q₂ P.q (P.q₂-t) (-1) + hs' hsl' (by omega) (by omega) (Or.inr rfl) det2 + dsimp only at h h' + try simp only [← sub_eq_add_neg] at h h' + fin_cases k <;> dsimp [P5332T1ParentRows] <;> + norm_num only [ht0, false_and, ite_false, h.1, h.2.1, h.2.2.1, + h.2.2.2.1, h.2.2.2.2, h'.1, h'.2.1, h'.2.2.1, + h'.2.2.2.1, h'.2.2.2.2] <;> ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1ParentRows.lean b/LeanPool/ApollonianSuperharmonic/P5332T1ParentRows.lean new file mode 100644 index 0000000000..deeaa5f716 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1ParentRows.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1Stencil + +-- [TABLET NODE: P5332T1ParentRows] + +/-! +# P5332T1ParentRows + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For every reduced Ford--Farey parameter $P$ of +`FordFareyParameter`, put $r=q_1,s=q_2,a=p_1,b=p_2$. +Thus $p,a,b$ are integers, $q,r,s$ are nonnegative integers, +$q,s>0$, and $0\le r0,\\ +0,&d=0, +\end{cases} +\qquad C_d(N)=-Q_d(-N). +$$ +In particular, $Q_0(N)=C_0(N)=0$. +For every integer $t$, $j\in\{0,1\}$, and $k\in\{0,1,2,3\}$, +define the child--parent contact stencils as records +$(d,\alpha,z,w,V)$ of `P5332T1Stencil`. +Here $j=0$ means parent $(a,r)$ and $j=1$ means parent $(b,s)$; +$k$ is the displayed rotation. +The domain includes $q=1$, when $(a,r)=(1,0)$ and +$(b,s)=(p-1,1)$; the first parent is the oriented line parent. +No contact or coverage hypothesis is imposed on $t$ in this definition. +$$ +\begin{array}{cc|c|c|c|c} +j&k&d&\alpha&z&w\\ \hline +0&0&(s,q)&(p,b)&(s+t,q)&(-r,q)\\ +0&1&(-r,s)&(b,-a)&(0,s+t)&(-r,q)\\ +0&2&(0,-r)&(-a,0)&(r-t,0)&(r,-q)\\ +0&3&(q,0)&(0,p)&(q,r-t)&(r,-q)\\ +1&0&(-s,0)&(0,-b)&(0,s-t)&(-s,-q)\\ +1&1&(r,-s)&(-b,a)&(r+t,0)&(-s,-q)\\ +1&2&(q,r)&(a,p)&(q,r+t)&(s,q)\\ +1&3&(0,q)&(p,0)&(s-t,q)&(s,q) +\end{array} +$$ +The five values in the prescribed order are +$$ +\begin{array}{cc|l} +0&0&(p(s+t),p(s+t+1),p(s+t-1), + p(s+t)+b+C_r(at),p(s+t)-b-Q_q(pt+1))\\ +0&1&(0,b+C_q(pt+1),-b-Q_r(at),0,0)\\ +0&2&(0,0,0,C_q(p(r-t)),-Q_r(a(r-t)))\\ +0&3&(p(r-t),p(r-t)+C_r(a(r-t)),p(r-t)-Q_q(p(r-t)), + p(r-t+1),p(r-t-1))\\ +1&0&(0,C_q(p(s-t)),-Q_s(b(s-t)),0,0)\\ +1&1&(0,0,0,a+C_q(pt-1),-a-Q_s(bt))\\ +1&2&(p(r+t),p(r+t)+a+C_s(bt),p(r+t)-a-Q_q(pt-1), + p(r+t+1),p(r+t-1))\\ +1&3&(p(s-t),p(s-t+1),p(s-t-1), + p(s-t)+C_s(b(s-t)),p(s-t)-Q_q(p(s-t))). +\end{array} +$$ +These formulas only specify data; the contact calculation must establish +that they are the actual values of a normalized function. +-/ +def P5332T1ParentRows (P : FordFareyParameter) (j : Fin 2) (k : Fin 4) + (t : Int) : P5332T1Stencil := +-- BODY + let q : Int := P.q + let r : Int := P.q₁ + let s : Int := P.q₂ + let p := P.p + let a := P.p₁ + let b := P.p₂ + let C (N d : Int) := -((-N) / d) + ![ + ![ + ⟨⟨s,q⟩, ⟨p,b⟩, ⟨s+t,q⟩, ⟨-r,q⟩, + ![p*(s+t),p*(s+t+1),p*(s+t-1), + p*(s+t)+b+C (a*t) r,p*(s+t)-b-((p*t+1)/q)]⟩, + ⟨⟨-r,s⟩, ⟨b,-a⟩, ⟨0,s+t⟩, ⟨-r,q⟩, + ![0,b+C (p*t+1) q,-b-(a*t/r),0,0]⟩, + ⟨⟨0,-r⟩, ⟨-a,0⟩, ⟨r-t,0⟩, ⟨r,-q⟩, + ![0,0,0,C (p*(r-t)) q,-(a*(r-t)/r)]⟩, + ⟨⟨q,0⟩, ⟨0,p⟩, ⟨q,r-t⟩, ⟨r,-q⟩, + ![p*(r-t),p*(r-t)+C (a*(r-t)) r, + p*(r-t)-(p*(r-t)/q),p*(r-t+1),p*(r-t-1)]⟩ + ], + ![ + ⟨⟨-s,0⟩, ⟨0,-b⟩, ⟨0,s-t⟩, ⟨-s,-q⟩, + ![0,C (p*(s-t)) q,-(b*(s-t)/s),0,0]⟩, + ⟨⟨r,-s⟩, ⟨-b,a⟩, ⟨r+t,0⟩, ⟨-s,-q⟩, + ![0,0,0,a+C (p*t-1) q,-a-(b*t/s)]⟩, + ⟨⟨q,r⟩, ⟨a,p⟩, ⟨q,r+t⟩, ⟨s,q⟩, + ![p*(r+t),p*(r+t)+a+C (b*t) s, + p*(r+t)-a-((p*t-1)/q),p*(r+t+1),p*(r+t-1)]⟩, + ⟨⟨0,q⟩, ⟨p,0⟩, ⟨s-t,q⟩, ⟨s,q⟩, + ![p*(s-t),p*(s-t+1),p*(s-t-1), + p*(s-t)+C (b*(s-t)) s,p*(s-t)-(p*(s-t)/q)]⟩ + ] + ] j k + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1RightFirstValues.lean b/LeanPool/ApollonianSuperharmonic/P5332T1RightFirstValues.lean new file mode 100644 index 0000000000..0231841562 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1RightFirstValues.lean @@ -0,0 +1,228 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1RightRows +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift + +-- [TABLET NODE: P5332T1RightFirstValues] + +/-! +# P5332T1RightFirstValues + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5332T1RightFirstValues (P : FordFareyParameter) (hq : 1 < P.q) + (f : IntegerLatticeFunction) (B : Int) (x : GaussianInt) + (hbase : ∀ y, y ∈ FordVertexDomain P.q → f y = FordOdometer P y) + (hother : ∀ y, + y - (P5332T1RightRows P 0 0).displacement ∈ FordVertexDomain P.q → + f y = FordOdometer P (y - (P5332T1RightRows P 0 0).displacement) + + (P5332T1RightRows P 0 0).linear.re * y.re + + (P5332T1RightRows P 0 0).linear.im * y.im + B) + (hx : x ∈ FordVertexDomain P.q) + (hx' : x - (P5332T1RightRows P 0 0).displacement ∈ FordVertexDomain P.q) + (hstar : ∀ k : Fin 5, + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] k) ∈ FordVertexDomain P.q ∨ + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] k) - (P5332T1RightRows P 0 + 0).displacement ∈ FordVertexDomain P.q) : + ∃ t : Int, 0 ≤ t ∧ t ≤ (P.q₂ : Int) ∧ + x = (P5332T1RightRows P 0 t).center ∧ B = P.p₁ * (P.q : Int) ∧ + (∀ k : Fin 5, f (x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] k)) = + (P5332T1RightRows P 0 t).values k) ∧ + ((∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩ → + z ∈ (FordTile P.q).cells ∨ + z - (P5332T1RightRows P 0 0).displacement ∈ (FordTile P.q).cells) ↔ + 0 < t ∧ t < (P.q₂ : Int)) := by +-- BODY + classical + have hq' : 1 < (P.q : Int) := by exact_mod_cast hq + have hqn : (P.q : Int) ≠ 0 := by omega + have hr : 0 < P.q₁ := by + by_contra h + have hz : P.q₁ = 0 := by omega + have hd := P.det₁ + rw [hz] at hd + norm_num at hd + have hqpos : 0 < (P.q : Int) := by exact_mod_cast P.q_pos + have hpone : P.p₁ * (P.q : Int) = 1 := hd + have hqdiv : (P.q : Int) ∣ 1 := ⟨P.p₁, by nlinarith [mul_comm P.p₁ (P.q : Int)]⟩ + have hqle : (P.q : Int) ≤ 1 := Int.le_of_dvd (by norm_num) hqdiv + omega + have hs : 0 < P.q₂ := P.q₂_pos + have hsum : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by + exact_mod_cast P.sum_q + have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ _ at laws + have boundary (u v : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) + (hv : 0 ≤ v) (hvq : v ≤ P.q) + (hb : u ≤ 1 ∨ (P.q : Int)-1 ≤ u ∨ v ≤ 1 ∨ (P.q : Int)-1 ≤ v) : + FordOdometer P ⟨u,v⟩ = IntegerCeilDiv (P.p*u*v) P.q hqn := by + apply laws.2.1 + change (0 ≤ u ∧ u ≤ (P.q : Int) ∧ 0 ≤ v ∧ v ≤ (P.q : Int)) ∧ + ¬ (2 ≤ u ∧ u ≤ (P.q : Int)-2 ∧ 2 ≤ v ∧ v ≤ (P.q : Int)-2) + omega + have top (u : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) : + FordOdometer P ⟨u,(P.q : Int)⟩ = P.p*u := by + rw [boundary _ _ hu (by omega) (by omega) (by omega) (by omega)] + unfold IntegerCeilDiv + rw [show -(P.p*u*(P.q : Int)) = -(P.p*u)*(P.q : Int) by ring, + Int.mul_ediv_cancel _ hqn] + ring + have bottom (u : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) : + FordOdometer P ⟨u,0⟩ = 0 := by + rw [boundary _ _ hu huq (by omega) (by omega) (by omega)] + simp [IntegerCeilDiv] + have domain (u v : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) + (hv : 0 ≤ v) (hvq : v ≤ P.q) : (⟨u,v⟩ : GaussianInt) ∈ FordVertexDomain P.q := by + exact ⟨hu, huq, hv, hvq⟩ + rcases x with ⟨X,Y⟩ + change ⟨X,Y⟩ ∈ FordVertexDomain P.q at hx + change ⟨X,Y⟩ - (P5332T1RightRows P 0 0).displacement ∈ FordVertexDomain P.q at hx' + simp only [FordVertexDomain, Set.mem_ofPred_eq, P5332T1RightRows, + Matrix.cons_val_zero, Zsqrtd.re_sub, Zsqrtd.im_sub] at hx hx' + have hY : Y = (P.q : Int) := by omega + subst Y + have ht0 : 0 ≤ X := hx.1 + have htq : X ≤ P.q₂ := by rw [hsum] at *; omega + have hstarE := hstar 1 + have hstarW := hstar 2 + dsimp [P5332T1RightRows] at hstarE hstarW + norm_num [FordVertexDomain] at hstarE hstarW + have hcenter0 := hbase ⟨X,(P.q : Int)⟩ hx + have hcenter1 := hother ⟨X,(P.q : Int)⟩ (by + dsimp [P5332T1RightRows] + change 0 ≤ X - (-(P.q₁ : Int)) ∧ X - (-(P.q₁ : Int)) ≤ P.q ∧ + 0 ≤ (P.q : Int)-(P.q : Int) ∧ (P.q : Int)-(P.q : Int) ≤ P.q + omega) + have argCenter : (⟨X,(P.q : Int)⟩ : GaussianInt) - ⟨-(P.q₁ : Int),P.q⟩ = + ⟨X+(P.q₁ : Int),0⟩ := by ext <;> simp + rw [show (⟨X,(P.q : Int)⟩ : GaussianInt) - (P5332T1RightRows P 0 0).displacement = + ⟨X+(P.q₁ : Int),0⟩ by simpa [P5332T1RightRows] using argCenter, + bottom (X+(P.q₁ : Int)) (by omega) (by omega)] at hcenter1 + simp only [P5332T1RightRows, Matrix.cons_val_zero, + zero_add, + ] at hcenter1 + rw [top X ht0 (by omega)] at hcenter0 + have hB : B = P.p₁ * (P.q : Int) := by + have hdet : P.p * (P.q₁ : Int) = P.p₁ * (P.q : Int) - 1 := by + have := P.det₁ + nlinarith + nlinarith + subst B + have valueTop (u : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) : + f ⟨u,(P.q : Int)⟩ = P.p*u := by + exact (hbase ⟨u,(P.q : Int)⟩ ⟨by dsimp; omega, by dsimp; omega, + by dsimp; omega, by dsimp; omega⟩).trans (top u hu huq) + have hNorth : f (⟨X,(P.q : Int)⟩ + ⟨0,1⟩) = + P.p*X + IntegerCeilDiv (P.p*X-1) P.q hqn := by + have arg : (⟨X,(P.q : Int)⟩ : GaussianInt)+⟨0,1⟩-⟨-(P.q₁ : Int),P.q⟩ = + ⟨X+(P.q₁ : Int),1⟩ := by ext <;> simp + have he := hother (⟨X,(P.q : Int)⟩+⟨0,1⟩) (by + dsimp [P5332T1RightRows] + change 0 ≤ (X+0) - (-(P.q₁ : Int)) ∧ (X+0) - (-(P.q₁ : Int)) ≤ P.q ∧ + 0 ≤ ((P.q : Int)+1)-(P.q : Int) ∧ ((P.q : Int)+1)-(P.q : Int) ≤ P.q + omega) + rw [show (⟨X,(P.q : Int)⟩ + ⟨0,1⟩ : GaussianInt) - + (P5332T1RightRows P 0 0).displacement = ⟨X+(P.q₁ : Int),1⟩ by + simpa [P5332T1RightRows] using arg, + boundary _ _ (by omega) (by omega) (by omega) (by omega) (by omega)] at he + have hdet : P.p * (P.q₁ : Int) = P.p₁ * (P.q : Int) - 1 := by + have := P.det₁ + nlinarith + have hp : P.p*(X+(P.q₁ : Int)) = (P.p*X-1) + P.p₁*(P.q : Int) := by + rw [mul_add, hdet] + ring + simp only [mul_one] at he + rw [hp, P5188T1CeilingShift (P.p*X-1) P.p₁ P.q hqn] at he + simp only [P5332T1RightRows, Matrix.cons_val_zero, + Zsqrtd.re_add, Zsqrtd.im_add, + zero_add, add_zero] at he + nlinarith + have hSouth : f (⟨X,(P.q : Int)⟩ - ⟨0,1⟩) = + P.p*X - P.p*X/(P.q : Int) := by + have arg : (⟨X,(P.q : Int)⟩ : GaussianInt)-⟨0,1⟩ = ⟨X,(P.q : Int)-1⟩ := by + ext <;> simp + rw [arg, hbase ⟨X,(P.q : Int)-1⟩ (domain X ((P.q : Int)-1) + (by omega) (by omega) (by omega) (by omega)), + boundary _ _ (by omega) (by omega) (by omega) (by omega) (by omega)] + have hnum : P.p*X*((P.q : Int)-1) = (-P.p*X) + (P.p*X)*(P.q : Int) := by ring + rw [hnum, P5188T1CeilingShift (-P.p*X) (P.p*X) P.q hqn] + simp [IntegerCeilDiv] + ring + have hWest : f (⟨X,(P.q : Int)⟩-1) = P.p*(X-1) := by + by_cases hXpos : X = 0 + · subst X + have arg : (⟨0,(P.q : Int)⟩ : GaussianInt)-1-⟨-(P.q₁ : Int),P.q⟩ = + ⟨(P.q₁ : Int)-1,0⟩ := by ext <;> simp; ring + have hw := hother (⟨0,(P.q : Int)⟩-1) (by + simp [FordVertexDomain, P5332T1RightRows] + omega) + rw [show (⟨0,(P.q : Int)⟩ - 1 : GaussianInt) - + (P5332T1RightRows P 0 0).displacement = ⟨(P.q₁ : Int)-1,0⟩ by + simpa [P5332T1RightRows] using arg, + bottom _ (by omega) (by omega)] at hw + norm_num [P5332T1RightRows] at hw + nlinarith + · have arg : (⟨X,(P.q : Int)⟩ : GaussianInt)-1 = ⟨X-1,(P.q : Int)⟩ := by + ext <;> simp + rw [arg, hbase ⟨X-1,(P.q : Int)⟩ (domain (X-1) (P.q : Int) + (by omega) (by omega) (by omega) (by omega)), top (X-1) (by omega) (by omega)] + refine ⟨X, ht0, htq, ?_, rfl, ?_, ?_⟩ + · ext <;> simp [P5332T1RightRows] + · intro k + fin_cases k + · simpa [P5332T1RightRows] using valueTop X ht0 (by omega) + · have heast : f (⟨X,(P.q : Int)⟩+1) = P.p*(X+1) := by + have arg : (⟨X,(P.q : Int)⟩ : GaussianInt)+1 = ⟨X+1,(P.q : Int)⟩ := by + ext <;> simp + simpa [arg] using valueTop (X+1) (by omega) (by omega) + simpa [P5332T1RightRows] using heast + · simpa [P5332T1RightRows, sub_eq_add_neg] using hWest + · simpa [P5332T1RightRows, Matrix.cons_val_three, Matrix.head_cons, + Matrix.tail_cons, IntegerCeilDiv] using hNorth + · simpa [P5332T1RightRows, Matrix.cons_val_four, Matrix.head_cons, + Matrix.tail_cons, ← sub_eq_add_neg] using hSouth + · constructor + · intro hc + have hc0 := hc ⟨X,(P.q : Int)⟩ (Or.inl rfl) + have hc1 := hc (⟨X,(P.q : Int)⟩-1-⟨0,1⟩) (Or.inr (Or.inr (Or.inr rfl))) + simp only [(P4210T1FordCellRectangles P.q _).1] at hc0 hc1 + simp [P5332T1RightRows] at hc0 hc1 + omega + · intro ht z hz + rcases hz with rfl | rfl | rfl | rfl + · right + simp only [(P4210T1FordCellRectangles P.q _).1] + simp [P5332T1RightRows] + omega + · right + simp only [(P4210T1FordCellRectangles P.q _).1] + simp [P5332T1RightRows] + omega + · left + simp only [(P4210T1FordCellRectangles P.q _).1] + simp [] + omega + · left + simp only [(P4210T1FordCellRectangles P.q _).1] + simp [] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1RightHorizontalValues.lean b/LeanPool/ApollonianSuperharmonic/P5332T1RightHorizontalValues.lean new file mode 100644 index 0000000000..e882de0061 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1RightHorizontalValues.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1RightRows +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift + +-- [TABLET NODE: P5332T1RightHorizontalValues] + +/-! +# P5332T1RightHorizontalValues + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5332T1RightHorizontalValues (P : FordFareyParameter) (hq : 1 < P.q) + (f : IntegerLatticeFunction) (B : Int) (x : GaussianInt) + (hbase : ∀ y, y ∈ FordVertexDomain P.q → f y = FordOdometer P y) + (hother : ∀ y, + y - (P5332T1RightRows P 2 0).displacement ∈ FordVertexDomain P.q → + f y = FordOdometer P (y - (P5332T1RightRows P 2 0).displacement) + + (P5332T1RightRows P 2 0).linear.re * y.re + + (P5332T1RightRows P 2 0).linear.im * y.im + B) + (hx : x ∈ FordVertexDomain P.q) + (hx' : x - (P5332T1RightRows P 2 0).displacement ∈ FordVertexDomain P.q) + (hstar : ∀ k : Fin 5, + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] k) ∈ FordVertexDomain P.q ∨ + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] k) - (P5332T1RightRows P 2 + 0).displacement ∈ FordVertexDomain P.q) : + ∃ t : Int, 0 ≤ t ∧ t ≤ (P.q : Int) ∧ + x = (P5332T1RightRows P 2 t).center ∧ B = 0 ∧ + (∀ k : Fin 5, f (x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] k)) = + (P5332T1RightRows P 2 t).values k) ∧ + ((∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩ → + z ∈ (FordTile P.q).cells ∨ + z - (P5332T1RightRows P 2 0).displacement ∈ (FordTile P.q).cells) ↔ + 0 < t ∧ t < (P.q : Int)) := by +-- BODY + classical + have hq' : 1 < (P.q : Int) := by exact_mod_cast hq + have hqn : (P.q : Int) ≠ 0 := by omega + have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ _ at laws + have boundary (r t : Int) (hr : 0 ≤ r) (hrq : r ≤ P.q) + (ht : 0 ≤ t) (htq : t ≤ P.q) + (hs : r ≤ 1 ∨ (P.q : Int)-1 ≤ r ∨ t ≤ 1 ∨ (P.q : Int)-1 ≤ t) : + FordOdometer P ⟨r,t⟩ = IntegerCeilDiv (P.p*r*t) P.q hqn := by + apply laws.2.1 + change (0 ≤ r ∧ r ≤ (P.q : Int) ∧ 0 ≤ t ∧ t ≤ (P.q : Int)) ∧ + ¬ (2 ≤ r ∧ r ≤ (P.q : Int)-2 ∧ 2 ≤ t ∧ t ≤ (P.q : Int)-2) + omega + have right (t : Int) (ht : 0 ≤ t) (htq : t ≤ P.q) : + FordOdometer P ⟨(P.q : Int),t⟩ = P.p*t := by + rw [boundary _ _ (by omega) (by omega) ht htq (by omega)] + unfold IntegerCeilDiv + rw [show -(P.p*(P.q : Int)*t) = -(P.p*t)*(P.q : Int) by ring, + Int.mul_ediv_cancel _ hqn] + ring + have left (t : Int) (ht : 0 ≤ t) (htq : t ≤ P.q) : + FordOdometer P ⟨0,t⟩ = 0 := by + rw [boundary _ _ (by omega) (by omega) ht htq (by omega)] + simp [IntegerCeilDiv] + rcases x with ⟨X,t⟩ + change ⟨X,t⟩-⟨(P.q : Int),0⟩ ∈ FordVertexDomain P.q at hx' + have hx0 := hx + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub, + sub_zero] at hx0 hx' + have hX : X = (P.q : Int) := by omega + subst X + have hlow := hstar 4 + have hhigh := hstar 3 + dsimp [P5332T1RightRows] at hlow hhigh + norm_num [FordVertexDomain] at hlow hhigh + have ht : 0 < t ∧ t < (P.q : Int) := by omega + have hcenter0 := hbase ⟨(P.q : Int),t⟩ hx + have hcenter1 := hother ⟨(P.q : Int),t⟩ (by + change 0 ≤ (P.q : Int)-P.q ∧ (P.q : Int)-P.q ≤ P.q ∧ 0 ≤ t-0 ∧ t-0 ≤ P.q + omega) + simp only [P5332T1RightRows, Matrix.cons_val_two, Matrix.head_cons, Matrix.tail_cons] + at hcenter1 + have B0 : B = 0 := by + have centerarg : (⟨(P.q : Int),t⟩ : GaussianInt)-⟨(P.q : Int),0⟩ = ⟨0,t⟩ := by + ext <;> simp + rw [centerarg, left t (by omega) (by omega)] at hcenter1 + rw [right t (by omega) (by omega)] at hcenter0 + norm_num only [zero_mul, zero_add, add_zero] at hcenter1 + omega + subst B + have valueR : ∀ z : Int, 0 ≤ z → z ≤ P.q → + f ⟨(P.q : Int),z⟩ = P.p*z := by + intro z hz hzq + exact (hbase ⟨(P.q : Int),z⟩ ⟨by dsimp; omega, le_rfl, hz, hzq⟩).trans (right z hz hzq) + have valueE : f (⟨(P.q : Int),t⟩+1) = P.p*t - (-(P.p*t))/(P.q : Int) := by + have arg : (⟨(P.q : Int),t⟩ : GaussianInt)+1-⟨(P.q : Int),0⟩ = ⟨1,t⟩ := by + ext <;> simp + have he := hother (⟨(P.q : Int),t⟩+1) (by + change (⟨(P.q : Int),t⟩ : GaussianInt)+1-⟨(P.q : Int),0⟩ ∈ FordVertexDomain P.q + rw [arg] + change 0 ≤ (1 : Int) ∧ (1 : Int) ≤ P.q ∧ 0 ≤ t ∧ t ≤ P.q + omega) + dsimp [P5332T1RightRows] at he + rw [arg, boundary 1 t (by omega) (by omega) (by omega) (by omega) (by omega)] at he + simp only [IntegerCeilDiv, mul_one, zero_mul, add_zero, + ] at he + simpa only [sub_eq_add_neg, add_comm] using he + have valueW : f (⟨(P.q : Int),t⟩-1) = P.p*t - P.p*t/(P.q : Int) := by + have arg : (⟨(P.q : Int),t⟩ : GaussianInt)-1 = ⟨(P.q : Int)-1,t⟩ := by + ext <;> simp + rw [arg, hbase (⟨(P.q : Int)-1,t⟩ : GaussianInt) + ⟨by dsimp; omega, by dsimp; omega, by dsimp; omega, by dsimp; omega⟩, + boundary _ _ (by omega) (by omega) (by omega) (by omega) (by omega)] + have num : P.p*((P.q : Int)-1)*t = -P.p*t+(P.p*t)*(P.q : Int) := by ring + rw [num, P5188T1CeilingShift (-P.p*t) (P.p*t) P.q hqn] + simp only [IntegerCeilDiv, neg_mul, neg_neg] + ring + refine ⟨t, by omega, by omega, rfl, rfl, ?_, ?_⟩ + · intro l + fin_cases l + · simpa [P5332T1RightRows] using valueR t (by omega) (by omega) + · simpa [P5332T1RightRows, sub_eq_add_neg] using valueE + · simpa [P5332T1RightRows, Matrix.cons_val_two, Matrix.head_cons, Matrix.tail_cons, + sub_eq_add_neg] using valueW + · have arg : (⟨(P.q : Int),t⟩ : GaussianInt)+⟨0,1⟩ = ⟨(P.q : Int),t+1⟩ := by ext <;> simp + simpa [P5332T1RightRows, Matrix.cons_val_three, Matrix.head_cons, Matrix.tail_cons, arg] + using valueR (t+1) (by omega) (by omega) + · have arg : (⟨(P.q : Int),t⟩ : GaussianInt)-⟨0,1⟩ = ⟨(P.q : Int),t-1⟩ := by ext <;> simp + simpa [P5332T1RightRows, Matrix.cons_val_four, Matrix.head_cons, Matrix.tail_cons, + ← sub_eq_add_neg, arg] using valueR (t-1) (by omega) (by omega) + · constructor + · intro _ + exact ht + · intro _ z hz + rcases hz with rfl | rfl | rfl | rfl + · right + rw [(P4210T1FordCellRectangles P.q _).1] + change 0 ≤ (P.q : Int)-P.q ∧ (P.q : Int)-P.q < P.q ∧ 0 ≤ t-0 ∧ t-0 < P.q + omega + · left + rw [(P4210T1FordCellRectangles P.q _).1] + change 0 ≤ (P.q : Int)-1 ∧ (P.q : Int)-1 < P.q ∧ 0 ≤ t-0 ∧ t-0 < P.q + omega + · right + rw [(P4210T1FordCellRectangles P.q _).1] + change 0 ≤ (P.q : Int)-0-P.q ∧ (P.q : Int)-0-P.q < P.q ∧ 0 ≤ t-1-0 ∧ t-1-0 < P.q + omega + · left + rw [(P4210T1FordCellRectangles P.q _).1] + change 0 ≤ (P.q : Int)-1-0 ∧ (P.q : Int)-1-0 < P.q ∧ 0 ≤ t-0-1 ∧ t-0-1 < P.q + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1RightRounding.lean b/LeanPool/ApollonianSuperharmonic/P5332T1RightRounding.lean new file mode 100644 index 0000000000..de9bab1bc5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1RightRounding.lean @@ -0,0 +1,148 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1RightRows +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv + +-- [TABLET NODE: P5332T1RightRounding] + +/-! +# P5332T1RightRounding + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5332T1RightRounding (P : FordFareyParameter) (hq : 1 < P.q) + (j : Fin 3) (t : Int) (ht : 0 ≤ t) + (ht' : t ≤ ((![P.q₂, P.q₁, P.q] j : Nat) : Int)) : + let V := (P5332T1RightRows P j t).values + V 1 + V 2 + V 3 + V 4 - 4 * V 0 = + if 0 < t ∧ t < ((![P.q₂, P.q₁, P.q] j : Nat) : Int) then 1 else 0 := by +-- BODY + have hq' : 1 < (P.q : Int) := by exact_mod_cast hq + have hr : 0 < (P.q₁ : Int) := by + by_contra hn + have hz : P.q₁ = 0 := by omega + have hh := P.det₁ + rw [hz] at hh + norm_num at hh + have : (P.q : Int) ∣ 1 := ⟨P.p₁, by nlinarith⟩ + have := Int.le_of_dvd (by omega : (0 : Int) < 1) this + omega + have hs : 0 < (P.q₂ : Int) := by exact_mod_cast P.q₂_pos + have hsum : (P.q : Int) = (P.q₁ : Int) + P.q₂ := by exact_mod_cast P.sum_q + have hpr : P.p * (P.q₁ : Int) = P.p₁ * (P.q : Int) - 1 := by nlinarith [P.det₁] + have hps : P.p * (P.q₂ : Int) = P.p₂ * (P.q : Int) + 1 := by nlinarith [P.det₂] + have cancel (v : Int) (hv : (P.q : Int) ∣ P.p*v) : (P.q : Int) ∣ v := by + obtain ⟨k, hk⟩ := hv + refine ⟨P.p₁*v-(P.q₁ : Int)*k, ?_⟩ + have hm := congrArg (fun z : Int => z*v) P.det₁ + nlinarith only [hm, hk] + have fm (K : Int) : (K*(P.q : Int)-1)/(P.q : Int) = K-1 := by + apply (Int.ediv_eq_iff_of_pos (by omega)).mpr + constructor <;> nlinarith + have fp (K : Int) : (K*(P.q : Int)+1)/(P.q : Int) = K := by + apply (Int.ediv_eq_iff_of_pos (by omega)).mpr + constructor <;> nlinarith + have ceil (N K : Int) (lo : K*(P.q : Int) < N) (hi : N ≤ K*(P.q : Int)+P.q) : + -((-N)/(P.q : Int)) = K+1 := by + have hh : (-N)/(P.q : Int) = -(K+1) := by + apply (Int.ediv_eq_iff_of_pos (by omega)).mpr + constructor <;> nlinarith + rw [hh] + ring + have cm (K : Int) : -((-(K*(P.q : Int)-1))/(P.q : Int)) = K := by + convert ceil (K*(P.q : Int)-1) (K-1) (by nlinarith) (by nlinarith) using 1; ring + have cp (K : Int) : -((-(K*(P.q : Int)+1))/(P.q : Int)) = K+1 := + ceil _ K (by omega) (by omega) + have fnm (K : Int) : (1-K*(P.q : Int))/(P.q : Int) = -K := by + apply (Int.ediv_eq_iff_of_pos (by omega)).mpr + constructor <;> nlinarith + have fnp (K : Int) : (-1-K*(P.q : Int))/(P.q : Int) = -(K+1) := by + apply (Int.ediv_eq_iff_of_pos (by omega)).mpr + constructor <;> nlinarith + have dq (K : Int) : K*(P.q : Int)/(P.q : Int) = K := + Int.mul_ediv_cancel K (by omega) + have cq (K : Int) : -((-(K*(P.q : Int)))/(P.q : Int)) = K := by + rw [← neg_mul, dq] + ring + by_cases hEnd : t = 0 ∨ t = ((![P.q₂,P.q₁,P.q] j : Nat) : Int) + · rcases hEnd with rfl | rfl + · fin_cases j <;> dsimp [P5332T1RightRows] <;> + norm_num [show (1 : Int)/(P.q : Int) = 0 by simpa using fp 0, + show (-1 : Int)/(P.q : Int) = -1 by simpa using fm 0] + · fin_cases j <;> dsimp [P5332T1RightRows] <;> + norm_num only [hps, hpr, add_sub_cancel_left, add_sub_cancel_right, sub_add_cancel, + sub_neg_eq_add, sub_self, lt_self_iff_false, and_false, ite_false, + fm, fp, cm, cp, fnm, fnp, dq, cq] <;> + nlinarith only [hpr, hps] + · have htp : 0 < t := by omega + have htL : t < ((![P.q₂,P.q₁,P.q] j : Nat) : Int) := by omega + have htq : t < (P.q : Int) := by fin_cases j <;> dsimp at htL <;> omega + let K := P.p*t/(P.q : Int) + let R := P.p*t%(P.q : Int) + have hR0 : 0 ≤ R := Int.emod_nonneg _ (by omega) + have hRq : R < (P.q : Int) := Int.emod_lt_of_pos _ (by omega) + have heq : P.p*t = K*(P.q : Int)+R := by + dsimp [K, R] + have := Int.emod_add_mul_ediv (P.p*t) (P.q : Int) + nlinarith + have hRn : R ≠ 0 := by + intro hh + have hd : (P.q : Int) ∣ t := cancel t ⟨K, by nlinarith [hh]⟩ + have := Int.le_of_dvd htp hd + omega + have hRp : 0 < R := by omega + have hC : -((-(P.p*t))/(P.q : Int)) = K+1 := + ceil _ K (by nlinarith) (by nlinarith) + fin_cases j + · change t < (P.q₂ : Int) at htL + have hR1 : R ≠ 1 := by + intro hh + have hd := cancel ((P.q₂ : Int)-t) + (show (P.q : Int) ∣ P.p*((P.q₂ : Int)-t) from + ⟨P.p₂-K, by nlinarith only [heq, hps, hh]⟩) + have := Int.le_of_dvd (by omega : 0 < (P.q₂ : Int)-t) hd + omega + have hc : -((-(P.p*t-1))/(P.q : Int)) = K+1 := + ceil _ K (by + have : 2 ≤ R := by omega + nlinarith) (by nlinarith) + dsimp [P5332T1RightRows] + norm_num only [hc, show 0 < t ∧ t < (P.q₂ : Int) from ⟨htp,htL⟩, true_and, ite_true] + change _ + _ + _ + _ - _ = 1 + dsimp [K] at hc + nlinarith only [hc] + · change t < (P.q₁ : Int) at htL + have hR1 : R ≠ (P.q : Int)-1 := by + intro hh + have hd := cancel ((P.q₁ : Int)-t) + (show (P.q : Int) ∣ P.p*((P.q₁ : Int)-t) from + ⟨P.p₁-K-1, by nlinarith only [heq, hpr, hh]⟩) + have := Int.le_of_dvd (by omega : 0 < (P.q₁ : Int)-t) hd + omega + have hf : (P.p*t+1)/(P.q : Int) = K := by + apply (Int.ediv_eq_iff_of_pos (by omega)).mpr + have : R ≤ (P.q : Int)-2 := by omega + constructor <;> nlinarith + dsimp [P5332T1RightRows] + norm_num only [hC, hf, show 0 < t ∧ t < (P.q₁ : Int) from ⟨htp,htL⟩, true_and, ite_true] + ring + · dsimp [P5332T1RightRows] + norm_num only [hC, show 0 < t ∧ t < (P.q : Int) from ⟨htp,htq⟩, true_and, ite_true] + change _ + _ + _ + _ - _ = 1 + dsimp [K] at hC + nlinarith only [hC] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1RightRows.lean b/LeanPool/ApollonianSuperharmonic/P5332T1RightRows.lean new file mode 100644 index 0000000000..179d5fa1d9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1RightRows.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1Stencil + +-- [TABLET NODE: P5332T1RightRows] + +/-! +# P5332T1RightRows + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a Ford--Farey parameter put $r=q_1$, $s=q_2$ and +$C_d(N)=-\lfloor-N/d\rfloor$. The three equal-square contact stencils, +indexed by $j=0,1,2$ and an integer $t$, are the following records +$(d,a,z,w,V)$ of `P5332T1Stencil`; in each row $w=0$: +$$ +\begin{array}{c|c|c|c} +j&d&a&z\\ \hline +0&(-r,q)&(p,-p_1)&(t,q)\\ +1&(-s,-q)&(-p,-p_2)&(t,0)\\ +2&(q,0)&(0,p)&(q,t) +\end{array} +$$ +Their five value vectors, in the prescribed order, are +$$ +\begin{array}{c|l} +0&(pt,p(t+1),p(t-1),pt+C_q(pt-1),pt-\lfloor pt/q\rfloor)\\ +1&(0,0,0,C_q(pt),-\lfloor(pt+1)/q\rfloor)\\ +2&(pt,pt+C_q(pt),pt-\lfloor pt/q\rfloor,p(t+1),p(t-1)). +\end{array} +$$ +These are data definitions, not an assertion that any function takes these +values. For positive $d$, $C_d$ is the usual ceiling for signed numerators. +-/ +def P5332T1RightRows (P : FordFareyParameter) (j : Fin 3) (t : Int) : + P5332T1Stencil := +-- BODY + let q : Int := P.q + let r : Int := P.q₁ + let s : Int := P.q₂ + let p := P.p + let C (N : Int) := -((-N) / q) + ![ + ⟨⟨-r, q⟩, ⟨p, -P.p₁⟩, ⟨t, q⟩, 0, + ![p*t, p*(t+1), p*(t-1), p*t+C (p*t-1), p*t-(p*t/q)]⟩, + ⟨⟨-s, -q⟩, ⟨-p, -P.p₂⟩, ⟨t, 0⟩, 0, + ![0, 0, 0, C (p*t), -((p*t+1)/q)]⟩, + ⟨⟨q, 0⟩, ⟨0, p⟩, ⟨q, t⟩, 0, + ![p*t, p*t+C (p*t), p*t-(p*t/q), p*(t+1), p*(t-1)]⟩ + ] j + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean b/LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean new file mode 100644 index 0000000000..7290054dd3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean @@ -0,0 +1,379 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1RightRows +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift +public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic + +-- [TABLET NODE: P5332T1RightSecondValues] + +/-! +# P5332T1RightSecondValues + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RightSecondValuesProof + +private theorem hB : + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → (∀ (f : IntegerLatticeFunction), ∀ (B : Int), + (∀ y ∈ FordVertexDomain P.q, f y = FordOdometer P y) → ((∀ (y : GaussianInt), y - + (P5332T1RightRows P (1 : Fin (3 : ℕ)) (0 : ℤ)).displacement ∈ FordVertexDomain P.q → f + y = FordOdometer P (y - (P5332T1RightRows P (1 : Fin (3 : ℕ)) (0 : ℤ)).displacement) + + (P5332T1RightRows P (1 : Fin (3 : ℕ)) (0 : ℤ)).linear.re * y.re + (P5332T1RightRows P + (1 : Fin (3 : ℕ)) (0 : ℤ)).linear.im * y.im + B) → ((∀ (u : Int), (0 ≤ u) → ((u ≤ P.q) → + (FordOdometer P ⟨u,0⟩ = 0))) → ((∀ (u : Int), (0 ≤ u) → ((u ≤ P.q) → (FordOdometer P + ⟨u,(P.q : Int)⟩ = P.p*u))) → (∀ (X : ℤ), ((P.q : Int) = (P.q₁ : Int) + P.q₂) → (((0 : ℤ) + ≤ X ∧ X ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ (0 : ℤ) ∧ (0 : ℤ) ≤ (↑P.q : ℤ)) → (((0 : ℤ) ≤ X - + -(↑P.q₂ : ℤ) ∧ X - -(↑P.q₂ : ℤ) ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ (0 : ℤ) - -(↑P.q : ℤ) ∧ (0 : ℤ) + - -(↑P.q : ℤ) ≤ (↑P.q : ℤ)) → ( + let t : Int := X + (0 ≤ t) → (B = -P.p * (P.q₂ : Int)))))))))) := by + classical + intro P hq f B hbase hother bottom top X hsum hx hx' t ht + have hxt : (⟨t,0⟩ : GaussianInt) ∈ FordVertexDomain P.q := by + change 0 ≤ t ∧ t ≤ P.q ∧ 0 ≤ (0 : Int) ∧ (0 : Int) ≤ P.q + exact ⟨ht, by omega, by omega, by omega⟩ + have hc0 := hbase ⟨t,0⟩ hxt + have hc1 := hother ⟨t,0⟩ (by + dsimp [P5332T1RightRows] + change 0 ≤ t - (-(P.q₂ : Int)) ∧ t - (-(P.q₂ : Int)) ≤ P.q ∧ + 0 ≤ (0 : Int) - (-(P.q : Int)) ∧ (0 : Int) - (-(P.q : Int)) ≤ P.q + omega) + dsimp [P5332T1RightRows] at hc1 + have arg : (⟨t,0⟩ : GaussianInt) - (⟨-(P.q₂ : Int),-(P.q : Int)⟩ : GaussianInt) = ⟨t+P.q₂,P.q⟩ + := by ext <;> simp + rw [arg, top (t+P.q₂) (by omega) (by omega)] at hc1 + simp only [Int.mul_zero, add_zero] at hc1 + rw [bottom t ht (by omega)] at hc0 + rw [hc0] at hc1 + nlinarith [hc1] + +private theorem hWest : + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → (∀ (f : IntegerLatticeFunction), ∀ (hqn : (P.q + : Int) ≠ 0), (∀ (u : Int), (0 ≤ u) → ((u ≤ P.q) → (FordOdometer P ⟨u,(P.q : Int)⟩ = + P.p*u))) → (∀ (X : ℤ), ((P.q : Int) = (P.q₁ : Int) + P.q₂) → ((0 < (P.q₂ : Int)) → (((0 : + ℤ) ≤ X ∧ X ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ (0 : ℤ) ∧ (0 : ℤ) ≤ (↑P.q : ℤ)) → (((0 : ℤ) ≤ X - + -(↑P.q₂ : ℤ) ∧ X - -(↑P.q₂ : ℤ) ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ (0 : ℤ) - -(↑P.q : ℤ) ∧ (0 : ℤ) + - -(↑P.q : ℤ) ≤ (↑P.q : ℤ)) → ( + let t : Int := X + (∀ (y : GaussianInt), y - (P5332T1RightRows P (1 : Fin (3 : ℕ)) (0 : ℤ)).displacement ∈ + FordVertexDomain P.q → f y = FordOdometer P (y - (P5332T1RightRows P (1 : Fin (3 : ℕ)) + (0 : ℤ)).displacement) + (P5332T1RightRows P (1 : Fin (3 : ℕ)) (0 : ℤ)).linear.re * + y.re + (P5332T1RightRows P (1 : Fin (3 : ℕ)) (0 : ℤ)).linear.im * y.im + -P.p * (↑P.q₂ + : ℤ)) → ((∀ (u : Int), ∀ (v : Int), (0 ≤ u) → ((u ≤ P.q) → ((0 ≤ v) → ((v ≤ P.q) → ((u ≤ + 1 ∨ P.q - 1 ≤ u ∨ v ≤ 1 ∨ P.q - 1 ≤ v) → (f ⟨u,v⟩ = IntegerCeilDiv (P.p*u*v) P.q + hqn)))))) → (f ((⟨t,0⟩ : GaussianInt)-1) = 0)))))))) := by + classical + intro P hq f hqn top X hsum hq₂pos hx hx' t hother hbaseval + by_cases htz : t = 0 + · have hXzero : X = 0 := by simpa [t] using htz + have hmem : (⟨-1,0⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement ∈ + FordVertexDomain P.q := by + dsimp [P5332T1RightRows] + change 0 ≤ -1 - (-(P.q₂ : Int)) ∧ -1 - (-(P.q₂ : Int)) ≤ P.q ∧ + 0 ≤ (0 : Int) - (-(P.q : Int)) ∧ (0 : Int) - (-(P.q : Int)) ≤ P.q + have hq₂nat : 1 ≤ P.q₂ := Nat.succ_le_of_lt P.q₂_pos + omega + have hw := hother ⟨-1,0⟩ hmem + dsimp [P5332T1RightRows] at hw + have ha : (⟨-1,0⟩ : GaussianInt) - (⟨-(P.q₂ : Int),-(P.q : Int)⟩ : GaussianInt) = + ⟨P.q₂-1,P.q⟩ := by + ext <;> simp; ring + rw [ha, top (P.q₂-1) (by omega) (by omega)] at hw + have hval : f (⟨-1,0⟩ : GaussianInt) = 0 := by rw [hw]; ring + have hp : ((⟨t,0⟩ : GaussianInt)-1) = ⟨-1,0⟩ := by rw [htz]; ext <;> simp + rw [hp, hval] + · have htpos : 0 < t := by omega + have hp : (⟨t,0⟩ : GaussianInt)-1 = ⟨t-1,0⟩ := by ext <;> simp + rw [hp, hbaseval (t-1) 0 (by omega) (by omega) (by omega) (by omega) (by omega)] + simp [IntegerCeilDiv] + +private theorem hSouth : + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → (∀ (f : IntegerLatticeFunction), ∀ (hqn : (P.q + : Int) ≠ 0), (∀ (u : Int), ∀ (v : Int), (0 ≤ u) → ((u ≤ P.q) → ((0 ≤ v) → ((v ≤ P.q) → + ((u ≤ 1 ∨ (P.q : Int)-1 ≤ u ∨ v ≤ 1 ∨ (P.q : Int)-1 ≤ v) → (FordOdometer P ⟨u,v⟩ = + IntegerCeilDiv (P.p*u*v) P.q hqn)))))) → (∀ (X : ℤ), ((P.q : Int) = (P.q₁ : Int) + P.q₂) + → ((0 < (P.q₁ : Int)) → (((0 : ℤ) ≤ X - -(↑P.q₂ : ℤ) ∧ X - -(↑P.q₂ : ℤ) ≤ (↑P.q : ℤ) ∧ (0 + : ℤ) ≤ (0 : ℤ) - -(↑P.q : ℤ) ∧ (0 : ℤ) - -(↑P.q : ℤ) ≤ (↑P.q : ℤ)) → ( + let t : Int := X + (∀ (y : GaussianInt), y - (P5332T1RightRows P (1 : Fin (3 : ℕ)) (0 : ℤ)).displacement ∈ + FordVertexDomain P.q → f y = FordOdometer P (y - (P5332T1RightRows P (1 : Fin (3 : ℕ)) + (0 : ℤ)).displacement) + (P5332T1RightRows P (1 : Fin (3 : ℕ)) (0 : ℤ)).linear.re * + y.re + (P5332T1RightRows P (1 : Fin (3 : ℕ)) (0 : ℤ)).linear.im * y.im + -P.p * (↑P.q₂ + : ℤ)) → (f ((⟨t,0⟩ : GaussianInt)+(-⟨0,1⟩)) = -((P.p*t+1)/P.q))))))) := by + classical + intro P hq f hqn boundary X hsum hq₁pos hx' t hother + have hdom : (⟨t,-1⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement ∈ FordVertexDomain + P.q := by + dsimp [P5332T1RightRows] + change 0 ≤ t - (-(P.q₂ : Int)) ∧ t - (-(P.q₂ : Int)) ≤ P.q ∧ + 0 ≤ -1 - (-(P.q : Int)) ∧ -1 - (-(P.q : Int)) ≤ P.q + have hq2nat : 1 ≤ P.q₂ := Nat.succ_le_of_lt P.q₂_pos + have hq1nat : 1 ≤ P.q₁ := Nat.succ_le_of_lt (by exact_mod_cast hq₁pos) + omega + have hsarg : (⟨t,-1⟩ : GaussianInt) - (⟨-(P.q₂ : Int),-(P.q : Int)⟩ : GaussianInt) = + ⟨t+P.q₂,P.q-1⟩ := by + ext <;> simp; ring + have hsbd : FordOdometer P ⟨t+P.q₂,P.q-1⟩ = + IntegerCeilDiv (P.p*(t+P.q₂)*(P.q-1)) P.q hqn := + boundary _ _ (by omega) (by omega) (by omega) (by omega) (by omega) + have hs := hother ⟨t,-1⟩ hdom + dsimp [P5332T1RightRows] at hs + rw [hsarg, hsbd] at hs + have hdet := P.det₂ + have hshift : IntegerCeilDiv (P.p*(t+P.q₂)*(P.q-1)) P.q hqn = + IntegerCeilDiv (-(P.p*t+1)) P.q hqn + P.p*(t+P.q₂) - P.p₂ := by + have hn : P.p*(t+P.q₂)*(P.q-1) = -(P.p*t+1) + (P.p*(t+P.q₂)-P.p₂)*P.q := by + nlinarith [hdet] + rw [hn, P5188T1CeilingShift] + ring + rw [hshift] at hs + have hpt : ((⟨t,0⟩ : GaussianInt)+(-⟨0,1⟩)) = ⟨t,-1⟩ := by ext <;> simp + rw [hpt] + ring_nf at hs + simpa [IntegerCeilDiv] using hs + +private theorem westUnion : + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((IntegerLatticeFunction) → (((P.q : Int) ≠ 0) + → (∀ (X : ℤ), ((P.q : Int) = (P.q₁ : Int) + P.q₂) → (((0 : ℤ) ≤ X ∧ X ≤ (↑P.q : ℤ) ∧ (0 : + ℤ) ≤ (0 : ℤ) ∧ (0 : ℤ) ≤ (↑P.q : ℤ)) → ( + let t : Int := X + (∀ (u : Int), ∀ (v : Int), (⟨u,v⟩ : GaussianInt) ∈ (FordTile P.q).cells ↔ 0 ≤ u ∧ u < P.q ∧ 0 + ≤ v ∧ v < P.q) → ((∀ (u : Int), ∀ (v : Int), ((⟨u,v⟩ : GaussianInt) - (P5332T1RightRows + P 1 0).displacement) ∈ (FordTile P.q).cells ↔ 0 ≤ u + P.q₂ ∧ u + P.q₂ < P.q ∧ 0 ≤ v + P.q + ∧ v + P.q < P.q) → ((⟨t-1,0⟩ : GaussianInt) ∈ (FordTile P.q).cells ∨ + (⟨t-1,0⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement ∈ + (FordTile P.q).cells ↔ 0 < t))))))) := by + classical + intro P hq f hqn X hsum hx t rect transRect + rw [rect, transRect] + constructor + · rintro (⟨hlo,_,_,_⟩ | ⟨_,hhi,_,_⟩) <;> omega + · intro htpos + left + exact ⟨by omega, by omega, by omega, by omega⟩ + +private theorem lowerUnion : + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((IntegerLatticeFunction) → (((P.q : Int) ≠ 0) + → (∀ (X : ℤ), ((P.q : Int) = (P.q₁ : Int) + P.q₂) → (((0 : ℤ) ≤ X - -(↑P.q₂ : ℤ) ∧ X - + -(↑P.q₂ : ℤ) ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ (0 : ℤ) - -(↑P.q : ℤ) ∧ (0 : ℤ) - -(↑P.q : ℤ) ≤ + (↑P.q : ℤ)) → ( + let t : Int := X + (∀ (u : Int), ∀ (v : Int), (⟨u,v⟩ : GaussianInt) ∈ (FordTile P.q).cells ↔ 0 ≤ u ∧ u < P.q ∧ 0 + ≤ v ∧ v < P.q) → ((∀ (u : Int), ∀ (v : Int), ((⟨u,v⟩ : GaussianInt) - (P5332T1RightRows + P 1 0).displacement) ∈ (FordTile P.q).cells ↔ 0 ≤ u + P.q₂ ∧ u + P.q₂ < P.q ∧ 0 ≤ v + P.q + ∧ v + P.q < P.q) → ((⟨t,-1⟩ : GaussianInt) ∈ (FordTile P.q).cells ∨ + (⟨t,-1⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement ∈ + (FordTile P.q).cells ↔ t < P.q₁))))))) := by + classical + intro P hq f hqn X hsum hx' t rect transRect + rw [rect, transRect] + constructor + · rintro (⟨_,_,hlo,_⟩ | ⟨hlo,hhi,_,_⟩) <;> omega + · intro hlt + right + exact ⟨by omega, by omega, by omega, by omega⟩ + +private theorem hcriterion : + ∀ (P : FordFareyParameter), ∀ (X : ℤ), + let t : Int := X + (((⟨t,0⟩ : GaussianInt)-1) = ⟨t-1,0⟩) → ((((⟨t,0⟩ : GaussianInt)-⟨0,1⟩) = ⟨t,-1⟩) → ((((⟨t,0⟩ + : GaussianInt)-1-⟨0,1⟩) = ⟨t-1,-1⟩) → (((⟨t-1,0⟩ : GaussianInt) ∈ (FordTile P.q).cells ∨ + (⟨t-1,0⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement ∈ (FordTile P.q).cells + ↔ 0 < t) → (((⟨t,-1⟩ : GaussianInt) ∈ (FordTile P.q).cells ∨ (⟨t,-1⟩ : GaussianInt) - + (P5332T1RightRows P 1 0).displacement ∈ (FordTile P.q).cells ↔ t < P.q₁) → (((⟨t,0⟩ : + GaussianInt) ∈ (FordTile P.q).cells) → (((⟨t-1,-1⟩ : GaussianInt) - (P5332T1RightRows P + 1 0).displacement ∈ (FordTile P.q).cells) → ((∀ z : GaussianInt, + z = (⟨t,0⟩ : GaussianInt) ∨ z = (⟨t,0⟩ : GaussianInt)-1 ∨ + z = (⟨t,0⟩ : GaussianInt)-⟨0,1⟩ ∨ + z = (⟨t,0⟩ : GaussianInt)-1-⟨0,1⟩ → + z ∈ (FordTile P.q).cells ∨ + z - (P5332T1RightRows P 1 0).displacement ∈ (FordTile P.q).cells) ↔ + 0 < t ∧ t < P.q₁))))))) := by + classical + intro P X t westPt lowerPt cornerPt westUnion lowerUnion centerCell cornerCell + constructor + · intro hall + have hw := hall (⟨t,0⟩-1) (by simp) + have hl := hall (⟨t,0⟩-⟨0,1⟩) (by simp) + constructor + · exact westUnion.mp (by simpa [westPt] using hw) + · exact lowerUnion.mp (by simpa [lowerPt] using hl) + · rintro ⟨htpos, htlt⟩ z hz + rcases hz with rfl | rfl | rfl | rfl + · exact Or.inl centerCell + · exact (westUnion.mpr htpos).imp_left (by intro hm; exact hm) + · simpa [lowerPt] using lowerUnion.mpr htlt + · exact Or.inr (by simpa [cornerPt] using cornerCell) + +end RightSecondValuesProof + +theorem P5332T1RightSecondValues (P : FordFareyParameter) (hq : 1 < P.q) + (f : IntegerLatticeFunction) (B : Int) (x : GaussianInt) + (hbase : ∀ y, y ∈ FordVertexDomain P.q → f y = FordOdometer P y) + (hother : ∀ y, + y - (P5332T1RightRows P 1 0).displacement ∈ FordVertexDomain P.q → + f y = FordOdometer P (y - (P5332T1RightRows P 1 0).displacement) + + (P5332T1RightRows P 1 0).linear.re * y.re + + (P5332T1RightRows P 1 0).linear.im * y.im + B) + (hx : x ∈ FordVertexDomain P.q) + (hx' : x - (P5332T1RightRows P 1 0).displacement ∈ FordVertexDomain P.q) + (hstar : ∀ k : Fin 5, + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] k) ∈ FordVertexDomain P.q ∨ + x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] k) - (P5332T1RightRows P 1 + 0).displacement ∈ FordVertexDomain P.q) : + ∃ t : Int, 0 ≤ t ∧ t ≤ (P.q₁ : Int) ∧ + x = (P5332T1RightRows P 1 t).center ∧ B = -P.p * (P.q₂ : Int) ∧ + (∀ k : Fin 5, f (x + (![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] k)) = + (P5332T1RightRows P 1 t).values k) ∧ + ((∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩ → + z ∈ (FordTile P.q).cells ∨ + z - (P5332T1RightRows P 1 0).displacement ∈ (FordTile P.q).cells) ↔ + 0 < t ∧ t < (P.q₁ : Int)) := by +-- BODY + classical + have hq' : 1 < (P.q : Int) := by exact_mod_cast hq + have hqn : (P.q : Int) ≠ 0 := by omega + have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ _ at laws + have boundary (u v : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) + (hv : 0 ≤ v) (hvq : v ≤ P.q) + (hs : u ≤ 1 ∨ (P.q : Int)-1 ≤ u ∨ v ≤ 1 ∨ (P.q : Int)-1 ≤ v) : + FordOdometer P ⟨u,v⟩ = IntegerCeilDiv (P.p*u*v) P.q hqn := by + apply laws.2.1 + change (0 ≤ u ∧ u ≤ (P.q : Int) ∧ 0 ≤ v ∧ v ≤ (P.q : Int)) ∧ + ¬ (2 ≤ u ∧ u ≤ (P.q : Int)-2 ∧ 2 ≤ v ∧ v ≤ (P.q : Int)-2) + omega + have bottom (u : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) : + FordOdometer P ⟨u,0⟩ = 0 := by + rw [boundary u 0 hu huq (by omega) (by omega) (by omega)] + simp [IntegerCeilDiv] + have top (u : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) : + FordOdometer P ⟨u,(P.q : Int)⟩ = P.p*u := by + rw [boundary u P.q hu huq (by omega) (by omega) (by omega)] + unfold IntegerCeilDiv + rw [show -(P.p*u*(P.q : Int)) = (-P.p*u)*(P.q : Int) by ring, + Int.mul_ediv_cancel _ hqn] + ring + let x₀ := x + rcases x with ⟨X,Y⟩ + change ⟨X,Y⟩ ∈ FordVertexDomain P.q at hx + change ⟨X,Y⟩- (P5332T1RightRows P 1 0).displacement ∈ FordVertexDomain P.q at hx' + simp only [FordVertexDomain, Set.mem_ofPred_eq] at hx + dsimp [P5332T1RightRows] at hx' + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, + Zsqrtd.im_sub] at hx' + have hsum : (P.q : Int) = (P.q₁ : Int) + P.q₂ := by exact_mod_cast P.sum_q + have hq₂pos : 0 < (P.q₂ : Int) := by exact_mod_cast P.q₂_pos + have hq₁pos : 0 < (P.q₁ : Int) := by + have hp := (P5130T5ParentArithmetic P hq).1 + exact_mod_cast hp + have hgeom : Y = 0 ∧ 0 ≤ X ∧ X ≤ P.q₁ := by omega + rcases hgeom with ⟨rfl, hX, hXr⟩ + let t : Int := X + have ht : 0 ≤ t := hX + have htr : t ≤ P.q₁ := hXr + have hcenter : x₀ = (P5332T1RightRows P 1 t).center := by + simp [x₀, t, P5332T1RightRows] + have hB : B = -P.p * (P.q₂ : Int) := RightSecondValuesProof.hB P hq f B hbase hother bottom top + X hsum hx hx' ht + subst B + have hq1le : (P.q₁ : Int) ≤ P.q := by omega + have hbaseval (u v : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) + (hv : 0 ≤ v) (hvq : v ≤ P.q) + (hs : u ≤ 1 ∨ P.q - 1 ≤ u ∨ v ≤ 1 ∨ P.q - 1 ≤ v) : + f ⟨u,v⟩ = IntegerCeilDiv (P.p*u*v) P.q hqn := by + have hdom : (⟨u,v⟩ : GaussianInt) ∈ FordVertexDomain P.q := ⟨hu,huq,hv,hvq⟩ + rw [hbase ⟨u,v⟩ hdom, boundary u v hu huq hv hvq hs] + have hcenterVal : f ⟨t,0⟩ = 0 := by + rw [hbaseval t 0 ht (by omega) (by omega) (by omega) (by omega)] + simp [IntegerCeilDiv] + have hEast : f ((⟨t,0⟩ : GaussianInt)+1) = 0 := by + have hp : (⟨t,0⟩ : GaussianInt)+1 = ⟨t+1,0⟩ := by ext <;> simp + rw [hp, hbaseval (t+1) 0 (by omega) (by omega) (by omega) (by omega) (by omega)] + simp [IntegerCeilDiv] + have hWest : f ((⟨t,0⟩ : GaussianInt)-1) = 0 := RightSecondValuesProof.hWest P hq f hqn top X + hsum hq₂pos hx hx' hother hbaseval + have hNorth : f ((⟨t,0⟩ : GaussianInt)+⟨0,1⟩) = IntegerCeilDiv (P.p*t) P.q hqn := by + have hp : (⟨t,0⟩ : GaussianInt)+⟨0,1⟩ = ⟨t,1⟩ := by ext <;> simp + rw [hp, hbaseval t 1 ht (by omega) (by omega) (by omega) (by omega)] + norm_num [IntegerCeilDiv] + have hSouth : f ((⟨t,0⟩ : GaussianInt)+(-⟨0,1⟩)) = -((P.p*t+1)/P.q) := + RightSecondValuesProof.hSouth P hq f hqn boundary X hsum hq₁pos hx' hother + refine ⟨t, ht, htr, ?_, ?_, ?_, ?_⟩ + · simp [t, P5332T1RightRows] + · rfl + · intro k + fin_cases k + · simpa [P5332T1RightRows, t] using hcenterVal + · simpa [P5332T1RightRows, t] using hEast + · simpa [P5332T1RightRows, t, sub_eq_add_neg] using hWest + · simpa [P5332T1RightRows, t, IntegerCeilDiv] using hNorth + · simpa [P5332T1RightRows, t] using hSouth + · have hq1lt : (P.q₁ : Int) < P.q := by exact_mod_cast P.q₁_lt + have hq2nat : 1 ≤ P.q₂ := Nat.succ_le_of_lt P.q₂_pos + have dval : (P5332T1RightRows P 1 0).displacement = + (⟨-(P.q₂ : Int),-(P.q : Int)⟩ : GaussianInt) := by + simp [P5332T1RightRows] + have rect (u v : Int) : + (⟨u,v⟩ : GaussianInt) ∈ (FordTile P.q).cells ↔ + 0 ≤ u ∧ u < P.q ∧ 0 ≤ v ∧ v < P.q := by + simpa using (P4210T1FordCellRectangles P.q ⟨u,v⟩).1 + have transRect (u v : Int) : + ((⟨u,v⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement) ∈ + (FordTile P.q).cells ↔ + 0 ≤ u + P.q₂ ∧ u + P.q₂ < P.q ∧ + 0 ≤ v + P.q ∧ v + P.q < P.q := by + have hp : (⟨u,v⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement = + ⟨u+P.q₂,v+P.q⟩ := by rw [dval]; ext <;> simp + rw [hp, rect] + have westPt : ((⟨t,0⟩ : GaussianInt)-1) = ⟨t-1,0⟩ := by ext <;> simp + have lowerPt : ((⟨t,0⟩ : GaussianInt)-⟨0,1⟩) = ⟨t,-1⟩ := by ext <;> simp + have cornerPt : ((⟨t,0⟩ : GaussianInt)-1-⟨0,1⟩) = ⟨t-1,-1⟩ := by ext <;> simp + have westUnion : + (⟨t-1,0⟩ : GaussianInt) ∈ (FordTile P.q).cells ∨ + (⟨t-1,0⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement ∈ + (FordTile P.q).cells ↔ 0 < t := RightSecondValuesProof.westUnion P hq f hqn X hsum hx + rect transRect + have lowerUnion : + (⟨t,-1⟩ : GaussianInt) ∈ (FordTile P.q).cells ∨ + (⟨t,-1⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement ∈ + (FordTile P.q).cells ↔ t < P.q₁ := RightSecondValuesProof.lowerUnion P hq f hqn X + hsum hx' rect transRect + have centerCell : (⟨t,0⟩ : GaussianInt) ∈ (FordTile P.q).cells := by + rw [rect] + exact ⟨by omega, by omega, by omega, by omega⟩ + have cornerCell : + (⟨t-1,-1⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement ∈ + (FordTile P.q).cells := by + rw [transRect] + exact ⟨by omega, by omega, by omega, by omega⟩ + have hcriterion : + (∀ z : GaussianInt, + z = (⟨t,0⟩ : GaussianInt) ∨ z = (⟨t,0⟩ : GaussianInt)-1 ∨ + z = (⟨t,0⟩ : GaussianInt)-⟨0,1⟩ ∨ + z = (⟨t,0⟩ : GaussianInt)-1-⟨0,1⟩ → + z ∈ (FordTile P.q).cells ∨ + z - (P5332T1RightRows P 1 0).displacement ∈ (FordTile P.q).cells) ↔ + 0 < t ∧ t < P.q₁ := RightSecondValuesProof.hcriterion P X westPt lowerPt cornerPt + westUnion lowerUnion centerCell cornerCell + simpa [x₀, t, P5332T1RightRows, sub_eq_add_neg] using hcriterion + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1SignedParentIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5332T1SignedParentIntervals.lean new file mode 100644 index 0000000000..cccb7615b0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1SignedParentIntervals.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P5332T1SignedParentIntervals] + +/-! +# P5332T1SignedParentIntervals + +Adapted from Wesley Pegden’s Apache - 2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5332T1SignedParentIntervals (A p d q v σ : Int) + (hd : 0 < d) (hdq : d < q) (hv : 0 < v) (hvd : v < d) + (hσ : σ = 1 ∨ σ = -1) (hdet : A * q - p * d = σ) : + let K := A * v / d; + -((-(A * v)) / d) = K + 1 ∧ + p * v / q = K ∧ -((-(p * v)) / q) = K + 1 ∧ + (p * v + σ) / q = K ∧ -((-(p * v + σ)) / q) = K + 1 := by +-- BODY + dsimp only + let K := A * v / d + let R := A * v % d + have hq : 0 < q := lt_trans hd hdq + have hR0 : 0 ≤ R := Int.emod_nonneg _ (by omega) + have hRd : R < d := Int.emod_lt_of_pos _ hd + have heq : A * v = K * d + R := by + dsimp [K, R] + have := Int.emod_add_mul_ediv (A * v) d + nlinarith + have hRn : R ≠ 0 := by + intro hz + have hdiv : d ∣ σ * v := by + refine ⟨K * q - p * v, ?_⟩ + have hm := congrArg (fun z : Int => z * v) hdet + rw [hz] at heq + nlinarith [hm] + have hdv : d ∣ v := by + rcases hσ with rfl | rfl + · simpa using hdiv + · simpa using hdiv + have := Int.le_of_dvd hv hdv + omega + have hRp : 0 < R := by omega + have lower : K * q < p * v := by + have hh := congrArg (fun z : Int => z * v) hdet + rcases hσ with hs | hs <;> rw [hs] at hh <;> nlinarith + have upper : p * v < K * q + q := by + have hh := congrArg (fun z : Int => z * v) hdet + rcases hσ with hs | hs <;> rw [hs] at hh <;> nlinarith + have lower' : K * q < p * v + σ := by + have hh := congrArg (fun z : Int => z * v) hdet + rcases hσ with hs | hs <;> rw [hs] at hh ⊢ <;> nlinarith + have upper' : p * v + σ < K * q + q := by + have hh := congrArg (fun z : Int => z * v) hdet + rcases hσ with hs | hs <;> rw [hs] at hh ⊢ <;> nlinarith + have ceil (N D : Int) (hD : 0 < D) (hlo : K * D < N) (hhi : N < K * D + D) : + -((-N) / D) = K + 1 := by + have hh : (-N) / D = -(K + 1) := by + apply (Int.ediv_eq_iff_of_pos hD).mpr + constructor <;> nlinarith + rw [hh] + ring + refine ⟨ceil (A * v) d hd (by nlinarith) (by nlinarith), ?_, + ceil (p * v) q hq lower upper, ?_, ceil (p * v + σ) q hq lower' upper'⟩ + · change p * v / q = K + apply (Int.ediv_eq_iff_of_pos hq).mpr + constructor <;> omega + · change (p * v + σ) / q = K + apply (Int.ediv_eq_iff_of_pos hq).mpr + constructor <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Stencil.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Stencil.lean new file mode 100644 index 0000000000..0776549c0c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Stencil.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter + +-- [TABLET NODE: P5332T1Stencil] + +/-! +# P5332T1Stencil + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A Ford contact stencil is a record consisting of an integral displacement +$d$, an integral affine coefficient $a$, a contact center $z$, an integral +companion displacement $w$, and five integer values $V_0,\ldots,V_4$. +The value order is always $z,z+1,z-1,z+i,z-i$. The companion displacement +is used for child--parent contacts; it is set to zero for equal-square +contacts. +-/ +structure P5332T1Stencil where +-- BODY + /-- The spatial translation in the contact identity. -/ + displacement : GaussianInt + /-- The Gaussian coefficient of the affine correction. -/ + linear : GaussianInt + /-- The lattice vertex at the center of the five-point contact stencil. -/ + center : GaussianInt + /-- The companion displacement, zero for equal-square contacts. -/ + companion : GaussianInt + /-- The prescribed values at the center, east, west, north and south vertices. -/ + values : Fin 5 → Int + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1VectorPlacements.lean b/LeanPool/ApollonianSuperharmonic/P5332T1VectorPlacements.lean new file mode 100644 index 0000000000..1bd38d5058 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5332T1VectorPlacements.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1RightRows +public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint + +-- [TABLET NODE: P5332T1VectorPlacements] + +/-! +# P5332T1VectorPlacements + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5332T1VectorPlacements (P : FordFareyParameter) (hq : 1 < P.q) : + let q := FordRecursiveQuadruple P + (∀ j : Fin 3, + BandVectors.1 (q 0) (q j.succ) = (P5332T1RightRows P j 0).displacement ∧ + BandVectors.2 (q 0) (q j.succ) = (P5332T1RightRows P j 0).linear) ∧ + ∀ (j : Fin 2) (k : Fin 4), + let i : Fin 3 := ⟨j.val, by omega⟩ + let R := P5332T1ParentRows P j k 0 + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ k.val * + (BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ))) = + (((((![P.q₁, P.q₂] j : Nat) : ℝ) - P.q) / 2 + R.displacement.re), + ((((![P.q₁, P.q₂] j : Nat) : ℝ) - P.q) / 2 + R.displacement.im)) ∧ + (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ k.val * + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ))) = + (((((![P.p₁, P.p₂] j : Int) : ℝ) - P.p) / 2 + R.linear.re), + ((((![P.p₁, P.p₂] j : Int) : ℝ) - P.p) / 2 + R.linear.im)) ∧ + (⟨0, 1⟩ : GaussianInt) ^ k.val * + (if Even k.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) = R.companion := by +-- BODY + classical + dsimp only + obtain ⟨hproper, hv1, hv2, hv3, ha1, ha2, ha3, _⟩ := + (FordCoordinateConfiguration P).2 hq + have flip := (VectorRecursionLaws _ hproper.1).2.2.2.2 hproper + have o0 := flip 0 + have o1 := flip 1 + have o2 := flip 2 + simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl, + show (1 : Fin 3).succ = (2 : Fin 4) from rfl, + show (2 : Fin 3).succ = (3 : Fin 4) from rfl] at o0 o1 o2 + rw [hv1, ha1] at o0 + rw [hv2, ha2] at o1 + rw [hv3, ha3] at o2 + constructor + · intro j + fin_cases j <;> simp [P5332T1RightRows, o0.1, o0.2, o1.1, o1.2, o2.1, o2.2, + Zsqrtd.ext_iff] + · intro j k + have hqsum : (P.q : ℝ) = (P.q₁ : ℝ) + (P.q₂ : ℝ) := by + exact_mod_cast P.sum_q + have hpsum : (P.p : ℝ) = (P.p₁ : ℝ) + (P.p₂ : ℝ) := by + exact_mod_cast P.sum_p + fin_cases j <;> fin_cases k <;> + norm_num [P5332T1ParentRows, hv1, hv2, ha1, ha2, + o0.1, o0.2, o1.1, o1.2, GaussianRealPoint, Zsqrtd.ext_iff, + pow_succ, GaussianInt.toComplex_def, Prod.ext_iff, + show Even 0 from ⟨0, rfl⟩, show ¬ Even 1 by decide, + show Even 2 from ⟨1, rfl⟩, show ¬ Even 3 by decide] <;> + (repeat' constructor) <;> linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2DomainRows.lean b/LeanPool/ApollonianSuperharmonic/P5352T2DomainRows.lean new file mode 100644 index 0000000000..0a69c77d1c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5352T2DomainRows.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows + +-- [TABLET NODE: P5352T2DomainRows] + +/-! +# P5352T2DomainRows + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5352T2DomainRows (K : DiamondParameter) (z : GaussianInt) : + (z ∈ FootprintVertices (DiamondTile K.1) ↔ + 0 ≤ z.im ∧ z.im ≤ 2 * (K.1 : Int) ∧ + -(K.1 : Int) ≤ z.re ∧ z.re ≤ (K.1 : Int) ∧ + -z.im-1 ≤ z.re ∧ z.re ≤ z.im+1 ∧ + -(2*(K.1 : Int)-z.im+1) ≤ z.re ∧ z.re ≤ 2*(K.1 : Int)-z.im+1) ∧ + (z ∈ FootprintVertices (DiamondTile K.1) → + DiamondOdometer K z = + (Int.natAbs z.re : Int) * ((Int.natAbs z.re : Int)-1)/2 - + (z.re-z.im)^2/4) := by +-- BODY + obtain ⟨_, _, _, hf, _⟩ := DiamondTileOdometerRestriction K + have bounds : (z ∈ FootprintVertices (DiamondTile K.1) ↔ + 0 ≤ z.im ∧ z.im ≤ 2 * (K.1 : Int) ∧ + -(K.1 : Int) ≤ z.re ∧ z.re ≤ (K.1 : Int) ∧ + -z.im-1 ≤ z.re ∧ z.re ≤ z.im+1 ∧ + -(2*(K.1 : Int)-z.im+1) ≤ z.re ∧ z.re ≤ 2*(K.1 : Int)-z.im+1) := by + rw [hf] + change max (Int.natAbs z.re) (max (Int.natAbs (z.im-(K.1 : Int))) + (Int.natAbs z.re + Int.natAbs (z.im-(K.1 : Int)) - 1)) ≤ K.1 ↔ _ + simp only [max_le_iff] + have ha := Int.natCast_natAbs z.re + have hb := Int.natCast_natAbs (z.im-(K.1 : Int)) + rcases le_total 0 z.re with h | h <;> + rcases le_total 0 (z.im-(K.1 : Int)) with h' | h' <;> + simp only [abs_of_nonneg, abs_of_nonpos, h, h'] at ha hb <;> omega + refine ⟨bounds, ?_⟩ + intro hz + exact (Classical.choose_spec (DiamondOdometerExistsUnique K)).1.2.2.2 z (hf ▸ hz) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean b/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean new file mode 100644 index 0000000000..f72fe5a1d8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean @@ -0,0 +1,602 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData +public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic +public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable + +-- [TABLET NODE: P5352T2FirstUnit] + +/-! +# P5352T2FirstUnit + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FirstUnitProof + +private theorem umem : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + ∀ (x : GaussianInt), x ∈ FootprintVertices (P5352T2Sources K hk (1 : Fin (4 : ℕ))).1 ↔ + U x.re x.im ) := by + classical + intro K hk U x + simp only [P5352T2Sources, Matrix.cons_val_one, Matrix.cons_val_zero] + simp [FootprintVertices] + simp only [Zsqrtd.ext_iff, Zsqrtd.re_zero, Zsqrtd.im_zero, + Zsqrtd.re_one, Zsqrtd.im_one, Zsqrtd.re_add, Zsqrtd.im_add] + dsimp [U] + omega + +private theorem sqm : + (by + classical + exact + ∀ (t : ℤ), ((-1 : ℤ) - (2 : ℤ) * t) ^ (2 : ℕ) / (4 : ℤ) = t ^ (2 : ℕ) + t ) := by + classical + intro t + have h := P4207T1FloorArithmetic.1 (-1) (-t) + rw [show -1+2*(-t) = -1-2*t by ring] at h + norm_num at h + nlinarith only [h] + +private theorem sqp : + (by + classical + exact + ∀ (t : ℤ), ((1 : ℤ) - (2 : ℤ) * t) ^ (2 : ℕ) / (4 : ℤ) = t ^ (2 : ℕ) - t ) := by + classical + intro t + have h := P4207T1FloorArithmetic.1 1 (-t) + rw [show 1+2*(-t) = 1-2*t by ring] at h + norm_num at h + nlinarith only [h] + +private theorem triDiff : + (by + classical + exact + (DiamondParameter) → (∀ (t : ℤ), t * (t - (1 : ℤ)) / (2 : ℤ) - (t - (1 : ℤ)) * (t - (2 : + ℤ)) / (2 : ℤ) = t - (1 : ℤ)) ) := by + classical + intro K t + have he : t*(t-1) = (t-1)*(t-2)+(t-1)*2 := by ring + omega + +private theorem child : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ C x.re x.im) → ((∀ y ∈ + FootprintVertices (DiamondTile K.1), f y = DiamondOdometer K y) → (∀ (p : ℤ), ∀ (q : + ℤ), C p q → f ⟨p, q⟩ = P4207T1DiamondFormula ⟨p, q⟩)) ) := by + classical + intro K f k C cmem hA p q h + rw [hA _ ((cmem _).mpr h)] + exact (P5352T2DomainRows K _).2 ((cmem _).mpr h) + +private theorem parent : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (s : Fin 4), ∀ (f : + IntegerLatticeFunction), ∀ (B : Int), + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (P5352T2Sources K hk 1).1 ↔ U x.re x.im) → + ((∀ (y : GaussianInt), y - ((P5352T2PlacementData K.1 (0 : Fin (3 : ℕ))).2 s).1 ∈ + FootprintVertices (P5352T2Sources K hk (1 : Fin (4 : ℕ))).1 → f y = + (P5352T2Sources K hk (1 : Fin (4 : ℕ))).2.1 (y - ((P5352T2PlacementData K.1 (0 : + Fin (3 : ℕ))).2 s).1) + ((P5352T2PlacementData K.1 (0 : Fin (3 : ℕ))).2 s).2.1.re * + y.re + ((P5352T2PlacementData K.1 (0 : Fin (3 : ℕ))).2 s).2.1.im * y.im + B) → ( + let d := ((P5352T2PlacementData K.1 0).2 s).1 + let a := ((P5352T2PlacementData K.1 0).2 s).2.1 + ∀ (p : ℤ), ∀ (q : ℤ), U (p - d.re) (q - d.im) → f ⟨p, q⟩ = (if p - d.re = (1 : ℤ) ∧ q - + d.im = (1 : ℤ) then (1 : ℤ) else (0 : ℤ)) + a.re * p + a.im * q + B)) ) := by + classical + intro K hk s f B U umem hP d a p q h + have hh := hP ⟨p,q⟩ ((umem _).mpr h) + simpa only [P5352T2Sources, Matrix.cons_val_one, Matrix.cons_val_zero, + CurvatureOneOdometer, Zsqrtd.ext_iff, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, + zero_add, add_zero, d, a] using hh + +private theorem covered : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (s : Fin 4), ∀ (z : GaussianInt), + let k : Int := K.1 + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ C x.re x.im) → ((∀ (x : + GaussianInt), x ∈ FootprintVertices (P5352T2Sources K hk 1).1 ↔ U x.re x.im) → ((∀ + (y : GaussianInt), y = z ∨ y = z + (1 : GaussianInt) ∨ y = z - (1 : GaussianInt) ∨ y + = z + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = z - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ FootprintVertices + (P5352T2Sources K hk (0 : Fin (4 : ℕ))).1 ∨ y - ((P5352T2PlacementData K.1 (0 : + Fin (3 : ℕ))).2 s).1 ∈ FootprintVertices (P5352T2Sources K hk (1 : Fin (4 : ℕ))).1) + → ( + let d := ((P5352T2PlacementData K.1 0).2 s).1 + ∀ (p : ℤ), ∀ (q : ℤ), ⟨p, q⟩ = z ∨ ⟨p, q⟩ = z + (1 : GaussianInt) ∨ ⟨p, q⟩ = z - (1 : + GaussianInt) ∨ ⟨p, q⟩ = z + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ ⟨p, q⟩ = z - ⟨(0 : ℤ), (1 : ℤ)⟩ → C + p q ∨ U (p - d.re) (q - d.im)))) ) := by + classical + intro K hk s z k C U cmem umem hcov d p q h + rcases hcov _ h with h | h + · exact Or.inl ((cmem _).mp h) + · exact Or.inr ((umem _).mp h) + +private theorem lap : + (by + classical + exact + ∀ (f : IntegerLatticeFunction), ∀ (p : ℤ), ∀ (q : ℤ), FourNeighborLaplacian f ⟨p, q⟩ = f + ⟨p + (1 : ℤ), q⟩ - f ⟨p, q⟩ + (f ⟨p - (1 : ℤ), q⟩ - f ⟨p, q⟩) + (f ⟨p, q + (1 : ℤ)⟩ - + f ⟨p, q⟩) + (f ⟨p, q - (1 : ℤ)⟩ - f ⟨p, q⟩) ) := by + classical + intro f p q + rw [FourNeighborLaplacian, + show (⟨p,q⟩ : GaussianInt)+1 = ⟨p+1,q⟩ by ext <;> simp, + show (⟨p,q⟩ : GaussianInt)-1 = ⟨p-1,q⟩ by ext <;> simp, + show (⟨p,q⟩ : GaussianInt)+⟨0,1⟩ = ⟨p,q+1⟩ by ext <;> simp, + show (⟨p,q⟩ : GaussianInt)-⟨0,1⟩ = ⟨p,q-1⟩ by ext <;> simp] + ring + +private theorem hzAt199 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (z : GaussianInt), + let k : Int := K.1 + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + (C z.re z.im) → ((U (z.re - (0 : ℤ)) (z.im - (2 : ℤ) * k)) → ((C (z.re + (1 : ℤ)) z.im ∨ + U (z.re + (1 : ℤ) - (0 : ℤ)) (z.im - (2 : ℤ) * k)) → (z = ⟨0,2*k⟩))) ) := by + classical + intro K z k C U center unitCenter he + dsimp [C, U] at center unitCenter he + ext <;> dsimp <;> omega + +private theorem hmarkAt203 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ C x.re x.im) → ( + let r : GaussianInt := ⟨-k, k+1⟩ + (⟨0,2*k⟩ : GaussianInt) - r ∈ FootprintVertices (DiamondTile K.1))) ) := by + classical + intro K hk k C cmem r + rw [cmem] + change C (0-(-k)) (2*k-(k+1)) + dsimp [C] + omega + +private theorem hlAt223 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + (∀ (p : Int), ∀ (q : Int), FourNeighborLaplacian f ⟨p,q⟩ = (f ⟨p+1,q⟩ - f ⟨p,q⟩) + (f + ⟨p-1,q⟩ - f ⟨p,q⟩) + (f ⟨p,q+1⟩ - f ⟨p,q⟩) + (f ⟨p,q-1⟩ - f ⟨p,q⟩)) → ((f ⟨(1 : ℤ), + (2 : ℤ) * k⟩ = -(k ^ (2 : ℕ) - k)) → ((f ⟨(0 : ℤ), (2 : ℤ) * k + (1 : ℤ)⟩ = -(k * ((2 + : ℤ) * k + (1 : ℤ))) + B) → ((f ⟨(0 : ℤ), (2 : ℤ) * k⟩ = -(k * ((2 : ℤ) * k)) + B) → + ((f ⟨0,2*k+1⟩ - f ⟨0,2*k⟩ = -k) → ((f ⟨(-1 : ℤ), (2 : ℤ) * k⟩ = -(k ^ (2 : ℕ) + k)) → + ((f ⟨(0 : ℤ), (2 : ℤ) * k - (1 : ℤ)⟩ = -(k ^ (2 : ℕ) - k)) → ((f ⟨(0 : ℤ), (2 : ℤ) * + k⟩ = -k ^ (2 : ℕ)) → (FourNeighborLaplacian f ⟨0,2*k⟩ = 0)))))))) ) := by + classical + intro K f B k lap he hdiffN hdiffZ hn hw hs hc + rw [lap] + norm_num only [zero_add, zero_sub] + omega + +private theorem hzAt234 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (z : GaussianInt), + let k : Int := K.1 + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + (C z.re z.im) → ((U (z.re - (-k - (1 : ℤ))) (z.im - k)) → ((C z.re (z.im + (1 : ℤ)) ∨ U + (z.re - (-k - (1 : ℤ))) (z.im + (1 : ℤ) - k)) → (z = ⟨-k,k⟩))) ) := by + classical + intro K z k C U center unitCenter hn + dsimp [C, U] at center unitCenter hn + ext <;> dsimp <;> omega + +private theorem hmarkAt238 : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ C x.re x.im) → ( + let r : GaussianInt := ⟨-k, k+1⟩ + (⟨-k,k⟩ : GaussianInt) - r ∉ FootprintVertices (DiamondTile K.1)) ) := by + classical + intro K k C cmem r + rw [cmem] + change ¬ C (-k-(-k)) (k-(k+1)) + dsimp [C] + omega + +private theorem haAt253 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ((IntegerLatticeFunction) → ((Int) → ( + let k : Int := K.1 + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + (C (⟨-k, k⟩ : GaussianInt).re (⟨-k, k⟩ : GaussianInt).im) → ((U ((⟨-k, k⟩ : + GaussianInt).re - (-k - (1 : ℤ))) ((⟨-k, k⟩ : GaussianInt).im - k)) → + ((Int.natAbs (1-k) : Int) = k-1))))) ) := by + classical + intro K hk f B k C U center unitCenter + rw [Int.natCast_natAbs, abs_of_nonpos (by omega : 1-k ≤ 0)] + omega + +private theorem hbAt256 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ((IntegerLatticeFunction) → ((Int) → ( + let k : Int := K.1 + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + (C (⟨-k, k⟩ : GaussianInt).re (⟨-k, k⟩ : GaussianInt).im) → ((U ((⟨-k, k⟩ : + GaussianInt).re - (-k - (1 : ℤ))) ((⟨-k, k⟩ : GaussianInt).im - k)) → + (((Int.natAbs (1-k) : Int) = k-1) → ((Int.natAbs (-k) : Int) = k)))))) ) := by + classical + intro K hk f B k C U center unitCenter ha + rw [Int.natCast_natAbs, abs_of_nonpos (by omega : -k ≤ 0)] + omega + +private theorem hlAt265 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + (∀ (p : Int), ∀ (q : Int), FourNeighborLaplacian f ⟨p,q⟩ = (f ⟨p+1,q⟩ - f ⟨p,q⟩) + (f + ⟨p-1,q⟩ - f ⟨p,q⟩) + (f ⟨p,q+1⟩ - f ⟨p,q⟩) + (f ⟨p,q-1⟩ - f ⟨p,q⟩)) → ((C (⟨-k, k⟩ : + GaussianInt).re + (⟨-k, k⟩ : GaussianInt).im) → ((U ((⟨-k, k⟩ : GaussianInt).re - (-k - (1 : ℤ))) + ((⟨-k, k⟩ : GaussianInt).im - k)) → ((f ⟨-k, k + (1 : + ℤ)⟩ = k * (k - (1 : ℤ)) / (2 : ℤ) - (k ^ (2 : ℕ) + k)) → ((f ⟨-k - (1 : ℤ), k⟩ = (-k + - (1 : ℤ)) * k + B) → ((f ⟨-k, k⟩ = (-k - (1 : ℤ)) * k + B) → (((Int.natAbs (1-k) : + Int) = k-1) → (((Int.natAbs (-k) : Int) = k) → ((f ⟨(1 : ℤ) - k, k⟩ = (k - (1 : ℤ)) * + (k - (2 : ℤ)) / (2 : ℤ) - (k ^ (2 : ℕ) - k)) → ((f ⟨-k, k - (1 : ℤ)⟩ = k * (k - (1 : + ℤ)) / (2 : ℤ) - (k ^ (2 : ℕ) - k)) → ((f ⟨-k, k⟩ = k * (k - (1 : ℤ)) / (2 : ℤ) - k ^ + (2 : ℕ)) → ((k * (k - (1 : ℤ)) / (2 : ℤ) - (k - (1 : ℤ)) * (k - (2 : ℤ)) / (2 : ℤ) = + k - (1 : ℤ)) → (FourNeighborLaplacian f ⟨-k,k⟩ = 1)))))))))))) ) := by + classical + intro K f B k C U lap center unitCenter hn hdiffW hdiffZ ha hb he hs hc ht + rw [lap, show -k+1 = 1-k by ring] + omega + +private theorem hzAt275 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (z : GaussianInt), + let k : Int := K.1 + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + (C z.re z.im) → ((U (z.re - (-1 : ℤ)) (z.im - (-1 : ℤ))) → ((C (z.re - (1 : ℤ)) z.im ∨ U + (z.re - (1 : ℤ) - (-1 : ℤ)) (z.im - (-1 : ℤ))) → (z = ⟨0,0⟩))) ) := by + classical + intro K z k C U center unitCenter hw + dsimp [C, U] at center unitCenter hw + ext <;> dsimp <;> omega + +private theorem hmarkAt279 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ C x.re x.im) → ( + let r : GaussianInt := ⟨k, -k-1⟩ + (⟨0,0⟩ : GaussianInt) - r ∈ FootprintVertices (DiamondTile K.1))) ) := by + classical + intro K hk k C cmem r + rw [cmem] + change C (0-k) (0-(-k-1)) + dsimp [C] + omega + +private theorem hlAt294 : + (by + classical + exact + (DiamondParameter) → (∀ (f : IntegerLatticeFunction), ∀ (B : Int), (∀ (p : Int), ∀ (q : + Int), FourNeighborLaplacian f ⟨p,q⟩ = (f ⟨p+1,q⟩ - f ⟨p,q⟩) + (f ⟨p-1,q⟩ - f ⟨p,q⟩) + + (f ⟨p,q+1⟩ - f ⟨p,q⟩) + (f ⟨p,q-1⟩ - f ⟨p,q⟩)) → ((f ⟨(-1 : ℤ), (0 : ℤ)⟩ = (0 : ℤ)) → + ((f ⟨(0 : ℤ), (-1 : ℤ)⟩ = (1 : ℤ) + B) → ((f ⟨(0 : ℤ), (0 : ℤ)⟩ = (1 : ℤ) + B) → ((f + ⟨(1 : ℤ), (0 : ℤ)⟩ = (0 : ℤ)) → ((f ⟨(0 : ℤ), (1 : ℤ)⟩ = (0 : ℤ)) → ((f ⟨(0 : ℤ), (0 + : ℤ)⟩ = (0 : ℤ)) → (FourNeighborLaplacian f ⟨0,0⟩ = 0)))))))) ) := by + classical + intro K f B lap hw hdiffS hdiffZ he hn hc + rw [lap] + norm_num only [zero_add, zero_sub] + omega + +private theorem hzAt305 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (z : GaussianInt), + let k : Int := K.1 + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + (C z.re z.im) → ((U (z.re - k) (z.im - (k - (1 : ℤ)))) → ((C z.re (z.im - (1 : ℤ)) ∨ U + (z.re - k) (z.im - (1 : ℤ) - (k - (1 : ℤ)))) → (z = ⟨k,k⟩))) ) := by + classical + intro K z k C U center unitCenter hs + dsimp [C, U] at center unitCenter hs + ext <;> dsimp <;> omega + +private theorem hmarkAt309 : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ C x.re x.im) → ( + let r : GaussianInt := ⟨k, -k-1⟩ + (⟨k,k⟩ : GaussianInt) - r ∉ FootprintVertices (DiamondTile K.1)) ) := by + classical + intro K k C cmem r + rw [cmem] + change ¬ C (k-k) (k-(-k-1)) + dsimp [C] + omega + +private theorem hlAt331 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + (∀ (p : Int), ∀ (q : Int), FourNeighborLaplacian f ⟨p,q⟩ = (f ⟨p+1,q⟩ - f ⟨p,q⟩) + (f + ⟨p-1,q⟩ - f ⟨p,q⟩) + (f ⟨p,q+1⟩ - f ⟨p,q⟩) + (f ⟨p,q-1⟩ - f ⟨p,q⟩)) → ((C (⟨k, k⟩ : + GaussianInt).re + (⟨k, k⟩ : GaussianInt).im) → ((U ((⟨k, k⟩ : GaussianInt).re - k) ((⟨k, k⟩ : + GaussianInt).im - (k - (1 : ℤ)))) → ((f ⟨k, k - (1 : ℤ)⟩ + = k * (k - (1 : ℤ)) / (2 : ℤ)) → ((f ⟨k + (1 : ℤ), k⟩ = (1 : ℤ) + (k - (1 : ℤ)) * (k + + (1 : ℤ)) + B) → ((f ⟨k, k⟩ = (k - (1 : ℤ)) * k + B) → ((f ⟨k+1,k⟩ - f ⟨k,k⟩ = k) → + (((Int.natAbs (k-1) : Int) = k-1) → (((Int.natAbs k : Int) = k) → ((f ⟨k - (1 : ℤ), + k⟩ = (k - (1 : ℤ)) * (k - (2 : ℤ)) / (2 : ℤ)) → ((f ⟨k, k + (1 : ℤ)⟩ = k * (k - (1 : + ℤ)) / (2 : ℤ)) → ((f ⟨k, k⟩ = k * (k - (1 : ℤ)) / (2 : ℤ)) → ((k * (k - (1 : ℤ)) / (2 + : ℤ) - (k - (1 : ℤ)) * (k - (2 : ℤ)) / (2 : ℤ) = k - (1 : ℤ)) → + (FourNeighborLaplacian f ⟨k,k⟩ = 1))))))))))))) ) := by + classical + intro K f B k C U lap center unitCenter hs hdiffE hdiffZ he ha hb hw hn hc ht + rw [lap] + omega + +end FirstUnitProof + +theorem P5352T2FirstUnit (K : DiamondParameter) (hk : 1 < K.1) + (s : Fin 4) (f : IntegerLatticeFunction) (B : Int) (z : GaussianInt) : + let A := P5352T2Sources K hk 0 + let D := P5352T2Sources K hk 1 + let M := (P5352T2PlacementData K.1 0).2 s + (∀ y, y ∈ FootprintVertices A.1 → f y = A.2.1 y) → + (∀ y, y - M.1 ∈ FootprintVertices D.1 → + f y = D.2.1 (y - M.1) + M.2.1.re*y.re + M.2.1.im*y.im + B) → + z ∈ FootprintVertices A.1 → z - M.1 ∈ FootprintVertices D.1 → + (∀ y, y = z ∨ y = z + 1 ∨ y = z - 1 ∨ + y = z + ⟨0, 1⟩ ∨ y = z - ⟨0, 1⟩ → + y ∈ FootprintVertices A.1 ∨ y - M.1 ∈ FootprintVertices D.1) → + (z - M.2.2 ∈ FootprintVertices A.1 → FourNeighborLaplacian f z = 0) ∧ + (z - M.2.2 ∉ FootprintVertices A.1 → FourNeighborLaplacian f z = 1) := by +-- BODY + classical + let k : Int := K.1 + have hk2 : 2 ≤ k := by dsimp [k]; omega + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + have cmem (x : GaussianInt) : + x ∈ FootprintVertices (DiamondTile K.1) ↔ C x.re x.im := + (P5352T2DomainRows K x).1 + have umem (x : GaussianInt) : + x ∈ FootprintVertices (P5352T2Sources K hk 1).1 ↔ U x.re x.im := FirstUnitProof.umem K hk x + have sq0 (t : Int) : (2*t)^2/4 = t^2 := by + simpa using (P4207T1FloorArithmetic.1 0 t) + have sqm (t : Int) : (-1-2*t)^2/4 = t^2+t := FirstUnitProof.sqm t + have sqp (t : Int) : (1-2*t)^2/4 = t^2-t := FirstUnitProof.sqp t + have triDiff (t : Int) : + t*(t-1)/2 - (t-1)*(t-2)/2 = t-1 := FirstUnitProof.triDiff K t + dsimp only + intro hA hP hzA hzP hcov + change ∀ y, y ∈ FootprintVertices (DiamondTile K.1) → + f y = DiamondOdometer K y at hA + have child (p q : Int) (h : C p q) : + f ⟨p,q⟩ = P4207T1DiamondFormula ⟨p,q⟩ := FirstUnitProof.child K f cmem hA p q h + have center := (cmem z).mp hzA + have unitCenter := (umem _).mp hzP + let d := ((P5352T2PlacementData K.1 0).2 s).1 + let a := ((P5352T2PlacementData K.1 0).2 s).2.1 + let r := ((P5352T2PlacementData K.1 0).2 s).2.2 + have parent (p q : Int) (h : U (p-d.re) (q-d.im)) : + f ⟨p,q⟩ = (if p-d.re = 1 ∧ q-d.im = 1 then 1 else 0) + + a.re*p + a.im*q + B := FirstUnitProof.parent K hk s f B umem hP p q h + have covered (p q : Int) + (h : (⟨p,q⟩ : GaussianInt) = z ∨ ⟨p,q⟩ = z+1 ∨ ⟨p,q⟩ = z-1 ∨ + ⟨p,q⟩ = z+⟨0,1⟩ ∨ ⟨p,q⟩ = z-⟨0,1⟩) : + C p q ∨ U (p-d.re) (q-d.im) := FirstUnitProof.covered K hk s z cmem umem hcov p q h + have lap (p q : Int) : FourNeighborLaplacian f ⟨p,q⟩ = + (f ⟨p+1,q⟩ - f ⟨p,q⟩) + (f ⟨p-1,q⟩ - f ⟨p,q⟩) + + (f ⟨p,q+1⟩ - f ⟨p,q⟩) + (f ⟨p,q-1⟩ - f ⟨p,q⟩) := FirstUnitProof.lap f p q + clear hA hP hzA hzP hcov umem + fin_cases s + · have he := covered (z.re+1) z.im (Or.inr (Or.inl (by ext <;> simp))) + change U (z.re-0) (z.im-2*k) at unitCenter + change C (z.re+1) z.im ∨ U (z.re+1-0) (z.im-2*k) at he + change ∀ p q, U (p-0) (q-2*k) → + f ⟨p,q⟩ = (if p-0=1 ∧ q-2*k=1 then 1 else 0) + k*p + (-k)*q + B at parent + have hz : z = ⟨0,2*k⟩ := FirstUnitProof.hzAt199 K z center unitCenter he + subst z + have hmark : (⟨0,2*k⟩ : GaussianInt) - r ∈ + FootprintVertices (DiamondTile K.1) := FirstUnitProof.hmarkAt203 K hk cmem + have hdiffN := parent 0 (2*k+1) (by dsimp [U]; omega) + have hdiffZ := parent 0 (2*k) (by dsimp [U]; omega) + norm_num at hdiffN hdiffZ + have hn : f ⟨0,2*k+1⟩ - f ⟨0,2*k⟩ = -k := by + nlinarith only [hdiffN, hdiffZ] + have he := child 1 (2*k) (by dsimp [C]; omega) + have hw := child (-1) (2*k) (by dsimp [C]; omega) + have hs := child 0 (2*k-1) (by dsimp [C]; omega) + have hc := child 0 (2*k) (by dsimp [C]; omega) + norm_num [P4207T1DiamondFormula] at he hw hs hc + rw [sqp] at he + rw [sqm] at hw + rw [sqp] at hs + rw [sq0] at hc + have hl : FourNeighborLaplacian f ⟨0,2*k⟩ = 0 := FirstUnitProof.hlAt223 K f B lap he hdiffN + hdiffZ hn hw hs hc + exact ⟨fun _ => hl, fun h => False.elim (h hmark)⟩ + · have hn := covered z.re (z.im+1) + (Or.inr (Or.inr (Or.inr (Or.inl (by ext <;> simp))))) + change U (z.re-(-k-1)) (z.im-k) at unitCenter + change C z.re (z.im+1) ∨ U (z.re-(-k-1)) (z.im+1-k) at hn + change ∀ p q, U (p-(-k-1)) (q-k) → + f ⟨p,q⟩ = (if p-(-k-1)=1 ∧ q-k=1 then 1 else 0) + 0*p + (-k-1)*q + B at parent + have hz : z = ⟨-k,k⟩ := FirstUnitProof.hzAt234 K z center unitCenter hn + subst z + have hmark : (⟨-k,k⟩ : GaussianInt) - r ∉ + FootprintVertices (DiamondTile K.1) := FirstUnitProof.hmarkAt238 K cmem + have hdiffW := parent (-k-1) k (by dsimp [U]; omega) + have hdiffZ := parent (-k) k (by dsimp [U]; omega) + norm_num at hdiffW hdiffZ + have hw : f ⟨-k-1,k⟩ - f ⟨-k,k⟩ = 0 := by + omega + have he := child (1-k) k (by dsimp [C]; omega) + have hn := child (-k) (k+1) (by dsimp [C]; omega) + have hs := child (-k) (k-1) (by dsimp [C]; omega) + have hc := child (-k) k (by dsimp [C]; omega) + have ha : (Int.natAbs (1-k) : Int) = k-1 := FirstUnitProof.haAt253 K hk f B center unitCenter + have hb : (Int.natAbs (-k) : Int) = k := FirstUnitProof.hbAt256 K hk f B center unitCenter ha + simp only [P4207T1DiamondFormula, ha, hb] at he hn hs hc + rw [show 1-k-k = 1-2*k by ring, show k-1-1 = k-2 by ring, sqp] at he + rw [show -k-(k+1) = -1-2*k by ring, sqm] at hn + rw [show -k-(k-1) = 1-2*k by ring, sqp] at hs + rw [show -k-k = -(2*k) by ring, neg_sq, sq0] at hc + have ht := triDiff k + have hl : FourNeighborLaplacian f ⟨-k,k⟩ = 1 := FirstUnitProof.hlAt265 K f B lap center + unitCenter hn hdiffW hdiffZ ha hb he hs hc ht + exact ⟨fun h => False.elim (hmark h), fun _ => hl⟩ + · have hw := covered (z.re-1) z.im + (Or.inr (Or.inr (Or.inl (by ext <;> simp)))) + change U (z.re-(-1)) (z.im-(-1)) at unitCenter + change C (z.re-1) z.im ∨ U (z.re-1-(-1)) (z.im-(-1)) at hw + change ∀ p q, U (p-(-1)) (q-(-1)) → + f ⟨p,q⟩ = (if p-(-1)=1 ∧ q-(-1)=1 then 1 else 0) + (-1)*p + (-1)*q + B at parent + have hz : z = ⟨0,0⟩ := FirstUnitProof.hzAt275 K z center unitCenter hw + subst z + have hmark : (⟨0,0⟩ : GaussianInt) - r ∈ + FootprintVertices (DiamondTile K.1) := FirstUnitProof.hmarkAt279 K hk cmem + have hdiffS := parent 0 (-1) (by dsimp [U]; omega) + have hdiffZ := parent 0 0 (by dsimp [U]; omega) + norm_num at hdiffS hdiffZ + have hs : f ⟨0,-1⟩ - f ⟨0,0⟩ = 0 := by omega + have he := child 1 0 (by dsimp [C]; omega) + have hw := child (-1) 0 (by dsimp [C]; omega) + have hn := child 0 1 (by dsimp [C]; omega) + have hc := child 0 0 (by dsimp [C]; omega) + norm_num [P4207T1DiamondFormula] at he hw hn hc + have hl : FourNeighborLaplacian f ⟨0,0⟩ = 0 := FirstUnitProof.hlAt294 K f B lap hw hdiffS + hdiffZ he hn hc + exact ⟨fun _ => hl, fun h => False.elim (h hmark)⟩ + · have hs := covered z.re (z.im-1) + (Or.inr (Or.inr (Or.inr (Or.inr (by ext <;> simp))))) + change U (z.re-k) (z.im-(k-1)) at unitCenter + change C z.re (z.im-1) ∨ U (z.re-k) (z.im-1-(k-1)) at hs + change ∀ p q, U (p-k) (q-(k-1)) → + f ⟨p,q⟩ = (if p-k=1 ∧ q-(k-1)=1 then 1 else 0) + (k-1)*p + 0*q + B at parent + have hz : z = ⟨k,k⟩ := FirstUnitProof.hzAt305 K z center unitCenter hs + subst z + have hmark : (⟨k,k⟩ : GaussianInt) - r ∉ + FootprintVertices (DiamondTile K.1) := FirstUnitProof.hmarkAt309 K cmem + have hdiffE := parent (k+1) k (by dsimp [U]; omega) + have hdiffZ := parent k k (by dsimp [U]; omega) + norm_num at hdiffE hdiffZ + have he : f ⟨k+1,k⟩ - f ⟨k,k⟩ = k := by + nlinarith only [hdiffE, hdiffZ] + have hw := child (k-1) k (by dsimp [C]; omega) + have hn := child k (k+1) (by dsimp [C]; omega) + have hs := child k (k-1) (by dsimp [C]; omega) + have hc := child k k (by dsimp [C]; omega) + have ha : (Int.natAbs (k-1) : Int) = k-1 := by + rw [Int.natCast_natAbs, abs_of_nonneg (by omega : 0 ≤ k-1)] + have hb : (Int.natAbs k : Int) = k := by + rw [Int.natCast_natAbs, abs_of_nonneg (by omega : 0 ≤ k)] + norm_num [P4207T1DiamondFormula, ha, hb] at hw hn hs hc + rw [show k-1-1 = k-2 by ring] at hw + have ht := triDiff k + have hl : FourNeighborLaplacian f ⟨k,k⟩ = 1 := FirstUnitProof.hlAt331 K f B lap center + unitCenter hs hdiffE hdiffZ he ha hb hw hn hc ht + exact ⟨fun h => False.elim (hmark h), fun _ => hl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2LiteralNormalization.lean b/LeanPool/ApollonianSuperharmonic/P5352T2LiteralNormalization.lean new file mode 100644 index 0000000000..0dd934ac55 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5352T2LiteralNormalization.lean @@ -0,0 +1,167 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2SourceCertificates +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian + +-- [TABLET NODE: P5352T2LiteralNormalization] + +/-! +# P5352T2LiteralNormalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5352T2LiteralNormalization (K : DiamondParameter) (hk : 1 < K.1) + (j : Fin 4) (T U : ProtoTile) (h l : PartialOdometer) + (p r : ℝ × ℝ) (g : IntegerLatticeFunction) + (hT : TileOdometer ((DiamondRecursiveQuadruple K) 0) T h) + (hU : TileOdometer ((DiamondRecursiveQuadruple K) j) U l) + (hp : PartialOdometerSlope h = some p) + (hr : PartialOdometerSlope l = some r) + (he : GlobalOdometerExtends g h) (he' : GlobalOdometerExtends g l) : + let A := P5352T2Sources K hk 0 + let D := P5352T2Sources K hk j + ∃ (w d a : GaussianInt) (B : Int) (f : IntegerLatticeFunction), + (∀ x, x ∈ h.domain ↔ x - w ∈ FootprintVertices A.1) ∧ + (∀ x, x ∈ l.domain ↔ x - w - d ∈ FootprintVertices D.1) ∧ + (∀ x, x ∈ T.cells ↔ x - w ∈ A.1.cells) ∧ + (∀ x, x ∈ U.cells ↔ x - w - d ∈ D.1.cells) ∧ + (∀ x v, x ∈ FootprintVertices (TileTranslation T v) ↔ + x - w - v ∈ FootprintVertices A.1) ∧ + TileCentroid U - TileCentroid T = + (D.2.2.1.1 - A.2.2.1.1 + d.re, D.2.2.1.2 - A.2.2.1.2 + d.im) ∧ + r.1 - p.1 = D.2.2.2.1 - A.2.2.2.1 + a.re ∧ + r.2 - p.2 = D.2.2.2.2 - A.2.2.2.2 + a.im ∧ + (∀ y, y ∈ FootprintVertices A.1 → f y = A.2.1 y) ∧ + (∀ y, y - d ∈ FootprintVertices D.1 → + f y = D.2.1 (y - d) + a.re * y.re + a.im * y.im + B) ∧ + (∀ x, FourNeighborLaplacian g x = FourNeighborLaplacian f (x - w)) := by +-- BODY + classical + dsimp only + let S := P5352T2Sources K hk + have memtr (V : ProtoTile) (u x : GaussianInt) : + x ∈ (TileTranslation V u).cells ↔ x-u ∈ V.cells := by + constructor + · intro hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx + simpa [GaussianTranslation] using hy + · intro hx + exact Finset.mem_image.mpr ⟨x-u, hx, by simp [GaussianTranslation]⟩ + have memim (E : Set GaussianInt) (u x : GaussianInt) : + x ∈ GaussianTranslation u '' E ↔ x-u ∈ E := by + constructor + · rintro ⟨y, hy, rfl⟩ + simpa [GaussianTranslation] using hy + · intro hx + exact ⟨x-u, hx, by simp [GaussianTranslation]⟩ + have normal (i : Fin 4) (V : ProtoTile) (H : PartialOdometer) + (p : ℝ × ℝ) (ho : TileOdometer ((DiamondRecursiveQuadruple K) i) V H) + (hs : PartialOdometerSlope H = some p) (hg : GlobalOdometerExtends g H) : + ∃ (u a : GaussianInt) (b : Int), + V.cells = (TileTranslation (S i).1 u).cells ∧ + FootprintVertices V = FootprintVertices (TileTranslation (S i).1 u) ∧ + (∀ x, x ∈ H.domain ↔ x-u ∈ FootprintVertices (S i).1) ∧ + (∀ x, x ∈ H.domain → + g x = (S i).2.1 (x-u) + a.re*x.re + a.im*x.im+b) ∧ + TileCentroid V = ((S i).2.2.1.1+u.re, (S i).2.2.1.2+u.im) ∧ + p = ((S i).2.2.2.1+a.re, (S i).2.2.2.2+a.im) := by + obtain ⟨hc, hcent, Hc, hOc, hDc, hVc, hPc⟩ := P5352T2SourceCertificates K hk i + obtain ⟨u, ⟨hcell, hanchor, a, b, hd, hv⟩, _⟩ := + TileOdometerTranslationUniqueness _ V (S i).1 H Hc hc ho hOc + obtain ⟨c, hg⟩ := hg + have hh : H = PartialOdometerAffineTranslate Hc u a b := by + have he : H.domain = (PartialOdometerAffineTranslate Hc u a b).domain := by + ext x + rw [(PartialOdometerAffineTranslateFormulas Hc u a b).2.1] + exact hd x + have ve : H.value = (PartialOdometerAffineTranslate Hc u a b).value := by + funext x + by_cases hx : x ∈ H.domain + · rw [hv x hx, (PartialOdometerAffineTranslateFormulas Hc u a b).2.2.1 + x (by rwa [← he])] + · rw [H.value_outside x hx, + (PartialOdometerAffineTranslate Hc u a b).value_outside x (by rwa [← he])] + cases H + simp only [PartialOdometerAffineTranslate, PartialOdometer.mk.injEq] + exact ⟨he, ve⟩ + have obs := ProtoTileObservableExtensionality V _ hcell hanchor + refine ⟨u, a, b+c, hcell, obs.1, ?_, ?_, ?_, ?_⟩ + · intro x + rw [hd x] + exact Set.ext_iff.mp hDc (x-u) + · intro x hx + rw [hg x hx, hv x hx, hVc (x-u) ((hd x).mp hx)] + ring + · rw [obs.2.2.2.2, (TileTranslationFormulas (S i).1 u).2.2.2.2.1, hcent] + · apply Option.some.inj + rw [← hs, hh, (PartialOdometerAffineTranslateFormulas Hc u a b).2.2.2.2.2, hPc] + rfl + obtain ⟨w, b, c, hc, hf, hd, hv, hC, hP⟩ := normal 0 T h p hT hp he + obtain ⟨v, b', c', hc', hf', hd', hv', hC', hP'⟩ := normal j U l r hU hr he' + let f : IntegerLatticeFunction := fun y => + g (y+w) - b.re*(y+w).re - b.im*(y+w).im-c + refine ⟨w, v-w, b'-b, c'-c+(b'.re-b.re)*w.re+(b'.im-b.im)*w.im, + f, hd, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro x + simpa only [show x-w-(v-w) = x-v by abel] using hd' x + · intro x + rw [hc, memtr] + · intro x + rw [hc', memtr] + simp only [show x-w-(v-w) = x-v by abel] + rfl + · intro x u + rw [(TileTranslationFormulas T u).2.2.2.2.2.1, memim, hf, + (TileTranslationFormulas (S 0).1 w).2.2.2.2.2.1, memim] + rw [show x-u-w = x-w-u by abel] + · rw [hC, hC'] + ext <;> simp <;> ring + · rw [hP, hP'] + simp only [Zsqrtd.re_sub] + push_cast + ring + · rw [hP, hP'] + simp only [Zsqrtd.im_sub] + push_cast + ring + · intro y hy + have hy' : y+w ∈ h.domain := (hd _).mpr (by simpa using hy) + dsimp only [f] + rw [hv _ hy'] + simp only [add_sub_cancel_right] + ring + · intro y hy + have hy' : y+w ∈ l.domain := (hd' _).mpr (by + simpa only [show y+w-v = y-(v-w) by abel] using hy) + dsimp only [f] + rw [hv' _ hy', show y+w-v = y-(v-w) by abel] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] + ring + · intro x + unfold FourNeighborLaplacian + dsimp only [f] + simp only [sub_add_cancel] + rw [show x-w+1+w = x+1 by abel, show x-w-1+w = x-1 by abel, + show x-w+⟨0,1⟩+w = x+⟨0,1⟩ by abel, + show x-w-⟨0,1⟩+w = x-⟨0,1⟩ by abel] + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_one, Zsqrtd.im_one] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2PlacementData.lean b/LeanPool/ApollonianSuperharmonic/P5352T2PlacementData.lean new file mode 100644 index 0000000000..95a47293f9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5352T2PlacementData.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2Sources + +-- [TABLET NODE: P5352T2PlacementData] + +/-! +# P5352T2PlacementData + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $n=k$, let the right displacement and affine coefficient pairs +$(\rho_j,\beta_j)$ be +$$ + ((-k,k+1),(1,-k)),\quad ((-k,-k-1),(-k,0)),\quad ((2k,0),(k-1,k)) +$$ +for parent indices $j=1,2,3$. For each $j$, the four triples +$(d_{js},a_{js},r_{js})$, ordered by $s=0,1,2,3$, are +$$ +\begin{array}{c|c|c|c|c} +j&s&d_{js}&a_{js}&r_{js}\\\hline +1&0&(0,2k)&(k,-k)&(-k,k+1)\\ +1&1&(-k-1,k)&(0,-k-1)&(-k,k+1)\\ +1&2&(-1,-1)&(-1,-1)&(k,-k-1)\\ +1&3&(k,k-1)&(k-1,0)&(k,-k-1)\\ +2&0&(-k-1,k-1)&(0,-k)&(-k,-k-1)\\ +2&1&(0,-1)&(0,0)&(-k,-k-1)\\ +2&2&(k,k)&(k,0)&(k,k+1)\\ +2&3&(-1,2k)&(k,-k)&(k,k+1)\\ +3&0&(k,1-k)&(0,k-1)&(2k,0)\\ +3&1&(k,k+1)&(k,0)&(2k,0)\\ +3&2&(-k,k+1)&(1,-k)&(-2k,0)\\ +3&3&(-k,1-k)&(1-k,-1)&(-2k,0). +\end{array} +$$ +The Lean index $i$ is $j-1$; the first component of the data is +$(\rho_j,\beta_j)$ and its second component is the four-entry triple table. +-/ +def P5352T2PlacementData (k : Nat) (i : Fin 3) : + (GaussianInt × GaussianInt) × (Fin 4 → GaussianInt × GaussianInt × GaussianInt) := +-- BODY + let n : Int := k + ![((⟨-n, n+1⟩, ⟨1, -n⟩), + ![(⟨0, 2*n⟩, ⟨n, -n⟩, ⟨-n, n+1⟩), + (⟨-n-1, n⟩, ⟨0, -n-1⟩, ⟨-n, n+1⟩), + (⟨-1, -1⟩, ⟨-1, -1⟩, ⟨n, -n-1⟩), + (⟨n, n-1⟩, ⟨n-1, 0⟩, ⟨n, -n-1⟩)]), + ((⟨-n, -n-1⟩, ⟨-n, 0⟩), + ![(⟨-n-1, n-1⟩, ⟨0, -n⟩, ⟨-n, -n-1⟩), + (⟨0, -1⟩, ⟨0, 0⟩, ⟨-n, -n-1⟩), + (⟨n, n⟩, ⟨n, 0⟩, ⟨n, n+1⟩), + (⟨-1, 2*n⟩, ⟨n, -n⟩, ⟨n, n+1⟩)]), + ((⟨2*n, 0⟩, ⟨n-1, n⟩), + ![(⟨n, 1-n⟩, ⟨0, n-1⟩, ⟨2*n, 0⟩), + (⟨n, n+1⟩, ⟨n, 0⟩, ⟨2*n, 0⟩), + (⟨-n, n+1⟩, ⟨1, -n⟩, ⟨-2*n, 0⟩), + (⟨-n, 1-n⟩, ⟨1-n, -1⟩, ⟨-2*n, 0⟩)])] i + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean new file mode 100644 index 0000000000..6655652538 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean @@ -0,0 +1,983 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData +public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic +public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable + +-- [TABLET NODE: P5352T2Predecessor0] + +/-! +# P5352T2Predecessor0 + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FirstPredecessorCases + +private theorem lap_identity : + (by + classical + exact + ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), FourNeighborLaplacian g x = g (x + + (1 : GaussianInt)) - g x + (g (x - (1 : GaussianInt)) - g x) + (g (x + ⟨(0 : ℤ), (1 : + ℤ)⟩) - g x) + (g (x - ⟨(0 : ℤ), (1 : ℤ)⟩) - g x) ) := by + classical + intro g x + unfold FourNeighborLaplacian + ring + +private theorem endAlgebra : + (by + classical + exact + ∀ (b : ℤ), -((b - (1 : ℤ)) ^ (2 : ℕ) - (b - (1 : ℤ))) + (b - (1 : ℤ)) * (b - (1 : ℤ)) - + (-(b - (1 : ℤ)) ^ (2 : ℕ) + (b - (1 : ℤ)) * (b - (1 : ℤ))) = b - (1 : ℤ) ) := by + classical + intro b + ring + +private theorem endAlgebraB : + (by + classical + exact + ∀ (b : ℤ), ∀ (c : ℤ), -((b - (1 : ℤ)) ^ (2 : ℕ) - (b - (1 : ℤ))) + (b - (1 : ℤ)) * (b - + (1 : ℤ)) + c - ((0 / 2 : ℤ) - (b - (1 : ℤ)) ^ (2 : ℕ) + (b - (1 : ℤ)) * (b - (1 : ℤ)) + + c) = b - (1 : ℤ) ) := by + classical + intro b c + norm_num + +private theorem childMem : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℤ) ≤ b → b ≤ (2 : ℤ) * k → -k ≤ a → a ≤ k → -b - (1 : ℤ) ≤ a → + a ≤ b + (1 : ℤ) → -((2 : ℤ) * k - b + (1 : ℤ)) ≤ a → a ≤ (2 : ℤ) * k - b + (1 : ℤ) → + ⟨a, b⟩ ∈ FootprintVertices (DiamondTile K.1) ) := by + classical + intro K k a b hb0 hb1 ha0 ha1 hs0 hs1 ht0 ht1 + exact (P5352T2DomainRows K ⟨a,b⟩).1.mpr + ⟨hb0, hb1, ha0, ha1, hs0, hs1, ht0, ht1⟩ + +private theorem boundaryCase : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let d : GaussianInt := ⟨k, 1-k⟩ + let r : GaussianInt := ⟨2*k, 0⟩ + let child := P5352T2Sources K hk 0 + let pred := P5352T2Sources K hk 3 + (∀ y ∈ FootprintVertices child.1, f y = child.2.1 y) → (((2 : ℤ) ≤ k) → (∀ (p : ℤ), ∀ (q + : ℤ), (⟨p, q⟩ ∈ FootprintVertices child.1) → ((⟨p, q⟩ - d ∈ FootprintVertices pred.1) + → ((∀ (y : GaussianInt), y = ⟨p, q⟩ ∨ y = ⟨p, q⟩ + (1 : GaussianInt) ∨ y = ⟨p, q⟩ - + (1 : GaussianInt) ∨ y = ⟨p, q⟩ + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨p, q⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ + → y ∈ FootprintVertices child.1 ∨ y - d ∈ FootprintVertices pred.1) → (((1 : ℤ) ≤ q + + k ∧ q ≤ (2 : ℤ) * (k - (1 : ℤ)) + ((1 : ℤ) - k) ∧ k ≤ p + (k - (1 : ℤ)) ∧ p ≤ k - (1 + : ℤ) + k ∧ (1 : ℤ) ≤ p - k + (1 : ℤ) + q + k ∧ p ≤ q - ((1 : ℤ) - k) + (1 : ℤ) + k ∧ + q ≤ (1 : ℤ) + (p - k) + (2 : ℤ) * (k - (1 : ℤ)) + ((1 : ℤ) - k) ∧ p ≤ (2 : ℤ) * (k - + (1 : ℤ)) - (q - ((1 : ℤ) - k)) + (1 : ℤ) + k) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : + ℤ)) → (((0 : ℤ) ≤ q ∧ q ≤ (2 : ℤ) * k ∧ -k ≤ p ∧ p ≤ k ∧ -q - (1 : ℤ) ≤ p ∧ p ≤ q + + (1 : ℤ) ∧ -((2 : ℤ) * k - q + (1 : ℤ)) ≤ p ∧ p ≤ (2 : ℤ) * k - q + (1 : ℤ)) → (((1 : + ℤ) ≤ p) → ((q = p - (1 : ℤ) ∨ q = p) → ((∀ (a : Int), ∀ (b : Int), (0 ≤ b) → ((b ≤ + 2*k) → ((-k ≤ a) → ((a ≤ k) → ((-b-1 ≤ a) → ((a ≤ b+1) → ((-(2*k-b+1) ≤ a) → ((a ≤ + 2*k-b+1) → ((⟨a,b⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)))))))))) → (q + = p → (⟨p, p⟩ - r ∈ FootprintVertices child.1 → FourNeighborLaplacian f ⟨p, p⟩ = (0 : + ℤ)) ∧ (⟨p, p⟩ - r ∉ FootprintVertices child.1 → FourNeighborLaplacian f ⟨p, p⟩ = (1 : + ℤ))))))))))))) ) := by + classical + intro K hk f k d r child pred hchild hkI p q hz hpz hcover hdpred hcast hdchild hp1 hq childMem + hqp + subst q + have hplt : p < k := by omega + have hpadd : p+1 ≤ k := Int.lt_iff_add_one_le.mp hplt + have hEb : 0 ≤ p ∧ p ≤ 2*k ∧ -k ≤ p+1 ∧ p+1 ≤ k ∧ + -p-1 ≤ p+1 ∧ p+1 ≤ p+1 ∧ -(2*k-p+1) ≤ p+1 ∧ p+1 ≤ 2*k-p+1 := by + omega + have hWb : 0 ≤ p ∧ p ≤ 2*k ∧ -k ≤ p-1 ∧ p-1 ≤ k ∧ + -p-1 ≤ p-1 ∧ p-1 ≤ p+1 ∧ -(2*k-p+1) ≤ p-1 ∧ p-1 ≤ 2*k-p+1 := by + omega + have hNb : 0 ≤ p+1 ∧ p+1 ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -(p+1)-1 ≤ p ∧ p ≤ p+1+1 ∧ -(2*k-(p+1)+1) ≤ p ∧ p ≤ 2*k-(p+1)+1 := by + omega + have hSb : 0 ≤ p-1 ∧ p-1 ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -(p-1)-1 ≤ p ∧ p ≤ p-1+1 ∧ -(2*k-(p-1)+1) ≤ p ∧ p ≤ 2*k-(p-1)+1 := by + omega + have hE : (⟨p+1,p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := + childMem (p+1) p hEb.1 hEb.2.1 hEb.2.2.1 hEb.2.2.2.1 + hEb.2.2.2.2.1 hEb.2.2.2.2.2.1 hEb.2.2.2.2.2.2.1 hEb.2.2.2.2.2.2.2 + have hW : (⟨p-1,p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := + childMem (p-1) p hWb.1 hWb.2.1 hWb.2.2.1 hWb.2.2.2.1 + hWb.2.2.2.2.1 hWb.2.2.2.2.2.1 hWb.2.2.2.2.2.2.1 hWb.2.2.2.2.2.2.2 + have hN : (⟨p,p+1⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := + childMem p (p+1) hNb.1 hNb.2.1 hNb.2.2.1 hNb.2.2.2.1 + hNb.2.2.2.2.1 hNb.2.2.2.2.2.1 hNb.2.2.2.2.2.2.1 hNb.2.2.2.2.2.2.2 + have hS : (⟨p,p-1⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := + childMem p (p-1) hSb.1 hSb.2.1 hSb.2.2.1 hSb.2.2.2.1 + hSb.2.2.2.2.1 hSb.2.2.2.2.2.1 hSb.2.2.2.2.2.2.1 hSb.2.2.2.2.2.2.2 + have fval (w : GaussianInt) (hw : w ∈ FootprintVertices (DiamondTile K.1)) : + f w = DiamondOdometer K w := by + simpa [child, P5352T2Sources] using hchild w (by + simpa [child, P5352T2Sources] using hw) + have hcenter : f ⟨p,p⟩ = DiamondOdometer K ⟨p,p⟩ := fval _ hz + have heast : f (⟨p,p⟩+1) = DiamondOdometer K (⟨p,p⟩+1) := by + have he : (⟨p,p⟩ : GaussianInt)+1 = ⟨p+1,p⟩ := by ext <;> simp + rw [he] + exact fval _ hE + have hwest : f (⟨p,p⟩-1) = DiamondOdometer K (⟨p,p⟩-1) := by + have he : (⟨p,p⟩ : GaussianInt)-1 = ⟨p-1,p⟩ := by ext <;> simp + rw [he] + exact fval _ hW + have hnorth : f (⟨p,p⟩+⟨0,1⟩) = DiamondOdometer K (⟨p,p⟩+⟨0,1⟩) := by + have he : (⟨p,p⟩ : GaussianInt)+⟨0,1⟩ = ⟨p,p+1⟩ := by ext <;> simp + rw [he] + exact fval _ hN + have hsouth : f (⟨p,p⟩-⟨0,1⟩) = DiamondOdometer K (⟨p,p⟩-⟨0,1⟩) := by + have he : (⟨p,p⟩ : GaussianInt)-⟨0,1⟩ = ⟨p,p-1⟩ := by ext <;> simp + rw [he] + exact fval _ hS + have hpn : (Int.natAbs p : Int) = p := by + rw [Int.natCast_natAbs, abs_of_nonneg (show 0 ≤ p by omega)] + have hqn : (Int.natAbs (p-k) : Int) = k-p := by + rw [Int.natCast_natAbs, abs_of_nonpos (show p-k ≤ 0 by omega)] + omega + have hKsub : ((K.1-1 : Nat) : Int) = k-1 := by + rw [Nat.cast_sub (by omega : 1 ≤ K.1)] + dsimp [k] + have hnot : (⟨p,p⟩ : GaussianInt) ∉ DiamondVertexDomains K true := by + change ¬ (Int.natAbs p + Int.natAbs (p-(K.1:Int)) ≤ K.1-1) + intro hh + have hhI : ((Int.natAbs p + Int.natAbs (p-(K.1:Int)) : Nat) : Int) ≤ + ((K.1-1 : Nat) : Int) := by exact_mod_cast hh + rw [Int.natCast_add, hpn, hqn, hKsub] at hhI + omega + have hdom : (⟨p,p⟩ : GaussianInt) ∈ DiamondVertexDomains K false := by + obtain ⟨_, _, _, hfp, _, _⟩ := DiamondTileOdometerRestriction K + exact hfp ▸ (by simpa [child, P5352T2Sources] using hz) + have htable := (DiamondLaplacianTable K).2.1 ⟨p,p⟩ hdom hnot + have hcomp : (⟨p,p⟩ : GaussianInt)-r ∉ FootprintVertices child.1 := by + intro hc + have hb := (P5352T2DomainRows K (⟨p,p⟩-r)).1.mp (by + simpa [child, P5352T2Sources] using hc) + simp [r] at hb + omega + refine ⟨fun hc => (hcomp hc).elim, ?_⟩ + intro _ + rw [FourNeighborLaplacian, heast, hwest, hnorth, hsouth, hcenter] + exact htable + +private theorem childValue : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), + let child := P5352T2Sources K hk 0 + (∀ y ∈ FootprintVertices child.1, f y = child.2.1 y) → ( + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + ∀ w ∈ FootprintVertices (DiamondTile K.1), f w = Q w.re w.im) ) := by + classical + intro K hk f child hchild Q w hw + have hw' : w ∈ FootprintVertices child.1 := by + simpa [child, P5352T2Sources] using hw + rw [hchild w hw'] + simpa [Q, child, P5352T2Sources] using (P5352T2DomainRows K w).2 hw + +private theorem predFoot : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (ℤ) → ((ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (∀ (w : GaussianInt), (0 : + ℤ) ≤ w.im ∧ w.im ≤ (2 : ℤ) * (k - (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ + w.re ∧ w.re ≤ k - (1 : ℤ) ∧ -w.im - (1 : ℤ) ≤ w.re ∧ w.re ≤ w.im + (1 : ℤ) ∧ -((2 : + ℤ) * (k - (1 : ℤ)) - w.im + (1 : ℤ)) ≤ w.re ∧ w.re ≤ (2 : ℤ) * (k - (1 : ℤ)) - w.im + + (1 : ℤ) → w ∈ FootprintVertices (DiamondTile (K.1 - (1 : ℕ)))))))) := by + classical + intro K hk k p q hcast w hw + let Kp : DiamondParameter := ⟨K.1-1, by omega⟩ + apply (P5352T2DomainRows Kp w).1.mpr + simpa [Kp, hcast] using hw + +private theorem predValue : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1 + let pred := P5352T2Sources K hk 3 + ∀ (p : ℤ), ∀ (q : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + ∀ w ∈ FootprintVertices (DiamondTile (K.1 - (1 : ℕ))), pred.2.1 w = Q w.re w.im ) := by + classical + intro K hk k pred p q hcast Q w hw + let Kp : DiamondParameter := ⟨K.1-1, by omega⟩ + simpa [Q, pred, Kp, P5352T2Sources] using (P5352T2DomainRows Kp w).2 hw + +private theorem predTranslatedValue : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), + let k : Int := K.1 + let d : GaussianInt := ⟨k, 1-k⟩ + let pred := P5352T2Sources K hk 3 + (∀ (y : GaussianInt), y - d ∈ FootprintVertices pred.1 → f y = pred.2.1 (y - d) + (⟨(0 : + ℤ), k - (1 : ℤ)⟩ : GaussianInt).re * y.re + (⟨(0 : ℤ), k - (1 : ℤ)⟩ : GaussianInt).im + * y.im + B) → ( + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + (∀ (w : GaussianInt), (w ∈ FootprintVertices (DiamondTile (K.1-1))) → (pred.2.1 w = Q + w.re w.im)) → (∀ (y : GaussianInt), y - d ∈ FootprintVertices (DiamondTile (K.1 - (1 + : ℕ))) → f y = Q (y - d).re (y - d).im + (k - (1 : ℤ)) * y.im + B)) ) := by + classical + intro K hk f B k d pred hpred Q predValue y hy + have h := hpred y (by simpa [pred, P5352T2Sources] using hy) + have hv := predValue (y-d) hy + have h' : f y = pred.2.1 (y-d) + (k-1)*y.im+B := by simpa using h + rw [hv] at h' + simpa [d] using h' + +private theorem hComp : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1 + let d : GaussianInt := ⟨k, 1-k⟩ + let r : GaussianInt := ⟨2*k, 0⟩ + let child := P5352T2Sources K hk 0 + let pred := P5352T2Sources K hk 3 + ∀ (p : ℤ), ∀ (q : ℤ), (⟨p, q⟩ ∈ FootprintVertices child.1) → ((⟨p, q⟩ - d ∈ + FootprintVertices pred.1) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (((1 : ℤ) ≤ p) + → ((p ≤ k) → ((∀ (a : Int), ∀ (b : Int), (0 ≤ b) → ((b ≤ 2*k) → ((-k ≤ a) → ((a ≤ k) + → ((-b-1 ≤ a) → ((a ≤ b+1) → ((-(2*k-b+1) ≤ a) → ((a ≤ 2*k-b+1) → ((⟨a,b⟩ : + GaussianInt) ∈ FootprintVertices (DiamondTile K.1)))))))))) → ((q = p - (1 : ℤ)) → ( + let zA : GaussianInt := ⟨p,p-1⟩ + (zA ∈ FootprintVertices (DiamondTile K.1)) → (zA-r ∈ FootprintVertices (DiamondTile K.1) + ↔ p=k)))))))) ) := by + classical + intro K hk k d r child pred p q hz hpz hcast hp1 hpk childMem hq zA hzA + constructor + · intro hh + have hb := (P5352T2DomainRows K (zA-r)).1.mp hh + have hl := hb.2.2.1 + have hre : (zA-r).re = p-2*k := by simp [zA,r] + rw [hre] at hl + omega + · intro hp + subst p + have he : zA-r = (⟨-k,k-1⟩ : GaussianInt) := by + ext <;> simp [zA,r]; omega + rw [he] + exact childMem (-k) (k-1) (by omega) (by omega) (by omega) (by omega) + (by omega) (by omega) (by omega) (by omega) + +private theorem hPe : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + ∀ (p : ℤ), ∀ (q : ℤ), ((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (((1 : ℤ) ≤ p) → ((p ≤ k) + → ((∀ (w : GaussianInt), (0 ≤ w.im ∧ w.im ≤ 2*(k-1) ∧ -(k-1) ≤ w.re ∧ w.re ≤ k-1 ∧ + -w.im-1 ≤ w.re ∧ w.re ≤ w.im+1 ∧ -(2*(k-1)-w.im+1) ≤ w.re ∧ w.re ≤ 2*(k-1)-w.im+1) → + (w ∈ FootprintVertices (DiamondTile (K.1-1)))) → ((q = p - (1 : ℤ)) → + (((⟨p+1-k,p+k-2⟩ : GaussianInt)) ∈ FootprintVertices (DiamondTile (K.1-1)))))))) ) := by + classical + intro K hk k p q hcast hp1 hpk predFoot hq + apply predFoot + constructor <;> simp [] <;> omega + +private theorem hPs : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + ∀ (p : ℤ), ∀ (q : ℤ), ((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (((1 : ℤ) ≤ p) → ((p ≤ k) + → ((∀ (w : GaussianInt), (0 ≤ w.im ∧ w.im ≤ 2*(k-1) ∧ -(k-1) ≤ w.re ∧ w.re ≤ k-1 ∧ + -w.im-1 ≤ w.re ∧ w.re ≤ w.im+1 ∧ -(2*(k-1)-w.im+1) ≤ w.re ∧ w.re ≤ 2*(k-1)-w.im+1) → + (w ∈ FootprintVertices (DiamondTile (K.1-1)))) → ((q = p - (1 : ℤ)) → (((⟨p-k,p+k-3⟩ + : GaussianInt)) ∈ FootprintVertices (DiamondTile (K.1-1)))))))) ) := by + classical + intro K hk k p q hcast hp1 hpk predFoot hq + apply predFoot + constructor <;> simp [] <;> omega + +private theorem hCW : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (p : ℤ), + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + (∀ (w : GaussianInt), (w ∈ FootprintVertices (DiamondTile K.1)) → (f w = Q w.re w.im)) → ( + let zA : GaussianInt := ⟨p,p-1⟩ + ((⟨p-1,p-1⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → ( + let valW : Int := Q (p-1) (p-1) + f (zA-1) = valW)) ) := by + classical + intro K f p Q childValue zA hW valW + have hw : zA-1 = (⟨p-1,p-1⟩ : GaussianInt) := by ext <;> simp [zA] + rw [hw] + exact childValue _ hW + +private theorem hCN : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (p : ℤ), + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + (∀ (w : GaussianInt), (w ∈ FootprintVertices (DiamondTile K.1)) → (f w = Q w.re w.im)) → ( + let zA : GaussianInt := ⟨p,p-1⟩ + ((⟨p,p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → ( + let valN : Int := Q p p + f (zA+⟨0,1⟩) = valN)) ) := by + classical + intro K f p Q childValue zA hN valN + have hw : zA+⟨0,1⟩ = (⟨p,p⟩ : GaussianInt) := by ext <;> simp [zA] + rw [hw] + exact childValue _ hN + +private theorem hPcenter : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let d : GaussianInt := ⟨k, 1-k⟩ + ∀ (p : ℤ), + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + (∀ (y : GaussianInt), (y-d ∈ FootprintVertices (DiamondTile (K.1-1))) → (f y = Q (y-d).re + (y-d).im + (k-1)*y.im+B)) → ( + let zA : GaussianInt := ⟨p,p-1⟩ + ((zA-d) ∈ FootprintVertices (DiamondTile (K.1-1))) → ( + let valC : Int := Q (p-k) (p-1-(1-k)) + f zA = valC + (k-1)*(p-1)+B)) ) := by + classical + intro K f B k d p Q predTranslatedValue zA hP0 valC + have hv := predTranslatedValue zA hP0 + simpa [valC, zA, d] using hv + +private theorem hPeast : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let d : GaussianInt := ⟨k, 1-k⟩ + ∀ (p : ℤ), + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + (∀ (y : GaussianInt), (y-d ∈ FootprintVertices (DiamondTile (K.1-1))) → (f y = Q (y-d).re + (y-d).im + (k-1)*y.im+B)) → ( + let zA : GaussianInt := ⟨p,p-1⟩ + ((zA+1)-d = (⟨p+1-k,p+k-2⟩ : GaussianInt)) → ((((⟨p+1-k,p+k-2⟩ : GaussianInt)) ∈ + FootprintVertices (DiamondTile (K.1-1))) → (f (zA+1) = Q (p+1-k) (p-1-(1-k)) + + (k-1)*(p-1)+B))) ) := by + classical + intro K f B k d p Q predTranslatedValue zA he hPe + have hv := predTranslatedValue (zA+1) (by rw [he]; exact hPe) + simpa [zA, d] using hv + +private theorem hPsouth : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let d : GaussianInt := ⟨k, 1-k⟩ + ∀ (p : ℤ), + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + (∀ (y : GaussianInt), (y-d ∈ FootprintVertices (DiamondTile (K.1-1))) → (f y = Q (y-d).re + (y-d).im + (k-1)*y.im+B)) → ( + let zA : GaussianInt := ⟨p,p-1⟩ + let valS : Int := Q (p-k) (p-1-1-(1-k)) + ((zA-⟨0,1⟩)-d = (⟨p-k,p+k-3⟩ : GaussianInt)) → ((((⟨p-k,p+k-3⟩ : GaussianInt)) ∈ + FootprintVertices (DiamondTile (K.1-1))) → (f (zA-⟨0,1⟩) = valS + (k-1)*(p-2)+B))) ) + := by + classical + intro K f B k d p Q predTranslatedValue zA valS hs hPs + have hv := predTranslatedValue (zA-⟨0,1⟩) (by rw [hs]; exact hPs) + calc + f (zA-⟨0,1⟩) = valS + (k-1)*(p-1-1)+B := by + simpa [valS, zA, d] using hv + _ = _ := by congr 1; ring + +private theorem qCW : + (by + classical + exact + (DiamondParameter) → ((IntegerLatticeFunction) → ((Int) → (∀ (p : ℤ), ∀ (q : ℤ), ((1 : ℤ) + ≤ p) → ( + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + (q = p - (1 : ℤ)) → ( + let valW : Int := Q (p-1) (p-1) + valW = (p-1)*(p-2)/2))))) ) := by + classical + intro K f B p q hp1 Q hq valW + simp [valW, Q, abs_of_nonneg (show 0 ≤ p-1 by omega)] + ring + +private theorem floorEven : + (by + classical + exact + ∀ (m : ℤ), ((-2 : ℤ) * m) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) ) := by + classical + intro m + have h := P4207T1FloorArithmetic.1 0 (-m) + simpa using h + +private theorem floorOdd : + (by + classical + exact + (DiamondParameter) → ((IntegerLatticeFunction) → ((Int) → ((ℤ) → ((ℤ) → (∀ (m : ℤ), ((1 : + ℤ) - (2 : ℤ) * m) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) - m))))) ) := by + classical + intro K f B p q m + have h := P4207T1FloorArithmetic.1 1 (-m) + have h' : 1 + 2*(-m) = 1-2*m := by ring + rw [h'] at h + norm_num at h ⊢ + omega + +private theorem qP0 : + (by + classical + exact + ∀ (K : DiamondParameter), (IntegerLatticeFunction) → ((Int) → ( + let k : Int := K.1 + ∀ (p : ℤ), ∀ (q : ℤ), (p ≤ k) → ( + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + (q = p - (1 : ℤ)) → ( + let valC : Int := Q (p-k) (p-1-(1-k)) + (∀ (m : Int), (-2*m)^2/4 = m^2) → (valC = (k-p)*(k-p-1)/2-(k-1)^2))))) ) := by + classical + intro K f B k p q hpk Q hq valC floorEven + simp only [valC, Q, Int.natCast_natAbs] + rw [abs_of_nonpos (show p-k ≤ 0 by omega)] + rw [show (p-k)-(p-1-(1-k)) = -2*(k-1) by ring, floorEven] + congr 1; ring + +private theorem qPeLt : + (by + classical + exact + ∀ (K : DiamondParameter), (IntegerLatticeFunction) → ((Int) → ( + let k : Int := K.1 + ∀ (p : ℤ), ∀ (q : ℤ), + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + (q = p - (1 : ℤ)) → ((∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (p < k → Q (p + (1 : ℤ) - k) (p + - (1 : ℤ) - ((1 : ℤ) - k)) = (k - p - (1 : ℤ)) * (k - p - (2 : ℤ)) / (2 : ℤ) - ((k - + (1 : ℤ)) ^ (2 : ℕ) - (k - (1 : ℤ))))))) ) := by + classical + intro K f B k p q Q hq floorOdd hpk' + simp only [Q, Int.natCast_natAbs] + rw [abs_of_nonpos (show p+1-k ≤ 0 by omega)] + rw [show (p+1-k)-(p-1-(1-k)) = 1-2*(k-1) by ring, floorOdd] + congr 1; ring + +private theorem qPeEq : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let d : GaussianInt := ⟨k, 1-k⟩ + let r : GaussianInt := ⟨2*k, 0⟩ + ∀ (p : ℤ), ∀ (q : ℤ), ((1 : ℤ) ≤ p) → ((p ≤ k) → ( + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + (q = p - (1 : ℤ)) → ( + let zA : GaussianInt := ⟨p,p-1⟩ + (zA-r ∈ FootprintVertices (DiamondTile K.1) ↔ p=k) → ((zA = (⟨p,p-1⟩ : GaussianInt)) → ( + let valS : Int := Q (p-k) (p-1-1-(1-k)) + let valC : Int := Q (p-k) (p-1-(1-k)) + ((zA+1)-d = (⟨p+1-k,p+k-2⟩ : GaussianInt)) → (((zA-⟨0,1⟩)-d = (⟨p-k,p+k-3⟩ : + GaussianInt)) → ( + let val0 : Int := Q p (p-1) + let valW : Int := Q (p-1) (p-1) + let valN : Int := Q p p + (f zA = val0) → ((f (zA-1) = valW) → ((f (zA+⟨0,1⟩) = valN) → ((f zA = valC + + (k-1)*(p-1)+B) → ((f (zA+1) = Q (p+1-k) (p-1-(1-k)) + (k-1)*(p-1)+B) → ((f (zA-⟨0,1⟩) + = valS + (k-1)*(p-2)+B) → ((val0 = p*(p-1)/2) → ((valW = (p-1)*(p-2)/2) → ((valN = + p*(p-1)/2) → ((Q p (p-2) = p*(p-1)/2-1) → ((∀ (m : Int), (1-2*m)^2/4 = m^2-m) → + ((valC = (k-p)*(k-p-1)/2-(k-1)^2) → (((p < k) → (Q (p+1-k) (p-1-(1-k)) = + (k-p-1)*(k-p-2)/2-((k-1)^2-(k-1)))) → (p = k → Q (p + (1 : ℤ) - k) (p - (1 : ℤ) - ((1 + : ℤ) - k)) = -((k - (1 : ℤ)) ^ (2 : ℕ) - (k - (1 : ℤ))))))))))))))))))))))) ) := by + classical + intro K f B k d r p q hp1 hpk Q hq zA hComp hzEq valS valC he hs val0 valW valN hC0 hCW hCN + hPcenter hPeast hPsouth qC0 qCW qCN qCS floorOdd qP0 qPeLt hpk' + subst p + simp only [Q, Int.natCast_natAbs] + rw [show k+1-k = 1 by omega, abs_of_nonneg (show 0 ≤ (1:Int) by omega)] + have hsquare : (1-(k-1-(1-k)))^2/4 = (k-1)^2-(k-1) := by + rw [show 1-(k-1-(1-k)) = 1-2*(k-1) by ring, floorOdd] + rw [hsquare] + norm_num + +private theorem qPs : + (by + classical + exact + ∀ (K : DiamondParameter), (IntegerLatticeFunction) → ((Int) → ( + let k : Int := K.1 + ∀ (p : ℤ), ∀ (q : ℤ), (p ≤ k) → ( + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + (q = p - (1 : ℤ)) → ( + let valS : Int := Q (p-k) (p-1-1-(1-k)) + (∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (valS = (k-p)*(k-p-1)/2-((k-1)^2-(k-1))))))) ) := by + classical + intro K f B k p q hpk Q hq valS floorOdd + simp only [valS, Q, Int.natCast_natAbs] + rw [abs_of_nonpos (show p-k ≤ 0 by omega)] + rw [show (p-k)-(p-1-1-(1-k)) = 1-2*(k-1) by ring, floorOdd] + rw [show -(p-k) = k-p by omega] + +private theorem tri : + (by + classical + exact + (DiamondParameter) → ((IntegerLatticeFunction) → ((Int) → ((ℤ) → ((ℤ) → (∀ (a : ℤ), (2 : + ℤ) * (a * (a - (1 : ℤ)) / (2 : ℤ)) = a * (a - (1 : ℤ))))))) ) := by + classical + intro K f B p q a + rcases Int.emod_two_eq_zero_or_one a with h | h + · have ha : a = 2*(a/2) := by omega + rw [ha] + have he : 2*(a/2)*(2*(a/2)-1) = 2*((a/2)*(2*(a/2)-1)) := by ring + rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + · have ha : a = 2*(a/2)+1 := by omega + rw [ha] + have he : (2*(a/2)+1)*(2*(a/2)+1-1) = + 2*((2*(a/2)+1)*(a/2)) := by ring + rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + +private theorem tdiff : + (by + classical + exact + (DiamondParameter) → ((IntegerLatticeFunction) → ((Int) → ((ℤ) → ((ℤ) → ((∀ (a : Int), + 2*(a*(a-1)/2) = a*(a-1)) → (∀ (a : ℤ), a * (a - (1 : ℤ)) / (2 : ℤ) - (a - (1 : ℤ)) * + (a - (2 : ℤ)) / (2 : ℤ) = a - (1 : ℤ))))))) ) := by + classical + intro K f B p q tri a + have h := tri a + have h' : 2*((a-1)*(a-2)/2) = (a-1)*(a-2) := by + simpa [show a-1-1 = a-2 by ring] using tri (a-1) + have he : 2*(a*(a-1)/2-(a-1)*(a-2)/2) = 2*(a-1) := by + rw [mul_sub, h, h'] + ring + omega + +private theorem tdiffRev : + (by + classical + exact + (DiamondParameter) → ((IntegerLatticeFunction) → ((Int) → ((ℤ) → ((ℤ) → ((∀ (a : Int), + a*(a-1)/2-(a-1)*(a-2)/2 = a-1) → (∀ (a : ℤ), (a - (1 : ℤ)) * (a - (2 : ℤ)) / (2 : ℤ) + - a * (a - (1 : ℤ)) / (2 : ℤ) = (1 : ℤ) - a)))))) ) := by + classical + intro K f B p q tdiff a + have ht := tdiff a + omega + +private theorem hEastDiff : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), (∀ (a : Int), ∀ (b + : Int), 1-(b-a)+(b-1)=a) → ((∀ (b : Int), ∀ (c : Int), + -((b-1)^2-(b-1))+(b-1)*(b-1)+c- (0/2-(b-1)^2+(b-1)*(b-1)+c)=b-1) → ( + let k : Int := K.1 + ∀ (p : ℤ), ∀ (q : ℤ), (p ≤ k) → ( + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + (q = p - (1 : ℤ)) → ( + let zA : GaussianInt := ⟨p,p-1⟩ + let valS : Int := Q (p-k) (p-1-1-(1-k)) + let valC : Int := Q (p-k) (p-1-(1-k)) + (f zA = valC + (k-1)*(p-1)+B) → ((f (zA+1) = Q (p+1-k) (p-1-(1-k)) + (k-1)*(p-1)+B) → + ((valC = (k-p)*(k-p-1)/2-(k-1)^2) → (((p < k) → (Q (p+1-k) (p-1-(1-k)) = + (k-p-1)*(k-p-2)/2-((k-1)^2-(k-1)))) → (((p = k) → (Q (p+1-k) (p-1-(1-k)) = + -((k-1)^2-(k-1)))) → ((valS = (k-p)*(k-p-1)/2-((k-1)^2-(k-1))) → ((∀ (a : Int), + (a-1)*(a-2)/2-a*(a-1)/2 = 1-a) → (f (zA+1)-f zA = if p=k then k-1 else p))))))))))) ) + := by + classical + intro K f B eastAlgebra endAlgebraB k p q hpk Q hq zA valS valC hPcenter hPeast qP0 qPeLt qPeEq + qPs tdiffRev + by_cases hp : p=k + · rw [hPeast, hPcenter, qPeEq hp, qP0] + rw [hp] + simp only [sub_self, zero_mul, zero_sub] + exact endAlgebraB k B + · have hlt : p + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + let zA : GaussianInt := ⟨p,p-1⟩ + let val0 : Int := Q p (p-1) + let valW : Int := Q (p-1) (p-1) + (f zA = val0) → ((f (zA-1) = valW) → ((val0 = p*(p-1)/2) → ((valW = (p-1)*(p-2)/2) → ((∀ + (a : Int), (a-1)*(a-2)/2-a*(a-1)/2 = 1-a) → (f (zA-1)-f zA = 1-p)))))) ) := by + classical + intro f subDiff p Q zA val0 valW hC0 hCW qC0 qCW tdiffRev + calc + f (zA-1)-f zA = valW-val0 := subDiff hCW hC0 + _ = 1-p := by + rw [qCW,qC0] + rw [tdiffRev p] + +private theorem hNorthDiff : + (by + classical + exact + ∀ (f : IntegerLatticeFunction), (∀ {a : Int}, ∀ {b : Int}, ∀ {c : Int}, ∀ {d : Int}, + (a=b) → ((c=d) → (a-c = b-d))) → (∀ (p : ℤ), + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + let zA : GaussianInt := ⟨p,p-1⟩ + let val0 : Int := Q p (p-1) + let valN : Int := Q p p + (f zA = val0) → ((f (zA+⟨0,1⟩) = valN) → ((val0 = p*(p-1)/2) → ((valN = p*(p-1)/2) → (f + (zA+⟨0,1⟩)-f zA = 0))))) ) := by + classical + intro f subDiff p Q zA val0 valN hC0 hCN qC0 qCN + exact (by + have hval : valN=val0 := by + calc + valN = p*(p-1)/2 := qCN + _ = val0 := qC0.symm + calc + f (zA+⟨0,1⟩)-f zA = valN-val0 := subDiff hCN hC0 + _ = 0 := by exact sub_eq_zero.mpr hval + ) + +private theorem hSouthDiff : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), (∀ {a : Int}, ∀ + {b : Int}, ∀ {c : Int}, ∀ {d : Int}, (a=b) → ((c=d) → (a-c = b-d))) → ((∀ (a : Int), + ∀ (b : Int), (b-1)*(a-2)-(b-1)*(a-1)=-(b-1)) → ( + let k : Int := K.1 + ∀ (p : ℤ), + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + let zA : GaussianInt := ⟨p,p-1⟩ + let valS : Int := Q (p-k) (p-1-1-(1-k)) + let valC : Int := Q (p-k) (p-1-(1-k)) + (f zA = valC + (k-1)*(p-1)+B) → ((f (zA-⟨0,1⟩) = valS + (k-1)*(p-2)+B) → ((valS - valC = + k-1) → (f (zA-⟨0,1⟩)-f zA = 0))))) ) := by + classical + intro K f B subDiff productGap k p Q zA valS valC hPcenter hPsouth hQdelta + calc + f (zA-⟨0,1⟩)-f zA = + valS+(k-1)*(p-2)+B - (valC+(k-1)*(p-1)+B) := subDiff hPsouth hPcenter + _ = 0 := by + have hdelta : valS-valC=k-1 := hQdelta + have hsum : valS+(k-1)*(p-2)+B - (valC+(k-1)*(p-1)+B) = + (valS-valC)+((k-1)*(p-2)-(k-1)*(p-1)) := by abel + rw [hsum, hdelta] + have hgap := productGap p k + calc + (k-1)+((k-1)*(p-2)-(k-1)*(p-1)) = (k-1)+(-(k-1)) := + congrArg (fun t : Int => (k-1)+t) hgap + _ = 0 := add_neg_cancel (k-1) + +private theorem hLapZero : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), (∀ (g : + IntegerLatticeFunction), ∀ (x : GaussianInt), FourNeighborLaplacian g x = (g (x+1)-g + x)+(g (x-1)-g x)+ (g (x+⟨0,1⟩)-g x)+(g (x-⟨0,1⟩)-g x)) → ((∀ (a : Int), + (a-1)+(1-a)=0) → ( + let k : Int := K.1 + ∀ (p : ℤ), + let zA : GaussianInt := ⟨p,p-1⟩ + (f (zA+1)-f zA = if p=k then k-1 else p) → ((f (zA-1)-f zA = 1-p) → ((f (zA+⟨0,1⟩)-f zA = + 0) → ((f (zA-⟨0,1⟩)-f zA = 0) → (p = k → FourNeighborLaplacian f zA = (0 : ℤ))))))) ) + := by + classical + intro K f lap_identity lapZeroAlgebra k p zA hEastDiff hWestDiff hNorthDiff hSouthDiff hp + rw [ite_eq_left hp] at hEastDiff + have he : f (zA+1)-f zA = k-1 := hEastDiff + rw [lap_identity, he, hWestDiff, hNorthDiff, hSouthDiff] + rw [hp] + simpa only [Int.add_zero] using lapZeroAlgebra k + +private theorem hLapOne : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), (∀ (g : + IntegerLatticeFunction), ∀ (x : GaussianInt), FourNeighborLaplacian g x = (g (x+1)-g + x)+(g (x-1)-g x)+ (g (x+⟨0,1⟩)-g x)+(g (x-⟨0,1⟩)-g x)) → ((∀ (a : Int), a+(1-a)=1) → ( + let k : Int := K.1 + ∀ (p : ℤ), + let zA : GaussianInt := ⟨p,p-1⟩ + (f (zA+1)-f zA = if p=k then k-1 else p) → ((f (zA-1)-f zA = 1-p) → ((f (zA+⟨0,1⟩)-f zA = + 0) → ((f (zA-⟨0,1⟩)-f zA = 0) → (p ≠ k → FourNeighborLaplacian f zA = (1 : ℤ))))))) ) + := by + classical + intro K f lap_identity lapOneAlgebra k p zA hEastDiff hWestDiff hNorthDiff hSouthDiff hp + rw [ite_eq_right hp] at hEastDiff + have he : f (zA+1)-f zA = p := hEastDiff + rw [lap_identity, he, hWestDiff, hNorthDiff, hSouthDiff] + simpa only [Int.add_zero] using lapOneAlgebra p + +private theorem hce : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1 + let r : GaussianInt := ⟨2*k, 0⟩ + let child := P5352T2Sources K hk 0 + (child.1 = DiamondTile K.1) → (∀ (p : ℤ), + let zA : GaussianInt := ⟨p,p-1⟩ + (zA = (⟨p,p-1⟩ : GaussianInt)) → ((⟨p, p - (1 : ℤ)⟩ - r ∈ FootprintVertices child.1) → + (zA-r ∈ FootprintVertices (DiamondTile K.1)))) ) := by + classical + intro K hk k r child hchildTile p zA hzEq hc + have hpEq : zA-r = (⟨p,p-1⟩ : GaussianInt)-r := + congrArg (fun w : GaussianInt => w-r) hzEq + rw [hpEq] + exact hchildTile ▸ hc + +private theorem hpAt505 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1 + let r : GaussianInt := ⟨2*k, 0⟩ + let child := P5352T2Sources K hk 0 + (child.1 = DiamondTile K.1) → (∀ (p : ℤ), + let zA : GaussianInt := ⟨p,p-1⟩ + (zA-r ∈ FootprintVertices (DiamondTile K.1) ↔ p=k) → ((zA = (⟨p,p-1⟩ : GaussianInt)) → + ((⟨p, p - (1 : ℤ)⟩ - r ∉ FootprintVertices child.1) → (p≠k)))) ) := by + classical + intro K hk k r child hchildTile p zA hComp hzEq hn heq + apply hn + have hc := hComp.mpr heq + have hpEq : zA-r = (⟨p,p-1⟩ : GaussianInt)-r := + congrArg (fun w : GaussianInt => w-r) hzEq + rw [← hpEq] + exact hchildTile.symm ▸ hc + +end FirstPredecessorCases + +theorem P5352T2Predecessor0 (K : DiamondParameter) (hk : 1 < K.1) + (f : IntegerLatticeFunction) (B : Int) (z : GaussianInt) : + let A := P5352T2Sources K hk 0 + let D := P5352T2Sources K hk 3 + let M := (P5352T2PlacementData K.1 2).2 0 + (∀ y, y ∈ FootprintVertices A.1 → f y = A.2.1 y) → + (∀ y, y - M.1 ∈ FootprintVertices D.1 → + f y = D.2.1 (y - M.1) + M.2.1.re*y.re + M.2.1.im*y.im + B) → + z ∈ FootprintVertices A.1 → z - M.1 ∈ FootprintVertices D.1 → + (∀ y, y = z ∨ y = z + 1 ∨ y = z - 1 ∨ + y = z + ⟨0, 1⟩ ∨ y = z - ⟨0, 1⟩ → + y ∈ FootprintVertices A.1 ∨ y - M.1 ∈ FootprintVertices D.1) → + (z - M.2.2 ∈ FootprintVertices A.1 → FourNeighborLaplacian f z = 0) ∧ + (z - M.2.2 ∉ FootprintVertices A.1 → FourNeighborLaplacian f z = 1) := by +-- BODY + exact (by + classical + have lap_identity (g : IntegerLatticeFunction) (x : GaussianInt) := + FirstPredecessorCases.lap_identity g x + have subDiff {a b c d : Int} (hab : a=b) (hcd : c=d) : + a-c = b-d := by rw [hab, hcd] + have eastAlgebra (a b : Int) : 1-(b-a)+(b-1)=a := by ring + have productGap (a b : Int) : (b-1)*(a-2)-(b-1)*(a-1)=-(b-1) := by ring + have lapZeroAlgebra (a : Int) : (a-1)+(1-a)=0 := by ring + have lapOneAlgebra (a : Int) : a+(1-a)=1 := by ring + have endAlgebra (b : Int) := FirstPredecessorCases.endAlgebra b + have endAlgebraB (b c : Int) := FirstPredecessorCases.endAlgebraB b c + let k : Int := K.1 + let d : GaussianInt := ⟨k, 1-k⟩ + let r : GaussianInt := ⟨2*k, 0⟩ + let child := P5352T2Sources K hk 0 + let pred := P5352T2Sources K hk 3 + let M := (P5352T2PlacementData K.1 2).2 0 + have hchildTile : child.1 = DiamondTile K.1 := by simp [child, P5352T2Sources] + change + (∀ y, y ∈ FootprintVertices child.1 → f y = child.2.1 y) → + (∀ y, y - M.1 ∈ FootprintVertices pred.1 → + f y = pred.2.1 (y - M.1) + M.2.1.re*y.re + M.2.1.im*y.im + B) → + z ∈ FootprintVertices child.1 → z - M.1 ∈ FootprintVertices pred.1 → + (∀ y, y = z ∨ y = z + 1 ∨ y = z - 1 ∨ + y = z + ⟨0, 1⟩ ∨ y = z - ⟨0, 1⟩ → + y ∈ FootprintVertices child.1 ∨ y - M.1 ∈ FootprintVertices pred.1) → + (z - M.2.2 ∈ FootprintVertices child.1 → FourNeighborLaplacian f z = 0) ∧ + (z - M.2.2 ∉ FootprintVertices child.1 → FourNeighborLaplacian f z = 1) + intro hchild hpred hz hpz hcover + have hkI : 2 ≤ k := by dsimp [k]; exact_mod_cast (show 2 ≤ K.1 by omega) + have hm : M.1 = d ∧ M.2.1 = ⟨0,k-1⟩ ∧ M.2.2 = r := by + simp [M, d, r, P5352T2PlacementData, k] + rcases hm with ⟨hdisp, hcoeff, hr⟩ + rw [hdisp, hcoeff] at hpred + rw [hdisp] at hpz hcover + rw [hr] at ⊢ + have hdchild := (P5352T2DomainRows K z).1.mp hz + have hdpred := (P5352T2DomainRows ⟨K.1-1, by omega⟩ (z-d)).1.mp hpz + rcases z with ⟨p,q⟩ + simp? [d] at hdpred + have hcast : (↑(K.1-1) : Int) = k-1 := by dsimp [k]; omega + rw [hcast] at hdpred + change (0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ -q-1 ≤ p ∧ p ≤ q+1 ∧ + -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1) at hdchild + have hpq : 1 ≤ p ∧ p ≤ k ∧ (q = p-1 ∨ q = p) := by omega + rcases hpq with ⟨hp1,hpk,hq⟩ + have childMem (a b : Int) + (hb0 : 0 ≤ b) (hb1 : b ≤ 2*k) (ha0 : -k ≤ a) (ha1 : a ≤ k) + (hs0 : -b-1 ≤ a) (hs1 : a ≤ b+1) + (ht0 : -(2*k-b+1) ≤ a) (ht1 : a ≤ 2*k-b+1) := FirstPredecessorCases.childMem K a b hb0 + hb1 ha0 ha1 hs0 hs1 ht0 ht1 + have boundaryCase (hqp : q=p) : + ((⟨p,p⟩ : GaussianInt)-r ∈ FootprintVertices child.1 → + FourNeighborLaplacian f ⟨p,p⟩ = 0) ∧ + ((⟨p,p⟩ : GaussianInt)-r ∉ FootprintVertices child.1 → + FourNeighborLaplacian f ⟨p,p⟩ = 1) := FirstPredecessorCases.boundaryCase K hk f hchild + hkI p q hz hpz hcover hdpred hcast hdchild hp1 hq childMem hqp + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + have childValue (w : GaussianInt) + (hw : w ∈ FootprintVertices (DiamondTile K.1)) := FirstPredecessorCases.childValue K hk f + hchild w hw + let Kp : DiamondParameter := ⟨K.1-1, by omega⟩ + have predFoot (w : GaussianInt) + (hw : 0 ≤ w.im ∧ w.im ≤ 2*(k-1) ∧ -(k-1) ≤ w.re ∧ w.re ≤ k-1 ∧ + -w.im-1 ≤ w.re ∧ w.re ≤ w.im+1 ∧ + -(2*(k-1)-w.im+1) ≤ w.re ∧ w.re ≤ 2*(k-1)-w.im+1) := FirstPredecessorCases.predFoot K + hk p q hcast w hw + have predValue (w : GaussianInt) + (hw : w ∈ FootprintVertices (DiamondTile (K.1-1))) := FirstPredecessorCases.predValue K + hk p q hcast w hw + have predTranslatedValue (y : GaussianInt) + (hy : y-d ∈ FootprintVertices (DiamondTile (K.1-1))) := + FirstPredecessorCases.predTranslatedValue K hk f B hpred predValue y hy + rcases hq with hq | hq + · -- Staircase centers A_t=(t,t-1). + clear hcover hdpred hdchild hpred boundaryCase hdisp hcoeff hr M + let zA : GaussianInt := ⟨p,p-1⟩ + have hzA : zA ∈ FootprintVertices (DiamondTile K.1) := by + simpa [zA, child, P5352T2Sources, hq] using hz + have hComp := FirstPredecessorCases.hComp K hk p q hz hpz hcast hp1 hpk childMem hq hzA + have hzEq : zA = (⟨p,p-1⟩ : GaussianInt) := rfl + have hW : (⟨p-1,p-1⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := + childMem (p-1) (p-1) (by omega) (by omega) (by omega) (by omega) + (by omega) (by omega) (by omega) (by omega) + have hN : (⟨p,p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := + childMem p p (by omega) (by omega) (by omega) (by omega) + (by omega) (by omega) (by omega) (by omega) + have hP0 : (zA-d) ∈ FootprintVertices (DiamondTile (K.1-1)) := by + simpa [zA, pred, P5352T2Sources, hq] using hpz + clear hpz Kp + let valS : Int := Q (p-k) (p-1-1-(1-k)) + let valC : Int := Q (p-k) (p-1-(1-k)) + have he : (zA+1)-d = (⟨p+1-k,p+k-2⟩ : GaussianInt) := by + ext <;> simp [d] <;> ring + have hs : (zA-⟨0,1⟩)-d = (⟨p-k,p+k-3⟩ : GaussianInt) := by + ext <;> simp [d] <;> ring + have hPe := FirstPredecessorCases.hPe K hk p q hcast hp1 hpk predFoot hq + have hPs := FirstPredecessorCases.hPs K hk p q hcast hp1 hpk predFoot hq + let val0 : Int := Q p (p-1) + let valW : Int := Q (p-1) (p-1) + let valN : Int := Q p p + have hC0 : f zA = val0 := childValue zA hzA + have hCW := FirstPredecessorCases.hCW K f p childValue hW + have hCN := FirstPredecessorCases.hCN K f p childValue hN + have hPcenter := FirstPredecessorCases.hPcenter K f B p predTranslatedValue hP0 + have hPeast := FirstPredecessorCases.hPeast K f B p predTranslatedValue he hPe + have hPsouth := FirstPredecessorCases.hPsouth K f B p predTranslatedValue hs hPs + clear hP0 hPe hPs predValue predTranslatedValue predFoot pred hcast + hzA hW hN hz hchild childMem childValue + have qC0 : val0 = p*(p-1)/2 := by + simp [val0, Q, abs_of_nonneg (show 0 ≤ p by omega)] + have qCW := FirstPredecessorCases.qCW K f B p q hp1 hq + have qCN : valN = p*(p-1)/2 := by + simp [valN, Q, abs_of_nonneg (show 0 ≤ p by omega)] + have qCS : Q p (p-2) = p*(p-1)/2-1 := by + simp [Q, abs_of_nonneg (show 0 ≤ p by omega)] + have floorEven (m : Int) := FirstPredecessorCases.floorEven m + have floorOdd (m : Int) := FirstPredecessorCases.floorOdd K f B p q m + have qP0 := FirstPredecessorCases.qP0 K f B p q hpk hq floorEven + have qPeLt (hpk' : p < k) := FirstPredecessorCases.qPeLt K f B p q hq floorOdd hpk' + have qPeEq (hpk' : p = k) := FirstPredecessorCases.qPeEq K f B p q hp1 hpk hq hComp hzEq he + hs hC0 hCW hCN hPcenter hPeast hPsouth qC0 qCW qCN qCS floorOdd qP0 qPeLt hpk' + have qPs := FirstPredecessorCases.qPs K f B p q hpk hq floorOdd + have hQdelta : valS - valC = k-1 := by + linear_combination qPs-qP0 + have tri (a : Int) := FirstPredecessorCases.tri K f B p q a + have tdiff (a : Int) := FirstPredecessorCases.tdiff K f B p q tri a + have tdiffRev (a : Int) := FirstPredecessorCases.tdiffRev K f B p q tdiff a + have hEastDiff := FirstPredecessorCases.hEastDiff K f B eastAlgebra endAlgebraB p q hpk hq + hPcenter hPeast qP0 qPeLt qPeEq qPs tdiffRev + have hWestDiff := FirstPredecessorCases.hWestDiff f subDiff p hC0 hCW qC0 qCW tdiffRev + have hNorthDiff := FirstPredecessorCases.hNorthDiff f subDiff p hC0 hCN qC0 qCN + have hSouthDiff := FirstPredecessorCases.hSouthDiff K f B subDiff productGap p hPcenter + hPsouth hQdelta + have hLapZero (hp : p=k) := FirstPredecessorCases.hLapZero K f lap_identity lapZeroAlgebra + p hEastDiff hWestDiff hNorthDiff hSouthDiff hp + have hLapOne (hp : p≠k) := FirstPredecessorCases.hLapOne K f lap_identity lapOneAlgebra p + hEastDiff hWestDiff hNorthDiff hSouthDiff hp + rw [hq] + refine ⟨?_, ?_⟩ + · intro hc + have hce := FirstPredecessorCases.hce K hk hchildTile p hzEq hc + have hp : p=k := hComp.mp hce + exact hLapZero hp + · intro hn + have hp := FirstPredecessorCases.hpAt505 K hk hchildTile p hComp hzEq hn + exact hLapOne hp + · rw [hq] + exact boundaryCase hq + ) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean new file mode 100644 index 0000000000..01ecb14549 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean @@ -0,0 +1,1202 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData +public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic +public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable + +-- [TABLET NODE: P5352T2Predecessor1] + +/-! +# P5352T2Predecessor1 + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FirstPredecessorProof + +private theorem lap_identity : + (by + classical + exact + ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), FourNeighborLaplacian g x = g (x + + (1 : GaussianInt)) - g x + (g (x - (1 : GaussianInt)) - g x) + (g (x + ⟨(0 : ℤ), (1 : + ℤ)⟩) - g x) + (g (x - ⟨(0 : ℤ), (1 : ℤ)⟩) - g x) ) := by + classical + intro g x + unfold FourNeighborLaplacian + ring + +private theorem predMem : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (ℤ) → ((ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (∀ (a : ℤ), ∀ (b : ℤ), (0 : ℤ) ≤ b + → b ≤ (2 : ℤ) * (k - (1 : ℤ)) → -(k - (1 : ℤ)) ≤ a → a ≤ k - (1 : ℤ) → -b - (1 : ℤ) ≤ + a → a ≤ b + (1 : ℤ) → -((2 : ℤ) * (k - (1 : ℤ)) - b + (1 : ℤ)) ≤ a → a ≤ (2 : ℤ) * (k + - (1 : ℤ)) - b + (1 : ℤ) → ⟨a, b⟩ ∈ FootprintVertices (DiamondTile (K.1 - (1 : + ℕ))))))) ) := by + classical + intro K hk k p q hcast a b hb0 hb1 ha0 ha1 hs0 hs1 ht0 ht1 + apply (P5352T2DomainRows ⟨K.1-1,by omega⟩ ⟨a,b⟩).1.mpr + simpa [hcast] using And.intro hb0 (And.intro hb1 (And.intro ha0 + (And.intro ha1 (And.intro hs0 (And.intro hs1 (And.intro ht0 ht1)))))) + +private theorem hcenter : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let child := P5352T2Sources K hk 0 + (∀ y ∈ FootprintVertices child.1, f y = child.2.1 y) → (∀ (p : ℤ), (⟨p, (2 : ℤ) * k - p⟩ + ∈ FootprintVertices child.1) → (f ⟨p,2*k-p⟩ = DiamondOdometer K ⟨p,2*k-p⟩)) ) := by + classical + intro K hk f k child hchild p hz + have := hchild _ (by simpa [child,P5352T2Sources] using hz) + simpa [child,P5352T2Sources] using this + +private theorem hEval : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), + let child := P5352T2Sources K hk 0 + (child.1 = DiamondTile K.1) → ((∀ y ∈ FootprintVertices child.1, f y = child.2.1 y) → (∀ + w ∈ FootprintVertices (DiamondTile K.1), f w = DiamondOdometer K w)) ) := by + classical + intro K hk f child hchildTile hchild w hw + have := hchild w (by simpa [child,P5352T2Sources] using (hchildTile ▸ hw)) + simpa [child,P5352T2Sources] using this + +private theorem hdom : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1 + let child := P5352T2Sources K hk 0 + (child.1 = DiamondTile K.1) → (∀ (p : ℤ), (⟨p, (2 : ℤ) * k - p⟩ ∈ FootprintVertices + child.1) → ((⟨p,2*k-p⟩ : GaussianInt) ∈ DiamondVertexDomains K false)) ) := by + classical + intro K hk k child hchildTile p hz + obtain ⟨_,_,_,hf,_⟩ := DiamondTileOdometerRestriction K + exact hf ▸ (hchildTile ▸ (by simpa [child,P5352T2Sources] using hz)) + +private theorem hnot : + (by + classical + exact + ∀ (K : DiamondParameter), (IntegerLatticeFunction) → ( + let k : Int := K.1 + ∀ (p : ℤ), ((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (((1 : ℤ) ≤ p) → ((k < (2 : ℤ) * k - + p ∧ (2 : ℤ) * k - p ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ k ≤ p + (k - (1 : ℤ)) + ∧ p ≤ k - (1 : ℤ) + k ∧ k < p - k + (1 : ℤ) + ((2 : ℤ) * k - p) ∧ p ≤ (2 : ℤ) * k - p + - (k + (1 : ℤ)) + (1 : ℤ) + k ∧ (2 : ℤ) * k - p ≤ (1 : ℤ) + (p - k) + (2 : ℤ) * (k - + (1 : ℤ)) + (k + (1 : ℤ)) ∧ p ≤ (2 : ℤ) * (k - (1 : ℤ)) - ((2 : ℤ) * k - p - (k + (1 : + ℤ))) + (1 : ℤ) + k) → ((⟨p,2*k-p⟩ : GaussianInt) ∉ DiamondVertexDomains K true)))) ) + := by + classical + intro K f k p hcast hp1 hdpred + change ¬ (Int.natAbs p + Int.natAbs (2*k-p-(K.1:Int)) ≤ K.1-1) + intro hh + have hpabs : (Int.natAbs p : Int)=p := by rw [Int.natCast_natAbs,abs_of_nonneg (by omega)] + have hqabs : (Int.natAbs (2*k-p-(K.1:Int)) : Int)=k-p := by + rw [Int.natCast_natAbs,abs_of_nonneg (by dsimp [k]; omega)] + dsimp [k] + ring + have hKsub : ((K.1-1 : Nat) : Int)=k-1 := by + rw [Nat.cast_sub (by omega : 1≤K.1)] + rfl + have hhI : ((Int.natAbs p + Int.natAbs (2*k-p-(K.1:Int)) : Nat) : Int) ≤ + ((K.1-1 : Nat) : Int) := by exact_mod_cast hh + rw [Int.natCast_add,hpabs,hqabs,hKsub] at hhI + have hh' : p+(k-p)≤k-1 := hhI + dsimp [k] at hh' + omega + +private theorem hvE : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + ∀ (p : ℤ), ((⟨p+1,2*k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → ((∀ (w : + GaussianInt), (w ∈ FootprintVertices (DiamondTile K.1)) → (f w = DiamondOdometer K + w)) → (f (⟨p,2*k-p⟩+1)=DiamondOdometer K (⟨p,2*k-p⟩+1))) ) := by + classical + intro K f k p hE hEval + have he : (⟨p,2*k-p⟩:GaussianInt)+1=⟨p+1,2*k-p⟩ := by ext <;> simp + rw [he]; exact hEval _ hE + +private theorem hvW : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + ∀ (p : ℤ), ((⟨p-1,2*k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → ((∀ (w : + GaussianInt), (w ∈ FootprintVertices (DiamondTile K.1)) → (f w = DiamondOdometer K + w)) → (f (⟨p,2*k-p⟩-1)=DiamondOdometer K (⟨p,2*k-p⟩-1))) ) := by + classical + intro K f k p hW hEval + have he : (⟨p,2*k-p⟩:GaussianInt)-1=⟨p-1,2*k-p⟩ := by ext <;> simp + rw [he]; exact hEval _ hW + +private theorem hvN : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + ∀ (p : ℤ), ((⟨p,2*k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → ((∀ (w : + GaussianInt), (w ∈ FootprintVertices (DiamondTile K.1)) → (f w = DiamondOdometer K + w)) → (f (⟨p,2*k-p⟩+⟨0,1⟩)=DiamondOdometer K (⟨p,2*k-p⟩+⟨0,1⟩))) ) := by + classical + intro K f k p hN hEval + have he : (⟨p,2*k-p⟩:GaussianInt)+⟨0,1⟩=⟨p,2*k+1-p⟩ := by ext <;> simp; omega + rw [he]; exact hEval _ hN + +private theorem hvS : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + ∀ (p : ℤ), ((⟨p,2*k-p-1⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → ((∀ (w : + GaussianInt), (w ∈ FootprintVertices (DiamondTile K.1)) → (f w = DiamondOdometer K + w)) → (f (⟨p,2*k-p⟩-⟨0,1⟩)=DiamondOdometer K (⟨p,2*k-p⟩-⟨0,1⟩))) ) := by + classical + intro K f k p hS hEval + have he : (⟨p,2*k-p⟩:GaussianInt)-⟨0,1⟩=⟨p,2*k-p-1⟩ := by ext <;> simp + rw [he]; exact hEval _ hS + +private theorem hcompAt229 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), (IntegerLatticeFunction) → ( + let k : Int := K.1 + let r : GaussianInt := ⟨2*k,0⟩ + let child := P5352T2Sources K hk 0 + (child.1 = DiamondTile K.1) → (∀ (p : ℤ), ((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → ((k < + (2 : ℤ) * k - p ∧ (2 : ℤ) * k - p ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ k ≤ p + + (k - (1 : ℤ)) ∧ p ≤ k - (1 : ℤ) + k ∧ k < p - k + (1 : ℤ) + ((2 : ℤ) * k - p) ∧ p ≤ + (2 : ℤ) * k - p - (k + (1 : ℤ)) + (1 : ℤ) + k ∧ (2 : ℤ) * k - p ≤ (1 : ℤ) + (p - k) + + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ p ≤ (2 : ℤ) * (k - (1 : ℤ)) - ((2 : ℤ) * k + - p - (k + (1 : ℤ))) + (1 : ℤ) + k) → ((⟨p,2*k-p⟩:GaussianInt)-r ∉ FootprintVertices + child.1)))) ) := by + classical + intro K hk f k r child hchildTile p hcast hdpred hc + have hb := (P5352T2DomainRows K (⟨p,2*k-p⟩-r)).1.mp (hchildTile ▸ hc) + simp [r] at hb + omega + +private theorem hcenterC : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let child := P5352T2Sources K hk 0 + (∀ y ∈ FootprintVertices child.1, f y = child.2.1 y) → (∀ (p : ℤ), (⟨p, (2 : ℤ) * k + (1 + : ℤ) - p⟩ ∈ FootprintVertices child.1) → (f ⟨p,2*k+1-p⟩ = DiamondOdometer K + ⟨p,2*k+1-p⟩)) ) := by + classical + intro K hk f k child hchild p hz + have := hchild _ (by simpa [child,P5352T2Sources] using hz) + simpa [child,P5352T2Sources] using this + +private theorem hWval : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let child := P5352T2Sources K hk 0 + (child.1 = DiamondTile K.1) → ((∀ y ∈ FootprintVertices child.1, f y = child.2.1 y) → (∀ + (p : ℤ), ((⟨p-1,2*k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → (f + (⟨p,2*k+1-p⟩-1)=DiamondOdometer K (⟨p,2*k+1-p⟩-1)))) ) := by + classical + intro K hk f k child hchildTile hchild p hW + have he : (⟨p,2*k+1-p⟩:GaussianInt)-1=⟨p-1,2*k+1-p⟩ := by ext <;> simp + rw [he] + have hh := hchild _ (by simpa [child,P5352T2Sources] using (hchildTile ▸ hW)) + simpa [child,P5352T2Sources] using hh + +private theorem hSval : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let child := P5352T2Sources K hk 0 + (child.1 = DiamondTile K.1) → ((∀ y ∈ FootprintVertices child.1, f y = child.2.1 y) → (∀ + (p : ℤ), ((⟨p,2*k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → (f + (⟨p,2*k+1-p⟩-⟨0,1⟩)=DiamondOdometer K (⟨p,2*k+1-p⟩-⟨0,1⟩)))) ) := by + classical + intro K hk f k child hchildTile hchild p hS + have he : (⟨p,2*k+1-p⟩:GaussianInt)-⟨0,1⟩=⟨p,2*k-p⟩ := by ext <;> simp; omega + rw [he] + have hh := hchild _ (by simpa [child,P5352T2Sources] using (hchildTile ▸ hS)) + simpa [child,P5352T2Sources] using hh + +private theorem hPval : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), + let k : Int := K.1 + let d : GaussianInt := ⟨k,k+1⟩ + let pred := P5352T2Sources K hk 3 + (∀ (y : GaussianInt), y - d ∈ FootprintVertices pred.1 → f y = pred.2.1 (y - d) + + (⟨k, (0 : ℤ)⟩ : GaussianInt).re * y.re + (⟨k, (0 : ℤ)⟩ : GaussianInt).im * y.im + + B) → ((ℤ) → (∀ (hcast : (↑(K.1 + - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), ∀ (y : GaussianInt), ∀ (w : GaussianInt), (y-d + ∈ FootprintVertices pred.1) → ((y-d=w) → (f y = DiamondOdometer (⟨K.1-1,by + omega⟩) w + k*y.re+B))))) := by + classical + intro K hk f B k d pred hpred p hcast y w hy heq + have hh := hpred y (by simpa [pred,P5352T2Sources] using hy) + rw [heq] at hh + simpa [pred,P5352T2Sources] using hh + +private theorem hPcenter : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), + let k : Int := K.1 + let d : GaussianInt := ⟨k,k+1⟩ + let pred := P5352T2Sources K hk 3 + ∀ (p : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), (⟨p, (2 : ℤ) * k + + (1 : ℤ) - p⟩ - d ∈ FootprintVertices pred.1) → ((∀ (y : GaussianInt), ∀ (w : + GaussianInt), (y-d ∈ FootprintVertices pred.1) → ((y-d=w) → (f y = + DiamondOdometer (⟨K.1-1,by omega⟩) w + k*y.re+B))) → (f ⟨p,2*k+1-p⟩ = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩ + k*p+B))) := by + classical + intro K hk f B k d pred p hcast hpz hPval + have he : (⟨p,2*k+1-p⟩:GaussianInt)-d=⟨p-k,k-p⟩ := by ext <;> simp [d]; ring + have hv := hPval _ _ (by simpa [pred,P5352T2Sources] using hpz) he + simpa using hv + +private theorem hPeval : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), + let k : Int := K.1 + let d : GaussianInt := ⟨k,k+1⟩ + let pred := P5352T2Sources K hk 3 + ∀ (p : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), ((⟨p+1-k,k-p⟩ : + GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))) → + (((⟨p,2*k+1-p⟩:GaussianInt)+1-d=⟨p+1-k,k-p⟩) → ((∀ (y : GaussianInt), ∀ (w : + GaussianInt), (y-d ∈ FootprintVertices pred.1) → ((y-d=w) → (f y = + DiamondOdometer (⟨K.1-1,by omega⟩) w + k*y.re+B))) → (f (⟨p,2*k+1-p⟩+1) = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩ + k*(p+1)+B)))) := by + classical + intro K hk f B k d pred p hcast hPe hearg hPval + have hv := hPval _ _ (by rw [hearg]; exact hPe) hearg + simpa using hv + +private theorem hPnval : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), + let k : Int := K.1 + let d : GaussianInt := ⟨k,k+1⟩ + let pred := P5352T2Sources K hk 3 + ∀ (p : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), ((⟨p-k,k+1-p⟩ : + GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))) → + (((⟨p,2*k+1-p⟩:GaussianInt)+⟨0,1⟩-d=⟨p-k,k+1-p⟩) → ((∀ (y : GaussianInt), ∀ (w : + GaussianInt), (y-d ∈ FootprintVertices pred.1) → ((y-d=w) → (f y = + DiamondOdometer (⟨K.1-1,by omega⟩) w + k*y.re+B))) → (f (⟨p,2*k+1-p⟩+⟨0,1⟩) = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩ + k*p+B)))) := by + classical + intro K hk f B k d pred p hcast hPn hnarg hPval + have hv := hPval _ _ (by rw [hnarg]; exact hPn) hnarg + simpa using hv + +private theorem sqEven : + (by + classical + exact + ∀ (m : ℤ), ((2 : ℤ) * m) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) ) := by + classical + intro m + have h := P4207T1FloorArithmetic.1 0 m + simpa using h + +private theorem sqOdd : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ((IntegerLatticeFunction) → ((Int) → ( + let k : Int := K.1 + (ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (∀ (m : ℤ), ((2 : ℤ) * m + (1 : ℤ)) ^ (2 + : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) + m))))) ) := by + classical + intro K hk f B k p hcast m + have h := P4207T1FloorArithmetic.1 1 m + have he : 1+2*m=2*m+1 := by ring + rw [he] at h + norm_num at h ⊢ + omega + +private theorem tri : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ((IntegerLatticeFunction) → ((Int) → ( + let k : Int := K.1 + (ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (∀ (a : ℤ), (2 : ℤ) * (a * (a - (1 : ℤ)) + / (2 : ℤ)) = a * (a - (1 : ℤ))))))) ) := by + classical + intro K hk f B k p hcast a + rcases Int.emod_two_eq_zero_or_one a with h | h + · have ha : a=2*(a/2) := by omega + rw [ha] + have he : 2*(a/2)*(2*(a/2)-1)=2*((a/2)*(2*(a/2)-1)) := by ring + rw [he,Int.mul_ediv_cancel_left _ (by norm_num : (2:Int)≠0)] + · have ha : a=2*(a/2)+1 := by omega + rw [ha] + have he : (2*(a/2)+1)*(2*(a/2)+1-1)=2*((2*(a/2)+1)*(a/2)) := by ring + rw [he,Int.mul_ediv_cancel_left _ (by norm_num : (2:Int)≠0)] + +private theorem tdiff : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ((IntegerLatticeFunction) → ((Int) → ( + let k : Int := K.1 + (ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → ((∀ (a : Int), 2*(a*(a-1)/2)=a*(a-1)) → + (∀ (a : ℤ), a * (a - (1 : ℤ)) / (2 : ℤ) - (a - (1 : ℤ)) * (a - (2 : ℤ)) / (2 : ℤ) = a + - (1 : ℤ))))))) ) := by + classical + intro K hk f B k p hcast tri a + have h1 := tri a + have h2 := tri (a-1) + have he : 2*(a*(a-1)/2-(a-1)*(a-2)/2)=2*(a-1) := by + have h2' : 2*((a-1)*(a-2)/2)=(a-1)*(a-2) := by + simpa [show a-1-1=a-2 by ring] using h2 + calc + 2*(a*(a-1)/2-(a-1)*(a-2)/2) = 2*(a*(a-1)/2)-2*((a-1)*(a-2)/2) := by ring + _ = a*(a-1)-(a-1)*(a-2) := by rw [h1,h2'] + _ = 2*(a-1) := by ring + omega + +private theorem tdiffRev : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ((IntegerLatticeFunction) → ((Int) → ( + let k : Int := K.1 + (ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → ((∀ (a : Int), + a*(a-1)/2-(a-1)*(a-2)/2=a-1) → (∀ (a : ℤ), (a - (1 : ℤ)) * (a - (2 : ℤ)) / (2 : ℤ) - + a * (a - (1 : ℤ)) / (2 : ℤ) = (1 : ℤ) - a)))))) ) := by + classical + intro K hk f B k p hcast tdiff a + have hh := tdiff a + omega + +private theorem qpc : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (p : ℤ), + let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + (∀ (m : Int), (2*m)^2/4=m^2) → (((Int.natAbs (p-k) : Int)=k-p) → (Q (p-k) + (k-p)=(k-p)*(k-p-1)/2-(p-k)^2)) ) := by + classical + intro K k p Q sqEven absKm + simp only [Q,absKm] + rw [show (p-k)-(k-p)=2*(p-k) by ring,sqEven] + +private theorem hPcenterQ : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), + let k : Int := K.1 + let d : GaussianInt := ⟨k,k+1⟩ + let pred := P5352T2Sources K hk 3 + ∀ (p : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), ∀ (hpz : ⟨p, (2 : ℤ) * k + + (1 : ℤ) - p⟩ - d ∈ FootprintVertices pred.1), + let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + ((Int.natAbs p : Int)=p) → (((Int.natAbs (p-1) : Int)=p-1) → (∀ (absKm : (Int.natAbs + (p-k) : Int)=k-p), DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q (p-k) + (k-p)))) := by + classical + intro K hk f B k d pred p hcast hpz Q absP absPm absKm + have he : (⟨p,2*k+1-p⟩:GaussianInt)-d=⟨p-k,k-p⟩ := by ext <;> simp [d]; ring + have hm : (⟨p-k,k-p⟩:GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1)) := by + have hh := hpz + rw [he] at hh + simpa [pred,P5352T2Sources] using hh + simpa [Q] using (P5352T2DomainRows ⟨K.1-1,by omega⟩ ⟨p-k,k-p⟩).2 hm + +private theorem absKme : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), + let k : Int := K.1 + let d : GaussianInt := ⟨k,k+1⟩ + let child := P5352T2Sources K hk 0 + let pred := P5352T2Sources K hk 3 + ∀ (p : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), ∀ (hp1 : (1 : ℤ) ≤ p), ∀ + (hpk : p ≤ k), ∀ (hz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∈ FootprintVertices child.1), ∀ + (hpz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - d ∈ FootprintVertices pred.1), ∀ (hcover : ∀ + (y : GaussianInt), y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) + - p⟩ + (1 : GaussianInt) ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - (1 : GaussianInt) ∨ y + = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) + - p⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ FootprintVertices child.1 ∨ y - d ∈ FootprintVertices + pred.1), ∀ (hdpred : k < (2 : ℤ) * k + (1 : ℤ) - p ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : + ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ k ≤ p + (k - (1 : ℤ)) ∧ p ≤ k - (1 : ℤ) + k ∧ k + < p - k + (1 : ℤ) + ((2 : ℤ) * k + (1 : ℤ) - p) ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p - (k + + (1 : ℤ)) + (1 : ℤ) + k ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (1 : ℤ) + (p - k) + (2 : ℤ) * + (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ p ≤ (2 : ℤ) * (k - (1 : ℤ)) - ((2 : ℤ) * k + (1 : ℤ) + - p - (k + (1 : ℤ))) + (1 : ℤ) + k), ∀ (hdchild : (0 : ℤ) ≤ (2 : ℤ) * k + (1 : ℤ) - p + ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : ℤ) * k ∧ -k ≤ p ∧ p ≤ k ∧ -((2 : ℤ) * k + (1 : ℤ) + - p) - (1 : ℤ) ≤ p ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p + (1 : ℤ) ∧ -((2 : ℤ) * k - ((2 : + ℤ) * k + (1 : ℤ) - p) + (1 : ℤ)) ≤ p ∧ p ≤ (2 : ℤ) * k - ((2 : ℤ) * k + (1 : ℤ) - p) + + (1 : ℤ)), ∀ (hW : (⟨p-1,2*k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile + K.1)), ∀ (hS : (⟨p,2*k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)), ∀ + (hPe : (⟨p+1-k,k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ + (hPn : (⟨p-k,k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ + (hearg : (⟨p,2*k+1-p⟩:GaussianInt)+1-d=⟨p+1-k,k-p⟩), ∀ (hnarg : + (⟨p,2*k+1-p⟩:GaussianInt)+⟨0,1⟩-d=⟨p-k,k+1-p⟩), ∀ (hcenterC : f ⟨p,2*k+1-p⟩ = + DiamondOdometer K ⟨p,2*k+1-p⟩), ∀ (hWval : f (⟨p,2*k+1-p⟩-1)=DiamondOdometer K + (⟨p,2*k+1-p⟩-1)), ∀ (hSval : f (⟨p,2*k+1-p⟩-⟨0,1⟩)=DiamondOdometer K + (⟨p,2*k+1-p⟩-⟨0,1⟩)), ∀ (hPval : ∀ (y : GaussianInt), ∀ (w : GaussianInt), (y-d ∈ + FootprintVertices pred.1) → ((y-d=w) → (f y = DiamondOdometer (⟨K.1-1,by + omega⟩) w + k*y.re+B))), ∀ (hPcenter : f ⟨p,2*k+1-p⟩ = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩ + k*p+B), ∀ (hPeval : f (⟨p,2*k+1-p⟩+1) = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩ + k*(p+1)+B), ∀ (hPnval : f + (⟨p,2*k+1-p⟩+⟨0,1⟩) = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩ + k*p+B), + let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + ∀ (qc : DiamondOdometer K ⟨p,2*k+1-p⟩=Q p (2*k+1-p)), ∀ (qw : DiamondOdometer K + ⟨p-1,2*k+1-p⟩=Q (p-1) (2*k+1-p)), ∀ (qs : DiamondOdometer K ⟨p,2*k-p⟩=Q p (2*k-p)), ∀ + (qe : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩=Q (p+1-k) (k-p)), ∀ (qn : + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩=Q (p-k) (k+1-p)), ∀ (absP : + (Int.natAbs p : Int)=p), ∀ (absPm : (Int.natAbs (p-1) : Int)=p-1), ∀ (absKm : + (Int.natAbs (p-k) : Int)=k-p), (Q (p-k) (k-p)=(k-p)*(k-p-1)/2-(p-k)^2) → + ((DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q (p-k) (k-p)) → ((f ⟨p,2*k+1-p⟩=Q + (p-k) (k-p)+k*p+B) → ((Int.natAbs (p+1-k) : Int)=if p=k then 1 else k-p-1)))) := by + classical + intro K hk f B k d child pred p hcast hp1 hpk hz hpz hcover hdpred hdchild hW hS hPe hPn hearg + hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval Q qc qw qs qe qn absP absPm absKm + qpc hPcenterQ hPcval + by_cases hpk : p=k + · subst p + norm_num + · rw [Int.natCast_natAbs,abs_of_nonpos (by omega)] + simp [hpk] + omega + +private theorem hqvals : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (p : ℤ), + let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + (∀ (m : Int), (2*m)^2/4=m^2) → ((∀ (m : Int), (2*m+1)^2/4=m^2+m) → (((Int.natAbs p : + Int)=p) → (((Int.natAbs (p-1) : Int)=p-1) → (((Int.natAbs (p-k) : Int)=k-p) → + (((Int.natAbs (p+1-k) : Int)=if p=k then 1 else k-p-1) → (Q p (2*k+1-p) = + p*(p-1)/2-(p-k)*(p-k-1) ∧ Q (p-1) (2*k+1-p)=(p-1)*(p-2)/2-(p-k-1)^2 ∧ Q p + (2*k-p)=p*(p-1)/2-(p-k)^2 ∧ Q (p+1-k) (k-p)=(if p=k then 0 else + (k-p-1)*(k-p-2)/2-((p-k)^2+(p-k))) ∧ Q (p-k) + (k+1-p)=(k-p)*(k-p-1)/2-((p-k-1)^2+(p-k-1)))))))) ) := by + classical + intro K k p Q sqEven sqOdd absP absPm absKm absKme + constructor + · simp only [Q,absP] + rw [show p-(2*k+1-p)=2*(p-k)-1 by ring] + have hsq : (2*(p-k)-1)^2/4=(p-k)*(p-k-1) := by + have hh := sqOdd (p-k-1) + have he : 2*(p-k)-1=2*(p-k-1)+1 := by ring + rw [he,hh] + ring + rw [hsq] + constructor + · simp only [Q,absPm] + rw [show (p-1)-(2*k+1-p)=2*(p-k-1) by ring, sqEven] + congr 1; ring + constructor + · simp only [Q,absP] + rw [show p-(2*k-p)=2*(p-k) by ring,sqEven] + constructor + · simp only [Q,absKme] + by_cases hp : p=k + · simp [hp] + · simp? [hp] + rw [show (p+1-k)-(k-p)=2*(p-k)+1 by ring,sqOdd] + congr 1; ring + · simp only [Q,absKm] + rw [show (p-k)-(k+1-p)=2*(p-k)-1 by ring] + have hh := sqOdd (p-k-1) + have he : 2*(p-k)-1=2*(p-k-1)+1 := by ring + rw [he,hh] + +private theorem hcval : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + ∀ (p : ℤ), (f ⟨p,2*k+1-p⟩ = DiamondOdometer K ⟨p,2*k+1-p⟩) → ( + let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + (DiamondOdometer K ⟨p,2*k+1-p⟩=Q p (2*k+1-p)) → (f ⟨p,2*k+1-p⟩=Q p (2*k+1-p))) ) := by + classical + intro K f k p hcenterC Q qc + calc + f ⟨p,2*k+1-p⟩ = DiamondOdometer K ⟨p,2*k+1-p⟩ := hcenterC + _ = Q p (2*k+1-p) := qc + +private theorem hwval : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + ∀ (p : ℤ), (f (⟨p,2*k+1-p⟩-1)=DiamondOdometer K (⟨p,2*k+1-p⟩-1)) → ( + let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + (DiamondOdometer K ⟨p-1,2*k+1-p⟩=Q (p-1) (2*k+1-p)) → + (((⟨p,2*k+1-p⟩:GaussianInt)-1=⟨p-1,2*k+1-p⟩) → (f (⟨p,2*k+1-p⟩-1)=Q (p-1) + (2*k+1-p)))) ) := by + classical + intro K f k p hWval Q qw hwcoord + calc + f (⟨p,2*k+1-p⟩-1) = DiamondOdometer K (⟨p,2*k+1-p⟩-1) := hWval + _ = DiamondOdometer K ⟨p-1,2*k+1-p⟩ := by rw [hwcoord] + _ = Q (p-1) (2*k+1-p) := qw + +private theorem hsval : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + ∀ (p : ℤ), (f (⟨p,2*k+1-p⟩-⟨0,1⟩)=DiamondOdometer K (⟨p,2*k+1-p⟩-⟨0,1⟩)) → ( + let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + (DiamondOdometer K ⟨p,2*k-p⟩=Q p (2*k-p)) → (((⟨p,2*k+1-p⟩:GaussianInt)-⟨0,1⟩=⟨p,2*k-p⟩) + → (f (⟨p,2*k+1-p⟩-⟨0,1⟩)=Q p (2*k-p)))) ) := by + classical + intro K f k p hSval Q qs hscoord + calc + f (⟨p,2*k+1-p⟩-⟨0,1⟩) = DiamondOdometer K (⟨p,2*k+1-p⟩-⟨0,1⟩) := hSval + _ = DiamondOdometer K ⟨p,2*k-p⟩ := by rw [hscoord] + _ = Q p (2*k-p) := qs + +private theorem hEAt404 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), + let k : Int := K.1 + let d : GaussianInt := ⟨k,k+1⟩ + let child := P5352T2Sources K hk 0 + let pred := P5352T2Sources K hk 3 + ∀ (p : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), ∀ (hp1 : (1 : ℤ) ≤ p), ∀ + (hpk : p ≤ k), ∀ (hz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∈ FootprintVertices child.1), ∀ + (hpz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - d ∈ FootprintVertices pred.1), ∀ (hcover : ∀ + (y : GaussianInt), y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) + - p⟩ + (1 : GaussianInt) ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - (1 : GaussianInt) ∨ y + = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) + - p⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ FootprintVertices child.1 ∨ y - d ∈ FootprintVertices + pred.1), ∀ (hdpred : k < (2 : ℤ) * k + (1 : ℤ) - p ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : + ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ k ≤ p + (k - (1 : ℤ)) ∧ p ≤ k - (1 : ℤ) + k ∧ k + < p - k + (1 : ℤ) + ((2 : ℤ) * k + (1 : ℤ) - p) ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p - (k + + (1 : ℤ)) + (1 : ℤ) + k ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (1 : ℤ) + (p - k) + (2 : ℤ) * + (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ p ≤ (2 : ℤ) * (k - (1 : ℤ)) - ((2 : ℤ) * k + (1 : ℤ) + - p - (k + (1 : ℤ))) + (1 : ℤ) + k), ∀ (hdchild : (0 : ℤ) ≤ (2 : ℤ) * k + (1 : ℤ) - p + ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : ℤ) * k ∧ -k ≤ p ∧ p ≤ k ∧ -((2 : ℤ) * k + (1 : ℤ) + - p) - (1 : ℤ) ≤ p ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p + (1 : ℤ) ∧ -((2 : ℤ) * k - ((2 : + ℤ) * k + (1 : ℤ) - p) + (1 : ℤ)) ≤ p ∧ p ≤ (2 : ℤ) * k - ((2 : ℤ) * k + (1 : ℤ) - p) + + (1 : ℤ)), ∀ (hW : (⟨p-1,2*k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile + K.1)), ∀ (hS : (⟨p,2*k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)), ∀ + (hPe : (⟨p+1-k,k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ + (hPn : (⟨p-k,k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ + (hearg : (⟨p,2*k+1-p⟩:GaussianInt)+1-d=⟨p+1-k,k-p⟩), ∀ (hnarg : + (⟨p,2*k+1-p⟩:GaussianInt)+⟨0,1⟩-d=⟨p-k,k+1-p⟩), ∀ (hcenterC : f ⟨p,2*k+1-p⟩ = + DiamondOdometer K ⟨p,2*k+1-p⟩), ∀ (hWval : f (⟨p,2*k+1-p⟩-1)=DiamondOdometer K + (⟨p,2*k+1-p⟩-1)), ∀ (hSval : f (⟨p,2*k+1-p⟩-⟨0,1⟩)=DiamondOdometer K + (⟨p,2*k+1-p⟩-⟨0,1⟩)), ∀ (hPval : ∀ (y : GaussianInt), ∀ (w : GaussianInt), (y-d ∈ + FootprintVertices pred.1) → ((y-d=w) → (f y = DiamondOdometer (⟨K.1-1,by + omega⟩) w + k*y.re+B))), ∀ (hPcenter : f ⟨p,2*k+1-p⟩ = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩ + k*p+B), ∀ (hPeval : f (⟨p,2*k+1-p⟩+1) = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩ + k*(p+1)+B), ∀ (hPnval : f + (⟨p,2*k+1-p⟩+⟨0,1⟩) = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩ + k*p+B), + let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + ∀ (qc : DiamondOdometer K ⟨p,2*k+1-p⟩=Q p (2*k+1-p)), ∀ (qw : DiamondOdometer K + ⟨p-1,2*k+1-p⟩=Q (p-1) (2*k+1-p)), ∀ (qs : DiamondOdometer K ⟨p,2*k-p⟩=Q p (2*k-p)), ∀ + (qe : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩=Q (p+1-k) (k-p)), ∀ (qn : + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩=Q (p-k) (k+1-p)), ∀ (tdiffRev : ∀ + (a : Int), (a-1)*(a-2)/2-a*(a-1)/2=1-a), ∀ (absP : (Int.natAbs p : Int)=p), ∀ + (absPm : (Int.natAbs (p-1) : Int)=p-1), ∀ (absKm : (Int.natAbs (p-k) : Int)=k-p), (Q + (p-k) (k-p)=(k-p)*(k-p-1)/2-(p-k)^2) → ((DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q + (p-k) (k-p)) → ((f ⟨p,2*k+1-p⟩=Q (p-k) (k-p)+k*p+B) → (((Int.natAbs (p+1-k) : Int)=if + p=k then 1 else k-p-1) → ((Q p ((2 : ℤ) * k + (1 : ℤ) - p) = p * (p - (1 : ℤ)) / (2 : + ℤ) - (p - k) * (p - k - (1 : ℤ))) → ((Q (p - (1 : ℤ)) ((2 : ℤ) * k + (1 : ℤ) - p) = + (p - (1 : ℤ)) * (p - (2 : ℤ)) / (2 : ℤ) - (p - k - (1 : ℤ)) ^ (2 : ℕ)) → ((Q p ((2 : + ℤ) * k - p) = p * (p - (1 : ℤ)) / (2 : ℤ) - (p - k) ^ (2 : ℕ)) → ((Q (p + (1 : ℤ) - + k) (k - p) = if p = k then (0 : ℤ) else (k - p - (1 : ℤ)) * (k - p - (2 : ℤ)) / (2 : + ℤ) - ((p - k) ^ (2 : ℕ) + (p - k))) → ((Q (p - k) (k + (1 : ℤ) - p) = (k - p) * (k - + p - (1 : ℤ)) / (2 : ℤ) - ((p - k - (1 : ℤ)) ^ (2 : ℕ) + (p - k - (1 : ℤ)))) → ((f + ⟨p,2*k+1-p⟩=Q p (2*k+1-p)) → (((⟨p,2*k+1-p⟩:GaussianInt)-1=⟨p-1,2*k+1-p⟩) → + (((⟨p,2*k+1-p⟩:GaussianInt)-⟨0,1⟩=⟨p,2*k-p⟩) → ((f (⟨p,2*k+1-p⟩-1)=Q (p-1) (2*k+1-p)) + → ((f (⟨p,2*k+1-p⟩-⟨0,1⟩)=Q p (2*k-p)) → ((f (⟨p,2*k+1-p⟩+1)=Q (p+1-k) + (k-p)+k*(p+1)+B) → ((f (⟨p,2*k+1-p⟩+⟨0,1⟩)=Q (p-k) (k+1-p)+k*p+B) → (f + (⟨p,2*k+1-p⟩+1)-f ⟨p,2*k+1-p⟩ = if p=k then k else k+1))))))))))))))))) := by + classical + intro K hk f B k d child pred p hcast hp1 hpk hz hpz hcover hdpred hdchild hW hS hPe hPn hearg + hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval Q qc qw qs qe qn tdiffRev absP + absPm absKm qpc hPcenterQ hPcval absKme hqc hqw hqs hqe hqn hcval hwcoord hscoord hwval + hsval heval hnval + rw [heval,hPcval,hqe,qpc] + by_cases hp : p=k + · subst p + simp + ring + · simp only [ite_eq_right hp] + have ht := tdiffRev (k-p) + nlinarith only [ht] + +private theorem hWdiff : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + ∀ (p : ℤ), + let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + (∀ (a : Int), (a-1)*(a-2)/2-a*(a-1)/2=1-a) → ((Q p ((2 : ℤ) * k + (1 : ℤ) - p) = p * (p - + (1 : ℤ)) / (2 : ℤ) - (p - k) * (p - k - (1 : ℤ))) → ((Q (p - (1 : ℤ)) ((2 : ℤ) * k + + (1 : ℤ) - p) = (p - (1 : ℤ)) * (p - (2 : ℤ)) / (2 : ℤ) - (p - k - (1 : ℤ)) ^ (2 : ℕ)) + → ((f ⟨p,2*k+1-p⟩=Q p (2*k+1-p)) → ((f (⟨p,2*k+1-p⟩-1)=Q (p-1) (2*k+1-p)) → (f + (⟨p,2*k+1-p⟩-1)-f ⟨p,2*k+1-p⟩ = -k))))) ) := by + classical + intro K f k p Q tdiffRev hqc hqw hcval hwval + rw [hwval,hcval,hqw,hqc] + calc + (p-1)*(p-2)/2-(p-k-1)^2-(p*(p-1)/2-(p-k)*(p-k-1)) = + ((p-1)*(p-2)/2-p*(p-1)/2)+(-(p-k-1)^2+(p-k)*(p-k-1)) := by ring + _ = (1-p)+(p-k-1) := by rw [tdiffRev p]; ring + _ = -k := by ring + +private theorem hNdiff : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), + let k : Int := K.1 + let d : GaussianInt := ⟨k,k+1⟩ + let child := P5352T2Sources K hk 0 + let pred := P5352T2Sources K hk 3 + ∀ (p : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), ∀ (hp1 : (1 : ℤ) ≤ p), ∀ + (hpk : p ≤ k), ∀ (hz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∈ FootprintVertices child.1), ∀ + (hpz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - d ∈ FootprintVertices pred.1), ∀ (hcover : ∀ + (y : GaussianInt), y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) + - p⟩ + (1 : GaussianInt) ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - (1 : GaussianInt) ∨ y + = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) + - p⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ FootprintVertices child.1 ∨ y - d ∈ FootprintVertices + pred.1), ∀ (hdpred : k < (2 : ℤ) * k + (1 : ℤ) - p ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : + ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ k ≤ p + (k - (1 : ℤ)) ∧ p ≤ k - (1 : ℤ) + k ∧ k + < p - k + (1 : ℤ) + ((2 : ℤ) * k + (1 : ℤ) - p) ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p - (k + + (1 : ℤ)) + (1 : ℤ) + k ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (1 : ℤ) + (p - k) + (2 : ℤ) * + (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ p ≤ (2 : ℤ) * (k - (1 : ℤ)) - ((2 : ℤ) * k + (1 : ℤ) + - p - (k + (1 : ℤ))) + (1 : ℤ) + k), ∀ (hdchild : (0 : ℤ) ≤ (2 : ℤ) * k + (1 : ℤ) - p + ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : ℤ) * k ∧ -k ≤ p ∧ p ≤ k ∧ -((2 : ℤ) * k + (1 : ℤ) + - p) - (1 : ℤ) ≤ p ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p + (1 : ℤ) ∧ -((2 : ℤ) * k - ((2 : + ℤ) * k + (1 : ℤ) - p) + (1 : ℤ)) ≤ p ∧ p ≤ (2 : ℤ) * k - ((2 : ℤ) * k + (1 : ℤ) - p) + + (1 : ℤ)), ∀ (hW : (⟨p-1,2*k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile + K.1)), ∀ (hS : (⟨p,2*k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)), ∀ + (hPe : (⟨p+1-k,k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ + (hPn : (⟨p-k,k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ + (hearg : (⟨p,2*k+1-p⟩:GaussianInt)+1-d=⟨p+1-k,k-p⟩), ∀ (hnarg : + (⟨p,2*k+1-p⟩:GaussianInt)+⟨0,1⟩-d=⟨p-k,k+1-p⟩), ∀ (hcenterC : f ⟨p,2*k+1-p⟩ = + DiamondOdometer K ⟨p,2*k+1-p⟩), ∀ (hWval : f (⟨p,2*k+1-p⟩-1)=DiamondOdometer K + (⟨p,2*k+1-p⟩-1)), ∀ (hSval : f (⟨p,2*k+1-p⟩-⟨0,1⟩)=DiamondOdometer K + (⟨p,2*k+1-p⟩-⟨0,1⟩)), ∀ (hPval : ∀ (y : GaussianInt), ∀ (w : GaussianInt), (y-d ∈ + FootprintVertices pred.1) → ((y-d=w) → (f y = DiamondOdometer (⟨K.1-1,by + omega⟩) w + k*y.re+B))), ∀ (hPcenter : f ⟨p,2*k+1-p⟩ = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩ + k*p+B), ∀ (hPeval : f (⟨p,2*k+1-p⟩+1) = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩ + k*(p+1)+B), ∀ (hPnval : f + (⟨p,2*k+1-p⟩+⟨0,1⟩) = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩ + k*p+B), + let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + ∀ (qc : DiamondOdometer K ⟨p,2*k+1-p⟩=Q p (2*k+1-p)), ∀ (qw : DiamondOdometer K + ⟨p-1,2*k+1-p⟩=Q (p-1) (2*k+1-p)), ∀ (qs : DiamondOdometer K ⟨p,2*k-p⟩=Q p (2*k-p)), ∀ + (qe : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩=Q (p+1-k) (k-p)), ∀ (qn : + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩=Q (p-k) (k+1-p)), ∀ (absP : + (Int.natAbs p : Int)=p), ∀ (absPm : (Int.natAbs (p-1) : Int)=p-1), ∀ (absKm : + (Int.natAbs (p-k) : Int)=k-p), (Q (p-k) (k-p)=(k-p)*(k-p-1)/2-(p-k)^2) → + ((DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q (p-k) (k-p)) → ((f ⟨p,2*k+1-p⟩=Q + (p-k) (k-p)+k*p+B) → (((Int.natAbs (p+1-k) : Int)=if p=k then 1 else k-p-1) → ((Q p + ((2 : ℤ) * k + (1 : ℤ) - p) = p * (p - (1 : ℤ)) / (2 : ℤ) - (p - k) * (p - k - (1 : + ℤ))) → ((Q (p - (1 : ℤ)) ((2 : ℤ) * k + (1 : ℤ) - p) = (p - (1 : ℤ)) * (p - (2 : ℤ)) + / (2 : ℤ) - (p - k - (1 : ℤ)) ^ (2 : ℕ)) → ((Q p ((2 : ℤ) * k - p) = p * (p - (1 : + ℤ)) / (2 : ℤ) - (p - k) ^ (2 : ℕ)) → ((Q (p + (1 : ℤ) - k) (k - p) = if p = k then (0 + : ℤ) else (k - p - (1 : ℤ)) * (k - p - (2 : ℤ)) / (2 : ℤ) - ((p - k) ^ (2 : ℕ) + (p - + k))) → ((Q (p - k) (k + (1 : ℤ) - p) = (k - p) * (k - p - (1 : ℤ)) / (2 : ℤ) - ((p - + k - (1 : ℤ)) ^ (2 : ℕ) + (p - k - (1 : ℤ)))) → ((f ⟨p,2*k+1-p⟩=Q p (2*k+1-p)) → + (((⟨p,2*k+1-p⟩:GaussianInt)-1=⟨p-1,2*k+1-p⟩) → + (((⟨p,2*k+1-p⟩:GaussianInt)-⟨0,1⟩=⟨p,2*k-p⟩) → ((f (⟨p,2*k+1-p⟩-1)=Q (p-1) (2*k+1-p)) + → ((f (⟨p,2*k+1-p⟩-⟨0,1⟩)=Q p (2*k-p)) → ((f (⟨p,2*k+1-p⟩+1)=Q (p+1-k) + (k-p)+k*(p+1)+B) → ((f (⟨p,2*k+1-p⟩+⟨0,1⟩)=Q (p-k) (k+1-p)+k*p+B) → ((f + (⟨p,2*k+1-p⟩+1)-f ⟨p,2*k+1-p⟩ = if p=k then k else k+1) → ((f (⟨p,2*k+1-p⟩-1)-f + ⟨p,2*k+1-p⟩ = -k) → (f (⟨p,2*k+1-p⟩+⟨0,1⟩)-f ⟨p,2*k+1-p⟩ = if p=k then 0 else + p-k))))))))))))))))))) := by + classical + intro K hk f B k d child pred p hcast hp1 hpk hz hpz hcover hdpred hdchild hW hS hPe hPn hearg + hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval Q qc qw qs qe qn absP absPm absKm + qpc hPcenterQ hPcval absKme hqc hqw hqs hqe hqn hcval hwcoord hscoord hwval hsval heval + hnval hE hWdiff + rw [hnval,hPcval,hqn,qpc] + by_cases hp : p=k + · subst p + simp + · simp only [ite_eq_right hp] + ring + +private theorem hSdiff : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), + let k : Int := K.1 + let d : GaussianInt := ⟨k,k+1⟩ + let child := P5352T2Sources K hk 0 + let pred := P5352T2Sources K hk 3 + ∀ (p : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), ∀ (hp1 : (1 : ℤ) ≤ p), ∀ + (hpk : p ≤ k), ∀ (hz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∈ FootprintVertices child.1), ∀ + (hpz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - d ∈ FootprintVertices pred.1), ∀ (hcover : ∀ + (y : GaussianInt), y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) + - p⟩ + (1 : GaussianInt) ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - (1 : GaussianInt) ∨ y + = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) + - p⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ FootprintVertices child.1 ∨ y - d ∈ FootprintVertices + pred.1), ∀ (hdpred : k < (2 : ℤ) * k + (1 : ℤ) - p ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : + ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ k ≤ p + (k - (1 : ℤ)) ∧ p ≤ k - (1 : ℤ) + k ∧ k + < p - k + (1 : ℤ) + ((2 : ℤ) * k + (1 : ℤ) - p) ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p - (k + + (1 : ℤ)) + (1 : ℤ) + k ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (1 : ℤ) + (p - k) + (2 : ℤ) * + (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ p ≤ (2 : ℤ) * (k - (1 : ℤ)) - ((2 : ℤ) * k + (1 : ℤ) + - p - (k + (1 : ℤ))) + (1 : ℤ) + k), ∀ (hdchild : (0 : ℤ) ≤ (2 : ℤ) * k + (1 : ℤ) - p + ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : ℤ) * k ∧ -k ≤ p ∧ p ≤ k ∧ -((2 : ℤ) * k + (1 : ℤ) + - p) - (1 : ℤ) ≤ p ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p + (1 : ℤ) ∧ -((2 : ℤ) * k - ((2 : + ℤ) * k + (1 : ℤ) - p) + (1 : ℤ)) ≤ p ∧ p ≤ (2 : ℤ) * k - ((2 : ℤ) * k + (1 : ℤ) - p) + + (1 : ℤ)), ∀ (hW : (⟨p-1,2*k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile + K.1)), ∀ (hS : (⟨p,2*k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)), ∀ + (hPe : (⟨p+1-k,k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ + (hPn : (⟨p-k,k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ + (hearg : (⟨p,2*k+1-p⟩:GaussianInt)+1-d=⟨p+1-k,k-p⟩), ∀ (hnarg : + (⟨p,2*k+1-p⟩:GaussianInt)+⟨0,1⟩-d=⟨p-k,k+1-p⟩), ∀ (hcenterC : f ⟨p,2*k+1-p⟩ = + DiamondOdometer K ⟨p,2*k+1-p⟩), ∀ (hWval : f (⟨p,2*k+1-p⟩-1)=DiamondOdometer K + (⟨p,2*k+1-p⟩-1)), ∀ (hSval : f (⟨p,2*k+1-p⟩-⟨0,1⟩)=DiamondOdometer K + (⟨p,2*k+1-p⟩-⟨0,1⟩)), ∀ (hPval : ∀ (y : GaussianInt), ∀ (w : GaussianInt), (y-d ∈ + FootprintVertices pred.1) → ((y-d=w) → (f y = DiamondOdometer (⟨K.1-1,by + omega⟩) w + k*y.re+B))), ∀ (hPcenter : f ⟨p,2*k+1-p⟩ = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩ + k*p+B), ∀ (hPeval : f (⟨p,2*k+1-p⟩+1) = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩ + k*(p+1)+B), ∀ (hPnval : f + (⟨p,2*k+1-p⟩+⟨0,1⟩) = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩ + k*p+B), + let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + ∀ (qc : DiamondOdometer K ⟨p,2*k+1-p⟩=Q p (2*k+1-p)), ∀ (qw : DiamondOdometer K + ⟨p-1,2*k+1-p⟩=Q (p-1) (2*k+1-p)), ∀ (qs : DiamondOdometer K ⟨p,2*k-p⟩=Q p (2*k-p)), ∀ + (qe : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩=Q (p+1-k) (k-p)), ∀ (qn : + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩=Q (p-k) (k+1-p)), ∀ (absP : + (Int.natAbs p : Int)=p), ∀ (absPm : (Int.natAbs (p-1) : Int)=p-1), ∀ (absKm : + (Int.natAbs (p-k) : Int)=k-p), (Q (p-k) (k-p)=(k-p)*(k-p-1)/2-(p-k)^2) → + ((DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q (p-k) (k-p)) → ((f ⟨p,2*k+1-p⟩=Q + (p-k) (k-p)+k*p+B) → (((Int.natAbs (p+1-k) : Int)=if p=k then 1 else k-p-1) → ((Q p + ((2 : ℤ) * k + (1 : ℤ) - p) = p * (p - (1 : ℤ)) / (2 : ℤ) - (p - k) * (p - k - (1 : + ℤ))) → ((Q (p - (1 : ℤ)) ((2 : ℤ) * k + (1 : ℤ) - p) = (p - (1 : ℤ)) * (p - (2 : ℤ)) + / (2 : ℤ) - (p - k - (1 : ℤ)) ^ (2 : ℕ)) → ((Q p ((2 : ℤ) * k - p) = p * (p - (1 : + ℤ)) / (2 : ℤ) - (p - k) ^ (2 : ℕ)) → ((Q (p + (1 : ℤ) - k) (k - p) = if p = k then (0 + : ℤ) else (k - p - (1 : ℤ)) * (k - p - (2 : ℤ)) / (2 : ℤ) - ((p - k) ^ (2 : ℕ) + (p - + k))) → ((Q (p - k) (k + (1 : ℤ) - p) = (k - p) * (k - p - (1 : ℤ)) / (2 : ℤ) - ((p - + k - (1 : ℤ)) ^ (2 : ℕ) + (p - k - (1 : ℤ)))) → ((f ⟨p,2*k+1-p⟩=Q p (2*k+1-p)) → + (((⟨p,2*k+1-p⟩:GaussianInt)-1=⟨p-1,2*k+1-p⟩) → + (((⟨p,2*k+1-p⟩:GaussianInt)-⟨0,1⟩=⟨p,2*k-p⟩) → ((f (⟨p,2*k+1-p⟩-1)=Q (p-1) (2*k+1-p)) + → ((f (⟨p,2*k+1-p⟩-⟨0,1⟩)=Q p (2*k-p)) → ((f (⟨p,2*k+1-p⟩+1)=Q (p+1-k) + (k-p)+k*(p+1)+B) → ((f (⟨p,2*k+1-p⟩+⟨0,1⟩)=Q (p-k) (k+1-p)+k*p+B) → ((f + (⟨p,2*k+1-p⟩+1)-f ⟨p,2*k+1-p⟩ = if p=k then k else k+1) → ((f (⟨p,2*k+1-p⟩-1)-f + ⟨p,2*k+1-p⟩ = -k) → ((f (⟨p,2*k+1-p⟩+⟨0,1⟩)-f ⟨p,2*k+1-p⟩ = if p=k then 0 else p-k) → + (f (⟨p,2*k+1-p⟩-⟨0,1⟩)-f ⟨p,2*k+1-p⟩ = if p=k then 0 else k-p)))))))))))))))))))) := by + classical + intro K hk f B k d child pred p hcast hp1 hpk hz hpz hcover hdpred hdchild hW hS hPe hPn hearg + hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval Q qc qw qs qe qn absP absPm absKm + qpc hPcenterQ hPcval absKme hqc hqw hqs hqe hqn hcval hwcoord hscoord hwval hsval heval + hnval hE hWdiff hNdiff + rw [hsval,hcval,hqs,hqc] + by_cases hp : p=k + · subst p + simp + · simp only [ite_eq_right hp] + ring + +private theorem hcompAt434 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), + let k : Int := K.1 + let d : GaussianInt := ⟨k,k+1⟩ + let r : GaussianInt := ⟨2*k,0⟩ + let child := P5352T2Sources K hk 0 + let pred := P5352T2Sources K hk 3 + ∀ (hchildTile : child.1 = DiamondTile K.1), ∀ (p : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) + = k - (1 : ℤ)), ∀ (hp1 : (1 : ℤ) ≤ p), ∀ (hpk : p ≤ k), ∀ (childMem : ∀ (a : Int), ∀ + (b : Int), (0≤b) → ((b≤2*k) → ((-k≤a) → ((a≤k) → ((-b-1≤a) → ((a≤b+1) → + ((-(2*k-b+1)≤a) → ((a≤2*k-b+1) → ((⟨a,b⟩ : GaussianInt) ∈ FootprintVertices + (DiamondTile K.1)))))))))), ∀ (hz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∈ + FootprintVertices child.1), ∀ (hpz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - d ∈ + FootprintVertices pred.1), ∀ (hcover : ∀ (y : GaussianInt), y = ⟨p, (2 : ℤ) * k + (1 + : ℤ) - p⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ + (1 : GaussianInt) ∨ y = ⟨p, (2 : ℤ) + * k + (1 : ℤ) - p⟩ - (1 : GaussianInt) ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ + ⟨(0 : + ℤ), (1 : ℤ)⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ + FootprintVertices child.1 ∨ y - d ∈ FootprintVertices pred.1), ∀ (hdpred : k < (2 : + ℤ) * k + (1 : ℤ) - p ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 + : ℤ)) ∧ k ≤ p + (k - (1 : ℤ)) ∧ p ≤ k - (1 : ℤ) + k ∧ k < p - k + (1 : ℤ) + ((2 : ℤ) + * k + (1 : ℤ) - p) ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p - (k + (1 : ℤ)) + (1 : ℤ) + k ∧ (2 + : ℤ) * k + (1 : ℤ) - p ≤ (1 : ℤ) + (p - k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) + ∧ p ≤ (2 : ℤ) * (k - (1 : ℤ)) - ((2 : ℤ) * k + (1 : ℤ) - p - (k + (1 : ℤ))) + (1 : ℤ) + + k), ∀ (hdchild : (0 : ℤ) ≤ (2 : ℤ) * k + (1 : ℤ) - p ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ + (2 : ℤ) * k ∧ -k ≤ p ∧ p ≤ k ∧ -((2 : ℤ) * k + (1 : ℤ) - p) - (1 : ℤ) ≤ p ∧ p ≤ (2 : + ℤ) * k + (1 : ℤ) - p + (1 : ℤ) ∧ -((2 : ℤ) * k - ((2 : ℤ) * k + (1 : ℤ) - p) + (1 : + ℤ)) ≤ p ∧ p ≤ (2 : ℤ) * k - ((2 : ℤ) * k + (1 : ℤ) - p) + (1 : ℤ)), ∀ (hW : + (⟨p-1,2*k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)), ∀ (hS : + (⟨p,2*k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)), ∀ (hPe : + (⟨p+1-k,k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ (hPn : + (⟨p-k,k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ (hearg + : (⟨p,2*k+1-p⟩:GaussianInt)+1-d=⟨p+1-k,k-p⟩), ∀ (hnarg : + (⟨p,2*k+1-p⟩:GaussianInt)+⟨0,1⟩-d=⟨p-k,k+1-p⟩), ∀ (hcenterC : f ⟨p,2*k+1-p⟩ = + DiamondOdometer K ⟨p,2*k+1-p⟩), ∀ (hWval : f (⟨p,2*k+1-p⟩-1)=DiamondOdometer K + (⟨p,2*k+1-p⟩-1)), ∀ (hSval : f (⟨p,2*k+1-p⟩-⟨0,1⟩)=DiamondOdometer K + (⟨p,2*k+1-p⟩-⟨0,1⟩)), ∀ (hPval : ∀ (y : GaussianInt), ∀ (w : GaussianInt), (y-d ∈ + FootprintVertices pred.1) → ((y-d=w) → (f y = DiamondOdometer (⟨K.1-1,by + omega⟩) w + k*y.re+B))), ∀ (hPcenter : f ⟨p,2*k+1-p⟩ = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩ + k*p+B), ∀ (hPeval : f (⟨p,2*k+1-p⟩+1) = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩ + k*(p+1)+B), ∀ (hPnval : f + (⟨p,2*k+1-p⟩+⟨0,1⟩) = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩ + k*p+B), + let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + ∀ (qc : DiamondOdometer K ⟨p,2*k+1-p⟩=Q p (2*k+1-p)), ∀ (qw : DiamondOdometer K + ⟨p-1,2*k+1-p⟩=Q (p-1) (2*k+1-p)), ∀ (qs : DiamondOdometer K ⟨p,2*k-p⟩=Q p (2*k-p)), ∀ + (qe : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩=Q (p+1-k) (k-p)), ∀ (qn : + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩=Q (p-k) (k+1-p)), ∀ (absP : + (Int.natAbs p : Int)=p), ∀ (absPm : (Int.natAbs (p-1) : Int)=p-1), ∀ (absKm : + (Int.natAbs (p-k) : Int)=k-p), (Q (p-k) (k-p)=(k-p)*(k-p-1)/2-(p-k)^2) → + ((DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q (p-k) (k-p)) → ((f ⟨p,2*k+1-p⟩=Q + (p-k) (k-p)+k*p+B) → (((Int.natAbs (p+1-k) : Int)=if p=k then 1 else k-p-1) → ((Q p + ((2 : ℤ) * k + (1 : ℤ) - p) = p * (p - (1 : ℤ)) / (2 : ℤ) - (p - k) * (p - k - (1 : + ℤ))) → ((Q (p - (1 : ℤ)) ((2 : ℤ) * k + (1 : ℤ) - p) = (p - (1 : ℤ)) * (p - (2 : ℤ)) + / (2 : ℤ) - (p - k - (1 : ℤ)) ^ (2 : ℕ)) → ((Q p ((2 : ℤ) * k - p) = p * (p - (1 : + ℤ)) / (2 : ℤ) - (p - k) ^ (2 : ℕ)) → ((Q (p + (1 : ℤ) - k) (k - p) = if p = k then (0 + : ℤ) else (k - p - (1 : ℤ)) * (k - p - (2 : ℤ)) / (2 : ℤ) - ((p - k) ^ (2 : ℕ) + (p - + k))) → ((Q (p - k) (k + (1 : ℤ) - p) = (k - p) * (k - p - (1 : ℤ)) / (2 : ℤ) - ((p - + k - (1 : ℤ)) ^ (2 : ℕ) + (p - k - (1 : ℤ)))) → ((f ⟨p,2*k+1-p⟩=Q p (2*k+1-p)) → + (((⟨p,2*k+1-p⟩:GaussianInt)-1=⟨p-1,2*k+1-p⟩) → + (((⟨p,2*k+1-p⟩:GaussianInt)-⟨0,1⟩=⟨p,2*k-p⟩) → ((f (⟨p,2*k+1-p⟩-1)=Q (p-1) (2*k+1-p)) + → ((f (⟨p,2*k+1-p⟩-⟨0,1⟩)=Q p (2*k-p)) → ((f (⟨p,2*k+1-p⟩+1)=Q (p+1-k) + (k-p)+k*(p+1)+B) → ((f (⟨p,2*k+1-p⟩+⟨0,1⟩)=Q (p-k) (k+1-p)+k*p+B) → ((f + (⟨p,2*k+1-p⟩+1)-f ⟨p,2*k+1-p⟩ = if p=k then k else k+1) → ((f (⟨p,2*k+1-p⟩-1)-f + ⟨p,2*k+1-p⟩ = -k) → ((f (⟨p,2*k+1-p⟩+⟨0,1⟩)-f ⟨p,2*k+1-p⟩ = if p=k then 0 else p-k) → + ((f (⟨p,2*k+1-p⟩-⟨0,1⟩)-f ⟨p,2*k+1-p⟩ = if p=k then 0 else k-p) → + ((⟨p,2*k+1-p⟩:GaussianInt)-r ∈ FootprintVertices child.1 ↔ p=k))))))))))))))))))))) + := by + classical + intro K hk f B k d r child pred hchildTile p hcast hp1 hpk childMem hz hpz hcover hdpred + hdchild hW hS hPe hPn hearg hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval Q qc qw + qs qe qn absP absPm absKm qpc hPcenterQ hPcval absKme hqc hqw hqs hqe hqn hcval hwcoord + hscoord hwval hsval heval hnval hE hWdiff hNdiff hSdiff + constructor + · intro hh + have hb := (P5352T2DomainRows K ((⟨p,2*k+1-p⟩:GaussianInt)-r)).1.mp (hchildTile ▸ hh) + simp [r] at hb + omega + · intro hp + subst p + have he : (⟨k,k+1⟩:GaussianInt)-r=⟨-k,k+1⟩ := by ext <;> simp [r]; ring + have hc : (⟨k,2*k+1-k⟩:GaussianInt)=⟨k,k+1⟩ := by ext <;> simp; omega + have heFull : (⟨k,2*k+1-k⟩:GaussianInt)-r=⟨-k,k+1⟩ := by rw [hc,he] + have hm := childMem (-k) (k+1) (by omega) (by omega) (by omega) (by omega) + (by omega) (by omega) (by omega) (by omega) + have hm' : (⟨-k,k+1⟩:GaussianInt) ∈ FootprintVertices child.1 := by + rw [hchildTile] + exact hm + rw [heFull] + exact hm' + +private theorem hlap0 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), (∀ (g : + IntegerLatticeFunction), ∀ (x : GaussianInt), FourNeighborLaplacian g x = (g (x+1)-g + x)+(g (x-1)-g x)+ (g (x+⟨0,1⟩)-g x)+(g (x-⟨0,1⟩)-g x)) → ( + let k : Int := K.1 + ∀ (p : ℤ), (f (⟨p,2*k+1-p⟩+1)-f ⟨p,2*k+1-p⟩ = if p=k then k else k+1) → ((f + (⟨p,2*k+1-p⟩-1)-f ⟨p,2*k+1-p⟩ = -k) → ((f (⟨p,2*k+1-p⟩+⟨0,1⟩)-f ⟨p,2*k+1-p⟩ = if p=k + then 0 else p-k) → ((f (⟨p,2*k+1-p⟩-⟨0,1⟩)-f ⟨p,2*k+1-p⟩ = if p=k then 0 else k-p) → + (p = k → FourNeighborLaplacian f ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ = (0 : ℤ)))))) ) := by + classical + intro K f lap_identity k p hE hWdiff hNdiff hSdiff hp + rw [lap_identity,hE,hWdiff,hNdiff,hSdiff] + simp [hp] + +private theorem hlap1 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), (∀ (g : + IntegerLatticeFunction), ∀ (x : GaussianInt), FourNeighborLaplacian g x = (g (x+1)-g + x)+(g (x-1)-g x)+ (g (x+⟨0,1⟩)-g x)+(g (x-⟨0,1⟩)-g x)) → ( + let k : Int := K.1 + ∀ (p : ℤ), (f (⟨p,2*k+1-p⟩+1)-f ⟨p,2*k+1-p⟩ = if p=k then k else k+1) → ((f + (⟨p,2*k+1-p⟩-1)-f ⟨p,2*k+1-p⟩ = -k) → ((f (⟨p,2*k+1-p⟩+⟨0,1⟩)-f ⟨p,2*k+1-p⟩ = if p=k + then 0 else p-k) → ((f (⟨p,2*k+1-p⟩-⟨0,1⟩)-f ⟨p,2*k+1-p⟩ = if p=k then 0 else k-p) → + (p ≠ k → FourNeighborLaplacian f ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ = (1 : ℤ)))))) ) := by + classical + intro K f lap_identity k p hE hWdiff hNdiff hSdiff hp + rw [lap_identity,hE,hWdiff,hNdiff,hSdiff] + simp [hp]; ring + +end FirstPredecessorProof + +theorem P5352T2Predecessor1 (K : DiamondParameter) (hk : 1 < K.1) + (f : IntegerLatticeFunction) (B : Int) (z : GaussianInt) : + let A := P5352T2Sources K hk 0 + let D := P5352T2Sources K hk 3 + let M := (P5352T2PlacementData K.1 2).2 1 + (∀ y, y ∈ FootprintVertices A.1 → f y = A.2.1 y) → + (∀ y, y - M.1 ∈ FootprintVertices D.1 → + f y = D.2.1 (y - M.1) + M.2.1.re*y.re + M.2.1.im*y.im + B) → + z ∈ FootprintVertices A.1 → z - M.1 ∈ FootprintVertices D.1 → + (∀ y, y = z ∨ y = z + 1 ∨ y = z - 1 ∨ + y = z + ⟨0, 1⟩ ∨ y = z - ⟨0, 1⟩ → + y ∈ FootprintVertices A.1 ∨ y - M.1 ∈ FootprintVertices D.1) → + (z - M.2.2 ∈ FootprintVertices A.1 → FourNeighborLaplacian f z = 0) ∧ + (z - M.2.2 ∉ FootprintVertices A.1 → FourNeighborLaplacian f z = 1) := by +-- BODY + exact (by + classical + have lap_identity (g : IntegerLatticeFunction) (x : GaussianInt) := + FirstPredecessorProof.lap_identity g x + let k : Int := K.1 + let d : GaussianInt := ⟨k,k+1⟩ + let r : GaussianInt := ⟨2*k,0⟩ + let child := P5352T2Sources K hk 0 + let pred := P5352T2Sources K hk 3 + let M := (P5352T2PlacementData K.1 2).2 1 + have hkI : 2 ≤ k := by dsimp [k]; exact_mod_cast (show 2 ≤ K.1 by omega) + have hm : M.1 = d ∧ M.2.1 = ⟨k,0⟩ ∧ M.2.2 = r := by + simp [M, d, r, P5352T2PlacementData, k] + rcases hm with ⟨hdisp,hcoeff,hr⟩ + have hchildTile : child.1 = DiamondTile K.1 := by simp [child,P5352T2Sources] + change + (∀ y, y ∈ FootprintVertices child.1 → f y = child.2.1 y) → + (∀ y, y - M.1 ∈ FootprintVertices pred.1 → + f y = pred.2.1 (y-M.1)+M.2.1.re*y.re+M.2.1.im*y.im+B) → + z ∈ FootprintVertices child.1 → z-M.1 ∈ FootprintVertices pred.1 → + (∀ y, y=z ∨ y=z+1 ∨ y=z-1 ∨ y=z+⟨0,1⟩ ∨ y=z-⟨0,1⟩ → + y ∈ FootprintVertices child.1 ∨ y-M.1 ∈ FootprintVertices pred.1) → + (z-M.2.2 ∈ FootprintVertices child.1 → FourNeighborLaplacian f z=0) ∧ + (z-M.2.2 ∉ FootprintVertices child.1 → FourNeighborLaplacian f z=1) + intro hchild hpred hz hpz hcover + rw [hdisp,hcoeff] at hpred + rw [hdisp] at hpz hcover + rw [hr] at ⊢ + have hdchild := (P5352T2DomainRows K z).1.mp hz + have hdpred := (P5352T2DomainRows ⟨K.1-1,by omega⟩ (z-d)).1.mp hpz + rcases z with ⟨p,q⟩ + simp? [d] at hdpred + have hcast : ((K.1-1 : Nat) : Int)=k-1 := by dsimp [k]; omega + rw [hcast] at hdpred + change (0≤q ∧ q≤2*k ∧ -k≤p ∧ p≤k ∧ -q-1≤p ∧ p≤q+1 ∧ + -(2*k-q+1)≤p ∧ p≤2*k-q+1) at hdchild + have hloc : 1≤p ∧ p≤k ∧ (q=2*k-p ∨ q=2*k+1-p) := by omega + rcases hloc with ⟨hp1,hpk,hq⟩ + have childMem (a b : Int) + (hb0 : 0≤b) (hb1 : b≤2*k) (ha0 : -k≤a) (ha1 : a≤k) + (hs0 : -b-1≤a) (hs1 : a≤b+1) + (ht0 : -(2*k-b+1)≤a) (ht1 : a≤2*k-b+1) : + (⟨a,b⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := + (P5352T2DomainRows K ⟨a,b⟩).1.mpr ⟨hb0,hb1,ha0,ha1,hs0,hs1,ht0,ht1⟩ + have predMem (a b : Int) + (hb0 : 0≤b) (hb1 : b≤2*(k-1)) (ha0 : -(k-1)≤a) (ha1 : a≤k-1) + (hs0 : -b-1≤a) (hs1 : a≤b+1) + (ht0 : -(2*(k-1)-b+1)≤a) (ht1 : a≤2*(k-1)-b+1) := FirstPredecessorProof.predMem K hk p q + hcast a b hb0 hb1 ha0 ha1 hs0 hs1 ht0 ht1 + rcases hq with hqB | hqA + · subst q + have hplt : p clear * - hp1 hplt hkI <;> omega + have hW : (⟨p-1,2*k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := by + apply childMem <;> clear * - hp1 hplt hkI <;> omega + have hN : (⟨p,2*k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := by + apply childMem <;> clear * - hp1 hplt hkI <;> omega + have hS : (⟨p,2*k-p-1⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := by + apply childMem <;> clear * - hp1 hplt hkI <;> omega + have hcenter : f ⟨p,2*k-p⟩ = DiamondOdometer K ⟨p,2*k-p⟩ := FirstPredecessorProof.hcenter K + hk f hchild p hz + have hEval (w : GaussianInt) (hw : w ∈ FootprintVertices (DiamondTile K.1)) := + FirstPredecessorProof.hEval K hk f hchildTile hchild w hw + have hdom := FirstPredecessorProof.hdom K hk hchildTile p hz + have hnot := FirstPredecessorProof.hnot K f p hcast hp1 hdpred + have htable := (DiamondLaplacianTable K).2.1 ⟨p,2*k-p⟩ hdom hnot + have hvE : f (⟨p,2*k-p⟩+1)=DiamondOdometer K (⟨p,2*k-p⟩+1) := FirstPredecessorProof.hvE K f + p hE hEval + have hvW : f (⟨p,2*k-p⟩-1)=DiamondOdometer K (⟨p,2*k-p⟩-1) := FirstPredecessorProof.hvW K f + p hW hEval + have hvN : f (⟨p,2*k-p⟩+⟨0,1⟩)=DiamondOdometer K (⟨p,2*k-p⟩+⟨0,1⟩) := + FirstPredecessorProof.hvN K f p hN hEval + have hvS : f (⟨p,2*k-p⟩-⟨0,1⟩)=DiamondOdometer K (⟨p,2*k-p⟩-⟨0,1⟩) := + FirstPredecessorProof.hvS K f p hS hEval + have hcomp := FirstPredecessorProof.hcompAt229 K hk f hchildTile p hcast hdpred + refine ⟨fun hc => (hcomp hc).elim, ?_⟩ + intro _ + rw [FourNeighborLaplacian,hvE,hvW,hvN,hvS,hcenter] + exact htable + · subst q + -- Marked staircase: east and north come from the predecessor, west and south from the child. + have hW : (⟨p-1,2*k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := by + apply childMem <;> clear * - hp1 hpk hkI <;> omega + have hS : (⟨p,2*k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := by + apply childMem <;> clear * - hp1 hpk hkI <;> omega + have hPe : (⟨p+1-k,k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1)) := by + apply predMem <;> clear * - hp1 hpk hkI <;> omega + have hPn : (⟨p-k,k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1)) := by + apply predMem <;> clear * - hp1 hpk hkI <;> omega + have hearg : (⟨p,2*k+1-p⟩:GaussianInt)+1-d=⟨p+1-k,k-p⟩ := by ext <;> simp [d]; ring + have hnarg : (⟨p,2*k+1-p⟩:GaussianInt)+⟨0,1⟩-d=⟨p-k,k+1-p⟩ := by ext <;> simp [d]; ring + have hcenterC := FirstPredecessorProof.hcenterC K hk f hchild p hz + have hWval := FirstPredecessorProof.hWval K hk f hchildTile hchild p hW + have hSval := FirstPredecessorProof.hSval K hk f hchildTile hchild p hS + have hPval (y : GaussianInt) (w : GaussianInt) + (hy : y-d ∈ FootprintVertices pred.1) (heq : y-d=w) := FirstPredecessorProof.hPval K + hk f B hpred p hcast y w hy heq + have hPcenter : f ⟨p,2*k+1-p⟩ = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩ + k*p+B := FirstPredecessorProof.hPcenter + K hk f B p hcast hpz hPval + have hPeval : f (⟨p,2*k+1-p⟩+1) = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩ + k*(p+1)+B := + FirstPredecessorProof.hPeval K hk f B p hcast hPe hearg hPval + have hPnval : f (⟨p,2*k+1-p⟩+⟨0,1⟩) = + DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩ + k*p+B := FirstPredecessorProof.hPnval + K hk f B p hcast hPn hnarg hPval + -- The closed-form restriction turns the four source values into floor-polynomial values. + let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + have qc : DiamondOdometer K ⟨p,2*k+1-p⟩=Q p (2*k+1-p) := by + simpa [Q] using (P5352T2DomainRows K ⟨p,2*k+1-p⟩).2 (hchildTile ▸ (by simpa + [child,P5352T2Sources] using hz)) + have qw : DiamondOdometer K ⟨p-1,2*k+1-p⟩=Q (p-1) (2*k+1-p) := by + simpa [Q] using (P5352T2DomainRows K ⟨p-1,2*k+1-p⟩).2 (hchildTile ▸ hW) + have qs : DiamondOdometer K ⟨p,2*k-p⟩=Q p (2*k-p) := by + simpa [Q] using (P5352T2DomainRows K ⟨p,2*k-p⟩).2 (hchildTile ▸ hS) + have qe : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩=Q (p+1-k) (k-p) := by + simpa [Q] using (P5352T2DomainRows ⟨K.1-1,by omega⟩ ⟨p+1-k,k-p⟩).2 hPe + have qn : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩=Q (p-k) (k+1-p) := by + simpa [Q] using (P5352T2DomainRows ⟨K.1-1,by omega⟩ ⟨p-k,k+1-p⟩).2 hPn + -- The exact four increments follow by reducing the even and odd squares. + have sqEven (m : Int) := FirstPredecessorProof.sqEven m + have sqOdd (m : Int) := FirstPredecessorProof.sqOdd K hk f B p hcast m + have tri (a : Int) := FirstPredecessorProof.tri K hk f B p hcast a + have tdiff (a : Int) := FirstPredecessorProof.tdiff K hk f B + p hcast tri a + have tdiffRev (a : Int) := FirstPredecessorProof.tdiffRev K + hk f B p hcast tdiff a + have absP : (Int.natAbs p : Int)=p := by rw [Int.natCast_natAbs,abs_of_nonneg (by omega)] + have absPm : (Int.natAbs (p-1) : Int)=p-1 := by rw [Int.natCast_natAbs,abs_of_nonneg (by + omega)] + have absKm : (Int.natAbs (p-k) : Int)=k-p := by + rw [Int.natCast_natAbs,abs_of_nonpos (by omega)]; omega + have qpc := FirstPredecessorProof.qpc K p sqEven absKm + have hPcenterQ : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q (p-k) (k-p) := + FirstPredecessorProof.hPcenterQ K hk f B p hcast hpz absP absPm absKm + have hPcval : f ⟨p,2*k+1-p⟩=Q (p-k) (k-p)+k*p+B := by + rw [hPcenter,hPcenterQ] + have absKme := FirstPredecessorProof.absKme K hk f B p hcast hp1 hpk hz hpz hcover hdpred + hdchild hW + hS hPe hPn hearg hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval qc qw qs qe qn + absP absPm absKm qpc hPcenterQ hPcval + have hqvals := FirstPredecessorProof.hqvals K p + sqEven sqOdd absP absPm absKm absKme + rcases hqvals with ⟨hqc,hqw,hqs,hqe,hqn⟩ + have hcval := FirstPredecessorProof.hcval K f p hcenterC qc + have hwcoord : (⟨p,2*k+1-p⟩:GaussianInt)-1=⟨p-1,2*k+1-p⟩ := by ext <;> simp + have hscoord : (⟨p,2*k+1-p⟩:GaussianInt)-⟨0,1⟩=⟨p,2*k-p⟩ := by ext <;> simp; omega + have hwval := FirstPredecessorProof.hwval K f p hWval + qw hwcoord + have hsval := FirstPredecessorProof.hsval K f p hSval + qs hscoord + have heval : f (⟨p,2*k+1-p⟩+1)=Q (p+1-k) (k-p)+k*(p+1)+B := by simpa [qe] using hPeval + have hnval : f (⟨p,2*k+1-p⟩+⟨0,1⟩)=Q (p-k) (k+1-p)+k*p+B := by simpa [qn] using hPnval + have hE := FirstPredecessorProof.hEAt404 K hk f B p hcast hp1 hpk hz hpz hcover hdpred + hdchild hW + hS hPe hPn hearg hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval qc qw qs qe qn + tdiffRev absP absPm absKm qpc hPcenterQ hPcval absKme hqc hqw hqs hqe hqn hcval hwcoord + hscoord hwval hsval heval hnval + have hWdiff := FirstPredecessorProof.hWdiff K f p + tdiffRev hqc hqw hcval hwval + have hNdiff := FirstPredecessorProof.hNdiff K hk f B p hcast hp1 hpk hz hpz hcover hdpred + hdchild hW + hS hPe hPn hearg hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval qc qw qs qe qn + absP absPm absKm qpc hPcenterQ hPcval absKme hqc hqw hqs hqe hqn hcval hwcoord hscoord + hwval hsval heval hnval hE hWdiff + have hSdiff := FirstPredecessorProof.hSdiff K hk f B p hcast hp1 hpk hz hpz hcover hdpred + hdchild hW + hS hPe hPn hearg hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval qc qw qs qe qn + absP absPm absKm qpc hPcenterQ hPcval absKme hqc hqw hqs hqe hqn hcval hwcoord hscoord + hwval hsval heval hnval hE hWdiff hNdiff + have hcomp := FirstPredecessorProof.hcompAt434 K hk f B hchildTile p hcast hp1 hpk childMem + hz hpz + hcover hdpred hdchild hW hS hPe hPn hearg hnarg hcenterC hWval hSval hPval hPcenter + hPeval hPnval qc qw qs qe qn absP absPm absKm qpc hPcenterQ hPcval absKme hqc hqw hqs + hqe hqn hcval hwcoord hscoord hwval hsval heval hnval hE hWdiff hNdiff hSdiff + have hlap0 (hp : p=k) := FirstPredecessorProof.hlap0 K f lap_identity p hE hWdiff hNdiff + hSdiff hp + have hlap1 (hp : p≠k) := FirstPredecessorProof.hlap1 K f lap_identity p hE hWdiff hNdiff + hSdiff hp + refine ⟨?_, ?_⟩ + · intro hh + have hp : p=k := hcomp.mp (hchildTile ▸ hh) + exact hlap0 hp + · intro hh + have hp : p≠k := by intro he; apply hh; exact hchildTile.symm ▸ hcomp.mpr he + exact hlap1 hp + ) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean new file mode 100644 index 0000000000..d4c4a5f0fd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean @@ -0,0 +1,1133 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData +public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic +public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable + +-- [TABLET NODE: P5352T2Predecessor2] + +/-! +# P5352T2Predecessor2 + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SecondPredecessorProof + +private theorem lap_identity : + (by + classical + exact + ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), FourNeighborLaplacian g x = g (x + + (1 : GaussianInt)) - g x + (g (x - (1 : GaussianInt)) - g x) + (g (x + ⟨(0 : ℤ), (1 : + ℤ)⟩) - g x) + (g (x - ⟨(0 : ℤ), (1 : ℤ)⟩) - g x) ) := by + classical + intro g x + unfold FourNeighborLaplacian + ring + +private theorem childValue : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), + let child := P5352T2Sources K hk 0 + (∀ y ∈ FootprintVertices child.1, f y = child.2.1 y) → ( + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + ∀ w ∈ FootprintVertices (DiamondTile K.1), f w = Q w.re w.im) ) := by + classical + intro K hk f child hchild Q w hw + have hw' : w∈FootprintVertices child.1 := by simpa [child,P5352T2Sources] using hw + rw [hchild w hw'] + simpa [Q,child,P5352T2Sources] using (P5352T2DomainRows K w).2 hw + +private theorem childOdometer : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), + let child := P5352T2Sources K hk 0 + (∀ y ∈ FootprintVertices child.1, f y = child.2.1 y) → (∀ w ∈ FootprintVertices + (DiamondTile K.1), f w = DiamondOdometer K w) ) := by + classical + intro K hk f child hchild w hw + have hw' : w∈FootprintVertices child.1 := by simpa [child,P5352T2Sources] using hw + simpa [child,P5352T2Sources] using hchild w hw' + +private theorem predFoot : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (ℤ) → ((ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (∀ (w : GaussianInt), (0 : ℤ) ≤ + w.im ∧ w.im ≤ (2 : ℤ) * (k - (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ w.re ∧ w.re ≤ k - (1 : ℤ) ∧ + -w.im - (1 : ℤ) ≤ w.re ∧ w.re ≤ w.im + (1 : ℤ) ∧ -((2 : ℤ) * (k - (1 : ℤ)) - w.im + + (1 : ℤ)) ≤ w.re ∧ w.re ≤ (2 : ℤ) * (k - (1 : ℤ)) - w.im + (1 : ℤ) → w ∈ + FootprintVertices (DiamondTile (K.1 - (1 : ℕ))))))) ) := by + classical + intro K hk k a b hcast w hw + apply (P5352T2DomainRows ⟨K.1-1,by omega⟩ w).1.mpr + simpa [hcast] using hw + +private theorem predValue : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + ∀ (w : GaussianInt), (w∈FootprintVertices (DiamondTile (K.1-1))) → (DiamondOdometer + ⟨K.1-1,by omega⟩ w=Q w.re w.im)) := by + classical + intro K hk k a b hcast Q w hw + simpa [Q] using (P5352T2DomainRows ⟨K.1-1,by omega⟩ w).2 hw + +private theorem predTranslatedValue : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), + let k : Int := K.1 + let d : GaussianInt := ⟨-k,k+1⟩ + let pred := P5352T2Sources K hk 3 + ∀ (hpred : ∀ (y : GaussianInt), y - d ∈ FootprintVertices pred.1 → f y = pred.2.1 (y - d) + + (⟨(1 : ℤ), -k⟩ : GaussianInt).re * y.re + (⟨(1 : ℤ), -k⟩ : GaussianInt).im * y.im + + B), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + (∀ (w : GaussianInt), (w∈FootprintVertices (DiamondTile (K.1-1))) → (DiamondOdometer + ⟨K.1-1,by omega⟩ w=Q w.re w.im)) → (∀ (y : GaussianInt), y - d ∈ FootprintVertices + (DiamondTile (K.1 - (1 : ℕ))) → f y = Q (y - d).re (y - d).im + y.re - k * y.im + B)) + := by + classical + intro K hk f B k d pred hpred a b hcast Q predValue y hy + have hp : y-d∈FootprintVertices pred.1 := by + simpa [pred,P5352T2Sources] using hy + have heq := hpred y hp + have hv := predValue (y-d) hy + have heq' : f y = DiamondOdometer ⟨K.1-1,by omega⟩ (y-d) + y.re-k*y.im+B := by + simpa [pred,P5352T2Sources,sub_eq_add_neg] using heq + rw [hv] at heq' + simpa [d,sub_eq_add_neg] using heq' + +private theorem tri : + (by + classical + exact + (DiamondParameter) → ((ℤ) → ((ℤ) → ( + let T : Int → Int := fun n => n*(n-1)/2 + ∀ (n : ℤ), (2 : ℤ) * T n = n * (n - (1 : ℤ))))) ) := by + classical + intro K a b T n + dsimp [T] + rcases Int.emod_two_eq_zero_or_one n with h|h + · have hn : n=2*(n/2) := by omega + rw [hn] + have he : 2*(n/2)*(2*(n/2)-1)=2*((n/2)*(2*(n/2)-1)) := by ring + rw [he,Int.mul_ediv_cancel_left _ (by norm_num : (2:Int)≠0)] + · have hn : n=2*(n/2)+1 := by omega + rw [hn] + have he : (2*(n/2)+1)*(2*(n/2)+1-1)= + 2*((2*(n/2)+1)*(n/2)) := by ring + rw [he,Int.mul_ediv_cancel_left _ (by norm_num : (2:Int)≠0)] + +private theorem tdiff : + (by + classical + exact + (DiamondParameter) → ((ℤ) → ((ℤ) → ( + let T : Int → Int := fun n => n*(n-1)/2 + (∀ (n : Int), 2*T n=n*(n-1)) → (∀ (n : ℤ), T n - T (n - (1 : ℤ)) = n - (1 : ℤ))))) ) := by + classical + intro K a b T tri n + have h1 := tri n + have h2 := tri (n-1) + have h : 2 * (T n - T (n - 1)) = 2 * (n - 1) := by + rw [mul_sub,h1,h2] + ring + omega + +private theorem tdiffRev : + (by + classical + exact + (DiamondParameter) → ((ℤ) → ((ℤ) → ( + let T : Int → Int := fun n => n*(n-1)/2 + (∀ (n : Int), T n - T (n - 1) = n - 1) → (∀ (n : ℤ), T (n - (1 : ℤ)) - T n = (1 : ℤ) - + n)))) ) := by + classical + intro K a b T tdiff n + have h := tdiff n + omega + +private theorem floorEven : + (by + classical + exact + ∀ (m : ℤ), ((2 : ℤ) * m) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) ) := by + classical + intro m + have h := P4207T1FloorArithmetic.1 0 m + simpa using h + +private theorem floorOdd : + (by + classical + exact + (DiamondParameter) → ((ℤ) → ((ℤ) → (∀ (m : ℤ), ((2 : ℤ) * m + (1 : ℤ)) ^ (2 : ℕ) / (4 : + ℤ) = m ^ (2 : ℕ) + m))) ) := by + classical + intro K a b m + have h := P4207T1FloorArithmetic.1 1 m + have he : 1+2*m=2*m+1 := by ring + rw [he] at h + norm_num at h ⊢ + omega + +private theorem ht : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : + ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : + ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → (((↑(K.1 - (1 : ℕ)) : + ℤ) = k - (1 : ℤ)) → (((0 : ℤ) ≤ b ∧ b ≤ (2 : ℤ) * k ∧ -k ≤ a ∧ a ≤ k ∧ -b - (1 : ℤ) ≤ + a ∧ a ≤ b + (1 : ℤ) ∧ -((2 : ℤ) * k - b + (1 : ℤ)) ≤ a ∧ a ≤ (2 : ℤ) * k - b + (1 : + ℤ)) → (1≤-a ∧ -a≤k ∧ (b=2*k+1+a ∨ b=2*k+a)))) ) := by + classical + intro K k a b hdpred hcast hdchild + have h : -k≤a ∧ a≤-1 ∧ (b-a=2*k+1 ∨ b-a=2*k) := by omega + omega + +private theorem hcompAt243 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1 + let r : GaussianInt := ⟨-2*k,0⟩ + let child := P5352T2Sources K hk 0 + (child.1=DiamondTile K.1) → (∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + + (k + (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + + b ∧ a + k ≤ b - (k + (1 : ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : + ℤ)) + (k + (1 : ℤ)) ∧ a + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : + ℤ)) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → ((b = (2 : ℤ) * k + (1 : ℤ) + a) → ( + let t : Int := -a + (a=-t ∧ b=2*k+1-t) → ((1≤t ∧ t≤k) → ( + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + zA-r ∈ FootprintVertices child.1 ↔ t=k)))))) ) := by + classical + intro K hk k r child hchildTile a b hdpred hcast hb t hcoords htrange zA + constructor + · intro hh + have hdom := (P5352T2DomainRows K (zA-r)).1.mp + (hchildTile ▸ hh) + simp [zA,r] at hdom + omega + · intro he + subst t + have hmem : zA-r=⟨k, k+1⟩ := by + ext <;> simp [zA,r] <;> omega + rw [hmem] + exact hchildTile.symm ▸ (P5352T2DomainRows K ⟨k,k+1⟩).1.mpr (by + constructor <;> simp <;> omega) + +private theorem hce : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : + ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : + ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → (((↑(K.1 - (1 : ℕ)) : + ℤ) = k - (1 : ℤ)) → ((∀ (x : Int), ∀ (y : Int), (0≤y ∧ y≤2*k ∧ -k≤x ∧ x≤k ∧ -y-1≤x ∧ + x≤y+1 ∧ -(2*k-y+1)≤x ∧ x≤2*k-y+1) → ((⟨x,y⟩:GaussianInt)∈FootprintVertices + (DiamondTile K.1))) → ((b = (2 : ℤ) * k + (1 : ℤ) + a) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (zA+1)∈FootprintVertices (DiamondTile K.1)))))) ) := by + classical + intro K hk k a b hdpred hcast childMem hb t zA + have he : zA+1=(⟨1-t,2*k+1-t⟩:GaussianInt) := by ext <;> simp [zA]; ring + rw [he] + exact childMem (1-t) (2*k+1-t) (by constructor <;> omega) + +private theorem hcs : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : + ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : + ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → (((↑(K.1 - (1 : ℕ)) : + ℤ) = k - (1 : ℤ)) → ((∀ (x : Int), ∀ (y : Int), (0≤y ∧ y≤2*k ∧ -k≤x ∧ x≤k ∧ -y-1≤x ∧ + x≤y+1 ∧ -(2*k-y+1)≤x ∧ x≤2*k-y+1) → ((⟨x,y⟩:GaussianInt)∈FootprintVertices + (DiamondTile K.1))) → ((b = (2 : ℤ) * k + (1 : ℤ) + a) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (zA-⟨0,1⟩)∈FootprintVertices (DiamondTile K.1)))))) ) := by + classical + intro K hk k a b hdpred hcast childMem hb t zA + have hs : zA-⟨0,1⟩=(⟨-t,2*k-t⟩:GaussianInt) := by ext <;> simp [zA]; ring + rw [hs] + exact childMem (-t) (2*k-t) (by constructor <;> omega) + +private theorem hpw : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + let d : GaussianInt := ⟨-k,k+1⟩ + ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : + ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : + ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → (((↑(K.1 - (1 : ℕ)) : + ℤ) = k - (1 : ℤ)) → ((∀ (w : GaussianInt), (0≤w.im ∧ w.im≤2*(k-1) ∧ -(k-1)≤w.re ∧ + w.re≤k-1 ∧ -w.im-1≤w.re ∧ w.re≤w.im+1 ∧ -(2*(k-1)-w.im+1)≤w.re ∧ w.re≤2*(k-1)-w.im+1) + → (w∈FootprintVertices (DiamondTile (K.1-1)))) → ((b = (2 : ℤ) * k + (1 : ℤ) + a) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (zA-1)-d∈FootprintVertices (DiamondTile (K.1-1))))))) ) := by + classical + intro K hk k d a b hdpred hcast predFoot hb t zA + apply predFoot + constructor <;> simp [zA,d] <;> omega + +private theorem hpn : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + let d : GaussianInt := ⟨-k,k+1⟩ + ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : + ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : + ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → (((↑(K.1 - (1 : ℕ)) : + ℤ) = k - (1 : ℤ)) → ((∀ (w : GaussianInt), (0≤w.im ∧ w.im≤2*(k-1) ∧ -(k-1)≤w.re ∧ + w.re≤k-1 ∧ -w.im-1≤w.re ∧ w.re≤w.im+1 ∧ -(2*(k-1)-w.im+1)≤w.re ∧ w.re≤2*(k-1)-w.im+1) + → (w∈FootprintVertices (DiamondTile (K.1-1)))) → ((b = (2 : ℤ) * k + (1 : ℤ) + a) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (zA+⟨0,1⟩)-d∈FootprintVertices (DiamondTile (K.1-1))))))) ) := by + classical + intro K hk k d a b hdpred hcast predFoot hb t zA + apply predFoot + constructor <;> simp [zA,d] <;> omega + +private theorem hEAt277 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + ∀ (a : ℤ), + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + (∀ (w : GaussianInt), (w ∈ FootprintVertices (DiamondTile K.1)) → (f w=Q w.re w.im)) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + ((zA+1)∈FootprintVertices (DiamondTile K.1)) → (f (zA+1)=Q (1-t) (2*k+1-t))) ) := by + classical + intro K f k a Q childValue t zA hce + have he : zA+1=(⟨1-t,2*k+1-t⟩:GaussianInt) := by ext <;> simp [zA]; ring + rw [he] + have hm : (⟨1-t,2*k+1-t⟩:GaussianInt)∈FootprintVertices (DiamondTile K.1) := by + rw [← he] + exact hce + exact childValue _ hm + +private theorem hSAt284 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + ∀ (a : ℤ), + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + (∀ (w : GaussianInt), (w ∈ FootprintVertices (DiamondTile K.1)) → (f w=Q w.re w.im)) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + ((zA-⟨0,1⟩)∈FootprintVertices (DiamondTile K.1)) → (f (zA-⟨0,1⟩)=Q (-t) (2*k-t))) ) := by + classical + intro K f k a Q childValue t zA hcs + have he : zA-⟨0,1⟩=(⟨-t,2*k-t⟩:GaussianInt) := by ext <;> simp [zA]; ring + rw [he] + have hm : (⟨-t,2*k-t⟩:GaussianInt)∈FootprintVertices (DiamondTile K.1) := by + rw [← he] + exact hcs + exact childValue _ hm + +private theorem hPC : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let d : GaussianInt := ⟨-k,k+1⟩ + ∀ (a : ℤ), + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + (∀ (y : GaussianInt), (y-d∈FootprintVertices (DiamondTile (K.1-1))) → (f y=Q (y-d).re + (y-d).im+y.re-k*y.im+B)) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (zA-d∈FootprintVertices (DiamondTile (K.1-1))) → (f zA=Q (k-t) (k-t)+(-t)-k*(2*k+1-t)+B)) + ) := by + classical + intro K f B k d a Q predTranslatedValue t zA hp0 + have hv := predTranslatedValue zA (by simpa [zA,d] using hp0) + convert hv using 1; simp [zA,d]; ring + +private theorem hPW : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let d : GaussianInt := ⟨-k,k+1⟩ + ∀ (a : ℤ), + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + (∀ (y : GaussianInt), (y-d∈FootprintVertices (DiamondTile (K.1-1))) → (f y=Q (y-d).re + (y-d).im+y.re-k*y.im+B)) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + ((zA-1)-d∈FootprintVertices (DiamondTile (K.1-1))) → (f (zA-1)=Q (k-t-1) + (k-t)+(-t-1)-k*(2*k+1-t)+B)) ) := by + classical + intro K f B k d a Q predTranslatedValue t zA hpw + have he : (zA-1)-d=(⟨k-t-1,k-t⟩:GaussianInt) := by ext <;> simp [zA,d] <;> ring + have hv := predTranslatedValue (zA-1) hpw + convert hv using 1; simp [zA,d]; ring + +private theorem hPN : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let d : GaussianInt := ⟨-k,k+1⟩ + ∀ (a : ℤ), + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + (∀ (y : GaussianInt), (y-d∈FootprintVertices (DiamondTile (K.1-1))) → (f y=Q (y-d).re + (y-d).im+y.re-k*y.im+B)) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + ((zA+⟨0,1⟩)-d∈FootprintVertices (DiamondTile (K.1-1))) → (f (zA+⟨0,1⟩)=Q (k-t) + (k+1-t)+(-t)-k*(2*k+2-t)+B)) ) := by + classical + intro K f B k d a Q predTranslatedValue t zA hpn + have he : (zA+⟨0,1⟩)-d=(⟨k-t,k+1-t⟩:GaussianInt) := by ext <;> simp [zA,d] <;> ring + have hv := predTranslatedValue (zA+⟨0,1⟩) hpn + convert hv using 1; simp [zA,d]; ring + +private theorem qC : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : + ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : + ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → ( + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + let T : Int → Int := fun n => n*(n-1)/2 + (∀ (m : Int), (2*m+1)^2/4=m^2+m) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (f zA=Q (-t) (2*k+1-t)) → ((f zA=Q (k-t) (k-t)+(-t)-k*(2*k+1-t)+B) → ((f (zA-1)=Q (k-t-1) + (k-t)+(-t-1)-k*(2*k+1-t)+B) → ((f (zA+⟨0,1⟩)=Q (k-t) (k+1-t)+(-t)-k*(2*k+2-t)+B) → (Q + (-t) (2*k+1-t)=T t-(k*k+k))))))) ) := by + classical + intro K f B k a b hdpred Q T floorOdd t zA hC hPC hPW hPN + unfold Q + have ha : (Int.natAbs (-t):Int)=t := by + rw [Int.natCast_natAbs,abs_of_nonpos (show -t≤0 by omega)]; omega + have hs : (-t-(2*k+1-t))^2/4=k*k+k := by + rw [show -t-(2*k+1-t)=2*(-k-1)+1 by ring,floorOdd] + ring + rw [ha,hs] + +private theorem qE : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : + ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : + ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → ( + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + let T : Int → Int := fun n => n*(n-1)/2 + (∀ (m : Int), (2*m)^2/4=m^2) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (f zA=Q (-t) (2*k+1-t)) → ((f zA=Q (k-t) (k-t)+(-t)-k*(2*k+1-t)+B) → ((f (zA-1)=Q (k-t-1) + (k-t)+(-t-1)-k*(2*k+1-t)+B) → ((f (zA+⟨0,1⟩)=Q (k-t) (k+1-t)+(-t)-k*(2*k+2-t)+B) → (Q + (1-t) (2*k+1-t)=T (t-1)-k*k)))))) ) := by + classical + intro K f B k a b hdpred Q T floorEven t zA hC hPC hPW hPN + unfold Q + have ha : (Int.natAbs (1-t):Int)=t-1 := by + rw [Int.natCast_natAbs,abs_of_nonpos (show 1-t≤0 by omega)]; omega + have hs : ((1-t)-(2*k+1-t))^2/4=k*k := by + rw [show (1-t)-(2*k+1-t)=2*(-k) by ring,floorEven] + ring + rw [ha,hs] + +private theorem qS : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : + ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : + ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → ( + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + let T : Int → Int := fun n => n*(n-1)/2 + (∀ (m : Int), (2*m)^2/4=m^2) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (f zA=Q (-t) (2*k+1-t)) → ((f zA=Q (k-t) (k-t)+(-t)-k*(2*k+1-t)+B) → ((f (zA-1)=Q (k-t-1) + (k-t)+(-t-1)-k*(2*k+1-t)+B) → ((f (zA+⟨0,1⟩)=Q (k-t) (k+1-t)+(-t)-k*(2*k+2-t)+B) → (Q + (-t) (2*k-t)=T t-k*k)))))) ) := by + classical + intro K f B k a b hdpred Q T floorEven t zA hC hPC hPW hPN + unfold Q + have ha : (Int.natAbs (-t):Int)=t := by + rw [Int.natCast_natAbs,abs_of_nonpos (show -t≤0 by omega)]; omega + have hs : (-t-(2*k-t))^2/4=k*k := by + rw [show -t-(2*k-t)=2*(-k) by ring,floorEven] + ring + rw [ha,hs] + +private theorem qPC : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : + ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : + ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → (((↑(K.1 - (1 : ℕ)) : + ℤ) = k - (1 : ℤ)) → ( + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + let T : Int → Int := fun n => n*(n-1)/2 + (b = (2 : ℤ) * k + (1 : ℤ) + a) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (f zA=Q (-t) (2*k+1-t)) → ((f zA=Q (k-t) (k-t)+(-t)-k*(2*k+1-t)+B) → ((f (zA-1)=Q (k-t-1) + (k-t)+(-t-1)-k*(2*k+1-t)+B) → ((f (zA+⟨0,1⟩)=Q (k-t) (k+1-t)+(-t)-k*(2*k+2-t)+B) → + ((Q (-t) (2*k+1-t)=T t-(k*k+k)) → (Q (k-t) (k-t)=T (k-t))))))))) ) := by + classical + intro K f B k a b hdpred hcast Q T hb t zA hC hPC hPW hPN qC + unfold Q + have ha : (Int.natAbs (k-t):Int)=k-t := by + rw [Int.natCast_natAbs,abs_of_nonneg (show 0≤k-t by omega)] + rw [ha] + norm_num [T] + +private theorem qPN : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : + ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : + ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → (((↑(K.1 - (1 : ℕ)) : + ℤ) = k - (1 : ℤ)) → ( + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + let T : Int → Int := fun n => n*(n-1)/2 + (b = (2 : ℤ) * k + (1 : ℤ) + a) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (f zA=Q (-t) (2*k+1-t)) → ((f zA=Q (k-t) (k-t)+(-t)-k*(2*k+1-t)+B) → ((f (zA-1)=Q (k-t-1) + (k-t)+(-t-1)-k*(2*k+1-t)+B) → ((f (zA+⟨0,1⟩)=Q (k-t) (k+1-t)+(-t)-k*(2*k+2-t)+B) → + ((Q (-t) (2*k+1-t)=T t-(k*k+k)) → ((Q (k-t) (k-t)=T (k-t)) → (Q (k-t) (k+1-t)=T + (k-t)))))))))) ) := by + classical + intro K f B k a b hdpred hcast Q T hb t zA hC hPC hPW hPN qC qPC + unfold Q + have ha : (Int.natAbs (k-t):Int)=k-t := by + rw [Int.natCast_natAbs,abs_of_nonneg (show 0≤k-t by omega)] + rw [ha] + norm_num [T] + +private theorem qPWlt : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + ∀ (a : ℤ), (ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → ( + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + let T : Int → Int := fun n => n*(n-1)/2 + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (f zA=Q (-t) (2*k+1-t)) → ((f zA=Q (k-t) (k-t)+(-t)-k*(2*k+1-t)+B) → ((f (zA-1)=Q (k-t-1) + (k-t)+(-t-1)-k*(2*k+1-t)+B) → ((f (zA+⟨0,1⟩)=Q (k-t) (k+1-t)+(-t)-k*(2*k+2-t)+B) → + ((Q (-t) (2*k+1-t)=T t-(k*k+k)) → ((Q (k-t) (k-t)=T (k-t)) → ((Q (k-t) (k+1-t)=T + (k-t)) → (t < k → Q (k - t - (1 : ℤ)) (k - t) = T (k - t - (1 : ℤ))))))))))) ) := by + classical + intro K f B k a b hcast Q T t zA hC hPC hPW hPN qC qPC qPN hlt + unfold Q + have ha : (Int.natAbs (k-t-1):Int)=k-t-1 := by + rw [Int.natCast_natAbs,abs_of_nonneg (show 0≤k-t-1 by omega)] + rw [ha] + norm_num [T] + +private theorem qPWeq : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (a : ℤ), + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + let t : Int := -a + t = k → Q (k - t - (1 : ℤ)) (k - t) = (0 : ℤ) ) := by + classical + intro K k a Q t heq + rw [heq] + norm_num [Q,Int.natCast_natAbs] + +private theorem hEastDiff : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + ∀ (a : ℤ), + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + let T : Int → Int := fun n => n*(n-1)/2 + (∀ (n : Int), T (n-1)-T n=1-n) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (f zA=Q (-t) (2*k+1-t)) → ((f (zA+1)=Q (1-t) (2*k+1-t)) → ((Q (-t) (2*k+1-t)=T t-(k*k+k)) + → ((Q (1-t) (2*k+1-t)=T (t-1)-k*k) → (f (zA+1)-f zA=k+1-t))))) ) := by + classical + intro K f k a Q T tdiffRev t zA hC hE qC qE + rw [hE,hC,qE,qC] + calc + T (t-1)-k*k-(T t-(k*k+k))=T (t-1)-T t+k := by ring + _ = (1-t)+k := by rw [tdiffRev] + _ = k+1-t := by ring + +private theorem hWestDiff : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + ∀ (a : ℤ), + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + let T : Int → Int := fun n => n*(n-1)/2 + (∀ (n : Int), T (n-1)-T n=1-n) → ( + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (f zA=Q (k-t) (k-t)+(-t)-k*(2*k+1-t)+B) → ((f (zA-1)=Q (k-t-1) + (k-t)+(-t-1)-k*(2*k+1-t)+B) → ((Q (k-t) (k-t)=T (k-t)) → (((t + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + let T : Int → Int := fun n => n*(n-1)/2 + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (f zA=Q (k-t) (k-t)+(-t)-k*(2*k+1-t)+B) → ((f (zA+⟨0,1⟩)=Q (k-t) + (k+1-t)+(-t)-k*(2*k+2-t)+B) → ((Q (k-t) (k-t)=T (k-t)) → ((Q (k-t) (k+1-t)=T (k-t)) → + (f (zA+⟨0,1⟩)-f zA= -k)))) ) := by + classical + intro K f B k a Q T t zA hPC hPN qPC qPN + rw [hPN,hPC,qPN,qPC] + ring + +private theorem hSouthDiff : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + ∀ (a : ℤ), + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + let T : Int → Int := fun n => n*(n-1)/2 + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (f zA=Q (-t) (2*k+1-t)) → ((f (zA-⟨0,1⟩)=Q (-t) (2*k-t)) → ((Q (-t) (2*k+1-t)=T + t-(k*k+k)) → ((Q (-t) (2*k-t)=T t-k*k) → (f (zA-⟨0,1⟩)-f zA=k)))) ) := by + classical + intro K f k a Q T t zA hC hS qC qS + rw [hS,hC,qS,qC] + ring + +private theorem hWestDiffEq : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + ∀ (a : ℤ), + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + let T : Int → Int := fun n => n*(n-1)/2 + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (f zA=Q (k-t) (k-t)+(-t)-k*(2*k+1-t)+B) → ((f (zA-1)=Q (k-t-1) + (k-t)+(-t-1)-k*(2*k+1-t)+B) → ((Q (k-t) (k-t)=T (k-t)) → (((t=k) → (Q (k-t-1) + (k-t)=0)) → (t=k → f (zA-1)-f zA= -1)))) ) := by + classical + intro K f B k a Q T t zA hPC hPW qPC qPWeq heq + rw [hPW,hPC,qPWeq heq,qPC] + rw [heq] + simp [T] + ring + +private theorem hneq : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1 + let r : GaussianInt := ⟨-2*k,0⟩ + let child := P5352T2Sources K hk 0 + (child.1=DiamondTile K.1) → (∀ (a : ℤ), + let t : Int := -a + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + (zA-r ∈ FootprintVertices child.1 ↔ t=k) → ((zA - r ∉ FootprintVertices child.1) → + (t≠k))) ) := by + classical + intro K hk k r child hchildTile a t zA hcomp hmem heq + apply hmem + exact hchildTile.symm ▸ hcomp.mpr heq + +private theorem heAt394 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : + ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : + ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → (((↑(K.1 - (1 : ℕ)) : + ℤ) = k - (1 : ℤ)) → ((∀ (x : Int), ∀ (y : Int), (0≤y ∧ y≤2*k ∧ -k≤x ∧ x≤k ∧ -y-1≤x ∧ + x≤y+1 ∧ -(2*k-y+1)≤x ∧ x≤2*k-y+1) → ((⟨x,y⟩:GaussianInt)∈FootprintVertices + (DiamondTile K.1))) → ((b = (2 : ℤ) * k + a) → ( + let t : Int := -a + let zB : GaussianInt := ⟨-t,2*k-t⟩ + (zB+1)∈FootprintVertices (DiamondTile K.1)))))) ) := by + classical + intro K hk k a b hdpred hcast childMem hb t zB + have heq : zB+1=(⟨1-t,2*k-t⟩:GaussianInt) := by ext <;> simp [zB]; ring + rw [heq] + exact childMem (1-t) (2*k-t) (by constructor <;> omega) + +private theorem hw : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : + ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : + ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → (((↑(K.1 - (1 : ℕ)) : + ℤ) = k - (1 : ℤ)) → ((∀ (x : Int), ∀ (y : Int), (0≤y ∧ y≤2*k ∧ -k≤x ∧ x≤k ∧ -y-1≤x ∧ + x≤y+1 ∧ -(2*k-y+1)≤x ∧ x≤2*k-y+1) → ((⟨x,y⟩:GaussianInt)∈FootprintVertices + (DiamondTile K.1))) → ((b = (2 : ℤ) * k + a) → ( + let t : Int := -a + let zB : GaussianInt := ⟨-t,2*k-t⟩ + (zB-1)∈FootprintVertices (DiamondTile K.1)))))) ) := by + classical + intro K hk k a b hdpred hcast childMem hb t zB + have heq : zB-1=(⟨-t-1,2*k-t⟩:GaussianInt) := by ext <;> simp [zB] + rw [heq] + exact childMem (-t-1) (2*k-t) (by constructor <;> omega) + +private theorem hnAt402 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : + ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : + ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → (((↑(K.1 - (1 : ℕ)) : + ℤ) = k - (1 : ℤ)) → ((∀ (x : Int), ∀ (y : Int), (0≤y ∧ y≤2*k ∧ -k≤x ∧ x≤k ∧ -y-1≤x ∧ + x≤y+1 ∧ -(2*k-y+1)≤x ∧ x≤2*k-y+1) → ((⟨x,y⟩:GaussianInt)∈FootprintVertices + (DiamondTile K.1))) → ((b = (2 : ℤ) * k + a) → ( + let t : Int := -a + let zB : GaussianInt := ⟨-t,2*k-t⟩ + (zB+⟨0,1⟩)∈FootprintVertices (DiamondTile K.1)))))) ) := by + classical + intro K hk k a b hdpred hcast childMem hb t zB + have heq : zB+⟨0,1⟩=(⟨-t,2*k+1-t⟩:GaussianInt) := by ext <;> simp [zB]; ring + rw [heq] + exact childMem (-t) (2*k+1-t) (by constructor <;> omega) + +private theorem hsAt406 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : + ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : + ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → (((↑(K.1 - (1 : ℕ)) : + ℤ) = k - (1 : ℤ)) → ((∀ (x : Int), ∀ (y : Int), (0≤y ∧ y≤2*k ∧ -k≤x ∧ x≤k ∧ -y-1≤x ∧ + x≤y+1 ∧ -(2*k-y+1)≤x ∧ x≤2*k-y+1) → ((⟨x,y⟩:GaussianInt)∈FootprintVertices + (DiamondTile K.1))) → ((b = (2 : ℤ) * k + a) → ( + let t : Int := -a + let zB : GaussianInt := ⟨-t,2*k-t⟩ + (zB-⟨0,1⟩)∈FootprintVertices (DiamondTile K.1)))))) ) := by + classical + intro K hk k a b hdpred hcast childMem hb t zB + have heq : zB-⟨0,1⟩=(⟨-t,2*k-t-1⟩:GaussianInt) := by ext <;> simp [zB] + rw [heq] + exact childMem (-t) (2*k-t-1) (by constructor <;> omega) + +private theorem hdomAt410 : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (a : ℤ), + let t : Int := -a + let zB : GaussianInt := ⟨-t,2*k-t⟩ + (zB∈FootprintVertices (DiamondTile K.1)) → (zB∈DiamondVertexDomains K false) ) := by + classical + intro K k a t zB hc + obtain ⟨_,_,_,hfp,_,_⟩ := DiamondTileOdometerRestriction K + exact hfp ▸ hc + +private theorem hnot : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : + ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : + ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → (((↑(K.1 - (1 : ℕ)) : + ℤ) = k - (1 : ℤ)) → ((b = (2 : ℤ) * k + a) → ( + let t : Int := -a + let zB : GaussianInt := ⟨-t,2*k-t⟩ + zB∉DiamondVertexDomains K true))) ) := by + classical + intro K k a b hdpred hcast hb t zB + change ¬ (Int.natAbs zB.re+Int.natAbs (zB.im-(K.1:Int))≤K.1-1) + intro hh + have hhI : ((Int.natAbs zB.re+Int.natAbs (zB.im-(K.1:Int)):Nat):Int)≤ + ((K.1-1:Nat):Int) := by exact_mod_cast hh + have ha : (Int.natAbs zB.re:Int)=t := by + change (Int.natAbs (-t):Int)=t + rw [Int.natCast_natAbs,abs_of_nonpos (show -t≤0 by omega)] + omega + have hb' : (Int.natAbs (zB.im-(K.1:Int)):Int)=k-t := by + change (Int.natAbs (2*k-t-(K.1:Int)):Int)=k-t + rw [Int.natCast_natAbs,abs_of_nonneg (show 0≤2*k-t-(K.1:Int) by dsimp [k]; omega)] + dsimp [k] + omega + rw [Int.natCast_add,ha,hb',hcast] at hhI + omega + +private theorem htable' : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (a : ℤ), + let t : Int := -a + let zB : GaussianInt := ⟨-t,2*k-t⟩ + (FourNeighborLaplacian (DiamondOdometer K) zB = (1 : ℤ)) → ((DiamondOdometer K + (zB+1)-DiamondOdometer K zB)+ (DiamondOdometer K (zB-1)-DiamondOdometer K zB)+ + (DiamondOdometer K (zB+⟨0,1⟩)-DiamondOdometer K zB)+ (DiamondOdometer K + (zB-⟨0,1⟩)-DiamondOdometer K zB)=1) ) := by + classical + intro K k a t zB htable + rw [FourNeighborLaplacian] at htable + linarith + +private theorem hcompAt447 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), (IntegerLatticeFunction) → ( + let k : Int := K.1 + let r : GaussianInt := ⟨-2*k,0⟩ + let child := P5352T2Sources K hk 0 + (child.1=DiamondTile K.1) → (∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + + (k + (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + + b ∧ a + k ≤ b - (k + (1 : ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : + ℤ)) + (k + (1 : ℤ)) ∧ a + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : + ℤ)) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → ((b = (2 : ℤ) * k + a) → ( + let t : Int := -a + let zB : GaussianInt := ⟨-t,2*k-t⟩ + zB-r∉FootprintVertices child.1))))) ) := by + classical + intro K hk f k r child hchildTile a b hdpred hcast hb t zB hmem + have hd := (P5352T2DomainRows K (zB-r)).1.mp (hchildTile ▸ hmem) + simp [zB,r] at hd + omega + +end SecondPredecessorProof + +theorem P5352T2Predecessor2 (K : DiamondParameter) (hk : 1 < K.1) + (f : IntegerLatticeFunction) (B : Int) (z : GaussianInt) : + let A := P5352T2Sources K hk 0 + let D := P5352T2Sources K hk 3 + let M := (P5352T2PlacementData K.1 2).2 2 + (∀ y, y ∈ FootprintVertices A.1 → f y = A.2.1 y) → + (∀ y, y - M.1 ∈ FootprintVertices D.1 → + f y = D.2.1 (y - M.1) + M.2.1.re*y.re + M.2.1.im*y.im + B) → + z ∈ FootprintVertices A.1 → z - M.1 ∈ FootprintVertices D.1 → + (∀ y, y = z ∨ y = z + 1 ∨ y = z - 1 ∨ + y = z + ⟨0, 1⟩ ∨ y = z - ⟨0, 1⟩ → + y ∈ FootprintVertices A.1 ∨ y - M.1 ∈ FootprintVertices D.1) → + (z - M.2.2 ∈ FootprintVertices A.1 → FourNeighborLaplacian f z = 0) ∧ + (z - M.2.2 ∉ FootprintVertices A.1 → FourNeighborLaplacian f z = 1) := by +-- BODY + exact (by + classical + have lap_identity (g : IntegerLatticeFunction) (x : GaussianInt) : + FourNeighborLaplacian g x = + (g (x+1)-g x)+(g (x-1)-g x)+ + (g (x+⟨0,1⟩)-g x)+(g (x-⟨0,1⟩)-g x) := SecondPredecessorProof.lap_identity g x + let k : Int := K.1 + let d : GaussianInt := ⟨-k,k+1⟩ + let r : GaussianInt := ⟨-2*k,0⟩ + let child := P5352T2Sources K hk 0 + let pred := P5352T2Sources K hk 3 + let M := (P5352T2PlacementData K.1 2).2 2 + have hkI : 2 ≤ k := by dsimp [k]; exact_mod_cast (show 2 ≤ K.1 by omega) + have hm : M.1=d ∧ M.2.1=⟨1,-k⟩ ∧ M.2.2=r := by + simp [M,d,r,P5352T2PlacementData,k] + rcases hm with ⟨hdisp,hcoeff,hr⟩ + have hchildTile : child.1=DiamondTile K.1 := by simp [child,P5352T2Sources] + change + (∀ y, y ∈ FootprintVertices child.1 → f y=child.2.1 y) → + (∀ y, y-M.1 ∈ FootprintVertices pred.1 → + f y=pred.2.1 (y-M.1)+M.2.1.re*y.re+M.2.1.im*y.im+B) → + z ∈ FootprintVertices child.1 → z-M.1 ∈ FootprintVertices pred.1 → + (∀ y, y=z ∨ y=z+1 ∨ y=z-1 ∨ y=z+⟨0,1⟩ ∨ y=z-⟨0,1⟩ → + y ∈ FootprintVertices child.1 ∨ y-M.1 ∈ FootprintVertices pred.1) → + (z-M.2.2 ∈ FootprintVertices child.1 → FourNeighborLaplacian f z=0) ∧ + (z-M.2.2 ∉ FootprintVertices child.1 → FourNeighborLaplacian f z=1) + intro hchild hpred hz hpz hcover + rw [hdisp] at hpz hcover + rw [hdisp,hcoeff] at hpred + rw [hr] at ⊢ + have hdchild := (P5352T2DomainRows K z).1.mp hz + have hdpred := (P5352T2DomainRows ⟨K.1-1,by omega⟩ (z-d)).1.mp hpz + rcases z with ⟨a,b⟩ + simp? [d] at hdpred + have hcast : ((K.1-1 : Nat) : Int)=k-1 := by dsimp [k]; omega + rw [hcast] at hdpred + change (0≤b ∧ b≤2*k ∧ -k≤a ∧ a≤k ∧ -b-1≤a ∧ a≤b+1 ∧ + -(2*k-b+1)≤a ∧ a≤2*k-b+1) at hdchild + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 + have childValue (w : GaussianInt) + (hw : w ∈ FootprintVertices (DiamondTile K.1)) : + f w=Q w.re w.im := SecondPredecessorProof.childValue K hk f hchild w hw + have childMem (x y : Int) + (h : 0≤y ∧ y≤2*k ∧ -k≤x ∧ x≤k ∧ -y-1≤x ∧ x≤y+1 ∧ + -(2*k-y+1)≤x ∧ x≤2*k-y+1) : + (⟨x,y⟩:GaussianInt)∈FootprintVertices (DiamondTile K.1) := + (P5352T2DomainRows K ⟨x,y⟩).1.mpr h + have childOdometer (w : GaussianInt) + (hw : w∈FootprintVertices (DiamondTile K.1)) : + f w=DiamondOdometer K w := SecondPredecessorProof.childOdometer K hk f hchild w hw + have predFoot (w : GaussianInt) + (hw : 0≤w.im ∧ w.im≤2*(k-1) ∧ -(k-1)≤w.re ∧ w.re≤k-1 ∧ + -w.im-1≤w.re ∧ w.re≤w.im+1 ∧ + -(2*(k-1)-w.im+1)≤w.re ∧ w.re≤2*(k-1)-w.im+1) := SecondPredecessorProof.predFoot K hk a b + hcast w hw + have predValue (w : GaussianInt) + (hw : w∈FootprintVertices (DiamondTile (K.1-1))) := SecondPredecessorProof.predValue K hk a + b hcast w hw + have predTranslatedValue (y : GaussianInt) + (hy : y-d∈FootprintVertices (DiamondTile (K.1-1))) := + SecondPredecessorProof.predTranslatedValue K hk + f B hpred a b hcast predValue y hy + let T : Int → Int := fun n => n*(n-1)/2 + have tri (n : Int) := SecondPredecessorProof.tri K a b n + have tdiff (n : Int) := SecondPredecessorProof.tdiff K a b tri n + have tdiffRev (n : Int) := SecondPredecessorProof.tdiffRev K a b tdiff n + have floorEven (m : Int) := SecondPredecessorProof.floorEven m + have floorOdd (m : Int) := SecondPredecessorProof.floorOdd K a b m + have ht := SecondPredecessorProof.ht K a b hdpred hcast + hdchild + rcases ht with ⟨ht1,htk,hb⟩ + rcases hb with hb | hb + · let t : Int := -a + have hcoords : a=-t ∧ b=2*k+1-t := by dsimp [t]; omega + have htrange : 1≤t ∧ t≤k := by dsimp [t]; omega + let zA : GaussianInt := ⟨-t,2*k+1-t⟩ + -- The two translated-source neighbors and the three child values are evaluated below. + have hcomp : zA-r ∈ FootprintVertices child.1 ↔ t=k := SecondPredecessorProof.hcompAt243 K + hk hchildTile a b hdpred hcast hb hcoords htrange + have hc0 : zA∈FootprintVertices (DiamondTile K.1) := by + exact childMem (-t) (2*k+1-t) (by constructor <;> omega) + have hce := SecondPredecessorProof.hce K hk a + b hdpred hcast childMem hb + have hcs := SecondPredecessorProof.hcs K + hk a b hdpred hcast childMem hb + have hp0 : zA-d∈FootprintVertices (DiamondTile (K.1-1)) := by + simpa [zA,hcoords,pred,P5352T2Sources] using hpz + have hpw := SecondPredecessorProof.hpw K + hk a b hdpred hcast predFoot hb + have hpn := SecondPredecessorProof.hpn K hk a b hdpred hcast predFoot hb + have hC : f zA=Q (-t) (2*k+1-t) := by + simpa [zA] using childValue zA hc0 + have hE : f (zA+1)=Q (1-t) (2*k+1-t) := SecondPredecessorProof.hEAt277 K f a childValue hce + have hS : f (zA-⟨0,1⟩)=Q (-t) (2*k-t) := SecondPredecessorProof.hSAt284 K f a childValue hcs + have hPC := SecondPredecessorProof.hPC K f B a + predTranslatedValue hp0 + have hPW := SecondPredecessorProof.hPW K f + B a predTranslatedValue hpw + have hPN := SecondPredecessorProof.hPN K + f B a predTranslatedValue hpn + have qC := SecondPredecessorProof.qC K f B a b hdpred + floorOdd hC hPC hPW hPN + have qE := SecondPredecessorProof.qE K f B a b hdpred + floorEven hC hPC hPW hPN + have qS := SecondPredecessorProof.qS K f B a b hdpred floorEven hC + hPC hPW hPN + have qPC := SecondPredecessorProof.qPC K f B a b hdpred hcast hb hC + hPC hPW hPN qC + have qPN := SecondPredecessorProof.qPN K f B a b hdpred hcast hb + hC hPC hPW hPN qC qPC + have qPWlt (hlt : t simp [zA,hcoords] + rw [hzA] at ⊢ + refine ⟨?_,?_⟩ + · intro hmem + have heq : t=k := hcomp.mp (by simpa [child,hchildTile] using hmem) + rw [lap_identity,hEastDiff,hWestDiffEq heq,hNorthDiff,hSouthDiff,heq] + ring + · intro hmem + have hneq := SecondPredecessorProof.hneq K hk hchildTile a hcomp hmem + have hlt : t simp [zB,hcoords] + have hc : zB∈FootprintVertices (DiamondTile K.1) := + childMem (-t) (2*k-t) (by constructor <;> omega) + have he : (zB+1)∈FootprintVertices (DiamondTile K.1) := SecondPredecessorProof.heAt394 K hk + a b hdpred hcast childMem hb + have hw : (zB-1)∈FootprintVertices (DiamondTile K.1) := SecondPredecessorProof.hw K hk a b + hdpred hcast childMem hb + have hn : (zB+⟨0,1⟩)∈FootprintVertices (DiamondTile K.1) := SecondPredecessorProof.hnAt402 + K hk a b hdpred hcast childMem hb + have hs : (zB-⟨0,1⟩)∈FootprintVertices (DiamondTile K.1) := SecondPredecessorProof.hsAt406 + K hk a b hdpred hcast childMem hb + have hdom := SecondPredecessorProof.hdomAt410 K a hc + have hnot := SecondPredecessorProof.hnot K a b hdpred + hcast hb + have htable := (DiamondLaplacianTable K).2.1 zB hdom hnot + have hE : f (zB+1)=DiamondOdometer K (zB+1) := by + exact childOdometer _ (by simpa [hchildTile] using he) + have hW : f (zB-1)=DiamondOdometer K (zB-1) := by + exact childOdometer _ (by simpa [hchildTile] using hw) + have hN : f (zB+⟨0,1⟩)=DiamondOdometer K (zB+⟨0,1⟩) := by + exact childOdometer _ (by simpa [hchildTile] using hn) + have hS : f (zB-⟨0,1⟩)=DiamondOdometer K (zB-⟨0,1⟩) := by + exact childOdometer _ (by simpa [hchildTile] using hs) + have hC : f zB=DiamondOdometer K zB := by + exact childOdometer _ (by simpa [hchildTile] using hc) + have htable' := SecondPredecessorProof.htable' + K a htable + have hcomp : zB-r∉FootprintVertices child.1 := SecondPredecessorProof.hcompAt447 K hk f + hchildTile a b hdpred hcast hb + rw [hzB] at ⊢ + refine ⟨?_,?_⟩ + · intro hm + exact (hcomp hm).elim + · intro _ + rw [lap_identity,hE,hW,hN,hS,hC] + exact htable' + ) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean new file mode 100644 index 0000000000..ac9f632ec6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean @@ -0,0 +1,1059 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData +public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic +public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable + +-- [TABLET NODE: P5352T2Predecessor3] + +/-! +# P5352T2Predecessor3 + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FourthPredecessorCases + +private theorem hkm : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + ((K.1-1 : Nat) : Int) = k-1) ) := by + classical + intro K hk k + rw [Nat.cast_sub (by omega : 1 ≤ K.1)] + dsimp [k] + +private theorem childMem : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℤ) ≤ b ∧ b ≤ (2 : ℤ) * k ∧ -k ≤ a ∧ a ≤ k ∧ -b - (1 : ℤ) ≤ a ∧ + a ≤ b + (1 : ℤ) ∧ -((2 : ℤ) * k - b + (1 : ℤ)) ≤ a ∧ a ≤ (2 : ℤ) * k - b + (1 : ℤ) → + ⟨a, b⟩ ∈ FootprintVertices (DiamondTile K.1) ) := by + classical + intro K k a b h + apply (P5352T2DomainRows K ⟨a,b⟩).1.mpr + simpa [k] using h + +private theorem predMem : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (((K.1-1 : Nat) : Int) = k-1) → (∀ (a : ℤ), ∀ (b : ℤ), (0 : ℤ) ≤ b ∧ b ≤ (2 : ℤ) * (k - + (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ a ∧ a ≤ k - (1 : ℤ) ∧ -b - (1 : ℤ) ≤ a ∧ a ≤ b + (1 : ℤ) + ∧ -((2 : ℤ) * (k - (1 : ℤ)) - b + (1 : ℤ)) ≤ a ∧ a ≤ (2 : ℤ) * (k - (1 : ℤ)) - b + (1 + : ℤ) → ⟨a, b⟩ ∈ FootprintVertices (DiamondTile (K.1 - (1 : ℕ))))) ) := by + classical + intro K hk k hkm a b h + apply (P5352T2DomainRows ⟨K.1-1, by omega⟩ ⟨a,b⟩).1.mpr + simpa [hkm] using h + +private theorem childValue : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), + let child := P5352T2Sources K hk 0 + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + (∀ y ∈ FootprintVertices child.1, f y = child.2.1 y) → ((child.1 = DiamondTile K.1) → + ((child.2.1 = DiamondOdometer K) → (∀ w ∈ FootprintVertices (DiamondTile K.1), f w = + Q w.re w.im))) ) := by + classical + intro K hk f child Q hchild hchildTile hchildSrc w hw + have h := hchild w (by rw [hchildTile]; exact hw) + rw [hchildSrc] at h + rw [h, (P5352T2DomainRows K w).2 hw] + +private theorem childOdo : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), + let child := P5352T2Sources K hk 0 + (∀ y ∈ FootprintVertices child.1, f y = child.2.1 y) → ((child.1 = DiamondTile K.1) → + ((child.2.1 = DiamondOdometer K) → (∀ w ∈ FootprintVertices (DiamondTile K.1), f w = + DiamondOdometer K w))) ) := by + classical + intro K hk f child hchild hchildTile hchildSrc w hw + have h := hchild w (by rw [hchildTile]; exact hw) + simpa [hchildSrc] using h + +private theorem predValue : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1 + let pred := P5352T2Sources K hk 3 + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + ∀ (hkm : ((K.1-1 : Nat) : Int) = k-1), (pred.2.1 = DiamondOdometer ⟨K.1-1, + by omega⟩) → (∀ w ∈ FootprintVertices (DiamondTile (K.1 - (1 : ℕ))), pred.2.1 w = Q + w.re w.im)) := by + classical + intro K hk k pred Q hkm hpredSrc w hw + let Kp : DiamondParameter := ⟨K.1-1, by omega⟩ + have h := (P5352T2DomainRows Kp w).2 (by simpa [Kp] using hw) + rw [hpredSrc] + simpa [Q] using h + +private theorem predTranslatedValue : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), + let k : Int := K.1 + let pred := P5352T2Sources K hk 3 + let d : GaussianInt := ⟨-k, 1-k⟩ + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + (∀ (y : GaussianInt), y - d ∈ FootprintVertices pred.1 → f y = pred.2.1 (y - d) + (⟨(1 : + ℤ) - k, (-1 : ℤ)⟩ : GaussianInt).re * y.re + (⟨(1 : ℤ) - k, (-1 : ℤ)⟩ : + GaussianInt).im * y.im + B) → ((pred.1 = DiamondTile (K.1-1)) → ((∀ (w : + GaussianInt), (w ∈ FootprintVertices (DiamondTile (K.1-1))) → (pred.2.1 w = Q w.re + w.im)) → (∀ (y : GaussianInt), y - d ∈ FootprintVertices (DiamondTile (K.1 - (1 : + ℕ))) → f y = Q (y - d).re (y - d).im + ((1 : ℤ) - k) * y.re - y.im + B))) ) := by + classical + intro K hk f B k pred d Q hpred hpredTile predValue y hy + have h := hpred y (by rw [hpredTile]; exact hy) + have hv := predValue (y-d) hy + rw [hv] at h + convert h using 1; ring + +private theorem floorEven : + (by + classical + exact + ∀ (m : ℤ), ((-2 : ℤ) * m) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) ) := by + classical + intro m + have h := P4207T1FloorArithmetic.1 0 (-m) + have he : 0+2*(-m) = -2*m := by ring + simpa [he] using h + +private theorem floorOdd : + (by + classical + exact + (DiamondParameter) → (∀ (m : ℤ), ((1 : ℤ) - (2 : ℤ) * m) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : + ℕ) - m) ) := by + classical + intro K m + have h := P4207T1FloorArithmetic.1 1 (-m) + have he : 1+2*(-m) = 1-2*m := by ring + rw [he] at h + norm_num at h ⊢ + omega + +private theorem cases : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + (((K.1-1 : Nat) : Int) = k-1) → (∀ (a : ℤ), ∀ (b : ℤ), ((0 : ℤ) ≤ b ∧ b ≤ (2 : ℤ) * (↑K.1 + : ℤ) ∧ -(↑K.1 : ℤ) ≤ a ∧ a ≤ (↑K.1 : ℤ) ∧ -b - (1 : ℤ) ≤ a ∧ a ≤ b + (1 : ℤ) ∧ -((2 : + ℤ) * (↑K.1 : ℤ) - b + (1 : ℤ)) ≤ a ∧ a ≤ (2 : ℤ) * (↑K.1 : ℤ) - b + (1 : ℤ)) → (((0 : + ℤ) ≤ b - ((1 : ℤ) - k) ∧ b - ((1 : ℤ) - k) ≤ (2 : ℤ) * (k - (1 : ℤ)) ∧ -(k - (1 : ℤ)) + ≤ a - -k ∧ a - -k ≤ k - (1 : ℤ) ∧ -(b - ((1 : ℤ) - k)) - (1 : ℤ) ≤ a - -k ∧ a - -k ≤ + b - ((1 : ℤ) - k) + (1 : ℤ) ∧ -((2 : ℤ) * (k - (1 : ℤ)) - (b - ((1 : ℤ) - k)) + (1 : + ℤ)) ≤ a - -k ∧ a - -k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - ((1 : ℤ) - k)) + (1 : ℤ)) → + ((∃ t : Int, 1 ≤ t ∧ t ≤ k ∧ a = -t ∧ b = t-1) ∨ (∃ t : Int, 1 ≤ t ∧ t < k ∧ a = -t ∧ + b = t)))) ) := by + classical + intro K k hkm a b hc hp + have hs : a+b=-1 ∨ a+b=0 := by omega + rcases hs with hs | hs + · left + refine ⟨-a, ?_, ?_, ?_, ?_⟩ <;> omega + · right + refine ⟨-a, ?_, ?_, ?_, ?_⟩ <;> omega + +private theorem hComp : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1 + let child := P5352T2Sources K hk 0 + let pred := P5352T2Sources K hk 3 + let d : GaussianInt := ⟨-k, 1-k⟩ + let r : GaussianInt := ⟨-2*k, 0⟩ + (((K.1-1 : Nat) : Int) = k-1) → ((∀ (a : Int), ∀ (b : Int), (0 ≤ b ∧ b ≤ 2*k ∧ -k ≤ a ∧ a + ≤ k ∧ -b-1 ≤ a ∧ a ≤ b+1 ∧ -(2*k-b+1) ≤ a ∧ a ≤ 2*k-b+1) → ((⟨a,b⟩ : GaussianInt) ∈ + FootprintVertices (DiamondTile K.1))) → (∀ (t : ℤ), ((1 : ℤ) ≤ t) → ((t ≤ k) → ((⟨-t, + t - (1 : ℤ)⟩ ∈ FootprintVertices child.1) → ((⟨-t, t - (1 : ℤ)⟩ - d ∈ + FootprintVertices pred.1) → ((∀ (y : GaussianInt), y = ⟨-t, t - (1 : ℤ)⟩ ∨ y = ⟨-t, t + - (1 : ℤ)⟩ + (1 : GaussianInt) ∨ y = ⟨-t, t - (1 : ℤ)⟩ - (1 : GaussianInt) ∨ y = ⟨-t, + t - (1 : ℤ)⟩ + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨-t, t - (1 : ℤ)⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ + FootprintVertices child.1 ∨ y - d ∈ FootprintVertices pred.1) → (((0 : ℤ) ≤ t - (1 : + ℤ) ∧ t - (1 : ℤ) ≤ (2 : ℤ) * (↑K.1 : ℤ) ∧ -(↑K.1 : ℤ) ≤ -t ∧ -t ≤ (↑K.1 : ℤ) ∧ -(t - + (1 : ℤ)) - (1 : ℤ) ≤ -t ∧ -t ≤ t - (1 : ℤ) + (1 : ℤ) ∧ -((2 : ℤ) * (↑K.1 : ℤ) - (t - + (1 : ℤ)) + (1 : ℤ)) ≤ -t ∧ -t ≤ (2 : ℤ) * (↑K.1 : ℤ) - (t - (1 : ℤ)) + (1 : ℤ)) → + (((0 : ℤ) ≤ t - (1 : ℤ) - ((1 : ℤ) - k) ∧ t - (1 : ℤ) - ((1 : ℤ) - k) ≤ (2 : ℤ) * (k + - (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ -t - -k ∧ -t - -k ≤ k - (1 : ℤ) ∧ -(t - (1 : ℤ) - ((1 : + ℤ) - k)) - (1 : ℤ) ≤ -t - -k ∧ -t - -k ≤ t - (1 : ℤ) - ((1 : ℤ) - k) + (1 : ℤ) ∧ -((2 + : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) ≤ -t - -k ∧ -t - -k ≤ + (2 : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) → ( + let x : GaussianInt := ⟨-t,t-1⟩ + x-r ∈ FootprintVertices (DiamondTile K.1) ↔ t=k))))))))) ) := by + classical + intro K hk k child pred d r hkm childMem t ht1 htk hz hpz hcover hc hp x + constructor + · intro hh + have h := (P5352T2DomainRows K (x-r)).1.mp hh + simp only [x, r, Zsqrtd.re_sub, Zsqrtd.im_sub] at h + omega + · intro ht + subst t + have hm : x-r = (⟨k,k-1⟩ : GaussianInt) := by + ext <;> simp [x,r]; ring + rw [hm] + exact childMem k (k-1) (by omega) + +private theorem hPC : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1 + let pred := P5352T2Sources K hk 3 + let d : GaussianInt := ⟨-k, 1-k⟩ + (pred.1 = DiamondTile (K.1-1)) → (∀ (t : ℤ), (⟨-t, t - (1 : ℤ)⟩ - d ∈ FootprintVertices + pred.1) → ( + let x : GaussianInt := ⟨-t,t-1⟩ + x-d ∈ FootprintVertices (DiamondTile (K.1-1)))) ) := by + classical + intro K hk k pred d hpredTile t hpz x + have hpz' := hpredTile ▸ hpz + simpa [x,d] using hpz' + +private theorem hPW : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (((K.1-1 : Nat) : Int) = k-1) → ((∀ (a : Int), ∀ (b : Int), (0 ≤ b ∧ b ≤ 2*(k-1) ∧ -(k-1) + ≤ a ∧ a ≤ k-1 ∧ -b-1 ≤ a ∧ a ≤ b+1 ∧ -(2*(k-1)-b+1) ≤ a ∧ a ≤ 2*(k-1)-b+1) → ((⟨a,b⟩ + : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1)))) → (∀ (t : ℤ), ((1 : ℤ) ≤ + t) → ((t ≤ k) → (((0 : ℤ) ≤ t - (1 : ℤ) - ((1 : ℤ) - k) ∧ t - (1 : ℤ) - ((1 : ℤ) - k) + ≤ (2 : ℤ) * (k - (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ -t - -k ∧ -t - -k ≤ k - (1 : ℤ) ∧ -(t - + (1 : ℤ) - ((1 : ℤ) - k)) - (1 : ℤ) ≤ -t - -k ∧ -t - -k ≤ t - (1 : ℤ) - ((1 : ℤ) - k) + + (1 : ℤ) ∧ -((2 : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) ≤ -t + - -k ∧ -t - -k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) → + ((⟨k-t-1,k+t-2⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1)))))))) ) := by + classical + intro K hk k hkm predMem t ht1 htk hp + apply predMem; omega + +private theorem hPS : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (((K.1-1 : Nat) : Int) = k-1) → ((∀ (a : Int), ∀ (b : Int), (0 ≤ b ∧ b ≤ 2*(k-1) ∧ -(k-1) + ≤ a ∧ a ≤ k-1 ∧ -b-1 ≤ a ∧ a ≤ b+1 ∧ -(2*(k-1)-b+1) ≤ a ∧ a ≤ 2*(k-1)-b+1) → ((⟨a,b⟩ + : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1)))) → (∀ (t : ℤ), ((1 : ℤ) ≤ + t) → ((t ≤ k) → (((0 : ℤ) ≤ t - (1 : ℤ) - ((1 : ℤ) - k) ∧ t - (1 : ℤ) - ((1 : ℤ) - k) + ≤ (2 : ℤ) * (k - (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ -t - -k ∧ -t - -k ≤ k - (1 : ℤ) ∧ -(t - + (1 : ℤ) - ((1 : ℤ) - k)) - (1 : ℤ) ≤ -t - -k ∧ -t - -k ≤ t - (1 : ℤ) - ((1 : ℤ) - k) + + (1 : ℤ) ∧ -((2 : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) ≤ -t + - -k ∧ -t - -k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) → + ((⟨k-t,k+t-3⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1)))))))) ) := by + classical + intro K hk k hkm predMem t ht1 htk hp + apply predMem; omega + +private theorem hPredC : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let d : GaussianInt := ⟨-k, 1-k⟩ + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + (∀ (y : GaussianInt), (y-d ∈ FootprintVertices (DiamondTile (K.1-1))) → (f y = Q (y-d).re + (y-d).im + (1-k)*y.re-y.im+B)) → (∀ (t : ℤ), + let x : GaussianInt := ⟨-t,t-1⟩ + (x-d ∈ FootprintVertices (DiamondTile (K.1-1))) → (f x = Q (k-t) (k+t-2) + (1-k)*(-t) - + (t-1)+B)) ) := by + classical + intro K f B k d Q predTranslatedValue t x hPC + have h := predTranslatedValue x (by + simpa [x,d] using hPC) + convert h using 1; simp [x,d]; congr 1 <;> ring + +private theorem hPredW : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let d : GaussianInt := ⟨-k, 1-k⟩ + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + (∀ (y : GaussianInt), (y-d ∈ FootprintVertices (DiamondTile (K.1-1))) → (f y = Q (y-d).re + (y-d).im + (1-k)*y.re-y.im+B)) → (∀ (t : ℤ), ((⟨k-t-1,k+t-2⟩ : GaussianInt) ∈ + FootprintVertices (DiamondTile (K.1-1))) → (f (⟨-t-1,t-1⟩ : GaussianInt) = Q (k-t-1) + (k+t-2) + (1-k)*(-t-1) - (t-1)+B)) ) := by + classical + intro K f B k d Q predTranslatedValue t hPW + have hy : (⟨-t-1,t-1⟩ : GaussianInt)-d = ⟨k-t-1,k+t-2⟩ := by + ext <;> simp [d] <;> ring + have h := predTranslatedValue ⟨-t-1,t-1⟩ (by rw [hy]; exact hPW) + convert h using 1; simp [hy,d] + +private theorem hPredS : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let d : GaussianInt := ⟨-k, 1-k⟩ + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + (∀ (y : GaussianInt), (y-d ∈ FootprintVertices (DiamondTile (K.1-1))) → (f y = Q (y-d).re + (y-d).im + (1-k)*y.re-y.im+B)) → (∀ (t : ℤ), ((⟨k-t,k+t-3⟩ : GaussianInt) ∈ + FootprintVertices (DiamondTile (K.1-1))) → (f (⟨-t,t-2⟩ : GaussianInt) = Q (k-t) + (k+t-3) + (1-k)*(-t) - (t-2)+B)) ) := by + classical + intro K f B k d Q predTranslatedValue t hPS + have hy : (⟨-t,t-2⟩ : GaussianInt)-d = ⟨k-t,k+t-3⟩ := by + ext <;> simp [d] <;> ring + have h := predTranslatedValue ⟨-t,t-2⟩ (by rw [hy]; exact hPS) + convert h using 1; simp [hy,d] + +private theorem tri : + (by + classical + exact + (DiamondParameter) → ((IntegerLatticeFunction) → ((Int) → ((ℤ) → (∀ (n : ℤ), (2 : ℤ) * (n + * (n - (1 : ℤ)) / (2 : ℤ)) = n * (n - (1 : ℤ)))))) ) := by + classical + intro K f B t n + rcases Int.emod_two_eq_zero_or_one n with h | h + · have hn : n=2*(n/2) := by omega + rw [hn] + have he : 2*(n/2)*(2*(n/2)-1)=2*((n/2)*(2*(n/2)-1)) := by ring + rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + · have hn : n=2*(n/2)+1 := by omega + rw [hn] + have he : (2*(n/2)+1)*(2*(n/2)+1-1)= + 2*((2*(n/2)+1)*(n/2)) := by ring + rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + +private theorem tdiff : + (by + classical + exact + (∀ (n : Int), 2*(n*(n-1)/2)=n*(n-1)) → (∀ (n : ℤ), n * (n - (1 : ℤ)) / (2 : ℤ) - (n - (1 + : ℤ)) * (n - (2 : ℤ)) / (2 : ℤ) = n - (1 : ℤ)) ) := by + classical + intro tri n + have h0 := tri n + have h1 : 2*((n-1)*(n-2)/2)=(n-1)*(n-2) := by + simpa [show n-1-1=n-2 by ring] using tri (n-1) + have he : 2*(n*(n-1)/2-(n-1)*(n-2)/2)=2*(n-1) := by + rw [mul_sub, h0, h1] + ring + exact mul_left_cancel₀ (by norm_num : (2:Int) ≠ 0) he + +private theorem qChildC : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + (∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (∀ (t : ℤ), ((1 : ℤ) ≤ t) → ( + let x : GaussianInt := ⟨-t,t-1⟩ + (f x = Q (-t) (t-1)) → ((f x = Q (k-t) (k+t-2) + (1-k)*(-t) - (t-1)+B) → ((f (⟨-t-1,t-1⟩ + : GaussianInt) = Q (k-t-1) (k+t-2) + (1-k)*(-t-1) - (t-1)+B) → ((∀ (n : Int), + 2*(n*(n-1)/2)=n*(n-1)) → (Q (-t) (t-1) = -(t*(t-1)/2))))))) ) := by + classical + intro K f B k Q floorOdd t ht1 x hChildC hPredC hPredW tri + simp only [Q, Int.natCast_natAbs] + rw [abs_of_nonpos (by omega : -t ≤ 0)] + simp only [neg_neg] + rw [show -t-(t-1)=1-2*t by ring, floorOdd] + have hp : t^2-t=2*(t*(t-1)/2) := by + have h := tri t + simpa [show t*(t-1)=t^2-t by ring] using h.symm + rw [hp] + ring + +private theorem qChildE : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + (∀ (m : Int), (-2*m)^2/4 = m^2) → (∀ (t : ℤ), ((1 : ℤ) ≤ t) → ( + let x : GaussianInt := ⟨-t,t-1⟩ + (f x = Q (-t) (t-1)) → ((f x = Q (k-t) (k+t-2) + (1-k)*(-t) - (t-1)+B) → ((f (⟨-t-1,t-1⟩ + : GaussianInt) = Q (k-t-1) (k+t-2) + (1-k)*(-t-1) - (t-1)+B) → ((∀ (n : Int), + 2*(n*(n-1)/2)=n*(n-1)) → ((∀ (n : Int), n*(n-1)/2-(n-1)*(n-2)/2=n-1) → (Q (1-t) (t-1) + = -(t*(t-1)/2)))))))) ) := by + classical + intro K f B k Q floorEven t ht1 x hChildC hPredC hPredW tri tdiff + simp only [Q, Int.natCast_natAbs] + rw [abs_of_nonpos (by omega : 1-t ≤ 0)] + simp only [neg_sub] + rw [show (1-t)-(t-1)=-2*(t-1) by ring, floorEven] + have ht : 2*((t-1)*(t-2)/2)=(t-1)*(t-2) := by + simpa [show t-1-1=t-2 by ring] using tri (t-1) + have hs : (t-1)^2=2*((t-1)*(t-2)/2)+(t-1) := by rw [ht]; ring + have he : t*(t-1)/2=(t-1)*(t-2)/2+(t-1) := by + have h := tdiff t + omega + rw [hs, he] + ring + +private theorem qChildN : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + (∀ (m : Int), (-2*m)^2/4 = m^2) → (∀ (t : ℤ), ((1 : ℤ) ≤ t) → ( + let x : GaussianInt := ⟨-t,t-1⟩ + (f x = Q (-t) (t-1)) → ((f x = Q (k-t) (k+t-2) + (1-k)*(-t) - (t-1)+B) → ((f (⟨-t-1,t-1⟩ + : GaussianInt) = Q (k-t-1) (k+t-2) + (1-k)*(-t-1) - (t-1)+B) → ((∀ (n : Int), + 2*(n*(n-1)/2)=n*(n-1)) → ((∀ (n : Int), n*(n-1)/2-(n-1)*(n-2)/2=n-1) → (Q (-t) t = + -(t*(t+1)/2)))))))) ) := by + classical + intro K f B k Q floorEven t ht1 x hChildC hPredC hPredW tri tdiff + simp only [Q, Int.natCast_natAbs] + rw [abs_of_nonpos (by omega : -t ≤ 0)] + simp only [neg_neg] + rw [show -t-t=-2*t by ring, floorEven] + have hs : t^2=2*(t*(t-1)/2)+t := by + have hp : t^2=t*(t-1)+t := by ring + calc + t^2 = t*(t-1)+t := hp + _ = 2*(t*(t-1)/2)+t := by + exact congrArg (fun u : Int => u+t) (tri t).symm + have hn : t*(t+1)/2=t*(t-1)/2+t := by + have h := tdiff (t+1) + have h' : (t+1)*t/2-t*(t-1)/2=t := by + simpa [show t+1-1=t by ring, show t+1-2=t-1 by ring] using h + have hmul : (t+1)*t/2=t*(t+1)/2 := by ring + rw [← hmul] + omega + rw [hs, hn] + ring + +private theorem qPredC : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + (((K.1-1 : Nat) : Int) = k-1) → ((∀ (m : Int), (-2*m)^2/4 = m^2) → (∀ (t : ℤ), (t ≤ k) → ( + let x : GaussianInt := ⟨-t,t-1⟩ + (f x = Q (-t) (t-1)) → ((f x = Q (k-t) (k+t-2) + (1-k)*(-t) - (t-1)+B) → ((f (⟨-t-1,t-1⟩ + : GaussianInt) = Q (k-t-1) (k+t-2) + (1-k)*(-t-1) - (t-1)+B) → (Q (k-t) (k+t-2) = + (k-t)*(k-t-1)/2-(t-1)^2)))))) ) := by + classical + intro K f B k Q hkm floorEven t htk x hChildC hPredC hPredW + simp only [Q, Int.natCast_natAbs] + rw [abs_of_nonneg (by omega : 0 ≤ k-t)] + rw [show (k-t)-(k+t-2)=-2*(t-1) by ring, floorEven] + +private theorem qPredWlt : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + (((K.1-1 : Nat) : Int) = k-1) → ((∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (∀ (t : ℤ), + let x : GaussianInt := ⟨-t,t-1⟩ + (f x = Q (-t) (t-1)) → ((f x = Q (k-t) (k+t-2) + (1-k)*(-t) - (t-1)+B) → ((f (⟨-t-1,t-1⟩ + : GaussianInt) = Q (k-t-1) (k+t-2) + (1-k)*(-t-1) - (t-1)+B) → (t < k → Q (k - t - (1 + : ℤ)) (k + t - (2 : ℤ)) = (k - t - (1 : ℤ)) * (k - t - (2 : ℤ)) / (2 : ℤ) - (t * t - + t)))))) ) := by + classical + intro K f B k Q hkm floorOdd t x hChildC hPredC hPredW ht + simp only [Q, Int.natCast_natAbs] + rw [abs_of_nonneg (by omega : 0 ≤ k-t-1)] + rw [show (k-t-1)-(k+t-2)=1-2*t by ring, floorOdd] + ring + +private theorem qPredWeq : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), + let k : Int := K.1 + let child := P5352T2Sources K hk 0 + let pred := P5352T2Sources K hk 3 + let d : GaussianInt := ⟨-k, 1-k⟩ + let r : GaussianInt := ⟨-2*k, 0⟩ + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + (∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (∀ (t : ℤ), ((1 : ℤ) ≤ t) → ((t ≤ k) → ((⟨-t, t - (1 + : ℤ)⟩ ∈ FootprintVertices child.1) → ((⟨-t, t - (1 : ℤ)⟩ - d ∈ FootprintVertices + pred.1) → ((∀ (y : GaussianInt), y = ⟨-t, t - (1 : ℤ)⟩ ∨ y = ⟨-t, t - (1 : ℤ)⟩ + (1 : + GaussianInt) ∨ y = ⟨-t, t - (1 : ℤ)⟩ - (1 : GaussianInt) ∨ y = ⟨-t, t - (1 : ℤ)⟩ + + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨-t, t - (1 : ℤ)⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ + FootprintVertices child.1 ∨ y - d ∈ FootprintVertices pred.1) → (((0 : ℤ) ≤ t - (1 : + ℤ) ∧ t - (1 : ℤ) ≤ (2 : ℤ) * (↑K.1 : ℤ) ∧ -(↑K.1 : ℤ) ≤ -t ∧ -t ≤ (↑K.1 : ℤ) ∧ -(t - + (1 : ℤ)) - (1 : ℤ) ≤ -t ∧ -t ≤ t - (1 : ℤ) + (1 : ℤ) ∧ -((2 : ℤ) * (↑K.1 : ℤ) - (t - + (1 : ℤ)) + (1 : ℤ)) ≤ -t ∧ -t ≤ (2 : ℤ) * (↑K.1 : ℤ) - (t - (1 : ℤ)) + (1 : ℤ)) → + (((0 : ℤ) ≤ t - (1 : ℤ) - ((1 : ℤ) - k) ∧ t - (1 : ℤ) - ((1 : ℤ) - k) ≤ (2 : ℤ) * (k + - (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ -t - -k ∧ -t - -k ≤ k - (1 : ℤ) ∧ -(t - (1 : ℤ) - ((1 : + ℤ) - k)) - (1 : ℤ) ≤ -t - -k ∧ -t - -k ≤ t - (1 : ℤ) - ((1 : ℤ) - k) + (1 : ℤ) ∧ -((2 + : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) ≤ -t - -k ∧ -t - -k ≤ + (2 : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) → ( + let x : GaussianInt := ⟨-t,t-1⟩ + (x-r ∈ FootprintVertices (DiamondTile K.1) ↔ t=k) → ((x ∈ FootprintVertices (DiamondTile + K.1)) → (((⟨1-t,t-1⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → + (((⟨-t,t⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → ((x-d ∈ + FootprintVertices (DiamondTile (K.1-1))) → (((⟨k-t-1,k+t-2⟩ : GaussianInt) ∈ + FootprintVertices (DiamondTile (K.1-1))) → (((⟨k-t,k+t-3⟩ : GaussianInt) ∈ + FootprintVertices (DiamondTile (K.1-1))) → ((f x = Q (-t) (t-1)) → ((f (⟨1-t,t-1⟩ : + GaussianInt) = Q (1-t) (t-1)) → ((f (⟨-t,t⟩ : GaussianInt) = Q (-t) t) → ((f x = Q + (k-t) (k+t-2) + (1-k)*(-t) - (t-1)+B) → ((f (⟨-t-1,t-1⟩ : GaussianInt) = Q (k-t-1) + (k+t-2) + (1-k)*(-t-1) - (t-1)+B) → ((f (⟨-t,t-2⟩ : GaussianInt) = Q (k-t) (k+t-3) + + (1-k)*(-t) - (t-2)+B) → ((Q (-t) (t-1) = -(t*(t-1)/2)) → ((Q (1-t) (t-1) = + -(t*(t-1)/2)) → ((Q (-t) t = -(t*(t+1)/2)) → ((Q (k-t) (k+t-2) = + (k-t)*(k-t-1)/2-(t-1)^2) → (((t + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + (((K.1-1 : Nat) : Int) = k-1) → ((∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (∀ (t : ℤ), (t ≤ k) + → ( + let x : GaussianInt := ⟨-t,t-1⟩ + (f x = Q (-t) (t-1)) → ((f x = Q (k-t) (k+t-2) + (1-k)*(-t) - (t-1)+B) → ((f (⟨-t-1,t-1⟩ + : GaussianInt) = Q (k-t-1) (k+t-2) + (1-k)*(-t-1) - (t-1)+B) → (Q (k-t) (k+t-3) = + (k-t)*(k-t-1)/2-((t-1)^2-(t-1)))))))) ) := by + classical + intro K f B k Q hkm floorOdd t htk x hChildC hPredC hPredW + simp only [Q, Int.natCast_natAbs] + rw [abs_of_nonneg (by omega : 0 ≤ k-t)] + rw [show (k-t)-(k+t-3)=1-2*(t-1) by ring, floorOdd] + +private theorem hEastDiff : + (by + classical + exact + ∀ (f : IntegerLatticeFunction), + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + ∀ (t : ℤ), + let x : GaussianInt := ⟨-t,t-1⟩ + (f x = Q (-t) (t-1)) → ((f (⟨1-t,t-1⟩ : GaussianInt) = Q (1-t) (t-1)) → ((Q (-t) (t-1) = + -(t*(t-1)/2)) → ((Q (1-t) (t-1) = -(t*(t-1)/2)) → (f (x+1)-f x = 0)))) ) := by + classical + intro f Q t x hChildC hChildE qChildC qChildE + have he : x+1 = ⟨1-t,t-1⟩ := by ext <;> simp [x]; ring + rw [he, hChildE, hChildC, qChildE, qChildC] + ring + +private theorem hWestDiff : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), + let k : Int := K.1 + let child := P5352T2Sources K hk 0 + let pred := P5352T2Sources K hk 3 + let d : GaussianInt := ⟨-k, 1-k⟩ + let r : GaussianInt := ⟨-2*k, 0⟩ + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + (((K.1-1 : Nat) : Int) = k-1) → (∀ (t : ℤ), ((1 : ℤ) ≤ t) → ((t ≤ k) → ((⟨-t, t - (1 : + ℤ)⟩ ∈ FootprintVertices child.1) → ((⟨-t, t - (1 : ℤ)⟩ - d ∈ FootprintVertices + pred.1) → ((∀ (y : GaussianInt), y = ⟨-t, t - (1 : ℤ)⟩ ∨ y = ⟨-t, t - (1 : ℤ)⟩ + (1 : + GaussianInt) ∨ y = ⟨-t, t - (1 : ℤ)⟩ - (1 : GaussianInt) ∨ y = ⟨-t, t - (1 : ℤ)⟩ + + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨-t, t - (1 : ℤ)⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ + FootprintVertices child.1 ∨ y - d ∈ FootprintVertices pred.1) → (((0 : ℤ) ≤ t - (1 : + ℤ) ∧ t - (1 : ℤ) ≤ (2 : ℤ) * (↑K.1 : ℤ) ∧ -(↑K.1 : ℤ) ≤ -t ∧ -t ≤ (↑K.1 : ℤ) ∧ -(t - + (1 : ℤ)) - (1 : ℤ) ≤ -t ∧ -t ≤ t - (1 : ℤ) + (1 : ℤ) ∧ -((2 : ℤ) * (↑K.1 : ℤ) - (t - + (1 : ℤ)) + (1 : ℤ)) ≤ -t ∧ -t ≤ (2 : ℤ) * (↑K.1 : ℤ) - (t - (1 : ℤ)) + (1 : ℤ)) → + (((0 : ℤ) ≤ t - (1 : ℤ) - ((1 : ℤ) - k) ∧ t - (1 : ℤ) - ((1 : ℤ) - k) ≤ (2 : ℤ) * (k + - (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ -t - -k ∧ -t - -k ≤ k - (1 : ℤ) ∧ -(t - (1 : ℤ) - ((1 : + ℤ) - k)) - (1 : ℤ) ≤ -t - -k ∧ -t - -k ≤ t - (1 : ℤ) - ((1 : ℤ) - k) + (1 : ℤ) ∧ -((2 + : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) ≤ -t - -k ∧ -t - -k ≤ + (2 : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) → ( + let x : GaussianInt := ⟨-t,t-1⟩ + (x-r ∈ FootprintVertices (DiamondTile K.1) ↔ t=k) → ((x ∈ FootprintVertices (DiamondTile + K.1)) → (((⟨1-t,t-1⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → + (((⟨-t,t⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → ((x-d ∈ + FootprintVertices (DiamondTile (K.1-1))) → (((⟨k-t-1,k+t-2⟩ : GaussianInt) ∈ + FootprintVertices (DiamondTile (K.1-1))) → (((⟨k-t,k+t-3⟩ : GaussianInt) ∈ + FootprintVertices (DiamondTile (K.1-1))) → ((f x = Q (-t) (t-1)) → ((f (⟨1-t,t-1⟩ : + GaussianInt) = Q (1-t) (t-1)) → ((f (⟨-t,t⟩ : GaussianInt) = Q (-t) t) → ((f x = Q + (k-t) (k+t-2) + (1-k)*(-t) - (t-1)+B) → ((f (⟨-t-1,t-1⟩ : GaussianInt) = Q (k-t-1) + (k+t-2) + (1-k)*(-t-1) - (t-1)+B) → ((f (⟨-t,t-2⟩ : GaussianInt) = Q (k-t) (k+t-3) + + (1-k)*(-t) - (t-2)+B) → ((∀ (n : Int), n*(n-1)/2-(n-1)*(n-2)/2=n-1) → ((Q (-t) (t-1) + = -(t*(t-1)/2)) → ((Q (1-t) (t-1) = -(t*(t-1)/2)) → ((Q (-t) t = -(t*(t+1)/2)) → ((Q + (k-t) (k+t-2) = (k-t)*(k-t-1)/2-(t-1)^2) → (((t simp [x] + rw [hw, hPredW, hChildC, hAgree] + by_cases ht : t=k + · subst t + simp only [] + rw [qPredWeq rfl, qPredC] + norm_num + ring + · have hlt : t + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + ∀ (t : ℤ), + let x : GaussianInt := ⟨-t,t-1⟩ + (f x = Q (-t) (t-1)) → ((f (⟨-t,t⟩ : GaussianInt) = Q (-t) t) → ((∀ (n : Int), + n*(n-1)/2-(n-1)*(n-2)/2=n-1) → ((Q (-t) (t-1) = -(t*(t-1)/2)) → ((Q (-t) t = + -(t*(t+1)/2)) → (f (x+⟨0,1⟩)-f x = -t))))) ) := by + classical + intro f Q t x hChildC hChildN tdiff qChildC qChildN + have hn : x+⟨0,1⟩ = ⟨-t,t⟩ := by ext <;> simp [x] + rw [hn, hChildN, hChildC, qChildN, qChildC] + have h := tdiff (t+1) + have h' : (t+1)*t/2-t*(t-1)/2=t := by + simpa [show t+1-1=t by ring, show t+1-2=t-1 by ring] using h + have hquot : t*(t+1)/2=(t+1)*t/2 := by + exact congrArg (fun n : Int => n/2) (by ring) + rw [hquot] + linear_combination -h' + +private theorem hSouthDiff : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + ∀ (t : ℤ), + let x : GaussianInt := ⟨-t,t-1⟩ + (f x = Q (-t) (t-1)) → ((f (⟨-t,t-2⟩ : GaussianInt) = Q (k-t) (k+t-3) + (1-k)*(-t) - + (t-2)+B) → ((Q (k-t) (k+t-2) = (k-t)*(k-t-1)/2-(t-1)^2) → ((Q (k-t) (k+t-3) = + (k-t)*(k-t-1)/2-((t-1)^2-(t-1))) → ((Q (-t) (t-1) = Q (k-t) (k+t-2) + + (1-k)*(-t)-(t-1)+B) → (f (x-⟨0,1⟩)-f x = t))))) ) := by + classical + intro K f B k Q t x hChildC hPredS qPredC qPredS hAgree + have hs : x-⟨0,1⟩ = ⟨-t,t-2⟩ := by ext <;> simp [x]; ring + rw [hs, hPredS, hChildC, hAgree, qPredS, qPredC] + ring + +private theorem lapIdentity : + (by + classical + exact + ∀ (g : IntegerLatticeFunction), ∀ (w : GaussianInt), FourNeighborLaplacian g w = g (w + + (1 : GaussianInt)) - g w + (g (w - (1 : GaussianInt)) - g w) + (g (w + ⟨(0 : ℤ), (1 : + ℤ)⟩) - g w) + (g (w - ⟨(0 : ℤ), (1 : ℤ)⟩) - g w) ) := by + classical + intro g w + unfold FourNeighborLaplacian + ring + +private theorem lap0 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + ∀ (t : ℤ), + let x : GaussianInt := ⟨-t,t-1⟩ + (f (x+1)-f x = 0) → ((f (x-1)-f x = if t=k then 0 else 1) → ((f (x+⟨0,1⟩)-f x = -t) → ((f + (x-⟨0,1⟩)-f x = t) → ((∀ (g : IntegerLatticeFunction), ∀ (w : GaussianInt), + FourNeighborLaplacian g w = (g (w+1)-g w)+(g (w-1)-g w)+ (g (w+⟨0,1⟩)-g w)+(g + (w-⟨0,1⟩)-g w)) → (t = k → FourNeighborLaplacian f x = (0 : ℤ)))))) ) := by + classical + intro K f k t x hEastDiff hWestDiff hNorthDiff hSouthDiff lapIdentity ht + rw [lapIdentity, hEastDiff, hWestDiff, hNorthDiff, hSouthDiff, ite_eq_left ht] + ring + +private theorem lap1 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + ∀ (t : ℤ), + let x : GaussianInt := ⟨-t,t-1⟩ + (f (x+1)-f x = 0) → ((f (x-1)-f x = if t=k then 0 else 1) → ((f (x+⟨0,1⟩)-f x = -t) → ((f + (x-⟨0,1⟩)-f x = t) → ((∀ (g : IntegerLatticeFunction), ∀ (w : GaussianInt), + FourNeighborLaplacian g w = (g (w+1)-g w)+(g (w-1)-g w)+ (g (w+⟨0,1⟩)-g w)+(g + (w-⟨0,1⟩)-g w)) → (t ≠ k → FourNeighborLaplacian f x = (1 : ℤ)))))) ) := by + classical + intro K f k t x hEastDiff hWestDiff hNorthDiff hSouthDiff lapIdentity ht + rw [lapIdentity, hEastDiff, hWestDiff, hNorthDiff, hSouthDiff, ite_eq_right ht] + ring + +private theorem htAt413 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1 + let child := P5352T2Sources K hk 0 + let r : GaussianInt := ⟨-2*k, 0⟩ + (child.1 = DiamondTile K.1) → (∀ (t : ℤ), (⟨-t, t - (1 : ℤ)⟩ - r ∉ FootprintVertices + child.1) → ( + let x : GaussianInt := ⟨-t,t-1⟩ + (x-r ∈ FootprintVertices (DiamondTile K.1) ↔ t=k) → (t≠k))) ) := by + classical + intro K hk k child r hchildTile t hc x hComp ht + apply hc + have hh := hComp.mpr ht + simpa [hchildTile] using hh + +private theorem hLap : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (u : ℤ), + let x : GaussianInt := ⟨-u,u⟩ + (f x = DiamondOdometer K x) → ((f ⟨(1 : ℤ) - u, u⟩ = DiamondOdometer K ⟨(1 : ℤ) - u, u⟩) + → ((f ⟨-u - (1 : ℤ), u⟩ = DiamondOdometer K ⟨-u - (1 : ℤ), u⟩) → ((f ⟨-u, u + (1 : + ℤ)⟩ = DiamondOdometer K ⟨-u, u + (1 : ℤ)⟩) → ((f ⟨-u, u - (1 : ℤ)⟩ = DiamondOdometer + K ⟨-u, u - (1 : ℤ)⟩) → ((x+1 = (⟨1-u,u⟩ : GaussianInt)) → ((x-1 = (⟨-u-1,u⟩ : + GaussianInt)) → ((x+⟨0,1⟩ = (⟨-u,u+1⟩ : GaussianInt)) → ((x-⟨0,1⟩ = (⟨-u,u-1⟩ : + GaussianInt)) → (FourNeighborLaplacian f x = FourNeighborLaplacian (DiamondOdometer + K) x))))))))) ) := by + classical + intro K f u x h0 h1 h2 h3 h4 he hw hn hs + unfold FourNeighborLaplacian + rw [he, hw, hn, hs, h1, h2, h3, h4, h0] + +private theorem huK : + (by + classical + exact + ∀ (K : DiamondParameter), (IntegerLatticeFunction) → ( + let k : Int := K.1 + (((K.1-1 : Nat) : Int) = k-1) → (∀ (u : ℤ), (u < k) → (u ≤ (K.1 : Int)))) ) := by + classical + intro K f k hkm u huk + have huK' : u ≤ k := by omega + exact_mod_cast huK' + +private theorem habsA : + (by + classical + exact + (DiamondParameter) → ((IntegerLatticeFunction) → (∀ (u : ℤ), ((1 : ℤ) ≤ u) → ((Int.natAbs + (-u) : Int) = u))) ) := by + classical + intro K f u hu1 + rw [Int.natCast_natAbs, abs_of_nonpos (by omega : -u ≤ 0)] + ring + +private theorem habsB : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + (((K.1 : Nat) : Int) = k) → (∀ (u : ℤ), (u-(K.1:Int) ≤ 0) → ((Int.natAbs (u-(K.1:Int)) : + Int) = k-u)) ) := by + classical + intro K k hkc u hle + rw [Int.natCast_natAbs, abs_of_nonpos hle] + rw [hkc] + ring + +private theorem hNotTrue : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + (((K.1-1 : Nat) : Int) = k-1) → (∀ (u : ℤ), + let x : GaussianInt := ⟨-u,u⟩ + ((Int.natAbs (-u) : Int) = u) → (((Int.natAbs (u-(K.1:Int)) : Int) = k-u) → (x ∉ + DiamondVertexDomains K true))) ) := by + classical + intro K k hkm u x habsA habsB + change ¬ (Int.natAbs (-u) + Int.natAbs (u-(K.1:Int)) ≤ K.1-1) + intro hi + have hiI : ((Int.natAbs (-u) + Int.natAbs (u-(K.1:Int)) : Nat) : Int) ≤ + ((K.1-1 : Nat) : Int) := by exact_mod_cast hi + rw [Nat.cast_add, habsA, habsB, hkm] at hiI + clear * - hiI + omega + +private theorem hCompFalse : + (by + classical + exact + ∀ (K : DiamondParameter), (IntegerLatticeFunction) → ( + let k : Int := K.1 + let r : GaussianInt := ⟨-2*k, 0⟩ + (((K.1-1 : Nat) : Int) = k-1) → (∀ (u : ℤ), (u < k) → ( + let x : GaussianInt := ⟨-u,u⟩ + ((Int.natAbs (-u) : Int) = u) → (((Int.natAbs (u-(K.1:Int)) : Int) = k-u) → (x-r ∉ + FootprintVertices (DiamondTile K.1)))))) ) := by + classical + intro K f k r hkm u huk x habsA habsB hh + have h := (P5352T2DomainRows K (x-r)).1.mp hh + simp only [x, r, Zsqrtd.re_sub, Zsqrtd.im_sub] at h + omega + +end FourthPredecessorCases + +theorem P5352T2Predecessor3 (K : DiamondParameter) (hk : 1 < K.1) + (f : IntegerLatticeFunction) (B : Int) (z : GaussianInt) : + let A := P5352T2Sources K hk 0 + let D := P5352T2Sources K hk 3 + let M := (P5352T2PlacementData K.1 2).2 3 + (∀ y, y ∈ FootprintVertices A.1 → f y = A.2.1 y) → + (∀ y, y - M.1 ∈ FootprintVertices D.1 → + f y = D.2.1 (y - M.1) + M.2.1.re*y.re + M.2.1.im*y.im + B) → + z ∈ FootprintVertices A.1 → z - M.1 ∈ FootprintVertices D.1 → + (∀ y, y = z ∨ y = z + 1 ∨ y = z - 1 ∨ + y = z + ⟨0, 1⟩ ∨ y = z - ⟨0, 1⟩ → + y ∈ FootprintVertices A.1 ∨ y - M.1 ∈ FootprintVertices D.1) → + (z - M.2.2 ∈ FootprintVertices A.1 → FourNeighborLaplacian f z = 0) ∧ + (z - M.2.2 ∉ FootprintVertices A.1 → FourNeighborLaplacian f z = 1) := by +-- BODY + exact (by + classical + let k : Int := K.1 + let child := P5352T2Sources K hk 0 + let pred := P5352T2Sources K hk 3 + let M := (P5352T2PlacementData K.1 2).2 3 + let d : GaussianInt := ⟨-k, 1-k⟩ + let r : GaussianInt := ⟨-2*k, 0⟩ + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 + have hk2 : 2 ≤ k := by dsimp [k]; exact_mod_cast (show 2 ≤ K.1 by omega) + have hm : M.1 = d ∧ M.2.1 = ⟨1-k,-1⟩ ∧ M.2.2 = r := by + simp [M, d, r, P5352T2PlacementData, k] + rcases hm with ⟨hd, ha, hr⟩ + change + (∀ y, y ∈ FootprintVertices child.1 → f y = child.2.1 y) → + (∀ y, y - M.1 ∈ FootprintVertices pred.1 → + f y = pred.2.1 (y-M.1) + M.2.1.re*y.re + M.2.1.im*y.im+B) → + z ∈ FootprintVertices child.1 → z-M.1 ∈ FootprintVertices pred.1 → + (∀ y, y=z ∨ y=z+1 ∨ y=z-1 ∨ y=z+⟨0,1⟩ ∨ y=z-⟨0,1⟩ → + y ∈ FootprintVertices child.1 ∨ y-M.1 ∈ FootprintVertices pred.1) → + (z-M.2.2 ∈ FootprintVertices child.1 → FourNeighborLaplacian f z=0) ∧ + (z-M.2.2 ∉ FootprintVertices child.1 → FourNeighborLaplacian f z=1) + intro hchild hpred hz hpz hcover + rw [hd, ha] at hpred + rw [hd] at hpz hcover + rw [hr] at ⊢ + have hkc : ((K.1 : Nat) : Int) = k := by rfl + have hkm : ((K.1-1 : Nat) : Int) = k-1 := FourthPredecessorCases.hkm K hk + obtain ⟨_, _, _, hFoot, _, _⟩ := DiamondTileOdometerRestriction K + have hchildTile : child.1 = DiamondTile K.1 := by simp [child, P5352T2Sources] + have hpredTile : pred.1 = DiamondTile (K.1-1) := by simp [pred, P5352T2Sources] + have hchildSrc : child.2.1 = DiamondOdometer K := by + simp [child, P5352T2Sources] + have hpredSrc : pred.2.1 = DiamondOdometer ⟨K.1-1, by omega⟩ := by + simp [pred, P5352T2Sources] + have childMem (a b : Int) + (h : 0 ≤ b ∧ b ≤ 2*k ∧ -k ≤ a ∧ a ≤ k ∧ -b-1 ≤ a ∧ a ≤ b+1 ∧ + -(2*k-b+1) ≤ a ∧ a ≤ 2*k-b+1) := FourthPredecessorCases.childMem K a b h + have predMem (a b : Int) + (h : 0 ≤ b ∧ b ≤ 2*(k-1) ∧ -(k-1) ≤ a ∧ a ≤ k-1 ∧ + -b-1 ≤ a ∧ a ≤ b+1 ∧ -(2*(k-1)-b+1) ≤ a ∧ a ≤ 2*(k-1)-b+1) := + FourthPredecessorCases.predMem K hk hkm a b h + let Kp : DiamondParameter := ⟨K.1-1, by omega⟩ + have childValue (w : GaussianInt) + (hw : w ∈ FootprintVertices (DiamondTile K.1)) : + f w = Q w.re w.im := FourthPredecessorCases.childValue K hk f hchild hchildTile hchildSrc + w hw + have childOdo (w : GaussianInt) + (hw : w ∈ FootprintVertices (DiamondTile K.1)) := FourthPredecessorCases.childOdo K hk f + hchild hchildTile hchildSrc w hw + have predValue (w : GaussianInt) + (hw : w ∈ FootprintVertices (DiamondTile (K.1-1))) := FourthPredecessorCases.predValue K + hk hkm hpredSrc w hw + have predTranslatedValue (y : GaussianInt) + (hy : y-d ∈ FootprintVertices (DiamondTile (K.1-1))) := + FourthPredecessorCases.predTranslatedValue K hk f B hpred hpredTile predValue y hy + have floorEven (m : Int) := FourthPredecessorCases.floorEven m + have floorOdd (m : Int) := FourthPredecessorCases.floorOdd K m + rcases z with ⟨a,b⟩ + have hc := (P5352T2DomainRows K ⟨a,b⟩).1.mp (by simpa [hchildTile] using hz) + have hp := (P5352T2DomainRows ⟨K.1-1, by omega⟩ (⟨a,b⟩-d)).1.mp (by + simpa [hpredTile, d, hkm] using hpz) + rw [hkm] at hp + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, d] at hp + simp only [] at hc + have cases := FourthPredecessorCases.cases K hkm a b hc hp + rcases cases with ⟨t, ht1, htk, ha0, hb0⟩ | ⟨u, hu1, huk, ha0, hb0⟩ + · -- A_t = (-t,t-1) + subst a + subst b + let x : GaussianInt := ⟨-t,t-1⟩ + have hComp : x-r ∈ FootprintVertices (DiamondTile K.1) ↔ t=k := + FourthPredecessorCases.hComp K hk hkm childMem t ht1 htk hz hpz hcover hc hp + have hX : x ∈ FootprintVertices (DiamondTile K.1) := by + apply childMem (-t) (t-1); omega + have hE : (⟨1-t,t-1⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := by + apply childMem (1-t) (t-1); omega + have hN : (⟨-t,t⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := by + apply childMem (-t) t; omega + have hPC := FourthPredecessorCases.hPC K hk hpredTile t hpz + have hPW := FourthPredecessorCases.hPW K hk hkm predMem t ht1 htk hp + have hPS := FourthPredecessorCases.hPS K hk hkm predMem t ht1 htk hp + have hChildC : f x = Q (-t) (t-1) := by simpa [x] using childValue x hX + have hChildE : f (⟨1-t,t-1⟩ : GaussianInt) = Q (1-t) (t-1) := by + exact childValue _ hE + have hChildN : f (⟨-t,t⟩ : GaussianInt) = Q (-t) t := by + exact childValue _ hN + have hPredC : f x = Q (k-t) (k+t-2) + (1-k)*(-t) - (t-1)+B := FourthPredecessorCases.hPredC + K f B predTranslatedValue t hPC + have hPredW := FourthPredecessorCases.hPredW K f B predTranslatedValue t hPW + have hPredS := FourthPredecessorCases.hPredS K f B predTranslatedValue t hPS + have tri (n : Int) := FourthPredecessorCases.tri K f B t n + have tdiff (n : Int) := FourthPredecessorCases.tdiff tri n + have qChildC := FourthPredecessorCases.qChildC K f B floorOdd t ht1 hChildC hPredC hPredW tri + have qChildE := FourthPredecessorCases.qChildE K f B floorEven t ht1 hChildC hPredC hPredW + tri tdiff + have qChildN := FourthPredecessorCases.qChildN K f B floorEven t ht1 hChildC hPredC hPredW + tri tdiff + have qPredC := FourthPredecessorCases.qPredC K f B hkm floorEven t htk hChildC hPredC hPredW + have qPredWlt (ht : t simp [x]; ring + have hw : x-1 = (⟨-u-1,u⟩ : GaussianInt) := by ext <;> simp [x] + have hn : x+⟨0,1⟩ = (⟨-u,u+1⟩ : GaussianInt) := by ext <;> simp [x] + have hs : x-⟨0,1⟩ = (⟨-u,u-1⟩ : GaussianInt) := by ext <;> simp [x] + have hLap := FourthPredecessorCases.hLap K f u h0 h1 h2 h3 h4 he hw hn hs + have huK := FourthPredecessorCases.huK K f hkm u huk + have hFalse : x ∈ DiamondVertexDomains K false := by + exact hFoot ▸ hX + have habsA := FourthPredecessorCases.habsA K f u hu1 + have hle : u-(K.1:Int) ≤ 0 := by rw [hkc]; omega + have habsB := FourthPredecessorCases.habsB K hkc u hle + have hNotTrue := FourthPredecessorCases.hNotTrue K hkm u habsA habsB + have htable := (DiamondLaplacianTable K).2.1 x hFalse hNotTrue + have hLapOne : FourNeighborLaplacian f x=1 := hLap.trans htable + have hCompFalse := FourthPredecessorCases.hCompFalse K f hkm u huk habsA habsB + constructor + · intro hh + exact (hCompFalse hh).elim + · intro _ + exact hLapOne) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2RightFirst.lean b/LeanPool/ApollonianSuperharmonic/P5352T2RightFirst.lean new file mode 100644 index 0000000000..bd807f0325 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5352T2RightFirst.lean @@ -0,0 +1,797 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData +public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic +public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable + +-- [TABLET NODE: P5352T2RightFirst] + +/-! +# P5352T2RightFirst + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiamondRightFirst + +private theorem fourCells : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, k+1⟩ + let covered (x : GaussianInt) : Prop := + ∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → + y ∈ DiamondCellDomain K.1 ∨ y-rho ∈ DiamondCellDomain K.1 + ∀ (x : GaussianInt), covered x ↔ (x ∈ DiamondCellDomain K.1 ∨ x - rho ∈ DiamondCellDomain + K.1) ∧ (x - (1 : GaussianInt) ∈ DiamondCellDomain K.1 ∨ x - (1 : GaussianInt) - rho ∈ + DiamondCellDomain K.1) ∧ (x - ⟨(0 : ℤ), (1 : ℤ)⟩ ∈ DiamondCellDomain K.1 ∨ x - ⟨(0 : + ℤ), (1 : ℤ)⟩ - rho ∈ DiamondCellDomain K.1) ∧ (x - (1 : GaussianInt) - ⟨(0 : ℤ), (1 : + ℤ)⟩ ∈ DiamondCellDomain K.1 ∨ x - (1 : GaussianInt) - ⟨(0 : ℤ), (1 : ℤ)⟩ - rho ∈ + DiamondCellDomain K.1) ) := by + classical + intro K k rho covered x + constructor + · intro h + exact ⟨h x (Or.inl rfl), h (x-1) (Or.inr (Or.inl rfl)), + h (x-⟨0,1⟩) (Or.inr (Or.inr (Or.inl rfl))), + h (x-1-⟨0,1⟩) (Or.inr (Or.inr (Or.inr rfl)))⟩ + · rintro ⟨h0,h1,h2,h3⟩ y (rfl | rfl | rfl | rfl) + · exact h0 + · exact h1 + · exact h2 + · exact h3 + +private theorem contact : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (z : GaussianInt), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, k+1⟩ + (z ∈ FootprintVertices (DiamondTile K.1)) → ((z - rho ∈ FootprintVertices (DiamondTile + K.1)) → ((∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ + x.im ≤ 2*k ∧ -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ + x.re ∧ x.re ≤ 2*k-x.im+1) → ((∃ t : Int, 0 ≤ t ∧ t < k ∧ z = ⟨-k+t,k+t+1⟩) ∨ (∃ t : + Int, 0 ≤ t ∧ t < k ∧ z = ⟨-k+t+1,k+t+1⟩)))) ) := by + classical + intro K z k rho hz hzR foot + have h0 := (foot z).mp hz + have h1 := (foot (z-rho)).mp hzR + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] at h1 + dsimp [rho] at h1 + have hd : z.im-z.re = 2*k ∨ z.im-z.re = 2*k+1 := by omega + rcases hd with hd | hd + · right + refine ⟨z.re+k-1, by omega, by omega, ?_⟩ + ext <;> dsimp <;> omega + · left + refine ⟨z.re+k, by omega, by omega, ?_⟩ + ext <;> dsimp <;> omega + +private theorem tri : + (by + classical + exact + (DiamondParameter) → (∀ (a : ℤ), (2 : ℤ) * (a * (a - (1 : ℤ)) / (2 : ℤ)) = a * (a - (1 : + ℤ))) ) := by + classical + intro K a + rcases Int.emod_two_eq_zero_or_one a with h | h + · have ha : a = 2*(a/2) := by omega + rw [ha] + rw [show 2*(a/2)*(2*(a/2)-1) = 2*((a/2)*(2*(a/2)-1)) by ring, + Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + · have ha : a = 2*(a/2)+1 := by omega + rw [ha] + rw [show (2*(a/2)+1)*(2*(a/2)+1-1) = 2*((2*(a/2)+1)*(a/2)) by ring, + Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + +private theorem square : + (by + classical + exact + (DiamondParameter) → (∀ (a : ℤ), (4 : ℤ) * (a ^ (2 : ℕ) / (4 : ℤ)) = a ^ (2 : ℕ) - a % (2 + : ℤ)) ) := by + classical + intro K a + rcases Int.emod_two_eq_zero_or_one a with h | h + · have ha : a = 2*(a/2) := by omega + have he : a^2 = 4*(a/2)^2 := by + conv_lhs => rw [ha] + ring + rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (4:Int) ≠ 0), h] + ring + · have ha : a = 2*(a/2)+1 := by omega + have he : a^2 = 4*((a/2)^2+a/2)+1 := by + conv_lhs => rw [ha] + ring + rw [he, h] + omega + +private theorem scale : + (by + classical + exact + let Q (a b : Int) : Int := + (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), 2*(a*(a-1)/2) = a*(a-1)) → ((∀ (a : Int), 4*(a^2/4) = a^2-a%2) → (∀ (a : + ℤ), ∀ (b : ℤ), (4 : ℤ) * Q a b = S a b)) ) := by + classical + intro Q S tri square a b + have ht := tri (Int.natAbs a : Int) + have hs := square (a-b) + have ha : (Int.natAbs a : Int)^2 = a^2 := by + rw [Int.natCast_natAbs, sq_abs] + dsimp [Q, S] + rw [Int.natCast_natAbs] at ht ha ⊢ + nlinarith only [ht, hs, ha] + +private theorem sEven : + (by + classical + exact + (DiamondParameter) → ( + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + ∀ (a : ℤ), ∀ (b : ℤ), ∀ (m : ℤ), a - b = (2 : ℤ) * m → S a b = (2 : ℤ) * a ^ (2 : ℕ) - (2 + : ℤ) * |a| - (4 : ℤ) * m ^ (2 : ℕ)) ) := by + classical + intro K S a b m h + dsimp [S] + rw [h, show (2*m)%2 = 0 by omega] + ring + +private theorem sOdd : + (by + classical + exact + (DiamondParameter) → ( + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + ∀ (a : ℤ), ∀ (b : ℤ), ∀ (m : ℤ), a - b = (2 : ℤ) * m + (1 : ℤ) → S a b = (2 : ℤ) * a ^ (2 + : ℕ) - (2 : ℤ) * |a| - (4 : ℤ) * m ^ (2 : ℕ) - (4 : ℤ) * m) ) := by + classical + intro K S a b m h + dsimp [S] + rw [h, show (2*m+1)%2 = 1 by omega] + ring + +private theorem valR : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, k+1⟩ + (∀ (y : GaussianInt), y - rho ∈ FootprintVertices (DiamondTile K.1) → f y = + DiamondOdometer K (y - rho) + y.re + -k * y.im + B) → ( + let Q (a b : Int) : Int := + (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + ∀ (x : GaussianInt), x - rho ∈ FootprintVertices (DiamondTile K.1) → f x = Q (x - rho).re + (x - rho).im + x.re - k * x.im + B) ) := by + classical + intro K f B k rho hR Q x hx + rw [hR x hx, (P5352T2DomainRows K (x-rho)).2 hx] + dsimp [Q] + ring + +private theorem diffC : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let Q (a b : Int) : Int := + (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), 4*Q a b = S a b) → ((∀ (x : GaussianInt), (x ∈ + FootprintVertices (DiamondTile K.1)) → (f x = Q x.re x.im)) → (∀ (x : GaussianInt), ∀ + (y : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) → y ∈ FootprintVertices + (DiamondTile K.1) → (4 : ℤ) * (f y - f x) = S y.re y.im - S x.re x.im)) ) := by + classical + intro K f Q S scale valC x y hx hy + rw [valC x hx, valC y hy] + linear_combination scale y.re y.im - scale x.re x.im + +private theorem diffR : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, k+1⟩ + let Q (a b : Int) : Int := + (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), 4*Q a b = S a b) → ((∀ (x : GaussianInt), (x-rho ∈ + FootprintVertices (DiamondTile K.1)) → (f x = Q (x-rho).re (x-rho).im + + x.re-k*x.im+B)) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), x - rho ∈ + FootprintVertices (DiamondTile K.1) → y - rho ∈ FootprintVertices (DiamondTile K.1) → + (4 : ℤ) * (f y - f x) = S (y - rho).re (y - rho).im - S (x - rho).re (x - rho).im + + (4 : ℤ) * ((y - x).re - k * (y - x).im))) ) := by + classical + intro K f B k rho Q S scale valR x y hx hy + rw [valR x hx, valR y hy] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + linear_combination scale (y.re-rho.re) (y.im-rho.im) - + scale (x.re-rho.re) (x.im-rho.im) + +private theorem lap : + (by + classical + exact + ∀ (f : IntegerLatticeFunction), ∀ (x : GaussianInt), FourNeighborLaplacian f x = f (x + + (1 : GaussianInt)) - f x + (f (x - (1 : GaussianInt)) - f x) + (f (x + ⟨(0 : ℤ), (1 : + ℤ)⟩) - f x) + (f (x - ⟨(0 : ℤ), (1 : ℤ)⟩) - f x) ) := by + classical + intro f x + unfold FourNeighborLaplacian + ring + +private theorem cellsAt260 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, k+1⟩ + let covered (x : GaussianInt) : Prop := + ∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → + y ∈ DiamondCellDomain K.1 ∨ y-rho ∈ DiamondCellDomain K.1 + (∀ (x : GaussianInt), x ∈ DiamondCellDomain K.1 ↔ 0 ≤ x.im ∧ x.im < 2*k ∧ -(x.im+1) ≤ + x.re ∧ x.re < x.im+1 ∧ -(2*k-x.im) ≤ x.re ∧ x.re < 2*k-x.im) → ((∀ (x : GaussianInt), + covered x ↔ (x ∈ DiamondCellDomain K.1 ∨ x-rho ∈ DiamondCellDomain K.1) ∧ (x-1 ∈ + DiamondCellDomain K.1 ∨ x-1-rho ∈ DiamondCellDomain K.1) ∧ (x-⟨0,1⟩ ∈ + DiamondCellDomain K.1 ∨ x-⟨0,1⟩-rho ∈ DiamondCellDomain K.1) ∧ (x-1-⟨0,1⟩ ∈ + DiamondCellDomain K.1 ∨ x-1-⟨0,1⟩-rho ∈ DiamondCellDomain K.1)) → (∀ (t : ℤ), ((0 : + ℤ) ≤ t) → ((t < k) → (covered ⟨-k+t,k+t+1⟩ ↔ 0 < t))))) ) := by + classical + intro K hk k rho covered cell fourCells t ht0 htk + rw [fourCells] + simp only [cell, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + dsimp [rho] + omega + +private theorem heAt265 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((t < k) → ((⟨-k+t,k+t+1⟩ : GaussianInt)+1 + ∈ FootprintVertices (DiamondTile K.1))))) ) := by + classical + intro K hk k foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one] + omega + +private theorem hsAt270 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((t < k) → ((⟨-k+t,k+t+1⟩ : + GaussianInt)-⟨0,1⟩ ∈ FootprintVertices (DiamondTile K.1))))) ) := by + classical + intro K hk k foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + omega + +private theorem hwAt275 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, k+1⟩ + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((t < k) → ((⟨-k+t,k+t+1⟩ : + GaussianInt)-1-rho ∈ FootprintVertices (DiamondTile K.1))))) ) := by + classical + intro K hk k rho foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + dsimp [rho] + omega + +private theorem hnAt281 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, k+1⟩ + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((t < k) → ((⟨-k+t,k+t+1⟩ : + GaussianInt)+⟨0,1⟩-rho ∈ FootprintVertices (DiamondTile K.1))))) ) := by + classical + intro K hk k rho foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] + dsimp [rho] + omega + +private theorem eastAt287 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x ∈ FootprintVertices (DiamondTile + K.1)) → ((y ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S y.re y.im-S + x.re x.im))) → (∀ (t : ℤ), (t < k) → ((⟨-k + t, k + t + (1 : ℤ)⟩ ∈ FootprintVertices + (DiamondTile K.1)) → (((⟨-k+t,k+t+1⟩ : GaussianInt)+1 ∈ FootprintVertices + (DiamondTile K.1)) → (f ((⟨-k+t,k+t+1⟩ : GaussianInt)+1)-f ⟨-k+t,k+t+1⟩ = t+1)))))) ) + := by + classical + intro K f k S sEven sOdd diffC t htk hz he + have h := diffC _ _ hz he + rw [sEven _ _ (-k) (by dsimp; ring), sOdd _ _ (-k-1) (by dsimp; ring)] at h + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at h + simp (disch := omega) only [abs_of_nonpos] at h + nlinarith only [h] + +private theorem southAt293 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x ∈ FootprintVertices (DiamondTile + K.1)) → ((y ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S y.re y.im-S + x.re x.im))) → (∀ (t : ℤ), (t < k) → ((⟨-k + t, k + t + (1 : ℤ)⟩ ∈ FootprintVertices + (DiamondTile K.1)) → (((⟨-k+t,k+t+1⟩ : GaussianInt)-⟨0,1⟩ ∈ FootprintVertices + (DiamondTile K.1)) → ((f ((⟨-k+t,k+t+1⟩ : GaussianInt)+1)-f ⟨-k+t,k+t+1⟩ = t+1) → (f + ((⟨-k+t,k+t+1⟩ : GaussianInt)-⟨0,1⟩)-f ⟨-k+t,k+t+1⟩ = k))))))) ) := by + classical + intro K f k S sEven sOdd diffC t htk hz hs east + have h := diffC _ _ hz hs + rw [sEven _ _ (-k) (by dsimp; ring), sOdd _ _ (-k-1) (by dsimp; ring)] at h + simp only [Zsqrtd.re_sub] at h + simp (disch := omega) only [abs_of_nonpos] at h + nlinarith only [h] + +private theorem westAt299 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, k+1⟩ + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x-rho ∈ FootprintVertices (DiamondTile + K.1)) → ((y-rho ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S (y-rho).re + (y-rho).im-S (x-rho).re (x-rho).im + 4*((y-x).re-k*(y-x).im)))) → (∀ (t : ℤ), ((0 : + ℤ) ≤ t) → ((⟨-k + t, k + t + (1 : ℤ)⟩ - rho ∈ FootprintVertices (DiamondTile K.1)) → + (((⟨-k+t,k+t+1⟩ : GaussianInt)-1-rho ∈ FootprintVertices (DiamondTile K.1)) → ((f + ((⟨-k+t,k+t+1⟩ : GaussianInt)+1)-f ⟨-k+t,k+t+1⟩ = t+1) → (f ((⟨-k+t,k+t+1⟩ : + GaussianInt)-1)-f ⟨-k+t,k+t+1⟩ = if t=0 then -1 else -t))))))) ) := by + classical + intro K f k rho S sEven sOdd diffR t ht0 hzR hw east + have h := diffR _ _ hzR hw + rw [sOdd _ _ (-1) (by dsimp [rho]; ring), sEven _ _ 0 (by dsimp [rho]; ring)] at h + simp only [rho, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] at h + by_cases ht : t=0 + · rw [ite_eq_left ht] + simp (disch := omega) only [abs_of_nonpos] at h + nlinarith only [h, ht] + · rw [ite_eq_right ht] + simp (disch := omega) only [abs_of_nonneg] at h + nlinarith only [h] + +private theorem northAt311 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, k+1⟩ + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x-rho ∈ FootprintVertices (DiamondTile + K.1)) → ((y-rho ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S (y-rho).re + (y-rho).im-S (x-rho).re (x-rho).im + 4*((y-x).re-k*(y-x).im)))) → (∀ (t : ℤ), ((0 : + ℤ) ≤ t) → ((⟨-k + t, k + t + (1 : ℤ)⟩ - rho ∈ FootprintVertices (DiamondTile K.1)) → + (((⟨-k+t,k+t+1⟩ : GaussianInt)+⟨0,1⟩-rho ∈ FootprintVertices (DiamondTile K.1)) → ((f + ((⟨-k+t,k+t+1⟩ : GaussianInt)+1)-f ⟨-k+t,k+t+1⟩ = t+1) → ((f ((⟨-k+t,k+t+1⟩ : + GaussianInt)-1)-f ⟨-k+t,k+t+1⟩ = if t=0 then -1 else -t) → (f ((⟨-k+t,k+t+1⟩ : + GaussianInt)+⟨0,1⟩)-f ⟨-k+t,k+t+1⟩ = -k)))))))) ) := by + classical + intro K f k rho S sEven sOdd diffR t ht0 hzR hn east west + have h := diffR _ _ hzR hn + rw [sOdd _ _ (-1) (by dsimp [rho]; ring), sEven _ _ 0 (by dsimp [rho]; ring)] at h + simp only [rho, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] at h + simp (disch := omega) only [abs_of_nonneg] at h + nlinarith only [h] + +private theorem htAt324 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, k+1⟩ + let covered (x : GaussianInt) : Prop := + ∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → + y ∈ DiamondCellDomain K.1 ∨ y-rho ∈ DiamondCellDomain K.1 + ∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((covered ⟨-k+t,k+t+1⟩ ↔ 0 < t) → ((f ((⟨-k+t,k+t+1⟩ : + GaussianInt)+1)-f ⟨-k+t,k+t+1⟩ = t+1) → ((f ((⟨-k+t,k+t+1⟩ : GaussianInt)-1)-f + ⟨-k+t,k+t+1⟩ = if t=0 then -1 else -t) → ((¬covered ⟨-k + t, k + t + (1 : ℤ)⟩) → (t = + 0))))) ) := by + classical + intro K f k rho covered t ht0 cells east west hc + have : ¬ 0 < t := fun ht => hc (cells.mpr ht) + omega + +private theorem cellsAt329 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, k+1⟩ + let covered (x : GaussianInt) : Prop := + ∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → + y ∈ DiamondCellDomain K.1 ∨ y-rho ∈ DiamondCellDomain K.1 + (∀ (x : GaussianInt), x ∈ DiamondCellDomain K.1 ↔ 0 ≤ x.im ∧ x.im < 2*k ∧ -(x.im+1) ≤ + x.re ∧ x.re < x.im+1 ∧ -(2*k-x.im) ≤ x.re ∧ x.re < 2*k-x.im) → ((∀ (x : GaussianInt), + covered x ↔ (x ∈ DiamondCellDomain K.1 ∨ x-rho ∈ DiamondCellDomain K.1) ∧ (x-1 ∈ + DiamondCellDomain K.1 ∨ x-1-rho ∈ DiamondCellDomain K.1) ∧ (x-⟨0,1⟩ ∈ + DiamondCellDomain K.1 ∨ x-⟨0,1⟩-rho ∈ DiamondCellDomain K.1) ∧ (x-1-⟨0,1⟩ ∈ + DiamondCellDomain K.1 ∨ x-1-⟨0,1⟩-rho ∈ DiamondCellDomain K.1)) → (∀ (t : ℤ), ((0 : + ℤ) ≤ t) → ((t < k) → (covered ⟨-k+t+1,k+t+1⟩ ↔ t+1 < k))))) ) := by + classical + intro K hk k rho covered cell fourCells t ht0 htk + rw [fourCells] + simp only [cell, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + dsimp [rho] + omega + +private theorem heAt334 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((t < k) → ((⟨-k+t+1,k+t+1⟩ : + GaussianInt)+1 ∈ FootprintVertices (DiamondTile K.1))))) ) := by + classical + intro K hk k foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one] + omega + +private theorem hwAt339 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((t < k) → ((⟨-k+t+1,k+t+1⟩ : + GaussianInt)-1 ∈ FootprintVertices (DiamondTile K.1))))) ) := by + classical + intro K hk k foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + omega + +private theorem hsAt344 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((t < k) → ((⟨-k+t+1,k+t+1⟩ : + GaussianInt)-⟨0,1⟩ ∈ FootprintVertices (DiamondTile K.1))))) ) := by + classical + intro K hk k foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + omega + +private theorem hnAt349 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, k+1⟩ + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((t < k) → ((⟨-k+t+1,k+t+1⟩ : + GaussianInt)+⟨0,1⟩-rho ∈ FootprintVertices (DiamondTile K.1))))) ) := by + classical + intro K hk k rho foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] + dsimp [rho] + omega + +private theorem eastAt355 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x ∈ FootprintVertices (DiamondTile + K.1)) → ((y ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S y.re y.im-S + x.re x.im))) → (∀ (t : ℤ), (t < k) → ((⟨-k + t + (1 : ℤ), k + t + (1 : ℤ)⟩ ∈ + FootprintVertices (DiamondTile K.1)) → (((⟨-k+t+1,k+t+1⟩ : GaussianInt)+1 ∈ + FootprintVertices (DiamondTile K.1)) → (f ((⟨-k+t+1,k+t+1⟩ : GaussianInt)+1)-f + ⟨-k+t+1,k+t+1⟩ = if t+1=k then k else t+2)))))) ) := by + classical + intro K f k S sEven sOdd diffC t htk hz he + have h := diffC _ _ hz he + rw [sOdd _ _ (-k) (by dsimp; ring), sEven _ _ (-k) (by dsimp; ring)] at h + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at h + by_cases ht : t+1=k + · rw [ite_eq_left ht] + simp (disch := omega) only [abs_of_nonneg] at h + nlinarith only [h, ht] + · rw [ite_eq_right ht] + simp (disch := omega) only [abs_of_nonpos] at h + nlinarith only [h] + +private theorem westAt367 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x ∈ FootprintVertices (DiamondTile + K.1)) → ((y ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S y.re y.im-S + x.re x.im))) → (∀ (t : ℤ), (t < k) → ((⟨-k + t + (1 : ℤ), k + t + (1 : ℤ)⟩ ∈ + FootprintVertices (DiamondTile K.1)) → (((⟨-k+t+1,k+t+1⟩ : GaussianInt)-1 ∈ + FootprintVertices (DiamondTile K.1)) → (f ((⟨-k+t+1,k+t+1⟩ : GaussianInt)-1)-f + ⟨-k+t+1,k+t+1⟩ = -t-1)))))) ) := by + classical + intro K f k S sEven sOdd diffC t htk hz hw + have h := diffC _ _ hz hw + rw [sOdd _ _ (-k-1) (by dsimp; ring), sEven _ _ (-k) (by dsimp; ring)] at h + simp only [Zsqrtd.re_sub, Zsqrtd.re_one] at h + simp (disch := omega) only [abs_of_nonpos] at h + nlinarith only [h] + +private theorem southAt373 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x ∈ FootprintVertices (DiamondTile + K.1)) → ((y ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S y.re y.im-S + x.re x.im))) → (∀ (t : ℤ), (t < k) → ((⟨-k + t + (1 : ℤ), k + t + (1 : ℤ)⟩ ∈ + FootprintVertices (DiamondTile K.1)) → (((⟨-k+t+1,k+t+1⟩ : GaussianInt)-⟨0,1⟩ ∈ + FootprintVertices (DiamondTile K.1)) → ((f ((⟨-k+t+1,k+t+1⟩ : GaussianInt)-1)-f + ⟨-k+t+1,k+t+1⟩ = -t-1) → (f ((⟨-k+t+1,k+t+1⟩ : GaussianInt)-⟨0,1⟩)-f ⟨-k+t+1,k+t+1⟩ = + k))))))) ) := by + classical + intro K f k S sEven sOdd diffC t htk hz hs west + have h := diffC _ _ hz hs + rw [sOdd _ _ (-k) (by dsimp; ring), sEven _ _ (-k) (by dsimp; ring)] at h + simp only [Zsqrtd.re_sub] at h + simp (disch := omega) only [abs_of_nonpos] at h + nlinarith only [h] + +private theorem northAt379 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, k+1⟩ + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x-rho ∈ FootprintVertices (DiamondTile + K.1)) → ((y-rho ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S (y-rho).re + (y-rho).im-S (x-rho).re (x-rho).im + 4*((y-x).re-k*(y-x).im)))) → (∀ (t : ℤ), ((0 : + ℤ) ≤ t) → ((⟨-k + t + (1 : ℤ), k + t + (1 : ℤ)⟩ - rho ∈ FootprintVertices + (DiamondTile K.1)) → (((⟨-k+t+1,k+t+1⟩ : GaussianInt)+⟨0,1⟩-rho ∈ FootprintVertices + (DiamondTile K.1)) → ((f ((⟨-k+t+1,k+t+1⟩ : GaussianInt)-1)-f ⟨-k+t+1,k+t+1⟩ = -t-1) + → (f ((⟨-k+t+1,k+t+1⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-k+t+1,k+t+1⟩ = -k))))))) ) := by + classical + intro K f k rho S sEven sOdd diffR t ht0 hzR hn west + have h := diffR _ _ hzR hn + rw [sEven _ _ 0 (by dsimp [rho]; ring), sOdd _ _ 0 (by dsimp [rho]; ring)] at h + simp only [rho, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] at h + simp (disch := omega) only [abs_of_nonneg] at h + nlinarith only [h] + +private theorem htAt392 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, k+1⟩ + let covered (x : GaussianInt) : Prop := + ∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → + y ∈ DiamondCellDomain K.1 ∨ y-rho ∈ DiamondCellDomain K.1 + ∀ (t : ℤ), (t < k) → ((covered ⟨-k+t+1,k+t+1⟩ ↔ t+1 < k) → ((f ((⟨-k+t+1,k+t+1⟩ : + GaussianInt)-1)-f ⟨-k+t+1,k+t+1⟩ = -t-1) → ((f ((⟨-k+t+1,k+t+1⟩ : + GaussianInt)-⟨0,1⟩)-f ⟨-k+t+1,k+t+1⟩ = k) → ((f ((⟨-k+t+1,k+t+1⟩ : + GaussianInt)+⟨0,1⟩)-f ⟨-k+t+1,k+t+1⟩ = -k) → ((¬covered ⟨-k + t + (1 : ℤ), k + t + (1 + : ℤ)⟩) → (t+1 = k)))))) ) := by + classical + intro K f k rho covered t htk cells west south north hc + have : ¬ t+1 < k := fun ht => hc (cells.mpr ht) + omega + +end DiamondRightFirst + +theorem P5352T2RightFirst (K : DiamondParameter) (hk : 1 < K.1) + (f : IntegerLatticeFunction) (B : Int) (z : GaussianInt) : + let A := P5352T2Sources K hk 0 + let M := (P5352T2PlacementData K.1 0).1 + (∀ y, y ∈ FootprintVertices A.1 → f y = A.2.1 y) → + (∀ y, y - M.1 ∈ FootprintVertices A.1 → + f y = A.2.1 (y - M.1) + M.2.re*y.re + M.2.im*y.im + B) → + z ∈ FootprintVertices A.1 → z - M.1 ∈ FootprintVertices A.1 → + (∀ y, y = z ∨ y = z + 1 ∨ y = z - 1 ∨ + y = z + ⟨0, 1⟩ ∨ y = z - ⟨0, 1⟩ → + y ∈ FootprintVertices A.1 ∨ y - M.1 ∈ FootprintVertices A.1) → + ((∀ y, y = z ∨ y = z - 1 ∨ y = z - ⟨0, 1⟩ ∨ + y = z - 1 - ⟨0, 1⟩ → + y ∈ A.1.cells ∨ y - M.1 ∈ A.1.cells) → FourNeighborLaplacian f z = 1) ∧ + (¬ (∀ y, y = z ∨ y = z - 1 ∨ y = z - ⟨0, 1⟩ ∨ + y = z - 1 - ⟨0, 1⟩ → + y ∈ A.1.cells ∨ y - M.1 ∈ A.1.cells) → FourNeighborLaplacian f z = 0) := by +-- BODY + exact (by + classical + dsimp only + intro hC hR hz hzR hstar + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, k+1⟩ + have hkI : 2 ≤ k := by dsimp [k]; exact_mod_cast hk + change (∀ y, y ∈ FootprintVertices (DiamondTile K.1) → + f y = DiamondOdometer K y) at hC + change (∀ y, y-rho ∈ FootprintVertices (DiamondTile K.1) → + f y = DiamondOdometer K (y-rho) + 1*y.re + (-k)*y.im+B) at hR + simp only [one_mul] at hR + change z ∈ FootprintVertices (DiamondTile K.1) at hz + change z-rho ∈ FootprintVertices (DiamondTile K.1) at hzR + let covered (x : GaussianInt) : Prop := + ∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → + y ∈ DiamondCellDomain K.1 ∨ y-rho ∈ DiamondCellDomain K.1 + change (covered z → FourNeighborLaplacian f z = 1) ∧ + (¬ covered z → FourNeighborLaplacian f z = 0) + have foot (x : GaussianInt) : + x ∈ FootprintVertices (DiamondTile K.1) ↔ + 0 ≤ x.im ∧ x.im ≤ 2*k ∧ -k ≤ x.re ∧ x.re ≤ k ∧ + -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ + -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ 2*k-x.im+1 := + (P5352T2DomainRows K x).1 + have cell (x : GaussianInt) : + x ∈ DiamondCellDomain K.1 ↔ + 0 ≤ x.im ∧ x.im < 2*k ∧ -(x.im+1) ≤ x.re ∧ x.re < x.im+1 ∧ + -(2*k-x.im) ≤ x.re ∧ x.re < 2*k-x.im := + (P4194T1DiamondCellRows K.1 x).1 + have fourCells (x : GaussianInt) := DiamondRightFirst.fourCells K x + -- The common footprint consists of the two staircase rows. + have contact := DiamondRightFirst.contact K z hz hzR foot + let Q (a b : Int) : Int := + (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + have tri (a : Int) := DiamondRightFirst.tri K a + have square (a : Int) := DiamondRightFirst.square K a + -- Scaling removes both divisions, including for negative odd arguments. + have scale (a b : Int) := DiamondRightFirst.scale tri square a b + have sEven (a b m : Int) (h : a-b = 2*m) := DiamondRightFirst.sEven K a b m h + have sOdd (a b m : Int) (h : a-b = 2*m+1) := DiamondRightFirst.sOdd K a b m h + have valC (x : GaussianInt) (hx : x ∈ FootprintVertices (DiamondTile K.1)) : + f x = Q x.re x.im := (hC x hx).trans ((P5352T2DomainRows K x).2 hx) + have valR (x : GaussianInt) (hx : x-rho ∈ FootprintVertices (DiamondTile K.1)) := + DiamondRightFirst.valR K f B hR x hx + have diffC (x y : GaussianInt) + (hx : x ∈ FootprintVertices (DiamondTile K.1)) + (hy : y ∈ FootprintVertices (DiamondTile K.1)) := DiamondRightFirst.diffC K f scale valC + x y hx hy + -- Subtract in the same translated source so B cancels. + have diffR (x y : GaussianInt) + (hx : x-rho ∈ FootprintVertices (DiamondTile K.1)) + (hy : y-rho ∈ FootprintVertices (DiamondTile K.1)) := DiamondRightFirst.diffR K f B scale + valR x y hx hy + have lap (x : GaussianInt) : FourNeighborLaplacian f x = + (f (x+1)-f x)+(f (x-1)-f x)+ + (f (x+⟨0,1⟩)-f x)+(f (x-⟨0,1⟩)-f x) := DiamondRightFirst.lap f x + rcases contact with ⟨t,ht0,htk,rfl⟩ | ⟨t,ht0,htk,rfl⟩ + · have cells : covered ⟨-k+t,k+t+1⟩ ↔ 0 < t := DiamondRightFirst.cellsAt260 K hk cell + fourCells t ht0 htk + have he := DiamondRightFirst.heAt265 K hk foot t ht0 htk + have hs := DiamondRightFirst.hsAt270 K hk foot t ht0 htk + have hw := DiamondRightFirst.hwAt275 K hk foot t ht0 htk + have hn := DiamondRightFirst.hnAt281 K hk foot t ht0 htk + have east : f ((⟨-k+t,k+t+1⟩ : GaussianInt)+1)-f ⟨-k+t,k+t+1⟩ = t+1 := + DiamondRightFirst.eastAt287 K f sEven sOdd diffC t htk hz he + have south : f ((⟨-k+t,k+t+1⟩ : GaussianInt)-⟨0,1⟩)-f ⟨-k+t,k+t+1⟩ = k := + DiamondRightFirst.southAt293 K f sEven sOdd diffC t htk hz hs east + have west : f ((⟨-k+t,k+t+1⟩ : GaussianInt)-1)-f ⟨-k+t,k+t+1⟩ = + if t=0 then -1 else -t := DiamondRightFirst.westAt299 K f sEven sOdd diffR t ht0 hzR hw + east + have north : f ((⟨-k+t,k+t+1⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-k+t,k+t+1⟩ = -k := + DiamondRightFirst.northAt311 K f sEven sOdd diffR t ht0 hzR hn east west + rw [lap, east, west, north, south] + constructor + · intro hc + have ht : t ≠ 0 := by have := cells.mp hc; omega + rw [ite_eq_right ht] + ring + · intro hc + have ht : t = 0 := DiamondRightFirst.htAt324 K f t ht0 cells east west hc + rw [ite_eq_left ht, ht] + ring + · have cells : covered ⟨-k+t+1,k+t+1⟩ ↔ t+1 < k := DiamondRightFirst.cellsAt329 K hk cell + fourCells t ht0 htk + have he := DiamondRightFirst.heAt334 K hk foot t ht0 htk + have hw := DiamondRightFirst.hwAt339 K hk foot t ht0 htk + have hs := DiamondRightFirst.hsAt344 K hk foot t ht0 htk + have hn := DiamondRightFirst.hnAt349 K hk foot t ht0 htk + have east : f ((⟨-k+t+1,k+t+1⟩ : GaussianInt)+1)-f ⟨-k+t+1,k+t+1⟩ = + if t+1=k then k else t+2 := DiamondRightFirst.eastAt355 K f sEven sOdd diffC t htk hz he + have west : f ((⟨-k+t+1,k+t+1⟩ : GaussianInt)-1)-f ⟨-k+t+1,k+t+1⟩ = -t-1 := + DiamondRightFirst.westAt367 K f sEven sOdd diffC t htk hz hw + have south : f ((⟨-k+t+1,k+t+1⟩ : GaussianInt)-⟨0,1⟩)-f ⟨-k+t+1,k+t+1⟩ = k := + DiamondRightFirst.southAt373 K f sEven sOdd diffC t htk hz hs west + have north : f ((⟨-k+t+1,k+t+1⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-k+t+1,k+t+1⟩ = -k := + DiamondRightFirst.northAt379 K f sEven sOdd diffR t ht0 hzR hn west + rw [lap, east, west, north, south] + constructor + · intro hc + have ht : t+1 ≠ k := by have := cells.mp hc; omega + rw [ite_eq_right ht] + ring + · intro hc + have ht : t+1 = k := DiamondRightFirst.htAt392 K f t htk cells west south north hc + rw [ite_eq_left ht] + omega + ) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean b/LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean new file mode 100644 index 0000000000..b7b22d096c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean @@ -0,0 +1,550 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData +public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic +public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable + +-- [TABLET NODE: P5352T2RightHorizontal] + +/-! +# P5352T2RightHorizontal + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiamondRightHorizontal + +private theorem hcoords : + (by + classical + exact + ∀ (K : DiamondParameter), + let n : Int := K.1 + ∀ w ∈ FootprintVertices (DiamondTile K.1), (0 : ℤ) ≤ w.im ∧ w.im ≤ (2 : ℤ) * n ∧ -n ≤ + w.re ∧ w.re ≤ n ∧ -w.im - (1 : ℤ) ≤ w.re ∧ w.re ≤ w.im + (1 : ℤ) ∧ -((2 : ℤ) * n - + w.im + (1 : ℤ)) ≤ w.re ∧ w.re ≤ (2 : ℤ) * n - w.im + (1 : ℤ) ) := by + classical + intro K n w hw + simpa [n] using (P5352T2DomainRows K w).1.mp hw + +private theorem hz' : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (z : GaussianInt), (z - + (P5352T2PlacementData K.1 (2 : Fin (3 : ℕ))).1.1 ∈ FootprintVertices + (P5352T2Sources K hk (0 : Fin (4 : ℕ))).1) → ( + let n : Int := K.1 + let M : GaussianInt := ⟨2*n, 0⟩ + ((P5352T2PlacementData K.1 2).1.1 = M) → (((P5352T2Sources K hk 0).1 = DiamondTile + K.1) → (z - M ∈ FootprintVertices (DiamondTile K.1)))) ) := by + classical + intro K hk z hzM n M hM hA + simpa [hM] using (show z - (P5352T2PlacementData K.1 2).1.1 ∈ + FootprintVertices (DiamondTile K.1) by simpa [hA] using hzM) + +private theorem hzr : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (z : GaussianInt), + let n : Int := K.1 + let M : GaussianInt := ⟨2*n, 0⟩ + ((0 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * n ∧ -n ≤ z.re ∧ z.re ≤ n ∧ -z.im - (1 : ℤ) ≤ z.re ∧ + z.re ≤ z.im + (1 : ℤ) ∧ -((2 : ℤ) * n - z.im + (1 : ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * n - + z.im + (1 : ℤ)) → (((0 : ℤ) ≤ (z - M).im ∧ (z - M).im ≤ (2 : ℤ) * n ∧ -n ≤ (z - M).re + ∧ (z - M).re ≤ n ∧ -(z - M).im - (1 : ℤ) ≤ (z - M).re ∧ (z - M).re ≤ (z - M).im + (1 + : ℤ) ∧ -((2 : ℤ) * n - (z - M).im + (1 : ℤ)) ≤ (z - M).re ∧ (z - M).re ≤ (2 : ℤ) * n + - (z - M).im + (1 : ℤ)) → (z.re = n)) ) := by + classical + intro K z n M hzB hzMB + have hlow := hzMB.2.2.1 + have hhigh := hzB.2.2.2.1 + dsimp [M] at hlow + omega + +private theorem hzi : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (z : GaussianInt), (∀ (y : + GaussianInt), y = z ∨ y = z + (1 : GaussianInt) ∨ y = z - (1 : GaussianInt) ∨ y = z + + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = z - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ FootprintVertices + (P5352T2Sources K hk (0 : Fin (4 : ℕ))).1 ∨ y - (P5352T2PlacementData K.1 (2 : + Fin (3 : ℕ))).1.1 ∈ FootprintVertices (P5352T2Sources K hk (0 : Fin (4 : ℕ))).1) → ( + let n : Int := K.1 + let M : GaussianInt := ⟨2*n, 0⟩ + ((P5352T2PlacementData K.1 2).1.1 = M) → (((P5352T2Sources K hk 0).1 = DiamondTile + K.1) → ((∀ (w : GaussianInt), (w ∈ FootprintVertices (DiamondTile K.1)) → (0 ≤ w.im ∧ + w.im ≤ 2*n ∧ -n ≤ w.re ∧ w.re ≤ n ∧ -w.im-1 ≤ w.re ∧ w.re ≤ w.im+1 ∧ -(2*n-w.im+1) ≤ + w.re ∧ w.re ≤ 2*n-w.im+1)) → (((0 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * n ∧ -n ≤ z.re ∧ z.re + ≤ n ∧ -z.im - (1 : ℤ) ≤ z.re ∧ z.re ≤ z.im + (1 : ℤ) ∧ -((2 : ℤ) * n - z.im + (1 : + ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * n - z.im + (1 : ℤ)) → (((0 : ℤ) ≤ (z - M).im ∧ (z - + M).im ≤ (2 : ℤ) * n ∧ -n ≤ (z - M).re ∧ (z - M).re ≤ n ∧ -(z - M).im - (1 : ℤ) ≤ (z - + M).re ∧ (z - M).re ≤ (z - M).im + (1 : ℤ) ∧ -((2 : ℤ) * n - (z - M).im + (1 : ℤ)) ≤ + (z - M).re ∧ (z - M).re ≤ (2 : ℤ) * n - (z - M).im + (1 : ℤ)) → ((z.re = n) → (z.im = + n))))))) ) := by + classical + intro K hk z hstar n M hM hA hcoords hzB hzMB hzr + rcases hzB with ⟨_, _, _, _, _, hzlo, _, _⟩ + rcases hzMB with ⟨_, _, _, _, _, _, hbound, _⟩ + have him : (z-M).im = z.im := by simp [M] + have hre : (z-M).re = z.re-2*n := by simp [M] + have hreM : (z-M).re = -n := by rw [hre, hzr]; omega + have hlower : n-1 ≤ z.im := by rw [← hzr]; omega + have hupper : z.im ≤ n+1 := by + rw [him, hreM] at hbound + omega + have hnotlow : z.im ≠ n-1 := by + intro heq + have hsouth := hstar (z-⟨0,1⟩) (Or.inr (Or.inr (Or.inr (Or.inr rfl))) : + z-⟨0,1⟩ = z ∨ z-⟨0,1⟩ = z+1 ∨ z-⟨0,1⟩ = z-1 ∨ + z-⟨0,1⟩ = z+⟨0,1⟩ ∨ z-⟨0,1⟩ = z-⟨0,1⟩) + rcases hsouth with hp | hc + · have hr := hcoords (z-⟨0,1⟩) (by simpa [hA] using hp) + have hh := hr.2.2.2.2.2.1 + have hsr : (z-⟨0,1⟩).re = n := by simp [Zsqrtd.re_sub, hzr] + have hsi : (z-⟨0,1⟩).im = n-2 := by simp [Zsqrtd.im_sub, heq]; ring + rw [hsr,hsi] at hh + omega + · have hr := hcoords ((z-⟨0,1⟩)-M) (by + simpa [hA, hM] using hc) + have hh := hr.2.2.2.2.1 + have hcr : ((z-⟨0,1⟩)-M).re = -n := by simp [Zsqrtd.re_sub, M, hzr]; ring + have hci : ((z-⟨0,1⟩)-M).im = n-2 := by simp [Zsqrtd.im_sub, M, heq]; ring + rw [hcr,hci] at hh + omega + have hnotup : z.im ≠ n+1 := by + intro heq + have hnorth := hstar (z+⟨0,1⟩) (Or.inr (Or.inr (Or.inr (Or.inl rfl))) : + z+⟨0,1⟩ = z ∨ z+⟨0,1⟩ = z+1 ∨ z+⟨0,1⟩ = z-1 ∨ + z+⟨0,1⟩ = z+⟨0,1⟩ ∨ z+⟨0,1⟩ = z-⟨0,1⟩) + rcases hnorth with hp | hc + · have hr := hcoords (z+⟨0,1⟩) (by simpa [hA] using hp) + rcases hr with ⟨_,_,_,_,_,_,_,hh⟩ + have hnr : (z+⟨0,1⟩).re = n := by simp [Zsqrtd.re_add, hzr] + have hni : (z+⟨0,1⟩).im = n+2 := by simp [Zsqrtd.im_add, heq]; ring + rw [hnr,hni] at hh + omega + · have hr := hcoords ((z+⟨0,1⟩)-M) (by + simpa [hA, hM] using hc) + rcases hr with ⟨_,_,_,_,_,_,hh,_⟩ + have hnr : ((z+⟨0,1⟩)-M).re = -n := by simp [Zsqrtd.re_sub, Zsqrtd.re_add, M, hzr]; ring + have hni : ((z+⟨0,1⟩)-M).im = n+2 := by simp [Zsqrtd.im_sub, Zsqrtd.im_add, M, heq]; ring + rw [hnr,hni] at hh + omega + omega + +private theorem foot : + (by + classical + exact + ∀ (K : DiamondParameter), + let n : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℤ) ≤ b ∧ b ≤ (2 : ℤ) * n ∧ -n ≤ a ∧ a ≤ n ∧ -b - (1 : ℤ) ≤ a ∧ + a ≤ b + (1 : ℤ) ∧ -((2 : ℤ) * n - b + (1 : ℤ)) ≤ a ∧ a ≤ (2 : ℤ) * n - b + (1 : ℤ) → + ⟨a, b⟩ ∈ FootprintVertices (DiamondTile K.1) ) := by + classical + intro K n a b hb + apply (P5352T2DomainRows K ⟨a,b⟩).1.mpr + simpa using hb + +private theorem cellD : + (by + classical + exact + ∀ (K : DiamondParameter), + let n : Int := K.1 + ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℤ) ≤ b ∧ b < (2 : ℤ) * n ∧ -(b + (1 : ℤ)) ≤ a ∧ a < b + (1 : + ℤ) ∧ -((2 : ℤ) * n - b) ≤ a ∧ a < (2 : ℤ) * n - b → ⟨a, b⟩ ∈ DiamondCellDomain K.1 ) + := by + classical + intro K n a b hb + apply (P4194T1DiamondCellRows K.1 ⟨a,b⟩).1.mpr + simpa using hb + +private theorem coverCells : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (z : GaussianInt), + let n : Int := K.1 + let M : GaussianInt := ⟨2*n, 0⟩ + ((P5352T2PlacementData K.1 2).1.1 = M) → (((P5352T2Sources K hk 0).1 = DiamondTile + K.1) → ((z.re = n) → ((z = ⟨n,n⟩) → ((∀ (a : Int), ∀ (b : Int), (0 ≤ b ∧ b < 2*n ∧ + -(b+1) ≤ a ∧ a < b+1 ∧ -(2*n-b) ≤ a ∧ a < 2*n-b) → ((⟨a,b⟩ : GaussianInt) ∈ + DiamondCellDomain K.1)) → (∀ y : GaussianInt, y = z ∨ y = z-1 ∨ y = z-⟨0,1⟩ ∨ y = + z-1-⟨0,1⟩ → y ∈ (P5352T2Sources K hk 0).1.cells ∨ y-(P5352T2PlacementData K.1 + 2).1.1 ∈ (P5352T2Sources K hk 0).1.cells))))) ) := by + classical + intro K hk z n M hM hA hzr hzc cellD y hy + rcases hy with h | h | h | h <;> subst y + · right + have hc := cellD (-n) n (by constructor <;> omega) + rw [hzc, hM, hA, DiamondTile] + change (⟨n,n⟩ : GaussianInt)-M ∈ DiamondCellDomain K.1 + rw [show (⟨n,n⟩ : GaussianInt)-M = ⟨-n,n⟩ by ext <;> simp [M]; ring] + exact hc + · left + have hc := cellD (n-1) n (by constructor <;> omega) + rw [hzc, hA, DiamondTile] + change (⟨n,n⟩ : GaussianInt)-1 ∈ DiamondCellDomain K.1 + rw [show (⟨n,n⟩ : GaussianInt)-1 = ⟨n-1,n⟩ by ext <;> simp ] + exact hc + · right + have hc := cellD (-n) (n-1) (by constructor <;> omega) + rw [hzc, hM, hA, DiamondTile] + change (⟨n,n⟩ : GaussianInt)-⟨0,1⟩-M ∈ DiamondCellDomain K.1 + rw [show (⟨n,n⟩ : GaussianInt)-⟨0,1⟩-M = ⟨-n,n-1⟩ by ext <;> simp [M]; ring] + exact hc + · left + have hc := cellD (n-1) (n-1) (by constructor <;> omega) + rw [hzc, hA, DiamondTile] + change (⟨n,n⟩ : GaussianInt)-1-⟨0,1⟩ ∈ DiamondCellDomain K.1 + rw [show (⟨n,n⟩ : GaussianInt)-1-⟨0,1⟩ = ⟨n-1,n-1⟩ by ext <;> simp ] + exact hc + +private theorem hchildEast : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → (∀ (z : GaussianInt), + let n : Int := K.1 + let M : GaussianInt := ⟨2*n, 0⟩ + (z.re = n) → ((∀ (a : Int), ∀ (b : Int), (0 ≤ b ∧ b ≤ 2*n ∧ -n ≤ a ∧ a ≤ n ∧ -b-1 ≤ a ∧ a + ≤ b+1 ∧ -(2*n-b+1) ≤ a ∧ a ≤ 2*n-b+1) → ((⟨a,b⟩ : GaussianInt) ∈ FootprintVertices + (DiamondTile K.1))) → ((z+1 = ⟨n+1,n⟩) → ((z+1)-M ∈ FootprintVertices (DiamondTile + K.1))))) ) := by + classical + intro K hk z n M hzr foot hEc + rw [hEc] + have hpt : (⟨n+1,n⟩ : GaussianInt)-M = ⟨1-n,n⟩ := by ext <;> simp [M]; ring + rw [hpt] + exact foot (1-n) n (by constructor <;> omega) + +private theorem hparent : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), (∀ y ∈ + FootprintVertices (P5352T2Sources K hk (0 : Fin (4 : ℕ))).1, f y = + (P5352T2Sources K hk (0 : Fin (4 : ℕ))).2.1 y) → ( + let Q (x : GaussianInt) : Int := + (Int.natAbs x.re : Int) * ((Int.natAbs x.re : Int)-1)/2 - + (x.re-x.im)^2/4 + ((P5352T2Sources K hk 0).1 = DiamondTile K.1) → (∀ w ∈ FootprintVertices (DiamondTile + K.1), f w = Q w)) ) := by + classical + intro K hk f hC Q hA w hw + have hv := hC w hw + have hval := (P5352T2DomainRows K w).2 hw + simpa [P5352T2Sources, Q] using hv.trans hval + +private theorem hfChildCenter : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), ∀ (z : GaussianInt), (∀ (y : GaussianInt), y - (P5352T2PlacementData K.1 (2 : + Fin (3 : ℕ))).1.1 ∈ FootprintVertices (P5352T2Sources K hk (0 : Fin (4 : ℕ))).1 → f + y = (P5352T2Sources K hk (0 : Fin (4 : ℕ))).2.1 (y - (P5352T2PlacementData K.1 (2 + : Fin (3 : ℕ))).1.1) + (P5352T2PlacementData K.1 (2 : Fin (3 : ℕ))).1.2.re * y.re + + (P5352T2PlacementData K.1 (2 : Fin (3 : ℕ))).1.2.im * y.im + B) → ((z - + (P5352T2PlacementData K.1 (2 : Fin (3 : ℕ))).1.1 ∈ FootprintVertices + (P5352T2Sources K hk (0 : Fin (4 : ℕ))).1) → ( + let n : Int := K.1 + let M : GaussianInt := ⟨2*n, 0⟩ + let Q (x : GaussianInt) : Int := + (Int.natAbs x.re : Int) * ((Int.natAbs x.re : Int)-1)/2 - + (x.re-x.im)^2/4 + ((P5352T2PlacementData K.1 2).1.1 = M) → (((P5352T2PlacementData K.1 2).1.2 = + ⟨n-1,n⟩) → (((P5352T2Sources K hk 0).1 = DiamondTile K.1) → (f z = Q (z-M) + + (n-1)*z.re + n*z.im + B))))) ) := by + classical + intro K hk f B z hR hzM n M Q hM hbeta hA + have hv := hR z (by simpa [hA, hM] using hzM) + have hval := (P5352T2DomainRows K (z-M)).2 (by simpa [hA, hM] using hzM) + simpa [P5352T2Sources, hM, hbeta, Q] using hv.trans (congrArg (fun v => v + + (P5352T2PlacementData K.1 2).1.2.re*z.re + + (P5352T2PlacementData K.1 2).1.2.im*z.im+B) hval) + +private theorem hfEast : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : + Int), ∀ (z : GaussianInt), (∀ (y : GaussianInt), y - (P5352T2PlacementData K.1 (2 : + Fin (3 : ℕ))).1.1 ∈ FootprintVertices (P5352T2Sources K hk (0 : Fin (4 : ℕ))).1 → f + y = (P5352T2Sources K hk (0 : Fin (4 : ℕ))).2.1 (y - (P5352T2PlacementData K.1 (2 + : Fin (3 : ℕ))).1.1) + (P5352T2PlacementData K.1 (2 : Fin (3 : ℕ))).1.2.re * y.re + + (P5352T2PlacementData K.1 (2 : Fin (3 : ℕ))).1.2.im * y.im + B) → ( + let n : Int := K.1 + let M : GaussianInt := ⟨2*n, 0⟩ + let Q (x : GaussianInt) : Int := + (Int.natAbs x.re : Int) * ((Int.natAbs x.re : Int)-1)/2 - + (x.re-x.im)^2/4 + ((P5352T2PlacementData K.1 2).1.1 = M) → (((P5352T2PlacementData K.1 2).1.2 = + ⟨n-1,n⟩) → (((P5352T2Sources K hk 0).1 = DiamondTile K.1) → (((z+1)-M ∈ + FootprintVertices (DiamondTile K.1)) → (f (z+1) = Q ((z+1)-M) + (n-1)*(z+1).re + + n*(z+1).im + B))))) ) := by + classical + intro K hk f B z hR n M Q hM hbeta hA hchildEast + have he := hR (z+1) (by simpa [hM, hA] using hchildEast) + have hval := (P5352T2DomainRows K ((z+1)-M)).2 (by simpa [hM, hA] using hchildEast) + simpa [P5352T2Sources, hM, hbeta, Q] using he.trans (congrArg (fun v => v + + (P5352T2PlacementData K.1 2).1.2.re*(z+1).re + + (P5352T2PlacementData K.1 2).1.2.im*(z+1).im+B) hval) + +private theorem hsq1 : + (by + classical + exact + ∀ (K : DiamondParameter), (IntegerLatticeFunction) → ((Int) → (∀ (z : GaussianInt), + let n : Int := K.1 + (z.re = n) → ((1-2*n)^2/4 = n^2-n))) ) := by + classical + intro K f B z n hzr + have h := P4207T1FloorArithmetic.1 1 (-n) + norm_num at h ⊢ + rw [show 1 + -(2*n) = 1-2*n by ring] at h + omega + +private theorem hsq0' : + (by + classical + exact + ∀ (K : DiamondParameter), + let n : Int := K.1 + ((-2*n)^2/4 = n^2) → ((-n-n)^2/4 = n^2) ) := by + classical + intro K n hsq0 + rw [show -n-n = -2*n by ring] + exact hsq0 + +private theorem hsq1' : + (by + classical + exact + ∀ (K : DiamondParameter), + let n : Int := K.1 + ((1-2*n)^2/4 = n^2-n) → ((1-n-n)^2/4 = n^2-n) ) := by + classical + intro K n hsq1 + rw [show 1-n-n = 1-2*n by ring] + exact hsq1 + +private theorem qChildCenter : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ((IntegerLatticeFunction) → ((Int) → (∀ (z : + GaussianInt), + let n : Int := K.1 + let Q (x : GaussianInt) : Int := + (Int.natAbs x.re : Int) * ((Int.natAbs x.re : Int)-1)/2 - + (x.re-x.im)^2/4 + (z.re = n) → (((1-2*n)^2/4 = n^2-n) → (((-n-n)^2/4 = n^2) → (((1-n-n)^2/4 = n^2-n) → (Q + ⟨-n,n⟩ = n*(n-1)/2-n^2))))))) ) := by + classical + intro K hk f B z n Q hzr hsq1 hsq0' hsq1' + change (Int.natAbs (-n) : Int) * ((Int.natAbs (-n) : Int)-1)/2 - + (-n-n)^2/4 = n*(n-1)/2-n^2 + simp only [Int.natCast_natAbs, abs_of_nonpos (show -n ≤ 0 by omega)] + rw [hsq0'] + ring + +private theorem qChildEast : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ((IntegerLatticeFunction) → ((Int) → (∀ (z : + GaussianInt), + let n : Int := K.1 + let Q (x : GaussianInt) : Int := + (Int.natAbs x.re : Int) * ((Int.natAbs x.re : Int)-1)/2 - + (x.re-x.im)^2/4 + (z.re = n) → (((1-2*n)^2/4 = n^2-n) → (((-n-n)^2/4 = n^2) → (((1-n-n)^2/4 = n^2-n) → (Q + ⟨1-n,n⟩ = (n-1)*(n-2)/2-(n^2-n)))))))) ) := by + classical + intro K hk f B z n Q hzr hsq1 hsq0' hsq1' + change (Int.natAbs (1-n) : Int) * ((Int.natAbs (1-n) : Int)-1)/2 - + ((1-n)-n)^2/4 = (n-1)*(n-2)/2-(n^2-n) + simp only [Int.natCast_natAbs, abs_of_nonpos (show 1-n ≤ 0 by omega)] + rw [hsq1'] + ring + +private theorem hLap : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), ∀ (z : GaussianInt), + let n : Int := K.1 + let M : GaussianInt := ⟨2*n, 0⟩ + let Q (x : GaussianInt) : Int := + (Int.natAbs x.re : Int) * ((Int.natAbs x.re : Int)-1)/2 - + (x.re-x.im)^2/4 + (z.re = n) → ((z = ⟨n,n⟩) → ((z-1 = ⟨n-1,n⟩) → ((z+⟨0,1⟩ = ⟨n,n+1⟩) → ((z-⟨0,1⟩ = + ⟨n,n-1⟩) → ((z+1 = ⟨n+1,n⟩) → ((f z = Q z) → ((f (z-1) = Q (z-1)) → ((f (z+⟨0,1⟩) = Q + (z+⟨0,1⟩)) → ((f (z-⟨0,1⟩) = Q (z-⟨0,1⟩)) → ((f z = Q (z-M) + (n-1)*z.re + n*z.im + + B) → ((f (z+1) = Q ((z+1)-M) + (n-1)*(z+1).re + n*(z+1).im + B) → ((Q ⟨n,n⟩ = + n*(n-1)/2) → ((Q ⟨n-1,n⟩ = (n-1)*(n-2)/2) → ((Q ⟨n,n+1⟩ = n*(n-1)/2) → ((Q ⟨n,n-1⟩ = + n*(n-1)/2) → (((1-2*n)^2/4 = n^2-n) → (((-n-n)^2/4 = n^2) → (((1-n-n)^2/4 = n^2-n) → + ((Q ⟨-n,n⟩ = n*(n-1)/2-n^2) → ((Q ⟨1-n,n⟩ = (n-1)*(n-2)/2-(n^2-n)) → ((z-M = ⟨-n,n⟩) + → (((z+1)-M = ⟨1-n,n⟩) → (FourNeighborLaplacian f z = 1))))))))))))))))))))))) ) := by + classical + intro K f B z n M Q hzr hzc hWc hNc hSc hEc hfCenter hfWest hfNorth hfSouth hfChildCenter + hfEast qCenter qWest qNorth qSouth hsq1 hsq0' hsq1' qChildCenter qChildEast hChildCenter + hChildEast + have hB : B = n-n^2 := by + rw [hfCenter] at hfChildCenter + rw [hChildCenter, qChildCenter] at hfChildCenter + rw [hzc, qCenter] at hfChildCenter + change n*(n-1)/2 = n*(n-1)/2 - n^2 + (n-1)*n+n*n+B at hfChildCenter + ring_nf at hfChildCenter ⊢ + omega + have hv0 : f z = n*(n-1)/2 := by rw [hfCenter, hzc, qCenter] + have hvW : f (z-1) = (n-1)*(n-2)/2 := by rw [hfWest, hWc, qWest] + have hvN : f (z+⟨0,1⟩) = n*(n-1)/2 := by rw [hfNorth, hNc, qNorth] + have hvS : f (z-⟨0,1⟩) = n*(n-1)/2 := by rw [hfSouth, hSc, qSouth] + have hvE : f (z+1) = (n-1)*(n-2)/2 + 2*n-1 := by + rw [hfEast, hChildEast, qChildEast, hEc, hB] + simp + ring + have tri (a : Int) : 2 * (a * (a-1) / 2) = a * (a-1) := by + rcases Int.emod_two_eq_zero_or_one a with h | h + · have ha : a = 2 * (a / 2) := by omega + rw [ha] + have he : 2 * (a / 2) * (2 * (a / 2) - 1) = + 2 * ((a / 2) * (2 * (a / 2) - 1)) := by ring + rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (2 : Int) ≠ 0)] + · have ha : a = 2 * (a / 2) + 1 := by omega + rw [ha] + have he : (2 * (a / 2) + 1) * (2 * (a / 2) + 1 - 1) = + 2 * ((2 * (a / 2) + 1) * (a / 2)) := by ring + rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (2 : Int) ≠ 0)] + have htri : (n-1)*(n-2)/2 - n*(n-1)/2 = 1-n := by + have h1 := tri (n-1) + have h2 := tri n + have h1' : 2*((n-1)*(n-2)/2) = (n-1)*(n-2) := by + convert h1 using 1 <;> congr 1 <;> ring + have hd : 2*((n-1)*(n-2)/2 - n*(n-1)/2) = 2*(1-n) := by + rw [mul_sub, h1', h2] + ring + omega + rw [FourNeighborLaplacian, hvE, hvW, hvN, hvS, hv0] + linear_combination 2 * htri + +end DiamondRightHorizontal + +theorem P5352T2RightHorizontal (K : DiamondParameter) (hk : 1 < K.1) + (f : IntegerLatticeFunction) (B : Int) (z : GaussianInt) : + let A := P5352T2Sources K hk 0 + let M := (P5352T2PlacementData K.1 2).1 + (∀ y, y ∈ FootprintVertices A.1 → f y = A.2.1 y) → + (∀ y, y - M.1 ∈ FootprintVertices A.1 → + f y = A.2.1 (y - M.1) + M.2.re*y.re + M.2.im*y.im + B) → + z ∈ FootprintVertices A.1 → z - M.1 ∈ FootprintVertices A.1 → + (∀ y, y = z ∨ y = z + 1 ∨ y = z - 1 ∨ + y = z + ⟨0, 1⟩ ∨ y = z - ⟨0, 1⟩ → + y ∈ FootprintVertices A.1 ∨ y - M.1 ∈ FootprintVertices A.1) → + ((∀ y, y = z ∨ y = z - 1 ∨ y = z - ⟨0, 1⟩ ∨ + y = z - 1 - ⟨0, 1⟩ → + y ∈ A.1.cells ∨ y - M.1 ∈ A.1.cells) → FourNeighborLaplacian f z = 1) ∧ + (¬ (∀ y, y = z ∨ y = z - 1 ∨ y = z - ⟨0, 1⟩ ∨ + y = z - 1 - ⟨0, 1⟩ → + y ∈ A.1.cells ∨ y - M.1 ∈ A.1.cells) → FourNeighborLaplacian f z = 0) := by +-- BODY + dsimp only + intro hC hR hz hzM hstar + let n : Int := K.1 + have hn : 2 ≤ n := by dsimp [n]; exact_mod_cast hk + let M : GaussianInt := ⟨2*n, 0⟩ + let Q (x : GaussianInt) : Int := + (Int.natAbs x.re : Int) * ((Int.natAbs x.re : Int)-1)/2 - + (x.re-x.im)^2/4 + have hM : (P5352T2PlacementData K.1 2).1.1 = M := by + simp [P5352T2PlacementData, M, n] + have hbeta : (P5352T2PlacementData K.1 2).1.2 = ⟨n-1,n⟩ := by + simp [P5352T2PlacementData, n] + have hA : (P5352T2Sources K hk 0).1 = DiamondTile K.1 := by + simp [P5352T2Sources] + have hcoords (w : GaussianInt) (hw : w ∈ FootprintVertices (DiamondTile K.1)) : + 0 ≤ w.im ∧ w.im ≤ 2*n ∧ -n ≤ w.re ∧ w.re ≤ n ∧ + -w.im-1 ≤ w.re ∧ w.re ≤ w.im+1 ∧ + -(2*n-w.im+1) ≤ w.re ∧ w.re ≤ 2*n-w.im+1 := DiamondRightHorizontal.hcoords K w hw + have hz' := DiamondRightHorizontal.hz' K hk z hzM hM hA + have hzB := hcoords z (by simpa [hA] using hz) + have hzMB := hcoords (z-M) hz' + have hzr : z.re = n := DiamondRightHorizontal.hzr K z hzB hzMB + have hzi : z.im = n := DiamondRightHorizontal.hzi K hk z hstar hM hA hcoords hzB hzMB hzr + have hzc : z = ⟨n,n⟩ := by ext <;> simp [hzr,hzi] + have foot (a b : Int) + (hb : 0 ≤ b ∧ b ≤ 2*n ∧ -n ≤ a ∧ a ≤ n ∧ + -b-1 ≤ a ∧ a ≤ b+1 ∧ -(2*n-b+1) ≤ a ∧ a ≤ 2*n-b+1) : + (⟨a,b⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := DiamondRightHorizontal.foot + K a b hb + have cellD (a b : Int) + (hb : 0 ≤ b ∧ b < 2*n ∧ -(b+1) ≤ a ∧ a < b+1 ∧ + -(2*n-b) ≤ a ∧ a < 2*n-b) := DiamondRightHorizontal.cellD K a b hb + have coverCells := DiamondRightHorizontal.coverCells K hk z hM hA hzr hzc cellD + have hWc : z-1 = ⟨n-1,n⟩ := by rw [hzc]; ext <;> simp + have hNc : z+⟨0,1⟩ = ⟨n,n+1⟩ := by rw [hzc]; ext <;> simp + have hSc : z-⟨0,1⟩ = ⟨n,n-1⟩ := by rw [hzc]; ext <;> simp + have hEc : z+1 = ⟨n+1,n⟩ := by rw [hzc]; ext <;> simp + have hw : z-1 ∈ FootprintVertices (DiamondTile K.1) := by + rw [hWc]; exact foot (n-1) n (by constructor <;> omega) + have hnorth : z+⟨0,1⟩ ∈ FootprintVertices (DiamondTile K.1) := by + rw [hNc]; exact foot n (n+1) (by constructor <;> omega) + have hsouth : z-⟨0,1⟩ ∈ FootprintVertices (DiamondTile K.1) := by + rw [hSc]; exact foot n (n-1) (by constructor <;> omega) + have hchildCenter : z-M ∈ FootprintVertices (DiamondTile K.1) := by + simpa [hA, hM] using hzM + have hchildEast := DiamondRightHorizontal.hchildEast K hk z hzr foot hEc + have hparent (w : GaussianInt) (hw : w ∈ FootprintVertices (DiamondTile K.1)) : + f w = Q w := DiamondRightHorizontal.hparent K hk f hC hA w hw + have hfCenter : f z = Q z := hparent z (by simpa [hA] using hz) + have hfWest : f (z-1) = Q (z-1) := hparent (z-1) hw + have hfNorth : f (z+⟨0,1⟩) = Q (z+⟨0,1⟩) := hparent _ hnorth + have hfSouth : f (z-⟨0,1⟩) = Q (z-⟨0,1⟩) := hparent _ hsouth + have hfChildCenter := DiamondRightHorizontal.hfChildCenter K hk f B z hR hzM hM hbeta hA + have hfEast := DiamondRightHorizontal.hfEast K hk f B z hR hM hbeta hA hchildEast + have qCenter : Q ⟨n,n⟩ = n*(n-1)/2 := by + simp [Q, abs_of_nonneg (show 0 ≤ n by omega)] + have qWest : Q ⟨n-1,n⟩ = (n-1)*(n-2)/2 := by + simp [Q, abs_of_nonneg (show 0 ≤ n-1 by omega)]; ring + have qNorth : Q ⟨n,n+1⟩ = n*(n-1)/2 := by + simp [Q, abs_of_nonneg (show 0 ≤ n by omega)] + have qSouth : Q ⟨n,n-1⟩ = n*(n-1)/2 := by + simp [Q, abs_of_nonneg (show 0 ≤ n by omega)] + have hsq0 : (-2*n)^2/4 = n^2 := by + simpa using (P4207T1FloorArithmetic.1 0 (-n)) + have hsq1 := DiamondRightHorizontal.hsq1 K f B z hzr + have hsq0' := DiamondRightHorizontal.hsq0' K hsq0 + have hsq1' := DiamondRightHorizontal.hsq1' K hsq1 + have qChildCenter := DiamondRightHorizontal.qChildCenter K hk f B z hzr hsq1 hsq0' hsq1' + have qChildEast := DiamondRightHorizontal.qChildEast K hk f B z hzr hsq1 hsq0' hsq1' + have hChildCenter : z-M = ⟨-n,n⟩ := by rw [hzc]; ext <;> simp [M]; ring + have hChildEast : (z+1)-M = ⟨1-n,n⟩ := by rw [hzc]; ext <;> simp [M]; ring + have hLap := DiamondRightHorizontal.hLap K f B z hzr hzc hWc hNc hSc hEc hfCenter hfWest + hfNorth hfSouth hfChildCenter hfEast qCenter qWest qNorth qSouth hsq1 hsq0' hsq1' + qChildCenter qChildEast hChildCenter hChildEast + refine ⟨?_, ?_⟩ + · intro _ + exact hLap + · intro hbad + exact (hbad coverCells).elim + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean b/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean new file mode 100644 index 0000000000..8c7d0396b2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean @@ -0,0 +1,814 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData +public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic +public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable + +-- [TABLET NODE: P5352T2RightSecond] + +/-! +# P5352T2RightSecond + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiamondRightSecond + +private theorem fourCells : + (by + classical + exact + ∀ (K : DiamondParameter), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, -k-1⟩ + let covered (x : GaussianInt) : Prop := + ∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → + y ∈ DiamondCellDomain K.1 ∨ y-rho ∈ DiamondCellDomain K.1 + ∀ (x : GaussianInt), covered x ↔ (x ∈ DiamondCellDomain K.1 ∨ x - rho ∈ DiamondCellDomain + K.1) ∧ (x - (1 : GaussianInt) ∈ DiamondCellDomain K.1 ∨ x - (1 : GaussianInt) - rho ∈ + DiamondCellDomain K.1) ∧ (x - ⟨(0 : ℤ), (1 : ℤ)⟩ ∈ DiamondCellDomain K.1 ∨ x - ⟨(0 : + ℤ), (1 : ℤ)⟩ - rho ∈ DiamondCellDomain K.1) ∧ (x - (1 : GaussianInt) - ⟨(0 : ℤ), (1 : + ℤ)⟩ ∈ DiamondCellDomain K.1 ∨ x - (1 : GaussianInt) - ⟨(0 : ℤ), (1 : ℤ)⟩ - rho ∈ + DiamondCellDomain K.1) ) := by + classical + intro K k rho covered x + constructor + · intro h + exact ⟨h x (Or.inl rfl), h (x-1) (Or.inr (Or.inl rfl)), + h (x-⟨0,1⟩) (Or.inr (Or.inr (Or.inl rfl))), + h (x-1-⟨0,1⟩) (Or.inr (Or.inr (Or.inr rfl)))⟩ + · rintro ⟨h0,h1,h2,h3⟩ y (rfl | rfl | rfl | rfl) + · exact h0 + · exact h1 + · exact h2 + · exact h3 + +private theorem contact : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (z : GaussianInt), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, -k-1⟩ + (z ∈ FootprintVertices (DiamondTile K.1)) → ((z - rho ∈ FootprintVertices (DiamondTile + K.1)) → ((∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ + x.im ≤ 2*k ∧ -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ + x.re ∧ x.re ≤ 2*k-x.im+1) → ((∃ t : Int, 0 ≤ t ∧ t < k ∧ z = ⟨-1-t,t⟩) ∨ (∃ t : Int, + 0 ≤ t ∧ t < k ∧ z = ⟨-t,t⟩)))) ) := by + classical + intro K z k rho hz hzR foot + have h0 := (foot z).mp hz + have h1 := (foot (z-rho)).mp hzR + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] at h1 + dsimp [rho] at h1 + have hd : z.re+z.im = -1 ∨ z.re+z.im = 0 := by omega + rcases hd with hd | hd + · left + refine ⟨z.im, by omega, by omega, ?_⟩ + ext <;> dsimp; omega + · right + refine ⟨z.im, by omega, by omega, ?_⟩ + ext <;> dsimp; omega + +private theorem cellsA : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, -k-1⟩ + let covered (x : GaussianInt) : Prop := + ∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → + y ∈ DiamondCellDomain K.1 ∨ y-rho ∈ DiamondCellDomain K.1 + (∀ (x : GaussianInt), x ∈ DiamondCellDomain K.1 ↔ 0 ≤ x.im ∧ x.im < 2*k ∧ -(x.im+1) ≤ + x.re ∧ x.re < x.im+1 ∧ -(2*k-x.im) ≤ x.re ∧ x.re < 2*k-x.im) → ((∀ (x : GaussianInt), + covered x ↔ (x ∈ DiamondCellDomain K.1 ∨ x-rho ∈ DiamondCellDomain K.1) ∧ (x-1 ∈ + DiamondCellDomain K.1 ∨ x-1-rho ∈ DiamondCellDomain K.1) ∧ (x-⟨0,1⟩ ∈ + DiamondCellDomain K.1 ∨ x-⟨0,1⟩-rho ∈ DiamondCellDomain K.1) ∧ (x-1-⟨0,1⟩ ∈ + DiamondCellDomain K.1 ∨ x-1-⟨0,1⟩-rho ∈ DiamondCellDomain K.1)) → (∀ (t : ℤ), (0 : ℤ) + ≤ t → t < k → (covered ⟨(-1 : ℤ) - t, t⟩ ↔ t + (1 : ℤ) < k)))) ) := by + classical + intro K hk k rho covered cell fourCells t ht0 htk + rw [fourCells] + simp only [cell, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + dsimp [rho] + omega + +private theorem cellsB : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, -k-1⟩ + let covered (x : GaussianInt) : Prop := + ∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → + y ∈ DiamondCellDomain K.1 ∨ y-rho ∈ DiamondCellDomain K.1 + (∀ (x : GaussianInt), x ∈ DiamondCellDomain K.1 ↔ 0 ≤ x.im ∧ x.im < 2*k ∧ -(x.im+1) ≤ + x.re ∧ x.re < x.im+1 ∧ -(2*k-x.im) ≤ x.re ∧ x.re < 2*k-x.im) → ((∀ (x : GaussianInt), + covered x ↔ (x ∈ DiamondCellDomain K.1 ∨ x-rho ∈ DiamondCellDomain K.1) ∧ (x-1 ∈ + DiamondCellDomain K.1 ∨ x-1-rho ∈ DiamondCellDomain K.1) ∧ (x-⟨0,1⟩ ∈ + DiamondCellDomain K.1 ∨ x-⟨0,1⟩-rho ∈ DiamondCellDomain K.1) ∧ (x-1-⟨0,1⟩ ∈ + DiamondCellDomain K.1 ∨ x-1-⟨0,1⟩-rho ∈ DiamondCellDomain K.1)) → (∀ (t : ℤ), (0 : ℤ) + ≤ t → t < k → (covered ⟨-t, t⟩ ↔ (0 : ℤ) < t)))) ) := by + classical + intro K hk k rho covered cell fourCells t ht0 htk + rw [fourCells] + simp only [cell, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + dsimp [rho] + omega + +private theorem footAE : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t < k → ⟨(-1 : ℤ) - t, t⟩ + (1 : ℤ√(-1 : ℤ)) + ∈ FootprintVertices (DiamondTile K.1))) ) := by + classical + intro K hk k foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one] + omega + +private theorem footAN : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t < k → ⟨(-1 : ℤ) - t, t⟩ + ⟨(0 : ℤ), (1 : + ℤ)⟩ ∈ FootprintVertices (DiamondTile K.1))) ) := by + classical + intro K hk k foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_add, Zsqrtd.im_add] + omega + +private theorem footAW : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, -k-1⟩ + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t < k → ⟨(-1 : ℤ) - t, t⟩ - (1 : ℤ√(-1 : ℤ)) + - rho ∈ FootprintVertices (DiamondTile K.1))) ) := by + classical + intro K hk k rho foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + dsimp [rho] + omega + +private theorem footAS : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, -k-1⟩ + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t < k → ⟨(-1 : ℤ) - t, t⟩ - ⟨(0 : ℤ), (1 : + ℤ)⟩ - rho ∈ FootprintVertices (DiamondTile K.1))) ) := by + classical + intro K hk k rho foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + dsimp [rho] + omega + +private theorem footBE : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t < k → ⟨-t, t⟩ + (1 : ℤ√(-1 : ℤ)) ∈ + FootprintVertices (DiamondTile K.1))) ) := by + classical + intro K hk k foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one] + omega + +private theorem footBW : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t < k → ⟨-t, t⟩ - (1 : ℤ√(-1 : ℤ)) ∈ + FootprintVertices (DiamondTile K.1))) ) := by + classical + intro K hk k foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + omega + +private theorem footBN : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t < k → ⟨-t, t⟩ + ⟨(0 : ℤ), (1 : ℤ)⟩ ∈ + FootprintVertices (DiamondTile K.1))) ) := by + classical + intro K hk k foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_add, Zsqrtd.im_add] + omega + +private theorem footBS : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, -k-1⟩ + (∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) ↔ 0 ≤ x.im ∧ x.im ≤ 2*k ∧ + -k ≤ x.re ∧ x.re ≤ k ∧ -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ + 2*k-x.im+1) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t < k → ⟨-t, t⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ - rho ∈ + FootprintVertices (DiamondTile K.1))) ) := by + classical + intro K hk k rho foot t ht0 htk + rw [foot] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + dsimp [rho] + omega + +private theorem tri : + (by + classical + exact + (DiamondParameter) → (∀ (a : ℤ), (2 : ℤ) * (a * (a - (1 : ℤ)) / (2 : ℤ)) = a * (a - (1 : + ℤ))) ) := by + classical + intro K a + rcases Int.emod_two_eq_zero_or_one a with h | h + · have ha : a = 2*(a/2) := by omega + rw [ha] + rw [show 2*(a/2)*(2*(a/2)-1) = 2*((a/2)*(2*(a/2)-1)) by ring, + Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + · have ha : a = 2*(a/2)+1 := by omega + rw [ha] + rw [show (2*(a/2)+1)*(2*(a/2)+1-1) = 2*((2*(a/2)+1)*(a/2)) by ring, + Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + +private theorem square : + (by + classical + exact + (DiamondParameter) → (∀ (a : ℤ), (4 : ℤ) * (a ^ (2 : ℕ) / (4 : ℤ)) = a ^ (2 : ℕ) - a % (2 + : ℤ)) ) := by + classical + intro K a + rcases Int.emod_two_eq_zero_or_one a with h | h + · have ha : a = 2*(a/2) := by omega + have he : a^2 = 4*(a/2)^2 := by + conv_lhs => rw [ha] + ring + rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (4:Int) ≠ 0), h] + ring + · have ha : a = 2*(a/2)+1 := by omega + have he : a^2 = 4*((a/2)^2+a/2)+1 := by + conv_lhs => rw [ha] + ring + rw [he, h] + omega + +private theorem scale : + (by + classical + exact + let Q (a b : Int) : Int := + (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), 2*(a*(a-1)/2) = a*(a-1)) → ((∀ (a : Int), 4*(a^2/4) = a^2-a%2) → (∀ (a : + ℤ), ∀ (b : ℤ), (4 : ℤ) * Q a b = S a b)) ) := by + classical + intro Q S tri square a b + have ht := tri (Int.natAbs a : Int) + have hs := square (a-b) + have ha : (Int.natAbs a : Int)^2 = a^2 := by + rw [Int.natCast_natAbs, sq_abs] + dsimp [Q, S] + rw [Int.natCast_natAbs] at ht ha ⊢ + nlinarith only [ht, hs, ha] + +private theorem sEven : + (by + classical + exact + (DiamondParameter) → ( + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + ∀ (a : ℤ), ∀ (b : ℤ), ∀ (m : ℤ), a - b = (2 : ℤ) * m → S a b = (2 : ℤ) * a ^ (2 : ℕ) - (2 + : ℤ) * |a| - (4 : ℤ) * m ^ (2 : ℕ)) ) := by + classical + intro K S a b m h + dsimp [S] + rw [h, show (2*m)%2 = 0 by omega] + ring + +private theorem sOdd : + (by + classical + exact + (DiamondParameter) → ( + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + ∀ (a : ℤ), ∀ (b : ℤ), ∀ (m : ℤ), a - b = (2 : ℤ) * m + (1 : ℤ) → S a b = (2 : ℤ) * a ^ (2 + : ℕ) - (2 : ℤ) * |a| - (4 : ℤ) * m ^ (2 : ℕ) - (4 : ℤ) * m) ) := by + classical + intro K S a b m h + dsimp [S] + rw [h, show (2*m+1)%2 = 1 by omega] + ring + +private theorem valR : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, -k-1⟩ + (∀ (y : GaussianInt), y - rho ∈ FootprintVertices (DiamondTile K.1) → f y = + DiamondOdometer K (y - rho) + -k * y.re + B) → ( + let Q (a b : Int) : Int := + (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + ∀ (x : GaussianInt), x - rho ∈ FootprintVertices (DiamondTile K.1) → f x = Q (x - rho).re + (x - rho).im - k * x.re + B) ) := by + classical + intro K f B k rho hR Q x hx + rw [hR x hx, (P5352T2DomainRows K (x-rho)).2 hx] + dsimp [Q] + ring + +private theorem diffC : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let Q (a b : Int) : Int := + (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), 4*Q a b = S a b) → ((∀ (x : GaussianInt), (x ∈ + FootprintVertices (DiamondTile K.1)) → (f x = Q x.re x.im)) → (∀ (x : GaussianInt), ∀ + (y : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) → y ∈ FootprintVertices + (DiamondTile K.1) → (4 : ℤ) * (f y - f x) = S y.re y.im - S x.re x.im)) ) := by + classical + intro K f Q S scale valC x y hx hy + rw [valC x hx, valC y hy] + linear_combination scale y.re y.im - scale x.re x.im + +private theorem diffR : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, -k-1⟩ + let Q (a b : Int) : Int := + (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), 4*Q a b = S a b) → ((∀ (x : GaussianInt), (x-rho ∈ + FootprintVertices (DiamondTile K.1)) → (f x = Q (x-rho).re (x-rho).im-k*x.re+B)) → (∀ + (x : GaussianInt), ∀ (y : GaussianInt), x - rho ∈ FootprintVertices (DiamondTile K.1) + → y - rho ∈ FootprintVertices (DiamondTile K.1) → (4 : ℤ) * (f y - f x) = S (y - + rho).re (y - rho).im - S (x - rho).re (x - rho).im - (4 : ℤ) * k * (y - x).re)) ) := by + classical + intro K f B k rho Q S scale valR x y hx hy + rw [valR x hx, valR y hy] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + linear_combination scale (y.re-rho.re) (y.im-rho.im) - + scale (x.re-rho.re) (x.im-rho.im) + +private theorem lap : + (by + classical + exact + ∀ (f : IntegerLatticeFunction), ∀ (x : GaussianInt), FourNeighborLaplacian f x = f (x + + (1 : GaussianInt)) - f x + (f (x - (1 : GaussianInt)) - f x) + (f (x + ⟨(0 : ℤ), (1 : + ℤ)⟩) - f x) + (f (x - ⟨(0 : ℤ), (1 : ℤ)⟩) - f x) ) := by + classical + intro f x + unfold FourNeighborLaplacian + ring + +private theorem eastAt316 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + (∀ (t : Int), (0 ≤ t) → ((t < k) → ((⟨-1-t,t⟩ : GaussianInt)+1 ∈ FootprintVertices + (DiamondTile K.1)))) → ( + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x ∈ FootprintVertices (DiamondTile + K.1)) → ((y ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S y.re y.im-S + x.re x.im))) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((t < k) → ((⟨(-1 : ℤ) - t, t⟩ ∈ + FootprintVertices (DiamondTile K.1)) → (f ((⟨-1-t,t⟩ : GaussianInt)+1)-f ⟨-1-t,t⟩ = + 0))))))) ) := by + classical + intro K f k footAE S sEven sOdd diffC t ht0 htk hz + have h := diffC _ _ hz (footAE t ht0 htk) + rw [sEven _ _ (-t) (by dsimp; ring), sOdd _ _ (-t-1) (by dsimp; ring)] at h + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at h + simp (disch := omega) only [abs_of_nonpos] at h + nlinarith only [h] + +private theorem northAt322 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + (∀ (t : Int), (0 ≤ t) → ((t < k) → ((⟨-1-t,t⟩ : GaussianInt)+⟨0,1⟩ ∈ FootprintVertices + (DiamondTile K.1)))) → ( + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x ∈ FootprintVertices (DiamondTile + K.1)) → ((y ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S y.re y.im-S + x.re x.im))) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((t < k) → ((⟨(-1 : ℤ) - t, t⟩ ∈ + FootprintVertices (DiamondTile K.1)) → (f ((⟨-1-t,t⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-1-t,t⟩ + = -t-1))))))) ) := by + classical + intro K f k footAN S sEven sOdd diffC t ht0 htk hz + have h := diffC _ _ hz (footAN t ht0 htk) + rw [sEven _ _ (-t-1) (by dsimp; ring), sOdd _ _ (-t-1) (by dsimp; ring)] at h + simp only [Zsqrtd.re_add] at h + simp (disch := omega) only [abs_of_nonpos] at h + nlinarith only [h] + +private theorem westAt328 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, -k-1⟩ + (∀ (t : Int), (0 ≤ t) → ((t < k) → ((⟨-1-t,t⟩ : GaussianInt)-1-rho ∈ FootprintVertices + (DiamondTile K.1)))) → ( + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x-rho ∈ FootprintVertices (DiamondTile + K.1)) → ((y-rho ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S (y-rho).re + (y-rho).im-S (x-rho).re (x-rho).im - 4*k*(y-x).re))) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → + ((t < k) → ((⟨(-1 : ℤ) - t, t⟩ - rho ∈ FootprintVertices (DiamondTile K.1)) → ((f + ((⟨-1-t,t⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-1-t,t⟩ = -t-1) → (f ((⟨-1-t,t⟩ : + GaussianInt)-1)-f ⟨-1-t,t⟩ = if t+1=k then 0 else 1)))))))) ) := by + classical + intro K f k rho footAW S sEven sOdd diffR t ht0 htk hzR north + have h := diffR _ _ hzR (footAW t ht0 htk) + rw [sOdd _ _ (-t-2) (by dsimp [rho]; ring), + sEven _ _ (-t-1) (by dsimp [rho]; ring)] at h + simp only [rho, Zsqrtd.re_sub, Zsqrtd.re_one] at h + by_cases ht : t+1=k + · rw [ite_eq_left ht] + simp (disch := omega) only [abs_of_nonpos] at h + nlinarith only [h, ht] + · rw [ite_eq_right ht] + simp (disch := omega) only [abs_of_nonneg] at h + nlinarith only [h] + +private theorem southAt341 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, -k-1⟩ + (∀ (t : Int), (0 ≤ t) → ((t < k) → ((⟨-1-t,t⟩ : GaussianInt)-⟨0,1⟩-rho ∈ + FootprintVertices (DiamondTile K.1)))) → ( + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x-rho ∈ FootprintVertices (DiamondTile + K.1)) → ((y-rho ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S (y-rho).re + (y-rho).im-S (x-rho).re (x-rho).im - 4*k*(y-x).re))) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → + ((t < k) → ((⟨(-1 : ℤ) - t, t⟩ - rho ∈ FootprintVertices (DiamondTile K.1)) → ((f + ((⟨-1-t,t⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-1-t,t⟩ = -t-1) → ((f ((⟨-1-t,t⟩ : + GaussianInt)-1)-f ⟨-1-t,t⟩ = if t+1=k then 0 else 1) → (f ((⟨-1-t,t⟩ : + GaussianInt)-⟨0,1⟩)-f ⟨-1-t,t⟩ = t+1))))))))) ) := by + classical + intro K f k rho footAS S sEven sOdd diffR t ht0 htk hzR north west + have h := diffR _ _ hzR (footAS t ht0 htk) + rw [sOdd _ _ (-t-1) (by dsimp [rho]; ring), + sEven _ _ (-t-1) (by dsimp [rho]; ring)] at h + simp only [rho, Zsqrtd.re_sub] at h + simp (disch := omega) only [abs_of_nonneg] at h + nlinarith only [h] + +private theorem htAt355 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, -k-1⟩ + let covered (x : GaussianInt) : Prop := + ∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → + y ∈ DiamondCellDomain K.1 ∨ y-rho ∈ DiamondCellDomain K.1 + ∀ (t : ℤ), (t < k) → ((covered ⟨(-1 : ℤ) - t, t⟩ ↔ t + (1 : ℤ) < k) → ((f ((⟨-1-t,t⟩ : + GaussianInt)+⟨0,1⟩)-f ⟨-1-t,t⟩ = -t-1) → ((f ((⟨-1-t,t⟩ : GaussianInt)-1)-f ⟨-1-t,t⟩ + = if t+1=k then 0 else 1) → ((f ((⟨-1-t,t⟩ : GaussianInt)-⟨0,1⟩)-f ⟨-1-t,t⟩ = t+1) → + ((¬covered ⟨(-1 : ℤ) - t, t⟩) → (t+1 = k)))))) ) := by + classical + intro K f k rho covered t htk cells north west south hc + have : ¬ t+1 < k := fun ht => hc (cells.mpr ht) + omega + +private theorem eastAt361 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + (∀ (t : Int), (0 ≤ t) → ((t < k) → ((⟨-t,t⟩ : GaussianInt)+1 ∈ FootprintVertices + (DiamondTile K.1)))) → ( + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x ∈ FootprintVertices (DiamondTile + K.1)) → ((y ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S y.re y.im-S + x.re x.im))) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((t < k) → ((⟨-t, t⟩ ∈ FootprintVertices + (DiamondTile K.1)) → (f ((⟨-t,t⟩ : GaussianInt)+1)-f ⟨-t,t⟩ = if t=0 then 0 else + 1))))))) ) := by + classical + intro K f k footBE S sEven sOdd diffC t ht0 htk hz + have h := diffC _ _ hz (footBE t ht0 htk) + rw [sOdd _ _ (-t) (by dsimp; ring), sEven _ _ (-t) (by dsimp; ring)] at h + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at h + by_cases ht : t=0 + · rw [ite_eq_left ht] + simp (disch := omega) only [abs_of_nonneg] at h + nlinarith only [h, ht] + · rw [ite_eq_right ht] + simp (disch := omega) only [abs_of_nonpos] at h + nlinarith only [h] + +private theorem westAt373 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + (∀ (t : Int), (0 ≤ t) → ((t < k) → ((⟨-t,t⟩ : GaussianInt)-1 ∈ FootprintVertices + (DiamondTile K.1)))) → ( + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x ∈ FootprintVertices (DiamondTile + K.1)) → ((y ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S y.re y.im-S + x.re x.im))) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((t < k) → ((⟨-t, t⟩ ∈ FootprintVertices + (DiamondTile K.1)) → (f ((⟨-t,t⟩ : GaussianInt)-1)-f ⟨-t,t⟩ = 0))))))) ) := by + classical + intro K f k footBW S sEven sOdd diffC t ht0 htk hz + have h := diffC _ _ hz (footBW t ht0 htk) + rw [sOdd _ _ (-t-1) (by dsimp; ring), sEven _ _ (-t) (by dsimp; ring)] at h + simp only [Zsqrtd.re_sub, Zsqrtd.re_one] at h + simp (disch := omega) only [abs_of_nonpos] at h + nlinarith only [h] + +private theorem northAt379 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + (∀ (t : Int), (0 ≤ t) → ((t < k) → ((⟨-t,t⟩ : GaussianInt)+⟨0,1⟩ ∈ FootprintVertices + (DiamondTile K.1)))) → ( + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x ∈ FootprintVertices (DiamondTile + K.1)) → ((y ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S y.re y.im-S + x.re x.im))) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((t < k) → ((⟨-t, t⟩ ∈ FootprintVertices + (DiamondTile K.1)) → (f ((⟨-t,t⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-t,t⟩ = -t))))))) ) := by + classical + intro K f k footBN S sEven sOdd diffC t ht0 htk hz + have h := diffC _ _ hz (footBN t ht0 htk) + rw [sOdd _ _ (-t-1) (by dsimp; ring), sEven _ _ (-t) (by dsimp; ring)] at h + simp only [Zsqrtd.re_add] at h + simp (disch := omega) only [abs_of_nonpos] at h + nlinarith only [h] + +private theorem southAt385 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, -k-1⟩ + (∀ (t : Int), (0 ≤ t) → ((t < k) → ((⟨-t,t⟩ : GaussianInt)-⟨0,1⟩-rho ∈ FootprintVertices + (DiamondTile K.1)))) → ( + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ + (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) + → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x-rho ∈ FootprintVertices (DiamondTile + K.1)) → ((y-rho ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S (y-rho).re + (y-rho).im-S (x-rho).re (x-rho).im - 4*k*(y-x).re))) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → + ((t < k) → ((⟨-t, t⟩ - rho ∈ FootprintVertices (DiamondTile K.1)) → ((f ((⟨-t,t⟩ : + GaussianInt)-1)-f ⟨-t,t⟩ = 0) → ((f ((⟨-t,t⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-t,t⟩ = -t) → + (f ((⟨-t,t⟩ : GaussianInt)-⟨0,1⟩)-f ⟨-t,t⟩ = t))))))))) ) := by + classical + intro K f k rho footBS S sEven sOdd diffR t ht0 htk hzR west north + have h := diffR _ _ hzR (footBS t ht0 htk) + rw [sEven _ _ (-t) (by dsimp [rho]; ring), + sOdd _ _ (-t-1) (by dsimp [rho]; ring)] at h + simp only [rho, Zsqrtd.re_sub] at h + simp (disch := omega) only [abs_of_nonneg] at h + nlinarith only [h] + +private theorem htAt399 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, -k-1⟩ + let covered (x : GaussianInt) : Prop := + ∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → + y ∈ DiamondCellDomain K.1 ∨ y-rho ∈ DiamondCellDomain K.1 + ∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((covered ⟨-t, t⟩ ↔ (0 : ℤ) < t) → ((f ((⟨-t,t⟩ : + GaussianInt)-1)-f ⟨-t,t⟩ = 0) → ((f ((⟨-t,t⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-t,t⟩ = -t) → + ((f ((⟨-t,t⟩ : GaussianInt)-⟨0,1⟩)-f ⟨-t,t⟩ = t) → ((¬covered ⟨-t, t⟩) → (t=0)))))) ) + := by + classical + intro K f k rho covered t ht0 cells west north south hc + have : ¬ 0 < t := fun ht => hc (cells.mpr ht) + omega + +end DiamondRightSecond + +theorem P5352T2RightSecond (K : DiamondParameter) (hk : 1 < K.1) + (f : IntegerLatticeFunction) (B : Int) (z : GaussianInt) : + let A := P5352T2Sources K hk 0 + let M := (P5352T2PlacementData K.1 1).1 + (∀ y, y ∈ FootprintVertices A.1 → f y = A.2.1 y) → + (∀ y, y - M.1 ∈ FootprintVertices A.1 → + f y = A.2.1 (y - M.1) + M.2.re*y.re + M.2.im*y.im + B) → + z ∈ FootprintVertices A.1 → z - M.1 ∈ FootprintVertices A.1 → + (∀ y, y = z ∨ y = z + 1 ∨ y = z - 1 ∨ + y = z + ⟨0, 1⟩ ∨ y = z - ⟨0, 1⟩ → + y ∈ FootprintVertices A.1 ∨ y - M.1 ∈ FootprintVertices A.1) → + ((∀ y, y = z ∨ y = z - 1 ∨ y = z - ⟨0, 1⟩ ∨ + y = z - 1 - ⟨0, 1⟩ → + y ∈ A.1.cells ∨ y - M.1 ∈ A.1.cells) → FourNeighborLaplacian f z = 1) ∧ + (¬ (∀ y, y = z ∨ y = z - 1 ∨ y = z - ⟨0, 1⟩ ∨ + y = z - 1 - ⟨0, 1⟩ → + y ∈ A.1.cells ∨ y - M.1 ∈ A.1.cells) → FourNeighborLaplacian f z = 0) := by +-- BODY + exact (by + classical + dsimp only + intro hC hR hz hzR hstar + let k : Int := K.1 + let rho : GaussianInt := ⟨-k, -k-1⟩ + have hkI : 2 ≤ k := by dsimp [k]; exact_mod_cast hk + change (∀ y, y ∈ FootprintVertices (DiamondTile K.1) → + f y = DiamondOdometer K y) at hC + change (∀ y, y-rho ∈ FootprintVertices (DiamondTile K.1) → + f y = DiamondOdometer K (y-rho) + (-k)*y.re + 0*y.im+B) at hR + simp only [zero_mul, add_zero] at hR + change z ∈ FootprintVertices (DiamondTile K.1) at hz + change z-rho ∈ FootprintVertices (DiamondTile K.1) at hzR + let covered (x : GaussianInt) : Prop := + ∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → + y ∈ DiamondCellDomain K.1 ∨ y-rho ∈ DiamondCellDomain K.1 + change (covered z → FourNeighborLaplacian f z = 1) ∧ + (¬ covered z → FourNeighborLaplacian f z = 0) + have foot (x : GaussianInt) : + x ∈ FootprintVertices (DiamondTile K.1) ↔ + 0 ≤ x.im ∧ x.im ≤ 2*k ∧ -k ≤ x.re ∧ x.re ≤ k ∧ + -x.im-1 ≤ x.re ∧ x.re ≤ x.im+1 ∧ + -(2*k-x.im+1) ≤ x.re ∧ x.re ≤ 2*k-x.im+1 := + (P5352T2DomainRows K x).1 + have cell (x : GaussianInt) : + x ∈ DiamondCellDomain K.1 ↔ + 0 ≤ x.im ∧ x.im < 2*k ∧ -(x.im+1) ≤ x.re ∧ x.re < x.im+1 ∧ + -(2*k-x.im) ≤ x.re ∧ x.re < 2*k-x.im := + (P4194T1DiamondCellRows K.1 x).1 + have fourCells (x : GaussianInt) := DiamondRightSecond.fourCells K x + -- Classify the common footprint before evaluating either formula. + have contact := DiamondRightSecond.contact K z hz hzR foot + -- These cell tests are independent of the star's footprint coverage. + have cellsA (t : Int) (ht0 : 0 ≤ t) (htk : t < k) := DiamondRightSecond.cellsA K hk cell + fourCells t ht0 htk + have cellsB (t : Int) (ht0 : 0 ≤ t) (htk : t < k) := DiamondRightSecond.cellsB K hk cell + fourCells t ht0 htk + have footAE (t : Int) (ht0 : 0 ≤ t) (htk : t < k) := DiamondRightSecond.footAE K hk foot t + ht0 htk + have footAN (t : Int) (ht0 : 0 ≤ t) (htk : t < k) := DiamondRightSecond.footAN K hk foot t + ht0 htk + have footAW (t : Int) (ht0 : 0 ≤ t) (htk : t < k) := DiamondRightSecond.footAW K hk foot t + ht0 htk + have footAS (t : Int) (ht0 : 0 ≤ t) (htk : t < k) := DiamondRightSecond.footAS K hk foot t + ht0 htk + have footBE (t : Int) (ht0 : 0 ≤ t) (htk : t < k) := DiamondRightSecond.footBE K hk foot t + ht0 htk + have footBW (t : Int) (ht0 : 0 ≤ t) (htk : t < k) := DiamondRightSecond.footBW K hk foot t + ht0 htk + have footBN (t : Int) (ht0 : 0 ≤ t) (htk : t < k) := DiamondRightSecond.footBN K hk foot t + ht0 htk + have footBS (t : Int) (ht0 : 0 ≤ t) (htk : t < k) := DiamondRightSecond.footBS K hk foot t + ht0 htk + let Q (a b : Int) : Int := + (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + have tri (a : Int) := DiamondRightSecond.tri K a + have square (a : Int) := DiamondRightSecond.square K a + have scale (a b : Int) := DiamondRightSecond.scale tri square a b + have sEven (a b m : Int) (h : a-b = 2*m) := DiamondRightSecond.sEven K a b m h + have sOdd (a b m : Int) (h : a-b = 2*m+1) := DiamondRightSecond.sOdd K a b m h + have valC (x : GaussianInt) (hx : x ∈ FootprintVertices (DiamondTile K.1)) : + f x = Q x.re x.im := (hC x hx).trans ((P5352T2DomainRows K x).2 hx) + have valR (x : GaussianInt) (hx : x-rho ∈ FootprintVertices (DiamondTile K.1)) := + DiamondRightSecond.valR K f B hR x hx + have diffC (x y : GaussianInt) + (hx : x ∈ FootprintVertices (DiamondTile K.1)) + (hy : y ∈ FootprintVertices (DiamondTile K.1)) := DiamondRightSecond.diffC K f scale valC + x y hx hy + -- Subtraction at the common center cancels B. + have diffR (x y : GaussianInt) + (hx : x-rho ∈ FootprintVertices (DiamondTile K.1)) + (hy : y-rho ∈ FootprintVertices (DiamondTile K.1)) := DiamondRightSecond.diffR K f B + scale valR x y hx hy + have lap (x : GaussianInt) : FourNeighborLaplacian f x = + (f (x+1)-f x)+(f (x-1)-f x)+ + (f (x+⟨0,1⟩)-f x)+(f (x-⟨0,1⟩)-f x) := DiamondRightSecond.lap f x + rcases contact with ⟨t,ht0,htk,rfl⟩ | ⟨t,ht0,htk,rfl⟩ + · have cells := cellsA t ht0 htk + have east : f ((⟨-1-t,t⟩ : GaussianInt)+1)-f ⟨-1-t,t⟩ = 0 := DiamondRightSecond.eastAt316 K + f footAE sEven sOdd diffC t ht0 htk hz + have north : f ((⟨-1-t,t⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-1-t,t⟩ = -t-1 := + DiamondRightSecond.northAt322 K f footAN sEven sOdd diffC t ht0 htk hz + have west : f ((⟨-1-t,t⟩ : GaussianInt)-1)-f ⟨-1-t,t⟩ = + if t+1=k then 0 else 1 := DiamondRightSecond.westAt328 K f footAW sEven sOdd diffR t + ht0 htk hzR north + have south : f ((⟨-1-t,t⟩ : GaussianInt)-⟨0,1⟩)-f ⟨-1-t,t⟩ = t+1 := + DiamondRightSecond.southAt341 K f footAS sEven sOdd diffR t ht0 htk hzR north west + rw [lap, east, west, north, south] + constructor + · intro hc + have ht : t+1 ≠ k := by have := cells.mp hc; omega + rw [ite_eq_right ht] + ring + · intro hc + have ht : t+1 = k := DiamondRightSecond.htAt355 K f t htk cells north west south hc + rw [ite_eq_left ht] + ring + · have cells := cellsB t ht0 htk + have east : f ((⟨-t,t⟩ : GaussianInt)+1)-f ⟨-t,t⟩ = + if t=0 then 0 else 1 := DiamondRightSecond.eastAt361 K f footBE sEven sOdd diffC t ht0 + htk hz + have west : f ((⟨-t,t⟩ : GaussianInt)-1)-f ⟨-t,t⟩ = 0 := DiamondRightSecond.westAt373 K f + footBW sEven sOdd diffC t ht0 htk hz + have north : f ((⟨-t,t⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-t,t⟩ = -t := + DiamondRightSecond.northAt379 K f footBN sEven sOdd diffC t ht0 htk hz + have south : f ((⟨-t,t⟩ : GaussianInt)-⟨0,1⟩)-f ⟨-t,t⟩ = t := DiamondRightSecond.southAt385 + K f footBS sEven sOdd diffR t ht0 htk hzR west north + rw [lap, east, west, north, south] + constructor + · intro hc + have ht : t ≠ 0 := by have := cells.mp hc; omega + rw [ite_eq_right ht] + ring + · intro hc + have ht : t=0 := DiamondRightSecond.htAt399 K f t ht0 cells west north south hc + rw [ite_eq_left ht] + ring + ) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2SecondUnit.lean b/LeanPool/ApollonianSuperharmonic/P5352T2SecondUnit.lean new file mode 100644 index 0000000000..c8628acfaf --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5352T2SecondUnit.lean @@ -0,0 +1,174 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData +public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic +public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable +public import LeanPool.ApollonianSuperharmonic.P5416T1SecondUnitGeometry +public import LeanPool.ApollonianSuperharmonic.P5416T1DiamondAxialDifferences + +-- [TABLET NODE: P5352T2SecondUnit] + +/-! +# P5352T2SecondUnit + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5352T2SecondUnit (K : DiamondParameter) (hk : 1 < K.1) + (s : Fin 4) (f : IntegerLatticeFunction) (B : Int) (z : GaussianInt) : + let A := P5352T2Sources K hk 0 + let D := P5352T2Sources K hk 2 + let M := (P5352T2PlacementData K.1 1).2 s + (∀ y, y ∈ FootprintVertices A.1 → f y = A.2.1 y) → + (∀ y, y - M.1 ∈ FootprintVertices D.1 → + f y = D.2.1 (y - M.1) + M.2.1.re*y.re + M.2.1.im*y.im + B) → + z ∈ FootprintVertices A.1 → z - M.1 ∈ FootprintVertices D.1 → + (∀ y, y = z ∨ y = z + 1 ∨ y = z - 1 ∨ + y = z + ⟨0, 1⟩ ∨ y = z - ⟨0, 1⟩ → + y ∈ FootprintVertices A.1 ∨ y - M.1 ∈ FootprintVertices D.1) → + (z - M.2.2 ∈ FootprintVertices A.1 → FourNeighborLaplacian f z = 0) ∧ + (z - M.2.2 ∉ FootprintVertices A.1 → FourNeighborLaplacian f z = 1) := by +-- BODY + classical + let k : Int := K.1 + have hk2 : 2 ≤ k := by dsimp [k]; omega + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + have cmem (x : GaussianInt) : + x ∈ FootprintVertices (DiamondTile K.1) ↔ C x.re x.im := + (P5352T2DomainRows K x).1 + have umem (x : GaussianInt) : + x ∈ FootprintVertices (P5352T2Sources K hk 2).1 ↔ U x.re x.im := by + simp only [P5352T2Sources, Matrix.cons_val_two] + simp [FootprintVertices] + simp only [Zsqrtd.ext_iff, Zsqrtd.re_zero, Zsqrtd.im_zero, + Zsqrtd.re_one, Zsqrtd.im_one, Zsqrtd.re_add, Zsqrtd.im_add] + dsimp [U] + omega + dsimp only + intro hA hP hzA hzP hcov + change ∀ y, y ∈ FootprintVertices (DiamondTile K.1) → + f y = DiamondOdometer K y at hA + have child (p q : Int) (h : C p q) : + f ⟨p,q⟩ = P4207T1DiamondFormula ⟨p,q⟩ := by as_aux_lemma => + rw [hA _ ((cmem _).mpr h)] + exact (P5352T2DomainRows K _).2 ((cmem _).mpr h) + obtain ⟨center, marked⟩ := P5416T1SecondUnitGeometry K hk s z hzA hzP hcov + let d := ((P5352T2PlacementData K.1 1).2 s).1 + let a := ((P5352T2PlacementData K.1 1).2 s).2.1 + have parent (p q : Int) (h : U (p-d.re) (q-d.im)) : + f ⟨p,q⟩ = a.re*p + a.im*q + B := by as_aux_lemma => + have hh := hP ⟨p,q⟩ ((umem _).mpr h) + change f ⟨p,q⟩ = (if (⟨p,q⟩ : GaussianInt)-d = 1+⟨0,1⟩ then (0 : Int) else 0) + + a.re*p + a.im*q + B at hh + simpa only [ite_self, zero_add] using hh + have lap (p q : Int) : FourNeighborLaplacian f ⟨p,q⟩ = + (f ⟨p+1,q⟩ - f ⟨p,q⟩) + (f ⟨p-1,q⟩ - f ⟨p,q⟩) + + (f ⟨p,q+1⟩ - f ⟨p,q⟩) + (f ⟨p,q-1⟩ - f ⟨p,q⟩) := by as_aux_lemma => + rw [FourNeighborLaplacian, + show (⟨p,q⟩ : GaussianInt)+1 = ⟨p+1,q⟩ by ext <;> simp, + show (⟨p,q⟩ : GaussianInt)-1 = ⟨p-1,q⟩ by ext <;> simp, + show (⟨p,q⟩ : GaussianInt)+⟨0,1⟩ = ⟨p,q+1⟩ by ext <;> simp, + show (⟨p,q⟩ : GaussianInt)-⟨0,1⟩ = ⟨p,q-1⟩ by ext <;> simp] + ring + clear hA hP hzA hzP hcov umem + fin_cases s + · as_aux_lemma => + change z = ⟨-k,k⟩ at center + subst z + norm_num [Fin.ext_iff] at marked + change ∀ p q, U (p-(-k-1)) (q-(k-1)) → + f ⟨p,q⟩ = 0*p + (-k)*q + B at parent + have hdiffW := parent (-k-1) k (by dsimp [U]; omega) + have hdiffZ := parent (-k) k (by dsimp [U]; omega) + have hw : f ⟨-k-1,k⟩ - f ⟨-k,k⟩ = 0 := by + omega + clear hdiffW hdiffZ parent + have he := child (1-k) k (by dsimp [C]; omega) + have hn := child (-k) (k+1) (by dsimp [C]; omega) + have hs := child (-k) (k-1) (by dsimp [C]; omega) + have hc := child (-k) k (by dsimp [C]; omega) + have hl : FourNeighborLaplacian f ⟨-k,k⟩ = 1 := by + rw [lap, show -k+1 = 1-k by ring] + have hleft := (P5416T1DiamondAxialDifferences k hk2).1 + omega + exact ⟨fun h => False.elim (marked h), fun _ => hl⟩ + · as_aux_lemma => + change z = ⟨0,0⟩ at center + subst z + norm_num [Fin.ext_iff] at marked + change ∀ p q, U (p-0) (q-(-1)) → + f ⟨p,q⟩ = 0*p + 0*q + B at parent + have hdiffS := parent 0 (-1) (by dsimp [U]; omega) + have hdiffZ := parent 0 0 (by dsimp [U]; omega) + have hs : f ⟨0,-1⟩ - f ⟨0,0⟩ = 0 := by + omega + clear hdiffS hdiffZ parent + have he := child 1 0 (by dsimp [C]; omega) + have hw := child (-1) 0 (by dsimp [C]; omega) + have hn := child 0 1 (by dsimp [C]; omega) + have hc := child 0 0 (by dsimp [C]; omega) + have hl : FourNeighborLaplacian f ⟨0,0⟩ = 0 := by + rw [lap] + norm_num only [zero_add, zero_sub] + have hbottom := (P5416T1DiamondAxialDifferences k hk2).2.1 + omega + exact ⟨fun _ => hl, fun h => False.elim (h marked)⟩ + · as_aux_lemma => + change z = ⟨k,k⟩ at center + subst z + norm_num [Fin.ext_iff] at marked + change ∀ p q, U (p-k) (q-k) → + f ⟨p,q⟩ = k*p + 0*q + B at parent + have hdiffE := parent (k+1) k (by dsimp [U]; omega) + have hdiffZ := parent k k (by dsimp [U]; omega) + have he : f ⟨k+1,k⟩ - f ⟨k,k⟩ = k := by + nlinarith only [hdiffE, hdiffZ] + clear hdiffE hdiffZ parent + have hw := child (k-1) k (by dsimp [C]; omega) + have hn := child k (k+1) (by dsimp [C]; omega) + have hs := child k (k-1) (by dsimp [C]; omega) + have hc := child k k (by dsimp [C]; omega) + have hl : FourNeighborLaplacian f ⟨k,k⟩ = 1 := by + rw [lap] + have hright := (P5416T1DiamondAxialDifferences k hk2).2.2.1 + omega + exact ⟨fun h => False.elim (marked h), fun _ => hl⟩ + · as_aux_lemma => + change z = ⟨0,2*k⟩ at center + subst z + norm_num [Fin.ext_iff] at marked + change ∀ p q, U (p-(-1)) (q-2*k) → + f ⟨p,q⟩ = k*p + (-k)*q + B at parent + have hdiffN := parent 0 (2*k+1) (by dsimp [U]; omega) + have hdiffZ := parent 0 (2*k) (by dsimp [U]; omega) + have hn : f ⟨0,2*k+1⟩ - f ⟨0,2*k⟩ = -k := by + nlinarith only [hdiffN, hdiffZ] + clear hdiffN hdiffZ parent + have he := child 1 (2*k) (by dsimp [C]; omega) + have hw := child (-1) (2*k) (by dsimp [C]; omega) + have hs := child 0 (2*k-1) (by dsimp [C]; omega) + have hc := child 0 (2*k) (by dsimp [C]; omega) + have hl : FourNeighborLaplacian f ⟨0,2*k⟩ = 0 := by + rw [lap] + norm_num only [zero_add, zero_sub] + have htop := (P5416T1DiamondAxialDifferences k hk2).2.2.2 + omega + exact ⟨fun _ => hl, fun h => False.elim (h marked)⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2SourceCertificates.lean b/LeanPool/ApollonianSuperharmonic/P5352T2SourceCertificates.lean new file mode 100644 index 0000000000..9847c8381e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5352T2SourceCertificates.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2Sources +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCentroid + +-- [TABLET NODE: P5352T2SourceCertificates] + +/-! +# P5352T2SourceCertificates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5352T2SourceCertificates (K : DiamondParameter) (hk : 1 < K.1) + (j : Fin 4) : + let S := P5352T2Sources K hk j + 0 < ((DiamondRecursiveQuadruple K) j).1 ∧ + TileCentroid S.1 = S.2.2.1 ∧ + ∃ h : PartialOdometer, + TileOdometer ((DiamondRecursiveQuadruple K) j) S.1 h ∧ + (h.domain : Set GaussianInt) = FootprintVertices S.1 ∧ + (∀ x, x ∈ h.domain → h.value x = S.2.1 x) ∧ + PartialOdometerSlope h = some S.2.2.2 := by +-- BODY + classical + have unit (z : GaussianInt) : + TileOdometer (1, 1 + 2 * z) ⟨{0}, 0⟩ (CurvatureOneOdometer z) := by + refine TileOdometer.unit z 0 _ _ rfl ?_ ?_ + · ext x + simp [CurvatureOneOdometer, FootprintVertices] + · refine ⟨0, 0, 0, ?_, ?_⟩ <;> simp [CurvatureOneOdometer] + have slope (z : GaussianInt) : PartialOdometerSlope (CurvatureOneOdometer z) = + some (((z.im : ℝ) / 2), ((z.im : ℝ) / 2)) := by + have hs : PartialOdometerSquares (CurvatureOneOdometer z) = {0} := by + change PartialOdometerSquares (CurvatureOneOdometer 0) = {0} + decide +kernel + unfold PartialOdometerSlope + rw [hs] + norm_num [CurvatureOneOdometer, Zsqrtd.ext_iff] + have unitDomain (z : GaussianInt) : + ((CurvatureOneOdometer z).domain : Set GaussianInt) = + FootprintVertices (⟨{0}, 0⟩ : ProtoTile) := by + ext x + simp [CurvatureOneOdometer, FootprintVertices] + fin_cases j + · obtain ⟨h, ho, hd, hf, _, hv, hp⟩ := DiamondTileOdometerRestriction K + refine ⟨?_, ?_, h, ho, hd.trans hf.symm, hv, hp⟩ + · change 0 < (2 * (K.1 : Int) * ((K.1 : Int) + 1)) + have hki : 0 < (K.1 : Int) := by omega + positivity + · exact P4194T1DiamondCentroid K.1 (by omega) + · refine ⟨by norm_num [DiamondRecursiveQuadruple], ?_, + CurvatureOneOdometer ⟨0, 1⟩, ?_, unitDomain _, fun _ _ => rfl, ?_⟩ + · norm_num [P5352T2Sources, TileCentroid] + · convert unit ⟨0, 1⟩ using 1 <;> + norm_num [P5352T2Sources, DiamondRecursiveQuadruple, Zsqrtd.ext_iff, + Zsqrtd.re_mul, Zsqrtd.im_mul] + · simpa [P5352T2Sources] using slope ⟨0, 1⟩ + · refine ⟨by norm_num [DiamondRecursiveQuadruple], ?_, + CurvatureOneOdometer 0, ?_, unitDomain _, fun _ _ => rfl, ?_⟩ + · norm_num [P5352T2Sources, TileCentroid] + · simpa [P5352T2Sources, DiamondRecursiveQuadruple] using unit 0 + · simpa [P5352T2Sources] using slope 0 + · let L : DiamondParameter := ⟨K.1 - 1, by omega⟩ + obtain ⟨h, ho, hd, hf, _, hv, hp⟩ := DiamondTileOdometerRestriction L + have circle : (DiamondRecursiveQuadruple L) 0 = (DiamondRecursiveQuadruple K) 3 := by + simp [L, DiamondRecursiveQuadruple] + omega + refine ⟨?_, ?_, h, ?_, hd.trans hf.symm, hv, ?_⟩ + · change 0 < (2 * ((K.1 - 1 : Nat) : Int) * (K.1 : Int)) + have hsub : 0 < K.1 - 1 := by omega + have hki : 0 < (K.1 : Int) := by omega + have hsi : 0 < ((K.1 - 1 : Nat) : Int) := by exact_mod_cast hsub + positivity + · simpa [P5352T2Sources, Nat.cast_sub (by omega : 1 ≤ K.1)] using + P4194T1DiamondCentroid (K.1 - 1) (by omega) + · simpa [P5352T2Sources, L, circle] using ho + · simpa [P5352T2Sources, L, Nat.cast_sub (by omega : 1 ≤ K.1)] using hp + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Sources.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Sources.lean new file mode 100644 index 0000000000..e5cbf47989 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Sources.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer + +-- [TABLET NODE: P5352T2Sources] + +/-! +# P5352T2Sources + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a diamond parameter $K$ with $k>1$, the four sources are tuples +$(V_j,F_j,C_j,P_j)$, consisting of a tile, an integer function, a centroid, +and a slope. Source $0$ is +$(D_k,G_k,(0,k),(k/2,-k/2))$. Sources $1$ and $2$ have tile +$\langle\{0\},0\rangle$, functions equal to the value functions of +$\operatorname{CurvatureOneOdometer}(i)$ and +$\operatorname{CurvatureOneOdometer}(0)$ respectively, centroid +$(1/2,1/2)$, and slopes $(1/2,1/2)$ and $(0,0)$ respectively. +Source $3$ is $(D_{k-1},G_{k-1},(0,k-1),((k-1)/2,-(k-1)/2))$. +Here $D_d=\operatorname{DiamondTile}(d)$ and +$G_d=\operatorname{DiamondOdometer}(d)$. +-/ +noncomputable def P5352T2Sources (K : DiamondParameter) (hk : 1 < K.1) + (j : Fin 4) : ProtoTile × IntegerLatticeFunction × (ℝ × ℝ) × (ℝ × ℝ) := +-- BODY + ![(DiamondTile K.1, DiamondOdometer K, + (0, (K.1 : ℝ)), ((K.1 : ℝ) / 2, -((K.1 : ℝ) / 2))), + (⟨{0}, 0⟩, (CurvatureOneOdometer ⟨0, 1⟩).value, + (1 / 2, 1 / 2), (1 / 2, 1 / 2)), + (⟨{0}, 0⟩, (CurvatureOneOdometer 0).value, + (1 / 2, 1 / 2), (0, 0)), + (DiamondTile (K.1 - 1), DiamondOdometer ⟨K.1 - 1, by omega⟩, + (0, (K.1 : ℝ) - 1), (((K.1 : ℝ) - 1) / 2, -(((K.1 : ℝ) - 1) / 2)))] j + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2VectorPlacements.lean b/LeanPool/ApollonianSuperharmonic/P5352T2VectorPlacements.lean new file mode 100644 index 0000000000..2be6af55aa --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5352T2VectorPlacements.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData +public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration + +-- [TABLET NODE: P5352T2VectorPlacements] + +/-! +# P5352T2VectorPlacements + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5352T2VectorPlacements (K : DiamondParameter) (hk : 1 < K.1) + (i : Fin 3) (s : Fin 4) : + let q := DiamondRecursiveQuadruple K + let A := P5352T2Sources K hk 0 + let D := P5352T2Sources K hk i.succ + let M := P5352T2PlacementData K.1 i + BandVectors.1 (q 0) (q i.succ) = M.1.1 ∧ + BandVectors.2 (q 0) (q i.succ) = M.1.2 ∧ + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt)^s.val * + (BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ))) = + (D.2.2.1.1 - A.2.2.1.1 + (M.2 s).1.re, + D.2.2.1.2 - A.2.2.1.2 + (M.2 s).1.im) ∧ + (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt)^s.val * + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ))) = + (D.2.2.2.1 - A.2.2.2.1 + (M.2 s).2.1.re, + D.2.2.2.2 - A.2.2.2.2 + (M.2 s).2.1.im) ∧ + (⟨0, 1⟩ : GaussianInt)^s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)) = (M.2 s).2.2 := by +-- BODY + obtain ⟨_, hq, hv0, hv1, hv2, ha0, ha1, ha2, _⟩ := DiamondCoordinateConfiguration K + have flip := (VectorRecursionLaws _ hq.1).2.2.2.2 hq + have hv (t : Fin 3) : BandVectors.1 ((DiamondRecursiveQuadruple K) t.succ) + ((DiamondRecursiveQuadruple K) 0) = + ![⟨(K.1 : Int)+1, (K.1 : Int)⟩, ⟨-(K.1 : Int)-1, (K.1 : Int)⟩, + ⟨0, -2*(K.1 : Int)⟩] t := by + fin_cases t + · exact hv0 + · exact hv1 + · exact hv2 + have ha (t : Fin 3) : BandVectors.2 ((DiamondRecursiveQuadruple K) t.succ) + ((DiamondRecursiveQuadruple K) 0) = + ![⟨(K.1 : Int), 1⟩, ⟨0, -(K.1 : Int)⟩, + ⟨-(K.1 : Int), (K.1 : Int)-1⟩] t := by + fin_cases t + · exact ha0 + · exact ha1 + · exact ha2 + dsimp only + rw [(flip i).1, (flip i).2, hv, ha] + fin_cases i <;> fin_cases s <;> + norm_num [P5352T2PlacementData, P5352T2Sources, GaussianRealPoint, + GaussianInt.toComplex_def, Zsqrtd.re_mul, Zsqrtd.im_mul, + Zsqrtd.ext_iff, Prod.ext_iff, pow_succ, Nat.even_iff] <;> + (repeat' constructor) <;> ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5416T1DiamondAxialDifferences.lean b/LeanPool/ApollonianSuperharmonic/P5416T1DiamondAxialDifferences.lean new file mode 100644 index 0000000000..be5bdd64b3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5416T1DiamondAxialDifferences.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic + +-- [TABLET NODE: P5416T1DiamondAxialDifferences] + +/-! +# P5416T1DiamondAxialDifferences + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5416T1DiamondAxialDifferences (k : Int) (hk : 2 ≤ k) : + let Q := P4207T1DiamondFormula + (Q ⟨1-k,k⟩ - Q ⟨-k,k⟩ = 1 ∧ + Q ⟨-k,k+1⟩ - Q ⟨-k,k⟩ = -k ∧ + Q ⟨-k,k-1⟩ - Q ⟨-k,k⟩ = k) ∧ + (Q ⟨1,0⟩ - Q ⟨0,0⟩ = 0 ∧ + Q ⟨-1,0⟩ - Q ⟨0,0⟩ = 0 ∧ + Q ⟨0,1⟩ - Q ⟨0,0⟩ = 0) ∧ + (Q ⟨k-1,k⟩ - Q ⟨k,k⟩ = 1-k ∧ + Q ⟨k,k+1⟩ - Q ⟨k,k⟩ = 0 ∧ + Q ⟨k,k-1⟩ - Q ⟨k,k⟩ = 0) ∧ + (Q ⟨1,2*k⟩ - Q ⟨0,2*k⟩ = k ∧ + Q ⟨-1,2*k⟩ - Q ⟨0,2*k⟩ = -k ∧ + Q ⟨0,2*k-1⟩ - Q ⟨0,2*k⟩ = k) := by +-- BODY + have sq0 (t : Int) : (2*t)^2/4 = t^2 := by + simpa using (P4207T1FloorArithmetic.1 0 t) + have sqm (t : Int) : (-1-2*t)^2/4 = t^2+t := by + have h := P4207T1FloorArithmetic.1 (-1) (-t) + rw [show -1+2*(-t) = -1-2*t by ring] at h + norm_num at h + nlinarith only [h] + have sqp (t : Int) : (1-2*t)^2/4 = t^2-t := by + have h := P4207T1FloorArithmetic.1 1 (-t) + rw [show 1+2*(-t) = 1-2*t by ring] at h + norm_num at h + nlinarith only [h] + have ht : k*(k-1)/2 - (k-1)*(k-2)/2 = k-1 := by + have he : k*(k-1) = (k-1)*(k-2)+(k-1)*2 := by ring + omega + have ha : (Int.natAbs (1-k) : Int) = k-1 := by + rw [Int.natCast_natAbs, abs_of_nonpos (by omega : 1-k ≤ 0)] + omega + have hb : (Int.natAbs (-k) : Int) = k := by + rw [Int.natCast_natAbs, abs_of_nonpos (by omega : -k ≤ 0)] + omega + have hc : (Int.natAbs (k-1) : Int) = k-1 := by + rw [Int.natCast_natAbs, abs_of_nonneg (by omega : 0 ≤ k-1)] + have hd : (Int.natAbs k : Int) = k := by + rw [Int.natCast_natAbs, abs_of_nonneg (by omega : 0 ≤ k)] + dsimp only + refine ⟨?_, ?_, ?_, ?_⟩ + · simp only [P4207T1DiamondFormula, ha, hb] + rw [show 1-k-k = 1-2*k by ring, show k-1-1 = k-2 by ring, + show -k-k = -(2*k) by ring, show -k-(k+1) = -1-2*k by ring, + show -k-(k-1) = 1-2*k by ring, neg_sq, sq0, sqp, sqm] + omega + · norm_num [P4207T1DiamondFormula] + · norm_num [P4207T1DiamondFormula, hc, hd] + rw [show k-1-1 = k-2 by ring] + omega + · norm_num [P4207T1DiamondFormula] + rw [sqp, sqm, sq0] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5416T1SecondUnitGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5416T1SecondUnitGeometry.lean new file mode 100644 index 0000000000..3a7380eba9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5416T1SecondUnitGeometry.lean @@ -0,0 +1,128 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData +public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows + +-- [TABLET NODE: P5416T1SecondUnitGeometry] + +/-! +# P5416T1SecondUnitGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5416T1SecondUnitGeometry (K : DiamondParameter) (hk : 1 < K.1) + (s : Fin 4) (z : GaussianInt) : + let d := ((P5352T2PlacementData K.1 1).2 s).1 + let r := ((P5352T2PlacementData K.1 1).2 s).2.2 + z ∈ FootprintVertices (DiamondTile K.1) → + z - d ∈ FootprintVertices (P5352T2Sources K hk 2).1 → + (∀ y, y = z ∨ y = z + 1 ∨ y = z - 1 ∨ + y = z + ⟨0, 1⟩ ∨ y = z - ⟨0, 1⟩ → + y ∈ FootprintVertices (DiamondTile K.1) ∨ + y - d ∈ FootprintVertices (P5352T2Sources K hk 2).1) → + z = ![⟨-(K.1 : Int), (K.1 : Int)⟩, ⟨0, 0⟩, + ⟨(K.1 : Int), (K.1 : Int)⟩, ⟨0, 2*(K.1 : Int)⟩] s ∧ + (z - r ∈ FootprintVertices (DiamondTile K.1) ↔ s = 1 ∨ s = 3) := by +-- BODY + classical + let k : Int := K.1 + have hk2 : 2 ≤ k := by dsimp [k]; omega + let C (p q : Int) : Prop := + 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + have cmem (x : GaussianInt) : + x ∈ FootprintVertices (DiamondTile K.1) ↔ C x.re x.im := + (P5352T2DomainRows K x).1 + have umem (x : GaussianInt) : + x ∈ FootprintVertices (P5352T2Sources K hk 2).1 ↔ U x.re x.im := by + simp only [P5352T2Sources, Matrix.cons_val_two] + simp [FootprintVertices] + simp only [Zsqrtd.ext_iff, Zsqrtd.re_zero, Zsqrtd.im_zero, + Zsqrtd.re_one, Zsqrtd.im_one, Zsqrtd.re_add, Zsqrtd.im_add] + dsimp [U] + omega + dsimp only + intro hzA hzP hcov + have center := (cmem z).mp hzA + have unitCenter := (umem _).mp hzP + let d := ((P5352T2PlacementData K.1 1).2 s).1 + have covered (p q : Int) + (h : (⟨p,q⟩ : GaussianInt) = z ∨ ⟨p,q⟩ = z+1 ∨ ⟨p,q⟩ = z-1 ∨ + ⟨p,q⟩ = z+⟨0,1⟩ ∨ ⟨p,q⟩ = z-⟨0,1⟩) : + C p q ∨ U (p-d.re) (q-d.im) := by + rcases hcov _ h with h | h + · exact Or.inl ((cmem _).mp h) + · exact Or.inr ((umem _).mp h) + clear hzA hzP hcov umem + fin_cases s + · have hs := covered z.re (z.im-1) + (Or.inr (Or.inr (Or.inr (Or.inr (by ext <;> simp))))) + change U (z.re-(-k-1)) (z.im-(k-1)) at unitCenter + change C z.re (z.im-1) ∨ U (z.re-(-k-1)) (z.im-1-(k-1)) at hs + have hz : z = ⟨-k,k⟩ := by + dsimp [C, U] at center unitCenter hs + ext <;> dsimp <;> omega + subst z + refine ⟨rfl, ?_⟩ + rw [cmem] + change C (-k-(-k)) (k-(-k-1)) ↔ (0 : Fin 4) = 1 ∨ (0 : Fin 4) = 3 + norm_num + dsimp [C] + omega + · have he := covered (z.re+1) z.im (Or.inr (Or.inl (by ext <;> simp))) + change U (z.re-0) (z.im-(-1)) at unitCenter + change C (z.re+1) z.im ∨ U (z.re+1-0) (z.im-(-1)) at he + have hz : z = ⟨0,0⟩ := by + dsimp [C, U] at center unitCenter he + ext <;> dsimp <;> omega + subst z + refine ⟨rfl, ?_⟩ + rw [cmem] + change C (0-(-k)) (0-(-k-1)) ↔ (1 : Fin 4) = 1 ∨ (1 : Fin 4) = 3 + norm_num + dsimp [C] + omega + · have hn := covered z.re (z.im+1) + (Or.inr (Or.inr (Or.inr (Or.inl (by ext <;> simp))))) + change U (z.re-k) (z.im-k) at unitCenter + change C z.re (z.im+1) ∨ U (z.re-k) (z.im+1-k) at hn + have hz : z = ⟨k,k⟩ := by + dsimp [C, U] at center unitCenter hn + ext <;> dsimp <;> omega + subst z + refine ⟨rfl, ?_⟩ + rw [cmem] + change C (k-k) (k-(k+1)) ↔ (2 : Fin 4) = 1 ∨ (2 : Fin 4) = 3 + norm_num + dsimp [C] + omega + · have hw := covered (z.re-1) z.im + (Or.inr (Or.inr (Or.inl (by ext <;> simp)))) + change U (z.re-(-1)) (z.im-2*k) at unitCenter + change C (z.re-1) z.im ∨ U (z.re-1-(-1)) (z.im-2*k) at hw + have hz : z = ⟨0,2*k⟩ := by + dsimp [C, U] at center unitCenter hw + ext <;> dsimp <;> omega + subst z + refine ⟨rfl, ?_⟩ + rw [cmem] + change C (0-k) (2*k-(k+1)) ↔ (3 : Fin 4) = 1 ∨ (3 : Fin 4) = 3 + norm_num + dsimp [C] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5432T1EdgeLedger.lean b/LeanPool/ApollonianSuperharmonic/P5432T1EdgeLedger.lean new file mode 100644 index 0000000000..bdbc710aec --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5432T1EdgeLedger.lean @@ -0,0 +1,175 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import Mathlib.Algebra.Group.Int.Even + +-- [TABLET NODE: P5432T1EdgeLedger] + +/-! +# P5432T1EdgeLedger + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5432T1EdgeLedger (K : DiamondParameter) (D : Finset GaussianInt) + (hD : ∀ x, x ∈ D ↔ x ∈ DiamondVertexDomains K true) : + let edge := fun x y : GaussianInt => + x ∈ D ∧ y ∈ D ∧ FourNeighborAdjacent x y ∧ + (x.re.natAbs < y.re.natAbs ∨ + (x.re = y.re ∧ ¬ Even (x.re + x.im) ∧ Even (y.re + y.im))) + let rank := fun x : GaussianInt => + 2 * x.re.natAbs + if Even (x.re + x.im) then 1 else 0 + (∀ x y, edge x y → x ∈ D ∧ y ∈ D ∧ FourNeighborAdjacent x y) ∧ + (∀ x ∈ D, ∀ y ∈ D, FourNeighborAdjacent x y → + (edge x y ∧ ¬ edge y x) ∨ (edge y x ∧ ¬ edge x y)) ∧ + (∀ x y, edge x y → rank x < rank y) ∧ + (∀ x ∈ D, + ((D.filter fun y => @decide (edge y x) (Classical.propDecidable _)).card : Int) = + if x.re = 0 then (if Even (x.re + x.im) then 2 else 0) + else (if Even (x.re + x.im) then 3 else 1)) := by +-- BODY + classical + let edge := fun x y : GaussianInt => + x ∈ D ∧ y ∈ D ∧ FourNeighborAdjacent x y ∧ + (x.re.natAbs < y.re.natAbs ∨ + (x.re = y.re ∧ ¬ Even (x.re+x.im) ∧ Even (y.re+y.im))) + let rank := fun x : GaussianInt => + 2 * x.re.natAbs + if Even (x.re+x.im) then 1 else 0 + change (∀ x y, edge x y → _) ∧ (∀ x ∈ D, ∀ y ∈ D, _ → _) ∧ + (∀ x y, edge x y → rank x < rank y) ∧ _ + have increasing : ∀ x y, edge x y → rank x < rank y := by + intro x y he + rcases he.2.2.2 with h | ⟨heq, ho, he⟩ + · dsimp [rank] + split_ifs <;> omega + · dsimp only [rank] + rw [ite_eq_right ho, ite_eq_left he, heq] + omega + have symm (x y : GaussianInt) (h : FourNeighborAdjacent x y) : + FourNeighborAdjacent y x := by + rcases h with rfl | rfl | rfl | rfl + · exact Or.inr (Or.inl (by abel)) + · exact Or.inl (by abel) + · exact Or.inr (Or.inr (Or.inr (by abel))) + · exact Or.inr (Or.inr (Or.inl (by abel))) + refine ⟨(fun x y he => ⟨he.1, he.2.1, he.2.2.1⟩), ?_, increasing, ?_⟩ + · intro x hx y hy ha + have choice : + (x.re.natAbs < y.re.natAbs ∨ + (x.re = y.re ∧ ¬ Even (x.re+x.im) ∧ Even (y.re+y.im))) ∨ + (y.re.natAbs < x.re.natAbs ∨ + (y.re = x.re ∧ ¬ Even (y.re+y.im) ∧ Even (x.re+x.im))) := by + have ax := Int.natCast_natAbs x.re + have ay := Int.natCast_natAbs y.re + simp only [Int.even_iff] + rcases ha with rfl | rfl | rfl | rfl <;> + norm_num at ay ⊢ <;> + simp only [abs_eq_max_neg] at ax ay <;> omega + rcases choice with h | h + · have he : edge x y := ⟨hx, hy, ha, h⟩ + exact Or.inl ⟨he, fun hr => (Nat.lt_asymm (increasing x y he)) + (increasing y x hr)⟩ + · have he : edge y x := ⟨hy, hx, symm x y ha, h⟩ + exact Or.inr ⟨he, fun hr => (Nat.lt_asymm (increasing y x he)) + (increasing x y hr)⟩ + · intro x hx + have inner (z : GaussianInt) : z ∈ D ↔ + |z.re| + |z.im - (K.1 : Int)| ≤ (K.1 : Int) - 1 := by + rw [hD] + change Int.natAbs z.re + Int.natAbs (z.im - (K.1 : Int)) ≤ K.1 - 1 ↔ _ + have hk := K.2 + have ha := Int.natCast_natAbs z.re + have hb := Int.natCast_natAbs (z.im - (K.1 : Int)) + omega + have hxI := (inner x).mp hx + have slack (he : Even (x.re+x.im)) : + |x.re| + |x.im - (K.1 : Int)| ≤ (K.1 : Int) - 2 := by + have hp := Int.even_iff.mp he + simp only [abs_eq_max_neg] at hxI ⊢ + omega + have left_mem (hp : 0 < x.re) : x-1 ∈ D := by + rw [inner] + norm_num + simp only [abs_eq_max_neg] at hxI ⊢ + omega + have right_mem (hp : x.re < 0) : x+1 ∈ D := by + rw [inner] + norm_num + simp only [abs_eq_max_neg] at hxI ⊢ + omega + have vertical_mem (he : Even (x.re+x.im)) : + x+⟨0, 1⟩ ∈ D ∧ x-⟨0, 1⟩ ∈ D := by + have hs := slack he + constructor <;> rw [inner] <;> norm_num <;> + simp only [abs_eq_max_neg] at hs ⊢ <;> omega + have character (y : GaussianInt) (ha : FourNeighborAdjacent y x) : + (y.re.natAbs < x.re.natAbs ∨ + (y.re = x.re ∧ ¬ Even (y.re+y.im) ∧ Even (x.re+x.im))) ↔ + (0 < x.re ∧ y = x-1) ∨ (x.re < 0 ∧ y = x+1) ∨ + (Even (x.re+x.im) ∧ (y = x+⟨0, 1⟩ ∨ y = x-⟨0, 1⟩)) := by + have ax := Int.natCast_natAbs x.re + have ay := Int.natCast_natAbs y.re + rcases symm y x ha with rfl | rfl | rfl | rfl <;> + simp only [Int.even_iff, Zsqrtd.ext_iff] <;> + norm_num at ay ⊢ <;> + simp only [abs_eq_max_neg] at ax ay <;> omega + have incoming (y : GaussianInt) : edge y x ↔ + (0 < x.re ∧ y = x-1) ∨ (x.re < 0 ∧ y = x+1) ∨ + (Even (x.re+x.im) ∧ (y = x+⟨0, 1⟩ ∨ y = x-⟨0, 1⟩)) := by + constructor + · intro he + exact (character y he.2.2.1).mp he.2.2.2 + · intro hi + have hy : y ∈ D := by + rcases hi with ⟨hp, rfl⟩ | ⟨hp, rfl⟩ | ⟨he, rfl | rfl⟩ + · exact left_mem hp + · exact right_mem hp + · exact (vertical_mem he).1 + · exact (vertical_mem he).2 + have ha : FourNeighborAdjacent y x := by + apply symm x y + rcases hi with ⟨_, rfl⟩ | ⟨_, rfl⟩ | ⟨_, rfl | rfl⟩ + · exact Or.inr (Or.inl rfl) + · exact Or.inl rfl + · exact Or.inr (Or.inr (Or.inl rfl)) + · exact Or.inr (Or.inr (Or.inr rfl)) + exact ⟨hy, hx, ha, (character y ha).mpr hi⟩ + have filter_eq : + D.filter (fun y => @decide (edge y x) (Classical.propDecidable _)) = + (if 0 < x.re then {x-1} else if x.re < 0 then {x+1} else ∅) ∪ + (if Even (x.re+x.im) then {x+⟨0, 1⟩, x-⟨0, 1⟩} else ∅) := by + ext y + simp only [Finset.mem_filter, decide_eq_true_eq] + have elim : (y ∈ D ∧ edge y x) ↔ edge y x := + ⟨And.right, fun he => ⟨he.1, he⟩⟩ + rw [elim, incoming] + by_cases hp : 0 < x.re <;> by_cases hn : x.re < 0 <;> + by_cases he : Even (x.re+x.im) <;> + simp [hp, hn, he, or_left_comm] <;> omega + have n1 : x+⟨0, 1⟩ ≠ x-1 := by simp [Zsqrtd.ext_iff] + have n2 : x+⟨0, 1⟩ ≠ x+1 := by simp [Zsqrtd.ext_iff] + have n3 : x+⟨0, 1⟩ ≠ x-⟨0, 1⟩ := by simp [Zsqrtd.ext_iff]; omega + have n4 : x-1 ≠ x-⟨0, 1⟩ := by simp [Zsqrtd.ext_iff] + have n5 : x+1 ≠ x-⟨0, 1⟩ := by simp [Zsqrtd.ext_iff] + rw [filter_eq] + by_cases hp : 0 < x.re <;> by_cases hn : x.re < 0 <;> + by_cases he : Even (x.re+x.im) + all_goals + simp only [hp, hn, he, ↓reduceIte] + norm_num [n1, n2, n3, n4, n5] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5432T1Interior.lean b/LeanPool/ApollonianSuperharmonic/P5432T1Interior.lean new file mode 100644 index 0000000000..1849828ef0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5432T1Interior.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence +public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains + +-- [TABLET NODE: P5432T1Interior] + +/-! +# P5432T1Interior + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5432T1Interior (K : DiamondParameter) : + (∀ z, (z ∈ FootprintVertices (DiamondTile K.1) ∧ + z ∉ BoundaryFootprintVertices (DiamondTile K.1)) ↔ + z ∈ DiamondVertexDomains K true) ∧ + (∀ z, z ∈ DiamondVertexDomains K true → + ∀ d ∈ ({0, 1, -1, ⟨0, 1⟩, -⟨0, 1⟩} : Finset GaussianInt), + z + d ∈ DiamondVertexDomains K false) := by +-- BODY + classical + have hk := K.2 + have inner (z : GaussianInt) : z ∈ DiamondVertexDomains K true ↔ + |z.re| + |z.im - (K.1 : Int)| ≤ (K.1 : Int) - 1 := by + change Int.natAbs z.re + Int.natAbs (z.im - (K.1 : Int)) ≤ K.1 - 1 ↔ _ + have ha := Int.natCast_natAbs z.re + have hb := Int.natCast_natAbs (z.im - (K.1 : Int)) + omega + constructor + · intro z + rw [(P4194T1DiamondVertexIncidence K.1 hk z).1, + (P4194T1DiamondVertexIncidence K.1 hk z).2] + have all_iff : ((∃ j : Fin 4, + LatticeVertexIncidentCell z j ∈ DiamondCellDomain K.1) ∧ + ¬ ((∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ DiamondCellDomain K.1) ∧ + ∃ j : Fin 4, LatticeVertexIncidentCell z j ∉ DiamondCellDomain K.1)) ↔ + ∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ DiamondCellDomain K.1 := by + constructor + · rintro ⟨hex, hn⟩ j + by_contra hj + exact hn ⟨hex, j, hj⟩ + · intro h + exact ⟨⟨0, h 0⟩, fun ⟨_, j, hj⟩ => hj (h j)⟩ + rw [all_iff, (P4194T1DiamondCellRows K.1 z).2, inner] + simp only [abs_eq_max_neg] + omega + · intro z hz d hd + rw [inner] at hz + have bound (w : GaussianInt) + (hw : |w.re| + |w.im - (K.1 : Int)| ≤ (K.1 : Int)) : + w ∈ DiamondVertexDomains K false := by + change max (Int.natAbs w.re) + (max (Int.natAbs (w.im - (K.1 : Int))) + (Int.natAbs w.re + Int.natAbs (w.im - (K.1 : Int)) - 1)) ≤ K.1 + have ha := Int.natCast_natAbs w.re + have hb := Int.natCast_natAbs (w.im - (K.1 : Int)) + simp only [max_le_iff] + have hapos := abs_nonneg w.re + have hbpos := abs_nonneg (w.im - (K.1 : Int)) + omega + apply bound + simp only [Finset.mem_insert, Finset.mem_singleton] at hd + rcases hd with rfl | rfl | rfl | rfl | rfl <;> + norm_num <;> + simp only [abs_eq_max_neg] at hz ⊢ <;> omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5432T1Normalization.lean b/LeanPool/ApollonianSuperharmonic/P5432T1Normalization.lean new file mode 100644 index 0000000000..0c10c1540d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5432T1Normalization.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5432T1Interior +public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian + +-- [TABLET NODE: P5432T1Normalization] + +/-! +# P5432T1Normalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5432T1Normalization (K : DiamondParameter) + (T : ProtoTile) (h : PartialOdometer) (g : IntegerLatticeFunction) + (hodo : TileOdometer ((DiamondRecursiveQuadruple K) 0) T h) + (hdom : (h.domain : Set GaussianInt) = FootprintVertices T) + (hext : GlobalOdometerExtends g h) : + ∃ u : GaussianInt, + (∀ x, (x ∈ h.domain ∧ x ∉ BoundaryFootprintVertices T) ↔ + x - u ∈ DiamondVertexDomains K true) ∧ + (∀ x, x - u ∈ DiamondVertexDomains K true → + FourNeighborLaplacian g x = + FourNeighborLaplacian (DiamondOdometer K) (x - u)) := by +-- BODY + classical + obtain ⟨hK, hKodo, hKdom, _, _, hKval, _⟩ := DiamondTileOdometerRestriction K + have hpos : 0 < ((DiamondRecursiveQuadruple K) 0).1 := by + change 0 < ((2 * K.1 * (K.1 + 1) : Nat) : Int) + have hk := K.2 + positivity + obtain ⟨u, ⟨hcells, hanchor, a, b, hshift, hval⟩, _⟩ := + TileOdometerTranslationUniqueness _ T (DiamondTile K.1) h hK + hpos hodo hKodo + obtain ⟨c, hc⟩ := hext + have obs := ProtoTileObservableExtensionality T + (TileTranslation (DiamondTile K.1) u) hcells hanchor + obtain ⟨_, _, _, _, _, hfoot, _, hboundary, _⟩ := + TileTranslationFormulas (DiamondTile K.1) u + have image (S : Set GaussianInt) (x : GaussianInt) : + x ∈ GaussianTranslation u '' S ↔ x-u ∈ S := by + constructor + · rintro ⟨y, hy, rfl⟩ + simpa [GaussianTranslation] using hy + · intro hx + exact ⟨x-u, hx, by simp [GaussianTranslation]⟩ + have interior (x : GaussianInt) : + (x ∈ h.domain ∧ x ∉ BoundaryFootprintVertices T) ↔ + x-u ∈ DiamondVertexDomains K true := by + have hm : x ∈ h.domain ↔ x ∈ FootprintVertices T := by + change x ∈ (h.domain : Set GaussianInt) ↔ _ + rw [hdom] + rw [hm, obs.1, obs.2.1, hfoot, hboundary, image, image] + exact (P5432T1Interior K).1 (x-u) + refine ⟨u, interior, ?_⟩ + intro x hx + have eval (d : GaussianInt) + (hd : d ∈ ({0, 1, -1, ⟨0, 1⟩, -⟨0, 1⟩} : Finset GaussianInt)) : + g (x+d) = DiamondOdometer K (x-u+d) + + a.re * (x+d).re + a.im * (x+d).im + b + c := by + have hz : x-u+d ∈ hK.domain := by + change x-u+d ∈ (hK.domain : Set GaussianInt) + rw [hKdom] + exact (P5432T1Interior K).2 (x-u) hx d hd + have he : x+d-u = x-u+d := by abel + have hy : x+d ∈ h.domain := (hshift _).mpr (he.symm ▸ hz) + rw [hc _ hy, hval _ hy, he, hKval _ hz] + have e0 : g x = DiamondOdometer K (x-u) + + a.re * x.re + a.im * x.im + b + c := by + simpa using eval 0 (by simp) + simp only [FourNeighborLaplacian, sub_eq_add_neg] + rw [eval 1 (by simp), eval (-1) (by simp), + eval ⟨0, 1⟩ (by simp), eval (-⟨0, 1⟩) (by simp), e0] + simp only [sub_eq_add_neg, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_neg, Zsqrtd.im_neg] + norm_num + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5435T1Cocycle.lean b/LeanPool/ApollonianSuperharmonic/P5435T1Cocycle.lean new file mode 100644 index 0000000000..160ccb71f8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5435T1Cocycle.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalLattice +public import LeanPool.ApollonianSuperharmonic.DiamondOdometer +public import LeanPool.ApollonianSuperharmonic.DiamondPeakMatrix +public import Mathlib.Tactic + +-- [TABLET NODE: P5435T1Cocycle] + +/-! +# P5435T1Cocycle + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5435T1Cocycle (K : DiamondParameter) : + ∀ v, v ∈ DiamondExceptionalLattice K → ∃ a : GaussianInt, + Matrix.mulVec (DiamondPeakMatrix K) + ![(v.re : Real), (v.im : Real)] = + ![(a.re : Real), (a.im : Real)] ∧ + ∀ x, DiamondOdometer K (x + v) = DiamondOdometer K x + + x.re * a.re + x.im * a.im + DiamondOdometer K v := by +-- BODY + classical + let g := DiamondOdometer K + let k : Int := K.1 + have hk : (k : Real) ≠ 0 := by + have h : 0 < k := by dsimp [k]; exact_mod_cast K.2 + exact_mod_cast ne_of_gt h + have hk1 : (k : Real) + 1 ≠ 0 := by + have h : 0 < k := by dsimp [k]; exact_mod_cast K.2 + have h' : (0 : Real) < k := by exact_mod_cast h + linarith + obtain ⟨ha, hb, _, hf⟩ := (Classical.choose_spec (DiamondOdometerExistsUnique K)).1 + change (∀ x, g (x + ⟨0, -(2 * K.1 : Int)⟩) = g x + + (-(K.1 : Int))*x.re + ((K.1 : Int)-1)*x.im - + (K.1 : Int)*((K.1 : Int)-2)) at ha + change (∀ x, g (x + ⟨(K.1+1 : Int), (K.1 : Int)⟩) = g x + + (K.1 : Int)*x.re + x.im + (K.1 : Int)*(K.1+1)/2) at hb + have hF : ∀ x, x ∈ DiamondVertexDomains K false → + g x = (Int.natAbs x.re : Int)*((Int.natAbs x.re : Int)-1)/2 - + (x.re-x.im)^2/4 := hf + have hzero : g 0 = 0 := by + have hmem : (0 : GaussianInt) ∈ DiamondVertexDomains K false := by + change max (Int.natAbs (0 : GaussianInt).re) + (max (Int.natAbs ((0 : GaussianInt).im - (K.1 : Int))) + (Int.natAbs (0 : GaussianInt).re + + Int.natAbs ((0 : GaussianInt).im - (K.1 : Int)) - 1)) ≤ K.1 + norm_num + have h := hF 0 hmem + norm_num at h + exact h + let B (v a : GaussianInt) : Prop := + Matrix.mulVec (DiamondPeakMatrix K) ![(v.re : Real), (v.im : Real)] = + ![(a.re : Real), (a.im : Real)] + let H : AddSubgroup GaussianInt := + { carrier := {v | ∃ a : GaussianInt, B v a ∧ + ∀ x, g (x+v) = g x + x.re*a.re + x.im*a.im + g v} + zero_mem' := by + refine ⟨0, ?_, ?_⟩ + · dsimp [B] + ext i; fin_cases i <;> simp [Matrix.mulVec, dotProduct] + · intro x; simp [hzero] + add_mem' := by + rintro u v ⟨a, hMa, hua⟩ ⟨b, hMb, hvb⟩ + refine ⟨a+b, ?_, ?_⟩ + · dsimp [B] at hMa hMb ⊢ + have he : ![((u+v).re : Real), ((u+v).im : Real)] = + ![(u.re : Real), (u.im : Real)] + ![(v.re : Real), (v.im : Real)] := by + ext i; fin_cases i <;> simp + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at he + rw [he, Matrix.mulVec_add, hMa, hMb] + ext i; fin_cases i <;> simp + · intro x + have h1 := hvb (x+u) + have h2 := hua x + have h3 := hvb u + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at h1 ⊢ + rw [add_assoc] at h1 + linear_combination h1 + h2 - h3 + neg_mem' := by + rintro v ⟨a, hMa, hva⟩ + refine ⟨-a, ?_, ?_⟩ + · dsimp [B] at hMa ⊢ + have he : ![((-v).re : Real), ((-v).im : Real)] = + - ![(v.re : Real), (v.im : Real)] := by + ext i; fin_cases i <;> simp + simp only [Zsqrtd.re_neg, Zsqrtd.im_neg] at he + rw [he, Matrix.mulVec_neg, hMa] + ext i; fin_cases i <;> simp + · intro x + have h1 := hva (x-v) + have h2 := hva (-v) + simp only [sub_add_cancel, neg_add_cancel, Zsqrtd.re_sub, + Zsqrtd.im_sub, Zsqrtd.re_neg, Zsqrtd.im_neg, hzero] at h1 h2 + simp only [Zsqrtd.re_neg, Zsqrtd.im_neg] + rw [show x + -v = x-v by abel] + linear_combination -h1 + h2 } + have hgen : {v : GaussianInt | v = ⟨0, -(2 * K.1 : Int)⟩ ∨ + v = ⟨(K.1 + 1 : Int), (K.1 : Int)⟩} ⊆ H := by + intro v hv + rcases hv with rfl | rfl + · refine ⟨⟨-k, k-1⟩, ?_, ?_⟩ + · dsimp [B, DiamondPeakMatrix] + ext i; fin_cases i <;> + simp [Matrix.mulVec, dotProduct, k] + all_goals + try field_simp [show (K.1 : Real) ≠ 0 by simpa [k] using hk, + show (K.1 : Real)+1 ≠ 0 by simpa [k] using hk1] + ring + · intro x + have h := ha x + have h0 := ha 0 + simp only [Zsqrtd.re_zero, Zsqrtd.im_zero, zero_add, mul_zero, add_zero, + hzero] at h0 + change g _ = g x + x.re*(-k) + x.im*(k-1) + g _ + rw [h0] + change g _ = g x + (-k)*x.re + (k-1)*x.im - k*(k-2) at h + linarith + · refine ⟨⟨k, 1⟩, ?_, ?_⟩ + · dsimp [B, DiamondPeakMatrix] + ext i; fin_cases i <;> + simp [Matrix.mulVec, dotProduct, k] + all_goals + try field_simp [show (K.1 : Real) ≠ 0 by simpa [k] using hk, + show (K.1 : Real)+1 ≠ 0 by simpa [k] using hk1] + ring + · intro x + have h := hb x + have h0 := hb 0 + simp only [Zsqrtd.re_zero, Zsqrtd.im_zero, zero_add, mul_zero, add_zero, + hzero] at h0 + change g _ = g x + x.re*k + x.im*1 + g _ + rw [h0] + change g _ = g x + k*x.re + x.im + k*(k+1)/2 at h + linarith + intro v hv + exact ((AddSubgroup.closure_le H).mpr hgen) hv + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5435T1PeriodGap.lean b/LeanPool/ApollonianSuperharmonic/P5435T1PeriodGap.lean new file mode 100644 index 0000000000..ac0947c496 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5435T1PeriodGap.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalLattice +public import Mathlib.Tactic + +-- [TABLET NODE: P5435T1PeriodGap] + +/-! +# P5435T1PeriodGap + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5435T1PeriodGap (K : DiamondParameter) : + ∀ v ∈ DiamondExceptionalLattice K, v ≠ 0 → + 2 * (K.1 : Int) ≤ |v.re| + |v.im| := by +-- BODY + let k : Int := K.1 + have hk : 0 < k := by dsimp [k]; exact_mod_cast K.2 + let H : AddSubgroup GaussianInt := + { carrier := {v | ∃ m n : Int, v.re = n*(k+1) ∧ v.im = k*(n-2*m)} + zero_mem' := ⟨0, 0, by simp, by simp⟩ + add_mem' := by + rintro u v ⟨m, n, hr, hi⟩ ⟨m', n', hr', hi'⟩ + refine ⟨m+m', n+n', ?_, ?_⟩ + · simp only [Zsqrtd.re_add, hr, hr']; ring + · simp only [Zsqrtd.im_add, hi, hi']; ring + neg_mem' := by + rintro v ⟨m, n, hr, hi⟩ + refine ⟨-m, -n, ?_, ?_⟩ + · simp only [Zsqrtd.re_neg, hr]; ring + · simp only [Zsqrtd.im_neg, hi]; ring } + have hgen : {v : GaussianInt | v = ⟨0, -(2 * K.1 : Int)⟩ ∨ + v = ⟨(K.1 + 1 : Int), (K.1 : Int)⟩} ⊆ H := by + intro v hv + rcases hv with rfl | rfl + · refine ⟨1, 0, by simp, ?_⟩ + change -(2*k) = k*(0-2*1) + ring + · exact ⟨0, 1, by simp [k], by simp [k]⟩ + intro v hv hne + obtain ⟨m, n, hr, hi⟩ := ((AddSubgroup.closure_le H).mpr hgen) hv + change 2*k ≤ |v.re| + |v.im| + rw [hr, hi, abs_mul, abs_mul, abs_of_pos hk, abs_of_pos (by omega : 0 < k+1)] + by_cases hn : n=0 + · subst n + have hm : m ≠ 0 := by + intro hm + apply hne + ext <;> simp_all + have hab : 1 ≤ |m| := by have h := abs_pos.mpr hm; omega + rw [zero_sub, abs_neg, abs_mul] + norm_num + nlinarith + · have han : 1 ≤ |n| := by have h := abs_pos.mpr hn; omega + by_cases hlarge : 2 ≤ |n| + · have hnonneg := abs_nonneg (n-2*m) + nlinarith + · have hone : n=1 ∨ n = -1 := by + simp only [abs_eq_max_neg] at han hlarge + omega + have hodd : n-2*m ≠ 0 := by rcases hone with rfl | rfl <;> omega + have ham : 1 ≤ |n-2*m| := by have h := abs_pos.mpr hodd; omega + nlinarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5435T1ShellPaths.lean b/LeanPool/ApollonianSuperharmonic/P5435T1ShellPaths.lean new file mode 100644 index 0000000000..c76f523de4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5435T1ShellPaths.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import Mathlib.Data.List.Chain +public import Mathlib.Tactic + +-- [TABLET NODE: P5435T1ShellPaths] + +/-! +# P5435T1ShellPaths + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5435T1ShellPaths (K : DiamondParameter) : + let k : Int := K.1 + let S := DiamondVertexDomains K false \ DiamondVertexDomains K true + FourNeighborConnected S ∧ + ((⟨0, 0⟩ : GaussianInt) ∈ S ∧ ⟨0, 2 * k⟩ ∈ S) ∧ + ((⟨k, k + 1⟩ : GaussianInt) ∈ S ∧ ⟨-1, 1⟩ ∈ S) := by +-- BODY + classical + dsimp only + let k : Int := K.1 + let S := DiamondVertexDomains K false \ DiamondVertexDomains K true + have hk : 0 < K.1 := K.2 + have bounds (x : GaussianInt) : x ∈ S ↔ + x.re.natAbs ≤ K.1 ∧ (x.im-k).natAbs ≤ K.1 ∧ + K.1 ≤ x.re.natAbs + (x.im-k).natAbs ∧ + x.re.natAbs + (x.im-k).natAbs ≤ K.1+1 := by + change (max x.re.natAbs (max (x.im-k).natAbs + (x.re.natAbs + (x.im-k).natAbs - 1)) ≤ K.1 ∧ + ¬ x.re.natAbs + (x.im-k).natAbs ≤ K.1-1) ↔ _ + rw [max_le_iff, max_le_iff] + omega + let Q := fun x y : GaussianInt => x ∈ S ∧ y ∈ S ∧ FourNeighborAdjacent x y + have reverse {x y} (h : Relation.ReflTransGen Q x y) : + Relation.ReflTransGen Q y x := by + induction h with + | refl => exact .refl + | @tail u z h e ih => + have hs : FourNeighborAdjacent z u := by + rcases e.2.2 with h | h | h | h <;> rw [h] <;> + simp [FourNeighborAdjacent, add_assoc, add_comm, add_left_comm] + exact (Relation.ReflTransGen.single ⟨e.2.1, e.1, hs⟩).trans ih + let pt (sx sy : Int) (p r : Nat) : GaussianInt := ⟨sx*p, k+sy*r⟩ + have pmem (sx sy : Int) (hsx : sx=1 ∨ sx = -1) (hsy : sy=1 ∨ sy = -1) + (p r : Nat) (hp : p ≤ K.1) (hr : r ≤ K.1) + (hlo : K.1 ≤ p+r) (hhi : p+r ≤ K.1+1) : pt sx sy p r ∈ S := by + rw [bounds] + have he : (pt sx sy p r).re.natAbs = p := by + rcases hsx with rfl | rfl <;> simp [pt] + have hi : ((pt sx sy p r).im-k).natAbs = r := by + rcases hsy with rfl | rfl <;> simp [pt] + rw [he, hi] + exact ⟨hp, hr, hlo, hhi⟩ + have horiz (sx sy : Int) (hsx : sx=1 ∨ sx = -1) (p r : Nat) : + FourNeighborAdjacent (pt sx sy (p+1) r) (pt sx sy p r) := by + rcases hsx with rfl | rfl + · apply Or.inr; apply Or.inl + ext <;> simp [pt] + · apply Or.inl + ext <;> simp [pt] + have vert (sx sy : Int) (hsy : sy=1 ∨ sy = -1) (p r : Nat) : + FourNeighborAdjacent (pt sx sy p r) (pt sx sy p (r+1)) := by + rcases hsy with rfl | rfl + · apply Or.inr; apply Or.inr; apply Or.inl + ext <;> simp [pt]; ring + · apply Or.inr; apply Or.inr; apply Or.inr + ext <;> simp [pt]; ring + have quadrant (sx sy : Int) (hsx : sx=1 ∨ sx = -1) (hsy : sy=1 ∨ sy = -1) : + ∀ p r : Nat, p ≤ K.1 → r ≤ K.1 → K.1 ≤ p+r → p+r ≤ K.1+1 → + Relation.ReflTransGen Q (pt sx sy p r) (pt sx sy 0 K.1) := by + intro p + induction p with + | zero => + intro r hp hr hlo hhi + have he : r=K.1 := by omega + subst r + exact .refl + | succ p ih => + intro r hp hr hlo hhi + have hstart := pmem sx sy hsx hsy (p+1) r hp hr hlo hhi + by_cases hout : p+1+r=K.1+1 + · have hnext := pmem sx sy hsx hsy p r (by omega) hr (by omega) (by omega) + exact (Relation.ReflTransGen.single ⟨hstart, hnext, horiz sx sy hsx p r⟩).trans + (ih r (by omega) hr (by omega) (by omega)) + · have hpeak := pmem sx sy hsx hsy (p+1) (r+1) hp (by omega) (by omega) (by omega) + have hnext := pmem sx sy hsx hsy p (r+1) (by omega) (by omega) (by omega) (by omega) + exact (Relation.ReflTransGen.single ⟨hstart, hpeak, vert sx sy hsy (p+1) r⟩).trans + ((Relation.ReflTransGen.single ⟨hpeak, hnext, horiz sx sy hsx p (r+1)⟩).trans + (ih (r+1) (by omega) (by omega) (by omega) (by omega))) + let top := pt 1 1 0 K.1 + let bot := pt 1 (-1) 0 K.1 + have bridge : Relation.ReflTransGen Q top bot := by + have h1 := quadrant 1 1 (Or.inl rfl) (Or.inl rfl) K.1 0 + (by omega) (by omega) (by omega) (by omega) + have h2 := quadrant 1 (-1) (Or.inl rfl) (Or.inr rfl) K.1 0 + (by omega) (by omega) (by omega) (by omega) + have he : pt 1 (-1) K.1 0 = pt 1 1 K.1 0 := by simp [pt] + rw [he] at h2 + exact (reverse h1).trans h2 + have signed (n : Int) : ∃ s : Int, (s=1 ∨ s = -1) ∧ n=s*(n.natAbs : Int) := by + by_cases hn : 0 ≤ n + · exact ⟨1, Or.inl rfl, by simp [abs_of_nonneg hn]⟩ + · exact ⟨-1, Or.inr rfl, by simp [abs_of_neg (by omega : n<0)]⟩ + have toBot : ∀ x ∈ S, Relation.ReflTransGen Q x bot := by + intro x hx + obtain ⟨sx, hsx, hex⟩ := signed x.re + obtain ⟨sy, hsy, hey⟩ := signed (x.im-k) + have hxpt : x=pt sx sy x.re.natAbs (x.im-k).natAbs := by + ext + · exact hex + · change x.im=k+sy*((x.im-k).natAbs : Int) + omega + obtain ⟨hp, hr, hlo, hhi⟩ := (bounds x).mp hx + have hq := quadrant sx sy hsx hsy _ _ hp hr hlo hhi + rw [← hxpt] at hq + rcases hsy with rfl | rfl + · have he : pt sx 1 0 K.1=top := by simp [pt, top] + rw [he] at hq + exact hq.trans bridge + · have he : pt sx (-1) 0 K.1=bot := by simp [pt, bot] + rw [he] at hq + exact hq + have hbot : bot ∈ S := pmem 1 (-1) (Or.inl rfl) (Or.inr rfl) 0 K.1 + (by omega) (by omega) (by omega) (by omega) + refine ⟨?_, ?_, ?_⟩ + · refine ⟨⟨bot, hbot⟩, ?_⟩ + intro x hx y hy + obtain ⟨p, hc, hlast⟩ := List.exists_isChain_cons_of_relationReflTransGen + ((toBot x hx).trans (reverse (toBot y hy))) + refine ⟨x::p, rfl, ?_, ?_, ?_⟩ + · rw [List.getLast?_eq_some_getLast (List.cons_ne_nil x p), hlast] + · exact hc.induction (fun t => t ∈ S) (x::p) + (fun {u z} he _ => he.2.1) (fun _ => hx) + · exact List.isChain_iff_forall_rel_of_append_cons_cons.mp + (hc.imp (fun _ _ he => he.2.2)) + · constructor + · convert hbot using 1; ext <;> simp [bot, pt, k] + · have ht := pmem 1 1 (Or.inl rfl) (Or.inl rfl) 0 K.1 + (by omega) (by omega) (by omega) (by omega) + convert ht using 1; ext <;> simp [pt, k]; ring + · constructor + · have ht := pmem 1 1 (Or.inl rfl) (Or.inl rfl) K.1 1 + (by omega) (by omega) (by omega) (by omega) + convert ht using 1; ext <;> simp [pt, k] + · have ht := pmem (-1) (-1) (Or.inr rfl) (Or.inr rfl) 1 (K.1-1) + (by omega) (by omega) (by omega) (by omega) + convert ht using 1 + ext <;> simp? [pt, k] + have hcast : ((K.1-1 : Nat) : Int)=(K.1 : Int)-1 := by omega + rw [hcast] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5435T1WebGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5435T1WebGeometry.lean new file mode 100644 index 0000000000..36e382fe0a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5435T1WebGeometry.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5435T1ShellPaths +public import LeanPool.ApollonianSuperharmonic.P5435T1PeriodGap +public import LeanPool.ApollonianSuperharmonic.P4818T1Representatives +public import Mathlib.Data.List.Chain + +-- [TABLET NODE: P5435T1WebGeometry] + +/-! +# P5435T1WebGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5435T1WebGeometry (K : DiamondParameter) : + let D := DiamondVertexDomains K true + let S := DiamondVertexDomains K false \ D + let W : Set GaussianInt := + {x | ∃ v ∈ DiamondExceptionalLattice K, x - v ∈ S} + FourNeighborConnected W ∧ + ∀ x, x ∉ W → ∃ v ∈ DiamondExceptionalLattice K, ∀ y, + Relation.ReflTransGen + (fun u z => u ∉ W ∧ z ∉ W ∧ FourNeighborAdjacent u z) x y → + y - v ∈ D := by +-- BODY + classical + dsimp only + let k : Int := K.1 + let a : GaussianInt := ⟨0, -(2*K.1 : Int)⟩ + let b : GaussianInt := ⟨(K.1+1 : Int), (K.1 : Int)⟩ + let L := DiamondExceptionalLattice K + let D := DiamondVertexDomains K true + let S := DiamondVertexDomains K false \ D + let W : Set GaussianInt := {x | ∃ v ∈ L, x-v ∈ S} + change FourNeighborConnected W ∧ _ + obtain ⟨hS, hA, hB⟩ := P5435T1ShellPaths K + have hs0 : (0 : GaussianInt) ∈ S := by + convert hA.1 using 1 + ext <;> rfl + have ha : a ∈ L := AddSubgroup.subset_closure (Or.inl rfl) + have hb : b ∈ L := AddSubgroup.subset_closure (Or.inr rfl) + have adjSymm {x y : GaussianInt} (h : FourNeighborAdjacent x y) : + FourNeighborAdjacent y x := by + rcases h with rfl | rfl | rfl | rfl <;> + simp [FourNeighborAdjacent, add_assoc, add_comm, add_left_comm] + have adjShift {x y : GaussianInt} (h : FourNeighborAdjacent x y) (v : GaussianInt) : + FourNeighborAdjacent (x+v) (y+v) := by + rcases h with rfl | rfl | rfl | rfl <;> + simp [FourNeighborAdjacent, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + have inW (v : GaussianInt) (hv : v ∈ L) (s : GaussianInt) (hs : s ∈ S) : + s+v ∈ W := ⟨v, hv, by simpa using hs⟩ + have shiftW (x : GaussianInt) (hx : x ∈ W) (v : GaussianInt) (hv : v ∈ L) : + x+v ∈ W := by + obtain ⟨u, hu, hs⟩ := hx + exact ⟨u+v, L.add_mem hu hv, by simpa only [add_sub_add_right_eq_sub] using hs⟩ + let Q := fun x y => x ∈ W ∧ y ∈ W ∧ FourNeighborAdjacent x y + have reverse {x y} (h : Relation.ReflTransGen Q x y) : + Relation.ReflTransGen Q y x := by + induction h with + | refl => exact .refl + | tail h e ih => exact (Relation.ReflTransGen.single + ⟨e.2.1, e.1, adjSymm e.2.2⟩).trans ih + have shellReach (v : GaussianInt) (hv : v ∈ L) + (s : GaussianInt) (hs : s ∈ S) (t : GaussianInt) (ht : t ∈ S) : + Relation.ReflTransGen Q (s+v) (t+v) := by + obtain ⟨p, hp, hlast, pall, padj⟩ := hS.2 s hs t ht + have hc : p.IsChain (fun u z => u ∈ S ∧ z ∈ S ∧ FourNeighborAdjacent u z) := by + apply List.isChain_iff_forall_rel_of_append_cons_cons.mpr + intro u z l₁ l₂ he + exact ⟨pall u (by simp [he]), pall z (by simp [he]), padj u z l₁ l₂ he⟩ + have hr : Relation.ReflTransGen + (fun u z => u ∈ S ∧ z ∈ S ∧ FourNeighborAdjacent u z) s t := by + cases p with + | nil => simp at hp + | cons u p => + simp only [List.head?_cons, Option.some.injEq] at hp + subst u + exact List.relationReflTransGen_of_exists_isChain_cons p hc + (List.getLast_of_getLast?_eq_some hlast) + exact Relation.ReflTransGen.lift (fun u => u+v) + (fun u z he => ⟨inW v hv u he.1, inW v hv z he.2.1, adjShift he.2.2 v⟩) + _ _ hr + have genReach (d : GaussianInt) (hd : d ∈ L) + (t : GaussianInt) (ht : t ∈ S) (htd : t-d ∈ S) : + ∀ x ∈ W, Relation.ReflTransGen Q x (x+d) := by + rintro x ⟨v, hv, hs⟩ + have h1 := shellReach v hv (x-v) hs t ht + have h2 := shellReach (v+d) (L.add_mem hv hd) (t-d) htd (x-v) hs + have h2' : Relation.ReflTransGen Q (t+v) (x+d) := by + convert h2 using 1 <;> abel + simpa only [sub_add_cancel] using h1.trans h2' + let H : AddSubgroup GaussianInt := + { carrier := {v | v ∈ L ∧ ∀ x ∈ W, Relation.ReflTransGen Q x (x+v)} + zero_mem' := ⟨L.zero_mem, by intro x hx; simpa using (Relation.ReflTransGen.refl (a := x) + (r := Q))⟩ + add_mem' := by + rintro u v ⟨hu, hpu⟩ ⟨hv, hpv⟩ + refine ⟨L.add_mem hu hv, ?_⟩ + intro x hx + simpa only [add_assoc] using (hpu x hx).trans (hpv (x+u) (shiftW x hx u hu)) + neg_mem' := by + rintro v ⟨hv, hp⟩ + refine ⟨L.neg_mem hv, ?_⟩ + intro x hx + have h := reverse (hp (x-v) (by + simpa only [sub_eq_add_neg] using shiftW x hx (-v) (L.neg_mem hv))) + rw [sub_add_cancel] at h + simpa only [sub_eq_add_neg] using h } + have hgen : {v : GaussianInt | v=a ∨ v=b} ⊆ H := by + intro v hv + rcases hv with rfl | rfl + · refine ⟨ha, genReach a ha 0 hs0 ?_⟩ + have he : (0 : GaussianInt)-a = ⟨0, (2*K.1 : Int)⟩ := by + ext <;> simp [a] + rw [he] + exact hA.2 + · refine ⟨hb, genReach b hb ⟨k,k+1⟩ hB.1 ?_⟩ + have he : (⟨k,k+1⟩ : GaussianInt)-b = ⟨-1,1⟩ := by + ext <;> simp [b, k] + rw [he] + exact hB.2 + have hLH : L ≤ H := (AddSubgroup.closure_le H).mpr hgen + have zeroW : (0 : GaussianInt) ∈ W := ⟨0, L.zero_mem, by simpa using hs0⟩ + have reach0 : ∀ x ∈ W, Relation.ReflTransGen Q 0 x := by + rintro x ⟨v, hv, hs⟩ + have h1 := (hLH hv).2 0 zeroW + have h2 := shellReach v hv 0 hs0 (x-v) hs + simpa only [zero_add, sub_add_cancel] using h1.trans h2 + constructor + · refine ⟨⟨0, zeroW⟩, ?_⟩ + intro x hx y hy + have hr := (reverse (reach0 x hx)).trans (reach0 y hy) + obtain ⟨p, hc, hlast⟩ := List.exists_isChain_cons_of_relationReflTransGen hr + refine ⟨x::p, rfl, ?_, ?_, ?_⟩ + · rw [List.getLast?_eq_some_getLast (List.cons_ne_nil x p), hlast] + · exact hc.induction (fun t => t ∈ W) (x::p) + (fun {u z} he _ => he.2.1) (fun _ => hx) + · exact List.isChain_iff_forall_rel_of_append_cons_cons.mp + (hc.imp (fun _ _ he => he.2.2)) + · have coverage : ∀ x, x ∉ W → ∃ v ∈ L, x-v ∈ D := by + intro x hx + obtain ⟨p, hp, _⟩ := P4818T1Representatives K x + let v := p.2.1 • a + p.2.2 • b + have hv : v ∈ L := L.add_mem (L.zsmul_mem ha _) (L.zsmul_mem hb _) + have he : x-v=p.1 := by + have he' : x=p.1+v := by + simpa only [v, a, b, neg_mul, add_assoc] using hp.2 + rw [he']; abel + refine ⟨v, hv, ?_⟩ + by_contra hn + exact hx ⟨v, hv, he ▸ ⟨hp.1.1, he ▸ hn⟩⟩ + have inner (x : GaussianInt) (hx : x ∈ D) : + |x.re| + |x.im-k| ≤ k-1 := by + change x.re.natAbs + (x.im-k).natAbs ≤ K.1-1 at hx + have ha := Int.natCast_natAbs x.re + have hb := Int.natCast_natAbs (x.im-k) + have hk := K.2 + dsimp only [k] at hx ha hb ⊢ + omega + have adjacentOwner (x y v v' : GaussianInt) + (hv : v ∈ L) (hv' : v' ∈ L) (hx : x-v ∈ D) (hy : y-v' ∈ D) + (hadj : FourNeighborAdjacent x y) : v=v' := by + by_contra hn + have hg := P5435T1PeriodGap K (v-v') (L.sub_mem hv hv') (sub_ne_zero.mpr hn) + have hxi := inner (x-v) hx + have hyi := inner (y-v') hy + change 2*k ≤ |(v-v').re|+|(v-v').im| at hg + rcases hadj with rfl | rfl | rfl | rfl <;> + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one, add_zero, sub_zero, + abs_eq_max_neg] at hg hxi hyi <;> omega + intro x hx + obtain ⟨v, hv, hxv⟩ := coverage x hx + refine ⟨v, hv, ?_⟩ + intro y hy + induction hy with + | refl => exact hxv + | @tail y z h e ih => + obtain ⟨v', hv', hz⟩ := coverage z e.2.1 + have he := adjacentOwner y z v v' hv hv' ih hz e.2.2 + simpa only [he] using hz + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5442T1Cocycle.lean b/LeanPool/ApollonianSuperharmonic/P5442T1Cocycle.lean new file mode 100644 index 0000000000..b19398060e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5442T1Cocycle.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordExceptionalLattice +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordPeakMatrix +public import Mathlib.Tactic.LinearCombination + +-- [TABLET NODE: P5442T1Cocycle] + +/-! +# P5442T1Cocycle + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5442T1Cocycle (P : FordFareyParameter) : + ∀ v, v ∈ FordExceptionalLattice P → ∃ a : GaussianInt, + Matrix.mulVec (FordPeakMatrix P.p P.q P.q_pos P.reduced) + ![(v.re : Real), (v.im : Real)] = + ![(a.re : Real), (a.im : Real)] ∧ + ∀ x, FordOdometer P (x + v) = FordOdometer P x + + x.re * a.re + x.im * a.im + FordOdometer P v := by +-- BODY + classical + let g := FordOdometer P + obtain ⟨_, hbdy, ha, hb, _, _⟩ := + (Classical.choose_spec FordOdometerFamilyExistsUnique).1 + change ∀ R x, x ∈ FordDoubledBoundary R.q → FordOdometer R x = _ at hbdy + change ∀ R x, FordOdometer R (x + ⟨0, -(R.q : Int)⟩) = _ at ha + change ∀ R x, FordOdometer R (x + ⟨(R.q : Int), (R.q₁ : Int)⟩) = _ at hb + have hzero : g 0 = 0 := by + have hz : (0 : GaussianInt) ∈ FordDoubledBoundary P.q := by + simp [FordDoubledBoundary, FordVertexDomain] + simpa [g, IntegerCeilDiv] using hbdy P 0 hz + let B (v a : GaussianInt) : Prop := + Matrix.mulVec (FordPeakMatrix P.p P.q P.q_pos P.reduced) + ![(v.re : Real), (v.im : Real)] = ![(a.re : Real), (a.im : Real)] + let H : AddSubgroup GaussianInt := + { carrier := {v | ∃ a : GaussianInt, B v a ∧ + ∀ x, g (x+v) = g x + x.re*a.re + x.im*a.im + g v} + zero_mem' := by + refine ⟨0, ?_, ?_⟩ + · dsimp [B] + ext i; fin_cases i <;> simp [Matrix.mulVec, dotProduct] + · intro x; simp [hzero] + add_mem' := by + rintro u v ⟨a, hMa, hua⟩ ⟨b, hMb, hvb⟩ + refine ⟨a+b, ?_, ?_⟩ + · dsimp [B] at hMa hMb ⊢ + have he : ![((u+v).re : Real), ((u+v).im : Real)] = + ![(u.re : Real), (u.im : Real)] + ![(v.re : Real), (v.im : Real)] := by + ext i; fin_cases i <;> simp + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at he + rw [he, Matrix.mulVec_add, hMa, hMb] + ext i; fin_cases i <;> simp + · intro x + have h1 := hvb (x+u) + have h2 := hua x + have h3 := hvb u + simp only [Zsqrtd.re_add, Zsqrtd.im_add] at h1 ⊢ + rw [add_assoc] at h1 + linear_combination h1 + h2 - h3 + neg_mem' := by + rintro v ⟨a, hMa, hva⟩ + refine ⟨-a, ?_, ?_⟩ + · dsimp [B] at hMa ⊢ + have he : ![((-v).re : Real), ((-v).im : Real)] = + - ![(v.re : Real), (v.im : Real)] := by + ext i; fin_cases i <;> simp + simp only [Zsqrtd.re_neg, Zsqrtd.im_neg] at he + rw [he, Matrix.mulVec_neg, hMa] + ext i; fin_cases i <;> simp + · intro x + have h1 := hva (x-v) + have h2 := hva (-v) + simp only [sub_add_cancel, neg_add_cancel, Zsqrtd.re_sub, + Zsqrtd.im_sub, Zsqrtd.re_neg, Zsqrtd.im_neg, hzero] at h1 h2 + simp only [Zsqrtd.re_neg, Zsqrtd.im_neg] + rw [show x + -v = x-v by abel] + linear_combination -h1 + h2 } + have hq : (P.q : Real) ≠ 0 := by exact_mod_cast P.q_pos.ne' + have hdet : (P.p₁ : Real) * P.q - (P.q₁ : Real) * P.p = 1 := by + exact_mod_cast P.det₁ + have hgen : {v : GaussianInt | v = ⟨0, -(P.q : Int)⟩ ∨ + v = ⟨(P.q : Int), (P.q₁ : Int)⟩} ⊆ H := by + intro v hv + rcases hv with rfl | rfl + · refine ⟨⟨-P.p, 0⟩, ?_, ?_⟩ + · dsimp [B, FordPeakMatrix] + ext i; fin_cases i <;> simp only [Matrix.mulVec, dotProduct, Fin.sum_univ_two] + · push_cast + change (1 / (P.q : Real)^2) * 1 * 0 + + (1 / (P.q : Real)^2) * ((P.p : Real) * P.q) * (-(P.q : Real)) = -(P.p : Real) + field_simp [hq]; ring + · push_cast + change (1 / (P.q : Real)^2) * ((P.p : Real) * P.q) * 0 + + (1 / (P.q : Real)^2) * 0 * (-(P.q : Real)) = 0 + ring + · intro x + have h := ha P x + have h0 := ha P 0 + change g _ = g _ - _ at h h0 + simp only [Zsqrtd.re_zero, zero_add, mul_zero, sub_zero, hzero] at h0 + change g _ = g x + x.re * (-P.p) + x.im * 0 + g _ + rw [h0] + linarith only [h] + · refine ⟨⟨P.p₁, P.p⟩, ?_, ?_⟩ + · dsimp [B, FordPeakMatrix] + ext i; fin_cases i <;> simp only [Matrix.mulVec, dotProduct, Fin.sum_univ_two] + · push_cast + change (1 / (P.q : Real)^2) * 1 * (P.q : Real) + + (1 / (P.q : Real)^2) * ((P.p : Real) * P.q) * (P.q₁ : Real) = (P.p₁ : Real) + field_simp [hq] + nlinarith only [hdet] + · push_cast + change (1 / (P.q : Real)^2) * ((P.p : Real) * P.q) * (P.q : Real) + + (1 / (P.q : Real)^2) * 0 * (P.q₁ : Real) = (P.p : Real) + field_simp [hq]; ring + · intro x + have h := hb P x + have h0 := hb P 0 + change g _ = g _ + _ + _ + _ at h h0 + simp only [Zsqrtd.re_zero, Zsqrtd.im_zero, zero_add, + mul_zero, add_zero, hzero] at h0 + change g _ = g x + x.re * P.p₁ + x.im * P.p + g _ + rw [h0] + linarith only [h] + intro v hv + exact ((AddSubgroup.closure_le H).mpr hgen) hv + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5442T1LaplacianBound.lean b/LeanPool/ApollonianSuperharmonic/P5442T1LaplacianBound.lean new file mode 100644 index 0000000000..c58cf16443 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5442T1LaplacianBound.lean @@ -0,0 +1,144 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5442T1WebGeometry +public import LeanPool.ApollonianSuperharmonic.P4062T1ParentalRestriction +public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderGeometry + +-- [TABLET NODE: P5442T1LaplacianBound] + +/-! +# P5442T1LaplacianBound + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5442T1LaplacianBound (P : FordFareyParameter) : + ∀ x, FourNeighborLaplacian (FordOdometer P) x ≤ 1 := by +-- BODY + classical + have coords (q : Nat) (x : GaussianInt) : + x ∈ P4062T1InteriorSquare q ↔ + 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ + 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 := by + constructor + · intro hx + obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hx + obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab + exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, + (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ + · intro hx + exact Finset.mem_image.mpr ⟨(x.re, x.im), Finset.mem_product.mpr + ⟨Finset.mem_Icc.mpr ⟨hx.1, hx.2.1⟩, + Finset.mem_Icc.mpr hx.2.2⟩, by cases x; rfl⟩ + have main : ∀ n, ∀ P : FordFareyParameter, P.q = n → + ∀ x, FourNeighborLaplacian (FordOdometer P) x ≤ 1 := by + intro n + induction n using Nat.strong_induction_on with + | h n ih => + intro P hn x + obtain ⟨hp, hw, _, ho⟩ := P5442T1WebGeometry P + let t : Int → Int → GaussianInt := fun m n => + ⟨n * (P.q : Int), n * (P.q₁ : Int) - m * (P.q : Int)⟩ + let W : Set GaussianInt := {x | ∃ m n : Int, + x - t m n ∈ LatticeVertexBoundary (FordVertexDomain P.q)} + change (∀ x ∈ W, FourNeighborLaplacian (FordOdometer P) x = 1) at hw + by_cases hx : x ∈ W + · exact le_of_eq (hw x hx) + obtain ⟨m, k, ho⟩ := ho x hx + let y := x - t m k + have hy : y ∈ P4062T1InteriorSquare P.q := ho x .refl + have he : FourNeighborLaplacian (FordOdometer P) x = + FourNeighborLaplacian (FordOdometer P) y := by + have he := (hp m k).2 y + simpa only [y, t, sub_add_cancel] using he + rw [he] + have hyc := (coords P.q y).mp hy + by_cases h1 : P.q = 1 + · omega + by_cases h2 : P.q = 2 + · have hab : P.q₁ = 1 ∧ P.q₂ = 1 := by + have hs := P.sum_q + have ht := P.q₁_lt + have hpos := P.q₂_pos + have hd := P.det₁ + rw [h2] at hs ht hd + by_cases hz : P.q₁ = 0 + · rw [hz] at hd + norm_num at hd + omega + · constructor <;> omega + have hyeq : y = (⟨1, 1⟩ : GaussianInt) := by ext <;> dsimp <;> omega + have hm : FordBoundaryMultiplicity P y = 4 := by + rw [hyeq] + unfold FordBoundaryMultiplicity + have hb : ∀ i : Fin 4, + (⟨1, 1⟩ : GaussianInt) ∈ + LatticeVertexBoundary (FordRecursiveVertexDomains P i) := by + intro i + fin_cases i + · refine ⟨?_, ⟨⟨2, 1⟩, ?_, ?_, ?_⟩⟩ + all_goals norm_num [FordRecursiveVertexDomains, hab.1, hab.2, h2] + · refine ⟨?_, ⟨⟨0, 1⟩, ?_, ?_, ?_⟩⟩ + all_goals norm_num [FordRecursiveVertexDomains, hab.1, hab.2, h2] + · refine ⟨?_, ⟨⟨1, 2⟩, ?_, ?_, ?_⟩⟩ + all_goals norm_num [FordRecursiveVertexDomains, hab.1, hab.2, h2] + · refine ⟨?_, ⟨⟨1, 0⟩, ?_, ?_, ?_⟩⟩ + all_goals norm_num [FordRecursiveVertexDomains, hab.1, hab.2, h2] + simp only [Finset.filter_true_of_mem (fun i _ => hb i), Finset.card_univ, + Fintype.card_fin] + have ht := (FordLaplacianTable P).2.2 (by omega) y + hyc.1 hyc.2.1 hyc.2.2.1 hyc.2.2.2 + rw [ht.2.2 hm] + norm_num + have hbig : 2 < P.q := by have := P.q_pos; omega + obtain ⟨A, B, _, _, _, _, hA, hB, _, restrictions⟩ := + P4062T1ParentalRestriction P hbig + let E := (P4062T1RecursiveInteriors P 0 ∪ P4062T1RecursiveInteriors P 1) ∪ + (P4062T1RecursiveInteriors P 2 ∪ P4062T1RecursiveInteriors P 3) + by_cases hyE : y ∈ E + · have select : ∃ i : Fin 4, y ∈ P4062T1RecursiveInteriors P i := by + rcases Finset.mem_union.mp hyE with h | h + · rcases Finset.mem_union.mp h with h | h + · exact ⟨0, h⟩ + · exact ⟨1, h⟩ + · rcases Finset.mem_union.mp h with h | h + · exact ⟨2, h⟩ + · exact ⟨3, h⟩ + obtain ⟨i, hi⟩ := select + rw [(restrictions i).2 y hi] + apply ih (if i.val < 2 then A else B).q + (by split_ifs <;> omega) (if i.val < 2 then A else B) rfl + · have rem := P4062T1RemainderGeometry P hbig + obtain ⟨_, hW, _, _, _, hmult, _, _⟩ := rem + have hyW : y ∈ P4062T1InteriorSquare P.q \ E := + Finset.mem_sdiff.mpr ⟨hy, hyE⟩ + rw [hW] at hyW + have hj : ∃ j : Fin 2, y ∈ (P4062T1RemainderPaths P j).1 := by + rcases Finset.mem_union.mp hyW with h | h + · exact ⟨0, h⟩ + · exact ⟨1, h⟩ + obtain ⟨j, hj⟩ := hj + have hm := (hmult j y hj).2.1 + have ht := (FordLaplacianTable P).2.2 (by omega) y + hyc.1 hyc.2.1 hyc.2.2.1 hyc.2.2.2 + by_cases hr : y = (P4062T1RemainderPaths P j).2 + · rw [ite_eq_left hr] at hm + rw [ht.2.1 hm] + norm_num + · rw [ite_eq_right hr] at hm + exact le_of_eq (ht.1 hm) + exact main P.q P rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5442T1WebGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5442T1WebGeometry.lean new file mode 100644 index 0000000000..beaba40887 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5442T1WebGeometry.lean @@ -0,0 +1,438 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5442T1Cocycle +public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorSquare +public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import Mathlib.Data.List.Chain + +-- [TABLET NODE: P5442T1WebGeometry] + +/-! +# P5442T1WebGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FordWebGeometryProof + +private theorem boundary : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), x ∈ LatticeVertexBoundary + (FordVertexDomain P.q) ↔ (0 : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ x.im ∧ x.im ≤ + (↑P.q : ℤ) ∧ (x.re = (0 : ℤ) ∨ x.re = (↑P.q : ℤ) ∨ x.im = (0 : ℤ) ∨ x.im = (↑P.q : ℤ)) + ) := by + classical + intro P x + constructor + · rintro ⟨hx, y, hy, hr, hi⟩ + refine ⟨hx.1, hx.2.1, hx.2.2.1, hx.2.2.2, ?_⟩ + have hr' : |x.re - y.re| ≤ (1 : Int) := by + rw [← Int.natCast_natAbs]; exact_mod_cast hr + have hi' : |x.im - y.im| ≤ (1 : Int) := by + rw [← Int.natCast_natAbs]; exact_mod_cast hi + have hrb := abs_le.mp hr' + have hib := abs_le.mp hi' + change ¬(0 ≤ y.re ∧ y.re ≤ (P.q : Int) ∧ + 0 ≤ y.im ∧ y.im ≤ (P.q : Int)) at hy + change 0 ≤ x.re ∧ x.re ≤ (P.q : Int) ∧ + 0 ≤ x.im ∧ x.im ≤ (P.q : Int) at hx + omega + · rintro ⟨hr, hr', hi, hi', he⟩ + refine ⟨⟨hr, hr', hi, hi'⟩, ?_⟩ + rcases he with he | he | he | he + · refine ⟨x-1, ?_, ?_, ?_⟩ + all_goals simp [FordVertexDomain, he] + · refine ⟨x+1, ?_, ?_, ?_⟩ + · simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_add, + Zsqrtd.im_add, Zsqrtd.re_one, Zsqrtd.im_one, he] + omega + all_goals simp + · refine ⟨x-⟨0,1⟩, ?_, ?_, ?_⟩ + all_goals simp [FordVertexDomain, he] + · refine ⟨x+⟨0,1⟩, ?_, ?_, ?_⟩ + · simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_add, Zsqrtd.im_add, he] + omega + all_goals simp + +private theorem coords : + (by + classical + exact + ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare P.q ↔ (1 : + ℤ) ≤ x.re ∧ x.re ≤ (↑P.q : ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q : ℤ) - (1 : ℤ) + ) := by + classical + intro P x + constructor + · intro hx + obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hx + obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab + exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, + (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ + · intro hx + exact Finset.mem_image.mpr ⟨(x.re, x.im), Finset.mem_product.mpr + ⟨Finset.mem_Icc.mpr ⟨hx.1, hx.2.1⟩, + Finset.mem_Icc.mpr hx.2.2⟩, by cases x; rfl⟩ + +private theorem periods : + (by + classical + exact + ∀ (P : FordFareyParameter), + let t : Int → Int → GaussianInt := fun m n => + ⟨n * (P.q : Int), n * (P.q₁ : Int) - m * (P.q : Int)⟩ + ∀ m, ∀ n, t m n ∈ + FordExceptionalLattice P ∧ ∀ x, FourNeighborLaplacian (FordOdometer P) (x+t m n) = + FourNeighborLaplacian (FordOdometer P) x + ) := by + classical + intro P t m n + have hu : (⟨0, -(P.q : Int)⟩ : GaussianInt) ∈ FordExceptionalLattice P := + AddSubgroup.subset_closure (Or.inl rfl) + have hv : (⟨(P.q : Int), (P.q₁ : Int)⟩ : GaussianInt) ∈ FordExceptionalLattice P := + AddSubgroup.subset_closure (Or.inr rfl) + have ht : t m n = m • (⟨0, -(P.q : Int)⟩ : GaussianInt) + + n • (⟨(P.q : Int), (P.q₁ : Int)⟩ : GaussianInt) := by + ext <;> simp [t]; ring + have htL : t m n ∈ FordExceptionalLattice P := by + rw [ht] + exact (FordExceptionalLattice P).add_mem + ((FordExceptionalLattice P).zsmul_mem hu m) + ((FordExceptionalLattice P).zsmul_mem hv n) + refine ⟨htL, ?_⟩ + obtain ⟨a, _, ha⟩ := P5442T1Cocycle P (t m n) htL + intro x + unfold FourNeighborLaplacian + rw [show x+t m n+1 = (x+1)+t m n by abel, + show x+t m n-1 = (x-1)+t m n by abel, + show x+t m n+⟨0,1⟩ = (x+⟨0,1⟩)+t m n by abel, + show x+t m n-⟨0,1⟩ = (x-⟨0,1⟩)+t m n by abel, + ha, ha, ha, ha, ha] + simp only [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, + Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] + ring + +private theorem lineMem : + (by + classical + exact + ∀ (P : FordFareyParameter), + let t : Int → Int → GaussianInt := fun m n => + ⟨n * (P.q : Int), n * (P.q₁ : Int) - m * (P.q : Int)⟩ + let W : Set GaussianInt := {x | ∃ m n : Int, + x - t m n ∈ LatticeVertexBoundary (FordVertexDomain P.q)} + ( (0 < (P.q : + Int)) → ((∀ (x : GaussianInt), x ∈ LatticeVertexBoundary (FordVertexDomain P.q) ↔ 0 ≤ + x.re ∧ x.re ≤ (P.q : Int) ∧ 0 ≤ x.im ∧ x.im ≤ (P.q : Int) ∧ (x.re = 0 ∨ x.re = (P.q : + Int) ∨ x.im = 0 ∨ x.im = (P.q : Int))) → (∀ (n : ℤ), ∀ (b : ℤ), ⟨n * (↑P.q : ℤ), b⟩ ∈ + W))) + ) := by + classical + intro P t W hq boundary n b + let k := (b - n*(P.q₁ : Int)) / (P.q : Int) + let s := (b - n*(P.q₁ : Int)) % (P.q : Int) + have hs : 0 ≤ s := Int.emod_nonneg _ (ne_of_gt hq) + have hs' : s < (P.q : Int) := Int.emod_lt_of_pos _ hq + have he := Int.emod_add_mul_ediv (b - n*(P.q₁ : Int)) (P.q : Int) + refine ⟨-k, n, (boundary _).mpr ?_⟩ + have hi : (⟨n*(P.q : Int), b⟩ - t (-k) n).im = s := by + dsimp [t, k, s] + nlinarith only [he] + simp only [Zsqrtd.re_sub, hi] + change 0 ≤ n*(P.q : Int)-n*(P.q : Int) ∧ _ + dsimp [t] + omega + +private theorem segment : + (by + classical + exact + ∀ (P : FordFareyParameter), + let t : Int → Int → GaussianInt := fun m n => + ⟨n * (P.q : Int), n * (P.q₁ : Int) - m * (P.q : Int)⟩ + let W : Set GaussianInt := {x | ∃ m n : Int, + x - t m n ∈ LatticeVertexBoundary (FordVertexDomain P.q)} + ( + let Q : GaussianInt → GaussianInt → Prop := + fun u z => u ∈ W ∧ z ∈ W ∧ FourNeighborAdjacent u z + ∀ (a : GaussianInt), ∀ (d : GaussianInt), d = (1 : GaussianInt) ∨ d = ⟨(0 : ℤ), (1 : ℤ)⟩ + → ∀ (k : ℕ), (∀ j ≤ k, a + j • d ∈ W) → Relation.ReflTransGen Q a (a + k • d)) + ) := by + classical + intro P t W Q a d hd k hm + induction k with + | zero => simpa only [zero_nsmul, add_zero] using + (Relation.ReflTransGen.refl (a := a) (r := Q)) + | succ k ih => + have hp := ih (fun j hj => hm j (by omega)) + have he : FourNeighborAdjacent (a+k • d) (a+(k+1) • d) := by + rcases hd with rfl | rfl + · left; rw [add_nsmul, one_nsmul, add_assoc] + · right; right; left; rw [add_nsmul, one_nsmul, add_assoc] + exact hp.tail ⟨hm k (by omega), hm (k+1) le_rfl, he⟩ + +private theorem bridge : + (by + classical + exact + ∀ (P : FordFareyParameter), + let t : Int → Int → GaussianInt := fun m n => + ⟨n * (P.q : Int), n * (P.q₁ : Int) - m * (P.q : Int)⟩ + let W : Set GaussianInt := {x | ∃ m n : Int, + x - t m n ∈ LatticeVertexBoundary (FordVertexDomain P.q)} + ( (∀ (x : + GaussianInt), x ∈ LatticeVertexBoundary (FordVertexDomain P.q) ↔ 0 ≤ x.re ∧ x.re ≤ + (P.q : Int) ∧ 0 ≤ x.im ∧ x.im ≤ (P.q : Int) ∧ (x.re = 0 ∨ x.re = (P.q : Int) ∨ x.im = + 0 ∨ x.im = (P.q : Int))) → ( + let Q : GaussianInt → GaussianInt → Prop := + fun u z => u ∈ W ∧ z ∈ W ∧ FourNeighborAdjacent u z + (∀ (a : GaussianInt), ∀ (d : GaussianInt), (d = 1 ∨ d = ⟨0,1⟩) → (∀ (k : Nat), (∀ j : + Nat, j ≤ k → a + j • d ∈ W) → (Relation.ReflTransGen Q a (a + k • d)))) → ((∀ (j : + Nat), j • (1 : GaussianInt) = ⟨j,0⟩) → (∀ (n : ℤ), Relation.ReflTransGen Q ⟨n * (↑P.q + : ℤ), n * (↑P.q₁ : ℤ)⟩ ⟨(n + (1 : ℤ)) * (↑P.q : ℤ), n * (↑P.q₁ : ℤ)⟩)))) + ) := by + classical + intro P t W boundary Q segment horizVec n + have hh := segment ⟨n*(P.q : Int), n*(P.q₁ : Int)⟩ 1 (Or.inl rfl) P.q + (fun j hj => by + refine ⟨0, n, (boundary _).mpr ?_⟩ + rw [horizVec] + dsimp [t] + have hj' : (j : Int) ≤ P.q := by exact_mod_cast hj + omega) + convert hh using 1 + ext <;> simp; ring + +private theorem lineReach : + (by + classical + exact + ∀ (P : FordFareyParameter), + let t : Int → Int → GaussianInt := fun m n => + ⟨n * (P.q : Int), n * (P.q₁ : Int) - m * (P.q : Int)⟩ + let W : Set GaussianInt := {x | ∃ m n : Int, + x - t m n ∈ LatticeVertexBoundary (FordVertexDomain P.q)} + let Q : GaussianInt → GaussianInt → Prop := + fun u z => u ∈ W ∧ z ∈ W ∧ FourNeighborAdjacent u z + (∀ {x y}, Relation.ReflTransGen Q x y → Relation.ReflTransGen Q y x) → ((∀ (n : Int), + Relation.ReflTransGen Q ⟨n*(P.q : Int), 0⟩ ⟨(n+1)*(P.q : Int), 0⟩) → (∀ (n : ℤ), + Relation.ReflTransGen Q (0 : GaussianInt) ⟨n * (↑P.q : ℤ), (0 : ℤ)⟩))) := by + classical + intro P t W Q reverse link n + induction n using Int.induction_on with + | zero => + have hz : (⟨(0 : Int)*(P.q : Int), 0⟩ : GaussianInt) = 0 := by ext <;> simp + simpa only [hz] using (Relation.ReflTransGen.refl (a := (0 : GaussianInt)) (r := Q)) + | succ n ih => + convert ih.trans (link n) using 1 + | pred n ih => + have hh := reverse (link (-(n : Int)-1)) + have he : (⟨(-(n : Int)-1+1)*(P.q : Int), 0⟩ : GaussianInt) = + ⟨(-(n : Int))*(P.q : Int), 0⟩ := by ext <;> simp + rw [he] at hh + exact ih.trans hh + +private theorem reach0 : + (by + classical + exact + ∀ (P : FordFareyParameter), + let t : Int → Int → GaussianInt := fun m n => + ⟨n * (P.q : Int), n * (P.q₁ : Int) - m * (P.q : Int)⟩ + let W : Set GaussianInt := {x | ∃ m n : Int, + x - t m n ∈ LatticeVertexBoundary (FordVertexDomain P.q)} + ( (0 < (P.q : + Int)) → ((∀ (x : GaussianInt), x ∈ LatticeVertexBoundary (FordVertexDomain P.q) ↔ 0 ≤ + x.re ∧ x.re ≤ (P.q : Int) ∧ 0 ≤ x.im ∧ x.im ≤ (P.q : Int) ∧ (x.re = 0 ∨ x.re = (P.q : + Int) ∨ x.im = 0 ∨ x.im = (P.q : Int))) → ( + let Q : GaussianInt → GaussianInt → Prop := + fun u z => u ∈ W ∧ z ∈ W ∧ FourNeighborAdjacent u z + (∀ (a : GaussianInt), ∀ (d : GaussianInt), (d = 1 ∨ d = ⟨0,1⟩) → (∀ (k : Nat), (∀ j : + Nat, j ≤ k → a + j • d ∈ W) → (Relation.ReflTransGen Q a (a + k • d)))) → ((∀ (j : + Nat), j • (1 : GaussianInt) = ⟨j,0⟩) → ((∀ (n : Int), ∀ (b : Int), ∀ (c : Int), + Relation.ReflTransGen Q ⟨n*(P.q : Int), b⟩ ⟨n*(P.q : Int), c⟩) → ((∀ (n : Int), + Relation.ReflTransGen Q 0 ⟨n*(P.q : Int), 0⟩) → (∀ x ∈ W, Relation.ReflTransGen Q 0 + x))))))) + ) := by + classical + intro P t W hq boundary Q segment horizVec vertical lineReach + rintro x ⟨m, n, hx⟩ + have hc := (boundary _).mp hx + have leftReach := (lineReach n).trans (vertical n 0 x.im) + by_cases hleft : x.re = n*(P.q : Int) + · convert leftReach using 1 + ext <;> simp [hleft] + by_cases hright : x.re = (n+1)*(P.q : Int) + · have hh := (lineReach (n+1)).trans (vertical (n+1) 0 x.im) + convert hh using 1 + ext <;> simp [hright] + have hr : 0 ≤ x.re-n*(P.q : Int) ∧ x.re-n*(P.q : Int) ≤ (P.q : Int) := by + simpa [t] using And.intro hc.1 hc.2.1 + have hb : x.im-(t m n).im = 0 ∨ x.im-(t m n).im = (P.q : Int) := by + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] at hc + dsimp [t] at hc + rcases hc.2.2.2.2 with h | h | h | h + · omega + · exfalso; apply hright; nlinarith only [h] + · exact Or.inl h + · exact Or.inr h + let k := (x.re-n*(P.q : Int)).toNat + have hk : (k : Int) = x.re-n*(P.q : Int) := Int.toNat_of_nonneg hr.1 + have hh := segment ⟨n*(P.q : Int), x.im⟩ 1 (Or.inl rfl) k + (fun j hj => by + refine ⟨m, n, (boundary _).mpr ?_⟩ + rw [horizVec] + dsimp [t] at hb ⊢ + have hj' : (j : Int) ≤ k := by exact_mod_cast hj + rcases hb with hb | hb <;> omega) + have he : (⟨n*(P.q : Int), x.im⟩ : GaussianInt) + k • 1 = x := by + ext <;> simp [hk] + rw [he] at hh + exact leftReach.trans hh + +end FordWebGeometryProof + +theorem P5442T1WebGeometry (P : FordFareyParameter) : + let t : Int → Int → GaussianInt := fun m n => + ⟨n * (P.q : Int), n * (P.q₁ : Int) - m * (P.q : Int)⟩ + let W : Set GaussianInt := {x | ∃ m n : Int, + x - t m n ∈ LatticeVertexBoundary (FordVertexDomain P.q)} + (∀ m n, t m n ∈ FordExceptionalLattice P ∧ + ∀ x, FourNeighborLaplacian (FordOdometer P) (x + t m n) = + FourNeighborLaplacian (FordOdometer P) x) ∧ + (∀ x ∈ W, FourNeighborLaplacian (FordOdometer P) x = 1) ∧ + FourNeighborConnected W ∧ + (∀ x, x ∉ W → ∃ m n : Int, ∀ y, + Relation.ReflTransGen + (fun u z => u ∉ W ∧ z ∉ W ∧ FourNeighborAdjacent u z) x y → + y - t m n ∈ P4062T1InteriorSquare P.q) := by +-- BODY + classical + intro t W + have hq : 0 < (P.q : Int) := by exact_mod_cast P.q_pos + have boundary (x : GaussianInt) : + x ∈ LatticeVertexBoundary (FordVertexDomain P.q) ↔ + 0 ≤ x.re ∧ x.re ≤ (P.q : Int) ∧ + 0 ≤ x.im ∧ x.im ≤ (P.q : Int) ∧ + (x.re = 0 ∨ x.re = (P.q : Int) ∨ x.im = 0 ∨ x.im = (P.q : Int)) := + FordWebGeometryProof.boundary P x + have coords (x : GaussianInt) : x ∈ P4062T1InteriorSquare P.q ↔ + 1 ≤ x.re ∧ x.re ≤ (P.q : Int) - 1 ∧ + 1 ≤ x.im ∧ x.im ≤ (P.q : Int) - 1 := FordWebGeometryProof.coords P x + have periods : ∀ m n, t m n ∈ FordExceptionalLattice P ∧ + ∀ x, FourNeighborLaplacian (FordOdometer P) (x+t m n) = + FourNeighborLaplacian (FordOdometer P) x := FordWebGeometryProof.periods P + refine ⟨periods, ?_, ?_, ?_⟩ + · rintro x ⟨m, n, hx⟩ + have hp := (periods m n).2 (x-t m n) + rw [sub_add_cancel] at hp + exact hp.trans ((FordLaplacianTable P).2.1 _ hx) + · let Q : GaussianInt → GaussianInt → Prop := + fun u z => u ∈ W ∧ z ∈ W ∧ FourNeighborAdjacent u z + have reverse {x y} (h : Relation.ReflTransGen Q x y) : + Relation.ReflTransGen Q y x := by + induction h with + | refl => exact .refl + | @tail u v h e ih => + have hs : FourNeighborAdjacent v u := by + rcases e.2.2 with he | he | he | he <;> rw [he] <;> + simp [FourNeighborAdjacent, add_assoc, add_comm, add_left_comm] + exact (Relation.ReflTransGen.single ⟨e.2.1, e.1, hs⟩).trans ih + have lineMem (n b : Int) : (⟨n*(P.q : Int), b⟩ : GaussianInt) ∈ W := + FordWebGeometryProof.lineMem P hq boundary n b + have segment (a d : GaussianInt) (hd : d = 1 ∨ d = ⟨0,1⟩) + (k : Nat) (hm : ∀ j : Nat, j ≤ k → a + j • d ∈ W) : + Relation.ReflTransGen Q a (a + k • d) := FordWebGeometryProof.segment P a d hd k hm + have horizVec (j : Nat) : j • (1 : GaussianInt) = ⟨j,0⟩ := by ext <;> simp + have verticalUp (n b : Int) (k : Nat) : + Relation.ReflTransGen Q ⟨n*(P.q : Int), b⟩ ⟨n*(P.q : Int), b+k⟩ := by + have hh := segment ⟨n*(P.q : Int), b⟩ ⟨0,1⟩ (Or.inr rfl) k + (fun j _ => by simpa using lineMem n (b+j)) + simpa using hh + have vertical (n b c : Int) : + Relation.ReflTransGen Q ⟨n*(P.q : Int), b⟩ ⟨n*(P.q : Int), c⟩ := by + by_cases h : b ≤ c + · have hh := verticalUp n b (c-b).toNat + simpa [Int.toNat_of_nonneg (by omega : 0 ≤ c-b)] using hh + · have hh := reverse (verticalUp n c (b-c).toNat) + simpa [Int.toNat_of_nonneg (by omega : 0 ≤ b-c)] using hh + have bridge (n : Int) : + Relation.ReflTransGen Q ⟨n*(P.q : Int), n*(P.q₁ : Int)⟩ + ⟨(n+1)*(P.q : Int), n*(P.q₁ : Int)⟩ := FordWebGeometryProof.bridge P boundary segment + horizVec n + have link (n : Int) : Relation.ReflTransGen Q + ⟨n*(P.q : Int), 0⟩ ⟨(n+1)*(P.q : Int), 0⟩ := + ((vertical n 0 (n*(P.q₁ : Int))).trans (bridge n)).trans + (vertical (n+1) (n*(P.q₁ : Int)) 0) + have lineReach (n : Int) : Relation.ReflTransGen Q 0 ⟨n*(P.q : Int), 0⟩ := + FordWebGeometryProof.lineReach P reverse link n + have reach0 : ∀ x ∈ W, Relation.ReflTransGen Q 0 x := FordWebGeometryProof.reach0 P hq + boundary segment horizVec vertical lineReach + have zeroW : (0 : GaussianInt) ∈ W := by + have hz : (⟨(0 : Int)*(P.q : Int), 0⟩ : GaussianInt) = 0 := by ext <;> simp + exact hz ▸ lineMem 0 0 + refine ⟨⟨0, zeroW⟩, ?_⟩ + intro x hx y hy + have hr := (reverse (reach0 x hx)).trans (reach0 y hy) + obtain ⟨p, hc, hlast⟩ := List.exists_isChain_cons_of_relationReflTransGen hr + refine ⟨x::p, rfl, ?_, ?_, ?_⟩ + · rw [List.getLast?_eq_some_getLast (List.cons_ne_nil x p), hlast] + · exact hc.induction (fun z => z ∈ W) (x::p) + (fun {u z} he _ => he.2.1) (fun _ => hx) + · exact List.isChain_iff_forall_rel_of_append_cons_cons.mp + (hc.imp (fun _ _ he => he.2.2)) + · intro x hx + let n := x.re / (P.q : Int) + let m := -((x.im-n*(P.q₁ : Int)) / (P.q : Int)) + let y := x-t m n + have hyr : y.re = x.re % (P.q : Int) := by + have he := Int.emod_add_mul_ediv x.re (P.q : Int) + dsimp [y, t, n] + nlinarith only [he] + have hyi : y.im = (x.im-n*(P.q₁ : Int)) % (P.q : Int) := by + have he := Int.emod_add_mul_ediv (x.im-n*(P.q₁ : Int)) (P.q : Int) + dsimp [y, t, m] + nlinarith only [he] + have hr := Int.emod_nonneg x.re (ne_of_gt hq) + have hr' := Int.emod_lt_of_pos x.re hq + have hi := Int.emod_nonneg (x.im-n*(P.q₁ : Int)) (ne_of_gt hq) + have hi' := Int.emod_lt_of_pos (x.im-n*(P.q₁ : Int)) hq + have hnb : y ∉ LatticeVertexBoundary (FordVertexDomain P.q) := + fun h => hx ⟨m, n, h⟩ + have hy : y ∈ P4062T1InteriorSquare P.q := by + rw [boundary] at hnb + apply (coords y).mpr + omega + refine ⟨m, n, ?_⟩ + intro z hz + induction hz with + | refl => exact hy + | @tail u v h e ih => + have hu := (coords _).mp ih + have hv : 0 ≤ (v-t m n).re ∧ (v-t m n).re ≤ (P.q : Int) ∧ + 0 ≤ (v-t m n).im ∧ (v-t m n).im ≤ (P.q : Int) := by + rcases e.2.2 with rfl | rfl | rfl | rfl <;> + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_one, Zsqrtd.im_one] at hu ⊢ <;> omega + have hn : v-t m n ∉ LatticeVertexBoundary (FordVertexDomain P.q) := + fun h => e.2.1 ⟨m, n, h⟩ + rw [boundary] at hn + apply (coords _).mpr + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5448T1CanonicalFordBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5448T1CanonicalFordBoundary.lean new file mode 100644 index 0000000000..795f79c7a8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5448T1CanonicalFordBoundary.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic +public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingBelow + +-- [TABLET NODE: P5448T1CanonicalFordBoundary] + +/-! +# P5448T1CanonicalFordBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5448T1CanonicalFordBoundary (F : FordFareyParameter) (hq : 1 < F.q) : + (∀ t : Int, 0 ≤ t → t ≤ F.q → + FordOdometer F ⟨t, 0⟩ = 0 ∧ + FordOdometer F ⟨t, (F.q : Int)⟩ = F.p * t) ∧ + FordOdometer F ⟨(F.q₁ : Int), 1⟩ = F.p₁ ∧ + FordOdometer F ⟨(F.q₂ : Int), (F.q : Int) - 1⟩ = + F.p * (F.q₂ : Int) - F.p₂ := by +-- BODY + have bounds := P5130T5ParentArithmetic F hq + have hqi : (1 : Int) < F.q := by exact_mod_cast hq + have hb := (Classical.choose_spec FordOdometerFamilyExistsUnique).1.2.1 F + change ∀ z, z ∈ FordDoubledBoundary F.q → FordOdometer F z = _ at hb + have edge (t : Int) (ht : 0 ≤ t) (htq : t ≤ F.q) : + FordOdometer F ⟨t, 0⟩ = 0 ∧ + FordOdometer F ⟨t, (F.q : Int)⟩ = F.p * t := by + have hbot : (⟨t, 0⟩ : GaussianInt) ∈ FordDoubledBoundary F.q := by + simp only [FordDoubledBoundary, FordVertexDomain, Set.mem_ofPred_eq] + omega + have htop : (⟨t, (F.q : Int)⟩ : GaussianInt) ∈ FordDoubledBoundary F.q := by + simp only [FordDoubledBoundary, FordVertexDomain, Set.mem_ofPred_eq] + omega + constructor + · rw [hb _ hbot] + simpa using P5188T1CeilingBelow 0 0 (F.q : Int) (by omega) + (by omega) (by omega) + · rw [hb _ htop] + simpa using P5188T1CeilingBelow (F.p * t) 0 (F.q : Int) + (by omega) (by omega) (by omega) + refine ⟨edge, ?_, ?_⟩ + · have hm : (⟨(F.q₁ : Int), 1⟩ : GaussianInt) ∈ FordDoubledBoundary F.q := by + simp only [FordDoubledBoundary, FordVertexDomain, Set.mem_ofPred_eq] + omega + rw [hb _ hm] + have he : F.p * (F.q₁ : Int) * 1 = F.p₁ * (F.q : Int) - 1 := by + nlinarith [F.det₁] + change IntegerCeilDiv (F.p * (F.q₁ : Int) * 1) (F.q : Int) _ = _ + rw [he] + exact P5188T1CeilingBelow F.p₁ 1 (F.q : Int) (by omega) + (by omega) (by omega) + · have hm : (⟨(F.q₂ : Int), (F.q : Int) - 1⟩ : GaussianInt) ∈ + FordDoubledBoundary F.q := by + simp only [FordDoubledBoundary, FordVertexDomain, Set.mem_ofPred_eq] + omega + rw [hb _ hm] + have he : F.p * (F.q₂ : Int) * ((F.q : Int) - 1) = + (F.p * (F.q₂ : Int) - F.p₂) * (F.q : Int) - 1 := by + nlinarith [F.det₂] + change IntegerCeilDiv (F.p * (F.q₂ : Int) * ((F.q : Int) - 1)) + (F.q : Int) _ = _ + rw [he] + exact P5188T1CeilingBelow (F.p * (F.q₂ : Int) - F.p₂) 1 + (F.q : Int) (by omega) (by omega) (by omega) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5448T1CenteredFordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5448T1CenteredFordGeometry.lean new file mode 100644 index 0000000000..016df4d79a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5448T1CenteredFordGeometry.lean @@ -0,0 +1,181 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5472T1FordNormalization +public import LeanPool.ApollonianSuperharmonic.P5472T1CyclicPhaseCovariance +public import LeanPool.ApollonianSuperharmonic.P5472T1LiteralFordPlacement +public import LeanPool.ApollonianSuperharmonic.P5472T1FordSlopeDifference +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryGlobalOdometerTransport + +-- [TABLET NODE: P5448T1CenteredFordGeometry] + +/-! +# P5448T1CenteredFordGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5448T1CenteredFordGeometry + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C0 : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C0 T) + (h : PartialOdometer) + (P : Fin 3 → Bool → ProtoTile) + (r : Fin 3 → Bool → PartialOdometer) + (Q S : Fin 3 → Bool → ProtoTile) + (u v : Fin 3 → Bool → PartialOdometer) + (g : IntegerLatticeFunction) (x : GaussianInt) + (data : BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) + (hext : GlobalOdometerExtends g h) + (hcenter : GaussianRealPoint x = TileCentroid T) + (hzero : (cfg.firstPredecessor 1).1 = 0) : + ∃ (F : FordFareyParameter) (s : BandPackingSymmetry) (delta : Bool) + (f : IntegerLatticeFunction), + let c := BandPackingSymmetryVectorAction s x + let H := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s h) (-c) 0 0 + let U := TileTranslation (BandPackingSymmetryTileAction s (P 0 (!delta))) (-c) + let V := TileTranslation (BandPackingSymmetryTileAction s (P 0 delta)) (-c) + let hp := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 (!delta))) (-c) 0 0 + let hm := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 delta)) (-c) 0 0 + 1 < F.q ∧ + BandPackingSymmetryReversesOrientation s = false ∧ + BandPackingSymmetryScopedPhase s q delta ∧ + BandPackingSymmetryQuadrupleAction s + ![cfg.firstPredecessor 0, cfg.firstPredecessor 2, + cfg.firstPredecessor 3, cfg.firstPredecessor 1] = + FordRecursiveQuadruple F ∧ + U.cells = (TileTranslation (FordTile F.q) ⟨-(F.q₁ : Int), 0⟩).cells ∧ + V.cells = (TileTranslation (FordTile F.q) ⟨-(F.q₂ : Int), -(F.q : Int)⟩).cells ∧ + TileOdometer (FordCircleCoordinate F.p F.q) U hp ∧ + TileOdometer (FordCircleCoordinate F.p F.q) V hm ∧ + (∀ z : GaussianInt, z ∈ hp.domain ↔ + -(F.q₁ : Int) ≤ z.re ∧ z.re ≤ F.q₂ ∧ 0 ≤ z.im ∧ z.im ≤ F.q) ∧ + (∀ z : GaussianInt, z ∈ hm.domain ↔ + -(F.q₂ : Int) ≤ z.re ∧ z.re ≤ F.q₁ ∧ -(F.q : Int) ≤ z.im ∧ z.im ≤ 0) ∧ + (∃ sp sm : Real × Real, + PartialOdometerSlope hp = some sp ∧ PartialOdometerSlope hm = some sm ∧ + sm.1 - sp.1 = -(F.p : Real) ∧ sm.2 - sp.2 = (F.p₁ : Real) - F.p₂) ∧ + (∀ z, z ∈ hp.domain → z ∈ H.domain ∧ H.value z = hp.value z) ∧ + (∀ z, z ∈ hm.domain → z ∈ H.domain ∧ H.value z = hm.value z) ∧ + GlobalOdometerExtends f H ∧ + FourNeighborLaplacian f 0 = FourNeighborLaplacian g x := by +-- BODY + obtain ⟨F, s, hFq, hrev, hword, hford, hrootCircle, hW, hA⟩ := + P5472T1FordNormalization q cfg hzero + obtain ⟨delta, hphase, hcyclic⟩ := + P5472T1CyclicPhaseCovariance s q cfg.proper hrev hword + have hplacement := P5472T1LiteralFordPlacement q cfg C0 T cert h P r Q S u v g x + data hcenter F s delta hrev hword hphase hrootCircle hW + have hslope := P5472T1FordSlopeDifference q cfg C0 T cert h P r Q S u v g x + data F s delta hword hrootCircle hA (by + dsimp only + rw [hcyclic] + split <;> rfl) + let c := BandPackingSymmetryVectorAction s x + let H := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s h) (-c) 0 0 + let U := TileTranslation (BandPackingSymmetryTileAction s (P 0 (!delta))) (-c) + let V := TileTranslation (BandPackingSymmetryTileAction s (P 0 delta)) (-c) + let hp := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 (!delta))) (-c) 0 0 + let hm := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 delta)) (-c) 0 0 + obtain ⟨g', hext', hlap'⟩ := + BandPackingSymmetryGlobalOdometerTransport s g h x hext + let f : IntegerLatticeFunction := fun z => g' (z + c) + have hextH : GlobalOdometerExtends f H := by + obtain ⟨K, hK⟩ := hext' + refine ⟨K, ?_⟩ + intro z hz + have hz' : z + c ∈ + (BandPackingSymmetryPartialOdometerAction s h).domain := by + have hmem := (PartialOdometerAffineTranslateFormulas + (BandPackingSymmetryPartialOdometerAction s h) (-c) 0 0).2.1 z + have := hmem.mp hz + simpa using this + have hv := hK (z + c) hz' + have hv' := (PartialOdometerAffineTranslateFormulas + (BandPackingSymmetryPartialOdometerAction s h) (-c) 0 0).2.2.1 z hz + change g' (z + c) = H.value z + K + rw [hv, hv'] + simp [sub_neg_eq_add, zero_mul, Zsqrtd.re_zero, Zsqrtd.im_zero] + have hlap : FourNeighborLaplacian f 0 = FourNeighborLaplacian g x := by + have hh := hlap' + change FourNeighborLaplacian g' c = FourNeighborLaplacian g x at hh + simpa [f, FourNeighborLaplacian, c, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hh + have restrictShift (w : GaussianInt) (a b : PartialOdometer) + (hd : ∀ z, z ∈ a.domain → z ∈ b.domain ∧ b.value z = a.value z) : + ∀ z, z ∈ (BandPackingSymmetryPartialOdometerAction (.shift w) a).domain → + z ∈ (BandPackingSymmetryPartialOdometerAction (.shift w) b).domain ∧ + (BandPackingSymmetryPartialOdometerAction (.shift w) b).value z = + (BandPackingSymmetryPartialOdometerAction (.shift w) a).value z := by + intro z hz + change z ∈ a.domain at hz + obtain ⟨hz', hv⟩ := hd z hz + refine ⟨hz', ?_⟩ + simp only [BandPackingSymmetryPartialOdometerAction, ite_eq_left hz, ite_eq_left hz', hv] + have restrictNegate (a b : PartialOdometer) + (hd : ∀ z, z ∈ a.domain → z ∈ b.domain ∧ b.value z = a.value z) : + ∀ z, z ∈ (BandPackingSymmetryPartialOdometerAction .negate a).domain → + z ∈ (BandPackingSymmetryPartialOdometerAction .negate b).domain ∧ + (BandPackingSymmetryPartialOdometerAction .negate b).value z = + (BandPackingSymmetryPartialOdometerAction .negate a).value z := by + intro z hz + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hz + change GaussianQuarterTurn y ∈ a.domain.image GaussianQuarterTurn at hz + obtain ⟨hy', hv⟩ := hd y hy + have hz' : GaussianQuarterTurn y ∈ b.domain.image GaussianQuarterTurn := + Finset.mem_image.mpr ⟨y, hy', rfl⟩ + refine ⟨hz', ?_⟩ + have inv : -GaussianQuarterTurn (GaussianQuarterTurn y) = y := by + ext <;> simp [GaussianQuarterTurn] + simp only [BandPackingSymmetryPartialOdometerAction, ite_eq_left hz, + ite_eq_left hz', inv, hv] + have hrestriction (b : Bool) : + ∀ z, z ∈ (PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 b)) (-c) 0 0).domain → + z ∈ H.domain ∧ H.value z = + (PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 b)) (-c) 0 0).value z := by + have hd : ∀ z, z ∈ (r 0 b).domain → z ∈ h.domain ∧ h.value z = (r 0 b).value z := by + intro z hz + exact ⟨(data.hPdom z).mpr ⟨0, b, hz⟩, data.hPvalue 0 b z hz⟩ + have hd' : ∀ z, z ∈ (BandPackingSymmetryPartialOdometerAction s (r 0 b)).domain → + z ∈ (BandPackingSymmetryPartialOdometerAction s h).domain ∧ + (BandPackingSymmetryPartialOdometerAction s h).value z = + (BandPackingSymmetryPartialOdometerAction s (r 0 b)).value z := by + rcases hword with ⟨w, hs | hs⟩ + · rw [hs] + exact restrictShift w _ _ hd + · rw [hs] + exact restrictShift w _ _ (restrictNegate _ _ hd) + intro z hz + have hz0 := (PartialOdometerAffineTranslateFormulas _ (-c) 0 0).2.1 z |>.mp hz + obtain ⟨hz1, hv⟩ := hd' (z - -c) hz0 + have hzH : z ∈ H.domain := + (PartialOdometerAffineTranslateFormulas _ (-c) 0 0).2.1 z |>.mpr hz1 + refine ⟨hzH, ?_⟩ + rw [(PartialOdometerAffineTranslateFormulas _ (-c) 0 0).2.2.1 z hzH, + (PartialOdometerAffineTranslateFormulas _ (-c) 0 0).2.2.1 z hz, hv] + refine ⟨F, s, delta, f, hFq, hrev, hphase, hford, ?_⟩ + exact ⟨hplacement.1, hplacement.2.1, hplacement.2.2.1, + hplacement.2.2.2.1, hplacement.2.2.2.2.1, hplacement.2.2.2.2.2, + hslope, hrestriction (!delta), hrestriction delta, hextH, hlap⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5448T1CommonAffineFordPair.lean b/LeanPool/ApollonianSuperharmonic/P5448T1CommonAffineFordPair.lean new file mode 100644 index 0000000000..f04747f9f9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5448T1CommonAffineFordPair.lean @@ -0,0 +1,165 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.P5448T1CanonicalFordBoundary +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: P5448T1CommonAffineFordPair] + +/-! +# P5448T1CommonAffineFordPair + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5448T1CommonAffineFordPair + (F : FordFareyParameter) (hq : 1 < F.q) + (U V : ProtoTile) (hp hm : PartialOdometer) + (hplus : TileOdometer (FordCircleCoordinate F.p F.q) U hp) + (hminus : TileOdometer (FordCircleCoordinate F.p F.q) V hm) + (hdp : ∀ z : GaussianInt, z ∈ hp.domain ↔ + -(F.q₁ : Int) ≤ z.re ∧ z.re ≤ F.q₂ ∧ 0 ≤ z.im ∧ z.im ≤ F.q) + (hdm : ∀ z : GaussianInt, z ∈ hm.domain ↔ + -(F.q₂ : Int) ≤ z.re ∧ z.re ≤ F.q₁ ∧ -(F.q : Int) ≤ z.im ∧ z.im ≤ 0) + (sp sm : Real × Real) + (hsp : PartialOdometerSlope hp = some sp) + (hsm : PartialOdometerSlope hm = some sm) + (hsx : sm.1 - sp.1 = -(F.p : Real)) + (hsy : sm.2 - sp.2 = (F.p₁ : Real) - F.p₂) + (hshared : hp.value 0 = hm.value 0) : + ∃ (a : GaussianInt) (b : Int), + (∀ z, z ∈ hp.domain → hp.value z = + FordOdometer F (z + ⟨(F.q₁ : Int), 0⟩) - F.p₁ * z.im + + a.re * z.re + a.im * z.im + b) ∧ + (∀ z, z ∈ hm.domain → hm.value z = + FordOdometer F (z + ⟨(F.q₂ : Int), (F.q : Int)⟩) - + F.p * z.re - F.p₂ * z.im - F.p * (F.q₂ : Int) + + a.re * z.re + a.im * z.im + b) := by +-- BODY + obtain ⟨k, hk, hkd, hkv⟩ := FordTileOdometerRestriction F + have hC : 0 < (FordCircleCoordinate F.p F.q).1 := by + simp only [FordCircleCoordinate, Nat.cast_mul] + positivity + obtain ⟨up, ⟨_, _, ap, bp, dp, vp⟩, _⟩ := + TileOdometerTranslationUniqueness _ U (FordTile F.q) hp k hC hplus hk + obtain ⟨um, ⟨_, _, am, bm, dm, vm⟩, _⟩ := + TileOdometerTranslationUniqueness _ V (FordTile F.q) hm k hC hminus hk + have kmem (z : GaussianInt) : z ∈ k.domain ↔ z ∈ FordVertexDomain F.q := + Set.ext_iff.mp hkd z + have k0 : (0 : GaussianInt) ∈ k.domain := by + rw [kmem] + simp [FordVertexDomain] + have kqq : (⟨(F.q : Int), (F.q : Int)⟩ : GaussianInt) ∈ k.domain := by + rw [kmem] + simp [FordVertexDomain] + have hsum : (F.q : Int) = F.q₁ + F.q₂ := by exact_mod_cast F.sum_q + have hup : up = ⟨-(F.q₁ : Int), 0⟩ := by + have h0 := (hdp up).mp ((dp up).mpr (by simpa using k0)) + have h1 := (hdp (up + ⟨(F.q : Int), (F.q : Int)⟩)).mp + ((dp _).mpr (by simpa using kqq)) + apply Zsqrtd.ext <;> dsimp at h0 h1 ⊢ <;> omega + have hum : um = ⟨-(F.q₂ : Int), -(F.q : Int)⟩ := by + have h0 := (hdm um).mp ((dm um).mpr (by simpa using k0)) + have h1 := (hdm (um + ⟨(F.q : Int), (F.q : Int)⟩)).mp + ((dm _).mpr (by simpa using kqq)) + apply Zsqrtd.ext <;> dsimp at h0 h1 ⊢ <;> omega + have affineEq (l : PartialOdometer) (w a : GaussianInt) (b : Int) + (hd : ∀ z, z ∈ l.domain ↔ z - w ∈ k.domain) + (hv : ∀ z, z ∈ l.domain → + l.value z = k.value (z - w) + a.re * z.re + a.im * z.im + b) : + l = PartialOdometerAffineTranslate k w a b := by + have he : l.domain = (PartialOdometerAffineTranslate k w a b).domain := by + ext z + rw [(PartialOdometerAffineTranslateFormulas k w a b).2.1] + exact hd z + have ve : l.value = (PartialOdometerAffineTranslate k w a b).value := by + funext z + by_cases hz : z ∈ l.domain + · rw [hv z hz, (PartialOdometerAffineTranslateFormulas k w a b).2.2.1 z + (by rwa [← he])] + · rw [l.value_outside z hz, + (PartialOdometerAffineTranslate k w a b).value_outside z (by rwa [← he])] + have same : ∀ l m : PartialOdometer, + l.domain = m.domain → l.value = m.value → l = m := by + rintro ⟨ld, lv, lo⟩ ⟨md, mv, mo⟩ hd hv + dsimp at hd hv + cases hd + cases hv + rfl + exact same _ _ he ve + have heP := affineEq hp up ap bp dp vp + have heM := affineEq hm um am bm dm vm + have slP := (PartialOdometerAffineTranslateFormulas k up ap bp).2.2.2.2.2 + have slM := (PartialOdometerAffineTranslateFormulas k um am bm).2.2.2.2.2 + rw [← heP, hsp] at slP + rw [← heM, hsm] at slM + obtain ⟨sk, hsk⟩ : ∃ sk, PartialOdometerSlope k = some sk := by + cases hs : PartialOdometerSlope k with + | none => simp [hs] at slP + | some sk => exact ⟨sk, rfl⟩ + have eqP : sp = (sk.1 + (ap.re : Real), sk.2 + (ap.im : Real)) := + Option.some.inj (by simpa [hsk] using slP) + have eqM : sm = (sk.1 + (am.re : Real), sk.2 + (am.im : Real)) := + Option.some.inj (by simpa [hsk] using slM) + have ax : am.re = ap.re - F.p := by + apply Int.cast_injective (α := Real) + push_cast + rw [eqP, eqM] at hsx + dsimp at hsx + linarith + have ay : am.im = ap.im + F.p₁ - F.p₂ := by + apply Int.cast_injective (α := Real) + push_cast + rw [eqP, eqM] at hsy + dsimp at hsy + linarith + have valP (z : GaussianInt) (hz : z ∈ hp.domain) : hp.value z = + FordOdometer F (z + ⟨(F.q₁ : Int), 0⟩) + + ap.re * z.re + ap.im * z.im + bp := by + have he : z - up = z + ⟨(F.q₁ : Int), 0⟩ := by + rw [hup] + ext <;> simp + rw [vp z hz, hkv _ ((dp z).mp hz), he] + have valM (z : GaussianInt) (hz : z ∈ hm.domain) : hm.value z = + FordOdometer F (z + ⟨(F.q₂ : Int), (F.q : Int)⟩) + + am.re * z.re + am.im * z.im + bm := by + have he : z - um = z + ⟨(F.q₂ : Int), (F.q : Int)⟩ := by + rw [hum] + ext <;> simp + rw [vm z hz, hkv _ ((dm z).mp hz), he] + have hp0 := (hdp 0).mpr (by simp) + have hm0 := (hdm 0).mpr (by simp) + have bounds := P5130T5ParentArithmetic F hq + have edge := (P5448T1CanonicalFordBoundary F hq).1 + have p0 := valP 0 hp0 + have m0 := valM 0 hm0 + simp only [zero_add, Zsqrtd.re_zero, Zsqrtd.im_zero, mul_zero, add_zero, + (edge (F.q₁ : Int) (by omega) (by omega)).1, + (edge (F.q₂ : Int) (by omega) (by omega)).2] at p0 m0 + have bc : bm = bp - F.p * (F.q₂ : Int) := by omega + refine ⟨⟨ap.re, ap.im + F.p₁⟩, bp, ?_, ?_⟩ + · intro z hz + rw [valP z hz] + dsimp + ring + · intro z hz + rw [valM z hz, ax, ay, bc] + dsimp + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2AlignedPredecessor.lean b/LeanPool/ApollonianSuperharmonic/P5455T2AlignedPredecessor.lean new file mode 100644 index 0000000000..b509016d9f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5455T2AlignedPredecessor.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5455T2CurvatureGrowth +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision + +-- [TABLET NODE: P5455T2AlignedPredecessor] + +/-! +# P5455T2AlignedPredecessor + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5455T2AlignedPredecessor + (p p' : Fin 4 → CircleCoordinates) + (hp : ProperBandQuadruple p) (hp' : ProperBandQuadruple p') + (hchild : P4828T1Step p 0 = P4828T1Step p' 0) : + p = p' := by +-- BODY + obtain ⟨r, hr, _⟩ := BandPredecessorNoCollision _ _ + (P5455T2CurvatureGrowth p hp).2.1 + (P5455T2CurvatureGrowth p' hp').2.1 hchild + have e0 := hr 0 + have e1 := hr 1 + have e2 := hr 2 + have rzero : r = 0 := by + fin_cases r + · rfl + · have a := hp.2 1 + have b := hp'.2 2 + change (p 2).1 < (p 0).1 at a + change (p' 3).1 < (p' 0).1 at b + simp? [P4828T1Step] at e0 e2 + rw [e0, e2] at b + omega + · have a := hp.2 2 + have b := hp'.2 1 + change (p 3).1 < (p 0).1 at a + change (p' 2).1 < (p' 0).1 at b + simp? [P4828T1Step] at e0 e1 + rw [e0, e1] at b + omega + subst r + simp? [P4828T1Step] at e0 e1 e2 + have cx := congrArg Prod.fst hchild + have wx := congrArg Prod.snd hchild + simp only [P4828T1Step, Matrix.cons_val_zero] at cx wx + rw [e0, e1, e2] at cx wx + have removed : p 1 = p' 1 := by + apply Prod.ext + · omega + · linear_combination -wx + funext k + fin_cases k + · exact e0.symm + · exact removed + · exact e1.symm + · exact e2.symm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2CurvatureGrowth.lean b/LeanPool/ApollonianSuperharmonic/P5455T2CurvatureGrowth.lean new file mode 100644 index 0000000000..38ddf6252b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5455T2CurvatureGrowth.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification +public import LeanPool.ApollonianSuperharmonic.P4828T1Step + +-- [TABLET NODE: P5455T2CurvatureGrowth] + +/-! +# P5455T2CurvatureGrowth + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5455T2CurvatureGrowth (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) : + 4 ≤ (q 0).1 ∧ ProperBandQuadruple (P4828T1Step q) ∧ + (q 0).1 < (P4828T1Step q 0).1 := by +-- BODY + have lower : ∀ p, SemiProperQuadruple p → + ProperBandQuadruple p → 4 ≤ (p 0).1 := by + intro p hs + induction hs with + | base z => + intro hp + have bad := hp.2 0 + norm_num at bad + | @rotate p hs ih => + intro hp + apply ih + refine ⟨hs, ?_⟩ + intro j + fin_cases j + · simpa using hp.2 2 + · simpa using hp.2 0 + · simpa using hp.2 1 + | @successor p hs ih => + intro hp + rcases (SemiProperForestClassification p hs).2 with root | root | root | old + · obtain ⟨z, hz⟩ := root + have bad := hp.2 0 + simp [hz] at bad + · obtain ⟨z, hz⟩ := root + simp [hz] + · obtain ⟨z, hz⟩ := root + simp [hz] + · have bound := ih old + have strict := old.2 0 + change (p 1).1 < (p 0).1 at strict + have nonneg := (SemiProperForestClassification p hs).1 + have n2 := nonneg 2 + have n3 := nonneg 3 + dsimp + omega + have bound := lower q hq.1 hq + have strict := hq.2 0 + change (q 1).1 < (q 0).1 at strict + have nonneg := (SemiProperForestClassification q hq.1).1 + have n2 := nonneg 2 + have n3 := nonneg 3 + have growth : (q 0).1 < (P4828T1Step q 0).1 := by + dsimp [P4828T1Step] + omega + refine ⟨bound, ?_, growth⟩ + rcases BandSuccessorClassification q hq.1 with bad | good + · change (P4828T1Step q 0).1 = 1 at bad + omega + · exact good.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2LeftRegressions.lean b/LeanPool/ApollonianSuperharmonic/P5455T2LeftRegressions.lean new file mode 100644 index 0000000000..d3d58bf58e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5455T2LeftRegressions.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5455T2CurvatureGrowth +public import LeanPool.ApollonianSuperharmonic.P5455T2OccurrenceRotation +public import LeanPool.ApollonianSuperharmonic.P4828T1LeftRootGeometry + +-- [TABLET NODE: P5455T2LeftRegressions] + +/-! +# P5455T2LeftRegressions + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5455T2LeftRegressions (z : GaussianInt) : + let q : Fin 4 → CircleCoordinates := + ![(12, 7 + 24 * z + 12 * ⟨0, 1⟩), + (4, 1 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (1, 1 + 2 * z)] + let q' : Fin 4 → CircleCoordinates := + ![(24, 17 + 48 * z + 24 * ⟨0, 1⟩), + (12, 7 + 24 * z + 12 * ⟨0, 1⟩), + (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (1, 1 + 2 * z)] + ProperBandQuadruple q ∧ PrimitiveVectorOrientation (q 2) (q 3) ∧ + UnitOccurrenceOrientation q 1 false ∧ UnitOccurrenceOrientation q 2 true ∧ + ProperBandQuadruple q' ∧ PrimitiveVectorOrientation (q' 2) (q' 3) ∧ + UnitOccurrenceOrientation q' 1 false ∧ UnitOccurrenceOrientation q' 2 true := by +-- BODY + dsimp only + let L := P4828T1Root z false + let p : Fin 4 → CircleCoordinates := ![L 0, L 2, L 3, L 1] + let q : Fin 4 → CircleCoordinates := + ![(12, 7 + 24 * z + 12 * ⟨0, 1⟩), + (4, 1 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (1, 1 + 2 * z)] + have hp : ProperBandQuadruple p := by + convert P4828T1RotationLaws.2.2 L 1 (P4828T1LeftRootGeometry z).1 using 1 + funext k + fin_cases k <;> rfl + have oldB : UnitOccurrenceOrientation p 1 false := by + have h := (P5455T2OccurrenceRotation L 2 1 false).mpr + (UnitOccurrenceOrientation.leftUpper z) + convert h using 1 + · funext k + fin_cases k <;> rfl + · decide +kernel + have oldD : UnitOccurrenceOrientation p 2 true := by + have h := (P5455T2OccurrenceRotation L 0 1 true).mpr + (UnitOccurrenceOrientation.leftLower z) + convert h using 1 + · funext k + fin_cases k <;> rfl + · decide +kernel + have eq : P4828T1Step p = q := by + funext k + fin_cases k <;> simp [P4828T1Step, p, L, P4828T1Root, q]; ring + have direction : PrimitiveVectorOrientation (p 2) (p 3) := .base10 z + have hq : ProperBandQuadruple q := eq ▸ (P5455T2CurvatureGrowth p hp).2.1 + have hB : UnitOccurrenceOrientation q 1 false := by + rw [← eq] + exact .retainSecondToThird hp rfl direction oldB + have hD : UnitOccurrenceOrientation q 2 true := by + rw [← eq] + exact .retainThirdFromSecond hp rfl direction oldD + have eq' : P4828T1Step q = + ![(24, 17 + 48 * z + 24 * ⟨0, 1⟩), + (12, 7 + 24 * z + 12 * ⟨0, 1⟩), + (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (1, 1 + 2 * z)] := by + funext k + fin_cases k <;> simp [P4828T1Step, q]; ring + refine ⟨hq, PrimitiveVectorOrientation.base10 z, hB, hD, ?_, + PrimitiveVectorOrientation.base10 z, ?_, ?_⟩ + · rw [← eq'] + exact (P5455T2CurvatureGrowth q hq).2.1 + · rw [← eq'] + exact .retainSecondToThird hq rfl (.base10 z) hB + · rw [← eq'] + exact .retainThirdFromSecond hq rfl (.base10 z) hD + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean new file mode 100644 index 0000000000..7d3ab0e07a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean @@ -0,0 +1,348 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5455T2CurvatureGrowth +public import LeanPool.ApollonianSuperharmonic.P5455T2OccurrenceRotation +public import LeanPool.ApollonianSuperharmonic.P5455T2RootAlignment +public import LeanPool.ApollonianSuperharmonic.P5455T2AlignedPredecessor +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique + +-- [TABLET NODE: P5455T2OccurrenceDeterministic] + +/-! +# P5455T2OccurrenceDeterministic + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OccurrenceDeterministicProof + +private theorem Normalize : + ∀ {q : Fin 4 → CircleCoordinates}, ∀ {i : Fin 3}, ∀ {o : Bool}, UnitOccurrenceOrientation q i + o → + ∃ (t : Fin 4 → CircleCoordinates) (r j : Fin 3), + q = P4828T1Rotate t r ∧ i = j - r ∧ + ((∃ z, t = P4828T1Root z false ∧ + ((j = 0 ∧ o = true) ∨ (j = 2 ∧ o = false))) ∨ + (∃ z, t = P4828T1Root z true ∧ + ((j = 0 ∧ o = true) ∨ (j = 1 ∧ o = false))) ∨ + (∃ p e, ProperBandQuadruple p ∧ t = P4828T1Step p ∧ + ((j = 1 ∧ UnitOccurrenceOrientation p 1 e ∧ + (((p 3).1 ≠ 1 ∧ o = e) ∨ + ((p 3).1 = 1 ∧ PrimitiveVectorOrientation (p 2) (p 3) ∧ o = false) ∨ + ((p 3).1 = 1 ∧ PrimitiveVectorOrientation (p 3) (p 2) ∧ o = true))) ∨ + (j = 2 ∧ UnitOccurrenceOrientation p 2 e ∧ + (((p 2).1 ≠ 1 ∧ o = e) ∨ + ((p 2).1 = 1 ∧ PrimitiveVectorOrientation (p 2) (p 3) ∧ o = true) ∨ + ((p 2).1 = 1 ∧ PrimitiveVectorOrientation (p 3) (p 2) ∧ o = false)))))) := by + classical + intro q i o h + induction h with + | leftLower z => + let t := P4828T1Root z false + refine ⟨t, 0, 0, ?_, rfl, Or.inl ⟨z, rfl, Or.inl ⟨rfl, rfl⟩⟩⟩ + rw [P4828T1RotationLaws.1] + rfl + | leftUpper z => + let t := P4828T1Root z false + refine ⟨t, 0, 2, ?_, rfl, Or.inl ⟨z, rfl, Or.inr ⟨rfl, rfl⟩⟩⟩ + rw [P4828T1RotationLaws.1] + rfl + | rightUpper z => + let t := P4828T1Root z true + refine ⟨t, 0, 0, ?_, rfl, Or.inr (Or.inl ⟨z, rfl, Or.inl ⟨rfl, rfl⟩⟩)⟩ + rw [P4828T1RotationLaws.1] + rfl + | rightLower z => + let t := P4828T1Root z true + refine ⟨t, 0, 1, ?_, rfl, Or.inr (Or.inl ⟨z, rfl, Or.inr ⟨rfl, rfl⟩⟩)⟩ + rw [P4828T1RotationLaws.1] + rfl + | @rotate q i o h ih => + obtain ⟨t, r, j, hq, hi, hc⟩ := ih + refine ⟨t, 1 + r, j, ?_, ?_, hc⟩ + · have hrot : ![q 0, q 2, q 3, q 1] = P4828T1Rotate q 1 := by + funext k + fin_cases k <;> rfl + rw [hrot, hq, P4828T1RotationLaws.2.1] + · rw [hi] + fin_cases j <;> fin_cases r <;> rfl + | @retainSecondToThird p o hp hu horient h ih => + refine ⟨P4828T1Step p, 0, 1, ?_, rfl, Or.inr (Or.inr ⟨p, o, hp, rfl, Or.inl ⟨rfl, h, + Or.inr (Or.inl ⟨hu, horient, rfl⟩)⟩⟩)⟩ + · funext k; fin_cases k <;> rfl + | @retainSecondFromThird p o hp hu horient h ih => + refine ⟨P4828T1Step p, 0, 1, ?_, rfl, Or.inr (Or.inr ⟨p, o, hp, rfl, Or.inl ⟨rfl, h, + Or.inr (Or.inr ⟨hu, horient, rfl⟩)⟩⟩)⟩ + · funext k; fin_cases k <;> rfl + | @retainSecondOther p o hp hu h ih => + refine ⟨P4828T1Step p, 0, 1, ?_, rfl, Or.inr (Or.inr ⟨p, o, hp, rfl, Or.inl ⟨rfl, h, + Or.inl ⟨hu, rfl⟩⟩⟩)⟩ + · funext k; fin_cases k <;> rfl + | @retainThirdFromSecond p o hp hu horient h ih => + refine ⟨P4828T1Step p, 0, 2, ?_, rfl, Or.inr (Or.inr ⟨p, o, hp, rfl, Or.inr ⟨rfl, h, + Or.inr (Or.inl ⟨hu, horient, rfl⟩)⟩⟩)⟩ + · funext k; fin_cases k <;> rfl + | @retainThirdToSecond p o hp hu horient h ih => + refine ⟨P4828T1Step p, 0, 2, ?_, rfl, Or.inr (Or.inr ⟨p, o, hp, rfl, Or.inr ⟨rfl, h, + Or.inr (Or.inr ⟨hu, horient, rfl⟩)⟩⟩)⟩ + · funext k; fin_cases k <;> rfl + | @retainThirdOther p o hp hu h ih => + refine ⟨P4828T1Step p, 0, 2, ?_, rfl, Or.inr (Or.inr ⟨p, o, hp, rfl, Or.inr ⟨rfl, h, + Or.inl ⟨hu, rfl⟩⟩⟩)⟩ + · funext k; fin_cases k <;> rfl + +private theorem noMix : + (Fin 4 → CircleCoordinates) → ((Fin 3) → (∀ z s r p, ProperBandQuadruple p → ∀ r', + P4828T1Rotate (P4828T1Root z s) r = + P4828T1Rotate (P4828T1Step p) r' → False)) := by + classical + intro q i z s r p hp r' heq + have hc := congrArg (fun x : Fin 4 → CircleCoordinates => (x 0).1) heq + simp only [P4828T1Rotate, Fin.cases_zero] at hc + have hg := P5455T2CurvatureGrowth p hp + cases s <;> simp [P4828T1Root] at hc <;> omega + +private theorem rotUnique : + ∀ t, ProperBandQuadruple t → ∀ r r', + P4828T1Rotate t r = P4828T1Rotate t r' → r = r' := by + classical + intro t ht r r' heq + obtain ⟨d, hd, huniq⟩ := BandPredecessorNoCollision t t ht ht rfl + have hzero : ∀ j : Fin 3, t j.succ = t ((j + 0).succ) := by + intro j + simp + have hdzero := huniq 0 hzero + have hcyc : ∀ j : Fin 3, t j.succ = t ((j + (r' - r)).succ) := by + intro j + have hh := congrFun heq ((j - r).succ) + have hidx₁ : (j - r) + r = j := sub_add_cancel j r + have hidx₂ : (j - r) + r' = j + (r' - r) := by + abel + simpa only [P4828T1Rotate, Fin.cases_succ, hidx₁, hidx₂] using hh + have hdd := huniq (r' - r) hcyc + have hdiff : r' - r = 0 := hdd.trans hdzero.symm + exact (sub_eq_zero.mp hdiff).symm + +private theorem main : + (∀ {q : Fin 4 → CircleCoordinates}, ∀ + {i : Fin 3}, ∀ {o : Bool}, UnitOccurrenceOrientation q i o → ∃ (t : Fin 4 → + CircleCoordinates) (r j : Fin 3), q = P4828T1Rotate t r ∧ i = j - r ∧ ((∃ z, t = + P4828T1Root z false ∧ ((j = 0 ∧ o = true) ∨ (j = 2 ∧ o = false))) ∨ (∃ z, t = + P4828T1Root z true ∧ ((j = 0 ∧ o = true) ∨ (j = 1 ∧ o = false))) ∨ (∃ p e, + ProperBandQuadruple p ∧ t = P4828T1Step p ∧ ((j = 1 ∧ UnitOccurrenceOrientation p 1 e ∧ + (((p 3).1 ≠ 1 ∧ o = e) ∨ ((p 3).1 = 1 ∧ PrimitiveVectorOrientation (p 2) (p 3) ∧ o = + false) ∨ ((p 3).1 = 1 ∧ PrimitiveVectorOrientation (p 3) (p 2) ∧ o = true))) ∨ (j = 2 ∧ + UnitOccurrenceOrientation p 2 e ∧ (((p 2).1 ≠ 1 ∧ o = e) ∨ ((p 2).1 = 1 ∧ + PrimitiveVectorOrientation (p 2) (p 3) ∧ o = true) ∨ ((p 2).1 = 1 ∧ + PrimitiveVectorOrientation (p 3) (p 2) ∧ o = false))))))) → ((∀ z s r p, + ProperBandQuadruple p → ∀ r', P4828T1Rotate (P4828T1Root z s) r = P4828T1Rotate + (P4828T1Step p) r' → False) → ((∀ t, ProperBandQuadruple t → ∀ r r', P4828T1Rotate t + r = P4828T1Rotate t r' → r = r') → (∀ n : Nat, ∀ q : Fin 4 → CircleCoordinates, + ProperBandQuadruple q → ∀ i : Fin 3, (q i.succ).1 = 1 → + ∀ a b : Bool, UnitOccurrenceOrientation q i a → + UnitOccurrenceOrientation q i b → (q 0).1.toNat = n → a = b))) := by + classical + intro Normalize noMix rotUnique n + induction n using Nat.strong_induction_on with + | h n ih => + intro q hq i hi a b ha hb hn + obtain ⟨t, r, j, hqa, hia, enda⟩ := Normalize ha + obtain ⟨t', r', j', hqb, hib, endb⟩ := Normalize hb + have hrot : P4828T1Rotate t r = P4828T1Rotate t' r' := hqa.symm.trans hqb + rcases enda with rootA | rootA | retainA + · rcases rootA with ⟨z, hta, rowA⟩ + rcases endb with rootB | rootB | retainB + · rcases rootB with ⟨z', htb, rowB⟩ + have align := P5455T2RootAlignment z z' false false r r' (by simpa [hta, htb] using hrot) + rcases align with ⟨hz, _, hr⟩ + subst z' + have hjEq : j = j' := by + calc + j = (j - r) + r := by simp + _ = (j' - r') + r' := by rw [← hia, ← hib, hr] + _ = j' := sub_add_cancel j' r' + have hrEq := hr + rcases rowA with ⟨hj, ho⟩ | ⟨hj, ho⟩ <;> + rcases rowB with ⟨hj', ho'⟩ | ⟨hj', ho'⟩ <;> simp_all + · rcases rootB with ⟨z', htb, rowB⟩ + have align := P5455T2RootAlignment z z' false true r r' (by simpa [hta, htb] using hrot) + rcases align with ⟨_, ⟨hs, _⟩⟩ + cases hs + · rcases retainB with ⟨p', e', hp', htb, rowB⟩ + exact False.elim (noMix z false r p' hp' r' (by simpa [hta, htb] using hrot)) + · rcases rootA with ⟨z, hta, rowA⟩ + rcases endb with rootB | rootB | retainB + · rcases rootB with ⟨z', htb, rowB⟩ + have align := P5455T2RootAlignment z z' true false r r' (by simpa [hta, htb] using hrot) + rcases align with ⟨_, ⟨hs, _⟩⟩ + cases hs + · rcases rootB with ⟨z', htb, rowB⟩ + have align := P5455T2RootAlignment z z' true true r r' (by simpa [hta, htb] using hrot) + rcases align with ⟨hz, _, hr⟩ + subst z' + have hjEq : j = j' := by + calc + j = (j - r) + r := by simp + _ = (j' - r') + r' := by rw [← hia, ← hib, hr] + _ = j' := sub_add_cancel j' r' + rcases rowA with ⟨hj, ho⟩ | ⟨hj, ho⟩ <;> + rcases rowB with ⟨hj', ho'⟩ | ⟨hj', ho'⟩ <;> simp_all + · rcases retainB with ⟨p', e', hp', htb, rowB⟩ + exact False.elim (noMix z true r p' hp' r' (by simpa [hta, htb] using hrot)) + · rcases retainA with ⟨p, e, hp, hta, rowA⟩ + rcases endb with rootB | rootB | retainB + · rcases rootB with ⟨z', htb, rowB⟩ + exact False.elim (noMix z' false r' p hp r (by simpa [hta, htb] using hrot.symm)) + · rcases rootB with ⟨z', htb, rowB⟩ + exact False.elim (noMix z' true r' p hp r (by simpa [hta, htb] using hrot.symm)) + · rcases retainB with ⟨p', e', hp', htb, rowB⟩ + have hchild : P4828T1Step p 0 = P4828T1Step p' 0 := by + have hc := congrArg (fun x : Fin 4 → CircleCoordinates => x 0) hrot + simpa [hta, htb, P4828T1Rotate] using hc + have heqP := P5455T2AlignedPredecessor p p' hp hp' hchild + subst p' + have hstepProper := (P5455T2CurvatureGrowth p hp).2.1 + have hr : r = r' := rotUnique (P4828T1Step p) hstepProper r r' (by simpa [hta, htb] + using hrot) + have hjEq : j = j' := by + calc + j = (j - r) + r := by simp + _ = (j' - r') + r := by rw [← hia, ← hib, hr] + _ = (j' - r') + r' := by rw [hr] + _ = j' := sub_add_cancel j' r' + have hcurv : (q 0).1 = (P4828T1Step p 0).1 := by + have hh := congrFun hqa 0 + simpa [hta, P4828T1Rotate] using congrArg Prod.fst hh + have hlt : (p 0).1.toNat < n := by + have hg := (P5455T2CurvatureGrowth p hp) + rw [hcurv] at hn + omega + have hnpre : (p 0).1.toNat = (p 0).1.toNat := rfl + rcases rowA with ⟨hj, hpre, stateA⟩ | ⟨hj, hpre, stateA⟩ + · rw [← hjEq] at rowB + simp? [hj] at rowB + rcases rowB with ⟨hpre', stateB⟩ + have hunit : (p 2).1 = 1 := by + have hidx : i + r = 1 := by rw [hia, hj]; exact sub_add_cancel 1 r + have hi' : (P4828T1Step p ((i + r).succ)).1 = 1 := by + simpa [hqa, hta, P4828T1Rotate] using hi + rw [hidx] at hi' + simpa [P4828T1Step] using hi' + have heOld := ih _ hlt p hp 1 hunit e e' hpre hpre' hnpre + have htan : BandTangency (p 2) (p 3) := + ⟨p, hp.1, 2, 3, by decide, rfl, rfl⟩ + have exclusive : ¬ (PrimitiveVectorOrientation (p 2) (p 3) ∧ + PrimitiveVectorOrientation (p 3) (p 2)) := by + intro hd + have hx := (PrimitiveVectorOrientationUnique (p 2) (p 3)).2 htan + rcases hx.2 with ⟨hf, hnrev⟩ | ⟨hr, hnfor⟩ + · exact hnrev hd.2 + · exact hnfor hd.1 + by_cases hsib : (p 3).1 = 1 + · rcases stateA with hN | hF | hR + · exact (hN.1 hsib).elim + · rcases stateB with hN' | hF' | hR' + · exact (hN'.1 hsib).elim + · exact hF.2.2.trans hF'.2.2.symm + · exact False.elim (exclusive ⟨hF.2.1, hR'.2.1⟩) + · rcases stateB with hN' | hF' | hR' + · exact (hN'.1 hsib).elim + · exact False.elim (exclusive ⟨hF'.2.1, hR.2.1⟩) + · exact hR.2.2.trans hR'.2.2.symm + · rcases stateA with hN | hF | hR + · rcases stateB with hN' | hF' | hR' + · exact hN.2.trans (heOld.trans hN'.2.symm) + · exact (hsib hF'.1).elim + · exact (hsib hR'.1).elim + · exact (hsib hF.1).elim + · exact (hsib hR.1).elim + · rw [← hjEq] at rowB + simp? [hj] at rowB + rcases rowB with ⟨hpre', stateB⟩ + have hunit : (p 3).1 = 1 := by + have hidx : i + r = 2 := by rw [hia, hj]; exact sub_add_cancel 2 r + have hi' : (P4828T1Step p ((i + r).succ)).1 = 1 := by + simpa [hqa, hta, P4828T1Rotate] using hi + rw [hidx] at hi' + simpa [P4828T1Step] using hi' + have heOld := ih _ hlt p hp 2 hunit e e' hpre hpre' hnpre + have htan : BandTangency (p 2) (p 3) := + ⟨p, hp.1, 2, 3, by decide, rfl, rfl⟩ + have exclusive : ¬ (PrimitiveVectorOrientation (p 2) (p 3) ∧ + PrimitiveVectorOrientation (p 3) (p 2)) := by + intro hd + have hx := (PrimitiveVectorOrientationUnique (p 2) (p 3)).2 htan + rcases hx.2 with ⟨hf, hnrev⟩ | ⟨hr, hnfor⟩ + · exact hnrev hd.2 + · exact hnfor hd.1 + by_cases hsib : (p 2).1 = 1 + · rcases stateA with hN | hF | hR + · exact (hN.1 hsib).elim + · rcases stateB with hN' | hF' | hR' + · exact (hN'.1 hsib).elim + · exact hF.2.2.trans hF'.2.2.symm + · exact False.elim (exclusive ⟨hF.2.1, hR'.2.1⟩) + · rcases stateB with hN' | hF' | hR' + · exact (hN'.1 hsib).elim + · exact False.elim (exclusive ⟨hF'.2.1, hR.2.1⟩) + · exact hR.2.2.trans hR'.2.2.symm + · rcases stateA with hN | hF | hR + · rcases stateB with hN' | hF' | hR' + · exact hN.2.trans (heOld.trans hN'.2.symm) + · exact (hsib hF'.1).elim + · exact (hsib hR'.1).elim + · exact (hsib hF.1).elim + · exact (hsib hR.1).elim + +end OccurrenceDeterministicProof + +theorem P5455T2OccurrenceDeterministic + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (i : Fin 3) (hi : (q i.succ).1 = 1) + (a b : Bool) (ha : UnitOccurrenceOrientation q i a) + (hb : UnitOccurrenceOrientation q i b) : a = b := by +-- BODY + exact (by + let Normalize : ∀ {q : Fin 4 → CircleCoordinates} {i : Fin 3} {o : Bool}, + UnitOccurrenceOrientation q i o → + ∃ (t : Fin 4 → CircleCoordinates) (r j : Fin 3), + q = P4828T1Rotate t r ∧ i = j - r ∧ + ((∃ z, t = P4828T1Root z false ∧ + ((j = 0 ∧ o = true) ∨ (j = 2 ∧ o = false))) ∨ + (∃ z, t = P4828T1Root z true ∧ + ((j = 0 ∧ o = true) ∨ (j = 1 ∧ o = false))) ∨ + (∃ p e, ProperBandQuadruple p ∧ t = P4828T1Step p ∧ + ((j = 1 ∧ UnitOccurrenceOrientation p 1 e ∧ + (((p 3).1 ≠ 1 ∧ o = e) ∨ + ((p 3).1 = 1 ∧ PrimitiveVectorOrientation (p 2) (p 3) ∧ o = false) ∨ + ((p 3).1 = 1 ∧ PrimitiveVectorOrientation (p 3) (p 2) ∧ o = true))) ∨ + (j = 2 ∧ UnitOccurrenceOrientation p 2 e ∧ + (((p 2).1 ≠ 1 ∧ o = e) ∨ + ((p 2).1 = 1 ∧ PrimitiveVectorOrientation (p 2) (p 3) ∧ o = true) ∨ + ((p 2).1 = 1 ∧ PrimitiveVectorOrientation (p 3) (p 2) ∧ o = false)))))) := + OccurrenceDeterministicProof.Normalize + have noMix : ∀ z s r p, ProperBandQuadruple p → ∀ r', + P4828T1Rotate (P4828T1Root z s) r = + P4828T1Rotate (P4828T1Step p) r' → False := OccurrenceDeterministicProof.noMix q i + have rotUnique : ∀ t, ProperBandQuadruple t → ∀ r r', + P4828T1Rotate t r = P4828T1Rotate t r' → r = r' := OccurrenceDeterministicProof.rotUnique + have main : ∀ n : Nat, ∀ q : Fin 4 → CircleCoordinates, + ProperBandQuadruple q → ∀ i : Fin 3, (q i.succ).1 = 1 → + ∀ a b : Bool, UnitOccurrenceOrientation q i a → + UnitOccurrenceOrientation q i b → (q 0).1.toNat = n → a = b := + OccurrenceDeterministicProof.main Normalize noMix rotUnique + exact main _ q hq i hi a b ha hb rfl) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceExists.lean b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceExists.lean new file mode 100644 index 0000000000..c8e04a12a8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceExists.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5455T2CurvatureGrowth +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique + +-- [TABLET NODE: P5455T2OccurrenceExists] + +/-! +# P5455T2OccurrenceExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5455T2OccurrenceExists (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) (i : Fin 3) (hi : (q i.succ).1 = 1) : + ∃ o : Bool, UnitOccurrenceOrientation q i o := by +-- BODY + have main : ∀ p, SemiProperQuadruple p → ProperBandQuadruple p → + ∀ j : Fin 3, (p j.succ).1 = 1 → + ∃ o : Bool, UnitOccurrenceOrientation p j o := by + intro p hs + induction hs with + | base z => + intro hp + have bad := hp.2 0 + norm_num at bad + | @rotate p hs ih => + intro hp j hj + have old : ProperBandQuadruple p := by + refine ⟨hs, ?_⟩ + intro k + fin_cases k + · simpa using hp.2 2 + · simpa using hp.2 0 + · simpa using hp.2 1 + have unit : (p (j + 1).succ).1 = 1 := by + fin_cases j <;> simpa using hj + obtain ⟨o, ho⟩ := ih old (j + 1) unit + refine ⟨o, ?_⟩ + have hr := UnitOccurrenceOrientation.rotate ho + fin_cases j <;> simpa using hr + | @successor p hs ih => + intro hp j hj + rcases (SemiProperForestClassification p hs).2 with root | root | root | old + · obtain ⟨z, hz⟩ := root + have bad := hp.2 0 + simp [hz] at bad + · obtain ⟨z, hz⟩ := root + have eq : P4828T1Step p = + ![(4, 1 + 8 * z + 4 * ⟨0, 1⟩), (1, 1 + 2 * z), + (0, -1), (1, 1 + 2 * z + 2 * ⟨0, 1⟩)] := by + rw [hz] + funext k + fin_cases k <;> simp [P4828T1Step]; ring + change (P4828T1Step p j.succ).1 = 1 at hj + change ∃ o, UnitOccurrenceOrientation (P4828T1Step p) j o + rw [eq] at hj ⊢ + fin_cases j + · exact ⟨true, .leftLower z⟩ + · change (0 : ℤ) = 1 at hj + omega + · exact ⟨false, .leftUpper z⟩ + · obtain ⟨z, hz⟩ := root + have eq : P4828T1Step p = + ![(4, 7 + 8 * z + 4 * ⟨0, 1⟩), (1, 1 + 2 * z), + (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (0, 1)] := by + rw [hz] + funext k + fin_cases k <;> simp [P4828T1Step]; ring + change (P4828T1Step p j.succ).1 = 1 at hj + change ∃ o, UnitOccurrenceOrientation (P4828T1Step p) j o + rw [eq] at hj ⊢ + fin_cases j + · exact ⟨true, .rightUpper z⟩ + · exact ⟨false, .rightLower z⟩ + · change (0 : ℤ) = 1 at hj + omega + · have large := (P5455T2CurvatureGrowth p old).1 + fin_cases j + · simp at hj + omega + · have unit : (p 2).1 = 1 := by simpa using hj + obtain ⟨o, ho⟩ := ih old 1 unit + by_cases sibling : (p 3).1 = 1 + · have tangent : BandTangency (p 2) (p 3) := + ⟨p, hs, 2, 3, by decide, rfl, rfl⟩ + rcases ((PrimitiveVectorOrientationUnique (p 2) (p 3)).2 tangent).2 with + direction | direction + · exact ⟨false, .retainSecondToThird old sibling direction.1 ho⟩ + · exact ⟨true, .retainSecondFromThird old sibling direction.1 ho⟩ + · exact ⟨o, .retainSecondOther old sibling ho⟩ + · have unit : (p 3).1 = 1 := by simpa using hj + obtain ⟨o, ho⟩ := ih old 2 unit + by_cases sibling : (p 2).1 = 1 + · have tangent : BandTangency (p 2) (p 3) := + ⟨p, hs, 2, 3, by decide, rfl, rfl⟩ + rcases ((PrimitiveVectorOrientationUnique (p 2) (p 3)).2 tangent).2 with + direction | direction + · exact ⟨true, .retainThirdFromSecond old sibling direction.1 ho⟩ + · exact ⟨false, .retainThirdToSecond old sibling direction.1 ho⟩ + · exact ⟨o, .retainThirdOther old sibling ho⟩ + exact main q hq.1 hq i hi + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceRotation.lean b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceRotation.lean new file mode 100644 index 0000000000..a606320d45 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceRotation.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation +public import LeanPool.ApollonianSuperharmonic.P4828T1RotationLaws + +-- [TABLET NODE: P5455T2OccurrenceRotation] + +/-! +# P5455T2OccurrenceRotation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5455T2OccurrenceRotation + (q : Fin 4 → CircleCoordinates) (i r : Fin 3) (o : Bool) : + UnitOccurrenceOrientation (P4828T1Rotate q r) (i - r) o ↔ + UnitOccurrenceOrientation q i o := by +-- BODY + have forward : ∀ (p : Fin 4 → CircleCoordinates) (j s : Fin 3) (b : Bool), + UnitOccurrenceOrientation p j b → + UnitOccurrenceOrientation (P4828T1Rotate p s) (j - s) b := by + intro p j s b h + fin_cases s + · change UnitOccurrenceOrientation (P4828T1Rotate p 0) (j - 0) b + simpa only [P4828T1RotationLaws.1, sub_zero] using h + · have hr := UnitOccurrenceOrientation.rotate h + have eq : P4828T1Rotate p 1 = ![p 0, p 2, p 3, p 1] := by + funext k + fin_cases k <;> rfl + change UnitOccurrenceOrientation (P4828T1Rotate p 1) (j - 1) b + rw [eq] + convert hr using 1; fin_cases j <;> rfl + · have hr := UnitOccurrenceOrientation.rotate (UnitOccurrenceOrientation.rotate h) + have eq : P4828T1Rotate p 2 = ![p 0, p 3, p 1, p 2] := by + funext k + fin_cases k <;> rfl + change UnitOccurrenceOrientation (P4828T1Rotate p 2) (j - 2) b + rw [eq] + convert hr using 1 <;> fin_cases j <;> rfl + constructor + · intro h + have hr := forward (P4828T1Rotate q r) (i - r) (-r) o h + rw [P4828T1RotationLaws.2.1, neg_add_cancel, + P4828T1RotationLaws.1] at hr + have idx : (i - r) - (-r) = i := by + fin_cases i <;> fin_cases r <;> rfl + rwa [idx] at hr + · exact forward q i r o + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2RightRegressions.lean b/LeanPool/ApollonianSuperharmonic/P5455T2RightRegressions.lean new file mode 100644 index 0000000000..ac7556e561 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5455T2RightRegressions.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5455T2CurvatureGrowth +public import LeanPool.ApollonianSuperharmonic.P5455T2OccurrenceRotation +public import LeanPool.ApollonianSuperharmonic.P4828T1RightRootGeometry + +-- [TABLET NODE: P5455T2RightRegressions] + +/-! +# P5455T2RightRegressions + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5455T2RightRegressions (z : GaussianInt) : + let q : Fin 4 → CircleCoordinates := + ![(12, 17 + 24 * z + 12 * ⟨0, 1⟩), + (4, 7 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩)] + let q' : Fin 4 → CircleCoordinates := + ![(24, 31 + 48 * z + 24 * ⟨0, 1⟩), + (12, 17 + 24 * z + 12 * ⟨0, 1⟩), + (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩)] + ProperBandQuadruple q ∧ PrimitiveVectorOrientation (q 3) (q 2) ∧ + UnitOccurrenceOrientation q 1 true ∧ UnitOccurrenceOrientation q 2 false ∧ + ProperBandQuadruple q' ∧ PrimitiveVectorOrientation (q' 3) (q' 2) ∧ + UnitOccurrenceOrientation q' 1 true ∧ UnitOccurrenceOrientation q' 2 false := by +-- BODY + dsimp only + let H := P4828T1Root z true + let p : Fin 4 → CircleCoordinates := ![H 0, H 3, H 1, H 2] + let q : Fin 4 → CircleCoordinates := + ![(12, 17 + 24 * z + 12 * ⟨0, 1⟩), + (4, 7 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩)] + have hp : ProperBandQuadruple p := by + convert P4828T1RotationLaws.2.2 H 2 (P4828T1RightRootGeometry z).1 using 1 + funext k + fin_cases k <;> rfl + have oldB : UnitOccurrenceOrientation p 1 true := by + have h := (P5455T2OccurrenceRotation H 0 2 true).mpr + (UnitOccurrenceOrientation.rightUpper z) + convert h using 1 + · funext k + fin_cases k <;> rfl + · decide +kernel + have oldD : UnitOccurrenceOrientation p 2 false := by + have h := (P5455T2OccurrenceRotation H 1 2 false).mpr + (UnitOccurrenceOrientation.rightLower z) + convert h using 1 + · funext k + fin_cases k <;> rfl + · decide +kernel + have eq : P4828T1Step p = q := by + funext k + fin_cases k <;> simp [P4828T1Step, p, H, P4828T1Root, q]; ring + have direction : PrimitiveVectorOrientation (p 3) (p 2) := .base10 z + have hq : ProperBandQuadruple q := eq ▸ (P5455T2CurvatureGrowth p hp).2.1 + have hB : UnitOccurrenceOrientation q 1 true := by + rw [← eq] + exact .retainSecondFromThird hp rfl direction oldB + have hD : UnitOccurrenceOrientation q 2 false := by + rw [← eq] + exact .retainThirdToSecond hp rfl direction oldD + have eq' : P4828T1Step q = + ![(24, 31 + 48 * z + 24 * ⟨0, 1⟩), + (12, 17 + 24 * z + 12 * ⟨0, 1⟩), + (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩)] := by + funext k + fin_cases k <;> simp [P4828T1Step, q]; ring + refine ⟨hq, PrimitiveVectorOrientation.base10 z, hB, hD, ?_, + PrimitiveVectorOrientation.base10 z, ?_, ?_⟩ + · rw [← eq'] + exact (P5455T2CurvatureGrowth q hq).2.1 + · rw [← eq'] + exact .retainSecondFromThird hq rfl (.base10 z) hB + · rw [← eq'] + exact .retainThirdToSecond hq rfl (.base10 z) hD + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2RootAlignment.lean b/LeanPool/ApollonianSuperharmonic/P5455T2RootAlignment.lean new file mode 100644 index 0000000000..b187c723f6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5455T2RootAlignment.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4828T1Root +public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate + +-- [TABLET NODE: P5455T2RootAlignment] + +/-! +# P5455T2RootAlignment + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5455T2RootAlignment (z z' : GaussianInt) (s s' : Bool) + (r r' : Fin 3) + (h : P4828T1Rotate (P4828T1Root z s) r = + P4828T1Rotate (P4828T1Root z' s') r') : + z = z' ∧ s = s' ∧ r = r' := by +-- BODY + have hc := congrArg (fun q => (q 0).2) h + have parameters : z = z' ∧ s = s' := by + cases s <;> cases s' + all_goals norm_num [P4828T1Rotate, P4828T1Root, Zsqrtd.ext_iff] at hc + · exact ⟨by ext <;> omega, rfl⟩ + · omega + · omega + · exact ⟨by ext <;> omega, rfl⟩ + obtain ⟨rfl, rfl⟩ := parameters + refine ⟨rfl, rfl, ?_⟩ + have h1 := congrArg (fun q => (q 1).1) h + have h2 := congrArg (fun q => (q 2).1) h + cases s <;> fin_cases r <;> fin_cases r' + all_goals first + | rfl + | (change (0 : ℤ) = 1 at h1; omega) + | (change (1 : ℤ) = 0 at h1; omega) + | (change (0 : ℤ) = 1 at h2; omega) + | (change (1 : ℤ) = 0 at h2; omega) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2WholeJoin.lean b/LeanPool/ApollonianSuperharmonic/P5455T2WholeJoin.lean new file mode 100644 index 0000000000..25a544e3ce --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5455T2WholeJoin.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4994T6UnitRootTable +public import LeanPool.ApollonianSuperharmonic.P4828T1LeftRootGeometry +public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep + +-- [TABLET NODE: P5455T2WholeJoin] + +/-! +# P5455T2WholeJoin + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5455T2WholeJoin (z : GaussianInt) : + let v := BandVectors.1 (4, 1 + 8 * z + 4 * ⟨0, 1⟩) (1, 1 + 2 * z) + v.re * v.re + v.im * v.im = 5 ∧ + ∀ o : Bool, ¬ UnitTriangularStep o v := by +-- BODY + let L := P4828T1Root z false + have proper := (P4828T1LeftRootGeometry z).1 + have row := P4994T6UnitRootTable z + have incoming := (VectorRecursionLaws L proper.1).2.2.1 + change BandVectors.1 (L 1) (L 0) = _ at incoming + rw [show BandVectors.1 (L 1) (L 3) = -1 + (⟨0, 1⟩ : GaussianInt) + from row.2.1.1, + show BandVectors.1 (L 2) (L 1) = -(⟨0, 1⟩ : GaussianInt) + from row.1.1] at incoming + have flip := ((VectorRecursionLaws L proper.1).2.2.2.2 proper 0).1 + change BandVectors.1 (L 0) (L 1) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (L 1) (L 0) at flip + rw [incoming] at flip + have value : BandVectors.1 (L 0) (L 1) = (-1 - 2 * (⟨0, 1⟩ : GaussianInt)) := by + rw [flip] + ext <;> norm_num + change (BandVectors.1 (L 0) (L 1)).re * (BandVectors.1 (L 0) (L 1)).re + + (BandVectors.1 (L 0) (L 1)).im * (BandVectors.1 (L 0) (L 1)).im = 5 ∧ + ∀ o, ¬ UnitTriangularStep o (BandVectors.1 (L 0) (L 1)) + rw [value] + constructor + · norm_num + · intro o + cases o <;> norm_num [UnitTriangularStep, Zsqrtd.ext_iff] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1AffineDifferenceTransport.lean b/LeanPool/ApollonianSuperharmonic/P5472T1AffineDifferenceTransport.lean new file mode 100644 index 0000000000..8af0da2072 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5472T1AffineDifferenceTransport.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import Mathlib.Tactic.LinearCombination + +-- [TABLET NODE: P5472T1AffineDifferenceTransport] + +/-! +# P5472T1AffineDifferenceTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5472T1AffineDifferenceTransport + (s : BandPackingSymmetry) + (hword : ∃ z : GaussianInt, s = .shift z ∨ s = (BandPackingSymmetry.shift z).comp .negate) + (U V : ProtoTile) (x y : Real × Real) (v w : GaussianInt) (k : Real) + (hc : TileCentroid V - TileCentroid U = k • GaussianRealPoint v) + (hp : x - y = k • GaussianRealPoint w) : + TileCentroid (BandPackingSymmetryTileAction s V) - + TileCentroid (BandPackingSymmetryTileAction s U) = + k • GaussianRealPoint (BandPackingSymmetryAffineVectorAction s (v, w)).1 ∧ + BandPackingSymmetrySlopeAction s V x - BandPackingSymmetrySlopeAction s U y = + k • GaussianRealPoint (BandPackingSymmetryAffineVectorAction s (v, w)).2 := by +-- BODY + have differenceShift (z : GaussianInt) (U V : ProtoTile) + (x y : Real × Real) (v w : GaussianInt) (k : Real) + (hc : TileCentroid V - TileCentroid U = k • GaussianRealPoint v) + (hp : x - y = k • GaussianRealPoint w) : + TileCentroid (BandPackingSymmetryTileAction (.shift z) V) - + TileCentroid (BandPackingSymmetryTileAction (.shift z) U) = + k • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction (.shift z) (v, w)).1 ∧ + BandPackingSymmetrySlopeAction (.shift z) V x - + BandPackingSymmetrySlopeAction (.shift z) U y = + k • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction (.shift z) (v, w)).2 := by + rcases z with ⟨zr, zi⟩ + rcases v with ⟨vr, vi⟩ + rcases w with ⟨wr, wi⟩ + have hc1 := congrArg Prod.fst hc + have hc2 := congrArg Prod.snd hc + have hp1 := congrArg Prod.fst hp + have hp2 := congrArg Prod.snd hp + refine ⟨hc, ?_⟩ + apply Prod.ext + · simp [BandPackingSymmetrySlopeAction, BandPackingSymmetryAffineVectorAction, + GaussianRealPoint, GaussianReflection] at hc1 hc2 hp1 hp2 ⊢ + linear_combination hp1 + (zr : Real) * hc1 + (zi : Real) * hc2 + · simp [BandPackingSymmetrySlopeAction, BandPackingSymmetryAffineVectorAction, + GaussianRealPoint, GaussianReflection] at hc1 hc2 hp1 hp2 ⊢ + linear_combination hp2 + (zi : Real) * hc1 - (zr : Real) * hc2 + have differenceNegate (U V : ProtoTile) (x y : Real × Real) + (v w : GaussianInt) (k : Real) + (hc : TileCentroid V - TileCentroid U = k • GaussianRealPoint v) + (hp : x - y = k • GaussianRealPoint w) : + TileCentroid (BandPackingSymmetryTileAction .negate V) - + TileCentroid (BandPackingSymmetryTileAction .negate U) = + k • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction .negate (v, w)).1 ∧ + BandPackingSymmetrySlopeAction .negate V x - + BandPackingSymmetrySlopeAction .negate U y = + k • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction .negate (v, w)).2 := by + rcases v with ⟨vr, vi⟩ + rcases w with ⟨wr, wi⟩ + have hc1 := congrArg Prod.fst hc + have hc2 := congrArg Prod.snd hc + have hp1 := congrArg Prod.fst hp + have hp2 := congrArg Prod.snd hp + change TileCentroid (TileQuarterTurn V) - TileCentroid (TileQuarterTurn U) = _ ∧ _ + rw [(TileQuarterTurnFormulas V).2.2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.2.1] + simp only [BandPackingSymmetryAffineVectorAction, + BandPackingSymmetrySlopeAction, GaussianQuarterTurn, + GaussianRealPoint] + constructor + · apply Prod.ext + · simp only [Prod.fst_add, Prod.fst_neg, sub_eq_add_neg, + Prod.smul_fst, smul_eq_mul, Int.cast_neg] + ring_nf + have hh : (TileCentroid V).2 - (TileCentroid U).2 = k * (vi : Real) := by + simpa [GaussianRealPoint] using congrArg Prod.snd hc + linear_combination -hh + · change (TileCentroid V).1 - (TileCentroid U).1 = k * (vr : Real) + have hh := congrArg Prod.fst hc + change (TileCentroid V).1 - (TileCentroid U).1 = k * (vr : Real) at hh + exact hh + · apply Prod.ext + · simp only [Prod.fst_add, Prod.fst_neg, sub_eq_add_neg, + Prod.smul_fst, smul_eq_mul, Int.cast_neg] + ring_nf + have hh : x.2 - y.2 = k * (wi : Real) := by + simpa [GaussianRealPoint] using congrArg Prod.snd hp + linear_combination -hh + · change x.1 - y.1 = k * (wr : Real) + have hh := congrArg Prod.fst hp + change x.1 - y.1 = k * (wr : Real) at hh + exact hh + rcases hword with ⟨z, hs | hs⟩ + · rw [hs] + exact ⟨hc, (differenceShift z U V x y v w k hc hp).2⟩ + · rw [hs] + have hn := differenceNegate U V x y v w k hc hp + have hs := differenceShift z (TileQuarterTurn U) (TileQuarterTurn V) + (BandPackingSymmetrySlopeAction .negate V x) + (BandPackingSymmetrySlopeAction .negate U y) + (BandPackingSymmetryAffineVectorAction .negate (v, w)).1 + (BandPackingSymmetryAffineVectorAction .negate (v, w)).2 k hn.1 hn.2 + exact hs + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1CyclicAffineCommutation.lean b/LeanPool/ApollonianSuperharmonic/P5472T1CyclicAffineCommutation.lean new file mode 100644 index 0000000000..5b5ac7f4a4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5472T1CyclicAffineCommutation.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction + +-- [TABLET NODE: P5472T1CyclicAffineCommutation] + +/-! +# P5472T1CyclicAffineCommutation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5472T1CyclicAffineCommutation + (s : BandPackingSymmetry) + (hword : ∃ z : GaussianInt, s = .shift z ∨ s = (BandPackingSymmetry.shift z).comp .negate) + (W A : GaussianInt) : + let I : GaussianInt := ⟨0, 1⟩ + let B := BandPackingSymmetryAffineVectorAction s (W, A) + BandPackingSymmetryAffineVectorAction s (W - I * W, A + I * A) = + (B.1 - I * B.1, B.2 + I * B.2) := by +-- BODY + let Icyc : GaussianInt := ⟨0, 1⟩ + have hI_mul (z : GaussianInt) : Icyc * z = GaussianQuarterTurn z := by + ext <;> simp [Icyc, GaussianQuarterTurn] + let Pcyc (z : GaussianInt × GaussianInt) : GaussianInt × GaussianInt := + (z.1 - Icyc * z.1, z.2 + Icyc * z.2) + have shiftPcyc (z W A : GaussianInt) : + BandPackingSymmetryAffineVectorAction (.shift z) (Pcyc (W, A)) = + Pcyc (BandPackingSymmetryAffineVectorAction (.shift z) (W, A)) := by + have hconj (X : GaussianInt) : GaussianReflection (X - Icyc * X) = + GaussianReflection X + Icyc * GaussianReflection X := by + rw [hI_mul] + rcases X with ⟨u, v⟩ + rw [hI_mul] + ext <;> + simp only [GaussianReflection, GaussianQuarterTurn, + Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, Zsqrtd.im_sub, + ] <;> ring + simp only [BandPackingSymmetryAffineVectorAction, Pcyc] + rw [Prod.mk.injEq] + constructor + · rfl + · rw [hconj] + rw [mul_add, mul_add] + have hmul (R : GaussianInt) : z * (Icyc * R) = Icyc * (z * R) := by + rw [← mul_assoc, mul_comm z Icyc, mul_assoc] + rw [hmul] + ac_rfl + have negatePcyc (W A : GaussianInt) : + BandPackingSymmetryAffineVectorAction .negate (Pcyc (W, A)) = + Pcyc (BandPackingSymmetryAffineVectorAction .negate (W, A)) := by + change (GaussianQuarterTurn (W - Icyc * W), + GaussianQuarterTurn (A + Icyc * A)) = + (GaussianQuarterTurn W - Icyc * GaussianQuarterTurn W, + GaussianQuarterTurn A + Icyc * GaussianQuarterTurn A) + rw [Prod.mk.injEq] + constructor + · rw [hI_mul] + rcases W with ⟨wr, wi⟩ + rw [hI_mul] + ext <;> + simp only [GaussianQuarterTurn, + Zsqrtd.re_sub, Zsqrtd.im_sub]; ring + · rw [hI_mul] + rcases A with ⟨ar, ai⟩ + rw [hI_mul] + ext <;> + simp only [GaussianQuarterTurn, Zsqrtd.re_add, Zsqrtd.im_add, + ]; ring + change BandPackingSymmetryAffineVectorAction s (Pcyc (W, A)) = + Pcyc (BandPackingSymmetryAffineVectorAction s (W, A)) + rcases hword with ⟨z, hs | hs⟩ + · rw [hs] + exact shiftPcyc z W A + · rw [hs] + change BandPackingSymmetryAffineVectorAction (.shift z) + (BandPackingSymmetryAffineVectorAction .negate (Pcyc (W, A))) = + Pcyc (BandPackingSymmetryAffineVectorAction (.shift z) + (BandPackingSymmetryAffineVectorAction .negate (W, A))) + rw [negatePcyc] + exact shiftPcyc z _ _ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1CyclicPhaseCovariance.lean b/LeanPool/ApollonianSuperharmonic/P5472T1CyclicPhaseCovariance.lean new file mode 100644 index 0000000000..36a29655ed --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5472T1CyclicPhaseCovariance.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5472T1CyclicAffineCommutation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance + +-- [TABLET NODE: P5472T1CyclicPhaseCovariance] + +/-! +# P5472T1CyclicPhaseCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5472T1CyclicPhaseCovariance + (s : BandPackingSymmetry) (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) + (hrev : BandPackingSymmetryReversesOrientation s = false) + (hword : ∃ z : GaussianInt, s = .shift z ∨ s = (BandPackingSymmetry.shift z).comp .negate) : + ∃ delta : Bool, + BandPackingSymmetryScopedPhase s q delta ∧ + let I : GaussianInt := ⟨0, 1⟩ + let W := BandVectors.1 (q 3) (q 2) + let A := BandVectors.2 (q 3) (q 2) + let W' := BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2) + let A' := BandVectors.2 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2) + BandPackingSymmetryAffineVectorAction s (W - I * W, A + I * A) = + if delta then -(W' - I * W', A' + I * A') + else (W' - I * W', A' + I * A') := by +-- BODY + obtain ⟨delta, hphase, hcov⟩ := BandPackingSymmetryAffineVectorCovariance s q hq + refine ⟨delta, hphase, ?_⟩ + let I : GaussianInt := ⟨0, 1⟩ + let W := BandVectors.1 (q 3) (q 2) + let A := BandVectors.2 (q 3) (q 2) + let W' := BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2) + let A' := BandVectors.2 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2) + have hfirst : (BandPackingSymmetryAffineVectorAction s (W, A)).1 = + BandPackingSymmetryVectorAction s W := by + rcases hword with ⟨z, hs | hs⟩ <;> rw [hs] <;> rfl + have hv := (hphase (0 : Fin 3)).2.2 + have ha := (hcov (0 : Fin 3)).2 + simp only [hrev, Bool.false_eq_true, ite_false] at hv ha + change W' = (if delta then (-1 : GaussianInt) else 1) * + BandPackingSymmetryVectorAction s W at hv + change A' = (if delta then (-1 : GaussianInt) else 1) * + (BandPackingSymmetryAffineVectorAction s (W, A)).2 at ha + rw [← hfirst] at hv + change BandPackingSymmetryAffineVectorAction s (W - I * W, A + I * A) = _ + rw [P5472T1CyclicAffineCommutation s hword W A] + change ((BandPackingSymmetryAffineVectorAction s (W, A)).1 - + I * (BandPackingSymmetryAffineVectorAction s (W, A)).1, + (BandPackingSymmetryAffineVectorAction s (W, A)).2 + + I * (BandPackingSymmetryAffineVectorAction s (W, A)).2) = + if delta then -(W' - I * W', A' + I * A') + else (W' - I * W', A' + I * A') + cases delta + all_goals + simp only [Bool.false_eq_true, ite_false, ite_true, one_mul, neg_one_mul] at hv ha ⊢ + · rw [hv, ha] + · rw [hv, ha] + ext <;> simp <;> ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1FordNormalization.lean b/LeanPool/ApollonianSuperharmonic/P5472T1FordNormalization.lean new file mode 100644 index 0000000000..13e0b970a2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5472T1FordNormalization.lean @@ -0,0 +1,431 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P5472T1FordNormalization] + +/-! +# P5472T1FordNormalization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace FordNormalizationProof + +private theorem hridx : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + ((cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → ( + let t := cfg.firstPredecessor + ((0 : ℤ) < (t (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (t i.succ).1) ∧ ∀ (i + : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), (t i.succ).1 = (0 : ℤ) → (t j.succ).1 = (0 : ℤ) + → i = j) → (∀ (ridx : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), ∀ (F : + FordFareyParameter), ((t (ridx + (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ)) → + ((BandPackingSymmetryQuadrupleAction s ![t (0 : Fin (4 : ℕ)), t ridx.succ, t (ridx + + (1 : Fin (3 : ℕ))).succ, t (ridx + (2 : Fin (3 : ℕ))).succ] = FordRecursiveQuadruple + F) → (ridx = 1)))) ) := by + classical + intro q cfg hzero t hcurv ridx s F hline hford + fin_cases ridx + · have hzero3 : (t 3).1 = 0 := by simpa using hline + have eq := hcurv.2.2 2 0 hzero3 hzero + exact False.elim ((by decide : (2 : Fin 3) ≠ 0) eq) + · rfl + · have hzero2 : (t 2).1 = 0 := by simpa using hline + have eq := hcurv.2.2 1 0 hzero2 hzero + exact False.elim ((by decide : (1 : Fin 3) ≠ 0) eq) + +private theorem hford' : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let t := cfg.firstPredecessor + ∀ (s : BandPackingSymmetry), ∀ (F : FordFareyParameter), + (BandPackingSymmetryQuadrupleAction s ![t (0 : Fin (4 : ℕ)), t (Fin.succ (1 : Fin (3 + : ℕ))), t ((1 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ, t ((1 : Fin (3 : ℕ)) + (2 : + Fin (3 : ℕ))).succ] = FordRecursiveQuadruple F) → (BandPackingSymmetryQuadrupleAction + s ![cfg.firstPredecessor 0, cfg.firstPredecessor 2, cfg.firstPredecessor 3, + cfg.firstPredecessor 1] = FordRecursiveQuadruple F) ) := by + classical + intro q cfg t s F hford + simpa using hford + +private theorem hqSucc : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let t := cfg.firstPredecessor + let succ (a : Fin 4 → CircleCoordinates) : Fin 4 → CircleCoordinates := + ![(2 * (a 0).1 + 2 * (a 2).1 + 2 * (a 3).1 - (a 1).1, + 2 * (a 0).2 + 2 * (a 2).2 + 2 * (a 3).2 - (a 1).2), + a 0, a 2, a 3] + q = succ t ) := by + classical + intro q cfg t succ + have htwin := cfg.firstTwin + rw [← cfg.firstChild, ← cfg.firstParentTwo, ← cfg.firstParentThree] at htwin + change t 1 = + (2 * (t 0).1 + 2 * (t 2).1 + 2 * (t 3).1 - (q 0).1, + 2 * (t 0).2 + 2 * (t 2).2 + 2 * (t 3).2 - (q 0).2) at htwin + have hroot : q 0 = + (2 * (t 0).1 + 2 * (t 2).1 + 2 * (t 3).1 - (t 1).1, + 2 * (t 0).2 + 2 * (t 2).2 + 2 * (t 3).2 - (t 1).2) := by + apply Prod.ext + · have hh := congrArg Prod.fst htwin + dsimp at hh ⊢ + linear_combination hh + · have hh := congrArg Prod.snd htwin + dsimp at hh ⊢ + linear_combination hh + funext i + fin_cases i + · change q 0 = succ t 0 + exact hroot + · change q 1 = succ t 1 + exact cfg.firstChild.symm + · change q 2 = succ t 2 + exact cfg.firstParentTwo.symm + · change q 3 = succ t 3 + exact cfg.firstParentThree.symm + +private theorem hsuccCov : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let t := cfg.firstPredecessor + ∀ (s : BandPackingSymmetry), (∃ (w : GaussianInt), s = BandPackingSymmetry.shift w ∨ s = + (BandPackingSymmetry.shift w).comp BandPackingSymmetry.negate) → ( + let succ (a : Fin 4 → CircleCoordinates) : Fin 4 → CircleCoordinates := + ![(2 * (a 0).1 + 2 * (a 2).1 + 2 * (a 3).1 - (a 1).1, + 2 * (a 0).2 + 2 * (a 2).2 + 2 * (a 3).2 - (a 1).2), + a 0, a 2, a 3] + BandPackingSymmetryQuadrupleAction s (succ t) = succ (BandPackingSymmetryQuadrupleAction + s t)) ) := by + classical + intro q cfg t s hword succ + rcases hword with ⟨w, hs | hs⟩ + · rw [hs] + funext i + fin_cases i <;> + simp? [succ, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, BandPackingSymmetryReversesOrientation]; + (try ext) <;> simp [] <;> ring + · rw [hs] + funext i + fin_cases i <;> + simp? [succ, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, BandPackingSymmetryReversesOrientation, + ]; (try ext) <;> + simp [] <;> ring + +private theorem hF0 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let t := cfg.firstPredecessor + ∀ (s : BandPackingSymmetry), ∀ (F : FordFareyParameter), + (BandPackingSymmetryReversesOrientation s = false) → + ((BandPackingSymmetryQuadrupleAction s ![cfg.firstPredecessor 0, cfg.firstPredecessor + 2, cfg.firstPredecessor 3, cfg.firstPredecessor 1] = FordRecursiveQuadruple F) → + (BandPackingSymmetryCircleAction s (t 0) = FordRecursiveQuadruple F 0)) ) := by + classical + intro q cfg t s F hrev hford' + have hh := congrArg (fun z : Fin 4 → CircleCoordinates => z 0) hford' + simpa [BandPackingSymmetryQuadrupleAction, hrev] using hh + +private theorem hF1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let t := cfg.firstPredecessor + ∀ (s : BandPackingSymmetry), ∀ (F : FordFareyParameter), + (BandPackingSymmetryReversesOrientation s = false) → + ((BandPackingSymmetryQuadrupleAction s ![cfg.firstPredecessor 0, cfg.firstPredecessor + 2, cfg.firstPredecessor 3, cfg.firstPredecessor 1] = FordRecursiveQuadruple F) → + (BandPackingSymmetryCircleAction s (t 2) = FordRecursiveQuadruple F 1)) ) := by + classical + intro q cfg t s F hrev hford' + have hh := congrArg (fun z : Fin 4 → CircleCoordinates => z 1) hford' + simpa [BandPackingSymmetryQuadrupleAction, hrev] using hh + +private theorem hF2 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let t := cfg.firstPredecessor + ∀ (s : BandPackingSymmetry), ∀ (F : FordFareyParameter), + (BandPackingSymmetryReversesOrientation s = false) → + ((BandPackingSymmetryQuadrupleAction s ![cfg.firstPredecessor 0, cfg.firstPredecessor + 2, cfg.firstPredecessor 3, cfg.firstPredecessor 1] = FordRecursiveQuadruple F) → + (BandPackingSymmetryCircleAction s (t 3) = FordRecursiveQuadruple F 2)) ) := by + classical + intro q cfg t s F hrev hford' + have hh := congrArg (fun z : Fin 4 → CircleCoordinates => z 2) hford' + simpa [BandPackingSymmetryQuadrupleAction, hrev] using hh + +private theorem hF3 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let t := cfg.firstPredecessor + ∀ (s : BandPackingSymmetry), ∀ (F : FordFareyParameter), + (BandPackingSymmetryReversesOrientation s = false) → + ((BandPackingSymmetryQuadrupleAction s ![cfg.firstPredecessor 0, cfg.firstPredecessor + 2, cfg.firstPredecessor 3, cfg.firstPredecessor 1] = FordRecursiveQuadruple F) → + (BandPackingSymmetryCircleAction s (t 1) = FordRecursiveQuadruple F 3)) ) := by + classical + intro q cfg t s F hrev hford' + have hh := congrArg (fun z : Fin 4 → CircleCoordinates => z 3) hford' + simpa [BandPackingSymmetryQuadrupleAction, hrev] using hh + +private theorem hsF1 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let t := cfg.firstPredecessor + ∀ (s : BandPackingSymmetry), ∀ (F : FordFareyParameter), + (BandPackingSymmetryReversesOrientation s = false) → + ((BandPackingSymmetryCircleAction s (t 1) = FordRecursiveQuadruple F 3) → + (BandPackingSymmetryQuadrupleAction s t 1 = FordRecursiveQuadruple F 3)) ) := by + classical + intro q cfg t s F hrev hF3 + simpa [BandPackingSymmetryQuadrupleAction, hrev] using hF3 + +private theorem houter : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), + let t := cfg.firstPredecessor + ∀ (s : BandPackingSymmetry), ∀ (F : FordFareyParameter), + let succ (a : Fin 4 → CircleCoordinates) : Fin 4 → CircleCoordinates := + ![(2 * (a 0).1 + 2 * (a 2).1 + 2 * (a 3).1 - (a 1).1, + 2 * (a 0).2 + 2 * (a 2).2 + 2 * (a 3).2 - (a 1).2), + a 0, a 2, a 3] + (q = succ t) → ((BandPackingSymmetryQuadrupleAction s (succ t) = succ + (BandPackingSymmetryQuadrupleAction s t)) → ((BandPackingSymmetryQuadrupleAction s t + 0 = FordRecursiveQuadruple F 0) → ((BandPackingSymmetryQuadrupleAction s t 1 = + FordRecursiveQuadruple F 3) → ((BandPackingSymmetryQuadrupleAction s t 2 = + FordRecursiveQuadruple F 1) → ((BandPackingSymmetryQuadrupleAction s t 3 = + FordRecursiveQuadruple F 2) → (BandPackingSymmetryQuadrupleAction s q = ![(2 * + (FordRecursiveQuadruple F 0).1 + 2 * (FordRecursiveQuadruple F 1).1 + 2 * + (FordRecursiveQuadruple F 2).1 - (FordRecursiveQuadruple F 3).1, 2 * + (FordRecursiveQuadruple F 0).2 + 2 * (FordRecursiveQuadruple F 1).2 + 2 * + (FordRecursiveQuadruple F 2).2 - (FordRecursiveQuadruple F 3).2), + FordRecursiveQuadruple F 0, FordRecursiveQuadruple F 1, FordRecursiveQuadruple F + 2])))))) ) := by + classical + intro q cfg t s F succ hqSucc hsuccCov hsF0 hsF1 hsF2 hsF3 + rw [hqSucc, hsuccCov] + funext i + fin_cases i + · simp? [succ] + constructor + · rw [hsF0, hsF2, hsF3, hsF1] + · rw [hsF0, hsF2, hsF3, hsF1] + · simpa [succ] using hsF0 + · simpa [succ] using hsF2 + · simpa [succ] using hsF3 + +private theorem hW : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (s : BandPackingSymmetry), ∀ (F : + FordFareyParameter), ((1 : ℕ) < F.q) → ((BandPackingSymmetryQuadrupleAction s q = + ![(2 * (FordRecursiveQuadruple F 0).1 + 2 * (FordRecursiveQuadruple F 1).1 + 2 * + (FordRecursiveQuadruple F 2).1 - (FordRecursiveQuadruple F 3).1, 2 * + (FordRecursiveQuadruple F 0).2 + 2 * (FordRecursiveQuadruple F 1).2 + 2 * + (FordRecursiveQuadruple F 2).2 - (FordRecursiveQuadruple F 3).2), + FordRecursiveQuadruple F 0, FordRecursiveQuadruple F 1, FordRecursiveQuadruple F 2]) + → (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2) = ⟨-(F.q₁ : Int), (F.q₂ : Int)⟩)) ) := by + classical + intro q s F hFq houter + have fc := (FordCoordinateConfiguration F).2 hFq + have laws := VectorRecursionLaws (FordRecursiveQuadruple F) fc.1.1 + have hv10 := fc.2.1 + have hv20 := fc.2.2.1 + have hsum : (F.q : Int) = (F.q₁ : Int) + F.q₂ := by exact_mod_cast F.sum_q + let rot : Fin 4 → CircleCoordinates := + ![FordRecursiveQuadruple F 0, FordRecursiveQuadruple F 2, + FordRecursiveQuadruple F 3, FordRecursiveQuadruple F 1] + have hrot : SemiProperQuadruple rot := by + simpa [rot] using SemiProperQuadruple.rotate fc.1.1 + have lawsRot := VectorRecursionLaws rot hrot + let rot2 : Fin 4 → CircleCoordinates := + ![FordRecursiveQuadruple F 0, FordRecursiveQuadruple F 3, + FordRecursiveQuadruple F 1, FordRecursiveQuadruple F 2] + have hrot2 : SemiProperQuadruple rot2 := by + simpa [rot2] using + SemiProperQuadruple.rotate (SemiProperQuadruple.rotate fc.1.1) + have lawsRot2 := VectorRecursionLaws rot2 hrot2 + rw [houter] + change BandVectors.1 (FordRecursiveQuadruple F 2) + (FordRecursiveQuadruple F 1) = _ + have e1 := laws.2.2.1 + have e2 : BandVectors.1 (FordRecursiveQuadruple F 2) + (FordRecursiveQuadruple F 0) = + BandVectors.1 (FordRecursiveQuadruple F 2) + (FordRecursiveQuadruple F 1) - + (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (FordRecursiveQuadruple F 3) + (FordRecursiveQuadruple F 2) := by + simpa [rot] using lawsRot.2.2.1 + have e4 : BandVectors.1 (FordRecursiveQuadruple F 3) + (FordRecursiveQuadruple F 0) = + BandVectors.1 (FordRecursiveQuadruple F 3) + (FordRecursiveQuadruple F 2) - + (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (FordRecursiveQuadruple F 1) + (FordRecursiveQuadruple F 3) := by + simpa [rot2] using lawsRot2.2.2.1 + have e3 := laws.1 + have hv30 := fc.2.2.2.1 + rw [hv10] at e1 + rw [hv20] at e2 + rw [hv30] at e4 + have imul (z : GaussianInt) : + (⟨0, 1⟩ : GaussianInt) * z = GaussianQuarterTurn z := by + ext <;> simp [GaussianQuarterTurn] + rw [imul] at e1 e2 e4 + have e1r := congrArg (fun z : GaussianInt => z.re) e1 + have e1i := congrArg (fun z : GaussianInt => z.im) e1 + have e2r := congrArg (fun z : GaussianInt => z.re) e2 + have e2i := congrArg (fun z : GaussianInt => z.im) e2 + have e4r := congrArg (fun z : GaussianInt => z.re) e4 + have e4i := congrArg (fun z : GaussianInt => z.im) e4 + have e3r := congrArg (fun z : GaussianInt => z.re) e3 + have e3i := congrArg (fun z : GaussianInt => z.im) e3 + simp [GaussianQuarterTurn] at e1r e1i e2r e2i e3r e3i e4r e4i + apply Zsqrtd.ext + · nlinarith [e1r, e2r, e3r, e4r] + · nlinarith [e1i, e2i, e3i, e4i, hsum] + +private theorem hA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (s : BandPackingSymmetry), ∀ (F : + FordFareyParameter), ((1 : ℕ) < F.q) → ((BandPackingSymmetryQuadrupleAction s q = + ![(2 * (FordRecursiveQuadruple F 0).1 + 2 * (FordRecursiveQuadruple F 1).1 + 2 * + (FordRecursiveQuadruple F 2).1 - (FordRecursiveQuadruple F 3).1, 2 * + (FordRecursiveQuadruple F 0).2 + 2 * (FordRecursiveQuadruple F 1).2 + 2 * + (FordRecursiveQuadruple F 2).2 - (FordRecursiveQuadruple F 3).2), + FordRecursiveQuadruple F 0, FordRecursiveQuadruple F 1, FordRecursiveQuadruple F 2]) + → (BandVectors.2 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2) = ⟨F.p₂, -F.p₁⟩)) ) := by + classical + intro q s F hFq houter + have fc := (FordCoordinateConfiguration F).2 hFq + have laws := VectorRecursionLaws (FordRecursiveQuadruple F) fc.1.1 + have ha32 := fc.2.2.2.2.2.2.2.1 + have ha13 := fc.2.2.2.2.2.2.2.2 + rw [houter] + change BandVectors.2 (FordRecursiveQuadruple F 2) + (FordRecursiveQuadruple F 1) = _ + calc + BandVectors.2 (FordRecursiveQuadruple F 2) (FordRecursiveQuadruple F 1) = + -(BandVectors.2 (FordRecursiveQuadruple F 3) + (FordRecursiveQuadruple F 2) + + BandVectors.2 (FordRecursiveQuadruple F 1) + (FordRecursiveQuadruple F 3)) := by linear_combination laws.2.1 + _ = _ := by rw [ha32, ha13]; ext <;> simp + +private theorem hrootCircle : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (s : + BandPackingSymmetry), ∀ (F : FordFareyParameter), + (BandPackingSymmetryReversesOrientation s = false) → + ((BandPackingSymmetryQuadrupleAction s ![cfg.firstPredecessor 0, cfg.firstPredecessor + 2, cfg.firstPredecessor 3, cfg.firstPredecessor 1] = FordRecursiveQuadruple F) → + (BandPackingSymmetryCircleAction s (q 1) = FordCircleCoordinate F.p F.q)) ) := by + classical + intro q cfg s F hrev hford' + have hh := congrFun hford' 0 + simpa [BandPackingSymmetryQuadrupleAction, BandPackingSymmetryReversesOrientation, + hrev, cfg.firstChild, FordRecursiveQuadruple] using hh + +end FordNormalizationProof + +theorem P5472T1FordNormalization + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (hzero : (cfg.firstPredecessor 1).1 = 0) : + ∃ (F : FordFareyParameter) (s : BandPackingSymmetry), + 1 < F.q ∧ + BandPackingSymmetryReversesOrientation s = false ∧ + (∃ w : GaussianInt, s = .shift w ∨ s = (BandPackingSymmetry.shift w).comp .negate) ∧ + BandPackingSymmetryQuadrupleAction s + ![cfg.firstPredecessor 0, cfg.firstPredecessor 2, + cfg.firstPredecessor 3, cfg.firstPredecessor 1] = + FordRecursiveQuadruple F ∧ + BandPackingSymmetryCircleAction s (q 1) = FordCircleCoordinate F.p F.q ∧ + BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2) = + ⟨-(F.q₁ : Int), (F.q₂ : Int)⟩ ∧ + BandVectors.2 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2) = ⟨F.p₂, -F.p₁⟩ := by +-- BODY + let t := cfg.firstPredecessor + have htproper : ProperBandQuadruple t := cfg.firstProper + have hcurv := ProperBandCurvatureStructure t htproper + obtain ⟨ridx, s, F, hFq, hrev, hword, hline, hford⟩ := + FordRegimeConverse t htproper ⟨1, hzero⟩ + have hridx := FordNormalizationProof.hridx q cfg hzero hcurv ridx s F hline hford + subst ridx + have hford' := FordNormalizationProof.hford' q cfg s F hford + let succ (a : Fin 4 → CircleCoordinates) : Fin 4 → CircleCoordinates := + ![(2 * (a 0).1 + 2 * (a 2).1 + 2 * (a 3).1 - (a 1).1, + 2 * (a 0).2 + 2 * (a 2).2 + 2 * (a 3).2 - (a 1).2), + a 0, a 2, a 3] + have hqSucc := FordNormalizationProof.hqSucc q cfg + have hsuccCov := FordNormalizationProof.hsuccCov q cfg s hword + have hF0 : BandPackingSymmetryCircleAction s (t 0) = + FordRecursiveQuadruple F 0 := FordNormalizationProof.hF0 q cfg s F hrev hford' + have hF1 : BandPackingSymmetryCircleAction s (t 2) = + FordRecursiveQuadruple F 1 := FordNormalizationProof.hF1 q cfg s F hrev hford' + have hF2 : BandPackingSymmetryCircleAction s (t 3) = + FordRecursiveQuadruple F 2 := FordNormalizationProof.hF2 q cfg s F hrev hford' + have hF3 := FordNormalizationProof.hF3 q cfg s F hrev hford' + have hsF0 : BandPackingSymmetryQuadrupleAction s t 0 = + FordRecursiveQuadruple F 0 := by simpa [BandPackingSymmetryQuadrupleAction, hrev] using hF0 + have hsF1 := FordNormalizationProof.hsF1 q cfg s F hrev hF3 + have hsF2 : BandPackingSymmetryQuadrupleAction s t 2 = + FordRecursiveQuadruple F 1 := by simpa [BandPackingSymmetryQuadrupleAction, hrev] using hF1 + have hsF3 : BandPackingSymmetryQuadrupleAction s t 3 = + FordRecursiveQuadruple F 2 := by simpa [BandPackingSymmetryQuadrupleAction, hrev] using hF2 + have houter := FordNormalizationProof.houter q cfg s F hqSucc hsuccCov hsF0 hsF1 hsF2 hsF3 + have hW := FordNormalizationProof.hW q s F hFq houter + have hA := FordNormalizationProof.hA q s F hFq houter + have hrootCircle := FordNormalizationProof.hrootCircle q cfg s F hrev hford' + exact ⟨F, s, hFq, hrev, hword, hford', hrootCircle, hW, hA⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean b/LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean new file mode 100644 index 0000000000..60be18a8b3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean @@ -0,0 +1,199 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.P5472T1AffineDifferenceTransport +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate + +-- [TABLET NODE: P5472T1FordSlopeDifference] + +/-! +# P5472T1FordSlopeDifference + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5472T1FordSlopeDifference + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C0 : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C0 T) + (h : PartialOdometer) + (P : Fin 3 → Bool → ProtoTile) + (r : Fin 3 → Bool → PartialOdometer) + (Q S : Fin 3 → Bool → ProtoTile) + (u v : Fin 3 → Bool → PartialOdometer) + (g : IntegerLatticeFunction) (x : GaussianInt) + (data : BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) + (F : FordFareyParameter) (s : BandPackingSymmetry) (delta : Bool) + (hword : ∃ z : GaussianInt, s = .shift z ∨ s = (BandPackingSymmetry.shift z).comp .negate) + (hrootCircle : BandPackingSymmetryCircleAction s (q 1) = FordCircleCoordinate F.p F.q) + (hA : BandVectors.2 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2) = ⟨F.p₂, -F.p₁⟩) + (hcyclic : + let I : GaussianInt := ⟨0, 1⟩ + let W := BandVectors.1 (q 3) (q 2) + let A := BandVectors.2 (q 3) (q 2) + let A' := BandVectors.2 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2) + (BandPackingSymmetryAffineVectorAction s (W - I * W, A + I * A)).2 = + if delta then -(A' + I * A') else A' + I * A') : + let c := BandPackingSymmetryVectorAction s x + let hp := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 (!delta))) (-c) 0 0 + let hm := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 delta)) (-c) 0 0 + ∃ sp sm : Real × Real, + PartialOdometerSlope hp = some sp ∧ PartialOdometerSlope hm = some sm ∧ + sm.1 - sp.1 = -(F.p : Real) ∧ sm.2 - sp.2 = (F.p₁ : Real) - F.p₂ := by +-- BODY + have hcurvSym : ∀ a C, (BandPackingSymmetryCircleAction a C).1 = C.1 := by + intro a + induction a <;> intro C <;> + simp [BandPackingSymmetryCircleAction, *] + have hq1pos : 0 < (q 1).1 := by + have hh := congrArg Prod.fst hrootCircle + rw [hcurvSym] at hh + simp? [FordCircleCoordinate] at hh + have : 0 < F.q * F.q := Nat.mul_pos F.q_pos F.q_pos + omega + let I : GaussianInt := ⟨0, 1⟩ + let Wsource : GaussianInt := BandVectors.1 (q 3) (q 2) + let Asource : GaussianInt := BandVectors.2 (q 3) (q 2) + have hrawSlope (b : Bool) : + ∃ p pi : Real × Real, + PartialOdometerSlope h = some p ∧ + PartialOdometerSlope (r 0 b) = some pi ∧ + pi.1 - p.1 = (if b then (1 : Real) else -1) * (1 / 2) * + (((Asource.re : Int) : Real) - ((Asource.im : Int) : Real)) ∧ + pi.2 - p.2 = (if b then (1 : Real) else -1) * (1 / 2) * + (((Asource.im : Int) : Real) + ((Asource.re : Int) : Real)) := by + rcases data.hPslope 0 b with hz | hslope + · exact (ne_of_gt hq1pos hz).elim + · simpa [Asource] using hslope + let Icyc : GaussianInt := ⟨0, 1⟩ + let vcyc : GaussianInt := Wsource - Icyc * Wsource + let acyc : GaussianInt := Asource + Icyc * Asource + have hWreal : GaussianRealPoint vcyc = GaussianRealPoint Wsource - + (-(GaussianRealPoint Wsource).2, (GaussianRealPoint Wsource).1) := by + change GaussianRealPoint (Wsource - Icyc * Wsource) = _ + cases Wsource with + | mk wr wi => + ext <;> simp [Icyc, GaussianRealPoint] + have hAreal : GaussianRealPoint acyc = + ((((Asource.re : Int) : Real) - ((Asource.im : Int) : Real)), + (((Asource.im : Int) : Real) + ((Asource.re : Int) : Real))) := by + change GaussianRealPoint (Asource + Icyc * Asource) = _ + cases Asource with + | mk ar ai => + ext <;> simp [Icyc, GaussianRealPoint]; ring + have hcentSource (b : Bool) : + TileCentroid (P 0 b) - TileCentroid T = + (if b then (1 / 2 : Real) else -(1 / 2 : Real)) • + GaussianRealPoint vcyc := by + have hh := data.hPcent 0 b + have hh' : TileCentroid (P 0 b) - TileCentroid T = + (if b then (1 : Real) else -1) • ((1 / 2 : Real) • + (GaussianRealPoint Wsource - + (-(GaussianRealPoint Wsource).2, (GaussianRealPoint Wsource).1))) := by + simpa [Wsource] using hh + rw [← hWreal] at hh' + cases b <;> simpa [smul_smul, smul_eq_mul] using hh' + have hslopeSource (b : Bool) : + ∃ p pi : Real × Real, + PartialOdometerSlope h = some p ∧ + PartialOdometerSlope (r 0 b) = some pi ∧ + pi - p = (if b then (1 / 2 : Real) else -(1 / 2 : Real)) • + GaussianRealPoint acyc := by + obtain ⟨p, pi, hp, hpi, hdx, hdy⟩ := hrawSlope b + refine ⟨p, pi, hp, hpi, ?_⟩ + apply Prod.ext + · cases b <;> simpa [hAreal, smul_eq_mul] using hdx + · cases b <;> simpa [hAreal, smul_eq_mul] using hdy + have positiveCells : ∀ (D : CircleCoordinates) (V : ProtoTile), + 0 < D.1 → BandPrototile D V → V.cells.Nonempty := by + intro D V hD hV + induction hV with + | line w x hw => simp at hD + | unit z x anchor => simp + | @decompose q hq S V hS hcells hfoot hcentroid ih => + have facts := ProperBandCurvatureStructure q hq + have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by + by_cases h0 : 0 < (q (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (q (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + have n0 := facts.2.1 (0 : Fin 3) + have n1 := facts.2.1 (1 : Fin 3) + have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim + rcases hp with ⟨i, hi⟩ + rcases ih i false hi with ⟨z, hz⟩ + exact ⟨z, (hcells z).mpr ⟨i, false, hz⟩⟩ + have hTne := positiveCells (q 0) T (ProperBandCurvatureStructure q cfg.proper).1 + data.hPband + have hsigned (b : Bool) : + ∃ p pi : Real × Real, + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction s h) = some p ∧ + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction s (r 0 b)) = some pi ∧ + pi - p = (if b then (1 / 2 : Real) else -(1 / 2 : Real)) • + GaussianRealPoint (BandPackingSymmetryAffineVectorAction s (vcyc, acyc)).2 := by + obtain ⟨p, pi, hp, hpi, hd⟩ := hslopeSource b + have hn := positiveCells (q 1) (P 0 b) hq1pos + (TileOdometerBandPrototile _ _ _ (data.hP 0 b)) + have hroot := (BandPackingSymmetryTileOdometerCovariance s (q 0) T h + data.hroot).2.2 hTne + have hchild := (BandPackingSymmetryTileOdometerCovariance s (q 1) (P 0 b) + (r 0 b) (data.hP 0 b)).2.2 hn + rw [hp] at hroot + rw [hpi] at hchild + refine ⟨BandPackingSymmetrySlopeAction s T p, + BandPackingSymmetrySlopeAction s (P 0 b) pi, hroot, hchild, ?_⟩ + exact (P5472T1AffineDifferenceTransport s hword T (P 0 b) pi p + vcyc acyc _ (hcentSource b) hd).2 + obtain ⟨p, sp, hp, hsp, dp⟩ := hsigned (!delta) + obtain ⟨p', sm, hp', hsm, dm⟩ := hsigned delta + have ep : p' = p := Option.some.inj (hp'.symm.trans hp) + subst p' + refine ⟨sp, sm, ?_, ?_, ?_, ?_⟩ + · rw [(PartialOdometerAffineTranslateFormulas _ _ _ _).2.2.2.2.2, hsp] + simp + · rw [(PartialOdometerAffineTranslateFormulas _ _ _ _).2.2.2.2.2, hsm] + simp + · have hpair := hcyclic + change (BandPackingSymmetryAffineVectorAction s (vcyc, acyc)).2 = _ at hpair + rw [hA] at hpair + have dp1 := congrArg Prod.fst dp + have dm1 := congrArg Prod.fst dm + rw [hpair] at dp1 dm1 + cases delta <;> + simp [GaussianRealPoint] at dp1 dm1 <;> + have hsum : (F.p : Real) = (F.p₁ : Real) + F.p₂ := by exact_mod_cast F.sum_p + all_goals linarith + · have hpair := hcyclic + change (BandPackingSymmetryAffineVectorAction s (vcyc, acyc)).2 = _ at hpair + rw [hA] at hpair + have dp2 := congrArg Prod.snd dp + have dm2 := congrArg Prod.snd dm + rw [hpair] at dp2 dm2 + cases delta <;> + simp [GaussianRealPoint] at dp2 dm2 <;> + linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1LiteralFordPlacement.lean b/LeanPool/ApollonianSuperharmonic/P5472T1LiteralFordPlacement.lean new file mode 100644 index 0000000000..d5ae3c2de8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5472T1LiteralFordPlacement.lean @@ -0,0 +1,754 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation + +-- [TABLET NODE: P5472T1LiteralFordPlacement] + +/-! +# P5472T1LiteralFordPlacement + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace LiteralFordPlacementGeometry + +private theorem hplus' : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (r : Fin 3 → Bool + → PartialOdometer), ∀ (Q : Fin 3 → Bool → ProtoTile), ∀ (S : Fin 3 → Bool → + ProtoTile), ∀ (u : Fin 3 → Bool → PartialOdometer), ∀ (v : Fin 3 → Bool → + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), + (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → (∀ (F : + FordFareyParameter), ∀ (s : BandPackingSymmetry), ∀ (delta : Bool), + (BandPackingSymmetryCircleAction s (q (1 : Fin (4 : ℕ))) = FordCircleCoordinate F.p + F.q) → ( + let c := BandPackingSymmetryVectorAction s x + let U := TileTranslation (BandPackingSymmetryTileAction s (P 0 (!delta))) (-c) + let hp := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 (!delta))) (-c) 0 0 + TileOdometer (FordCircleCoordinate F.p F.q) U hp)) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g x data F s delta hrootCircle c U hp + have hc := (BandPackingSymmetryTileOdometerCovariance s (q 1) + (P 0 (!delta)) (r 0 (!delta)) (data.hP 0 (!delta))).1 + rw [hrootCircle] at hc + simpa [U, hp, c] using + TileOdometerAffineTranslation _ _ _ _ _ _ hc + +private theorem hminus' : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (r : Fin 3 → Bool + → PartialOdometer), ∀ (Q : Fin 3 → Bool → ProtoTile), ∀ (S : Fin 3 → Bool → + ProtoTile), ∀ (u : Fin 3 → Bool → PartialOdometer), ∀ (v : Fin 3 → Bool → + PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), + (BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) → (∀ (F : + FordFareyParameter), ∀ (s : BandPackingSymmetry), ∀ (delta : Bool), + (BandPackingSymmetryCircleAction s (q (1 : Fin (4 : ℕ))) = FordCircleCoordinate F.p + F.q) → ( + let c := BandPackingSymmetryVectorAction s x + let V := TileTranslation (BandPackingSymmetryTileAction s (P 0 delta)) (-c) + let hm := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 delta)) (-c) 0 0 + TileOdometer (FordCircleCoordinate F.p F.q) V hm)) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g x data F s delta hrootCircle c V hm + have hc := (BandPackingSymmetryTileOdometerCovariance s (q 1) + (P 0 delta) (r 0 delta) (data.hP 0 delta)).1 + rw [hrootCircle] at hc + simpa [V, hm, c] using + TileOdometerAffineTranslation _ _ _ _ _ _ hc + +private theorem hocc : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (r : Fin 3 → Bool + → PartialOdometer), ∀ (Q : Fin 3 → Bool → ProtoTile), ∀ (S : Fin 3 → Bool → + ProtoTile), ∀ (u : Fin 3 → Bool → PartialOdometer), ∀ (v : Fin 3 → Bool → + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → (∀ (i : Fin 3), ∀ (b : Bool), + BandSubtileOccurrence q T i b (P i b)) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data i b + refine ⟨TileOdometerBandPrototile _ _ _ (data.hP i b), data.hPfoot i b, ?_⟩ + exact data.hPcent i b + +private theorem hePlus : + (by + classical + exact + ∀ (s : BandPackingSymmetry), ∀ (delta : Bool), (BandPackingSymmetryReversesOrientation s + = false) → (∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), (∀ (i : Fin (3 : ℕ)), ∀ + (s_1 : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s_1) = ((fun (i : Fin + (3 : ℕ)) => if BandPackingSymmetryReversesOrientation s = true then -i else i) i, s_1 + ^^ delta)) → (e (0, !delta) = (0, true))) ) := by + classical + intro s delta hrev e he + have hh := he 0 (!delta) + simpa [hrev] using hh + +private theorem heMinus : + (by + classical + exact + ∀ (s : BandPackingSymmetry), ∀ (delta : Bool), (BandPackingSymmetryReversesOrientation s + = false) → (∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), (∀ (i : Fin (3 : ℕ)), ∀ + (s_1 : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s_1) = ((fun (i : Fin + (3 : ℕ)) => if BandPackingSymmetryReversesOrientation s = true then -i else i) i, s_1 + ^^ delta)) → (e (0, delta) = (0, false))) ) := by + classical + intro s delta hrev e he + have hh := he 0 delta + simpa [hrev] using hh + +private theorem hPplusCent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (P : Fin 3 → Bool → ProtoTile), ∀ + (s : BandPackingSymmetry), ∀ (delta : Bool), ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) + × Bool), ∀ (P' : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s_1 : + Bool), P' ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s_1)).1 ((e : Fin (3 : + ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s_1)).2 = BandPackingSymmetryTileAction s (P i + s_1)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s_1 : Bool), BandSubtileOccurrence + (BandPackingSymmetryQuadrupleAction s q) (BandPackingSymmetryTileAction s T) i s_1 + (P' i s_1)) → ((e (0, !delta) = (0, true)) → (TileCentroid + (BandPackingSymmetryTileAction s (P 0 (!delta))) - TileCentroid + (BandPackingSymmetryTileAction s T) = (1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2)) - (-(GaussianRealPoint (BandVectors.1 + (BandPackingSymmetryQuadrupleAction s q 3) (BandPackingSymmetryQuadrupleAction s q + 2))).2, (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2))).1)))))) ) := by + classical + intro q T P s delta e P' hPmap hPocc hePlus + have hh := (hPocc 0 true).2.2 + have hm := hPmap 0 (!delta) + have hm' : P' 0 true = BandPackingSymmetryTileAction s (P 0 (!delta)) := by + simpa [hePlus] using hm + rw [hm'] at hh + simpa [BandSubtileOccurrence] using hh + +private theorem hPminusCent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (P : Fin 3 → Bool → ProtoTile), ∀ + (s : BandPackingSymmetry), ∀ (delta : Bool), ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) + × Bool), ∀ (P' : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s_1 : + Bool), P' ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s_1)).1 ((e : Fin (3 : + ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s_1)).2 = BandPackingSymmetryTileAction s (P i + s_1)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s_1 : Bool), BandSubtileOccurrence + (BandPackingSymmetryQuadrupleAction s q) (BandPackingSymmetryTileAction s T) i s_1 + (P' i s_1)) → ((e (0, delta) = (0, false)) → (TileCentroid + (BandPackingSymmetryTileAction s (P 0 delta)) - TileCentroid + (BandPackingSymmetryTileAction s T) = (-1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2)) - (-(GaussianRealPoint (BandVectors.1 + (BandPackingSymmetryQuadrupleAction s q 3) (BandPackingSymmetryQuadrupleAction s q + 2))).2, (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2))).1)))))) ) := by + classical + intro q T P s delta e P' hPmap hPocc heMinus + have hh := (hPocc 0 false).2.2 + have hm := hPmap 0 delta + have hm' : P' 0 false = BandPackingSymmetryTileAction s (P 0 delta) := by + simpa [heMinus] using hm + rw [hm'] at hh + simpa [BandSubtileOccurrence] using hh + +private theorem hcenter' : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (P : Fin 3 → Bool → ProtoTile), ∀ + (r : Fin 3 → Bool → PartialOdometer), ∀ (x : GaussianInt), (GaussianRealPoint x = + TileCentroid T) → (∀ (F : FordFareyParameter), ∀ (s : BandPackingSymmetry), ∀ (delta + : Bool), (BandPackingSymmetryReversesOrientation s = false) → ((∃ (z : GaussianInt), + s = BandPackingSymmetry.shift z ∨ s = (BandPackingSymmetry.shift z).comp + BandPackingSymmetry.negate) → ((BandPackingSymmetryScopedPhase s q delta) → + ((BandPackingSymmetryCircleAction s (q (1 : Fin (4 : ℕ))) = FordCircleCoordinate F.p + F.q) → ((BandVectors.1 (BandPackingSymmetryQuadrupleAction s q (3 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction s q (2 : Fin (4 : ℕ))) = (⟨-(↑F.q₁ : ℤ), (↑F.q₂ : + ℤ)⟩ : GaussianInt)) → ( + let c := BandPackingSymmetryVectorAction s x + let U := TileTranslation (BandPackingSymmetryTileAction s (P 0 (!delta))) (-c) + let V := TileTranslation (BandPackingSymmetryTileAction s (P 0 delta)) (-c) + let hp := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 (!delta))) (-c) 0 0 + let hm := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 delta)) (-c) 0 0 + (TileOdometer (FordCircleCoordinate F.p F.q) U hp) → ((TileOdometer (FordCircleCoordinate + F.p F.q) V hm) → (∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (P' : Fin (3 : + ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s_1 : Bool), P' ((e : Fin (3 : ℕ) × + Bool → Fin (3 : ℕ) × Bool) (i, s_1)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) + (i, s_1)).2 = BandPackingSymmetryTileAction s (P i s_1)) → ((∀ (i : Fin (3 : ℕ)), ∀ + (s_1 : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction s q) + (BandPackingSymmetryTileAction s T) i s_1 (P' i s_1)) → ((∀ (x : LatticeCell), x ∈ + (BandPackingSymmetryTileAction s T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (P' i + s).cells) → ((BandPackingSymmetryScopedPhase s q delta) → ((∀ (i : Fin (3 : ℕ)), ∀ + (s_1 : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s_1) = ((fun (i : Fin + (3 : ℕ)) => if BandPackingSymmetryReversesOrientation s = true then -i else i) i, s_1 + ^^ delta)) → ((TileCentroid (BandPackingSymmetryTileAction s (P 0 (!delta))) - + TileCentroid (BandPackingSymmetryTileAction s T) = (1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2)) - (-(GaussianRealPoint (BandVectors.1 + (BandPackingSymmetryQuadrupleAction s q 3) (BandPackingSymmetryQuadrupleAction s q + 2))).2, (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2))).1)))) → ((TileCentroid + (BandPackingSymmetryTileAction s (P 0 delta)) - TileCentroid + (BandPackingSymmetryTileAction s T) = (-1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2)) - (-(GaussianRealPoint (BandVectors.1 + (BandPackingSymmetryQuadrupleAction s q 3) (BandPackingSymmetryQuadrupleAction s q + 2))).2, (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2))).1)))) → (TileCentroid + (BandPackingSymmetryTileAction s T) = GaussianRealPoint c))))))))))))))) ) := by + classical + intro q T P r x hcenter F s delta hrev hword hphase hrootCircle hW c U V hp hm hplus' hminus' e + P' hPmap hPocc hPcover hdphase he hPplusCent hPminusCent + rcases hword with ⟨w, hs | hs⟩ + · subst s + simpa [c, BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] using + hcenter.symm + · subst s + change TileCentroid (TileQuarterTurn T) = + GaussianRealPoint (GaussianQuarterTurn x) + rw [(TileQuarterTurnFormulas T).2.2.2.2.1] + have hh := congrArg (fun p : Real × Real => (-p.2, p.1)) hcenter + simpa [GaussianRealPoint, GaussianQuarterTurn] using hh.symm + +private theorem hDplus : + (by + classical + exact + ∀ (F : FordFareyParameter), ((F.q : Real) = (F.q₁ : Real) + F.q₂) → ((1 : Real) • ((1 / 2 + : Real) • (GaussianRealPoint (⟨-(F.q₁ : Int), (F.q₂ : Int)⟩ : GaussianInt) - + (-(GaussianRealPoint (⟨-(F.q₁ : Int), (F.q₂ : Int)⟩ : GaussianInt)).2, + (GaussianRealPoint (⟨-(F.q₁ : Int), (F.q₂ : Int)⟩ : GaussianInt)).1))) = (((F.q₂ : + Real) - F.q₁) / 2, (F.q : Real) / 2)) ) := by + classical + intro F hsumReal + ext <;> simp [GaussianRealPoint] <;> linarith + +private theorem hDminus : + (by + classical + exact + ∀ (F : FordFareyParameter), ((F.q : Real) = (F.q₁ : Real) + F.q₂) → ((-1 : Real) • ((1 / + 2 : Real) • (GaussianRealPoint (⟨-(F.q₁ : Int), (F.q₂ : Int)⟩ : GaussianInt) - + (-(GaussianRealPoint (⟨-(F.q₁ : Int), (F.q₂ : Int)⟩ : GaussianInt)).2, + (GaussianRealPoint (⟨-(F.q₁ : Int), (F.q₂ : Int)⟩ : GaussianInt)).1))) = (-((F.q₂ : + Real) - F.q₁) / 2, -(F.q : Real) / 2)) ) := by + classical + intro F hsumReal + ext <;> simp [GaussianRealPoint] <;> linarith + +private theorem hUcent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (P : Fin 3 → Bool → ProtoTile), ∀ + (x : GaussianInt), ∀ (F : FordFareyParameter), ∀ (s : BandPackingSymmetry), ∀ (delta + : Bool), (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q (3 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction s q (2 : Fin (4 : ℕ))) = (⟨-(↑F.q₁ : ℤ), (↑F.q₂ : + ℤ)⟩ : GaussianInt)) → ( + let c := BandPackingSymmetryVectorAction s x + let U := TileTranslation (BandPackingSymmetryTileAction s (P 0 (!delta))) (-c) + (TileCentroid (BandPackingSymmetryTileAction s (P 0 (!delta))) - TileCentroid + (BandPackingSymmetryTileAction s T) = (1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2)) - (-(GaussianRealPoint (BandVectors.1 + (BandPackingSymmetryQuadrupleAction s q 3) (BandPackingSymmetryQuadrupleAction s q + 2))).2, (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2))).1)))) → ((TileCentroid + (BandPackingSymmetryTileAction s T) = GaussianRealPoint c) → (((1 : Real) • ((1 / 2 : + Real) • (GaussianRealPoint (⟨-(F.q₁ : Int), (F.q₂ : Int)⟩ : GaussianInt) - + (-(GaussianRealPoint (⟨-(F.q₁ : Int), (F.q₂ : Int)⟩ : GaussianInt)).2, + (GaussianRealPoint (⟨-(F.q₁ : Int), (F.q₂ : Int)⟩ : GaussianInt)).1))) = (((F.q₂ : + Real) - F.q₁) / 2, (F.q : Real) / 2)) → (TileCentroid U = (((F.q₂ : Real) - F.q₁) / + 2, (F.q : Real) / 2))))) ) := by + classical + intro q T P x F s delta hW c U hPplusCent hcenter' hDplus + have hh := hPplusCent + rw [hW, hcenter'] at hh + rw [(TileTranslationFormulas + (BandPackingSymmetryTileAction s (P 0 (!delta))) (-c)).2.2.2.2.1] + change TileCentroid (BandPackingSymmetryTileAction s (P 0 (!delta))) + + GaussianRealPoint (-c) = _ + have hsub := hh + rw [hDplus] at hsub + have hsub1 : (TileCentroid (BandPackingSymmetryTileAction s (P 0 (!delta)))).1 - + (c.re : Real) = ((F.q₂ : Real) - F.q₁) / 2 := by + simpa [GaussianRealPoint] using congrArg Prod.fst hsub + have hsub2 : (TileCentroid (BandPackingSymmetryTileAction s (P 0 (!delta)))).2 - + (c.im : Real) = (F.q : Real) / 2 := by + simpa [GaussianRealPoint] using congrArg Prod.snd hsub + have heq : TileCentroid (BandPackingSymmetryTileAction s (P 0 (!delta))) = + GaussianRealPoint c + + (((F.q₂ : Real) - F.q₁) / 2, (F.q : Real) / 2) := by + apply Prod.ext + · change (TileCentroid (BandPackingSymmetryTileAction s (P 0 (!delta)))).1 = + (c.re : Real) + ((F.q₂ : Real) - F.q₁) / 2 + linarith + · change (TileCentroid (BandPackingSymmetryTileAction s (P 0 (!delta)))).2 = + (c.im : Real) + (F.q : Real) / 2 + linarith + rw [heq] + ext <;> simp [GaussianRealPoint] + +private theorem hVcent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (P : Fin 3 → Bool → ProtoTile), ∀ + (x : GaussianInt), ∀ (F : FordFareyParameter), ∀ (s : BandPackingSymmetry), ∀ (delta + : Bool), (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q (3 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction s q (2 : Fin (4 : ℕ))) = (⟨-(↑F.q₁ : ℤ), (↑F.q₂ : + ℤ)⟩ : GaussianInt)) → ( + let c := BandPackingSymmetryVectorAction s x + let V := TileTranslation (BandPackingSymmetryTileAction s (P 0 delta)) (-c) + (TileCentroid (BandPackingSymmetryTileAction s (P 0 delta)) - TileCentroid + (BandPackingSymmetryTileAction s T) = (-1 : Real) • ((1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2)) - (-(GaussianRealPoint (BandVectors.1 + (BandPackingSymmetryQuadrupleAction s q 3) (BandPackingSymmetryQuadrupleAction s q + 2))).2, (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2))).1)))) → ((TileCentroid + (BandPackingSymmetryTileAction s T) = GaussianRealPoint c) → (((-1 : Real) • ((1 / 2 + : Real) • (GaussianRealPoint (⟨-(F.q₁ : Int), (F.q₂ : Int)⟩ : GaussianInt) - + (-(GaussianRealPoint (⟨-(F.q₁ : Int), (F.q₂ : Int)⟩ : GaussianInt)).2, + (GaussianRealPoint (⟨-(F.q₁ : Int), (F.q₂ : Int)⟩ : GaussianInt)).1))) = (-((F.q₂ : + Real) - F.q₁) / 2, -(F.q : Real) / 2)) → (TileCentroid V = (-((F.q₂ : Real) - F.q₁) / + 2, -(F.q : Real) / 2))))) ) := by + classical + intro q T P x F s delta hW c V hPminusCent hcenter' hDminus + have hh := hPminusCent + rw [hW, hcenter'] at hh + rw [(TileTranslationFormulas + (BandPackingSymmetryTileAction s (P 0 delta)) (-c)).2.2.2.2.1] + change TileCentroid (BandPackingSymmetryTileAction s (P 0 delta)) + + GaussianRealPoint (-c) = _ + have hsub := hh + rw [hDminus] at hsub + have hsub1 : (TileCentroid (BandPackingSymmetryTileAction s (P 0 delta))).1 - + (c.re : Real) = -((F.q₂ : Real) - F.q₁) / 2 := by + simpa [GaussianRealPoint] using congrArg Prod.fst hsub + have hsub2 : (TileCentroid (BandPackingSymmetryTileAction s (P 0 delta))).2 - + (c.im : Real) = -(F.q : Real) / 2 := by + simpa [GaussianRealPoint] using congrArg Prod.snd hsub + have heq : TileCentroid (BandPackingSymmetryTileAction s (P 0 delta)) = + GaussianRealPoint c + + (-((F.q₂ : Real) - F.q₁) / 2, -(F.q : Real) / 2) := by + apply Prod.ext + · change (TileCentroid (BandPackingSymmetryTileAction s (P 0 delta))).1 = + (c.re : Real) + -((F.q₂ : Real) - F.q₁) / 2 + linarith + · change (TileCentroid (BandPackingSymmetryTileAction s (P 0 delta))).2 = + (c.im : Real) + -(F.q : Real) / 2 + linarith + rw [heq] + ext <;> simp [GaussianRealPoint] + +private theorem hFordCells : + (by + classical + exact + ∀ (F : FordFareyParameter), (FordTile F.q).cells.Nonempty ) := by + classical + intro F + refine ⟨⟨0, 0⟩, ?_⟩ + simp [FordTile, FordCellDomain, F.q_pos] + +private theorem hUnon : + (by + classical + exact + ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (r : Fin 3 → Bool → PartialOdometer), ∀ (x : + GaussianInt), ∀ (F : FordFareyParameter), ∀ (s : BandPackingSymmetry), ∀ (delta : Bool), + let c := BandPackingSymmetryVectorAction s x + let U := TileTranslation (BandPackingSymmetryTileAction s (P 0 (!delta))) (-c) + let hp := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 (!delta))) (-c) 0 0 + (TileOdometer (FordCircleCoordinate F.p F.q) U hp) → (∀ (k : PartialOdometer), + (TileOdometer (FordCircleCoordinate F.p F.q) (FordTile F.q) k) → (((FordTile + F.q).cells.Nonempty) → (U.cells.Nonempty))) ) := by + classical + intro P r x F s delta c U hp hplus' k hkO hFordCells + obtain ⟨u₀, hu₀, _⟩ := BandPrototileTranslationNormalForm + (FordCircleCoordinate F.p F.q) U (FordTile F.q) + (TileOdometerBandPrototile _ _ _ hplus') + (TileOdometerBandPrototile _ _ _ hkO) + rw [hu₀] + exact hFordCells.image _ + +private theorem hVnon : + (by + classical + exact + ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (r : Fin 3 → Bool → PartialOdometer), ∀ (x : + GaussianInt), ∀ (F : FordFareyParameter), ∀ (s : BandPackingSymmetry), ∀ (delta : Bool), + let c := BandPackingSymmetryVectorAction s x + let V := TileTranslation (BandPackingSymmetryTileAction s (P 0 delta)) (-c) + let hm := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 delta)) (-c) 0 0 + (TileOdometer (FordCircleCoordinate F.p F.q) V hm) → (∀ (k : PartialOdometer), + (TileOdometer (FordCircleCoordinate F.p F.q) (FordTile F.q) k) → (((FordTile + F.q).cells.Nonempty) → (V.cells.Nonempty))) ) := by + classical + intro P r x F s delta c V hm hminus' k hkO hFordCells + obtain ⟨u₀, hu₀, _⟩ := BandPrototileTranslationNormalForm + (FordCircleCoordinate F.p F.q) V (FordTile F.q) + (TileOdometerBandPrototile _ _ _ hminus') + (TileOdometerBandPrototile _ _ _ hkO) + rw [hu₀] + exact hFordCells.image _ + +private theorem huPlusEq : + (by + classical + exact + ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (x : GaussianInt), ∀ (F : FordFareyParameter), ∀ (s : + BandPackingSymmetry), ∀ (delta : Bool), + let c := BandPackingSymmetryVectorAction s x + let U := TileTranslation (BandPackingSymmetryTileAction s (P 0 (!delta))) (-c) + ((F.q : Real) = (F.q₁ : Real) + F.q₂) → ((TileCentroid U = (((F.q₂ : Real) - F.q₁) / 2, + (F.q : Real) / 2)) → ((TileCentroid (FordTile F.q) = ((↑F.q : ℝ) / (2 : ℝ), (↑F.q : + ℝ) / (2 : ℝ))) → (∀ (uPlus : GaussianInt), (FootprintVertices U = FootprintVertices + (TileTranslation (FordTile F.q) uPlus) ∧ BoundaryFootprintVertices U = + BoundaryFootprintVertices (TileTranslation (FordTile F.q) uPlus) ∧ + BoundaryFootprintEdges U = BoundaryFootprintEdges (TileTranslation (FordTile F.q) + uPlus) ∧ TileRealization U = TileRealization (TileTranslation (FordTile F.q) uPlus) ∧ + TileCentroid U = TileCentroid (TileTranslation (FordTile F.q) uPlus)) → (uPlus = + ⟨-(F.q₁ : Int), 0⟩)))) ) := by + classical + intro P x F s delta c U hsumReal hUcent hFordCent uPlus hobsPlus + have hh := hobsPlus.2.2.2.2 + rw [(TileTranslationFormulas (FordTile F.q) uPlus).2.2.2.2.1, + hFordCent, hUcent] at hh + apply Zsqrtd.ext + · have h := congrArg Prod.fst hh + apply Int.cast_injective (α := Real) + dsimp at h ⊢ + push_cast at h ⊢ + linarith [F.sum_q] + · have h := congrArg Prod.snd hh + apply Int.cast_injective (α := Real) + dsimp at h ⊢ + push_cast at h ⊢ + linarith + +private theorem huMinusEq : + (by + classical + exact + ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (x : GaussianInt), ∀ (F : FordFareyParameter), ∀ (s : + BandPackingSymmetry), ∀ (delta : Bool), + let c := BandPackingSymmetryVectorAction s x + let V := TileTranslation (BandPackingSymmetryTileAction s (P 0 delta)) (-c) + ((F.q : Real) = (F.q₁ : Real) + F.q₂) → ((TileCentroid V = (-((F.q₂ : Real) - F.q₁) / 2, + -(F.q : Real) / 2)) → ((TileCentroid (FordTile F.q) = ((↑F.q : ℝ) / (2 : ℝ), (↑F.q : + ℝ) / (2 : ℝ))) → (∀ (uMinus : GaussianInt), (FootprintVertices V = FootprintVertices + (TileTranslation (FordTile F.q) uMinus) ∧ BoundaryFootprintVertices V = + BoundaryFootprintVertices (TileTranslation (FordTile F.q) uMinus) ∧ + BoundaryFootprintEdges V = BoundaryFootprintEdges (TileTranslation (FordTile F.q) + uMinus) ∧ TileRealization V = TileRealization (TileTranslation (FordTile F.q) uMinus) + ∧ TileCentroid V = TileCentroid (TileTranslation (FordTile F.q) uMinus)) → (uMinus = + ⟨-(F.q₂ : Int), -(F.q : Int)⟩)))) ) := by + classical + intro P x F s delta c V hsumReal hVcent hFordCent uMinus hobsMinus + have hh := hobsMinus.2.2.2.2 + rw [(TileTranslationFormulas (FordTile F.q) uMinus).2.2.2.2.1, + hFordCent, hVcent] at hh + apply Zsqrtd.ext + · have h := congrArg Prod.fst hh + apply Int.cast_injective (α := Real) + dsimp at h ⊢ + push_cast at h ⊢ + linarith [F.sum_q] + · have h := congrArg Prod.snd hh + apply Int.cast_injective (α := Real) + dsimp at h ⊢ + push_cast at h ⊢ + linarith + +private theorem hcellsPlus : + (by + classical + exact + ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (x : GaussianInt), ∀ (F : FordFareyParameter), ∀ (s : + BandPackingSymmetry), ∀ (delta : Bool), + let c := BandPackingSymmetryVectorAction s x + let U := TileTranslation (BandPackingSymmetryTileAction s (P 0 (!delta))) (-c) + ∀ (uPlus : GaussianInt), (U.cells = (TileTranslation (FordTile F.q) uPlus).cells) → + ((uPlus = ⟨-(F.q₁ : Int), 0⟩) → (U.cells = (TileTranslation (FordTile F.q) ⟨-(F.q₁ : + Int), 0⟩).cells)) ) := by + classical + intro P x F s delta c U uPlus huPlus huPlusEq + simpa [huPlusEq] using huPlus + +private theorem hcellsMinus : + (by + classical + exact + ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (x : GaussianInt), ∀ (F : FordFareyParameter), ∀ (s : + BandPackingSymmetry), ∀ (delta : Bool), + let c := BandPackingSymmetryVectorAction s x + let V := TileTranslation (BandPackingSymmetryTileAction s (P 0 delta)) (-c) + ∀ (uMinus : GaussianInt), (V.cells = (TileTranslation (FordTile F.q) uMinus).cells) → + ((uMinus = ⟨-(F.q₂ : Int), -(F.q : Int)⟩) → (V.cells = (TileTranslation (FordTile + F.q) ⟨-(F.q₂ : Int), -(F.q : Int)⟩).cells)) ) := by + classical + intro P x F s delta c V uMinus huMinus huMinusEq + simpa [huMinusEq] using huMinus + +private theorem hcurvPos : + (by + classical + exact + ∀ (F : FordFareyParameter), 0 < (FordCircleCoordinate F.p F.q).1 ) := by + classical + intro F + simp? [FordCircleCoordinate] + exact Nat.ne_of_gt F.q_pos + +private theorem hfootFord : + (by + classical + exact + ∀ (F : FordFareyParameter), ∀ (k : PartialOdometer), ((↑k.domain : Set GaussianInt) = + FordVertexDomain F.q) → (((↑k.domain : Set GaussianInt) = FootprintVertices (FordTile + F.q)) → (FootprintVertices (FordTile F.q) = FordVertexDomain F.q)) ) := by + classical + intro F k hkd hdomFord + calc + FootprintVertices (FordTile F.q) = k.domain := hdomFord.symm + _ = FordVertexDomain F.q := hkd + +private theorem hdomainPlus : + (by + classical + exact + ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (r : Fin 3 → Bool → PartialOdometer), ∀ (x : + GaussianInt), ∀ (F : FordFareyParameter), ∀ (s : BandPackingSymmetry), ∀ (delta : Bool), + let c := BandPackingSymmetryVectorAction s x + let U := TileTranslation (BandPackingSymmetryTileAction s (P 0 (!delta))) (-c) + let hp := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 (!delta))) (-c) 0 0 + ∀ (uPlus : GaussianInt), (FootprintVertices U = FootprintVertices (TileTranslation + (FordTile F.q) uPlus) ∧ BoundaryFootprintVertices U = BoundaryFootprintVertices + (TileTranslation (FordTile F.q) uPlus) ∧ BoundaryFootprintEdges U = + BoundaryFootprintEdges (TileTranslation (FordTile F.q) uPlus) ∧ TileRealization U = + TileRealization (TileTranslation (FordTile F.q) uPlus) ∧ TileCentroid U = + TileCentroid (TileTranslation (FordTile F.q) uPlus)) → ((uPlus = ⟨-(F.q₁ : Int), 0⟩) + → (((↑hp.domain : Set GaussianInt) = FootprintVertices U) → ((FootprintVertices + (FordTile F.q) = FordVertexDomain F.q) → (((F.q : Int) = F.q₁ + F.q₂) → (∀ (z : + GaussianInt), z ∈ hp.domain ↔ -(F.q₁ : Int) ≤ z.re ∧ z.re ≤ F.q₂ ∧ 0 ≤ z.im ∧ z.im ≤ + F.q))))) ) := by + classical + intro P r x F s delta c U hp uPlus hobsPlus huPlusEq hdomPlus hfootFord hsumInt z + change z ∈ (hp.domain : Set GaussianInt) ↔ _ + rw [hdomPlus, hobsPlus.1, + (TileTranslationFormulas (FordTile F.q) uPlus).2.2.2.2.2.1, hfootFord, + huPlusEq] + simp only [Set.mem_image, FordVertexDomain, Set.mem_ofPred_eq, + GaussianTranslation] + constructor + · rintro ⟨y, hy, rfl⟩ + simp only [Zsqrtd.re_add, Zsqrtd.im_add] + omega + · rintro ⟨hr1, hr2, hi1, hi2⟩ + refine ⟨z - ⟨-(F.q₁ : Int), 0⟩, ?_, ?_⟩ + · dsimp [FordVertexDomain] + simp [] + omega + · abel + +private theorem hdomainMinus : + (by + classical + exact + ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (r : Fin 3 → Bool → PartialOdometer), ∀ (x : + GaussianInt), ∀ (F : FordFareyParameter), ∀ (s : BandPackingSymmetry), ∀ (delta : Bool), + let c := BandPackingSymmetryVectorAction s x + let V := TileTranslation (BandPackingSymmetryTileAction s (P 0 delta)) (-c) + let hm := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 delta)) (-c) 0 0 + ∀ (uMinus : GaussianInt), (FootprintVertices V = FootprintVertices (TileTranslation + (FordTile F.q) uMinus) ∧ BoundaryFootprintVertices V = BoundaryFootprintVertices + (TileTranslation (FordTile F.q) uMinus) ∧ BoundaryFootprintEdges V = + BoundaryFootprintEdges (TileTranslation (FordTile F.q) uMinus) ∧ TileRealization V = + TileRealization (TileTranslation (FordTile F.q) uMinus) ∧ TileCentroid V = + TileCentroid (TileTranslation (FordTile F.q) uMinus)) → ((uMinus = ⟨-(F.q₂ : Int), + -(F.q : Int)⟩) → (((↑hm.domain : Set GaussianInt) = FootprintVertices V) → + ((FootprintVertices (FordTile F.q) = FordVertexDomain F.q) → (((F.q : Int) = F.q₁ + + F.q₂) → (∀ (z : GaussianInt), z ∈ hm.domain ↔ -(F.q₂ : Int) ≤ z.re ∧ z.re ≤ F.q₁ ∧ + -(F.q : Int) ≤ z.im ∧ z.im ≤ 0))))) ) := by + classical + intro P r x F s delta c V hm uMinus hobsMinus huMinusEq hdomMinus hfootFord hsumInt z + change z ∈ (hm.domain : Set GaussianInt) ↔ _ + rw [hdomMinus, hobsMinus.1, + (TileTranslationFormulas (FordTile F.q) uMinus).2.2.2.2.2.1, hfootFord, + huMinusEq] + simp only [Set.mem_image, FordVertexDomain, Set.mem_ofPred_eq, + GaussianTranslation] + constructor + · rintro ⟨y, hy, rfl⟩ + simp only [Zsqrtd.re_add, Zsqrtd.im_add] + omega + · rintro ⟨hr1, hr2, hi1, hi2⟩ + refine ⟨z - ⟨-(F.q₂ : Int), -(F.q : Int)⟩, ?_, ?_⟩ + · dsimp [FordVertexDomain] + simp [] + omega + · abel + +end LiteralFordPlacementGeometry + +theorem P5472T1LiteralFordPlacement + (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C0 : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C0 T) + (h : PartialOdometer) + (P : Fin 3 → Bool → ProtoTile) + (r : Fin 3 → Bool → PartialOdometer) + (Q S : Fin 3 → Bool → ProtoTile) + (u v : Fin 3 → Bool → PartialOdometer) + (g : IntegerLatticeFunction) (x : GaussianInt) + (data : BandOrderedGeneralOdometerRowData q cfg C0 T cert h P r Q S u v g) + (hcenter : GaussianRealPoint x = TileCentroid T) + (F : FordFareyParameter) (s : BandPackingSymmetry) (delta : Bool) + (hrev : BandPackingSymmetryReversesOrientation s = false) + (hword : ∃ z : GaussianInt, s = .shift z ∨ s = (BandPackingSymmetry.shift z).comp .negate) + (hphase : BandPackingSymmetryScopedPhase s q delta) + (hrootCircle : BandPackingSymmetryCircleAction s (q 1) = FordCircleCoordinate F.p F.q) + (hW : BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) + (BandPackingSymmetryQuadrupleAction s q 2) = ⟨-(F.q₁ : Int), (F.q₂ : Int)⟩) : + let c := BandPackingSymmetryVectorAction s x + let U := TileTranslation (BandPackingSymmetryTileAction s (P 0 (!delta))) (-c) + let V := TileTranslation (BandPackingSymmetryTileAction s (P 0 delta)) (-c) + let hp := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 (!delta))) (-c) 0 0 + let hm := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 delta)) (-c) 0 0 + U.cells = (TileTranslation (FordTile F.q) ⟨-(F.q₁ : Int), 0⟩).cells ∧ + V.cells = (TileTranslation (FordTile F.q) ⟨-(F.q₂ : Int), -(F.q : Int)⟩).cells ∧ + TileOdometer (FordCircleCoordinate F.p F.q) U hp ∧ + TileOdometer (FordCircleCoordinate F.p F.q) V hm ∧ + (∀ z : GaussianInt, z ∈ hp.domain ↔ + -(F.q₁ : Int) ≤ z.re ∧ z.re ≤ F.q₂ ∧ 0 ≤ z.im ∧ z.im ≤ F.q) ∧ + (∀ z : GaussianInt, z ∈ hm.domain ↔ + -(F.q₂ : Int) ≤ z.re ∧ z.re ≤ F.q₁ ∧ -(F.q : Int) ≤ z.im ∧ z.im ≤ 0) := by +-- BODY + let c := BandPackingSymmetryVectorAction s x + let U := TileTranslation (BandPackingSymmetryTileAction s (P 0 (!delta))) (-c) + let V := TileTranslation (BandPackingSymmetryTileAction s (P 0 delta)) (-c) + let hp := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 (!delta))) (-c) 0 0 + let hm := PartialOdometerAffineTranslate + (BandPackingSymmetryPartialOdometerAction s (r 0 delta)) (-c) 0 0 + have hplus' := LiteralFordPlacementGeometry.hplus' q cfg C0 T cert h P r Q S u v g x data F s + delta hrootCircle + have hminus' := LiteralFordPlacementGeometry.hminus' q cfg C0 T cert h P r Q S u v g x data F s + delta hrootCircle + have hocc (i : Fin 3) (b : Bool) := LiteralFordPlacementGeometry.hocc q cfg C0 T cert h P r Q S + u v g data i b + obtain ⟨d, e, P', hdphase, he, hPmap, hPocc, hPcover⟩ := + (BandPackingSymmetryCovariance s).2.2 q T P cfg.proper data.hPband + hocc data.hPcells + have hd : d = delta := + BandPackingSymmetryScopedPhaseUnique s q cfg.proper d delta hdphase hphase + subst d + have hePlus := LiteralFordPlacementGeometry.hePlus s delta hrev e he + have heMinus := LiteralFordPlacementGeometry.heMinus s delta hrev e he + have hPplusCent := LiteralFordPlacementGeometry.hPplusCent q T P s delta e P' hPmap hPocc hePlus + have hPminusCent := LiteralFordPlacementGeometry.hPminusCent q T P s delta e P' hPmap hPocc + heMinus + have hcenter' := LiteralFordPlacementGeometry.hcenter' q T P r x hcenter F s delta hrev hword + hphase hrootCircle hW hplus' hminus' e P' hPmap hPocc hPcover hdphase he hPplusCent + hPminusCent + have hsumReal : (F.q : Real) = (F.q₁ : Real) + F.q₂ := by exact_mod_cast F.sum_q + have hDplus := LiteralFordPlacementGeometry.hDplus F hsumReal + have hDminus := LiteralFordPlacementGeometry.hDminus F hsumReal + have hUcent := LiteralFordPlacementGeometry.hUcent q T P x F s delta hW hPplusCent hcenter' hDplus + have hVcent := LiteralFordPlacementGeometry.hVcent q T P x F s delta hW hPminusCent hcenter' + hDminus + obtain ⟨k, hkO, hkd, _⟩ := FordTileOdometerRestriction F + have hFordCent := P4210T1FordSquareCentroid F.q F.q_pos + have hFordCells := LiteralFordPlacementGeometry.hFordCells F + have hUnon := LiteralFordPlacementGeometry.hUnon P r x F s delta hplus' k hkO hFordCells + have hVnon := LiteralFordPlacementGeometry.hVnon P r x F s delta hminus' k hkO hFordCells + obtain ⟨uPlus, huPlus, _⟩ := BandPrototileTranslationNormalForm + (FordCircleCoordinate F.p F.q) U (FordTile F.q) + (TileOdometerBandPrototile _ _ _ hplus') + (TileOdometerBandPrototile _ _ _ hkO) + obtain ⟨uMinus, huMinus, _⟩ := BandPrototileTranslationNormalForm + (FordCircleCoordinate F.p F.q) V (FordTile F.q) + (TileOdometerBandPrototile _ _ _ hminus') + (TileOdometerBandPrototile _ _ _ hkO) + have hobsPlus := ProtoTileObservableExtensionality U + (TileTranslation (FordTile F.q) uPlus) huPlus (by + intro hempty + have hne := hUnon + rw [hempty] at hne + simp at hne) + have hobsMinus := ProtoTileObservableExtensionality V + (TileTranslation (FordTile F.q) uMinus) huMinus (by + intro hempty + have hne := hVnon + rw [hempty] at hne + simp at hne) + have huPlusEq := LiteralFordPlacementGeometry.huPlusEq P x F s delta hsumReal hUcent hFordCent + uPlus hobsPlus + have huMinusEq := LiteralFordPlacementGeometry.huMinusEq P x F s delta hsumReal hVcent + hFordCent uMinus hobsMinus + have hcellsPlus := LiteralFordPlacementGeometry.hcellsPlus P x F s delta uPlus huPlus huPlusEq + have hcellsMinus := LiteralFordPlacementGeometry.hcellsMinus P x F s delta uMinus huMinus + huMinusEq + have hcurvPos := LiteralFordPlacementGeometry.hcurvPos F + have hdomPlus := PositiveCurvatureTileOdometerDomain + (FordCircleCoordinate F.p F.q) U hp hcurvPos hplus' + have hdomMinus := PositiveCurvatureTileOdometerDomain + (FordCircleCoordinate F.p F.q) V hm hcurvPos hminus' + have hdomFord := PositiveCurvatureTileOdometerDomain + (FordCircleCoordinate F.p F.q) (FordTile F.q) k hcurvPos hkO + have hfootFord := LiteralFordPlacementGeometry.hfootFord F k hkd hdomFord + have hsumInt : (F.q : Int) = F.q₁ + F.q₂ := by exact_mod_cast F.sum_q + have hdomainPlus (z : GaussianInt) := LiteralFordPlacementGeometry.hdomainPlus P r x F s delta + uPlus hobsPlus huPlusEq hdomPlus hfootFord hsumInt z + have hdomainMinus (z : GaussianInt) := LiteralFordPlacementGeometry.hdomainMinus P r x F s + delta uMinus hobsMinus huMinusEq hdomMinus hfootFord hsumInt z + exact ⟨hcellsPlus, hcellsMinus, hplus', hminus', hdomainPlus, hdomainMinus⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5478T1ExteriorPlacementIndex.lean b/LeanPool/ApollonianSuperharmonic/P5478T1ExteriorPlacementIndex.lean new file mode 100644 index 0000000000..61b2c8ce27 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5478T1ExteriorPlacementIndex.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms + +-- [TABLET NODE: P5478T1ExteriorPlacementIndex] + +/-! +# P5478T1ExteriorPlacementIndex + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5478T1ExteriorPlacementIndex + (C D : BandCircle) (T N : ProtoTile) (h k : PartialOdometer) + (x : GaussianInt) + (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x) + (placement : BandOrderedGeneralRightPlacement bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction + bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces + bundle.functions bundle.selectedSlot bundle.selectedSign bundle.routedDirection) : + let label : SixSubtileLabel := match bundle.selectedSlot.val with + | 0 => if bundle.selectedSign then .A else .B + | 1 => if bundle.selectedSign then .C else .D + | _ => if bundle.selectedSign then .E else .F + let coord : Int × Int := match placement.rightDirectionSlot.val with + | 0 => (1, 0) + | 1 => (0, 1) + | _ => (-1, -1) + let sign : Int := if placement.rightNeighborPositive then 1 else -1 + placement.exteriorIndex = ⟨label, sign * coord.1, sign * coord.2⟩ := by +-- BODY + classical + let canonical : PeriodicSubtileIndex := + let label : SixSubtileLabel := match bundle.selectedSlot.val with + | 0 => if bundle.selectedSign then .A else .B + | 1 => if bundle.selectedSign then .C else .D + | _ => if bundle.selectedSign then .E else .F + let coord : Int × Int := match placement.rightDirectionSlot.val with + | 0 => (1, 0) | 1 => (0, 1) | _ => (-1, -1) + let sign : Int := if placement.rightNeighborPositive then 1 else -1 + ⟨label, sign * coord.1, sign * coord.2⟩ + change placement.exteriorIndex = canonical + let occurrence := SubtileOccurrenceInterpretation placement.layout.P + placement.layout.u placement.layout.v + have hu : BandVectors.1 (bundle.normalizedPresentation 0) + (bundle.normalizedPresentation 1) = placement.layout.u := + placement.layout.period_u.symm + have hv : BandVectors.1 (bundle.normalizedPresentation 0) + (bundle.normalizedPresentation 2) = placement.layout.v := + placement.layout.period_v.symm + have hw : BandVectors.1 (bundle.normalizedPresentation 0) + (bundle.normalizedPresentation 3) = -placement.layout.u - placement.layout.v := by + obtain ⟨_, _, _, _, h1, h2, h3, _⟩ := + P3055T1ParentVectorNormalForms bundle.normalizedPresentation bundle.configuration + rw [← hu, ← hv, h1, h2, h3] + ring + have same_cells : (bundle.pieces bundle.selectedSlot bundle.selectedSign).cells = + (occurrence canonical).cells := by + rcases placement.selected_boundary_piece with ⟨hi, hs⟩ | ⟨hi, hs⟩ + · have he := congrArg ProtoTile.cells (congrArg₂ bundle.pieces hi hs) + refine he.trans (placement.first_boundary_cells.trans ?_) + rcases placement.right_slots_cyclic with ⟨hr, ht, hd⟩ | ⟨hr, ht, hd⟩ | ⟨hr, ht, hd⟩ + all_goals rcases placement.boundary_signs with ⟨hp, hf, ht'⟩ | ⟨hp, hf, ht'⟩ + all_goals simp [canonical, occurrence, hi, hs, hr, hd, hp, hf, + SubtileOccurrenceInterpretation, placement.right_neighbor_displacement, hu, hv, hw, + sub_eq_add_neg, add_comm] + · have he := congrArg ProtoTile.cells (congrArg₂ bundle.pieces hi hs) + refine he.trans (placement.second_boundary_cells.trans ?_) + rcases placement.right_slots_cyclic with ⟨hr, ht, hd⟩ | ⟨hr, ht, hd⟩ | ⟨hr, ht, hd⟩ + all_goals rcases placement.boundary_signs with ⟨hp, hf, ht'⟩ | ⟨hp, hf, ht'⟩ + all_goals simp [canonical, occurrence, hi, hs, ht, hd, hp, ht', + SubtileOccurrenceInterpretation, placement.right_neighbor_displacement, hu, hv, hw, + sub_eq_add_neg, add_comm] + have canonical_exterior : + canonical = ⟨.A, -1, -1⟩ ∨ canonical = ⟨.A, 0, -1⟩ ∨ + canonical = ⟨.C, 1, 0⟩ ∨ canonical = ⟨.C, 1, 1⟩ ∨ + canonical = ⟨.E, 0, 1⟩ ∨ canonical = ⟨.E, -1, 0⟩ ∨ + canonical = ⟨.B, 1, 1⟩ ∨ canonical = ⟨.B, 0, 1⟩ ∨ + canonical = ⟨.D, -1, 0⟩ ∨ canonical = ⟨.D, -1, -1⟩ ∨ + canonical = ⟨.F, 0, -1⟩ ∨ canonical = ⟨.F, 1, 0⟩ := by + rcases placement.selected_boundary_piece with ⟨hi, hs⟩ | ⟨hi, hs⟩ + all_goals rcases placement.right_slots_cyclic with ⟨hr, ht, hd⟩ | ⟨hr, ht, hd⟩ | ⟨hr, ht, hd⟩ + all_goals rcases placement.boundary_signs with ⟨hp, hf, ht'⟩ | ⟨hp, hf, ht'⟩ + all_goals simp [canonical, hi, hs, hr, ht, hd, hp, hf, ht'] + have hOA : placement.layout.O.cells ⊆ (placement.layout.P 0 true).cells := by + rw [placement.layout.precursor_eq] + intro z hz + exact (placement.layout.plus_union z).2 ⟨0, false, hz⟩ + have hOB : placement.layout.O.cells ⊆ (placement.layout.P 0 false).cells := by + rw [placement.layout.precursor_cells] + intro z hz + exact (placement.layout.minus_union z).2 ⟨0, true, hz⟩ + have separation := (BandOriginalPairSeparation placement.layout.P placement.layout.O + placement.layout.u placement.layout.v hOA hOB placement.layout.partition).2 + by_contra hne + have nonpaired : ¬ ((placement.exteriorIndex.label = .A ∧ canonical.label = .B ∨ + placement.exteriorIndex.label = .B ∧ canonical.label = .A) ∧ + placement.exteriorIndex.first = canonical.first ∧ + placement.exteriorIndex.second = canonical.second) := by + rcases placement.exterior_index with he | he | he | he | he | he | he | he | he | he | he | he + all_goals rcases canonical_exterior with hc | hc | hc | hc | hc | hc | hc | hc | hc | hc | hc + | hc + all_goals simp [he, hc] + have disj := separation placement.exteriorIndex canonical hne nonpaired + have hc := bundle.selected_piece_cell + have he : LatticeVertexIncidentCell bundle.normalizedPoint bundle.routedDirection ∈ + (occurrence placement.exteriorIndex).cells := by + rw [← placement.selected_exterior_cells] + exact hc + have hk : LatticeVertexIncidentCell bundle.normalizedPoint bundle.routedDirection ∈ + (occurrence canonical).cells := by + rw [← same_cells] + exact hc + exact Finset.disjoint_left.mp disj he hk + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5485T1FullInterfaceMarking.lean b/LeanPool/ApollonianSuperharmonic/P5485T1FullInterfaceMarking.lean new file mode 100644 index 0000000000..dd128c4866 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5485T1FullInterfaceMarking.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure + +-- [TABLET NODE: P5485T1FullInterfaceMarking] + +/-! +# P5485T1FullInterfaceMarking + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5485T1FullInterfaceMarking + (A B U : ProtoTile) (data : ExactTileInterfaceTriple A B U) + (hA : LatticeTile A) (hB : LatticeTile B) (hU : LatticeTile U) + (hAB : Disjoint A.cells B.cells) + (hAU : Disjoint A.cells U.cells) (hBU : Disjoint B.cells U.cells) + (htouch : TouchingTriple A B U) (x : GaussianInt) + (hedge : ∃ e : Finset GaussianInt, + x ∈ e ∧ e ∈ FootprintEdges A ∩ FootprintEdges B) + (hother : x ≠ data.otherAB) : + (¬ (∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩ → z ∈ A.cells ∨ z ∈ B.cells) ↔ + x ∈ FootprintVertices U) := by +-- BODY + have incident (U : ProtoTile) (hne : U.cells.Nonempty) + (z : GaussianInt) (hz : z ∈ FootprintVertices U) : + ∃ k : Fin 4, LatticeVertexIncidentCell z k ∈ U.cells := by + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hz + rcases hz with ⟨c, hc, rfl | rfl | rfl | rfl⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨2, by simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hc⟩ + have coverage : + (∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩ → z ∈ A.cells ∨ z ∈ B.cells) ↔ + ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ A.cells ∨ + LatticeVertexIncidentCell x j ∈ B.cells := by + constructor + · intro h j + apply h + fin_cases j <;> simp [LatticeVertexIncidentCell] + · intro h z hz + rcases hz with rfl | rfl | rfl | rfl + · simpa [LatticeVertexIncidentCell] using h 0 + · simpa [LatticeVertexIncidentCell] using h 1 + · simpa [LatticeVertexIncidentCell] using h 3 + · simpa [LatticeVertexIncidentCell] using h 2 + rw [coverage] + rcases SimpleGridPathPointTrichotomy _ _ data.point data.otherAB x + data.pathAB hedge with hpoint | hwrong | hinterior + · have hcommon := (data.unique_common x).2 hpoint + obtain ⟨j, hj⟩ := (LocalLatticeInterfaceSectors.1 A B U x hA hB hU + htouch hcommon).2.2.2.1 + constructor + · intro _ + exact hcommon.2 + · intro _ hall + rcases hall j with ha | hb + · exact Finset.disjoint_left.mp hAU ha hj + · exact Finset.disjoint_left.mp hBU hb hj + · exact (hother hwrong).elim + · have hall := (LocalLatticeInterfaceSectors.2 A B x hA hB hAB hinterior).1 + constructor + · intro h + exact (h hall).elim + · intro hu _ + obtain ⟨j, hj⟩ := incident U (LatticeTileGridStructure U hU).1.1 x hu + rcases hall j with ha | hb + · exact Finset.disjoint_left.mp hAU ha hj + · exact Finset.disjoint_left.mp hBU hb hj + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5485T1OtherCompanionCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P5485T1OtherCompanionCoordinates.lean new file mode 100644 index 0000000000..f72edb686e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5485T1OtherCompanionCoordinates.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4418T3EndpointOwnerIndices +public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms + +-- [TABLET NODE: P5485T1OtherCompanionCoordinates] + +/-! +# P5485T1OtherCompanionCoordinates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5485T1OtherCompanionCoordinates + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b) + (i j k s : Fin 3) (positive sign : Bool) + (hcyclic : (i = 0 ∧ j = 1 ∧ k = 2) ∨ + (i = 1 ∧ j = 2 ∧ k = 0) ∨ (i = 2 ∧ j = 0 ∧ k = 1)) + (hselected : (s = i ∧ sign = positive) ∨ + (s = j ∧ sign = !positive)) + (hindex : a = + let label : SixSubtileLabel := match s.val with + | 0 => if sign then .A else .B + | 1 => if sign then .C else .D + | _ => if sign then .E else .F + let coord : Int × Int := match k.val with + | 0 => (1, 0) | 1 => (0, 1) | _ => (-1, -1) + let scale : Int := if positive then 1 else -1 + ⟨label, scale * coord.1, scale * coord.2⟩) : + let other := if s = i then j else i + let coord : Int × Int := match other.val with + | 0 => (1, 0) | 1 => (0, 1) | _ => (-1, -1) + let scale : Int := if positive then -1 else 1 + let m := scale * coord.1 + let n := scale * coord.2 + (if positive then (-1 : GaussianInt) else 1) * + BandVectors.1 (q 0) (q other.succ) = + (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v ∧ + (a.first, a.second) ≠ (m, n) ∧ + (b.first, b.second) ≠ (m, n) ∧ + ((P4418T3EndpointOwnerIndices q cfg C T cert a b row).1.first, + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1.second) ≠ (m, n) ∧ + ((P4418T3EndpointOwnerIndices q cfg C T cert a b row).2.first, + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2.second) ≠ (m, n) := by +-- BODY + have hu : BandVectors.1 (q 0) (q 1) = cert.u := cert.period_u.symm + have hv : BandVectors.1 (q 0) (q 2) = cert.v := cert.period_v.symm + have hw : BandVectors.1 (q 0) (q 3) = -cert.u - cert.v := by + obtain ⟨_, _, _, _, h1, h2, h3, _⟩ := P3055T1ParentVectorNormalForms q cfg + rw [← hu, ← hv, h1, h2, h3] + ring + rcases hcyclic with ⟨rfl, rfl, rfl⟩ | ⟨rfl, rfl, rfl⟩ | ⟨rfl, rfl, rfl⟩ + all_goals cases positive + all_goals rcases hselected with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + all_goals cases row + all_goals simp_all [P4418T3EndpointOwnerIndices, Fin.succ] + all_goals ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5485T1RoutedInterfaceAvoidance.lean b/LeanPool/ApollonianSuperharmonic/P5485T1RoutedInterfaceAvoidance.lean new file mode 100644 index 0000000000..35a37eb4e7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5485T1RoutedInterfaceAvoidance.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceData +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.OppositeRoutedCommonEdgeOutsideCellUnique +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure + +-- [TABLET NODE: P5485T1RoutedInterfaceAvoidance] + +/-! +# P5485T1RoutedInterfaceAvoidance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5485T1RoutedInterfaceAvoidance + (V W G H K : ProtoTile) + (data : P4418T3SelectedInterfaceData V W G H) + (hK : K.cells.Nonempty) + (hVK : Disjoint V.cells K.cells) (hWK : Disjoint W.cells K.cells) + (hGK : Disjoint G.cells K.cells) (hHK : Disjoint H.cells K.cells) + (x : GaussianInt) (j : Fin 4) (edge : Finset GaussianInt) + (hx : x ∈ edge) + (hedge : edge ∈ FootprintEdges V ∩ FootprintEdges W) + (hV : LatticeVertexIncidentCell x j ∈ V.cells) + (hW : LatticeVertexIncidentCell x (j + 2) ∈ W.cells) : + x ∉ FootprintVertices K := by +-- BODY + intro hfoot + have incident (U : ProtoTile) (hne : U.cells.Nonempty) + (z : GaussianInt) (hz : z ∈ FootprintVertices U) : + ∃ k : Fin 4, LatticeVertexIncidentCell z k ∈ U.cells := by + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hz + rcases hz with ⟨c, hc, rfl | rfl | rfl | rfl⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hc⟩ + · exact ⟨2, by simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hc⟩ + obtain ⟨k, hk⟩ := incident K hK x hfoot + have outsideV : LatticeVertexIncidentCell x k ∉ V.cells := + fun hc => Finset.disjoint_left.mp hVK hc hk + have outsideW : LatticeVertexIncidentCell x k ∉ W.cells := + fun hc => Finset.disjoint_left.mp hWK hc hk + have endpoint (Z : ProtoTile) (hZ : LatticeTile Z) + (hVZ : Disjoint V.cells Z.cells) (hWZ : Disjoint W.cells Z.cells) + (hZK : Disjoint Z.cells K.cells) (hz : x ∈ FootprintVertices Z) : False := by + obtain ⟨l, hl⟩ := incident Z (LatticeTileGridStructure Z hZ).1.1 x hz + have heq := OppositeRoutedCommonEdgeOutsideCellUnique V W x j edge + data.disjointVW hx hedge hV hW l k + (fun hc => Finset.disjoint_left.mp hVZ hc hl) + (fun hc => Finset.disjoint_left.mp hWZ hc hl) outsideV outsideW + exact Finset.disjoint_left.mp hZK hl (heq.symm ▸ hk) + rcases SimpleGridPathPointTrichotomy _ _ data.first data.last x + data.path ⟨edge, hx, hedge⟩ with hfirst | hlast | hinterior + · exact endpoint G data.latticeG₀ data.disjointVG₀ data.disjointWG₀ + hGK (hfirst.symm ▸ data.common₀.2) + · exact endpoint H data.latticeG₁ data.disjointVG₁ data.disjointWG₁ + hHK (hlast.symm ▸ data.common₁.2) + · rcases (LocalLatticeInterfaceSectors.2 V W x data.latticeV + data.latticeW data.disjointVW hinterior).1 k with hv | hw + · exact outsideV hv + · exact outsideW hw + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1AffinePairReduction.lean b/LeanPool/ApollonianSuperharmonic/P5491T1AffinePairReduction.lean new file mode 100644 index 0000000000..7205ecf578 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5491T1AffinePairReduction.lean @@ -0,0 +1,125 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P5491T1AffinePairReduction] + +/-! +# P5491T1AffinePairReduction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5491T1AffinePairReduction + (C D : CircleCoordinates) (U V T S : ProtoTile) + (f g h k : PartialOdometer) (p q r t : ℝ × ℝ) + (d a : GaussianInt) + (hC : 0 < C.1) (hD : 0 < D.1) + (hf : TileOdometer C U f) (hg : TileOdometer D V g) + (hh : TileOdometer C T h) (hk : TileOdometer D S k) + (hpf : PartialOdometerSlope f = some p) + (hqg : PartialOdometerSlope g = some q) + (hrh : PartialOdometerSlope h = some r) + (htk : PartialOdometerSlope k = some t) + (hc : TileCentroid S - TileCentroid T = + TileCentroid V - TileCentroid U + GaussianRealPoint d) + (ha : t.1 - r.1 = q.1 - p.1 + (a.re : ℝ)) + (hb : t.2 - r.2 = q.2 - p.2 + (a.im : ℝ)) : + ∃ u : GaussianInt, ∃ b : ℤ, + (∀ x, (x ∈ h.domain ∧ x ∈ k.domain) ↔ + (x - u ∈ f.domain ∧ x - u - d ∈ g.domain)) ∧ + ∀ x, x ∈ h.domain → x ∈ k.domain → + k.value x - h.value x = + g.value (x - u - d) + a.re * (x - u).re + + a.im * (x - u).im - f.value (x - u) + b := by +-- BODY + obtain ⟨u, ⟨hu, heu, a₀, b₀, hdu, hvu⟩, _⟩ := + TileOdometerTranslationUniqueness C T U h f hC hh hf + obtain ⟨v, ⟨hv, hev, a₁, b₁, hdv, hvv⟩, _⟩ := + TileOdometerTranslationUniqueness D S V k g hD hk hg + have representation (l m : PartialOdometer) (w c : GaussianInt) (b : ℤ) + (hd : ∀ x, x ∈ l.domain ↔ x - w ∈ m.domain) + (he : ∀ x, x ∈ l.domain → + l.value x = m.value (x - w) + c.re*x.re + c.im*x.im + b) : + l = PartialOdometerAffineTranslate m w c b := by + have hdom : l.domain = (PartialOdometerAffineTranslate m w c b).domain := by + ext x + exact (hd x).trans ((PartialOdometerAffineTranslateFormulas m w c b).2.1 x).symm + have hval : l.value = (PartialOdometerAffineTranslate m w c b).value := by + funext x + by_cases hx : x ∈ l.domain + · exact (he x hx).trans + ((PartialOdometerAffineTranslateFormulas m w c b).2.2.1 x (hdom ▸ hx)).symm + · rw [l.value_outside x hx, + (PartialOdometerAffineTranslate m w c b).value_outside x (by rwa [← hdom])] + have ext (l m : PartialOdometer) (hd : l.domain = m.domain) + (hv : l.value = m.value) : l = m := by + cases l + cases m + dsimp at hd hv + subst_vars + rfl + exact ext l _ hdom hval + have hsr : r = (p.1 + (a₀.re : ℝ), p.2 + (a₀.im : ℝ)) := by + apply Option.some.inj + rw [← hrh, representation h f u a₀ b₀ hdu hvu, + (PartialOdometerAffineTranslateFormulas f u a₀ b₀).2.2.2.2.2, hpf] + rfl + have hst : t = (q.1 + (a₁.re : ℝ), q.2 + (a₁.im : ℝ)) := by + apply Option.some.inj + rw [← htk, representation k g v a₁ b₁ hdv hvv, + (PartialOdometerAffineTranslateFormulas g v a₁ b₁).2.2.2.2.2, hqg] + rfl + have hcu : TileCentroid T = TileCentroid U + GaussianRealPoint u := by + exact (ProtoTileObservableExtensionality T (TileTranslation U u) hu heu).2.2.2.2 |>.trans + (TileTranslationFormulas U u).2.2.2.2.1 + have hcv : TileCentroid S = TileCentroid V + GaussianRealPoint v := by + exact (ProtoTileObservableExtensionality S (TileTranslation V v) hv hev).2.2.2.2 |>.trans + (TileTranslationFormulas V v).2.2.2.2.1 + have hshift : v = u + d := by + rw [hcu, hcv] at hc + apply Zsqrtd.ext + · have he := congrArg Prod.fst hc + simp only [Prod.fst_add, Prod.fst_sub, GaussianRealPoint] at he + have he' : (v.re : ℝ) = (u.re : ℝ) + (d.re : ℝ) := by linarith + exact_mod_cast he' + · have he := congrArg Prod.snd hc + simp only [Prod.snd_add, Prod.snd_sub, GaussianRealPoint] at he + have he' : (v.im : ℝ) = (u.im : ℝ) + (d.im : ℝ) := by linarith + exact_mod_cast he' + have har : a₁.re - a₀.re = a.re := by + rw [hsr, hst] at ha + dsimp at ha + have he : (a₁.re : ℝ) - (a₀.re : ℝ) = (a.re : ℝ) := by linarith + exact_mod_cast he + have hai : a₁.im - a₀.im = a.im := by + rw [hsr, hst] at hb + dsimp at hb + have he : (a₁.im : ℝ) - (a₀.im : ℝ) = (a.im : ℝ) := by linarith + exact_mod_cast he + have arg (x : GaussianInt) : x - v = x - u - d := by rw [hshift]; abel + refine ⟨u, a.re*u.re + a.im*u.im + b₁-b₀, ?_, ?_⟩ + · intro x + rw [hdu x, hdv x, arg] + · intro x hx hy + rw [hvv x hy, hvu x hx, arg] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + rw [← har, ← hai] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1DiamondParentBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondParentBoundary.lean new file mode 100644 index 0000000000..4818b83ac5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondParentBoundary.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData +public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows +public import LeanPool.ApollonianSuperharmonic.P5537T1UnitParentBoundary +public import LeanPool.ApollonianSuperharmonic.P5537T1PredecessorCoordinates +public import LeanPool.ApollonianSuperharmonic.P5537T1PredecessorValues + +-- [TABLET NODE: P5491T1DiamondParentBoundary] + +/-! +# P5491T1DiamondParentBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5491T1DiamondParentBoundary (K : DiamondParameter) (hk : 1 < K.1) + (i : Fin 3) (s : Fin 4) : + let A := P5352T2Sources K hk 0 + let D := P5352T2Sources K hk i.succ + let M := (P5352T2PlacementData K.1 i).2 s + ∃ b : ℤ, ∀ x : GaussianInt, + x ∈ FootprintVertices A.1 → x-M.1 ∈ FootprintVertices D.1 → + D.2.1 (x-M.1) + M.2.1.re*x.re + M.2.1.im*x.im - A.2.1 x = b := by +-- BODY + dsimp only + by_cases hi : i.val < 2 + · exact P5537T1UnitParentBoundary K hk i hi s + · have hi2 : i = 2 := by apply Fin.ext; omega + subst i + have hn : 2 ≤ (K.1 : Int) := by exact_mod_cast hk + let L : DiamondParameter := ⟨K.1-1, by omega⟩ + have value (M : DiamondParameter) (z : GaussianInt) + (hz : z ∈ FootprintVertices (DiamondTile M.1)) : + DiamondOdometer M z = P4207T1DiamondFormula z := + (P5352T2DomainRows M z).2 hz + fin_cases s + · refine ⟨-((K.1:Int)*((K.1:Int)-1)/2), ?_⟩ + intro x hx hd + change x ∈ FootprintVertices (DiamondTile K.1) at hx + change x-⟨(K.1:Int),1-(K.1:Int)⟩ ∈ + FootprintVertices (DiamondTile (K.1-1)) at hd + have hc := (P5537T1PredecessorCoordinates K hk x).1.mp ⟨hx,hd⟩ + change DiamondOdometer L (x-⟨(K.1:Int),1-(K.1:Int)⟩) + + 0*x.re + ((K.1:Int)-1)*x.im - DiamondOdometer K x = _ + rw [value L _ hd, value K x hx] + simpa only [P4207T1DiamondFormula, Zsqrtd.re_sub, Zsqrtd.im_sub, + zero_mul, add_zero] using + (P5537T1PredecessorValues (K.1:Int) x.re x.im hn).1 hc + · refine ⟨(K.1:Int)*((K.1:Int)+1)/2, ?_⟩ + intro x hx hd + change x ∈ FootprintVertices (DiamondTile K.1) at hx + change x-⟨(K.1:Int),(K.1:Int)+1⟩ ∈ + FootprintVertices (DiamondTile (K.1-1)) at hd + have hc := (P5537T1PredecessorCoordinates K hk x).2.1.mp ⟨hx,hd⟩ + change DiamondOdometer L (x-⟨(K.1:Int),(K.1:Int)+1⟩) + + (K.1:Int)*x.re + 0*x.im - DiamondOdometer K x = _ + rw [value L _ hd, value K x hx] + simpa only [P4207T1DiamondFormula, Zsqrtd.re_sub, Zsqrtd.im_sub, + zero_mul, add_zero] using + (P5537T1PredecessorValues (K.1:Int) x.re x.im hn).2.1 hc + · refine ⟨-((K.1:Int)*((K.1:Int)+1)/2), ?_⟩ + intro x hx hd + change x ∈ FootprintVertices (DiamondTile K.1) at hx + change x-⟨-(K.1:Int),(K.1:Int)+1⟩ ∈ + FootprintVertices (DiamondTile (K.1-1)) at hd + have hc := (P5537T1PredecessorCoordinates K hk x).2.2.1.mp ⟨hx,hd⟩ + change DiamondOdometer L (x-⟨-(K.1:Int),(K.1:Int)+1⟩) + + 1*x.re + (-(K.1:Int))*x.im - DiamondOdometer K x = _ + rw [value L _ hd, value K x hx] + simpa only [P4207T1DiamondFormula, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_neg, Zsqrtd.im_neg, + sub_neg_eq_add, one_mul, neg_mul, sub_eq_add_neg, neg_neg] using + (P5537T1PredecessorValues (K.1:Int) x.re x.im hn).2.2.1 hc + · refine ⟨(K.1:Int)*((K.1:Int)-1)/2, ?_⟩ + intro x hx hd + change x ∈ FootprintVertices (DiamondTile K.1) at hx + change x-⟨-(K.1:Int),1-(K.1:Int)⟩ ∈ + FootprintVertices (DiamondTile (K.1-1)) at hd + have hc := (P5537T1PredecessorCoordinates K hk x).2.2.2.mp ⟨hx,hd⟩ + change DiamondOdometer L (x-⟨-(K.1:Int),1-(K.1:Int)⟩) + + (1-(K.1:Int))*x.re + (-1)*x.im - DiamondOdometer K x = _ + rw [value L _ hd, value K x hx] + simpa only [P4207T1DiamondFormula, Zsqrtd.re_sub, Zsqrtd.im_sub, + Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_neg, Zsqrtd.im_neg, + sub_neg_eq_add, neg_one_mul, sub_eq_add_neg, neg_neg] using + (P5537T1PredecessorValues (K.1:Int) x.re x.im hn).2.2.2 hc + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean new file mode 100644 index 0000000000..cf132aae4f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean @@ -0,0 +1,795 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData +public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic + +-- [TABLET NODE: P5491T1DiamondRightBoundary] + +/-! +# P5491T1DiamondRightBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiamondRightBoundaryProof + +private theorem tri : + (by + classical + exact + (DiamondParameter) → (∀ (a : ℤ), (2 : ℤ) * (a * (a - (1 : ℤ)) / (2 : ℤ)) = a * (a - (1 : + ℤ))) ) := by + classical + intro K a + rcases Int.emod_two_eq_zero_or_one a with h | h + · have ha : a = 2*(a/2) := by omega + rw [ha, show 2*(a/2)*(2*(a/2)-1) = + 2*((a/2)*(2*(a/2)-1)) by ring, + Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + · have ha : a = 2*(a/2)+1 := by omega + rw [ha, show (2*(a/2)+1)*(2*(a/2)+1-1) = + 2*((2*(a/2)+1)*(a/2)) by ring, + Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + +private theorem square : + (by + classical + exact + (DiamondParameter) → (∀ (a : ℤ), (4 : ℤ) * (a ^ (2 : ℕ) / (4 : ℤ)) = a ^ (2 : ℕ) - a % (2 + : ℤ)) ) := by + classical + intro K a + rcases Int.emod_two_eq_zero_or_one a with h | h + · have ha : a = 2*(a/2) := by omega + have he : a^2 = 4*(a/2)^2 := by + conv_lhs => rw [ha] + ring + rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (4:Int) ≠ 0), h] + ring + · have ha : a = 2*(a/2)+1 := by omega + have he : a^2 = 4*((a/2)^2+a/2)+1 := by + conv_lhs => rw [ha] + ring + rw [he, h] + omega + +private theorem hposResult : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), + let n : Int := K.1 + (∀ (i : Fin 3), ∀ (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) → x - + (P5352T2PlacementData K.1 i).1.1 ∈ FootprintVertices (DiamondTile K.1) → + (P5352T2Sources K hk 0).2.1 (x - (P5352T2PlacementData K.1 i).1.1) + + (P5352T2PlacementData K.1 i).1.2.re*x.re + (P5352T2PlacementData K.1 + i).1.2.im*x.im - (P5352T2Sources K hk 0).2.1 x = if i.val = 0 then -(n*(n+1))/2 + else if i.val = 1 then n*(n-1)/2 else n*(n-1)) → (∀ (i : Fin 3), ∀ (x : GaussianInt), + x ∈ FootprintVertices (DiamondTile K.1) → x - (P5352T2PlacementData K.1 i).1.1 ∈ + FootprintVertices (DiamondTile K.1) → (P5352T2Sources K hk 0).2.1 (x - + (P5352T2PlacementData K.1 i).1.1) + (P5352T2PlacementData K.1 i).1.2.re*x.re + + (P5352T2PlacementData K.1 i).1.2.im*x.im - (P5352T2Sources K hk 0).2.1 x = if + i.val = 0 then -(n*(n+1))/2 else if i.val = 1 then n*(n-1)/2 else n*(n-1)) ) := by + classical + intro K hk n hpositive + exact hpositive + +end DiamondRightBoundaryProof + +namespace DiamondBoundaryDetails + +private theorem hF : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ z ∈ FootprintVertices + (DiamondTile K.1), (P5352T2Sources K hk (0 : Fin (4 : ℕ))).2.1 z = + (↑z.re.natAbs : ℤ) * ((↑z.re.natAbs : ℤ) - (1 : ℤ)) / (2 : ℤ) - (z.re - z.im) ^ (2 : + ℕ) / (4 : ℤ) ) := by + classical + intro K hk z hz + simp only [P5352T2Sources] + exact (P5352T2DomainRows K z).2 hz + +private theorem hfloorEven : + (by + classical + exact + ∀ (m : ℤ), ((2 : ℤ) * m) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) ) := by + classical + intro m + have hh := P4207T1FloorArithmetic.1 (0:Int) m + simpa using hh + +private theorem hfloorOdd : + (by + classical + exact + ∀ (m : ℤ), ((2 : ℤ) * m + (1 : ℤ)) ^ (2 : ℕ) / (4 : ℤ) = m * (m + (1 : ℤ)) ) := by + classical + intro m + have hh := P4207T1FloorArithmetic.1 (1:Int) m + have he : (1:Int) + 2*m = 2*m+1 := by ring + rw [he] at hh + norm_num at hh ⊢ + nlinarith + +private theorem scale : + (by + classical + exact + let Q (a b : Int) : Int := + (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), 2*(a*(a-1)/2) = a*(a-1)) → ((∀ (a : Int), 4*(a^2/4) = a^2-a%2) → (∀ (a : + ℤ), ∀ (b : ℤ), (4 : ℤ) * Q a b = S a b)) ) := by + classical + intro Q S tri square a b + have ht := tri (Int.natAbs a : Int) + have hs := square (a-b) + have ha : (Int.natAbs a : Int)^2 = a^2 := by + rw [Int.natCast_natAbs, sq_abs] + dsimp [Q, S] + rw [Int.natCast_natAbs] at ht ha ⊢ + nlinarith only [ht, hs, ha] + +private theorem foot : + (by + classical + exact + ∀ (K : DiamondParameter), + let n : Int := K.1 + ∀ (z : GaussianInt), z ∈ FootprintVertices (DiamondTile K.1) ↔ (0 : ℤ) ≤ z.im ∧ z.im + ≤ (2 : ℤ) * n ∧ -n ≤ z.re ∧ z.re ≤ n ∧ -z.im - (1 : ℤ) ≤ z.re ∧ z.re ≤ z.im + (1 : ℤ) + ∧ -((2 : ℤ) * n - z.im + (1 : ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * n - z.im + (1 : ℤ) ) := by + classical + intro K n z + simpa [n] using (P5352T2DomainRows K z).1 + +private theorem hs1At258 : + (by + classical + exact + ∀ (K : DiamondParameter), + let n : Int := K.1 + ∀ (x : GaussianInt), + let v : Int := x.im + let r : Int := v-n-1 + (r+1-(↑K.1+1+r-(↑K.1+1)))^2/4 = 0 ) := by + classical + intro K n x v r + have he : r+1-(↑K.1+1+r-(↑K.1+1)) = 1 := by ring + rw [he] + norm_num + +private theorem hs2At262 : + (by + classical + exact + ∀ (K : DiamondParameter), + let n : Int := K.1 + (∀ (m : Int), (2*m)^2/4 = m^2) → (∀ (x : GaussianInt), + let v : Int := x.im + let r : Int := v-n-1 + (-(K.1:Int)+1+r-(↑K.1+1+r))^2/4 = (K.1:Int)^2) ) := by + classical + intro K n hfloorEven x v r + have he : -(K.1:Int)+1+r-(↑K.1+1+r) = 2*(-(K.1:Int)) := by ring + rw [he] + have hf := hfloorEven (-(K.1:Int)) + nlinarith + +private theorem hpolyAt270 : + (by + classical + exact + ∀ (K : DiamondParameter), + let n : Int := K.1 + ∀ (x : GaussianInt), + let v : Int := x.im + let r : Int := v-n-1 + (r+1)*(r) - (-( -(K.1:Int)+1+r))*( -( -(K.1:Int)+1+r)-1) + 2*(-(K.1:Int)+1+r) - + 2*(K.1:Int)*((K.1:Int)+1+r) + 2*(K.1:Int)^2 + (K.1:Int)*((K.1:Int)+1) = 0 ) := by + classical + intro K n x v r + ring + +private theorem hdvdAt275 : + (by + classical + exact + ∀ (K : DiamondParameter), ((2 : ℤ) * (((↑K.1 : ℤ) + (1 : ℤ)) * ((↑K.1 : ℤ) + (1 + : ℤ) - (1 : ℤ)) / (2 : ℤ)) = ((↑K.1 : ℤ) + (1 : ℤ)) * ((↑K.1 : ℤ) + (1 : ℤ) + - (1 : ℤ))) → ((2:Int) ∣ (K.1:Int)*((K.1:Int)+1)) ) := by + classical + intro K ht3 + refine ⟨((K.1:Int)+1)*(K.1:Int)/2, ?_⟩ + simpa [mul_comm] using ht3.symm + +private theorem ht3'At278 : + (by + classical + exact + ∀ (K : DiamondParameter), ((2 : ℤ) * (((↑K.1 : ℤ) + (1 : ℤ)) * ((↑K.1 : ℤ) + (1 + : ℤ) - (1 : ℤ)) / (2 : ℤ)) = ((↑K.1 : ℤ) + (1 : ℤ)) * ((↑K.1 : ℤ) + (1 : ℤ) + - (1 : ℤ))) → (2*((K.1:Int)*((K.1:Int)+1)/2) = (K.1:Int)*((K.1:Int)+1)) ) := by + classical + intro K ht3 + simpa [mul_comm] using ht3 + +private theorem hs1At299 : + (by + classical + exact + ∀ (K : DiamondParameter), + let n : Int := K.1 + ∀ (x : GaussianInt), + let v : Int := x.im + let r : Int := v-n-1 + (r-(↑K.1+1+r-(↑K.1+1)))^2/4 = 0 ) := by + classical + intro K n x v r + have he : r-(↑K.1+1+r-(↑K.1+1)) = 0 := by ring + rw [he] + norm_num + +private theorem hs2At303 : + (by + classical + exact + ∀ (K : DiamondParameter), + let n : Int := K.1 + (∀ (m : Int), (2*m+1)^2/4 = m*(m+1)) → (∀ (x : GaussianInt), + let v : Int := x.im + let r : Int := v-n-1 + (-(K.1:Int)+r-(↑K.1+1+r))^2/4 = (K.1:Int)*((K.1:Int)+1)) ) := by + classical + intro K n hfloorOdd x v r + have he : -(K.1:Int)+r-(↑K.1+1+r) = 2*(-(K.1:Int)-1)+1 := by ring + rw [he, hfloorOdd (-(K.1:Int)-1)] + ring + +private theorem hpolyAt310 : + (by + classical + exact + ∀ (K : DiamondParameter), + let n : Int := K.1 + ∀ (x : GaussianInt), + let v : Int := x.im + let r : Int := v-n-1 + r*(r-1) - ((K.1:Int)-r)*((K.1:Int)-r-1) + 3*(K.1:Int)*((K.1:Int)+1) + 2*(1-(K.1:Int))*r - + 2*(K.1:Int)^2 - 4*(K.1:Int) = 0 ) := by + classical + intro K n x v r + ring + +private theorem hdvdAt315 : + (by + classical + exact + ∀ (K : DiamondParameter), ((2 : ℤ) * (((↑K.1 : ℤ) + (1 : ℤ)) * ((↑K.1 : ℤ) + (1 + : ℤ) - (1 : ℤ)) / (2 : ℤ)) = ((↑K.1 : ℤ) + (1 : ℤ)) * ((↑K.1 : ℤ) + (1 : ℤ) + - (1 : ℤ))) → ((2:Int) ∣ (K.1:Int)*((K.1:Int)+1)) ) := by + classical + intro K ht3 + refine ⟨((K.1:Int)+1)*(K.1:Int)/2, ?_⟩ + simpa [mul_comm] using ht3.symm + +private theorem hs1At341 : + (by + classical + exact + ∀ (K : DiamondParameter), (∀ (m : Int), (2*m)^2/4 = m^2) → (∀ (x : GaussianInt), + let v : Int := x.im + let r : Int := v + (-r-1-(-(K.1:Int)) - (r-(-(K.1:Int)-1)))^2/4 = (r+1)^2) ) := by + classical + intro K hfloorEven x v r + have he : -r-1-(-(K.1:Int)) - (r-(-(K.1:Int)-1)) = -2*(r+1) := by ring + rw [he] + have hf := hfloorEven (-(r+1)) + have he' : (-2*(r+1))^2/4 = (2*-(r+1))^2/4 := by + congr 2; ring + rw [he', hf] + ring + +private theorem hs2At349 : + (by + classical + exact + (∀ (m : Int), (2*m+1)^2/4 = m*(m+1)) → (∀ (x : GaussianInt), + let v : Int := x.im + let r : Int := v + (-r-1-r)^2/4 = r*(r+1)) ) := by + classical + intro hfloorOdd x v r + have he : -r-1-r = 2*(-r-1)+1 := by ring + rw [he, hfloorOdd (-r-1)] + ring + +private theorem hpolyAt356 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (x : GaussianInt), + let v : Int := x.im + let r : Int := v + ((K.1:Int)-r-1)*((K.1:Int)-r-2) + (r+1)*r - 2*(r+1)^2 + 2*(K.1:Int)*(r+1) - + (K.1:Int)*((K.1:Int)-1) = 0 ) := by + classical + intro K x v r + ring + +private theorem hs1At382 : + (by + classical + exact + ∀ (K : DiamondParameter), (∀ (m : Int), (2*m+1)^2/4 = m*(m+1)) → (∀ (x : GaussianInt), + let v : Int := x.im + let r : Int := v + (-r-(-(K.1:Int)) - (r-(-(K.1:Int)-1)))^2/4 = r*(r+1)) ) := by + classical + intro K hfloorOdd x v r + have he : -r-(-(K.1:Int)) - (r-(-(K.1:Int)-1)) = 2*(-r-1)+1 := by ring + rw [he, hfloorOdd (-r-1)] + ring + +private theorem hs2At386 : + (by + classical + exact + (∀ (m : Int), (2*m)^2/4 = m^2) → (∀ (x : GaussianInt), + let v : Int := x.im + let r : Int := v + (-r-r)^2/4 = r^2) ) := by + classical + intro hfloorEven x v r + have he : -r-r = 2*(-r) := by ring + rw [he] + have hf := hfloorEven (-r) + rw [hf] + ring + +private theorem hpolyAt395 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (x : GaussianInt), + let v : Int := x.im + let r : Int := v + ((K.1:Int)-r)*((K.1:Int)-r-1) - r*(r-1) + 2*r^2 - 2*r*(r+1) + 2*(K.1:Int)*r - + (K.1:Int)*((K.1:Int)-1) = 0 ) := by + classical + intro K x v r + ring + +private theorem habsTAt417 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let n : Int := K.1 + ∀ (x : GaussianInt), ((0 : ℤ) ≤ x.im ∧ x.im ≤ (2 : ℤ) * n ∧ -n ≤ x.re ∧ x.re ≤ n ∧ -x.im + - (1 : ℤ) ≤ x.re ∧ x.re ≤ x.im + (1 : ℤ) ∧ -((2 : ℤ) * n - x.im + (1 : ℤ)) ≤ x.re ∧ + x.re ≤ (2 : ℤ) * n - x.im + (1 : ℤ)) → (((0 : ℤ) ≤ x.im ∧ x.im ≤ (2 : ℤ) * (↑K.1 + : ℤ) ∧ (2 : ℤ) * (↑K.1 : ℤ) ≤ x.re + (↑K.1 : ℤ) ∧ x.re ≤ (↑K.1 : ℤ) + + (2 : ℤ) * (↑K.1 : ℤ) ∧ -x.im ≤ x.re - (2 : ℤ) * (↑K.1 : ℤ) + (1 : ℤ) ∧ x.re + ≤ x.im + (1 : ℤ) + (2 : ℤ) * (↑K.1 : ℤ) ∧ x.im ≤ (1 : ℤ) + (x.re - (2 : ℤ) * + (↑K.1 : ℤ)) + (2 : ℤ) * (↑K.1 : ℤ) ∧ x.re ≤ (2 : ℤ) * (↑K.1 : ℤ) - + x.im + (1 : ℤ) + (2 : ℤ) * (↑K.1 : ℤ)) → (|(K.1:Int)-2*(K.1:Int)| = (K.1:Int)))) + ) := by + classical + intro K hk n x hxy hxyD + rw [show (K.1:Int)-2*(K.1:Int) = -(K.1:Int) by ring] + rw [abs_of_neg (show -(K.1:Int) < 0 by omega)] + simp + +private theorem hfAt425 : + (by + classical + exact + ∀ (K : DiamondParameter), (∀ (m : Int), (2*m+1)^2/4 = m*(m+1)) → + (((K.1:Int)-2*(K.1:Int)-((K.1:Int)-1))^2/4 = (K.1:Int)*((K.1:Int)-1)) ) := by + classical + intro K hfloorOdd + have he : (K.1:Int)-2*(K.1:Int)-((K.1:Int)-1) = 2*(-(K.1:Int))+1 := by ring + rw [he, hfloorOdd (-(K.1:Int))] + ring + +private theorem habsTAt438 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let n : Int := K.1 + ∀ (x : GaussianInt), ((0 : ℤ) ≤ x.im ∧ x.im ≤ (2 : ℤ) * n ∧ -n ≤ x.re ∧ x.re ≤ n ∧ -x.im + - (1 : ℤ) ≤ x.re ∧ x.re ≤ x.im + (1 : ℤ) ∧ -((2 : ℤ) * n - x.im + (1 : ℤ)) ≤ x.re ∧ + x.re ≤ (2 : ℤ) * n - x.im + (1 : ℤ)) → (((0 : ℤ) ≤ x.im ∧ x.im ≤ (2 : ℤ) * (↑K.1 + : ℤ) ∧ (2 : ℤ) * (↑K.1 : ℤ) ≤ x.re + (↑K.1 : ℤ) ∧ x.re ≤ (↑K.1 : ℤ) + + (2 : ℤ) * (↑K.1 : ℤ) ∧ -x.im ≤ x.re - (2 : ℤ) * (↑K.1 : ℤ) + (1 : ℤ) ∧ x.re + ≤ x.im + (1 : ℤ) + (2 : ℤ) * (↑K.1 : ℤ) ∧ x.im ≤ (1 : ℤ) + (x.re - (2 : ℤ) * + (↑K.1 : ℤ)) + (2 : ℤ) * (↑K.1 : ℤ) ∧ x.re ≤ (2 : ℤ) * (↑K.1 : ℤ) - + x.im + (1 : ℤ) + (2 : ℤ) * (↑K.1 : ℤ)) → (|(K.1:Int)-2*(K.1:Int)| = (K.1:Int)))) + ) := by + classical + intro K hk n x hxy hxyD + rw [show (K.1:Int)-2*(K.1:Int) = -(K.1:Int) by ring] + rw [abs_of_neg (show -(K.1:Int) < 0 by omega)] + simp + +private theorem hfAt446 : + (by + classical + exact + ∀ (K : DiamondParameter), (∀ (m : Int), (2*m)^2/4 = m^2) → + (((K.1:Int)-2*(K.1:Int)-(K.1:Int))^2/4 = (K.1:Int)^2) ) := by + classical + intro K hfloorEven + have he : (K.1:Int)-2*(K.1:Int)-(K.1:Int) = 2*(-(K.1:Int)) := by ring + rw [he, hfloorEven] + ring + +private theorem habsTAt459 : + (by + classical + exact + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + let n : Int := K.1 + ∀ (x : GaussianInt), ((0 : ℤ) ≤ x.im ∧ x.im ≤ (2 : ℤ) * n ∧ -n ≤ x.re ∧ x.re ≤ n ∧ -x.im + - (1 : ℤ) ≤ x.re ∧ x.re ≤ x.im + (1 : ℤ) ∧ -((2 : ℤ) * n - x.im + (1 : ℤ)) ≤ x.re ∧ + x.re ≤ (2 : ℤ) * n - x.im + (1 : ℤ)) → (((0 : ℤ) ≤ x.im ∧ x.im ≤ (2 : ℤ) * (↑K.1 + : ℤ) ∧ (2 : ℤ) * (↑K.1 : ℤ) ≤ x.re + (↑K.1 : ℤ) ∧ x.re ≤ (↑K.1 : ℤ) + + (2 : ℤ) * (↑K.1 : ℤ) ∧ -x.im ≤ x.re - (2 : ℤ) * (↑K.1 : ℤ) + (1 : ℤ) ∧ x.re + ≤ x.im + (1 : ℤ) + (2 : ℤ) * (↑K.1 : ℤ) ∧ x.im ≤ (1 : ℤ) + (x.re - (2 : ℤ) * + (↑K.1 : ℤ)) + (2 : ℤ) * (↑K.1 : ℤ) ∧ x.re ≤ (2 : ℤ) * (↑K.1 : ℤ) - + x.im + (1 : ℤ) + (2 : ℤ) * (↑K.1 : ℤ)) → (|(K.1:Int)-2*(K.1:Int)| = (K.1:Int)))) + ) := by + classical + intro K hk n x hxy hxyD + rw [show (K.1:Int)-2*(K.1:Int) = -(K.1:Int) by ring] + rw [abs_of_neg (show -(K.1:Int) < 0 by omega)] + simp + +private theorem hfAt467 : + (by + classical + exact + ∀ (K : DiamondParameter), (∀ (m : Int), (2*m+1)^2/4 = m*(m+1)) → + (((K.1:Int)-2*(K.1:Int)-((K.1:Int)+1))^2/4 = (K.1:Int)*((K.1:Int)+1)) ) := by + classical + intro K hfloorOdd + have he : (K.1:Int)-2*(K.1:Int)-((K.1:Int)+1) = 2*(-(K.1:Int)-1)+1 := by ring + rw [he, hfloorOdd (-(K.1:Int)-1)] + ring + +private theorem hp' : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (i : Fin 3), + let n : Int := K.1 + let c : Int := if i.val = 0 then -(n*(n+1))/2 else + if i.val = 1 then n*(n-1)/2 else n*(n-1) + let M := (P5352T2PlacementData K.1 i).1 + ∀ (x : GaussianInt), ((P5352T2Sources K hk (0 : Fin (4 : ℕ))).2.1 (x + M.1 - + (P5352T2PlacementData K.1 i).1.1) + (P5352T2PlacementData K.1 i).1.2.re + * (x + M.1).re + (P5352T2PlacementData K.1 i).1.2.im * (x + M.1).im - + (P5352T2Sources K hk (0 : Fin (4 : ℕ))).2.1 (x + M.1) = if (↑i : ℕ) = (0 : ℕ) then + -(n * (n + (1 : ℤ))) / (2 : ℤ) else if (↑i : ℕ) = (1 : ℕ) then n * (n - (1 : ℤ)) / (2 + : ℤ) else n * (n - (1 : ℤ))) → ((P5352T2Sources K hk 0).2.1 x + + M.2.re*(x.re+M.1.re) + M.2.im*(x.im+M.1.im) - (P5352T2Sources K hk 0).2.1 (x+M.1) = + c) ) := by + classical + intro K hk i n c M x hp + simpa [M, c] using hp + +private theorem hx1At508 : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (i : Fin 3), ∀ (x : + GaussianInt), ((x - if true = true then (P5352T2PlacementData K.1 i).1.1 else + -(P5352T2PlacementData K.1 i).1.1) ∈ FootprintVertices (P5352T2Sources K hk + (0 : Fin (4 : ℕ))).1) → (x-(P5352T2PlacementData K.1 i).1.1 ∈ FootprintVertices + (DiamondTile K.1)) ) := by + classical + intro K hk i x hxD + simpa [P5352T2Sources] using hxD + +end DiamondBoundaryDetails + +namespace DiamondPositiveBoundary + +private theorem hpositive : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), + let n : Int := K.1 + (∀ z ∈ FootprintVertices (DiamondTile K.1), (P5352T2Sources K hk (0 : Fin (4 : + ℕ))).2.1 z = (↑z.re.natAbs : ℤ) * ((↑z.re.natAbs : ℤ) - (1 : ℤ)) / (2 : ℤ) - (z.re - + z.im) ^ (2 : ℕ) / (4 : ℤ)) → ((∀ (m : ℤ), ((2 : ℤ) * m) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 + : ℕ)) → ((∀ (m : ℤ), ((2 : ℤ) * m + (1 : ℤ)) ^ (2 : ℕ) / (4 : ℤ) = m * (m + (1 : ℤ))) + → ((∀ (a : Int), 2*(a*(a-1)/2) = a*(a-1)) → ((∀ (z : GaussianInt), z ∈ + FootprintVertices (DiamondTile K.1) ↔ (0 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑K.1 : ℤ) ∧ + -(↑K.1 : ℤ) ≤ z.re ∧ z.re ≤ (↑K.1 : ℤ) ∧ -z.im - (1 : ℤ) ≤ z.re ∧ + z.re ≤ z.im + (1 : ℤ) ∧ -((2 : ℤ) * (↑K.1 : ℤ) - z.im + (1 : ℤ)) ≤ z.re ∧ z.re ≤ + (2 : ℤ) * (↑K.1 : ℤ) - z.im + (1 : ℤ)) → (∀ (i : Fin 3), ∀ (x : GaussianInt), x + ∈ FootprintVertices (DiamondTile K.1) → x - (P5352T2PlacementData K.1 i).1.1 ∈ + FootprintVertices (DiamondTile K.1) → (P5352T2Sources K hk 0).2.1 (x - + (P5352T2PlacementData K.1 i).1.1) + (P5352T2PlacementData K.1 i).1.2.re*x.re + + (P5352T2PlacementData K.1 i).1.2.im*x.im - (P5352T2Sources K hk 0).2.1 x = if + i.val = 0 then -(n*(n+1))/2 else if i.val = 1 then n*(n-1)/2 else n*(n-1)))))) ) := by + classical + intro K hk n hF hfloorEven hfloorOdd tri foot i x hx hxD + let u : Int := x.re + let v : Int := x.im + have hxy := (foot x).mp hx + have hxyD := (foot (x-(P5352T2PlacementData K.1 i).1.1)).mp hxD + fin_cases i + · simp? [P5352T2PlacementData] at hxyD + have hd : v-u = 2*n ∨ v-u = 2*n+1 := by + omega + rcases hd with hd | hd + · let r : Int := v-n-1 + have hr0 : 0 ≤ r := by dsimp [r]; omega + have hrn : r < n := by dsimp [r]; omega + have hxe : x = ⟨-n+1+r,n+1+r⟩ := by + ext <;> simp [r,v]; omega + rw [hxe] + simp? [P5352T2PlacementData] + rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), + hF _ (by simpa [hxe] using hx)] + simp only [n] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] + simp only [Int.natCast_natAbs] + have hrabs : 0 ≤ r+1 := by omega + have huabs : -n+1+r ≤ 0 := by omega + have harg : -(K.1 : Int)+1+r- -(K.1 : Int) = r+1 := by ring + rw [harg] + have huabs' : -(K.1:Int)+1+r ≤ 0 := by simpa [n] using huabs + rw [abs_of_nonneg hrabs] + rw [abs_of_nonpos huabs'] + have hs1 := DiamondBoundaryDetails.hs1At258 K x + have hs2 := DiamondBoundaryDetails.hs2At262 K hfloorEven x + rw [hs1, hs2] + have ht1 := tri (r+1) + have ht2 := tri (-( -(K.1:Int)+1+r)) + have hpoly := DiamondBoundaryDetails.hpolyAt270 K x + have ht3 := tri ((K.1:Int)+1) + have hdvd := DiamondBoundaryDetails.hdvdAt275 K ht3 + have ht3' := DiamondBoundaryDetails.ht3'At278 K ht3 + rw [Int.neg_ediv_of_dvd hdvd] + apply (mul_left_cancel₀ (by norm_num : (2:Int) ≠ 0)) + nlinarith [ht1, ht2, hpoly, ht3'] + · let r : Int := v-n-1 + have hr0 : 0 ≤ r := by dsimp [r]; omega + have hrn : r < n := by dsimp [r]; omega + have hxe : x = ⟨-n+r,n+1+r⟩ := by + ext <;> simp [r,v]; omega + rw [hxe] + simp? [P5352T2PlacementData] + rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), + hF _ (by simpa [hxe] using hx)] + simp only [n, Zsqrtd.re_sub, Zsqrtd.im_sub, Int.natCast_natAbs] + have huabs : -n+r ≤ 0 := by omega + have huabs' : -(K.1:Int)+r ≤ 0 := by simpa [n] using huabs + have harg : -(K.1:Int)+r- -(K.1:Int) = r := by ring + rw [harg] + rw [abs_of_nonneg hr0, abs_of_nonpos huabs'] + have hs1 := DiamondBoundaryDetails.hs1At299 K x + have hs2 := DiamondBoundaryDetails.hs2At303 K hfloorOdd x + rw [hs1, hs2] + have ht1 := tri r + have ht2 := tri ((K.1:Int)-r) + have hpoly := DiamondBoundaryDetails.hpolyAt310 K x + have ht3 := tri ((K.1:Int)+1) + have hdvd := DiamondBoundaryDetails.hdvdAt315 K ht3 + have ht3' : 2*((K.1:Int)*((K.1:Int)+1)/2) = + (K.1:Int)*((K.1:Int)+1) := by simpa [mul_comm] using ht3 + rw [Int.neg_ediv_of_dvd hdvd] + apply (mul_left_cancel₀ (by norm_num : (2:Int) ≠ 0)) + have habsRe : -(-(K.1:Int)+r) = (K.1:Int)-r := by ring + rw [habsRe] + linear_combination ht1 - ht2 + hpoly + ht3' + · simp? [P5352T2PlacementData] at hxyD + have hd : u+v = -1 ∨ u+v = 0 := by omega + rcases hd with hd | hd + · let r : Int := v + have hr0 : 0 ≤ r := by dsimp [r]; omega + have hrn : r < n := by dsimp [r]; omega + have hxe : x = ⟨-r-1,r⟩ := by ext <;> simp [r,v]; omega + rw [hxe] + simp? [P5352T2PlacementData] + rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), + hF _ (by simpa [hxe] using hx)] + simp only [n, Zsqrtd.re_sub, Zsqrtd.im_sub, Int.natCast_natAbs] + have harg : (K.1:Int)-r-1 ≥ 0 := by omega + have huabs : -r-1 ≤ 0 := by omega + have harg' : 0 ≤ -r-1 - (-(K.1:Int)) := by nlinarith [harg] + rw [abs_of_nonneg harg', abs_of_nonpos huabs] + have hs1 := DiamondBoundaryDetails.hs1At341 K hfloorEven x + have hs2 := DiamondBoundaryDetails.hs2At349 hfloorOdd x + rw [hs1, hs2] + have ht1 := tri ((K.1:Int)-r-1) + have ht2 := tri (r+1) + have hpoly := DiamondBoundaryDetails.hpolyAt356 K x + have ht3 := tri (K.1:Int) + have ht3' : 2*((K.1:Int)*((K.1:Int)-1)/2) = + (K.1:Int)*((K.1:Int)-1) := by simpa using ht3 + apply (mul_left_cancel₀ (by norm_num : (2:Int) ≠ 0)) + have hre : -r-1 - (-(K.1:Int)) = (K.1:Int)-r-1 := by ring + have hbr : -(-r-1) = r+1 := by ring + rw [hre, hbr] + have htr : r+1-1 = r := by omega + rw [htr] at ht2 ⊢ + linear_combination ht1 - ht2 + hpoly - ht3' + · let r : Int := v + have hr0 : 0 ≤ r := by dsimp [r]; omega + have hrn : r < n := by dsimp [r]; omega + have hxe : x = ⟨-r,r⟩ := by ext <;> simp [r,v]; omega + rw [hxe] + simp? [P5352T2PlacementData] + rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), + hF _ (by simpa [hxe] using hx)] + simp only [n, Zsqrtd.re_sub, Zsqrtd.im_sub, Int.natCast_natAbs] + have harg : (K.1:Int)-r ≥ 0 := by omega + have huabs : -r ≤ 0 := by omega + have harg' : 0 ≤ -r - (-(K.1:Int)) := by nlinarith [harg] + rw [abs_of_nonneg harg', abs_of_nonpos huabs] + have hs1 := DiamondBoundaryDetails.hs1At382 K hfloorOdd x + have hs2 := DiamondBoundaryDetails.hs2At386 hfloorEven x + rw [hs1, hs2] + have ht1 := tri ((K.1:Int)-r) + have ht2 := tri r + have hpoly := DiamondBoundaryDetails.hpolyAt395 K x + have ht3 := tri (K.1:Int) + have ht3' : 2*((K.1:Int)*((K.1:Int)-1)/2) = + (K.1:Int)*((K.1:Int)-1) := by simpa using ht3 + apply (mul_left_cancel₀ (by norm_num : (2:Int) ≠ 0)) + have hre : -r - (-(K.1:Int)) = (K.1:Int)-r := by ring + have hbaseT : -(-r)*(-(-r)-1) = r*(r-1) := by ring + rw [hre, hbaseT] + linear_combination ht1 - ht2 + hpoly - ht3' + · simp? [P5352T2PlacementData] at hxyD + have hu : u = n := by omega + have hv : v = n-1 ∨ v = n ∨ v = n+1 := by omega + rcases hv with hv | hv | hv + · have hxe : x = ⟨n,n-1⟩ := by ext <;> simp [u,v,hu,hv] + rw [hxe] + simp? [P5352T2PlacementData] + rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), + hF _ (by simpa [hxe] using hx)] + simp only [n, Zsqrtd.re_sub, Zsqrtd.im_sub, Int.natCast_natAbs] + have habsT := DiamondBoundaryDetails.habsTAt417 K + hk x hxy hxyD + have habsB : |(K.1:Int)| = (K.1:Int) := + abs_of_nonneg (show 0 ≤ (K.1:Int) by omega) + rw [habsT, habsB] + simp only [sub_zero] + have hf := DiamondBoundaryDetails.hfAt425 K hfloorOdd + have hxSq : ((K.1:Int)-((K.1:Int)-1))^2/4 = 0 := by norm_num + rw [hf, hxSq] + ring + · have hxe : x = ⟨n,n⟩ := by ext <;> simp [u,v,hu,hv] + rw [hxe] + simp? [P5352T2PlacementData] + rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), + hF _ (by simpa [hxe] using hx)] + simp only [n, Zsqrtd.re_sub, Zsqrtd.im_sub, Int.natCast_natAbs] + have habsT := DiamondBoundaryDetails.habsTAt438 K + hk x hxy hxyD + have habsB : |(K.1:Int)| = (K.1:Int) := + abs_of_nonneg (show 0 ≤ (K.1:Int) by omega) + rw [habsT, habsB] + simp only [sub_zero] + have hf := DiamondBoundaryDetails.hfAt446 K hfloorEven + have hxSq : ((K.1:Int)-(K.1:Int))^2/4 = 0 := by norm_num + rw [hf, hxSq] + ring + · have hxe : x = ⟨n,n+1⟩ := by ext <;> simp [u,v,hu,hv] + rw [hxe] + simp? [P5352T2PlacementData] + rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), + hF _ (by simpa [hxe] using hx)] + simp only [n, Zsqrtd.re_sub, Zsqrtd.im_sub, Int.natCast_natAbs] + have habsT := DiamondBoundaryDetails.habsTAt459 K + hk x hxy hxyD + have habsB : |(K.1:Int)| = (K.1:Int) := + abs_of_nonneg (show 0 ≤ (K.1:Int) by omega) + rw [habsT, habsB] + simp only [sub_zero] + have hf := DiamondBoundaryDetails.hfAt467 K hfloorOdd + have hxSq : ((K.1:Int)-((K.1:Int)+1))^2/4 = 0 := by norm_num + rw [hf, hxSq] + ring + +end DiamondPositiveBoundary + +theorem P5491T1DiamondRightBoundary (K : DiamondParameter) (hk : 1 < K.1) + (i : Fin 3) (e : Bool) : + let A := P5352T2Sources K hk 0 + let M := (P5352T2PlacementData K.1 i).1 + let d := if e then M.1 else -M.1 + let a := if e then M.2 else -M.2 + ∃ b : ℤ, ∀ x : GaussianInt, + x ∈ FootprintVertices A.1 → x-d ∈ FootprintVertices A.1 → + A.2.1 (x-d) + a.re*x.re + a.im*x.im - A.2.1 x = b := by +-- BODY + dsimp only + let n : Int := K.1 + have hn : 2 ≤ n := by dsimp [n]; exact_mod_cast hk + have hA : (P5352T2Sources K hk 0).1 = DiamondTile K.1 := by + simp [P5352T2Sources] + have hF (z : GaussianInt) (hz : z ∈ FootprintVertices (DiamondTile K.1)) := + DiamondBoundaryDetails.hF K hk z hz + have hfloorEven (m : Int) := DiamondBoundaryDetails.hfloorEven m + have hfloorOdd (m : Int) := DiamondBoundaryDetails.hfloorOdd m + let Q (a b : Int) : Int := + (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + have tri (a : Int) : 2*(a*(a-1)/2) = a*(a-1) := DiamondRightBoundaryProof.tri K a + have square (a : Int) : 4*(a^2/4) = a^2-a%2 := DiamondRightBoundaryProof.square K a + have scale (a b : Int) := DiamondBoundaryDetails.scale tri square a b + have foot (z : GaussianInt) := DiamondBoundaryDetails.foot K z + have hpositive : ∀ (i : Fin 3) (x : GaussianInt), + x ∈ FootprintVertices (DiamondTile K.1) → + x - (P5352T2PlacementData K.1 i).1.1 ∈ FootprintVertices (DiamondTile K.1) → + (P5352T2Sources K hk 0).2.1 + (x - (P5352T2PlacementData K.1 i).1.1) + + (P5352T2PlacementData K.1 i).1.2.re*x.re + + (P5352T2PlacementData K.1 i).1.2.im*x.im - + (P5352T2Sources K hk 0).2.1 x = + if i.val = 0 then -(n*(n+1))/2 else + if i.val = 1 then n*(n-1)/2 else n*(n-1) := DiamondPositiveBoundary.hpositive K hk hF + hfloorEven hfloorOdd tri foot + have hposResult : ∀ (i : Fin 3) (x : GaussianInt), + x ∈ FootprintVertices (DiamondTile K.1) → + x - (P5352T2PlacementData K.1 i).1.1 ∈ FootprintVertices (DiamondTile K.1) → + (P5352T2Sources K hk 0).2.1 + (x - (P5352T2PlacementData K.1 i).1.1) + + (P5352T2PlacementData K.1 i).1.2.re*x.re + + (P5352T2PlacementData K.1 i).1.2.im*x.im - + (P5352T2Sources K hk 0).2.1 x = + if i.val = 0 then -(n*(n+1))/2 else + if i.val = 1 then n*(n-1)/2 else n*(n-1) := DiamondRightBoundaryProof.hposResult K hk + hpositive + let c : Int := if i.val = 0 then -(n*(n+1))/2 else + if i.val = 1 then n*(n-1)/2 else n*(n-1) + cases e + · let M := (P5352T2PlacementData K.1 i).1 + refine ⟨M.2.re*M.1.re + M.2.im*M.1.im - c, ?_⟩ + intro x hx hxD + have hx0 : x ∈ FootprintVertices (DiamondTile K.1) := by + simpa [P5352T2Sources] using hx + have hx1 : x+M.1 ∈ FootprintVertices (DiamondTile K.1) := by + simpa [P5352T2Sources, M, P5352T2PlacementData] using hxD + have hp := hposResult i (x+M.1) hx1 (by simpa [M] using hx0) + have hp' := DiamondBoundaryDetails.hp' K hk i x hp + simp only [Bool.false_eq_true, ↓reduceIte, sub_neg_eq_add] + simp only [M, + Zsqrtd.re_neg, Zsqrtd.im_neg] at hp' ⊢ + linear_combination -hp' + · refine ⟨c, ?_⟩ + intro x hx hxD + have hx0 : x ∈ FootprintVertices (DiamondTile K.1) := by + simpa [P5352T2Sources] using hx + have hx1 := DiamondBoundaryDetails.hx1At508 K hk i x hxD + have hp := hposResult i x hx0 hx1 + simpa [P5352T2Sources, P5352T2PlacementData, c] using hp + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1ExceptionalPresentation.lean b/LeanPool/ApollonianSuperharmonic/P5491T1ExceptionalPresentation.lean new file mode 100644 index 0000000000..737db3a376 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5491T1ExceptionalPresentation.lean @@ -0,0 +1,96 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist + +-- [TABLET NODE: P5491T1ExceptionalPresentation] + +/-! +# P5491T1ExceptionalPresentation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5491T1ExceptionalPresentation (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) + (he : (∃ (g : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction g (FordCircleCoordinate P.p P.q) = q 0) ∨ + (∃ (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction g (DiamondRecursiveQuadruple K 0) = q 0)) : + ∃ g : BandPackingSymmetry, + (∃ P : FordFareyParameter, 1 < P.q ∧ + (BandPackingSymmetryQuadrupleAction g q) 0 = FordRecursiveQuadruple P 0 ∧ + ∀ i : Fin 3, ∃ j : Fin 3, + (BandPackingSymmetryQuadrupleAction g q) i.succ = + FordRecursiveQuadruple P j.succ) ∨ + (∃ K : DiamondParameter, 1 < K.1 ∧ + (BandPackingSymmetryQuadrupleAction g q) 0 = DiamondRecursiveQuadruple K 0 ∧ + ∀ i : Fin 3, ∃ j : Fin 3, + (BandPackingSymmetryQuadrupleAction g q) i.succ = + DiamondRecursiveQuadruple K j.succ) := by +-- BODY + have parents (F R : Fin 4 → CircleCoordinates) + (hF : ProperBandQuadruple F) (hR : ProperBandQuadruple R) + (h0 : R 0 = F 0) : ∀ i : Fin 3, ∃ j : Fin 3, R i.succ = F j.succ := by + obtain ⟨r,hr,_⟩ := BandPredecessorNoCollision F R hF hR h0.symm + exact fun i => ⟨i+r,hr i⟩ + have childLarge : 1 < (q 0).1 := by + have H := ProperBandCurvatureStructure q hq + have H0 := hq.2 0 + have H1 := hq.2 1 + have N0 := H.2.1 0 + have N1 := H.2.1 1 + by_contra hn + have Z0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have Z1 : (q (1 : Fin 3).succ).1 = 0 := by omega + have := H.2.2 0 1 Z0 Z1 + contradiction + rcases he with ⟨w,P,hw⟩ | ⟨w,K,hw⟩ + · obtain ⟨v,hleft,_,_⟩ := BandPackingSymmetryInversePhaseCancellation.2 w + have hR := BandPackingSymmetryProperCovariance v q hq + have h0 : (BandPackingSymmetryQuadrupleAction v q) 0 = FordRecursiveQuadruple P 0 := by + change BandPackingSymmetryCircleAction v (q 0) = FordCircleCoordinate P.p P.q + rw [← hw,hleft] + have hP : 1 < P.q := by + have hc := (BandPackingSymmetryCovariance w).1 (FordCircleCoordinate P.p P.q) + rw [hw] at hc + by_contra hn + have hq1 : P.q = 1 := by have := P.q_pos; omega + simp [FordCircleCoordinate,hq1] at hc + omega + exact ⟨v,Or.inl ⟨P,hP,h0,parents _ _ ((FordCoordinateConfiguration P).2 hP).1 hR h0⟩⟩ + · obtain ⟨v,hleft,_,_⟩ := BandPackingSymmetryInversePhaseCancellation.2 w + have hR := BandPackingSymmetryProperCovariance v q hq + have h0 : (BandPackingSymmetryQuadrupleAction v q) 0 = DiamondRecursiveQuadruple K 0 := by + change BandPackingSymmetryCircleAction v (q 0) = DiamondRecursiveQuadruple K 0 + rw [← hw,hleft] + by_cases hK : 1 < K.1 + · exact ⟨v,Or.inr ⟨K,hK,h0,parents _ _ (DiamondCoordinateConfiguration K).2.1 hR h0⟩⟩ + · have hk1 : K.1 = 1 := by have := K.2; omega + obtain ⟨P,⟨hp,hpden⟩,_⟩ := FordFareyParentsExist 1 2 (by decide) (by decide) + have hP : 1 < P.q := by omega + have hford : (BandPackingSymmetryQuadrupleAction v q) 0 = FordRecursiveQuadruple P 0 := by + rw [h0] + simp [DiamondRecursiveQuadruple,FordRecursiveQuadruple,FordCircleCoordinate, + hk1,hp,hpden] + exact ⟨v,Or.inl ⟨P,hP,hford, + parents _ _ ((FordCoordinateConfiguration P).2 hP).1 hR hford⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1FordBoundarySlope.lean b/LeanPool/ApollonianSuperharmonic/P5491T1FordBoundarySlope.lean new file mode 100644 index 0000000000..27068652bd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5491T1FordBoundarySlope.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.P4217T2RectangularBoundarySlope + +-- [TABLET NODE: P5491T1FordBoundarySlope] + +/-! +# P5491T1FordBoundarySlope + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5491T1FordBoundarySlope (P : FordFareyParameter) + (h : PartialOdometer) + (hd : (h.domain : Set GaussianInt) = FordVertexDomain P.q) + (hv : ∀ x, x ∈ h.domain → h.value x = FordOdometer P x) : + PartialOdometerSlope h = some ((P.p : ℝ)/2, (P.p : ℝ)/2) := by +-- BODY + have hqn : (P.q : ℤ) ≠ 0 := by exact_mod_cast P.q_pos.ne' + have boundary (x y : ℤ) (hx : 0 ≤ x) (hxq : x ≤ P.q) + (hy : 0 ≤ y) (hyq : y ≤ P.q) + (hb : x = 0 ∨ x = P.q ∨ y = 0 ∨ y = P.q) : + h.value ⟨x,y⟩ = IntegerCeilDiv (P.p*x*y) P.q hqn := by + rw [hv _ (by change (⟨x,y⟩ : GaussianInt) ∈ (h.domain : Set GaussianInt) + rw [hd]; exact ⟨hx,hxq,hy,hyq⟩)] + apply (Classical.choose_spec FordOdometerFamilyExistsUnique).1.2.1 + change (0 ≤ x ∧ x ≤ (P.q : ℤ) ∧ 0 ≤ y ∧ y ≤ (P.q : ℤ)) ∧ + ¬ (2 ≤ x ∧ x ≤ (P.q : ℤ)-2 ∧ 2 ≤ y ∧ y ≤ (P.q : ℤ)-2) + omega + have hz (y : ℤ) (hy : 0 ≤ y) (hyq : y ≤ P.q) : h.value ⟨0,y⟩ = 0 := by + rw [boundary 0 y (by omega) (by omega) hy hyq (Or.inl rfl)] + simp [IntegerCeilDiv] + have hright (y : ℤ) (hy : 0 ≤ y) (hyq : y ≤ P.q) : + h.value ⟨P.q,y⟩ = P.p*y := by + rw [boundary P.q y (by omega) (by omega) hy hyq (Or.inr (Or.inl rfl))] + unfold IntegerCeilDiv + rw [show -(P.p*(P.q : ℤ)*y) = (-(P.p*y))*(P.q : ℤ) by ring, + Int.mul_ediv_cancel _ hqn] + ring + have hbottom (x : ℤ) (hx : 0 ≤ x) (hxq : x ≤ P.q) : h.value ⟨x,0⟩ = 0 := by + rw [boundary x 0 hx hxq (by omega) (by omega) (Or.inr (Or.inr (Or.inl rfl)))] + simp [IntegerCeilDiv] + have htop (x : ℤ) (hx : 0 ≤ x) (hxq : x ≤ P.q) : + h.value ⟨x,P.q⟩ = P.p*x := by + rw [boundary x P.q hx hxq (by omega) (by omega) (Or.inr (Or.inr (Or.inr rfl)))] + unfold IntegerCeilDiv + rw [show -(P.p*x*(P.q : ℤ)) = (-(P.p*x))*(P.q : ℤ) by ring, + Int.mul_ediv_cancel _ hqn] + ring + have hs := P4217T2RectangularBoundarySlope h P.q P.q P.q_pos P.q_pos + P.p P.p hd hz hright hbottom htop + have hn : (P.q : ℝ) ≠ 0 := by exact_mod_cast P.q_pos.ne' + convert hs using 2; field_simp + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1FordParentBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5491T1FordParentBoundary.lean new file mode 100644 index 0000000000..da9328da44 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5491T1FordParentBoundary.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary + +-- [TABLET NODE: P5491T1FordParentBoundary] + +/-! +# P5491T1FordParentBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5491T1FordParentBoundary : + ∀ (P : FordFareyParameter), ∀ (A : FordFareyParameter), (1 < P.q) → (∀ (j : Fin 2), ∀ (s : + Fin 4), (A.p = ![P.p₁, P.p₂] j) → ((A.q = ![P.q₁, P.q₂] j) → ( + let R := P5332T1ParentRows P j s 0; + ∃ b : ℤ, ∀ x : GaussianInt, + x ∈ FordVertexDomain P.q → x - R.displacement ∈ FordVertexDomain A.q → + FordOdometer A (x-R.displacement) + R.linear.re*x.re + + R.linear.im*x.im - FordOdometer P x = b))) := by + intro P A hq j s hp hd +-- BODY + have hnP : (P.q : ℤ) ≠ 0 := by exact_mod_cast P.q_pos.ne' + have boundary (N : FordFareyParameter) (x y : ℤ) + (hx : 0 ≤ x) (hxq : x ≤ N.q) (hy : 0 ≤ y) (hyq : y ≤ N.q) + (hb : x = 0 ∨ x = N.q ∨ y = 0 ∨ y = N.q) : + FordOdometer N ⟨x,y⟩ = IntegerCeilDiv (N.p*x*y) N.q + (by exact_mod_cast N.q_pos.ne') := by + apply (Classical.choose_spec FordOdometerFamilyExistsUnique).1.2.1 + change (0 ≤ x ∧ x ≤ (N.q : ℤ) ∧ 0 ≤ y ∧ y ≤ (N.q : ℤ)) ∧ + ¬ (2 ≤ x ∧ x ≤ (N.q : ℤ)-2 ∧ 2 ≤ y ∧ y ≤ (N.q : ℤ)-2) + exact ⟨⟨hx,hxq,hy,hyq⟩, by + rcases hb with h | h | h | h <;> simp [h]⟩ + have bottom (N : FordFareyParameter) (x : ℤ) (hx : 0 ≤ x) (hxq : x ≤ N.q) : + FordOdometer N ⟨x,0⟩ = 0 := by + rw [boundary N x 0 hx hxq (by omega) (by omega) (by omega)] + simp [IntegerCeilDiv] + have leftEdge (N : FordFareyParameter) (y : ℤ) (hy : 0 ≤ y) (hyq : y ≤ N.q) : + FordOdometer N ⟨0,y⟩ = 0 := by + rw [boundary N 0 y (by omega) (by omega) hy hyq (by omega)] + simp [IntegerCeilDiv] + have top (N : FordFareyParameter) (x : ℤ) (hx : 0 ≤ x) (hxq : x ≤ N.q) : + FordOdometer N ⟨x,N.q⟩ = N.p*x := by + rw [boundary N x N.q hx hxq (by omega) (by omega) (by omega)] + unfold IntegerCeilDiv + have hq : (N.q : ℤ) ≠ 0 := by exact_mod_cast N.q_pos.ne' + rw [show -(N.p*x*(N.q : ℤ)) = (-(N.p*x))*(N.q : ℤ) by ring, + Int.mul_ediv_cancel _ hq] + ring + have rightEdge (N : FordFareyParameter) (y : ℤ) (hy : 0 ≤ y) (hyq : y ≤ N.q) : + FordOdometer N ⟨N.q,y⟩ = N.p*y := by + rw [boundary N N.q y (by omega) (by omega) hy hyq (by omega)] + unfold IntegerCeilDiv + have hq : (N.q : ℤ) ≠ 0 := by exact_mod_cast N.q_pos.ne' + rw [show -(N.p*(N.q : ℤ)*y) = (-(N.p*y))*(N.q : ℤ) by ring, + Int.mul_ediv_cancel _ hq] + ring + have parent (j' : Fin 2) (s' : Fin 4) + (hpj : A.p = ![P.p₁, P.p₂] j') (hqj : A.q = ![P.q₁, P.q₂] j') : + let R := P5332T1ParentRows P j' s' 0 + ∃ b : ℤ, ∀ x : GaussianInt, + x ∈ FordVertexDomain P.q → x-R.displacement ∈ FordVertexDomain A.q → + FordOdometer A (x-R.displacement) + R.linear.re*x.re + + R.linear.im*x.im - FordOdometer P x = b := by + fin_cases j' <;> fin_cases s' + all_goals + simp only [P5332T1ParentRows, Matrix.cons_val_zero, Matrix.cons_val_one, + Matrix.cons_val_two, Matrix.cons_val_three, + Matrix.head_cons, Matrix.tail_cons, Fin.reduceFinMk, Fin.isValue] + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Fin.reduceFinMk] at hpj hqj + · refine ⟨P.p₂ * (P.q : ℤ), ?_⟩ + rintro ⟨x,y⟩ hx hy + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, + Zsqrtd.im_sub] at hx hy + simp only [] at hx hy ⊢ + have hqParent : A.q = P.q₁ := by simpa using hqj + change FordOdometer A (⟨x,y⟩-⟨P.q₂,P.q⟩) + P.p*x + P.p₂*y - + FordOdometer P ⟨x,y⟩ = _ + have he : y = P.q := by omega + subst y + rw [show (⟨x,P.q⟩-⟨P.q₂,P.q⟩ : GaussianInt) = ⟨x-P.q₂,0⟩ by ext <;> simp] + have he' : 0 ≤ x-P.q₂ ∧ x-P.q₂ ≤ A.q := by omega + rw [bottom A _ he'.1 he'.2, top P _ hx.1 hx.2.1] + ring + · refine ⟨-P.p₁ * (P.q₂ : ℤ), ?_⟩ + rintro ⟨x,y⟩ hx hy + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, + Zsqrtd.im_sub] at hx hy + simp only [] at hx hy ⊢ + have hqParent : A.q = P.q₁ := by simpa using hqj + have he : x = 0 := by omega + subst x + rw [show (⟨0,y⟩-⟨-P.q₁,P.q₂⟩ : GaussianInt) = ⟨P.q₁,y-P.q₂⟩ by ext <;> simp] + rw [leftEdge P _ hx.2.2.1 hx.2.2.2] + -- The parent point is on its right edge by the determinant identity. + have hpq : A.q = P.q₁ := by simpa using hqj + have hpa : A.p = P.p₁ := by simpa using hpj + rw [show (⟨P.q₁,y-P.q₂⟩ : GaussianInt) = ⟨A.q,y-P.q₂⟩ by simp [hpq]] + rw [rightEdge A _ (by omega) (by omega)] + rw [hpa] + ring + · refine ⟨0, ?_⟩ + rintro ⟨x,y⟩ hx hy + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, + Zsqrtd.im_sub] at hx hy + simp only [sub_zero] at hx hy ⊢ + have he : y = 0 := by omega + subst y + have hpa : A.p = P.p₁ := by simpa using hpj + have hpq : A.q = P.q₁ := by simpa using hqj + rw [show (⟨x,0⟩-⟨0,-P.q₁⟩ : GaussianInt) = ⟨x,P.q₁⟩ by ext <;> simp] + rw [show (⟨x,P.q₁⟩ : GaussianInt) = ⟨x,A.q⟩ by simp [hpq], + top A _ (by omega) (by omega), bottom P _ hx.1 hx.2.1] + rw [hpa] + ring + · refine ⟨0, ?_⟩ + rintro ⟨x,y⟩ hx hy + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, + Zsqrtd.im_sub] at hx hy + simp only [sub_zero] at hx hy ⊢ + change 0 ≤ x-P.q ∧ x-P.q ≤ A.q ∧ 0 ≤ y ∧ y ≤ A.q at hy + have he : x = P.q := by omega + subst x + rw [show (⟨P.q,y⟩-⟨P.q,0⟩ : GaussianInt) = ⟨0,y⟩ by ext <;> simp, + leftEdge A _ (by omega) (by omega), rightEdge P _ hx.2.2.1 hx.2.2.2] + ring + · refine ⟨0, ?_⟩ + rintro ⟨x,y⟩ hx hy + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, + Zsqrtd.im_sub] at hx hy + simp only [sub_zero] at hx hy ⊢ + have hqParent : A.q = P.q₂ := by simpa using hqj + have he : x = 0 := by omega + subst x + have hpa : A.p = P.p₂ := by simpa using hpj + rw [show (⟨0,y⟩-⟨-P.q₂,0⟩ : GaussianInt) = ⟨P.q₂,y⟩ by ext <;> simp, + show (⟨P.q₂,y⟩ : GaussianInt) = ⟨A.q,y⟩ by simp [hqParent], + rightEdge A _ (by omega) (by omega), leftEdge P _ hx.2.2.1 hx.2.2.2, + hpa] + ring + · refine ⟨-P.p₂ * (P.q₁ : ℤ), ?_⟩ + rintro ⟨x,y⟩ hx hy + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, + Zsqrtd.im_sub] at hx hy + simp only [] at hx hy ⊢ + have hqParent : A.q = P.q₂ := by simpa using hqj + have he : y = 0 := by omega + subst y + have hpa : A.p = P.p₂ := by simpa using hpj + rw [show (⟨x,0⟩-⟨P.q₁,-P.q₂⟩ : GaussianInt) = ⟨x-P.q₁,P.q₂⟩ by + ext <;> simp, + show (⟨x-P.q₁,P.q₂⟩ : GaussianInt) = ⟨x-P.q₁,A.q⟩ by simp [hqParent], + top A _ (by omega) (by omega), bottom P _ hx.1 hx.2.1, hpa] + ring + · refine ⟨P.p₁ * (P.q : ℤ), ?_⟩ + rintro ⟨x,y⟩ hx hy + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, + Zsqrtd.im_sub] at hx hy + simp only [] at hx hy ⊢ + have hqParent : A.q = P.q₂ := by simpa using hqj + have he : x = P.q := by omega + subst x + rw [show (⟨P.q,y⟩-⟨P.q,P.q₁⟩ : GaussianInt) = ⟨0,y-P.q₁⟩ by + ext <;> simp, + leftEdge A _ (by omega) (by omega), rightEdge P _ hx.2.2.1 hx.2.2.2] + ring + · refine ⟨0, ?_⟩ + rintro ⟨x,y⟩ hx hy + simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, + Zsqrtd.im_sub] at hx hy + simp only [sub_zero] at hx hy ⊢ + have hqParent : A.q = P.q₂ := by simpa using hqj + have he : y = P.q := by omega + subst y + rw [show (⟨x,P.q⟩-⟨0,P.q⟩ : GaussianInt) = ⟨x,0⟩ by ext <;> simp, + bottom A _ (by omega) (by omega), top P _ hx.1 hx.2.1] + ring + dsimp only + exact parent j s hp hd + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1FordRightBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5491T1FordRightBoundary.lean new file mode 100644 index 0000000000..5f87de3f98 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5491T1FordRightBoundary.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5332T1RightRows +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FordVertexDomain +public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary + +-- [TABLET NODE: P5491T1FordRightBoundary] + +/-! +# P5491T1FordRightBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5491T1FordRightBoundary (P : FordFareyParameter) (hq : 1 < P.q) + (j : Fin 3) (e : Bool) : + let R := P5332T1RightRows P j 0 + let d := if e then R.displacement else -R.displacement + let a := if e then R.linear else -R.linear + ∃ b : ℤ, ∀ x : GaussianInt, + x ∈ FordVertexDomain P.q → x - d ∈ FordVertexDomain P.q → + FordOdometer P (x-d) + a.re*x.re + a.im*x.im - FordOdometer P x = b := by +-- BODY + have hn : (P.q : ℤ) ≠ 0 := by exact_mod_cast P.q_pos.ne' + have boundary (x y : ℤ) (hx : 0 ≤ x) (hxq : x ≤ P.q) + (hy : 0 ≤ y) (hyq : y ≤ P.q) + (hb : x = 0 ∨ x = P.q ∨ y = 0 ∨ y = P.q) : + FordOdometer P ⟨x,y⟩ = IntegerCeilDiv (P.p*x*y) P.q hn := by + apply (Classical.choose_spec FordOdometerFamilyExistsUnique).1.2.1 + change (0 ≤ x ∧ x ≤ (P.q : ℤ) ∧ 0 ≤ y ∧ y ≤ (P.q : ℤ)) ∧ + ¬ (2 ≤ x ∧ x ≤ (P.q : ℤ)-2 ∧ 2 ≤ y ∧ y ≤ (P.q : ℤ)-2) + omega + have bottom (x : ℤ) (hx : 0 ≤ x) (hxq : x ≤ P.q) : + FordOdometer P ⟨x,0⟩ = 0 := by + rw [boundary x 0 hx hxq (by omega) (by omega) (by omega)] + simp [IntegerCeilDiv] + have leftEdge (y : ℤ) (hy : 0 ≤ y) (hyq : y ≤ P.q) : + FordOdometer P ⟨0,y⟩ = 0 := by + rw [boundary 0 y (by omega) (by omega) hy hyq (by omega)] + simp [IntegerCeilDiv] + have top (x : ℤ) (hx : 0 ≤ x) (hxq : x ≤ P.q) : + FordOdometer P ⟨x,P.q⟩ = P.p*x := by + rw [boundary x P.q hx hxq (by omega) (by omega) (by omega)] + unfold IntegerCeilDiv + rw [show -(P.p*x*(P.q : ℤ)) = (-(P.p*x))*(P.q : ℤ) by ring, + Int.mul_ediv_cancel _ hn] + ring + have rightEdge (y : ℤ) (hy : 0 ≤ y) (hyq : y ≤ P.q) : + FordOdometer P ⟨P.q,y⟩ = P.p*y := by + rw [boundary P.q y (by omega) (by omega) hy hyq (by omega)] + unfold IntegerCeilDiv + rw [show -(P.p*(P.q : ℤ)*y) = (-(P.p*y))*(P.q : ℤ) by ring, + Int.mul_ediv_cancel _ hn] + ring + have positive (j : Fin 3) : + let R := P5332T1RightRows P j 0 + ∃ b : ℤ, ∀ x : GaussianInt, + x ∈ FordVertexDomain P.q → x-R.displacement ∈ FordVertexDomain P.q → + FordOdometer P (x-R.displacement) + R.linear.re*x.re + + R.linear.im*x.im - FordOdometer P x = b := by + fin_cases j + · refine ⟨-P.p₁*(P.q : ℤ), ?_⟩ + rintro ⟨x,y⟩ hx hy + change 0 ≤ x ∧ x ≤ (P.q : ℤ) ∧ 0 ≤ y ∧ y ≤ (P.q : ℤ) at hx + change 0 ≤ x-(-(P.q₁ : ℤ)) ∧ x-(-(P.q₁ : ℤ)) ≤ (P.q : ℤ) ∧ + 0 ≤ y-(P.q : ℤ) ∧ y-(P.q : ℤ) ≤ (P.q : ℤ) at hy + have he : y = (P.q : ℤ) := by omega + subst y + change FordOdometer P (⟨x,P.q⟩-⟨-(P.q₁ : ℤ),P.q⟩) + + P.p*x+(-P.p₁)*(P.q : ℤ)-FordOdometer P ⟨x,P.q⟩ = _ + rw [show (⟨x,P.q⟩-⟨-(P.q₁ : ℤ),P.q⟩ : GaussianInt) = ⟨x+P.q₁,0⟩ by ext <;> simp, + bottom _ (by omega) (by omega), top _ hx.1 hx.2.1] + ring + · refine ⟨P.p*(P.q₂ : ℤ), ?_⟩ + rintro ⟨x,y⟩ hx hy + change 0 ≤ x ∧ x ≤ (P.q : ℤ) ∧ 0 ≤ y ∧ y ≤ (P.q : ℤ) at hx + change 0 ≤ x-(-(P.q₂ : ℤ)) ∧ x-(-(P.q₂ : ℤ)) ≤ (P.q : ℤ) ∧ + 0 ≤ y-(-(P.q : ℤ)) ∧ y-(-(P.q : ℤ)) ≤ (P.q : ℤ) at hy + have he : y = 0 := by omega + subst y + change FordOdometer P (⟨x,0⟩-⟨-(P.q₂ : ℤ),-(P.q : ℤ)⟩) + + (-P.p)*x+(-P.p₂)*0-FordOdometer P ⟨x,0⟩ = _ + rw [show (⟨x,0⟩-⟨-(P.q₂ : ℤ),-(P.q : ℤ)⟩ : GaussianInt) = ⟨x+P.q₂,P.q⟩ by + ext <;> simp, + top _ (by omega) (by omega), bottom _ hx.1 hx.2.1] + ring + · refine ⟨0, ?_⟩ + rintro ⟨x,y⟩ hx hy + change 0 ≤ x ∧ x ≤ (P.q : ℤ) ∧ 0 ≤ y ∧ y ≤ (P.q : ℤ) at hx + change 0 ≤ x-(P.q : ℤ) ∧ x-(P.q : ℤ) ≤ (P.q : ℤ) ∧ + 0 ≤ y-0 ∧ y-0 ≤ (P.q : ℤ) at hy + have he : x = (P.q : ℤ) := by omega + subst x + change FordOdometer P (⟨P.q,y⟩-⟨P.q,0⟩) + + 0*(P.q : ℤ)+P.p*y-FordOdometer P ⟨P.q,y⟩ = _ + rw [show (⟨P.q,y⟩-⟨P.q,0⟩ : GaussianInt) = ⟨0,y⟩ by ext <;> simp, + leftEdge _ hx.2.2.1 hx.2.2.2, rightEdge _ hx.2.2.1 hx.2.2.2] + ring + cases e + · dsimp only [Bool.false_eq_true, ↓reduceIte] + let R := P5332T1RightRows P j 0 + obtain ⟨b,hb⟩ := positive j + change ∀ x : GaussianInt, x ∈ FordVertexDomain P.q → + x-R.displacement ∈ FordVertexDomain P.q → + FordOdometer P (x-R.displacement) + R.linear.re*x.re + + R.linear.im*x.im - FordOdometer P x = b at hb + refine ⟨R.linear.re*R.displacement.re+R.linear.im*R.displacement.im-b, ?_⟩ + intro x hx hy + have he := hb (x+R.displacement) (by simpa [R] using hy) (by simpa using hx) + simp only [add_sub_cancel_right, Zsqrtd.re_add, Zsqrtd.im_add] at he + change FordOdometer P (x-(-R.displacement)) + (-R.linear).re*x.re + + (-R.linear).im*x.im-FordOdometer P x = _ + simp only [sub_neg_eq_add, Zsqrtd.re_neg, Zsqrtd.im_neg] + linear_combination -he + · exact positive j + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5532T1FiniteOrientationGluing.lean b/LeanPool/ApollonianSuperharmonic/P5532T1FiniteOrientationGluing.lean new file mode 100644 index 0000000000..51ca8dbb97 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5532T1FiniteOrientationGluing.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ParentalOrientationGluing + +-- [TABLET NODE: P5532T1FiniteOrientationGluing] + +/-! +# P5532T1FiniteOrientationGluing + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5532T1FiniteOrientationGluing {ι : Type*} [Fintype ι] + (A : ι → Finset GaussianInt) (σ : GaussianInt → ℤ) + (o : ∀ i, AcyclicIndegreeOrientation (A i) σ) + (hcross : ∀ i j, ∀ x ∈ A i, x ∉ A j → ∀ y ∈ A j, y ∉ A i → + ¬ FourNeighborAdjacent x y) + (hclosed : ∀ i j, ∀ x ∈ A i ∩ A j, ∀ y ∈ A i, + (o i).edge y x → y ∈ A j) : + ∃ t : AcyclicIndegreeOrientation (Finset.univ.biUnion A) σ, + ∀ i, ∀ x ∈ A i, ∀ y ∈ A i, t.edge x y ↔ (o i).edge x y := by +-- BODY + classical + have run : ∀ J : Finset ι, + ∃ t : AcyclicIndegreeOrientation (J.biUnion A) σ, + ∀ i ∈ J, ∀ x ∈ A i, ∀ y ∈ A i, t.edge x y ↔ (o i).edge x y := by + intro J + induction J using Finset.induction_on with + | empty => + refine ⟨{ + edge := fun _ _ => False + edge_decidable := fun _ _ => Classical.propDecidable _ + rank := fun _ => 0 + supported := by intro x y he; cases he + oriented := by simp + increasing := by intro x y he; cases he + indegree := by simp }, by simp⟩ + | @insert i J hi ih => + obtain ⟨a, ha⟩ := ih + let U := J.biUnion A + have common : ∀ x ∈ U, ∀ y ∈ U, FourNeighborAdjacent x y → + ∃ j ∈ J, x ∈ A j ∧ y ∈ A j := by + intro x hx y hy hxy + obtain ⟨j, hj, hxj⟩ := Finset.mem_biUnion.mp hx + obtain ⟨k, hk, hyk⟩ := Finset.mem_biUnion.mp hy + by_cases hyj : y ∈ A j + · exact ⟨j, hj, hxj, hyj⟩ + by_cases hxk : x ∈ A k + · exact ⟨k, hk, hxk, hyk⟩ + exact (hcross j k x hxj hxk y hyk hyj hxy).elim + have cross : ∀ x ∈ U, x ∉ A i → ∀ y ∈ A i, y ∉ U → + ¬ FourNeighborAdjacent x y := by + intro x hx hxi y hy hyU + obtain ⟨j, hj, hxj⟩ := Finset.mem_biUnion.mp hx + exact hcross j i x hxj hxi y hy (fun hyj => + hyU (Finset.mem_biUnion.mpr ⟨j, hj, hyj⟩)) + have closedU : ∀ x ∈ U ∩ A i, ∀ y ∈ U, a.edge y x → y ∈ A i := by + intro x hx y hy he + obtain ⟨j, hj, hyj, hxj⟩ := common y hy x (Finset.mem_inter.mp hx).1 + (a.supported y x he).2.2 + exact hclosed j i x (Finset.mem_inter.mpr ⟨hxj, (Finset.mem_inter.mp hx).2⟩) + y hyj ((ha j hj y hyj x hxj).mp he) + have closedI : ∀ x ∈ U ∩ A i, ∀ y ∈ A i, (o i).edge y x → y ∈ U := by + intro x hx y hy he + obtain ⟨j, hj, hxj⟩ := Finset.mem_biUnion.mp (Finset.mem_inter.mp hx).1 + exact Finset.mem_biUnion.mpr ⟨j, hj, hclosed i j x + (Finset.mem_inter.mpr ⟨(Finset.mem_inter.mp hx).2, hxj⟩) y hy he⟩ + obtain ⟨t, htU, htI⟩ := ParentalOrientationGluing U (A i) σ a (o i) + cross closedU closedI + have hset : (insert i J).biUnion A = U ∪ A i := by + simp [U, Finset.union_comm] + rw [hset] + refine ⟨t, ?_⟩ + intro j hj x hx y hy + rcases Finset.mem_insert.mp hj with rfl | hj + · exact htI x hx y hy + · have hxU : x ∈ U := Finset.mem_biUnion.mpr ⟨j, hj, hx⟩ + have hyU : y ∈ U := Finset.mem_biUnion.mpr ⟨j, hj, hy⟩ + exact (htU x hxU y hyU).trans (ha j hj x hx y hy) + obtain ⟨t, ht⟩ := run Finset.univ + exact ⟨t, fun i => ht i (Finset.mem_univ i)⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5532T1ForestAttachment.lean b/LeanPool/ApollonianSuperharmonic/P5532T1ForestAttachment.lean new file mode 100644 index 0000000000..b4cc0309a9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5532T1ForestAttachment.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.RootedFourNeighborForest +public import LeanPool.ApollonianSuperharmonic.P4062T1RankedAttachment + +-- [TABLET NODE: P5532T1ForestAttachment] + +/-! +# P5532T1ForestAttachment + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5532T1ForestAttachment (D P R : Finset GaussianInt) + (σ : GaussianInt → ℤ) (hP : P ⊆ D) + (o : AcyclicIndegreeOrientation P σ) + (hf : RootedFourNeighborForest (D \ P) R) + (hres : ∀ x ∈ D \ P, + σ x - ((P.filter fun y => @decide (FourNeighborAdjacent y x) + (Classical.propDecidable _)).card : ℤ) = 1 - if x ∈ R then 1 else 0) : + ∃ t : AcyclicIndegreeOrientation D σ, + (∀ x ∈ P, ∀ y ∈ P, t.edge x y ↔ o.edge x y) ∧ + (∀ x ∈ P, ∀ y ∈ D \ P, FourNeighborAdjacent x y → t.edge x y) ∧ + (∀ x ∈ P, t.rank x = o.rank x) ∧ + ∀ x ∈ D \ P, P.sup o.rank < t.rank x := by +-- BODY + classical + obtain ⟨hR, parent, d, hroot, hparent, hzero, hedge⟩ := hf + have hstrict : ∀ x ∈ D \ P, ∀ y ∈ D \ P, + FourNeighborAdjacent x y → d x ≠ d y := by + intro x hx y hy ha heq + rcases hedge x hx y hy ha with hp | hp + · have hn : y ∉ R := by + intro hr + have hsame : x = y := hp.trans (hroot y hr) + rw [hsame] at ha + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] at ha + omega + have hd := (hparent y hy hn).2.2 + rw [← hp] at hd + omega + · have hn : x ∉ R := by + intro hr + have hsame : y = x := hp.trans (hroot x hr) + rw [hsame] at ha + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] at ha + omega + have hd := (hparent x hx hn).2.2 + rw [← hp] at hd + omega + have hcount : ∀ x ∈ D \ P, + (((D \ P).filter fun y => FourNeighborAdjacent y x ∧ d y < d x).card : ℤ) = + 1 - if x ∈ R then 1 else 0 := by + intro x hx + by_cases hr : x ∈ R + · have hd := (hzero x hx).mp hr + simp [hd, hr] + · have hp := hparent x hx hr + have heq : (D \ P).filter (fun y => FourNeighborAdjacent y x ∧ d y < d x) = + {parent x} := by + ext y + simp only [Finset.mem_filter, Finset.mem_singleton] + constructor + · rintro ⟨hy, ha, hd⟩ + rcases hedge y hy x hx ha with hh | hh + · exact hh + · have hyr : y ∉ R := by + intro hyr + rw [hroot y hyr] at hh + rw [hh] at hd + omega + have hh' := (hparent y hy hyr).2.2 + rw [← hh] at hh' + omega + · rintro rfl + exact ⟨hp.1, hp.2⟩ + simp [heq, hr] + have hsum : ∀ x ∈ D \ P, + ((P.filter fun y => FourNeighborAdjacent y x).card : ℤ) + + (((D \ P).filter fun y => FourNeighborAdjacent y x ∧ d y < d x).card : ℤ) = + σ x := by + intro x hx + have hr := hres x hx + simp only [decide_eq_true_eq] at hr + rw [hcount x hx] + omega + obtain ⟨t, ht, hcross, hW, hrP, hrW⟩ := + P4062T1RankedAttachment D P σ d hP o (by + intro x hx + convert hsum x hx using 1; + congr 3; ext y; simp only [Finset.mem_filter]) hstrict + refine ⟨t, ht, hcross, hrP, ?_⟩ + intro x hx + rw [hrW x hx] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5532T1OrientationPullback.lean b/LeanPool/ApollonianSuperharmonic/P5532T1OrientationPullback.lean new file mode 100644 index 0000000000..0057e1b080 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5532T1OrientationPullback.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation + +-- [TABLET NODE: P5532T1OrientationPullback] + +/-! +# P5532T1OrientationPullback + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5532T1OrientationPullback (D E : Finset GaussianInt) + (σ τ : GaussianInt → ℤ) (L : GaussianInt → GaussianInt) + (hDE : E = D.image L) (hinj : Function.Injective L) + (hadj : ∀ x y, FourNeighborAdjacent x y ↔ FourNeighborAdjacent (L x) (L y)) + (hσ : ∀ x ∈ D, τ (L x) = σ x) + (o : AcyclicIndegreeOrientation E τ) : + Nonempty (AcyclicIndegreeOrientation D σ) := by +-- BODY + classical + have hmem (x : GaussianInt) : x ∈ D ↔ L x ∈ E := by + rw [hDE] + constructor + · exact fun hx => Finset.mem_image.mpr ⟨x, hx, rfl⟩ + · intro hx + obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp hx + exact hinj heq ▸ hy + refine ⟨{ + edge := fun x y => o.edge (L x) (L y) + edge_decidable := fun x y => o.edge_decidable (L x) (L y) + rank := fun x => o.rank (L x) + supported := ?_ + oriented := ?_ + increasing := ?_ + indegree := ?_ }⟩ + · intro x y he + obtain ⟨hx, hy, ha⟩ := o.supported _ _ he + exact ⟨(hmem x).mpr hx, (hmem y).mpr hy, (hadj x y).mpr ha⟩ + · intro x hx y hy ha + exact o.oriented _ ((hmem x).mp hx) _ ((hmem y).mp hy) ((hadj x y).mp ha) + · intro x y he + exact o.increasing _ _ he + · intro x hx + have hc : + (D.filter fun y => @decide (o.edge (L y) (L x)) + (o.edge_decidable (L y) (L x))).card = + (E.filter fun y => @decide (o.edge y (L x)) + (o.edge_decidable y (L x))).card := by + apply Finset.card_bij (fun y _ => L y) + · intro y hy + exact Finset.mem_filter.mpr ⟨(hmem y).mp (Finset.mem_filter.mp hy).1, + (Finset.mem_filter.mp hy).2⟩ + · intro y hy z hz heq + exact hinj heq + · intro z hz + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp (hDE ▸ (Finset.mem_filter.mp hz).1) + exact ⟨y, Finset.mem_filter.mpr ⟨hy, (Finset.mem_filter.mp hz).2⟩, rfl⟩ + rw [hc, ← hσ x hx] + exact o.indegree (L x) ((hmem x).mp hx) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5532T1OverlapNoEntry.lean b/LeanPool/ApollonianSuperharmonic/P5532T1OverlapNoEntry.lean new file mode 100644 index 0000000000..10e91dd68b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5532T1OverlapNoEntry.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation +public import Mathlib.Algebra.BigOperators.Group.Finset.Basic + +-- [TABLET NODE: P5532T1OverlapNoEntry] + +/-! +# P5532T1OverlapNoEntry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5532T1OverlapNoEntry (D I : Finset GaussianInt) + (σ : GaussianInt → ℤ) (hI : I ⊆ D) + (o : AcyclicIndegreeOrientation D σ) + (hmass : (∑ x ∈ I, σ x) = + ((((I.product I).filter fun e => @decide (FourNeighborAdjacent e.1 e.2) + (Classical.propDecidable _)).card / 2 : ℕ) : ℤ)) : + ∀ x ∈ I, ∀ y ∈ D, o.edge y x → y ∈ I := by +-- BODY + classical + have symm (x y : GaussianInt) (h : FourNeighborAdjacent x y) : + FourNeighborAdjacent y x := by + rcases h with h | h | h | h <;> subst y <;> simp [FourNeighborAdjacent] + let B := (D.product I).filter (fun e => o.edge e.1 e.2) + let K := (I.product I).filter (fun e => o.edge e.1 e.2) + let K' := (I.product I).filter (fun e => o.edge e.2 e.1) + let A := (I.product I).filter (fun e => FourNeighborAdjacent e.1 e.2) + have hswap : K.card = K'.card := by + apply Finset.card_bij (fun e _ => e.swap) + · intro e he + simpa only [K, K', Finset.mem_filter, Finset.product_eq_sprod, Finset.mem_product, + Prod.fst_swap, Prod.snd_swap, and_comm] using he + · intro e he f hf h + exact Prod.swap_injective h + · intro e he + refine ⟨e.swap, ?_, by simp⟩ + simpa only [K, K', Finset.mem_filter, Finset.product_eq_sprod, Finset.mem_product, + Prod.fst_swap, Prod.snd_swap, and_comm] using he + have hdis : Disjoint K K' := by + apply Finset.disjoint_left.mpr + intro e he hf + exact Nat.lt_asymm (o.increasing _ _ (Finset.mem_filter.mp he).2) + (o.increasing _ _ (Finset.mem_filter.mp hf).2) + have hun : K ∪ K' = A := by + ext e + simp only [K, K', A, Finset.mem_union, Finset.mem_filter] + constructor + · rintro (⟨he, h⟩ | ⟨he, h⟩) + · exact ⟨he, (o.supported _ _ h).2.2⟩ + · exact ⟨he, symm _ _ (o.supported _ _ h).2.2⟩ + · rintro ⟨he, ha⟩ + have hp := Finset.mem_product.mp he + rcases o.oriented _ (hI hp.1) _ (hI hp.2) ha with h | h + · exact Or.inl ⟨he, h.1⟩ + · exact Or.inr ⟨he, h.1⟩ + have hhalf : A.card / 2 = K.card := by + have hc := Finset.card_union_of_disjoint hdis + rw [hun, ← hswap] at hc + omega + have hsum : (B.card : ℤ) = ∑ x ∈ I, σ x := by + have totals : B.card = ∑ x ∈ I, (D.filter fun y => o.edge y x).card := by + dsimp [B] + simp_rw [Finset.card_eq_sum_ones, Finset.sum_filter] + rw [Finset.sum_product, Finset.sum_comm] + rw [totals, Nat.cast_sum] + apply Finset.sum_congr rfl + intro x hx + simpa only [decide_eq_true_eq] using o.indegree x (hI hx) + have hBK : B.card = K.card := by + have hm : (∑ x ∈ I, σ x) = (A.card / 2 : ℕ) := by + simpa only [A, decide_eq_true_eq] using hmass + rw [hm, hhalf] at hsum + exact_mod_cast hsum + have hsub : K ⊆ B := by + intro e he + obtain ⟨hp, hh⟩ := Finset.mem_filter.mp he + have hpi := Finset.mem_product.mp hp + exact Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨hI hpi.1, hpi.2⟩, hh⟩ + have heq : K = B := Finset.eq_of_subset_of_card_le hsub (by omega) + intro x hx y hy he + have hm : (y, x) ∈ B := + Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨hy, hx⟩, he⟩ + rw [← heq] at hm + exact (Finset.mem_product.mp (Finset.mem_filter.mp hm).1).1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5532T1ParentInteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5532T1ParentInteriorGeometry.lean new file mode 100644 index 0000000000..6d0c454322 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5532T1ParentInteriorGeometry.lean @@ -0,0 +1,197 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior +public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells + +-- [TABLET NODE: P5532T1ParentInteriorGeometry] + +/-! +# P5532T1ParentInteriorGeometry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5532T1ParentInteriorGeometry : + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : + BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : + BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (h : PartialOdometer), ∀ (hs : Fin 3 → + Bool → PartialOdometer), ∀ (k : PartialOdometer), (LatticeTile T) → (((h.domain : Set + GaussianInt) = FootprintVertices T) → ((∀ i, ∀ s, ((hs i s).domain : Set GaussianInt) = + FootprintVertices (cert.P i s)) → (((k.domain : Set GaussianInt) = FootprintVertices + cert.O) → ( + let D := h.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _) + let A := fun a : Fin 3 × Bool => (hs a.1 a.2).domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices (cert.P a.1 a.2)) (Classical.propDecidable _) + let I := k.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices cert.O) (Classical.propDecidable _) + (∀ a, A a ⊆ D) ∧ + (∀ a, ∀ b, a ≠ b → A a ∩ A b = if a.1 = 0 ∧ b.1 = 0 then I else ∅) ∧ + (∀ a, ∀ b, ∀ x ∈ A a, x ∉ A b → ∀ y ∈ A b, y ∉ A a → + ¬ FourNeighborAdjacent x y) ∧ + Finset.univ.biUnion A = D.filter (fun x => + @decide (∃ i s, x ∈ (hs i s).domain ∧ + x ∉ BoundaryFootprintVertices (cert.P i s)) (Classical.propDecidable _)))))) := by + intro C q cfg T cert h hs k hlat hdom hsdom hkdom +-- BODY + classical + let D := h.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _) + let A := fun a : Fin 3 × Bool => (hs a.1 a.2).domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices (cert.P a.1 a.2)) (Classical.propDecidable _) + let I := k.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices cert.O) (Classical.propDecidable _) + have full (V : ProtoTile) (x : GaussianInt) : + (x ∈ FootprintVertices V ∧ x ∉ BoundaryFootprintVertices V) ↔ + ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ V.cells := by + by_cases hne : V.cells.Nonempty + · constructor + · rintro ⟨hx, hnb⟩ + exact (P4456T2VertexInterior V hne x hx).2.mp hnb + · intro hall + have hxcell : x ∈ V.cells := by simpa [LatticeVertexIncidentCell] using hall 0 + have hx : x ∈ FootprintVertices V := by + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] + exact ⟨x, hxcell, Or.inl rfl⟩ + exact ⟨hx, (P4456T2VertexInterior V hne x hx).2.mpr hall⟩ + · have hempty : V.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hne + simp only [FootprintVertices, BoundaryFootprintVertices, + hempty, Finset.notMem_empty] + simp + have domainFull (V : ProtoTile) (l : PartialOdometer) + (hd : (l.domain : Set GaussianInt) = FootprintVertices V) (x : GaussianInt) : + x ∈ l.domain.filter (fun x => @decide (x ∉ BoundaryFootprintVertices V) + (Classical.propDecidable _)) ↔ + ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ V.cells := by + simp only [Finset.mem_filter, decide_eq_true_eq] + have hmem : x ∈ l.domain ↔ x ∈ FootprintVertices V := by + change x ∈ (l.domain : Set GaussianInt) ↔ _ + rw [hd] + rw [hmem] + exact full V x + have hD (x : GaussianInt) : x ∈ D ↔ + ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells := domainFull T h hdom x + have hA (a : Fin 3 × Bool) (x : GaussianInt) : x ∈ A a ↔ + ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P a.1 a.2).cells := + domainFull _ _ (hsdom a.1 a.2) x + have hI (x : GaussianInt) : x ∈ I ↔ + ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ cert.O.cells := + domainFull _ _ hkdom x + obtain ⟨_, _, hOband, hOdisk, _, _, hpairCells, hdis⟩ := + P4339T1PrecursorSupportGeometry C q cfg T cert + have cellsPair (a b : Fin 3 × Bool) (hab : a ≠ b) + (hz : a.1 = 0 ∧ b.1 = 0) : + (cert.P a.1 a.2).cells ∩ (cert.P b.1 b.2).cells = cert.O.cells := by + rcases a with ⟨a, s⟩ + rcases b with ⟨b, t⟩ + obtain ⟨rfl, rfl⟩ := hz + cases s <;> cases t + · exact (hab rfl).elim + · simpa only [Finset.inter_comm] using hpairCells + · exact hpairCells + · exact (hab rfl).elim + have contained : ∀ a, A a ⊆ D := by + intro a x hx + apply (hD x).mpr + intro j + exact (cert.outer_union _).mpr ⟨a.1, a.2, (hA a x).mp hx j⟩ + have pair : ∀ a b, a ≠ b → A a ∩ A b = if a.1 = 0 ∧ b.1 = 0 then I else ∅ := by + intro a b hab + by_cases hz : a.1 = 0 ∧ b.1 = 0 + · rw [ite_eq_left hz] + have hc := cellsPair a b hab hz + ext x + simp only [Finset.mem_inter, hA, hI] + constructor + · rintro ⟨ha, hb⟩ j + rw [← hc] + exact Finset.mem_inter.mpr ⟨ha j, hb j⟩ + · intro hall + constructor <;> intro j + · exact (Finset.mem_inter.mp (hc ▸ hall j)).1 + · exact (Finset.mem_inter.mp (hc ▸ hall j)).2 + · rw [ite_eq_right hz] + have hd := hdis a.1 a.2 b.1 b.2 hab hz + apply Finset.eq_empty_iff_forall_notMem.mpr + intro x hx + obtain ⟨ha, hb⟩ := Finset.mem_inter.mp hx + exact Finset.disjoint_left.mp hd ((hA a x).mp ha 0) ((hA b x).mp hb 0) + have cross : ∀ a b, ∀ x ∈ A a, x ∉ A b → ∀ y ∈ A b, y ∉ A a → + ¬ FourNeighborAdjacent x y := by + intro a b x hx hxnot y hy hynot hxy + have hab : a ≠ b := by rintro rfl; exact hxnot hx + obtain ⟨z, w, hform⟩ := P4397T1UnitEdgeCells.1 x y hxy + have fa := P4397T1UnitEdgeCells.2 x y z w hform (cert.P a.1 a.2) + have fb := P4397T1UnitEdgeCells.2 y x z w (by + rcases hform with ⟨hh, heq⟩ | ⟨hh, heq⟩ + · exact Or.inl ⟨hh.elim Or.inr Or.inl, heq⟩ + · exact Or.inr ⟨hh.elim Or.inr Or.inl, heq⟩) (cert.P b.1 b.2) + have za := fa.2.2.2.2 ((hA a x).mp hx) + have zb := fb.2.2.2.2 ((hA b y).mp hy) + by_cases hz : a.1 = 0 ∧ b.1 = 0 + · have hc := cellsPair a b hab hz + have zO : z ∈ cert.O.cells := by + rw [← hc] + exact Finset.mem_inter.mpr ⟨za.1, zb.1⟩ + have wO : w ∈ cert.O.cells := by + rw [← hc] + exact Finset.mem_inter.mpr ⟨za.2, zb.2⟩ + have hOne : cert.O.cells.Nonempty := ⟨z, zO⟩ + have hlatO : LatticeTile cert.O := hOdisk hOne + have fo := P4397T1UnitEdgeCells.2 x y z w hform cert.O + have hfootO := fo.2.2.1 (Or.inl zO) + have hxb : x ∈ BoundaryFootprintVertices cert.O := by + by_contra hn + have hxI := (hI x).mpr ((full cert.O x).mp ⟨hfootO.1, hn⟩) + have hxpair : x ∈ A a ∩ A b := by rw [pair a b hab, ite_eq_left hz]; exact hxI + exact hxnot (Finset.mem_inter.mp hxpair).2 + have hyb : y ∈ BoundaryFootprintVertices cert.O := by + by_contra hn + have hyI := (hI y).mpr ((full cert.O y).mp ⟨hfootO.2.1, hn⟩) + have hypair : y ∈ A a ∩ A b := by rw [pair a b hab, ite_eq_left hz]; exact hyI + exact hynot (Finset.mem_inter.mp hypair).1 + have hposO : 0 < (cfg.firstPredecessor 1).1 := by + have positive (c : CircleCoordinates) (V : ProtoTile) + (hb : BandPrototile c V) (hne : V.cells.Nonempty) : 0 < c.1 := by + cases hb with + | line w x hw => simp at hne + | unit z x anchor => norm_num + | decompose hp hS hc hf hce => + exact (ProperBandCurvatureStructure _ hp).1 + exact positive _ _ hOband hOne + let CO : BandCircle := + ⟨⟨cfg.firstPredecessor 1, Or.inl hposO, + cfg.firstPredecessor, cfg.firstProper.1, 1, rfl⟩, hposO⟩ + exact (LatticeEdgeRegularity CO cert.O hOband hlatO).1 x y hxy hxb hyb + (fo.2.2.2.1 ⟨zO, wO⟩) + · exact Finset.disjoint_left.mp (hdis a.1 a.2 b.1 b.2 hab hz) za.1 zb.1 + refine ⟨contained, pair, cross, ?_⟩ + ext x + simp only [Finset.mem_biUnion, Finset.mem_univ, true_and, + Finset.mem_filter, decide_eq_true_eq] + constructor + · rintro ⟨a, hx⟩ + have hxA : x ∈ A a := by + simpa only [A, Finset.mem_filter, decide_eq_true_eq] using hx + refine ⟨?_, a.1, a.2, ?_⟩ + · simpa only [D, Finset.mem_filter, decide_eq_true_eq] using contained a hxA + · exact hx + · rintro ⟨hx, i, s, his⟩ + exact ⟨(i, s), his⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5532T1RestrictionMassBalance.lean b/LeanPool/ApollonianSuperharmonic/P5532T1RestrictionMassBalance.lean new file mode 100644 index 0000000000..4d882357dc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5532T1RestrictionMassBalance.lean @@ -0,0 +1,121 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandCanonicalPeriodicExtension +public import LeanPool.ApollonianSuperharmonic.PeriodicTileTotalIndegree +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain + +-- [TABLET NODE: P5532T1RestrictionMassBalance] + +/-! +# P5532T1RestrictionMassBalance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5532T1RestrictionMassBalance + (c : CircleCoordinates) (U : ProtoTile) (k : PartialOdometer) + (g : IntegerLatticeFunction) (ho : TileOdometer c U k) + (hdom : (k.domain : Set GaussianInt) = FootprintVertices U) + (hext : GlobalOdometerExtends g k) : + let I := k.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices U) (Classical.propDecidable _) + (∑ x ∈ I, (2 + FourNeighborLaplacian g x)) = + ((((I.product I).filter fun e => @decide (FourNeighborAdjacent e.1 e.2) + (Classical.propDecidable _)).card / 2 : ℕ) : ℤ) := by +-- BODY + classical + cases ho with + | line w x hw k hk => + have hempty : (k.domain.filter fun y => + @decide (y ∉ BoundaryFootprintVertices (⟨∅, x⟩ : ProtoTile)) + (Classical.propDecidable _)) = ∅ := by + ext y + simp [hk, BoundaryFootprintVertices] + dsimp only + rw [hempty] + simp [Finset.product_eq_sprod] + | unit z x U k hcell hdomain htrans => + have hne : U.cells.Nonempty := by rw [hcell]; simp + have bottom : {x, x + 1} ∈ BoundaryFootprintEdges U := by + refine ⟨x, Or.inl ⟨rfl, Or.inl ⟨?_, ?_⟩⟩⟩ + · simp [hcell] + · simp only [hcell, Finset.mem_singleton] + intro hh + have hh' := congrArg Zsqrtd.im hh + simp at hh' + have left : {x, x + ⟨0, 1⟩} ∈ BoundaryFootprintEdges U := by + refine ⟨x, Or.inr ⟨rfl, Or.inl ⟨?_, ?_⟩⟩⟩ + · simp [hcell] + · simp only [hcell, Finset.mem_singleton] + intro hh + have hh' := congrArg Zsqrtd.re hh + simp at hh' + have right : {x + 1, x + 1 + ⟨0, 1⟩} ∈ BoundaryFootprintEdges U := by + refine ⟨x + 1, Or.inr ⟨rfl, Or.inr ⟨?_, ?_⟩⟩⟩ + · simp only [hcell, Finset.mem_singleton] + intro hh + have hh' := congrArg Zsqrtd.re hh + simp at hh' + · simp [hcell] + have hb0 : x ∈ BoundaryFootprintVertices U := by + rw [BoundaryFootprintVertices, ite_eq_left hne] + exact ⟨{x, x + 1}, bottom, by simp⟩ + have hb1 : x + 1 ∈ BoundaryFootprintVertices U := by + rw [BoundaryFootprintVertices, ite_eq_left hne] + exact ⟨{x, x + 1}, bottom, by simp⟩ + have hbi : x + ⟨0, 1⟩ ∈ BoundaryFootprintVertices U := by + rw [BoundaryFootprintVertices, ite_eq_left hne] + exact ⟨{x, x + ⟨0, 1⟩}, left, by simp⟩ + have hb1i : x + 1 + ⟨0, 1⟩ ∈ BoundaryFootprintVertices U := by + rw [BoundaryFootprintVertices, ite_eq_left hne] + exact ⟨{x + 1, x + 1 + ⟨0, 1⟩}, right, by simp⟩ + have hempty : (k.domain.filter fun y => + @decide (y ∉ BoundaryFootprintVertices U) (Classical.propDecidable _)) = ∅ := by + ext y + simp only [Finset.mem_filter, decide_eq_true_eq, Finset.notMem_empty, iff_false] + rintro ⟨hy, hnb⟩ + have hyfoot : y ∈ FootprintVertices U := by rw [← hdom]; exact hy + simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hyfoot + obtain ⟨a, ha, hv⟩ := hyfoot + have hax : a = x := by simpa [hcell] using ha + subst a + rcases hv with hv | hv | hv | hv + · rw [hv] at hnb; exact hnb hb0 + · rw [hv] at hnb; exact hnb hb1 + · rw [hv] at hnb; exact hnb hbi + · rw [hv] at hnb; exact hnb hb1i + dsimp only + rw [hempty] + simp [Finset.product_eq_sprod] + | @decompose p hp S U hs k hU hsub hcells hfoot hcentroid hdomain + hvalue hcompat hslope => + have hk : TileOdometer (p 0) U k := TileOdometer.decompose hp hU hsub + hcells hfoot hcentroid hdomain hvalue hcompat hslope + have hpos : 0 < (p 0).1 := (ProperBandCurvatureStructure p hp).1 + let C : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ + obtain ⟨G, hG, hlat, htile, hweb, hperiod, hlap⟩ := + BandCanonicalPeriodicExtension C p hp rfl U k g hU hk hdom hext + have hm := PeriodicTileTotalIndegree C U k G hdom hU hlat htile hweb hperiod + dsimp only at hm ⊢ + rw [← hm] + apply Finset.sum_congr rfl + intro x hx + have hx' := Finset.mem_filter.mp hx + have hnb : x ∉ BoundaryFootprintVertices U := + @of_decide_eq_true _ (Classical.propDecidable _) hx'.2 + rw [hlap x hx'.1 hnb] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5532T1SymmetryOrientationTransport.lean b/LeanPool/ApollonianSuperharmonic/P5532T1SymmetryOrientationTransport.lean new file mode 100644 index 0000000000..a7f4cb804b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5532T1SymmetryOrientationTransport.lean @@ -0,0 +1,171 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5532T1OrientationPullback +public import LeanPool.ApollonianSuperharmonic.P5686T1UniformGlobalOdometerTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas + +-- [TABLET NODE: P5532T1SymmetryOrientationTransport] + +/-! +# P5532T1SymmetryOrientationTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5532T1SymmetryOrientationTransport + (s : BandPackingSymmetry) (c : CircleCoordinates) (T : ProtoTile) + (h : PartialOdometer) (g : IntegerLatticeFunction) + (ho : TileOdometer c T h) (hext : GlobalOdometerExtends g h) : + ∃ g' : IntegerLatticeFunction, + GlobalOdometerExtends g' (BandPackingSymmetryPartialOdometerAction s h) ∧ + let D := h.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _) + let E := (BandPackingSymmetryPartialOdometerAction s h).domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices (BandPackingSymmetryTileAction s T)) + (Classical.propDecidable _) + (Nonempty (AcyclicIndegreeOrientation D (fun x => 2 + FourNeighborLaplacian g x)) ↔ + Nonempty (AcyclicIndegreeOrientation E (fun x => 2 + FourNeighborLaplacian g' x))) := by +-- BODY + classical + obtain ⟨g', he', hlap⟩ := + P5686T1UniformGlobalOdometerTransport s g h hext + have grid : ∀ a : BandPackingSymmetry, + Function.Bijective (BandPackingSymmetryVectorAction a) ∧ + (∀ x y, FourNeighborAdjacent x y ↔ + FourNeighborAdjacent (BandPackingSymmetryVectorAction a x) + (BandPackingSymmetryVectorAction a y)) ∧ + ∀ V, BoundaryFootprintVertices (BandPackingSymmetryTileAction a V) = + BandPackingSymmetryVectorAction a '' BoundaryFootprintVertices V := by + intro a + induction a with + | identity => + refine ⟨Function.bijective_id, fun _ _ => Iff.rfl, ?_⟩ + intro V + simp [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + | shift w => + refine ⟨Function.bijective_id, fun _ _ => Iff.rfl, ?_⟩ + intro V + simp [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] + | negate => + have inv (x : GaussianInt) : GaussianQuarterTurn (-GaussianQuarterTurn x) = x := by + ext <;> simp [GaussianQuarterTurn] + have inv' (x : GaussianInt) : -GaussianQuarterTurn (GaussianQuarterTurn x) = x := by + ext <;> simp [GaussianQuarterTurn] + refine ⟨⟨?_, fun x => ⟨-GaussianQuarterTurn x, inv x⟩⟩, ?_, ?_⟩ + · intro x y hxy + simpa only [BandPackingSymmetryVectorAction, inv'] using + congrArg (fun z => -GaussianQuarterTurn z) hxy + · intro x y + simp [BandPackingSymmetryVectorAction, FourNeighborAdjacent, + GaussianQuarterTurn, Zsqrtd.ext_iff] + omega + · intro V + exact (TileQuarterTurnFormulas V).2.2.2.2.2.2.2.1 + | conjugate => + have inv (x : GaussianInt) : -GaussianReflection (-GaussianReflection x) = x := by + ext <;> simp [GaussianReflection] + refine ⟨⟨?_, fun x => ⟨-GaussianReflection x, inv x⟩⟩, ?_, ?_⟩ + · intro x y hxy + simpa only [BandPackingSymmetryVectorAction, inv] using + congrArg (fun z => -GaussianReflection z) hxy + · intro x y + simp [BandPackingSymmetryVectorAction, FourNeighborAdjacent, + GaussianReflection, Zsqrtd.ext_iff] + omega + · intro V + rw [BandPackingSymmetryTileAction, + (TileQuarterTurnFormulas _).2.2.2.2.2.2.2.1, + (TileQuarterTurnFormulas _).2.2.2.2.2.2.2.1, + (TileReflectionFormulas _).2.2.2.2.2.2.2.1] + simp only [Set.image_image] + congr 1 + | comp a b iha ihb => + refine ⟨iha.1.comp ihb.1, ?_, ?_⟩ + · intro x y + exact (ihb.2.1 x y).trans (iha.2.1 _ _) + · intro V + simp only [BandPackingSymmetryTileAction, iha.2.2, ihb.2.2, + BandPackingSymmetryVectorAction, Set.image_image] + let L := BandPackingSymmetryVectorAction s + let D := h.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _) + let E := (BandPackingSymmetryPartialOdometerAction s h).domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices (BandPackingSymmetryTileAction s T)) + (Classical.propDecidable _) + have hdomain := (BandPackingSymmetryTileOdometerCovariance s c T h ho).2.1 + have hboundary := (grid s).2.2 T + have hE : E = D.image L := by + ext y + simp only [E, D, Finset.mem_filter, decide_eq_true_eq, Finset.mem_image] + constructor + · rintro ⟨hy, hnb⟩ + have hy' : y ∈ BandPackingSymmetryVectorAction s '' (h.domain : Set GaussianInt) := by + rw [← hdomain] + exact hy + obtain ⟨x, hx, rfl⟩ := hy' + refine ⟨x, ⟨hx, ?_⟩, rfl⟩ + intro hb + apply hnb + rw [hboundary] + exact Set.mem_image_of_mem L hb + · rintro ⟨x, ⟨hx, hnb⟩, rfl⟩ + refine ⟨?_, ?_⟩ + · change L x ∈ ((BandPackingSymmetryPartialOdometerAction s h).domain : Set GaussianInt) + rw [hdomain] + exact ⟨x, hx, rfl⟩ + · intro hb + rw [hboundary] at hb + obtain ⟨y, hy, hyx⟩ := hb + exact hnb ((grid s).1.1 hyx ▸ hy) + let e : GaussianInt ≃ GaussianInt := Equiv.ofBijective L (grid s).1 + have heL : ∀ x, e x = L x := fun _ => rfl + have hD : D = E.image e.symm := by + rw [hE, Finset.image_image] + have hf : e.symm ∘ L = id := by + funext x + exact e.symm_apply_apply x + rw [hf] + simp + refine ⟨g', he', ?_⟩ + change Nonempty (AcyclicIndegreeOrientation D (fun x => 2 + FourNeighborLaplacian g x)) ↔ + Nonempty (AcyclicIndegreeOrientation E (fun x => 2 + FourNeighborLaplacian g' x)) + constructor + · rintro ⟨o⟩ + apply P5532T1OrientationPullback E D + (fun x => 2 + FourNeighborLaplacian g' x) + (fun x => 2 + FourNeighborLaplacian g x) e.symm hD e.symm.injective + (fun x y => ?_) (fun x hx => ?_) o + · have ha := (grid s).2.1 (e.symm x) (e.symm y) + change FourNeighborAdjacent (e.symm x) (e.symm y) ↔ + FourNeighborAdjacent (e (e.symm x)) (e (e.symm y)) at ha + simpa only [e.apply_symm_apply] using ha.symm + · have hl := hlap (e.symm x) + change FourNeighborLaplacian g' (e (e.symm x)) = + FourNeighborLaplacian g (e.symm x) at hl + rw [e.apply_symm_apply] at hl + rw [hl] + · rintro ⟨o⟩ + exact P5532T1OrientationPullback D E + (fun x => 2 + FourNeighborLaplacian g x) + (fun x => 2 + FourNeighborLaplacian g' x) L hE (grid s).1.1 (grid s).2.1 + (fun x hx => by rw [hlap x]) o + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5537T1PredecessorCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P5537T1PredecessorCoordinates.lean new file mode 100644 index 0000000000..61f133e867 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5537T1PredecessorCoordinates.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows + +-- [TABLET NODE: P5537T1PredecessorCoordinates] + +/-! +# P5537T1PredecessorCoordinates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5537T1PredecessorCoordinates (K : DiamondParameter) + (hk : 1 < K.1) (x : GaussianInt) : + let n : Int := K.1 + ((x ∈ FootprintVertices (DiamondTile K.1) ∧ + x-⟨n,1-n⟩ ∈ FootprintVertices (DiamondTile (K.1-1))) ↔ + 1 ≤ x.re ∧ x.re ≤ n ∧ 0 ≤ x.im ∧ x.im ≤ n-1 ∧ + x.re-1 ≤ x.im ∧ x.im ≤ x.re) ∧ + ((x ∈ FootprintVertices (DiamondTile K.1) ∧ + x-⟨n,n+1⟩ ∈ FootprintVertices (DiamondTile (K.1-1))) ↔ + 1 ≤ x.re ∧ x.re ≤ n ∧ n+1 ≤ x.im ∧ x.im ≤ 2*n ∧ + 2*n ≤ x.re+x.im ∧ x.re+x.im ≤ 2*n+1) ∧ + ((x ∈ FootprintVertices (DiamondTile K.1) ∧ + x-⟨-n,n+1⟩ ∈ FootprintVertices (DiamondTile (K.1-1))) ↔ + -n ≤ x.re ∧ x.re ≤ -1 ∧ n+1 ≤ x.im ∧ x.im ≤ 2*n ∧ + 2*n ≤ x.im-x.re ∧ x.im-x.re ≤ 2*n+1) ∧ + ((x ∈ FootprintVertices (DiamondTile K.1) ∧ + x-⟨-n,1-n⟩ ∈ FootprintVertices (DiamondTile (K.1-1))) ↔ + -n ≤ x.re ∧ x.re ≤ -1 ∧ 0 ≤ x.im ∧ x.im ≤ n-1 ∧ + -1 ≤ x.re+x.im ∧ x.re+x.im ≤ 0) := by +-- BODY + have hc := (P5352T2DomainRows K x).1 + have hp (a b : Int) := + (P5352T2DomainRows ⟨K.1-1, by omega⟩ (x-⟨a,b⟩)).1 + simp only [Nat.cast_sub (by omega : 1 ≤ K.1), Nat.cast_one, + Zsqrtd.re_sub, Zsqrtd.im_sub] at hp + dsimp only + refine ⟨?_, ?_, ?_, ?_⟩ + all_goals + rw [hc, hp] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5537T1PredecessorValues.lean b/LeanPool/ApollonianSuperharmonic/P5537T1PredecessorValues.lean new file mode 100644 index 0000000000..d3cb870628 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5537T1PredecessorValues.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5537T1ScaledDiamondFormula + +-- [TABLET NODE: P5537T1PredecessorValues] + +/-! +# P5537T1PredecessorValues + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5537T1PredecessorValues (k X Y : Int) (_hk : 2 ≤ k) : + ((1 ≤ X ∧ X ≤ k ∧ 0 ≤ Y ∧ Y ≤ k-1 ∧ X-1 ≤ Y ∧ Y ≤ X) → + P4207T1DiamondFormula ⟨X-k,Y-(1-k)⟩ + (k-1)*Y - + P4207T1DiamondFormula ⟨X,Y⟩ = -(k*(k-1)/2)) ∧ + ((1 ≤ X ∧ X ≤ k ∧ k+1 ≤ Y ∧ Y ≤ 2*k ∧ 2*k ≤ X+Y ∧ X+Y ≤ 2*k+1) → + P4207T1DiamondFormula ⟨X-k,Y-(k+1)⟩ + k*X - + P4207T1DiamondFormula ⟨X,Y⟩ = k*(k+1)/2) ∧ + ((-k ≤ X ∧ X ≤ -1 ∧ k+1 ≤ Y ∧ Y ≤ 2*k ∧ 2*k ≤ Y-X ∧ Y-X ≤ 2*k+1) → + P4207T1DiamondFormula ⟨X+k,Y-(k+1)⟩ + X-k*Y - + P4207T1DiamondFormula ⟨X,Y⟩ = -(k*(k+1)/2)) ∧ + ((-k ≤ X ∧ X ≤ -1 ∧ 0 ≤ Y ∧ Y ≤ k-1 ∧ -1 ≤ X+Y ∧ X+Y ≤ 0) → + P4207T1DiamondFormula ⟨X+k,Y-(1-k)⟩ + (1-k)*X-Y - + P4207T1DiamondFormula ⟨X,Y⟩ = k*(k-1)/2) := by +-- BODY + have hs := P5537T1ScaledDiamondFormula.1 X Y + have ht := P5537T1ScaledDiamondFormula.2 k + have htp := P5537T1ScaledDiamondFormula.2 (k+1) + rw [show k+1-1 = k by ring] at htp + have htp' : 2*(k*(k+1)/2) = k*(k+1) := by + simpa only [mul_comm] using htp + refine ⟨?_, ?_, ?_, ?_⟩ + · intro h + have hp := P5537T1ScaledDiamondFormula.1 (X-k) (Y-(1-k)) + rw [abs_of_nonneg (by omega : 0 ≤ X)] at hs + rw [abs_of_nonpos (by omega : X-k ≤ 0)] at hp + have hd : Y = X-1 ∨ Y = X := by omega + rcases hd with hd | hd + · have hm : (X-Y)%2 = 1 ∧ (X-k-(Y-(1-k)))%2 = 0 := by omega + rw [hm.1] at hs + rw [hm.2] at hp + rw [hd] at hs hp ⊢ + nlinarith only [hs, hp, ht] + · have hm : (X-Y)%2 = 0 ∧ (X-k-(Y-(1-k)))%2 = 1 := by omega + rw [hm.1] at hs + rw [hm.2] at hp + rw [hd] at hs hp ⊢ + nlinarith only [hs, hp, ht] + · intro h + have hp := P5537T1ScaledDiamondFormula.1 (X-k) (Y-(k+1)) + rw [abs_of_nonneg (by omega : 0 ≤ X)] at hs + rw [abs_of_nonpos (by omega : X-k ≤ 0)] at hp + have hd : Y = 2*k-X ∨ Y = 2*k+1-X := by omega + rcases hd with hd | hd + · have hm : (X-Y)%2 = 0 ∧ (X-k-(Y-(k+1)))%2 = 1 := by omega + rw [hm.1] at hs + rw [hm.2] at hp + rw [hd] at hs hp ⊢ + nlinarith only [hs, hp, htp'] + · have hm : (X-Y)%2 = 1 ∧ (X-k-(Y-(k+1)))%2 = 0 := by omega + rw [hm.1] at hs + rw [hm.2] at hp + rw [hd] at hs hp ⊢ + nlinarith only [hs, hp, htp'] + · intro h + have hp := P5537T1ScaledDiamondFormula.1 (X+k) (Y-(k+1)) + rw [abs_of_nonpos (by omega : X ≤ 0)] at hs + rw [abs_of_nonneg (by omega : 0 ≤ X+k)] at hp + have hd : Y = 2*k+X ∨ Y = 2*k+1+X := by omega + rcases hd with hd | hd + · have hm : (X-Y)%2 = 0 ∧ (X+k-(Y-(k+1)))%2 = 1 := by omega + rw [hm.1] at hs + rw [hm.2] at hp + rw [hd] at hs hp ⊢ + nlinarith only [hs, hp, htp'] + · have hm : (X-Y)%2 = 1 ∧ (X+k-(Y-(k+1)))%2 = 0 := by omega + rw [hm.1] at hs + rw [hm.2] at hp + rw [hd] at hs hp ⊢ + nlinarith only [hs, hp, htp'] + · intro h + have hp := P5537T1ScaledDiamondFormula.1 (X+k) (Y-(1-k)) + rw [abs_of_nonpos (by omega : X ≤ 0)] at hs + rw [abs_of_nonneg (by omega : 0 ≤ X+k)] at hp + have hd : Y = -X-1 ∨ Y = -X := by omega + rcases hd with hd | hd + · have hm : (X-Y)%2 = 1 ∧ (X+k-(Y-(1-k)))%2 = 0 := by omega + rw [hm.1] at hs + rw [hm.2] at hp + rw [hd] at hs hp ⊢ + nlinarith only [hs, hp, ht] + · have hm : (X-Y)%2 = 0 ∧ (X+k-(Y-(1-k)))%2 = 1 := by omega + rw [hm.1] at hs + rw [hm.2] at hp + rw [hd] at hs hp ⊢ + nlinarith only [hs, hp, ht] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5537T1ScaledDiamondFormula.lean b/LeanPool/ApollonianSuperharmonic/P5537T1ScaledDiamondFormula.lean new file mode 100644 index 0000000000..f6a5cc441e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5537T1ScaledDiamondFormula.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic + +-- [TABLET NODE: P5537T1ScaledDiamondFormula] + +/-! +# P5537T1ScaledDiamondFormula + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5537T1ScaledDiamondFormula : + (∀ a b : Int, 4 * P4207T1DiamondFormula ⟨a,b⟩ = + 2*a^2 - 2*|a| - (a-b)^2 + (a-b)%2) ∧ + (∀ n : Int, 2*(n*(n-1)/2) = n*(n-1)) := by +-- BODY + have tri (n : Int) : 2*(n*(n-1)/2) = n*(n-1) := by + rcases Int.emod_two_eq_zero_or_one n with h | h + · have hn : n = 2*(n/2) := by omega + rw [hn, show 2*(n/2)*(2*(n/2)-1) = + 2*((n/2)*(2*(n/2)-1)) by ring, + Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + · have hn : n = 2*(n/2)+1 := by omega + rw [hn, show (2*(n/2)+1)*(2*(n/2)+1-1) = + 2*((2*(n/2)+1)*(n/2)) by ring, + Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + have square (n : Int) : 4*(n^2/4) = n^2-n%2 := by + rcases Int.emod_two_eq_zero_or_one n with h | h + · have hn : n = 2*(n/2) := by omega + have hs := P4207T1FloorArithmetic.1 0 (n/2) + norm_num at hs + have hf : n^2/4 = (n/2)^2 := by + conv_lhs => rw [hn] + exact hs + rw [hf, h] + nlinarith only [congrArg (fun t : Int => t^2) hn] + · have hn : n = 2*(n/2)+1 := by omega + have hs := P4207T1FloorArithmetic.1 1 (n/2) + norm_num at hs + have he : 1+2*(n/2) = 2*(n/2)+1 := by ring + rw [he] at hs + have hf : n^2/4 = n/2+(n/2)^2 := by + conv_lhs => rw [hn] + exact hs + rw [hf, h] + nlinarith only [congrArg (fun t : Int => t^2) hn] + refine ⟨?_, tri⟩ + intro a b + have ht := tri (|a|) + have hs := square (a-b) + simp only [P4207T1DiamondFormula, Int.natCast_natAbs] + nlinarith only [ht, hs, sq_abs a] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5537T1UnitParentBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5537T1UnitParentBoundary.lean new file mode 100644 index 0000000000..4c26a65a0a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5537T1UnitParentBoundary.lean @@ -0,0 +1,236 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData +public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows +public import LeanPool.ApollonianSuperharmonic.P5537T1ScaledDiamondFormula + +-- [TABLET NODE: P5537T1UnitParentBoundary] + +/-! +# P5537T1UnitParentBoundary + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5537T1UnitParentBoundary (K : DiamondParameter) (hk : 1 < K.1) : + let A := P5352T2Sources K hk 0 + ∀ (i : Fin 3), i.val < 2 → ∀ (s : Fin 4), + let D := P5352T2Sources K hk i.succ + let M := (P5352T2PlacementData K.1 i).2 s + ∃ b : Int, ∀ x : GaussianInt, + x ∈ FootprintVertices A.1 → x-M.1 ∈ FootprintVertices D.1 → + D.2.1 (x-M.1) + M.2.1.re*x.re + M.2.1.im*x.im - A.2.1 x = b := by +-- BODY + dsimp only + have hn : 2 ≤ (K.1 : Int) := by exact_mod_cast hk + have unitMem (z : GaussianInt) : + z ∈ FootprintVertices (⟨{0},0⟩ : ProtoTile) ↔ + 0 ≤ z.re ∧ z.re ≤ 1 ∧ 0 ≤ z.im ∧ z.im ≤ 1 := by + simp only [FootprintVertices, Finset.singleton_nonempty, ↓reduceIte, + Set.mem_ofPred_eq, Finset.mem_singleton, exists_eq_left] + simp only [zero_add, Zsqrtd.ext_iff, Zsqrtd.re_zero, Zsqrtd.im_zero, + Zsqrtd.re_one, Zsqrtd.im_one, Zsqrtd.re_add, Zsqrtd.im_add] + omega + have hF (z : GaussianInt) (hz : z ∈ FootprintVertices (DiamondTile K.1)) : + DiamondOdometer K z = P4207T1DiamondFormula z := + (P5352T2DomainRows K z).2 hz + have scale (z : GaussianInt) : + 4 * P4207T1DiamondFormula z = + 2*z.re^2-2*|z.re|-(z.re-z.im)^2+(z.re-z.im)%2 := by + exact P5537T1ScaledDiamondFormula.1 z.re z.im + have ht := P5537T1ScaledDiamondFormula.2 (K.1 : Int) + have ht' := P5537T1ScaledDiamondFormula.2 ((K.1 : Int)+1) + rw [show (K.1:Int)+1-1 = (K.1:Int) by ring] at ht' + rw [mul_comm ((K.1:Int)+1) (K.1:Int)] at ht' + intro i hi s + fin_cases i + · fin_cases s + · refine ⟨-(K.1:Int)^2, ?_⟩ + intro x hx hd + change x ∈ FootprintVertices (DiamondTile K.1) at hx + change x-⟨0,2*(K.1:Int)⟩ ∈ FootprintVertices (⟨{0},0⟩ : ProtoTile) at hd + have hc := (P5352T2DomainRows K x).1.mp hx + have hu := (unitMem _).mp hd + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] at hu + have hy : x.im = 2*(K.1:Int) := by omega + have hx01 : x.re = 0 ∨ x.re = 1 := by omega + change (CurvatureOneOdometer ⟨0,1⟩).value (x-⟨0,2*(K.1:Int)⟩) + + (K.1:Int)*x.re + (-(K.1:Int))*x.im - DiamondOdometer K x = _ + rw [hF x hx] + have hs := scale x + rcases hx01 with hxr | hxr + all_goals + simp only [hxr, hy] at hs ⊢ + simp only [CurvatureOneOdometer, Zsqrtd.ext_iff, Zsqrtd.re_sub, + Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, + Zsqrtd.im_one, hxr, hy] + norm_num at hs ⊢ + have hm : (-(2*(K.1:Int)))%2 = 0 := by omega + have hm' : (1-2*(K.1:Int))%2 = 1 := by omega + try + nlinarith only [hs] + · refine ⟨-((K.1:Int)*((K.1:Int)+1)/2), ?_⟩ + intro x hx hd + change x ∈ FootprintVertices (DiamondTile K.1) at hx + change x-⟨-(K.1:Int)-1,(K.1:Int)⟩ ∈ FootprintVertices (⟨{0},0⟩ : ProtoTile) at hd + have hc := (P5352T2DomainRows K x).1.mp hx + have hu := (unitMem _).mp hd + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] at hu + have hxr : x.re = -(K.1:Int) := by omega + have hy01 : x.im = (K.1:Int) ∨ x.im = (K.1:Int)+1 := by omega + change (CurvatureOneOdometer ⟨0,1⟩).value (x-⟨-(K.1:Int)-1,(K.1:Int)⟩) + + 0*x.re + (-(K.1:Int)-1)*x.im - DiamondOdometer K x = _ + rw [hF x hx] + have hs := scale x + rcases hy01 with hy | hy + all_goals + simp only [hxr, hy, abs_neg, abs_of_nonneg (by omega : 0 ≤ (K.1:Int))] at hs ⊢ + simp only [CurvatureOneOdometer, Zsqrtd.ext_iff, Zsqrtd.re_sub, + Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, + Zsqrtd.im_one, hxr, hy] + norm_num at hs ⊢ + have hm : (-(K.1:Int)-(K.1:Int))%2 = 0 := by omega + have hm' : (-(K.1:Int)-((K.1:Int)+1))%2 = 1 := by omega + try simp only [hm, hm'] at hs + nlinarith only [hs, ht'] + · refine ⟨1, ?_⟩ + intro x hx hd + change x ∈ FootprintVertices (DiamondTile K.1) at hx + change x-⟨-1,-1⟩ ∈ FootprintVertices (⟨{0},0⟩ : ProtoTile) at hd + have hc := (P5352T2DomainRows K x).1.mp hx + have hu := (unitMem _).mp hd + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] at hu + have hy : x.im = 0 := by omega + have hx01 : x.re = -1 ∨ x.re = 0 := by omega + change (CurvatureOneOdometer ⟨0,1⟩).value (x-⟨-1,-1⟩) + + (-1)*x.re + (-1)*x.im - DiamondOdometer K x = _ + rw [hF x hx] + have hs := scale x + rcases hx01 with hxr | hxr + all_goals + simp only [hxr, hy] at hs ⊢ + simp only [CurvatureOneOdometer, Zsqrtd.ext_iff, Zsqrtd.re_sub, + Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, + Zsqrtd.im_one, hxr, hy] + norm_num at hs ⊢ + nlinarith only [hs] + · refine ⟨(K.1:Int)*((K.1:Int)-1)/2, ?_⟩ + intro x hx hd + change x ∈ FootprintVertices (DiamondTile K.1) at hx + change x-⟨(K.1:Int),(K.1:Int)-1⟩ ∈ FootprintVertices (⟨{0},0⟩ : ProtoTile) at hd + have hc := (P5352T2DomainRows K x).1.mp hx + have hu := (unitMem _).mp hd + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] at hu + have hxr : x.re = (K.1:Int) := by omega + have hy01 : x.im = (K.1:Int)-1 ∨ x.im = (K.1:Int) := by omega + change (CurvatureOneOdometer ⟨0,1⟩).value (x-⟨(K.1:Int),(K.1:Int)-1⟩) + + ((K.1:Int)-1)*x.re + 0*x.im - DiamondOdometer K x = _ + rw [hF x hx] + have hs := scale x + rcases hy01 with hy | hy + all_goals + simp only [hxr, hy, abs_of_nonneg (by omega : 0 ≤ (K.1:Int))] at hs ⊢ + simp only [CurvatureOneOdometer, Zsqrtd.ext_iff, Zsqrtd.re_sub, + Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_one, + Zsqrtd.im_one, hxr, hy] + norm_num at hs ⊢ + nlinarith only [hs, ht] + · fin_cases s + · refine ⟨-((K.1:Int)*((K.1:Int)-1)/2), ?_⟩ + intro x hx hd + change x ∈ FootprintVertices (DiamondTile K.1) at hx + change x-⟨-(K.1:Int)-1,(K.1:Int)-1⟩ ∈ FootprintVertices (⟨{0},0⟩ : ProtoTile) at hd + have hc := (P5352T2DomainRows K x).1.mp hx + have hu := (unitMem _).mp hd + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] at hu + have hxr : x.re = -(K.1:Int) := by omega + have hy01 : x.im = (K.1:Int)-1 ∨ x.im = (K.1:Int) := by omega + change (CurvatureOneOdometer 0).value (x-⟨-(K.1:Int)-1,(K.1:Int)-1⟩) + + 0*x.re + (-(K.1:Int))*x.im - DiamondOdometer K x = _ + rw [hF x hx] + have hs := scale x + rcases hy01 with hy | hy + all_goals + simp only [hxr, hy, abs_neg, abs_of_nonneg (by omega : 0 ≤ (K.1:Int))] at hs ⊢ + simp only [CurvatureOneOdometer, Zsqrtd.im_zero, ite_self] + norm_num at hs ⊢ + have hm : (-(K.1:Int)-(K.1:Int))%2 = 0 := by omega + have hm' : (-(K.1:Int)-((K.1:Int)-1))%2 = 1 := by omega + try simp only [hm, hm'] at hs + nlinarith only [hs, ht] + · refine ⟨0, ?_⟩ + intro x hx hd + change x ∈ FootprintVertices (DiamondTile K.1) at hx + change x-⟨0,-1⟩ ∈ FootprintVertices (⟨{0},0⟩ : ProtoTile) at hd + have hc := (P5352T2DomainRows K x).1.mp hx + have hu := (unitMem _).mp hd + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] at hu + have hy : x.im = 0 := by omega + have hx01 : x.re = 0 ∨ x.re = 1 := by omega + change (CurvatureOneOdometer 0).value (x-⟨0,-1⟩) + + 0*x.re + 0*x.im - DiamondOdometer K x = _ + rw [hF x hx] + have hs := scale x + rcases hx01 with hxr | hxr + all_goals + simp only [hxr, hy] at hs ⊢ + simp only [CurvatureOneOdometer, Zsqrtd.im_zero, ite_self] + norm_num at hs ⊢ + nlinarith only [hs] + · refine ⟨(K.1:Int)*((K.1:Int)+1)/2, ?_⟩ + intro x hx hd + change x ∈ FootprintVertices (DiamondTile K.1) at hx + change x-⟨(K.1:Int),(K.1:Int)⟩ ∈ FootprintVertices (⟨{0},0⟩ : ProtoTile) at hd + have hc := (P5352T2DomainRows K x).1.mp hx + have hu := (unitMem _).mp hd + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] at hu + have hxr : x.re = (K.1:Int) := by omega + have hy01 : x.im = (K.1:Int) ∨ x.im = (K.1:Int)+1 := by omega + change (CurvatureOneOdometer 0).value (x-⟨(K.1:Int),(K.1:Int)⟩) + + (K.1:Int)*x.re + 0*x.im - DiamondOdometer K x = _ + rw [hF x hx] + have hs := scale x + rcases hy01 with hy | hy + all_goals + simp only [hxr, hy, abs_of_nonneg (by omega : 0 ≤ (K.1:Int))] at hs ⊢ + simp only [CurvatureOneOdometer, Zsqrtd.im_zero, ite_self] + norm_num at hs ⊢ + nlinarith only [hs, ht'] + · refine ⟨-(K.1:Int)^2, ?_⟩ + intro x hx hd + change x ∈ FootprintVertices (DiamondTile K.1) at hx + change x-⟨-1,2*(K.1:Int)⟩ ∈ FootprintVertices (⟨{0},0⟩ : ProtoTile) at hd + have hc := (P5352T2DomainRows K x).1.mp hx + have hu := (unitMem _).mp hd + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub] at hu + have hy : x.im = 2*(K.1:Int) := by omega + have hx01 : x.re = -1 ∨ x.re = 0 := by omega + change (CurvatureOneOdometer 0).value (x-⟨-1,2*(K.1:Int)⟩) + + (K.1:Int)*x.re + (-(K.1:Int))*x.im - DiamondOdometer K x = _ + rw [hF x hx] + have hs := scale x + rcases hx01 with hxr | hxr + all_goals + simp only [hxr, hy] at hs ⊢ + simp only [CurvatureOneOdometer, Zsqrtd.im_zero, ite_self] + norm_num at hs ⊢ + have hm : (-(2*(K.1:Int)))%2 = 0 := by omega + have hm' : (-1-2*(K.1:Int))%2 = 1 := by omega + try + nlinarith only [hs] + · change (2 : Nat) < 2 at hi + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5570T1UnitNormalForm.lean b/LeanPool/ApollonianSuperharmonic/P5570T1UnitNormalForm.lean new file mode 100644 index 0000000000..b885fa90b0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5570T1UnitNormalForm.lean @@ -0,0 +1,135 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5570T1UnitQuadratic +public import LeanPool.ApollonianSuperharmonic.CurvatureOnePeriodicOdometer +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas + +-- [TABLET NODE: P5570T1UnitNormalForm] + +/-! +# P5570T1UnitNormalForm + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5570T1UnitNormalForm (C : BandCircle) (z : GaussianInt) + (T : ProtoTile) (h : PartialOdometer) + (hC : C.1.1 = (1, 1 + 2 * z)) (hh : TileOdometer C.1.1 T h) : + ∃ (u a : GaussianInt) (b : ℤ), + T.cells = {u} ∧ + (∀ x, x ∈ h.domain ↔ x-u ∈ (CurvatureOneOdometer z).domain) ∧ + TileCentroid T = ((u.re : ℝ)+1/2, (u.im : ℝ)+1/2) ∧ + (∀ x, x ∈ h.domain → h.value x = + P5570T1UnitQuadratic z x + a.re*x.re + a.im*x.im + b) ∧ + PartialOdometerSlope h = some + (((1+(z.re : ℝ))*(u.re : ℝ)+(z.im : ℝ)*(u.im : ℝ)+a.re+(z.im : ℝ)/2), + ((z.im : ℝ)*(u.re : ℝ)-(z.re : ℝ)*(u.im : ℝ)+a.im+(z.im : ℝ)/2)) := by +-- BODY + classical + have hc : C.1.1.1 = 1 := by rw [hC] + obtain ⟨u, hu⟩ := CurvatureOneBandPrototileSingleton C T hc + (TileOdometerBandPrototile _ _ _ hh) + let U : ProtoTile := ⟨{0}, 0⟩ + have hperiodic := CurvatureOnePeriodicOdometer C z hC + have hcan : TileOdometer C.1.1 U (CurvatureOneOdometer z) := hperiodic.2.1 + have hbase : ∀ x, x ∈ (CurvatureOneOdometer z).domain → + P5570T1UnitQuadratic z x = (CurvatureOneOdometer z).value x := + hperiodic.2.2.2.1 + have hmatrix : CircleMatrix C = + ![![((1+z.re : ℤ) : ℝ), (z.im : ℝ)], + ![(z.im : ℝ), (-z.re : ℝ)]] := by + unfold CircleMatrix BandCircleEuclideanData + simp only [hc, show C.1.1.2 = 1+2*z by rw [hC]] + ext i j; fin_cases i <;> fin_cases j + all_goals simp only [ + Complex.div_re, Complex.div_im, GaussianInt.toComplex_def, + Complex.add_re, Complex.add_im, Complex.mul_re, Complex.mul_im, + Complex.intCast_re, Complex.intCast_im] + all_goals norm_num + all_goals ring + have translation (x v : GaussianInt) : + P5570T1UnitQuadratic z (x+v) = + P5570T1UnitQuadratic z x + P5570T1UnitQuadratic z v + + ((1+z.re)*v.re+z.im*v.im)*x.re + + (z.im*v.re-z.re*v.im)*x.im := by + obtain ⟨w, hw, hshift⟩ := hperiodic.2.2.2.2.2.2.1 v + (by simp [TilingLattice, hc]) + have hr : (1+z.re)*v.re+z.im*v.im = w.re := by + have he := congrFun hw 0 + simp only [hmatrix, Matrix.mulVec, dotProduct, Fin.sum_univ_two, + Matrix.cons_val_zero, Matrix.cons_val_one] at he + exact_mod_cast he + have hi : z.im*v.re-z.re*v.im = w.im := by + have he := congrFun hw 1 + simp only [hmatrix, Matrix.mulVec, dotProduct, Fin.sum_univ_two, + Matrix.cons_val_zero, Matrix.cons_val_one] at he + have he' : z.im*v.re + -z.re*v.im = w.im := by exact_mod_cast he + linear_combination he' + have he : P5570T1UnitQuadratic z (x+v) = + P5570T1UnitQuadratic z x + x.re*w.re + x.im*w.im + + P5570T1UnitQuadratic z v := hshift x + rw [← hr, ← hi] at he + linear_combination he + obtain ⟨v, ⟨hv, _, a, b, hd, hval⟩, _⟩ := + TileOdometerTranslationUniqueness C.1.1 T U h (CurvatureOneOdometer z) + C.2 hh hcan + have hvu : v = u := by + simpa [hu, U, TileTranslation, GaussianTranslation] using hv.symm + subst v + have heq : h = PartialOdometerAffineTranslate (CurvatureOneOdometer z) u a b := by + have hdom : h.domain = + (PartialOdometerAffineTranslate (CurvatureOneOdometer z) u a b).domain := by + ext x + rw [(PartialOdometerAffineTranslateFormulas _ u a b).2.1] + exact hd x + have hvalues : h.value = + (PartialOdometerAffineTranslate (CurvatureOneOdometer z) u a b).value := by + funext x + by_cases hx : x ∈ h.domain + · rw [hval x hx, (PartialOdometerAffineTranslateFormulas _ u a b).2.2.1 x + (by rwa [← hdom])] + · rw [h.value_outside x hx, + (PartialOdometerAffineTranslate _ u a b).value_outside x (by rwa [← hdom])] + cases h + congr + have hsquares : PartialOdometerSquares (CurvatureOneOdometer z) = {0} := by + change PartialOdometerSquares (CurvatureOneOdometer 0) = {0} + decide +kernel + have hslope : PartialOdometerSlope (CurvatureOneOdometer z) = + some ((z.im : ℝ)/2, (z.im : ℝ)/2) := by + unfold PartialOdometerSlope + rw [hsquares] + simp [CurvatureOneOdometer, Zsqrtd.ext_iff] + let A : GaussianInt := ⟨a.re-((1+z.re)*u.re+z.im*u.im), + a.im-(z.im*u.re-z.re*u.im)⟩ + refine ⟨u, A, b+P5570T1UnitQuadratic z (-u), hu, hd, ?_, ?_, ?_⟩ + · simp [TileCentroid, hu] + · intro x hx + rw [hval x hx, ← hbase (x-u) ((hd x).mp hx)] + have ht := translation x (-u) + simp only [← sub_eq_add_neg] at ht + rw [ht] + simp [A] + ring + · rw [heq, (PartialOdometerAffineTranslateFormulas _ u a b).2.2.2.2.2, hslope] + simp only [Option.map_some, Option.some.injEq, Prod.mk.injEq] + dsimp [A] + push_cast + constructor <;> ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5570T1UnitQuadratic.lean b/LeanPool/ApollonianSuperharmonic/P5570T1UnitQuadratic.lean new file mode 100644 index 0000000000..224a812155 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5570T1UnitQuadratic.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction + +-- [TABLET NODE: P5570T1UnitQuadratic] + +/-! +# P5570T1UnitQuadratic + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $z=a+bi\in\mathbb Z[i]$, define the integer quadratic +$$ + Q_z(r+ti)=(1+a)\frac{r(r-1)}2-a\frac{t(t-1)}2+brt. +$$ +The divisions are integer divisions; both numerators are even, including +for negative integer arguments. +-/ +def P5570T1UnitQuadratic (z : GaussianInt) : IntegerLatticeFunction := +-- BODY + fun x => (1 + z.re) * (x.re * (x.re - 1) / 2) - + z.re * (x.im * (x.im - 1) / 2) + z.im * x.re * x.im + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5589T1EndpointCompatibility.lean b/LeanPool/ApollonianSuperharmonic/P5589T1EndpointCompatibility.lean new file mode 100644 index 0000000000..7eb3ea50e9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5589T1EndpointCompatibility.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.RightSubtileOdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P5589T1EndpointCompatibility] + +/-! +# P5589T1EndpointCompatibility + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5589T1EndpointCompatibility + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (C D : BandCircle) (i : Fin 3) (hC : q 0 = C.1.1) (hD : q i.succ = D.1.1) + (U R S : ProtoTile) (f k hm hp : PartialOdometer) + (hOf : TileOdometer C.1.1 U f) + (hOm : TileOdometer D.1.1 R hm) (hOp : TileOdometer D.1.1 S hp) + (p pm pp : ℝ × ℝ) + (hsf : PartialOdometerSlope f = some p) + (hsm : PartialOdometerSlope hm = some pm) + (hsp : PartialOdometerSlope hp = some pp) + (hcm : TileCentroid R - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (q i.succ) (q 0) - BandVectors.1 (q 0) (q i.succ))) + (hcp : TileCentroid S - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ))) + (hpm : pm - p = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ))) + (hpp : pp - p = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ))) + (d a : GaussianInt) (b bm bp : ℤ) + (hk : k = PartialOdometerAffineTranslate (PartialOdometerHalfTurn f) d a b) + (hhp : hp = PartialOdometerAffineTranslate (PartialOdometerHalfTurn hm) d a bm) + (hhm : hm = PartialOdometerAffineTranslate (PartialOdometerHalfTurn hp) d a bp) : + OdometerCompatibility f hm ∧ OdometerCompatibility f hp ∧ + OdometerCompatibility k hm ∧ OdometerCompatibility k hp := by +-- BODY + have flips := (VectorRecursionLaws q hq.1).2.2.2.2 hq i + have cm : TileCentroid R - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0,1⟩ : GaussianInt) ^ (3 : Fin 4).val * + (BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ))) := by + rw [hcm, flips.1] + congr 2 + ext <;> simp [pow_succ] <;> ring + have sm : pm - p = (1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0,1⟩ : GaussianInt) ^ (3 : Fin 4).val * + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ))) := by + rw [hpm, flips.2] + congr 2 + ext <;> simp [pow_succ]; ring + have hfm : OdometerCompatibility f hm := + RightSubtileOdometerCompatibility.2 C D U R f hm + ⟨hOf, hOm, p, pm, hsf, hsm, q, i, 3, hq, hC, hD, cm, + congrArg Prod.fst sm, congrArg Prod.snd sm⟩ + have hfp : OdometerCompatibility f hp := + RightSubtileOdometerCompatibility.2 C D U S f hp + ⟨hOf, hOp, p, pp, hsf, hsp, q, i, 0, hq, hC, hD, + by simpa using hcp, by simpa using congrArg Prod.fst hpp, + by simpa using congrArg Prod.snd hpp⟩ + have reflect (v w : PartialOdometer) (c e : ℤ) + (h : OdometerCompatibility v w) : + OdometerCompatibility + (PartialOdometerAffineTranslate (PartialOdometerHalfTurn v) d a c) + (PartialOdometerAffineTranslate (PartialOdometerHalfTurn w) d a e) := by + have mem (v : PartialOdometer) (c : ℤ) (x : GaussianInt) : + x ∈ (PartialOdometerAffineTranslate (PartialOdometerHalfTurn v) d a c).domain ↔ + -(x-d) ∈ v.domain := by + rw [(PartialOdometerAffineTranslateFormulas _ _ _ _).2.1, + (PartialOdometerHalfTurnFormulas _).1] + rcases h with hd | ⟨t, ht⟩ + · left + exact Set.disjoint_left.mpr (fun x hx hy => + Set.disjoint_left.mp hd ((mem v c x).mp hx) ((mem w e x).mp hy)) + · right + refine ⟨t+e-c, ?_⟩ + intro x hx hy + have he := ht (-(x-d)) ((mem v c x).mp hx) ((mem w e x).mp hy) + rw [(PartialOdometerAffineTranslateFormulas _ _ _ _).2.2.1 x hy, + (PartialOdometerAffineTranslateFormulas _ _ _ _).2.2.1 x hx, + (PartialOdometerHalfTurnFormulas w).2.1 (x-d) + ((PartialOdometerAffineTranslateFormulas _ _ _ _).2.1 x |>.mp hy), + (PartialOdometerHalfTurnFormulas v).2.1 (x-d) + ((PartialOdometerAffineTranslateFormulas _ _ _ _).2.1 x |>.mp hx)] + omega + refine ⟨hfm, hfp, ?_, ?_⟩ + · rw [hk, hhm] + exact reflect f hp b bp hfp + · rw [hk, hhp] + exact reflect f hm b bm hfm + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5589T1LinkedUnitValues.lean b/LeanPool/ApollonianSuperharmonic/P5589T1LinkedUnitValues.lean new file mode 100644 index 0000000000..6b819d53b7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5589T1LinkedUnitValues.lean @@ -0,0 +1,167 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4261T2UnitStringTelescoping +public import LeanPool.ApollonianSuperharmonic.P5570T1UnitNormalForm +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends + +-- [TABLET NODE: P5589T1LinkedUnitValues] + +/-! +# P5589T1LinkedUnitValues + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5589T1LinkedUnitValues + (C D : BandCircle) (z : GaussianInt) (hz : D.1.1 = (1, 1 + 2 * z)) + (o : Bool) (base R S U V : ProtoTile) + (ts rs : List ProtoTile) (hs ks : List PartialOdometer) + (hm hp f k : PartialOdometer) (g : IntegerLatticeFunction) (x : GaussianInt) + (hf : OdometerStringRespect D o base R S ts hs) + (hr : OdometerStringRespect D o base S R rs ks) + (hhead : hs.head? = some hm) (hlast : hs.getLast? = some hp) + (hrlast : ks.getLast? = some hm) + (hgf : GlobalOdometerExtends g f) (hgk : GlobalOdometerExtends g k) + (hxf : x ∈ f.domain) (hxk : x ∈ k.domain) + (hcompat : OdometerCompatibility f hm ∧ OdometerCompatibility f hp ∧ + OdometerCompatibility k hm ∧ OdometerCompatibility k hp) + (hcover : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ f.domain ∨ y ∈ k.domain) + (hselect : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + ∃ T h, ((T, h) ∈ ts.zip hs ∨ (T, h) ∈ rs.zip ks) ∧ + x ∈ h.domain ∧ y ∈ h.domain ∧ + (AncestorOdometer D.1.1 C.1.1 T U h f ∨ + AncestorOdometer D.1.1 C.1.1 T V h k ∨ h = hm ∨ h = hp)) : + ∃ a : GaussianInt, ∃ b : ℤ, ∀ y, + y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + g y = P5570T1UnitQuadratic z y + a.re * y.re + a.im * y.im + b := by +-- BODY + have hc : D.1.1.1 = 1 := by rw [hz] + have headZip : (R, hm) ∈ ts.zip hs := by + obtain ⟨t, ht⟩ := List.head?_eq_some_iff.mp hf.1.2.1 + obtain ⟨s, hs'⟩ := List.head?_eq_some_iff.mp hhead + simp [ht, hs'] + have lastZip : (S, hp) ∈ ts.zip hs := by + obtain ⟨t, ht⟩ := List.getLast?_eq_some_iff.mp hf.1.2.2.1 + obtain ⟨s, hs'⟩ := List.getLast?_eq_some_iff.mp hlast + have hlen : t.length = s.length := by + have he := List.Forall₂.length_eq hf.2.1 + rw [ht, hs', List.length_append, List.length_append] at he + simpa using he + simp [ht, hs', List.zip_append hlen] + have reverseLast : (R, hm) ∈ rs.zip ks := by + obtain ⟨t, ht⟩ := List.getLast?_eq_some_iff.mp hr.1.2.2.1 + obtain ⟨s, hs'⟩ := List.getLast?_eq_some_iff.mp hrlast + have hlen : t.length = s.length := by + have he := List.Forall₂.length_eq hr.2.1 + rw [ht, hs', List.length_append, List.length_append] at he + simpa using he + simp [ht, hs', List.zip_append hlen] + have hmatrix : CircleMatrix D = + ![![((1 + z.re : ℤ) : ℝ), (z.im : ℝ)], + ![(z.im : ℝ), (-z.re : ℝ)]] := by + unfold CircleMatrix BandCircleEuclideanData + simp only [hc, show D.1.1.2 = 1 + 2 * z by rw [hz]] + ext i j; fin_cases i <;> fin_cases j + all_goals simp only [ + Complex.div_re, Complex.div_im, GaussianInt.toComplex_def, + Complex.add_re, Complex.add_im, Complex.mul_re, Complex.mul_im, + Complex.intCast_re, Complex.intCast_im] + all_goals norm_num + all_goals ring + obtain ⟨u₀, a, b₀, _, _, hc₀, hv₀, hs₀⟩ := + P5570T1UnitNormalForm D z R hm hz (List.forall₂_zip hf.2.1 headZip) + have common (T : ProtoTile) (h : PartialOdometer) + (hmem : (T, h) ∈ ts.zip hs ∨ (T, h) ∈ rs.zip ks) : + ∃ b : ℤ, ∀ y, y ∈ h.domain → + h.value y = P5570T1UnitQuadratic z y + a.re * y.re + a.im * y.im + b := by + have hO : TileOdometer D.1.1 T h := by + rcases hmem with hmem | hmem + · exact List.forall₂_zip hf.2.1 hmem + · exact List.forall₂_zip hr.2.1 hmem + obtain ⟨u, a', b, _, _, hcent, hval, hslope⟩ := + P5570T1UnitNormalForm D z T h hz hO + have telescope : ∃ s t : ℝ × ℝ, + PartialOdometerSlope hm = some s ∧ PartialOdometerSlope h = some t ∧ + t.1 - s.1 = CircleMatrix D 0 0 * ((TileCentroid T).1 - (TileCentroid R).1) + + CircleMatrix D 0 1 * ((TileCentroid T).2 - (TileCentroid R).2) ∧ + t.2 - s.2 = CircleMatrix D 1 0 * ((TileCentroid T).1 - (TileCentroid R).1) + + CircleMatrix D 1 1 * ((TileCentroid T).2 - (TileCentroid R).2) := by + rcases hmem with hmem | hmem + · obtain ⟨t, s, ht, hs, he₁, he₂⟩ := P4261T2UnitStringTelescoping D hc o + base R S ts rs hs ks hf hr hm hhead hrlast T R h hm hmem reverseLast + exact ⟨s, t, hs, ht, by linear_combination -he₁, by linear_combination -he₂⟩ + · exact P4261T2UnitStringTelescoping D hc o base R S ts rs hs ks hf hr + hm hhead hrlast R T hm h headZip hmem + obtain ⟨s, t, hs, ht, he₁, he₂⟩ := telescope + have es := Option.some.inj (hs.symm.trans hs₀) + have et := Option.some.inj (ht.symm.trans hslope) + rw [es, et, hc₀, hcent, hmatrix] at he₁ he₂ + norm_num only [Matrix.cons_val_zero, Matrix.cons_val_one] at he₁ he₂ + have ear : (a'.re : ℝ) = a.re := by + push_cast at he₁ + nlinarith only [he₁] + have eai : (a'.im : ℝ) = a.im := by + nlinarith only [he₂] + have ea : a' = a := by + apply Zsqrtd.ext + · exact_mod_cast ear + · exact_mod_cast eai + subst a' + exact ⟨b, hval⟩ + have endpoint (v h : PartialOdometer) (hv : GlobalOdometerExtends g v) + (hvh : OdometerCompatibility v h) (hxh : x ∈ h.domain) + (hxv : x ∈ v.domain) (y : GaussianInt) (hyh : y ∈ h.domain) + (hyv : y ∈ v.domain) : g y - g x = h.value y - h.value x := by + obtain ⟨c, hc⟩ := hv + rcases hvh with hd | ⟨b, hb⟩ + · exact (Set.disjoint_left.mp hd hxv hxh).elim + · have he₁ := hb x hxv hxh + have he₂ := hb y hyv hyh + rw [hc y hyv, hc x hxv] + omega + have increment (T : ProtoTile) (h : PartialOdometer) (y : GaussianInt) + (hy : y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) + (hxh : x ∈ h.domain) (hyh : y ∈ h.domain) + (hroute : AncestorOdometer D.1.1 C.1.1 T U h f ∨ + AncestorOdometer D.1.1 C.1.1 T V h k ∨ h = hm ∨ h = hp) : + g y - g x = h.value y - h.value x := by + rcases hroute with hf' | hk' | rfl | rfl + · obtain ⟨c, hc⟩ := hgf + rw [hc y (hf'.2.2.2.1 hyh), hc x (hf'.2.2.2.1 hxh), + ← hf'.2.2.2.2 y hyh, ← hf'.2.2.2.2 x hxh] + omega + · obtain ⟨c, hc⟩ := hgk + rw [hc y (hk'.2.2.2.1 hyh), hc x (hk'.2.2.2.1 hxh), + ← hk'.2.2.2.2 y hyh, ← hk'.2.2.2.2 x hxh] + omega + · -- Compatibility is used only on the covered part of the endpoint. + rcases hcover y hy with hyf | hyk + · exact endpoint f h hgf hcompat.1 hxh hxf y hyh hyf + · exact endpoint k h hgk hcompat.2.2.1 hxh hxk y hyh hyk + · rcases hcover y hy with hyf | hyk + · exact endpoint f h hgf hcompat.2.1 hxh hxf y hyh hyf + · exact endpoint k h hgk hcompat.2.2.2 hxh hxk y hyh hyk + refine ⟨a, g x - P5570T1UnitQuadratic z x - a.re * x.re - a.im * x.im, ?_⟩ + intro y hy + obtain ⟨T, h, hm, hx, hyh, hroute⟩ := hselect y hy + obtain ⟨b, hb⟩ := common T h hm + have he := increment T h y hy hx hyh hroute + rw [hb y hyh, hb x hx] at he + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5589T1UnitInterfaceSelection.lean b/LeanPool/ApollonianSuperharmonic/P5589T1UnitInterfaceSelection.lean new file mode 100644 index 0000000000..84e0f112a6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5589T1UnitInterfaceSelection.lean @@ -0,0 +1,259 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.OpposingStringInterfacePath +public import LeanPool.ApollonianSuperharmonic.P4366T2WalkExhaustion +public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.P4158T1AncestorCells +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge + +-- [TABLET NODE: P5589T1UnitInterfaceSelection] + +/-! +# P5589T1UnitInterfaceSelection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5589T1UnitInterfaceSelection + (C D : BandCircle) (hunit : D.1.1.1 = 1) + (o : Bool) (base R S U V : ProtoTile) + (ts rs : List ProtoTile) (hs ks : List PartialOdometer) + (hm hp f k : PartialOdometer) + (hOf : TileOdometer C.1.1 U f) (hOk : TileOdometer C.1.1 V k) + (hUn : U.cells.Nonempty) (hVn : V.cells.Nonempty) + (hf : OdometerStringRespect D o base R S ts hs) + (hr : OdometerStringRespect D o base S R rs ks) + (hhead : hs.head? = some hm) (hlast : hs.getLast? = some hp) + (hRS : R ≠ S) + (hnadj : ¬ ∃ v : GaussianInt, UnitTriangularStep o v ∧ + TileCentroid S - TileCentroid R = GaussianRealPoint v) + (hanc : ∀ T, T ∈ (ts.drop 1).dropLast → + ∃ h, (T, h) ∈ ts.zip hs ∧ AncestorOdometer D.1.1 C.1.1 T U h f) + (hranc : ∀ T, T ∈ (rs.drop 1).dropLast → + ∃ h, (T, h) ∈ rs.zip ks ∧ AncestorOdometer D.1.1 C.1.1 T V h k) + (ER : ExactTileInterfaceTriple U V R) (ES : ExactTileInterfaceTriple U V S) + (htR : TouchingTriple U V R) (htS : TouchingTriple U V S) + (hcross : ER.otherAB = ES.point) + (x : GaussianInt) (hxf : x ∈ f.domain) (hxk : x ∈ k.domain) : + ∀ y, y = x ∨ y = x+1 ∨ y = x-1 ∨ y = x+⟨0,1⟩ ∨ y = x-⟨0,1⟩ → + ∃ T h, ((T, h) ∈ ts.zip hs ∨ (T, h) ∈ rs.zip ks) ∧ + x ∈ h.domain ∧ y ∈ h.domain ∧ + (AncestorOdometer D.1.1 C.1.1 T U h f ∨ + AncestorOdometer D.1.1 C.1.1 T V h k ∨ h = hm ∨ h = hp) := by +-- BODY + obtain ⟨walk, ⟨a, ha, haR⟩, ⟨b, hb, hbS⟩, hchain, hverts, hedges⟩ := + OpposingStringInterfacePath D o base R S hRS (by simpa [hunit] using hnadj) + ts rs hf.1 hr.1 + have hdomf := PositiveCurvatureTileOdometerDomain C.1.1 U f C.property hOf + have hdomk := PositiveCurvatureTileOdometerDomain C.1.1 V k C.property hOk + have hv (z : GaussianInt) (hz : z ∈ walk) : + z ∈ FootprintVertices U ∩ FootprintVertices V := by + obtain ⟨⟨A,hA,hzA⟩,⟨B,hB,hzB⟩⟩ := hverts z hz + obtain ⟨h,_,hh⟩ := hanc A hA + obtain ⟨l,_,hl⟩ := hranc B hB + have hzh : z ∈ h.domain := by rw [← hh.2.2.1] at hzA; exact hzA + have hzl : z ∈ l.domain := by rw [← hl.2.2.1] at hzB; exact hzB + exact ⟨hdomf ▸ hh.2.2.2.1 hzh, hdomk ▸ hl.2.2.2.1 hzl⟩ + have ha' : a = ER.point := + (ER.unique_common a).mp ⟨hv a (List.mem_of_head? ha), haR⟩ + have hb' : b = ES.point := + (ES.unique_common b).mp ⟨hv b (List.mem_of_getLast? hb), hbS⟩ + have hedge (a b : GaussianInt) (l r : List GaussianInt) + (he : walk = l ++ a :: b :: r) : + {a,b} ∈ FootprintEdges U ∩ FootprintEdges V := by + obtain ⟨⟨A,hA,heA⟩,⟨B,hB,heB⟩⟩ := hedges a b l r he + obtain ⟨h,_,hh⟩ := hanc A hA + obtain ⟨k',_,hk'⟩ := hranc B hB + have lift (A B : ProtoTile) (hAB : A.cells ⊆ B.cells) + (he : {a,b} ∈ FootprintEdges A) : {a,b} ∈ FootprintEdges B := by + obtain ⟨c,hc,he⟩ := he + exact ⟨c,hAB hc,he⟩ + exact ⟨lift A U (P4158T1AncestorCells _ _ _ _ hh.2.1) heA, + lift B V (P4158T1AncestorCells _ _ _ _ hk'.2.1) heB⟩ + have hexhaust := P4366T2WalkExhaustion ER.pathAB walk + (ha.trans (congrArg some ha')) + (by rw [hcross]; exact hb.trans (congrArg some hb')) hedge + classical + let inc := LatticeVertexIncidentCell x + let route := fun (T : ProtoTile) (h : PartialOdometer) => + AncestorOdometer D.1.1 C.1.1 T U h f ∨ + AncestorOdometer D.1.1 C.1.1 T V h k ∨ h = hm ∨ h = hp + let good := fun j : Fin 4 => ∃ T h, + ((T, h) ∈ ts.zip hs ∨ (T, h) ∈ rs.zip ks) ∧ + inc j ∈ T.cells ∧ (h.domain : Set GaussianInt) = FootprintVertices T ∧ route T h + have corner (T : ProtoTile) (u y : GaussianInt) (hu : u ∈ T.cells) + (hy : y = u ∨ y = u+1 ∨ y = u+⟨0,1⟩ ∨ y = u+1+⟨0,1⟩) : + y ∈ FootprintVertices T := by + exact (show FootprintVertices T = _ from ite_eq_left (show T.cells.Nonempty from ⟨u,hu⟩)) ▸ + (show y ∈ {v | ∃ c ∈ T.cells, + v = c ∨ v = c+1 ∨ v = c+⟨0,1⟩ ∨ v = c+1+⟨0,1⟩} from ⟨u,hu,hy⟩) + have atX (j : Fin 4) : + x = inc j ∨ x = inc j+1 ∨ x = inc j+⟨0,1⟩ ∨ x = inc j+1+⟨0,1⟩ := by + fin_cases j <;> simp [inc, LatticeVertexIncidentCell, Zsqrtd.ext_iff] + have hdis : Disjoint U.cells V.cells := by + rcases htR.1 with h | h | h + · exact h.2.2.1 + · exact (hUn.ne_empty h.1).elim + · exact (hVn.ne_empty h.1).elim + have edgeGood (e : Finset GaussianInt) (hxe : x ∈ e) + (he : e ∈ FootprintEdges U ∩ FootprintEdges V) : + ∃ j : Fin 4, + e = ![{x,x+⟨0,1⟩},{x-1,x},{x-⟨0,1⟩,x},{x,x+1}] j ∧ + good j ∧ good (j+1) ∧ + ((inc j ∈ U.cells ∧ inc (j+1) ∈ V.cells) ∨ + (inc j ∈ V.cells ∧ inc (j+1) ∈ U.cells)) := by + obtain ⟨a,b,l,r,hw,heq⟩ := hexhaust.2 e he + obtain ⟨⟨A,hA,heA⟩,⟨B,hB,heB⟩⟩ := hedges a b l r hw + obtain ⟨h,hmA,hh⟩ := hanc A hA + obtain ⟨k',hmB,hk'⟩ := hranc B hB + have hAU := P4158T1AncestorCells _ _ _ _ hh.2.1 + have hBV := P4158T1AncestorCells _ _ _ _ hk'.2.1 + have hAB : Disjoint A.cells B.cells := Finset.disjoint_left.mpr + (fun c hc hd => Finset.disjoint_left.mp hdis (hAU hc) (hBV hd)) + obtain ⟨j,hj,hcells⟩ := P3102T2CommonEdgeSectorTransition A B x e hAB hxe + (by rw [heq]; exact ⟨heA,heB⟩) + refine ⟨j,hj,?_,?_,?_⟩ + · rcases hcells with hcells | hcells + · exact ⟨A,h,Or.inl hmA,hcells.1,hh.2.2.1,Or.inl hh⟩ + · exact ⟨B,k',Or.inr hmB,hcells.1,hk'.2.2.1,Or.inr (Or.inl hk')⟩ + · rcases hcells with hcells | hcells + · exact ⟨B,k',Or.inr hmB,hcells.2,hk'.2.2.1,Or.inr (Or.inl hk')⟩ + · exact ⟨A,h,Or.inl hmA,hcells.2,hh.2.2.1,Or.inl hh⟩ + · rcases hcells with hcells | hcells + · exact Or.inl ⟨hAU hcells.1,hBV hcells.2⟩ + · exact Or.inr ⟨hBV hcells.1,hAU hcells.2⟩ + have incident (T : ProtoTile) (hT : T.cells.Nonempty) (hx : x ∈ FootprintVertices T) : + ∃ j : Fin 4, inc j ∈ T.cells := by + simp only [FootprintVertices, ite_eq_left hT, Set.mem_ofPred_eq] at hx + obtain ⟨c,hc,hx⟩ := hx + rcases hx with hx | hx | hx | hx + · refine ⟨0,?_⟩; simpa [inc,LatticeVertexIncidentCell,hx] using hc + · refine ⟨1,?_⟩; simpa [inc,LatticeVertexIncidentCell,hx] using hc + · refine ⟨3,?_⟩; simpa [inc,LatticeVertexIncidentCell,hx] using hc + · refine ⟨2,?_⟩; simpa [inc,LatticeVertexIncidentCell,hx,sub_sub] using hc + have endpointGood (T : ProtoTile) (h : PartialOdometer) + (hzip : (T, h) ∈ ts.zip hs) (ht : TouchingTriple U V T) + (hx : x ∈ FootprintVertices T) (hr : h = hm ∨ h = hp) + (e : Finset GaussianInt) (hxe : x ∈ e) + (he : e ∈ FootprintEdges U ∩ FootprintEdges V) : + ∃ j l : Fin 4, j ≠ l ∧ j ≠ l+1 ∧ good j ∧ good l ∧ good (l+1) := by + have hOh := List.forall₂_zip hf.2.1 hzip + obtain ⟨u,hu⟩ := CurvatureOneBandPrototileSingleton D T hunit + (TileOdometerBandPrototile _ _ _ hOh) + have hTn : T.cells.Nonempty := by simp [hu] + have hTU : Disjoint T.cells U.cells := by + rcases ht.2.2.1 with h | h | h + · exact h.2.2.1 + · exact (hTn.ne_empty h.1).elim + · exact (hUn.ne_empty h.1).elim + have hTV : Disjoint T.cells V.cells := by + rcases ht.2.1 with h | h | h + · exact h.2.2.1.symm + · exact (hVn.ne_empty h.1).elim + · exact (hTn.ne_empty h.1).elim + obtain ⟨j,hj⟩ := incident T hTn hx + obtain ⟨l,_,hg₁,hg₂,htiles⟩ := edgeGood e hxe he + have hjs (r : Fin 4) (hr : inc r ∈ U.cells ∨ inc r ∈ V.cells) : j ≠ r := by + intro h; subst r + rcases hr with hr | hr + · exact Finset.disjoint_left.mp hTU hj hr + · exact Finset.disjoint_left.mp hTV hj hr + have hj₁ : j ≠ l := hjs l (htiles.elim (fun h => Or.inl h.1) (fun h => Or.inr h.1)) + have hj₂ : j ≠ l+1 := hjs (l+1) + (htiles.elim (fun h => Or.inr h.2) (fun h => Or.inl h.2)) + refine ⟨j,l,hj₁,hj₂,?_,hg₁,hg₂⟩ + exact ⟨T,h,Or.inl hzip,hj, + PositiveCurvatureTileOdometerDomain _ _ _ D.property hOh,Or.inr (Or.inr hr)⟩ + have hxV : x ∈ FootprintVertices U ∩ FootprintVertices V := + ⟨hdomf ▸ hxf,hdomk ▸ hxk⟩ + have hsimple : SimpleGridPath (FootprintVertices U ∩ FootprintVertices V) + (FootprintEdges U ∩ FootprintEdges V) := by + obtain ⟨p,hnd,hlen,_,_,hvs,hsteps,hes⟩ := ER.pathAB + exact ⟨p,hnd,hlen,hvs,hsteps,hes⟩ + obtain ⟨e,hxe,he⟩ := SimpleGridPathVertexIncidentEdge _ _ hsimple x hxV + have internalFinite : ∀ j k : Fin 4, j ≠ k → ∃ a : Fin 4, + (a = j ∨ a = j+1 ∨ a = k ∨ a = k+1) ∧ + (a+2 = j ∨ a+2 = j+1 ∨ a+2 = k ∨ a+2 = k+1) := by decide +kernel + have endpointFinite : ∀ j k : Fin 4, j ≠ k → j ≠ k+1 → ∃ a : Fin 4, + (a = j ∨ a = k ∨ a = k+1) ∧ (a+2 = j ∨ a+2 = k ∨ a+2 = k+1) := by decide +kernel + have hg : ∃ j : Fin 4, good j ∧ good (j+2) := by + rcases SimpleGridPathPointTrichotomy _ _ _ _ x ER.pathAB ⟨e,hxe,he⟩ with hx | hx | htwo + · have hxR := (ER.unique_common x).mpr hx |>.2 + have hzip : (R,hm) ∈ ts.zip hs := by + obtain ⟨t,ht⟩ := List.head?_eq_some_iff.mp hf.1.2.1 + obtain ⟨s,hs'⟩ := List.head?_eq_some_iff.mp hhead + simp [ht,hs'] + obtain ⟨j,l,hj,hl,hgj,hgl,hgl'⟩ := endpointGood R hm hzip htR hxR (Or.inl rfl) e hxe he + obtain ⟨a,ha,hb⟩ := endpointFinite j l hj hl + refine ⟨a,?_,?_⟩ + · rcases ha with rfl | rfl | rfl <;> assumption + · rcases hb with hb | hb | hb <;> rw [hb] <;> assumption + · have hxS := (ES.unique_common x).mpr (hx.trans hcross) |>.2 + have hzip : (S,hp) ∈ ts.zip hs := by + obtain ⟨t,ht⟩ := List.getLast?_eq_some_iff.mp hf.1.2.2.1 + obtain ⟨s,hs'⟩ := List.getLast?_eq_some_iff.mp hlast + have hlen : t.length = s.length := by + have he := List.Forall₂.length_eq hf.2.1 + rw [ht,hs',List.length_append,List.length_append] at he + simpa using he + simp [ht,hs',List.zip_append hlen] + obtain ⟨j,l,hj,hl,hgj,hgl,hgl'⟩ := endpointGood S hp hzip htS hxS (Or.inr rfl) e hxe he + obtain ⟨a,ha,hb⟩ := endpointFinite j l hj hl + refine ⟨a,?_,?_⟩ + · rcases ha with rfl | rfl | rfl <;> assumption + · rcases hb with hb | hb | hb <;> rw [hb] <;> assumption + · obtain ⟨e,f,hne,hxe,hxf,he,hf⟩ := htwo + obtain ⟨j,hj,hgj,hgj',_⟩ := edgeGood e hxe he + obtain ⟨k,hk,hgk,hgk',_⟩ := edgeGood f hxf hf + have hjk : j ≠ k := by intro h; exact hne (hj.trans (h ▸ hk.symm)) + obtain ⟨a,ha,hb⟩ := internalFinite j k hjk + refine ⟨a,?_,?_⟩ + · rcases ha with rfl | rfl | rfl | rfl <;> assumption + · rcases hb with hb | hb | hb | hb <;> rw [hb] <;> assumption + obtain ⟨j,hj,hj'⟩ := hg + intro y hy + have hycover : + (y = inc j ∨ y = inc j+1 ∨ y = inc j+⟨0,1⟩ ∨ y = inc j+1+⟨0,1⟩) ∨ + (y = inc (j+2) ∨ y = inc (j+2)+1 ∨ y = inc (j+2)+⟨0,1⟩ ∨ + y = inc (j+2)+1+⟨0,1⟩) := by + fin_cases j <;> rcases hy with rfl | rfl | rfl | rfl | rfl + all_goals simp [inc,LatticeVertexIncidentCell,Zsqrtd.ext_iff] + rcases hycover with hy | hy + · obtain ⟨T,h,hm,hc,hd,hr⟩ := hj + refine ⟨T,h,hm,?_,?_,hr⟩ + · change x ∈ (h.domain : Set GaussianInt) + rw [hd] + exact corner T (inc j) x hc (atX j) + · change y ∈ (h.domain : Set GaussianInt) + rw [hd] + exact corner T (inc j) y hc hy + · obtain ⟨T,h,hm,hc,hd,hr⟩ := hj' + refine ⟨T,h,hm,?_,?_,hr⟩ + · change x ∈ (h.domain : Set GaussianInt) + rw [hd] + exact corner T (inc (j+2)) x hc (atX (j+2)) + · change y ∈ (h.domain : Set GaussianInt) + rw [hd] + exact corner T (inc (j+2)) y hc hy + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5596T1CommonExtensionTransport.lean b/LeanPool/ApollonianSuperharmonic/P5596T1CommonExtensionTransport.lean new file mode 100644 index 0000000000..a34d371e1a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5596T1CommonExtensionTransport.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryGlobalOdometerTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.P4055T1PackingGridEquivalence + +-- [TABLET NODE: P5596T1CommonExtensionTransport] + +/-! +# P5596T1CommonExtensionTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5596T1CommonExtensionTransport + (s : BandPackingSymmetry) (g : IntegerLatticeFunction) + (h k : PartialOdometer) (x : GaussianInt) + (hg : GlobalOdometerExtends g h) (kg : GlobalOdometerExtends g k) + (hx : x ∈ h.domain) (kx : x ∈ k.domain) + (hstar : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h.domain ∨ y ∈ k.domain) : + ∃ g' : IntegerLatticeFunction, + GlobalOdometerExtends g' (BandPackingSymmetryPartialOdometerAction s h) ∧ + GlobalOdometerExtends g' (BandPackingSymmetryPartialOdometerAction s k) ∧ + FourNeighborLaplacian g' (BandPackingSymmetryVectorAction s x) = + FourNeighborLaplacian g x ∧ + BandPackingSymmetryVectorAction s x ∈ + (BandPackingSymmetryPartialOdometerAction s h).domain ∧ + BandPackingSymmetryVectorAction s x ∈ + (BandPackingSymmetryPartialOdometerAction s k).domain ∧ + ∀ y, y = BandPackingSymmetryVectorAction s x ∨ + y = BandPackingSymmetryVectorAction s x + 1 ∨ + y = BandPackingSymmetryVectorAction s x - 1 ∨ + y = BandPackingSymmetryVectorAction s x + ⟨0, 1⟩ ∨ + y = BandPackingSymmetryVectorAction s x - ⟨0, 1⟩ → + y ∈ (BandPackingSymmetryPartialOdometerAction s h).domain ∨ + y ∈ (BandPackingSymmetryPartialOdometerAction s k).domain := by +-- BODY + classical + let H : PartialOdometer := + { domain := h.domain ∪ k.domain + value := fun y => if y ∈ h.domain ∪ k.domain then g y else 0 + value_outside := by intro y hy; simp [hy] } + have hH : GlobalOdometerExtends g H := + ⟨0, by intro y hy; simp only [H, ite_eq_left hy, add_zero]⟩ + obtain ⟨g', hglobal, hlap⟩ := + BandPackingSymmetryGlobalOdometerTransport s g H x hH + obtain ⟨f, hf, _, hback⟩ := P4055T1PackingGridEquivalence s + have membership (a : PartialOdometer) (z : GaussianInt) : + BandPackingSymmetryVectorAction s z ∈ + (BandPackingSymmetryPartialOdometerAction s a).domain ↔ z ∈ a.domain := by + change _ ∈ ((BandPackingSymmetryPartialOdometerAction s a).domain : Set GaussianInt) ↔ _ + rw [(BandPackingSymmetryPartialOdometerActionFormulas s a a).1] + constructor + · rintro ⟨w, hw, he⟩ + have hwz : w = z := f.injective (by simpa only [hf] using he) + exact hwz ▸ hw + · intro hz + exact ⟨z, hz, rfl⟩ + have restrict (a : PartialOdometer) (ha : a.domain ⊆ H.domain) + (hext : GlobalOdometerExtends g a) (hxa : x ∈ a.domain) : + GlobalOdometerExtends g' (BandPackingSymmetryPartialOdometerAction s a) := by + obtain ⟨c, hc⟩ := hext + have hcompatible : OdometerCompatibility a H := by + right + refine ⟨c, ?_⟩ + intro y hy hyH + simp only [H, ite_eq_left hyH] + rw [hc y hy] + ring + have hc' := (BandPackingSymmetryPartialOdometerActionFormulas s a H).2.2.2.2.2.2.1.mpr + hcompatible + have subset : (BandPackingSymmetryPartialOdometerAction s a).domain ⊆ + (BandPackingSymmetryPartialOdometerAction s H).domain := by + intro y hy + change y ∈ ((BandPackingSymmetryPartialOdometerAction s a).domain : Set GaussianInt) at hy + rw [(BandPackingSymmetryPartialOdometerActionFormulas s a a).1] at hy + obtain ⟨z, hz, rfl⟩ := hy + exact (membership H z).mpr (ha hz) + rcases hc' with hd | ⟨d, hd⟩ + · exact (Set.disjoint_left.mp hd ((membership a x).mpr hxa) + ((membership H x).mpr (ha hxa))).elim + · obtain ⟨b, hb⟩ := hglobal + refine ⟨d + b, ?_⟩ + intro y hy + have hv := hd y hy (subset hy) + rw [hb y (subset hy)] + omega + refine ⟨g', restrict h (by intro y hy; exact Finset.mem_union_left _ hy) hg hx, + restrict k (by intro y hy; exact Finset.mem_union_right _ hy) kg kx, + hlap, (membership h x).mpr hx, (membership k x).mpr kx, ?_⟩ + intro y hy + have hy' : f.symm y = x ∨ f.symm y = x + 1 ∨ f.symm y = x - 1 ∨ + f.symm y = x + ⟨0, 1⟩ ∨ f.symm y = x - ⟨0, 1⟩ := by + rcases hy with he | hn + · left + rw [← hf x] at he + simp [he] + · right + have hn' : y = f x + 1 ∨ y = f x - 1 ∨ + y = f x + ⟨0, 1⟩ ∨ y = f x - ⟨0, 1⟩ := by simpa only [hf] using hn + simpa using hback (f x) y hn' + rcases hstar (f.symm y) hy' with hh | hk + · left + simpa only [← hf, Equiv.apply_symm_apply] using (membership h (f.symm y)).mpr hh + · right + simpa only [← hf, Equiv.apply_symm_apply] using (membership k (f.symm y)).mpr hk + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean b/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean new file mode 100644 index 0000000000..e4638b6496 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean @@ -0,0 +1,1176 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.LeftAdjacentOdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification +public import LeanPool.ApollonianSuperharmonic.P5570T1UnitNormalForm +public import LeanPool.ApollonianSuperharmonic.P5570T1UnitQuadratic +public import LeanPool.ApollonianSuperharmonic.CurvatureOnePeriodicOdometer +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryOdometerStrings +public import LeanPool.ApollonianSuperharmonic.BoundaryString +public import LeanPool.ApollonianSuperharmonic.P3996T1AdjacentParentPlacement +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentIncomingEndpoint +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleRetargetMiddle +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceDisjointCompanionEndpoints +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton +public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing +public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.P5589T1EndpointCompatibility +public import LeanPool.ApollonianSuperharmonic.P5589T1UnitInterfaceSelection +public import LeanPool.ApollonianSuperharmonic.P5589T1LinkedUnitValues +public import LeanPool.ApollonianSuperharmonic.P5596T1LineParent + +-- [TABLET NODE: P5596T1LeftWeb] + +/-! +# P5596T1LeftWeb + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace LeftWebGeometry + +private theorem hdata : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T₁ : ProtoTile), ∀ (T₂ : ProtoTile), (ℕ) → ((C.1.1.1 = (1 : ℤ)) → + (∀ (p₁ : ℝ × ℝ), ∀ (p₂ : ℝ × ℝ), ((C.1.1.1 = (1 : ℤ) ∧ ∃ (orientation : Bool) (v : + GaussianInt), UnitTriangularStep orientation v ∧ TileCentroid T₂ - TileCentroid T₁ = + GaussianRealPoint v ∧ p₂.1 - p₁.1 = CircleMatrix C (0 : Fin (2 : ℕ)) (0 : Fin (2 : + ℕ)) * (↑v.re : ℝ) + CircleMatrix C (0 : Fin (2 : ℕ)) (1 : Fin (2 : ℕ)) * (↑v.im : ℝ) + ∧ p₂.2 - p₁.2 = CircleMatrix C (1 : Fin (2 : ℕ)) (0 : Fin (2 : ℕ)) * (↑v.re : ℝ) + + CircleMatrix C (1 : Fin (2 : ℕ)) (1 : Fin (2 : ℕ)) * (↑v.im : ℝ)) ∨ ∃ (q : Fin (4 : + ℕ) → CircleCoordinates) (i : Fin (3 : ℕ)) (e : Bool), ProperBandQuadruple q ∧ q (0 : + Fin (4 : ℕ)) = C.1.1 ∧ TileCentroid T₂ - TileCentroid T₁ = (if e = true then (1 : ℝ) + else (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) ∧ + p₂.1 - p₁.1 = (if e = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (q i.succ) + (q (0 : Fin (4 : ℕ)))).re : ℝ) ∧ p₂.2 - p₁.2 = (if e = true then (1 : ℝ) else (-1 : + ℝ)) * (↑(BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))).im : ℝ)) → (∃ v : + GaussianInt, TileCentroid T₂ - TileCentroid T₁ = GaussianRealPoint v ∧ p₂.1-p₁.1 = + CircleMatrix C 0 0*v.re + CircleMatrix C 0 1*v.im ∧ p₂.2-p₁.2 = CircleMatrix C 1 + 0*v.re + CircleMatrix C 1 1*v.im))) ) := by + classical + intro C T₁ T₂ n hc p₁ p₂ hstep + rcases hstep with ⟨_, orientation, v, _, hv, hr, hi⟩ | ⟨q,i,e,hq,hqC,_⟩ + · exact ⟨v,hv,hr,hi⟩ + · have hqone : (q 0).1 = 1 := by rw [hqC, hc] + have hs := ProperBandCurvatureStructure q hq + have hn (j : Fin 3) : (q j.succ).1 = 0 := by + have hb := hq.2 j + have hzj := hs.2.1 j + omega + exact ((by decide : (0 : Fin 3) ≠ 1) + (hs.2.2 0 1 (hn 0) (hn 1))).elim + +private theorem hmatrixAt187 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (z : GaussianInt), (C.1.1 = ((1 : ℤ), (1 : GaussianInt) + (2 : + GaussianInt) * z)) → (CircleMatrix C = ![![((1+z.re : ℤ) : ℝ), (z.im : ℝ)], ![(z.im : + ℝ), (-z.re : ℝ)]]) ) := by + classical + intro C z hz + unfold CircleMatrix BandCircleEuclideanData + simp only [show C.1.1.1 = 1 by rw [hz], + show C.1.1.2 = 1+2*z by rw [hz]] + ext i j; fin_cases i <;> fin_cases j + all_goals simp only [ + Complex.div_re, Complex.div_im, GaussianInt.toComplex_def, + Complex.add_re, Complex.add_im, Complex.mul_re, Complex.mul_im, + Complex.intCast_re, Complex.intCast_im] + all_goals norm_num + all_goals ring + +private theorem har : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (u₁ : GaussianInt), ∀ (a₁ : GaussianInt), ∀ (u₂ : GaussianInt), ∀ + (a₂ : GaussianInt), (((1 : ℝ) + (↑z.re : ℝ)) * (↑u₂.re : ℝ) + (↑z.im : ℝ) * (↑u₂.im : + ℝ) + (↑a₂.re : ℝ) + (↑z.im : ℝ) / (2 : ℝ) - (((1 : ℝ) + (↑z.re : ℝ)) * (↑u₁.re : ℝ) + + (↑z.im : ℝ) * (↑u₁.im : ℝ) + (↑a₁.re : ℝ) + (↑z.im : ℝ) / (2 : ℝ)) = (↑((1 : ℤ) + + z.re) : ℝ) * ((↑u₂.re : ℝ) - (↑u₁.re : ℝ)) + (↑z.im : ℝ) * ((↑u₂.im : ℝ) - (↑u₁.im : + ℝ))) → ((a₁.re : ℝ) = a₂.re) ) := by + classical + intro z u₁ a₁ u₂ a₂ hr + push_cast at hr + nlinarith only [hr] + +private theorem hai : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (u₁ : GaussianInt), ∀ (a₁ : GaussianInt), ∀ (u₂ : GaussianInt), ∀ + (a₂ : GaussianInt), ((↑z.im : ℝ) * (↑u₂.re : ℝ) - (↑z.re : ℝ) * (↑u₂.im : ℝ) + + (↑a₂.im : ℝ) + (↑z.im : ℝ) / (2 : ℝ) - ((↑z.im : ℝ) * (↑u₁.re : ℝ) - (↑z.re : ℝ) * + (↑u₁.im : ℝ) + (↑a₁.im : ℝ) + (↑z.im : ℝ) / (2 : ℝ)) = (↑z.im : ℝ) * ((↑u₂.re : ℝ) - + (↑u₁.re : ℝ)) + -(↑z.re : ℝ) * ((↑u₂.im : ℝ) - (↑u₁.im : ℝ))) → ((a₁.im : ℝ) = a₂.im) + ) := by + classical + intro z u₁ a₁ u₂ a₂ hi + nlinarith only [hi] + +private theorem haAt220 : + (by + classical + exact + ∀ (a₁ : GaussianInt), ∀ (a₂ : GaussianInt), ((a₁.re : ℝ) = a₂.re) → (((a₁.im : ℝ) = + a₂.im) → (a₁ = a₂)) ) := by + classical + intro a₁ a₂ har hai + apply Zsqrtd.ext + · exact_mod_cast har + · exact_mod_cast hai + +private theorem hbAt227 : + (by + classical + exact + (BandCircle) → (∀ (h₁ : PartialOdometer), ∀ (h₂ : PartialOdometer), ∀ (g : + IntegerLatticeFunction), ∀ (x : GaussianInt), ∀ (c₁ : ℤ), (∀ x ∈ h₁.domain, g x = + h₁.value x + c₁) → (∀ (c₂ : ℤ), (∀ x ∈ h₂.domain, g x = h₂.value x + c₂) → ((x ∈ + h₁.domain) → ((x ∈ h₂.domain) → ((ℕ) → (∀ (z : GaussianInt), ∀ (a₁ : GaussianInt), ∀ + (b₁ : ℤ), (∀ x ∈ h₁.domain, h₁.value x = P5570T1UnitQuadratic z x + a₁.re * x.re + + a₁.im * x.im + b₁) → (∀ (b₂ : ℤ), (∀ x ∈ h₂.domain, h₂.value x = + P5570T1UnitQuadratic z x + a₁.re * x.re + a₁.im * x.im + b₂) → (b₁+c₁ = + b₂+c₂)))))))) ) := by + classical + intro C h₁ h₂ g x c₁ hg₁ c₂ hg₂ hx₁ hx₂ n z a₁ b₁ hval₁ b₂ hval₂ + have he₁ := hg₁ x hx₁ + have he₂ := hg₂ x hx₂ + rw [hval₁ x hx₁] at he₁ + rw [hval₂ x hx₂] at he₂ + omega + +private theorem hvalues : + (by + classical + exact + (BandCircle) → (∀ (h₁ : PartialOdometer), ∀ (h₂ : PartialOdometer), ∀ (g : + IntegerLatticeFunction), ∀ (x : GaussianInt), ∀ (c₁ : ℤ), (∀ x ∈ h₁.domain, g x = + h₁.value x + c₁) → (∀ (c₂ : ℤ), (∀ x ∈ h₂.domain, g x = h₂.value x + c₂) → ((∀ (y : + GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ + h₁.domain ∨ y ∈ h₂.domain) → ((ℕ) → (∀ (z : GaussianInt), ∀ (a₁ : GaussianInt), ∀ (b₁ + : ℤ), (∀ x ∈ h₁.domain, h₁.value x = P5570T1UnitQuadratic z x + a₁.re * x.re + + a₁.im * x.im + b₁) → (∀ (b₂ : ℤ), (∀ x ∈ h₂.domain, h₂.value x = + P5570T1UnitQuadratic z x + a₁.re * x.re + a₁.im * x.im + b₂) → ((b₁+c₁ = b₂+c₂) → + (∀ (y : GaussianInt), (y = x ∨ y = x+1 ∨ y = x-1 ∨ + y = x+⟨0,1⟩ ∨ y = x-⟨0,1⟩) → (g y = P5570T1UnitQuadratic z y + a₁.re*y.re + + a₁.im*y.im + (b₁+c₁)))))))))) ) := by + classical + intro C h₁ h₂ g x c₁ hg₁ c₂ hg₂ hstar n z a₁ b₁ hval₁ b₂ hval₂ hb y hy + rcases hstar y hy with hy₁ | hy₂ + · rw [hg₁ y hy₁, hval₁ y hy₁] + ring + · rw [hg₂ y hy₂, hval₂ y hy₂] + omega + +private theorem translationAt244 : + (by + classical + exact + ∀ (C : BandCircle), (IntegerLatticeFunction) → (∀ (x : GaussianInt), (C.1.1.1 = (1 : + ℤ)) → (∀ (z : GaussianInt), (CircleMatrix C = ![![(↑((1 : ℤ) + z.re) : ℝ), (↑z.im : + ℝ)], ![(↑z.im : ℝ), -(↑z.re : ℝ)]]) → (( + let g := fun (x : GaussianInt) => ((1 : ℤ) + z.re) * (x.re * (x.re - (1 : ℤ)) / (2 : ℤ)) + - z.re * (x.im * (x.im - (1 : ℤ)) / (2 : ℤ)) + z.im * x.re * x.im; + let T := (⟨{(0 : LatticeCell)}, (0 : GaussianInt)⟩ : ProtoTile); + let h := CurvatureOneOdometer z; BandPrototile C.1.1 T ∧ TileOdometer C.1.1 T h ∧ + (↑h.domain : Set GaussianInt) = FootprintVertices T ∧ (∀ x ∈ h.domain, g x = h.value + x) ∧ GlobalOdometerExtends g h ∧ IntegerSuperharmonicRepresentative (CircleMatrix C) + g ∧ (∀ v ∈ TilingLattice C, ∃ (a : GaussianInt), (CircleMatrix C).mulVec ![(↑v.re : + ℝ), (↑v.im : ℝ)] = ![(↑a.re : ℝ), (↑a.im : ℝ)] ∧ ∀ (x : GaussianInt), g (x + v) = g x + + x.re * a.re + x.im * a.im + g v) ∧ ∃ (b : ℝ × ℝ), ∀ v ∈ TilingLattice C, ∀ (x : + GaussianInt), (↑(g (x + v)) : ℝ) - LatticeQuadraticForm (CircleMatrix C) (x + v) - + (b.1 * (↑(x + v).re : ℝ) + b.2 * (↑(x + v).im : ℝ)) = (↑(g x) : ℝ) - + LatticeQuadraticForm (CircleMatrix C) x - (b.1 * (↑x.re : ℝ) + b.2 * (↑x.im : ℝ))) → + (∀ (v : GaussianInt), P5570T1UnitQuadratic z (x+v) = P5570T1UnitQuadratic z x + + P5570T1UnitQuadratic z v + ((1+z.re)*v.re+z.im*v.im)*x.re + + (z.im*v.re-z.re*v.im)*x.im))))) := by + classical + intro C g x hc z hmatrix hperiodic v + obtain ⟨w, hw, hshift⟩ := hperiodic.2.2.2.2.2.2.1 v + (by simp [TilingLattice, hc]) + have hr : (1+z.re)*v.re+z.im*v.im = w.re := by + have he := congrFun hw 0 + simp only [hmatrix, Matrix.mulVec, dotProduct, Fin.sum_univ_two, + Matrix.cons_val_zero, Matrix.cons_val_one] at he + exact_mod_cast he + have hi : z.im*v.re-z.re*v.im = w.im := by + have he := congrFun hw 1 + simp only [hmatrix, Matrix.mulVec, dotProduct, Fin.sum_univ_two, + Matrix.cons_val_zero, Matrix.cons_val_one] at he + have he' : z.im*v.re + -z.re*v.im = w.im := by exact_mod_cast he + linear_combination he' + have he : P5570T1UnitQuadratic z (x+v) = + P5570T1UnitQuadratic z x + x.re*w.re + x.im*w.im + + P5570T1UnitQuadratic z v := hshift x + rw [← hr, ← hi] at he + linear_combination he + +private theorem hq : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (z : GaussianInt), ∀ (a₁ : GaussianInt), ∀ (b₁ : ℤ), ∀ (c₁ : ℤ), + (∀ (v : GaussianInt), P5570T1UnitQuadratic z (x+v) = P5570T1UnitQuadratic z x + + P5570T1UnitQuadratic z v + ((1+z.re)*v.re+z.im*v.im)*x.re + + (z.im*v.re-z.re*v.im)*x.im) → (FourNeighborLaplacian (fun y => P5570T1UnitQuadratic + z y + a₁.re*y.re + a₁.im*y.im + (b₁+c₁)) x = 1) ) := by + classical + intro x z a₁ b₁ c₁ translation + have h1 := translation 1 + have hm1 := translation (-1) + have hi := translation ⟨0,1⟩ + have hmi := translation (-⟨0,1⟩) + simp only [sub_eq_add_neg, FourNeighborLaplacian] + rw [h1, hm1, hi, hmi] + norm_num [P5570T1UnitQuadratic] + ring + +private theorem hcminus3 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ + (Rminus : ProtoTile), (TileCentroid Rminus - TileCentroid U = (1 / 2 : ℝ) • + GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) - BandVectors.1 (q + (0 : Fin (4 : ℕ))) (q i.succ))) → ((BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) = + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + → (TileCentroid Rminus - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ + : GaussianInt) ^ (3 : Fin 4).val * (BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q + 0) (q i.succ))))) ) := by + classical + intro q i U Rminus hcminus flip + rw [hcminus, flip] + congr 2 + ext <;> simp [pow_succ] <;> ring + +private theorem hmstep : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (BandVectors.1 (q (0 : Fin + (4 : ℕ))) (q i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q i.succ) + (q (0 : Fin (4 : ℕ)))) → ((⟨0, 1⟩ : GaussianInt) ^ (3 : Fin 4).val * (if Even (3 : + Fin 4).val then BandVectors.1 (q i.succ) (q 0) else BandVectors.1 (q 0) (q i.succ)) = + BandVectors.1 (q i.succ) (q 0)) ) := by + classical + intro q i flip + rw [flip] + norm_num [show ¬ Even 3 by decide, pow_succ] + ext <;> simp + +private theorem hd : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), (TileCentroid V - TileCentroid U = GaussianRealPoint (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))))) → (∀ (d : GaussianInt), (FootprintVertices V = + FootprintVertices (TileTranslation U d) ∧ BoundaryFootprintVertices V = + BoundaryFootprintVertices (TileTranslation U d) ∧ BoundaryFootprintEdges V = + BoundaryFootprintEdges (TileTranslation U d) ∧ TileRealization V = TileRealization + (TileTranslation U d) ∧ TileCentroid V = TileCentroid (TileTranslation U d)) → (d = + BandVectors.1 (q i.succ) (q 0))) ) := by + classical + intro q i U V hcUV d hobs + have he := hcUV + rw [hobs.2.2.2.2, (TileTranslationFormulas U d).2.2.2.2.1] at he + have hre := congrArg Prod.fst he + have him := congrArg Prod.snd he + dsimp [GaussianRealPoint] at hre him + apply Zsqrtd.ext + · have he : (d.re : Real) = (BandVectors.1 (q i.succ) (q 0)).re := by + linarith + exact_mod_cast he + · have he : (d.im : Real) = (BandVectors.1 (q i.succ) (q 0)).im := by + linarith + exact_mod_cast he + +private theorem haMV : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), + let M := TileTranslation U (BandVectors.1 (q i.succ) (q 0)) + (V.cells = (TileTranslation U (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))).cells) → + ((V.cells = ∅ → V.anchor = (TileTranslation U (BandVectors.1 (q i.succ) (q (0 : Fin + (4 : ℕ))))).anchor) → (M.cells = ∅ → M.anchor = V.anchor)) ) := by + classical + intro q i U V M hcells hanchor hempty + exact (hanchor (hcells.trans hempty)).symm + +private theorem hnV : + (by + classical + exact + (BandCircle) → ((ℕ) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), (Fin (3 : ℕ)) → + ((ProperBandQuadruple q) → ((ProtoTile) → (∀ (V : ProtoTile), (LatticeTile V ∧ + TileArea V = (q (0 : Fin (4 : ℕ))).1.toNat ∧ (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q V i s (S i s)) → (∀ + (x : LatticeCell), x ∈ V.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i + s).cells) → ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), LatticeTile (TileCellComplement V + (S i s)) ∧ + TileTouching (TileCellComplement V (S i s)) (S i s)) ∧ QuarterTurnSymmetric V ∧ ((1 : + ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), TouchingTriple V (TileTranslation + V (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation V + (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) ∧ ((1 : ℤ) + < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile (q + i.succ) U → TileCentroid U - TileCentroid V = (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 + (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple V (TileTranslation V + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (U : + ProtoTile), ∀ (V_1 : ProtoTile), BandPrototile (q i.succ) U → BandPrototile (q (i + + (1 : Fin (3 : ℕ))).succ) V_1 → TileCentroid U - TileCentroid V = (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid + V_1 - TileCentroid V = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : + Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : + Fin (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple V U V_1) ∧ ∀ (r : + Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 + : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q + (3 : Fin (4 : ℕ)) → (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → (q (3 : Fin + (4 : ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → ∀ (P : + Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin + (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence q V i s (P i s)) → (∀ (x : LatticeCell), x ∈ V.cells ↔ ∃ (i : + Fin (3 : ℕ)) (s : Bool), x ∈ (P i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence r (P (0 : Fin (3 : ℕ)) true) i s (Q i s)) → (∀ (x : + LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), + x ∈ (Q i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P + (0 : Fin (3 : ℕ)) false) i s (S i s)) → (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : + ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → + let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); (∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty → AllowedSubtileIncidence a b) ∧ + (¬AllowedSubtileIncidence a b → FootprintVertices (SubtileOccurrenceInterpretation P + u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ FootprintVertices (P (0 : + Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ⊆ FootprintVertices + (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ + FootprintVertices (P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (0 : Fin (3 : ℕ)) + false) ⊆ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin + (3 : ℕ)) false) ∪ FootprintVertices (Q (0 : Fin (3 : ℕ)) false) ∪ FootprintVertices + (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → + (V.cells ≠ ∅)))))) ) := by + classical + intro C n q i hq U V hgeomV + have harea := hgeomV.2.1 + have hcpos := (ProperBandCurvatureStructure q hq).1 + intro he + simp only [TileArea, he, Finset.card_empty] at harea + omega + +private theorem touchingRetarget : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), + let M := TileTranslation U (BandVectors.1 (q i.succ) (q 0)) + (M.cells = V.cells) → ((FootprintVertices M = FootprintVertices V ∧ + BoundaryFootprintVertices M = BoundaryFootprintVertices V ∧ BoundaryFootprintEdges M + = BoundaryFootprintEdges V ∧ TileRealization M = TileRealization V ∧ TileCentroid M = + TileCentroid V) → ((V.cells ≠ ∅) → (∀ (W : ProtoTile), (TouchingTriple U M W) → + (TouchingTriple U V W)))) ) := by + classical + intro q i U V M hMV hobsMV hnV W ht + simpa only [TouchingTriple, TileTouching, hMV, + hobsMV.2.1, hobsMV.2.2.1, hnV, false_and, and_false, + false_or, or_false] using ht + +private theorem hsingletonDisk : + (by + classical + exact + ∀ (W : ProtoTile), ∀ (u : GaussianInt), (W.cells = {u}) → (LatticeTile W) ) := by + classical + intro W u hu + have hc : W.cells = (TileTranslation (FordTile 1) u).cells := by + simpa [TileTranslation, FordTile, FordCellDomain, GaussianTranslation, + show (⟨0, 0⟩ : GaussianInt) = 0 from rfl] using hu + have ho := ProtoTileObservableExtensionality W _ hc + (by simp [hu]) + change TopologicalDisk (TileRealization W) + rw [ho.2.2.2.1] + exact (TileDiskAreaCovariance (FordTile 1) u).1.mp + (FordTileGeometry 1 (by decide)).1 + +private theorem hdisjoint : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (ProperBandQuadruple q) → + (∀ (U : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), (TileCentroid + Rminus - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q i.succ) + (q (0 : Fin (4 : ℕ))) - BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → + ((TileCentroid Rplus - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) + (q i.succ))) → (∀ (um : GaussianInt), (Rminus.cells = {um}) → (∀ (up : GaussianInt), + (Rplus.cells = {up}) → (Disjoint Rplus.cells Rminus.cells))))) ) := by + classical + intro q i hq U Rminus Rplus hcminus hcplus um hum up hup + have hneq : up ≠ um := by + intro he + have hec : TileCentroid Rplus = TileCentroid Rminus := by + simp [TileCentroid, hup, hum, he] + have hre := congrArg Prod.fst hcplus + have him := congrArg Prod.snd hcplus + have hre' := congrArg Prod.fst hcminus + have him' := congrArg Prod.snd hcminus + rw [hec] at hre him + have hz : BandVectors.1 (q 0) (q i.succ) = 0 := by + apply Zsqrtd.ext + · have : ((BandVectors.1 (q 0) (q i.succ)).re : Real) = 0 := by + dsimp [GaussianRealPoint] at hre hre' + push_cast at hre hre' + linarith + exact_mod_cast this + · have : ((BandVectors.1 (q 0) (q i.succ)).im : Real) = 0 := by + dsimp [GaussianRealPoint] at him him' + push_cast at him him' + linarith + exact_mod_cast this + exact VectorNonvanishing q hq.1 0 i.succ + (Ne.symm (Fin.succ_ne_zero i)) + (Or.inl (ProperBandCurvatureStructure q hq).1) hz + simpa [hup, hum] using hneq + +private theorem hplusU : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (Rplus : ProtoTile), (TouchingTriple U V Rplus) → + (∀ (up : GaussianInt), (Rplus.cells = {up}) → (Disjoint U.cells Rplus.cells)) ) := by + classical + intro U V Rplus htouchPlus up hup + rcases htouchPlus.2.2.1 with h | h | h + · exact h.2.2.1.symm + · simp [hup] at h + · simp [h.1] + +private theorem hplusV : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (Rplus : ProtoTile), (V.cells ≠ ∅) → + ((TouchingTriple U V Rplus) → (∀ (up : GaussianInt), (Rplus.cells = {up}) → (Disjoint + V.cells Rplus.cells))) ) := by + classical + intro U V Rplus hnV htouchPlus up hup + rcases htouchPlus.2.1 with h | h | h + · exact h.2.2.1 + · exact (hnV h.1).elim + · simp [hup] at h + +private theorem hRS : + (by + classical + exact + ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (up : GaussianInt), (Rplus.cells = {up}) + → ((Disjoint Rplus.cells Rminus.cells) → (Rminus ≠ Rplus)) ) := by + classical + intro Rminus Rplus up hup hdisjoint he + have hn : up ∈ Rminus.cells := by rw [he, hup]; simp + exact Finset.disjoint_left.mp hdisjoint (by simp [hup]) hn + +private theorem hnorm : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (ProperBandQuadruple q) → + (((q i.succ).1 = (1 : ℤ)) → (Zsqrtd.norm (BandVectors.1 (q 0) (q i.succ)) = (q + 0).1+1)) ) := by + classical + intro q i hq hunit + have hs := (VectorSquareProduct q hq.1 0 i.succ + (Ne.symm (Fin.succ_ne_zero i))).1 + have ht := TangencyCoordinateIdentity q hq.1 0 i.succ + (Ne.symm (Fin.succ_ne_zero i)) + have he : Zsqrtd.norm (BandVectors.1 (q 0) (q i.succ)) ^ 2 = + ((q 0).1+1)^2 := by + rw [pow_two, ← Zsqrtd.norm_mul, ← pow_two, hs, ht, hunit] + have hn := Zsqrtd.norm_nonneg (by norm_num : (-1 : ℤ) ≤ 0) + (BandVectors.1 (q 0) (q i.succ)) + have hp := (ProperBandCurvatureStructure q hq).1 + nlinarith + +private theorem hnadj : + (by + classical + exact + (BandCircle) → ((ℕ) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ + (hq : ProperBandQuadruple q), ((q i.succ).1 = (1 : ℤ)) → (∀ (hpos : 0 < (q i.succ).1), + let Ci : BandCircle := + ⟨⟨q i.succ, Or.inl hpos, q, hq.1, i.succ, rfl⟩, hpos⟩ + ∀ (U : ProtoTile), (ProtoTile) → (∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus + : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (reverseTiles : + List ProtoTile), ∀ (hs : List PartialOdometer), ∀ (reverseHs : List PartialOdometer), + (TileString Ci orientation base Rplus Rminus reverseTiles) → ((OdometerStringRespect + Ci orientation base Rminus Rplus tiles hs) → ((OdometerStringRespect Ci orientation + base Rplus Rminus reverseTiles reverseHs) → (∀ (r : Fin (4 : ℕ) → CircleCoordinates), + (Ci.1.1.1 = (1 : ℤ) → UnitOccurrenceOrientation r i orientation) → ((TileString Ci + orientation base Rminus Rplus tiles) → ((TileCentroid Rminus - TileCentroid U = (1 / + 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) - + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((TileCentroid Rplus - + TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((Zsqrtd.norm + (BandVectors.1 (q 0) (q i.succ)) = (q 0).1+1) → (¬ ∃ v : GaussianInt, + UnitTriangularStep orientation v ∧ TileCentroid Rplus - TileCentroid Rminus = + GaussianRealPoint v)))))))))))) ) := by + classical + intro C n q i hq hunit hpos Ci U V orientation base Rminus Rplus tiles reverseTiles hs + reverseHs hreverse hrespect hreverseRespect r horientation hstring hcminus hcplus hnorm + rintro ⟨v,hv,hcv⟩ + have hveq : v = BandVectors.1 (q 0) (q i.succ) := by + apply Zsqrtd.ext + · have hr := congrArg Prod.fst hcv + have hm := congrArg Prod.fst hcminus + have hp := congrArg Prod.fst hcplus + dsimp [GaussianRealPoint] at hr hm hp + push_cast at hm hp + have he : (v.re : ℝ) = + ((BandVectors.1 (q 0) (q i.succ)).re : ℝ) := by linarith + exact_mod_cast he + · have hr := congrArg Prod.snd hcv + have hm := congrArg Prod.snd hcminus + have hp := congrArg Prod.snd hcplus + dsimp [GaussianRealPoint] at hr hm hp + push_cast at hm hp + have he : (v.im : ℝ) = + ((BandVectors.1 (q 0) (q i.succ)).im : ℝ) := by linarith + exact_mod_cast he + have hvnorm : Zsqrtd.norm v ≤ 2 := by + cases orientation <;> simp only [UnitTriangularStep, Bool.false_eq_true, + ite_false, ite_true, Finset.mem_insert, + Finset.mem_singleton] at hv + all_goals rcases hv with rfl | rfl | rfl | rfl | rfl | rfl + all_goals norm_num [Zsqrtd.norm] + rw [hveq, hnorm] at hvnorm + have hlt := hq.2 i + omega + +private theorem hUn : + (by + classical + exact + (BandCircle) → ((ℕ) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), (Fin (3 : ℕ)) → + ((ProperBandQuadruple q) → (∀ (U : ProtoTile), ∀ (V : ProtoTile), (LatticeTile U ∧ + TileArea U = (q (0 : Fin (4 : ℕ))).1.toNat ∧ (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q U i s (S i s)) → (∀ + (x : LatticeCell), x ∈ U.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i + s).cells) → ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), LatticeTile (TileCellComplement U + (S i s)) ∧ + TileTouching (TileCellComplement U (S i s)) (S i s)) ∧ QuarterTurnSymmetric U ∧ ((1 : + ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), TouchingTriple U (TileTranslation + U (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation U + (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) ∧ ((1 : ℤ) + < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), ∀ (U_1 : ProtoTile), BandPrototile + (q i.succ) U_1 → TileCentroid U_1 - TileCentroid U = (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 + (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple U (TileTranslation U + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U_1) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (U_1 + : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U_1 → BandPrototile (q + (i + + (1 : Fin (3 : ℕ))).succ) V → TileCentroid U_1 - TileCentroid U = (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V + - TileCentroid U = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin + (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin + (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple U U_1 V) ∧ ∀ (r : Fin + (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : + Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 + : Fin (4 : ℕ)) → (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → (q (3 : Fin (4 : + ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → ∀ (P : Fin (3 + : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) + → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q U i + s (P i s)) → (∀ (x : LatticeCell), x ∈ U.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ + (P i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : + Fin (3 : ℕ)) true) i s (Q i s)) → (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) + true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (Q i s).cells) → (∀ (i : Fin (3 : + ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : Fin (3 : ℕ)) false) i s (S i s)) → + (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s + : Bool), x ∈ (S i s).cells) → + let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); (∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty → AllowedSubtileIncidence a b) ∧ + (¬AllowedSubtileIncidence a b → FootprintVertices (SubtileOccurrenceInterpretation P + u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ FootprintVertices (P (0 : + Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ⊆ FootprintVertices + (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ + FootprintVertices (P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (0 : Fin (3 : ℕ)) + false) ⊆ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin + (3 : ℕ)) false) ∪ FootprintVertices (Q (0 : Fin (3 : ℕ)) false) ∪ FootprintVertices + (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → + ((LatticeTile V ∧ TileArea V = (q (0 : Fin (4 : ℕ))).1.toNat ∧ (∀ (S : Fin (3 : ℕ) → + Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q V i s + (S i s)) → (∀ (x : LatticeCell), x ∈ V.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S + i s).cells) → ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), LatticeTile (TileCellComplement V (S + i s)) ∧ TileTouching (TileCellComplement V (S i s)) (S i s)) ∧ QuarterTurnSymmetric V + ∧ ((1 : ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), TouchingTriple V + (TileTranslation V (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation + V (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) ∧ ((1 : + ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile + (q i.succ) U → TileCentroid U - TileCentroid V = (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 + (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple V (TileTranslation V + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (U : + ProtoTile), ∀ (V_1 : ProtoTile), BandPrototile (q i.succ) U → BandPrototile (q (i + + (1 : Fin (3 : ℕ))).succ) V_1 → TileCentroid U - TileCentroid V = (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid + V_1 - TileCentroid V = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : + Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : + Fin (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple V U V_1) ∧ ∀ (r : + Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 + : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q + (3 : Fin (4 : ℕ)) → (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → (q (3 : Fin + (4 : ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → ∀ (P : + Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin + (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence q V i s (P i s)) → (∀ (x : LatticeCell), x ∈ V.cells ↔ ∃ (i : + Fin (3 : ℕ)) (s : Bool), x ∈ (P i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + BandSubtileOccurrence r (P (0 : Fin (3 : ℕ)) true) i s (Q i s)) → (∀ (x : + LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), + x ∈ (Q i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P + (0 : Fin (3 : ℕ)) false) i s (S i s)) → (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : + ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → + let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); (∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges + (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b)).Nonempty → AllowedSubtileIncidence a b) ∧ + (¬AllowedSubtileIncidence a b → FootprintVertices (SubtileOccurrenceInterpretation P + u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ + (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ FootprintVertices (P (0 : + Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ⊆ FootprintVertices + (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ + FootprintVertices (P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (0 : Fin (3 : ℕ)) + false) ⊆ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin + (3 : ℕ)) false) ∪ FootprintVertices (Q (0 : Fin (3 : ℕ)) false) ∪ FootprintVertices + (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → + (U.cells.Nonempty)))))) ) := by + classical + intro C n q i hq U V hgeomU hgeomV + have ha := hgeomU.2.1 + have hp := (ProperBandCurvatureStructure q hq).1 + by_contra he + simp only [TileArea, Finset.not_nonempty_iff_eq_empty.mp he, + Finset.card_empty] at ha + omega + +private theorem hmatrixAt529 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (hq : ProperBandQuadruple + q), ∀ (hpos : 0 < (q i.succ).1), + let Ci : BandCircle := + ⟨⟨q i.succ, Or.inl hpos, q, hq.1, i.succ, rfl⟩, hpos⟩ + ∀ (z : GaussianInt), (Ci.1.1 = ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z)) → + ((Ci.1.1.1 = 1) → (CircleMatrix Ci = ![![((1+z.re : ℤ) : ℝ), (z.im : ℝ)], ![(z.im : + ℝ), (-z.re : ℝ)]])) ) := by + classical + intro q i hq hpos Ci z hz hCiunit + unfold CircleMatrix BandCircleEuclideanData + simp only [hCiunit, show Ci.1.1.2 = 1+2*z by rw [hz]] + ext j k; fin_cases j <;> fin_cases k + all_goals simp only [ + Complex.div_re, Complex.div_im, + GaussianInt.toComplex_def, Complex.add_re, Complex.add_im, Complex.mul_re, + Complex.mul_im, Complex.intCast_re, Complex.intCast_im] + all_goals norm_num + all_goals ring + +private theorem translationAt543 : + (by + classical + exact + (IntegerLatticeFunction) → (∀ (x : GaussianInt), ∀ (q : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (hq : ProperBandQuadruple q), ∀ (hpos : 0 + < (q i.succ).1), + let Ci : BandCircle := + ⟨⟨q i.succ, Or.inl hpos, q, hq.1, i.succ, rfl⟩, hpos⟩ + ∀ (z : GaussianInt), (Ci.1.1.1 = 1) → ((CircleMatrix Ci = ![![((1+z.re : ℤ) : ℝ), (z.im : + ℝ)], ![(z.im : ℝ), (-z.re : ℝ)]]) → (( + let g := fun (x : GaussianInt) => ((1 : ℤ) + z.re) * (x.re * (x.re - (1 : ℤ)) / (2 : ℤ)) + - z.re * (x.im * (x.im - (1 : ℤ)) / (2 : ℤ)) + z.im * x.re * x.im; + let T := (⟨{(0 : LatticeCell)}, (0 : GaussianInt)⟩ : ProtoTile); + let h := CurvatureOneOdometer z; BandPrototile Ci.1.1 T ∧ TileOdometer Ci.1.1 T h ∧ + (↑h.domain : Set GaussianInt) = FootprintVertices T ∧ (∀ x ∈ h.domain, g x = h.value + x) ∧ GlobalOdometerExtends g h ∧ IntegerSuperharmonicRepresentative (CircleMatrix Ci) + g ∧ (∀ v ∈ TilingLattice Ci, ∃ (a : GaussianInt), (CircleMatrix Ci).mulVec ![(↑v.re : + ℝ), (↑v.im : ℝ)] = ![(↑a.re : ℝ), (↑a.im : ℝ)] ∧ ∀ (x : GaussianInt), g (x + v) = g x + + x.re * a.re + x.im * a.im + g v) ∧ ∃ (b : ℝ × ℝ), ∀ v ∈ TilingLattice Ci, ∀ (x : + GaussianInt), (↑(g (x + v)) : ℝ) - LatticeQuadraticForm (CircleMatrix Ci) (x + v) - + (b.1 * (↑(x + v).re : ℝ) + b.2 * (↑(x + v).im : ℝ)) = (↑(g x) : ℝ) - + LatticeQuadraticForm (CircleMatrix Ci) x - (b.1 * (↑x.re : ℝ) + b.2 * (↑x.im : ℝ))) → + (∀ (v : GaussianInt), P5570T1UnitQuadratic z (x+v) = P5570T1UnitQuadratic z x + + P5570T1UnitQuadratic z v + ((1+z.re)*v.re+z.im*v.im)*x.re + + (z.im*v.re-z.re*v.im)*x.im))))) := by + classical + intro g x q i hq hpos Ci z hCiunit hmatrix hperiodic v + obtain ⟨w,hw,hshift⟩ := hperiodic.2.2.2.2.2.2.1 v + (by simp [TilingLattice, hCiunit]) + have hr : (1+z.re)*v.re+z.im*v.im = w.re := by + have he := congrFun hw 0 + simp only [hmatrix, Matrix.mulVec, dotProduct, Fin.sum_univ_two, + Matrix.cons_val_zero, Matrix.cons_val_one] at he + exact_mod_cast he + have hi : z.im*v.re-z.re*v.im = w.im := by + have he := congrFun hw 1 + simp only [hmatrix, Matrix.mulVec, dotProduct, Fin.sum_univ_two, + Matrix.cons_val_zero, Matrix.cons_val_one] at he + have he' : z.im*v.re + -z.re*v.im = w.im := by exact_mod_cast he + linear_combination he' + have he : P5570T1UnitQuadratic z (x+v) = + P5570T1UnitQuadratic z x + x.re*w.re + x.im*w.im + + P5570T1UnitQuadratic z v := hshift x + rw [← hr, ← hi] at he + linear_combination he + +private theorem hquad : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (z : GaussianInt), ∀ (A : GaussianInt), ∀ (B : ℤ), (∀ (v : + GaussianInt), P5570T1UnitQuadratic z (x+v) = P5570T1UnitQuadratic z x + + P5570T1UnitQuadratic z v + ((1+z.re)*v.re+z.im*v.im)*x.re + + (z.im*v.re-z.re*v.im)*x.im) → (FourNeighborLaplacian (fun y => P5570T1UnitQuadratic + z y + A.re*y.re + A.im*y.im + B) x = 1) ) := by + classical + intro x z A B translation + have h1 := translation 1 + have hm1 := translation (-1) + have hi := translation ⟨0,1⟩ + have hmi := translation (-⟨0,1⟩) + simp only [sub_eq_add_neg, FourNeighborLaplacian] + rw [h1,hm1,hi,hmi] + norm_num [P5570T1UnitQuadratic] + ring + +private theorem hposAt619 : + (by + classical + exact + (BandCircle) → ((ℕ) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), + (ProperBandQuadruple q) → ((¬(q i.succ).1 = (0 : ℤ)) → (0 < (q i.succ).1)))) ) := by + classical + intro C n q i hq hzero + have hnonneg := (ProperBandCurvatureStructure q hq).2.1 i + omega + +private theorem hgf : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T₁ : ProtoTile), ∀ (h₁ : PartialOdometer), ∀ (g : + IntegerLatticeFunction), (GlobalOdometerExtends g h₁) → (∀ (q : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (hq : ProperBandQuadruple q), ∀ (hpos : 0 + < (q i.succ).1), + let Ci : BandCircle := + ⟨⟨q i.succ, Or.inl hpos, q, hq.1, i.succ, rfl⟩, hpos⟩ + ∀ (U : ProtoTile), ∀ (f : PartialOdometer), (AncestorOdometer Ci.1.1 C.1.1 U T₁ f h₁) → + (GlobalOdometerExtends g f)) ) := by + classical + intro C T₁ h₁ g hg₁ q i hq hpos Ci U f ha + obtain ⟨c, hc⟩ := hg₁ + refine ⟨c, ?_⟩ + intro y hy + rw [hc y (ha.2.2.2.1 hy), ha.2.2.2.2 y hy] + +private theorem hgk : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T₂ : ProtoTile), ∀ (h₂ : PartialOdometer), ∀ (g : + IntegerLatticeFunction), (GlobalOdometerExtends g h₂) → (∀ (q : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (hq : ProperBandQuadruple q), ∀ (hpos : 0 + < (q i.succ).1), + let Ci : BandCircle := + ⟨⟨q i.succ, Or.inl hpos, q, hq.1, i.succ, rfl⟩, hpos⟩ + ∀ (V : ProtoTile), ∀ (k : PartialOdometer), (AncestorOdometer Ci.1.1 C.1.1 V T₂ k h₂) → + (GlobalOdometerExtends g k)) ) := by + classical + intro C T₂ h₂ g hg₂ q i hq hpos Ci V k hb + obtain ⟨c, hc⟩ := hg₂ + refine ⟨c, ?_⟩ + intro y hy + rw [hc y (hb.2.2.2.1 hy), hb.2.2.2.2 y hy] + +private theorem hbelow : + (by + classical + exact + ∀ (C : BandCircle), ∀ (n : ℕ), (C.1.1.1.toNat = n) → ((¬C.1.1.1 = (1 : ℤ)) → (∀ (q : Fin + (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (hq : ProperBandQuadruple q), (q + (0 : Fin (4 : ℕ)) = C.1.1) → ((¬(q i.succ).1 = (1 : ℤ)) → ((¬(q i.succ).1 = (0 : ℤ)) + → (∀ (hpos : 0 < (q i.succ).1), + let Ci : BandCircle := + ⟨⟨q i.succ, Or.inl hpos, q, hq.1, i.succ, rfl⟩, hpos⟩ + Ci.1.1.1.toNat < n))))) ) := by + classical + intro C n hn hc q i hq hqC hunit hzero hpos Ci + have hlt := hq.2 i + rw [hqC] at hlt + have hCpos := C.2 + change (q i.succ).1.toNat < n + omega + +end LeftWebGeometry + +namespace LeftWebStep + +private theorem positiveStep : + (by + classical + exact + ∀ (C : BandCircle), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), (ℕ) → (∀ (q : + Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (ProperBandQuadruple + q) → ((q (0 : Fin (4 : ℕ)) = C.1.1) → (((q i.succ).1 = (1 : ℤ)) → ((0 < (q + i.succ).1) → (∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (f : PartialOdometer), ∀ (k : + PartialOdometer), ∀ (p : Real × Real), ∀ (p' : Real × Real), (TileOdometer C.1.1 + U f) → ((TileOdometer + C.1.1 V k) → ((PartialOdometerSlope f = some p) → ((PartialOdometerSlope k = some p') + → ((TileCentroid V - TileCentroid U = + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) → ((p' - p = GaussianRealPoint + (BandVectors.2 (q i.succ) (q 0))) → ((OdometerCompatibility f k) → + ((GlobalOdometerExtends g f) → ((GlobalOdometerExtends g k) → ((x ∈ f.domain) → + ((x ∈ k.domain) → ((∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ f.domain ∨ y ∈ k.domain) → (FourNeighborLaplacian g x = 1)))))))))))))))))) := by + classical + intro C g x n q i hq hqC hunit hpos U V f k p p' hOf hOk hpf hpk hcUV hpUV hcomp hgf hgk hxf + hxk hcover + let Ci : BandCircle := + ⟨⟨q i.succ, Or.inl hpos, q, hq.1, i.succ, rfl⟩, hpos⟩ + classical + obtain ⟨orientation, centerShift, base, Rminus, Rplus, + tiles, reverseTiles, hs, reverseHs, hminus, hplus, + pminus, pplus, a, b, bminus, bplus, + hboundary, hminusCells, hplusCells, hcellPairs, + hreverse, hrespect, hreverseRespect, hhead, hlast, + hreverseHead, hreverseLast, hOminus, hOplus, + hsminus, hsplus, hpminus, hpplus, houterReflection, + hplusReflection, hminusReflection, hancestors, hreverseAncestors⟩ := + OpposingBoundaryOdometerStrings q hq C Ci i hqC rfl + U V f k hOf hOk hpos p p' hpf hpk hcUV hpUV + obtain ⟨r, hrproper, hrC, hrCi, hUband, horientation, + hstring, hcminus, hcplus⟩ := hboundary + -- The boundary string may use another proper presentation. + have hforward : BandVectors.1 (r i.succ) (r 0) = + BandVectors.1 (q i.succ) (q 0) := by rw [hrCi, hrC, hqC] + have hbackward : BandVectors.1 (r 0) (r i.succ) = + BandVectors.1 (q 0) (q i.succ) := by rw [hrCi, hrC, hqC] + rw [hforward, hbackward] at hcminus hcplus + have hU : BandPrototile (q 0) U := by simpa only [hqC] using hUband + have hV : BandPrototile (q 0) V := by + simpa only [hqC] using TileOdometerBandPrototile _ _ _ hOk + have hRm : BandPrototile (q i.succ) Rminus := + TileOdometerBandPrototile _ _ _ hOminus + have hRp : BandPrototile (q i.succ) Rplus := + TileOdometerBandPrototile _ _ _ hOplus + have flip := ((VectorRecursionLaws q hq.1).2.2.2.2 hq i).1 + obtain ⟨Zm, hZm, hcZm⟩ := + P3996T1AdjacentParentPlacement q hq i 3 U hU + obtain ⟨Zp, hZp, hcZp⟩ := + P3996T1AdjacentParentPlacement q hq i 0 U hU + have hcminus3 : TileCentroid Rminus - TileCentroid U = + (1 / 2 : Real) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (3 : Fin 4).val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) := LeftWebGeometry.hcminus3 q i U Rminus + hcminus flip + have hmstep : (⟨0, 1⟩ : GaussianInt) ^ (3 : Fin 4).val * + (if Even (3 : Fin 4).val then BandVectors.1 (q i.succ) (q 0) + else BandVectors.1 (q 0) (q i.succ)) = + BandVectors.1 (q i.succ) (q 0) := LeftWebGeometry.hmstep q i flip + obtain ⟨Em, htouchm⟩ := BandOrientedChildParentIncomingEndpoint + q hq i 3 U Rminus Zm hU hRm hZm + (ProperBandCurvatureStructure q hq).1 hpos hcminus3 hcZm + obtain ⟨Ep, htouchp⟩ := BandOrientedChildParentIncomingEndpoint + q hq i 0 U Rplus Zp hU hRp hZp + (ProperBandCurvatureStructure q hq).1 hpos (by simpa using hcplus) hcZp + simp only [hmstep] at Em htouchm + simp only [show (0 : Fin 4).val = 0 from rfl, + show Even 0 by decide, pow_zero, ite_true, one_mul] at Ep htouchp + let M := TileTranslation U (BandVectors.1 (q i.succ) (q 0)) + -- Identify observable middle-tile data, never ProtoTile records. + obtain ⟨d, hcells, hanchor⟩ := + BandPrototileTranslationNormalForm (q 0) V U hV hU + have hobs := ProtoTileObservableExtensionality _ _ hcells hanchor + have hd : d = BandVectors.1 (q i.succ) (q 0) := LeftWebGeometry.hd q i U V hcUV d hobs + subst d + have hMV : M.cells = V.cells := hcells.symm + have haMV : M.cells = ∅ → M.anchor = V.anchor := LeftWebGeometry.haMV q i U V + hcells hanchor + have hobsMV := ProtoTileObservableExtensionality M V hMV haMV + obtain ⟨Eminus, hmPoint, hmAB, hmBC, hmCA⟩ := + ExactTileInterfaceTripleRetargetMiddle U M V Rminus hMV haMV Em + obtain ⟨Eplus, hpPoint, hpAB, hpBC, hpCA⟩ := + ExactTileInterfaceTripleRetargetMiddle U M V Rplus hMV haMV Ep + have hgeomU := BandTileSimultaneousInduction q hq U hU + have hgeomV := BandTileSimultaneousInduction q hq V hV + have hnV : V.cells ≠ ∅ := LeftWebGeometry.hnV C n q i hq U V hgeomV + have touchingRetarget (W : ProtoTile) (ht : TouchingTriple U M W) : + TouchingTriple U V W := LeftWebGeometry.touchingRetarget q i U V hMV hobsMV hnV + W ht + have htouchMinus := touchingRetarget Rminus htouchm + have htouchPlus := touchingRetarget Rplus htouchp + obtain ⟨um, hum⟩ := CurvatureOneBandPrototileSingleton Ci Rminus hunit hRm + obtain ⟨up, hup⟩ := CurvatureOneBandPrototileSingleton Ci Rplus hunit hRp + have hsingletonDisk (W : ProtoTile) (u : GaussianInt) + (hu : W.cells = {u}) : LatticeTile W := LeftWebGeometry.hsingletonDisk W u hu + have hdisjoint : Disjoint Rplus.cells Rminus.cells := LeftWebGeometry.hdisjoint q i + hq U Rminus Rplus hcminus hcplus um hum up hup + have hplusU : Disjoint U.cells Rplus.cells := LeftWebGeometry.hplusU U V Rplus + htouchPlus up hup + have hplusV : Disjoint V.cells Rplus.cells := LeftWebGeometry.hplusV U V Rplus hnV + htouchPlus up hup + obtain ⟨hEndpointNe, hCrossFirst, hCrossLast⟩ := + ExactTileInterfaceDisjointCompanionEndpoints U V Rplus Rminus + Eplus Eminus hgeomU.1 hgeomV.1 + (hsingletonDisk Rplus up hup) (hsingletonDisk Rminus um hum) + htouchPlus htouchMinus hplusU hplusV hdisjoint + have hendpointCompat := P5589T1EndpointCompatibility q hq C Ci i hqC rfl + U Rminus Rplus f k hminus hplus hOf hOminus hOplus p pminus pplus + hpf hsminus hsplus hcminus hcplus hpminus hpplus + centerShift a b bminus bplus houterReflection hplusReflection hminusReflection + have hRS : Rminus ≠ Rplus := LeftWebGeometry.hRS Rminus Rplus up hup hdisjoint + have hnorm : Zsqrtd.norm (BandVectors.1 (q 0) (q i.succ)) = + (q 0).1+1 := LeftWebGeometry.hnorm q i hq hunit + have hnadj : ¬ ∃ v : GaussianInt, UnitTriangularStep orientation v ∧ + TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint v := + LeftWebGeometry.hnadj C n q i hq hunit hpos U V orientation base Rminus + Rplus tiles reverseTiles hs reverseHs hreverse hrespect hreverseRespect r + horientation hstring hcminus hcplus hnorm + have hUn : U.cells.Nonempty := LeftWebGeometry.hUn C n q i hq U V hgeomU hgeomV + have hVn : V.cells.Nonempty := Finset.nonempty_iff_ne_empty.mpr hnV + have hselection := P5589T1UnitInterfaceSelection C Ci hunit orientation + base Rminus Rplus U V tiles reverseTiles hs reverseHs hminus hplus f k + hOf hOk hUn hVn hrespect hreverseRespect hhead hlast hRS hnadj + hancestors hreverseAncestors Eminus Eplus htouchMinus htouchPlus + hCrossLast x hxf hxk + obtain ⟨z,hz⟩ := CurvatureOneBandCircleClassification Ci hunit + have hCiunit : Ci.1.1.1 = 1 := hunit + obtain ⟨A,B,hvalues⟩ := P5589T1LinkedUnitValues C Ci z hz orientation + base Rminus Rplus U V tiles reverseTiles hs reverseHs hminus hplus f k + g x hrespect hreverseRespect hhead hlast hreverseLast hgf hgk hxf hxk + hendpointCompat hcover hselection + have hmatrix : CircleMatrix Ci = + ![![((1+z.re : ℤ) : ℝ), (z.im : ℝ)], + ![(z.im : ℝ), (-z.re : ℝ)]] := LeftWebGeometry.hmatrixAt529 q i hq hpos z hz + hCiunit + have hperiodic := CurvatureOnePeriodicOdometer Ci z hz + have translation (v : GaussianInt) : + P5570T1UnitQuadratic z (x+v) = + P5570T1UnitQuadratic z x + P5570T1UnitQuadratic z v + + ((1+z.re)*v.re+z.im*v.im)*x.re + + (z.im*v.re-z.re*v.im)*x.im := LeftWebGeometry.translationAt543 g x q i hq + hpos z hCiunit hmatrix hperiodic v + have hquad : FourNeighborLaplacian + (fun y => P5570T1UnitQuadratic z y + A.re*y.re + A.im*y.im + B) x = 1 := + LeftWebGeometry.hquad x z A B translation + simpa only [FourNeighborLaplacian, + hvalues x (Or.inl rfl), + hvalues (x+1) (Or.inr (Or.inl rfl)), + hvalues (x-1) (Or.inr (Or.inr (Or.inl rfl))), + hvalues (x+⟨0,1⟩) (Or.inr (Or.inr (Or.inr (Or.inl rfl)))), + hvalues (x-⟨0,1⟩) (Or.inr (Or.inr (Or.inr (Or.inr rfl))))] using hquad + +end LeftWebStep + +theorem P5596T1LeftWeb + (C : BandCircle) (T₁ T₂ : ProtoTile) (h₁ h₂ : PartialOdometer) + (g : IntegerLatticeFunction) (x : GaussianInt) + (hcompat : OdometerCompatibility h₁ h₂) + (hg₁ : GlobalOdometerExtends g h₁) (hg₂ : GlobalOdometerExtends g h₂) + (hx₁ : x ∈ h₁.domain) (hx₂ : x ∈ h₂.domain) + (hstar : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h₁.domain ∨ y ∈ h₂.domain) + (hleft : LeftLatticeAdjacent C T₁ T₂ h₁ h₂) : + FourNeighborLaplacian g x = 1 := by +-- BODY + have left : ∀ n : Nat, + ∀ (C : BandCircle) (T₁ T₂ : ProtoTile) (h₁ h₂ : PartialOdometer) + (g : IntegerLatticeFunction) (x : GaussianInt), + C.1.1.1.toNat = n → + OdometerCompatibility h₁ h₂ → + GlobalOdometerExtends g h₁ → GlobalOdometerExtends g h₂ → + x ∈ h₁.domain → x ∈ h₂.domain → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h₁.domain ∨ y ∈ h₂.domain) → + LeftLatticeAdjacent C T₁ T₂ h₁ h₂ → FourNeighborLaplacian g x = 1 := by + intro n + induction n using Nat.strong_induction_on with + | h n ih => + intro C T₁ T₂ h₁ h₂ g x hn hcompat hg₁ hg₂ hx₁ hx₂ hstar hleft + by_cases hc : C.1.1.1 = 1 + · obtain ⟨z, hz⟩ := CurvatureOneBandCircleClassification C hc + obtain ⟨ht₁, ht₂, p₁, p₂, hp₁, hp₂, hstep⟩ := hleft + have hdata := LeftWebGeometry.hdata C T₁ T₂ n hc p₁ p₂ hstep + obtain ⟨v, hv, hr, hi⟩ := hdata + obtain ⟨u₁, a₁, b₁, hu₁, hd₁, hcent₁, hval₁, hs₁⟩ := + P5570T1UnitNormalForm C z T₁ h₁ hz ht₁ + obtain ⟨u₂, a₂, b₂, hu₂, hd₂, hcent₂, hval₂, hs₂⟩ := + P5570T1UnitNormalForm C z T₂ h₂ hz ht₂ + have hmatrix : CircleMatrix C = + ![![((1 + z.re : ℤ) : ℝ), (z.im : ℝ)], + ![(z.im : ℝ), (-z.re : ℝ)]] := LeftWebGeometry.hmatrixAt187 C z hz + have hpr₁ := Option.some.inj (hp₁.symm.trans hs₁) + have hpr₂ := Option.some.inj (hp₂.symm.trans hs₂) + subst p₁ + subst p₂ + rw [hcent₁, hcent₂] at hv + have hvr := congrArg Prod.fst hv + have hvi := congrArg Prod.snd hv + dsimp [GaussianRealPoint] at hvr hvi + have hvr' : (v.re : ℝ) = (u₂.re : ℝ) - (u₁.re : ℝ) := by linarith + have hvi' : (v.im : ℝ) = (u₂.im : ℝ) - (u₁.im : ℝ) := by linarith + rw [hmatrix] at hr hi + norm_num only [Matrix.cons_val_zero, Matrix.cons_val_one] at hr hi + rw [hvr', hvi'] at hr hi + have ha := LeftWebGeometry.haAt220 a₁ a₂ (LeftWebGeometry.har z u₁ a₁ u₂ a₂ hr) + (LeftWebGeometry.hai z u₁ a₁ u₂ a₂ hi) + subst a₂ + obtain ⟨c₁, hg₁⟩ := hg₁ + obtain ⟨c₂, hg₂⟩ := hg₂ + have hb := LeftWebGeometry.hbAt227 C h₁ h₂ g x c₁ hg₁ c₂ hg₂ hx₁ hx₂ n z a₁ b₁ hval₁ b₂ + hval₂ + have hvalues (y : GaussianInt) + (hy : y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) : + g y = P5570T1UnitQuadratic z y + + a₁.re * y.re + a₁.im * y.im + (b₁ + c₁) := LeftWebGeometry.hvalues C h₁ h₂ g x c₁ + hg₁ c₂ + hg₂ hstar n z a₁ b₁ hval₁ b₂ hval₂ hb y hy + have hperiodic := CurvatureOnePeriodicOdometer C z hz + have hq : FourNeighborLaplacian + (fun y => P5570T1UnitQuadratic z y + + a₁.re * y.re + a₁.im * y.im + (b₁ + c₁)) x = 1 := LeftWebGeometry.hq x z a₁ b₁ c₁ + (LeftWebGeometry.translationAt244 C g x hc z hmatrix hperiodic) + simpa only [FourNeighborLaplacian, + hvalues x (Or.inl rfl), + hvalues (x + 1) (Or.inr (Or.inl rfl)), + hvalues (x - 1) (Or.inr (Or.inr (Or.inl rfl))), + hvalues (x + ⟨0, 1⟩) (Or.inr (Or.inr (Or.inr (Or.inl rfl)))), + hvalues (x - ⟨0, 1⟩) (Or.inr (Or.inr (Or.inr (Or.inr rfl))))] using hq + · have horiginal := hleft + obtain ⟨hO₁, hO₂, p₁, p₂, hp₁, hp₂, hstep⟩ := hleft + rcases hstep with hunit | ⟨q, i, e, hq, hqC, hcent, hr, hi⟩ + · exact (hc hunit.1).elim + · by_cases hunit : (q i.succ).1 = 1 + · have hpos : 0 < (q i.succ).1 := by rw [hunit]; norm_num + let Ci : BandCircle := + ⟨⟨q i.succ, Or.inl hpos, q, hq.1, i.succ, rfl⟩, hpos⟩ + have positiveStep (U V : ProtoTile) (f k : PartialOdometer) + (p p' : Real × Real) + (hOf : TileOdometer C.1.1 U f) (hOk : TileOdometer C.1.1 V k) + (hpf : PartialOdometerSlope f = some p) + (hpk : PartialOdometerSlope k = some p') + (hcUV : TileCentroid V - TileCentroid U = + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) + (hpUV : p' - p = GaussianRealPoint (BandVectors.2 (q i.succ) (q 0))) + (hcomp : OdometerCompatibility f k) + (hgf : GlobalOdometerExtends g f) (hgk : GlobalOdometerExtends g k) + (hxf : x ∈ f.domain) (hxk : x ∈ k.domain) + (hcover : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ f.domain ∨ y ∈ k.domain) : + FourNeighborLaplacian g x = 1 := LeftWebStep.positiveStep C g x n q i hq hqC + hunit hpos U V f k p p' hOf hOk hpf hpk hcUV hpUV hcomp hgf hgk hxf hxk hcover + cases e + · apply positiveStep T₂ T₁ h₂ h₁ p₂ p₁ hO₂ hO₁ hp₂ hp₁ + · simp only [Bool.false_eq_true, ite_false, neg_one_smul] at hcent + linear_combination -hcent + · apply Prod.ext + · simp only [Bool.false_eq_true, ite_false, neg_one_mul] at hr + simpa [GaussianRealPoint] using (show p₁.1 - p₂.1 = + ((BandVectors.2 (q i.succ) (q 0)).re : Real) by linarith) + · simp only [Bool.false_eq_true, ite_false, neg_one_mul] at hi + simpa [GaussianRealPoint] using (show p₁.2 - p₂.2 = + ((BandVectors.2 (q i.succ) (q 0)).im : Real) by linarith) + · rcases hcompat with hd | ⟨c, hh⟩ + · exact Or.inl hd.symm + · exact Or.inr ⟨-c, fun y hy₂ hy₁ => by + have := hh y hy₁ hy₂ + omega⟩ + · exact hg₂ + · exact hg₁ + · exact hx₂ + · exact hx₁ + · intro y hy + exact (hstar y hy).symm + · apply positiveStep T₁ T₂ h₁ h₂ p₁ p₂ hO₁ hO₂ hp₁ hp₂ + · simpa using hcent + · apply Prod.ext + · simpa [GaussianRealPoint] using hr + · simpa [GaussianRealPoint] using hi + · exact hcompat + · exact hg₁ + · exact hg₂ + · exact hx₁ + · exact hx₂ + · exact hstar + · by_cases hzero : (q i.succ).1 = 0 + · exact P5596T1LineParent q hq i e hzero T₁ T₂ h₁ h₂ p₁ p₂ g x + (by simpa only [hqC] using hO₁) (by simpa only [hqC] using hO₂) + hp₁ hp₂ hcent hr hi hg₁ hg₂ hx₁ hx₂ hstar + · have hpos : 0 < (q i.succ).1 := LeftWebGeometry.hposAt619 C n q i hq hzero + let Ci : BandCircle := + ⟨⟨q i.succ, Or.inl hpos, q, hq.1, i.succ, rfl⟩, hpos⟩ + have hlarge : 1 < Ci.1.1.1 := by change 1 < (q i.succ).1; omega + obtain ⟨U, V, f, k, ha, hb, hadj, hxf, hxk, hcover⟩ := + (LeftAdjacentOdometerCompatibility C T₁ T₂ h₁ h₂ horiginal).2 + q hq i e Ci hqC rfl hlarge hcent x hx₁ hx₂ hstar + have hgf : GlobalOdometerExtends g f := LeftWebGeometry.hgf C T₁ h₁ g hg₁ q i hq + hpos U f ha + have hgk : GlobalOdometerExtends g k := LeftWebGeometry.hgk C T₂ h₂ g hg₂ q i hq + hpos V k hb + exact ih Ci.1.1.1.toNat (LeftWebGeometry.hbelow C n hn hc q i hq hqC hunit hzero + hpos) Ci U V f k g x rfl + (LeftAdjacentOdometerCompatibility Ci U V f k hadj).1 + hgf hgk hxf hxk hcover hadj + exact left C.1.1.1.toNat C T₁ T₂ h₁ h₂ g x rfl + hcompat hg₁ hg₂ hx₁ hx₂ hstar hleft + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5596T1LineParent.lean b/LeanPool/ApollonianSuperharmonic/P5596T1LineParent.lean new file mode 100644 index 0000000000..310443e855 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5596T1LineParent.lean @@ -0,0 +1,239 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5596T1CommonExtensionTransport +public import LeanPool.ApollonianSuperharmonic.P5332T1LiteralNormalization +public import LeanPool.ApollonianSuperharmonic.FordOdometerFamilyExistsUnique +public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable +public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse +public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure + +-- [TABLET NODE: P5596T1LineParent] + +/-! +# P5596T1LineParent + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5596T1LineParent + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (i : Fin 3) (e : Bool) (hzero : (q i.succ).1 = 0) + (T U : ProtoTile) (h k : PartialOdometer) (p p' : ℝ × ℝ) + (g : IntegerLatticeFunction) (x : GaussianInt) + (hT : TileOdometer (q 0) T h) (hU : TileOdometer (q 0) U k) + (hp : PartialOdometerSlope h = some p) + (hp' : PartialOdometerSlope k = some p') + (hc : TileCentroid U - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) + (hr : p'.1 - p.1 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q i.succ) (q 0)).re) + (hi : p'.2 - p.2 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q i.succ) (q 0)).im) + (hg : GlobalOdometerExtends g h) (kg : GlobalOdometerExtends g k) + (hx : x ∈ h.domain) (kx : x ∈ k.domain) + (hstar : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h.domain ∨ y ∈ k.domain) : + FourNeighborLaplacian g x = 1 := by +-- BODY + have fordLineStar (P : FordFareyParameter) (e : Bool) + (T U : ProtoTile) (h k : PartialOdometer) (p p' : ℝ × ℝ) + (g : IntegerLatticeFunction) (x : GaussianInt) + (hT : TileOdometer (FordCircleCoordinate P.p P.q) T h) + (hU : TileOdometer (FordCircleCoordinate P.p P.q) U k) + (hp : PartialOdometerSlope h = some p) + (hp' : PartialOdometerSlope k = some p') + (hc : TileCentroid U - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint ⟨0, -(P.q : Int)⟩) + (hr : p'.1 - p.1 = (if e = true then (1 : ℝ) else -1) * (-P.p : Int)) + (hi : p'.2 - p.2 = 0) + (hg : GlobalOdometerExtends g h) (kg : GlobalOdometerExtends g k) + (hx : x ∈ h.domain) (kx : x ∈ k.domain) + (hstar : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h.domain ∨ y ∈ k.domain) : + FourNeighborLaplacian g x = 1 := by + obtain ⟨u, d, a, B, f, hd, hd', _, _, _, hcent, hslope, hslope', hv, hv', hlap⟩ := + P5332T1LiteralNormalization P P T U h k p p' g hT hU hp hp' hg kg + have dr : d.re = 0 := by + have hh := congrArg Prod.fst hc + rw [hcent] at hh + change (↑P.q - ↑P.q) / 2 + (d.re : ℝ) = + (if e = true then (1 : ℝ) else -1) * ((0 : Int) : ℝ) at hh + simp only [sub_self, zero_div, zero_add, Int.cast_zero, mul_zero] at hh + exact_mod_cast hh + have di : d.im = if e = true then -(P.q : Int) else (P.q : Int) := by + have hh := congrArg Prod.snd hc + rw [hcent] at hh + change (↑P.q - ↑P.q) / 2 + (d.im : ℝ) = + (if e = true then (1 : ℝ) else -1) * (-(P.q : Int) : Int) at hh + cases e <;> simp only [Bool.false_eq_true, ite_false, ite_true, + sub_self, zero_div, zero_add, Int.cast_neg, neg_mul, one_mul, neg_neg] at hh ⊢ <;> + exact_mod_cast hh + have ar : a.re = if e = true then -P.p else P.p := by + rw [hslope] at hr + cases e <;> simp only [Bool.false_eq_true, ite_false, ite_true, + sub_self, zero_div, zero_add, Int.cast_neg, neg_mul, one_mul, neg_neg] at hr ⊢ <;> + exact_mod_cast hr + have ai : a.im = 0 := by + rw [hslope'] at hi + simp only [sub_self, zero_div, zero_add] at hi + exact_mod_cast hi + have hneg (y : GaussianInt) : + FordOdometer P (y + ⟨0, -(P.q : Int)⟩) = FordOdometer P y - P.p*y.re := + (Classical.choose_spec FordOdometerFamilyExistsUnique).1.2.2.1 P y + have cocycle (y : GaussianInt) : + FordOdometer P (y-d) + a.re*y.re + a.im*y.im = FordOdometer P y := by + cases e + · have deq : d = ⟨0, (P.q : Int)⟩ := by + ext <;> simp_all + have heq : y-d = y+⟨0, -(P.q : Int)⟩ := by + rw [deq] + ext <;> simp [sub_eq_add_neg] + rw [heq, hneg, ar, ai] + simp + · have deq : d = ⟨0, -(P.q : Int)⟩ := by + ext <;> simp_all + have hh := hneg (y-d) + have heq : y-d+⟨0, -(P.q : Int)⟩ = y := by rw [← deq]; abel + rw [heq] at hh + rw [ar, ai] + simp only [ite_true, Zsqrtd.re_sub, dr, sub_zero] at hh ⊢ + linear_combination -hh + have hB : B = 0 := by + have h1 := hv (x-u) ((hd x).mp hx) + have h2 := hv' (x-u) ((hd' x).mp kx) + have h3 := cocycle (x-u) + omega + have values (y : GaussianInt) + (hy : y = x ∨ y = x+1 ∨ y = x-1 ∨ y = x+⟨0,1⟩ ∨ y = x-⟨0,1⟩) : + f (y-u) = FordOdometer P (y-u) := by + rcases hstar y hy with hh | hk + · exact hv (y-u) ((hd y).mp hh) + · rw [hv' (y-u) ((hd' y).mp hk), hB, add_zero] + exact cocycle (y-u) + have hboundary : x-u ∈ LatticeVertexBoundary (FordVertexDomain P.q) := by + have h1 := (hd x).mp hx + have h2 := (hd' x).mp kx + have hq := P.q_pos + change 0 ≤ (x-u).re ∧ (x-u).re ≤ (P.q : Int) ∧ + 0 ≤ (x-u).im ∧ (x-u).im ≤ (P.q : Int) at h1 + change 0 ≤ (x-u-d).re ∧ (x-u-d).re ≤ (P.q : Int) ∧ + 0 ≤ (x-u-d).im ∧ (x-u-d).im ≤ (P.q : Int) at h2 + change 0 ≤ (x-u).re-d.re ∧ (x-u).re-d.re ≤ (P.q : Int) ∧ + 0 ≤ (x-u).im-d.im ∧ (x-u).im-d.im ≤ (P.q : Int) at h2 + rw [dr] at h2 + refine ⟨h1, ?_⟩ + cases e + · have heq : (x-u).im = (P.q : Int) := by + simp only [Bool.false_eq_true, ite_false] at di + omega + refine ⟨x-u+⟨0,1⟩, ?_, ?_, ?_⟩ + · change ¬ (0 ≤ (x-u).re + 0 ∧ (x-u).re + 0 ≤ (P.q : Int) ∧ + 0 ≤ (x-u).im + 1 ∧ (x-u).im + 1 ≤ (P.q : Int)) + omega + · simp + · simp + · have heq : (x-u).im = 0 := by simp only [ite_true] at di; omega + refine ⟨x-u-⟨0,1⟩, ?_, ?_, ?_⟩ + · simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub] + simp only [Zsqrtd.im_sub] at heq + omega + · simp + · simp + rw [hlap x] + have htable := (FordLaplacianTable P).2.1 (x-u) hboundary + unfold FourNeighborLaplacian at htable ⊢ + have eq1 : x-u+1 = x+1-u := by abel + have eq2 : x-u-1 = x-1-u := by abel + have eq3 : x-u+⟨0,1⟩ = x+⟨0,1⟩-u := by abel + have eq4 : x-u-⟨0,1⟩ = x-⟨0,1⟩-u := by abel + rw [eq1, eq2, eq3, eq4] at htable ⊢ + rw [values x (Or.inl rfl), values (x+1) (Or.inr (Or.inl rfl)), + values (x-1) (Or.inr (Or.inr (Or.inl rfl))), + values (x+⟨0,1⟩) (Or.inr (Or.inr (Or.inr (Or.inl rfl)))), + values (x-⟨0,1⟩) (Or.inr (Or.inr (Or.inr (Or.inr rfl))))] + exact htable + obtain ⟨a, s, P, hP, hrev, _, hline, hford⟩ := + FordRegimeConverse q hq ⟨i.succ, hzero⟩ + have hindex : i = a+2 := + (ProperBandCurvatureStructure q hq).2.2 i (a+2) hzero hline + let r : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a+1).succ, q (a+2).succ] + have hr0 : r 0 = q 0 := rfl + have hr3 : r (2 : Fin 3).succ = q i.succ := by rw [hindex]; rfl + have hproper : ProperBandQuadruple r := by + fin_cases a + · convert hq using 1; (try funext j; fin_cases j) <;> rfl + · refine ⟨?_, ?_⟩ + · exact SemiProperQuadruple.rotate hq.1 + · intro j + fin_cases j + · exact hq.2 1 + · exact hq.2 2 + · exact hq.2 0 + · refine ⟨?_, ?_⟩ + · exact SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1) + · intro j + fin_cases j + · exact hq.2 2 + · exact hq.2 0 + · exact hq.2 1 + obtain ⟨negative, v, v', _, hTn, hUn, hpn, hp'n, hcn, hrn, hin, _⟩ := + LeftLatticeAdjacentPackingSymmetryTransport s r hproper 2 e T U h k p p' + (by simpa only [hr0] using hT) (by simpa only [hr0] using hU) hp hp' + (by simpa only [hr0, hr3] using hc) + (by simpa only [hr0, hr3] using hr) + (by simpa only [hr0, hr3] using hi) + obtain ⟨g', hg', kg', hlap, hxn, kxn, hstarn⟩ := + P5596T1CommonExtensionTransport s g h k x hg kg hx kx hstar + obtain ⟨_, _, _, hvline, _, _, haline, _, _⟩ := + (FordCoordinateConfiguration P).2 hP + have hzeroN : FourNeighborLaplacian g' (BandPackingSymmetryVectorAction s x) = 1 := by + apply fordLineStar P (xor e negative) + (BandPackingSymmetryTileAction s T) (BandPackingSymmetryTileAction s U) + (BandPackingSymmetryPartialOdometerAction s h) + (BandPackingSymmetryPartialOdometerAction s k) v v' g' + (BandPackingSymmetryVectorAction s x) + · simpa only [show BandPackingSymmetryQuadrupleAction s r = FordRecursiveQuadruple P + from hford, FordRecursiveQuadruple, Matrix.cons_val_zero] using hTn + · simpa only [show BandPackingSymmetryQuadrupleAction s r = FordRecursiveQuadruple P + from hford, FordRecursiveQuadruple, Matrix.cons_val_zero] using hUn + · exact hpn + · exact hp'n + · simpa only [hrev, Bool.false_eq_true, ite_false, + show (2 : Fin 3).succ = (3 : Fin 4) from rfl, + show BandPackingSymmetryQuadrupleAction s r = FordRecursiveQuadruple P from hford, + hvline] using hcn + · simpa only [hrev, Bool.false_eq_true, ite_false, + show (2 : Fin 3).succ = (3 : Fin 4) from rfl, + show BandPackingSymmetryQuadrupleAction s r = FordRecursiveQuadruple P from hford, + haline] using hrn + · simpa only [hrev, Bool.false_eq_true, ite_false, + show (2 : Fin 3).succ = (3 : Fin 4) from rfl, + show BandPackingSymmetryQuadrupleAction s r = FordRecursiveQuadruple P from hford, + haline, Int.cast_zero, mul_zero] using hin + · exact hg' + · exact kg' + · exact hxn + · exact kxn + · exact hstarn + exact hlap ▸ hzeroN + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5606T1RightTerminalTransport.lean b/LeanPool/ApollonianSuperharmonic/P5606T1RightTerminalTransport.lean new file mode 100644 index 0000000000..03c7e361d1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5606T1RightTerminalTransport.lean @@ -0,0 +1,140 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5596T1CommonExtensionTransport +public import LeanPool.ApollonianSuperharmonic.FordTerminalWebStencilLedger +public import LeanPool.ApollonianSuperharmonic.DiamondTerminalWebStencilLedger +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryMarkedDataCovariance + +-- [TABLET NODE: P5606T1RightTerminalTransport] + +/-! +# P5606T1RightTerminalTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5606T1RightTerminalTransport + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (i : Fin 3) (e : Bool) (a : Fin 3) (w : BandPackingSymmetry) + (hnormal : + (∃ P : FordFareyParameter, 1 < P.q ∧ + BandPackingSymmetryQuadrupleAction w + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] = + FordRecursiveQuadruple P) ∨ + (∃ K : DiamondParameter, 1 < K.1 ∧ + BandPackingSymmetryQuadrupleAction w + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] = + DiamondRecursiveQuadruple K)) + (T U : ProtoTile) (h k : PartialOdometer) (p p' : ℝ × ℝ) + (g : IntegerLatticeFunction) (x : GaussianInt) + (hT : TileOdometer (q 0) T h) (hU : TileOdometer (q 0) U k) + (hp : PartialOdometerSlope h = some p) + (hp' : PartialOdometerSlope k = some p') + (hc : TileCentroid U - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) + (hr : p'.1 - p.1 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q 0) (q i.succ)).re) + (hi : p'.2 - p.2 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q 0) (q i.succ)).im) + (hcompat : OdometerCompatibility h k) + (hg : GlobalOdometerExtends g h) (kg : GlobalOdometerExtends g k) + (hx : x ∈ h.domain) (kx : x ∈ k.domain) + (hstar : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ h.domain ∨ y ∈ k.domain) : + ((∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ z = x - 1 - ⟨0, 1⟩ → + z ∈ T.cells ∨ z ∈ U.cells) → FourNeighborLaplacian g x = 1) ∧ + (¬ (∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ z = x - 1 - ⟨0, 1⟩ → + z ∈ T.cells ∨ z ∈ U.cells) → FourNeighborLaplacian g x = 0) := by +-- BODY + let r : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + have hr0 : r 0 = q 0 := rfl + have hri : r (i - a).succ = q i.succ := by + fin_cases a <;> fin_cases i <;> rfl + have hproper : ProperBandQuadruple r := by + fin_cases a + · convert hq using 1; (try funext j; fin_cases j) <;> rfl + · refine ⟨SemiProperQuadruple.rotate hq.1, ?_⟩ + intro j + fin_cases j + · exact hq.2 1 + · exact hq.2 2 + · exact hq.2 0 + · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1), ?_⟩ + intro j + fin_cases j + · exact hq.2 2 + · exact hq.2 0 + · exact hq.2 1 + obtain ⟨delta, b, b', hphase, hTn, hUn, hpn, hp'n, hcn, hrn, hin, hcompatn⟩ := + RightLatticeAdjacentPackingSymmetryTransport w r hproper (i - a) e T U h k p p' + (by simpa only [hr0] using hT) (by simpa only [hr0] using hU) hp hp' + (by simpa only [hr0, hri] using hc) + (by simpa only [hr0, hri] using hr) + (by simpa only [hr0, hri] using hi) + obtain ⟨g', hgn, kgn, hlap, hxn, kxn, hstarn⟩ := + P5596T1CommonExtensionTransport w g h k x hg kg hx kx hstar + have incident (y : GaussianInt) (V W : ProtoTile) : + (∀ z, z = y ∨ z = y - 1 ∨ z = y - ⟨0, 1⟩ ∨ z = y - 1 - ⟨0, 1⟩ → + z ∈ V.cells ∨ z ∈ W.cells) ↔ + (∀ j : Fin 4, LatticeVertexIncidentCell y j ∈ V.cells ∨ + LatticeVertexIncidentCell y j ∈ W.cells) := by + constructor + · intro H j + fin_cases j <;> apply H <;> simp [LatticeVertexIncidentCell] + · intro H z hz + rcases hz with rfl | rfl | rfl | rfl + · exact H 0 + · exact H 1 + · exact H 3 + · exact H 2 + have hcells := (incident x T U).trans + ((BandPackingSymmetryMarkedDataCovariance.2.1 w x T U).trans + (incident (BandPackingSymmetryVectorAction w x) + (BandPackingSymmetryTileAction w T) (BandPackingSymmetryTileAction w U)).symm) + let j : Fin 3 := if BandPackingSymmetryReversesOrientation w then -(i - a) else i - a + let en := xor (xor e delta) (BandPackingSymmetryReversesOrientation w) + have terminal : + ((∀ z, z = BandPackingSymmetryVectorAction w x ∨ + z = BandPackingSymmetryVectorAction w x - 1 ∨ + z = BandPackingSymmetryVectorAction w x - ⟨0, 1⟩ ∨ + z = BandPackingSymmetryVectorAction w x - 1 - ⟨0, 1⟩ → + z ∈ (BandPackingSymmetryTileAction w T).cells ∨ + z ∈ (BandPackingSymmetryTileAction w U).cells) → + FourNeighborLaplacian g' (BandPackingSymmetryVectorAction w x) = 1) ∧ + (¬ (∀ z, z = BandPackingSymmetryVectorAction w x ∨ + z = BandPackingSymmetryVectorAction w x - 1 ∨ + z = BandPackingSymmetryVectorAction w x - ⟨0, 1⟩ ∨ + z = BandPackingSymmetryVectorAction w x - 1 - ⟨0, 1⟩ → + z ∈ (BandPackingSymmetryTileAction w T).cells ∨ + z ∈ (BandPackingSymmetryTileAction w U).cells) → + FourNeighborLaplacian g' (BandPackingSymmetryVectorAction w x) = 0) := by + rcases hnormal with ⟨P, hP, heq⟩ | ⟨K, hK, heq⟩ + · change BandPackingSymmetryQuadrupleAction w r = FordRecursiveQuadruple P at heq + rw [heq] at hTn hUn hcn hrn hin + exact (FordTerminalWebStencilLedger P hP).1 j en _ _ _ _ b b' g' _ + hTn hUn hpn hp'n hcn hrn hin (hcompatn.mpr hcompat) + hgn kgn hxn kxn hstarn + · change BandPackingSymmetryQuadrupleAction w r = DiamondRecursiveQuadruple K at heq + rw [heq] at hTn hUn hcn hrn hin + exact (DiamondTerminalWebStencilLedger K hK).1 j en _ _ _ _ b b' g' _ + hTn hUn hpn hp'n hcn hrn hin (hcompatn.mpr hcompat) + hgn kgn hxn kxn hstarn + exact ⟨fun H => hlap ▸ terminal.1 (hcells.mp H), + fun H => hlap ▸ terminal.2 (fun Hn => H (hcells.mpr Hn))⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5606T1SubtileTerminalTransport.lean b/LeanPool/ApollonianSuperharmonic/P5606T1SubtileTerminalTransport.lean new file mode 100644 index 0000000000..a83ec2c9dd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5606T1SubtileTerminalTransport.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5596T1CommonExtensionTransport +public import LeanPool.ApollonianSuperharmonic.FordTerminalWebStencilLedger +public import LeanPool.ApollonianSuperharmonic.DiamondTerminalWebStencilLedger +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryMarkedDataCovariance + +-- [TABLET NODE: P5606T1SubtileTerminalTransport] + +/-! +# P5606T1SubtileTerminalTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5606T1SubtileTerminalTransport + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (i : Fin 3) (s : Fin 4) (hpos : 0 < (q i.succ).1) + (a : Fin 3) (w : BandPackingSymmetry) + (hnormal : + (∃ P : FordFareyParameter, 1 < P.q ∧ + BandPackingSymmetryQuadrupleAction w + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] = + FordRecursiveQuadruple P) ∨ + (∃ K : DiamondParameter, 1 < K.1 ∧ + BandPackingSymmetryQuadrupleAction w + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] = + DiamondRecursiveQuadruple K)) + (T U : ProtoTile) (h k : PartialOdometer) (p p' : ℝ × ℝ) + (g : IntegerLatticeFunction) (x : GaussianInt) + (hT : TileOdometer (q 0) T h) (hU : TileOdometer (q i.succ) U k) + (hp : PartialOdometerSlope h = some p) + (hp' : PartialOdometerSlope k = some p') + (hc : TileCentroid U - TileCentroid T = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + BandVectors.1 (q 0) (q i.succ)))) + (hr : p'.1 - p.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)))).1) + (hi : p'.2 - p.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)))).2) + (hcompat : OdometerCompatibility h k) + (hg : GlobalOdometerExtends g h) (kg : GlobalOdometerExtends g k) + (hx : x ∈ h.domain) (kx : x ∈ k.domain) + (hstar : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ h.domain ∨ y ∈ k.domain) : + let UR := TileTranslation T ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0))) + (x ∈ FootprintVertices UR → FourNeighborLaplacian g x = 0) ∧ + (x ∉ FootprintVertices UR → FourNeighborLaplacian g x = 1) := by +-- BODY + let r : Fin 4 → CircleCoordinates := + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + have hr0 : r 0 = q 0 := rfl + have hri : r (i - a).succ = q i.succ := by + fin_cases a <;> fin_cases i <;> rfl + have hproper : ProperBandQuadruple r := by + fin_cases a + · convert hq using 1; (try funext j; fin_cases j) <;> rfl + · refine ⟨SemiProperQuadruple.rotate hq.1, ?_⟩ + intro j + fin_cases j + · exact hq.2 1 + · exact hq.2 2 + · exact hq.2 0 + · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1), ?_⟩ + intro j + fin_cases j + · exact hq.2 2 + · exact hq.2 0 + · exact hq.2 1 + obtain ⟨delta, b, b', sn, hphase, hsn, hTn, hUn, hpn, hp'n, + hcn, hrn, hin, hcompatn⟩ := + SubtileLatticeAdjacentPackingSymmetryTransport w r hproper (i - a) s + (by simpa only [hri] using hpos) T U h k p p' + (by simpa only [hr0] using hT) (by simpa only [hri] using hU) hp hp' + (by simpa only [hr0, hri] using hc) + (by simpa only [hr0, hri] using hr) + (by simpa only [hr0, hri] using hi) + obtain ⟨g', hgn, kgn, hlap, hxn, kxn, hstarn⟩ := + P5596T1CommonExtensionTransport w g h k x hg kg hx kx hstar + have hmark := BandPackingSymmetryMarkedDataCovariance.2.2 + w r hproper (i - a) s delta hphase T x + dsimp only at hmark + rw [← hsn] at hmark + simp only [hr0, hri] at hmark + let j : Fin 3 := if BandPackingSymmetryReversesOrientation w then -(i - a) else i - a + have terminal : + let URn := TileTranslation (BandPackingSymmetryTileAction w T) + ((⟨0, 1⟩ : GaussianInt) ^ sn.val * + (if Even sn.val then + BandVectors.1 (BandPackingSymmetryQuadrupleAction w r 0) + (BandPackingSymmetryQuadrupleAction w r j.succ) + else BandVectors.1 (BandPackingSymmetryQuadrupleAction w r j.succ) + (BandPackingSymmetryQuadrupleAction w r 0))) + (BandPackingSymmetryVectorAction w x ∈ FootprintVertices URn → + FourNeighborLaplacian g' (BandPackingSymmetryVectorAction w x) = 0) ∧ + (BandPackingSymmetryVectorAction w x ∉ FootprintVertices URn → + FourNeighborLaplacian g' (BandPackingSymmetryVectorAction w x) = 1) := by + have hposn : 0 < (BandPackingSymmetryQuadrupleAction w r j.succ).1 := by + have heq : BandPackingSymmetryQuadrupleAction w r j.succ = + BandPackingSymmetryCircleAction w (r (i - a).succ) := by + have parent (l : Fin 3) : + BandPackingSymmetryQuadrupleAction w r + (if BandPackingSymmetryReversesOrientation w then -l else l).succ = + BandPackingSymmetryCircleAction w (r l.succ) := by + cases he : BandPackingSymmetryReversesOrientation w <;> fin_cases l <;> + simp [BandPackingSymmetryQuadrupleAction, he, + show -(1 : Fin 3) = 2 from rfl, show -(2 : Fin 3) = 1 from rfl] + exact parent (i - a) + rw [heq, (BandPackingSymmetryCovariance w).1, hri] + exact hpos + rcases hnormal with ⟨P, hP, heq⟩ | ⟨K, hK, heq⟩ + · change BandPackingSymmetryQuadrupleAction w r = FordRecursiveQuadruple P at heq + rw [heq] at hTn hUn hcn hrn hin hposn ⊢ + exact (FordTerminalWebStencilLedger P hP).2 j sn _ _ _ _ b b' g' _ + hposn hTn hUn hpn hp'n hcn hrn hin (hcompatn.mpr hcompat) + hgn kgn hxn kxn hstarn + · change BandPackingSymmetryQuadrupleAction w r = DiamondRecursiveQuadruple K at heq + rw [heq] at hTn hUn hcn hrn hin ⊢ + exact (DiamondTerminalWebStencilLedger K hK).2 j sn _ _ _ _ b b' g' _ + hTn hUn hpn hp'n hcn hrn hin (hcompatn.mpr hcompat) + hgn kgn hxn kxn hstarn + exact ⟨fun H => hlap ▸ terminal.1 (hmark.2.mp H), + fun H => hlap ▸ terminal.2 (fun Hn => H (hmark.2.mpr Hn))⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5617T1RectangleReachabilityAndBasepointConnectivity.lean b/LeanPool/ApollonianSuperharmonic/P5617T1RectangleReachabilityAndBasepointConnectivity.lean new file mode 100644 index 0000000000..652354e6b9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5617T1RectangleReachabilityAndBasepointConnectivity.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import Mathlib.Data.List.Chain +public import Mathlib.Logic.Relation + +-- [TABLET NODE: P5617T1RectangleReachabilityAndBasepointConnectivity] + +/-! +# P5617T1RectangleReachabilityAndBasepointConnectivity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5617T1RectangleReachabilityAndBasepointConnectivity : + (∀ (A : Set LatticeCell) (x y : LatticeCell), + (∀ z : LatticeCell, + min x.re y.re ≤ z.re → z.re ≤ max x.re y.re → + min x.im y.im ≤ z.im → z.im ≤ max x.im y.im → z ∈ A) → + Relation.ReflTransGen + (fun x y => FourNeighborAdjacent x y ∧ x ∈ A ∧ y ∈ A) x y) ∧ + (∀ (A : Set LatticeCell) (o : LatticeCell), o ∈ A → + (∀ x ∈ A, Relation.ReflTransGen + (fun x y => FourNeighborAdjacent x y ∧ x ∈ A ∧ y ∈ A) x o) → + FourNeighborConnected A) := by +-- BODY + classical + let reach (A : Set LatticeCell) := Relation.ReflTransGen + (fun x y => FourNeighborAdjacent x y ∧ x ∈ A ∧ y ∈ A) + have single (A : Set LatticeCell) {x y : LatticeCell} + (hx : x ∈ A) (hy : y ∈ A) (hxy : FourNeighborAdjacent x y) : + reach A x y := Relation.ReflTransGen.single ⟨hxy, hx, hy⟩ + have rect (A : Set LatticeCell) (x y : LatticeCell) + (hbox : ∀ z : LatticeCell, + min x.re y.re ≤ z.re → z.re ≤ max x.re y.re → + min x.im y.im ≤ z.im → z.im ≤ max x.im y.im → z ∈ A) : + reach A x y := by + have row : ∀ k : Int, min x.re y.re ≤ k → k ≤ max x.re y.re → + reach A (⟨k, x.im⟩ : LatticeCell) ⟨y.re, x.im⟩ := by + intro k + induction k using Int.inductionOn' (b := y.re) with + | zero => intro _ _; exact Relation.ReflTransGen.refl + | succ k hk ih => + intro hl hu + apply Relation.ReflTransGen.trans (single A + (hbox ⟨k + 1, x.im⟩ hl hu (by simp) (by simp)) + (hbox ⟨k, x.im⟩ (by dsimp; omega) (by dsimp; omega) (by simp) (by simp)) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff])) + exact ih (by omega) (by omega) + | pred k hk ih => + intro hl hu + apply Relation.ReflTransGen.trans (single A + (hbox ⟨k - 1, x.im⟩ hl hu (by simp) (by simp)) + (hbox ⟨k, x.im⟩ (by dsimp; omega) (by dsimp; omega) (by simp) (by simp)) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff])) + exact ih (by omega) (by omega) + have col : ∀ k : Int, min x.im y.im ≤ k → k ≤ max x.im y.im → + reach A (⟨y.re, k⟩ : LatticeCell) y := by + intro k + induction k using Int.inductionOn' (b := y.im) with + | zero => + intro _ _ + have he : (⟨y.re, y.im⟩ : LatticeCell) = y := by ext <;> rfl + rw [he] + | succ k hk ih => + intro hl hu + apply Relation.ReflTransGen.trans (single A + (hbox ⟨y.re, k + 1⟩ (by simp) (by simp) hl hu) + (hbox ⟨y.re, k⟩ (by simp) (by simp) (by dsimp; omega) (by dsimp; omega)) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff])) + exact ih (by omega) (by omega) + | pred k hk ih => + intro hl hu + apply Relation.ReflTransGen.trans (single A + (hbox ⟨y.re, k - 1⟩ (by simp) (by simp) hl hu) + (hbox ⟨y.re, k⟩ (by simp) (by simp) (by dsimp; omega) (by dsimp; omega)) + (by simp [FourNeighborAdjacent, Zsqrtd.ext_iff])) + exact ih (by omega) (by omega) + have hx : (⟨x.re, x.im⟩ : LatticeCell) = x := by ext <;> rfl + have hr := row x.re (min_le_left _ _) (le_max_left _ _) + rw [hx] at hr + exact hr.trans (col x.im (min_le_left _ _) (le_max_left _ _)) + have connected (A : Set LatticeCell) (o : LatticeCell) (ho : o ∈ A) + (hto : ∀ x ∈ A, reach A x o) : FourNeighborConnected A := by + have symm {x y : LatticeCell} (h : reach A x y) : reach A y x := by + induction h with + | refl => exact Relation.ReflTransGen.refl + | tail h hstep ih => + exact (single A hstep.2.2 hstep.2.1 (by + rcases hstep.1 with h | h | h | h <;> subst_vars <;> + simp [FourNeighborAdjacent, Zsqrtd.ext_iff])).trans ih + have walk : ∀ {x y : LatticeCell}, x ∈ A → reach A x y → + ∃ p : List LatticeCell, p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ A) ∧ + ∀ u v : LatticeCell, ∀ l₁ l₂ : List LatticeCell, + p = l₁ ++ u :: v :: l₂ → FourNeighborAdjacent u v := by + intro x y hx hxy + induction hxy using Relation.ReflTransGen.head_induction_on with + | refl => + exact ⟨[y], by simp, by simp, by simpa, + List.isChain_iff_forall_rel_of_append_cons_cons.mp + (List.isChain_singleton y)⟩ + | @head x z hstep hrest ih => + obtain ⟨p, hphead, hplast, hpmem, hpchain⟩ := ih hstep.2.2 + have hpne : p ≠ [] := by intro h; simp [h] at hphead + have hchain : List.IsChain FourNeighborAdjacent (x :: p) := by + rw [List.isChain_cons] + exact ⟨by simpa [hphead] using hstep.1, + List.isChain_iff_forall_rel_of_append_cons_cons.mpr hpchain⟩ + refine ⟨x :: p, by simp, ?_, ?_, + List.isChain_iff_forall_rel_of_append_cons_cons.mp hchain⟩ + · cases p with + | nil => exact (hpne rfl).elim + | cons z p => simpa using hplast + · intro z hz + rcases List.mem_cons.mp hz with rfl | hz + · exact hx + · exact hpmem z hz + exact ⟨⟨o, ho⟩, fun x hx y hy => walk hx ((hto x hx).trans (symm (hto y hy)))⟩ + exact ⟨rect, connected⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5620T1BoundaryComponentCycle.lean b/LeanPool/ApollonianSuperharmonic/P5620T1BoundaryComponentCycle.lean new file mode 100644 index 0000000000..d2e28b42e4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5620T1BoundaryComponentCycle.lean @@ -0,0 +1,404 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.FiniteCycleComponentList +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent + +-- [TABLET NODE: P5620T1BoundaryComponentCycle] + +/-! +# P5620T1BoundaryComponentCycle + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace BoundaryComponentCycle + +private noncomputable def boundaryUniverse (T : ProtoTile) : Finset GaussianInt := + T.cells.biUnion fun z => {z, z + 1, z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} + +private theorem boundary_vertices_finite (T : ProtoTile) (cells_nonempty : T.cells.Nonempty) : + (BoundaryFootprintVertices T).Finite := by + classical + let boundaryUniverse : Finset GaussianInt := + T.cells.biUnion fun z => {z, z + 1, z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} + refine boundaryUniverse.finite_toSet.subset ?_ + intro v hv + rw [BoundaryFootprintVertices, ite_eq_left cells_nonempty] at hv + rcases hv with ⟨e, he, hve⟩ + rcases he with ⟨z, (⟨rfl, hocc⟩ | ⟨rfl, hocc⟩)⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hve + rcases hocc with ⟨hz, _⟩ | ⟨_, hz⟩ + · refine Finset.mem_coe.2 (Finset.mem_biUnion.2 ⟨z, hz, ?_⟩) + rcases hve with rfl | rfl <;> simp + · refine Finset.mem_coe.2 (Finset.mem_biUnion.2 ⟨z - ⟨0, 1⟩, hz, ?_⟩) + rcases hve with rfl | rfl <;> simp [Zsqrtd.ext_iff] + · simp only [Finset.mem_insert, Finset.mem_singleton] at hve + rcases hocc with ⟨hz, _⟩ | ⟨_, hz⟩ + · refine Finset.mem_coe.2 (Finset.mem_biUnion.2 ⟨z, hz, ?_⟩) + rcases hve with rfl | rfl <;> simp + · refine Finset.mem_coe.2 (Finset.mem_biUnion.2 ⟨z - 1, hz, ?_⟩) + rcases hve with rfl | rfl <;> simp [Zsqrtd.ext_iff] + +private noncomputable def BV (T : ProtoTile) := {v : GaussianInt // v ∈ BoundaryFootprintVertices T} + +private noncomputable def G (T : ProtoTile) : SimpleGraph (BV T) := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ BoundaryFootprintEdges T + +private theorem boundary_edge_card_two (T : ProtoTile) (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) : e.card = 2 := by + classical + rcases he with ⟨z, (⟨rfl, hz⟩ | ⟨rfl, hz⟩)⟩ + · simp [] + · simp [Zsqrtd.ext_iff] + +private theorem graph_adj_iff (T : ProtoTile) (a b : (BV T)) : + (G T).Adj a b ↔ + a ≠ b ∧ ({a.1, b.1} : Finset GaussianInt) ∈ BoundaryFootprintEdges T := by + classical + let BV := {v : GaussianInt // v ∈ BoundaryFootprintVertices T} + let G : SimpleGraph BV := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ BoundaryFootprintEdges T + change (G.Adj a b ↔ + a ≠ b ∧ ({a.1, b.1} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) + simp only [G] + constructor + · rintro ⟨hne, hab | hba⟩ + · exact ⟨hne, hab⟩ + · refine ⟨hne, ?_⟩ + rw [Finset.pair_comm] + exact hba + · rintro ⟨hne, hab⟩ + exact ⟨hne, Or.inl hab⟩ + +private theorem graph_isCycles (T : ProtoTile) (cells_nonempty : T.cells.Nonempty) + (boundary_degree_two : ∀ v ∈ BoundaryFootprintVertices T, Set.ncard {e : Finset GaussianInt | + e ∈ BoundaryFootprintEdges T ∧ v ∈ e} = 2) : (G T).IsCycles := by + classical + let BV := {v : GaussianInt // v ∈ BoundaryFootprintVertices T} + let G : SimpleGraph BV := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ BoundaryFootprintEdges T + have boundary_edge_card_two (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) : e.card = 2 := boundary_edge_card_two T e he + have graph_adj_iff (a b : BV) : + G.Adj a b ↔ + a ≠ b ∧ ({a.1, b.1} : Finset GaussianInt) ∈ BoundaryFootprintEdges T := graph_adj_iff T a b + change (G.IsCycles) + intro v hn + calc + (G.neighborSet v).ncard = + {e : Finset GaussianInt | + e ∈ BoundaryFootprintEdges T ∧ v.1 ∈ e}.ncard := by + apply Set.ncard_congr + (fun w (_ : w ∈ G.neighborSet v) => ({v.1, w.1} : Finset GaussianInt)) + · intro w hw + rw [SimpleGraph.mem_neighborSet] at hw + have hadj := hw + exact ⟨(graph_adj_iff v w).mp hadj |>.2, by simp⟩ + · intro a b ha hb hab + rw [SimpleGraph.mem_neighborSet] at ha + have hadja := (graph_adj_iff v a).mp ha + apply Subtype.ext + have hmem : a.1 ∈ ({v.1, b.1} : Finset GaussianInt) := by + rw [← hab] + simp + simp only [Finset.mem_insert, Finset.mem_singleton] at hmem + exact hmem.resolve_left (fun h => hadja.1 (Subtype.ext h.symm)) + · intro e he + rcases he with ⟨heE, hve⟩ + obtain ⟨a, b, hab, heq⟩ := + Finset.card_eq_two.mp (boundary_edge_card_two e heE) + subst e + simp only [Finset.mem_insert, Finset.mem_singleton] at hve + rcases hve with rfl | rfl + · have hbV : b ∈ BoundaryFootprintVertices T := by + rw [BoundaryFootprintVertices, ite_eq_left cells_nonempty] + exact ⟨{v.1, b}, heE, by simp⟩ + let w : BV := ⟨b, hbV⟩ + have hvw : v ≠ w := by + intro h + exact hab (congrArg Subtype.val h) + refine ⟨w, ?_, ?_⟩ + · rw [SimpleGraph.mem_neighborSet] + exact (graph_adj_iff v w).mpr ⟨hvw, heE⟩ + · rfl + · have haV : a ∈ BoundaryFootprintVertices T := by + rw [BoundaryFootprintVertices, ite_eq_left cells_nonempty] + exact ⟨{a, v.1}, heE, by simp⟩ + let w : BV := ⟨a, haV⟩ + have hvw : v ≠ w := by + intro h + exact hab (congrArg Subtype.val h).symm + refine ⟨w, ?_, ?_⟩ + · rw [SimpleGraph.mem_neighborSet] + apply (graph_adj_iff v w).mpr + refine ⟨hvw, ?_⟩ + rw [Finset.pair_comm] + exact heE + · simp [w, Finset.pair_comm] + _ = 2 := boundary_degree_two v.1 v.2 + +end BoundaryComponentCycle + +private theorem boundaryEdgeFourNeighbor (T : ProtoTile) (a b : GaussianInt) + (hab : ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) : + FourNeighborAdjacent a b := by + have boundary_edge_card_two (e : Finset GaussianInt) (he : e ∈ BoundaryFootprintEdges T) : + e.card = 2 := BoundaryComponentCycle.boundary_edge_card_two T e he + have habne : a ≠ b := by + intro h + subst b + have hc := boundary_edge_card_two {a, a} hab + simp at hc + rcases hab with ⟨q, (⟨heq, _⟩ | ⟨heq, _⟩)⟩ + · have ha : a ∈ ({q, q + 1} : Finset GaussianInt) := by rw [← heq]; simp + have hb : b ∈ ({q, q + 1} : Finset GaussianInt) := by rw [← heq]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at ha hb + rcases ha with rfl | rfl + · rcases hb with rfl | rfl + · exact (habne rfl).elim + · simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + · rcases hb with rfl | rfl + · simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + · exact (habne rfl).elim + · have ha : a ∈ ({q, q + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← heq]; simp + have hb : b ∈ ({q, q + ⟨0, 1⟩} : Finset GaussianInt) := by rw [← heq]; simp + simp only [Finset.mem_insert, Finset.mem_singleton] at ha hb + rcases ha with rfl | rfl + · rcases hb with rfl | rfl + · exact (habne rfl).elim + · simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + · rcases hb with rfl | rfl + · simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + · exact (habne rfl).elim + +theorem P5620T1BoundaryComponentCycle (T : ProtoTile) + (cells_nonempty : T.cells.Nonempty) + (boundary_degree_two : + ∀ v ∈ BoundaryFootprintVertices T, + Set.ncard {e : Finset GaussianInt | + e ∈ BoundaryFootprintEdges T ∧ v ∈ e} = 2) : + ∃ (p : List GaussianInt) (x y z : GaussianInt), + p.Nodup ∧ 4 ≤ p.length ∧ + p.head? = some x ∧ p.getLast? = some y ∧ + List.IsChain (fun a b => + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) p ∧ + ({y, x} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ∧ + List.IsChain FourNeighborAdjacent p ∧ FourNeighborAdjacent y x ∧ + (∀ a b, (a, b) ∈ p.zip p.tail → FourNeighborAdjacent a b) ∧ + (∀ a ∈ p, a ∈ BoundaryFootprintVertices T) ∧ + z ∈ T.cells ∧ (∀ q ∈ T.cells, q.re ≤ z.re) ∧ z + 1 ∉ T.cells ∧ + let cyclicEdges := (p.zip p.tail) ++ [(y, x)] + (∀ a b, (a, b) ∈ cyclicEdges → + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) ∧ + (∀ a b, (a, b) ∈ cyclicEdges → FourNeighborAdjacent a b) ∧ + (∀ a b, a ∈ p → + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T → + (a, b) ∈ cyclicEdges ∨ (b, a) ∈ cyclicEdges) ∧ + ((z + 1, z + 1 + ⟨0, 1⟩) ∈ cyclicEdges ∨ + (z + 1 + ⟨0, 1⟩, z + 1) ∈ cyclicEdges) := by +-- BODY + classical + have boundary_vertices_finite : (BoundaryFootprintVertices T).Finite := + BoundaryComponentCycle.boundary_vertices_finite T cells_nonempty + let BV := {v : GaussianInt // v ∈ BoundaryFootprintVertices T} + let : Fintype BV := boundary_vertices_finite.fintype + let G : SimpleGraph BV := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ BoundaryFootprintEdges T + have boundary_edge_card_two (e : Finset GaussianInt) + (he : e ∈ BoundaryFootprintEdges T) : e.card = 2 := + BoundaryComponentCycle.boundary_edge_card_two T e he + have graph_adj_iff (a b : BV) : + G.Adj a b ↔ + a ≠ b ∧ ({a.1, b.1} : Finset GaussianInt) ∈ BoundaryFootprintEdges T := + BoundaryComponentCycle.graph_adj_iff T a b + have graph_isCycles : G.IsCycles := BoundaryComponentCycle.graph_isCycles T cells_nonempty + boundary_degree_two + obtain ⟨z, hz, hmax⟩ := T.cells.exists_max_image (fun q => q.re) cells_nonempty + have hzout : z + 1 ∉ T.cells := by + intro hz1 + have hle := hmax (z + 1) hz1 + simp at hle + have hrightEdge : ({z + 1, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ + BoundaryFootprintEdges T := by + refine ⟨z + 1, Or.inr ⟨rfl, Or.inr ⟨hzout, ?_⟩⟩⟩ + simpa [Zsqrtd.ext_iff] using hz + have hrightVertex : z + 1 ∈ BoundaryFootprintVertices T := by + rw [BoundaryFootprintVertices, ite_eq_left cells_nonempty] + exact ⟨{z + 1, z + 1 + ⟨0, 1⟩}, hrightEdge, by simp⟩ + have hrightTopVertex : z + 1 + ⟨0, 1⟩ ∈ BoundaryFootprintVertices T := by + rw [BoundaryFootprintVertices, ite_eq_left cells_nonempty] + exact ⟨{z + 1, z + 1 + ⟨0, 1⟩}, hrightEdge, by simp⟩ + let v0 : BV := ⟨z + 1, hrightVertex⟩ + let v1 : BV := ⟨z + 1 + ⟨0, 1⟩, hrightTopVertex⟩ + have hv01 : G.Adj v0 v1 := by + apply (graph_adj_iff v0 v1).mpr + refine ⟨?_, hrightEdge⟩ + intro h + have hi := congrArg (fun q : BV => q.1.im) h + simp [v0, v1] at hi + let component := G.connectedComponentMk v0 + have hv0component : v0 ∈ component.supp := rfl + have hv0neighbor : (G.neighborSet v0).Nonempty := + ⟨v1, by rw [SimpleGraph.mem_neighborSet]; exact hv01⟩ + obtain ⟨p, x, y, hpNodup, hpLength, hpHead, hpLast, hpVerts, + hyx, hpChain, hpEdges⟩ := + FiniteCycleComponentList G graph_isCycles component v0 hv0component hv0neighbor + let gridPath : List GaussianInt := p.map Subtype.val + have gridPath_nodup : gridPath.Nodup := hpNodup.map Subtype.val_injective + have gridPath_length : 3 ≤ gridPath.length := by simpa [gridPath] using hpLength + have gridPath_head : gridPath.head? = some x.1 := by + simp only [gridPath, List.head?_map, hpHead, Option.map_some] + have gridPath_last : gridPath.getLast? = some y.1 := by + simp only [gridPath, List.getLast?_map, hpLast, Option.map_some] + have gridPath_chain : List.IsChain (fun a b => + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) gridPath := by + change List.IsChain (fun a b => + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) (p.map Subtype.val) + rw [List.isChain_map] + exact hpChain.imp fun a b hab => ((graph_adj_iff a b).mp hab).2 + have gridPath_close : + ({y.1, x.1} : Finset GaussianInt) ∈ BoundaryFootprintEdges T := + ((graph_adj_iff y x).mp hyx).2 + have boundary_edge_fourNeighbor (a b : GaussianInt) + (hab : ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) : + FourNeighborAdjacent a b := + boundaryEdgeFourNeighbor T a b hab + have gridPath_fourNeighbor : List.IsChain FourNeighborAdjacent gridPath := + gridPath_chain.imp fun a b hab => boundary_edge_fourNeighbor a b hab + have gridPath_close_fourNeighbor : FourNeighborAdjacent y.1 x.1 := + boundary_edge_fourNeighbor y.1 x.1 gridPath_close + have gridPath_zip_fourNeighbor : + ∀ a b, (a, b) ∈ gridPath.zip gridPath.tail → FourNeighborAdjacent a b := by + intro a b hab + rw [List.mem_iff_getElem] at hab + rcases hab with ⟨i, hi, hab⟩ + have hi' : i < gridPath.tail.length := by + simpa [List.length_zip] using hi + have hip : i + 1 < gridPath.length := by + simp only [List.length_tail] at hi' + omega + rw [List.getElem_zip, List.getElem_tail] at hab + injection hab with ha hb + rw [List.isChain_iff_getElem] at gridPath_fourNeighbor + simpa [ha, hb] using gridPath_fourNeighbor i hip + let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y.1, x.1)] + have gridPath_zip_boundary : + ∀ a b, (a, b) ∈ gridPath.zip gridPath.tail → + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T := by + intro a b hab + rw [List.mem_iff_getElem] at hab + rcases hab with ⟨i, hi, hab⟩ + have hi' : i < gridPath.tail.length := by + simpa [List.length_zip] using hi + have hip : i + 1 < gridPath.length := by + simp only [List.length_tail] at hi' + omega + rw [List.getElem_zip, List.getElem_tail] at hab + injection hab with ha hb + rw [List.isChain_iff_getElem] at gridPath_chain + simpa [ha, hb] using gridPath_chain i hip + have cyclic_edge_boundary (a b : GaussianInt) (hab : (a, b) ∈ cyclicEdges) : + ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T := by + simp only [cyclicEdges, List.mem_append, List.mem_singleton] at hab + rcases hab with hab | hab + · exact gridPath_zip_boundary a b hab + · have hab' : a = y.1 ∧ b = x.1 := Prod.mk.inj hab + simpa [hab'.1, hab'.2] using gridPath_close + have component_graph_edge_cyclic (a b : BV) (ha : a ∈ component.supp) + (hab : G.Adj a b) : + (a.1, b.1) ∈ cyclicEdges ∨ (b.1, a.1) ∈ cyclicEdges := by + rcases (hpEdges a b ha).mp hab with hclose | hopen + · rcases Sym2.eq_iff.mp hclose with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact Or.inl (by simp [cyclicEdges]) + · exact Or.inr (by simp [cyclicEdges]) + · rw [List.mem_iff_getElem] at hopen + rcases hopen with ⟨i, hi, hopen⟩ + have hi' : i < p.tail.length := by + simpa [List.length_zipWith] using hi + have hip : i + 1 < p.length := by + simp only [List.length_tail] at hi' + omega + rw [List.getElem_zipWith, List.getElem_tail] at hopen + have hpPair : (p[i].1, p[i + 1].1) ∈ gridPath.zip gridPath.tail := by + rw [List.mem_iff_getElem] + refine ⟨i, ?_, ?_⟩ + · simpa [gridPath, List.length_zip, List.length_zipWith] using hi + · rw [List.getElem_zip, List.getElem_tail] + simp [gridPath] + rcases Sym2.eq_iff.mp hopen with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact Or.inl (by simp [cyclicEdges, hpPair]) + · exact Or.inr (by simp [cyclicEdges, hpPair]) + have hrightCyclic : + (z + 1, z + 1 + ⟨0, 1⟩) ∈ cyclicEdges ∨ + (z + 1 + ⟨0, 1⟩, z + 1) ∈ cyclicEdges := by + simpa [v0, v1] using + component_graph_edge_cyclic v0 v1 hv0component hv01 + have gridPath_length_four : 4 ≤ gridPath.length := by + by_contra hfour + have hlen : gridPath.length = 3 := by omega + rcases List.length_eq_three.mp hlen with ⟨a, b, c, hpath⟩ + have hab : FourNeighborAdjacent a b := by + rw [hpath] at gridPath_fourNeighbor + simpa using gridPath_fourNeighbor.rel + have hbc : FourNeighborAdjacent b c := by + rw [hpath] at gridPath_fourNeighbor + simpa using gridPath_fourNeighbor.tail.rel + have hxa : x.1 = a := by + rw [hpath] at gridPath_head + exact (Option.some.inj gridPath_head).symm + have hyc : y.1 = c := by + rw [hpath] at gridPath_last + exact (Option.some.inj gridPath_last).symm + have hca : FourNeighborAdjacent c a := by + simpa [hxa, hyc] using gridPath_close_fourNeighbor + have step_sum (u v : GaussianInt) (huv : FourNeighborAdjacent u v) : + (v.re : Int) + v.im = (u.re : Int) + u.im + 1 ∨ + (v.re : Int) + v.im = (u.re : Int) + u.im - 1 := by + rcases huv with rfl | rfl | rfl | rfl <;> + simp [] <;> omega + rcases step_sum a b hab with habs | habs <;> + rcases step_sum b c hbc with hbcs | hbcs <;> + rcases step_sum c a hca with hcas | hcas <;> omega + have gridPath_mem_boundary (a : GaussianInt) (ha : a ∈ gridPath) : + a ∈ BoundaryFootprintVertices T := by + rcases List.mem_map.mp ha with ⟨v, _, rfl⟩ + exact v.property + have component_edge_cyclic (a b : GaussianInt) (ha : a ∈ gridPath) + (hab : ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) : + (a, b) ∈ cyclicEdges ∨ (b, a) ∈ cyclicEdges := by + rcases List.mem_map.mp ha with ⟨v, hv, rfl⟩ + have hb : b ∈ BoundaryFootprintVertices T := by + rw [BoundaryFootprintVertices, ite_eq_left cells_nonempty] + exact ⟨{v.1, b}, hab, by simp⟩ + let w : BV := ⟨b, hb⟩ + have hvw : v ≠ w := by + intro heq + have hval : v.1 = b := congrArg Subtype.val heq + have hc := boundary_edge_card_two {v.1, b} hab + simp [hval] at hc + apply component_graph_edge_cyclic v w ?_ + ((graph_adj_iff v w).mpr ⟨hvw, hab⟩) + rw [← hpVerts, Finset.mem_coe, List.mem_toFinset] + exact hv + refine ⟨gridPath, x.1, y.1, z, gridPath_nodup, gridPath_length_four, + gridPath_head, gridPath_last, gridPath_chain, gridPath_close, + gridPath_fourNeighbor, gridPath_close_fourNeighbor, gridPath_zip_fourNeighbor, + gridPath_mem_boundary, hz, hmax, hzout, cyclic_edge_boundary, ?_, + component_edge_cyclic, hrightCyclic⟩ + intro a b hab + exact boundary_edge_fourNeighbor a b (cyclic_edge_boundary a b hab) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5625T1CentroidSlopeDifferenceCovariance.lean b/LeanPool/ApollonianSuperharmonic/P5625T1CentroidSlopeDifferenceCovariance.lean new file mode 100644 index 0000000000..e7ef6e06bf --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5625T1CentroidSlopeDifferenceCovariance.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas + +-- [TABLET NODE: P5625T1CentroidSlopeDifferenceCovariance] + +/-! +# P5625T1CentroidSlopeDifferenceCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5625T1CentroidSlopeDifferenceCovariance : + (∀ (g : BandPackingSymmetry) (z : GaussianInt × GaussianInt), + (BandPackingSymmetryAffineVectorAction g z).1 = + BandPackingSymmetryVectorAction g z.1) ∧ + ∀ (g : BandPackingSymmetry) (U V : ProtoTile) + (x y : ℝ × ℝ) (v a : GaussianInt) (k : ℝ), + TileCentroid V - TileCentroid U = k • GaussianRealPoint v → + x - y = k • GaussianRealPoint a → + TileCentroid (BandPackingSymmetryTileAction g V) - + TileCentroid (BandPackingSymmetryTileAction g U) = + k • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g (v, a)).1 ∧ + BandPackingSymmetrySlopeAction g V x - + BandPackingSymmetrySlopeAction g U y = + k • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g (v, a)).2 := by +-- BODY + constructor + · intro g + induction g with + | identity => intro z; rfl + | shift w => intro z; rfl + | negate => intro z; rfl + | conjugate => intro z; rfl + | comp a b iha ihb => + intro z + change (BandPackingSymmetryAffineVectorAction a + (BandPackingSymmetryAffineVectorAction b z)).1 = + BandPackingSymmetryVectorAction a (BandPackingSymmetryVectorAction b z.1) + rw [iha, ihb] + · intro g + induction g with + | identity => + intro U V x y v a k hc hp + exact ⟨hc, hp⟩ + | shift w => + intro U V x y v a k hc hp + rcases w with ⟨wr, wi⟩ + rcases v with ⟨vr, vi⟩ + rcases a with ⟨ar, ai⟩ + refine ⟨hc, ?_⟩ + have hc1 := congrArg Prod.fst hc + have hc2 := congrArg Prod.snd hc + have hp1 := congrArg Prod.fst hp + have hp2 := congrArg Prod.snd hp + apply Prod.ext + all_goals + simp [BandPackingSymmetrySlopeAction, BandPackingSymmetryAffineVectorAction, + GaussianRealPoint, GaussianReflection] at hc1 hc2 hp1 hp2 ⊢ + ring_nf + nlinarith [congrArg (fun z : ℝ => (wr : ℝ) * z) hc1, + congrArg (fun z : ℝ => (wi : ℝ) * z) hc2, + congrArg (fun z : ℝ => (wi : ℝ) * z) hc1, + congrArg (fun z : ℝ => (wr : ℝ) * z) hc2] + | negate => + intro U V x y v a k hc hp + have hc1 := congrArg Prod.fst hc + have hc2 := congrArg Prod.snd hc + have hp1 := congrArg Prod.fst hp + have hp2 := congrArg Prod.snd hp + change TileCentroid (TileQuarterTurn V) - TileCentroid (TileQuarterTurn U) = _ ∧ _ + rw [(TileQuarterTurnFormulas V).2.2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.2.1] + constructor <;> apply Prod.ext + all_goals + simp [BandPackingSymmetrySlopeAction, BandPackingSymmetryAffineVectorAction, + GaussianRealPoint, GaussianQuarterTurn] at hc1 hc2 hp1 hp2 ⊢ + linarith + | conjugate => + intro U V x y v a k hc hp + have hc1 := congrArg Prod.fst hc + have hc2 := congrArg Prod.snd hc + have hp1 := congrArg Prod.fst hp + have hp2 := congrArg Prod.snd hp + change TileCentroid (TileQuarterTurn (TileQuarterTurn (TileReflection V))) - + TileCentroid (TileQuarterTurn (TileQuarterTurn (TileReflection U))) = _ ∧ _ + rw [(TileQuarterTurnFormulas (TileQuarterTurn (TileReflection V))).2.2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn (TileReflection U))).2.2.2.2.1, + (TileQuarterTurnFormulas (TileReflection V)).2.2.2.2.1, + (TileQuarterTurnFormulas (TileReflection U)).2.2.2.2.1, + (TileReflectionFormulas V).2.2.2.2.1, + (TileReflectionFormulas U).2.2.2.2.1] + constructor <;> apply Prod.ext + all_goals + simp [BandPackingSymmetrySlopeAction, BandPackingSymmetryAffineVectorAction, + GaussianRealPoint, GaussianReflection] at hc1 hc2 hp1 hp2 ⊢ + linarith + | comp a b iha ihb => + intro U V x y v w k hc hp + have hh := ihb U V x y v w k hc hp + exact iha (BandPackingSymmetryTileAction b U) + (BandPackingSymmetryTileAction b V) + (BandPackingSymmetrySlopeAction b V x) + (BandPackingSymmetrySlopeAction b U y) + (BandPackingSymmetryAffineVectorAction b (v, w)).1 + (BandPackingSymmetryAffineVectorAction b (v, w)).2 k hh.1 hh.2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean new file mode 100644 index 0000000000..96662561fb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean @@ -0,0 +1,1085 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizedBundleExists +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRoutedSelectedContact +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightSelectedRowGeometry +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightSelectedAdjacency +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightOuterMarkingCriterion +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMarkedSectorTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryMarkedDataCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance + +-- [TABLET NODE: P5630T1MarkedRightOdometerAdjacencyReduction] + +/-! +# P5630T1MarkedRightOdometerAdjacencyReduction + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace MarkedRightAdjacencyGeometry + +private theorem hnorm : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), + bundle.normalizedCircle.1.1 = BandPackingSymmetryCircleAction bundle.symmetry C.1.1 ) + := by + classical + intro C T T₀ h h₀ x bundle + calc + bundle.normalizedCircle.1.1 = bundle.normalizedPresentation 0 := + bundle.normalized_circle_eq.symm + _ = BandPackingSymmetryCircleAction bundle.symmetry C.1.1 := by + rw [bundle.normalized_presentation_eq, bundle.rotated_presentation_eq] + simp [BandPackingSymmetryQuadrupleAction, + bundle.presentation_child] + +private theorem hfixedCircleEq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), + (bundle.normalizedCircle.1.1 = BandPackingSymmetryCircleAction bundle.symmetry C.1.1) + → (bundle.normalizedFixedCircle.1.1 = bundle.normalizedCircle.1.1) ) := by + classical + intro C T T₀ h h₀ x bundle hnorm + rw [bundle.normalized_fixed_circle_eq] + exact hnorm.symm + +private theorem hfixedOdometer : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), + (bundle.normalizedFixedCircle.1.1 = bundle.normalizedCircle.1.1) → (TileOdometer + (bundle.normalizedPresentation 0) bundle.normalizedFixed + bundle.normalizedFixedFunction) ) := by + classical + intro C T T₀ h h₀ x bundle hfixedCircleEq + rw [bundle.normalized_circle_eq, ← hfixedCircleEq] + exact bundle.normalized_fixed_odometer + +private theorem hparentPositive : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (C' : BandCircle), + (bundle.normalizedPresentation bundle.selectedSlot.succ = C'.1.1) → (0 < + (bundle.normalizedPresentation bundle.selectedSlot.succ).1) ) := by + classical + intro C T T₀ h h₀ x bundle C' hq' + rw [hq'] + exact C'.property + +private theorem actionCurvatureAt244 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (c : CircleCoordinates), (BandPackingSymmetryCircleAction + g c).1 = c.1 ) := by + classical + intro g + induction g with + | identity => intro c; rfl + | negate => intro c; rfl + | conjugate => intro c; rfl + | shift w => intro c; rfl + | comp a b iha ihb => intro c; simp [BandPackingSymmetryCircleAction, iha, ihb] + +private theorem hinverseCoordinate : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (C' : BandCircle), + (C'.1.1 = bundle.normalizedPresentation bundle.selectedSlot.succ) → (∀ (ginv : + BandPackingSymmetry), + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + inversePresentation inverseSlot.succ = BandPackingSymmetryCircleAction ginv C'.1.1) ) := by + classical + intro C T T₀ h h₀ x bundle C' hC' ginv inversePresentation inverseSlot + unfold inversePresentation inverseSlot + rw [hC'] + generalize hidx : bundle.selectedSlot = j + have neg1 : -(1 : Fin 3) = 2 := rfl + have neg2 : -(2 : Fin 3) = 1 := rfl + by_cases hrev : BandPackingSymmetryReversesOrientation ginv <;> + fin_cases j <;> + simp [BandPackingSymmetryQuadrupleAction, + hrev, neg1, neg2]; + +private theorem hinversePositive : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (C' : BandCircle), ∀ + (ginv : BandPackingSymmetry), (∀ (g : BandPackingSymmetry), ∀ (c : + CircleCoordinates), (BandPackingSymmetryCircleAction g c).1 = c.1) → ( + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + (inversePresentation inverseSlot.succ = BandPackingSymmetryCircleAction ginv C'.1.1) → (0 + < (inversePresentation inverseSlot.succ).1)) ) := by + classical + intro C T T₀ h h₀ x bundle C' ginv actionCurvature inversePresentation inverseSlot + hinverseCoordinate + rw [hinverseCoordinate, actionCurvature] + exact C'.property + +private theorem hsubNormalized : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (C' : BandCircle), + (TileSubodometer bundle.normalizedCircle.1.1 C'.1.1 bundle.normalizedRoot + (bundle.pieces bundle.selectedSlot + bundle.selectedSign) bundle.normalizedRootFunction (bundle.functions + bundle.selectedSlot bundle.selectedSign)) → ((bundle.normalizedCircle.1.1 = + BandPackingSymmetryCircleAction + bundle.symmetry C.1.1) → ( + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + TileSubodometer (BandPackingSymmetryCircleAction bundle.symmetry C.1.1) C'.1.1 + (BandPackingSymmetryTileAction bundle.symmetry T) selectedSupport + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h) selectedFunction)) ) := by + classical + intro C T T₀ h h₀ x bundle C' hsub hnorm selectedSupport selectedFunction + simpa [hnorm, bundle.normalized_root_eq, + bundle.normalized_root_function_eq] using hsub + +private theorem hsubInverse : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ((∀ (g : BandPackingSymmetry), ∀ (C : + CircleCoordinates), ∀ (C' : CircleCoordinates), ∀ (T : ProtoTile), ∀ (T' : + ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : PartialOdometer), TileSubodometer C C' T + T' h h' ↔ TileSubodometer (BandPackingSymmetryCircleAction g C) + (BandPackingSymmetryCircleAction g C') (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryTileAction g T') (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g h')) ∧ (∀ (g : BandPackingSymmetry), ∀ (x + : GaussianInt), ∀ (T : ProtoTile), ∀ (U : ProtoTile), (∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ T.cells ∨ LatticeVertexIncidentCell x j ∈ U.cells) ↔ + ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell (BandPackingSymmetryVectorAction g x) + j ∈ (BandPackingSymmetryTileAction g T).cells ∨ LatticeVertexIncidentCell + (BandPackingSymmetryVectorAction g x) j ∈ (BandPackingSymmetryTileAction g U).cells) + ∧ ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q → ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (delta : Bool), + BandPackingSymmetryScopedPhase g q delta → ∀ (T : ProtoTile), ∀ (x : GaussianInt), + let q' := BandPackingSymmetryQuadrupleAction g q; + let sigma := fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true + then -j else j; + let s' := if BandPackingSymmetryReversesOrientation g = true then -s - (1 : Fin (4 : ℕ)) + + if delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else s + if delta = + true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)); + let oldRight := TileTranslation T ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if + Even (↑s : ℕ) then BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) else BandVectors.1 + (q i.succ) (q (0 : Fin (4 : ℕ)))); + let newRight := TileTranslation (BandPackingSymmetryTileAction g T) ((⟨(0 : ℤ), (1 : ℤ)⟩ + : GaussianInt) ^ (↑s' : ℕ) * if Even (↑s' : ℕ) then BandVectors.1 (q' (0 : Fin (4 : + ℕ))) (q' (sigma i).succ) else BandVectors.1 (q' (sigma i).succ) (q' (0 : Fin (4 : + ℕ)))); BandPackingSymmetryTileAction g oldRight = newRight ∧ (x ∈ FootprintVertices + oldRight ↔ BandPackingSymmetryVectorAction g x ∈ FootprintVertices newRight)) → (∀ + (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (C' : + BandCircle), ∀ (ginv : BandPackingSymmetry), (∀ (C_1 : CircleCoordinates), + BandPackingSymmetryCircleAction ginv (BandPackingSymmetryCircleAction bundle.symmetry + C_1) = C_1) → ((∀ (T_1 : ProtoTile), BandPackingSymmetryTileAction ginv + (BandPackingSymmetryTileAction bundle.symmetry T_1) = T_1) → ((∀ (h_1 : + PartialOdometer), BandPackingSymmetryPartialOdometerAction ginv + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h_1) = h_1) → ( + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + ∀ (hinverseProper : ProperBandQuadruple inversePresentation), ∀ (hinversePositive : 0 < + (inversePresentation inverseSlot.succ).1), + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + (inverseCircle.1.1 = BandPackingSymmetryCircleAction ginv C'.1.1) → ( + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + (TileSubodometer (BandPackingSymmetryCircleAction bundle.symmetry C.1.1) C'.1.1 + (BandPackingSymmetryTileAction bundle.symmetry T) selectedSupport + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h) selectedFunction) → + (TileSubodometer C.1.1 inverseCircle.1.1 T T' h h')))))) ) := by + classical + intro C T T₀ h h₀ x markedData bundle C' ginv hcircleL htileL hfunL inversePresentation + inverseSlot hinverseProper hinversePositive inverseCircle hinverseCircle selectedSupport + selectedFunction T' h' hsubNormalized + have htransport := + (markedData.1 ginv (BandPackingSymmetryCircleAction bundle.symmetry C.1.1) + C'.1.1 (BandPackingSymmetryTileAction bundle.symmetry T) selectedSupport + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h) + selectedFunction).mp hsubNormalized + simpa [hcircleL, htileL, hfunL, hinverseCircle, T', h'] using htransport + +private theorem inverseDomain : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (ginv : + BandPackingSymmetry), (∀ (v : GaussianInt), BandPackingSymmetryVectorAction ginv + (BandPackingSymmetryVectorAction bundle.symmetry v) = v) → (∀ (f : PartialOdometer), + ∀ (y : GaussianInt), (BandPackingSymmetryVectorAction bundle.symmetry y ∈ f.domain) → + (y ∈ (BandPackingSymmetryPartialOdometerAction ginv f).domain)) ) := by + classical + intro C T T₀ h h₀ x bundle ginv hvecL f y hy + change y ∈ ((BandPackingSymmetryPartialOdometerAction ginv f).domain : Set GaussianInt) + rw [(BandPackingSymmetryPartialOdometerActionFormulas ginv f f).1] + exact ⟨BandPackingSymmetryVectorAction bundle.symmetry y, hy, hvecL y⟩ + +private theorem hxFixedOriginal : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), + (bundle.normalizedPoint ∈ bundle.normalizedFixedFunction.domain) → (∀ (ginv : + BandPackingSymmetry), (∀ (h_1 : PartialOdometer), + BandPackingSymmetryPartialOdometerAction ginv + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h_1) = h_1) → ((∀ (f : + PartialOdometer), ∀ (y : GaussianInt), (BandPackingSymmetryVectorAction + bundle.symmetry y ∈ f.domain) → (y ∈ (BandPackingSymmetryPartialOdometerAction ginv + f).domain)) → ((BandPackingSymmetryVectorAction bundle.symmetry x = + bundle.normalizedPoint) → (x ∈ h₀.domain)))) ) := by + classical + intro C T T₀ h h₀ x bundle hxFixed ginv hfunL inverseDomain hpoint + have hback := inverseDomain + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h₀) x (by + simpa [hpoint, bundle.normalized_fixed_function_eq] using hxFixed) + simpa [bundle.normalized_fixed_function_eq, hfunL] using hback + +private theorem hxSelectedOriginal : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), + (bundle.normalizedPoint ∈ (bundle.functions bundle.selectedSlot + bundle.selectedSign).domain) → (∀ (ginv : BandPackingSymmetry), + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + (∀ (f : PartialOdometer), ∀ (y : GaussianInt), (BandPackingSymmetryVectorAction + bundle.symmetry y ∈ f.domain) → (y ∈ (BandPackingSymmetryPartialOdometerAction ginv + f).domain)) → ((BandPackingSymmetryVectorAction bundle.symmetry x = + bundle.normalizedPoint) → (x ∈ h'.domain))) ) := by + classical + intro C T T₀ h h₀ x bundle hxSelected ginv selectedFunction h' inverseDomain hpoint + have hback := inverseDomain selectedFunction x (by simpa [hpoint] using hxSelected) + simpa [h'] using hback + +private theorem mapStar : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (b = a ∨ b = a + 1 + ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → (BandPackingSymmetryVectorAction g b + = BandPackingSymmetryVectorAction g a ∨ BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a + 1 ∨ BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a - 1 ∨ BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a + ⟨0, 1⟩ ∨ BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a - ⟨0, 1⟩) ) := by + classical + intro g + induction g with + | identity => intro a b hb; simpa [BandPackingSymmetryVectorAction] using hb + | shift w => intro a b hb; simpa [BandPackingSymmetryVectorAction] using hb + | negate => + intro a b hb + rcases hb with hb | hb | hb | hb | hb + · subst b; simp [BandPackingSymmetryVectorAction] + · subst b; right; right; right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] + · subst b; right; right; right; right + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] + · subst b; right; right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn]; try ring + · subst b; right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn]; try ring + | conjugate => + intro a b hb + rcases hb with hb | hb | hb | hb | hb + · subst b; simp [BandPackingSymmetryVectorAction] + · subst b; right; right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection]; try ring + · subst b; right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection]; try ring + · subst b; right; right; right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] + · subst b; right; right; right; right + ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] + | comp g₁ g₂ ih₁ ih₂ => + intro a b hb + exact ih₁ _ _ (ih₂ _ _ hb) + +private theorem hstarOriginal : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), (∀ (y : GaussianInt), + y = bundle.normalizedPoint ∨ y = bundle.normalizedPoint + (1 : GaussianInt) ∨ y = + bundle.normalizedPoint - (1 : GaussianInt) ∨ y = bundle.normalizedPoint + (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt) ∨ y = bundle.normalizedPoint - (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) → y ∈ bundle.normalizedFixedFunction.domain ∨ y ∈ (bundle.functions + bundle.selectedSlot bundle.selectedSign).domain) → (∀ (ginv : BandPackingSymmetry), + (∀ (h_1 : PartialOdometer), BandPackingSymmetryPartialOdometerAction ginv + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h_1) = h_1) → ( + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + (∀ (f : PartialOdometer), ∀ (y : GaussianInt), (BandPackingSymmetryVectorAction + bundle.symmetry y ∈ f.domain) → (y ∈ (BandPackingSymmetryPartialOdometerAction ginv + f).domain)) → ((BandPackingSymmetryVectorAction bundle.symmetry x = + bundle.normalizedPoint) → ((∀ (g : BandPackingSymmetry), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), (b = a ∨ b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (BandPackingSymmetryVectorAction g b = BandPackingSymmetryVectorAction g a ∨ + BandPackingSymmetryVectorAction g b = BandPackingSymmetryVectorAction g a + 1 ∨ + BandPackingSymmetryVectorAction g b = BandPackingSymmetryVectorAction g a - 1 ∨ + BandPackingSymmetryVectorAction g b = BandPackingSymmetryVectorAction g a + ⟨0, 1⟩ ∨ + BandPackingSymmetryVectorAction g b = BandPackingSymmetryVectorAction g a - ⟨0, 1⟩)) + → (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ + h₀.domain ∨ y ∈ h'.domain))))) ) := by + classical + intro C T T₀ h h₀ x bundle hstar' ginv hfunL selectedFunction h' inverseDomain hpoint mapStar y hy + have hnormalizedStar := mapStar bundle.symmetry x y hy + rw [hpoint] at hnormalizedStar + have hmem := hstar' (BandPackingSymmetryVectorAction bundle.symmetry y) + hnormalizedStar + rcases hmem with hfixed | hselected + · left + have hback := inverseDomain + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h₀) y (by + simpa [bundle.normalized_fixed_function_eq] using hfixed) + simpa [hfunL] using hback + · right + have hback := inverseDomain selectedFunction y hselected + simpa [h'] using hback + +private theorem hselectedCoord : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (C' : BandCircle), + (bundle.normalizedPresentation bundle.selectedSlot.succ = C'.1.1) → (∀ (ginv : + BandPackingSymmetry), + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + ∀ (hinverseProper : ProperBandQuadruple inversePresentation), ∀ (hinversePositive : 0 < + (inversePresentation inverseSlot.succ).1), + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + (inverseCircle.1.1 = BandPackingSymmetryCircleAction ginv C'.1.1) → + ((BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) (if + BandPackingSymmetryReversesOrientation ginv then -bundle.selectedSlot else + bundle.selectedSlot).succ = inverseCircle.1.1)) ) := by + classical + intro C T T₀ h h₀ x bundle C' hq' ginv inversePresentation inverseSlot hinverseProper + hinversePositive inverseCircle hinverseCircle + have neg1 : -(1 : Fin 3) = 2 := rfl + have neg2 : -(2 : Fin 3) = 1 := rfl + calc + (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) + (if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot).succ = + BandPackingSymmetryCircleAction ginv + (bundle.normalizedPresentation bundle.selectedSlot.succ) := by + generalize hidx : bundle.selectedSlot = j + by_cases hrev : BandPackingSymmetryReversesOrientation ginv <;> + fin_cases j <;> + simp [BandPackingSymmetryQuadrupleAction, + hrev, neg1, neg2] + _ = BandPackingSymmetryCircleAction ginv C'.1.1 := + congrArg (BandPackingSymmetryCircleAction ginv) hq' + _ = inverseCircle.1.1 := hinverseCircle.symm + +private theorem hrootAction : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (ginv : + BandPackingSymmetry), (∀ (C_1 : CircleCoordinates), BandPackingSymmetryCircleAction + ginv (BandPackingSymmetryCircleAction bundle.symmetry C_1) = C_1) → + ((bundle.normalizedCircle.1.1 = + BandPackingSymmetryCircleAction bundle.symmetry C.1.1) → + (BandPackingSymmetryCircleAction ginv (bundle.normalizedPresentation 0) = C.1.1)) ) + := by + classical + intro C T T₀ h h₀ x bundle ginv hcircleL hnorm + calc + BandPackingSymmetryCircleAction ginv (bundle.normalizedPresentation 0) = + BandPackingSymmetryCircleAction ginv bundle.normalizedCircle.1.1 := + congrArg (BandPackingSymmetryCircleAction ginv) + bundle.normalized_circle_eq + _ = BandPackingSymmetryCircleAction ginv + (BandPackingSymmetryCircleAction bundle.symmetry C.1.1) := + congrArg (BandPackingSymmetryCircleAction ginv) hnorm + _ = C.1.1 := hcircleL C.1.1 + +private theorem hOFixedOriginal : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (ginv : + BandPackingSymmetry), (∀ (T_1 : ProtoTile), BandPackingSymmetryTileAction ginv + (BandPackingSymmetryTileAction bundle.symmetry T_1) = T_1) → ((∀ (h_1 : + PartialOdometer), BandPackingSymmetryPartialOdometerAction ginv + (BandPackingSymmetryPartialOdometerAction bundle.symmetry h_1) = h_1) → + ((TileOdometer (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + (0 : Fin (4 : ℕ))) (BandPackingSymmetryTileAction ginv bundle.normalizedFixed) + (BandPackingSymmetryPartialOdometerAction ginv bundle.normalizedFixedFunction)) → + ((BandPackingSymmetryCircleAction ginv (bundle.normalizedPresentation 0) = C.1.1) → + (TileOdometer C.1.1 T₀ h₀)))) ) := by + classical + intro C T T₀ h h₀ x bundle ginv htileL hfunL hOFixedInv hrootAction + have h := hOFixedInv + change TileOdometer + (BandPackingSymmetryCircleAction ginv (bundle.normalizedPresentation 0)) + (BandPackingSymmetryTileAction ginv bundle.normalizedFixed) + (BandPackingSymmetryPartialOdometerAction ginv + bundle.normalizedFixedFunction) at h + rw [hrootAction] at h + rw [bundle.normalized_fixed_eq, htileL, + bundle.normalized_fixed_function_eq, hfunL] at h + exact h + +private theorem hcentOriginal : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (ginv : + BandPackingSymmetry), (∀ (T_1 : ProtoTile), BandPackingSymmetryTileAction ginv + (BandPackingSymmetryTileAction bundle.symmetry T_1) = T_1) → (∀ (t' : Fin (4 : ℕ)), + (TileCentroid (BandPackingSymmetryTileAction ginv (bundle.pieces bundle.selectedSlot + bundle.selectedSign)) - TileCentroid (BandPackingSymmetryTileAction ginv + bundle.normalizedFixed) = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ^ (↑t' : ℕ) * (BandVectors.1 (BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation (if BandPackingSymmetryReversesOrientation ginv = true + then -bundle.selectedSlot else bundle.selectedSlot).succ) + (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation (0 : Fin (4 : + ℕ))) + BandVectors.1 (BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (BandPackingSymmetryQuadrupleAction + ginv bundle.normalizedPresentation (if BandPackingSymmetryReversesOrientation ginv = + true then -bundle.selectedSlot else bundle.selectedSlot).succ)))) → ( + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + TileCentroid T' - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : + GaussianInt) ^ t'.val * (BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation) (if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot).succ) + ((BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) 0) + + BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation) 0) ((BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation) (if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot).succ))))) ) := by + classical + intro C T T₀ h h₀ x bundle ginv htileL t' hcentInv selectedSupport T' + simpa [T', bundle.normalized_fixed_eq, htileL] using hcentInv + +private theorem hrootCoord : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (ginv : + BandPackingSymmetry), (∀ (C_1 : CircleCoordinates), BandPackingSymmetryCircleAction + ginv (BandPackingSymmetryCircleAction bundle.symmetry C_1) = C_1) → + ((bundle.normalizedCircle.1.1 = + BandPackingSymmetryCircleAction bundle.symmetry C.1.1) → + ((BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) 0 = C.1.1)) + ) := by + classical + intro C T T₀ h h₀ x bundle ginv hcircleL hnorm + calc + (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) 0 = + BandPackingSymmetryCircleAction ginv + (bundle.normalizedPresentation 0) := by + simp [BandPackingSymmetryQuadrupleAction] + _ = C.1.1 := by + rw [bundle.normalized_circle_eq, hnorm] + exact hcircleL C.1.1 + +private theorem hnewAdj : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), (ProperBandQuadruple + bundle.normalizedPresentation) → (∀ (ginv : BandPackingSymmetry), ∀ (pFixed : ℝ × ℝ), + ∀ (pSelected : ℝ × ℝ), ∀ (t' : Fin (4 : ℕ)), (PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction ginv (bundle.functions bundle.selectedSlot + bundle.selectedSign)) = some pSelected) → ((pSelected.1 - pFixed.1 = (1 / 2 : ℝ) * + (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t' : ℕ) * + (BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + (if BandPackingSymmetryReversesOrientation ginv = true then -bundle.selectedSlot else + bundle.selectedSlot).succ) (BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation (0 : Fin (4 : + ℕ))) (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation (if + BandPackingSymmetryReversesOrientation ginv = true then -bundle.selectedSlot else + bundle.selectedSlot).succ)))).1) → ((pSelected.2 - pFixed.2 = (1 / 2 : ℝ) * + (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t' : ℕ) * + (BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + (if BandPackingSymmetryReversesOrientation ginv = true then -bundle.selectedSlot else + bundle.selectedSlot).succ) (BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation (0 : Fin (4 : ℕ))) + BandVectors.2 + (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation (0 : Fin (4 : + ℕ))) (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation (if + BandPackingSymmetryReversesOrientation ginv = true then -bundle.selectedSlot else + bundle.selectedSlot).succ)))).2) → ( + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + ∀ (hinverseProper : ProperBandQuadruple inversePresentation), ∀ (hinversePositive : 0 < + (inversePresentation inverseSlot.succ).1), + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + ((BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) (if + BandPackingSymmetryReversesOrientation ginv then -bundle.selectedSlot else + bundle.selectedSlot).succ = inverseCircle.1.1) → ((TileOdometer C.1.1 T₀ h₀) → + ((TileOdometer inverseCircle.1.1 T' h') → ((PartialOdometerSlope h₀ = some pFixed) → + ((TileCentroid T' - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : + GaussianInt) ^ t'.val * (BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation) (if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot).succ) + ((BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) 0) + + BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation) 0) ((BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation) (if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot).succ)))) → + (((BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) 0 = C.1.1) + → (SubtileLatticeAdjacent C inverseCircle T₀ T' h₀ h')))))))))) ) := by + classical + intro C T T₀ h h₀ x bundle hq ginv pFixed pSelected t' hslopeSelectedInv hslopeReInv + hslopeImInv inversePresentation inverseSlot hinverseProper hinversePositive inverseCircle + selectedSupport selectedFunction T' h' hselectedCoord hOFixedOriginal hOSelectedOriginal + hslopeFixedOriginal hcentOriginal hrootCoord + refine ⟨hOFixedOriginal, hOSelectedOriginal, pFixed, pSelected, + hslopeFixedOriginal, hslopeSelectedInv, ?_⟩ + exact ⟨BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation, + (if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot), + t', BandPackingSymmetryProperCovariance ginv bundle.normalizedPresentation hq, + hrootCoord, hselectedCoord, hcentOriginal, hslopeReInv, hslopeImInv⟩ + +private theorem actionCurvatureAt449 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (c : CircleCoordinates), (BandPackingSymmetryCircleAction + g c).1 = c.1 ) := by + classical + intro g + induction g with + | identity => intro c; rfl + | negate => intro c; rfl + | conjugate => intro c; rfl + | shift w => intro c; rfl + | comp a b iha ihb => intro c; simp [BandPackingSymmetryCircleAction, iha, ihb] + +private theorem hsizeOriginal : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (C' : BandCircle), + (bundle.normalizedCircle.1.1.1.toNat + + C'.1.1.1.toNat < bundle.normalizedCircle.1.1.1.toNat + + bundle.normalizedCircle.1.1.1.toNat) → (∀ (ginv : BandPackingSymmetry), + (bundle.normalizedCircle.1.1 = + BandPackingSymmetryCircleAction bundle.symmetry C.1.1) → ((∀ (g : + BandPackingSymmetry), ∀ (c : CircleCoordinates), (BandPackingSymmetryCircleAction g + c).1 = c.1) → ( + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + ∀ (hinverseProper : ProperBandQuadruple inversePresentation), ∀ (hinversePositive : 0 < + (inversePresentation inverseSlot.succ).1), + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + (inverseCircle.1.1 = BandPackingSymmetryCircleAction ginv C'.1.1) → (Int.toNat C.1.1.1 + + Int.toNat inverseCircle.1.1.1 < Int.toNat C.1.1.1 + Int.toNat C.1.1.1)))) ) := by + classical + intro C T T₀ h h₀ x bundle C' hsize ginv hnorm actionCurvature inversePresentation inverseSlot + hinverseProper hinversePositive inverseCircle hinverseCircle + have hrootCurv : C.1.1.1 = bundle.normalizedCircle.1.1.1 := by + rw [hnorm] + exact (actionCurvature bundle.symmetry C.1.1).symm + have hchildCurv : inverseCircle.1.1.1 = C'.1.1.1 := by + rw [hinverseCircle] + exact actionCurvature ginv C'.1.1 + rw [hrootCurv, hchildCurv] + exact hsize + +private theorem coverShape : + (by + classical + exact + ∀ (a : GaussianInt), ∀ (A : ProtoTile), ∀ (B : ProtoTile), (∀ z, z = a ∨ z = a - 1 ∨ z = + a - ⟨0, 1⟩ ∨ z = a - 1 - ⟨0, 1⟩ → z ∈ A.cells ∨ z ∈ B.cells) ↔ (∀ j : Fin 4, + LatticeVertexIncidentCell a j ∈ A.cells ∨ LatticeVertexIncidentCell a j ∈ B.cells) ) + := by + classical + intro a A B + constructor + · intro h j + fin_cases j <;> simp? [LatticeVertexIncidentCell] <;> + first | exact h _ (by simp) + · intro h z hz + rcases hz with hz | hz | hz | hz + · subst z; simpa [LatticeVertexIncidentCell] using h 0 + · subst z; simpa [LatticeVertexIncidentCell] using h 1 + · subst z; simpa [LatticeVertexIncidentCell] using h 3 + · subst z; simpa [LatticeVertexIncidentCell] using h 2 + +private theorem hcoverOriginal : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ((∀ (g : BandPackingSymmetry), ∀ (C : + CircleCoordinates), ∀ (C' : CircleCoordinates), ∀ (T : ProtoTile), ∀ (T' : + ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : PartialOdometer), TileSubodometer C C' T + T' h h' ↔ TileSubodometer (BandPackingSymmetryCircleAction g C) + (BandPackingSymmetryCircleAction g C') (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryTileAction g T') (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g h')) ∧ (∀ (g : BandPackingSymmetry), ∀ (x + : GaussianInt), ∀ (T : ProtoTile), ∀ (U : ProtoTile), (∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ T.cells ∨ LatticeVertexIncidentCell x j ∈ U.cells) ↔ + ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell (BandPackingSymmetryVectorAction g x) + j ∈ (BandPackingSymmetryTileAction g T).cells ∨ LatticeVertexIncidentCell + (BandPackingSymmetryVectorAction g x) j ∈ (BandPackingSymmetryTileAction g U).cells) + ∧ ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q → ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (delta : Bool), + BandPackingSymmetryScopedPhase g q delta → ∀ (T : ProtoTile), ∀ (x : GaussianInt), + let q' := BandPackingSymmetryQuadrupleAction g q; + let sigma := fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true + then -j else j; + let s' := if BandPackingSymmetryReversesOrientation g = true then -s - (1 : Fin (4 : ℕ)) + + if delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else s + if delta = + true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)); + let oldRight := TileTranslation T ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if + Even (↑s : ℕ) then BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) else BandVectors.1 + (q i.succ) (q (0 : Fin (4 : ℕ)))); + let newRight := TileTranslation (BandPackingSymmetryTileAction g T) ((⟨(0 : ℤ), (1 : ℤ)⟩ + : GaussianInt) ^ (↑s' : ℕ) * if Even (↑s' : ℕ) then BandVectors.1 (q' (0 : Fin (4 : + ℕ))) (q' (sigma i).succ) else BandVectors.1 (q' (sigma i).succ) (q' (0 : Fin (4 : + ℕ)))); BandPackingSymmetryTileAction g oldRight = newRight ∧ (x ∈ FootprintVertices + oldRight ↔ BandPackingSymmetryVectorAction g x ∈ FootprintVertices newRight)) → (∀ + (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), (∀ (a : + GaussianInt), ∀ (A : ProtoTile), ∀ (B : ProtoTile), (∀ z, z = a ∨ z = a - 1 ∨ z = a - + ⟨0, 1⟩ ∨ z = a - 1 - ⟨0, 1⟩ → z ∈ A.cells ∨ z ∈ B.cells) ↔ (∀ j : Fin 4, + LatticeVertexIncidentCell a j ∈ A.cells ∨ LatticeVertexIncidentCell a j ∈ B.cells)) → + ((∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ z = x - 1 - ⟨0, 1⟩ → z ∈ T.cells ∨ z ∈ + T₀.cells) ↔ (∀ z, z = bundle.normalizedPoint ∨ z = bundle.normalizedPoint - 1 ∨ z = + bundle.normalizedPoint - ⟨0, 1⟩ ∨ z = bundle.normalizedPoint - 1 - ⟨0, 1⟩ → z ∈ + bundle.normalizedRoot.cells ∨ z ∈ bundle.normalizedFixed.cells))) ) := by + classical + intro C T T₀ h h₀ x markedData bundle coverShape + rw [coverShape, coverShape] + simpa [bundle.normalized_point_eq, bundle.normalized_root_eq, + bundle.normalized_fixed_eq] using + (markedData.2.1 bundle.symmetry x T T₀) + +private theorem hpointInverse : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (ginv : + BandPackingSymmetry), (∀ (v : GaussianInt), BandPackingSymmetryVectorAction ginv + (BandPackingSymmetryVectorAction bundle.symmetry v) = v) → + ((BandPackingSymmetryVectorAction bundle.symmetry x = bundle.normalizedPoint) → + (BandPackingSymmetryVectorAction ginv bundle.normalizedPoint = x)) ) := by + classical + intro C T T₀ h h₀ x bundle ginv hvecL hpoint + rw [← hpoint] + exact hvecL x + +private theorem hmarkTransport : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (rightPlacement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ∀ (s : Fin (4 : ℕ)), (TileTranslation bundle.normalizedFixed + ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 + (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (bundle.normalizedPresentation + bundle.selectedSlot.succ) else BandVectors.1 (bundle.normalizedPresentation + bundle.selectedSlot.succ) (bundle.normalizedPresentation (0 : Fin (4 : ℕ)))) = + TileTranslation bundle.normalizedFixed ((if rightPlacement.rightNeighborPositive = + true then (-1 : GaussianInt) else (1 : GaussianInt)) * BandVectors.1 + (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (bundle.normalizedPresentation + bundle.selectedSlot.succ))) → (∀ (ginv : BandPackingSymmetry), (∀ (T_1 : ProtoTile), + BandPackingSymmetryTileAction ginv (BandPackingSymmetryTileAction bundle.symmetry + T_1) = T_1) → (∀ (delta : Bool), ∀ (t' : Fin (4 : ℕ)), (t' = if + BandPackingSymmetryReversesOrientation ginv = true then -s - (1 : Fin (4 : ℕ)) + if + delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else s + if delta = true + then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ))) → ( + let oldRight := TileTranslation bundle.normalizedFixed + ((if rightPlacement.rightNeighborPositive = true then (-1 : GaussianInt) + else 1) * + BandVectors.1 (bundle.normalizedPresentation 0) + (bundle.normalizedPresentation bundle.selectedSlot.succ)) + (bundle.normalizedPoint ∈ FootprintVertices (TileTranslation bundle.normalizedFixed ((⟨(0 + : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 + (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (bundle.normalizedPresentation + bundle.selectedSlot.succ) else BandVectors.1 (bundle.normalizedPresentation + bundle.selectedSlot.succ) (bundle.normalizedPresentation (0 : Fin (4 : ℕ))))) ↔ + BandPackingSymmetryVectorAction ginv bundle.normalizedPoint ∈ FootprintVertices + (TileTranslation (BandPackingSymmetryTileAction ginv bundle.normalizedFixed) ((⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑(if BandPackingSymmetryReversesOrientation ginv = + true then -s - (1 : Fin (4 : ℕ)) + if delta = true then (2 : Fin (4 : ℕ)) else (0 : + Fin (4 : ℕ)) else s + if delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ))) + : ℕ) * if Even (↑(if BandPackingSymmetryReversesOrientation ginv = true then -s - (1 + : Fin (4 : ℕ)) + if delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else s + + if delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ))) : ℕ) then + BandVectors.1 (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + (0 : Fin (4 : ℕ))) (BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation (if BandPackingSymmetryReversesOrientation ginv = true + then -bundle.selectedSlot else bundle.selectedSlot).succ) else BandVectors.1 + (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation (if + BandPackingSymmetryReversesOrientation ginv = true then -bundle.selectedSlot else + bundle.selectedSlot).succ) (BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation (0 : Fin (4 : ℕ)))))) → + ((BandPackingSymmetryVectorAction ginv bundle.normalizedPoint = x) → + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ x ∈ FootprintVertices + (TileTranslation T₀ ((⟨0, 1⟩ : GaussianInt) ^ t'.val * (if Even t'.val then + BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation) 0) ((BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation) (if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot).succ) else BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) (if + BandPackingSymmetryReversesOrientation ginv then -bundle.selectedSlot else + bundle.selectedSlot).succ) ((BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation) 0))))))))) ) := by + classical + intro C T T₀ h h₀ x bundle rightPlacement s hcompanion ginv htileL delta t' ht' oldRight + hcompanionFootprint hpointInverse + unfold oldRight + rw [← hcompanion] + rw [hpointInverse] at hcompanionFootprint + simpa [bundle.normalized_fixed_eq, htileL, ht'] using hcompanionFootprint + +private theorem hmarkedOriginal : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ + : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (rightPlacement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), ((¬∀ (z : GaussianInt), z = bundle.normalizedPoint ∨ z = + bundle.normalizedPoint - (1 : GaussianInt) ∨ z = bundle.normalizedPoint - (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt) ∨ z = bundle.normalizedPoint - (1 : GaussianInt) - (⟨(0 : ℤ), + (1 : ℤ)⟩ : GaussianInt) → z ∈ bundle.normalizedRoot.cells ∨ z ∈ + bundle.normalizedFixed.cells) ↔ bundle.normalizedPoint ∈ FootprintVertices + (TileTranslation bundle.normalizedFixed ((if rightPlacement.rightNeighborPositive = + true then (-1 : GaussianInt) else (1 : GaussianInt)) * BandVectors.1 + (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (bundle.normalizedPresentation + bundle.selectedSlot.succ)))) → (∀ (ginv : BandPackingSymmetry), ∀ (t' : Fin (4 : ℕ)), + ((∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ z = x - 1 - ⟨0, 1⟩ → z ∈ T.cells ∨ z ∈ + T₀.cells) ↔ (∀ z, z = bundle.normalizedPoint ∨ z = bundle.normalizedPoint - 1 ∨ z = + bundle.normalizedPoint - ⟨0, 1⟩ ∨ z = bundle.normalizedPoint - 1 - ⟨0, 1⟩ → z ∈ + bundle.normalizedRoot.cells ∨ z ∈ bundle.normalizedFixed.cells)) → ( + let oldRight := TileTranslation bundle.normalizedFixed + ((if rightPlacement.rightNeighborPositive = true then (-1 : GaussianInt) + else 1) * + BandVectors.1 (bundle.normalizedPresentation 0) + (bundle.normalizedPresentation bundle.selectedSlot.succ)) + (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ x ∈ FootprintVertices + (TileTranslation T₀ ((⟨0, 1⟩ : GaussianInt) ^ t'.val * (if Even t'.val then + BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation) 0) ((BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation) (if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot).succ) else BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) (if + BandPackingSymmetryReversesOrientation ginv then -bundle.selectedSlot else + bundle.selectedSlot).succ) ((BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation) 0))))) → ((¬ (∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ + ∨ z = x - 1 - ⟨0, 1⟩ → z ∈ T.cells ∨ z ∈ T₀.cells)) ↔ x ∈ FootprintVertices + (TileTranslation T₀ ((⟨0, 1⟩ : GaussianInt) ^ t'.val * (if Even t'.val then + BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation) 0) ((BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation) (if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot).succ) else BandVectors.1 + ((BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) (if + BandPackingSymmetryReversesOrientation ginv then -bundle.selectedSlot else + bundle.selectedSlot).succ) ((BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation) 0))))))) ) := by + classical + intro C T T₀ h h₀ x bundle rightPlacement outerMarkingCriterion ginv t' hcoverOriginal oldRight + hmarkTransport + exact (not_congr hcoverOriginal).trans + (outerMarkingCriterion.trans hmarkTransport) + +end MarkedRightAdjacencyGeometry + +theorem P5630T1MarkedRightOdometerAdjacencyReduction : + (∀ (C : BandCircle) (T T₀ : ProtoTile) (h h₀ : PartialOdometer) + (x : GaussianInt), + ¬ ((∃ (g : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = C.1.1) ∨ + (∃ (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K 0) = C.1.1)) → + RightLatticeAdjacent C T T₀ h h₀ → + x ∈ h.domain → x ∈ h₀.domain → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h.domain ∨ y ∈ h₀.domain) → + ∃ (C' : BandCircle) (T' : ProtoTile) (h' : PartialOdometer) + (p₀ p' : ℝ × ℝ) (q : Fin 4 → CircleCoordinates) + (i : Fin 3) (s : Fin 4), + TileSubodometer C.1.1 C'.1.1 T T' h h' ∧ + PartialOdometerSlope h₀ = some p₀ ∧ + PartialOdometerSlope h' = some p' ∧ + ProperBandQuadruple q ∧ q 0 = C.1.1 ∧ q i.succ = C'.1.1 ∧ + TileCentroid T' - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) ∧ + p'.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).1 ∧ + p'.2 - p₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).2 ∧ + SubtileLatticeAdjacent C C' T₀ T' h₀ h' ∧ + x ∈ h₀.domain ∧ x ∈ h'.domain ∧ + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h₀.domain ∨ y ∈ h'.domain) ∧ + Int.toNat C.1.1.1 + Int.toNat C'.1.1.1 < + Int.toNat C.1.1.1 + Int.toNat C.1.1.1 ∧ + (¬ (∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ + z = x - 1 - ⟨0, 1⟩ → z ∈ T.cells ∨ z ∈ T₀.cells) ↔ + x ∈ FootprintVertices + (TileTranslation T₀ + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (if Even s.val then BandVectors.1 (q 0) (q i.succ) + else BandVectors.1 (q i.succ) (q 0)))))) := by +-- BODY + intro C T T₀ h h₀ x horbit hadj hx hx₀ hstar + have inversePhase := BandPackingSymmetryInversePhaseCancellation + have markedData := BandPackingSymmetryMarkedDataCovariance + obtain ⟨bundle, rightPlacement, hrightPlacement⟩ := + BandOrderedGeneralRightNormalizedBundleExists + C T T₀ h h₀ x horbit hadj hx hx₀ hstar + obtain ⟨selectedEdge, hxSelectedEdge, hselectedEdge, selectedRow⟩ := + BandOrderedGeneralRoutedSelectedContact + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixed rightPlacement.layout + rightPlacement.exteriorIndex rightPlacement.centralIndex + bundle.normalizedPoint bundle.routedDirection + rightPlacement.exterior_index rightPlacement.central_index + rightPlacement.exterior_routed_cell rightPlacement.central_routed_cell + rightPlacement.selected_star + obtain ⟨row⟩ := selectedRow + have rightGeometry := BandOrderedGeneralRightSelectedRowGeometry + C C T T₀ h h₀ x bundle rightPlacement selectedEdge + hxSelectedEdge hselectedEdge row + have selectedAdjacency := BandOrderedGeneralRightSelectedAdjacency + C C T T₀ h h₀ x bundle rightPlacement selectedEdge + hxSelectedEdge hselectedEdge row + have outerMarkingCriterion := + BandOrderedGeneralRightOuterMarkingCriterion + C C T T₀ h h₀ x bundle rightPlacement selectedEdge + hxSelectedEdge hselectedEdge row + have markedSectorTransport := BandOrderedGeneralMarkedSectorTransport + C C T T₀ h h₀ x bundle rightPlacement selectedEdge + hxSelectedEdge hselectedEdge row + dsimp at selectedAdjacency outerMarkingCriterion markedSectorTransport + rcases selectedAdjacency with + ⟨C', p₀, p', s, hC', hsub, hslope₀, hslope', hq, hq₀, hq', + hcentroid, hslopeRe, hslopeIm, hadj', hxFixed, hxSelected, + hstar', hsize, hcompanion⟩ + obtain ⟨ginv, hcircleL, hcircleR, hquadL, hquadR, htileL, + htileR, hvecL, hvecR, hfunL, hfunR, hphase⟩ := + (BandPackingSymmetryInversePhaseCancellation.2 bundle.symmetry) + have hnorm := MarkedRightAdjacencyGeometry.hnorm C T T₀ h h₀ x bundle + have hfixedSlope : p₀ = bundle.normalizedFixedSlope := + Option.some.inj (hslope₀.symm.trans bundle.normalized_fixed_slope) + rw [hfixedSlope] at hslopeRe hslopeIm + have inverseAdjacency := + SubtileLatticeAdjacentPackingSymmetryTransport ginv + bundle.normalizedPresentation hq bundle.selectedSlot s + (MarkedRightAdjacencyGeometry.hparentPositive C T T₀ h h₀ x bundle C' hq') + bundle.normalizedFixed (bundle.pieces bundle.selectedSlot bundle.selectedSign) + bundle.normalizedFixedFunction + (bundle.functions bundle.selectedSlot bundle.selectedSign) + bundle.normalizedFixedSlope p' + (MarkedRightAdjacencyGeometry.hfixedOdometer C T T₀ h h₀ x bundle + (MarkedRightAdjacencyGeometry.hfixedCircleEq C T T₀ h h₀ x bundle hnorm)) + (bundle.piece_odometer bundle.selectedSlot bundle.selectedSign) + bundle.normalized_fixed_slope hslope' + hcentroid hslopeRe hslopeIm + dsimp at inverseAdjacency + rcases inverseAdjacency with + ⟨delta, pFixed, pSelected, t', hphaseInv, ht', + hOFixedInv, hOSelectedInv, hslopeFixedInv, hslopeSelectedInv, + hcentInv, hslopeReInv, hslopeImInv, hcompat⟩ + have actionCurvature := MarkedRightAdjacencyGeometry.actionCurvatureAt244 + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation + let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot + have hinverseProper : ProperBandQuadruple inversePresentation := + BandPackingSymmetryProperCovariance ginv bundle.normalizedPresentation hq + have hinverseCoordinate := MarkedRightAdjacencyGeometry.hinverseCoordinate C T T₀ h h₀ x bundle + C' hC' ginv + have hinversePositive := MarkedRightAdjacencyGeometry.hinversePositive C T T₀ h h₀ x bundle C' + ginv actionCurvature hinverseCoordinate + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ + have hinverseCircle : inverseCircle.1.1 = + BandPackingSymmetryCircleAction ginv C'.1.1 := hinverseCoordinate + let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign + let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign + let T' := BandPackingSymmetryTileAction ginv selectedSupport + let h' := BandPackingSymmetryPartialOdometerAction ginv selectedFunction + have hsubInverse := MarkedRightAdjacencyGeometry.hsubInverse C T T₀ h h₀ x markedData bundle C' + ginv hcircleL htileL hfunL hinverseProper hinversePositive hinverseCircle + (MarkedRightAdjacencyGeometry.hsubNormalized C T T₀ h h₀ x bundle C' hsub hnorm) + have inverseDomain := MarkedRightAdjacencyGeometry.inverseDomain C T T₀ h h₀ x bundle ginv hvecL + have hpoint : BandPackingSymmetryVectorAction bundle.symmetry x = + bundle.normalizedPoint := bundle.normalized_point_eq.symm + have hxFixedOriginal := MarkedRightAdjacencyGeometry.hxFixedOriginal C T T₀ h h₀ x bundle + hxFixed ginv hfunL inverseDomain hpoint + have hxSelectedOriginal := MarkedRightAdjacencyGeometry.hxSelectedOriginal C T T₀ h h₀ x bundle + hxSelected ginv inverseDomain hpoint + have hstarOriginal := MarkedRightAdjacencyGeometry.hstarOriginal C T T₀ h h₀ x bundle hstar' + ginv hfunL inverseDomain hpoint (MarkedRightAdjacencyGeometry.mapStar) + have hselectedCoord : + (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) + (if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot).succ = + inverseCircle.1.1 := MarkedRightAdjacencyGeometry.hselectedCoord C T T₀ h h₀ x bundle C' + hq' ginv hinverseProper hinversePositive hinverseCircle + have hOSelectedOriginal : TileOdometer inverseCircle.1.1 T' h' := by + simpa [hselectedCoord, T', h'] using hOSelectedInv + have hslopeFixedOriginal : PartialOdometerSlope h₀ = some pFixed := by + simpa [bundle.normalized_fixed_function_eq, hfunL] using hslopeFixedInv + have hcentOriginal := MarkedRightAdjacencyGeometry.hcentOriginal C T T₀ h h₀ x bundle ginv + htileL t' hcentInv + have hrootCoord := MarkedRightAdjacencyGeometry.hrootCoord C T T₀ h h₀ x bundle ginv hcircleL + hnorm + have hnewAdj := MarkedRightAdjacencyGeometry.hnewAdj C T T₀ h h₀ x bundle hq ginv pFixed + pSelected t' hslopeSelectedInv hslopeReInv hslopeImInv hinverseProper hinversePositive + hselectedCoord (MarkedRightAdjacencyGeometry.hOFixedOriginal C T T₀ h h₀ x bundle ginv + htileL hfunL hOFixedInv (MarkedRightAdjacencyGeometry.hrootAction C T T₀ h h₀ x bundle ginv + hcircleL hnorm)) hOSelectedOriginal hslopeFixedOriginal hcentOriginal hrootCoord + have actionCurvature := MarkedRightAdjacencyGeometry.actionCurvatureAt449 + have hsizeOriginal := MarkedRightAdjacencyGeometry.hsizeOriginal C T T₀ h h₀ x bundle C' hsize + ginv hnorm actionCurvature hinverseProper hinversePositive hinverseCircle + have hcoverOriginal := MarkedRightAdjacencyGeometry.hcoverOriginal C T T₀ h h₀ x markedData + bundle (MarkedRightAdjacencyGeometry.coverShape) + let oldRight := TileTranslation bundle.normalizedFixed + ((if rightPlacement.rightNeighborPositive = true then (-1 : GaussianInt) + else 1) * + BandVectors.1 (bundle.normalizedPresentation 0) + (bundle.normalizedPresentation bundle.selectedSlot.succ)) + have hcompanionCov := + markedData.2.2 ginv bundle.normalizedPresentation hq + bundle.selectedSlot s delta hphaseInv bundle.normalizedFixed + bundle.normalizedPoint + dsimp at hcompanionCov + rcases hcompanionCov with ⟨hcompanionTile, hcompanionFootprint⟩ + refine ⟨inverseCircle, T', h', pFixed, pSelected, + BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation, + (if BandPackingSymmetryReversesOrientation ginv then + -bundle.selectedSlot else bundle.selectedSlot), t', ?_⟩ + refine ⟨hsubInverse, hslopeFixedOriginal, hslopeSelectedInv, + BandPackingSymmetryProperCovariance ginv bundle.normalizedPresentation hq, + hrootCoord, hselectedCoord, hcentOriginal, hslopeReInv, hslopeImInv, + hnewAdj, hxFixedOriginal, hxSelectedOriginal, hstarOriginal, + hsizeOriginal, (MarkedRightAdjacencyGeometry.hmarkedOriginal C T T₀ h h₀ x bundle + rightPlacement outerMarkingCriterion ginv t' hcoverOriginal + (MarkedRightAdjacencyGeometry.hmarkTransport C T T₀ h h₀ x bundle rightPlacement s + hcompanion ginv htileL delta t' ht' hcompanionFootprint + (MarkedRightAdjacencyGeometry.hpointInverse C T T₀ h h₀ x bundle ginv hvecL hpoint)))⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5630T1SymmetricMatrixPositivityCriterion.lean b/LeanPool/ApollonianSuperharmonic/P5630T1SymmetricMatrixPositivityCriterion.lean new file mode 100644 index 0000000000..bca55ec8ef --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5630T1SymmetricMatrixPositivityCriterion.lean @@ -0,0 +1,203 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Analysis.Real.Sqrt + +-- [TABLET NODE: P5630T1SymmetricMatrixPositivityCriterion] + +/-! +# P5630T1SymmetricMatrixPositivityCriterion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5630T1SymmetricMatrixPositivityCriterion (s u v : Real) : + ( (let M : Matrix (Fin 2) (Fin 2) Real := ![![s + u, v], ![v, s - u]]; M.PosSemidef) ↔ + Real.sqrt (u ^ 2 + v ^ 2) ≤ s) ∧ + ( (let M : Matrix (Fin 2) (Fin 2) Real := ![![s + u, v], ![v, s - u]]; M.PosDef) ↔ + Real.sqrt (u ^ 2 + v ^ 2) < s) := by +-- BODY + let M : Matrix (Fin 2) (Fin 2) Real := ![![s + u, v], ![v, s - u]] + have symmetric : + M.IsHermitian := by + apply Matrix.IsHermitian.ext + intro i j + fin_cases i <;> fin_cases j <;> simp [M] + have quadratic (a b : Real) : + (let x : Fin 2 → Real := ![a, b]; dotProduct (fun i => x i) (M.mulVec x)) = + (s * (a ^ 2 + b ^ 2) + u * (a ^ 2 - b ^ 2) + 2 * v * a * b) := by + simp [M, Matrix.mulVec, dotProduct] + ring + constructor + · constructor + · intro h + have hq (a b : Real) : + 0 ≤ s * (a ^ 2 + b ^ 2) + u * (a ^ 2 - b ^ 2) + 2 * v * a * b := by + rw [← quadratic a b] + simpa using (Matrix.posSemidef_iff_dotProduct_mulVec.mp h).2 ![a, b] + have hu := hq 1 0 + have hv := hq 0 1 + have hdet : 0 ≤ s ^ 2 - u ^ 2 - v ^ 2 := by + by_cases hz : s + u = 0 + · have hp := hq 1 1 + have hm := hq 1 (-1) + have huval : u = -s := by linarith [hz] + rw [huval] at hp hm + have hs0 : 0 ≤ s := by nlinarith [hv] + have hzv := hq (2 * s) (-v) + rw [huval] at hzv + norm_num at hzv + ring_nf at hzv + have hsprod : s * v ^ 2 = 0 := by nlinarith [hzv] + have hv0 : v = 0 := by + have hprod : 0 ≤ s * v ^ 2 := mul_nonneg hs0 (sq_nonneg v) + rcases eq_zero_or_eq_zero_of_mul_eq_zero hsprod with hs | hv + · have hp' : 0 ≤ v := by nlinarith [hp] + have hm' : v ≤ 0 := by nlinarith [hm] + linarith + · exact (sq_eq_zero_iff.mp hv) + rw [hv0] + nlinarith + · have hp := hq v (-(s + u)) + have hsu : 0 ≤ s + u := by nlinarith + have hsu' : 0 < s + u := lt_of_le_of_ne hsu (Ne.symm hz) + nlinarith + have hs : 0 ≤ s := by nlinarith + have hsqrt : 0 ≤ Real.sqrt (u ^ 2 + v ^ 2) := Real.sqrt_nonneg _ + have hsquare : (Real.sqrt (u ^ 2 + v ^ 2)) ^ 2 = u ^ 2 + v ^ 2 := + Real.sq_sqrt (by positivity) + nlinarith + · intro h + refine Matrix.PosSemidef.of_dotProduct_mulVec_nonneg symmetric ?_ + intro x + have hx : x = ![x 0, x 1] := by + funext i + fin_cases i <;> rfl + rw [hx] + have hc : + (u * ((x 0) ^ 2 - (x 1) ^ 2) + 2 * v * x 0 * x 1) ^ 2 ≤ + (u ^ 2 + v ^ 2) * ((x 0) ^ 2 + (x 1) ^ 2) ^ 2 := by + nlinarith [sq_nonneg (v * ((x 0) ^ 2 - (x 1) ^ 2) - + u * (2 * x 0 * x 1))] + have hsquare : (Real.sqrt (u ^ 2 + v ^ 2)) ^ 2 = u ^ 2 + v ^ 2 := + Real.sq_sqrt (by positivity) + have hsqrt : 0 ≤ Real.sqrt (u ^ 2 + v ^ 2) := Real.sqrt_nonneg _ + have hnorm : 0 ≤ (x 0) ^ 2 + (x 1) ^ 2 := by positivity + have hprod : 0 ≤ (s - Real.sqrt (u ^ 2 + v ^ 2)) * + ((x 0) ^ 2 + (x 1) ^ 2) := + mul_nonneg (sub_nonneg.mpr h) hnorm + have hL : -(Real.sqrt (u ^ 2 + v ^ 2)) * + ((x 0) ^ 2 + (x 1) ^ 2) ≤ + u * ((x 0) ^ 2 - (x 1) ^ 2) + 2 * v * x 0 * x 1 := by + have hsq : (Real.sqrt (u ^ 2 + v ^ 2) * + ((x 0) ^ 2 + (x 1) ^ 2)) ^ 2 = + (u ^ 2 + v ^ 2) * ((x 0) ^ 2 + (x 1) ^ 2) ^ 2 := by + rw [mul_pow, hsquare] + by_contra hn + have hlt := lt_of_not_ge hn + have hrn : 0 ≤ Real.sqrt (u ^ 2 + v ^ 2) * + ((x 0) ^ 2 + (x 1) ^ 2) := mul_nonneg hsqrt hnorm + have hnl : 0 ≤ -(u * ((x 0) ^ 2 - (x 1) ^ 2) + + 2 * v * x 0 * x 1) := by linarith + have hsq' : (Real.sqrt (u ^ 2 + v ^ 2) * + ((x 0) ^ 2 + (x 1) ^ 2)) ^ 2 < + (-(u * ((x 0) ^ 2 - (x 1) ^ 2) + 2 * v * x 0 * x 1)) ^ 2 := by + apply (sq_lt_sq₀ hrn hnl).2 + linarith + nlinarith [hsq, hsq'] + have hq : 0 ≤ s * ((x 0) ^ 2 + (x 1) ^ 2) + + u * ((x 0) ^ 2 - (x 1) ^ 2) + 2 * v * x 0 * x 1 := by + nlinarith [hprod] + have hq' : 0 ≤ x 0 * ((s + u) * x 0 + v * x 1) + + x 1 * (v * x 0 + (s - u) * x 1) := by + nlinarith [hq] + simpa [M, Matrix.mulVec, dotProduct, TrivialStar.star_trivial] using hq' + · constructor + · intro h + have hq (a b : Real) (hne : (![a, b] : Fin 2 → Real) ≠ 0) : + 0 < s * (a ^ 2 + b ^ 2) + u * (a ^ 2 - b ^ 2) + 2 * v * a * b := by + have hv := (Matrix.posDef_iff_dotProduct_mulVec.mp + (by simpa [M] using h)).2 hne + rw [← quadratic a b] + simpa [TrivialStar.star_trivial] using hv + have hp := hq 1 0 (by norm_num) + have hsu : 0 < s + u := by nlinarith [hp] + have hzv := hq v (-(s + u)) (by + intro hz + have hh := congrFun hz 1 + simp at hh + nlinarith [hsu]) + have hdet : 0 < s ^ 2 - u ^ 2 - v ^ 2 := by + nlinarith [hzv] + have hs : 0 < s := by nlinarith [hp] + have hsquare : (Real.sqrt (u ^ 2 + v ^ 2)) ^ 2 = u ^ 2 + v ^ 2 := + Real.sq_sqrt (by positivity) + have hsqrt : 0 ≤ Real.sqrt (u ^ 2 + v ^ 2) := Real.sqrt_nonneg _ + nlinarith + · intro h + refine Matrix.PosDef.of_dotProduct_mulVec_pos symmetric ?_ + intro x hx + have hcoord : x = ![x 0, x 1] := by + funext i + fin_cases i <;> rfl + have hN : 0 < (x 0) ^ 2 + (x 1) ^ 2 := by + rcases eq_or_ne (x 0) 0 with ha | ha + · have hb : x 1 ≠ 0 := by + intro hb + apply hx + rw [hcoord] + funext i + fin_cases i <;> simp [ha, hb] + positivity + · positivity + have hsquare : (Real.sqrt (u ^ 2 + v ^ 2)) ^ 2 = u ^ 2 + v ^ 2 := + Real.sq_sqrt (by positivity) + have hsqrt : 0 ≤ Real.sqrt (u ^ 2 + v ^ 2) := Real.sqrt_nonneg _ + have hprod : 0 < (s - Real.sqrt (u ^ 2 + v ^ 2)) * + ((x 0) ^ 2 + (x 1) ^ 2) := + mul_pos (sub_pos.mpr h) hN + have hc : + (u * ((x 0) ^ 2 - (x 1) ^ 2) + 2 * v * x 0 * x 1) ^ 2 ≤ + (u ^ 2 + v ^ 2) * ((x 0) ^ 2 + (x 1) ^ 2) ^ 2 := by + nlinarith [sq_nonneg (v * ((x 0) ^ 2 - (x 1) ^ 2) - + u * (2 * x 0 * x 1))] + have hL : -(Real.sqrt (u ^ 2 + v ^ 2)) * + ((x 0) ^ 2 + (x 1) ^ 2) ≤ + u * ((x 0) ^ 2 - (x 1) ^ 2) + 2 * v * x 0 * x 1 := by + have hsq : (Real.sqrt (u ^ 2 + v ^ 2) * + ((x 0) ^ 2 + (x 1) ^ 2)) ^ 2 = + (u ^ 2 + v ^ 2) * ((x 0) ^ 2 + (x 1) ^ 2) ^ 2 := by + rw [mul_pow, hsquare] + by_contra hn + have hlt := lt_of_not_ge hn + have hrn : 0 ≤ Real.sqrt (u ^ 2 + v ^ 2) * + ((x 0) ^ 2 + (x 1) ^ 2) := mul_nonneg hsqrt (le_of_lt hN) + have hnl : 0 ≤ -(u * ((x 0) ^ 2 - (x 1) ^ 2) + + 2 * v * x 0 * x 1) := by linarith + have hsq' : (Real.sqrt (u ^ 2 + v ^ 2) * + ((x 0) ^ 2 + (x 1) ^ 2)) ^ 2 < + (-(u * ((x 0) ^ 2 - (x 1) ^ 2) + 2 * v * x 0 * x 1)) ^ 2 := by + apply (sq_lt_sq₀ hrn hnl).2 + linarith + nlinarith [hsq, hsq'] + have hq : 0 < s * ((x 0) ^ 2 + (x 1) ^ 2) + + u * ((x 0) ^ 2 - (x 1) ^ 2) + 2 * v * x 0 * x 1 := by + nlinarith [hprod] + rw [hcoord] + have hq' : 0 < x 0 * ((s + u) * x 0 + v * x 1) + + x 1 * (v * x 0 + (s - u) * x 1) := by nlinarith [hq] + simpa [M, Matrix.mulVec, dotProduct, TrivialStar.star_trivial] using hq' + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean b/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean new file mode 100644 index 0000000000..b59299d865 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean @@ -0,0 +1,1987 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleLatticeTouching +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge + +-- [TABLET NODE: P5635T1EndpointDiagonalOwnership] + +/-! +# P5635T1EndpointDiagonalOwnership + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace EndpointDiagonalGeometry + +private theorem triple_label_pattern : + (by + classical + exact + ∀ (label : Fin 4 → Fin 3), ∀ (a : Fin 4), ∀ (b : Fin 4), ∀ (c : Fin 4), a ≠ b → b ≠ c → c + ≠ a → ({label a, label (a + 1)} : Finset (Fin 3)) = {0, 1} → ({label b, + label (b + 1)} : Finset (Fin 3)) = {1, 2} → ({label c, label (c + 1)} : Finset (Fin + 3)) = {2, 0} → (label (a + 2) = 2 ∧ label (a + 3) = label a) ∨ (label (a + 3) = 2 ∧ + label (a + 2) = label (a + 1)) ∨ (label (a + 2) = 2 ∧ label (a + 3) = 2) ∨ (label (a + + 3) = 2 ∧ label a = 2) ) := by + classical + exact ((((by decide +kernel)))) + +private theorem neighbor_ne_center : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + ∀ (x : GaussianInt), ∀ (j : Fin 4), neighbor x j ≠ x ) := by + classical + intro neighbor x j + fin_cases j <;> simp [neighbor, Zsqrtd.ext_iff] + +private theorem neighbor_injective : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + ∀ (x : GaussianInt), ∀ {j : Fin 4}, ∀ {k : Fin 4}, (neighbor x j = neighbor x k) → (j = + k) ) := by + classical + intro neighbor x j k h + fin_cases j <;> fin_cases k <;> + simp [neighbor, Zsqrtd.ext_iff] at h ⊢ <;> omega + +private theorem edgeAt_mem : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + ∀ (x : GaussianInt), ∀ (j : Fin 4), x ∈ edgeAt x j ∧ neighbor x j ∈ edgeAt x j ) := by + classical + intro neighbor edgeAt x j + fin_cases j <;> simp [neighbor, edgeAt] + +private theorem edgeAt_eq_pair : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + ∀ (x : GaussianInt), ∀ (j : Fin 4), edgeAt x j = {x, neighbor x j} ) := by + classical + intro neighbor edgeAt x j + fin_cases j <;> simp [edgeAt, neighbor, Finset.pair_comm] + +private theorem edgeAt_injective : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (x : GaussianInt), ∀ (j : Fin 4), neighbor x j ≠ x) → ((∀ (x : GaussianInt), ∀ + {j : Fin 4}, ∀ {k : Fin 4}, (neighbor x j = neighbor x k) → (j = k)) → ((∀ (x : + GaussianInt), ∀ (j : Fin 4), x ∈ edgeAt x j ∧ neighbor x j ∈ edgeAt x j) → (∀ (x : + GaussianInt), ∀ {j : Fin 4}, ∀ {k : Fin 4}, (edgeAt x j = edgeAt x k) → (j = k)))) ) + := by + classical + intro neighbor edgeAt neighbor_ne_center neighbor_injective edgeAt_mem x j k h + have hx := (edgeAt_mem x j).1 + have hn := (edgeAt_mem x j).2 + have hnm : neighbor x j ∈ edgeAt x k := by rw [← h]; exact hn + have hchoices : neighbor x j = x ∨ neighbor x j = neighbor x k := by + fin_cases k + · simpa [edgeAt, neighbor] using hnm + · have hh : neighbor x j = x - 1 ∨ neighbor x j = x := by + simpa [edgeAt, neighbor] using hnm + exact Or.symm hh + · have hh : neighbor x j = x - ⟨0, 1⟩ ∨ neighbor x j = x := by + simpa [edgeAt, neighbor] using hnm + exact Or.symm hh + · simpa [edgeAt, neighbor] using hnm + exact neighbor_injective x (hchoices.resolve_left (neighbor_ne_center x j)) + +private theorem edge_of_sector_pair : + (by + classical + exact + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + ∀ (R : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ + R.cells) → ((LatticeVertexIncidentCell x (j + 1) ∈ R.cells) → (edgeAt x j ∈ + FootprintEdges R)) ) := by + classical + intro edgeAt R x j h0 h1 + fin_cases j + · simpa [edgeAt] using + (show {x, x + ⟨0, 1⟩} ∈ FootprintEdges R from + ⟨x, by simpa [LatticeVertexIncidentCell] using h0, + Or.inr (Or.inl rfl)⟩) + · simpa [edgeAt] using + (show {x - 1, x} ∈ FootprintEdges R from + ⟨x - 1, by simpa [LatticeVertexIncidentCell] using h0, + Or.inl (by simp)⟩) + · simpa [edgeAt] using + (show {x - ⟨0, 1⟩, x} ∈ FootprintEdges R from + ⟨x - ⟨0, 1⟩, by simpa [LatticeVertexIncidentCell] using h1, + Or.inr (Or.inl (by simp))⟩) + · simpa [edgeAt] using + (show {x, x + 1} ∈ FootprintEdges R from + ⟨x, by simpa [LatticeVertexIncidentCell] using h1, + Or.inl rfl⟩) + +private theorem edge_foreign_impossible : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (x : GaussianInt), ∀ (j : Fin 4), x ∈ edgeAt x j ∧ neighbor x j ∈ edgeAt x j) → ((∀ (x + : GaussianInt), ∀ {j : Fin 4}, ∀ {k : Fin 4}, (edgeAt x j = edgeAt x k) → (j = k)) → + ((∀ (R : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x + j ∈ R.cells) → ((LatticeVertexIncidentCell x (j + 1) ∈ R.cells) → (edgeAt x j ∈ + FootprintEdges R))) → (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (x : GaussianInt), ∀ + (j : Fin 4), (Disjoint A.cells B.cells) → ((LatticeVertexIncidentCell x j ∈ A.cells) + → ((LatticeVertexIncidentCell x (j + 1) ∈ A.cells) → ((edgeAt x j ∈ FootprintEdges B) + → (False))))))) ) := by + classical + intro neighbor edgeAt edgeAt_mem edgeAt_injective edge_of_sector_pair A B x j hdisAB h0 h1 hBedge + have hAedge := edge_of_sector_pair A x j h0 h1 + obtain ⟨k, hk, htransition⟩ := P3102T2CommonEdgeSectorTransition + A B x (edgeAt x j) hdisAB (edgeAt_mem x j).1 ⟨hAedge, hBedge⟩ + have hkj : k = j := edgeAt_injective x hk.symm + rcases htransition with htransition | htransition + · have hcB : LatticeVertexIncidentCell x (j + 1) ∈ B.cells := by + simpa [hkj] using htransition.2 + exact (Finset.disjoint_left.mp hdisAB) h1 hcB + · have hcB : LatticeVertexIncidentCell x j ∈ B.cells := by + simpa [hkj] using htransition.1 + exact (Finset.disjoint_left.mp hdisAB) h0 hcB + +private theorem neighbor_in_star : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + ∀ (x : GaussianInt), ∀ (j : Fin 4), neighbor x j = x ∨ neighbor x j = x + 1 ∨ neighbor x + j = x - 1 ∨ neighbor x j = x + ⟨0, 1⟩ ∨ neighbor x j = x - ⟨0, 1⟩ ) := by + classical + intro neighbor x j + fin_cases j <;> simp [neighbor, sub_eq_add_neg, + ] + +private theorem neighbor_four_adjacent : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + ∀ (x : GaussianInt), ∀ (j : Fin 4), FourNeighborAdjacent x (neighbor x j) ) := by + classical + intro neighbor x j + fin_cases j <;> simp [FourNeighborAdjacent, neighbor, + sub_eq_add_neg] + +private theorem star_induced_edge : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), (∀ x ∈ FootprintVertices T0, ∀ y ∈ + FootprintVertices T0, FourNeighborAdjacent x y → {x, y} ∈ FootprintEdges T0) → ((∀ x + ∈ FootprintVertices T0', ∀ y ∈ FootprintVertices T0', FourNeighborAdjacent x y → {x, + y} ∈ FootprintEdges T0') → ( + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (x : GaussianInt), ∀ (j : Fin 4), edgeAt x j = {x, neighbor x j}) → ((∀ (x : + GaussianInt), ∀ (j : Fin 4), neighbor x j = x ∨ neighbor x j = x + 1 ∨ neighbor x j = + x - 1 ∨ neighbor x j = x + ⟨0, 1⟩ ∨ neighbor x j = x - ⟨0, 1⟩) → ((∀ (x : + GaussianInt), ∀ (j : Fin 4), FourNeighborAdjacent x (neighbor x j)) → (∀ (x : + GaussianInt), (x ∈ FootprintVertices T0) → ((x ∈ FootprintVertices T0') → ((∀ y, y = + x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices T0 ∨ y ∈ FootprintVertices T0') → (∀ (j : Fin 4), edgeAt x j ∈ + FootprintEdges T0 ∨ edgeAt x j ∈ FootprintEdges T0')))))))) ) := by + classical + intro T0 T0' hreg hreg' neighbor edgeAt edgeAt_eq_pair neighbor_in_star neighbor_four_adjacent + x hx0 hx1 hstar j + have hy := hstar (neighbor x j) (neighbor_in_star x j) + rcases hy with hy | hy + · have he := hreg x hx0 (neighbor x j) hy (neighbor_four_adjacent x j) + rw [← edgeAt_eq_pair x j] at he + exact Or.inl he + · have he := hreg' x hx1 (neighbor x j) hy (neighbor_four_adjacent x j) + rw [← edgeAt_eq_pair x j] at he + exact Or.inr he + +private theorem endpoint_repeat_impossible : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), (Disjoint + A.cells B.cells) → ((LatticeVertexIncidentCell x j ∈ A.cells) → + ((LatticeVertexIncidentCell x (j + 1) ∈ A.cells) → ((edgeAt x j ∈ FootprintEdges B) → + (False))))) → ((∀ (x : GaussianInt), (x ∈ FootprintVertices T0) → ((x ∈ + FootprintVertices T0') → ((∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = + x - ⟨0, 1⟩ → y ∈ FootprintVertices T0 ∨ y ∈ FootprintVertices T0') → (∀ (j : Fin 4), + edgeAt x j ∈ FootprintEdges T0 ∨ edgeAt x j ∈ FootprintEdges T0')))) → (∀ (E : + ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), (x ∈ FootprintVertices T0) → ((x ∈ + FootprintVertices T0') → ((∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices T0 ∨ y ∈ FootprintVertices T0') → ((Disjoint E.cells T0.cells) + → ((Disjoint E.cells T0'.cells) → ((LatticeVertexIncidentCell x j ∈ E.cells) → + ((LatticeVertexIncidentCell x (j + 1) ∈ E.cells) → (False))))))))) ) := by + classical + intro T0 T0' edgeAt edge_foreign_impossible star_induced_edge E x j hx0 hx1 hstar hEdis0 hEdis1 + hE0 hE1 + rcases star_induced_edge x hx0 hx1 hstar j with houter | houter + · exact edge_foreign_impossible E T0 x j hEdis0 hE0 hE1 houter + · exact edge_foreign_impossible E T0' x j hEdis1 hE0 hE1 houter + +private theorem exact_point_boundary : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (point : GaussianInt), ∀ (other : GaussianInt), + (SimpleGridPathBetween + (FootprintVertices A ∩ FootprintVertices B) + (FootprintEdges A ∩ FootprintEdges B) point other) → ((LatticeTile A) → ((LatticeTile + B) → ((Disjoint A.cells B.cells) → (point ∈ BoundaryFootprintVertices A ∩ + BoundaryFootprintVertices B)))) ) := by + classical + intro A B point other pathAB hA hB hdisAB + rcases pathAB with ⟨p, hnd, hlen, hhead, hlast, hvertices, hsteps, hedges⟩ + have hsimple : SimpleGridPath + (FootprintVertices A ∩ FootprintVertices B) + (FootprintEdges A ∩ FootprintEdges B) := + ⟨p, hnd, hlen, hvertices, hsteps, hedges⟩ + have hpoint : point ∈ (p.toFinset : Set GaussianInt) := by + cases p with + | nil => simp at hlen + | cons a p => + change point ∈ (a :: p).toFinset + simp only [List.toFinset_cons, Finset.mem_insert] + simp only [List.head?, Option.some.injEq] at hhead + exact Or.inl hhead.symm + have hpointVertices : + point ∈ FootprintVertices A ∩ FootprintVertices B := by + rw [hvertices] + exact hpoint + obtain ⟨e, hpe, he⟩ := SimpleGridPathVertexIncidentEdge + _ _ hsimple point hpointVertices + have heBoundary : e ∈ BoundaryFootprintEdges A ∩ + BoundaryFootprintEdges B := by + rw [CellDisjointCommonEdgesBoundary A B hdisAB] at he + exact he + have hAne : A.cells.Nonempty := (LatticeTileGridStructure A hA).1.1 + have hBne : B.cells.Nonempty := (LatticeTileGridStructure B hB).1.1 + constructor + · unfold BoundaryFootprintVertices + rw [ite_eq_left hAne] + exact ⟨e, heBoundary.1, hpe⟩ + · unfold BoundaryFootprintVertices + rw [ite_eq_left hBne] + exact ⟨e, heBoundary.2, hpe⟩ + +private theorem touching_path : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), (LatticeTile A) → ((LatticeTile B) → ((TileTouching + A B) → (SimpleGridPath (BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B) + (BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B)))) ) := by + classical + intro A B hA hB htouch + rcases htouch with h | h | h + · exact h.2.2.2 + · have hne := (LatticeTileGridStructure A hA).1.1 + rw [h.1] at hne + simp at hne + · have hne := (LatticeTileGridStructure B hB).1.1 + rw [h.1] at hne + simp at hne + +private theorem transition_indices_ne : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin + 4), ∀ (k : Fin 4), ((LatticeVertexIncidentCell x j ∈ A.cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ B.cells) ∨ + (LatticeVertexIncidentCell x j ∈ B.cells ∧ + LatticeVertexIncidentCell x (j + 1) ∈ A.cells)) → (((LatticeVertexIncidentCell x k + ∈ B.cells ∧ + LatticeVertexIncidentCell x (k + 1) ∈ C.cells) ∨ + (LatticeVertexIncidentCell x k ∈ C.cells ∧ + LatticeVertexIncidentCell x (k + 1) ∈ B.cells)) → ((Disjoint A.cells B.cells) → + ((Disjoint B.cells C.cells) → ((Disjoint A.cells C.cells) → (j ≠ k))))) ) := by + classical + intro A B C x j k hAB hBC hABdis hBCdis hACdis hEq + subst k + rcases hAB with hAB | hAB <;> rcases hBC with hBC | hBC + · exact (Finset.disjoint_left.mp hABdis) hAB.1 hBC.1 + · exact (Finset.disjoint_left.mp hACdis) hAB.1 hBC.1 + · exact (Finset.disjoint_left.mp hACdis) hAB.2 hBC.2 + · exact (Finset.disjoint_left.mp hBCdis) hAB.1 hBC.1 + +private theorem triple_transitions : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), (LatticeTile T0) → ((LatticeTile T0') → + ((Disjoint T0.cells T0'.cells) → ( + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (point : GaussianInt), ∀ (other : GaussianInt), + (SimpleGridPathBetween (FootprintVertices A ∩ FootprintVertices B) (FootprintEdges A + ∩ FootprintEdges B) point other) → ((LatticeTile A) → ((LatticeTile B) → ((Disjoint + A.cells B.cells) → (point ∈ BoundaryFootprintVertices A ∩ BoundaryFootprintVertices + B))))) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), (LatticeTile A) → ((LatticeTile B) → + ((TileTouching A B) → (SimpleGridPath (BoundaryFootprintVertices A ∩ + BoundaryFootprintVertices B) (BoundaryFootprintEdges A ∩ BoundaryFootprintEdges + B))))) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (x : + GaussianInt), ∀ (j : Fin 4), ∀ (k : Fin 4), ((LatticeVertexIncidentCell x j ∈ A.cells + ∧ LatticeVertexIncidentCell x (j + 1) ∈ B.cells) ∨ (LatticeVertexIncidentCell x j ∈ + B.cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ A.cells)) → + (((LatticeVertexIncidentCell x k ∈ B.cells ∧ LatticeVertexIncidentCell x (k + 1) ∈ + C.cells) ∨ (LatticeVertexIncidentCell x k ∈ C.cells ∧ LatticeVertexIncidentCell x (k + + 1) ∈ B.cells)) → ((Disjoint A.cells B.cells) → ((Disjoint B.cells C.cells) → + ((Disjoint A.cells C.cells) → (j ≠ k)))))) → (∀ (R : ProtoTile), ∀ (E : + ExactTileInterfaceTriple T0 T0' R), (LatticeTile R) → ((Disjoint T0.cells R.cells) → + ((Disjoint T0'.cells R.cells) → ((TouchingTriple T0 T0' R) → (∃ eAB eBR eRA : Finset + GaussianInt, ∃ jAB jBR jRA : Fin 4, E.point ∈ eAB ∧ eAB ∈ FootprintEdges T0 ∩ + FootprintEdges T0' ∧ eAB = edgeAt E.point jAB ∧ E.point ∈ eBR ∧ eBR ∈ FootprintEdges + T0' ∩ FootprintEdges R ∧ eBR = edgeAt E.point jBR ∧ E.point ∈ eRA ∧ eRA ∈ + FootprintEdges R ∩ FootprintEdges T0 ∧ eRA = edgeAt E.point jRA ∧ + ((LatticeVertexIncidentCell E.point jAB ∈ T0.cells ∧ LatticeVertexIncidentCell + E.point (jAB + 1) ∈ T0'.cells) ∨ (LatticeVertexIncidentCell E.point jAB ∈ T0'.cells ∧ + LatticeVertexIncidentCell E.point (jAB + 1) ∈ T0.cells)) ∧ + ((LatticeVertexIncidentCell E.point jBR ∈ T0'.cells ∧ LatticeVertexIncidentCell + E.point (jBR + 1) ∈ R.cells) ∨ (LatticeVertexIncidentCell E.point jBR ∈ R.cells ∧ + LatticeVertexIncidentCell E.point (jBR + 1) ∈ T0'.cells)) ∧ + ((LatticeVertexIncidentCell E.point jRA ∈ R.cells ∧ LatticeVertexIncidentCell E.point + (jRA + 1) ∈ T0.cells) ∨ (LatticeVertexIncidentCell E.point jRA ∈ T0.cells ∧ + LatticeVertexIncidentCell E.point (jRA + 1) ∈ R.cells)) ∧ jAB ≠ jBR ∧ jBR ≠ jRA ∧ jRA + ≠ jAB)))))))))) ) := by + classical + intro T0 T0' hT hT' hdis edgeAt exact_point_boundary touching_path transition_indices_ne R E hR + hAR hBR hTouch + rcases hTouch with ⟨hABtouch, hBRtouch, hRAtouch, _⟩ + have hABvertex := exact_point_boundary T0 T0' E.point E.otherAB + E.pathAB hT hT' hdis + have hBRvertex := exact_point_boundary T0' R E.point E.otherBC + E.pathBC hT' hR hBR + have hRAvertex := exact_point_boundary R T0 E.point E.otherCA + E.pathCA hR hT hAR.symm + have hABpath := touching_path T0 T0' hT hT' hABtouch + have hBRpath := touching_path T0' R hT' hR hBRtouch + have hRApath := touching_path R T0 hR hT hRAtouch + obtain ⟨eAB, hxeAB, heAB⟩ := SimpleGridPathVertexIncidentEdge + _ _ hABpath E.point hABvertex + obtain ⟨eBR, hxeBR, heBR⟩ := SimpleGridPathVertexIncidentEdge + _ _ hBRpath E.point hBRvertex + obtain ⟨eRA, hxeRA, heRA⟩ := SimpleGridPathVertexIncidentEdge + _ _ hRApath E.point hRAvertex + have heABraw : eAB ∈ FootprintEdges T0 ∩ FootprintEdges T0' := by + rw [CellDisjointCommonEdgesBoundary T0 T0' hdis] + exact heAB + have heBRraw : eBR ∈ FootprintEdges T0' ∩ FootprintEdges R := by + rw [CellDisjointCommonEdgesBoundary T0' R hBR] + exact heBR + have heRAraw : eRA ∈ FootprintEdges R ∩ FootprintEdges T0 := by + rw [CellDisjointCommonEdgesBoundary R T0 hAR.symm] + exact heRA + obtain ⟨jAB, heABat, htransAB⟩ := + P3102T2CommonEdgeSectorTransition T0 T0' E.point eAB hdis hxeAB heABraw + obtain ⟨jBR, heBRat, htransBR⟩ := + P3102T2CommonEdgeSectorTransition T0' R E.point eBR hBR hxeBR heBRraw + obtain ⟨jRA, heRAat, htransRA⟩ := + P3102T2CommonEdgeSectorTransition R T0 E.point eRA hAR.symm hxeRA heRAraw + have hABBR := transition_indices_ne T0 T0' R E.point jAB jBR + htransAB htransBR hdis hBR hAR + have hBRRA := transition_indices_ne T0' R T0 E.point jBR jRA + htransBR htransRA hBR hAR.symm hdis.symm + have hRAAB := transition_indices_ne R T0 T0' E.point jRA jAB + htransRA htransAB hAR.symm hdis hBR.symm + exact ⟨eAB, eBR, eRA, jAB, jBR, jRA, hxeAB, heABraw, heABat, + hxeBR, heBRraw, heBRat, hxeRA, heRAraw, heRAat, + htransAB, htransBR, htransRA, hABBR, hBRRA, hRAAB⟩ + +private theorem triple_sector_cover : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), (LatticeTile T0) → ((LatticeTile T0') → (∀ (R : + ProtoTile), (LatticeTile R) → ((TouchingTriple T0 T0' R) → (∀ (x : GaussianInt), (x ∈ + FootprintVertices T0 ∩ FootprintVertices T0' ∩ + FootprintVertices R) → (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j ∈ + R.cells))))) ) := by + classical + intro T0 T0' hT hT' R hR htriple x hx + exact (LocalLatticeInterfaceSectors.1 T0 T0' R x hT hT' hR + htriple hx).1 + +private theorem label_T0 : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → + (outerLabel x j = 0) ) := by + classical + intro T0 T0' outerLabel x j hc + simp [outerLabel, hc] + +private theorem label_T0' : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), (Disjoint T0.cells T0'.cells) → ( + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0'.cells) → + (outerLabel x j = 1)) ) := by + classical + intro T0 T0' hdis outerLabel x j hc + have hn : LatticeVertexIncidentCell x j ∉ T0.cells := + Finset.disjoint_left.mp hdis.symm hc + simp [outerLabel, hn, hc] + +private theorem label_R : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (R : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), (Disjoint T0.cells R.cells) → + ((Disjoint T0'.cells R.cells) → ((LatticeVertexIncidentCell x j ∈ R.cells) → + (outerLabel x j = 2))) ) := by + classical + intro T0 T0' outerLabel R x j hR0 hR1 hc + have hn0 : LatticeVertexIncidentCell x j ∉ T0.cells := + Finset.disjoint_left.mp hR0.symm hc + have hn1 : LatticeVertexIncidentCell x j ∉ T0'.cells := + Finset.disjoint_left.mp hR1.symm hc + simp [outerLabel, hn0, hn1] + +private theorem label_mem : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → + (outerLabel x j = 0)) → ((∀ (x : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ T0'.cells) → (outerLabel x j = 1)) → (∀ (R : + ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells ∨ + LatticeVertexIncidentCell x j ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 0 ∧ + LatticeVertexIncidentCell x j ∈ T0.cells) ∨ (outerLabel x j = 1 ∧ + LatticeVertexIncidentCell x j ∈ T0'.cells) ∨ (outerLabel x j = 2 ∧ + LatticeVertexIncidentCell x j ∈ R.cells)))) ) := by + classical + intro T0 T0' outerLabel label_T0 label_T0' R x hexhaust j + by_cases h0 : LatticeVertexIncidentCell x j ∈ T0.cells + · exact Or.inl ⟨label_T0 x j h0, h0⟩ + · by_cases h1 : LatticeVertexIncidentCell x j ∈ T0'.cells + · exact Or.inr (Or.inl ⟨label_T0' x j h1, h1⟩) + · rcases hexhaust j with h0' | h1' | hR + · exact (h0 h0').elim + · exact (h1 h1').elim + · exact Or.inr (Or.inr ⟨by simp [outerLabel, h0, h1], hR⟩) + +private theorem label_eq_two_mem : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (R : ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T0.cells ∨ LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j + ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 0 ∧ LatticeVertexIncidentCell x j ∈ + T0.cells) ∨ (outerLabel x j = 1 ∧ LatticeVertexIncidentCell x j ∈ T0'.cells) ∨ + (outerLabel x j = 2 ∧ LatticeVertexIncidentCell x j ∈ R.cells))) → (∀ (R : + ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells ∨ + LatticeVertexIncidentCell x j ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 2) → + (LatticeVertexIncidentCell x j ∈ R.cells))) ) := by + classical + intro T0 T0' outerLabel label_mem R x hexhaust j h + rcases label_mem R x hexhaust j with h0 | h1 | h2 + · rw [h0.1] at h + exact False.elim ((by decide : (0 : Fin 3) ≠ 2) h) + · rw [h1.1] at h + exact False.elim ((by decide : (1 : Fin 3) ≠ 2) h) + · exact h2.2 + +private theorem label_eq_zero_mem : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (R : ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T0.cells ∨ LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j + ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 0 ∧ LatticeVertexIncidentCell x j ∈ + T0.cells) ∨ (outerLabel x j = 1 ∧ LatticeVertexIncidentCell x j ∈ T0'.cells) ∨ + (outerLabel x j = 2 ∧ LatticeVertexIncidentCell x j ∈ R.cells))) → (∀ (R : + ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells ∨ + LatticeVertexIncidentCell x j ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 0) → + (LatticeVertexIncidentCell x j ∈ T0.cells))) ) := by + classical + intro T0 T0' outerLabel label_mem R x hexhaust j h + rcases label_mem R x hexhaust j with h0 | h1 | h2 + · exact h0.2 + · exact False.elim ((by decide : (1 : Fin 3) ≠ 0) + (h1.1.symm.trans h)) + · exact False.elim ((by decide : (2 : Fin 3) ≠ 0) + (h2.1.symm.trans h)) + +private theorem label_eq_one_mem : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (R : ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T0.cells ∨ LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j + ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 0 ∧ LatticeVertexIncidentCell x j ∈ + T0.cells) ∨ (outerLabel x j = 1 ∧ LatticeVertexIncidentCell x j ∈ T0'.cells) ∨ + (outerLabel x j = 2 ∧ LatticeVertexIncidentCell x j ∈ R.cells))) → (∀ (R : + ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells ∨ + LatticeVertexIncidentCell x j ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 1) → + (LatticeVertexIncidentCell x j ∈ T0'.cells))) ) := by + classical + intro T0 T0' outerLabel label_mem R x hexhaust j h + rcases label_mem R x hexhaust j with h0 | h1 | h2 + · exact False.elim ((by decide : (0 : Fin 3) ≠ 1) + (h0.1.symm.trans h)) + · exact h1.2 + · exact False.elim ((by decide : (2 : Fin 3) ≠ 1) + (h2.1.symm.trans h)) + +private theorem label_side_mem : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (R : ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T0.cells ∨ LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j + ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 0 ∧ LatticeVertexIncidentCell x j ∈ + T0.cells) ∨ (outerLabel x j = 1 ∧ LatticeVertexIncidentCell x j ∈ T0'.cells) ∨ + (outerLabel x j = 2 ∧ LatticeVertexIncidentCell x j ∈ R.cells))) → (∀ (R : + ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells ∨ + LatticeVertexIncidentCell x j ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 0 ∨ + outerLabel x j = 1) → (LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells))) ) := by + classical + intro T0 T0' outerLabel label_mem R x hexhaust j h + rcases label_mem R x hexhaust j with h0 | h1 | h2 + · exact Or.inl h0.2 + · exact Or.inr h1.2 + · rcases h with h | h + · exact False.elim ((by decide : (0 : Fin 3) ≠ 2) + (h.symm.trans h2.1)) + · exact False.elim ((by decide : (1 : Fin 3) ≠ 2) + (h.symm.trans h2.1)) + +private theorem owner_eq_endpoint : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (owner : GaussianInt → ι), ∀ (R : + ProtoTile), ∀ (endpointIndex : ι), (P.tile endpointIndex = R) → ((∀ (c : + GaussianInt), ∀ (a : ι), (c ∈ (P.tile a).cells) → (owner c = a)) → (∀ (x : + GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ R.cells) → (owner + (LatticeVertexIncidentCell x j) = endpointIndex))) ) := by + classical + intro ι P owner R endpointIndex hRidx owner_unique x j hc + apply owner_unique + simpa [hRidx] using hc + +private theorem owner_repeat_at : + (by + classical + exact + ∀ (ι : Type), ∀ (owner : GaussianInt → ι), (∀ (x : GaussianInt), owner + (LatticeVertexIncidentCell x (0 : Fin (4 : ℕ))) = owner (LatticeVertexIncidentCell x + (1 : Fin (4 : ℕ))) ∨ owner (LatticeVertexIncidentCell x (0 : Fin (4 : ℕ))) = owner + (LatticeVertexIncidentCell x (2 : Fin (4 : ℕ))) ∨ owner (LatticeVertexIncidentCell x + (0 : Fin (4 : ℕ))) = owner (LatticeVertexIncidentCell x (3 : Fin (4 : ℕ))) ∨ owner + (LatticeVertexIncidentCell x (1 : Fin (4 : ℕ))) = owner (LatticeVertexIncidentCell x + (2 : Fin (4 : ℕ))) ∨ owner (LatticeVertexIncidentCell x (1 : Fin (4 : ℕ))) = owner + (LatticeVertexIncidentCell x (3 : Fin (4 : ℕ))) ∨ owner (LatticeVertexIncidentCell x + (2 : Fin (4 : ℕ))) = owner (LatticeVertexIncidentCell x (3 : Fin (4 : ℕ)))) → (∀ (x : + GaussianInt), ∀ (j : Fin 4), owner (LatticeVertexIncidentCell x j) = owner + (LatticeVertexIncidentCell x (j + 1)) ∨ owner (LatticeVertexIncidentCell x j) = owner + (LatticeVertexIncidentCell x (j + 2)) ∨ owner (LatticeVertexIncidentCell x j) = owner + (LatticeVertexIncidentCell x (j + 3)) ∨ owner (LatticeVertexIncidentCell x (j + 1)) = + owner (LatticeVertexIncidentCell x (j + 2)) ∨ owner (LatticeVertexIncidentCell x (j + + 1)) = owner (LatticeVertexIncidentCell x (j + 3)) ∨ owner (LatticeVertexIncidentCell + x (j + 2)) = owner (LatticeVertexIncidentCell x (j + 3))) ) := by + classical + intro ι owner owner_no_fourfold x j + let occ : Fin 4 → ι := fun i => + owner (LatticeVertexIncidentCell x i) + have h := owner_no_fourfold x + change occ 0 = occ 1 ∨ occ 0 = occ 2 ∨ occ 0 = occ 3 ∨ + occ 1 = occ 2 ∨ occ 1 = occ 3 ∨ occ 2 = occ 3 at h + fin_cases j + · exact h + · rcases h with h01 | h02 | h03 | h12 | h13 | h23 + · exact Or.inr (Or.inr (Or.inl h01.symm)) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl h02.symm)))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr h03.symm)))) + · exact Or.inl h12 + · exact Or.inr (Or.inl h13) + · exact Or.inr (Or.inr (Or.inr (Or.inl h23))) + · rcases h with h01 | h02 | h03 | h12 | h13 | h23 + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr h01)))) + · exact Or.inr (Or.inl h02.symm) + · exact Or.inr (Or.inr (Or.inr (Or.inl h03.symm))) + · exact Or.inr (Or.inr (Or.inl h12.symm)) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl h13.symm)))) + · exact Or.inl h23 + · rcases h with h01 | h02 | h03 | h12 | h13 | h23 + · exact Or.inr (Or.inr (Or.inr (Or.inl h01))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl h02)))) + · exact Or.inl h03.symm + · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr h12)))) + · exact Or.inr (Or.inl h13.symm) + · exact Or.inr (Or.inr (Or.inl h23.symm)) + +private theorem owner_ne_T0_index : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (owner : GaussianInt → ι), (∀ (c : + GaussianInt), ∀ (a : ι), c ∈ (P.tile a).cells ↔ owner c = a) → (∀ (T0 : ProtoTile), ∀ + (T0' : ProtoTile), (Disjoint T0.cells T0'.cells) → (∀ (c : GaussianInt), ∀ (a : ι), + ((P.tile a).cells ⊆ T0.cells) → ((c ∈ T0'.cells) → (owner c ≠ a)))) ) := by + classical + intro ι P owner owner_mem_iff T0 T0' hdis c a hsub hc heq + have hcP := (owner_mem_iff c a).2 heq + exact (Finset.disjoint_left.mp hdis) (hsub hcP) hc + +private theorem owner_ne_T0'_index : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (owner : GaussianInt → ι), (∀ (c : + GaussianInt), ∀ (a : ι), c ∈ (P.tile a).cells ↔ owner c = a) → (∀ (T0 : ProtoTile), ∀ + (T0' : ProtoTile), (Disjoint T0.cells T0'.cells) → (∀ (c : GaussianInt), ∀ (a : ι), + ((P.tile a).cells ⊆ T0'.cells) → ((c ∈ T0.cells) → (owner c ≠ a)))) ) := by + classical + intro ι P owner owner_mem_iff T0 T0' hdis c a hsub hc heq + have hcP := (owner_mem_iff c a).2 heq + exact (Finset.disjoint_left.mp hdis.symm) (hsub hcP) hc + +private theorem owner_ne_endpoint : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (owner : GaussianInt → ι), (∀ (c : + GaussianInt), ∀ (a : ι), c ∈ (P.tile a).cells ↔ owner c = a) → (∀ (T0 : ProtoTile), ∀ + (T0' : ProtoTile), ∀ (R : ProtoTile), (Disjoint T0.cells R.cells) → ((Disjoint + T0'.cells R.cells) → (∀ (endpointIndex : ι), (P.tile endpointIndex = R) → (∀ (x : + GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells) → (owner (LatticeVertexIncidentCell x j) ≠ + endpointIndex))))) ) := by + classical + intro ι P owner owner_mem_iff T0 T0' R hTm hT'm endpointIndex hRidx x j hside heq + have hcP := (owner_mem_iff (LatticeVertexIncidentCell x j) endpointIndex).2 heq + have hcR : LatticeVertexIncidentCell x j ∈ R.cells := by + simpa [hRidx] using hcP + rcases hside with hside | hside + · exact (Finset.disjoint_left.mp hTm) hside hcR + · exact (Finset.disjoint_left.mp hT'm) hside hcR + +private theorem hdisUV : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), (Disjoint + T0.cells T0'.cells) → ((U.cells ⊆ T0.cells) → ((V.cells ⊆ T0'.cells) → (Disjoint + U.cells V.cells))) ) := by + classical + intro T0 T0' U V hdis hUsub hVsub + apply Finset.disjoint_left.mpr + intro c hcU hcV + exact (Finset.disjoint_left.mp hdis) (hUsub hcU) (hVsub hcV) + +private theorem hsectorEdge : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (ia + : ι), ∀ (ib : ι), (P.tile ia = U) → ((P.tile ib = V) → (∀ (x : GaussianInt), ∀ (jEdge + : Fin (4 : ℕ)), (LatticeVertexIncidentCell x jEdge ∈ U.cells ∧ + LatticeVertexIncidentCell x (jEdge + (1 : Fin (4 : ℕ))) ∈ V.cells ∨ + LatticeVertexIncidentCell x jEdge ∈ V.cells ∧ LatticeVertexIncidentCell x (jEdge + (1 + : Fin (4 : ℕ))) ∈ U.cells) → ((LatticeVertexIncidentCell x jEdge ∈ (P.tile ia).cells + ∧ LatticeVertexIncidentCell x (jEdge + 1) ∈ (P.tile ib).cells) ∨ + (LatticeVertexIncidentCell x jEdge ∈ (P.tile ib).cells ∧ LatticeVertexIncidentCell x + (jEdge + 1) ∈ (P.tile ia).cells)))) ) := by + classical + intro ι P U V ia ib hUidx hVidx x jEdge htransition + simpa [hUidx, hVidx] using htransition + +private theorem hjABEdge : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (x : GaussianInt), ∀ {j : Fin 4}, ∀ {k : Fin 4}, (edgeAt x j = edgeAt x k) → (j = k)) + → (∀ (jEdge : Fin (4 : ℕ)), ∀ (eAB : Finset GaussianInt), ∀ (jAB : Fin (4 : ℕ)), (eAB + = {x, y}) → ((eAB = edgeAt x jAB) → ((({x, y} : Finset GaussianInt) = edgeAt x jEdge) + → (jAB = jEdge)))) ) := by + classical + intro x y edgeAt edgeAt_injective jEdge eAB jAB hABedge_eq hABatx hedgeAtx + apply edgeAt_injective x + calc + edgeAt x jAB = eAB := hABatx.symm + _ = {x, y} := hABedge_eq + _ = edgeAt x jEdge := hedgeAtx + +private theorem hlabelAB : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (x : GaussianInt), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → + (outerLabel x j = 0)) → ((∀ (x : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ T0'.cells) → (outerLabel x j = 1)) → (∀ (jAB : Fin + (4 : ℕ)), (LatticeVertexIncidentCell x jAB ∈ T0.cells ∧ LatticeVertexIncidentCell x + (jAB + (1 : Fin (4 : ℕ))) ∈ T0'.cells ∨ LatticeVertexIncidentCell x jAB ∈ T0'.cells ∧ + LatticeVertexIncidentCell x (jAB + (1 : Fin (4 : ℕ))) ∈ T0.cells) → + (({outerLabel x jAB, outerLabel x (jAB + 1)} : Finset (Fin 3)) = {0, 1}))) ) := by + classical + intro T0 T0' x outerLabel label_T0 label_T0' jAB htransABx + rcases htransABx with h | h + · rw [label_T0 x jAB h.1, + label_T0' x (jAB + 1) h.2] + · rw [label_T0' x jAB h.1, + label_T0 x (jAB + 1) h.2] + try simp [Finset.pair_comm] + +private theorem hlabelBR : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (R : ProtoTile), (Disjoint T0.cells R.cells) → + ((Disjoint T0'.cells R.cells) → (∀ (x : GaussianInt), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0'.cells) → + (outerLabel x j = 1)) → ((∀ (R : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), + (Disjoint T0.cells R.cells) → ((Disjoint T0'.cells R.cells) → + ((LatticeVertexIncidentCell x j ∈ R.cells) → (outerLabel x j = 2)))) → (∀ (jBR : Fin + (4 : ℕ)), (LatticeVertexIncidentCell x jBR ∈ T0'.cells ∧ LatticeVertexIncidentCell x + (jBR + (1 : Fin (4 : ℕ))) ∈ R.cells ∨ LatticeVertexIncidentCell x jBR ∈ R.cells ∧ + LatticeVertexIncidentCell x (jBR + (1 : Fin (4 : ℕ))) ∈ T0'.cells) → + (({outerLabel x jBR, outerLabel x (jBR + 1)} : Finset (Fin 3)) = {1, 2}))))) ) := by + classical + intro T0 T0' R hTm hT'm x outerLabel label_T0' label_R jBR htransBRx + rcases htransBRx with h | h + · rw [label_T0' x jBR h.1, + label_R R x (jBR + 1) hTm hT'm h.2] + · rw [label_R R x jBR hTm hT'm h.1, + label_T0' x (jBR + 1) h.2] + try simp [Finset.pair_comm] + +private theorem hlabelRA : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (R : ProtoTile), (Disjoint T0.cells R.cells) → + ((Disjoint T0'.cells R.cells) → (∀ (x : GaussianInt), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → + (outerLabel x j = 0)) → ((∀ (R : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), + (Disjoint T0.cells R.cells) → ((Disjoint T0'.cells R.cells) → + ((LatticeVertexIncidentCell x j ∈ R.cells) → (outerLabel x j = 2)))) → (∀ (jRA : Fin + (4 : ℕ)), (LatticeVertexIncidentCell x jRA ∈ R.cells ∧ LatticeVertexIncidentCell x + (jRA + (1 : Fin (4 : ℕ))) ∈ T0.cells ∨ LatticeVertexIncidentCell x jRA ∈ T0.cells ∧ + LatticeVertexIncidentCell x (jRA + (1 : Fin (4 : ℕ))) ∈ R.cells) → + (({outerLabel x jRA, outerLabel x (jRA + 1)} : Finset (Fin 3)) = {2, 0}))))) ) := by + classical + intro T0 T0' R hTm hT'm x outerLabel label_T0 label_R jRA htransRAx + rcases htransRAx with h | h + · rw [label_R R x jRA hTm hT'm h.1, + label_T0 x (jRA + 1) h.2] + · rw [label_T0 x jRA h.1, + label_R R x (jRA + 1) hTm hT'm h.2] + try simp [Finset.pair_comm] + +private theorem hlabelGood : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (R : ProtoTile), ∀ (E : + ExactTileInterfaceTriple T0 T0' R), (Disjoint T0.cells R.cells) → ((Disjoint + T0'.cells R.cells) → (∀ (x : GaussianInt), (∀ (z : GaussianInt), z = x ∨ z = x + (1 : + GaussianInt) ∨ z = x - (1 : GaussianInt) ∨ z = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + ∨ z = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → z ∈ FootprintVertices T0 ∨ z ∈ + FootprintVertices T0') → ( + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (E : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), (x ∈ FootprintVertices T0) → ((x + ∈ FootprintVertices T0') → ((∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y + = x - ⟨0, 1⟩ → y ∈ FootprintVertices T0 ∨ y ∈ FootprintVertices T0') → ((Disjoint + E.cells T0.cells) → ((Disjoint E.cells T0'.cells) → ((LatticeVertexIncidentCell x j ∈ + E.cells) → ((LatticeVertexIncidentCell x (j + 1) ∈ E.cells) → (False)))))))) → ( + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (R : ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T0.cells ∨ LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j + ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 2) → (LatticeVertexIncidentCell x j ∈ + R.cells))) → ((x ∈ FootprintVertices T0 ∩ FootprintVertices T0' ∩ FootprintVertices + R) → ((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j ∈ R.cells) + → (∀ (jEdge : Fin (4 : ℕ)), ∀ (eAB : Finset GaussianInt), ∀ (jAB : Fin (4 : ℕ)), ∀ + (jBR : Fin (4 : ℕ)), ∀ (jRA : Fin (4 : ℕ)), (eAB = edgeAt E.point jAB) → + ((LatticeVertexIncidentCell E.point jAB ∈ T0.cells ∧ LatticeVertexIncidentCell + E.point (jAB + (1 : Fin (4 : ℕ))) ∈ T0'.cells ∨ LatticeVertexIncidentCell E.point jAB + ∈ T0'.cells ∧ LatticeVertexIncidentCell E.point (jAB + (1 : Fin (4 : ℕ))) ∈ T0.cells) + → ((jAB ≠ jBR) → ((jRA ≠ jAB) → ((eAB = edgeAt x jAB) → ((LatticeVertexIncidentCell x + jAB ∈ T0.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : Fin (4 : ℕ))) ∈ T0'.cells ∨ + LatticeVertexIncidentCell x jAB ∈ T0'.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : + Fin (4 : ℕ))) ∈ T0.cells) → ((jAB = jEdge) → ((({outerLabel x jAB, + outerLabel x (jAB + 1)} : Finset (Fin 3)) = {0, 1}) → ((outerLabel x (jAB + (2 : Fin + (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = outerLabel x + jAB ∨ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + + (2 : Fin (4 : ℕ))) = outerLabel x (jAB + (1 : Fin (4 : ℕ))) ∨ outerLabel x (jAB + + (2 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 + : Fin (3 : ℕ)) ∨ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ + outerLabel x jAB = (2 : Fin (3 : ℕ))) → ((outerLabel x (jAB + 2) = 2 ∧ outerLabel x + (jAB + 3) = outerLabel x jAB) ∨ (outerLabel x (jAB + 3) = 2 ∧ outerLabel x (jAB + 2) + = outerLabel x (jAB + 1)))))))))))))))))) ) := by + classical + intro T0 T0' R E hTm hT'm x hstar edgeAt endpoint_repeat_impossible outerLabel label_eq_two_mem + hxTriple hsectorCover jEdge eAB jAB jBR jRA hABat htransAB hjABBR hjRAAB hABatx htransABx + hjABEdge hlabelAB hlabelPattern + rcases hlabelPattern with h | h | h | h + · exact Or.inl h + · exact Or.inr h + · have hfalse := endpoint_repeat_impossible R x (jAB + 2) + hxTriple.1.1 hxTriple.1.2 hstar hTm.symm hT'm.symm + (label_eq_two_mem R x hsectorCover (jAB + 2) h.1) + (by + have heq : jAB + 2 + 1 = jAB + 3 := by omega + simpa [heq] using + label_eq_two_mem R x hsectorCover (jAB + 3) h.2) + exact False.elim hfalse + · have hfalse := endpoint_repeat_impossible R x (jAB + 3) + hxTriple.1.1 hxTriple.1.2 hstar hTm.symm hT'm.symm + (label_eq_two_mem R x hsectorCover (jAB + 3) h.1) + (by + have heq : jAB + 3 + 1 = jAB := by + fin_cases jAB <;> decide + simpa [heq] using label_eq_two_mem R x hsectorCover jAB h.2) + exact False.elim hfalse + +private theorem hsectorAB : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (ia : ι), ∀ (ib : ι), ∀ (x : GaussianInt), + ∀ (jEdge : Fin (4 : ℕ)), ((LatticeVertexIncidentCell x jEdge ∈ (P.tile ia).cells ∧ + LatticeVertexIncidentCell x (jEdge + 1) ∈ (P.tile ib).cells) ∨ + (LatticeVertexIncidentCell x jEdge ∈ (P.tile ib).cells ∧ LatticeVertexIncidentCell x + (jEdge + 1) ∈ (P.tile ia).cells)) → (∀ (jAB : Fin (4 : ℕ)), (jAB = jEdge) → + ((LatticeVertexIncidentCell x jAB ∈ (P.tile ia).cells ∧ LatticeVertexIncidentCell x + (jAB + 1) ∈ (P.tile ib).cells) ∨ (LatticeVertexIncidentCell x jAB ∈ (P.tile ib).cells + ∧ LatticeVertexIncidentCell x (jAB + 1) ∈ (P.tile ia).cells))) ) := by + classical + intro ι P ia ib x jEdge hsectorEdge jAB hjABEdge + simpa [hjABEdge] using hsectorEdge + +private theorem hownerAB : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (owner : GaussianInt → ι), ∀ (U : + ProtoTile), ∀ (V : ProtoTile), ∀ (ia : ι), ∀ (ib : ι), (P.tile ia = U) → ((P.tile ib + = V) → (∀ (x : GaussianInt), (∀ (c : GaussianInt), ∀ (a : ι), (c ∈ (P.tile a).cells) + → (owner c = a)) → (∀ (jAB : Fin (4 : ℕ)), ((LatticeVertexIncidentCell x jAB ∈ + (P.tile ia).cells ∧ LatticeVertexIncidentCell x (jAB + 1) ∈ (P.tile ib).cells) ∨ + (LatticeVertexIncidentCell x jAB ∈ (P.tile ib).cells ∧ LatticeVertexIncidentCell x + (jAB + 1) ∈ (P.tile ia).cells)) → ((owner (LatticeVertexIncidentCell x jAB) = ia ∧ + owner (LatticeVertexIncidentCell x (jAB + 1)) = ib) ∨ (owner + (LatticeVertexIncidentCell x jAB) = ib ∧ owner (LatticeVertexIncidentCell x (jAB + + 1)) = ia))))) ) := by + classical + intro ι P owner U V ia ib hUidx hVidx x owner_unique jAB hsectorAB + rcases hsectorAB with h | h + · exact Or.inl ⟨owner_unique _ _ (by simpa [hUidx] using h.1), + owner_unique _ _ (by simpa [hVidx] using h.2)⟩ + · exact Or.inr ⟨owner_unique _ _ (by simpa [hVidx] using h.1), + owner_unique _ _ (by simpa [hUidx] using h.2)⟩ + +private theorem hownerAligned : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (owner : GaussianInt → ι), (∀ (c : + GaussianInt), ∀ (a : ι), c ∈ (P.tile a).cells ↔ owner c = a) → (∀ (T0 : ProtoTile), ∀ + (T0' : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), (Disjoint T0.cells + T0'.cells) → (∀ (ia : ι), ∀ (ib : ι), (P.tile ia = U) → ((P.tile ib = V) → ((U.cells + ⊆ T0.cells) → ((V.cells ⊆ T0'.cells) → (∀ (x : GaussianInt), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → + (outerLabel x j = 0)) → ((∀ (x : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ T0'.cells) → (outerLabel x j = 1)) → (∀ (jAB : Fin + (4 : ℕ)), (LatticeVertexIncidentCell x jAB ∈ T0.cells ∧ LatticeVertexIncidentCell x + (jAB + (1 : Fin (4 : ℕ))) ∈ T0'.cells ∨ LatticeVertexIncidentCell x jAB ∈ T0'.cells ∧ + LatticeVertexIncidentCell x (jAB + (1 : Fin (4 : ℕ))) ∈ T0.cells) → (((owner + (LatticeVertexIncidentCell x jAB) = ia ∧ owner (LatticeVertexIncidentCell x (jAB + + 1)) = ib) ∨ (owner (LatticeVertexIncidentCell x jAB) = ib ∧ owner + (LatticeVertexIncidentCell x (jAB + 1)) = ia)) → ((outerLabel x jAB = 0 ∧ owner + (LatticeVertexIncidentCell x jAB) = ia ∧ owner (LatticeVertexIncidentCell x (jAB + + 1)) = ib) ∨ (outerLabel x jAB = 1 ∧ owner (LatticeVertexIncidentCell x jAB) = ib ∧ + owner (LatticeVertexIncidentCell x (jAB + 1)) = ia))))))))))) ) := by + classical + intro ι P owner owner_mem_iff T0 T0' U V hdis ia ib hUidx hVidx hUsub hVsub x outerLabel + label_T0 label_T0' jAB htransABx hownerAB + rcases htransABx with h | h + · left + refine ⟨label_T0 x jAB h.1, ?_⟩ + rcases hownerAB with hab | hba + · exact hab + · have hc := (owner_mem_iff (LatticeVertexIncidentCell x jAB) ib).2 hba.1 + have hc' : LatticeVertexIncidentCell x jAB ∈ T0'.cells := by + rw [hVidx] at hc + exact hVsub hc + exact False.elim ((Finset.disjoint_left.mp hdis) h.1 hc') + · right + refine ⟨label_T0' x jAB h.1, ?_⟩ + rcases hownerAB with hab | hba + · have hc := (owner_mem_iff (LatticeVertexIncidentCell x jAB) ia).2 hab.1 + have hc' : LatticeVertexIncidentCell x jAB ∈ T0.cells := by + rw [hUidx] at hc + exact hUsub hc + exact False.elim ((Finset.disjoint_left.mp hdis.symm) h.1 hc') + · exact hba + +private theorem hlabelsAB : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (x : GaussianInt), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → + (outerLabel x j = 0)) → ((∀ (x : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ T0'.cells) → (outerLabel x j = 1)) → (∀ (jAB : Fin + (4 : ℕ)), (LatticeVertexIncidentCell x jAB ∈ T0.cells ∧ LatticeVertexIncidentCell x + (jAB + (1 : Fin (4 : ℕ))) ∈ T0'.cells ∨ LatticeVertexIncidentCell x jAB ∈ T0'.cells ∧ + LatticeVertexIncidentCell x (jAB + (1 : Fin (4 : ℕ))) ∈ T0.cells) → ((outerLabel x + jAB = 0 ∧ outerLabel x (jAB + 1) = 1) ∨ (outerLabel x jAB = 1 ∧ outerLabel x (jAB + + 1) = 0)))) ) := by + classical + intro T0 T0' x outerLabel label_T0 label_T0' jAB htransABx + rcases htransABx with h | h + · exact Or.inl ⟨label_T0 x jAB h.1, + label_T0' x (jAB + 1) h.2⟩ + · exact Or.inr ⟨label_T0' x jAB h.1, + label_T0 x (jAB + 1) h.2⟩ + +private theorem hownerAligned' : + (by + classical + exact + ∀ (ι : Type), ∀ (owner : GaussianInt → ι), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (ia + : ι), ∀ (ib : ι), ∀ (x : GaussianInt), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (jAB : Fin (4 : ℕ)), ((outerLabel x jAB = 0 ∧ owner (LatticeVertexIncidentCell x jAB) = + ia ∧ owner (LatticeVertexIncidentCell x (jAB + 1)) = ib) ∨ (outerLabel x jAB = 1 ∧ + owner (LatticeVertexIncidentCell x jAB) = ib ∧ owner (LatticeVertexIncidentCell x + (jAB + 1)) = ia)) → ( + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + (outerLabel x jAB = 0 ∧ o0 = ia ∧ o1 = ib) ∨ (outerLabel x jAB = 1 ∧ o0 = ib ∧ o1 = ia)) + ) := by + classical + intro ι owner T0 T0' ia ib x outerLabel jAB hownerAligned o0 o1 + simpa [o0, o1] using hownerAligned + +private theorem hownerRepeat : + (by + classical + exact + ∀ (ι : Type), ∀ (owner : GaussianInt → ι), ∀ (x : GaussianInt), (∀ (x : GaussianInt), ∀ + (j : Fin 4), owner (LatticeVertexIncidentCell x j) = owner (LatticeVertexIncidentCell + x (j + 1)) ∨ owner (LatticeVertexIncidentCell x j) = owner (LatticeVertexIncidentCell + x (j + 2)) ∨ owner (LatticeVertexIncidentCell x j) = owner (LatticeVertexIncidentCell + x (j + 3)) ∨ owner (LatticeVertexIncidentCell x (j + 1)) = owner + (LatticeVertexIncidentCell x (j + 2)) ∨ owner (LatticeVertexIncidentCell x (j + 1)) = + owner (LatticeVertexIncidentCell x (j + 3)) ∨ owner (LatticeVertexIncidentCell x (j + + 2)) = owner (LatticeVertexIncidentCell x (j + 3))) → (∀ (jAB : Fin (4 : ℕ)), + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + let o2 := owner (LatticeVertexIncidentCell x (jAB + 2)) + let o3 := owner (LatticeVertexIncidentCell x (jAB + 3)) + o0 = o1 ∨ o0 = o2 ∨ o0 = o3 ∨ o1 = o2 ∨ o1 = o3 ∨ o2 = o3) ) := by + classical + intro ι owner x owner_repeat_at jAB o0 o1 o2 o3 + simpa [o0, o1, o2, o3] using owner_repeat_at x jAB + +private theorem hcell3side : + (by + classical + exact + ∀ (ι : Type), ∀ (owner : GaussianInt → ι), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (R + : ProtoTile), ∀ (ia : ι), ∀ (ib : ι), ∀ (x : GaussianInt), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (R : ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T0.cells ∨ LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j + ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 0 ∨ outerLabel x j = 1) → + (LatticeVertexIncidentCell x j ∈ T0.cells ∨ LatticeVertexIncidentCell x j ∈ + T0'.cells))) → ((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j ∈ R.cells) + → (∀ (jAB : Fin (4 : ℕ)), + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + ((outerLabel x jAB = 0 ∧ o0 = ia ∧ o1 = ib) ∨ (outerLabel x jAB = 1 ∧ o0 = ib ∧ o1 = ia)) + → ((outerLabel x (jAB + (2 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + + (3 : Fin (4 : ℕ))) = outerLabel x jAB) → (LatticeVertexIncidentCell x (jAB + 3) ∈ + T0.cells ∨ LatticeVertexIncidentCell x (jAB + 3) ∈ T0'.cells)))) ) := by + classical + intro ι owner T0 T0' R ia ib x outerLabel label_side_mem hsectorCover jAB o0 o1 hownerAligned' + hGood + rcases hownerAligned' with hA | hA + · apply label_side_mem R x hsectorCover (jAB + 3) + exact Or.inl (hGood.2.trans hA.1) + · apply label_side_mem R x hsectorCover (jAB + 3) + exact Or.inr (hGood.2.trans hA.1) + +private theorem hside0At763 : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (x : GaussianInt), ∀ (jAB : Fin (4 : ℕ)), + (LatticeVertexIncidentCell x jAB ∈ T0.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : + Fin (4 : ℕ))) ∈ T0'.cells ∨ LatticeVertexIncidentCell x jAB ∈ T0'.cells ∧ + LatticeVertexIncidentCell x (jAB + (1 : Fin (4 : ℕ))) ∈ T0.cells) → + (LatticeVertexIncidentCell x jAB ∈ T0.cells ∨ LatticeVertexIncidentCell x jAB ∈ + T0'.cells) ) := by + classical + intro T0 T0' x jAB htransABx + rcases htransABx with h | h + · exact Or.inl h.1 + · exact Or.inr h.1 + +private theorem hside1At768 : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (x : GaussianInt), ∀ (jAB : Fin (4 : ℕ)), + (LatticeVertexIncidentCell x jAB ∈ T0.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : + Fin (4 : ℕ))) ∈ T0'.cells ∨ LatticeVertexIncidentCell x jAB ∈ T0'.cells ∧ + LatticeVertexIncidentCell x (jAB + (1 : Fin (4 : ℕ))) ∈ T0.cells) → + (LatticeVertexIncidentCell x (jAB + 1) ∈ T0.cells ∨ LatticeVertexIncidentCell x (jAB + + 1) ∈ T0'.cells) ) := by + classical + intro T0 T0' x jAB htransABx + rcases htransABx with h | h + · exact Or.inr h.2 + · exact Or.inl h.2 + +private theorem ho01neAt773 : + (by + classical + exact + ∀ (ι : Type), ∀ (owner : GaussianInt → ι), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (ia + : ι), ∀ (ib : ι), (ia ≠ ib) → (∀ (x : GaussianInt), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (jAB : Fin (4 : ℕ)), + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + ((outerLabel x jAB = 0 ∧ o0 = ia ∧ o1 = ib) ∨ (outerLabel x jAB = 1 ∧ o0 = ib ∧ o1 = ia)) + → (o0 ≠ o1)) ) := by + classical + intro ι owner T0 T0' ia ib hidxne x outerLabel jAB o0 o1 hownerAligned' heq + rcases hownerAligned' with hA | hA + · exact hidxne (hA.2.1.symm.trans (heq.trans hA.2.2)) + · exact hidxne (hA.2.1.symm.trans (heq.trans hA.2.2)).symm + +private theorem ho02neAt778 : + (by + classical + exact + ∀ (ι : Type), ∀ (owner : GaussianInt → ι), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ + (endpointIndex : ι), ∀ (x : GaussianInt), (∀ (x : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ T0.cells ∨ LatticeVertexIncidentCell x j ∈ + T0'.cells) → (owner (LatticeVertexIncidentCell x j) ≠ endpointIndex)) → (∀ (jAB : Fin + (4 : ℕ)), + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o2 := owner (LatticeVertexIncidentCell x (jAB + 2)) + (o2 = endpointIndex) → ((LatticeVertexIncidentCell x jAB ∈ T0.cells ∨ + LatticeVertexIncidentCell x jAB ∈ T0'.cells) → (o0 ≠ o2))) ) := by + classical + intro ι owner T0 T0' endpointIndex x owner_ne_endpoint jAB o0 o2 ho2 hside0 heq + exact owner_ne_endpoint x jAB hside0 (heq.trans ho2) + +private theorem ho12ne : + (by + classical + exact + ∀ (ι : Type), ∀ (owner : GaussianInt → ι), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ + (endpointIndex : ι), ∀ (x : GaussianInt), (∀ (x : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ T0.cells ∨ LatticeVertexIncidentCell x j ∈ + T0'.cells) → (owner (LatticeVertexIncidentCell x j) ≠ endpointIndex)) → (∀ (jAB : Fin + (4 : ℕ)), + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + let o2 := owner (LatticeVertexIncidentCell x (jAB + 2)) + (o2 = endpointIndex) → ((LatticeVertexIncidentCell x (jAB + 1) ∈ T0.cells ∨ + LatticeVertexIncidentCell x (jAB + 1) ∈ T0'.cells) → (o1 ≠ o2))) ) := by + classical + intro ι owner T0 T0' endpointIndex x owner_ne_endpoint jAB o1 o2 ho2 hside1 heq + exact owner_ne_endpoint x (jAB + 1) hside1 (heq.trans ho2) + +private theorem ho13neAt784 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (owner : GaussianInt → ι), ∀ (T0 : + ProtoTile), ∀ (T0' : ProtoTile), ∀ (R : ProtoTile), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), ∀ (ia : ι), ∀ (ib : ι), (P.tile ia = U) → ((P.tile ib = V) → ((U.cells ⊆ + T0.cells) → ((V.cells ⊆ T0'.cells) → (∀ (x : GaussianInt), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (R : ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T0.cells ∨ LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j + ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 0) → (LatticeVertexIncidentCell x j ∈ + T0.cells))) → ((∀ (R : ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T0.cells ∨ LatticeVertexIncidentCell x j ∈ T0'.cells + ∨ LatticeVertexIncidentCell x j ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 1) → + (LatticeVertexIncidentCell x j ∈ T0'.cells))) → ((∀ (c : GaussianInt), ∀ (a : ι), + ((P.tile a).cells ⊆ T0.cells) → ((c ∈ T0'.cells) → (owner c ≠ a))) → ((∀ (c : + GaussianInt), ∀ (a : ι), ((P.tile a).cells ⊆ T0'.cells) → ((c ∈ T0.cells) → (owner c + ≠ a))) → ((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j ∈ R.cells) + → (∀ (jAB : Fin (4 : ℕ)), + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + let o3 := owner (LatticeVertexIncidentCell x (jAB + 3)) + ((outerLabel x jAB = 0 ∧ o0 = ia ∧ o1 = ib) ∨ (outerLabel x jAB = 1 ∧ o0 = ib ∧ o1 = ia)) + → ((outerLabel x (jAB + (2 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + + (3 : Fin (4 : ℕ))) = outerLabel x jAB) → (o1 ≠ o3))))))))))) ) := by + classical + intro ι P owner T0 T0' R U V ia ib hUidx hVidx hUsub hVsub x outerLabel label_eq_zero_mem + label_eq_one_mem owner_ne_T0_index owner_ne_T0'_index hsectorCover jAB o0 o1 o3 + hownerAligned' hGood heq + rcases hownerAligned' with hA | hA + · have h3 := label_eq_zero_mem R x hsectorCover + (jAB + 3) (hGood.2.trans hA.1) + have hVsubidx : (P.tile ib).cells ⊆ T0'.cells := by + rw [hVidx] + exact hVsub + exact owner_ne_T0'_index (LatticeVertexIncidentCell x (jAB + 3)) + ib hVsubidx h3 (heq.symm.trans hA.2.2) + · have h3 := label_eq_one_mem R x hsectorCover + (jAB + 3) (hGood.2.trans hA.1) + have hUsubidx : (P.tile ia).cells ⊆ T0.cells := by + rw [hUidx] + exact hUsub + exact owner_ne_T0_index (LatticeVertexIncidentCell x (jAB + 3)) + ia hUsubidx h3 (heq.symm.trans hA.2.2) + +private theorem ho23neAt801 : + (by + classical + exact + ∀ (ι : Type), ∀ (owner : GaussianInt → ι), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ + (endpointIndex : ι), ∀ (x : GaussianInt), (∀ (x : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ T0.cells ∨ LatticeVertexIncidentCell x j ∈ + T0'.cells) → (owner (LatticeVertexIncidentCell x j) ≠ endpointIndex)) → (∀ (jAB : Fin + (4 : ℕ)), + let o2 := owner (LatticeVertexIncidentCell x (jAB + 2)) + let o3 := owner (LatticeVertexIncidentCell x (jAB + 3)) + (o2 = endpointIndex) → ((LatticeVertexIncidentCell x (jAB + 3) ∈ T0.cells ∨ + LatticeVertexIncidentCell x (jAB + 3) ∈ T0'.cells) → (o2 ≠ o3))) ) := by + classical + intro ι owner T0 T0' endpointIndex x owner_ne_endpoint jAB o2 o3 ho2 hcell3side heq + exact owner_ne_endpoint x (jAB + 3) hcell3side + (heq.symm.trans ho2) + +private theorem ho03 : + (by + classical + exact + ∀ (ι : Type), ∀ (owner : GaussianInt → ι), ∀ (x : GaussianInt), ∀ (jAB : Fin (4 : ℕ)), + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + let o2 := owner (LatticeVertexIncidentCell x (jAB + 2)) + let o3 := owner (LatticeVertexIncidentCell x (jAB + 3)) + (o0 = o1 ∨ o0 = o2 ∨ o0 = o3 ∨ o1 = o2 ∨ o1 = o3 ∨ o2 = o3) → ((o0 ≠ o1) → ((o0 ≠ o2) → + ((o1 ≠ o2) → ((o1 ≠ o3) → ((o2 ≠ o3) → (o0 = o3)))))) ) := by + classical + intro ι owner x jAB o0 o1 o2 o3 hownerRepeat ho01ne ho02ne ho12ne ho13ne ho23ne + rcases hownerRepeat with h01 | h02 | h03 | h12 | h13 | h23 + · exact False.elim (ho01ne h01) + · exact False.elim (ho02ne h02) + · exact h03 + · exact False.elim (ho12ne h12) + · exact False.elim (ho13ne h13) + · exact False.elim (ho23ne h23) + +private theorem hdiagAt813 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (owner : GaussianInt → ι), (∀ (c : + GaussianInt), ∀ (a : ι), c ∈ (P.tile a).cells ↔ owner c = a) → (∀ (T0 : ProtoTile), ∀ + (T0' : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (ia : ι), ∀ (ib : ι), + (P.tile ia = U) → ((P.tile ib = V) → (∀ (x : GaussianInt), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (jAB : Fin (4 : ℕ)), + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + let o3 := owner (LatticeVertexIncidentCell x (jAB + 3)) + ((outerLabel x jAB = 0 ∧ o0 = ia ∧ o1 = ib) ∨ (outerLabel x jAB = 1 ∧ o0 = ib ∧ o1 = ia)) + → ((o0 = o3) → ((LatticeVertexIncidentCell x (jAB + 1) ∈ U.cells ∧ + LatticeVertexIncidentCell x (jAB + 3) ∈ V.cells) ∨ (LatticeVertexIncidentCell x (jAB + + 1) ∈ V.cells ∧ LatticeVertexIncidentCell x (jAB + 3) ∈ U.cells)))))) ) := by + classical + intro ι P owner owner_mem_iff T0 T0' U V ia ib hUidx hVidx x outerLabel jAB o0 o1 o3 + hownerAligned' ho03 + rcases hownerAligned' with hA | hA + · right + constructor + · have hc := (owner_mem_iff _ ib).2 hA.2.2 + simpa [hVidx] using hc + · have heq : o3 = ia := ho03.symm.trans hA.2.1 + have hc := (owner_mem_iff _ ia).2 heq + simpa [hUidx] using hc + · left + constructor + · have hc := (owner_mem_iff _ ia).2 hA.2.2 + simpa [hUidx] using hc + · have heq : o3 = ib := ho03.symm.trans hA.2.1 + have hc := (owner_mem_iff _ ib).2 heq + simpa [hVidx] using hc + +private theorem hfinalCellsAt833 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (owner : GaussianInt → ι), ∀ (T0 : + ProtoTile), ∀ (T0' : ProtoTile), ∀ (R : ProtoTile), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), ∀ (E : ExactTileInterfaceTriple T0 T0' R), ∀ (endpointIndex : ι), ∀ (ia : + ι), ∀ (ib : ι), ∀ (x : GaussianInt), + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (jEdge : Fin (4 : ℕ)), ∀ (eAB : Finset GaussianInt), ∀ (jAB : Fin (4 : ℕ)), ∀ (jBR : + Fin (4 : ℕ)), ∀ (jRA : Fin (4 : ℕ)), (eAB = edgeAt E.point jAB) → + ((LatticeVertexIncidentCell E.point jAB ∈ T0.cells ∧ LatticeVertexIncidentCell + E.point (jAB + (1 : Fin (4 : ℕ))) ∈ T0'.cells ∨ LatticeVertexIncidentCell E.point jAB + ∈ T0'.cells ∧ LatticeVertexIncidentCell E.point (jAB + (1 : Fin (4 : ℕ))) ∈ T0.cells) + → ((jAB ≠ jBR) → ((jRA ≠ jAB) → ((eAB = edgeAt x jAB) → ((LatticeVertexIncidentCell x + jAB ∈ T0.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : Fin (4 : ℕ))) ∈ T0'.cells ∨ + LatticeVertexIncidentCell x jAB ∈ T0'.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : + Fin (4 : ℕ))) ∈ T0.cells) → ((jAB = jEdge) → ((({outerLabel x jAB, + outerLabel x (jAB + 1)} : Finset (Fin 3)) = {0, 1}) → ((outerLabel x (jAB + (2 : Fin + (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = outerLabel x + jAB ∨ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + + (2 : Fin (4 : ℕ))) = outerLabel x (jAB + (1 : Fin (4 : ℕ))) ∨ outerLabel x (jAB + + (2 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 + : Fin (3 : ℕ)) ∨ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ + outerLabel x jAB = (2 : Fin (3 : ℕ))) → (((LatticeVertexIncidentCell x jAB ∈ (P.tile + ia).cells ∧ LatticeVertexIncidentCell x (jAB + 1) ∈ (P.tile ib).cells) ∨ + (LatticeVertexIncidentCell x jAB ∈ (P.tile ib).cells ∧ LatticeVertexIncidentCell x + (jAB + 1) ∈ (P.tile ia).cells)) → (((owner (LatticeVertexIncidentCell x jAB) = ia ∧ + owner (LatticeVertexIncidentCell x (jAB + 1)) = ib) ∨ (owner + (LatticeVertexIncidentCell x jAB) = ib ∧ owner (LatticeVertexIncidentCell x (jAB + + 1)) = ia)) → (((outerLabel x jAB = 0 ∧ owner (LatticeVertexIncidentCell x jAB) = ia ∧ + owner (LatticeVertexIncidentCell x (jAB + 1)) = ib) ∨ (outerLabel x jAB = 1 ∧ owner + (LatticeVertexIncidentCell x jAB) = ib ∧ owner (LatticeVertexIncidentCell x (jAB + + 1)) = ia)) → (((outerLabel x jAB = 0 ∧ outerLabel x (jAB + 1) = 1) ∨ (outerLabel x + jAB = 1 ∧ outerLabel x (jAB + 1) = 0)) → ( + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + let o2 := owner (LatticeVertexIncidentCell x (jAB + 2)) + let o3 := owner (LatticeVertexIncidentCell x (jAB + 3)) + ((outerLabel x jAB = 0 ∧ o0 = ia ∧ o1 = ib) ∨ (outerLabel x jAB = 1 ∧ o0 = ib ∧ o1 = ia)) + → ((o0 = o1 ∨ o0 = o2 ∨ o0 = o3 ∨ o1 = o2 ∨ o1 = o3 ∨ o2 = o3) → ((outerLabel x (jAB + + (2 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = + outerLabel x jAB) → ((LatticeVertexIncidentCell x (jAB + 2) ∈ R.cells) → ((o2 = + endpointIndex) → ((LatticeVertexIncidentCell x (jAB + 3) ∈ T0.cells ∨ + LatticeVertexIncidentCell x (jAB + 3) ∈ T0'.cells) → ((LatticeVertexIncidentCell x + jAB ∈ T0.cells ∨ LatticeVertexIncidentCell x jAB ∈ T0'.cells) → + ((LatticeVertexIncidentCell x (jAB + 1) ∈ T0.cells ∨ LatticeVertexIncidentCell x (jAB + + 1) ∈ T0'.cells) → ((o0 ≠ o1) → ((o0 ≠ o2) → ((o1 ≠ o2) → ((o1 ≠ o3) → ((o2 ≠ o3) → + ((o0 = o3) → (((LatticeVertexIncidentCell x (jAB + 1) ∈ U.cells ∧ + LatticeVertexIncidentCell x (jAB + 3) ∈ V.cells) ∨ (LatticeVertexIncidentCell x (jAB + + 1) ∈ V.cells ∧ LatticeVertexIncidentCell x (jAB + 3) ∈ U.cells)) → ((x ∈ U.cells ∧ + x - 1 - ⟨0, 1⟩ ∈ V.cells) ∨ (x ∈ V.cells ∧ x - 1 - ⟨0, 1⟩ ∈ U.cells) ∨ (x - 1 ∈ + U.cells ∧ x - ⟨0, 1⟩ ∈ V.cells) ∨ (x - 1 ∈ V.cells ∧ x - ⟨0, 1⟩ ∈ + U.cells))))))))))))))))))))))))))))) ) := by + classical + intro ι P owner T0 T0' R U V E endpointIndex ia ib x edgeAt outerLabel jEdge eAB jAB jBR jRA + hABat htransAB hjABBR hjRAAB hABatx htransABx hjABEdge hlabelAB hlabelPattern hsectorAB + hownerAB hownerAligned hlabelsAB o0 o1 o2 o3 hownerAligned' hownerRepeat hGood hcell2 ho2 + hcell3side hside0 hside1 ho01ne ho02ne ho12ne ho13ne ho23ne ho03 hdiag + rcases hdiag with hdiag | hdiag + · fin_cases jAB + · exact Or.inr (Or.inr (Or.inl + (by simpa [LatticeVertexIncidentCell] using hdiag))) + · exact Or.inr (Or.inl + (by simpa [LatticeVertexIncidentCell] using + ⟨hdiag.2, hdiag.1⟩)) + · exact Or.inr (Or.inr (Or.inr + (by simpa [LatticeVertexIncidentCell] using + ⟨hdiag.2, hdiag.1⟩))) + · exact Or.inl + (by simpa [LatticeVertexIncidentCell] using hdiag) + · fin_cases jAB + · exact Or.inr (Or.inr (Or.inr + (by simpa [LatticeVertexIncidentCell] using hdiag))) + · exact Or.inl + (by simpa [LatticeVertexIncidentCell] using + ⟨hdiag.2, hdiag.1⟩) + · exact Or.inr (Or.inr (Or.inl + (by simpa [LatticeVertexIncidentCell] using + ⟨hdiag.2, hdiag.1⟩))) + · exact Or.inr (Or.inl + (by simpa [LatticeVertexIncidentCell] using hdiag)) + +private theorem hcell2side : + (by + classical + exact + ∀ (ι : Type), ∀ (owner : GaussianInt → ι), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (R + : ProtoTile), ∀ (ia : ι), ∀ (ib : ι), ∀ (x : GaussianInt), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (R : ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T0.cells ∨ LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j + ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 0 ∨ outerLabel x j = 1) → + (LatticeVertexIncidentCell x j ∈ T0.cells ∨ LatticeVertexIncidentCell x j ∈ + T0'.cells))) → ((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j ∈ R.cells) + → (∀ (jAB : Fin (4 : ℕ)), ((outerLabel x jAB = 0 ∧ outerLabel x (jAB + 1) = 1) ∨ + (outerLabel x jAB = 1 ∧ outerLabel x (jAB + 1) = 0)) → ( + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + ((outerLabel x jAB = 0 ∧ o0 = ia ∧ o1 = ib) ∨ (outerLabel x jAB = 1 ∧ o0 = ib ∧ o1 = ia)) + → ((outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + + (2 : Fin (4 : ℕ))) = outerLabel x (jAB + (1 : Fin (4 : ℕ)))) → + (LatticeVertexIncidentCell x (jAB + 2) ∈ T0.cells ∨ LatticeVertexIncidentCell x (jAB + + 2) ∈ T0'.cells))))) ) := by + classical + intro ι owner T0 T0' R ia ib x outerLabel label_side_mem hsectorCover jAB hlabelsAB o0 o1 + hownerAligned' hGood + rcases hownerAligned' with hA | hA + · apply label_side_mem R x hsectorCover (jAB + 2) + rcases hlabelsAB with h | h + · exact Or.inr (hGood.2.trans h.2) + · exact False.elim ((by decide : (1 : Fin 3) ≠ 0) + (h.1.symm.trans hA.1)) + · apply label_side_mem R x hsectorCover (jAB + 2) + rcases hlabelsAB with h | h + · exact False.elim ((by decide : (0 : Fin 3) ≠ 1) + (h.1.symm.trans hA.1)) + · exact Or.inl (hGood.2.trans h.2) + +private theorem hside0At880 : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (x : GaussianInt), ∀ (jAB : Fin (4 : ℕ)), + (LatticeVertexIncidentCell x jAB ∈ T0.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : + Fin (4 : ℕ))) ∈ T0'.cells ∨ LatticeVertexIncidentCell x jAB ∈ T0'.cells ∧ + LatticeVertexIncidentCell x (jAB + (1 : Fin (4 : ℕ))) ∈ T0.cells) → + (LatticeVertexIncidentCell x jAB ∈ T0.cells ∨ LatticeVertexIncidentCell x jAB ∈ + T0'.cells) ) := by + classical + intro T0 T0' x jAB htransABx + rcases htransABx with h | h + · exact Or.inl h.1 + · exact Or.inr h.1 + +private theorem hside1At885 : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (x : GaussianInt), ∀ (jAB : Fin (4 : ℕ)), + (LatticeVertexIncidentCell x jAB ∈ T0.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : + Fin (4 : ℕ))) ∈ T0'.cells ∨ LatticeVertexIncidentCell x jAB ∈ T0'.cells ∧ + LatticeVertexIncidentCell x (jAB + (1 : Fin (4 : ℕ))) ∈ T0.cells) → + (LatticeVertexIncidentCell x (jAB + 1) ∈ T0.cells ∨ LatticeVertexIncidentCell x (jAB + + 1) ∈ T0'.cells) ) := by + classical + intro T0 T0' x jAB htransABx + rcases htransABx with h | h + · exact Or.inr h.2 + · exact Or.inl h.2 + +private theorem ho01neAt890 : + (by + classical + exact + ∀ (ι : Type), ∀ (owner : GaussianInt → ι), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (ia + : ι), ∀ (ib : ι), (ia ≠ ib) → (∀ (x : GaussianInt), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (jAB : Fin (4 : ℕ)), + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + ((outerLabel x jAB = 0 ∧ o0 = ia ∧ o1 = ib) ∨ (outerLabel x jAB = 1 ∧ o0 = ib ∧ o1 = ia)) + → (o0 ≠ o1)) ) := by + classical + intro ι owner T0 T0' ia ib hidxne x outerLabel jAB o0 o1 hownerAligned' heq + rcases hownerAligned' with hA | hA + · exact hidxne (hA.2.1.symm.trans (heq.trans hA.2.2)) + · exact hidxne (hA.2.1.symm.trans (heq.trans hA.2.2)).symm + +private theorem ho02neAt895 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (owner : GaussianInt → ι), ∀ (T0 : + ProtoTile), ∀ (T0' : ProtoTile), ∀ (R : ProtoTile), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), ∀ (ia : ι), ∀ (ib : ι), (P.tile ia = U) → ((P.tile ib = V) → ((U.cells ⊆ + T0.cells) → ((V.cells ⊆ T0'.cells) → (∀ (x : GaussianInt), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + (∀ (R : ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ + T0.cells ∨ LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j + ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 0) → (LatticeVertexIncidentCell x j ∈ + T0.cells))) → ((∀ (R : ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T0.cells ∨ LatticeVertexIncidentCell x j ∈ T0'.cells + ∨ LatticeVertexIncidentCell x j ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 1) → + (LatticeVertexIncidentCell x j ∈ T0'.cells))) → ((∀ (c : GaussianInt), ∀ (a : ι), + ((P.tile a).cells ⊆ T0.cells) → ((c ∈ T0'.cells) → (owner c ≠ a))) → ((∀ (c : + GaussianInt), ∀ (a : ι), ((P.tile a).cells ⊆ T0'.cells) → ((c ∈ T0.cells) → (owner c + ≠ a))) → ((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j ∈ R.cells) + → (∀ (jAB : Fin (4 : ℕ)), ((outerLabel x jAB = 0 ∧ outerLabel x (jAB + 1) = 1) ∨ + (outerLabel x jAB = 1 ∧ outerLabel x (jAB + 1) = 0)) → ( + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + let o2 := owner (LatticeVertexIncidentCell x (jAB + 2)) + ((outerLabel x jAB = 0 ∧ o0 = ia ∧ o1 = ib) ∨ (outerLabel x jAB = 1 ∧ o0 = ib ∧ o1 = ia)) + → ((outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + + (2 : Fin (4 : ℕ))) = outerLabel x (jAB + (1 : Fin (4 : ℕ)))) → (o0 ≠ o2)))))))))))) ) + := by + classical + intro ι P owner T0 T0' R U V ia ib hUidx hVidx hUsub hVsub x outerLabel label_eq_zero_mem + label_eq_one_mem owner_ne_T0_index owner_ne_T0'_index hsectorCover jAB hlabelsAB o0 o1 o2 + hownerAligned' hGood heq + rcases hownerAligned' with hA | hA + · have hUsubidx : (P.tile ia).cells ⊆ T0.cells := by + rw [hUidx] + exact hUsub + have hc2 : LatticeVertexIncidentCell x (jAB + 2) ∈ T0'.cells := by + rcases hlabelsAB with h | h + · exact label_eq_one_mem R x hsectorCover + (jAB + 2) (hGood.2.trans h.2) + · exact False.elim ((by decide : (1 : Fin 3) ≠ 0) + (h.1.symm.trans hA.1)) + exact owner_ne_T0_index (LatticeVertexIncidentCell x (jAB + 2)) + ia hUsubidx hc2 (heq.symm.trans hA.2.1) + · have hVsubidx : (P.tile ib).cells ⊆ T0'.cells := by + rw [hVidx] + exact hVsub + have hc2 : LatticeVertexIncidentCell x (jAB + 2) ∈ T0.cells := by + rcases hlabelsAB with h | h + · exact False.elim ((by decide : (0 : Fin 3) ≠ 1) + (h.1.symm.trans hA.1)) + · exact label_eq_zero_mem R x hsectorCover + (jAB + 2) (hGood.2.trans h.2) + exact owner_ne_T0'_index (LatticeVertexIncidentCell x (jAB + 2)) + ib hVsubidx hc2 (heq.symm.trans hA.2.1) + +private theorem ho03ne : + (by + classical + exact + ∀ (ι : Type), ∀ (owner : GaussianInt → ι), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ + (endpointIndex : ι), ∀ (x : GaussianInt), (∀ (x : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ T0.cells ∨ LatticeVertexIncidentCell x j ∈ + T0'.cells) → (owner (LatticeVertexIncidentCell x j) ≠ endpointIndex)) → (∀ (jAB : Fin + (4 : ℕ)), + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o3 := owner (LatticeVertexIncidentCell x (jAB + 3)) + (o3 = endpointIndex) → ((LatticeVertexIncidentCell x jAB ∈ T0.cells ∨ + LatticeVertexIncidentCell x jAB ∈ T0'.cells) → (o0 ≠ o3))) ) := by + classical + intro ι owner T0 T0' endpointIndex x owner_ne_endpoint jAB o0 o3 ho3 hside0 heq + exact owner_ne_endpoint x jAB hside0 (heq.trans ho3) + +private theorem ho13neAt923 : + (by + classical + exact + ∀ (ι : Type), ∀ (owner : GaussianInt → ι), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ + (endpointIndex : ι), ∀ (x : GaussianInt), (∀ (x : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ T0.cells ∨ LatticeVertexIncidentCell x j ∈ + T0'.cells) → (owner (LatticeVertexIncidentCell x j) ≠ endpointIndex)) → (∀ (jAB : Fin + (4 : ℕ)), + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + let o3 := owner (LatticeVertexIncidentCell x (jAB + 3)) + (o3 = endpointIndex) → ((LatticeVertexIncidentCell x (jAB + 1) ∈ T0.cells ∨ + LatticeVertexIncidentCell x (jAB + 1) ∈ T0'.cells) → (o1 ≠ o3))) ) := by + classical + intro ι owner T0 T0' endpointIndex x owner_ne_endpoint jAB o1 o3 ho3 hside1 heq + exact owner_ne_endpoint x (jAB + 1) hside1 (heq.trans ho3) + +private theorem ho23neAt926 : + (by + classical + exact + ∀ (ι : Type), ∀ (owner : GaussianInt → ι), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ + (endpointIndex : ι), ∀ (x : GaussianInt), (∀ (x : GaussianInt), ∀ (j : Fin 4), + (LatticeVertexIncidentCell x j ∈ T0.cells ∨ LatticeVertexIncidentCell x j ∈ + T0'.cells) → (owner (LatticeVertexIncidentCell x j) ≠ endpointIndex)) → (∀ (jAB : Fin + (4 : ℕ)), + let o2 := owner (LatticeVertexIncidentCell x (jAB + 2)) + let o3 := owner (LatticeVertexIncidentCell x (jAB + 3)) + (o3 = endpointIndex) → ((LatticeVertexIncidentCell x (jAB + 2) ∈ T0.cells ∨ + LatticeVertexIncidentCell x (jAB + 2) ∈ T0'.cells) → (o2 ≠ o3))) ) := by + classical + intro ι owner T0 T0' endpointIndex x owner_ne_endpoint jAB o2 o3 ho3 hcell2side heq + exact owner_ne_endpoint x (jAB + 2) hcell2side + (heq.trans ho3) + +private theorem ho12 : + (by + classical + exact + ∀ (ι : Type), ∀ (owner : GaussianInt → ι), ∀ (x : GaussianInt), ∀ (jAB : Fin (4 : ℕ)), + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + let o2 := owner (LatticeVertexIncidentCell x (jAB + 2)) + let o3 := owner (LatticeVertexIncidentCell x (jAB + 3)) + (o0 = o1 ∨ o0 = o2 ∨ o0 = o3 ∨ o1 = o2 ∨ o1 = o3 ∨ o2 = o3) → ((o0 ≠ o1) → ((o0 ≠ o2) → + ((o0 ≠ o3) → ((o1 ≠ o3) → ((o2 ≠ o3) → (o1 = o2)))))) ) := by + classical + intro ι owner x jAB o0 o1 o2 o3 hownerRepeat ho01ne ho02ne ho03ne ho13ne ho23ne + rcases hownerRepeat with h01 | h02 | h03 | h12 | h13 | h23 + · exact False.elim (ho01ne h01) + · exact False.elim (ho02ne h02) + · exact False.elim (ho03ne h03) + · exact h12 + · exact False.elim (ho13ne h13) + · exact False.elim (ho23ne h23) + +private theorem hdiagAt938 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (owner : GaussianInt → ι), (∀ (c : + GaussianInt), ∀ (a : ι), c ∈ (P.tile a).cells ↔ owner c = a) → (∀ (T0 : ProtoTile), ∀ + (T0' : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (ia : ι), ∀ (ib : ι), + (P.tile ia = U) → ((P.tile ib = V) → (∀ (x : GaussianInt), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (jAB : Fin (4 : ℕ)), + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + let o2 := owner (LatticeVertexIncidentCell x (jAB + 2)) + ((outerLabel x jAB = 0 ∧ o0 = ia ∧ o1 = ib) ∨ (outerLabel x jAB = 1 ∧ o0 = ib ∧ o1 = ia)) + → ((o1 = o2) → ((LatticeVertexIncidentCell x jAB ∈ U.cells ∧ + LatticeVertexIncidentCell x (jAB + 2) ∈ V.cells) ∨ (LatticeVertexIncidentCell x jAB ∈ + V.cells ∧ LatticeVertexIncidentCell x (jAB + 2) ∈ U.cells)))))) ) := by + classical + intro ι P owner owner_mem_iff T0 T0' U V ia ib hUidx hVidx x outerLabel jAB o0 o1 o2 + hownerAligned' ho12 + rcases hownerAligned' with hA | hA + · left + constructor + · have hc := (owner_mem_iff _ ia).2 hA.2.1 + simpa [hUidx] using hc + · have heq : o2 = ib := ho12.symm.trans hA.2.2 + have hc := (owner_mem_iff _ ib).2 heq + simpa [hVidx] using hc + · right + constructor + · have hc := (owner_mem_iff _ ib).2 hA.2.1 + simpa [hVidx] using hc + · have heq : o2 = ia := ho12.symm.trans hA.2.2 + have hc := (owner_mem_iff _ ia).2 heq + simpa [hUidx] using hc + +private theorem hfinalCellsAt958 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (owner : GaussianInt → ι), ∀ (T0 : + ProtoTile), ∀ (T0' : ProtoTile), ∀ (R : ProtoTile), ∀ (U : ProtoTile), ∀ (V : + ProtoTile), ∀ (E : ExactTileInterfaceTriple T0 T0' R), ∀ (endpointIndex : ι), ∀ (ia : + ι), ∀ (ib : ι), ∀ (x : GaussianInt), + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (jEdge : Fin (4 : ℕ)), ∀ (eAB : Finset GaussianInt), ∀ (jAB : Fin (4 : ℕ)), ∀ (jBR : + Fin (4 : ℕ)), ∀ (jRA : Fin (4 : ℕ)), (eAB = edgeAt E.point jAB) → + ((LatticeVertexIncidentCell E.point jAB ∈ T0.cells ∧ LatticeVertexIncidentCell + E.point (jAB + (1 : Fin (4 : ℕ))) ∈ T0'.cells ∨ LatticeVertexIncidentCell E.point jAB + ∈ T0'.cells ∧ LatticeVertexIncidentCell E.point (jAB + (1 : Fin (4 : ℕ))) ∈ T0.cells) + → ((jAB ≠ jBR) → ((jRA ≠ jAB) → ((eAB = edgeAt x jAB) → ((LatticeVertexIncidentCell x + jAB ∈ T0.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : Fin (4 : ℕ))) ∈ T0'.cells ∨ + LatticeVertexIncidentCell x jAB ∈ T0'.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : + Fin (4 : ℕ))) ∈ T0.cells) → ((jAB = jEdge) → ((({outerLabel x jAB, + outerLabel x (jAB + 1)} : Finset (Fin 3)) = {0, 1}) → ((outerLabel x (jAB + (2 : Fin + (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = outerLabel x + jAB ∨ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + + (2 : Fin (4 : ℕ))) = outerLabel x (jAB + (1 : Fin (4 : ℕ))) ∨ outerLabel x (jAB + + (2 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 + : Fin (3 : ℕ)) ∨ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ + outerLabel x jAB = (2 : Fin (3 : ℕ))) → (((LatticeVertexIncidentCell x jAB ∈ (P.tile + ia).cells ∧ LatticeVertexIncidentCell x (jAB + 1) ∈ (P.tile ib).cells) ∨ + (LatticeVertexIncidentCell x jAB ∈ (P.tile ib).cells ∧ LatticeVertexIncidentCell x + (jAB + 1) ∈ (P.tile ia).cells)) → (((owner (LatticeVertexIncidentCell x jAB) = ia ∧ + owner (LatticeVertexIncidentCell x (jAB + 1)) = ib) ∨ (owner + (LatticeVertexIncidentCell x jAB) = ib ∧ owner (LatticeVertexIncidentCell x (jAB + + 1)) = ia)) → (((outerLabel x jAB = 0 ∧ owner (LatticeVertexIncidentCell x jAB) = ia ∧ + owner (LatticeVertexIncidentCell x (jAB + 1)) = ib) ∨ (outerLabel x jAB = 1 ∧ owner + (LatticeVertexIncidentCell x jAB) = ib ∧ owner (LatticeVertexIncidentCell x (jAB + + 1)) = ia)) → (((outerLabel x jAB = 0 ∧ outerLabel x (jAB + 1) = 1) ∨ (outerLabel x + jAB = 1 ∧ outerLabel x (jAB + 1) = 0)) → ( + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + let o2 := owner (LatticeVertexIncidentCell x (jAB + 2)) + let o3 := owner (LatticeVertexIncidentCell x (jAB + 3)) + ((outerLabel x jAB = 0 ∧ o0 = ia ∧ o1 = ib) ∨ (outerLabel x jAB = 1 ∧ o0 = ib ∧ o1 = ia)) + → ((o0 = o1 ∨ o0 = o2 ∨ o0 = o3 ∨ o1 = o2 ∨ o1 = o3 ∨ o2 = o3) → ((outerLabel x (jAB + + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (2 : Fin (4 : ℕ))) = + outerLabel x (jAB + (1 : Fin (4 : ℕ)))) → ((LatticeVertexIncidentCell x (jAB + 3) ∈ + R.cells) → ((o3 = endpointIndex) → ((LatticeVertexIncidentCell x (jAB + 2) ∈ T0.cells + ∨ LatticeVertexIncidentCell x (jAB + 2) ∈ T0'.cells) → ((LatticeVertexIncidentCell x + jAB ∈ T0.cells ∨ LatticeVertexIncidentCell x jAB ∈ T0'.cells) → + ((LatticeVertexIncidentCell x (jAB + 1) ∈ T0.cells ∨ LatticeVertexIncidentCell x (jAB + + 1) ∈ T0'.cells) → ((o0 ≠ o1) → ((o0 ≠ o2) → ((o0 ≠ o3) → ((o1 ≠ o3) → ((o2 ≠ o3) → + ((o1 = o2) → (((LatticeVertexIncidentCell x jAB ∈ U.cells ∧ LatticeVertexIncidentCell + x (jAB + 2) ∈ V.cells) ∨ (LatticeVertexIncidentCell x jAB ∈ V.cells ∧ + LatticeVertexIncidentCell x (jAB + 2) ∈ U.cells)) → ((x ∈ U.cells ∧ x - 1 - ⟨0, 1⟩ ∈ + V.cells) ∨ (x ∈ V.cells ∧ x - 1 - ⟨0, 1⟩ ∈ U.cells) ∨ (x - 1 ∈ U.cells ∧ x - ⟨0, 1⟩ ∈ + V.cells) ∨ (x - 1 ∈ V.cells ∧ x - ⟨0, 1⟩ ∈ U.cells))))))))))))))))))))))))))))) ) := by + classical + intro ι P owner T0 T0' R U V E endpointIndex ia ib x edgeAt outerLabel jEdge eAB jAB jBR jRA + hABat htransAB hjABBR hjRAAB hABatx htransABx hjABEdge hlabelAB hlabelPattern hsectorAB + hownerAB hownerAligned hlabelsAB o0 o1 o2 o3 hownerAligned' hownerRepeat hGood hcell3 ho3 + hcell2side hside0 hside1 ho01ne ho02ne ho03ne ho13ne ho23ne ho12 hdiag + rcases hdiag with hdiag | hdiag + · fin_cases jAB + · exact Or.inl (by simpa [LatticeVertexIncidentCell] using hdiag) + · exact Or.inr (Or.inr (Or.inl + (by simpa [LatticeVertexIncidentCell] using hdiag))) + · exact Or.inr (Or.inl + (by simpa [LatticeVertexIncidentCell] using + ⟨hdiag.2, hdiag.1⟩)) + · exact Or.inr (Or.inr (Or.inr + (by simpa [LatticeVertexIncidentCell] using + ⟨hdiag.2, hdiag.1⟩))) + · fin_cases jAB + · exact Or.inr (Or.inl + (by simpa [LatticeVertexIncidentCell] using hdiag)) + · exact Or.inr (Or.inr (Or.inr + (by simpa [LatticeVertexIncidentCell] using hdiag))) + · exact Or.inl + (by simpa [LatticeVertexIncidentCell] using + ⟨hdiag.2, hdiag.1⟩) + · exact Or.inr (Or.inr (Or.inl + (by simpa [LatticeVertexIncidentCell] using + ⟨hdiag.2, hdiag.1⟩))) + +end EndpointDiagonalGeometry + +theorem P5635T1EndpointDiagonalOwnership {ι : Type} + (P : PeriodicTileComplex ι) (owner : GaussianInt → ι) + (owner_mem_iff : ∀ (c : GaussianInt) (a : ι), + c ∈ (P.tile a).cells ↔ owner c = a) + (owner_no_fourfold : ∀ x : GaussianInt, + owner (LatticeVertexIncidentCell x 0) = + owner (LatticeVertexIncidentCell x 1) ∨ + owner (LatticeVertexIncidentCell x 0) = + owner (LatticeVertexIncidentCell x 2) ∨ + owner (LatticeVertexIncidentCell x 0) = + owner (LatticeVertexIncidentCell x 3) ∨ + owner (LatticeVertexIncidentCell x 1) = + owner (LatticeVertexIncidentCell x 2) ∨ + owner (LatticeVertexIncidentCell x 1) = + owner (LatticeVertexIncidentCell x 3) ∨ + owner (LatticeVertexIncidentCell x 2) = + owner (LatticeVertexIncidentCell x 3)) + (T0 T0' R U V : ProtoTile) + (E : ExactTileInterfaceTriple T0 T0' R) + (hT : LatticeTile T0) (hT' : LatticeTile T0') (hR : LatticeTile R) + (hdis : Disjoint T0.cells T0'.cells) + (hTm : Disjoint T0.cells R.cells) (hT'm : Disjoint T0'.cells R.cells) + (hreg : ∀ x, x ∈ FootprintVertices T0 → ∀ y, y ∈ FootprintVertices T0 → + FourNeighborAdjacent x y → {x, y} ∈ FootprintEdges T0) + (hreg' : ∀ x, x ∈ FootprintVertices T0' → ∀ y, y ∈ FootprintVertices T0' → + FourNeighborAdjacent x y → {x, y} ∈ FootprintEdges T0') + (endpointIndex ia ib : ι) + (hRidx : P.tile endpointIndex = R) + (hUidx : P.tile ia = U) (hVidx : P.tile ib = V) + (hidxne : ia ≠ ib) + (hUsub : U.cells ⊆ T0.cells) (hVsub : V.cells ⊆ T0'.cells) + (x y : GaussianInt) (hstart : x = E.point) + (hstar : ∀ z, z = x ∨ z = x + 1 ∨ z = x - 1 ∨ + z = x + ⟨0, 1⟩ ∨ z = x - ⟨0, 1⟩ → + z ∈ FootprintVertices T0 ∨ z ∈ FootprintVertices T0') + (hedgeUV : {x, y} ∈ FootprintEdges U ∩ FootprintEdges V) + (hEndpointEdge : ∀ e, x ∈ e → + e ∈ FootprintEdges T0 ∩ FootprintEdges T0' → e = {x, y}) : + (x ∈ U.cells ∧ x - 1 - ⟨0, 1⟩ ∈ V.cells) ∨ + (x ∈ V.cells ∧ x - 1 - ⟨0, 1⟩ ∈ U.cells) ∨ + (x - 1 ∈ U.cells ∧ x - ⟨0, 1⟩ ∈ V.cells) ∨ + (x - 1 ∈ V.cells ∧ x - ⟨0, 1⟩ ∈ U.cells) := by +-- BODY + classical + have triple_label_pattern := EndpointDiagonalGeometry.triple_label_pattern + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + have edgeAt_mem := EndpointDiagonalGeometry.edgeAt_mem + have edgeAt_injective (x : GaussianInt) {j k : Fin 4} + (h : edgeAt x j = edgeAt x k) := EndpointDiagonalGeometry.edgeAt_injective + (EndpointDiagonalGeometry.neighbor_ne_center) + (EndpointDiagonalGeometry.neighbor_injective) edgeAt_mem x (j := j) (k := k) h + have endpoint_repeat_impossible := EndpointDiagonalGeometry.endpoint_repeat_impossible T0 T0' + (EndpointDiagonalGeometry.edge_foreign_impossible edgeAt_mem edgeAt_injective + (EndpointDiagonalGeometry.edge_of_sector_pair)) (EndpointDiagonalGeometry.star_induced_edge + T0 T0' hreg hreg' (EndpointDiagonalGeometry.edgeAt_eq_pair) + (EndpointDiagonalGeometry.neighbor_in_star) (EndpointDiagonalGeometry.neighbor_four_adjacent)) + have triple_transitions := EndpointDiagonalGeometry.triple_transitions T0 T0' hT hT' hdis + (EndpointDiagonalGeometry.exact_point_boundary) (EndpointDiagonalGeometry.touching_path) + (EndpointDiagonalGeometry.transition_indices_ne) + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + have label_T0 := EndpointDiagonalGeometry.label_T0 T0 T0' + have label_T0' := EndpointDiagonalGeometry.label_T0' T0 T0' hdis + have label_R := EndpointDiagonalGeometry.label_R T0 T0' + have label_mem := EndpointDiagonalGeometry.label_mem T0 T0' label_T0 label_T0' + have label_eq_two_mem := EndpointDiagonalGeometry.label_eq_two_mem T0 T0' label_mem + have label_eq_zero_mem := EndpointDiagonalGeometry.label_eq_zero_mem T0 T0' label_mem + have label_eq_one_mem := EndpointDiagonalGeometry.label_eq_one_mem T0 T0' label_mem + have label_side_mem := EndpointDiagonalGeometry.label_side_mem T0 T0' label_mem + have htriple := ExactTileInterfaceTripleLatticeTouching + T0 T0' R E hT hT' hR hdis hT'm hTm.symm + have owner_unique (c : GaussianInt) (a : ι) + (hc : c ∈ (P.tile a).cells) : owner c = a := + (owner_mem_iff c a).mp hc + have owner_eq_endpoint (x : GaussianInt) (j : Fin 4) + (hc : LatticeVertexIncidentCell x j ∈ R.cells) : + owner (LatticeVertexIncidentCell x j) = endpointIndex := + EndpointDiagonalGeometry.owner_eq_endpoint ι P owner R endpointIndex hRidx owner_unique + x j hc + have owner_repeat_at := EndpointDiagonalGeometry.owner_repeat_at ι owner owner_no_fourfold + have owner_ne_T0_index := EndpointDiagonalGeometry.owner_ne_T0_index ι P owner owner_mem_iff T0 + T0' hdis + have owner_ne_T0'_index := EndpointDiagonalGeometry.owner_ne_T0'_index ι P owner owner_mem_iff + T0 T0' hdis + have owner_ne_endpoint := EndpointDiagonalGeometry.owner_ne_endpoint ι P owner owner_mem_iff T0 + T0' R hTm hT'm endpointIndex hRidx + have hxTriple : x ∈ FootprintVertices T0 ∩ FootprintVertices T0' ∩ + FootprintVertices R := (E.unique_common x).2 hstart + have hsectorCover := (EndpointDiagonalGeometry.triple_sector_cover T0 T0' hT hT') R hR htriple + x hxTriple + have hdisUV : Disjoint U.cells V.cells := EndpointDiagonalGeometry.hdisUV T0 T0' U V hdis hUsub + hVsub + obtain ⟨jEdge, hedgeAt, htransition⟩ := P3102T2CommonEdgeSectorTransition + U V x {x, y} hdisUV (by simp) hedgeUV + have hsectorEdge := EndpointDiagonalGeometry.hsectorEdge ι P U V ia ib hUidx hVidx x jEdge + htransition + rcases triple_transitions R E hR hTm hT'm htriple with + ⟨eAB, eBR, eRA, jAB, jBR, jRA, hxeAB, heAB, hABat, + hxeBR, heBR, hBRat, hxeRA, heRA, hRAat, + htransAB, htransBR, htransRA, hjABBR, hjBRRA, hjRAAB⟩ + have hxeABx : x ∈ eAB := by simpa [hstart] using hxeAB + have hABedge_eq : eAB = {x, y} := hEndpointEdge eAB hxeABx heAB + have hABatx : eAB = edgeAt x jAB := by + simpa [hstart] using hABat + have htransABx := htransAB + rw [← hstart] at htransABx + have htransBRx := htransBR + rw [← hstart] at htransBRx + have htransRAx := htransRA + rw [← hstart] at htransRAx + have hedgeAtx : ({x, y} : Finset GaussianInt) = edgeAt x jEdge := by + simpa [edgeAt] using hedgeAt + have hjABEdge := EndpointDiagonalGeometry.hjABEdge x y edgeAt_injective jEdge eAB jAB + hABedge_eq hABatx hedgeAtx + have hlabelAB := EndpointDiagonalGeometry.hlabelAB T0 T0' x label_T0 label_T0' jAB htransABx + have hlabelPattern := triple_label_pattern (fun j => outerLabel x j) + jAB jBR jRA + hjABBR hjBRRA hjRAAB hlabelAB (EndpointDiagonalGeometry.hlabelBR T0 T0' R hTm hT'm x + label_T0' label_R jBR htransBRx) (EndpointDiagonalGeometry.hlabelRA T0 T0' R hTm hT'm x + label_T0 label_R jRA htransRAx) + have hlabelGood := EndpointDiagonalGeometry.hlabelGood T0 T0' R E hTm hT'm x hstar + endpoint_repeat_impossible label_eq_two_mem hxTriple hsectorCover jEdge eAB jAB jBR jRA + hABat htransAB hjABBR hjRAAB hABatx htransABx hjABEdge hlabelAB hlabelPattern + have hsectorAB := EndpointDiagonalGeometry.hsectorAB ι P ia ib x jEdge hsectorEdge jAB hjABEdge + have hownerAB := EndpointDiagonalGeometry.hownerAB ι P owner U V ia ib hUidx hVidx x + owner_unique jAB hsectorAB + have hownerAligned := EndpointDiagonalGeometry.hownerAligned ι P owner owner_mem_iff T0 T0' U V + hdis ia ib hUidx hVidx hUsub hVsub x label_T0 label_T0' jAB htransABx hownerAB + have hlabelsAB := EndpointDiagonalGeometry.hlabelsAB T0 T0' x label_T0 label_T0' jAB htransABx + let o0 := owner (LatticeVertexIncidentCell x jAB) + let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) + let o2 := owner (LatticeVertexIncidentCell x (jAB + 2)) + let o3 := owner (LatticeVertexIncidentCell x (jAB + 3)) + have hownerAligned' := EndpointDiagonalGeometry.hownerAligned' ι owner T0 T0' ia ib x jAB + hownerAligned + have hownerRepeat := EndpointDiagonalGeometry.hownerRepeat ι owner x owner_repeat_at jAB + rcases hlabelGood with hGood | hGood + · have hcell2 : LatticeVertexIncidentCell x (jAB + 2) ∈ R.cells := + label_eq_two_mem R x hsectorCover (jAB + 2) hGood.1 + have ho2 : o2 = endpointIndex := by + simpa [o2] using owner_eq_endpoint x (jAB + 2) hcell2 + have hcell3side := EndpointDiagonalGeometry.hcell3side ι owner T0 T0' R ia ib x + label_side_mem hsectorCover jAB hownerAligned' hGood + have hside0 := EndpointDiagonalGeometry.hside0At763 T0 T0' x jAB htransABx + have hside1 := EndpointDiagonalGeometry.hside1At768 T0 T0' x jAB htransABx + have ho01ne := EndpointDiagonalGeometry.ho01neAt773 ι owner T0 T0' ia ib hidxne x jAB + hownerAligned' + have ho02ne := EndpointDiagonalGeometry.ho02neAt778 ι owner T0 T0' endpointIndex x + owner_ne_endpoint jAB ho2 hside0 + have ho12ne := EndpointDiagonalGeometry.ho12ne ι owner T0 T0' endpointIndex x + owner_ne_endpoint jAB ho2 hside1 + have ho13ne := EndpointDiagonalGeometry.ho13neAt784 ι P owner T0 T0' R U V ia ib hUidx hVidx + hUsub hVsub x label_eq_zero_mem label_eq_one_mem owner_ne_T0_index owner_ne_T0'_index + hsectorCover jAB hownerAligned' hGood + have ho23ne := EndpointDiagonalGeometry.ho23neAt801 ι owner T0 T0' endpointIndex x + owner_ne_endpoint jAB ho2 hcell3side + have ho03 := EndpointDiagonalGeometry.ho03 ι owner x jAB hownerRepeat ho01ne ho02ne ho12ne + ho13ne ho23ne + have hdiag := EndpointDiagonalGeometry.hdiagAt813 ι P owner owner_mem_iff T0 T0' U V ia ib + hUidx hVidx x jAB hownerAligned' ho03 + have hfinalCells := EndpointDiagonalGeometry.hfinalCellsAt833 ι P owner T0 T0' R U V E + endpointIndex ia ib x jEdge eAB jAB jBR jRA hABat htransAB hjABBR hjRAAB hABatx htransABx + hjABEdge hlabelAB hlabelPattern hsectorAB hownerAB hownerAligned hlabelsAB hownerAligned' + hownerRepeat hGood hcell2 ho2 hcell3side hside0 hside1 ho01ne ho02ne ho12ne ho13ne ho23ne + ho03 hdiag + exact hfinalCells + · have hcell3 : LatticeVertexIncidentCell x (jAB + 3) ∈ R.cells := + label_eq_two_mem R x hsectorCover (jAB + 3) hGood.1 + have ho3 : o3 = endpointIndex := by + simpa [o3] using owner_eq_endpoint x (jAB + 3) hcell3 + have hcell2side := EndpointDiagonalGeometry.hcell2side ι owner T0 T0' R ia ib x + label_side_mem hsectorCover jAB hlabelsAB hownerAligned' hGood + have hside0 := EndpointDiagonalGeometry.hside0At880 T0 T0' x jAB htransABx + have hside1 := EndpointDiagonalGeometry.hside1At885 T0 T0' x jAB htransABx + have ho01ne := EndpointDiagonalGeometry.ho01neAt890 ι owner T0 T0' ia ib hidxne x jAB + hownerAligned' + have ho02ne := EndpointDiagonalGeometry.ho02neAt895 ι P owner T0 T0' R U V ia ib hUidx hVidx + hUsub hVsub x label_eq_zero_mem label_eq_one_mem owner_ne_T0_index owner_ne_T0'_index + hsectorCover jAB hlabelsAB hownerAligned' hGood + have ho03ne := EndpointDiagonalGeometry.ho03ne ι owner T0 T0' endpointIndex x + owner_ne_endpoint jAB ho3 hside0 + have ho13ne := EndpointDiagonalGeometry.ho13neAt923 ι owner T0 T0' endpointIndex x + owner_ne_endpoint jAB ho3 hside1 + have ho23ne := EndpointDiagonalGeometry.ho23neAt926 ι owner T0 T0' endpointIndex x + owner_ne_endpoint jAB ho3 hcell2side + have ho12 := EndpointDiagonalGeometry.ho12 ι owner x jAB hownerRepeat ho01ne ho02ne ho03ne + ho13ne ho23ne + have hdiag := EndpointDiagonalGeometry.hdiagAt938 ι P owner owner_mem_iff T0 T0' U V ia ib + hUidx hVidx x jAB hownerAligned' ho12 + have hfinalCells := EndpointDiagonalGeometry.hfinalCellsAt958 ι P owner T0 T0' R U V E + endpointIndex ia ib x jEdge eAB jAB jBR jRA hABat htransAB hjABBR hjRAAB hABatx htransABx + hjABEdge hlabelAB hlabelPattern hsectorAB hownerAB hownerAligned hlabelsAB hownerAligned' + hownerRepeat hGood hcell3 ho3 hcell2side hside0 hside1 ho01ne ho02ne ho03ne ho13ne ho23ne + ho12 hdiag + exact hfinalCells + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5635T1RightBoundaryInterfaceRecords.lean b/LeanPool/ApollonianSuperharmonic/P5635T1RightBoundaryInterfaceRecords.lean new file mode 100644 index 0000000000..e969b142fb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5635T1RightBoundaryInterfaceRecords.lean @@ -0,0 +1,1139 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightPlacement +public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentRightEndpoint +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.P3045T1RightBoundaryDisplacementAlgebra +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: P5635T1RightBoundaryInterfaceRecords] + +/-! +# P5635T1RightBoundaryInterfaceRecords + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RightBoundaryRecordsGeometry + +private theorem translatedPieceCentroid : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + ∀ (i : Fin 3), ∀ (s : Bool), ∀ (d : GaussianInt), ∀ (z : GaussianInt), ((if s then (1 - + (⟨0, 1⟩ : GaussianInt)) else + -((1 - (⟨0, 1⟩ : GaussianInt)))) * + BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + + 2 * d = z) → (TileCentroid (TileTranslation (placement.layout.P i s) d) - + TileCentroid F = (1 / 2 : Real) • GaussianRealPoint z) ) := by + classical + intro C D T N h k x bundle placement q F i s d z hdisp + let I : GaussianInt := ⟨0, 1⟩ + let edge := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + have hcent := (placement.layout.outer_occurrence i s).2.2 + have hcent' : TileCentroid (placement.layout.P i s) - TileCentroid F = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint edge - + (-(GaussianRealPoint edge).2, (GaussianRealPoint edge).1))) := by + simpa [edge, F, q] using hcent + have gpEdge (x : GaussianInt) : + GaussianRealPoint x - (-(GaussianRealPoint x).2, (GaussianRealPoint x).1) = + GaussianRealPoint ((1 - I) * x) := by + rcases x with ⟨a, b⟩ + apply Prod.ext <;> simp [GaussianRealPoint, I]; ring + have gpEdgeNeg (x : GaussianInt) : + -(GaussianRealPoint x - (-(GaussianRealPoint x).2, (GaussianRealPoint x).1)) = + GaussianRealPoint (-((1 - I) * x)) := by + rw [gpEdge] + rcases x with ⟨a, b⟩ + apply Prod.ext <;> simp [GaussianRealPoint, I] + have gpAdd (x y : GaussianInt) : + GaussianRealPoint (x + y) = GaussianRealPoint x + GaussianRealPoint y := by + rcases x with ⟨a, b⟩ + rcases y with ⟨c, e⟩ + apply Prod.ext <;> simp [GaussianRealPoint] + have gpTwo (x : GaussianInt) : + GaussianRealPoint ((2 : GaussianInt) * x) = + (2 : Real) • GaussianRealPoint x := by + rcases x with ⟨a, b⟩ + apply Prod.ext <;> simp [GaussianRealPoint] + have negHalf (p : Real × Real) : + (-1 : Real) • ((1 / 2 : Real) • p) = (1 / 2 : Real) • (-p) := by + apply Prod.ext <;> simp [smul_eq_mul] + have hmul (x : GaussianInt) : I * x - x = -x + x * I := by ring + have hleft (x : GaussianInt) : -((1 - I) * x) = I * x - x := by ring + have hright (x : GaussianInt) : -(1 - I) * x = -x + x * I := by ring + have hassoc : TileCentroid (placement.layout.P i s) + GaussianRealPoint d - + TileCentroid F = + (TileCentroid (placement.layout.P i s) - TileCentroid F) + + GaussianRealPoint d := by + apply Prod.ext <;> simp <;> ring + rw [(TileTranslationFormulas (placement.layout.P i s) d).2.2.2.2.1] + change TileCentroid (placement.layout.P i s) + GaussianRealPoint d - + TileCentroid F = _ + rw [hassoc, hcent'] + have hdisp' : (if s then (1 - I) else -(1 - I)) * edge + 2 * d = z := by + simpa [edge, I] using hdisp + rw [← hdisp'] + cases s + · simp only [Bool.false_eq_true, ite_false] at hcent ⊢ + rw [negHalf] + rw [gpEdgeNeg] + rw [gpAdd, gpTwo] + rw [hleft, hright, hmul] + apply Prod.ext <;> simp [smul_eq_mul] + · simp only [ite_true] at hcent ⊢ + rw [gpEdge] + rw [gpAdd, gpTwo] + apply Prod.ext <;> simp + +private theorem rNext : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), placement.rightFirstSlot + 1 = placement.rightSecondSlot ) + := by + classical + intro C D T N h k x bundle placement + rcases placement.right_slots_cyclic with ⟨hr, ht, hk⟩ | ⟨hr, ht, hk⟩ | + ⟨hr, ht, hk⟩ <;> simp [hr, ht] + +private theorem rPrev : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), placement.rightFirstSlot + 2 = placement.rightDirectionSlot + ) := by + classical + intro C D T N h k x bundle placement + rcases placement.right_slots_cyclic with ⟨hr, ht, hk⟩ | ⟨hr, ht, hk⟩ | + ⟨hr, ht, hk⟩ <;> simp [hr, hk] + +private theorem tNext : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), placement.rightSecondSlot + 1 = placement.rightDirectionSlot + ) := by + classical + intro C D T N h k x bundle placement + rcases placement.right_slots_cyclic with ⟨hr, ht, hk⟩ | ⟨hr, ht, hk⟩ | + ⟨hr, ht, hk⟩ <;> simp [ht, hk] + +private theorem tPrev : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), placement.rightSecondSlot + 2 = placement.rightFirstSlot ) + := by + classical + intro C D T N h k x bundle placement + rcases placement.right_slots_cyclic with ⟨hr, ht, hk⟩ | ⟨hr, ht, hk⟩ | + ⟨hr, ht, hk⟩ <;> simp [ht, hr] + +private theorem cyclicVectorRecurrence : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (fixedFunction : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h fixedFunction x), + let q := bundle.normalizedPresentation + ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), ((i = 0 ∧ j = 1 ∧ k = 2) ∨ + (i = 1 ∧ j = 2 ∧ k = 0) ∨ (i = 2 ∧ j = 0 ∧ k = 1)) → (BandVectors.1 (q k.succ) (q + j.succ) + BandVectors.1 (q i.succ) (q k.succ) + BandVectors.1 (q j.succ) (q + i.succ) = 0 ∧ BandVectors.1 (q i.succ) (q 0) = BandVectors.1 (q i.succ) (q + k.succ) - (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q i.succ) ∧ + BandVectors.1 (q j.succ) (q 0) = BandVectors.1 (q j.succ) (q i.succ) - (⟨0, 1⟩ : + GaussianInt) * BandVectors.1 (q k.succ) (q j.succ) ∧ BandVectors.1 (q k.succ) (q + 0) = BandVectors.1 (q k.succ) (q j.succ) - (⟨0, 1⟩ : GaussianInt) * BandVectors.1 + (q i.succ) (q k.succ)) ) := by + classical + intro C D T N h fixedFunction x bundle q i j k hcyc + let cfg := bundle.configuration + let qs : Fin 4 → CircleCoordinates := ![q 0, q i.succ, q j.succ, q k.succ] + have hqs : SemiProperQuadruple qs := by + rcases hcyc with ⟨rfl, rfl, rfl⟩ | ⟨rfl, rfl, rfl⟩ | + ⟨rfl, rfl, rfl⟩ + · change SemiProperQuadruple ![q 0, q 1, q 2, q 3] + convert cfg.proper.1 using 1; funext x; fin_cases x <;> rfl + · change SemiProperQuadruple ![q 0, q 2, q 3, q 1] + convert SemiProperQuadruple.rotate cfg.proper.1 using 1; + · change SemiProperQuadruple ![q 0, q 3, q 1, q 2] + convert SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate cfg.proper.1) using 1; + funext x; fin_cases x <;> rfl + let qs1 : Fin 4 → CircleCoordinates := ![qs 0, qs 2, qs 3, qs 1] + let qs2 : Fin 4 → CircleCoordinates := ![qs 0, qs1 2, qs1 3, qs1 1] + have hqs1 : SemiProperQuadruple qs1 := by + simpa [qs1] using SemiProperQuadruple.rotate hqs + have hqs2 : SemiProperQuadruple qs2 := by + simpa [qs2, qs1] using SemiProperQuadruple.rotate hqs1 + have laws0 := VectorRecursionLaws qs hqs + have laws1 := VectorRecursionLaws qs1 hqs1 + have laws2 := VectorRecursionLaws qs2 hqs2 + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa [qs, add_comm, add_left_comm, add_assoc] using laws0.1 + · simpa [qs] using laws0.2.2.1 + · simpa [qs1, qs] using laws1.2.2.1 + · simpa [qs2, qs1, qs] using laws2.2.2.1 + +private theorem aux1Alg : + (by + classical + exact + ((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) = -1) → (((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) = -⟨0, + 1⟩) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), (a + b + c = 0) + → ((1 - (⟨0, 1⟩ : GaussianInt)) * b + 2 * (-(⟨0, 1⟩ : GaussianInt) * c) = (⟨0, 1⟩ : + GaussianInt) ^ (3 : Nat) * ((c - (⟨0, 1⟩ : GaussianInt) * a) - (⟨0, 1⟩ : GaussianInt) + * (c - (⟨0, 1⟩ : GaussianInt) * a))))) ) := by + classical + intro hI2 hI3 a b c hs + rw [hI3] + linear_combination (1 - (⟨0, 1⟩ : GaussianInt)) * hs + + a * hI3 - a * hI2 - c * hI2 + +private theorem aux2Alg : + (by + classical + exact + ((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) = -1) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ + (c : GaussianInt), (a + b + c = 0) → (-(1 - (⟨0, 1⟩ : GaussianInt)) * a + 2 * (-c) = + (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * ((⟨0, 1⟩ : GaussianInt) * (b - (⟨0, 1⟩ : + GaussianInt) * c) - (b - (⟨0, 1⟩ : GaussianInt) * c)))) ) := by + classical + intro hI2 a b c hs + rw [hI2] + linear_combination ((⟨0, 1⟩ : GaussianInt) - 1) * hs - c * hI2 + +private theorem aux3Alg : + (by + classical + exact + ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) = ⟨0, 1⟩) → (∀ (a : GaussianInt), ∀ (b : + GaussianInt), ∀ (c : GaussianInt), (a + b + c = 0) → (-(1 - (⟨0, 1⟩ : GaussianInt)) * + b + 2 * ((⟨0, 1⟩ : GaussianInt) * c) = (⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * ((c - + (⟨0, 1⟩ : GaussianInt) * a) - (⟨0, 1⟩ : GaussianInt) * (c - (⟨0, 1⟩ : GaussianInt) * + a)))) ) := by + classical + intro hI1 a b c hs + rw [hI1] + have hI2' : (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) = -1 := by decide +kernel + have hI3' : (⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) = -⟨0, 1⟩ := by decide +kernel + linear_combination ((⟨0, 1⟩ : GaussianInt) - 1) * hs + + a * hI2' - a * hI3' + c * hI2' + +private theorem aux4Alg : + (by + classical + exact + ((⟨0, 1⟩ : GaussianInt) ^ (0 : Nat) = 1) → (((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) = -1) → + (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), (a + b + c = 0) → ((1 + - (⟨0, 1⟩ : GaussianInt)) * a + 2 * c = (⟨0, 1⟩ : GaussianInt) ^ (0 : Nat) * ((⟨0, 1⟩ + : GaussianInt) * (b - (⟨0, 1⟩ : GaussianInt) * c) - (b - (⟨0, 1⟩ : GaussianInt) * + c))))) ) := by + classical + intro hI0 hI2 a b c hs + rw [hI0] + linear_combination (1 - (⟨0, 1⟩ : GaussianInt)) * hs + c * hI2 + +private theorem auxiliaryDisplacements : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (fixedFunction : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h fixedFunction x), + let q := bundle.normalizedPresentation + (∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q j.succ) = (⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 + (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ)))) → ((∀ (i : Fin 3), ∀ (j : Fin 3), ∀ + (k : Fin 3), ((i = 0 ∧ j = 1 ∧ k = 2) ∨ (i = 1 ∧ j = 2 ∧ k = 0) ∨ (i = 2 ∧ j = 0 ∧ k + = 1)) → (BandVectors.1 (q k.succ) (q j.succ) + BandVectors.1 (q i.succ) (q k.succ) + + BandVectors.1 (q j.succ) (q i.succ) = 0 ∧ BandVectors.1 (q i.succ) (q 0) = + BandVectors.1 (q i.succ) (q k.succ) - (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q + j.succ) (q i.succ) ∧ BandVectors.1 (q j.succ) (q 0) = BandVectors.1 (q j.succ) (q + i.succ) - (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q k.succ) (q j.succ) ∧ + BandVectors.1 (q k.succ) (q 0) = BandVectors.1 (q k.succ) (q j.succ) - (⟨0, 1⟩ : + GaussianInt) * BandVectors.1 (q i.succ) (q k.succ))) → (((⟨0, 1⟩ : GaussianInt) ^ (1 + : Nat) = ⟨0, 1⟩) → (((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) = -1) → (((⟨0, 1⟩ : + GaussianInt) ^ (3 : Nat) = -⟨0, 1⟩) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ + (c : GaussianInt), (a + b + c = 0) → ((1 - (⟨0, 1⟩ : GaussianInt)) * b + 2 * (-(⟨0, + 1⟩ : GaussianInt) * c) = (⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * ((c - (⟨0, 1⟩ : + GaussianInt) * a) - (⟨0, 1⟩ : GaussianInt) * (c - (⟨0, 1⟩ : GaussianInt) * a)))) → + ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), (a + b + c = 0) → + (-(1 - (⟨0, 1⟩ : GaussianInt)) * a + 2 * (-c) = (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + ((⟨0, 1⟩ : GaussianInt) * (b - (⟨0, 1⟩ : GaussianInt) * c) - (b - (⟨0, 1⟩ : + GaussianInt) * c)))) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : + GaussianInt), (a + b + c = 0) → (-(1 - (⟨0, 1⟩ : GaussianInt)) * b + 2 * ((⟨0, 1⟩ : + GaussianInt) * c) = (⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * ((c - (⟨0, 1⟩ : GaussianInt) + * a) - (⟨0, 1⟩ : GaussianInt) * (c - (⟨0, 1⟩ : GaussianInt) * a)))) → ((∀ (a : + GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), (a + b + c = 0) → ((1 - (⟨0, + 1⟩ : GaussianInt)) * a + 2 * c = (⟨0, 1⟩ : GaussianInt) ^ (0 : Nat) * ((⟨0, 1⟩ : + GaussianInt) * (b - (⟨0, 1⟩ : GaussianInt) * c) - (b - (⟨0, 1⟩ : GaussianInt) * c)))) + → (∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), ((i = 0 ∧ j = 1 ∧ k = 2) ∨ + (i = 1 ∧ j = 2 ∧ k = 0) ∨ (i = 2 ∧ j = 0 ∧ k = 1)) → (((1 - (⟨0, 1⟩ : GaussianInt)) * + BandVectors.1 (q ((j + 2).succ)) (q ((j + 1).succ)) + 2 * (-((⟨0, 1⟩ : + GaussianInt) * BandVectors.1 (q j.succ) (q i.succ))) = (⟨0, 1⟩ : GaussianInt) ^ + (3 : Nat) * (BandVectors.1 (q j.succ) (q 0) - BandVectors.1 (q 0) (q j.succ))) ∧ + (-(1 - (⟨0, 1⟩ : GaussianInt)) * BandVectors.1 (q ((i + 2).succ)) (q ((i + + 1).succ)) + 2 * (-BandVectors.1 (q j.succ) (q i.succ)) = (⟨0, 1⟩ : GaussianInt) ^ + (2 : Nat) * (BandVectors.1 (q 0) (q i.succ) - BandVectors.1 (q i.succ) (q 0))) ∧ + (-(1 - (⟨0, 1⟩ : GaussianInt)) * BandVectors.1 (q ((j + 2).succ)) (q ((j + + 1).succ)) + 2 * ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q i.succ)) = + (⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * (BandVectors.1 (q j.succ) (q 0) - + BandVectors.1 (q 0) (q j.succ))) ∧ ((1 - (⟨0, 1⟩ : GaussianInt)) * BandVectors.1 + (q ((i + 2).succ)) (q ((i + 1).succ)) + 2 * BandVectors.1 (q j.succ) (q i.succ) = + (⟨0, 1⟩ : GaussianInt) ^ (0 : Nat) * (BandVectors.1 (q 0) (q i.succ) - + BandVectors.1 (q i.succ) (q 0))))))))))))) ) := by + classical + intro C D T N h fixedFunction x bundle q turnFlip cyclicVectorRecurrence hI1 hI2 hI3 aux1Alg + aux2Alg aux3Alg + aux4Alg i j k hcyc + obtain ⟨hsum, hi, hj, hk⟩ := cyclicVectorRecurrence i j k hcyc + let a := BandVectors.1 (q k.succ) (q j.succ) + let b := BandVectors.1 (q i.succ) (q k.succ) + let c := BandVectors.1 (q j.succ) (q i.succ) + have habc : a + b + c = 0 := by + simpa [a, b, c, add_comm, add_left_comm, add_assoc] using hsum + have hi' : BandVectors.1 (q i.succ) (q 0) = b - (⟨0, 1⟩ : GaussianInt) * c := by + simpa [a, b, c] using hi + have hj' : BandVectors.1 (q j.succ) (q 0) = c - (⟨0, 1⟩ : GaussianInt) * a := by + simpa [a, b, c] using hj + have hfi' : BandVectors.1 (q 0) (q i.succ) = + (⟨0, 1⟩ : GaussianInt) * (b - (⟨0, 1⟩ : GaussianInt) * c) := by + rw [(turnFlip i).1, hi'] + have hfj' : BandVectors.1 (q 0) (q j.succ) = + (⟨0, 1⟩ : GaussianInt) * (c - (⟨0, 1⟩ : GaussianInt) * a) := by + rw [(turnFlip j).1, hj'] + rcases hcyc with ⟨rfl, rfl, rfl⟩ | ⟨rfl, rfl, rfl⟩ | + ⟨rfl, rfl, rfl⟩ + all_goals + refine ⟨?_, ?_, ?_, ?_⟩ + · rw [hj', hfj'] + simpa [a, b, c, hI3, Fin.add_def, Nat.reduceAdd, Nat.reduceMod] using + aux1Alg a b c habc + · rw [hi', hfi'] + simpa [a, b, c, hI2, Fin.add_def, Nat.reduceAdd, Nat.reduceMod] using + aux2Alg a b c habc + · rw [hj', hfj'] + simpa [a, b, c, hI1, Fin.add_def, Nat.reduceAdd, Nat.reduceMod] using + aux3Alg a b c habc + · rw [hi', hfi'] + simpa [a, b, c, Fin.add_def, Nat.reduceAdd, Nat.reduceMod] using + aux4Alg a b c habc + +private theorem firstPositiveCentroid : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (i : Fin 3), ∀ (s : Bool), ∀ (d : GaussianInt), ∀ (z : GaussianInt), ((if s then (1 - + (⟨0, 1⟩ : GaussianInt)) else -((1 - (⟨0, 1⟩ : GaussianInt)))) * BandVectors.1 (q ((i + + 2).succ)) (q ((i + 1).succ)) + 2 * d = z) → (TileCentroid (TileTranslation + (placement.layout.P i s) d) - TileCentroid F = (1 / 2 : Real) • GaussianRealPoint z)) + → ((placement.rightFirstSlot + 1 = placement.rightSecondSlot) → + ((placement.rightFirstSlot + 2 = placement.rightDirectionSlot) → (((⟨0, 1⟩ : + GaussianInt) ^ (3 : Nat) = -⟨0, 1⟩) → ((((1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) * BandVectors.1 (q placement.rightDirectionSlot.succ) (q + placement.rightSecondSlot.succ) + (2 : GaussianInt) * BandVectors.1 (q (0 : Fin (4 : + ℕ))) (q placement.rightDirectionSlot.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + (BandVectors.1 (q placement.rightFirstSlot.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q placement.rightFirstSlot.succ))) → + ((placement.rightNeighborPositive = true) → (TileCentroid (TileTranslation + (placement.layout.P placement.rightFirstSlot true) + placement.rightNeighborDisplacement) - TileCentroid F = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * (BandVectors.1 (q + placement.rightFirstSlot.succ) (q 0) + BandVectors.1 (q 0) (q + placement.rightFirstSlot.succ))))))))) ) := by + classical + intro C D T N h k x bundle placement q F translatedPieceCentroid rNext rPrev hI3 vFirst hpos + have hR : placement.rightNeighborDisplacement = + BandVectors.1 (q 0) (q placement.rightDirectionSlot.succ) := by + simpa [hpos] using placement.right_neighbor_displacement + have hdisp : (1 - (⟨0, 1⟩ : GaussianInt)) * + BandVectors.1 (q ((placement.rightFirstSlot + 2).succ)) + (q ((placement.rightFirstSlot + 1).succ)) + + 2 * placement.rightNeighborDisplacement = + (⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * + (BandVectors.1 (q placement.rightFirstSlot.succ) (q 0) + + BandVectors.1 (q 0) (q placement.rightFirstSlot.succ)) := by + calc + _ = - (⟨0, 1⟩ : GaussianInt) * + (BandVectors.1 (q placement.rightFirstSlot.succ) (q 0) + + BandVectors.1 (q 0) (q placement.rightFirstSlot.succ)) := by + rw [rPrev, rNext, hR] + exact vFirst + _ = _ := by simp [hI3] + exact translatedPieceCentroid placement.rightFirstSlot true + placement.rightNeighborDisplacement _ hdisp + +private theorem secondPositiveCentroid : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (i : Fin 3), ∀ (s : Bool), ∀ (d : GaussianInt), ∀ (z : GaussianInt), ((if s then (1 - + (⟨0, 1⟩ : GaussianInt)) else -((1 - (⟨0, 1⟩ : GaussianInt)))) * BandVectors.1 (q ((i + + 2).succ)) (q ((i + 1).succ)) + 2 * d = z) → (TileCentroid (TileTranslation + (placement.layout.P i s) d) - TileCentroid F = (1 / 2 : Real) • GaussianRealPoint z)) + → ((placement.rightSecondSlot + 1 = placement.rightDirectionSlot) → + ((placement.rightSecondSlot + 2 = placement.rightFirstSlot) → (((⟨0, 1⟩ : + GaussianInt) ^ (2 : Nat) = -1) → ((-((1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) * BandVectors.1 (q placement.rightFirstSlot.succ) (q + placement.rightDirectionSlot.succ) + (2 : GaussianInt) * BandVectors.1 (q (0 : Fin (4 + : ℕ))) (q placement.rightDirectionSlot.succ) = -(BandVectors.1 (q + placement.rightSecondSlot.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 + : ℕ))) (q placement.rightSecondSlot.succ))) → ((∀ (a : GaussianInt), ∀ (z : + GaussianInt), -a * z = -(a * z)) → ((placement.rightNeighborPositive = true) → + (TileCentroid (TileTranslation (placement.layout.P placement.rightSecondSlot false) + placement.rightNeighborDisplacement) - TileCentroid F = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * (BandVectors.1 (q + placement.rightSecondSlot.succ) (q 0) + BandVectors.1 (q 0) (q + placement.rightSecondSlot.succ)))))))))) ) := by + classical + intro C D T N h k x bundle placement q F translatedPieceCentroid tNext tPrev hI2 vSecond + gaussianNegMul hpos + have hR : placement.rightNeighborDisplacement = + BandVectors.1 (q 0) (q placement.rightDirectionSlot.succ) := by + simpa [hpos] using placement.right_neighbor_displacement + have hdisp : -((1 - (⟨0, 1⟩ : GaussianInt)) * + BandVectors.1 (q ((placement.rightSecondSlot + 2).succ)) + (q ((placement.rightSecondSlot + 1).succ))) + + 2 * placement.rightNeighborDisplacement = + (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + (BandVectors.1 (q placement.rightSecondSlot.succ) (q 0) + + BandVectors.1 (q 0) (q placement.rightSecondSlot.succ)) := by + calc + _ = -(BandVectors.1 (q placement.rightSecondSlot.succ) (q 0) + + BandVectors.1 (q 0) (q placement.rightSecondSlot.succ)) := by + rw [tPrev, tNext, hR] + convert vSecond using 1; ring + _ = _ := by simp [hI2] + have hdisp' : (-(1 - (⟨0, 1⟩ : GaussianInt))) * + BandVectors.1 (q ((placement.rightSecondSlot + 2).succ)) + (q ((placement.rightSecondSlot + 1).succ)) + + 2 * placement.rightNeighborDisplacement = + (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + (BandVectors.1 (q placement.rightSecondSlot.succ) (q 0) + + BandVectors.1 (q 0) (q placement.rightSecondSlot.succ)) := by + rw [gaussianNegMul] + exact hdisp + exact translatedPieceCentroid placement.rightSecondSlot false + placement.rightNeighborDisplacement _ hdisp' + +private theorem firstReflectedCentroid : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (i : Fin 3), ∀ (s : Bool), ∀ (d : GaussianInt), ∀ (z : GaussianInt), ((if s then (1 - + (⟨0, 1⟩ : GaussianInt)) else -((1 - (⟨0, 1⟩ : GaussianInt)))) * BandVectors.1 (q ((i + + 2).succ)) (q ((i + 1).succ)) + 2 * d = z) → (TileCentroid (TileTranslation + (placement.layout.P i s) d) - TileCentroid F = (1 / 2 : Real) • GaussianRealPoint z)) + → ((placement.rightFirstSlot + 1 = placement.rightSecondSlot) → + ((placement.rightFirstSlot + 2 = placement.rightDirectionSlot) → (((⟨0, 1⟩ : + GaussianInt) ^ (1 : Nat) = ⟨0, 1⟩) → ((-((1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) * BandVectors.1 (q placement.rightDirectionSlot.succ) (q + placement.rightSecondSlot.succ) - (2 : GaussianInt) * BandVectors.1 (q (0 : Fin (4 : + ℕ))) (q placement.rightDirectionSlot.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + (BandVectors.1 (q placement.rightFirstSlot.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q placement.rightFirstSlot.succ))) → ((∀ (a : + GaussianInt), ∀ (z : GaussianInt), -a * z = -(a * z)) → + ((placement.rightNeighborPositive = false) → (TileCentroid (TileTranslation + (placement.layout.P placement.rightFirstSlot false) + placement.rightNeighborDisplacement) - TileCentroid F = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * (BandVectors.1 (q + placement.rightFirstSlot.succ) (q 0) + BandVectors.1 (q 0) (q + placement.rightFirstSlot.succ)))))))))) ) := by + classical + intro C D T N h k x bundle placement q F translatedPieceCentroid rNext rPrev hI1 vRefFirst + gaussianNegMul hpos + have hR : placement.rightNeighborDisplacement = + -BandVectors.1 (q 0) (q placement.rightDirectionSlot.succ) := by + simpa [hpos] using placement.right_neighbor_displacement + have hdisp : -((1 - (⟨0, 1⟩ : GaussianInt)) * + BandVectors.1 (q ((placement.rightFirstSlot + 2).succ)) + (q ((placement.rightFirstSlot + 1).succ))) + + 2 * placement.rightNeighborDisplacement = + (⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * + (BandVectors.1 (q placement.rightFirstSlot.succ) (q 0) + + BandVectors.1 (q 0) (q placement.rightFirstSlot.succ)) := by + calc + _ = (⟨0, 1⟩ : GaussianInt) * + (BandVectors.1 (q placement.rightFirstSlot.succ) (q 0) + + BandVectors.1 (q 0) (q placement.rightFirstSlot.succ)) := by + rw [rPrev, rNext, hR] + convert vRefFirst using 1; ring + _ = _ := by simp [hI1] + apply translatedPieceCentroid placement.rightFirstSlot false + placement.rightNeighborDisplacement _ + rw [← gaussianNegMul] at hdisp + exact hdisp + +private theorem secondReflectedCentroid : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (∀ (i : Fin 3), ∀ (s : Bool), ∀ (d : GaussianInt), ∀ (z : GaussianInt), ((if s then (1 - + (⟨0, 1⟩ : GaussianInt)) else -((1 - (⟨0, 1⟩ : GaussianInt)))) * BandVectors.1 (q ((i + + 2).succ)) (q ((i + 1).succ)) + 2 * d = z) → (TileCentroid (TileTranslation + (placement.layout.P i s) d) - TileCentroid F = (1 / 2 : Real) • GaussianRealPoint z)) + → ((placement.rightSecondSlot + 1 = placement.rightDirectionSlot) → + ((placement.rightSecondSlot + 2 = placement.rightFirstSlot) → ((((1 : GaussianInt) - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) * BandVectors.1 (q placement.rightFirstSlot.succ) + (q placement.rightDirectionSlot.succ) - (2 : GaussianInt) * BandVectors.1 (q (0 : Fin + (4 : ℕ))) (q placement.rightDirectionSlot.succ) = BandVectors.1 (q + placement.rightSecondSlot.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 + : ℕ))) (q placement.rightSecondSlot.succ)) → ((placement.rightNeighborPositive = + false) → (TileCentroid (TileTranslation (placement.layout.P placement.rightSecondSlot + true) placement.rightNeighborDisplacement) - TileCentroid F = (1 / 2 : Real) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (0 : Nat) * (BandVectors.1 (q + placement.rightSecondSlot.succ) (q 0) + BandVectors.1 (q 0) (q + placement.rightSecondSlot.succ)))))))) ) := by + classical + intro C D T N h k x bundle placement q F translatedPieceCentroid tNext tPrev vRefSecond hpos + have hR : placement.rightNeighborDisplacement = + -BandVectors.1 (q 0) (q placement.rightDirectionSlot.succ) := by + simpa [hpos] using placement.right_neighbor_displacement + have hdisp : (1 - (⟨0, 1⟩ : GaussianInt)) * + BandVectors.1 (q ((placement.rightSecondSlot + 2).succ)) + (q ((placement.rightSecondSlot + 1).succ)) + + 2 * placement.rightNeighborDisplacement = + (⟨0, 1⟩ : GaussianInt) ^ (0 : Nat) * + (BandVectors.1 (q placement.rightSecondSlot.succ) (q 0) + + BandVectors.1 (q 0) (q placement.rightSecondSlot.succ)) := by + calc + _ = BandVectors.1 (q placement.rightSecondSlot.succ) (q 0) + + BandVectors.1 (q 0) (q placement.rightSecondSlot.succ) := by + rw [tPrev, tNext, hR] + convert vRefSecond using 1; ring + _ = _ := by simp [] + exact translatedPieceCentroid placement.rightSecondSlot true + placement.rightNeighborDisplacement _ hdisp + +private theorem childPositive : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + let q := bundle.normalizedPresentation + ∀ (i : Fin 3), 0 < (q i.succ).1 ) := by + classical + intro C D T N h k x bundle q i + let cfg := bundle.configuration + have hnonneg := (ProperBandCurvatureStructure q cfg.proper).2.1 i + rcases lt_or_eq_of_le hnonneg with hpos | hzero + · exact hpos + · exact (cfg.noLine i.succ (by simpa [q] using hzero.symm)).elim + +private theorem hJprev : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), (placement.rightFirstSlot = (0 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (1 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (2 : + Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (1 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (2 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (0 : + Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (2 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (0 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (1 : + Fin (3 : ℕ))) → ( + let i := placement.rightFirstSlot + let j := placement.rightSecondSlot + j - 1 = i) ) := by + classical + intro C D T N h k x bundle placement hcyc i j + rcases hcyc with ⟨hi0, hj0, hk0⟩ | ⟨hi0, hj0, hk0⟩ | + ⟨hi0, hj0, hk0⟩ + all_goals + apply Fin.ext + simp [i, j, hi0, hj0] + +private theorem hZ1' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), (placement.rightFirstSlot = (0 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (1 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (2 : + Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (1 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (2 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (0 : + Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (2 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (0 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (1 : + Fin (3 : ℕ))) → ( + let q := bundle.normalizedPresentation + (¬ Even (3 : Nat)) → ( + let i := placement.rightFirstSlot + let j := placement.rightSecondSlot + let c := BandVectors.1 (q j.succ) (q i.succ) + (BandPrototile (q j.succ) (TileTranslation (placement.layout.P j true) (-((⟨0, 1⟩ : + GaussianInt) * c)))) → (BandPrototile (q (if Even (3 : Nat) then i - 1 else i + + 1).succ) (TileTranslation (placement.layout.P j true) (-((⟨0, 1⟩ : GaussianInt) * + c)))))) ) := by + classical + intro C D T N h k x bundle placement hcyc q hEven3 i j c hZ1 + rcases hcyc with ⟨hi0, hj0, hk0⟩ | ⟨hi0, hj0, hk0⟩ | + ⟨hi0, hj0, hk0⟩ <;> + simpa [i, j, hi0, hj0, hEven3] using hZ1 + +private theorem hZ2' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + (Even (2 : Nat)) → ( + let i := placement.rightFirstSlot + let j := placement.rightSecondSlot + let c := BandVectors.1 (q j.succ) (q i.succ) + (j - 1 = i) → ((BandPrototile (q i.succ) (TileTranslation (placement.layout.P i false) + (-c))) → (BandPrototile (q (if Even (2 : Nat) then j - 1 else j + 1).succ) + (TileTranslation (placement.layout.P i false) (-c))))) ) := by + classical + intro C D T N h k x bundle placement q hEven2 i j c hJprev hZ2 + simpa [hEven2, hJprev] using hZ2 + +private theorem hZ3' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), (placement.rightFirstSlot = (0 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (1 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (2 : + Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (1 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (2 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (0 : + Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (2 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (0 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (1 : + Fin (3 : ℕ))) → ( + let q := bundle.normalizedPresentation + (¬ Even (1 : Nat)) → ( + let i := placement.rightFirstSlot + let j := placement.rightSecondSlot + let c := BandVectors.1 (q j.succ) (q i.succ) + (BandPrototile (q j.succ) (TileTranslation (placement.layout.P j false) ((⟨0, 1⟩ : + GaussianInt) * c))) → (BandPrototile (q (if Even (1 : Nat) then i - 1 else i + + 1).succ) (TileTranslation (placement.layout.P j false) ((⟨0, 1⟩ : GaussianInt) * + c))))) ) := by + classical + intro C D T N h k x bundle placement hcyc q hEven1 i j c hZ3 + rcases hcyc with ⟨hi0, hj0, hk0⟩ | ⟨hi0, hj0, hk0⟩ | + ⟨hi0, hj0, hk0⟩ <;> + simpa [i, j, hi0, hj0, hEven1] using hZ3 + +private theorem hZ4' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + (Even (0 : Nat)) → ( + let i := placement.rightFirstSlot + let j := placement.rightSecondSlot + let c := BandVectors.1 (q j.succ) (q i.succ) + (j - 1 = i) → ((BandPrototile (q i.succ) (TileTranslation (placement.layout.P i true) c)) + → (BandPrototile (q (if Even (0 : Nat) then j - 1 else j + 1).succ) (TileTranslation + (placement.layout.P i true) c)))) ) := by + classical + intro C D T N h k x bundle placement q hEven0 i j c hJprev hZ4 + simpa [hEven0, hJprev] using hZ4 + +private theorem hZcent1' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), (placement.rightFirstSlot = (0 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (1 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (2 : + Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (1 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (2 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (0 : + Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (2 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (0 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (1 : + Fin (3 : ℕ))) → ( + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (¬ Even (3 : Nat)) → ( + let i := placement.rightFirstSlot + let j := placement.rightSecondSlot + let c := BandVectors.1 (q j.succ) (q i.succ) + (TileCentroid (TileTranslation (placement.layout.P j true) (-((⟨0, 1⟩ : GaussianInt) * + c))) - TileCentroid F = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ + (3 : Nat) * (BandVectors.1 (q j.succ) (q 0) - BandVectors.1 (q 0) (q j.succ)))) → + (TileCentroid (TileTranslation (placement.layout.P j true) (-((⟨0, 1⟩ : GaussianInt) + * c))) - TileCentroid F = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) + ^ (3 : Nat) * (if Even (3 : Nat) then BandVectors.1 (q 0) (q (i - 1).succ) - + BandVectors.1 (q (i - 1).succ) (q 0) else BandVectors.1 (q (i + 1).succ) (q 0) - + BandVectors.1 (q 0) (q (i + 1).succ)))))) ) := by + classical + intro C D T N h k x bundle placement hcyc q F hEven3 i j c hZcent1 + rcases hcyc with ⟨hi0, hj0, hk0⟩ | ⟨hi0, hj0, hk0⟩ | + ⟨hi0, hj0, hk0⟩ <;> + simpa [i, j, hi0, hj0, hEven3] using hZcent1 + +private theorem hZcent2' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (Even (2 : Nat)) → ( + let i := placement.rightFirstSlot + let j := placement.rightSecondSlot + let c := BandVectors.1 (q j.succ) (q i.succ) + (j - 1 = i) → ((TileCentroid (TileTranslation (placement.layout.P i false) (-c)) - + TileCentroid F = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (2 : + Nat) * (BandVectors.1 (q 0) (q i.succ) - BandVectors.1 (q i.succ) (q 0)))) → + (TileCentroid (TileTranslation (placement.layout.P i false) (-c)) - TileCentroid F = + (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * (if Even (2 + : Nat) then BandVectors.1 (q 0) (q (j - 1).succ) - BandVectors.1 (q (j - 1).succ) (q + 0) else BandVectors.1 (q (j + 1).succ) (q 0) - BandVectors.1 (q 0) (q (j + + 1).succ)))))) ) := by + classical + intro C D T N h k x bundle placement q F hEven2 i j c hJprev hZcent2 + simpa [hEven2, hJprev] using hZcent2 + +private theorem hZcent3' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), (placement.rightFirstSlot = (0 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (1 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (2 : + Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (1 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (2 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (0 : + Fin (3 : ℕ)) ∨ placement.rightFirstSlot = (2 : Fin (3 : ℕ)) ∧ + placement.rightSecondSlot = (0 : Fin (3 : ℕ)) ∧ placement.rightDirectionSlot = (1 : + Fin (3 : ℕ))) → ( + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (¬ Even (1 : Nat)) → ( + let i := placement.rightFirstSlot + let j := placement.rightSecondSlot + let c := BandVectors.1 (q j.succ) (q i.succ) + (TileCentroid (TileTranslation (placement.layout.P j false) ((⟨0, 1⟩ : GaussianInt) * c)) + - TileCentroid F = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (1 : + Nat) * (BandVectors.1 (q j.succ) (q 0) - BandVectors.1 (q 0) (q j.succ)))) → + (TileCentroid (TileTranslation (placement.layout.P j false) ((⟨0, 1⟩ : GaussianInt) * + c)) - TileCentroid F = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ + (1 : Nat) * (if Even (1 : Nat) then BandVectors.1 (q 0) (q (i - 1).succ) - + BandVectors.1 (q (i - 1).succ) (q 0) else BandVectors.1 (q (i + 1).succ) (q 0) - + BandVectors.1 (q 0) (q (i + 1).succ)))))) ) := by + classical + intro C D T N h k x bundle placement hcyc q F hEven1 i j c hZcent3 + rcases hcyc with ⟨hi0, hj0, hk0⟩ | ⟨hi0, hj0, hk0⟩ | + ⟨hi0, hj0, hk0⟩ <;> + simpa [i, j, hi0, hj0, hEven1] using hZcent3 + +private theorem hZcent4' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : + PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : + BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint + bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let F := bundle.normalizedFixed + (Even (0 : Nat)) → ( + let i := placement.rightFirstSlot + let j := placement.rightSecondSlot + let c := BandVectors.1 (q j.succ) (q i.succ) + (j - 1 = i) → ((TileCentroid (TileTranslation (placement.layout.P i true) c) - + TileCentroid F = (1 / 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (0 : + Nat) * (BandVectors.1 (q 0) (q i.succ) - BandVectors.1 (q i.succ) (q 0)))) → + (TileCentroid (TileTranslation (placement.layout.P i true) c) - TileCentroid F = (1 / + 2 : Real) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ (0 : Nat) * (if Even (0 : + Nat) then BandVectors.1 (q 0) (q (j - 1).succ) - BandVectors.1 (q (j - 1).succ) (q 0) + else BandVectors.1 (q (j + 1).succ) (q 0) - BandVectors.1 (q 0) (q (j + 1).succ)))))) + ) := by + classical + intro C D T N h k x bundle placement q F hEven0 i j c hJprev hZcent4 + simpa [hEven0, hJprev] using hZcent4 + +end RightBoundaryRecordsGeometry + +theorem P5635T1RightBoundaryInterfaceRecords + (C D : BandCircle) (T N : ProtoTile) (h k : PartialOdometer) + (x : GaussianInt) + (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x) + (placement : BandOrderedGeneralRightPlacement bundle.normalizedPresentation + bundle.configuration bundle.normalizedCircle bundle.normalizedRoot + bundle.normalizedFixed bundle.normalizedRootFunction + bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces + bundle.functions bundle.selectedSlot bundle.selectedSign + bundle.routedDirection) + (hcyc : (placement.rightFirstSlot = 0 ∧ placement.rightSecondSlot = 1 ∧ + placement.rightDirectionSlot = 2) ∨ + (placement.rightFirstSlot = 1 ∧ placement.rightSecondSlot = 2 ∧ + placement.rightDirectionSlot = 0) ∨ + (placement.rightFirstSlot = 2 ∧ placement.rightSecondSlot = 0 ∧ + placement.rightDirectionSlot = 1)) : + (placement.rightNeighborPositive = true → + Nonempty (ExactTileInterfaceTriple bundle.normalizedFixed + (TileTranslation bundle.normalizedFixed (-BandVectors.1 (bundle.normalizedPresentation 0) + (bundle.normalizedPresentation placement.rightFirstSlot.succ))) + (TileTranslation (placement.layout.P placement.rightFirstSlot true) + placement.rightNeighborDisplacement)) ∧ + Nonempty (ExactTileInterfaceTriple bundle.normalizedFixed + (TileTranslation bundle.normalizedFixed (-BandVectors.1 (bundle.normalizedPresentation 0) + (bundle.normalizedPresentation placement.rightSecondSlot.succ))) + (TileTranslation (placement.layout.P placement.rightSecondSlot false) + placement.rightNeighborDisplacement))) ∧ + (placement.rightNeighborPositive = false → + Nonempty (ExactTileInterfaceTriple bundle.normalizedFixed + (TileTranslation bundle.normalizedFixed (BandVectors.1 (bundle.normalizedPresentation 0) + (bundle.normalizedPresentation placement.rightFirstSlot.succ))) + (TileTranslation (placement.layout.P placement.rightFirstSlot false) + placement.rightNeighborDisplacement)) ∧ + Nonempty (ExactTileInterfaceTriple bundle.normalizedFixed + (TileTranslation bundle.normalizedFixed (BandVectors.1 (bundle.normalizedPresentation 0) + (bundle.normalizedPresentation placement.rightSecondSlot.succ))) + (TileTranslation (placement.layout.P placement.rightSecondSlot true) + placement.rightNeighborDisplacement))) := by +-- BODY + classical + let q := bundle.normalizedPresentation + let cfg := bundle.configuration + let F := bundle.normalizedFixed + change + (placement.rightNeighborPositive = true → + Nonempty (ExactTileInterfaceTriple F + (TileTranslation F (-BandVectors.1 (q 0) + (q placement.rightFirstSlot.succ))) + (TileTranslation (placement.layout.P placement.rightFirstSlot true) + placement.rightNeighborDisplacement)) ∧ + Nonempty (ExactTileInterfaceTriple F + (TileTranslation F (-BandVectors.1 (q 0) + (q placement.rightSecondSlot.succ))) + (TileTranslation (placement.layout.P placement.rightSecondSlot false) + placement.rightNeighborDisplacement))) ∧ + (placement.rightNeighborPositive = false → + Nonempty (ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q 0) + (q placement.rightFirstSlot.succ))) + (TileTranslation (placement.layout.P placement.rightFirstSlot false) + placement.rightNeighborDisplacement)) ∧ + Nonempty (ExactTileInterfaceTriple F + (TileTranslation F (BandVectors.1 (q 0) + (q placement.rightSecondSlot.succ))) + (TileTranslation (placement.layout.P placement.rightSecondSlot true) + placement.rightNeighborDisplacement))) + have vectorLaws := VectorRecursionLaws q cfg.proper.1 + have turnFlip := vectorLaws.2.2.2.2 cfg.proper + have translatedPieceCentroid := RightBoundaryRecordsGeometry.translatedPieceCentroid C D T N h + k x bundle placement + have rNext := RightBoundaryRecordsGeometry.rNext C D T N h k x bundle placement + have rPrev := RightBoundaryRecordsGeometry.rPrev C D T N h k x bundle placement + have tNext := RightBoundaryRecordsGeometry.tNext C D T N h k x bundle placement + have tPrev := RightBoundaryRecordsGeometry.tPrev C D T N h k x bundle placement + have cyclicVectorRecurrence := RightBoundaryRecordsGeometry.cyclicVectorRecurrence C D T N h k x + bundle + have hI0 : (⟨0, 1⟩ : GaussianInt) ^ (0 : Nat) = 1 := by decide +kernel + have hI1 : (⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) = ⟨0, 1⟩ := by decide +kernel + have hI2 : (⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) = -1 := by decide +kernel + have hI3 : (⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) = -⟨0, 1⟩ := by decide +kernel + have auxiliaryDisplacements := RightBoundaryRecordsGeometry.auxiliaryDisplacements C D T N h k x + bundle turnFlip cyclicVectorRecurrence hI1 hI2 hI3 (RightBoundaryRecordsGeometry.aux1Alg + hI2 hI3) (RightBoundaryRecordsGeometry.aux2Alg hI2) (RightBoundaryRecordsGeometry.aux3Alg + hI1) (RightBoundaryRecordsGeometry.aux4Alg hI0 hI2) + obtain ⟨vFirst, vSecond, vRefFirst, vRefSecond, _, _, _, _, _⟩ := + P3045T1RightBoundaryDisplacementAlgebra q cfg.proper + placement.rightFirstSlot placement.rightSecondSlot + placement.rightDirectionSlot placement.right_slots_cyclic + have gaussianNegMul (a z : GaussianInt) : -a * z = -(a * z) := by ring + have firstPositiveCentroid := RightBoundaryRecordsGeometry.firstPositiveCentroid C D T N h k x + bundle placement translatedPieceCentroid rNext rPrev hI3 vFirst + have secondPositiveCentroid := RightBoundaryRecordsGeometry.secondPositiveCentroid C D T N h k + x bundle placement translatedPieceCentroid tNext tPrev hI2 vSecond gaussianNegMul + have firstReflectedCentroid := RightBoundaryRecordsGeometry.firstReflectedCentroid C D T N h k + x bundle placement translatedPieceCentroid rNext rPrev hI1 vRefFirst gaussianNegMul + have secondReflectedCentroid := RightBoundaryRecordsGeometry.secondReflectedCentroid C D T N h + k x bundle placement translatedPieceCentroid tNext tPrev vRefSecond + have childPositive := RightBoundaryRecordsGeometry.childPositive C D T N h k x bundle + have hEven3 : ¬ Even (3 : Nat) := by decide + have hEven2 : Even (2 : Nat) := by decide + have hEven1 : ¬ Even (1 : Nat) := by decide + have hEven0 : Even (0 : Nat) := by decide + have fixedPositive : 0 < (q 0).1 := + (ProperBandCurvatureStructure q cfg.proper).1 + have fixedBand : BandPrototile (q 0) F := + TileOdometerBandPrototile (q 0) F bundle.normalizedFixedFunction + (by + change TileOdometer (bundle.normalizedPresentation 0) F + bundle.normalizedFixedFunction + rw [bundle.normalized_circle_eq] + exact placement.adjacency.2.1) + let i := placement.rightFirstSlot + let j := placement.rightSecondSlot + let directionSlot := placement.rightDirectionSlot + obtain ⟨hsum, hi, hj, hk⟩ := cyclicVectorRecurrence i j directionSlot hcyc + let a := BandVectors.1 (q directionSlot.succ) (q j.succ) + let b := BandVectors.1 (q i.succ) (q directionSlot.succ) + let c := BandVectors.1 (q j.succ) (q i.succ) + have aux := auxiliaryDisplacements i j directionSlot hcyc + have hJprev := RightBoundaryRecordsGeometry.hJprev C D T N h k x bundle placement hcyc + have hBi : BandPrototile (q i.succ) (placement.layout.P i true) := + (placement.layout.outer_occurrence i true).1 + have hBj : BandPrototile (q j.succ) (placement.layout.P j true) := + (placement.layout.outer_occurrence j true).1 + have hBi' : BandPrototile (q i.succ) (placement.layout.P i false) := + (placement.layout.outer_occurrence i false).1 + have hBj' : BandPrototile (q j.succ) (placement.layout.P j false) := + (placement.layout.outer_occurrence j false).1 + have hWi : BandPrototile (q i.succ) + (TileTranslation (placement.layout.P i true) + placement.rightNeighborDisplacement) := + BandPrototileTranslation _ _ _ hBi + have hWj : BandPrototile (q j.succ) + (TileTranslation (placement.layout.P j false) + placement.rightNeighborDisplacement) := + BandPrototileTranslation _ _ _ hBj' + have hWi' : BandPrototile (q i.succ) + (TileTranslation (placement.layout.P i false) + placement.rightNeighborDisplacement) := + BandPrototileTranslation _ _ _ hBi' + have hWj' : BandPrototile (q j.succ) + (TileTranslation (placement.layout.P j true) + placement.rightNeighborDisplacement) := + BandPrototileTranslation _ _ _ hBj + have hZ1 : BandPrototile (q j.succ) + (TileTranslation (placement.layout.P j true) + (-((⟨0, 1⟩ : GaussianInt) * c))) := + BandPrototileTranslation _ _ _ hBj + have hZ2 : BandPrototile (q i.succ) + (TileTranslation (placement.layout.P i false) (-c)) := + BandPrototileTranslation _ _ _ hBi' + have hZ3 : BandPrototile (q j.succ) + (TileTranslation (placement.layout.P j false) + ((⟨0, 1⟩ : GaussianInt) * c)) := + BandPrototileTranslation _ _ _ hBj' + have hZ4 : BandPrototile (q i.succ) + (TileTranslation (placement.layout.P i true) c) := + BandPrototileTranslation _ _ _ hBi + have hZcent1 : TileCentroid + (TileTranslation (placement.layout.P j true) + (-((⟨0, 1⟩ : GaussianInt) * c))) - TileCentroid F = + (1 / 2 : Real) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (3 : Nat) * + (BandVectors.1 (q j.succ) (q 0) - + BandVectors.1 (q 0) (q j.succ))) := + translatedPieceCentroid j true (-((⟨0, 1⟩ : GaussianInt) * c)) _ aux.1 + have hZcent2 : TileCentroid + (TileTranslation (placement.layout.P i false) (-c)) - TileCentroid F = + (1 / 2 : Real) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (2 : Nat) * + (BandVectors.1 (q 0) (q i.succ) - + BandVectors.1 (q i.succ) (q 0))) := + translatedPieceCentroid i false (-c) _ aux.2.1 + have hZcent3 : TileCentroid + (TileTranslation (placement.layout.P j false) + ((⟨0, 1⟩ : GaussianInt) * c)) - TileCentroid F = + (1 / 2 : Real) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (1 : Nat) * + (BandVectors.1 (q j.succ) (q 0) - + BandVectors.1 (q 0) (q j.succ))) := + translatedPieceCentroid j false ((⟨0, 1⟩ : GaussianInt) * c) _ aux.2.2.1 + have hZcent4 : TileCentroid + (TileTranslation (placement.layout.P i true) c) - TileCentroid F = + (1 / 2 : Real) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ (0 : Nat) * + (BandVectors.1 (q 0) (q i.succ) - + BandVectors.1 (q i.succ) (q 0))) := + translatedPieceCentroid i true c _ aux.2.2.2 + have hUpos := fixedPositive + refine ⟨?_, ?_⟩ + · intro hpos + have hWcent1 := firstPositiveCentroid hpos + have hWcent2 := secondPositiveCentroid hpos + refine ⟨?_, ?_⟩ + · have E := BandOrientedChildParentRightEndpoint q cfg.proper i 3 F + (TileTranslation (placement.layout.P i true) + placement.rightNeighborDisplacement) + (TileTranslation (placement.layout.P j true) + (-((⟨0, 1⟩ : GaussianInt) * c))) fixedBand hWi (RightBoundaryRecordsGeometry.hZ1' C D T N + h k x bundle placement hcyc hEven3 hZ1) + hUpos (childPositive i) hWcent1 (RightBoundaryRecordsGeometry.hZcent1' C D T N h k x + bundle placement hcyc hEven3 hZcent1) + simpa [i, j, directionSlot, hI2, hI3, hEven3, (turnFlip i).1] using E + · have E := BandOrientedChildParentRightEndpoint q cfg.proper j 2 F + (TileTranslation (placement.layout.P j false) + placement.rightNeighborDisplacement) + (TileTranslation (placement.layout.P i false) (-c)) fixedBand hWj + (RightBoundaryRecordsGeometry.hZ2' C D T N h k x bundle placement hEven2 hJprev hZ2) + hUpos (childPositive j) hWcent2 (RightBoundaryRecordsGeometry.hZcent2' C D T N h k x + bundle placement hEven2 hJprev hZcent2) + simpa [i, j, directionSlot, hI2, hEven2, (turnFlip j).1] using E + · intro hneg + have hWcent3 := firstReflectedCentroid hneg + have hWcent4 := secondReflectedCentroid hneg + refine ⟨?_, ?_⟩ + · have E := BandOrientedChildParentRightEndpoint q cfg.proper i 1 F + (TileTranslation (placement.layout.P i false) + placement.rightNeighborDisplacement) + (TileTranslation (placement.layout.P j false) + ((⟨0, 1⟩ : GaussianInt) * c)) fixedBand hWi' (RightBoundaryRecordsGeometry.hZ3' C D T N h + k x bundle placement hcyc hEven1 hZ3) + hUpos (childPositive i) hWcent3 (RightBoundaryRecordsGeometry.hZcent3' C D T N h k x + bundle placement hcyc hEven1 hZcent3) + simpa [i, j, directionSlot, hI1, hI2, hEven1, (turnFlip i).1] using E + · have E := BandOrientedChildParentRightEndpoint q cfg.proper j 0 F + (TileTranslation (placement.layout.P j true) + placement.rightNeighborDisplacement) + (TileTranslation (placement.layout.P i true) c) fixedBand hWj' + (RightBoundaryRecordsGeometry.hZ4' C D T N h k x bundle placement hEven0 hJprev hZ4) + hUpos (childPositive j) hWcent4 (RightBoundaryRecordsGeometry.hZcent4' C D T N h k x + bundle placement hEven0 hJprev hZcent4) + simpa [i, j, directionSlot, hI0, hEven0, (turnFlip j).1] using E + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5640T1NonpairedOccurrenceIntersections.lean b/LeanPool/ApollonianSuperharmonic/P5640T1NonpairedOccurrenceIntersections.lean new file mode 100644 index 0000000000..e895f9f25d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5640T1NonpairedOccurrenceIntersections.lean @@ -0,0 +1,792 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.CellSupportedFootprintVertices +public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P5640T1NonpairedOccurrenceIntersections] + +/-! +# P5640T1NonpairedOccurrenceIntersections + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace NonpairedOccurrenceGeometry + +private theorem precursorInPlus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := layout.P + let O := layout.O + O.cells ⊆ (P 0 true).cells ) := by + classical + intro q cfg C₀ T layout P O z hz + change z ∈ layout.O.cells at hz + rw [layout.precursor_eq] at hz + exact (layout.plus_union z).2 ⟨0, false, hz⟩ + +private theorem precursorInMinus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := layout.P + let O := layout.O + O.cells ⊆ (P 0 false).cells ) := by + classical + intro q cfg C₀ T layout P O z hz + change z ∈ layout.O.cells at hz + rw [layout.precursor_cells] at hz + exact (layout.minus_union z).2 ⟨0, true, hz⟩ + +private theorem pairCells : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := layout.P + let O := layout.O + let u := layout.u + let v := layout.v + ((∀ (m : ℤ), ∀ (n : ℤ), (SubtileOccurrenceInterpretation P u v ⟨SixSubtileLabel.A, m, + n⟩).cells ∩ (SubtileOccurrenceInterpretation P u v ⟨SixSubtileLabel.B, m, n⟩).cells = + (TileTranslation O ((↑m : GaussianInt) * u + (↑n : GaussianInt) * v)).cells) ∧ ∀ (a : + PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ¬((a.label = + SixSubtileLabel.A ∧ b.label = SixSubtileLabel.B ∨ a.label = SixSubtileLabel.B ∧ + b.label = SixSubtileLabel.A) ∧ a.first = b.first ∧ a.second = b.second) → Disjoint + (SubtileOccurrenceInterpretation P u v a).cells (SubtileOccurrenceInterpretation P u + v b).cells) → (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → + ((¬ ((a.label = .A ∧ b.label = .B ∨ + a.label = .B ∧ b.label = .A) ∧ a.first = b.first ∧ a.second = b.second)) → (Disjoint + (SubtileOccurrenceInterpretation P u v a).cells (SubtileOccurrenceInterpretation + P u v b).cells))) ) := by + classical + intro q cfg C₀ T layout P O u v separation a b hab hnot + exact separation.2 a b hab hnot + +private theorem translationCells : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (d : GaussianInt), (TileTranslation X d).cells = X.cells.image + (GaussianTranslation d) ) := by + classical + intro X d + exact (TileTranslationFormulas X d).1 + +private theorem cellInclusion : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (d : GaussianInt), (TileTranslation X d).cells = X.cells.image + (GaussianTranslation d)) → (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells ⊆ Y.cells) + → (∀ (d : GaussianInt), (TileTranslation X d).cells ⊆ (TileTranslation Y d).cells)) ) + := by + classical + intro translationCells X Y hXY d + rw [translationCells, translationCells] + intro z hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + exact Finset.mem_image.mpr ⟨w, hXY hw, rfl⟩ + +private theorem isolatedPrecursor : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := layout.P + let O := layout.O + let u := layout.u + let v := layout.v + ∀ (m : Int), ∀ (n : Int), ∀ z ∈ CellSupportedFootprintVertices (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v)), ∀ a : GaussianInt, z ∈ FootprintVertices + (⟨{a}, a⟩ : ProtoTile) → a ∈ (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells + ∨ a ∈ (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells ) := by + classical + intro q cfg C₀ T layout P O u v m n z hz a hza + by_cases hnon : (TileTranslation O + ((m : GaussianInt) * u + (n : GaussianInt) * v)).cells.Nonempty + · have hzraw : z ∈ FootprintVertices (TileTranslation O + ((m : GaussianInt) * u + (n : GaussianInt) * v)) := by + simpa [CellSupportedFootprintVertices, FootprintVertices, hnon] using hz + exact layout.precursor_isolated m n z hzraw a hza + · rcases hz with ⟨w, hw, _⟩ + exact (hnon ⟨w, hw⟩).elim + +private theorem translatedNonempty : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (d : GaussianInt), (TileTranslation X d).cells = X.cells.image + (GaussianTranslation d)) → (∀ (X : ProtoTile), (X.cells.Nonempty) → (∀ (d : + GaussianInt), (TileTranslation X d).cells.Nonempty)) ) := by + classical + intro translationCells X hne d + rw [translationCells] + obtain ⟨z, hz⟩ := hne + exact ⟨GaussianTranslation d z, Finset.mem_image.mpr ⟨z, hz, rfl⟩⟩ + +private theorem deletionEdge : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := layout.P + let O := layout.O + let u := layout.u + let v := layout.v + (O.cells ⊆ (P 0 true).cells) → ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells ⊆ + Y.cells) → (∀ (d : GaussianInt), (TileTranslation X d).cells ⊆ (TileTranslation Y + d).cells)) → ((∀ (m : Int), ∀ (n : Int), ∀ z ∈ CellSupportedFootprintVertices + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)), ∀ a : + GaussianInt, z ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) → a ∈ + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells ∨ a ∈ + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) → (∀ (m : Int), ∀ (n : + Int), ∀ (Y : ProtoTile), (Disjoint Y.cells (SubtileOccurrenceInterpretation P u v + ⟨.A, m, n⟩).cells) → ((Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.B, + m, n⟩).cells) → (FootprintEdges (TileCellComplement (SubtileOccurrenceInterpretation + P u v ⟨.A, m, n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v))) ∩ FootprintEdges Y = FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, + m, n⟩) ∩ FootprintEdges Y))))) ) := by + classical + intro q cfg C₀ T layout P O u v precursorInPlus cellInclusion isolatedPrecursor m n Y hYA hYB + have h := FootprintDeletionRetention + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)) Y + (cellInclusion O (P 0 true) precursorInPlus _) (isolatedPrecursor m n) hYA hYB + exact h.2.1 + +private theorem deletionVertex : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := layout.P + let O := layout.O + let u := layout.u + let v := layout.v + (O.cells ⊆ (P 0 true).cells) → ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells ⊆ + Y.cells) → (∀ (d : GaussianInt), (TileTranslation X d).cells ⊆ (TileTranslation Y + d).cells)) → ((∀ (m : Int), ∀ (n : Int), ∀ z ∈ CellSupportedFootprintVertices + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)), ∀ a : + GaussianInt, z ∈ FootprintVertices (⟨{a}, a⟩ : ProtoTile) → a ∈ + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells ∨ a ∈ + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) → (∀ (m : Int), ∀ (n : + Int), ∀ (Y : ProtoTile), (Disjoint Y.cells (SubtileOccurrenceInterpretation P u v + ⟨.A, m, n⟩).cells) → ((Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.B, + m, n⟩).cells) → (((TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v)).cells = ∅ ∨ + ((TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))).cells.Nonempty ∧ + Y.cells.Nonempty)) → (FootprintVertices (TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) ∩ FootprintVertices Y = + FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ + FootprintVertices Y)))))) ) := by + classical + intro q cfg C₀ T layout P O u v precursorInPlus cellInclusion isolatedPrecursor m n Y hYA hYB + hsupport + have h := FootprintDeletionRetention + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) + (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)) Y + (cellInclusion O (P 0 true) precursorInPlus _) (isolatedPrecursor m n) hYA hYB + exact h.2.2 hsupport + +private theorem translateComplement : + (by + classical + exact + ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (d : GaussianInt), TileTranslation + (TileCellComplement A B) d = TileCellComplement (TileTranslation A d) + (TileTranslation B d) ) := by + classical + intro A B d + exact (TileCellComplementCovariance A B d).1 + +private theorem modifiedA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := layout.P + let O := layout.O + let u := layout.u + let v := layout.v + (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (d : GaussianInt), TileTranslation + (TileCellComplement A B) d = TileCellComplement (TileTranslation A d) + (TileTranslation B d)) → (∀ (m : Int), ∀ (n : Int), + ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩ = TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) ) := by + classical + intro q cfg C₀ T layout P O u v translateComplement m n + change TileTranslation (TileCellComplement (P 0 true) O) + ((m : GaussianInt) * u + (n : GaussianInt) * v) = _ + rw [translateComplement] + rfl + +private theorem modifiedOther : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := layout.P + let O := layout.O + let u := layout.u + let v := layout.v + ∀ (b : PeriodicSubtileIndex), (b.label ≠ .A) → (ModifiedSubtileOccurrenceInterpretation P + O u v b = SubtileOccurrenceInterpretation P u v b) ) := by + classical + intro q cfg C₀ T layout P O u v b hb + cases b with + | mk label first second => + cases label with + | A => exact (hb rfl).elim + | B => rfl + | C => rfl + | D => rfl + | E => rfl + | F => rfl + +private theorem parentNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := layout.P + let u := layout.u + let v := layout.v + (∀ (X : ProtoTile), (X.cells.Nonempty) → (∀ (d : GaussianInt), (TileTranslation X + d).cells.Nonempty)) → (∀ (b : PeriodicSubtileIndex), (SubtileOccurrenceInterpretation + P u v b).cells.Nonempty) ) := by + classical + intro q cfg C₀ T layout P u v translatedNonempty b + cases b with + | mk label first second => + cases label with + | A => + simpa [SubtileOccurrenceInterpretation] using translatedNonempty + (P 0 true) ((LatticeTileGridStructure (P 0 true) + (layout.parent_lattice 0 true)).1.1) _ + | B => + simpa [SubtileOccurrenceInterpretation] using translatedNonempty + (P 0 false) ((LatticeTileGridStructure (P 0 false) + (layout.parent_lattice 0 false)).1.1) _ + | C => + simpa [SubtileOccurrenceInterpretation] using translatedNonempty + (P 1 true) ((LatticeTileGridStructure (P 1 true) + (layout.parent_lattice 1 true)).1.1) _ + | D => + simpa [SubtileOccurrenceInterpretation] using translatedNonempty + (P 1 false) ((LatticeTileGridStructure (P 1 false) + (layout.parent_lattice 1 false)).1.1) _ + | E => + simpa [SubtileOccurrenceInterpretation] using translatedNonempty + (P 2 true) ((LatticeTileGridStructure (P 2 true) + (layout.parent_lattice 2 true)).1.1) _ + | F => + simpa [SubtileOccurrenceInterpretation] using translatedNonempty + (P 2 false) ((LatticeTileGridStructure (P 2 false) + (layout.parent_lattice 2 false)).1.1) _ + +private theorem complementNonempty : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := layout.P + let O := layout.O + let u := layout.u + let v := layout.v + (∀ (X : ProtoTile), (X.cells.Nonempty) → (∀ (d : GaussianInt), (TileTranslation X + d).cells.Nonempty)) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (d : GaussianInt), + TileTranslation (TileCellComplement A B) d = TileCellComplement (TileTranslation A d) + (TileTranslation B d)) → (∀ (m : Int), ∀ (n : Int), (TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))).cells.Nonempty)) ) := by + classical + intro q cfg C₀ T layout P O u v translatedNonempty translateComplement m n + have ht := translatedNonempty (TileCellComplement (P 0 true) O) + ((LatticeTileGridStructure _ layout.precursor_complement_lattice.1).1.1) + ((m : GaussianInt) * u + (n : GaussianInt) * v) + rw [translateComplement] at ht + simpa [SubtileOccurrenceInterpretation] using ht + +private theorem deletionSupport : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := layout.P + let O := layout.O + let u := layout.u + let v := layout.v + (∀ (m : Int), ∀ (n : Int), (TileCellComplement (SubtileOccurrenceInterpretation P u v + ⟨.A, m, n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v))).cells.Nonempty) → (∀ (m : Int), ∀ (n : Int), ∀ (Y : ProtoTile), + (Y.cells.Nonempty) → ((TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v)).cells = ∅ ∨ ((TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A, m, + n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v))).cells.Nonempty ∧ Y.cells.Nonempty))) ) := by + classical + intro q cfg C₀ T layout P O u v complementNonempty m n Y hY + by_cases hO : O.cells = ∅ + · exact Or.inl ((TileTranslationFormulas O + ((m : GaussianInt) * u + (n : GaussianInt) * v)).2.2.1.mpr hO) + · exact Or.inr ⟨complementNonempty m n, hY⟩ + +private theorem modifiedAEdges : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := layout.P + let O := layout.O + let u := layout.u + let v := layout.v + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → ((¬ ((a.label = .A + ∧ b.label = .B ∨ a.label = .B ∧ b.label = .A) ∧ a.first = b.first ∧ a.second = + b.second)) → (Disjoint (SubtileOccurrenceInterpretation P u v a).cells + (SubtileOccurrenceInterpretation P u v b).cells))) → ((∀ (m : Int), ∀ (n : Int), ∀ (Y + : ProtoTile), (Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.A, m, + n⟩).cells) → ((Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.B, m, + n⟩).cells) → (FootprintEdges (TileCellComplement (SubtileOccurrenceInterpretation P u + v ⟨.A, m, n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))) ∩ + FootprintEdges Y = FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) + ∩ FootprintEdges Y))) → ((∀ (m : Int), ∀ (n : Int), + ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩ = TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) → ((∀ (b : PeriodicSubtileIndex), + (b.label ≠ .A) → (ModifiedSubtileOccurrenceInterpretation P O u v b = + SubtileOccurrenceInterpretation P u v b)) → (∀ (m : Int), ∀ (n : Int), ∀ (b : + PeriodicSubtileIndex), (b.label ≠ .A) → ((¬ (b.label = .B ∧ b.first = m ∧ b.second = + n)) → (FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ FootprintEdges + (SubtileOccurrenceInterpretation P u v b))))))) ) := by + classical + intro q cfg C₀ T layout P O u v pairCells deletionEdge modifiedA modifiedOther m n b hbA hbpair + have hneA : (⟨.A, m, n⟩ : PeriodicSubtileIndex) ≠ b := by + intro he + exact hbA (by simpa using (congrArg PeriodicSubtileIndex.label he).symm) + have hneB : (⟨.B, m, n⟩ : PeriodicSubtileIndex) ≠ b := by + intro he + apply hbpair + exact ⟨by simpa using (congrArg PeriodicSubtileIndex.label he).symm, + by simpa using (congrArg PeriodicSubtileIndex.first he).symm, + by simpa using (congrArg PeriodicSubtileIndex.second he).symm⟩ + have hfirst := deletionEdge m n (SubtileOccurrenceInterpretation P u v b) + (pairCells b ⟨.A, m, n⟩ hneA.symm (by + intro hp + rcases hp with ⟨hlabels, hfirst, hsecond⟩ + rcases hlabels with ⟨hbA', hAB⟩ | ⟨hbB, hBA⟩ + · cases hAB + · exact hbpair ⟨hbB, by simpa using hfirst, + by simpa using hsecond⟩)) + (pairCells b ⟨.B, m, n⟩ hneB.symm (by + intro hp + rcases hp with ⟨hlabels, hfirst, hsecond⟩ + rcases hlabels with ⟨hbA', hAB⟩ | ⟨hbB, hBA⟩ + · exact hbA hbA' + · cases hBA)) + rw [modifiedA m n, modifiedOther b hbA] + exact hfirst + +private theorem modifiedAVertices : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := layout.P + let O := layout.O + let u := layout.u + let v := layout.v + (∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), (a ≠ b) → ((¬ ((a.label = .A + ∧ b.label = .B ∨ a.label = .B ∧ b.label = .A) ∧ a.first = b.first ∧ a.second = + b.second)) → (Disjoint (SubtileOccurrenceInterpretation P u v a).cells + (SubtileOccurrenceInterpretation P u v b).cells))) → ((∀ (m : Int), ∀ (n : Int), ∀ (Y + : ProtoTile), (Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.A, m, + n⟩).cells) → ((Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.B, m, + n⟩).cells) → (((TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v)).cells = ∅ ∨ ((TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A, m, + n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * + v))).cells.Nonempty ∧ Y.cells.Nonempty)) → (FootprintVertices (TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))) ∩ FootprintVertices Y = FootprintVertices + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ FootprintVertices Y)))) → ((∀ (m + : Int), ∀ (n : Int), ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩ = + TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))) → ((∀ (b : + PeriodicSubtileIndex), (b.label ≠ .A) → (ModifiedSubtileOccurrenceInterpretation P O + u v b = SubtileOccurrenceInterpretation P u v b)) → ((∀ (b : PeriodicSubtileIndex), + (SubtileOccurrenceInterpretation P u v b).cells.Nonempty) → ((∀ (m : Int), ∀ (n : + Int), ∀ (Y : ProtoTile), (Y.cells.Nonempty) → ((TileTranslation O ((m : GaussianInt) + * u + (n : GaussianInt) * v)).cells = ∅ ∨ ((TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : + GaussianInt) * u + (n : GaussianInt) * v))).cells.Nonempty ∧ Y.cells.Nonempty))) → (∀ + (m : Int), ∀ (n : Int), ∀ (b : PeriodicSubtileIndex), (b.label ≠ .A) → ((¬ (b.label = + .B ∧ b.first = m ∧ b.second = n)) → (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ FootprintVertices + (SubtileOccurrenceInterpretation P u v b))))))))) ) := by + classical + intro q cfg C₀ T layout P O u v pairCells deletionVertex modifiedA modifiedOther parentNonempty + deletionSupport m n b hbA hbpair + have hneA : (⟨.A, m, n⟩ : PeriodicSubtileIndex) ≠ b := by + intro he + exact hbA (by simpa using (congrArg PeriodicSubtileIndex.label he).symm) + have hneB : (⟨.B, m, n⟩ : PeriodicSubtileIndex) ≠ b := by + intro he + apply hbpair + exact ⟨by simpa using (congrArg PeriodicSubtileIndex.label he).symm, + by simpa using (congrArg PeriodicSubtileIndex.first he).symm, + by simpa using (congrArg PeriodicSubtileIndex.second he).symm⟩ + have hfirst := deletionVertex m n (SubtileOccurrenceInterpretation P u v b) + (pairCells b ⟨.A, m, n⟩ hneA.symm (by + intro hp + rcases hp with ⟨hlabels, hfirst, hsecond⟩ + rcases hlabels with ⟨hbA', hAB⟩ | ⟨hbB, hBA⟩ + · cases hAB + · exact hbpair ⟨hbB, by simpa using hfirst, + by simpa using hsecond⟩)) + (pairCells b ⟨.B, m, n⟩ hneB.symm (by + intro hp + rcases hp with ⟨hlabels, hfirst, hsecond⟩ + rcases hlabels with ⟨hbA', hAB⟩ | ⟨hbB, hBA⟩ + · exact hbA hbA' + · cases hBA)) + (deletionSupport m n (SubtileOccurrenceInterpretation P u v b) + (parentNonempty b)) + rw [modifiedA m n, modifiedOther b hbA] + exact hfirst + +private theorem allowedLabelNe : + (by + classical + exact + ∀ {a : PeriodicSubtileIndex}, ∀ {b : PeriodicSubtileIndex}, AllowedSubtileIncidence a b → + a.label ≠ b.label ) := by + classical + intro a b hab + induction hab with + | AB => intro h; cases h + | AB01 => intro h; cases h + | AB11 => intro h; cases h + | AC => intro h; cases h + | AC11 => intro h; cases h + | AD => intro h; cases h + | AE01 => intro h; cases h + | AF => intro h; cases h + | BC => intro h; cases h + | BDm1m1 => intro h; cases h + | BD => intro h; cases h + | BE => intro h; cases h + | BF0m1 => intro h; cases h + | CDm10 => intro h; cases h + | CEm10 => intro h; cases h + | CF => intro h; cases h + | DE => intro h; cases h + | DF10 => intro h; cases h + | symm _ ih => exact ih.symm + +private theorem hpairAt392 : + (by + classical + exact + ∀ (m : ℤ), ∀ (n : ℤ), ∀ (p : ℤ), ∀ (r : ℤ), (¬(((⟨SixSubtileLabel.A, m, n⟩ : + PeriodicSubtileIndex).label = + SixSubtileLabel.A ∧ (⟨SixSubtileLabel.B, p, r⟩ : PeriodicSubtileIndex).label = + SixSubtileLabel.B ∨ + (⟨SixSubtileLabel.A, m, n⟩ : PeriodicSubtileIndex).label = SixSubtileLabel.B ∧ + (⟨SixSubtileLabel.B, p, r⟩ : PeriodicSubtileIndex).label + = SixSubtileLabel.A) ∧ (⟨SixSubtileLabel.A, m, n⟩ : PeriodicSubtileIndex).first = + (⟨SixSubtileLabel.B, p, + r⟩ : PeriodicSubtileIndex).first ∧ (⟨SixSubtileLabel.A, m, n⟩ : + PeriodicSubtileIndex).second = (⟨SixSubtileLabel.B, p, r⟩ : + PeriodicSubtileIndex).second)) → (¬ + ((.B : SixSubtileLabel) = .B ∧ p = m ∧ r = n)) ) := by + classical + intro m n p r hnot hp + apply hnot + exact ⟨Or.inl ⟨rfl, rfl⟩, by simpa using hp.2.1.symm, + by simpa using hp.2.2.symm⟩ + +private theorem hpairAt410 : + (by + classical + exact + ∀ (m : ℤ), ∀ (n : ℤ), ∀ (p : ℤ), ∀ (r : ℤ), (¬(((⟨SixSubtileLabel.B, m, n⟩ : + PeriodicSubtileIndex).label = + SixSubtileLabel.A ∧ (⟨SixSubtileLabel.A, p, r⟩ : PeriodicSubtileIndex).label = + SixSubtileLabel.B ∨ + (⟨SixSubtileLabel.B, m, n⟩ : PeriodicSubtileIndex).label = SixSubtileLabel.B ∧ + (⟨SixSubtileLabel.A, p, r⟩ : PeriodicSubtileIndex).label + = SixSubtileLabel.A) ∧ (⟨SixSubtileLabel.B, m, n⟩ : PeriodicSubtileIndex).first = + (⟨SixSubtileLabel.A, p, + r⟩ : PeriodicSubtileIndex).first ∧ (⟨SixSubtileLabel.B, m, n⟩ : + PeriodicSubtileIndex).second = (⟨SixSubtileLabel.A, p, r⟩ : + PeriodicSubtileIndex).second)) → (¬ + ((.B : SixSubtileLabel) = .B ∧ m = p ∧ n = r)) ) := by + classical + intro m n p r hnot hp + apply hnot + exact ⟨Or.inr ⟨rfl, rfl⟩, by simpa using hp.2.1, + by simpa using hp.2.2⟩ + +private theorem hpairAt427 : + (by + classical + exact + ∀ (m : ℤ), ∀ (n : ℤ), ∀ (p : ℤ), ∀ (r : ℤ), ¬ ((.C : SixSubtileLabel) = .B ∧ m = p ∧ n = + r) ) := by + classical + intro m n p r hp + cases hp.1 + +private theorem hpairAt438 : + (by + classical + exact + ∀ (m : ℤ), ∀ (n : ℤ), ∀ (p : ℤ), ∀ (r : ℤ), ¬ ((.D : SixSubtileLabel) = .B ∧ m = p ∧ n = + r) ) := by + classical + intro m n p r hp + cases hp.1 + +private theorem hpairAt449 : + (by + classical + exact + ∀ (m : ℤ), ∀ (n : ℤ), ∀ (p : ℤ), ∀ (r : ℤ), ¬ ((.E : SixSubtileLabel) = .B ∧ m = p ∧ n = + r) ) := by + classical + intro m n p r hp + cases hp.1 + +private theorem hpairAt460 : + (by + classical + exact + ∀ (m : ℤ), ∀ (n : ℤ), ∀ (p : ℤ), ∀ (r : ℤ), ¬ ((.F : SixSubtileLabel) = .B ∧ m = p ∧ n = + r) ) := by + classical + intro m n p r hp + cases hp.1 + +end NonpairedOccurrenceGeometry + +theorem P5640T1NonpairedOccurrenceIntersections + (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (layout : BandOrderedGeneralLayoutCertificate q cfg C₀ T) + (a b : PeriodicSubtileIndex) + (hab : AllowedSubtileIncidence a b) + (hnot : ¬ ((a.label = .A ∧ b.label = .B ∨ + a.label = .B ∧ b.label = .A) ∧ a.first = b.first ∧ a.second = b.second)) : + (FootprintEdges + (ModifiedSubtileOccurrenceInterpretation layout.P layout.O layout.u layout.v a) ∩ + FootprintEdges + (ModifiedSubtileOccurrenceInterpretation layout.P layout.O layout.u layout.v b) = + FootprintEdges (SubtileOccurrenceInterpretation layout.P layout.u layout.v a) ∩ + FootprintEdges (SubtileOccurrenceInterpretation layout.P layout.u layout.v b)) ∧ + (FootprintVertices + (ModifiedSubtileOccurrenceInterpretation layout.P layout.O layout.u layout.v a) ∩ + FootprintVertices + (ModifiedSubtileOccurrenceInterpretation layout.P layout.O layout.u layout.v b) = + FootprintVertices (SubtileOccurrenceInterpretation layout.P layout.u layout.v a) ∩ + FootprintVertices (SubtileOccurrenceInterpretation layout.P layout.u layout.v b)) := by +-- BODY + classical + let P := layout.P + let O := layout.O + let u := layout.u + let v := layout.v + have precursorInPlus := NonpairedOccurrenceGeometry.precursorInPlus q cfg C₀ T layout + have precursorInMinus := NonpairedOccurrenceGeometry.precursorInMinus q cfg C₀ T layout + have separation := BandOriginalPairSeparation P O u v precursorInPlus + precursorInMinus layout.partition + have pairCells (a b : PeriodicSubtileIndex) (hab : a ≠ b) + (hnot : ¬ ((a.label = .A ∧ b.label = .B ∨ + a.label = .B ∧ b.label = .A) ∧ a.first = b.first ∧ a.second = b.second)) := + NonpairedOccurrenceGeometry.pairCells q cfg C₀ T layout separation a b hab hnot + have translationCells (X : ProtoTile) (d : GaussianInt) := + NonpairedOccurrenceGeometry.translationCells X d + have cellInclusion (X Y : ProtoTile) (hXY : X.cells ⊆ Y.cells) + (d : GaussianInt) := NonpairedOccurrenceGeometry.cellInclusion translationCells X Y hXY d + have isolatedPrecursor (m n : Int) := NonpairedOccurrenceGeometry.isolatedPrecursor q cfg C₀ T + layout m n + have translatedNonempty (X : ProtoTile) (hne : X.cells.Nonempty) + (d : GaussianInt) := NonpairedOccurrenceGeometry.translatedNonempty translationCells X hne d + have deletionEdge (m n : Int) (Y : ProtoTile) + (hYA : Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells) + (hYB : Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) := + NonpairedOccurrenceGeometry.deletionEdge q cfg C₀ T layout precursorInPlus + cellInclusion isolatedPrecursor m n Y hYA hYB + have deletionVertex (m n : Int) (Y : ProtoTile) + (hYA : Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩).cells) + (hYB : Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.B, m, n⟩).cells) + (hsupport : (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)).cells = ∅ ∨ + ((TileCellComplement + (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))).cells.Nonempty ∧ + Y.cells.Nonempty)) := NonpairedOccurrenceGeometry.deletionVertex q cfg C₀ T layout + precursorInPlus cellInclusion isolatedPrecursor m n Y hYA hYB hsupport + have translateComplement (A B : ProtoTile) (d : GaussianInt) := + NonpairedOccurrenceGeometry.translateComplement A B d + have modifiedA (m n : Int) := NonpairedOccurrenceGeometry.modifiedA q cfg C₀ T layout + translateComplement m n + have modifiedOther (b : PeriodicSubtileIndex) (hb : b.label ≠ .A) := + NonpairedOccurrenceGeometry.modifiedOther q cfg C₀ T layout b hb + have parentNonempty (b : PeriodicSubtileIndex) := NonpairedOccurrenceGeometry.parentNonempty q + cfg C₀ T layout translatedNonempty b + have complementNonempty (m n : Int) := NonpairedOccurrenceGeometry.complementNonempty q cfg C₀ + T layout translatedNonempty translateComplement m n + have deletionSupport (m n : Int) (Y : ProtoTile) (hY : Y.cells.Nonempty) := + NonpairedOccurrenceGeometry.deletionSupport q cfg C₀ T layout complementNonempty m n Y hY + have modifiedAEdges (m n : Int) (b : PeriodicSubtileIndex) + (hbA : b.label ≠ .A) + (hbpair : ¬ (b.label = .B ∧ b.first = m ∧ b.second = n)) : + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ + FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b) = + FootprintEdges (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ + FootprintEdges (SubtileOccurrenceInterpretation P u v b) := + NonpairedOccurrenceGeometry.modifiedAEdges q cfg C₀ T layout pairCells deletionEdge + modifiedA modifiedOther m n b hbA hbpair + have modifiedAVertices (m n : Int) (b : PeriodicSubtileIndex) + (hbA : b.label ≠ .A) + (hbpair : ¬ (b.label = .B ∧ b.first = m ∧ b.second = n)) : + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩) ∩ + FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b) = + FootprintVertices (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) ∩ + FootprintVertices (SubtileOccurrenceInterpretation P u v b) := + NonpairedOccurrenceGeometry.modifiedAVertices q cfg C₀ T layout pairCells + deletionVertex modifiedA modifiedOther parentNonempty deletionSupport m n b hbA hbpair + have allowedLabelNe : ∀ {a b : PeriodicSubtileIndex}, + AllowedSubtileIncidence a b → a.label ≠ b.label := + @NonpairedOccurrenceGeometry.allowedLabelNe + cases a with + | mk la m n => + cases b with + | mk lb p r => + cases la with + | A => + cases lb with + | A => exact (allowedLabelNe hab rfl).elim + | B => + have hpair : ¬ ((.B : SixSubtileLabel) = .B ∧ p = m ∧ r = n) := + NonpairedOccurrenceGeometry.hpairAt392 m n p r hnot + exact ⟨modifiedAEdges m n ⟨.B, p, r⟩ (by simp) hpair, + modifiedAVertices m n ⟨.B, p, r⟩ (by simp) hpair⟩ + | C => exact ⟨modifiedAEdges m n ⟨.C, p, r⟩ (by simp) (by intro hp; cases hp.1), + modifiedAVertices m n ⟨.C, p, r⟩ (by simp) (by intro hp; cases hp.1)⟩ + | D => exact ⟨modifiedAEdges m n ⟨.D, p, r⟩ (by simp) (by intro hp; cases hp.1), + modifiedAVertices m n ⟨.D, p, r⟩ (by simp) (by intro hp; cases hp.1)⟩ + | E => exact ⟨modifiedAEdges m n ⟨.E, p, r⟩ (by simp) (by intro hp; cases hp.1), + modifiedAVertices m n ⟨.E, p, r⟩ (by simp) (by intro hp; cases hp.1)⟩ + | F => exact ⟨modifiedAEdges m n ⟨.F, p, r⟩ (by simp) (by intro hp; cases hp.1), + modifiedAVertices m n ⟨.F, p, r⟩ (by simp) (by intro hp; cases hp.1)⟩ + | B => + cases lb with + | A => + have hpair : ¬ ((.B : SixSubtileLabel) = .B ∧ m = p ∧ n = r) := + NonpairedOccurrenceGeometry.hpairAt410 m n p r hnot + have he := modifiedAEdges p r ⟨.B, m, n⟩ (by simp) hpair + have hv := modifiedAVertices p r ⟨.B, m, n⟩ (by simp) hpair + exact ⟨by simpa [Set.inter_comm] using he, + by simpa [Set.inter_comm] using hv⟩ + | B => exact ⟨by rfl, by rfl⟩ + | C => exact ⟨by rfl, by rfl⟩ + | D => exact ⟨by rfl, by rfl⟩ + | E => exact ⟨by rfl, by rfl⟩ + | F => exact ⟨by rfl, by rfl⟩ + | C => + cases lb with + | A => + have hpair : ¬ ((.C : SixSubtileLabel) = .B ∧ m = p ∧ n = r) := + NonpairedOccurrenceGeometry.hpairAt427 m n p r + have he := modifiedAEdges p r ⟨.C, m, n⟩ (by simp) hpair + have hv := modifiedAVertices p r ⟨.C, m, n⟩ (by simp) hpair + exact ⟨by simpa [Set.inter_comm] using he, + by simpa [Set.inter_comm] using hv⟩ + | B | C | D | E | F => exact ⟨by rfl, by rfl⟩ + | D => + cases lb with + | A => + have hpair : ¬ ((.D : SixSubtileLabel) = .B ∧ m = p ∧ n = r) := + NonpairedOccurrenceGeometry.hpairAt438 m n p r + have he := modifiedAEdges p r ⟨.D, m, n⟩ (by simp) hpair + have hv := modifiedAVertices p r ⟨.D, m, n⟩ (by simp) hpair + exact ⟨by simpa [Set.inter_comm] using he, + by simpa [Set.inter_comm] using hv⟩ + | B | C | D | E | F => exact ⟨by rfl, by rfl⟩ + | E => + cases lb with + | A => + have hpair : ¬ ((.E : SixSubtileLabel) = .B ∧ m = p ∧ n = r) := + NonpairedOccurrenceGeometry.hpairAt449 m n p r + have he := modifiedAEdges p r ⟨.E, m, n⟩ (by simp) hpair + have hv := modifiedAVertices p r ⟨.E, m, n⟩ (by simp) hpair + exact ⟨by simpa [Set.inter_comm] using he, + by simpa [Set.inter_comm] using hv⟩ + | B | C | D | E | F => exact ⟨by rfl, by rfl⟩ + | F => + cases lb with + | A => + have hpair : ¬ ((.F : SixSubtileLabel) = .B ∧ m = p ∧ n = r) := + NonpairedOccurrenceGeometry.hpairAt460 m n p r + have he := modifiedAEdges p r ⟨.F, m, n⟩ (by simp) hpair + have hv := modifiedAVertices p r ⟨.F, m, n⟩ (by simp) hpair + exact ⟨by simpa [Set.inter_comm] using he, + by simpa [Set.inter_comm] using hv⟩ + | B | C | D | E | F => exact ⟨by rfl, by rfl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5658T1FivePointDomainCoverSymmetryCovariance.lean b/LeanPool/ApollonianSuperharmonic/P5658T1FivePointDomainCoverSymmetryCovariance.lean new file mode 100644 index 0000000000..e1c513fa6a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5658T1FivePointDomainCoverSymmetryCovariance.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction + +-- [TABLET NODE: P5658T1FivePointDomainCoverSymmetryCovariance] + +/-! +# P5658T1FivePointDomainCoverSymmetryCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5658T1FivePointDomainCoverSymmetryCovariance + (g : BandPackingSymmetry) (h k : PartialOdometer) (x : GaussianInt) + (hstar : ∀ y, + y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ h.domain ∨ y ∈ k.domain) : + ∀ y, + y = BandPackingSymmetryVectorAction g x ∨ + y = BandPackingSymmetryVectorAction g x + 1 ∨ + y = BandPackingSymmetryVectorAction g x - 1 ∨ + y = BandPackingSymmetryVectorAction g x + ⟨0, 1⟩ ∨ + y = BandPackingSymmetryVectorAction g x - ⟨0, 1⟩ → + y ∈ (BandPackingSymmetryPartialOdometerAction g h).domain ∨ + y ∈ (BandPackingSymmetryPartialOdometerAction g k).domain := by +-- BODY + let hbar := BandPackingSymmetryPartialOdometerAction g h + let kbar := BandPackingSymmetryPartialOdometerAction g k + let xbar := BandPackingSymmetryVectorAction g x + let Axial : GaussianInt → Prop := fun d => + d = 0 ∨ d = 1 ∨ d = -1 ∨ + d = ⟨0, 1⟩ ∨ d = -⟨0, 1⟩ + have vector_add : ∀ (a : BandPackingSymmetry) (u v : GaussianInt), + BandPackingSymmetryVectorAction a (u + v) = + BandPackingSymmetryVectorAction a u + + BandPackingSymmetryVectorAction a v := by + intro a + induction a with + | identity => intro u v; rfl + | shift w => intro u v; rfl + | negate => + intro u v + rcases u with ⟨ur, ui⟩ + rcases v with ⟨vr, vi⟩ + apply Zsqrtd.ext_iff.mpr + constructor <;> simp [BandPackingSymmetryVectorAction, + GaussianQuarterTurn]; ring + | conjugate => + intro u v + rcases u with ⟨ur, ui⟩ + rcases v with ⟨vr, vi⟩ + apply Zsqrtd.ext_iff.mpr + constructor <;> simp [BandPackingSymmetryVectorAction, + GaussianReflection]; ring + | comp a b iha ihb => + intro u v + simp only [BandPackingSymmetryVectorAction] + rw [ihb, iha] + have axial_preimage : ∀ (a : BandPackingSymmetry) (d : GaussianInt), + Axial d → ∃ d₀, Axial d₀ ∧ + BandPackingSymmetryVectorAction a d₀ = d := by + intro a + induction a with + | identity => + intro d hd + exact ⟨d, hd, rfl⟩ + | shift w => + intro d hd + exact ⟨d, hd, rfl⟩ + | negate => + intro d hd + rcases hd with rfl | rfl | rfl | rfl | rfl + · exact ⟨0, Or.inl rfl, by rfl⟩ + · exact ⟨-⟨0, 1⟩, Or.inr (Or.inr (Or.inr (Or.inr rfl))), by + ext <;> norm_num [BandPackingSymmetryVectorAction, + GaussianQuarterTurn]⟩ + · exact ⟨⟨0, 1⟩, Or.inr (Or.inr (Or.inr (Or.inl rfl))), by + ext <;> norm_num [BandPackingSymmetryVectorAction, + GaussianQuarterTurn]⟩ + · exact ⟨1, Or.inr (Or.inl rfl), by + ext <;> norm_num [BandPackingSymmetryVectorAction, + GaussianQuarterTurn]⟩ + · exact ⟨-1, Or.inr (Or.inr (Or.inl rfl)), by + ext <;> norm_num [BandPackingSymmetryVectorAction, + GaussianQuarterTurn]⟩ + | conjugate => + intro d hd + rcases hd with rfl | rfl | rfl | rfl | rfl + · exact ⟨0, Or.inl rfl, by rfl⟩ + · exact ⟨-1, Or.inr (Or.inr (Or.inl rfl)), by + ext <;> norm_num [BandPackingSymmetryVectorAction, + GaussianReflection]⟩ + · exact ⟨1, Or.inr (Or.inl rfl), by + ext <;> norm_num [BandPackingSymmetryVectorAction, + GaussianReflection]⟩ + · exact ⟨⟨0, 1⟩, Or.inr (Or.inr (Or.inr (Or.inl rfl))), by + ext <;> norm_num [BandPackingSymmetryVectorAction, + GaussianReflection]⟩ + · exact ⟨-⟨0, 1⟩, Or.inr (Or.inr (Or.inr (Or.inr rfl))), by + ext <;> norm_num [BandPackingSymmetryVectorAction, + GaussianReflection]⟩ + | comp a b iha ihb => + intro d hd + obtain ⟨d₁, hd₁, ha⟩ := iha d hd + obtain ⟨d₀, hd₀, hb⟩ := ihb d₁ hd₁ + refine ⟨d₀, hd₀, ?_⟩ + simp only [BandPackingSymmetryVectorAction, hb, ha] + have action_domain_mem (a : BandPackingSymmetry) (f : PartialOdometer) + (z : GaussianInt) (hz : z ∈ f.domain) : + BandPackingSymmetryVectorAction a z ∈ + (BandPackingSymmetryPartialOdometerAction a f).domain := by + have hd := (BandPackingSymmetryPartialOdometerActionFormulas a f f).1 + have hzset : BandPackingSymmetryVectorAction a z ∈ + ((BandPackingSymmetryPartialOdometerAction a f).domain : + Set GaussianInt) := by + rw [hd] + exact ⟨z, hz, rfl⟩ + exact hzset + have hstarBarDomain : ∀ y, + y = xbar ∨ y = xbar + 1 ∨ y = xbar - 1 ∨ + y = xbar + ⟨0, 1⟩ ∨ y = xbar - ⟨0, 1⟩ → + y ∈ hbar.domain ∨ y ∈ kbar.domain := by + intro y hy + have hdelta : ∃ d, Axial d ∧ y = xbar + d := by + rcases hy with rfl | rfl | rfl | rfl | rfl + · exact ⟨0, Or.inl rfl, by simp⟩ + · exact ⟨1, Or.inr (Or.inl rfl), rfl⟩ + · exact ⟨-1, Or.inr (Or.inr (Or.inl rfl)), by ring⟩ + · exact ⟨⟨0, 1⟩, Or.inr (Or.inr (Or.inr (Or.inl rfl))), rfl⟩ + · exact ⟨-⟨0, 1⟩, Or.inr (Or.inr (Or.inr (Or.inr rfl))), by ring⟩ + obtain ⟨d, hd, rfl⟩ := hdelta + obtain ⟨d₀, hd₀, hgd⟩ := axial_preimage g d hd + have hsource : x + d₀ ∈ h.domain ∨ x + d₀ ∈ k.domain := by + apply hstar (x + d₀) + rcases hd₀ with rfl | rfl | rfl | rfl | rfl + · left; simp + · exact Or.inr (Or.inl rfl) + · exact Or.inr (Or.inr (Or.inl (by ring))) + · exact Or.inr (Or.inr (Or.inr (Or.inl rfl))) + · exact Or.inr (Or.inr (Or.inr (Or.inr (by ring)))) + have hsum := vector_add g x d₀ + rcases hsource with hh | hk + · left + change BandPackingSymmetryVectorAction g x + d ∈ + (BandPackingSymmetryPartialOdometerAction g h).domain + rw [← hgd, ← hsum] + exact action_domain_mem g h (x + d₀) hh + · right + change BandPackingSymmetryVectorAction g x + d ∈ + (BandPackingSymmetryPartialOdometerAction g k).domain + rw [← hgd, ← hsum] + exact action_domain_mem g k (x + d₀) hk + exact hstarBarDomain + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5662T1TriangulationBarycentricCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P5662T1TriangulationBarycentricCoordinates.lean new file mode 100644 index 0000000000..5c3444bfb7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5662T1TriangulationBarycentricCoordinates.lean @@ -0,0 +1,180 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3381T1PairedTriangulation +public import LeanPool.ApollonianSuperharmonic.P3381T1AffineTriangleMap +public import Mathlib.Analysis.Convex.Combination +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.NormNum + +-- [TABLET NODE: P5662T1TriangulationBarycentricCoordinates] + +/-! +# P5662T1TriangulationBarycentricCoordinates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5662T1TriangulationBarycentricCoordinates {n : Nat} + (p : P3381T1PolygonBoundary n) (X K : Set (Real × Real)) + (t : P3381T1PairedTriangulation p X K) : + (∃ b : Fin t.count → (Real × Real) → Fin 3 → Real, + (∀ k z, (∑ j, b k z j) = 1) ∧ + (∀ k z, (∑ j, b k z j • p.vertex (t.face k j)) = z) ∧ + (∀ k w, (∑ j, w j) = 1 → + b k (∑ j, w j • p.vertex (t.face k j)) = w) ∧ + (∀ k j, Continuous (fun z => b k z j)) ∧ + (∀ k z, z ∈ convexHull Real (Set.range (p.vertex ∘ t.face k)) ↔ + ∀ j, 0 ≤ b k z j) ∧ + (∀ k i, b k (p.vertex (t.face k i)) = Pi.single i 1) ∧ + (∀ k l z, z ∈ convexHull Real + (p.vertex '' (Set.range (t.face k) ∩ Set.range (t.face l))) → + ∀ j, t.face k j ∉ Set.range (t.face l) → b k z j = 0)) ∧ + (∀ i k, + p.vertex i ∈ convexHull Real (Set.range (p.vertex ∘ t.face k)) ↔ + i ∈ Set.range (t.face k)) := by +-- BODY + have coordinates : + ∃ b : Fin t.count → (Real × Real) → Fin 3 → Real, + (∀ k z, (∑ j, b k z j) = 1) ∧ + (∀ k z, (∑ j, b k z j • p.vertex (t.face k j)) = z) ∧ + (∀ k w, (∑ j, w j) = 1 → + b k (∑ j, w j • p.vertex (t.face k j)) = w) ∧ + (∀ k j, Continuous (fun z => b k z j)) ∧ + (∀ k z, z ∈ convexHull Real (Set.range (p.vertex ∘ t.face k)) ↔ + ∀ j, 0 ≤ b k z j) ∧ + (∀ k i, b k (p.vertex (t.face k i)) = Pi.single i 1) ∧ + (∀ k l z, z ∈ convexHull Real + (p.vertex '' (Set.range (t.face k) ∩ Set.range (t.face l))) → + ∀ j, t.face k j ∉ Set.range (t.face l) → b k z j = 0) := by + classical + let standard : Fin 3 → Real × Real := ![(0, 0), (1, 0), (0, 1)] + have hstandard : P3381T1TriangleDeterminant standard ≠ 0 := by + change ((1 : Real) - 0) * (1 - 0) - (0 - 0) * (0 - 0) ≠ 0 + norm_num + have maps : ∀ k, ∃ A : (Real × Real) ≃ₜ (Real × Real), + ∀ w : Fin 3 → Real, (∑ j, w j) = 1 → + A (∑ j, w j • standard j) = ∑ j, w j • p.vertex (t.face k j) := by + intro k + exact P3381T1AffineTriangleMap standard (p.vertex ∘ t.face k) + hstandard (t.source_nondegenerate k) + choose A hA using maps + let weights (z : Real × Real) : Fin 3 → Real := ![1 - z.1 - z.2, z.1, z.2] + have weights_sum (z : Real × Real) : (∑ j, weights z j) = 1 := by + rw [Fin.sum_univ_three] + change (1 - z.1 - z.2) + z.1 + z.2 = 1 + ring + have standard_sum (w : Fin 3 → Real) : + (∑ j, w j • standard j) = (w 1, w 2) := by + apply Prod.ext <;> simp [Fin.sum_univ_three, standard] + have weights_sum_standard (z : Real × Real) : + (∑ j, weights z j • standard j) = z := by + rw [standard_sum] + rfl + let b (k : Fin t.count) (z : Real × Real) := weights ((A k).symm z) + have bsum k z : (∑ j, b k z j) = 1 := weights_sum _ + have breconstruct k z : (∑ j, b k z j • p.vertex (t.face k j)) = z := by + rw [← hA k _ (bsum k z), weights_sum_standard] + exact (A k).apply_symm_apply z + have bunique k (w : Fin 3 → Real) (hw : (∑ j, w j) = 1) : + b k (∑ j, w j • p.vertex (t.face k j)) = w := by + rw [← hA k w hw] + change weights ((A k).symm (A k _)) = w + rw [(A k).symm_apply_apply, standard_sum] + funext j + fin_cases j <;> simp [weights] + simp only [Fin.sum_univ_three] at hw + linarith + have bcontinuous k j : Continuous (fun z => b k z j) := by + fin_cases j <;> dsimp [b, weights] + all_goals fun_prop + have hull_weights (S : Set (Fin (n + 3))) k (hS : S ⊆ Set.range (t.face k)) z + (hz : z ∈ convexHull Real (p.vertex '' S)) : + (∀ j, 0 ≤ b k z j) ∧ (∀ j, t.face k j ∉ S → b k z j = 0) := by + obtain ⟨ι, inst, w, v, hw, hsum, hv, heq⟩ := + mem_convexHull_iff_exists_fintype.mp hz + let _ := inst + choose a ha hva using hv + have ha' : ∀ r, ∃ j, t.face k j = a r := fun r => hS (ha r) + choose c hc using ha' + let W : Fin 3 → Real := fun j => ∑ r, if c r = j then w r else 0 + have hW : (∑ j, W j) = 1 := by + simpa [W, Finset.sum_comm] using hsum + have hWz : (∑ j, W j • p.vertex (t.face k j)) = z := by + simp [W, Finset.sum_smul, Finset.sum_comm, ite_smul, hc, hva, heq] + have hbW : b k z = W := hWz ▸ bunique k W hW + rw [hbW] + constructor + · intro j + exact Finset.sum_nonneg fun r _ => by + split_ifs + · exact hw r + · exact le_rfl + · intro j hj + apply Finset.sum_eq_zero + intro r _ + have hne : c r ≠ j := by + intro h + apply hj + rw [← h, hc] + exact ha r + simp [hne] + refine ⟨b, bsum, breconstruct, bunique, bcontinuous, ?_, ?_, ?_⟩ + · intro k z + constructor + · intro hz + rw [Set.range_comp] at hz + exact (hull_weights _ k (Set.Subset.refl _) z hz).1 + · intro hz + exact mem_convexHull_of_exists_fintype (b k z) (p.vertex ∘ t.face k) + hz (bsum k z) (fun j => Set.mem_range_self j) (breconstruct k z) + · intro k i + let w : Fin 3 → Real := Pi.single i 1 + have hsum : (∑ j : Fin 3, w j) = 1 := by simp [w] + have heq : (∑ j : Fin 3, w j • + p.vertex (t.face k j)) = p.vertex (t.face k i) := by simp [w] + rw [← heq] + exact bunique k _ hsum + · intro k l z hz j hj + exact (hull_weights _ k Set.inter_subset_left z hz).2 j (by + intro h + exact hj h.2) + have vertex_incidence : ∀ i k, + p.vertex i ∈ convexHull Real (Set.range (p.vertex ∘ t.face k)) ↔ + i ∈ Set.range (t.face k) := by + obtain ⟨b, bsum, breconstruct, bunique, bcontinuous, bhull, bvertex, bcommon⟩ := + coordinates + let D k := convexHull Real (Set.range (p.vertex ∘ t.face k)) + intro i k + constructor + · intro hik + obtain ⟨l, j, hlj⟩ := t.vertex_used i + have hil : p.vertex i ∈ D l := by + apply subset_convexHull + exact ⟨j, congrArg p.vertex hlj⟩ + have hic : p.vertex i ∈ convexHull Real + (p.vertex '' (Set.range (t.face l) ∩ Set.range (t.face k))) := by + rw [← t.source_intersection] + exact ⟨hil, hik⟩ + by_contra hi + have hzero := bcommon l k (p.vertex i) hic j (hlj ▸ hi) + have hone : b l (p.vertex i) j = 1 := by + rw [← hlj, bvertex] + simp + linarith + · rintro ⟨j, rfl⟩ + exact subset_convexHull Real _ ⟨j, rfl⟩ + exact ⟨coordinates, vertex_incidence⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5667T1CyclicChildrenOldArcsPreconnected.lean b/LeanPool/ApollonianSuperharmonic/P5667T1CyclicChildrenOldArcsPreconnected.lean new file mode 100644 index 0000000000..7127ba5b91 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5667T1CyclicChildrenOldArcsPreconnected.lean @@ -0,0 +1,276 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3650T1CyclicChildren +public import Mathlib.Analysis.Convex.PathConnected +public import Mathlib.Analysis.Convex.Topology + +-- [TABLET NODE: P5667T1CyclicChildrenOldArcsPreconnected] + +/-! +# P5667T1CyclicChildrenOldArcsPreconnected + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OldArcs + +private theorem chainUnionPreconnected {X : Type} [TopologicalSpace X] {m : Nat} + (S : Fin (m + 1) → Set X) (hpre : ∀ i, IsPreconnected (S i)) + (hadj : ∀ i : Fin m, (S i.castSucc ∩ S i.succ).Nonempty) : + IsPreconnected (⋃ i, S i) := by + classical + let R : Fin (m + 1) → Fin (m + 1) → Prop := fun i j => (S i ∩ S j).Nonempty + have hsymm : ∀ i j, R i j → R j i := by + intro i j h + rcases h with ⟨x, hxi, hxj⟩ + exact ⟨x, hxj, hxi⟩ + have hreach : ∀ k : Nat, ∀ hk : k < m + 1, + Relation.ReflTransGen R (0 : Fin (m + 1)) ⟨k, hk⟩ := by + intro k + induction k with + | zero => intro hk; exact Relation.ReflTransGen.refl + | succ k ih => + intro hk + have hk' : k < m + 1 := by omega + have hprev := ih hk' + have hi : k < m := by omega + let i : Fin m := ⟨k, hi⟩ + let j : Fin (m + 1) := ⟨k + 1, hk⟩ + have hstep : R (⟨k, hk'⟩ : Fin (m + 1)) j := by + simpa [R, i, j] using hadj i + simpa [j] using Relation.ReflTransGen.tail hprev hstep + have hreachSymm : ∀ i j, Relation.ReflTransGen R i j → + Relation.ReflTransGen R j i := by + intro i j hij + induction hij with + | refl => exact Relation.ReflTransGen.refl + | @tail k l hkl hs ih => + exact (Relation.ReflTransGen.single (hsymm k l hs)).trans ih + have hconn : ∀ i j : Fin (m + 1), Relation.ReflTransGen R i j := by + intro i j + have hi := hreach i.val i.isLt + have hj := hreach j.val j.isLt + exact (hreachSymm _ _ hi).trans (by simpa using hj) + exact IsPreconnected.iUnion_of_reflTransGen hpre hconn + +private theorem segmentSdiffPreconnected (a b : Real × Real) + (z : Set (Real × Real)) + (hdisj : Disjoint (openSegment Real a b) z) : + IsPreconnected (segment Real a b \ z) := by + classical + have hs : IsPreconnected (openSegment Real a b) := + (convex_openSegment (𝕜 := Real) a b).isPreconnected + apply IsPreconnected.subset_closure hs + · intro x hx + exact ⟨openSegment_subset_segment Real a b hx, + fun hxz => Set.disjoint_left.mp hdisj hx hxz⟩ + · intro x hx + exact (segment_subset_closure_openSegment (𝕜 := Real) (x := a) (y := b)) hx.1 + +private theorem polygonOldArcPreconnected {m : Nat} (q : P3381T1PolygonBoundary m) : + IsPreconnected (P3544T1BoundaryCarrier q \ + segment Real (q.vertex 0) (q.vertex (Fin.last (m + 2)))) := by + classical + have chainUnionPreconnected {X : Type} [TopologicalSpace X] {m : Nat} + (S : Fin (m + 1) → Set X) (hpre : ∀ i, IsPreconnected (S i)) + (hadj : ∀ i : Fin m, (S i.castSucc ∩ S i.succ).Nonempty) : + IsPreconnected (⋃ i, S i) := chainUnionPreconnected (X := X) (m := m) S hpre hadj + have segmentSdiffPreconnected (a b : Real × Real) + (z : Set (Real × Real)) + (hdisj : Disjoint (openSegment Real a b) z) : + IsPreconnected (segment Real a b \ z) := segmentSdiffPreconnected a b z hdisj + classical + let last : Fin (m + 3) := Fin.last (m + 2) + let e : Set (Real × Real) := segment Real (q.vertex last) (q.vertex 0) + have hlast : last + 1 = (0 : Fin (m + 3)) := by + apply Fin.ext + simp [last] + let edge : Fin (m + 2) → Set (Real × Real) := fun i => + segment Real (q.vertex i.castSucc) (q.vertex i.succ) + have hnext (i : Fin (m + 2)) : i.castSucc + 1 = i.succ := by + apply Fin.ext + simp [] + have hcarrier : P3544T1BoundaryCarrier q = (⋃ i, edge i) ∪ e := by + ext x + simp only [P3544T1BoundaryCarrier, Set.mem_iUnion, Set.mem_union] + constructor + · rintro ⟨i, hx⟩ + cases i using Fin.lastCases with + | last => right; simpa [e, last, hlast] using hx + | cast j => + left + refine ⟨j, ?_⟩ + simpa [edge, hnext] using hx + · rintro (⟨i, hx⟩ | hx) + · exact ⟨i.castSucc, by simpa [edge, hnext] using hx⟩ + · exact ⟨last, by simpa [e, last, hlast] using hx⟩ + have hopenDisjoint (i : Fin (m + 2)) : + Disjoint (openSegment Real (q.vertex i.castSucc) (q.vertex i.succ)) e := by + have hidx : i.castSucc ≠ last := by + intro heq + have hv := congrArg Fin.val heq + simp [last] at hv + omega + have hlaw := q.edge_intersection i.castSucc last hidx + rw [hnext, hlast] at hlaw + apply Set.disjoint_left.mpr + intro x hxopen hxe + have hxi : x ∈ segment Real (q.vertex i.castSucc) (q.vertex i.succ) := + openSegment_subset_segment Real _ _ hxopen + have hpair : x ∈ segment Real (q.vertex i.castSucc) (q.vertex i.succ) ∩ e := + ⟨hxi, hxe⟩ + rw [hlaw] at hpair + rcases hpair.1 with hxleft | hxright + · have heq : q.vertex i.castSucc = q.vertex i.succ := + left_mem_openSegment_iff.mp (hxleft ▸ hxopen) + have hi : i.castSucc = i.succ := q.injective heq + have hv := congrArg Fin.val hi + simp [Fin.succ, Fin.castSucc] at hv + · have heq : q.vertex i.succ = q.vertex i.castSucc := + (right_mem_openSegment_iff.mp (hxright ▸ hxopen)).symm + have hi : i.succ = i.castSucc := q.injective heq + have hv := congrArg Fin.val hi + simp [Fin.succ, Fin.castSucc] at hv + have hpieces (i : Fin (m + 2)) : IsPreconnected (edge i \ e) := + segmentSdiffPreconnected (q.vertex i.castSucc) (q.vertex i.succ) e (hopenDisjoint i) + have hadj (i : Fin (m + 1)) : + ((edge i.castSucc \ e) ∩ (edge i.succ \ e)).Nonempty := by + let j : Fin (m + 3) := i.succ.castSucc + have hidx : j ≠ last := by + intro heq + have hv := congrArg Fin.val heq + simp [j, last] at hv + omega + have hnext' : j + 1 = ⟨i.val + 2, by omega⟩ := by + apply Fin.ext + have hj : j.val = i.val + 1 := by simp [j] + have hlt : j.val + 1 < m + 3 := by rw [hj]; omega + change (j.val + 1) % (m + 3) = i.val + 2 + rw [Nat.mod_eq_of_lt hlt, hj] + have hlaw := q.edge_intersection j last hidx + rw [hnext', hlast] at hlaw + have hnot : q.vertex j ∉ e := by + intro hx + have hmem : q.vertex j ∈ segment Real (q.vertex j) + (q.vertex ⟨i.val + 2, by omega⟩) ∩ e := + ⟨left_mem_segment Real _ _, hx⟩ + rw [hlaw] at hmem + rcases hmem.2 with h | h + · have heq : j = last := q.injective h + have hv := congrArg Fin.val heq + simp [j, last] at hv + omega + · have heq : j = 0 := q.injective h + have hv := congrArg Fin.val heq + simp [j] at hv + refine ⟨q.vertex (i.succ.castSucc), ?_, ?_⟩ + · exact ⟨right_mem_segment Real _ _, hnot⟩ + · exact ⟨left_mem_segment Real _ _, hnot⟩ + have hpre : IsPreconnected (⋃ i : Fin (m + 2), edge i \ e) := + chainUnionPreconnected (fun i => edge i \ e) hpieces hadj + have hdecomp : ((⋃ i : Fin (m + 2), edge i) ∪ e) \ e = + ⋃ i : Fin (m + 2), edge i \ e := by + ext x + simp [Set.mem_iUnion] + have heq : segment Real (q.vertex 0) (q.vertex last) = e := + segment_symm Real _ _ + rw [heq, hcarrier, hdecomp] + exact hpre + +end OldArcs + +theorem P5667T1CyclicChildrenOldArcsPreconnected {n : Nat} (p : P3381T1PolygonBoundary n) + (a b : Fin (n + 3)) (C : P3650T1CyclicChildren p a b) : + IsPreconnected + (P3544T1BoundaryCarrier C.left \ segment Real (p.vertex a) (p.vertex b)) ∧ + IsPreconnected + (P3544T1BoundaryCarrier C.right \ segment Real (p.vertex a) (p.vertex b)) := by +-- BODY + classical + let e := segment Real (p.vertex a) (p.vertex b) + let CL := P3544T1BoundaryCarrier C.left + let CR := P3544T1BoundaryCarrier C.right + have chainUnionPreconnected {X : Type} [TopologicalSpace X] {m : Nat} + (S : Fin (m + 1) → Set X) (hpre : ∀ i, IsPreconnected (S i)) + (hadj : ∀ i : Fin m, (S i.castSucc ∩ S i.succ).Nonempty) : + IsPreconnected (⋃ i, S i) := OldArcs.chainUnionPreconnected (X := X) (m := m) S hpre hadj + have segmentSdiffPreconnected (a b : Real × Real) + (z : Set (Real × Real)) + (hdisj : Disjoint (openSegment Real a b) z) : + IsPreconnected (segment Real a b \ z) := OldArcs.segmentSdiffPreconnected a b z hdisj + have polygonOldArcPreconnected {m : Nat} (q : P3381T1PolygonBoundary m) : + IsPreconnected (P3544T1BoundaryCarrier q \ + segment Real (q.vertex 0) (q.vertex (Fin.last (m + 2)))) := + OldArcs.polygonOldArcPreconnected (m := m) q + have leftArcPreconnected : IsPreconnected (CL \ e) := by + have hfirst : C.il 0 = a := by + have h := congrArg List.head? C.left_order + simpa using h + have hlast : C.il (Fin.last (C.left_n + 2)) = b := by + have hlast? : (List.ofFn C.il).getLast? = some (C.il (Fin.last _)) := by + rw [List.getLast?_eq_getLast_of_ne_nil (by simp)] + rw [List.getLast_ofFn_succ] + have h := congrArg List.getLast? C.left_order + rw [hlast?] at h + have hrhs : (a :: (C.u ++ [b])).getLast? = some b := by + rw [show a :: (C.u ++ [b]) = [a] ++ (C.u ++ [b]) by simp] + rw [List.getLast?_append_of_ne_nil _ (by simp)] + rw [List.getLast?_append_of_ne_nil _ (by simp)] + simp + rw [hrhs] at h + exact Option.some.inj h + have hvfirst : C.left.vertex 0 = p.vertex a := by + rw [C.left_vertex] + simpa using congrArg p.vertex hfirst + have hvlast : C.left.vertex (Fin.last (C.left_n + 2)) = p.vertex b := by + rw [C.left_vertex] + simpa using congrArg p.vertex hlast + have hq := polygonOldArcPreconnected C.left + have heq : segment Real (C.left.vertex 0) + (C.left.vertex (Fin.last (C.left_n + 2))) = e := by + rw [hvfirst, hvlast] + simpa [CL, e, heq] using hq + have rightArcPreconnected : IsPreconnected (CR \ e) := by + have hfirst : C.ir 0 = b := by + have h := congrArg List.head? C.right_order + simpa using h + have hlast : C.ir (Fin.last (C.right_n + 2)) = a := by + have hlast? : (List.ofFn C.ir).getLast? = some (C.ir (Fin.last _)) := by + rw [List.getLast?_eq_getLast_of_ne_nil (by simp)] + rw [List.getLast_ofFn_succ] + have h := congrArg List.getLast? C.right_order + rw [hlast?] at h + have hrhs : (b :: (C.v ++ [a])).getLast? = some a := by + rw [show b :: (C.v ++ [a]) = [b] ++ (C.v ++ [a]) by simp] + rw [List.getLast?_append_of_ne_nil _ (by simp)] + rw [List.getLast?_append_of_ne_nil _ (by simp)] + simp + rw [hrhs] at h + exact Option.some.inj h + have hvfirst : C.right.vertex 0 = p.vertex b := by + rw [C.right_vertex] + simpa using congrArg p.vertex hfirst + have hvlast : C.right.vertex (Fin.last (C.right_n + 2)) = p.vertex a := by + rw [C.right_vertex] + simpa using congrArg p.vertex hlast + have hq := polygonOldArcPreconnected C.right + have heq : segment Real (C.right.vertex 0) + (C.right.vertex (Fin.last (C.right_n + 2))) = e := by + rw [hvfirst, hvlast] + exact segment_symm Real _ _ + simpa [CR, e, heq] using hq + exact ⟨leftArcPreconnected, rightArcPreconnected⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5667T1RoundedSupportingSlope.lean b/LeanPool/ApollonianSuperharmonic/P5667T1RoundedSupportingSlope.lean new file mode 100644 index 0000000000..c34f0d0884 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5667T1RoundedSupportingSlope.lean @@ -0,0 +1,202 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm + +-- [TABLET NODE: P5667T1RoundedSupportingSlope] + +/-! +# P5667T1RoundedSupportingSlope + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5667T1RoundedSupportingSlope + (A : Matrix (Fin 2) (Fin 2) Real) (hA : A.IsSymm) + (hpsd : A.PosSemidef) (x : GaussianInt) : + ∃ p : GaussianInt, ∀ y : GaussianInt, + Int.ceil (LatticeQuadraticForm A x - + ((abs x.re + abs x.im : Int) : Real) - 1 - + p.re * x.re - p.im * x.im) ≤ + Int.floor (LatticeQuadraticForm A y + + ((abs y.re + abs y.im : Int) : Real)) - + p.re * y.re - p.im * y.im := by +-- BODY + have q_nonneg : ∀ z, 0 ≤ LatticeQuadraticForm A z := by + intro z + have hz := hpsd.dotProduct_mulVec_nonneg + (![ (z.re : Real), (z.im : Real) ] : Fin 2 → Real) + simpa [LatticeQuadraticForm, dotProduct, Matrix.mulVec, Fin.sum_univ_two] + using hz + let vx : Fin 2 → Real := ![(x.re : Real), (x.im : Real)] + let ax : Fin 2 → Real := Matrix.mulVec A vx + let p : GaussianInt := + ⟨Int.floor (ax 0 + (1 / 2 : Real)), + Int.floor (ax 1 + (1 / 2 : Real))⟩ + have round0 : |(p.re : Real) - ax 0| ≤ (1 / 2 : Real) := by + dsimp [p] + have h₁ := Int.floor_le (ax 0 + (1 / 2 : Real)) + have h₂ := Int.lt_floor_add_one (ax 0 + (1 / 2 : Real)) + rw [abs_le] + constructor <;> linarith + have round1 : |(p.im : Real) - ax 1| ≤ (1 / 2 : Real) := by + dsimp [p] + have h₁ := Int.floor_le (ax 1 + (1 / 2 : Real)) + have h₂ := Int.lt_floor_add_one (ax 1 + (1 / 2 : Real)) + rw [abs_le] + constructor <;> linarith + have qconvex : ∀ y : GaussianInt, + LatticeQuadraticForm A x + + (Matrix.mulVec A vx) 0 * ((y.re : Real) - x.re) + + (Matrix.mulVec A vx) 1 * ((y.im : Real) - x.im) ≤ + LatticeQuadraticForm A y := by + intro y + have hy := q_nonneg (y - x) + have hs : A 0 1 = A 1 0 := by + exact (congrFun (congrFun hA.eq 0) 1).symm + dsimp [LatticeQuadraticForm, vx] at hy ⊢ + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, hs] at hy ⊢ + nlinarith + have lower_energy : ∀ y, + Int.ceil (LatticeQuadraticForm A x - + ((abs x.re + abs x.im : Int) : Real) - 1 - + p.re * x.re - p.im * x.im) ≤ + Int.floor (LatticeQuadraticForm A y + + ((abs y.re + abs y.im : Int) : Real)) - + p.re * y.re - p.im * y.im := by + intro y + have hfloor := (Int.sub_one_lt_floor (LatticeQuadraticForm A y + + ((abs y.re + abs y.im : Int) : Real))).le + have hconv := qconvex y + have hconv0 := hconv + have hi : Int.ceil (LatticeQuadraticForm A x - + ((abs x.re + abs x.im : Int) : Real) - 1 - + p.re * x.re - p.im * x.im) ≤ + Int.floor (LatticeQuadraticForm A y + + ((abs y.re + abs y.im : Int) : Real)) - + p.re * y.re - p.im * y.im := by + rw [Int.ceil_le] + have hxi : (0 : Real) ≤ abs (x.re : Real) := abs_nonneg _ + have hyi : (0 : Real) ≤ abs (y.re : Real) := abs_nonneg _ + have hxm : (0 : Real) ≤ abs (x.im : Real) := abs_nonneg _ + have hym : (0 : Real) ≤ abs (y.im : Real) := abs_nonneg _ + have h0 : |((p.re : Real) - (Matrix.mulVec A vx) 0) * ((x.re : Real) - y.re)| ≤ + (1 / 2 : Real) * (abs x.re + abs y.re) := by + have := mul_le_mul_of_nonneg_right round0 (abs_nonneg ((x.re : Real) - y.re)) + have ht : |(x.re : Real) - y.re| ≤ abs x.re + abs y.re := by + have ht' := abs_sub_le (x.re : Real) 0 (y.re : Real) + norm_num [Int.cast_abs, abs_sub_comm, add_comm] at ht' ⊢ + exact ht' + have h0a : |(p.re : Real) - ax 0| * |(x.re : Real) - y.re| ≤ + (1 / 2 : Real) * (abs x.re + abs y.re) := by + nlinarith [this] + simpa [ax] using h0a + have h1 : |((p.im : Real) - (Matrix.mulVec A vx) 1) * ((x.im : Real) - y.im)| ≤ + (1 / 2 : Real) * (abs x.im + abs y.im) := by + have := mul_le_mul_of_nonneg_right round1 (abs_nonneg ((x.im : Real) - y.im)) + have ht : |(x.im : Real) - y.im| ≤ abs x.im + abs y.im := by + have ht' := abs_sub_le (x.im : Real) 0 (y.im : Real) + norm_num [Int.cast_abs, abs_sub_comm, add_comm] at ht' ⊢ + exact ht' + have h1a : |(p.im : Real) - ax 1| * |(x.im : Real) - y.im| ≤ + (1 / 2 : Real) * (abs x.im + abs y.im) := by + nlinarith [this] + simpa [ax] using h1a + have hxa : (0 : Real) ≤ (abs x.re + abs x.im : Int) := by + exact_mod_cast (add_nonneg (abs_nonneg x.re) (abs_nonneg x.im)) + have hya : (0 : Real) ≤ (abs y.re + abs y.im : Int) := by + exact_mod_cast (add_nonneg (abs_nonneg y.re) (abs_nonneg y.im)) + have herr : -( + |((p.re : Real) - (Matrix.mulVec A vx) 0) * ((x.re : Real) - y.re)| + + |((p.im : Real) - (Matrix.mulVec A vx) 1) * ((x.im : Real) - y.im)|) ≤ + ((p.re : Real) - (Matrix.mulVec A vx) 0) * ((x.re : Real) - y.re) + + ((p.im : Real) - (Matrix.mulVec A vx) 1) * ((x.im : Real) - y.im) := by + have habs := abs_add_le + (((p.re : Real) - (Matrix.mulVec A vx) 0) * ((x.re : Real) - y.re)) + (((p.im : Real) - (Matrix.mulVec A vx) 1) * ((x.im : Real) - y.im)) + have hnon := neg_le_of_abs_le habs + linarith + norm_num [Int.cast_sub, Int.cast_mul] at hconv ⊢ + simp only [GaussianInt.toComplex_def] at hconv hfloor ⊢ + norm_num at hconv hfloor ⊢ + try ring_nf at hconv hfloor ⊢ + have hab : + |((p.re : Real) - (Matrix.mulVec A vx) 0) * ((x.re : Real) - y.re)| + + |((p.im : Real) - (Matrix.mulVec A vx) 1) * ((x.im : Real) - y.im)| ≤ + (1 / 2 : Real) * (abs x.re + abs x.im + abs y.re + abs y.im) := by + calc + _ ≤ (1 / 2 : Real) * (abs x.re + abs y.re) + + (1 / 2 : Real) * (abs x.im + abs y.im) := add_le_add h0 h1 + _ = _ := by ring + norm_num [Complex.mul_re, Complex.mul_im] at hconv hfloor ⊢ + try ring_nf at hconv hfloor ⊢ + rw [← GaussianInt.intCast_re y, ← GaussianInt.intCast_im y] at hfloor hconv ⊢ + rw [← GaussianInt.intCast_re x, ← GaussianInt.intCast_im x] at hconv ⊢ + rw [← GaussianInt.intCast_re p, ← GaussianInt.intCast_im p] at ⊢ + try ring_nf at hconv ⊢ + have hmain : LatticeQuadraticForm A x ≤ + LatticeQuadraticForm A y + + (p.re : Real) * ((x.re : Real) - y.re) + + (p.im : Real) * ((x.im : Real) - y.im) + + (|((p.re : Real) - (Matrix.mulVec A vx) 0) * + ((x.re : Real) - y.re)| + + |((p.im : Real) - (Matrix.mulVec A vx) 1) * + ((x.im : Real) - y.im)|) := by + calc + LatticeQuadraticForm A x ≤ + LatticeQuadraticForm A y + + (Matrix.mulVec A vx) 0 * ((x.re : Real) - y.re) + + (Matrix.mulVec A vx) 1 * ((x.im : Real) - y.im) := by + linarith [hconv] + _ = LatticeQuadraticForm A y + + (p.re : Real) * ((x.re : Real) - y.re) + + (p.im : Real) * ((x.im : Real) - y.im) - + (((p.re : Real) - (Matrix.mulVec A vx) 0) * + ((x.re : Real) - y.re) + + ((p.im : Real) - (Matrix.mulVec A vx) 1) * + ((x.im : Real) - y.im)) := by ring + _ ≤ _ := by linarith [herr] + rw [Int.cast_abs, Int.cast_abs, Int.cast_abs, Int.cast_abs] at hab + have hsum : + |((p.re : Real) - (Matrix.mulVec A vx) 0) * + ((x.re : Real) - y.re)| + + |((p.im : Real) - (Matrix.mulVec A vx) 1) * + ((x.im : Real) - y.im)| ≤ + |(x.re : Real)| + |(x.im : Real)| + + |(y.re : Real)| + |(y.im : Real)| := by + nlinarith [hab, hxi, hyi, hxm, hym] + have hfinal : LatticeQuadraticForm A x ≤ + 1 + (Int.floor (LatticeQuadraticForm A y + + |(y.re : Real)| + |(y.im : Real)|) : Real) + + (p.re : Real) * ((x.re : Real) - y.re) + + (p.im : Real) * ((x.im : Real) - y.im) + + |(x.re : Real)| + |(x.im : Real)| := by + nlinarith [hmain, hfloor, hsum] + have polynomial_eq : + 1 + (Int.floor (LatticeQuadraticForm A y + + |(y.re : Real)| + |(y.im : Real)|) : Real) + + (p.re : Real) * ((x.re : Real) - y.re) + + (p.im : Real) * ((x.im : Real) - y.im) + + |(x.re : Real)| + |(x.im : Real)| = + 1 - (y.re : Real) * p.re + (x.re : Real) * p.re - + (y.im : Real) * p.im + (x.im : Real) * p.im + + (Int.floor (LatticeQuadraticForm A y + + |(y.re : Real)| + |(y.im : Real)|) : Real) + + |(x.re : Real)| + |(x.im : Real)| := by ring + rw [polynomial_eq] at hfinal + exact hfinal + exact_mod_cast hi + exact ⟨p, lower_energy⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean b/LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean new file mode 100644 index 0000000000..ecf211ff4c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean @@ -0,0 +1,970 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3934T1LocalSide +public import LeanPool.ApollonianSuperharmonic.P3934T1SectorSelection +public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectors + +-- [TABLET NODE: P5667T1StraightFrontierLocalSides] + +/-! +# P5667T1StraightFrontierLocalSides + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace StraightFrontierProof + +private theorem scaleLocalSide : + (by + classical + exact + ∀ (W : Set (ℝ × ℝ)), ∀ (z : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (c : ℝ), ∀ (e : Bool), (0 : ℝ) < c → + P3934T1LocalSide W z w e → P3934T1LocalSide W z (c • w) e + ) := by + classical + intro W z w c e hc hside + obtain ⟨r, hr, heq⟩ := hside + refine ⟨r, hr, ?_⟩ + have hdet (q : Real × Real) : + (c • w).1 * (q.2 - z.2) - (c • w).2 * (q.1 - z.1) = + c * (w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1)) := by + simp only [Prod.smul_fst, Prod.smul_snd] + ring + ext q + rw [heq] + simp only [Set.mem_ofPred_eq] + rw [hdet q] + constructor + · rintro ⟨hq, hs⟩ + refine ⟨hq, ?_⟩ + cases e <;> simp at hs ⊢ <;> + nlinarith [hc] + · rintro ⟨hq, hs⟩ + refine ⟨hq, ?_⟩ + cases e <;> simp at hs ⊢ <;> + nlinarith [hc] + +private theorem hcol : + (by + classical + exact + ∀ (B : Real × Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + (d ≠ (0, 0)) → (∀ (y : ℝ × ℝ), d.1 * y.2 - d.2 * y.1 = (0 : ℝ) → ∃ (c : ℝ), y = c • d) + ) := by + classical + intro B n d hdnz y hy + have hcoord : d.1 ≠ 0 ∨ d.2 ≠ 0 := by + by_contra h + push Not at h + apply hdnz + ext <;> simp [h.1, h.2] + rcases hcoord with h1 | h2 + · refine ⟨y.1 / d.1, ?_⟩ + ext + · simp [h1] + · dsimp + field_simp + nlinarith [hy] + · refine ⟨y.2 / d.2, ?_⟩ + ext + · dsimp + field_simp [h2] + nlinarith [hy] + · simp [h2] + +private theorem hDleft : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + let ray : Set (Real × Real) := + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)} ∪ + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • d} + ∀ (E : P3889T1TwoRaySectorDecomposition x r (-d) d), (∀ (y : Real × Real), (d.1 * y.2 - + d.2 * y.1 = 0) → (∃ c : Real, y = c • d)) → ((∀ (q : Real × Real), (q ∈ E.left) → (q + ∈ Metric.ball x r)) → ((∀ (q : Real × Real), (q ∈ E.left) → (q ∉ ray)) → (∀ q ∈ + E.left, D q ≠ (0 : ℝ)))) + ) := by + classical + intro x B r n d D ray E hcol hleftball hleftnotray q hq hzero + have hqball := hleftball q hq + have hy : d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) = 0 := by + simpa [D] using hzero + obtain ⟨c, hc⟩ := hcol (q - x) (by simpa using hy) + have hqline : q = x + c • d := by + calc q = x + (q - x) := by simp + _ = x + c • d := by rw [hc] + by_cases h : 0 ≤ c + · have : q ∈ ray := Or.inr ⟨c, h, hqline⟩ + exact hleftnotray q hq this + · have hqline' : q = x + (-c) • (-d) := by + have hvec : (-c) • (-d) = c • d := by simp [neg_smul] + calc + q = x + c • d := hqline + _ = x + (-c) • (-d) := by rw [← hvec] + have : q ∈ ray := Or.inl ⟨-c, neg_nonneg.mpr (le_of_lt (lt_of_not_ge h)), hqline'⟩ + exact hleftnotray q hq this + +private theorem hDright : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + let ray : Set (Real × Real) := + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)} ∪ + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • d} + ∀ (E : P3889T1TwoRaySectorDecomposition x r (-d) d), (∀ (y : Real × Real), (d.1 * y.2 - + d.2 * y.1 = 0) → (∃ c : Real, y = c • d)) → ((∀ (q : Real × Real), (q ∈ E.right) → (q + ∈ Metric.ball x r)) → ((∀ (q : Real × Real), (q ∈ E.right) → (q ∉ ray)) → (∀ q ∈ + E.right, D q ≠ (0 : ℝ)))) + ) := by + classical + intro x B r n d D ray E hcol hrightball hrightnotray q hq hzero + have hqball := hrightball q hq + have hy : d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) = 0 := by + simpa [D] using hzero + obtain ⟨c, hc⟩ := hcol (q - x) (by simpa using hy) + have hqline : q = x + c • d := by + calc q = x + (q - x) := by simp + _ = x + c • d := by rw [hc] + by_cases h : 0 ≤ c + · have : q ∈ ray := Or.inr ⟨c, h, hqline⟩ + exact hrightnotray q hq this + · have hqline' : q = x + (-c) • (-d) := by + have hvec : (-c) • (-d) = c • d := by simp [neg_smul] + calc + q = x + c • d := hqline + _ = x + (-c) • (-d) := by rw [← hvec] + have : q ∈ ray := Or.inl ⟨-c, neg_nonneg.mpr (le_of_lt (lt_of_not_ge h)), hqline'⟩ + exact hrightnotray q hq this + +private theorem hsectorSign : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + ∀ (E : P3889T1TwoRaySectorDecomposition x r (-d) d), + let pos : Set (Real × Real) := {q | 0 < D q} + let neg : Set (Real × Real) := {q | D q < 0} + (E.left ⊆ pos ∨ E.left ⊆ neg) → ((E.right ⊆ pos ∨ E.right ⊆ neg) → ( + let j : Real × Real := (-d.2, d.1) + let qpos : Real × Real := x + (r / 4) • j + let qneg : Real × Real := x - (r / 4) • j + (0 < D qpos) → ((D qneg < 0) → ((qpos ∈ E.left ∪ E.right) → ((qneg ∈ E.left ∪ E.right) → + ((E.left ⊆ pos ∧ E.right ⊆ neg) ∨ (E.left ⊆ neg ∧ E.right ⊆ pos))))))) + ) := by + classical + intro x B r n d D E pos neg hleftSign hrightSign j qpos qneg hDpos hDneg hqposCover hqnegCover + rcases hleftSign with hleftpos | hleftneg + · refine Or.inl ⟨hleftpos, ?_⟩ + rcases hrightSign with hrightpos | hrightneg + · exfalso + rcases hqnegCover with hq | hq + · exact (not_lt_of_ge (le_of_lt (hleftpos hq))) hDneg + · exact (not_lt_of_ge (le_of_lt (hrightpos hq))) hDneg + · exact hrightneg + · rcases hrightSign with hrightpos | hrightneg + · exact Or.inr ⟨hleftneg, hrightpos⟩ + · exfalso + rcases hqposCover with hq | hq + · exact (not_lt_of_ge (le_of_lt (hleftneg hq))) hDpos + · exact (not_lt_of_ge (le_of_lt (hrightneg hq))) hDpos + +private theorem sectorEq : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + let ray : Set (Real × Real) := + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)} ∪ + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • d} + (∀ (q : Real × Real), (q ∈ ray) → (D q = 0)) → ( + let pos : Set (Real × Real) := {q | 0 < D q} + let neg : Set (Real × Real) := {q | D q < 0} + ∀ (C : Set (ℝ × ℝ)), ∀ (D' : Set (ℝ × ℝ)), C ⊆ pos → D' ⊆ neg → C ⊆ Metric.ball x r → D' + ⊆ Metric.ball x r → C ∪ D' = Metric.ball x r \ ray → C = Metric.ball x r ∩ pos ∧ D' = + Metric.ball x r ∩ neg) + ) := by + classical + intro x B r n d D ray hrayzero pos neg C D' hCpos hDneg hCball hDball hCD + constructor + · apply Set.Subset.antisymm + · intro q hq + exact ⟨hCball hq, hCpos hq⟩ + · intro q hq + rcases hq with ⟨hqball, hqpos⟩ + have hc : q ∈ C ∪ D' := by + rw [hCD] + refine ⟨hqball, ?_⟩ + intro hqr + have hz := hrayzero q hqr + change 0 < D q at hqpos + change D q = 0 at hz + linarith + rcases hc with hqC | hqD + · exact hqC + · have hqneg := hDneg hqD + change D q < 0 at hqneg + exact False.elim ((not_lt_of_ge (le_of_lt hqneg)) hqpos) + · apply Set.Subset.antisymm + · intro q hq + exact ⟨hDball hq, hDneg hq⟩ + · intro q hq + rcases hq with ⟨hqball, hqneg⟩ + have hc : q ∈ C ∪ D' := by + rw [hCD] + refine ⟨hqball, ?_⟩ + intro hqr + have hz := hrayzero q hqr + change D q < 0 at hqneg + change D q = 0 at hz + linarith + rcases hc with hqC | hqD + · have hqpos := hCpos hqC + change 0 < D q at hqpos + exact False.elim ((not_lt_of_ge (le_of_lt hqpos)) hqneg) + · exact hqD + +private theorem hsectorEq : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + let ray : Set (Real × Real) := + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)} ∪ + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • d} + ∀ (E : P3889T1TwoRaySectorDecomposition x r (-d) d), (E.left ∪ E.right = Metric.ball x + r \ ray) → ((∀ (q : Real × Real), (q ∈ E.left) → (q ∈ Metric.ball x r)) → ((∀ (q : + Real × Real), (q ∈ E.right) → (q ∈ Metric.ball x r)) → ( + let pos : Set (Real × Real) := {q | 0 < D q} + let neg : Set (Real × Real) := {q | D q < 0} + ((E.left ⊆ pos ∧ E.right ⊆ neg) ∨ (E.left ⊆ neg ∧ E.right ⊆ pos)) → ((∀ (C : Set (Real × + Real)), ∀ (D' : Set (Real × Real)), (C ⊆ pos) → ((D' ⊆ neg) → ((C ⊆ Metric.ball x r) + → ((D' ⊆ Metric.ball x r) → ((C ∪ D' = Metric.ball x r \ ray) → (C = Metric.ball x r + ∩ pos ∧ D' = Metric.ball x r ∩ neg)))))) → ((E.left = Metric.ball x r ∩ pos ∧ E.right + = Metric.ball x r ∩ neg) ∨ (E.left = Metric.ball x r ∩ neg ∧ E.right = Metric.ball x + r ∩ pos)))))) + ) := by + classical + intro x B r n d D ray E hcover hleftball hrightball pos neg hsectorSign sectorEq + rcases hsectorSign with h | h + · exact Or.inl (sectorEq E.left E.right h.1 h.2 hleftball hrightball hcover) + · have hcover' : E.right ∪ E.left = Metric.ball x r \ ray := by + rw [Set.union_comm] + exact hcover + obtain ⟨hrightPos, hleftNeg⟩ := + sectorEq E.right E.left h.2 h.1 hrightball hleftball hcover' + exact Or.inr ⟨hleftNeg, hrightPos⟩ + +private theorem sidePos : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), ((0 : ℝ) < r) → ( + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + let pos : Set (Real × Real) := {q | 0 < D q} + ∀ (W : Set (ℝ × ℝ)), W ∩ Metric.ball x r = Metric.ball x r ∩ pos → P3934T1LocalSide W x + d true) + ) := by + classical + intro x B r hr n d D pos W hW + refine ⟨r, hr, ?_⟩ + change W ∩ Metric.ball x r = + {q | q ∈ Metric.ball x r ∧ 0 < + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1)} + rw [hW] + ext q + simp [pos, D] + +private theorem sideNeg : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), ((0 : ℝ) < r) → ( + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + let neg : Set (Real × Real) := {q | D q < 0} + ∀ (W : Set (ℝ × ℝ)), W ∩ Metric.ball x r = Metric.ball x r ∩ neg → P3934T1LocalSide W x + d false) + ) := by + classical + intro x B r hr n d D neg W hW + refine ⟨r, hr, ?_⟩ + change W ∩ Metric.ball x r = + {q | q ∈ Metric.ball x r ∧ + (d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1)) < 0} + rw [hW] + ext q + simp [neg, D] + +private theorem hlocal : + (by + classical + exact + ∀ (U : Set (Real × Real)), ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + ∀ (E : P3889T1TwoRaySectorDecomposition x r (-d) d), (U ∩ Metric.ball x r = E.left ∧ + (closure U)ᶜ ∩ Metric.ball x r = E.right ∨ U ∩ Metric.ball x r = E.right ∧ (closure + U)ᶜ ∩ Metric.ball x r = E.left) → ( + let pos : Set (Real × Real) := {q | 0 < D q} + let neg : Set (Real × Real) := {q | D q < 0} + ((E.left = Metric.ball x r ∩ pos ∧ E.right = Metric.ball x r ∩ neg) ∨ (E.left = + Metric.ball x r ∩ neg ∧ E.right = Metric.ball x r ∩ pos)) → ((∀ (W : Set (Real × + Real)), (W ∩ Metric.ball x r = Metric.ball x r ∩ pos) → (P3934T1LocalSide W x d + true)) → ((∀ (W : Set (Real × Real)), (W ∩ Metric.ball x r = Metric.ball x r ∩ neg) → + (P3934T1LocalSide W x d false)) → (∃ e : Bool, P3934T1LocalSide U x d e ∧ + P3934T1LocalSide (closure U)ᶜ x d (!e))))) + ) := by + classical + intro U x B r n d D E hselect pos neg hsectorEq sidePos sideNeg + rcases hselect with hs | hs + · rcases hsectorEq with heq | heq + · exact ⟨true, sidePos U (by rw [hs.1, heq.1]), + sideNeg (closure U)ᶜ (by rw [hs.2, heq.2])⟩ + · exact ⟨false, sideNeg U (by rw [hs.1, heq.1]), + sidePos (closure U)ᶜ (by rw [hs.2, heq.2])⟩ + · rcases hsectorEq with heq | heq + · exact ⟨false, sideNeg U (by rw [hs.1, heq.2]), + sidePos (closure U)ᶜ (by rw [hs.2, heq.1])⟩ + · exact ⟨true, sidePos U (by rw [hs.1, heq.2]), + sideNeg (closure U)ᶜ (by rw [hs.2, heq.1])⟩ + +end StraightFrontierProof + +namespace StraightFrontierDetails + +private theorem hBdecomp : + (by + classical + exact + ∀ (B : Real × Real), + let n : Real := ‖B‖ + (0 < n) → ( + let d : Real × Real := n⁻¹ • B + B = n • d) ) := by + classical + intro B n hn d + dsimp [d] + rw [smul_smul] + simp [n, hn.ne'] + +private theorem hd : + (by + classical + exact + ∀ (B : Real × Real), + let n : Real := ‖B‖ + (0 < n) → ( + let d : Real × Real := n⁻¹ • B + ‖d‖ = 1) ) := by + classical + intro B n hn d + dsimp [d] + rw [norm_smul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr hn)] + change n⁻¹ * n = 1 + exact inv_mul_cancel₀ hn.ne' + +private theorem hdnz : + (by + classical + exact + ∀ (B : Real × Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + (‖d‖ = 1) → (d ≠ (0, 0)) ) := by + classical + intro B n d hd hz + rw [hz] at hd + norm_num at hd + +private theorem hnotopp : + (by + classical + exact + ∀ (B : Real × Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + (d ≠ (0, 0)) → (-d ≠ d) ) := by + classical + intro B n d hdnz hz + have h1 : d.1 = 0 := by have := congrArg Prod.fst hz; dsimp at this; linarith + have h2 : d.2 = 0 := by have := congrArg Prod.snd hz; dsimp at this; linarith + apply hdnz + ext <;> assumption + +private theorem hminus : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + {q | ∃ a : Real, 0 ≤ a ∧ q = x - a • d} = {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)} ) := by + classical + intro x B n d + ext q + constructor + · rintro ⟨a, ha, hq⟩ + exact ⟨a, ha, by simpa [smul_neg, sub_eq_add_neg] using hq⟩ + · rintro ⟨a, ha, hq⟩ + exact ⟨a, ha, by simpa [smul_neg, sub_eq_add_neg] using hq⟩ + +private theorem hchart' : + (by + classical + exact + ∀ (U : Set (Real × Real)), ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + (frontier U ∩ Metric.ball x r = ({q : ℝ × ℝ | ∃ (a : ℝ), (0 : ℝ) ≤ a ∧ q = x + a • + ‖B‖⁻¹ • B} ∪ {q : ℝ × ℝ | ∃ (a : ℝ), (0 : ℝ) ≤ a ∧ q = x - a • ‖B‖⁻¹ • B}) ∩ + Metric.ball x r) → ( + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let ray : Set (Real × Real) := + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)} ∪ + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • d} + ({q | ∃ a : Real, 0 ≤ a ∧ q = x - a • d} = {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)}) → + (frontier U ∩ Metric.ball x r = ray ∩ Metric.ball x r)) ) := by + classical + intro U x B r hchart n d ray hminus + rw [hminus, Set.union_comm] at hchart + simpa only [ray] using hchart + +private theorem hx : + (by + classical + exact + ∀ (U : Set (Real × Real)), ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), ((0 : + ℝ) < r) → ((frontier U ∩ Metric.ball x r = ({q : ℝ × ℝ | ∃ (a : ℝ), (0 : ℝ) ≤ a ∧ q = + x + a • ‖B‖⁻¹ • B} ∪ {q : ℝ × ℝ | ∃ (a : ℝ), (0 : ℝ) ≤ a ∧ q = x - a • ‖B‖⁻¹ • B}) ∩ + Metric.ball x r) → (x ∈ frontier U)) ) := by + classical + intro U x B r hr hchart + have hm : x ∈ frontier U ∩ Metric.ball x r := by + rw [hchart] + exact ⟨Or.inl ⟨0, le_rfl, by simp⟩, Metric.mem_ball_self hr⟩ + exact hm.1 + +private theorem hrayzero : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + let ray : Set (Real × Real) := + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)} ∪ + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • d} + ∀ q ∈ ray, D q = (0 : ℝ) ) := by + classical + intro x B n d D ray q hq + rcases hq with ⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩ + · dsimp [D] + simp [] + ring + · dsimp [D] + simp [] + ring + +private theorem hleftball : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let ray : Set (Real × Real) := + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)} ∪ + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • d} + ∀ (E : P3889T1TwoRaySectorDecomposition x r (-d) d), (E.left ∪ E.right = Metric.ball x + r \ ray) → (∀ q ∈ E.left, q ∈ Metric.ball x r) ) := by + classical + intro x B r n d ray E hcover q hq + have hq' : q ∈ E.left ∪ E.right := Or.inl hq + rw [hcover] at hq' + exact hq'.1 + +private theorem hrightball : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let ray : Set (Real × Real) := + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)} ∪ + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • d} + ∀ (E : P3889T1TwoRaySectorDecomposition x r (-d) d), (E.left ∪ E.right = Metric.ball x + r \ ray) → (∀ q ∈ E.right, q ∈ Metric.ball x r) ) := by + classical + intro x B r n d ray E hcover q hq + have hq' : q ∈ E.left ∪ E.right := Or.inr hq + rw [hcover] at hq' + exact hq'.1 + +private theorem hleftnotray : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let ray : Set (Real × Real) := + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)} ∪ + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • d} + ∀ (E : P3889T1TwoRaySectorDecomposition x r (-d) d), (E.left ∪ E.right = Metric.ball x + r \ ray) → (∀ q ∈ E.left, q ∉ ray) ) := by + classical + intro x B r n d ray E hcover q hq + have hq' : q ∈ E.left ∪ E.right := Or.inl hq + rw [hcover] at hq' + exact hq'.2 + +private theorem hrightnotray : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let ray : Set (Real × Real) := + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)} ∪ + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • d} + ∀ (E : P3889T1TwoRaySectorDecomposition x r (-d) d), (E.left ∪ E.right = Metric.ball x + r \ ray) → (∀ q ∈ E.right, q ∉ ray) ) := by + classical + intro x B r n d ray E hcover q hq + have hq' : q ∈ E.left ∪ E.right := Or.inr hq + rw [hcover] at hq' + exact hq'.2 + +private theorem hposnegDis : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + let pos : Set (Real × Real) := {q | 0 < D q} + let neg : Set (Real × Real) := {q | D q < 0} + Disjoint pos neg ) := by + classical + intro x B n d D pos neg + apply Set.disjoint_left.mpr + intro q hqpos hqneg + change 0 < D q at hqpos + change D q < 0 at hqneg + exact (not_lt_of_ge (le_of_lt hqpos)) hqneg + +private theorem hleftSplit : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + ∀ (E : P3889T1TwoRaySectorDecomposition x r (-d) d), (∀ (q : Real × Real), (q ∈ E.left) + → (D q ≠ 0)) → ( + let pos : Set (Real × Real) := {q | 0 < D q} + let neg : Set (Real × Real) := {q | D q < 0} + E.left ⊆ pos ∪ neg) ) := by + classical + intro x B r n d D E hDleft pos neg q hq + have hne := hDleft q hq + by_cases hn : D q < 0 + · exact Or.inr hn + · exact Or.inl (lt_of_le_of_ne (le_of_not_gt hn) (Ne.symm hne)) + +private theorem hrightSplit : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + ∀ (E : P3889T1TwoRaySectorDecomposition x r (-d) d), (∀ (q : Real × Real), (q ∈ + E.right) → (D q ≠ 0)) → ( + let pos : Set (Real × Real) := {q | 0 < D q} + let neg : Set (Real × Real) := {q | D q < 0} + E.right ⊆ pos ∪ neg) ) := by + classical + intro x B r n d D E hDright pos neg q hq + have hne := hDright q hq + by_cases hn : D q < 0 + · exact Or.inr hn + · exact Or.inl (lt_of_le_of_ne (le_of_not_gt hn) (Ne.symm hne)) + +private theorem hleftSign : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + ∀ (E : P3889T1TwoRaySectorDecomposition x r (-d) d), + let pos : Set (Real × Real) := {q | 0 < D q} + let neg : Set (Real × Real) := {q | D q < 0} + (IsOpen pos) → ((IsOpen neg) → ((Disjoint pos neg) → ((E.left ⊆ pos ∪ neg) → (E.left ⊆ + pos ∨ E.left ⊆ neg)))) ) := by + classical + intro x B r n d D E pos neg hposOpen hnegOpen hposnegDis hleftSplit + by_cases hp : (E.left ∩ pos).Nonempty + · exact Or.inl (E.left_connected.isPreconnected.subset_left_of_subset_union + hposOpen hnegOpen hposnegDis hleftSplit hp) + · right + intro q hq + rcases hleftSplit hq with hpq | hnq + · exact (hp ⟨q, hq, hpq⟩).elim + · exact hnq + +private theorem hrightSign : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + ∀ (E : P3889T1TwoRaySectorDecomposition x r (-d) d), + let pos : Set (Real × Real) := {q | 0 < D q} + let neg : Set (Real × Real) := {q | D q < 0} + (IsOpen pos) → ((IsOpen neg) → ((Disjoint pos neg) → ((E.right ⊆ pos ∪ neg) → (E.right ⊆ + pos ∨ E.right ⊆ neg)))) ) := by + classical + intro x B r n d D E pos neg hposOpen hnegOpen hposnegDis hrightSplit + by_cases hp : (E.right ∩ pos).Nonempty + · exact Or.inl (E.right_connected.isPreconnected.subset_left_of_subset_union + hposOpen hnegOpen hposnegDis hrightSplit hp) + · right + intro q hq + rcases hrightSplit hq with hpq | hnq + · exact (hp ⟨q, hq, hpq⟩).elim + · exact hnq + +private theorem hsq : + (by + classical + exact + ∀ (B : Real × Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + (d ≠ (0, 0)) → (0 < d.1 ^ 2 + d.2 ^ 2) ) := by + classical + intro B n d hdnz + rcases (show d.1 ≠ 0 ∨ d.2 ≠ 0 from by + by_contra h + push Not at h + exact hdnz (by ext <;> simp [h.1, h.2])) with h1 | h2 + · exact add_pos_of_pos_of_nonneg (sq_pos_of_ne_zero h1) (sq_nonneg _) + · exact add_pos_of_nonneg_of_pos (sq_nonneg _) (sq_pos_of_ne_zero h2) + +private theorem hjnorm : + (by + classical + exact + ∀ (B : Real × Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + (‖d‖ = 1) → ( + let j : Real × Real := (-d.2, d.1) + ‖j‖ = 1) ) := by + classical + intro B n d hd j + dsimp [j] + simpa [Prod.norm_def, Real.norm_eq_abs, max_comm] using hd + +private theorem hqposball : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), ((0 : ℝ) < r) → ( + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let j : Real × Real := (-d.2, d.1) + (‖j‖ = 1) → ( + let qpos : Real × Real := x + (r / 4) • j + qpos ∈ Metric.ball x r)) ) := by + classical + intro x B r hr n d j hjnorm qpos + change dist qpos x < r + rw [dist_eq_norm] + have hdiff : qpos - x = (r / 4) • j := by simp [qpos] + rw [hdiff, norm_smul, Real.norm_eq_abs, + abs_of_pos (by positivity : 0 < r / 4), hjnorm] + linarith + +private theorem hqnegball : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), ((0 : ℝ) < r) → ( + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let j : Real × Real := (-d.2, d.1) + (‖j‖ = 1) → ( + let qneg : Real × Real := x - (r / 4) • j + qneg ∈ Metric.ball x r)) ) := by + classical + intro x B r hr n d j hjnorm qneg + change dist qneg x < r + rw [dist_eq_norm] + have hdiff : qneg - x = -((r / 4) • j) := by simp [qneg, sub_eq_add_neg] + rw [hdiff, norm_neg, norm_smul, Real.norm_eq_abs, + abs_of_pos (by positivity : 0 < r / 4), hjnorm] + linarith + +private theorem hDpos : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), ((0 : ℝ) < r) → ( + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + (0 < d.1 ^ 2 + d.2 ^ 2) → ( + let j : Real × Real := (-d.2, d.1) + let qpos : Real × Real := x + (r / 4) • j + 0 < D qpos)) ) := by + classical + intro x B r hr n d D hsq j qpos + dsimp [D, qpos, j] + simp [] + nlinarith [hsq, hr] + +private theorem hDneg : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), ((0 : ℝ) < r) → ( + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + (0 < d.1 ^ 2 + d.2 ^ 2) → ( + let j : Real × Real := (-d.2, d.1) + let qneg : Real × Real := x - (r / 4) • j + D qneg < 0)) ) := by + classical + intro x B r hr n d D hsq j qneg + dsimp [D, qneg, j] + simp [] + nlinarith [hsq, hr] + +private theorem hqposCover : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + let ray : Set (Real × Real) := + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)} ∪ + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • d} + ∀ (E : P3889T1TwoRaySectorDecomposition x r (-d) d), (∀ (q : Real × Real), (q ∈ ray) → + (D q = 0)) → ((E.left ∪ E.right = Metric.ball x r \ ray) → ( + let j : Real × Real := (-d.2, d.1) + let qpos : Real × Real := x + (r / 4) • j + (qpos ∈ Metric.ball x r) → ((0 < D qpos) → (qpos ∈ E.left ∪ E.right)))) ) := by + classical + intro x B r n d D ray E hrayzero hcover j qpos hqposball hDpos + rw [hcover] + refine ⟨hqposball, ?_⟩ + intro hqray + have := hrayzero qpos hqray + linarith + +private theorem hqnegCover : + (by + classical + exact + ∀ (x : Real × Real), ∀ (B : Real × Real), ∀ (r : Real), + let n : Real := ‖B‖ + let d : Real × Real := n⁻¹ • B + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + let ray : Set (Real × Real) := + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)} ∪ + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • d} + ∀ (E : P3889T1TwoRaySectorDecomposition x r (-d) d), (∀ (q : Real × Real), (q ∈ ray) → + (D q = 0)) → ((E.left ∪ E.right = Metric.ball x r \ ray) → ( + let j : Real × Real := (-d.2, d.1) + let qneg : Real × Real := x - (r / 4) • j + (qneg ∈ Metric.ball x r) → ((D qneg < 0) → (qneg ∈ E.left ∪ E.right)))) ) := by + classical + intro x B r n d D ray E hrayzero hcover j qneg hqnegball hDneg + rw [hcover] + refine ⟨hqnegball, ?_⟩ + intro hqray + have := hrayzero qneg hqray + linarith + +end StraightFrontierDetails + +theorem P5667T1StraightFrontierLocalSides + (U : Set (Real × Real)) (hU : IsOpen U) + (he : frontier (closure U)ᶜ = frontier U) + (x B : Real × Real) (hB : B ≠ 0) (r : Real) (hr : 0 < r) + (hchart : frontier U ∩ Metric.ball x r = + ({q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (‖B‖⁻¹ • B)} ∪ + {q | ∃ a : Real, 0 ≤ a ∧ q = x - a • (‖B‖⁻¹ • B)}) ∩ + Metric.ball x r) : + ∃ e : Bool, P3934T1LocalSide U x B e ∧ + P3934T1LocalSide (closure U)ᶜ x B (!e) := by +-- BODY + have scaleLocalSide (W : Set (Real × Real)) (z w : Real × Real) + (c : Real) (e : Bool) (hc : 0 < c) + (hside : P3934T1LocalSide W z w e) : + P3934T1LocalSide W z (c • w) e := StraightFrontierProof.scaleLocalSide W z w c e hc hside + let n : Real := ‖B‖ + have hn : 0 < n := by dsimp [n]; exact norm_pos_iff.mpr hB + let d : Real × Real := n⁻¹ • B + have hBdecomp : B = n • d := StraightFrontierDetails.hBdecomp B hn + have hd : ‖d‖ = 1 := StraightFrontierDetails.hd B hn + have hdnz : d ≠ (0, 0) := StraightFrontierDetails.hdnz B hd + have hnotopp : -d ≠ d := StraightFrontierDetails.hnotopp B hdnz + let D : (Real × Real) → Real := fun q => + d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) + have hDcont : Continuous D := by dsimp [D]; fun_prop + let ray : Set (Real × Real) := + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)} ∪ + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • d} + have hminus : + {q | ∃ a : Real, 0 ≤ a ∧ q = x - a • d} = + {q | ∃ a : Real, 0 ≤ a ∧ q = x + a • (-d)} := StraightFrontierDetails.hminus x B + have hchart' : frontier U ∩ Metric.ball x r = ray ∩ Metric.ball x r := + StraightFrontierDetails.hchart' U x B r hchart hminus + have hx : x ∈ frontier U := StraightFrontierDetails.hx U x B r hr hchart + obtain ⟨E⟩ := P3889T1TwoRaySectors x r (-d) d hr (by simpa using hd) + hd hnotopp + have hselect := P3934T1SectorSelection U x r (-d) d E hr hU hx he hchart' + have hcol (y : Real × Real) (hy : d.1 * y.2 - d.2 * y.1 = 0) : + ∃ c : Real, y = c • d := StraightFrontierProof.hcol B hdnz y hy + have hrayzero (q : Real × Real) (hq : q ∈ ray) : D q = 0 := StraightFrontierDetails.hrayzero x + B q hq + have hcover : E.left ∪ E.right = Metric.ball x r \ ray := by + simpa only [ray] using E.cover + have hleftball (q : Real × Real) (hq : q ∈ E.left) : q ∈ Metric.ball x r := + StraightFrontierDetails.hleftball x B r E hcover q hq + have hrightball (q : Real × Real) (hq : q ∈ E.right) : q ∈ Metric.ball x r := + StraightFrontierDetails.hrightball x B r E hcover q hq + have hleftnotray (q : Real × Real) (hq : q ∈ E.left) : q ∉ ray := + StraightFrontierDetails.hleftnotray x B r E hcover q hq + have hrightnotray (q : Real × Real) (hq : q ∈ E.right) : q ∉ ray := + StraightFrontierDetails.hrightnotray x B r E hcover q hq + have hDleft (q : Real × Real) (hq : q ∈ E.left) : D q ≠ 0 := StraightFrontierProof.hDleft x B r + E hcol hleftball hleftnotray q hq + have hDright (q : Real × Real) (hq : q ∈ E.right) : D q ≠ 0 := StraightFrontierProof.hDright x + B r E hcol hrightball hrightnotray q hq + let pos : Set (Real × Real) := {q | 0 < D q} + let neg : Set (Real × Real) := {q | D q < 0} + have hposOpen : IsOpen pos := by + exact isOpen_Ioi.preimage hDcont + have hnegOpen : IsOpen neg := by + exact isOpen_Iio.preimage hDcont + have hposnegDis : Disjoint pos neg := StraightFrontierDetails.hposnegDis x B + have hleftSplit : E.left ⊆ pos ∪ neg := StraightFrontierDetails.hleftSplit x B r E hDleft + have hrightSplit : E.right ⊆ pos ∪ neg := StraightFrontierDetails.hrightSplit x B r E hDright + have hleftSign : E.left ⊆ pos ∨ E.left ⊆ neg := StraightFrontierDetails.hleftSign x B r E + hposOpen hnegOpen hposnegDis hleftSplit + have hrightSign : E.right ⊆ pos ∨ E.right ⊆ neg := StraightFrontierDetails.hrightSign x B r E + hposOpen hnegOpen hposnegDis hrightSplit + have hsq : 0 < d.1 ^ 2 + d.2 ^ 2 := StraightFrontierDetails.hsq B hdnz + let j : Real × Real := (-d.2, d.1) + have hjnorm : ‖j‖ = 1 := StraightFrontierDetails.hjnorm B hd + let qpos : Real × Real := x + (r / 4) • j + let qneg : Real × Real := x - (r / 4) • j + have hqposball : qpos ∈ Metric.ball x r := StraightFrontierDetails.hqposball x B r hr hjnorm + have hqnegball : qneg ∈ Metric.ball x r := StraightFrontierDetails.hqnegball x B r hr hjnorm + have hDpos : 0 < D qpos := StraightFrontierDetails.hDpos x B r hr hsq + have hDneg : D qneg < 0 := StraightFrontierDetails.hDneg x B r hr hsq + have hqposCover : qpos ∈ E.left ∪ E.right := StraightFrontierDetails.hqposCover x B r E + hrayzero hcover hqposball hDpos + have hqnegCover : qneg ∈ E.left ∪ E.right := StraightFrontierDetails.hqnegCover x B r E + hrayzero hcover hqnegball hDneg + have hsectorSign : + (E.left ⊆ pos ∧ E.right ⊆ neg) ∨ + (E.left ⊆ neg ∧ E.right ⊆ pos) := StraightFrontierProof.hsectorSign x B r E hleftSign + hrightSign hDpos hDneg hqposCover hqnegCover + have sectorEq (C D' : Set (Real × Real)) + (hCpos : C ⊆ pos) (hDneg : D' ⊆ neg) + (hCball : C ⊆ Metric.ball x r) + (hDball : D' ⊆ Metric.ball x r) + (hCD : C ∪ D' = Metric.ball x r \ ray) : + C = Metric.ball x r ∩ pos ∧ + D' = Metric.ball x r ∩ neg := StraightFrontierProof.sectorEq x B r hrayzero C D' hCpos + hDneg hCball hDball hCD + have hsectorEq : + (E.left = Metric.ball x r ∩ pos ∧ E.right = Metric.ball x r ∩ neg) ∨ + (E.left = Metric.ball x r ∩ neg ∧ E.right = Metric.ball x r ∩ pos) := + StraightFrontierProof.hsectorEq x B r E hcover hleftball hrightball hsectorSign sectorEq + have sidePos (W : Set (Real × Real)) + (hW : W ∩ Metric.ball x r = Metric.ball x r ∩ pos) : + P3934T1LocalSide W x d true := StraightFrontierProof.sidePos x B r hr W hW + have sideNeg (W : Set (Real × Real)) + (hW : W ∩ Metric.ball x r = Metric.ball x r ∩ neg) : + P3934T1LocalSide W x d false := StraightFrontierProof.sideNeg x B r hr W hW + have hlocal : ∃ e : Bool, + P3934T1LocalSide U x d e ∧ + P3934T1LocalSide (closure U)ᶜ x d (!e) := StraightFrontierProof.hlocal U x B r E hselect + hsectorEq sidePos sideNeg + obtain ⟨e, hUside, hVside⟩ := hlocal + refine ⟨e, ?_, ?_⟩ + · simpa only [hBdecomp] using scaleLocalSide U x d n e hn hUside + · simpa only [hBdecomp] using scaleLocalSide (closure U)ᶜ x d n (!e) hn hVside + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5682T1AlignedSquareRawInterfaces.lean b/LeanPool/ApollonianSuperharmonic/P5682T1AlignedSquareRawInterfaces.lean new file mode 100644 index 0000000000..a401193834 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5682T1AlignedSquareRawInterfaces.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5110T1SquareInterface +public import LeanPool.ApollonianSuperharmonic.P3192T1SimplePathOrientation +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary + +-- [TABLET NODE: P5682T1AlignedSquareRawInterfaces] + +/-! +# P5682T1AlignedSquareRawInterfaces + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5682T1AlignedSquareRawInterfaces : + let sq := fun (n : Nat) (a : GaussianInt) => TileTranslation (FordTile n) a + (∀ (n : Nat), 0 < n → ∀ a z : GaussianInt, + z ∈ FootprintVertices (sq n a) ↔ + a.re ≤ z.re ∧ z.re ≤ a.re + n ∧ a.im ≤ z.im ∧ z.im ≤ a.im + n) ∧ + (∀ (n m : Nat), 0 < n → 0 < m → ∀ (a b : GaussianInt) (v : Bool), + (if v then b.re = a.re + n else b.im = a.im + n) → + max (if v then a.im else a.re) (if v then b.im else b.re) < + min ((if v then a.im else a.re) + n) ((if v then b.im else b.re) + m) → + let l := max (if v then a.im else a.re) (if v then b.im else b.re) + let u := min ((if v then a.im else a.re) + n) ((if v then b.im else b.re) + m) + let x : GaussianInt := if v then ⟨b.re,l⟩ else ⟨l,b.im⟩ + let y : GaussianInt := if v then ⟨b.re,u⟩ else ⟨u,b.im⟩ + Disjoint (sq n a).cells (sq m b).cells ∧ + SimpleGridPathBetween + (FootprintVertices (sq n a) ∩ FootprintVertices (sq m b)) + (FootprintEdges (sq n a) ∩ FootprintEdges (sq m b)) x y ∧ + SimpleGridPathBetween + (FootprintVertices (sq n a) ∩ FootprintVertices (sq m b)) + (FootprintEdges (sq n a) ∩ FootprintEdges (sq m b)) y x) := by +-- BODY + classical + let sq := fun (n : Nat) (a : GaussianInt) => TileTranslation (FordTile n) a + have vertex (n : Nat) (hn : 0 < n) (a z : GaussianInt) : + z ∈ FootprintVertices (sq n a) ↔ + a.re ≤ z.re ∧ z.re ≤ a.re + n ∧ a.im ≤ z.im ∧ z.im ≤ a.im + n := by + rw [(TileTranslationFormulas _ _).2.2.2.2.2.1, + (P4062T1CanonicalSupport n hn).1] + constructor + · rintro ⟨w, hw, rfl⟩ + dsimp [FordVertexDomain, GaussianTranslation] at hw ⊢ + omega + · intro hz + refine ⟨z-a, ?_, by simp [GaussianTranslation]⟩ + dsimp [FordVertexDomain] + omega + refine ⟨vertex, ?_⟩ + intro n m hn hm a b v hside hover + obtain ⟨_, _, hd, hV, hE, _, _, _, hp⟩ := + P5110T1SquareInterface n m hn hm a b v hside hover + let l := max (if v then a.im else a.re) (if v then b.im else b.re) + let u := min ((if v then a.im else a.re) + n) ((if v then b.im else b.re) + m) + let x : GaussianInt := if v then ⟨b.re,l⟩ else ⟨l,b.im⟩ + let y : GaussianInt := if v then ⟨b.re,u⟩ else ⟨u,b.im⟩ + change Disjoint (sq n a).cells (sq m b).cells ∧ + SimpleGridPathBetween + (FootprintVertices (sq n a) ∩ FootprintVertices (sq m b)) + (FootprintEdges (sq n a) ∩ FootprintEdges (sq m b)) x y ∧ + SimpleGridPathBetween + (FootprintVertices (sq n a) ∩ FootprintVertices (sq m b)) + (FootprintEdges (sq n a) ∩ FootprintEdges (sq m b)) y x + have hv : FootprintVertices (sq n a) ∩ FootprintVertices (sq m b) = + BoundaryFootprintVertices (sq n a) ∩ BoundaryFootprintVertices (sq m b) := by + rw [hV] + ext z + simp only [Set.mem_inter_iff, vertex n hn a, vertex m hm b, Set.mem_ofPred_eq] + cases v <;> dsimp at hside ⊢ <;> omega + have he := CellDisjointCommonEdgesBoundary (sq n a) (sq m b) hd + have hx : x ∈ BoundaryFootprintVertices (sq n a) ∩ BoundaryFootprintVertices (sq m b) := by + rw [hV] + cases v <;> dsimp [x,l,u] at hover ⊢ <;> omega + have hy : y ∈ BoundaryFootprintVertices (sq n a) ∩ BoundaryFootprintVertices (sq m b) := by + rw [hV] + cases v <;> dsimp [y,l,u] at hover ⊢ <;> omega + have hxy : x ≠ y := by + intro h + cases v <;> simp only [x,y,l,u,Bool.false_eq_true,ite_false,ite_true, + Zsqrtd.ext_iff] at h hover <;> omega + have endpoint (z : GaussianInt) (hz : z = x ∨ z = y) : + ∀ e f : Finset GaussianInt, z ∈ e → z ∈ f → + e ∈ BoundaryFootprintEdges (sq n a) ∩ BoundaryFootprintEdges (sq m b) → + f ∈ BoundaryFootprintEdges (sq n a) ∩ BoundaryFootprintEdges (sq m b) → e = f := by + intro e f hze hzf he hf + rw [hE] at he hf + obtain ⟨t, htl, htu, rfl⟩ := he + obtain ⟨t', ht'l, ht'u, rfl⟩ := hf + have htt : t = t' := by + cases v <;> rcases hz with rfl | rfl <;> + simp only [x,y,l,u,Bool.false_eq_true, ite_false, ite_true, Finset.mem_insert, + Finset.mem_singleton, Zsqrtd.ext_iff] at hze hzf htl htu ht'l ht'u <;> omega + rw [htt] + have forward := P3192T1SimplePathOrientation _ _ x y hp hx hy hxy + (endpoint x (Or.inl rfl)) (endpoint y (Or.inr rfl)) + have backward := P3192T1SimplePathOrientation _ _ y x hp hy hx hxy.symm + (endpoint y (Or.inr rfl)) (endpoint x (Or.inl rfl)) + exact ⟨hd, by simpa only [hv,he] using forward, + by simpa only [hv,he] using backward⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5686T1UniformGlobalOdometerTransport.lean b/LeanPool/ApollonianSuperharmonic/P5686T1UniformGlobalOdometerTransport.lean new file mode 100644 index 0000000000..a477130903 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5686T1UniformGlobalOdometerTransport.lean @@ -0,0 +1,192 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Tactic.LinearCombination +public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.GaussianReflection +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends + +-- [TABLET NODE: P5686T1UniformGlobalOdometerTransport] + +/-! +# P5686T1UniformGlobalOdometerTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5686T1UniformGlobalOdometerTransport + (s : BandPackingSymmetry) (g : IntegerLatticeFunction) + (h : PartialOdometer) (hext : GlobalOdometerExtends g h) : + ∃ g' : IntegerLatticeFunction, + GlobalOdometerExtends g' (BandPackingSymmetryPartialOdometerAction s h) ∧ + ∀ x, FourNeighborLaplacian g' (BandPackingSymmetryVectorAction s x) = + FourNeighborLaplacian g x := by +-- BODY + classical + induction s generalizing g h with + | identity => + exact ⟨g, by simpa [BandPackingSymmetryPartialOdometerAction], by + intro x; simp [BandPackingSymmetryVectorAction]⟩ + | shift w => + let g' : IntegerLatticeFunction := fun y => + g y + BandPackingShiftPotential w y + refine ⟨g', ?_, ?_⟩ + · rcases hext with ⟨c, hc⟩ + refine ⟨c, ?_⟩ + intro y hy + simp only [BandPackingSymmetryPartialOdometerAction] at hy ⊢ + simp [g', hy, hc y hy] + abel + · intro x + simp only [BandPackingSymmetryVectorAction] + rcases w with ⟨A, B⟩ + rcases x with ⟨a, b⟩ + have tri_succ (n : ℤ) : + (n + 1) * ((n + 1) - 1) / 2 = n * (n - 1) / 2 + n := by + rcases Int.even_or_odd' n with ⟨k, hk | hk⟩ <;> subst n + · rw [Int.ediv_eq_of_eq_mul_right (by norm_num) + (show (2 * k + 1) * (2 * k + 1 - 1) = + 2 * ((2 * k + 1) * k) by ring)] + rw [Int.ediv_eq_of_eq_mul_right (by norm_num) + (show (2 * k) * (2 * k - 1) = + 2 * (k * (2 * k - 1)) by ring)] + ring + · rw [Int.ediv_eq_of_eq_mul_right (by norm_num) + (show (2 * k + 1 + 1) * (2 * k + 1 + 1 - 1) = + 2 * ((k + 1) * (2 * k + 1)) by ring)] + rw [Int.ediv_eq_of_eq_mul_right (by norm_num) + (show (2 * k + 1) * (2 * k + 1 - 1) = + 2 * (k * (2 * k + 1)) by ring)] + ring + have tri_pred (n : ℤ) : + (n - 1) * ((n - 1) - 1) / 2 = + n * (n - 1) / 2 - (n - 1) := by + have ht := tri_succ (n - 1) + simp only [sub_add_cancel] at ht + linarith + have second_difference (n : ℤ) : + (n + n ^ 2) / 2 + (2 - 3 * n + n ^ 2) / 2 - + 2 * ((-n + n ^ 2) / 2) = 1 := by + have hs := tri_succ n + have hp := tri_pred n + ring_nf at hs hp ⊢ + linarith + simp [g', FourNeighborLaplacian, BandPackingShiftPotential] + ring_nf + have reorder (n : ℤ) : + 2 - n * 3 + n ^ 2 = 2 - 3 * n + n ^ 2 := by + ring + rw [reorder a, reorder b] + linear_combination A * second_difference a - A * second_difference b + | negate => + let g' : IntegerLatticeFunction := fun y => g (-GaussianQuarterTurn y) + refine ⟨g', ?_, ?_⟩ + · rcases hext with ⟨c, hc⟩ + refine ⟨c, ?_⟩ + intro y hy + simp only [BandPackingSymmetryPartialOdometerAction] at hy ⊢ + have hpre : -GaussianQuarterTurn y ∈ h.domain := by + simp only [Finset.mem_image] at hy + rcases hy with ⟨z, hz, rfl⟩ + have hinv : -GaussianQuarterTurn (GaussianQuarterTurn z) = z := by + ext <;> simp [GaussianQuarterTurn] + simpa [hinv] using hz + simp [g', hy, hc _ hpre] + · intro x + rcases x with ⟨a, b⟩ + simp only [g', BandPackingSymmetryVectorAction, FourNeighborLaplacian] + have hr : -GaussianQuarterTurn + (GaussianQuarterTurn ⟨a, b⟩ + 1) = ⟨a, b - 1⟩ := by + ext <;> simp [GaussianQuarterTurn]; ring + have hl : -GaussianQuarterTurn + (GaussianQuarterTurn ⟨a, b⟩ - 1) = ⟨a, b + 1⟩ := by + ext <;> simp [GaussianQuarterTurn]; ring + have hu : -GaussianQuarterTurn + (GaussianQuarterTurn ⟨a, b⟩ + ⟨0, 1⟩) = ⟨a + 1, b⟩ := by + ext <;> simp [GaussianQuarterTurn] + have hd : -GaussianQuarterTurn + (GaussianQuarterTurn ⟨a, b⟩ - ⟨0, 1⟩) = ⟨a - 1, b⟩ := by + ext <;> simp [GaussianQuarterTurn] + have hc : -GaussianQuarterTurn + (GaussianQuarterTurn ⟨a, b⟩) = ⟨a, b⟩ := by + ext <;> simp [GaussianQuarterTurn] + have xr : (⟨a, b⟩ : GaussianInt) + 1 = ⟨a + 1, b⟩ := by + ext <;> simp + have xl : (⟨a, b⟩ : GaussianInt) - 1 = ⟨a - 1, b⟩ := by + ext <;> simp + have xu : (⟨a, b⟩ : GaussianInt) + ⟨0, 1⟩ = ⟨a, b + 1⟩ := by + ext <;> simp + have xd : (⟨a, b⟩ : GaussianInt) - ⟨0, 1⟩ = ⟨a, b - 1⟩ := by + ext <;> simp + rw [hr, hl, hu, hd, hc, xr, xl, xu, xd] + ring + | conjugate => + let g' : IntegerLatticeFunction := fun y => g (-GaussianReflection y) + refine ⟨g', ?_, ?_⟩ + · rcases hext with ⟨c, hc⟩ + refine ⟨c, ?_⟩ + intro y hy + simp only [BandPackingSymmetryPartialOdometerAction] at hy ⊢ + have hpre : -GaussianReflection y ∈ h.domain := by + simp only [Finset.mem_image] at hy + rcases hy with ⟨z, hz, rfl⟩ + have hinv : -GaussianReflection (-GaussianReflection z) = z := by + ext <;> simp [GaussianReflection] + simpa [hinv] using hz + simp [g', hy, hc _ hpre] + · intro x + rcases x with ⟨a, b⟩ + simp only [g', BandPackingSymmetryVectorAction, FourNeighborLaplacian] + have hr : -GaussianReflection + (-GaussianReflection ⟨a, b⟩ + 1) = ⟨a - 1, b⟩ := by + ext <;> simp [GaussianReflection]; ring + have hl : -GaussianReflection + (-GaussianReflection ⟨a, b⟩ - 1) = ⟨a + 1, b⟩ := by + ext <;> simp [GaussianReflection]; ring + have hu : -GaussianReflection + (-GaussianReflection ⟨a, b⟩ + ⟨0, 1⟩) = ⟨a, b + 1⟩ := by + ext <;> simp [GaussianReflection] + have hd : -GaussianReflection + (-GaussianReflection ⟨a, b⟩ - ⟨0, 1⟩) = ⟨a, b - 1⟩ := by + ext <;> simp [GaussianReflection] + have hc : -GaussianReflection + (-GaussianReflection ⟨a, b⟩) = ⟨a, b⟩ := by + ext <;> simp [GaussianReflection] + have xr : (⟨a, b⟩ : GaussianInt) + 1 = ⟨a + 1, b⟩ := by + ext <;> simp + have xl : (⟨a, b⟩ : GaussianInt) - 1 = ⟨a - 1, b⟩ := by + ext <;> simp + have xu : (⟨a, b⟩ : GaussianInt) + ⟨0, 1⟩ = ⟨a, b + 1⟩ := by + ext <;> simp + have xd : (⟨a, b⟩ : GaussianInt) - ⟨0, 1⟩ = ⟨a, b - 1⟩ := by + ext <;> simp + rw [hr, hl, hu, hd, hc, xr, xl, xu, xd] + ring + | comp a b iha ihb => + obtain ⟨gb, hgb, hlb⟩ := ihb g h hext + obtain ⟨ga, hga, hla⟩ := iha gb + (BandPackingSymmetryPartialOdometerAction b h) + hgb + refine ⟨ga, ?_, ?_⟩ + · simpa [BandPackingSymmetryPartialOdometerAction] using hga + · intro x + simpa [BandPackingSymmetryVectorAction] using + (hla (BandPackingSymmetryVectorAction b x)).trans (hlb x) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5691T1DiamondReflectionFootprints.lean b/LeanPool/ApollonianSuperharmonic/P5691T1DiamondReflectionFootprints.lean new file mode 100644 index 0000000000..f689c4cbba --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5691T1DiamondReflectionFootprints.lean @@ -0,0 +1,359 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: P5691T1DiamondReflectionFootprints] + +/-! +# P5691T1DiamondReflectionFootprints + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiamondReflectionFootprintConstruction + +private noncomputable abbrev J (k : Nat) : GaussianInt → GaussianInt := by + classical + exact fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + +private theorem diamondCellsNonempty (m : Nat) (hm : 0 < m) : + (DiamondTile m).cells.Nonempty := by + classical + refine ⟨0, (P4194T1DiamondCellRows m 0).1.mpr ?_⟩ + norm_num + omega + +private theorem sameCellObs (T T' : ProtoTile) (hc : T.cells = T'.cells) + (hne : T.cells.Nonempty) : + FootprintVertices T = FootprintVertices T' ∧ + FootprintEdges T = FootprintEdges T' := by + classical + cases T with + | mk tc ta => + cases T' with + | mk uc ua => + dsimp only at hc + subst uc + simp [FootprintVertices, FootprintEdges, hne] + +private theorem centeredCellEq (m : Nat) : + (TileTranslation (TileReflection (DiamondTile m)) + ⟨0, 2 * (m : Int)⟩).cells = (DiamondTile m).cells := by + classical + let rho : GaussianInt → GaussianInt := fun z => + ⟨z.re, 2 * (m : Int) - 1 - z.im⟩ + have hrho (z : GaussianInt) : rho (rho z) = z := by + apply Zsqrtd.ext <;> simp [rho] + have hrhoMem (z : GaussianInt) (hz : z ∈ DiamondCellDomain m) : + rho z ∈ DiamondCellDomain m := by + apply (P4194T1DiamondCellRows m (rho z)).1.mpr + have h := (P4194T1DiamondCellRows m z).1.mp hz + dsimp [rho] + omega + change ((DiamondCellDomain m).image + (fun w => GaussianReflection w - ⟨0, 1⟩)).image + (GaussianTranslation ⟨0, 2 * (m : Int)⟩) = DiamondCellDomain m + rw [Finset.image_image] + ext z + have hmap (w : GaussianInt) : + GaussianTranslation ⟨0, 2 * (m : Int)⟩ + (GaussianReflection w - ⟨0, 1⟩) = rho w := by + apply Zsqrtd.ext <;> simp [rho, GaussianTranslation, GaussianReflection] + omega + rw [show (GaussianTranslation ⟨0, 2 * (m : Int)⟩ ∘ + (fun w => GaussianReflection w - ⟨0, 1⟩)) = rho from funext hmap] + simp only [Finset.mem_image] + constructor + · rintro ⟨w, hw, rfl⟩ + exact hrhoMem w hw + · intro hz + exact ⟨rho z, hrhoMem z hz, hrho z⟩ + +private theorem centeredVertices (m : Nat) (hm : 0 < m) : + GaussianTranslation ⟨0, 2 * (m : Int)⟩ '' + FootprintVertices (TileReflection (DiamondTile m)) = + FootprintVertices (DiamondTile m) := by + classical + have diamondCellsNonempty (m : Nat) (hm : 0 < m) : + (DiamondTile m).cells.Nonempty := diamondCellsNonempty m hm + have sameCellObs (T T' : ProtoTile) (hc : T.cells = T'.cells) + (hne : T.cells.Nonempty) : + FootprintVertices T = FootprintVertices T' ∧ + FootprintEdges T = FootprintEdges T' := sameCellObs T T' hc hne + have centeredCellEq (m : Nat) : + (TileTranslation (TileReflection (DiamondTile m)) + ⟨0, 2 * (m : Int)⟩).cells = (DiamondTile m).cells := centeredCellEq m + have hobs := sameCellObs + (TileTranslation (TileReflection (DiamondTile m)) ⟨0, 2 * (m : Int)⟩) + (DiamondTile m) (centeredCellEq m) (by + rw [centeredCellEq] + exact diamondCellsNonempty m hm) + have hformula := + (TileTranslationFormulas (TileReflection (DiamondTile m)) + ⟨0, 2 * (m : Int)⟩).2.2.2.2.2.1 + exact hformula.symm.trans hobs.1 + +private theorem centeredEdges (m : Nat) (hm : 0 < m) : + (fun e : Finset GaussianInt => + e.image (GaussianTranslation ⟨0, 2 * (m : Int)⟩)) '' + FootprintEdges (TileReflection (DiamondTile m)) = + FootprintEdges (DiamondTile m) := by + classical + have diamondCellsNonempty (m : Nat) (hm : 0 < m) : + (DiamondTile m).cells.Nonempty := diamondCellsNonempty m hm + have sameCellObs (T T' : ProtoTile) (hc : T.cells = T'.cells) + (hne : T.cells.Nonempty) : + FootprintVertices T = FootprintVertices T' ∧ + FootprintEdges T = FootprintEdges T' := sameCellObs T T' hc hne + have centeredCellEq (m : Nat) : + (TileTranslation (TileReflection (DiamondTile m)) + ⟨0, 2 * (m : Int)⟩).cells = (DiamondTile m).cells := centeredCellEq m + have hobs := sameCellObs + (TileTranslation (TileReflection (DiamondTile m)) ⟨0, 2 * (m : Int)⟩) + (DiamondTile m) (centeredCellEq m) (by + rw [centeredCellEq] + exact diamondCellsNonempty m hm) + have hformula := + (TileTranslationFormulas (TileReflection (DiamondTile m)) + ⟨0, 2 * (m : Int)⟩).2.2.2.2.2.2.1 + exact hformula.symm.trans hobs.2 + +private theorem rhoVertexImage (m : Nat) (hm : 0 < m) : + (fun z => GaussianTranslation ⟨0, 2 * (m : Int)⟩ + (GaussianReflection z)) '' + FootprintVertices (DiamondTile m) = FootprintVertices (DiamondTile m) := by + classical + have centeredVertices (m : Nat) (hm : 0 < m) : + GaussianTranslation ⟨0, 2 * (m : Int)⟩ '' + FootprintVertices (TileReflection (DiamondTile m)) = + FootprintVertices (DiamondTile m) := centeredVertices m hm + have h := centeredVertices m hm + have href := TileReflectionFormulas (DiamondTile m) + rw [href.2.2.2.2.2.1] at h + rw [Set.image_image] at h + exact h + +private theorem rhoEdgeImage (m : Nat) (hm : 0 < m) : + (fun e : Finset GaussianInt => + e.image (fun z => GaussianTranslation ⟨0, 2 * (m : Int)⟩ + (GaussianReflection z))) '' + FootprintEdges (DiamondTile m) = FootprintEdges (DiamondTile m) := by + classical + have centeredEdges (m : Nat) (hm : 0 < m) : + (fun e : Finset GaussianInt => + e.image (GaussianTranslation ⟨0, 2 * (m : Int)⟩)) '' + FootprintEdges (TileReflection (DiamondTile m)) = + FootprintEdges (DiamondTile m) := centeredEdges m hm + have h := centeredEdges m hm + have href := TileReflectionFormulas (DiamondTile m) + rw [href.2.2.2.2.2.2.1] at h + rw [Set.image_image] at h + change (fun e : Finset GaussianInt => + (e.image GaussianReflection).image + (GaussianTranslation ⟨0, 2 * (m : Int)⟩)) '' + FootprintEdges (DiamondTile m) = _ at h + have hfun (e : Finset GaussianInt) : + (e.image GaussianReflection).image + (GaussianTranslation ⟨0, 2 * (m : Int)⟩) = + e.image (fun z => GaussianTranslation ⟨0, 2 * (m : Int)⟩ + (GaussianReflection z)) := by + rw [Finset.image_image] + rfl + rw [show (fun e : Finset GaussianInt => + (e.image GaussianReflection).image + (GaussianTranslation ⟨0, 2 * (m : Int)⟩)) = + (fun e => e.image (fun z => GaussianTranslation ⟨0, 2 * (m : Int)⟩ + (GaussianReflection z))) from funext hfun] at h + exact h + +private theorem JtranslatedVertices (k : Nat) (m : Nat) (hm : 0 < m) + (s t : GaussianInt) (hst : t = ⟨s.re, 2 * (k : Int) - + 2 * (m : Int) - s.im⟩) : + (J k) '' FootprintVertices (TileTranslation (DiamondTile m) s) = + FootprintVertices (TileTranslation (DiamondTile m) t) := by + classical + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + have rhoVertexImage (m : Nat) (hm : 0 < m) : + (fun z => GaussianTranslation ⟨0, 2 * (m : Int)⟩ + (GaussianReflection z)) '' + FootprintVertices (DiamondTile m) = FootprintVertices (DiamondTile m) := rhoVertexImage m hm + change (J '' FootprintVertices (TileTranslation (DiamondTile m) s) = + FootprintVertices (TileTranslation (DiamondTile m) t)) + have hs := (TileTranslationFormulas (DiamondTile m) s).2.2.2.2.2.1 + have ht := (TileTranslationFormulas (DiamondTile m) t).2.2.2.2.2.1 + have hfun : J ∘ GaussianTranslation s = + (fun z => GaussianTranslation t + (GaussianTranslation ⟨0, 2 * (m : Int)⟩ (GaussianReflection z))) := by + funext z + apply Zsqrtd.ext + · have hre : t.re = s.re := by simpa using congrArg Zsqrtd.re hst + simp [J, GaussianTranslation, GaussianReflection] + omega + · have him : t.im = 2 * (k : Int) - 2 * (m : Int) - s.im := by + simpa using congrArg Zsqrtd.im hst + simp [J, GaussianTranslation, GaussianReflection] + omega + calc + J '' FootprintVertices (TileTranslation (DiamondTile m) s) = + (fun x => J (GaussianTranslation s x)) '' FootprintVertices (DiamondTile m) := by + rw [hs, Set.image_image] + _ = + (J ∘ GaussianTranslation s) '' FootprintVertices (DiamondTile m) := by + rfl + _ = (fun z => GaussianTranslation t + (GaussianTranslation ⟨0, 2 * (m : Int)⟩ (GaussianReflection z))) '' + FootprintVertices (DiamondTile m) := by rw [hfun] + _ = GaussianTranslation t '' FootprintVertices (DiamondTile m) := by + rw [← Set.image_image, rhoVertexImage m hm] + _ = _ := ht.symm + +private theorem JtranslatedEdges (k : Nat) (m : Nat) (hm : 0 < m) + (s t : GaussianInt) (hst : t = ⟨s.re, 2 * (k : Int) - + 2 * (m : Int) - s.im⟩) : + (fun e : Finset GaussianInt => e.image (J k)) '' + FootprintEdges (TileTranslation (DiamondTile m) s) = + FootprintEdges (TileTranslation (DiamondTile m) t) := by + classical + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + have rhoEdgeImage (m : Nat) (hm : 0 < m) : + (fun e : Finset GaussianInt => + e.image (fun z => GaussianTranslation ⟨0, 2 * (m : Int)⟩ + (GaussianReflection z))) '' + FootprintEdges (DiamondTile m) = FootprintEdges (DiamondTile m) := rhoEdgeImage m hm + change ((fun e : Finset GaussianInt => e.image J) '' + FootprintEdges (TileTranslation (DiamondTile m) s) = + FootprintEdges (TileTranslation (DiamondTile m) t)) + have hs := (TileTranslationFormulas (DiamondTile m) s).2.2.2.2.2.2.1 + have ht := (TileTranslationFormulas (DiamondTile m) t).2.2.2.2.2.2.1 + have hpoint (z : GaussianInt) : + J (GaussianTranslation s z) = + GaussianTranslation t + (GaussianTranslation ⟨0, 2 * (m : Int)⟩ (GaussianReflection z)) := by + apply Zsqrtd.ext + · have hre : t.re = s.re := by simpa using congrArg Zsqrtd.re hst + simp [J, GaussianTranslation, GaussianReflection] + omega + · have him : t.im = 2 * (k : Int) - 2 * (m : Int) - s.im := by + simpa using congrArg Zsqrtd.im hst + simp [J, GaussianTranslation, GaussianReflection] + omega + have hfun (e : Finset GaussianInt) : + (e.image (GaussianTranslation s)).image J = + (e.image (fun z => GaussianTranslation ⟨0, 2 * (m : Int)⟩ + (GaussianReflection z))).image (GaussianTranslation t) := by + rw [Finset.image_image, Finset.image_image] + congr 1 + funext z + exact hpoint z + calc + (fun e : Finset GaussianInt => e.image J) '' + FootprintEdges (TileTranslation (DiamondTile m) s) = + ((fun e : Finset GaussianInt => e.image J) ∘ + (fun e : Finset GaussianInt => e.image (GaussianTranslation s))) '' + FootprintEdges (DiamondTile m) := by + rw [hs] + exact Set.image_image _ _ _ + _ = ((fun e : Finset GaussianInt => e.image (GaussianTranslation t)) ∘ + (fun e : Finset GaussianInt => e.image + (fun z => GaussianTranslation ⟨0, 2 * (m : Int)⟩ + (GaussianReflection z)))) '' FootprintEdges (DiamondTile m) := by + congr 1 + funext e + exact hfun e + _ = (fun e : Finset GaussianInt => e.image (GaussianTranslation t)) '' + FootprintEdges (DiamondTile m) := by + exact (Set.image_image + (fun e : Finset GaussianInt => e.image (GaussianTranslation t)) + (fun e : Finset GaussianInt => e.image + (fun z => GaussianTranslation ⟨0, 2 * (m : Int)⟩ + (GaussianReflection z))) + (FootprintEdges (DiamondTile m))).symm.trans + (congrArg (fun S : Set (Finset GaussianInt) => + (fun e : Finset GaussianInt => e.image (GaussianTranslation t)) '' S) + (rhoEdgeImage m hm)) + _ = _ := ht.symm + +end DiamondReflectionFootprintConstruction + +theorem P5691T1DiamondReflectionFootprints + (k m : Nat) (hm : 0 < m) (s t : GaussianInt) + (hst : t = ⟨s.re, 2 * (k : Int) - 2 * (m : Int) - s.im⟩) : + (fun z => GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z)) '' + FootprintVertices (TileTranslation (DiamondTile m) s) = + FootprintVertices (TileTranslation (DiamondTile m) t) ∧ + (fun e : Finset GaussianInt => e.image (fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z))) '' + FootprintEdges (TileTranslation (DiamondTile m) s) = + FootprintEdges (TileTranslation (DiamondTile m) t) := by +-- BODY + classical + let J : GaussianInt → GaussianInt := fun z => + GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) + have diamondCellsNonempty (m : Nat) (hm : 0 < m) : + (DiamondTile m).cells.Nonempty := + DiamondReflectionFootprintConstruction.diamondCellsNonempty m hm + have sameCellObs (T T' : ProtoTile) (hc : T.cells = T'.cells) + (hne : T.cells.Nonempty) : + FootprintVertices T = FootprintVertices T' ∧ + FootprintEdges T = FootprintEdges T' := + DiamondReflectionFootprintConstruction.sameCellObs T T' hc hne + have centeredCellEq (m : Nat) : + (TileTranslation (TileReflection (DiamondTile m)) + ⟨0, 2 * (m : Int)⟩).cells = (DiamondTile m).cells := + DiamondReflectionFootprintConstruction.centeredCellEq m + have centeredVertices (m : Nat) (hm : 0 < m) : + GaussianTranslation ⟨0, 2 * (m : Int)⟩ '' + FootprintVertices (TileReflection (DiamondTile m)) = + FootprintVertices (DiamondTile m) := + DiamondReflectionFootprintConstruction.centeredVertices m hm + have centeredEdges (m : Nat) (hm : 0 < m) : + (fun e : Finset GaussianInt => + e.image (GaussianTranslation ⟨0, 2 * (m : Int)⟩)) '' + FootprintEdges (TileReflection (DiamondTile m)) = + FootprintEdges (DiamondTile m) := DiamondReflectionFootprintConstruction.centeredEdges + m hm + have rhoVertexImage (m : Nat) (hm : 0 < m) : + (fun z => GaussianTranslation ⟨0, 2 * (m : Int)⟩ + (GaussianReflection z)) '' + FootprintVertices (DiamondTile m) = FootprintVertices (DiamondTile m) := + DiamondReflectionFootprintConstruction.rhoVertexImage m hm + have rhoEdgeImage (m : Nat) (hm : 0 < m) : + (fun e : Finset GaussianInt => + e.image (fun z => GaussianTranslation ⟨0, 2 * (m : Int)⟩ + (GaussianReflection z))) '' + FootprintEdges (DiamondTile m) = FootprintEdges (DiamondTile m) := + DiamondReflectionFootprintConstruction.rhoEdgeImage m hm + have JtranslatedVertices (m : Nat) (hm : 0 < m) + (s t : GaussianInt) (hst : t = ⟨s.re, 2 * (k : Int) - + 2 * (m : Int) - s.im⟩) : + J '' FootprintVertices (TileTranslation (DiamondTile m) s) = + FootprintVertices (TileTranslation (DiamondTile m) t) := + DiamondReflectionFootprintConstruction.JtranslatedVertices k m hm s t hst + have JtranslatedEdges (m : Nat) (hm : 0 < m) + (s t : GaussianInt) (hst : t = ⟨s.re, 2 * (k : Int) - + 2 * (m : Int) - s.im⟩) : + (fun e : Finset GaussianInt => e.image J) '' + FootprintEdges (TileTranslation (DiamondTile m) s) = + FootprintEdges (TileTranslation (DiamondTile m) t) := + DiamondReflectionFootprintConstruction.JtranslatedEdges k m hm s t hst + exact ⟨JtranslatedVertices m hm s t hst, JtranslatedEdges m hm s t hst⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/P5691T1PosDefQuadraticLowerBound.lean b/LeanPool/ApollonianSuperharmonic/P5691T1PosDefQuadraticLowerBound.lean new file mode 100644 index 0000000000..44f5fa92c9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/P5691T1PosDefQuadraticLowerBound.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm +public import Mathlib.LinearAlgebra.Matrix.PosDef + +-- [TABLET NODE: P5691T1PosDefQuadraticLowerBound] + +/-! +# P5691T1PosDefQuadraticLowerBound + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem P5691T1PosDefQuadraticLowerBound + (D : Matrix (Fin 2) (Fin 2) ℝ) (hgap : D.PosDef) : + ∃ k : ℝ, 0 < k ∧ ∀ x : GaussianInt, + k * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) ≤ LatticeQuadraticForm D x := by +-- BODY + let a : ℝ := D 0 0 + let b : ℝ := D 0 1 + let d : ℝ := D 1 1 + have hDs : D.IsHermitian := hgap.isHermitian + have hDsym : D.IsSymm := by + exact Matrix.isHermitian_iff_isSymm.mp hDs + have ha : 0 < a := by + have hp := hgap.dotProduct_mulVec_pos (x := ![(1 : ℝ), 0]) (by + intro hz + have := congr_fun hz 0 + simp at this) + simpa [a, Matrix.mulVec, dotProduct, Fin.sum_univ_two] using hp + have hpos (u v : ℝ) (hne : ![u, v] ≠ 0) : + 0 < a * u ^ 2 + 2 * b * u * v + d * v ^ 2 := by + have hp := hgap.dotProduct_mulVec_pos (x := ![u, v]) hne + have hs := hDsym.apply 0 1 + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, hs] at hp + dsimp [a, b, d] + nlinarith [hp] + have hdet : 0 < a * d - b ^ 2 := by + have hp := hpos (-b) a (by + intro hz + have hz0 := congr_fun hz 0 + have hz1 := congr_fun hz 1 + simp [ha.ne'] at hz0 hz1 + ) + nlinarith + have had : 0 < a + d := by + have hd : 0 < d := by + have hp := hgap.dotProduct_mulVec_pos (x := ![(0 : ℝ), 1]) (by + intro hz + have := congr_fun hz 1 + simp at this) + simpa [d, Matrix.mulVec, dotProduct, Fin.sum_univ_two] using hp + linarith + have hquad (x : GaussianInt) : + LatticeQuadraticForm D x = + (1 / 2 : ℝ) * (a * (x.re : ℝ)^2 + + 2 * b * (x.re : ℝ) * (x.im : ℝ) + d * (x.im : ℝ)^2) := by + have hs := hDsym.apply 0 1 + simp [LatticeQuadraticForm, a, b, d, Matrix.mulVec, dotProduct, + Fin.sum_univ_two, -GaussianInt.intCast_re, -GaussianInt.intCast_im, + hs] + ring_nf + have hlower (x : GaussianInt) : + LatticeQuadraticForm D x ≥ + (a * d - b ^ 2) / (2 * (a + d)) * + ((x.re : ℝ)^2 + (x.im : ℝ)^2) := by + rw [hquad] + have hs1 : 0 ≤ (a * (x.re : ℝ) + b * (x.im : ℝ)) ^ 2 := sq_nonneg _ + have hs2 : 0 ≤ (b * (x.re : ℝ) + d * (x.im : ℝ)) ^ 2 := sq_nonneg _ + field_simp + nlinarith + let k : ℝ := (a * d - b ^ 2) / (2 * (a + d)) + have hk : 0 < k := by + dsimp [k] + exact div_pos hdet (mul_pos (by norm_num) had) + exact ⟨k, hk, hlower⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PSDQuadraticIntegerApproximation.lean b/LeanPool/ApollonianSuperharmonic/PSDQuadraticIntegerApproximation.lean new file mode 100644 index 0000000000..8caeadab79 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PSDQuadraticIntegerApproximation.lean @@ -0,0 +1,264 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Order.Int.LeastGreatest + +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.IntegerLaplacianCastBridge +public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm +public import LeanPool.ApollonianSuperharmonic.RealLaplacianContactComparison +public import LeanPool.ApollonianSuperharmonic.RealLaplacianLinearity +public import LeanPool.ApollonianSuperharmonic.P5667T1RoundedSupportingSlope + +-- [TABLET NODE: PSDQuadraticIntegerApproximation] + +/-! +# PSDQuadraticIntegerApproximation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem PSDQuadraticIntegerApproximation + (A : Matrix (Fin 2) (Fin 2) Real) (hA : A.IsSymm) + (hpsd : A.PosSemidef) : + exists g : IntegerLatticeFunction, + (forall p : GaussianInt, + (forall K : Int, exists y : GaussianInt, + Int.floor (LatticeQuadraticForm A y + + ((abs y.re + abs y.im : Int) : Real)) - + p.re * y.re - p.im * y.im <= K) ∨ + exists m : Int, + (forall y : GaussianInt, + m <= Int.floor (LatticeQuadraticForm A y + + ((abs y.re + abs y.im : Int) : Real)) - + p.re * y.re - p.im * y.im) /\ + (exists y : GaussianInt, + m = Int.floor (LatticeQuadraticForm A y + + ((abs y.re + abs y.im : Int) : Real)) - + p.re * y.re - p.im * y.im)) /\ + (forall x : GaussianInt, exists p : GaussianInt, exists m : Int, + (forall y : GaussianInt, + m <= Int.floor (LatticeQuadraticForm A y + + ((abs y.re + abs y.im : Int) : Real)) - + p.re * y.re - p.im * y.im) /\ + (exists y : GaussianInt, + m = Int.floor (LatticeQuadraticForm A y + + ((abs y.re + abs y.im : Int) : Real)) - + p.re * y.re - p.im * y.im) /\ + g x = m + p.re * x.re + p.im * x.im) /\ + (forall x p : GaussianInt, forall m : Int, + (forall y : GaussianInt, + m <= Int.floor (LatticeQuadraticForm A y + + ((abs y.re + abs y.im : Int) : Real)) - + p.re * y.re - p.im * y.im) -> + m + p.re * x.re + p.im * x.im <= g x) /\ + (forall x : GaussianInt, + LatticeQuadraticForm A x - ((abs x.re + abs x.im : Int) : Real) - 1 <= + (g x : Real) /\ + (g x : Real) <= + LatticeQuadraticForm A x + ((abs x.re + abs x.im : Int) : Real) + 1) /\ + (forall x : GaussianInt, 0 <= FourNeighborLaplacian g x) := by +-- BODY + classical + let q : GaussianInt → Real := fun z => LatticeQuadraticForm A z + let energy : GaussianInt → GaussianInt → Int := fun p y => + Int.floor (LatticeQuadraticForm A y + + ((abs y.re + abs y.im : Int) : Real)) - p.re * y.re - p.im * y.im + let bounded : GaussianInt → Prop := fun p => ∃ b : Int, ∀ y, b ≤ energy p y + let minimum : GaussianInt → Int := fun p => + if hp : bounded p then Classical.choose (Int.exists_least_of_bdd + (show ∃ b : Int, ∀ z : Int, (∃ y, energy p y = z) → b ≤ z from + ⟨Classical.choose hp, by + intro z hz + rcases hz with ⟨y, hy⟩ + rw [← hy] + exact Classical.choose_spec hp y⟩) + ⟨energy p 0, ⟨0, rfl⟩⟩) + else 0 + have minimum_spec : ∀ p, bounded p → + (∀ y, minimum p ≤ energy p y) ∧ ∃ y, minimum p = energy p y := by + intro p hp + dsimp [minimum] + rw [dite_eq_left hp] + have hs := Classical.choose_spec (Int.exists_least_of_bdd + (show ∃ b : Int, ∀ z : Int, (∃ y, energy p y = z) → b ≤ z from + ⟨Classical.choose hp, by + intro z hz + rcases hz with ⟨y, hy⟩ + rw [← hy] + exact Classical.choose_spec hp y⟩) + ⟨energy p 0, ⟨0, rfl⟩⟩) + rcases hs with ⟨he, hl⟩ + constructor + · intro y + apply hl + exact Exists.intro y rfl + · rcases he with ⟨y, hy⟩ + exact ⟨y, hy.symm⟩ + have bounded_iff : ∀ p, bounded p ↔ ∃ m : Int, (∀ y, m ≤ energy p y) ∧ ∃ y, m = energy p y := by + intro p + constructor + · intro hp + exact ⟨minimum p, minimum_spec p hp⟩ + · rintro ⟨m, hm, hy⟩ + exact ⟨m, hm⟩ + have q_nonneg : ∀ z, 0 ≤ q z := by + intro z + have hz := hpsd.dotProduct_mulVec_nonneg + (![ (z.re : Real), (z.im : Real) ] : Fin 2 → Real) + simpa [q, LatticeQuadraticForm, dotProduct, Matrix.mulVec, Fin.sum_univ_two] + using hz + let admitted : GaussianInt → Int → Prop := fun x z => + ∃ p, bounded p ∧ z = minimum p + p.re * x.re + p.im * x.im + have admitted_upper : ∀ x z, admitted x z → + z ≤ Int.floor (LatticeQuadraticForm A x + + ((abs x.re + abs x.im : Int) : Real)) := by + intro x z hz + rcases hz with ⟨p, hp, rfl⟩ + have hm := (minimum_spec p hp).1 x + dsimp [energy] at hm + omega + have admitted_nonempty : ∀ x, ∃ z, admitted x z := by + intro x + have hb : bounded 0 := by + refine ⟨0, ?_⟩ + intro y + have hf' : 0 ≤ Int.floor (LatticeQuadraticForm A y + + ((abs y.re + abs y.im : Int) : Real)) := by + apply Int.floor_nonneg.mpr + have hi : 0 ≤ abs y.re + abs y.im := + add_nonneg (abs_nonneg _) (abs_nonneg _) + have hw : (0 : Real) ≤ ((abs y.re + abs y.im : Int) : Real) := by + exact_mod_cast hi + exact add_nonneg (q_nonneg y) hw + simpa [energy] using hf' + refine ⟨minimum 0, 0, hb, ?_⟩ + simp + let g : IntegerLatticeFunction := fun x => + Classical.choose (Int.exists_greatest_of_bdd + ⟨Int.floor (LatticeQuadraticForm A x + + ((abs x.re + abs x.im : Int) : Real)), admitted_upper x⟩ + (admitted_nonempty x)) + have g_spec : ∀ x, admitted x (g x) ∧ + ∀ z, admitted x z → z ≤ g x := by + intro x + exact Classical.choose_spec (Int.exists_greatest_of_bdd + ⟨Int.floor (LatticeQuadraticForm A x + + ((abs x.re + abs x.im : Int) : Real)), admitted_upper x⟩ + (admitted_nonempty x)) + refine ⟨g, ?_, ?_, ?_, ?_, ?_⟩ + · intro p + by_cases hp : bounded p + · right + exact bounded_iff p |>.mp hp + · left + intro K + by_contra hn + apply hp + refine ⟨K + 1, ?_⟩ + intro y + by_contra hy + apply hn + refine ⟨y, ?_⟩ + have hlt : energy p y ≤ K := by omega + exact hlt + · intro x + rcases g_spec x with ⟨⟨p, hp, hvalue⟩, hgreat⟩ + refine ⟨p, minimum p, (minimum_spec p hp).1, (minimum_spec p hp).2, ?_⟩ + simp [hvalue] + · intro x p m hm + have hp : bounded p := ⟨m, hm⟩ + have hmin := (minimum_spec p hp).2 + rcases hmin with ⟨y, hy⟩ + have hle : m ≤ minimum p := by + have := hm y + calc + m ≤ energy p y := by simpa [energy] using this + _ = minimum p := hy.symm + have htop := (g_spec x).2 + (minimum p + p.re * x.re + p.im * x.im) + ⟨p, hp, rfl⟩ + omega + · intro x + have hu := admitted_upper x (g x) (g_spec x).1 + have hf := Int.floor_le (LatticeQuadraticForm A x + + ((abs x.re + abs x.im : Int) : Real)) + constructor + · obtain ⟨p, lower_energy⟩ := P5667T1RoundedSupportingSlope A hA hpsd x + have hb : bounded p := ⟨Int.ceil (LatticeQuadraticForm A x - + ((abs x.re + abs x.im : Int) : Real) - 1 - + p.re * x.re - p.im * x.im), lower_energy⟩ + have hg := (g_spec x).2 + (minimum p + p.re * x.re + p.im * x.im) + ⟨p, hb, rfl⟩ + have hminx : (Int.ceil (LatticeQuadraticForm A x - + ((abs x.re + abs x.im : Int) : Real) - 1 - + p.re * x.re - p.im * x.im) : Real) ≤ + (minimum p : Real) := by + rcases (minimum_spec p hb).2 with ⟨y, hy⟩ + have hm' : Int.ceil (LatticeQuadraticForm A x - + ((abs x.re + abs x.im : Int) : Real) - 1 - + p.re * x.re - p.im * x.im) ≤ energy p y := by + exact lower_energy y + have hmp : Int.ceil (LatticeQuadraticForm A x - + ((abs x.re + abs x.im : Int) : Real) - 1 - + p.re * x.re - p.im * x.im) ≤ minimum p := by + calc + Int.ceil (LatticeQuadraticForm A x - + ((abs x.re + abs x.im : Int) : Real) - 1 - + p.re * x.re - p.im * x.im) ≤ energy p y := hm' + _ = minimum p := hy.symm + exact_mod_cast hmp + have hgf : (minimum p : Real) + p.re * x.re + p.im * x.im ≤ (g x : Real) := by + exact_mod_cast hg + have hceil := Int.le_ceil (LatticeQuadraticForm A x - + ((abs x.re + abs x.im : Int) : Real) - 1 - + p.re * x.re - p.im * x.im) + change (minimum p : Real) + (p.re : Real) * (x.re : Real) + + (p.im : Real) * (x.im : Real) ≤ (g x : Real) at hgf + linarith [hminx, hceil, hgf] + · have hgu : (g x : Real) ≤ + (Int.floor (LatticeQuadraticForm A x + + ((abs x.re + abs x.im : Int) : Real)) : Real) := by + exact_mod_cast hu + linarith + · intro x + have hl := (g_spec x).1 + rcases hl with ⟨p, hp, hvalue⟩ + have hcontact : ∀ y, y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + ((minimum p : Real) + p.re * y.re + p.im * y.im) ≤ (g y : Real) := by + intro y hy + have hi := (g_spec y).2 + (minimum p + p.re * y.re + p.im * y.im) + ⟨p, hp, rfl⟩ + exact_mod_cast hi + have hcenter : + (minimum p : Real) + p.re * x.re + p.im * x.im = (g x : Real) := by + exact_mod_cast hvalue.symm + have hcomp := RealLaplacianContactComparison.1 + (fun y => (minimum p : Real) + p.re * y.re + p.im * y.im) + (fun y => (g y : Real)) x hcenter hcontact + have hzero : RealFourNeighborLaplacian + (fun y => (minimum p : Real) + p.re * y.re + p.im * y.im) x = 0 := by + unfold RealFourNeighborLaplacian + simp + ring + have hreal : 0 ≤ RealFourNeighborLaplacian (fun y => (g y : Real)) x := by + rw [← hzero] + exact hcomp + rw [IntegerLaplacianCastBridge g x] at hreal + exact_mod_cast hreal + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ParentVectorsInTilingLattice.lean b/LeanPool/ApollonianSuperharmonic/ParentVectorsInTilingLattice.lean new file mode 100644 index 0000000000..6f10a97abb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ParentVectorsInTilingLattice.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.TilingLattice +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: ParentVectorsInTilingLattice] + +/-! +# ParentVectorsInTilingLattice + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem ParentVectorsInTilingLattice + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (i : Fin 3) (Cᵢ : BandCircle) (hCᵢ : q i.succ = Cᵢ.1.1) : + BandVectors.1 (q ((i + 1).succ)) (q i.succ) ∈ TilingLattice Cᵢ ∧ + BandVectors.1 (q ((i + 2).succ)) (q i.succ) ∈ TilingLattice Cᵢ := by +-- BODY + induction hq.1 generalizing i Cᵢ with + | base z => + have positive := Cᵢ.2 + fin_cases i + · have unit : Cᵢ.1.1.1 = 1 := by + simpa using (congrArg (fun x => x.1) hCᵢ).symm + simp [TilingLattice, unit] + · rw [← hCᵢ] at positive + have coordinate := congrArg (fun x => x.1) hCᵢ + have contradiction : (0 : ℤ) < 0 := by simp at positive + omega + · rw [← hCᵢ] at positive + have coordinate := congrArg (fun x => x.1) hCᵢ + have contradiction : (0 : ℤ) < 0 := by simp at positive + omega + | @rotate predecessor semi ih => + have previous : ProperBandQuadruple predecessor := by + refine ⟨semi, ?_⟩ + intro j + fin_cases j + · simpa using hq.2 ⟨2, by decide⟩ + · simpa using hq.2 ⟨0, by decide⟩ + · simpa using hq.2 ⟨1, by decide⟩ + fin_cases i + · simpa using ih previous ⟨1, by decide⟩ Cᵢ (by simpa using hCᵢ) + · simpa using ih previous ⟨2, by decide⟩ Cᵢ (by simpa using hCᵢ) + · simpa using ih previous ⟨0, by decide⟩ Cᵢ (by simpa using hCᵢ) + | @successor predecessor semi ih => + have successorSemi : SemiProperQuadruple _ := + SemiProperQuadruple.successor semi + have systemLaw : RecursiveVectorSystem BandVectors := + by simpa [BandVectors] using (Classical.choose_spec RecursiveVectorsExistUnique).1 + rcases systemLaw with ⟨zeroLaw, baseLaw, stepLaw, flipLaw⟩ + rcases SemiProperForestClassification predecessor semi with ⟨nonnegative, alternatives⟩ + rcases alternatives with root | root | root | previous + · rcases root with ⟨z, rfl⟩ + have alternatives : Cᵢ.1.1.1 = 1 ∨ Cᵢ.1.1.1 = 0 := by + have coordinate := congrArg (fun x => x.1) hCᵢ + fin_cases i <;> simp at coordinate ⊢ <;> omega + rcases alternatives with unit | zero + · simp [TilingLattice, unit] + · have positive := Cᵢ.2 + omega + · rcases root with ⟨z, rfl⟩ + have alternatives : Cᵢ.1.1.1 = 1 ∨ Cᵢ.1.1.1 = 0 := by + have coordinate := congrArg (fun x => x.1) hCᵢ + fin_cases i <;> simp at coordinate ⊢ <;> omega + rcases alternatives with unit | zero + · simp [TilingLattice, unit] + · have positive := Cᵢ.2 + omega + · rcases root with ⟨z, rfl⟩ + have alternatives : Cᵢ.1.1.1 = 1 ∨ Cᵢ.1.1.1 = 0 := by + have coordinate := congrArg (fun x => x.1) hCᵢ + fin_cases i <;> simp at coordinate ⊢ <;> omega + rcases alternatives with unit | zero + · simp [TilingLattice, unit] + · have positive := Cᵢ.2 + omega + · have previousProper : ProperBandQuadruple predecessor := previous + have childRelation : ∀ a b : CircleCoordinates, BandTangency a b → + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 b a = BandVectors.1 a b ∨ + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 b a = -BandVectors.1 a b := by + intro a b tangent + have orientations := (PrimitiveVectorOrientationUnique a b).2 tangent + rcases orientations with ⟨_, xor⟩ + unfold Xor at xor + rcases xor with ⟨forward, _⟩ | ⟨backward, _⟩ + · rw [(flipLaw _ _ forward).1] + right + norm_num [Zsqrtd.ext_iff] + · rw [(flipLaw _ _ backward).1] + left + norm_num [Zsqrtd.ext_iff] + fin_cases i + · have rootEquality : predecessor 0 = Cᵢ.1.1 := by simpa using hCᵢ + by_cases unit : Cᵢ.1.1.1 = 1 + · simp [TilingLattice, unit] + · unfold TilingLattice + simp only [unit, ↓reduceIte] + constructor + · exact AddSubgroup.subset_closure ⟨predecessor, semi, rootEquality, + by simpa [rootEquality] using previousProper.2, ⟨1, by simp⟩⟩ + · exact AddSubgroup.subset_closure ⟨predecessor, semi, rootEquality, + by simpa [rootEquality] using previousProper.2, ⟨2, by simp⟩⟩ + · have hfirst := ih previousProper ⟨1, by decide⟩ Cᵢ (by simpa using hCᵢ) + have step := (stepLaw predecessor semi).1 + have rootFlip := flipLaw _ _ (PrimitiveVectorOrientation.parentChild previousProper 1) + have rootFlip' : BandVectors.1 (predecessor 0) (predecessor 2) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (predecessor 2) (predecessor 0) := by + simpa using rootFlip.1 + have rel := childRelation (predecessor 1) (predecessor 2) + ⟨predecessor, semi, 1, 2, by decide, rfl, rfl⟩ + have target : BandVectors.1 (predecessor 0) (predecessor 2) = + BandVectors.1 (predecessor 3) (predecessor 2) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (predecessor 2) (predecessor 1) := by + rw [rootFlip', step, mul_sub] + norm_num [Zsqrtd.ext_iff] + constructor <;> ring + refine ⟨hfirst.1, ?_⟩ + change BandVectors.1 (predecessor 0) (predecessor 2) ∈ TilingLattice Cᵢ + rw [target] + rcases rel with rel | rel + · rw [rel] + exact (TilingLattice Cᵢ).add_mem hfirst.1 hfirst.2 + · rw [rel] + exact (TilingLattice Cᵢ).sub_mem hfirst.1 hfirst.2 + · have hfirst := ih previousProper ⟨2, by decide⟩ Cᵢ (by simpa using hCᵢ) + have step := (stepLaw predecessor semi).2.1 + have rel := childRelation (predecessor 2) (predecessor 3) + ⟨predecessor, semi, 2, 3, by decide, rfl, rfl⟩ + have target : BandVectors.1 (predecessor 0) (predecessor 3) = + BandVectors.1 (predecessor 1) (predecessor 3) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (predecessor 3) (predecessor 2) := by + simpa using step + refine ⟨?_, hfirst.2⟩ + change BandVectors.1 (predecessor 0) (predecessor 3) ∈ TilingLattice Cᵢ + rw [target] + rcases rel with rel | rel + · rw [rel] + exact (TilingLattice Cᵢ).add_mem hfirst.1 hfirst.2 + · rw [rel] + exact (TilingLattice Cᵢ).sub_mem hfirst.1 hfirst.2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ParentalOrientationGluing.lean b/LeanPool/ApollonianSuperharmonic/ParentalOrientationGluing.lean new file mode 100644 index 0000000000..de3f9d37a9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ParentalOrientationGluing.lean @@ -0,0 +1,466 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation + +-- [TABLET NODE: ParentalOrientationGluing] + +/-! +# ParentalOrientationGluing + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ParentalOrientationLemmas + +private theorem incoming_one : + ∀ (D₁ : Finset GaussianInt), ∀ (D₂ : Finset GaussianInt), ∀ (σ : GaussianInt → ℤ), ∀ (o₁ : + AcyclicIndegreeOrientation D₁ σ), (∀ x ∈ D₁ ∩ D₂, ∀ y ∈ D₁, o₁.edge y x → y ∈ D₂) → + let I := D₁ ∩ D₂ + ∀ x ∈ I, + (D₁.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))) = + (I.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))) := by + classical + intro D₁ D₂ σ o₁ hclosed₁ I x hx + change x ∈ D₁ ∩ D₂ at hx + ext y + simp only [Finset.mem_filter] + constructor + · intro h + refine ⟨Finset.mem_inter.mpr ⟨h.1, ?_⟩, h.2⟩ + exact hclosed₁ x hx y + h.1 + (@of_decide_eq_true (o₁.edge y x) (o₁.edge_decidable y x) h.2) + · intro h + exact ⟨(Finset.mem_inter.mp (show y ∈ D₁ ∩ D₂ from h.1)).1, h.2⟩ + +private theorem incoming_two : + ∀ (D₁ : Finset GaussianInt), ∀ (D₂ : Finset GaussianInt), ∀ (σ : GaussianInt → ℤ), ∀ (o₂ : + AcyclicIndegreeOrientation D₂ σ), (∀ x ∈ D₁ ∩ D₂, ∀ y ∈ D₂, o₂.edge y x → y ∈ D₁) → + let I := D₁ ∩ D₂ + ∀ x ∈ I, + (D₂.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x))) = + (I.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x))) := by + classical + intro D₁ D₂ σ o₂ hclosed₂ I x hx + change x ∈ D₁ ∩ D₂ at hx + ext y + simp only [Finset.mem_filter] + constructor + · intro h + refine ⟨Finset.mem_inter.mpr ⟨?_, h.1⟩, h.2⟩ + exact hclosed₂ x hx y + h.1 + (@of_decide_eq_true (o₂.edge y x) (o₂.edge_decidable y x) h.2) + · intro h + exact ⟨(Finset.mem_inter.mp (show y ∈ D₁ ∩ D₂ from h.1)).2, h.2⟩ + +private theorem incoming_card : + ∀ (D₁ : Finset GaussianInt), ∀ (D₂ : Finset GaussianInt), ∀ (σ : GaussianInt → ℤ), ∀ (o₁ : + AcyclicIndegreeOrientation D₁ σ), ∀ (o₂ : AcyclicIndegreeOrientation D₂ σ), + let I := D₁ ∩ D₂ + (∀ x ∈ I, (D₁.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))) = (I.filter + (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x)))) → (∀ x ∈ I, (D₂.filter (fun y + => @decide (o₂.edge y x) (o₂.edge_decidable y x))) = (I.filter (fun y => @decide (o₂.edge + y x) (o₂.edge_decidable y x)))) → ∀ x ∈ I, + (I.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))).card = + (I.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x))).card := by + classical + intro D₁ D₂ σ o₁ o₂ I incoming_one incoming_two x hx + change x ∈ D₁ ∩ D₂ at hx + have hx' := Finset.mem_inter.mp (show x ∈ D₁ ∩ D₂ from hx) + have h₁ := o₁.indegree x hx'.1 + have h₂ := o₂.indegree x hx'.2 + rw [incoming_one x hx] at h₁ + rw [incoming_two x hx] at h₂ + exact_mod_cast h₁.trans h₂.symm + +private theorem agreement : + ∀ (D₁ : Finset GaussianInt), ∀ (D₂ : Finset GaussianInt), ∀ (σ : GaussianInt → ℤ), ∀ (o₁ : + AcyclicIndegreeOrientation D₁ σ), ∀ (o₂ : AcyclicIndegreeOrientation D₂ σ), + let I := D₁ ∩ D₂ + (∀ x ∈ I, (I.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))).card = + (I.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x))).card) → + ∀ x ∈ I, ∀ y ∈ I, o₁.edge x y ↔ o₂.edge x y := by + classical + intro D₁ D₂ σ o₁ o₂ I incoming_card + let B := I.filter (fun x => ∃ y ∈ I, o₁.edge x y ≠ o₂.edge x y) + intro x hx y hy + by_contra hxy + have hb : x ∈ B := by + simp only [B, Finset.mem_filter] + exact ⟨hx, y, hy, by + by_cases a : o₁.edge x y <;> by_cases b : o₂.edge x y <;> simp_all⟩ + obtain ⟨z, hz, hmin⟩ := Finset.exists_min_image B o₁.rank + (by exact ⟨x, hb⟩) + have hin : ∀ w ∈ I, o₁.edge w z → o₂.edge w z := by + intro w hw hwz + by_contra hn + have hwb : w ∈ B := by + simp only [B, Finset.mem_filter] + exact ⟨hw, ⟨z, (Finset.mem_filter.mp hz).1, by + intro he + exact hn (he ▸ hwz)⟩⟩ + exact (Nat.not_lt_of_ge (hmin w hwb)) (o₁.increasing w z hwz) + have hsub : I.filter (fun w => @decide (o₁.edge w z) (o₁.edge_decidable w z)) ⊆ + I.filter (fun w => @decide (o₂.edge w z) (o₂.edge_decidable w z)) := by + intro w hw + have hwI := (Finset.mem_filter.mp hw).1 + have he := (Finset.mem_filter.mp hw).2 + have he' : o₁.edge w z := @of_decide_eq_true (o₁.edge w z) + (o₁.edge_decidable w z) he + have ho := hin w hwI he' + have hot : @decide (o₂.edge w z) (o₂.edge_decidable w z) = true := by + exact (show @decide (o₂.edge w z) (o₂.edge_decidable w z) = true from + (@decide_eq_true_eq (o₂.edge w z) (o₂.edge_decidable w z)).mpr ho) + exact Finset.mem_filter.mpr ⟨hwI, hot⟩ + have heq := Finset.eq_of_subset_of_card_le hsub + (by rw [incoming_card z (Finset.mem_filter.mp hz).1]) + have hback : ∀ w ∈ I, o₂.edge w z → o₁.edge w z := by + intro w hw hwz + have hm : w ∈ I.filter (fun q => @decide (o₂.edge q z) (o₂.edge_decidable q z)) := + Finset.mem_filter.mpr ⟨hw, by simp [hwz]⟩ + have hm' := heq ▸ hm + exact @of_decide_eq_true (o₁.edge w z) (o₁.edge_decidable w z) + (Finset.mem_filter.mp hm').2 + have hzall : ∀ w ∈ I, o₁.edge w z ↔ o₂.edge w z := by + intro w hw + exact ⟨hin w hw, hback w hw⟩ + have hznot : z ∉ B := by + intro hzb + rcases (Finset.mem_filter.mp hzb) with ⟨hzI, w, hwI, hdiff⟩ + by_cases hadj : FourNeighborAdjacent z w + · rcases o₁.oriented z (Finset.mem_inter.mp (show z ∈ D₁ ∩ D₂ from hzI)).1 + w (Finset.mem_inter.mp (show w ∈ D₁ ∩ D₂ from hwI)).1 hadj with h | h + · have hzout : ¬ o₁.edge w z := h.2 + rcases o₂.oriented z (Finset.mem_inter.mp (show z ∈ D₁ ∩ D₂ from hzI)).2 + w (Finset.mem_inter.mp (show w ∈ D₁ ∩ D₂ from hwI)).2 hadj with k | k + · exact hdiff (propext ⟨fun q => k.1, fun q => h.1⟩) + · exact hzout ((hzall w hwI).2 k.1) + · have hzout : ¬ o₁.edge z w := h.2 + rcases o₂.oriented z (Finset.mem_inter.mp (show z ∈ D₁ ∩ D₂ from hzI)).2 + w (Finset.mem_inter.mp (show w ∈ D₁ ∩ D₂ from hwI)).2 hadj with k | k + · exact k.2 ((hzall w hwI).1 h.1) + · exact hdiff (propext ⟨False.elim ∘ hzout, False.elim ∘ k.2⟩) + · have h₁ : ¬ o₁.edge z w := by + intro q + exact hadj (o₁.supported z w q).2.2 + have h₂ : ¬ o₂.edge z w := by + intro q + exact hadj (o₂.supported z w q).2.2 + exact hdiff (propext (by simp [h₁, h₂])) + exact hznot hz + +private theorem edge_one : + ∀ (D₁ : Finset GaussianInt), ∀ (D₂ : Finset GaussianInt), ∀ (σ : GaussianInt → ℤ), ∀ (o₁ : + AcyclicIndegreeOrientation D₁ σ), ∀ (o₂ : AcyclicIndegreeOrientation D₂ σ), + let edge : GaussianInt → GaussianInt → Prop := fun x y => + if x ∈ D₁ ∧ y ∈ D₁ then o₁.edge x y + else if x ∈ D₂ ∧ y ∈ D₂ then o₂.edge x y else False + ∀ x ∈ D₁, ∀ y ∈ D₁, edge x y ↔ o₁.edge x y := by + classical + intro D₁ D₂ σ o₁ o₂ edge x hx y hy + simp [edge, hx, hy] + +private theorem edge_two : + ∀ (D₁ : Finset GaussianInt), ∀ (D₂ : Finset GaussianInt), ∀ (σ : GaussianInt → ℤ), ∀ (o₁ : + AcyclicIndegreeOrientation D₁ σ), ∀ (o₂ : AcyclicIndegreeOrientation D₂ σ), + let I := D₁ ∩ D₂ + (∀ x ∈ I, ∀ y ∈ I, o₁.edge x y ↔ o₂.edge x y) → + let edge : GaussianInt → GaussianInt → Prop := fun x y => + if x ∈ D₁ ∧ y ∈ D₁ then o₁.edge x y + else if x ∈ D₂ ∧ y ∈ D₂ then o₂.edge x y else False + ∀ x ∈ D₂, ∀ y ∈ D₂, edge x y ↔ o₂.edge x y := by + classical + intro D₁ D₂ σ o₁ o₂ I agreement edge x hx y hy + by_cases hxy : x ∈ D₁ ∧ y ∈ D₁ + · have hxi : x ∈ I := Finset.mem_inter.mpr ⟨hxy.1, hx⟩ + have hyi : y ∈ I := Finset.mem_inter.mpr ⟨hxy.2, hy⟩ + simp [edge, hxy, agreement x hxi y hyi] + · simp [edge, hxy, hx, hy] + +private theorem edge_support : + ∀ (D₁ : Finset GaussianInt), ∀ (D₂ : Finset GaussianInt), ∀ (σ : GaussianInt → ℤ), ∀ (o₁ : + AcyclicIndegreeOrientation D₁ σ), ∀ (o₂ : AcyclicIndegreeOrientation D₂ σ), + let U := D₁ ∪ D₂ + let edge : GaussianInt → GaussianInt → Prop := fun x y => + if x ∈ D₁ ∧ y ∈ D₁ then o₁.edge x y + else if x ∈ D₂ ∧ y ∈ D₂ then o₂.edge x y else False + ∀ x y, edge x y → x ∈ U ∧ y ∈ U ∧ FourNeighborAdjacent x y := by + classical + intro D₁ D₂ σ o₁ o₂ U edge x y h + by_cases h1 : x ∈ D₁ ∧ y ∈ D₁ + · have he : o₁.edge x y := by simpa [edge, h1] using h + exact ⟨Finset.mem_union.mpr (Or.inl h1.1), + Finset.mem_union.mpr (Or.inl h1.2), (o₁.supported x y he).2.2⟩ + · by_cases h2 : x ∈ D₂ ∧ y ∈ D₂ + · have he : o₂.edge x y := by simpa [edge, h1, h2] using h + exact ⟨Finset.mem_union.mpr (Or.inr h2.1), + Finset.mem_union.mpr (Or.inr h2.2), (o₂.supported x y he).2.2⟩ + · simp [edge, h1, h2] at h + +private theorem edge_oriented : + ∀ (D₁ : Finset GaussianInt), ∀ (D₂ : Finset GaussianInt), ∀ (σ : GaussianInt → ℤ), ∀ (o₁ : + AcyclicIndegreeOrientation D₁ σ), ∀ (o₂ : AcyclicIndegreeOrientation D₂ σ), (∀ x ∈ D₁, x + ∉ D₂ → ∀ y ∈ D₂, y ∉ D₁ → ¬ FourNeighborAdjacent x y) → + let U := D₁ ∪ D₂ + let edge : GaussianInt → GaussianInt → Prop := fun x y => + if x ∈ D₁ ∧ y ∈ D₁ then o₁.edge x y + else if x ∈ D₂ ∧ y ∈ D₂ then o₂.edge x y else False + ∀ x ∈ U, ∀ y ∈ U, FourNeighborAdjacent x y → + (edge x y ∧ ¬ edge y x) ∨ (edge y x ∧ ¬ edge x y) := by + classical + intro D₁ D₂ σ o₁ o₂ hcross U edge x hx y hy hxy + rcases Finset.mem_union.mp hx with hx1 | hx2 + · rcases Finset.mem_union.mp hy with hy1 | hy2 + · rcases o₁.oriented x hx1 y hy1 hxy with h | h + · simpa [edge, hx1, hy1] using (Or.inl h) + · simpa [edge, hx1, hy1] using (Or.inr h) + · by_cases hx2' : x ∈ D₂ + · by_cases hy1 : y ∈ D₁ + · rcases o₁.oriented x hx1 y hy1 hxy with h | h + · simpa [edge, hx1, hy1] using (Or.inl h) + · simpa [edge, hx1, hy1] using (Or.inr h) + · rcases o₂.oriented x hx2' y hy2 hxy with h | h + · simpa [edge, hx1, hy1, hy2, hx2'] using (Or.inl h) + · simpa [edge, hx1, hy1, hy2, hx2'] using (Or.inr h) + · by_cases hy1 : y ∈ D₁ + · rcases o₁.oriented x hx1 y hy1 hxy with h | h + · simpa [edge, hx1, hy1] using (Or.inl h) + · simpa [edge, hx1, hy1] using (Or.inr h) + · exfalso + exact hcross x hx1 hx2' y hy2 hy1 hxy + · rcases Finset.mem_union.mp hy with hy1 | hy2 + · by_cases hy2' : y ∈ D₂ + · by_cases hx1 : x ∈ D₁ + · rcases o₁.oriented x hx1 y hy1 hxy with h | h + · simpa [edge, hx1, hy1] using (Or.inl h) + · simpa [edge, hx1, hy1] using (Or.inr h) + · rcases o₂.oriented x hx2 y hy2' hxy with h | h + · simpa [edge, hx1, hy1, hx2, hy2'] using (Or.inl h) + · simpa [edge, hx1, hy1, hx2, hy2'] using (Or.inr h) + · by_cases hx1 : x ∈ D₁ + · rcases o₁.oriented x hx1 y hy1 hxy with h | h + · simpa [edge, hx1, hy1] using (Or.inl h) + · simpa [edge, hx1, hy1] using (Or.inr h) + · exfalso + have hsymm : FourNeighborAdjacent y x := by + rcases hxy with h | h | h | h <;> subst y <;> + simp [FourNeighborAdjacent] + exact hcross y hy1 hy2' x hx2 hx1 hsymm + · by_cases hboth : x ∈ D₁ ∧ y ∈ D₁ + · rcases o₁.oriented x hboth.1 y hboth.2 hxy with h | h + · simpa [edge, hboth] using (Or.inl h) + · simpa [edge, hboth] using (Or.inr h) + · rcases o₂.oriented x hx2 y hy2 hxy with h | h + · have hboth' : ¬(y ∈ D₁ ∧ x ∈ D₁) := by + intro q; exact hboth ⟨q.2, q.1⟩ + simpa [edge, hboth, hboth', hx2, hy2] using (Or.inl h) + · have hboth' : ¬(y ∈ D₁ ∧ x ∈ D₁) := by + intro q; exact hboth ⟨q.2, q.1⟩ + simpa [edge, hboth, hboth', hx2, hy2] using (Or.inr h) + +private theorem rank_one_bound : + ∀ (D₁ : Finset GaussianInt), ∀ (σ : GaussianInt → ℤ), ∀ (o₁ : AcyclicIndegreeOrientation D₁ + σ), ∀ x ∈ D₁, o₁.rank x ≤ D₁.sup o₁.rank := by + classical + intro D₁ σ o₁ x hx + exact Finset.le_sup hx + +private theorem rank_two_bound : + ∀ (D₂ : Finset GaussianInt), ∀ (σ : GaussianInt → ℤ), ∀ (o₂ : AcyclicIndegreeOrientation D₂ + σ), ∀ x ∈ D₂, o₂.rank x ≤ D₂.sup o₂.rank := by + classical + intro D₂ σ o₂ x hx + exact Finset.le_sup hx + +private theorem rank_increasing : + ∀ (D₁ : Finset GaussianInt), ∀ (D₂ : Finset GaussianInt), ∀ (σ : GaussianInt → ℤ), ∀ (o₁ : + AcyclicIndegreeOrientation D₁ σ), ∀ (o₂ : AcyclicIndegreeOrientation D₂ σ), (∀ x ∈ D₁ ∩ + D₂, ∀ y ∈ D₁, o₁.edge y x → y ∈ D₂) → (∀ x ∈ D₁ ∩ D₂, ∀ y ∈ D₂, o₂.edge y x → y ∈ D₁) → + let I := D₁ ∩ D₂ + (∀ x ∈ I, ∀ y ∈ I, o₁.edge x y ↔ o₂.edge x y) → + let edge : GaussianInt → GaussianInt → Prop := fun x y => + if x ∈ D₁ ∧ y ∈ D₁ then o₁.edge x y + else if x ∈ D₂ ∧ y ∈ D₂ then o₂.edge x y else False + let M : ℕ := D₁.sup o₁.rank + D₂.sup o₂.rank + 1 + let rank : GaussianInt → ℕ := fun x => + if x ∈ I then o₁.rank x else + if x ∈ D₁ then o₁.rank x + M else o₂.rank x + M + (∀ x ∈ D₁, o₁.rank x ≤ D₁.sup o₁.rank) → ∀ x y, edge x y → rank x < rank y := by + classical + intro D₁ D₂ σ o₁ o₂ hclosed₁ hclosed₂ I agreement edge M rank rank_one_bound x y hxy + by_cases h1 : x ∈ D₁ ∧ y ∈ D₁ + · have he := (by simpa [edge, h1] using hxy : o₁.edge x y) + have hxI : x ∈ I ↔ x ∈ D₂ := by simp [I, h1.1] + have hyI : y ∈ I ↔ y ∈ D₂ := by simp [I, h1.2] + by_cases hx' : x ∈ I + · by_cases hy' : y ∈ I + · simp? [rank, hx', hy'] + exact o₁.increasing x y he + · simp [rank, hx', hy', h1.2] + have hm : 0 < M := by simp [M] + have hr := rank_one_bound y h1.2 + have hp := rank_one_bound x h1.1 + simp [M] at * + omega + · by_cases hy' : y ∈ I + · have hbad : x ∈ D₂ := hclosed₁ y hy' x h1.1 he + exact (hx' (Finset.mem_inter.mpr ⟨h1.1, hbad⟩)).elim + · simp? [rank, hx', hy', h1.1, h1.2] + exact o₁.increasing x y he + · by_cases h2 : x ∈ D₂ ∧ y ∈ D₂ + · have he := (by simpa [edge, h1, h2] using hxy : o₂.edge x y) + by_cases hx' : x ∈ I + · by_cases hy' : y ∈ I + · simp? [rank, hx', hy'] + exact o₁.increasing x y ((agreement x hx' y hy').2 he) + · simp? [rank, hx', hy'] + by_cases hyD1 : y ∈ D₁ + · simp [hyD1] + have hp := rank_one_bound x (Finset.mem_inter.mp (show x ∈ D₁ ∩ D₂ from hx')).1 + have hm : 0 < M := by simp [M] + simp [M] at * + omega + · simp? [hyD1] + have hp := rank_one_bound x (Finset.mem_inter.mp (show x ∈ D₁ ∩ D₂ from hx')).1 + have hm : 0 < M := by simp [M] + simp [M] at * + omega + · by_cases hy' : y ∈ I + · have hbad : x ∈ D₁ := hclosed₂ y hy' x h2.1 he + exact (hx' (Finset.mem_inter.mpr ⟨hbad, h2.1⟩)).elim + · have hyD1 : ¬ y ∈ D₁ := by + intro q; exact hy' (Finset.mem_inter.mpr ⟨q, h2.2⟩) + have hxD1 : ¬ x ∈ D₁ := by + intro q; exact hx' (Finset.mem_inter.mpr ⟨q, h2.1⟩) + simp? [rank, hx', hy', hyD1, hxD1] + exact o₂.increasing x y he + · simp [edge, h1, h2] at hxy + +end ParentalOrientationLemmas + +theorem ParentalOrientationGluing + (D₁ D₂ : Finset GaussianInt) (σ : GaussianInt → ℤ) + (o₁ : AcyclicIndegreeOrientation D₁ σ) + (o₂ : AcyclicIndegreeOrientation D₂ σ) + (hcross : ∀ x ∈ D₁, x ∉ D₂ → ∀ y ∈ D₂, y ∉ D₁ → + ¬ FourNeighborAdjacent x y) + (hclosed₁ : ∀ x ∈ D₁ ∩ D₂, ∀ y ∈ D₁, + o₁.edge y x → y ∈ D₂) + (hclosed₂ : ∀ x ∈ D₁ ∩ D₂, ∀ y ∈ D₂, + o₂.edge y x → y ∈ D₁) : + ∃ o : AcyclicIndegreeOrientation (D₁ ∪ D₂) σ, + (∀ x ∈ D₁, ∀ y ∈ D₁, o.edge x y ↔ o₁.edge x y) ∧ + ∀ x ∈ D₂, ∀ y ∈ D₂, o.edge x y ↔ o₂.edge x y := by +-- BODY + classical + let I := D₁ ∩ D₂ + let U := D₁ ∪ D₂ + have incoming_one : ∀ x ∈ I, + (D₁.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))) = + (I.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))) := + ParentalOrientationLemmas.incoming_one D₁ D₂ σ o₁ hclosed₁ + have incoming_two : ∀ x ∈ I, + (D₂.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x))) = + (I.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x))) := + ParentalOrientationLemmas.incoming_two D₁ D₂ σ o₂ hclosed₂ + have incoming_card : ∀ x ∈ I, + (I.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))).card = + (I.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x))).card := + ParentalOrientationLemmas.incoming_card D₁ D₂ σ o₁ o₂ incoming_one incoming_two + let B := I.filter (fun x => ∃ y ∈ I, o₁.edge x y ≠ o₂.edge x y) + have agreement : ∀ x ∈ I, ∀ y ∈ I, o₁.edge x y ↔ o₂.edge x y := + ParentalOrientationLemmas.agreement D₁ D₂ σ o₁ o₂ incoming_card + let edge : GaussianInt → GaussianInt → Prop := fun x y => + if x ∈ D₁ ∧ y ∈ D₁ then o₁.edge x y + else if x ∈ D₂ ∧ y ∈ D₂ then o₂.edge x y else False + let M : ℕ := D₁.sup o₁.rank + D₂.sup o₂.rank + 1 + let rank : GaussianInt → ℕ := fun x => + if x ∈ I then o₁.rank x else + if x ∈ D₁ then o₁.rank x + M else o₂.rank x + M + have edge_one : ∀ x ∈ D₁, ∀ y ∈ D₁, edge x y ↔ o₁.edge x y := + ParentalOrientationLemmas.edge_one D₁ D₂ σ o₁ o₂ + have edge_two : ∀ x ∈ D₂, ∀ y ∈ D₂, edge x y ↔ o₂.edge x y := + ParentalOrientationLemmas.edge_two D₁ D₂ σ o₁ o₂ agreement + have edge_support : ∀ x y, edge x y → x ∈ U ∧ y ∈ U ∧ FourNeighborAdjacent x y := + ParentalOrientationLemmas.edge_support D₁ D₂ σ o₁ o₂ + have edge_oriented : ∀ x ∈ U, ∀ y ∈ U, FourNeighborAdjacent x y → + (edge x y ∧ ¬ edge y x) ∨ (edge y x ∧ ¬ edge x y) := + ParentalOrientationLemmas.edge_oriented D₁ D₂ σ o₁ o₂ hcross + have rank_one_bound : ∀ x ∈ D₁, o₁.rank x ≤ D₁.sup o₁.rank := + ParentalOrientationLemmas.rank_one_bound D₁ σ o₁ + have rank_two_bound : ∀ x ∈ D₂, o₂.rank x ≤ D₂.sup o₂.rank := + ParentalOrientationLemmas.rank_two_bound D₂ σ o₂ + have rank_increasing : ∀ x y, edge x y → rank x < rank y := + ParentalOrientationLemmas.rank_increasing D₁ D₂ σ o₁ o₂ hclosed₁ hclosed₂ agreement + rank_one_bound + let o : AcyclicIndegreeOrientation U σ := + { edge := edge + edge_decidable := fun x y => Classical.propDecidable _ + rank := rank + supported := edge_support + oriented := edge_oriented + increasing := rank_increasing + indegree := by + intro x hx + by_cases hx1 : x ∈ D₁ + · have hi := o₁.indegree x hx1 + have hf : U.filter (fun y => @decide (edge y x) (Classical.propDecidable _)) = + D₁.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x)) := by + ext y + simp only [Finset.mem_filter] + constructor + · intro h + rcases Finset.mem_union.mp h.1 with hy1 | hy2 + · exact ⟨hy1, by simpa [edge, hx1, hy1] using h.2⟩ + · by_cases hy1' : y ∈ D₁ + · exact ⟨hy1', by simpa [edge, hx1, hy1'] using h.2⟩ + · by_cases hx2 : x ∈ D₂ + · exfalso + have q : o₂.edge y x := by + simpa [edge, hx1, hy1', hy2, hx2] using h.2 + exact hy1' (hclosed₂ x (Finset.mem_inter.mpr ⟨hx1, hx2⟩) y hy2 q) + · exfalso + simpa [edge, hx1, hy1', hy2, hx2] using h.2 + · intro h + exact ⟨Finset.mem_union.mpr (Or.inl h.1), by + simpa [edge, hx1, h.1] using h.2⟩ + rw [hf] + exact hi + · have hx2 : x ∈ D₂ := Finset.mem_union.mp hx |>.resolve_left hx1 + have hi := o₂.indegree x hx2 + have hf : U.filter (fun y => @decide (edge y x) (Classical.propDecidable _)) = + D₂.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x)) := by + ext y + simp only [Finset.mem_filter] + constructor + · intro h + rcases Finset.mem_union.mp h.1 with hy1 | hy2 + · by_cases hy2' : y ∈ D₂ + · exact ⟨hy2', by simpa [edge, hx1, hy2', hx2] using h.2⟩ + · exact (hy2' (o₂.supported y x (by simpa [edge, hx1, hy1, hy2'] using h.2)).1).elim + · exact ⟨hy2, by simpa [edge, hx1, hy2, hx2] using h.2⟩ + · intro h + exact ⟨Finset.mem_union.mpr (Or.inr h.1), by + simpa [edge, hx1, h.1, hx2] using h.2⟩ + rw [hf] + exact hi } + refine ⟨o, ?_, ?_⟩ + · intro x hx y hy + exact edge_one x hx y hy + · intro x hx y hy + exact edge_two x hx y hy + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometer.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometer.lean new file mode 100644 index 0000000000..7a6ded71e5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometer.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction + +-- [TABLET NODE: PartialOdometer] + +/-! +# PartialOdometer + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A partial odometer is an integer-valued function on a finite subset +$T\subseteq\mathbb Z[i]$. Formally, we represent it by its finite domain +and by the extension of its values by zero outside that domain; values +outside the displayed domain are not part of the partial function. +-/ +structure PartialOdometer where +-- BODY + /-- The finite set of lattice vertices where the partial function is defined. -/ + domain : Finset GaussianInt + /-- The integer value function, extended by zero outside the finite domain. -/ + value : IntegerLatticeFunction + value_outside : ∀ x, x ∉ domain → value x = 0 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslate.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslate.lean new file mode 100644 index 0000000000..7fa48b6ed5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslate.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianTranslation +public import LeanPool.ApollonianSuperharmonic.PartialOdometer + +-- [TABLET NODE: PartialOdometerAffineTranslate] + +/-! +# PartialOdometerAffineTranslate + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a partial odometer $h$, Gaussian integers $u,a$, and $b\in\mathbb Z$, +the affine spatial translate +$\operatorname{AffTr}_{u,a,b}(h)$ has domain +$\tau_u(T(h))$, where $\tau_u(x)=x+u$. At a point of this translated +domain its value is +$$ + h(x-u)+\operatorname{Re}(a)\operatorname{Re}(x) + +\operatorname{Im}(a)\operatorname{Im}(x)+b. +$$ +Its total-function representative has value zero outside the translated +domain. +-/ +def PartialOdometerAffineTranslate (h : PartialOdometer) + (u a : GaussianInt) (b : ℤ) : PartialOdometer := +-- BODY + { domain := h.domain.image (GaussianTranslation u) + value := fun x => + if x ∈ h.domain.image (GaussianTranslation u) then + h.value (x - u) + a.re * x.re + a.im * x.im + b + else 0 + value_outside := by + intro x hx + simp [hx] } + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslateFormulas.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslateFormulas.lean new file mode 100644 index 0000000000..cd50653bc0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslateFormulas.lean @@ -0,0 +1,300 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslate +public import LeanPool.ApollonianSuperharmonic.PartialOdometer +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import LeanPool.ApollonianSuperharmonic.GaussianTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: PartialOdometerAffineTranslateFormulas] + +/-! +# PartialOdometerAffineTranslateFormulas + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PartialTranslationLemmas + +private theorem membership : + ∀ (h : PartialOdometer), ∀ (u : GaussianInt), ∀ (x : GaussianInt), x ∈ h.domain.image + (GaussianTranslation u) ↔ x - u ∈ h.domain := by + classical + intro h u x + constructor + · intro hx + rcases Finset.mem_image.mp hx with ⟨y, hy, rfl⟩ + simpa [GaussianTranslation, add_comm, add_left_comm, add_assoc] using hy + · intro hx + apply Finset.mem_image.mpr + refine ⟨x - u, hx, ?_⟩ + simp [GaussianTranslation, add_comm] + +private theorem setImage : + ∀ (h : PartialOdometer), ∀ (u : GaussianInt), ((h.domain.image (GaussianTranslation u) : + Finset GaussianInt) : Set GaussianInt) = + GaussianTranslation u '' (h.domain : Set GaussianInt) := by + classical + intro h u + ext x + constructor + · intro hx + change x ∈ h.domain.image (GaussianTranslation u) at hx + rcases Finset.mem_image.mp hx with ⟨y, hy, hxy⟩ + exact ⟨y, hy, hxy⟩ + · rintro ⟨y, hy, rfl⟩ + change GaussianTranslation u y ∈ h.domain.image (GaussianTranslation u) + exact Finset.mem_image.mpr ⟨y, hy, rfl⟩ + +end PartialTranslationLemmas + +namespace PartialTranslationSquares + +private theorem translatedSquares : + ∀ (h : PartialOdometer), ∀ (u : GaussianInt), ∀ (a : GaussianInt), ∀ (b : ℤ), + PartialOdometerSquares + ({ domain := h.domain.image (GaussianTranslation u) + value := fun x => + if x ∈ h.domain.image (GaussianTranslation u) then + h.value (x - u) + a.re * x.re + a.im * x.im + b + else 0 + value_outside := by + intro x hx + simp [hx] } : PartialOdometer) = + (PartialOdometerSquares h).image (GaussianTranslation u) := by + classical + intro h u a b + simp only [PartialOdometerSquares, Finset.filter_image] + congr 1 + ext x + simp [GaussianTranslation, add_assoc, add_comm] + +end PartialTranslationSquares + +theorem PartialOdometerAffineTranslateFormulas + (h : PartialOdometer) (u a : GaussianInt) (b : ℤ) : + (PartialOdometerAffineTranslate h u a b).domain = + h.domain.image (GaussianTranslation u) ∧ + (∀ x, x ∈ (PartialOdometerAffineTranslate h u a b).domain ↔ + x - u ∈ h.domain) ∧ + (∀ x, x ∈ (PartialOdometerAffineTranslate h u a b).domain → + (PartialOdometerAffineTranslate h u a b).value x = + h.value (x - u) + a.re * x.re + a.im * x.im + b) ∧ + (((PartialOdometerAffineTranslate h u a b).domain : Set GaussianInt) = + GaussianTranslation u '' (h.domain : Set GaussianInt)) ∧ + (∀ T : ProtoTile, + ((h.domain : Set GaussianInt) = FootprintVertices T) → + (((PartialOdometerAffineTranslate h u a b).domain : Set GaussianInt) = + FootprintVertices (TileTranslation T u))) ∧ + PartialOdometerSlope (PartialOdometerAffineTranslate h u a b) = + (PartialOdometerSlope h).map + (fun p => (p.1 + (a.re : ℝ), p.2 + (a.im : ℝ))) := by +-- BODY + classical + unfold PartialOdometerAffineTranslate + have membership (x : GaussianInt) : + x ∈ h.domain.image (GaussianTranslation u) ↔ x - u ∈ h.domain := + PartialTranslationLemmas.membership h u x + have setImage : + ((h.domain.image (GaussianTranslation u) : Finset GaussianInt) : Set GaussianInt) = + GaussianTranslation u '' (h.domain : Set GaussianInt) := + PartialTranslationLemmas.setImage h u + refine ⟨rfl, ?_, ?_, setImage, ?_, ?_⟩ + · intro x + exact membership x + · intro x hx + change x ∈ h.domain.image (GaussianTranslation u) at hx + have hxu := (membership x).mp hx + simp [hx] + · intro T hT + rw [setImage, hT] + rw [← (TileTranslationFormulas T u).2.2.2.2.2.1] + · change PartialOdometerSlope + ({ domain := h.domain.image (GaussianTranslation u) + value := fun x => + if x ∈ h.domain.image (GaussianTranslation u) then + h.value (x - u) + a.re * x.re + a.im * x.im + b + else 0 + value_outside := by + intro x hx + simp [hx] } : PartialOdometer) = _ + have translatedSquares := PartialTranslationSquares.translatedSquares h u a b + have valueFormula (z : GaussianInt) (hz : z ∈ h.domain) : + (if GaussianTranslation u z ∈ h.domain.image (GaussianTranslation u) then + h.value (GaussianTranslation u z - u) + a.re * (GaussianTranslation u z).re + + a.im * (GaussianTranslation u z).im + b + else 0) = + h.value z + a.re * (GaussianTranslation u z).re + + a.im * (GaussianTranslation u z).im + b := by + have hz' : GaussianTranslation u z - u ∈ h.domain := by + simpa [GaussianTranslation, add_assoc, add_comm, add_left_comm] using hz + rw [ite_eq_left ((membership _).mpr hz')] + simp [GaussianTranslation, add_comm, add_left_comm] + have reAdd (x y : GaussianInt) : + ((x + y).re : ℝ) = (x.re : ℝ) + (y.re : ℝ) := by + cases x; cases y; simp + have imAdd (x y : GaussianInt) : + ((x + y).im : ℝ) = (x.im : ℝ) + (y.im : ℝ) := by + cases x; cases y; simp + have reInt (x y : GaussianInt) : (x + y).re = x.re + y.re := by + cases x; cases y; rfl + have imInt (x y : GaussianInt) : (x + y).im = x.im + y.im := by + cases x; cases y; rfl + have horizontal (x : GaussianInt) (hx : x ∈ PartialOdometerSquares h) : + (((if GaussianTranslation u (x + 1) ∈ h.domain.image (GaussianTranslation u) then + h.value (GaussianTranslation u (x + 1) - u) + a.re * (GaussianTranslation u (x + 1)).re + + a.im * (GaussianTranslation u (x + 1)).im + b else 0) - + (if GaussianTranslation u x ∈ h.domain.image (GaussianTranslation u) then + h.value (GaussianTranslation u x - u) + a.re * (GaussianTranslation u x).re + + a.im * (GaussianTranslation u x).im + b else 0) + + (if GaussianTranslation u (x + 1 + ⟨0, 1⟩) ∈ h.domain.image (GaussianTranslation u) then + h.value (GaussianTranslation u (x + 1 + ⟨0, 1⟩) - u) + a.re * (GaussianTranslation u (x + + 1 + ⟨0, 1⟩)).re + + a.im * (GaussianTranslation u (x + 1 + ⟨0, 1⟩)).im + b else 0) - + (if GaussianTranslation u (x + ⟨0, 1⟩) ∈ h.domain.image (GaussianTranslation u) then + h.value (GaussianTranslation u (x + ⟨0, 1⟩) - u) + a.re * (GaussianTranslation u (x + + ⟨0, 1⟩)).re + + a.im * (GaussianTranslation u (x + ⟨0, 1⟩)).im + b else 0) : ℤ) : ℝ) = + ((h.value (x + 1) - h.value x + h.value (x + 1 + ⟨0, 1⟩) - + h.value (x + ⟨0, 1⟩) : ℤ) : ℝ) + 2 * (a.re : ℝ) := by + have hx0 := (Finset.mem_filter.mp hx).1 + have hx1 := (Finset.mem_filter.mp hx).2.1 + have hxi := (Finset.mem_filter.mp hx).2.2.1 + have hx1i := (Finset.mem_filter.mp hx).2.2.2 + rw [valueFormula (x + 1) hx1, valueFormula x hx0, + valueFormula (x + 1 + ⟨0, 1⟩) hx1i, valueFormula (x + ⟨0, 1⟩) hxi] + simp [GaussianTranslation, reInt, imInt] + ring + have vertical (x : GaussianInt) (hx : x ∈ PartialOdometerSquares h) : + (((if GaussianTranslation u (x + ⟨0, 1⟩) ∈ h.domain.image (GaussianTranslation u) then + h.value (GaussianTranslation u (x + ⟨0, 1⟩) - u) + a.re * (GaussianTranslation u (x + + ⟨0, 1⟩)).re + + a.im * (GaussianTranslation u (x + ⟨0, 1⟩)).im + b else 0) - + (if GaussianTranslation u x ∈ h.domain.image (GaussianTranslation u) then + h.value (GaussianTranslation u x - u) + a.re * (GaussianTranslation u x).re + + a.im * (GaussianTranslation u x).im + b else 0) + + (if GaussianTranslation u (x + 1 + ⟨0, 1⟩) ∈ h.domain.image (GaussianTranslation u) then + h.value (GaussianTranslation u (x + 1 + ⟨0, 1⟩) - u) + a.re * (GaussianTranslation u (x + + 1 + ⟨0, 1⟩)).re + + a.im * (GaussianTranslation u (x + 1 + ⟨0, 1⟩)).im + b else 0) - + (if GaussianTranslation u (x + 1) ∈ h.domain.image (GaussianTranslation u) then + h.value (GaussianTranslation u (x + 1) - u) + a.re * (GaussianTranslation u (x + 1)).re + + a.im * (GaussianTranslation u (x + 1)).im + b else 0) : ℤ) : ℝ) = + ((h.value (x + ⟨0, 1⟩) - h.value x + h.value (x + 1 + ⟨0, 1⟩) - + h.value (x + 1) : ℤ) : ℝ) + 2 * (a.im : ℝ) := by + have hx0 := (Finset.mem_filter.mp hx).1 + have hx1 := (Finset.mem_filter.mp hx).2.1 + have hxi := (Finset.mem_filter.mp hx).2.2.1 + have hx1i := (Finset.mem_filter.mp hx).2.2.2 + rw [valueFormula (x + ⟨0, 1⟩) hxi, valueFormula x hx0, + valueFormula (x + 1 + ⟨0, 1⟩) hx1i, valueFormula (x + 1) hx1] + simp [GaussianTranslation, reInt, imInt] + ring + simp only [PartialOdometerSlope] + rw [translatedSquares] + have injectiveTranslation : Function.Injective (GaussianTranslation u) := by + intro x y hxy + exact add_right_cancel hxy + by_cases hs : (PartialOdometerSquares h).Nonempty + · have hsi : (Finset.image (GaussianTranslation u) (PartialOdometerSquares h)).Nonempty := + hs.image _ + simp only [hsi, hs, ↓reduceIte, Option.map_some] + rw [Finset.card_image_of_injective _ injectiveTranslation] + rw [Finset.sum_image] + all_goals try exact injectiveTranslation.injOn + rw [Finset.sum_image] + all_goals try exact injectiveTranslation.injOn + congr 1 + · congr 2 + · have cardPositive : (PartialOdometerSquares h).card > 0 := hs.card_pos + have cardReal : ((PartialOdometerSquares h).card : ℝ) ≠ 0 := by + exact_mod_cast (Nat.ne_of_gt cardPositive) + field_simp [cardReal] + have constSum : + (∑ _x ∈ PartialOdometerSquares h, 2 * (a.re : ℝ)) = + 2 * (PartialOdometerSquares h).card * (a.re : ℝ) := by + rw [Finset.sum_const] + simp + ring + rw [← constSum] + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro x hx + have hx0 := (Finset.mem_filter.mp hx).1 + have hx1 := (Finset.mem_filter.mp hx).2.1 + have hxi := (Finset.mem_filter.mp hx).2.2.1 + have hx1i := (Finset.mem_filter.mp hx).2.2.2 + have h0' := (membership (GaussianTranslation u x)).mpr (by + simpa [GaussianTranslation, add_assoc, add_comm] using hx0) + have h1' := (membership (GaussianTranslation u x + 1)).mpr (by + simpa [GaussianTranslation, add_assoc, add_comm] using hx1) + have hi' := (membership (GaussianTranslation u x + ⟨0, 1⟩)).mpr (by + simpa [GaussianTranslation, add_assoc, add_comm] using hxi) + have h1i' := (membership (GaussianTranslation u x + 1 + ⟨0, 1⟩)).mpr (by + simpa [GaussianTranslation, add_assoc, add_comm] using hx1i) + rw [ite_eq_left h1', ite_eq_left h0', ite_eq_left h1i', ite_eq_left hi'] + have c0 : GaussianTranslation u x - u = x := by change x + u - u = x; abel + have c1 : GaussianTranslation u x + 1 - u = x + 1 := by change x + u + 1 - u = x + 1; abel + have ci : GaussianTranslation u x + ⟨0, 1⟩ - u = x + ⟨0, 1⟩ := by + change x + u + ⟨0, 1⟩ - u = x + ⟨0, 1⟩ + abel + have c1i : GaussianTranslation u x + 1 + ⟨0, 1⟩ - u = x + 1 + ⟨0, 1⟩ := by + change x + u + 1 + ⟨0, 1⟩ - u = x + 1 + ⟨0, 1⟩ + abel + rw [c1, c0, c1i, ci] + simp [reInt, imInt] + ring + · have cardPositive : (PartialOdometerSquares h).card > 0 := hs.card_pos + have cardReal : ((PartialOdometerSquares h).card : ℝ) ≠ 0 := by + exact_mod_cast (Nat.ne_of_gt cardPositive) + field_simp [cardReal] + have constSum : + (∑ _x ∈ PartialOdometerSquares h, 2 * (a.im : ℝ)) = + 2 * (PartialOdometerSquares h).card * (a.im : ℝ) := by + rw [Finset.sum_const] + simp + ring + rw [← constSum] + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro x hx + have hx0 := (Finset.mem_filter.mp hx).1 + have hx1 := (Finset.mem_filter.mp hx).2.1 + have hxi := (Finset.mem_filter.mp hx).2.2.1 + have hx1i := (Finset.mem_filter.mp hx).2.2.2 + have h0' := (membership (GaussianTranslation u x)).mpr (by + simpa [GaussianTranslation, add_assoc, add_comm] using hx0) + have h1' := (membership (GaussianTranslation u x + 1)).mpr (by + simpa [GaussianTranslation, add_assoc, add_comm] using hx1) + have hi' := (membership (GaussianTranslation u x + ⟨0, 1⟩)).mpr (by + simpa [GaussianTranslation, add_assoc, add_comm] using hxi) + have h1i' := (membership (GaussianTranslation u x + 1 + ⟨0, 1⟩)).mpr (by + simpa [GaussianTranslation, add_assoc, add_comm] using hx1i) + rw [ite_eq_left hi', ite_eq_left h0', ite_eq_left h1i', ite_eq_left h1'] + have c0 : GaussianTranslation u x - u = x := by change x + u - u = x; abel + have c1 : GaussianTranslation u x + 1 - u = x + 1 := by change x + u + 1 - u = x + 1; abel + have ci : GaussianTranslation u x + ⟨0, 1⟩ - u = x + ⟨0, 1⟩ := by + change x + u + ⟨0, 1⟩ - u = x + ⟨0, 1⟩ + abel + have c1i : GaussianTranslation u x + 1 + ⟨0, 1⟩ - u = x + 1 + ⟨0, 1⟩ := by + change x + u + 1 + ⟨0, 1⟩ - u = x + 1 + ⟨0, 1⟩ + abel + rw [ci, c0, c1i, c1] + simp [reInt, imInt] + ring + · simp [hs] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurn.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurn.lean new file mode 100644 index 0000000000..f82c868b10 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurn.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PartialOdometer + +-- [TABLET NODE: PartialOdometerHalfTurn] + +/-! +# PartialOdometerHalfTurn + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The origin half-turn of a partial odometer $h$ is the partial odometer +$h^{-}$ with domain $-\operatorname{dom}(h)$ and values +$h^{-}(x)=h(-x)$. Its stored total-function representative is set to zero +outside that reflected finite domain, as required by +`PartialOdometer`. +-/ +def PartialOdometerHalfTurn (h : PartialOdometer) : PartialOdometer := +-- BODY + { domain := h.domain.image (fun x => -x) + value := fun x => if -x ∈ h.domain then h.value (-x) else 0 + value_outside := by + intro x hx + split + next hmem => + exfalso + apply hx + exact Finset.mem_image.mpr ⟨-x, hmem, by simp⟩ + next => rfl } + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurnFormulas.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurnFormulas.lean new file mode 100644 index 0000000000..c77d12e221 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurnFormulas.lean @@ -0,0 +1,239 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurn +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares + +-- [TABLET NODE: PartialOdometerHalfTurnFormulas] + +/-! +# PartialOdometerHalfTurnFormulas + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem PartialOdometerHalfTurnFormulas (h : PartialOdometer) : + (∀ x, x ∈ (PartialOdometerHalfTurn h).domain ↔ -x ∈ h.domain) ∧ + (∀ x, x ∈ (PartialOdometerHalfTurn h).domain → + (PartialOdometerHalfTurn h).value x = h.value (-x)) ∧ + PartialOdometerSquares (PartialOdometerHalfTurn h) = + (PartialOdometerSquares h).image (fun x => -x - 1 - ⟨0, 1⟩) ∧ + (PartialOdometerSquares (PartialOdometerHalfTurn h)).card = + (PartialOdometerSquares h).card ∧ + (∑ y ∈ PartialOdometerSquares (PartialOdometerHalfTurn h), + ((PartialOdometerHalfTurn h).value (y + 1) - + (PartialOdometerHalfTurn h).value y + + (PartialOdometerHalfTurn h).value (y + 1 + ⟨0, 1⟩) - + (PartialOdometerHalfTurn h).value (y + ⟨0, 1⟩) : ℤ)) = + -(∑ x ∈ PartialOdometerSquares h, + (h.value (x + 1) - h.value x + + h.value (x + 1 + ⟨0, 1⟩) - h.value (x + ⟨0, 1⟩) : ℤ)) ∧ + (∑ y ∈ PartialOdometerSquares (PartialOdometerHalfTurn h), + ((PartialOdometerHalfTurn h).value (y + ⟨0, 1⟩) - + (PartialOdometerHalfTurn h).value y + + (PartialOdometerHalfTurn h).value (y + 1 + ⟨0, 1⟩) - + (PartialOdometerHalfTurn h).value (y + 1) : ℤ)) = + -(∑ x ∈ PartialOdometerSquares h, + (h.value (x + ⟨0, 1⟩) - h.value x + + h.value (x + 1 + ⟨0, 1⟩) - h.value (x + 1) : ℤ)) ∧ + PartialOdometerSlope (PartialOdometerHalfTurn h) = + (PartialOdometerSlope h).map (fun p => (-p.1, -p.2)) := by +-- BODY + classical + unfold PartialOdometerHalfTurn + have membership (x : GaussianInt) : + x ∈ h.domain.image (fun z => -z) ↔ -x ∈ h.domain := by + constructor + · intro hx + change x ∈ h.domain.image (fun z => -z) at hx + rcases Finset.mem_image.mp hx with ⟨z, hz, heq⟩ + rw [← heq] + simpa using hz + · intro hx + exact Finset.mem_image.mpr ⟨-x, hx, by simp⟩ + have valueFormula (x : GaussianInt) + (hx : x ∈ h.domain.image (fun z => -z)) : + (if -x ∈ h.domain then h.value (-x) else 0) = h.value (-x) := by + rw [ite_eq_left ((membership x).mp hx)] + have squaresImage : + PartialOdometerSquares + ({ domain := h.domain.image (fun z => -z) + value := fun x => if -x ∈ h.domain then h.value (-x) else 0 + value_outside := by + intro x hx + rw [ite_eq_right] + intro hm + exact hx ((membership x).mpr hm) } : PartialOdometer) = + (PartialOdometerSquares h).image (fun x => -x - 1 - ⟨0, 1⟩) := by + simp only [PartialOdometerSquares] + ext x + constructor + · intro hx + change x ∈ (h.domain.image (fun z => -z)).filter _ at hx + rcases Finset.mem_filter.mp hx with ⟨hxdom, hxc⟩ + rcases Finset.mem_image.mp hxdom with ⟨z, hz, heq⟩ + subst x + have hz0' : z ∈ h.domain := hz + have hz1' : z - 1 ∈ h.domain := by + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using + (membership (-z + 1)).mp hxc.1 + have hzi' : z - ⟨0, 1⟩ ∈ h.domain := by + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using + (membership (-z + ⟨0, 1⟩)).mp hxc.2.1 + have hz1i' : z - 1 - ⟨0, 1⟩ ∈ h.domain := by + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using + (membership (-z + 1 + ⟨0, 1⟩)).mp hxc.2.2 + apply Finset.mem_image.mpr + refine ⟨z - 1 - ⟨0, 1⟩, ?_, ?_⟩ + · simp only [Finset.mem_filter] + refine ⟨hz1i', ?_, ?_, ?_⟩ + · simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hzi' + · simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hz1' + · simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hz0' + · simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + · intro hx + rcases Finset.mem_image.mp hx with ⟨z, hz, rfl⟩ + simp only [Finset.mem_filter] at hz + rcases hz with ⟨hz0, hz1, hzi, hz1i⟩ + apply Finset.mem_filter.mpr + refine ⟨Finset.mem_image.mpr ⟨z + 1 + ⟨0, 1⟩, ?_, ?_⟩, ?_⟩ + · exact hz1i + · simp [sub_eq_add_neg, add_assoc, add_comm] + refine ⟨?_, ?_, ?_⟩ + · apply (membership _).mpr + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hzi + · apply (membership _).mpr + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hz1 + · apply (membership _).mpr + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hz0 + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro x + exact membership x + · intro x hx + exact valueFormula x hx + · exact squaresImage + · rw [squaresImage] + apply Finset.card_image_of_injective + intro x y hxy + simpa using sub_left_injective hxy + · rw [squaresImage] + have injectiveMap : Function.Injective (fun x : GaussianInt => -x - 1 - ⟨0, 1⟩) := by + intro x y hxy + simpa using sub_left_injective hxy + rw [Finset.sum_image] + · rw [← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro x hx + have hx0 := (Finset.mem_filter.mp hx).1 + have hx1 := (Finset.mem_filter.mp hx).2.1 + have hxi := (Finset.mem_filter.mp hx).2.2.1 + have hx1i := (Finset.mem_filter.mp hx).2.2.2 + have hm0 : -x ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr; simpa using hx0 + have hm1 : -(x + 1) ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr; simpa using hx1 + have hmi : -(x + ⟨0, 1⟩) ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr; simpa using hxi + have hm1i : -(x + 1 + ⟨0, 1⟩) ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr; simpa using hx1i + have ha : -x - 1 - ⟨0, 1⟩ + 1 ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hxi + have hb : -x - 1 - ⟨0, 1⟩ ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hx1i + have hc : -x - 1 - ⟨0, 1⟩ + 1 + ⟨0, 1⟩ ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hx0 + have hd : -x - 1 - ⟨0, 1⟩ + ⟨0, 1⟩ ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hx1 + dsimp + rw [valueFormula _ ha, valueFormula _ hb, valueFormula _ hc, valueFormula _ hd] + simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + · exact injectiveMap.injOn + · rw [squaresImage] + have injectiveMap : Function.Injective (fun x : GaussianInt => -x - 1 - ⟨0, 1⟩) := by + intro x y hxy + simpa using sub_left_injective hxy + rw [Finset.sum_image] + · rw [← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro x hx + have hx0 := (Finset.mem_filter.mp hx).1 + have hx1 := (Finset.mem_filter.mp hx).2.1 + have hxi := (Finset.mem_filter.mp hx).2.2.1 + have hx1i := (Finset.mem_filter.mp hx).2.2.2 + have ha : -x - 1 - ⟨0, 1⟩ + 1 ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hxi + have hb : -x - 1 - ⟨0, 1⟩ ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hx1i + have hc : -x - 1 - ⟨0, 1⟩ + 1 + ⟨0, 1⟩ ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hx0 + have hd : -x - 1 - ⟨0, 1⟩ + ⟨0, 1⟩ ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hx1 + dsimp + rw [valueFormula _ hd, valueFormula _ hb, + valueFormula _ hc, valueFormula _ ha] + simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + · exact injectiveMap.injOn + · simp only [PartialOdometerSlope] + rw [squaresImage] + by_cases hs : (PartialOdometerSquares h).Nonempty + · have hsi := hs.image (fun x : GaussianInt => -x - 1 - ⟨0, 1⟩) + simp only [hs, hsi, ↓reduceIte, Option.map_some] + have inj : Function.Injective (fun x : GaussianInt => -x - 1 - ⟨0, 1⟩) := by + intro x y e + simpa using sub_left_injective e + rw [Finset.card_image_of_injective _ inj, Finset.sum_image, Finset.sum_image] + all_goals try exact inj.injOn + congr 1; congr 1 + all_goals + have hc : ((PartialOdometerSquares h).card : ℝ) ≠ 0 := by + exact_mod_cast (Nat.ne_of_gt hs.card_pos) + field_simp [hc] + rw [← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro x hx + have hx0 := (Finset.mem_filter.mp hx).1 + have hx1 := (Finset.mem_filter.mp hx).2.1 + have hxi := (Finset.mem_filter.mp hx).2.2.1 + have hx1i := (Finset.mem_filter.mp hx).2.2.2 + have ha : -x - 1 - ⟨0, 1⟩ + 1 ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hxi + have hb : -x - 1 - ⟨0, 1⟩ ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hx1i + have hc' : -x - 1 - ⟨0, 1⟩ + 1 + ⟨0, 1⟩ ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hx0 + have hd : -x - 1 - ⟨0, 1⟩ + ⟨0, 1⟩ ∈ h.domain.image (fun z => -z) := by + apply (membership _).mpr + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hx1 + rw [valueFormula _ ha, valueFormula _ hb, valueFormula _ hc', valueFormula _ hd] + rw [show -(-x - 1 - (⟨0, 1⟩ : GaussianInt) + 1) = x + ⟨0, 1⟩ by abel, + show -(-x - 1 - (⟨0, 1⟩ : GaussianInt)) = x + 1 + ⟨0, 1⟩ by abel, + show -(-x - 1 - (⟨0, 1⟩ : GaussianInt) + 1 + ⟨0, 1⟩) = x by abel, + show -(-x - 1 - (⟨0, 1⟩ : GaussianInt) + ⟨0, 1⟩) = x + 1 by abel] + push_cast + ring + · simp [hs] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometerSlope.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometerSlope.lean new file mode 100644 index 0000000000..f0dcb76f38 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometerSlope.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares + +-- [TABLET NODE: PartialOdometerSlope] + +/-! +# PartialOdometerSlope + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +If $S(h)$ is nonempty, the slope of a partial odometer $h$ is the average, +over $x\in S(h)$, of +$$ + \frac12\bigl(h(x+1)-h(x)+h(x+1+i)-h(x+i)\bigr) + +\frac i2\bigl(h(x+i)-h(x)+h(x+1+i)-h(x+1)\bigr). +$$ +We record this complex number by its ordered pair of real and imaginary +parts. If $S(h)$ is empty, the slope is undefined. In particular it is +undefined on a singleton domain, as required for the curvature-zero tile. +-/ +noncomputable def PartialOdometerSlope + (h : PartialOdometer) : Option (ℝ × ℝ) := +-- BODY + let S := PartialOdometerSquares h + if S.Nonempty then + some + ((∑ x ∈ S, + ((h.value (x + 1) - h.value x + + h.value (x + 1 + ⟨0, 1⟩) - h.value (x + ⟨0, 1⟩) : ℤ) : ℝ)) / + (2 * (S.card : ℝ)), + (∑ x ∈ S, + ((h.value (x + ⟨0, 1⟩) - h.value x + + h.value (x + 1 + ⟨0, 1⟩) - h.value (x + 1) : ℤ) : ℝ)) / + (2 * (S.card : ℝ))) + else none + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometerSquares.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometerSquares.lean new file mode 100644 index 0000000000..893032bf13 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometerSquares.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PartialOdometer + +-- [TABLET NODE: PartialOdometerSquares] + +/-! +# PartialOdometerSquares + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a partial odometer $h$ with domain $T(h)$, let $S(h)$ be the finite set +of all $x\in\mathbb Z[i]$ for which the four vertices +$x,x+1,x+i,x+1+i$ all belong to $T(h)$. Thus $S(h)$ indexes the unit +squares wholly contained in the domain. +-/ +def PartialOdometerSquares (h : PartialOdometer) : Finset GaussianInt := +-- BODY + h.domain.filter fun x => + x + 1 ∈ h.domain ∧ x + ⟨0, 1⟩ ∈ h.domain ∧ + x + 1 + ⟨0, 1⟩ ∈ h.domain + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean new file mode 100644 index 0000000000..06698a14c0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean @@ -0,0 +1,1084 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LambdaTiling +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton +public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary + +-- [TABLET NODE: PeriodicBoundaryWebConnected] + +/-! +# PeriodicBoundaryWebConnected + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace BoundaryWebGeometry + +private theorem gridWalk : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∃ p : List GaussianInt, p.head? = some x ∧ + p.getLast? = some y ∧ List.IsChain FourNeighborAdjacent p ) := by + classical + intro x y + let dist (a b : GaussianInt) : Nat := + (b.re - a.re).natAbs + (b.im - a.im).natAbs + have aux : ∀ n (a b : GaussianInt), dist a b = n → + ∃ p : List GaussianInt, + p.head? = some a ∧ p.getLast? = some b ∧ + List.IsChain FourNeighborAdjacent p := by + intro n + induction n using Nat.strong_induction_on with + | h n ih => + intro a b hab + by_cases hre : a.re < b.re + · let c := a + 1 + have hdist : dist c b < n := by + dsimp [dist] at hab ⊢ + have h1 : 0 ≤ b.re - a.re := by omega + have h2 : 0 ≤ b.re - a.re - 1 := by omega + have hc : b.re - c.re = b.re - a.re - 1 := by simp [c]; omega + have hcast : ((dist c b : Nat) : Int) < n := by + dsimp [dist] + have hIm : b.im - c.im = b.im - a.im := by simp [c] + rw [hc, Int.natAbs_of_nonneg h2, hIm] + have habcast : ((dist a b : Nat) : Int) = n := by exact_mod_cast hab + dsimp [dist] at habcast + rw [Int.natAbs_of_nonneg h1] at habcast + rw [← habcast] + omega + exact_mod_cast hcast + obtain ⟨p, hp, hlast, hchain⟩ := ih (dist c b) hdist c b rfl + refine ⟨a :: p, ?_, ?_, ?_⟩ + · simp + · cases p with + | nil => simp at hp + | cons q qs => + cases qs with + | nil => simpa using hlast + | cons r rs => simpa using hlast + · apply List.isChain_cons.2 + refine ⟨?_, hchain⟩ + rw [hp] + simp [FourNeighborAdjacent, c] + · by_cases hge : a.re > b.re + · let c := a - 1 + have hdist : dist c b < n := by + dsimp [dist] at hab ⊢ + have h1 : 0 ≤ a.re - b.re := by omega + have h2 : 0 ≤ a.re - b.re - 1 := by omega + have hc : (b.re - c.re).natAbs = (a.re - b.re - 1).natAbs := by + simp [c]; omega + have hcast : ((dist c b : Nat) : Int) < n := by + dsimp [dist] + have hIm : b.im - c.im = b.im - a.im := by simp [c] + rw [hc, Int.natAbs_of_nonneg h2, hIm] + have habcast : ((dist a b : Nat) : Int) = n := by exact_mod_cast hab + dsimp [dist] at habcast + rw [show b.re - a.re = -(a.re - b.re) by omega, + Int.natAbs_neg, Int.natAbs_of_nonneg h1] at habcast + rw [← habcast] + omega + exact_mod_cast hcast + obtain ⟨p, hp, hlast, hchain⟩ := ih (dist c b) hdist c b rfl + refine ⟨a :: p, ?_, ?_, ?_⟩ + · simp + · cases p with + | nil => simp at hp + | cons q qs => + cases qs with + | nil => simpa using hlast + | cons r rs => simpa using hlast + · apply List.isChain_cons.2 + refine ⟨?_, hchain⟩ + rw [hp] + simp [FourNeighborAdjacent, c] + · by_cases him : a.im < b.im + · let c := a + ⟨0, 1⟩ + have hdist : dist c b < n := by + dsimp [dist] at hab ⊢ + have h1 : 0 ≤ b.im - a.im := by omega + have h2 : 0 ≤ b.im - a.im - 1 := by omega + have hc : b.im - c.im = b.im - a.im - 1 := by simp [c]; omega + have hcast : ((dist c b : Nat) : Int) < n := by + dsimp [dist] + have hRe : b.re - c.re = b.re - a.re := by simp [c] + rw [hRe, hc, Int.natAbs_of_nonneg h2] + have habcast : ((dist a b : Nat) : Int) = n := by exact_mod_cast hab + dsimp [dist] at habcast + rw [Int.natAbs_of_nonneg (show 0 ≤ b.re - a.re by omega)] at habcast + rw [← habcast] + omega + exact_mod_cast hcast + obtain ⟨p, hp, hlast, hchain⟩ := ih (dist c b) hdist c b rfl + refine ⟨a :: p, ?_, ?_, ?_⟩ + · simp + · cases p with + | nil => simp at hp + | cons q qs => + cases qs with + | nil => simpa using hlast + | cons r rs => simpa using hlast + · apply List.isChain_cons.2 + refine ⟨?_, hchain⟩ + rw [hp] + simp [FourNeighborAdjacent, c] + · by_cases hmi : a.im > b.im + · let c := a - ⟨0, 1⟩ + have hdist : dist c b < n := by + dsimp [dist] at hab ⊢ + have h1 : 0 ≤ a.im - b.im := by omega + have h2 : 0 ≤ a.im - b.im - 1 := by omega + have hc : (b.im - c.im).natAbs = (a.im - b.im - 1).natAbs := by + simp [c]; omega + have hcast : ((dist c b : Nat) : Int) < n := by + dsimp [dist] + have hRe : b.re - c.re = b.re - a.re := by simp [c] + rw [hRe, hc, Int.natAbs_of_nonneg h2] + have habcast : ((dist a b : Nat) : Int) = n := by exact_mod_cast hab + dsimp [dist] at habcast + rw [show b.im - a.im = -(a.im - b.im) by omega, + Int.natAbs_neg, Int.natAbs_of_nonneg h1] at habcast + rw [← habcast] + omega + exact_mod_cast hcast + obtain ⟨p, hp, hlast, hchain⟩ := ih (dist c b) hdist c b rfl + refine ⟨a :: p, ?_, ?_, ?_⟩ + · simp + · cases p with + | nil => simp at hp + | cons q qs => + cases qs with + | nil => simpa using hlast + | cons r rs => simpa using hlast + · apply List.isChain_cons.2 + refine ⟨?_, hchain⟩ + rw [hp] + simp [FourNeighborAdjacent, c] + · have heq : a = b := by + simpa [Zsqrtd.ext_iff] using + And.intro (show a.re = b.re by omega) + (show a.im = b.im by omega) + subst b + exact ⟨[a], by simp, by simp, List.isChain_singleton _⟩ + exact aux (dist x y) x y rfl + +private theorem hW : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (a : GaussianInt), (T.cells = {a}) → + ((TilingLattice C = ⊤) → ((({x | ∃ v, v ∈ TilingLattice C ∧ x ∈ + BoundaryFootprintVertices (TileTranslation T v)} : Set GaussianInt)) = Set.univ)) ) + := by + classical + intro C T a ha hlatC + ext x + constructor + · intro _ + simp + · intro _ + refine ⟨x - a, ?_, ?_⟩ + · rw [hlatC] + simp + · rw [((TileTranslationFormulas T (x - a)).2.2.2.2.2.2.2.1)] + have hboundary : a ∈ BoundaryFootprintVertices T := by + rw [BoundaryFootprintVertices, ite_eq_left] + · refine ⟨{a, a + 1}, ?_, by simp⟩ + refine ⟨a, Or.inl ⟨rfl, ?_⟩⟩ + rw [ha] + simp [Zsqrtd.ext_iff] + · rw [ha] + simp + exact ⟨a, hboundary, by simp [GaussianTranslation, sub_eq_add_neg, + ]⟩ + +private theorem hproper : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (SemiProperQuadruple q) → + ((q (0 : Fin (4 : ℕ)) = C.1.1) → ((∀ (j : Fin (3 : ℕ)), (q j.succ).1 < C.1.1.1) → + (ProperBandQuadruple q))) ) := by + classical + intro C q hsemi hqC hlt + refine ⟨hsemi, ?_⟩ + intro j + simpa [hqC] using hlt j + +private theorem indexWalk : + (by + classical + exact + ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (a : TilingLattice + C), ∀ (b : TilingLattice C), ∃ p : List (TilingLattice C), p.head? = some a ∧ + p.getLast? = some b ∧ List.IsChain P.plane.adjacent p ) := by + classical + intro C P a b + obtain ⟨p, hhead, hlast, _, hstep⟩ := + P.plane.three_connected ∅ (by simp) a (by simp) b (by simp) + exact ⟨p, hhead, hlast, + List.isChain_iff_forall_rel_of_append_cons_cons.mpr hstep⟩ + +private theorem listPrefix : + (by + classical + exact + ∀ (R : GaussianInt → GaussianInt → Prop), ∀ (p : List GaussianInt), ∀ (x : GaussianInt), + (x ∈ p) → ((List.IsChain R p) → (∃ q : List GaussianInt, q.head? = p.head? ∧ + q.getLast? = some x ∧ (∀ z ∈ q, z ∈ p) ∧ List.IsChain R q)) ) := by + classical + intro R p x hx hc + induction p with + | nil => simp at hx + | cons a p ih => + simp only [List.mem_cons] at hx + rcases hx with rfl | hx + · exact ⟨[x], by simp, by simp, + by intro z hz; simp at hz; subst z; simp, + List.isChain_singleton _⟩ + · obtain ⟨q, hqhead, hqlast, hqmem, hqchain⟩ := ih hx hc.tail + cases q with + | nil => + cases p with + | nil => simp at hx + | cons b p => simp at hqhead + | cons b q => + refine ⟨a :: b :: q, by simp, ?_, ?_, ?_⟩ + · simpa using hqlast + · intro z hz + simp only [List.mem_cons] at hz + rcases hz with hza | hz + · subst z + exact List.mem_cons_self + · rcases hz with hzb | hz + · subst z + have hb : b ∈ p := by + cases p with + | nil => simp at hqhead + | cons c p => + have hcb : c = b := by simpa using hqhead.symm + subst c + simp + exact List.mem_cons_of_mem a hb + · exact List.mem_cons_of_mem a + (hqmem z (List.mem_cons_of_mem b hz)) + · apply List.isChain_cons.mpr + refine ⟨?_, hqchain⟩ + intro z hz + have hz' : z ∈ p.head? := by rw [← hqhead]; exact hz + exact (List.isChain_cons.mp hc).1 z hz' + +private theorem listLoopRoute : + (by + classical + exact + (∀ (R : GaussianInt → GaussianInt → Prop), ∀ (p : List GaussianInt), ∀ (x : GaussianInt), + (x ∈ p) → ((List.IsChain R p) → (∃ q : List GaussianInt, q.head? = p.head? ∧ + q.getLast? = some x ∧ (∀ z ∈ q, z ∈ p) ∧ List.IsChain R q))) → (∀ (R : GaussianInt → + GaussianInt → Prop), (∀ a, ∀ b, R a b → R b a) → (∀ (p : List GaussianInt), (p ≠ []) + → ((List.IsChain R p) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), (x ∈ p) → ((y ∈ p) + → (∃ q : List GaussianInt, q.head? = some x ∧ q.getLast? = some y ∧ (∀ z ∈ q, z ∈ p) + ∧ List.IsChain R q)))))) ) := by + classical + intro listPrefix R hsymm p hpne hc x y hx hy + obtain ⟨px, hpxhead, hpxlast, hpxmem, hpxchain⟩ := + listPrefix R p x hx hc + obtain ⟨py, hpyhead, hpyLast, hpyMem, hpyChain⟩ := + listPrefix R p y hy hc + let q := px.reverse ++ py.tail + have phead : p.head? ≠ none := by + cases p with + | nil => exact (hpne rfl).elim + | cons a p => simp + have hrev : List.IsChain R px.reverse := by + apply List.isChain_reverse.mpr + exact (List.IsChain.iff (by + intro a b + exact ⟨hsymm a b, hsymm b a⟩)).mp hpxchain + have hqchain : List.IsChain R q := by + change List.IsChain R (px.reverse ++ py.tail) + rw [List.isChain_append] + refine ⟨hrev, hpyChain.tail, ?_⟩ + intro a ha b hb + cases py with + | nil => exact False.elim (phead hpyhead.symm) + | cons r rs => + cases rs with + | nil => simp at hb + | cons s ss => + have hroot : p.head? = some r := by simpa using hpyhead.symm + have ha' : r = a := by + simpa [List.getLast?_reverse, hpxhead, hroot] using ha + have hb' : b = s := by simpa using hb.symm + rw [← ha', hb'] + exact (List.isChain_cons.mp hpyChain).1 s (by simp) + have hqhead : q.head? = some x := by + simp [q, List.head?_reverse, hpxlast] + have hqLast : q.getLast? = some y := by + cases py with + | nil => exact False.elim (phead hpyhead.symm) + | cons r rs => + cases rs with + | nil => + have hroot : p.head? = some r := by simpa using hpyhead.symm + have hry : r = y := by simpa using hpyLast + simp [q, List.getLast?_reverse, hpxhead, hroot, hry] + | cons s ss => + have hlast : (s :: ss).getLast? = some y := by simpa using hpyLast + simpa [q] using hlast + have hqmem : ∀ z ∈ q, z ∈ p := by + intro z hz + simp only [q, List.mem_append, List.mem_reverse] at hz + rcases hz with hz | hz + · exact hpxmem z hz + · exact hpyMem z (List.mem_of_mem_tail hz) + exact ⟨q, hqhead, hqLast, hqmem, hqchain⟩ + +private theorem adjacentSymm : + (by + classical + exact + ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → + (FourNeighborAdjacent b a) ) := by + classical + intro a b h + rcases h with h | h | h | h <;> subst b + all_goals simp [FourNeighborAdjacent, Zsqrtd.ext_iff] + +private theorem cyclePath : + (by + classical + exact + (∀ (R : GaussianInt → GaussianInt → Prop), (∀ a, ∀ b, R a b → R b a) → (∀ (p : List + GaussianInt), (p ≠ []) → ((List.IsChain R p) → (∀ (x : GaussianInt), ∀ (y : + GaussianInt), (x ∈ p) → ((y ∈ p) → (∃ q : List GaussianInt, q.head? = some x ∧ + q.getLast? = some y ∧ (∀ z ∈ q, z ∈ p) ∧ List.IsChain R q)))))) → ((∀ (a : + GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → (FourNeighborAdjacent + b a)) → (∀ (U : ProtoTile), (LatticeTile U) → (∀ (x : GaussianInt), ∀ (y : + GaussianInt), (x ∈ BoundaryFootprintVertices U) → ((y ∈ BoundaryFootprintVertices U) + → (∃ p : List GaussianInt, p.head? = some x ∧ p.getLast? = some y ∧ (∀ z ∈ p, z ∈ + BoundaryFootprintVertices U) ∧ List.IsChain FourNeighborAdjacent p))))) ) := by + classical + intro listLoopRoute adjacentSymm U hU x y hx hy + obtain ⟨p, x₀, y₀, _, hlen, _, _, hverts, _, hsteps, _⟩ := + LatticeTileGridStructure U hU |>.2.2 + have hpne : p ≠ [] := by + intro he + simp [he] at hlen + have hchain : List.IsChain FourNeighborAdjacent p := + List.isChain_iff_forall_rel_of_append_cons_cons.mpr hsteps + have hxmem : x ∈ p := by + rw [hverts] at hx + simpa using hx + have hymem : y ∈ p := by + rw [hverts] at hy + simpa using hy + obtain ⟨l, hhead, hlast, hmem, hpath⟩ := + listLoopRoute FourNeighborAdjacent (fun a b h => adjacentSymm a b h) + p hpne hchain x y hxmem hymem + exact ⟨l, hhead, hlast, fun z hz => by + rw [hverts] + simpa using hmem z hz, hpath⟩ + +private theorem pathConcat : + (by + classical + exact + ∀ (S : Set GaussianInt), ∀ (p : List GaussianInt), ∀ (q : List GaussianInt), ∀ (x : + GaussianInt), ∀ (z : GaussianInt), ∀ (y : GaussianInt), (p.head? = some x) → + ((p.getLast? = some z) → ((∀ w ∈ p, w ∈ S) → ((List.IsChain FourNeighborAdjacent p) → + ((q.head? = some z) → ((q.getLast? = some y) → ((∀ w ∈ q, w ∈ S) → ((List.IsChain + FourNeighborAdjacent q) → (∃ r : List GaussianInt, r.head? = some x ∧ r.getLast? = + some y ∧ (∀ w ∈ r, w ∈ S) ∧ List.IsChain FourNeighborAdjacent r)))))))) ) := by + classical + intro S p q x z y hphead hplast hpmem hpchain hqhead hqlast hqmem hqchain + let r := p ++ q.tail + have hchain : List.IsChain FourNeighborAdjacent r := by + change List.IsChain FourNeighborAdjacent (p ++ q.tail) + rw [List.isChain_append] + refine ⟨hpchain, hqchain.tail, ?_⟩ + intro a ha b hb + cases q with + | nil => simp at hqhead + | cons z' qs => + cases qs with + | nil => simp at hb + | cons w ws => + have hz' : z' = z := Option.some.inj (by simpa using hqhead) + have ha' : z = a := by simpa [hplast] using ha + have hb' : b = w := by simpa using hb.symm + have hza : a = z' := (hz'.trans ha').symm + rw [hza, hb'] + exact (List.isChain_cons.mp hqchain).1 w (by simp) + have hhead : r.head? = some x := by + cases p with + | nil => simp at hphead + | cons a p => simpa [r] using hphead + have hlast : r.getLast? = some y := by + cases q with + | nil => simp at hqhead + | cons z' qs => + cases qs with + | nil => + have hzy : z' = y := Option.some.inj (by simpa using hqlast) + have hzz : z' = z := Option.some.inj (by simpa using hqhead) + have hzy' : z = y := hzz.symm.trans hzy + simp? [r, hplast] + rw [hzy'] + | cons w ws => + have hqs : (w :: ws).getLast? = some y := by simpa using hqlast + simpa [r] using hqs + have hmem : ∀ w ∈ r, w ∈ S := by + intro w hw + simp only [r, List.mem_append] at hw + rcases hw with hw | hw + · exact hpmem w hw + · exact hqmem w (List.mem_of_mem_tail hw) + exact ⟨r, hhead, hlast, hmem, hchain⟩ + +private theorem tileBoundarySubsetWeb : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), + let W : Set GaussianInt := {x | ∃ v, v ∈ TilingLattice C ∧ + x ∈ BoundaryFootprintVertices (TileTranslation T v)} + ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), (∀ (u : ↥(TilingLattice C)), P.tile u = + TileTranslation T (↑u : GaussianInt)) → (∀ (a : TilingLattice C), + BoundaryFootprintVertices (P.tile a) ⊆ W) ) := by + classical + intro C T W P hPtile a z hz + exact ⟨a, a.property, by simpa [hPtile] using hz⟩ + +private theorem boundaryEndpoint : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges U) → (∀ (z : + GaussianInt), (z ∈ e) → (z ∈ BoundaryFootprintVertices U)) ) := by + classical + intro U e he z hz + have hne : U.cells.Nonempty := by + rcases he with ⟨w, hw | hw⟩ + · rcases hw.2 with ⟨hcell, _⟩ | ⟨_, hcell⟩ + · exact ⟨w, hcell⟩ + · exact ⟨w - ⟨0, 1⟩, hcell⟩ + · rcases hw.2 with ⟨hcell, _⟩ | ⟨_, hcell⟩ + · exact ⟨w, hcell⟩ + · exact ⟨w - 1, hcell⟩ + rw [BoundaryFootprintVertices, ite_eq_left hne] + exact ⟨e, he, hz⟩ + +private theorem indexedDisjointEarly : + (by + classical + exact + ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (a : TilingLattice + C), ∀ (b : TilingLattice C), (P.plane.adjacent a b) → (Disjoint (P.tile a).cells + (P.tile b).cells) ) := by + classical + intro C P a b hab + apply Finset.disjoint_left.mpr + intro x hxa hxb + obtain ⟨owner, howner, hunique⟩ := PeriodicTileIndexedMultiplicityOne P x + have ha : a = owner := hunique a hxa + have hb : b = owner := hunique b hxb + have hne : a ≠ b := by + intro hab' + rw [← hab'] at hab + exact P.plane.adjacent_irreflexive a hab + exact hne (ha.trans hb.symm) + +private theorem edgeBoundaryEarly : + (by + classical + exact + ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), (∀ (a : TilingLattice + C), ∀ (b : TilingLattice C), (P.plane.adjacent a b) → (Disjoint (P.tile a).cells + (P.tile b).cells)) → (∀ (a : TilingLattice C), ∀ (b : TilingLattice C), + (P.plane.adjacent a b) → (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges (P.tile a) + ∩ FootprintEdges (P.tile b)) → (e ∈ BoundaryFootprintEdges (P.tile a) ∩ + BoundaryFootprintEdges (P.tile b)))) ) := by + classical + intro C P indexedDisjointEarly a b hab e he + have he' := he + rw [CellDisjointCommonEdgesBoundary (P.tile a) (P.tile b) + (indexedDisjointEarly a b hab)] at he' + exact he' + +private theorem commonBoundaryVertex : + (by + classical + exact + ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), (∀ (U : ProtoTile), ∀ + (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges U) → (∀ (z : GaussianInt), (z ∈ + e) → (z ∈ BoundaryFootprintVertices U))) → ((∀ (a : TilingLattice C), ∀ (b : + TilingLattice C), (P.plane.adjacent a b) → (∀ (e : Finset GaussianInt), (e ∈ + FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) → (e ∈ BoundaryFootprintEdges + (P.tile a) ∩ BoundaryFootprintEdges (P.tile b)))) → (∀ (a : TilingLattice C), ∀ (b : + TilingLattice C), (P.plane.adjacent a b) → (∃ z, z ∈ BoundaryFootprintVertices + (P.tile a) ∧ z ∈ BoundaryFootprintVertices (P.tile b)))) ) := by + classical + intro C P boundaryEndpoint edgeBoundaryEarly a b hab + obtain ⟨e, he⟩ := P.adjacent_has_common_edge a b hab + have heB := edgeBoundaryEarly a b hab e he + have hne : e.Nonempty := by + rcases he.1 with ⟨c, hc, hshape⟩ + rcases hshape with h | h | h | h <;> subst e <;> simp + obtain ⟨z, hz⟩ := hne + exact ⟨z, + boundaryEndpoint (P.tile a) e heB.1 z hz, + boundaryEndpoint (P.tile b) e heB.2 z hz⟩ + +private theorem indexBoundaryPath : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), + let W : Set GaussianInt := {x | ∃ v, v ∈ TilingLattice C ∧ + x ∈ BoundaryFootprintVertices (TileTranslation T v)} + ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), (∀ (U : ProtoTile), (LatticeTile U) → (∀ + (x : GaussianInt), ∀ (y : GaussianInt), (x ∈ BoundaryFootprintVertices U) → ((y ∈ + BoundaryFootprintVertices U) → (∃ p : List GaussianInt, p.head? = some x ∧ p.getLast? + = some y ∧ (∀ z ∈ p, z ∈ BoundaryFootprintVertices U) ∧ List.IsChain + FourNeighborAdjacent p)))) → ((∀ (S : Set GaussianInt), ∀ (p : List GaussianInt), ∀ + (q : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), ∀ (y : + GaussianInt), (p.head? = some x) → ((p.getLast? = some z) → ((∀ w ∈ p, w ∈ S) → + ((List.IsChain FourNeighborAdjacent p) → ((q.head? = some z) → ((q.getLast? = some y) + → ((∀ w ∈ q, w ∈ S) → ((List.IsChain FourNeighborAdjacent q) → (∃ r : List + GaussianInt, r.head? = some x ∧ r.getLast? = some y ∧ (∀ w ∈ r, w ∈ S) ∧ List.IsChain + FourNeighborAdjacent r))))))))) → ((∀ (a : TilingLattice C), + BoundaryFootprintVertices (P.tile a) ⊆ W) → ((∀ (a : TilingLattice C), ∀ (b : + TilingLattice C), (P.plane.adjacent a b) → (∃ z, z ∈ BoundaryFootprintVertices + (P.tile a) ∧ z ∈ BoundaryFootprintVertices (P.tile b))) → (∀ (p : List (TilingLattice + C)), ∀ (a : TilingLattice C), ∀ (b : TilingLattice C), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), p.head? = some a → p.getLast? = some b → List.IsChain P.plane.adjacent + p → x ∈ BoundaryFootprintVertices (P.tile a) → y ∈ BoundaryFootprintVertices (P.tile + b) → ∃ l : List GaussianInt, l.head? = some x ∧ l.getLast? = some y ∧ (∀ z ∈ l, z ∈ + W) ∧ List.IsChain FourNeighborAdjacent l)))) ) := by + classical + intro C T W P cyclePath pathConcat tileBoundarySubsetWeb commonBoundaryVertex p + induction p with + | nil => + intro a b x y hp _ _ _ _ + simp at hp + | cons a' p ih => + intro a b x y hp hl hchain hx hy + have haa : a' = a := Option.some.inj hp + subst a' + cases p with + | nil => + have hab : a = b := by simpa using hl + subst b + obtain ⟨l, hhead, hlast, hmem, hpath⟩ := + cyclePath (P.tile a) (P.tiles_are_disks a) x y hx hy + exact ⟨l, hhead, hlast, + fun z hz => tileBoundarySubsetWeb a (hmem z hz), hpath⟩ + | cons c p => + have hac : P.plane.adjacent a c := + (List.isChain_cons.mp hchain).1 c (by simp) + have htail : List.IsChain P.plane.adjacent (c :: p) := + (List.isChain_cons.mp hchain).2 + have hlast : (c :: p).getLast? = some b := by simpa using hl + obtain ⟨z, hza, hzc⟩ := commonBoundaryVertex a c hac + obtain ⟨l₁, h1head, h1last, h1mem, h1chain⟩ := + cyclePath (P.tile a) (P.tiles_are_disks a) x z hx hza + obtain ⟨l₂, h2head, h2last, h2mem, h2chain⟩ := + ih c b z y (by simp) hlast htail hzc hy + obtain ⟨l, hhead, hlast, hmem, hchain⟩ := + pathConcat W l₁ l₂ x z y h1head h1last + (fun w hw => tileBoundarySubsetWeb a (h1mem w hw)) h1chain + h2head h2last h2mem h2chain + exact ⟨l, hhead, hlast, hmem, hchain⟩ + +private theorem indexedDisjoint : + (by + classical + exact + ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (a : TilingLattice + C), ∀ (b : TilingLattice C), (P.plane.adjacent a b) → (Disjoint (P.tile a).cells + (P.tile b).cells) ) := by + classical + intro C P a b hab + apply Finset.disjoint_left.mpr + intro x hxa hxb + obtain ⟨owner, howner, hunique⟩ := PeriodicTileIndexedMultiplicityOne P x + have ha : a = owner := hunique a hxa + have hb : b = owner := hunique b hxb + have hne : a ≠ b := by + intro hab' + rw [← hab'] at hab + exact P.plane.adjacent_irreflexive a hab + exact hne (ha.trans hb.symm) + +private theorem edgeBoundary : + (by + classical + exact + ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), (∀ (a : TilingLattice + C), ∀ (b : TilingLattice C), (P.plane.adjacent a b) → (Disjoint (P.tile a).cells + (P.tile b).cells)) → (∀ (a : TilingLattice C), ∀ (b : TilingLattice C), + (P.plane.adjacent a b) → (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges (P.tile a) + ∩ FootprintEdges (P.tile b)) → (e ∈ BoundaryFootprintEdges (P.tile a) ∩ + BoundaryFootprintEdges (P.tile b)))) ) := by + classical + intro C P indexedDisjoint a b hab e he + have he' := he + rw [CellDisjointCommonEdgesBoundary (P.tile a) (P.tile b) + (indexedDisjoint a b hab)] at he' + exact he' + +private theorem noBoundaryIncident : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∉ + BoundaryFootprintVertices U) → (∀ (e : Finset GaussianInt), (e ∈ + BoundaryFootprintEdges U) → ((x ∈ e) → (False)))) ) := by + classical + intro U x hne hx e he hxe + apply hx + rw [BoundaryFootprintVertices, ite_eq_left hne] + exact ⟨e, he, hxe⟩ + +private theorem horizontalStatus : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (({z, z + 1} : Finset GaussianInt) ∉ + BoundaryFootprintEdges U) → ((z ∈ U.cells ↔ z - I ∈ U.cells)) ) := by + classical + intro I U z hnot + constructor + · intro hz + by_contra hbelow + apply hnot + exact ⟨z, Or.inl ⟨rfl, Or.inl ⟨hz, hbelow⟩⟩⟩ + · intro hbelow + by_contra hz + apply hnot + exact ⟨z, Or.inl ⟨rfl, Or.inr ⟨hz, hbelow⟩⟩⟩ + +private theorem verticalStatus : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + ∀ (U : ProtoTile), ∀ (z : GaussianInt), (({z, z + I} : Finset GaussianInt) ∉ + BoundaryFootprintEdges U) → ((z ∈ U.cells ↔ z - 1 ∈ U.cells)) ) := by + classical + intro I U z hnot + constructor + · intro hz + by_contra hleft + apply hnot + exact ⟨z, Or.inr ⟨rfl, Or.inl ⟨hz, hleft⟩⟩⟩ + · intro hleft + by_contra hz + apply hnot + exact ⟨z, Or.inr ⟨rfl, Or.inr ⟨hz, hleft⟩⟩⟩ + +private theorem incidentCellsOwned : + (by + classical + exact + (∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∉ + BoundaryFootprintVertices U) → (∀ (e : Finset GaussianInt), (e ∈ + BoundaryFootprintEdges U) → ((x ∈ e) → (False))))) → ( + let I : GaussianInt := ⟨0, 1⟩ + (∀ (U : ProtoTile), ∀ (z : GaussianInt), (({z, z + 1} : Finset GaussianInt) ∉ + BoundaryFootprintEdges U) → ((z ∈ U.cells ↔ z - I ∈ U.cells))) → ((∀ (U : ProtoTile), + ∀ (z : GaussianInt), (({z, z + I} : Finset GaussianInt) ∉ BoundaryFootprintEdges U) → + ((z ∈ U.cells ↔ z - 1 ∈ U.cells))) → (∀ (U : ProtoTile), ∀ (x : GaussianInt), (x ∈ + U.cells) → ((x ∉ BoundaryFootprintVertices U) → (x ∈ U.cells ∧ x - 1 ∈ U.cells ∧ x - + I ∈ U.cells ∧ x - 1 - I ∈ U.cells))))) ) := by + classical + intro noBoundaryIncident I horizontalStatus verticalStatus U x hxcell hxnot + have hne : U.cells.Nonempty := ⟨x, hxcell⟩ + have htop : ({x, x + 1} : Finset GaussianInt) ∉ + BoundaryFootprintEdges U := by + intro he + exact noBoundaryIncident U x hne hxnot {x, x + 1} he (by simp) + have hleft : ({x, x + I} : Finset GaussianInt) ∉ + BoundaryFootprintEdges U := by + intro he + exact noBoundaryIncident U x hne hxnot {x, x + I} he (by simp) + have hbottom : ({x - 1, x - 1 + 1} : Finset GaussianInt) ∉ + BoundaryFootprintEdges U := by + intro he + exact noBoundaryIncident U x hne hxnot {x - 1, x - 1 + 1} he (by + simp [Zsqrtd.ext_iff]) + have hdiagonal : ({x - I, x - I + I} : Finset GaussianInt) ∉ + BoundaryFootprintEdges U := by + intro he + exact noBoundaryIncident U x hne hxnot {x - I, x - I + I} he (by + simp [I, Zsqrtd.ext_iff]) + have hbelowCell : x - I ∈ U.cells := + (horizontalStatus U x htop) |>.mp hxcell + have hleftCell : x - 1 ∈ U.cells := + (verticalStatus U x hleft) |>.mp hxcell + exact ⟨hxcell, hleftCell, hbelowCell, + (horizontalStatus U (x - 1) hbottom).mp hleftCell⟩ + +private theorem tileCellsNonempty : + (by + classical + exact + ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (a : TilingLattice + C), (P.tile a).cells.Nonempty ) := by + classical + intro C P a + have hreal : (TileRealization (P.tile a)).Nonempty := by + rcases P.tiles_are_disks a with ⟨e⟩ + let z : Metric.closedBall (0 : Real × Real) 1 := ⟨0, by simp⟩ + exact ⟨e z, (e z).property⟩ + rcases hreal with ⟨z, hz⟩ + simp only [TileRealization, Set.mem_iUnion] at hz + rcases hz with ⟨x, hx, _⟩ + exact ⟨x, hx⟩ + +private theorem ownerExists : + (by + classical + exact + ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (x : GaussianInt), + ∃ a : TilingLattice C, x ∈ (P.tile a).cells ) := by + classical + intro C P x + exact (PeriodicTileIndexedMultiplicityOne P x).exists + +private theorem ownerUnique : + (by + classical + exact + ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (ownerExists : ∀ (x + : GaussianInt), ∃ a : TilingLattice C, x ∈ (P.tile a).cells), + let owner : GaussianInt → TilingLattice C := fun x => + Classical.choose (ownerExists x) + (∀ (x : GaussianInt), x ∈ (P.tile (owner x)).cells) → (∀ (x : GaussianInt), ∀ (a : + TilingLattice C), (x ∈ (P.tile a).cells) → (owner x = a)) ) := by + classical + intro C P ownerExists owner ownerCell x a ha + obtain ⟨a₀, ha₀, huniq⟩ := PeriodicTileIndexedMultiplicityOne P x + have howner : owner x = a₀ := huniq (owner x) (ownerCell x) + have ha' : a = a₀ := huniq a ha + exact howner.trans ha'.symm + +private theorem ownerBoundaryAbsent : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), + let W : Set GaussianInt := {x | ∃ v, v ∈ TilingLattice C ∧ + x ∈ BoundaryFootprintVertices (TileTranslation T v)} + ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), (∀ (u : ↥(TilingLattice C)), P.tile u = + TileTranslation T (↑u : GaussianInt)) → (∀ (ownerExists : ∀ (x : GaussianInt), ∃ a : + TilingLattice C, x ∈ (P.tile a).cells), + let owner : GaussianInt → TilingLattice C := fun x => + Classical.choose (ownerExists x) + ∀ (x : GaussianInt), (x ∉ W) → (x ∉ BoundaryFootprintVertices (P.tile (owner x)))) ) := by + classical + intro C T W P hPtile ownerExists owner x hx h + apply hx + refine ⟨owner x, (owner x).property, ?_⟩ + simpa [hPtile] using h + +private theorem ownerFootprint : + (by + classical + exact + ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (ownerExists : ∀ (x + : GaussianInt), ∃ a : TilingLattice C, x ∈ (P.tile a).cells), + let owner : GaussianInt → TilingLattice C := fun x => + Classical.choose (ownerExists x) + (∀ (x : GaussianInt), x ∈ (P.tile (owner x)).cells) → (∀ (x : GaussianInt), x ∈ + FootprintVertices (P.tile (owner x))) ) := by + classical + intro C P ownerExists owner ownerCell x + have hx := ownerCell x + have hne := (owner x).property + by_cases hcells : (P.tile (owner x)).cells.Nonempty + · rw [FootprintVertices, ite_eq_left hcells] + exact ⟨x, hx, Or.inl rfl⟩ + · exact (hcells ⟨x, hx⟩).elim + +private theorem ownerEqAdjacent : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), + let W : Set GaussianInt := {x | ∃ v, v ∈ TilingLattice C ∧ + x ∈ BoundaryFootprintVertices (TileTranslation T v)} + ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + let I : GaussianInt := ⟨0, 1⟩ + (∀ (U : ProtoTile), ∀ (x : GaussianInt), (x ∈ U.cells) → ((x ∉ BoundaryFootprintVertices + U) → (x ∈ U.cells ∧ x - 1 ∈ U.cells ∧ x - I ∈ U.cells ∧ x - 1 - I ∈ U.cells))) → (∀ + (ownerExists : ∀ (x : GaussianInt), ∃ a : TilingLattice C, x ∈ (P.tile a).cells), + let owner : GaussianInt → TilingLattice C := fun x => + Classical.choose (ownerExists x) + (∀ (x : GaussianInt), x ∈ (P.tile (owner x)).cells) → ((∀ (x : GaussianInt), ∀ (a : + TilingLattice C), (x ∈ (P.tile a).cells) → (owner x = a)) → ((∀ (x : GaussianInt), (x + ∉ W) → (x ∉ BoundaryFootprintVertices (P.tile (owner x)))) → (∀ (x : GaussianInt), ∀ + (y : GaussianInt), (FourNeighborAdjacent x y) → ((x ∉ W) → ((y ∉ W) → (owner x = + owner y))))))) ) := by + classical + intro C T W P I incidentCellsOwned ownerExists owner ownerCell ownerUnique ownerBoundaryAbsent + x y hxy hx hy + have hcx := incidentCellsOwned (P.tile (owner x)) x (ownerCell x) + (ownerBoundaryAbsent x hx) + have hcy := incidentCellsOwned (P.tile (owner y)) y (ownerCell y) + (ownerBoundaryAbsent y hy) + rcases hxy with h | h | h | h + · rw [h] + apply ownerUnique x (owner (x + 1)) + simpa [h, Zsqrtd.ext_iff] using hcy.2.1 + · rw [h] + exact (ownerUnique (x - 1) (owner x) hcx.2.1).symm.trans + (ownerUnique (x - 1) (owner (x - 1)) + (by simpa [h, Zsqrtd.ext_iff] using hcy.1)) + · rw [h] + apply ownerUnique x (owner (x + I)) + simpa [h, I, Zsqrtd.ext_iff] using hcy.2.2.1 + · rw [h] + exact (ownerUnique (x - I) (owner x) hcx.2.2.1).symm.trans + (ownerUnique (x - I) (owner (x - I)) + (by simpa [h, I, Zsqrtd.ext_iff] using hcy.1)) + +private theorem listOwner : + (by + classical + exact + ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (ownerExists : ∀ (x + : GaussianInt), ∃ a : TilingLattice C, x ∈ (P.tile a).cells), + let owner : GaussianInt → TilingLattice C := fun x => + Classical.choose (ownerExists x) + ∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (p.head? = some x) → + ((p.getLast? = some y) → ((List.IsChain (fun a b : GaussianInt => owner a = owner b) + p) → (owner y = owner x))) ) := by + classical + intro C P ownerExists owner p x y hp hl hc + revert x y hp hl hc + induction p with + | nil => intro x y hp hl hc; simp at hp + | cons a p ih => + intro x y hp hl hc + have hax : a = x := by simpa using hp + subst x + cases p with + | nil => + have hay : a = y := Option.some.inj hl + subst y + rfl + | cons b p => + have hfirst : owner a = owner b := + (List.isChain_cons.mp hc).1 b (by simp) + have htail : List.IsChain + (fun a b : GaussianInt => owner a = owner b) (b :: p) := + (List.isChain_cons.mp hc).2 + have hlast : (b :: p).getLast? = some y := by simpa using hl + exact (ih b y (by simp) hlast htail).trans hfirst.symm + +private theorem ownerOnPath : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), + let W : Set GaussianInt := {x | ∃ v, v ∈ TilingLattice C ∧ + x ∈ BoundaryFootprintVertices (TileTranslation T v)} + ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (ownerExists : ∀ (x : GaussianInt), ∃ a + : TilingLattice C, x ∈ (P.tile a).cells), + let owner : GaussianInt → TilingLattice C := fun x => + Classical.choose (ownerExists x) + (∀ (x : GaussianInt), ∀ (y : GaussianInt), (FourNeighborAdjacent x y) → ((x ∉ W) → ((y ∉ + W) → (owner x = owner y)))) → ((∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), (p.head? = some x) → ((p.getLast? = some y) → ((List.IsChain (fun a b : + GaussianInt => owner a = owner b) p) → (owner y = owner x)))) → (∀ (X : Set + GaussianInt), (FourNeighborConnected X) → ((Disjoint X W) → (∀ (x : GaussianInt), ∀ + (y : GaussianInt), (x ∈ X) → ((y ∈ X) → (owner x = owner y)))))) ) := by + classical + intro C T W P ownerExists owner ownerEqAdjacent listOwner X hX hdisj x y hx hy + obtain ⟨p, hp, hl, hmem, hstep⟩ := hX.2 x hx y hy + have hadj : List.IsChain FourNeighborAdjacent p := + List.isChain_iff_forall_rel_of_append_cons_cons.mpr hstep + have hnot (z : GaussianInt) (hz : z ∈ X) : z ∉ W := by + intro hzw + exact (Set.disjoint_left.mp hdisj) hz hzw + have howner : List.IsChain + (fun a b : GaussianInt => owner a = owner b) p := + hadj.imp_of_mem_imp (fun a b ha hb hab => + ownerEqAdjacent a b hab (hnot a (hmem a ha)) (hnot b (hmem b hb))) + exact (listOwner p x y hp hl howner).symm + +private theorem hx₀ : + (by + classical + exact + ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + let a₀ : TilingLattice C := ⟨0, (TilingLattice C).zero_mem⟩ + ∀ (p₀ : List GaussianInt), ∀ (x₀ : GaussianInt), (p₀.head? = some x₀) → + ((BoundaryFootprintVertices (P.tile a₀) = (↑p₀.toFinset : Set GaussianInt)) → (x₀ ∈ + BoundaryFootprintVertices (P.tile a₀))) ) := by + classical + intro C P a₀ p₀ x₀ hhead₀ hverts₀ + rw [hverts₀] + simp only [Finset.mem_coe, List.mem_toFinset] + rcases List.head?_eq_some_iff.mp hhead₀ with ⟨l, hl⟩ + rw [hl] + simp + +private theorem hx₀W : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), + let W : Set GaussianInt := {x | ∃ v, v ∈ TilingLattice C ∧ + x ∈ BoundaryFootprintVertices (TileTranslation T v)} + ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), (∀ (u : ↥(TilingLattice C)), P.tile u = + TileTranslation T (↑u : GaussianInt)) → ( + let a₀ : TilingLattice C := ⟨0, (TilingLattice C).zero_mem⟩ + ∀ (x₀ : GaussianInt), (x₀ ∈ BoundaryFootprintVertices (P.tile a₀)) → (x₀ ∈ W)) ) := by + classical + intro C T W P hPtile a₀ x₀ hx₀ + refine ⟨(a₀ : GaussianInt), a₀.property, ?_⟩ + simpa [hPtile] using hx₀ + +private theorem hxnot : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), + let W : Set GaussianInt := {x | ∃ v, v ∈ TilingLattice C ∧ + x ∈ BoundaryFootprintVertices (TileTranslation T v)} + ∀ (X : Set GaussianInt), (Disjoint X W) → (∀ (x : GaussianInt), (x ∈ X) → (x ∉ W)) ) := by + classical + intro C T W X hdisj x hx hxw + exact (Set.disjoint_left.mp hdisj) hx hxw + +end BoundaryWebGeometry + +theorem PeriodicBoundaryWebConnected : + ∀ (C : BandCircle), ∀ (T : ProtoTile), (BandPrototile C.1.1 T) → ((LatticeTile T) → + ((ExactTileTiling (RegularTileFamily T (TilingLattice C))) → ( + let W : Set GaussianInt := {x | ∃ v, v ∈ TilingLattice C ∧ + x ∈ BoundaryFootprintVertices (TileTranslation T v)} + FourNeighborConnected W ∧ + ∀ X : Set GaussianInt, FourNeighborConnected X → Disjoint X W → + ∃ v, v ∈ TilingLattice C ∧ + X ⊆ FootprintVertices (TileTranslation T v) \ W))) := by + intro C T hT hlat htile +-- BODY + let W : Set GaussianInt := {x | ∃ v, v ∈ TilingLattice C ∧ + x ∈ BoundaryFootprintVertices (TileTranslation T v)} + change FourNeighborConnected W ∧ + ∀ X : Set GaussianInt, FourNeighborConnected X → Disjoint X W → + ∃ v, v ∈ TilingLattice C ∧ + X ⊆ FootprintVertices (TileTranslation T v) \ W + classical + have gridWalk (x y : GaussianInt) : + ∃ p : List GaussianInt, + p.head? = some x ∧ p.getLast? = some y ∧ + List.IsChain FourNeighborAdjacent p := BoundaryWebGeometry.gridWalk x y + by_cases hc : C.1.1.1 = 1 + · obtain ⟨a, ha⟩ := CurvatureOneBandPrototileSingleton C T hc hT + have hlatC : TilingLattice C = ⊤ := by simp [TilingLattice, hc] + have hW : (({x | ∃ v, v ∈ TilingLattice C ∧ + x ∈ BoundaryFootprintVertices (TileTranslation T v)} : Set GaussianInt)) = + Set.univ := BoundaryWebGeometry.hW C T a ha hlatC + have hWeq : W = Set.univ := by simpa [W] using hW + constructor + · rw [hWeq] + refine ⟨⟨0, by simp⟩, ?_⟩ + intro x hx y hy + obtain ⟨p, hp, hlast, hchain⟩ := gridWalk x y + exact ⟨p, hp, hlast, fun z hz => by simp, + List.isChain_iff_forall_rel_of_append_cons_cons.mp hchain⟩ + · intro X hX hdisj + exfalso + obtain ⟨x, hx⟩ := hX.1 + rw [hWeq] at hdisj + exact (Set.disjoint_left.mp hdisj) hx (Set.mem_univ x) + · obtain ⟨q, hsemi, hqC, hlt, _⟩ := Or.resolve_left (BandGenealogy C) hc + have hproper := BoundaryWebGeometry.hproper C q hsemi hqC hlt + have hT' : BandPrototile (q 0) T := by simpa [hqC] using hT + obtain ⟨P, hPlattice, hPtile, hPadj, hPposition, hPvertices, + hPedges, hPfaces, hPchart⟩ := + BandRegularTranslatePeriodicComplex C q hproper hqC T hT' + have indexWalk := BoundaryWebGeometry.indexWalk C P + have indexBoundaryPath := BoundaryWebGeometry.indexBoundaryPath C T P + (BoundaryWebGeometry.cyclePath (BoundaryWebGeometry.listLoopRoute + (BoundaryWebGeometry.listPrefix)) (BoundaryWebGeometry.adjacentSymm)) + (BoundaryWebGeometry.pathConcat) + (BoundaryWebGeometry.tileBoundarySubsetWeb C T P hPtile) + (BoundaryWebGeometry.commonBoundaryVertex C P + (BoundaryWebGeometry.boundaryEndpoint) (BoundaryWebGeometry.edgeBoundaryEarly + C P (BoundaryWebGeometry.indexedDisjointEarly C P))) + have edgeBoundary := BoundaryWebGeometry.edgeBoundary C P + (BoundaryWebGeometry.indexedDisjoint C P) + let I : GaussianInt := ⟨0, 1⟩ + have tileCellsNonempty := BoundaryWebGeometry.tileCellsNonempty C P + have ownerExists := BoundaryWebGeometry.ownerExists C P + let owner : GaussianInt → TilingLattice C := fun x => + Classical.choose (ownerExists x) + have ownerCell (x : GaussianInt) : x ∈ (P.tile (owner x)).cells := + Classical.choose_spec (ownerExists x) + have ownerFootprint (x : GaussianInt) : + x ∈ FootprintVertices (P.tile (owner x)) := BoundaryWebGeometry.ownerFootprint C P + ownerExists ownerCell x + have ownerOnPath := BoundaryWebGeometry.ownerOnPath C T P ownerExists + (BoundaryWebGeometry.ownerEqAdjacent C T P (BoundaryWebGeometry.incidentCellsOwned + (BoundaryWebGeometry.noBoundaryIncident) (BoundaryWebGeometry.horizontalStatus) + (BoundaryWebGeometry.verticalStatus)) ownerExists ownerCell + (BoundaryWebGeometry.ownerUnique C P ownerExists ownerCell) + (BoundaryWebGeometry.ownerBoundaryAbsent C T P hPtile ownerExists)) + (BoundaryWebGeometry.listOwner C P ownerExists) + refine ⟨?_, ?_⟩ + · let a₀ : TilingLattice C := ⟨0, (TilingLattice C).zero_mem⟩ + obtain ⟨p₀, x₀, y₀, _, _, hhead₀, _, hverts₀, _, _, _⟩ := + LatticeTileGridStructure (P.tile a₀) (P.tiles_are_disks a₀) |>.2.2 + have hx₀ := BoundaryWebGeometry.hx₀ C P p₀ x₀ + hhead₀ hverts₀ + refine ⟨⟨x₀, (BoundaryWebGeometry.hx₀W C T P hPtile x₀ hx₀)⟩, ?_⟩ + intro x hx y hy + obtain ⟨u, hu, hxu⟩ := hx + obtain ⟨v, hv, hyv⟩ := hy + let a : TilingLattice C := ⟨u, hu⟩ + let b : TilingLattice C := ⟨v, hv⟩ + have hxa : x ∈ BoundaryFootprintVertices (P.tile a) := by + simpa [a, hPtile] using hxu + have hyb : y ∈ BoundaryFootprintVertices (P.tile b) := by + simpa [b, hPtile] using hyv + obtain ⟨p, hhead, hlast, hindex⟩ := indexWalk a b + obtain ⟨l, hlhead, hllast, hlmem, hlchain⟩ := + indexBoundaryPath p a b x y hhead hlast hindex hxa hyb + exact ⟨l, hlhead, hllast, hlmem, + List.isChain_iff_forall_rel_of_append_cons_cons.mp hlchain⟩ + · intro X hX hdisj + obtain ⟨x₀, hx₀⟩ := hX.1 + refine ⟨(owner x₀ : GaussianInt), (owner x₀).property, ?_⟩ + intro x hx + have howner : owner x = owner x₀ := + ownerOnPath X hX hdisj x x₀ hx hx₀ + have hfoot : x ∈ FootprintVertices (TileTranslation T (owner x₀ : GaussianInt)) := by + simpa [hPtile, howner] using ownerFootprint x + exact ⟨hfoot, (BoundaryWebGeometry.hxnot C T X hdisj x hx)⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean new file mode 100644 index 0000000000..77fcdddd4d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean @@ -0,0 +1,1781 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AffineTriangularNoFourfoldCellOwners +public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.LeftAdjacentOdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.OdometerWeb +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TilingLattice + +-- [TABLET NODE: PeriodicBoundaryWebLaplacian] + +/-! +# PeriodicBoundaryWebLaplacian + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace WebLaplacianGeometry + +private theorem hunit : + (by + classical + exact + ∀ (C : BandCircle), ∀ (g : IntegerLatticeFunction), (∀ v ∈ TilingLattice C, ∃ (a : + GaussianInt), (CircleMatrix C).mulVec ![(↑v.re : ℝ), (↑v.im : ℝ)] = ![(↑a.re : ℝ), + (↑a.im : ℝ)] ∧ ∀ (x : GaussianInt), g (x + v) = g x + x.re * a.re + x.im * a.im + g + v) → ((C.1.1.1 = (1 : ℤ)) → (∀ y, FourNeighborLaplacian g y = 1)) ) := by + classical + intro C g hcocycle hc + obtain ⟨z, hz⟩ := CurvatureOneBandCircleClassification C hc + have hlattice : TilingLattice C = ⊤ := by simp [TilingLattice, hc] + have hmatrix : CircleMatrix C = + let c : ℝ := C.1.1.1 + let x : ℝ := C.1.1.2.re + let y : ℝ := C.1.1.2.im + (2 * c)⁻¹ • ![![1 + x, y], ![y, 1 - x]] := by + ext i j + fin_cases i <;> fin_cases j <;> + simp [CircleMatrix, BandCircleEuclideanData] + all_goals field_simp + have hcoord := congrArg Prod.snd hz + have hcoordR : (C.1.1.2.re : ℝ) = 1 + 2 * (z.re : ℝ) := by + rw [hcoord] + exact_mod_cast (show (1 + 2 * z).re = 1 + 2 * z.re by simp) + have hcoordI : (C.1.1.2.im : ℝ) = 2 * (z.im : ℝ) := by + rw [hcoord] + exact_mod_cast (show (1 + 2 * z).im = 2 * z.im by simp) + obtain ⟨_, _, hshift0⟩ := hcocycle 0 (by rw [hlattice]; simp) + have hg0 : g 0 = 0 := by + have h := hshift0 0 + simp at h + linarith + obtain ⟨aP, hP, hshiftP⟩ := hcocycle 1 (by rw [hlattice]; simp) + obtain ⟨aM, hM, hshiftM⟩ := hcocycle (-1) (by rw [hlattice]; simp) + obtain ⟨aI, hI, hshiftI⟩ := hcocycle ⟨0, 1⟩ (by rw [hlattice]; simp) + obtain ⟨aMI, hMI, hshiftMI⟩ := + hcocycle (-(⟨0, 1⟩ : GaussianInt)) (by rw [hlattice]; simp) + have hpcoords : (aP.re : ℝ) = 1 + (z.re : ℝ) ∧ + (aP.im : ℝ) = (z.im : ℝ) := by + rw [hmatrix] at hP + dsimp at hP + rw [hc, hcoordR, hcoordI] at hP + have h0 := congrFun hP 0 + have h1 := congrFun hP 1 + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] at h0 h1 + simp only [← GaussianInt.intCast_re, ← GaussianInt.intCast_im] at h0 h1 + field_simp at h0 + constructor <;> linarith + have hmcoords : (aM.re : ℝ) = -(1 + (z.re : ℝ)) ∧ + (aM.im : ℝ) = -(z.im : ℝ) := by + rw [hmatrix] at hM + dsimp at hM + rw [hc, hcoordR, hcoordI] at hM + have h0 := congrFun hM 0 + have h1 := congrFun hM 1 + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] at h0 h1 + simp only [← GaussianInt.intCast_re, ← GaussianInt.intCast_im] at h0 h1 + field_simp at h0 + constructor <;> linarith + have hic : (aI.re : ℝ) = (z.im : ℝ) ∧ + (aI.im : ℝ) = -(z.re : ℝ) := by + rw [hmatrix] at hI + dsimp at hI + rw [hc, hcoordR, hcoordI] at hI + have h0 := congrFun hI 0 + have h1 := congrFun hI 1 + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] at h0 h1 + simp only [← GaussianInt.intCast_re, ← GaussianInt.intCast_im] at h0 h1 + constructor <;> linarith + have hmic : (aMI.re : ℝ) = -(z.im : ℝ) ∧ + (aMI.im : ℝ) = (z.re : ℝ) := by + rw [hmatrix] at hMI + dsimp at hMI + rw [hc, hcoordR, hcoordI] at hMI + have h0 := congrFun hMI 0 + have h1 := congrFun hMI 1 + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] at h0 h1 + simp only [← GaussianInt.intCast_re, ← GaussianInt.intCast_im] at h0 h1 + constructor <;> linarith + have hRe : aM.re = -aP.re := by + exact_mod_cast (by linarith [hpcoords.1, hmcoords.1] : + (aM.re : ℝ) = -(aP.re : ℝ)) + have hImP : aM.im = -aP.im := by + exact_mod_cast (by linarith [hpcoords.2, hmcoords.2] : + (aM.im : ℝ) = -(aP.im : ℝ)) + have hReI : aMI.re = -aI.re := by + exact_mod_cast (by linarith [hic.1, hmic.1] : + (aMI.re : ℝ) = -(aI.re : ℝ)) + have hIm : aMI.im = -aI.im := by + exact_mod_cast (by linarith [hic.2, hmic.2] : + (aMI.im : ℝ) = -(aI.im : ℝ)) + have hpconst : g 1 + g (-1) = aP.re := by + have h := hshiftP (-1) + have hadd : (-1 : GaussianInt) + 1 = 0 := by ext <;> norm_num + rw [hadd, hg0] at h + norm_num at h + omega + have hiconst : g ⟨0, 1⟩ + g (-(⟨0, 1⟩ : GaussianInt)) = aI.im := by + have h := hshiftI (-(⟨0, 1⟩ : GaussianInt)) + have hadd : -(⟨0, 1⟩ : GaussianInt) + ⟨0, 1⟩ = 0 := by + ext <;> norm_num + rw [hadd, hg0] at h + norm_num at h + omega + intro y + have hre (x w : GaussianInt) : (x + w).re = x.re + w.re := by + cases x; cases w; rfl + have him (x w : GaussianInt) : (x + w).im = x.im + w.im := by + cases x; cases w; rfl + have hpairs : g (y + 1) + g (y - 1) - 2 * g y = + g 1 + g (-1) := by + have hsub : y - 1 = y + (-1) := by abel + rw [hsub, hshiftP y, hshiftM y, hRe, hImP] + ring + have hipairs : g (y + ⟨0, 1⟩) + g (y - ⟨0, 1⟩) - 2 * g y = + g ⟨0, 1⟩ + g (-(⟨0, 1⟩ : GaussianInt)) := by + have hsub : y - ⟨0, 1⟩ = y + -(⟨0, 1⟩ : GaussianInt) := by abel + rw [hsub, hshiftI y, hshiftMI y, hReI, hIm] + ring + have hsum : g (y + 1) + g (y - 1) + g (y + ⟨0, 1⟩) + + g (y - ⟨0, 1⟩) - 4 * g y = + (g 1 + g (-1)) + + (g ⟨0, 1⟩ + g (-(⟨0, 1⟩ : GaussianInt))) := by + linarith [hpairs, hipairs] + rw [FourNeighborLaplacian, hsum, hpconst, hiconst] + have htrace : (aP.re : ℝ) + (aI.im : ℝ) = 1 := by + linarith [hpcoords.1, hic.2] + exact_mod_cast htrace + +private theorem hproper : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (SemiProperQuadruple q) → + ((q (0 : Fin (4 : ℕ)) = C.1.1) → ((∀ (j : Fin (3 : ℕ)), (q j.succ).1 < C.1.1.1) → + (ProperBandQuadruple q))) ) := by + classical + intro C q hsemi hqC hless + refine ⟨hsemi, ?_⟩ + intro j + simpa [hqC] using hless j + +private theorem hcells : + (by + classical + exact + ∀ (C : BandCircle), ∀ (v : GaussianInt), ∀ (hv : v ∈ TilingLattice C), ∀ (P : + PeriodicTileComplex ↥(TilingLattice C)), + let iv : TilingLattice C := ⟨v, hv⟩ + (P.tile iv).cells.Nonempty ) := by + classical + intro C v hv P iv + have hreal : (TileRealization (P.tile iv)).Nonempty := by + rcases P.tiles_are_disks iv with ⟨e⟩ + let z : Metric.closedBall (0 : ℝ × ℝ) 1 := ⟨0, by simp⟩ + exact ⟨e z, (e z).property⟩ + rcases hreal with ⟨z, hz⟩ + simp only [TileRealization, Set.mem_iUnion] at hz + rcases hz with ⟨c, hc, _⟩ + exact ⟨c, hc⟩ + +private theorem hcorner : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (v : GaussianInt), ∀ (hv : + v ∈ TilingLattice C), (x ∈ BoundaryFootprintVertices (TileTranslation T v)) → (∀ (P : + PeriodicTileComplex ↥(TilingLattice C)), + let iv : TilingLattice C := ⟨v, hv⟩ + (x ∈ BoundaryFootprintVertices (P.tile iv)) → (((P.tile iv).cells.Nonempty) → (∃ y ∈ + (P.tile iv).cells, y = x ∨ y = x - 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩))) ) := by + classical + intro C T x v hv hx P iv hxi hcells + rw [BoundaryFootprintVertices, ite_eq_left hcells] at hxi + rcases hxi with ⟨e, he, hxe⟩ + rcases he with ⟨z, ⟨rfl, hs⟩ | ⟨rfl, hs⟩⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hs with ⟨hz, _⟩ | ⟨_, hz⟩ + · rcases hxe with h | h + · subst x + exact ⟨z, hz, Or.inl rfl⟩ + · have hz' : z = x - 1 := by rw [h]; abel + exact ⟨z, hz, Or.inr (Or.inl hz')⟩ + · rcases hxe with h | h + · subst x + exact ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr rfl))⟩ + · have hz' : z = x - 1 := by rw [h]; abel + refine ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + rw [h] + abel + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hs with ⟨hz, _⟩ | ⟨_, hz⟩ + · rcases hxe with h | h + · subst x + exact ⟨z, hz, Or.inl rfl⟩ + · have hz' : z = x - ⟨0, 1⟩ := by rw [h]; abel + exact ⟨z, hz, Or.inr (Or.inr (Or.inr hz'))⟩ + · rcases hxe with h | h + · subst x + exact ⟨z - 1, hz, Or.inr (Or.inl rfl)⟩ + · have hz' : z = x - ⟨0, 1⟩ := by rw [h]; abel + refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + rw [h] + abel + +private theorem hcornerOutside : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (v : GaussianInt), ∀ (hv : + v ∈ TilingLattice C), (x ∈ BoundaryFootprintVertices (TileTranslation T v)) → (∀ (P : + PeriodicTileComplex ↥(TilingLattice C)), + let iv : TilingLattice C := ⟨v, hv⟩ + (x ∈ BoundaryFootprintVertices (P.tile iv)) → (((P.tile iv).cells.Nonempty) → ((∃ y ∈ + (P.tile iv).cells, y = x ∨ y = x - 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → (∃ y, y + ∉ (P.tile iv).cells ∧ (y = x ∨ y = x - 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩))))) ) + := by + classical + intro C T x v hv hx P iv hxi hcells hcorner + rw [BoundaryFootprintVertices, ite_eq_left hcells] at hxi + rcases hxi with ⟨e, he, hxe⟩ + rcases he with ⟨z, ⟨rfl, hs⟩ | ⟨rfl, hs⟩⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hs with ⟨_, hz⟩ | ⟨hz, _⟩ + · rcases hxe with h | h + · subst x + exact ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr rfl))⟩ + · have hz' : z = x - 1 := by rw [h]; abel + refine ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + rw [h] + abel + · rcases hxe with h | h + · subst x + exact ⟨z, hz, Or.inl rfl⟩ + · have hz' : z = x - 1 := by rw [h]; abel + exact ⟨z, hz, Or.inr (Or.inl hz')⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hxe + rcases hs with ⟨_, hz⟩ | ⟨hz, _⟩ + · rcases hxe with h | h + · subst x + exact ⟨z - 1, hz, Or.inr (Or.inl rfl)⟩ + · have hz' : z = x - ⟨0, 1⟩ := by rw [h]; abel + refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + rw [h] + abel + · rcases hxe with h | h + · subst x + exact ⟨z, hz, Or.inl rfl⟩ + · have hz' : z = x - ⟨0, 1⟩ := by rw [h]; abel + exact ⟨z, hz, Or.inr (Or.inr (Or.inr hz'))⟩ + +private theorem hvowner : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (v : GaussianInt), ∀ (hv : + v ∈ TilingLattice C), (x ∈ BoundaryFootprintVertices (TileTranslation T v)) → (∀ (P : + PeriodicTileComplex ↥(TilingLattice C)), + let iv : TilingLattice C := ⟨v, hv⟩ + (x ∈ BoundaryFootprintVertices (P.tile iv)) → ((∃ y ∈ (P.tile iv).cells, y = x ∨ y = x - + 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → ((∃ y, y ∉ (P.tile iv).cells ∧ (y = x ∨ y + = x - 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩)) → (∀ (a0 : ↥(TilingLattice C)), (x ∈ + (P.tile a0).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x + ∈ (P.tile a).cells) y → y = a0) → (∀ (a1 : ↥(TilingLattice C)), (x - (1 : + LatticeCell) ∈ (P.tile a1).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : + ↥(TilingLattice C)) => x - (1 : LatticeCell) ∈ (P.tile a).cells) y → y = a1) → (∀ (a2 + : ↥(TilingLattice C)), (x - (1 : LatticeCell) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ + (P.tile a2).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x + - (1 : LatticeCell) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = + a2) → (∀ (a3 : ↥(TilingLattice C)), (x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile + a3).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (⟨(0 + : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = a3) → (iv = a0 ∨ iv = a1 ∨ + iv = a2 ∨ iv = a3)))))))))))) ) := by + classical + intro C T x v hv hx P iv hxi hcorner hcornerOutside a0 ha0 hu0 a1 ha1 hu1 a2 ha2 hu2 a3 ha3 hu3 + rcases hcorner with ⟨y, hy, rfl | rfl | rfl | rfl⟩ + · exact Or.inl (hu0 iv hy) + · exact Or.inr (Or.inl (hu1 iv hy)) + · exact Or.inr (Or.inr (Or.inl (hu2 iv hy))) + · exact Or.inr (Or.inr (Or.inr (hu3 iv hy))) + +private theorem hvnotfour : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (v : GaussianInt), ∀ (hv : + v ∈ TilingLattice C), (x ∈ BoundaryFootprintVertices (TileTranslation T v)) → (∀ (P : + PeriodicTileComplex ↥(TilingLattice C)), + let iv : TilingLattice C := ⟨v, hv⟩ + (x ∈ BoundaryFootprintVertices (P.tile iv)) → ((∃ y ∈ (P.tile iv).cells, y = x ∨ y = x - + 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → ((∃ y, y ∉ (P.tile iv).cells ∧ (y = x ∨ y + = x - 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩)) → (∀ (a0 : ↥(TilingLattice C)), (x ∈ + (P.tile a0).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x + ∈ (P.tile a).cells) y → y = a0) → (∀ (a1 : ↥(TilingLattice C)), (x - (1 : + LatticeCell) ∈ (P.tile a1).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : + ↥(TilingLattice C)) => x - (1 : LatticeCell) ∈ (P.tile a).cells) y → y = a1) → (∀ (a2 + : ↥(TilingLattice C)), (x - (1 : LatticeCell) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ + (P.tile a2).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x + - (1 : LatticeCell) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = + a2) → (∀ (a3 : ↥(TilingLattice C)), (x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile + a3).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (⟨(0 + : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = a3) → (¬ (iv = a0 ∧ iv = a1 + ∧ iv = a2 ∧ iv = a3))))))))))))) ) := by + classical + intro C T x v hv hx P iv hxi hcorner hcornerOutside a0 ha0 hu0 a1 ha1 hu1 a2 ha2 hu2 a3 ha3 hu3 + rintro ⟨h0, h1, h2, h3⟩ + rcases hcornerOutside with ⟨y, hy, rfl | rfl | rfl | rfl⟩ + · exact hy (by simpa [h0] using ha0) + · exact hy (by simpa [h1] using ha1) + · exact hy (by simpa [h2] using ha2) + · exact hy (by simpa [h3] using ha3) + +private theorem atMostOneRemaining : + (by + classical + exact + ∀ a b c i j : Fin 4, a ≠ b → c ≠ a → c ≠ b → i ≠ a → i ≠ b → i ≠ c → j ≠ a → j ≠ b → j ≠ + c → i = j ) := by + classical + decide +kernel + +private theorem secondOwnerCoversThree : + (by + classical + exact + (∀ a b c i j : Fin 4, a ≠ b → c ≠ a → c ≠ b → i ≠ a → i ≠ b → i ≠ c → j ≠ a → j ≠ b → j ≠ + c → i = j) → (∀ {I : Type}, ∀ (f : Fin 4 → I), ∀ (m : Fin 4), (∃ w, f w ≠ f m) → ((¬ + Function.Injective f) → (∃ w, f w ≠ f m ∧ ∀ i, ∀ j, f i ≠ f m → f i ≠ f w → f j ≠ f m + → f j ≠ f w → i = j))) ) := by + classical + intro atMostOneRemaining I f m hother hnotinj + classical + have hrepeat : ∃ a b, f a = f b ∧ a ≠ b := by + by_contra h + apply hnotinj + intro a b hab + by_contra hne + exact h ⟨a, b, hab, hne⟩ + obtain ⟨a, b, hab, hne⟩ := hrepeat + by_cases ha : f a = f m + · obtain ⟨w, hw⟩ := hother + have hb : f b = f m := hab.symm.trans ha + have hwa : w ≠ a := by + intro h + exact hw ((congrArg f h).trans ha) + have hwb : w ≠ b := by + intro h + exact hw ((congrArg f h).trans hb) + refine ⟨w, hw, ?_⟩ + intro i j him hiw hjm hjw + apply atMostOneRemaining a b w i j hne hwa hwb + · intro h + exact him ((congrArg f h).trans ha) + · intro h + exact him ((congrArg f h).trans hb) + · intro h + exact hiw (congrArg f h) + · intro h + exact hjm ((congrArg f h).trans ha) + · intro h + exact hjm ((congrArg f h).trans hb) + · intro h + exact hjw (congrArg f h) + · have hma : m ≠ a := by + intro h + exact ha (congrArg f h.symm) + have hmb : m ≠ b := by + intro h + exact ha (hab.trans (congrArg f h.symm)) + refine ⟨a, ha, ?_⟩ + intro i j him hia hjm hja + apply atMostOneRemaining a b m i j hne hma hmb + · intro h + exact hia (congrArg f h) + · intro h + exact hia ((congrArg f h).trans hab.symm) + · intro h + exact him (congrArg f h) + · intro h + exact hja (congrArg f h) + · intro h + exact hja ((congrArg f h).trans hab.symm) + · intro h + exact hjm (congrArg f h) + +private theorem hmexists : + (by + classical + exact + ∀ (C : BandCircle), ∀ (v : GaussianInt), ∀ (hv : v ∈ TilingLattice C), + let iv : TilingLattice C := ⟨v, hv⟩ + ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ + (a3 : ↥(TilingLattice C)), (iv = a0 ∨ iv = a1 ∨ iv = a2 ∨ iv = a3) → ( + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∃ m : Fin 4, owner m = iv) ) := by + classical + intro C v hv iv a0 a1 a2 a3 hvowner owner + rcases hvowner with h | h | h | h + · exact ⟨0, by simpa [owner] using h.symm⟩ + · exact ⟨1, by simpa [owner] using h.symm⟩ + · exact ⟨2, by simpa [owner] using h.symm⟩ + · exact ⟨3, by simpa [owner] using h.symm⟩ + +private theorem hnotinj : + (by + classical + exact + ∀ (C : BandCircle), ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : + ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), (a0 = a1 ∨ a0 = a2 ∨ a0 = a3 ∨ a1 = + a2 ∨ a1 = a3 ∨ a2 = a3) → ( + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ¬ Function.Injective owner) ) := by + classical + intro C a0 a1 a2 a3 hfour owner hi + rcases hfour with h01 | h02 | h03 | h12 | h13 | h23 + · have hh : (0 : Fin 4) = 1 := hi (by simpa [owner] using h01) + exact (by decide : (0 : Fin 4) ≠ 1) hh + · have hh : (0 : Fin 4) = 2 := hi (by simpa [owner] using h02) + exact (by decide : (0 : Fin 4) ≠ 2) hh + · have hh : (0 : Fin 4) = 3 := hi (by simpa [owner] using h03) + exact (by decide : (0 : Fin 4) ≠ 3) hh + · have hh : (1 : Fin 4) = 2 := hi (by simpa [owner] using h12) + exact (by decide : (1 : Fin 4) ≠ 2) hh + · have hh : (1 : Fin 4) = 3 := hi (by simpa [owner] using h13) + exact (by decide : (1 : Fin 4) ≠ 3) hh + · have hh : (2 : Fin 4) = 3 := hi (by simpa [owner] using h23) + exact (by decide : (2 : Fin 4) ≠ 3) hh + +private theorem hnotall : + (by + classical + exact + ∀ (C : BandCircle), ∀ (v : GaussianInt), ∀ (hv : v ∈ TilingLattice C), + let iv : TilingLattice C := ⟨v, hv⟩ + ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ + (a3 : ↥(TilingLattice C)), (¬ (iv = a0 ∧ iv = a1 ∧ iv = a2 ∧ iv = a3)) → ( + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ¬ ∀ i, owner i = iv) ) := by + classical + intro C v hv iv a0 a1 a2 a3 hvnotfour owner hall + apply hvnotfour + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa [owner] using (hall 0).symm + · simpa [owner] using (hall 1).symm + · simpa [owner] using (hall 2).symm + · simpa [owner] using (hall 3).symm + +private theorem hother : + (by + classical + exact + ∀ (C : BandCircle), ∀ (v : GaussianInt), ∀ (hv : v ∈ TilingLattice C), + let iv : TilingLattice C := ⟨v, hv⟩ + ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ + (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), (owner m = iv) → ((¬ ∀ i, owner i = iv) → (∃ w, owner w ≠ owner m)) + ) := by + classical + intro C v hv iv a0 a1 a2 a3 owner m hm hnotall + by_contra hn + push Not at hn + apply hnotall + intro i + exact (hn i).trans hm + +private theorem colorCycle : + (by + classical + exact + let next : Fin 4 → Fin 4 := ![1, 2, 3, 0] + ∀ col : Fin 4 → Fin 3, (∃ i, col i = 0) → (∃ i, col i = 1) → (∀ i, ∀ j, col i = 2 → col j + = 2 → i = j) → ∃ i, (col i = 0 ∧ col (next i) = 1) ∨ (col i = 1 ∧ col (next i) = 0) ) + := by + classical + intro next + decide +kernel + +private theorem hcol2unique : + (by + classical + exact + ∀ (C : BandCircle), ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : + ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), (owner w ≠ owner m) → ((∀ (i : Fin (4 : ℕ)), ∀ + (j : Fin (4 : ℕ)), owner i ≠ owner m → owner i ≠ owner w → owner j ≠ owner m → owner + j ≠ owner w → i = j) → ( + let col : Fin 4 → Fin 3 := fun i => + if owner i = owner m then 0 else if owner i = owner w then 1 else 2 + ∀ i, ∀ j, col i = 2 → col j = 2 → i = j)) ) := by + classical + intro C a0 a1 a2 a3 owner m w hmw hcover col i j hi hj + have hiA : owner i ≠ owner m := by + intro h + have hc : col i = 0 := by simp [col, h] + exact (by decide : (0 : Fin 3) ≠ 2) (hc.symm.trans hi) + have hiB : owner i ≠ owner w := by + intro h + have hc : col i = 1 := by simp [col, h, hmw] + exact (by decide : (1 : Fin 3) ≠ 2) (hc.symm.trans hi) + have hjA : owner j ≠ owner m := by + intro h + have hc : col j = 0 := by simp [col, h] + exact (by decide : (0 : Fin 3) ≠ 2) (hc.symm.trans hj) + have hjB : owner j ≠ owner w := by + intro h + have hc : col j = 1 := by simp [col, h, hmw] + exact (by decide : (1 : Fin 3) ≠ 2) (hc.symm.trans hj) + exact hcover i j hiA hiB hjA hjB + +private theorem hepair : + (by + classical + exact + ∀ (C : BandCircle), ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : + ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), + let next : Fin 4 → Fin 4 := ![1, 2, 3, 0] + let col : Fin 4 → Fin 3 := fun i => + if owner i = owner m then 0 else if owner i = owner w then 1 else 2 + ∀ (e : Fin (4 : ℕ)), (col e = (0 : Fin (3 : ℕ)) ∧ col (next e) = (1 : Fin (3 : ℕ)) ∨ col + e = (1 : Fin (3 : ℕ)) ∧ col (next e) = (0 : Fin (3 : ℕ))) → ((owner e = owner m ∧ + owner (next e) = owner w) ∨ (owner e = owner w ∧ owner (next e) = owner m)) ) := by + classical + intro C a0 a1 a2 a3 owner m w next col e hecolor + rcases hecolor with h | h + · left + have h0 := h.1 + have h1 := h.2 + constructor + · by_contra hn + change (if owner e = owner m then 0 else + if owner e = owner w then 1 else 2) = 0 at h0 + rw [ite_eq_right hn] at h0 + by_cases hew : owner e = owner w + · rw [ite_eq_left hew] at h0 + exact (by decide : (1 : Fin 3) ≠ 0) h0 + · rw [ite_eq_right hew] at h0 + exact (by decide : (2 : Fin 3) ≠ 0) h0 + · have hne : owner (next e) ≠ owner m := by + intro hh + have hc : col (next e) = 0 := by simp [col, hh] + exact (by decide : (0 : Fin 3) ≠ 1) (hc.symm.trans h1) + change (if owner (next e) = owner m then 0 else + if owner (next e) = owner w then 1 else 2) = 1 at h1 + rw [ite_eq_right hne] at h1 + by_contra hn + rw [ite_eq_right hn] at h1 + exact (by decide : (2 : Fin 3) ≠ 1) h1 + · right + have h0 := h.1 + have h1 := h.2 + constructor + · have hne : owner e ≠ owner m := by + intro hh + have hc : col e = 0 := by simp [col, hh] + exact (by decide : (0 : Fin 3) ≠ 1) (hc.symm.trans h0) + change (if owner e = owner m then 0 else + if owner e = owner w then 1 else 2) = 1 at h0 + rw [ite_eq_right hne] at h0 + by_contra hn + rw [ite_eq_right hn] at h0 + exact (by decide : (2 : Fin 3) ≠ 1) h0 + · by_contra hn + change (if owner (next e) = owner m then 0 else + if owner (next e) = owner w then 1 else 2) = 0 at h1 + rw [ite_eq_right hn] at h1 + by_cases hew : owner (next e) = owner w + · rw [ite_eq_left hew] at h1 + exact (by decide : (1 : Fin 3) ≠ 0) h1 + · rw [ite_eq_right hew] at h1 + exact (by decide : (2 : Fin 3) ≠ 0) h1 + +private theorem hsector : + (by + classical + exact + ∀ (C : BandCircle), ∀ (x : GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + ∀ (a0 : ↥(TilingLattice C)), (x ∈ (P.tile a0).cells) → (∀ (a1 : ↥(TilingLattice C)), + (x - (1 : LatticeCell) ∈ (P.tile a1).cells) → (∀ (a2 : ↥(TilingLattice C)), (x - (1 : + LatticeCell) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a2).cells) → (∀ (a3 : + ↥(TilingLattice C)), (x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a3).cells) → ( + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + let sector : Fin 4 → GaussianInt := + ![x, x - 1, x - 1 - ⟨0, 1⟩, x - ⟨0, 1⟩] + ∀ i, sector i ∈ (P.tile (owner i)).cells)))) ) := by + classical + intro C x P a0 ha0 a1 ha1 a2 ha2 a3 ha3 owner sector i + fin_cases i + · simpa [sector, owner] using ha0 + · simpa [sector, owner] using ha1 + · simpa [sector, owner] using ha2 + · simpa [sector, owner] using ha3 + +private theorem hsectorNot : + (by + classical + exact + ∀ (C : BandCircle), ∀ (x : GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice + C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + let sector : Fin 4 → GaussianInt := + ![x, x - 1, x - 1 - ⟨0, 1⟩, x - ⟨0, 1⟩] + (∀ i, sector i ∈ (P.tile (owner i)).cells) → (∀ (i : Fin 4), ∀ (j : Fin 4), (owner i ≠ + owner j) → (sector j ∉ (P.tile (owner i)).cells)) ) := by + classical + intro C x P a0 a1 a2 a3 owner sector hsector i j hij hmem + have huniq := PeriodicTileIndexedMultiplicityOne P (sector j) + have hji := huniq.unique (hsector j) hmem + exact hij hji.symm + +private theorem hedgeBoundary : + (by + classical + exact + ∀ (C : BandCircle), ∀ (x : GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + ∀ (a0 : ↥(TilingLattice C)), (x ∈ (P.tile a0).cells) → (∀ (a1 : ↥(TilingLattice C)), + (x - (1 : LatticeCell) ∈ (P.tile a1).cells) → (∀ (a2 : ↥(TilingLattice C)), (x - (1 : + LatticeCell) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a2).cells) → (∀ (a3 : + ↥(TilingLattice C)), (x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a3).cells) → ( + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + let next : Fin 4 → Fin 4 := ![1, 2, 3, 0] + let sector : Fin 4 → GaussianInt := + ![x, x - 1, x - 1 - ⟨0, 1⟩, x - ⟨0, 1⟩] + let edge : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (i : Fin 4), ∀ (j : Fin 4), (owner i ≠ owner j) → (sector j ∉ (P.tile (owner + i)).cells)) → (∀ (i : Fin 4), (owner i ≠ owner (next i)) → (edge i ∈ + BoundaryFootprintEdges (P.tile (owner i)) ∧ edge i ∈ BoundaryFootprintEdges (P.tile + (owner (next i))))))))) ) := by + classical + intro C x P a0 ha0 a1 ha1 a2 ha2 a3 ha3 owner next sector edge hsectorNot i hij + fin_cases i + · constructor + · refine ⟨x, Or.inr ⟨by simp [edge], Or.inl ⟨?_, ?_⟩⟩⟩ + · simpa [sector, owner] using ha0 + · exact hsectorNot 0 1 (by simpa [owner, next] using hij) + · refine ⟨x, Or.inr ⟨by simp [edge], Or.inr ⟨?_, ?_⟩⟩⟩ + · exact hsectorNot 1 0 (by simpa [owner, next] using hij.symm) + · simpa [sector, owner, next] using ha1 + · constructor + · refine ⟨x - 1, Or.inl ⟨by simp [edge], Or.inl ⟨?_, ?_⟩⟩⟩ + · simpa [sector, owner] using ha1 + · exact hsectorNot 1 2 (by simpa [owner, next] using hij) + · refine ⟨x - 1, Or.inl ⟨by simp [edge], Or.inr ⟨?_, ?_⟩⟩⟩ + · exact hsectorNot 2 1 (by simpa [owner, next] using hij.symm) + · simpa [sector, owner, next] using ha2 + · constructor + · refine ⟨x - ⟨0, 1⟩, Or.inr ⟨by simp [edge], Or.inr ⟨?_, ?_⟩⟩⟩ + · exact hsectorNot 2 3 (by simpa [owner, next] using hij) + · have hcoord : x - ⟨0, 1⟩ - 1 = x - 1 - ⟨0, 1⟩ := by abel + rw [hcoord] + exact ha2 + · refine ⟨x - ⟨0, 1⟩, Or.inr ⟨by simp [edge], Or.inl ⟨?_, ?_⟩⟩⟩ + · simpa [sector, owner, next] using ha3 + · have hcoord : x - ⟨0, 1⟩ - 1 = x - 1 - ⟨0, 1⟩ := by abel + rw [hcoord] + exact hsectorNot 3 2 (by simpa [owner, next] using hij.symm) + · constructor + · refine ⟨x, Or.inl ⟨by simp [edge], Or.inr ⟨?_, ?_⟩⟩⟩ + · exact hsectorNot 3 0 (by simpa [owner, next] using hij) + · simpa [sector, owner] using ha3 + · refine ⟨x, Or.inl ⟨by simp [edge], Or.inl ⟨?_, ?_⟩⟩⟩ + · simpa [sector, owner, next] using ha0 + · exact hsectorNot 0 3 (by simpa [owner, next] using hij.symm) + +private theorem boundaryEdge : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges U) → (e ∈ + FootprintEdges U) ) := by + classical + intro U e he + let I : GaussianInt := ⟨0, 1⟩ + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [I, Zsqrtd.ext_iff] + · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + +private theorem hnewe : + (by + classical + exact + ∀ (C : BandCircle), ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : + ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), (owner w ≠ owner m) → ( + let next : Fin 4 → Fin 4 := ![1, 2, 3, 0] + ∀ (e : Fin (4 : ℕ)), ((owner e = owner m ∧ owner (next e) = owner w) ∨ (owner e = owner w + ∧ owner (next e) = owner m)) → (owner e ≠ owner (next e))) ) := by + classical + intro C a0 a1 a2 a3 owner m w hmw next e hepair heq + rcases hepair with ⟨heA, henB⟩ | ⟨heB, henA⟩ + · apply hmw + calc + owner w = owner (next e) := henB.symm + _ = owner e := heq.symm + _ = owner m := heA + · apply hmw + calc + owner w = owner e := heB.symm + _ = owner (next e) := heq + _ = owner m := henA + +private theorem hcommon : + (by + classical + exact + ∀ (C : BandCircle), ∀ (x : GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice + C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), + let next : Fin 4 → Fin 4 := ![1, 2, 3, 0] + ∀ (e : Fin (4 : ℕ)), ((owner e = owner m ∧ owner (next e) = owner w) ∨ (owner e = owner w + ∧ owner (next e) = owner m)) → ( + let edge : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges U) → (e ∈ + FootprintEdges U)) → ((edge e ∈ BoundaryFootprintEdges (P.tile (owner e))) → ((edge e + ∈ BoundaryFootprintEdges (P.tile (owner (next e)))) → ((FootprintEdges (P.tile (owner + m)) ∩ FootprintEdges (P.tile (owner w))).Nonempty)))) ) := by + classical + intro C x P a0 a1 a2 a3 owner m w next e hepair edge boundaryEdge edge_mem_e edge_mem_next + refine ⟨edge e, ?_⟩ + rcases hepair with ⟨heA, henB⟩ | ⟨heB, henA⟩ + · constructor + · simpa [heA] using boundaryEdge (P.tile (owner e)) (edge e) edge_mem_e + · simpa [henB] using boundaryEdge (P.tile (owner (next e))) + (edge e) edge_mem_next + · constructor + · simpa [henA] using boundaryEdge (P.tile (owner (next e))) + (edge e) edge_mem_next + · simpa [heB] using boundaryEdge (P.tile (owner e)) (edge e) edge_mem_e + +private theorem hadj : + (by + classical + exact + ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (a0 : + ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ (a3 + : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), (owner m ≠ owner w) → (((FootprintEdges (P.tile + (owner m)) ∩ FootprintEdges (P.tile (owner w))).Nonempty) → (P.plane.adjacent (owner + m) (owner w))) ) := by + classical + intro C P a0 a1 a2 a3 owner m w hneq hcommon + have hclass := (PeriodicTileIntersectionClassification P).1 + exact (hclass (owner m) (owner w) hneq).1.mp hcommon + +private theorem slope_for : + (by + classical + exact + ∀ (C : BandCircle), (PeriodicTileComplex ↥(TilingLattice C)) → ((↥(TilingLattice C)) → + ((↥(TilingLattice C)) → ((↥(TilingLattice C)) → ((↥(TilingLattice C)) → ((Fin (4 : + ℕ)) → ((Fin (4 : ℕ)) → (∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : + PartialOdometer), TileOdometer c U k → 1 < c.1 → ∃ p : ℝ × ℝ, PartialOdometerSlope k + = some p))))))) ) := by + classical + intro C P a0 a1 a2 a3 m w c U k ho hcpos + induction ho with + | line w y hw hdom => omega + | unit z y U hU hdom htrans => omega + | @decompose qd hqd S U hs k hU hsub hcells hfoot hcentroid hdom hvalue + hcompat hslope ih => + have facts := ProperBandCurvatureStructure qd hqd + have hp : ∃ i : Fin 3, 0 < (qd i.succ).1 := by + by_cases h0 : 0 < (qd (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (qd (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + by_cases h2 : 0 < (qd (2 : Fin 3).succ).1 + · exact ⟨2, h2⟩ + have n0 := facts.2.1 (0 : Fin 3) + have n1 := facts.2.1 (1 : Fin 3) + have z0 : (qd (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (qd (1 : Fin 3).succ).1 = 0 := by omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim + rcases hp with ⟨i, hi⟩ + rcases hslope i false with hz | ⟨p, pi, hp, hpi, hpr, hpi'⟩ + · omega + · exact ⟨p, hp⟩ + +private theorem hcurvature : + (by + classical + exact + ∀ (C : BandCircle), (¬C.1.1.1 = (1 : ℤ)) → ((PeriodicTileComplex ↥(TilingLattice C)) → (∀ + (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), + ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), + let next : Fin 4 → Fin 4 := ![1, 2, 3, 0] + let col : Fin 4 → Fin 3 := fun i => + if owner i = owner m then 0 else if owner i = owner w then 1 else 2 + ∀ (e : Fin (4 : ℕ)), (col e = (0 : Fin (3 : ℕ)) ∧ col (next e) = (1 : Fin (3 : ℕ)) ∨ col + e = (1 : Fin (3 : ℕ)) ∧ col (next e) = (0 : Fin (3 : ℕ))) → (1 < C.1.1.1))) ) := by + classical + intro C hc P a0 a1 a2 a3 owner m w next col e hecolor + have hpos : 0 < C.1.1.1 := C.2 + omega + +private theorem hu_eq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (v : GaussianInt), ∀ (hv : v ∈ TilingLattice C), + let iv : TilingLattice C := ⟨v, hv⟩ + ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ + (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), (owner m = iv) → ( + let u : GaussianInt := owner m + u = v) ) := by + classical + intro C v hv iv a0 a1 a2 a3 owner m hm u + change (owner m : GaussianInt) = v + rw [hm] + +private theorem translateExtends : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (g : IntegerLatticeFunction), (GlobalOdometerExtends g h) → (∀ + (t : GaussianInt), ∀ (a : GaussianInt), (∀ y, g (y + t) = g y + y.re * a.re + y.im * + a.im + g t) → (GlobalOdometerExtends g (PartialOdometerAffineTranslate h t a 0))) ) + := by + classical + intro h g hext t a hshift + rcases hext with ⟨c, hc⟩ + refine ⟨c + g t - t.re * a.re - t.im * a.im, ?_⟩ + intro y hy + have hy' := (PartialOdometerAffineTranslateFormulas h t a 0).2.1 y |>.mp hy + have hval := (PartialOdometerAffineTranslateFormulas h t a 0).2.2.1 y hy + have hext' := hc (y - t) hy' + have hsum : y - t + t = y := by abel + have hRe : (y - t).re + t.re = y.re := by + have hh := congrArg Zsqrtd.re hsum + simp + have hIm : (y - t).im + t.im = y.im := by + have hh := congrArg Zsqrtd.im hsum + simp + have hgy := hshift (y - t) + rw [hsum] at hgy + rw [hgy, hext', hval] + rw [← hRe, ← hIm] + ring + +private theorem centroidShift : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (z : GaussianInt), TileCentroid (TileTranslation T z) = TileCentroid + T + GaussianRealPoint z ) := by + classical + intro T z + rw [(TileTranslationFormulas T z).2.2.2.2.1] + ext <;> simp [GaussianRealPoint] + +private theorem hcentDiff : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : + ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), + let u : GaussianInt := owner m + let u' : GaussianInt := owner w + (∀ (z : GaussianInt), TileCentroid (TileTranslation T z) = TileCentroid T + + GaussianRealPoint z) → (TileCentroid (TileTranslation T u') - TileCentroid + (TileTranslation T u) = GaussianRealPoint (u' - u)) ) := by + classical + intro C T a0 a1 a2 a3 owner m w u u' centroidShift + rw [centroidShift u', centroidShift u] + ext <;> simp [GaussianRealPoint] + +private theorem hmatrixDiff : + (by + classical + exact + ∀ (C : BandCircle), ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : + ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), + let u : GaussianInt := owner m + let u' : GaussianInt := owner w + ∀ (au : GaussianInt), ((CircleMatrix C).mulVec ![(↑u.re : ℝ), (↑u.im : ℝ)] = ![(↑au.re : + ℝ), (↑au.im : ℝ)]) → (∀ (au' : GaussianInt), ((CircleMatrix C).mulVec ![(↑u'.re : ℝ), + (↑u'.im : ℝ)] = ![(↑au'.re : ℝ), (↑au'.im : ℝ)]) → (Matrix.mulVec (CircleMatrix C) + ![((u' - u).re : ℝ), ((u' - u).im : ℝ)] = ![((au' - au).re : ℝ), ((au' - au).im : + ℝ)])) ) := by + classical + intro C a0 a1 a2 a3 owner m w u u' au hAu au' hAu' + have hre : (u' - u).re = u'.re - u.re := by + cases u; cases u'; rfl + have him : (u' - u).im = u'.im - u.im := by + cases u; cases u'; rfl + have hA0 := congrFun hAu 0 + have hA1 := congrFun hAu 1 + have hA0' := congrFun hAu' 0 + have hA1' := congrFun hAu' 1 + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] at hA0 hA1 hA0' hA1' + ext k + fin_cases k + · simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, hre, him] + linarith + · simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, hre, him] + linarith + +private theorem hAdiff : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (a0 : ↥(TilingLattice C)), + ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), ∀ (j : Fin (3 : ℕ)), ((↑(owner w) : + GaussianInt) - (↑(owner m) : GaussianInt) = BandVectors.1 (q j.succ) (q (0 : Fin (4 : + ℕ))) ∨ (↑(owner w) : GaussianInt) - (↑(owner m) : GaussianInt) = -BandVectors.1 (q + j.succ) (q (0 : Fin (4 : ℕ)))) → ( + let u : GaussianInt := owner m + let u' : GaussianInt := owner w + ∀ (au : GaussianInt), ∀ (au' : GaussianInt), (Matrix.mulVec (CircleMatrix C) ![((u' - + u).re : ℝ), ((u' - u).im : ℝ)] = ![((au' - au).re : ℝ), ((au' - au).im : ℝ)]) → + (((CircleMatrix C).mulVec ![(↑(BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ)))).re : + ℝ), (↑(BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ)))).im : ℝ)] = ![(↑(BandVectors.2 + (q j.succ) (q (0 : Fin (4 : ℕ)))).re : ℝ), (↑(BandVectors.2 (q j.succ) (q (0 : Fin (4 + : ℕ)))).im : ℝ)]) → (au' - au = BandVectors.2 (q j.succ) (q 0) ∨ au' - au = + -BandVectors.2 (q j.succ) (q 0)))) ) := by + classical + intro C q a0 a1 a2 a3 owner m w j hsign u u' au au' hmatrixDiff hincoming + rcases hsign with hplus | hminus + · have hmd := hmatrixDiff + rw [hplus] at hmd + left + have hvec := hmd.symm.trans hincoming + ext + · have hh : ((au' - au).re : ℝ) = + ((BandVectors.2 (q j.succ) (q 0)).re : ℝ) := by + simpa using congrFun hvec 0 + exact_mod_cast hh + · have hh : ((au' - au).im : ℝ) = + ((BandVectors.2 (q j.succ) (q 0)).im : ℝ) := by + simpa using congrFun hvec 1 + exact_mod_cast hh + · have hmd := hmatrixDiff + rw [hminus] at hmd + right + have hneg' : Matrix.mulVec (CircleMatrix C) + ![(-((BandVectors.1 (q j.succ) (q 0)).re : ℝ)), + (-((BandVectors.1 (q j.succ) (q 0)).im : ℝ))] = + ![(-((BandVectors.2 (q j.succ) (q 0)).re : ℝ)), + (-((BandVectors.2 (q j.succ) (q 0)).im : ℝ))] := by + ext k + fin_cases k + · have hc := congrFun hincoming 0 + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] at hc ⊢ + linarith + · have hc := congrFun hincoming 1 + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] at hc ⊢ + linarith + have hneg : Matrix.mulVec (CircleMatrix C) + ![((-BandVectors.1 (q j.succ) (q 0)).re : ℝ), + ((-BandVectors.1 (q j.succ) (q 0)).im : ℝ)] = + ![((-BandVectors.2 (q j.succ) (q 0)).re : ℝ), + ((-BandVectors.2 (q j.succ) (q 0)).im : ℝ)] := by + simpa [Zsqrtd.re_neg, Zsqrtd.im_neg] using hneg' + have hmd' := hmd + simp only [Zsqrtd.re_neg, Zsqrtd.im_neg] at hmd' + have hvec := hmd'.symm.trans hneg + ext + · have hh : ((au' - au).re : ℝ) = + (-((BandVectors.2 (q j.succ) (q 0)).re : ℝ)) := by + simpa using congrFun hvec 0 + exact_mod_cast hh + · have hh : ((au' - au).im : ℝ) = + (-((BandVectors.2 (q j.succ) (q 0)).im : ℝ)) := by + simpa using congrFun hvec 1 + exact_mod_cast hh + +private theorem aDiffPlus : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (a0 : ↥(TilingLattice C)), + ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), ∀ (j : Fin (3 : ℕ)), + let u : GaussianInt := owner m + let u' : GaussianInt := owner w + ∀ (au : GaussianInt), ∀ (au' : GaussianInt), (Matrix.mulVec (CircleMatrix C) ![((u' - + u).re : ℝ), ((u' - u).im : ℝ)] = ![((au' - au).re : ℝ), ((au' - au).im : ℝ)]) → + (((CircleMatrix C).mulVec ![(↑(BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ)))).re : + ℝ), (↑(BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ)))).im : ℝ)] = ![(↑(BandVectors.2 + (q j.succ) (q (0 : Fin (4 : ℕ)))).re : ℝ), (↑(BandVectors.2 (q j.succ) (q (0 : Fin (4 + : ℕ)))).im : ℝ)]) → ((u' - u = BandVectors.1 (q j.succ) (q 0)) → (au' - au = + BandVectors.2 (q j.succ) (q 0)))) ) := by + classical + intro C q a0 a1 a2 a3 owner m w j u u' au au' hmatrixDiff hincoming hplus + have hmd := hmatrixDiff + rw [hplus] at hmd + have hvec := hmd.symm.trans hincoming + ext + · have hh : ((au' - au).re : ℝ) = + ((BandVectors.2 (q j.succ) (q 0)).re : ℝ) := by + simpa using congrFun hvec 0 + exact_mod_cast hh + · have hh : ((au' - au).im : ℝ) = + ((BandVectors.2 (q j.succ) (q 0)).im : ℝ) := by + simpa using congrFun hvec 1 + exact_mod_cast hh + +private theorem aDiffMinus : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (a0 : ↥(TilingLattice C)), + ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), ∀ (j : Fin (3 : ℕ)), + let u : GaussianInt := owner m + let u' : GaussianInt := owner w + ∀ (au : GaussianInt), ∀ (au' : GaussianInt), (Matrix.mulVec (CircleMatrix C) ![((u' - + u).re : ℝ), ((u' - u).im : ℝ)] = ![((au' - au).re : ℝ), ((au' - au).im : ℝ)]) → + (((CircleMatrix C).mulVec ![(↑(BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ)))).re : + ℝ), (↑(BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ)))).im : ℝ)] = ![(↑(BandVectors.2 + (q j.succ) (q (0 : Fin (4 : ℕ)))).re : ℝ), (↑(BandVectors.2 (q j.succ) (q (0 : Fin (4 + : ℕ)))).im : ℝ)]) → ((u' - u = -BandVectors.1 (q j.succ) (q 0)) → (au' - au = + -BandVectors.2 (q j.succ) (q 0)))) ) := by + classical + intro C q a0 a1 a2 a3 owner m w j u u' au au' hmatrixDiff hincoming hminus + have hmd := hmatrixDiff + rw [hminus] at hmd + have hneg' : Matrix.mulVec (CircleMatrix C) + ![(-((BandVectors.1 (q j.succ) (q 0)).re : ℝ)), + (-((BandVectors.1 (q j.succ) (q 0)).im : ℝ))] = + ![(-((BandVectors.2 (q j.succ) (q 0)).re : ℝ)), + (-((BandVectors.2 (q j.succ) (q 0)).im : ℝ))] := by + ext k + fin_cases k + · have hc := congrFun hincoming 0 + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] at hc ⊢ + linarith + · have hc := congrFun hincoming 1 + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] at hc ⊢ + linarith + have hneg : Matrix.mulVec (CircleMatrix C) + ![((-BandVectors.1 (q j.succ) (q 0)).re : ℝ), + ((-BandVectors.1 (q j.succ) (q 0)).im : ℝ)] = + ![((-BandVectors.2 (q j.succ) (q 0)).re : ℝ), + ((-BandVectors.2 (q j.succ) (q 0)).im : ℝ)] := by + simpa [Zsqrtd.re_neg, Zsqrtd.im_neg] using hneg' + simp only [Zsqrtd.re_neg, Zsqrtd.im_neg] at hmd + have hvec := hmd.symm.trans hneg + ext + · have hh : ((au' - au).re : ℝ) = + (-((BandVectors.2 (q j.succ) (q 0)).re : ℝ)) := by + simpa using congrFun hvec 0 + exact_mod_cast hh + · have hh : ((au' - au).im : ℝ) = + (-((BandVectors.2 (q j.succ) (q 0)).im : ℝ)) := by + simpa using congrFun hvec 1 + exact_mod_cast hh + +private theorem hslopeU : + (by + classical + exact + ∀ (C : BandCircle), ∀ (h : PartialOdometer), ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : + ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (p : ℝ × ℝ), (PartialOdometerSlope h = some p) → ( + let u : GaussianInt := owner m + ∀ (au : GaussianInt), + let huOdo : PartialOdometer := PartialOdometerAffineTranslate h u au 0 + PartialOdometerSlope huOdo = some (p.1 + (au.re : ℝ), p.2 + (au.im : ℝ))) ) := by + classical + intro C h a0 a1 a2 a3 owner m p hp u au huOdo + rw [(PartialOdometerAffineTranslateFormulas h u au 0).2.2.2.2.2, hp] + rfl + +private theorem hslopeU' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (h : PartialOdometer), ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : + ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (w : Fin (4 : ℕ)), ∀ (p : ℝ × ℝ), (PartialOdometerSlope h = some p) → ( + let u' : GaussianInt := owner w + ∀ (au' : GaussianInt), + let hu'Odo : PartialOdometer := PartialOdometerAffineTranslate h u' au' 0 + PartialOdometerSlope hu'Odo = some (p.1 + (au'.re : ℝ), p.2 + (au'.im : ℝ))) ) := by + classical + intro C h a0 a1 a2 a3 owner w p hp u' au' hu'Odo + rw [(PartialOdometerAffineTranslateFormulas h u' au' 0).2.2.2.2.2, hp] + rfl + +private theorem cellVertex : + (by + classical + exact + ∀ (C : BandCircle), ∀ (x : GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice + C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + let sector : Fin 4 → GaussianInt := + ![x, x - 1, x - 1 - ⟨0, 1⟩, x - ⟨0, 1⟩] + (∀ i, sector i ∈ (P.tile (owner i)).cells) → ((∀ (i : Fin 4), (P.tile (owner + i)).cells.Nonempty) → (∀ (i : Fin 4), ∀ (y : GaussianInt), (y = sector i ∨ y = sector + i + 1 ∨ + y = sector i + ⟨0, 1⟩ ∨ y = sector i + 1 + ⟨0, 1⟩) → (y ∈ FootprintVertices (P.tile + (owner i))))) ) := by + classical + intro C x P a0 a1 a2 a3 owner sector hsector ownerNonempty i y hy + simp only [FootprintVertices, ownerNonempty i, ite_true] + exact ⟨sector i, hsector i, hy⟩ + +private theorem sectorCornerX : + (by + classical + exact + ∀ (x : GaussianInt), + let sector : Fin 4 → GaussianInt := + ![x, x - 1, x - 1 - ⟨0, 1⟩, x - ⟨0, 1⟩] + ∀ i : Fin 4, x = sector i ∨ x = sector i + 1 ∨ x = sector i + ⟨0, 1⟩ ∨ x = sector i + 1 + + ⟨0, 1⟩ ) := by + classical + intro x sector i + fin_cases i <;> simp [sector]; abel; simp + +private theorem pairCovered : + (by + classical + exact + ∀ (C : BandCircle), ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : + ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), (∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), + owner i ≠ owner m → owner i ≠ owner w → owner j ≠ owner m → owner j ≠ owner w → i = + j) → (∀ (i : Fin 4), ∀ (j : Fin 4), (i ≠ j) → (owner i = owner m ∨ owner i = owner w + ∨ owner j = owner m ∨ owner j = owner w)) ) := by + classical + intro C a0 a1 a2 a3 owner m w hcover i j hij + by_contra hn + push Not at hn + have heq := hcover i j hn.1 hn.2.1 hn.2.2.1 hn.2.2.2 + exact hij heq + +private theorem toDomains : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (P : + PeriodicTileComplex ↥(TilingLattice C)), ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : + ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), + let u : GaussianInt := owner m + let u' : GaussianInt := owner w + ∀ (au : GaussianInt), ∀ (au' : GaussianInt), + let huOdo : PartialOdometer := PartialOdometerAffineTranslate h u au 0 + let hu'Odo : PartialOdometer := PartialOdometerAffineTranslate h u' au' 0 + ((huOdo.domain : Set GaussianInt) = FootprintVertices (TileTranslation T u)) → + (((hu'Odo.domain : Set GaussianInt) = FootprintVertices (TileTranslation T u')) → + ((P.tile (owner m) = TileTranslation T u) → ((P.tile (owner w) = TileTranslation T + u') → (∀ (y : GaussianInt), (y ∈ FootprintVertices (P.tile (owner m)) ∨ + y ∈ FootprintVertices (P.tile (owner w))) → (y ∈ huOdo.domain ∨ y ∈ + hu'Odo.domain))))) ) := by + classical + intro C T h P a0 a1 a2 a3 owner m w u u' au au' huOdo hu'Odo hdomu hdomu' tileM tileW y hy + rcases hy with hy | hy + · have hy' : y ∈ FootprintVertices (TileTranslation T u) := by + simpa [tileM] using hy + exact Or.inl ((Set.ext_iff.mp hdomu y).mpr hy') + · have hy' : y ∈ FootprintVertices (TileTranslation T u') := by + simpa [tileW] using hy + exact Or.inr ((Set.ext_iff.mp hdomu' y).mpr hy') + +private theorem hxM : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (x : GaussianInt), ∀ (P + : PeriodicTileComplex ↥(TilingLattice C)), ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : + ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), + let sector : Fin 4 → GaussianInt := + ![x, x - 1, x - 1 - ⟨0, 1⟩, x - ⟨0, 1⟩] + let u : GaussianInt := owner m + ∀ (au : GaussianInt), + let huOdo : PartialOdometer := PartialOdometerAffineTranslate h u au 0 + ((huOdo.domain : Set GaussianInt) = FootprintVertices (TileTranslation T u)) → ((P.tile + (owner m) = TileTranslation T u) → ((∀ (i : Fin 4), ∀ (y : GaussianInt), (y = sector + i ∨ y = sector i + 1 ∨ y = sector i + ⟨0, 1⟩ ∨ y = sector i + 1 + ⟨0, 1⟩) → (y ∈ + FootprintVertices (P.tile (owner i)))) → ((∀ i : Fin 4, x = sector i ∨ x = sector i + + 1 ∨ x = sector i + ⟨0, 1⟩ ∨ x = sector i + 1 + ⟨0, 1⟩) → (x ∈ huOdo.domain)))) ) := by + classical + intro C T h x P a0 a1 a2 a3 owner m sector u au huOdo hdomu tileM cellVertex sectorCornerX + have hxv := cellVertex m x (sectorCornerX m) + have hxv' : x ∈ FootprintVertices (TileTranslation T u) := by + simpa [tileM] using hxv + exact (Set.ext_iff.mp hdomu x).mpr hxv' + +private theorem hxW : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (x : GaussianInt), ∀ (P + : PeriodicTileComplex ↥(TilingLattice C)), ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : + ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (w : Fin (4 : ℕ)), + let sector : Fin 4 → GaussianInt := + ![x, x - 1, x - 1 - ⟨0, 1⟩, x - ⟨0, 1⟩] + let u' : GaussianInt := owner w + ∀ (au' : GaussianInt), + let hu'Odo : PartialOdometer := PartialOdometerAffineTranslate h u' au' 0 + ((hu'Odo.domain : Set GaussianInt) = FootprintVertices (TileTranslation T u')) → ((P.tile + (owner w) = TileTranslation T u') → ((∀ (i : Fin 4), ∀ (y : GaussianInt), (y = sector + i ∨ y = sector i + 1 ∨ y = sector i + ⟨0, 1⟩ ∨ y = sector i + 1 + ⟨0, 1⟩) → (y ∈ + FootprintVertices (P.tile (owner i)))) → ((∀ i : Fin 4, x = sector i ∨ x = sector i + + 1 ∨ x = sector i + ⟨0, 1⟩ ∨ x = sector i + 1 + ⟨0, 1⟩) → (x ∈ hu'Odo.domain)))) ) := by + classical + intro C T h x P a0 a1 a2 a3 owner w sector u' au' hu'Odo hdomu' tileW cellVertex sectorCornerX + have hxv := cellVertex w x (sectorCornerX w) + have hxv' : x ∈ FootprintVertices (TileTranslation T u') := by + simpa [tileW] using hxv + exact (Set.ext_iff.mp hdomu' x).mpr hxv' + +private theorem hstar : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (x : GaussianInt), ∀ (v + : GaussianInt), ∀ (hv : v ∈ TilingLattice C), (x ∈ BoundaryFootprintVertices + (TileTranslation T v)) → (∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + let iv : TilingLattice C := ⟨v, hv⟩ + (x ∈ BoundaryFootprintVertices (P.tile iv)) → ((∃ y ∈ (P.tile iv).cells, y = x ∨ y = x - + 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → ((∃ y, y ∉ (P.tile iv).cells ∧ (y = x ∨ y + = x - 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩)) → (∀ (a0 : ↥(TilingLattice C)), (x ∈ + (P.tile a0).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x + ∈ (P.tile a).cells) y → y = a0) → (∀ (a1 : ↥(TilingLattice C)), (x - (1 : + LatticeCell) ∈ (P.tile a1).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : + ↥(TilingLattice C)) => x - (1 : LatticeCell) ∈ (P.tile a).cells) y → y = a1) → (∀ (a2 + : ↥(TilingLattice C)), (x - (1 : LatticeCell) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ + (P.tile a2).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x + - (1 : LatticeCell) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = + a2) → (∀ (a3 : ↥(TilingLattice C)), (x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile + a3).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (⟨(0 + : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = a3) → ( + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), + let next : Fin 4 → Fin 4 := ![1, 2, 3, 0] + ∀ (e : Fin (4 : ℕ)), + let sector : Fin 4 → GaussianInt := + ![x, x - 1, x - 1 - ⟨0, 1⟩, x - ⟨0, 1⟩] + let edge : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ i, sector i ∈ (P.tile (owner i)).cells) → ((∀ (i : Fin 4), ∀ (j : Fin 4), (owner i ≠ + owner j) → (sector j ∉ (P.tile (owner i)).cells)) → ((∀ (i : Fin 4), (owner i ≠ owner + (next i)) → (edge i ∈ BoundaryFootprintEdges (P.tile (owner i)) ∧ edge i ∈ + BoundaryFootprintEdges (P.tile (owner (next i))))) → ((edge e ∈ + BoundaryFootprintEdges (P.tile (owner e))) → ((edge e ∈ BoundaryFootprintEdges + (P.tile (owner (next e)))) → ( + let u : GaussianInt := owner m + let u' : GaussianInt := owner w + ∀ (au : GaussianInt), ∀ (au' : GaussianInt), + let huOdo : PartialOdometer := PartialOdometerAffineTranslate h u au 0 + let hu'Odo : PartialOdometer := PartialOdometerAffineTranslate h u' au' 0 + (∀ (i : Fin 4), ∀ (y : GaussianInt), (y = sector i ∨ y = sector i + 1 ∨ y = sector i + + ⟨0, 1⟩ ∨ y = sector i + 1 + ⟨0, 1⟩) → (y ∈ FootprintVertices (P.tile (owner i)))) → + ((∀ i : Fin 4, x = sector i ∨ x = sector i + 1 ∨ x = sector i + ⟨0, 1⟩ ∨ x = sector i + + 1 + ⟨0, 1⟩) → ((∀ (i : Fin 4), ∀ (j : Fin 4), (i ≠ j) → (owner i = owner m ∨ owner + i = owner w ∨ owner j = owner m ∨ owner j = owner w)) → ((∀ (y : GaussianInt), (y ∈ + FootprintVertices (P.tile (owner m)) ∨ y ∈ FootprintVertices (P.tile (owner w))) → (y + ∈ huOdo.domain ∨ y ∈ hu'Odo.domain)) → ((x ∈ huOdo.domain) → ((x ∈ hu'Odo.domain) → + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ + huOdo.domain ∨ y ∈ hu'Odo.domain))))))))))))))))))))))) ) := by + classical + intro C T h x v hv hx P iv hxi hcorner hcornerOutside a0 ha0 hu0 a1 ha1 hu1 a2 ha2 hu2 a3 ha3 + hu3 owner m w next e sector edge hsector hsectorNot hedgeBoundary edge_mem_e edge_mem_next + u u' au au' huOdo hu'Odo cellVertex sectorCornerX pairCovered toDomains hxM hxW y hy + rcases hy with rfl | rfl | rfl | rfl | rfl + · exact Or.inl hxM + · have hpair : x + 1 ∈ FootprintVertices (P.tile (owner m)) ∨ + x + 1 ∈ FootprintVertices (P.tile (owner w)) := by + rcases pairCovered 0 3 (by decide) with h0 | h0 | h3 | h3 + · exact Or.inl (by simpa [h0] using + (cellVertex 0 (x + 1) (Or.inr (Or.inl (by simp [sector]))))) + · exact Or.inr (by simpa [h0] using + (cellVertex 0 (x + 1) (Or.inr (Or.inl (by simp [sector]))))) + · exact Or.inl (by simpa [h3] using + (cellVertex 3 (x + 1) (Or.inr (Or.inr (Or.inr + (by simp [sector]; abel)))))) + · exact Or.inr (by simpa [h3] using + (cellVertex 3 (x + 1) (Or.inr (Or.inr (Or.inr + (by simp [sector]; abel)))))) + exact toDomains (x + 1) hpair + · have hpair : x - 1 ∈ FootprintVertices (P.tile (owner m)) ∨ + x - 1 ∈ FootprintVertices (P.tile (owner w)) := by + rcases pairCovered 1 2 (by decide) with h1 | h1 | h2 | h2 + · exact Or.inl (by simpa [h1] using + (cellVertex 1 (x - 1) (Or.inl (by simp [sector]))) ) + · exact Or.inr (by simpa [h1] using + (cellVertex 1 (x - 1) (Or.inl (by simp [sector]))) ) + · exact Or.inl (by simpa [h2] using + (cellVertex 2 (x - 1) (Or.inr (Or.inr (Or.inl + (by simp [sector] ))))) ) + · exact Or.inr (by simpa [h2] using + (cellVertex 2 (x - 1) (Or.inr (Or.inr (Or.inl + (by simp [sector] ))))) ) + exact toDomains (x - 1) hpair + · have hpair : x + ⟨0, 1⟩ ∈ FootprintVertices (P.tile (owner m)) ∨ + x + ⟨0, 1⟩ ∈ FootprintVertices (P.tile (owner w)) := by + rcases pairCovered 0 1 (by decide) with h0 | h0 | h1 | h1 + · exact Or.inl (by simpa [h0] using + (cellVertex 0 (x + ⟨0, 1⟩) + (Or.inr (Or.inr (Or.inl (by simp [sector]))))) ) + · exact Or.inr (by simpa [h0] using + (cellVertex 0 (x + ⟨0, 1⟩) + (Or.inr (Or.inr (Or.inl (by simp [sector]))))) ) + · exact Or.inl (by simpa [h1] using + (cellVertex 1 (x + ⟨0, 1⟩) + (Or.inr (Or.inr (Or.inr (by simp [sector] ))))) ) + · exact Or.inr (by simpa [h1] using + (cellVertex 1 (x + ⟨0, 1⟩) + (Or.inr (Or.inr (Or.inr (by simp [sector] ))))) ) + exact toDomains (x + ⟨0, 1⟩) hpair + · have hpair : x - ⟨0, 1⟩ ∈ FootprintVertices (P.tile (owner m)) ∨ + x - ⟨0, 1⟩ ∈ FootprintVertices (P.tile (owner w)) := by + rcases pairCovered 2 3 (by decide) with h2 | h2 | h3 | h3 + · exact Or.inl (by simpa [h2] using + (cellVertex 2 (x - ⟨0, 1⟩) + (Or.inr (Or.inl (by simp [sector]; abel)))) ) + · exact Or.inr (by simpa [h2] using + (cellVertex 2 (x - ⟨0, 1⟩) + (Or.inr (Or.inl (by simp [sector]; abel)))) ) + · exact Or.inl (by simpa [h3] using + (cellVertex 3 (x - ⟨0, 1⟩) (Or.inl (by simp [sector]))) ) + · exact Or.inr (by simpa [h3] using + (cellVertex 3 (x - ⟨0, 1⟩) (Or.inl (by simp [sector]))) ) + exact toDomains (x - ⟨0, 1⟩) hpair + +private theorem hadjOdo : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (q : Fin (4 : ℕ) → + CircleCoordinates), (q (0 : Fin (4 : ℕ)) = C.1.1) → ((ProperBandQuadruple q) → (∀ (a0 + : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ + (a3 : ↥(TilingLattice C)), + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), ∀ (j : Fin (3 : ℕ)), ((↑(owner w) : + GaussianInt) - (↑(owner m) : GaussianInt) = BandVectors.1 (q j.succ) (q (0 : Fin (4 : + ℕ))) ∨ (↑(owner w) : GaussianInt) - (↑(owner m) : GaussianInt) = -BandVectors.1 (q + j.succ) (q (0 : Fin (4 : ℕ)))) → (∀ (p : ℝ × ℝ), + let u : GaussianInt := owner m + let u' : GaussianInt := owner w + ∀ (au : GaussianInt), ∀ (au' : GaussianInt), + let huOdo : PartialOdometer := PartialOdometerAffineTranslate h u au 0 + let hu'Odo : PartialOdometer := PartialOdometerAffineTranslate h u' au' 0 + (TileOdometer C.1.1 (TileTranslation T u) huOdo) → ((TileOdometer C.1.1 (TileTranslation + T u') hu'Odo) → ((TileCentroid (TileTranslation T u') - TileCentroid (TileTranslation + T u) = GaussianRealPoint (u' - u)) → (((u' - u = BandVectors.1 (q j.succ) (q 0)) → + (au' - au = BandVectors.2 (q j.succ) (q 0))) → (((u' - u = -BandVectors.1 (q j.succ) + (q 0)) → (au' - au = -BandVectors.2 (q j.succ) (q 0))) → ((PartialOdometerSlope huOdo + = some (p.1 + (au.re : ℝ), p.2 + (au.im : ℝ))) → ((PartialOdometerSlope hu'Odo = some + (p.1 + (au'.re : ℝ), p.2 + (au'.im : ℝ))) → (LeftLatticeAdjacent C (TileTranslation T + u) (TileTranslation T u') huOdo hu'Odo)))))))))) ) := by + classical + intro C T h q hqC hproper a0 a1 a2 a3 owner m w j hsign p u u' au au' huOdo hu'Odo htransOdo + htrans'Odo hcentDiff aDiffPlus aDiffMinus hslopeU hslopeU' + refine ⟨htransOdo, htrans'Odo, ?_⟩ + refine ⟨(p.1 + (au.re : ℝ), p.2 + (au.im : ℝ)), + (p.1 + (au'.re : ℝ), p.2 + (au'.im : ℝ)), hslopeU, hslopeU', ?_⟩ + rcases hsign with hplus | hminus + · right + refine ⟨q, j, true, hproper, hqC, ?_, ?_, ?_⟩ + · have hstep' : u' - u = BandVectors.1 (q j.succ) (q 0) := by + simpa [u, u'] using hplus + rw [hstep'] at hcentDiff + simpa [GaussianRealPoint] using hcentDiff + · have ha := aDiffPlus (by simpa [u, u'] using hplus) + have hre : au'.re - au.re = + (BandVectors.2 (q j.succ) (q 0)).re := by + have hh := congrArg Zsqrtd.re ha + simpa using hh + dsimp + have hr : (p.1 + (au'.re : ℝ)) - (p.1 + (au.re : ℝ)) = + ((BandVectors.2 (q j.succ) (q 0)).re : ℝ) := by + have hreal : (au'.re : ℝ) - (au.re : ℝ) = + ((BandVectors.2 (q j.succ) (q 0)).re : ℝ) := by + exact_mod_cast hre + linarith + simpa using hr + · have ha := aDiffPlus (by simpa [u, u'] using hplus) + have him : au'.im - au.im = + (BandVectors.2 (q j.succ) (q 0)).im := by + have hh := congrArg Zsqrtd.im ha + simpa using hh + dsimp + have hr : (p.2 + (au'.im : ℝ)) - (p.2 + (au.im : ℝ)) = + ((BandVectors.2 (q j.succ) (q 0)).im : ℝ) := by + have hreal : (au'.im : ℝ) - (au.im : ℝ) = + ((BandVectors.2 (q j.succ) (q 0)).im : ℝ) := by + exact_mod_cast him + linarith + simpa using hr + · right + refine ⟨q, j, false, hproper, hqC, ?_, ?_, ?_⟩ + · have hstep' : u' - u = -BandVectors.1 (q j.succ) (q 0) := by + simpa [u, u'] using hminus + rw [hstep'] at hcentDiff + simpa [GaussianRealPoint, smul_eq_mul] using hcentDiff + · have ha := aDiffMinus (by simpa [u, u'] using hminus) + have hre : au'.re - au.re = + -(BandVectors.2 (q j.succ) (q 0)).re := by + have hh := congrArg Zsqrtd.re ha + simpa using hh + dsimp + have hr : (p.1 + (au'.re : ℝ)) - (p.1 + (au.re : ℝ)) = + -((BandVectors.2 (q j.succ) (q 0)).re : ℝ) := by + have hreal : (au'.re : ℝ) - (au.re : ℝ) = + -((BandVectors.2 (q j.succ) (q 0)).re : ℝ) := by + exact_mod_cast hre + linarith + simpa using hr + · have ha := aDiffMinus (by simpa [u, u'] using hminus) + have him : au'.im - au.im = + -(BandVectors.2 (q j.succ) (q 0)).im := by + have hh := congrArg Zsqrtd.im ha + simpa using hh + dsimp + have hr : (p.2 + (au'.im : ℝ)) - (p.2 + (au.im : ℝ)) = + -((BandVectors.2 (q j.succ) (q 0)).im : ℝ) := by + have hreal : (au'.im : ℝ) - (au.im : ℝ) = + -((BandVectors.2 (q j.succ) (q 0)).im : ℝ) := by + exact_mod_cast him + linarith + simpa using hr + +private theorem hnoCheckerboard0 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (x : GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + ∀ (a0 : ↥(TilingLattice C)), (x ∈ (P.tile a0).cells) → (∀ (a1 : ↥(TilingLattice C)), + (∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (1 : LatticeCell) ∈ + (P.tile a).cells) y → y = a1) → (∀ (a2 : ↥(TilingLattice C)), (x - (1 : LatticeCell) + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a2).cells) → (∀ (a3 : ↥(TilingLattice + C)), (∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = a3) → (a0 = a2 → a0 = a1 ∨ a0 = + a3)))) ) := by + classical + intro C x P a0 ha0 a1 hu1 a2 ha2 a3 hu3 h02 + by_cases h01 : a0 = a1 + · exact Or.inl h01 + by_cases h03 : a0 = a3 + · exact Or.inr h03 + have hx1 : x - 1 ∉ (P.tile a0).cells := by + intro hx1 + exact h01 (hu1 a0 hx1) + have hx3 : x - ⟨0, 1⟩ ∉ (P.tile a0).cells := by + intro hx3 + exact h03 (hu3 a0 hx3) + have hnc := (LatticeTileGridStructure (P.tile a0) + (P.tiles_are_disks a0)).2.1 + exact (hnc x (Or.inl ⟨ha0, by simpa [h02] using ha2, hx1, hx3⟩)).elim + +private theorem hnoCheckerboard1 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (x : GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + ∀ (a0 : ↥(TilingLattice C)), (∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice + C)) => x ∈ (P.tile a).cells) y → y = a0) → (∀ (a1 : ↥(TilingLattice C)), (x - (1 : + LatticeCell) ∈ (P.tile a1).cells) → (∀ (a2 : ↥(TilingLattice C)), (∀ (y : + ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (1 : LatticeCell) - (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = a2) → (∀ (a3 : + ↥(TilingLattice C)), (x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a3).cells) → + (a1 = a3 → a1 = a0 ∨ a1 = a2)))) ) := by + classical + intro C x P a0 hu0 a1 ha1 a2 hu2 a3 ha3 h13 + by_cases h10 : a1 = a0 + · exact Or.inl h10 + by_cases h12 : a1 = a2 + · exact Or.inr h12 + have hx0 : x ∉ (P.tile a1).cells := by + intro hx0 + exact h10 (hu0 a1 hx0) + have hx2 : x - 1 - ⟨0, 1⟩ ∉ (P.tile a1).cells := by + intro hx2 + exact h12 (hu2 a1 hx2) + have hnc := (LatticeTileGridStructure (P.tile a1) + (P.tiles_are_disks a1)).2.1 + exact (hnc x (Or.inr ⟨ha1, by simpa [h13] using ha3, hx0, hx2⟩)).elim + +private theorem hnoCheckerboard2 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (x : GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + ∀ (a0 : ↥(TilingLattice C)), (x ∈ (P.tile a0).cells) → (∀ (a1 : ↥(TilingLattice C)), + (∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (1 : LatticeCell) ∈ + (P.tile a).cells) y → y = a1) → (∀ (a2 : ↥(TilingLattice C)), (x - (1 : LatticeCell) + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a2).cells) → (∀ (a3 : ↥(TilingLattice + C)), (∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = a3) → (a2 = a0 → a2 = a1 ∨ a2 = + a3)))) ) := by + classical + intro C x P a0 ha0 a1 hu1 a2 ha2 a3 hu3 h20 + by_cases h21 : a2 = a1 + · exact Or.inl h21 + by_cases h23 : a2 = a3 + · exact Or.inr h23 + have hx1 : x - 1 ∉ (P.tile a2).cells := by + intro hx1 + exact h21 (hu1 a2 hx1) + have hx3 : x - ⟨0, 1⟩ ∉ (P.tile a2).cells := by + intro hx3 + exact h23 (hu3 a2 hx3) + have hnc := (LatticeTileGridStructure (P.tile a2) + (P.tiles_are_disks a2)).2.1 + exact (hnc x (Or.inl ⟨by simpa [h20] using ha0, ha2, hx1, hx3⟩)).elim + +private theorem hnoCheckerboard3 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (x : GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + ∀ (a0 : ↥(TilingLattice C)), (∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice + C)) => x ∈ (P.tile a).cells) y → y = a0) → (∀ (a1 : ↥(TilingLattice C)), (x - (1 : + LatticeCell) ∈ (P.tile a1).cells) → (∀ (a2 : ↥(TilingLattice C)), (∀ (y : + ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (1 : LatticeCell) - (⟨(0 : + ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = a2) → (∀ (a3 : + ↥(TilingLattice C)), (x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a3).cells) → + (a3 = a1 → a3 = a0 ∨ a3 = a2)))) ) := by + classical + intro C x P a0 hu0 a1 ha1 a2 hu2 a3 ha3 h31 + by_cases h30 : a3 = a0 + · exact Or.inl h30 + by_cases h32 : a3 = a2 + · exact Or.inr h32 + have hx0 : x ∉ (P.tile a3).cells := by + intro hx0 + exact h30 (hu0 a3 hx0) + have hx2 : x - 1 - ⟨0, 1⟩ ∉ (P.tile a3).cells := by + intro hx2 + exact h32 (hu2 a3 hx2) + have hnc := (LatticeTileGridStructure (P.tile a3) + (P.tiles_are_disks a3)).2.1 + exact (hnc x (Or.inr ⟨by simpa [h31] using ha1, ha3, hx0, hx2⟩)).elim + +end WebLaplacianGeometry + +theorem PeriodicBoundaryWebLaplacian (C : BandCircle) + (T : ProtoTile) (h : PartialOdometer) (g : IntegerLatticeFunction) + (hT : BandPrototile C.1.1 T) (hodo : TileOdometer C.1.1 T h) + (hext : GlobalOdometerExtends g h) + (hcocycle : ∀ v, v ∈ TilingLattice C → ∃ a : GaussianInt, + Matrix.mulVec (CircleMatrix C) ![(v.re : ℝ), (v.im : ℝ)] = + ![(a.re : ℝ), (a.im : ℝ)] ∧ + ∀ x, g (x + v) = g x + x.re * a.re + x.im * a.im + g v) : + ∀ x, (∃ v, v ∈ TilingLattice C ∧ + x ∈ BoundaryFootprintVertices (TileTranslation T v)) → + FourNeighborLaplacian g x = 1 := by +-- BODY + classical + intro x + rintro ⟨v, hv, hx⟩ + by_cases hc : C.1.1.1 = 1 + · have hunit := WebLaplacianGeometry.hunit C g hcocycle hc + exact hunit x + · obtain ⟨q, hsemi, hqC, hless, _⟩ := Or.resolve_left (BandGenealogy C) hc + have hproper := WebLaplacianGeometry.hproper C q hsemi hqC hless + have hT' : BandPrototile (q 0) T := by simpa [hqC] using hT + obtain ⟨P, hPlat, hPtile, hPadj, hPposition, hPvertices, + hPedges, hPfaces, hPchart⟩ := + BandRegularTranslatePeriodicComplex C q hproper hqC T hT' + obtain ⟨chart⟩ := hPchart + let tileAt := fun mn : Int × Int => + TileTranslation T + ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (mn.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) + let iv : TilingLattice C := ⟨v, hv⟩ + have hPv : P.tile iv = TileTranslation T v := by simpa [iv] using hPtile iv + have hxi : x ∈ BoundaryFootprintVertices (P.tile iv) := by + simpa [hPv] using hx + have hcells := WebLaplacianGeometry.hcells C v hv P + have hcorner := WebLaplacianGeometry.hcorner C T x v hv hx P hxi hcells + have hcornerOutside := WebLaplacianGeometry.hcornerOutside C T x v hv hx P hxi hcells hcorner + obtain ⟨a0, ha0, hu0⟩ := PeriodicTileIndexedMultiplicityOne P x + obtain ⟨a1, ha1, hu1⟩ := PeriodicTileIndexedMultiplicityOne P (x - 1) + obtain ⟨a2, ha2, hu2⟩ := + PeriodicTileIndexedMultiplicityOne P (x - 1 - ⟨0, 1⟩) + obtain ⟨a3, ha3, hu3⟩ := PeriodicTileIndexedMultiplicityOne P (x - ⟨0, 1⟩) + have hvnotfour := WebLaplacianGeometry.hvnotfour C T x v hv hx P hxi hcorner hcornerOutside + a0 ha0 hu0 a1 ha1 hu1 a2 ha2 hu2 a3 ha3 hu3 + have hfour := AffineTriangularNoFourfoldCellOwners P tileAt chart x + a0 a1 a2 a3 ha0 ha1 ha2 ha3 + have secondOwnerCoversThree {I : Type} (f : Fin 4 → I) + (m : Fin 4) (hother : ∃ w, f w ≠ f m) + (hnotinj : ¬ Function.Injective f) := WebLaplacianGeometry.secondOwnerCoversThree + (WebLaplacianGeometry.atMostOneRemaining) (I := I) f m hother hnotinj + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + have hmexists := WebLaplacianGeometry.hmexists C v hv a0 a1 a2 a3 + (WebLaplacianGeometry.hvowner C T x v hv hx P hxi hcorner hcornerOutside a0 ha0 hu0 a1 + ha1 hu1 a2 ha2 hu2 a3 ha3 hu3) + obtain ⟨m, hm⟩ := hmexists + have hnotinj := WebLaplacianGeometry.hnotinj C a0 a1 a2 a3 hfour + have hother := WebLaplacianGeometry.hother C v hv a0 a1 a2 a3 m hm + (WebLaplacianGeometry.hnotall C v hv a0 a1 a2 a3 hvnotfour) + obtain ⟨w, hmw, hcover⟩ := secondOwnerCoversThree owner m hother hnotinj + let next : Fin 4 → Fin 4 := ![1, 2, 3, 0] + have colorCycle := WebLaplacianGeometry.colorCycle + let col : Fin 4 → Fin 3 := fun i => + if owner i = owner m then 0 else if owner i = owner w then 1 else 2 + have hmcol : col m = 0 := by simp [col] + have hwcol : col w = 1 := by simp [col, hmw] + have hcol2unique := WebLaplacianGeometry.hcol2unique C a0 a1 a2 a3 m w hmw hcover + obtain ⟨e, hecolor⟩ := colorCycle col ⟨m, hmcol⟩ ⟨w, hwcol⟩ hcol2unique + have hepair := WebLaplacianGeometry.hepair C a0 a1 a2 a3 m w e hecolor + let sector : Fin 4 → GaussianInt := + ![x, x - 1, x - 1 - ⟨0, 1⟩, x - ⟨0, 1⟩] + let edge : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + have hsector := WebLaplacianGeometry.hsector C x P a0 ha0 a1 ha1 a2 ha2 a3 ha3 + have hsectorNot := WebLaplacianGeometry.hsectorNot C x P a0 a1 a2 a3 hsector + have hedgeBoundary := WebLaplacianGeometry.hedgeBoundary C x P a0 ha0 a1 ha1 a2 ha2 a3 ha3 + hsectorNot + have boundaryEdge := WebLaplacianGeometry.boundaryEdge + have hneq : owner m ≠ owner w := hmw.symm + have hnewe := WebLaplacianGeometry.hnewe C a0 a1 a2 a3 m w hmw e hepair + obtain ⟨edge_mem_e, edge_mem_next⟩ := hedgeBoundary e hnewe + have hdisplacement := (hPadj (owner m) (owner w)).mp (WebLaplacianGeometry.hadj C P a0 a1 a2 + a3 m w hneq (WebLaplacianGeometry.hcommon C x P a0 a1 a2 a3 m w e hepair boundaryEdge + edge_mem_e edge_mem_next)) + obtain ⟨j, hsign⟩ := hdisplacement + have slope_for := WebLaplacianGeometry.slope_for C P a0 a1 a2 a3 m w + have hcurvature := WebLaplacianGeometry.hcurvature C hc P a0 a1 a2 a3 m w e hecolor + obtain ⟨p, hp⟩ := slope_for C.1.1 T h hodo hcurvature + let u : GaussianInt := owner m + let u' : GaussianInt := owner w + have hu_eq := WebLaplacianGeometry.hu_eq C v hv a0 a1 a2 a3 m hm + have hu_mem : u ∈ TilingLattice C := (owner m).property + have hu'_mem : u' ∈ TilingLattice C := (owner w).property + obtain ⟨au, hAu, hshiftu⟩ := hcocycle u hu_mem + obtain ⟨au', hAu', hshiftu'⟩ := hcocycle u' hu'_mem + let huOdo : PartialOdometer := PartialOdometerAffineTranslate h u au 0 + let hu'Odo : PartialOdometer := PartialOdometerAffineTranslate h u' au' 0 + have htransOdo : TileOdometer C.1.1 (TileTranslation T u) huOdo := + TileOdometerAffineTranslation C.1.1 T h u au 0 hodo + have htrans'Odo : TileOdometer C.1.1 (TileTranslation T u') hu'Odo := + TileOdometerAffineTranslation C.1.1 T h u' au' 0 hodo + have hdom : (h.domain : Set GaussianInt) = FootprintVertices T := + PositiveCurvatureTileOdometerDomain C.1.1 T h (by omega) hodo + have hdomu : (huOdo.domain : Set GaussianInt) = + FootprintVertices (TileTranslation T u) := + (PartialOdometerAffineTranslateFormulas h u au 0).2.2.2.2.1 T hdom + have hdomu' : (hu'Odo.domain : Set GaussianInt) = + FootprintVertices (TileTranslation T u') := + (PartialOdometerAffineTranslateFormulas h u' au' 0).2.2.2.2.1 T hdom + have translateExtends (t a : GaussianInt) + (hshift : ∀ y, g (y + t) = g y + y.re * a.re + y.im * a.im + g t) : + GlobalOdometerExtends g (PartialOdometerAffineTranslate h t a 0) := + WebLaplacianGeometry.translateExtends h g hext t a hshift + have hextu : GlobalOdometerExtends g huOdo := by + simpa [huOdo] using translateExtends u au hshiftu + have hextu' : GlobalOdometerExtends g hu'Odo := by + simpa [hu'Odo] using translateExtends u' au' hshiftu' + have hmatrixDiff := WebLaplacianGeometry.hmatrixDiff C a0 a1 a2 a3 m w au hAu au' hAu' + have hincoming := CircleMatrixIncomingVector C q hsemi hqC j + have hAdiff := WebLaplacianGeometry.hAdiff C q a0 a1 a2 a3 m w j hsign au au' hmatrixDiff + hincoming + have tileM : P.tile (owner m) = TileTranslation T u := by + simpa [u] using hPtile (owner m) + have tileW : P.tile (owner w) = TileTranslation T u' := by + simpa [u'] using hPtile (owner w) + have ownerNonempty (i : Fin 4) : (P.tile (owner i)).cells.Nonempty := + (LatticeTileGridStructure _ (P.tiles_are_disks (owner i))).1.1 + have cellVertex := WebLaplacianGeometry.cellVertex C x P a0 a1 a2 a3 hsector ownerNonempty + have sectorCornerX := WebLaplacianGeometry.sectorCornerX x + have hxM := WebLaplacianGeometry.hxM C T h x P a0 a1 a2 a3 m au hdomu tileM cellVertex + sectorCornerX + have hxW := WebLaplacianGeometry.hxW C T h x P a0 a1 a2 a3 w au' hdomu' tileW cellVertex + sectorCornerX + have hadjOdo := WebLaplacianGeometry.hadjOdo C T h q hqC hproper a0 a1 a2 a3 m w j hsign p au + au' htransOdo htrans'Odo (WebLaplacianGeometry.hcentDiff C T a0 a1 a2 a3 m w + (WebLaplacianGeometry.centroidShift T)) (WebLaplacianGeometry.aDiffPlus C q a0 a1 a2 a3 m + w j au au' hmatrixDiff hincoming) (WebLaplacianGeometry.aDiffMinus C q a0 a1 a2 a3 m w j + au au' hmatrixDiff hincoming) (WebLaplacianGeometry.hslopeU C h a0 a1 a2 a3 m p hp au) + (WebLaplacianGeometry.hslopeU' C h a0 a1 a2 a3 w p hp au') + have hnoCheckerboard0 := WebLaplacianGeometry.hnoCheckerboard0 C x P a0 ha0 a1 hu1 a2 ha2 a3 hu3 + have hnoCheckerboard1 := WebLaplacianGeometry.hnoCheckerboard1 C x P a0 hu0 a1 ha1 a2 hu2 a3 ha3 + have hnoCheckerboard2 := WebLaplacianGeometry.hnoCheckerboard2 C x P a0 ha0 a1 hu1 a2 ha2 a3 hu3 + have hnoCheckerboard3 := WebLaplacianGeometry.hnoCheckerboard3 C x P a0 hu0 a1 ha1 a2 hu2 a3 ha3 + have hcompat : OdometerCompatibility huOdo hu'Odo := + (LeftAdjacentOdometerCompatibility C (TileTranslation T u) + (TileTranslation T u') huOdo hu'Odo hadjOdo).1 + have hweb := (OdometerWeb).1 C (TileTranslation T u) + (TileTranslation T u') huOdo hu'Odo g x hcompat hextu hextu' hxM hxW + (WebLaplacianGeometry.hstar C T h x v hv hx P hxi hcorner hcornerOutside a0 ha0 hu0 a1 + ha1 hu1 a2 ha2 hu2 a3 ha3 hu3 m w e hsector hsectorNot hedgeBoundary edge_mem_e + edge_mem_next au au' cellVertex sectorCornerX (WebLaplacianGeometry.pairCovered C a0 a1 + a2 a3 m w hcover) (WebLaplacianGeometry.toDomains C T h P a0 a1 a2 a3 m w au au' hdomu + hdomu' tileM tileW) hxM hxW) + exact hweb.1 hadjOdo + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean b/LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean new file mode 100644 index 0000000000..03414b1b5e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean @@ -0,0 +1,685 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandTileAcyclicIndegree +public import LeanPool.ApollonianSuperharmonic.FiniteAcyclicOrientationObstruction +public import LeanPool.ApollonianSuperharmonic.PeriodicBoundaryWebConnected +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: PeriodicOdometerIndicatorRigidity] + +/-! +# PeriodicOdometerIndicatorRigidity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PeriodicIndicatorGeometry + +private theorem finiteFoot : + (by + classical + exact + ∀ (U : ProtoTile), (FootprintVertices U).Finite ) := by + classical + intro U + by_cases hu : U.cells.Nonempty + · let K : Finset GaussianInt := U.cells.biUnion (fun x => + {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) + have hk : (K : Set GaussianInt) = FootprintVertices U := by + ext z + simp [K, FootprintVertices, hu] + rw [← hk] + exact K.finite_toSet + · simp [FootprintVertices, hu] + +private theorem hmeet : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (X : Set GaussianInt), (X.Infinite) → + ((FourNeighborConnected X) → ((∀ (X : Set GaussianInt), FourNeighborConnected X → + Disjoint X {x : GaussianInt | ∃ v ∈ TilingLattice C, x ∈ BoundaryFootprintVertices + (TileTranslation T v)} → ∃ v ∈ TilingLattice C, X ⊆ FootprintVertices + (TileTranslation T v) \ {x : GaussianInt | ∃ v ∈ TilingLattice C, x ∈ + BoundaryFootprintVertices (TileTranslation T v)}) → ((∀ (U : ProtoTile), + (FootprintVertices U).Finite) → ((X ∩ {x | ∃ v, v ∈ TilingLattice C ∧ x ∈ + BoundaryFootprintVertices (TileTranslation T v)}).Nonempty)))) ) := by + classical + intro C T X hXin hXconn hWcontain finiteFoot + by_contra hn + have hd : Disjoint X {x | ∃ v, v ∈ TilingLattice C ∧ + x ∈ BoundaryFootprintVertices (TileTranslation T v)} := by + rw [Set.disjoint_left] + intro x hx hwx + exact hn ⟨x, hx, hwx⟩ + obtain ⟨v, hv, hs⟩ := hWcontain X hXconn hd + exact hXin.not_finite ((finiteFoot _).subset (fun z hz => (hs hz).1)) + +private theorem noCross : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (g : IntegerLatticeFunction), (∀ x, (∃ v, v ∈ + TilingLattice C ∧ x ∈ BoundaryFootprintVertices (TileTranslation T v)) → + FourNeighborLaplacian g x = 1) → (∀ (X : Set GaussianInt), (∀ (x : GaussianInt), + FourNeighborLaplacian (fun (y : GaussianInt) => g y + X.indicator (fun (_ : + GaussianInt) => (1 : ℤ)) y) x ≤ (1 : ℤ)) → (∀ a ∈ {x | ∃ v, v ∈ TilingLattice C ∧ x ∈ + BoundaryFootprintVertices (TileTranslation T v)}, ∀ b, FourNeighborAdjacent a b → b ∈ + X → a ∈ X))) := by + classical + intro C T g hweb X hle a ha b hab hb + rcases hab with rfl | rfl | rfl | rfl + all_goals + by_contra hna + obtain ⟨v, hv, hav⟩ := ha + have hga := hweb a ⟨v, hv, hav⟩ + have hh := hle a + simp only [FourNeighborLaplacian, Set.indicator_apply] at hh hga ⊢ + simp_all only [ite_true, ite_false] + omega + +private theorem hWsub : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (X : Set GaussianInt), (FourNeighborConnected {x + : GaussianInt | ∃ v ∈ TilingLattice C, x ∈ BoundaryFootprintVertices (TileTranslation + T v)}) → (((X ∩ {x | ∃ v, v ∈ TilingLattice C ∧ x ∈ BoundaryFootprintVertices + (TileTranslation T v)}).Nonempty) → ((∀ a ∈ {x | ∃ v, v ∈ TilingLattice C ∧ x ∈ + BoundaryFootprintVertices (TileTranslation T v)}, ∀ b, FourNeighborAdjacent a b → b ∈ + X → a ∈ X) → ({x | ∃ v, v ∈ TilingLattice C ∧ x ∈ BoundaryFootprintVertices + (TileTranslation T v)} ⊆ X))) ) := by + classical + intro C T X hWconn hmeet noCross w hw + obtain ⟨x0, hx0, hx0W⟩ := hmeet + obtain ⟨p, hp, hpend, hpall, hadj⟩ := hWconn.2 x0 hx0W w hw + have symmetry : ∀ a b, FourNeighborAdjacent a b → + FourNeighborAdjacent b a := by + intro a b hab + rcases hab with rfl | rfl | rfl | rfl <;> + simp [FourNeighborAdjacent, add_assoc, add_comm, add_left_comm] + have walk : ∀ (q : List GaussianInt), ∀ a, q.head? = some a → a ∈ X → + (∀ z ∈ q, z ∈ {x | ∃ v, v ∈ TilingLattice C ∧ + x ∈ BoundaryFootprintVertices (TileTranslation T v)}) → + (∀ a b l₁ l₂, q = l₁ ++ a :: b :: l₂ → + FourNeighborAdjacent a b) → ∀ z ∈ q, z ∈ X := by + intro q + induction q with + | nil => intro a hq; simp at hq + | cons z q ih => + intro a hq haX hwq hstep + simp only [List.head?_cons, Option.some.injEq] at hq + subst a + intro b hb + simp only [List.mem_cons] at hb + cases q with + | nil => + rcases hb with rfl | hb + · exact haX + · simp at hb + | cons y q => + have hzy : FourNeighborAdjacent z y := by + apply hstep z y [] q + simp + have hzW := hwq z (by simp) + have hyW := hwq y (by simp) + have hyX : y ∈ X := by + exact noCross y hyW z (symmetry z y hzy) haX + rcases hb with rfl | hb + · exact haX + · have htail := ih y (by rfl) hyX (by + intro t ht + exact hwq t (by simp [ht])) (by + intro c d l₁ l₂ hq + apply hstep c d (z :: l₁) l₂ + simp [hq]) + exact htail b hb + have hall := walk p x0 hp hx0 hpall hadj + have hne : p ≠ [] := by intro he; simp [he] at hp + have hwmem : w ∈ p := by + rw [← List.getLast_of_getLast?_eq_some hpend] + exact List.getLast_mem hne + exact hall w hwmem + +private theorem Ynonempty : + (by + classical + exact + ∀ (X : Set GaussianInt), ∀ (x : GaussianInt), (x ∉ X) → ( + let reachable (a b : GaussianInt) : Prop := ∃ p : List GaussianInt, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent + let Y : Set GaussianInt := {y | reachable x y} + Y.Nonempty) ) := by + classical + intro X x hxX reachable Y + refine ⟨x, ?_⟩ + refine ⟨[x], rfl, rfl, ?_, List.isChain_singleton _⟩ + intro z hz + simp only [List.mem_singleton] at hz + simpa [hz] using hxX + +private theorem xY : + (by + classical + exact + ∀ (X : Set GaussianInt), ∀ (x : GaussianInt), (x ∉ X) → ( + let reachable (a b : GaussianInt) : Prop := ∃ p : List GaussianInt, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent + let Y : Set GaussianInt := {y | reachable x y} + x ∈ Y) ) := by + classical + intro X x hxX reachable Y + refine ⟨[x], ?_, ?_, ?_, ?_⟩ + · rfl + · rfl + · intro z hz + have hz' : z = x := by simpa using hz + simpa [hz'] using hxX + · exact List.isChain_singleton _ + +private theorem Yout : + (by + classical + exact + ∀ (X : Set GaussianInt), ∀ (x : GaussianInt), + let reachable (a b : GaussianInt) : Prop := ∃ p : List GaussianInt, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent + let Y : Set GaussianInt := {y | reachable x y} + Y ⊆ Xᶜ ) := by + classical + intro X x reachable Y y hy + rcases hy with ⟨p, hp, hlast, hpout, hchain⟩ + intro hyX + have hmem : y ∈ p := by + rw [← List.getLast_of_getLast?_eq_some hlast] + exact List.getLast_mem (by intro he; simp [he] at hp) + exact hpout y hmem hyX + +private theorem Yconn : + (by + classical + exact + ∀ (X : Set GaussianInt), ∀ (x : GaussianInt), + let reachable (a b : GaussianInt) : Prop := ∃ p : List GaussianInt, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent + let Y : Set GaussianInt := {y | reachable x y} + (x ∈ Y) → (FourNeighborConnected Y) ) := by + classical + intro X x reachable Y xY + refine ⟨⟨x, xY⟩, ?_⟩ + intro y hy z hz + rcases hy with ⟨p, hp, hpy, hpout, hpc⟩ + rcases hz with ⟨q, hq, hqz, hqout, hqc⟩ + have hsym : ∀ a b, FourNeighborAdjacent a b → + FourNeighborAdjacent b a := by + intro a b hab + rcases hab with rfl | rfl | rfl | rfl <;> + simp [FourNeighborAdjacent, add_assoc, add_comm, add_left_comm] + have prefixReach : ∀ (r : List GaussianInt), r.head? = some x → + (∀ t ∈ r, t ∉ X) → r.IsChain FourNeighborAdjacent → + ∀ t ∈ r, t ∈ Y := by + intro r hr hout hchain t ht + obtain ⟨l₁, l₂, heq⟩ := List.mem_iff_append.mp ht + subst r + refine ⟨l₁ ++ [t], ?_, ?_, ?_, ?_⟩ + · simpa using hr + · simp + · intro u hu + simp only [List.mem_append, List.mem_cons] at hu + rcases hu with hu | rfl | hu + · exact hout u (by simp [hu]) + · exact hout u (by simp) + · simp at hu + · exact (List.isChain_split.mp hchain).1 + have hpc' : p.IsChain (fun a b => FourNeighborAdjacent b a) := + hpc.imp (fun a b hab => hsym a b hab) + have hrev : p.reverse.IsChain FourNeighborAdjacent := + List.isChain_reverse.mpr hpc' + have hqtail : q.tail.IsChain FourNeighborAdjacent := hqc.tail + have hpn : p ≠ [] := by intro he; simp [he] at hp + have hqn : q ≠ [] := by intro he; simp [he] at hq + have hjoin : (p.reverse ++ q.tail).IsChain FourNeighborAdjacent := by + apply hrev.append hqtail + intro a ha b hb + have ha' : a = x := by + simpa [hp] using ha.symm + subst a + cases q with + | nil => simp at hq + | cons u s => + simp only [List.head?_cons, Option.some.injEq] at hq + subst u + cases s with + | nil => simp at hb + | cons u s => + have hfirst : FourNeighborAdjacent x u := + (List.isChain_cons_cons.mp hqc).1 + rcases (by simpa using hb : u = b) with rfl + exact hfirst + have hreach : ∀ a ∈ p.reverse ++ q.tail, a ∈ Y := by + intro a ha + simp only [List.mem_append] at ha + rcases ha with ha | ha + · apply prefixReach p hp hpout hpc a + simpa using ha + · apply prefixReach q hq hqout hqc a + exact List.mem_of_mem_tail (l := q) ha + refine ⟨p.reverse ++ q.tail, ?_, ?_, hreach, + List.isChain_iff_forall_rel_of_append_cons_cons.mp hjoin⟩ + · simp [List.head?_append, hpy] + · cases q with + | nil => simp at hq + | cons u s => + simp only [List.head?_cons, Option.some.injEq] at hq + subst u + cases s with + | nil => + have hz : x = z := by simpa using hqz + simpa [hz] using hp + | cons u s => simpa [List.getLast?_append] using hqz + +private theorem Ydis : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (X : Set GaussianInt), ({x | ∃ v, v ∈ + TilingLattice C ∧ x ∈ BoundaryFootprintVertices (TileTranslation T v)} ⊆ X) → (∀ (x : + GaussianInt), + let reachable (a b : GaussianInt) : Prop := ∃ p : List GaussianInt, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent + let Y : Set GaussianInt := {y | reachable x y} + (Y ⊆ Xᶜ) → (Disjoint Y {x | ∃ v, v ∈ TilingLattice C ∧ x ∈ BoundaryFootprintVertices + (TileTranslation T v)})) ) := by + classical + intro C T X hWsub x reachable Y Yout + rw [Set.disjoint_left] + intro y hy hyW + exact False.elim ((Yout hy) (hWsub hyW)) + +private theorem Znonempty : + (by + classical + exact + ∀ (X : Set GaussianInt), ∀ (x : GaussianInt), + let reachable (a b : GaussianInt) : Prop := ∃ p : List GaussianInt, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent + let Y : Set GaussianInt := {y | reachable x y} + (x ∈ Y) → (∀ (v : GaussianInt), ∀ (hYfin : Y.Finite), + let Z : Finset GaussianInt := hYfin.toFinset.image (fun y => y - v) + Z.Nonempty) ) := by + classical + intro X x reachable Y xY v hYfin Z + refine ⟨x - v, ?_⟩ + apply Finset.mem_image.mpr + exact ⟨x, hYfin.mem_toFinset.mpr xY, rfl⟩ + +private theorem Zsub : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ((h.domain : Set + GaussianInt) = FootprintVertices T) → (∀ (X : Set GaussianInt), ∀ (x : GaussianInt), + let reachable (a b : GaussianInt) : Prop := ∃ p : List GaussianInt, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent + let Y : Set GaussianInt := {y | reachable x y} + ∀ (v : GaussianInt), (v ∈ TilingLattice C) → ((Y ⊆ FootprintVertices (TileTranslation T + v) \ {x : GaussianInt | ∃ v ∈ TilingLattice C, x ∈ BoundaryFootprintVertices + (TileTranslation T v)}) → (∀ (hYfin : Y.Finite), + let D := h.domain.filter fun p => + @decide (p ∉ BoundaryFootprintVertices T) (Classical.propDecidable _) + let Z : Finset GaussianInt := hYfin.toFinset.image (fun y => y - v) + Z ⊆ D))) ) := by + classical + intro C T h hdom X x reachable Y v hv hYsub hYfin D Z p hp + rcases Finset.mem_image.mp hp with ⟨y, hy, rfl⟩ + have hyY : y ∈ Y := hYfin.mem_toFinset.mp hy + have hyfp := (hYsub hyY).1 + have forms := TileTranslationFormulas T v + rcases forms with ⟨hcells, hanchor, hempty, hreal, hcent, hfp, hed, hb, hbe⟩ + rw [hfp] at hyfp + rcases hyfp with ⟨p, hp, hpy⟩ + have hpeq : p = y - v := by + rw [← hpy] + simp [GaussianTranslation] + subst p + have hpdom : y - v ∈ h.domain := by + change y - v ∈ (h.domain : Set GaussianInt) + rw [hdom] + exact hp + have hpbd : y - v ∉ BoundaryFootprintVertices T := by + intro hpbd + have hybd : y ∈ BoundaryFootprintVertices (TileTranslation T v) := by + rw [hb] + exact ⟨y - v, hpbd, by simp [GaussianTranslation] + ⟩ + exact (hYsub hyY).2 ⟨v, hv, hybd⟩ + exact Finset.mem_filter.mpr ⟨hpdom, by simp [hpbd] + ⟩ + +private theorem htrans : + (by + classical + exact + ∀ (v : GaussianInt), ∀ (p : GaussianInt), ∀ (y : GaussianInt), (y - v = p) → (y = p + v) + ) := by + classical + intro v p y hpy + rw [← hpy] + simp [sub_eq_add_neg, add_comm] + +private theorem memZ : + (by + classical + exact + ∀ (X : Set GaussianInt), ∀ (x : GaussianInt), + let reachable (a b : GaussianInt) : Prop := ∃ p : List GaussianInt, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent + let Y : Set GaussianInt := {y | reachable x y} + ∀ (v : GaussianInt), ∀ (hYfin : Y.Finite), + let Z : Finset GaussianInt := hYfin.toFinset.image (fun y => y - v) + ∀ (a : GaussianInt), a ∈ Z ↔ a + v ∈ Y ) := by + classical + intro X x reachable Y v hYfin Z a + constructor + · intro ha + rcases Finset.mem_image.mp ha with ⟨b, hb, hab⟩ + have hbY : b ∈ Y := hYfin.mem_toFinset.mp hb + have : b = a + v := by + rw [← hab] + simp [sub_eq_add_neg, add_comm] + simpa [this] using hbY + · intro ha + apply Finset.mem_image.mpr + exact ⟨a + v, hYfin.mem_toFinset.mpr ha, by + simp [sub_eq_add_neg, add_assoc, add_comm]⟩ + +private theorem stepReach : + (by + classical + exact + ∀ (X : Set GaussianInt), ∀ (x : GaussianInt), + let reachable (a b : GaussianInt) : Prop := ∃ p : List GaussianInt, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent + let Y : Set GaussianInt := {y | reachable x y} + ∀ (v : GaussianInt), ∀ (p : GaussianInt), ∀ (y : GaussianInt), (y ∈ Y) → ((y = p + v) → + (∀ (z : GaussianInt), (FourNeighborAdjacent (p + v) z) → ((z ∉ X) → (z ∈ Y)))) ) := by + classical + intro X x reachable Y v p y hyY htrans z hz hzX + rcases hyY with ⟨r, hr, hrlast, hrout, hrc⟩ + refine ⟨r ++ [z], ?_, ?_, ?_, ?_⟩ + · simp [hr] + · simp [htrans, hrlast] + · intro a ha + simp only [List.mem_append, List.mem_singleton] at ha + rcases ha with ha | rfl + · exact hrout a ha + · exact hzX + · apply hrc.append (List.isChain_singleton _) + intro a ha b hb + have ha' : a = p + v := by simpa [hrlast, htrans] using ha.symm + subst a + rcases (by simpa using hb : z = b) with rfl + exact hz + +private theorem neighborMem : + (by + classical + exact + ∀ (X : Set GaussianInt), ∀ (x : GaussianInt), + let reachable (a b : GaussianInt) : Prop := ∃ p : List GaussianInt, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent + let Y : Set GaussianInt := {y | reachable x y} + (Y ⊆ Xᶜ) → (∀ (v : GaussianInt), ∀ (hYfin : Y.Finite), + let Z : Finset GaussianInt := hYfin.toFinset.image (fun y => y - v) + ∀ (p : GaussianInt), (∀ (a : GaussianInt), a ∈ Z ↔ a + v ∈ Y) → ((∀ (z : GaussianInt), + (FourNeighborAdjacent (p + v) z) → ((z ∉ X) → (z ∈ Y))) → (∀ (z : GaussianInt), + (FourNeighborAdjacent (p + v) z) → (z ∈ X ↔ z - v ∉ Z)))) ) := by + classical + intro X x reachable Y Yout v hYfin Z p memZ stepReach z hz + constructor + · intro hzX hzZ + rcases (memZ (z - v)).mp hzZ with hzY + have : z ∉ X := by simpa [sub_add_cancel] using (Yout hzY) + exact this hzX + · intro hzZ + by_contra hzX + have hzY := stepReach z hz hzX + exact hzZ ((memZ (z - v)).mpr (by simpa [sub_add_cancel] using hzY)) + +private theorem hlapInd : + (by + classical + exact + ∀ (X : Set GaussianInt), ∀ (x : GaussianInt), + let reachable (a b : GaussianInt) : Prop := ∃ p : List GaussianInt, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent + let Y : Set GaussianInt := {y | reachable x y} + (Y ⊆ Xᶜ) → (∀ (v : GaussianInt), ∀ (hYfin : Y.Finite), + let Z : Finset GaussianInt := hYfin.toFinset.image (fun y => y - v) + ∀ (p : GaussianInt), (p ∈ Z) → (∀ (y : GaussianInt), (y ∈ Y) → ((y = p + v) → ((∀ (z : + GaussianInt), (FourNeighborAdjacent (p + v) z) → (z ∈ X ↔ z - v ∉ Z)) → + (FourNeighborLaplacian (fun z => (1 : ℤ) - if z ∈ Z then 1 else 0) p = + FourNeighborLaplacian (fun z => if z ∈ X then (1 : ℤ) else 0) (p + v)))))) ) := by + classical + intro X x reachable Y Yout v hYfin Z p hpZ y hyY htrans neighborMem + have h1 := neighborMem (p + v + 1) (by simp [FourNeighborAdjacent]) + have h2 := neighborMem (p + v - 1) (by simp [FourNeighborAdjacent]) + have h3 := neighborMem (p + v + ⟨0, 1⟩) (by simp [FourNeighborAdjacent]) + have h4 := neighborMem (p + v - ⟨0, 1⟩) (by simp [FourNeighborAdjacent]) + have hc : p ∈ Z := hpZ + have hcx : p + v ∉ X := by simpa [htrans] using (Yout hyY) + have h1' : p + 1 ∈ Z ↔ p + v + 1 ∉ X := by + have hh := (not_congr h1).symm + rw [show p + v + 1 - v = p + 1 by abel] at hh + simp only [not_not] at hh + exact hh + have h2' : p - 1 ∈ Z ↔ p + v - 1 ∉ X := by + have hh := (not_congr h2).symm + rw [show p + v - 1 - v = p - 1 by abel] at hh + simp only [not_not] at hh + exact hh + have h3' : p + ⟨0, 1⟩ ∈ Z ↔ p + v + ⟨0, 1⟩ ∉ X := by + have hh := (not_congr h3).symm + rw [show p + v + ⟨0, 1⟩ - v = p + ⟨0, 1⟩ by abel] at hh + simp only [not_not] at hh + exact hh + have h4' : p - ⟨0, 1⟩ ∈ Z ↔ p + v - ⟨0, 1⟩ ∉ X := by + have hh := (not_congr h4).symm + rw [show p + v - ⟨0, 1⟩ - v = p - ⟨0, 1⟩ by abel] at hh + simp only [not_not] at hh + exact hh + have h2'' : -1 + p ∈ Z ↔ -1 + p + v ∉ X := by + convert h2' using 1 <;> abel + have h4'' : -⟨0, 1⟩ + p ∈ Z ↔ -⟨0, 1⟩ + p + v ∉ X := by + convert h4' using 1 <;> abel + have e1 : 1 + p + v ∉ X ↔ p + 1 ∈ Z := by + convert h1'.symm using 1; abel + have e2 : -1 + p + v ∉ X ↔ p - 1 ∈ Z := by + convert h2'.symm using 1; abel + have e3 : p + v + ⟨0, 1⟩ ∉ X ↔ p + ⟨0, 1⟩ ∈ Z := h3'.symm + have e4 : p + v - ⟨0, 1⟩ ∉ X ↔ p - ⟨0, 1⟩ ∈ Z := h4'.symm + simp only [FourNeighborLaplacian] + have d1 : p + v + 1 ∉ X ↔ p + 1 ∈ Z := h1'.symm + have d2 : p + v - 1 ∉ X ↔ p - 1 ∈ Z := h2'.symm + have d3 : p + v + ⟨0, 1⟩ ∉ X ↔ p + ⟨0, 1⟩ ∈ Z := e3 + have d4 : p + v - ⟨0, 1⟩ ∉ X ↔ p - ⟨0, 1⟩ ∈ Z := e4 + have c1 : (if p + 1 ∈ Z then (1 : ℤ) else 0) = + 1 - (if p + v + 1 ∈ X then (1 : ℤ) else 0) := by + by_cases hz : p + 1 ∈ Z + · have hn := d1.mpr hz + simp [hz, hn] + · have hx : p + v + 1 ∈ X := by + by_contra hn + exact hz (d1.mp hn) + simp [hz, hx] + have c2 : (if p - 1 ∈ Z then (1 : ℤ) else 0) = + 1 - (if p + v - 1 ∈ X then (1 : ℤ) else 0) := by + by_cases hz : p - 1 ∈ Z + · have hn := d2.mpr hz + simp [hz, hn] + · have hx : p + v - 1 ∈ X := by + by_contra hn + exact hz (d2.mp hn) + simp [hz, hx] + have c3 : (if p + ⟨0, 1⟩ ∈ Z then (1 : ℤ) else 0) = + 1 - (if p + v + ⟨0, 1⟩ ∈ X then (1 : ℤ) else 0) := by + by_cases hz : p + ⟨0, 1⟩ ∈ Z + · have hn := d3.mpr hz + simp [hz, hn] + · have hx : p + v + ⟨0, 1⟩ ∈ X := by + by_contra hn + exact hz (d3.mp hn) + simp [hz, hx] + have c4 : (if p - ⟨0, 1⟩ ∈ Z then (1 : ℤ) else 0) = + 1 - (if p + v - ⟨0, 1⟩ ∈ X then (1 : ℤ) else 0) := by + by_cases hz : p - ⟨0, 1⟩ ∈ Z + · have hn := d4.mpr hz + simp [hz, hn] + · have hx : p + v - ⟨0, 1⟩ ∈ X := by + by_contra hn + exact hz (d4.mp hn) + simp [hz, hx] + rw [c1, c2] + rw [c3, c4] + simp [hc, hcx] + +private theorem hcompare : + (by + classical + exact + ∀ (g : IntegerLatticeFunction), ∀ (X : Set GaussianInt), ∀ (x : GaussianInt), + let reachable (a b : GaussianInt) : Prop := ∃ p : List GaussianInt, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent + let Y : Set GaussianInt := {y | reachable x y} + ∀ (v : GaussianInt), ∀ (hYfin : Y.Finite), + let Z : Finset GaussianInt := hYfin.toFinset.image (fun y => y - v) + ∀ (p : GaussianInt), (FourNeighborLaplacian (fun z => (1 : ℤ) - if z ∈ Z then 1 else 0) p + = FourNeighborLaplacian (fun z => if z ∈ X then (1 : ℤ) else 0) (p + v)) → + ((FourNeighborLaplacian g (p + v) = FourNeighborLaplacian g p) → + (FourNeighborLaplacian (fun z => g z + 1 - if z ∈ Z then 1 else 0) p = + FourNeighborLaplacian (fun z => g z + Set.indicator X (fun _ => (1 : ℤ)) z) (p + v))) + ) := by + classical + intro g X x reachable Y v hYfin Z p hlapInd hlapg + simp only [FourNeighborLaplacian, Set.indicator_apply] + have hg := hlapg + simp only [FourNeighborLaplacian] at hg + have hi := hlapInd + simp only [FourNeighborLaplacian] at hi + linarith + +private theorem hconst : + (by + classical + exact + ∀ (g : IntegerLatticeFunction), ∀ (X : Set GaussianInt), ∀ (x : GaussianInt), + let reachable (a b : GaussianInt) : Prop := ∃ p : List GaussianInt, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent + let Y : Set GaussianInt := {y | reachable x y} + ∀ (v : GaussianInt), ∀ (hYfin : Y.Finite), + let Z : Finset GaussianInt := hYfin.toFinset.image (fun y => y - v) + ∀ (p : GaussianInt), FourNeighborLaplacian (fun z => g z + 1 - if z ∈ Z then 1 else 0) p + = FourNeighborLaplacian (fun z => g z - if z ∈ Z then 1 else 0) p ) := by + classical + intro g X x reachable Y v hYfin Z p + simp only [FourNeighborLaplacian] + ring + +end PeriodicIndicatorGeometry + +theorem PeriodicOdometerIndicatorRigidity (C : BandCircle) + (T : ProtoTile) (h : PartialOdometer) (g : IntegerLatticeFunction) + (hT : BandPrototile C.1.1 T) (hlat : LatticeTile T) + (hodo : TileOdometer C.1.1 T h) + (hdom : (h.domain : Set GaussianInt) = FootprintVertices T) + (hext : GlobalOdometerExtends g h) + (htile : ExactTileTiling (RegularTileFamily T (TilingLattice C))) + (hperiodic : ∀ v, v ∈ TilingLattice C → ∀ x, + FourNeighborLaplacian g (x + v) = FourNeighborLaplacian g x) + (hweb : ∀ x, (∃ v, v ∈ TilingLattice C ∧ + x ∈ BoundaryFootprintVertices (TileTranslation T v)) → + FourNeighborLaplacian g x = 1) : + ∀ X : Set GaussianInt, X.Infinite → FourNeighborConnected X → + (∀ x, FourNeighborLaplacian + (fun y => g y + Set.indicator X (fun _ => (1 : ℤ)) y) x ≤ 1) → + X = Set.univ := by +-- BODY + classical + intro X hXin hXconn hle + have web := PeriodicBoundaryWebConnected C T hT hlat htile + dsimp at web + obtain ⟨hWconn, hWcontain⟩ := web + have finiteFoot := PeriodicIndicatorGeometry.finiteFoot + apply Set.eq_univ_of_forall + intro x + by_contra hxX + let reachable (a b : GaussianInt) : Prop := ∃ p : List GaussianInt, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent + let Y : Set GaussianInt := {y | reachable x y} + have Ynonempty := PeriodicIndicatorGeometry.Ynonempty X x hxX + have xY := PeriodicIndicatorGeometry.xY X x hxX + have Yout := PeriodicIndicatorGeometry.Yout X x + have Yconn := PeriodicIndicatorGeometry.Yconn X x xY + have Ydis := PeriodicIndicatorGeometry.Ydis C T X (PeriodicIndicatorGeometry.hWsub C T X hWconn + (PeriodicIndicatorGeometry.hmeet C T X hXin hXconn hWcontain finiteFoot) + (PeriodicIndicatorGeometry.noCross C T g hweb X hle)) x Yout + obtain ⟨v, hv, hYsub⟩ := hWcontain Y Yconn Ydis + have hYfin : Y.Finite := (finiteFoot _).subset (fun y hy => (hYsub hy).1) + let D := h.domain.filter fun p => + @decide (p ∉ BoundaryFootprintVertices T) (Classical.propDecidable _) + have ho0 := BandTileAcyclicIndegree C T h g hT hodo hdom hext + dsimp at ho0 + obtain ⟨o⟩ := ho0 + let Z : Finset GaussianInt := hYfin.toFinset.image (fun y => y - v) + have hobs := FiniteAcyclicOrientationObstruction D g o Z (PeriodicIndicatorGeometry.Znonempty X + x xY v hYfin) (PeriodicIndicatorGeometry.Zsub C T h hdom X x v hv hYsub hYfin) + rcases hobs with ⟨p, hpZ, hpobs⟩ + rcases Finset.mem_image.mp (show p ∈ hYfin.toFinset.image (fun y => y - v) from hpZ) with + ⟨y, hy, hpy⟩ + have hyY : y ∈ Y := hYfin.mem_toFinset.mp hy + have htrans := PeriodicIndicatorGeometry.htrans v p y hpy + have hlapg := hperiodic v hv p + have hcompare : FourNeighborLaplacian + (fun z => g z + 1 - if z ∈ Z then 1 else 0) p = + FourNeighborLaplacian + (fun z => g z + Set.indicator X (fun _ => (1 : ℤ)) z) (p + v) := + PeriodicIndicatorGeometry.hcompare g X x v hYfin p (PeriodicIndicatorGeometry.hlapInd + X x Yout v hYfin p hpZ y hyY htrans (PeriodicIndicatorGeometry.neighborMem X x Yout v + hYfin p (PeriodicIndicatorGeometry.memZ X x v hYfin) + (PeriodicIndicatorGeometry.stepReach X x v p y hyY htrans))) hlapg + have hle' := hle (p + v) + rw [← hcompare] at hle' + have hconst : FourNeighborLaplacian + (fun z => g z + 1 - if z ∈ Z then 1 else 0) p = + FourNeighborLaplacian (fun z => g z - if z ∈ Z then 1 else 0) p := + PeriodicIndicatorGeometry.hconst g X x v hYfin p + rw [hconst] at hle' + linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicQuadraticRemainder.lean b/LeanPool/ApollonianSuperharmonic/PeriodicQuadraticRemainder.lean new file mode 100644 index 0000000000..e5d6cabb6d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicQuadraticRemainder.lean @@ -0,0 +1,233 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm +public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis +public import LeanPool.ApollonianSuperharmonic.TilingLatticeCocycleExtension + +-- [TABLET NODE: PeriodicQuadraticRemainder] + +/-! +# PeriodicQuadraticRemainder + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem PeriodicQuadraticRemainder (C : BandCircle) + (g : IntegerLatticeFunction) + (hcocycle : ∀ v, v ∈ TilingLattice C → ∃ a : GaussianInt, + Matrix.mulVec (CircleMatrix C) ![(v.re : ℝ), (v.im : ℝ)] = + ![(a.re : ℝ), (a.im : ℝ)] ∧ + ∀ x, g (x + v) = g x + x.re * a.re + x.im * a.im + g v) : + ∃ b : ℝ × ℝ, ∀ v, v ∈ TilingLattice C → ∀ x, + (g (x + v) : ℝ) - LatticeQuadraticForm (CircleMatrix C) (x + v) - + (b.1 * (x + v).re + b.2 * (x + v).im) = + (g x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x - + (b.1 * x.re + b.2 * x.im) := by +-- BODY + classical + let Q : GaussianInt → ℝ := fun z => LatticeQuadraticForm (CircleMatrix C) z + let d : GaussianInt → ℝ := fun z => (g z : ℝ) - Q z + have shift : ∀ x v : GaussianInt, + Q (x + v) = Q x + x.re * (Matrix.mulVec (CircleMatrix C) + ![(v.re : ℝ), (v.im : ℝ)] 0) + + x.im * (Matrix.mulVec (CircleMatrix C) + ![(v.re : ℝ), (v.im : ℝ)] 1) + Q v := by + intro x v + dsimp [Q, LatticeQuadraticForm] + simp [CircleMatrix, Matrix.mulVec, dotProduct, Fin.sum_univ_two, + Matrix.vecCons, Matrix.vecEmpty, Fin.cons, Fin.cases, Fin.induction, + Fin.induction.go, -GaussianInt.intCast_re, -GaussianInt.intCast_im] + ring_nf + have delta_add : ∀ x v, v ∈ TilingLattice C → d (x + v) = d x + d v := by + intro x v hv + obtain ⟨a, ha, hg⟩ := hcocycle v hv + have h0 := congrFun ha 0 + have h1 := congrFun ha 1 + dsimp at h0 h1 + dsimp [d] + rw [hg x, shift x v] + simp only [sub_eq_add_neg] + rw [h0, h1] + norm_num + ring + have delta_zero : d 0 = 0 := by + have hz := delta_add 0 0 (TilingLattice C).zero_mem + simpa using hz + have delta_neg : ∀ v, v ∈ TilingLattice C → d (-v) = -d v := by + intro v hv + have h := delta_add (-v) v hv + have hmem : -v ∈ TilingLattice C := (TilingLattice C).neg_mem hv + have hzero : -v + v = 0 := by simp + rw [hzero, delta_zero] at h + linarith + let deltaHom : TilingLattice C →+ ℝ := + { toFun := fun v => d v + map_zero' := delta_zero + map_add' := by + intro u v + exact delta_add u v v.property } + have basis : ∃ u v : GaussianInt, u ∈ TilingLattice C ∧ + v ∈ TilingLattice C ∧ + ∀ w : TilingLattice C, ∃! mn : Int × Int, + (mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v = (w : GaussianInt) := by + by_cases hc : C.1.1.1 = 1 + · refine ⟨1, ⟨0, 1⟩, ?_, ?_, ?_⟩ + · simp [TilingLattice, hc] + · simp [TilingLattice, hc] + · intro w + refine ⟨((w : GaussianInt).re, (w : GaussianInt).im), ?_, ?_⟩ + · ext <;> simp + · intro mn hm + have hr := congrArg (fun z : GaussianInt => z.re) hm + have hi := congrArg (fun z : GaussianInt => z.im) hm + simp? at hr hi + exact Prod.ext (by exact_mod_cast hr) (by exact_mod_cast hi) + · have hpos := C.2 + have hgt : 1 < C.1.1.1 := by omega + obtain ⟨q, T, h, g0, hq, hC, hrest⟩ := + PositiveCurvatureGeneratorCocycles C hgt + obtain ⟨hu, hv, hcoord, hleft, hright, hlast⟩ := + TilingLatticeBasis C q hq hC + exact ⟨BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0), hu, hv, + hcoord⟩ + obtain ⟨u, v, hu, hv, hcoord⟩ := basis + let det : ℤ := u.re * v.im - u.im * v.re + have det_ne : det ≠ 0 := by + intro hd + dsimp [det] at hd + have hu0 : u ≠ 0 := by + intro hz + obtain ⟨mn, hm, hmu⟩ := hcoord ⟨0, (TilingLattice C).zero_mem⟩ + have hzero : (0 : Int × Int) = mn := hmu (0, 0) (by simp [hz]) + have hone : (1, 0) = mn := hmu (1, 0) (by simp [hz]) + have hh := congrArg Prod.fst (hone.trans hzero.symm) + norm_num at hh + have hv0 : v ≠ 0 := by + intro hz + obtain ⟨mn, hm, hmu⟩ := hcoord ⟨0, (TilingLattice C).zero_mem⟩ + have hzero : (0 : Int × Int) = mn := hmu (0, 0) (by simp [hz]) + have hone : (0, 1) = mn := hmu (0, 1) (by simp [hz]) + have hh := congrArg Prod.snd (hone.trans hzero.symm) + norm_num at hh + by_cases hreal : v.re = 0 ∧ u.re = 0 + · have himag : v.im ≠ 0 ∨ u.im ≠ 0 := by + by_cases hvim : v.im = 0 + · right + intro huim + apply hu0 + ext <;> simp [huim, hreal.2] + · exact Or.inl hvim + rcases himag with hvim | huim + · let mn : Int × Int := (v.im, -u.im) + have hz : (mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v = 0 := by + ext <;> simp [mn, hreal.1, hreal.2] + ring + obtain ⟨mp, hp, hmp⟩ := hcoord ⟨0, (TilingLattice C).zero_mem⟩ + have heq : mn = mp := hmp mn hz + have hz0 : (0 : Int × Int) = mp := hmp (0, 0) (by simp) + have hmzero : mn = (0, 0) := heq.trans hz0.symm + have : (mn.1 : Int) = 0 := by simpa using congrArg Prod.fst hmzero + exact hvim this + · let mn : Int × Int := (v.im, -u.im) + have hz : (mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v = 0 := by + ext <;> simp [mn, hreal.1, hreal.2] + ring + obtain ⟨mp, hp, hmp⟩ := hcoord ⟨0, (TilingLattice C).zero_mem⟩ + have heq : mn = mp := hmp mn hz + have hz0 : (0 : Int × Int) = mp := hmp (0, 0) (by simp) + have hmzero : mn = (0, 0) := heq.trans hz0.symm + have hsecond : (mn.2 : Int) = 0 := by simpa using congrArg Prod.snd hmzero + dsimp [mn] at hsecond + exact huim (by linarith [hsecond]) + · let mn : Int × Int := (v.re, -u.re) + have hz : (mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v = 0 := by + ext <;> simp [mn] + · ring + · nlinarith [hd] + obtain ⟨mp, hp, hmp⟩ := hcoord ⟨0, (TilingLattice C).zero_mem⟩ + have heq : mn = mp := hmp mn hz + have hz0 : (0 : Int × Int) = mp := hmp (0, 0) (by simp) + have hmzero : mn = (0, 0) := heq.trans hz0.symm + have hfirst : (mn.1 : Int) = 0 := by simpa using congrArg Prod.fst hmzero + have hsecond : (mn.2 : Int) = 0 := by simpa using congrArg Prod.snd hmzero + apply hreal + constructor + · exact hfirst + · linarith + let b : ℝ × ℝ := + ((d u * (v.im : ℝ) - d v * (u.im : ℝ)) / (det : ℝ), + ((u.re : ℝ) * d v - (v.re : ℝ) * d u) / (det : ℝ)) + have coordinate_value : ∀ w : TilingLattice C, + d (w : GaussianInt) = + b.1 * (w : GaussianInt).re + b.2 * (w : GaussianInt).im := by + intro w + obtain ⟨mn, hm, hmu⟩ := hcoord w + have hlinear : d ((mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v) = + (mn.1 : ℝ) * d u + (mn.2 : ℝ) * d v := by + have hu' : (⟨u, hu⟩ : TilingLattice C) = + (⟨u, hu⟩ : TilingLattice C) := rfl + have hv' : (⟨v, hv⟩ : TilingLattice C) = + (⟨v, hv⟩ : TilingLattice C) := rfl + have hm1 := deltaHom.map_zsmul mn.1 (⟨u, hu⟩ : TilingLattice C) + have hm2 := deltaHom.map_zsmul mn.2 (⟨v, hv⟩ : TilingLattice C) + have hadd := deltaHom.map_add + (mn.1 • (⟨u, hu⟩ : TilingLattice C)) + (mn.2 • (⟨v, hv⟩ : TilingLattice C)) + dsimp [deltaHom, d] at hm1 hm2 hadd ⊢ + rw [hm1, hm2] at hadd + simpa [smul_eq_mul, zsmul_eq_mul, Int.cast_ofNat, Int.cast_neg, + add_comm, add_left_comm, add_assoc] using hadd + have hlinear' : d (w : GaussianInt) = + (mn.1 : ℝ) * d u + (mn.2 : ℝ) * d v := by + calc + d (w : GaussianInt) = + d ((mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v) := + congrArg d hm.symm + _ = _ := hlinear + rw [hlinear'] + dsimp [b] + have hdetreal : (det : ℝ) ≠ 0 := by exact_mod_cast det_ne + have hr := congrArg (fun z : GaussianInt => z.re) hm + have hi := congrArg (fun z : GaussianInt => z.im) hm + simp at hr hi + field_simp [hdetreal] + have hrr : (mn.1 : ℝ) * (u.re : ℝ) + (mn.2 : ℝ) * (v.re : ℝ) = + (w : GaussianInt).re := by exact_mod_cast hr + have hir : (mn.1 : ℝ) * (u.im : ℝ) + (mn.2 : ℝ) * (v.im : ℝ) = + (w : GaussianInt).im := by exact_mod_cast hi + rw [← hrr, ← hir] + dsimp [det] + push_cast + ring_nf + refine ⟨b, ?_⟩ + intro w hw x + have hdw := coordinate_value ⟨w, hw⟩ + change d w = b.1 * (w.re : ℝ) + b.2 * (w.im : ℝ) at hdw + have hdx := delta_add x w hw + have hcorrected : d (x + w) - + (b.1 * (x + w).re + b.2 * (x + w).im) = + d x - (b.1 * x.re + b.2 * x.im) := by + rw [hdx, show (x + w).re = x.re + w.re by simp, + show (x + w).im = x.im + w.im by simp] + rw [Int.cast_add, Int.cast_add] + have haddb : b.1 * ((x.re : ℝ) + (w.re : ℝ)) + + b.2 * ((x.im : ℝ) + (w.im : ℝ)) = + (b.1 * x.re + b.2 * x.im) + + (b.1 * (w.re : ℝ) + b.2 * (w.im : ℝ)) := by ring + rw [haddb, ← hdw] + ring + simpa [d, Q] using hcorrected + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicSubtileFaceIndex.lean b/LeanPool/ApollonianSuperharmonic/PeriodicSubtileFaceIndex.lean new file mode 100644 index 0000000000..375f125b45 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicSubtileFaceIndex.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceLabel + +-- [TABLET NODE: PeriodicSubtileFaceIndex] + +/-! +# PeriodicSubtileFaceIndex + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A periodic face index is a triple $(H,m,n)$, where $H$ is one of the twelve +labels of `SixSubtileFaceLabel` and $(m,n)\in\mathbb Z^2$. It +denotes the translate by $mu+nv$ of the entire labelled face, including its +three tile occurrences and its selected common point. +-/ +structure PeriodicSubtileFaceIndex where +-- BODY + /-- The orbit label preserved by all period translations. -/ + label : SixSubtileFaceLabel + /-- The integral coordinate along the first period vector. -/ + first : Int + /-- The integral coordinate along the second period vector. -/ + second : Int + deriving DecidableEq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicSubtileIndex.lean b/LeanPool/ApollonianSuperharmonic/PeriodicSubtileIndex.lean new file mode 100644 index 0000000000..944ed72922 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicSubtileIndex.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SixSubtileLabel + +-- [TABLET NODE: PeriodicSubtileIndex] + +/-! +# PeriodicSubtileIndex + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A periodic labeled-subtile index is a triple $(X,m,n)$ with +$X\in\{A,B,C,D,E,F\}$ and $(m,n)\in\mathbb Z^2$. It denotes the translate +$X_{m,n}$ in the periodic six-type layout. +-/ +structure PeriodicSubtileIndex where +-- BODY + /-- The orbit label preserved by all period translations. -/ + label : SixSubtileLabel + /-- The integral coordinate along the first period vector. -/ + first : Int + /-- The integral coordinate along the second period vector. -/ + second : Int + deriving DecidableEq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileAdjacentContactRegularity.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileAdjacentContactRegularity.lean new file mode 100644 index 0000000000..d4e4a118f9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileAdjacentContactRegularity.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices + +-- [TABLET NODE: PeriodicTileAdjacentContactRegularity] + +/-! +# PeriodicTileAdjacentContactRegularity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +An adjacent-contact regularity certificate for a +`PeriodicTileComplex` $P$ asserts that, for every prescribed graph +edge $ab$, the complete raw common-footprint vertex set is exactly the set +of endpoints of actual common footprint edges: +$$ + \operatorname{foot}(P_a)\cap\operatorname{foot}(P_b) + =\operatorname{CommonFootprintEdgeVertices}(P_a,P_b). +$$ +Thus every raw contact of a prescribed adjacent pair is incident with a +common unit edge. The condition is imposed only on prescribed adjacent +pairs: it neither promotes an isolated contact of a nonadjacent pair to an +edge nor forbids such a contact. +-/ +structure PeriodicTileAdjacentContactRegularity {ι : Type} + (P : PeriodicTileComplex ι) where +-- BODY + adjacent_raw_eq_edge_vertices : ∀ a b, P.plane.adjacent a b → + FootprintVertices (P.tile a) ∩ FootprintVertices (P.tile b) = + CommonFootprintEdgeVertices (P.tile a) (P.tile b) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileComplex.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileComplex.lean new file mode 100644 index 0000000000..fe6c9caaf1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileComplex.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import LeanPool.ApollonianSuperharmonic.TileArea +public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices + +-- [TABLET NODE: PeriodicTileComplex] + +/-! +# PeriodicTileComplex + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A periodic tile complex is an area-free periodic tile core together with the +two additional hypotheses used after coverage: the orbit-area identity +$$ + \sum_{a\in\mathcal T/L}|T_a|=[\mathbb Z[i]:L], +$$ +computed using the selected vertex-orbit and lattice-coset representatives, +and the requirement that the two tiles on every graph edge have an actual +common footprint edge. Equivalently, every prescribed graph adjacency is +supported by a nonconstant lattice-edge interface; two isolated common +footprint vertices, or a single corner contact, do not satisfy this +requirement. The vertices belonging to such interfaces are recorded by +`CommonFootprintEdgeVertices`. +-/ +structure PeriodicTileComplex (ι : Type) extends PeriodicTileCore ι where +-- BODY + area_balance : + (∑ a ∈ vertexOrbitReps, TileArea (tile a)) = latticeReps.card + adjacent_has_common_edge : ∀ a b, plane.adjacent a b → + (FootprintEdges (tile a) ∩ FootprintEdges (tile b)).Nonempty + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRouting.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRouting.lean new file mode 100644 index 0000000000..04a4d5ee0a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRouting.lean @@ -0,0 +1,136 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint + +-- [TABLET NODE: PeriodicTileContactRouting] + +/-! +# PeriodicTileContactRouting + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a periodic tile complex $P$, a periodic contact routing is a proper, +compactly locally finite, periodic plane drawing of the prescribed graph, +made from genuine common-edge ports and tile-interior half-stars. It chooses +a point $v_a$ in the interior of each closed-square tile realization. For +each prescribed edge $ab$ it chooses, symmetrically, an actual two-element +lattice edge +$$ + e_{ab}\in E(T_a)\cap E(T_b) +$$ +and an optional port whose value is the Euclidean midpoint $p_{ab}$ of that +edge. The optional port is *none* exactly for nonedges; a nonedge also +has empty chosen-edge, half-arc, and full-arc data. + +For a prescribed edge $ab$, the half-arc $H_{ab}$ is an arc from $v_a$ to +$p_{ab}$ contained in the interior of $T_a$ except at the port. Distinct +ports at $a$ are distinct, and distinct incident half-arcs meet exactly at +$v_a$. The full arc $A_{ab}=H_{ab}\cup H_{ba}$ is an arc from $v_a$ to +$v_b$, is symmetric in $a,b$, and two distinct full arcs meet exactly in +the positions of their common graph endpoints. The vertex positions are +injective. Compact local finiteness means that every compact subset of the +plane meets only finitely many full arcs. + +Translation by the period lattice translates vertex positions, selected +lattice edges, optional ports, half-arcs, and full arcs. Thus this object +contains precisely a periodic proper drawing of the prescribed adjacency +relation. It has no second face type, no routed face regions, and no +plane-cover datum. In particular, an isolated raw corner contact with no +common footprint edge produces neither a port nor a drawn edge. +-/ +structure PeriodicTileContactRouting {ι : Type} + (P : PeriodicTileComplex ι) where +-- BODY + /-- The tile-interior point representing each graph vertex. -/ + position : ι → Real × Real + /-- The selected common unit footprint edge of each prescribed adjacency. -/ + portEdge : ι → ι → Finset GaussianInt + /-- The midpoint port of a prescribed edge, absent on nonedges. -/ + port : ι → ι → Option (Real × Real) + /-- The half arc inside the first tile, ending at the selected edge port. -/ + halfArc : ι → ι → Set (Real × Real) + /-- The symmetric full arc joining the two incident tile positions. -/ + edgeArc : ι → ι → Set (Real × Real) + portEdge_symmetric : ∀ a b, portEdge a b = portEdge b a + port_symmetric : ∀ a b, port a b = port b a + portEdge_common : ∀ a b, P.plane.adjacent a b → + portEdge a b ∈ FootprintEdges (P.tile a) ∩ + FootprintEdges (P.tile b) + portEdge_two : ∀ a b, P.plane.adjacent a b → + (portEdge a b).card = 2 + port_midpoint : ∀ a b, P.plane.adjacent a b → + port a b = some + (((∑ z ∈ portEdge a b, (((z.re : Int) : Real))) / 2), + ((∑ z ∈ portEdge a b, (((z.im : Int) : Real))) / 2)) + port_eq_none_iff : ∀ a b, + port a b = none ↔ ¬ P.plane.adjacent a b + nonedge_has_no_portEdge : ∀ a b, ¬ P.plane.adjacent a b → + portEdge a b = ∅ + nonedge_has_no_halfArc : ∀ a b, ¬ P.plane.adjacent a b → + halfArc a b = ∅ + nonedge_has_no_edgeArc : ∀ a b, ¬ P.plane.adjacent a b → + edgeArc a b = ∅ + position_in_tile_interior : ∀ a, + position a ∈ interior (TileRealization (P.tile a)) + position_injective : Function.Injective position + incident_ports_distinct : ∀ a b c p q, + port a b = some p → port a c = some q → b ≠ c → p ≠ q + halfArc_homeomorph : ∀ a b p, port a b = some p → + ∃ h : (Set.Icc (0 : Real) 1) ≃ₜ halfArc a b, + ((h ⟨0, by norm_num⟩ : halfArc a b) : Real × Real) = + position a ∧ + ((h ⟨1, by norm_num⟩ : halfArc a b) : Real × Real) = p + halfArc_supported : ∀ a b p, port a b = some p → + halfArc a b ⊆ interior (TileRealization (P.tile a)) ∪ {p} + incident_halfArc_intersections : ∀ a b c, + P.plane.adjacent a b → P.plane.adjacent a c → b ≠ c → + halfArc a b ∩ halfArc a c = {position a} + edgeArc_symmetric : ∀ a b, edgeArc a b = edgeArc b a + edgeArc_from_halfArcs : ∀ a b p, port a b = some p → + edgeArc a b = halfArc a b ∪ halfArc b a + edgeArc_homeomorph : ∀ a b, P.plane.adjacent a b → + ∃ h : (Set.Icc (0 : Real) 1) ≃ₜ edgeArc a b, + ((h ⟨0, by norm_num⟩ : edgeArc a b) : Real × Real) = + position a ∧ + ((h ⟨1, by norm_num⟩ : edgeArc a b) : Real × Real) = + position b + edgeArc_intersections : ∀ a b c d, + P.plane.adjacent a b → P.plane.adjacent c d → + ({a, b} : Set ι) ≠ ({c, d} : Set ι) → + edgeArc a b ∩ edgeArc c d = + position '' (({a, b} : Set ι) ∩ ({c, d} : Set ι)) + compact_local_finiteness : ∀ K : Set (Real × Real), IsCompact K → + Set.Finite {e : ι × ι | + P.plane.adjacent e.1 e.2 ∧ (edgeArc e.1 e.2 ∩ K).Nonempty} + position_periodic : ∀ u : P.lattice, ∀ a, + position (P.shift u a) = position a + GaussianRealPoint u + portEdge_periodic : ∀ u : P.lattice, ∀ a b, + portEdge (P.shift u a) (P.shift u b) = + (portEdge a b).image (fun z => z + (u : GaussianInt)) + port_periodic : ∀ u : P.lattice, ∀ a b, + port (P.shift u a) (P.shift u b) = + (port a b).map (fun p => p + GaussianRealPoint u) + halfArc_periodic : ∀ u : P.lattice, ∀ a b, + halfArc (P.shift u a) (P.shift u b) = + (fun p => p + GaussianRealPoint u) '' halfArc a b + edgeArc_periodic : ∀ u : P.lattice, ∀ a b, + edgeArc (P.shift u a) (P.shift u b) = + (fun p => p + GaussianRealPoint u) '' edgeArc a b + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRoutingRigidity.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRoutingRigidity.lean new file mode 100644 index 0000000000..7e27fb7967 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRoutingRigidity.lean @@ -0,0 +1,585 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PlaneEmbeddingAgreement +public import LeanPool.ApollonianSuperharmonic.P3723T1ContactPortsExist +public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactDrawingExists +public import LeanPool.ApollonianSuperharmonic.P3861T1RoutedFacialDomains +public import LeanPool.ApollonianSuperharmonic.P3861T1RoutedFaceOrientation +public import LeanPool.ApollonianSuperharmonic.P3861T1ExtraArcLocalization +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.FinCases + +-- [TABLET NODE: PeriodicTileContactRoutingRigidity] + +/-! +# PeriodicTileContactRoutingRigidity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ContactRoutingGeometry + +private theorem contact : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ {a : ι}, ∀ {b : ι}, (P.plane.adjacent a b) + → (P3723T1EdgeContact P a b) ) := by + classical + intro ι P a b hab + exact ⟨fun heq => P.plane.adjacent_irreflexive a (heq ▸ hab), + P.adjacent_has_common_edge a b hab⟩ + +private theorem hne : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), (∀ + {a : ι}, ∀ {b : ι}, (P.plane.adjacent a b) → (P3723T1EdgeContact P a b)) → (∀ (a : + ι), ∀ (b : ι), (P.plane.adjacent a b) → (D.port a b ≠ none)) ) := by + classical + intro ι P D contact a b hab hn + exact (D.port_eq_none_iff a b).mp hn (contact hab) + +private theorem traces : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (ports : P3723T1ContactPorts P), ∀ (D : + P3723T1AllContactRouting P), ∀ (retained_position : D.position = ports.position), ∀ + (contact : ∀ {a : ι}, ∀ {b : ι}, (P.plane.adjacent a b) → (P3723T1EdgeContact P a + b)), ∀ (symmetric : ∀ {a : ι}, ∀ {b : ι}, (P.plane.adjacent a b) → (P.plane.adjacent + b a)), + let R : PeriodicTileContactRouting P := { + position := D.position + portEdge := fun a b => if P.plane.adjacent a b then D.portEdge a b else ∅ + port := fun a b => if P.plane.adjacent a b then D.port a b else none + halfArc := fun a b => if P.plane.adjacent a b then D.halfArc a b else ∅ + edgeArc := fun a b => if P.plane.adjacent a b then D.edgeArc a b else ∅ + portEdge_symmetric := by + intro a b + by_cases hab : P.plane.adjacent a b + · simp only [ite_eq_left hab, ite_eq_left (symmetric hab)] + exact D.portEdge_symmetric a b + · have hba : ¬ P.plane.adjacent b a := fun h => hab (symmetric h) + simp only [ite_eq_right hab, ite_eq_right hba] + port_symmetric := by + intro a b + by_cases hab : P.plane.adjacent a b + · simp only [ite_eq_left hab, ite_eq_left (symmetric hab)] + exact D.port_symmetric a b + · have hba : ¬ P.plane.adjacent b a := fun h => hab (symmetric h) + simp only [ite_eq_right hab, ite_eq_right hba] + portEdge_common := by + intro a b hab + simpa only [ite_eq_left hab] using D.portEdge_common a b (contact hab) + portEdge_two := by + intro a b hab + simpa only [ite_eq_left hab] using D.portEdge_two a b (contact hab) + port_midpoint := by + intro a b hab + simpa only [ite_eq_left hab] using D.port_midpoint a b (contact hab) + port_eq_none_iff := by + intro a b + by_cases hab : P.plane.adjacent a b + · have hne : D.port a b ≠ none := by + intro hn + exact (D.port_eq_none_iff a b).mp hn (contact hab) + simp only [hne, hab, not_true_eq_false, ite_true] + · simp only [hab, not_false_eq_true, ite_false, eq_self] + nonedge_has_no_portEdge := by + intro a b hab + simp only [ite_eq_right hab] + nonedge_has_no_halfArc := by + intro a b hab + simp only [ite_eq_right hab] + nonedge_has_no_edgeArc := by + intro a b hab + simp only [ite_eq_right hab] + position_in_tile_interior := by + rw [retained_position] + exact ports.position_in_tile_interior + position_injective := by + rw [retained_position] + exact ports.position_injective + incident_ports_distinct := by + intro a b c p q hp hq hbc + by_cases hab : P.plane.adjacent a b + · by_cases hac : P.plane.adjacent a c + · simp only [ite_eq_left hab] at hp + simp only [ite_eq_left hac] at hq + exact D.incident_ports_distinct a b c p q hp hq hbc + · simp only [ite_eq_right hac, reduceCtorEq] at hq + · simp only [ite_eq_right hab, reduceCtorEq] at hp + halfArc_homeomorph := by + intro a b p hp + by_cases hab : P.plane.adjacent a b + · simp only [ite_eq_left hab] at hp + rw [ite_eq_left hab] + exact D.halfArc_homeomorph a b p hp + · simp only [ite_eq_right hab, reduceCtorEq] at hp + halfArc_supported := by + intro a b p hp + by_cases hab : P.plane.adjacent a b + · simp only [ite_eq_left hab] at hp ⊢ + exact D.halfArc_supported a b p hp + · simp only [ite_eq_right hab, reduceCtorEq] at hp + incident_halfArc_intersections := by + intro a b c hab hac hbc + simpa only [ite_eq_left hab, ite_eq_left hac] using + D.incident_halfArc_intersections a b c (contact hab) (contact hac) hbc + edgeArc_symmetric := by + intro a b + by_cases hab : P.plane.adjacent a b + · simp only [ite_eq_left hab, ite_eq_left (symmetric hab)] + exact D.edgeArc_symmetric a b + · have hba : ¬ P.plane.adjacent b a := fun h => hab (symmetric h) + simp only [ite_eq_right hab, ite_eq_right hba] + edgeArc_from_halfArcs := by + intro a b p hp + by_cases hab : P.plane.adjacent a b + · simp only [ite_eq_left hab] at hp + simpa only [ite_eq_left hab, ite_eq_left (symmetric hab)] using + D.edgeArc_from_halfArcs a b p hp + · simp only [ite_eq_right hab, reduceCtorEq] at hp + edgeArc_homeomorph := by + intro a b hab + rw [ite_eq_left hab] + exact D.edgeArc_homeomorph a b (contact hab) + edgeArc_intersections := by + intro a b c d hab hcd hne + simpa only [ite_eq_left hab, ite_eq_left hcd] using + D.edgeArc_intersections a b c d (contact hab) (contact hcd) hne + compact_local_finiteness := by + intro K hK + apply (D.compact_local_finiteness K hK).subset + rintro ⟨a, b⟩ ⟨hab, hmeet⟩ + exact ⟨contact hab, by simpa only [ite_eq_left hab] using hmeet⟩ + position_periodic := D.position_periodic + portEdge_periodic := by + intro u a b + by_cases hab : P.plane.adjacent a b + · simpa only [ite_eq_left hab, ite_eq_left ((P.edge_periodic u a b).mpr hab)] using + D.portEdge_periodic u a b + · have hn : ¬ P.plane.adjacent (P.shift u a) (P.shift u b) := by + simpa only [P.edge_periodic] using hab + simp only [ite_eq_right hab, ite_eq_right hn, Finset.image_empty] + port_periodic := by + intro u a b + by_cases hab : P.plane.adjacent a b + · simpa only [ite_eq_left hab, ite_eq_left ((P.edge_periodic u a b).mpr hab)] using + D.port_periodic u a b + · have hn : ¬ P.plane.adjacent (P.shift u a) (P.shift u b) := by + simpa only [P.edge_periodic] using hab + simp only [ite_eq_right hab, ite_eq_right hn, Option.map_none] + halfArc_periodic := by + intro u a b + by_cases hab : P.plane.adjacent a b + · simpa only [ite_eq_left hab, ite_eq_left ((P.edge_periodic u a b).mpr hab)] using + D.halfArc_periodic u a b + · have hn : ¬ P.plane.adjacent (P.shift u a) (P.shift u b) := by + simpa only [P.edge_periodic] using hab + simp only [ite_eq_right hab, ite_eq_right hn, Set.image_empty] + edgeArc_periodic := by + intro u a b + by_cases hab : P.plane.adjacent a b + · simpa only [ite_eq_left hab, ite_eq_left ((P.edge_periodic u a b).mpr hab)] using + D.edgeArc_periodic u a b + · have hn : ¬ P.plane.adjacent (P.shift u a) (P.shift u b) := by + simpa only [P.edge_periodic] using hab + simp only [ite_eq_right hab, ite_eq_right hn, Set.image_empty] + } + (Set.range R.position ∪ {p | ∃ a b, P.plane.adjacent a b ∧ p ∈ R.edgeArc a b}) = + (Set.range D.position ∪ {p | ∃ a b, P.plane.adjacent a b ∧ p ∈ D.edgeArc a b}) ) := by + classical + intro ι P ports D retained_position contact symmetric R + ext x + constructor + · rintro (hx | ⟨a, b, hab, hx⟩) + · exact Or.inl hx + · exact Or.inr ⟨a, b, hab, by simpa only [R, ite_eq_left hab] using hx⟩ + · rintro (hx | ⟨a, b, hab, hx⟩) + · exact Or.inl hx + · exact Or.inr ⟨a, b, hab, by simpa only [R, ite_eq_left hab] using hx⟩ + +private theorem face_frontier : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (f : P.plane.Face), frontier (F.region f) ⊆ Set.range + D.position ∪ {p | ∃ a b, P.plane.adjacent a b ∧ p ∈ D.edgeArc a b} ) := by + classical + intro ι P D F f + rw [F.region_frontier] + rintro x ((hx | hx) | hx) + · exact Or.inr ⟨_, _, P.plane.face_edges f 0 1 (by decide), hx⟩ + · exact Or.inr ⟨_, _, P.plane.face_edges f 1 2 (by decide), hx⟩ + · exact Or.inr ⟨_, _, P.plane.face_edges f 2 0 (by decide), hx⟩ + +private theorem edge_frontier : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : + P3861T1FacialDomains P D), ∀ (f : P.plane.Face), ∀ (a : ι), ∀ (b : ι), + (P.plane.adjacent a b) → ((∃ i, P.plane.faceVertex f i = a) → ((∃ i, + P.plane.faceVertex f i = b) → (D.edgeArc a b ⊆ frontier (F.region f)))) ) := by + classical + intro ι P D F f a b hab ha hb + obtain ⟨i, rfl⟩ := ha + obtain ⟨j, rfl⟩ := hb + intro x hx + rw [F.region_frontier] + fin_cases i <;> fin_cases j + · exact (P.plane.adjacent_irreflexive _ hab).elim + · exact Or.inl (Or.inl hx) + · rw [D.edgeArc_symmetric] at hx + exact Or.inr hx + · rw [D.edgeArc_symmetric] at hx + exact Or.inl (Or.inl hx) + · exact (P.plane.adjacent_irreflexive _ hab).elim + · exact Or.inl (Or.inr hx) + · exact Or.inr hx + · rw [D.edgeArc_symmetric] at hx + exact Or.inl (Or.inr hx) + · exact (P.plane.adjacent_irreflexive _ hab).elim + +private theorem different : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ {a : ι}, ∀ {b : ι}, (P.plane.adjacent a + b) → (P.plane.adjacent b a)) → (∀ (a : ι), ∀ (b : ι), (a ≠ b) → ((¬P.plane.adjacent a + b) → (∀ {c : ι}, ∀ {d : ι}, (P.plane.adjacent c d) → (({a, b} : Set ι) ≠ {c, d})))) ) + := by + classical + intro ι P symmetric a b hab hn c d hcd heq + have hacd : a = c ∨ a = d := by + have hm : a ∈ ({c, d} : Set ι) := heq ▸ (by simp) + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hm + have hbcd : b = c ∨ b = d := by + have hm : b ∈ ({c, d} : Set ι) := heq ▸ (by simp) + simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hm + rcases hacd with hac | had <;> rcases hbcd with hbc | hbd + · exact hab (hac.trans hbc.symm) + · exact hn (by simpa only [hac, hbd] using hcd) + · exact hn (by simpa only [had, hbc] using symmetric hcd) + · exact hab (had.trans hbd.symm) + +private theorem avoid : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), (∀ + {a : ι}, ∀ {b : ι}, (P.plane.adjacent a b) → (P3723T1EdgeContact P a b)) → (∀ + [Nontrivial ι], ∀ (a : ι), ∀ (b : ι), (a ≠ b) → (((FootprintEdges (P.tile a) ∩ + FootprintEdges (P.tile b)).Nonempty) → ((P3723T1EdgeContact P a b) → (∀ (h : + (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) ≃ₜ (↑(D.edgeArc a b) : Type)), ((↑((h : + (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → (↑(D.edgeArc a b) : Type)) ⟨(0 : ℝ), + (by norm_num)⟩) : ℝ × ℝ) = D.position a) → (((↑((h : (↑(Set.Icc + (0 : ℝ) (1 : ℝ)) : Type) → (↑(D.edgeArc a b) : Type)) ⟨(1 : ℝ), + (by norm_num)⟩) : ℝ × ℝ) = D.position b) → ((¬P.plane.adjacent + a b) → ( + let g : Set.Icc (0 : Real) 1 → Real × Real := fun t => h t + (Continuous g) → ((Function.Injective g) → ((∀ {c : ι}, ∀ {d : ι}, (P.plane.adjacent c d) + → (({a, b} : Set ι) ≠ {c, d})) → (∀ t : Set.Icc (0 : Real) 1, 0 < (t : Real) → (t : + Real) < 1 → g t ∉ Set.range D.position ∪ {p | ∃ c d, P.plane.adjacent c d ∧ p ∈ + D.edgeArc c d})))))))))) ) := by + classical + intro ι P D contact this a b hab hcontact saved_contact h hstart hend hn g gc gi different t + ht0 ht1 + have hga : g t ≠ D.position a := by + intro heq + have ht := gi (heq.trans hstart.symm) + have hv : (t : Real) = 0 := congrArg Subtype.val ht + linarith + have hgb : g t ≠ D.position b := by + intro heq + have ht := gi (heq.trans hend.symm) + have hv : (t : Real) = 1 := congrArg Subtype.val ht + linarith + have no_arc (c d : ι) (hcd : P.plane.adjacent c d) : + g t ∉ D.edgeArc c d := by + intro hx + have hm : g t ∈ D.edgeArc a b ∩ D.edgeArc c d := ⟨(h t).property, hx⟩ + rw [D.edgeArc_intersections a b c d saved_contact (contact hcd) + (different hcd)] at hm + obtain ⟨v, hv, heq⟩ := hm + rcases Set.mem_insert_iff.mp hv.1 with rfl | hvb + · exact hga heq.symm + · have hvb' : v = b := Set.mem_singleton_iff.mp hvb + exact hgb (hvb' ▸ heq.symm) + rintro (⟨c, hc⟩ | ⟨c, d, hcd, hx⟩) + · obtain ⟨d, hcd⟩ := (P3767T1VertexEdgeIncidence P.plane c).1 + obtain ⟨hcmap, hc0, _⟩ := D.edgeArc_homeomorph c d (contact hcd) + apply no_arc c d hcd + rw [← hc, ← hc0] + exact (hcmap ⟨0, by norm_num⟩).property + · exact no_arc c d hcd hx + +private theorem hij : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), (a ≠ b) → (∀ (f : + P.plane.Face), ∀ (i : Fin (3 : ℕ)), (P.plane.faceVertex f i = a) → (∀ (j : Fin (3 : + ℕ)), (P.plane.faceVertex f j = b) → (i ≠ j))) ) := by + classical + intro ι P a b hab f i hi j hj heq + exact hab (hi.symm.trans (heq ▸ hj)) + +end ContactRoutingGeometry + +private noncomputable def restrictContactDrawing {ι : Type} (P : PeriodicTileComplex ι) + (ports : P3723T1ContactPorts P) (D : P3723T1AllContactRouting P) + (retained_position : D.position = ports.position) + (contact : ∀ {a b : ι}, P.plane.adjacent a b → P3723T1EdgeContact P a b) + (symmetric : ∀ {a b : ι}, P.plane.adjacent a b → P.plane.adjacent b a) : + PeriodicTileContactRouting P := by + classical + exact { + position := D.position + portEdge := fun a b => if P.plane.adjacent a b then D.portEdge a b else ∅ + port := fun a b => if P.plane.adjacent a b then D.port a b else none + halfArc := fun a b => if P.plane.adjacent a b then D.halfArc a b else ∅ + edgeArc := fun a b => if P.plane.adjacent a b then D.edgeArc a b else ∅ + portEdge_symmetric := by + intro a b + by_cases hab : P.plane.adjacent a b + · simp only [ite_eq_left hab, ite_eq_left (symmetric hab)] + exact D.portEdge_symmetric a b + · have hba : ¬ P.plane.adjacent b a := fun h => hab (symmetric h) + simp only [ite_eq_right hab, ite_eq_right hba] + port_symmetric := by + intro a b + by_cases hab : P.plane.adjacent a b + · simp only [ite_eq_left hab, ite_eq_left (symmetric hab)] + exact D.port_symmetric a b + · have hba : ¬ P.plane.adjacent b a := fun h => hab (symmetric h) + simp only [ite_eq_right hab, ite_eq_right hba] + portEdge_common := by + intro a b hab + simpa only [ite_eq_left hab] using D.portEdge_common a b (contact hab) + portEdge_two := by + intro a b hab + simpa only [ite_eq_left hab] using D.portEdge_two a b (contact hab) + port_midpoint := by + intro a b hab + simpa only [ite_eq_left hab] using D.port_midpoint a b (contact hab) + port_eq_none_iff := by + intro a b + by_cases hab : P.plane.adjacent a b + · have hne : D.port a b ≠ none := ContactRoutingGeometry.hne ι P D contact a b hab + simp only [hne, hab, not_true_eq_false, ite_true] + · simp only [hab, not_false_eq_true, ite_false, eq_self] + nonedge_has_no_portEdge := by + intro a b hab + simp only [ite_eq_right hab] + nonedge_has_no_halfArc := by + intro a b hab + simp only [ite_eq_right hab] + nonedge_has_no_edgeArc := by + intro a b hab + simp only [ite_eq_right hab] + position_in_tile_interior := by + rw [retained_position] + exact ports.position_in_tile_interior + position_injective := by + rw [retained_position] + exact ports.position_injective + incident_ports_distinct := by + intro a b c p q hp hq hbc + by_cases hab : P.plane.adjacent a b + · by_cases hac : P.plane.adjacent a c + · simp only [ite_eq_left hab] at hp + simp only [ite_eq_left hac] at hq + exact D.incident_ports_distinct a b c p q hp hq hbc + · simp only [ite_eq_right hac, reduceCtorEq] at hq + · simp only [ite_eq_right hab, reduceCtorEq] at hp + halfArc_homeomorph := by + intro a b p hp + by_cases hab : P.plane.adjacent a b + · simp only [ite_eq_left hab] at hp + rw [ite_eq_left hab] + exact D.halfArc_homeomorph a b p hp + · simp only [ite_eq_right hab, reduceCtorEq] at hp + halfArc_supported := by + intro a b p hp + by_cases hab : P.plane.adjacent a b + · simp only [ite_eq_left hab] at hp ⊢ + exact D.halfArc_supported a b p hp + · simp only [ite_eq_right hab, reduceCtorEq] at hp + incident_halfArc_intersections := by + intro a b c hab hac hbc + simpa only [ite_eq_left hab, ite_eq_left hac] using + D.incident_halfArc_intersections a b c (contact hab) (contact hac) hbc + edgeArc_symmetric := by + intro a b + by_cases hab : P.plane.adjacent a b + · simp only [ite_eq_left hab, ite_eq_left (symmetric hab)] + exact D.edgeArc_symmetric a b + · have hba : ¬ P.plane.adjacent b a := fun h => hab (symmetric h) + simp only [ite_eq_right hab, ite_eq_right hba] + edgeArc_from_halfArcs := by + intro a b p hp + by_cases hab : P.plane.adjacent a b + · simp only [ite_eq_left hab] at hp + simpa only [ite_eq_left hab, ite_eq_left (symmetric hab)] using + D.edgeArc_from_halfArcs a b p hp + · simp only [ite_eq_right hab, reduceCtorEq] at hp + edgeArc_homeomorph := by + intro a b hab + rw [ite_eq_left hab] + exact D.edgeArc_homeomorph a b (contact hab) + edgeArc_intersections := by + intro a b c d hab hcd hne + simpa only [ite_eq_left hab, ite_eq_left hcd] using + D.edgeArc_intersections a b c d (contact hab) (contact hcd) hne + compact_local_finiteness := by + intro K hK + apply (D.compact_local_finiteness K hK).subset + rintro ⟨a, b⟩ ⟨hab, hmeet⟩ + exact ⟨contact hab, by simpa only [ite_eq_left hab] using hmeet⟩ + position_periodic := D.position_periodic + portEdge_periodic := by + intro u a b + by_cases hab : P.plane.adjacent a b + · simpa only [ite_eq_left hab, ite_eq_left ((P.edge_periodic u a b).mpr hab)] using + D.portEdge_periodic u a b + · have hn : ¬ P.plane.adjacent (P.shift u a) (P.shift u b) := by + simpa only [P.edge_periodic] using hab + simp only [ite_eq_right hab, ite_eq_right hn, Finset.image_empty] + port_periodic := by + intro u a b + by_cases hab : P.plane.adjacent a b + · simpa only [ite_eq_left hab, ite_eq_left ((P.edge_periodic u a b).mpr hab)] using + D.port_periodic u a b + · have hn : ¬ P.plane.adjacent (P.shift u a) (P.shift u b) := by + simpa only [P.edge_periodic] using hab + simp only [ite_eq_right hab, ite_eq_right hn, Option.map_none] + halfArc_periodic := by + intro u a b + by_cases hab : P.plane.adjacent a b + · simpa only [ite_eq_left hab, ite_eq_left ((P.edge_periodic u a b).mpr hab)] using + D.halfArc_periodic u a b + · have hn : ¬ P.plane.adjacent (P.shift u a) (P.shift u b) := by + simpa only [P.edge_periodic] using hab + simp only [ite_eq_right hab, ite_eq_right hn, Set.image_empty] + edgeArc_periodic := by + intro u a b + by_cases hab : P.plane.adjacent a b + · simpa only [ite_eq_left hab, ite_eq_left ((P.edge_periodic u a b).mpr hab)] using + D.edgeArc_periodic u a b + · have hn : ¬ P.plane.adjacent (P.shift u a) (P.shift u b) := by + simpa only [P.edge_periodic] using hab + simp only [ite_eq_right hab, ite_eq_right hn, Set.image_empty] + } + +theorem PeriodicTileContactRoutingRigidity {ι : Type} + (P : PeriodicTileComplex ι) : + ∃ R : PeriodicTileContactRouting P, + (∀ a b, a ≠ b → + ((FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty ↔ + P.plane.adjacent a b)) ∧ + Nonempty (PlaneEmbeddingAgreement P R) := by +-- BODY + classical + obtain ⟨ports⟩ := P3723T1ContactPortsExist P + obtain ⟨D, retained_ports⟩ := P3723T1AllContactDrawingExists P ports + have retained_position : D.position = ports.position := + congrArg P3723T1ContactPorts.position retained_ports + have contact {a b : ι} (hab : P.plane.adjacent a b) : + P3723T1EdgeContact P a b := ContactRoutingGeometry.contact ι P (a := a) (b := b) hab + have symmetric {a b : ι} (hab : P.plane.adjacent a b) : + P.plane.adjacent b a := (P.plane.adjacent_symmetric a b).mp hab + let R := restrictContactDrawing P ports D retained_position contact symmetric + obtain ⟨F⟩ := P3861T1RoutedFacialDomains P D + obtain ⟨disjoint_faces, ⟨O⟩⟩ := P3861T1RoutedFaceOrientation P D F + let : Nontrivial ι := (P3776T1FixedGeometry P.toPeriodicTileCore).1 + have traces : + (Set.range R.position ∪ + {p | ∃ a b, P.plane.adjacent a b ∧ p ∈ R.edgeArc a b}) = + (Set.range D.position ∪ + {p | ∃ a b, P.plane.adjacent a b ∧ p ∈ D.edgeArc a b}) := ContactRoutingGeometry.traces ι + P ports D retained_position contact symmetric + have face_frontier (f : P.plane.Face) := ContactRoutingGeometry.face_frontier ι P D F f + have edge_frontier (f : P.plane.Face) (a b : ι) + (hab : P.plane.adjacent a b) + (ha : ∃ i, P.plane.faceVertex f i = a) + (hb : ∃ i, P.plane.faceVertex f i = b) := ContactRoutingGeometry.edge_frontier ι P D F f a + b hab ha hb + refine ⟨R, ?_, ?_⟩ + · intro a b hab + constructor + · intro hcontact + have saved_contact : P3723T1EdgeContact P a b := ⟨hab, hcontact⟩ + obtain ⟨h, hstart, hend⟩ := D.edgeArc_homeomorph a b saved_contact + by_contra hn + let g : Set.Icc (0 : Real) 1 → Real × Real := fun t => h t + have gc : Continuous g := continuous_subtype_val.comp h.continuous + have gi : Function.Injective g := fun s t hst => + h.injective (Subtype.ext hst) + have different {c d : ι} (hcd : P.plane.adjacent c d) := ContactRoutingGeometry.different ι + P symmetric a b hab hn (c := c) (d := d) hcd + have avoid := ContactRoutingGeometry.avoid ι P D contact a b hab hcontact + saved_contact h hstart hend hn gc gi different + obtain ⟨f, ⟨i, hi⟩, ⟨j, hj⟩, _⟩ := + P3861T1ExtraArcLocalization P D F disjoint_faces a b g gc gi hstart hend avoid + apply hn + have hij : i ≠ j := ContactRoutingGeometry.hij ι P a b hab f i hi j hj + simpa only [hi, hj] using P.plane.face_edges f i j hij + · exact P.adjacent_has_common_edge a b + · refine ⟨{ + fixedOrientation := O + routedLeftFace := O.leftFace + routedLeftSide := fun a b => F.region (O.leftFace a b) + reversed := false + routed_left_incident := O.left_incident + routed_opposite_faces := O.opposite_sides + routed_sides_exhaust_faces := O.sides_exhaust_faces + routed_side_open := fun a b _ => F.region_open (O.leftFace a b) + routed_side_connected := fun a b _ => F.region_connected (O.leftFace a b) + routed_side_avoids_drawing := ?_ + routed_edge_in_side_frontiers := ?_ + routed_opposite_sides := ?_ + routed_side_component := ?_ + same_face_same_side := ?_ + face_side_agreement := ?_ + }⟩ + · intro a b _ + rw [traces] + exact F.region_avoids_trace (O.leftFace a b) + · intro a b hab x hx + have hD : x ∈ D.edgeArc a b := by simpa only [R, restrictContactDrawing, ite_eq_left hab] + using hx + have hD' : x ∈ D.edgeArc b a := by rwa [D.edgeArc_symmetric] + exact ⟨edge_frontier _ a b hab (O.left_incident a b hab).1 + (O.left_incident a b hab).2 hD, + edge_frontier _ b a (symmetric hab) (O.left_incident b a (symmetric hab)).1 + (O.left_incident b a (symmetric hab)).2 hD'⟩ + · intro a b hab + exact disjoint_faces (O.opposite_sides a b hab) + · intro a b _ U _ hU havoid hmeet + apply P3767T1BarrierRegionMaximal (F.region (O.leftFace a b)) _ U + (F.region_open _) _ hU.isPreconnected havoid hmeet + rw [traces] + exact face_frontier _ + · intro a b c d _ _ heq + exact congrArg F.region heq + · intro a b _ + simp + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileCore.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileCore.lean new file mode 100644 index 0000000000..e2598efae6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileCore.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.LatticeFundamentalSet +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation +public import LeanPool.ApollonianSuperharmonic.TileTranslation + +-- [TABLET NODE: PeriodicTileCore] + +/-! +# PeriodicTileCore + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +An area-free periodic tile core consists of a locally finite, +$3$-connected cellular plane triangulation whose vertices index +topological-disk lattice tiles, together with a full-rank sublattice +$L\subseteq\mathbb Z[i]$ and an $L$-action on vertices and faces. It has +finite sets of representatives for lattice-cell cosets and for the edge and +face orbits, and exactly one selected representative for every vertex orbit. +Translation by $u\in L$ translates every indexed +tile by $u$, preserves adjacency, translates the embedded vertex positions, +edge arcs, and face regions by the real vector represented by $u$, and sends +the three vertices of each face to the three vertices of the translated +face. + +For every face $F$ the core selects a lattice vertex $\rho(F)$ common to +the footprints of its three tiles. These selections are $L$-equivariant. +For each ordered pair $F,F'$ of distinct faces incident to one graph edge +$\{a,b\}$, it selects a possibly constant lattice-edge path from $\rho(F)$ +to $\rho(F')$ whose vertices and actual footprint edges lie in the ordinary +intersection of the footprint graphs of the tiles indexed by $a$ and $b$. +The selected path for the reverse ordering is the reversed path, and all +selected paths are $L$-equivariant under termwise translation. +-/ +structure PeriodicTileCore (ι : Type) where +-- BODY + /-- The fixed locally finite cellular plane triangulation. -/ + plane : PlaneTriangulation ι + /-- The literal lattice tile assigned to each graph vertex. -/ + tile : ι → ProtoTile + /-- The full-rank additive lattice of tile periods. -/ + lattice : AddSubgroup GaussianInt + /-- A complete finite set of lattice-cell coset representatives. -/ + latticeReps : Finset GaussianInt + /-- Exactly one representative from each vertex translation orbit. -/ + vertexOrbitReps : Finset ι + /-- A finite family representing every ordered graph edge under translation. -/ + edgeOrbitReps : Finset (ι × ι) + /-- A finite family representing every face under translation. -/ + faceOrbitReps : Finset plane.Face + /-- The action of a period on graph vertices. -/ + shift : lattice → ι → ι + /-- The compatible action of a period on entire faces. -/ + faceShift : lattice → plane.Face → plane.Face + lattice_full_rank : LatticeFundamentalSet lattice latticeReps + tiles_are_disks : ∀ a, LatticeTile (tile a) + shift_zero : ∀ a, shift 0 a = a + shift_add : ∀ u v a, shift (u + v) a = shift u (shift v a) + faceShift_zero : ∀ f, faceShift 0 f = f + faceShift_add : ∀ u v f, + faceShift (u + v) f = faceShift u (faceShift v f) + tile_periodic : ∀ u : lattice, ∀ a, + tile (shift u a) = TileTranslation (tile a) u + edge_periodic : ∀ u : lattice, ∀ a b, + plane.adjacent (shift u a) (shift u b) ↔ plane.adjacent a b + face_vertices_periodic : ∀ u f i, + plane.faceVertex (faceShift u f) i = shift u (plane.faceVertex f i) + position_periodic : ∀ u : lattice, ∀ a, + plane.position (shift u a) = plane.position a + GaussianRealPoint u + edgeArc_periodic : ∀ u : lattice, ∀ a b, + plane.edgeArc (shift u a) (shift u b) = + (fun p => p + GaussianRealPoint u) '' plane.edgeArc a b + faceRegion_periodic : ∀ u : lattice, ∀ f, + plane.faceRegion (faceShift u f) = + (fun p => p + GaussianRealPoint u) '' plane.faceRegion f + vertex_orbit_representatives : ∀ a, ∃! r : ι, + r ∈ vertexOrbitReps ∧ ∃ u : lattice, a = shift u r + edge_orbit_representatives : ∀ a b, plane.adjacent a b → + ∃ r ∈ edgeOrbitReps, ∃ u : lattice, + a = shift u r.1 ∧ b = shift u r.2 + face_orbit_representatives : ∀ f, ∃ r ∈ faceOrbitReps, + ∃ u : lattice, f = faceShift u r + /-- The selected common footprint vertex of the three tiles at each face. -/ + rho : plane.Face → GaussianInt + rho_common : ∀ f i, + rho f ∈ FootprintVertices (tile (plane.faceVertex f i)) + rho_periodic : ∀ u : lattice, ∀ f, + rho (faceShift u f) = rho f + u + /-- + The contained lattice walk joining the selected points of two faces across their common + edge. + -/ + facePath : plane.Face → plane.Face → List GaussianInt + facePath_reverse : ∀ f g, facePath g f = (facePath f g).reverse + facePath_periodic : ∀ u : lattice, ∀ f g, + facePath (faceShift u f) (faceShift u g) = + (facePath f g).map (fun x => x + (u : GaussianInt)) + facePath_spec : ∀ a b, plane.adjacent a b → + ∀ f g, f ≠ g → + (∃ i, plane.faceVertex f i = a) → + (∃ i, plane.faceVertex f i = b) → + (∃ i, plane.faceVertex g i = a) → + (∃ i, plane.faceVertex g i = b) → + (facePath f g).head? = some (rho f) ∧ + (facePath f g).getLast? = some (rho g) ∧ + (∀ x ∈ facePath f g, + x ∈ FootprintVertices (tile a) ∩ FootprintVertices (tile b)) ∧ + ∀ x y : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + facePath f g = l₁ ++ x :: y :: l₂ → + {x, y} ∈ FootprintEdges (tile a) ∩ FootprintEdges (tile b) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileCoverage.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileCoverage.lean new file mode 100644 index 0000000000..c04b6bed86 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileCoverage.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore +public import LeanPool.ApollonianSuperharmonic.P3776T1PlaneMapExists +public import LeanPool.ApollonianSuperharmonic.P3776T1EquivariantDisplacementBound +public import LeanPool.ApollonianSuperharmonic.P3776T1BoundedDisplacementSurjective +public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership + +-- [TABLET NODE: PeriodicTileCoverage] + +/-! +# PeriodicTileCoverage + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem PeriodicTileCoverage {ι : Type} (P : PeriodicTileCore ι) : + ∀ x : LatticeCell, ∃ a : ι, x ∈ (P.tile a).cells := by +-- BODY + obtain ⟨f, hf, hperiodic, himage⟩ := P3776T1PlaneMapExists P + have hbound := P3776T1EquivariantDisplacementBound P.lattice P.latticeReps + P.lattice_full_rank f hf hperiodic + have hsurjective := P3776T1BoundedDisplacementSurjective f hf hbound + intro x + obtain ⟨y, hy⟩ := hsurjective + (GaussianRealPoint x + ((1 / 2, 1 / 2) : Real × Real)) + obtain ⟨a, ha⟩ := himage y + rw [hy] at ha + exact ⟨a, (P3776T1CellCenterMembership (P.tile a) x).mp ha⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileIndexedMultiplicityOne.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileIndexedMultiplicityOne.lean new file mode 100644 index 0000000000..c650e69316 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileIndexedMultiplicityOne.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicTileCoverage +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex + +-- [TABLET NODE: PeriodicTileIndexedMultiplicityOne] + +/-! +# PeriodicTileIndexedMultiplicityOne + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem PeriodicTileIndexedMultiplicityOne {ι : Type} (P : PeriodicTileComplex ι) : + ∀ x : LatticeCell, ∃! a : ι, x ∈ (P.tile a).cells := by +-- BODY + classical + let representative : GaussianInt → GaussianInt := fun x => + Classical.choose (P.lattice_full_rank x) + have representative_spec (x : GaussianInt) : + representative x ∈ P.latticeReps ∧ + x - representative x ∈ P.lattice := + (Classical.choose_spec (P.lattice_full_rank x)).1 + let incidences : Finset (Σ a : ι, LatticeCell) := + P.vertexOrbitReps.sigma (fun a => (P.tile a).cells) + let target : Finset GaussianInt := P.latticeReps + let incidence_map : (Σ a : ι, LatticeCell) → GaussianInt := + fun q => representative q.2 + have map_to_target : Set.MapsTo incidence_map incidences target := by + intro q hq + exact (representative_spec q.2).1 + have target_to_image : Set.MapsTo + (fun x : GaussianInt => x) (target : Set GaussianInt) + (incidence_map '' (incidences : Set (Σ a : ι, LatticeCell))) := by + intro x hx + obtain ⟨a, ha⟩ := PeriodicTileCoverage P.toPeriodicTileCore x + obtain ⟨r, hr, u, hau⟩ := (P.vertex_orbit_representatives a).exists + have htile : P.tile a = TileTranslation (P.tile r) u := by + calc + P.tile a = P.tile (P.shift u r) := congrArg P.tile hau + _ = TileTranslation (P.tile r) u := P.tile_periodic u r + have hmem : x ∈ (TileTranslation (P.tile r) u).cells := by + rw [← htile] + exact ha + obtain ⟨y, hy, hxy⟩ := Finset.mem_image.mp hmem + change y + (u : GaussianInt) = x at hxy + have hyr : y - x ∈ P.lattice := by + have hu : (u : GaussianInt) ∈ P.lattice := u.property + have hneg := P.lattice.neg_mem hu + have : y - x = -u := by + rw [← hxy] + abel + rw [this] + exact hneg + have hrep : representative y = x := by + apply (P.lattice_full_rank y).unique + · exact ⟨(representative_spec y).1, (representative_spec y).2⟩ + · exact ⟨hx, by simpa [sub_eq_add_neg, add_comm] using hyr⟩ + refine ⟨⟨r, y⟩, ?_, ?_⟩ + · exact Finset.mem_sigma.mpr ⟨hr, hy⟩ + · exact hrep + have image_eq : Finset.image incidence_map incidences = target := by + apply Finset.eq_of_subset_of_card_le + · intro z hz + obtain ⟨q, hq, rfl⟩ := Finset.mem_image.mp hz + exact map_to_target hq + · apply Finset.card_le_card_of_injOn (fun x : GaussianInt => x) + (by + intro x hx + obtain ⟨q, hq, hqx⟩ := target_to_image hx + refine Finset.mem_image.mpr ⟨q, hq, ?_⟩ + simpa using hqx) + intro x hx y hy hxy + exact hxy + have map_injective : Set.InjOn incidence_map + (incidences : Set (Σ a : ι, LatticeCell)) := by + apply (Finset.card_image_iff).mp + rw [image_eq] + calc + target.card = ∑ a ∈ P.vertexOrbitReps, (P.tile a).cells.card := by + simpa [target, TileArea] using P.area_balance.symm + _ = incidences.card := by + simp [incidences, Finset.card_sigma] + intro x + obtain ⟨a, ha⟩ := PeriodicTileCoverage P.toPeriodicTileCore x + refine ⟨a, ha, ?_⟩ + intro b hb + obtain ⟨ra, hra, u, hau⟩ := (P.vertex_orbit_representatives a).exists + obtain ⟨rb, hrb, v, hbv⟩ := (P.vertex_orbit_representatives b).exists + have ha' : x ∈ (TileTranslation (P.tile ra) u).cells := by + have htile : P.tile a = TileTranslation (P.tile ra) u := by + calc + P.tile a = P.tile (P.shift u ra) := congrArg P.tile hau + _ = TileTranslation (P.tile ra) u := P.tile_periodic u ra + rw [← htile] + exact ha + have hb' : x ∈ (TileTranslation (P.tile rb) v).cells := by + have htile : P.tile b = TileTranslation (P.tile rb) v := by + calc + P.tile b = P.tile (P.shift v rb) := congrArg P.tile hbv + _ = TileTranslation (P.tile rb) v := P.tile_periodic v rb + rw [← htile] + exact hb + obtain ⟨y, hy, hxy⟩ := Finset.mem_image.mp ha' + obtain ⟨z, hz, hxz⟩ := Finset.mem_image.mp hb' + change y + (u : GaussianInt) = x at hxy + change z + (v : GaussianInt) = x at hxz + have hmap : incidence_map ⟨ra, y⟩ = incidence_map ⟨rb, z⟩ := by + have hrep : representative y = representative z := by + have hyx : y - representative y ∈ P.lattice := (representative_spec y).2 + have hzx : z - representative z ∈ P.lattice := (representative_spec z).2 + have hu : (u : GaussianInt) ∈ P.lattice := u.property + have hv : (v : GaussianInt) ∈ P.lattice := v.property + have hyzmem : y - z ∈ P.lattice := by + have hsub : y - z = (v : GaussianInt) - u := by + calc + y - z = (y + (u : GaussianInt)) - (z + (v : GaussianInt)) + + (v : GaussianInt) - u := by abel + _ = (v : GaussianInt) - u := by rw [hxy, hxz]; abel + rw [hsub] + exact P.lattice.sub_mem hv hu + have hycand : y - representative z ∈ P.lattice := by + have := P.lattice.add_mem hyzmem hzx + convert this using 1; abel + exact (P.lattice_full_rank y).unique + ⟨(representative_spec y).1, hyx⟩ + ⟨(representative_spec z).1, hycand⟩ + exact hrep + have hinc : (⟨ra, y⟩ : Σ a : ι, LatticeCell) = ⟨rb, z⟩ := + map_injective (Finset.mem_sigma.mpr ⟨hra, hy⟩) + (Finset.mem_sigma.mpr ⟨hrb, hz⟩) hmap + have hyz : y = z := congrArg Sigma.snd hinc + have huv : (u : GaussianInt) = v := by + apply add_left_cancel (a := y) + simpa [hyz] using hxy.trans hxz.symm + have hrr : ra = rb := congrArg Sigma.fst hinc + have huv' : u = v := Subtype.ext huv + simp [hau, hbv, huv', hrr] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionClassification.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionClassification.lean new file mode 100644 index 0000000000..6662b9240a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionClassification.lean @@ -0,0 +1,148 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices +public import LeanPool.ApollonianSuperharmonic.FinitePatchTopology +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.LatticeTileDiskUnionInterface +public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileAdjacentContactRegularity +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileContactRoutingRigidity +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.P3963T1DeletedPairExteriorConnected +public import LeanPool.ApollonianSuperharmonic.P3963T1EdgeFreeDiskCorners +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: PeriodicTileIntersectionClassification] + +/-! +# PeriodicTileIntersectionClassification + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem PeriodicTileIntersectionClassification {ι : Type} + (P : PeriodicTileComplex ι) : + (∀ a b : ι, a ≠ b → + (((FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty ↔ + P.plane.adjacent a b) ∧ + ((FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty → + SimpleGridPath + (CommonFootprintEdgeVertices (P.tile a) (P.tile b)) + (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) ∧ + FootprintVertices (P.tile a) ∩ FootprintVertices (P.tile b) = + CommonFootprintEdgeVertices (P.tile a) (P.tile b)) ∧ + (¬ (FootprintEdges (P.tile a) ∩ + FootprintEdges (P.tile b)).Nonempty → + FootprintVertices (P.tile a) ∩ FootprintVertices (P.tile b) = ∅ ∨ + (FootprintVertices (P.tile a) ∩ + FootprintVertices (P.tile b)).Subsingleton))) ∧ + PeriodicTileAdjacentContactRegularity P := by +-- BODY + classical + have hindexed := PeriodicTileIndexedMultiplicityOne P + have adjacentInterface : ∀ a b, P.plane.adjacent a b → + SimpleGridPath + (CommonFootprintEdgeVertices (P.tile a) (P.tile b)) + (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) ∧ + FootprintVertices (P.tile a) ∩ FootprintVertices (P.tile b) = + CommonFootprintEdgeVertices (P.tile a) (P.tile b) := by + intro a b hab + have hne : a ≠ b := by + intro h + subst b + exact P.plane.adjacent_irreflexive a hab + let K : FiniteInducedTilePatch P.plane P.tile := { + indices := {a, b} + unionTile := { cells := (P.tile a).cells ∪ (P.tile b).cells, anchor := 0 } + nonempty := by simp + tile_injective := by + intro c hc d hd heq + obtain ⟨x, hx⟩ := (LatticeTileGridStructure _ (P.tiles_are_disks c)).1.1 + apply (hindexed x).unique hx + simpa [heq] using hx + exact_union := by + intro x + simp only [Finset.mem_union, Finset.mem_insert, Finset.mem_singleton] + constructor + · rintro (hx | hx) + · exact ⟨a, Or.inl rfl, hx⟩ + · exact ⟨b, Or.inr rfl, hx⟩ + · rintro ⟨c, hc, hx⟩ + rcases hc with rfl | rfl + · exact Or.inl hx + · exact Or.inr hx + induced_connected := by + intro c hc d hd + simp only [Finset.mem_insert, Finset.mem_singleton] at hc hd + rcases hc with hc | hc <;> rcases hd with hd | hd + all_goals rw [hc, hd] + · exact ⟨[a], by simp, by simp, by simp, + List.isChain_iff_forall_rel_of_append_cons_cons.mp + (List.isChain_singleton a)⟩ + · exact ⟨[a, b], by simp, by simp, by simp, + List.isChain_iff_forall_rel_of_append_cons_cons.mp + (List.isChain_pair.mpr hab)⟩ + · exact ⟨[b, a], by simp, by simp, by simp, + List.isChain_iff_forall_rel_of_append_cons_cons.mp + (List.isChain_pair.mpr ((P.plane.adjacent_symmetric a b).mp hab))⟩ + · exact ⟨[b], by simp, by simp, by simp, + List.isChain_iff_forall_rel_of_append_cons_cons.mp + (List.isChain_singleton b)⟩ + complement_connected := by + exact P.plane.three_connected {a, b} (by + have hcard := Finset.card_insert_le a ({b} : Finset ι) + simp only [Finset.card_singleton] at hcard + omega) } + have hK : LatticeTile K.unionTile := + FinitePatchTopology P.plane P.tile (PeriodicTileMultiplicityOne P) + hindexed (fun c d _ h => P.adjacent_has_common_edge c d h) K + have hdisjoint : Disjoint (P.tile a).cells (P.tile b).cells := by + apply Finset.disjoint_left.mpr + intro x hxa hxb + exact hne ((hindexed x).unique hxa hxb) + have hinterface := LatticeTileDiskUnionInterface (P.tile a) (P.tile b) K.unionTile + (P.tiles_are_disks a) (P.tiles_are_disks b) hK hdisjoint + (fun x => by simp [K]) (P.adjacent_has_common_edge a b hab) + obtain ⟨x, y, p, hpnodup, hplen, hphead, hplast, hpvertices, hpsteps, hpedges⟩ := + hinterface.2.1 + exact ⟨⟨p, hpnodup, hplen, hpvertices, hpsteps, hpedges⟩, hinterface.1⟩ + obtain ⟨_, hadjacency, _⟩ := PeriodicTileContactRoutingRigidity P + constructor + · intro a b hab + refine ⟨hadjacency a b hab, ?_, ?_⟩ + · intro hedge + exact adjacentInterface a b ((hadjacency a b hab).mp hedge) + · intro hedge + right + have hdisjoint : Disjoint (P.tile a).cells (P.tile b).cells := by + exact Finset.disjoint_left.mpr + (fun x hxa hxb => hab ((hindexed x).unique hxa hxb)) + exact P3963T1EdgeFreeDiskCorners (P.tile a) (P.tile b) + (P.tiles_are_disks a) (P.tiles_are_disks b) hdisjoint hedge + (P3963T1DeletedPairExteriorConnected P a b) + · exact ⟨fun a b hab => (adjacentInterface a b hab).2⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionPaths.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionPaths.lean new file mode 100644 index 0000000000..079aad1018 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionPaths.lean @@ -0,0 +1,640 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileAdjacentContactRegularity +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.P3192T1SimplePathOrientation +public import LeanPool.ApollonianSuperharmonic.P3192T1FourOwnerTriangleExclusion +public import LeanPool.ApollonianSuperharmonic.P3192T1PeriodicIndicesInfinite +public import LeanPool.ApollonianSuperharmonic.P3767T1FixedFaceComponents +public import LeanPool.ApollonianSuperharmonic.P3821T1ThreeArcCircle +public import LeanPool.ApollonianSuperharmonic.P3821T1CircleComponentBound + +-- [TABLET NODE: PeriodicTileIntersectionPaths] + +/-! +# PeriodicTileIntersectionPaths + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace IntersectionPathGeometry + +private theorem hdisjoint : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (u : ι), ∀ (v : ι), (u ≠ v) → (Disjoint + (P.tile u).cells (P.tile v).cells) ) := by + classical + intro ι P u v huv + apply Finset.disjoint_left.mpr + intro x hxu hxv + obtain ⟨w, hw, hunique⟩ := PeriodicTileIndexedMultiplicityOne P x + exact huv ((hunique u hxu).trans (hunique v hxv).symm) + +private theorem face_adjacent : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (f : P.plane.Face), ∀ (u : ι), ∀ (v : ι), + (u ≠ v) → ((∃ i, P.plane.faceVertex f i = u) → ((∃ i, P.plane.faceVertex f i = v) → + (P.plane.adjacent u v))) ) := by + classical + intro ι P f u v huv hu hv + obtain ⟨i, hi⟩ := hu + obtain ⟨j, hj⟩ := hv + have hij : i ≠ j := by + intro h + exact huv (hi.symm.trans (h ▸ hj)) + simpa [hi, hj] using P.plane.face_edges f i j hij + +private theorem face_point : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (f : P.plane.Face), ∀ (u : ι), (∃ i, + P.plane.faceVertex f i = u) → (P.rho f ∈ FootprintVertices (P.tile u)) ) := by + classical + intro ι P f u hu + obtain ⟨i, hi⟩ := hu + simpa [hi] using P.rho_common f i + +private theorem third_vertex : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), ∀ (f : P.plane.Face), + (∃ i, P.plane.faceVertex f i = a) → ((∃ i, P.plane.faceVertex f i = b) → (∃ c : ι, c + ≠ a ∧ c ≠ b ∧ ∃ i, P.plane.faceVertex f i = c)) ) := by + classical + intro ι P a b f hfa hfb + obtain ⟨i, hi⟩ := hfa + obtain ⟨j, hj⟩ := hfb + have hindex : ∀ i j : Fin 3, ∃ k : Fin 3, k ≠ i ∧ k ≠ j := by decide + obtain ⟨k, hki, hkj⟩ := hindex i j + refine ⟨P.plane.faceVertex f k, ?_, ?_, k, rfl⟩ + · intro h + exact hki (P.plane.face_vertices_distinct f (h.trans hi.symm)) + · intro h + exact hkj (P.plane.face_vertices_distinct f (h.trans hj.symm)) + +private theorem hgc : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (g : P.plane.Face), ∀ (c : ι), ∀ (d : ι), + (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex g i = d) → ((c = d) → (∃ i, + P.plane.faceVertex g i = c)) ) := by + classical + intro ι P g c d hgd hcd + obtain ⟨i, hi⟩ := hgd + exact ⟨i, hi.trans hcd.symm⟩ + +private theorem triangle_boundary : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), (a ≠ b) → (∀ (c : ι), + (c ≠ a) → ((c ≠ b) → ( + let J := P.plane.edgeArc a b ∪ P.plane.edgeArc b c ∪ P.plane.edgeArc c a + ∀ (h : P.plane.Face), (∃ i, P.plane.faceVertex h i = a) → ((∃ i, P.plane.faceVertex h i = + b) → ((∃ i, P.plane.faceVertex h i = c) → (frontier (P.plane.faceRegion h) = J)))))) + ) := by + classical + intro ι P a b hab c hca hcb J h hha hhb hhc + obtain ⟨i, hi⟩ := hha + obtain ⟨j, hj⟩ := hhb + obtain ⟨k, hk⟩ := hhc + have hij : i ≠ j := by + intro heq + exact hab (hi.symm.trans (heq ▸ hj)) + have hik : i ≠ k := by + intro heq + exact hca (hk.symm.trans (heq.symm ▸ hi)) + have hjk : j ≠ k := by + intro heq + exact hcb (hk.symm.trans (heq.symm ▸ hj)) + have hfin0 : (⟨0, by decide⟩ : Fin 3) = 0 := rfl + have hfin1 : (⟨1, by decide⟩ : Fin 3) = 1 := rfl + have hfin2 : (⟨2, by decide⟩ : Fin 3) = 2 := rfl + rw [P.plane.face_boundary h] + fin_cases i <;> fin_cases j <;> fin_cases k + all_goals try exact (hij rfl).elim + all_goals try exact (hik rfl).elim + all_goals try exact (hjk rfl).elim + all_goals dsimp only at hi hj hk + all_goals simp only [hfin0, hfin1, hfin2] at hi hj hk + all_goals rw [hi, hj, hk] + all_goals try simp only [P.plane.arc_symmetric b a, P.plane.arc_symmetric a c, + P.plane.arc_symmetric c b] + all_goals dsimp only [J] + all_goals ac_rfl + +private theorem hJtrace : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), ∀ (f : P.plane.Face), + ∀ (c : ι), + let J := P.plane.edgeArc a b ∪ P.plane.edgeArc b c ∪ P.plane.edgeArc c a + (frontier (P.plane.faceRegion f) = J) → ((∀ (f : P.plane.Face), Disjoint + (P3767T1FixedTrace P.plane) (P.plane.faceRegion f) ∧ frontier (P.plane.faceRegion + f) ⊆ P3767T1FixedTrace P.plane) → (J ⊆ P3767T1FixedTrace P.plane)) ) := by + classical + intro ι P a b f c J hfrontf htrace + rw [← hfrontf] + exact (htrace f).2 + +private theorem hseparation : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), (a ≠ b) → ((∀ (f : + P.plane.Face), ∀ (u : ι), ∀ (v : ι), (u ≠ v) → ((∃ i, P.plane.faceVertex f i = u) → + ((∃ i, P.plane.faceVertex f i = v) → (P.plane.adjacent u v)))) → ((P.plane.adjacent a + b) → (∀ (f : P.plane.Face), ∀ (g : P.plane.Face), (f ≠ g) → (((∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex f i = a) ∧ ∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = b) → (∀ + (c : ι), (c ≠ a) → ((c ≠ b) → ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = c) → ( + let J := P.plane.edgeArc a b ∪ P.plane.edgeArc b c ∪ P.plane.edgeArc c a + (frontier (P.plane.faceRegion f) = J) → ((∀ (f : P.plane.Face), ∀ (V : Set (ℝ × ℝ)), + IsPreconnected V → Disjoint V (frontier (P.plane.faceRegion f)) → (V ∩ + P.plane.faceRegion f).Nonempty → V ⊆ P.plane.faceRegion f) → ((∀ (h : P.plane.Face), + Disjoint (P.plane.faceRegion h) J) → (∃ U V : Set (Real × Real), IsOpen U ∧ IsOpen V + ∧ IsConnected U ∧ IsConnected V ∧ Disjoint U V ∧ U ∪ V = Jᶜ))))))))))) ) := by + classical + intro ι P a b hab face_adjacent hadj f g hfg hf c hca hcb hfc J hfrontf hmaximal hregion_avoids + obtain ⟨e, he, heJ⟩ := P3821T1ThreeArcCircle P.plane a b c + hab hcb.symm hca hadj + (face_adjacent f b c hcb.symm hf.2 hfc) + (face_adjacent f c a hca hfc hf.1) + change Set.range e = J at heJ + have hopen : IsOpen Jᶜ := by + rw [← heJ] + exact (isCompact_range e.continuous).isClosed.isOpen_compl + obtain ⟨x, hxf⟩ := (P.plane.region_connected f).nonempty + obtain ⟨y, hyg⟩ := (P.plane.region_connected g).nonempty + have hx : x ∈ Jᶜ := fun hxJ => + Set.disjoint_left.mp (hregion_avoids f) hxf hxJ + have hy : y ∈ Jᶜ := fun hyJ => + Set.disjoint_left.mp (hregion_avoids g) hyg hyJ + have hcomponent_f : connectedComponentIn Jᶜ x ⊆ P.plane.faceRegion f := by + apply hmaximal f _ isPreconnected_connectedComponentIn + · rw [hfrontf] + apply Set.disjoint_left.mpr + intro w hw hwJ + exact connectedComponentIn_subset Jᶜ x hw hwJ + · exact ⟨x, mem_connectedComponentIn hx, hxf⟩ + have hne : connectedComponentIn Jᶜ x ≠ connectedComponentIn Jᶜ y := by + intro h + have hyx : y ∈ connectedComponentIn Jᶜ x := by + rw [h] + exact mem_connectedComponentIn hy + exact Set.disjoint_left.mp (P.plane.region_disjoint hfg) + (hcomponent_f hyx) hyg + have hbound (w : Real × Real) (hw : w ∈ Jᶜ) : + connectedComponentIn Jᶜ x = connectedComponentIn Jᶜ y ∨ + connectedComponentIn Jᶜ y = connectedComponentIn Jᶜ w ∨ + connectedComponentIn Jᶜ x = connectedComponentIn Jᶜ w := by + have hxe : x ∈ (Set.range e)ᶜ := by simpa only [heJ] using hx + have hye : y ∈ (Set.range e)ᶜ := by simpa only [heJ] using hy + have hwe : w ∈ (Set.range e)ᶜ := by simpa only [heJ] using hw + simpa only [heJ] using P3821T1CircleComponentBound e he x y w hxe hye hwe + refine ⟨connectedComponentIn Jᶜ x, connectedComponentIn Jᶜ y, + hopen.connectedComponentIn, hopen.connectedComponentIn, + isConnected_connectedComponentIn_iff.mpr hx, + isConnected_connectedComponentIn_iff.mpr hy, ?_, ?_⟩ + · apply Set.disjoint_left.mpr + intro w hwx hwy + exact hne ((connectedComponentIn_eq hwx).trans + (connectedComponentIn_eq hwy).symm) + · apply Set.Subset.antisymm + · exact Set.union_subset (connectedComponentIn_subset Jᶜ x) + (connectedComponentIn_subset Jᶜ y) + · intro w hw + rcases hbound w hw with hxy | hyw | hxw + · exact (hne hxy).elim + · exact Or.inr (hyw.symm ▸ mem_connectedComponentIn hw) + · exact Or.inl (hxw.symm ▸ mem_connectedComponentIn hw) + +private theorem hside_avoids : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), + let J := P.plane.edgeArc a b ∪ P.plane.edgeArc b c ∪ P.plane.edgeArc c a + ∀ (U : Set (ℝ × ℝ)), ∀ (V : Set (ℝ × ℝ)), (U ∪ V = Jᶜ) → (Disjoint (U ∪ V) J) ) := by + classical + intro ι P a b c J U V hcover + rw [hcover] + exact disjoint_compl_left + +private theorem region_is_side : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), + let J := P.plane.edgeArc a b ∪ P.plane.edgeArc b c ∪ P.plane.edgeArc c a + (∀ (f : P.plane.Face), ∀ (V : Set (ℝ × ℝ)), IsPreconnected V → Disjoint V (frontier + (P.plane.faceRegion f)) → (V ∩ P.plane.faceRegion f).Nonempty → V ⊆ + P.plane.faceRegion f) → ((∀ (h : P.plane.Face), Disjoint (P.plane.faceRegion h) J) → + (∀ (U : Set (ℝ × ℝ)), ∀ (V : Set (ℝ × ℝ)), (IsOpen U) → ((IsOpen V) → ((IsConnected + U) → ((IsConnected V) → ((Disjoint U V) → ((U ∪ V = Jᶜ) → ((Disjoint (U ∪ V) J) → (∀ + (h : P.plane.Face), (frontier (P.plane.faceRegion h) = J) → (P.plane.faceRegion h = U + ∨ P.plane.faceRegion h = V)))))))))) ) := by + classical + intro ι P a b c J hmaximal hregion_avoids U V hU hV hUc hVc hUV hcover hside_avoids h hfront + have hsubset : P.plane.faceRegion h ⊆ U ∪ V := by + rw [hcover] + intro x hx hxJ + exact Set.disjoint_left.mp (hregion_avoids h) hx hxJ + by_cases hmeet : (P.plane.faceRegion h ∩ U).Nonempty + · left + apply Set.Subset.antisymm + · exact (P.plane.region_connected h).isPreconnected.subset_left_of_subset_union + hU hV hUV hsubset hmeet + · apply hmaximal h U hUc.isPreconnected + · rw [hfront] + exact hside_avoids.mono_left Set.subset_union_left + · simpa only [Set.inter_comm] using hmeet + · right + have hmeetV : (P.plane.faceRegion h ∩ V).Nonempty := by + obtain ⟨x, hx⟩ := (P.plane.region_connected h).nonempty + rcases hsubset hx with hxU | hxV + · exact (hmeet ⟨x, hx, hxU⟩).elim + · exact ⟨x, hx, hxV⟩ + apply Set.Subset.antisymm + · apply (P.plane.region_connected h).isPreconnected.subset_left_of_subset_union + hV hU hUV.symm + · simpa only [Set.union_comm] using hsubset + · exact hmeetV + · apply hmaximal h V hVc.isPreconnected + · rw [hfront] + exact hside_avoids.mono_left Set.subset_union_right + · simpa only [Set.inter_comm] using hmeetV + +private theorem hregions_ne : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (f : P.plane.Face), ∀ (g : P.plane.Face), + (f ≠ g) → (P.plane.faceRegion f ≠ P.plane.faceRegion g) ) := by + classical + intro ι P f g hfg heq + obtain ⟨x, hx⟩ := (P.plane.region_connected f).nonempty + exact Set.disjoint_left.mp (P.plane.region_disjoint hfg) hx (heq ▸ hx) + +private theorem hregions : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), ∀ (f : P.plane.Face), + ∀ (g : P.plane.Face), ∀ (c : ι), + let J := P.plane.edgeArc a b ∪ P.plane.edgeArc b c ∪ P.plane.edgeArc c a + (frontier (P.plane.faceRegion f) = J) → ((frontier (P.plane.faceRegion g) = J) → (∀ (U : + Set (ℝ × ℝ)), ∀ (V : Set (ℝ × ℝ)), (U ∪ V = Jᶜ) → ((∀ (h : P.plane.Face), (frontier + (P.plane.faceRegion h) = J) → (P.plane.faceRegion h = U ∨ P.plane.faceRegion h = V)) + → ((P.plane.faceRegion f ≠ P.plane.faceRegion g) → (P.plane.faceRegion f ∪ + P.plane.faceRegion g = Jᶜ))))) ) := by + classical + intro ι P a b f g c J hfrontf hfrontg U V hcover region_is_side hregions_ne + rcases region_is_side f hfrontf with hfU | hfV <;> + rcases region_is_side g hfrontg with hgU | hgV + · exact (hregions_ne (hfU.trans hgU.symm)).elim + · rw [hfU, hgV] + exact hcover + · rw [hfV, hgU, Set.union_comm] + exact hcover + · exact (hregions_ne (hfV.trans hgV.symm)).elim + +private theorem htrace_eq : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), ∀ (f : P.plane.Face), + ∀ (g : P.plane.Face), ∀ (c : ι), + let J := P.plane.edgeArc a b ∪ P.plane.edgeArc b c ∪ P.plane.edgeArc c a + ((P3767T1FixedTrace P.plane)ᶜ = {x : ℝ × ℝ | ∃ (f : P.plane.Face), x ∈ + P.plane.faceRegion f}) → ((∀ (h : P.plane.Face), Disjoint (P.plane.faceRegion h) J) → + ((P.plane.faceRegion f ∪ P.plane.faceRegion g = Jᶜ) → (P3767T1FixedTrace P.plane = + J))) ) := by + classical + intro ι P a b f g c J hexhaust hregion_avoids hregions + have hcompeq : (P3767T1FixedTrace P.plane)ᶜ = Jᶜ := by + rw [hexhaust] + apply Set.Subset.antisymm + · rintro x ⟨h, hx⟩ hxJ + exact Set.disjoint_left.mp (hregion_avoids h) hx hxJ + · intro x hx + rw [← hregions] at hx + rcases hx with hxf | hxg + · exact ⟨f, hxf⟩ + · exact ⟨g, hxg⟩ + simpa only [compl_compl] using + congrArg (fun s : Set (Real × Real) => sᶜ) hcompeq + +private theorem hw : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), + let J := P.plane.edgeArc a b ∪ P.plane.edgeArc b c ∪ P.plane.edgeArc c a + (P3767T1FixedTrace P.plane = J) → (∀ (w : ι), P.plane.position w ∈ J) ) := by + classical + intro ι P a b c J htrace_eq w + rw [← htrace_eq] + exact Or.inl ⟨w, rfl⟩ + +private theorem hcd : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), (a ≠ b) → ((∀ (f : + P.plane.Face), (∃ i, P.plane.faceVertex f i = a) → ((∃ i, P.plane.faceVertex f i = b) + → (∃ c : ι, c ≠ a ∧ c ≠ b ∧ ∃ i, P.plane.faceVertex f i = c))) → ((((FootprintEdges + (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty ↔ P.plane.adjacent a b) ∧ + ((FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty → SimpleGridPath + (CommonFootprintEdgeVertices (P.tile a) (P.tile b)) (FootprintEdges (P.tile a) ∩ + FootprintEdges (P.tile b)) ∧ FootprintVertices (P.tile a) ∩ FootprintVertices (P.tile + b) = CommonFootprintEdgeVertices (P.tile a) (P.tile b)) ∧ (¬(FootprintEdges (P.tile + a) ∩ FootprintEdges (P.tile b)).Nonempty → FootprintVertices (P.tile a) ∩ + FootprintVertices (P.tile b) = ∅ ∨ (FootprintVertices (P.tile a) ∩ FootprintVertices + (P.tile b)).Subsingleton)) → (((FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile + b)).Nonempty ↔ P.plane.adjacent a b) → ((P.plane.adjacent a b) → (∀ (f : + P.plane.Face), ∀ (g : P.plane.Face), ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = + a) ∧ ∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = b) → (((∃ (i : Fin (3 : ℕ)), + P.plane.faceVertex g i = a) ∧ ∃ (i : Fin (3 : ℕ)), P.plane.faceVertex g i = b) → ((∀ + (h : P.plane.Face), ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex h i = a) ∧ ∃ (i : Fin + (3 : ℕ)), P.plane.faceVertex h i = b) → h = f ∨ h = g) → (∀ (c : ι), (c ≠ a) → ((c ≠ + b) → ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = c) → (∀ (d : ι), (d ≠ a) → ((d ≠ + b) → ((c = d → ∀ w : ι, w = a ∨ w = b ∨ w = c) → (c ≠ d)))))))))))))) ) := by + classical + intro ι P a b hab third_vertex hclassification hcriterion hadj f g hf hg hfaces c hca hcb hfc d + hda hdb hcellular h + let : Infinite ι := P3192T1PeriodicIndicesInfinite P + obtain ⟨w, hw⟩ := ({a, b, c} : Finset ι).exists_notMem + rcases hcellular h w with rfl | rfl | rfl <;> exact hw (by simp) + +private theorem hxAt393 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (PeriodicTileAdjacentContactRegularity P) → + (∀ (a : ι), ∀ (b : ι), (∀ (f : P.plane.Face), ∀ (u : ι), (∃ i, P.plane.faceVertex f i + = u) → (P.rho f ∈ FootprintVertices (P.tile u))) → ((P.plane.adjacent a b) → (∀ (h : + P.plane.Face), (∃ i, P.plane.faceVertex h i = a) → ((∃ i, P.plane.faceVertex h i = b) + → (P.rho h ∈ CommonFootprintEdgeVertices (P.tile a) (P.tile b)))))) ) := by + classical + intro ι P contact_regular a b face_point hadj h hha hhb + rw [← contact_regular.adjacent_raw_eq_edge_vertices a b hadj] + exact ⟨face_point h a hha, face_point h b hhb⟩ + +private theorem hpoints : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (PeriodicTileAdjacentContactRegularity P) → + (∀ (a : ι), ∀ (b : ι), (a ≠ b) → ((∀ (u : ι), ∀ (v : ι), (u ≠ v) → (Disjoint (P.tile + u).cells (P.tile v).cells)) → ((∀ (f : P.plane.Face), ∀ (u : ι), (∃ i, + P.plane.faceVertex f i = u) → (P.rho f ∈ FootprintVertices (P.tile u))) → (∀ (f : + P.plane.Face), ∀ (g : P.plane.Face), ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = + a) ∧ ∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = b) → (∀ (c : ι), (c ≠ a) → ((c ≠ + b) → ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = c) → (∀ (d : ι), (d ≠ a) → ((d ≠ + b) → ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex g i = d) → ((c ≠ d) → + ((P.plane.adjacent a c) → ((P.plane.adjacent b c) → ((P.rho f ∈ + CommonFootprintEdgeVertices (P.tile a) (P.tile b)) → (P.rho f ≠ P.rho + g))))))))))))))) ) := by + classical + intro ι P contact_regular a b hab hdisjoint face_point f g hf c hca hcb hfc d hda hdb hgd hcd + hfac hfbc hrhof heq + let idx : Fin 4 → ι := ![a, b, c, d] + have hinj : Function.Injective idx := by + intro i j hij + fin_cases i <;> fin_cases j <;> simp_all [idx, ne_comm] + have hnonempty (i : Fin 4) : (P.tile (idx i)).cells.Nonempty := + (LatticeTileGridStructure _ (P.tiles_are_disks (idx i))).1.1 + have hdis (i j : Fin 4) (hij : i ≠ j) : + Disjoint (P.tile (idx i)).cells (P.tile (idx j)).cells := + hdisjoint _ _ (fun h => hij (hinj h)) + have hraw (i : Fin 4) : P.rho f ∈ FootprintVertices (P.tile (idx i)) := by + fin_cases i + · exact face_point f a hf.1 + · exact face_point f b hf.2 + · exact face_point f c hfc + · change P.rho f ∈ FootprintVertices (P.tile d) + rw [heq] + exact face_point g d hgd + apply P3192T1FourOwnerTriangleExclusion (fun i => P.tile (idx i)) + (P.rho f) hnonempty hdis hraw + refine ⟨hrhof, ?_, ?_⟩ + · change P.rho f ∈ CommonFootprintEdgeVertices (P.tile b) (P.tile c) + rw [← contact_regular.adjacent_raw_eq_edge_vertices b c hfbc] + exact ⟨face_point f b hf.2, face_point f c hfc⟩ + · change P.rho f ∈ CommonFootprintEdgeVertices (P.tile c) (P.tile a) + rw [← contact_regular.adjacent_raw_eq_edge_vertices c a + ((P.plane.adjacent_symmetric a c).mp hfac)] + exact ⟨face_point f c hfc, face_point f a hf.1⟩ + +private theorem third_owner_degree : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), (a ≠ b) → ((∀ (u : ι), + ∀ (v : ι), (u ≠ v) → (Disjoint (P.tile u).cells (P.tile v).cells)) → (∀ (z : ι), (z ≠ + a) → ((z ≠ b) → (∀ (x : GaussianInt), (x ∈ FootprintVertices (P.tile z)) → (∀ e f : + Finset GaussianInt, x ∈ e → x ∈ f → e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges + (P.tile b) → f ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b) → e = f))))) ) + := by + classical + intro ι P a b hab hdisjoint z hza hzb x hx + have hzne : (P.tile z).cells.Nonempty := + (LatticeTileGridStructure _ (P.tiles_are_disks z)).1.1 + have hincident : + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (P.tile z).cells := by + simp only [FootprintVertices, hzne, ite_true, Set.mem_ofPred_eq] at hx + rcases hx with ⟨c, hc, h | h | h | h⟩ + · refine ⟨0, ?_⟩ + simpa [LatticeVertexIncidentCell] using h ▸ hc + · refine ⟨1, ?_⟩ + subst x + convert hc using 1; simp [LatticeVertexIncidentCell] + · refine ⟨3, ?_⟩ + subst x + convert hc using 1; simp [LatticeVertexIncidentCell] + · refine ⟨2, ?_⟩ + change x - 1 - ⟨0, 1⟩ ∈ (P.tile z).cells + rw [h] + convert hc using 1 + ext <;> simp + intro e f hxe hxf he hf + by_contra hne + have hcover := (LocalLatticeInterfaceSectors.2 (P.tile a) (P.tile b) x + (P.tiles_are_disks a) (P.tiles_are_disks b) (hdisjoint a b hab) + ⟨e, f, hne, hxe, hxf, he, hf⟩).1 + obtain ⟨j, hj⟩ := hincident + rcases hcover j with h | h + · exact Finset.disjoint_left.mp (hdisjoint a z hza.symm) h hj + · exact Finset.disjoint_left.mp (hdisjoint b z hzb.symm) h hj + +end IntersectionPathGeometry + +theorem PeriodicTileIntersectionPaths {ι : Type} (P : PeriodicTileComplex ι) + (contact_regular : PeriodicTileAdjacentContactRegularity P) + (a b : ι) (hab : a ≠ b) : + ((P.plane.adjacent a b ∧ + ∃ f g : P.plane.Face, f ≠ g ∧ + ((∃ i, P.plane.faceVertex f i = a) ∧ + (∃ i, P.plane.faceVertex f i = b)) ∧ + ((∃ i, P.plane.faceVertex g i = a) ∧ + (∃ i, P.plane.faceVertex g i = b)) ∧ + (∀ h : P.plane.Face, + ((∃ i, P.plane.faceVertex h i = a) ∧ + (∃ i, P.plane.faceVertex h i = b)) → h = f ∨ h = g) ∧ + SimpleGridPathBetween + (CommonFootprintEdgeVertices (P.tile a) (P.tile b)) + (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) + (P.rho f) (P.rho g)) ↔ + (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty) ∧ + ((FootprintVertices (P.tile a) ∩ + FootprintVertices (P.tile b)).Nonempty → + (P.plane.adjacent a b ∧ + ∃ f g : P.plane.Face, f ≠ g ∧ + ((∃ i, P.plane.faceVertex f i = a) ∧ + (∃ i, P.plane.faceVertex f i = b)) ∧ + ((∃ i, P.plane.faceVertex g i = a) ∧ + (∃ i, P.plane.faceVertex g i = b)) ∧ + (∀ h : P.plane.Face, + ((∃ i, P.plane.faceVertex h i = a) ∧ + (∃ i, P.plane.faceVertex h i = b)) → h = f ∨ h = g) ∧ + SimpleGridPathBetween + (CommonFootprintEdgeVertices (P.tile a) (P.tile b)) + (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) + (P.rho f) (P.rho g)) ∨ + (¬ P.plane.adjacent a b ∧ + FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b) = ∅)) := by +-- BODY + classical + have hdisjoint (u v : ι) (huv : u ≠ v) := IntersectionPathGeometry.hdisjoint ι P u v huv + have face_adjacent (f : P.plane.Face) (u v : ι) (huv : u ≠ v) + (hu : ∃ i, P.plane.faceVertex f i = u) + (hv : ∃ i, P.plane.faceVertex f i = v) := IntersectionPathGeometry.face_adjacent ι P f u v + huv hu hv + have face_point (f : P.plane.Face) (u : ι) + (hu : ∃ i, P.plane.faceVertex f i = u) := IntersectionPathGeometry.face_point ι P f u hu + have third_vertex (f : P.plane.Face) + (hfa : ∃ i, P.plane.faceVertex f i = a) + (hfb : ∃ i, P.plane.faceVertex f i = b) := IntersectionPathGeometry.third_vertex ι P a b f + hfa hfb + have hclassification := (PeriodicTileIntersectionClassification P).1 a b hab + have hcriterion := hclassification.1 + have adjacent_package (hadj : P.plane.adjacent a b) : + ∃ f g : P.plane.Face, f ≠ g ∧ + ((∃ i, P.plane.faceVertex f i = a) ∧ + (∃ i, P.plane.faceVertex f i = b)) ∧ + ((∃ i, P.plane.faceVertex g i = a) ∧ + (∃ i, P.plane.faceVertex g i = b)) ∧ + (∀ h : P.plane.Face, + ((∃ i, P.plane.faceVertex h i = a) ∧ + (∃ i, P.plane.faceVertex h i = b)) → h = f ∨ h = g) ∧ + SimpleGridPathBetween + (CommonFootprintEdgeVertices (P.tile a) (P.tile b)) + (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) + (P.rho f) (P.rho g) := by + obtain ⟨f, g, hfg, hf, hg, hfaces⟩ := P.plane.every_edge_two_faces a b hadj + obtain ⟨c, hca, hcb, hfc⟩ := third_vertex f hf.1 hf.2 + obtain ⟨d, hda, hdb, hgd⟩ := third_vertex g hg.1 hg.2 + have hcellular : c = d → ∀ w : ι, w = a ∨ w = b ∨ w = c := by + intro hcd + let : Nontrivial ι := ⟨⟨a, b, hab⟩⟩ + have hgc := IntersectionPathGeometry.hgc ι P g c d hgd hcd + let J := P.plane.edgeArc a b ∪ P.plane.edgeArc b c ∪ P.plane.edgeArc c a + have triangle_boundary (h : P.plane.Face) + (hha : ∃ i, P.plane.faceVertex h i = a) + (hhb : ∃ i, P.plane.faceVertex h i = b) + (hhc : ∃ i, P.plane.faceVertex h i = c) := IntersectionPathGeometry.triangle_boundary ι + P a b hab c hca hcb h hha hhb hhc + have hfrontf := triangle_boundary f hf.1 hf.2 hfc + have hfrontg := triangle_boundary g hg.1 hg.2 hgc + obtain ⟨htrace, hmaximal, hexhaust⟩ := P3767T1FixedFaceComponents P.plane + have hJtrace := IntersectionPathGeometry.hJtrace ι P a b f c hfrontf htrace + have hregion_avoids (h : P.plane.Face) : + Disjoint (P.plane.faceRegion h) J := + (htrace h).1.symm.mono_right hJtrace + have hseparation := IntersectionPathGeometry.hseparation ι P a b hab face_adjacent hadj f g + hfg hf c hca hcb hfc hfrontf hmaximal hregion_avoids + obtain ⟨U, V, hU, hV, hUc, hVc, hUV, hcover⟩ := hseparation + have hside_avoids := IntersectionPathGeometry.hside_avoids ι P a b c U V hcover + have region_is_side (h : P.plane.Face) + (hfront : frontier (P.plane.faceRegion h) = J) := + IntersectionPathGeometry.region_is_side ι P a b c hmaximal hregion_avoids U V hU hV + hUc hVc hUV hcover hside_avoids h hfront + have hregions_ne := IntersectionPathGeometry.hregions_ne ι P f g hfg + have hregions := IntersectionPathGeometry.hregions ι P a b f g c hfrontf hfrontg U V hcover + region_is_side hregions_ne + have htrace_eq := IntersectionPathGeometry.htrace_eq ι P a b f g c hexhaust hregion_avoids + hregions + intro w + have hw := IntersectionPathGeometry.hw ι P a b c htrace_eq w + rcases hw with (hw | hw) | hw + · rcases (P3767T1VertexEdgeIncidence P.plane w).2 a b hadj hw with ha | hb + · exact Or.inl ha + · exact Or.inr (Or.inl hb) + · rcases (P3767T1VertexEdgeIncidence P.plane w).2 b c + (face_adjacent f b c hcb.symm hf.2 hfc) hw with hb | hc + · exact Or.inr (Or.inl hb) + · exact Or.inr (Or.inr hc) + · rcases (P3767T1VertexEdgeIncidence P.plane w).2 c a + (face_adjacent f c a hca hfc hf.1) hw with hc | ha + · exact Or.inr (Or.inr hc) + · exact Or.inl ha + have hcd := IntersectionPathGeometry.hcd ι P a b hab third_vertex hclassification hcriterion + hadj f g hf hg hfaces c hca hcb hfc d hda hdb hcellular + have hfac := face_adjacent f a c hca.symm hf.1 hfc + have hfbc := face_adjacent f b c hcb.symm hf.2 hfc + have hx (h : P.plane.Face) + (hha : ∃ i, P.plane.faceVertex h i = a) + (hhb : ∃ i, P.plane.faceVertex h i = b) := IntersectionPathGeometry.hxAt393 ι P + contact_regular a b face_point hadj h hha hhb + have hrhof := hx f hf.1 hf.2 + have hrhog := hx g hg.1 hg.2 + have hpoints := IntersectionPathGeometry.hpoints ι P contact_regular a b hab hdisjoint + face_point f g hf c hca hcb hfc d hda hdb hgd hcd hfac hfbc hrhof + have third_owner_degree (z : ι) (hza : z ≠ a) (hzb : z ≠ b) + (x : GaussianInt) (hx : x ∈ FootprintVertices (P.tile z)) := + IntersectionPathGeometry.third_owner_degree ι P a b hab hdisjoint z hza hzb x hx + have hdegreef := third_owner_degree c hca hcb (P.rho f) (face_point f c hfc) + have hdegreeg := third_owner_degree d hda hdb (P.rho g) (face_point g d hgd) + refine ⟨f, g, hfg, hf, hg, hfaces, ?_⟩ + exact P3192T1SimplePathOrientation _ _ (P.rho f) (P.rho g) + (hclassification.2.1 (hcriterion.mpr hadj)).1 + hrhof hrhog hpoints hdegreef hdegreeg + constructor + · constructor + · intro hp + exact hcriterion.mpr hp.1 + · intro he + have hadj := hcriterion.mp he + exact ⟨hadj, adjacent_package hadj⟩ + · intro _ + by_cases he : (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty + · have hadj := hcriterion.mp he + exact Or.inl ⟨hadj, adjacent_package hadj⟩ + · exact Or.inr ⟨fun hadj => he (hcriterion.mpr hadj), + Set.not_nonempty_iff_eq_empty.mp he⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileMultiplicityOne.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileMultiplicityOne.lean new file mode 100644 index 0000000000..0e4739e3ea --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileMultiplicityOne.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ExactTileTiling +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne + +-- [TABLET NODE: PeriodicTileMultiplicityOne] + +/-! +# PeriodicTileMultiplicityOne + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem PeriodicTileMultiplicityOne {ι : Type} (P : PeriodicTileComplex ι) : + ExactTileTiling (Set.range P.tile) := by +-- BODY + unfold ExactTileTiling + constructor + · intro T hT + obtain ⟨a, rfl⟩ := hT + exact P.tiles_are_disks a + · intro x + obtain ⟨a, ha, hunique⟩ := PeriodicTileIndexedMultiplicityOne P x + refine ⟨P.tile a, ⟨a, rfl⟩, ha, ?_⟩ + intro U hU hu + obtain ⟨b, rfl⟩ := hU + exact congrArg P.tile (hunique b hu) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean new file mode 100644 index 0000000000..110a8368b7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean @@ -0,0 +1,2142 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.ExactTileTiling +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import LeanPool.ApollonianSuperharmonic.PartialOdometer +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.RegularTileFamily +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex +public import LeanPool.ApollonianSuperharmonic.LatticeTileGridEulerCount +public import LeanPool.ApollonianSuperharmonic.QuadraticAffineLaplacian +public import LeanPool.ApollonianSuperharmonic.RealLaplacianLinearity +public import LeanPool.ApollonianSuperharmonic.IntegerLaplacianCastBridge +public import LeanPool.ApollonianSuperharmonic.FiniteSquareIncidenceIdentities + +-- [TABLET NODE: PeriodicTileTotalIndegree] + +/-! +# PeriodicTileTotalIndegree + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PeriodicIndegreeGeometry + +private theorem hordered : + (by + classical + exact + ∀ (D : Finset GaussianInt), ((D.product D).filter fun (e : GaussianInt × GaussianInt) => + FourNeighborAdjacent e.1 e.2).card = 2 * ((D.filter fun z => z + 1 ∈ D).card + + (D.filter fun z => z + (⟨0, 1⟩ : GaussianInt) ∈ D).card) ) := by + classical + intro D + let I : GaussianInt := ⟨0, 1⟩ + have hstep (s : GaussianInt) : + ((D.product D).filter fun e => e.2 = e.1 + s).card = + (D.filter fun z => z + s ∈ D).card := by + apply Finset.card_bij (fun e _ => e.1) + · intro e he + rcases Finset.mem_filter.mp he with ⟨heD, heq⟩ + rcases Finset.mem_product.mp heD with ⟨hfirst, hsecond⟩ + exact Finset.mem_filter.mpr ⟨hfirst, heq ▸ hsecond⟩ + · intro a ha b hb hab + apply Prod.ext hab + rw [(Finset.mem_filter.mp ha).2, (Finset.mem_filter.mp hb).2, hab] + · intro z hz + rcases Finset.mem_filter.mp hz with ⟨hzD, hzs⟩ + exact ⟨(z, z + s), by simp [hzD, hzs], rfl⟩ + have hreverse (s : GaussianInt) : + (D.filter fun z => z + (-s) ∈ D).card = + (D.filter fun z => z + s ∈ D).card := by + apply Finset.card_bij (fun z _ => z - s) + · intro z hz + rcases Finset.mem_filter.mp hz with ⟨hzD, hzs⟩ + exact Finset.mem_filter.mpr + ⟨by simpa [sub_eq_add_neg] using hzs, by simpa using hzD⟩ + · intro a ha b hb hab + have hab' := congrArg (fun z : GaussianInt => z + s) hab + simpa using hab' + · intro z hz + rcases Finset.mem_filter.mp hz with ⟨hzD, hzs⟩ + exact ⟨z + s, by simp [hzD, hzs], by simp⟩ + have hpoint (e : GaussianInt × GaussianInt) : + (if FourNeighborAdjacent e.1 e.2 then 1 else 0 : Nat) = + (if e.2 = e.1 + 1 then 1 else 0) + + (if e.2 = e.1 + (-1) then 1 else 0) + + (if e.2 = e.1 + I then 1 else 0) + + (if e.2 = e.1 + (-I) then 1 else 0) := by + rcases e with ⟨x, y⟩ + simp only [FourNeighborAdjacent, sub_eq_add_neg] + split_ifs <;> simp_all [I, Zsqrtd.ext_iff] + have hsum := Finset.sum_congr (s₁ := D.product D) rfl (fun e _ => hpoint e) + simp only [Finset.sum_add_distrib] at hsum + simp only [← Finset.card_filter] at hsum + rw [hstep 1, hstep (-1), hstep I, hstep (-I), hreverse 1, hreverse I] at hsum + change _ = 2 * ((D.filter fun z => z + 1 ∈ D).card + + (D.filter fun z => z + I ∈ D).card) + omega + +private theorem hcornerCount : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + ∀ (z : GaussianInt), cornerBag.count z = (if z ∈ T.cells then 1 else 0) + (if z - 1 ∈ + T.cells then 1 else 0) + (if z - I ∈ T.cells then 1 else 0) + (if z - 1 - I ∈ T.cells + then 1 else 0) ) := by + classical + intro T I cornerBag z + dsimp only [cornerBag] + rw [Multiset.count_bind, ← Finset.sum_eq_multiset_sum] + simp only [Multiset.coe_count, List.count_cons, beq_iff_eq, + List.count_nil] + have h11 : ∀ c : GaussianInt, (c + 1 + I = z) ↔ (c = z - 1 - I) := by + intro c + constructor <;> intro h + · rw [← h]; ring + · rw [h]; ring + have hI : ∀ c : GaussianInt, (c + I = z) ↔ (c = z - I) := by + intro c + constructor <;> intro h + · rw [← h]; ring + · rw [h]; ring + have h1 : ∀ c : GaussianInt, (c + 1 = z) ↔ (c = z - 1) := by + intro c + constructor <;> intro h + · rw [← h]; ring + · rw [h]; ring + simp_rw [h11, hI, h1] + simp only [Finset.sum_add_distrib, zero_add] + rw [Finset.sum_ite_eq', Finset.sum_ite_eq', Finset.sum_ite_eq', + Finset.sum_ite_eq'] + omega + +private theorem hfull_not_boundary : + (by + classical + exact + ∀ (T : ProtoTile), (T.cells.Nonempty) → ( + let I : GaussianInt := ⟨0, 1⟩ + ∀ (z : GaussianInt), (z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - I ∈ T.cells ∧ + z - 1 - I ∈ T.cells) → (z ∉ BoundaryFootprintVertices T)) ) := by + classical + intro T hcells I z hz hb + rw [BoundaryFootprintVertices, ite_eq_left hcells] at hb + rcases hb with ⟨e, ⟨w, (⟨rfl, hw⟩ | ⟨rfl, hw⟩)⟩, hze⟩ + · simp only [Finset.mem_insert, Finset.mem_singleton] at hze + rcases hze with rfl | rfl + · rcases hw with hw | hw + · exact hw.2 hz.2.2.1 + · exact hw.1 hz.1 + · have hleft : w + 1 - 1 = w := by ring + have hlow : w + 1 - 1 - I = w - I := by ring + rcases hw with hw | hw + · apply hw.2 + simpa only [hlow, I] using hz.2.2.2 + · apply hw.1 + simpa only [hleft] using hz.2.1 + · simp only [Finset.mem_insert, Finset.mem_singleton] at hze + rcases hze with rfl | rfl + · rcases hw with hw | hw + · exact hw.2 hz.2.1 + · exact hw.1 hz.1 + · have hlow : w + I - I = w := by ring + have hleft : w + I - 1 - I = w - 1 := by ring + rcases hw with hw | hw + · apply hw.2 + simpa only [I, hleft] using hz.2.2.2 + · apply hw.1 + simpa only [I, hlow] using hz.2.2.1 + +private theorem hN4 : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (D : Finset GaussianInt), (∀ (z : GaussianInt), z ∈ D ↔ z ∈ + FootprintVertices T ∧ z ∉ BoundaryFootprintVertices T) → ((∀ z ∈ FootprintVertices T, + z ∉ BoundaryFootprintVertices T → z ∈ T.cells ∧ z - (1 : GaussianInt) ∈ T.cells ∧ z - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells ∧ z - (1 : GaussianInt) - (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ∈ T.cells) → ((T.cells.Nonempty) → ( + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let N : Nat → Nat := fun k => + (cornerBag.toFinset.filter fun z => cornerBag.count z = k).card + (∀ (z : GaussianInt), cornerBag.count z = (if z ∈ T.cells then 1 else 0) + (if z - 1 ∈ + T.cells then 1 else 0) + (if z - I ∈ T.cells then 1 else 0) + (if z - 1 - I ∈ T.cells + then 1 else 0)) → ((∀ (z : GaussianInt), (z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - I ∈ + T.cells ∧ z - 1 - I ∈ T.cells) → (z ∉ BoundaryFootprintVertices T)) → (D.card = N + 4))))) ) := by + classical + intro T D hDmem hsectorAll hcells I cornerBag N hcornerCount hfull_not_boundary + have hs : D = cornerBag.toFinset.filter fun z => cornerBag.count z = 4 := by + ext z + rw [hDmem, Finset.mem_filter, hcornerCount] + constructor + · rintro ⟨hz, hn⟩ + have hall := hsectorAll z hz hn + have hzbag : z ∈ cornerBag.toFinset := by + rw [Multiset.mem_toFinset, Multiset.mem_bind] + exact ⟨z, hall.1, by simp⟩ + exact ⟨hzbag, by simp only [I] at *; simp [hall.1, hall.2.1, hall.2.2.1, hall.2.2.2]⟩ + · rintro ⟨_, hc⟩ + have hall : z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - I ∈ T.cells ∧ + z - 1 - I ∈ T.cells := by + by_cases h0 : z ∈ T.cells <;> by_cases h1 : z - 1 ∈ T.cells <;> + by_cases hI : z - I ∈ T.cells <;> by_cases h1I : z - 1 - I ∈ T.cells <;> + simp only [h0, h1, hI, h1I, ite_true, ite_false] at hc <;> + norm_num at hc; exact ⟨h0, h1, hI, h1I⟩ + refine ⟨?_, hfull_not_boundary z hall⟩ + rw [FootprintVertices, ite_eq_left hcells] + exact ⟨z, hall.1, Or.inl rfl⟩ + exact congrArg Finset.card hs + +private theorem hvertex_partition : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (D : Finset GaussianInt), ((FootprintVertices T).ncard + Finset.card + T.cells = (FootprintEdges T).ncard + (1 : ℕ)) → ( + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let N : Nat → Nat := fun k => + (cornerBag.toFinset.filter fun z => cornerBag.count z = k).card + ((4 : ℕ) * Finset.card T.cells = N (1 : ℕ) + (2 : ℕ) * N (2 : ℕ) + (3 : ℕ) * N (3 : ℕ) + + (4 : ℕ) * N (4 : ℕ) ∧ (FootprintVertices T).ncard = N (1 : ℕ) + N (2 : ℕ) + N (3 : ℕ) + + N (4 : ℕ) ∧ (2 : ℕ) * (FootprintEdges T).ncard = (4 : ℕ) * Finset.card T.cells + + (BoundaryFootprintEdges T).ncard ∧ (BoundaryFootprintEdges T).ncard = N (1 : ℕ) + N + (2 : ℕ) + N (3 : ℕ)) → ((D.card = N 4) → ((FootprintVertices T).ncard = D.card + + (BoundaryFootprintEdges T).ncard))) ) := by + classical + intro T D heuler I cornerBag N hinc hN4 + omega + +private theorem pair_eq : + (by + classical + exact + ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ {d : GaussianInt}, (({a, + b} : Finset GaussianInt) = {c, d}) → ((a = c ∧ b = d) ∨ (a = d ∧ b = c)) ) := by + classical + intro a b c d h + have hs : ({a, b} : Set GaussianInt) = {c, d} := by + ext x + have hx := congrArg (fun s : Finset GaussianInt => x ∈ s) h + apply Iff.of_eq + change (x = a ∨ x = b) = (x = c ∨ x = d) + simpa only [Finset.mem_insert, Finset.mem_singleton] using hx + exact Set.pair_eq_pair_iff.mp hs + +private theorem edgeOf_injective : + (by + classical + exact + (ProtoTile) → ((Finset GaussianInt) → ( + let I : GaussianInt := ⟨0, 1⟩ + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ {d : GaussianInt}, + (({a, b} : Finset GaussianInt) = {c, d}) → ((a = c ∧ b = d) ∨ (a = d ∧ b = c))) → + (Function.Injective edgeOf))) ) := by + classical + intro T D I edgeOf pair_eq + rintro ⟨z, b⟩ ⟨w, d⟩ h + cases b <;> cases d + · change ({z, z + 1} : Finset GaussianInt) = {w, w + 1} at h + replace h := pair_eq h + rcases h with ⟨h, _⟩ | ⟨h1, h2⟩ + · subst w; rfl + · exfalso + have h1r := congrArg Zsqrtd.re h1 + have h2r := congrArg Zsqrtd.re h2 + norm_num at h1r h2r + omega + · change ({z, z + 1} : Finset GaussianInt) = {w, w + I} at h + replace h := pair_eq h + rcases h with ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> exfalso + · have h1i := congrArg Zsqrtd.im h1 + have h2i := congrArg Zsqrtd.im h2 + dsimp only [I] at h1i h2i + norm_num at h1i h2i + omega + · have h1r := congrArg Zsqrtd.re h1 + have h2r := congrArg Zsqrtd.re h2 + norm_num at h1r h2r + omega + · change ({z, z + I} : Finset GaussianInt) = {w, w + 1} at h + replace h := pair_eq h + rcases h with ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> exfalso + · have h1r := congrArg Zsqrtd.re h1 + have h2r := congrArg Zsqrtd.re h2 + norm_num at h1r h2r + omega + · have h1i := congrArg Zsqrtd.im h1 + have h2i := congrArg Zsqrtd.im h2 + dsimp only [I] at h1i h2i + norm_num at h1i h2i + omega + · change ({z, z + I} : Finset GaussianInt) = {w, w + I} at h + replace h := pair_eq h + rcases h with ⟨h, _⟩ | ⟨h1, h2⟩ + · subst w; rfl + · exfalso + have h1i := congrArg Zsqrtd.im h1 + have h2i := congrArg Zsqrtd.im h2 + dsimp only [I] at h1i h2i + norm_num at h1i h2i + omega + +private theorem hV : + (by + classical + exact + ∀ (T : ProtoTile), (T.cells.Nonempty) → ( + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let V := cornerBag.toFinset + (V : Set GaussianInt) = FootprintVertices T) ) := by + classical + intro T hcells I cornerBag V + ext z + change z ∈ cornerBag.toFinset ↔ z ∈ FootprintVertices T + rw [Multiset.mem_toFinset] + dsimp only [cornerBag, I] + simp [FootprintVertices, hcells] + +private theorem hEV : + (by + classical + exact + ∀ (T : ProtoTile), (T.cells.Nonempty) → (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges + T) → (∀ (z : GaussianInt), (z ∈ e) → (z ∈ FootprintVertices T))) ) := by + classical + intro T hcells e he z hz + rcases he with ⟨c, hc, rfl | rfl | rfl | rfl⟩ + all_goals rw [FootprintVertices, ite_eq_left hcells] + all_goals refine ⟨c, hc, ?_⟩ + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hz + all_goals rcases hz with rfl | rfl <;> simp + +private theorem hEmem : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let V := cornerBag.toFinset + ((V : Set GaussianInt) = FootprintVertices T) → ((∀ (e : Finset GaussianInt), (e ∈ + FootprintEdges T) → (∀ (z : GaussianInt), (z ∈ e) → (z ∈ FootprintVertices T))) → ( + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + ∀ (e : GaussianInt × Bool), e ∈ E ↔ edgeOf e ∈ FootprintEdges T)) ) := by + classical + intro T I cornerBag edgeOf V hV hEV E e + change e ∈ ((V.product (Finset.univ : Finset Bool)).filter + fun q => edgeOf q ∈ FootprintEdges T) ↔ _ + rw [Finset.mem_filter, Finset.product_eq_sprod, Finset.mem_product] + simp only [Finset.mem_univ, and_true] + constructor + · exact And.right + · intro he + refine ⟨?_, he⟩ + have hv := hEV (edgeOf e) he e.1 (by rcases e with ⟨z, b⟩; cases b <;> simp [edgeOf]) + change e.1 ∈ (V : Set GaussianInt) + rw [hV] + exact hv + +private theorem hEset : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let V := cornerBag.toFinset + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + (∀ (e : GaussianInt × Bool), e ∈ E ↔ edgeOf e ∈ FootprintEdges T) → ((E.image edgeOf : + Set (Finset GaussianInt)) = FootprintEdges T) ) := by + classical + intro T I cornerBag edgeOf V E hEmem + ext e + change e ∈ E.image edgeOf ↔ e ∈ FootprintEdges T + rw [Finset.mem_image] + constructor + · rintro ⟨q, hq, rfl⟩ + exact (hEmem q).mp hq + · intro he + have hrep : ∃ q, edgeOf q = e := by + rcases he with ⟨c, hc, rfl | rfl | rfl | rfl⟩ + · exact ⟨(c, false), rfl⟩ + · exact ⟨(c, true), rfl⟩ + · exact ⟨(c + 1, true), rfl⟩ + · refine ⟨(c + I, false), ?_⟩ + change ({c + I, c + I + 1} : Finset GaussianInt) = + {c + I, c + 1 + I} + congr 1; ring + rcases hrep with ⟨q, hq⟩ + exact ⟨q, (hEmem q).mpr (hq.symm ▸ he), hq⟩ + +private theorem hEcard : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + (Function.Injective edgeOf) → ( + let V := cornerBag.toFinset + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + ((E.image edgeOf : Set (Finset GaussianInt)) = FootprintEdges T) → (E.card = + (FootprintEdges T).ncard)) ) := by + classical + intro T I cornerBag edgeOf edgeOf_injective V E hEset + have hh := congrArg Set.ncard hEset + rw [Set.ncard_coe_finset, Finset.card_image_of_injective _ edgeOf_injective] at hh + exact hh + +private theorem hBEsub : + (by + classical + exact + ∀ (T : ProtoTile), + BoundaryFootprintEdges T ⊆ FootprintEdges T ) := by + classical + intro T + let I : GaussianInt := ⟨0, 1⟩ + rintro e ⟨z, (⟨rfl, hz⟩ | ⟨rfl, hz⟩)⟩ + · rcases hz with hz | hz + · exact ⟨z, hz.1, Or.inl rfl⟩ + · refine ⟨z - I, hz.2, Or.inr (Or.inr (Or.inr ?_))⟩ + simp [I, add_comm, add_left_comm, sub_eq_add_neg] + · rcases hz with hz | hz + · exact ⟨z, hz.1, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz.2, Or.inr (Or.inr (Or.inl ?_))⟩ + simp + +private theorem hBEset : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let V := cornerBag.toFinset + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + ((E.image edgeOf : Set (Finset GaussianInt)) = FootprintEdges T) → + ((BoundaryFootprintEdges T ⊆ FootprintEdges T) → ( + let BE := E.filter fun e => edgeOf e ∈ BoundaryFootprintEdges T + (BE.image edgeOf : Set (Finset GaussianInt)) = BoundaryFootprintEdges T)) ) := by + classical + intro T I cornerBag edgeOf V E hEset hBEsub BE + ext e + change e ∈ BE.image edgeOf ↔ e ∈ BoundaryFootprintEdges T + rw [Finset.mem_image] + constructor + · rintro ⟨q, hq, rfl⟩ + exact (Finset.mem_filter.mp hq).2 + · intro he + have hf := hBEsub he + rw [← hEset] at hf + rcases Finset.mem_image.mp hf with ⟨q, hq, rfl⟩ + exact ⟨q, Finset.mem_filter.mpr ⟨hq, he⟩, rfl⟩ + +private theorem hBEcard : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + (Function.Injective edgeOf) → ( + let V := cornerBag.toFinset + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + let BE := E.filter fun e => edgeOf e ∈ BoundaryFootprintEdges T + ((BE.image edgeOf : Set (Finset GaussianInt)) = BoundaryFootprintEdges T) → (BE.card = + (BoundaryFootprintEdges T).ncard)) ) := by + classical + intro T I cornerBag edgeOf edgeOf_injective V E BE hBEset + have hh := congrArg Set.ncard hBEset + rw [Set.ncard_coe_finset, Finset.card_image_of_injective _ edgeOf_injective] at hh + exact hh + +private theorem hApart : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let V := cornerBag.toFinset + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + let BE := E.filter fun e => edgeOf e ∈ BoundaryFootprintEdges T + let A := E.filter fun e => edgeOf e ∉ BoundaryFootprintEdges T + A.card + BE.card = E.card ) := by + classical + intro T I cornerBag edgeOf V E BE A + simpa only [A, BE, not_not] using + Finset.card_filter_add_card_filter_not (s := E) + (fun e => edgeOf e ∉ BoundaryFootprintEdges T) + +private theorem hEocc : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + (Function.Injective edgeOf) → ( + let V := cornerBag.toFinset + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + (∀ (e : GaussianInt × Bool), e ∈ E ↔ edgeOf e ∈ FootprintEdges T) → (∀ (q : GaussianInt × + Bool), q ∈ E ↔ if q.2 then (q.1 ∈ T.cells ∨ q.1 - 1 ∈ T.cells) else (q.1 ∈ T.cells ∨ + q.1 - I ∈ T.cells))) ) := by + classical + intro T I cornerBag edgeOf edgeOf_injective V E hEmem q + rw [hEmem] + constructor + · rintro ⟨c, hc, he | he | he | he⟩ + · have hq : q = (c, false) := edgeOf_injective he + simp [hq, hc] + · have hq : q = (c, true) := edgeOf_injective he + simp [hq, hc] + · have hq : q = (c + 1, true) := edgeOf_injective he + simp [hq, hc] + · have he' : edgeOf q = edgeOf (c + I, false) := by + rw [he] + change ({c + I, c + 1 + I} : Finset GaussianInt) = + {c + I, c + I + 1} + congr 1; ring + have hq := edgeOf_injective he' + simp [hq, hc] + · rcases q with ⟨z, b⟩ + cases b <;> simp only [Bool.false_eq_true, ite_false, ite_true, + ] <;> intro hz + · rcases hz with hz | hz + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + change ({z, z + 1} : Finset GaussianInt) = + {z - I + I, z - I + 1 + I} + congr 1 <;> ring + · rcases hz with hz | hz + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + simp [edgeOf, I] + +private theorem hBEocc : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + (Function.Injective edgeOf) → (∀ (q : GaussianInt × Bool), edgeOf q ∈ + BoundaryFootprintEdges T ↔ if q.2 then ((q.1 ∈ T.cells ∧ q.1 - 1 ∉ T.cells) ∨ (q.1 ∉ + T.cells ∧ q.1 - 1 ∈ T.cells)) else ((q.1 ∈ T.cells ∧ q.1 - I ∉ T.cells) ∨ (q.1 ∉ + T.cells ∧ q.1 - I ∈ T.cells))) ) := by + classical + intro T I edgeOf edgeOf_injective q + constructor + · rintro ⟨z, (⟨he, hz⟩ | ⟨he, hz⟩)⟩ + · have hq : q = (z, false) := edgeOf_injective he + simpa [hq, I] using hz + · have hq : q = (z, true) := edgeOf_injective he + simpa [hq] using hz + · rcases q with ⟨z, b⟩ + cases b <;> simp only [Bool.false_eq_true, ite_false, ite_true, + ] <;> intro hz + · exact ⟨z, Or.inl ⟨rfl, hz⟩⟩ + · exact ⟨z, Or.inr ⟨rfl, hz⟩⟩ + +private theorem hshared : + (by + classical + exact + ∀ (T : ProtoTile), (FourNeighborConnected (↑T.cells : Set LatticeCell) ∧ + NoCheckerboardCellVertex (↑T.cells : Set LatticeCell) ∧ SimpleGridCycle + (BoundaryFootprintVertices T) (BoundaryFootprintEdges T)) → (((∀ (x : LatticeCell), ∀ + (y : LatticeCell), FourNeighborAdjacent x y → x ∈ BoundaryFootprintVertices T → y ∈ + BoundaryFootprintVertices T → ¬OpenLatticeEdge x y ⊆ interior (TileRealization T)) ∧ + (∀ x ∈ FootprintVertices T, ∀ y ∈ FootprintVertices T, FourNeighborAdjacent x y → {x, + y} ∈ FootprintEdges T) ∧ ∀ x ∈ FootprintVertices T, GaussianRealPoint x ∈ interior + (TileRealization T) ↔ x ∉ BoundaryFootprintVertices T) → ( + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let N : Nat → Nat := fun k => + (cornerBag.toFinset.filter fun z => cornerBag.count z = k).card + ((4 : ℕ) * Finset.card T.cells = N (1 : ℕ) + (2 : ℕ) * N (2 : ℕ) + (3 : ℕ) * N (3 : ℕ) + + (4 : ℕ) * N (4 : ℕ) ∧ (FootprintVertices T).ncard = N (1 : ℕ) + N (2 : ℕ) + N (3 : ℕ) + + N (4 : ℕ) ∧ (2 : ℕ) * (FootprintEdges T).ncard = (4 : ℕ) * Finset.card T.cells + + (BoundaryFootprintEdges T).ncard ∧ (BoundaryFootprintEdges T).ncard = N (1 : ℕ) + N + (2 : ℕ) + N (3 : ℕ)) → ( + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let V := cornerBag.toFinset + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + let A := E.filter fun e => edgeOf e ∉ BoundaryFootprintEdges T + (∀ (q : GaussianInt × Bool), q ∈ E ↔ if q.2 then (q.1 ∈ T.cells ∨ q.1 - 1 ∈ T.cells) else + (q.1 ∈ T.cells ∨ q.1 - I ∈ T.cells)) → ((∀ (q : GaussianInt × Bool), edgeOf q ∈ + BoundaryFootprintEdges T ↔ if q.2 then ((q.1 ∈ T.cells ∧ q.1 - 1 ∉ T.cells) ∨ (q.1 ∉ + T.cells ∧ q.1 - 1 ∈ T.cells)) else ((q.1 ∈ T.cells ∧ q.1 - I ∉ T.cells) ∨ (q.1 ∉ + T.cells ∧ q.1 - I ∈ T.cells))) → (∀ (q : GaussianInt × Bool), (q ∈ A) → (if q.2 then + (q.1 ∈ T.cells ∧ q.1 - 1 ∈ T.cells) else (q.1 ∈ T.cells ∧ q.1 - I ∈ T.cells))))))) ) + := by + classical + intro T htiles hreg I cornerBag N hinc edgeOf V E A hEocc hBEocc q hq + rcases Finset.mem_filter.mp hq with ⟨hqe, hqb⟩ + rw [hEocc] at hqe + rw [hBEocc] at hqb + rcases q with ⟨z, b⟩ + cases b <;> simp only [Bool.false_eq_true, ite_false, ite_true, + ] at hqe hqb ⊢ <;> tauto + +private theorem hhorizontal : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + ∀ (x : GaussianInt), (x ∈ T.cells) → ((x - I ∈ T.cells) → (OpenLatticeEdge x (x + 1) ⊆ + interior (TileRealization T))) ) := by + classical + intro T I x hupper hlower + let I : GaussianInt := ⟨0, 1⟩ + let R := Set.Ioo (x.re : Real) ((x.re : Real) + 1) ×ˢ + Set.Ioo ((x.im : Real) - 1) ((x.im : Real) + 1) + have hopen : IsOpen R := isOpen_Ioo.prod isOpen_Ioo + have hsub : R ⊆ TileRealization T := by + intro p hp + rcases hp with ⟨⟨hxl, hxu⟩, ⟨hyl, hyu⟩⟩ + by_cases hside : p.2 ≤ (x.im : Real) + · apply Set.mem_iUnion.mpr + refine ⟨x - I, Set.mem_iUnion.mpr ⟨hlower, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + norm_num [I] + rw [GaussianInt.toComplex_def₂] + change ((x.re : Real) ≤ p.1 ∧ (x.im : Real) ≤ p.2 + 1) ∧ + (p.1 ≤ (x.re : Real) + 1 ∧ p.2 ≤ (x.im : Real)) + constructor <;> constructor <;> linarith + · apply Set.mem_iUnion.mpr + refine ⟨x, Set.mem_iUnion.mpr ⟨hupper, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor <;> constructor <;> linarith + intro p hp + apply hopen.subset_interior_iff.mpr hsub + rcases hp with ⟨t, ht0, ht1, rfl⟩ + norm_num [R, GaussianRealPoint, Prod.smul_fst, Prod.smul_snd, smul_eq_mul] + constructor <;> constructor <;> nlinarith + +private theorem hvertical : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + ∀ (x : GaussianInt), (x ∈ T.cells) → ((x - 1 ∈ T.cells) → (OpenLatticeEdge x (x + I) ⊆ + interior (TileRealization T))) ) := by + classical + intro T I x hright hleft + let R := Set.Ioo ((x.re : Real) - 1) ((x.re : Real) + 1) ×ˢ + Set.Ioo (x.im : Real) ((x.im : Real) + 1) + have hopen : IsOpen R := isOpen_Ioo.prod isOpen_Ioo + have hsub : R ⊆ TileRealization T := by + intro p hp + rcases hp with ⟨⟨hxl, hxu⟩, ⟨hyl, hyu⟩⟩ + by_cases hside : p.1 ≤ (x.re : Real) + · apply Set.mem_iUnion.mpr + refine ⟨x - 1, Set.mem_iUnion.mpr ⟨hleft, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + norm_num + rw [GaussianInt.toComplex_def₂] + change ((x.re : Real) ≤ p.1 + 1 ∧ (x.im : Real) ≤ p.2) ∧ + (p.1 ≤ (x.re : Real) ∧ p.2 ≤ (x.im : Real) + 1) + constructor <;> constructor <;> linarith + · apply Set.mem_iUnion.mpr + refine ⟨x, Set.mem_iUnion.mpr ⟨hright, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor <;> constructor <;> linarith + intro p hp + apply hopen.subset_interior_iff.mpr hsub + rcases hp with ⟨t, ht0, ht1, rfl⟩ + norm_num [R, GaussianRealPoint, Prod.smul_fst, Prod.smul_snd, smul_eq_mul] + constructor <;> constructor <;> nlinarith + +private theorem hedgeOf : + (by + classical + exact + let I : GaussianInt := ⟨0, 1⟩ + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let step : Bool → GaussianInt := fun b => if b then I else 1 + ∀ (q : GaussianInt × Bool), edgeOf q = {q.1, q.1 + step q.2} ) := by + classical + intro I edgeOf step q + rcases q with ⟨z, b⟩ + cases b <;> rfl + +private theorem hAendpoint : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (D : Finset GaussianInt), (∀ (z : GaussianInt), z ∈ D ↔ z ∈ + FootprintVertices T ∧ z ∉ BoundaryFootprintVertices T) → (((∀ (x : LatticeCell), ∀ (y + : LatticeCell), FourNeighborAdjacent x y → x ∈ BoundaryFootprintVertices T → y ∈ + BoundaryFootprintVertices T → ¬OpenLatticeEdge x y ⊆ interior (TileRealization T)) ∧ + (∀ x ∈ FootprintVertices T, ∀ y ∈ FootprintVertices T, FourNeighborAdjacent x y → {x, + y} ∈ FootprintEdges T) ∧ ∀ x ∈ FootprintVertices T, GaussianRealPoint x ∈ interior + (TileRealization T) ↔ x ∉ BoundaryFootprintVertices T) → ( + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let V := cornerBag.toFinset + (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges T) → (∀ (z : GaussianInt), (z ∈ e) → (z + ∈ FootprintVertices T))) → ( + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + (∀ (e : GaussianInt × Bool), e ∈ E ↔ edgeOf e ∈ FootprintEdges T) → ( + let A := E.filter fun e => edgeOf e ∉ BoundaryFootprintEdges T + (∀ (q : GaussianInt × Bool), (q ∈ A) → (if q.2 then (q.1 ∈ T.cells ∧ q.1 - 1 ∈ T.cells) + else (q.1 ∈ T.cells ∧ q.1 - I ∈ T.cells))) → ((∀ (x : GaussianInt), (x ∈ T.cells) → + ((x - I ∈ T.cells) → (OpenLatticeEdge x (x + 1) ⊆ interior (TileRealization T)))) → + ((∀ (x : GaussianInt), (x ∈ T.cells) → ((x - 1 ∈ T.cells) → (OpenLatticeEdge x (x + + I) ⊆ interior (TileRealization T)))) → ( + let step : Bool → GaussianInt := fun b => if b then I else 1 + (∀ (q : GaussianInt × Bool), edgeOf q = {q.1, q.1 + step q.2}) → (∀ (q : GaussianInt × + Bool), (q ∈ A) → (q.1 ∈ D ∨ q.1 + step q.2 ∈ D))))))))) ) := by + classical + intro T D hDmem hreg I cornerBag edgeOf V hEV E hEmem A hshared hhorizontal hvertical step + hedgeOf q hq + have hqe := (Finset.mem_filter.mp hq).1 + have hf := (hEmem q).mp hqe + have hv0 := hEV (edgeOf q) hf q.1 (by rw [hedgeOf]; simp) + have hv1 := hEV (edgeOf q) hf (q.1 + step q.2) (by rw [hedgeOf]; simp) + by_contra hn + have hb0 : q.1 ∈ BoundaryFootprintVertices T := by + by_contra hb + exact hn (Or.inl ((hDmem _).mpr ⟨hv0, hb⟩)) + have hb1 : q.1 + step q.2 ∈ BoundaryFootprintVertices T := by + by_contra hb + exact hn (Or.inr ((hDmem _).mpr ⟨hv1, hb⟩)) + have hocc := hshared q hq + rcases q with ⟨z, b⟩ + cases b + · exact hreg.1 z (z + 1) (Or.inl rfl) hb0 hb1 + (hhorizontal z hocc.1 hocc.2) + · exact hreg.1 z (z + I) (Or.inr (Or.inr (Or.inl rfl))) hb0 hb1 + (hvertical z hocc.1 hocc.2) + +private theorem hDedge_nonboundary : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (D : Finset GaussianInt), (∀ (z : GaussianInt), z ∈ D ↔ z ∈ + FootprintVertices T ∧ z ∉ BoundaryFootprintVertices T) → ((T.cells.Nonempty) → ( + let I : GaussianInt := ⟨0, 1⟩ + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + ∀ (q : GaussianInt × Bool), ∀ (x : GaussianInt), (x ∈ D) → ((x ∈ edgeOf q) → (edgeOf q ∉ + BoundaryFootprintEdges T)))) ) := by + classical + intro T D hDmem hcells I edgeOf q x hx hxe he + apply (hDmem x).mp hx |>.2 + rw [BoundaryFootprintVertices, ite_eq_left hcells] + exact ⟨edgeOf q, he, hxe⟩ + +private theorem hdegree : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (D : Finset GaussianInt), (∀ (z : GaussianInt), z ∈ D ↔ z ∈ + FootprintVertices T ∧ z ∉ BoundaryFootprintVertices T) → ((∀ z ∈ FootprintVertices T, + z ∉ BoundaryFootprintVertices T → z ∈ T.cells ∧ z - (1 : GaussianInt) ∈ T.cells ∧ z - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells ∧ z - (1 : GaussianInt) - (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ∈ T.cells) → ( + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let V := cornerBag.toFinset + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + let A := E.filter fun e => edgeOf e ∉ BoundaryFootprintEdges T + (∀ (q : GaussianInt × Bool), q ∈ E ↔ if q.2 then (q.1 ∈ T.cells ∨ q.1 - 1 ∈ T.cells) else + (q.1 ∈ T.cells ∨ q.1 - I ∈ T.cells)) → ((∀ (q : GaussianInt × Bool), ∀ (x : + GaussianInt), (x ∈ D) → ((x ∈ edgeOf q) → (edgeOf q ∉ BoundaryFootprintEdges T))) → + (∀ (x : GaussianInt), (x ∈ D) → ((A.filter fun q => x ∈ edgeOf q).card = 4))))) ) := by + classical + intro T D hDmem hsectorAll I cornerBag edgeOf V E A hEocc hDedge_nonboundary x hx + have hall := hsectorAll x ((hDmem x).mp hx).1 ((hDmem x).mp hx).2 + let F : Finset (GaussianInt × Bool) := + {(x, false), (x - 1, false), (x, true), (x - I, true)} + have hs : A.filter (fun q => x ∈ edgeOf q) = F := by + ext q + rw [Finset.mem_filter] + constructor + · rintro ⟨hq, hxq⟩ + rcases q with ⟨z, b⟩ + cases b + · change x ∈ ({z, z + 1} : Finset GaussianInt) at hxq + simp only [Finset.mem_insert, Finset.mem_singleton] at hxq + rcases hxq with rfl | rfl <;> simp [F] + · change x ∈ ({z, z + I} : Finset GaussianInt) at hxq + simp only [Finset.mem_insert, Finset.mem_singleton] at hxq + rcases hxq with rfl | rfl <;> simp [F] + · intro hq + have hxq : x ∈ edgeOf q := by + simp only [F, Finset.mem_insert, Finset.mem_singleton] at hq + rcases hq with rfl | rfl | rfl | rfl <;> simp [edgeOf] + refine ⟨Finset.mem_filter.mpr ⟨?_, hDedge_nonboundary q x hx hxq⟩, hxq⟩ + simp only [F, Finset.mem_insert, Finset.mem_singleton] at hq + rcases hq with rfl | rfl | rfl | rfl + all_goals simp [hEocc, I, hall.1, hall.2.1, hall.2.2.1] + rw [hs] + have hre : x.re ≠ x.re - 1 := by omega + have him : x.im ≠ x.im - 1 := by omega + simp [F, I, Zsqrtd.ext_iff, hre, him] + +private theorem hendSum : + (by + classical + exact + ∀ (D : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let step : Bool → GaussianInt := fun b => if b then I else 1 + (∀ (q : GaussianInt × Bool), edgeOf q = {q.1, q.1 + step q.2}) → (∀ (q : GaussianInt × + Bool), (∑ x ∈ D, if x ∈ edgeOf q then 1 else 0 : Nat) = (if q.1 ∈ D then 1 else 0) + + (if q.1 + step q.2 ∈ D then 1 else 0)) ) := by + classical + intro D I edgeOf step hedgeOf q + have hn : q.1 ≠ q.1 + step q.2 := by + rcases q with ⟨z, b⟩ + cases b <;> simp [step, I, Zsqrtd.ext_iff] + have hpoint (x : GaussianInt) : + (if x ∈ edgeOf q then 1 else 0 : Nat) = + (if x = q.1 then 1 else 0) + + (if x = q.1 + step q.2 then 1 else 0) := by + rw [hedgeOf] + simp only [Finset.mem_insert, Finset.mem_singleton] + by_cases h0 : x = q.1 + · subst x + simp only [hn, ite_false, ite_true, true_or] + · by_cases h1 : x = q.1 + step q.2 <;> + simp only [h0, h1, Ne.symm hn, ite_true, ite_false, or_true, or_false, zero_add, + add_zero] + calc + _ = ∑ x ∈ D, ((if x = q.1 then 1 else 0) + + (if x = q.1 + step q.2 then 1 else 0)) := + Finset.sum_congr rfl (fun x _ => hpoint x) + _ = _ := by simp [Finset.sum_add_distrib, Finset.sum_ite_eq'] + +private theorem hdegree_sum : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (D : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let V := cornerBag.toFinset + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + let A := E.filter fun e => edgeOf e ∉ BoundaryFootprintEdges T + let step : Bool → GaussianInt := fun b => if b then I else 1 + (∀ (x : GaussianInt), (x ∈ D) → ((A.filter fun q => x ∈ edgeOf q).card = 4)) → ((∀ (q : + GaussianInt × Bool), (∑ x ∈ D, if x ∈ edgeOf q then 1 else 0 : Nat) = (if q.1 ∈ D + then 1 else 0) + (if q.1 + step q.2 ∈ D then 1 else 0)) → ((∑ q ∈ A, ((if q.1 ∈ D + then 1 else 0) + (if q.1 + step q.2 ∈ D then 1 else 0)) : Nat) = 4 * D.card)) ) := by + classical + intro T D I cornerBag edgeOf V E A step hdegree hendSum + calc + _ = ∑ q ∈ A, ∑ x ∈ D, if x ∈ edgeOf q then 1 else 0 := by + apply Finset.sum_congr rfl + intro q hq + exact (hendSum q).symm + _ = ∑ x ∈ D, ∑ q ∈ A, if x ∈ edgeOf q then 1 else 0 := Finset.sum_comm + _ = ∑ x ∈ D, 4 := by + apply Finset.sum_congr rfl + intro x hx + rw [← Finset.card_filter] + exact hdegree x hx + _ = _ := by simp [Nat.mul_comm] + +private theorem hdegree_count : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (D : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let V := cornerBag.toFinset + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + let A := E.filter fun e => edgeOf e ∉ BoundaryFootprintEdges T + let step : Bool → GaussianInt := fun b => if b then I else 1 + (∀ (q : GaussianInt × Bool), (q ∈ A) → (q.1 ∈ D ∨ q.1 + step q.2 ∈ D)) → (((∑ q ∈ A, ((if + q.1 ∈ D then 1 else 0) + (if q.1 + step q.2 ∈ D then 1 else 0)) : Nat) = 4 * D.card) → ( + let J := A.filter fun q => q.1 ∈ D ∧ q.1 + step q.2 ∈ D + A.card + J.card = 4 * D.card)) ) := by + classical + intro T D I cornerBag edgeOf V E A step hAendpoint hdegree_sum J + have hp (q : GaussianInt × Bool) (hq : q ∈ A) : + ((if q.1 ∈ D then 1 else 0) + + (if q.1 + step q.2 ∈ D then 1 else 0) : Nat) = + 1 + (if q.1 ∈ D ∧ q.1 + step q.2 ∈ D then 1 else 0) := by + rcases hAendpoint q hq with h0 | h1 + · by_cases h1 : q.1 + step q.2 ∈ D <;> simp [h0, h1] + · by_cases h0 : q.1 ∈ D <;> simp [h0, h1] + have hs := Finset.sum_congr (s₁ := A) rfl hp + rw [hdegree_sum] at hs + simp only [Finset.sum_add_distrib, Finset.sum_const, smul_eq_mul, + mul_one, ← Finset.card_filter] at hs + exact hs.symm + +private theorem hJmem : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (D : Finset GaussianInt), (∀ (z : GaussianInt), z ∈ D ↔ z ∈ + FootprintVertices T ∧ z ∉ BoundaryFootprintVertices T) → (((∀ (x : LatticeCell), ∀ (y + : LatticeCell), FourNeighborAdjacent x y → x ∈ BoundaryFootprintVertices T → y ∈ + BoundaryFootprintVertices T → ¬OpenLatticeEdge x y ⊆ interior (TileRealization T)) ∧ + (∀ x ∈ FootprintVertices T, ∀ y ∈ FootprintVertices T, FourNeighborAdjacent x y → {x, + y} ∈ FootprintEdges T) ∧ ∀ x ∈ FootprintVertices T, GaussianRealPoint x ∈ interior + (TileRealization T) ↔ x ∉ BoundaryFootprintVertices T) → ( + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let V := cornerBag.toFinset + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + (∀ (e : GaussianInt × Bool), e ∈ E ↔ edgeOf e ∈ FootprintEdges T) → ( + let A := E.filter fun e => edgeOf e ∉ BoundaryFootprintEdges T + let step : Bool → GaussianInt := fun b => if b then I else 1 + (∀ (q : GaussianInt × Bool), edgeOf q = {q.1, q.1 + step q.2}) → ((∀ (q : GaussianInt × + Bool), ∀ (x : GaussianInt), (x ∈ D) → ((x ∈ edgeOf q) → (edgeOf q ∉ + BoundaryFootprintEdges T))) → ( + let J := A.filter fun q => q.1 ∈ D ∧ q.1 + step q.2 ∈ D + ∀ (q : GaussianInt × Bool), q ∈ J ↔ q.1 ∈ D ∧ q.1 + step q.2 ∈ D))))) ) := by + classical + intro T D hDmem hreg I cornerBag edgeOf V E hEmem A step hedgeOf hDedge_nonboundary J q + constructor + · intro hq + exact (Finset.mem_filter.mp hq).2 + · rintro ⟨h0, h1⟩ + have he : edgeOf q ∈ FootprintEdges T := by + rw [hedgeOf] + apply hreg.2.1 q.1 ((hDmem _).mp h0).1 + (q.1 + step q.2) ((hDmem _).mp h1).1 + rcases q with ⟨z, b⟩ + cases b + · exact Or.inl rfl + · exact Or.inr (Or.inr (Or.inl rfl)) + have hb := hDedge_nonboundary q q.1 h0 (by rw [hedgeOf]; simp) + exact Finset.mem_filter.mpr ⟨Finset.mem_filter.mpr ⟨(hEmem q).mpr he, hb⟩, + h0, h1⟩ + +private theorem hJset : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (D : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let V := cornerBag.toFinset + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + let A := E.filter fun e => edgeOf e ∉ BoundaryFootprintEdges T + let step : Bool → GaussianInt := fun b => if b then I else 1 + let J := A.filter fun q => q.1 ∈ D ∧ q.1 + step q.2 ∈ D + (∀ (q : GaussianInt × Bool), q ∈ J ↔ q.1 ∈ D ∧ q.1 + step q.2 ∈ D) → ( + let east := D.filter fun z => z + 1 ∈ D + let north := D.filter fun z => z + I ∈ D + J = (east.product {false}) ∪ (north.product {true})) ) := by + classical + intro T D I cornerBag edgeOf V E A step J hJmem east north + ext q + rw [hJmem] + rcases q with ⟨z, b⟩ + cases b <;> simp [east, north, step, Finset.product_eq_sprod] + +private theorem hdisj : + (by + classical + exact + ∀ (D : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let east := D.filter fun z => z + 1 ∈ D + let north := D.filter fun z => z + I ∈ D + Disjoint (east.product {false}) (north.product {true}) ) := by + classical + intro D I east north + apply Finset.disjoint_left.mpr + intro q hq hn + have h0 : q.2 = false := Finset.mem_singleton.mp (Finset.mem_product.mp hq).2 + have h1 : q.2 = true := Finset.mem_singleton.mp (Finset.mem_product.mp hn).2 + exact Bool.false_ne_true (h0.symm.trans h1) + +private theorem hJcard : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (D : Finset GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let V := cornerBag.toFinset + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + let A := E.filter fun e => edgeOf e ∉ BoundaryFootprintEdges T + let step : Bool → GaussianInt := fun b => if b then I else 1 + let J := A.filter fun q => q.1 ∈ D ∧ q.1 + step q.2 ∈ D + let east := D.filter fun z => z + 1 ∈ D + let north := D.filter fun z => z + I ∈ D + (J = (east.product {false}) ∪ (north.product {true})) → ((Disjoint (east.product {false}) + (north.product {true})) → (J.card = east.card + north.card)) ) := by + classical + intro T D I cornerBag edgeOf V E A step J east north hJset hdisj + rw [hJset, Finset.card_union_of_disjoint hdisj] + simp [Finset.product_eq_sprod] + +private theorem hboundary_card : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (p : List GaussianInt), (p.Nodup) → ((BoundaryFootprintVertices T = + (↑p.toFinset : Set GaussianInt)) → ((BoundaryFootprintVertices T).ncard = p.length)) + ) := by + classical + intro T p hpnd hverts + rw [hverts] + rw [Set.ncard_coe_finset] + exact List.toFinset_card_of_nodup hpnd + +private theorem hDmem : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ((↑h.domain : Set GaussianInt) = + FootprintVertices T) → ( + let D : Finset GaussianInt := h.domain.filter + (fun x => @decide (x ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _)) + ∀ (z : GaussianInt), z ∈ D ↔ z ∈ FootprintVertices T ∧ z ∉ BoundaryFootprintVertices T) ) + := by + classical + intro T h hdom D z + rw [Finset.mem_filter] + have hdec : @decide (z ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _) = true ↔ + z ∉ BoundaryFootprintVertices T := by + cases Classical.propDecidable _ <;> simp + rw [hdec] + have hzdom : z ∈ h.domain ↔ z ∈ FootprintVertices T := by + change z ∈ (h.domain : Set GaussianInt) ↔ z ∈ FootprintVertices T + rw [hdom] + rw [hzdom] + +private theorem htranslation_rigid : + (by + classical + exact + ∀ (T : ProtoTile), (T.cells.Nonempty) → ((List GaussianInt) → (∀ (v : GaussianInt), + (T.cells.image (fun z => z + v) = T.cells) → (v = 0))) ) := by + classical + intro T hcells p v hs + have hinj : Function.Injective (fun z : GaussianInt => z + v) := by + intro a b hab + exact add_right_cancel hab + have hsumRe : (∑ z ∈ T.cells, z.re) = + ∑ z ∈ T.cells, (z + v).re := by + calc + _ = ∑ z ∈ T.cells.image (fun z => z + v), z.re := by rw [hs] + _ = ∑ z ∈ T.cells, (z + v).re := + Finset.sum_image (fun a ha b hb hab => hinj hab) + have hsumIm : (∑ z ∈ T.cells, z.im) = + ∑ z ∈ T.cells, (z + v).im := by + calc + _ = ∑ z ∈ T.cells.image (fun z => z + v), z.im := by rw [hs] + _ = ∑ z ∈ T.cells, (z + v).im := + Finset.sum_image (fun a ha b hb hab => hinj hab) + have hre : (T.cells.card : ℤ) * v.re = 0 := by + have hformula : (∑ z ∈ T.cells, (z + v).re) = + (∑ z ∈ T.cells, z.re) + (T.cells.card : ℤ) * v.re := by + calc + _ = ∑ z ∈ T.cells, (z.re + v.re) := by + apply Finset.sum_congr rfl + intro z hz + exact Zsqrtd.re_add z v + _ = _ := by simp [Finset.sum_add_distrib, mul_comm] + rw [hformula] at hsumRe + omega + have him : (T.cells.card : ℤ) * v.im = 0 := by + have hformula : (∑ z ∈ T.cells, (z + v).im) = + (∑ z ∈ T.cells, z.im) + (T.cells.card : ℤ) * v.im := by + calc + _ = ∑ z ∈ T.cells, (z.im + v.im) := by + apply Finset.sum_congr rfl + intro z hz + exact Zsqrtd.im_add z v + _ = _ := by simp [Finset.sum_add_distrib, mul_comm] + rw [hformula] at hsumIm + omega + have hcard : (T.cells.card : ℤ) ≠ 0 := by + have : 0 < T.cells.card := Finset.card_pos.mpr hcells + omega + have hr : v.re = 0 := (mul_eq_zero.mp hre).resolve_left hcard + have hi : v.im = 0 := (mul_eq_zero.mp him).resolve_left hcard + ext <;> simp [hr, hi] + +private theorem hcell_cover : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), (ExactTileTiling (RegularTileFamily T + (TilingLattice C))) → (∀ (z : GaussianInt), ∃ a ∈ T.cells, ∃ v ∈ TilingLattice C, z = + a + v) ) := by + classical + intro C T htile z + obtain ⟨U, hU, hzU, _⟩ := htile.2 z + rcases hU with ⟨v, hv, rfl⟩ + change z ∈ T.cells.image (fun a => a + v) at hzU + rcases Finset.mem_image.mp hzU with ⟨a, ha, haz⟩ + exact ⟨a, ha, v, hv, haz.symm⟩ + +private theorem hcell_residue_unique : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (g : + IntegerLatticeFunction), ((↑h.domain : Set GaussianInt) = FootprintVertices T) → + ((BandPrototile C.1.1 T) → ((LatticeTile T) → ((ExactTileTiling (RegularTileFamily T + (TilingLattice C))) → ((∀ x ∈ BoundaryFootprintVertices T, FourNeighborLaplacian g x + = (1 : ℤ)) → ((∀ (D : Finset GaussianInt), (∀ z, z ∈ D ↔ z ∈ FootprintVertices T ∧ z + ∉ BoundaryFootprintVertices T) → ((∀ z, z ∈ FootprintVertices T → z ∉ + BoundaryFootprintVertices T → z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - (⟨0, 1⟩ : + GaussianInt) ∈ T.cells ∧ z - 1 - (⟨0, 1⟩ : GaussianInt) ∈ T.cells) → ((3 * (D.card : + Int) - T.cells.card + 1) = (D.filter fun z => z + 1 ∈ D).card + (D.filter fun z => z + + (⟨0, 1⟩ : GaussianInt) ∈ D).card))) → ((FourNeighborConnected (↑T.cells : Set + LatticeCell) ∧ NoCheckerboardCellVertex (↑T.cells : Set LatticeCell) ∧ + SimpleGridCycle (BoundaryFootprintVertices T) (BoundaryFootprintEdges T)) → + (((FootprintVertices T).ncard + Finset.card T.cells = (FootprintEdges T).ncard + (1 : + ℕ)) → (((∀ (x : LatticeCell), ∀ (y : LatticeCell), FourNeighborAdjacent x y → x ∈ + BoundaryFootprintVertices T → y ∈ BoundaryFootprintVertices T → ¬OpenLatticeEdge x y + ⊆ interior (TileRealization T)) ∧ (∀ x ∈ FootprintVertices T, ∀ y ∈ FootprintVertices + T, FourNeighborAdjacent x y → {x, y} ∈ FootprintEdges T) ∧ ∀ x ∈ FootprintVertices T, + GaussianRealPoint x ∈ interior (TileRealization T) ↔ x ∉ BoundaryFootprintVertices T) + → ( + let D : Finset GaussianInt := h.domain.filter + (fun x => @decide (x ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _)) + (T.cells.Nonempty) → (∀ (p : List GaussianInt), ∀ (x₀ : GaussianInt), ∀ (x₁ : + GaussianInt), (BoundaryFootprintVertices T = (↑p.toFinset : Set GaussianInt)) → ((∀ + (e : Finset GaussianInt), e ∈ BoundaryFootprintEdges T ↔ e = {x₁, x₀} ∨ ∃ (a : + GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = + l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (((BoundaryFootprintVertices T).ncard = p.length) + → ((∀ (z : GaussianInt), z ∈ D ↔ z ∈ FootprintVertices T ∧ z ∉ + BoundaryFootprintVertices T) → ((∀ (v : GaussianInt), (T.cells.image (fun z => z + v) + = T.cells) → (v = 0)) → ((∀ (z : GaussianInt), ∃ a ∈ T.cells, ∃ v ∈ TilingLattice C, + z = a + v) → (∀ (a : GaussianInt), ∀ (a' : GaussianInt), (a ∈ T.cells) → ((a' ∈ + T.cells) → ((a - a' ∈ TilingLattice C) → (a = a'))))))))))))))))))) ) := by + classical + intro C T h g hdom hT hlat htile hweb hcountBridge htiles heuler hreg D hcells p x₀ x₁ hverts + hedges hboundary_card hDmem htranslation_rigid hcell_cover a a' ha ha' hres + let v := a - a' + have htransmem : a ∈ (TileTranslation T v).cells := by + change a ∈ T.cells.image (fun z => z + v) + exact Finset.mem_image.mpr ⟨a', ha', by dsimp [v]; simp⟩ + have hTmem : T ∈ RegularTileFamily T (TilingLattice C) := by + refine ⟨0, (TilingLattice C).zero_mem, ?_⟩ + cases T with + | mk cells anchor => + change ({ cells := cells, anchor := anchor } : ProtoTile) = + { cells := cells.image (fun z => z + 0), anchor := anchor + 0 } + simp + have hVmem : TileTranslation T v ∈ RegularTileFamily T (TilingLattice C) := + ⟨v, hres, rfl⟩ + obtain ⟨U, hUmem, haU, huniq⟩ := htile.2 a + have hTU : T = U := huniq T hTmem ha + have hVU : TileTranslation T v = U := huniq (TileTranslation T v) hVmem htransmem + have htilesame : TileTranslation T v = T := hVU.trans hTU.symm + have hcellsame : T.cells.image (fun z => z + v) = T.cells := by + change T.cells.image (GaussianTranslation v) = T.cells + exact congrArg ProtoTile.cells htilesame + change T.cells.image (fun z => z + v) = T.cells at hcellsame + have hvzero : v = 0 := htranslation_rigid v hcellsame + dsimp [v] at hvzero + exact sub_eq_zero.mp hvzero + +private theorem hfund : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), (∀ (z : GaussianInt), ∃ a ∈ T.cells, ∃ v ∈ + TilingLattice C, z = a + v) → ((∀ (a : GaussianInt), ∀ (a' : GaussianInt), (a ∈ + T.cells) → ((a' ∈ T.cells) → ((a - a' ∈ TilingLattice C) → (a = a')))) → + (LatticeFundamentalSet (TilingLattice C) T.cells)) ) := by + classical + intro C T hcell_cover hcell_residue_unique z + obtain ⟨a, ha, v, hv, hz⟩ := hcell_cover z + refine ⟨a, ⟨ha, ?_⟩, ?_⟩ + · rw [hz] + simpa using hv + · intro a' ha' + have hzmem : z - a ∈ TilingLattice C := by + simpa [hz, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hv + have hd := (TilingLattice C).sub_mem ha'.2 hzmem + exact (hcell_residue_unique a a' ha ha'.1 + (by convert hd using 1; abel)).symm + +private theorem hcell_card : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), (∀ (a : GaussianInt), ∀ (a' : GaussianInt), (a ∈ + T.cells) → ((a' ∈ T.cells) → ((a - a' ∈ TilingLattice C) → (a = a')))) → + ((LatticeFundamentalSet (TilingLattice C) T.cells) → (∀ (R : Finset GaussianInt), + (LatticeFundamentalSet (TilingLattice C) R) → (T.cells.card = R.card))) ) := by + classical + intro C T hcell_residue_unique hfund R hR + apply Finset.card_bij + (fun a _ => Classical.choose (hR a)) + · intro a ha + exact (Classical.choose_spec (hR a)).1.1 + · intro a ha a' ha' heq + have hfa := (Classical.choose_spec (hR a)).1.2 + have hfa' := (Classical.choose_spec (hR a')).1.2 + have hfa'' : a' - Classical.choose (hR a) ∈ TilingLattice C := by + convert hfa' using 1 + rw [heq] + have hd : a - a' ∈ TilingLattice C := by + have hs := (TilingLattice C).add_mem hfa + ((TilingLattice C).neg_mem hfa'') + convert hs using 1; abel + exact hcell_residue_unique a a' ha ha' hd + · intro b hb + obtain ⟨a, ⟨ha, hba⟩, _⟩ := hfund b + have haR : a - Classical.choose (hR a) ∈ TilingLattice C := + (Classical.choose_spec (hR a)).1.2 + have hbRep : b - Classical.choose (hR a) ∈ TilingLattice C := by + have hsum := (TilingLattice C).add_mem hba haR + convert hsum using 1; abel + have hchoose : Classical.choose (hR a) = + Classical.choose (hR b) := by + exact (Classical.choose_spec (hR b)).2 _ + ⟨(Classical.choose_spec (hR a)).1.1, hbRep⟩ + have hbchoose : Classical.choose (hR b) = b := by + exact ((Classical.choose_spec (hR b)).2 b ⟨hb, by simp⟩).symm + exact ⟨a, ha, hchoose.trans hbchoose⟩ + +private theorem hcell_curv : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (R : Finset GaussianInt), (R.card = + C.1.1.1.natAbs) → ((T.cells.card = R.card) → (T.cells.card = C.1.1.1.natAbs)) ) := by + classical + intro C T R hRcard hcell_card + rw [hcell_card] + exact hRcard + +private theorem hstatusRight : + (by + classical + exact + ∀ (T : ProtoTile), (T.cells.Nonempty) → ( + ∀ (z : GaussianInt), (z ∉ BoundaryFootprintVertices T) → ((z ∈ T.cells ↔ z - 1 ∈ + T.cells))) ) := by + classical + intro T hcells z hz + let I : GaussianInt := ⟨0, 1⟩ + constructor + · intro hz0 + by_contra hz1 + apply hz + rw [BoundaryFootprintVertices, ite_eq_left hcells] + refine ⟨{z, z + I}, ?_, by simp⟩ + rw [BoundaryFootprintEdges] + exact ⟨z, Or.inr ⟨by simp [I], Or.inl ⟨hz0, hz1⟩⟩⟩ + · intro hz0 + by_contra hz1 + apply hz + rw [BoundaryFootprintVertices, ite_eq_left hcells] + refine ⟨{z, z + I}, ?_, by simp⟩ + rw [BoundaryFootprintEdges] + exact ⟨z, Or.inr ⟨by simp [I], Or.inr ⟨hz1, hz0⟩⟩⟩ + +private theorem hstatusDown : + (by + classical + exact + ∀ (T : ProtoTile), (T.cells.Nonempty) → ( + let I : GaussianInt := ⟨0, 1⟩ + ∀ (z : GaussianInt), (z ∉ BoundaryFootprintVertices T) → ((z - I ∈ T.cells ↔ z - 1 - I ∈ + T.cells))) ) := by + classical + intro T hcells I z hz + constructor + · intro h0 + by_contra h1 + apply hz + rw [BoundaryFootprintVertices, ite_eq_left hcells] + refine ⟨{z - I, z}, ?_, by simp⟩ + rw [BoundaryFootprintEdges] + refine ⟨z - I, Or.inr ⟨by simp [I], ?_⟩⟩ + exact Or.inl ⟨by simpa [I, Zsqrtd.ext_iff] using h0, + by + have heq : z - I - 1 = z - 1 - I := by ring + rw [heq] + exact h1⟩ + · intro h0 + by_contra h1 + apply hz + rw [BoundaryFootprintVertices, ite_eq_left hcells] + refine ⟨{z - I, z}, ?_, by simp⟩ + rw [BoundaryFootprintEdges] + refine ⟨z - I, Or.inr ⟨by simp [I], ?_⟩⟩ + exact Or.inr ⟨by simpa [I, Zsqrtd.ext_iff] using h1, + by + have heq : z - I - 1 = z - 1 - I := by ring + rw [heq] + exact h0⟩ + +private theorem hstatusLeft : + (by + classical + exact + ∀ (T : ProtoTile), (T.cells.Nonempty) → ( + let I : GaussianInt := ⟨0, 1⟩ + ∀ (z : GaussianInt), (z ∉ BoundaryFootprintVertices T) → ((z - 1 ∈ T.cells ↔ z - 1 - I ∈ + T.cells))) ) := by + classical + intro T hcells I z hz + constructor + · intro h0 + by_contra h1 + apply hz + rw [BoundaryFootprintVertices, ite_eq_left hcells] + refine ⟨{z - 1, z}, ?_, by simp⟩ + rw [BoundaryFootprintEdges] + refine ⟨z - 1, Or.inl ⟨by simp, ?_⟩⟩ + exact Or.inl ⟨by simpa [I, Zsqrtd.ext_iff] using h0, + by simpa [I, Zsqrtd.ext_iff] using h1⟩ + · intro h0 + by_contra h1 + apply hz + rw [BoundaryFootprintVertices, ite_eq_left hcells] + refine ⟨{z - 1, z}, ?_, by simp⟩ + rw [BoundaryFootprintEdges] + refine ⟨z - 1, Or.inl ⟨by simp, ?_⟩⟩ + exact Or.inr ⟨by simpa [I, Zsqrtd.ext_iff] using h1, + by simpa [I, Zsqrtd.ext_iff] using h0⟩ + +private theorem hsomeSector : + (by + classical + exact + ∀ (T : ProtoTile), (T.cells.Nonempty) → ( + let I : GaussianInt := ⟨0, 1⟩ + ∀ (z : GaussianInt), (z ∈ FootprintVertices T) → (z ∈ T.cells ∨ z - 1 ∈ T.cells ∨ z - I ∈ + T.cells ∨ z - 1 - I ∈ T.cells)) ) := by + classical + intro T hcells I z hz + rw [FootprintVertices, ite_eq_left hcells] at hz + rcases hz with ⟨a, ha, rfl | h | h | h⟩ + · exact Or.inl ha + · right + left + simpa [h, sub_eq_add_neg] using ha + · right + right + left + simpa [h, I, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using ha + · right + right + right + simpa [h, I, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using ha + +private theorem hsectorAll : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + (∀ (z : GaussianInt), (z ∉ BoundaryFootprintVertices T) → ((z ∈ T.cells ↔ z - 1 ∈ + T.cells))) → ((∀ (z : GaussianInt), (z ∉ BoundaryFootprintVertices T) → ((z - I ∈ + T.cells ↔ z - 1 - I ∈ T.cells))) → ((∀ (z : GaussianInt), (z ∉ + BoundaryFootprintVertices T) → ((z - 1 ∈ T.cells ↔ z - 1 - I ∈ T.cells))) → ((∀ (z : + GaussianInt), (z ∈ FootprintVertices T) → (z ∈ T.cells ∨ z - 1 ∈ T.cells ∨ z - I ∈ + T.cells ∨ z - 1 - I ∈ T.cells)) → (∀ (z : GaussianInt), (z ∈ FootprintVertices T) → + ((z ∉ BoundaryFootprintVertices T) → (z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - I ∈ T.cells + ∧ z - 1 - I ∈ T.cells)))))) ) := by + classical + intro T I hstatusRight hstatusDown hstatusLeft hsomeSector z hz hn + have hr := hstatusRight z hn + have hd := hstatusDown z hn + have hl := hstatusLeft z hn + rcases hsomeSector z hz with h0 | h1 | h2 | h3 + · exact ⟨h0, hr.mp h0, hd.mpr (hl.mp (hr.mp h0)), hl.mp (hr.mp h0)⟩ + · exact ⟨hr.mpr h1, h1, hd.mpr (hl.mp h1), hl.mp h1⟩ + · exact ⟨hr.mpr (hl.mpr (hd.mp h2)), hl.mpr (hd.mp h2), h2, hd.mp h2⟩ + · exact ⟨hr.mpr (hl.mpr h3), hl.mpr h3, hd.mpr h3, h3⟩ + +private theorem hcellBaseFV : + (by + classical + exact + ∀ (T : ProtoTile), (T.cells.Nonempty) → (∀ (z : GaussianInt), (z ∈ T.cells) → (z ∈ + FootprintVertices T)) ) := by + classical + intro T hcells z hz + rw [FootprintVertices, ite_eq_left hcells] + exact ⟨z, hz, Or.inl rfl⟩ + +private theorem hDcells : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), + let D : Finset GaussianInt := h.domain.filter + (fun x => @decide (x ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _)) + (∀ (z : GaussianInt), z ∈ D ↔ z ∈ FootprintVertices T ∧ z ∉ BoundaryFootprintVertices T) → ( + let I : GaussianInt := ⟨0, 1⟩ + (∀ (z : GaussianInt), (z ∈ FootprintVertices T) → ((z ∉ BoundaryFootprintVertices T) → (z + ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - I ∈ T.cells ∧ z - 1 - I ∈ T.cells))) → ((∀ (z : + GaussianInt), (z ∈ T.cells) → (z ∈ FootprintVertices T)) → (∀ (z : GaussianInt), z ∈ + D ↔ z ∈ T.cells ∧ z ∉ BoundaryFootprintVertices T))) ) := by + classical + intro T h D hDmem I hsectorAll hcellBaseFV z + constructor + · intro hz + rcases hDmem z |>.mp hz with ⟨hzv, hzb⟩ + exact ⟨(hsectorAll z hzv hzb).1, hzb⟩ + · rintro ⟨hzc, hzb⟩ + apply hDmem z |>.mpr + exact ⟨hcellBaseFV z hzc, hzb⟩ + +private theorem hDfilter : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), + let D : Finset GaussianInt := h.domain.filter + (fun x => @decide (x ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _)) + (∀ (z : GaussianInt), z ∈ D ↔ z ∈ T.cells ∧ z ∉ BoundaryFootprintVertices T) → (D = + T.cells.filter (fun z => @decide (z ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _))) ) := by + classical + intro T h D hDcells + ext z + rw [hDcells, Finset.mem_filter] + have hdec : @decide (z ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _) = true ↔ + z ∉ BoundaryFootprintVertices T := by + cases Classical.propDecidable _ <;> simp + simp [] + +private theorem hsumFund : + (by + classical + exact + ∀ (C : BandCircle), ∀ (S : Finset GaussianInt), ∀ (R : Finset GaussianInt), + (LatticeFundamentalSet (TilingLattice C) S) → ((LatticeFundamentalSet (TilingLattice + C) R) → (∀ (f : GaussianInt → ℝ), (∀ x, ∀ v, v ∈ TilingLattice C → f (x + v) = f x) → + ((∑ x ∈ S, f x) = ∑ x ∈ R, f x))) ) := by + classical + intro C S R hS hR' f hper + apply Finset.sum_bij (fun a _ => Classical.choose (hR' a)) + · intro a ha + exact (Classical.choose_spec (hR' a)).1.1 + · intro a ha a' ha' heq + have hfa := (Classical.choose_spec (hR' a)).1.2 + have hfa' := (Classical.choose_spec (hR' a')).1.2 + have hfa'' : a' - Classical.choose (hR' a) ∈ TilingLattice C := by + convert hfa' using 1 + rw [heq] + have hd : a - a' ∈ TilingLattice C := by + have hs := (TilingLattice C).add_mem hfa + ((TilingLattice C).neg_mem hfa'') + convert hs using 1; abel + have hchoose : Classical.choose (hS a) = a := by + exact ((Classical.choose_spec (hS a)).2 a ⟨ha, by simp⟩).symm + have hchoose' : a' = Classical.choose (hS a) := + (Classical.choose_spec (hS a)).2 a' ⟨ha', hd⟩ + rw [hchoose] at hchoose' + exact hchoose'.symm + · intro b hb + obtain ⟨a, ⟨ha, hba⟩, _⟩ := hS b + have haR : a - Classical.choose (hR' a) ∈ TilingLattice C := + (Classical.choose_spec (hR' a)).1.2 + have hbRep : b - Classical.choose (hR' a) ∈ TilingLattice C := by + have hsum := (TilingLattice C).add_mem hba haR + convert hsum using 1; abel + have hchoose : Classical.choose (hR' a) = + Classical.choose (hR' b) := + (Classical.choose_spec (hR' b)).2 _ + ⟨(Classical.choose_spec (hR' a)).1.1, hbRep⟩ + have hbchoose : Classical.choose (hR' b) = b := + ((Classical.choose_spec (hR' b)).2 b ⟨hb, by simp⟩).symm + exact ⟨a, ha, hchoose.trans hbchoose⟩ + · intro a ha + let r := Classical.choose (hR' a) + have hv : a - r ∈ TilingLattice C := by + exact (Classical.choose_spec (hR' a)).1.2 + have hp := hper r (a - r) hv + calc + f a = f (r + (a - r)) := by congr 1; abel + _ = f r := hp + +private theorem hfundTranslate : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), (LatticeFundamentalSet (TilingLattice C) T.cells) + → (∀ (s : GaussianInt), LatticeFundamentalSet (TilingLattice C) (T.cells.image (fun x + => x + s))) ) := by + classical + intro C T hfund s x + obtain ⟨r, ⟨hr, hxr⟩, huniq⟩ := hfund (x - s) + refine ⟨r + s, ⟨Finset.mem_image.mpr ⟨r, hr, rfl⟩, ?_⟩, ?_⟩ + · convert hxr using 1; abel + · intro y hy + rcases Finset.mem_image.mp hy.1 with ⟨r', hr', rfl⟩ + have hxr' : (x - s) - r' ∈ TilingLattice C := by + convert hy.2 using 1; abel + have heq := huniq r' ⟨hr', hxr'⟩ + simpa using congrArg (fun z => z + s) heq + +private theorem hsumTranslate : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), (LatticeFundamentalSet (TilingLattice C) T.cells) + → ((∀ (S : Finset GaussianInt), ∀ (R : Finset GaussianInt), (LatticeFundamentalSet + (TilingLattice C) S) → ((LatticeFundamentalSet (TilingLattice C) R) → (∀ (f : + GaussianInt → ℝ), (∀ x, ∀ v, v ∈ TilingLattice C → f (x + v) = f x) → ((∑ x ∈ S, f x) + = ∑ x ∈ R, f x)))) → ((∀ (s : GaussianInt), LatticeFundamentalSet (TilingLattice C) + (T.cells.image (fun x => x + s))) → (∀ (s : GaussianInt), ∀ (f : GaussianInt → ℝ), (∀ + x, ∀ v, v ∈ TilingLattice C → f (x + v) = f x) → ((∑ x ∈ T.cells, f (x + s)) = ∑ x ∈ + T.cells, f x)))) ) := by + classical + intro C T hfund hsumFund hfundTranslate s f hper + have hinj : Function.Injective (fun x : GaussianInt => x + s) := by + intro x y hxy + exact add_right_cancel hxy + have himage : (∑ y ∈ T.cells.image (fun x => x + s), f y) = + ∑ x ∈ T.cells, f (x + s) := + Finset.sum_image (fun a ha b hb hab => hinj hab) + calc + _ = ∑ y ∈ T.cells.image (fun x => x + s), f y := himage.symm + _ = ∑ x ∈ T.cells, f x := + (hsumFund T.cells (T.cells.image (fun x => x + s)) hfund + (hfundTranslate s) f hper).symm + +private theorem hFstencil_sum : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (g : IntegerLatticeFunction), + (∀ (s : GaussianInt), ∀ (f : GaussianInt → ℝ), (∀ x, ∀ v, v ∈ TilingLattice C → f (x + v) + = f x) → ((∑ x ∈ T.cells, f (x + s)) = ∑ x ∈ T.cells, f x)) → (∀ (b : ℝ × ℝ), + let F : GaussianInt → ℝ := fun x => (g x : ℝ) - + LatticeQuadraticForm (CircleMatrix C) x - (b.1 * x.re + b.2 * x.im) + (∀ (x : GaussianInt), ∀ (v : GaussianInt), (v ∈ TilingLattice C) → (F (x + v) = F x)) → + ((∑ x ∈ T.cells, RealFourNeighborLaplacian F x) = 0)) ) := by + classical + intro C T g hsumTranslate b F hFperiod + let I : GaussianInt := ⟨0, 1⟩ + have hs1 := hsumTranslate (1 : GaussianInt) F hFperiod + have hsm1 := hsumTranslate (-1 : GaussianInt) F hFperiod + have hsI := hsumTranslate I F hFperiod + have hsmI := hsumTranslate (-I) F hFperiod + have hsm1' : (∑ x ∈ T.cells, F (x - 1)) = ∑ x ∈ T.cells, F x := by + convert hsm1 using 1 + have hsmI' : (∑ x ∈ T.cells, F (x - I)) = ∑ x ∈ T.cells, F x := by + convert hsmI using 1 + simp only [RealFourNeighborLaplacian, Finset.sum_sub_distrib, + Finset.sum_add_distrib] + rw [hs1, hsm1', hsI, hsmI'] + rw [← Finset.mul_sum] + ring + +private theorem hsym : + (by + classical + exact + ∀ (C : BandCircle), (CircleMatrix C).IsSymm ) := by + classical + intro C + unfold Matrix.IsSymm CircleMatrix + dsimp + ext i j + fin_cases i <;> fin_cases j <;> rfl + +private theorem hF_eq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (g : IntegerLatticeFunction), ∀ (b : ℝ × ℝ), + let F : GaussianInt → ℝ := fun x => (g x : ℝ) - + LatticeQuadraticForm (CircleMatrix C) x - (b.1 * x.re + b.2 * x.im) + let u : GaussianInt → ℝ := fun x => (g x : ℝ) + let vfun : GaussianInt → ℝ := fun x => + LatticeQuadraticForm (CircleMatrix C) x + + dotProduct ![b.1, b.2] ![(x.re : ℝ), (x.im : ℝ)] + F = fun x => u x - vfun x ) := by + classical + intro C g b F u vfun + funext x + simp [F, u, vfun, dotProduct] + ring + +private theorem hFlap : + (by + classical + exact + ∀ (C : BandCircle), ∀ (g : IntegerLatticeFunction), ∀ (b : ℝ × ℝ), + let F : GaussianInt → ℝ := fun x => (g x : ℝ) - + LatticeQuadraticForm (CircleMatrix C) x - (b.1 * x.re + b.2 * x.im) + let u : GaussianInt → ℝ := fun x => (g x : ℝ) + let vfun : GaussianInt → ℝ := fun x => + LatticeQuadraticForm (CircleMatrix C) x + + dotProduct ![b.1, b.2] ![(x.re : ℝ), (x.im : ℝ)] + ((CircleMatrix C).IsSymm) → ((F = fun x => u x - vfun x) → (∀ (x : GaussianInt), + RealFourNeighborLaplacian F x = (FourNeighborLaplacian g x : ℝ) - Matrix.trace + (CircleMatrix C))) ) := by + classical + intro C g b F u vfun hsym hF_eq x + rw [hF_eq] + have hlin := RealLaplacianLinearity u vfun 1 (-1) x + have hquad := QuadraticAffineLaplacian (CircleMatrix C) hsym + ![b.1, b.2] 0 x + have hquad' : RealFourNeighborLaplacian vfun x = + Matrix.trace (CircleMatrix C) := by + simpa [vfun] using hquad + rw [show (fun y => u y - vfun y) = + (fun y => (1 : ℝ) * u y + (-1 : ℝ) * vfun y) by + funext y + ring] + rw [hlin] + simp only [one_mul, neg_one_mul] + rw [IntegerLaplacianCastBridge, hquad'] + ring + +private theorem hsumDelta : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (g : IntegerLatticeFunction), ∀ (b : ℝ × ℝ), + let F : GaussianInt → ℝ := fun x => (g x : ℝ) - + LatticeQuadraticForm (CircleMatrix C) x - (b.1 * x.re + b.2 * x.im) + ((∑ x ∈ T.cells, RealFourNeighborLaplacian F x) = 0) → ((∀ (x : GaussianInt), + RealFourNeighborLaplacian F x = (FourNeighborLaplacian g x : ℝ) - Matrix.trace + (CircleMatrix C)) → ((∑ x ∈ T.cells, (FourNeighborLaplacian g x : ℝ)) = (T.cells.card + : ℝ) * Matrix.trace (CircleMatrix C))) ) := by + classical + intro C T g b F hFstencil_sum hFlap + calc + _ = ∑ x ∈ T.cells, + (RealFourNeighborLaplacian F x + Matrix.trace (CircleMatrix C)) := by + apply Finset.sum_congr rfl + intro x hx + rw [hFlap] + ring + _ = _ := by rw [Finset.sum_add_distrib, hFstencil_sum]; simp + +private theorem htrace : + (by + classical + exact + ∀ (C : BandCircle), Matrix.trace (CircleMatrix C) = 1 / (C.1.1.1 : ℝ) ) := by + classical + intro C + simp [CircleMatrix, BandCircleEuclideanData, Matrix.trace, Matrix.diag] + ring + +private theorem hcurvCast : + (by + classical + exact + ∀ (C : BandCircle), (C.1.1.1.natAbs : ℝ) = (C.1.1.1 : ℝ) ) := by + classical + intro C + have hi : (C.1.1.1.natAbs : ℤ) = C.1.1.1 := + Int.natAbs_of_nonneg (le_of_lt C.2) + have hcast : ((C.1.1.1.natAbs : ℤ) : ℝ) = + (C.1.1.1.natAbs : ℝ) := Int.cast_natCast _ + calc + (C.1.1.1.natAbs : ℝ) = ((C.1.1.1.natAbs : ℤ) : ℝ) := hcast.symm + _ = (C.1.1.1 : ℝ) := congrArg (fun z : ℤ => (z : ℝ)) hi + +private theorem hsumDelta_one : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (g : IntegerLatticeFunction), (T.cells.card = + C.1.1.1.natAbs) → (((∑ x ∈ T.cells, (FourNeighborLaplacian g x : ℝ)) = (T.cells.card + : ℝ) * Matrix.trace (CircleMatrix C)) → ((Matrix.trace (CircleMatrix C) = 1 / + (C.1.1.1 : ℝ)) → (((C.1.1.1.natAbs : ℝ) = (C.1.1.1 : ℝ)) → ((∑ x ∈ T.cells, + (FourNeighborLaplacian g x : ℝ)) = 1)))) ) := by + classical + intro C T g hcell_curv hsumDelta htrace hcurvCast + rw [hsumDelta, htrace] + have hcardReal : (T.cells.card : ℝ) = (C.1.1.1.natAbs : ℝ) := by + exact_mod_cast hcell_curv + rw [hcardReal, hcurvCast] + have hcne : (C.1.1.1 : ℝ) ≠ 0 := by + exact_mod_cast (ne_of_gt C.2) + field_simp + +private theorem hDfilterProp : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), + let D : Finset GaussianInt := h.domain.filter + (fun x => @decide (x ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _)) + (∀ (z : GaussianInt), z ∈ D ↔ z ∈ T.cells ∧ z ∉ BoundaryFootprintVertices T) → (D = + T.cells.filter (fun x => x ∉ BoundaryFootprintVertices T)) ) := by + classical + intro T h D hDcells + ext z + simp only [Finset.mem_filter] + exact hDcells z + +private theorem hcell_partition : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), + let D : Finset GaussianInt := h.domain.filter + (fun x => @decide (x ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _)) + (D = T.cells.filter (fun x => x ∉ BoundaryFootprintVertices T)) → ( + let B : Finset GaussianInt := T.cells.filter + (fun x => x ∈ BoundaryFootprintVertices T) + D.card + B.card = T.cells.card) ) := by + classical + intro T h D hDfilterProp B + rw [hDfilterProp] + dsimp [B] + have h := Finset.card_filter_add_card_filter_not + (s := T.cells) (fun x => x ∉ BoundaryFootprintVertices T) + simpa only [not_not] using h + +private theorem hsum_partition : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), + let D : Finset GaussianInt := h.domain.filter + (fun x => @decide (x ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _)) + (D = T.cells.filter (fun x => x ∉ BoundaryFootprintVertices T)) → ( + let B : Finset GaussianInt := T.cells.filter + (fun x => x ∈ BoundaryFootprintVertices T) + ∀ (f : GaussianInt → ℝ), (∑ x ∈ D, f x) + (∑ x ∈ B, f x) = ∑ x ∈ T.cells, f x) ) := by + classical + intro T h D hDfilterProp B f + rw [hDfilterProp] + dsimp [B] + simpa only [not_not] using + Finset.sum_filter_add_sum_filter_not T.cells + (fun x => x ∉ BoundaryFootprintVertices T) f + +private theorem hB_lap : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (g : IntegerLatticeFunction), (∀ x ∈ BoundaryFootprintVertices T, + FourNeighborLaplacian g x = (1 : ℤ)) → ( + let B : Finset GaussianInt := T.cells.filter + (fun x => x ∈ BoundaryFootprintVertices T) + (∑ x ∈ B, (FourNeighborLaplacian g x : ℝ)) = B.card) ) := by + classical + intro T g hweb B + calc + _ = ∑ x ∈ B, (1 : ℝ) := by + apply Finset.sum_congr rfl + intro x hx + have hx' : x ∈ BoundaryFootprintVertices T := by + simp? [B, Finset.mem_filter] at hx + exact hx.2 + rw [hweb x hx'] + norm_num + _ = B.card := by simp [B] + +private theorem hD_lap_real : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (g : IntegerLatticeFunction), + let D : Finset GaussianInt := h.domain.filter + (fun x => @decide (x ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _)) + ((∑ x ∈ T.cells, (FourNeighborLaplacian g x : ℝ)) = 1) → ( + let B : Finset GaussianInt := T.cells.filter + (fun x => x ∈ BoundaryFootprintVertices T) + (∀ (f : GaussianInt → ℝ), (∑ x ∈ D, f x) + (∑ x ∈ B, f x) = ∑ x ∈ T.cells, f x) → (((∑ x + ∈ B, (FourNeighborLaplacian g x : ℝ)) = B.card) → ((∑ x ∈ D, (FourNeighborLaplacian g + x : ℝ)) = 1 - (B.card : ℝ)))) ) := by + classical + intro T h g D hsumDelta_one B hsum_partition hB_lap + have hs := hsum_partition (fun x => (FourNeighborLaplacian g x : ℝ)) + rw [hB_lap] at hs + have hreal : + (∑ x ∈ D, (FourNeighborLaplacian g x : ℝ)) + + (B.card : ℝ) = 1 := by + calc + _ = ∑ x ∈ T.cells, (FourNeighborLaplacian g x : ℝ) := hs + _ = 1 := hsumDelta_one + linarith + +private theorem hD_lap_int : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (g : IntegerLatticeFunction), + let D : Finset GaussianInt := h.domain.filter + (fun x => @decide (x ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _)) + let B : Finset GaussianInt := T.cells.filter + (fun x => x ∈ BoundaryFootprintVertices T) + ((∑ x ∈ D, (FourNeighborLaplacian g x : ℝ)) = 1 - (B.card : ℝ)) → ((∑ x ∈ D, + FourNeighborLaplacian g x) = 1 - (B.card : ℤ)) ) := by + classical + intro T h g D B hD_lap_real + exact_mod_cast hD_lap_real + +private theorem hsum_sigma : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (g : IntegerLatticeFunction), + let D : Finset GaussianInt := h.domain.filter + (fun x => @decide (x ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _)) + let B : Finset GaussianInt := T.cells.filter + (fun x => x ∈ BoundaryFootprintVertices T) + ((∑ x ∈ D, FourNeighborLaplacian g x) = 1 - (B.card : ℤ)) → ((∑ x ∈ D, (2 + + FourNeighborLaplacian g x)) = (2 * D.card : ℤ) + 1 - B.card) ) := by + classical + intro T h g D B hD_lap_int + rw [Finset.sum_add_distrib, hD_lap_int] + simp only [Finset.sum_const, + nsmul_eq_mul] + ring + +private theorem hpairfilter : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), + let D : Finset GaussianInt := h.domain.filter + (fun x => @decide (x ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _)) + ((D.product D).filter fun (e : GaussianInt × GaussianInt) => @decide + (FourNeighborAdjacent e.1 e.2) (Classical.propDecidable _)) = ((D.product D).filter + fun e => FourNeighborAdjacent e.1 e.2) ) := by + classical + intro T h D + ext e + simp only [Finset.mem_filter] + have hdec : @decide (FourNeighborAdjacent e.1 e.2) + (Classical.propDecidable _) = true ↔ FourNeighborAdjacent e.1 e.2 := by + cases Classical.propDecidable _ <;> simp + rw [hdec] + +private theorem hhalf : + (by + classical + exact + (BandCircle) → (∀ (T : ProtoTile), ∀ (h : PartialOdometer), (IntegerLatticeFunction) → ( + let D : Finset GaussianInt := h.domain.filter + (fun x => @decide (x ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _)) + (List GaussianInt) → ((Finset GaussianInt) → ((2 * ((D.filter fun z => z + 1 ∈ D).card + + (D.filter fun z => z + (⟨0, 1⟩ : GaussianInt) ∈ D).card)) / 2 = (D.filter fun z => z + + 1 ∈ D).card + (D.filter fun z => z + (⟨0, 1⟩ : GaussianInt) ∈ D).card)))) ) := by + classical + intro C T h g D p R + omega + +end PeriodicIndegreeGeometry + +namespace PeriodicCountBridge + +private theorem hcountBridge : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), (BandPrototile C.1.1 T) → ((LatticeTile T) → (∀ (D + : Finset GaussianInt), (∀ z, z ∈ D ↔ z ∈ FootprintVertices T ∧ z ∉ + BoundaryFootprintVertices T) → ((∀ z, z ∈ FootprintVertices T → z ∉ + BoundaryFootprintVertices T → + z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - (⟨0, 1⟩ : GaussianInt) ∈ T.cells ∧ + z - 1 - (⟨0, 1⟩ : GaussianInt) ∈ T.cells) → ((3 * (D.card : Int) - T.cells.card + + 1) = (D.filter fun z => z + 1 ∈ D).card + (D.filter fun z => z + (⟨0, 1⟩ : + GaussianInt) ∈ D).card)))) ) := by + classical + intro C T hT hlat D hDmem hsectorAll + have htiles := LatticeTileGridStructure T hlat + have hcells : T.cells.Nonempty := htiles.1.1 + have heuler := LatticeTileGridEulerCount T hlat + have hreg := LatticeEdgeRegularity C T hT hlat + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let N : Nat → Nat := fun k => + (cornerBag.toFinset.filter fun z => cornerBag.count z = k).card + have hinc := FiniteSquareIncidenceIdentities T hcells htiles.2.1 + change 4 * T.cells.card = N 1 + 2 * N 2 + 3 * N 3 + 4 * N 4 ∧ + (FootprintVertices T).ncard = N 1 + N 2 + N 3 + N 4 ∧ + 2 * (FootprintEdges T).ncard = 4 * T.cells.card + + (BoundaryFootprintEdges T).ncard ∧ + (BoundaryFootprintEdges T).ncard = N 1 + N 2 + N 3 at hinc + have hvertex_partition : (FootprintVertices T).ncard = + D.card + (BoundaryFootprintEdges T).ncard := PeriodicIndegreeGeometry.hvertex_partition T + D heuler hinc + (PeriodicIndegreeGeometry.hN4 T D hDmem hsectorAll hcells + (PeriodicIndegreeGeometry.hcornerCount T) (PeriodicIndegreeGeometry.hfull_not_boundary T + hcells)) + -- A base point and direction give a unique tag for each footprint edge. + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + have edgeOf_injective := PeriodicIndegreeGeometry.edgeOf_injective T D + (PeriodicIndegreeGeometry.pair_eq) + let V := cornerBag.toFinset + have hEV := PeriodicIndegreeGeometry.hEV T hcells + let E := (V.product (Finset.univ : Finset Bool)).filter + fun e => edgeOf e ∈ FootprintEdges T + have hEmem := PeriodicIndegreeGeometry.hEmem T (PeriodicIndegreeGeometry.hV T hcells) hEV + have hEset := PeriodicIndegreeGeometry.hEset T hEmem + have hEcard : E.card = (FootprintEdges T).ncard := PeriodicIndegreeGeometry.hEcard T + edgeOf_injective hEset + let BE := E.filter fun e => edgeOf e ∈ BoundaryFootprintEdges T + have hBEcard : BE.card = (BoundaryFootprintEdges T).ncard := PeriodicIndegreeGeometry.hBEcard + T edgeOf_injective + (PeriodicIndegreeGeometry.hBEset T hEset (PeriodicIndegreeGeometry.hBEsub T)) + let A := E.filter fun e => edgeOf e ∉ BoundaryFootprintEdges T + have hApart : A.card + BE.card = E.card := PeriodicIndegreeGeometry.hApart T + have hAcount : (A.card : Int) = D.card + T.cells.card - 1 := by + omega + have hEocc := PeriodicIndegreeGeometry.hEocc T edgeOf_injective hEmem + -- A shared side has an open rectangle inside its two incident squares. + let step : Bool → GaussianInt := fun b => if b then I else 1 + have hedgeOf := PeriodicIndegreeGeometry.hedgeOf + have hDedge_nonboundary := PeriodicIndegreeGeometry.hDedge_nonboundary T D hDmem hcells + -- Swap the vertex and edge sums to count the same incidences twice. + let J := A.filter fun q => q.1 ∈ D ∧ q.1 + step q.2 ∈ D + have hdegree_count : A.card + J.card = 4 * D.card := PeriodicIndegreeGeometry.hdegree_count T D + (PeriodicIndegreeGeometry.hAendpoint T D hDmem hreg hEV hEmem + (PeriodicIndegreeGeometry.hshared T htiles hreg hinc hEocc + (PeriodicIndegreeGeometry.hBEocc T edgeOf_injective)) + (PeriodicIndegreeGeometry.hhorizontal T) (PeriodicIndegreeGeometry.hvertical T) hedgeOf) + (PeriodicIndegreeGeometry.hdegree_sum T D (PeriodicIndegreeGeometry.hdegree T D hDmem + hsectorAll hEocc hDedge_nonboundary) (PeriodicIndegreeGeometry.hendSum D hedgeOf)) + let east := D.filter fun z => z + 1 ∈ D + let north := D.filter fun z => z + I ∈ D + have hJcard : J.card = east.card + north.card := PeriodicIndegreeGeometry.hJcard T D + (PeriodicIndegreeGeometry.hJset T D + (PeriodicIndegreeGeometry.hJmem T D hDmem hreg hEmem hedgeOf hDedge_nonboundary)) + (PeriodicIndegreeGeometry.hdisj D) + change (3 * (D.card : Int) - T.cells.card + 1) = east.card + north.card + omega + +end PeriodicCountBridge + +theorem PeriodicTileTotalIndegree (C : BandCircle) + (T : ProtoTile) (h : PartialOdometer) (g : IntegerLatticeFunction) + (hdom : (h.domain : Set GaussianInt) = FootprintVertices T) + (hT : BandPrototile C.1.1 T) (hlat : LatticeTile T) + (htile : ExactTileTiling (RegularTileFamily T (TilingLattice C))) + (hweb : ∀ x, x ∈ BoundaryFootprintVertices T → + FourNeighborLaplacian g x = 1) + (hperiod : ∃ b : ℝ × ℝ, ∀ v, v ∈ TilingLattice C → ∀ x, + (g (x + v) : ℝ) - LatticeQuadraticForm (CircleMatrix C) (x + v) - + (b.1 * (x + v).re + b.2 * (x + v).im) = + (g x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x - + (b.1 * x.re + b.2 * x.im)) : + let D := h.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _) + (∑ x ∈ D, (2 + FourNeighborLaplacian g x)) = + ((((D.product D).filter fun (e : GaussianInt × GaussianInt) => + @decide (FourNeighborAdjacent e.1 e.2) + (Classical.propDecidable _)).card / 2 : ℕ) : ℤ) := by +-- BODY + classical + -- East and north representatives count each unoriented induced edge once. + have hordered (D : Finset GaussianInt) : + ((D.product D).filter fun (e : GaussianInt × GaussianInt) => + FourNeighborAdjacent e.1 e.2).card = + 2 * ((D.filter fun z => z + 1 ∈ D).card + + (D.filter fun z => z + (⟨0, 1⟩ : GaussianInt) ∈ D).card) := + PeriodicIndegreeGeometry.hordered D + -- Disk Euler count and the four interior incidences give 3m - c + 1. + have hcountBridge (D : Finset GaussianInt) + (hDmem : ∀ z, z ∈ D ↔ z ∈ FootprintVertices T ∧ z ∉ BoundaryFootprintVertices T) + (hsectorAll : ∀ z, z ∈ FootprintVertices T → z ∉ BoundaryFootprintVertices T → + z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - (⟨0, 1⟩ : GaussianInt) ∈ T.cells ∧ + z - 1 - (⟨0, 1⟩ : GaussianInt) ∈ T.cells) : + (3 * (D.card : Int) - T.cells.card + 1) = + (D.filter fun z => z + 1 ∈ D).card + + (D.filter fun z => z + (⟨0, 1⟩ : GaussianInt) ∈ D).card := + PeriodicCountBridge.hcountBridge C T hT hlat D hDmem hsectorAll + have htiles := LatticeTileGridStructure T hlat + have heuler := LatticeTileGridEulerCount T hlat + have hreg := LatticeEdgeRegularity C T hT hlat + let D : Finset GaussianInt := h.domain.filter + (fun x => @decide (x ∉ BoundaryFootprintVertices T) + (Classical.propDecidable _)) + change (∑ x ∈ D, (2 + FourNeighborLaplacian g x)) = + ((((D.product D).filter fun (e : GaussianInt × GaussianInt) => + @decide (FourNeighborAdjacent e.1 e.2) + (Classical.propDecidable _)).card / 2 : ℕ) : ℤ) + have hcells : T.cells.Nonempty := htiles.1.1 + rcases htiles.2.2 with ⟨p, x₀, x₁, hpnd, hplen, hhead, hlast, + hverts, hclose, hadj, hedges⟩ + have hDmem := PeriodicIndegreeGeometry.hDmem T h hdom + -- Exact tiling makes the cell bases a finite set of residue representatives. + have hcell_cover := PeriodicIndegreeGeometry.hcell_cover C T htile + have hcell_residue_unique := PeriodicIndegreeGeometry.hcell_residue_unique C T h g hdom hT hlat + htile hweb hcountBridge htiles heuler hreg hcells p x₀ x₁ hverts hedges + (PeriodicIndegreeGeometry.hboundary_card T p hpnd hverts) hDmem + (PeriodicIndegreeGeometry.htranslation_rigid T hcells p) hcell_cover + have hfund := PeriodicIndegreeGeometry.hfund C T hcell_cover hcell_residue_unique + obtain ⟨R, hR, hRcard⟩ := TilingLatticeIndex C + have hcell_curv : T.cells.card = C.1.1.1.natAbs := PeriodicIndegreeGeometry.hcell_curv C T R + hRcard + (PeriodicIndegreeGeometry.hcell_card C T hcell_residue_unique hfund R hR) + let I : GaussianInt := ⟨0, 1⟩ + have hsectorAll := PeriodicIndegreeGeometry.hsectorAll T (PeriodicIndegreeGeometry.hstatusRight + T hcells) (PeriodicIndegreeGeometry.hstatusDown T hcells) + (PeriodicIndegreeGeometry.hstatusLeft T hcells) (PeriodicIndegreeGeometry.hsomeSector T + hcells) + have hDcells := PeriodicIndegreeGeometry.hDcells T h hDmem hsectorAll + (PeriodicIndegreeGeometry.hcellBaseFV T hcells) + have hDfilter := PeriodicIndegreeGeometry.hDfilter T h hDcells + have hsumTranslate := PeriodicIndegreeGeometry.hsumTranslate C T hfund + (PeriodicIndegreeGeometry.hsumFund C) (PeriodicIndegreeGeometry.hfundTranslate C T hfund) + -- Each translated periodic stencil has the same sum over the representatives. + rcases hperiod with ⟨b, hb⟩ + let F : GaussianInt → ℝ := fun x => (g x : ℝ) - + LatticeQuadraticForm (CircleMatrix C) x - (b.1 * x.re + b.2 * x.im) + have hFperiod (x v : GaussianInt) (hv : v ∈ TilingLattice C) : + F (x + v) = F x := hb v hv x + let u : GaussianInt → ℝ := fun x => (g x : ℝ) + let vfun : GaussianInt → ℝ := fun x => + LatticeQuadraticForm (CircleMatrix C) x + + dotProduct ![b.1, b.2] ![(x.re : ℝ), (x.im : ℝ)] + have hDfilterProp := PeriodicIndegreeGeometry.hDfilterProp T h hDcells + let B : Finset GaussianInt := T.cells.filter + (fun x => x ∈ BoundaryFootprintVertices T) + have hcell_partition : D.card + B.card = T.cells.card := + PeriodicIndegreeGeometry.hcell_partition T h hDfilterProp + have hsum_sigma : + (∑ x ∈ D, (2 + FourNeighborLaplacian g x)) = + (2 * D.card : ℤ) + 1 - B.card := PeriodicIndegreeGeometry.hsum_sigma T h g + (PeriodicIndegreeGeometry.hD_lap_int T h g (PeriodicIndegreeGeometry.hD_lap_real T h + g (PeriodicIndegreeGeometry.hsumDelta_one C T g hcell_curv + (PeriodicIndegreeGeometry.hsumDelta C T g b (PeriodicIndegreeGeometry.hFstencil_sum C + T g hsumTranslate b hFperiod) (PeriodicIndegreeGeometry.hFlap C g b + (PeriodicIndegreeGeometry.hsym C) (PeriodicIndegreeGeometry.hF_eq C g b))) + (PeriodicIndegreeGeometry.htrace C) (PeriodicIndegreeGeometry.hcurvCast C)) + (PeriodicIndegreeGeometry.hsum_partition T h hDfilterProp) + (PeriodicIndegreeGeometry.hB_lap T g hweb))) + rw [hsum_sigma] + have hc := hcountBridge D hDmem hsectorAll + have hpairfilter : ((D.product D).filter fun (e : GaussianInt × GaussianInt) => + @decide (FourNeighborAdjacent e.1 e.2) (Classical.propDecidable _)) = + ((D.product D).filter fun e => FourNeighborAdjacent e.1 e.2) := + PeriodicIndegreeGeometry.hpairfilter T h + rw [hpairfilter, hordered] + have hhalf : + (2 * ((D.filter fun z => z + 1 ∈ D).card + + (D.filter fun z => z + (⟨0, 1⟩ : GaussianInt) ∈ D).card)) / 2 = + (D.filter fun z => z + 1 ∈ D).card + + (D.filter fun z => z + (⟨0, 1⟩ : GaussianInt) ∈ D).card := PeriodicIndegreeGeometry.hhalf + C T h g p R + rw [hhalf] + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PlaneEmbeddingAgreement.lean b/LeanPool/ApollonianSuperharmonic/PlaneEmbeddingAgreement.lean new file mode 100644 index 0000000000..df0bc253f6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PlaneEmbeddingAgreement.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicTileContactRouting +public import LeanPool.ApollonianSuperharmonic.PlaneFaceOrientation + +-- [TABLET NODE: PlaneEmbeddingAgreement] + +/-! +# PlaneEmbeddingAgreement + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $P$ be a periodic tile complex and let $R$ be a +`PeriodicTileContactRouting`. A plane-embedding agreement records +the geometric side components and the induced rotation system of $R$, and +compares them with the fixed cellular embedding of $P$. + +More precisely, it chooses a coherent fixed-face orientation in the sense +of `PlaneFaceOrientation`. For each directed prescribed edge +$ab$, it chooses one of its two fixed incident faces, denoted +$F_R(a,b)$, and the corresponding open connected component $S_R(a,b)$ of +the complement of the routed vertices and arcs. The full routed arc +$A_{ab}$ lies in the frontier of both $S_R(a,b)$ and $S_R(b,a)$; these two +components are disjoint. Component means maximal open connected subset of +the drawing complement. The two labels $F_R(a,b)$ and $F_R(b,a)$ are +distinct and exhaust the two fixed faces incident to $ab$, and directed +edges labeled by the same fixed face select the same complementary +component. Consequently the labels describe the cyclic order actually +induced by the routed arcs, rather than an independently stored abstract +order. + +One Boolean records the single global orientation choice. Simultaneously +for every directed edge, $F_R(a,b)$ is the fixed left face of $ab$ when +the Boolean is false and the fixed left face of $ba$ when it is true. +Thus the two fixed incident faces are individually identified with the two +geometric sides of every routed edge, up to one global reversal. No +ambient homeomorphism and no exact transport of the fixed face regions is +part of the agreement. +-/ +structure PlaneEmbeddingAgreement {ι : Type} + (P : PeriodicTileComplex ι) (R : PeriodicTileContactRouting P) where +-- BODY + /-- The coherent orientation of the fixed face sides. -/ + fixedOrientation : PlaneFaceOrientation P.plane + /-- The fixed face label occupying the selected geometric side of a routed directed edge. -/ + routedLeftFace : ι → ι → P.plane.Face + /-- The maximal open complementary component on that routed directed side. -/ + routedLeftSide : ι → ι → Set (Real × Real) + /-- The single global choice comparing the routed and fixed orientations. -/ + reversed : Bool + routed_left_incident : ∀ a b, P.plane.adjacent a b → + (∃ i, P.plane.faceVertex (routedLeftFace a b) i = a) ∧ + (∃ i, P.plane.faceVertex (routedLeftFace a b) i = b) + routed_opposite_faces : ∀ a b, P.plane.adjacent a b → + routedLeftFace a b ≠ routedLeftFace b a + routed_sides_exhaust_faces : ∀ a b, P.plane.adjacent a b → + ∀ f : P.plane.Face, + ((∃ i, P.plane.faceVertex f i = a) ∧ + (∃ i, P.plane.faceVertex f i = b)) → + f = routedLeftFace a b ∨ f = routedLeftFace b a + routed_side_open : ∀ a b, P.plane.adjacent a b → + IsOpen (routedLeftSide a b) + routed_side_connected : ∀ a b, P.plane.adjacent a b → + IsConnected (routedLeftSide a b) + routed_side_avoids_drawing : ∀ a b, P.plane.adjacent a b → + Disjoint (routedLeftSide a b) + (Set.range R.position ∪ + {p | ∃ c d, P.plane.adjacent c d ∧ p ∈ R.edgeArc c d}) + routed_edge_in_side_frontiers : ∀ a b, P.plane.adjacent a b → + R.edgeArc a b ⊆ + frontier (routedLeftSide a b) ∩ frontier (routedLeftSide b a) + routed_opposite_sides : ∀ a b, P.plane.adjacent a b → + Disjoint (routedLeftSide a b) (routedLeftSide b a) + routed_side_component : ∀ a b, P.plane.adjacent a b → + ∀ U : Set (Real × Real), IsOpen U → IsConnected U → + Disjoint U + (Set.range R.position ∪ + {p | ∃ c d, P.plane.adjacent c d ∧ p ∈ R.edgeArc c d}) → + (U ∩ routedLeftSide a b).Nonempty → U ⊆ routedLeftSide a b + same_face_same_side : ∀ a b c d, + P.plane.adjacent a b → P.plane.adjacent c d → + routedLeftFace a b = routedLeftFace c d → + routedLeftSide a b = routedLeftSide c d + face_side_agreement : ∀ a b, P.plane.adjacent a b → + routedLeftFace a b = + if reversed = true then fixedOrientation.leftFace b a + else fixedOrientation.leftFace a b + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PlaneFaceOrientation.lean b/LeanPool/ApollonianSuperharmonic/PlaneFaceOrientation.lean new file mode 100644 index 0000000000..ee454e4ce5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PlaneFaceOrientation.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation + +-- [TABLET NODE: PlaneFaceOrientation] + +/-! +# PlaneFaceOrientation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $G$ be a locally finite cellular plane triangulation. A coherent +orientation of its face sides chooses, for every directed graph edge +$a b$, one of the two incident faces, denoted $L(a,b)$. The chosen face +contains both endpoints, $L(a,b)\ne L(b,a)$, and these two faces exhaust +the faces incident to the unoriented edge $\{a,b\}$. The choices are +coherent when the three directed boundary edges of every triangular face +can be cyclically ordered so that the face lies on the chosen left side of +all three. Reversing every directed edge produces the global opposite +convention; the definition does not impose an orientation on the +arbitrary stored numbering of the three vertices of a face. +-/ +structure PlaneFaceOrientation {ι : Type} (G : PlaneTriangulation ι) where +-- BODY + /-- The coherently selected incident face to the left of each directed edge. -/ + leftFace : ι → ι → G.Face + left_incident : ∀ a b, G.adjacent a b → + (∃ i, G.faceVertex (leftFace a b) i = a) ∧ + (∃ i, G.faceVertex (leftFace a b) i = b) + opposite_sides : ∀ a b, G.adjacent a b → + leftFace a b ≠ leftFace b a + sides_exhaust_faces : ∀ a b, G.adjacent a b → ∀ f : G.Face, + ((∃ i, G.faceVertex f i = a) ∧ (∃ i, G.faceVertex f i = b)) → + f = leftFace a b ∨ f = leftFace b a + coherently_oriented : ∀ f : G.Face, ∃ σ : Equiv.Perm (Fin 3), + leftFace (G.faceVertex f (σ 0)) (G.faceVertex f (σ 1)) = f ∧ + leftFace (G.faceVertex f (σ 1)) (G.faceVertex f (σ 2)) = f ∧ + leftFace (G.faceVertex f (σ 2)) (G.faceVertex f (σ 0)) = f + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PlaneTriangulation.lean b/LeanPool/ApollonianSuperharmonic/PlaneTriangulation.lean new file mode 100644 index 0000000000..119f22c53d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PlaneTriangulation.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: PlaneTriangulation] + +/-! +# PlaneTriangulation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A locally finite, $3$-connected cellular plane triangulation consists of a +simple locally finite graph, triangular faces with every edge incident to +exactly two distinct faces, and a cellular embedding in $\mathbb R^2$. +The two faces are given without an ordering: every other face incident to +that edge is one of them. The embedding records distinct vertex positions +and, for every adjacent pair, an arc homeomorphic to $[0,1]$ whose two +endpoints are the two vertex positions. Distinct edge arcs are disjoint when +their edges are disjoint and otherwise meet exactly at their common endpoint. +It also records pairwise-disjoint open connected face regions whose frontiers +are exactly the three incident arcs and whose vertices, arcs, and regions +cover the plane. Three-connectivity means that deleting any set of fewer +than three vertices leaves a path between any two remaining vertices. +-/ +structure PlaneTriangulation (ι : Type) where +-- BODY + /-- The simple locally finite graph adjacency relation. -/ + adjacent : ι → ι → Prop + /-- The type of triangular face labels of the fixed cellular embedding. -/ + Face : Type + /-- The three numbered graph vertices of each face. -/ + faceVertex : Face → Fin 3 → ι + /-- The injective plane position of each graph vertex. -/ + position : ι → Real × Real + /-- The symmetric embedded arc on each graph edge. -/ + edgeArc : ι → ι → Set (Real × Real) + /-- The open connected region enclosed by the three arcs of each face. -/ + faceRegion : Face → Set (Real × Real) + adjacent_symmetric : ∀ a b, adjacent a b ↔ adjacent b a + adjacent_irreflexive : ∀ a, ¬ adjacent a a + locally_finite : ∀ a, Set.Finite {b | adjacent a b} + three_connected : ∀ (D : Finset ι), D.card < 3 → + ∀ a ∉ D, ∀ b ∉ D, ∃ p : List ι, + p.head? = some a ∧ p.getLast? = some b ∧ + (∀ x ∈ p, x ∉ D) ∧ + ∀ x y : ι, ∀ l₁ l₂ : List ι, + p = l₁ ++ x :: y :: l₂ → adjacent x y + face_vertices_distinct : ∀ f, Function.Injective (faceVertex f) + face_edges : ∀ f i j, i ≠ j → adjacent (faceVertex f i) (faceVertex f j) + every_edge_two_faces : ∀ a b, adjacent a b → + ∃ f g : Face, f ≠ g ∧ + ((∃ i, faceVertex f i = a) ∧ (∃ i, faceVertex f i = b)) ∧ + ((∃ i, faceVertex g i = a) ∧ (∃ i, faceVertex g i = b)) ∧ + ∀ h : Face, + ((∃ i, faceVertex h i = a) ∧ (∃ i, faceVertex h i = b)) → + h = f ∨ h = g + position_injective : Function.Injective position + arc_symmetric : ∀ a b, edgeArc a b = edgeArc b a + arc_homeomorph : ∀ a b, adjacent a b → + ∃ h : (Set.Icc (0 : Real) 1) ≃ₜ edgeArc a b, + ((h ⟨0, by norm_num⟩ : edgeArc a b) : Real × Real) = position a ∧ + ((h ⟨1, by norm_num⟩ : edgeArc a b) : Real × Real) = position b + arc_intersections : ∀ a b c d, adjacent a b → adjacent c d → + ({a, b} : Set ι) ≠ ({c, d} : Set ι) → + edgeArc a b ∩ edgeArc c d = + position '' (({a, b} : Set ι) ∩ ({c, d} : Set ι)) + region_open : ∀ f, IsOpen (faceRegion f) + region_connected : ∀ f, IsConnected (faceRegion f) + region_disjoint : Pairwise fun f g => Disjoint (faceRegion f) (faceRegion g) + face_boundary : ∀ f, + frontier (faceRegion f) = + edgeArc (faceVertex f 0) (faceVertex f 1) ∪ + edgeArc (faceVertex f 1) (faceVertex f 2) ∪ + edgeArc (faceVertex f 2) (faceVertex f 0) + plane_cover : Set.range position ∪ + {p | ∃ a b, adjacent a b ∧ p ∈ edgeArc a b} ∪ + {p | ∃ f, p ∈ faceRegion f} = Set.univ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PointwiseDiagonalCompactness.lean b/LeanPool/ApollonianSuperharmonic/PointwiseDiagonalCompactness.lean new file mode 100644 index 0000000000..4aa09e855e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PointwiseDiagonalCompactness.lean @@ -0,0 +1,808 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Topology.Algebra.Ring.Real +public import Mathlib.Topology.Instances.Matrix +public import Mathlib.Topology.MetricSpace.ProperSpace.Real +public import Mathlib.Topology.Sequences +public import LeanPool.ApollonianSuperharmonic.IntegerLaplacianCastBridge +public import LeanPool.ApollonianSuperharmonic.LocalExponentialEstimate +public import LeanPool.ApollonianSuperharmonic.QuadraticAffineLaplacian +public import LeanPool.ApollonianSuperharmonic.RealLaplacianLinearity + +-- [TABLET NODE: PointwiseDiagonalCompactness] + +/-! +# PointwiseDiagonalCompactness + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiagonalCompactnessProof + +private theorem hw0 : + (by + classical + exact + ∀ (B : ℕ → Matrix (Fin (2 : ℕ)) (Fin (2 : ℕ)) ℝ), ∀ (b : ℕ → Fin (2 : ℕ) → ℝ), ∀ (u : ℕ → + IntegerLatticeFunction), (∀ (k : ℕ), u k (0 : GaussianInt) = (0 : ℤ)) → ( + let w : Nat → GaussianInt → Real := fun k x => + (u k x : Real) - LatticeQuadraticForm (B k) x - + dotProduct (b k) ![(x.re : Real), (x.im : Real)] + ∀ k, w k 0 = 0) ) := by + classical + intro B b u hu0 w k + simp [w, hu0 k, LatticeQuadraticForm, dotProduct] + +private theorem hwpos : + (by + classical + exact + ∀ (B : ℕ → Matrix (Fin (2 : ℕ)) (Fin (2 : ℕ)) ℝ), ∀ (b : ℕ → Fin (2 : ℕ) → ℝ), ∀ (u : ℕ → + IntegerLatticeFunction), (∀ (k : ℕ), ∀ (x : GaussianInt), LatticeQuadraticForm (B k) + x + b k ⬝ᵥ ![(↑x.re : ℝ), (↑x.im : ℝ)] ≤ (↑(u k x) : ℝ)) → ( + let w : Nat → GaussianInt → Real := fun k x => + (u k x : Real) - LatticeQuadraticForm (B k) x - + dotProduct (b k) ![(x.re : Real), (x.im : Real)] + ∀ k, ∀ x, 0 ≤ w k x) ) := by + classical + intro B b u hulower w k x + dsimp [w] + linarith [hulower k x] + +private theorem hwl : + (by + classical + exact + ∀ (B : ℕ → Matrix (Fin (2 : ℕ)) (Fin (2 : ℕ)) ℝ), ∀ (b : ℕ → Fin (2 : ℕ) → ℝ), ∀ (u : ℕ → + IntegerLatticeFunction), ∀ (M : ℝ), (∀ (k : ℕ), (B k).IsSymm) → ((∀ (k : ℕ), ∀ (x : + GaussianInt), FourNeighborLaplacian (u k) x ≤ (1 : ℤ)) → ((∀ (k : ℕ), (1 : ℝ) - (B + k).trace ≤ M) → ( + let w : Nat → GaussianInt → Real := fun k x => + (u k x : Real) - LatticeQuadraticForm (B k) x - + dotProduct (b k) ![(x.re : Real), (x.im : Real)] + ∀ k, ∀ x, RealFourNeighborLaplacian (w k) x ≤ M))) ) := by + classical + intro B b u M hBsymm hulap htrace w k x + dsimp [w] + have hshape : (fun y => (u k y : Real) - LatticeQuadraticForm (B k) y - + dotProduct (b k) ![(y.re : Real), (y.im : Real)]) = + (fun y => (u k y : Real) - (LatticeQuadraticForm (B k) y + + dotProduct (b k) ![(y.re : Real), (y.im : Real)])) := by + funext y + ring + rw [hshape] + have hlin := RealLaplacianLinearity + (fun y => (u k y : Real)) + (fun y => LatticeQuadraticForm (B k) y + + dotProduct (b k) ![(y.re : Real), (y.im : Real)]) 1 (-1) x + have hwexpr : (fun y => (u k y : Real) - (LatticeQuadraticForm (B k) y + + dotProduct (b k) ![(y.re : Real), (y.im : Real)])) = + (fun y => 1 * (u k y : Real) + (-1) * + (LatticeQuadraticForm (B k) y + + dotProduct (b k) ![(y.re : Real), (y.im : Real)])) := by + funext y + simp + ring + rw [hwexpr] + rw [hlin] + have hq := QuadraticAffineLaplacian (B k) (hBsymm k) (b k) 0 x + simp only [one_mul, neg_one_mul, add_zero] at hq ⊢ + have hc : RealFourNeighborLaplacian (fun y => (u k y : Real)) x ≤ 1 := by + rw [IntegerLaplacianCastBridge] + exact_mod_cast hulap k x + rw [hq] + have ht := htrace k + linarith + +private theorem hwb : + (by + classical + exact + ∀ (B : ℕ → Matrix (Fin (2 : ℕ)) (Fin (2 : ℕ)) ℝ), ∀ (b : ℕ → Fin (2 : ℕ) → ℝ), ∀ (u : ℕ → + IntegerLatticeFunction), ∀ (M : ℝ), + let w : Nat → GaussianInt → Real := fun k x => + (u k x : Real) - LatticeQuadraticForm (B k) x - + dotProduct (b k) ![(x.re : Real), (x.im : Real)] + (∀ k, w k 0 = 0) → ((∀ k, ∀ x, 0 ≤ w k x) → ((∀ k, ∀ x, RealFourNeighborLaplacian (w k) x + ≤ M) → (∀ k, ∀ x, w k x ≤ (4 : Real) ^ (x.re.natAbs + x.im.natAbs) * (0 : Real) + M * + (((4 : Real) ^ (x.re.natAbs + x.im.natAbs) - 1) / 3)))) ) := by + classical + intro B b u M w hw0 hwpos hwl k x + simpa [hw0 k] using LocalExponentialEstimate (w k) M (hwpos k) (hwl k) x + +private theorem hentry : + (by + classical + exact + ∀ (A : Matrix (Fin (2 : ℕ)) (Fin (2 : ℕ)) ℝ), ∀ (B : ℕ → Matrix (Fin (2 : ℕ)) (Fin (2 : + ℕ)) ℝ), (∀ (i : Fin (2 : ℕ)), ∀ (j : Fin (2 : ℕ)), Filter.Tendsto (fun (k : ℕ) => B k + i j) Filter.atTop (nhds (A i j))) → (∀ i j : Fin 2, ∃ lo hi : Real, ∀ k, lo ≤ B k i j + ∧ B k i j ≤ hi) ) := by + classical + intro A B hconv i j + have hu : ∀ᶠ k in Filter.atTop, B k i j < A i j + 1 := + (hconv i j) (Iio_mem_nhds (by linarith)) + have hl : ∀ᶠ k in Filter.atTop, A i j - 1 < B k i j := + (hconv i j) (Ioi_mem_nhds (by linarith)) + obtain ⟨K, hK⟩ := Filter.eventually_atTop.mp hu + obtain ⟨L, hL⟩ := Filter.eventually_atTop.mp hl + let N := max K L + let values := (Finset.range (N + 1)).image (fun k => B k i j) + have values_ne : values.Nonempty := by + refine ⟨B 0 i j, ?_⟩ + exact Finset.mem_image.mpr ⟨0, by simp, rfl⟩ + let lo := min (A i j - 1) (values.min' values_ne) + let hi := max (A i j + 1) (values.max' values_ne) + refine ⟨lo, hi, ?_⟩ + intro k + have hmem : ∀ {r : Real}, r ∈ values → lo ≤ r ∧ r ≤ hi := by + intro r hr + exact ⟨le_trans (min_le_right _ _) (Finset.min'_le values r hr), + le_trans (Finset.le_max' values r hr) (le_max_of_le_right (le_refl _))⟩ + by_cases hk : k ≤ N + · have hkr : k ∈ Finset.range (N + 1) := by simp [hk] + have hr : B k i j ∈ values := Finset.mem_image.mpr ⟨k, hkr, rfl⟩ + exact hmem hr + · have hkK : K ≤ k := le_trans (le_max_left _ _) (Nat.le_of_not_ge hk) + have hkL : L ≤ k := le_trans (le_max_right _ _) (Nat.le_of_not_ge hk) + constructor + · exact le_trans (min_le_left _ _) (le_of_lt (hL k hkL)) + · exact le_trans (le_of_lt (hK k hkK)) (le_max_left _ _) + +private theorem hub : + (by + classical + exact + ∀ (B : ℕ → Matrix (Fin (2 : ℕ)) (Fin (2 : ℕ)) ℝ), ∀ (b : ℕ → Fin (2 : ℕ) → ℝ), ∀ (u : ℕ → + IntegerLatticeFunction), ∀ (M : ℝ), (∀ (k : ℕ), ∀ (i : Fin (2 : ℕ)), |b k i| ≤ (1 : + ℝ)) → ( + let w : Nat → GaussianInt → Real := fun k x => + (u k x : Real) - LatticeQuadraticForm (B k) x - + dotProduct (b k) ![(x.re : Real), (x.im : Real)] + (∀ k, ∀ x, 0 ≤ w k x) → ((∀ k, ∀ x, w k x ≤ (4 : Real) ^ (x.re.natAbs + x.im.natAbs) * (0 + : Real) + M * (((4 : Real) ^ (x.re.natAbs + x.im.natAbs) - 1) / 3)) → ((∀ i j : Fin + 2, ∃ lo hi : Real, ∀ k, lo ≤ B k i j ∧ B k i j ≤ hi) → (∀ x, ∃ C : Real, ∀ k, |(u k x + : Real)| ≤ C)))) ) := by + classical + intro B b u M hb w hwpos hwb hentry x + rcases hentry 0 0 with ⟨l00, u00, hL00⟩ + rcases hentry 0 1 with ⟨l01, u01, hL01⟩ + rcases hentry 1 0 with ⟨l10, u10, hL10⟩ + rcases hentry 1 1 with ⟨l11, u11, hL11⟩ + refine ⟨M * (((4 : Real) ^ (x.re.natAbs + x.im.natAbs) - 1) / 3) + + |(x.re : Real)| * (|l00| + |u00|) * |(x.re : Real)| / 2 + + |(x.re : Real)| * (|l01| + |u01|) * |(x.im : Real)| / 2 + + |(x.im : Real)| * (|l10| + |u10|) * |(x.re : Real)| / 2 + + |(x.im : Real)| * (|l11| + |u11|) * |(x.im : Real)| / 2 + + |(x.re : Real)| + |(x.im : Real)| + 10, ?_⟩ + intro k + have hw := hwb k x + have hp := hwpos k x + have h00' := hL00 k + have h01' := hL01 k + have h10' := hL10 k + have h11' := hL11 k + have hb0 := hb k 0 + have hb1 := hb k 1 + dsimp [w] at hw + dsimp [w] at hp + simp? [LatticeQuadraticForm, Matrix.mulVec, dotProduct] at hw ⊢ + simp? [LatticeQuadraticForm, Matrix.mulVec, dotProduct] at hp + have e00 : |B k 0 0| ≤ |l00| + |u00| := by + rw [abs_le] + constructor <;> nlinarith [h00'.1, h00'.2, neg_le_abs l00, neg_le_abs u00, + le_abs_self l00, le_abs_self u00] + have e01 : |B k 0 1| ≤ |l01| + |u01| := by + rw [abs_le] + constructor <;> nlinarith [h01'.1, h01'.2, neg_le_abs l01, neg_le_abs u01, + le_abs_self l01, le_abs_self u01] + have e10 : |B k 1 0| ≤ |l10| + |u10| := by + rw [abs_le] + constructor <;> nlinarith [h10'.1, h10'.2, neg_le_abs l10, neg_le_abs u10, + le_abs_self l10, le_abs_self u10] + have e11 : |B k 1 1| ≤ |l11| + |u11| := by + rw [abs_le] + constructor <;> nlinarith [h11'.1, h11'.2, neg_le_abs l11, neg_le_abs u11, + le_abs_self l11, le_abs_self u11] + have hxre : (GaussianInt.toComplex x).re = (x.re : Real) := by + exact (GaussianInt.intCast_re x).symm + have hxim : (GaussianInt.toComplex x).im = (x.im : Real) := by + exact (GaussianInt.intCast_im x).symm + have q00 : |(GaussianInt.toComplex x).re * (B k 0 0 * (GaussianInt.toComplex x).re)| ≤ + |(x.re : Real)| * (|l00| + |u00|) * |(x.re : Real)| := by + rw [hxre] + rw [abs_mul, abs_mul] + calc + |(x.re : Real)| * (|B k 0 0| * |(x.re : Real)|) ≤ + |(x.re : Real)| * ((|l00| + |u00|) * |(x.re : Real)|) := by + gcongr + _ = _ := by ring + have q01 : |(GaussianInt.toComplex x).re * (B k 0 1 * (GaussianInt.toComplex x).im)| ≤ + |(x.re : Real)| * (|l01| + |u01|) * |(x.im : Real)| := by + rw [hxre, hxim] + rw [abs_mul, abs_mul] + calc + |(x.re : Real)| * (|B k 0 1| * |(x.im : Real)|) ≤ + |(x.re : Real)| * ((|l01| + |u01|) * |(x.im : Real)|) := by + gcongr + _ = _ := by ring + have q10 : |(GaussianInt.toComplex x).im * (B k 1 0 * (GaussianInt.toComplex x).re)| ≤ + |(x.im : Real)| * (|l10| + |u10|) * |(x.re : Real)| := by + rw [hxim, hxre] + rw [abs_mul, abs_mul] + calc + |(x.im : Real)| * (|B k 1 0| * |(x.re : Real)|) ≤ + |(x.im : Real)| * ((|l10| + |u10|) * |(x.re : Real)|) := by + gcongr + _ = _ := by ring + have q11 : |(GaussianInt.toComplex x).im * (B k 1 1 * (GaussianInt.toComplex x).im)| ≤ + |(x.im : Real)| * (|l11| + |u11|) * |(x.im : Real)| := by + rw [hxim] + rw [abs_mul, abs_mul] + calc + |(x.im : Real)| * (|B k 1 1| * |(x.im : Real)|) ≤ + |(x.im : Real)| * ((|l11| + |u11|) * |(x.im : Real)|) := by + gcongr + _ = _ := by ring + have d0 : |b k 0 * (GaussianInt.toComplex x).re| ≤ |(x.re : Real)| := by + rw [hxre] + rw [abs_mul] + calc + |b k 0| * |(x.re : Real)| ≤ 1 * |(x.re : Real)| := by + gcongr + _ = _ := by ring + have d1 : |b k 1 * (GaussianInt.toComplex x).im| ≤ |(x.im : Real)| := by + rw [hxim] + rw [abs_mul] + calc + |b k 1| * |(x.im : Real)| ≤ 1 * |(x.im : Real)| := by + gcongr + _ = _ := by ring + rw [hxre, hxim] at hw ⊢ + simp only [hxre, hxim] at hp + simp only [hxre, hxim] at q00 q01 q10 q11 d0 d1 + have hu : (u k x : Real) ≤ M * (((4 : Real) ^ (x.re.natAbs + x.im.natAbs) - 1) / 3) + + |(x.re : Real)| * (|l00| + |u00|) * |(x.re : Real)| / 2 + + |(x.re : Real)| * (|l01| + |u01|) * |(x.im : Real)| / 2 + + |(x.im : Real)| * (|l10| + |u10|) * |(x.re : Real)| / 2 + + |(x.im : Real)| * (|l11| + |u11|) * |(x.im : Real)| / 2 + + |(x.re : Real)| + |(x.im : Real)| + 10 := by + linarith [q00, q01, q10, q11, d0, d1, + le_abs_self (b k 0 * (x.re : Real)), + le_abs_self (b k 1 * (x.im : Real)), + le_abs_self ((x.re : Real) * (B k 0 0 * (x.re : Real))), + le_abs_self ((x.re : Real) * (B k 0 1 * (x.im : Real))), + le_abs_self ((x.im : Real) * (B k 1 0 * (x.re : Real))), + le_abs_self ((x.im : Real) * (B k 1 1 * (x.im : Real))), + abs_nonneg l00, abs_nonneg u00, abs_nonneg l01, abs_nonneg u01, + abs_nonneg l10, abs_nonneg u10, abs_nonneg l11, abs_nonneg u11, + abs_nonneg (x.re : Real), abs_nonneg (x.im : Real)] + have hl : -(M * (((4 : Real) ^ (x.re.natAbs + x.im.natAbs) - 1) / 3) + + |(x.re : Real)| * (|l00| + |u00|) * |(x.re : Real)| / 2 + + |(x.re : Real)| * (|l01| + |u01|) * |(x.im : Real)| / 2 + + |(x.im : Real)| * (|l10| + |u10|) * |(x.re : Real)| / 2 + + |(x.im : Real)| * (|l11| + |u11|) * |(x.im : Real)| / 2 + + |(x.re : Real)| + |(x.im : Real)| + 10) ≤ (u k x : Real) := by + linarith [q00, q01, q10, q11, d0, d1, + neg_le_abs (b k 0 * (x.re : Real)), + neg_le_abs (b k 1 * (x.im : Real)), + neg_le_abs ((x.re : Real) * (B k 0 0 * (x.re : Real))), + neg_le_abs ((x.re : Real) * (B k 0 1 * (x.im : Real))), + neg_le_abs ((x.im : Real) * (B k 1 0 * (x.re : Real))), + neg_le_abs ((x.im : Real) * (B k 1 1 * (x.im : Real))), + abs_nonneg l00, abs_nonneg u00, abs_nonneg l01, abs_nonneg u01, + abs_nonneg l10, abs_nonneg u10, abs_nonneg l11, abs_nonneg u11, + abs_nonneg (x.re : Real), abs_nonneg (x.im : Real)] + exact abs_le.2 ⟨hl, hu⟩ + +private theorem enumerate_surj : + (by + classical + exact + ∀ [this : Encodable GaussianInt], + let enumerate : Nat → GaussianInt := fun n => + (Encodable.decode n).getD 0 + ∀ x : GaussianInt, ∃ n, enumerate n = x ) := by + classical + intro this enumerate x + refine ⟨Encodable.encode x, ?_⟩ + simp [enumerate, Encodable.encodek] + +private theorem refineFiber : + (by + classical + exact + ∀ (u : ℕ → IntegerLatticeFunction), (∀ x, ∃ C : Real, ∀ k, |(u k x : Real)| ≤ C) → (∀ x : + GaussianInt, ∀ s : Set Nat, s.Infinite → ∃ t : Set Nat, t ⊆ s ∧ t.Infinite ∧ ∃ z : + Int, ∀ k ∈ t, u k x = z) ) := by + classical + intro u hub x s hs + obtain ⟨C, hC⟩ := hub x + let bound : Set Int := {z | |(z : Real)| ≤ C} + let N : Nat := ⌈C⌉₊ + let positive : Set Int := {z | 0 ≤ z ∧ z.natAbs ≤ N} + let negative : Set Int := {z | z ≤ 0 ∧ z.natAbs ≤ N} + have hposimage : (Int.natAbs '' positive) ⊆ Set.Iic N := by + intro n hn + rcases hn with ⟨z, hz, rfl⟩ + exact hz.2 + have hnegimage : (Int.natAbs '' negative) ⊆ Set.Iic N := by + intro n hn + rcases hn with ⟨z, hz, rfl⟩ + exact hz.2 + have hpos : positive.Finite := + (Set.finite_Iic N).subset hposimage |>.of_finite_image + (fun z hz w hw h => by + have hh := congrArg (fun n : Nat => (n : Int)) h + simpa [Int.natAbs_of_nonneg hz.1, Int.natAbs_of_nonneg hw.1] using hh) + have hneg : negative.Finite := + (Set.finite_Iic N).subset hnegimage |>.of_finite_image + (fun z hz w hw h => by + have hh := congrArg (fun n : Nat => (n : Int)) h + have ha : (-z : Int) = (z.natAbs : Int) := by + simpa using (Int.natAbs_of_nonneg (neg_nonneg.mpr hz.1)).symm + have hb : (-w : Int) = (w.natAbs : Int) := by + simpa using (Int.natAbs_of_nonneg (neg_nonneg.mpr hw.1)).symm + rw [← ha, ← hb] at hh + simpa using congrArg Neg.neg hh) + have hfinite : bound.Finite := by + apply hpos.union hneg |>.subset + intro z hz + change |(z : Real)| ≤ C at hz + by_cases hz0 : 0 ≤ z + · left + exact ⟨hz0, by + have hc : 0 ≤ C := by + exact le_trans (abs_nonneg (u 0 x : Real)) (hC 0) + have hn : C ≤ (N : Real) := by exact_mod_cast Nat.le_ceil C + have hzN : (z.natAbs : Real) ≤ (N : Real) := by + have he : (z.natAbs : Real) = (z : Real) := by + exact congrArg (fun q : Int => (q : Real)) (Int.natAbs_of_nonneg hz0) + rw [he] + exact (abs_le.mp hz).2.trans hn + exact_mod_cast hzN⟩ + · right + have hz0' : z ≤ 0 := le_of_not_ge hz0 + exact ⟨hz0', by + have hc : 0 ≤ C := by + exact le_trans (abs_nonneg (u 0 x : Real)) (hC 0) + have hn : C ≤ (N : Real) := by exact_mod_cast Nat.le_ceil C + have hzN : ((-z).natAbs : Real) ≤ (N : Real) := by + have he : ((-z).natAbs : Real) = (-z : Real) := by + simpa using congrArg (fun q : Int => (q : Real)) + (Int.natAbs_of_nonneg (neg_nonneg.mpr hz0')) + rw [he] + linarith [abs_le.mp hz |>.1, hn] + simpa only [Int.natAbs_neg] using (show (-z).natAbs ≤ N by exact_mod_cast hzN)⟩ + let : Fintype bound := hfinite.fintype + let α := {k : Nat // k ∈ s} + let : Infinite α := hs.to_subtype + let mapValue : α → bound := fun k => + ⟨u k.1 x, by exact hC k.1⟩ + obtain ⟨y, hy⟩ := Finite.exists_infinite_fiber mapValue + let p : Set α := mapValue ⁻¹' ({y} : Set bound) + let t : Set Nat := (fun k : α => k.1) '' p + refine ⟨t, ?_, ?_, ?_⟩ + · intro k hk + obtain ⟨q, hq, rfl⟩ := hk + exact q.2 + · have ht : p.Infinite := Set.infinite_coe_iff.mp hy + exact Set.Infinite.image (fun a _ b _ h => Subtype.ext h) ht + · refine ⟨y.1, ?_⟩ + intro k hk + obtain ⟨q, hq, rfl⟩ := hk + have he : mapValue q = y := hq + exact congrArg Subtype.val he + +private theorem seq_step : + (by + classical + exact + ∀ (u : ℕ → IntegerLatticeFunction), ∀ [this : Encodable GaussianInt], + let enumerate : Nat → GaussianInt := fun n => + (Encodable.decode n).getD 0 + ∀ (refineFiber : ∀ x : GaussianInt, ∀ s : Set Nat, s.Infinite → ∃ t : Set Nat, t ⊆ s ∧ + t.Infinite ∧ ∃ z : Int, ∀ k ∈ t, u k x = z), + let next (n : Nat) (s : Set Nat) (hs : s.Infinite) : Set Nat := + Classical.choose (refineFiber (enumerate n) s hs) + ∀ (next_spec : ∀ (n : Nat), ∀ (s : Set Nat), ∀ (hs : s.Infinite), next n s hs ⊆ s ∧ (next + n s hs).Infinite ∧ ∃ z, ∀ k ∈ next n s hs, u k (enumerate n) = z), + let good : Type := {s : Set Nat // s.Infinite} + let seq : Nat → good := Nat.rec ⟨Set.univ, Set.infinite_univ⟩ + (fun n q => ⟨next n q.1 q.2, (next_spec n q.1 q.2).2.1⟩) + ∀ (n : Nat), seq (n + 1) = ⟨next n (seq n).1 (seq n).2, (next_spec n (seq n).1 (seq + n).2).2.1⟩ ) := by + classical + intro u this enumerate refineFiber next next_spec good seq n + rfl + +private theorem seq_nested : + (by + classical + exact + ∀ (u : ℕ → IntegerLatticeFunction), ∀ [this : Encodable GaussianInt], + let enumerate : Nat → GaussianInt := fun n => + (Encodable.decode n).getD 0 + ∀ (refineFiber : ∀ x : GaussianInt, ∀ s : Set Nat, s.Infinite → ∃ t : Set Nat, t ⊆ s ∧ + t.Infinite ∧ ∃ z : Int, ∀ k ∈ t, u k x = z), + let next (n : Nat) (s : Set Nat) (hs : s.Infinite) : Set Nat := + Classical.choose (refineFiber (enumerate n) s hs) + ∀ (next_spec : ∀ (n : Nat), ∀ (s : Set Nat), ∀ (hs : s.Infinite), next n s hs ⊆ s ∧ (next + n s hs).Infinite ∧ ∃ z, ∀ k ∈ next n s hs, u k (enumerate n) = z), + let good : Type := {s : Set Nat // s.Infinite} + let seq : Nat → good := Nat.rec ⟨Set.univ, Set.infinite_univ⟩ + (fun n q => ⟨next n q.1 q.2, (next_spec n q.1 q.2).2.1⟩) + ∀ (m : ℕ), ∀ (n : ℕ), m ≤ n → (seq n).1 ⊆ (seq m).1 ) := by + classical + intro u this enumerate refineFiber next next_spec good seq m n hmn + induction n, hmn using Nat.le_induction with + | base => exact Set.Subset.rfl + | succ n hmn ih => + exact (next_spec n (seq n).1 (seq n).2).1.trans ih + +private theorem phi_spec : + (by + classical + exact + ∀ (u : ℕ → IntegerLatticeFunction), ∀ [this : Encodable GaussianInt], + let enumerate : Nat → GaussianInt := fun n => + (Encodable.decode n).getD 0 + ∀ (refineFiber : ∀ x : GaussianInt, ∀ s : Set Nat, s.Infinite → ∃ t : Set Nat, t ⊆ s ∧ + t.Infinite ∧ ∃ z : Int, ∀ k ∈ t, u k x = z), + let next (n : Nat) (s : Set Nat) (hs : s.Infinite) : Set Nat := + Classical.choose (refineFiber (enumerate n) s hs) + ∀ (next_spec : ∀ (n : Nat), ∀ (s : Set Nat), ∀ (hs : s.Infinite), next n s hs ⊆ s ∧ (next + n s hs).Infinite ∧ ∃ z, ∀ k ∈ next n s hs, u k (enumerate n) = z), + let good : Type := {s : Set Nat // s.Infinite} + let seq : Nat → good := Nat.rec ⟨Set.univ, Set.infinite_univ⟩ + (fun n q => ⟨next n q.1 q.2, (next_spec n q.1 q.2).2.1⟩) + let first : Nat := Classical.choose (Set.Infinite.exists_gt (seq 0).2 0) + (first ∈ (seq 0).1 ∧ 0 < first) → ( + let phi : Nat → Nat := Nat.rec first + (fun n p => Classical.choose (Set.Infinite.exists_gt (seq (n + 1)).2 p)) + ∀ (n : ℕ), phi n ∈ (seq n).1) ) := by + classical + intro u this enumerate refineFiber next next_spec good seq first first_spec phi n + induction n with + | zero => exact first_spec.1 + | succ n ih => + exact (Classical.choose_spec (Set.Infinite.exists_gt (seq (n + 1)).2 (phi n))).1 + +private theorem phi_mono : + (by + classical + exact + ∀ (u : ℕ → IntegerLatticeFunction), ∀ [this : Encodable GaussianInt], + let enumerate : Nat → GaussianInt := fun n => + (Encodable.decode n).getD 0 + ∀ (refineFiber : ∀ x : GaussianInt, ∀ s : Set Nat, s.Infinite → ∃ t : Set Nat, t ⊆ s ∧ + t.Infinite ∧ ∃ z : Int, ∀ k ∈ t, u k x = z), + let next (n : Nat) (s : Set Nat) (hs : s.Infinite) : Set Nat := + Classical.choose (refineFiber (enumerate n) s hs) + ∀ (next_spec : ∀ (n : Nat), ∀ (s : Set Nat), ∀ (hs : s.Infinite), next n s hs ⊆ s ∧ (next + n s hs).Infinite ∧ ∃ z, ∀ k ∈ next n s hs, u k (enumerate n) = z), + let good : Type := {s : Set Nat // s.Infinite} + let seq : Nat → good := Nat.rec ⟨Set.univ, Set.infinite_univ⟩ + (fun n q => ⟨next n q.1 q.2, (next_spec n q.1 q.2).2.1⟩) + let first : Nat := Classical.choose (Set.Infinite.exists_gt (seq 0).2 0) + let phi : Nat → Nat := Nat.rec first + (fun n p => Classical.choose (Set.Infinite.exists_gt (seq (n + 1)).2 p)) + StrictMono phi ) := by + classical + intro u this enumerate refineFiber next next_spec good seq first phi + apply strictMono_nat_of_lt_succ + intro n + exact (Classical.choose_spec (Set.Infinite.exists_gt (seq (n + 1)).2 (phi n))).2 + +private theorem boundedSubsequence : + (by + classical + exact + ∀ f : Nat → Real, (∀ n, -1 ≤ f n ∧ f n ≤ 1) → ∃ q : Nat → Nat, StrictMono q ∧ ∃ c : Real, + Filter.Tendsto (fun n => f (q n)) Filter.atTop (nhds c) ) := by + classical + intro f hf + obtain ⟨c, _, q, hq, hc⟩ := + (isCompact_Icc : IsCompact (Set.Icc (-1 : Real) 1)).tendsto_subseq hf + exact ⟨q, hq, c, hc⟩ + +private theorem hpsi_ge : + (by + classical + exact + ∀ (q0 : ℕ → ℕ), ∀ (q1 : ℕ → ℕ), + let psi : Nat → Nat := q0 ∘ q1 + (StrictMono psi) → (∀ n, n ≤ psi n) ) := by + classical + intro q0 q1 psi hpsi n + induction n with + | zero => exact Nat.zero_le _ + | succ n ih => + exact Nat.succ_le_of_lt (lt_of_le_of_lt ih (hpsi (Nat.lt_succ_self n))) + +private theorem fiber_spec : + (by + classical + exact + ∀ (u : ℕ → IntegerLatticeFunction), ∀ [this : Encodable GaussianInt], + let enumerate : Nat → GaussianInt := fun n => + (Encodable.decode n).getD 0 + ∀ (enumerate_surj : ∀ x : GaussianInt, ∃ n, enumerate n = x), ∀ (refineFiber : ∀ x : + GaussianInt, ∀ s : Set Nat, s.Infinite → ∃ t : Set Nat, t ⊆ s ∧ t.Infinite ∧ ∃ z : + Int, ∀ k ∈ t, u k x = z), + let next (n : Nat) (s : Set Nat) (hs : s.Infinite) : Set Nat := + Classical.choose (refineFiber (enumerate n) s hs) + ∀ (next_spec : ∀ (n : Nat), ∀ (s : Set Nat), ∀ (hs : s.Infinite), next n s hs ⊆ s ∧ (next + n s hs).Infinite ∧ ∃ z, ∀ k ∈ next n s hs, u k (enumerate n) = z), + let good : Type := {s : Set Nat // s.Infinite} + let seq : Nat → good := Nat.rec ⟨Set.univ, Set.infinite_univ⟩ + (fun n q => ⟨next n q.1 q.2, (next_spec n q.1 q.2).2.1⟩) + let index : GaussianInt → Nat := fun x => Classical.choose (enumerate_surj x) + (∀ (x : GaussianInt), enumerate (index x) = x) → (∀ (x : GaussianInt), ∃ z : Int, ∀ k ∈ + next (index x) (seq (index x)).1 (seq (index x)).2, u k x = z) ) := by + classical + intro u this enumerate enumerate_surj refineFiber next next_spec good seq index index_spec x + simpa [index, index_spec x] using + (next_spec (index x) (seq (index x)).1 (seq (index x)).2).2.2 + +private theorem eventual_eq : + (by + classical + exact + ∀ (u : ℕ → IntegerLatticeFunction), ∀ [this : Encodable GaussianInt], + let enumerate : Nat → GaussianInt := fun n => + (Encodable.decode n).getD 0 + ∀ (enumerate_surj : ∀ x : GaussianInt, ∃ n, enumerate n = x), ∀ (refineFiber : ∀ x : + GaussianInt, ∀ s : Set Nat, s.Infinite → ∃ t : Set Nat, t ⊆ s ∧ t.Infinite ∧ ∃ z : + Int, ∀ k ∈ t, u k x = z), + let next (n : Nat) (s : Set Nat) (hs : s.Infinite) : Set Nat := + Classical.choose (refineFiber (enumerate n) s hs) + ∀ (next_spec : ∀ (n : Nat), ∀ (s : Set Nat), ∀ (hs : s.Infinite), next n s hs ⊆ s ∧ (next + n s hs).Infinite ∧ ∃ z, ∀ k ∈ next n s hs, u k (enumerate n) = z), + let good : Type := {s : Set Nat // s.Infinite} + let seq : Nat → good := Nat.rec ⟨Set.univ, Set.infinite_univ⟩ + (fun n q => ⟨next n q.1 q.2, (next_spec n q.1 q.2).2.1⟩) + (∀ (n : Nat), seq (n + 1) = ⟨next n (seq n).1 (seq n).2, (next_spec n (seq n).1 (seq + n).2).2.1⟩) → ((∀ (m : Nat), ∀ (n : Nat), (m ≤ n) → ((seq n).1 ⊆ (seq m).1)) → ( + let first : Nat := Classical.choose (Set.Infinite.exists_gt (seq 0).2 0) + let phi : Nat → Nat := Nat.rec first + (fun n p => Classical.choose (Set.Infinite.exists_gt (seq (n + 1)).2 p)) + (∀ (n : Nat), phi n ∈ (seq n).1) → (∀ (q0 : ℕ → ℕ), ∀ (q1 : ℕ → ℕ), + let psi : Nat → Nat := q0 ∘ q1 + (∀ n, n ≤ psi n) → ( + let output : Nat → Nat := phi ∘ psi + let index : GaussianInt → Nat := fun x => Classical.choose (enumerate_surj x) + ∀ (fiber_spec : ∀ (x : GaussianInt), ∃ z : Int, ∀ k ∈ next (index x) (seq (index x)).1 + (seq (index x)).2, u k x = z), + let v : IntegerLatticeFunction := fun x => Classical.choose (fiber_spec x) + (∀ (x : GaussianInt), ∀ k ∈ next (index x) (seq (index x)).1 (seq (index x)).2, u k x = v + x) → (∀ (x : GaussianInt), ∃ (K : ℕ), ∀ (k : ℕ), K ≤ k → u (output k) x = v x))))) ) + := by + classical + intro u this enumerate enumerate_surj refineFiber next next_spec good seq seq_step seq_nested + first phi phi_spec q0 q1 psi hpsi_ge output index fiber_spec v v_spec x + let n := index x + refine ⟨n + 1, ?_⟩ + intro k hk + have hm : n + 1 ≤ psi k := le_trans hk (hpsi_ge k) + have hs : phi (psi k) ∈ (seq (n + 1)).1 := + (seq_nested (n + 1) (psi k) hm) (phi_spec (psi k)) + have hs' : phi (psi k) ∈ next n (seq n).1 (seq n).2 := by + simpa [seq_step] using hs + exact v_spec x (phi (psi k)) hs' + +private theorem hlim : + (by + classical + exact + ∀ (A : Matrix (Fin (2 : ℕ)) (Fin (2 : ℕ)) ℝ), ∀ (B : ℕ → Matrix (Fin (2 : ℕ)) (Fin (2 : + ℕ)) ℝ), ∀ (b : ℕ → Fin (2 : ℕ) → ℝ), ∀ (u : ℕ → IntegerLatticeFunction), ∀ [this : + Encodable GaussianInt], + let enumerate : Nat → GaussianInt := fun n => + (Encodable.decode n).getD 0 + ∀ (refineFiber : ∀ x : GaussianInt, ∀ s : Set Nat, s.Infinite → ∃ t : Set Nat, t ⊆ s ∧ + t.Infinite ∧ ∃ z : Int, ∀ k ∈ t, u k x = z), + let next (n : Nat) (s : Set Nat) (hs : s.Infinite) : Set Nat := + Classical.choose (refineFiber (enumerate n) s hs) + ∀ (next_spec : ∀ (n : Nat), ∀ (s : Set Nat), ∀ (hs : s.Infinite), next n s hs ⊆ s ∧ (next + n s hs).Infinite ∧ ∃ z, ∀ k ∈ next n s hs, u k (enumerate n) = z), + let good : Type := {s : Set Nat // s.Infinite} + let seq : Nat → good := Nat.rec ⟨Set.univ, Set.infinite_univ⟩ + (fun n q => ⟨next n q.1 q.2, (next_spec n q.1 q.2).2.1⟩) + let first : Nat := Classical.choose (Set.Infinite.exists_gt (seq 0).2 0) + let phi : Nat → Nat := Nat.rec first + (fun n p => Classical.choose (Set.Infinite.exists_gt (seq (n + 1)).2 p)) + ∀ (q0 : ℕ → ℕ), ∀ (c0 : ℝ), ∀ (q1 : ℕ → ℕ), ∀ (c1 : ℝ), + let psi : Nat → Nat := q0 ∘ q1 + let bInf : Fin 2 → Real := ![c0, c1] + let output : Nat → Nat := phi ∘ psi + ∀ (x : GaussianInt), (Filter.Tendsto ((fun (k : ℕ) => B k (0 : Fin (2 : ℕ)) (0 : Fin (2 : + ℕ))) ∘ output) Filter.atTop (nhds (A (0 : Fin (2 : ℕ)) (0 : Fin (2 : ℕ))))) → + ((Filter.Tendsto ((fun (k : ℕ) => B k (0 : Fin (2 : ℕ)) (1 : Fin (2 : ℕ))) ∘ output) + Filter.atTop (nhds (A (0 : Fin (2 : ℕ)) (1 : Fin (2 : ℕ))))) → ((Filter.Tendsto ((fun + (k : ℕ) => B k (1 : Fin (2 : ℕ)) (0 : Fin (2 : ℕ))) ∘ output) Filter.atTop (nhds (A + (1 : Fin (2 : ℕ)) (0 : Fin (2 : ℕ))))) → ((Filter.Tendsto ((fun (k : ℕ) => B k (1 : + Fin (2 : ℕ)) (1 : Fin (2 : ℕ))) ∘ output) Filter.atTop (nhds (A (1 : Fin (2 : ℕ)) (1 + : Fin (2 : ℕ))))) → ((Filter.Tendsto ((fun (n : ℕ) => b (phi (q0 n)) (0 : Fin (2 : + ℕ))) ∘ q1) Filter.atTop (nhds c0)) → ((Filter.Tendsto (fun (n : ℕ) => b (phi (q0 (q1 + n))) (1 : Fin (2 : ℕ))) Filter.atTop (nhds c1)) → (Filter.Tendsto (fun k => + LatticeQuadraticForm (B (output k)) x + dotProduct (b (output k)) ![(x.re : Real), + (x.im : Real)]) Filter.atTop (nhds (LatticeQuadraticForm A x + dotProduct bInf + ![(x.re : Real), (x.im : Real)])))))))) ) := by + classical + intro A B b u this enumerate refineFiber next next_spec good seq first phi q0 c0 q1 c1 psi bInf + output x h00 h01 h10 h11 hb0 hb1 + have xr : Filter.Tendsto (fun _ : Nat => (x.re : Real)) Filter.atTop + (nhds (x.re : Real)) := tendsto_const_nhds + have xi : Filter.Tendsto (fun _ : Nat => (x.im : Real)) Filter.atTop + (nhds (x.im : Real)) := tendsto_const_nhds + have half : Filter.Tendsto (fun _ : Nat => (2 : Real)⁻¹) Filter.atTop + (nhds ((2 : Real)⁻¹)) := tendsto_const_nhds + have r0 := (h00.mul xr).add (h01.mul xi) + have r1 := (h10.mul xr).add (h11.mul xi) + have q0 := xr.mul r0 + have q1 := xi.mul r1 + have q := half.mul (q0.add q1) + have d := (hb0.mul xr).add (hb1.mul xi) + have all := q.add d + convert all using 1 <;> + simp [LatticeQuadraticForm, Matrix.mulVec, dotProduct, output, bInf, + psi, Function.comp_def] + +end DiagonalCompactnessProof + +theorem PointwiseDiagonalCompactness : + ∀ (A : Matrix (Fin 2) (Fin 2) Real), ∀ (B : Nat -> Matrix (Fin 2) (Fin 2) Real), ∀ (b : Nat + -> Fin 2 -> Real), ∀ (u : Nat -> IntegerLatticeFunction), ∀ (M : Real), (0 <= M) → + ((forall i j, + Filter.Tendsto (fun k => B k i j) Filter.atTop (nhds (A i j))) → ((forall k, (B k).IsSymm) + → ((forall k i, abs (b k i) <= 1) → ((forall k, u k 0 = 0) → ((forall k x, + FourNeighborLaplacian (u k) x <= 1) → ((forall k x, LatticeQuadraticForm (B k) x + + dotProduct (b k) ![(x.re : Real), (x.im : Real)] <= (u k x : Real)) → ((forall k, 1 - + Matrix.trace (B k) <= M) → (exists phi : Nat -> Nat, StrictMono phi /\ + exists bInf : Fin 2 -> Real, exists v : IntegerLatticeFunction, + (forall i, Filter.Tendsto (fun k => b (phi k) i) + Filter.atTop (nhds (bInf i))) /\ + (forall x, exists K, forall k, K <= k -> u (phi k) x = v x) /\ + (forall x, FourNeighborLaplacian v x <= 1) /\ + (forall x, LatticeQuadraticForm A x + + dotProduct bInf ![(x.re : Real), (x.im : Real)] <= (v x : Real)))))))))) := by + intro A B b u M hM hconv hBsymm hb hu0 hulap hulower htrace +-- BODY + classical + let w : Nat → GaussianInt → Real := fun k x => + (u k x : Real) - LatticeQuadraticForm (B k) x - + dotProduct (b k) ![(x.re : Real), (x.im : Real)] + have hw0 : ∀ k, w k 0 = 0 := DiagonalCompactnessProof.hw0 B b u hu0 + have hwpos : ∀ k x, 0 ≤ w k x := DiagonalCompactnessProof.hwpos B b u hulower + have hwl : ∀ k x, RealFourNeighborLaplacian (w k) x ≤ M := DiagonalCompactnessProof.hwl B b u M + hBsymm hulap htrace + have hwb : ∀ k x, w k x ≤ + (4 : Real) ^ (x.re.natAbs + x.im.natAbs) * (0 : Real) + + M * (((4 : Real) ^ (x.re.natAbs + x.im.natAbs) - 1) / 3) := DiagonalCompactnessProof.hwb + B b u M hw0 hwpos hwl + have hentry : ∀ i j : Fin 2, ∃ lo hi : Real, ∀ k, + lo ≤ B k i j ∧ B k i j ≤ hi := DiagonalCompactnessProof.hentry A B hconv + have hub : ∀ x, ∃ C : Real, ∀ k, |(u k x : Real)| ≤ C := DiagonalCompactnessProof.hub B b u M + hb hwpos hwb hentry + let : Encodable GaussianInt := Encodable.ofEquiv (Int × Int) + { toFun := fun z => (z.re, z.im) + invFun := fun p => ⟨p.1, p.2⟩ + left_inv := by intro z; cases z; rfl + right_inv := by intro p; cases p; rfl } + let enumerate : Nat → GaussianInt := fun n => + (Encodable.decode n).getD 0 + have enumerate_surj : ∀ x : GaussianInt, ∃ n, enumerate n = x := + DiagonalCompactnessProof.enumerate_surj (this := this) + have refineFiber : ∀ x : GaussianInt, ∀ s : Set Nat, s.Infinite → + ∃ t : Set Nat, t ⊆ s ∧ t.Infinite ∧ ∃ z : Int, ∀ k ∈ t, u k x = z := + DiagonalCompactnessProof.refineFiber u hub + let next (n : Nat) (s : Set Nat) (hs : s.Infinite) : Set Nat := + Classical.choose (refineFiber (enumerate n) s hs) + have next_spec (n : Nat) (s : Set Nat) (hs : s.Infinite) : + next n s hs ⊆ s ∧ (next n s hs).Infinite ∧ + ∃ z, ∀ k ∈ next n s hs, u k (enumerate n) = z := + Classical.choose_spec (refineFiber (enumerate n) s hs) + let good : Type := {s : Set Nat // s.Infinite} + let seq : Nat → good := Nat.rec ⟨Set.univ, Set.infinite_univ⟩ + (fun n q => ⟨next n q.1 q.2, (next_spec n q.1 q.2).2.1⟩) + have seq_step (n : Nat) : seq (n + 1) = + ⟨next n (seq n).1 (seq n).2, (next_spec n (seq n).1 (seq n).2).2.1⟩ := + DiagonalCompactnessProof.seq_step u (this := this) refineFiber next_spec n + have seq_nested (m n : Nat) (hmn : m ≤ n) : (seq n).1 ⊆ (seq m).1 := + DiagonalCompactnessProof.seq_nested u (this := this) refineFiber next_spec m n hmn + let first : Nat := Classical.choose (Set.Infinite.exists_gt (seq 0).2 0) + have first_spec : first ∈ (seq 0).1 ∧ 0 < first := + Classical.choose_spec (Set.Infinite.exists_gt (seq 0).2 0) + let phi : Nat → Nat := Nat.rec first + (fun n p => Classical.choose (Set.Infinite.exists_gt (seq (n + 1)).2 p)) + have phi_spec (n : Nat) : phi n ∈ (seq n).1 := DiagonalCompactnessProof.phi_spec u (this := + this) refineFiber next_spec first_spec n + have phi_mono : StrictMono phi := DiagonalCompactnessProof.phi_mono u (this := this) + refineFiber next_spec + have boundedSubsequence : ∀ f : Nat → Real, (∀ n, -1 ≤ f n ∧ f n ≤ 1) → + ∃ q : Nat → Nat, StrictMono q ∧ ∃ c : Real, + Filter.Tendsto (fun n => f (q n)) Filter.atTop (nhds c) := + DiagonalCompactnessProof.boundedSubsequence + obtain ⟨q0, hq0, c0, hc0⟩ := boundedSubsequence (fun n => b (phi n) 0) (by + intro n + have h := hb (phi n) 0 + rw [abs_le] at h + exact h) + obtain ⟨q1, hq1, c1, hc1⟩ := boundedSubsequence (fun n => b (phi (q0 n)) 1) (by + intro n + have h := hb (phi (q0 n)) 1 + rw [abs_le] at h + exact h) + let psi : Nat → Nat := q0 ∘ q1 + have hpsi : StrictMono psi := hq0.comp hq1 + have hpsi_ge : ∀ n, n ≤ psi n := DiagonalCompactnessProof.hpsi_ge q0 q1 hpsi + let bInf : Fin 2 → Real := ![c0, c1] + let output : Nat → Nat := phi ∘ psi + have output_mono : StrictMono output := phi_mono.comp hpsi + let index : GaussianInt → Nat := fun x => Classical.choose (enumerate_surj x) + have index_spec (x : GaussianInt) : enumerate (index x) = x := + Classical.choose_spec (enumerate_surj x) + have fiber_spec (x : GaussianInt) : ∃ z : Int, ∀ k ∈ next (index x) + (seq (index x)).1 (seq (index x)).2, u k x = z := DiagonalCompactnessProof.fiber_spec u + (this := this) enumerate_surj refineFiber next_spec index_spec x + let v : IntegerLatticeFunction := fun x => Classical.choose (fiber_spec x) + have v_spec (x : GaussianInt) : ∀ k ∈ next (index x) + (seq (index x)).1 (seq (index x)).2, u k x = v x := + Classical.choose_spec (fiber_spec x) + have eventual_eq (x : GaussianInt) : ∃ K, ∀ k, K ≤ k → u (output k) x = v x := + DiagonalCompactnessProof.eventual_eq u (this := this) enumerate_surj refineFiber next_spec + seq_step seq_nested phi_spec q0 q1 hpsi_ge fiber_spec v_spec x + refine ⟨output, output_mono, bInf, v, ?_, ?_, ?_, ?_⟩ + · intro i + fin_cases i + · simpa [output, psi, bInf, Function.comp_def] using hc0.comp hq1.tendsto_atTop + · simpa [output, psi, bInf, Function.comp_def] using hc1 + · exact eventual_eq + · intro x + obtain ⟨K0, h0⟩ := eventual_eq x + obtain ⟨K1, h1⟩ := eventual_eq (x + 1) + obtain ⟨K2, h2⟩ := eventual_eq (x - 1) + obtain ⟨K3, h3⟩ := eventual_eq (x + ⟨0, 1⟩) + obtain ⟨K4, h4⟩ := eventual_eq (x - ⟨0, 1⟩) + let K := max (max (max K0 K1) (max K2 K3)) K4 + have hu := hulap (output K) x + have e0 := h0 K (by dsimp [K]; omega) + have e1 := h1 K (by dsimp [K]; omega) + have e2 := h2 K (by dsimp [K]; omega) + have e3 := h3 K (by dsimp [K]; omega) + have e4 := h4 K (by dsimp [K]; omega) + simp? [FourNeighborLaplacian, e0, e1, e2, e3, e4] at hu ⊢ + exact hu + · intro x + have h00 := (hconv 0 0).comp output_mono.tendsto_atTop + have h01 := (hconv 0 1).comp output_mono.tendsto_atTop + have h10 := (hconv 1 0).comp output_mono.tendsto_atTop + have h11 := (hconv 1 1).comp output_mono.tendsto_atTop + have hb0 := hc0.comp hq1.tendsto_atTop + have hb1 := hc1 + have hlim : Filter.Tendsto + (fun k => LatticeQuadraticForm (B (output k)) x + + dotProduct (b (output k)) ![(x.re : Real), (x.im : Real)]) + Filter.atTop (nhds (LatticeQuadraticForm A x + + dotProduct bInf ![(x.re : Real), (x.im : Real)])) := DiagonalCompactnessProof.hlim A B b + u (this := this) refineFiber next_spec q0 c0 q1 c1 x h00 h01 h10 h11 hb0 hb1 + apply le_of_tendsto hlim + obtain ⟨K, hK⟩ := eventual_eq x + filter_upwards [Filter.eventually_ge_atTop K] with k hk + have he := hK k hk + simpa [he] using hulower (output k) x + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean new file mode 100644 index 0000000000..7f1ed857f5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean @@ -0,0 +1,498 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.OdometerGluing +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTranslatedOdometers +public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation + +-- [TABLET NODE: PositiveCurvatureGeneratorCocycles] + +/-! +# PositiveCurvatureGeneratorCocycles + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace GeneratorCocycleGeometry + +private theorem domain_from_odo : + (by + classical + exact + ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), TileOdometer c U k + → (k.domain : Set GaussianInt) = FootprintVertices U ) := by + classical + intro c U k ho + induction ho with + | line w x hw k hdom => + simp [hdom, FootprintVertices] + | unit z x U k hU hdom htrans => exact hdom + | @decompose q hq S U hs k hU hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + ext y + change (y ∈ k.domain) ↔ y ∈ FootprintVertices U + rw [hdom] + have child (i : Fin 3) (s : Bool) : + (hs i s).domain = FootprintVertices (S i s) := ih i s + constructor + · rintro ⟨i, s, hy⟩ + exact hfoot i s ((Set.ext_iff.mp (child i s) y).mp hy) + · intro hy + by_cases hu : U.cells.Nonempty + · simp only [FootprintVertices, ite_eq_left hu, Set.mem_ofPred_eq] at hy + rcases hy with ⟨x, hx, hv⟩ + rcases (hcells x).mp hx with ⟨i, s, hxs⟩ + refine ⟨i, s, (Set.ext_iff.mp (child i s) y).mpr ?_⟩ + simp only [FootprintVertices, ite_eq_left (show (S i s).cells.Nonempty from ⟨x, hxs⟩), + Set.mem_ofPred_eq] + exact ⟨x, hxs, hv⟩ + · have hs_empty : ∀ i s, ¬ (S i s).cells.Nonempty := by + intro i s hi + apply hu + rcases hi with ⟨x, hx⟩ + exact ⟨x, (hcells x).mpr ⟨i, s, hx⟩⟩ + simp only [FootprintVertices, ite_eq_right hu, Set.mem_singleton_iff] at hy + have hh := hfoot 0 false + rw [FootprintVertices, ite_eq_right (hs_empty 0 false), + FootprintVertices, ite_eq_right hu] at hh + refine ⟨0, false, (Set.ext_iff.mp (child 0 false) y).mpr ?_⟩ + have ha : (S 0 false).anchor = U.anchor := by + simpa [Set.singleton_subset_iff] using hh + simp only [FootprintVertices, ite_eq_right (hs_empty 0 false), + Set.mem_singleton_iff] + rw [ha] + exact hy + +private theorem hcoords : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → + ((q (0 : Fin (4 : ℕ)) = C.1.1) → (∀ w : TilingLattice C, ∃ mn : Int × Int, (mn.1 : + GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : GaussianInt) * BandVectors.1 (q 2) + (q 0) = (w : GaussianInt))) ) := by + classical + intro C q hq hqC w + exact (TilingLatticeBasis C q hq hqC).2.2.1 w |>.exists + +private theorem hlat : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (h : + PartialOdometer), ∀ (H : ℤ × ℤ → PartialOdometer), (BandPrototile C.1.1 T) → + ((TileOdometer C.1.1 T h) → ((∀ (kl : ℤ × ℤ), + let w := (↑kl.1 : GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ))) + (↑kl.2 : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ))); + let a := (↑kl.1 : GaussianInt) * BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ))) + (↑kl.2 : GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ))); TileOdometer C.1.1 (TileTranslation T w) (H kl) ∧ (∀ (x : GaussianInt), x ∈ (H + kl).domain ↔ x - w ∈ h.domain) ∧ ∀ x ∈ (H kl).domain, (H kl).value x = h.value (x - + w) + a.re * x.re + a.im * x.im) → (((h.domain : Set GaussianInt) = FootprintVertices + T) → ((ExactTileTiling (RegularTileFamily T (TilingLattice C))) → (LatticeTile T))))) + ) := by + classical + intro C q T h H hT hodo htrans hdom tiling + apply tiling.1 T + refine ⟨0, (TilingLattice C).zero_mem, ?_⟩ + cases T + congr 1 + · rw [show GaussianTranslation 0 = id by funext z; simp [GaussianTranslation]] + simp only [Finset.image_id] + · simp [GaussianTranslation] + +private theorem hfamily : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), + (ProperBandQuadruple q) → ((q (0 : Fin (4 : ℕ)) = C.1.1) → ((ExactTileTiling + (RegularTileFamily T (TilingLattice C))) → (∀ kl : Int × Int, LatticeTile + (TileTranslation T ((kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (kl.2 : + GaussianInt) * BandVectors.1 (q 2) (q 0)))))) ) := by + classical + intro C q T hq hqC tiling (kl : Int × Int) + apply tiling.1 + refine ⟨_, ?_, rfl⟩ + exact (TilingLattice C).add_mem + (by simpa using (TilingLattice C).zsmul_mem (by + exact (TilingLatticeBasis C q hq hqC).1) kl.1) + (by simpa using (TilingLattice C).zsmul_mem (by + exact (TilingLatticeBasis C q hq hqC).2.1) kl.2) + +private theorem hglobal : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (h : + PartialOdometer), ∀ (H : ℤ × ℤ → PartialOdometer), (∀ (kl : ℤ × ℤ), + let w := (↑kl.1 : GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ))) + (↑kl.2 : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ))); + let a := (↑kl.1 : GaussianInt) * BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ))) + (↑kl.2 : GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ))); TileOdometer C.1.1 (TileTranslation T w) (H kl) ∧ (∀ (x : GaussianInt), x ∈ (H + kl).domain ↔ x - w ∈ h.domain) ∧ ∀ x ∈ (H kl).domain, (H kl).value x = h.value (x - + w) + a.re * x.re + a.im * x.im) → ((∀ (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), + OdometerCompatibility (H kl) (H mn)) → ((∀ (c : CircleCoordinates), ∀ (U : + ProtoTile), ∀ (k : PartialOdometer), TileOdometer c U k → (k.domain : Set + GaussianInt) = FootprintVertices U) → (((h.domain : Set GaussianInt) = + FootprintVertices T) → ((∀ w : TilingLattice C, ∃ mn : Int × Int, (mn.1 : + GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : GaussianInt) * BandVectors.1 (q 2) + (q 0) = (w : GaussianInt)) → ((ExactTileTiling (RegularTileFamily T (TilingLattice + C))) → ((∀ kl : Int × Int, LatticeTile (TileTranslation T ((kl.1 : GaussianInt) * + BandVectors.1 (q 1) (q 0) + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)))) → (∃ + g : IntegerLatticeFunction, (∀ i, ∃ c : ℤ, ∀ x, x ∈ (H i).domain → g x - (H i).value + x = c) ∧ ∀ g' : IntegerLatticeFunction, (∀ i, ∃ c : ℤ, ∀ x, x ∈ (H i).domain → g' x - + (H i).value x = c) → ∃ c : ℤ, ∀ x, g' x - g x = c))))))) ) := by + classical + intro C q T h H htrans hcompat domain_from_odo hdom hcoords tiling hfamily + apply (OdometerGluing).2 + · intro i + exact hfamily i + · intro i + exact domain_from_odo _ _ _ (htrans i).1 + · exact hcompat + · intro x + obtain ⟨U, hUF, hxU, _⟩ := tiling.2 x + rcases hUF with ⟨w, hw, rfl⟩ + rcases hcoords ⟨w, hw⟩ with ⟨kl, hkl⟩ + refine ⟨kl, ?_⟩ + have hx := hxU + have hkl' : (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) = w := by + simpa using hkl + rw [← hkl'] at hx + have base : x - ((kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) ∈ T.cells := by + simp only [TileTranslation, Finset.mem_image, GaussianTranslation] at hx + rcases hx with ⟨a, ha, he⟩ + have he' : x - ((kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) = a := by + rw [← he] + simp [] + rw [he'] + exact ha + have baseDomain : x - ((kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) ∈ h.domain := by + change x - ((kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) ∈ + (h.domain : Set GaussianInt) + rw [hdom] + have nonempty : T.cells.Nonempty := ⟨_, base⟩ + simp only [FootprintVertices, ite_eq_left nonempty, Set.mem_ofPred_eq] + exact ⟨_, base, Or.inl rfl⟩ + have hv : x ∈ FootprintVertices (TileTranslation T + ((kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0))) := by + rw [← (domain_from_odo _ _ _ (htrans kl).1)] + exact (htrans kl).2.1 x |>.mpr baseDomain + have vertex (z : GaussianInt) + (hz : z = x - ((kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) ∨ + z = x - ((kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) + 1 ∨ + z = x - ((kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) + ⟨0, 1⟩ ∨ + z = x - ((kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) + 1 + ⟨0, 1⟩) : + z ∈ h.domain := by + change z ∈ (h.domain : Set GaussianInt) + rw [hdom] + have nonempty : T.cells.Nonempty := ⟨_, base⟩ + simp only [FootprintVertices, ite_eq_left nonempty, Set.mem_ofPred_eq] + exact ⟨x - ((kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)), base, hz⟩ + refine ⟨(htrans kl).2.1 x |>.mpr (vertex _ (Or.inl rfl)), ?_, ?_, ?_⟩ + · apply (htrans kl).2.1 (x + 1) |>.mpr + apply vertex _ + right; left; abel + · apply (htrans kl).2.1 (x + ⟨0, 1⟩) |>.mpr + apply vertex _ + right; right; left; abel + · apply (htrans kl).2.1 (x + 1 + ⟨0, 1⟩) |>.mpr + apply vertex _ + right; right; right; abel + +private theorem shift_cocycle : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (h : + PartialOdometer), ∀ (H : ℤ × ℤ → PartialOdometer), (∀ (kl : ℤ × ℤ), + let w := (↑kl.1 : GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ))) + (↑kl.2 : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ))); + let a := (↑kl.1 : GaussianInt) * BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ))) + (↑kl.2 : GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ))); TileOdometer C.1.1 (TileTranslation T w) (H kl) ∧ (∀ (x : GaussianInt), x ∈ (H + kl).domain ↔ x - w ∈ h.domain) ∧ ∀ x ∈ (H kl).domain, (H kl).value x = h.value (x - + w) + a.re * x.re + a.im * x.im) → (∀ (g : IntegerLatticeFunction), (∀ (i : ℤ × ℤ), ∃ + (c : ℤ), ∀ x ∈ (H i).domain, g x - (H i).value x = c) → ((∀ (g' : + IntegerLatticeFunction), (∀ (i : ℤ × ℤ), ∃ (c : ℤ), ∀ x ∈ (H i).domain, g' x - (H + i).value x = c) → ∃ (c : ℤ), ∀ (x : GaussianInt), g' x - g x = c) → (∀ (d : Int × + Int), ∀ (v : GaussianInt), ∀ (a : GaussianInt), (∀ i : Int × Int, (↑(i.1 + d.1) : + GaussianInt) * BandVectors.1 (q 1) (q 0) + (↑(i.2 + d.2) : GaussianInt) * + BandVectors.1 (q 2) (q 0) = (↑i.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (↑i.2 + : GaussianInt) * BandVectors.1 (q 2) (q 0) + v) → (∀ i : Int × Int, (↑(i.1 + d.1) : + GaussianInt) * BandVectors.2 (q 1) (q 0) + (↑(i.2 + d.2) : GaussianInt) * + BandVectors.2 (q 2) (q 0) = (↑i.1 : GaussianInt) * BandVectors.2 (q 1) (q 0) + (↑i.2 + : GaussianInt) * BandVectors.2 (q 2) (q 0) + a) → ∃ c : ℤ, ∀ x, g (x + v) - x.re * + a.re - x.im * a.im - g x = c))) ) := by + classical + intro C q T h H htrans g hg huniq d v a hw ha + let gs : IntegerLatticeFunction := fun x => + g (x + v) - x.re * a.re - x.im * a.im + have gscomp : ∀ i, ∃ c : ℤ, ∀ x, x ∈ (H i).domain → + gs x - (H i).value x = c := by + intro i + obtain ⟨c, hc⟩ := hg (i.1 + d.1, i.2 + d.2) + let s := (↑i.1 : GaussianInt) * BandVectors.2 (q 1) (q 0) + + (↑i.2 : GaussianInt) * BandVectors.2 (q 2) (q 0) + refine ⟨c + s.re * v.re + s.im * v.im + a.re * v.re + a.im * v.im, ?_⟩ + intro x hx + have hx' : x + v ∈ (H (i.1 + d.1, i.2 + d.2)).domain := by + apply (htrans (i.1 + d.1, i.2 + d.2)).2.1 (x + v) |>.mpr + have hi := (htrans i).2.1 x |>.mp hx + rw [hw i] + convert hi using 1; ring + have hi := (htrans i).2.2 x hx + have hi' := (htrans (i.1 + d.1, i.2 + d.2)).2.2 (x + v) hx' + have harg : (x + v) - + ((↑(i.1 + d.1) : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (↑(i.2 + d.2) : GaussianInt) * BandVectors.1 (q 2) (q 0)) = + x - ((↑i.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (↑i.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) := by + rw [hw i] + ring + rw [harg] at hi' + dsimp [gs] + have ha' := ha i + calc + g (x + v) - x.re * a.re - x.im * a.im - (H i).value x = + (g (x + v) - (H (i.1 + d.1, i.2 + d.2)).value (x + v)) + + ((H (i.1 + d.1, i.2 + d.2)).value (x + v) - + x.re * a.re - x.im * a.im - (H i).value x) := by ring + _ = c + s.re * v.re + s.im * v.im + a.re * v.re + a.im * v.im := by + rw [hc (x + v) hx', hi', hi, ha'] + simp [s] at ⊢; ring + obtain ⟨c, hc⟩ := huniq gs gscomp + refine ⟨c, ?_⟩ + intro x + have hz := hc x + dsimp [gs] at hz + have hz0 := hc 0 + dsimp [gs] at hz0 + have : c = g v - g 0 := by + simpa using hz0.symm + rw [this] at hz + linarith + +private theorem heqAt349 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (g : IntegerLatticeFunction), ∀ (x : + GaussianInt), ∀ (c : ℤ), (g (x + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ)))) - x.re * (BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))).re - x.im + * (BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))).im - g x = c) → (g (x + + BandVectors.1 (q 1) (q 0)) = g x + x.re * (BandVectors.2 (q 1) (q 0)).re + x.im * + (BandVectors.2 (q 1) (q 0)).im + c) ) := by + classical + intro q g x c hz + linarith [hz] + +private theorem calibrationAtOrigin (g : IntegerLatticeFunction) + (v a : GaussianInt) (c : Int) + (hc : ∀ x : GaussianInt, + g (x + v) - x.re * a.re - x.im * a.im - g x = c) : + c = g v - g 0 := by + have atOrigin := hc 0 + simpa using atOrigin.symm + +private theorem heqAt366 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (g : IntegerLatticeFunction), ∀ (x : + GaussianInt), ∀ (c : ℤ), (g (x + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ)))) - x.re * (BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))).re - x.im + * (BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))).im - g x = c) → (g (x + + BandVectors.1 (q 2) (q 0)) = g x + x.re * (BandVectors.2 (q 2) (q 0)).re + x.im * + (BandVectors.2 (q 2) (q 0)).im + c) ) := by + classical + intro q g x c hz + linarith [hz] + +private theorem hvAt384 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (BandVectors.1 (q (1 : Fin ((2 : ℕ) + (1 : ℕ) + + (1 : ℕ)))) (q (0 : Fin (4 : ℕ))) + (BandVectors.1 (q (2 : Fin ((1 : ℕ) + (2 : ℕ) + (1 + : ℕ)))) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ)))) = (0 : GaussianInt)) → (BandVectors.1 (q 3) (q 0) = -(BandVectors.1 (q 1) (q 0) + + BandVectors.1 (q 2) (q 0))) ) := by + classical + intro q rr + apply eq_neg_of_add_eq_zero_left + linear_combination rr + +private theorem hvAt395 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (BandVectors.2 (q (1 : Fin ((2 : ℕ) + (1 : ℕ) + + (1 : ℕ)))) (q (0 : Fin (4 : ℕ))) + (BandVectors.2 (q (2 : Fin ((1 : ℕ) + (2 : ℕ) + (1 + : ℕ)))) (q (0 : Fin (4 : ℕ))) + BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ)))) = (0 : GaussianInt)) → (BandVectors.2 (q 3) (q 0) = -(BandVectors.2 (q 1) (q 0) + + BandVectors.2 (q 2) (q 0))) ) := by + classical + intro q rr + apply eq_neg_of_add_eq_zero_left + linear_combination rr + +private theorem heqAt404 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (g : IntegerLatticeFunction), ∀ (x : + GaussianInt), ∀ (c : ℤ), (g (x + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (0 : Fin (4 : + ℕ)))) - x.re * (BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))).re - x.im + * (BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))).im - g x = c) → (g (x + + BandVectors.1 (q 3) (q 0)) = g x + x.re * (BandVectors.2 (q 3) (q 0)).re + x.im * + (BandVectors.2 (q 3) (q 0)).im + c) ) := by + classical + intro q g x c hz + linarith [hz] + +end GeneratorCocycleGeometry + +theorem PositiveCurvatureGeneratorCocycles (C : BandCircle) + (hc : 1 < C.1.1.1) : + ∃ (q : Fin 4 → CircleCoordinates) (T : ProtoTile) (h : PartialOdometer) + (g : IntegerLatticeFunction), + ProperBandQuadruple q ∧ q 0 = C.1.1 ∧ + BandPrototile C.1.1 T ∧ TileOdometer C.1.1 T h ∧ + GlobalOdometerExtends g h ∧ g 0 = 0 ∧ + ∀ j : Fin 3, ∀ x, + g (x + BandVectors.1 (q j.succ) (q 0)) = g x + + x.re * (BandVectors.2 (q j.succ) (q 0)).re + + x.im * (BandVectors.2 (q j.succ) (q 0)).im + + g (BandVectors.1 (q j.succ) (q 0)) := by +-- BODY + obtain ⟨q, T, h, H, hq, hqC, hT, hodo, htrans, hcompat⟩ := + PositiveCurvatureTranslatedOdometers C hc + have domain_from_odo := GeneratorCocycleGeometry.domain_from_odo + have hdom : (h.domain : Set GaussianInt) = FootprintVertices T := + domain_from_odo _ _ _ hodo + have tiling : ExactTileTiling (RegularTileFamily T (TilingLattice C)) := + (BandTileTopologyApplication C q hq hqC T (by simpa [hqC] using hT)).1 + have hlat := GeneratorCocycleGeometry.hlat C q T h H hT hodo htrans hdom tiling + have hglobal := GeneratorCocycleGeometry.hglobal C q T h H htrans hcompat domain_from_odo hdom + (GeneratorCocycleGeometry.hcoords C q hq hqC) tiling (GeneratorCocycleGeometry.hfamily C q + T hq hqC tiling) + rcases hglobal with ⟨g, hg, huniq⟩ + refine ⟨q, T, h, fun x => g x - g 0, hq, hqC, hT, hodo, ?_, ?_, ?_⟩ + · rcases hg (0, 0) with ⟨c, hc⟩ + refine ⟨c - g 0, ?_⟩ + intro x hx + have hxH := (htrans (0, 0)).2.1 x |>.mpr (by simpa using hx) + have hv := (htrans (0, 0)).2.2 x hxH + dsimp + calc + g x - g 0 = (g x - (H (0, 0)).value x) + + (H (0, 0)).value x - g 0 := by ring + _ = c + h.value x - g 0 := by + rw [hc x hxH] + simpa using hv + _ = h.value x + (c - g 0) := by ring + · simp + · intro j x + have shift_cocycle := GeneratorCocycleGeometry.shift_cocycle C q T h H htrans g hg huniq + have rel := IncomingSuperbasisRelation q hq + fin_cases j + · obtain ⟨c, hc⟩ := shift_cocycle (1, 0) + (BandVectors.1 (q 1) (q 0)) (BandVectors.2 (q 1) (q 0)) + (by intro i; simp; ring) (by intro i; simp; ring) + have hz := hc x + have heq : g (x + BandVectors.1 (q 1) (q 0)) = + g x + x.re * (BandVectors.2 (q 1) (q 0)).re + + x.im * (BandVectors.2 (q 1) (q 0)).im + c := GeneratorCocycleGeometry.heqAt349 q g x + c hz + have hcval : c = g (BandVectors.1 (q 1) (q 0)) - g 0 := + GeneratorCocycleGeometry.calibrationAtOrigin g (BandVectors.1 (q 1) (q 0)) + (BandVectors.2 (q 1) (q 0)) c hc + change g (x + BandVectors.1 (q 1) (q 0)) - g 0 = + (g x - g 0) + x.re * (BandVectors.2 (q 1) (q 0)).re + + x.im * (BandVectors.2 (q 1) (q 0)).im + + (g (BandVectors.1 (q 1) (q 0)) - g 0) + rw [heq, hcval] + ring + · obtain ⟨c, hc⟩ := shift_cocycle (0, 1) + (BandVectors.1 (q 2) (q 0)) (BandVectors.2 (q 2) (q 0)) + (by intro i; simp; ring) (by intro i; simp; ring) + have hz := hc x + have heq : g (x + BandVectors.1 (q 2) (q 0)) = + g x + x.re * (BandVectors.2 (q 2) (q 0)).re + + x.im * (BandVectors.2 (q 2) (q 0)).im + c := GeneratorCocycleGeometry.heqAt366 q g x + c hz + have hcval : c = g (BandVectors.1 (q 2) (q 0)) - g 0 := + GeneratorCocycleGeometry.calibrationAtOrigin g (BandVectors.1 (q 2) (q 0)) + (BandVectors.2 (q 2) (q 0)) c hc + change g (x + BandVectors.1 (q 2) (q 0)) - g 0 = + (g x - g 0) + x.re * (BandVectors.2 (q 2) (q 0)).re + + x.im * (BandVectors.2 (q 2) (q 0)).im + + (g (BandVectors.1 (q 2) (q 0)) - g 0) + rw [heq, hcval] + ring + · obtain ⟨c, hc⟩ := shift_cocycle (-1, -1) + (BandVectors.1 (q 3) (q 0)) (BandVectors.2 (q 3) (q 0)) + (by + have rr := rel.1 + simp? [Fin.sum_univ_succ] at rr + have hv : BandVectors.1 (q 3) (q 0) = + -(BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0)) := + GeneratorCocycleGeometry.hvAt384 q rr + intro i + norm_num + rw [hv] + ring) + (by + have rr := rel.2 + simp? [Fin.sum_univ_succ] at rr + have hv : BandVectors.2 (q 3) (q 0) = + -(BandVectors.2 (q 1) (q 0) + BandVectors.2 (q 2) (q 0)) := + GeneratorCocycleGeometry.hvAt395 q rr + intro i + norm_num + rw [hv] + ring) + have hz := hc x + have heq : g (x + BandVectors.1 (q 3) (q 0)) = + g x + x.re * (BandVectors.2 (q 3) (q 0)).re + + x.im * (BandVectors.2 (q 3) (q 0)).im + c := GeneratorCocycleGeometry.heqAt404 q g x + c hz + have hcval : c = g (BandVectors.1 (q 3) (q 0)) - g 0 := + GeneratorCocycleGeometry.calibrationAtOrigin g (BandVectors.1 (q 3) (q 0)) + (BandVectors.2 (q 3) (q 0)) c hc + change g (x + BandVectors.1 (q 3) (q 0)) - g 0 = + (g x - g 0) + x.re * (BandVectors.2 (q 3) (q 0)).re + + x.im * (BandVectors.2 (q 3) (q 0)).im + + (g (BandVectors.1 (q 3) (q 0)) - g 0) + rw [heq, hcval] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerDomain.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerDomain.lean new file mode 100644 index 0000000000..fecf46ce64 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerDomain.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.TileOdometer + +-- [TABLET NODE: PositiveCurvatureTileOdometerDomain] + +/-! +# PositiveCurvatureTileOdometerDomain + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem PositiveCurvatureTileOdometerDomain : + ∀ (C : CircleCoordinates), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), (0 < C.1) → + ((TileOdometer C T h) → ((h.domain : Set GaussianInt) = FootprintVertices T)) := by + intro C T h hC hO +-- BODY + have domain_from_odo : ∀ (c : CircleCoordinates) (U : ProtoTile) (k : PartialOdometer), + TileOdometer c U k → (k.domain : Set GaussianInt) = FootprintVertices U := by + intro c U k ho + induction ho with + | line w x hw k hdom => + simp [hdom, FootprintVertices] + | unit z x U k hU hdom htrans => + exact hdom + | @decompose q hq S U hs k hU hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + ext y + change (y ∈ k.domain) ↔ y ∈ FootprintVertices U + rw [hdom] + have child (i : Fin 3) (s : Bool) : + (hs i s).domain = FootprintVertices (S i s) := + ih i s + change (∃ i s, y ∈ (hs i s).domain) ↔ y ∈ FootprintVertices U + have union : (∃ i s, y ∈ (hs i s).domain) ↔ + ∃ i s, y ∈ FootprintVertices (S i s) := by + constructor + · rintro ⟨i, s, hy⟩ + exact ⟨i, s, (Set.ext_iff.mp (child i s) y).mp hy⟩ + · rintro ⟨i, s, hy⟩ + exact ⟨i, s, (Set.ext_iff.mp (child i s) y).mpr hy⟩ + rw [union] + clear hq hU hsub hcentroid hvalue hcompat hslope ih child union + classical + simp only [FootprintVertices] + constructor + · rintro ⟨i, s, hy⟩ + exact hfoot i s hy + · intro hy + by_cases hu : U.cells.Nonempty + · simp only [ite_eq_left hu, Set.mem_ofPred_eq] at hy + rcases hy with ⟨x, hx, hv⟩ + rcases (hcells x).mp hx with ⟨i, s, hxs⟩ + have hs : (S i s).cells.Nonempty := ⟨x, hxs⟩ + refine ⟨i, s, ?_⟩ + simp only [ite_eq_left hs, Set.mem_ofPred_eq] + exact ⟨x, hxs, hv⟩ + · have hs_empty : ∀ i s, ¬ (S i s).cells.Nonempty := by + intro i s hs + rcases hs with ⟨x, hx⟩ + apply hu + exact ⟨x, (hcells x).mpr ⟨i, s, hx⟩⟩ + have ha : (S 0 false).anchor = U.anchor := by + have hh := hfoot 0 false + rw [FootprintVertices, ite_eq_right (hs_empty 0 false), + FootprintVertices, ite_eq_right hu] at hh + have hm := hh (Set.mem_singleton _) + simpa using hm + simp only [ite_eq_right hu, Set.mem_singleton_iff] at hy + refine ⟨0, false, ?_⟩ + simp only [ite_eq_right (hs_empty 0 false), Set.mem_singleton_iff] + simpa [ha] using hy + exact domain_from_odo C T h hO + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerSupportTransport.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerSupportTransport.lean new file mode 100644 index 0000000000..f7d560f8fa --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerSupportTransport.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandCircle +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileOdometer + +-- [TABLET NODE: PositiveCurvatureTileOdometerSupportTransport] + +/-! +# PositiveCurvatureTileOdometerSupportTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem PositiveCurvatureTileOdometerSupportTransport + (C : CircleCoordinates) (T U : ProtoTile) (h : PartialOdometer) + (hC : 0 < C.1) (hT : TileOdometer C T h) + (hU : BandPrototile C U) (hcellsTU : T.cells = U.cells) : + TileOdometer C U h := by +-- BODY + classical + have positive_cells : ∀ (D : CircleCoordinates) (V : ProtoTile), + 0 < D.1 → BandPrototile D V → V.cells.Nonempty := by + intro D V hD hV + induction hV with + | line w x hw => simp at hD + | unit z x anchor => simp + | @decompose q hq S V hS hcells hfoot hcentroid ih => + have facts := ProperBandCurvatureStructure q hq + have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by + by_cases h0 : 0 < (q (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (q (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + by_cases h2 : 0 < (q (2 : Fin 3).succ).1 + · exact ⟨2, h2⟩ + have n0 := facts.2.1 (0 : Fin 3) + have n1 := facts.2.1 (1 : Fin 3) + have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim + rcases hp with ⟨i, hi⟩ + rcases ih i false hi with ⟨x, hx⟩ + exact ⟨x, (hcells x).mpr ⟨i, false, hx⟩⟩ + induction hT with + | line w x hw h hdom => + simp at hC + | unit z x V h hV hdom htrans => + have hUcells : U.cells = {x} := hcellsTU.symm.trans hV + have hVne : V.cells.Nonempty := by rw [hV]; simp + have hUne : U.cells.Nonempty := by rw [hUcells]; simp + have hfoot : FootprintVertices V = FootprintVertices U := by + simp only [FootprintVertices, ite_eq_left hVne, ite_eq_left hUne] + rw [hcellsTU] + exact TileOdometer.unit z x U h hUcells (hdom.trans hfoot) htrans + | @decompose q hq S V hs h hV hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + have hVne : V.cells.Nonempty := positive_cells (q 0) V hC hV + have hUne : U.cells.Nonempty := by + rw [← hcellsTU] + exact hVne + have hfoot_eq : FootprintVertices V = FootprintVertices U := by + simp only [FootprintVertices, ite_eq_left hVne, ite_eq_left hUne] + rw [hcellsTU] + have hcent_eq : TileCentroid V = TileCentroid U := by + simp only [TileCentroid, ite_eq_left hVne, ite_eq_left hUne] + rw [hcellsTU] + refine @TileOdometer.decompose q hq S U hs h hU hsub + ?_ ?_ ?_ hdom hvalue hcompat hslope + · intro x + rw [← hcellsTU] + exact hcells x + · intro i s + rw [← hfoot_eq] + exact hfoot i s + · intro i s + rw [← hcent_eq] + exact hcentroid i s + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean new file mode 100644 index 0000000000..78359f2391 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean @@ -0,0 +1,730 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector +public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation +public import LeanPool.ApollonianSuperharmonic.LeftAdjacentOdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.LambdaTiling +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.TileOdometerExists +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis + +-- [TABLET NODE: PositiveCurvatureTranslatedOdometers] + +/-! +# PositiveCurvatureTranslatedOdometers + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PositiveTranslationGeometry + +private theorem slope_for : + (by + classical + exact + (BandCircle) → (∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), + TileOdometer c U k → 1 < c.1 → ∃ p : ℝ × ℝ, PartialOdometerSlope k = some p) ) := by + classical + intro C c U k ho hc + induction ho with + | line w x hw hdom => omega + | unit z x U hU hdom htrans => omega + | @decompose q' hq' S U hs k hU hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + have facts := ProperBandCurvatureStructure q' hq' + have hp : ∃ i : Fin 3, 0 < (q' i.succ).1 := by + by_cases h0 : 0 < (q' (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (q' (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + by_cases h2 : 0 < (q' (2 : Fin 3).succ).1 + · exact ⟨2, h2⟩ + have n0 := facts.2.1 (0 : Fin 3) + have n1 := facts.2.1 (1 : Fin 3) + have z0 : (q' (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (q' (1 : Fin 3).succ).1 = 0 := by omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim + rcases hp with ⟨i, hi⟩ + rcases hslope i false with hz | ⟨p, pi, hp, hpi, hpr, hpi'⟩ + · omega + exact ⟨p, hp⟩ + +private theorem lattice_coords : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (q (0 : Fin (4 : ℕ)) = + C.1.1) → ((ProperBandQuadruple q) → ( + let shift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) + ∀ kl : Int × Int, shift kl ∈ TilingLattice C)) ) := by + classical + intro C q hqC hq shift kl + dsimp [shift] + exact (TilingLattice C).add_mem + (by simpa using ((TilingLattice C).zsmul_mem (TilingLatticeBasis C q hq hqC).1 kl.1)) + (by simpa using ((TilingLattice C).zsmul_mem (TilingLatticeBasis C q hq hqC).2.1 kl.2)) + +private theorem index_injective : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (q (0 : Fin (4 : ℕ)) = + C.1.1) → ((ProperBandQuadruple q) → ( + let shift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) + ∀ (lattice_coords : ∀ kl : Int × Int, shift kl ∈ TilingLattice C), + let index (kl : Int × Int) : TilingLattice C := ⟨shift kl, lattice_coords kl⟩ + Function.Injective index)) ) := by + classical + intro C q hqC hq shift lattice_coords index kl mn heq + have hu := (TilingLatticeBasis C q hq hqC).2.2.1 (index kl) + have hk : (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) = (index kl : GaussianInt) := rfl + have hm : (mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (mn.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) = (index kl : GaussianInt) := by + change shift mn = shift kl + exact (congrArg (fun z : TilingLattice C => (z : GaussianInt)) heq).symm + exact hu.unique hk hm + +private theorem slope_step : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → ( + let shift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) + let slopeShift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.2 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.2 (q 2) (q 0) + ∀ (lattice_coords : ∀ kl : Int × Int, shift kl ∈ TilingLattice C), + let index (kl : Int × Int) : TilingLattice C := ⟨shift kl, lattice_coords kl⟩ + (Function.Injective index) → (∀ (r : Int × Int), ∀ (s : Int × Int), ∀ (i : Fin 3), shift + s - shift r = BandVectors.1 (q i.succ) (q 0) → slopeShift s - slopeShift r = + BandVectors.2 (q i.succ) (q 0))) ) := by + classical + intro C q hq shift slopeShift lattice_coords index index_injective r s i hs + have hsum := IncomingSuperbasisRelation q hq + fin_cases i + · have he : index (r.1 + 1, r.2) = index s := by + apply Subtype.ext + change shift (r.1 + 1, r.2) = shift s + calc + shift (r.1 + 1, r.2) = shift r + BandVectors.1 (q 1) (q 0) := by + simp [shift, add_comm] + ring + _ = shift s := by + have hh := sub_eq_iff_eq_add.mp hs + simpa [add_comm] using hh.symm + have hc := index_injective he + dsimp [slopeShift] + rw [← hc] + push_cast + ring + · have he : index (r.1, r.2 + 1) = index s := by + apply Subtype.ext + change shift (r.1, r.2 + 1) = shift s + calc + shift (r.1, r.2 + 1) = shift r + BandVectors.1 (q 2) (q 0) := by + simp [shift, add_comm, add_left_comm] + ring + _ = shift s := by + have hh := sub_eq_iff_eq_add.mp hs + simpa [add_comm] using hh.symm + have hc := index_injective he + dsimp [slopeShift] + rw [← hc] + push_cast + ring + · have h3 : BandVectors.1 (q (2 : Fin 3).succ) (q 0) = + -BandVectors.1 (q 1) (q 0) - BandVectors.1 (q 2) (q 0) := by + have finthree : Fin.succ (2 : Fin 3) = (3 : Fin 4) := by decide + have expanded : BandVectors.1 (q 1) (q 0) + + (BandVectors.1 (q 2) (q 0) + BandVectors.1 (q (Fin.succ (2 : Fin 3))) (q 0)) = 0 := by + simpa only [Fin.sum_univ_succ, Fin.sum_univ_zero, add_zero, zero_add, + Fin.succ_zero_eq_one, Fin.succ_one_eq_two, Fin.isValue, finthree] using hsum.1 + linear_combination expanded + have he : index (r.1 - 1, r.2 - 1) = index s := by + apply Subtype.ext + change shift (r.1 - 1, r.2 - 1) = shift s + calc + shift (r.1 - 1, r.2 - 1) = shift r + BandVectors.1 (q (2 : Fin 3).succ) (q 0) := by + rw [h3] + simp [shift, sub_eq_add_neg, add_assoc, add_left_comm] + ring + _ = shift s := by + have hh := sub_eq_iff_eq_add.mp hs + simpa [add_comm] using hh.symm + have hc := index_injective he + dsimp [slopeShift] + have h3' : BandVectors.2 (q (2 : Fin 3).succ) (q 0) = + -BandVectors.2 (q 1) (q 0) - BandVectors.2 (q 2) (q 0) := by + have hsum' := IncomingSuperbasisRelation q hq + have finthree : Fin.succ (2 : Fin 3) = (3 : Fin 4) := by decide + have expanded : BandVectors.2 (q 1) (q 0) + + (BandVectors.2 (q 2) (q 0) + BandVectors.2 (q (Fin.succ (2 : Fin 3))) (q 0)) = 0 := by + simpa only [Fin.sum_univ_succ, Fin.sum_univ_zero, add_zero, zero_add, + Fin.succ_zero_eq_one, Fin.succ_one_eq_two, Fin.isValue, finthree] using hsum'.2 + linear_combination expanded + have finthree : Fin.succ (2 : Fin 3) = (3 : Fin 4) := by decide + rw [← finthree, h3'] + rw [← hc] + push_cast + ring + +private theorem hidx : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let shift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) + ∀ (lattice_coords : ∀ kl : Int × Int, shift kl ∈ TilingLattice C), + let index (kl : Int × Int) : TilingLattice C := ⟨shift kl, lattice_coords kl⟩ + (Function.Injective index) → (∀ (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), (¬kl = mn) → (index kl ≠ + index mn)) ) := by + classical + intro C q shift lattice_coords index index_injective kl mn hkm he + exact hkm (index_injective he) + +private theorem hdom : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (h : + PartialOdometer), (TileOdometer C.1.1 T h) → ((0 < C.1.1.1) → ( + let shift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) + let slopeShift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.2 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.2 (q 2) (q 0) + let H (kl : Int × Int) : PartialOdometer := + PartialOdometerAffineTranslate h (shift kl) (slopeShift kl) 0 + ∀ r : Int × Int, (H r).domain = FootprintVertices (TileTranslation T (shift r)))) ) := by + classical + intro C q T h hO hpos shift slopeShift H r + exact PositiveCurvatureTileOdometerDomain C.1.1 + (TileTranslation T (shift r)) (H r) hpos + (TileOdometerAffineTranslation C.1.1 T h (shift r) + (slopeShift r) 0 hO) + +private theorem hedgeP : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), + let shift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) + ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), (∀ (u : ↥(TilingLattice C)), P.tile u = + TileTranslation T (↑u : GaussianInt)) → (∀ (lattice_coords : ∀ kl : Int × Int, shift + kl ∈ TilingLattice C), + let index (kl : Int × Int) : TilingLattice C := ⟨shift kl, lattice_coords kl⟩ + ∀ (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), ((FootprintEdges (TileTranslation T (shift kl)) ∩ + FootprintEdges (TileTranslation T (shift mn))).Nonempty) → ((FootprintEdges (P.tile + (index kl)) ∩ FootprintEdges (P.tile (index mn))).Nonempty)) ) := by + classical + intro C q T shift P htile lattice_coords index kl mn hedge + simpa [htile, index] using hedge + +private theorem hr'At341 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let shift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) + ∀ (lattice_coords : ∀ kl : Int × Int, shift kl ∈ TilingLattice C), + let index (kl : Int × Int) : TilingLattice C := ⟨shift kl, lattice_coords kl⟩ + ∀ (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), ∀ (i : Fin (3 : ℕ)), (((↑(index mn) : GaussianInt) - + (↑(index kl) : GaussianInt)).re = (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ)))).re) → (((shift mn).re : ℝ) - (shift kl).re = ((BandVectors.1 (q i.succ) (q + 0)).re : ℝ)) ) := by + classical + intro C q shift lattice_coords index kl mn i hr + exact_mod_cast hr + +private theorem hi'At344 : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let shift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) + ∀ (lattice_coords : ∀ kl : Int × Int, shift kl ∈ TilingLattice C), + let index (kl : Int × Int) : TilingLattice C := ⟨shift kl, lattice_coords kl⟩ + ∀ (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), ∀ (i : Fin (3 : ℕ)), (((↑(index mn) : GaussianInt) - + (↑(index kl) : GaussianInt)).im = (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ)))).im) → (((shift mn).im : ℝ) - (shift kl).im = ((BandVectors.1 (q i.succ) (q + 0)).im : ℝ)) ) := by + classical + intro C q shift lattice_coords index kl mn i hi + exact_mod_cast hi + +private theorem hr'At361 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let slopeShift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.2 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.2 (q 2) (q 0) + ∀ (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), ∀ (i : Fin (3 : ℕ)), ((slopeShift mn - slopeShift kl).re + = (BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))).re) → (((slopeShift mn).re : ℝ) - + (slopeShift kl).re = ((BandVectors.2 (q i.succ) (q 0)).re : ℝ)) ) := by + classical + intro q slopeShift kl mn i hr + exact_mod_cast hr + +private theorem hi'At370 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let slopeShift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.2 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.2 (q 2) (q 0) + ∀ (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), ∀ (i : Fin (3 : ℕ)), ((slopeShift mn - slopeShift kl).im + = (BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))).im) → (((slopeShift mn).im : ℝ) - + (slopeShift kl).im = ((BandVectors.2 (q i.succ) (q 0)).im : ℝ)) ) := by + classical + intro q slopeShift kl mn i hi + exact_mod_cast hi + +private theorem hstep'' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let shift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) + ∀ (lattice_coords : ∀ kl : Int × Int, shift kl ∈ TilingLattice C), + let index (kl : Int × Int) : TilingLattice C := ⟨shift kl, lattice_coords kl⟩ + ∀ (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), ∀ (i : Fin (3 : ℕ)), ((↑(index mn) : GaussianInt) - + (↑(index kl) : GaussianInt) = -BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) → + (shift mn - shift kl = -BandVectors.1 (q i.succ) (q 0)) ) := by + classical + intro C q shift lattice_coords index kl mn i hstep + simpa [index] using hstep + +private theorem hr'At406 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let shift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) + ∀ (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), ∀ (i : Fin (3 : ℕ)), ((shift mn - shift kl).re = + (-BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))).re) → (((shift mn).re : ℝ) - (shift + kl).re = ((-BandVectors.1 (q i.succ) (q 0)).re : ℝ)) ) := by + classical + intro q shift kl mn i hr + exact_mod_cast hr + +private theorem hi'At416 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let shift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) + ∀ (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), ∀ (i : Fin (3 : ℕ)), ((shift mn - shift kl).im = + (-BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))).im) → (((shift mn).im : ℝ) - (shift + kl).im = ((-BandVectors.1 (q i.succ) (q 0)).im : ℝ)) ) := by + classical + intro q shift kl mn i hi + exact_mod_cast hi + +private theorem hslope'At428 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let slopeShift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.2 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.2 (q 2) (q 0) + ∀ (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), ∀ (i : Fin (3 : ℕ)), (slopeShift kl - slopeShift mn = + BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))) → (slopeShift mn - slopeShift kl = + -BandVectors.2 (q i.succ) (q 0)) ) := by + classical + intro q slopeShift kl mn i hslope + rw [← hslope] + ring + +private theorem hr'At433 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let slopeShift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.2 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.2 (q 2) (q 0) + ∀ (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), ∀ (i : Fin (3 : ℕ)), ((slopeShift mn - slopeShift kl).re + = (-BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))).re) → (((slopeShift mn).re : ℝ) - + (slopeShift kl).re = ((-BandVectors.2 (q i.succ) (q 0)).re : ℝ)) ) := by + classical + intro q slopeShift kl mn i hr + exact_mod_cast hr + +private theorem hslope'At443 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let slopeShift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.2 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.2 (q 2) (q 0) + ∀ (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), ∀ (i : Fin (3 : ℕ)), (slopeShift kl - slopeShift mn = + BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))) → (slopeShift mn - slopeShift kl = + -BandVectors.2 (q i.succ) (q 0)) ) := by + classical + intro q slopeShift kl mn i hslope + rw [← hslope] + ring + +private theorem hi'At448 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let slopeShift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.2 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.2 (q 2) (q 0) + ∀ (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), ∀ (i : Fin (3 : ℕ)), ((slopeShift mn - slopeShift kl).im + = (-BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))).im) → (((slopeShift mn).im : ℝ) - + (slopeShift kl).im = ((-BandVectors.2 (q i.succ) (q 0)).im : ℝ)) ) := by + classical + intro q slopeShift kl mn i hi + exact_mod_cast hi + +end PositiveTranslationGeometry + +namespace PositiveAdjacentCompatibility + +private theorem adjacentCompatibility : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (q (0 : Fin (4 : ℕ)) = + C.1.1) → ((ProperBandQuadruple q) → (∀ (T : ProtoTile), ∀ (h : PartialOdometer), + (TileOdometer C.1.1 T h) → ( + let shift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) + let slopeShift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.2 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.2 (q 2) (q 0) + let H (kl : Int × Int) : PartialOdometer := + PartialOdometerAffineTranslate h (shift kl) (slopeShift kl) 0 + (∃ p : ℝ × ℝ, PartialOdometerSlope h = some p) → (∀ (P : PeriodicTileComplex + ↥(TilingLattice C)), (∀ (u : ↥(TilingLattice C)), P.tile u = TileTranslation T (↑u : + GaussianInt)) → ((∀ (u : ↥(TilingLattice C)), ∀ (v : ↥(TilingLattice C)), + P.plane.adjacent u v ↔ ∃ (j : Fin (3 : ℕ)), (↑v : GaussianInt) - (↑u : GaussianInt) = + BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ))) ∨ (↑v : GaussianInt) - (↑u : + GaussianInt) = -BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ)))) → (∀ (lattice_coords + : ∀ kl : Int × Int, shift kl ∈ TilingLattice C), + let index (kl : Int × Int) : TilingLattice C := ⟨shift kl, lattice_coords kl⟩ + (∀ (r : Int × Int), ∀ (s : Int × Int), ∀ (i : Fin 3), shift s - shift r = BandVectors.1 + (q i.succ) (q 0) → slopeShift s - slopeShift r = BandVectors.2 (q i.succ) (q 0)) → (∀ + (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), (((FootprintEdges (P.tile (index kl)) ∩ FootprintEdges + (P.tile (index mn))).Nonempty ↔ P.plane.adjacent (index kl) (index mn)) ∧ + ((FootprintEdges (P.tile (index kl)) ∩ FootprintEdges (P.tile (index mn))).Nonempty → + SimpleGridPath (CommonFootprintEdgeVertices (P.tile (index kl)) (P.tile (index mn))) + (FootprintEdges (P.tile (index kl)) ∩ FootprintEdges (P.tile (index mn))) ∧ + FootprintVertices (P.tile (index kl)) ∩ FootprintVertices (P.tile (index mn)) = + CommonFootprintEdgeVertices (P.tile (index kl)) (P.tile (index mn))) ∧ + (¬(FootprintEdges (P.tile (index kl)) ∩ FootprintEdges (P.tile (index mn))).Nonempty + → FootprintVertices (P.tile (index kl)) ∩ FootprintVertices (P.tile (index mn)) = ∅ ∨ + (FootprintVertices (P.tile (index kl)) ∩ FootprintVertices (P.tile (index + mn))).Subsingleton)) → (((FootprintEdges (TileTranslation T (shift kl)) ∩ + FootprintEdges (TileTranslation T (shift mn))).Nonempty) → (OdometerCompatibility (H + kl) (H mn)))))))))) ) := by + classical + intro C q hqC hq T h hO shift slopeShift H slope_exists P htile hadj lattice_coords index + slope_step kl mn hclass hedge + have hedgeP : (FootprintEdges (P.tile (index kl)) ∩ + FootprintEdges (P.tile (index mn))).Nonempty := PositiveTranslationGeometry.hedgeP + C q T P htile lattice_coords kl mn hedge + have hadj' := hclass.1.mp hedgeP + have hstep := (hadj (index kl) (index mn)).mp hadj' + rcases hstep with ⟨i, hstep | hstep⟩ + · have hOkl := TileOdometerAffineTranslation C.1.1 T h (shift kl) + (slopeShift kl) 0 hO + have hOmn := TileOdometerAffineTranslation C.1.1 T h (shift mn) + (slopeShift mn) 0 hO + apply (LeftAdjacentOdometerCompatibility C + (TileTranslation T (shift kl)) (TileTranslation T (shift mn)) + (H kl) (H mn) ?_).1 + refine ⟨hOkl, hOmn, ?_⟩ + rcases slope_exists with ⟨p, hp⟩ + refine ⟨(p.1 + (slopeShift kl).re, p.2 + (slopeShift kl).im), + (p.1 + (slopeShift mn).re, p.2 + (slopeShift mn).im), ?_, ?_, ?_⟩ + · rw [PartialOdometerAffineTranslateFormulas h (shift kl) + (slopeShift kl) 0 |>.2.2.2.2.2, hp] + simp + · rw [PartialOdometerAffineTranslateFormulas h (shift mn) + (slopeShift mn) 0 |>.2.2.2.2.2, hp] + simp + · refine Or.inr ⟨q, i, true, hq, ?_, ?_, ?_, ?_⟩ + · exact hqC + · have hc1 := (TileTranslationFormulas T (shift kl)).2.2.2.2.1 + have hc2 := (TileTranslationFormulas T (shift mn)).2.2.2.2.1 + rw [hc2, hc1] + simp only [ite_true] + have hr := congrArg (fun z : GaussianInt => z.re) hstep + have hi := congrArg (fun z : GaussianInt => z.im) hstep + have hr' : ((shift mn).re : ℝ) - (shift kl).re = + ((BandVectors.1 (q i.succ) (q 0)).re : ℝ) := + PositiveTranslationGeometry.hr'At341 C q lattice_coords kl mn i hr + have hi' : ((shift mn).im : ℝ) - (shift kl).im = + ((BandVectors.1 (q i.succ) (q 0)).im : ℝ) := + PositiveTranslationGeometry.hi'At344 C q lattice_coords kl mn i hi + apply Prod.ext + · simp? [GaussianRealPoint] + rw [← GaussianInt.intCast_re, ← GaussianInt.intCast_re, + ← GaussianInt.intCast_re] + linarith + · simp? [GaussianRealPoint] + rw [← GaussianInt.intCast_im, ← GaussianInt.intCast_im, + ← GaussianInt.intCast_im] + linarith + · simp? [] + rw [← GaussianInt.intCast_re, ← GaussianInt.intCast_re, + ← GaussianInt.intCast_re] + have hslope := slope_step kl mn i hstep + have hr := congrArg (fun z : GaussianInt => z.re) hslope + have hr' : ((slopeShift mn).re : ℝ) - (slopeShift kl).re = + ((BandVectors.2 (q i.succ) (q 0)).re : ℝ) := + PositiveTranslationGeometry.hr'At361 q kl mn i hr + linarith + · simp? [] + rw [← GaussianInt.intCast_im, ← GaussianInt.intCast_im, + ← GaussianInt.intCast_im] + have hslope := slope_step kl mn i hstep + have hi := congrArg (fun z : GaussianInt => z.im) hslope + have hi' : ((slopeShift mn).im : ℝ) - (slopeShift kl).im = + ((BandVectors.2 (q i.succ) (q 0)).im : ℝ) := + PositiveTranslationGeometry.hi'At370 q kl mn i hi + linarith + · have hstep' : shift kl - shift mn = BandVectors.1 (q i.succ) (q 0) := by + simpa using congrArg Neg.neg hstep + have hOkl := TileOdometerAffineTranslation C.1.1 T h (shift kl) + (slopeShift kl) 0 hO + have hOmn := TileOdometerAffineTranslation C.1.1 T h (shift mn) + (slopeShift mn) 0 hO + apply (LeftAdjacentOdometerCompatibility C + (TileTranslation T (shift kl)) (TileTranslation T (shift mn)) + (H kl) (H mn) ?_).1 + refine ⟨hOkl, hOmn, ?_⟩ + rcases slope_exists with ⟨p, hp⟩ + refine ⟨(p.1 + (slopeShift kl).re, p.2 + (slopeShift kl).im), + (p.1 + (slopeShift mn).re, p.2 + (slopeShift mn).im), ?_, ?_, ?_⟩ + · rw [PartialOdometerAffineTranslateFormulas h (shift kl) + (slopeShift kl) 0 |>.2.2.2.2.2, hp] + simp + · rw [PartialOdometerAffineTranslateFormulas h (shift mn) + (slopeShift mn) 0 |>.2.2.2.2.2, hp] + simp + · refine Or.inr ⟨q, i, false, hq, hqC, ?_, ?_, ?_⟩ + · have hc1 := (TileTranslationFormulas T (shift kl)).2.2.2.2.1 + have hc2 := (TileTranslationFormulas T (shift mn)).2.2.2.2.1 + rw [hc2, hc1] + have hstep'' : shift mn - shift kl = + -BandVectors.1 (q i.succ) (q 0) := PositiveTranslationGeometry.hstep'' C q + lattice_coords kl mn i hstep + have hr := congrArg (fun z : GaussianInt => z.re) hstep'' + have hi := congrArg (fun z : GaussianInt => z.im) hstep'' + apply Prod.ext + · simp? [GaussianRealPoint] + rw [← GaussianInt.intCast_re, ← GaussianInt.intCast_re, + ← GaussianInt.intCast_re] + have hr' : ((shift mn).re : ℝ) - (shift kl).re = + ((-BandVectors.1 (q i.succ) (q 0)).re : ℝ) := + PositiveTranslationGeometry.hr'At406 q kl mn i hr + norm_num at hr' + rw [← GaussianInt.intCast_re, ← GaussianInt.intCast_re, + ← GaussianInt.intCast_re] at hr' + linarith + · simp? [GaussianRealPoint] + rw [← GaussianInt.intCast_im, ← GaussianInt.intCast_im, + ← GaussianInt.intCast_im] + have hi' : ((shift mn).im : ℝ) - (shift kl).im = + ((-BandVectors.1 (q i.succ) (q 0)).im : ℝ) := + PositiveTranslationGeometry.hi'At416 q kl mn i hi + norm_num at hi' + rw [← GaussianInt.intCast_im, ← GaussianInt.intCast_im, + ← GaussianInt.intCast_im] at hi' + linarith + · simp only [] + change (p.1 + (slopeShift mn).re - + (p.1 + (slopeShift kl).re) : ℝ) = + -1 * (BandVectors.2 (q i.succ) (q 0)).re + have hslope := slope_step mn kl i hstep' + have hslope' : slopeShift mn - slopeShift kl = + -BandVectors.2 (q i.succ) (q 0) := PositiveTranslationGeometry.hslope'At428 q + kl mn i hslope + have hr := congrArg (fun z : GaussianInt => z.re) hslope' + have hr' : ((slopeShift mn).re : ℝ) - (slopeShift kl).re = + ((-BandVectors.2 (q i.succ) (q 0)).re : ℝ) := + PositiveTranslationGeometry.hr'At433 q kl mn i hr + norm_num at hr' ⊢ + linarith + · simp only [] + change (p.2 + (slopeShift mn).im - + (p.2 + (slopeShift kl).im) : ℝ) = + -1 * (BandVectors.2 (q i.succ) (q 0)).im + have hslope := slope_step mn kl i hstep' + have hslope' : slopeShift mn - slopeShift kl = + -BandVectors.2 (q i.succ) (q 0) := PositiveTranslationGeometry.hslope'At443 q + kl mn i hslope + have hi := congrArg (fun z : GaussianInt => z.im) hslope' + have hi' : ((slopeShift mn).im : ℝ) - (slopeShift kl).im = + ((-BandVectors.2 (q i.succ) (q 0)).im : ℝ) := + PositiveTranslationGeometry.hi'At448 q kl mn i hi + norm_num at hi' ⊢ + linarith + +end PositiveAdjacentCompatibility + +theorem PositiveCurvatureTranslatedOdometers (C : BandCircle) + (hc : 1 < C.1.1.1) : + ∃ (q : Fin 4 → CircleCoordinates) (T : ProtoTile) (h : PartialOdometer) + (H : Int × Int → PartialOdometer), + ProperBandQuadruple q ∧ q 0 = C.1.1 ∧ + BandPrototile C.1.1 T ∧ TileOdometer C.1.1 T h ∧ + (∀ kl, + let w := (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) + let a := (kl.1 : GaussianInt) * BandVectors.2 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.2 (q 2) (q 0) + TileOdometer C.1.1 (TileTranslation T w) (H kl) ∧ + (∀ x, x ∈ (H kl).domain ↔ x - w ∈ h.domain) ∧ + ∀ x, x ∈ (H kl).domain → + (H kl).value x = h.value (x - w) + a.re * x.re + a.im * x.im) ∧ + ∀ kl mn, OdometerCompatibility (H kl) (H mn) := by +-- BODY + rcases BandGenealogy C with hunit | ⟨q, hqsemi, hqC, hless, huniq⟩ + · omega + · have hq : ProperBandQuadruple q := ⟨hqsemi, by simpa [hqC] using hless⟩ + rcases TileOdometerExists C with ⟨T, h, hT, hO⟩ + have hpos : 0 < C.1.1.1 := by omega + let shift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) + let slopeShift (kl : Int × Int) : GaussianInt := + (kl.1 : GaussianInt) * BandVectors.2 (q 1) (q 0) + + (kl.2 : GaussianInt) * BandVectors.2 (q 2) (q 0) + let H (kl : Int × Int) : PartialOdometer := + PartialOdometerAffineTranslate h (shift kl) (slopeShift kl) 0 + have slope_for : ∀ (c : CircleCoordinates) (U : ProtoTile) + (k : PartialOdometer), TileOdometer c U k → 1 < c.1 → + ∃ p : ℝ × ℝ, PartialOdometerSlope k = some p := PositiveTranslationGeometry.slope_for C + have slope_exists : ∃ p : ℝ × ℝ, PartialOdometerSlope h = some p := + slope_for C.1.1 T h hO (by omega) + obtain ⟨P, hPl, htile, hadj, hposition, hvcard, hecard, hfcard, hchart⟩ := + BandRegularTranslatePeriodicComplex C q hq hqC T (by simpa [hqC] using hT) + have lattice_coords : ∀ kl : Int × Int, shift kl ∈ TilingLattice C := + PositiveTranslationGeometry.lattice_coords C q hqC hq + let index (kl : Int × Int) : TilingLattice C := ⟨shift kl, lattice_coords kl⟩ + have index_injective : Function.Injective index := + PositiveTranslationGeometry.index_injective C q hqC hq lattice_coords + have slope_step : ∀ (r s : Int × Int) (i : Fin 3), + shift s - shift r = BandVectors.1 (q i.succ) (q 0) → + slopeShift s - slopeShift r = BandVectors.2 (q i.succ) (q 0) := + PositiveTranslationGeometry.slope_step C q hq lattice_coords index_injective + refine ⟨q, T, h, H, hq, hqC, hT, hO, ?_, ?_⟩ + · intro kl + refine ⟨?_, ?_, ?_⟩ + · exact TileOdometerAffineTranslation C.1.1 T h (shift kl) + (slopeShift kl) 0 hO + · intro x + exact (PartialOdometerAffineTranslateFormulas h (shift kl) + (slopeShift kl) 0).2.1 x + · intro x hx + simpa [H, shift, slopeShift] using (PartialOdometerAffineTranslateFormulas h + (shift kl) (slopeShift kl) 0).2.2.1 x hx + · intro kl mn + by_cases hkm : kl = mn + · subst mn + right + refine ⟨0, ?_⟩ + intro x hx hx' + simp + · have hidx : index kl ≠ index mn := PositiveTranslationGeometry.hidx C q lattice_coords + index_injective kl mn hkm + have hdom : ∀ r : Int × Int, + (H r).domain = FootprintVertices (TileTranslation T (shift r)) := + PositiveTranslationGeometry.hdom C q T h hO hpos + have hclass := (PeriodicTileIntersectionClassification P).1 + (index kl) (index mn) hidx + have hclass' := hclass.2.2 + rw [htile (index kl), htile (index mn)] at hclass' + change ¬(FootprintEdges (TileTranslation T (shift kl)) ∩ + FootprintEdges (TileTranslation T (shift mn))).Nonempty → _ at hclass' + by_cases hedge : (FootprintEdges (TileTranslation T (shift kl)) ∩ + FootprintEdges (TileTranslation T (shift mn))).Nonempty + · have adjacentCompatibility : OdometerCompatibility (H kl) (H mn) := + PositiveAdjacentCompatibility.adjacentCompatibility C q hqC hq T h hO slope_exists P + htile hadj lattice_coords slope_step kl mn hclass hedge + exact adjacentCompatibility + · rcases hclass' hedge with hempty | hsingle + · left + apply Set.disjoint_left.2 + intro x hx hy + have hxv := (hdom kl).symm ▸ hx + have hyv := (hdom mn).symm ▸ hy + have : x ∈ (∅ : Set GaussianInt) := by rw [← hempty]; exact ⟨hxv, hyv⟩ + exact this.elim + · by_cases hne : ∃ x, x ∈ (H kl).domain ∧ x ∈ (H mn).domain + · rcases hne with ⟨x₀, hx₀, hy₀⟩ + right + refine ⟨(H mn).value x₀ - (H kl).value x₀, ?_⟩ + intro x hx hy + have hxv : x ∈ FootprintVertices (TileTranslation T (shift kl)) := + (hdom kl).symm ▸ hx + have hyv : x ∈ FootprintVertices (TileTranslation T (shift mn)) := + (hdom mn).symm ▸ hy + have heq : x = x₀ := hsingle ⟨hxv, hyv⟩ ⟨ + (hdom kl).symm ▸ hx₀, (hdom mn).symm ▸ hy₀⟩ + subst x + rfl + · left + apply Set.disjoint_left.2 + intro x hx hy + exact hne ⟨x, hx, hy⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCutCompanionRow.lean b/LeanPool/ApollonianSuperharmonic/PositiveCutCompanionRow.lean new file mode 100644 index 0000000000..45fbc4794e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PositiveCutCompanionRow.lean @@ -0,0 +1,175 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.TileTranslation + +-- [TABLET NODE: PositiveCutCompanionRow] + +/-! +# PositiveCutCompanionRow + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Fix an ordered-general layout certificate and one positive precursor cut +$x$. A *positive-cut web row* records a proper birth +$p=(M,D,E,F)$, a raw parent slot $r\in\mathbb Z/3\mathbb Z$, a rotation +$s\in\mathbb Z/4\mathbb Z$, a selected whole-child occurrence $U$ for +$M$, and a selected parent occurrence $W$ for $p_{r+1}$. The row includes +the certificate that the precursor $O$ has a nonempty cell set, the +corresponding `BandPrototile` certificates, and the two cut +memberships $x\in\operatorname{foot}(U)\cap\operatorname{foot}(W)$. Some incident $U$-cell is +opposite an incident $W$-cell, and the two footprints contain the +five-point star +$$ + x,\qquad x+1,\qquad x-1,\qquad x+\mathrm{i},\qquad x-\mathrm{i}. +$$ + +Put +$$ + u_R=\mathrm{i}^s\begin{cases}v_{0,r+1},&s\text{ even},\\ + v_{r+1,0},&s\text{ odd}. + \end{cases} +$$ +The row records that translation closure makes $U+u_R$ a prototile for +$M$ and, crucially, that +$$ + x\notin\operatorname{foot}(U+u_R). \tag{1} +$$ +Thus the right companion is always the actual translated child prescribed +by the web rule, rather than an occurrence guessed from a circle label. + +The literal tag is exactly one of the following eight alternatives: +$$ +\begin{array}{c|c|c|c|c|c} +p&x&U&W&r&s\\ \hline +(C_2,D,C_3,C_4)&a&Q_2^+&S_3^-&1&1\\ +(C_2,D,C_3,C_4)&a&Q_2^+&O&2&0\\ +(C_2,D,C_3,C_4)&b&S_2^-&Q_3^+&1&3\\ +(C_2,D,C_3,C_4)&b&S_2^-&O&2&2\\ +(C_4,D,C_2,C_3)&a&O&Q_2^+&1&1\\ +(C_4,D,C_2,C_3)&a&O&S_3^-&2&0\\ +(C_4,D,C_2,C_3)&b&O&S_2^-&1&3\\ +(C_4,D,C_2,C_3)&b&O&Q_3^+&2&2. +\end{array} \tag{2} +$$ +For the first and third rows only, the row additionally records observable +equality, meaning equality of cell sets and equality of anchors when those +sets are empty, of $U+u_R$ with $P_2^+$ and $P_2^-$, respectively. These +are the two fixed $Q$--$S$ companions identified in the manuscript. No +literal support is asserted for the other six rows merely from their tags. +In particular the four $C_4$-birth rows do not identify their companions +with $Q_4^+$ or $S_4^-$. +-/ +structure PositiveCutCompanionRow + {q : Fin 4 → CircleCoordinates} + {cfg : BandOrderedGeneralConfiguration q} + {C₀ : BandCircle} {T : ProtoTile} + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) + (x : GaussianInt) where +-- BODY + precursorNonempty : cert.O.cells.Nonempty + /-- The proper birth presentation prescribed by the literal positive-cut row. -/ + birth : Fin 4 → CircleCoordinates + /-- The parent slot fixed by that row in its birth presentation. -/ + parentIndex : Fin 3 + /-- The quarter-turn index fixed by that literal row. -/ + rotation : Fin 4 + /-- The selected whole-child occurrence through the precursor attachment. -/ + child : ProtoTile + /-- The selected parent occurrence on the opposite side of the attachment. -/ + parent : ProtoTile + proper : ProperBandQuadruple birth + childPrototile : BandPrototile (birth 0) child + parentPrototile : BandPrototile (birth parentIndex.succ) parent + child_mem : x ∈ FootprintVertices child + parent_mem : x ∈ FootprintVertices parent + opposite : ∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ child.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ parent.cells + star : ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices child ∨ y ∈ FootprintVertices parent + rightPrototile : + let uR := (⟨0, 1⟩ : GaussianInt) ^ rotation.val * + (if Even rotation.val then + BandVectors.1 (birth 0) (birth parentIndex.succ) + else BandVectors.1 (birth parentIndex.succ) (birth 0)) + BandPrototile (birth 0) (TileTranslation child uR) + rightAbsent : + let uR := (⟨0, 1⟩ : GaussianInt) ^ rotation.val * + (if Even rotation.val then + BandVectors.1 (birth 0) (birth parentIndex.succ) + else BandVectors.1 (birth parentIndex.succ) (birth 0)) + x ∉ FootprintVertices (TileTranslation child uR) + fixedPlusCompanion : + child = cert.Q 1 true → parent = cert.S 2 false → + let uR := (⟨0, 1⟩ : GaussianInt) ^ rotation.val * + (if Even rotation.val then + BandVectors.1 (birth 0) (birth parentIndex.succ) + else BandVectors.1 (birth parentIndex.succ) (birth 0)) + (TileTranslation child uR).cells = (cert.P 1 true).cells ∧ + ((TileTranslation child uR).cells = ∅ → + (TileTranslation child uR).anchor = (cert.P 1 true).anchor) + fixedMinusCompanion : + child = cert.S 1 false → parent = cert.Q 2 true → + let uR := (⟨0, 1⟩ : GaussianInt) ^ rotation.val * + (if Even rotation.val then + BandVectors.1 (birth 0) (birth parentIndex.succ) + else BandVectors.1 (birth parentIndex.succ) (birth 0)) + (TileTranslation child uR).cells = (cert.P 1 false).cells ∧ + ((TileTranslation child uR).cells = ∅ → + (TileTranslation child uR).anchor = (cert.P 1 false).anchor) + literalRow : + (birth = ![q 2, birth 1, q 3, cfg.firstPredecessor 1] ∧ + parentIndex = 1 ∧ rotation = 1 ∧ + x = cert.exceptional_segments.a ∧ + child = cert.Q 1 true ∧ parent = cert.S 2 false) ∨ + (birth = ![q 2, birth 1, q 3, cfg.firstPredecessor 1] ∧ + parentIndex = 2 ∧ rotation = 0 ∧ + x = cert.exceptional_segments.a ∧ + child = cert.Q 1 true ∧ parent = cert.O) ∨ + (birth = ![q 2, birth 1, q 3, cfg.firstPredecessor 1] ∧ + parentIndex = 1 ∧ rotation = 3 ∧ + x = cert.exceptional_segments.b ∧ + child = cert.S 1 false ∧ parent = cert.Q 2 true) ∨ + (birth = ![q 2, birth 1, q 3, cfg.firstPredecessor 1] ∧ + parentIndex = 2 ∧ rotation = 2 ∧ + x = cert.exceptional_segments.b ∧ + child = cert.S 1 false ∧ parent = cert.O) ∨ + (birth = ![cfg.firstPredecessor 1, birth 1, q 2, q 3] ∧ + parentIndex = 1 ∧ rotation = 1 ∧ + x = cert.exceptional_segments.a ∧ + child = cert.O ∧ parent = cert.Q 1 true) ∨ + (birth = ![cfg.firstPredecessor 1, birth 1, q 2, q 3] ∧ + parentIndex = 2 ∧ rotation = 0 ∧ + x = cert.exceptional_segments.a ∧ + child = cert.O ∧ parent = cert.S 2 false) ∨ + (birth = ![cfg.firstPredecessor 1, birth 1, q 2, q 3] ∧ + parentIndex = 1 ∧ rotation = 3 ∧ + x = cert.exceptional_segments.b ∧ + child = cert.O ∧ parent = cert.S 1 false) ∨ + (birth = ![cfg.firstPredecessor 1, birth 1, q 2, q 3] ∧ + parentIndex = 2 ∧ rotation = 2 ∧ + x = cert.exceptional_segments.b ∧ + child = cert.O ∧ parent = cert.Q 2 true) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PositiveDefiniteRepresentativeGap.lean b/LeanPool/ApollonianSuperharmonic/PositiveDefiniteRepresentativeGap.lean new file mode 100644 index 0000000000..ca4b56e8aa --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PositiveDefiniteRepresentativeGap.lean @@ -0,0 +1,165 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicRepresentative +public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm +public import LeanPool.ApollonianSuperharmonic.QuadraticGrowthAtInfinity +public import LeanPool.ApollonianSuperharmonic.P5691T1PosDefQuadraticLowerBound + +-- [TABLET NODE: PositiveDefiniteRepresentativeGap] + +/-! +# PositiveDefiniteRepresentativeGap + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem PositiveDefiniteRepresentativeGap + (A : Matrix (Fin 2) (Fin 2) Real) (C : BandCircle) + (g h : IntegerLatticeFunction) + (hg : IntegerSuperharmonicRepresentative A g) + (hh : IntegerSuperharmonicRepresentative (CircleMatrix C) h) + (hgap : (A - CircleMatrix C).PosDef) : + (forall M : Real, exists R : Real, forall x : GaussianInt, + R <= (x.re : Real) ^ 2 + (x.im : Real) ^ 2 -> + M <= (g x : Real) - (h x : Real)) /\ + (exists c : Int, forall x : GaussianInt, h x <= g x + c) := by +-- BODY + rcases hg with ⟨hAs, hQg, hglap⟩ + rcases hh with ⟨hCs, hQh, hhlap⟩ + let D := A - CircleMatrix C + obtain ⟨k, hk, hlower⟩ := P5691T1PosDefQuadraticLowerBound D hgap + have hqdiff (x : GaussianInt) : + LatticeQuadraticForm A x - LatticeQuadraticForm (CircleMatrix C) x = + LatticeQuadraticForm D x := by + simp [D, LatticeQuadraticForm, Matrix.sub_mulVec] + ring + have hdiv : ∀ M : ℝ, ∃ R : ℝ, ∀ x : GaussianInt, + R ≤ (x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2 → + M ≤ (g x : ℝ) - (h x : ℝ) := by + intro M + have he : 0 < k / 4 := by linarith + obtain ⟨Rg, hRg⟩ := hQg (k / 4) he + obtain ⟨Rh, hRh⟩ := hQh (k / 4) he + refine ⟨max Rg (max Rh (2 * M / k)), ?_⟩ + intro x hx + have hxg := hRg x (le_trans (le_max_left _ _) hx) + have hxh := hRh x (le_trans + (le_trans (le_max_left Rh (2 * M / k)) + (le_max_right Rg (max Rh (2 * M / k)))) hx) + have hq := hlower x + have hn : 0 ≤ (x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2 := by positivity + have hmain : k / 2 * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) ≤ + (g x : ℝ) - (h x : ℝ) := by + have hgl : -(k / 4 * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2)) ≤ + (g x : ℝ) - LatticeQuadraticForm A x := + neg_le_of_abs_le hxg + have hhu : (h x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x ≤ + k / 4 * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) := + le_of_abs_le hxh + rw [show (g x : ℝ) - (h x : ℝ) = + (LatticeQuadraticForm A x - LatticeQuadraticForm (CircleMatrix C) x) + + ((g x : ℝ) - LatticeQuadraticForm A x) - + ((h x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x) by ring] + rw [hqdiff] + linarith + have hxR : 2 * M / k ≤ (x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2 := + le_trans (le_trans (le_max_right Rh (2 * M / k)) + (le_max_right Rg (max Rh (2 * M / k)))) hx + have hxR' : 2 * M ≤ k * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) := + by simpa [mul_comm] using (div_le_iff₀ hk).mp hxR + nlinarith [hmain, hxR'] + refine ⟨hdiv, ?_⟩ + obtain ⟨R0, hR0⟩ := hdiv 0 + let S : Set GaussianInt := {x | (x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2 < R0} + obtain ⟨N, hN⟩ := exists_nat_ge (max R0 1) + have hR : R0 ≤ (N : ℝ) := le_trans (le_max_left _ _) hN + have hNo : (1 : ℝ) ≤ (N : ℝ) := le_trans (le_max_right _ _) hN + have hS : S.Finite := by + have hx_of_mem (x : GaussianInt) (hx : x ∈ S) : + -(N : ℤ) ≤ x.re ∧ x.re ≤ N ∧ -(N : ℤ) ≤ x.im ∧ x.im ≤ N := by + dsimp [S] at hx + have hr : -(N : ℝ) ≤ (x.re : ℝ) := by + nlinarith [sq_nonneg (x.im : ℝ), sq_nonneg ((x.re : ℝ) + N), hR, hNo] + have hr' : (x.re : ℝ) ≤ (N : ℝ) := by + nlinarith [sq_nonneg (x.im : ℝ), sq_nonneg ((x.re : ℝ) - N), hR, hNo] + have hi : -(N : ℝ) ≤ (x.im : ℝ) := by + nlinarith [sq_nonneg (x.re : ℝ), sq_nonneg ((x.im : ℝ) + N), hR, hNo] + have hi' : (x.im : ℝ) ≤ (N : ℝ) := by + nlinarith [sq_nonneg (x.re : ℝ), sq_nonneg ((x.im : ℝ) - N), hR, hNo] + exact ⟨by exact_mod_cast hr, by exact_mod_cast hr', + by exact_mod_cast hi, by exact_mod_cast hi'⟩ + let encode (x : S) : Fin (2 * N + 1) × Fin (2 * N + 1) := + ⟨⟨(x.1.re + N).toNat, by + have hxs := hx_of_mem x.1 x.2 + omega⟩, ⟨(x.1.im + N).toNat, by + have hxs := hx_of_mem x.1 x.2 + omega⟩⟩ + let : Finite S := Finite.of_injective encode (by + intro x y hxy + apply Subtype.ext + apply Zsqrtd.ext + · have he := congrArg (fun z => z.1) (congrArg Prod.fst hxy) + have hxn := (hx_of_mem x.1 x.2).1 + have hxp := (hx_of_mem x.1 x.2).2.1 + have hyn := (hx_of_mem y.1 y.2).1 + have hyp := (hx_of_mem y.1 y.2).2.1 + have hxn0 : 0 ≤ x.1.re + N := by omega + have hyn0 : 0 ≤ y.1.re + N := by omega + dsimp [encode] at he + have hxn1 := Int.toNat_of_nonneg hxn0 + have hyn1 := Int.toNat_of_nonneg hyn0 + omega + · have he := congrArg (fun z => z.val) (congrArg Prod.snd hxy) + have hxn := (hx_of_mem x.1 x.2).2.2.1 + have hxp := (hx_of_mem x.1 x.2).2.2.2 + have hyn := (hx_of_mem y.1 y.2).2.2.1 + have hyp := (hx_of_mem y.1 y.2).2.2.2 + have hxn0 : 0 ≤ x.1.im + N := by omega + have hyn0 : 0 ≤ y.1.im + N := by omega + dsimp [encode] at he + have hxn1 := Int.toNat_of_nonneg hxn0 + have hyn1 := Int.toNat_of_nonneg hyn0 + omega) + exact Set.finite_coe_iff.mp (by infer_instance : Finite S) + let V : Set ℤ := insert 0 ((fun x : GaussianInt => h x - g x) '' S) + have hVfin : V.Finite := by + dsimp [V] + exact Set.Finite.insert 0 (hS.image _) + have hVne : V.Nonempty := by + exact ⟨0, Set.mem_insert 0 _⟩ + obtain ⟨c, hcV, hc⟩ := Set.exists_max_image V id hVfin hVne + refine ⟨c, ?_⟩ + intro x + by_cases hxin : x ∈ S + · have hm : h x - g x ∈ V := by + apply Set.mem_insert_iff.mpr + right + exact ⟨x, hxin, rfl⟩ + have hle : h x - g x ≤ c := by + simpa using hc (h x - g x) hm + linarith + · have hlarge : R0 ≤ (x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2 := by + dsimp [S] at hxin + exact le_of_not_gt hxin + have hnon : (0 : ℝ) ≤ (g x : ℝ) - (h x : ℝ) := hR0 x hlarge + have hnon' : h x ≤ g x := by + exact_mod_cast (show (h x : ℝ) ≤ (g x : ℝ) by linarith) + have hc0 : (0 : ℤ) ≤ c := by + have := hc 0 (Set.mem_insert 0 _) + simpa using this + linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PositiveTracePackingDichotomy.lean b/LeanPool/ApollonianSuperharmonic/PositiveTracePackingDichotomy.lean new file mode 100644 index 0000000000..b391c85892 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PositiveTracePackingDichotomy.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandCircleEnclosureDichotomy +public import LeanPool.ApollonianSuperharmonic.CircleMatrixEnclosureCriterion +public import LeanPool.ApollonianSuperharmonic.SymmetricMatrixCoordinates + +-- [TABLET NODE: PositiveTracePackingDichotomy] + +/-! +# PositiveTracePackingDichotomy + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem PositiveTracePackingDichotomy + (A : Matrix (Fin 2) (Fin 2) Real) (hA : A.IsSymm) + (htrace : 0 < Matrix.trace A) : + (∃ C : BandCircle, (CircleMatrix C - A).PosSemidef) ∨ + (∃ C : BandCircle, (A - CircleMatrix C).PosDef) := by +-- BODY + let E : EuclideanCircleData := + { center := (SymmetricMatrixCoordinates A).1 + radius := (SymmetricMatrixCoordinates A).2 + radius_pos := by + simpa [SymmetricMatrixCoordinates] using htrace } + rcases BandCircleEnclosureDichotomy E with h | h + · left + rcases h with ⟨C, hC⟩ + refine ⟨C, (CircleMatrixEnclosureCriterion A hA C).1.mpr ?_⟩ + simpa [E] using hC + · right + rcases h with ⟨C, hC⟩ + refine ⟨C, (CircleMatrixEnclosureCriterion A hA C).2.mpr ?_⟩ + simpa [E] using hC + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/Preamble.lean b/LeanPool/ApollonianSuperharmonic/Preamble.lean new file mode 100644 index 0000000000..e211d004af --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/Preamble.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +-- Preamble: shared imports for all tablet nodes. +-- Add specific Mathlib imports here (never `import Mathlib`). +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt +public import Mathlib.Data.Fin.VecNotation +public import Mathlib.LinearAlgebra.Matrix.ToLin +public import Mathlib.LinearAlgebra.Matrix.Trace +public import Mathlib.LinearAlgebra.Matrix.PosDef +public import Mathlib.Data.Finset.Card +public import Mathlib.Topology.Homeomorph.Defs +public import Mathlib.Topology.MetricSpace.Isometry +public import Mathlib.SetTheory.Cardinal.Finite + +/-! +# Preamble + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PrecursorBoundaryArcData.lean b/LeanPool/ApollonianSuperharmonic/PrecursorBoundaryArcData.lean new file mode 100644 index 0000000000..63beb71a52 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PrecursorBoundaryArcData.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: PrecursorBoundaryArcData] + +/-! +# PrecursorBoundaryArcData + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $D^+,D^-,O,O'$ be prototiles, where $O$ and $O'$ are the two +labelled occurrences of one precursor: they have the same cell set and, +when that set is empty, the same anchor. Let $(Q_2,S_3)$ and +$(Q_3,S_2)$ be its two labelled attaching pairs. Thus +$(Q_2,S_3,O)$ and $(Q_3,S_2,O)$ are `TouchingTriple`s, the +$Q_2,Q_3$ cell sets are contained in $D^+$, and the $S_3,S_2$ cell sets +are contained in $D^-$. A *precursor +boundary-arc certificate* consists of two attachment vertices $a,b$ such +that $a$ is the unique common boundary vertex of $Q_2,S_3,O$ and $b$ is +the unique common boundary vertex of $Q_3,S_2,O$, together with one of the +following two alternatives. + +If $O$ has a cell, the certificate contains simple vertex lists $K^+$ and +$K^-$, oriented from $a$ to $b$ and from $b$ to $a$, whose vertex sets are +exactly +$$ + \partial\operatorname{foot}(D^+)\cap\partial\operatorname{foot}(O),\qquad + \partial\operatorname{foot}(D^-)\cap\partial\operatorname{foot}(O), +$$ +and whose consecutive edges belong to the corresponding common boundary +edge sets. These two arcs cover the entire boundary footprint of $O$, +their common vertices are exactly $\{a,b\}$, half-turn about $\operatorname{cent}(O)$ +sends $a$ to $b$, and that half-turn sends the vertex set of $K^+$ exactly +onto the vertex set of $K^-$. The lists have no repeated vertices. + +If $O$ has no cells, then $a=b$ is the common anchor of $O$ and $O'$, and +both boundary footprints are exactly the singleton $\{a\}$. +-/ +structure PrecursorBoundaryArcData + (Dplus Dminus O O' Q2 S3 Q3 S2 : ProtoTile) where +-- BODY + precursor_cells : O.cells = O'.cells + precursor_anchor : O.cells = ∅ → O.anchor = O'.anchor + first_touching : TouchingTriple Q2 S3 O + second_touching : TouchingTriple Q3 S2 O + first_plus_child : Q2.cells ⊆ Dplus.cells + first_minus_child : S3.cells ⊆ Dminus.cells + second_plus_child : Q3.cells ⊆ Dplus.cells + second_minus_child : S2.cells ⊆ Dminus.cells + /-- The unique attachment vertex of the first labelled child pair to the precursor. -/ + a : GaussianInt + /-- The unique attachment vertex of the second labelled child pair to the precursor. -/ + b : GaussianInt + first_transition : ∀ x : GaussianInt, + x ∈ BoundaryFootprintVertices Q2 ∧ + x ∈ BoundaryFootprintVertices S3 ∧ + x ∈ BoundaryFootprintVertices O ↔ x = a + second_transition : ∀ x : GaussianInt, + x ∈ BoundaryFootprintVertices Q3 ∧ + x ∈ BoundaryFootprintVertices S2 ∧ + x ∈ BoundaryFootprintVertices O ↔ x = b + branch : + (O.cells.Nonempty ∧ + ∃ plusArc minusArc : List GaussianInt, + plusArc.Nodup ∧ minusArc.Nodup ∧ + plusArc.head? = some a ∧ plusArc.getLast? = some b ∧ + minusArc.head? = some b ∧ minusArc.getLast? = some a ∧ + (plusArc.toFinset : Set GaussianInt) = + BoundaryFootprintVertices Dplus ∩ BoundaryFootprintVertices O ∧ + (minusArc.toFinset : Set GaussianInt) = + BoundaryFootprintVertices Dminus ∩ BoundaryFootprintVertices O ∧ + (∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + plusArc = l1 ++ x :: y :: l2 → + {x, y} ∈ BoundaryFootprintEdges Dplus ∩ + BoundaryFootprintEdges O) ∧ + (∀ x y : GaussianInt, ∀ l1 l2 : List GaussianInt, + minusArc = l1 ++ x :: y :: l2 → + {x, y} ∈ BoundaryFootprintEdges Dminus ∩ + BoundaryFootprintEdges O) ∧ + BoundaryFootprintVertices O = + (plusArc.toFinset : Set GaussianInt) ∪ + (minusArc.toFinset : Set GaussianInt) ∧ + (plusArc.toFinset : Set GaussianInt) ∩ + (minusArc.toFinset : Set GaussianInt) = {a, b} ∧ + GaussianRealPoint b = + (2 * (TileCentroid O).1 - (GaussianRealPoint a).1, + 2 * (TileCentroid O).2 - (GaussianRealPoint a).2) ∧ + (fun z : GaussianInt => + (2 * (TileCentroid O).1 - (GaussianRealPoint z).1, + 2 * (TileCentroid O).2 - (GaussianRealPoint z).2)) '' + (plusArc.toFinset : Set GaussianInt) = + GaussianRealPoint '' (minusArc.toFinset : Set GaussianInt)) ∨ + (O.cells = ∅ ∧ a = b ∧ a = O.anchor ∧ a = O'.anchor ∧ + BoundaryFootprintVertices O = {a} ∧ + BoundaryFootprintVertices O' = {a}) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientation.lean b/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientation.lean new file mode 100644 index 0000000000..cac86d9b72 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientation.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple + +-- [TABLET NODE: PrimitiveVectorOrientation] + +/-! +# PrimitiveVectorOrientation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The primitive orientation of an unoriented band-tangent edge is chosen from +the stage where that edge enters the directed semi-proper genealogy. At a +proper quadruple +$(C_0,C_1,C_2,C_3)$ it points from each parent to the child, +$C_j\longrightarrow C_0$ for $j=1,2,3$. At a root +$$ + ((1,1+2z),(1,1+2z+2i),(0,1),(0,-1)) +$$ +the four primitive root orientations are +$$ + C_3\longrightarrow C_2,\qquad C_2\longrightarrow C_1,\qquad + C_3\longrightarrow C_1,\qquad C_1\longrightarrow C_0. +$$ +For the first two, the manuscript gives the primitive base value directly. +For $C_3\to C_1$ it gives the opposite value $v_{13},a_{13}$, from which the +primitive value is recovered by the single quarter-turn rule. The fourth is +the remaining edge between adjacent unit circles; its values are obtained by +applying the successor formulas to a parent rotation of the root. Parameter +shifts identify the other two child--line edges with the displayed root +families. These choices make the reverse rule have the same sign on every +root and proper parent--child edge. This is a relation on curvature +coordinates, not on derivation codes. +-/ +inductive PrimitiveVectorOrientation : + CircleCoordinates → CircleCoordinates → Prop where +-- BODY + | base32 (z : GaussianInt) : + PrimitiveVectorOrientation (0, -1) (0, 1) + | base21 (z : GaussianInt) : + PrimitiveVectorOrientation (0, 1) + (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)) + | base31 (z : GaussianInt) : + PrimitiveVectorOrientation + (0, -1) (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)) + | base10 (z : GaussianInt) : + PrimitiveVectorOrientation + (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)) + (1, 1 + 2 * z) + | parentChild {q : Fin 4 → CircleCoordinates} + (hq : ProperBandQuadruple q) (j : Fin 3) : + PrimitiveVectorOrientation (q j.succ) (q 0) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientationUnique.lean b/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientationUnique.lean new file mode 100644 index 0000000000..ef07110140 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientationUnique.lean @@ -0,0 +1,256 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandTangency +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple + +-- [TABLET NODE: PrimitiveVectorOrientationUnique] + +/-! +# PrimitiveVectorOrientationUnique + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PrimitiveOrientation + +private def Good : (Fin 4 → CircleCoordinates) → Prop := fun q => + (∀ i j : Fin 4, i ≠ j → q i ≠ q j) ∧ + (∀ i j : Fin 4, i ≠ j → + PrimitiveVectorOrientation (q i) (q j) ∨ + PrimitiveVectorOrientation (q j) (q i)) + +private theorem baseGood : ∀ z, Good (![ (1, 1 + 2 * z), + (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)), (0, 1), (0, -1) ]) := by + intro z + constructor + · intro i j hij hsame + fin_cases i <;> fin_cases j + all_goals try { exact (hij rfl).elim } + all_goals norm_num [Zsqrtd.ext_iff] at hsame + · intro i j hij + fin_cases i <;> fin_cases j + all_goals simp? + · exact (hij rfl).elim + · exact Or.inr (PrimitiveVectorOrientation.base10 z) + · convert Or.inr (PrimitiveVectorOrientation.base21 (z - ⟨0, 1⟩)) using 1; ring + · convert Or.inr (PrimitiveVectorOrientation.base31 (z - ⟨0, 1⟩)) using 1; ring + · exact Or.inl (PrimitiveVectorOrientation.base10 z) + · exact (hij rfl).elim + · exact Or.inr (PrimitiveVectorOrientation.base21 z) + · exact Or.inr (PrimitiveVectorOrientation.base31 z) + · convert Or.inl (PrimitiveVectorOrientation.base21 (z - ⟨0, 1⟩)) using 1; ring + · exact Or.inl (PrimitiveVectorOrientation.base21 z) + · exact (hij rfl).elim + · exact Or.inr (PrimitiveVectorOrientation.base32 z) + · convert Or.inl (PrimitiveVectorOrientation.base31 (z - ⟨0, 1⟩)) using 1; ring + · exact Or.inl (PrimitiveVectorOrientation.base31 z) + · exact Or.inl (PrimitiveVectorOrientation.base32 z) + · exact (hij rfl).elim + +private theorem rotateGood : ∀ {q}, Good q → Good (![q 0, q 2, q 3, q 1]) := by + intro q hq + rcases hq with ⟨distinct, oriented⟩ + constructor + · intro i j hij hsame + fin_cases i <;> fin_cases j + all_goals try { exact (hij rfl).elim } + · exact distinct 0 2 (by decide) hsame + · exact distinct 0 3 (by decide) hsame + · exact distinct 0 1 (by decide) hsame + · exact distinct 2 0 (by decide) hsame + · exact distinct 2 3 (by decide) hsame + · exact distinct 2 1 (by decide) hsame + · exact distinct 3 0 (by decide) hsame + · exact distinct 3 2 (by decide) hsame + · exact distinct 3 1 (by decide) hsame + · exact distinct 1 0 (by decide) hsame + · exact distinct 1 2 (by decide) hsame + · exact distinct 1 3 (by decide) hsame + · intro i j hij + fin_cases i <;> fin_cases j + all_goals dsimp + · exact (hij rfl).elim + · exact oriented 0 2 (by decide) + · exact oriented 0 3 (by decide) + · exact oriented 0 1 (by decide) + · exact oriented 2 0 (by decide) + · exact (hij rfl).elim + · exact oriented 2 3 (by decide) + · exact oriented 2 1 (by decide) + · exact oriented 3 0 (by decide) + · exact oriented 3 2 (by decide) + · exact (hij rfl).elim + · exact oriented 3 1 (by decide) + · exact oriented 1 0 (by decide) + · exact oriented 1 2 (by decide) + · exact oriented 1 3 (by decide) + · exact (hij rfl).elim + +private theorem invariant : ∀ q, SemiProperQuadruple q → Good q := by + intro q hq + induction hq with + | base z => exact baseGood z + | rotate hq ih => + exact rotateGood ih + | @successor q hq ih => + rcases ih with ⟨distinct, oriented⟩ + let r := ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), q 0, q 2, q 3] + have classification := SemiProperForestClassification r (SemiProperQuadruple.successor hq) + change Good r + rcases classification.2 with root | root | root | proper + · rcases root with ⟨z, hz⟩ + rw [hz] + exact baseGood z + · rcases root with ⟨z, hz⟩ + rw [hz] + exact rotateGood (baseGood z) + · rcases root with ⟨z, hz⟩ + rw [hz] + exact rotateGood (rotateGood (baseGood z)) + · rcases proper with ⟨hs, inequalities⟩ + constructor + · intro i j hij hsame + have h0 := inequalities 0 + have h1 := inequalities 1 + have h2 := inequalities 2 + fin_cases i <;> fin_cases j + all_goals dsimp [r] at h0 h1 h2 hsame + all_goals try { exact (hij rfl).elim } + all_goals try { have curv := congrArg Prod.fst hsame; omega } + · exact distinct 0 2 (by decide) hsame + · exact distinct 0 3 (by decide) hsame + · exact distinct 2 0 (by decide) hsame + · exact distinct 2 3 (by decide) hsame + · exact distinct 3 0 (by decide) hsame + · exact distinct 3 2 (by decide) hsame + · intro i j hij + fin_cases i <;> fin_cases j + · exact (hij rfl).elim + · simpa using (Or.inr (PrimitiveVectorOrientation.parentChild ⟨hs, inequalities⟩ 0)) + · simpa using (Or.inr (PrimitiveVectorOrientation.parentChild ⟨hs, inequalities⟩ 1)) + · simpa using (Or.inr (PrimitiveVectorOrientation.parentChild ⟨hs, inequalities⟩ 2)) + · simpa using (Or.inl (PrimitiveVectorOrientation.parentChild ⟨hs, inequalities⟩ 0)) + · exact (hij rfl).elim + · exact oriented 0 2 (by decide) + · exact oriented 0 3 (by decide) + · simpa using (Or.inl (PrimitiveVectorOrientation.parentChild ⟨hs, inequalities⟩ 1)) + · exact oriented 2 0 (by decide) + · exact (hij rfl).elim + · exact oriented 2 3 (by decide) + · simpa using (Or.inl (PrimitiveVectorOrientation.parentChild ⟨hs, inequalities⟩ 2)) + · exact oriented 3 0 (by decide) + · exact oriented 3 2 (by decide) + · exact (hij rfl).elim + +private theorem curvature : ∀ {A B : CircleCoordinates}, + PrimitiveVectorOrientation A B → A.1 ≤ B.1 := by + intro A B h + cases h with + | base32 z => omega + | base21 z => omega + | base31 z => omega + | base10 z => omega + | parentChild hq j => exact le_of_lt (by simpa using hq.2 j) + +private theorem equalShape : ∀ {A B : CircleCoordinates}, + PrimitiveVectorOrientation A B → A.1 = B.1 → + (A = (0, -1) ∧ B = (0, 1)) ∨ + ∃ z : GaussianInt, + A = (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)) ∧ + B = (1, 1 + 2 * z) := by + intro A B h equal + cases h with + | base32 z => exact Or.inl ⟨rfl, rfl⟩ + | base21 z => omega + | base31 z => omega + | base10 z => exact Or.inr ⟨z, rfl, rfl⟩ + | parentChild hq j => + have strict := hq.2 j + omega + +private theorem noReverse : ∀ {A B : CircleCoordinates}, + PrimitiveVectorOrientation A B → ¬ PrimitiveVectorOrientation B A := by + intro A B first second + have forward := curvature first + have backward := curvature second + rcases equalShape first (le_antisymm forward backward) with left | left + · rcases left with ⟨leftA, leftB⟩ + rcases equalShape second (le_antisymm backward forward) with right | right + · rcases right with ⟨rightA, rightB⟩ + have bad : ((0 : ℤ), (1 : GaussianInt)) = (0, -1) := leftB.symm.trans rightA + norm_num at bad + · rcases right with ⟨z, rightA, rightB⟩ + have bad := congrArg Prod.fst (leftB.symm.trans rightA) + norm_num at bad + · rcases left with ⟨z, leftA, leftB⟩ + rcases equalShape second (le_antisymm backward forward) with right | right + · rcases right with ⟨rightA, rightB⟩ + have bad := congrArg Prod.fst (leftA.symm.trans rightB) + norm_num at bad + · rcases right with ⟨w, rightA, rightB⟩ + have e1 := congrArg Prod.snd (leftB.symm.trans rightA) + have e2 := congrArg Prod.snd (leftA.symm.trans rightB) + norm_num [Zsqrtd.ext_iff] at e1 e2 + omega + +end PrimitiveOrientation + +open PrimitiveOrientation + +theorem PrimitiveVectorOrientationUnique (C D : CircleCoordinates) : + (PrimitiveVectorOrientation C D → BandTangency C D) ∧ + (BandTangency C D → + C ≠ D ∧ + Xor (PrimitiveVectorOrientation C D) + (PrimitiveVectorOrientation D C)) := by + constructor + · intro h + cases h with + | base32 z => + exact ⟨![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), + (0, 1), (0, -1)], ⟨SemiProperQuadruple.base z, + ⟨3, 2, by decide, rfl, rfl⟩⟩⟩ + | base21 z => + exact ⟨![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), + (0, 1), (0, -1)], ⟨SemiProperQuadruple.base z, + ⟨2, 1, by decide, rfl, rfl⟩⟩⟩ + | base31 z => + exact ⟨![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), + (0, 1), (0, -1)], ⟨SemiProperQuadruple.base z, + ⟨3, 1, by decide, rfl, rfl⟩⟩⟩ + | base10 z => + exact ⟨![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), + (0, 1), (0, -1)], ⟨SemiProperQuadruple.base z, + ⟨1, 0, by decide, rfl, rfl⟩⟩⟩ + | parentChild hq j => + exact ⟨_, hq.1, j.succ, 0, by simp, rfl, rfl⟩ + · intro tangency + rcases tangency with ⟨q, hq, i, j, hij, hi, hj⟩ + have good := invariant q hq + have distinct := good.1 i j hij + have directions := good.2 i j hij + constructor + · simpa [hi, hj] using distinct + · rcases directions with forward | backward + · rw [← hi, ← hj] + exact Or.inl ⟨forward, noReverse forward⟩ + · rw [← hi, ← hj] + exact Or.inr ⟨backward, noReverse backward⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ProperBandCurvatureStructure.lean b/LeanPool/ApollonianSuperharmonic/ProperBandCurvatureStructure.lean new file mode 100644 index 0000000000..c045eb8a30 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ProperBandCurvatureStructure.lean @@ -0,0 +1,123 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification + +-- [TABLET NODE: ProperBandCurvatureStructure] + +/-! +# ProperBandCurvatureStructure + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem ProperBandCurvatureStructure (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) : + 0 < (q 0).1 ∧ + (∀ i : Fin 3, 0 ≤ (q i.succ).1) ∧ + ∀ i j : Fin 3, + (q i.succ).1 = 0 → (q j.succ).1 = 0 → i = j := by +-- BODY + have main : ∀ (r : Fin 4 → CircleCoordinates), + SemiProperQuadruple r → ProperBandQuadruple r → + 0 < (r 0).1 ∧ + (∀ i : Fin 3, 0 ≤ (r i.succ).1) ∧ + ∀ i j : Fin 3, (r i.succ).1 = 0 → (r j.succ).1 = 0 → i = j := by + intro r hs + induction hs with + | base z => + intro hp + rcases hp with ⟨_, hp⟩ + have bad := hp (0 : Fin 3) + norm_num at bad + | @rotate r hs ih => + intro hp + rcases hp with ⟨hpsemi, hpbelow⟩ + have old : ProperBandQuadruple r := by + refine ⟨hs, ?_⟩ + intro j + fin_cases j + · simpa using hpbelow 2 + · simpa using hpbelow 0 + · simpa using hpbelow 1 + have facts := ih old + rcases facts with ⟨child, nonneg, unique⟩ + constructor + · simpa using child + constructor + · intro i + fin_cases i + · simpa using nonneg 1 + · simpa using nonneg 2 + · simpa using nonneg 0 + · intro i j hi hj + fin_cases i <;> fin_cases j + · simp + · simpa using unique 1 2 hi hj + · simpa using unique 1 0 hi hj + · simpa using unique 2 1 hi hj + · simp + · simpa using unique 2 0 hi hj + · simpa using unique 0 1 hi hj + · simpa using unique 0 2 hi hj + · simp + | @successor r hs ih => + intro hp + rcases hp with ⟨hpsemi, hpbelow⟩ + have classified := SemiProperForestClassification _ hs + rcases classified with ⟨nonneg, cases⟩ + constructor + · have hbelow : (r 0).1 < + 2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1 := by + simpa using hpbelow (0 : Fin 3) + have a := nonneg (0 : Fin 4) + have b := nonneg (1 : Fin 4) + have c := nonneg (2 : Fin 4) + have d := nonneg (3 : Fin 4) + change 0 < 2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1 + omega + constructor + · intro i + fin_cases i + · exact nonneg 0 + · exact nonneg 2 + · exact nonneg 3 + · intro i j hi hj + rcases cases with root | root | root | proper + · rcases root with ⟨z, hz⟩ + have bad := hpbelow (0 : Fin 3) + simp [hz] at bad + · rcases root with ⟨z, hz⟩ + rw [hz] at hi hj + fin_cases i <;> fin_cases j <;> simp_all + · rcases root with ⟨z, hz⟩ + rw [hz] at hi hj + fin_cases i <;> fin_cases j <;> simp_all + · have old := ih proper + rcases old with ⟨child, oldnonneg, oldunique⟩ + fin_cases i <;> fin_cases j + all_goals simp? at hi hj + · omega + · omega + · omega + · omega + · exact oldunique 1 1 hi hj + · exact oldunique 1 2 hi hj + · omega + · exact oldunique 2 1 hi hj + · exact oldunique 2 2 hi hj + exact main q hq.1 hq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ProperBandQuadruple.lean b/LeanPool/ApollonianSuperharmonic/ProperBandQuadruple.lean new file mode 100644 index 0000000000..c18a0d9c9b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ProperBandQuadruple.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple + +-- [TABLET NODE: ProperBandQuadruple] + +/-! +# ProperBandQuadruple + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A semi-proper coordinate quadruple +$(C_0,C_1,C_2,C_3)$ is proper when the curvature of its child is strictly +larger than the curvature of each parent: +$$ + c_j Real), ∀ (c : Real), ∀ (x + : GaussianInt), RealFourNeighborLaplacian + (fun y => LatticeQuadraticForm A y + + dotProduct b ![(y.re : Real), (y.im : Real)] + c) x = + Matrix.trace A) := by + intro A hA b c x +-- BODY + simp [RealFourNeighborLaplacian, LatticeQuadraticForm, Matrix.mulVec, + dotProduct, Matrix.trace] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/QuadraticGrowthAtInfinity.lean b/LeanPool/ApollonianSuperharmonic/QuadraticGrowthAtInfinity.lean new file mode 100644 index 0000000000..e0b55fa98d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/QuadraticGrowthAtInfinity.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction +public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm + +-- [TABLET NODE: QuadraticGrowthAtInfinity] + +/-! +# QuadraticGrowthAtInfinity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +An integer lattice function $g$ has quadratic growth $A$ at infinity if +$$ + g(x)=q_A(x)+o(|x|^2). +$$ +Explicitly, for every $\varepsilon>0$ there is $R\in\mathbb R$ such that +whenever $|x|^2=x_1^2+x_2^2\geq R$, +$$ + |g(x)-q_A(x)|\leq\varepsilon |x|^2. +$$ +-/ +def QuadraticGrowthAtInfinity + (A : Matrix (Fin 2) (Fin 2) ℝ) (g : IntegerLatticeFunction) : Prop := +-- BODY + ∀ ε : ℝ, 0 < ε → ∃ R : ℝ, ∀ x : GaussianInt, + R ≤ (x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2 → + |(g x : ℝ) - LatticeQuadraticForm A x| ≤ + ε * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetric.lean b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetric.lean new file mode 100644 index 0000000000..d2021a7a53 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetric.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: QuarterTurnSymmetric] + +/-! +# QuarterTurnSymmetric + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A prototile $T$ has $90^\circ$ rotational symmetry when its real realization +is invariant under the quarter-turn +$$(x,y)\longmapsto(c_1-(y-c_2),c_2+(x-c_1))$$ +about its centroid $c=\operatorname{cent}(T)$. +-/ +def QuarterTurnSymmetric (T : ProtoTile) : Prop := +-- BODY + ∀ p : Real × Real, p ∈ TileRealization T ↔ + let c := TileCentroid T + (c.1 - (p.2 - c.2), c.2 + (p.1 - c.1)) ∈ TileRealization T + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean new file mode 100644 index 0000000000..c0749b3674 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean @@ -0,0 +1,268 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricOccurrence +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: QuarterTurnSymmetricCenteredTransport] + +/-! +# QuarterTurnSymmetricCenteredTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CenteredTransportLemmas + +private theorem center_mem : + ∀ (S : ProtoTile), ∀ (x : GaussianInt), x ∈ S.cells ↔ + (((x.re : Int) : Real) + (1 / 2 : Real), + ((x.im : Int) : Real) + (1 / 2 : Real)) ∈ TileRealization S := by + classical + intro S x + constructor + · intro hx + change (((x.re : Int) : Real) + (1 / 2 : Real), + ((x.im : Int) : Real) + (1 / 2 : Real)) ∈ + ⋃ y ∈ S.cells, ClosedSquareRealization y + simp only [Set.mem_iUnion] + refine ⟨x, hx, ?_⟩ + simp [ClosedSquareRealization] + norm_num + · intro hp + change (((x.re : Int) : Real) + (1 / 2 : Real), + ((x.im : Int) : Real) + (1 / 2 : Real)) ∈ + ⋃ y ∈ S.cells, ClosedSquareRealization y at hp + simp only [Set.mem_iUnion] at hp + rcases hp with ⟨y, hy, hbox⟩ + simp only [ClosedSquareRealization, Set.mem_Icc] at hbox + have re_one : (y.re : Int) < x.re + 1 := by + exact_mod_cast (show (y.re : Real) < (x.re : Real) + 1 by linarith [hbox.1.1]) + have re_two : x.re < (y.re : Int) + 1 := by + exact_mod_cast (show (x.re : Real) < (y.re : Real) + 1 by linarith [hbox.2.1]) + have im_one : (y.im : Int) < x.im + 1 := by + exact_mod_cast (show (y.im : Real) < (x.im : Real) + 1 by linarith [hbox.1.2]) + have im_two : x.im < (y.im : Int) + 1 := by + exact_mod_cast (show (x.im : Real) < (y.im : Real) + 1 by linarith [hbox.2.2]) + have re_eq : y.re = x.re := by omega + have im_eq : y.im = x.im := by omega + have xy : y = x := by + cases y + cases x + rw [Zsqrtd.ext_iff] + exact ⟨re_eq, im_eq⟩ + simpa [xy] using hy + +end CenteredTransportLemmas + +theorem QuarterTurnSymmetricCenteredTransport : ∀ (T : ProtoTile), + QuarterTurnSymmetric T → + ∃ u : GaussianInt, + GaussianRealPoint u = + ((TileCentroid T).1 + (TileCentroid T).2, + (TileCentroid T).2 - (TileCentroid T).1) ∧ + (TileTranslation (TileQuarterTurn T) u).cells = T.cells ∧ + ((T.cells = ∅) → + (TileTranslation (TileQuarterTurn T) u).anchor = T.anchor) ∧ + FootprintVertices (TileTranslation (TileQuarterTurn T) u) = + FootprintVertices T ∧ + TileCentroid (TileTranslation (TileQuarterTurn T) u) = + TileCentroid T := by +-- BODY + intro T hT + have center_mem : ∀ (S : ProtoTile) (x : GaussianInt), + x ∈ S.cells ↔ + (((x.re : Int) : Real) + (1 / 2 : Real), + ((x.im : Int) : Real) + (1 / 2 : Real)) ∈ TileRealization S := + CenteredTransportLemmas.center_mem + by_cases hempty : T.cells = ∅ + · let u : GaussianInt := + ⟨T.anchor.re + T.anchor.im, T.anchor.im - T.anchor.re⟩ + have hc : TileCentroid T = + ((((T.anchor.re : Int) : Real)), (((T.anchor.im : Int) : Real))) := by + change (if T.cells.Nonempty then _ else + ((((T.anchor.re : Int) : Real)), (((T.anchor.im : Int) : Real)))) = _ + rw [ite_eq_right] + exact Finset.not_nonempty_iff_eq_empty.mpr hempty + have hu : GaussianRealPoint u = + ((TileCentroid T).1 + (TileCentroid T).2, + (TileCentroid T).2 - (TileCentroid T).1) := by + rw [hc] + dsimp [u, GaussianRealPoint] + norm_num + have ho := QuarterTurnSymmetricOccurrence T u hT hu + have qt := TileQuarterTurnFormulas T + have tr := TileTranslationFormulas (TileQuarterTurn T) u + have hf : FootprintVertices (TileTranslation (TileQuarterTurn T) u) = + FootprintVertices T := by + simp only [FootprintVertices] + rw [ho.1, ho.2 hempty] + have hcent : TileCentroid (TileTranslation (TileQuarterTurn T) u) = + TileCentroid T := by + rw [tr.2.2.2.2.1, qt.2.2.2.2.1, hc] + dsimp [u] + norm_num + exact ⟨u, hu, ho.1, fun _ => ho.2 hempty, hf, hcent⟩ + · have hne : T.cells.Nonempty := Finset.nonempty_iff_ne_empty.mpr hempty + let real_parts := T.cells.image (fun x => x.re) + let imag_parts := T.cells.image (fun x => x.im) + have real_ne : real_parts.Nonempty := hne.image _ + have imag_ne : imag_parts.Nonempty := hne.image _ + let xmin : Int := real_parts.min' real_ne + let xmax : Int := real_parts.max' real_ne + let ymin : Int := imag_parts.min' imag_ne + let ymax : Int := imag_parts.max' imag_ne + have lower_re : ∀ p : Real × Real, p ∈ TileRealization T → + (xmin : Real) ≤ p.1 := by + intro p hp + change p ∈ ⋃ y ∈ T.cells, ClosedSquareRealization y at hp + simp only [Set.mem_iUnion] at hp + rcases hp with ⟨y, hy, hb⟩ + simp only [ClosedSquareRealization, Set.mem_Icc] at hb + have hm : xmin ≤ y.re := by + exact Finset.min'_le real_parts y.re (Finset.mem_image.mpr ⟨y, hy, rfl⟩) + exact le_trans (by simpa only [Prod.fst] using (show (xmin : Real) ≤ (y.re : Real) by + exact_mod_cast hm)) hb.1.1 + have upper_im : ∀ p : Real × Real, p ∈ TileRealization T → + p.2 ≤ (ymax : Real) + 1 := by + intro p hp + change p ∈ ⋃ y ∈ T.cells, ClosedSquareRealization y at hp + simp only [Set.mem_iUnion] at hp + rcases hp with ⟨y, hy, hb⟩ + simp only [ClosedSquareRealization, Set.mem_Icc] at hb + have hm : y.im ≤ ymax := by + exact Finset.le_max' imag_parts y.im (Finset.mem_image.mpr ⟨y, hy, rfl⟩) + have hh : (y.im : Real) ≤ (ymax : Real) := by exact_mod_cast hm + exact le_trans hb.2.2 (by linarith) + have lower_im : ∀ p : Real × Real, p ∈ TileRealization T → + (ymin : Real) ≤ p.2 := by + intro p hp + change p ∈ ⋃ y ∈ T.cells, ClosedSquareRealization y at hp + simp only [Set.mem_iUnion] at hp + rcases hp with ⟨y, hy, hb⟩ + simp only [ClosedSquareRealization, Set.mem_Icc] at hb + have hm : ymin ≤ y.im := by + exact Finset.min'_le imag_parts y.im (Finset.mem_image.mpr ⟨y, hy, rfl⟩) + exact le_trans (by simpa only [Prod.snd] using (show (ymin : Real) ≤ (y.im : Real) by + exact_mod_cast hm)) hb.1.2 + have lower_pt : ∃ p : Real × Real, p ∈ TileRealization T ∧ p.1 = (xmin : Real) := by + obtain ⟨x, hx, hxr⟩ := Finset.mem_image.mp (Finset.min'_mem real_parts real_ne) + have hxmin : xmin = x.re := by exact hxr.symm + refine ⟨((xmin : Real), (x.im : Real)), ?_, ?_⟩ + · change _ ∈ ⋃ y ∈ T.cells, ClosedSquareRealization y + simp only [Set.mem_iUnion] + refine ⟨x, hx, ?_⟩ + simp [ClosedSquareRealization, hxmin] + · rfl + have lower_pt_im : ∃ p : Real × Real, p ∈ TileRealization T ∧ p.2 = (ymin : Real) := by + obtain ⟨x, hx, hxr⟩ := Finset.mem_image.mp (Finset.min'_mem imag_parts imag_ne) + have hymin : ymin = x.im := by exact hxr.symm + refine ⟨((x.re : Real), (ymin : Real)), ?_, ?_⟩ + · change _ ∈ ⋃ y ∈ T.cells, ClosedSquareRealization y + simp only [Set.mem_iUnion] + refine ⟨x, hx, ?_⟩ + simp [ClosedSquareRealization, hymin] + · rfl + have upper_pt : ∃ p : Real × Real, p ∈ TileRealization T ∧ p.2 = (ymax : Real) + 1 := by + obtain ⟨y, hy, hyr⟩ := Finset.mem_image.mp (Finset.max'_mem imag_parts imag_ne) + have hymax : ymax = y.im := by exact hyr.symm + refine ⟨((y.re : Real), (ymax : Real) + 1), ?_, ?_⟩ + · change _ ∈ ⋃ z ∈ T.cells, ClosedSquareRealization z + simp only [Set.mem_iUnion] + refine ⟨y, hy, ?_⟩ + simp [ClosedSquareRealization, hymax] + · rfl + let c := TileCentroid T + have image_mem (p : Real × Real) (hp : p ∈ TileRealization T) : + (c.1 - (p.2 - c.2), c.2 + (p.1 - c.1)) ∈ TileRealization T := + (hT p).mp hp + have image_twice (p : Real × Real) (hp : p ∈ TileRealization T) : + (c.1 - ((c.2 + (p.1 - c.1)) - c.2), + c.2 + ((c.1 - (p.2 - c.2)) - c.1)) ∈ TileRealization T := by + exact image_mem _ (image_mem p hp) + have image_thrice (p : Real × Real) (hp : p ∈ TileRealization T) : + (c.1 - ((c.2 + ((c.1 - (p.2 - c.2)) - c.1)) - c.2), + c.2 + ((c.1 - ((c.2 + (p.1 - c.1)) - c.2)) - c.1)) ∈ TileRealization T := by + exact image_mem _ (image_twice p hp) + have image_lower (p : Real × Real) (hp : p ∈ TileRealization T) : + (xmin : Real) ≤ c.1 - (p.2 - c.2) := + lower_re _ (image_mem p hp) + have image_lower_second (p : Real × Real) (hp : p ∈ TileRealization T) : + (ymin : Real) ≤ c.2 + (p.1 - c.1) := + lower_im _ (image_mem p hp) + have first_eq : c.1 + c.2 = (xmin : Real) + (ymax : Real) + 1 := by + obtain ⟨p, hp, hpy⟩ := upper_pt + have h₁ := image_lower p hp + obtain ⟨q, hq, hqx⟩ := lower_pt + let r := (c.1 - ((c.2 + ((c.1 - (q.2 - c.2)) - c.1)) - c.2), + c.2 + ((c.1 - ((c.2 + (q.1 - c.1)) - c.2)) - c.1)) + have hr : r ∈ TileRealization T := by + exact image_thrice q hq + have h₂ := upper_im r hr + have hre : q.1 = c.1 + c.2 - r.2 := by + dsimp [r] + ring + change r.2 ≤ (ymax : Real) + 1 at h₂ + rw [hpy] at h₁ + rw [hqx] at hre + linarith + have second_eq : c.2 - c.1 = (ymin : Real) - (xmin : Real) := by + obtain ⟨p, hp, hpx⟩ := lower_pt + have h₁ := image_lower_second p hp + obtain ⟨q, hq, hqy⟩ := lower_pt_im + let r := (c.1 - ((c.2 + ((c.1 - (q.2 - c.2)) - c.1)) - c.2), + c.2 + ((c.1 - ((c.2 + (q.1 - c.1)) - c.2)) - c.1)) + have hr : r ∈ TileRealization T := by + exact image_thrice q hq + have h₂ := lower_re r hr + change (xmin : Real) ≤ r.1 at h₂ + rw [hpx] at h₁ + have hre : q.2 = c.2 - c.1 + r.1 := by + dsimp [r] + ring + rw [hqy] at hre + linarith + let u : GaussianInt := ⟨xmin + ymax + 1, ymin - xmin⟩ + have hu : GaussianRealPoint u = + ((TileCentroid T).1 + (TileCentroid T).2, + (TileCentroid T).2 - (TileCentroid T).1) := by + dsimp [u, GaussianRealPoint] + exact Prod.ext (by exact_mod_cast first_eq.symm) (by exact_mod_cast second_eq.symm) + have ho := QuarterTurnSymmetricOccurrence T u hT hu + have qt := TileQuarterTurnFormulas T + have tr := TileTranslationFormulas (TileQuarterTurn T) u + have hf : FootprintVertices (TileTranslation (TileQuarterTurn T) u) = + FootprintVertices T := by + simp only [FootprintVertices] + have hnew : (TileTranslation (TileQuarterTurn T) u).cells.Nonempty := by + rw [ho.1] + exact hne + rw [ite_eq_left hnew, ite_eq_left hne, ho.1] + have hcent : TileCentroid (TileTranslation (TileQuarterTurn T) u) = + TileCentroid T := by + rw [tr.2.2.2.2.1, qt.2.2.2.2.1] + dsimp [u] + have a := congrArg Prod.fst hu + have b := congrArg Prod.snd hu + dsimp [GaussianRealPoint] at a b + rw [Prod.ext_iff] + constructor <;> linarith + exact ⟨u, hu, ho.1, fun h => (hempty h).elim, hf, hcent⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricExactInterfaceTransport.lean b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricExactInterfaceTransport.lean new file mode 100644 index 0000000000..7ab454bd44 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricExactInterfaceTransport.lean @@ -0,0 +1,580 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: QuarterTurnSymmetricExactInterfaceTransport] + +/-! +# QuarterTurnSymmetricExactInterfaceTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace QuarterInterfaceProof + +private theorem hbaseE : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), ((TileTranslation (TileQuarterTurn T) u).cells = + T.cells) → (((TileQuarterTurn T).cells = Finset.image (fun (x : GaussianInt) => + GaussianQuarterTurn x - (1 : GaussianInt)) T.cells ∧ (TileQuarterTurn T).anchor = + GaussianQuarterTurn T.anchor ∧ ((TileQuarterTurn T).cells = ∅ ↔ T.cells = ∅) ∧ + TileRealization (TileQuarterTurn T) = (fun (p : ℝ × ℝ) => (-p.2, p.1)) '' + TileRealization T ∧ TileCentroid (TileQuarterTurn T) = (-(TileCentroid T).2, + (TileCentroid T).1) ∧ FootprintVertices (TileQuarterTurn T) = GaussianQuarterTurn '' + FootprintVertices T ∧ FootprintEdges (TileQuarterTurn T) = (fun (e : Finset + GaussianInt) => Finset.image GaussianQuarterTurn e) '' FootprintEdges T ∧ + BoundaryFootprintVertices (TileQuarterTurn T) = GaussianQuarterTurn '' + BoundaryFootprintVertices T ∧ BoundaryFootprintEdges (TileQuarterTurn T) = (fun (e : + Finset GaussianInt) => Finset.image GaussianQuarterTurn e) '' BoundaryFootprintEdges + T) → (((TileTranslation (TileQuarterTurn T) u).cells = Finset.image + (GaussianTranslation u) (TileQuarterTurn T).cells ∧ (TileTranslation (TileQuarterTurn + T) u).anchor = GaussianTranslation u (TileQuarterTurn T).anchor ∧ ((TileTranslation + (TileQuarterTurn T) u).cells = ∅ ↔ (TileQuarterTurn T).cells = ∅) ∧ TileRealization + (TileTranslation (TileQuarterTurn T) u) = (fun (p : ℝ × ℝ) => (p.1 + (↑u.re : ℝ), p.2 + + (↑u.im : ℝ))) '' TileRealization (TileQuarterTurn T) ∧ TileCentroid + (TileTranslation (TileQuarterTurn T) u) = ((TileCentroid (TileQuarterTurn T)).1 + + (↑u.re : ℝ), (TileCentroid (TileQuarterTurn T)).2 + (↑u.im : ℝ)) ∧ FootprintVertices + (TileTranslation (TileQuarterTurn T) u) = GaussianTranslation u '' FootprintVertices + (TileQuarterTurn T) ∧ FootprintEdges (TileTranslation (TileQuarterTurn T) u) = (fun + (e : Finset GaussianInt) => Finset.image (GaussianTranslation u) e) '' FootprintEdges + (TileQuarterTurn T) ∧ BoundaryFootprintVertices (TileTranslation (TileQuarterTurn T) + u) = GaussianTranslation u '' BoundaryFootprintVertices (TileQuarterTurn T) ∧ + BoundaryFootprintEdges (TileTranslation (TileQuarterTurn T) u) = (fun (e : Finset + GaussianInt) => Finset.image (GaussianTranslation u) e) '' BoundaryFootprintEdges + (TileQuarterTurn T)) → ((fun e : Finset GaussianInt => e.image (GaussianTranslation + u)) '' ((fun e : Finset GaussianInt => e.image GaussianQuarterTurn) '' FootprintEdges + T) = FootprintEdges T))) + ) := by + classical + intro T u hcell qt tu + have hedge : FootprintEdges (TileTranslation (TileQuarterTurn T) u) = + FootprintEdges T := by + simp [FootprintEdges, hcell] + have hedge' := hedge + have hqedge : FootprintEdges (TileQuarterTurn T) = + (fun e : Finset GaussianInt => e.image GaussianQuarterTurn) '' + FootprintEdges T := qt.2.2.2.2.2.2.1 + rw [tu.2.2.2.2.2.2.1, hqedge] at hedge' + exact hedge' + +private theorem vertex_cov : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), (GaussianTranslation u '' (GaussianQuarterTurn '' + FootprintVertices T) = FootprintVertices T) → (∀ (d : GaussianInt), FootprintVertices + (TileTranslation T (GaussianQuarterTurn d)) = (fun (x : GaussianInt) => + GaussianQuarterTurn x + u) '' FootprintVertices (TileTranslation T d)) + ) := by + classical + intro T u hbaseV d + have trq := TileTranslationFormulas T (GaussianQuarterTurn d) + have trd := TileTranslationFormulas T d + rw [trq.2.2.2.2.2.1, trd.2.2.2.2.2.1] + calc + GaussianTranslation (GaussianQuarterTurn d) '' FootprintVertices T = + GaussianTranslation (GaussianQuarterTurn d) '' + (GaussianTranslation u '' GaussianQuarterTurn '' FootprintVertices T) := + congrArg (fun s => GaussianTranslation (GaussianQuarterTurn d) '' s) + hbaseV.symm + _ = (fun x : GaussianInt => GaussianQuarterTurn x + u) '' + (GaussianTranslation d '' FootprintVertices T) := by + rw [Set.image_image, Set.image_image] + ext z + constructor + · rintro ⟨x, hx, rfl⟩ + refine ⟨GaussianTranslation d x, ⟨x, hx, rfl⟩, ?_⟩ + simp [GaussianTranslation, GaussianQuarterTurn, add_comm, + add_left_comm] + · rintro ⟨x, ⟨y, hy, rfl⟩, rfl⟩ + refine ⟨y, hy, ?_⟩ + simp [GaussianTranslation, GaussianQuarterTurn, add_comm, + add_left_comm] + +private theorem step_map : + (by + classical + exact + ∀ (u : GaussianInt), ∀ (r : GaussianInt), ∀ (s : GaussianInt), s = r + (1 : GaussianInt) + ∨ s = r - (1 : GaussianInt) ∨ s = r + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ s = r - ⟨(0 : ℤ), (1 : ℤ)⟩ + → GaussianQuarterTurn s + u = GaussianQuarterTurn r + u + (1 : GaussianInt) ∨ + GaussianQuarterTurn s + u = GaussianQuarterTurn r + u - (1 : GaussianInt) ∨ + GaussianQuarterTurn s + u = GaussianQuarterTurn r + u + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ + GaussianQuarterTurn s + u = GaussianQuarterTurn r + u - ⟨(0 : ℤ), (1 : ℤ)⟩ + ) := by + classical + intro u r s h + rcases h with h | h | h | h + · subst s + right; right; left + ext <;> simp [GaussianQuarterTurn, add_assoc, add_comm, add_left_comm] + · subst s + right; right; right + ext <;> simp [GaussianQuarterTurn, add_comm]; omega + · subst s + right; left + ext <;> simp [GaussianQuarterTurn, add_comm]; omega + · subst s + left + ext <;> simp [GaussianQuarterTurn, add_comm, add_left_comm]; omega + +private theorem path_map : + (by + classical + exact + ∀ (u : GaussianInt), (Function.Injective GaussianQuarterTurn) → ((Function.Injective (fun + z : GaussianInt => GaussianQuarterTurn z + u)) → ((∀ (r : GaussianInt), ∀ (s : + GaussianInt), (s = r + 1 ∨ s = r - 1 ∨ s = r + ⟨0, 1⟩ ∨ s = r - ⟨0, 1⟩) → + (GaussianQuarterTurn s + u = GaussianQuarterTurn r + u + 1 ∨ GaussianQuarterTurn s + + u = GaussianQuarterTurn r + u - 1 ∨ GaussianQuarterTurn s + u = GaussianQuarterTurn r + + u + ⟨0, 1⟩ ∨ GaussianQuarterTurn s + u = GaussianQuarterTurn r + u - ⟨0, 1⟩)) → (∀ + (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (E' : Set (Finset + GaussianInt)), ∀ (V' : Set GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), V' + = (fun z : GaussianInt => GaussianQuarterTurn z + u) '' V → E' = (fun e : Finset + GaussianInt => e.image (fun z : GaussianInt => GaussianQuarterTurn z + u)) '' E → + SimpleGridPathBetween V E x y → SimpleGridPathBetween V' E' (GaussianQuarterTurn x + + u) (GaussianQuarterTurn y + u)))) + ) := by + classical + intro u qinj finj step_map V E E' V' x y hV hE hp + rcases hp with ⟨p, hnd, hlen, hhead, hlast, hpV, hstep, hpE⟩ + refine ⟨p.map (fun z => GaussianQuarterTurn z + u), hnd.map finj, ?_, ?_, + ?_, ?_, ?_, ?_⟩ + · simpa using hlen + · rw [List.head?_map, hhead] + rfl + · rw [List.getLast?_map, hlast] + rfl + · rw [hV, hpV] + ext z + simp only [Set.mem_image, Finset.mem_coe, List.mem_toFinset, + List.mem_map] + · intro r s l₁ l₂ hm + have mappedStep : ∀ (p : List GaussianInt), + (∀ r s l₁ l₂, p = l₁ ++ r :: s :: l₂ → + s = r + 1 ∨ s = r - 1 ∨ s = r + ⟨0, 1⟩ ∨ s = r - ⟨0, 1⟩) → + ∀ r s l₁ l₂, p.map (fun z => GaussianQuarterTurn z + u) = + l₁ ++ r :: s :: l₂ → + s = r + 1 ∨ s = r - 1 ∨ s = r + ⟨0, 1⟩ ∨ s = r - ⟨0, 1⟩ := by + intro q + induction q with + | nil => + intro hh r s k m hm + cases k with + | nil => simp at hm + | cons z zs => simp at hm + | cons z q ih => + intro hh r s k m hm + cases q with + | nil => cases k <;> cases m <;> simp_all + | cons w q => + cases k with + | nil => + injection hm with hzr hrest + subst r + injection hrest with hws htail + subst s + exact step_map z w (hh z w [] q (by simp)) + | cons k ks => + simp only [List.map_cons, List.cons_append] at hm + have hz : k = GaussianQuarterTurn z + u := by + simpa using (congrArg List.head? hm).symm + subst k + apply ih + focus intro c d k m hkm + focus apply hh c d (z :: k) m + focus simp [hkm] + simpa using hm + exact mappedStep p hstep r s l₁ l₂ hm + · intro e + constructor + · rw [hE] + rintro ⟨f, hf, rfl⟩ + rcases (hpE f).mp hf with ⟨r, s, l₁, l₂, hm, he⟩ + refine ⟨GaussianQuarterTurn r + u, GaussianQuarterTurn s + u, + l₁.map (fun z => GaussianQuarterTurn z + u), + l₂.map (fun z => GaussianQuarterTurn z + u), by simp [hm], ?_⟩ + simp [he, Finset.image_insert] + · intro he + rcases he with ⟨r, s, l₁, l₂, hm, he⟩ + have hr : r ∈ p.map (fun z => GaussianQuarterTurn z + u) := by + rw [hm] + simp + have hs : s ∈ p.map (fun z => GaussianQuarterTurn z + u) := by + rw [hm] + simp + rcases List.mem_map.mp hr with ⟨c, hc, hcr⟩ + rcases List.mem_map.mp hs with ⟨d, hd, hds⟩ + have unmap : ∀ (q : List GaussianInt) (k m : List GaussianInt), + q.map (fun z => GaussianQuarterTurn z + u) = + k ++ (GaussianQuarterTurn c + u) :: + (GaussianQuarterTurn d + u) :: m → + ∃ k₀ m₀, q = k₀ ++ c :: d :: m₀ := by + intro q + induction q with + | nil => intro k m h; cases k with | nil => cases h | cons z zs => cases h + | cons z q ih => + intro k m h + cases k with + | nil => + simp? at h + rcases h with ⟨hz, hrest⟩ + have hz' : z = c := qinj hz + subst z + cases q with + | nil => simp_all + | cons w q => + simp? at hrest + have hw' : w = d := qinj hrest.1 + subst w + exact ⟨[], q, by simp []⟩ + | cons k ks => + simp only [List.map_cons, List.cons_append] at h + have hz : k = GaussianQuarterTurn z + u := by + simpa using (congrArg List.head? h).symm + subst k + have htail : List.map (fun z => GaussianQuarterTurn z + u) q = + ks ++ (GaussianQuarterTurn c + u) :: + (GaussianQuarterTurn d + u) :: m := by + exact List.cons.inj h |>.2 + rcases ih ks m htail with ⟨k₀, m₀, hq⟩ + exact ⟨z :: k₀, m₀, by simp [hq]⟩ + rw [← hcr, ← hds] at hm + have hcd := unmap p l₁ l₂ hm + rcases hcd with ⟨k, m, hpm⟩ + subst r + subst s + rw [hE] + refine ⟨({c, d} : Finset GaussianInt), + (hpE {c, d}).mpr ⟨c, d, k, m, hpm, rfl⟩, ?_⟩ + rw [he] + simp [Finset.image_insert] + +private theorem edge_cov : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), ((fun e : Finset GaussianInt => e.image + (GaussianTranslation u)) '' ((fun e : Finset GaussianInt => e.image + GaussianQuarterTurn) '' FootprintEdges T) = FootprintEdges T) → (∀ (d : GaussianInt), + FootprintEdges (TileTranslation T (GaussianQuarterTurn d)) = (fun (e : Finset + GaussianInt) => Finset.image (fun (z : GaussianInt) => GaussianQuarterTurn z + u) e) + '' FootprintEdges (TileTranslation T d)) + ) := by + classical + intro T u hbaseE d + have trq := TileTranslationFormulas T (GaussianQuarterTurn d) + have trd := TileTranslationFormulas T d + rw [trq.2.2.2.2.2.2.1, trd.2.2.2.2.2.2.1] + have hfin (e : Finset GaussianInt) : + ((e.image GaussianQuarterTurn).image (GaussianTranslation u)).image + (GaussianTranslation (GaussianQuarterTurn d)) = + (e.image (GaussianTranslation d)).image + (fun z : GaussianInt => GaussianQuarterTurn z + u) := by + ext z + simp only [Finset.mem_image] + constructor + · rintro ⟨x, ⟨y, ⟨w, hw, rfl⟩, rfl⟩, rfl⟩ + exact ⟨GaussianTranslation d w, ⟨w, hw, rfl⟩, by simp [GaussianTranslation, + GaussianQuarterTurn, + add_comm, add_left_comm]⟩ + · rintro ⟨x, ⟨y, hy, rfl⟩, rfl⟩ + exact ⟨GaussianTranslation u (GaussianQuarterTurn y), + ⟨GaussianQuarterTurn y, ⟨y, hy, rfl⟩, rfl⟩, by + simp [GaussianTranslation, GaussianQuarterTurn, + add_comm, add_left_comm]⟩ + calc + (fun e : Finset GaussianInt => e.image (GaussianTranslation (GaussianQuarterTurn d))) '' + FootprintEdges T = + (fun e : Finset GaussianInt => e.image (GaussianTranslation (GaussianQuarterTurn d))) '' + ((fun e : Finset GaussianInt => e.image (GaussianTranslation u)) '' + ((fun e : Finset GaussianInt => e.image GaussianQuarterTurn) '' FootprintEdges T)) := + congrArg (fun s => (fun e : Finset GaussianInt => + e.image (GaussianTranslation (GaussianQuarterTurn d))) '' s) hbaseE.symm + _ = (fun e : Finset GaussianInt => e.image (fun z => GaussianQuarterTurn z + u)) '' + ((fun e : Finset GaussianInt => e.image (GaussianTranslation d)) '' FootprintEdges T) := by + rw [Set.image_image, Set.image_image] + have hf : (fun e : Finset GaussianInt => + ((e.image GaussianQuarterTurn).image (GaussianTranslation u)).image + (GaussianTranslation (GaussianQuarterTurn d))) = + (fun e : Finset GaussianInt => + e.image (fun z => GaussianQuarterTurn z + u)) ∘ + (fun e : Finset GaussianInt => e.image (GaussianTranslation d)) := by + funext e + exact hfin e + rw [hf] + simp only [Function.comp_apply, Set.image_image] + +private theorem edge_zero : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), ((fun (x : Finset GaussianInt) => Finset.image + (GaussianTranslation u) (Finset.image GaussianQuarterTurn x)) '' FootprintEdges T = + FootprintEdges T) → (FootprintEdges T = (fun e : Finset GaussianInt => e.image (fun z + : GaussianInt => GaussianQuarterTurn z + u)) '' FootprintEdges T) + ) := by + classical + intro T u hbaseE' + have hf : (fun e : Finset GaussianInt => + (e.image GaussianQuarterTurn).image (GaussianTranslation u)) = + (fun e : Finset GaussianInt => + e.image (fun z : GaussianInt => GaussianQuarterTurn z + u)) := by + funext e + apply Finset.ext + intro z + simp only [Finset.mem_image] + simp [GaussianQuarterTurn, GaussianTranslation, + add_comm] + calc + FootprintEdges T = + (fun e : Finset GaussianInt => + (e.image GaussianQuarterTurn).image (GaussianTranslation u)) '' + FootprintEdges T := hbaseE'.symm + _ = _ := by rw [hf] + +private theorem ebc : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (u : GaussianInt), + (Function.Injective (fun z : GaussianInt => GaussianQuarterTurn z + u)) → ((∀ + {α : Type}, ∀ {β : Type}, ∀ (f : α → β), Function.Injective f → ∀ (A : Set α), ∀ (B : + Set α), ∀ (A' : Set β), ∀ (B' : Set β), A' = f '' A → B' = f '' B → A' ∩ B' = f '' (A + ∩ B)) → ((FootprintEdges (TileTranslation T (GaussianQuarterTurn a)) = (fun (e : + Finset GaussianInt) => Finset.image (fun (z : GaussianInt) => GaussianQuarterTurn z + + u) e) '' FootprintEdges (TileTranslation T a)) → ((FootprintEdges (TileTranslation T + (GaussianQuarterTurn b)) = (fun (e : Finset GaussianInt) => Finset.image (fun (z : + GaussianInt) => GaussianQuarterTurn z + u) e) '' FootprintEdges (TileTranslation T + b)) → (FootprintEdges (TileTranslation T (GaussianQuarterTurn a)) ∩ FootprintEdges + (TileTranslation T (GaussianQuarterTurn b)) = (fun e : Finset GaussianInt => e.image + (fun z : GaussianInt => GaussianQuarterTurn z + u)) '' (FootprintEdges + (TileTranslation T a) ∩ FootprintEdges (TileTranslation T b)))))) + ) := by + classical + intro T a b u finj intersection_map ea eb + have ffinj : Function.Injective (fun e : Finset GaussianInt => + e.image (fun z => GaussianQuarterTurn z + u)) := Finset.image_injective finj + exact intersection_map (fun e : Finset GaussianInt => + e.image (fun z => GaussianQuarterTurn z + u)) ffinj _ _ _ _ ea eb + +private theorem unique_target : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (data : + ExactTileInterfaceTriple T (TileTranslation T a) (TileTranslation T b)), ∀ (u : + GaussianInt), (FootprintVertices T ∩ FootprintVertices (TileTranslation T + (GaussianQuarterTurn a)) ∩ FootprintVertices (TileTranslation T (GaussianQuarterTurn + b)) = (fun z : GaussianInt => GaussianQuarterTurn z + u) '' (FootprintVertices T ∩ + FootprintVertices (TileTranslation T a) ∩ FootprintVertices (TileTranslation T b))) → + (∀ y, y ∈ FootprintVertices T ∩ FootprintVertices (TileTranslation T + (GaussianQuarterTurn a)) ∩ FootprintVertices (TileTranslation T (GaussianQuarterTurn + b)) ↔ y = GaussianQuarterTurn data.point + u) + ) := by + classical + intro T a b data u vtriple y + rw [vtriple] + constructor + · rintro ⟨z, hz, rfl⟩ + have hp := (data.unique_common z).mp hz + simp [hp] + · intro hy + subst y + exact ⟨data.point, (data.unique_common data.point).mpr rfl, rfl⟩ + +end QuarterInterfaceProof + +theorem QuarterTurnSymmetricExactInterfaceTransport + (T : ProtoTile) (a b : GaussianInt) + (data : ExactTileInterfaceTriple T (TileTranslation T a) + (TileTranslation T b)) + (hsym : QuarterTurnSymmetric T) : + ∃ u : GaussianInt, + GaussianRealPoint u = + ((TileCentroid T).1 + (TileCentroid T).2, + (TileCentroid T).2 - (TileCentroid T).1) ∧ + ∃ transported : ExactTileInterfaceTriple T + (TileTranslation T (GaussianQuarterTurn a)) + (TileTranslation T (GaussianQuarterTurn b)), + transported.point = GaussianQuarterTurn data.point + u ∧ + transported.otherAB = GaussianQuarterTurn data.otherAB + u ∧ + transported.otherBC = GaussianQuarterTurn data.otherBC + u ∧ + transported.otherCA = GaussianQuarterTurn data.otherCA + u := by +-- BODY + obtain ⟨u, hu, hcell, hanchor, hvert, hcent⟩ := + QuarterTurnSymmetricCenteredTransport T hsym + have qt := TileQuarterTurnFormulas T + have tu := TileTranslationFormulas (TileQuarterTurn T) u + have qinj : Function.Injective GaussianQuarterTurn := by + intro x y h + apply Zsqrtd.ext + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.im) h + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.re) h + have tinj : Function.Injective (GaussianTranslation u) := by + intro x y h + dsimp [GaussianTranslation] at h + exact add_right_cancel h + have finj : Function.Injective (fun z : GaussianInt => GaussianQuarterTurn z + u) := by + intro x y h + apply qinj + dsimp [GaussianTranslation] at h + exact add_right_cancel h + have hbaseV : GaussianTranslation u '' (GaussianQuarterTurn '' + FootprintVertices T) = FootprintVertices T := by + calc + GaussianTranslation u '' (GaussianQuarterTurn '' FootprintVertices T) = + FootprintVertices (TileTranslation (TileQuarterTurn T) u) := + by rw [← qt.2.2.2.2.2.1]; exact (tu.2.2.2.2.2.1).symm + _ = _ := hvert + have hbaseE : (fun e : Finset GaussianInt => + e.image (GaussianTranslation u)) '' + ((fun e : Finset GaussianInt => e.image GaussianQuarterTurn) '' + FootprintEdges T) = FootprintEdges T := QuarterInterfaceProof.hbaseE T u hcell qt tu + have hbaseV' := hbaseV + rw [Set.image_image] at hbaseV' + have hbaseE' := hbaseE + rw [Set.image_image] at hbaseE' + have point_map (d x : GaussianInt) : + GaussianQuarterTurn (GaussianTranslation d x) + u = + GaussianTranslation (GaussianQuarterTurn d) + (GaussianQuarterTurn x + u) := by + simp [GaussianTranslation, GaussianQuarterTurn, add_comm, + add_left_comm] + have vertex_cov (d : GaussianInt) : + FootprintVertices (TileTranslation T (GaussianQuarterTurn d)) = + (fun x : GaussianInt => GaussianQuarterTurn x + u) '' + FootprintVertices (TileTranslation T d) := QuarterInterfaceProof.vertex_cov T u hbaseV d + have step_map (r s : GaussianInt) + (h : s = r + 1 ∨ s = r - 1 ∨ s = r + ⟨0, 1⟩ ∨ + s = r - ⟨0, 1⟩) : + GaussianQuarterTurn s + u = GaussianQuarterTurn r + u + 1 ∨ + GaussianQuarterTurn s + u = GaussianQuarterTurn r + u - 1 ∨ + GaussianQuarterTurn s + u = GaussianQuarterTurn r + u + ⟨0, 1⟩ ∨ + GaussianQuarterTurn s + u = GaussianQuarterTurn r + u - ⟨0, 1⟩ := + QuarterInterfaceProof.step_map u r s h + have path_map : ∀ (V : Set GaussianInt) (E E' : Set (Finset GaussianInt)) + (V' : Set GaussianInt) (x y : GaussianInt), + V' = (fun z : GaussianInt => GaussianQuarterTurn z + u) '' V → + E' = (fun e : Finset GaussianInt => + e.image (fun z : GaussianInt => GaussianQuarterTurn z + u)) '' E → + SimpleGridPathBetween V E x y → + SimpleGridPathBetween V' E' (GaussianQuarterTurn x + u) + (GaussianQuarterTurn y + u) := QuarterInterfaceProof.path_map u qinj finj step_map + have edge_cov (d : GaussianInt) : + FootprintEdges (TileTranslation T (GaussianQuarterTurn d)) = + (fun e : Finset GaussianInt => + e.image (fun z : GaussianInt => GaussianQuarterTurn z + u)) '' + FootprintEdges (TileTranslation T d) := QuarterInterfaceProof.edge_cov T u hbaseE d + have vertex_zero : FootprintVertices T = + (fun x : GaussianInt => GaussianQuarterTurn x + u) '' + FootprintVertices T := by + simpa [GaussianQuarterTurn, GaussianTranslation] using hbaseV'.symm + have edge_zero : FootprintEdges T = + (fun e : Finset GaussianInt => + e.image (fun z : GaussianInt => GaussianQuarterTurn z + u)) '' + FootprintEdges T := QuarterInterfaceProof.edge_zero T u hbaseE' + have intersection_map : ∀ {α β : Type} (f : α → β), Function.Injective f → + ∀ (A B : Set α) (A' B' : Set β), + A' = f '' A → B' = f '' B → + A' ∩ B' = f '' (A ∩ B) := by + intro α β f hf A B A' B' hA hB + rw [hA, hB] + exact (Set.image_inter hf).symm + have v0 := vertex_zero + have va := vertex_cov a + have vb := vertex_cov b + have e0 := edge_zero + have ea := edge_cov a + have eb := edge_cov b + have vab : + FootprintVertices T ∩ FootprintVertices (TileTranslation T (GaussianQuarterTurn a)) = + (fun z : GaussianInt => GaussianQuarterTurn z + u) '' + (FootprintVertices T ∩ FootprintVertices (TileTranslation T a)) := by + exact intersection_map (fun z : GaussianInt => GaussianQuarterTurn z + u) finj _ _ _ _ v0 va + have vbc : + FootprintVertices (TileTranslation T (GaussianQuarterTurn a)) ∩ + FootprintVertices (TileTranslation T (GaussianQuarterTurn b)) = + (fun z : GaussianInt => GaussianQuarterTurn z + u) '' + (FootprintVertices (TileTranslation T a) ∩ + FootprintVertices (TileTranslation T b)) := by + exact intersection_map (fun z : GaussianInt => GaussianQuarterTurn z + u) finj _ _ _ _ va vb + have vca : + FootprintVertices (TileTranslation T (GaussianQuarterTurn b)) ∩ FootprintVertices T = + (fun z : GaussianInt => GaussianQuarterTurn z + u) '' + (FootprintVertices (TileTranslation T b) ∩ FootprintVertices T) := by + exact intersection_map (fun z : GaussianInt => GaussianQuarterTurn z + u) finj _ _ _ _ vb v0 + have eab : + FootprintEdges T ∩ FootprintEdges (TileTranslation T (GaussianQuarterTurn a)) = + (fun e : Finset GaussianInt => + e.image (fun z : GaussianInt => GaussianQuarterTurn z + u)) '' + (FootprintEdges T ∩ FootprintEdges (TileTranslation T a)) := by + have ffinj : Function.Injective (fun e : Finset GaussianInt => + e.image (fun z => GaussianQuarterTurn z + u)) := Finset.image_injective finj + exact intersection_map (fun e : Finset GaussianInt => + e.image (fun z => GaussianQuarterTurn z + u)) ffinj _ _ _ _ e0 ea + have ebc : + FootprintEdges (TileTranslation T (GaussianQuarterTurn a)) ∩ + FootprintEdges (TileTranslation T (GaussianQuarterTurn b)) = + (fun e : Finset GaussianInt => + e.image (fun z : GaussianInt => GaussianQuarterTurn z + u)) '' + (FootprintEdges (TileTranslation T a) ∩ FootprintEdges (TileTranslation T b)) := + QuarterInterfaceProof.ebc T a b u finj intersection_map ea eb + have eca : + FootprintEdges (TileTranslation T (GaussianQuarterTurn b)) ∩ FootprintEdges T = + (fun e : Finset GaussianInt => + e.image (fun z : GaussianInt => GaussianQuarterTurn z + u)) '' + (FootprintEdges (TileTranslation T b) ∩ FootprintEdges T) := by + have ffinj : Function.Injective (fun e : Finset GaussianInt => + e.image (fun z => GaussianQuarterTurn z + u)) := Finset.image_injective finj + exact intersection_map (fun e : Finset GaussianInt => + e.image (fun z => GaussianQuarterTurn z + u)) ffinj _ _ _ _ eb e0 + have pAB := path_map _ _ _ _ _ _ vab eab data.pathAB + have pBC := path_map _ _ _ _ _ _ vbc ebc data.pathBC + have pCA := path_map _ _ _ _ _ _ vca eca data.pathCA + have vtriple : + FootprintVertices T ∩ FootprintVertices (TileTranslation T (GaussianQuarterTurn a)) ∩ + FootprintVertices (TileTranslation T (GaussianQuarterTurn b)) = + (fun z : GaussianInt => GaussianQuarterTurn z + u) '' + (FootprintVertices T ∩ FootprintVertices (TileTranslation T a) ∩ + FootprintVertices (TileTranslation T b)) := by + exact intersection_map (fun z : GaussianInt => GaussianQuarterTurn z + u) finj _ _ _ _ vab vb + have unique_target : ∀ y, + y ∈ FootprintVertices T ∩ + FootprintVertices (TileTranslation T (GaussianQuarterTurn a)) ∩ + FootprintVertices (TileTranslation T (GaussianQuarterTurn b)) ↔ + y = GaussianQuarterTurn data.point + u := QuarterInterfaceProof.unique_target T a b data + u vtriple + refine ⟨u, hu, ⟨GaussianQuarterTurn data.point + u, + GaussianQuarterTurn data.otherAB + u, + GaussianQuarterTurn data.otherBC + u, + GaussianQuarterTurn data.otherCA + u, pAB, pBC, pCA, ?_⟩, rfl, rfl, rfl, rfl⟩ + exact unique_target + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricOccurrence.lean b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricOccurrence.lean new file mode 100644 index 0000000000..65f08bb2b6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricOccurrence.lean @@ -0,0 +1,176 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: QuarterTurnSymmetricOccurrence] + +/-! +# QuarterTurnSymmetricOccurrence + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem QuarterTurnSymmetricOccurrence : + ∀ (T : ProtoTile) (u : GaussianInt), + QuarterTurnSymmetric T → + GaussianRealPoint u = + ((TileCentroid T).1 + (TileCentroid T).2, + (TileCentroid T).2 - (TileCentroid T).1) → + (TileTranslation (TileQuarterTurn T) u).cells = T.cells ∧ + (T.cells = ∅ → + (TileTranslation (TileQuarterTurn T) u).anchor = T.anchor) := by +-- BODY + intro T u hT hu + have quarter := TileQuarterTurnFormulas T + have translate := TileTranslationFormulas (TileQuarterTurn T) u + have coordinate_re : (u.re : Real) = (TileCentroid T).1 + (TileCentroid T).2 := by + have h := congrArg Prod.fst hu + simpa [GaussianRealPoint] using h + have coordinate_im : (u.im : Real) = (TileCentroid T).2 - (TileCentroid T).1 := by + have h := congrArg Prod.snd hu + simpa [GaussianRealPoint] using h + have realization_same : + TileRealization (TileTranslation (TileQuarterTurn T) u) = + TileRealization T := by + let rotate : (Real × Real) → (Real × Real) := fun p => + ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), + (TileCentroid T).2 + (p.1 - (TileCentroid T).1)) + have rotate_mem : ∀ p : Real × Real, + p ∈ TileRealization T ↔ rotate p ∈ TileRealization T := by + intro p + exact hT p + have rotate_four : ∀ p : Real × Real, rotate (rotate (rotate (rotate p))) = p := by + intro p + dsimp [rotate] + congr 1 <;> ring + rw [translate.2.2.2.1, quarter.2.2.2.1] + have map_formula : ∀ p : Real × Real, + (fun q : Real × Real => (q.1 + (u.re : Real), q.2 + (u.im : Real))) + (-p.2, p.1) = rotate p := by + intro p + dsimp [rotate] + rw [coordinate_re, coordinate_im] + congr 1 <;> ring + have image_formula : + (fun q : Real × Real => (q.1 + (u.re : Real), q.2 + (u.im : Real))) '' + ((fun p : Real × Real => (-p.2, p.1)) '' TileRealization T) = + rotate '' TileRealization T := by + ext p + simp only [Set.mem_image] + constructor + · rintro ⟨q, ⟨r, hr, rfl⟩, rfl⟩ + exact ⟨r, hr, (map_formula r).symm⟩ + · rintro ⟨r, hr, rfl⟩ + exact ⟨(-r.2, r.1), ⟨r, hr, rfl⟩, map_formula r⟩ + rw [image_formula] + ext p + simp only [Set.mem_image] + constructor + · rintro ⟨q, hq, rfl⟩ + exact (rotate_mem q).mp hq + · intro hp + refine ⟨rotate (rotate (rotate p)), ?_, ?_⟩ + · exact (rotate_mem (rotate (rotate p))).mp + ((rotate_mem (rotate p)).mp ((rotate_mem p).mp hp)) + · rw [rotate_four] + have center_mem : ∀ (S : ProtoTile) (x : GaussianInt), + x ∈ S.cells ↔ + (((x.re : Int) : Real) + (1 / 2 : Real), + ((x.im : Int) : Real) + (1 / 2 : Real)) ∈ TileRealization S := by + intro S x + constructor + · intro hx + change (((x.re : Int) : Real) + (1 / 2 : Real), + ((x.im : Int) : Real) + (1 / 2 : Real)) ∈ + ⋃ y ∈ S.cells, ClosedSquareRealization y + simp only [Set.mem_iUnion] + refine ⟨x, hx, ?_⟩ + simp [ClosedSquareRealization] + norm_num + · intro hp + change (((x.re : Int) : Real) + (1 / 2 : Real), + ((x.im : Int) : Real) + (1 / 2 : Real)) ∈ + ⋃ y ∈ S.cells, ClosedSquareRealization y at hp + simp only [Set.mem_iUnion] at hp + rcases hp with ⟨y, hy, hbox⟩ + simp only [ClosedSquareRealization, Set.mem_Icc] at hbox + have re_lower : (y.re : Real) ≤ (x.re : Real) + (1 / 2 : Real) := hbox.1.1 + have re_upper : (x.re : Real) + (1 / 2 : Real) ≤ (y.re : Real) + 1 := hbox.2.1 + have im_lower : (y.im : Real) ≤ (x.im : Real) + (1 / 2 : Real) := hbox.1.2 + have im_upper : (x.im : Real) + (1 / 2 : Real) ≤ (y.im : Real) + 1 := hbox.2.2 + have re_one : (y.re : Int) < x.re + 1 := by + exact_mod_cast (show (y.re : Real) < (x.re : Real) + 1 by linarith) + have re_two : x.re < (y.re : Int) + 1 := by + exact_mod_cast (show (x.re : Real) < (y.re : Real) + 1 by linarith) + have im_one : (y.im : Int) < x.im + 1 := by + exact_mod_cast (show (y.im : Real) < (x.im : Real) + 1 by linarith) + have im_two : x.im < (y.im : Int) + 1 := by + exact_mod_cast (show (x.im : Real) < (y.im : Real) + 1 by linarith) + have re_eq : y.re = x.re := by omega + have im_eq : y.im = x.im := by omega + have xy : y = x := by + cases y + cases x + rw [Zsqrtd.ext_iff] + exact ⟨re_eq, im_eq⟩ + simpa [xy] using hy + constructor + · have cell_formula := translate.1 + rw [cell_formula, quarter.1] + apply Finset.ext + intro x + constructor + · intro hx + change x ∈ (TileTranslation (TileQuarterTurn T) u).cells at hx + have hxcenter := (center_mem (TileTranslation (TileQuarterTurn T) u) x).mp hx + have hnew : + (((x.re : Int) : Real) + (1 / 2 : Real), + ((x.im : Int) : Real) + (1 / 2 : Real)) ∈ TileRealization T := by + rw [← realization_same] + exact hxcenter + exact (center_mem T x).mpr hnew + · intro hx + have hxcenter := (center_mem T x).mp hx + have hnew : + (((x.re : Int) : Real) + (1 / 2 : Real), + ((x.im : Int) : Real) + (1 / 2 : Real)) ∈ + TileRealization (TileTranslation (TileQuarterTurn T) u) := by + rw [realization_same] + exact hxcenter + exact (center_mem (TileTranslation (TileQuarterTurn T) u) x).mpr hnew + · intro hempty + rw [translate.2.1, quarter.2.1] + dsimp [GaussianTranslation, GaussianQuarterTurn] + have hcentroid : TileCentroid T = + ((((T.anchor.re : Int) : Real)), (((T.anchor.im : Int) : Real))) := by + change (if T.cells.Nonempty then _ else + ((((T.anchor.re : Int) : Real)), (((T.anchor.im : Int) : Real)))) = _ + rw [ite_eq_right] + exact Finset.not_nonempty_iff_eq_empty.mpr hempty + rw [hcentroid] at coordinate_re coordinate_im + rw [Zsqrtd.ext_iff] + dsimp at coordinate_re coordinate_im ⊢ + have re_relation : u.re = T.anchor.re + T.anchor.im := by + exact_mod_cast coordinate_re + have im_relation : u.im = T.anchor.im - T.anchor.re := by + exact_mod_cast coordinate_im + constructor + · omega + · omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/RealFourNeighborLaplacian.lean b/LeanPool/ApollonianSuperharmonic/RealFourNeighborLaplacian.lean new file mode 100644 index 0000000000..5707816cec --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/RealFourNeighborLaplacian.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: RealFourNeighborLaplacian] + +/-! +# RealFourNeighborLaplacian + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a real-valued function $u:\mathbb Z[i]\to\mathbb R$, define its +four-neighbor Laplacian by +$$ + \Delta_{\mathbb R}u(x)=u(x+1)+u(x-1)+u(x+i)+u(x-i)-4u(x). +$$ +-/ +def RealFourNeighborLaplacian (f : GaussianInt -> Real) + (x : GaussianInt) : Real := +-- BODY + f (x + 1) + f (x - 1) + f (x + ⟨0, 1⟩) + f (x - ⟨0, 1⟩) - 4 * f x + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/RealLaplacianContactComparison.lean b/LeanPool/ApollonianSuperharmonic/RealLaplacianContactComparison.lean new file mode 100644 index 0000000000..e6cf5ea7d3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/RealLaplacianContactComparison.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.RealFourNeighborLaplacian + +-- [TABLET NODE: RealLaplacianContactComparison] + +/-! +# RealLaplacianContactComparison + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem RealLaplacianContactComparison : + (forall (u v : GaussianInt -> Real) (x : GaussianInt), + u x = v x -> + (forall y, y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ + y = x - ⟨0, 1⟩ -> u y <= v y) -> + RealFourNeighborLaplacian u x <= RealFourNeighborLaplacian v x) /\ + (forall (F : Nat -> GaussianInt -> Real) (g : GaussianInt -> Real) + (M : Real) (x : GaussianInt), + (forall i, RealFourNeighborLaplacian (F i) x <= M) -> + (exists i, g x = F i x /\ + forall y, y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ + y = x - ⟨0, 1⟩ -> g y <= F i y) -> + RealFourNeighborLaplacian g x <= M) /\ + (forall (F : Nat -> GaussianInt -> Real) (g : GaussianInt -> Real) + (M : Real) (x : GaussianInt), + (forall i, M <= RealFourNeighborLaplacian (F i) x) -> + (exists i, g x = F i x /\ + forall y, y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ + y = x - ⟨0, 1⟩ -> F i y <= g y) -> + M <= RealFourNeighborLaplacian g x) := by +-- BODY + constructor + · intro u v x hcenter hneighbors + unfold RealFourNeighborLaplacian + have hright := hneighbors (x + 1) (Or.inl rfl) + have hleft := hneighbors (x - 1) (Or.inr (Or.inl rfl)) + have hup := hneighbors (x + ⟨0, 1⟩) (Or.inr (Or.inr (Or.inl rfl))) + have hdown := hneighbors (x - ⟨0, 1⟩) (Or.inr (Or.inr (Or.inr rfl))) + linarith + constructor + · intro F g M x hbound hattained + obtain ⟨i, hvalue, hcontact⟩ := hattained + have hcomparison := (show + RealFourNeighborLaplacian g x <= RealFourNeighborLaplacian (F i) x from + (by + unfold RealFourNeighborLaplacian + have hright := hcontact (x + 1) (Or.inl rfl) + have hleft := hcontact (x - 1) (Or.inr (Or.inl rfl)) + have hup := hcontact (x + ⟨0, 1⟩) (Or.inr (Or.inr (Or.inl rfl))) + have hdown := hcontact (x - ⟨0, 1⟩) (Or.inr (Or.inr (Or.inr rfl))) + linarith)) + linarith [hbound i] + · intro F g M x hbound hattained + obtain ⟨i, hvalue, hcontact⟩ := hattained + have hcomparison := (show + RealFourNeighborLaplacian (F i) x <= RealFourNeighborLaplacian g x from + (by + unfold RealFourNeighborLaplacian + have hright := hcontact (x + 1) (Or.inl rfl) + have hleft := hcontact (x - 1) (Or.inr (Or.inl rfl)) + have hup := hcontact (x + ⟨0, 1⟩) (Or.inr (Or.inr (Or.inl rfl))) + have hdown := hcontact (x - ⟨0, 1⟩) (Or.inr (Or.inr (Or.inr rfl))) + linarith [hvalue])) + linarith [hbound i] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/RealLaplacianLinearity.lean b/LeanPool/ApollonianSuperharmonic/RealLaplacianLinearity.lean new file mode 100644 index 0000000000..2b05b1633e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/RealLaplacianLinearity.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.RealFourNeighborLaplacian + +-- [TABLET NODE: RealLaplacianLinearity] + +/-! +# RealLaplacianLinearity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem RealLaplacianLinearity (u v : GaussianInt -> Real) (a b : Real) + (x : GaussianInt) : + RealFourNeighborLaplacian (fun y => a * u y + b * v y) x = + a * RealFourNeighborLaplacian u x + + b * RealFourNeighborLaplacian v x := by +-- BODY + simp [RealFourNeighborLaplacian] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean b/LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean new file mode 100644 index 0000000000..756797f379 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandTangency +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation + +-- [TABLET NODE: RecursiveVectorSystem] + +/-! +# RecursiveVectorSystem + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A recursive vector system is a pair of functions +$v(C,C'),a(C,C')\in\mathbb Z[i]$ on ordered pairs of raw curvature +coordinates. Both functions vanish away from band-tangent pairs. On the +clockwise base quadruple +$((1,1+2z),(1,1+2z+2i),(0,1),(0,-1))$ their three clockwise values are +$$ +(v_{32},v_{21},v_{13})=(0,-1,1),\qquad +(a_{32},a_{21},a_{13})=(1,-1-z-i,z+i). +$$ +For every semi-proper quadruple the successor values are prescribed by +$$ +\begin{aligned} +v_{20}&=v_{21}-iv_{32},&v_{03}&=v_{13}+iv_{32},\\ +a_{20}&=a_{21}+ia_{32},&a_{03}&=a_{13}-ia_{32}. +\end{aligned} +\end{aligned} +$$ +These are exactly the recursion rules of equation (4.2), and parent +rotations provide the other cases. Finally, only when $C\to D$ is the +canonical orientation of \operatorname{PrimitiveVectorOrientation}, the opposite +ordered value is prescribed once by +$$ + v(D,C)=iv(C,D),\qquad a(D,C)=-ia(C,D). +$$ +The uniqueness theorem for the primitive orientation ensures that this rule +is never imposed again in the reverse direction. +-/ +def RecursiveVectorSystem + (s : (CircleCoordinates → CircleCoordinates → GaussianInt) × + (CircleCoordinates → CircleCoordinates → GaussianInt)) : Prop := +-- BODY + let v := s.1 + let a := s.2 + let ii : GaussianInt := ⟨0, 1⟩ + (∀ C D, ¬ BandTangency C D → v C D = 0 ∧ a C D = 0) ∧ + (∀ z : GaussianInt, + let q : Fin 4 → CircleCoordinates := + ![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ii), (0, 1), (0, -1)] + v (q 3) (q 2) = 0 ∧ v (q 2) (q 1) = -1 ∧ v (q 1) (q 3) = 1 ∧ + a (q 3) (q 2) = 1 ∧ a (q 2) (q 1) = -1 - z - ii ∧ + a (q 1) (q 3) = z + ii) ∧ + (∀ q : Fin 4 → CircleCoordinates, SemiProperQuadruple q → + v (q 2) (q 0) = v (q 2) (q 1) - ii * v (q 3) (q 2) ∧ + v (q 0) (q 3) = v (q 1) (q 3) + ii * v (q 3) (q 2) ∧ + a (q 2) (q 0) = a (q 2) (q 1) + ii * a (q 3) (q 2) ∧ + a (q 0) (q 3) = a (q 1) (q 3) - ii * a (q 3) (q 2)) ∧ + (∀ C D : CircleCoordinates, PrimitiveVectorOrientation C D → + v D C = ii * v C D ∧ a D C = -ii * a C D) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/RecursiveVectorsExistUnique.lean b/LeanPool/ApollonianSuperharmonic/RecursiveVectorsExistUnique.lean new file mode 100644 index 0000000000..f8038e14b7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/RecursiveVectorsExistUnique.lean @@ -0,0 +1,207 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandTangency +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import LeanPool.ApollonianSuperharmonic.P4981T1PrescriptionCoherence +public import LeanPool.ApollonianSuperharmonic.P4981T1PrescriptionLocality +public import LeanPool.ApollonianSuperharmonic.P4981T1ProperEquations +public import LeanPool.ApollonianSuperharmonic.P4981T1RootEquations + +-- [TABLET NODE: RecursiveVectorsExistUnique] + +/-! +# RecursiveVectorsExistUnique + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem RecursiveVectorsExistUnique : + ∃! s : (CircleCoordinates → CircleCoordinates → GaussianInt) × + (CircleCoordinates → CircleCoordinates → GaussianInt), + RecursiveVectorSystem s := by +-- BODY + classical + let E := CircleCoordinates × CircleCoordinates + let V := GaussianInt × GaussianInt + let rank : E → ℕ := P4981T1EdgeRank + let ii : GaussianInt := ⟨0, 1⟩ + let turn : V → V := fun x => (ii * x.1, -ii * x.2) + have source : ∀ {C D}, PrimitiveVectorOrientation C D → + Nonempty (P4981T1EdgePrescription (C, D)) := by + intro C D h + cases h with + | base32 z => exact ⟨.line⟩ + | base21 z => exact ⟨.left z⟩ + | base31 z => exact ⟨.right z⟩ + | base10 z => exact ⟨.unit z⟩ + | parentChild hq j => exact ⟨.proper _ hq j⟩ + have oriented : ∀ {e : E}, P4981T1EdgePrescription e → + PrimitiveVectorOrientation e.1 e.2 := by + intro e p + cases p with + | line => exact .base32 0 + | left z => exact .base21 z + | right z => exact .base31 z + | unit z => exact .base10 z + | proper q hq j => exact .parentChild hq j + let choose := fun C D (h : PrimitiveVectorOrientation C D) => + Classical.choice (source h) + have rank_swap (C D : CircleCoordinates) : rank (D, C) = rank (C, D) := by + simp only [rank, P4981T1EdgeRank, max_comm] + have noReverse {C D} (h : PrimitiveVectorOrientation C D) : + ¬ PrimitiveVectorOrientation D C := by + rcases ((PrimitiveVectorOrientationUnique C D).2 + ((PrimitiveVectorOrientationUnique C D).1 h)).2 with h' | h' + · exact h'.2 + · exact (h'.2 h).elim + have tangent_symm {C D} (h : BandTangency D C) : BandTangency C D := by + rcases h with ⟨q, hq, i, j, hij, hi, hj⟩ + exact ⟨q, hq, j, i, Ne.symm hij, hj, hi⟩ + -- Recursion calls only lower-rank ordered edges. A reverse is evaluated + -- from the same primitive prescription, never by a same-rank call. + let step : (e : E) → (∀ d : E, rank d < rank e → V) → V := fun e rec => + let low : E → V := fun d => if h : rank d < rank e then rec d h else (0, 0) + if h : PrimitiveVectorOrientation e.1 e.2 then + P4981T1PrescriptionValue (choose e.1 e.2 h) low + else if h : PrimitiveVectorOrientation e.2 e.1 then + turn (P4981T1PrescriptionValue (choose e.2 e.1 h) low) + else (0, 0) + let F : E → V := (measure rank).wf.fix step + have unfoldF (e : E) : F e = step e (fun d _ => F d) := + (measure rank).wf.fix_eq step e + have table {e : E} (p : P4981T1EdgePrescription e) : + F e = P4981T1PrescriptionValue p F := by + rw [unfoldF] + dsimp only [step] + rw [dite_eq_left (oriented p)] + trans P4981T1PrescriptionValue p + (fun d => if _h : rank d < rank e then F d else (0, 0)) + · exact P4981T1PrescriptionCoherence _ p _ + · apply P4981T1PrescriptionLocality + intro d hd + exact dite_eq_left hd + have rev (C D : CircleCoordinates) (h : PrimitiveVectorOrientation C D) : + F (D, C) = turn (F (C, D)) := by + rw [unfoldF] + dsimp only [step] + rw [dite_eq_right (noReverse h), dite_eq_left h] + congr 1 + trans P4981T1PrescriptionValue (choose C D h) F + · apply P4981T1PrescriptionLocality + intro d hd + exact dite_eq_left (by simpa only [rank_swap] using hd) + · exact (table _).symm + have zero (C D : CircleCoordinates) (h : ¬ BandTangency C D) : + F (C, D) = (0, 0) := by + have hn : ¬ PrimitiveVectorOrientation C D := + fun hp => h ((PrimitiveVectorOrientationUnique C D).1 hp) + have hn' : ¬ PrimitiveVectorOrientation D C := + fun hp => h (tangent_symm ((PrimitiveVectorOrientationUnique D C).1 hp)) + rw [unfoldF] + dsimp only [step] + rw [dite_eq_right hn, dite_eq_right hn'] + have root := (P4981T1RootEquations F rev).mpr + ⟨table .line, fun z => ⟨table (.left z), table (.right z), table (.unit z)⟩⟩ + have proper := (P4981T1ProperEquations F rev).mp + (fun q hq j => table (.proper q hq j)) + refine ⟨(fun C D => (F (C, D)).1, fun C D => (F (C, D)).2), ?_, ?_⟩ + · refine ⟨?_, root.1, ?_, ?_⟩ + · intro C D h + exact ⟨congrArg Prod.fst (zero C D h), congrArg Prod.snd (zero C D h)⟩ + · intro q hq + change P4981T1Recursion F q + rcases (SemiProperForestClassification q hq).2 with h | h | h | h + · obtain ⟨z, rfl⟩ := h + exact root.2 z 0 + · obtain ⟨z, rfl⟩ := h + exact root.2 z 1 + · obtain ⟨z, rfl⟩ := h + exact root.2 z 2 + · exact proper q h + · intro C D h + exact ⟨congrArg Prod.fst (rev C D h), congrArg Prod.snd (rev C D h)⟩ + · intro t ht + rcases ht with ⟨hz, hb, hr, hv⟩ + let G : E → V := fun e => (t.1 e.1 e.2, t.2 e.1 e.2) + have Grev (C D : CircleCoordinates) (h : PrimitiveVectorOrientation C D) : + G (D, C) = turn (G (C, D)) := + Prod.ext (hv C D h).1 (hv C D h).2 + have Groot := (P4981T1RootEquations G Grev).mp + ⟨hb, by + intro z r + dsimp only [P4981T1Recursion, G] + apply hr + fin_cases r + · convert SemiProperQuadruple.base z using 1 + funext k + fin_cases k <;> rfl + · convert SemiProperQuadruple.rotate (SemiProperQuadruple.base z) using 1 + funext k + fin_cases k <;> rfl + · convert SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate (SemiProperQuadruple.base z)) using 1 + funext k + fin_cases k <;> rfl⟩ + have Gproper := (P4981T1ProperEquations G Grev).mpr + (fun q hq => hr q hq.1) + have Gtable {e : E} (p : P4981T1EdgePrescription e) : + G e = P4981T1PrescriptionValue p G := by + cases p with + | line => exact Groot.1 + | left z => exact (Groot.2 z).1 + | right z => exact (Groot.2 z).2.1 + | unit z => exact (Groot.2 z).2.2 + | proper q hq j => exact Gproper q hq j + have equal : ∀ e, G e = F e := by + intro e + induction e using (measure rank).wf.induction with + | h e ih => + by_cases hp : PrimitiveVectorOrientation e.1 e.2 + · rw [Gtable (choose _ _ hp), table (choose _ _ hp)] + exact P4981T1PrescriptionLocality _ G F ih + · by_cases hp' : PrimitiveVectorOrientation e.2 e.1 + · have primitive : G (e.2, e.1) = F (e.2, e.1) := by + rw [Gtable (choose _ _ hp'), table (choose _ _ hp')] + apply P4981T1PrescriptionLocality + intro d hd + apply ih d + change rank d < rank (e.1, e.2) + change rank d < rank (e.2, e.1) at hd + rwa [rank_swap e.1 e.2] at hd + change G (e.1, e.2) = F (e.1, e.2) + rw [Grev _ _ hp', rev _ _ hp', primitive] + · have hn : ¬ BandTangency e.1 e.2 := by + intro ht + rcases ((PrimitiveVectorOrientationUnique e.1 e.2).2 ht).2 with h | h + · exact hp h.1 + · exact hp' h.1 + rw [zero _ _ hn] + exact Prod.ext (hz _ _ hn).1 (hz _ _ hn).2 + apply Prod.ext + · funext C D + exact congrArg Prod.fst (equal (C, D)) + · funext C D + exact congrArg Prod.snd (equal (C, D)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/RegularTileFamily.lean b/LeanPool/ApollonianSuperharmonic/RegularTileFamily.lean new file mode 100644 index 0000000000..80c96f0940 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/RegularTileFamily.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileTranslation + +-- [TABLET NODE: RegularTileFamily] + +/-! +# RegularTileFamily + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a prototile $T$ and an additive lattice $L\subseteq\mathbb Z[i]$, the +regular translate family $T+L$ is the collection $\{T+u:u\in L\}$. +-/ +def RegularTileFamily (T : ProtoTile) (L : AddSubgroup GaussianInt) : + Set ProtoTile := +-- BODY + {U | ∃ u ∈ L, U = TileTranslation T u} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/RegularTileFamilyTranslationUnique.lean b/LeanPool/ApollonianSuperharmonic/RegularTileFamilyTranslationUnique.lean new file mode 100644 index 0000000000..9974390fea --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/RegularTileFamilyTranslationUnique.lean @@ -0,0 +1,49 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.RegularTileFamily +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: RegularTileFamilyTranslationUnique] + +/-! +# RegularTileFamilyTranslationUnique + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem RegularTileFamilyTranslationUnique (T : ProtoTile) + (L : AddSubgroup GaussianInt) (U : ProtoTile) + (hU : U ∈ RegularTileFamily T L) : + ∃! u : L, U = TileTranslation T (u : GaussianInt) := by +-- BODY + rcases hU with ⟨u, huL, rfl⟩ + refine ⟨⟨u, huL⟩, rfl, ?_⟩ + intro v hv + apply Subtype.ext + have hc := congrArg TileCentroid hv + rw [(TileTranslationFormulas T v).2.2.2.2.1, + (TileTranslationFormulas T u).2.2.2.2.1] at hc + have hre := congrArg Prod.fst hc + have him := congrArg Prod.snd hc + dsimp at hre him + have hre' : (((v.1.re : Int) : Real)) = (((u.re : Int) : Real)) := by + linarith + have him' : (((v.1.im : Int) : Real)) = (((u.im : Int) : Real)) := by + linarith + apply Zsqrtd.ext + · exact_mod_cast hre' + · exact_mod_cast him' + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacent.lean b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacent.lean new file mode 100644 index 0000000000..24a80d1b55 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacent.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileOdometer + +-- [TABLET NODE: RightLatticeAdjacent] + +/-! +# RightLatticeAdjacent + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Two nondegenerate tile odometers $h,h'$ for the same positive-curvature +circle $C_0$ are right-lattice adjacent when both slopes are defined and, +for some parent $C_i$ in a proper quadruple with child $C_0$, one has with +matching signs +$$ + \operatorname{cent}(T(h'))-\operatorname{cent}(T(h))=\pm v_{0i}, + \qquad + \operatorname{slope}(h')-\operatorname{slope}(h)=\pm a_{0i}. +$$ +There is no special right-adjacency convention for unit circles. +-/ +def RightLatticeAdjacent (C : BandCircle) (T T' : ProtoTile) + (h h' : PartialOdometer) : Prop := +-- BODY + TileOdometer C.1.1 T h ∧ TileOdometer C.1.1 T' h' ∧ + ∃ p p' : ℝ × ℝ, + PartialOdometerSlope h = some p ∧ + PartialOdometerSlope h' = some p' ∧ + ∃ q : Fin 4 → CircleCoordinates, ∃ i : Fin 3, ∃ e : Bool, + ProperBandQuadruple q ∧ q 0 = C.1.1 ∧ + TileCentroid T' - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) ∧ + p'.1 - p.1 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q 0) (q i.succ)).re ∧ + p'.2 - p.2 = (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q 0) (q i.succ)).im + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean new file mode 100644 index 0000000000..8bf00e635e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean @@ -0,0 +1,1085 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: RightLatticeAdjacentPackingSymmetryTransport] + +/-! +# RightLatticeAdjacentPackingSymmetryTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RightLatticeTransportGeometry + +private theorem hTne : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (T : ProtoTile), ∀ (h : + PartialOdometer), ∀ (p : ℝ × ℝ), (TileOdometer (q (0 : Fin (4 : ℕ))) T h) → + ((PartialOdometerSlope h = some p) → (T.cells.Nonempty))) ) := by + classical + intro q hq T h p hO hp + have hd := PositiveCurvatureTileOdometerDomain (q 0) T h + (ProperBandCurvatureStructure q hq).1 hO + by_contra hn + have hde : (h.domain : Set GaussianInt) = {T.anchor} := by + rw [hd] + simp [FootprintVertices, hn] + have hs : (PartialOdometerSquares h).Nonempty := by + by_contra hs + simp [PartialOdometerSlope, hs] at hp + rcases hs with ⟨x, hx⟩ + simp only [PartialOdometerSquares, Finset.mem_filter] at hx + have hz : x + 1 = T.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.2.1 + have hz0 : x = T.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.1 + have hzbad : x + 1 = x := hz.trans hz0.symm + have hzbad' := congrArg (fun z : GaussianInt => z.re) hzbad + norm_num at hzbad' + +private theorem hT'ne : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (T' : ProtoTile), ∀ (h' : + PartialOdometer), ∀ (p' : ℝ × ℝ), (TileOdometer (q (0 : Fin (4 : ℕ))) T' h') → + ((PartialOdometerSlope h' = some p') → (T'.cells.Nonempty))) ) := by + classical + intro q hq T' h' p' hO' hp' + have hd := PositiveCurvatureTileOdometerDomain (q 0) T' h' + (ProperBandCurvatureStructure q hq).1 hO' + by_contra hn + have hde : (h'.domain : Set GaussianInt) = {T'.anchor} := by + rw [hd] + simp [FootprintVertices, hn] + have hs : (PartialOdometerSquares h').Nonempty := by + by_contra hs + simp [PartialOdometerSlope, hs] at hp' + rcases hs with ⟨x, hx⟩ + simp only [PartialOdometerSquares, Finset.mem_filter] at hx + have hz : x + 1 = T'.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.2.1 + have hz0 : x = T'.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.1 + have hzbad : x + 1 = x := hz.trans hz0.symm + have hzbad' := congrArg (fun z : GaussianInt => z.re) hzbad + norm_num at hzbad' + +private theorem hsr : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (p : ℝ × ℝ), + (PartialOdometerSlope h = some p) → ((T.cells.Nonempty) → ((Finset.Nonempty T.cells → + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = Option.map + (BandPackingSymmetrySlopeAction g T) (PartialOdometerSlope h)) → + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = some + (BandPackingSymmetrySlopeAction g T p)))) ) := by + classical + intro g T h p hp hTne hST + simpa [Option.map] using (hST hTne).trans (congrArg (Option.map + (BandPackingSymmetrySlopeAction g T)) hp) + +private theorem hsr' : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), ∀ (p' : ℝ × + ℝ), (PartialOdometerSlope h' = some p') → ((T'.cells.Nonempty) → ((Finset.Nonempty + T'.cells → PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h') = + Option.map (BandPackingSymmetrySlopeAction g T') (PartialOdometerSlope h')) → + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h') = some + (BandPackingSymmetrySlopeAction g T' p')))) ) := by + classical + intro g T' h' p' hp' hT'ne hST' + simpa [Option.map] using (hST' hT'ne).trans (congrArg (Option.map + (BandPackingSymmetrySlopeAction g T')) hp') + +private theorem centroid_transport : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (v : GaussianInt), + TileCentroid V - TileCentroid U = GaussianRealPoint v → TileCentroid + (BandPackingSymmetryTileAction a V) - TileCentroid (BandPackingSymmetryTileAction a + U) = GaussianRealPoint (BandPackingSymmetryVectorAction a v) ) := by + classical + intro a U V v hv + have hc := (P5625T1CentroidSlopeDifferenceCovariance.2 + a U V (0, 0) (0, 0) v 0 1 + (by simpa using hv) (by ext <;> simp [GaussianRealPoint])).1 + simpa only [one_smul, P5625T1CentroidSlopeDifferenceCovariance.1] using hc + +private theorem vector_signAt246 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), + (BandPackingSymmetryScopedPhase g q negative) → (∀ (j : Fin 3), GaussianRealPoint + (BandPackingSymmetryVectorAction g (BandVectors.1 (q j.succ) (q 0))) = (if negative + then (-1 : ℝ) else 1) • GaussianRealPoint (BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + then -j else j).succ) (BandPackingSymmetryQuadrupleAction g q 0))) ) := by + classical + intro g q negative hphase j + have hp := hphase j + dsimp [BandPackingSymmetryScopedPhase] at hp + have hv := hp.1 + by_cases hn : negative + · have hh := congrArg Neg.neg (congrArg GaussianRealPoint hv) + simpa [hn, GaussianRealPoint] using hh.symm + · have hh := (congrArg GaussianRealPoint hv).symm + simpa [hn, GaussianRealPoint] using hh + +private theorem vector_neg : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (v : GaussianInt), BandPackingSymmetryVectorAction a (-v) + = -BandPackingSymmetryVectorAction a v ) := by + classical + intro a + induction a with + | identity => intro v; rfl + | negate => + intro v + rcases v with ⟨a, b⟩ + rfl + | conjugate => + intro v + rcases v with ⟨a, b⟩ + rfl + | shift w => intro v; rfl + | comp a b iha ihb => + intro v + change BandPackingSymmetryVectorAction a + (BandPackingSymmetryVectorAction b (-v)) = + -BandPackingSymmetryVectorAction a + (BandPackingSymmetryVectorAction b v) + rw [ihb, iha] + +private theorem affine_neg : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (v : GaussianInt), ∀ (u : GaussianInt), + BandPackingSymmetryAffineVectorAction a (-v, -u) = + -BandPackingSymmetryAffineVectorAction a (v, u) ) := by + classical + intro a + induction a with + | identity => intro v u; rfl + | shift w => + intro v u + rcases v with ⟨va, vb⟩ + rcases u with ⟨ua, ub⟩ + rcases w with ⟨wa, wb⟩ + apply Prod.ext + · simp [BandPackingSymmetryAffineVectorAction, GaussianReflection] + · simp? [BandPackingSymmetryAffineVectorAction, GaussianReflection] + have hrel : ({re := -va, im := vb} : GaussianInt) = + -({re := va, im := -vb} : GaussianInt) := by + ext <;> simp + rw [hrel] + ring + | negate => + intro v u + rcases v with ⟨va, vb⟩ + rcases u with ⟨ua, ub⟩ + rfl + | conjugate => + intro v u + rcases v with ⟨va, vb⟩ + rcases u with ⟨ua, ub⟩ + rfl + | comp a b iha ihb => + intro v u + change BandPackingSymmetryAffineVectorAction a + (BandPackingSymmetryAffineVectorAction b (-v, -u)) = _ + rw [ihb] + apply iha + +private theorem slope_transport : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : ℝ × ℝ), ∀ (y : + ℝ × ℝ), ∀ (v : GaussianInt), ∀ (u : GaussianInt), TileCentroid V - TileCentroid U = + GaussianRealPoint v → x.1 - y.1 = (u.re : ℝ) → x.2 - y.2 = (u.im : ℝ) → + (BandPackingSymmetrySlopeAction a V x).1 - (BandPackingSymmetrySlopeAction a U y).1 = + (BandPackingSymmetryAffineVectorAction a (v, u)).2.re ∧ + (BandPackingSymmetrySlopeAction a V x).2 - (BandPackingSymmetrySlopeAction a U y).2 = + (BandPackingSymmetryAffineVectorAction a (v, u)).2.im ) := by + classical + intro a U V x y v u hc hx hy + have hp : x - y = (1 : ℝ) • GaussianRealPoint u := by + apply Prod.ext + · simpa [GaussianRealPoint] using hx + · simpa [GaussianRealPoint] using hy + have hs := (P5625T1CentroidSlopeDifferenceCovariance.2 + a U V x y v u 1 (by simpa using hc) hp).2 + constructor + · simpa [GaussianRealPoint] using congrArg Prod.fst hs + · simpa [GaussianRealPoint] using congrArg Prod.snd hs + +private theorem vector_signAt350 : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), + (BandPackingSymmetryScopedPhase g q negative) → (∀ (j : Fin 3), GaussianRealPoint + (BandPackingSymmetryVectorAction g (BandVectors.1 (q 0) (q j.succ))) = (if xor + negative (BandPackingSymmetryReversesOrientation g) = true then (-1 : ℝ) else 1) • + GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction g q 0) + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + then -j else j).succ))) ) := by + classical + intro g q negative hphase j + have hp := hphase j + dsimp [BandPackingSymmetryScopedPhase] at hp + have hv := hp.2.1 + by_cases hn : negative + · by_cases hr : BandPackingSymmetryReversesOrientation g = true + · simpa [hn, hr, GaussianRealPoint] using + (congrArg GaussianRealPoint hv).symm + · simpa [hn, hr, GaussianRealPoint] using + congrArg Neg.neg (congrArg GaussianRealPoint hv).symm + · by_cases hr : BandPackingSymmetryReversesOrientation g = true + · simpa [hn, hr, GaussianRealPoint] using + congrArg Neg.neg (congrArg GaussianRealPoint hv).symm + · simpa [hn, hr, GaussianRealPoint] using + (congrArg GaussianRealPoint hv).symm + +private theorem vector_flip : + (by + classical + exact + (∀ (a : BandPackingSymmetry), ∀ (v : GaussianInt), BandPackingSymmetryVectorAction a (-v) + = -BandPackingSymmetryVectorAction a v) → (∀ (a : BandPackingSymmetry), ∀ (v : + GaussianInt), BandPackingSymmetryVectorAction a (GaussianQuarterTurn v) = (if + BandPackingSymmetryReversesOrientation a then -GaussianQuarterTurn + (BandPackingSymmetryVectorAction a v) else GaussianQuarterTurn + (BandPackingSymmetryVectorAction a v))) ) := by + classical + intro vector_neg a + induction a with + | identity => intro v; rfl + | shift w => intro v; rfl + | negate => intro v; rfl + | conjugate => + intro v + rcases v with ⟨va,vb⟩ + simp [BandPackingSymmetryVectorAction, + BandPackingSymmetryReversesOrientation, GaussianQuarterTurn, + GaussianReflection] + | comp a b iha ihb => + intro v + change BandPackingSymmetryVectorAction a + (BandPackingSymmetryVectorAction b (GaussianQuarterTurn v)) = _ + rw [ihb] + by_cases ha : BandPackingSymmetryReversesOrientation a = true + · by_cases hb : BandPackingSymmetryReversesOrientation b = true + · simp only [ite_eq_left hb] + rw [vector_neg, iha] + simp [ha, hb, BandPackingSymmetryReversesOrientation, + BandPackingSymmetryVectorAction, GaussianQuarterTurn] + · simp only [ite_eq_right hb] + rw [iha] + simp [ha, hb, BandPackingSymmetryReversesOrientation, + BandPackingSymmetryVectorAction, GaussianQuarterTurn] + · by_cases hb : BandPackingSymmetryReversesOrientation b = true + · simp only [ite_eq_left hb] + rw [vector_neg, iha] + simp [ha, hb, BandPackingSymmetryReversesOrientation, + BandPackingSymmetryVectorAction, GaussianQuarterTurn] + · simp only [ite_eq_right hb] + rw [iha] + simp [ha, hb, BandPackingSymmetryReversesOrientation, + BandPackingSymmetryVectorAction, GaussianQuarterTurn] + +private theorem affine_flip_second : + (by + classical + exact + (∀ (a : BandPackingSymmetry), ∀ (v : GaussianInt), ∀ (u : GaussianInt), + BandPackingSymmetryAffineVectorAction a (-v, -u) = + -BandPackingSymmetryAffineVectorAction a (v, u)) → ((∀ (a : BandPackingSymmetry), ∀ + (v : GaussianInt), ∀ (u : GaussianInt), (BandPackingSymmetryAffineVectorAction a (v, + u)).1 = BandPackingSymmetryVectorAction a v) → ((∀ (a : BandPackingSymmetry), ∀ (v : + GaussianInt), BandPackingSymmetryVectorAction a (GaussianQuarterTurn v) = (if + BandPackingSymmetryReversesOrientation a then -GaussianQuarterTurn + (BandPackingSymmetryVectorAction a v) else GaussianQuarterTurn + (BandPackingSymmetryVectorAction a v))) → (∀ (a : BandPackingSymmetry), ∀ (v : + GaussianInt), ∀ (u : GaussianInt), (BandPackingSymmetryAffineVectorAction a + (GaussianQuarterTurn v, -GaussianQuarterTurn u)).2 = (if + BandPackingSymmetryReversesOrientation a then GaussianQuarterTurn + (BandPackingSymmetryAffineVectorAction a (v,u)).2 else -GaussianQuarterTurn + (BandPackingSymmetryAffineVectorAction a (v,u)).2)))) ) := by + classical + intro affine_neg affine_first vector_flip a + induction a with + | identity => intro v u; rfl + | shift w => + intro v u + rcases v with ⟨va,vb⟩ + rcases u with ⟨ua,ub⟩ + rcases w with ⟨wa,wb⟩ + simp? [BandPackingSymmetryAffineVectorAction, + BandPackingSymmetryReversesOrientation, GaussianQuarterTurn, + GaussianReflection] + ext <;> simp; ring + | negate => + intro v u + rcases v with ⟨va,vb⟩ + rcases u with ⟨ua,ub⟩ + rfl + | conjugate => + intro v u + rcases v with ⟨va,vb⟩ + rcases u with ⟨ua,ub⟩ + simp? [BandPackingSymmetryAffineVectorAction, + BandPackingSymmetryReversesOrientation, GaussianQuarterTurn, + GaussianReflection] + ext <;> simp + | comp a b iha ihb => + intro v u + change (BandPackingSymmetryAffineVectorAction a + (BandPackingSymmetryAffineVectorAction b + (GaussianQuarterTurn v, -GaussianQuarterTurn u))).2 = _ + have hb1 := vector_flip b v + have hb2 := ihb v u + have hpair : BandPackingSymmetryAffineVectorAction b + (GaussianQuarterTurn v, -GaussianQuarterTurn u) = + (BandPackingSymmetryVectorAction b (GaussianQuarterTurn v), + (BandPackingSymmetryAffineVectorAction b + (GaussianQuarterTurn v, -GaussianQuarterTurn u)).2) := by + apply Prod.ext + · exact affine_first b (GaussianQuarterTurn v) (-GaussianQuarterTurn u) + · rfl + rw [hpair] + rw [hb1, hb2] + by_cases ha : BandPackingSymmetryReversesOrientation a = true + · by_cases hb : BandPackingSymmetryReversesOrientation b = true + · have hp : (-GaussianQuarterTurn (BandPackingSymmetryVectorAction b v), + GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction b (v,u)).2) = + -(GaussianQuarterTurn (BandPackingSymmetryVectorAction b v), + -GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction b (v,u)).2) := by + ext <;> simp + simp only [ite_eq_left hb] + change (BandPackingSymmetryAffineVectorAction a + (-GaussianQuarterTurn (BandPackingSymmetryVectorAction b v), + GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction b (v,u)).2)).2 = _ + have hn : (-GaussianQuarterTurn (BandPackingSymmetryVectorAction b v), + GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction b (v,u)).2) = + (-GaussianQuarterTurn (BandPackingSymmetryVectorAction b v), + -(-GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction b (v,u)).2)) := by + ext <;> simp + rw [hn, affine_neg] + change -((BandPackingSymmetryAffineVectorAction a + (GaussianQuarterTurn (BandPackingSymmetryVectorAction b v), + -GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction b (v,u)).2)).2) = _ + rw [iha] + have hpair2 : (BandPackingSymmetryVectorAction b v, + (BandPackingSymmetryAffineVectorAction b (v,u)).2) = + BandPackingSymmetryAffineVectorAction b (v,u) := by + apply Prod.ext + · exact (affine_first b v u).symm + · rfl + rw [hpair2] + simp [ha, hb, BandPackingSymmetryReversesOrientation, + BandPackingSymmetryAffineVectorAction, GaussianQuarterTurn] + · simp only [ite_eq_right hb] + change (BandPackingSymmetryAffineVectorAction a + (GaussianQuarterTurn (BandPackingSymmetryVectorAction b v), + -GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction b (v,u)).2)).2 = _ + rw [iha] + have hpair2 : (BandPackingSymmetryVectorAction b v, + (BandPackingSymmetryAffineVectorAction b (v,u)).2) = + BandPackingSymmetryAffineVectorAction b (v,u) := by + apply Prod.ext + · exact (affine_first b v u).symm + · rfl + rw [hpair2] + simp [ha, hb, BandPackingSymmetryReversesOrientation, + BandPackingSymmetryAffineVectorAction, GaussianQuarterTurn] + · by_cases hb : BandPackingSymmetryReversesOrientation b = true + · have hp : (-GaussianQuarterTurn (BandPackingSymmetryVectorAction b v), + GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction b (v,u)).2) = + -(GaussianQuarterTurn (BandPackingSymmetryVectorAction b v), + -GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction b (v,u)).2) := by + ext <;> simp + simp only [ite_eq_left hb] + change (BandPackingSymmetryAffineVectorAction a + (-GaussianQuarterTurn (BandPackingSymmetryVectorAction b v), + GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction b (v,u)).2)).2 = _ + have hn : (-GaussianQuarterTurn (BandPackingSymmetryVectorAction b v), + GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction b (v,u)).2) = + (-GaussianQuarterTurn (BandPackingSymmetryVectorAction b v), + -(-GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction b (v,u)).2)) := by + ext <;> simp + rw [hn, affine_neg] + change -((BandPackingSymmetryAffineVectorAction a + (GaussianQuarterTurn (BandPackingSymmetryVectorAction b v), + -GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction b (v,u)).2)).2) = _ + rw [iha] + have hpair2 : (BandPackingSymmetryVectorAction b v, + (BandPackingSymmetryAffineVectorAction b (v,u)).2) = + BandPackingSymmetryAffineVectorAction b (v,u) := by + apply Prod.ext + · exact (affine_first b v u).symm + · rfl + rw [hpair2] + simp [ha, hb, BandPackingSymmetryReversesOrientation, + BandPackingSymmetryAffineVectorAction, GaussianQuarterTurn] + · simp only [ite_eq_right hb] + change (BandPackingSymmetryAffineVectorAction a + (GaussianQuarterTurn (BandPackingSymmetryVectorAction b v), + -GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction b (v,u)).2)).2 = _ + rw [iha] + have hpair2 : (BandPackingSymmetryVectorAction b v, + (BandPackingSymmetryAffineVectorAction b (v,u)).2) = + BandPackingSymmetryAffineVectorAction b (v,u) := by + apply Prod.ext + · exact (affine_first b v u).symm + · rfl + rw [hpair2] + simp [ha, hb, BandPackingSymmetryReversesOrientation, + BandPackingSymmetryAffineVectorAction, GaussianQuarterTurn] + +private theorem newIndex_eq : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (i : Fin 3), + let newIndex : Fin 3 := + if BandPackingSymmetryReversesOrientation g then -i else i + newIndex = (if BandPackingSymmetryReversesOrientation g = true then -i else i) ) := by + classical + intro g i newIndex + simp [newIndex] + +private theorem turn_mul : + (by + classical + exact + ∀ (z : GaussianInt), (⟨0, 1⟩ : GaussianInt) * z = GaussianQuarterTurn z ) := by + classical + intro z + rcases z with ⟨a, b⟩ + ext <;> simp [GaussianQuarterTurn] + +private theorem neg_turn_mul : + (by + classical + exact + (∀ (z : GaussianInt), (⟨0, 1⟩ : GaussianInt) * z = GaussianQuarterTurn z) → (∀ (z : + GaussianInt), -((⟨0, 1⟩ : GaussianInt) * z) = -GaussianQuarterTurn z) ) := by + classical + intro turn_mul z + rw [turn_mul] + +private theorem neg_turn_mul' : + (by + classical + exact + ∀ (z : GaussianInt), (-(⟨0, 1⟩ : GaussianInt)) * z = -GaussianQuarterTurn z ) := by + classical + intro z + rcases z with ⟨a, b⟩ + ext <;> simp [GaussianQuarterTurn] + +private theorem oldPair : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), (BandVectors.2 (q (0 : Fin (4 : ℕ))) (q + i.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (q i.succ) (q (0 : Fin + (4 : ℕ)))) → ((BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) * BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) → ((∀ (z : + GaussianInt), (⟨0, 1⟩ : GaussianInt) * z = GaussianQuarterTurn z) → ((∀ (z : + GaussianInt), (-(⟨0, 1⟩ : GaussianInt)) * z = -GaussianQuarterTurn z) → + ((BandVectors.1 (q 0) (q i.succ), BandVectors.2 (q 0) (q i.succ)) = + (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)), -GaussianQuarterTurn + (BandVectors.2 (q i.succ) (q 0))))))) ) := by + classical + intro q i oldFlip oldFlipVec turn_mul neg_turn_mul' + apply Prod.ext + · rw [turn_mul] at oldFlipVec + exact oldFlipVec + · rw [neg_turn_mul'] at oldFlip + exact oldFlip + +private theorem hcAt631 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' + : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 + : ℝ)) • GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((e = + true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 (q 0) (q + i.succ)))) ) := by + classical + intro q i e T T' hcent he + simpa [he] using hcent + +private theorem hcAt637 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' + : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 + : ℝ)) • GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((¬e = + true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (-(BandVectors.1 (q 0) + (q i.succ))))) ) := by + classical + intro q i e T T' hcent he + simpa [he, GaussianRealPoint] using hcent + +private theorem hcAt647 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' + : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 + : ℝ)) • GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((e = + true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 (q 0) (q + i.succ)))) ) := by + classical + intro q i e T T' hcent he + simpa [he] using hcent + +private theorem hcAt695 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' + : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 + : ℝ)) • GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((¬e = + true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (-(BandVectors.1 (q 0) + (q i.succ))))) ) := by + classical + intro q i e T T' hcent he + simpa [he, GaussianRealPoint] using hcent + +private theorem hcAt742 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' + : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 + : ℝ)) • GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((e = + true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 (q 0) (q + i.succ)))) ) := by + classical + intro q i e T T' hcent he + simpa [he] using hcent + +private theorem hcAt785 : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' + : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 + : ℝ)) • GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((¬e = + true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (-(BandVectors.1 (q 0) + (q i.succ))))) ) := by + classical + intro q i e T T' hcent he + simpa [he, GaussianRealPoint] using hcent + +end RightLatticeTransportGeometry + +namespace RightAdjacencyAssembly + +private theorem transportedAdjacency : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : + Bool), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : + PartialOdometer), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), (TileCentroid T' - TileCentroid T = + (if e = true then (1 : ℝ) else (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 (q (0 : + Fin (4 : ℕ))) (q i.succ))) → ((p'.1 - p.1 = (if e = true then (1 : ℝ) else (-1 : ℝ)) + * (↑(BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i.succ)).re : ℝ)) → ((p'.2 - p.2 = (if e + = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (q (0 : Fin (4 : ℕ))) (q + i.succ)).im : ℝ)) → (∀ (negative : Bool), (BandPackingSymmetryScopedPhase g q + negative) → ((∀ (i : Fin (3 : ℕ)), + let e := if negative = true then (-1 : GaussianInt) else (1 : GaussianInt); + let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); + let cyclic := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 + : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ + BandVectors.2 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : + ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation g = true then + -GaussianQuarterTurn cyclic.2 else cyclic.2) → ((TileOdometer + (BandPackingSymmetryCircleAction g (q (0 : Fin (4 : ℕ)))) + (BandPackingSymmetryTileAction g T) (BandPackingSymmetryPartialOdometerAction g h)) → + ((TileOdometer (BandPackingSymmetryCircleAction g (q (0 : Fin (4 : ℕ)))) + (BandPackingSymmetryTileAction g T') (BandPackingSymmetryPartialOdometerAction g h')) + → ((PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = some + (BandPackingSymmetrySlopeAction g T p)) → ((PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction g h') = some + (BandPackingSymmetrySlopeAction g T' p')) → ((∀ (a : BandPackingSymmetry), ∀ (U : + ProtoTile), ∀ (V : ProtoTile), ∀ (v : GaussianInt), TileCentroid V - TileCentroid U = + GaussianRealPoint v → TileCentroid (BandPackingSymmetryTileAction a V) - TileCentroid + (BandPackingSymmetryTileAction a U) = GaussianRealPoint + (BandPackingSymmetryVectorAction a v)) → ((∀ (j : Fin 3), GaussianRealPoint + (BandPackingSymmetryVectorAction g (BandVectors.1 (q 0) (q j.succ))) = (if xor + negative (BandPackingSymmetryReversesOrientation g) = true then (-1 : ℝ) else 1) • + GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction g q 0) + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + then -j else j).succ))) → ((∀ (a : BandPackingSymmetry), ∀ (v : GaussianInt), + BandPackingSymmetryVectorAction a (-v) = -BandPackingSymmetryVectorAction a v) → ((∀ + (a : BandPackingSymmetry), ∀ (v : GaussianInt), ∀ (u : GaussianInt), + BandPackingSymmetryAffineVectorAction a (-v, -u) = + -BandPackingSymmetryAffineVectorAction a (v, u)) → ((∀ (z : GaussianInt), + (GaussianInt.toComplex z).re = (z.re : ℝ)) → ((∀ (z : GaussianInt), + (GaussianInt.toComplex z).im = (z.im : ℝ)) → ((∀ (a : BandPackingSymmetry), ∀ (U : + ProtoTile), ∀ (V : ProtoTile), ∀ (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), ∀ (v : GaussianInt), ∀ + (u : GaussianInt), TileCentroid V - TileCentroid U = GaussianRealPoint v → x.1 - y.1 + = (↑u.re : ℝ) → x.2 - y.2 = (↑u.im : ℝ) → (BandPackingSymmetrySlopeAction a V x).1 - + (BandPackingSymmetrySlopeAction a U y).1 = (↑(BandPackingSymmetryAffineVectorAction a + (v, u)).2.re : ℝ) ∧ (BandPackingSymmetrySlopeAction a V x).2 - + (BandPackingSymmetrySlopeAction a U y).2 = (↑(BandPackingSymmetryAffineVectorAction a + (v, u)).2.im : ℝ)) → ( + let newIndex : Fin 3 := + if BandPackingSymmetryReversesOrientation g then -i else i + (newIndex = (if BandPackingSymmetryReversesOrientation g = true then -i else i)) → + (((BandVectors.1 (q 0) (q i.succ), BandVectors.2 (q 0) (q i.succ)) = + (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)), -GaussianQuarterTurn + (BandVectors.2 (q i.succ) (q 0)))) → (((↑(BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q newIndex.succ)).re : ℝ) = (↑(BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q newIndex.succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ)))).im : ℝ)) → + (((↑(BandVectors.2 (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q newIndex.succ)).im : ℝ) = -(↑(BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q newIndex.succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ)))).re : ℝ)) → + (((↑(BandPackingSymmetryAffineVectorAction g ((⟨-(BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ)))).im, (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))).re⟩ : + GaussianInt), -(⟨-(BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))).im, (BandVectors.2 + (q i.succ) (q (0 : Fin (4 : ℕ)))).re⟩ : GaussianInt))).2.re : ℝ) = + ((GaussianInt.toComplex : GaussianInt → ℂ) (if BandPackingSymmetryReversesOrientation + g = true then (⟨-(BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) + (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.im, + (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.re⟩ : GaussianInt) else + -(⟨-(BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 + : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.im, + (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.re⟩ : GaussianInt))).re) → + (((↑(BandPackingSymmetryAffineVectorAction g ((⟨-(BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ)))).im, (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))).re⟩ : + GaussianInt), -(⟨-(BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))).im, (BandVectors.2 + (q i.succ) (q (0 : Fin (4 : ℕ)))).re⟩ : GaussianInt))).2.im : ℝ) = + ((GaussianInt.toComplex : GaussianInt → ℂ) (if BandPackingSymmetryReversesOrientation + g = true then (⟨-(BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) + (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.im, + (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.re⟩ : GaussianInt) else + -(⟨-(BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 + : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.im, + (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : + ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.re⟩ : GaussianInt))).im) → ( + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let reverses := BandPackingSymmetryReversesOrientation g + ∃ negative : Bool, ∃ r r' : ℝ × ℝ, + BandPackingSymmetryScopedPhase g q negative ∧ + TileOdometer (q' 0) (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryPartialOdometerAction g h) ∧ + TileOdometer (q' 0) (BandPackingSymmetryTileAction g T') + (BandPackingSymmetryPartialOdometerAction g h') ∧ + PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction g h) = some r ∧ + PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction g h') = some r' ∧ + TileCentroid (BandPackingSymmetryTileAction g T') - + TileCentroid (BandPackingSymmetryTileAction g T) = + (if xor (xor e negative) reverses = true then (1 : ℝ) else -1) • + GaussianRealPoint + (BandVectors.1 (q' 0) (q' (sigma i).succ)) ∧ + r'.1 - r.1 = + (if xor (xor e negative) reverses = true then (1 : ℝ) else -1) * + (BandVectors.2 (q' 0) (q' (sigma i).succ)).re ∧ + r'.2 - r.2 = + (if xor (xor e negative) reverses = true then (1 : ℝ) else -1) * + (BandVectors.2 (q' 0) (q' (sigma i).succ)).im ∧ + (OdometerCompatibility + (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g h') ↔ + OdometerCompatibility h h'))))))))))))))))))))))) ) := by + classical + intro g q i e T T' h h' p p' hcent hslopeRe hslopeIm negative hphase hvec hOT hOT' hsr hsr' + centroid_transport vector_sign vector_neg affine_neg real_coord imag_coord slope_transport + newIndex newIndex_eq oldPair newFlipRe newFlipIm affineRightRe affineRightIm + refine ⟨negative, BandPackingSymmetrySlopeAction g T p, + BandPackingSymmetrySlopeAction g T' p', ?_⟩ + refine ⟨hphase, ?_, ?_, hsr, hsr', ?_, ?_, ?_, ?_⟩ + · simpa [BandPackingSymmetryQuadrupleAction] using hOT + · simpa [BandPackingSymmetryQuadrupleAction] using hOT' + · by_cases he : e = true + · have hc : TileCentroid T' - TileCentroid T = + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) := + RightLatticeTransportGeometry.hcAt631 q i e T T' hcent he + rw [centroid_transport g T T' + (BandVectors.1 (q 0) (q i.succ)) hc] + simpa [he] using vector_sign i + · have hc : TileCentroid T' - TileCentroid T = + GaussianRealPoint (-(BandVectors.1 (q 0) (q i.succ))) := + RightLatticeTransportGeometry.hcAt637 q i e T T' hcent he + rw [centroid_transport g T T' + (-(BandVectors.1 (q 0) (q i.succ))) hc, vector_neg] + have hh := congrArg Neg.neg (vector_sign i) + by_cases hn : negative <;> + by_cases hr : BandPackingSymmetryReversesOrientation g = true + all_goals simpa [he, hn, hr, GaussianRealPoint] using hh + · by_cases he : e = true + · have hc : TileCentroid T' - TileCentroid T = + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) := + RightLatticeTransportGeometry.hcAt647 q i e T T' hcent he + have hs := slope_transport g T T' p' p + (BandVectors.1 (q 0) (q i.succ)) + (BandVectors.2 (q 0) (q i.succ)) hc + (by simpa [he] using hslopeRe) (by simpa [he] using hslopeIm) + rw [oldPair] at hs + have hv := (hvec i).1 + have hvr := congrArg (fun z : GaussianInt => (z.re : ℝ)) hv + have hvi := congrArg (fun z : GaussianInt => (z.im : ℝ)) hv + by_cases hn : negative <;> + by_cases hr : BandPackingSymmetryReversesOrientation g = true + all_goals simp? [he, hn, hr] at ⊢ + all_goals simp? [newIndex_eq, hr] at newFlipRe newFlipIm + all_goals try rw [real_coord] at newFlipRe + all_goals try rw [imag_coord] at newFlipIm + all_goals simp only [hn, hr] at hvr hvi + all_goals norm_num at hvr hvi + all_goals rw [← GaussianInt.intCast_re] at hvr ⊢ + all_goals rw [← GaussianInt.intCast_im] at hvi + all_goals simp? [hr] at affineRightRe affineRightIm + all_goals rw [← GaussianInt.intCast_re] at affineRightRe + all_goals rw [← GaussianInt.intCast_im] at affineRightIm + all_goals rw [real_coord] at hvr affineRightIm + all_goals rw [imag_coord] at hvi affineRightRe + all_goals simp? [GaussianQuarterTurn] at hs + all_goals rw [real_coord] at hs + all_goals rw [imag_coord] at hs + all_goals ring_nf at hs ⊢ + all_goals simp only [real_coord, imag_coord] at newFlipRe newFlipIm + all_goals linarith only [hs.1, hvr, hvi, newFlipRe, newFlipIm, + affineRightRe, + affineRightIm] + · have hc : TileCentroid T' - TileCentroid T = + GaussianRealPoint (-(BandVectors.1 (q 0) (q i.succ))) := + RightLatticeTransportGeometry.hcAt695 q i e T T' hcent he + have hs := slope_transport g T T' p' p + (-(BandVectors.1 (q 0) (q i.succ))) + (-(BandVectors.2 (q 0) (q i.succ))) hc + (by simpa [he, GaussianRealPoint] using hslopeRe) + (by simpa [he, GaussianRealPoint] using hslopeIm) + rw [affine_neg] at hs + rw [oldPair] at hs + norm_num at hs + have hv := (hvec i).1 + have hvr := congrArg (fun z : GaussianInt => (z.re : ℝ)) hv + have hvi := congrArg (fun z : GaussianInt => (z.im : ℝ)) hv + by_cases hn : negative <;> + by_cases hr : BandPackingSymmetryReversesOrientation g = true + all_goals simp? [he, hn, hr] at ⊢ + all_goals simp? [newIndex_eq, hr] at newFlipRe newFlipIm + all_goals try rw [real_coord] at newFlipRe + all_goals try rw [imag_coord] at newFlipIm + all_goals simp only [hn, hr] at hvr hvi + all_goals norm_num at hvr hvi + all_goals rw [← GaussianInt.intCast_re] at hvr ⊢ + all_goals rw [← GaussianInt.intCast_im] at hvi + all_goals simp? [hr] at affineRightRe affineRightIm + all_goals rw [← GaussianInt.intCast_re] at affineRightRe + all_goals rw [← GaussianInt.intCast_im] at affineRightIm + all_goals rw [real_coord] at hvr affineRightIm + all_goals rw [imag_coord] at hvi affineRightRe + all_goals simp? [GaussianQuarterTurn] at hs + all_goals rw [real_coord] at hs + all_goals rw [imag_coord] at hs + all_goals ring_nf at hs ⊢ + all_goals simp only [real_coord, imag_coord] at newFlipRe newFlipIm + all_goals linarith only [hs.1, hvr, hvi, newFlipRe, newFlipIm, + affineRightRe, + affineRightIm] + · by_cases he : e = true + · have hc : TileCentroid T' - TileCentroid T = + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) := + RightLatticeTransportGeometry.hcAt742 q i e T T' hcent he + have hs := slope_transport g T T' p' p + (BandVectors.1 (q 0) (q i.succ)) (BandVectors.2 (q 0) (q i.succ)) hc + (by simpa [he] using hslopeRe) (by simpa [he] using hslopeIm) + rw [oldPair] at hs + have hv := (hvec i).1 + have hvi := congrArg (fun z : GaussianInt => (z.im : ℝ)) hv + have hvr := congrArg (fun z : GaussianInt => (z.re : ℝ)) hv + by_cases hn : negative <;> + by_cases hr : BandPackingSymmetryReversesOrientation g = true + all_goals simp? [he, hn, hr] at ⊢ + all_goals simp? [newIndex_eq, hr] at newFlipRe newFlipIm + all_goals try rw [real_coord] at newFlipRe + all_goals try rw [imag_coord] at newFlipIm + all_goals simp only [hn, hr] at hvi + all_goals simp only [hn, hr] at hvr + all_goals norm_num at hvi + all_goals norm_num at hvr + all_goals rw [← GaussianInt.intCast_im] at ⊢ + all_goals rw [← GaussianInt.intCast_im] at hvi + all_goals rw [← GaussianInt.intCast_re] at hvr + all_goals simp? [hr] at affineRightRe affineRightIm + all_goals rw [← GaussianInt.intCast_re] at affineRightRe + all_goals rw [← GaussianInt.intCast_im] at affineRightIm + all_goals rw [imag_coord] at hvi affineRightRe + all_goals rw [real_coord] at hvr + all_goals rw [real_coord] at affineRightIm + all_goals simp? [GaussianQuarterTurn] at hs + all_goals rw [real_coord] at hs + all_goals rw [imag_coord] at hs + all_goals ring_nf at hs ⊢ + all_goals simp only [real_coord, imag_coord] at newFlipRe newFlipIm + all_goals linarith only [hs.2, hvi, hvr, newFlipRe, newFlipIm, + affineRightRe, + affineRightIm] + · have hc : TileCentroid T' - TileCentroid T = + GaussianRealPoint (-(BandVectors.1 (q 0) (q i.succ))) := + RightLatticeTransportGeometry.hcAt785 q i e T T' hcent he + have hs := slope_transport g T T' p' p + (-(BandVectors.1 (q 0) (q i.succ))) + (-(BandVectors.2 (q 0) (q i.succ))) hc + (by simpa [he, GaussianRealPoint] using hslopeRe) + (by simpa [he, GaussianRealPoint] using hslopeIm) + rw [affine_neg] at hs + rw [oldPair] at hs + norm_num at hs + have hv := (hvec i).1 + have hvi := congrArg (fun z : GaussianInt => (z.im : ℝ)) hv + have hvr := congrArg (fun z : GaussianInt => (z.re : ℝ)) hv + by_cases hn : negative <;> + by_cases hr : BandPackingSymmetryReversesOrientation g = true + all_goals simp? [he, hn, hr] at ⊢ + all_goals simp? [newIndex_eq, hr] at newFlipRe newFlipIm + all_goals try rw [real_coord] at newFlipRe + all_goals try rw [imag_coord] at newFlipIm + all_goals simp only [hn, hr] at hvi + all_goals simp only [hn, hr] at hvr + all_goals norm_num at hvi + all_goals norm_num at hvr + all_goals rw [← GaussianInt.intCast_im] at ⊢ + all_goals rw [← GaussianInt.intCast_im] at hvi + all_goals rw [← GaussianInt.intCast_re] at hvr + all_goals simp? [hr] at affineRightRe affineRightIm + all_goals rw [← GaussianInt.intCast_re] at affineRightRe + all_goals rw [← GaussianInt.intCast_im] at affineRightIm + all_goals rw [imag_coord] at hvi affineRightRe + all_goals rw [real_coord] at hvr + all_goals rw [real_coord] at affineRightIm + all_goals simp? [GaussianQuarterTurn] at hs + all_goals rw [real_coord] at hs + all_goals rw [imag_coord] at hs + all_goals ring_nf at hs ⊢ + all_goals simp only [real_coord, imag_coord] at newFlipRe newFlipIm + all_goals linarith only [hs.2, hvi, hvr, newFlipRe, newFlipIm, + affineRightRe, + affineRightIm] + · exact (BandPackingSymmetryPartialOdometerActionFormulas g h h').2.2.2.2.2.2.1 + +end RightAdjacencyAssembly + +theorem RightLatticeAdjacentPackingSymmetryTransport + (g : BandPackingSymmetry) (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) (i : Fin 3) (e : Bool) + (T T' : ProtoTile) (h h' : PartialOdometer) (p p' : ℝ × ℝ) + (hO : TileOdometer (q 0) T h) (hO' : TileOdometer (q 0) T' h') + (hp : PartialOdometerSlope h = some p) + (hp' : PartialOdometerSlope h' = some p') + (hcent : TileCentroid T' - TileCentroid T = + (if e = true then (1 : ℝ) else -1) • + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ))) + (hslopeRe : p'.1 - p.1 = + (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q 0) (q i.succ)).re) + (hslopeIm : p'.2 - p.2 = + (if e = true then (1 : ℝ) else -1) * + (BandVectors.2 (q 0) (q i.succ)).im) : + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let reverses := BandPackingSymmetryReversesOrientation g + ∃ negative : Bool, ∃ r r' : ℝ × ℝ, + BandPackingSymmetryScopedPhase g q negative ∧ + TileOdometer (q' 0) (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryPartialOdometerAction g h) ∧ + TileOdometer (q' 0) (BandPackingSymmetryTileAction g T') + (BandPackingSymmetryPartialOdometerAction g h') ∧ + PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction g h) = some r ∧ + PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction g h') = some r' ∧ + TileCentroid (BandPackingSymmetryTileAction g T') - + TileCentroid (BandPackingSymmetryTileAction g T) = + (if xor (xor e negative) reverses = true then (1 : ℝ) else -1) • + GaussianRealPoint + (BandVectors.1 (q' 0) (q' (sigma i).succ)) ∧ + r'.1 - r.1 = + (if xor (xor e negative) reverses = true then (1 : ℝ) else -1) * + (BandVectors.2 (q' 0) (q' (sigma i).succ)).re ∧ + r'.2 - r.2 = + (if xor (xor e negative) reverses = true then (1 : ℝ) else -1) * + (BandVectors.2 (q' 0) (q' (sigma i).succ)).im ∧ + (OdometerCompatibility + (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g h') ↔ + OdometerCompatibility h h') := by +-- BODY + classical + dsimp + obtain ⟨negative, hphase, hvec⟩ := + BandPackingSymmetryAffineVectorCovariance g q hq + have hTne := RightLatticeTransportGeometry.hTne q hq T h p hO hp + have hT'ne := RightLatticeTransportGeometry.hT'ne q hq T' h' p' hO' hp' + obtain ⟨hOT, _, hST⟩ := BandPackingSymmetryTileOdometerCovariance g (q 0) T h hO + obtain ⟨hOT', _, hST'⟩ := BandPackingSymmetryTileOdometerCovariance g (q 0) T' h' hO' + have hsr := RightLatticeTransportGeometry.hsr g T h p hp hTne hST + have hsr' := RightLatticeTransportGeometry.hsr' g T' h' p' hp' hT'ne hST' + have centroid_transport := RightLatticeTransportGeometry.centroid_transport + have vector_sign (j : Fin 3) := RightLatticeTransportGeometry.vector_signAt246 g q negative + hphase j + have vector_neg := RightLatticeTransportGeometry.vector_neg + have affine_neg := RightLatticeTransportGeometry.affine_neg + have affine_first (a : BandPackingSymmetry) (v u : GaussianInt) : + (BandPackingSymmetryAffineVectorAction a (v, u)).1 = + BandPackingSymmetryVectorAction a v := + P5625T1CentroidSlopeDifferenceCovariance.1 a (v, u) + have real_coord (z : GaussianInt) : + (GaussianInt.toComplex z).re = (z.re : ℝ) := + (GaussianInt.intCast_re z).symm + have imag_coord (z : GaussianInt) : + (GaussianInt.toComplex z).im = (z.im : ℝ) := + (GaussianInt.intCast_im z).symm + have slope_transport := RightLatticeTransportGeometry.slope_transport + have vector_sign (j : Fin 3) := RightLatticeTransportGeometry.vector_signAt350 g q negative + hphase j + have vector_flip := RightLatticeTransportGeometry.vector_flip vector_neg + have affine_flip_second := RightLatticeTransportGeometry.affine_flip_second affine_neg + affine_first vector_flip + have hrec := VectorRecursionLaws q hq.1 + have hrec' := VectorRecursionLaws + (BandPackingSymmetryQuadrupleAction g q) + (BandPackingSymmetryProperCovariance g q hq).1 + have oldFlip := (hrec.2.2.2.2 hq i).2 + let newIndex : Fin 3 := + if BandPackingSymmetryReversesOrientation g then -i else i + have newIndex_eq := RightLatticeTransportGeometry.newIndex_eq g i + have newFlip := (hrec'.2.2.2.2 + (BandPackingSymmetryProperCovariance g q hq) newIndex).2 + have oldFlipVec := (hrec.2.2.2.2 hq i).1 + have newFlipVec := (hrec'.2.2.2.2 + (BandPackingSymmetryProperCovariance g q hq) newIndex).1 + have affineRight := affine_flip_second g + (BandVectors.1 (q i.succ) (q 0)) + (BandVectors.2 (q i.succ) (q 0)) + have oldFlipRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) oldFlip + have oldFlipIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) oldFlip + have newFlipRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) newFlip + have newFlipIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) newFlip + have turn_mul (z : GaussianInt) := RightLatticeTransportGeometry.turn_mul z + have neg_turn_mul (z : GaussianInt) := RightLatticeTransportGeometry.neg_turn_mul turn_mul z + have neg_turn_mul' (z : GaussianInt) := RightLatticeTransportGeometry.neg_turn_mul' z + have oldPair := RightLatticeTransportGeometry.oldPair q i oldFlip oldFlipVec turn_mul + neg_turn_mul' + have oldFlipVecRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) oldFlipVec + have oldFlipVecIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) oldFlipVec + have newFlipVecRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) newFlipVec + have newFlipVecIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) newFlipVec + have affineRightRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) affineRight + have affineRightIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) affineRight + have phaseSlope := (hvec i).2 + have phaseSlopeRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) phaseSlope + have phaseSlopeIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) phaseSlope + simp? [] at oldFlipRe oldFlipIm newFlipRe newFlipIm + simp? [] at oldFlipVecRe oldFlipVecIm newFlipVecRe newFlipVecIm + simp only [real_coord, imag_coord] at newFlipRe newFlipIm + try + try + rw [real_coord] at oldFlipVecRe newFlipVecRe + rw [imag_coord] at oldFlipVecIm newFlipVecIm + rw [imag_coord] at oldFlipVecRe newFlipVecRe + rw [real_coord] at oldFlipVecIm newFlipVecIm + simp? [GaussianQuarterTurn] at affineRightRe affineRightIm phaseSlopeRe phaseSlopeIm + try rw [← GaussianInt.intCast_re] at oldFlipRe + try + try rw [← GaussianInt.intCast_re] at affineRightRe + try rw [← GaussianInt.intCast_re] at phaseSlopeRe + try rw [← GaussianInt.intCast_im] at oldFlipIm + try + try rw [← GaussianInt.intCast_im] at affineRightIm + try rw [← GaussianInt.intCast_im] at phaseSlopeIm + try rw [← GaussianInt.intCast_im] at oldFlipRe + try + try rw [← GaussianInt.intCast_re] at oldFlipIm + try + have transportedAdjacency := RightAdjacencyAssembly.transportedAdjacency g q i e T T' h h' p p' + hcent hslopeRe hslopeIm negative hphase hvec hOT hOT' hsr hsr' centroid_transport + vector_sign vector_neg affine_neg real_coord imag_coord slope_transport newIndex_eq oldPair + newFlipRe newFlipIm affineRightRe affineRightIm + exact transportedAdjacency + + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean b/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean new file mode 100644 index 0000000000..b89b2c409b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean @@ -0,0 +1,767 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.OdometerAdjacencyInduction +public import LeanPool.ApollonianSuperharmonic.LeftAdjacentOdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentInterfacePath +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileSubodometer + +-- [TABLET NODE: RightSubtileOdometerCompatibility] + +/-! +# RightSubtileOdometerCompatibility + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RightCompatibilityGeometry + +private theorem singleton_case : + (by + classical + exact + ∀ (a : PartialOdometer), ∀ (b : PartialOdometer), ((a.domain : Set GaussianInt) ∩ + (b.domain : Set GaussianInt)).Subsingleton → OdometerCompatibility a b ) := by + classical + intro a b hs + by_cases hn : ((a.domain : Set GaussianInt) ∩ + (b.domain : Set GaussianInt)).Nonempty + · rcases hn with ⟨x, hx, hx'⟩ + right + refine ⟨b.value x - a.value x, ?_⟩ + intro y hy hy' + have hxy : y = x := hs ⟨hy, hy'⟩ ⟨hx, hx'⟩ + subst y + rfl + · left + rw [Set.not_nonempty_iff_eq_empty] at hn + exact Set.disjoint_iff_inter_eq_empty.mpr hn + +private theorem list_glue : + (by + classical + exact + ∀ (p : List GaussianInt), ∀ (a : PartialOdometer), ∀ (b : PartialOdometer), 2 ≤ p.length + → (∀ u, ∀ v, ∀ l, ∀ r, p = l ++ u :: v :: r → ∃ c : ℤ, ∀ z, (z = u ∨ z = v) → z ∈ + a.domain → z ∈ b.domain → b.value z - a.value z = c) → (∀ z, z ∈ (p.toFinset : Set + GaussianInt) → z ∈ a.domain ∧ z ∈ b.domain) → ∃ c : ℤ, ∀ z, z ∈ (p.toFinset : Set + GaussianInt) → z ∈ a.domain → z ∈ b.domain → b.value z - a.value z = c ) := by + classical + intro p + induction p with + | nil => simp_all + | cons u p ih => + intro a b hlen hedge hmem + cases p with + | nil => simp at hlen + | cons v r => + cases r with + | nil => + obtain ⟨c, hc⟩ := hedge u v [] [] (by simp) + refine ⟨c, ?_⟩ + intro z hz ha hb + have hz' : z = u ∨ z = v := by simpa using hz + rcases hz' with rfl | rfl + · exact hc _ (Or.inl rfl) ha hb + · exact hc _ (Or.inr rfl) ha hb + | cons w r => + have htail : 2 ≤ (v :: w :: r).length := by simp + have hedgeTail : ∀ u' v' l' r', v :: w :: r = l' ++ u' :: v' :: r' → + ∃ c : ℤ, ∀ z, (z = u' ∨ z = v') → + z ∈ a.domain → z ∈ b.domain → b.value z - a.value z = c := by + intro u' v' l' r' he + apply hedge u' v' (u :: l') r' + simpa [List.cons_append, List.append_assoc] using congrArg (fun t => u :: t) he + obtain ⟨d, hd⟩ := ih a b htail hedgeTail (by + intro z hz + apply hmem z + exact by + simpa [List.toFinset_cons] using + (Or.inr hz : z = u ∨ z ∈ ((v :: w :: r).toFinset : Set GaussianInt))) + obtain ⟨c, hc⟩ := hedge u v [] (w :: r) (by simp) + have same : c = d := by + have hv := hc v (Or.inr rfl) + have hv' := hd v (by simp) + have hm := hmem v (by simp) + have e1 := hv hm.1 hm.2 + have e2 := hv' hm.1 hm.2 + omega + refine ⟨c, ?_⟩ + intro z hz ha hb + have hz' : z = u ∨ z ∈ ((v :: w :: r).toFinset : Set GaussianInt) := by + simpa using hz + rcases hz' with rfl | hz + · exact hc _ (Or.inl rfl) ha hb + · have := hd z hz ha hb + simpa [same] using this + +private theorem edge_endpoints : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), {a, b} ∈ FootprintEdges U → + a ∈ FootprintVertices U ∧ b ∈ FootprintVertices U ) := by + classical + intro U a b he + rcases he with ⟨x, hx, he⟩ + have hn : U.cells.Nonempty := ⟨x, hx⟩ + rcases he with he | he | he | he + · have ha : a ∈ ({x, x + 1} : Finset GaussianInt) := by + rw [← he] + simp + have hb : b ∈ ({x, x + 1} : Finset GaussianInt) := by + rw [← he] + simp + have lift : ∀ w, w = x ∨ w = x + 1 → + w = x ∨ w = x + 1 ∨ w = x + ⟨0, 1⟩ ∨ w = x + 1 + ⟨0, 1⟩ := by + intro w hw + rcases hw with hw | hw + · exact Or.inl hw + · exact Or.inr (Or.inl hw) + constructor <;> simp only [FootprintVertices, ite_eq_left hn, Set.mem_ofPred_eq] + · exact ⟨x, hx, lift a (by simpa using ha)⟩ + · exact ⟨x, hx, lift b (by simpa using hb)⟩ + · have ha : a ∈ ({x, x + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← he] + simp + have hb : b ∈ ({x, x + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← he] + simp + have lift : ∀ w, w = x ∨ w = x + ⟨0, 1⟩ → + w = x ∨ w = x + 1 ∨ w = x + ⟨0, 1⟩ ∨ w = x + 1 + ⟨0, 1⟩ := by + intro w hw + rcases hw with hw | hw + · exact Or.inl hw + · exact Or.inr (Or.inr (Or.inl hw)) + constructor <;> simp only [FootprintVertices, ite_eq_left hn, Set.mem_ofPred_eq] + · exact ⟨x, hx, lift a (by simpa using ha)⟩ + · exact ⟨x, hx, lift b (by simpa using hb)⟩ + · have ha : a ∈ ({x + 1, x + 1 + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← he] + simp + have hb : b ∈ ({x + 1, x + 1 + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← he] + simp + have lift : ∀ w, w = x + 1 ∨ w = x + 1 + ⟨0, 1⟩ → + w = x ∨ w = x + 1 ∨ w = x + ⟨0, 1⟩ ∨ w = x + 1 + ⟨0, 1⟩ := by + intro w hw + rcases hw with hw | hw + · exact Or.inr (Or.inl hw) + · exact Or.inr (Or.inr (Or.inr hw)) + constructor <;> simp only [FootprintVertices, ite_eq_left hn, Set.mem_ofPred_eq] + · exact ⟨x, hx, lift a (by simpa using ha)⟩ + · exact ⟨x, hx, lift b (by simpa using hb)⟩ + · have ha : a ∈ ({x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← he] + simp + have hb : b ∈ ({x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩} : Finset GaussianInt) := by + rw [← he] + simp + have lift : ∀ w, w = x + ⟨0, 1⟩ ∨ w = x + 1 + ⟨0, 1⟩ → + w = x ∨ w = x + 1 ∨ w = x + ⟨0, 1⟩ ∨ w = x + 1 + ⟨0, 1⟩ := by + intro w hw + rcases hw with hw | hw + · exact Or.inr (Or.inr (Or.inl hw)) + · exact Or.inr (Or.inr (Or.inr hw)) + constructor <;> simp only [FootprintVertices, ite_eq_left hn, Set.mem_ofPred_eq] + · exact ⟨x, hx, lift a (by simpa using ha)⟩ + · exact ⟨x, hx, lift b (by simpa using hb)⟩ + +private theorem qdata : + (by + classical + exact + ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' + : PartialOdometer), (∃ (p : ℝ × ℝ) (p' : ℝ × ℝ), PartialOdometerSlope h = some p ∧ + PartialOdometerSlope h' = some p' ∧ ∃ (q : Fin (4 : ℕ) → CircleCoordinates) (i : Fin + (3 : ℕ)) (e : Bool), ProperBandQuadruple q ∧ q (0 : Fin (4 : ℕ)) = C.1.1 ∧ + TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 : ℝ)) • + GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) ∧ p'.1 - p.1 = (if + e = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (q (0 : Fin (4 : ℕ))) (q + i.succ)).re : ℝ) ∧ p'.2 - p.2 = (if e = true then (1 : ℝ) else (-1 : ℝ)) * + (↑(BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i.succ)).im : ℝ)) → (∃ q : Fin 4 → + CircleCoordinates, ∃ _ : Fin 3, ∃ _ : Bool, ProperBandQuadruple q ∧ q 0 = C.1.1) ) := by + classical + intro C T T' h h' hdata + rcases hdata with ⟨p₀, p₁, hp₀, hp₁, q, i, e, hq, hqC, rest⟩ + exact ⟨q, i, e, hq, hqC⟩ + +private theorem hrootAt310 : + (by + classical + exact + (ℕ) → (∀ (C : BandCircle), (List GaussianInt) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple q) → ((q (0 : Fin (4 : ℕ)) = C.1.1) → (1 < (q 0).1)))) ) := by + classical + intro n C p q hq hqC + have hpq := hq.2 (0 : Fin 3) + have hpos : 0 < (q 0).1 := by simpa only [hqC] using C.property + have hnon := (ProperBandCurvatureStructure q hq).2.1 + have hunique := (ProperBandCurvatureStructure q hq).2.2 + have hnon0 := hnon 0 + have hnon1 := hnon 1 + have hpq1 := hq.2 (1 : Fin 3) + have huniq01 := hunique 0 1 + by_contra hn + have hle : (q 0).1 ≤ 1 := by omega + have hz0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have hz1 : (q (1 : Fin 3).succ).1 = 0 := by omega + have bad := huniq01 hz0 hz1 + omega + +private theorem edgeStepAt328 : + (by + classical + exact + (∀ (U : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), {a, b} ∈ FootprintEdges U → + a ∈ FootprintVertices U ∧ b ∈ FootprintVertices U) → (∀ (n : ℕ), (∀ m < n, (∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : + PartialOdometer), C.1.1.1.toNat + C.1.1.1.toNat = m → RightLatticeAdjacent C T T' h + h' → OdometerCompatibility h h') ∧ ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : + ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : PartialOdometer), + C₀.1.1.1.toNat + Cᵢ.1.1.1.toNat = m → SubtileLatticeAdjacent C₀ Cᵢ T₀ Tᵢ h₀ hᵢ → + OdometerCompatibility h₀ hᵢ) → (∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T' : + ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : PartialOdometer), (C.1.1.1.toNat + + C.1.1.1.toNat = n) → ((TileOdometer C.1.1 T h) → ((TileOdometer C.1.1 T' h') → ((∃ (p + : ℝ × ℝ) (p' : ℝ × ℝ), PartialOdometerSlope h = some p ∧ PartialOdometerSlope h' = + some p' ∧ ∃ (q : Fin (4 : ℕ) → CircleCoordinates) (i : Fin (3 : ℕ)) (e : Bool), + ProperBandQuadruple q ∧ q (0 : Fin (4 : ℕ)) = C.1.1 ∧ TileCentroid T' - TileCentroid + T = (if e = true then (1 : ℝ) else (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 (q (0 + : Fin (4 : ℕ))) (q i.succ)) ∧ p'.1 - p.1 = (if e = true then (1 : ℝ) else (-1 : ℝ)) * + (↑(BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i.succ)).re : ℝ) ∧ p'.2 - p.2 = (if e = + true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (q (0 : Fin (4 : ℕ))) (q + i.succ)).im : ℝ)) → (((h'.domain : Set GaussianInt) = FootprintVertices T') → ((¬((∃ + (g : BandPackingSymmetry) (P : FordFareyParameter), BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = C.1.1) ∨ ∃ (g : BandPackingSymmetry) (K : + DiamondParameter), BandPackingSymmetryCircleAction g (DiamondRecursiveQuadruple K (0 + : Fin (4 : ℕ))) = C.1.1)) → (∀ (p : List GaussianInt), (∀ (e : Finset GaussianInt), e + ∈ FootprintEdges T ∩ FootprintEdges T' ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : + List GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (∀ + (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → ((q (0 : Fin (4 : + ℕ)) = C.1.1) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hsx : Fin (3 : ℕ) → Bool → + PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (S i s) + (hsx i s)) → ((∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ + (S i s).cells) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), FootprintVertices (S i s) ⊆ + FootprintVertices T) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S i s) - + TileCentroid T = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((∀ (x : + GaussianInt), x ∈ h.domain ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (hsx i s).domain) → + ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (hsx i s).domain, h.value x = (hsx i + s).value x) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (q i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ + × ℝ) (p_i : ℝ × ℝ), PartialOdometerSlope h = some p ∧ PartialOdometerSlope (hsx i s) + = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : + ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q + (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (∀ u, ∀ v, ∀ l, ∀ r, p = l ++ u :: v :: r + → ∃ c : ℤ, ∀ z, (z = u ∨ z = v) → z ∈ h'.domain → z ∈ h.domain → h.value z - h'.value + z = c)))))))))))))))))) ) := by + classical + intro edge_endpoints n ih C T T' h h' hn hOT hOT' hdata hdom' hex p hpedges q hq hqC S hsx + hchildren hcells hfoot hcent hdoms hvalues hslopes u v l r hpr + have he : {u, v} ∈ FootprintEdges T ∩ FootprintEdges T' := by + apply (hpedges {u, v}).mpr + exact ⟨u, v, l, r, hpr, rfl⟩ + have heT : {u, v} ∈ FootprintEdges T := he.1 + rcases heT with ⟨a, ha, heq⟩ + rcases heq with heq | heq | heq | heq + all_goals + have hac : ∃ j s, a ∈ (S j s).cells := (hcells a).mp ha + rcases hac with ⟨j, s, has⟩ + have heS : {u, v} ∈ FootprintEdges (S j s) := by + rw [heq] + exact ⟨a, has, by simp⟩ + have hposchild : 0 < (q j.succ).1 := by + have hnonchild := (ProperBandCurvatureStructure q hq).2.1 j + have hchild := hchildren j s + generalize hqj : q j.succ = cj at hchild + have hposcj : 0 < cj.1 := by + by_contra hz + have hnoncj : 0 ≤ cj.1 := by simpa [hqj] using hnonchild + have hz0 : cj.1 = 0 := by omega + generalize hS : S j s = U at hchild heS + revert heS + cases hchild with + | line w z hw k hd => + intro heS + simp [FootprintEdges] at heS + | unit z x U k hU hd ht => intro; omega + | decompose hq' hT' hs' hU hcells' hfoot' hcent' hdom' + hvalue' hcompat' => + have hp' := (ProperBandCurvatureStructure _ hq').1 + intro + omega + simpa [hqj] using hposcj + have hsub : TileSubodometer C.1.1 (q j.succ) + T (S j s) h (hsx j s) := by + refine ⟨hOT, hchildren j s, hfoot j s, ?_, ?_, ?_⟩ + · intro z hz + exact (hdoms z).mpr ⟨j, s, hz⟩ + · exact fun z hz => hvalues j s z hz + · refine ⟨q, j, hq, hqC, rfl, s, hcent j s, ?_⟩ + exact hslopes j s + let Cj : BandCircle := + ⟨⟨q j.succ, + ⟨Or.inl hposchild, ⟨q, hq.1, ⟨j.succ, rfl⟩⟩⟩⟩, + hposchild⟩ + have had0 := ((OdometerAdjacencyInduction.1 C hex).1) T T' h h' + ⟨hOT, hOT', hdata⟩ + have had := had0 (C' := Cj) (T' := S j s) (h' := hsx j s) + (by simpa [Cj] using hsub) ⟨{u, v}, ⟨heS, he.2⟩⟩ + have hlt := hq.2 j + have hltNat : (Int.toNat (q j.succ).1 : Nat) < + Int.toNat (q 0).1 := + (Int.toNat_lt_toNat (by simpa [hqC] using C.property)).2 hlt + have hCeq : Int.toNat C.1.1.1 = Int.toNat (q 0).1 := by + simp [hqC] + have hsum : Int.toNat C.1.1.1 + Int.toNat (q j.succ).1 < + Int.toNat C.1.1.1 + Int.toNat (q 0).1 := + Nat.add_lt_add_left hltNat _ + have hltSum : Int.toNat C.1.1.1 + Int.toNat (q j.succ).1 < n := by + omega + have hltSum' : Int.toNat C.1.1.1 + Int.toNat Cj.1.1.1 < n := by + simpa [Cj] using hltSum + have hcpt := (ih (Int.toNat C.1.1.1 + Int.toNat Cj.1.1.1) + hltSum').2 + C Cj T' (S j s) h' (hsx j s) + (by omega) had + rcases hcpt with hdis | ⟨c, hc⟩ + · exfalso + have hu := edge_endpoints (S j s) u v heS + have hu' := edge_endpoints T' u v he.2 + have huS := (PositiveCurvatureTileOdometerDomain + (q j.succ) (S j s) (hsx j s) hposchild (hchildren j s)).symm ▸ hu.1 + have huT' : u ∈ (h'.domain : Set GaussianInt) := by + rw [hdom'] + exact hu'.1 + exact (Set.disjoint_left.1 hdis) huT' huS + · refine ⟨c, ?_⟩ + intro z hz hz' hz0 + have hzV : z ∈ FootprintVertices (S j s) := by + have hev := edge_endpoints (S j s) u v heS + rcases hz with rfl | rfl + · exact hev.1 + · exact hev.2 + have hzS : z ∈ (hsx j s).domain := by + exact (Set.ext_iff.mp (PositiveCurvatureTileOdometerDomain + (q j.succ) (S j s) (hsx j s) hposchild (hchildren j s)) z).mpr hzV + have hh := hc z hz' hzS + rw [hvalues j s z hzS] + omega + +private theorem hz'At423 : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (p : List GaussianInt), (FootprintVertices T ∩ + FootprintVertices T' = (↑p.toFinset : Set GaussianInt)) → (∀ (z : GaussianInt), (z ∈ + (↑p.toFinset : Set GaussianInt)) → (z ∈ FootprintVertices T ∩ FootprintVertices T')) + ) := by + classical + intro T T' p hpverts z hz + rw [hpverts] + exact hz + +private theorem hzPAt435 : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (p : List GaussianInt), (FootprintVertices T ∩ + FootprintVertices T' = (↑p.toFinset : Set GaussianInt)) → (∀ (z : GaussianInt), (z ∈ + FootprintVertices T ∩ FootprintVertices T') → (z ∈ (p.toFinset : Set GaussianInt))) ) + := by + classical + intro T T' p hpverts z hzV + rw [← hpverts] + exact hzV + +private theorem hrootAt463 : + (by + classical + exact + (ℕ) → (∀ (C₀ : BandCircle), (BandCircle) → ((List GaussianInt) → (∀ (q : Fin (4 : ℕ) → + CircleCoordinates), (ProperBandQuadruple q) → ((q (0 : Fin (4 : ℕ)) = C₀.1.1) → (1 < + (q 0).1))))) ) := by + classical + intro n C₀ Cᵢ p q hq hqC + have hnon := (ProperBandCurvatureStructure q hq).2.1 + have hunique := (ProperBandCurvatureStructure q hq).2.2 + have hnon0 := hnon 0 + have hnon1 := hnon 1 + have hpq0 := hq.2 (0 : Fin 3) + have hpq1 := hq.2 (1 : Fin 3) + have huniq01 := hunique 0 1 + have hpos : 0 < (q 0).1 := by simpa [hqC] using C₀.property + by_contra hn0 + have hle : (q 0).1 ≤ 1 := by omega + have hz0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have hz1 : (q (1 : Fin 3).succ).1 = 0 := by omega + have bad := huniq01 hz0 hz1 + omega + +private theorem edgeStepAt482 : + (by + classical + exact + (∀ (U : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), {a, b} ∈ FootprintEdges U → + a ∈ FootprintVertices U ∧ b ∈ FootprintVertices U) → (∀ (n : ℕ), (∀ m < n, (∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : + PartialOdometer), C.1.1.1.toNat + C.1.1.1.toNat = m → RightLatticeAdjacent C T T' h + h' → OdometerCompatibility h h') ∧ ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : + ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : PartialOdometer), + C₀.1.1.1.toNat + Cᵢ.1.1.1.toNat = m → SubtileLatticeAdjacent C₀ Cᵢ T₀ Tᵢ h₀ hᵢ → + OdometerCompatibility h₀ hᵢ) → (∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : + ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : PartialOdometer), + (C₀.1.1.1.toNat + Cᵢ.1.1.1.toNat = n) → ((TileOdometer C₀.1.1 T₀ h₀) → ((TileOdometer + Cᵢ.1.1 Tᵢ hᵢ) → (((hᵢ.domain : Set GaussianInt) = FootprintVertices Tᵢ) → ((¬((∃ (g : + BandPackingSymmetry) (P : FordFareyParameter), BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = C₀.1.1) ∨ ∃ (g : BandPackingSymmetry) (K : + DiamondParameter), BandPackingSymmetryCircleAction g (DiamondRecursiveQuadruple K (0 + : Fin (4 : ℕ))) = C₀.1.1)) → (∀ (p : List GaussianInt), (∀ (a : GaussianInt), ∀ (b : + GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), p = l₁ ++ a :: b + :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ∨ b = a - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → ((∀ (e : Finset + GaussianInt), e ∈ FootprintEdges T₀ ∩ FootprintEdges Tᵢ ↔ ∃ (a : GaussianInt) (b : + GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ + ∧ e = {a, b}) → (∀ (p₀ : ℝ × ℝ), ∀ (pᵢ : ℝ × ℝ), (PartialOdometerSlope h₀ = some p₀) + → ((PartialOdometerSlope hᵢ = some pᵢ) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ + (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), (ProperBandQuadruple q) → ((q (0 : Fin (4 : + ℕ)) = C₀.1.1) → ((q i.succ = Cᵢ.1.1) → ((TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : + ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) + (q i.succ))) ∧ pᵢ.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ + : GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i.succ)))).1 ∧ pᵢ.2 - p₀.2 = ((1 / 2 : ℝ) • + GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 + (q i.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q + i.succ)))).2) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hsx : Fin (3 : ℕ) → Bool + → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (S i + s) (hsx i s)) → ((∀ (x : LatticeCell), x ∈ T₀.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), + x ∈ (S i s).cells) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), FootprintVertices (S i s) ⊆ + FootprintVertices T₀) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S i s) - + TileCentroid T₀ = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((∀ (x : + GaussianInt), x ∈ h₀.domain ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (hsx i s).domain) → + ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (hsx i s).domain, h₀.value x = (hsx i + s).value x) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (q i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ + × ℝ) (p_i : ℝ × ℝ), PartialOdometerSlope h₀ = some p ∧ PartialOdometerSlope (hsx i s) + = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : + ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = true then (1 : ℝ) else (-1 : + ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q + (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (∀ u, ∀ v, ∀ l, ∀ r, p = l ++ u :: v :: r + → ∃ c : ℤ, ∀ z, (z = u ∨ z = v) → z ∈ hᵢ.domain → z ∈ h₀.domain → hᵢ.value z - + h₀.value z = c)))))))))))))))))))))) ) := by + classical + intro edge_endpoints n ih C₀ Cᵢ T₀ Tᵢ h₀ hᵢ hn hOT0 hOTi hdomi hex p hstep hpedges p₀ pᵢ hp₀ + hpᵢ q i s hq hqC hqI rest S hsx hchildren hcells hfoot hcent hdoms hvalues hslopes u v l r hpr + have he : {u, v} ∈ FootprintEdges T₀ ∩ FootprintEdges Tᵢ := by + apply (hpedges {u, v}).mpr + exact ⟨u, v, l, r, hpr, rfl⟩ + rcases he.1 with ⟨a, ha, heq⟩ + rcases heq with heq | heq | heq | heq + all_goals + have hac : ∃ j t, a ∈ (S j t).cells := (hcells a).mp ha + rcases hac with ⟨j, t, has⟩ + have heS : {u, v} ∈ FootprintEdges (S j t) := by + rw [heq] + exact ⟨a, has, by simp⟩ + have hposchild : 0 < (q j.succ).1 := by + have hnchild := (ProperBandCurvatureStructure q hq).2.1 j + have hchild := hchildren j t + generalize hqj : q j.succ = cj at hchild heS + have hposcj : 0 < cj.1 := by + by_contra hz + have hnoncj : 0 ≤ cj.1 := by simpa [hqj] using hnchild + have hz0 : cj.1 = 0 := by omega + generalize hS : S j t = U at hchild heS + revert heS + cases hchild with + | line w z hw k hd => intro heS; simp [FootprintEdges] at heS + | unit z x U k hU hd ht => intro; omega + | decompose hq' hT' hs' hU hcells' hfoot' hcent' hdom' + hvalue' hcompat' => + have hp' := (ProperBandCurvatureStructure _ hq').1 + intro + omega + simpa [hqj] using hposcj + have hsub : TileSubodometer C₀.1.1 (q j.succ) + T₀ (S j t) h₀ (hsx j t) := by + refine ⟨hOT0, hchildren j t, hfoot j t, ?_, ?_, ?_⟩ + · intro z hz; exact (hdoms z).mpr ⟨j, t, hz⟩ + · exact fun z hz => hvalues j t z hz + · refine ⟨q, j, hq, hqC, rfl, t, hcent j t, ?_⟩ + exact hslopes j t + let Cj : BandCircle := + ⟨⟨q j.succ, ⟨Or.inl hposchild, + ⟨q, hq.1, ⟨j.succ, rfl⟩⟩⟩⟩, hposchild⟩ + have had0 := ((OdometerAdjacencyInduction.1 C₀ hex).2 + Cᵢ Tᵢ T₀ hᵢ h₀ ⟨hOT0, hOTi, ⟨p₀, pᵢ, hp₀, hpᵢ, + q, i, s, hq, hqC, hqI, rest⟩⟩) + have had := had0 (C' := Cj) (T' := S j t) (h' := hsx j t) + (by simpa [Cj] using hsub) (by + refine ⟨u, ?_, ?_⟩ + · exact (Set.ext_iff.mp (PositiveCurvatureTileOdometerDomain + (q j.succ) (S j t) (hsx j t) hposchild (hchildren j t)) u).mpr + (edge_endpoints (S j t) u v heS).1 + · exact (Set.ext_iff.mp hdomi u).mpr + (edge_endpoints Tᵢ u v he.2).1) + have hlt := hq.2 j + have hltNat : (Int.toNat (q j.succ).1 : Nat) < Int.toNat (q 0).1 := + (Int.toNat_lt_toNat (by simpa [hqC] using C₀.property)).2 hlt + have hci : Int.toNat Cᵢ.1.1.1 = Int.toNat (q i.succ).1 := by + simp [hqI] + have hc0 : Int.toNat C₀.1.1.1 = Int.toNat (q 0).1 := by + simp [hqC] + have hcj : Int.toNat Cj.1.1.1 = Int.toNat (q j.succ).1 := by + simp [Cj] + have hltSum : Int.toNat Cᵢ.1.1.1 + Int.toNat (q j.succ).1 < n := by + omega + have hcpt := (ih (Int.toNat Cᵢ.1.1.1 + Int.toNat Cj.1.1.1) + (by simpa [Cj] using hltSum)).2 + have common : ∃ c : ℤ, ∀ z, (z = u ∨ z = v) → + z ∈ hᵢ.domain → z ∈ h₀.domain → hᵢ.value z - h₀.value z = c := by + have child_mem : ∀ z, z = u ∨ z = v → z ∈ (hsx j t).domain := by + intro z hz + have ev := edge_endpoints (S j t) u v heS + rcases hz with hz | hz + · subst z + exact (Set.ext_iff.mp (PositiveCurvatureTileOdometerDomain + (q j.succ) (S j t) (hsx j t) hposchild (hchildren j t)) u).mpr ev.1 + · subst z + exact (Set.ext_iff.mp (PositiveCurvatureTileOdometerDomain + (q j.succ) (S j t) (hsx j t) hposchild (hchildren j t)) v).mpr ev.2 + have outer_mem : ∀ z, z = u ∨ z = v → z ∈ hᵢ.domain := by + intro z hz + have ev := edge_endpoints Tᵢ u v he.2 + rcases hz with hz | hz + · subst z; exact (Set.ext_iff.mp hdomi u).mpr ev.1 + · subst z; exact (Set.ext_iff.mp hdomi v).mpr ev.2 + rcases had with hsingle | had + · exfalso + have eu := edge_endpoints (S j t) u v heS + have ei := edge_endpoints Tᵢ u v he.2 + have eus : u ∈ (hsx j t).domain := child_mem u (Or.inl rfl) + have evs : v ∈ (hsx j t).domain := child_mem v (Or.inr rfl) + have eui : u ∈ hᵢ.domain := (Set.ext_iff.mp hdomi u).mpr ei.1 + have evi : v ∈ hᵢ.domain := (Set.ext_iff.mp hdomi v).mpr ei.2 + have huv := hsingle ⟨eus, eui⟩ ⟨evs, evi⟩ + have hne : u ≠ v := by + intro huv' + subst v + have hh := hstep u u l r hpr + rcases hh with hh | hh | hh | hh + · have hbad := congrArg (fun z : GaussianInt => z.re) hh + norm_num at hbad + · have hbad := congrArg (fun z : GaussianInt => z.re) hh + norm_num at hbad; omega + · have hbad := congrArg (fun z : GaussianInt => z.im) hh + norm_num at hbad + · have hbad := congrArg (fun z : GaussianInt => z.im) hh + norm_num at hbad; omega + exact False.elim (hne huv) + · rcases had with hleft | had + have compat := (LeftAdjacentOdometerCompatibility + Cᵢ Tᵢ (S j t) hᵢ (hsx j t) hleft.2).1 + rcases compat with hd | ⟨c, hc⟩ + · exact False.elim (Set.disjoint_left.1 hd + (outer_mem u (Or.inl rfl)) (child_mem u (Or.inl rfl))) + · refine ⟨-c, ?_⟩ + intro z hz hz0 hz00 + have hzS := child_mem z hz + have hv := hc z (outer_mem z hz) hzS + rw [hvalues j t z hzS] + omega + · rcases had with hsubadj | hrev + · have hh := (ih (Int.toNat Cᵢ.1.1.1 + Int.toNat Cj.1.1.1) + (by omega)).2 Cᵢ Cj Tᵢ (S j t) hᵢ (hsx j t) (by omega) hsubadj + rcases hh with hd | ⟨c, hc⟩ + · exfalso + exact (Set.disjoint_left.1 hd) + (outer_mem u (Or.inl rfl)) (child_mem u (Or.inl rfl)) + · refine ⟨-c, ?_⟩ + intro z hz hz0 hz00 + have hzS := child_mem z hz + have hv := hc z (outer_mem z hz) hzS + rw [hvalues j t z hzS] + omega + · have hh := (ih (Int.toNat Cj.1.1.1 + Int.toNat Cᵢ.1.1.1) + (by omega)).2 Cj Cᵢ (S j t) Tᵢ (hsx j t) hᵢ (by omega) hrev + rcases hh with hd | ⟨c, hc⟩ + · exfalso + exact (Set.disjoint_left.1 hd) + (child_mem u (Or.inl rfl)) (outer_mem u (Or.inl rfl)) + · refine ⟨c, ?_⟩ + intro z hz hz0 hz00 + have hzS := child_mem z hz + have hv := hc z hzS (outer_mem z hz) + rw [hvalues j t z hzS] + exact hv + exact common + +end RightCompatibilityGeometry + +theorem RightSubtileOdometerCompatibility : + (∀ (C : BandCircle) (T T' : ProtoTile) (h h' : PartialOdometer), + RightLatticeAdjacent C T T' h h' → OdometerCompatibility h h') ∧ + ∀ (C₀ Cᵢ : BandCircle) (T₀ Tᵢ : ProtoTile) + (h₀ hᵢ : PartialOdometer), + SubtileLatticeAdjacent C₀ Cᵢ T₀ Tᵢ h₀ hᵢ → + OdometerCompatibility h₀ hᵢ := by +-- BODY + have singleton_case := RightCompatibilityGeometry.singleton_case + have list_glue := RightCompatibilityGeometry.list_glue + have child_circle : ∀ (q : Fin 4 → CircleCoordinates), + ProperBandQuadruple q → ∀ j : Fin 3, 0 < (q j.succ).1 → BandCircle := by + intro q hq j hj + refine ⟨⟨q j.succ, ?_⟩, hj⟩ + exact ⟨Or.inl hj, ⟨q, hq.1, ⟨j.succ, rfl⟩⟩⟩ + have edge_endpoints := RightCompatibilityGeometry.edge_endpoints + have main : ∀ n : Nat, + (∀ (C : BandCircle) (T T' : ProtoTile) (h h' : PartialOdometer), + Int.toNat C.1.1.1 + Int.toNat C.1.1.1 = n → + RightLatticeAdjacent C T T' h h' → OdometerCompatibility h h') ∧ + (∀ (C₀ Cᵢ : BandCircle) (T₀ Tᵢ : ProtoTile) + (h₀ hᵢ : PartialOdometer), + Int.toNat C₀.1.1.1 + Int.toNat Cᵢ.1.1.1 = n → + SubtileLatticeAdjacent C₀ Cᵢ T₀ Tᵢ h₀ hᵢ → + OdometerCompatibility h₀ hᵢ) := by + intro n + induction n using Nat.strong_induction_on with + | h n ih => + constructor + · intro C T T' h h' hn hadj + by_cases hs : ((h.domain : Set GaussianInt) ∩ + (h'.domain : Set GaussianInt)).Subsingleton + · exact singleton_case h h' hs + · rcases hadj with ⟨hOT, hOT', hdata⟩ + have hdom : (h.domain : Set GaussianInt) = FootprintVertices T := + PositiveCurvatureTileOdometerDomain C.1.1 T h C.property hOT + have hdom' : (h'.domain : Set GaussianInt) = FootprintVertices T' := + PositiveCurvatureTileOdometerDomain C.1.1 T' h' C.property hOT' + by_cases hex : + (∃ (g : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = C.1.1) ∨ + (∃ (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K 0) = C.1.1) + · exact ((OdometerAdjacencyInduction).2 C hex).1 T T' h h' + ⟨hOT, hOT', hdata⟩ + · obtain ⟨x, y, path⟩ := + (LatticeAdjacentInterfacePath.1 C T T' h h' + ⟨hOT, hOT', hdata⟩) + rcases path with ⟨p, hpnd, hplen, hhead, hlast, hpverts, hstep, hpedges⟩ + have qdata := RightCompatibilityGeometry.qdata C T T' h h' hdata + rcases qdata with ⟨q, i, e, hq, hqC⟩ + have hroot : 1 < (q 0).1 := RightCompatibilityGeometry.hrootAt310 n C p q hq hqC + obtain ⟨S, hsx, hband, hchildren, hcells, hfoot, hcent, + hdoms, hvalues, hcomps, hslopes⟩ := + TileOdometerReindexedDecomposition q hq T h hroot (by simpa [hqC] using hOT) + have edgeStep := RightCompatibilityGeometry.edgeStepAt328 edge_endpoints n ih C T T' + h h' hn hOT hOT' hdata hdom' hex p hpedges q hq hqC S hsx hchildren hcells hfoot + hcent hdoms hvalues hslopes + obtain ⟨c, hc⟩ := list_glue p h' h hplen edgeStep (by + intro z hz + have hz' : z ∈ FootprintVertices T ∩ FootprintVertices T' := + RightCompatibilityGeometry.hz'At423 T T' p hpverts z hz + constructor + · change z ∈ (h'.domain : Set GaussianInt) + exact hdom'.symm ▸ hz'.2 + · change z ∈ (h.domain : Set GaussianInt) + exact hdom.symm ▸ hz'.1) + exact Or.inr ⟨-c, by + intro z hz0 hz1 + have hzV : z ∈ FootprintVertices T ∩ FootprintVertices T' := by + exact ⟨hdom ▸ hz0, hdom' ▸ hz1⟩ + have hzP := RightCompatibilityGeometry.hzPAt435 T T' p hpverts z hzV + have hv := hc z hzP hz1 hz0 + omega⟩ + · intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ hn hadj + by_cases hs : ((h₀.domain : Set GaussianInt) ∩ + (hᵢ.domain : Set GaussianInt)).Subsingleton + · exact singleton_case h₀ hᵢ hs + · rcases hadj with ⟨hOT0, hOTi, hdata⟩ + have hdom0 : (h₀.domain : Set GaussianInt) = FootprintVertices T₀ := + PositiveCurvatureTileOdometerDomain C₀.1.1 T₀ h₀ C₀.property hOT0 + have hdomi : (hᵢ.domain : Set GaussianInt) = FootprintVertices Tᵢ := + PositiveCurvatureTileOdometerDomain Cᵢ.1.1 Tᵢ hᵢ Cᵢ.property hOTi + by_cases hex : + (∃ (g : BandPackingSymmetry) (P : FordFareyParameter), + BandPackingSymmetryCircleAction g + (FordCircleCoordinate P.p P.q) = C₀.1.1) ∨ + (∃ (g : BandPackingSymmetry) (K : DiamondParameter), + BandPackingSymmetryCircleAction g + (DiamondRecursiveQuadruple K 0) = C₀.1.1) + · exact ((OdometerAdjacencyInduction.2 C₀ hex).2 Cᵢ T₀ Tᵢ h₀ hᵢ + ⟨hOT0, hOTi, hdata⟩) + · obtain ⟨x, y, path⟩ := + (LatticeAdjacentInterfacePath.2 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ + ⟨hOT0, hOTi, hdata⟩) + rcases path with ⟨p, hpnd, hplen, hhead, hlast, hpverts, hstep, hpedges⟩ + rcases hdata with ⟨p₀, pᵢ, hp₀, hpᵢ, q, i, s, hq, hqC, hqI, rest⟩ + have hroot : 1 < (q 0).1 := RightCompatibilityGeometry.hrootAt463 n C₀ Cᵢ p q hq hqC + obtain ⟨S, hsx, hband, hchildren, hcells, hfoot, hcent, + hdoms, hvalues, hcomps, hslopes⟩ := + TileOdometerReindexedDecomposition q hq T₀ h₀ hroot + (by simpa [hqC] using hOT0) + have edgeStep := RightCompatibilityGeometry.edgeStepAt482 edge_endpoints n ih C₀ Cᵢ + T₀ Tᵢ h₀ hᵢ hn hOT0 hOTi hdomi hex p hstep hpedges p₀ pᵢ hp₀ hpᵢ q i s hq hqC hqI + rest S hsx hchildren hcells hfoot hcent hdoms hvalues hslopes + obtain ⟨c, hc⟩ := list_glue p h₀ hᵢ hplen (by + intro u v l r hpr + obtain ⟨d, hd⟩ := edgeStep u v l r hpr + refine ⟨d, ?_⟩ + intro z hz hz0 hzi + have hv := hd z hz hzi hz0 + exact hv) (by + intro z hz + have hz' : z ∈ FootprintVertices T₀ ∩ FootprintVertices Tᵢ := by + rw [hpverts]; exact hz + constructor + · change z ∈ (h₀.domain : Set GaussianInt) + exact hdom0.symm ▸ hz'.1 + · change z ∈ (hᵢ.domain : Set GaussianInt) + exact hdomi.symm ▸ hz'.2) + refine Or.inr ⟨c, ?_⟩ + intro z hz0 hzi + have hzV : z ∈ FootprintVertices T₀ ∩ FootprintVertices Tᵢ := + ⟨hdom0 ▸ hz0, hdomi ▸ hzi⟩ + have hzP : z ∈ (p.toFinset : Set GaussianInt) := by + rw [← hpverts]; exact hzV + exact hc z hzP hz0 hzi + constructor + · intro C T T' h h' hadj + exact main (Int.toNat C.1.1.1 + Int.toNat C.1.1.1) |>.1 C T T' h h' rfl hadj + · intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ hadj + exact main (Int.toNat C₀.1.1.1 + Int.toNat Cᵢ.1.1.1) |>.2 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ rfl hadj + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/RootedFourNeighborForest.lean b/LeanPool/ApollonianSuperharmonic/RootedFourNeighborForest.lean new file mode 100644 index 0000000000..6779d8b18e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/RootedFourNeighborForest.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent + +-- [TABLET NODE: RootedFourNeighborForest] + +/-! +# RootedFourNeighborForest + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A finite induced four-neighbor graph $W$ is a \emph{forest rooted at +$R\subseteq W$} if every nonroot has a parent joined to it by a lattice +edge, ranks strictly increase from parent to child, the rank-zero vertices +are exactly $R$, every root is its own parent, and every edge is a parent +edge. These conditions force each connected component to be a tree +containing exactly one root. +-/ +def RootedFourNeighborForest (W R : Finset GaussianInt) : Prop := +-- BODY + R ⊆ W ∧ ∃ parent : GaussianInt → GaussianInt, ∃ rank : GaussianInt → ℕ, + (∀ r ∈ R, parent r = r) ∧ + (∀ x ∈ W, x ∉ R → + parent x ∈ W ∧ FourNeighborAdjacent (parent x) x ∧ + rank (parent x) < rank x) ∧ + (∀ x ∈ W, x ∈ R ↔ rank x = 0) ∧ + (∀ x ∈ W, ∀ y ∈ W, FourNeighborAdjacent x y → + x = parent y ∨ y = parent x) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SemiProperForestClassification.lean b/LeanPool/ApollonianSuperharmonic/SemiProperForestClassification.lean new file mode 100644 index 0000000000..e25f6b0ef0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SemiProperForestClassification.lean @@ -0,0 +1,154 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple + + +-- [TABLET NODE: SemiProperForestClassification] + +/-! +# SemiProperForestClassification + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem SemiProperForestClassification (q : Fin 4 → CircleCoordinates) + (hq : SemiProperQuadruple q) : + (∀ k : Fin 4, 0 ≤ (q k).1) ∧ + ((∃ z : GaussianInt, q = ![(1, 1 + 2 * z), + (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (0, 1), (0, -1)]) ∨ + (∃ z : GaussianInt, q = ![(1, 1 + 2 * z), + (0, 1), (0, -1), (1, 1 + 2 * z + 2 * ⟨0, 1⟩)]) ∨ + (∃ z : GaussianInt, q = ![(1, 1 + 2 * z), + (0, -1), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (0, 1)]) ∨ + ProperBandQuadruple q) := by +-- BODY + induction hq with + | base z => + constructor + · intro k; fin_cases k <;> simp + · exact Or.inl ⟨z, rfl⟩ + | rotate hq ih => + rcases ih with ⟨nonneg, cases⟩ + constructor + · intro k; fin_cases k <;> simp_all + · rcases cases with root | root | root | proper + · rcases root with ⟨z, hz⟩ + right + left + refine ⟨z, ?_⟩ + rw [hz] + funext k + fin_cases k <;> rfl + · rcases root with ⟨z, hz⟩ + right + right + left + refine ⟨z, ?_⟩ + rw [hz] + funext k + fin_cases k <;> rfl + · rcases root with ⟨z, hz⟩ + left + refine ⟨z, ?_⟩ + rw [hz] + funext k + fin_cases k <;> rfl + · right + right + right + refine ⟨SemiProperQuadruple.rotate proper.1, ?_⟩ + intro j + fin_cases j + · simpa using proper.2 1 + · simpa using proper.2 2 + · simpa using proper.2 0 + | @successor r hr ih => + rcases ih with ⟨nonneg, cases⟩ + constructor + · intro k + rcases cases with root | root | root | proper + · rcases root with ⟨z, hz⟩ + rw [hz] + fin_cases k <;> simp + · rcases root with ⟨z, hz⟩ + rw [hz] + fin_cases k <;> simp + · rcases root with ⟨z, hz⟩ + rw [hz] + fin_cases k <;> simp + · fin_cases k + · have h0 : (r 1).1 < (r 0).1 := by simpa using proper.2 0 + have a := nonneg 0 + have b := nonneg 1 + have c := nonneg 2 + have d := nonneg 3 + dsimp + omega + · exact nonneg 0 + · exact nonneg 2 + · exact nonneg 3 + · rcases cases with root | root | root | proper + · rcases root with ⟨z, hz⟩ + left + refine ⟨z - ⟨0, 1⟩, ?_⟩ + rw [hz] + funext k + fin_cases k <;> simp <;> ring + · rcases root with ⟨z, hz⟩ + right + right + right + change SemiProperQuadruple _ ∧ _ + refine ⟨SemiProperQuadruple.successor hr, ?_⟩ + intro j + fin_cases j <;> rw [hz] <;> simp + · rcases root with ⟨z, hz⟩ + right + right + right + refine ⟨SemiProperQuadruple.successor hr, ?_⟩ + intro j + fin_cases j <;> rw [hz] <;> simp + · right + right + right + change SemiProperQuadruple _ ∧ _ + refine ⟨SemiProperQuadruple.successor proper.1, ?_⟩ + have h0 : (r 1).1 < (r 0).1 := by simpa using proper.2 0 + have h1 : (r 2).1 < (r 0).1 := by simpa using proper.2 1 + have h2 : (r 3).1 < (r 0).1 := by simpa using proper.2 2 + intro j + fin_cases j + · dsimp + have a := nonneg 0 + have b := nonneg 1 + have c := nonneg 2 + have d := nonneg 3 + omega + · dsimp + have a := nonneg 0 + have b := nonneg 1 + have c := nonneg 2 + have d := nonneg 3 + omega + · dsimp + have a := nonneg 0 + have b := nonneg 1 + have c := nonneg 2 + have d := nonneg 3 + omega + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SemiProperQuadruple.lean b/LeanPool/ApollonianSuperharmonic/SemiProperQuadruple.lean new file mode 100644 index 0000000000..11d4951d7c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SemiProperQuadruple.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates + +-- [TABLET NODE: SemiProperQuadruple] + +/-! +# SemiProperQuadruple + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A semi-proper Descartes quadruple is a coordinate quadruple in the directed +forest generated as follows. For every $z\in\mathbb Z[i]$ the clockwise +base quadruple is +$$ + ((1,1+2z),(1,1+2z+2i),(0,1),(0,-1)). +$$ +The class is closed under parent rotation +$(C_0,C_1,C_2,C_3)\mapsto(C_0,C_2,C_3,C_1)$ and under the successor operation +$$ + (C_0,C_1,C_2,C_3)\mapsto + (2(C_0+C_2+C_3)-C_1,C_0,C_2,C_3), +$$ +where both components of curvature coordinates are combined linearly. +Thus this is a predicate on coordinate quadruples, rather than a type of +derivation codes. +-/ +inductive SemiProperQuadruple : (Fin 4 → CircleCoordinates) → Prop where +-- BODY + | base (z : GaussianInt) : + SemiProperQuadruple ![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), + (0, 1), (0, -1)] + | rotate {q : Fin 4 → CircleCoordinates} (hq : SemiProperQuadruple q) : + SemiProperQuadruple ![q 0, q 2, q 3, q 1] + | successor {q : Fin 4 → CircleCoordinates} (hq : SemiProperQuadruple q) : + SemiProperQuadruple + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridCycle.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridCycle.lean new file mode 100644 index 0000000000..c0a0e68bf9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridCycle.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent + +-- [TABLET NODE: SimpleGridCycle] + +/-! +# SimpleGridCycle + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A finite grid graph $(V,E)$ is a *simple grid cycle* when its vertices +have a cyclic listing $p_0,\ldots,p_{n-1}$ without repetition, with +$n\geq4$, every consecutive pair (including $p_{n-1},p_0$) is +four-neighbor adjacent, and $E$ consists exactly of those consecutive +unordered pairs. +-/ +def SimpleGridCycle (V : Set GaussianInt) + (E : Set (Finset GaussianInt)) : Prop := +-- BODY + ∃ p : List GaussianInt, ∃ x y : GaussianInt, + p.Nodup ∧ 4 ≤ p.length ∧ + p.head? = some x ∧ p.getLast? = some y ∧ + V = (p.toFinset : Set GaussianInt) ∧ + FourNeighborAdjacent y x ∧ + (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) ∧ + ∀ e, e ∈ E ↔ e = {y, x} ∨ + ∃ a b : GaussianInt, ∃ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ ∧ e = {a, b} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridCycleSubgraphDegreeTwo.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridCycleSubgraphDegreeTwo.lean new file mode 100644 index 0000000000..0249a3be71 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridCycleSubgraphDegreeTwo.lean @@ -0,0 +1,193 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Combinatorics.SimpleGraph.Matching +public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle + +-- [TABLET NODE: SimpleGridCycleSubgraphDegreeTwo] + +/-! +# SimpleGridCycleSubgraphDegreeTwo + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem SimpleGridCycleSubgraphDegreeTwo + (X W : Set GaussianInt) (E F : Set (Finset GaussianInt)) + (hcycle : SimpleGridCycle W F) + (hX : X ⊆ W) (hE : E ⊆ F) + : + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + ∀ v : X, Set.ncard (G.neighborSet v) ≤ 2 := by +-- BODY + classical + dsimp only + let C : SimpleGraph GaussianInt := SimpleGraph.fromRel fun a b => + ({a, b} : Finset GaussianInt) ∈ F + let G : SimpleGraph X := SimpleGraph.fromRel fun a b => + ({a.1, b.1} : Finset GaussianInt) ∈ E + change ∀ v : X, Set.ncard (G.neighborSet v) ≤ 2 + have pair_eq_iff_sym2 (a b r s : GaussianInt) : + ({a, b} : Finset GaussianInt) = {r, s} ↔ s(a, b) = s(r, s) := by + constructor + · intro h + have hs : ({a, b} : Set GaussianInt) = {r, s} := by + ext t + have ht := congrArg (fun e : Finset GaussianInt => t ∈ e) h + apply Iff.of_eq + simpa only [Finset.mem_insert, Finset.mem_singleton, + Set.mem_insert_iff, Set.mem_singleton_iff] using ht + rw [Set.pair_eq_pair_iff] at hs + simpa [Sym2.eq] using hs + · intro h + simp only [Sym2.eq, Sym2.rel_iff', Prod.mk.injEq, + Prod.swap_prod_mk] at h + rcases h with h | h + · simp [h.1, h.2] + · simp [h.1, h.2, Finset.pair_comm] + obtain ⟨p, x, y, hpNodup, hpLength, hpHead, hpLast, hW, hclose, + hpAdj, hpEdges⟩ := hcycle + have hpne : p ≠ [] := by intro h; simp [h] at hpLength + have hxy : y ≠ x := by + intro h + subst y + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] at hclose + omega + have C_adj_iff (a b : GaussianInt) : + C.Adj a b ↔ a ≠ b ∧ ({a, b} : Finset GaussianInt) ∈ F := by + simp only [C, SimpleGraph.fromRel_adj] + constructor + · rintro ⟨hne, hab | hba⟩ + · exact ⟨hne, hab⟩ + · exact ⟨hne, Finset.pair_comm b a ▸ hba⟩ + · rintro ⟨hne, hab⟩ + exact ⟨hne, Or.inl hab⟩ + have hpChain : List.IsChain C.Adj p := by + rw [List.isChain_iff_forall_rel_of_append_cons_cons] + intro a b l₁ l₂ heq + apply (C_adj_iff a b).mpr + refine ⟨?_, ?_⟩ + · have hadj := hpAdj a b l₁ l₂ heq + intro hab + subst b + simp [FourNeighborAdjacent, Zsqrtd.ext_iff] at hadj + omega + · exact (hpEdges {a, b}).mpr (Or.inr ⟨a, b, l₁, l₂, heq, rfl⟩) + have hx : p.head hpne = x := by + exact (List.head_eq_iff_head?_eq_some hpne).mpr hpHead + have hy : p.getLast hpne = y := by + exact (List.getLast_eq_iff_getLast?_eq_some hpne).mpr hpLast + let q : C.Walk x y := (SimpleGraph.Walk.ofSupport p hpne hpChain).copy hx hy + have hqSupport : q.support = p := by simp [q] + have hqPath : q.IsPath := by + rw [SimpleGraph.Walk.isPath_def, hqSupport] + exact hpNodup + have hcloseAdj : C.Adj y x := + (C_adj_iff y x).mpr ⟨hxy, (hpEdges {y, x}).mpr (Or.inl rfl)⟩ + have hcloseNotMem : s(y, x) ∉ q.edges := by + intro hmem + have hlen := hqPath.length_eq_one_of_mem_edges (Sym2.eq_swap ▸ hmem) + have hqLength : q.length = p.length - 1 := by simp [q] + omega + let d : C.Walk y y := q.cons hcloseAdj + have hdCycle : d.IsCycle := by + change (q.cons hcloseAdj).IsCycle + rw [SimpleGraph.Walk.cons_isCycle_iff] + exact ⟨hqPath, hcloseNotMem⟩ + have hdEdges {a b : GaussianInt} (hab : a ≠ b) : + (({a, b} : Finset GaussianInt) ∈ F ↔ d.toSubgraph.Adj a b) := by + rw [SimpleGraph.Walk.adj_toSubgraph_iff_mem_edges] + simp only [d, SimpleGraph.Walk.edges_cons, List.mem_cons] + rw [hpEdges] + constructor + · intro he + rcases he with he | ⟨r, s, l₁, l₂, heq, hrs⟩ + · left + exact (pair_eq_iff_sym2 a b y x).mp he + · right + rw [SimpleGraph.Walk.edges_eq_zipWith_support, hqSupport] + have adjacent_mem_zip (l₁ l₂ : List GaussianInt) + (r s : GaussianInt) : s(r, s) ∈ + List.zipWith (fun x y => s(x, y)) + (l₁ ++ r :: s :: l₂) (l₁ ++ r :: s :: l₂).tail := by + induction l₁ with + | nil => simp + | cons t l ih => + cases l with + | nil => simp + | cons r' l => + simp only [List.cons_append, List.tail_cons, + List.zipWith_cons_cons, List.mem_cons] + exact Or.inr ih + have hm : s(r, s) ∈ List.zipWith (fun x y => s(x, y)) p p.tail := by + rw [heq] + exact adjacent_mem_zip l₁ l₂ r s + have hsym : s(a, b) = s(r, s) := + (pair_eq_iff_sym2 a b r s).mp hrs + exact hsym ▸ hm + · intro he + rcases he with he | he + · left + exact (pair_eq_iff_sym2 a b y x).mpr he + · right + rw [SimpleGraph.Walk.edges_eq_zipWith_support, hqSupport] at he + rw [List.mem_iff_getElem] at he + obtain ⟨i, hi, hieq⟩ := he + have hi' : i + 1 < p.length := by + simp [List.length_zipWith] at hi + omega + let l₁ := p.take i + let l₂ := p.drop (i + 2) + have hpdecomp : p = l₁ ++ p[i] :: p[i + 1] :: l₂ := by + simp only [l₁, l₂] + calc + p = p.take i ++ p.drop i := (List.take_append_drop i p).symm + _ = p.take i ++ p[i] :: p.drop (i + 1) := by + rw [List.drop_eq_getElem_cons (by omega)] + _ = p.take i ++ p[i] :: p[i + 1] :: p.drop (i + 2) := by + rw [List.drop_eq_getElem_cons hi'] + refine ⟨p[i], p[i + 1], l₁, l₂, hpdecomp, ?_⟩ + have hieq' : s(p[i], p[i + 1]) = s(a, b) := by simpa using hieq + exact (pair_eq_iff_sym2 a b p[i] p[i + 1]).mpr hieq'.symm + intro v + have hvSupport : v.1 ∈ d.support := by + have hvp : v.1 ∈ p := by + have hvW : v.1 ∈ W := hX v.2 + rw [hW] at hvW + simpa using hvW + simp only [d, SimpleGraph.Walk.support_cons, List.mem_cons] + exact Or.inr (hqSupport.symm ▸ hvp) + calc + Set.ncard (G.neighborSet v) ≤ + Set.ncard (d.toSubgraph.neighborSet v.1) := by + apply Set.ncard_le_ncard_of_injOn Subtype.val + (ht := SimpleGraph.Walk.finite_neighborSet_toSubgraph d) + · intro w hw + have hG : G.Adj v w := hw + have hvw : v.1 ≠ w.1 := by + intro h + apply hG.ne + exact Subtype.ext h + apply (hdEdges hvw).mp + have hrel : ({v.1, w.1} : Finset GaussianInt) ∈ E := by + simp only [G, SimpleGraph.fromRel_adj] at hG + rcases hG.2 with hG | hG + · exact hG + · simpa [Finset.pair_comm] using hG + exact hE hrel + · exact Subtype.val_injective.injOn + _ = 2 := hdCycle.ncard_neighborSet_toSubgraph_eq_two hvSupport + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPath.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPath.lean new file mode 100644 index 0000000000..8cbd9956e4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPath.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices + +-- [TABLET NODE: SimpleGridPath] + +/-! +# SimpleGridPath + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A footprint graph $(V,E)$ is a simple nontrivial grid path when its vertices +can be listed without repetition as $p_0,\ldots,p_n$ with $n\geq1$, and its +edges are exactly the unordered pairs $\{p_j,p_{j+1}\}$ of consecutive +vertices. Every consecutive pair must differ by one of $\pm1,\pm i$, so +each displayed pair is an actual unit edge of the Gaussian-integer lattice. +-/ +def SimpleGridPath (V : Set GaussianInt) + (E : Set (Finset GaussianInt)) : Prop := +-- BODY + ∃ p : List GaussianInt, p.Nodup ∧ 2 ≤ p.length ∧ + V = (p.toFinset : Set GaussianInt) ∧ + (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ + b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) ∧ + ∀ e, e ∈ E ↔ ∃ a b : GaussianInt, ∃ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ ∧ e = {a, b} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathBetween.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathBetween.lean new file mode 100644 index 0000000000..638b158d1b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathBetween.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath + +-- [TABLET NODE: SimpleGridPathBetween] + +/-! +# SimpleGridPathBetween + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A footprint graph $(V,E)$ is a simple nontrivial grid path from $x$ to $y$ +when one list $p_0,\ldots,p_n$ without repeated vertices, with $n\geq1$, +simultaneously satisfies $p_0=x$, $p_n=y$, has vertex set exactly $V$, and +has edge set exactly the unordered pairs $\{p_j,p_{j+1}\}$. Every +consecutive pair differs by one of $\pm1,\pm i$. +-/ +def SimpleGridPathBetween (V : Set GaussianInt) + (E : Set (Finset GaussianInt)) (x y : GaussianInt) : Prop := +-- BODY + ∃ p : List GaussianInt, p.Nodup ∧ 2 ≤ p.length ∧ + p.head? = some x ∧ p.getLast? = some y ∧ + V = (p.toFinset : Set GaussianInt) ∧ + (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ + b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) ∧ + ∀ e, e ∈ E ↔ ∃ a b : GaussianInt, ∃ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ ∧ e = {a, b} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean new file mode 100644 index 0000000000..12a05c1f98 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean @@ -0,0 +1,482 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween + +-- [TABLET NODE: SimpleGridPathEndpointPairUnique] + +/-! +# SimpleGridPathEndpointPairUnique + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace EndpointPairProof + +private theorem hpne : + ∀ (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), ∀ (p : List GaussianInt), (p.Nodup) → (((2 : ℕ) ≤ p.length) → ((p.head? = + some x) → ((p.getLast? = some y) → ((V = (↑p.toFinset : Set GaussianInt)) → ((∀ (a : + GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), + p = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + + { re := (0 : ℤ), im := (1 : ℤ) } ∨ b = a - { re := (0 : ℤ), im := (1 : ℤ) }) → ((∀ (e : + Finset GaussianInt), e ∈ E ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (p ≠ + []))))))) := by + classical + intro V E x y p hp hlen hx hy hV hstep hE he + subst p + simp at hlen + +private theorem hqne : + ∀ (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (x' : GaussianInt), ∀ (y' : + GaussianInt), ∀ (q : List GaussianInt), (q.Nodup) → (((2 : ℕ) ≤ q.length) → ((q.head? = + some x') → ((q.getLast? = some y') → ((V = (↑q.toFinset : Set GaussianInt)) → ((∀ (a : + GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), + q = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + + { re := (0 : ℤ), im := (1 : ℤ) } ∨ b = a - { re := (0 : ℤ), im := (1 : ℤ) }) → ((∀ (e : + Finset GaussianInt), e ∈ E ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (q ≠ + []))))))) := by + classical + intro V E x' y' q hq hqlen hx' hy' hV' hstep' hE' he + subst q + simp at hqlen + +private theorem hpform : + ∀ (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), ∀ (p : List GaussianInt), (p.Nodup) → (((2 : ℕ) ≤ p.length) → ((p.head? = + some x) → ((p.getLast? = some y) → ((V = (↑p.toFinset : Set GaussianInt)) → ((∀ (a : + GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), + p = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + + { re := (0 : ℤ), im := (1 : ℤ) } ∨ b = a - { re := (0 : ℤ), im := (1 : ℤ) }) → ((∀ (e : + Finset GaussianInt), e ∈ E ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((p ≠ []) → + (∃ r, p = x :: r)))))))) := by + classical + intro V E x y p hp hlen hx hy hV hstep hE hpne + cases p with + | nil => exact False.elim (hpne rfl) + | cons a r => + simp only [List.head?_cons, Option.some.injEq] at hx + exact ⟨r, by simp [hx]⟩ + +private theorem hqform : + ∀ (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (x' : GaussianInt), ∀ (y' : + GaussianInt), ∀ (q : List GaussianInt), (q.Nodup) → (((2 : ℕ) ≤ q.length) → ((q.head? = + some x') → ((q.getLast? = some y') → ((V = (↑q.toFinset : Set GaussianInt)) → ((∀ (a : + GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), + q = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + + { re := (0 : ℤ), im := (1 : ℤ) } ∨ b = a - { re := (0 : ℤ), im := (1 : ℤ) }) → ((∀ (e : + Finset GaussianInt), e ∈ E ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List + GaussianInt) (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((q ≠ []) → + (∃ r, q = x' :: r)))))))) := by + classical + intro V E x' y' q hq hqlen hx' hy' hV' hstep' hE' hqne + cases q with + | nil => exact False.elim (hqne rfl) + | cons a r => + simp only [List.head?_cons, Option.some.injEq] at hx' + exact ⟨r, by simp [hx']⟩ + +private theorem endpoint_edge : + ∀ (r : List GaussianInt), ∀ (z : GaussianInt), r.Nodup → 2 ≤ r.length → r.head? = some z → + ∀ e : Finset GaussianInt, + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → + z ∈ e → + ∃ t s, r = z :: t :: s ∧ e = {z, t} := by + classical + intro r z hr hrl hz e he hze + rcases he with ⟨a, b, l₁, l₂, hrab, he⟩ + have hmem : z ∈ ({a, b} : Finset GaussianInt) := by simpa [he] using hze + have hcases : z = a ∨ z = b := by simpa using hmem + have hsub : [a, b] <:+: r := by + refine ⟨l₁, l₂, ?_⟩ + simpa [List.cons_append] using hrab.symm + have hrne : r ≠ [] := by + intro hrnil + rw [hrnil] at hrl + simp at hrl + have hzhead : r.head hrne = z := by + simpa [List.head?_eq_some_head hrne] using hz + have hheadmem : r.head hrne ∈ [a, b] := by + rcases hcases with hza | hzb + · simp [hzhead, hza] + · simp [hzhead, hzb] + have hprefix : [a, b] <+: r := + hr.prefix_of_head_mem_of_infix hsub hheadmem + rcases hprefix with ⟨tail, hrtail⟩ + have hab : r = [a, b] ++ tail := hrtail.symm + have hza : z = a := by + rw [hab] at hz + simpa using hz.symm + subst a + refine ⟨b, tail, ?_, ?_⟩ + · simp [hab] + · simpa using he + +private theorem split_mem : + ∀ (r : List GaussianInt), ∀ (z : GaussianInt), z ∈ r → ∃ l t, r = l ++ z :: t := by + classical + intro r z hzmem + induction r with + | nil => simp at hzmem + | cons a r ih => + simp only [List.mem_cons] at hzmem + rcases hzmem with rfl | hzmem + · exact ⟨[], r, rfl⟩ + · rcases ih hzmem with ⟨l, t, ht⟩ + exact ⟨a :: l, t, by simp [ht, List.cons_append]⟩ + +private theorem endpoint_unique : + (∀ (r : List GaussianInt), ∀ (z : GaussianInt), r.Nodup → 2 ≤ r.length → r.head? = some z → ∀ + e : Finset GaussianInt, (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → z ∈ e → ∃ t + s, r = z :: t :: s ∧ e = {z, t}) → (∀ (r : List GaussianInt), ∀ (z : GaussianInt), + r.Nodup → 2 ≤ r.length → r.head? = some z → + ∀ e₁ e₂ : Finset GaussianInt, + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₁ = {a, b}) → + z ∈ e₁ → + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₂ = {a, b}) → + z ∈ e₂ → e₁ = e₂) := by + classical + intro endpoint_edge r z hr hrl hz e₁ e₂ he₁ hze₁ he₂ hze₂ + rcases endpoint_edge r z hr hrl hz e₁ he₁ hze₁ with ⟨t₁, s₁, hr₁, he₁'⟩ + rcases endpoint_edge r z hr hrl hz e₂ he₂ hze₂ with ⟨t₂, s₂, hr₂, he₂'⟩ + have hsame : z :: t₁ :: s₁ = z :: t₂ :: s₂ := hr₁.symm.trans hr₂ + have ht : t₁ = t₂ := by + have htail : t₁ :: s₁ = t₂ :: s₂ := by injection hsame + have hheads := congrArg List.head? htail + simpa using hheads + simp [he₁', he₂', ht] + +private theorem interior_edges : + (∀ (r : List GaussianInt), ∀ (z : GaussianInt), z ∈ r → ∃ l t, r = l ++ z :: t) → (∀ (r : + List GaussianInt), ∀ (z : GaussianInt), ∀ (u : GaussianInt), ∀ (v : GaussianInt), r.Nodup + → r.head? = some u → r.getLast? = some v → + z ∈ r → z ≠ u → z ≠ v → + ∃ e₁ e₂ : Finset GaussianInt, + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₁ = {a, b}) ∧ + z ∈ e₁ ∧ + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₂ = {a, b}) ∧ + z ∈ e₂ ∧ e₁ ≠ e₂) := by + classical + intro split_mem r z u v hr hu hv hz hzu hzv + rcases split_mem r z hz with ⟨l, t, hrt⟩ + have hl : l ≠ [] := by + intro he + subst l + rw [hrt] at hu + simp? at hu + exact hzu hu + have ht : t ≠ [] := by + intro he + subst t + rw [hrt] at hv + simp? at hv + exact hzv hv + let a := l.getLast hl + let l₀ := l.dropLast + have hlt : l₀ ++ [a] = l := List.dropLast_append_getLast hl + obtain ⟨b, t, rfl⟩ := List.exists_cons_of_ne_nil ht + refine ⟨{a, z}, {z, b}, ?_, ?_, ?_, ?_, ?_⟩ + · refine ⟨a, z, l₀, b :: t, ?_, rfl⟩ + calc + r = l ++ z :: b :: t := hrt + _ = (l₀ ++ [a]) ++ z :: b :: t := by rw [hlt] + _ = l₀ ++ a :: z :: b :: t := by simp [List.append_assoc] + · simp + · refine ⟨z, b, l, t, ?_, rfl⟩ + exact hrt + · simp + · intro heq + have hamem : a ∈ ({z, b} : Finset GaussianInt) := by + rw [← heq] + simp + have hab : a = z ∨ a = b := by simpa using hamem + rcases hab with haz | hab + · subst a + have hbad := hr + rw [hrt, ← hlt] at hbad + simp? [List.nodup_append] at hbad + exact hbad.2.1.1.1 haz + · subst b + have hbad := hr + rw [hrt, ← hlt] at hbad + simp [List.nodup_append] at hbad + +private theorem endpoint_class : + ∀ (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), ∀ (p : List GaussianInt), (p.Nodup) → ((p.head? = some x) → ((p.getLast? = + some y) → ((V = (↑p.toFinset : Set GaussianInt)) → ((∀ (e : Finset GaussianInt), e ∈ E ↔ + ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p + = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (∀ (q : List GaussianInt), (q.Nodup) → (((2 : ℕ) ≤ + q.length) → ((V = (↑q.toFinset : Set GaussianInt)) → ((∀ (e : Finset GaussianInt), e ∈ E + ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), + q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((∀ (r : List GaussianInt), ∀ (z : GaussianInt), + r.Nodup → 2 ≤ r.length → r.head? = some z → ∀ e₁ e₂ : Finset GaussianInt, (∃ a b l₁ l₂, r + = l₁ ++ a :: b :: l₂ ∧ e₁ = {a, b}) → z ∈ e₁ → (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₂ + = {a, b}) → z ∈ e₂ → e₁ = e₂) → ((∀ (r : List GaussianInt), ∀ (z : GaussianInt), ∀ (u : + GaussianInt), ∀ (v : GaussianInt), r.Nodup → r.head? = some u → r.getLast? = some v → z ∈ + r → z ≠ u → z ≠ v → ∃ e₁ e₂ : Finset GaussianInt, (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ + e₁ = {a, b}) ∧ z ∈ e₁ ∧ (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₂ = {a, b}) ∧ z ∈ e₂ ∧ e₁ + ≠ e₂) → (∀ z : GaussianInt, + z ∈ q → q.head? = some z → z = x ∨ z = y))))))))))) := by + classical + intro V E x y p hp hx hy hV hE q hq hqlen hV' hE' endpoint_unique interior_edges z hzq hzh + have hzp : z ∈ p := by + have hzset : z ∈ (p.toFinset : Set GaussianInt) := by + rw [← hV, hV'] + simpa [List.mem_toFinset] using hzq + simpa [List.mem_toFinset] using hzset + by_contra hn + push Not at hn + rcases interior_edges p z x y hp hx hy hzp hn.1 hn.2 with + ⟨e₁, e₂, he₁, hze₁, he₂, hze₂, hne⟩ + apply hne + apply endpoint_unique q z hq hqlen hzh e₁ e₂ + · exact (hE' e₁).1 ((hE e₁).2 he₁) + · exact hze₁ + · exact (hE' e₂).1 ((hE e₂).2 he₂) + · exact hze₂ + +private theorem reverse_raw : + ∀ (r : List GaussianInt), ∀ (e : Finset GaussianInt), (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ + e = {a, b}) → + ∃ a b l₁ l₂, r.reverse = l₁ ++ a :: b :: l₂ ∧ e = {a, b} := by + classical + intro r e he + rcases he with ⟨a, b, l₁, l₂, hr, he⟩ + refine ⟨b, a, l₂.reverse, l₁.reverse, ?_, ?_⟩ + · rw [hr] + simp [List.reverse_append, List.append_assoc] + · simpa [Finset.pair_comm] using he + +private theorem endpoint_unique_last : + (∀ (r : List GaussianInt), ∀ (z : GaussianInt), r.Nodup → 2 ≤ r.length → r.head? = some z → ∀ + e₁ e₂ : Finset GaussianInt, (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₁ = {a, b}) → z ∈ e₁ + → (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₂ = {a, b}) → z ∈ e₂ → e₁ = e₂) → ((∀ (r : List + GaussianInt), ∀ (e : Finset GaussianInt), (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e = {a, + b}) → ∃ a b l₁ l₂, r.reverse = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (∀ (r : List + GaussianInt), ∀ (z : GaussianInt), r.Nodup → 2 ≤ r.length → r.getLast? = some z → + ∀ e₁ e₂ : Finset GaussianInt, + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₁ = {a, b}) → + z ∈ e₁ → + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₂ = {a, b}) → + z ∈ e₂ → e₁ = e₂)) := by + classical + intro endpoint_unique reverse_raw r z hr hrl hz e₁ e₂ he₁ hze₁ he₂ hze₂ + have hrevnodup : r.reverse.Nodup := List.nodup_reverse.mpr hr + have hrevlen : 2 ≤ r.reverse.length := by simpa using hrl + have hrevhead : r.reverse.head? = some z := by + simpa using hz + apply endpoint_unique r.reverse z hrevnodup hrevlen hrevhead e₁ e₂ + · exact reverse_raw r e₁ he₁ + · exact hze₁ + · exact reverse_raw r e₂ he₂ + · exact hze₂ + +private theorem endpoint_class_last : + ∀ (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), ∀ (p : List GaussianInt), (p.Nodup) → ((p.head? = some x) → ((p.getLast? = + some y) → ((V = (↑p.toFinset : Set GaussianInt)) → ((∀ (e : Finset GaussianInt), e ∈ E ↔ + ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p + = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (∀ (q : List GaussianInt), (q.Nodup) → (((2 : ℕ) ≤ + q.length) → ((V = (↑q.toFinset : Set GaussianInt)) → ((∀ (e : Finset GaussianInt), e ∈ E + ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), + q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((∀ (r : List GaussianInt), ∀ (z : GaussianInt), ∀ + (u : GaussianInt), ∀ (v : GaussianInt), r.Nodup → r.head? = some u → r.getLast? = some v + → z ∈ r → z ≠ u → z ≠ v → ∃ e₁ e₂ : Finset GaussianInt, (∃ a b l₁ l₂, r = l₁ ++ a :: b :: + l₂ ∧ e₁ = {a, b}) ∧ z ∈ e₁ ∧ (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₂ = {a, b}) ∧ z ∈ e₂ + ∧ e₁ ≠ e₂) → ((∀ (r : List GaussianInt), ∀ (z : GaussianInt), r.Nodup → 2 ≤ r.length → + r.getLast? = some z → ∀ e₁ e₂ : Finset GaussianInt, (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ + ∧ e₁ = {a, b}) → z ∈ e₁ → (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₂ = {a, b}) → z ∈ e₂ → + e₁ = e₂) → (∀ z : GaussianInt, + z ∈ q → q.getLast? = some z → z = x ∨ z = y))))))))))) := by + classical + intro V E x y p hp hx hy hV hE q hq hqlen hV' hE' interior_edges endpoint_unique_last z hzq hzl + have hzp : z ∈ p := by + have hzset : z ∈ (p.toFinset : Set GaussianInt) := by + rw [← hV, hV'] + simpa [List.mem_toFinset] using hzq + simpa [List.mem_toFinset] using hzset + by_contra hn + push Not at hn + rcases interior_edges p z x y hp hx hy hzp hn.1 hn.2 with + ⟨e₁, e₂, he₁, hze₁, he₂, hze₂, hne⟩ + apply hne + apply endpoint_unique_last q z hq hqlen hzl e₁ e₂ + · exact (hE' e₁).1 ((hE e₁).2 he₁) + · exact hze₁ + · exact (hE' e₂).1 ((hE e₂).2 he₂) + · exact hze₂ + +private theorem endpoint_ne : + ∀ (r : List GaussianInt), ∀ (u : GaussianInt), ∀ (v : GaussianInt), r.Nodup → 2 ≤ r.length → + r.head? = some u → + r.getLast? = some v → u ≠ v := by + classical + intro r u v hr hrl hu hv huv + have hrne : r ≠ [] := by + intro he + subst r + simp at hrl + have heq : r.head hrne = r.getLast hrne := by + have hh := List.head?_eq_some_head hrne + have ht := List.getLast?_eq_some_getLast hrne + rw [hh] at hu + rw [ht] at hv + have hhead : r.head hrne = u := by injection hu + have hlast : r.getLast hrne = v := by injection hv + exact hhead.trans (huv.trans hlast.symm) + have hsingle : ∃ w, r = [w] := + (List.Nodup.head_eq_getLast_iff hrne hr).mp heq + rcases hsingle with ⟨w, rfl⟩ + simp at hrl + +private theorem hx'q : + ∀ (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (y : + GaussianInt), ∀ (x' : GaussianInt), ∀ (y' : GaussianInt), ∀ (q : List GaussianInt), + (q.Nodup) → (((2 : ℕ) ≤ q.length) → ((q.head? = some x') → ((q.getLast? = some y') → ((V + = (↑q.toFinset : Set GaussianInt)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : + List GaussianInt), ∀ (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ → b = a + (1 : + GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + { re := (0 : ℤ), im := (1 : ℤ) } ∨ b = + a - { re := (0 : ℤ), im := (1 : ℤ) }) → ((∀ (e : Finset GaussianInt), e ∈ E ↔ ∃ (a : + GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), q = l₁ ++ + a :: b :: l₂ ∧ e = {a, b}) → ((q ≠ []) → ((∃ r, q = x' :: r) → ((∀ z : GaussianInt, z ∈ q + → q.head? = some z → z = x ∨ z = y) → ((∀ z : GaussianInt, z ∈ q → q.getLast? = some z → + z = x ∨ z = y) → (x' ∈ q))))))))))) := by + classical + intro V E x y x' y' q hq hqlen hx' hy' hV' hstep' hE' hqne hqform endpoint_class + endpoint_class_last + cases q with + | nil => simp at hqlen + | cons a r => + simp only [List.head?_cons, Option.some.injEq] at hx' + simp [hx'] + +private theorem hy'q : + ∀ (y' : GaussianInt), ∀ (q : List GaussianInt), (q.getLast? = some y') → ((q ≠ []) → (y' ∈ + q)) := by + classical + intro y' q hy' hqne + have hlast : q.getLast hqne = y' := by + simpa [List.getLast?_eq_some_getLast hqne] using hy' + exact hlast ▸ List.getLast_mem hqne + +private theorem hxclass : + ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (x' : GaussianInt), ∀ (q : List GaussianInt), + (q.head? = some x') → ((∀ z : GaussianInt, z ∈ q → q.head? = some z → z = x ∨ z = y) → + ((x' ∈ q) → (x' = x ∨ x' = y))) := by + classical + intro x y x' q hx' endpoint_class hx'q + exact endpoint_class x' hx'q hx' + +private theorem hyclass : + ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (y' : GaussianInt), ∀ (q : List GaussianInt), + (q.getLast? = some y') → ((∀ z : GaussianInt, z ∈ q → q.getLast? = some z → z = x ∨ z = + y) → ((y' ∈ q) → (y' = x ∨ y' = y))) := by + classical + intro x y y' q hy' endpoint_class_last hy'q + exact endpoint_class_last y' hy'q hy' + +private theorem hxy : + ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (p : List GaussianInt), (p.Nodup) → (((2 : ℕ) ≤ + p.length) → ((p.head? = some x) → ((p.getLast? = some y) → ((∀ (r : List GaussianInt), ∀ + (u : GaussianInt), ∀ (v : GaussianInt), r.Nodup → 2 ≤ r.length → r.head? = some u → + r.getLast? = some v → u ≠ v) → (x ≠ y))))) := by + classical + intro x y p hp hlen hx hy endpoint_ne + exact endpoint_ne p x y hp hlen hx hy + +private theorem hxy' : + ∀ (x' : GaussianInt), ∀ (y' : GaussianInt), ∀ (q : List GaussianInt), (q.Nodup) → (((2 : ℕ) ≤ + q.length) → ((q.head? = some x') → ((q.getLast? = some y') → ((∀ (r : List GaussianInt), + ∀ (u : GaussianInt), ∀ (v : GaussianInt), r.Nodup → 2 ≤ r.length → r.head? = some u → + r.getLast? = some v → u ≠ v) → (x' ≠ y'))))) := by + classical + intro x' y' q hq hqlen hx' hy' endpoint_ne + exact endpoint_ne q x' y' hq hqlen hx' hy' + +end EndpointPairProof + +theorem SimpleGridPathEndpointPairUnique + {V : Set GaussianInt} {E : Set (Finset GaussianInt)} + {x y x' y' : GaussianInt} + (h : SimpleGridPathBetween V E x y) + (h' : SimpleGridPathBetween V E x' y') : + ({x, y} : Finset GaussianInt) = {x', y'} := by +-- BODY + rcases h with ⟨p, hp, hlen, hx, hy, hV, hstep, hE⟩ + rcases h' with ⟨q, hq, hqlen, hx', hy', hV', hstep', hE'⟩ + have hpne : p ≠ [] := EndpointPairProof.hpne V E x y p hp hlen hx hy hV hstep hE + have hqne : q ≠ [] := EndpointPairProof.hqne V E x' y' q hq hqlen hx' hy' hV' hstep' hE' + have hpform : ∃ r, p = x :: r := EndpointPairProof.hpform V E x y p hp hlen hx hy hV hstep hE hpne + have hqform : ∃ r, q = x' :: r := EndpointPairProof.hqform V E x' y' q hq hqlen hx' hy' hV' + hstep' hE' hqne + have endpoint_edge : ∀ (r : List GaussianInt) (z : GaussianInt), + r.Nodup → 2 ≤ r.length → r.head? = some z → + ∀ e : Finset GaussianInt, + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → + z ∈ e → + ∃ t s, r = z :: t :: s ∧ e = {z, t} := EndpointPairProof.endpoint_edge + have split_mem : ∀ (r : List GaussianInt) (z : GaussianInt), + z ∈ r → ∃ l t, r = l ++ z :: t := EndpointPairProof.split_mem + have endpoint_unique : ∀ (r : List GaussianInt) (z : GaussianInt), + r.Nodup → 2 ≤ r.length → r.head? = some z → + ∀ e₁ e₂ : Finset GaussianInt, + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₁ = {a, b}) → + z ∈ e₁ → + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₂ = {a, b}) → + z ∈ e₂ → e₁ = e₂ := EndpointPairProof.endpoint_unique endpoint_edge + have interior_edges : ∀ (r : List GaussianInt) (z u v : GaussianInt), + r.Nodup → r.head? = some u → r.getLast? = some v → + z ∈ r → z ≠ u → z ≠ v → + ∃ e₁ e₂ : Finset GaussianInt, + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₁ = {a, b}) ∧ + z ∈ e₁ ∧ + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₂ = {a, b}) ∧ + z ∈ e₂ ∧ e₁ ≠ e₂ := EndpointPairProof.interior_edges split_mem + have endpoint_class : ∀ z : GaussianInt, + z ∈ q → q.head? = some z → z = x ∨ z = y := EndpointPairProof.endpoint_class V E x y p hp + hx hy hV hE q hq hqlen hV' hE' endpoint_unique interior_edges + have reverse_raw : ∀ (r : List GaussianInt) (e : Finset GaussianInt), + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → + ∃ a b l₁ l₂, r.reverse = l₁ ++ a :: b :: l₂ ∧ e = {a, b} := EndpointPairProof.reverse_raw + have endpoint_unique_last : ∀ (r : List GaussianInt) (z : GaussianInt), + r.Nodup → 2 ≤ r.length → r.getLast? = some z → + ∀ e₁ e₂ : Finset GaussianInt, + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₁ = {a, b}) → + z ∈ e₁ → + (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e₂ = {a, b}) → + z ∈ e₂ → e₁ = e₂ := EndpointPairProof.endpoint_unique_last endpoint_unique reverse_raw + have endpoint_class_last : ∀ z : GaussianInt, + z ∈ q → q.getLast? = some z → z = x ∨ z = y := EndpointPairProof.endpoint_class_last V E x + y p hp hx hy hV hE q hq hqlen hV' hE' interior_edges endpoint_unique_last + have endpoint_ne : ∀ (r : List GaussianInt) (u v : GaussianInt), + r.Nodup → 2 ≤ r.length → r.head? = some u → + r.getLast? = some v → u ≠ v := EndpointPairProof.endpoint_ne + have hx'q : x' ∈ q := EndpointPairProof.hx'q V E x y x' y' q hq hqlen hx' hy' hV' hstep' hE' + hqne hqform endpoint_class endpoint_class_last + have hy'q : y' ∈ q := EndpointPairProof.hy'q y' q hy' hqne + have hxclass : x' = x ∨ x' = y := EndpointPairProof.hxclass x y x' q hx' endpoint_class hx'q + have hyclass : y' = x ∨ y' = y := EndpointPairProof.hyclass x y y' q hy' endpoint_class_last hy'q + have hxy : x ≠ y := EndpointPairProof.hxy x y p hp hlen hx hy endpoint_ne + have hxy' : x' ≠ y' := EndpointPairProof.hxy' x' y' q hq hqlen hx' hy' endpoint_ne + rcases hxclass with rfl | rfl <;> rcases hyclass with rfl | rfl + · exact False.elim (hxy' rfl) + · simp [Finset.pair_comm] + · simp [Finset.pair_comm] + · exact False.elim (hxy' rfl) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean new file mode 100644 index 0000000000..f17d5067d5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean @@ -0,0 +1,317 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianReflection +public import LeanPool.ApollonianSuperharmonic.GaussianTranslation +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath + +-- [TABLET NODE: SimpleGridPathEquivariance] + +/-! +# SimpleGridPathEquivariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace PathEquivariance + +private theorem transport : ∀ (p : List GaussianInt) (f : GaussianInt → GaussianInt), + Function.Injective f → + (∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (f b = f a + 1 ∨ f b = f a - 1 ∨ + f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → + (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ + b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p.map f = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ + b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) := by + classical + intro p f hf hstep hp + induction p with + | nil => + intro a b l₁ l₂ h + cases l₁ <;> cases l₂ <;> simp_all + | cons x xs ih => + cases xs with + | nil => + intro a b l₁ l₂ h + cases l₁ <;> cases l₂ <;> simp_all + | cons y ys => + intro a b l₁ l₂ h + cases l₁ with + | nil => + simp? at h + rcases h with ⟨rfl, rfl, hys⟩ + exact hstep x y (hp x y [] ys (by simp)) + | cons z zs => + simp only [List.map_cons, List.cons_append] at h + have hz : z = f x := by simpa using (congrArg List.head? h).symm + subst z + have htail : (y :: ys).map f = zs ++ a :: b :: l₂ := by + simpa using h + apply ih + · intro c d k m hm + apply hp c d (x :: k) m + simp [hm] + · exact htail + +private theorem forward : ∀ (f : GaussianInt → GaussianInt), Function.Injective f → + (∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (f b = f a + 1 ∨ f b = f a - 1 ∨ + f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → + ∀ V E, SimpleGridPath V E → + SimpleGridPath (f '' V) ((fun e : Finset GaussianInt => e.image f) '' E) := by + classical + have transport : ∀ (p : List GaussianInt) (f : GaussianInt → GaussianInt), + Function.Injective f → + (∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (f b = f a + 1 ∨ f b = f a - 1 ∨ + f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → + (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ + b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p.map f = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ + b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) := transport + intro f hf hstep V E path + rcases path with ⟨p, hnd, hlen, hV, hp, hE⟩ + refine ⟨p.map f, hnd.map hf, ?_, ?_, ?_, ?_⟩ + · simpa using hlen + · rw [hV] + ext z + simp [] + · exact transport p f hf hstep hp + · intro e + constructor + · rintro ⟨d, hd, rfl⟩ + rcases (hE d).mp hd with ⟨a, b, l₁, l₂, hh, he⟩ + refine ⟨f a, f b, l₁.map f, l₂.map f, ?_, ?_⟩ + · simp [hh] + · simp [he] + · rintro ⟨a, b, l₁, l₂, hh, he⟩ + have unmap : ∀ (q : List GaussianInt) (k m : List GaussianInt) + (a b : GaussianInt), + q.map f = k ++ f a :: f b :: m → + ∃ k₀ m₀, q = k₀ ++ a :: b :: m₀ := by + intro q + induction q with + | nil => + intro k m a b h + cases k <;> simp_all + | cons x xs ih => + intro k m a b h + cases k with + | nil => + simp? at h + cases xs with + | nil => simp_all + | cons y ys => + simp? at h + have hxa : x = a := hf h.1 + have hya : y = b := hf h.2.1 + subst a + subst b + exact ⟨[], ys, by simp []⟩ + | cons z zs => + simp? at h + have hz : z = f x := h.1.symm + subst z + rcases ih zs m a b h.2 with ⟨k₀, m₀, hm⟩ + exact ⟨x :: k₀, m₀, by simp [hm]⟩ + have ha : a ∈ p.map f := by rw [hh]; simp + have hb : b ∈ p.map f := by rw [hh]; simp + rcases List.mem_map.mp ha with ⟨a₀, ha₀, haeq⟩ + rcases List.mem_map.mp hb with ⟨b₀, hb₀, hbeq⟩ + rw [← haeq, ← hbeq] at hh he + rcases unmap p l₁ l₂ a₀ b₀ hh with ⟨k, m, hm⟩ + refine ⟨{a₀, b₀}, (hE {a₀, b₀}).mpr ⟨a₀, b₀, k, m, hm, rfl⟩, ?_⟩ + simp [he] + +private theorem backward : ∀ (f g : GaussianInt → GaussianInt), Function.Injective f → + (∀ x, g (f x) = x) → (∀ x, f (g x) = x) → + (∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (g b = g a + 1 ∨ g b = g a - 1 ∨ + g b = g a + ⟨0, 1⟩ ∨ g b = g a - ⟨0, 1⟩)) → + ∀ V E, SimpleGridPath (f '' V) + ((fun e : Finset GaussianInt => e.image f) '' E) → SimpleGridPath V E := by + classical + have forward : ∀ (f : GaussianInt → GaussianInt), Function.Injective f → + (∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (f b = f a + 1 ∨ f b = f a - 1 ∨ + f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → + ∀ V E, SimpleGridPath V E → + SimpleGridPath (f '' V) ((fun e : Finset GaussianInt => e.image f) '' E) := forward + intro f g hf hgf hfg hstep V E h + have result := forward g (by + intro a b hab + simpa [hfg] using congrArg f hab) hstep (f '' V) + ((fun e : Finset GaussianInt => e.image f) '' E) h + simpa [Set.image_image, Finset.image_image, Function.comp_def, hgf, hfg] using result + +end PathEquivariance + +theorem SimpleGridPathEquivariance : + ∀ (V : Set GaussianInt) (E : Set (Finset GaussianInt)) + (u : GaussianInt), + (SimpleGridPath V E ↔ + SimpleGridPath (GaussianTranslation u '' V) + ((fun e : Finset GaussianInt => + e.image (GaussianTranslation u)) '' E)) ∧ + (SimpleGridPath V E ↔ + SimpleGridPath (GaussianQuarterTurn '' V) + ((fun e : Finset GaussianInt => + e.image GaussianQuarterTurn) '' E)) ∧ + (SimpleGridPath V E ↔ + SimpleGridPath (GaussianReflection '' V) + ((fun e : Finset GaussianInt => + e.image GaussianReflection) '' E)) := by +-- BODY + intro V E u + have ht : Function.Injective (GaussianTranslation u) := by + intro a b h + dsimp [GaussianTranslation] at h + exact add_right_cancel h + have hq : Function.Injective GaussianQuarterTurn := by + intro a b h + apply Zsqrtd.ext + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.im) h + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.re) h + have hr : Function.Injective GaussianReflection := by + intro a b h + apply Zsqrtd.ext + · simpa [GaussianReflection] using congrArg (fun z : GaussianInt => z.re) h + · simpa [GaussianReflection] using congrArg (fun z : GaussianInt => -z.im) h + have transport : ∀ (p : List GaussianInt) (f : GaussianInt → GaussianInt), + Function.Injective f → + (∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (f b = f a + 1 ∨ f b = f a - 1 ∨ + f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → + (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ + b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p.map f = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ + b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) := PathEquivariance.transport + have forward : ∀ (f : GaussianInt → GaussianInt), Function.Injective f → + (∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (f b = f a + 1 ∨ f b = f a - 1 ∨ + f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → + ∀ V E, SimpleGridPath V E → + SimpleGridPath (f '' V) ((fun e : Finset GaussianInt => e.image f) '' E) := + PathEquivariance.forward + have backward : ∀ (f g : GaussianInt → GaussianInt), Function.Injective f → + (∀ x, g (f x) = x) → (∀ x, f (g x) = x) → + (∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (g b = g a + 1 ∨ g b = g a - 1 ∨ + g b = g a + ⟨0, 1⟩ ∨ g b = g a - ⟨0, 1⟩)) → + ∀ V E, SimpleGridPath (f '' V) + ((fun e : Finset GaussianInt => e.image f) '' E) → SimpleGridPath V E := + PathEquivariance.backward + let qb : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + have hqb : Function.Injective qb := by + intro a b h + apply Zsqrtd.ext + · simpa [qb] using congrArg (fun z : GaussianInt => z.im) h + · simpa [qb] using congrArg (fun z : GaussianInt => z.re) h + have transStep : ∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (GaussianTranslation u b = GaussianTranslation u a + 1 ∨ + GaussianTranslation u b = GaussianTranslation u a - 1 ∨ + GaussianTranslation u b = GaussianTranslation u a + ⟨0, 1⟩ ∨ + GaussianTranslation u b = GaussianTranslation u a - ⟨0, 1⟩) := by + intro a b h + rcases h with h | h | h | h + · subst b; left; apply Zsqrtd.ext <;> simp [GaussianTranslation]; abel + · subst b; right; left; apply Zsqrtd.ext <;> simp [GaussianTranslation]; abel + · subst b; right; right; left; apply Zsqrtd.ext <;> simp [GaussianTranslation]; abel + · subst b; right; right; right; apply Zsqrtd.ext <;> simp [GaussianTranslation]; abel + have transBack : ∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + ((GaussianTranslation (-u)) b = GaussianTranslation (-u) a + 1 ∨ + (GaussianTranslation (-u)) b = GaussianTranslation (-u) a - 1 ∨ + (GaussianTranslation (-u)) b = GaussianTranslation (-u) a + ⟨0, 1⟩ ∨ + (GaussianTranslation (-u)) b = GaussianTranslation (-u) a - ⟨0, 1⟩) := by + intro a b h + rcases h with h | h | h | h + · subst b; left; apply Zsqrtd.ext <;> simp [GaussianTranslation]; abel + · subst b; right; left; apply Zsqrtd.ext <;> simp [GaussianTranslation]; abel + · subst b; right; right; left; apply Zsqrtd.ext <;> simp [GaussianTranslation]; abel + · subst b; right; right; right; apply Zsqrtd.ext <;> simp [GaussianTranslation]; abel + have transInv₁ : ∀ x, GaussianTranslation (-u) (GaussianTranslation u x) = x := by + intro x + simp [GaussianTranslation, add_assoc, add_comm] + have transInv₂ : ∀ x, GaussianTranslation u (GaussianTranslation (-u) x) = x := by + intro x + simp [GaussianTranslation, add_comm] + have quarterInv₁ : ∀ x, qb (GaussianQuarterTurn x) = x := by + intro x; apply Zsqrtd.ext <;> simp [qb, GaussianQuarterTurn] + have quarterInv₂ : ∀ x, GaussianQuarterTurn (qb x) = x := by + intro x; apply Zsqrtd.ext <;> simp [qb, GaussianQuarterTurn] + have reflInv : ∀ x, GaussianReflection (GaussianReflection x) = x := by + intro x; apply Zsqrtd.ext <;> simp [GaussianReflection] + have reflStep : ∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (GaussianReflection b = GaussianReflection a + 1 ∨ GaussianReflection b = + GaussianReflection a - 1 ∨ + GaussianReflection b = GaussianReflection a + ⟨0, 1⟩ ∨ GaussianReflection b = + GaussianReflection a - ⟨0, 1⟩) := by + intro a b h; rcases h with h | h | h | h + · subst b; left; apply Zsqrtd.ext <;> simp [GaussianReflection] + · subst b; right; left; apply Zsqrtd.ext <;> simp [GaussianReflection] + · subst b; right; right; right; apply Zsqrtd.ext <;> simp [GaussianReflection]; abel + · subst b; right; right; left; apply Zsqrtd.ext <;> simp [GaussianReflection]; abel + have quarterStep : ∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (GaussianQuarterTurn b = GaussianQuarterTurn a + 1 ∨ GaussianQuarterTurn b = + GaussianQuarterTurn a - 1 ∨ + GaussianQuarterTurn b = GaussianQuarterTurn a + ⟨0, 1⟩ ∨ GaussianQuarterTurn b = + GaussianQuarterTurn a - ⟨0, 1⟩) := by + intro a b h; rcases h with h | h | h | h + · subst b; right; right; left; apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + · subst b; right; right; right; apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + · subst b; right; left; apply Zsqrtd.ext <;> simp [GaussianQuarterTurn]; abel + · subst b; left; apply Zsqrtd.ext <;> simp [GaussianQuarterTurn]; abel + have quarterBackStep : ∀ a b : GaussianInt, + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + (qb b = qb a + 1 ∨ qb b = qb a - 1 ∨ qb b = qb a + ⟨0, 1⟩ ∨ qb b = qb a - ⟨0, 1⟩) := by + intro a b h; rcases h with h | h | h | h + · subst b; right; right; right; apply Zsqrtd.ext <;> simp [qb]; abel + · subst b; right; right; left; apply Zsqrtd.ext <;> simp [qb]; abel + · subst b; left; apply Zsqrtd.ext <;> simp [qb] + · subst b; right; left; apply Zsqrtd.ext <;> simp [qb] + exact ⟨⟨fun h => forward (GaussianTranslation u) ht transStep V E h, + fun h => backward (GaussianTranslation u) (GaussianTranslation (-u)) ht transInv₁ transInv₂ + transBack V E h⟩, + ⟨fun h => forward GaussianQuarterTurn hq quarterStep V E h, + fun h => backward GaussianQuarterTurn qb hq quarterInv₁ quarterInv₂ quarterBackStep V E h⟩, + ⟨fun h => forward GaussianReflection hr reflStep V E h, + fun h => backward GaussianReflection GaussianReflection hr reflInv reflInv reflStep V E h⟩⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathPointTrichotomy.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathPointTrichotomy.lean new file mode 100644 index 0000000000..cd7187eb23 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathPointTrichotomy.lean @@ -0,0 +1,124 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween + +-- [TABLET NODE: SimpleGridPathPointTrichotomy] + +/-! +# SimpleGridPathPointTrichotomy + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +lemma SimpleGridPathPointTrichotomy + (V : Set GaussianInt) (E : Set (Finset GaussianInt)) + (a b x : GaussianInt) + (hpath : SimpleGridPathBetween V E a b) + (hincident : ∃ e : Finset GaussianInt, x ∈ e ∧ e ∈ E) : + x = a ∨ x = b ∨ + ∃ e f : Finset GaussianInt, + e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ e ∈ E ∧ f ∈ E := by +-- BODY + rcases hpath with ⟨p, hp, hlen, hhead, hlast, hV, hstep, hE⟩ + rcases hincident with ⟨e, hxe, heE⟩ + rcases (hE e).1 heE with ⟨u, v, l₁, l₂, hraw, heq⟩ + have hxlist : x ∈ p := by + have hxpair : x ∈ ({u, v} : Finset GaussianInt) := by + rw [← heq] + exact hxe + have hxuv : x = u ∨ x = v := by simpa using hxpair + rcases hxuv with rfl | rfl + · rw [hraw] + simp + · rw [hraw] + simp + have hpne : p ≠ [] := by + intro hpnil + have hzero : (2 : Nat) ≤ 0 := by simpa only [hpnil, List.length_nil] using hlen + omega + have hfirst : ∀ z : GaussianInt, p.head? = some z → p = z :: p.tail := by + intro z hz + cases p with + | nil => exact False.elim (hpne rfl) + | cons q r => + simp only [List.head?_cons, Option.some.injEq] at hz + subst q + rfl + have split_mem : ∀ (r : List GaussianInt) (z : GaussianInt), + z ∈ r → ∃ l t, r = l ++ z :: t := by + intro r z hz + induction r with + | nil => simp at hz + | cons q r ih => + simp only [List.mem_cons] at hz + rcases hz with rfl | hz + · exact ⟨[], r, rfl⟩ + · rcases ih hz with ⟨l, t, ht⟩ + exact ⟨q :: l, t, by simp [ht, List.cons_append]⟩ + have hxa : x = a ∨ x ≠ a := eq_or_ne x a + rcases hxa with rfl | hxa + · exact Or.inl rfl + have hxb : x = b ∨ x ≠ b := eq_or_ne x b + rcases hxb with rfl | hxb + · exact Or.inr (Or.inl rfl) + rcases split_mem p x hxlist with ⟨l, t, hsplit⟩ + have hl : l ≠ [] := by + intro hnil + have hheadx : p.head? = some x := by + rw [hsplit, hnil] + simp + have hhead_eq : x = a := by simpa [hheadx] using hhead + exact hxa hhead_eq + have ht : t ≠ [] := by + intro hnil + have hlastx : p.getLast? = some x := by + rw [hsplit, hnil] + simp + have hlast_eq : x = b := by simpa [hlastx] using hlast + exact hxb hlast_eq + let z := l.getLast hl + let l₀ := l.dropLast + have hlt : l₀ ++ [z] = l := by + exact List.dropLast_append_getLast hl + obtain ⟨w, t₀, htform⟩ := List.exists_cons_of_ne_nil ht + have he₁ : ({z, x} : Finset GaussianInt) ∈ E := by + apply (hE {z, x}).2 + refine ⟨z, x, l₀, w :: t₀, ?_, rfl⟩ + rw [hsplit, ← hlt, htform] + simp [List.append_assoc] + have he₂ : ({x, w} : Finset GaussianInt) ∈ E := by + apply (hE {x, w}).2 + refine ⟨x, w, l, t₀, ?_, rfl⟩ + rw [hsplit, htform] + refine Or.inr (Or.inr ⟨{z, x}, {x, w}, ?_, by simp, by simp, he₁, he₂⟩) + intro heq' + have hzmem : z ∈ ({x, w} : Finset GaussianInt) := by + rw [← heq'] + simp + have hzw : z = x ∨ z = w := by simpa using hzmem + have hznotx : z ≠ x := by + intro hzx + have hbad := hp + rw [hsplit, ← hlt, htform] at hbad + simp? [List.nodup_append] at hbad + exact hbad.2.1.1.1 hzx + rcases hzw with hzx | hzw + · exact hznotx hzx + · subst w + have hbad := hp + rw [hsplit, ← hlt, htform] at hbad + simp [List.nodup_append] at hbad + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathVertexIncidentEdge.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathVertexIncidentEdge.lean new file mode 100644 index 0000000000..d19b3077ab --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathVertexIncidentEdge.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath + +-- [TABLET NODE: SimpleGridPathVertexIncidentEdge] + +/-! +# SimpleGridPathVertexIncidentEdge + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem SimpleGridPathVertexIncidentEdge + (V : Set GaussianInt) (E : Set (Finset GaussianInt)) + (hpath : SimpleGridPath V E) (x : GaussianInt) (hx : x ∈ V) : + ∃ e : Finset GaussianInt, x ∈ e ∧ e ∈ E := by +-- BODY + rcases hpath with ⟨p, hp, hlen, hV, hstep, hE⟩ + have hxlist : x ∈ p := by + rw [hV] at hx + simpa using hx + have split_mem : ∀ (r : List GaussianInt) (z : GaussianInt), + z ∈ r → ∃ l t, r = l ++ z :: t := by + intro r z hz + induction r with + | nil => simp at hz + | cons q r ih => + simp only [List.mem_cons] at hz + rcases hz with rfl | hz + · exact ⟨[], r, rfl⟩ + · rcases ih hz with ⟨l, t, ht⟩ + exact ⟨q :: l, t, by simp [ht, List.cons_append]⟩ + rcases split_mem p x hxlist with ⟨l, t, hsplit⟩ + by_cases ht : t = [] + · subst t + have hl : l ≠ [] := by + intro hl + subst l + rw [hsplit] at hlen + simp at hlen + let z := l.getLast hl + let l₀ := l.dropLast + have hlt : l₀ ++ [z] = l := List.dropLast_append_getLast hl + refine ⟨{z, x}, by simp, (hE {z, x}).2 ?_⟩ + refine ⟨z, x, l₀, [], ?_, rfl⟩ + rw [← hlt] at hsplit + simpa [List.append_assoc] using hsplit + · obtain ⟨z, t₀, rfl⟩ := List.exists_cons_of_ne_nil ht + refine ⟨{x, z}, by simp, (hE {x, z}).2 ?_⟩ + exact ⟨x, z, l, t₀, hsplit, rfl⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SixSubtileFaceLabel.lean b/LeanPool/ApollonianSuperharmonic/SixSubtileFaceLabel.lean new file mode 100644 index 0000000000..6b91b584f0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SixSubtileFaceLabel.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: SixSubtileFaceLabel] + +/-! +# SixSubtileFaceLabel + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The fixed six-occurrence periodic layout has twelve face-orbit labels. The +four inner labels are $I_1,I_2,I_3,I_4$, and the eight outer labels are +$J_1,\ldots,J_8$. In particular, $J_5$ is the face called `F10` +in the coverage audit. +-/ +inductive SixSubtileFaceLabel : Type where +-- BODY + | I1 | I2 | I3 | I4 + | J1 | J2 | J3 | J4 | J5 | J6 | J7 | J8 + deriving DecidableEq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SixSubtileFaceVertices.lean b/LeanPool/ApollonianSuperharmonic/SixSubtileFaceVertices.lean new file mode 100644 index 0000000000..3aa651dea9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SixSubtileFaceVertices.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileFaceIndex +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex + +-- [TABLET NODE: SixSubtileFaceVertices] + +/-! +# SixSubtileFaceVertices + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The three vertices of each translated face in the six-occurrence layout are +the following periodic subtile indices: +$$ +\begin{array}{c|c@{\qquad}c|c} +I_1&(A,B,C)&I_2&(A,B,D)\\ +I_3&(A,C,F)&I_4&(B,D,E)\\ +J_1&(A,B_{0,1},E_{0,1})&J_2&(A,B_{0,1},F)\\ +J_3&(A,B_{1,1},C_{1,1})&J_4&(A,B_{1,1},D)\\ +J_5&(A,C_{1,1},E_{0,1})&J_6&(B,D_{-1,-1},F_{0,-1})\\ +J_7&(C,D_{-1,0},E_{-1,0})&J_8&(C,D_{-1,0},F). +\end{array} +$$ +For the face indexed by $(H,m,n)$, $(m,n)$ is added to every subscript in +the row. Thus translation acts on the entire face rather than on one +displayed vertex. +-/ +def SixSubtileFaceVertices (f : PeriodicSubtileFaceIndex) : + Fin 3 -> PeriodicSubtileIndex := +-- BODY + let m := f.first + let n := f.second + match f.label with + | .I1 => ![⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩] + | .I2 => ![⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.D, m, n⟩] + | .I3 => ![⟨.A, m, n⟩, ⟨.C, m, n⟩, ⟨.F, m, n⟩] + | .I4 => ![⟨.B, m, n⟩, ⟨.D, m, n⟩, ⟨.E, m, n⟩] + | .J1 => ![⟨.A, m, n⟩, ⟨.B, m, n + 1⟩, ⟨.E, m, n + 1⟩] + | .J2 => ![⟨.A, m, n⟩, ⟨.B, m, n + 1⟩, ⟨.F, m, n⟩] + | .J3 => ![⟨.A, m, n⟩, ⟨.B, m + 1, n + 1⟩, + ⟨.C, m + 1, n + 1⟩] + | .J4 => ![⟨.A, m, n⟩, ⟨.B, m + 1, n + 1⟩, ⟨.D, m, n⟩] + | .J5 => ![⟨.A, m, n⟩, ⟨.C, m + 1, n + 1⟩, ⟨.E, m, n + 1⟩] + | .J6 => ![⟨.B, m, n⟩, ⟨.D, m - 1, n - 1⟩, ⟨.F, m, n - 1⟩] + | .J7 => ![⟨.C, m, n⟩, ⟨.D, m - 1, n⟩, ⟨.E, m - 1, n⟩] + | .J8 => ![⟨.C, m, n⟩, ⟨.D, m - 1, n⟩, ⟨.F, m, n⟩] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SixSubtileLabel.lean b/LeanPool/ApollonianSuperharmonic/SixSubtileLabel.lean new file mode 100644 index 0000000000..29dbac99d2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SixSubtileLabel.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: SixSubtileLabel] + +/-! +# SixSubtileLabel + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The six labels for a tile decomposition are +$$ + A=T_1^+,\quad B=T_1^-,\quad C=T_2^+,\quad D=T_2^-,\quad + E=T_3^+,\quad F=T_3^-. +$$ +They are combinatorial labels and do not themselves assert any geometric +intersection. +-/ +inductive SixSubtileLabel : Type where +-- BODY + | A | B | C | D | E | F + deriving DecidableEq + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/StandardSimplex.lean b/LeanPool/ApollonianSuperharmonic/StandardSimplex.lean new file mode 100644 index 0000000000..5325ecf728 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/StandardSimplex.lean @@ -0,0 +1,31 @@ +/- +Copyright (c) 2019 Alexander Bentkamp. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Alexander Bentkamp, Yury Kudryashov, Yaël Dillies, Joël Riou +-/ +module + +public import Mathlib.Basic.Real.Basic +public import Mathlib.Algebra.BigOperators.Group.Finset.Defs + +/-! +# Finite standard simplices + +The geometric constructions use the standard simplex as a subset of a finite-dimensional +function space, preserving the set-based domain of the upstream formalization. +This specializes the set definition in `Mathlib.Analysis.Convex.StdSimplex`. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open scoped BigOperators + +/-- The nonnegative real weights of total mass one on a finite index type. -/ +def StandardSimplex (ι : Type*) [Fintype ι] : Set (ι → Real) := + {weights | (∀ i, 0 ≤ weights i) ∧ ∑ i, weights i = 1} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacent.lean b/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacent.lean new file mode 100644 index 0000000000..63f7ae7ee3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacent.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileOdometer + +-- [TABLET NODE: SubtileLatticeAdjacent] + +/-! +# SubtileLatticeAdjacent + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Let $C_i$ be a positive-curvature parent of $C_0$ in a proper quadruple. +A tile odometer $h_i$ for $C_i$ is subtile-lattice adjacent to a tile +odometer $h_0$ for $C_0$ when both slopes are defined and, for some +$s\in\{0,1,2,3\}$, +$$ + \operatorname{cent}(T(h_i))-\operatorname{cent}(T(h_0)) + =i^s\tfrac12(v_{i0}+v_{0i}), +$$ +$$ + \operatorname{slope}(h_i)-\operatorname{slope}(h_0) + =(-i)^s\tfrac12(a_{i0}+a_{0i}). +$$ +The ordering of the arguments is part of the definition: subtile-lattice +adjacency is not symmetric. Curvature-zero parents are excluded because +their singleton odometers have no slope. +-/ +def SubtileLatticeAdjacent (C₀ Cᵢ : BandCircle) (T₀ Tᵢ : ProtoTile) + (h₀ hᵢ : PartialOdometer) : Prop := +-- BODY + TileOdometer C₀.1.1 T₀ h₀ ∧ TileOdometer Cᵢ.1.1 Tᵢ hᵢ ∧ + ∃ p₀ pᵢ : ℝ × ℝ, + PartialOdometerSlope h₀ = some p₀ ∧ + PartialOdometerSlope hᵢ = some pᵢ ∧ + ∃ q : Fin 4 → CircleCoordinates, ∃ i : Fin 3, ∃ s : Fin 4, + ProperBandQuadruple q ∧ q 0 = C₀.1.1 ∧ q i.succ = Cᵢ.1.1 ∧ + TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ))) ∧ + pᵢ.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).1 ∧ + pᵢ.2 - p₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean new file mode 100644 index 0000000000..f7f175c6b9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean @@ -0,0 +1,465 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: SubtileLatticeAdjacentPackingSymmetryTransport] + +/-! +# SubtileLatticeAdjacentPackingSymmetryTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SubtileTransportGeometry + +private theorem rotation_transport : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (s : Fin 4), ∀ (negative : Bool), ∀ (x : GaussianInt × + GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let P := fun (k : Fin 4) (y : GaussianInt × GaussianInt) => + (I ^ k.val * (y.1 + I * y.1), (-I) ^ k.val * (y.2 + -I * y.2)) + let s' := if BandPackingSymmetryReversesOrientation g then + -s - 1 + (if negative then (2 : Fin 4) else 0) + else s + (if negative then (2 : Fin 4) else 0) + BandPackingSymmetryAffineVectorAction g (P s x) = + P s' (if negative then -BandPackingSymmetryAffineVectorAction g x + else BandPackingSymmetryAffineVectorAction g x) ) := by + classical + intro g s negative x + let I : GaussianInt := ⟨0, 1⟩ + let R := fun y : GaussianInt × GaussianInt => (I * y.1, -I * y.2) + have Rneg (y : GaussianInt × GaussianInt) : R (-y) = -R y := by + ext <;> simp [R] + have facts : ∀ a : BandPackingSymmetry, + (∀ y z, BandPackingSymmetryAffineVectorAction a (y + z) = + BandPackingSymmetryAffineVectorAction a y + BandPackingSymmetryAffineVectorAction a z) ∧ + (∀ y, BandPackingSymmetryAffineVectorAction a (-y) = + -BandPackingSymmetryAffineVectorAction a y) ∧ + (∀ y, BandPackingSymmetryAffineVectorAction a (R y) = + if BandPackingSymmetryReversesOrientation a then + -R (BandPackingSymmetryAffineVectorAction a y) + else R (BandPackingSymmetryAffineVectorAction a y)) := by + intro a + induction a with + | identity => exact ⟨fun _ _ => rfl, fun _ => rfl, fun _ => rfl⟩ + | shift w => + rcases w with ⟨wr, wi⟩ + refine ⟨?_, ?_, ?_⟩ + · rintro ⟨⟨vr, vi⟩, ⟨ar, ai⟩⟩ ⟨⟨ur, ui⟩, ⟨br, bi⟩⟩ + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianReflection] <;> ring + · rintro ⟨⟨vr, vi⟩, ⟨ar, ai⟩⟩ + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianReflection] <;> ring + · rintro ⟨⟨vr, vi⟩, ⟨ar, ai⟩⟩ + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianReflection, + BandPackingSymmetryReversesOrientation, R, I]; ring + | negate => + refine ⟨?_, ?_, ?_⟩ + · intro y z + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianQuarterTurn] <;> ring + · intro y + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianQuarterTurn] + · intro y + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianQuarterTurn, + BandPackingSymmetryReversesOrientation, R, I] + | conjugate => + refine ⟨?_, ?_, ?_⟩ + · intro y z + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianReflection] <;> ring + · intro y + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianReflection] + · intro y + ext <;> simp [BandPackingSymmetryAffineVectorAction, GaussianReflection, + BandPackingSymmetryReversesOrientation, R, I] + | comp a b iha ihb => + refine ⟨?_, ?_, ?_⟩ + · intro y z + change BandPackingSymmetryAffineVectorAction a + (BandPackingSymmetryAffineVectorAction b (y + z)) = _ + rw [ihb.1, iha.1] + rfl + · intro y + change BandPackingSymmetryAffineVectorAction a + (BandPackingSymmetryAffineVectorAction b (-y)) = _ + rw [ihb.2.1, iha.2.1] + rfl + · intro y + change BandPackingSymmetryAffineVectorAction a + (BandPackingSymmetryAffineVectorAction b (R y)) = _ + rw [ihb.2.2] + cases ha : BandPackingSymmetryReversesOrientation a <;> + cases hb : BandPackingSymmetryReversesOrientation b <;> + simp [ha, hb, iha.2.1, iha.2.2, + BandPackingSymmetryReversesOrientation, BandPackingSymmetryAffineVectorAction] + let P := fun (k : Fin 4) (y : GaussianInt × GaussianInt) => + (I ^ k.val * (y.1 + I * y.1), (-I) ^ k.val * (y.2 + -I * y.2)) + let B := fun (k : Fin 4) (y : GaussianInt × GaussianInt) => + match k.val with + | 0 => y + R y + | 1 => R y + -y + | 2 => -(y + R y) + | _ => y + -(R y) + have PB (k : Fin 4) (y : GaussianInt × GaussianInt) : P k y = B k y := by + fin_cases k <;> ext <;> simp [P, B, R, I, pow_succ] <;> ring + change BandPackingSymmetryAffineVectorAction g (P s x) = P _ _ + rw [PB, PB] + fin_cases s <;> cases negative <;> + cases he : BandPackingSymmetryReversesOrientation g + all_goals norm_num [B, he, (facts g).1, (facts g).2.1, (facts g).2.2, Rneg, + Fin.val_neg', Fin.sub_def, Fin.add_def] + all_goals ext <;> simp [R, I] <;> ring + +private theorem support_nonempty : + (by + classical + exact + ∀ (C : CircleCoordinates), ∀ (U : ProtoTile), ∀ (h : PartialOdometer), ∀ (p : ℝ × ℝ), 0 < + C.1 → TileOdometer C U h → PartialOdometerSlope h = some p → U.cells.Nonempty ) := by + classical + intro C U h p hpos hO hp + have hd := PositiveCurvatureTileOdometerDomain C U h hpos hO + by_contra hn + have hde : (h.domain : Set GaussianInt) = {U.anchor} := by + rw [hd] + simp [FootprintVertices, hn] + have hs : (PartialOdometerSquares h).Nonempty := by + by_contra hs + simp [PartialOdometerSlope, hs] at hp + rcases hs with ⟨x, hx⟩ + simp only [PartialOdometerSquares, Finset.mem_filter] at hx + have hz : x + 1 = U.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.2.1 + have hz0 : x = U.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.1 + have hzbad := congrArg (fun z : GaussianInt => z.re) (hz.trans hz0.symm) + norm_num at hzbad + +private theorem hsr₀ : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (T₀ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (p₀ : ℝ × + ℝ), (PartialOdometerSlope h₀ = some p₀) → ((Finset.Nonempty T₀.cells) → + ((Finset.Nonempty T₀.cells → PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction g h₀) = Option.map + (BandPackingSymmetrySlopeAction g T₀) (PartialOdometerSlope h₀)) → + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h₀) = some + (BandPackingSymmetrySlopeAction g T₀ p₀)))) ) := by + classical + intro g T₀ h₀ p₀ hp₀ hT₀ne hST₀ + simpa [Option.map] using (hST₀ hT₀ne).trans + (congrArg (Option.map (BandPackingSymmetrySlopeAction g T₀)) hp₀) + +private theorem hsrᵢ : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (Tᵢ : ProtoTile), ∀ (hᵢ : PartialOdometer), ∀ (pᵢ : ℝ × + ℝ), (PartialOdometerSlope hᵢ = some pᵢ) → ((Finset.Nonempty Tᵢ.cells) → + ((Finset.Nonempty Tᵢ.cells → PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction g hᵢ) = Option.map + (BandPackingSymmetrySlopeAction g Tᵢ) (PartialOdometerSlope hᵢ)) → + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g hᵢ) = some + (BandPackingSymmetrySlopeAction g Tᵢ pᵢ)))) ) := by + classical + intro g Tᵢ hᵢ pᵢ hpᵢ hTᵢne hSTᵢ + simpa [Option.map] using (hSTᵢ hTᵢne).trans + (congrArg (Option.map (BandPackingSymmetrySlopeAction g Tᵢ)) hpᵢ) + +private theorem incoming : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ + (negative : Bool), (BandPackingSymmetryScopedPhase g q negative) → ((∀ (i : Fin (3 : + ℕ)), + let e := if negative = true then (-1 : GaussianInt) else (1 : GaussianInt); + let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : + Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); + let cyclic := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 + : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ + BandVectors.2 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : + ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if + BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : + ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation g = true then + -GaussianQuarterTurn cyclic.2 else cyclic.2) → ((∀ (g : BandPackingSymmetry), ∀ (z : + GaussianInt × GaussianInt), (BandPackingSymmetryAffineVectorAction g z).1 = + BandPackingSymmetryVectorAction g z.1) → ( + let q' := BandPackingSymmetryQuadrupleAction g q + let j : Fin 3 := if BandPackingSymmetryReversesOrientation g then -i else i + let V := BandVectors.1 (q i.succ) (q 0) + let A := BandVectors.2 (q i.succ) (q 0) + let V' := BandVectors.1 (q' j.succ) (q' 0) + let A' := BandVectors.2 (q' j.succ) (q' 0) + (V', A') = if negative then -BandPackingSymmetryAffineVectorAction g (V, A) else + BandPackingSymmetryAffineVectorAction g (V, A)))) ) := by + classical + intro g q i negative hphase hvec affine_first q' j V A V' A' + have hv := (hphase i).1 + have ha := (hvec i).1 + change V' = (if negative then (-1 : GaussianInt) else 1) * + BandPackingSymmetryVectorAction g V at hv + change A' = (if negative then (-1 : GaussianInt) else 1) * + (BandPackingSymmetryAffineVectorAction g (V, A)).2 at ha + apply Prod.ext + · cases negative <;> simpa [affine_first] using hv + · cases negative <;> simpa using ha + +private theorem hrot : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin + 4), + let P := fun (k : Fin 4) (z : GaussianInt × GaussianInt) => + ((⟨0, 1⟩ : GaussianInt) ^ k.val * (z.1 + (⟨0, 1⟩ : GaussianInt) * z.1), + (-⟨0, 1⟩ : GaussianInt) ^ k.val * (z.2 + (-⟨0, 1⟩ : GaussianInt) * z.2)) + ∀ (negative : Bool), + let s' : Fin 4 := if BandPackingSymmetryReversesOrientation g then + -s - 1 + (if negative then (2 : Fin 4) else 0) + else s + (if negative then (2 : Fin 4) else 0) + (∀ (g : BandPackingSymmetry), ∀ (s : Fin 4), ∀ (negative : Bool), ∀ (x : GaussianInt × + GaussianInt), + let I : GaussianInt := ⟨0, 1⟩ + let P := fun (k : Fin 4) (y : GaussianInt × GaussianInt) => + (I ^ k.val * (y.1 + I * y.1), (-I) ^ k.val * (y.2 + -I * y.2)) + let s' := if BandPackingSymmetryReversesOrientation g then + -s - 1 + (if negative then (2 : Fin 4) else 0) + else s + (if negative then (2 : Fin 4) else 0) + BandPackingSymmetryAffineVectorAction g (P s x) = + P s' (if negative then -BandPackingSymmetryAffineVectorAction g x + else BandPackingSymmetryAffineVectorAction g x)) → ( + let q' := BandPackingSymmetryQuadrupleAction g q + let j : Fin 3 := if BandPackingSymmetryReversesOrientation g then -i else i + let V := BandVectors.1 (q i.succ) (q 0) + let A := BandVectors.2 (q i.succ) (q 0) + let V' := BandVectors.1 (q' j.succ) (q' 0) + let A' := BandVectors.2 (q' j.succ) (q' 0) + ((V', A') = if negative then -BandPackingSymmetryAffineVectorAction g (V, A) else + BandPackingSymmetryAffineVectorAction g (V, A)) → + (BandPackingSymmetryAffineVectorAction g (P s (V, A)) = P s' (V', A'))) ) := by + classical + intro g q i s P negative s' rotation_transport q' j V A V' A' incoming + have hr := rotation_transport g s negative (V, A) + change BandPackingSymmetryAffineVectorAction g (P s (V, A)) = + P s' (if negative then -BandPackingSymmetryAffineVectorAction g (V, A) + else BandPackingSymmetryAffineVectorAction g (V, A)) at hr + rw [← incoming] at hr + exact hr + +private theorem hc : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (T₀ : ProtoTile), ∀ + (Tᵢ : ProtoTile), (TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (q + i.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)))) → ( + let V := BandVectors.1 (q i.succ) (q 0) + let A := BandVectors.2 (q i.succ) (q 0) + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) + (q i.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (q i.succ) (q (0 : + Fin (4 : ℕ)))) → ( + let P := fun (k : Fin 4) (z : GaussianInt × GaussianInt) => + ((⟨0, 1⟩ : GaussianInt) ^ k.val * (z.1 + (⟨0, 1⟩ : GaussianInt) * z.1), + (-⟨0, 1⟩ : GaussianInt) ^ k.val * (z.2 + (-⟨0, 1⟩ : GaussianInt) * z.2)) + TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (P s (V, A)).1)) ) := by + classical + intro q i s T₀ Tᵢ hcent V A hflip P + simpa only [P, Prod.fst, V, hflip.1] using hcent + +private theorem hp : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (p₀ : ℝ × ℝ), ∀ (pᵢ : + ℝ × ℝ), (pᵢ.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i.succ)))).1) → ((pᵢ.2 - p₀.2 = ((1 / 2 : ℝ) • + GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 + (q i.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q + i.succ)))).2) → ( + let V := BandVectors.1 (q i.succ) (q 0) + let A := BandVectors.2 (q i.succ) (q 0) + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) + (q i.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (q i.succ) (q (0 : + Fin (4 : ℕ)))) → ( + let P := fun (k : Fin 4) (z : GaussianInt × GaussianInt) => + ((⟨0, 1⟩ : GaussianInt) ^ k.val * (z.1 + (⟨0, 1⟩ : GaussianInt) * z.1), + (-⟨0, 1⟩ : GaussianInt) ^ k.val * (z.2 + (-⟨0, 1⟩ : GaussianInt) * z.2)) + pᵢ - p₀ = (1 / 2 : ℝ) • GaussianRealPoint (P s (V, A)).2))) ) := by + classical + intro q i s p₀ pᵢ hslopeRe hslopeIm V A hflip P + apply Prod.ext + · simpa [P, A, hflip.2] using hslopeRe + · simpa [P, A, hflip.2] using hslopeIm + +end SubtileTransportGeometry + +theorem SubtileLatticeAdjacentPackingSymmetryTransport + (g : BandPackingSymmetry) (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) (i : Fin 3) (s : Fin 4) + (hparent : 0 < (q i.succ).1) + (T₀ Tᵢ : ProtoTile) (h₀ hᵢ : PartialOdometer) (p₀ pᵢ : ℝ × ℝ) + (hO₀ : TileOdometer (q 0) T₀ h₀) + (hOᵢ : TileOdometer (q i.succ) Tᵢ hᵢ) + (hp₀ : PartialOdometerSlope h₀ = some p₀) + (hpᵢ : PartialOdometerSlope hᵢ = some pᵢ) + (hcent : TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.1 (q i.succ) (q 0) + + BandVectors.1 (q 0) (q i.succ)))) + (hslopeRe : pᵢ.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).1) + (hslopeIm : pᵢ.2 - p₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s.val * + (BandVectors.2 (q i.succ) (q 0) + + BandVectors.2 (q 0) (q i.succ)))).2) : + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + ∃ negative : Bool, ∃ r₀ rᵢ : ℝ × ℝ, ∃ s' : Fin 4, + BandPackingSymmetryScopedPhase g q negative ∧ + s' = (if BandPackingSymmetryReversesOrientation g then + -s - 1 + (if negative then (2 : Fin 4) else 0) + else s + (if negative then (2 : Fin 4) else 0)) ∧ + TileOdometer (q' 0) (BandPackingSymmetryTileAction g T₀) + (BandPackingSymmetryPartialOdometerAction g h₀) ∧ + TileOdometer (q' (sigma i).succ) (BandPackingSymmetryTileAction g Tᵢ) + (BandPackingSymmetryPartialOdometerAction g hᵢ) ∧ + PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction g h₀) = some r₀ ∧ + PartialOdometerSlope + (BandPackingSymmetryPartialOdometerAction g hᵢ) = some rᵢ ∧ + TileCentroid (BandPackingSymmetryTileAction g Tᵢ) - + TileCentroid (BandPackingSymmetryTileAction g T₀) = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s'.val * + (BandVectors.1 (q' (sigma i).succ) (q' 0) + + BandVectors.1 (q' 0) (q' (sigma i).succ))) ∧ + rᵢ.1 - r₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s'.val * + (BandVectors.2 (q' (sigma i).succ) (q' 0) + + BandVectors.2 (q' 0) (q' (sigma i).succ)))).1 ∧ + rᵢ.2 - r₀.2 = ((1 / 2 : ℝ) • GaussianRealPoint + ((-⟨0, 1⟩ : GaussianInt) ^ s'.val * + (BandVectors.2 (q' (sigma i).succ) (q' 0) + + BandVectors.2 (q' 0) (q' (sigma i).succ)))).2 ∧ + (OdometerCompatibility + (BandPackingSymmetryPartialOdometerAction g h₀) + (BandPackingSymmetryPartialOdometerAction g hᵢ) ↔ + OdometerCompatibility h₀ hᵢ) := by +-- BODY + classical + dsimp + have difference_transport := P5625T1CentroidSlopeDifferenceCovariance.2 + -- The same phase changes the two rotated coordinates. + have rotation_transport := SubtileTransportGeometry.rotation_transport + obtain ⟨negative, hphase, hvec⟩ := + BandPackingSymmetryAffineVectorCovariance g q hq + have support_nonempty := SubtileTransportGeometry.support_nonempty + have hT₀ne := support_nonempty (q 0) T₀ h₀ p₀ + (ProperBandCurvatureStructure q hq).1 hO₀ hp₀ + have hTᵢne := support_nonempty (q i.succ) Tᵢ hᵢ pᵢ hparent hOᵢ hpᵢ + obtain ⟨hOT₀, _, hST₀⟩ := + BandPackingSymmetryTileOdometerCovariance g (q 0) T₀ h₀ hO₀ + obtain ⟨hOTᵢ, _, hSTᵢ⟩ := + BandPackingSymmetryTileOdometerCovariance g (q i.succ) Tᵢ hᵢ hOᵢ + have hsr₀ := SubtileTransportGeometry.hsr₀ g T₀ h₀ p₀ hp₀ hT₀ne hST₀ + have hsrᵢ := SubtileTransportGeometry.hsrᵢ g Tᵢ hᵢ pᵢ hpᵢ hTᵢne hSTᵢ + have affine_first := P5625T1CentroidSlopeDifferenceCovariance.1 + let q' := BandPackingSymmetryQuadrupleAction g q + let j : Fin 3 := if BandPackingSymmetryReversesOrientation g then -i else i + let V := BandVectors.1 (q i.succ) (q 0) + let A := BandVectors.2 (q i.succ) (q 0) + let V' := BandVectors.1 (q' j.succ) (q' 0) + let A' := BandVectors.2 (q' j.succ) (q' 0) + have incoming := SubtileTransportGeometry.incoming g q i negative hphase hvec affine_first + have hproper := BandPackingSymmetryProperCovariance g q hq + have hflip := (VectorRecursionLaws q hq.1).2.2.2.2 hq i + have hflip' := (VectorRecursionLaws q' hproper.1).2.2.2.2 hproper j + let P := fun (k : Fin 4) (z : GaussianInt × GaussianInt) => + ((⟨0, 1⟩ : GaussianInt) ^ k.val * (z.1 + (⟨0, 1⟩ : GaussianInt) * z.1), + (-⟨0, 1⟩ : GaussianInt) ^ k.val * (z.2 + (-⟨0, 1⟩ : GaussianInt) * z.2)) + let s' : Fin 4 := if BandPackingSymmetryReversesOrientation g then + -s - 1 + (if negative then (2 : Fin 4) else 0) + else s + (if negative then (2 : Fin 4) else 0) + have hrot : BandPackingSymmetryAffineVectorAction g (P s (V, A)) = + P s' (V', A') := SubtileTransportGeometry.hrot g q i s negative rotation_transport incoming + have hc := SubtileTransportGeometry.hc q i s T₀ Tᵢ hcent hflip + have hp := SubtileTransportGeometry.hp q i s p₀ pᵢ hslopeRe hslopeIm hflip + have ht := difference_transport g T₀ Tᵢ pᵢ p₀ + (P s (V, A)).1 (P s (V, A)).2 (1 / 2 : ℝ) hc hp + change TileCentroid (BandPackingSymmetryTileAction g Tᵢ) - + TileCentroid (BandPackingSymmetryTileAction g T₀) = + (1 / 2 : ℝ) • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g (P s (V, A))).1 ∧ + BandPackingSymmetrySlopeAction g Tᵢ pᵢ - + BandPackingSymmetrySlopeAction g T₀ p₀ = + (1 / 2 : ℝ) • GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g (P s (V, A))).2 at ht + rw [hrot] at ht + have neg1 : -(1 : Fin 3) = 2 := rfl + have neg2 : -(2 : Fin 3) = 1 := rfl + refine ⟨negative, BandPackingSymmetrySlopeAction g T₀ p₀, + BandPackingSymmetrySlopeAction g Tᵢ pᵢ, s', hphase, rfl, + ?_, ?_, hsr₀, hsrᵢ, ?_, ?_, ?_, ?_⟩ + · simpa [BandPackingSymmetryQuadrupleAction] using hOT₀ + · cases he : BandPackingSymmetryReversesOrientation g <;> fin_cases i <;> + simpa [BandPackingSymmetryQuadrupleAction, he, neg1, neg2] using hOTᵢ + · simpa only [P, Prod.fst, V', q', j, hflip'.1] using ht.1 + · simpa [P, A', q', j, hflip'.2] using congrArg Prod.fst ht.2 + · simpa [P, A', q', j, hflip'.2] using congrArg Prod.snd ht.2 + · exact (BandPackingSymmetryPartialOdometerActionFormulas g h₀ hᵢ).2.2.2.2.2.2.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretation.lean b/LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretation.lean new file mode 100644 index 0000000000..7dc85daa21 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretation.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex +public import LeanPool.ApollonianSuperharmonic.TileTranslation + +-- [TABLET NODE: SubtileOccurrenceInterpretation] + +/-! +# SubtileOccurrenceInterpretation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Given six signed occurrences $S_i^\pm$ and two period vectors $u,v$, the +geometric interpretation of $(X,m,n)$ is the translate by $mu+nv$ of the +occurrence selected by +$$ + A=S_1^+,\quad B=S_1^-,\quad C=S_2^+,\quad D=S_2^-,\quad + E=S_3^+,\quad F=S_3^-. +$$ +This interpretation applies without change to the Ford configuration, +where $E,F$ are anchored empty line occurrences, and to the diamond +configuration, where the six occurrences include the two unit-parent pairs +and the predecessor pair. +-/ +def SubtileOccurrenceInterpretation (S : Fin 3 → Bool → ProtoTile) + (u v : GaussianInt) (o : PeriodicSubtileIndex) : ProtoTile := +-- BODY + let T := match o.label with + | .A => S 0 true + | .B => S 0 false + | .C => S 1 true + | .D => S 1 false + | .E => S 2 true + | .F => S 2 false + TileTranslation T ((o.first : GaussianInt) * u + (o.second : GaussianInt) * v) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretationCovariance.lean b/LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretationCovariance.lean new file mode 100644 index 0000000000..9828b2e2da --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretationCovariance.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.GaussianReflection +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: SubtileOccurrenceInterpretationCovariance] + +/-! +# SubtileOccurrenceInterpretationCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem SubtileOccurrenceInterpretationCovariance + (S : Fin 3 → Bool → ProtoTile) (u v a : GaussianInt) + (o : PeriodicSubtileIndex) : + TileTranslation (SubtileOccurrenceInterpretation S u v o) a = + SubtileOccurrenceInterpretation + (fun i s => TileTranslation (S i s) a) u v o ∧ + TileQuarterTurn (SubtileOccurrenceInterpretation S u v o) = + SubtileOccurrenceInterpretation + (fun i s => TileQuarterTurn (S i s)) + (GaussianQuarterTurn u) (GaussianQuarterTurn v) o ∧ + TileReflection (SubtileOccurrenceInterpretation S u v o) = + SubtileOccurrenceInterpretation + (fun i s => TileReflection (S i s)) + (GaussianReflection u) (GaussianReflection v) o := by +-- BODY + have translation_commute : ∀ (T : ProtoTile) (x y : GaussianInt), + TileTranslation (TileTranslation T x) y = + TileTranslation (TileTranslation T y) x := by + intro T x y + cases T with + | mk cells anchor => + have map : (fun z : GaussianInt => (z + x) + y) = + (fun z : GaussianInt => (z + y) + x) := by + funext z + simp [add_comm, add_left_comm] + apply congrArg₂ (fun c : FiniteTile => fun d : GaussianInt => + ProtoTile.mk c d) + · simp [TileTranslation, GaussianTranslation, Finset.image_image, + Function.comp_def, map] + · simp [TileTranslation, GaussianTranslation, add_comm, + add_left_comm] + have quarter_commute : ∀ (T : ProtoTile) (x : GaussianInt), + TileQuarterTurn (TileTranslation T x) = + TileTranslation (TileQuarterTurn T) (GaussianQuarterTurn x) := by + intro T x + cases T with + | mk cells anchor => + have map : (fun z : GaussianInt => GaussianQuarterTurn (z + x) - 1) = + (fun z : GaussianInt => (GaussianQuarterTurn z - 1) + + GaussianQuarterTurn x) := by + funext z + ext <;> simp [GaussianQuarterTurn, add_comm]; ring + apply congrArg₂ (fun c : FiniteTile => fun d : GaussianInt => + ProtoTile.mk c d) + · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, + Finset.image_image, Function.comp_def, map] + · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, + GaussianQuarterTurn, add_comm] + have reflection_commute : ∀ (T : ProtoTile) (x : GaussianInt), + TileReflection (TileTranslation T x) = + TileTranslation (TileReflection T) (GaussianReflection x) := by + intro T x + cases T with + | mk cells anchor => + have map : (fun z : GaussianInt => GaussianReflection (z + x) - + ⟨0, 1⟩) = + (fun z : GaussianInt => (GaussianReflection z - ⟨0, 1⟩) + + GaussianReflection x) := by + funext z + ext <;> simp [GaussianReflection, add_comm]; ring + apply congrArg₂ (fun c : FiniteTile => fun d : GaussianInt => + ProtoTile.mk c d) + · simp [TileReflection, TileTranslation, GaussianTranslation, + Finset.image_image, Function.comp_def, map] + · simp [TileReflection, TileTranslation, GaussianTranslation, + GaussianReflection, add_comm] + have quarter_linear : ∀ (m n : Int) (x y : GaussianInt), + GaussianQuarterTurn (m * x + n * y) = + m * GaussianQuarterTurn x + n * GaussianQuarterTurn y := by + intro m n x y + ext <;> simp [GaussianQuarterTurn]; ring + have reflection_linear : ∀ (m n : Int) (x y : GaussianInt), + GaussianReflection (m * x + n * y) = + m * GaussianReflection x + n * GaussianReflection y := by + intro m n x y + ext <;> simp [GaussianReflection]; ring + cases o with + | mk label first second => + cases label <;> + simp? [SubtileOccurrenceInterpretation] + <;> rw [translation_commute] + <;> rw [quarter_commute] + <;> rw [reflection_commute] + <;> simp [quarter_linear, reflection_linear] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SufficientBoundedMaximality.lean b/LeanPool/ApollonianSuperharmonic/SufficientBoundedMaximality.lean new file mode 100644 index 0000000000..58df13499b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SufficientBoundedMaximality.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundedDifference +public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.P4849T1MinimumTruncation +public import LeanPool.ApollonianSuperharmonic.P4849T1ComponentRestriction +public import LeanPool.ApollonianSuperharmonic.P4849T1PeriodResidues +public import LeanPool.ApollonianSuperharmonic.P4849T1LargePositiveComponents +public import LeanPool.ApollonianSuperharmonic.P4849T1PeriodAnchoring +public import LeanPool.ApollonianSuperharmonic.P4849T1SetDiagonalSubsequence +public import LeanPool.ApollonianSuperharmonic.P4849T1LocalLimitAdmissibility +public import LeanPool.ApollonianSuperharmonic.P4849T1InfiniteLimitComponent +public import Mathlib.Order.Int.LeastGreatest + +-- [TABLET NODE: SufficientBoundedMaximality] + +/-! +# SufficientBoundedMaximality + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem SufficientBoundedMaximality (g : IntegerLatticeFunction) + (hlap : ∀ x, FourNeighborLaplacian g x ≤ 1) + (hperiod : ∃ u v : GaussianInt, + u.re * v.im - u.im * v.re ≠ 0 ∧ + (∀ x, FourNeighborLaplacian g (x + u) = FourNeighborLaplacian g x) ∧ + ∀ x, FourNeighborLaplacian g (x + v) = FourNeighborLaplacian g x) + (hrigid : ∀ X : Set GaussianInt, X.Infinite → FourNeighborConnected X → + (∀ x, FourNeighborLaplacian + (fun y => g y + Set.indicator X (fun _ => (1 : ℤ)) y) x ≤ 1) → + X = Set.univ) : + ∀ f : IntegerLatticeFunction, (∀ x, g x ≤ f x) → + (∀ x, FourNeighborLaplacian f x ≤ 1) → BoundedDifference f g := by +-- BODY + classical + intro f hfg hflap + by_contra hnot + obtain ⟨m, ⟨z₀, hz₀⟩, hmin⟩ := Int.exists_least_of_bdd + (P := fun t => ∃ x, f x - g x = t) + ⟨0, by rintro t ⟨x, rfl⟩; exact sub_nonneg.mpr (hfg x)⟩ + ⟨f 0 - g 0, 0, rfl⟩ + let q : IntegerLatticeFunction := fun x => f x - m - g x + have hq (x : GaussianInt) : 0 ≤ q x := by + have := hmin (f x - g x) ⟨x, rfl⟩ + dsimp [q] + omega + have hzero : ∃ z, q z = 0 := ⟨z₀, by dsimp [q]; omega⟩ + have hunbounded : ∀ B : ℤ, ∃ x, B < q x := by + intro B + by_contra hb + push Not at hb + apply hnot + refine ⟨(B + m).natAbs, ?_⟩ + intro x + have hx := hb x + have hn := sub_nonneg.mpr (hfg x) + have heq := Int.natAbs_of_nonneg hn + have hB := Int.le_natAbs (a := B + m) + dsimp [q] at hx + omega + have hplus : ∀ x, FourNeighborLaplacian (fun y => g y + q y) x ≤ 1 := by + intro x + have h := hflap x + simp only [FourNeighborLaplacian, q] at h ⊢ + linarith + have hS := P4849T1MinimumTruncation g q hlap hq hplus + obtain ⟨u, v, hdet, hu, hv⟩ := hperiod + obtain ⟨R, hres, hper⟩ := + P4849T1PeriodResidues (FourNeighborLaplacian g) u v hdet hu hv + let M : ℕ := ∑ r ∈ R, (1 - FourNeighborLaplacian g r).natAbs + have hM (x : GaussianInt) : 1 - FourNeighborLaplacian g x ≤ (M : ℤ) := by + obtain ⟨r, hr, a, b, hx⟩ := hres x + have hp : FourNeighborLaplacian g x = FourNeighborLaplacian g r := by + rw [hx, hper a b r] + have hrM : (1 - FourNeighborLaplacian g r).natAbs ≤ M := + Finset.single_le_sum (fun s _ => Nat.zero_le ((1 - FourNeighborLaplacian g s).natAbs)) hr + rw [hp] + have := Int.le_natAbs (a := 1 - FourNeighborLaplacian g r) + omega + have hqlap (x : GaussianInt) : FourNeighborLaplacian q x ≤ (M : ℤ) := by + have hf := hflap x + have hb := hM x + simp only [FourNeighborLaplacian, q] at hf hb ⊢ + linarith + have hfamily : ∀ N : ℕ, ∃ C : Set GaussianInt, + FourNeighborConnected C ∧ + (∀ x, FourNeighborLaplacian + (fun y => g y + Set.indicator C (fun _ => (1 : ℤ)) y) x ≤ 1) ∧ + ∃ z a : GaussianInt, z ∉ C ∧ a ∈ C ∧ FourNeighborAdjacent z a ∧ + ∃ F : Finset GaussianInt, (↑F : Set GaussianInt) ⊆ C ∧ N < F.card := by + intro N + obtain ⟨C, hC, z, a, hz, ha, hza, F, hF, hcard⟩ := + P4849T1LargePositiveComponents q M hq (by omega) hqlap hzero hunbounded N + refine ⟨C, hC.1, P4849T1ComponentRestriction g _ C hlap hS hC, + z, a, ?_, ha, hza, F, hF, hcard⟩ + intro hzc + have hpos := hC.2.1 hzc + change 0 < q z at hpos + omega + obtain ⟨z, a, C, hza, hC⟩ := P4849T1PeriodAnchoring g u v R hres hper hfamily + obtain ⟨σ, hσ, L, hlocal⟩ := P4849T1SetDiagonalSubsequence C + have hlarge (n : ℕ) : ∃ F : Finset GaussianInt, + (↑F : Set GaussianInt) ⊆ C (σ n) ∧ n < F.card := by + obtain ⟨F, hF, hcard⟩ := (hC (σ n)).2.2.2.2 + exact ⟨F, hF, lt_of_le_of_lt (hσ.id_le n) hcard⟩ + have hL := P4849T1LocalLimitAdmissibility g (fun n => C (σ n)) L + (fun n => (hC (σ n)).2.2.2.1) hlocal + obtain ⟨X, hX, hXinf, _, hzX⟩ := + P4849T1InfiniteLimitComponent (fun n => C (σ n)) L z a hza + (fun n => (hC (σ n)).1) (fun n => (hC (σ n)).2.1) + (fun n => (hC (σ n)).2.2.1) hlarge hlocal + have hXlap := P4849T1ComponentRestriction g L X hlap hL hX + have hXuniv := hrigid X hXinf hX.1 hXlap + exact hzX (hXuniv.symm ▸ Set.mem_univ z) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SuperharmonicDownwardClosure.lean b/LeanPool/ApollonianSuperharmonic/SuperharmonicDownwardClosure.lean new file mode 100644 index 0000000000..001739e45b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SuperharmonicDownwardClosure.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerLaplacianCastBridge +public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicRepresentative +public import LeanPool.ApollonianSuperharmonic.PSDQuadraticIntegerApproximation +public import LeanPool.ApollonianSuperharmonic.QuadraticGrowthAtInfinity +public import LeanPool.ApollonianSuperharmonic.RealLaplacianLinearity + +-- [TABLET NODE: SuperharmonicDownwardClosure] + +/-! +# SuperharmonicDownwardClosure + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem SuperharmonicDownwardClosure + (A B : Matrix (Fin 2) (Fin 2) Real) (hA : A.IsSymm) + (hB : exists f : IntegerLatticeFunction, + IntegerSuperharmonicRepresentative B f) + (hgap : (B - A).PosSemidef) : + exists g : IntegerLatticeFunction, + IntegerSuperharmonicRepresentative A g := by +-- BODY + obtain ⟨f, hf⟩ := hB + have hDsymm : (B - A).IsSymm := by + change (B - A).transpose = B - A + simpa [Matrix.IsHermitian] using hgap.1 + obtain ⟨d, hd₁, hd₂, hd₃, hd₄, hd₅⟩ := + PSDQuadraticIntegerApproximation (B - A) hDsymm hgap + let g : IntegerLatticeFunction := fun x => f x - d x + refine ⟨g, ?_⟩ + refine ⟨hA, ?_, ?_⟩ + · intro ε hε + have hhalf : 0 < ε / 2 := by linarith + obtain ⟨R, hR⟩ := hf.2.1 (ε / 2) hhalf + refine ⟨max R (max (32 / ε ^ 2) (8 / ε)), ?_⟩ + intro x hx + have ht : 0 ≤ (x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2 := by positivity + have hR' : R ≤ (x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2 := + le_trans (le_max_left _ _) hx + have hlarge : 32 / ε ^ 2 ≤ (x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2 := + le_trans (le_trans (le_max_left _ _) (le_max_right _ _)) hx + have hlarge' : 8 / ε ≤ (x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2 := + le_trans (le_trans (le_max_right _ _) (le_max_right _ _)) hx + have hre : |(x.re : ℝ)| ^ 2 = (x.re : ℝ) ^ 2 := by rw [sq_abs] + have him : |(x.im : ℝ)| ^ 2 = (x.im : ℝ) ^ 2 := by rw [sq_abs] + have hsquare : (|(x.re : ℝ)| + |(x.im : ℝ)|) ^ 2 ≤ + 2 * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) := by + nlinarith [sq_nonneg (|(x.re : ℝ)| - |(x.im : ℝ)|)] + have habs : ((abs x.re + abs x.im : Int) : ℝ) = + |(x.re : ℝ)| + |(x.im : ℝ)| := by simp [Int.cast_add, Int.cast_abs] + have hlin : ((abs x.re + abs x.im : Int) : ℝ) + 1 ≤ + (ε / 2) * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) := by + rw [habs] + have hprod : 32 ≤ ε ^ 2 * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) := by + apply (div_le_iff₀ (sq_pos_of_pos hε)).mp at hlarge + nlinarith + have hprod' : 8 ≤ ε * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) := by + apply (div_le_iff₀ hε).mp at hlarge' + nlinarith + have hmul := mul_le_mul_of_nonneg_right hprod ht + have hsquare' := mul_le_mul_of_nonneg_left hsquare (by norm_num : (0 : ℝ) ≤ 16) + have hsum : |(x.re : ℝ)| + |(x.im : ℝ)| ≤ + ε * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) / 4 := by + nlinarith [sq_nonneg (ε * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) - + 4 * (|(x.re : ℝ)| + |(x.im : ℝ)|))] + nlinarith + have hfd : |(f x : ℝ) - LatticeQuadraticForm B x| ≤ + (ε / 2) * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) := hR x hR' + have hdl : LatticeQuadraticForm (B - A) x - + ((abs x.re + abs x.im : Int) : ℝ) - 1 ≤ (d x : ℝ) := (hd₄ x).1 + have hdu : (d x : ℝ) ≤ LatticeQuadraticForm (B - A) x + + ((abs x.re + abs x.im : Int) : ℝ) + 1 := (hd₄ x).2 + have hquad : LatticeQuadraticForm B x - LatticeQuadraticForm (B - A) x = + LatticeQuadraticForm A x := by + simp [LatticeQuadraticForm, Matrix.sub_mulVec] + ring + rw [show (g x : ℝ) = (f x : ℝ) - (d x : ℝ) by simp [g], ← hquad] + have hdiff : |(d x : ℝ) - LatticeQuadraticForm (B - A) x| ≤ + ((abs x.re + abs x.im : Int) : ℝ) + 1 := by + rw [abs_le] + constructor <;> linarith + calc + |(f x : ℝ) - (d x : ℝ) - + (LatticeQuadraticForm B x - LatticeQuadraticForm (B - A) x)| = + |((f x : ℝ) - LatticeQuadraticForm B x) - + ((d x : ℝ) - LatticeQuadraticForm (B - A) x)| := by + congr 1; ring + _ ≤ |(f x : ℝ) - LatticeQuadraticForm B x| + + |(d x : ℝ) - LatticeQuadraticForm (B - A) x| := abs_sub _ _ + _ ≤ (ε / 2) * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) + + (((abs x.re + abs x.im : Int) : ℝ) + 1) := + add_le_add hfd hdiff + _ ≤ ε * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) := by nlinarith [hlin] + · intro x + have hfl := hf.2.2 x + have hdl := hd₅ x + change FourNeighborLaplacian (fun y => f y - d y) x ≤ 1 + have hident : FourNeighborLaplacian (fun y => f y - d y) x = + FourNeighborLaplacian f x - FourNeighborLaplacian d x := by + simp only [FourNeighborLaplacian] + ring + rw [hident] + linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SwappedAffineTriangularChartAlignment.lean b/LeanPool/ApollonianSuperharmonic/SwappedAffineTriangularChartAlignment.lean new file mode 100644 index 0000000000..9ebf42da66 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SwappedAffineTriangularChartAlignment.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AffineTriangularComplexChart +public import LeanPool.ApollonianSuperharmonic.AffineTriangularFaceCoordinateSwap +public import LeanPool.ApollonianSuperharmonic.AffineTriangularFaceVertices +public import LeanPool.ApollonianSuperharmonic.TileTranslation + +-- [TABLET NODE: SwappedAffineTriangularChartAlignment] + +/-! +# SwappedAffineTriangularChartAlignment + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem SwappedAffineTriangularChartAlignment {ι : Type} [DecidableEq ι] + (P : PeriodicTileComplex ι) (base : ProtoTile) (a b : GaussianInt) + (chart : AffineTriangularComplexChart P (fun z : Int × Int => + TileTranslation base + ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b))) : + (∀ x y : Int × Int, + TriangularLatticeAdjacent (Prod.swap x) + (Prod.swap y) ↔ + TriangularLatticeAdjacent x y) ∧ + (∀ f : AffineTriangularFace, + (AffineTriangularFaceVertices f).image Prod.swap = + AffineTriangularFaceVertices + (AffineTriangularFaceCoordinateSwap f)) ∧ + (∀ z : Int × Int, + TileTranslation base + ((z.1 : GaussianInt) * b + (z.2 : GaussianInt) * a) = + P.tile (chart.vertexEquiv (Prod.swap z))) ∧ + ∀ f : AffineTriangularFace, + let F : P.plane.Face := + match AffineTriangularFaceCoordinateSwap f with + | .up z => chart.up z + | .down z => chart.down z + (AffineTriangularFaceVertices f).image + (fun z => chart.vertexEquiv (Prod.swap z)) = + {P.plane.faceVertex F 0, P.plane.faceVertex F 1, + P.plane.faceVertex F 2} := by +-- BODY + constructor + · intro x y + rcases x with ⟨x₁, x₂⟩ + rcases y with ⟨y₁, y₂⟩ + simp only [Prod.swap, TriangularLatticeAdjacent, + Prod.mk_sub_mk, Prod.ext_iff] + omega + constructor + · intro f + cases f <;> ext x <;> + simp [AffineTriangularFaceVertices, AffineTriangularFaceCoordinateSwap, + Prod.swap, Prod.ext_iff] <;> + aesop + constructor + · intro z + rw [chart.tile_eq] + rcases z with ⟨m, n⟩ + simp [Prod.swap, add_comm] + intro f + cases f with + | up z => + rw [show (match AffineTriangularFaceCoordinateSwap + (AffineTriangularFace.up z) with + | .up w => chart.up w + | .down w => chart.down w) = + chart.down (Prod.swap z) by rfl] + rcases chart.down_vertices (Prod.swap z) with + ⟨h₀', h₁', h₂'⟩ + have h₀ := h₀' + have h₁ := h₁' + have h₂ := h₂' + simp [Prod.swap] at h₀ h₁ h₂ + ext x + simp [h₀, h₁, h₂, AffineTriangularFaceVertices, + Prod.swap] + aesop + | down z => + rw [show (match AffineTriangularFaceCoordinateSwap + (AffineTriangularFace.down z) with + | .up w => chart.up w + | .down w => chart.down w) = + chart.up (Prod.swap z) by rfl] + rcases chart.up_vertices (Prod.swap z) with + ⟨h₀', h₁', h₂'⟩ + have h₀ := h₀' + have h₁ := h₁' + have h₂ := h₂' + simp [Prod.swap] at h₀ h₁ h₂ + ext x + simp [h₀, h₁, h₂, AffineTriangularFaceVertices, + Prod.swap] + aesop + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinateIdentity.lean b/LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinateIdentity.lean new file mode 100644 index 0000000000..ed593ae02f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinateIdentity.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SymmetricMatrixCoordinates + +-- [TABLET NODE: SymmetricMatrixCoordinateIdentity] + +/-! +# SymmetricMatrixCoordinateIdentity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem SymmetricMatrixCoordinateIdentity + (A : Matrix (Fin 2) (Fin 2) Real) (hA : A.IsSymm) : + let x := SymmetricMatrixCoordinates A + A = (2 : Real)⁻¹ • + ![![x.2 + x.1.re, x.1.im], ![x.1.im, x.2 - x.1.re]] := by +-- BODY + dsimp [SymmetricMatrixCoordinates] + ext i j + fin_cases i <;> fin_cases j <;> + simp [Matrix.trace_fin_two, smul_eq_mul, hA.apply 0 1] <;> ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinates.lean b/LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinates.lean new file mode 100644 index 0000000000..8956e2f4b5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinates.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Analysis.Complex.Basic +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: SymmetricMatrixCoordinates] + +/-! +# SymmetricMatrixCoordinates + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a real $2\times2$ matrix $A$, define its spatial coordinates by +$$ + \operatorname{coord}(A)=(x,r),\qquad + x=(A_{00}-A_{11})+2A_{01}i,\qquad r=\operatorname{trace}(A). +$$ +When $A$ is symmetric these are the $(x_1,x_2,r)$ coordinates used in the +paper, with $x=x_1+ix_2$. +-/ +noncomputable def SymmetricMatrixCoordinates + (A : Matrix (Fin 2) (Fin 2) Real) : Complex × Real := +-- BODY + (⟨A 0 0 - A 1 1, 2 * A 0 1⟩, Matrix.trace A) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateBaseTables.lean b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateBaseTables.lean new file mode 100644 index 0000000000..e6ee46c1bb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateBaseTables.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateNormLaw +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinatePolarizationLaw + + +-- [TABLET NODE: TangencyCoordinateBaseTables] + +/-! +# TangencyCoordinateBaseTables + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TangencyCoordinateBaseTables (z : GaussianInt) : + TangencyCoordinateNormLaw + ![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), + (0, 1), (0, -1)] ∧ + TangencyCoordinatePolarizationLaw + ![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), + (0, 1), (0, -1)] := by +-- BODY + constructor + · intro a b hab + fin_cases a <;> fin_cases b <;> + simp_all [Zsqrtd.norm] + · intro a b j hab haj hbj + fin_cases a <;> fin_cases b <;> fin_cases j <;> + simp_all + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateIdentity.lean b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateIdentity.lean new file mode 100644 index 0000000000..dc29ae86a2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateIdentity.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import LeanPool.ApollonianSuperharmonic.Preamble +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateBaseTables +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateRotation +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateSuccessorNorm +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateSuccessorPolarization + +-- [TABLET NODE: TangencyCoordinateIdentity] + +/-! +# TangencyCoordinateIdentity + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TangencyCoordinateIdentity (q : Fin 4 → CircleCoordinates) + (hq : SemiProperQuadruple q) (i j : Fin 4) (hij : i ≠ j) : + Zsqrtd.norm ((q j).1 • (q i).2 - (q i).1 • (q j).2) = + ((q i).1 + (q j).1) ^ 2 := by +-- BODY + have simultaneous : ∀ (r : Fin 4 → CircleCoordinates), SemiProperQuadruple r → + TangencyCoordinateNormLaw r ∧ TangencyCoordinatePolarizationLaw r := by + intro r hr + induction hr with + | base z => exact TangencyCoordinateBaseTables z + | rotate hr ih => exact TangencyCoordinateRotation _ ih.1 ih.2 + | successor hr ih => + exact ⟨TangencyCoordinateSuccessorNorm _ ih.1 ih.2, + TangencyCoordinateSuccessorPolarization _ ih.1 ih.2⟩ + exact (simultaneous q hq).1 i j hij + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateNormLaw.lean b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateNormLaw.lean new file mode 100644 index 0000000000..49de61dbb9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateNormLaw.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple + +-- [TABLET NODE: TangencyCoordinateNormLaw] + +/-! +# TangencyCoordinateNormLaw + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a coordinate quadruple $q=(C_0,C_1,C_2,C_3)$, with +$C_i=(c_i,w_i)$, the tangency-coordinate norm law means that, for every +pair of distinct indices $i,j$, +$$ + \left|c_jw_i-c_iw_j\right|^2=(c_i+c_j)^2. +$$ +This is an algebraic property of the coordinate quadruple and asserts no +geometric sidedness. +-/ +def TangencyCoordinateNormLaw (q : Fin 4 → CircleCoordinates) : Prop := +-- BODY + ∀ i j : Fin 4, i ≠ j → + Zsqrtd.norm ((q j).1 • (q i).2 - (q i).1 • (q j).2) = + ((q i).1 + (q j).1) ^ 2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TangencyCoordinatePolarizationLaw.lean b/LeanPool/ApollonianSuperharmonic/TangencyCoordinatePolarizationLaw.lean new file mode 100644 index 0000000000..28ecaee00d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TangencyCoordinatePolarizationLaw.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple + +-- [TABLET NODE: TangencyCoordinatePolarizationLaw] + +/-! +# TangencyCoordinatePolarizationLaw + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a coordinate quadruple $q=(C_0,C_1,C_2,C_3)$, write +$C_i=(c_i,w_i)$ and $\delta_{ab}=c_bw_a-c_aw_b$. The +tangency-coordinate polarization law means that, whenever $a,b,j$ are +pairwise distinct, +$$ + \operatorname{Re}(\delta_{aj})\operatorname{Re}(\delta_{bj})+ + \operatorname{Im}(\delta_{aj})\operatorname{Im}(\delta_{bj}) + =c_ac_b+c_j(c_a+c_b)-c_j^2. +$$ +Equivalently, the real polarization +$[u,v]=u\overline v+\overline u v$ of the two determinants is twice the +right-hand side. +-/ +def TangencyCoordinatePolarizationLaw (q : Fin 4 → CircleCoordinates) : Prop := +-- BODY + ∀ a b j : Fin 4, a ≠ b → a ≠ j → b ≠ j → + let u := (q j).1 • (q a).2 - (q a).1 • (q j).2 + let v := (q j).1 • (q b).2 - (q b).1 • (q j).2 + u.re * v.re + u.im * v.im = + (q a).1 * (q b).1 + (q j).1 * ((q a).1 + (q b).1) - (q j).1 ^ 2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateRotation.lean b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateRotation.lean new file mode 100644 index 0000000000..d1cef7fc54 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateRotation.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateNormLaw +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinatePolarizationLaw + + +-- [TABLET NODE: TangencyCoordinateRotation] + +/-! +# TangencyCoordinateRotation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TangencyCoordinateRotation (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) + (hp : TangencyCoordinatePolarizationLaw q) : + TangencyCoordinateNormLaw ![q 0, q 2, q 3, q 1] ∧ + TangencyCoordinatePolarizationLaw ![q 0, q 2, q 3, q 1] := by +-- BODY + constructor + · intro a b hab + fin_cases a <;> fin_cases b <;> + simp_all [TangencyCoordinateNormLaw] + · intro a b j hab haj hbj + fin_cases a <;> fin_cases b <;> fin_cases j <;> + simp_all [TangencyCoordinatePolarizationLaw] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorNorm.lean b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorNorm.lean new file mode 100644 index 0000000000..99f4281933 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorNorm.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateNormLaw +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinatePolarizationLaw + +-- [TABLET NODE: TangencyCoordinateSuccessorNorm] + +/-! +# TangencyCoordinateSuccessorNorm + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TangencyCoordinateSuccessorNorm (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) + (hp : TangencyCoordinatePolarizationLaw q) : + TangencyCoordinateNormLaw + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] := by +-- BODY + intro i j hij + fin_cases i <;> fin_cases j <;> + simp_all? [TangencyCoordinateNormLaw, TangencyCoordinatePolarizationLaw, + Zsqrtd.norm_def] + case «0».«1» | «1».«0» => + have a := hn 0 2 (by decide) + have b := hn 0 3 (by decide) + have c := hn 1 0 (by decide) + have d := hp 2 3 0 (by decide) (by decide) (by decide) + have e := hp 2 1 0 (by decide) (by decide) (by decide) + have f := hp 3 1 0 (by decide) (by decide) (by decide) + ring_nf at a b c d e f ⊢ + linarith + case «0».«2» | «2».«0» => + have a := hn 0 2 (by decide) + have b := hn 2 3 (by decide) + have c := hn 1 2 (by decide) + have d := hp 0 3 2 (by decide) (by decide) (by decide) + have e := hp 0 1 2 (by decide) (by decide) (by decide) + have f := hp 3 1 2 (by decide) (by decide) (by decide) + ring_nf at a b c d e f ⊢ + linarith + case «0».«3» | «3».«0» => + have a := hn 0 3 (by decide) + have b := hn 2 3 (by decide) + have c := hn 1 3 (by decide) + have d := hp 0 2 3 (by decide) (by decide) (by decide) + have e := hp 0 1 3 (by decide) (by decide) (by decide) + have f := hp 2 1 3 (by decide) (by decide) (by decide) + ring_nf at a b c d e f ⊢ + linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorPolarization.lean b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorPolarization.lean new file mode 100644 index 0000000000..c7378266f5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorPolarization.lean @@ -0,0 +1,478 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateNormLaw +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinatePolarizationLaw + + +-- [TABLET NODE: TangencyCoordinateSuccessorPolarization] + +/-! +# TangencyCoordinateSuccessorPolarization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace SuccessorPolarization + +private noncomputable def c (q : Fin 4 → CircleCoordinates) : Fin 4 → ℤ := fun r => (q r).1 + +private noncomputable def w (q : Fin 4 → CircleCoordinates) : Fin 4 → GaussianInt := fun r => (q + r).2 + +private noncomputable def delta (q : Fin 4 → CircleCoordinates) : Fin 4 → Fin 4 → GaussianInt := + fun r s => (c q) s • (w q) r - (c q) r • (w q) s + +private noncomputable def dot : GaussianInt → GaussianInt → ℤ := fun x y => x.re * y.re + x.im * + y.im + +private noncomputable def P (q : Fin 4 → CircleCoordinates) : Fin 4 → Fin 4 → Fin 4 → ℤ := fun a + b j => (c q) a * (c q) b + (c q) j * ((c q) a + (c q) b) - (c q) j ^ 2 + +private theorem hn' (q : Fin 4 → CircleCoordinates) (hn : TangencyCoordinateNormLaw q) : ∀ i j : + Fin 4, i ≠ j → + dot ((delta q) i j) ((delta q) i j) = ((c q) i + (c q) j) ^ 2 := by + classical + let c : Fin 4 → ℤ := fun r => (q r).1 + let w : Fin 4 → GaussianInt := fun r => (q r).2 + let delta : Fin 4 → Fin 4 → GaussianInt := + fun r s => c s • w r - c r • w s + let dot : GaussianInt → GaussianInt → ℤ := + fun x y => x.re * y.re + x.im * y.im + change (∀ i j : Fin 4, i ≠ j → + dot (delta i j) (delta i j) = (c i + c j) ^ 2) + intro i j hij + have h := hn i j hij + convert h using 1; simp [dot, delta, c, w, Zsqrtd.norm]; ring + +private theorem hp' (q : Fin 4 → CircleCoordinates) (hp : TangencyCoordinatePolarizationLaw q) : + ∀ a b j : Fin 4, a ≠ b → a ≠ j → b ≠ j → + dot ((delta q) a j) ((delta q) b j) = (P q) a b j := by + classical + let c : Fin 4 → ℤ := fun r => (q r).1 + let w : Fin 4 → GaussianInt := fun r => (q r).2 + let delta : Fin 4 → Fin 4 → GaussianInt := + fun r s => c s • w r - c r • w s + let dot : GaussianInt → GaussianInt → ℤ := + fun x y => x.re * y.re + x.im * y.im + let P : Fin 4 → Fin 4 → Fin 4 → ℤ := + fun a b j => c a * c b + c j * (c a + c b) - c j ^ 2 + change (∀ a b j : Fin 4, a ≠ b → a ≠ j → b ≠ j → + dot (delta a j) (delta b j) = P a b j) + intro a b j hab haj hbj + have h := hp a b j hab haj hbj + simpa [dot, delta, P, c, w] using h + +private theorem noncommon (q : Fin 4 → CircleCoordinates) (hn : TangencyCoordinateNormLaw q) (hp + : TangencyCoordinatePolarizationLaw q) : ∀ j k l : Fin 4, j ≠ k → j ≠ l → k ≠ l → + j ≠ 1 → k ≠ 1 → l ≠ 1 → + let d := 2 * ((c q) j + (c q) k + (c q) l) - (c q) 1 + let wd := 2 * (w q) j + 2 * (w q) k + 2 * (w q) l - (w q) 1 + dot ((c q) j • wd - d • (w q) j) ((delta q) k j) = + d * (c q) k + (c q) j * (d + (c q) k) - (c q) j ^ 2 := by + classical + let c : Fin 4 → ℤ := fun r => (q r).1 + let w : Fin 4 → GaussianInt := fun r => (q r).2 + let delta : Fin 4 → Fin 4 → GaussianInt := + fun r s => c s • w r - c r • w s + let dot : GaussianInt → GaussianInt → ℤ := + fun x y => x.re * y.re + x.im * y.im + let P : Fin 4 → Fin 4 → Fin 4 → ℤ := + fun a b j => c a * c b + c j * (c a + c b) - c j ^ 2 + have hn' : ∀ i j : Fin 4, i ≠ j → + dot (delta i j) (delta i j) = (c i + c j) ^ 2 := hn' q hn + have hp' : ∀ a b j : Fin 4, a ≠ b → a ≠ j → b ≠ j → + dot (delta a j) (delta b j) = P a b j := hp' q hp + change (∀ j k l : Fin 4, j ≠ k → j ≠ l → k ≠ l → + j ≠ 1 → k ≠ 1 → l ≠ 1 → + let d := 2 * (c j + c k + c l) - c 1 + let wd := 2 * w j + 2 * w k + 2 * w l - w 1 + dot (c j • wd - d • w j) (delta k j) = + d * c k + c j * (d + c k) - c j ^ 2) + intro j k l hjk hjl hkl hj1 hk1 hl1 + dsimp only + calc + dot (c j • (2 * w j + 2 * w k + 2 * w l - w 1) - + (2 * (c j + c k + c l) - c 1) • w j) (delta k j) = + 2 * dot (delta k j) (delta k j) + + 2 * dot (delta l j) (delta k j) - dot (delta 1 j) (delta k j) := by + simp [delta, dot] + ring + _ = (2 * (c j + c k + c l) - c 1) * c k + + c j * (2 * (c j + c k + c l) - c 1 + c k) - c j ^ 2 := by + rw [hn' k j (Ne.symm hjk), + hp' l k j (Ne.symm hkl) (Ne.symm hjl) (Ne.symm hjk), + hp' 1 k j (Ne.symm hk1) (Ne.symm hj1) (Ne.symm hjk)] + simp [P] + ring + +private theorem common (q : Fin 4 → CircleCoordinates) (hn : TangencyCoordinateNormLaw q) (hp : + TangencyCoordinatePolarizationLaw q) : ∀ i k l : Fin 4, i ≠ k → i ≠ l → k ≠ l → + i ≠ 1 → k ≠ 1 → l ≠ 1 → + let d := 2 * ((c q) i + (c q) k + (c q) l) - (c q) 1 + let wd := 2 * (w q) i + 2 * (w q) k + 2 * (w q) l - (w q) 1 + dot (d • (w q) i - (c q) i • wd) (d • (w q) k - (c q) k • wd) = + (c q) i * (c q) k + d * ((c q) i + (c q) k) - d ^ 2 := by + classical + let c : Fin 4 → ℤ := fun r => (q r).1 + let w : Fin 4 → GaussianInt := fun r => (q r).2 + let delta : Fin 4 → Fin 4 → GaussianInt := + fun r s => c s • w r - c r • w s + let dot : GaussianInt → GaussianInt → ℤ := + fun x y => x.re * y.re + x.im * y.im + let P : Fin 4 → Fin 4 → Fin 4 → ℤ := + fun a b j => c a * c b + c j * (c a + c b) - c j ^ 2 + have hn' : ∀ i j : Fin 4, i ≠ j → + dot (delta i j) (delta i j) = (c i + c j) ^ 2 := hn' q hn + have hp' : ∀ a b j : Fin 4, a ≠ b → a ≠ j → b ≠ j → + dot (delta a j) (delta b j) = P a b j := hp' q hp + change (∀ i k l : Fin 4, i ≠ k → i ≠ l → k ≠ l → + i ≠ 1 → k ≠ 1 → l ≠ 1 → + let d := 2 * (c i + c k + c l) - c 1 + let wd := 2 * w i + 2 * w k + 2 * w l - w 1 + dot (d • w i - c i • wd) (d • w k - c k • wd) = + c i * c k + d * (c i + c k) - d ^ 2) + intro i k l hik hil hkl hi1 hk1 hl1 + dsimp only + let d := 2 * (c i + c k + c l) - c 1 + let wd := 2 * w i + 2 * w k + 2 * w l - w 1 + let A := delta i k + let B := delta i l + let C := delta i 1 + let E := delta k l + let F := delta k 1 + let G := delta l 1 + let X0 := -2 * c i * c k + c i * c l + c i * c 1 + + c k * c l + c k * c 1 - 2 * c l * c 1 + have hBC : dot B C = P l 1 i := by + convert hp' l 1 i hl1 (Ne.symm hil) (Ne.symm hi1) using 1; + simp [B, C, delta, dot]; ring + have hAB : dot A B = P k l i := by + convert hp' k l i hkl (Ne.symm hik) (Ne.symm hil) using 1; + simp [A, B, delta, dot]; ring + have hAC : dot A C = P k 1 i := by + convert hp' k 1 i hk1 (Ne.symm hik) (Ne.symm hi1) using 1; + simp [A, C, delta, dot]; ring + have hEF : dot E F = P l 1 k := by + convert hp' l 1 k hl1 (Ne.symm hkl) (Ne.symm hk1) using 1; + simp [E, F, delta, dot]; ring + have hAF : dot A F = -P i 1 k := by + have h := hp' i 1 k hi1 hik (Ne.symm hk1) + convert congrArg Neg.neg h using 1; simp [A, F, delta, dot]; ring + have hAE : dot A E = -P i l k := by + have h := hp' i l k hil hik (Ne.symm hkl) + convert congrArg Neg.neg h using 1; simp [A, E, delta, dot]; ring + have hGE : dot G E = -P k 1 l := by + have h := hp' k 1 l hk1 hkl (Ne.symm hl1) + convert congrArg Neg.neg h using 1; simp [G, E, delta, dot]; ring + have hCF : dot C F = P i k 1 := by + simpa [C, F] using hp' i k 1 hik hi1 hk1 + have hBF : dot B F + dot C E = X0 := by + by_cases hi : c i = 0 + · by_cases hk : c k = 0 + · by_cases hl : c l = 0 + · by_cases h1 : c 1 = 0 + · simp [X0, B, C, E, F, delta, dot, hi, hk, hl, h1] + · have halg : c 1 * (dot B F + dot C E) = + 2 * c l * dot C F - c i * dot G F - c k * dot C G := by + simp [B, C, E, F, G, delta, dot] + ring + have hs : c 1 * (dot B F + dot C E) = c 1 * X0 := by + rw [halg, hCF] + simp [X0, P, hi, hk, hl] + exact (mul_left_cancel₀ h1) hs + · have halg : c l * (dot B F + dot C E) = + 2 * c 1 * dot B E + c k * dot B G + c i * dot G E := by + simp [B, C, E, F, G, delta, dot] + ring + have hBE : dot B E = P i k l := by + simpa [B, E] using hp' i k l hik hil hkl + have hBG : dot B G = -P i 1 l := by + have h := hp' i 1 l hi1 hil (Ne.symm hl1) + convert congrArg Neg.neg h using 1; + simp [B, G, delta, dot]; ring + have hs : c l * (dot B F + dot C E) = c l * X0 := by + rw [halg, hBE, hBG, hGE] + simp [X0, P, hi, hk] + ring + exact (mul_left_cancel₀ hl) hs + · have halg : c k * (dot B F + dot C E) = + 2 * c i * dot E F + c l * dot A F + c 1 * dot A E := by + simp [A, B, C, E, F, delta, dot] + ring + have hs : c k * (dot B F + dot C E) = c k * X0 := by + rw [halg, hEF, hAF, hAE] + simp [X0, P, hi] + ring + exact (mul_left_cancel₀ hk) hs + · have halg : c i * (dot B F + dot C E) = + 2 * c k * dot B C - c 1 * dot A B - c l * dot A C := by + simp [A, B, C, E, F, delta, dot] + ring + have hs : c i * (dot B F + dot C E) = c i * X0 := by + rw [halg, hBC, hAB, hAC] + simp [X0, P] + ring + exact (mul_left_cancel₀ hi) hs + have hAA := hn' i k hik + have hBE : dot B E = P i k l := by + simpa [B, E] using hp' i k l hik hil hkl + have hCF' : dot C F = P i k 1 := by + simpa [C, F] using hp' i k 1 hik hi1 hk1 + change dot (d • w i - c i • wd) (d • w k - c k • wd) = + c i * c k + d * (c i + c k) - d ^ 2 + calc + dot (d • w i - c i • wd) (d • w k - c k • wd) = + -4 * dot A A - 4 * dot A B + 2 * dot A C + 4 * dot A E - + 2 * dot A F + 4 * dot B E - 2 * (dot B F + dot C E) + + dot C F := by + simp [d, wd, A, B, C, E, F, delta, dot] + ring + _ = c i * c k + d * (c i + c k) - d ^ 2 := by + rw [hAA, hAB, hAC, hAE, hAF, hBE, hBF, hCF'] + simp [P, X0, d] + ring + +end SuccessorPolarization + +private def successorQuadruple (q : Fin 4 → CircleCoordinates) : Fin 4 → CircleCoordinates := + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + +private def pairPolarization (q : Fin 4 → CircleCoordinates) (a b j : Fin 4) : Prop := + let u := (q j).1 • (q a).2 - (q a).1 • (q j).2 + let v := (q j).1 • (q b).2 - (q b).1 • (q j).2 + u.re * v.re + u.im * v.im = + (q a).1 * (q b).1 + (q j).1 * ((q a).1 + (q b).1) - (q j).1 ^ 2 + +private theorem polarizationCase012 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 0 1 2 := by + convert SuccessorPolarization.noncommon q hn hp 2 0 3 (by decide) (by decide) (by decide) (by + decide) + (by decide) (by decide) using 1; simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, SuccessorPolarization.delta, pairPolarization, + successorQuadruple]; ring + +private theorem polarizationCase013 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 0 1 3 := by + convert SuccessorPolarization.noncommon q hn hp 3 0 2 (by decide) (by decide) (by decide) (by + decide) + (by decide) (by decide) using 1; simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, SuccessorPolarization.delta, pairPolarization, + successorQuadruple]; ring + +private theorem polarizationCase021 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 0 2 1 := by + convert SuccessorPolarization.noncommon q hn hp 0 2 3 (by decide) (by decide) (by decide) (by + decide) + (by decide) (by decide) using 1; simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, SuccessorPolarization.delta, pairPolarization, + successorQuadruple]; ring + +private theorem polarizationCase023 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 0 2 3 := by + convert SuccessorPolarization.noncommon q hn hp 3 2 0 (by decide) (by decide) (by decide) (by + decide) + (by decide) (by decide) using 1; simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, SuccessorPolarization.delta, pairPolarization, + successorQuadruple]; ring + +private theorem polarizationCase031 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 0 3 1 := by + convert SuccessorPolarization.noncommon q hn hp 0 3 2 (by decide) (by decide) (by decide) (by + decide) + (by decide) (by decide) using 1; simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, SuccessorPolarization.delta, pairPolarization, + successorQuadruple]; ring + +private theorem polarizationCase032 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 0 3 2 := by + convert SuccessorPolarization.noncommon q hn hp 2 3 0 (by decide) (by decide) (by decide) (by + decide) + (by decide) (by decide) using 1; simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, SuccessorPolarization.delta, pairPolarization, + successorQuadruple]; ring + +private theorem polarizationCase102 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 1 0 2 := by + convert SuccessorPolarization.noncommon q hn hp 2 0 3 (by decide) (by decide) (by decide) (by + decide) + (by decide) (by decide) using 1; simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, SuccessorPolarization.delta, pairPolarization, + successorQuadruple]; ring + +private theorem polarizationCase103 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 1 0 3 := by + convert SuccessorPolarization.noncommon q hn hp 3 0 2 (by decide) (by decide) (by decide) (by + decide) + (by decide) (by decide) using 1; simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, SuccessorPolarization.delta, pairPolarization, + successorQuadruple]; ring + +private theorem polarizationCase120 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 1 2 0 := by + convert SuccessorPolarization.common q hn hp 0 2 3 (by decide) (by decide) (by decide) (by decide) + (by decide) (by decide) using 1; (try simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, pairPolarization, successorQuadruple]); ring + +private theorem polarizationCase123 (q : Fin 4 → CircleCoordinates) + (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 1 2 3 := by + exact hp 0 2 3 (by decide) (by decide) (by decide) + +private theorem polarizationCase130 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 1 3 0 := by + convert SuccessorPolarization.common q hn hp 0 3 2 (by decide) (by decide) (by decide) (by decide) + (by decide) (by decide) using 1; (try simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, pairPolarization, successorQuadruple]); ring + +private theorem polarizationCase132 (q : Fin 4 → CircleCoordinates) + (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 1 3 2 := by + exact hp 0 3 2 (by decide) (by decide) (by decide) + +private theorem polarizationCase201 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 2 0 1 := by + convert SuccessorPolarization.noncommon q hn hp 0 2 3 (by decide) (by decide) (by decide) (by + decide) + (by decide) (by decide) using 1; simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, SuccessorPolarization.delta, pairPolarization, + successorQuadruple]; ring + +private theorem polarizationCase203 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 2 0 3 := by + convert SuccessorPolarization.noncommon q hn hp 3 2 0 (by decide) (by decide) (by decide) (by + decide) + (by decide) (by decide) using 1; simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, SuccessorPolarization.delta, pairPolarization, + successorQuadruple]; ring + +private theorem polarizationCase210 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 2 1 0 := by + convert SuccessorPolarization.common q hn hp 2 0 3 (by decide) (by decide) (by decide) (by decide) + (by decide) (by decide) using 1; (try simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, pairPolarization, successorQuadruple]); ring + +private theorem polarizationCase213 (q : Fin 4 → CircleCoordinates) + (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 2 1 3 := by + exact hp 2 0 3 (by decide) (by decide) (by decide) + +private theorem polarizationCase230 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 2 3 0 := by + convert SuccessorPolarization.common q hn hp 2 3 0 (by decide) (by decide) (by decide) (by decide) + (by decide) (by decide) using 1; (try simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, pairPolarization, successorQuadruple]); ring + +private theorem polarizationCase231 (q : Fin 4 → CircleCoordinates) + (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 2 3 1 := by + exact hp 2 3 0 (by decide) (by decide) (by decide) + +private theorem polarizationCase301 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 3 0 1 := by + convert SuccessorPolarization.noncommon q hn hp 0 3 2 (by decide) (by decide) (by decide) (by + decide) + (by decide) (by decide) using 1; simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, SuccessorPolarization.delta, pairPolarization, + successorQuadruple]; ring + +private theorem polarizationCase302 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 3 0 2 := by + convert SuccessorPolarization.noncommon q hn hp 2 3 0 (by decide) (by decide) (by decide) (by + decide) + (by decide) (by decide) using 1; simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, SuccessorPolarization.delta, pairPolarization, + successorQuadruple]; ring + +private theorem polarizationCase310 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 3 1 0 := by + convert SuccessorPolarization.common q hn hp 3 0 2 (by decide) (by decide) (by decide) (by decide) + (by decide) (by decide) using 1; (try simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, pairPolarization, successorQuadruple]); ring + +private theorem polarizationCase312 (q : Fin 4 → CircleCoordinates) + (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 3 1 2 := by + exact hp 3 0 2 (by decide) (by decide) (by decide) + +private theorem polarizationCase320 (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 3 2 0 := by + convert SuccessorPolarization.common q hn hp 3 2 0 (by decide) (by decide) (by decide) (by decide) + (by decide) (by decide) using 1; (try simp [SuccessorPolarization.c, SuccessorPolarization.w, + SuccessorPolarization.dot, pairPolarization, successorQuadruple]); ring + +private theorem polarizationCase321 (q : Fin 4 → CircleCoordinates) + (hp : TangencyCoordinatePolarizationLaw q) : + pairPolarization (successorQuadruple q) 3 2 1 := by + exact hp 3 2 0 (by decide) (by decide) (by decide) + +theorem TangencyCoordinateSuccessorPolarization + (q : Fin 4 → CircleCoordinates) + (hn : TangencyCoordinateNormLaw q) + (hp : TangencyCoordinatePolarizationLaw q) : + TangencyCoordinatePolarizationLaw + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] := by + intro a b j hab haj hbj + fin_cases a <;> fin_cases b <;> fin_cases j + all_goals try exact (hab rfl).elim + all_goals try exact (haj rfl).elim + all_goals try exact (hbj rfl).elim + case «0».«1».«2» => exact polarizationCase012 q hn hp + case «0».«1».«3» => exact polarizationCase013 q hn hp + case «0».«2».«1» => exact polarizationCase021 q hn hp + case «0».«2».«3» => exact polarizationCase023 q hn hp + case «0».«3».«1» => exact polarizationCase031 q hn hp + case «0».«3».«2» => exact polarizationCase032 q hn hp + case «1».«0».«2» => exact polarizationCase102 q hn hp + case «1».«0».«3» => exact polarizationCase103 q hn hp + case «1».«2».«0» => exact polarizationCase120 q hn hp + case «1».«2».«3» => exact polarizationCase123 q hp + case «1».«3».«0» => exact polarizationCase130 q hn hp + case «1».«3».«2» => exact polarizationCase132 q hp + case «2».«0».«1» => exact polarizationCase201 q hn hp + case «2».«0».«3» => exact polarizationCase203 q hn hp + case «2».«1».«0» => exact polarizationCase210 q hn hp + case «2».«1».«3» => exact polarizationCase213 q hp + case «2».«3».«0» => exact polarizationCase230 q hn hp + case «2».«3».«1» => exact polarizationCase231 q hp + case «3».«0».«1» => exact polarizationCase301 q hn hp + case «3».«0».«2» => exact polarizationCase302 q hn hp + case «3».«1».«0» => exact polarizationCase310 q hn hp + case «3».«1».«2» => exact polarizationCase312 q hp + case «3».«2».«0» => exact polarizationCase320 q hn hp + case «3».«2».«1» => exact polarizationCase321 q hp + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ThreeOwnerDesignatedOppositePair.lean b/LeanPool/ApollonianSuperharmonic/ThreeOwnerDesignatedOppositePair.lean new file mode 100644 index 0000000000..1c5873e93c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ThreeOwnerDesignatedOppositePair.lean @@ -0,0 +1,184 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.NormNum + +-- [TABLET NODE: ThreeOwnerDesignatedOppositePair] + +/-! +# ThreeOwnerDesignatedOppositePair + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem ThreeOwnerDesignatedOppositePair : + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), (LatticeTile X) + → ((LatticeTile Y) → ((LatticeTile Z) → ((Disjoint X.cells Y.cells) → ((Disjoint Y.cells + Z.cells) → ((Disjoint Z.cells X.cells) → ((NoCheckerboardCellVertex (X.cells : Set + LatticeCell)) → ((NoCheckerboardCellVertex (Y.cells : Set LatticeCell)) → + ((NoCheckerboardCellVertex (Z.cells : Set LatticeCell)) → ((∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ X.cells ∨ + LatticeVertexIncidentCell x j ∈ Y.cells ∨ + LatticeVertexIncidentCell x j ∈ Z.cells) → ((∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ + X.cells) → ((∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ Y.cells) → ((∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ Z.cells) → (∀ D : ProtoTile, D = X ∨ D = Y ∨ D = Z → + ∃ U V R : ProtoTile, + (D = U ∨ D = V) ∧ + ((U = X ∧ V = Y ∧ R = Z) ∨ + (U = Y ∧ V = X ∧ R = Z) ∨ + (U = X ∧ V = Z ∧ R = Y) ∨ + (U = Z ∧ V = X ∧ R = Y) ∨ + (U = Y ∧ V = Z ∧ R = X) ∨ + (U = Z ∧ V = Y ∧ R = X)) ∧ + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ V.cells) ∧ + x ∈ FootprintVertices U ∧ x ∈ FootprintVertices V ∧ + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V)))))))))))))) := by + intro X Y Z x hX hY hZ hXY hYZ hZX hcheckerX hcheckerY hcheckerZ hexhaust hXocc hYocc hZocc +-- BODY + have no_opposite (P Q R : Fin 4 → Prop) + (hPQ : ∀ j, P j → ¬ Q j) + (hPR : ∀ j, P j → ¬ R j) + (hQR : ∀ j, Q j → ¬ R j) + (hcheck : ¬ ((P 0 ∧ P 2 ∧ ¬ P 1 ∧ ¬ P 3) ∨ + (P 1 ∧ P 3 ∧ ¬ P 0 ∧ ¬ P 2))) + (hQocc : ∃ j, Q j) (hRocc : ∃ j, R j) : + ∀ j, P j → ¬ P (j + 2) := by + have positions : ∀ j k : Fin 4, + k = j ∨ k = j + 1 ∨ k = j + 2 ∨ k = j + 3 := by + decide +kernel + have check (j : Fin 4) : + ¬ (P j ∧ P (j + 2) ∧ ¬ P (j + 1) ∧ ¬ P (j + 3)) := by + intro hj + fin_cases j <;> norm_num at hj + · exact hcheck (Or.inl hj) + · exact hcheck (Or.inr ⟨hj.1, hj.2.1, hj.2.2.2, hj.2.2.1⟩) + · exact hcheck (Or.inl ⟨hj.2.1, hj.1, hj.2.2.2, hj.2.2.1⟩) + · exact hcheck (Or.inr ⟨hj.2.1, hj.1, hj.2.2.1, hj.2.2.2⟩) + intro j hj hj2 + -- The other owners must occupy the two remaining positions. + have side (S : Fin 4 → Prop) (hPS : ∀ k, P k → ¬ S k) + (hSocc : ∃ k, S k) : S (j + 1) ∨ S (j + 3) := by + obtain ⟨k, hk⟩ := hSocc + rcases positions j k with hk0 | hk1 | hk2 | hk3 + · exact (hPS j hj (hk0 ▸ hk)).elim + · exact Or.inl (hk1 ▸ hk) + · exact (hPS (j + 2) hj2 (hk2 ▸ hk)).elim + · exact Or.inr (hk3 ▸ hk) + rcases side Q hPQ hQocc with hQ1 | hQ3 + · rcases side R hPR hRocc with hR1 | hR3 + · exact hQR (j + 1) hQ1 hR1 + · exact check j ⟨hj, hj2, + fun hp => hPQ (j + 1) hp hQ1, + fun hp => hPR (j + 3) hp hR3⟩ + · rcases side R hPR hRocc with hR1 | hR3 + · exact check j ⟨hj, hj2, + fun hp => hPR (j + 1) hp hR1, + fun hp => hPQ (j + 3) hp hQ3⟩ + · exact hQR (j + 3) hQ3 hR3 + let owns (T : ProtoTile) (j : Fin 4) : Prop := + LatticeVertexIncidentCell x j ∈ T.cells + have check (T : ProtoTile) + (hc : NoCheckerboardCellVertex (T.cells : Set LatticeCell)) : + ¬ ((owns T 0 ∧ owns T 2 ∧ ¬ owns T 1 ∧ ¬ owns T 3) ∨ + (owns T 1 ∧ owns T 3 ∧ ¬ owns T 0 ∧ ¬ owns T 2)) := by + simpa [owns, LatticeVertexIncidentCell] using hc x + have hXY' : ∀ j, owns X j → ¬ owns Y j := + fun _ hj => Finset.disjoint_left.mp hXY hj + have hYX' : ∀ j, owns Y j → ¬ owns X j := + fun _ hj => Finset.disjoint_left.mp hXY.symm hj + have hYZ' : ∀ j, owns Y j → ¬ owns Z j := + fun _ hj => Finset.disjoint_left.mp hYZ hj + have hZY' : ∀ j, owns Z j → ¬ owns Y j := + fun _ hj => Finset.disjoint_left.mp hYZ.symm hj + have hZX' : ∀ j, owns Z j → ¬ owns X j := + fun _ hj => Finset.disjoint_left.mp hZX hj + have hXZ' : ∀ j, owns X j → ¬ owns Z j := + fun _ hj => Finset.disjoint_left.mp hZX.symm hj + have hnoX := no_opposite (owns X) (owns Y) (owns Z) + hXY' hXZ' hYZ' (check X hcheckerX) hYocc hZocc + have hnoY := no_opposite (owns Y) (owns Z) (owns X) + hYZ' hYX' hZX' (check Y hcheckerY) hZocc hXocc + have hnoZ := no_opposite (owns Z) (owns X) (owns Y) + hZX' hZY' hXY' (check Z hcheckerZ) hXocc hYocc + have cell_vertex (T : ProtoTile) (c : LatticeCell) (hc : c ∈ T.cells) + (y : GaussianInt) + (hy : y = c ∨ y = c + 1 ∨ y = c + ⟨0, 1⟩ ∨ + y = c + 1 + ⟨0, 1⟩) : y ∈ FootprintVertices T := by + have hne : T.cells.Nonempty := ⟨c, hc⟩ + simp only [FootprintVertices, ite_eq_left hne] + exact ⟨c, hc, hy⟩ + have incident_vertex (T : ProtoTile) (k : Fin 4) + (hk : LatticeVertexIncidentCell x k ∈ T.cells) : + x ∈ FootprintVertices T := by + apply cell_vertex T _ hk + fin_cases k <;> simp [LatticeVertexIncidentCell, Zsqrtd.ext_iff] + have star (U V : ProtoTile) (j : Fin 4) + (hU : LatticeVertexIncidentCell x j ∈ U.cells) + (hV : LatticeVertexIncidentCell x (j + 2) ∈ V.cells) : + x ∈ FootprintVertices U ∧ x ∈ FootprintVertices V ∧ + (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V) := by + refine ⟨incident_vertex U j hU, incident_vertex V (j + 2) hV, ?_⟩ + intro y hy + have corners : + (y = LatticeVertexIncidentCell x j ∨ + y = LatticeVertexIncidentCell x j + 1 ∨ + y = LatticeVertexIncidentCell x j + ⟨0, 1⟩ ∨ + y = LatticeVertexIncidentCell x j + 1 + ⟨0, 1⟩) ∨ + (y = LatticeVertexIncidentCell x (j + 2) ∨ + y = LatticeVertexIncidentCell x (j + 2) + 1 ∨ + y = LatticeVertexIncidentCell x (j + 2) + ⟨0, 1⟩ ∨ + y = LatticeVertexIncidentCell x (j + 2) + 1 + ⟨0, 1⟩) := by + fin_cases j <;> rcases hy with rfl | rfl | rfl | rfl | rfl <;> + simp [LatticeVertexIncidentCell, Zsqrtd.ext_iff] + rcases corners with hc | hc + · exact Or.inl (cell_vertex U _ hU y hc) + · exact Or.inr (cell_vertex V _ hV y hc) + intro D hD + rcases hD with hD | hD | hD + · subst D + obtain ⟨j, hj⟩ := hXocc + rcases hexhaust (j + 2) with hx | hy | hz + · exact (hnoX j hj hx).elim + · refine ⟨X, Y, Z, Or.inl rfl, ?_, ⟨j, hj, hy⟩, star X Y j hj hy⟩ + exact Or.inl ⟨rfl, rfl, rfl⟩ + · refine ⟨X, Z, Y, Or.inl rfl, ?_, ⟨j, hj, hz⟩, star X Z j hj hz⟩ + exact Or.inr (Or.inr (Or.inl ⟨rfl, rfl, rfl⟩)) + · subst D + obtain ⟨j, hj⟩ := hYocc + rcases hexhaust (j + 2) with hx | hy | hz + · refine ⟨Y, X, Z, Or.inl rfl, ?_, ⟨j, hj, hx⟩, star Y X j hj hx⟩ + exact Or.inr (Or.inl ⟨rfl, rfl, rfl⟩) + · exact (hnoY j hj hy).elim + · refine ⟨Y, Z, X, Or.inl rfl, ?_, ⟨j, hj, hz⟩, star Y Z j hj hz⟩ + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨rfl, rfl, rfl⟩)))) + · subst D + obtain ⟨j, hj⟩ := hZocc + rcases hexhaust (j + 2) with hx | hy | hz + · refine ⟨Z, X, Y, Or.inl rfl, ?_, ⟨j, hj, hx⟩, star Z X j hj hx⟩ + exact Or.inr (Or.inr (Or.inr (Or.inl ⟨rfl, rfl, rfl⟩))) + · refine ⟨Z, Y, X, Or.inl rfl, ?_, ⟨j, hj, hy⟩, star Z Y j hj hy⟩ + exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr ⟨rfl, rfl, rfl⟩)))) + · exact (hnoZ j hj hz).elim + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileArea.lean b/LeanPool/ApollonianSuperharmonic/TileArea.lean new file mode 100644 index 0000000000..18b1a16612 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileArea.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: TileArea] + +/-! +# TileArea + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The area $|T|$ of a prototile is the number of its constituent unit lattice +cells. This agrees with the Euclidean area of $I(T)$ because the interiors +of distinct lattice cells are disjoint. +-/ +def TileArea (T : ProtoTile) : Nat := +-- BODY + T.cells.card + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileBordering.lean b/LeanPool/ApollonianSuperharmonic/TileBordering.lean new file mode 100644 index 0000000000..ff2485e14c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileBordering.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges + +-- [TABLET NODE: TileBordering] + +/-! +# TileBordering + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Two prototiles border one another when they have no common lattice cell and +their boundary-footprint graphs share a lattice edge. A mere corner +intersection does not count as bordering, and degenerate anchor-touching does +not by itself supply a shared edge. +-/ +def TileBordering (T U : ProtoTile) : Prop := +-- BODY + Disjoint T.cells U.cells ∧ + (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U).Nonempty + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileCellComplement.lean b/LeanPool/ApollonianSuperharmonic/TileCellComplement.lean new file mode 100644 index 0000000000..9703ce7415 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileCellComplement.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: TileCellComplement] + +/-! +# TileCellComplement + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For prototiles $T$ and $U$, the cell complement $T\setminus U$ is the +prototile with cell set $T_{\rm cells}\setminus U_{\rm cells}$. It keeps +$T$'s auxiliary anchor; whenever the complement is nonempty this anchor is +irrelevant. +-/ +def TileCellComplement (T U : ProtoTile) : ProtoTile := +-- BODY + ⟨T.cells \ U.cells, T.anchor⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileCellComplementCovariance.lean b/LeanPool/ApollonianSuperharmonic/TileCellComplementCovariance.lean new file mode 100644 index 0000000000..c823d1392a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileCellComplementCovariance.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: TileCellComplementCovariance] + +/-! +# TileCellComplementCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TileCellComplementCovariance : ∀ (T U : ProtoTile) (u : GaussianInt), + TileTranslation (TileCellComplement T U) u = + TileCellComplement (TileTranslation T u) (TileTranslation U u) ∧ + TileQuarterTurn (TileCellComplement T U) = + TileCellComplement (TileQuarterTurn T) (TileQuarterTurn U) ∧ + TileReflection (TileCellComplement T U) = + TileCellComplement (TileReflection T) (TileReflection U) := by +-- BODY + have tile_equality : ∀ (A B : ProtoTile), + A.cells = B.cells → A.anchor = B.anchor → A = B := by + intro A B hc ha + cases A with + | mk ac aa => + cases B with + | mk bc ba => + simp_all + have image_difference : ∀ (A B : Finset GaussianInt) + (f : GaussianInt → GaussianInt), Function.Injective f → + (A \ B).image f = A.image f \ B.image f := by + intro A B f hf + exact Finset.image_sdiff A B hf + have translation_injective (u : GaussianInt) : + Function.Injective (GaussianTranslation u) := by + intro a b h + dsimp [GaussianTranslation] at h + exact add_right_cancel h + have quarter_injective : Function.Injective GaussianQuarterTurn := by + intro a b h + apply Zsqrtd.ext + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.im) h + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.re) h + have reflection_injective : Function.Injective GaussianReflection := by + intro a b h + apply Zsqrtd.ext + · simpa [GaussianReflection] using congrArg (fun z : GaussianInt => z.re) h + · simpa [GaussianReflection] using congrArg (fun z : GaussianInt => -z.im) h + intro T U u + constructor + · apply tile_equality + · simp only [TileTranslation, TileCellComplement] + exact image_difference T.cells U.cells (GaussianTranslation u) + (translation_injective u) + · simp only [TileTranslation, TileCellComplement] + constructor + · apply tile_equality + · simp only [TileQuarterTurn, TileCellComplement] + exact image_difference T.cells U.cells + (fun x => GaussianQuarterTurn x - 1) (by + intro a b h + apply quarter_injective + have shifted := congrArg (fun z : GaussianInt => z + 1) h + simpa using shifted) + · simp only [TileQuarterTurn, TileCellComplement] + · apply tile_equality + · simp only [TileReflection, TileCellComplement] + exact image_difference T.cells U.cells + (fun x => GaussianReflection x - ⟨0, 1⟩) (by + intro a b h + apply reflection_injective + have shifted := congrArg (fun z : GaussianInt => z + ⟨0, 1⟩) h + simpa using shifted) + · simp only [TileReflection, TileCellComplement] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileCentroid.lean b/LeanPool/ApollonianSuperharmonic/TileCentroid.lean new file mode 100644 index 0000000000..bffeb6d8dd --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileCentroid.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: TileCentroid] + +/-! +# TileCentroid + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a nonempty prototile, $\operatorname{cent}(T)$ is the arithmetic mean +of the centers $x+(1+i)/2$ of its unit cells, equivalently the Euclidean +centroid of $I(T)$. For an empty prototile it is its designated anchor. +-/ +noncomputable def TileCentroid (T : ProtoTile) : Real × Real := +-- BODY + if T.cells.Nonempty then + ((((T.cells.sum fun x => x.re : Int) : Real) / T.cells.card + (1 / 2 : Real)), + (((T.cells.sum fun x => x.im : Int) : Real) / T.cells.card + (1 / 2 : Real))) + else ((((T.anchor.re : Int) : Real)), (((T.anchor.im : Int) : Real))) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileDiskAreaCovariance.lean b/LeanPool/ApollonianSuperharmonic/TileDiskAreaCovariance.lean new file mode 100644 index 0000000000..9b80b588f4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileDiskAreaCovariance.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import LeanPool.ApollonianSuperharmonic.TileArea +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk + +-- [TABLET NODE: TileDiskAreaCovariance] + +/-! +# TileDiskAreaCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TileDiskAreaCovariance : ∀ (T : ProtoTile) (u : GaussianInt), + (LatticeTile T ↔ LatticeTile (TileTranslation T u)) ∧ + (LatticeTile T ↔ LatticeTile (TileQuarterTurn T)) ∧ + (LatticeTile T ↔ LatticeTile (TileReflection T)) ∧ + TileArea (TileTranslation T u) = TileArea T ∧ + TileArea (TileQuarterTurn T) = TileArea T ∧ + TileArea (TileReflection T) = TileArea T := by +-- BODY + intro T u + let translation : (Real × Real) ≃ₜ (Real × Real) := + (show (Real × Real) ≃ᵢ (Real × Real) from + { toEquiv := + { toFun := fun p => (p.1 + (u.re : Real), p.2 + (u.im : Real)) + invFun := fun p => (p.1 - (u.re : Real), p.2 - (u.im : Real)) + left_inv := by intro p; ext <;> simp + right_inv := by intro p; ext <;> simp } + isometry_toFun := by + apply Isometry.of_dist_eq + intro p q + simp [Prod.dist_eq, Real.dist_eq] }) + |>.toHomeomorph + let quarter : (Real × Real) ≃ₜ (Real × Real) := + (show (Real × Real) ≃ᵢ (Real × Real) from + { toEquiv := + { toFun := fun p => (-p.2, p.1) + invFun := fun p => (p.2, -p.1) + left_inv := by intro p; ext <;> simp + right_inv := by intro p; ext <;> simp } + isometry_toFun := by + apply Isometry.of_dist_eq + intro p q + simp only [Prod.dist_eq, Real.dist_eq] + rw [show -p.2 - -q.2 = -(p.2 - q.2) by ring, abs_neg] + exact max_comm _ _ }) + |>.toHomeomorph + let reflection : (Real × Real) ≃ₜ (Real × Real) := + (show (Real × Real) ≃ᵢ (Real × Real) from + { toEquiv := + { toFun := fun p => (p.1, -p.2) + invFun := fun p => (p.1, -p.2) + left_inv := by intro p; ext <;> simp + right_inv := by intro p; ext <;> simp } + isometry_toFun := by + apply Isometry.of_dist_eq + intro p q + simp only [Prod.dist_eq, Real.dist_eq] + rw [show -p.2 - -q.2 = -(p.2 - q.2) by ring, abs_neg] }) + |>.toHomeomorph + have disk_image : ∀ (S : Set (Real × Real)) (e : (Real × Real) ≃ₜ (Real × Real)), + TopologicalDisk S ↔ TopologicalDisk (e '' S) := by + intro S e + constructor + · rintro ⟨h⟩ + exact ⟨h.trans (e.image S)⟩ + · rintro ⟨h⟩ + rw [← e.symm_image_image S] + exact ⟨h.trans ((e.symm).image (e '' S))⟩ + have htranslation := TileTranslationFormulas T u + have hquarter := TileQuarterTurnFormulas T + have hreflection := TileReflectionFormulas T + have ht : LatticeTile T ↔ LatticeTile (TileTranslation T u) := by + change TopologicalDisk (TileRealization T) ↔ + TopologicalDisk (TileRealization (TileTranslation T u)) + rw [htranslation.2.2.2.1] + simpa [translation, Function.comp_def, add_comm] using disk_image _ translation + have hq : LatticeTile T ↔ LatticeTile (TileQuarterTurn T) := by + change TopologicalDisk (TileRealization T) ↔ + TopologicalDisk (TileRealization (TileQuarterTurn T)) + rw [hquarter.2.2.2.1] + simpa [quarter, Function.comp_def] using disk_image _ quarter + have hr : LatticeTile T ↔ LatticeTile (TileReflection T) := by + change TopologicalDisk (TileRealization T) ↔ + TopologicalDisk (TileRealization (TileReflection T)) + rw [hreflection.2.2.2.1] + simpa [reflection, Function.comp_def] using disk_image _ reflection + have transArea : TileArea (TileTranslation T u) = TileArea T := by + change (TileTranslation T u).cells.card = T.cells.card + rw [htranslation.1, Finset.card_image_iff.mpr] + intro a ha b hb hab + dsimp [GaussianTranslation] at hab + exact add_right_cancel hab + have quarterArea : TileArea (TileQuarterTurn T) = TileArea T := by + change (TileQuarterTurn T).cells.card = T.cells.card + rw [hquarter.1, Finset.card_image_iff.mpr] + intro a ha b hb hab + apply Zsqrtd.ext + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.im) hab + · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.re) hab + have reflectionArea : TileArea (TileReflection T) = TileArea T := by + change (TileReflection T).cells.card = T.cells.card + rw [hreflection.1, Finset.card_image_iff.mpr] + intro a ha b hb hab + apply Zsqrtd.ext + · simpa [GaussianReflection] using congrArg (fun z : GaussianInt => z.re) hab + · simpa [GaussianReflection] using congrArg (fun z : GaussianInt => -z.im) hab + exact ⟨ht, hq, hr, transArea, quarterArea, reflectionArea⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileHalfTurn.lean b/LeanPool/ApollonianSuperharmonic/TileHalfTurn.lean new file mode 100644 index 0000000000..c70a80c9f9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileHalfTurn.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: TileHalfTurn] + +/-! +# TileHalfTurn + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The origin half-turn of a prototile $T$ is the prototile $-T$ whose cell +basepoints are +$$ + \{-x-1-i:x\in T_{\rm cell}\}. +$$ +If $T$ is nonempty, its auxiliary anchor is normalized by the same +cell-basepoint rule, so that $a_{-T}=-a_T-1-i$. If $T$ is empty, its +anchor represents its singleton footprint and is instead sent as a grid +vertex, so that $a_{-T}=-a_T$. +-/ +def TileHalfTurn (T : ProtoTile) : ProtoTile := +-- BODY + { cells := T.cells.image (fun x => -x - 1 - ⟨0, 1⟩) + anchor := + if T.cells.Nonempty then -T.anchor - 1 - ⟨0, 1⟩ else -T.anchor } + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileHalfTurnFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileHalfTurnFormulas.lean new file mode 100644 index 0000000000..155d13c35a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileHalfTurnFormulas.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileHalfTurn +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: TileHalfTurnFormulas] + +/-! +# TileHalfTurnFormulas + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TileHalfTurnFormulas : ∀ T : ProtoTile, + (TileHalfTurn T).cells = + T.cells.image (fun x => -x - 1 - ⟨0, 1⟩) ∧ + (TileHalfTurn T).anchor = + (if T.cells.Nonempty then -T.anchor - 1 - ⟨0, 1⟩ else -T.anchor) ∧ + ((TileHalfTurn T).cells = ∅ ↔ T.cells = ∅) ∧ + TileHalfTurn (TileHalfTurn T) = T ∧ + (TileHalfTurn T).cells = + (TileQuarterTurn (TileQuarterTurn T)).cells ∧ + TileRealization (TileHalfTurn T) = + (fun p : Real × Real => (-p.1, -p.2)) '' TileRealization T ∧ + FootprintVertices (TileHalfTurn T) = + (fun x : GaussianInt => -x) '' FootprintVertices T ∧ + TileCentroid (TileHalfTurn T) = + (-(TileCentroid T).1, -(TileCentroid T).2) ∧ + (T.cells = ∅ → + TileHalfTurn T = TileQuarterTurn (TileQuarterTurn T)) := by +-- BODY + intro T + have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := by + rcases u with ⟨u, w⟩ + rcases v with ⟨v, z⟩ + simp_all + have half_map (x : GaussianInt) : -(-x - 1 - ⟨0, 1⟩) - 1 - ⟨0, 1⟩ = x := by + apply gaussian_equal <;> simp + have half_anchor (a : GaussianInt) : -(-a) = a := by + apply gaussian_equal <;> simp + have half_map_normal (x : GaussianInt) : + ⟨0, 1⟩ - (-x - 1) - 1 - ⟨0, 1⟩ = x := by + apply gaussian_equal <;> simp + have quarter_twice (x : GaussianInt) : + GaussianQuarterTurn (GaussianQuarterTurn x - 1) - 1 = + -x - 1 - ⟨0, 1⟩ := by + apply gaussian_equal <;> simp [GaussianQuarterTurn] + have quarter_anchor (a : GaussianInt) : + GaussianQuarterTurn (GaussianQuarterTurn a) = -a := by + apply gaussian_equal <;> simp [GaussianQuarterTurn] + have image_empty (s : Finset GaussianInt) : + s.image (fun x => -x - 1 - ⟨0, 1⟩) = ∅ ↔ s = ∅ := by + have inj : Function.Injective (fun x : GaussianInt => -x - 1 - ⟨0, 1⟩) := by + intro a b h + have := congrArg (fun z => -z - 1 - ⟨0, 1⟩) h + simpa [half_map] using this + exact Finset.image_eq_empty.trans (by simp []) + have proto_equal (A B : ProtoTile) (hc : A.cells = B.cells) + (ha : A.anchor = B.anchor) : A = B := by + cases A + cases B + simp_all + have cell_half_quarter : + (TileHalfTurn T).cells = (TileQuarterTurn (TileQuarterTurn T)).cells := by + simp only [TileHalfTurn, TileQuarterTurn, Finset.image_image] + apply Finset.image_congr + intro x hx + exact (quarter_twice x).symm + constructor + · rfl + constructor + · rfl + constructor + · exact image_empty T.cells + constructor + · apply proto_equal + · simp? [TileHalfTurn] + change (T.cells.image (fun x => -x - 1 - ⟨0, 1⟩)).image + (fun x => -x - 1 - ⟨0, 1⟩) = T.cells + rw [Finset.image_image] + rw [show (fun x : GaussianInt => -x - 1 - (⟨0, 1⟩ : GaussianInt)) ∘ + (fun x : GaussianInt => -x - 1 - (⟨0, 1⟩ : GaussianInt)) = + (fun x : GaussianInt => x) by + funext x + simpa [Function.comp_def] using half_map x] + simp + · by_cases h : T.cells.Nonempty + · have hi : (T.cells.image (fun x => -x - 1 - ⟨0, 1⟩)).Nonempty := + h.image _ + simpa [TileHalfTurn, h, hi] using half_map T.anchor + · simp [TileHalfTurn, h, half_anchor] + constructor + · exact cell_half_quarter + constructor + · rw [show TileRealization (TileHalfTurn T) = + TileRealization (TileQuarterTurn (TileQuarterTurn T)) by + simp [TileRealization, cell_half_quarter]] + rw [(TileQuarterTurnFormulas (TileQuarterTurn T)).2.2.2.1, + (TileQuarterTurnFormulas T).2.2.2.1] + ext p + simp [Set.image_image] + constructor + · have hverts : FootprintVertices (TileHalfTurn T) = + FootprintVertices (TileQuarterTurn (TileQuarterTurn T)) := by + by_cases h : T.cells.Nonempty + · have hq : (TileQuarterTurn (TileQuarterTurn T)).cells.Nonempty := by + rw [← cell_half_quarter] + simp [TileHalfTurn, h] + simp [FootprintVertices, hq, cell_half_quarter] + · have he : T.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp h + simp [FootprintVertices, he, TileHalfTurn, + TileQuarterTurn, quarter_anchor] + rw [hverts, (TileQuarterTurnFormulas (TileQuarterTurn T)).2.2.2.2.2.1, + (TileQuarterTurnFormulas T).2.2.2.2.2.1] + ext v + simp [Set.image_image, quarter_anchor] + constructor + · by_cases h : T.cells.Nonempty + · have hq : (TileQuarterTurn (TileQuarterTurn T)).cells.Nonempty := by + rw [← cell_half_quarter] + simp [TileHalfTurn, h] + have hc : TileCentroid (TileHalfTurn T) = + TileCentroid (TileQuarterTurn (TileQuarterTurn T)) := by + simp [TileCentroid, hq, cell_half_quarter] + change TileCentroid (TileHalfTurn T) = + (-(TileCentroid T).1, -(TileCentroid T).2) + rw [hc, (TileQuarterTurnFormulas (TileQuarterTurn T)).2.2.2.2.1, + (TileQuarterTurnFormulas T).2.2.2.2.1] + · have he : (TileHalfTurn T).cells = ∅ := by + have hz : T.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp h + simp [TileHalfTurn, hz] + have hz : T.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp h + simp [TileCentroid, hz, TileHalfTurn] + · intro h + apply proto_equal + · exact cell_half_quarter + · simp [TileHalfTurn, TileQuarterTurn, h, quarter_anchor] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometer.lean b/LeanPool/ApollonianSuperharmonic/TileOdometer.lean new file mode 100644 index 0000000000..02388b3766 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileOdometer.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.OdometerTranslation +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope + +-- [TABLET NODE: TileOdometer] + +/-! +# TileOdometer + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A partial odometer $h_0$ with domain the footprint of a band prototile +$T_0$ is a tile odometer for $C_0$ when it belongs to the following +recursive family. + +If $C_0=(0,\pm1)$, then $T_0$ is the empty prototile with an assigned +anchor $x$, the domain of $h_0$ is the singleton $\{x\}$, and its sole +value is arbitrary. No slope is assigned in this case. + +If $C_0=(1,1+2z)$, then $T_0$ is a single unit cell (with arbitrary +auxiliary anchor) and $h_0$ is an +odometer translation, in the sense of `OdometerTranslation`, of +the standard four-vertex function `CurvatureOneOdometer`. + +Finally, suppose $(C_0,C_1,C_2,C_3)$ is proper and $T_0$ is a +`BandPrototile` for $C_0$. Choose the six recursively constructed +parent prototiles and tile odometers $h_i^\pm$ appearing in its six-piece +decomposition. Their footprints +cover the footprint of $T_0$, their values agree with $h_0$ wherever they +are defined, and they are pairwise compatible in the sense of +`OdometerCompatibility`. For every cyclic ordering $(i,j,k)$ of +$(1,2,3)$ their centroids satisfy +$$ + \operatorname{cent}(T_i^\pm)-\operatorname{cent}(T_0) + =\pm\tfrac12(v_{kj}-iv_{kj}). +$$ +When $c_i>0$, both slopes are defined and +$$ + \operatorname{slope}(h_i^\pm)-\operatorname{slope}(h_0) + =\pm\tfrac12(a_{kj}+ia_{kj}). +$$ +When $c_i=0$ this slope clause is replaced by the zero-curvature +alternative, so it never extracts a slope from a singleton. The six +$h_i^\pm$ are the immediate subodometers of this displayed decomposition. +-/ +inductive TileOdometer : CircleCoordinates → ProtoTile → PartialOdometer → Prop where +-- BODY + | line (w x : GaussianInt) (hw : w = 1 ∨ w = -1) + (h : PartialOdometer) (hdom : h.domain = {x}) : + TileOdometer (0, w) ⟨∅, x⟩ h + | unit (z x : GaussianInt) (T : ProtoTile) (h : PartialOdometer) + (hT : T.cells = {x}) + (hdom : (h.domain : Set GaussianInt) = FootprintVertices T) + (htrans : OdometerTranslation h (CurvatureOneOdometer z)) : + TileOdometer (1, 1 + 2 * z) T h + | decompose {q : Fin 4 → CircleCoordinates} (hq : ProperBandQuadruple q) + {S : Fin 3 → Bool → ProtoTile} {T : ProtoTile} + {hs : Fin 3 → Bool → PartialOdometer} {h : PartialOdometer} + (hT : BandPrototile (q 0) T) + (hsub : ∀ i s, TileOdometer (q i.succ) (S i s) (hs i s)) + (hcells : ∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (S i s).cells) + (hfoot : ∀ i s, FootprintVertices (S i s) ⊆ FootprintVertices T) + (hcentroid : ∀ i s, + TileCentroid (S i s) - TileCentroid T = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1)))) + (hdom : ∀ x, x ∈ h.domain ↔ ∃ i s, x ∈ (hs i s).domain) + (hvalue : ∀ i s x, x ∈ (hs i s).domain → h.value x = (hs i s).value x) + (hcompat : ∀ i s j t, OdometerCompatibility (hs i s) (hs j t)) + (hslope : ∀ i s, (q i.succ).1 = 0 ∨ + ∃ p p_i : ℝ × ℝ, + PartialOdometerSlope h = some p ∧ + PartialOdometerSlope (hs i s) = some p_i ∧ + p_i.1 - p.1 = + (if s = true then (1 : ℝ) else -1) * (1 / 2) * + (((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).re : ℤ) - + ((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).im : ℤ)) ∧ + p_i.2 - p.2 = + (if s = true then (1 : ℝ) else -1) * (1 / 2) * + (((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).im : ℤ) + + ((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).re : ℤ))) : + TileOdometer (q 0) T h + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerAffineTranslation.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerAffineTranslation.lean new file mode 100644 index 0000000000..c45712270b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerAffineTranslation.lean @@ -0,0 +1,153 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.OdometerTranslation +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: TileOdometerAffineTranslation] + +/-! +# TileOdometerAffineTranslation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TileOdometerAffineTranslation + (C : CircleCoordinates) (T : ProtoTile) (h : PartialOdometer) + (u a : GaussianInt) (b : ℤ) (hO : TileOdometer C T h) : + TileOdometer C (TileTranslation T u) + (PartialOdometerAffineTranslate h u a b) := by +-- BODY + induction hO with + | line w x hw h hdom => + change TileOdometer (0, w) ⟨∅, GaussianTranslation u x⟩ + (PartialOdometerAffineTranslate h u a b) + refine TileOdometer.line w (GaussianTranslation u x) hw + (PartialOdometerAffineTranslate h u a b) ?_ + rw [PartialOdometerAffineTranslateFormulas h u a b |>.1, hdom] + simp [GaussianTranslation] + | unit z x T h hT hdom htrans => + refine TileOdometer.unit z (GaussianTranslation u x) + (TileTranslation T u) + (PartialOdometerAffineTranslate h u a b) ?_ ?_ ?_ + · rw [(TileTranslationFormulas T u).1, hT] + simp [GaussianTranslation] + · exact ((PartialOdometerAffineTranslateFormulas h u a b).2.2.2.2.1) + _ hdom + · rcases htrans with ⟨v, c, d, hv, hval⟩ + refine ⟨GaussianTranslation u v, c + a, + d - c.re * u.re - c.im * u.im + b, ?_, ?_⟩ + · intro y + constructor + · intro hy + have hy' := ((PartialOdometerAffineTranslateFormulas h u a b).2.1 y).mp hy + simpa [GaussianTranslation, sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] using (hv (y - u)).mp hy' + · intro hy + apply ((PartialOdometerAffineTranslateFormulas h u a b).2.1 y).mpr + apply (hv (y - u)).mpr + simpa [GaussianTranslation, sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] using hy + · intro y hy + rw [(PartialOdometerAffineTranslateFormulas h u a b).2.2.1 y hy] + rw [hval (y - u) (((PartialOdometerAffineTranslateFormulas h u a b).2.1 y).mp hy)] + dsimp [GaussianTranslation] + ring_nf + | @decompose qd hq Sd Td hsd hd hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + refine TileOdometer.decompose (q := qd) + (S := fun i s => TileTranslation (Sd i s) u) + (T := TileTranslation Td u) + (hs := fun i s => PartialOdometerAffineTranslate (hsd i s) u a b) + (h := PartialOdometerAffineTranslate hd u a b) hq + (BandPrototileTranslation _ Td u hT) ?_ ?_ ?_ ?_ ?_ ?_ ?_ ?_ + · intro i s + exact ih i s + · intro x + rw [(TileTranslationFormulas Td u).1] + change x ∈ Td.cells.image (GaussianTranslation u) ↔ + ∃ i s, x ∈ (Sd i s).cells.image (GaussianTranslation u) + simp only [Finset.mem_image] + constructor + · rintro ⟨y, hy, rfl⟩ + obtain ⟨i, s, hy'⟩ := (hcells y).mp hy + exact ⟨i, s, y, hy', rfl⟩ + · rintro ⟨i, s, y, hy, rfl⟩ + exact ⟨y, (hcells y).mpr ⟨i, s, hy⟩, rfl⟩ + · intro i s x hx + obtain ⟨y, hy, rfl⟩ := by + simpa only [(TileTranslationFormulas (Sd i s) u).2.2.2.2.2.1] + using hx + have hy' := hfoot i s hy + rw [(TileTranslationFormulas Td u).2.2.2.2.2.1] + exact ⟨y, hy', rfl⟩ + · intro i s + obtain ⟨_, _, _, _, fS, _, _⟩ := TileTranslationFormulas (Sd i s) u + obtain ⟨_, _, _, _, fT, _, _⟩ := TileTranslationFormulas Td u + rw [fS, fT] + dsimp + convert hcentroid i s using 1; ext <;> + simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] + · intro x + constructor + · intro hx + obtain ⟨i, s, hy⟩ := (hdom (x - u)).mp + (((PartialOdometerAffineTranslateFormulas hd u a b).2.1 x).mp hx) + exact ⟨i, s, ((PartialOdometerAffineTranslateFormulas (hsd i s) u a b).2.1 x).mpr hy⟩ + · rintro ⟨i, s, hx⟩ + apply ((PartialOdometerAffineTranslateFormulas hd u a b).2.1 x).mpr + apply (hdom (x - u)).mpr + exact ⟨i, s, ((PartialOdometerAffineTranslateFormulas (hsd i s) u a b).2.1 x).mp hx⟩ + · intro i s x hx + have hx' := ((PartialOdometerAffineTranslateFormulas (hsd i s) u a b).2.1 x).mp hx + have hxo := (hdom (x - u)).mpr ⟨i, s, hx'⟩ + have hxo' := ((PartialOdometerAffineTranslateFormulas hd u a b).2.1 x).mpr hxo + rw [(PartialOdometerAffineTranslateFormulas hd u a b).2.2.1 x hxo'] + rw [(PartialOdometerAffineTranslateFormulas (hsd i s) u a b).2.2.1 x hx] + rw [hvalue i s (x - u) hx'] + · intro i s j t + rcases hcompat i s j t with hd | ⟨c, hc⟩ + · left + apply Set.disjoint_left.2 + intro x hx hy + apply Set.disjoint_left.1 hd + · exact ((PartialOdometerAffineTranslateFormulas (hsd i s) u a b).2.1 x).mp hx + · exact ((PartialOdometerAffineTranslateFormulas (hsd j t) u a b).2.1 x).mp hy + · right + refine ⟨c, ?_⟩ + intro x hx hy + have hxi := ((PartialOdometerAffineTranslateFormulas (hsd i s) u a b).2.1 x).mp hx + have hxj := ((PartialOdometerAffineTranslateFormulas (hsd j t) u a b).2.1 x).mp hy + rw [(PartialOdometerAffineTranslateFormulas (hsd j t) u a b).2.2.1 x hy] + rw [(PartialOdometerAffineTranslateFormulas (hsd i s) u a b).2.2.1 x hx] + have hc' := hc (x - u) hxi hxj + linarith + · intro i s + rcases hslope i s with hz | ⟨p, pi, hp, hpi, hdx, hdy⟩ + · exact Or.inl hz + · right + refine ⟨(p.1 + (a.re : ℝ), p.2 + (a.im : ℝ)), + (pi.1 + (a.re : ℝ), pi.2 + (a.im : ℝ)), ?_, ?_, ?_, ?_⟩ + · simpa [PartialOdometerAffineTranslateFormulas hd u a b] using hp + · simpa [PartialOdometerAffineTranslateFormulas (hsd i s) u a b] using hpi + · dsimp + linarith + · dsimp + linarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerBandPrototile.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerBandPrototile.lean new file mode 100644 index 0000000000..eb840ce65f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerBandPrototile.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.TileOdometer + +-- [TABLET NODE: TileOdometerBandPrototile] + +/-! +# TileOdometerBandPrototile + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TileOdometerBandPrototile (C : CircleCoordinates) (T : ProtoTile) + (h : PartialOdometer) (hodo : TileOdometer C T h) : + BandPrototile C T := by +-- BODY + induction hodo with + | line w x hw h hdom => + exact BandPrototile.line w x hw + | unit z x T h hT hdom htrans => + cases T with + | mk cells anchor => + simp_all only + exact BandPrototile.unit z x anchor + | decompose hq hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + exact hT + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean new file mode 100644 index 0000000000..a0a4581077 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean @@ -0,0 +1,438 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.OdometerTranslation +public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurn +public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile + +-- [TABLET NODE: TileOdometerCentralSymmetry] + +/-! +# TileOdometerCentralSymmetry + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CentralSymmetryGeometry + +private theorem gaussian_equal : + (by + classical + exact + ∀ (u : GaussianInt), ∀ (v : GaussianInt), (u.re = v.re) → ((u.im = v.im) → (u = v)) ) := by + classical + intro u v hre him + rcases u with ⟨u, u'⟩ + rcases v with ⟨v, v'⟩ + simp_all + +private theorem unit_reflection : + (by + classical + exact + ∀ (z : GaussianInt), ∀ (r : GaussianInt), (r ∈ (CurvatureOneOdometer z).domain) → (1 + + (⟨0, 1⟩ : GaussianInt) - r ∈ (CurvatureOneOdometer z).domain ∧ (CurvatureOneOdometer + z).value r - (CurvatureOneOdometer z).value (1 + ⟨0, 1⟩ - r) = z.im * (r.re + r.im - + 1)) ) := by + classical + intro z r hr + simp only [CurvatureOneOdometer, Finset.mem_insert, Finset.mem_singleton] at hr + rcases hr with rfl | rfl | rfl | rfl <;> + norm_num [CurvatureOneOdometer, Zsqrtd.ext_iff] + +private theorem unit_domain : + (by + classical + exact + (∀ (z : GaussianInt), ∀ (r : GaussianInt), (r ∈ (CurvatureOneOdometer z).domain) → (1 + + (⟨0, 1⟩ : GaussianInt) - r ∈ (CurvatureOneOdometer z).domain ∧ (CurvatureOneOdometer + z).value r - (CurvatureOneOdometer z).value (1 + ⟨0, 1⟩ - r) = z.im * (r.re + r.im - + 1))) → (∀ (z : GaussianInt), ∀ (r : GaussianInt), r ∈ (CurvatureOneOdometer z).domain + ↔ 1 + (⟨0, 1⟩ : GaussianInt) - r ∈ (CurvatureOneOdometer z).domain) ) := by + classical + intro unit_reflection z r + constructor + · intro hr + exact (unit_reflection z r hr).1 + · intro hr + have hr' := (unit_reflection z (1 + ⟨0, 1⟩ - r) hr).1 + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hr' + +private theorem hdom' : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (x : GaussianInt), (h.domain = {x}) → + ((PartialOdometerHalfTurn h).domain = {-x}) ) := by + classical + intro h x hdom + ext y + rw [(PartialOdometerHalfTurnFormulas h).1, hdom] + simp only [Finset.mem_singleton] + constructor <;> intro hy + · simpa using congrArg Neg.neg hy + · simpa using congrArg Neg.neg hy + +private theorem hy'At170 : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), (y - (-2 : GaussianInt) * x = x) → (y = -x) ) + := by + classical + intro x y hy + have he : y + x + x = x := by + simpa [sub_eq_add_neg, two_mul, add_assoc] using hy + have := congrArg (fun t : GaussianInt => t - x - x) he + simpa [sub_eq_add_neg, add_assoc] using this + +private theorem hy'At178 : + (by + classical + exact + ∀ (h : PartialOdometer), ∀ (x : GaussianInt), (h.domain = {x}) → (∀ (y : GaussianInt), (y + ∈ (PartialOdometerHalfTurn h).domain) → (y = -x)) ) := by + classical + intro h x hdom y hy + have hx := ((PartialOdometerHalfTurnFormulas h).1 y).mp hy + have hx' : -y = x := by simpa [hdom] using hx + simpa using congrArg Neg.neg hx' + +private theorem reflected_translation : + (by + classical + exact + ∀ (h : PartialOdometer), (∀ (z : GaussianInt), ∀ (r : GaussianInt), (r ∈ + (CurvatureOneOdometer z).domain) → (1 + (⟨0, 1⟩ : GaussianInt) - r ∈ + (CurvatureOneOdometer z).domain ∧ (CurvatureOneOdometer z).value r - + (CurvatureOneOdometer z).value (1 + ⟨0, 1⟩ - r) = z.im * (r.re + r.im - 1))) → ((∀ (z + : GaussianInt), ∀ (r : GaussianInt), r ∈ (CurvatureOneOdometer z).domain ↔ 1 + (⟨0, + 1⟩ : GaussianInt) - r ∈ (CurvatureOneOdometer z).domain) → (∀ (z : GaussianInt), + (OdometerTranslation h (CurvatureOneOdometer z)) → (OdometerTranslation + (PartialOdometerHalfTurn h) (CurvatureOneOdometer z)))) ) := by + classical + intro h unit_reflection unit_domain z htrans + rcases htrans with ⟨v, a, b, hvdom, hvvalue⟩ + refine ⟨-v - 1 - ⟨0, 1⟩, ⟨-z.im - a.re, -z.im - a.im⟩, + b - z.im * (v.re + v.im + 1), ?_, ?_⟩ + · intro y + rw [(PartialOdometerHalfTurnFormulas h).1, hvdom, + unit_domain z (-y - v)] + have heq : 1 + (⟨0, 1⟩ : GaussianInt) - (-y - v) = + y - (-v - 1 - ⟨0, 1⟩) := by abel + rw [heq] + · intro y hy + have hmy := ((PartialOdometerHalfTurnFormulas h).1 y).mp hy + have hr := (hvdom (-y)).mp hmy + have hcalc := (unit_reflection z (-y - v) hr).2 + have heq : 1 + (⟨0, 1⟩ : GaussianInt) - (-y - v) = + y - (-v - 1 - ⟨0, 1⟩) := by abel + rw [heq] at hcalc + rw [(PartialOdometerHalfTurnFormulas h).2.1 y hy, hvvalue (-y) hmy] + dsimp at hcalc ⊢ + nlinarith + +private theorem reflected_domain : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ((↑h.domain : Set GaussianInt) = + FootprintVertices T) → (((PartialOdometerHalfTurn h).domain : Set GaussianInt) = + FootprintVertices (TileHalfTurn T)) ) := by + classical + intro T h hdom + rw [(TileHalfTurnFormulas T).2.2.2.2.2.2.1] + ext y + simp only [Finset.mem_coe, Set.mem_image] + rw [(PartialOdometerHalfTurnFormulas h).1] + constructor + · intro hy + refine ⟨-y, ?_, by simp⟩ + change -y ∈ (h.domain : Set GaussianInt) at hy + rwa [hdom] at hy + · rintro ⟨r, hr, rfl⟩ + simp only [neg_neg] + change r ∈ (h.domain : Set GaussianInt) + rwa [hdom] + +private theorem reflectedAt226 : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (z : GaussianInt), ∀ (x : GaussianInt), + (T.cells = {x}) → ((OdometerTranslation (PartialOdometerHalfTurn h) + (CurvatureOneOdometer z)) → ((((PartialOdometerHalfTurn h).domain : Set GaussianInt) + = FootprintVertices (TileHalfTurn T)) → (TileOdometer (1, 1 + 2 * z) (TileHalfTurn T) + (PartialOdometerHalfTurn h)))) ) := by + classical + intro T h z x hT reflected_translation reflected_domain + apply TileOdometer.unit z (-x - 1 - ⟨0, 1⟩) + · rw [(TileHalfTurnFormulas T).1, hT] + simp + · exact reflected_domain + · exact reflected_translation + +private theorem reflected_cells : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (x : LatticeCell), x ∈ + T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → (∀ x, x ∈ + (TileHalfTurn T).cells ↔ ∃ i s, x ∈ (TileHalfTurn (S i (!s))).cells) ) := by + classical + intro T S hcells x + rw [(TileHalfTurnFormulas T).1] + constructor + · intro hx + rcases Finset.mem_image.mp hx with ⟨r, hr, rfl⟩ + rcases (hcells r).mp hr with ⟨i, s, hs⟩ + refine ⟨i, !s, ?_⟩ + simp only [Bool.not_not] + rw [(TileHalfTurnFormulas (S i s)).1] + exact Finset.mem_image.mpr ⟨r, hs, rfl⟩ + · rintro ⟨i, s, hx⟩ + rw [(TileHalfTurnFormulas (S i (!s))).1] at hx + rcases Finset.mem_image.mp hx with ⟨r, hr, rfl⟩ + exact Finset.mem_image.mpr ⟨r, (hcells r).mpr ⟨i, !s, hr⟩, rfl⟩ + +private theorem reflected_foot : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : + Bool), FootprintVertices (S i s) ⊆ FootprintVertices T) → (∀ i, ∀ s, + FootprintVertices (TileHalfTurn (S i (!s))) ⊆ FootprintVertices (TileHalfTurn T)) ) + := by + classical + intro T S hfoot i s y hy + rw [(TileHalfTurnFormulas (S i (!s))).2.2.2.2.2.2.1] at hy + rw [(TileHalfTurnFormulas T).2.2.2.2.2.2.1] + rcases hy with ⟨r, hr, rfl⟩ + exact ⟨r, hfoot i (!s) hr, rfl⟩ + +private theorem reflected_centroid : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S i s) - TileCentroid T + = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ( + let d (i : Fin 3) : Real × Real := + let w := GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) + (1 / 2 : Real) • (w - (-w.2, w.1)) + ∀ i, ∀ s, TileCentroid (TileHalfTurn (S i (!s))) - TileCentroid (TileHalfTurn T) = (if s + = true then (1 : Real) else -1) • d i) ) := by + classical + intro T q S hcentroid d i s + rw [(TileHalfTurnFormulas (S i (!s))).2.2.2.2.2.2.2.1, + (TileHalfTurnFormulas T).2.2.2.2.2.2.2.1] + have hc := hcentroid i (!s) + have hx := congrArg Prod.fst hc + have hy := congrArg Prod.snd hc + cases s <;> apply Prod.ext <;> dsimp [d] at hx hy ⊢ <;> linarith + +private theorem reflectedAt278 : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + (ProperBandQuadruple q) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 : + ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (q + i.succ) (S i s) (hs i s)) → ((∀ (x : GaussianInt), x ∈ h.domain ↔ ∃ (i : Fin (3 : ℕ)) + (s : Bool), x ∈ (hs i s).domain) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (hs i + s).domain, h.value x = (hs i s).value x) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j + : Fin (3 : ℕ)), ∀ (t : Bool), OdometerCompatibility (hs i s) (hs j t)) → ((∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), (q i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ × ℝ) (p_i : ℝ × ℝ), + PartialOdometerSlope h = some p ∧ PartialOdometerSlope (hs i s) = some p_i ∧ p_i.1 - + p.1 = (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : + ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / + 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : + ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).re : ℝ))) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (q + i.succ) (TileHalfTurn (S i s)) (PartialOdometerHalfTurn (hs i s)) ∧ + OdometerTranslation (PartialOdometerHalfTurn (hs i s)) (hs i s)) → ((∀ x, x ∈ + (TileHalfTurn T).cells ↔ ∃ i s, x ∈ (TileHalfTurn (S i (!s))).cells) → ((∀ i, ∀ s, + FootprintVertices (TileHalfTurn (S i (!s))) ⊆ FootprintVertices (TileHalfTurn T)) → ( + let d (i : Fin 3) : Real × Real := + let w := GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) + (1 / 2 : Real) • (w - (-w.2, w.1)) + (∀ i, ∀ s, TileCentroid (TileHalfTurn (S i (!s))) - TileCentroid (TileHalfTurn T) = (if s + = true then (1 : Real) else -1) • d i) → (TileOdometer (q 0) (TileHalfTurn T) + (PartialOdometerHalfTurn h))))))))))) ) := by + classical + intro T h q hq S hs hsub hdom hvalue hcompat hslope ih reflected_cells reflected_foot d + reflected_centroid + apply TileOdometer.decompose (S := fun i s => TileHalfTurn (S i (!s))) + (hs := fun i s => PartialOdometerHalfTurn (hs i (!s))) hq + · exact BandPrototile.decompose hq + (fun i s => TileOdometerBandPrototile _ _ _ (ih i (!s)).1) + reflected_cells reflected_foot reflected_centroid + · intro i s + exact (ih i (!s)).1 + · exact reflected_cells + · exact reflected_foot + · exact reflected_centroid + · intro y + rw [(PartialOdometerHalfTurnFormulas h).1, hdom] + constructor + · rintro ⟨i, s, hy⟩ + refine ⟨i, !s, ?_⟩ + simp only [Bool.not_not] + exact ((PartialOdometerHalfTurnFormulas (hs i s)).1 y).mpr hy + · rintro ⟨i, s, hy⟩ + exact ⟨i, !s, ((PartialOdometerHalfTurnFormulas (hs i (!s))).1 y).mp hy⟩ + · intro i s y hy + have hmy := ((PartialOdometerHalfTurnFormulas (hs i (!s))).1 y).mp hy + have houter := ((PartialOdometerHalfTurnFormulas h).1 y).mpr + ((hdom (-y)).mpr ⟨i, !s, hmy⟩) + rw [(PartialOdometerHalfTurnFormulas h).2.1 y houter, + (PartialOdometerHalfTurnFormulas (hs i (!s))).2.1 y hy] + exact hvalue i (!s) (-y) hmy + · intro i s j t + rcases hcompat i (!s) j (!t) with hd | ⟨c, hc⟩ + · left + apply Set.disjoint_left.mpr + intro y hy hz + exact Set.disjoint_left.mp hd + (((PartialOdometerHalfTurnFormulas (hs i (!s))).1 y).mp hy) + (((PartialOdometerHalfTurnFormulas (hs j (!t))).1 y).mp hz) + · right + refine ⟨c, ?_⟩ + intro y hy hz + rw [(PartialOdometerHalfTurnFormulas (hs i (!s))).2.1 y hy, + (PartialOdometerHalfTurnFormulas (hs j (!t))).2.1 y hz] + exact hc (-y) + (((PartialOdometerHalfTurnFormulas (hs i (!s))).1 y).mp hy) + (((PartialOdometerHalfTurnFormulas (hs j (!t))).1 y).mp hz) + · intro i s + rcases hslope i (!s) with hz | ⟨p, pi, hp, hpi, hx, hy⟩ + · exact Or.inl hz + · right + refine ⟨(-p.1, -p.2), (-pi.1, -pi.2), ?_, ?_, ?_, ?_⟩ + · rw [(PartialOdometerHalfTurnFormulas h).2.2.2.2.2.2, hp] + rfl + · rw [(PartialOdometerHalfTurnFormulas (hs i (!s))).2.2.2.2.2.2, hpi] + rfl + · cases s <;> dsimp at hx ⊢ <;> linarith + · cases s <;> dsimp at hy ⊢ <;> linarith + +end CentralSymmetryGeometry + +theorem TileOdometerCentralSymmetry + (C : CircleCoordinates) (T : ProtoTile) (h : PartialOdometer) + (hO : TileOdometer C T h) : + TileOdometer C (TileHalfTurn T) + (PartialOdometerHalfTurn h) ∧ + OdometerTranslation (PartialOdometerHalfTurn h) h := by +-- BODY + classical + have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := CentralSymmetryGeometry.gaussian_equal u v hre him + have unit_reflection (z r : GaussianInt) + (hr : r ∈ (CurvatureOneOdometer z).domain) : + 1 + (⟨0, 1⟩ : GaussianInt) - r ∈ (CurvatureOneOdometer z).domain ∧ + (CurvatureOneOdometer z).value r - + (CurvatureOneOdometer z).value (1 + ⟨0, 1⟩ - r) = + z.im * (r.re + r.im - 1) := CentralSymmetryGeometry.unit_reflection z r hr + have unit_domain (z r : GaussianInt) : + r ∈ (CurvatureOneOdometer z).domain ↔ + 1 + (⟨0, 1⟩ : GaussianInt) - r ∈ (CurvatureOneOdometer z).domain := + CentralSymmetryGeometry.unit_domain unit_reflection z r + induction hO with + | line w x hw h hdom => + constructor + · have hdom' : (PartialOdometerHalfTurn h).domain = {-x} := CentralSymmetryGeometry.hdom' h + x hdom + have htile : TileHalfTurn (⟨∅, x⟩ : ProtoTile) = ⟨∅, -x⟩ := by + simp [TileHalfTurn] + rw [htile] + exact TileOdometer.line w (-x) hw (PartialOdometerHalfTurn h) hdom' + · refine ⟨-2 * x, 0, 0, ?_, ?_⟩ + · intro y + rw [(PartialOdometerHalfTurnFormulas h).1, hdom] + simp only [Finset.mem_singleton] + constructor + · intro hy + have hy' : y = -x := by simpa using congrArg Neg.neg hy + subst y + simp [two_mul] + · intro hy + have hy' : y = -x := CentralSymmetryGeometry.hy'At170 x y hy + subst y + simp [] + · intro y hy + have hy' : y = -x := CentralSymmetryGeometry.hy'At178 h x hdom y hy + subst y + rw [(PartialOdometerHalfTurnFormulas h).2.1 (-x) hy] + have heq : -x - -2 * x = x := by + apply gaussian_equal <;> simp <;> ring + rw [heq] + simp + | unit z x T h hT hdom htrans => + have reflected_translation : + OdometerTranslation (PartialOdometerHalfTurn h) (CurvatureOneOdometer z) := + CentralSymmetryGeometry.reflected_translation h unit_reflection unit_domain z htrans + have reflected_domain : + ((PartialOdometerHalfTurn h).domain : Set GaussianInt) = + FootprintVertices (TileHalfTurn T) := CentralSymmetryGeometry.reflected_domain T h hdom + have reflected : TileOdometer (1, 1 + 2 * z) + (TileHalfTurn T) (PartialOdometerHalfTurn h) := CentralSymmetryGeometry.reflectedAt226 + T h z x hT reflected_translation reflected_domain + refine ⟨reflected, ?_⟩ + obtain ⟨v, hv, _⟩ := TileOdometerTranslationUniqueness + (1, 1 + 2 * z) (TileHalfTurn T) T (PartialOdometerHalfTurn h) h + (by norm_num) reflected (TileOdometer.unit z x T h hT hdom htrans) + rcases hv.2.2 with ⟨a, b, hdomains, hvalues⟩ + exact ⟨v, a, b, hdomains, hvalues⟩ + | @decompose q hq S T hs h hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + have reflected_cells : ∀ x, x ∈ (TileHalfTurn T).cells ↔ + ∃ i s, x ∈ (TileHalfTurn (S i (!s))).cells := CentralSymmetryGeometry.reflected_cells T + S hcells + have reflected_foot : ∀ i s, + FootprintVertices (TileHalfTurn (S i (!s))) ⊆ + FootprintVertices (TileHalfTurn T) := CentralSymmetryGeometry.reflected_foot T S hfoot + let d (i : Fin 3) : Real × Real := + let w := GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) + (1 / 2 : Real) • (w - (-w.2, w.1)) + have reflected_centroid : ∀ i s, + TileCentroid (TileHalfTurn (S i (!s))) - TileCentroid (TileHalfTurn T) = + (if s = true then (1 : Real) else -1) • d i := + CentralSymmetryGeometry.reflected_centroid T q S hcentroid + have reflected : TileOdometer (q 0) + (TileHalfTurn T) (PartialOdometerHalfTurn h) := CentralSymmetryGeometry.reflectedAt278 + T h q hq S hs hsub hdom hvalue hcompat hslope ih reflected_cells reflected_foot + reflected_centroid + refine ⟨reflected, ?_⟩ + obtain ⟨v, hv, _⟩ := TileOdometerTranslationUniqueness + (q 0) (TileHalfTurn T) T (PartialOdometerHalfTurn h) h + (ProperBandCurvatureStructure q hq).1 reflected + (TileOdometer.decompose hq hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope) + rcases hv.2.2 with ⟨a, b, hdomains, hvalues⟩ + exact ⟨v, a, b, hdomains, hvalues⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean new file mode 100644 index 0000000000..5e171de512 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean @@ -0,0 +1,648 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandPrototileExists +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRawSupport +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification +public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer +public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction +public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.OdometerGluing +public import LeanPool.ApollonianSuperharmonic.OdometerTranslation +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem +public import LeanPool.ApollonianSuperharmonic.RightSubtileOdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation +public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.P4250T1DefinedHalfIntegralSlope +public import LeanPool.ApollonianSuperharmonic.P4250T1ParentSlopePhase +public import LeanPool.ApollonianSuperharmonic.P4250T1IntegralAffinePlacement +public import LeanPool.ApollonianSuperharmonic.P4250T1OrdinaryCompatibility +public import LeanPool.ApollonianSuperharmonic.P4250T1NestedCompatibility +public import LeanPool.ApollonianSuperharmonic.P4250T1ReflectedGluingSlope + +-- [TABLET NODE: TileOdometerExists] + +/-! +# TileOdometerExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TileOdometerExistenceGeometry + +private theorem hcurv : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), + let q' := BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + (q' 0 = BandPackingSymmetryCircleAction g C.1.1) → ((q' 0).1 = C.1.1.1) ) := by + classical + intro C q r g q' hq'0 + rw [hq'0] + exact (BandPackingSymmetryCovariance g).1 _ + +private theorem restore : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), + let q' := BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + (q' 0 = BandPackingSymmetryCircleAction g C.1.1) → (∀ (inverse : BandPackingSymmetry), (∀ + (C : CircleCoordinates), BandPackingSymmetryCircleAction inverse + (BandPackingSymmetryCircleAction g C) = C) → (∀ (U : ProtoTile), ∀ (k : + PartialOdometer), (TileOdometer (q' 0) U k) → (∃ (T : ProtoTile) (h : + PartialOdometer), BandPrototile C.1.1 T ∧ TileOdometer C.1.1 T h))) ) := by + classical + intro C q r g q' hq'0 inverse hinverse U k hk + have ho := (BandPackingSymmetryTileOdometerCovariance + inverse (q' 0) U k hk).1 + rw [hq'0, hinverse] at ho + exact ⟨_, _, TileOdometerBandPrototile _ _ _ ho, ho⟩ + +private theorem hpositive : + (by + classical + exact + (BandCircle) → ((ℕ) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g + : BandPackingSymmetry), + let q' := BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + (BandOrderedGeneralConfiguration q') → (∀ (i : Fin 3), 0 < (q' i.succ).1))) ) := by + classical + intro C n q r g q' cfg i + have hnonneg := (ProperBandCurvatureStructure q' cfg.proper).2.1 i + have hnonzero := cfg.noLine i.succ + omega + +private theorem smallT1 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' := BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (p : Fin 4 → CircleCoordinates), ∀ (V : ProtoTile), ∀ (S : Fin 3 → Bool → ProtoTile), + ProperBandQuadruple p → BandPrototile (p 0) V → (∀ i, ∀ s, BandSubtileOccurrence p V + i s (S i s)) → (∀ x, x ∈ V.cells ↔ ∃ i s, x ∈ (S i s).cells) → Int.toNat (p 0).1 < + Int.toNat (q' 0).1 → LatticeTile V ∧ TileArea V = Int.toNat (p 0).1 ∧ ∀ i, ∀ s, + LatticeTile (TileCellComplement V (S i s)) ∧ TileTouching (TileCellComplement V (S i + s)) (S i s) ) := by + classical + intro q r g q' p V S hp hV hS hcover _ + have facts := BandTileSimultaneousInduction p hp V hV + exact ⟨facts.1, facts.2.1, facts.2.2.1 S hS hcover⟩ + +private theorem smallT2 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' := BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (D : CircleCoordinates), ∀ (V : ProtoTile), BandPrototile D V → Int.toNat D.1 < + Int.toNat (q' 0).1 → QuarterTurnSymmetric V ) := by + classical + intro q r g q' D V hV _ + cases hV with + | line w x hw => + simp [QuarterTurnSymmetric, TileRealization] + | unit z x anchor => + intro p + norm_num [TileRealization, TileCentroid, ClosedSquareRealization] + constructor <;> rintro ⟨⟨h1, h2⟩, h3, h4⟩ + all_goals constructor <;> constructor <;> linarith + | decompose hp hS hcells hfoot hcentroid => + exact (BandTileSimultaneousInduction _ hp _ + (.decompose hp hS hcells hfoot hcentroid)).2.2.2.1 + +private theorem parents : + (by + classical + exact + ∀ (C : BandCircle), ∀ (n : ℕ), (∀ m < n, ∀ (C : BandCircle), C.1.1.1.toNat = m → ∃ (T : + ProtoTile) (h : PartialOdometer), BandPrototile C.1.1 T ∧ TileOdometer C.1.1 T h) → + ((C.1.1.1.toNat = n) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), + ∀ (g : BandPackingSymmetry), + let q' := BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ((q' 0).1 = C.1.1.1) → ((BandOrderedGeneralConfiguration q') → ((∀ (i : Fin 3), 0 < (q' + i.succ).1) → (∀ i : Fin 3, ∃ U k, BandPrototile (q' i.succ) U ∧ TileOdometer (q' + i.succ) U k)))))) := by + classical + intro C n ih hn q r g q' hcurv cfg hpositive i + let D : Fin 3 → BandCircle := fun i => + ⟨⟨q' i.succ, Or.inl (hpositive i), + q', cfg.proper.1, i.succ, rfl⟩, hpositive i⟩ + apply ih (q' i.succ).1.toNat ?_ (D i) rfl + rw [← hn, ← hcurv] + exact (Int.toNat_lt_toNat (by simpa [hcurv] using C.2)).2 + (cfg.proper.2 i) + +private theorem placements : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), + let q' := BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (hcurv : (q' 0).1 = C.1.1.1), ∀ (cfg : BandOrderedGeneralConfiguration q'), ∀ + (hpositive : ∀ (i : Fin 3), 0 < (q' i.succ).1), + let C' : BandCircle := + ⟨⟨q' 0, Or.inl (by simpa [hcurv] using C.2), + q', cfg.proper.1, 0, rfl⟩, by simpa [hcurv] using C.2⟩ + ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q' cfg C' T), ∀ (U : Fin + (3 : ℕ) → ProtoTile), ∀ (k : Fin (3 : ℕ) → PartialOdometer), (∀ (i : Fin (3 : ℕ)), + TileOdometer (q' i.succ) (U i) (k i)) → (∀ (p : Fin (3 : ℕ) → ℝ × ℝ), (∀ (i : Fin (3 + : ℕ)), PartialOdometerSlope (k i) = some (p i)) → (∀ (s0 : ℝ × ℝ), ∀ (z : Fin (3 : ℕ) + → GaussianInt), + let w : Fin 3 → GaussianInt := fun i => + BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ)) + (∀ (i : Fin (3 : ℕ)), p i = s0 + P4250T1SlopeOffset (w i) + GaussianRealPoint (z i)) → + (∀ (i : Fin 3), ∀ (s : Bool), ∃ h, TileOdometer (q' i.succ) (cert.P i s) h ∧ + PartialOdometerSlope h = some (s0 + (if s = true then (1 : Real) else -1) • + P4250T1SlopeOffset (w i))))) ) := by + classical + intro C q r g q' hcurv cfg hpositive C' T cert U k hk p hp s0 z w hphase i s + let ai : GaussianInt := if s = true then -z i + else -z i - (w i + GaussianQuarterTurn (w i)) + obtain ⟨h, ho, hs⟩ := P4250T1IntegralAffinePlacement + (q' i.succ) (U i) (cert.P i s) (k i) (p i) ai + (hpositive i) (hk i) (cert.outer_occurrence i s).1 (hp i) + refine ⟨h, ho, ?_⟩ + rw [hs] + congr 1 + have hr := congrArg Prod.fst (hphase i) + have hi := congrArg Prod.snd (hphase i) + cases s <;> apply Prod.ext + all_goals + simp [ai, P4250T1SlopeOffset, GaussianRealPoint, + GaussianQuarterTurn] at hr hi ⊢ + linarith + +private theorem compat_symm : + (by + classical + exact + (BandCircle) → ((ℕ) → ((Fin (4 : ℕ) → CircleCoordinates) → ((Fin (3 : ℕ)) → + ((BandPackingSymmetry) → (∀ (h : PartialOdometer), ∀ (k : PartialOdometer), + (OdometerCompatibility h k) → (OdometerCompatibility k h)))))) ) := by + classical + intro C n q r g h k hc + rcases hc with hd | ⟨c, hc⟩ + · exact Or.inl hd.symm + · refine Or.inr ⟨-c, ?_⟩ + intro x hx hy + have he := hc x hy hx + omega + +private theorem hcompat : + (by + classical + exact + ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : + Fin (3 : ℕ)), ∀ (t : Bool), ¬(i = (0 : Fin (3 : ℕ)) ∧ j = (0 : Fin (3 : ℕ)) ∧ s ≠ t ∨ + (i = (0 : Fin (3 : ℕ)) ∧ j = (1 : Fin (3 : ℕ)) ∨ i = (1 : Fin (3 : ℕ)) ∧ j = (0 : Fin + (3 : ℕ))) ∧ s = t) → OdometerCompatibility (hs i s) (hs j t)) → + ((OdometerCompatibility (hs (0 : Fin (3 : ℕ)) true) (hs (1 : Fin (3 : ℕ)) true) ∧ + OdometerCompatibility (hs (0 : Fin (3 : ℕ)) false) (hs (1 : Fin (3 : ℕ)) false) ∧ + OdometerCompatibility (hs (0 : Fin (3 : ℕ)) true) (hs (0 : Fin (3 : ℕ)) false)) → ((∀ + (h : PartialOdometer), ∀ (k : PartialOdometer), (OdometerCompatibility h k) → + (OdometerCompatibility k h)) → (∀ i, ∀ s, ∀ j, ∀ t, OdometerCompatibility (hs i s) + (hs j t)))) ) := by + classical + intro hs hord hnest compat_symm i s j t + fin_cases i <;> fin_cases j <;> cases s <;> cases t + all_goals first + | exact hord _ _ _ _ (by decide) + | exact hnest.1 + | exact hnest.2.1 + | exact hnest.2.2 + | exact compat_symm _ _ hnest.1 + | exact compat_symm _ _ hnest.2.1 + | exact compat_symm _ _ hnest.2.2 + +private theorem hTne : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), + let q' := BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (hcurv : (q' 0).1 = C.1.1.1), ∀ (cfg : BandOrderedGeneralConfiguration q'), + let C' : BandCircle := + ⟨⟨q' 0, Or.inl (by simpa [hcurv] using C.2), + q', cfg.proper.1, 0, rfl⟩, by simpa [hcurv] using C.2⟩ + ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q' cfg C' T), (∀ (i : + Fin 3), ∀ (s : Bool), (cert.P i s).cells.Nonempty) → (T.cells.Nonempty) ) := by + classical + intro C q r g q' hcurv cfg C' T cert hPne + obtain ⟨x, hx⟩ := hPne 0 true + exact ⟨x, (cert.outer_union x).2 ⟨0, true, hx⟩⟩ + +private theorem hcover : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), + let q' := BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (hcurv : (q' 0).1 = C.1.1.1), ∀ (cfg : BandOrderedGeneralConfiguration q'), + let C' : BandCircle := + ⟨⟨q' 0, Or.inl (by simpa [hcurv] using C.2), + q', cfg.proper.1, 0, rfl⟩, by simpa [hcurv] using C.2⟩ + ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q' cfg C' T), ∀ (hs : + Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin 3), ∀ (s : Bool), ((hs i s).domain + : Set GaussianInt) = FootprintVertices (cert.P i s)) → ((∀ (i : Fin 3), ∀ (s : Bool), + (cert.P i s).cells.Nonempty) → ((T.cells.Nonempty) → (∀ x, x ∈ FootprintVertices T ↔ + ∃ i s, x ∈ (hs i s).domain))) ) := by + classical + intro C q r g q' hcurv cfg C' T cert hs hdomain hPne hTne x + constructor + · intro hx + rw [FootprintVertices, ite_eq_left hTne] at hx + obtain ⟨y, hy, hxy⟩ := hx + obtain ⟨i, s, hi⟩ := (cert.outer_union y).1 hy + refine ⟨i, s, ?_⟩ + change x ∈ ((hs i s).domain : Set GaussianInt) + rw [hdomain, FootprintVertices, ite_eq_left (hPne i s)] + exact ⟨y, hi, hxy⟩ + · rintro ⟨i, s, hx⟩ + apply (cert.outer_occurrence i s).2.1 + rw [← hdomain] + exact hx + +private theorem h0compat' : + (by + classical + exact + ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), + let e : Fin 6 ≃ Fin 3 × Bool := (Fintype.equivFin (Fin 3 × Bool)).symm + ∀ (h0 : PartialOdometer), (∀ (i : Fin (6 : ℕ)), OdometerCompatibility h0 (hs ((e : Fin (6 + : ℕ) → Fin (3 : ℕ) × Bool) i).1 ((e : Fin (6 : ℕ) → Fin (3 : ℕ) × Bool) i).2)) → (∀ + i, ∀ s, OdometerCompatibility h0 (hs i s)) ) := by + classical + intro hs e h0 h0compat i s + simpa using h0compat (e.symm (i, s)) + +private theorem offsets : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), + let q' := BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (hcurv : (q' 0).1 = C.1.1.1), ∀ (cfg : BandOrderedGeneralConfiguration q'), + let C' : BandCircle := + ⟨⟨q' 0, Or.inl (by simpa [hcurv] using C.2), + q', cfg.proper.1, 0, rfl⟩, by simpa [hcurv] using C.2⟩ + ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q' cfg C' T), ∀ (hs : + Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin 3), ∀ (s : Bool), ((hs i s).domain + : Set GaussianInt) = FootprintVertices (cert.P i s)) → ((∀ (i : Fin 3), ∀ (s : Bool), + (cert.P i s).cells.Nonempty) → ((∀ x, x ∈ FootprintVertices T ↔ ∃ i s, x ∈ (hs i + s).domain) → (∀ (h0 : PartialOdometer), ((↑h0.domain : Set GaussianInt) = + FootprintVertices T) → ((∀ i, ∀ s, OdometerCompatibility h0 (hs i s)) → (∀ i, ∀ s, ∃ + c : Int, ∀ x, x ∈ (hs i s).domain → (hs i s).value x - h0.value x = c))))) ) := by + classical + intro C q r g q' hcurv cfg C' T cert hs hdomain hPne hcover h0 h0dom h0compat' i s + have hne : (hs i s).domain.Nonempty := by + obtain ⟨x, hx⟩ := hPne i s + refine ⟨x, ?_⟩ + change x ∈ ((hs i s).domain : Set GaussianInt) + rw [hdomain, FootprintVertices, ite_eq_left (hPne i s)] + exact ⟨x, hx, Or.inl rfl⟩ + rcases h0compat' i s with hd | ⟨c, hc⟩ + · obtain ⟨x, hx⟩ := hne + have hx0 : x ∈ h0.domain := by + change x ∈ (h0.domain : Set GaussianInt) + rw [h0dom] + exact (hcover x).2 ⟨i, s, hx⟩ + exact (Set.disjoint_left.mp hd hx0 hx).elim + · refine ⟨c, ?_⟩ + intro x hx + apply hc x _ hx + change x ∈ (h0.domain : Set GaussianInt) + rw [h0dom] + exact (hcover x).2 ⟨i, s, hx⟩ + +private theorem hndom : + (by + classical + exact + ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (c : Fin (3 : ℕ) → Bool → ℤ), + let hn : Fin 3 → Bool → PartialOdometer := fun i s => + PartialOdometerAffineTranslate (hs i s) 0 0 (-c i s) + ∀ (i : Fin 3), ∀ (s : Bool), ∀ (x : GaussianInt), x ∈ (hn i s).domain ↔ x ∈ (hs i + s).domain ) := by + classical + intro hs c hn i s x + simpa [hn] using + (PartialOdometerAffineTranslateFormulas (hs i s) 0 0 (-c i s)).2.1 x + +private theorem hnvalue : + (by + classical + exact + (BandCircle) → ((ℕ) → (∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (c : Fin (3 : ℕ) + → Bool → ℤ), + let hn : Fin 3 → Bool → PartialOdometer := fun i s => + PartialOdometerAffineTranslate (hs i s) 0 0 (-c i s) + ∀ (h0 : PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (hs i s).domain, (hs + i s).value x - h0.value x = c i s) → ((Fin (4 : ℕ) → CircleCoordinates) → ((Fin (3 : + ℕ)) → ((BandPackingSymmetry) → ((∀ (i : Fin 3), ∀ (s : Bool), ∀ (x : GaussianInt), x + ∈ (hn i s).domain ↔ x ∈ (hs i s).domain) → (∀ (i : Fin 3), ∀ (s : Bool), ∀ (x : + GaussianInt), (x ∈ (hn i s).domain) → (h0.value x = (hn i s).value x)))))))) ) := by + classical + intro C n hs c hn h0 hc q r g hndom i s x hx + have hv := (PartialOdometerAffineTranslateFormulas + (hs i s) 0 0 (-c i s)).2.2.1 x hx + have he := hc i s x ((hndom i s x).1 hx) + simp? at hv + change (hn i s).value x = (hs i s).value x + -c i s at hv + omega + +private theorem hnsub : + (by + classical + exact + ∀ (C : BandCircle), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (c : Fin (3 : ℕ) → + Bool → ℤ), + let hn : Fin 3 → Bool → PartialOdometer := fun i s => + PartialOdometerAffineTranslate (hs i s) 0 0 (-c i s) + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' := BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (hcurv : (q' 0).1 = C.1.1.1), ∀ (cfg : BandOrderedGeneralConfiguration q'), (∀ (i : Fin + 3), 0 < (q' i.succ).1) → ( + let C' : BandCircle := + ⟨⟨q' 0, Or.inl (by simpa [hcurv] using C.2), + q', cfg.proper.1, 0, rfl⟩, by simpa [hcurv] using C.2⟩ + ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q' cfg C' T), (∀ (i : + Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (q' i.succ) (cert.P i s) (hs i s)) → (∀ (i : + Fin 3), ∀ (s : Bool), TileOdometer (q' i.succ) (cert.P i s) (hn i s)))) := by + classical + intro C hs c hn q r g q' hcurv cfg hpositive C' T cert hsub i s + apply PositiveCurvatureTileOdometerSupportTransport _ + (TileTranslation (cert.P i s) 0) _ _ (hpositive i) + (TileOdometerAffineTranslation _ _ _ 0 0 (-c i s) (hsub i s)) + (cert.outer_occurrence i s).1 + have hzero : GaussianTranslation 0 = id := by + funext x + simp [GaussianTranslation] + simp [TileTranslation, hzero] + +private theorem hnslope : + (by + classical + exact + ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (c : Fin (3 : ℕ) → Bool → ℤ), + let hn : Fin 3 → Bool → PartialOdometer := fun i s => + PartialOdometerAffineTranslate (hs i s) 0 0 (-c i s) + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), + let q' := BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (s0 : ℝ × ℝ), + let w : Fin 3 → GaussianInt := fun i => + BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ)) + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), PartialOdometerSlope (hs i s) = some (s0 + (if s = + true then (1 : ℝ) else (-1 : ℝ)) • P4250T1SlopeOffset (w i))) → (∀ (i : Fin 3), ∀ + (s : Bool), PartialOdometerSlope (hn i s) = some (s0 + (if s = true then (1 : Real) + else -1) • P4250T1SlopeOffset (w i))) ) := by + classical + intro hs c hn q r g q' s0 w hslope i s + change PartialOdometerSlope + (PartialOdometerAffineTranslate (hs i s) 0 0 (-c i s)) = _ + rw [(PartialOdometerAffineTranslateFormulas + (hs i s) 0 0 (-c i s)).2.2.2.2.2, hslope] + simp only [Option.map_some, + show (0 : GaussianInt).re = 0 from rfl, + show (0 : GaussianInt).im = 0 from rfl, + Int.cast_zero, add_zero] + +end TileOdometerExistenceGeometry + +theorem TileOdometerExists (C : BandCircle) : + ∃ (T : ProtoTile) (h : PartialOdometer), + BandPrototile C.1.1 T ∧ TileOdometer C.1.1 T h := by +-- BODY + classical + have existence : ∀ n : Nat, ∀ C : BandCircle, C.1.1.1.toNat = n → + ∃ (T : ProtoTile) (h : PartialOdometer), + BandPrototile C.1.1 T ∧ TileOdometer C.1.1 T h := by + intro n + induction n using Nat.strong_induction_on with + | h n ih => + intro C hn + by_cases hc : C.1.1.1 = 1 + · obtain ⟨z, hz⟩ := CurvatureOneBandCircleClassification C hc + let T : ProtoTile := ⟨{0}, 0⟩ + let h := CurvatureOneOdometer z + refine ⟨T, h, ?_, ?_⟩ + · rw [hz] + exact BandPrototile.unit z 0 0 + · rw [hz] + apply TileOdometer.unit z 0 T h + · rfl + · ext x + simp [h, T, FootprintVertices, CurvatureOneOdometer] + · refine ⟨0, 0, 0, ?_, ?_⟩ + · intro x + simp [h] + · intro x hx + simp [h] + · obtain hunit | ⟨q, hq, hq0, hsmall, _⟩ := BandGenealogy C + · exact (hc hunit).elim + have hproper : ProperBandQuadruple q := + ⟨hq, by simpa [hq0] using hsmall⟩ + obtain ⟨r, g, hregime⟩ := BandRegimeClassification q hproper + let q' := BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + change Xor (∃ P : FordFareyParameter, 1 < P.q ∧ + q' = FordRecursiveQuadruple P) + (Xor (∃ K : DiamondParameter, 1 < K.1 ∧ + q' = DiamondRecursiveQuadruple K) + (Nonempty (BandOrderedGeneralConfiguration q'))) at hregime + have hq'0 : q' 0 = BandPackingSymmetryCircleAction g C.1.1 := by + simp [q', BandPackingSymmetryQuadrupleAction, hq0] + have hcurv : (q' 0).1 = C.1.1.1 := TileOdometerExistenceGeometry.hcurv C q r g hq'0 + obtain ⟨inverse, hinverse, _⟩ := + BandPackingSymmetryInversePhaseCancellation.2 g + have restore := TileOdometerExistenceGeometry.restore C q r g hq'0 inverse hinverse + have normalized : ∃ U k, TileOdometer (q' 0) U k := by + rcases hregime with ⟨⟨P, _, hP⟩, _⟩ | ⟨hother, _⟩ + · obtain ⟨h, ho, _⟩ := FordTileOdometerRestriction P + refine ⟨FordTile P.q, h, ?_⟩ + simpa [hP, FordRecursiveQuadruple] using ho + · rcases hother with ⟨⟨K, _, hK⟩, _⟩ | ⟨⟨cfg⟩, _⟩ + · obtain ⟨h, ho, _⟩ := DiamondTileOdometerRestriction K + exact ⟨DiamondTile K.1, h, by simpa [hK] using ho⟩ + · have hpositive (i : Fin 3) := TileOdometerExistenceGeometry.hpositive C n q r g cfg i + let C' : BandCircle := + ⟨⟨q' 0, Or.inl (by simpa [hcurv] using C.2), + q', cfg.proper.1, 0, rfl⟩, by simpa [hcurv] using C.2⟩ + obtain ⟨T, hT⟩ := BandPrototileExists C'.1 + change BandPrototile (q' 0) T at hT + -- Discharge the smaller layout premises, including line and unit T2. + have smallT1 := TileOdometerExistenceGeometry.smallT1 q r g + have smallT2 := TileOdometerExistenceGeometry.smallT2 q r g + obtain ⟨cert⟩ := BandOrderedGeneralLayout q' cfg C' rfl T hT + smallT1 smallT2 + (by + intro p V U hp hV _ hlarge i hU hcent + exact (BandTileSimultaneousInduction p hp V hV).2.2.2.2.2.1 + hlarge i U hU hcent) + (by + intro p V U W hp hV _ i hU hW hcU hcW + exact (BandTileSimultaneousInduction p hp V hV).2.2.2.2.2.2.1 + i U W hU hW hcU hcW) + let D : Fin 3 → BandCircle := fun i => + ⟨⟨q' i.succ, Or.inl (hpositive i), + q', cfg.proper.1, i.succ, rfl⟩, hpositive i⟩ + choose U k hU hk using (TileOdometerExistenceGeometry.parents C n ih hn q r g hcurv + cfg hpositive) + choose p a hp ha hnonempty using fun i => + P4250T1DefinedHalfIntegralSlope _ (U i) (k i) (hpositive i) (hk i) + obtain ⟨s0, b, z, hb, hphase⟩ := + P4250T1ParentSlopePhase q' cfg U k p (a 0) hk hp (ha 0) + let w : Fin 3 → GaussianInt := fun i => + BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ)) + change ∀ i, p i = s0 + P4250T1SlopeOffset (w i) + + GaussianRealPoint (z i) at hphase + choose hs hsub hslope using (TileOdometerExistenceGeometry.placements C q r g hcurv + cfg hpositive T cert U k hk p hp s0 z hphase) + have hord := P4250T1OrdinaryCompatibility + q' cfg C' T cert hs s0 hsub hslope + have hnest := P4250T1NestedCompatibility + q' cfg C' T cert hs s0 hsub hslope + have hcompat := TileOdometerExistenceGeometry.hcompat hs hord hnest + (TileOdometerExistenceGeometry.compat_symm C n q r g) + have hdomain (i : Fin 3) (s : Bool) : + ((hs i s).domain : Set GaussianInt) = FootprintVertices (cert.P i s) := + PositiveCurvatureTileOdometerDomain _ _ _ (hpositive i) (hsub i s) + have hPne (i : Fin 3) (s : Bool) : (cert.P i s).cells.Nonempty := + (P4250T1DefinedHalfIntegralSlope _ _ _ (hpositive i) (hsub i s)) + |>.choose_spec.choose_spec.2.2 + have hcover : ∀ x, x ∈ FootprintVertices T ↔ ∃ i s, x ∈ (hs i s).domain := + TileOdometerExistenceGeometry.hcover C q r g hcurv cfg T cert hs hdomain hPne + (TileOdometerExistenceGeometry.hTne C q r g hcurv cfg T cert hPne) + -- Use the finite-cover gluing theorem on these actual six functions. + let e : Fin 6 ≃ Fin 3 × Bool := (Fintype.equivFin (Fin 3 × Bool)).symm + obtain ⟨h0, h0dom, h0compat, h0unique⟩ := OdometerGluing.1 + (T := T) (U := fun j => cert.P (e j).1 (e j).2) + (h := fun j => hs (e j).1 (e j).2) + (BandTileSimultaneousInduction q' cfg.proper T hT).1 + (fun j => cert.parent_lattice (e j).1 (e j).2) + (fun j => hdomain (e j).1 (e j).2) + (fun j k => hcompat _ _ _ _) + (by + intro x + constructor + · intro hx + obtain ⟨i, s, hx⟩ := (cert.outer_union x).1 hx + exact ⟨e.symm (i, s), by simpa using hx⟩ + · rintro ⟨j, hx⟩ + exact (cert.outer_union x).2 ⟨(e j).1, (e j).2, hx⟩) + (by + intro x + constructor + · intro hx + obtain ⟨i, s, hx⟩ := (hcover x).1 hx + exact ⟨e.symm (i, s), by simpa using hx⟩ + · rintro ⟨j, hx⟩ + exact (hcover x).2 ⟨(e j).1, (e j).2, hx⟩) + have h0compat' := TileOdometerExistenceGeometry.h0compat' hs h0 h0compat + obtain ⟨u, a0, hu, ha0, h0slope⟩ := + P4250T1ReflectedGluingSlope q' cfg C' T cert hs s0 hsub hslope + h0 h0dom h0compat' (by + intro g hg hgc + exact h0unique g hg (fun j => hgc (e j).1 (e j).2)) + -- Normalize the six additive constants without changing their slopes. + choose c hc using (TileOdometerExistenceGeometry.offsets C q r g hcurv cfg T cert + hs hdomain hPne hcover h0 h0dom h0compat') + let hn : Fin 3 → Bool → PartialOdometer := fun i s => + PartialOdometerAffineTranslate (hs i s) 0 0 (-c i s) + have hndom := TileOdometerExistenceGeometry.hndom hs c + have hnvalue (i : Fin 3) (s : Bool) (x : GaussianInt) + (hx : x ∈ (hn i s).domain) : h0.value x = (hn i s).value x := + TileOdometerExistenceGeometry.hnvalue C n hs c h0 hc q r g hndom i s x hx + refine ⟨T, h0, ?_⟩ + apply TileOdometer.decompose cfg.proper hT (TileOdometerExistenceGeometry.hnsub C + hs c q r g hcurv cfg hpositive T cert hsub) cert.outer_union + (fun i s => (cert.outer_occurrence i s).2.1) + (fun i s => (cert.outer_occurrence i s).2.2) + · intro x + change x ∈ (h0.domain : Set GaussianInt) ↔ _ + rw [h0dom, hcover] + exact exists_congr fun i => exists_congr fun s => (hndom i s x).symm + · exact hnvalue + · intro i s j t + refine Or.inr ⟨0, ?_⟩ + intro x hx hy + rw [← hnvalue i s x hx, ← hnvalue j t x hy] + omega + · intro i s + right + refine ⟨s0, _, h0slope, (TileOdometerExistenceGeometry.hnslope hs c q r g s0 + hslope) i s, ?_, ?_⟩ + all_goals cases s <;> simp [P4250T1SlopeOffset] <;> ring + obtain ⟨U, k, hk⟩ := normalized + exact restore U k hk + exact existence _ C rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerReindexedDecomposition.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerReindexedDecomposition.lean new file mode 100644 index 0000000000..b8d13a87d3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerReindexedDecomposition.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileOdometer + +-- [TABLET NODE: TileOdometerReindexedDecomposition] + +/-! +# TileOdometerReindexedDecomposition + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TileOdometerReindexedDecomposition + (q : Fin 4 -> CircleCoordinates) (hq : ProperBandQuadruple q) + (T : ProtoTile) (h : PartialOdometer) + (hroot : 1 < (q 0).1) (hO : TileOdometer (q 0) T h) : + exists S : Fin 3 -> Bool -> ProtoTile, + exists hs : Fin 3 -> Bool -> PartialOdometer, + BandPrototile (q 0) T /\ + (forall i s, TileOdometer (q i.succ) (S i s) (hs i s)) /\ + (forall x, x ∈ T.cells <-> exists i s, x ∈ (S i s).cells) /\ + (forall i s, FootprintVertices (S i s) ⊆ FootprintVertices T) /\ + (forall i s, + TileCentroid (S i s) - TileCentroid T = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1)))) /\ + (forall x, x ∈ h.domain <-> exists i s, x ∈ (hs i s).domain) /\ + (forall i s x, x ∈ (hs i s).domain -> h.value x = (hs i s).value x) /\ + (forall i s j t, OdometerCompatibility (hs i s) (hs j t)) /\ + forall i s, (q i.succ).1 = 0 \/ + exists p p_i : Real × Real, + PartialOdometerSlope h = some p /\ + PartialOdometerSlope (hs i s) = some p_i /\ + p_i.1 - p.1 = + (if s = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).re : Int) - + ((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).im : Int)) /\ + p_i.2 - p.2 = + (if s = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).im : Int) + + ((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).re : Int)) := by +-- BODY + generalize hc : q 0 = c at hO hroot + cases hO with + | line w x hw h hdom => + have hbad : ¬ (1 < (0 : Real)) := by norm_num + exact False.elim (hbad (by simp [] at hroot)) + | unit z x T h hT hdom htrans => + have hbad : ¬ (1 < (1 : Real)) := by norm_num + exact False.elim (hbad (by simp [] at hroot)) + | @decompose q' hq' S' T' hs' h' hT' hsub' hcells' hfoot' + hcentroid' hdom' hvalue' hcompat' hslope' => + obtain ⟨r, hr, hru⟩ := BandPredecessorNoCollision q q' hq hq' (by simp [hc]) + let slot : Fin 3 → Fin 3 := fun i => i - r + have reindex (i k : Fin 3) : + q' (slot i + k).succ = q (i + k).succ := by + calc + q' (slot i + k).succ = q ((slot i + k + r).succ) := hr _ + _ = q (i + k).succ := by + congr 1 + fin_cases r <;> fin_cases i <;> fin_cases k <;> simp [slot] + have child (i : Fin 3) : q' (slot i).succ = q i.succ := by + calc + q' (slot i).succ = q ((slot i + r).succ) := hr _ + _ = q i.succ := by + congr 1 + fin_cases r <;> fin_cases i <;> simp [slot] + refine ⟨(fun i s => S' (slot i) s), + (fun i s => hs' (slot i) s), hT', ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intro i s + simpa only [child i] using hsub' (slot i) s + · intro x + constructor + · intro hx + obtain ⟨j, s, hj⟩ := (hcells' x).mp hx + exact ⟨j + r, s, by simpa [slot] using hj⟩ + · rintro ⟨i, s, hi⟩ + exact (hcells' x).mpr ⟨slot i, s, hi⟩ + · intro i s + exact hfoot' (slot i) s + · intro i s + simpa only [reindex i 2, reindex i 1] using hcentroid' (slot i) s + · intro x + constructor + · intro hx + obtain ⟨j, s, hj⟩ := (hdom' x).mp hx + exact ⟨j + r, s, by simpa [slot] using hj⟩ + · rintro ⟨i, s, hi⟩ + exact (hdom' x).mpr ⟨slot i, s, hi⟩ + · intro i s x hx + exact hvalue' (slot i) s x hx + · intro i s j t + exact hcompat' (slot i) s (slot j) t + · intro i s + rcases hslope' (slot i) s with hz | hz + · left + simpa only [child i] using hz + · right + simpa only [reindex i 2, reindex i 1] using hz + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean new file mode 100644 index 0000000000..1fd0cdefc3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean @@ -0,0 +1,892 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction +public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer +public import LeanPool.ApollonianSuperharmonic.OdometerGluing +public import LeanPool.ApollonianSuperharmonic.OdometerTranslation +public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: TileOdometerTranslationUniqueness] + +/-! +# TileOdometerTranslationUniqueness + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace OdometerTranslationGeometry + +private theorem hTproto : + (by + classical + exact + ∀ (C : CircleCoordinates), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), (TileOdometer C T + h) → (BandPrototile C T) ) := by + classical + intro C T h hT + induction hT with + | line w x hw h hdom => + exact BandPrototile.line w x hw + | unit z x T h hT hdom htrans => + cases T with + | mk cells anchor => + dsimp at hT ⊢ + subst cells + exact BandPrototile.unit z x anchor + | decompose hq hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + exact BandPrototile.decompose hq ih hcells hfoot hcentroid + +private theorem hUproto : + (by + classical + exact + ∀ (C : CircleCoordinates), ∀ (U : ProtoTile), ∀ (g : PartialOdometer), (TileOdometer C U + g) → (BandPrototile C U) ) := by + classical + intro C U g hU + induction hU with + | line w x hw h hdom => + exact BandPrototile.line w x hw + | unit z x T h hT hdom htrans => + cases T with + | mk cells anchor => + dsimp at hT ⊢ + subst cells + exact BandPrototile.unit z x anchor + | decompose hq hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + exact BandPrototile.decompose hq ih hcells hfoot hcentroid + +private theorem proto : + (by + classical + exact + ∀ D, ∀ V, ∀ k, TileOdometer D V k → BandPrototile D V ) := by + classical + intro D V k hk + induction hk with + | line w x hw k hd => exact BandPrototile.line w x hw + | unit z x V k hc hd ht => + cases V with + | mk cells anchor => + dsimp at hc ⊢ + subst cells + exact BandPrototile.unit z x anchor + | decompose hq hV hsub hc hf hcent hd hv hcompat hslope ih => exact hV + +private theorem positive_parent : + (by + classical + exact + (CircleCoordinates) → (∀ q, ProperBandQuadruple q → ∃ i : Fin 3, 0 < (q i.succ).1) ) := by + classical + intro C q hq + have f := ProperBandCurvatureStructure q hq + by_cases h0 : 0 < (q (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (q (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + have n0 := f.2.1 0 + have n1 := f.2.1 1 + have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega + exact ((by decide : (0 : Fin 3) ≠ 1) (f.2.2 0 1 z0 z1)).elim + +private theorem proper_large : + (by + classical + exact + (CircleCoordinates) → ((∀ q, ProperBandQuadruple q → ∃ i : Fin 3, 0 < (q i.succ).1) → (∀ + q, ProperBandQuadruple q → 1 < (q 0).1)) ) := by + classical + intro C positive_parent q hq + obtain ⟨i, hi⟩ := positive_parent q hq + have hb := hq.2 i + omega + +private theorem positive_cells : + (by + classical + exact + (∀ q, ProperBandQuadruple q → ∃ i : Fin 3, 0 < (q i.succ).1) → (∀ D, ∀ V, BandPrototile D + V → 0 < D.1 → V.cells.Nonempty) ) := by + classical + intro positive_parent D V hV + induction hV with + | line w x hw => simp + | unit z x anchor => simp + | @decompose q hq S V hS hc hf hcent ih => + intro hp + obtain ⟨i, hi⟩ := positive_parent q hq + obtain ⟨x, hx⟩ := ih i false hi + exact ⟨x, (hc x).mpr ⟨i, false, hx⟩⟩ + +private theorem zero_cells : + (by + classical + exact + ∀ D, ∀ V, BandPrototile D V → D.1 = 0 → V.cells = ∅ ) := by + classical + intro D V hV hz + cases hV with + | line w x hw => rfl + | unit z x anchor => simp at hz + | decompose hq hS hc hf hcent => + have hp := (ProperBandCurvatureStructure _ hq).1 + rw [hz] at hp + exact (lt_irrefl _ hp).elim + +private theorem cent_eq : + (by + classical + exact + ∀ V W : ProtoTile, V.cells = W.cells → (V.cells = ∅ → V.anchor = W.anchor) → TileCentroid + V = TileCentroid W ) := by + classical + intro V W hc ha + by_cases hn : V.cells.Nonempty + · have hm : W.cells.Nonempty := hc ▸ hn + simp only [TileCentroid, ite_eq_left hm, hc] + · have hz := Finset.not_nonempty_iff_eq_empty.mp hn + have hm : ¬ W.cells.Nonempty := by rwa [← hc] + simp only [TileCentroid, ite_eq_right hn, ite_eq_right hm, ha hz] + +private theorem foot_eq : + (by + classical + exact + ∀ V W : ProtoTile, V.cells = W.cells → (V.cells = ∅ → V.anchor = W.anchor) → + FootprintVertices V = FootprintVertices W ) := by + classical + intro V W hc ha + by_cases hn : V.cells.Nonempty + · have hm : W.cells.Nonempty := hc ▸ hn + simp only [FootprintVertices, ite_eq_left hm, hc] + · have hz := Finset.not_nonempty_iff_eq_empty.mp hn + have hm : ¬ W.cells.Nonempty := by rwa [← hc] + simp only [FootprintVertices, ite_eq_right hn, ite_eq_right hm, ha hz] + +private theorem domains : + (by + classical + exact + (∀ V W : ProtoTile, V.cells = W.cells → (V.cells = ∅ → V.anchor = W.anchor) → + FootprintVertices V = FootprintVertices W) → (∀ D, ∀ V, ∀ W, ∀ k, ∀ l, 0 < D.1 → + TileOdometer D V k → TileOdometer D W l → ∀ u, V.cells = (TileTranslation W u).cells + → (V.cells = ∅ → V.anchor = (TileTranslation W u).anchor) → ∀ x, x ∈ k.domain ↔ x-u ∈ + l.domain) ) := by + classical + intro foot_eq D V W k l hp hk hl u hc ha x + have hd := PositiveCurvatureTileOdometerDomain D V k hp hk + have he := PositiveCurvatureTileOdometerDomain D W l hp hl + have ht := (PartialOdometerAffineTranslateFormulas l u 0 0).2.2.2.2.1 W he + have hf := foot_eq V (TileTranslation W u) hc ha + have hsame : (k.domain : Set GaussianInt) = + ((PartialOdometerAffineTranslate l u 0 0).domain : Set GaussianInt) := + hd.trans (hf.trans ht.symm) + rw [← (PartialOdometerAffineTranslateFormulas l u 0 0).2.1] + exact Set.ext_iff.mp hsame x + +private theorem affine_eq : + (by + classical + exact + ∀ (k : PartialOdometer), ∀ (l : PartialOdometer), ∀ (u : GaussianInt), ∀ (a : + GaussianInt), ∀ (b : ℤ), (∀ x, x ∈ k.domain ↔ x-u ∈ l.domain) → (∀ x, x ∈ k.domain → + k.value x = l.value (x-u) + a.re*x.re + a.im*x.im+b) → k = + PartialOdometerAffineTranslate l u a b ) := by + classical + intro k l u a b hd hv + have hh : k.domain = (PartialOdometerAffineTranslate l u a b).domain := by + ext x + rw [(PartialOdometerAffineTranslateFormulas l u a b).2.1] + exact hd x + have vv : k.value = (PartialOdometerAffineTranslate l u a b).value := by + funext x + by_cases hx : x ∈ k.domain + · rw [hv x hx, (PartialOdometerAffineTranslateFormulas l u a b).2.2.1 x + (by rwa [← hh])] + · rw [k.value_outside x hx, + (PartialOdometerAffineTranslate l u a b).value_outside x (by rwa [← hh])] + cases k + simp only [PartialOdometerAffineTranslate, PartialOdometer.mk.injEq] + exact ⟨hh, vv⟩ + +private theorem unit_shift : + (by + classical + exact + (CircleCoordinates) → (∀ (z : GaussianInt), ∀ (x : GaussianInt), ∀ (V : ProtoTile), ∀ (k + : PartialOdometer), V.cells = {x} → (k.domain : Set GaussianInt) = FootprintVertices + V → ∀ v, (∀ y, y ∈ k.domain ↔ y-v ∈ (CurvatureOneOdometer z).domain) → v=x) ) := by + classical + intro C z x V k hc hd v hv + have hn : V.cells.Nonempty := by rw [hc]; simp + have h0 : v ∈ FootprintVertices V := by + rw [← hd] + exact (hv v).mpr (by simp [CurvatureOneOdometer]) + have h1 : v+1+(⟨0,1⟩ : GaussianInt) ∈ FootprintVertices V := by + rw [← hd] + apply (hv _).mpr + rw [show v+1+(⟨0,1⟩ : GaussianInt)-v = 1+⟨0,1⟩ by abel] + simp [CurvatureOneOdometer] + simp only [FootprintVertices, hc, + Finset.mem_singleton, exists_eq_left] at h0 h1 + apply Zsqrtd.ext + · rcases h0 with h0 | h0 | h0 | h0 <;> + rcases h1 with h1 | h1 | h1 | h1 + all_goals have a := congrArg (fun w : GaussianInt => w.re) h0 + all_goals have b := congrArg (fun w : GaussianInt => w.re) h1 + all_goals simp at a b + all_goals omega + · rcases h0 with h0 | h0 | h0 | h0 <;> + rcases h1 with h1 | h1 | h1 | h1 + all_goals have a := congrArg (fun w : GaussianInt => w.im) h0 + all_goals have b := congrArg (fun w : GaussianInt => w.im) h1 + all_goals simp at a b + all_goals omega + +private theorem square_disk : + (by + classical + exact + ∀ (V : ProtoTile), ∀ (x : GaussianInt), V.cells = {x} → LatticeTile V ) := by + classical + intro V x hx + let f : ℝ × ℝ → ℝ × ℝ := fun p => + (p.1/2+(x.re : ℝ)+1/2, p.2/2+(x.im : ℝ)+1/2) + let g : ℝ × ℝ → ℝ × ℝ := fun p => + (2*(p.1-(x.re : ℝ)-1/2), 2*(p.2-(x.im : ℝ)-1/2)) + have hf : ∀ p, p ∈ Metric.closedBall (0 : ℝ × ℝ) 1 → f p ∈ TileRealization V := by + intro p hp + simp only [Metric.mem_closedBall, Prod.dist_eq, Real.dist_eq, + Prod.fst_zero, Prod.snd_zero, sub_zero, max_le_iff, abs_le] at hp + simp [TileRealization, hx, ClosedSquareRealization, f, Prod.le_def] + constructor <;> constructor <;> linarith [hp.1.1, hp.1.2, hp.2.1, hp.2.2] + have hg : ∀ p, p ∈ TileRealization V → g p ∈ Metric.closedBall (0 : ℝ × ℝ) 1 := by + intro p hp + simp? [TileRealization, hx, ClosedSquareRealization, Prod.le_def] at hp + rw [← GaussianInt.intCast_re, ← GaussianInt.intCast_im] at hp + simp only [Metric.mem_closedBall, Prod.dist_eq, Real.dist_eq, + Prod.fst_zero, Prod.snd_zero, sub_zero, max_le_iff, abs_le, g] + constructor <;> constructor <;> linarith [hp.1.1, hp.1.2, hp.2.1, hp.2.2] + have hgf : ∀ p, g (f p) = p := by intro p; ext <;> dsimp [f,g] <;> ring + have hfg : ∀ p, f (g p) = p := by intro p; ext <;> dsimp [f,g] <;> ring + refine ⟨{ + toEquiv := { + toFun := fun p => ⟨f p, hf p p.property⟩ + invFun := fun p => ⟨g p, hg p p.property⟩ + left_inv := fun p => Subtype.ext (hgf p) + right_inv := fun p => Subtype.ext (hfg p) } + continuous_toFun := ?_ + continuous_invFun := ?_ }⟩ + · apply Continuous.subtype_mk + exact (by fun_prop : Continuous f).comp continuous_subtype_val + · apply Continuous.subtype_mk + exact (by fun_prop : Continuous g).comp continuous_subtype_val + +private theorem disk : + (by + classical + exact + (∀ (V : ProtoTile), ∀ (x : GaussianInt), V.cells = {x} → LatticeTile V) → (∀ D, ∀ V, ∀ k, + TileOdometer D V k → 0 < D.1 → LatticeTile V) ) := by + classical + intro square_disk D V k hk hp + cases hk with + | line w x hw k hd => simp at hp + | unit z x V k hc hd ht => exact square_disk V x hc + | decompose hq hV hsub hc hf hcent hd hv hcompat hslope => + exact (BandTileSimultaneousInduction _ hq V hV).1 + +private theorem hzAt354 : + (by + classical + exact + (CircleCoordinates) → (∀ (z : GaussianInt), ∀ (z' : GaussianInt), (((1 : ℤ), (1 : + GaussianInt) + (2 : GaussianInt) * z') = ((1 : ℤ), (1 : GaussianInt) + (2 : + GaussianInt) * z)) → (z = z')) ) := by + classical + intro C z z' he + have hh := congrArg (fun D : CircleCoordinates => D.2) he + apply Zsqrtd.ext + · have hr := congrArg (fun w : GaussianInt => w.re) hh + simp at hr + omega + · have hi := congrArg (fun w : GaussianInt => w.im) hh + simp at hi + omega + +private theorem matched : + (by + classical + exact + (∀ D, ∀ V, ∀ k, TileOdometer D V k → BandPrototile D V) → (∀ (V : ProtoTile), ∀ (q : Fin + (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 + : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (q + i.succ) (S i s) (hs i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S i s) + - TileCentroid V = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (W : + ProtoTile), ∀ (u : GaussianInt), ∀ (R : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (rs : Fin + (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer + (q i.succ) (R i s) (rs i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (R i + s) - TileCentroid W = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • + (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → + ((TileCentroid V = TileCentroid (TileTranslation W u)) → (∀ i, ∀ s, (S i s).cells = + (TileTranslation (R i s) u).cells ∧ ((S i s).cells = ∅ → (S i s).anchor = + (TileTranslation (R i s) u).anchor))))))) ) := by + classical + intro proto V q S hs hsub hcentroid W u R rs rsub rcent houter i s + have hcent : TileCentroid (S i s) = TileCentroid (TileTranslation (R i s) u) := by + rw [(TileTranslationFormulas (R i s) u).2.2.2.2.1] + apply Prod.ext + · have he := congrArg Prod.fst houter + rw [(TileTranslationFormulas W u).2.2.2.2.1] at he + have h1 := congrArg Prod.fst (hcentroid i s) + have h2 := congrArg Prod.fst (rcent i s) + dsimp at he h1 h2 ⊢ + linarith + · have he := congrArg Prod.snd houter + rw [(TileTranslationFormulas W u).2.2.2.2.1] at he + have h1 := congrArg Prod.snd (hcentroid i s) + have h2 := congrArg Prod.snd (rcent i s) + dsimp at he h1 h2 ⊢ + linarith + exact BandPrototileCentroidUnique _ (S i s) (TileTranslation (R i s) u) + (proto _ _ _ (hsub i s)) + (BandPrototileTranslation _ _ u (proto _ _ _ (rsub i s))) hcent + +private theorem pieces : + (by + classical + exact + (∀ D, ∀ V, ∀ W, ∀ k, ∀ l, 0 < D.1 → TileOdometer D V k → TileOdometer D W l → ∀ u, + V.cells = (TileTranslation W u).cells → (V.cells = ∅ → V.anchor = (TileTranslation W + u).anchor) → ∀ x, x ∈ k.domain ↔ x-u ∈ l.domain) → (∀ (q : Fin (4 : ℕ) → + CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 : ℕ) → + Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) + (S i s) (hs i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (0 : ℤ) < (q i.succ).1 → ∀ + (W : ProtoTile), ∀ (l : PartialOdometer), TileOdometer (q i.succ) W l → ∀ (u : + GaussianInt), (S i s).cells = (TileTranslation W u).cells → ((S i s).cells = ∅ → (S i + s).anchor = (TileTranslation W u).anchor) → ∃ (a : GaussianInt) (b : ℤ), ∀ x ∈ (hs i + s).domain, (hs i s).value x = l.value (x - u) + a.re * x.re + a.im * x.im + b) → (∀ + (u : GaussianInt), ∀ (R : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (rs : Fin (3 : ℕ) → Bool + → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (R i + s) (rs i s)) → ((∀ i, ∀ s, (S i s).cells = (TileTranslation (R i s) u).cells ∧ ((S i + s).cells = ∅ → (S i s).anchor = (TileTranslation (R i s) u).anchor)) → (∀ i, ∀ s, 0 < + (q i.succ).1 → ∃ a : GaussianInt, ∃ b : ℤ, (∀ x, x ∈ (hs i s).domain ↔ x-u ∈ (rs i + s).domain) ∧ ∀ x, x ∈ (hs i s).domain → (hs i s).value x = (rs i s).value + (x-u)+a.re*x.re+a.im*x.im+b))))) ) := by + classical + intro domains q S hs hsub ih u R rs rsub matched i s hi + obtain ⟨a,b,hv⟩ := ih i s hi (R i s) (rs i s) (rsub i s) u + (matched i s).1 (matched i s).2 + exact ⟨a,b,domains _ _ _ _ _ hi (hsub i s) (rsub i s) u + (matched i s).1 (matched i s).2,hv⟩ + +private theorem coefficients : + (by + classical + exact + (CircleCoordinates) → ((∀ (k : PartialOdometer), ∀ (l : PartialOdometer), ∀ (u : + GaussianInt), ∀ (a : GaussianInt), ∀ (b : ℤ), (∀ x, x ∈ k.domain ↔ x-u ∈ l.domain) → + (∀ x, x ∈ k.domain → k.value x = l.value (x-u) + a.re*x.re + a.im*x.im+b) → k = + PartialOdometerAffineTranslate l u a b) → (∀ (k : PartialOdometer), ∀ (q : Fin (4 : + ℕ) → CircleCoordinates), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin + (3 : ℕ)), ∀ (s : Bool), (q i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ × ℝ) (p_i : ℝ × ℝ), + PartialOdometerSlope k = some p ∧ PartialOdometerSlope (hs i s) = some p_i ∧ p_i.1 - + p.1 = (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q + (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : + ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / + 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : + ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : + Fin (3 : ℕ))).succ)).re : ℝ))) → (∀ (l : PartialOdometer), ∀ (u : GaussianInt), ∀ (rs + : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (q + i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ × ℝ) (p_i : ℝ × ℝ), PartialOdometerSlope l = some p ∧ + PartialOdometerSlope (rs i s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) + else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q + (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = true + then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : + Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((Fin (3 : ℕ)) → (∀ + (p : ℝ × ℝ), (PartialOdometerSlope k = some p) → (∀ (p' : ℝ × ℝ), + (PartialOdometerSlope l = some p') → (∀ i, ∀ s, 0 < (q i.succ).1 → ∀ (ai : + GaussianInt), ∀ (bi : ℤ), (∀ x, x ∈ (hs i s).domain ↔ x-u ∈ (rs i s).domain) → (∀ x, + x ∈ (hs i s).domain → (hs i s).value x = (rs i s).value + (x-u)+ai.re*x.re+ai.im*x.im+bi) → (ai.re : ℝ) = p.1-p'.1 ∧ (ai.im : ℝ) = + p.2-p'.2))))))) ) := by + classical + intro C affine_eq k q hs hslope l u rs rslope j p hp0 p' hp1 i s hi ai bi hd hv + obtain ⟨pp,ii,hpp,hii,dx,dy⟩ := (hslope i s).resolve_left (by omega) + obtain ⟨qq,jj,hqq,hjj,ex,ey⟩ := (rslope i s).resolve_left (by omega) + have heq := affine_eq (hs i s) (rs i s) u ai bi hd hv + have hsl : ii = (jj.1+(ai.re : ℝ), jj.2+(ai.im : ℝ)) := by + apply Option.some.inj + rw [← hii,heq,(PartialOdometerAffineTranslateFormulas (rs i s) u ai bi).2.2.2.2.2,hjj] + rfl + have hpp' : pp=p := Option.some.inj (hpp.symm.trans hp0) + have hqq' : qq=p' := Option.some.inj (hqq.symm.trans hp1) + subst pp + subst qq + have hx := congrArg Prod.fst hsl + have hy := congrArg Prod.snd hsl + dsimp at hx hy + constructor <;> linarith + +private theorem common : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ + (u : GaussianInt), ∀ (rs : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ i, ∀ s, 0 < (q + i.succ).1 → ∃ a : GaussianInt, ∃ b : ℤ, (∀ x, x ∈ (hs i s).domain ↔ x-u ∈ (rs i + s).domain) ∧ ∀ x, x ∈ (hs i s).domain → (hs i s).value x = (rs i s).value + (x-u)+a.re*x.re+a.im*x.im+b) → (∀ (a : GaussianInt), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), + (∀ i, ∀ s, 0 < (q i.succ).1 → ∀ (ai : GaussianInt), ∀ (bi : ℤ), (∀ x, x ∈ (hs i + s).domain ↔ x-u ∈ (rs i s).domain) → (∀ x, x ∈ (hs i s).domain → (hs i s).value x = + (rs i s).value (x-u)+ai.re*x.re+ai.im*x.im+bi) → (ai.re : ℝ) = p.1-p'.1 ∧ (ai.im : ℝ) + = p.2-p'.2) → (((↑a.re : ℝ) = p.1 - p'.1 ∧ (↑a.im : ℝ) = p.2 - p'.2) → (∀ i, ∀ s, 0 < + (q i.succ).1 → ∃ b : ℤ, (∀ x, x ∈ (hs i s).domain ↔ x-u ∈ (rs i s).domain) ∧ ∀ x, x ∈ + (hs i s).domain → (hs i s).value x = (rs i s).value (x-u)+a.re*x.re+a.im*x.im+b))) ) + := by + classical + intro q hs u rs pieces a p p' coefficients ca i s hi + obtain ⟨ai,bi,hd,hv⟩ := pieces i s hi + have ci := coefficients i s hi ai bi hd hv + have eq : ai=a := by + apply Zsqrtd.ext + · exact_mod_cast ci.1.trans ca.1.symm + · exact_mod_cast ci.2.trans ca.2.symm + subst ai + exact ⟨bi,hd,hv⟩ + +private theorem chosen_positive : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), ((0 : ℤ) < (q j.succ).1) → ( + let chooseSlot : Fin 3 × Bool → Fin 3 × Bool := fun t => + if 0 < (q t.1.succ).1 then t else (j,false) + ∀ t, 0 < (q (chooseSlot t).1.succ).1) ) := by + classical + intro q j hj chooseSlot t + dsimp [chooseSlot] + split_ifs with ht + · exact ht + · exact hj + +private theorem parent_positive : + (by + classical + exact + (CircleCoordinates) → ((∀ D, ∀ V, ∀ k, TileOdometer D V k → BandPrototile D V) → ((∀ D, ∀ + V, BandPrototile D V → D.1 = 0 → V.cells = ∅) → (∀ (q : Fin (4 : ℕ) → + CircleCoordinates), (ProperBandQuadruple q) → (∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s + : Bool), TileOdometer (q i.succ) (S i s) (hs i s)) → ((Fin (3 : ℕ)) → (∀ (i : Fin 3), + ∀ (s : Bool), ∀ (x : GaussianInt), (x ∈ (S i s).cells) → (0 < (q i.succ).1))))))) ) + := by + classical + intro C proto zero_cells q hq S hs hsub j i s x hx + have hn := (ProperBandCurvatureStructure q hq).2.1 i + by_contra hn' + have hz : (q i.succ).1 = 0 := by omega + have he := zero_cells _ _ (proto _ _ _ (hsub i s)) hz + rw [he] at hx + simp at hx + +private theorem cellcover : + (by + classical + exact + ∀ (V : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (x : LatticeCell), x ∈ V.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ + (S i s).cells) → (∀ (j : Fin (3 : ℕ)), + let chooseSlot : Fin 3 × Bool → Fin 3 × Bool := fun t => + if 0 < (q t.1.succ).1 then t else (j,false) + let e := Fintype.equivFin (Fin 3 × Bool) + let slot := fun t : Fin (Fintype.card (Fin 3 × Bool)) => chooseSlot (e.symm t) + let tiles := fun t => S (slot t).1 (slot t).2 + (∀ (i : Fin 3), ∀ (s : Bool), (0 < (q i.succ).1) → (slot (e (i,s)) = (i,s))) → ((∀ (i : + Fin 3), ∀ (s : Bool), ∀ (x : GaussianInt), (x ∈ (S i s).cells) → (0 < (q i.succ).1)) + → (∀ x, x ∈ V.cells ↔ ∃ t, x ∈ (tiles t).cells))) ) := by + classical + intro V q S hcells j chooseSlot e slot tiles selected parent_positive x + constructor + · intro hx + obtain ⟨i,s,hxi⟩ := (hcells x).mp hx + refine ⟨e (i,s), ?_⟩ + simpa only [tiles,selected i s (parent_positive i s x hxi)] using hxi + · rintro ⟨t,ht⟩ + exact (hcells x).mpr ⟨(slot t).1,(slot t).2,ht⟩ + +private theorem ododom : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs : + Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), + TileOdometer (q i.succ) (S i s) (hs i s)) → (∀ (j : Fin (3 : ℕ)), + let chooseSlot : Fin 3 × Bool → Fin 3 × Bool := fun t => + if 0 < (q t.1.succ).1 then t else (j,false) + (∀ t, 0 < (q (chooseSlot t).1.succ).1) → ( + let e := Fintype.equivFin (Fin 3 × Bool) + let slot := fun t : Fin (Fintype.card (Fin 3 × Bool)) => chooseSlot (e.symm t) + let tiles := fun t => S (slot t).1 (slot t).2 + let odos := fun t => hs (slot t).1 (slot t).2 + ∀ t, ((odos t).domain : Set GaussianInt) = FootprintVertices (tiles t))) ) := by + classical + intro q S hs hsub j chooseSlot chosen_positive e slot tiles odos t + exact PositiveCurvatureTileOdometerDomain _ _ _ (chosen_positive _) + (hsub (slot t).1 (slot t).2) + +private theorem footcover : + (by + classical + exact + ∀ (V : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → + ProtoTile), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s + : Bool), FootprintVertices (S i s) ⊆ FootprintVertices V) → (∀ (j : Fin (3 : ℕ)), + let chooseSlot : Fin 3 × Bool → Fin 3 × Bool := fun t => + if 0 < (q t.1.succ).1 then t else (j,false) + let e := Fintype.equivFin (Fin 3 × Bool) + let slot := fun t : Fin (Fintype.card (Fin 3 × Bool)) => chooseSlot (e.symm t) + let tiles := fun t => S (slot t).1 (slot t).2 + let odos := fun t => hs (slot t).1 (slot t).2 + (V.cells.Nonempty) → ((∀ x, x ∈ V.cells ↔ ∃ t, x ∈ (tiles t).cells) → ((∀ t, ((odos + t).domain : Set GaussianInt) = FootprintVertices (tiles t)) → (∀ x, x ∈ + FootprintVertices V ↔ ∃ t, x ∈ (odos t).domain)))) ) := by + classical + intro V q S hs hfoot j chooseSlot e slot tiles odos tilene cellcover ododom x + constructor + · intro hx + simp only [FootprintVertices, ite_eq_left tilene, Set.mem_ofPred_eq] at hx + obtain ⟨y,hy,hxy⟩ := hx + obtain ⟨t,ht⟩ := (cellcover y).mp hy + have hne : (tiles t).cells.Nonempty := ⟨y,ht⟩ + refine ⟨t,?_⟩ + have hf : x ∈ FootprintVertices (tiles t) := by + simp only [FootprintVertices,ite_eq_left hne,Set.mem_ofPred_eq] + exact ⟨y,ht,hxy⟩ + exact (Set.ext_iff.mp (ododom t) x).mpr hf + · rintro ⟨t,ht⟩ + exact hfoot (slot t).1 (slot t).2 ((Set.ext_iff.mp (ododom t) x).mp ht) + +private theorem coverdisk : + (by + classical + exact + (∀ D, ∀ V, ∀ k, TileOdometer D V k → 0 < D.1 → LatticeTile V) → (∀ (q : Fin (4 : ℕ) → + CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 : ℕ) → + Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) + (S i s) (hs i s)) → (∀ (j : Fin (3 : ℕ)), + let chooseSlot : Fin 3 × Bool → Fin 3 × Bool := fun t => + if 0 < (q t.1.succ).1 then t else (j,false) + (∀ t, 0 < (q (chooseSlot t).1.succ).1) → ( + let e := Fintype.equivFin (Fin 3 × Bool) + let slot := fun t : Fin (Fintype.card (Fin 3 × Bool)) => chooseSlot (e.symm t) + let tiles := fun t => S (slot t).1 (slot t).2 + ∀ t, LatticeTile (tiles t)))) ) := by + classical + intro disk q S hs hsub j chooseSlot chosen_positive e slot tiles t + exact disk _ _ _ (hsub (slot t).1 (slot t).2) (chosen_positive _) + +private theorem covercompat : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), + (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), + OdometerCompatibility (hs i s) (hs j t)) → (∀ (j : Fin (3 : ℕ)), + let chooseSlot : Fin 3 × Bool → Fin 3 × Bool := fun t => + if 0 < (q t.1.succ).1 then t else (j,false) + let e := Fintype.equivFin (Fin 3 × Bool) + let slot := fun t : Fin (Fintype.card (Fin 3 × Bool)) => chooseSlot (e.symm t) + let odos := fun t => hs (slot t).1 (slot t).2 + ∀ t, ∀ v, OdometerCompatibility (odos t) (odos v)) ) := by + classical + intro q hs hcompat j chooseSlot e slot odos t v + exact hcompat _ _ _ _ + +private theorem hkcompat : + (by + classical + exact + ∀ (k : PartialOdometer), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (hs : Fin (3 : ℕ) → + Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (hs i s).domain, + k.value x = (hs i s).value x) → (∀ (j : Fin (3 : ℕ)), + let chooseSlot : Fin 3 × Bool → Fin 3 × Bool := fun t => + if 0 < (q t.1.succ).1 then t else (j,false) + let e := Fintype.equivFin (Fin 3 × Bool) + let slot := fun t : Fin (Fintype.card (Fin 3 × Bool)) => chooseSlot (e.symm t) + let odos := fun t => hs (slot t).1 (slot t).2 + ∀ t, OdometerCompatibility k (odos t)) ) := by + classical + intro k q hs hvalue j chooseSlot e slot odos t + right + refine ⟨0,?_⟩ + intro x hx hy + rw [hvalue (slot t).1 (slot t).2 x hy] + simp only [odos,sub_self] + +private theorem htcompat : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ + (l : PartialOdometer), ∀ (u : GaussianInt), ∀ (rs : Fin (3 : ℕ) → Bool → + PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (rs i s).domain, l.value + x = (rs i s).value x) → (∀ (j : Fin (3 : ℕ)), ∀ (a : GaussianInt), (∀ i, ∀ s, 0 < (q + i.succ).1 → ∃ b : ℤ, (∀ x, x ∈ (hs i s).domain ↔ x-u ∈ (rs i s).domain) ∧ ∀ x, x ∈ + (hs i s).domain → (hs i s).value x = (rs i s).value (x-u)+a.re*x.re+a.im*x.im+b) → ( + let chooseSlot : Fin 3 × Bool → Fin 3 × Bool := fun t => + if 0 < (q t.1.succ).1 then t else (j,false) + (∀ t, 0 < (q (chooseSlot t).1.succ).1) → ( + let e := Fintype.equivFin (Fin 3 × Bool) + let slot := fun t : Fin (Fintype.card (Fin 3 × Bool)) => chooseSlot (e.symm t) + let odos := fun t => hs (slot t).1 (slot t).2 + let translated := PartialOdometerAffineTranslate l u a 0 + ∀ t, OdometerCompatibility translated (odos t)))) ) := by + classical + intro q hs l u rs rvalue j a common chooseSlot chosen_positive e slot odos translated t + obtain ⟨b,hd,hv⟩ := common (slot t).1 (slot t).2 (chosen_positive _) + right + refine ⟨b,?_⟩ + intro x hx hy + have hxr : x-u ∈ (rs (slot t).1 (slot t).2).domain := (hd x).mp hy + rw [hv x hy, (PartialOdometerAffineTranslateFormulas l u a 0).2.2.1 x hx, + rvalue (slot t).1 (slot t).2 (x-u) hxr] + ring + +end OdometerTranslationGeometry + +theorem TileOdometerTranslationUniqueness + (C : CircleCoordinates) (T U : ProtoTile) (h g : PartialOdometer) + (hC : 0 < C.1) (hT : TileOdometer C T h) + (hU : TileOdometer C U g) : + ∃! u : GaussianInt, + T.cells = (TileTranslation U u).cells ∧ + (T.cells = ∅ → T.anchor = (TileTranslation U u).anchor) ∧ + ∃ a : GaussianInt, ∃ b : ℤ, + (∀ x, x ∈ h.domain ↔ x - u ∈ g.domain) ∧ + ∀ x, x ∈ h.domain → + h.value x = g.value (x - u) + + a.re * x.re + a.im * x.im + b := by +-- BODY + classical + have hTproto : BandPrototile C T := OdometerTranslationGeometry.hTproto C T h hT + have hUproto : BandPrototile C U := OdometerTranslationGeometry.hUproto C U g hU + have proto : ∀ D V k, TileOdometer D V k → BandPrototile D V := OdometerTranslationGeometry.proto + have positive_parent : ∀ q, ProperBandQuadruple q → + ∃ i : Fin 3, 0 < (q i.succ).1 := OdometerTranslationGeometry.positive_parent C + have proper_large : ∀ q, ProperBandQuadruple q → 1 < (q 0).1 := + OdometerTranslationGeometry.proper_large C positive_parent + have positive_cells : ∀ D V, BandPrototile D V → 0 < D.1 → + V.cells.Nonempty := OdometerTranslationGeometry.positive_cells positive_parent + have zero_cells : ∀ D V, BandPrototile D V → D.1 = 0 → V.cells = ∅ := + OdometerTranslationGeometry.zero_cells + have cent_eq : ∀ V W : ProtoTile, V.cells = W.cells → + (V.cells = ∅ → V.anchor = W.anchor) → TileCentroid V = TileCentroid W := + OdometerTranslationGeometry.cent_eq + have foot_eq : ∀ V W : ProtoTile, V.cells = W.cells → + (V.cells = ∅ → V.anchor = W.anchor) → FootprintVertices V = FootprintVertices W := + OdometerTranslationGeometry.foot_eq + have domains : ∀ D V W k l, 0 < D.1 → + TileOdometer D V k → TileOdometer D W l → ∀ u, + V.cells = (TileTranslation W u).cells → + (V.cells = ∅ → V.anchor = (TileTranslation W u).anchor) → + ∀ x, x ∈ k.domain ↔ x-u ∈ l.domain := OdometerTranslationGeometry.domains foot_eq + have affine_eq : ∀ (k l : PartialOdometer) (u a : GaussianInt) (b : ℤ), + (∀ x, x ∈ k.domain ↔ x-u ∈ l.domain) → + (∀ x, x ∈ k.domain → k.value x = l.value (x-u) + + a.re*x.re + a.im*x.im+b) → + k = PartialOdometerAffineTranslate l u a b := OdometerTranslationGeometry.affine_eq + have unit_shift : ∀ (z x : GaussianInt) (V : ProtoTile) (k : PartialOdometer), + V.cells = {x} → (k.domain : Set GaussianInt) = FootprintVertices V → + ∀ v, (∀ y, y ∈ k.domain ↔ y-v ∈ (CurvatureOneOdometer z).domain) → v=x := + OdometerTranslationGeometry.unit_shift C + have square_disk : ∀ (V : ProtoTile) (x : GaussianInt), V.cells = {x} → + LatticeTile V := OdometerTranslationGeometry.square_disk + have disk : ∀ D V k, TileOdometer D V k → 0 < D.1 → LatticeTile V := + OdometerTranslationGeometry.disk square_disk + have comparison : ∀ D V k, TileOdometer D V k → 0 < D.1 → + ∀ W l, TileOdometer D W l → ∀ u, + V.cells = (TileTranslation W u).cells → + (V.cells = ∅ → V.anchor = (TileTranslation W u).anchor) → + ∃ a : GaussianInt, ∃ b : ℤ, + ∀ x, x ∈ k.domain → k.value x = l.value (x-u) + + a.re*x.re + a.im*x.im+b := by + intro D V k hk + induction hk with + | line w x hw k hd => simp + | unit z x V k hc hd ht => + intro hp W l hl u hcells hempty + refine TileOdometer.rec (motive := fun E W l _ => + E = (1,1+2*z) → V.cells = (TileTranslation W u).cells → + (V.cells = ∅ → V.anchor = (TileTranslation W u).anchor) → + ∃ a : GaussianInt, ∃ b : ℤ, ∀ t, t ∈ k.domain → + k.value t = l.value (t-u)+a.re*t.re+a.im*t.im+b) + ?_ ?_ ?_ hl rfl hcells hempty + · intro w y hw l hdl he hcells hempty + have hh := congrArg (fun D : CircleCoordinates => D.1) he + norm_num at hh + · intro z' y W l hcy hdy hty he hcells hempty + have hz : z = z' := OdometerTranslationGeometry.hzAt354 C z z' he + subst z' + obtain ⟨v,a,b,hv,hval⟩ := ht + obtain ⟨w,c,d,hw,hval'⟩ := hty + have vx : v=x := unit_shift z x V k hc hd v hv + have wy : w=y := unit_shift z y W l hcy hdy w hw + subst v + subst w + have hxy : x=y+u := by + simpa [hc, hcy, TileTranslation, GaussianTranslation] using hcells + refine ⟨a-c, b-d+c.re*u.re+c.im*u.im, ?_⟩ + intro t ht + have htl : t-u ∈ l.domain := (domains _ V W k l hp + (TileOdometer.unit z x V k hc hd ⟨x,a,b,hv,hval⟩) + (TileOdometer.unit z y W l hcy hdy ⟨y,c,d,hw,hval'⟩) + u hcells hempty t).mp ht + rw [hval t ht, hval' (t-u) htl, + show t-u-y = t-x by rw [hxy]; abel] + dsimp + ring + · intro q' hq S' W hs' l hW hsub hcell hf hcent hdl hvl hcompat hslope ih' + he hcells hempty + have hh := congrArg (fun D : CircleCoordinates => D.1) he + have hb := proper_large _ hq + simp only [] at hh + rw [hh] at hb + norm_num at hb + | @decompose q hq S V hs k hV hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + intro hp W l hl u hc ha + obtain ⟨R,rs,hW,rsub,rcells,rfoot,rcent,rdom,rvalue,rcompat,rslope⟩ := + TileOdometerReindexedDecomposition q hq W l (proper_large q hq) hl + have houter := cent_eq V (TileTranslation W u) hc ha + have matched : ∀ i s, + (S i s).cells = (TileTranslation (R i s) u).cells ∧ + ((S i s).cells = ∅ → (S i s).anchor = (TileTranslation (R i s) u).anchor) := + OdometerTranslationGeometry.matched proto V q S hs hsub hcentroid W u R rs rsub + rcent houter + have pieces : ∀ i s, 0 < (q i.succ).1 → + ∃ a : GaussianInt, ∃ b : ℤ, + (∀ x, x ∈ (hs i s).domain ↔ x-u ∈ (rs i s).domain) ∧ + ∀ x, x ∈ (hs i s).domain → (hs i s).value x = + (rs i s).value (x-u)+a.re*x.re+a.im*x.im+b := OdometerTranslationGeometry.pieces + domains q S hs hsub ih u R rs rsub matched + obtain ⟨j,hj⟩ := positive_parent q hq + obtain ⟨a,b0,hd0,hv0⟩ := pieces j false hj + obtain ⟨p,pi,hp0,hpi,dx0,dy0⟩ := (hslope j false).resolve_left (by omega) + obtain ⟨p',qi,hp1,hqi,dx1,dy1⟩ := (rslope j false).resolve_left (by omega) + have coefficients : ∀ i s, 0 < (q i.succ).1 → + ∀ (ai : GaussianInt) (bi : ℤ), + (∀ x, x ∈ (hs i s).domain ↔ x-u ∈ (rs i s).domain) → + (∀ x, x ∈ (hs i s).domain → (hs i s).value x = + (rs i s).value (x-u)+ai.re*x.re+ai.im*x.im+bi) → + (ai.re : ℝ) = p.1-p'.1 ∧ (ai.im : ℝ) = p.2-p'.2 := + OdometerTranslationGeometry.coefficients C affine_eq k q hs hslope l u rs + rslope j p hp0 p' hp1 + have ca := coefficients j false hj a b0 hd0 hv0 + have common : ∀ i s, 0 < (q i.succ).1 → ∃ b : ℤ, + (∀ x, x ∈ (hs i s).domain ↔ x-u ∈ (rs i s).domain) ∧ + ∀ x, x ∈ (hs i s).domain → (hs i s).value x = + (rs i s).value (x-u)+a.re*x.re+a.im*x.im+b := OdometerTranslationGeometry.common q + hs u rs pieces a p p' coefficients ca + -- Replace zero-curvature slots by a positive slot in the finite disk cover. + let chooseSlot : Fin 3 × Bool → Fin 3 × Bool := fun t => + if 0 < (q t.1.succ).1 then t else (j,false) + have chosen_positive : ∀ t, 0 < (q (chooseSlot t).1.succ).1 := + OdometerTranslationGeometry.chosen_positive q j hj + let e := Fintype.equivFin (Fin 3 × Bool) + let slot := fun t : Fin (Fintype.card (Fin 3 × Bool)) => chooseSlot (e.symm t) + let tiles := fun t => S (slot t).1 (slot t).2 + let odos := fun t => hs (slot t).1 (slot t).2 + have selected (i : Fin 3) (s : Bool) (hi : 0 < (q i.succ).1) : + slot (e (i,s)) = (i,s) := by simp [slot,chooseSlot,hi] + have tilene : V.cells.Nonempty := positive_cells _ V hV hp + have parent_positive (i : Fin 3) (s : Bool) (x : GaussianInt) + (hx : x ∈ (S i s).cells) : 0 < (q i.succ).1 := + OdometerTranslationGeometry.parent_positive C proto zero_cells q hq S hs hsub j i + s x hx + have cellcover : ∀ x, x ∈ V.cells ↔ ∃ t, x ∈ (tiles t).cells := + OdometerTranslationGeometry.cellcover V q S hcells j selected parent_positive + have ododom : ∀ t, ((odos t).domain : Set GaussianInt) = FootprintVertices (tiles t) := + OdometerTranslationGeometry.ododom q S hs hsub j chosen_positive + have footcover : ∀ x, x ∈ FootprintVertices V ↔ ∃ t, x ∈ (odos t).domain := + OdometerTranslationGeometry.footcover V q S hs hfoot j tilene cellcover ododom + have coverdisk : ∀ t, LatticeTile (tiles t) := OdometerTranslationGeometry.coverdisk disk + q S hs hsub j chosen_positive + have covercompat : ∀ t v, OdometerCompatibility (odos t) (odos v) := + OdometerTranslationGeometry.covercompat q hs hcompat j + obtain ⟨glued,hgd,hgc,huniq⟩ := OdometerGluing.1 + (T := V) (U := tiles) (h := odos) + (BandTileSimultaneousInduction q hq V hV).1 coverdisk ododom covercompat + cellcover footcover + have hk : TileOdometer (q 0) V k := + TileOdometer.decompose hq hV hsub hcells hfoot hcentroid hdom hvalue hcompat hslope + have hkd := PositiveCurvatureTileOdometerDomain _ _ _ hp hk + have hld := PositiveCurvatureTileOdometerDomain _ _ _ hp hl + let translated := PartialOdometerAffineTranslate l u a 0 + have htd : (translated.domain : Set GaussianInt) = FootprintVertices V := + ((PartialOdometerAffineTranslateFormulas l u a 0).2.2.2.2.1 W hld).trans + (foot_eq V (TileTranslation W u) hc ha).symm + have hkcompat : ∀ t, OdometerCompatibility k (odos t) := + OdometerTranslationGeometry.hkcompat k q hs hvalue j + have htcompat : ∀ t, OdometerCompatibility translated (odos t) := + OdometerTranslationGeometry.htcompat q hs l u rs rvalue j a common chosen_positive + obtain ⟨b1,hb1⟩ := huniq k hkd hkcompat + obtain ⟨b2,hb2⟩ := huniq translated htd htcompat + refine ⟨a,b1-b2,?_⟩ + intro x hx + have hxg : x ∈ glued.domain := (Set.ext_iff.mp (hkd.trans hgd.symm) x).mp hx + have hxt : x ∈ translated.domain := (Set.ext_iff.mp (hkd.trans htd.symm) x).mp hx + have h1 := hb1 x hxg + have h2 := hb2 x hxg + rw [(PartialOdometerAffineTranslateFormulas l u a 0).2.2.1 x hxt] at h2 + linarith + obtain ⟨u,hcells,hempty⟩ := BandPrototileTranslationNormalForm C T U hTproto hUproto + obtain ⟨a,b,hval⟩ := comparison C T h hT hC U g hU u hcells hempty + refine ⟨u, ⟨hcells,hempty,a,b,domains C T U h g hC hT hU u hcells hempty,hval⟩, ?_⟩ + intro v hv + have hcent : TileCentroid (TileTranslation U v) = TileCentroid (TileTranslation U u) := + (cent_eq T (TileTranslation U v) hv.1 hv.2.1).symm.trans + (cent_eq T (TileTranslation U u) hcells hempty) + rw [(TileTranslationFormulas U v).2.2.2.2.1, + (TileTranslationFormulas U u).2.2.2.2.1] at hcent + apply Zsqrtd.ext + · have hh := congrArg Prod.fst hcent + dsimp at hh + exact_mod_cast (add_left_cancel hh : (v.re : ℝ) = (u.re : ℝ)) + · have hh := congrArg Prod.snd hcent + dsimp at hh + exact_mod_cast (add_left_cancel hh : (v.im : ℝ) = (u.im : ℝ)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileQuarterTurn.lean b/LeanPool/ApollonianSuperharmonic/TileQuarterTurn.lean new file mode 100644 index 0000000000..93ffe9da20 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileQuarterTurn.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: TileQuarterTurn] + +/-! +# TileQuarterTurn + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The quarter-turn $qT$ of a prototile about the origin has cell basepoints +$qx-1$ for $x$ a cell basepoint of $T$, and has anchor $q(a_T)$. The +subtraction of $1$ is the lower-left-corner correction: the geometric image +of the closed square based at $x$ under $(s,t)\mapsto(-t,s)$ is the closed +square based at $qx-1$. The anchor is a vertex, not a cell basepoint, so it +receives no correction; this remains meaningful when $T$ is empty. +-/ +def TileQuarterTurn (T : ProtoTile) : ProtoTile := +-- BODY + ⟨T.cells.image (fun x => GaussianQuarterTurn x - 1), + GaussianQuarterTurn T.anchor⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean new file mode 100644 index 0000000000..d53d0b4a90 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean @@ -0,0 +1,594 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurn +public import LeanPool.ApollonianSuperharmonic.TileRealization + +-- [TABLET NODE: TileQuarterTurnFormulas] + +/-! +# TileQuarterTurnFormulas + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace QuarterTurnFormulas + +private theorem quarter_re (x : GaussianInt) : + (GaussianInt.toComplex (GaussianQuarterTurn x - 1)).re = + -(x.im : Real) - 1 := by + classical + rcases x with ⟨a, b⟩ + simp [GaussianQuarterTurn, GaussianInt.toComplex_def] + +private theorem quarter_im (x : GaussianInt) : + (GaussianInt.toComplex (GaussianQuarterTurn x - 1)).im = + (x.re : Real) := by + classical + rcases x with ⟨a, b⟩ + simp [GaussianQuarterTurn, GaussianInt.toComplex_def] + +private theorem quarter_re_int (x : GaussianInt) : + (GaussianQuarterTurn x - 1).re = -x.im - 1 := by + classical + rcases x with ⟨a, b⟩ + rfl + +private theorem quarter_im_int (x : GaussianInt) : + (GaussianQuarterTurn x - 1).im = x.re := by + classical + rcases x with ⟨a, b⟩ + simp [GaussianQuarterTurn] + +private theorem quarter_re_cast (x : GaussianInt) : + ((GaussianQuarterTurn x - 1).re : Real) = -(x.im : Real) - 1 := by + classical + have quarter_re_int (x : GaussianInt) : + (GaussianQuarterTurn x - 1).re = -x.im - 1 := quarter_re_int x + rw [quarter_re_int] + norm_num + +private theorem quarter_im_cast (x : GaussianInt) : + ((GaussianQuarterTurn x - 1).im : Real) = (x.re : Real) := by + classical + have quarter_im_int (x : GaussianInt) : + (GaussianQuarterTurn x - 1).im = x.re := quarter_im_int x + rw [quarter_im_int] + +private theorem quarter_re_base (x : GaussianInt) : + (GaussianInt.toComplex (GaussianQuarterTurn x)).re = -(x.im : Real) := by + classical + rcases x with ⟨a, b⟩ + simp [GaussianQuarterTurn, GaussianInt.toComplex_def] + +private theorem quarter_im_base (x : GaussianInt) : + (GaussianInt.toComplex (GaussianQuarterTurn x)).im = (x.re : Real) := by + classical + rcases x with ⟨a, b⟩ + simp [GaussianQuarterTurn, GaussianInt.toComplex_def] + +private theorem gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := by + classical + rcases u with ⟨u, w⟩ + rcases v with ⟨v, z⟩ + simp_all + +private theorem turn_up (a : GaussianInt) : + GaussianQuarterTurn (a + ⟨0, 1⟩) = GaussianQuarterTurn a - 1 := by + classical + have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_equal u v hre him + apply gaussian_equal <;> simp [GaussianQuarterTurn]; omega + +private theorem turn_right (a : GaussianInt) : + GaussianQuarterTurn (a + 1) = GaussianQuarterTurn a + ⟨0, 1⟩ := by + classical + have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_equal u v hre him + apply gaussian_equal <;> simp [GaussianQuarterTurn] + +private theorem turn_up_right (a : GaussianInt) : + GaussianQuarterTurn (a + 1 + ⟨0, 1⟩) = + GaussianQuarterTurn a - 1 + ⟨0, 1⟩ := by + classical + have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_equal u v hre him + apply gaussian_equal <;> simp [GaussianQuarterTurn]; omega + +private theorem minus_one_add_one (u : GaussianInt) : u - 1 + 1 = u := by + classical + have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_equal u v hre him + apply gaussian_equal <;> simp + +private theorem minus_one_add_up (u : GaussianInt) : + u - 1 + ⟨0, 1⟩ = ⟨u.re - 1, u.im + 1⟩ := by + classical + have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_equal u v hre him + apply gaussian_equal <;> simp + +private theorem pair_swap (u v : GaussianInt) : ({u, v} : Finset GaussianInt) = {v, u} := by + classical + ext z + simp [or_comm] + +private noncomputable def cellInverse : GaussianInt → GaussianInt := fun z => + ⟨(z + 1).im, -(z + 1).re⟩ + +private theorem inverse_formula (z : GaussianInt) : + GaussianQuarterTurn (cellInverse z) - 1 = z := by + classical + have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_equal u v hre him + let cellInverse : GaussianInt → GaussianInt := fun z => + ⟨(z + 1).im, -(z + 1).re⟩ + change (GaussianQuarterTurn (cellInverse z) - 1 = z) + apply gaussian_equal <;> simp [cellInverse, GaussianQuarterTurn] + +private theorem forward_formula (a : GaussianInt) : + cellInverse (GaussianQuarterTurn a - 1) = a := by + classical + have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_equal u v hre him + let cellInverse : GaussianInt → GaussianInt := fun z => + ⟨(z + 1).im, -(z + 1).re⟩ + change (cellInverse (GaussianQuarterTurn a - 1) = a) + apply gaussian_equal <;> simp [cellInverse, GaussianQuarterTurn] + +private theorem quarter_inverse (a : GaussianInt) : + cellInverse (GaussianQuarterTurn a) = a - ⟨0, 1⟩ := by + classical + have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_equal u v hre him + let cellInverse : GaussianInt → GaussianInt := fun z => + ⟨(z + 1).im, -(z + 1).re⟩ + change (cellInverse (GaussianQuarterTurn a) = a - ⟨0, 1⟩) + apply gaussian_equal <;> simp [cellInverse, GaussianQuarterTurn]; omega + +private theorem q_inverse (z : GaussianInt) : + GaussianQuarterTurn (cellInverse z) = z + 1 := by + classical + have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_equal u v hre him + let cellInverse : GaussianInt → GaussianInt := fun z => + ⟨(z + 1).im, -(z + 1).re⟩ + have inverse_formula (z : GaussianInt) : + GaussianQuarterTurn (cellInverse z) - 1 = z := inverse_formula z + have hz := inverse_formula z + change (GaussianQuarterTurn (cellInverse z) = z + 1) + apply gaussian_equal <;> simp [cellInverse, GaussianQuarterTurn] at hz ⊢ + +private theorem turn_up_left (a : GaussianInt) : + GaussianQuarterTurn (⟨0, 1⟩ + a) = GaussianQuarterTurn a - 1 := by + classical + have turn_up (a : GaussianInt) : + GaussianQuarterTurn (a + ⟨0, 1⟩) = GaussianQuarterTurn a - 1 := turn_up a + rw [add_comm] + exact turn_up a + +private theorem turn_one_up (a : GaussianInt) : + GaussianQuarterTurn (a + 1 + ⟨0, 1⟩) = + GaussianQuarterTurn a - 1 + ⟨0, 1⟩ := by + classical + have turn_up_right (a : GaussianInt) : + GaussianQuarterTurn (a + 1 + ⟨0, 1⟩) = + GaussianQuarterTurn a - 1 + ⟨0, 1⟩ := turn_up_right a + exact turn_up_right a + +private theorem turn_one_up_left (a : GaussianInt) : + GaussianQuarterTurn (1 + (⟨0, 1⟩ + a)) = + GaussianQuarterTurn a - 1 + ⟨0, 1⟩ := by + classical + have turn_one_up (a : GaussianInt) : + GaussianQuarterTurn (a + 1 + ⟨0, 1⟩) = + GaussianQuarterTurn a - 1 + ⟨0, 1⟩ := turn_one_up a + rw [show 1 + (⟨0, 1⟩ + a) = a + 1 + ⟨0, 1⟩ by + simp [add_assoc, add_comm, add_left_comm]] + exact turn_one_up a + +private theorem one_up_comm : (1 : GaussianInt) + ⟨0, 1⟩ = ⟨0, 1⟩ + 1 := by + classical + have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_equal u v hre him + apply gaussian_equal <;> simp + +private theorem one_sub_one (u : GaussianInt) : u + 1 - 1 = u := by + classical + have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_equal u v hre him + apply gaussian_equal <;> simp + +private theorem add_one_up (u : GaussianInt) : + u + (1 + ⟨0, 1⟩) = u + (⟨0, 1⟩ + 1) := by + classical + have one_up_comm : (1 : GaussianInt) + ⟨0, 1⟩ = ⟨0, 1⟩ + 1 := one_up_comm + rw [one_up_comm] + +private theorem inverse_horizontal (z : GaussianInt) : + cellInverse (z - ⟨0, 1⟩) = cellInverse z - 1 := by + classical + have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_equal u v hre him + let cellInverse : GaussianInt → GaussianInt := fun z => + ⟨(z + 1).im, -(z + 1).re⟩ + change cellInverse (z - ⟨0, 1⟩) = cellInverse z - 1 + apply gaussian_equal <;> simp [cellInverse] + +private theorem inverse_vertical (z : GaussianInt) : + cellInverse (z - 1) = cellInverse z + ⟨0, 1⟩ := by + classical + have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_equal u v hre him + let cellInverse : GaussianInt → GaussianInt := fun z => + ⟨(z + 1).im, -(z + 1).re⟩ + change cellInverse (z - 1) = cellInverse z + ⟨0, 1⟩ + apply gaussian_equal <;> simp [cellInverse] + +private theorem cell_formula (T : ProtoTile) (z : GaussianInt) : + z ∈ (TileQuarterTurn T).cells ↔ cellInverse z ∈ T.cells := by + classical + let cellInverse : GaussianInt → GaussianInt := fun z => + ⟨(z + 1).im, -(z + 1).re⟩ + have inverse_formula (z : GaussianInt) : + GaussianQuarterTurn (cellInverse z) - 1 = z := inverse_formula z + have forward_formula (a : GaussianInt) : + cellInverse (GaussianQuarterTurn a - 1) = a := forward_formula a + change z ∈ T.cells.image (fun x => GaussianQuarterTurn x - 1) ↔ cellInverse z ∈ T.cells + constructor + · intro hz + rcases Finset.mem_image.mp hz with ⟨a, ha, hza⟩ + rw [← hza, forward_formula] + exact ha + · intro hz + exact Finset.mem_image.mpr ⟨cellInverse z, hz, inverse_formula z⟩ + +private theorem edge_formula (T : ProtoTile) : + BoundaryFootprintEdges (TileQuarterTurn T) = + (fun e : Finset GaussianInt => e.image GaussianQuarterTurn) '' + BoundaryFootprintEdges T := by + classical + have turn_up (a : GaussianInt) : + GaussianQuarterTurn (a + ⟨0, 1⟩) = GaussianQuarterTurn a - 1 := turn_up a + have turn_right (a : GaussianInt) : + GaussianQuarterTurn (a + 1) = GaussianQuarterTurn a + ⟨0, 1⟩ := turn_right a + have pair_swap (u v : GaussianInt) : ({u, v} : Finset GaussianInt) = {v, u} := pair_swap u v + let cellInverse : GaussianInt → GaussianInt := fun z => + ⟨(z + 1).im, -(z + 1).re⟩ + have forward_formula (a : GaussianInt) : + cellInverse (GaussianQuarterTurn a - 1) = a := forward_formula a + have quarter_inverse (a : GaussianInt) : + cellInverse (GaussianQuarterTurn a) = a - ⟨0, 1⟩ := quarter_inverse a + have q_inverse (z : GaussianInt) : + GaussianQuarterTurn (cellInverse z) = z + 1 := q_inverse z + have turn_up_left (a : GaussianInt) : + GaussianQuarterTurn (⟨0, 1⟩ + a) = GaussianQuarterTurn a - 1 := turn_up_left a + have turn_one_up (a : GaussianInt) : + GaussianQuarterTurn (a + 1 + ⟨0, 1⟩) = + GaussianQuarterTurn a - 1 + ⟨0, 1⟩ := turn_one_up a + have one_sub_one (u : GaussianInt) : u + 1 - 1 = u := one_sub_one u + have inverse_horizontal (z : GaussianInt) : + cellInverse (z - ⟨0, 1⟩) = cellInverse z - 1 := inverse_horizontal z + have inverse_vertical (z : GaussianInt) : + cellInverse (z - 1) = cellInverse z + ⟨0, 1⟩ := inverse_vertical z + have cell_formula (z : GaussianInt) : + z ∈ (TileQuarterTurn T).cells ↔ cellInverse z ∈ T.cells := cell_formula T z + ext e + change (∃ z : GaussianInt, + (e = {z, z + 1} ∧ + ((z ∈ (TileQuarterTurn T).cells ∧ + z - ⟨0, 1⟩ ∉ (TileQuarterTurn T).cells) ∨ + (z ∉ (TileQuarterTurn T).cells ∧ + z - ⟨0, 1⟩ ∈ (TileQuarterTurn T).cells))) ∨ + (e = {z, z + ⟨0, 1⟩} ∧ + ((z ∈ (TileQuarterTurn T).cells ∧ + z - 1 ∉ (TileQuarterTurn T).cells) ∨ + (z ∉ (TileQuarterTurn T).cells ∧ + z - 1 ∈ (TileQuarterTurn T).cells)))) ↔ + ∃ f, f ∈ BoundaryFootprintEdges T ∧ + f.image GaussianQuarterTurn = e + constructor + · rintro ⟨z, hz⟩ + rcases hz with ⟨he, hp⟩ | ⟨he, hp⟩ + · refine ⟨{cellInverse z, cellInverse z + ⟨0, 1⟩}, ?_, ?_⟩ + · refine ⟨cellInverse z, Or.inr ⟨rfl, ?_⟩⟩ + simpa [cell_formula, inverse_horizontal] using hp + · subst e + simp [Finset.image_insert, pair_swap, q_inverse, turn_up_left, + one_sub_one, add_comm] + · refine ⟨{cellInverse z + ⟨0, 1⟩, cellInverse z + 1 + ⟨0, 1⟩}, ?_, ?_⟩ + · refine ⟨cellInverse z + ⟨0, 1⟩, + Or.inl ⟨by ext w; simp [add_comm, add_left_comm], ?_⟩⟩ + simpa [cell_formula, inverse_vertical, and_comm, or_comm] using hp + · subst e + simp only [Finset.image_insert, Finset.image_singleton] + rw [turn_up, turn_one_up, q_inverse, one_sub_one] + · rintro ⟨f, ⟨a, ha⟩, he⟩ + rcases ha with hf | hf + · rcases hf with ⟨hf, hp⟩ + refine ⟨GaussianQuarterTurn a, ?_⟩ + right + refine ⟨?_, ?_⟩ + · subst f + rw [← he] + simp [Finset.image_insert, turn_right, pair_swap, + ] + · simpa [cell_formula, quarter_inverse, forward_formula, and_comm, or_comm] using hp + · rcases hf with ⟨hf, hp⟩ + refine ⟨GaussianQuarterTurn a - 1, ?_⟩ + left + refine ⟨?_, ?_⟩ + · subst f + rw [← he] + simp [Finset.image_insert, turn_up, pair_swap, + add_comm] + · simpa [cell_formula, inverse_horizontal, forward_formula] using hp + +end QuarterTurnFormulas + +private theorem quarterTurnCentroid (T : ProtoTile) : + TileCentroid (TileQuarterTurn T) = (-(TileCentroid T).2, (TileCentroid T).1) := by + have quarter_re := QuarterTurnFormulas.quarter_re + have quarter_im := QuarterTurnFormulas.quarter_im + have quarter_re_cast := QuarterTurnFormulas.quarter_re_cast + have quarter_im_cast := QuarterTurnFormulas.quarter_im_cast + have quarter_re_base := QuarterTurnFormulas.quarter_re_base + have quarter_im_base := QuarterTurnFormulas.quarter_im_base + dsimp [TileQuarterTurn] + by_cases h : T.cells.Nonempty + · have hinj : Function.Injective (fun x : GaussianInt => GaussianQuarterTurn x - 1) := by + intro a b hab + rcases a with ⟨a, c⟩ + rcases b with ⟨b, d⟩ + simp? [GaussianQuarterTurn] at hab ⊢ + exact ⟨hab.2, hab.1⟩ + have coordRe (x : GaussianInt) : + (GaussianInt.toComplex x).re = (x.re : Real) := by + exact (GaussianInt.intCast_re x).symm + have coordIm (x : GaussianInt) : + (GaussianInt.toComplex x).im = (x.im : Real) := by + exact (GaussianInt.intCast_im x).symm + have sumRe (x : GaussianInt) : + (GaussianInt.toComplex (GaussianQuarterTurn x - 1)).re = + -(GaussianInt.toComplex x).im - 1 := by + rw [quarter_re, coordIm] + have sumIm (x : GaussianInt) : + (GaussianInt.toComplex (GaussianQuarterTurn x - 1)).im = + (GaussianInt.toComplex x).re := by + rw [quarter_im, coordRe] + have sumReInt (x : GaussianInt) : + ((GaussianQuarterTurn x - 1).re : Real) = -(x.im : Real) - 1 := + quarter_re_cast x + have sumImInt (x : GaussianInt) : + ((GaussianQuarterTurn x - 1).im : Real) = (x.re : Real) := + quarter_im_cast x + simp? [TileCentroid, h] + rw [Finset.card_image_of_injective T.cells hinj] + rw [Finset.sum_image hinj.injOn] + rw [Finset.sum_image hinj.injOn] + simp only [coordRe, coordIm, sumReInt, sumImInt, + Finset.sum_sub_distrib, + Finset.sum_neg_distrib] + have cardReal : (Finset.card T.cells : Real) ≠ 0 := by + exact_mod_cast h.card_pos.ne' + constructor + · field_simp [cardReal] + rw [Finset.sum_const] + ring + · simp + · simp [TileCentroid, h, quarter_re_base, quarter_im_base] + +theorem TileQuarterTurnFormulas : ∀ T : ProtoTile, + (TileQuarterTurn T).cells = + T.cells.image (fun x => GaussianQuarterTurn x - 1) ∧ + (TileQuarterTurn T).anchor = GaussianQuarterTurn T.anchor ∧ + ((TileQuarterTurn T).cells = ∅ ↔ T.cells = ∅) ∧ + TileRealization (TileQuarterTurn T) = + (fun p : Real × Real => (-p.2, p.1)) '' TileRealization T ∧ + TileCentroid (TileQuarterTurn T) = + (-(TileCentroid T).2, (TileCentroid T).1) ∧ + FootprintVertices (TileQuarterTurn T) = + GaussianQuarterTurn '' FootprintVertices T ∧ + FootprintEdges (TileQuarterTurn T) = + (fun e : Finset GaussianInt => e.image GaussianQuarterTurn) '' + FootprintEdges T ∧ + BoundaryFootprintVertices (TileQuarterTurn T) = + GaussianQuarterTurn '' BoundaryFootprintVertices T ∧ + BoundaryFootprintEdges (TileQuarterTurn T) = + (fun e : Finset GaussianInt => e.image GaussianQuarterTurn) '' + BoundaryFootprintEdges T := by +-- BODY + intro T + have quarter_re (x : GaussianInt) : + (GaussianInt.toComplex (GaussianQuarterTurn x - 1)).re = + -(x.im : Real) - 1 := QuarterTurnFormulas.quarter_re x + have quarter_im (x : GaussianInt) : + (GaussianInt.toComplex (GaussianQuarterTurn x - 1)).im = + (x.re : Real) := QuarterTurnFormulas.quarter_im x + have quarter_re_cast (x : GaussianInt) : + ((GaussianQuarterTurn x - 1).re : Real) = -(x.im : Real) - 1 := + QuarterTurnFormulas.quarter_re_cast x + have quarter_im_cast (x : GaussianInt) : + ((GaussianQuarterTurn x - 1).im : Real) = (x.re : Real) := + QuarterTurnFormulas.quarter_im_cast x + have quarter_re_base (x : GaussianInt) : + (GaussianInt.toComplex (GaussianQuarterTurn x)).re = -(x.im : Real) := + QuarterTurnFormulas.quarter_re_base x + have quarter_im_base (x : GaussianInt) : + (GaussianInt.toComplex (GaussianQuarterTurn x)).im = (x.re : Real) := + QuarterTurnFormulas.quarter_im_base x + have turn_up (a : GaussianInt) : + GaussianQuarterTurn (a + ⟨0, 1⟩) = GaussianQuarterTurn a - 1 := QuarterTurnFormulas.turn_up a + have turn_right (a : GaussianInt) : + GaussianQuarterTurn (a + 1) = GaussianQuarterTurn a + ⟨0, 1⟩ := + QuarterTurnFormulas.turn_right a + have turn_up_right (a : GaussianInt) : + GaussianQuarterTurn (a + 1 + ⟨0, 1⟩) = + GaussianQuarterTurn a - 1 + ⟨0, 1⟩ := QuarterTurnFormulas.turn_up_right a + have minus_one_add_one (u : GaussianInt) : u - 1 + 1 = u := + QuarterTurnFormulas.minus_one_add_one u + have minus_one_add_up (u : GaussianInt) : + u - 1 + ⟨0, 1⟩ = ⟨u.re - 1, u.im + 1⟩ := QuarterTurnFormulas.minus_one_add_up u + have pair_swap (u v : GaussianInt) : ({u, v} : Finset GaussianInt) = {v, u} := + QuarterTurnFormulas.pair_swap u v + dsimp [TileQuarterTurn] + constructor + · rfl + constructor + · rfl + constructor + · simp + constructor + · ext p + simp only [TileRealization, ClosedSquareRealization, Set.mem_iUnion, + Set.mem_image, Set.mem_Icc, Prod.le_def, Finset.mem_image] + constructor + · rintro ⟨i, ⟨j, hj, rfl⟩, hlow, hupp⟩ + refine ⟨(p.2, -p.1), ?_, ?_⟩ + · rw [quarter_re_cast, quarter_im_cast] at hlow hupp + rcases hlow with ⟨h₁, h₂⟩ + rcases hupp with ⟨h₃, h₄⟩ + simp only [] + refine ⟨j, hj, ?_⟩ + refine ⟨⟨h₂, ?_⟩, h₄, ?_⟩ + · norm_num at h₁ h₃ ⊢ + linarith [h₁, h₃] + · norm_num at h₁ h₃ ⊢ + linarith [h₁, h₃] + · simp + · rintro ⟨x, ⟨i, hi, hlow, hupp⟩, rfl⟩ + refine ⟨GaussianQuarterTurn i - 1, ⟨i, hi, rfl⟩, ?_, ?_⟩ + · rw [quarter_re_cast, quarter_im_cast] + rcases hlow with ⟨h₁, h₂⟩ + rcases hupp with ⟨h₃, h₄⟩ + simp only [] + constructor <;> linarith + · rw [quarter_re_cast, quarter_im_cast] + constructor <;> linarith + constructor + · exact quarterTurnCentroid T + constructor + · ext v + by_cases h : T.cells.Nonempty + · have hnew : (T.cells.image (fun x => GaussianQuarterTurn x - 1)).Nonempty := + h.image _ + simp? [FootprintVertices, h, hnew] + constructor + · rintro ⟨a, ha, hv⟩ + rcases hv with rfl | rfl | rfl | rfl + · refine ⟨a + ⟨0, 1⟩, ⟨a, ha, Or.inr (Or.inr (Or.inl rfl))⟩, ?_⟩ + exact turn_up a + · refine ⟨a, ⟨a, ha, Or.inl rfl⟩, ?_⟩ + simp [GaussianQuarterTurn] + · refine ⟨a + 1 + ⟨0, 1⟩, + ⟨a, ha, Or.inr (Or.inr (Or.inr rfl))⟩, ?_⟩ + exact turn_up_right a + · refine ⟨a + 1, ⟨a, ha, Or.inr (Or.inl rfl)⟩, ?_⟩ + exact turn_right a + · rintro ⟨x, ⟨a, ha, hx⟩, hv⟩ + refine ⟨a, ha, ?_⟩ + rcases hx with rfl | rfl | rfl | rfl + · refine Or.inr (Or.inl ?_) + rw [← hv] + · refine Or.inr (Or.inr (Or.inr ?_)) + rw [← hv] + exact turn_right a + · refine Or.inl ?_ + rw [← hv] + exact turn_up a + · refine Or.inr (Or.inr (Or.inl ?_)) + rw [← hv] + exact turn_up_right a + · simp [FootprintVertices, h, GaussianQuarterTurn] + constructor + · ext e + simp only [FootprintEdges, Set.mem_ofPred_eq] + have turn_shift (a : GaussianInt) : + GaussianQuarterTurn (a + 1) - 1 = + GaussianQuarterTurn a - 1 + ⟨0, 1⟩ := by + rw [← turn_up (a + 1), turn_up_right] + constructor + · rintro ⟨z, hz, he⟩ + rcases Finset.mem_image.mp hz with ⟨a, ha, hza⟩ + subst z + rcases he with h0 | h1 | h2 | h3 + · refine ⟨{a, a + ⟨0, 1⟩}, ⟨a, ha, Or.inr (Or.inl rfl)⟩, ?_⟩ + rw [h0] + simp [Finset.image_insert, turn_up, pair_swap, minus_one_add_one, + ] + · refine ⟨{a + ⟨0, 1⟩, a + 1 + ⟨0, 1⟩}, + ⟨a, ha, Or.inr (Or.inr (Or.inr rfl))⟩, ?_⟩ + rw [h1] + simp [Finset.image_insert, turn_up, pair_swap, + minus_one_add_up, turn_shift] + · refine ⟨{a, a + 1}, ⟨a, ha, Or.inl rfl⟩, ?_⟩ + rw [h2] + simp [Finset.image_insert, turn_right, pair_swap, minus_one_add_one, + ] + · refine ⟨{a + 1, a + 1 + ⟨0, 1⟩}, + ⟨a, ha, Or.inr (Or.inr (Or.inl rfl))⟩, ?_⟩ + rw [h3] + simp [Finset.image_insert, turn_right, turn_up_right, pair_swap, + minus_one_add_one, minus_one_add_up] + · rintro ⟨f, ⟨a, ha, hf⟩, he⟩ + refine ⟨GaussianQuarterTurn a - 1, + Finset.mem_image.mpr ⟨a, ha, rfl⟩, ?_⟩ + rcases hf with h0 | h1 | h2 | h3 + · refine Or.inr (Or.inr (Or.inl ?_)) + rw [← he, h0] + simp [Finset.image_insert, turn_right, pair_swap, + minus_one_add_one] + · refine Or.inl ?_ + rw [← he, h1] + simp [Finset.image_insert, turn_up, pair_swap, minus_one_add_one, + ] + · refine Or.inr (Or.inr (Or.inr ?_)) + rw [← he, h2] + simp [Finset.image_insert, turn_right, turn_up_right, pair_swap, + minus_one_add_one, minus_one_add_up] + · refine Or.inr (Or.inl ?_) + rw [← he, h3] + simp? [Finset.image_insert, turn_up, pair_swap, + minus_one_add_up] + rw [turn_shift, ← minus_one_add_up] + have edge_formula : + BoundaryFootprintEdges (TileQuarterTurn T) = + (fun e : Finset GaussianInt => e.image GaussianQuarterTurn) '' + BoundaryFootprintEdges T := QuarterTurnFormulas.edge_formula T + constructor + · by_cases h : T.cells.Nonempty + · simp only [BoundaryFootprintVertices, ite_eq_left h] + have imageNonempty : (T.cells.image (fun x => GaussianQuarterTurn x - 1)).Nonempty := + h.image _ + simp only [ite_eq_left imageNonempty] + change {v | ∃ e ∈ BoundaryFootprintEdges (TileQuarterTurn T), v ∈ e} = _ + rw [edge_formula] + ext v + constructor + · rintro ⟨e, ⟨f, hf, rfl⟩, hv⟩ + rcases Finset.mem_image.mp hv with ⟨z, hz, rfl⟩ + exact ⟨z, ⟨f, hf, hz⟩, rfl⟩ + · rintro ⟨z, ⟨f, hf, hz⟩, rfl⟩ + exact ⟨f.image GaussianQuarterTurn, ⟨f, hf, rfl⟩, + Finset.mem_image.mpr ⟨z, hz, rfl⟩⟩ + · simp [BoundaryFootprintVertices, h, + GaussianQuarterTurn] + · exact edge_formula + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileRealization.lean b/LeanPool/ApollonianSuperharmonic/TileRealization.lean new file mode 100644 index 0000000000..d68e3b4cc2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileRealization.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: TileRealization] + +/-! +# TileRealization + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The real realization of a prototile $T$ is the finite union +$$ + I(T)=\bigcup_{s_x\in T}\overline s_x\subset\mathbb R^2. +$$ +The anchor of an empty prototile contributes no square to $I(T)$. +-/ +def TileRealization (T : ProtoTile) : Set (Real × Real) := +-- BODY + ⋃ x ∈ T.cells, ClosedSquareRealization x + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileReflection.lean b/LeanPool/ApollonianSuperharmonic/TileReflection.lean new file mode 100644 index 0000000000..fb01d8f2ea --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileReflection.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianReflection +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: TileReflection] + +/-! +# TileReflection + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +The reflection $rT$ of a prototile in the real axis has cell basepoints +$r x-i$ for $x$ a cell basepoint of $T$, and has anchor $r(a_T)$. The +subtraction of $i$ is the lower-left-corner correction for reflecting a +closed unit square. An empty prototile therefore remains empty and its +singleton footprint is reflected by reflecting its assigned anchor. +-/ +def TileReflection (T : ProtoTile) : ProtoTile := +-- BODY + ⟨T.cells.image (fun x => GaussianReflection x - ⟨0, 1⟩), + GaussianReflection T.anchor⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean new file mode 100644 index 0000000000..39130e131d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean @@ -0,0 +1,499 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileReflection + +-- [TABLET NODE: TileReflectionFormulas] + +/-! +# TileReflectionFormulas + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace ReflectionFormulas + +private noncomputable def f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + +private theorem gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := by + classical + rcases u with ⟨u, w⟩ + rcases v with ⟨v, z⟩ + simp_all + +private theorem reflection_involutive (z : GaussianInt) : + GaussianReflection (GaussianReflection z) = z := by + classical + have gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_ext u v hre him + apply gaussian_ext <;> simp [GaussianReflection] + +private theorem f_involutive (z : GaussianInt) : f (f z) = z := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_ext u v hre him + change (f (f z) = z) + apply gaussian_ext <;> simp [f, GaussianReflection] + +private theorem reflection_one (z : GaussianInt) : + GaussianReflection (z + 1) = GaussianReflection z + 1 := by + classical + have gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_ext u v hre him + apply gaussian_ext <;> simp [GaussianReflection] + +private theorem reflection_up (z : GaussianInt) : + GaussianReflection (z + ⟨0, 1⟩) = f z := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_ext u v hre him + change (GaussianReflection (z + ⟨0, 1⟩) = f z) + apply gaussian_ext <;> simp [f, GaussianReflection]; omega + +private theorem reflection_one_up (z : GaussianInt) : + GaussianReflection (z + 1 + ⟨0, 1⟩) = f z + 1 := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_ext u v hre him + change (GaussianReflection (z + 1 + ⟨0, 1⟩) = f z + 1) + apply gaussian_ext <;> simp [f, GaussianReflection]; omega + +private theorem f_one (z : GaussianInt) : f (z + 1) = f z + 1 := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_ext u v hre him + change (f (z + 1) = f z + 1) + apply gaussian_ext <;> simp [f, GaussianReflection] + +private theorem f_up (z : GaussianInt) : f (z + ⟨0, 1⟩) = f z - ⟨0, 1⟩ := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_ext u v hre him + change (f (z + ⟨0, 1⟩) = f z - ⟨0, 1⟩) + apply gaussian_ext <;> simp [f, GaussianReflection]; omega + +private theorem reflection_f (z : GaussianInt) : GaussianReflection (f z) = z + ⟨0, 1⟩ := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_ext u v hre him + change (GaussianReflection (f z) = z + ⟨0, 1⟩) + apply gaussian_ext <;> simp [f, GaussianReflection]; omega + +private theorem f_reflection (z : GaussianInt) : f (GaussianReflection z) = z - ⟨0, 1⟩ := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_ext u v hre him + change (f (GaussianReflection z) = z - ⟨0, 1⟩) + apply gaussian_ext <;> simp [f, GaussianReflection] + +private theorem f_sub_up (z : GaussianInt) : f (z - ⟨0, 1⟩) = GaussianReflection z := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_ext u v hre him + change (f (z - ⟨0, 1⟩) = GaussianReflection z) + apply gaussian_ext <;> simp [f, GaussianReflection] + +private theorem f_sub_one (z : GaussianInt) : f (z - 1) = f z - 1 := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_ext u v hre him + change (f (z - 1) = f z - 1) + apply gaussian_ext <;> simp [f, GaussianReflection] + +private theorem f_add_up (z : GaussianInt) : f z + ⟨0, 1⟩ = GaussianReflection z := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_ext u v hre him + change (f z + ⟨0, 1⟩ = GaussianReflection z) + apply gaussian_ext <;> simp [f, GaussianReflection] + +private theorem f_add_one_up (z : GaussianInt) : + f z + 1 + ⟨0, 1⟩ = GaussianReflection z + 1 := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := gaussian_ext u v hre him + change (f z + 1 + ⟨0, 1⟩ = GaussianReflection z + 1) + apply gaussian_ext <;> simp [f, GaussianReflection] + +private theorem f_re_cast (z : GaussianInt) : ((f z).re : Real) = (z.re : Real) := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + change (((f z).re : Real) = (z.re : Real)) + rcases z with ⟨a, b⟩ + simp [f, GaussianReflection] + +private theorem f_re (z : GaussianInt) : + (GaussianInt.toComplex (f z)).re = (GaussianInt.toComplex z).re := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + change ((GaussianInt.toComplex (f z)).re = (GaussianInt.toComplex z).re) + rcases z with ⟨a, b⟩ + simp [f, GaussianReflection] + +private theorem f_im (z : GaussianInt) : + (GaussianInt.toComplex (f z)).im = + -(GaussianInt.toComplex z).im - 1 := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + change ((GaussianInt.toComplex (f z)).im = + -(GaussianInt.toComplex z).im - 1) + rcases z with ⟨a, b⟩ + simp [f, GaussianReflection] + +private theorem reflectedCellRe (z : GaussianInt) : + (GaussianInt.toComplex (GaussianReflection z - ⟨0, 1⟩)).re = + (GaussianInt.toComplex z).re := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have f_re (z : GaussianInt) : + (GaussianInt.toComplex (f z)).re = (GaussianInt.toComplex z).re := f_re z + change (GaussianInt.toComplex (f z)).re = _ + exact f_re z + +private theorem reflectedCellIm (z : GaussianInt) : + (GaussianInt.toComplex (GaussianReflection z - ⟨0, 1⟩)).im = + -(GaussianInt.toComplex z).im - 1 := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have f_im (z : GaussianInt) : + (GaussianInt.toComplex (f z)).im = + -(GaussianInt.toComplex z).im - 1 := f_im z + change (GaussianInt.toComplex (f z)).im = _ + exact f_im z + +private theorem f_im_cast (z : GaussianInt) : + ((f z).im : Real) = -(z.im : Real) - 1 := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + change (((f z).im : Real) = -(z.im : Real) - 1) + rcases z with ⟨a, b⟩ + simp [f, GaussianReflection] + +private theorem pair_swap (u v : GaussianInt) : ({u, v} : Finset GaussianInt) = {v, u} := by + classical + ext z + simp [or_comm] + +private theorem cell_formula (T : ProtoTile) (z : GaussianInt) : + z ∈ (TileReflection T).cells ↔ f z ∈ T.cells := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have f_involutive (z : GaussianInt) : f (f z) = z := f_involutive z + change (z ∈ (TileReflection T).cells ↔ f z ∈ T.cells) + change z ∈ T.cells.image f ↔ _ + constructor + · intro hz + rcases Finset.mem_image.mp hz with ⟨a, ha, rfl⟩ + simpa only [f_involutive] using ha + · intro hz + exact Finset.mem_image.mpr ⟨f z, hz, f_involutive z⟩ + +private theorem edge_formula (T : ProtoTile) : + BoundaryFootprintEdges (TileReflection T) = + (fun e : Finset GaussianInt => e.image GaussianReflection) '' + BoundaryFootprintEdges T := by + classical + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have reflection_involutive (z : GaussianInt) : + GaussianReflection (GaussianReflection z) = z := reflection_involutive z + have f_involutive (z : GaussianInt) : f (f z) = z := f_involutive z + have reflection_one (z : GaussianInt) : + GaussianReflection (z + 1) = GaussianReflection z + 1 := reflection_one z + have reflection_up (z : GaussianInt) : + GaussianReflection (z + ⟨0, 1⟩) = f z := reflection_up z + have reflection_f (z : GaussianInt) : GaussianReflection (f z) = z + ⟨0, 1⟩ := reflection_f z + have f_reflection (z : GaussianInt) : f (GaussianReflection z) = z - ⟨0, 1⟩ := f_reflection z + have f_sub_up (z : GaussianInt) : f (z - ⟨0, 1⟩) = GaussianReflection z := f_sub_up z + have f_sub_one (z : GaussianInt) : f (z - 1) = f z - 1 := f_sub_one z + have f_add_up (z : GaussianInt) : f z + ⟨0, 1⟩ = GaussianReflection z := f_add_up z + have pair_swap (u v : GaussianInt) : ({u, v} : Finset GaussianInt) = {v, u} := pair_swap u v + have cell_formula (z : GaussianInt) : + z ∈ (TileReflection T).cells ↔ f z ∈ T.cells := cell_formula T z + ext e + change (∃ z : GaussianInt, + (e = {z, z + 1} ∧ + ((z ∈ (TileReflection T).cells ∧ + z - ⟨0, 1⟩ ∉ (TileReflection T).cells) ∨ + (z ∉ (TileReflection T).cells ∧ + z - ⟨0, 1⟩ ∈ (TileReflection T).cells))) ∨ + (e = {z, z + ⟨0, 1⟩} ∧ + ((z ∈ (TileReflection T).cells ∧ + z - 1 ∉ (TileReflection T).cells) ∨ + (z ∉ (TileReflection T).cells ∧ + z - 1 ∈ (TileReflection T).cells)))) ↔ + ∃ q, q ∈ BoundaryFootprintEdges T ∧ + q.image GaussianReflection = e + constructor + · rintro ⟨z, hz⟩ + rcases hz with ⟨he, hp⟩ | ⟨he, hp⟩ + · refine ⟨{GaussianReflection z, GaussianReflection z + 1}, ?_, ?_⟩ + · refine ⟨GaussianReflection z, Or.inl ⟨rfl, ?_⟩⟩ + simpa [cell_formula, f_sub_up, f_reflection, and_comm, or_comm] + using hp + · subst e + simp [Finset.image_insert, reflection_involutive, reflection_one] + · refine ⟨{f z, f z + ⟨0, 1⟩}, ?_, ?_⟩ + · refine ⟨f z, Or.inr ⟨rfl, ?_⟩⟩ + simpa [cell_formula, f_involutive, f_sub_one] using hp + · subst e + simp [Finset.image_insert, reflection_f, reflection_up, + f_involutive, pair_swap] + · rintro ⟨q, ⟨a, ha⟩, he⟩ + rcases ha with ⟨hq, hp⟩ | ⟨hq, hp⟩ + · refine ⟨GaussianReflection a, Or.inl ⟨?_, ?_⟩⟩ + · subst q + rw [← he] + simp [Finset.image_insert, reflection_one] + · simpa only [cell_formula, f_reflection, f_sub_up, + reflection_involutive, not_iff_not, and_comm, or_comm] using hp + · refine ⟨f a, Or.inr ⟨?_, ?_⟩⟩ + · subst q + rw [← he] + simp [Finset.image_insert, reflection_up, f_add_up, pair_swap] + · simpa [cell_formula, f_involutive, f_sub_one] using hp + +end ReflectionFormulas + +theorem TileReflectionFormulas : ∀ T : ProtoTile, + (TileReflection T).cells = + T.cells.image (fun x => GaussianReflection x - ⟨0, 1⟩) ∧ + (TileReflection T).anchor = GaussianReflection T.anchor ∧ + ((TileReflection T).cells = ∅ ↔ T.cells = ∅) ∧ + TileRealization (TileReflection T) = + (fun p : Real × Real => (p.1, -p.2)) '' TileRealization T ∧ + TileCentroid (TileReflection T) = + ((TileCentroid T).1, -(TileCentroid T).2) ∧ + FootprintVertices (TileReflection T) = + GaussianReflection '' FootprintVertices T ∧ + FootprintEdges (TileReflection T) = + (fun e : Finset GaussianInt => e.image GaussianReflection) '' + FootprintEdges T ∧ + BoundaryFootprintVertices (TileReflection T) = + GaussianReflection '' BoundaryFootprintVertices T ∧ + BoundaryFootprintEdges (TileReflection T) = + (fun e : Finset GaussianInt => e.image GaussianReflection) '' + BoundaryFootprintEdges T := by +-- BODY + intro T + let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ + have f_involutive (z : GaussianInt) : f (f z) = z := ReflectionFormulas.f_involutive z + have reflection_one (z : GaussianInt) : + GaussianReflection (z + 1) = GaussianReflection z + 1 := ReflectionFormulas.reflection_one z + have reflection_up (z : GaussianInt) : + GaussianReflection (z + ⟨0, 1⟩) = f z := ReflectionFormulas.reflection_up z + have reflection_one_up (z : GaussianInt) : + GaussianReflection (z + 1 + ⟨0, 1⟩) = f z + 1 := ReflectionFormulas.reflection_one_up z + have f_one (z : GaussianInt) : f (z + 1) = f z + 1 := ReflectionFormulas.f_one z + have f_add_up (z : GaussianInt) : f z + ⟨0, 1⟩ = GaussianReflection z := + ReflectionFormulas.f_add_up z + have f_add_one_up (z : GaussianInt) : + f z + 1 + ⟨0, 1⟩ = GaussianReflection z + 1 := ReflectionFormulas.f_add_one_up z + have f_re_cast (z : GaussianInt) : ((f z).re : Real) = (z.re : Real) := + ReflectionFormulas.f_re_cast z + have f_re (z : GaussianInt) : + (GaussianInt.toComplex (f z)).re = (GaussianInt.toComplex z).re := ReflectionFormulas.f_re z + have f_im (z : GaussianInt) : + (GaussianInt.toComplex (f z)).im = + -(GaussianInt.toComplex z).im - 1 := ReflectionFormulas.f_im z + have f_im_cast (z : GaussianInt) : + ((f z).im : Real) = -(z.im : Real) - 1 := ReflectionFormulas.f_im_cast z + have pair_swap (u v : GaussianInt) : ({u, v} : Finset GaussianInt) = {v, u} := + ReflectionFormulas.pair_swap u v + dsimp [TileReflection] + constructor + · rfl + constructor + · rfl + constructor + · simp [GaussianReflection] + constructor + · ext p + simp only [TileRealization, ClosedSquareRealization, Set.mem_iUnion, + Set.mem_image, Set.mem_Icc, Prod.le_def, Finset.mem_image] + constructor + · rintro ⟨i, ⟨j, hj, rfl⟩, hlow, hupp⟩ + refine ⟨(p.1, -p.2), ?_, ?_⟩ + · change ((f j).re : Real) ≤ p.1 ∧ ((f j).im : Real) ≤ p.2 at hlow + change p.1 ≤ ((f j).re : Real) + 1 ∧ + p.2 ≤ ((f j).im : Real) + 1 at hupp + rw [f_re_cast, f_im_cast] at hlow hupp + rcases hlow with ⟨h₁, h₂⟩ + rcases hupp with ⟨h₃, h₄⟩ + simp only [] + refine ⟨j, hj, ?_⟩ + exact ⟨⟨h₁, by linarith⟩, h₃, by linarith⟩ + · simp + · rintro ⟨x, ⟨i, hi, hlow, hupp⟩, rfl⟩ + refine ⟨f i, ⟨i, hi, ?_⟩, ?_, ?_⟩ + · rfl + · change ((f i).re : Real) ≤ x.1 ∧ ((f i).im : Real) ≤ -x.2 + rw [f_re_cast, f_im_cast] + rcases hlow with ⟨h₁, h₂⟩ + rcases hupp with ⟨h₃, h₄⟩ + exact ⟨h₁, by linarith⟩ + · change x.1 ≤ ((f i).re : Real) + 1 ∧ + -x.2 ≤ ((f i).im : Real) + 1 + rw [f_re_cast, f_im_cast] + exact ⟨hupp.1, by linarith [hlow.2]⟩ + constructor + · by_cases h : T.cells.Nonempty + · have hinj : Function.Injective f := by + intro a b hab + simpa only [f_involutive] using congrArg f hab + simp? [TileCentroid, h] + rw [Finset.card_image_of_injective T.cells hinj] + rw [Finset.sum_image hinj.injOn] + rw [Finset.sum_image hinj.injOn] + simp only [f_re, f_im, + Finset.sum_sub_distrib, + Finset.sum_neg_distrib, Finset.sum_const] + have cardReal : (Finset.card T.cells : Real) ≠ 0 := by + exact_mod_cast h.card_pos.ne' + constructor + · trivial + · field_simp [cardReal] + ring + · simp [TileCentroid, h, GaussianReflection] + constructor + · ext v + by_cases h : T.cells.Nonempty + · have hnew : + (T.cells.image (fun x => GaussianReflection x - ⟨0, 1⟩)).Nonempty := + h.image _ + simp? [FootprintVertices, h, hnew] + constructor + · rintro ⟨a, ha, hv⟩ + rcases hv with rfl | rfl | rfl | rfl + · refine ⟨a + ⟨0, 1⟩, ⟨a, ha, Or.inr (Or.inr (Or.inl rfl))⟩, ?_⟩ + exact reflection_up a + · refine ⟨a + 1 + ⟨0, 1⟩, + ⟨a, ha, Or.inr (Or.inr (Or.inr rfl))⟩, ?_⟩ + exact reflection_one_up a + · refine ⟨a, ⟨a, ha, Or.inl rfl⟩, ?_⟩ + rfl + · refine ⟨a + 1, ⟨a, ha, Or.inr (Or.inl rfl)⟩, ?_⟩ + rw [reflection_one, ← f_add_one_up] + · rintro ⟨x, ⟨a, ha, hx⟩, hv⟩ + refine ⟨a, ha, ?_⟩ + rcases hx with rfl | rfl | rfl | rfl + · refine Or.inr (Or.inr (Or.inl ?_)) + rw [← hv] + · refine Or.inr (Or.inr (Or.inr ?_)) + rw [← hv] + rw [reflection_one, ← f_add_one_up] + · refine Or.inl ?_ + rw [← hv] + exact reflection_up a + · refine Or.inr (Or.inl ?_) + rw [← hv] + exact reflection_one_up a + · simp [FootprintVertices, h, GaussianReflection] + constructor + · ext e + simp only [FootprintEdges, Set.mem_ofPred_eq, Set.mem_image, + Finset.mem_image] + constructor + · rintro ⟨z, ⟨a, ha, rfl⟩, he⟩ + rcases he with h0 | h1 | h2 | h3 + · refine ⟨{a + ⟨0, 1⟩, a + 1 + ⟨0, 1⟩}, + ⟨a, ha, Or.inr (Or.inr (Or.inr rfl))⟩, ?_⟩ + rw [h0] + simp only [Finset.image_insert, Finset.image_singleton] + rw [reflection_up, reflection_one_up] + · refine ⟨{a, a + ⟨0, 1⟩}, + ⟨a, ha, Or.inr (Or.inl rfl)⟩, ?_⟩ + rw [h1] + simp only [Finset.image_insert, Finset.image_singleton] + rw [reflection_up] + change ({GaussianReflection a, f a} : Finset GaussianInt) = + {f a, f a + ⟨0, 1⟩} + rw [f_add_up] + exact pair_swap _ _ + · refine ⟨{a + 1, a + 1 + ⟨0, 1⟩}, + ⟨a, ha, Or.inr (Or.inr (Or.inl rfl))⟩, ?_⟩ + rw [h2] + simp only [Finset.image_insert, Finset.image_singleton] + rw [reflection_one, reflection_one_up] + change ({GaussianReflection a + 1, f a + 1} : Finset GaussianInt) = + {f a + 1, f a + 1 + ⟨0, 1⟩} + rw [f_add_one_up] + exact pair_swap _ _ + · refine ⟨{a, a + 1}, ⟨a, ha, Or.inl rfl⟩, ?_⟩ + rw [h3] + simp only [Finset.image_insert, Finset.image_singleton] + rw [reflection_one] + change ({GaussianReflection a, GaussianReflection a + 1} : + Finset GaussianInt) = {f a + ⟨0, 1⟩, f a + 1 + ⟨0, 1⟩} + rw [f_add_up, f_add_one_up] + · rintro ⟨q, ⟨a, ha, hq⟩, he⟩ + refine ⟨f a, ⟨a, ha, rfl⟩, ?_⟩ + rcases hq with h0 | h1 | h2 | h3 + · refine Or.inr (Or.inr (Or.inr ?_)) + rw [← he, h0] + simp [Finset.image_insert, reflection_one, f_add_up, f_add_one_up] + · refine Or.inr (Or.inl ?_) + rw [← he, h1] + simp [Finset.image_insert, reflection_up, f_add_up, pair_swap] + · refine Or.inr (Or.inr (Or.inl ?_)) + rw [← he, h2] + simp [Finset.image_insert, reflection_one, reflection_one_up, + f_add_one_up, pair_swap] + · refine Or.inl ?_ + rw [← he, h3] + simp [Finset.image_insert, reflection_up, f_one] + have edge_formula : + BoundaryFootprintEdges (TileReflection T) = + (fun e : Finset GaussianInt => e.image GaussianReflection) '' + BoundaryFootprintEdges T := ReflectionFormulas.edge_formula T + constructor + · by_cases h : T.cells.Nonempty + · simp only [BoundaryFootprintVertices, ite_eq_left h] + have hnew : + (T.cells.image (fun x => GaussianReflection x - ⟨0, 1⟩)).Nonempty := + h.image _ + simp only [ite_eq_left hnew] + change {v | ∃ e ∈ BoundaryFootprintEdges (TileReflection T), v ∈ e} = _ + rw [edge_formula] + ext v + constructor + · rintro ⟨e, ⟨q, hq, rfl⟩, hv⟩ + rcases Finset.mem_image.mp hv with ⟨z, hz, rfl⟩ + exact ⟨z, ⟨q, hq, hz⟩, rfl⟩ + · rintro ⟨z, ⟨q, hq, hz⟩, rfl⟩ + exact ⟨q.image GaussianReflection, ⟨q, hq, rfl⟩, + Finset.mem_image.mpr ⟨z, hz, rfl⟩⟩ + · have hnew : + ¬(T.cells.image (fun x => GaussianReflection x - ⟨0, 1⟩)).Nonempty := by + simpa using h + simp [BoundaryFootprintVertices, h, GaussianReflection] + · exact edge_formula + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileString.lean b/LeanPool/ApollonianSuperharmonic/TileString.lean new file mode 100644 index 0000000000..9f611a9bf5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileString.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.RegularTileFamily +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TilingLattice +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep + +-- [TABLET NODE: TileString] + +/-! +# TileString + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Fix a `BandPrototile` $T_C$ for $C$ and its regular translate family +$T_C+\Lambda_C$. Thus the ambient family is the regular $C$-tiling, not +the translate family of an arbitrary prototile. A tile string from $R$ to +$S$, with a chosen unit orientation $\epsilon$, is a finite list of +pairwise distinct tiles in this family, beginning +at $R$ and ending at $S$, with consecutive terms adjacent. For +$c>1$, adjacency means `TileTouching`; for $c=1$ it is the +single triangular completion selected by +`UnitTriangularStep`: centroid differences satisfy +$\operatorname{UnitStep}_{\epsilon}$. In particular, a string never +uses the eight-neighbor union of the two unit completions. + +Every interior tile has nonnegative signed height above the directed line +from $\operatorname{cent}(R)$ to $\operatorname{cent}(S)$ and has an +adjacent tile of strictly negative signed height. Here signed height is +the cross product +$$ + (y-y_R)(x_S-x_R)-(x-x_R)(y_S-y_R), +$$ +which is the denominator-cleared form of the paper's imaginary-part +inequality. When $R=S$, the string is the one-term list; otherwise the +pairwise-distinct condition forces distinct endpoints. +-/ +def TileString (C : BandCircle) (orientation : Bool) (base R S : ProtoTile) + (tiles : List ProtoTile) : Prop := +-- BODY + let adjacent := fun T U : ProtoTile => + if C.1.1.1 = 1 then + ∃ v : GaussianInt, + UnitTriangularStep orientation v ∧ + TileCentroid U - TileCentroid T = GaussianRealPoint v + else TileTouching T U + let height := fun T : ProtoTile => + ((TileCentroid T).2 - (TileCentroid R).2) * + ((TileCentroid S).1 - (TileCentroid R).1) - + ((TileCentroid T).1 - (TileCentroid R).1) * + ((TileCentroid S).2 - (TileCentroid R).2) + BandPrototile C.1.1 base ∧ + tiles.head? = some R ∧ tiles.getLast? = some S ∧ + tiles.Pairwise (fun T U => T ≠ U) ∧ + (∀ T, T ∈ tiles → T ∈ RegularTileFamily base (TilingLattice C)) ∧ + tiles.IsChain adjacent ∧ + ∀ pre T post, tiles = pre ++ T :: post → + pre ≠ [] → post ≠ [] → + 0 ≤ height T ∧ + ∃ U ∈ RegularTileFamily base (TilingLattice C), + adjacent T U ∧ height U < 0 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileStringCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/TileStringCentralCovariance.lean new file mode 100644 index 0000000000..1ba0264adf --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileStringCentralCovariance.lean @@ -0,0 +1,524 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileString +public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: TileStringCentralCovariance] + +/-! +# TileStringCentralCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace CentralStringProof + +private theorem band_transform : + (by + classical + exact + ∀ (u : GaussianInt), + let transform : ProtoTile → ProtoTile := + fun T => TileTranslation (TileHalfTurn T) u + (∀ T : ProtoTile, TileCentroid (transform T) = (-(TileCentroid T).1 + (u.re : Real), + -(TileCentroid T).2 + (u.im : Real))) → ((∀ T : ProtoTile, FootprintVertices (transform + T) = GaussianTranslation u '' ((fun x : GaussianInt => -x) '' FootprintVertices T)) → (∀ + (D : CircleCoordinates), ∀ (T : ProtoTile), BandPrototile D T → BandPrototile D + (transform T))) ) := by + classical + intro u transform centroid_transform footprint_transform D T hT + induction hT with + | line w x hw => + apply BandPrototile.line + exact hw + | unit z x => + apply BandPrototile.unit + | @decompose q hq S T hS hcells hfoot hcentroid ih => + let R : Fin 3 → Bool → ProtoTile := + fun i s => transform (S i (!s)) + have hR : ∀ i s, BandPrototile (q i.succ) (R i s) := by + intro i s + exact ih i (!s) + apply BandPrototile.decompose hq hR + · intro x + constructor + · intro hx + dsimp [transform, TileTranslation, TileHalfTurn] at hx + rcases Finset.mem_image.mp hx with ⟨z, hz, rfl⟩ + rcases Finset.mem_image.mp hz with ⟨y, hy, rfl⟩ + rcases (hcells y).mp hy with ⟨i, s, hs⟩ + refine ⟨i, !s, ?_⟩ + dsimp [R] + simp only [Bool.not_not] + change GaussianTranslation u (-y - 1 - ⟨0, 1⟩) ∈ + (transform (S i s)).cells + exact Finset.mem_image.mpr ⟨-y - 1 - ⟨0, 1⟩, + Finset.mem_image.mpr ⟨y, hs, rfl⟩, rfl⟩ + · rintro ⟨i, s, hs⟩ + have hs' : x ∈ (transform (S i (!s))).cells := hs + have hx' : x ∈ (transform T).cells := by + dsimp [transform, TileTranslation, TileHalfTurn] + rcases Finset.mem_image.mp hs' with ⟨z, hz, heq⟩ + rcases Finset.mem_image.mp hz with ⟨y, hy, heq'⟩ + exact Finset.mem_image.mpr ⟨z, + Finset.mem_image.mpr ⟨y, (hcells y).mpr ⟨i, !s, hy⟩, heq'⟩, + heq⟩ + exact hx' + · intro i s + rw [footprint_transform, footprint_transform] + intro x hx + rcases hx with ⟨y, ⟨v, hv, rfl⟩, rfl⟩ + exact ⟨-v, ⟨v, hfoot i (!s) hv, rfl⟩, rfl⟩ + · intro i s + have hp := hcentroid i (!s) + rw [centroid_transform, centroid_transform] + have hfirst := congrArg Prod.fst hp + have hsecond := congrArg Prod.snd hp + have hsign : + (if (!s) = true then (1 : Real) else -1) = + -(if s = true then (1 : Real) else -1) := by + cases s <;> norm_num + rw [hsign] at hfirst hsecond + dsimp [R] + dsimp [GaussianRealPoint] at hfirst hsecond ⊢ + ring_nf at hfirst hsecond ⊢ + apply Prod.ext + all_goals try dsimp at * + all_goals linarith + +private theorem transform_translate : + (by + classical + exact + ∀ (u : GaussianInt), + let transform : ProtoTile → ProtoTile := + fun T => TileTranslation (TileHalfTurn T) u + ∀ (T : ProtoTile), ∀ (v : GaussianInt), transform (TileTranslation T v) = TileTranslation + (transform T) (-v) ) := by + classical + intro u transform T v + cases T with + | mk cells anchor => + rw [ProtoTile.mk.injEq] + constructor + · ext x + simp? [transform, TileTranslation, TileHalfTurn, + GaussianTranslation, Finset.image_image] + constructor + · rintro ⟨a, ha, heq⟩ + refine ⟨a, ha, ?_⟩ + calc + -a - 1 - ⟨0, 1⟩ + u + -v = -v + -a - 1 - ⟨0, 1⟩ + u := by abel + _ = x := heq + · rintro ⟨a, ha, heq⟩ + refine ⟨a, ha, ?_⟩ + calc + -v + -a - 1 - ⟨0, 1⟩ + u = -a - 1 - ⟨0, 1⟩ + u + -v := by abel + _ = x := heq + · simp [transform, TileTranslation, TileHalfTurn, GaussianTranslation]; split <;> abel + +private theorem transform_involutive : + (by + classical + exact + ∀ (u : GaussianInt), + let transform : ProtoTile → ProtoTile := + fun T => TileTranslation (TileHalfTurn T) u + (∀ (T : ProtoTile), ∀ (v : GaussianInt), transform (TileTranslation T v) = TileTranslation + (transform T) (-v)) → (∀ T : ProtoTile, transform (transform T) = T) ) := by + classical + intro u transform transform_translate T + have h := transform_translate (TileHalfTurn T) u + dsimp [transform] at h ⊢ + rw [(TileHalfTurnFormulas T).2.2.2.1] at h + have cancel : TileTranslation (TileTranslation T u) (-u) = T := by + cases T with + | mk cells anchor => + rw [ProtoTile.mk.injEq] + constructor + · ext x + simp [TileTranslation, GaussianTranslation, Finset.image_image] + · simp [TileTranslation, GaussianTranslation] + exact h.trans cancel + +private theorem touch_same_cells : + (by + classical + exact + ∀ A B A' B' : ProtoTile, A.cells = A'.cells → B.cells = B'.cells → A.cells.Nonempty → + B.cells.Nonempty → (TileTouching A B ↔ TileTouching A' B') ) := by + classical + intro A B A' B' hA hB ha hb + have eA : BoundaryFootprintEdges A = BoundaryFootprintEdges A' := by + ext e + simp [BoundaryFootprintEdges, hA] + have ha' : A'.cells.Nonempty := hA ▸ ha + have eB : BoundaryFootprintEdges B = BoundaryFootprintEdges B' := by + ext e + simp [BoundaryFootprintEdges, hB] + have hb' : B'.cells.Nonempty := hB ▸ hb + have haEmpty : A'.cells ≠ ∅ := Finset.nonempty_iff_ne_empty.mp ha' + have hbEmpty : B'.cells ≠ ∅ := Finset.nonempty_iff_ne_empty.mp hb' + unfold TileTouching + simp only [BoundaryFootprintVertices, ite_eq_left ha, ite_eq_left hb, + ite_eq_left ha', ite_eq_left hb'] + rw [hA, hB, eA, eB] + simp [haEmpty, hbEmpty] + +private theorem touch_same_left : + (by + classical + exact + ∀ A A' B : ProtoTile, A.cells = A'.cells → A.cells.Nonempty → (TileTouching A B ↔ + TileTouching A' B) ) := by + classical + intro A A' B hA ha + have eA : BoundaryFootprintEdges A = BoundaryFootprintEdges A' := by + ext e + simp [BoundaryFootprintEdges, hA] + have ha' : A'.cells.Nonempty := hA ▸ ha + have haEmpty : A'.cells ≠ ∅ := Finset.nonempty_iff_ne_empty.mp ha' + unfold TileTouching + simp only [BoundaryFootprintVertices, ite_eq_left ha, ite_eq_left ha'] + rw [hA, eA] + simp [haEmpty] + +private theorem touch_same_right : + (by + classical + exact + ∀ A B B' : ProtoTile, B.cells = B'.cells → B.cells.Nonempty → (TileTouching A B ↔ + TileTouching A B') ) := by + classical + intro A B B' hB hb + have eB : BoundaryFootprintEdges B = BoundaryFootprintEdges B' := by + ext e + simp [BoundaryFootprintEdges, hB] + have hb' : B'.cells.Nonempty := hB ▸ hb + have hbEmpty : B'.cells ≠ ∅ := Finset.nonempty_iff_ne_empty.mp hb' + unfold TileTouching + simp only [BoundaryFootprintVertices, ite_eq_left hb, ite_eq_left hb'] + rw [hB, eB] + simp [hbEmpty] + +private theorem touching_half_quarter : + (by + classical + exact + (∀ A B A' B' : ProtoTile, A.cells = A'.cells → B.cells = B'.cells → A.cells.Nonempty → + B.cells.Nonempty → (TileTouching A B ↔ TileTouching A' B')) → ((∀ A A' B : ProtoTile, + A.cells = A'.cells → A.cells.Nonempty → (TileTouching A B ↔ TileTouching A' B)) → ((∀ A B + B' : ProtoTile, B.cells = B'.cells → B.cells.Nonempty → (TileTouching A B ↔ TileTouching + A B')) → ((∀ T : ProtoTile, T.cells.Nonempty → (TileHalfTurn T).cells.Nonempty) → (∀ A B + : ProtoTile, TileTouching (TileHalfTurn A) (TileHalfTurn B) ↔ TileTouching + (TileQuarterTurn (TileQuarterTurn A)) (TileQuarterTurn (TileQuarterTurn B)))))) ) := by + classical + intro touch_same_cells touch_same_left touch_same_right half_nonempty A B + by_cases ha : A.cells.Nonempty + · by_cases hb : B.cells.Nonempty + · exact touch_same_cells (TileHalfTurn A) (TileHalfTurn B) + (TileQuarterTurn (TileQuarterTurn A)) + (TileQuarterTurn (TileQuarterTurn B)) + (TileHalfTurnFormulas A).2.2.2.2.1 + (TileHalfTurnFormulas B).2.2.2.2.1 + (half_nonempty A ha) (half_nonempty B hb) + · have eb : B.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hb + rw [(TileHalfTurnFormulas B).2.2.2.2.2.2.2.2 eb] + exact touch_same_left (TileHalfTurn A) + (TileQuarterTurn (TileQuarterTurn A)) + (TileQuarterTurn (TileQuarterTurn B)) + (TileHalfTurnFormulas A).2.2.2.2.1 + (half_nonempty A ha) + · have ea : A.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp ha + rw [(TileHalfTurnFormulas A).2.2.2.2.2.2.2.2 ea] + by_cases hb : B.cells.Nonempty + · exact touch_same_right (TileQuarterTurn (TileQuarterTurn A)) + (TileHalfTurn B) (TileQuarterTurn (TileQuarterTurn B)) + (TileHalfTurnFormulas B).2.2.2.2.1 + (half_nonempty B hb) + · have eb : B.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hb + rw [(TileHalfTurnFormulas B).2.2.2.2.2.2.2.2 eb] + +private theorem adjacent_cov : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (R : ProtoTile), ∀ (S + : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (u : GaussianInt), ( + let adjacent := fun (T U : + ProtoTile) => if C.1.1.1 = (1 : ℤ) then ∃ (v : + GaussianInt), UnitTriangularStep orientation v ∧ TileCentroid U - TileCentroid T = + GaussianRealPoint v else TileTouching T U; + let height := fun (T : ProtoTile) => + ((TileCentroid T).2 - (TileCentroid R).2) * ((TileCentroid S).1 - (TileCentroid R).1) - + ((TileCentroid T).1 - (TileCentroid R).1) * ((TileCentroid S).2 - (TileCentroid R).2); + BandPrototile C.1.1 base ∧ tiles.head? = some + R ∧ tiles.getLast? = some S ∧ List.Pairwise (fun (T U : ProtoTile) => T ≠ U) tiles ∧ (∀ T + ∈ tiles, T ∈ RegularTileFamily base (TilingLattice C)) ∧ List.IsChain adjacent tiles ∧ ∀ + (pre : List ProtoTile), ∀ (T : ProtoTile), ∀ (post : List ProtoTile), tiles = pre ++ + T :: + post → pre ≠ [] → post ≠ [] → (0 : ℝ) ≤ height T ∧ ∃ U ∈ RegularTileFamily base + (TilingLattice C), adjacent T U ∧ height U < (0 : ℝ)) → ( + let transform : ProtoTile → ProtoTile := + fun T => TileTranslation (TileHalfTurn T) u + (∀ T : ProtoTile, TileCentroid (transform T) = (-(TileCentroid T).1 + (u.re : Real), + -(TileCentroid T).2 + (u.im : Real))) → ((∀ A B : ProtoTile, TileTouching (TileHalfTurn + A) (TileHalfTurn B) ↔ TileTouching (TileQuarterTurn (TileQuarterTurn A)) (TileQuarterTurn + (TileQuarterTurn B))) → (∀ A B : ProtoTile, (if C.1.1.1 = 1 then ∃ v : GaussianInt, + UnitTriangularStep orientation v ∧ TileCentroid B - TileCentroid A = GaussianRealPoint v + else TileTouching A B) ↔ (if C.1.1.1 = 1 then ∃ v : GaussianInt, UnitTriangularStep + orientation v ∧ TileCentroid (transform B) - TileCentroid (transform A) = + GaussianRealPoint v else TileTouching (transform A) (transform B))))) ) := by + classical + intro C orientation base R S tiles u hstring transform centroid_transform touching_half_quarter + A B + by_cases hc : C.1.1.1 = 1 + · simp only [hc, ↓reduceIte] + constructor + · rintro ⟨v, hv, he⟩ + refine ⟨-v, ?_, ?_⟩ + · cases orientation <;> simp [UnitTriangularStep] at hv ⊢ <;> aesop + · rw [centroid_transform, centroid_transform] + have hx := congrArg Prod.fst he + have hy := congrArg Prod.snd he + dsimp [GaussianRealPoint] at hx hy ⊢ + norm_num at hx hy ⊢ + exact ⟨by linarith [hx], by linarith [hy]⟩ + · rintro ⟨v, hv, he⟩ + refine ⟨-v, ?_, ?_⟩ + · cases orientation <;> simp [UnitTriangularStep] at hv ⊢ <;> aesop + · rw [centroid_transform, centroid_transform] at he + have hx := congrArg Prod.fst he + have hy := congrArg Prod.snd he + dsimp [GaussianRealPoint] at hx hy ⊢ + norm_num at hx hy ⊢ + apply Prod.ext <;> dsimp <;> linarith [hx, hy] + · simp only [hc, ↓reduceIte] + have hfirst := (TileTouchingCovariance A B 0).2.1 + have hsecond := (TileTouchingCovariance (TileQuarterTurn A) + (TileQuarterTurn B) 0).2.1 + have hthird := (TileTouchingCovariance (TileHalfTurn A) + (TileHalfTurn B) u).1 + rw [touching_half_quarter A B] at hthird + simpa [transform] using (hfirst.trans hsecond |>.trans hthird) + +private theorem map_decompose : + (by + classical + exact + ∀ (u : GaussianInt), + let transform : ProtoTile → ProtoTile := + fun T => TileTranslation (TileHalfTurn T) u + ∀ xs, ∀ pre, ∀ x, ∀ post, xs.map transform = pre ++ x :: post → ∃ pre₀ y post₀, xs = pre₀ ++ + y :: post₀ ∧ pre = pre₀.map transform ∧ x = transform y ∧ post = post₀.map transform ) := by + classical + intro u transform xs + induction xs with + | nil => intro pre x post h; simp at h + | cons a xs ih => + intro pre x post h + cases pre with + | nil => + injection h with hx hp + exact ⟨[], a, xs, rfl, rfl, hx.symm, hp.symm⟩ + | cons p pre => + simp only [List.map_cons, List.cons_append] at h + injection h with hp hr + subst p + rcases ih pre x post hr with ⟨pre₀, y, post₀, hs, hpre, hx, hpost⟩ + refine ⟨a :: pre₀, y, post₀, ?_, ?_, hx, hpost⟩ + · simp [hs] + · simp [hpre] + +private theorem height_transform : + (by + classical + exact + ∀ (R : ProtoTile), ∀ (S : ProtoTile), ∀ (u : GaussianInt), + let transform : ProtoTile → ProtoTile := + fun T => TileTranslation (TileHalfTurn T) u + (∀ T : ProtoTile, TileCentroid (transform T) = (-(TileCentroid T).1 + (u.re : Real), + -(TileCentroid T).2 + (u.im : Real))) → (∀ T : ProtoTile, ((TileCentroid (transform T)).2 + - (TileCentroid (transform R)).2) * ((TileCentroid (transform S)).1 - (TileCentroid + (transform R)).1) - ((TileCentroid (transform T)).1 - (TileCentroid (transform R)).1) * + ((TileCentroid (transform S)).2 - (TileCentroid (transform R)).2) = ((TileCentroid T).2 - + (TileCentroid R).2) * ((TileCentroid S).1 - (TileCentroid R).1) - ((TileCentroid T).1 - + (TileCentroid R).1) * ((TileCentroid S).2 - (TileCentroid R).2)) ) := by + classical + intro R S u transform centroid_transform T + rw [centroid_transform, centroid_transform, centroid_transform] + ring + +end CentralStringProof + +theorem TileStringCentralCovariance + (C : BandCircle) (orientation : Bool) + (base R S : ProtoTile) (tiles : List ProtoTile) (u : GaussianInt) + (hstring : TileString C orientation base R S tiles) : + TileString C orientation + (TileTranslation (TileHalfTurn base) u) + (TileTranslation (TileHalfTurn R) u) + (TileTranslation (TileHalfTurn S) u) + (tiles.map (fun T => TileTranslation (TileHalfTurn T) u)) := by +-- BODY + unfold TileString at hstring ⊢ + let transform : ProtoTile → ProtoTile := + fun T => TileTranslation (TileHalfTurn T) u + change BandPrototile C.1.1 (transform base) ∧ _ + have centroid_transform : ∀ T : ProtoTile, + TileCentroid (transform T) = + (-(TileCentroid T).1 + (u.re : Real), + -(TileCentroid T).2 + (u.im : Real)) := by + intro T + dsimp [transform] + rw [(TileTranslationFormulas (TileHalfTurn T) u).2.2.2.2.1, + (TileHalfTurnFormulas T).2.2.2.2.2.2.2.1] + have footprint_transform : ∀ T : ProtoTile, + FootprintVertices (transform T) = + GaussianTranslation u '' ((fun x : GaussianInt => -x) '' + FootprintVertices T) := by + intro T + dsimp [transform] + rw [(TileTranslationFormulas (TileHalfTurn T) u).2.2.2.2.2.1, + (TileHalfTurnFormulas T).2.2.2.2.2.2.1] + have band_transform : ∀ (D : CircleCoordinates) (T : ProtoTile), + BandPrototile D T → BandPrototile D (transform T) := CentralStringProof.band_transform u + centroid_transform footprint_transform + have transform_translate : ∀ (T : ProtoTile) (v : GaussianInt), + transform (TileTranslation T v) = TileTranslation (transform T) (-v) := + CentralStringProof.transform_translate u + have transform_involutive : ∀ T : ProtoTile, transform (transform T) = T := + CentralStringProof.transform_involutive u transform_translate + have transform_injective : Function.Injective transform := by + intro A B hab + have := congrArg transform hab + simpa [transform_involutive] using this + have touch_same_cells : ∀ A B A' B' : ProtoTile, + A.cells = A'.cells → B.cells = B'.cells → + A.cells.Nonempty → B.cells.Nonempty → + (TileTouching A B ↔ TileTouching A' B') := CentralStringProof.touch_same_cells + have touch_same_left : ∀ A A' B : ProtoTile, + A.cells = A'.cells → A.cells.Nonempty → + (TileTouching A B ↔ TileTouching A' B) := CentralStringProof.touch_same_left + have touch_same_right : ∀ A B B' : ProtoTile, + B.cells = B'.cells → B.cells.Nonempty → + (TileTouching A B ↔ TileTouching A B') := CentralStringProof.touch_same_right + have half_nonempty : ∀ T : ProtoTile, T.cells.Nonempty → + (TileHalfTurn T).cells.Nonempty := by + intro T hT + rw [(TileHalfTurnFormulas T).1] + exact Finset.image_nonempty.mpr hT + have touching_half_quarter : ∀ A B : ProtoTile, + TileTouching (TileHalfTurn A) (TileHalfTurn B) ↔ + TileTouching (TileQuarterTurn (TileQuarterTurn A)) + (TileQuarterTurn (TileQuarterTurn B)) := CentralStringProof.touching_half_quarter + touch_same_cells touch_same_left touch_same_right half_nonempty + have adjacent_cov : ∀ A B : ProtoTile, + (if C.1.1.1 = 1 then + ∃ v : GaussianInt, + UnitTriangularStep orientation v ∧ + TileCentroid B - TileCentroid A = GaussianRealPoint v + else TileTouching A B) ↔ + (if C.1.1.1 = 1 then + ∃ v : GaussianInt, + UnitTriangularStep orientation v ∧ + TileCentroid (transform B) - TileCentroid (transform A) = + GaussianRealPoint v + else TileTouching (transform A) (transform B)) := CentralStringProof.adjacent_cov C + orientation base R S tiles u hstring centroid_transform touching_half_quarter + rcases hstring with ⟨hbase, hhead, hlast, hpair, hreg, hchain, hbelow⟩ + have map_decompose : ∀ xs pre x post, + xs.map transform = pre ++ x :: post → + ∃ pre₀ y post₀, xs = pre₀ ++ y :: post₀ ∧ + pre = pre₀.map transform ∧ x = transform y ∧ post = post₀.map transform := + CentralStringProof.map_decompose u + have height_transform : ∀ T : ProtoTile, + ((TileCentroid (transform T)).2 - (TileCentroid (transform R)).2) * + ((TileCentroid (transform S)).1 - (TileCentroid (transform R)).1) - + ((TileCentroid (transform T)).1 - (TileCentroid (transform R)).1) * + ((TileCentroid (transform S)).2 - (TileCentroid (transform R)).2) = + ((TileCentroid T).2 - (TileCentroid R).2) * + ((TileCentroid S).1 - (TileCentroid R).1) - + ((TileCentroid T).1 - (TileCentroid R).1) * + ((TileCentroid S).2 - (TileCentroid R).2) := CentralStringProof.height_transform R S u + centroid_transform + refine ⟨band_transform C.1.1 base hbase, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [List.head?_map, hhead] + rfl + · rw [List.getLast?_map, hlast] + rfl + · rw [List.pairwise_map] + exact hpair.imp (fun hab heq => hab (transform_injective heq)) + · intro V hV + rcases List.mem_map.mp hV with ⟨T, hT, rfl⟩ + rcases hreg T hT with ⟨v, hv, rfl⟩ + refine ⟨-v, (TilingLattice C).neg_mem hv, transform_translate base v⟩ + · revert hchain + clear hhead hlast hpair hreg hbelow hbase + induction tiles with + | nil => intro h; exact .nil + | cons first rest ih => + cases rest with + | nil => intro h; exact .singleton _ + | cons second tail => + intro h + cases h with + | cons_cons edge remaining => + exact .cons_cons (adjacent_cov first second |>.mp edge) (ih remaining) + · intro pre T post hsplit hpre hpost + rcases map_decompose tiles pre T post hsplit with + ⟨pre₀, V, post₀, hdecomp, hpreeq, hTeq, hposteq⟩ + have hpre₀ : pre₀ ≠ [] := by + intro hz + subst pre₀ + simp? at hpreeq + exact hpre hpreeq + have hpost₀ : post₀ ≠ [] := by + intro hz + subst post₀ + simp? at hposteq + exact hpost hposteq + rcases hbelow pre₀ V post₀ hdecomp hpre₀ hpost₀ with + ⟨hpos, W, hWreg, hVW, hWneg⟩ + refine ⟨?_, ?_⟩ + · rw [hTeq] + change 0 ≤ + ((TileCentroid (transform V)).2 - (TileCentroid (transform R)).2) * + ((TileCentroid (transform S)).1 - (TileCentroid (transform R)).1) - + ((TileCentroid (transform V)).1 - (TileCentroid (transform R)).1) * + ((TileCentroid (transform S)).2 - (TileCentroid (transform R)).2) + rw [height_transform V] + exact hpos + · rcases hWreg with ⟨v, hv, rfl⟩ + refine ⟨TileTranslation (transform base) (-v), ?_, ?_, ?_⟩ + · exact ⟨-v, (TilingLattice C).neg_mem hv, rfl⟩ + · simpa [hTeq, transform_translate base v] using + (adjacent_cov V (TileTranslation base v)).mp hVW + · rw [← transform_translate base v] + change + ((TileCentroid (transform (TileTranslation base v))).2 - + (TileCentroid (transform R)).2) * + ((TileCentroid (transform S)).1 - (TileCentroid (transform R)).1) - + ((TileCentroid (transform (TileTranslation base v))).1 - + (TileCentroid (transform R)).1) * + ((TileCentroid (transform S)).2 - (TileCentroid (transform R)).2) < 0 + rw [height_transform (TileTranslation base v)] + exact hWneg + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean b/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean new file mode 100644 index 0000000000..dcc496c921 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean @@ -0,0 +1,896 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AffineTriangularStrip +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification +public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.RegularTileFamilyTranslationUnique +public import LeanPool.ApollonianSuperharmonic.TileString +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis +public import LeanPool.ApollonianSuperharmonic.VectorDeterminant +public import Mathlib.Data.List.Forall2 +public import Mathlib.Data.List.Nodup + +-- [TABLET NODE: TileStringCoordinateTransport] + +/-! +# TileStringCoordinateTransport + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace StringCoordinateGeometry + +private theorem chart : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∃ a b : GaussianInt, 0 < a.re * b.im - a.im * + b.re ∧ a ∈ TilingLattice C ∧ b ∈ TilingLattice C ∧ (∀ w : TilingLattice C, ∃! z : Int + × Int, (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b = (w : GaussianInt)) ∧ + ((C.1.1.1 = 1 ∧ ((orientation = true ∧ a = 1 ∧ b = ⟨0, 1⟩) ∨ (orientation = false ∧ a + = ⟨0, 1⟩ ∧ b = -1))) ∨ (1 < C.1.1.1 ∧ ∃ q : Fin 4 → CircleCoordinates, + ProperBandQuadruple q ∧ q 0 = C.1.1 ∧ ((a = BandVectors.1 (q 1) (q 0) ∧ b = + BandVectors.1 (q 2) (q 0)) ∨ (a = BandVectors.1 (q 2) (q 0) ∧ b = BandVectors.1 (q 1) + (q 0))))) ) := by + classical + intro C orientation + by_cases hc : C.1.1.1 = 1 + · let a : GaussianInt := if orientation then 1 else ⟨0, 1⟩ + let b : GaussianInt := if orientation then ⟨0, 1⟩ else -1 + have hdet : a.re * b.im - a.im * b.re = 1 := by + cases orientation <;> simp [a, b] + refine ⟨a, b, by omega, by simp [TilingLattice, hc], + by simp [TilingLattice, hc], ?_, Or.inl ⟨hc, ?_⟩⟩ + · intro w + cases ho : orientation + · refine ⟨((w : GaussianInt).im, -(w : GaussianInt).re), ?_, ?_⟩ + · apply Zsqrtd.ext <;> simp [a, b, ho] + · intro z hz + have hr := congrArg Zsqrtd.re hz + have hi := congrArg Zsqrtd.im hz + simp [a, b, ho] at hr hi + exact Prod.ext (by omega) (by omega) + · refine ⟨((w : GaussianInt).re, (w : GaussianInt).im), ?_, ?_⟩ + · apply Zsqrtd.ext <;> simp [a, b, ho] + · intro z hz + have hr := congrArg Zsqrtd.re hz + have hi := congrArg Zsqrtd.im hz + simp? [a, b, ho] at hr hi + exact Prod.ext hr hi + · cases ho : orientation <;> simp [a, b, ho] + · obtain ⟨q, hsemi, hqC, hsmall, _⟩ := Or.resolve_left (BandGenealogy C) hc + have hq : ProperBandQuadruple q := ⟨hsemi, by simpa [hqC] using hsmall⟩ + let a0 := BandVectors.1 (q 1) (q 0) + let b0 := BandVectors.1 (q 2) (q 0) + let d0 := BandVectors.1 (q 3) (q 0) + have hbasis := TilingLatticeBasis C q hq hqC + have hsum : a0 + b0 + d0 = 0 := by + simpa [a0, b0, d0, Fin.sum_univ_succ, add_assoc] using + (IncomingSuperbasisRelation q hq).1 + let successorQuad : Fin 4 → CircleCoordinates := + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), q 0, q 2, q 3] + have hsuccessor : SemiProperQuadruple successorQuad := by + simpa [successorQuad] using SemiProperQuadruple.successor hsemi + have hdet32 : Int.natAbs (d0.re * b0.im - d0.im * b0.re) = C.1.1.1.natAbs := by + simpa [successorQuad, d0, b0, hqC] using + (VectorDeterminant successorQuad hsuccessor + (by simpa [successorQuad, hqC] using C.2)).2 + have hdetneg : d0.re * b0.im - d0.im * b0.re = + -(a0.re * b0.im - a0.im * b0.re) := by + have hr := congrArg Zsqrtd.re hsum + have hi := congrArg Zsqrtd.im hsum + change a0.re + b0.re + d0.re = 0 at hr + change a0.im + b0.im + d0.im = 0 at hi + rw [show d0.re = -(a0.re + b0.re) by omega, + show d0.im = -(a0.im + b0.im) by omega] + ring + have hdetnz : a0.re * b0.im - a0.im * b0.re ≠ 0 := by + intro hz + rw [hdetneg, hz] at hdet32 + have habs := Int.natAbs_pos.mpr C.2.ne' + simp at hdet32 + omega + have hcgt : 1 < C.1.1.1 := by have hp := C.2; omega + by_cases hpositive : 0 < a0.re * b0.im - a0.im * b0.re + · exact ⟨a0, b0, hpositive, hbasis.1, hbasis.2.1, hbasis.2.2.1, + Or.inr ⟨hcgt, q, hq, hqC, Or.inl ⟨rfl, rfl⟩⟩⟩ + · have hpositive' : 0 < b0.re * a0.im - b0.im * a0.re := by + have he : b0.re * a0.im - b0.im * a0.re = + -(a0.re * b0.im - a0.im * b0.re) := by ring + rw [he] + omega + refine ⟨b0, a0, hpositive', hbasis.2.1, hbasis.1, ?_, + Or.inr ⟨hcgt, q, hq, hqC, Or.inr ⟨rfl, rfl⟩⟩⟩ + intro w + obtain ⟨z, hz, hzu⟩ := hbasis.2.2.1 w + refine ⟨(z.2, z.1), by simpa [a0, b0, add_comm] using hz, ?_⟩ + intro y hy + have heq := hzu (y.2, y.1) (by simpa [a0, b0, add_comm] using hy) + exact Prod.ext (congrArg Prod.snd heq) (congrArg Prod.fst heq) + +private theorem index_mem : + (by + classical + exact + ∀ (C : BandCircle), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ TilingLattice C) → ((b + ∈ TilingLattice C) → ( + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + ∀ (z : Int × Int), index z ∈ TilingLattice C)) ) := by + classical + intro C a b ha hb index z + apply (TilingLattice C).add_mem + · simpa [zsmul_eq_mul] using (TilingLattice C).zsmul_mem ha z.1 + · simpa [zsmul_eq_mul] using (TilingLattice C).zsmul_mem hb z.2 + +private theorem index_inj : + (by + classical + exact + ∀ (C : BandCircle), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (∀ (w : ↥(TilingLattice + C)), ∃! z : ℤ × ℤ, (↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b = (↑w : + GaussianInt)) → ( + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + (∀ (z : Int × Int), index z ∈ TilingLattice C) → (Function.Injective index)) ) := by + classical + intro C a b hcoord index index_mem x y hxy + obtain ⟨z, hz, hu⟩ := hcoord ⟨index y, index_mem y⟩ + exact (hu x hxy).trans (hu y rfl).symm + +private theorem translation_inj : + (by + classical + exact + ∀ (base : ProtoTile), Function.Injective (TileTranslation base) ) := by + classical + intro base x y hxy + have h := congrArg ProtoTile.anchor hxy + change base.anchor + x = base.anchor + y at h + exact add_left_cancel h + +private theorem family : + (by + classical + exact + ∀ (C : BandCircle), ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (∀ (w + : ↥(TilingLattice C)), ∃! z : ℤ × ℤ, (↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) + * b = (↑w : GaussianInt)) → ( + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + (∀ (z : Int × Int), index z ∈ TilingLattice C) → ((Function.Injective (TileTranslation + base)) → (∀ (U : ProtoTile), U ∈ RegularTileFamily base (TilingLattice C) ↔ ∃! z : + Int × Int, U = tileAt z))) ) := by + classical + intro C base a b hcoord index tileAt index_mem translation_inj U + constructor + · rintro ⟨u, hu, rfl⟩ + obtain ⟨z, hz, hzu⟩ := hcoord ⟨u, hu⟩ + refine ⟨z, (congrArg (TileTranslation base) hz).symm, ?_⟩ + intro y hy + exact hzu y (translation_inj hy.symm) + · rintro ⟨z, hz, _⟩ + exact ⟨index z, index_mem z, hz⟩ + +private theorem point_inj : + (by + classical + exact + Function.Injective GaussianRealPoint ) := by + classical + intro x y hxy + apply Zsqrtd.ext + · have h := congrArg Prod.fst hxy + dsimp [GaussianRealPoint] at h + exact_mod_cast h + · have h := congrArg Prod.snd hxy + dsimp [GaussianRealPoint] at h + exact_mod_cast h + +private theorem index_sub : + (by + classical + exact + ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + ∀ (x : Int × Int), ∀ (y : Int × Int), index (y - x) = index y - index x ) := by + classical + intro a b index x y + dsimp [index, Prod.sub_def] + push_cast + ring + +private theorem difference : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + (∀ (z : Int × Int), TileCentroid (tileAt z) = ((TileCentroid base).1 + ((index z).re : + Int), (TileCentroid base).2 + ((index z).im : Int))) → ((∀ (x : Int × Int), ∀ (y : + Int × Int), index (y - x) = index y - index x) → (∀ (x : Int × Int), ∀ (y : Int × + Int), TileCentroid (tileAt y) - TileCentroid (tileAt x) = GaussianRealPoint (index (y + - x)))) ) := by + classical + intro base a b index tileAt centroid index_sub x y + rw [centroid, centroid, index_sub] + ext <;> simp [GaussianRealPoint] + +private theorem adj : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), (BandPrototile C.1.1 + base) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), ((0 : ℤ) < a.re * b.im - a.im * + b.re) → ((a ∈ TilingLattice C) → ((b ∈ TilingLattice C) → ((∀ (w : ↥(TilingLattice + C)), ∃! z : ℤ × ℤ, (↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b = (↑w : + GaussianInt)) → ((C.1.1.1 = (1 : ℤ) ∧ (orientation = true ∧ a = (1 : GaussianInt) ∧ b + = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ orientation = false ∧ a = (⟨(0 : ℤ), (1 : ℤ)⟩ + : GaussianInt) ∧ b = (-1 : GaussianInt)) ∨ (1 : ℤ) < C.1.1.1 ∧ ∃ (q : Fin (4 : ℕ) → + CircleCoordinates), ProperBandQuadruple q ∧ q (0 : Fin (4 : ℕ)) = C.1.1 ∧ (a = + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) ∧ b = BandVectors.1 (q (2 : + Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) ∨ a = BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : + Fin (4 : ℕ))) ∧ b = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))))) → ( + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + let adjacent := fun T U : ProtoTile => + if C.1.1.1 = 1 then + ∃ v : GaussianInt, UnitTriangularStep orientation v ∧ + TileCentroid U - TileCentroid T = GaussianRealPoint v + else TileTouching T U + (∀ (z : Int × Int), index z ∈ TilingLattice C) → ((Function.Injective index) → + ((Function.Injective tileAt) → ((∀ (U : ProtoTile), U ∈ RegularTileFamily base + (TilingLattice C) ↔ ∃! z : Int × Int, U = tileAt z) → ((∀ (z : Int × Int), tileAt z ∈ + RegularTileFamily base (TilingLattice C)) → ((Function.Injective GaussianRealPoint) → + ((∀ (z : Int × Int), TileCentroid (tileAt z) = ((TileCentroid base).1 + ((index z).re + : Int), (TileCentroid base).2 + ((index z).im : Int))) → ((∀ (x : Int × Int), ∀ (y : + Int × Int), index (y - x) = index y - index x) → ((∀ (x : Int × Int), ∀ (y : Int × + Int), TileCentroid (tileAt y) - TileCentroid (tileAt x) = GaussianRealPoint (index (y + - x))) → (∀ (x : Int × Int), ∀ (y : Int × Int), adjacent (tileAt x) (tileAt y) ↔ + TriangularLatticeAdjacent x y))))))))))))))) ) := by + classical + intro C orientation base hbase a b hdet ha hb hcoord hsource index tileAt adjacent index_mem + index_inj tile_inj family tile_mem point_inj centroid index_sub difference x y + rw [show adjacent (tileAt x) (tileAt y) = + (if C.1.1.1 = 1 then ∃ v : GaussianInt, UnitTriangularStep orientation v ∧ + TileCentroid (tileAt y) - TileCentroid (tileAt x) = GaussianRealPoint v + else TileTouching (tileAt x) (tileAt y)) from rfl] + rcases hsource with ⟨hc, hs⟩ | ⟨hc, q, hq, hqC, hs⟩ + · rw [ite_eq_left hc, difference] + rcases hs with ⟨ho, rfl, rfl⟩ | ⟨ho, rfl, rfl⟩ <;> + simp [index, UnitTriangularStep, GaussianRealPoint, ho] + all_goals simp only [TriangularLatticeAdjacent, Prod.sub_def, Prod.mk.injEq] + all_goals norm_cast + all_goals omega + · rw [ite_eq_right (by omega)] + rw [BandRegularTileTouchingClassification C q hq hqC base + (by simpa [hqC] using hbase) (tileAt x) (tileAt y) (tile_mem x) (tile_mem y)] + have hsum := (IncomingSuperbasisRelation q hq).1 + have hd : BandVectors.1 (q 3) (q 0) = -(a + b) := by + simp only [Fin.sum_univ_succ] at hsum + rcases hs with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ <;> dsimp at hsum ⊢ <;> linear_combination hsum + have hneg (v : GaussianInt) : -GaussianRealPoint v = GaussianRealPoint (-v) := by + ext <;> simp [GaussianRealPoint] + have heq (z : Int × Int) : + (TileCentroid (tileAt y) - TileCentroid (tileAt x) = GaussianRealPoint (index z)) ↔ + y - x = z := by + rw [difference, point_inj.eq_iff, index_inj.eq_iff] + have hsteps : (∃ j : Fin 3, + TileCentroid (tileAt y) - TileCentroid (tileAt x) = + GaussianRealPoint (BandVectors.1 (q j.succ) (q 0)) ∨ + TileCentroid (tileAt y) - TileCentroid (tileAt x) = + -GaussianRealPoint (BandVectors.1 (q j.succ) (q 0))) ↔ + (TileCentroid (tileAt y) - TileCentroid (tileAt x) = GaussianRealPoint a ∨ + TileCentroid (tileAt y) - TileCentroid (tileAt x) = GaussianRealPoint b ∨ + TileCentroid (tileAt y) - TileCentroid (tileAt x) = GaussianRealPoint (-(a + b)) ∨ + TileCentroid (tileAt y) - TileCentroid (tileAt x) = GaussianRealPoint (-a) ∨ + TileCentroid (tileAt y) - TileCentroid (tileAt x) = GaussianRealPoint (-b) ∨ + TileCentroid (tileAt y) - TileCentroid (tileAt x) = GaussianRealPoint (a + b)) := by + simp only [Fin.exists_fin_succ, hneg] + rcases hs with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ <;> simp [hd] <;> tauto + rw [hsteps] + have h1 : index (1, 0) = a := by simp [index] + have h2 : index (0, 1) = b := by simp [index] + have h3 : index (-1, -1) = -(a + b) := by simp [index, neg_add_rev, add_comm] + have h4 : index (-1, 0) = -a := by simp [index] + have h5 : index (0, -1) = -b := by simp [index] + have h6 : index (1, 1) = a + b := by simp [index] + rw [← h3, ← h4, ← h5, ← h6, ← h1, ← h2] + simp only [heq, TriangularLatticeAdjacent] + +private theorem height : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + (∀ (z : Int × Int), TileCentroid (tileAt z) = ((TileCentroid base).1 + ((index z).re : + Int), (TileCentroid base).2 + ((index z).im : Int))) → (∀ (x : Int × Int), ∀ (y : Int + × Int), ∀ (z : Int × Int), ((TileCentroid (tileAt z)).2 - (TileCentroid (tileAt + x)).2) * ((TileCentroid (tileAt y)).1 - (TileCentroid (tileAt x)).1) - ((TileCentroid + (tileAt z)).1 - (TileCentroid (tileAt x)).1) * ((TileCentroid (tileAt y)).2 - + (TileCentroid (tileAt x)).2) = ((a.re * b.im - a.im * b.re : Int) : Real) * + TriangularSignedHeight x y z) ) := by + classical + intro base a b index tileAt centroid x y z + rw [centroid, centroid, centroid] + simp [index, TriangularSignedHeight] + ring + +private theorem map_occurrence : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + ∀ (xs : List (Int × Int)), ∀ (pre : List ProtoTile), ∀ (T : ProtoTile), ∀ (post : List + ProtoTile), (xs.map tileAt = pre ++ T :: post) → (∃ left z right, xs = left ++ z :: + right ∧ pre = left.map tileAt ∧ T = tileAt z ∧ post = right.map tileAt) ) := by + classical + intro base a b index tileAt xs pre T post h + induction pre generalizing xs with + | nil => + cases xs with + | nil => simp at h + | cons z rest => + have hh : tileAt z = T ∧ rest.map tileAt = post := by simpa using h + exact ⟨[], z, rest, rfl, rfl, hh.1.symm, hh.2.symm⟩ + | cons U pre ih => + cases xs with + | nil => simp at h + | cons z rest => + have hh : tileAt z = U ∧ rest.map tileAt = pre ++ T :: post := by + simpa using h + obtain ⟨left, x, right, hx, hp, ht, hs⟩ := ih rest hh.2 + exact ⟨z :: left, x, right, by simp [hx], + by simp [hp, hh.1], ht, hs⟩ + +private theorem map_interior : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + (∀ (xs : List (Int × Int)), ∀ (pre : List ProtoTile), ∀ (T : ProtoTile), ∀ (post : List + ProtoTile), (xs.map tileAt = pre ++ T :: post) → (∃ left z right, xs = left ++ z :: + right ∧ pre = left.map tileAt ∧ T = tileAt z ∧ post = right.map tileAt)) → (∀ (P : + ProtoTile → Prop), ∀ (xs : List (Int × Int)), (∀ pre, ∀ T, ∀ post, xs.map tileAt = + pre ++ T :: post → pre ≠ [] → post ≠ [] → P T) ↔ (∀ pre, ∀ z, ∀ post, xs = pre ++ z + :: post → pre ≠ [] → post ≠ [] → P (tileAt z))) ) := by + classical + intro base a b index tileAt map_occurrence P xs + constructor + · intro h pre z post he hp ht + apply h (pre.map tileAt) (tileAt z) (post.map tileAt) + · simp [he] + · simpa using hp + · simpa using ht + · intro h pre T post he hp ht + obtain ⟨left, z, right, hx, hl, hz, hr⟩ := map_occurrence xs pre T post he + rw [hz] + apply h left z right hx + · intro hn + simp [hl, hn] at hp + · intro hn + simp [hr, hn] at ht + +private theorem internal_strip : + (by + classical + exact + (GaussianInt) → ((GaussianInt) → (∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), ∀ (xs : List (Int × + Int)), TriangularStripSegment r s xs ↔ xs.head? = some r ∧ xs.getLast? = some s ∧ + xs.Nodup ∧ xs.IsChain TriangularLatticeAdjacent ∧ (∀ pre, ∀ z, ∀ post, xs = pre ++ z + :: post → pre ≠ [] → post ≠ [] → 0 ≤ TriangularSignedHeight r s z ∧ ∃ u, + TriangularLatticeAdjacent z u ∧ TriangularSignedHeight r s u < 0))) ) := by + classical + intro a b r s xs + by_cases hrs : r = s + · subst s + constructor + · intro h + have hx : xs = [r] := by simpa [TriangularStripSegment] using h + subst xs + refine ⟨by simp, by simp, by simp, List.isChain_singleton r, ?_⟩ + intro pre z post he hp ht + have hl := congrArg List.length he + simp at hl + have hpl : 0 < pre.length := by + cases pre with + | nil => simp at hp + | cons a tail => simp + have htl : 0 < post.length := by + cases post with + | nil => simp at ht + | cons a tail => simp + omega + · rintro ⟨hh, ht, hn, hc, hi⟩ + have hne : xs ≠ [] := by intro he; simp [he] at hh + have hhead : xs.head hne = r := by + simpa only [List.head?_eq_some_head hne, Option.some.injEq] using hh + have hlast : xs.getLast hne = r := by + simpa only [List.getLast?_eq_some_getLast hne, Option.some.injEq] using ht + obtain ⟨z, hz⟩ := (List.Nodup.head_eq_getLast_iff hne hn).mp + (hhead.trans hlast.symm) + have hzr : z = r := by simpa [hz] using hh + simp [TriangularStripSegment, hz, hzr] + · obtain ⟨hM, hcross, _⟩ := AffineTriangularStrip.2 r s hrs + constructor + · intro h + simp only [TriangularStripSegment, ite_eq_right hrs] at h + refine ⟨h.1, h.2.1, h.2.2.1, h.2.2.2.2, ?_⟩ + intro pre z post he hp ht + apply (hcross z).mpr + exact h.2.2.2.1 z (by simp [he]) + · rintro ⟨hh, ht, hn, hc, hi⟩ + simp only [TriangularStripSegment, ite_eq_right hrs] + refine ⟨hh, ht, hn, ?_, hc⟩ + intro z hz + obtain ⟨pre, post, he⟩ := List.mem_iff_append.mp hz + by_cases hp : pre = [] + · have hzr : z = r := by simpa [he, hp] using hh + subst z + simpa [TriangularBoundaryStrip, TriangularSignedHeight] using hM + by_cases ht' : post = [] + · have hzs : z = s := by simpa [he, ht'] using ht + subst z + simpa [TriangularBoundaryStrip, TriangularSignedHeight, mul_comm] using hM + exact (hcross z).mp (hi pre z post he hp ht') + +private theorem nonnegative : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + (∀ (x : Int × Int), ∀ (y : Int × Int), ∀ (z : Int × Int), ((TileCentroid (tileAt z)).2 - + (TileCentroid (tileAt x)).2) * ((TileCentroid (tileAt y)).1 - (TileCentroid (tileAt + x)).1) - ((TileCentroid (tileAt z)).1 - (TileCentroid (tileAt x)).1) * ((TileCentroid + (tileAt y)).2 - (TileCentroid (tileAt x)).2) = ((a.re * b.im - a.im * b.re : Int) : + Real) * TriangularSignedHeight x y z) → (∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), + let physical := fun T : ProtoTile => + ((TileCentroid T).2 - (TileCentroid (tileAt r)).2) * + ((TileCentroid (tileAt s)).1 - (TileCentroid (tileAt r)).1) - + ((TileCentroid T).1 - (TileCentroid (tileAt r)).1) * + ((TileCentroid (tileAt s)).2 - (TileCentroid (tileAt r)).2) + ((0 : Real) < ((a.re * b.im - a.im * b.re : Int) : Real)) → (∀ (z : Int × Int), 0 ≤ + physical (tileAt z) ↔ 0 ≤ TriangularSignedHeight r s z)) ) := by + classical + intro base a b index tileAt height r s physical hdetReal z + dsimp only [physical] + rw [height, mul_nonneg_iff_of_pos_left hdetReal] + norm_cast + +private theorem negative : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + ∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), + let physical := fun T : ProtoTile => + ((TileCentroid T).2 - (TileCentroid (tileAt r)).2) * + ((TileCentroid (tileAt s)).1 - (TileCentroid (tileAt r)).1) - + ((TileCentroid T).1 - (TileCentroid (tileAt r)).1) * + ((TileCentroid (tileAt s)).2 - (TileCentroid (tileAt r)).2) + (∀ (z : Int × Int), 0 ≤ physical (tileAt z) ↔ 0 ≤ TriangularSignedHeight r s z) → (∀ (z : + Int × Int), physical (tileAt z) < 0 ↔ TriangularSignedHeight r s z < 0) ) := by + classical + intro base a b index tileAt r s physical nonnegative z + rw [← not_le, ← not_le, nonnegative] + +private theorem interior_point : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ + (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + let adjacent := fun T U : ProtoTile => + if C.1.1.1 = 1 then + ∃ v : GaussianInt, UnitTriangularStep orientation v ∧ + TileCentroid U - TileCentroid T = GaussianRealPoint v + else TileTouching T U + (∀ (U : ProtoTile), U ∈ RegularTileFamily base (TilingLattice C) ↔ ∃! z : Int × Int, U = + tileAt z) → ((∀ (z : Int × Int), tileAt z ∈ RegularTileFamily base (TilingLattice C)) + → ((∀ (x : Int × Int), ∀ (y : Int × Int), adjacent (tileAt x) (tileAt y) ↔ + TriangularLatticeAdjacent x y) → (∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), + let physical := fun T : ProtoTile => + ((TileCentroid T).2 - (TileCentroid (tileAt r)).2) * + ((TileCentroid (tileAt s)).1 - (TileCentroid (tileAt r)).1) - + ((TileCentroid T).1 - (TileCentroid (tileAt r)).1) * + ((TileCentroid (tileAt s)).2 - (TileCentroid (tileAt r)).2) + (∀ (z : Int × Int), 0 ≤ physical (tileAt z) ↔ 0 ≤ TriangularSignedHeight r s z) → ((∀ (z + : Int × Int), physical (tileAt z) < 0 ↔ TriangularSignedHeight r s z < 0) → (∀ (z : + Int × Int), (0 ≤ physical (tileAt z) ∧ ∃ U ∈ RegularTileFamily base (TilingLattice + C), adjacent (tileAt z) U ∧ physical U < 0) ↔ (0 ≤ TriangularSignedHeight r s z ∧ ∃ + u, TriangularLatticeAdjacent z u ∧ TriangularSignedHeight r s u < 0)))))) ) := by + classical + intro C orientation base a b index tileAt adjacent family tile_mem adj r s physical nonnegative + negative z + rw [nonnegative] + constructor + · rintro ⟨hz, U, hU, hzu, hneg⟩ + obtain ⟨u, rfl, _⟩ := (family U).mp hU + exact ⟨hz, u, (adj z u).mp hzu, (negative u).mp hneg⟩ + · rintro ⟨hz, u, hzu, hneg⟩ + exact ⟨hz, tileAt u, tile_mem u, (adj z u).mpr hzu, (negative u).mpr hneg⟩ + +private theorem head_iff : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + (Function.Injective tileAt) → (∀ (r : ℤ × ℤ), ∀ (xs : List (Int × Int)), (xs.map + tileAt).head? = some (tileAt r) ↔ xs.head? = some r) ) := by + classical + intro base a b index tileAt tile_inj r xs + rw [List.head?_map] + simpa only [Option.map_some] using + (Option.map_injective tile_inj).eq_iff (a := xs.head?) (b := some r) + +private theorem last_iff : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + (Function.Injective tileAt) → (∀ (s : ℤ × ℤ), ∀ (xs : List (Int × Int)), (xs.map + tileAt).getLast? = some (tileAt s) ↔ xs.getLast? = some s) ) := by + classical + intro base a b index tileAt tile_inj s xs + rw [List.getLast?_map] + simpa only [Option.map_some] using + (Option.map_injective tile_inj).eq_iff (a := xs.getLast?) (b := some s) + +private theorem distinct_iff : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + (Function.Injective tileAt) → (∀ (xs : List (Int × Int)), (xs.map tileAt).Pairwise (fun T + U => T ≠ U) ↔ xs.Nodup) ) := by + classical + intro base a b index tileAt tile_inj xs + simp only [List.pairwise_map, ne_eq, tile_inj.eq_iff, ← List.nodup_iff_pairwise_ne] + +private theorem chain_iff : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ + (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + let adjacent := fun T U : ProtoTile => + if C.1.1.1 = 1 then + ∃ v : GaussianInt, UnitTriangularStep orientation v ∧ + TileCentroid U - TileCentroid T = GaussianRealPoint v + else TileTouching T U + (∀ (x : Int × Int), ∀ (y : Int × Int), adjacent (tileAt x) (tileAt y) ↔ + TriangularLatticeAdjacent x y) → (∀ (xs : List (Int × Int)), (xs.map tileAt).IsChain + adjacent ↔ xs.IsChain TriangularLatticeAdjacent) ) := by + classical + intro C orientation base a b index tileAt adjacent adj xs + simp only [List.isChain_map, adj] + +private theorem map_family : + (by + classical + exact + ∀ (C : BandCircle), ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + (∀ (z : Int × Int), tileAt z ∈ RegularTileFamily base (TilingLattice C)) → (∀ (xs : List + (Int × Int)), ∀ T ∈ xs.map tileAt, T ∈ RegularTileFamily base (TilingLattice C)) ) := by + classical + intro C base a b index tileAt tile_mem xs T hT + obtain ⟨z, hz, rfl⟩ := List.mem_map.mp hT + exact tile_mem z + +private theorem mapped_string : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), (BandPrototile C.1.1 + base) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + let adjacent := fun T U : ProtoTile => + if C.1.1.1 = 1 then + ∃ v : GaussianInt, UnitTriangularStep orientation v ∧ + TileCentroid U - TileCentroid T = GaussianRealPoint v + else TileTouching T U + ∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), (∀ (P : ProtoTile → Prop), ∀ (xs : List (Int × Int)), (∀ + pre, ∀ T, ∀ post, xs.map tileAt = pre ++ T :: post → pre ≠ [] → post ≠ [] → P T) ↔ (∀ + pre, ∀ z, ∀ post, xs = pre ++ z :: post → pre ≠ [] → post ≠ [] → P (tileAt z))) → ((∀ + (xs : List (Int × Int)), TriangularStripSegment r s xs ↔ xs.head? = some r ∧ + xs.getLast? = some s ∧ xs.Nodup ∧ xs.IsChain TriangularLatticeAdjacent ∧ (∀ pre, ∀ z, + ∀ post, xs = pre ++ z :: post → pre ≠ [] → post ≠ [] → 0 ≤ TriangularSignedHeight r s + z ∧ ∃ u, TriangularLatticeAdjacent z u ∧ TriangularSignedHeight r s u < 0)) → ( + let physical := fun T : ProtoTile => + ((TileCentroid T).2 - (TileCentroid (tileAt r)).2) * + ((TileCentroid (tileAt s)).1 - (TileCentroid (tileAt r)).1) - + ((TileCentroid T).1 - (TileCentroid (tileAt r)).1) * + ((TileCentroid (tileAt s)).2 - (TileCentroid (tileAt r)).2) + (∀ (z : Int × Int), (0 ≤ physical (tileAt z) ∧ ∃ U ∈ RegularTileFamily base + (TilingLattice C), adjacent (tileAt z) U ∧ physical U < 0) ↔ (0 ≤ + TriangularSignedHeight r s z ∧ ∃ u, TriangularLatticeAdjacent z u ∧ + TriangularSignedHeight r s u < 0)) → ((∀ (xs : List (Int × Int)), (xs.map + tileAt).head? = some (tileAt r) ↔ xs.head? = some r) → ((∀ (xs : List (Int × Int)), + (xs.map tileAt).getLast? = some (tileAt s) ↔ xs.getLast? = some s) → ((∀ (xs : List + (Int × Int)), (xs.map tileAt).Pairwise (fun T U => T ≠ U) ↔ xs.Nodup) → ((∀ (xs : + List (Int × Int)), (xs.map tileAt).IsChain adjacent ↔ xs.IsChain + TriangularLatticeAdjacent) → ((∀ (xs : List (Int × Int)), ∀ T ∈ xs.map tileAt, T ∈ + RegularTileFamily base (TilingLattice C)) → (∀ (xs : List (Int × Int)), TileString C + orientation base (tileAt r) (tileAt s) (xs.map tileAt) ↔ TriangularStripSegment r s + xs))))))))) ) := by + classical + intro C orientation base hbase a b index tileAt adjacent r s map_interior internal_strip + physical interior_point head_iff last_iff distinct_iff chain_iff map_family xs + rw [internal_strip] + change (BandPrototile C.1.1 base ∧ + (xs.map tileAt).head? = some (tileAt r) ∧ + (xs.map tileAt).getLast? = some (tileAt s) ∧ + (xs.map tileAt).Pairwise (fun T U => T ≠ U) ∧ + (∀ T ∈ xs.map tileAt, T ∈ RegularTileFamily base (TilingLattice C)) ∧ + (xs.map tileAt).IsChain adjacent ∧ + ∀ pre T post, xs.map tileAt = pre ++ T :: post → pre ≠ [] → post ≠ [] → + 0 ≤ physical T ∧ ∃ U ∈ RegularTileFamily base (TilingLattice C), + adjacent T U ∧ physical U < 0) ↔ _ + rw [head_iff, last_iff, distinct_iff, chain_iff, map_interior] + simp only [hbase, true_and, interior_point] + constructor + · rintro ⟨hh, hl, hn, hf, hc, hi⟩ + exact ⟨hh, hl, hn, hc, hi⟩ + · rintro ⟨hh, hl, hn, hc, hi⟩ + exact ⟨hh, hl, hn, map_family xs, hc, hi⟩ + +private theorem decode : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + ∀ (ys : List ProtoTile), ∀ (zs : List (Int × Int)), List.Forall₂ (fun T z => T = tileAt + z) ys zs ↔ ys = zs.map tileAt ) := by + classical + intro base a b index tileAt ys zs + rw [← List.forall₂_map_right_iff, List.forall₂_eq_eq_eq] + +private theorem map_decode : + (by + classical + exact + ∀ (C : BandCircle), ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + (∀ (U : ProtoTile), U ∈ RegularTileFamily base (TilingLattice C) ↔ ∃! z : Int × Int, U = + tileAt z) → (∀ (ys : List ProtoTile), (∀ T ∈ ys, T ∈ RegularTileFamily base + (TilingLattice C)) → (∃ xs : List (Int × Int), ys = xs.map tileAt)) ) := by + classical + intro C base a b index tileAt family ys hy + induction ys with + | nil => exact ⟨[], rfl⟩ + | cons T rest ih => + obtain ⟨z, hz, _⟩ := (family T).mp (hy T (by simp)) + obtain ⟨zs, hzs⟩ := ih (fun U hU => hy U (by simp [hU])) + exact ⟨z :: zs, by simp [hz, hzs]⟩ + +end StringCoordinateGeometry + +theorem TileStringCoordinateTransport (C : BandCircle) (orientation : Bool) + (base : ProtoTile) + (hbase : BandPrototile C.1.1 base) : + ∃ a b : GaussianInt, + 0 < a.re * b.im - a.im * b.re ∧ + a ∈ TilingLattice C ∧ b ∈ TilingLattice C ∧ + (∀ w : TilingLattice C, ∃! z : Int × Int, + (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b = + (w : GaussianInt)) ∧ + ((C.1.1.1 = 1 ∧ + ((orientation = true ∧ a = 1 ∧ b = ⟨0, 1⟩) ∨ + (orientation = false ∧ a = ⟨0, 1⟩ ∧ b = -1))) ∨ + (1 < C.1.1.1 ∧ + ∃ q : Fin 4 → CircleCoordinates, + ProperBandQuadruple q ∧ q 0 = C.1.1 ∧ + ((a = BandVectors.1 (q 1) (q 0) ∧ + b = BandVectors.1 (q 2) (q 0)) ∨ + (a = BandVectors.1 (q 2) (q 0) ∧ + b = BandVectors.1 (q 1) (q 0))))) ∧ + let tileAt := fun z : Int × Int => + TileTranslation base + ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + let tileAdjacent := fun T U : ProtoTile => + if C.1.1.1 = 1 then + ∃ v : GaussianInt, + UnitTriangularStep orientation v ∧ + TileCentroid U - TileCentroid T = GaussianRealPoint v + else TileTouching T U + (∀ U : ProtoTile, + U ∈ RegularTileFamily base (TilingLattice C) ↔ + ∃! z : Int × Int, U = tileAt z) ∧ + (∀ x y : Int × Int, + tileAdjacent (tileAt x) (tileAt y) ↔ + TriangularLatticeAdjacent x y) ∧ + (∀ x y z : Int × Int, + ((TileCentroid (tileAt z)).2 - (TileCentroid (tileAt x)).2) * + ((TileCentroid (tileAt y)).1 - (TileCentroid (tileAt x)).1) - + ((TileCentroid (tileAt z)).1 - (TileCentroid (tileAt x)).1) * + ((TileCentroid (tileAt y)).2 - (TileCentroid (tileAt x)).2) = + ((a.re * b.im - a.im * b.re : Int) : Real) * + TriangularSignedHeight x y z) ∧ + ∀ (R S : ProtoTile) (tiles : List ProtoTile) (r s : Int × Int), + R = tileAt r → S = tileAt s → + (TileString C orientation base R S tiles ↔ + ∃! coordinates : List (Int × Int), + List.Forall₂ (fun T z => T = tileAt z) tiles coordinates ∧ + TriangularStripSegment r s coordinates) := by +-- BODY + classical + have chart : ∃ a b : GaussianInt, + 0 < a.re * b.im - a.im * b.re ∧ + a ∈ TilingLattice C ∧ b ∈ TilingLattice C ∧ + (∀ w : TilingLattice C, ∃! z : Int × Int, + (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b = (w : GaussianInt)) ∧ + ((C.1.1.1 = 1 ∧ + ((orientation = true ∧ a = 1 ∧ b = ⟨0, 1⟩) ∨ + (orientation = false ∧ a = ⟨0, 1⟩ ∧ b = -1))) ∨ + (1 < C.1.1.1 ∧ ∃ q : Fin 4 → CircleCoordinates, + ProperBandQuadruple q ∧ q 0 = C.1.1 ∧ + ((a = BandVectors.1 (q 1) (q 0) ∧ b = BandVectors.1 (q 2) (q 0)) ∨ + (a = BandVectors.1 (q 2) (q 0) ∧ b = BandVectors.1 (q 1) (q 0))))) := + StringCoordinateGeometry.chart C orientation + obtain ⟨a, b, hdet, ha, hb, hcoord, hsource⟩ := chart + let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b + let tileAt := fun z : Int × Int => TileTranslation base (index z) + let adjacent := fun T U : ProtoTile => + if C.1.1.1 = 1 then + ∃ v : GaussianInt, UnitTriangularStep orientation v ∧ + TileCentroid U - TileCentroid T = GaussianRealPoint v + else TileTouching T U + have index_mem (z : Int × Int) : index z ∈ TilingLattice C := + StringCoordinateGeometry.index_mem C a b ha hb z + have index_inj : Function.Injective index := StringCoordinateGeometry.index_inj C a b hcoord + index_mem + have translation_inj : Function.Injective (TileTranslation base) := + StringCoordinateGeometry.translation_inj base + have tile_inj : Function.Injective tileAt := translation_inj.comp index_inj + have family (U : ProtoTile) : U ∈ RegularTileFamily base (TilingLattice C) ↔ + ∃! z : Int × Int, U = tileAt z := StringCoordinateGeometry.family C base a b hcoord + index_mem translation_inj U + have tile_mem (z : Int × Int) : tileAt z ∈ RegularTileFamily base (TilingLattice C) := + ⟨index z, index_mem z, rfl⟩ + have point_inj : Function.Injective GaussianRealPoint := StringCoordinateGeometry.point_inj + have centroid (z : Int × Int) : TileCentroid (tileAt z) = + ((TileCentroid base).1 + ((index z).re : Int), + (TileCentroid base).2 + ((index z).im : Int)) := + (TileTranslationFormulas base (index z)).2.2.2.2.1 + have index_sub (x y : Int × Int) : index (y - x) = index y - index x := + StringCoordinateGeometry.index_sub a b x y + have difference (x y : Int × Int) : + TileCentroid (tileAt y) - TileCentroid (tileAt x) = GaussianRealPoint (index (y - x)) := + StringCoordinateGeometry.difference base a b centroid index_sub x y + have adj (x y : Int × Int) : adjacent (tileAt x) (tileAt y) ↔ + TriangularLatticeAdjacent x y := StringCoordinateGeometry.adj C orientation base hbase a b + hdet ha hb hcoord hsource index_mem index_inj tile_inj family tile_mem point_inj + centroid index_sub difference x y + have height (x y z : Int × Int) : + ((TileCentroid (tileAt z)).2 - (TileCentroid (tileAt x)).2) * + ((TileCentroid (tileAt y)).1 - (TileCentroid (tileAt x)).1) - + ((TileCentroid (tileAt z)).1 - (TileCentroid (tileAt x)).1) * + ((TileCentroid (tileAt y)).2 - (TileCentroid (tileAt x)).2) = + ((a.re * b.im - a.im * b.re : Int) : Real) * TriangularSignedHeight x y z := + StringCoordinateGeometry.height base a b centroid x y z + refine ⟨a, b, hdet, ha, hb, hcoord, hsource, family, adj, height, ?_⟩ + intro R S tiles r s hr hs + subst R + subst S + have map_occurrence (xs : List (Int × Int)) (pre : List ProtoTile) + (T : ProtoTile) (post : List ProtoTile) + (h : xs.map tileAt = pre ++ T :: post) : + ∃ left z right, xs = left ++ z :: right ∧ pre = left.map tileAt ∧ + T = tileAt z ∧ post = right.map tileAt := StringCoordinateGeometry.map_occurrence base a + b xs pre T post h + have map_interior (P : ProtoTile → Prop) (xs : List (Int × Int)) : + (∀ pre T post, xs.map tileAt = pre ++ T :: post → + pre ≠ [] → post ≠ [] → P T) ↔ + (∀ pre z post, xs = pre ++ z :: post → + pre ≠ [] → post ≠ [] → P (tileAt z)) := StringCoordinateGeometry.map_interior base a b + map_occurrence P xs + have internal_strip (xs : List (Int × Int)) : + TriangularStripSegment r s xs ↔ + xs.head? = some r ∧ xs.getLast? = some s ∧ xs.Nodup ∧ + xs.IsChain TriangularLatticeAdjacent ∧ + (∀ pre z post, xs = pre ++ z :: post → pre ≠ [] → post ≠ [] → + 0 ≤ TriangularSignedHeight r s z ∧ + ∃ u, TriangularLatticeAdjacent z u ∧ TriangularSignedHeight r s u < 0) := + StringCoordinateGeometry.internal_strip a b r s xs + let physical := fun T : ProtoTile => + ((TileCentroid T).2 - (TileCentroid (tileAt r)).2) * + ((TileCentroid (tileAt s)).1 - (TileCentroid (tileAt r)).1) - + ((TileCentroid T).1 - (TileCentroid (tileAt r)).1) * + ((TileCentroid (tileAt s)).2 - (TileCentroid (tileAt r)).2) + have hdetReal : (0 : Real) < ((a.re * b.im - a.im * b.re : Int) : Real) := by + exact_mod_cast hdet + have nonnegative (z : Int × Int) : + 0 ≤ physical (tileAt z) ↔ 0 ≤ TriangularSignedHeight r s z := + StringCoordinateGeometry.nonnegative base a b height r s hdetReal z + have negative (z : Int × Int) : + physical (tileAt z) < 0 ↔ TriangularSignedHeight r s z < 0 := + StringCoordinateGeometry.negative base a b r s nonnegative z + have interior_point (z : Int × Int) : + (0 ≤ physical (tileAt z) ∧ + ∃ U ∈ RegularTileFamily base (TilingLattice C), + adjacent (tileAt z) U ∧ physical U < 0) ↔ + (0 ≤ TriangularSignedHeight r s z ∧ + ∃ u, TriangularLatticeAdjacent z u ∧ TriangularSignedHeight r s u < 0) := + StringCoordinateGeometry.interior_point C orientation base a b family tile_mem adj r + s nonnegative negative z + have head_iff (xs : List (Int × Int)) : + (xs.map tileAt).head? = some (tileAt r) ↔ xs.head? = some r := + StringCoordinateGeometry.head_iff base a b tile_inj r xs + have last_iff (xs : List (Int × Int)) : + (xs.map tileAt).getLast? = some (tileAt s) ↔ xs.getLast? = some s := + StringCoordinateGeometry.last_iff base a b tile_inj s xs + have distinct_iff (xs : List (Int × Int)) : + (xs.map tileAt).Pairwise (fun T U => T ≠ U) ↔ xs.Nodup := + StringCoordinateGeometry.distinct_iff base a b tile_inj xs + have chain_iff (xs : List (Int × Int)) : + (xs.map tileAt).IsChain adjacent ↔ xs.IsChain TriangularLatticeAdjacent := + StringCoordinateGeometry.chain_iff C orientation base a b adj xs + have map_family (xs : List (Int × Int)) : + ∀ T ∈ xs.map tileAt, T ∈ RegularTileFamily base (TilingLattice C) := + StringCoordinateGeometry.map_family C base a b tile_mem xs + have mapped_string (xs : List (Int × Int)) : + TileString C orientation base (tileAt r) (tileAt s) (xs.map tileAt) ↔ + TriangularStripSegment r s xs := StringCoordinateGeometry.mapped_string C orientation + base hbase a b r s map_interior internal_strip interior_point head_iff last_iff + distinct_iff chain_iff map_family xs + have decode (ys : List ProtoTile) (zs : List (Int × Int)) : + List.Forall₂ (fun T z => T = tileAt z) ys zs ↔ ys = zs.map tileAt := + StringCoordinateGeometry.decode base a b ys zs + have map_decode (ys : List ProtoTile) + (hy : ∀ T ∈ ys, T ∈ RegularTileFamily base (TilingLattice C)) : + ∃ xs : List (Int × Int), ys = xs.map tileAt := StringCoordinateGeometry.map_decode C base a + b family ys hy + constructor + · intro ht + obtain ⟨xs, hxs⟩ := map_decode tiles ht.2.2.2.2.1 + refine ⟨xs, ⟨(decode tiles xs).mpr hxs, ?_⟩, ?_⟩ + · exact (mapped_string xs).mp (by simpa [hxs] using ht) + · intro ys hy + exact List.map_injective_iff.mpr tile_inj + (((decode tiles ys).mp hy.1).symm.trans hxs) + · rintro ⟨xs, ⟨hd, hstrip⟩, _⟩ + rw [(decode tiles xs).mp hd] + exact (mapped_string xs).mpr hstrip + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileStringExists.lean b/LeanPool/ApollonianSuperharmonic/TileStringExists.lean new file mode 100644 index 0000000000..02501909c4 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileStringExists.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AffineTriangularStrip +public import LeanPool.ApollonianSuperharmonic.TileStringCoordinateTransport + +-- [TABLET NODE: TileStringExists] + +/-! +# TileStringExists + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TileStringExists (C : BandCircle) (orientation : Bool) + (base R S : ProtoTile) + (hbase : BandPrototile C.1.1 base) + (hR : R ∈ RegularTileFamily base (TilingLattice C)) + (hS : S ∈ RegularTileFamily base (TilingLattice C)) : + ∃ tiles : List ProtoTile, TileString C orientation base R S tiles := by +-- BODY + obtain ⟨a, b, hdet, ha, hb, hbasis, hsource, hchart⟩ := + TileStringCoordinateTransport C orientation base hbase + dsimp only at hchart + obtain ⟨hfamily, hadjacent, hheight, htransport⟩ := hchart + obtain ⟨r, hr, hr_unique⟩ := (hfamily R).mp hR + obtain ⟨s, hs, hs_unique⟩ := (hfamily S).mp hS + let tileAt := fun z : Int × Int => + TileTranslation base + ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + have map_corr : ∀ coordinates : List (Int × Int), List.Forall₂ + (fun T z => T = + TileTranslation base + ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b)) + (coordinates.map tileAt) coordinates := by + intro coordinates + induction coordinates with + | nil => exact .nil + | cons z zs ih => + exact .cons (by simp [tileAt]) ih + obtain ⟨coordinates, hsegment, hsegment_unique⟩ := + (AffineTriangularStrip).1 r s + let tiles := coordinates.map tileAt + have hcorr : List.Forall₂ + (fun T z => T = + TileTranslation base + ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b)) + tiles coordinates := by + dsimp [tiles] + exact map_corr coordinates + refine ⟨tiles, (htransport R S tiles r s hr hs).mpr ?_⟩ + refine ⟨coordinates, ?_, ?_⟩ + · constructor + · exact hcorr + · exact hsegment + · intro other hother + exact hsegment_unique other hother.2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean new file mode 100644 index 0000000000..243d0d40b8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean @@ -0,0 +1,654 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AffineTriangularStrip +public import LeanPool.ApollonianSuperharmonic.BandCircle +public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.RegularTileFamily +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileString +public import LeanPool.ApollonianSuperharmonic.TileStringCoordinateTransport +public import LeanPool.ApollonianSuperharmonic.TileStringCentralCovariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TriangularMaxIncrement +public import LeanPool.ApollonianSuperharmonic.TriangularSignedHeight +public import LeanPool.ApollonianSuperharmonic.TriangularStripSegment + +-- [TABLET NODE: TileStringRegularFamilyCentralCovariance] + +/-! +# TileStringRegularFamilyCentralCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace RegularStringCentralGeometry + +private theorem coordinate_value : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), + let tileAt := fun z : Int × Int => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + ∀ T, ∀ z, T = tileAt z → T = TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : + GaussianInt) * b) ) := by + classical + intro base a b tileAt T z hz + exact hz + +private theorem reflect_height : + (by + classical + exact + (GaussianInt) → ((GaussianInt) → (∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), + let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) + ∀ z, TriangularBoundaryStrip r s z → TriangularBoundaryStrip s r (reflect z))) ) := by + classical + intro a b r s reflect z hz + have hh : TriangularSignedHeight s r (reflect z) = + TriangularSignedHeight r s z := by + dsimp [TriangularSignedHeight, reflect] + ring + have hm : TriangularMaxIncrement s r = TriangularMaxIncrement r s := by + dsimp [TriangularMaxIncrement] + have e1 : s.1 - r.1 = -(r.1 - s.1) := by omega + have e2 : s.2 - r.2 = -(r.2 - s.2) := by omega + have f1 : |r.1 - s.1| = |s.1 - r.1| := by rw [e1, abs_neg] + have f2 : |r.2 - s.2| = |s.2 - r.2| := by rw [e2, abs_neg] + have f3 : |(r.1 - s.1) - (r.2 - s.2)| = + |(s.1 - r.1) - (s.2 - r.2)| := by + have e3 : (s.1 - r.1) - (s.2 - r.2) = + -((r.1 - s.1) - (r.2 - s.2)) := by omega + rw [e3, abs_neg] + rw [f1, f2, f3] + dsimp [TriangularBoundaryStrip] at hz ⊢ + rw [hh, hm] + exact hz + +private theorem reflect_sub : + (by + classical + exact + (GaussianInt) → ((GaussianInt) → (∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), + let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) + ∀ x, ∀ y, reflect y - reflect x = -(y - x))) ) := by + classical + intro a b r s reflect x y + apply Prod.ext <;> dsimp [reflect] <;> omega + +private theorem reflect_adjacent : + (by + classical + exact + ∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), + let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) + (∀ x, ∀ y, reflect y - reflect x = -(y - x)) → (∀ x, ∀ y, TriangularLatticeAdjacent x y → + TriangularLatticeAdjacent (reflect x) (reflect y)) ) := by + classical + intro r s reflect reflect_sub x y hxy + dsimp [TriangularLatticeAdjacent] at hxy ⊢ + rcases hxy with hxy | hxy | hxy | hxy | hxy | hxy + · refine Or.inr (Or.inr (Or.inr (Or.inl ?_))) + rw [reflect_sub, hxy] + norm_num + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ?_)))) + rw [reflect_sub, hxy] + norm_num + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr ?_)))) + rw [reflect_sub, hxy] + norm_num + · refine Or.inl ?_ + rw [reflect_sub, hxy] + norm_num + · refine Or.inr (Or.inl ?_) + rw [reflect_sub, hxy] + norm_num + · refine Or.inr (Or.inr (Or.inl ?_)) + rw [reflect_sub, hxy] + norm_num + +private theorem reflected_segment : + (by + classical + exact + (GaussianInt) → ((GaussianInt) → (∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), ∀ (coordinates : List (ℤ + × ℤ)), (TriangularStripSegment r s coordinates) → ( + let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) + (∀ z, TriangularBoundaryStrip r s z → TriangularBoundaryStrip s r (reflect z)) → ((∀ x, ∀ + y, TriangularLatticeAdjacent x y → TriangularLatticeAdjacent (reflect x) (reflect y)) + → (TriangularStripSegment s r (coordinates.map reflect)))))) ) := by + classical + intro a b r s coordinates hsegment reflect reflect_height reflect_adjacent + by_cases hrs : r = s + · have heq : coordinates = [r] := by simpa [TriangularStripSegment, hrs] using hsegment + simp [TriangularStripSegment, hrs, reflect, heq] + · have hsseg := (show TriangularStripSegment r s coordinates from hsegment) + have hrs' : s ≠ r := Ne.symm hrs + dsimp [TriangularStripSegment] at hsseg + rw [ite_eq_right hrs] at hsseg + rcases hsseg with ⟨hfirst, hlast', hnodup, hbound, hchain'⟩ + have hfirst' : (coordinates.map reflect).head? = some s := by + rw [List.head?_map, hfirst] + simp only [Option.map, Option.some.injEq] + apply Prod.ext <;> dsimp [reflect] <;> omega + have hlast'' : (coordinates.map reflect).getLast? = some r := by + rw [List.getLast?_map, hlast'] + simp only [Option.map, Option.some.injEq] + apply Prod.ext <;> dsimp [reflect] <;> omega + have hinj : Function.Injective reflect := by + intro x y he + have hx := congrArg Prod.fst he + have hy := congrArg Prod.snd he + apply Prod.ext <;> dsimp [reflect] at hx hy ⊢ <;> omega + have hnodup' := List.Nodup.map hinj hnodup + have hbound' : ∀ z ∈ coordinates.map reflect, + TriangularBoundaryStrip s r z := by + intro z hz + rw [List.mem_map] at hz + rcases hz with ⟨w, hw, rfl⟩ + exact reflect_height w (hbound w hw) + have hchain'' : List.IsChain TriangularLatticeAdjacent + (coordinates.map reflect) := + List.isChain_map_of_isChain reflect reflect_adjacent hchain' + have htarget : + (coordinates.map reflect).head? = some s ∧ + (coordinates.map reflect).getLast? = some r ∧ + (coordinates.map reflect).Nodup ∧ + (∀ z ∈ coordinates.map reflect, TriangularBoundaryStrip s r z) ∧ + List.IsChain TriangularLatticeAdjacent (coordinates.map reflect) := + ⟨hfirst', hlast'', hnodup', hbound', hchain''⟩ + rw [show TriangularStripSegment s r (coordinates.map reflect) = + ((coordinates.map reflect).head? = some s ∧ + (coordinates.map reflect).getLast? = some r ∧ + (coordinates.map reflect).Nodup ∧ + (∀ z ∈ coordinates.map reflect, TriangularBoundaryStrip s r z) ∧ + List.IsChain TriangularLatticeAdjacent (coordinates.map reflect)) by + simp [TriangularStripSegment, hrs']] + exact htarget + +private theorem reflected_corr : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), ∀ (coordinates : List (ℤ × ℤ)), (List.Forall₂ (fun (T : ProtoTile) (z : + ℤ × ℤ) => T = TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * + b)) tiles coordinates) → ( + let tileAt := fun z : Int × Int => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + List.Forall₂ (fun T z => T = tileAt z) tiles (coordinates)) ) := by + classical + intro base tiles a b coordinates hcorr tileAt + simpa [tileAt] using hcorr + +private theorem reverse_corr : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (r : ℤ × ℤ), ∀ (s : ℤ × + ℤ), ∀ (coordinates : List (ℤ × ℤ)), + let tileAt := fun z : Int × Int => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) + let reverseTiles := coordinates.map (fun z => tileAt (reflect z)) + List.Forall₂ (fun T z => T = tileAt z) reverseTiles (coordinates.map reflect) ) := by + classical + intro base a b r s coordinates tileAt reflect reverseTiles + change List.Forall₂ (fun T z => T = tileAt z) + (coordinates.map (fun z => tileAt (reflect z))) (coordinates.map reflect) + have map_corr : ∀ xs : List (Int × Int), + List.Forall₂ (fun T z => T = tileAt z) + (xs.map (fun z => tileAt (reflect z))) (xs.map reflect) := by + intro xs + induction xs with + | nil => exact .nil + | cons z zs ih => exact .cons rfl ih + exact map_corr coordinates + +private theorem reverse_string : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (R : ProtoTile), ∀ (S + : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (∀ (R : ProtoTile), ∀ (S : + ProtoTile), ∀ (tiles : List ProtoTile), ∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), R = + TileTranslation base ((↑r.1 : GaussianInt) * a + (↑r.2 : GaussianInt) * b) → S = + TileTranslation base ((↑s.1 : GaussianInt) * a + (↑s.2 : GaussianInt) * b) → + (TileString C orientation base R S tiles ↔ ∃! coordinates : List (ℤ × ℤ), + List.Forall₂ (fun (T : ProtoTile) (z : ℤ × ℤ) => T = TileTranslation base ((↑z.1 : + GaussianInt) * a + (↑z.2 : GaussianInt) * b)) tiles coordinates ∧ + TriangularStripSegment r s coordinates)) → (∀ (r : ℤ × ℤ), (R = TileTranslation base + ((↑r.1 : GaussianInt) * a + (↑r.2 : GaussianInt) * b)) → (∀ (s : ℤ × ℤ), (S = + TileTranslation base ((↑s.1 : GaussianInt) * a + (↑s.2 : GaussianInt) * b)) → (∀ + (coordinates : List (ℤ × ℤ)), + let tileAt := fun z : Int × Int => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) + (TriangularStripSegment s r (coordinates.map reflect)) → ( + let reverseTiles := coordinates.map (fun z => tileAt (reflect z)) + (List.Forall₂ (fun T z => T = tileAt z) reverseTiles (coordinates.map reflect)) → + (TileString C orientation base S R reverseTiles))))) ) := by + classical + intro C orientation base R S a b htransport r hr s hs coordinates tileAt reflect + reflected_segment reverseTiles reverse_corr + apply (htransport S R reverseTiles s r hs hr).mpr + exact ⟨coordinates.map reflect, ⟨reverse_corr, reflected_segment⟩, by + intro other hother + exact (AffineTriangularStrip).1 s r |>.unique hother.2 reflected_segment⟩ + +private theorem center_integral : + (by + classical + exact + ∀ (D : CircleCoordinates), ∀ (T : ProtoTile), BandPrototile D T → ∃ c : GaussianInt, + GaussianRealPoint c = TileCentroid T + TileCentroid T ) := by + classical + intro D T hT + induction hT with + | line w x hw => + refine ⟨2 * x, ?_⟩ + simp [TileCentroid, GaussianRealPoint] + constructor <;> ring + | unit z x => + refine ⟨2 * x + 1 + ⟨0, 1⟩, ?_⟩ + simp [TileCentroid, GaussianRealPoint] + constructor <;> ring + | @decompose q hq S T hS hcells hfoot hcentroid ih => + obtain ⟨c, hc⟩ := ih 0 false + let w := BandVectors.1 (q ((0 : Fin 3) + 2).succ) + (q ((0 : Fin 3) + 1).succ) + refine ⟨c + ⟨w.re + w.im, w.im - w.re⟩, ?_⟩ + have hd := hcentroid 0 false + have hcr := congrArg Prod.fst hd + have hci := congrArg Prod.snd hd + have hccr := congrArg Prod.fst hc + have hcci := congrArg Prod.snd hc + have hcr' : (TileCentroid (S 0 false)).1 - (TileCentroid T).1 = + -(1 / 2 : Real) * (((w.re : Int) : Real) + ((w.im : Int) : Real)) := by + simpa [w, GaussianRealPoint] using hcr + have hci' : (TileCentroid (S 0 false)).2 - (TileCentroid T).2 = + -(1 / 2 : Real) * (((w.im : Int) : Real) - ((w.re : Int) : Real)) := by + simpa [w, GaussianRealPoint] using hci + change (c.re : Real) = _ at hccr + change (c.im : Real) = _ at hcci + change (c.re : Real) = (TileCentroid (S 0 false)).1 + + (TileCentroid (S 0 false)).1 at hccr + change (c.im : Real) = (TileCentroid (S 0 false)).2 + + (TileCentroid (S 0 false)).2 at hcci + apply Prod.ext + · dsimp [GaussianRealPoint] + push_cast + linarith [hcr', hccr] + · dsimp [GaussianRealPoint] + push_cast + linarith [hci', hcci] + +private theorem hu : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (R : ProtoTile), ∀ (S : ProtoTile), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), ∀ (r : ℤ × ℤ), (R = TileTranslation base ((↑r.1 : GaussianInt) * a + + (↑r.2 : GaussianInt) * b)) → (∀ (s : ℤ × ℤ), (S = TileTranslation base ((↑s.1 : + GaussianInt) * a + (↑s.2 : GaussianInt) * b)) → (∀ (cbase : GaussianInt), + (GaussianRealPoint cbase = TileCentroid base + TileCentroid base) → ( + let wr : GaussianInt := (r.1 : GaussianInt) * a + (r.2 : GaussianInt) * b + let ws : GaussianInt := (s.1 : GaussianInt) * a + (s.2 : GaussianInt) * b + let u : GaussianInt := cbase + wr + ws + GaussianRealPoint u = TileCentroid R + TileCentroid S))) ) := by + classical + intro base R S a b r hr s hs cbase hcbase wr ws u + have hr' : TileCentroid R = + TileCentroid base + GaussianRealPoint wr := by + rw [hr, (TileTranslationFormulas base wr).2.2.2.2.1] + dsimp [wr, GaussianRealPoint] + rfl + have hs' : TileCentroid S = + TileCentroid base + GaussianRealPoint ws := by + rw [hs, (TileTranslationFormulas base ws).2.2.2.2.1] + dsimp [ws, GaussianRealPoint] + rfl + calc + GaussianRealPoint u = GaussianRealPoint cbase + GaussianRealPoint wr + + GaussianRealPoint ws := by + dsimp [u, GaussianRealPoint] + apply Prod.ext <;> dsimp <;> push_cast <;> ring + _ = (TileCentroid base + TileCentroid base) + + GaussianRealPoint wr + GaussianRealPoint ws := by rw [hcbase] + _ = TileCentroid base + GaussianRealPoint wr + + (TileCentroid base + GaussianRealPoint ws) := by + apply Prod.ext <;> dsimp <;> ring + _ = TileCentroid R + TileCentroid S := by rw [← hr', ← hs'] + +private theorem transformed_band : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (R : ProtoTile), ∀ (S + : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ + (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), ∀ (cbase : GaussianInt), + let wr : GaussianInt := (r.1 : GaussianInt) * a + (r.2 : GaussianInt) * b + let ws : GaussianInt := (s.1 : GaussianInt) * a + (s.2 : GaussianInt) * b + let u : GaussianInt := cbase + wr + ws + (TileString C orientation (TileTranslation (TileHalfTurn base) u) (TileTranslation + (TileHalfTurn R) u) (TileTranslation (TileHalfTurn S) u) (List.map (fun (T : + ProtoTile) => TileTranslation (TileHalfTurn T) u) tiles)) → ((BandPrototile C.1.1 + (TileTranslation (TileHalfTurn base) u)) → (∀ U, U ∈ tiles → BandPrototile C.1.1 + (TileTranslation (TileHalfTurn U) u))) ) := by + classical + intro C orientation base R S tiles a b r s cbase wr ws u rawString rawBase U hU + have hU' : TileTranslation (TileHalfTurn U) u ∈ + tiles.map (fun T => TileTranslation (TileHalfTurn T) u) := by + exact List.mem_map.mpr ⟨U, hU, rfl⟩ + have hm := rawString.2.2.2.2.1 _ hU' + rcases hm with ⟨v, hv, he⟩ + rw [he] + exact BandPrototileTranslation C.1.1 + (TileTranslation (TileHalfTurn base) u) v rawBase + +private theorem translated_band : + (by + classical + exact + ∀ (C : BandCircle), ∀ (base : ProtoTile), (BandPrototile C.1.1 base) → (∀ v : + GaussianInt, v ∈ TilingLattice C → BandPrototile C.1.1 (TileTranslation base v)) ) := by + classical + intro C base hbase v hv + exact BandPrototileTranslation C.1.1 base v hbase + +private theorem centroid_transform : + (by + classical + exact + ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), ∀ (cbase : + GaussianInt), + let wr : GaussianInt := (r.1 : GaussianInt) * a + (r.2 : GaussianInt) * b + let ws : GaussianInt := (s.1 : GaussianInt) * a + (s.2 : GaussianInt) * b + let u : GaussianInt := cbase + wr + ws + ∀ U : ProtoTile, TileCentroid (TileTranslation (TileHalfTurn U) u) = (- (TileCentroid + U).1 + (u.re : Int), - (TileCentroid U).2 + (u.im : Int)) ) := by + classical + intro a b r s cbase wr ws u U + rw [(TileTranslationFormulas (TileHalfTurn U) u).2.2.2.2.1, + (TileHalfTurnFormulas U).2.2.2.2.2.2.2.1] + +private theorem cell_transport : + (by + classical + exact + ∀ (C : BandCircle), ∀ (base : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (a : + GaussianInt), ∀ (b : GaussianInt), (a ∈ TilingLattice C) → ((b ∈ TilingLattice C) → + (∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), + let tileAt := fun z : Int × Int => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) + ∀ (cbase : GaussianInt), (GaussianRealPoint cbase = TileCentroid base + TileCentroid + base) → ( + let wr : GaussianInt := (r.1 : GaussianInt) * a + (r.2 : GaussianInt) * b + let ws : GaussianInt := (s.1 : GaussianInt) * a + (s.2 : GaussianInt) * b + let u : GaussianInt := cbase + wr + ws + (∀ U, U ∈ tiles → BandPrototile C.1.1 (TileTranslation (TileHalfTurn U) u)) → ((∀ v : + GaussianInt, v ∈ TilingLattice C → BandPrototile C.1.1 (TileTranslation base v)) → + ((∀ U : ProtoTile, TileCentroid (TileTranslation (TileHalfTurn U) u) = (- + (TileCentroid U).1 + (u.re : Int), - (TileCentroid U).2 + (u.im : Int))) → (∀ U, ∀ z, + U ∈ tiles → U = tileAt z → (TileTranslation (TileHalfTurn U) u).cells = (tileAt + (reflect z)).cells)))))) ) := by + classical + intro C base tiles a b ha hb r s tileAt reflect cbase hcbase wr ws u transformed_band + translated_band centroid_transform U z hUm hUz + have hVz : ((reflect z).1 : GaussianInt) * a + + ((reflect z).2 : GaussianInt) * b ∈ TilingLattice C := by + apply (TilingLattice C).add_mem + · simpa using (TilingLattice C).zsmul_mem ha (reflect z).1 + · simpa using (TilingLattice C).zsmul_mem hb (reflect z).2 + have hVband : BandPrototile C.1.1 (tileAt (reflect z)) := by + dsimp [tileAt] + exact translated_band _ hVz + have hUzcent : TileCentroid U = TileCentroid base + + GaussianRealPoint ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) := by + rw [hUz, (TileTranslationFormulas base _).2.2.2.2.1] + rfl + have hVcent : TileCentroid (tileAt (reflect z)) = + TileCentroid base + GaussianRealPoint + ((reflect z).1 * a + (reflect z).2 * b) := by + dsimp [tileAt] + rw [(TileTranslationFormulas base _).2.2.2.2.1] + rfl + have hcent : TileCentroid (TileTranslation (TileHalfTurn U) u) = + TileCentroid (tileAt (reflect z)) := by + rw [centroid_transform, hUzcent, hVcent] + have hsum : + ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + + (((reflect z).1 : GaussianInt) * a + + ((reflect z).2 : GaussianInt) * b) = wr + ws := by + dsimp [wr, ws, reflect] + push_cast + ring + have hsum_re := congrArg (fun q : GaussianInt => (q.re : Real)) hsum + have hsum_im := congrArg (fun q : GaussianInt => (q.im : Real)) hsum + norm_num at hsum_re hsum_im + dsimp [reflect, wr, ws] at hsum_re hsum_im + have cast_re : ∀ n : Int, (((n : GaussianInt).re : Int) : Real) = (n : Real) := by + intro n + cases n <;> simp + have cast_im : ∀ n : Int, (((n : GaussianInt).im : Int) : Real) = (0 : Real) := by + intro n + cases n <;> simp + simp only [GaussianInt.toComplex_def, Complex.add_re, Complex.add_im, + Complex.mul_re, Complex.mul_im, Complex.I_re, Complex.I_im, + ] at hsum_re hsum_im + norm_num at hsum_re hsum_im + dsimp [u, reflect, GaussianRealPoint] + have hcb_re := congrArg Prod.fst hcbase + have hcb_im := congrArg Prod.snd hcbase + dsimp [GaussianRealPoint] at hcb_re hcb_im + change (cbase.re : Real) = _ at hcb_re + change (cbase.im : Real) = _ at hcb_im + have real_part_cast : ∀ n : Int, ((n : Complex).re) = (n : Real) := by + intro n + norm_num + have imag_part_cast : ∀ n : Int, ((n : Complex).im) = (0 : Real) := by + intro n + norm_num + apply Prod.ext + · dsimp [wr, ws, reflect, GaussianRealPoint] + push_cast + simp only [cast_re] at hsum_re ⊢ + simp at hsum_re ⊢ + ring_nf at hsum_re ⊢ + simp only [GaussianInt.toComplex_def, Complex.add_re, + Complex.mul_re, Complex.I_re, Complex.I_im, + ] at ⊢ + ring_nf at ⊢ + simp only [real_part_cast, imag_part_cast] at ⊢ + ring_nf at ⊢ + nlinarith [hcb_re] + · dsimp [wr, ws, reflect, GaussianRealPoint] + push_cast + simp only [cast_re, cast_im] at hsum_im ⊢ + simp at hsum_im ⊢ + ring_nf at hsum_im ⊢ + simp only [GaussianInt.toComplex_def, Complex.add_im, + Complex.mul_im, Complex.I_re, Complex.I_im, + ] at ⊢ + ring_nf at ⊢ + simp only [real_part_cast, imag_part_cast] at ⊢ + ring_nf at ⊢ + nlinarith [hcb_im] + exact (BandPrototileCentroidUnique C.1.1 _ _ + (transformed_band U hUm) hVband hcent).1 + +private theorem endpoint_R : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (R : ProtoTile), ∀ (S : ProtoTile), ∀ (tiles : List ProtoTile), + (tiles.head? = some R) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (r : ℤ × ℤ), (R + = TileTranslation base ((↑r.1 : GaussianInt) * a + (↑r.2 : GaussianInt) * b)) → (∀ (s + : ℤ × ℤ), (S = TileTranslation base ((↑s.1 : GaussianInt) * a + (↑s.2 : GaussianInt) + * b)) → ( + let tileAt := fun z : Int × Int => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) + ∀ (cbase : GaussianInt), + let wr : GaussianInt := (r.1 : GaussianInt) * a + (r.2 : GaussianInt) * b + let ws : GaussianInt := (s.1 : GaussianInt) * a + (s.2 : GaussianInt) * b + let u : GaussianInt := cbase + wr + ws + (∀ U, ∀ z, U ∈ tiles → U = tileAt z → (TileTranslation (TileHalfTurn U) u).cells = + (tileAt (reflect z)).cells) → ((TileTranslation (TileHalfTurn R) u).cells = + S.cells)))) ) := by + classical + intro base R S tiles hhead a b r hr s hs tileAt reflect cbase wr ws u cell_transport + have h := cell_transport R r (List.mem_of_mem_head? hhead) hr + simpa [reflect, tileAt, hs] using h + +private theorem endpoint_S : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (R : ProtoTile), ∀ (S : ProtoTile), ∀ (tiles : List ProtoTile), + (tiles.getLast? = some S) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (r : ℤ × ℤ), + (R = TileTranslation base ((↑r.1 : GaussianInt) * a + (↑r.2 : GaussianInt) * b)) → (∀ + (s : ℤ × ℤ), (S = TileTranslation base ((↑s.1 : GaussianInt) * a + (↑s.2 : + GaussianInt) * b)) → ( + let tileAt := fun z : Int × Int => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) + ∀ (cbase : GaussianInt), + let wr : GaussianInt := (r.1 : GaussianInt) * a + (r.2 : GaussianInt) * b + let ws : GaussianInt := (s.1 : GaussianInt) * a + (s.2 : GaussianInt) * b + let u : GaussianInt := cbase + wr + ws + (∀ U, ∀ z, U ∈ tiles → U = tileAt z → (TileTranslation (TileHalfTurn U) u).cells = + (tileAt (reflect z)).cells) → ((TileTranslation (TileHalfTurn S) u).cells = + R.cells)))) ) := by + classical + intro base R S tiles hlast a b r hr s hs tileAt reflect cbase wr ws u cell_transport + have h := cell_transport S s (List.mem_of_getLast? hlast) hs + simpa [reflect, tileAt, hr] using h + +private theorem all_cells : + (by + classical + exact + ∀ (base : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (a : GaussianInt), ∀ (b : + GaussianInt), ∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), ∀ (coordinates : List (ℤ × ℤ)), + (List.Forall₂ (fun (T : ProtoTile) (z : ℤ × ℤ) => T = TileTranslation base ((↑z.1 : + GaussianInt) * a + (↑z.2 : GaussianInt) * b)) tiles coordinates) → ( + let tileAt := fun z : Int × Int => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) + let reverseTiles := coordinates.map (fun z => tileAt (reflect z)) + ∀ (cbase : GaussianInt), + let wr : GaussianInt := (r.1 : GaussianInt) * a + (r.2 : GaussianInt) * b + let ws : GaussianInt := (s.1 : GaussianInt) * a + (s.2 : GaussianInt) * b + let u : GaussianInt := cbase + wr + ws + (∀ U, ∀ z, U ∈ tiles → U = tileAt z → (TileTranslation (TileHalfTurn U) u).cells = + (tileAt (reflect z)).cells) → (List.Forall₂ (fun T U => (TileTranslation + (TileHalfTurn T) u).cells = U.cells) tiles reverseTiles)) ) := by + classical + intro base tiles a b r s coordinates hcorr tileAt reflect reverseTiles cbase wr ws u + cell_transport + change List.Forall₂ + (fun T U => (TileTranslation (TileHalfTurn T) u).cells = U.cells) + tiles (coordinates.map (fun z => tileAt (reflect z))) + have all_cells_aux : ∀ (xs : List ProtoTile) (zs : List (Int × Int)), + List.Forall₂ (fun T z => T = tileAt z) xs zs → + (∀ T ∈ xs, T ∈ tiles) → + List.Forall₂ + (fun T U => (TileTranslation (TileHalfTurn T) u).cells = U.cells) + xs (zs.map (fun z => tileAt (reflect z))) := by + intro xs zs h + induction h with + | nil => exact fun _ => .nil + | cons hhead htail ih => + intro hx + exact .cons (cell_transport _ _ (hx _ (List.mem_cons_self)) hhead) + (ih (fun T hT => hx T (List.mem_cons_of_mem _ hT))) + exact all_cells_aux tiles coordinates hcorr (by intro T hT; exact hT) + +end RegularStringCentralGeometry + +theorem TileStringRegularFamilyCentralCovariance + (C : BandCircle) (orientation : Bool) + (base R S : ProtoTile) (tiles : List ProtoTile) + (hstring : TileString C orientation base R S tiles) : + exists u : GaussianInt, exists reverseTiles : List ProtoTile, + GaussianRealPoint u = TileCentroid R + TileCentroid S /\ + TileString C orientation base S R reverseTiles /\ + (TileTranslation (TileHalfTurn R) u).cells = S.cells /\ + (TileTranslation (TileHalfTurn S) u).cells = R.cells /\ + List.Forall₂ + (fun T U => (TileTranslation (TileHalfTurn T) u).cells = U.cells) + tiles reverseTiles := by +-- BODY + classical + have original_string := hstring + unfold TileString at hstring + rcases hstring with ⟨hbase, hhead, hlast, hpair, hmem, hchain, hheight⟩ + obtain ⟨a, b, hdet, ha, hb, hbasis, hsource, hchart⟩ := + TileStringCoordinateTransport C orientation base hbase + dsimp only at hchart + obtain ⟨hfamily, hadjacent, hsigned, htransport⟩ := hchart + have hRmem := hmem R (List.mem_of_mem_head? hhead) + have hSmem := hmem S (List.mem_of_getLast? hlast) + obtain ⟨r, hr, hr_unique⟩ := (hfamily R).mp hRmem + obtain ⟨s, hs, hs_unique⟩ := (hfamily S).mp hSmem + obtain ⟨coordinates, hcoords, hsegment_unique⟩ := + (htransport R S tiles r s hr hs).mp + ⟨hbase, hhead, hlast, hpair, hmem, hchain, hheight⟩ + have hcorr := hcoords.1 + have hsegment := hcoords.2 + let tileAt := fun z : Int × Int => + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) + let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) + have coordinate_value := RegularStringCentralGeometry.coordinate_value base a b + have reflected_corr := RegularStringCentralGeometry.reflected_corr base tiles a b coordinates + hcorr + let reverseTiles := coordinates.map (fun z => tileAt (reflect z)) + have reverse_string := RegularStringCentralGeometry.reverse_string C orientation base R S a b + htransport r hr s hs coordinates (RegularStringCentralGeometry.reflected_segment a b r s + coordinates hsegment (RegularStringCentralGeometry.reflect_height a b r s) + (RegularStringCentralGeometry.reflect_adjacent r s + (RegularStringCentralGeometry.reflect_sub a b r s))) + (RegularStringCentralGeometry.reverse_corr base a b r s coordinates) + obtain ⟨cbase, hcbase⟩ : ∃ cbase : GaussianInt, + GaussianRealPoint cbase = TileCentroid base + TileCentroid base := by + exact (RegularStringCentralGeometry.center_integral) C.1.1 base hbase + let wr : GaussianInt := (r.1 : GaussianInt) * a + (r.2 : GaussianInt) * b + let ws : GaussianInt := (s.1 : GaussianInt) * a + (s.2 : GaussianInt) * b + let u : GaussianInt := cbase + wr + ws + have rawString := TileStringCentralCovariance C orientation base R S tiles u + original_string + have rawBase : BandPrototile C.1.1 + (TileTranslation (TileHalfTurn base) u) := rawString.1 + have cell_transport := RegularStringCentralGeometry.cell_transport C base tiles a b ha hb r s + cbase hcbase (RegularStringCentralGeometry.transformed_band C orientation base R S tiles a + b r s cbase rawString rawBase) (RegularStringCentralGeometry.translated_band C base hbase) + (RegularStringCentralGeometry.centroid_transform a b r s cbase) + exact ⟨u, reverseTiles, (RegularStringCentralGeometry.hu base R S a b r hr s hs cbase hcbase), + reverse_string, (RegularStringCentralGeometry.endpoint_R base R S tiles hhead a b r hr s hs + cbase cell_transport), (RegularStringCentralGeometry.endpoint_S base R S tiles hlast a b r + hr s hs cbase cell_transport), (RegularStringCentralGeometry.all_cells base tiles a b r s + coordinates hcorr cbase cell_transport)⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileStringUnique.lean b/LeanPool/ApollonianSuperharmonic/TileStringUnique.lean new file mode 100644 index 0000000000..71ae7a5052 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileStringUnique.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileStringCoordinateTransport +public import LeanPool.ApollonianSuperharmonic.AffineTriangularStrip + +-- [TABLET NODE: TileStringUnique] + +/-! +# TileStringUnique + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TileStringUnique (C : BandCircle) (orientation : Bool) + (base R S : ProtoTile) + (left right : List ProtoTile) + (hleft : TileString C orientation base R S left) + (hright : TileString C orientation base R S right) : + left = right := by +-- BODY + have hbase : BandPrototile C.1.1 base := hleft.1 + obtain ⟨a, b, hdet, ha, hb, hbasis, hsource, hchart⟩ := + TileStringCoordinateTransport C orientation base hbase + dsimp only at hchart + obtain ⟨hfamily, hadjacent, hheight, htransport⟩ := hchart + have hRmem : R ∈ RegularTileFamily base (TilingLattice C) := by + exact hleft.2.2.2.2.1 R (List.mem_of_mem_head? hleft.2.1) + have hSmem : S ∈ RegularTileFamily base (TilingLattice C) := by + exact hleft.2.2.2.2.1 S (List.mem_of_getLast? hleft.2.2.1) + obtain ⟨r, hr, hr_unique⟩ := (hfamily R).mp hRmem + obtain ⟨s, hs, hs_unique⟩ := (hfamily S).mp hSmem + obtain ⟨p, hp, hp_unique⟩ := (htransport R S left r s hr hs).mp hleft + obtain ⟨q, hq, hq_unique⟩ := (htransport R S right r s hr hs).mp hright + have hpq : p = q := (AffineTriangularStrip).1 r s |>.unique hp.2 hq.2 + subst q + clear hp_unique hq_unique hr_unique hs_unique + have correspondence_unique : ∀ (xs ys : List ProtoTile) (zs : List (Int × Int)), + List.Forall₂ (fun T z => T = + TileTranslation base + ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b)) xs zs → + List.Forall₂ (fun T z => T = + TileTranslation base + ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b)) ys zs → + xs = ys := by + intro xs ys zs hxs + induction hxs generalizing ys with + | nil => + intro hys + cases hys + rfl + | cons hx hxs ih => + intro hys + cases hys with + | cons hy hys => + congr + · exact hx.trans hy.symm + · exact ih _ hys + exact correspondence_unique left right p hp.1 hq.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileSubodometer.lean b/LeanPool/ApollonianSuperharmonic/TileSubodometer.lean new file mode 100644 index 0000000000..0108e562a8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileSubodometer.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileOdometer + +-- [TABLET NODE: TileSubodometer] + +/-! +# TileSubodometer + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A tile odometer $h'$ for $C'$ is an immediate subodometer of a tile +odometer $h$ for $C$ when both are certified tile odometers, the footprint +and domain of $h'$ lie in those of $h$, the two functions agree on the +smaller domain, and there is a proper quadruple with child $C$, parent +$C'$, and a sign for which the centroid displacement is the corresponding +six-piece displacement +$\pm\frac12(v_{kj}-iv_{kj})$. Thus this relation records one actual +parent piece of the recursive construction, rather than arbitrary domain +containment. If $C'$ has positive curvature, its slope difference from +$h$ is the corresponding $\pm\frac12(a_{kj}+ia_{kj})$; if $C'$ has zero +curvature, this is replaced by the explicit zero-curvature alternative and +no singleton slope is requested. +-/ +def TileSubodometer (C C' : CircleCoordinates) (T T' : ProtoTile) + (h h' : PartialOdometer) : Prop := +-- BODY + TileOdometer C T h ∧ TileOdometer C' T' h' ∧ + FootprintVertices T' ⊆ FootprintVertices T ∧ + h'.domain ⊆ h.domain ∧ + (∀ x, x ∈ h'.domain → h.value x = h'.value x) ∧ + ∃ q : Fin 4 → CircleCoordinates, ∃ i : Fin 3, + ProperBandQuadruple q ∧ q 0 = C ∧ q i.succ = C' ∧ + ∃ s : Bool, + TileCentroid T' - TileCentroid T = + (if s = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((i + 2).succ)) + (q ((i + 1).succ)))).1))) ∧ + (C'.1 = 0 ∨ ∃ p p' : ℝ × ℝ, + PartialOdometerSlope h = some p ∧ + PartialOdometerSlope h' = some p' ∧ + p'.1 - p.1 = + (if s = true then (1 : ℝ) else -1) * (1 / 2) * + (((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).re : ℤ) - + ((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).im : ℤ)) ∧ + p'.2 - p.2 = + (if s = true then (1 : ℝ) else -1) * (1 / 2) * + (((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).im : ℤ) + + ((BandVectors.2 (q ((i + 2).succ)) + (q ((i + 1).succ))).re : ℤ))) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileSubodometerLiteralDecompositionPiece.lean b/LeanPool/ApollonianSuperharmonic/TileSubodometerLiteralDecompositionPiece.lean new file mode 100644 index 0000000000..93eedaa2f3 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileSubodometerLiteralDecompositionPiece.lean @@ -0,0 +1,148 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileSubodometer + +-- [TABLET NODE: TileSubodometerLiteralDecompositionPiece] + +/-! +# TileSubodometerLiteralDecompositionPiece + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TileSubodometerLiteralDecompositionPiece + (C C' : BandCircle) (T T' : ProtoTile) (h h' : PartialOdometer) + (hC : 1 < C.1.1.1) + (hsub : TileSubodometer C.1.1 C'.1.1 T T' h h') : + ∃ q : Fin 4 → CircleCoordinates, ∃ i : Fin 3, ∃ s : Bool, + ∃ S : Fin 3 → Bool → ProtoTile, + ∃ hs : Fin 3 → Bool → PartialOdometer, + ProperBandQuadruple q ∧ q 0 = C.1.1 ∧ q i.succ = C'.1.1 ∧ + BandPrototile (q 0) T ∧ + (∀ j t, TileOdometer (q j.succ) (S j t) (hs j t)) ∧ + (∀ x, x ∈ T.cells ↔ ∃ j t, x ∈ (S j t).cells) ∧ + (∀ j t, FootprintVertices (S j t) ⊆ FootprintVertices T) ∧ + (∀ j t, + TileCentroid (S j t) - TileCentroid T = + (if t = true then (1 : Real) else -1) • + ((1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q ((j + 2).succ)) (q ((j + 1).succ))) - + (-((GaussianRealPoint + (BandVectors.1 (q ((j + 2).succ)) + (q ((j + 1).succ)))).2), + (GaussianRealPoint + (BandVectors.1 (q ((j + 2).succ)) + (q ((j + 1).succ)))).1)))) ∧ + (∀ x, x ∈ h.domain ↔ ∃ j t, x ∈ (hs j t).domain) ∧ + (∀ j t x, x ∈ (hs j t).domain → h.value x = (hs j t).value x) ∧ + (∀ j t k u, OdometerCompatibility (hs j t) (hs k u)) ∧ + (∀ j t, (q j.succ).1 = 0 ∨ + ∃ p p_j : Real × Real, + PartialOdometerSlope h = some p ∧ + PartialOdometerSlope (hs j t) = some p_j ∧ + p_j.1 - p.1 = + (if t = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (q ((j + 2).succ)) + (q ((j + 1).succ))).re : Int) - + ((BandVectors.2 (q ((j + 2).succ)) + (q ((j + 1).succ))).im : Int)) ∧ + p_j.2 - p.2 = + (if t = true then (1 : Real) else -1) * (1 / 2) * + (((BandVectors.2 (q ((j + 2).succ)) + (q ((j + 1).succ))).im : Int) + + ((BandVectors.2 (q ((j + 2).succ)) + (q ((j + 1).succ))).re : Int))) ∧ + T'.cells = (S i s).cells ∧ + (h'.domain : Set GaussianInt) = (hs i s).domain ∧ + ∀ x, x ∈ h'.domain → h'.value x = (hs i s).value x := by +-- BODY + rcases hsub with ⟨hO, hO', hfootSub, hdomSub, hvalSub, + ⟨q, i, hq, hq0, hqi, s, hcentSub, hslopeSub⟩⟩ + have root : 1 < (q 0).1 := by simpa [hq0] using hC + have hOq : TileOdometer (q 0) T h := by simpa [hq0] using hO + obtain ⟨S, hs, hT, hOchild, hcells, hfoot, hcent, hdom, hvalue, + hcompat, hslope⟩ := + TileOdometerReindexedDecomposition q hq T h root hOq + have band_of_odo : ∀ (d : CircleCoordinates) (u : ProtoTile) + k, TileOdometer d u k → BandPrototile d u := by + intro d u k ho + induction ho with + | line w x hw k hdom => exact BandPrototile.line w x hw + | unit z x u k hu hdom htrans => + cases u with + | mk cells anchor => + simp_all only [] + exact BandPrototile.unit z x anchor + | decompose hq hT hsub hcells hfoot hcent hdom hvalue hcompat hslope ih => + exact hT + have nonempty_of_odo : ∀ (d : CircleCoordinates) (u : ProtoTile) + k, 0 < d.1 → TileOdometer d u k → u.cells.Nonempty := by + intro d u k hd ho + induction ho with + | line w x hw k hdom => simp at hd + | unit z x u k hu hdom htrans => simp [hu] + | @decompose r hr V U hV hsub hT hsubTiles hcells hfoot hcent hdom hvalue hcompat hslope ih => + have curvature_data := ProperBandCurvatureStructure r hr + rcases curvature_data with ⟨hrootpos, hnonneg, hunique⟩ + have some_positive : ∃ j : Fin 3, 0 < (r j.succ).1 := by + by_contra none + have zeros : ∀ j : Fin 3, (r j.succ).1 = 0 := by + intro j + have non := hnonneg j + have notpos : ¬ 0 < (r j.succ).1 := fun hp => none ⟨j, hp⟩ + omega + have bad := hunique 0 1 (zeros 0) (zeros 1) + omega + rcases some_positive with ⟨j, hj⟩ + obtain ⟨x, hx⟩ := ih j false hj + exact ⟨x, (hcells x).mpr ⟨j, false, hx⟩⟩ + have hbandT' : BandPrototile C'.1.1 T' := band_of_odo _ _ _ hO' + have hbandS : BandPrototile C'.1.1 (S i s) := by + rw [← hqi] + exact band_of_odo _ _ _ (hOchild i s) + have hcentEq : TileCentroid T' = TileCentroid (S i s) := by + calc + TileCentroid T' = (TileCentroid T' - TileCentroid T) + TileCentroid T := by abel + _ = (TileCentroid (S i s) - TileCentroid T) + TileCentroid T := by + rw [hcentSub, hcent i s] + _ = TileCentroid (S i s) := by abel + have hcellsEq : T'.cells = (S i s).cells := + (BandPrototileCentroidUnique C'.1.1 T' (S i s) hbandT' hbandS hcentEq).1 + have hOis : TileOdometer C'.1.1 (S i s) (hs i s) := by + simpa [hqi] using hOchild i s + have hdomT' := PositiveCurvatureTileOdometerDomain C'.1.1 T' h' C'.property hO' + have hdomS := PositiveCurvatureTileOdometerDomain C'.1.1 (S i s) (hs i s) + C'.property hOis + have hneT' : T'.cells.Nonempty := nonempty_of_odo _ _ _ C'.property hO' + have hneS : (S i s).cells.Nonempty := by rw [← hcellsEq]; exact hneT' + have hfootEq : FootprintVertices T' = FootprintVertices (S i s) := by + simp only [FootprintVertices, ite_eq_left hneT', ite_eq_left hneS] + rw [hcellsEq] + have hdomEq : (h'.domain : Set GaussianInt) = (hs i s).domain := by + rw [hdomT', hdomS, hfootEq] + refine ⟨q, i, s, S, hs, hq, hq0, hqi, hT, hOchild, hcells, hfoot, + hcent, hdom, hvalue, hcompat, hslope, hcellsEq, hdomEq, ?_⟩ + intro x hx + have hxhs : x ∈ (hs i s).domain := (Set.ext_iff.mp hdomEq x).mp hx + exact (hvalSub x ((Set.ext_iff.mp hdomEq x).mpr hxhs)).symm.trans + (hvalue i s x hxhs) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean b/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean new file mode 100644 index 0000000000..bb1f3b5f2c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean @@ -0,0 +1,496 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn +public import LeanPool.ApollonianSuperharmonic.ConsecutivePatchInterface +public import LeanPool.ApollonianSuperharmonic.ExactPatchBoundaryInterface +public import LeanPool.ApollonianSuperharmonic.FinitePatchTopology +public import LeanPool.ApollonianSuperharmonic.LatticeTileDiskUnionInterface +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification +public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance +public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance + +-- [TABLET NODE: TileT1DiskArea] + +/-! +# TileT1DiskArea + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace DiskAreaGeometry + +private theorem hadjacency : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ a, ∀ b, a ≠ b → cert.modified.plane.adjacent a b → (FootprintEdges + (cert.modified.tile a) ∩ FootprintEdges (cert.modified.tile b)).Nonempty ) := by + classical + intro q cfg C₀ T cert a b hab hadj + exact ((PeriodicTileIntersectionClassification cert.modified).1 a b hab).1.mpr hadj + +private theorem hmodified : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (whole : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (∀ + d ∈ whole.indices, ∃ (rest : FiniteInducedTilePatch cert.modified.plane + cert.modified.tile), rest.indices = whole.indices.erase d ∧ rest.unionTile = + TileCellComplement T (cert.modified.tile d) ∧ Nonempty (ConsecutivePatchInterface + cert.modified.plane cert.modified.tile rest d)) → ((∀ (x : LatticeCell), ∃! a : + PeriodicSubtileIndex, x ∈ (cert.modified.tile a).cells) → ((∀ a, ∀ b, a ≠ b → + cert.modified.plane.adjacent a b → (FootprintEdges (cert.modified.tile a) ∩ + FootprintEdges (cert.modified.tile b)).Nonempty) → ((∀ K : FiniteInducedTilePatch + cert.modified.plane cert.modified.tile, LatticeTile K.unionTile) → (∀ d ∈ + whole.indices, LatticeTile (TileCellComplement T (cert.modified.tile d)) ∧ + TileTouching (TileCellComplement T (cert.modified.tile d)) (cert.modified.tile d))))) + ) := by + classical + intro q cfg C₀ T cert whole hdeletions hindexed hadjacency hdisk d hd + obtain ⟨rest, hrest, hrestTile, ⟨interface⟩⟩ := hdeletions d hd + have hUd := hdisk rest + have hVd := cert.modified.tiles_are_disks d + have hdisjoint : Disjoint rest.unionTile.cells (cert.modified.tile d).cells := by + apply Finset.disjoint_left.mpr + intro z hz hzd + obtain ⟨b, hb, hzb⟩ := (rest.exact_union z).mp hz + have hbd : b = d := (hindexed z).unique hzb hzd + exact interface.exterior (hbd ▸ hb) + have hunion : ∀ z, z ∈ whole.unionTile.cells ↔ + z ∈ rest.unionTile.cells ∨ z ∈ (cert.modified.tile d).cells := by + intro z + rw [whole.exact_union, rest.exact_union] + constructor + · rintro ⟨b, hb, hzb⟩ + by_cases hbd : b = d + · exact Or.inr (hbd ▸ hzb) + · exact Or.inl ⟨b, by simpa [hrest, Finset.mem_erase, hbd] using hb, hzb⟩ + · rintro (⟨b, hb, hzb⟩ | hzd) + · exact ⟨b, Finset.mem_of_mem_erase (hrest ▸ hb), hzb⟩ + · exact ⟨d, hd, hzd⟩ + let k : Fin interface.length := ⟨0, interface.positive⟩ + obtain ⟨hb, hadj⟩ := (interface.neighbors_exact (interface.neighbor k)).mpr ⟨k, rfl⟩ + have hdb : d ≠ interface.neighbor k := by + intro h + exact interface.exterior (h ▸ hb) + obtain ⟨e, hed, heb⟩ := hadjacency d (interface.neighbor k) hdb hadj + have heU : e ∈ FootprintEdges rest.unionTile := by + obtain ⟨z, hz, he⟩ := heb + exact ⟨z, (rest.exact_union z).mpr ⟨interface.neighbor k, hb, hz⟩, he⟩ + obtain ⟨hfoot, ⟨x, y, hpath⟩, hedges, hvertices⟩ := + LatticeTileDiskUnionInterface rest.unionTile (cert.modified.tile d) + whole.unionTile hUd hVd (hdisk whole) hdisjoint hunion ⟨e, heU, hed⟩ + obtain ⟨p, hnodup, hlength, _, _, hverts, hsteps, hpaths⟩ := hpath + have htouch : TileTouching rest.unionTile (cert.modified.tile d) := by + left + refine ⟨(LatticeTileGridStructure _ hUd).1.1, + (LatticeTileGridStructure _ hVd).1.1, hdisjoint, ?_⟩ + rw [hvertices, ← hedges] + exact ⟨p, hnodup, hlength, hverts, hsteps, hpaths⟩ + exact ⟨hrestTile ▸ hUd, hrestTile ▸ htouch⟩ + +private theorem hzero : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ l : SixSubtileLabel, cert.modified.tile ⟨l, 0, 0⟩ = (match l with + | .A => TileCellComplement (cert.P 0 true) cert.O + | .B => cert.P 0 false + | .C => cert.P 1 true + | .D => cert.P 1 false + | .E => cert.P 2 true + | .F => cert.P 2 false) ) := by + classical + intro q cfg C₀ T cert l + rw [cert.modified_tile] + have hz : GaussianTranslation (0 : GaussianInt) = id := by + funext z + exact add_zero z + simp [ModifiedSubtileOccurrenceInterpretation, TileTranslation, hz] + rfl + +private theorem horiginal : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (whole : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), + (whole.indices = {(⟨SixSubtileLabel.A, (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), + (⟨SixSubtileLabel.B, (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), (⟨SixSubtileLabel.C, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), (⟨SixSubtileLabel.D, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.E, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.F, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex)}) → ((∀ d ∈ whole.indices, LatticeTile (TileCellComplement T + (cert.modified.tile d)) ∧ TileTouching (TileCellComplement T (cert.modified.tile d)) + (cert.modified.tile d)) → ((∀ l : SixSubtileLabel, cert.modified.tile ⟨l, 0, 0⟩ = + (match l with + | .A => TileCellComplement (cert.P 0 true) cert.O + | .B => cert.P 0 false + | .C => cert.P 1 true + | .D => cert.P 1 false + | .E => cert.P 2 true + | .F => cert.P 2 false)) → (∀ (i : Fin 3), ∀ (s : Bool), i ≠ 0 ∨ s = false → + LatticeTile + (TileCellComplement T (cert.P i s)) ∧ TileTouching (TileCellComplement T (cert.P i + s)) (cert.P i s)))) ) := by + classical + intro q cfg C₀ T cert whole hindices hmodified hzero i s h + fin_cases i <;> cases s + · simpa [hzero] using hmodified ⟨.B, 0, 0⟩ (by simp [hindices]) + · simp at h + · simpa [hzero] using hmodified ⟨.D, 0, 0⟩ (by simp [hindices]) + · simpa [hzero] using hmodified ⟨.C, 0, 0⟩ (by simp [hindices]) + · simpa [hzero] using hmodified ⟨.F, 0, 0⟩ (by simp [hindices]) + · simpa [hzero] using hmodified ⟨.E, 0, 0⟩ (by simp [hindices]) + +private theorem harea : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (whole : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), + (whole.indices = {(⟨SixSubtileLabel.A, (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), + (⟨SixSubtileLabel.B, (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), (⟨SixSubtileLabel.C, + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), (⟨SixSubtileLabel.D, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.E, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), (⟨SixSubtileLabel.F, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex)}) → ((whole.unionTile = T) → ((∀ (x : LatticeCell), ∃! a : + PeriodicSubtileIndex, x ∈ (cert.modified.tile a).cells) → ((∀ l : SixSubtileLabel, + cert.modified.tile ⟨l, 0, 0⟩ = (match l with + | .A => TileCellComplement (cert.P 0 true) cert.O + | .B => cert.P 0 false + | .C => cert.P 1 true + | .D => cert.P 1 false + | .E => cert.P 2 true + | .F => cert.P 2 false)) → (TileArea T = Int.toNat (q 0).1)))) ) := by + classical + intro q cfg C₀ T cert whole hindices hwhole hindexed hzero + have hcells : whole.indices.biUnion (fun a => (cert.modified.tile a).cells) = + T.cells := by + ext z + simp only [Finset.mem_biUnion] + simpa only [hwhole] using (whole.exact_union z).symm + have hpair : (whole.indices : Set PeriodicSubtileIndex).PairwiseDisjoint + (fun a => (cert.modified.tile a).cells) := by + intro a ha b hb hab + apply Finset.disjoint_left.mpr + intro z hza hzb + exact hab ((hindexed z).unique hza hzb) + have hcard := Finset.card_biUnion hpair + rw [hcells] at hcard + have hsum : T.cells.card = cert.R.card := by + rw [hcard] + simpa [hindices, hzero, TileArea, Nat.add_assoc] using cert.orbit_area + change T.cells.card = _ + rw [hsum, cert.representative_count, cert.child_eq] + exact_mod_cast (Int.natAbs_of_nonneg (le_of_lt C₀.property)).trans + (Int.toNat_of_nonneg (le_of_lt C₀.property)).symm + +private theorem ht : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (u : GaussianInt), (GaussianRealPoint u = ((TileCentroid (cert.P (0 : Fin (3 + : ℕ)) false)).1 + (TileCentroid (cert.P (0 : Fin (3 : ℕ)) false)).2, (TileCentroid + (cert.P (0 : Fin (3 : ℕ)) false)).2 - (TileCentroid (cert.P (0 : Fin (3 : ℕ)) + false)).1)) → ( + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + (t.re : Real) = 2 * (TileCentroid T).1 ∧ (t.im : Real) = 2 * (TileCentroid T).2) ) := by + classical + intro q cfg C₀ T cert u hu w t + have hur := congrArg Prod.fst hu + have hui := congrArg Prod.snd hu + have hc := (cert.outer_occurrence 0 false).2.2 + have hcr := congrArg Prod.fst hc + have hci := congrArg Prod.snd hc + norm_num [GaussianRealPoint] at hur hui hcr hci + simp only [← GaussianInt.intCast_re, ← GaussianInt.intCast_im] at hur hui hcr hci + dsimp [t, w] + push_cast + constructor <;> linarith + +private theorem htau : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ + Function.Involutive tau ) := by + classical + intro q u w t tau z + dsimp [tau] + abel + +private theorem hHcells : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t + let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ + ∀ U, (H U).cells = U.cells.image tau ) := by + classical + intro q u w t H tau U + simp only [H, TileTranslation, TileQuarterTurn, Finset.image_image] + apply Finset.image_congr + intro z hz + apply Zsqrtd.ext <;> simp [Function.comp_def, GaussianTranslation, + GaussianQuarterTurn, tau] <;> ring + +private theorem hHreal : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + ((t.re : Real) = 2 * (TileCentroid T).1 ∧ (t.im : Real) = 2 * (TileCentroid T).2) → ( + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t + ∀ U, TileRealization (H U) = (fun p : Real × Real => (2 * (TileCentroid T).1 - p.1, 2 * + (TileCentroid T).2 - p.2)) '' TileRealization U) ) := by + classical + intro q T u w t ht H U + dsimp only [H] + rw [(TileTranslationFormulas _ t).2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn U)).2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.1, Set.image_image, Set.image_image] + congr 1 + funext p + apply Prod.ext <;> dsimp <;> simp only [ht.1, ht.2] <;> ring + +private theorem hcenter : + (by + classical + exact + (Fin 4 → CircleCoordinates) → ((ProtoTile) → (∀ (U : ProtoTile), ∀ (z : GaussianInt), z ∈ + U.cells ↔ ((z.re : Real) + 1 / 2, (z.im : Real) + 1 / 2) ∈ TileRealization U)) ) := by + classical + intro q T U z + constructor + · intro hz + simp only [TileRealization, Set.mem_iUnion] + refine ⟨z, hz, ?_⟩ + norm_num [ClosedSquareRealization, Set.mem_Icc] + · intro hp + simp only [TileRealization, Set.mem_iUnion] at hp + obtain ⟨b, hb, hbox⟩ := hp + simp only [ClosedSquareRealization, Set.mem_Icc] at hbox + have hr₁ : b.re < z.re + 1 := by + exact_mod_cast (show (b.re : Real) < (z.re : Real) + 1 by linarith [hbox.1.1]) + have hr₂ : z.re < b.re + 1 := by + exact_mod_cast (show (z.re : Real) < (b.re : Real) + 1 by linarith [hbox.2.1]) + have hi₁ : b.im < z.im + 1 := by + exact_mod_cast (show (b.im : Real) < (z.im : Real) + 1 by linarith [hbox.1.2]) + have hi₂ : z.im < b.im + 1 := by + exact_mod_cast (show (z.im : Real) < (b.im : Real) + 1 by linarith [hbox.2.2]) + have hbz : b = z := by apply Zsqrtd.ext <;> omega + exact hbz ▸ hb + +private theorem hreflectCells : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t + (∀ U, TileRealization (H U) = (fun p : Real × Real => (2 * (TileCentroid T).1 - p.1, 2 * + (TileCentroid T).2 - p.2)) '' TileRealization U) → ((∀ (U : ProtoTile), ∀ (z : + GaussianInt), z ∈ U.cells ↔ ((z.re : Real) + 1 / 2, (z.im : Real) + 1 / 2) ∈ + TileRealization U) → (∀ U, ∀ V, CentrallyReflectedAt (TileCentroid T) U V → (H + U).cells = V.cells)) ) := by + classical + intro q T u w t H hHreal hcenter U V hUV + have hreal : TileRealization (H U) = TileRealization V := + (hHreal U).trans hUV.symm + ext z + rw [hcenter, hcenter, hreal] + +private theorem hHminus : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t + let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ + (Function.Involutive tau) → ((∀ U, (H U).cells = U.cells.image tau) → (((H (cert.P 0 + true)).cells = (cert.P 0 false).cells) → ((H (cert.P 0 false)).cells = (cert.P 0 + true).cells))) ) := by + classical + intro q cfg C₀ T cert u w t H tau htau hHcells hHplus + rw [hHcells, ← hHplus, hHcells, Finset.image_image] + simp [htau] + +private theorem hHcomplement : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t + ((H T).cells = T.cells) → (((H (cert.P 0 false)).cells = (cert.P 0 true).cells) → ((H + (TileCellComplement T (cert.P 0 false))).cells = (TileCellComplement T (cert.P 0 + true)).cells)) ) := by + classical + intro q cfg C₀ T cert u w t H hHT hHminus + have hc : H (TileCellComplement T (cert.P 0 false)) = + TileCellComplement (H T) (H (cert.P 0 false)) := by + dsimp only [H] + rw [(TileCellComplementCovariance T (cert.P 0 false) 0).2.1, + (TileCellComplementCovariance (TileQuarterTurn T) + (TileQuarterTurn (cert.P 0 false)) 0).2.1, + (TileCellComplementCovariance _ _ t).1] + rw [hc] + change (H T).cells \ (H (cert.P 0 false)).cells = + T.cells \ (cert.P 0 true).cells + rw [hHT, hHminus] + +end DiskAreaGeometry + +theorem TileT1DiskArea (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (hT : BandPrototile (q 0) T) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + LatticeTile T ∧ TileArea T = Int.toNat (q 0).1 ∧ + ∀ i s, LatticeTile (TileCellComplement T (cert.P i s)) ∧ + TileTouching (TileCellComplement T (cert.P i s)) (cert.P i s) := by +-- BODY + classical + obtain ⟨whole, hindices, hwhole, hA, hdeletions⟩ := + BandOrderedGeneralFinitePatches q cfg C₀ T cert + have hindexed := PeriodicTileIndexedMultiplicityOne cert.modified + have hadjacency := DiskAreaGeometry.hadjacency q cfg C₀ T cert + have hdisk : ∀ K : FiniteInducedTilePatch + cert.modified.plane cert.modified.tile, LatticeTile K.unionTile := + FinitePatchTopology cert.modified.plane cert.modified.tile + (PeriodicTileMultiplicityOne cert.modified) hindexed hadjacency + have hTd : LatticeTile T := hwhole ▸ hdisk whole + have hmodified := DiskAreaGeometry.hmodified q cfg C₀ T cert whole hdeletions hindexed + hadjacency hdisk + have hzero := DiskAreaGeometry.hzero q cfg C₀ T cert + have horiginal := DiskAreaGeometry.horiginal q cfg C₀ T cert whole hindices hmodified hzero + have harea := DiskAreaGeometry.harea q cfg C₀ T cert whole hindices hwhole hindexed hzero + refine ⟨hTd, harea, ?_⟩ + intro i s + by_cases h : i ≠ 0 ∨ s = false + · exact horiginal i s h + · have hi : i = 0 := by tauto + have hs : s = true := by cases s <;> simp_all + subst i + subst s + obtain ⟨u, hu, _⟩ := QuarterTurnSymmetricCenteredTransport + (cert.P 0 false) (cert.parent_quarter_turn 0 false) + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + have ht := DiskAreaGeometry.ht q cfg C₀ T cert u hu + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t + let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ + have htau := DiskAreaGeometry.htau q u + have hHcells := DiskAreaGeometry.hHcells q u + have hHreal := DiskAreaGeometry.hHreal q T u ht + have hcenter := DiskAreaGeometry.hcenter q T + have hreflectCells := DiskAreaGeometry.hreflectCells q T u hHreal hcenter + have hHT : (H T).cells = T.cells := + hreflectCells T T (BandPrototileCentralSymmetry (q 0) T hT) + have hsigned := BandSignedOccurrenceHalfTurn q (TileCentroid T) cert.P + (fun i s => (cert.outer_occurrence i s).1) + (fun i s => (cert.outer_occurrence i s).2.2) 0 + have hHplus : (H (cert.P 0 true)).cells = (cert.P 0 false).cells := + hreflectCells _ _ hsigned.2.2.2.2.2 + have hHminus : (H (cert.P 0 false)).cells = (cert.P 0 true).cells := DiskAreaGeometry.hHminus + q cfg C₀ T cert u htau hHcells hHplus + have hHcomplement : + (H (TileCellComplement T (cert.P 0 false))).cells = + (TileCellComplement T (cert.P 0 true)).cells := DiskAreaGeometry.hHcomplement q cfg C₀ + T cert u hHT hHminus + obtain ⟨hminusDisk, hminusTouch⟩ := horiginal 0 false (Or.inr rfl) + have hHDisk : LatticeTile (H (TileCellComplement T (cert.P 0 false))) := + (TileDiskAreaCovariance _ t).1.mp + ((TileDiskAreaCovariance _ 0).2.1.mp + ((TileDiskAreaCovariance _ 0).2.1.mp hminusDisk)) + have hHTouch : TileTouching (H (TileCellComplement T (cert.P 0 false))) + (H (cert.P 0 false)) := + (TileTouchingCovariance _ _ t).1.mp + ((TileTouchingCovariance _ _ 0).2.1.mp + ((TileTouchingCovariance _ _ 0).2.1.mp hminusTouch)) + have hHcompNonempty := (LatticeTileGridStructure _ hHDisk).1.1 + have hHminusDisk : LatticeTile (H (cert.P 0 false)) := + (TileDiskAreaCovariance _ t).1.mp + ((TileDiskAreaCovariance _ 0).2.1.mp + ((TileDiskAreaCovariance _ 0).2.1.mp (cert.parent_lattice 0 false))) + have hHminusNonempty := (LatticeTileGridStructure _ hHminusDisk).1.1 + have hcompObs := ProtoTileObservableExtensionality _ _ hHcomplement + (fun h => False.elim (Finset.nonempty_iff_ne_empty.mp hHcompNonempty h)) + have hminusObs := ProtoTileObservableExtensionality _ _ hHminus + (fun h => False.elim (Finset.nonempty_iff_ne_empty.mp hHminusNonempty h)) + constructor + · change TopologicalDisk (TileRealization _) + rw [← hcompObs.2.2.2.1] + exact hHDisk + · unfold TileTouching at hHTouch ⊢ + rcases hHTouch with htouch | hdegenerate | hdegenerate + · left + simpa only [hHcomplement, hHminus, hcompObs.2.1, hcompObs.2.2.1, + hminusObs.2.1, hminusObs.2.2.1] using htouch + · exact False.elim (Finset.nonempty_iff_ne_empty.mp hHcompNonempty hdegenerate.1) + · exact False.elim (Finset.nonempty_iff_ne_empty.mp hHminusNonempty hdegenerate.1) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean b/LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean new file mode 100644 index 0000000000..49dc91cc76 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean @@ -0,0 +1,656 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandTwelveParentSurround +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.UniqueBoundedGridComplementComponent + +-- [TABLET NODE: TileT2QuarterTurn] + +/-! +# TileT2QuarterTurn + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace QuarterTurnTileGeometry + +private theorem turn_back : + (by + classical + exact + ∀ (u : GaussianInt), + let turn (x : GaussianInt) : GaussianInt := + ⟨-x.im - 1 + u.re, x.re + u.im⟩ + let back (x : GaussianInt) : GaussianInt := + ⟨x.im - u.im, -x.re - 1 + u.re⟩ + ∀ (x : GaussianInt), back (turn x) = x ) := by + classical + intro u turn back x + rcases x with ⟨a, b⟩ + simp [turn, back] + ring + +private theorem back_turn : + (by + classical + exact + ∀ (u : GaussianInt), + let turn (x : GaussianInt) : GaussianInt := + ⟨-x.im - 1 + u.re, x.re + u.im⟩ + let back (x : GaussianInt) : GaussianInt := + ⟨x.im - u.im, -x.re - 1 + u.re⟩ + ∀ (x : GaussianInt), turn (back x) = x ) := by + classical + intro u turn back x + rcases x with ⟨a, b⟩ + simp [turn, back] + ring + +private theorem hRingImage : + (by + classical + exact + ∀ (ring : ProtoTile), ∀ (u : GaussianInt), ((TileTranslation (TileQuarterTurn ring) + u).cells = ring.cells) → ( + let turn (x : GaussianInt) : GaussianInt := + ⟨-x.im - 1 + u.re, x.re + u.im⟩ + (ring.cells.image turn : Set GaussianInt) = (ring.cells : Set GaussianInt)) ) := by + classical + intro ring u hRingCells turn + have h := hRingCells + rw [TileTranslationFormulas (TileQuarterTurn ring) u |>.1, + TileQuarterTurnFormulas ring |>.1] at h + have hfun : ∀ x : GaussianInt, + GaussianTranslation u (GaussianQuarterTurn x - 1) = turn x := by + intro x + rcases x with ⟨a, b⟩ + apply Zsqrtd.ext_iff.mpr; + simp [GaussianTranslation, GaussianQuarterTurn, turn] + have hf : (GaussianTranslation u) ∘ (fun x => GaussianQuarterTurn x - 1) = turn := by + funext x + exact hfun x + rw [Finset.image_image, hf] at h + exact congrArg (fun s : Finset GaussianInt => (s : Set GaussianInt)) h + +private theorem turn_add : + (by + classical + exact + ∀ (u : GaussianInt), + let turn (x : GaussianInt) : GaussianInt := + ⟨-x.im - 1 + u.re, x.re + u.im⟩ + ∀ (x : GaussianInt), ∀ (d : GaussianInt), turn (x + d) = turn x + ⟨-d.im, d.re⟩ ) := by + classical + intro u turn x d + rcases x with ⟨a, b⟩ + rcases d with ⟨c, e⟩ + apply Zsqrtd.ext_iff.mpr + constructor <;> simp [turn] <;> abel + +private theorem back_add : + (by + classical + exact + ∀ (u : GaussianInt), + let back (x : GaussianInt) : GaussianInt := + ⟨x.im - u.im, -x.re - 1 + u.re⟩ + ∀ (x : GaussianInt), ∀ (d : GaussianInt), back (x + d) = back x + ⟨d.im, -d.re⟩ ) := by + classical + intro u back x d + rcases x with ⟨a, b⟩ + rcases d with ⟨c, e⟩ + apply Zsqrtd.ext_iff.mpr + constructor <;> simp [back] <;> abel + +private theorem turn_neighbor : + (by + classical + exact + ∀ (u : GaussianInt), + let turn (x : GaussianInt) : GaussianInt := + ⟨-x.im - 1 + u.re, x.re + u.im⟩ + ∀ (a : GaussianInt), ∀ (b : GaussianInt), (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a + - ⟨0, 1⟩) → (turn b = turn a + ⟨0, 1⟩ ∨ turn b = turn a - ⟨0, 1⟩ ∨ turn b = turn a - + 1 ∨ turn b = turn a + 1) ) := by + classical + intro u turn a b h + rcases h with h | h | h | h + · subst b; left; rcases a with ⟨a, c⟩ + apply Zsqrtd.ext_iff.mpr; constructor <;> simp [turn]; ring + · subst b; right; left; rcases a with ⟨a, c⟩ + apply Zsqrtd.ext_iff.mpr; constructor <;> simp [turn]; ring + · subst b; right; right; left; rcases a with ⟨a, c⟩ + apply Zsqrtd.ext_iff.mpr; constructor <;> simp [turn]; ring + · subst b; right; right; right; rcases a with ⟨a, c⟩ + apply Zsqrtd.ext_iff.mpr; constructor <;> simp [turn]; ring + +private theorem back_neighbor : + (by + classical + exact + ∀ (u : GaussianInt), + let back (x : GaussianInt) : GaussianInt := + ⟨x.im - u.im, -x.re - 1 + u.re⟩ + ∀ (a : GaussianInt), ∀ (b : GaussianInt), (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a + - ⟨0, 1⟩) → (back b = back a - ⟨0, 1⟩ ∨ back b = back a + ⟨0, 1⟩ ∨ back b = back a + + 1 ∨ back b = back a - 1) ) := by + classical + intro u back a b h + rcases h with h | h | h | h + · subst b; left; rcases a with ⟨a, c⟩ + apply Zsqrtd.ext_iff.mpr; constructor <;> simp [back]; ring + · subst b; right; left; rcases a with ⟨a, c⟩ + apply Zsqrtd.ext_iff.mpr; constructor <;> simp [back]; ring + · subst b; right; right; left; rcases a with ⟨a, c⟩ + apply Zsqrtd.ext_iff.mpr; constructor <;> simp [back]; ring + · subst b; right; right; right; rcases a with ⟨a, c⟩ + apply Zsqrtd.ext_iff.mpr; constructor <;> simp [back]; ring + +private theorem hDcomp : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (ring : ProtoTile), ∀ (u : GaussianInt), + let turn (x : GaussianInt) : GaussianInt := + ⟨-x.im - 1 + u.re, x.re + u.im⟩ + let back (x : GaussianInt) : GaussianInt := + ⟨x.im - u.im, -x.re - 1 + u.re⟩ + (∀ (x : GaussianInt), back (turn x) = x) → (((ring.cells.image turn : Set GaussianInt) = + (ring.cells : Set GaussianInt)) → (((T.cells : Set GaussianInt) ⊆ (ring.cells : Set + GaussianInt)ᶜ) → ( + let D : Set GaussianInt := turn '' (T.cells : Set GaussianInt) + D ⊆ (ring.cells : Set GaussianInt)ᶜ))) ) := by + classical + intro T ring u turn back turn_back hRingImage hTComp D x hx + rcases hx with ⟨y, hy, rfl⟩ + intro hxs + have hxs' : turn y ∈ (ring.cells.image turn : Set GaussianInt) := by + rw [hRingImage] + exact hxs + change turn y ∈ ring.cells.image turn at hxs' + rcases Finset.mem_image.mp hxs' with ⟨z, hz, hzy⟩ + have hzy' : z = y := by + apply_fun back at hzy + simpa [back_turn, turn_back] using hzy + exact hTComp hy (by simpa [hzy'] using hz) + +private theorem hDConnected : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), + let turn (x : GaussianInt) : GaussianInt := + ⟨-x.im - 1 + u.re, x.re + u.im⟩ + let back (x : GaussianInt) : GaussianInt := + ⟨x.im - u.im, -x.re - 1 + u.re⟩ + (∀ (x : GaussianInt), back (turn x) = x) → ((∀ (x : GaussianInt), turn (back x) = x) → ( + let gridConnected := fun S : Set GaussianInt => + S.Nonempty ∧ ∀ x ∈ S, ∀ y ∈ S, ∃ p : List GaussianInt, + p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ S) ∧ + ∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ + b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ + (gridConnected (T.cells : Set GaussianInt)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), + (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → (turn b = turn a + ⟨0, 1⟩ + ∨ turn b = turn a - ⟨0, 1⟩ ∨ turn b = turn a - 1 ∨ turn b = turn a + 1)) → ( + let D : Set GaussianInt := turn '' (T.cells : Set GaussianInt) + gridConnected D)))) ) := by + classical + intro T u turn back turn_back back_turn gridConnected hTConnected turn_neighbor D + constructor + · rcases hTConnected.1 with ⟨x, hx⟩ + exact ⟨turn x, ⟨x, hx, rfl⟩⟩ + · intro x hx y hy + rcases hx with ⟨x₀, hx₀, rfl⟩ + rcases hy with ⟨y₀, hy₀, rfl⟩ + rcases hTConnected.2 x₀ hx₀ y₀ hy₀ with ⟨p, hp, hlast, hmem, hadj⟩ + refine ⟨p.map turn, ?_, ?_, ?_, ?_⟩ + · simpa using congrArg (Option.map turn) hp + · simpa using congrArg (Option.map turn) hlast + · intro z hz + simp only [List.mem_map] at hz + rcases hz with ⟨w, hw, rfl⟩ + exact ⟨w, hmem w hw, rfl⟩ + · intro a b l₁ l₂ he + have he' : p = l₁.map back ++ back a :: back b :: l₂.map back := by + have hh := congrArg (List.map back) he + simpa [List.map_append, Function.comp_def, turn_back] using hh + have hadj' := hadj (back a) (back b) (l₁.map back) (l₂.map back) he' + rcases turn_neighbor (back a) (back b) hadj' with h | h | h | h + · exact Or.inr (Or.inr (Or.inl (by simpa [back_turn, turn_back] using h))) + · exact Or.inr (Or.inr (Or.inr (by simpa [back_turn, turn_back] using h))) + · exact Or.inr (Or.inl (by simpa [back_turn, turn_back] using h)) + · exact Or.inl (by simpa [back_turn, turn_back] using h) + +private theorem mapBackConnected : + (by + classical + exact + ∀ (u : GaussianInt), + let turn (x : GaussianInt) : GaussianInt := + ⟨-x.im - 1 + u.re, x.re + u.im⟩ + let back (x : GaussianInt) : GaussianInt := + ⟨x.im - u.im, -x.re - 1 + u.re⟩ + (∀ (x : GaussianInt), back (turn x) = x) → ((∀ (x : GaussianInt), turn (back x) = x) → ( + let gridConnected := fun S : Set GaussianInt => + S.Nonempty ∧ ∀ x ∈ S, ∀ y ∈ S, ∃ p : List GaussianInt, + p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ S) ∧ + ∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ + b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ + (∀ (a : GaussianInt), ∀ (b : GaussianInt), (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = + a - ⟨0, 1⟩) → (back b = back a - ⟨0, 1⟩ ∨ back b = back a + ⟨0, 1⟩ ∨ back b = back a + + 1 ∨ back b = back a - 1)) → (∀ (S : Set GaussianInt), (gridConnected S) → + (gridConnected (S.image back))))) ) := by + classical + intro u turn back turn_back back_turn gridConnected back_neighbor S hS + constructor + · rcases hS.1 with ⟨x, hx⟩ + exact ⟨back x, ⟨x, hx, rfl⟩⟩ + · intro x hx y hy + rcases hx with ⟨x₀, hx₀, rfl⟩ + rcases hy with ⟨y₀, hy₀, rfl⟩ + rcases hS.2 x₀ hx₀ y₀ hy₀ with ⟨p, hp, hlast, hmem, hadj⟩ + refine ⟨p.map back, ?_, ?_, ?_, ?_⟩ + · simpa using congrArg (Option.map back) hp + · simpa using congrArg (Option.map back) hlast + · intro z hz + simp only [List.mem_map] at hz + rcases hz with ⟨w, hw, rfl⟩ + exact ⟨w, hmem w hw, rfl⟩ + · intro a b l₁ l₂ he + have he' : p = l₁.map turn ++ turn a :: turn b :: l₂.map turn := by + have hh := congrArg (List.map turn) he + simpa [List.map_append, Function.comp_def, back_turn] using hh + have hadj' := hadj (turn a) (turn b) (l₁.map turn) (l₂.map turn) he' + rcases back_neighbor (turn a) (turn b) hadj' with h | h | h | h + · exact Or.inr (Or.inr (Or.inr (by simpa [back_turn, turn_back] using h))) + · exact Or.inr (Or.inr (Or.inl (by simpa [back_turn, turn_back] using h))) + · exact Or.inl (by simpa [back_turn, turn_back] using h) + · exact Or.inr (Or.inl (by simpa [back_turn, turn_back] using h)) + +private theorem hDmax : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (ring : ProtoTile), ((↑T.cells : Set GaussianInt).Finite ∧ (↑T.cells + : Set GaussianInt) ⊆ (↑ring.cells : Set GaussianInt)ᶜ ∧ ((↑T.cells : Set + GaussianInt).Nonempty ∧ ∀ x ∈ (↑T.cells : Set GaussianInt), ∀ y ∈ (↑T.cells : Set + GaussianInt), ∃ (p : List GaussianInt), p.head? = some x ∧ p.getLast? = some y ∧ (∀ z + ∈ p, z ∈ (↑T.cells : Set GaussianInt)) ∧ ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ + (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ → b = a + + (1 : GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + (⟨(0 : ℤ), (1 : ℤ)⟩ : + GaussianInt) ∨ b = a - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∧ (∀ (D : Set + GaussianInt), (D.Nonempty ∧ ∀ x ∈ D, ∀ y ∈ D, ∃ (p : List GaussianInt), p.head? = + some x ∧ p.getLast? = some y ∧ (∀ z ∈ p, z ∈ D) ∧ ∀ (a : GaussianInt), ∀ (b : + GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), p = l₁ ++ a :: b + :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ∨ b = a - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → (↑T.cells : Set + GaussianInt) ⊆ D → D ⊆ (↑ring.cells : Set GaussianInt)ᶜ → D = (↑T.cells : Set + GaussianInt)) ∧ ∀ (D : Set GaussianInt), D.Finite → D ⊆ (↑ring.cells : Set + GaussianInt)ᶜ → (D.Nonempty ∧ ∀ x ∈ D, ∀ y ∈ D, ∃ (p : List GaussianInt), p.head? = + some x ∧ p.getLast? = some y ∧ (∀ z ∈ p, z ∈ D) ∧ ∀ (a : GaussianInt), ∀ (b : + GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), p = l₁ ++ a :: b + :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ∨ b = a - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → (∀ (E : Set + GaussianInt), (E.Nonempty ∧ ∀ x ∈ E, ∀ y ∈ E, ∃ (p : List GaussianInt), p.head? = + some x ∧ p.getLast? = some y ∧ (∀ z ∈ p, z ∈ E) ∧ ∀ (a : GaussianInt), ∀ (b : + GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), p = l₁ ++ a :: b + :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + (⟨(0 : ℤ), (1 + : ℤ)⟩ : GaussianInt) ∨ b = a - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → D ⊆ E → E ⊆ + (↑ring.cells : Set GaussianInt)ᶜ → E = D) → D = (↑T.cells : Set GaussianInt)) → (∀ (u + : GaussianInt), + let turn (x : GaussianInt) : GaussianInt := + ⟨-x.im - 1 + u.re, x.re + u.im⟩ + let back (x : GaussianInt) : GaussianInt := + ⟨x.im - u.im, -x.re - 1 + u.re⟩ + (∀ (x : GaussianInt), back (turn x) = x) → ((∀ (x : GaussianInt), turn (back x) = x) → + (((ring.cells.image turn : Set GaussianInt) = (ring.cells : Set GaussianInt)) → ( + let gridConnected := fun S : Set GaussianInt => + S.Nonempty ∧ ∀ x ∈ S, ∀ y ∈ S, ∃ p : List GaussianInt, + p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ S) ∧ + ∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ + b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ + let D : Set GaussianInt := turn '' (T.cells : Set GaussianInt) + (∀ (S : Set GaussianInt), (gridConnected S) → (gridConnected (S.image back))) → (∀ E : + Set GaussianInt, gridConnected E → D ⊆ E → E ⊆ (ring.cells : Set GaussianInt)ᶜ → E = + D))))) ) := by + classical + intro T ring hUnique u turn back turn_back back_turn hRingImage gridConnected D + mapBackConnected E hE hDE hEcomp + let E' : Set GaussianInt := E.image back + have hEconn : gridConnected E' := mapBackConnected E hE + have hEcomp' : E' ⊆ (ring.cells : Set GaussianInt)ᶜ := by + intro x hx hxr + rcases hx with ⟨y, hy, rfl⟩ + have htr : turn (back y) ∈ (ring.cells : Set GaussianInt) := by + rw [← hRingImage] + exact Finset.mem_image.mpr ⟨back y, hxr, rfl⟩ + apply hEcomp hy + simpa [back_turn] using htr + have hTsub : (T.cells : Set GaussianInt) ⊆ E' := by + intro x hx + have htx : turn x ∈ D := by + change turn x ∈ turn '' (T.cells : Set GaussianInt) + exact ⟨x, hx, rfl⟩ + have hex : turn x ∈ E := hDE htx + exact ⟨turn x, hex, by simp [turn_back]⟩ + have hEq : E' = (T.cells : Set GaussianInt) := + hUnique.2.2.2.1 E' hEconn hTsub hEcomp' + ext x + constructor + · intro hx + have hx' : back x ∈ E' := ⟨x, hx, rfl⟩ + have hb : back x ∈ (T.cells : Set GaussianInt) := by rw [← hEq]; exact hx' + exact ⟨back x, hb, by simp [back_turn]⟩ + · intro hx + exact hDE hx + +private theorem hCells : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), + let turn (x : GaussianInt) : GaussianInt := + ⟨-x.im - 1 + u.re, x.re + u.im⟩ + let D : Set GaussianInt := turn '' (T.cells : Set GaussianInt) + (D = (T.cells : Set GaussianInt)) → ((TileTranslation (TileQuarterTurn T) u).cells = + T.cells) ) := by + classical + intro T u turn D hD_eq + rw [TileTranslationFormulas (TileQuarterTurn T) u |>.1, + TileQuarterTurnFormulas T |>.1] + have hfin : T.cells.image turn = T.cells := by + apply Finset.ext + intro x + have hx := Set.ext_iff.mp hD_eq x + change x ∈ turn '' (T.cells : Set GaussianInt) ↔ x ∈ (T.cells : Set GaussianInt) at hx + simpa using hx + rw [Finset.image_image] + have hfun : (GaussianTranslation u) ∘ (fun x => GaussianQuarterTurn x - 1) = turn := by + funext x + rcases x with ⟨a, b⟩ + apply Zsqrtd.ext_iff.mpr; simp [GaussianTranslation, GaussianQuarterTurn, turn] + rw [hfun, hfin] + +private theorem hcent : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), ((TileTranslation (TileQuarterTurn T) u).cells = + T.cells) → ((Finset.Nonempty T.cells) → (TileCentroid (TileTranslation + (TileQuarterTurn T) u) = TileCentroid T)) ) := by + classical + intro T u hCells hne + simp [TileCentroid, hne, hCells] + +private theorem hu_re : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), (TileCentroid (TileTranslation (TileQuarterTurn + T) u) = TileCentroid T) → ((u.re : Real) = (TileCentroid T).1 + (TileCentroid T).2) ) + := by + classical + intro T u hcent + have h := congrArg Prod.fst hcent + rw [TileTranslationFormulas (TileQuarterTurn T) u |>.2.2.2.2.1] at h + rw [TileQuarterTurnFormulas T |>.2.2.2.2.1] at h + dsimp at h + linarith + +private theorem hu_im : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), (TileCentroid (TileTranslation (TileQuarterTurn + T) u) = TileCentroid T) → ((u.im : Real) = (TileCentroid T).2 - (TileCentroid T).1) ) + := by + classical + intro T u hcent + have h := congrArg Prod.snd hcent + rw [TileTranslationFormulas (TileQuarterTurn T) u |>.2.2.2.2.1] at h + rw [TileQuarterTurnFormulas T |>.2.2.2.2.1] at h + dsimp at h + linarith + +private theorem hreal : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), ((TileTranslation (TileQuarterTurn T) u).cells = + T.cells) → (TileRealization (TileTranslation (TileQuarterTurn T) u) = TileRealization + T) ) := by + classical + intro T u hCells + rw [TileRealization, hCells, TileRealization] + +private theorem hset : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), + let rotate (p : Real × Real) : Real × Real := + (-(p.2) + (u.re : Real), p.1 + (u.im : Real)) + (TileRealization (TileTranslation (TileQuarterTurn T) u) = TileRealization T) → + (TileRealization T = rotate '' TileRealization T) ) := by + classical + intro T u rotate hreal + have hf : (fun p : Real × Real => + ((-p.2, p.1).1 + (u.re : Real), (-p.2, p.1).2 + (u.im : Real))) = + rotate := by + funext p + simp [rotate] + calc + TileRealization T = TileRealization (TileTranslation (TileQuarterTurn T) u) := hreal.symm + _ = (fun p : Real × Real => (p.1 + (u.re : Real), p.2 + (u.im : Real))) '' + ((fun p : Real × Real => (-p.2, p.1)) '' TileRealization T) := by + rw [TileTranslationFormulas (TileQuarterTurn T) u |>.2.2.2.1, + TileQuarterTurnFormulas T |>.2.2.2.1] + _ = rotate '' TileRealization T := by + rw [Set.image_image, hf] + +private theorem hrotate : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), ((u.re : Real) = (TileCentroid T).1 + + (TileCentroid T).2) → (((u.im : Real) = (TileCentroid T).2 - (TileCentroid T).1) → ( + let rotate (p : Real × Real) : Real × Real := + (-(p.2) + (u.re : Real), p.1 + (u.im : Real)) + ∀ (p : Real × Real), rotate p = ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), + (TileCentroid T).2 + (p.1 - (TileCentroid T).1)))) ) := by + classical + intro T u hu_re hu_im rotate p + apply Prod.ext <;> dsimp [rotate] + · rw [hu_re] + ring + · rw [hu_im] + ring + +private theorem hleft : + (by + classical + exact + ∀ (u : GaussianInt), + let rotate (p : Real × Real) : Real × Real := + (-(p.2) + (u.re : Real), p.1 + (u.im : Real)) + let unrotate (p : Real × Real) : Real × Real := + (p.2 - (u.im : Real), -p.1 + (u.re : Real)) + ∀ (p : Real × Real), unrotate (rotate p) = p ) := by + classical + intro u rotate unrotate p + apply Prod.ext <;> dsimp [rotate, unrotate] + · linarith [hu_re, hu_im] + · linarith [hu_re, hu_im] + +private theorem hright : + (by + classical + exact + ∀ (u : GaussianInt), + let rotate (p : Real × Real) : Real × Real := + (-(p.2) + (u.re : Real), p.1 + (u.im : Real)) + let unrotate (p : Real × Real) : Real × Real := + (p.2 - (u.im : Real), -p.1 + (u.re : Real)) + ∀ (p : Real × Real), rotate (unrotate p) = p ) := by + classical + intro u rotate unrotate p + apply Prod.ext <;> dsimp [rotate, unrotate] + · linarith [hu_re, hu_im] + · linarith [hu_re, hu_im] + +private theorem hforward : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), + let rotate (p : Real × Real) : Real × Real := + (-(p.2) + (u.re : Real), p.1 + (u.im : Real)) + (TileRealization T = rotate '' TileRealization T) → (∀ (p : Real × Real), (p ∈ + TileRealization T) → (rotate p ∈ TileRealization T)) ) := by + classical + intro T u rotate hset p hp + rw [hset] + exact ⟨p, hp, rfl⟩ + +private theorem hback : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (u : GaussianInt), + let rotate (p : Real × Real) : Real × Real := + (-(p.2) + (u.re : Real), p.1 + (u.im : Real)) + (TileRealization T = rotate '' TileRealization T) → ( + let unrotate (p : Real × Real) : Real × Real := + (p.2 - (u.im : Real), -p.1 + (u.re : Real)) + (∀ (p : Real × Real), unrotate (rotate p) = p) → (∀ (p : Real × Real), (p ∈ + TileRealization T) → (unrotate p ∈ TileRealization T))) ) := by + classical + intro T u rotate hset unrotate hleft p hp + have hp' : p ∈ rotate '' TileRealization T := hset ▸ hp + rcases hp' with ⟨z, hz, hzp⟩ + have heq : unrotate p = z := by + rw [← hzp] + exact hleft z + rw [heq] + exact hz + +end QuarterTurnTileGeometry + +theorem TileT2QuarterTurn (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) : + QuarterTurnSymmetric T := by +-- BODY + classical + obtain ⟨R, ring, h00, h01, h02, h03, h10, h11, h12, h13, + h20, h21, h22, h23, hUnion, hRing, hUnique⟩ := + BandTwelveParentSurround q cfg C₀ T cert + obtain ⟨u, hu, hRingCells, hRingEmpty, hRingVertices, hRingCentroid⟩ := + QuarterTurnSymmetricCenteredTransport ring hRing + let turn (x : GaussianInt) : GaussianInt := + ⟨-x.im - 1 + u.re, x.re + u.im⟩ + let back (x : GaussianInt) : GaussianInt := + ⟨x.im - u.im, -x.re - 1 + u.re⟩ + have turn_back (x : GaussianInt) := QuarterTurnTileGeometry.turn_back u x + have back_turn (x : GaussianInt) := QuarterTurnTileGeometry.back_turn u x + have hRingImage := QuarterTurnTileGeometry.hRingImage ring u hRingCells + have turn_add (x d : GaussianInt) := QuarterTurnTileGeometry.turn_add u x d + have back_add (x d : GaussianInt) := QuarterTurnTileGeometry.back_add u x d + dsimp [UniqueBoundedGridComplementComponent] at hUnique + let gridConnected := fun S : Set GaussianInt => + S.Nonempty ∧ ∀ x ∈ S, ∀ y ∈ S, ∃ p : List GaussianInt, + p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ S) ∧ + ∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ + b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ + have hTFinite : (T.cells : Set GaussianInt).Finite := hUnique.1 + have hTComp : (T.cells : Set GaussianInt) ⊆ (ring.cells : Set GaussianInt)ᶜ := hUnique.2.1 + have hTConnected : gridConnected (T.cells : Set GaussianInt) := hUnique.2.2.1 + have turn_neighbor (a b : GaussianInt) + (h : b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) := + QuarterTurnTileGeometry.turn_neighbor u a b h + have back_neighbor (a b : GaussianInt) + (h : b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) := + QuarterTurnTileGeometry.back_neighbor u a b h + let D : Set GaussianInt := turn '' (T.cells : Set GaussianInt) + have hDfinite : D.Finite := by + simpa [D] using hTFinite.image turn + have hDcomp := QuarterTurnTileGeometry.hDcomp T ring u turn_back hRingImage hTComp + have hDConnected := QuarterTurnTileGeometry.hDConnected T u turn_back back_turn hTConnected + turn_neighbor + have mapBackConnected (S : Set GaussianInt) (hS : gridConnected S) := + QuarterTurnTileGeometry.mapBackConnected u turn_back back_turn back_neighbor S hS + have hDmax := QuarterTurnTileGeometry.hDmax T ring hUnique u turn_back back_turn hRingImage + mapBackConnected + have hD_eq : D = (T.cells : Set GaussianInt) := + hUnique.2.2.2.2 D hDfinite hDcomp hDConnected hDmax + have hCells := QuarterTurnTileGeometry.hCells T u hD_eq + by_cases hne : T.cells.Nonempty + · have hcent := QuarterTurnTileGeometry.hcent T u hCells hne + have hu_re := QuarterTurnTileGeometry.hu_re T u hcent + have hu_im := QuarterTurnTileGeometry.hu_im T u hcent + let rotate (p : Real × Real) : Real × Real := + (-(p.2) + (u.re : Real), p.1 + (u.im : Real)) + have hreal := QuarterTurnTileGeometry.hreal T u hCells + have hset := QuarterTurnTileGeometry.hset T u hreal + let unrotate (p : Real × Real) : Real × Real := + (p.2 - (u.im : Real), -p.1 + (u.re : Real)) + have hrotate (p : Real × Real) : + rotate p = ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), + (TileCentroid T).2 + (p.1 - (TileCentroid T).1)) := QuarterTurnTileGeometry.hrotate T u + hu_re hu_im p + have hleft (p : Real × Real) := QuarterTurnTileGeometry.hleft u p + have hright (p : Real × Real) := QuarterTurnTileGeometry.hright u p + have hforward (p : Real × Real) (hp : p ∈ TileRealization T) := + QuarterTurnTileGeometry.hforward T u hset p hp + have hback (p : Real × Real) (hp : p ∈ TileRealization T) := QuarterTurnTileGeometry.hback T + u hset hleft p hp + intro p + change p ∈ TileRealization T ↔ + ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), + (TileCentroid T).2 + (p.1 - (TileCentroid T).1)) ∈ TileRealization T + rw [← hrotate] + constructor + · intro hp + exact hforward p hp + · intro hp + have := hback (rotate p) hp + convert this using 1 + exact (hleft p).symm + · have hzero : T.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hne + intro p + simp [TileRealization, hzero] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileT3TranslateTouching.lean b/LeanPool/ApollonianSuperharmonic/TileT3TranslateTouching.lean new file mode 100644 index 0000000000..10aeaaae45 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileT3TranslateTouching.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells +public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation +public import LeanPool.ApollonianSuperharmonic.TileT1DiskArea +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleLatticeTouching +public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance + +-- [TABLET NODE: TileT3TranslateTouching] + +/-! +# TileT3TranslateTouching + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TileT3TranslateTouching (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) + (hcurrentT2 : QuarterTurnSymmetric T) (i : Fin 3) : + TouchingTriple T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) + (TileTranslation T (-BandVectors.1 (q ((i + 1).succ)) (q 0))) := by +-- BODY + classical + have hroot : BandPrototile (q 0) T := by + apply BandPrototile.decompose cfg.proper + · intro j s + exact (cert.outer_occurrence j s).1 + · exact cert.outer_union + · intro j s + exact (cert.outer_occurrence j s).2.1 + · intro j s + exact (cert.outer_occurrence j s).2.2 + have hdisk := (TileT1DiskArea q cfg C₀ T hroot cert).1 + have hdisk₁ : LatticeTile + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) := + (TileDiskAreaCovariance T (BandVectors.1 (q i.succ) (q 0))).1.mp hdisk + have hdisk₂ : LatticeTile + (TileTranslation T (-BandVectors.1 (q ((i + 1).succ)) (q 0))) := + (TileDiskAreaCovariance T (-BandVectors.1 (q ((i + 1).succ)) (q 0))).1.mp hdisk + have hblocks := (BandOrderedGeneralPeriodicBlockCells q cfg C₀ T cert).2 + obtain ⟨g, _, hcenter, _⟩ := QuarterTurnSymmetricCenteredTransport T hcurrentT2 + have hcell (a x : GaussianInt) (hx : x ∈ (TileTranslation T a).cells) : + GaussianQuarterTurn x - 1 + g ∈ + (TileTranslation T (GaussianQuarterTurn a)).cells := by + rw [(TileTranslationFormulas T a).1] at hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_image.mp hx + have hy' : GaussianQuarterTurn y - 1 + g ∈ T.cells := by + rw [← hcenter, (TileTranslationFormulas (TileQuarterTurn T) g).1] + apply Finset.mem_image.mpr + refine ⟨GaussianQuarterTurn y - 1, ?_, rfl⟩ + rw [(TileQuarterTurnFormulas T).1] + exact Finset.mem_image.mpr ⟨y, hy, rfl⟩ + rw [(TileTranslationFormulas T (GaussianQuarterTurn a)).1] + refine Finset.mem_image.mpr ⟨GaussianQuarterTurn y - 1 + g, hy', ?_⟩ + ext <;> simp [GaussianTranslation, GaussianQuarterTurn] <;> ring + have htransfer (a b : GaussianInt) + (h : Disjoint (TileTranslation T (GaussianQuarterTurn a)).cells + (TileTranslation T (GaussianQuarterTurn b)).cells) : + Disjoint (TileTranslation T a).cells (TileTranslation T b).cells := by + apply Finset.disjoint_left.mpr + intro x hx hy + exact Finset.disjoint_left.mp h (hcell a x hx) (hcell b x hy) + have hmul (z : GaussianInt) : + GaussianQuarterTurn z = (⟨0, 1⟩ : GaussianInt) * z := by + ext <;> simp [GaussianQuarterTurn] + have hturn₀ : GaussianQuarterTurn (0 : GaussianInt) = 0 := by + rw [hmul, mul_zero] + have hzero : (TileTranslation T 0).cells = T.cells := by + rw [(TileTranslationFormulas T 0).1] + have hidentity : GaussianTranslation (0 : GaussianInt) = id := by + funext z + exact add_zero z + rw [hidentity, Finset.image_id] + have hflip := (VectorRecursionLaws q cfg.proper.1).2.2.2.2 cfg.proper + have hturn₁ : GaussianQuarterTurn (BandVectors.1 (q 1) (q 0)) = cert.u := by + rw [hmul, cert.period_u] + simpa using (hflip 0).1.symm + have hturn₂ : GaussianQuarterTurn (BandVectors.1 (q 2) (q 0)) = cert.v := by + rw [hmul, cert.period_v] + simpa using (hflip 1).1.symm + have hsum : BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + + BandVectors.1 (q 3) (q 0) = 0 := by + simpa [Fin.sum_univ_succ, add_assoc] using (IncomingSuperbasisRelation q cfg.proper).1 + have hthird : BandVectors.1 (q 3) (q 0) = + -BandVectors.1 (q 1) (q 0) - BandVectors.1 (q 2) (q 0) := by + linear_combination hsum + have hturn₃ : GaussianQuarterTurn (BandVectors.1 (q 3) (q 0)) = + -cert.u - cert.v := by + rw [hthird, hmul, mul_sub, mul_neg, ← hmul, ← hmul, hturn₁, hturn₂] + let p : Fin 3 → Int × Int := ![(1, 0), (0, 1), (-1, -1)] + have hcoords (j : Fin 3) : GaussianQuarterTurn (BandVectors.1 (q j.succ) (q 0)) = + ((p j).1 : GaussianInt) * cert.u + ((p j).2 : GaussianInt) * cert.v := by + fin_cases j <;> simp [p, hturn₁, hturn₂, hturn₃, sub_eq_add_neg] + have hnegcoords (j : Fin 3) : + GaussianQuarterTurn (-BandVectors.1 (q j.succ) (q 0)) = + ((-(p j).1 : Int) : GaussianInt) * cert.u + + ((-(p j).2 : Int) : GaussianInt) * cert.v := by + rw [hmul, mul_neg, ← hmul, hcoords] + simp [neg_mul, add_comm] + have hneq₀₁ : (0, 0) ≠ p i := by fin_cases i <;> simp [p] + have hneq₁₂ : p i ≠ (-(p (i + 1)).1, -(p (i + 1)).2) := by + fin_cases i <;> decide +kernel + have hneq₂₀ : (-(p (i + 1)).1, -(p (i + 1)).2) ≠ (0, 0) := by + fin_cases i <;> decide +kernel + have hdisjoint₀₁ : Disjoint T.cells + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))).cells := by + have h := hblocks 0 0 (p i).1 (p i).2 hneq₀₁ + have h' : Disjoint (TileTranslation T 0).cells + (TileTranslation T (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)))).cells := by + simpa [hcoords] using h + have h'' := htransfer 0 (BandVectors.1 (q i.succ) (q 0)) + (by simpa only [hturn₀] using h') + simpa only [hzero] using h'' + have hdisjoint₁₂ : Disjoint + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))).cells + (TileTranslation T (-BandVectors.1 (q ((i + 1).succ)) (q 0))).cells := by + apply htransfer + rw [hcoords, hnegcoords] + exact hblocks (p i).1 (p i).2 (-(p (i + 1)).1) (-(p (i + 1)).2) hneq₁₂ + have hdisjoint₂₀ : Disjoint + (TileTranslation T (-BandVectors.1 (q ((i + 1).succ)) (q 0))).cells T.cells := by + have h := hblocks (-(p (i + 1)).1) (-(p (i + 1)).2) 0 0 hneq₂₀ + have h' : Disjoint + (TileTranslation T (GaussianQuarterTurn (-BandVectors.1 (q ((i + 1).succ)) (q 0)))).cells + (TileTranslation T 0).cells := by + simpa [hnegcoords] using h + have h'' := htransfer (-BandVectors.1 (q ((i + 1).succ)) (q 0)) 0 + (by simpa only [hturn₀] using h') + simpa only [hzero] using h'' + obtain ⟨E⟩ := (BandOrderedGeneralChildInterfaces q cfg C₀ T cert hcurrentT2).1 i + exact ExactTileInterfaceTripleLatticeTouching T + (TileTranslation T (BandVectors.1 (q i.succ) (q 0))) + (TileTranslation T (-BandVectors.1 (q ((i + 1).succ)) (q 0))) E + hdisk hdisk₁ hdisk₂ hdisjoint₀₁ hdisjoint₁₂ hdisjoint₂₀ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileT4ParentTranslateTouching.lean b/LeanPool/ApollonianSuperharmonic/TileT4ParentTranslateTouching.lean new file mode 100644 index 0000000000..fe789ff192 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileT4ParentTranslateTouching.lean @@ -0,0 +1,150 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: TileT4ParentTranslateTouching] + +/-! +# TileT4ParentTranslateTouching + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TileT4ParentTranslateTouching (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T₀ Tᵢ : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T₀) + (hcurrentT2 : QuarterTurnSymmetric T₀) (i : Fin 3) + (hTᵢ : BandPrototile (q i.succ) Tᵢ) + (hcent : TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))) : + TouchingTriple T₀ + (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) Tᵢ := by +-- BODY + have hdata := BandOrderedGeneralMixedAggregatePatches q cfg C₀ T₀ cert hcurrentT2 + have hj := hdata.1 i Tᵢ hTᵢ hcent + rcases hj with ⟨AB, BC, CA, ABC, hA, hB, hC, hAB, hBC, hCA, hABC, + hdAB, hdBC, hdCA, huAB, huBC, huCA, huABC, heAB, heBC, heCA⟩ + have hex := LatticeTileThreeDiskJunction + T₀ (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) Tᵢ + AB BC CA ABC hA hB hC hAB hBC hCA hABC hdAB hdBC hdCA + huAB huBC huCA huABC heAB heBC heCA + rcases hex with ⟨hex⟩ + have path_to_simple : ∀ (V : Set GaussianInt) + (E : Set (Finset GaussianInt)) (x y : GaussianInt), + SimpleGridPathBetween V E x y → SimpleGridPath V E := by + intro V E x y hp + rcases hp with ⟨p, hn, hl, hh, ht, hv, ha, he⟩ + exact ⟨p, hn, hl, hv, ha, he⟩ + have hab := LatticeTileDiskUnionInterface + T₀ (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) AB + hA hB hAB hdAB huAB heAB + have hbc := LatticeTileDiskUnionInterface + (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) Tᵢ BC + hB hC hBC hdBC huBC heBC + have hca := LatticeTileDiskUnionInterface Tᵢ T₀ CA + hC hA hCA hdCA huCA heCA + have hpathAB : SimpleGridPath + (BoundaryFootprintVertices T₀ ∩ + BoundaryFootprintVertices (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0)))) + (BoundaryFootprintEdges T₀ ∩ + BoundaryFootprintEdges (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0)))) := by + rw [hab.2.2.2, ← hab.2.2.1] + rcases hab.2.1 with ⟨x, y, hp⟩ + exact path_to_simple _ _ x y hp + have hpathBC : SimpleGridPath + (BoundaryFootprintVertices (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) ∩ + BoundaryFootprintVertices Tᵢ) + (BoundaryFootprintEdges (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) ∩ + BoundaryFootprintEdges Tᵢ) := by + rw [hbc.2.2.2, ← hbc.2.2.1] + rcases hbc.2.1 with ⟨x, y, hp⟩ + exact path_to_simple _ _ x y hp + have hpathCA : SimpleGridPath + (BoundaryFootprintVertices Tᵢ ∩ BoundaryFootprintVertices T₀) + (BoundaryFootprintEdges Tᵢ ∩ BoundaryFootprintEdges T₀) := by + rw [hca.2.2.2, ← hca.2.2.1] + rcases hca.2.1 with ⟨x, y, hp⟩ + exact path_to_simple _ _ x y hp + have hneA : T₀.cells.Nonempty := by + rcases heAB with ⟨e, he⟩ + rcases he.1 with ⟨x, hx, hrest⟩ + exact ⟨x, hx⟩ + have hneB : (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))).cells.Nonempty := by + rcases heAB with ⟨e, he⟩ + rcases he.2 with ⟨x, hx, hrest⟩ + exact ⟨x, hx⟩ + have hneC : Tᵢ.cells.Nonempty := by + rcases heBC with ⟨e, he⟩ + rcases he.2 with ⟨x, hx, hrest⟩ + exact ⟨x, hx⟩ + have hsetAB : BoundaryFootprintVertices T₀ ∩ + BoundaryFootprintVertices (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) = + FootprintVertices T₀ ∩ + FootprintVertices (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) := + hab.2.2.2.trans hab.1.symm + have hsetBC : BoundaryFootprintVertices (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) ∩ + BoundaryFootprintVertices Tᵢ = + FootprintVertices (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) ∩ + FootprintVertices Tᵢ := + hbc.2.2.2.trans hbc.1.symm + have hsetCA : BoundaryFootprintVertices Tᵢ ∩ BoundaryFootprintVertices T₀ = + FootprintVertices Tᵢ ∩ FootprintVertices T₀ := + hca.2.2.2.trans hca.1.symm + have htriple : ∀ x : GaussianInt, + (x ∈ BoundaryFootprintVertices T₀ ∧ + x ∈ BoundaryFootprintVertices (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) ∧ + x ∈ BoundaryFootprintVertices Tᵢ) ↔ + x ∈ FootprintVertices T₀ ∧ + x ∈ FootprintVertices (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) ∧ + x ∈ FootprintVertices Tᵢ := by + intro x + constructor + · intro hx + have habx : x ∈ BoundaryFootprintVertices T₀ ∩ + BoundaryFootprintVertices (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) := + ⟨hx.1, hx.2.1⟩ + have hbcx : x ∈ BoundaryFootprintVertices (TileTranslation T₀ (BandVectors.1 (q i.succ) (q + 0))) ∩ + BoundaryFootprintVertices Tᵢ := ⟨hx.2.1, hx.2.2⟩ + have hfAB := hsetAB ▸ habx + have hfBC := hsetBC ▸ hbcx + exact ⟨hfAB.1, hfAB.2, hfBC.2⟩ + · intro hx + have habx : x ∈ FootprintVertices T₀ ∩ + FootprintVertices (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) := + ⟨hx.1, hx.2.1⟩ + have hbcx : x ∈ FootprintVertices (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) ∩ + FootprintVertices Tᵢ := ⟨hx.2.1, hx.2.2⟩ + have hbAB := hsetAB.symm ▸ habx + have hbBC := hsetBC.symm ▸ hbcx + exact ⟨hbAB.1, hbAB.2, hbBC.2⟩ + unfold TouchingTriple + refine ⟨?_, ?_, ?_, hex.point, ?_, ?_⟩ + · exact Or.inl ⟨hneA, hneB, hdAB, hpathAB⟩ + · exact Or.inl ⟨hneB, hneC, hdBC, hpathBC⟩ + · exact Or.inl ⟨hneC, hneA, hdCA, hpathCA⟩ + · have hp := (hex.unique_common hex.point).mpr rfl + exact htriple hex.point |>.mpr ⟨hp.1.1, hp.1.2, hp.2⟩ + · intro x hx + have hp := htriple x |>.mp hx + exact (hex.unique_common x).mp ⟨⟨hp.1, hp.2.1⟩, hp.2.2⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileT5ParentTouching.lean b/LeanPool/ApollonianSuperharmonic/TileT5ParentTouching.lean new file mode 100644 index 0000000000..cb3c625c3a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileT5ParentTouching.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: TileT5ParentTouching] + +/-! +# TileT5ParentTouching + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TileT5ParentTouching (q : Fin 4 → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T₀ Tᵢ Tⱼ : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T₀) + (hcurrentT2 : QuarterTurnSymmetric T₀) (i : Fin 3) + (hTᵢ : BandPrototile (q i.succ) Tᵢ) + (hTⱼ : BandPrototile (q ((i + 1).succ)) Tⱼ) + (hcentᵢ : TileCentroid Tᵢ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))) + (hcentⱼ : TileCentroid Tⱼ - TileCentroid T₀ = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q ((i + 1).succ)) (q 0)) - + GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ))))) : + TouchingTriple T₀ Tᵢ Tⱼ := by +-- BODY + have aggregate := BandOrderedGeneralMixedAggregatePatches q cfg C₀ T₀ cert hcurrentT2 + dsimp at aggregate + have makeTouching : ∀ (A B C AB BC CA ABC : ProtoTile), + LatticeTile A → LatticeTile B → LatticeTile C → + LatticeTile AB → LatticeTile BC → LatticeTile CA → LatticeTile ABC → + Disjoint A.cells B.cells → Disjoint B.cells C.cells → + Disjoint C.cells A.cells → + (∀ z : LatticeCell, z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) → + (∀ z : LatticeCell, z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) → + (∀ z : LatticeCell, z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) → + (∀ z : LatticeCell, z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) → + (FootprintEdges A ∩ FootprintEdges B).Nonempty → + (FootprintEdges B ∩ FootprintEdges C).Nonempty → + (FootprintEdges C ∩ FootprintEdges A).Nonempty → + ExactTileInterfaceTriple A B C → TouchingTriple A B C := by + intro A B C AB BC CA ABC hA hB hC hAB hBC hCA hABC hdAB hdBC hdCA huAB huBC huCA huABC heAB + heBC heCA exact + have edgeCells : ∀ (X Y : ProtoTile), + (FootprintEdges X ∩ FootprintEdges Y).Nonempty → + X.cells.Nonempty ∧ Y.cells.Nonempty := by + intro X Y h + rcases h with ⟨e, heX, heY⟩ + constructor + · change ∃ x ∈ X.cells, _ at heX + rcases heX with ⟨x, hx, _⟩ + exact ⟨x, hx⟩ + · change ∃ x ∈ Y.cells, _ at heY + rcases heY with ⟨x, hx, _⟩ + exact ⟨x, hx⟩ + have nonempty : A.cells.Nonempty ∧ B.cells.Nonempty ∧ C.cells.Nonempty := by + have hab := edgeCells A B heAB + have hbc := edgeCells B C heBC + exact ⟨hab.1, hab.2, hbc.2⟩ + have interfaceAB := LatticeTileDiskUnionInterface A B AB hA hB hAB hdAB huAB heAB + have interfaceBC := LatticeTileDiskUnionInterface B C BC hB hC hBC hdBC huBC heBC + have interfaceCA := LatticeTileDiskUnionInterface C A CA hC hA hCA hdCA huCA heCA + obtain ⟨xAB, yAB, pathAB⟩ := interfaceAB.2.1 + obtain ⟨xBC, yBC, pathBC⟩ := interfaceBC.2.1 + obtain ⟨xCA, yCA, pathCA⟩ := interfaceCA.2.1 + rw [← interfaceAB.2.2.2, interfaceAB.2.2.1] at pathAB + rw [← interfaceBC.2.2.2, interfaceBC.2.2.1] at pathBC + rw [← interfaceCA.2.2.2, interfaceCA.2.2.1] at pathCA + have simpleAB : SimpleGridPath + (BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B) + (BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B) := by + rcases pathAB with ⟨p, hn, hl, hh, ht, hv, he⟩ + exact ⟨p, hn, hl, hv, he⟩ + have simpleBC : SimpleGridPath + (BoundaryFootprintVertices B ∩ BoundaryFootprintVertices C) + (BoundaryFootprintEdges B ∩ BoundaryFootprintEdges C) := by + rcases pathBC with ⟨p, hn, hl, hh, ht, hv, he⟩ + exact ⟨p, hn, hl, hv, he⟩ + have simpleCA : SimpleGridPath + (BoundaryFootprintVertices C ∩ BoundaryFootprintVertices A) + (BoundaryFootprintEdges C ∩ BoundaryFootprintEdges A) := by + rcases pathCA with ⟨p, hn, hl, hh, ht, hv, he⟩ + exact ⟨p, hn, hl, hv, he⟩ + have touchAB : TileTouching A B := by + unfold TileTouching + left + exact ⟨nonempty.1, nonempty.2.1, hdAB, simpleAB⟩ + have touchBC : TileTouching B C := by + unfold TileTouching + left + exact ⟨nonempty.2.1, nonempty.2.2, hdBC, simpleBC⟩ + have touchCA : TileTouching C A := by + unfold TileTouching + left + exact ⟨nonempty.2.2, nonempty.1, hdCA, simpleCA⟩ + refine ⟨touchAB, touchBC, touchCA, ?_⟩ + have pointCommon : exact.point ∈ BoundaryFootprintVertices A ∧ + exact.point ∈ BoundaryFootprintVertices B ∧ + exact.point ∈ BoundaryFootprintVertices C := by + have hab : exact.point ∈ BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B := by + have hpoint := (exact.unique_common exact.point).mpr rfl + have hab0 : exact.point ∈ FootprintVertices A ∩ FootprintVertices B := + hpoint.1 + have commonAB : exact.point ∈ CommonFootprintEdgeVertices A B := by + rw [← interfaceAB.1] + exact hab0 + rw [interfaceAB.2.2.2] + exact commonAB + have hbc : exact.point ∈ BoundaryFootprintVertices B ∩ BoundaryFootprintVertices C := by + have hpoint := (exact.unique_common exact.point).mpr rfl + have hbc0 : exact.point ∈ FootprintVertices B ∩ FootprintVertices C := + ⟨hpoint.1.2, hpoint.2⟩ + have commonBC : exact.point ∈ CommonFootprintEdgeVertices B C := by + rw [← interfaceBC.1] + exact hbc0 + rw [interfaceBC.2.2.2] + exact commonBC + change exact.point ∈ BoundaryFootprintVertices A ∧ + exact.point ∈ BoundaryFootprintVertices B at hab + change exact.point ∈ BoundaryFootprintVertices B ∧ + exact.point ∈ BoundaryFootprintVertices C at hbc + exact ⟨hab.1, hab.2, hbc.2⟩ + refine ⟨exact.point, pointCommon, ?_⟩ + intro x hx + apply (exact.unique_common _).mp + have hab : x ∈ BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B := by + exact ⟨hx.1, hx.2.1⟩ + have hbc : x ∈ BoundaryFootprintVertices B ∩ BoundaryFootprintVertices C := by + exact ⟨hx.2.1, hx.2.2⟩ + have commonAB : x ∈ CommonFootprintEdgeVertices A B := by + rw [← interfaceAB.2.2.2] + exact hab + have commonBC : x ∈ CommonFootprintEdgeVertices B C := by + rw [← interfaceBC.2.2.2] + exact hbc + have footAB : x ∈ FootprintVertices A ∩ FootprintVertices B := by + rw [interfaceAB.1] + exact commonAB + have footBC : x ∈ FootprintVertices B ∩ FootprintVertices C := by + rw [interfaceBC.1] + exact commonBC + exact ⟨footAB, footBC.2⟩ + have junction := aggregate.2.1 i Tᵢ Tⱼ hTᵢ hTⱼ hcentᵢ hcentⱼ + obtain ⟨AB, BC, CA, ABC, hA, hB, hC, hAB, hBC, hCA, hABC, + hdAB, hdBC, hdCA, huAB, huBC, huCA, huABC, heAB, heBC, heCA⟩ := junction + exact makeTouching T₀ Tᵢ Tⱼ AB BC CA ABC hA hB hC hAB hBC hCA hABC + hdAB hdBC hdCA huAB huBC huCA huABC heAB heBC heCA + (Classical.choice ((BandOrderedGeneralChildInterfaces q cfg C₀ T₀ cert hcurrentT2).2.2.1 + i Tᵢ Tⱼ hTᵢ hTⱼ hcentᵢ hcentⱼ)) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileTouching.lean b/LeanPool/ApollonianSuperharmonic/TileTouching.lean new file mode 100644 index 0000000000..fab4be5544 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileTouching.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath + +-- [TABLET NODE: TileTouching] + +/-! +# TileTouching + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Two nonempty prototiles touch when they have no common cell and the ordinary +intersection of their boundary-footprint graphs is a simple unit grid path +with at least two vertices. Both the shared vertices and the shared boundary +edges are intersected; no edge is inferred from endpoint membership. + +If one prototile is empty, it touches the other exactly when its assigned +singleton anchor lies in the other's boundary footprint. This convention is +symmetric; in particular, two empty prototiles touch exactly when their +anchors agree. +-/ +def TileTouching (T U : ProtoTile) : Prop := +-- BODY + (T.cells.Nonempty ∧ U.cells.Nonempty ∧ Disjoint T.cells U.cells ∧ + SimpleGridPath + (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) + (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U)) ∨ + (T.cells = ∅ ∧ T.anchor ∈ BoundaryFootprintVertices U) ∨ + (U.cells = ∅ ∧ U.anchor ∈ BoundaryFootprintVertices T) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileTouchingCovariance.lean b/LeanPool/ApollonianSuperharmonic/TileTouchingCovariance.lean new file mode 100644 index 0000000000..29a1d561e9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileTouchingCovariance.lean @@ -0,0 +1,212 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas + +-- [TABLET NODE: TileTouchingCovariance] + +/-! +# TileTouchingCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TileTouchingCovariance : ∀ (T U : ProtoTile) (u : GaussianInt), + (TileTouching T U ↔ + TileTouching (TileTranslation T u) (TileTranslation U u)) ∧ + (TileTouching T U ↔ + TileTouching (TileQuarterTurn T) (TileQuarterTurn U)) ∧ + (TileTouching T U ↔ + TileTouching (TileReflection T) (TileReflection U)) := by +-- BODY + have image_intersection : ∀ {α β : Type} (A B : Set α) (f : α → β), + Function.Injective f → + f '' (A ∩ B) = (f '' A) ∩ (f '' B) := by + intro α β A B f hf + ext x + constructor + · rintro ⟨y, hy, rfl⟩ + exact ⟨⟨y, hy.1, rfl⟩, ⟨y, hy.2, rfl⟩⟩ + · rintro ⟨⟨a, ha, hax⟩, ⟨b, hb, hbx⟩⟩ + have hab : a = b := hf (hax.trans hbx.symm) + exact ⟨a, ⟨ha, hab ▸ hb⟩, hax⟩ + have image_disjoint : ∀ (A B : Set GaussianInt) (f : GaussianInt → GaussianInt), + Function.Injective f → + (Disjoint A B ↔ Disjoint (f '' A) (f '' B)) := by + intro A B f hf + exact (Set.disjoint_image_iff hf).symm + have image_mem : ∀ (A : Set GaussianInt) (f : GaussianInt → GaussianInt), + Function.Bijective f → ∀ x, (x ∈ A ↔ f x ∈ f '' A) := by + intro A f hf x + constructor + · intro hx + exact ⟨x, hx, rfl⟩ + · rintro ⟨y, hy, hxy⟩ + have hyx : y = x := hf.1 hxy + exact hyx ▸ hy + have generic_covariance : ∀ (T U T' U' : ProtoTile) + (c f : GaussianInt → GaussianInt), + T'.cells = T.cells.image c → U'.cells = U.cells.image c → + T'.anchor = f T.anchor → U'.anchor = f U.anchor → + ((T'.cells = ∅ ↔ T.cells = ∅) ∧ (U'.cells = ∅ ↔ U.cells = ∅)) → + BoundaryFootprintVertices T' = f '' BoundaryFootprintVertices T → + BoundaryFootprintVertices U' = f '' BoundaryFootprintVertices U → + BoundaryFootprintEdges T' = (fun e : Finset GaussianInt => e.image f) '' + BoundaryFootprintEdges T → + BoundaryFootprintEdges U' = (fun e : Finset GaussianInt => e.image f) '' + BoundaryFootprintEdges U → + Function.Injective c → Function.Bijective f → + (∀ (V : Set GaussianInt) (E : Set (Finset GaussianInt)), + SimpleGridPath V E ↔ + SimpleGridPath (f '' V) ((fun e : Finset GaussianInt => e.image f) '' E)) → + (TileTouching T U ↔ TileTouching T' U') := by + intro T U T' U' c f htc huc hta hua hem hvT hvU heT heU hc hf hpath + unfold TileTouching + rw [htc, huc, hvT, hvU, heT, heU, hta, hua] + have cell_empty (A : Finset GaussianInt) : + A.image c = ∅ ↔ A = ∅ := Finset.image_eq_empty + have cell_nonempty (A : Finset GaussianInt) : + (A.image c).Nonempty ↔ A.Nonempty := Finset.image_nonempty + have image_disjoint_finset : ∀ (A B : Finset GaussianInt), + Disjoint A B ↔ Disjoint (A.image c) (B.image c) := by + intro A B + exact (Finset.disjoint_image hc).symm + have edge_inter : + (fun e : Finset GaussianInt => e.image f) '' + (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) = + ((fun e : Finset GaussianInt => e.image f) '' BoundaryFootprintEdges T) ∩ + ((fun e : Finset GaussianInt => e.image f) '' BoundaryFootprintEdges U) := by + apply image_intersection (A := BoundaryFootprintEdges T) + (B := BoundaryFootprintEdges U) + (f := fun e : Finset GaussianInt => e.image f) + exact Finset.image_injective hf.1 + have vertex_inter := image_intersection + (BoundaryFootprintVertices T) (BoundaryFootprintVertices U) f hf.1 + have disj := image_disjoint_finset T.cells U.cells + have paths := hpath + (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) + (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) + have anchorT := image_mem (BoundaryFootprintVertices U) f hf T.anchor + have anchorU := image_mem (BoundaryFootprintVertices T) f hf U.anchor + rw [cell_empty, cell_empty] + rw [cell_nonempty, cell_nonempty, disj] + rw [← vertex_inter, ← edge_inter] + rw [paths] + simp [anchorT, anchorU] + have translation_injective (u : GaussianInt) : + Function.Injective (GaussianTranslation u) := by + intro a b h + dsimp [GaussianTranslation] at h ⊢ + exact add_right_cancel h + have translation_bijective (u : GaussianInt) : + Function.Bijective (GaussianTranslation u) := by + constructor + · exact translation_injective u + · intro a + refine ⟨a - u, ?_⟩ + dsimp [GaussianTranslation] + exact sub_add_cancel a u + have quarter_injective : Function.Injective GaussianQuarterTurn := by + intro a b h + have him := congrArg (fun z : GaussianInt => z.im) h + have hre := congrArg (fun z : GaussianInt => z.re) h + apply Zsqrtd.ext + · simpa [GaussianQuarterTurn] using him + · simpa [GaussianQuarterTurn] using hre + have quarter_bijective : Function.Bijective GaussianQuarterTurn := by + constructor + · exact quarter_injective + · intro a + refine ⟨⟨a.im, -a.re⟩, ?_⟩ + dsimp [GaussianQuarterTurn] + ext <;> simp + have reflection_injective : Function.Injective GaussianReflection := by + intro a b h + have hre := congrArg (fun z : GaussianInt => z.re) h + have him := congrArg (fun z : GaussianInt => -z.im) h + apply Zsqrtd.ext + · simpa [GaussianReflection] using hre + · simpa [GaussianReflection] using him + have reflection_bijective : Function.Bijective GaussianReflection := by + constructor + · exact reflection_injective + · intro a + refine ⟨⟨a.re, -a.im⟩, ?_⟩ + dsimp [GaussianReflection] + ext <;> simp + intro T U u + have translation_result : TileTouching T U ↔ + TileTouching (TileTranslation T u) (TileTranslation U u) := by + apply generic_covariance T U (TileTranslation T u) (TileTranslation U u) + (GaussianTranslation u) (GaussianTranslation u) + · exact (TileTranslationFormulas T u).1 + · exact (TileTranslationFormulas U u).1 + · exact (TileTranslationFormulas T u).2.1 + · exact (TileTranslationFormulas U u).2.1 + · exact ⟨(TileTranslationFormulas T u).2.2.1, + (TileTranslationFormulas U u).2.2.1⟩ + · exact (TileTranslationFormulas T u).2.2.2.2.2.2.2.1 + · exact (TileTranslationFormulas U u).2.2.2.2.2.2.2.1 + · exact (TileTranslationFormulas T u).2.2.2.2.2.2.2.2 + · exact (TileTranslationFormulas U u).2.2.2.2.2.2.2.2 + · exact translation_injective u + · exact translation_bijective u + · exact fun V E => (SimpleGridPathEquivariance V E u).1 + have quarter_result : TileTouching T U ↔ + TileTouching (TileQuarterTurn T) (TileQuarterTurn U) := by + apply generic_covariance T U (TileQuarterTurn T) (TileQuarterTurn U) + (fun x => GaussianQuarterTurn x - 1) GaussianQuarterTurn + · exact (TileQuarterTurnFormulas T).1 + · exact (TileQuarterTurnFormulas U).1 + · exact (TileQuarterTurnFormulas T).2.1 + · exact (TileQuarterTurnFormulas U).2.1 + · exact ⟨(TileQuarterTurnFormulas T).2.2.1, + (TileQuarterTurnFormulas U).2.2.1⟩ + · exact (TileQuarterTurnFormulas T).2.2.2.2.2.2.2.1 + · exact (TileQuarterTurnFormulas U).2.2.2.2.2.2.2.1 + · exact (TileQuarterTurnFormulas T).2.2.2.2.2.2.2.2 + · exact (TileQuarterTurnFormulas U).2.2.2.2.2.2.2.2 + · intro a b h + apply quarter_injective + have shifted := congrArg (fun z : GaussianInt => z + 1) h + simpa using shifted + · exact quarter_bijective + · exact fun V E => (SimpleGridPathEquivariance V E u).2.1 + have reflection_result : TileTouching T U ↔ + TileTouching (TileReflection T) (TileReflection U) := by + apply generic_covariance T U (TileReflection T) (TileReflection U) + (fun x => GaussianReflection x - ⟨0, 1⟩) GaussianReflection + · exact (TileReflectionFormulas T).1 + · exact (TileReflectionFormulas U).1 + · exact (TileReflectionFormulas T).2.1 + · exact (TileReflectionFormulas U).2.1 + · exact ⟨(TileReflectionFormulas T).2.2.1, + (TileReflectionFormulas U).2.2.1⟩ + · exact (TileReflectionFormulas T).2.2.2.2.2.2.2.1 + · exact (TileReflectionFormulas U).2.2.2.2.2.2.2.1 + · exact (TileReflectionFormulas T).2.2.2.2.2.2.2.2 + · exact (TileReflectionFormulas U).2.2.2.2.2.2.2.2 + · intro a b h + apply reflection_injective + have shifted := congrArg (fun z : GaussianInt => z + ⟨0, 1⟩) h + simpa using shifted + · exact reflection_bijective + · exact fun V E => (SimpleGridPathEquivariance V E u).2.2 + exact ⟨translation_result, quarter_result, reflection_result⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileTranslation.lean b/LeanPool/ApollonianSuperharmonic/TileTranslation.lean new file mode 100644 index 0000000000..11a4e9267c --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileTranslation.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianTranslation +public import LeanPool.ApollonianSuperharmonic.ProtoTile + +-- [TABLET NODE: TileTranslation] + +/-! +# TileTranslation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For $u\in\mathbb Z[i]$, the translate $T+u$ is obtained by replacing every +cell $s_x$ by $s_{x+u}$ and replacing the degenerate anchor by its translate +by $u$. +-/ +def TileTranslation (T : ProtoTile) (u : GaussianInt) : ProtoTile := +-- BODY + ⟨T.cells.image (GaussianTranslation u), GaussianTranslation u T.anchor⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileTranslationFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileTranslationFormulas.lean new file mode 100644 index 0000000000..ab2b0ef7d0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileTranslationFormulas.lean @@ -0,0 +1,447 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import LeanPool.ApollonianSuperharmonic.TileTranslation + +-- [TABLET NODE: TileTranslationFormulas] + +/-! +# TileTranslationFormulas + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +private theorem translationRealization (T : ProtoTile) (u : GaussianInt) : + TileRealization (TileTranslation T u) = + (fun p : Real × Real => + (p.1 + (u.re : Int), p.2 + (u.im : Int))) '' TileRealization T := by + dsimp [TileTranslation] + ext p + rcases p with ⟨p, q⟩ + simp only [TileRealization, ClosedSquareRealization, GaussianTranslation, + Set.mem_iUnion, Set.mem_image, Finset.mem_image, + ] + have realPart (z w : GaussianInt) : + ((GaussianTranslation w z).re : Real) = (z.re : Real) + (w.re : Real) := by + cases z; cases w; simp [GaussianTranslation] + have imagPart (z w : GaussianInt) : + ((GaussianTranslation w z).im : Real) = (z.im : Real) + (w.im : Real) := by + cases z; cases w; simp [GaussianTranslation] + have realAdd (z w : GaussianInt) : + (((z + w).re : Int) : Real) = (z.re : Real) + (w.re : Real) := by + cases z; cases w; simp + have imagAdd (z w : GaussianInt) : + (((z + w).im : Int) : Real) = (z.im : Real) + (w.im : Real) := by + cases z; cases w; simp + have realCoord (w : GaussianInt) : + (GaussianInt.toComplex w).re = (w.re : Real) := by + exact (GaussianInt.intCast_re w).symm + have imagCoord (w : GaussianInt) : + (GaussianInt.toComplex w).im = (w.im : Real) := by + exact (GaussianInt.intCast_im w).symm + constructor + · rintro ⟨i, hi, hp⟩ + rcases Finset.mem_image.mp hi with ⟨a, ha, hia⟩ + subst i + refine ⟨((p - (u.re : Real)), (q - (u.im : Real))), ?_, ?_⟩ + · refine ⟨a, ha, ?_⟩ + simp only [realPart, imagPart] at hp ⊢ + simp only [Set.mem_Icc, Prod.le_def] at hp ⊢ + constructor <;> constructor <;> + linarith [hp.1.1, hp.1.2, hp.2.1, hp.2.2] + · apply Prod.ext + all_goals dsimp + all_goals ring + · rintro ⟨x, ⟨i, hi, hx⟩, heq⟩ + rcases x with ⟨x, y⟩ + refine ⟨i + u, Finset.mem_image.mpr ⟨i, hi, rfl⟩, ?_⟩ + simp only [Set.mem_Icc, Prod.le_def] at hx ⊢ + simp only [realAdd, imagAdd] + have hp := congrArg Prod.fst heq + have hq := congrArg Prod.snd heq + dsimp at hp hq + constructor <;> constructor <;> + linarith [hx.1.1, hx.1.2, hx.2.1, hx.2.2, hp, hq] + +private theorem translationCentroid (T : ProtoTile) (u : GaussianInt) : + TileCentroid (TileTranslation T u) = + ((TileCentroid T).1 + (u.re : Int), + (TileCentroid T).2 + (u.im : Int)) := by + dsimp [TileTranslation] + by_cases h : T.cells.Nonempty + · have hinj : Function.Injective (GaussianTranslation u) := by + intro a b hab + exact add_right_cancel hab + have translatedRe (x : GaussianInt) : + (GaussianInt.toComplex (GaussianTranslation u x)).re = + (GaussianInt.toComplex x).re + (GaussianInt.toComplex u).re := by + cases x; cases u; simp [GaussianTranslation] + have translatedIm (x : GaussianInt) : + (GaussianInt.toComplex (GaussianTranslation u x)).im = + (GaussianInt.toComplex x).im + (GaussianInt.toComplex u).im := by + cases x; cases u; simp [GaussianTranslation] + simp? [TileCentroid, h] + rw [Finset.card_image_of_injective T.cells hinj] + rw [Finset.sum_image hinj.injOn] + rw [Finset.sum_image hinj.injOn] + simp only [translatedRe, translatedIm] + simp [Finset.sum_add_distrib] + have cardReal : (Finset.card T.cells : Real) ≠ 0 := by + exact_mod_cast h.card_pos.ne' + constructor <;> + field_simp [cardReal] <;> ring_nf + · have translatedRe (x : GaussianInt) : + (GaussianInt.toComplex (GaussianTranslation u x)).re = + (GaussianInt.toComplex x).re + (GaussianInt.toComplex u).re := by + cases x; cases u; simp [GaussianTranslation] + have translatedIm (x : GaussianInt) : + (GaussianInt.toComplex (GaussianTranslation u x)).im = + (GaussianInt.toComplex x).im + (GaussianInt.toComplex u).im := by + cases x; cases u; simp [GaussianTranslation] + simp [TileCentroid, h, translatedRe, translatedIm] + +private theorem translationVertices (T : ProtoTile) (u : GaussianInt) : + FootprintVertices (TileTranslation T u) = + GaussianTranslation u '' FootprintVertices T := by + dsimp [TileTranslation] + by_cases h : T.cells.Nonempty + · ext v + simp? [FootprintVertices, h, GaussianTranslation] + constructor + · rintro ⟨a, ha, hv⟩ + rcases hv with h0 | h1 | h2 | h3 + · refine ⟨a, ⟨a, ha, Or.inl rfl⟩, h0.symm⟩ + · refine ⟨a + 1, ⟨a, ha, Or.inr (Or.inl rfl)⟩, ?_⟩ + simpa [add_assoc, add_comm] using h1.symm + · refine ⟨a + ⟨0, 1⟩, ⟨a, ha, Or.inr (Or.inr (Or.inl rfl))⟩, ?_⟩ + simpa [add_assoc, add_comm] using h2.symm + · refine ⟨a + 1 + ⟨0, 1⟩, ⟨a, ha, Or.inr (Or.inr (Or.inr rfl))⟩, ?_⟩ + simpa [add_assoc, add_comm] using h3.symm + · rintro ⟨x, ⟨a, ha, hx⟩, hv⟩ + refine ⟨a, ha, ?_⟩ + rw [← hv] + rcases hx with rfl | rfl | rfl | rfl <;> + simp [add_assoc, add_comm] + · simp [FootprintVertices, h, GaussianTranslation] + +private theorem translationEdges (T : ProtoTile) (u : GaussianInt) : + FootprintEdges (TileTranslation T u) = + (fun e : Finset GaussianInt => e.image (GaussianTranslation u)) '' + FootprintEdges T := by + dsimp [TileTranslation] + ext e + simp? [FootprintEdges, GaussianTranslation] + constructor + · rintro ⟨a, ha, he⟩ + rcases he with h0 | h1 | h2 | h3 + · refine ⟨{a, a + 1}, ⟨a, ha, Or.inl rfl⟩, ?_⟩ + rw [h0] + simp [GaussianTranslation, Finset.image_insert, add_assoc, add_comm] + · refine ⟨{a, a + ⟨0, 1⟩}, ⟨a, ha, Or.inr (Or.inl rfl)⟩, ?_⟩ + rw [h1] + simp [GaussianTranslation, Finset.image_insert, add_assoc, add_comm] + · refine ⟨{a + 1, a + 1 + ⟨0, 1⟩}, + ⟨a, ha, Or.inr (Or.inr (Or.inl rfl))⟩, ?_⟩ + rw [h2] + simp [GaussianTranslation, Finset.image_insert, add_assoc, add_comm] + · refine ⟨{a + ⟨0, 1⟩, a + 1 + ⟨0, 1⟩}, + ⟨a, ha, Or.inr (Or.inr (Or.inr rfl))⟩, ?_⟩ + rw [h3] + simp [GaussianTranslation, Finset.image_insert, add_assoc, add_comm] + · rintro ⟨x, ⟨a, ha, hx⟩, he⟩ + refine ⟨a, ha, ?_⟩ + rcases hx with rfl | rfl | rfl | rfl <;> + rw [← he] <;> + simp [GaussianTranslation, Finset.image_insert, add_assoc, add_comm] + +private theorem translationBoundaryVertices (T : ProtoTile) (u : GaussianInt) : + BoundaryFootprintVertices (TileTranslation T u) = + GaussianTranslation u '' BoundaryFootprintVertices T := by + dsimp [TileTranslation] + by_cases h : T.cells.Nonempty + · ext v + simp only [BoundaryFootprintVertices, ite_eq_left h] + have cellMem (z : GaussianInt) : + (∃ a ∈ T.cells, a + u = z) ↔ z - u ∈ T.cells := by + constructor + · rintro ⟨a, ha, rfl⟩ + simpa [add_comm] using ha + · intro hz + exact ⟨z - u, hz, by simp⟩ + have imageMem (z : GaussianInt) : + (∃ a ∈ T.cells, a + u = z) ↔ z - u ∈ T.cells := cellMem z + have absentMem (z : GaussianInt) : + (∀ a ∈ T.cells, ¬a + u = z) ↔ z - u ∉ T.cells := by + constructor + · intro ha hz + obtain ⟨a, hca, heq⟩ := (cellMem z).mpr hz + exact ha a hca heq + · intro hz a ha heq + apply hz + exact (cellMem z).mp ⟨a, ha, heq⟩ + have translatedCell (z : GaussianInt) : + z ∈ (TileTranslation T u).cells ↔ z - u ∈ T.cells := by + change z ∈ T.cells.image (GaussianTranslation u) ↔ z - u ∈ T.cells + simpa [GaussianTranslation] using cellMem z + have edgeFormula : + BoundaryFootprintEdges (TileTranslation T u) = + (fun e : Finset GaussianInt => e.image (GaussianTranslation u)) '' + BoundaryFootprintEdges T := by + ext e + change (∃ z : GaussianInt, + (e = {z, z + 1} ∧ + ((z ∈ (TileTranslation T u).cells ∧ + z - ⟨0, 1⟩ ∉ (TileTranslation T u).cells) ∨ + (z ∉ (TileTranslation T u).cells ∧ + z - ⟨0, 1⟩ ∈ (TileTranslation T u).cells))) ∨ + (e = {z, z + ⟨0, 1⟩} ∧ + ((z ∈ (TileTranslation T u).cells ∧ + z - 1 ∉ (TileTranslation T u).cells) ∨ + (z ∉ (TileTranslation T u).cells ∧ + z - 1 ∈ (TileTranslation T u).cells)))) ↔ + ∃ f, f ∈ BoundaryFootprintEdges T ∧ + f.image (GaussianTranslation u) = e + constructor + · rintro ⟨z, hz⟩ + rcases hz with ⟨rfl, hz⟩ | ⟨rfl, hz⟩ + · rcases hz with hz | hz + · refine ⟨{z - u, (z - u) + 1}, ?_, ?_⟩ + · change ∃ w, ({z - u, (z - u) + 1} = {w, w + 1} ∧ + ((w ∈ T.cells ∧ w - ⟨0, 1⟩ ∉ T.cells) ∨ + (w ∉ T.cells ∧ w - ⟨0, 1⟩ ∈ T.cells))) ∨ + ({z - u, (z - u) + 1} = {w, w + ⟨0, 1⟩} ∧ + ((w ∈ T.cells ∧ w - 1 ∉ T.cells) ∨ + (w ∉ T.cells ∧ w - 1 ∈ T.cells))) + refine ⟨z - u, Or.inl ⟨rfl, Or.inl ?_⟩⟩ + convert hz using 1 <;> + simp [translatedCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] + · simp [GaussianTranslation, Finset.image_insert, sub_eq_add_neg, + add_assoc, add_comm]; try abel + · refine ⟨{z - u, (z - u) + 1}, ?_, ?_⟩ + · change ∃ w, ({z - u, (z - u) + 1} = {w, w + 1} ∧ + ((w ∈ T.cells ∧ w - ⟨0, 1⟩ ∉ T.cells) ∨ + (w ∉ T.cells ∧ w - ⟨0, 1⟩ ∈ T.cells))) ∨ + ({z - u, (z - u) + 1} = {w, w + ⟨0, 1⟩} ∧ + ((w ∈ T.cells ∧ w - 1 ∉ T.cells) ∨ + (w ∉ T.cells ∧ w - 1 ∈ T.cells))) + refine ⟨z - u, Or.inl ⟨rfl, Or.inr ?_⟩⟩ + convert hz using 1 <;> + simp [translatedCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] + · simp [GaussianTranslation, Finset.image_insert, sub_eq_add_neg, + add_assoc, add_comm]; try abel + · rcases hz with hz | hz + · refine ⟨{z - u, (z - u) + ⟨0, 1⟩}, ?_, ?_⟩ + · change ∃ w, ({z - u, (z - u) + ⟨0, 1⟩} = {w, w + 1} ∧ + ((w ∈ T.cells ∧ w - ⟨0, 1⟩ ∉ T.cells) ∨ + (w ∉ T.cells ∧ w - ⟨0, 1⟩ ∈ T.cells))) ∨ + ({z - u, (z - u) + ⟨0, 1⟩} = {w, w + ⟨0, 1⟩} ∧ + ((w ∈ T.cells ∧ w - 1 ∉ T.cells) ∨ + (w ∉ T.cells ∧ w - 1 ∈ T.cells))) + refine ⟨z - u, Or.inr ⟨rfl, Or.inl ?_⟩⟩ + convert hz using 1 <;> + simp [translatedCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] + · simp [GaussianTranslation, Finset.image_insert, sub_eq_add_neg, + add_assoc, add_comm]; try abel + · refine ⟨{z - u, (z - u) + ⟨0, 1⟩}, ?_, ?_⟩ + · change ∃ w, ({z - u, (z - u) + ⟨0, 1⟩} = {w, w + 1} ∧ + ((w ∈ T.cells ∧ w - ⟨0, 1⟩ ∉ T.cells) ∨ + (w ∉ T.cells ∧ w - ⟨0, 1⟩ ∈ T.cells))) ∨ + ({z - u, (z - u) + ⟨0, 1⟩} = {w, w + ⟨0, 1⟩} ∧ + ((w ∈ T.cells ∧ w - 1 ∉ T.cells) ∨ + (w ∉ T.cells ∧ w - 1 ∈ T.cells))) + refine ⟨z - u, Or.inr ⟨rfl, Or.inr ?_⟩⟩ + convert hz using 1 <;> + simp [translatedCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] + · simp [GaussianTranslation, Finset.image_insert, sub_eq_add_neg, + add_assoc, add_comm]; try abel + · rintro ⟨f, hf, rfl⟩ + rcases hf with ⟨z, hz⟩ + rcases hz with ⟨hf, hz⟩ | ⟨hf, hz⟩ + · refine ⟨z + u, ?_⟩ + left + refine ⟨?_, ?_⟩ + · simpa [GaussianTranslation, Finset.image_insert, add_assoc, add_comm] + using congrArg (fun q => q.image (GaussianTranslation u)) hf + · convert hz using 1 <;> + simp [translatedCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] <;> try abel; simp + · refine ⟨z + u, ?_⟩ + right + refine ⟨?_, ?_⟩ + · simpa [GaussianTranslation, Finset.image_insert, add_assoc, add_comm] + using congrArg (fun q => q.image (GaussianTranslation u)) hf + · convert hz using 1 <;> + simp [translatedCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] <;> try abel; simp + have imageNonempty : (T.cells.image (GaussianTranslation u)).Nonempty := + h.image _ + simp only [ite_eq_left imageNonempty] + change (v ∈ {v | ∃ e ∈ BoundaryFootprintEdges (TileTranslation T u), v ∈ e}) ↔ _ + rw [edgeFormula] + constructor + · rintro ⟨e, ⟨f, hf, rfl⟩, hv⟩ + rcases Finset.mem_image.mp hv with ⟨y, hy, rfl⟩ + exact ⟨y, ⟨f, hf, hy⟩, rfl⟩ + · rintro ⟨y, ⟨f, hf, hy⟩, rfl⟩ + exact ⟨f.image (GaussianTranslation u), ⟨f, hf, rfl⟩, + Finset.mem_image.mpr ⟨y, hy, rfl⟩⟩ + · simp [BoundaryFootprintVertices, GaussianTranslation, h] + +private theorem translationBoundaryEdges (T : ProtoTile) (u : GaussianInt) : + BoundaryFootprintEdges (TileTranslation T u) = + (fun e : Finset GaussianInt => e.image (GaussianTranslation u)) '' + BoundaryFootprintEdges T := by + dsimp [TileTranslation] + ext e + have translatedCell (z : GaussianInt) : + z ∈ (TileTranslation T u).cells ↔ z - u ∈ T.cells := by + change z ∈ T.cells.image (GaussianTranslation u) ↔ z - u ∈ T.cells + constructor + · intro hz + rw [Finset.mem_image] at hz + rcases hz with ⟨a, ha, rfl⟩ + simpa [GaussianTranslation, sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] using ha + · intro hz + apply Finset.mem_image.mpr + refine ⟨z - u, hz, ?_⟩ + simp [GaussianTranslation, sub_eq_add_neg, add_comm, + ] + change (∃ z : GaussianInt, + (e = {z, z + 1} ∧ + ((z ∈ (TileTranslation T u).cells ∧ + z - ⟨0, 1⟩ ∉ (TileTranslation T u).cells) ∨ + (z ∉ (TileTranslation T u).cells ∧ + z - ⟨0, 1⟩ ∈ (TileTranslation T u).cells))) ∨ + (e = {z, z + ⟨0, 1⟩} ∧ + ((z ∈ (TileTranslation T u).cells ∧ + z - 1 ∉ (TileTranslation T u).cells) ∨ + (z ∉ (TileTranslation T u).cells ∧ + z - 1 ∈ (TileTranslation T u).cells)))) ↔ + ∃ f, f ∈ BoundaryFootprintEdges T ∧ + f.image (GaussianTranslation u) = e + constructor + · rintro ⟨z, hz⟩ + rcases hz with ⟨he, hp⟩ | ⟨he, hp⟩ + · rcases hp with hp | hp + · refine ⟨{z - u, (z - u) + 1}, ?_, ?_⟩ + · refine ⟨z - u, Or.inl ⟨rfl, Or.inl ?_⟩⟩ + simpa [translatedCell, sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] using hp + · subst e + simp [GaussianTranslation, Finset.image_insert, sub_eq_add_neg, + add_assoc, add_comm]; abel + · refine ⟨{z - u, (z - u) + 1}, ?_, ?_⟩ + · refine ⟨z - u, Or.inl ⟨rfl, Or.inr ?_⟩⟩ + simpa [translatedCell, sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] using hp + · subst e + simp [GaussianTranslation, Finset.image_insert, sub_eq_add_neg, + add_assoc, add_comm]; abel + · rcases hp with hp | hp + · refine ⟨{z - u, (z - u) + ⟨0, 1⟩}, ?_, ?_⟩ + · refine ⟨z - u, Or.inr ⟨rfl, Or.inl ?_⟩⟩ + simpa [translatedCell, sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] using hp + · subst e + simp [GaussianTranslation, Finset.image_insert, sub_eq_add_neg, + add_assoc, add_comm]; abel + · refine ⟨{z - u, (z - u) + ⟨0, 1⟩}, ?_, ?_⟩ + · refine ⟨z - u, Or.inr ⟨rfl, Or.inr ?_⟩⟩ + simpa [translatedCell, sub_eq_add_neg, add_assoc, add_comm, + add_left_comm] using hp + · subst e + simp [GaussianTranslation, Finset.image_insert, sub_eq_add_neg, + add_assoc, add_comm]; abel + · rintro ⟨f, hf, he⟩ + rcases hf with ⟨z, hz⟩ + rcases hz with ⟨hf, hp⟩ | ⟨hf, hp⟩ + · refine ⟨z + u, ?_⟩ + left + refine ⟨?_, ?_⟩ + · rw [← he] + simpa [GaussianTranslation, Finset.image_insert, add_assoc, add_comm] + using congrArg (fun q => q.image (GaussianTranslation u)) hf + · subst e + rw [translatedCell, translatedCell] + rcases hp with hp | hp + · left + constructor + · simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hp.1 + · have shift : z + u - ⟨0, 1⟩ - u = z - ⟨0, 1⟩ := by abel + rw [shift] + exact hp.2 + · right + constructor + · simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hp.1 + · have shift : z + u - ⟨0, 1⟩ - u = z - ⟨0, 1⟩ := by abel + rw [shift] + exact hp.2 + · refine ⟨z + u, ?_⟩ + right + refine ⟨?_, ?_⟩ + · rw [← he] + simpa [GaussianTranslation, Finset.image_insert, add_assoc, add_comm] + using congrArg (fun q => q.image (GaussianTranslation u)) hf + · subst e + rw [translatedCell, translatedCell] + rcases hp with hp | hp + · left + constructor + · simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hp.1 + · have shift : z + u - 1 - u = z - 1 := by abel + rw [shift] + exact hp.2 + · right + constructor + · simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hp.1 + · have shift : z + u - 1 - u = z - 1 := by abel + rw [shift] + exact hp.2 + +theorem TileTranslationFormulas (T : ProtoTile) (u : GaussianInt) : + (TileTranslation T u).cells = T.cells.image (GaussianTranslation u) ∧ + (TileTranslation T u).anchor = GaussianTranslation u T.anchor ∧ + ((TileTranslation T u).cells = ∅ ↔ T.cells = ∅) ∧ + TileRealization (TileTranslation T u) = + (fun p : Real × Real => + (p.1 + (u.re : Int), p.2 + (u.im : Int))) '' TileRealization T ∧ + TileCentroid (TileTranslation T u) = + ((TileCentroid T).1 + (u.re : Int), + (TileCentroid T).2 + (u.im : Int)) ∧ + FootprintVertices (TileTranslation T u) = + GaussianTranslation u '' FootprintVertices T ∧ + FootprintEdges (TileTranslation T u) = + (fun e : Finset GaussianInt => e.image (GaussianTranslation u)) '' + FootprintEdges T ∧ + BoundaryFootprintVertices (TileTranslation T u) = + GaussianTranslation u '' BoundaryFootprintVertices T ∧ + BoundaryFootprintEdges (TileTranslation T u) = + (fun e : Finset GaussianInt => e.image (GaussianTranslation u)) '' + BoundaryFootprintEdges T := by + refine ⟨rfl, rfl, ?_, translationRealization T u, translationCentroid T u, translationVertices + T u, translationEdges T u, translationBoundaryVertices T u, translationBoundaryEdges T u⟩ + simp [TileTranslation] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TilingLattice.lean b/LeanPool/ApollonianSuperharmonic/TilingLattice.lean new file mode 100644 index 0000000000..499fc66537 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TilingLattice.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.BandCircle + +-- [TABLET NODE: TilingLattice] + +/-! +# TilingLattice + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a curvature-one band circle set $\Lambda_C=\mathbb Z[i]$. Otherwise, +let $(C,C_1,C_2,C_3)$ be its unique proper parent quadruple and set +$$ + \Lambda_C=\mathbb Z v(C_1,C)+\mathbb Z v(C_2,C)+\mathbb Z v(C_3,C), +$$ +as the additive subgroup generated by the three incoming parent vectors. +Equivalently one may use any two: the parent triple is unique up to rotation, +and the superbasis relation makes the third generator redundant. This +definition is independent of $L_C$. +-/ +def TilingLattice (C : BandCircle) : AddSubgroup GaussianInt := +-- BODY + if C.1.1.1 = 1 then ⊤ else + AddSubgroup.closure {u | ∃ q : Fin 4 → CircleCoordinates, + SemiProperQuadruple q ∧ q 0 = C.1.1 ∧ + (∀ j : Fin 3, (q j.succ).1 < C.1.1.1) ∧ + ∃ j : Fin 3, u = BandVectors.1 (q j.succ) (q 0)} + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean b/LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean new file mode 100644 index 0000000000..88e149d286 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean @@ -0,0 +1,829 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws + +-- [TABLET NODE: TilingLatticeBasis] + +/-! +# TilingLatticeBasis + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TilingBasisProof + +private theorem relation : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (BandVectors.1 (q 1) (q 0) + + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) ) := by + classical + intro q hq + let r : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + have hr : SemiProperQuadruple r := by + simpa [r] using SemiProperQuadruple.rotate hq.1 + let s : Fin 4 → CircleCoordinates := ![r 0, r 2, r 3, r 1] + have hs : SemiProperQuadruple s := by + simpa [s] using SemiProperQuadruple.rotate hr + have first := VectorRecursionLaws q hq.1 + have second := VectorRecursionLaws r hr + have third := VectorRecursionLaws s hs + have e0 := first.2.2.1 + have e1 := second.2.2.1 + have e2 := third.2.2.1 + simp? [r, s] at e1 e2 + rw [e0, e1, e2] + calc + _ = (1 - (⟨0, 1⟩ : GaussianInt)) * + (BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 1) (q 3) + + BandVectors.1 (q 2) (q 1)) := by ring + _ = 0 := by rw [first.1]; simp + +private theorem flipA : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (BandVectors.1 (q 0) (q 1) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 1) (q 0)) ) := by + classical + intro q hq + simpa using (VectorRecursionLaws q hq.1).2.2.2.2 hq ⟨0, by decide⟩ |>.1 + +private theorem flipB : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (BandVectors.1 (q 0) (q 2) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 2) (q 0)) ) := by + classical + intro q hq + simpa using (VectorRecursionLaws q hq.1).2.2.2.2 hq ⟨1, by decide⟩ |>.1 + +private theorem nonnegative : + (by + classical + exact + ∀ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 ) := by + classical + intro r hr + induction hr with + | base z => intro k; fin_cases k <;> simp + | rotate hr ih => + intro k + fin_cases k <;> simp_all + | @successor r hr ih => + intro k + have classification := BandSuccessorClassification r hr + dsimp at classification + rcases classification with special | proper + · fin_cases k + · simp [special] + · exact ih 0 + · exact ih 2 + · exact ih 3 + · rcases proper with ⟨_, larger0, larger2, larger3⟩ + fin_cases k + · exact (ih 0).trans larger0.le + · exact ih 0 + · exact ih 2 + · exact ih 3 + +private theorem impossible : + (by + classical + exact + (∀ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1) → (∀ + r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → (r 0).1 = 1 → (∀ j : Fin 3, (r + j.succ).1 = 0) → False) ) := by + classical + intro nonnegative r hr + induction hr with + | base z => + intro h0 hz + have h := hz ⟨0, by decide⟩ + simp at h0 h + | rotate hr ih => + intro h0 hz + apply ih h0 + intro j + fin_cases j + · simpa using hz ⟨2, by decide⟩ + · simpa using hz ⟨0, by decide⟩ + · simpa using hz ⟨1, by decide⟩ + | @successor r hr ih => + intro h0 hz + have hq0 : (r 0).1 = 0 := by simpa using hz ⟨0, by decide⟩ + have hq2 : (r 2).1 = 0 := by simpa using hz ⟨1, by decide⟩ + have hq3 : (r 3).1 = 0 := by simpa using hz ⟨2, by decide⟩ + have hq1 := nonnegative r hr 1 + have hnew := h0 + dsimp at hnew + omega + +private theorem hc : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ((q (0 : + Fin (4 : ℕ)) = C.1.1) → ((∀ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → ∀ + k : Fin 4, 0 ≤ (r k).1) → ((∀ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → + (r 0).1 = 1 → (∀ j : Fin 3, (r j.succ).1 = 0) → False) → (C.1.1.1 ≠ 1)))) ) := by + classical + intro C q hq hC nonnegative impossible heq + apply impossible q hq.1 + · simpa [hC] using heq + intro j + have hlt := hq.2 j + have hn := nonnegative q hq.1 j.succ + have he := heq + rw [← hC] at he + omega + +private theorem generator_mem : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ((q (0 : + Fin (4 : ℕ)) = C.1.1) → ((BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + + BandVectors.1 (q 3) (q 0) = 0) → (∀ (p : Fin (4 : ℕ) → CircleCoordinates), (∀ (q' : + Fin (4 : ℕ) → CircleCoordinates), SemiProperQuadruple q' → q' (0 : Fin (4 : ℕ)) = + C.1.1 → (∀ (j : Fin (3 : ℕ)), (q' j.succ).1 < C.1.1.1) → ∀ (D : CircleCoordinates), + (∃ (j : Fin (3 : ℕ)), p j.succ = D) ↔ ∃ (j : Fin (3 : ℕ)), q' j.succ = D) → ( + let K : AddSubgroup GaussianInt := AddSubgroup.closure + ({BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0)} : Set GaussianInt) + ∀ x : GaussianInt, (∃ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r ∧ r 0 = C.1.1 + ∧ (∀ j : Fin 3, (r j.succ).1 < C.1.1.1) ∧ ∃ j : Fin 3, x = BandVectors.1 (r j.succ) + (r 0)) → x ∈ K)))) ) := by + classical + intro C q hq hC relation p huniq K x hx + rcases hx with ⟨r, hr, hr0, hrt, j, hx⟩ + have hs : ∀ k : Fin 3, (r k.succ).1 < C.1.1.1 := hrt + have child := (huniq r hr hr0 hs (r j.succ)).mpr ⟨j, rfl⟩ + rcases child with ⟨k, hk⟩ + have child' := (huniq q hq.1 hC (by simpa [hC] using hq.2) (p k.succ)).mp ⟨k, rfl⟩ + rcases child' with ⟨l, hl⟩ + fin_cases l + · rw [hx, ← hk, ← hl, hr0, ← hC] + exact AddSubgroup.subset_closure (by simp) + · rw [hx, ← hk, ← hl, hr0, ← hC] + exact AddSubgroup.subset_closure (by simp) + · rw [hx, ← hk, ← hl, hr0, ← hC] + simp? at hl ⊢ + have cneg : BandVectors.1 (q 3) (q 0) = + -(BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0)) := by + apply eq_neg_of_add_eq_zero_left + simpa [add_assoc, add_left_comm, add_comm] using relation + rw [cneg] + exact K.neg_mem (K.add_mem + (AddSubgroup.subset_closure (by simp)) + (AddSubgroup.subset_closure (by simp))) + +private theorem lattice_le : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), (C.1.1.1 ≠ 1) → ( + let K : AddSubgroup GaussianInt := AddSubgroup.closure + ({BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0)} : Set GaussianInt) + (∀ x : GaussianInt, (∃ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r ∧ r 0 = C.1.1 + ∧ (∀ j : Fin 3, (r j.succ).1 < C.1.1.1) ∧ ∃ j : Fin 3, x = BandVectors.1 (r j.succ) + (r 0)) → x ∈ K) → (TilingLattice C ≤ K)) ) := by + classical + intro C q hc K generator_mem + unfold TilingLattice + simp only [ite_eq_right hc] + rw [AddSubgroup.closure_le] + intro x hx + exact generator_mem x hx + +private theorem first_mem : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ((q (0 : + Fin (4 : ℕ)) = C.1.1) → ((C.1.1.1 ≠ 1) → (BandVectors.1 (q 1) (q 0) ∈ TilingLattice + C))) ) := by + classical + intro C q hq hC hc + unfold TilingLattice + simp only [ite_eq_right hc] + exact AddSubgroup.subset_closure ⟨q, hq.1, hC, by simpa [hC] using hq.2, + ⟨0, by simp⟩⟩ + +private theorem second_mem : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ((q (0 : + Fin (4 : ℕ)) = C.1.1) → ((C.1.1.1 ≠ 1) → (BandVectors.1 (q 2) (q 0) ∈ TilingLattice + C))) ) := by + classical + intro C q hq hC hc + unfold TilingLattice + simp only [ite_eq_right hc] + exact AddSubgroup.subset_closure ⟨q, hq.1, hC, by simpa [hC] using hq.2, + ⟨1, by simp⟩⟩ + +private theorem lattice_eq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), + let K : AddSubgroup GaussianInt := AddSubgroup.closure + ({BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0)} : Set GaussianInt) + (TilingLattice C ≤ K) → ((BandVectors.1 (q 1) (q 0) ∈ TilingLattice C) → ((BandVectors.1 + (q 2) (q 0) ∈ TilingLattice C) → (TilingLattice C = K))) ) := by + classical + intro C q K lattice_le first_mem second_mem + apply le_antisymm lattice_le + change AddSubgroup.closure + ({BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0)} : Set GaussianInt) ≤ + TilingLattice C + rw [AddSubgroup.closure_le] + intro x hx + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hx + rcases hx with rfl | rfl + · exact first_mem + · exact second_mem + +private theorem positive : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), (q (0 : Fin (4 : ℕ)) = C.1.1) → (0 + < (q 0).1) ) := by + classical + intro C q hC + rw [hC] + exact C.2 + +private theorem determinant_value : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let successorQuad : Fin 4 → CircleCoordinates := + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), q 0, q 2, q 3] + (star (BandVectors.1 (successorQuad (1 : Fin (4 : ℕ))) (successorQuad (3 : Fin (4 : ℕ)))) + * BandVectors.1 (successorQuad (2 : Fin (4 : ℕ))) (successorQuad (1 : Fin (4 : ℕ))) + + BandVectors.1 (successorQuad (1 : Fin (4 : ℕ))) (successorQuad (3 : Fin (4 : ℕ))) * + star (BandVectors.1 (successorQuad (2 : Fin (4 : ℕ))) (successorQuad (1 : Fin (4 : + ℕ)))) = (↑((-2 : ℤ) * (successorQuad (1 : Fin (4 : ℕ))).1) : GaussianInt) ∧ + ((BandVectors.1 (successorQuad (3 : Fin (4 : ℕ))) (successorQuad (1 : Fin (4 : + ℕ)))).re * (BandVectors.1 (successorQuad (2 : Fin (4 : ℕ))) (successorQuad (1 : Fin + (4 : ℕ)))).im - (BandVectors.1 (successorQuad (3 : Fin (4 : ℕ))) (successorQuad (1 : + Fin (4 : ℕ)))).im * (BandVectors.1 (successorQuad (2 : Fin (4 : ℕ))) (successorQuad + (1 : Fin (4 : ℕ)))).re).natAbs = (successorQuad (1 : Fin (4 : ℕ))).1.natAbs) → + (Int.natAbs ((BandVectors.1 (q 3) (q 0)).re * (BandVectors.1 (q 2) (q 0)).im - + (BandVectors.1 (q 3) (q 0)).im * (BandVectors.1 (q 2) (q 0)).re) = (q 0).1.natAbs) ) + := by + classical + intro q successorQuad determinant + simpa [successorQuad] using determinant.2 + +private theorem determinant_nonzero : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + + BandVectors.1 (q 3) (q 0) = 0) → ((0 < (q 0).1) → ((Int.natAbs ((BandVectors.1 (q + 3) (q 0)).re * (BandVectors.1 (q 2) (q 0)).im - (BandVectors.1 (q 3) (q 0)).im * + (BandVectors.1 (q 2) (q 0)).re) = (q 0).1.natAbs) → ( + let determinantNumber : Int := + (BandVectors.1 (q 1) (q 0)).re * (BandVectors.1 (q 2) (q 0)).im - + (BandVectors.1 (q 1) (q 0)).im * (BandVectors.1 (q 2) (q 0)).re + determinantNumber ≠ 0))) ) := by + classical + intro q relation positive determinant_value determinantNumber zero + have opposite : + (BandVectors.1 (q 3) (q 0)).re * (BandVectors.1 (q 2) (q 0)).im - + (BandVectors.1 (q 3) (q 0)).im * (BandVectors.1 (q 2) (q 0)).re = + -determinantNumber := by + have cneg : BandVectors.1 (q 3) (q 0) = + -(BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0)) := by + exact eq_neg_of_add_eq_zero_left + (by simpa [add_assoc, add_left_comm, add_comm] using relation) + rw [cneg] + dsimp [determinantNumber] + simp + ring + have zeroOpposite : + (BandVectors.1 (q 3) (q 0)).re * (BandVectors.1 (q 2) (q 0)).im - + (BandVectors.1 (q 3) (q 0)).im * (BandVectors.1 (q 2) (q 0)).re = 0 := by + rw [opposite, zero] + simp + have vanish := determinant_value + rw [zeroOpposite] at vanish + have qzero : (q 0).1.natAbs = 0 := by simpa using vanish.symm + have : (q 0).1 = 0 := Int.natAbs_eq_zero.mp qzero + omega + +private theorem coordinate_for : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let K : AddSubgroup GaussianInt := AddSubgroup.closure + ({BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0)} : Set GaussianInt) + ∀ x : GaussianInt, x ∈ K → ∃ mn : Int × Int, (mn.1 : GaussianInt) * BandVectors.1 (q 1) + (q 0) + (mn.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) = x ) := by + classical + intro q K x hx + induction hx using AddSubgroup.closure_induction with + | mem y hy => + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hy + rcases hy with rfl | rfl + · exact ⟨(1, 0), by simp⟩ + · exact ⟨(0, 1), by simp⟩ + | zero => exact ⟨(0, 0), by simp⟩ + | add x y hx hy ix iy => + rcases ix with ⟨mx, hx⟩ + rcases iy with ⟨my, hy⟩ + refine ⟨(mx.1 + my.1, mx.2 + my.2), ?_⟩ + calc + _ = (↑mx.1 * BandVectors.1 (q 1) (q 0) + + ↑mx.2 * BandVectors.1 (q 2) (q 0)) + + (↑my.1 * BandVectors.1 (q 1) (q 0) + + ↑my.2 * BandVectors.1 (q 2) (q 0)) := by + rw [Int.cast_add, Int.cast_add] + ring + _ = x + y := by rw [hx, hy] + | neg x hx ix => + rcases ix with ⟨m, hm⟩ + refine ⟨(-m.1, -m.2), ?_⟩ + calc + _ = -(↑m.1 * BandVectors.1 (q 1) (q 0) + + ↑m.2 * BandVectors.1 (q 2) (q 0)) := by + rw [Int.cast_neg, Int.cast_neg] + simp + ring + _ = -x := by rw [hm] + +private theorem coordinates : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), + let K : AddSubgroup GaussianInt := AddSubgroup.closure + ({BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0)} : Set GaussianInt) + (TilingLattice C = K) → ((∀ x : GaussianInt, x ∈ K → ∃ mn : Int × Int, (mn.1 : + GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : GaussianInt) * BandVectors.1 (q 2) + (q 0) = x) → (∀ w : TilingLattice C, ∃ mn : Int × Int, (mn.1 : GaussianInt) * + BandVectors.1 (q 1) (q 0) + (mn.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) = (w : + GaussianInt))) ) := by + classical + intro C q K lattice_eq coordinate_for w + apply coordinate_for + rw [← lattice_eq] + exact w.property + +private theorem unique_coordinates : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), + let determinantNumber : Int := + (BandVectors.1 (q 1) (q 0)).re * (BandVectors.1 (q 2) (q 0)).im - + (BandVectors.1 (q 1) (q 0)).im * (BandVectors.1 (q 2) (q 0)).re + (determinantNumber ≠ 0) → (∀ m n : Int × Int, (m.1 : GaussianInt) * BandVectors.1 (q 1) + (q 0) + (m.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) = (n.1 : GaussianInt) * + BandVectors.1 (q 1) (q 0) + (n.2 : GaussianInt) * BandVectors.1 (q 2) (q 0) → m = n) + ) := by + classical + intro q determinantNumber determinant_nonzero m n h + have realpart := congrArg (fun z : GaussianInt => z.re) h + have imagpart := congrArg (fun z : GaussianInt => z.im) h + simp? at realpart imagpart + have realzero : + (m.1 - n.1) * (BandVectors.1 (q 1) (q 0)).re + + (m.2 - n.2) * (BandVectors.1 (q 2) (q 0)).re = 0 := by + linarith + have imagzero : + (m.1 - n.1) * (BandVectors.1 (q 1) (q 0)).im + + (m.2 - n.2) * (BandVectors.1 (q 2) (q 0)).im = 0 := by + linarith + have first_difference : determinantNumber * (m.1 - n.1) = 0 := by + dsimp [determinantNumber] + calc + _ = (BandVectors.1 (q 2) (q 0)).im * + ((m.1 - n.1) * (BandVectors.1 (q 1) (q 0)).re + + (m.2 - n.2) * (BandVectors.1 (q 2) (q 0)).re) - + (BandVectors.1 (q 2) (q 0)).re * + ((m.1 - n.1) * (BandVectors.1 (q 1) (q 0)).im + + (m.2 - n.2) * (BandVectors.1 (q 2) (q 0)).im) := by ring + _ = 0 := by rw [realzero, imagzero]; ring + have second_difference : determinantNumber * (m.2 - n.2) = 0 := by + dsimp [determinantNumber] + calc + _ = (BandVectors.1 (q 1) (q 0)).re * + ((m.1 - n.1) * (BandVectors.1 (q 1) (q 0)).im + + (m.2 - n.2) * (BandVectors.1 (q 2) (q 0)).im) - + (BandVectors.1 (q 1) (q 0)).im * + ((m.1 - n.1) * (BandVectors.1 (q 1) (q 0)).re + + (m.2 - n.2) * (BandVectors.1 (q 2) (q 0)).re) := by ring + _ = 0 := by rw [realzero, imagzero]; ring + have first_equal : m.1 = n.1 := by + have := (mul_eq_zero.mp first_difference).resolve_left determinant_nonzero + omega + have second_equal : m.2 = n.2 := by + have := (mul_eq_zero.mp second_difference).resolve_left determinant_nonzero + omega + exact Prod.ext first_equal second_equal + +private theorem incoming_unique : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), (∀ w : TilingLattice C, ∃ mn : Int + × Int, (mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : GaussianInt) * + BandVectors.1 (q 2) (q 0) = (w : GaussianInt)) → ((∀ m n : Int × Int, (m.1 : + GaussianInt) * BandVectors.1 (q 1) (q 0) + (m.2 : GaussianInt) * BandVectors.1 (q 2) + (q 0) = (n.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (n.2 : GaussianInt) * + BandVectors.1 (q 2) (q 0) → m = n) → (∀ w : TilingLattice C, ∃! mn : Int × Int, (mn.1 + : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : GaussianInt) * BandVectors.1 (q + 2) (q 0) = (w : GaussianInt))) ) := by + classical + intro C q coordinates unique_coordinates w + rcases coordinates w with ⟨mn, hmn⟩ + refine ⟨mn, hmn, ?_⟩ + intro other hother + exact unique_coordinates other mn (hother.trans hmn.symm) + +private theorem image_mem : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandVectors.1 (q 0) (q 1) = (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (q 1) (q 0)) → ((BandVectors.1 (q 0) (q 2) = (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (q 2) (q 0)) → ( + let K : AddSubgroup GaussianInt := AddSubgroup.closure + ({BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0)} : Set GaussianInt) + (BandVectors.1 (q 0) (q 1) ∈ AddSubgroup.closure ({BandVectors.1 (q 0) (q 1), + BandVectors.1 (q 0) (q 2)} : Set GaussianInt)) → ((BandVectors.1 (q 0) (q 2) ∈ + AddSubgroup.closure ({BandVectors.1 (q 0) (q 1), BandVectors.1 (q 0) (q 2)} : Set + GaussianInt)) → (∀ x : GaussianInt, x ∈ K → (⟨0, 1⟩ : GaussianInt) * x ∈ + AddSubgroup.closure ({BandVectors.1 (q 0) (q 1), BandVectors.1 (q 0) (q 2)} : Set + GaussianInt))))) ) := by + classical + intro q flipA flipB K first_layout second_layout x hx + induction hx using AddSubgroup.closure_induction with + | mem y hy => + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hy + rcases hy with rfl | rfl + · simpa [flipA] using first_layout + · simpa [flipB] using second_layout + | zero => simp + | add x y hx hy ix iy => + rw [mul_add] + exact (AddSubgroup.closure _).add_mem ix iy + | neg x hx ix => + rw [mul_neg] + exact (AddSubgroup.closure _).neg_mem ix + +private theorem layout_coordinate_for : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ x : GaussianInt, x ∈ AddSubgroup.closure + ({BandVectors.1 (q 0) (q 1), BandVectors.1 (q 0) (q 2)} : Set GaussianInt) → ∃ mn : + Int × Int, (mn.1 : GaussianInt) * BandVectors.1 (q 0) (q 1) + (mn.2 : GaussianInt) * + BandVectors.1 (q 0) (q 2) = x ) := by + classical + intro q x hx + induction hx using AddSubgroup.closure_induction with + | mem y hy => + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hy + rcases hy with rfl | rfl + · exact ⟨(1, 0), by simp⟩ + · exact ⟨(0, 1), by simp⟩ + | zero => exact ⟨(0, 0), by simp⟩ + | add x y hx hy ix iy => + rcases ix with ⟨mx, hx⟩ + rcases iy with ⟨my, hy⟩ + refine ⟨(mx.1 + my.1, mx.2 + my.2), ?_⟩ + calc + _ = (↑mx.1 * BandVectors.1 (q 0) (q 1) + ↑mx.2 * BandVectors.1 (q 0) (q 2)) + + (↑my.1 * BandVectors.1 (q 0) (q 1) + ↑my.2 * BandVectors.1 (q 0) (q 2)) := by + rw [Int.cast_add, Int.cast_add] + ring + _ = x + y := by rw [hx, hy] + | neg x hx ix => + rcases ix with ⟨m, hm⟩ + refine ⟨(-m.1, -m.2), ?_⟩ + calc + _ = -(↑m.1 * BandVectors.1 (q 0) (q 1) + ↑m.2 * BandVectors.1 (q 0) (q 2)) := by + rw [Int.cast_neg, Int.cast_neg] + simp + ring + _ = -x := by rw [hm] + +private theorem incoming : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandVectors.1 (q 0) (q 1) = (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (q 1) (q 0)) → ((BandVectors.1 (q 0) (q 2) = (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (q 2) (q 0)) → (∀ (mn : ℤ × ℤ), ∀ (other : ℤ × ℤ), (-(⟨(0 : ℤ), (1 : + ℤ)⟩ : GaussianInt) * ((↑other.1 : GaussianInt) * BandVectors.1 (q (0 : Fin (4 : ℕ))) + (q (1 : Fin (4 : ℕ))) + (↑other.2 : GaussianInt) * BandVectors.1 (q (0 : Fin (4 : + ℕ))) (q (2 : Fin (4 : ℕ)))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * ((↑mn.1 : + GaussianInt) * BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) + (↑mn.2 : + GaussianInt) * BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))) → + ((other.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (other.2 : GaussianInt) * + BandVectors.1 (q 2) (q 0) = (mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 + : GaussianInt) * BandVectors.1 (q 2) (q 0)))) ) := by + classical + intro q flipA flipB mn other transformed + rw [mul_add, mul_add, flipA, flipB] at transformed + have iiSquare : ({ re := 0, im := 1 } : GaussianInt) ^ 2 = -1 := by + apply Zsqrtd.ext_iff.mpr + simp [pow_two] + have hunit : -({ re := 0, im := 1 } : GaussianInt) * + ({ re := 0, im := 1 } : GaussianInt) = 1 := by + rw [show -({ re := 0, im := 1 } : GaussianInt) * + ({ re := 0, im := 1 } : GaussianInt) = - + (({ re := 0, im := 1 } : GaussianInt) ^ 2) by ring, iiSquare] + simp + have scalar (n : Int) (z : GaussianInt) : + -({ re := 0, im := 1 } : GaussianInt) * + ((n : GaussianInt) * (({ re := 0, im := 1 } : GaussianInt) * z)) = + (n : GaussianInt) * z := by + calc + _ = ((-({ re := 0, im := 1 } : GaussianInt)) * + ({ re := 0, im := 1 } : GaussianInt)) * ((n : GaussianInt) * z) := by ring + _ = (n : GaussianInt) * z := by rw [hunit]; simp + rw [scalar, scalar, scalar, scalar] at transformed + exact transformed + +private theorem iiSquareAt530 : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + ii ^ 2 = -1 ) := by + classical + intro ii + dsimp [ii] + norm_num [pow_two, Zsqrtd.ext_iff] + +private theorem hunitAt533 : + (by + classical + exact + let ii : GaussianInt := ⟨0, 1⟩ + (ii ^ 2 = -1) → (-ii * ii = 1) ) := by + classical + intro ii iiSquare + calc + -ii * ii = -(ii ^ 2) := by rw [pow_two]; ring + _ = 1 := by rw [iiSquare]; simp + +private theorem image_tiling : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), (BandVectors.1 (q 0) (q 1) = (⟨0, + 1⟩ : GaussianInt) * BandVectors.1 (q 1) (q 0)) → ((BandVectors.1 (q 0) (q 2) = (⟨0, + 1⟩ : GaussianInt) * BandVectors.1 (q 2) (q 0)) → ( + let K : AddSubgroup GaussianInt := AddSubgroup.closure + ({BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0)} : Set GaussianInt) + (TilingLattice C ≤ K) → ((TilingLattice C = K) → ((BandVectors.1 (q 0) (q 1) ∈ + AddSubgroup.closure ({BandVectors.1 (q 0) (q 1), BandVectors.1 (q 0) (q 2)} : Set + GaussianInt)) → ((BandVectors.1 (q 0) (q 2) ∈ AddSubgroup.closure + ({BandVectors.1 (q 0) (q 1), BandVectors.1 (q 0) (q 2)} : Set GaussianInt)) → ( + let ii : GaussianInt := ⟨0, 1⟩ + ∀ y : GaussianInt, y ∈ TilingLattice C → ii * y ∈ AddSubgroup.closure + ({BandVectors.1 (q 0) (q 1), BandVectors.1 (q 0) (q 2)} : Set GaussianInt))))))) ) := by + classical + intro C q flipA flipB K lattice_le lattice_eq first_layout second_layout ii y hy + have hk : y ∈ K := lattice_le hy + induction hk using AddSubgroup.closure_induction with + | mem z hz => + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with rfl | rfl + · simpa [ii, flipA] using first_layout + · simpa [ii, flipB] using second_layout + | zero => simp [ii] + | add z t hz ht iz it => + rw [mul_add] + exact (AddSubgroup.closure _).add_mem (iz (by rw [lattice_eq]; exact hz)) + (it (by rw [lattice_eq]; exact ht)) + | neg z hz iz => + rw [mul_neg] + exact (AddSubgroup.closure _).neg_mem (iz (by rw [lattice_eq]; exact hz)) + +private theorem layout_preimage : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), (BandVectors.1 (q 0) (q 1) = (⟨0, + 1⟩ : GaussianInt) * BandVectors.1 (q 1) (q 0)) → ((BandVectors.1 (q 0) (q 2) = (⟨0, + 1⟩ : GaussianInt) * BandVectors.1 (q 2) (q 0)) → ((BandVectors.1 (q 1) (q 0) ∈ + TilingLattice C) → ((BandVectors.1 (q 2) (q 0) ∈ TilingLattice C) → ( + let ii : GaussianInt := ⟨0, 1⟩ + (-ii * ii = 1) → (∀ y : GaussianInt, y ∈ AddSubgroup.closure ({BandVectors.1 (q 0) (q 1), + BandVectors.1 (q 0) (q 2)} : Set GaussianInt) → (-ii) * y ∈ TilingLattice C))))) ) := by + classical + intro C q flipA flipB first_mem second_mem ii hunit y hy + induction hy using AddSubgroup.closure_induction with + | mem z hz => + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with rfl | rfl + · rw [flipA] + rw [show -ii * (ii * BandVectors.1 (q 1) (q 0)) = + BandVectors.1 (q 1) (q 0) by rw [← mul_assoc, hunit, one_mul]] + exact first_mem + · rw [flipB] + rw [show -ii * (ii * BandVectors.1 (q 2) (q 0)) = + BandVectors.1 (q 2) (q 0) by rw [← mul_assoc, hunit, one_mul]] + exact second_mem + | zero => simp [ii] + | add z t hz ht iz it => + rw [mul_add] + exact (TilingLattice C).add_mem iz it + | neg z hz iz => + rw [mul_neg] + exact (TilingLattice C).neg_mem iz + +private theorem hcoset : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (R : Finset GaussianInt), ∀ (x : + GaussianInt), + let ii : GaussianInt := ⟨0, 1⟩ + (ii ^ 2 = -1) → ((∀ y : GaussianInt, y ∈ TilingLattice C → ii * y ∈ AddSubgroup.closure + ({BandVectors.1 (q 0) (q 1), BandVectors.1 (q 0) (q 2)} : Set GaussianInt)) → (∀ (r : + GaussianInt), (r ∈ R ∧ -ii * x - r ∈ TilingLattice C) → (x - ii * r ∈ + AddSubgroup.closure ({BandVectors.1 (q 0) (q 1), BandVectors.1 (q 0) (q 2)} : Set + GaussianInt)))) ) := by + classical + intro C q R x ii iiSquare image_tiling r hr + have := image_tiling ((-ii) * x - r) hr.2 + convert this using 1; ring_nf; simp [iiSquare] + +private theorem hpre' : + (by + classical + exact + ∀ (C : BandCircle), ∀ (x : GaussianInt), + let ii : GaussianInt := ⟨0, 1⟩ + (-ii * ii = 1) → (∀ (t : GaussianInt), (-ii * (x - ii * t) ∈ TilingLattice C) → ((-ii) * + x - t ∈ TilingLattice C)) ) := by + classical + intro C x ii hunit t hpre + have identity : (-ii) * (x - ii * t) = (-ii) * x - t := by + rw [mul_sub, ← mul_assoc, hunit, one_mul] + rw [identity] at hpre + exact hpre + +end TilingBasisProof + +theorem TilingLatticeBasis (C : BandCircle) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hC : q 0 = C.1.1) : + let a := BandVectors.1 (q 1) (q 0) + let b := BandVectors.1 (q 2) (q 0) + let u := BandVectors.1 (q 0) (q 1) + let v := BandVectors.1 (q 0) (q 2) + let L := AddSubgroup.closure ({u, v} : Set GaussianInt) + a ∈ TilingLattice C ∧ b ∈ TilingLattice C ∧ + (∀ w : TilingLattice C, ∃! mn : Int × Int, + (mn.1 : GaussianInt) * a + (mn.2 : GaussianInt) * b = + (w : GaussianInt)) ∧ + u ∈ L ∧ v ∈ L ∧ + (∀ z : GaussianInt, z ∈ L ↔ + ∃ w : GaussianInt, w ∈ TilingLattice C ∧ + z = (⟨0, 1⟩ : GaussianInt) * w) ∧ + (∀ w : L, ∃! mn : Int × Int, + (mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v = + (w : GaussianInt)) ∧ + ∃ R : Finset GaussianInt, + LatticeFundamentalSet L R ∧ R.card = C.1.1.1.natAbs := by +-- BODY + classical + dsimp + have relation := TilingBasisProof.relation q hq + have flipA := TilingBasisProof.flipA q hq + have flipB := TilingBasisProof.flipB q hq + have nonnegative := TilingBasisProof.nonnegative + have impossible := TilingBasisProof.impossible nonnegative + have hc := TilingBasisProof.hc C q hq hC nonnegative impossible + obtain ⟨p, hp, hp0, hsmall, huniq⟩ := Or.resolve_left (BandGenealogy C) hc + let K : AddSubgroup GaussianInt := AddSubgroup.closure + ({BandVectors.1 (q 1) (q 0), BandVectors.1 (q 2) (q 0)} : Set GaussianInt) + have generator_mem := TilingBasisProof.generator_mem C q hq hC relation p huniq + have lattice_le := TilingBasisProof.lattice_le C q hc generator_mem + have first_mem := TilingBasisProof.first_mem C q hq hC hc + have second_mem := TilingBasisProof.second_mem C q hq hC hc + have lattice_eq : TilingLattice C = K := TilingBasisProof.lattice_eq C q lattice_le first_mem + second_mem + have positive : 0 < (q 0).1 := TilingBasisProof.positive C q hC + let successorQuad : Fin 4 → CircleCoordinates := + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), q 0, q 2, q 3] + have determinant := VectorDeterminant successorQuad + (SemiProperQuadruple.successor hq.1) (by simpa [successorQuad] using positive) + have determinant_value := TilingBasisProof.determinant_value q determinant + let determinantNumber : Int := + (BandVectors.1 (q 1) (q 0)).re * (BandVectors.1 (q 2) (q 0)).im - + (BandVectors.1 (q 1) (q 0)).im * (BandVectors.1 (q 2) (q 0)).re + have determinant_nonzero := TilingBasisProof.determinant_nonzero q relation positive + determinant_value + have coordinate_for := TilingBasisProof.coordinate_for q + have coordinates := TilingBasisProof.coordinates C q lattice_eq coordinate_for + have unique_coordinates := TilingBasisProof.unique_coordinates q determinant_nonzero + have incoming_unique := TilingBasisProof.incoming_unique C q coordinates unique_coordinates + have first_layout : BandVectors.1 (q 0) (q 1) ∈ + AddSubgroup.closure ({BandVectors.1 (q 0) (q 1), BandVectors.1 (q 0) (q 2)} : Set + GaussianInt) := + AddSubgroup.subset_closure (by simp) + have second_layout : BandVectors.1 (q 0) (q 2) ∈ + AddSubgroup.closure ({BandVectors.1 (q 0) (q 1), BandVectors.1 (q 0) (q 2)} : Set + GaussianInt) := + AddSubgroup.subset_closure (by simp) + obtain ⟨R, hR, hcard⟩ := TilingLatticeIndex C + refine ⟨first_mem, second_mem, incoming_unique, first_layout, second_layout, ?_, ?_, ?_⟩ + · intro z + constructor + · intro hz + induction hz using AddSubgroup.closure_induction with + | mem y hy => + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hy + rcases hy with rfl | rfl + · exact ⟨BandVectors.1 (q 1) (q 0), first_mem, flipA⟩ + · exact ⟨BandVectors.1 (q 2) (q 0), second_mem, flipB⟩ + | zero => exact ⟨0, (TilingLattice C).zero_mem, by simp⟩ + | add x y hx hy ix iy => + rcases ix with ⟨wx, hwx, ex⟩ + rcases iy with ⟨wy, hwy, ey⟩ + refine ⟨wx + wy, (TilingLattice C).add_mem hwx hwy, ?_⟩ + rw [ex, ey] + simp [mul_add] + | neg x hx ix => + rcases ix with ⟨w, hw, ex⟩ + refine ⟨-w, (TilingLattice C).neg_mem hw, ?_⟩ + rw [ex] + simp + · rintro ⟨w, hw, rfl⟩ + have image_mem : ∀ x : GaussianInt, x ∈ K → + (⟨0, 1⟩ : GaussianInt) * x ∈ + AddSubgroup.closure ({BandVectors.1 (q 0) (q 1), BandVectors.1 (q 0) (q 2)} : Set + GaussianInt) := TilingBasisProof.image_mem q flipA flipB first_layout second_layout + apply image_mem (w : GaussianInt) + rw [← lattice_eq] + exact hw + · intro w + have layout_coordinate_for := TilingBasisProof.layout_coordinate_for q + rcases layout_coordinate_for (w : GaussianInt) w.property with ⟨mn, hmn⟩ + refine ⟨mn, hmn, ?_⟩ + intro other hother + have transformed := congrArg (fun z : GaussianInt => + (-({ re := 0, im := 1 } : GaussianInt)) * z) (hother.trans hmn.symm) + have incoming := TilingBasisProof.incoming q flipA flipB mn other transformed + exact unique_coordinates other mn incoming + · refine ⟨Finset.image (fun x : GaussianInt => (⟨0, 1⟩ : GaussianInt) * x) R, ?_, ?_⟩ + · intro x + let ii : GaussianInt := ⟨0, 1⟩ + have iiSquare := TilingBasisProof.iiSquareAt530 + have hunit : -ii * ii = 1 := TilingBasisProof.hunitAt533 iiSquare + have hunit' : ii * (-ii) = 1 := by simpa [mul_comm] using hunit + have image_tiling := TilingBasisProof.image_tiling C q flipA flipB lattice_le lattice_eq + first_layout second_layout + have layout_preimage := TilingBasisProof.layout_preimage C q flipA flipB first_mem + second_mem hunit + rcases hR ((-ii) * x) with ⟨r, hr, hdiff⟩ + have hrep : ii * r ∈ Finset.image (fun z : GaussianInt => ii * z) R := + Finset.mem_image.mpr ⟨r, hr.1, rfl⟩ + have hcoset := TilingBasisProof.hcoset C q R x iiSquare image_tiling r hr + refine ⟨ii * r, ⟨hrep, hcoset⟩, ?_⟩ + intro s hs + rcases Finset.mem_image.mp hs.1 with ⟨t, ht, rfl⟩ + have hpre := layout_preimage (x - ii * t) hs.2 + have hpre' := TilingBasisProof.hpre' C x hunit t hpre + have equal_rep := (hR ((-ii) * x)).unique + ⟨hr.1, hr.2⟩ ⟨ht, hpre'⟩ + rw [equal_rep] + · rw [Finset.card_image_of_injective] + · exact hcard + · intro x y hxy + have := congrArg (fun z : GaussianInt => (-({ re := 0, im := 1 } : GaussianInt)) * z) hxy + apply_fun (fun z : GaussianInt => -({ re := 0, im := 1 } : GaussianInt) * z) at hxy + simpa [Zsqrtd.ext_iff] using hxy + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TilingLatticeCocycleExtension.lean b/LeanPool/ApollonianSuperharmonic/TilingLatticeCocycleExtension.lean new file mode 100644 index 0000000000..50bfaf400e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TilingLatticeCocycleExtension.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureGeneratorCocycles +public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis + +-- [TABLET NODE: TilingLatticeCocycleExtension] + +/-! +# TilingLatticeCocycleExtension + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TilingLatticeCocycleExtension (C : BandCircle) + (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) + (hC : q 0 = C.1.1) (g : IntegerLatticeFunction) + (hgen : ∀ j : Fin 3, ∀ x, + g (x + BandVectors.1 (q j.succ) (q 0)) = g x + + x.re * (BandVectors.2 (q j.succ) (q 0)).re + + x.im * (BandVectors.2 (q j.succ) (q 0)).im + + g (BandVectors.1 (q j.succ) (q 0))) : + ∀ v, v ∈ TilingLattice C → ∃ a : GaussianInt, + Matrix.mulVec (CircleMatrix C) ![(v.re : ℝ), (v.im : ℝ)] = + ![(a.re : ℝ), (a.im : ℝ)] ∧ + ∀ x, g (x + v) = g x + x.re * a.re + x.im * a.im + g v := by +-- BODY + classical + intro w hw + let a := BandVectors.1 (q 1) (q 0) + let b := BandVectors.1 (q 2) (q 0) + have basis := TilingLatticeBasis C q hq hC + dsimp at basis + obtain ⟨ha, hb, hcoords, hu, hv, hL, hLcoords, hfund⟩ := basis + obtain ⟨mn, hmn⟩ := hcoords ⟨w, hw⟩ + have hgenA := hgen ⟨0, by decide⟩ + have hgenB := hgen ⟨1, by decide⟩ + have hmatA := CircleMatrixIncomingVector C q hq.1 hC ⟨0, by decide⟩ + have hmatB := CircleMatrixIncomingVector C q hq.1 hC ⟨1, by decide⟩ + have gzero : g 0 = 0 := by + have h := hgenA 0 + simpa using congrArg (fun z : ℤ => z - g a) h + let K : AddSubgroup GaussianInt := AddSubgroup.closure ({a, b} : Set GaussianInt) + have cocycle : ∀ z : GaussianInt, z ∈ K → ∃ c : GaussianInt, + Matrix.mulVec (CircleMatrix C) ![(z.re : ℝ), (z.im : ℝ)] = + ![(c.re : ℝ), (c.im : ℝ)] ∧ + ∀ x, g (x + z) = g x + x.re * c.re + x.im * c.im + g z := by + intro z hz + induction hz using AddSubgroup.closure_induction with + | mem z hz => + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with rfl | rfl + · refine ⟨BandVectors.2 (q 1) (q 0), hmatA, ?_⟩ + exact hgenA + · refine ⟨BandVectors.2 (q 2) (q 0), hmatB, ?_⟩ + exact hgenB + | zero => + refine ⟨0, ?_, ?_⟩ + · ext i + fin_cases i <;> simp [Matrix.mulVec] + · intro x + simp [gzero] + | add z y hz hy iz iy => + rcases iz with ⟨c, hc, hz⟩ + rcases iy with ⟨d, hd, hy⟩ + refine ⟨c + d, ?_, ?_⟩ + · rw [show ![((z + y).re : ℝ), ((z + y).im : ℝ)] = + ![(z.re : ℝ), (z.im : ℝ)] + ![(y.re : ℝ), (y.im : ℝ)] by + ext i; fin_cases i <;> simp] + have hcr := congrFun hc 0 + have hci := congrFun hc 1 + have hdr := congrFun hd 0 + have hdi := congrFun hd 1 + ext i + fin_cases i + · simp [Matrix.mulVec] at hcr hdr ⊢ + nlinarith [hcr, hdr] + · simp [Matrix.mulVec] at hci hdi ⊢ + nlinarith [hci, hdi] + · intro x + rw [show x + (z + y) = (x + z) + y by abel] + rw [hy, hz] + have hyz := hy z + rw [hyz] + simp + ring_nf + | neg z hz iz => + rcases iz with ⟨c, hc, hz⟩ + refine ⟨-c, ?_, ?_⟩ + · have hlin : Matrix.mulVec (CircleMatrix C) ![(-z.re : ℝ), (-z.im : ℝ)] = + - Matrix.mulVec (CircleMatrix C) ![(z.re : ℝ), (z.im : ℝ)] := by + ext i + fin_cases i <;> simp [Matrix.mulVec] <;> ring + have hzre : ((-z).re : ℝ) = -(z.re : ℝ) := by + simp [] + have hzim : ((-z).im : ℝ) = -(z.im : ℝ) := by + simp [] + have hcre : ((-c).re : ℝ) = -(c.re : ℝ) := by + simp [] + have hcim : ((-c).im : ℝ) = -(c.im : ℝ) := by + simp [] + rw [hzre, hzim, hcre, hcim] + rw [hlin, hc] + simp + · intro x + have h := hz (x - z) + have hconst := hz (-z) + have hback : g 0 = g (-z) + (-z).re * c.re + (-z).im * c.im + g z := by + simpa using hconst + rw [gzero] at hback + have gzneg : g (-z) = z.re * c.re + z.im * c.im - g z := by + simp at hback + linarith [hback] + change g (x - z) = _ + rw [gzneg] + rw [show ((-c).re : ℤ) = -c.re by simp [], + show ((-c).im : ℤ) = -c.im by simp []] + simp at h + ring_nf at h ⊢ + linarith [h] + have hwK : w ∈ K := by + rw [show w = (mn.1 : GaussianInt) * a + (mn.2 : GaussianInt) * b by simpa [a, b] using + hmn.1.symm] + have aa : a ∈ K := AddSubgroup.subset_closure (by simp) + have bb : b ∈ K := AddSubgroup.subset_closure (by simp) + exact K.add_mem (by simpa [smul_eq_mul] using K.zsmul_mem aa mn.1) + (by simpa [smul_eq_mul] using K.zsmul_mem bb mn.2) + obtain ⟨c, hc, hformula⟩ := cocycle w hwK + exact ⟨c, hc, hformula⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TilingLatticeInclusion.lean b/LeanPool/ApollonianSuperharmonic/TilingLatticeInclusion.lean new file mode 100644 index 0000000000..9b566df664 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TilingLatticeInclusion.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector +public import LeanPool.ApollonianSuperharmonic.IntegralityLattice +public import LeanPool.ApollonianSuperharmonic.TilingLattice + +-- [TABLET NODE: TilingLatticeInclusion] + +/-! +# TilingLatticeInclusion + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TilingLatticeInclusion (C : BandCircle) : + TilingLattice C ≤ IntegralityLattice C := by +-- BODY + have hmatrix : + CircleMatrix C = + let c : ℝ := C.1.1.1 + let x : ℝ := C.1.1.2.re + let y : ℝ := C.1.1.2.im + (2 * c)⁻¹ • ![![1 + x, y], ![y, 1 - x]] := by + ext i j + fin_cases i <;> fin_cases j <;> + simp [CircleMatrix, BandCircleEuclideanData] + all_goals field_simp + by_cases hc : C.1.1.1 = 1 + · have parity : ∀ q : Fin 4 → CircleCoordinates, SemiProperQuadruple q → + ∀ j : Fin 4, ∃ a b : ℤ, + (q j).2.re = 1 + 2 * a ∧ + (q j).2.im = 2 * b := by + intro q hq + induction hq with + | base z => + intro j + fin_cases j + · exact ⟨z.re, z.im, by simp, by simp⟩ + · exact ⟨z.re, z.im + 1, by norm_num [Zsqrtd.ext_iff], by norm_num [Zsqrtd.ext_iff]; ring⟩ + · exact ⟨0, 0, by simp, by simp⟩ + · exact ⟨-1, 0, by simp, by simp⟩ + | rotate hq ih => + intro j + fin_cases j <;> simp_all + | @successor q hq ih => + intro j + fin_cases j + · dsimp + rcases ih 0 with ⟨a0, b0, ha0, hb0⟩ + rcases ih 1 with ⟨a1, b1, ha1, hb1⟩ + rcases ih 2 with ⟨a2, b2, ha2, hb2⟩ + rcases ih 3 with ⟨a3, b3, ha3, hb3⟩ + refine ⟨2 * a0 + 2 * a2 + 2 * a3 - a1 + 2, + 2 * b0 + 2 * b2 + 2 * b3 - b1, ?_, ?_⟩ + · rw [ha0, ha1, ha2, ha3] + ring + · rw [hb0, hb1, hb2, hb3] + ring + · simpa using ih 0 + · simpa using ih 2 + · simpa using ih 3 + unfold TilingLattice + split + · intro u hu + unfold IntegralityLattice + intro i + obtain ⟨q, hq, j, hj⟩ := C.1.2.2 + obtain ⟨a, b, ha, hb⟩ := parity q hq j + have hreal : (q j).1 = C.1.1.1 := by simp [hj] + have hxr : C.1.1.2.re = 1 + 2 * a := by simpa [hj] using ha + have hxi : C.1.1.2.im = 2 * b := by simpa [hj] using hb + fin_cases i + · refine ⟨u.re + a * u.re + b * u.im, ?_⟩ + simp [hmatrix, Matrix.mulVec, hc, hxr, hxi] + ring + · refine ⟨b * u.re - a * u.im, ?_⟩ + simp [hmatrix, Matrix.mulVec, hc, hxr, hxi] + ring + · rename_i h + exact (h hc).elim + · unfold TilingLattice + split + · rename_i h + exact (hc h).elim + · rw [AddSubgroup.closure_le] + intro u hu + obtain ⟨q, hq, hq0, hsmall, j, rfl⟩ := hu + intro i + obtain hvec := CircleMatrixIncomingVector C q hq hq0 j + have hcoord := congrFun hvec i + fin_cases i + · refine ⟨(BandVectors.2 (q j.succ) (q 0)).re, ?_⟩ + simpa [IntegralityLattice, Matrix.mulVec] using hcoord + · refine ⟨(BandVectors.2 (q j.succ) (q 0)).im, ?_⟩ + simpa [IntegralityLattice, Matrix.mulVec] using hcoord + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TilingLatticeIndex.lean b/LeanPool/ApollonianSuperharmonic/TilingLatticeIndex.lean new file mode 100644 index 0000000000..afe2eb4307 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TilingLatticeIndex.lean @@ -0,0 +1,516 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.VectorDeterminant +public import LeanPool.ApollonianSuperharmonic.TilingLattice +public import LeanPool.ApollonianSuperharmonic.LatticeFundamentalSet +public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.LinearAlgebra.FreeModule.Finite.CardQuotient + +-- [TABLET NODE: TilingLatticeIndex] + +/-! +# TilingLatticeIndex + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace TilingIndexProof + +private theorem relation : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (SemiProperQuadruple q) → (BandVectors.1 (q 1) + (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) ) := by + classical + intro q hq + let r : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] + have hr : SemiProperQuadruple r := by + simpa [r] using SemiProperQuadruple.rotate hq + let s : Fin 4 → CircleCoordinates := ![r 0, r 2, r 3, r 1] + have hs : SemiProperQuadruple s := by + simpa [s] using SemiProperQuadruple.rotate hr + have first := VectorRecursionLaws q hq + have second := VectorRecursionLaws r hr + have third := VectorRecursionLaws s hs + have e0 := first.2.2.1 + have e1 := second.2.2.1 + have e2 := third.2.2.1 + simp? [r, s] at e1 e2 + rw [e0, e1, e2] + calc + _ = (1 - (⟨0, 1⟩ : GaussianInt)) * + (BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 1) (q 3) + + BandVectors.1 (q 2) (q 1)) := by ring + _ = 0 := by rw [first.1]; simp + +private theorem first_mem : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let a : GaussianInt := BandVectors.1 (q 3) (q 0) + let b : GaussianInt := BandVectors.1 (q 2) (q 0) + let K : AddSubgroup GaussianInt := AddSubgroup.closure ({a, b} : Set GaussianInt) + (BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) → + (BandVectors.1 (q 1) (q 0) ∈ K) ) := by + classical + intro q a b K relation + have hsum : BandVectors.1 (q 1) (q 0) = -(b + a) := by + dsimp [a, b] + exact eq_neg_of_add_eq_zero_left (by simpa [add_assoc] using relation) + rw [hsum] + exact K.neg_mem (K.add_mem + (AddSubgroup.subset_closure (by simp [])) + (AddSubgroup.subset_closure (by simp []))) + +private theorem generator_mem : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (q (0 : Fin (4 : ℕ)) = + C.1.1) → ((∀ (q' : Fin (4 : ℕ) → CircleCoordinates), SemiProperQuadruple q' → q' (0 : + Fin (4 : ℕ)) = C.1.1 → (∀ (j : Fin (3 : ℕ)), (q' j.succ).1 < C.1.1.1) → ∀ (D : + CircleCoordinates), (∃ (j : Fin (3 : ℕ)), q j.succ = D) ↔ ∃ (j : Fin (3 : ℕ)), q' + j.succ = D) → ( + let a : GaussianInt := BandVectors.1 (q 3) (q 0) + let b : GaussianInt := BandVectors.1 (q 2) (q 0) + let K : AddSubgroup GaussianInt := AddSubgroup.closure ({a, b} : Set GaussianInt) + (BandVectors.1 (q 1) (q 0) ∈ K) → (∀ u : GaussianInt, (∃ q' : Fin 4 → CircleCoordinates, + SemiProperQuadruple q' ∧ q' 0 = C.1.1 ∧ (∀ j : Fin 3, (q' j.succ).1 < C.1.1.1) ∧ ∃ j + : Fin 3, u = BandVectors.1 (q' j.succ) (q' 0)) → u ∈ K))) ) := by + classical + intro C q hC huniq a b K first_mem u hu + rcases hu with ⟨q', hq', hC', hless', j, rfl⟩ + obtain ⟨k, hk⟩ := (huniq q' hq' hC' hless' (q' j.succ)).2 ⟨j, rfl⟩ + rw [hC', ← hC, ← hk] + fin_cases k + · exact first_mem + · exact AddSubgroup.subset_closure (by simp [b]) + · exact AddSubgroup.subset_closure (by simp [a]) + +private theorem lattice_le : + (by + classical + exact + ∀ (C : BandCircle), (¬C.1.1.1 = (1 : ℤ)) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let a : GaussianInt := BandVectors.1 (q 3) (q 0) + let b : GaussianInt := BandVectors.1 (q 2) (q 0) + let K : AddSubgroup GaussianInt := AddSubgroup.closure ({a, b} : Set GaussianInt) + (∀ u : GaussianInt, (∃ q' : Fin 4 → CircleCoordinates, SemiProperQuadruple q' ∧ q' 0 = + C.1.1 ∧ (∀ j : Fin 3, (q' j.succ).1 < C.1.1.1) ∧ ∃ j : Fin 3, u = BandVectors.1 (q' + j.succ) (q' 0)) → u ∈ K) → (TilingLattice C ≤ K)) ) := by + classical + intro C hunit q a b K generator_mem + unfold TilingLattice + simp only [hunit, ↓reduceIte] + rw [AddSubgroup.closure_le] + exact generator_mem + +private theorem a_mem : + (by + classical + exact + ∀ (C : BandCircle), (¬C.1.1.1 = (1 : ℤ)) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), + (SemiProperQuadruple q) → ((q (0 : Fin (4 : ℕ)) = C.1.1) → ((∀ (j : Fin (3 : ℕ)), (q + j.succ).1 < C.1.1.1) → ( + let a : GaussianInt := BandVectors.1 (q 3) (q 0) + a ∈ TilingLattice C)))) ) := by + classical + intro C hunit q hq hC hless a + unfold TilingLattice + simp only [hunit, ↓reduceIte] + exact AddSubgroup.subset_closure + ⟨q, hq, hC, hless, ⟨2, by simp [a]⟩⟩ + +private theorem b_mem : + (by + classical + exact + ∀ (C : BandCircle), (¬C.1.1.1 = (1 : ℤ)) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), + (SemiProperQuadruple q) → ((q (0 : Fin (4 : ℕ)) = C.1.1) → ((∀ (j : Fin (3 : ℕ)), (q + j.succ).1 < C.1.1.1) → ( + let b : GaussianInt := BandVectors.1 (q 2) (q 0) + b ∈ TilingLattice C)))) ) := by + classical + intro C hunit q hq hC hless b + unfold TilingLattice + simp only [hunit, ↓reduceIte] + exact AddSubgroup.subset_closure + ⟨q, hq, hC, hless, ⟨1, by simp [b]⟩⟩ + +private theorem lattice_eq : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let a : GaussianInt := BandVectors.1 (q 3) (q 0) + let b : GaussianInt := BandVectors.1 (q 2) (q 0) + let K : AddSubgroup GaussianInt := AddSubgroup.closure ({a, b} : Set GaussianInt) + (TilingLattice C ≤ K) → ((a ∈ TilingLattice C) → ((b ∈ TilingLattice C) → (TilingLattice + C = K))) ) := by + classical + intro C q a b K lattice_le a_mem b_mem + apply le_antisymm lattice_le + dsimp [K] + rw [AddSubgroup.closure_le] + intro x hx + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hx + rcases hx with rfl | rfl + · exact a_mem + · exact b_mem + +private theorem successor_positive : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (q (0 : Fin (4 : ℕ)) = + C.1.1) → ( + let successor : Fin 4 → CircleCoordinates := + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + (successor 1 = q 0) → (0 < (successor 1).1)) ) := by + classical + intro C q hC successor successor_parent + rw [successor_parent, hC] + exact C.2 + +private theorem determinant_value : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (q (0 : Fin (4 : ℕ)) = + C.1.1) → ( + let a : GaussianInt := BandVectors.1 (q 3) (q 0) + let b : GaussianInt := BandVectors.1 (q 2) (q 0) + let successor : Fin 4 → CircleCoordinates := + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + (SemiProperQuadruple successor) → ((0 < (successor 1).1) → (Int.natAbs (a.re * b.im - + a.im * b.re) = C.1.1.1.natAbs))) ) := by + classical + intro C q hC a b successor successor_semi successor_positive + have determinant := + (VectorDeterminant successor successor_semi successor_positive).2 + simpa [successor, a, b, hC] using determinant + +private theorem determinant_positive : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let a : GaussianInt := BandVectors.1 (q 3) (q 0) + let b : GaussianInt := BandVectors.1 (q 2) (q 0) + (Int.natAbs (a.re * b.im - a.im * b.re) = C.1.1.1.natAbs) → (0 < Int.natAbs (a.re * b.im + - a.im * b.re)) ) := by + classical + intro C q a b determinant_value + rw [determinant_value, Int.natAbs_pos] + exact C.2.ne' + +private theorem f_injective : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let a : GaussianInt := BandVectors.1 (q 3) (q 0) + let b : GaussianInt := BandVectors.1 (q 2) (q 0) + let K : AddSubgroup GaussianInt := AddSubgroup.closure ({a, b} : Set GaussianInt) + (0 < Int.natAbs (a.re * b.im - a.im * b.re)) → ( + let f : (Fin 2 → ℤ) →ₗ[ℤ] K := + { toFun := fun x => ⟨x 0 • a + x 1 • b, + K.add_mem (K.zsmul_mem (AddSubgroup.subset_closure (by simp [])) (x 0)) + (K.zsmul_mem (AddSubgroup.subset_closure (by simp [])) (x 1))⟩ + map_add' := by + intro x y + apply Subtype.ext + simp [zsmul_eq_mul, Int.cast_add] + ring + map_smul' := by + intro n x + apply Subtype.ext + simp [zsmul_eq_mul, Int.cast_mul] + ring } + Function.Injective f)) := by + classical + intro q a b K determinant_positive f x y hxy + have hre := congrArg (fun z : GaussianInt => z.re) (congrArg Subtype.val hxy) + have him := congrArg (fun z : GaussianInt => z.im) (congrArg Subtype.val hxy) + simp? [f] at hre him + have h0 : (a.re * b.im - a.im * b.re) * (x 0 - y 0) = 0 := by + calc + _ = b.im * ((x 0 * a.re + x 1 * b.re) - (y 0 * a.re + y 1 * b.re)) - + b.re * ((x 0 * a.im + x 1 * b.im) - (y 0 * a.im + y 1 * b.im)) := by ring + _ = 0 := by rw [hre, him]; ring + have h1 : (a.re * b.im - a.im * b.re) * (x 1 - y 1) = 0 := by + calc + _ = a.re * ((x 0 * a.im + x 1 * b.im) - (y 0 * a.im + y 1 * b.im)) - + a.im * ((x 0 * a.re + x 1 * b.re) - (y 0 * a.re + y 1 * b.re)) := by ring + _ = 0 := by rw [hre, him]; ring + have determinant_ne : a.re * b.im - a.im * b.re ≠ 0 := by + intro h + simp [h] at determinant_positive + funext i + fin_cases i + · exact sub_eq_zero.mp ((mul_eq_zero.mp h0).resolve_left determinant_ne) + · exact sub_eq_zero.mp ((mul_eq_zero.mp h1).resolve_left determinant_ne) + +private theorem f_surjective : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let a : GaussianInt := BandVectors.1 (q 3) (q 0) + let b : GaussianInt := BandVectors.1 (q 2) (q 0) + let K : AddSubgroup GaussianInt := AddSubgroup.closure ({a, b} : Set GaussianInt) + let f : (Fin 2 → ℤ) →ₗ[ℤ] K := + { toFun := fun x => ⟨x 0 • a + x 1 • b, + K.add_mem (K.zsmul_mem (AddSubgroup.subset_closure (by simp [])) (x 0)) + (K.zsmul_mem (AddSubgroup.subset_closure (by simp [])) (x 1))⟩ + map_add' := by + intro x y + apply Subtype.ext + simp [zsmul_eq_mul, Int.cast_add] + ring + map_smul' := by + intro n x + apply Subtype.ext + simp [zsmul_eq_mul, Int.cast_mul] + ring } + Function.Surjective f ) := by + classical + intro q a b K f y + suffices ∃ x, (f x : GaussianInt) = y by + rcases this with ⟨x, hx⟩ + exact ⟨x, Subtype.ext hx⟩ + let z : GaussianInt := y + change ∃ x, (f x : GaussianInt) = z + have hz : z ∈ K := y.property + change z ∈ AddSubgroup.closure ({a, b} : Set GaussianInt) at hz + refine AddSubgroup.closure_induction (p := fun z _ => ∃ x, (f x : GaussianInt) = z) + ?_ ?_ ?_ ?_ hz + · intro z hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with rfl | rfl + · exact ⟨![1, 0], by simp [f]⟩ + · exact ⟨![0, 1], by simp [f]⟩ + · exact ⟨0, by simp [f]⟩ + · intro x y _ _ ix iy + rcases ix with ⟨u, hu⟩ + rcases iy with ⟨v, hv⟩ + refine ⟨u + v, ?_⟩ + calc + (f (u + v) : GaussianInt) = (f u : GaussianInt) + (f v : GaussianInt) := + congrArg Subtype.val (f.map_add u v) + _ = x + y := by rw [hu, hv] + · intro x _ ix + rcases ix with ⟨u, hu⟩ + refine ⟨-u, ?_⟩ + calc + (f (-u) : GaussianInt) = -(f u : GaussianInt) := + congrArg Subtype.val (f.map_neg u) + _ = -x := by rw [hu] + +private theorem index_value : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let a : GaussianInt := BandVectors.1 (q 3) (q 0) + let b : GaussianInt := BandVectors.1 (q 2) (q 0) + let K : AddSubgroup GaussianInt := AddSubgroup.closure ({a, b} : Set GaussianInt) + let f : (Fin 2 → ℤ) →ₗ[ℤ] K := + { toFun := fun x => ⟨x 0 • a + x 1 • b, + K.add_mem (K.zsmul_mem (AddSubgroup.subset_closure (by simp [])) (x 0)) + (K.zsmul_mem (AddSubgroup.subset_closure (by simp [])) (x 1))⟩ + map_add' := by + intro x y + apply Subtype.ext + simp [zsmul_eq_mul, Int.cast_add] + ring + map_smul' := by + intro n x + apply Subtype.ext + simp [zsmul_eq_mul, Int.cast_mul] + ring } + (Function.Injective f) → ((Function.Surjective f) → (K.index = Int.natAbs (a.re * b.im - + a.im * b.re)))) := by + classical + intro q a b K f f_injective f_surjective + let coordinates : GaussianInt ≃ₗ[ℤ] (Fin 2 → ℤ) := + { toFun := fun z => ![z.re, z.im] + invFun := fun x => ⟨x 0, x 1⟩ + left_inv := by intro z; ext <;> simp + right_inv := by intro x; funext i; fin_cases i <;> simp + map_add' := by intro x y; funext i; fin_cases i <;> simp + map_smul' := by intro n x; funext i; fin_cases i <;> simp } + let e : (Fin 2 → ℤ) ≃ₗ[ℤ] K := + LinearEquiv.ofBijective f ⟨f_injective, f_surjective⟩ + let basisK : Module.Basis (Fin 2) ℤ K := (Pi.basisFun ℤ (Fin 2)).map e + let basisG : Module.Basis (Fin 2) ℤ GaussianInt := + Module.Basis.ofEquivFun coordinates + rw [AddSubgroup.index_eq_natAbs_det basisG K basisK] + congr 1 + rw [Module.Basis.det_apply, Matrix.det_fin_two] + simp [Module.Basis.toMatrix_apply, basisG, basisK, e, f, coordinates] + ring + +private theorem quotient_positive : + (by + classical + exact + ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let a : GaussianInt := BandVectors.1 (q 3) (q 0) + let b : GaussianInt := BandVectors.1 (q 2) (q 0) + let K : AddSubgroup GaussianInt := AddSubgroup.closure ({a, b} : Set GaussianInt) + (Nat.card (GaussianInt ⧸ K) = C.1.1.1.natAbs) → (0 < Nat.card (GaussianInt ⧸ K)) ) := by + classical + intro C q a b K quotient_card + rw [quotient_card, Int.natAbs_pos] + exact C.2.ne' + +private theorem hzAt323 : + (by + classical + exact + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + let a : GaussianInt := BandVectors.1 (q 3) (q 0) + let b : GaussianInt := BandVectors.1 (q 2) (q 0) + let K : AddSubgroup GaussianInt := AddSubgroup.closure ({a, b} : Set GaussianInt) + ∀ [this : Fintype (GaussianInt ⧸ K)], + let quotientMap : GaussianInt → GaussianInt ⧸ K := QuotientAddGroup.mk' K + ∀ (quotient_surjective : Function.Surjective quotientMap), + let representative : GaussianInt ⧸ K → GaussianInt := + Function.surjInv quotient_surjective + ∀ (representative_injective : Function.Injective representative), + let representativeEmbedding : (GaussianInt ⧸ K) ↪ GaussianInt := + ⟨representative, representative_injective⟩ + let R : Finset GaussianInt := Finset.univ.map representativeEmbedding + ∀ (x : GaussianInt), ∀ (z : GaussianInt ⧸ K), ((representativeEmbedding : GaussianInt ⧸ K + → GaussianInt) z ∈ R ∧ x - (representativeEmbedding : GaussianInt ⧸ K → GaussianInt) + z ∈ K) → (quotientMap x = quotientMap (representative z)) ) := by + classical + intro q a b K this quotientMap quotient_surjective representative representative_injective + representativeEmbedding R x z hs + apply QuotientAddGroup.eq_iff_sub_mem.mpr + exact hs.2 + +end TilingIndexProof + +theorem TilingLatticeIndex (C : BandCircle) : + ∃ R : Finset GaussianInt, + LatticeFundamentalSet (TilingLattice C) R ∧ R.card = C.1.1.1.natAbs := by +-- BODY + classical + by_cases hunit : C.1.1.1 = 1 + · refine ⟨{0}, ?_, by simp [hunit]⟩ + simp [LatticeFundamentalSet, TilingLattice, hunit] + rcases BandGenealogy C with unit | ⟨q, hq, hC, hless, huniq⟩ + · exact (hunit unit).elim + let a : GaussianInt := BandVectors.1 (q 3) (q 0) + let b : GaussianInt := BandVectors.1 (q 2) (q 0) + let K : AddSubgroup GaussianInt := AddSubgroup.closure ({a, b} : Set GaussianInt) + have relation := TilingIndexProof.relation q hq + have first_mem := TilingIndexProof.first_mem q relation + have generator_mem := TilingIndexProof.generator_mem C q hC huniq first_mem + have lattice_le := TilingIndexProof.lattice_le C hunit q generator_mem + have a_mem := TilingIndexProof.a_mem C hunit q hq hC hless + have b_mem := TilingIndexProof.b_mem C hunit q hq hC hless + have lattice_eq : TilingLattice C = K := TilingIndexProof.lattice_eq C q lattice_le a_mem b_mem + let successor : Fin 4 → CircleCoordinates := + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + have successor_semi : SemiProperQuadruple successor := by + simpa [successor] using SemiProperQuadruple.successor hq + have successor_parent : successor 1 = q 0 := by simp [successor] + have successor_positive := TilingIndexProof.successor_positive C q hC successor_parent + have determinant_value : Int.natAbs (a.re * b.im - a.im * b.re) = + C.1.1.1.natAbs := TilingIndexProof.determinant_value C q hC successor_semi successor_positive + have determinant_positive := TilingIndexProof.determinant_positive C q determinant_value + let f : (Fin 2 → ℤ) →ₗ[ℤ] K := + { toFun := fun x => ⟨x 0 • a + x 1 • b, + K.add_mem (K.zsmul_mem (AddSubgroup.subset_closure (by simp [])) (x 0)) + (K.zsmul_mem (AddSubgroup.subset_closure (by simp [])) (x 1))⟩ + map_add' := by + intro x y + apply Subtype.ext + simp [zsmul_eq_mul, Int.cast_add] + ring + map_smul' := by + intro n x + apply Subtype.ext + simp [zsmul_eq_mul, Int.cast_mul] + ring } + have f_injective := TilingIndexProof.f_injective q determinant_positive + have f_surjective := TilingIndexProof.f_surjective q + let coordinates : GaussianInt ≃ₗ[ℤ] (Fin 2 → ℤ) := + { toFun := fun z => ![z.re, z.im] + invFun := fun x => ⟨x 0, x 1⟩ + left_inv := by intro z; ext <;> simp + right_inv := by intro x; funext i; fin_cases i <;> simp + map_add' := by intro x y; funext i; fin_cases i <;> simp + map_smul' := by intro n x; funext i; fin_cases i <;> simp } + let e : (Fin 2 → ℤ) ≃ₗ[ℤ] K := + LinearEquiv.ofBijective f ⟨f_injective, f_surjective⟩ + let basisK : Module.Basis (Fin 2) ℤ K := (Pi.basisFun ℤ (Fin 2)).map e + let basisG : Module.Basis (Fin 2) ℤ GaussianInt := + Module.Basis.ofEquivFun coordinates + have index_value : K.index = Int.natAbs (a.re * b.im - a.im * b.re) := + TilingIndexProof.index_value q f_injective f_surjective + have quotient_card : Nat.card (GaussianInt ⧸ K) = C.1.1.1.natAbs := by + rw [← K.index_eq_card, index_value, determinant_value] + have quotient_positive := TilingIndexProof.quotient_positive C q quotient_card + have : Finite (GaussianInt ⧸ K) := (Nat.card_pos_iff.mp quotient_positive).2 + let : Fintype (GaussianInt ⧸ K) := Fintype.ofFinite _ + let quotientMap : GaussianInt → GaussianInt ⧸ K := QuotientAddGroup.mk' K + have quotient_surjective : Function.Surjective quotientMap := + QuotientAddGroup.mk'_surjective K + let representative : GaussianInt ⧸ K → GaussianInt := + Function.surjInv quotient_surjective + have representative_spec : ∀ z, quotientMap (representative z) = z := + Function.surjInv_eq quotient_surjective + have representative_injective : Function.Injective representative := + Function.injective_surjInv quotient_surjective + let representativeEmbedding : (GaussianInt ⧸ K) ↪ GaussianInt := + ⟨representative, representative_injective⟩ + let R : Finset GaussianInt := Finset.univ.map representativeEmbedding + refine ⟨R, ?_, ?_⟩ + · rw [lattice_eq] + intro x + let r := representative (quotientMap x) + have hr : r ∈ R := by + exact Finset.mem_map.mpr ⟨quotientMap x, Finset.mem_univ _, rfl⟩ + refine ⟨r, ⟨hr, ?_⟩, ?_⟩ + · apply QuotientAddGroup.eq_iff_sub_mem.mp + exact (representative_spec (quotientMap x)).symm + · intro s hs + obtain ⟨z, _, rfl⟩ := Finset.mem_map.mp hs.1 + have hz : quotientMap x = quotientMap (representative z) := TilingIndexProof.hzAt323 q + (this := this) quotient_surjective representative_injective x z hs + have hz' : quotientMap x = z := hz.trans (representative_spec z) + change representative z = representative (quotientMap x) + rw [hz'] + · calc + R.card = Fintype.card (GaussianInt ⧸ K) := by simp [R] + _ = Nat.card (GaussianInt ⧸ K) := Nat.card_eq_fintype_card.symm + _ = C.1.1.1.natAbs := quotient_card + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TopologicalDisk.lean b/LeanPool/ApollonianSuperharmonic/TopologicalDisk.lean new file mode 100644 index 0000000000..fa4f4cdb6f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TopologicalDisk.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: TopologicalDisk] + +/-! +# TopologicalDisk + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +A plane set homeomorphic to the closed unit ball for the product norm. +This ball is a square, homeomorphic to the closed Euclidean unit disk. +-/ +def TopologicalDisk (S : Set (Real × Real)) : Prop := +-- BODY + Nonempty + ((Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) ≃ₜ + S) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TopologicalDiskExponentialLift.lean b/LeanPool/ApollonianSuperharmonic/TopologicalDiskExponentialLift.lean new file mode 100644 index 0000000000..7b20494021 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TopologicalDiskExponentialLift.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk +public import Mathlib.Analysis.Complex.CoveringMap +public import Mathlib.Analysis.Normed.Module.Connected +public import Mathlib.Topology.Algebra.Module.LocallyConvex +public import Mathlib.Topology.Homotopy.Lifting + +/-! +# TopologicalDiskExponentialLift + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open Set + +noncomputable section + +-- [TABLET NODE: TopologicalDiskExponentialLift] +theorem TopologicalDiskExponentialLift + (S : Set (Real × Real)) (hS : TopologicalDisk S) + (q : Real × Real) (hq : q ∉ S) : + ∃ F : S → ℂ, Continuous F ∧ + ∀ x : S, Complex.exp (F x) = + (⟨x.1.1 - q.1, x.1.2 - q.2⟩ : ℂ) := by +-- BODY + rcases hS with ⟨e⟩ + let D : Set (Real × Real) := Metric.closedBall 0 1 + let : ContractibleSpace D := Metric.contractibleSpace_closedBall (by norm_num) + let : LocallyPathConnectedSpace D := + (convex_closedBall (0 : Real × Real) 1).locallyPathConnectedSpace + let : ContractibleSpace S := e.symm.contractibleSpace + let : LocallyPathConnectedSpace S := e.isQuotientMap.locallyPathConnectedSpace + let g : S → ℂ := fun x ↦ + ((x.1.1 - q.1 : Real) : ℂ) + ((x.1.2 - q.2 : Real) : ℂ) * Complex.I + have hg : Continuous g := by + dsimp [g] + fun_prop + let x0 : S := Classical.choice (inferInstance : Nonempty S) + have hg0 (x : S) : g x ≠ 0 := by + intro hx + apply hq + have hre := congrArg Complex.re hx + have him := congrArg Complex.im hx + have hxq : (x.1 : Real × Real) = q := by + apply Prod.ext <;> simp [g] at hre him <;> linarith + exact hxq ▸ x.2 + let e0 : ℂ := Complex.log (g x0) + have he0 : Complex.exp e0 = g x0 := by + exact Complex.exp_log (hg0 x0) + rcases Complex.isCoveringMapOn_exp.existsUnique_continuousMap_lifts + ⟨g, hg⟩ (a₀ := x0) (e₀ := e0) he0 (fun x ↦ by simpa using hg0 x) with + ⟨F, hF, _⟩ + refine ⟨F, F.continuous, ?_⟩ + intro x + have hx := congrFun hF.2 x + apply Complex.ext + · simpa [Function.comp_apply, g] using congrArg Complex.re hx + · simpa [Function.comp_apply, g] using congrArg Complex.im hx + +end + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TopologicalDiskGridRayCrossingIndexZero.lean b/LeanPool/ApollonianSuperharmonic/TopologicalDiskGridRayCrossingIndexZero.lean new file mode 100644 index 0000000000..f17b25c0d6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TopologicalDiskGridRayCrossingIndexZero.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexZeroOfEdgeLifts +public import LeanPool.ApollonianSuperharmonic.TopologicalDiskExponentialLift + +/-! +# TopologicalDiskGridRayCrossingIndexZero + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open Set + +noncomputable section + +-- [TABLET NODE: TopologicalDiskGridRayCrossingIndexZero] +theorem TopologicalDiskGridRayCrossingIndexZero + (S : Set (Real × Real)) (hS : TopologicalDisk S) (q : LatticeCell) + (hq : ((((q.re : Int) : Real) + (1 / 2 : Real)), + (((q.im : Int) : Real) + (1 / 2 : Real))) ∉ S) + (p : List GaussianInt) (x y : GaussianInt) + (hhead : p.head? = some x) (hlast : p.getLast? = some y) + (hadj : ∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) + (hclose : FourNeighborAdjacent y x) + (hedge : ∀ a b : GaussianInt, + ((∃ l₁ l₂ : List GaussianInt, p = l₁ ++ a :: b :: l₂) ∨ + (a = y ∧ b = x)) → + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * ((a.re : Int) : Real) + + (t : Real) * ((b.re : Int) : Real), + (1 - (t : Real)) * ((a.im : Int) : Real) + + (t : Real) * ((b.im : Int) : Real)) ∈ S) : + GridRayCrossingIndex q p = 0 := by +-- BODY + classical + let center : Real × Real := + ((((q.re : Int) : Real) + (1 / 2 : Real)), + (((q.im : Int) : Real) + (1 / 2 : Real))) + rcases TopologicalDiskExponentialLift S hS center hq with ⟨G, hG, hGexp⟩ + let point : GaussianInt → Real × Real := fun a ↦ + (((a.re : Int) : Real), ((a.im : Int) : Real)) + let F : GaussianInt → ℂ := fun a ↦ + if ha : point a ∈ S then G ⟨point a, ha⟩ else 0 + apply GridRayCrossingIndexZeroOfEdgeLifts q p x y F hhead hlast hadj hclose + intro a b hoccur + let edge : Set.Icc (0 : Real) 1 → S := fun t ↦ + ⟨((1 - (t : Real)) * ((a.re : Int) : Real) + + (t : Real) * ((b.re : Int) : Real), + (1 - (t : Real)) * ((a.im : Int) : Real) + + (t : Real) * ((b.im : Int) : Real)), hedge a b hoccur t⟩ + let L : Set.Icc (0 : Real) 1 → ℂ := fun t ↦ G (edge t) + have hedgeCont : Continuous edge := by + fun_prop + have hL : Continuous L := hG.comp hedgeCont + have ha : point a ∈ S := by + simpa [point] using hedge a b hoccur ⟨0, by norm_num⟩ + have hb : point b ∈ S := by + simpa [point] using hedge a b hoccur ⟨1, by norm_num⟩ + refine ⟨L, hL, ?_, ?_, ?_⟩ + · change G (edge ⟨0, by norm_num⟩) = F a + rw [show F a = G ⟨point a, ha⟩ by simp [F, ha]] + congr 1 + apply Subtype.ext + simp [edge, point] + · change G (edge ⟨1, by norm_num⟩) = F b + rw [show F b = G ⟨point b, hb⟩ by simp [F, hb]] + congr 1 + apply Subtype.ext + simp [edge, point] + · intro t + have he := hGexp (edge t) + rw [he] + apply Complex.ext <;> + simp [edge, center, GridCellCenter] <;> ring + +end + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TopologicalDiskLocallyPuncturedPreconnected.lean b/LeanPool/ApollonianSuperharmonic/TopologicalDiskLocallyPuncturedPreconnected.lean new file mode 100644 index 0000000000..409049fe81 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TopologicalDiskLocallyPuncturedPreconnected.lean @@ -0,0 +1,308 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TopologicalDisk +public import Mathlib.Analysis.Convex.PathConnected + +/-! +# TopologicalDiskLocallyPuncturedPreconnected + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +open Set +open scoped Topology + +-- [TABLET NODE: TopologicalDiskLocallyPuncturedPreconnected] +namespace PuncturedDiskConstruction + +private theorem punctured_rect_pathConnected + (a b d : Real × Real) (h1 : a.1 < b.1) (h2 : a.2 < b.2) + (hd : d ∈ Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2) : + IsPathConnected ((Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2) \ {d}) := by + classical + let rx : Real := if d.1 ≤ (a.1 + b.1) / 2 then b.1 else a.1 + let ry : Real := if d.2 ≤ (a.2 + b.2) / 2 then b.2 else a.2 + let X : Real × Real := (rx, d.2) + let Y : Real × Real := (d.1, ry) + have hrx_mem : rx ∈ Set.Icc a.1 b.1 := by + dsimp [rx] + split <;> simp_all [le_of_lt] + have hry_mem : ry ∈ Set.Icc a.2 b.2 := by + dsimp [ry] + split <;> simp_all [le_of_lt] + have hrx_ne : rx ≠ d.1 := by + dsimp [rx] + split + · intro he + have := hd.2.1 + linarith + · intro he + have := hd.1.1 + linarith + have hry_ne : ry ≠ d.2 := by + dsimp [ry] + split + · intro he + have := hd.2.2 + linarith + · intro he + have := hd.1.2 + linarith + have hX : X ∈ (Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2) \ {d} := by + constructor + · exact ⟨hrx_mem, hd.2⟩ + · simpa [X, Prod.ext_iff] using hrx_ne + have hY : Y ∈ (Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2) \ {d} := by + constructor + · exact ⟨hd.1, hry_mem⟩ + · simpa [Y, Prod.ext_iff] using hry_ne + have segment_avoid_X {p : Real × Real} + (hp : p ∈ (Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2) \ {d}) + (hp2 : p.2 ≠ d.2) : + segment Real p X ⊆ (Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2) \ {d} := by + rw [segment_subset_iff] + intro u v hu hv huv + constructor + · exact ((convex_Icc a.1 b.1).prod (convex_Icc a.2 b.2)).segment_subset hp.1 hX.1 + (by exact ⟨u, v, hu, hv, huv, rfl⟩) + · simp only [X] + intro heq + simp only [Set.mem_singleton_iff] at heq + have hsnd := congrArg Prod.snd heq + simp only [Prod.smul_snd, Prod.snd_add] at hsnd + simp only [smul_eq_mul] at hsnd + have huz : u * (p.2 - d.2) = 0 := by + linear_combination hsnd - d.2 * huv + have hu0 : u = 0 := (mul_eq_zero.mp huz).resolve_right (sub_ne_zero.mpr hp2) + subst u + have hv1 : v = 1 := by linarith + subst v + exact hrx_ne (by simpa [X] using congrArg Prod.fst heq) + have segment_avoid_Y {p : Real × Real} + (hp : p ∈ (Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2) \ {d}) + (hp1 : p.1 ≠ d.1) : + segment Real p Y ⊆ (Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2) \ {d} := by + rw [segment_subset_iff] + intro u v hu hv huv + constructor + · exact ((convex_Icc a.1 b.1).prod (convex_Icc a.2 b.2)).segment_subset hp.1 hY.1 + (by exact ⟨u, v, hu, hv, huv, rfl⟩) + · simp only [Y] + intro heq + simp only [Set.mem_singleton_iff] at heq + have hfst := congrArg Prod.fst heq + simp only [Prod.smul_fst, Prod.fst_add] at hfst + simp only [smul_eq_mul] at hfst + have huz : u * (p.1 - d.1) = 0 := by + linear_combination hfst - d.1 * huv + have hu0 : u = 0 := (mul_eq_zero.mp huz).resolve_right (sub_ne_zero.mpr hp1) + subst u + have hv1 : v = 1 := by linarith + subst v + exact hry_ne (by simpa [Y] using congrArg Prod.snd heq) + have segment_YX : + segment Real Y X ⊆ (Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2) \ {d} := by + rw [segment_subset_iff] + intro u v hu hv huv + constructor + · exact ((convex_Icc a.1 b.1).prod (convex_Icc a.2 b.2)).segment_subset hY.1 hX.1 + (by exact ⟨u, v, hu, hv, huv, rfl⟩) + · simp only [X, Y] + intro heq + simp only [Set.mem_singleton_iff] at heq + have hfst := congrArg Prod.fst heq + have hsnd := congrArg Prod.snd heq + simp only [Prod.smul_fst, Prod.smul_snd, Prod.fst_add, Prod.snd_add] at hfst hsnd + simp only [smul_eq_mul] at hfst hsnd + by_cases hu0 : u = 0 + · subst u + have hv1 : v = 1 := by linarith + subst v + exact hrx_ne (by simpa [X, Y] using congrArg Prod.fst heq) + · have huz : u * (ry - d.2) = 0 := by + linear_combination hsnd - d.2 * huv + have : ry = d.2 := sub_eq_zero.mp ((mul_eq_zero.mp huz).resolve_left hu0) + exact hry_ne this + refine ⟨X, hX, ?_⟩ + intro p hp + by_cases hp2 : p.2 = d.2 + · have hp1 : p.1 ≠ d.1 := by + intro hp1 + exact hp.2 (Prod.ext hp1 hp2) + exact ((JoinedIn.of_segment_subset (segment_avoid_Y hp hp1)).trans + (JoinedIn.of_segment_subset segment_YX)).symm + · exact (JoinedIn.of_segment_subset (segment_avoid_X hp hp2)).symm + +private theorem disk_locally_punctured_preconnected + (d : Metric.closedBall (0 : Real × Real) 1) + (V₀ : Set (Metric.closedBall (0 : Real × Real) 1)) (hV₀ : V₀ ∈ nhds d) : + ∃ V ∈ nhds d, V ⊆ V₀ ∧ IsConnected (V \ {d}) := by + classical + have punctured_rect_pathConnected + (a b d : Real × Real) (h1 : a.1 < b.1) (h2 : a.2 < b.2) + (hd : d ∈ Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2) : + IsPathConnected ((Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2) \ {d}) := + punctured_rect_pathConnected a b d h1 h2 hd + let D : Set (Real × Real) := Metric.closedBall 0 1 + have himage : ((fun x : D => (x : Real × Real)) '' V₀) ∈ 𝓝[D] (d : Real × Real) := by + exact mem_nhds_subtype_iff_nhdsWithin.mp hV₀ + rcases Metric.mem_nhdsWithin_iff.mp himage with ⟨e, he, heU⟩ + let δ : Real := min (e / 2) (1 / 2) + have hδ : 0 < δ := by dsimp [δ]; positivity + have hδe : δ < e := lt_of_le_of_lt (min_le_left _ _) (by linarith) + let a : Real × Real := + (max (-1) ((d : Real × Real).1 - δ), max (-1) ((d : Real × Real).2 - δ)) + let b : Real × Real := + (min 1 ((d : Real × Real).1 + δ), min 1 ((d : Real × Real).2 + δ)) + let R : Set (Real × Real) := Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2 + have hdD : (d : Real × Real) ∈ D := d.property + have hdcoords : (d : Real × Real).1 ∈ Set.Icc (-1 : Real) 1 ∧ + (d : Real × Real).2 ∈ Set.Icc (-1 : Real) 1 := by + have hDprod : D = Set.Icc (-1 : Real) 1 ×ˢ Set.Icc (-1 : Real) 1 := by + change Metric.closedBall (0 : Real × Real) 1 = _ + rw [← closedBall_prod_same, Real.closedBall_eq_Icc, Real.closedBall_eq_Icc] + norm_num + rw [hDprod] at hdD + exact hdD + have ha1 : a.1 < b.1 := by + dsimp [a, b] + rcases le_total (-1 : Real) ((d : Real × Real).1 - δ) with h | h <;> + rcases le_total (1 : Real) ((d : Real × Real).1 + δ) with h' | h' <;> + simp [h, h'] <;> + linarith [hdcoords.1.1, hdcoords.1.2] + have ha2 : a.2 < b.2 := by + dsimp [a, b] + rcases le_total (-1 : Real) ((d : Real × Real).2 - δ) with h | h <;> + rcases le_total (1 : Real) ((d : Real × Real).2 + δ) with h' | h' <;> + simp [h, h'] <;> + linarith [hdcoords.2.1, hdcoords.2.2] + have hdR : (d : Real × Real) ∈ R := by + constructor <;> constructor <;> dsimp [R, a, b] + · exact max_le hdcoords.1.1 (sub_le_self _ hδ.le) + · exact le_min hdcoords.1.2 (le_add_of_nonneg_right hδ.le) + · exact max_le hdcoords.2.1 (sub_le_self _ hδ.le) + · exact le_min hdcoords.2.2 (le_add_of_nonneg_right hδ.le) + have hRball : R ⊆ Metric.closedBall (d : Real × Real) δ := by + rw [← closedBall_prod_same, Real.closedBall_eq_Icc, Real.closedBall_eq_Icc] + intro x hx + exact ⟨⟨(max_le_iff.mp hx.1.1).2, (le_min_iff.mp hx.1.2).2⟩, + ⟨(max_le_iff.mp hx.2.1).2, (le_min_iff.mp hx.2.2).2⟩⟩ + have hRD : R ⊆ D := by + change R ⊆ Metric.closedBall (0 : Real × Real) 1 + rw [← closedBall_prod_same, Real.closedBall_eq_Icc, Real.closedBall_eq_Icc] + intro x hx + simp only [Set.mem_prod, Set.mem_Icc] + norm_num + exact ⟨⟨(max_le_iff.mp hx.1.1).1, (le_min_iff.mp hx.1.2).1⟩, + ⟨(max_le_iff.mp hx.2.1).1, (le_min_iff.mp hx.2.2).1⟩⟩ + let V : Set D := (fun x : D => (x : Real × Real)) ⁻¹' R + have hVU : V ⊆ V₀ := by + intro x hx + have hxball : (x : Real × Real) ∈ Metric.ball (d : Real × Real) e := + Metric.closedBall_subset_ball hδe (hRball hx) + have hximage := heU ⟨hxball, x.2⟩ + rcases hximage with ⟨y, hyU, hyx⟩ + exact Subtype.coe_injective hyx ▸ hyU + have hVnhds : V ∈ nhds d := by + apply preimage_coe_mem_nhds_subtype.mpr + apply Metric.mem_nhdsWithin_iff.mpr + refine ⟨δ, hδ, ?_⟩ + intro x hx + have hxball : x ∈ Metric.closedBall (d : Real × Real) δ := + Metric.mem_closedBall'.mpr (le_of_lt (Metric.mem_ball'.mp hx.1)) + rw [← closedBall_prod_same, Real.closedBall_eq_Icc, Real.closedBall_eq_Icc] at hxball + have hxD : x.1 ∈ Set.Icc (-1 : Real) 1 ∧ x.2 ∈ Set.Icc (-1 : Real) 1 := by + have hxD' := hx.2 + change x ∈ Metric.closedBall (0 : Real × Real) 1 at hxD' + rw [← closedBall_prod_same, Real.closedBall_eq_Icc, Real.closedBall_eq_Icc] at hxD' + simpa only [Set.mem_prod, Set.mem_Icc, Prod.fst_zero, Prod.snd_zero, + zero_sub, zero_add] using hxD' + exact ⟨⟨max_le hxD.1.1 hxball.1.1, le_min hxD.1.2 hxball.1.2⟩, + ⟨max_le hxD.2.1 hxball.2.1, le_min hxD.2.2 hxball.2.2⟩⟩ + have hpathR : IsPathConnected (R \ {(d : Real × Real)}) := + punctured_rect_pathConnected a b d ha1 ha2 hdR + have himageV : (fun x : D => (x : Real × Real)) '' (V \ {d}) = + R \ {(d : Real × Real)} := by + ext x + constructor + · rintro ⟨y, ⟨hyR, hyd⟩, rfl⟩ + exact ⟨hyR, fun heq => hyd (Subtype.ext heq)⟩ + · rintro ⟨hxR, hxd⟩ + refine ⟨⟨x, hRD hxR⟩, ⟨hxR, ?_⟩, rfl⟩ + intro heq + exact hxd (congrArg Subtype.val heq) + have hconn : IsConnected (V \ {d}) := by + constructor + · rw [← Set.image_nonempty, himageV] + exact hpathR.nonempty + · rw [← Topology.IsInducing.subtypeVal.isPreconnected_image, himageV] + exact hpathR.isConnected.isPreconnected + exact ⟨V, hVnhds, hVU, hconn⟩ + +end PuncturedDiskConstruction + +theorem TopologicalDiskLocallyPuncturedPreconnected + (S : Set (Real × Real)) (hS : TopologicalDisk S) (z : S) + (U : Set S) (hU : U ∈ nhds z) : + ∃ W ∈ nhds z, W ⊆ U ∧ IsConnected (W \ {z}) := by +-- BODY + have punctured_rect_pathConnected + (a b d : Real × Real) (h1 : a.1 < b.1) (h2 : a.2 < b.2) + (hd : d ∈ Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2) : + IsPathConnected ((Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2) \ {d}) := + PuncturedDiskConstruction.punctured_rect_pathConnected a b d h1 h2 hd + have disk_locally_punctured_preconnected + (d : Metric.closedBall (0 : Real × Real) 1) + (V₀ : Set (Metric.closedBall (0 : Real × Real) 1)) (hV₀ : V₀ ∈ nhds d) : + ∃ V ∈ nhds d, V ⊆ V₀ ∧ IsConnected (V \ {d}) := + PuncturedDiskConstruction.disk_locally_punctured_preconnected d V₀ hV₀ + rcases hS with ⟨e⟩ + let d : Metric.closedBall (0 : Real × Real) 1 := e.symm z + have hpreU : e ⁻¹' U ∈ nhds d := by + have hedz : e d = z := by simp [d] + rw [← hedz] at hU + exact e.continuous.continuousAt hU + rcases disk_locally_punctured_preconnected d (e ⁻¹' U) hpreU with + ⟨V, hVnhds, hVU, hVconn⟩ + let W : Set S := e.symm ⁻¹' V + have hWnhds : W ∈ nhds z := by + exact e.symm.continuous.continuousAt hVnhds + have hWU : W ⊆ U := by + intro y hy + simpa using hVU hy + have himage : e '' (V \ {d}) = W \ {z} := by + ext y + constructor + · rintro ⟨x, ⟨hxV, hxd⟩, rfl⟩ + constructor + · simpa [W] + · simp only [Set.mem_singleton_iff] + intro heq + apply hxd + apply e.injective + simpa [d] using heq + · rintro ⟨hyW, hyz⟩ + refine ⟨e.symm y, ⟨hyW, ?_⟩, by simp⟩ + simp only [Set.mem_singleton_iff] + intro heq + apply hyz + apply e.symm.injective + simpa [d] using heq + have hWconn : IsConnected (W \ {z}) := by + rw [← himage, e.isConnected_image] + exact hVconn + exact ⟨W, hWnhds, hWU, hWconn⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TouchingTriple.lean b/LeanPool/ApollonianSuperharmonic/TouchingTriple.lean new file mode 100644 index 0000000000..1c072cff3f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TouchingTriple.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileTouching + +-- [TABLET NODE: TouchingTriple] + +/-! +# TouchingTriple + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +Three prototiles form a touching triple when every pair touches in the +extended sense of `TileTouching` and their three boundary footprints +have exactly one common vertex. This includes triples containing an empty +anchored prototile, as required in the curvature-zero parent cases. +-/ +def TouchingTriple (T₀ T₁ T₂ : ProtoTile) : Prop := +-- BODY + TileTouching T₀ T₁ ∧ TileTouching T₁ T₂ ∧ + TileTouching T₂ T₀ ∧ + ∃! x : GaussianInt, + x ∈ BoundaryFootprintVertices T₀ ∧ + x ∈ BoundaryFootprintVertices T₁ ∧ + x ∈ BoundaryFootprintVertices T₂ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TouchingTripleCovariance.lean b/LeanPool/ApollonianSuperharmonic/TouchingTripleCovariance.lean new file mode 100644 index 0000000000..3570b03cc7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TouchingTripleCovariance.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: TouchingTripleCovariance] + +/-! +# TouchingTripleCovariance + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TouchingTripleCovariance : + ∀ (T U V : ProtoTile) (u : GaussianInt), + (TouchingTriple T U V ↔ + TouchingTriple (TileTranslation T u) (TileTranslation U u) + (TileTranslation V u)) ∧ + (TouchingTriple T U V ↔ + TouchingTriple (TileQuarterTurn T) (TileQuarterTurn U) + (TileQuarterTurn V)) ∧ + (TouchingTriple T U V ↔ + TouchingTriple (TileReflection T) (TileReflection U) + (TileReflection V)) := by +-- BODY + have image_unique : ∀ (A B C : Set GaussianInt) (f : GaussianInt → GaussianInt), + Function.Bijective f → + ((∃! x, x ∈ A ∧ x ∈ B ∧ x ∈ C) ↔ + (∃! y, y ∈ f '' A ∧ y ∈ f '' B ∧ y ∈ f '' C)) := by + intro A B C f hf + constructor + · rintro ⟨x, hx, hxu⟩ + refine ⟨f x, ?_, ?_⟩ + · exact ⟨⟨x, hx.1, rfl⟩, ⟨x, hx.2.1, rfl⟩, ⟨x, hx.2.2, rfl⟩⟩ + · intro y hy + rcases hy with ⟨⟨a, ha, hac⟩, ⟨b, hb, hbc⟩, ⟨c, hc, hcc⟩⟩ + have hab : a = b := hf.1 (hac.trans hbc.symm) + have hac' : a = c := hf.1 (hac.trans hcc.symm) + exact hac.symm.trans (congrArg f (hxu a ⟨ha, hab ▸ hb, hac' ▸ hc⟩)) + · rintro ⟨y, hy, hyu⟩ + obtain ⟨x, rfl⟩ := hf.2 y + refine ⟨x, ?_, ?_⟩ + · rcases hy with ⟨⟨a, ha, haa⟩, ⟨b, hb, hba⟩, ⟨c, hc, hca⟩⟩ + have hax : a = x := hf.1 (haa.trans rfl.symm) + have hbx : b = x := hf.1 (hba.trans rfl.symm) + have hcx : c = x := hf.1 (hca.trans rfl.symm) + exact ⟨hax ▸ ha, hbx ▸ hb, hcx ▸ hc⟩ + · intro z hz + apply hf.1 + exact hyu (f z) ⟨⟨z, hz.1, rfl⟩, ⟨z, hz.2.1, rfl⟩, ⟨z, hz.2.2, rfl⟩⟩ + intro T U V u + have translate_bijective : Function.Bijective (GaussianTranslation u) := by + constructor + · intro a b h + dsimp [GaussianTranslation] at h ⊢ + exact add_right_cancel h + · intro a + refine ⟨a - u, ?_⟩ + dsimp [GaussianTranslation] + exact sub_add_cancel a u + have quarter_bijective : Function.Bijective GaussianQuarterTurn := by + constructor + · intro a b h + dsimp [GaussianQuarterTurn] at h ⊢ + cases a + cases b + simp_all + · intro a + refine ⟨⟨a.im, -a.re⟩, ?_⟩ + dsimp [GaussianQuarterTurn] + ext <;> simp + have reflection_bijective : Function.Bijective GaussianReflection := by + constructor + · intro a b h + dsimp [GaussianReflection] at h ⊢ + cases a + cases b + simp_all + · intro a + refine ⟨⟨a.re, -a.im⟩, ?_⟩ + dsimp [GaussianReflection] + ext <;> simp + have translate_sets (W : ProtoTile) : + BoundaryFootprintVertices (TileTranslation W u) = + GaussianTranslation u '' BoundaryFootprintVertices W := + (TileTranslationFormulas W u).2.2.2.2.2.2.2.1 + have quarter_sets (W : ProtoTile) : + BoundaryFootprintVertices (TileQuarterTurn W) = + GaussianQuarterTurn '' BoundaryFootprintVertices W := + (TileQuarterTurnFormulas W).2.2.2.2.2.2.2.1 + have reflection_sets (W : ProtoTile) : + BoundaryFootprintVertices (TileReflection W) = + GaussianReflection '' BoundaryFootprintVertices W := + (TileReflectionFormulas W).2.2.2.2.2.2.2.1 + have translate_result : + TouchingTriple T U V ↔ + TouchingTriple (TileTranslation T u) (TileTranslation U u) + (TileTranslation V u) := by + rcases TileTouchingCovariance T U u with ⟨t₁, q₁, r₁⟩ + rcases TileTouchingCovariance U V u with ⟨t₂, q₂, r₂⟩ + rcases TileTouchingCovariance V T u with ⟨t₃, q₃, r₃⟩ + unfold TouchingTriple + rw [translate_sets, translate_sets, translate_sets] + constructor + · rintro ⟨h₁, h₂, h₃, huniq⟩ + exact ⟨t₁.mp h₁, t₂.mp h₂, t₃.mp h₃, + (image_unique _ _ _ _ translate_bijective).mp huniq⟩ + · rintro ⟨h₁, h₂, h₃, huniq⟩ + exact ⟨t₁.mpr h₁, t₂.mpr h₂, t₃.mpr h₃, + (image_unique _ _ _ _ translate_bijective).mpr huniq⟩ + have quarter_result : + TouchingTriple T U V ↔ + TouchingTriple (TileQuarterTurn T) (TileQuarterTurn U) + (TileQuarterTurn V) := by + rcases TileTouchingCovariance T U u with ⟨t₁, q₁, r₁⟩ + rcases TileTouchingCovariance U V u with ⟨t₂, q₂, r₂⟩ + rcases TileTouchingCovariance V T u with ⟨t₃, q₃, r₃⟩ + unfold TouchingTriple + rw [quarter_sets, quarter_sets, quarter_sets] + constructor + · rintro ⟨h₁, h₂, h₃, huniq⟩ + exact ⟨q₁.mp h₁, q₂.mp h₂, q₃.mp h₃, + (image_unique _ _ _ _ quarter_bijective).mp huniq⟩ + · rintro ⟨h₁, h₂, h₃, huniq⟩ + exact ⟨q₁.mpr h₁, q₂.mpr h₂, q₃.mpr h₃, + (image_unique _ _ _ _ quarter_bijective).mpr huniq⟩ + have reflection_result : + TouchingTriple T U V ↔ + TouchingTriple (TileReflection T) (TileReflection U) + (TileReflection V) := by + rcases TileTouchingCovariance T U u with ⟨t₁, q₁, r₁⟩ + rcases TileTouchingCovariance U V u with ⟨t₂, q₂, r₂⟩ + rcases TileTouchingCovariance V T u with ⟨t₃, q₃, r₃⟩ + unfold TouchingTriple + rw [reflection_sets, reflection_sets, reflection_sets] + constructor + · rintro ⟨h₁, h₂, h₃, huniq⟩ + exact ⟨r₁.mp h₁, r₂.mp h₂, r₃.mp h₃, + (image_unique _ _ _ _ reflection_bijective).mp huniq⟩ + · rintro ⟨h₁, h₂, h₃, huniq⟩ + exact ⟨r₁.mpr h₁, r₂.mpr h₂, r₃.mpr h₃, + (image_unique _ _ _ _ reflection_bijective).mpr huniq⟩ + exact ⟨translate_result, quarter_result, reflection_result⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TouchingTriplePermutations.lean b/LeanPool/ApollonianSuperharmonic/TouchingTriplePermutations.lean new file mode 100644 index 0000000000..a02d424f19 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TouchingTriplePermutations.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TouchingTriple + +-- [TABLET NODE: TouchingTriplePermutations] + +/-! +# TouchingTriplePermutations + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TouchingTriplePermutations : ∀ T U V : ProtoTile, + TouchingTriple T U V ↔ + TouchingTriple T V U ∧ TouchingTriple U T V ∧ + TouchingTriple U V T ∧ TouchingTriple V T U ∧ + TouchingTriple V U T := by +-- BODY + intro T U V + have touching_swap : ∀ A B : ProtoTile, TileTouching A B ↔ TileTouching B A := by + intro A B + unfold TileTouching + constructor + · intro h + rcases h with h | h | h + · left + rcases h with ⟨ha, hb, hab, hp⟩ + exact ⟨hb, ha, hab.symm, by simpa [Set.inter_comm] using hp⟩ + · right + right + exact h + · right + left + exact h + · intro h + rcases h with h | h | h + · left + rcases h with ⟨hb, ha, hba, hp⟩ + exact ⟨ha, hb, hba.symm, by simpa [Set.inter_comm] using hp⟩ + · right + right + exact h + · right + left + exact h + have triple_swap : ∀ A B C : ProtoTile, + TouchingTriple A B C ↔ TouchingTriple A C B := by + intro A B C + constructor + · intro h + rcases h with ⟨hAB, hBC, hCA, x, hx, hxuniq⟩ + refine ⟨(touching_swap C A).mp hCA, (touching_swap B C).mp hBC, + (touching_swap A B).mp hAB, x, ?_, ?_⟩ + · exact ⟨hx.1, hx.2.2, hx.2.1⟩ + · intro y hy + exact hxuniq y ⟨hy.1, hy.2.2, hy.2.1⟩ + · intro h + rcases h with ⟨hAC, hCB, hBA, x, hx, hxuniq⟩ + refine ⟨(touching_swap B A).mp hBA, (touching_swap C B).mp hCB, + (touching_swap A C).mp hAC, x, ?_, ?_⟩ + · exact ⟨hx.1, hx.2.2, hx.2.1⟩ + · intro y hy + exact hxuniq y ⟨hy.1, hy.2.2, hy.2.1⟩ + have triple_cycle : ∀ A B C : ProtoTile, + TouchingTriple A B C ↔ TouchingTriple B C A := by + intro A B C + constructor + · intro h + rcases h with ⟨hAB, hBC, hCA, x, hx, hxuniq⟩ + refine ⟨hBC, hCA, hAB, x, ?_, ?_⟩ + · exact ⟨hx.2.1, hx.2.2, hx.1⟩ + · intro y hy + exact hxuniq y ⟨hy.2.2, hy.1, hy.2.1⟩ + · intro h + rcases h with ⟨hBC, hCA, hAB, x, hx, hxuniq⟩ + refine ⟨hAB, hBC, hCA, x, ?_, ?_⟩ + · exact ⟨hx.2.2, hx.1, hx.2.1⟩ + · intro y hy + exact hxuniq y ⟨hy.2.1, hy.2.2, hy.1⟩ + have hswap : TouchingTriple T U V ↔ TouchingTriple T V U := triple_swap T U V + have hcycle : TouchingTriple T U V ↔ TouchingTriple U V T := triple_cycle T U V + have hcycle2 : TouchingTriple T U V ↔ TouchingTriple V T U := + hcycle.trans (triple_cycle U V T) + have hlast : TouchingTriple T U V ↔ TouchingTriple V U T := + hswap.trans (triple_cycle T V U) + constructor + · intro h + exact ⟨hswap.mp h, (hcycle.trans (triple_swap U V T)).mp h, + hcycle.mp h, hcycle2.mp h, hlast.mp h⟩ + · intro h + exact hswap.mpr h.1 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TraceNonpositivePackingApproximation.lean b/LeanPool/ApollonianSuperharmonic/TraceNonpositivePackingApproximation.lean new file mode 100644 index 0000000000..9dab5c9ac8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TraceNonpositivePackingApproximation.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Topology.Instances.Matrix +public import LeanPool.ApollonianSuperharmonic.BandDiskExteriorDensity +public import LeanPool.ApollonianSuperharmonic.CircleMatrixEnclosureCriterion + +-- [TABLET NODE: TraceNonpositivePackingApproximation] + +/-! +# TraceNonpositivePackingApproximation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TraceNonpositivePackingApproximation + (A : Matrix (Fin 2) (Fin 2) Real) (hA : A.IsSymm) + (htrace : Matrix.trace A ≤ 0) : + ∃ Aseq : Nat → Matrix (Fin 2) (Fin 2) Real, + (∀ i j, Filter.Tendsto (fun n ↦ Aseq n i j) Filter.atTop + (nhds (A i j))) ∧ + ∃ Cseq : Nat → BandCircle, ∀ n, + (CircleMatrix (Cseq n) - Aseq n).PosSemidef := by +-- BODY + classical + let x := (SymmetricMatrixCoordinates A).1 + let r := (SymmetricMatrixCoordinates A).2 + by_cases hExterior : BandPackingExterior x + · let Cseq : Nat → BandCircle := fun n => + Classical.choose (BandDiskExteriorDensity x hExterior (1 / (n + 1)) (by positivity)) + let Aseq : Nat → Matrix (Fin 2) (Fin 2) Real := fun n => + (2 : Real)⁻¹ • + ![![r + (BandCircleEuclideanData (Cseq n)).center.re, + (BandCircleEuclideanData (Cseq n)).center.im], + ![(BandCircleEuclideanData (Cseq n)).center.im, + r - (BandCircleEuclideanData (Cseq n)).center.re]] + refine ⟨Aseq, ?_, Cseq, ?_⟩ + · intro i j + have hcenter : Filter.Tendsto + (fun n => (BandCircleEuclideanData (Cseq n)).center) Filter.atTop (nhds x) := by + have hsucc : Filter.Tendsto (fun n : Nat => n + 1) Filter.atTop Filter.atTop := by + apply Filter.tendsto_atTop.mpr + intro b + filter_upwards [Filter.eventually_ge_atTop b] with n hn + exact Nat.le_trans hn (Nat.le_succ n) + have hden : Filter.Tendsto + (fun n : Nat => ((n + 1 : Nat) : Real)) Filter.atTop Filter.atTop := by + simpa [Function.comp_def] using + (tendsto_natCast_atTop_atTop (R := Real)).comp hsucc + apply tendsto_iff_dist_tendsto_zero.mpr + have hlim : Filter.Tendsto + (fun n : Nat => (1 : Real) / ((n + 1 : Nat) : Real)) Filter.atTop (nhds 0) := by + exact tendsto_const_nhds.div_atTop (f := fun _ : Nat => (1 : Real)) hden + refine squeeze_zero' (Filter.Eventually.of_forall (fun n => dist_nonneg)) ?_ hlim + filter_upwards [] with n + simpa [Cseq, dist_comm, Nat.cast_add, Nat.cast_one] using + (Classical.choose_spec + (BandDiskExteriorDensity x hExterior (1 / (n + 1)) (by positivity))).2.le + have hreal : Filter.Tendsto + (fun n => (BandCircleEuclideanData (Cseq n)).center.re) Filter.atTop (nhds x.re) := by + have hpart : Filter.Tendsto Complex.re (nhds x) (nhds x.re) := + Complex.continuous_re.continuousAt + exact hpart.comp hcenter + have himag : Filter.Tendsto + (fun n => (BandCircleEuclideanData (Cseq n)).center.im) Filter.atTop (nhds x.im) := by + have hpart : Filter.Tendsto Complex.im (nhds x) (nhds x.im) := + Complex.continuous_im.continuousAt + exact hpart.comp hcenter + have htraceeq : Matrix.trace A = A 0 0 + A 1 1 := by + simp [Matrix.trace, Fin.sum_univ_two] + have hsymentry : A 0 1 = A 1 0 := by + simpa [Matrix.transpose_apply] using (congrFun (congrFun hA.eq 0) 1).symm + fin_cases i <;> fin_cases j + · convert ((hreal.const_add r).const_mul (2 : Real)⁻¹) using 1 <;> + simp [Aseq, x, r, SymmetricMatrixCoordinates, htraceeq]; ring + · convert (himag.const_mul (2 : Real)⁻¹) using 1 <;> + simp [Aseq, x, r, SymmetricMatrixCoordinates] + · convert (himag.const_mul (2 : Real)⁻¹) using 1 <;> + simp [Aseq, x, r, SymmetricMatrixCoordinates, hsymentry] + · convert ((hreal.neg.const_add r).const_mul (2 : Real)⁻¹) using 1 <;> + simp [Aseq, x, r, SymmetricMatrixCoordinates, htraceeq] <;> try ring + · intro n + have hsym : (Aseq n).IsSymm := by + change Matrix.transpose (Aseq n) = Aseq n + ext i j + fin_cases i <;> fin_cases j <;> simp [Aseq, Matrix.transpose] + have hcoords : SymmetricMatrixCoordinates (Aseq n) = + ((BandCircleEuclideanData (Cseq n)).center, r) := by + apply Prod.ext + · apply Complex.ext <;> simp [Aseq, SymmetricMatrixCoordinates]; ring + · simp [Aseq, SymmetricMatrixCoordinates, Matrix.trace, Fin.sum_univ_two, + Matrix.diag]; ring + apply (CircleMatrixEnclosureCriterion (Aseq n) hsym (Cseq n)).1.mpr + rw [hcoords] + simp only [dist_self, zero_add] + have hr : r ≤ 0 := by + change Matrix.trace A ≤ 0 + exact htrace + linarith [hr, (BandCircleEuclideanData (Cseq n)).radius_pos] + · have hC : ∃ C : BandCircle, + dist x (BandCircleEuclideanData C).center < + (BandCircleEuclideanData C).radius := by + change ¬ (∀ C : BandCircle, + (BandCircleEuclideanData C).radius ≤ dist x + (BandCircleEuclideanData C).center) at hExterior + obtain ⟨C, hC⟩ := Classical.not_forall.mp hExterior + exact ⟨C, lt_of_not_ge hC⟩ + obtain ⟨C, hC⟩ := hC + refine ⟨fun _ => A, ?_, fun _ => C, ?_⟩ + · intro i j + exact tendsto_const_nhds + · intro n + apply (CircleMatrixEnclosureCriterion A hA C).1.mpr + dsimp [x, r] at hC ⊢ + have hr : (SymmetricMatrixCoordinates A).2 ≤ 0 := by + change Matrix.trace A ≤ 0 + exact htrace + linarith [hr, hC] + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TranslatedMinimumEnvelope.lean b/LeanPool/ApollonianSuperharmonic/TranslatedMinimumEnvelope.lean new file mode 100644 index 0000000000..2353a2ce7b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TranslatedMinimumEnvelope.lean @@ -0,0 +1,212 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicRepresentative +public import LeanPool.ApollonianSuperharmonic.IntegerLaplacianCastBridge +public import LeanPool.ApollonianSuperharmonic.QuadraticAffineLaplacian +public import LeanPool.ApollonianSuperharmonic.QuadraticGrowthAtInfinity +public import LeanPool.ApollonianSuperharmonic.RealLaplacianContactComparison +public import Mathlib.Order.Int.LeastGreatest + +-- [TABLET NODE: TranslatedMinimumEnvelope] + +/-! +# TranslatedMinimumEnvelope + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TranslatedMinimumEnvelope + (A : Matrix (Fin 2) (Fin 2) Real) (hA : A.IsSymm) + (b : Fin 2 -> Real) (u : IntegerLatticeFunction) + (hulap : forall x, FourNeighborLaplacian u x <= 1) + (hulower : forall x, LatticeQuadraticForm A x + + dotProduct b ![(x.re : Real), (x.im : Real)] <= (u x : Real)) : + exists F : GaussianInt -> IntegerLatticeFunction, + exists g : IntegerLatticeFunction, + (forall z x, + F z x = u (x + z) - + Int.floor (LatticeQuadraticForm A z + + dotProduct b ![(z.re : Real), (z.im : Real)]) - + Int.floor ((Matrix.mulVec A + ![(z.re : Real), (z.im : Real)]) 0 + b 0) * x.re - + Int.floor ((Matrix.mulVec A + ![(z.re : Real), (z.im : Real)]) 1 + b 1) * x.im) /\ + (forall z x, FourNeighborLaplacian (F z) x <= 1) /\ + (forall x, (forall z, g x <= F z x) /\ exists z, g x = F z x) /\ + (forall x, + LatticeQuadraticForm A x - ((abs x.re + abs x.im : Int) : Real) <= + (g x : Real) /\ + (g x : Real) <= LatticeQuadraticForm A x + (u 0 : Real) + 1 + + ((abs x.re + abs x.im : Int) : Real)) /\ + IntegerSuperharmonicRepresentative A g := by +-- BODY + classical + let c (z : GaussianInt) : Real := LatticeQuadraticForm A z + + dotProduct b ![(z.re : Real), (z.im : Real)] + let a (z : GaussianInt) (j : Fin 2) : Real := + (Matrix.mulVec A ![(z.re : Real), (z.im : Real)]) j + b j + let F (z x : GaussianInt) : Int := + u (x + z) - Int.floor (c z) - Int.floor (a z 0) * x.re - + Int.floor (a z 1) * x.im + let r (z : GaussianInt) (j : Fin 2) : Real := a z j - (Int.floor (a z j) : Real) + have hexpand (x z : GaussianInt) : + LatticeQuadraticForm A (x + z) + + dotProduct b ![((x + z).re : Real), ((x + z).im : Real)] = + LatticeQuadraticForm A x + c z + + a z 0 * (x.re : Real) + a z 1 * (x.im : Real) := by + dsimp [c, a] + simp [LatticeQuadraticForm, Matrix.mulVec, dotProduct, hA.apply 0 1] + ring + have hcast (z x : GaussianInt) : + (F z x : Real) = (u (x + z) : Real) - (Int.floor (c z) : Real) - + (Int.floor (a z 0) : Real) * (x.re : Real) - + (Int.floor (a z 1) : Real) * (x.im : Real) := by + simp only [F, Int.cast_sub, Int.cast_mul] + have hrem (t : Real) : 0 <= t - (Int.floor t : Real) ∧ + t - (Int.floor t : Real) <= 1 := by + constructor + · linarith [Int.floor_le t] + · linarith [Int.lt_floor_add_one t] + have hmul (s t : Real) (hs : 0 <= s) (hs' : s <= 1) : + -abs t <= s * t ∧ s * t <= abs t := by + constructor + · have h := mul_le_mul_of_nonneg_left (neg_le_abs t) hs + have h' := mul_le_mul_of_nonneg_right hs' (abs_nonneg t) + nlinarith + · have h := mul_le_mul_of_nonneg_left (le_abs_self t) hs + have h' := mul_le_mul_of_nonneg_right hs' (abs_nonneg t) + nlinarith + have hlower (z x : GaussianInt) : + LatticeQuadraticForm A x - ((abs x.re + abs x.im : Int) : Real) <= + (F z x : Real) := by + have hu := hulower (x + z) + rw [hexpand x z] at hu + have hr0 := (hrem (c z)).1 + have hrx := (hmul (r z 0) (x.re : Real) + (hrem (a z 0)).1 (hrem (a z 0)).2).1 + have hry := (hmul (r z 1) (x.im : Real) + (hrem (a z 1)).1 (hrem (a z 1)).2).1 + dsimp only [r] at hrx hry + rw [Int.cast_add, Int.cast_abs, Int.cast_abs] + nlinarith [hcast z x] + have hupper (x : GaussianInt) : + (F (-x) x : Real) <= LatticeQuadraticForm A x + (u 0 : Real) + 1 + + ((abs x.re + abs x.im : Int) : Real) := by + have he := hexpand x (-x) + have hzero : LatticeQuadraticForm A 0 + + dotProduct b ![((0 : GaussianInt).re : Real), ((0 : GaussianInt).im : Real)] = 0 := by + simp [LatticeQuadraticForm, Matrix.mulVec, dotProduct] + rw [add_neg_cancel, hzero] at he + have hc := hcast (-x) x + rw [add_neg_cancel] at hc + have hr0 := (hrem (c (-x))).2 + have hrx := (hmul (r (-x) 0) (x.re : Real) + (hrem (a (-x) 0)).1 (hrem (a (-x) 0)).2).2 + have hry := (hmul (r (-x) 1) (x.im : Real) + (hrem (a (-x) 1)).1 (hrem (a (-x) 1)).2).2 + dsimp only [r] at hrx hry + rw [Int.cast_add, Int.cast_abs, Int.cast_abs] + nlinarith + have hFlap (z x : GaussianInt) : FourNeighborLaplacian (F z) x <= 1 := by + have he : FourNeighborLaplacian (F z) x = FourNeighborLaplacian u (x + z) := by + simp only [FourNeighborLaplacian, F] + rw [show (x + 1) + z = (x + z) + 1 by abel, + show (x - 1) + z = (x + z) - 1 by abel, + show (x + ⟨0, 1⟩) + z = (x + z) + ⟨0, 1⟩ by abel, + show (x - ⟨0, 1⟩) + z = (x + z) - ⟨0, 1⟩ by abel] + simp [sub_eq_add_neg] + ring + rw [he] + exact hulap (x + z) + have hminimum (x : GaussianInt) : + exists m : Int, (exists z, F z x = m) ∧ + forall n : Int, (exists z, F z x = n) -> m <= n := by + apply Int.exists_least_of_bdd + · refine ⟨Int.floor (LatticeQuadraticForm A x - + ((abs x.re + abs x.im : Int) : Real)), ?_⟩ + rintro n ⟨z, rfl⟩ + apply (Int.cast_le (R := Real)).mp + exact (Int.floor_le _).trans (hlower z x) + · exact ⟨F 0 x, 0, rfl⟩ + let g (x : GaussianInt) : Int := Classical.choose (hminimum x) + have hmin (x : GaussianInt) : + (forall z, g x <= F z x) ∧ exists z, g x = F z x := by + have hs := Classical.choose_spec (hminimum x) + constructor + · intro z + exact hs.2 (F z x) ⟨z, rfl⟩ + · obtain ⟨z, hz⟩ := hs.1 + exact ⟨z, hz.symm⟩ + have hbounds (x : GaussianInt) : + LatticeQuadraticForm A x - ((abs x.re + abs x.im : Int) : Real) <= + (g x : Real) ∧ + (g x : Real) <= LatticeQuadraticForm A x + (u 0 : Real) + 1 + + ((abs x.re + abs x.im : Int) : Real) := by + constructor + · obtain ⟨z, hz⟩ := (hmin x).2 + rw [hz] + exact hlower z x + · have hm : (g x : Real) <= (F (-x) x : Real) := + Int.cast_le.mpr ((hmin x).1 (-x)) + exact hm.trans (hupper x) + have hglap (x : GaussianInt) : FourNeighborLaplacian g x <= 1 := by + obtain ⟨z, hz⟩ := (hmin x).2 + have hc := RealLaplacianContactComparison.1 + (fun y => (g y : Real)) (fun y => (F z y : Real)) x + (congrArg (fun n : Int => (n : Real)) hz) (by + intro y hy + exact Int.cast_le.mpr ((hmin y).1 z)) + rw [IntegerLaplacianCastBridge g x, IntegerLaplacianCastBridge (F z) x] at hc + exact (Int.cast_le.mp hc).trans (hFlap z x) + let K : Real := abs ((u 0 : Real) + 1) + have habs (x : GaussianInt) : + abs ((g x : Real) - LatticeQuadraticForm A x) <= + K + abs (x.re : Real) + abs (x.im : Real) := by + have hb := hbounds x + rw [Int.cast_add, Int.cast_abs, Int.cast_abs] at hb + apply abs_le.mpr + constructor + · have hK : 0 <= K := abs_nonneg _ + linarith [hb.1] + · have hK : (u 0 : Real) + 1 <= K := le_abs_self _ + linarith [hb.2] + have hgrowth : QuadraticGrowthAtInfinity A g := by + intro eps heps + have hlinear (t : Real) : abs t <= eps * t ^ 2 / 4 + 1 / eps := by + apply (mul_le_mul_iff_of_pos_left heps).mp + have hcancel : eps * (1 / eps) = 1 := by field_simp + rw [mul_add, hcancel] + have hs := sq_nonneg (eps * abs t - 2) + rw [sub_sq, mul_pow, sq_abs] at hs + nlinarith only [hs] + refine ⟨2 * (K + 2 / eps) / eps, ?_⟩ + intro x hx + have hcancel : eps * (2 * (K + 2 / eps) / eps) = 2 * (K + 2 / eps) := by + field_simp + have ht := mul_le_mul_of_nonneg_left hx heps.le + rw [hcancel] at ht + have hnonneg : 0 <= eps * ((x.re : Real) ^ 2 + (x.im : Real) ^ 2) := + mul_nonneg heps.le (add_nonneg (sq_nonneg _) (sq_nonneg _)) + calc + abs ((g x : Real) - LatticeQuadraticForm A x) <= + K + abs (x.re : Real) + abs (x.im : Real) := habs x + _ <= eps * ((x.re : Real) ^ 2 + (x.im : Real) ^ 2) := by + have hre := hlinear (x.re : Real) + have him := hlinear (x.im : Real) + rw [show 2 / eps = 2 * (1 / eps) by ring] at ht + nlinarith only [ht, hnonneg, hre, him] + exact ⟨F, g, (fun _ _ => rfl), hFlap, hmin, hbounds, hA, hgrowth, hglap⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TriangularBoundaryStrip.lean b/LeanPool/ApollonianSuperharmonic/TriangularBoundaryStrip.lean new file mode 100644 index 0000000000..0d0c94bc48 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TriangularBoundaryStrip.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TriangularMaxIncrement +public import LeanPool.ApollonianSuperharmonic.TriangularSignedHeight + +-- [TABLET NODE: TriangularBoundaryStrip] + +/-! +# TriangularBoundaryStrip + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For distinct endpoints $x,y\in\mathbb Z^2$, their left boundary strip is +the height window +$$ + \mathcal B(x,y)=\{z\in\mathbb Z^2:0\leq + \Phi_{x,y}(z) v = u + 1 ∨ u = v + 1) → + (∀ z : Int, z ∈ p ↔ min a b ≤ z ∧ z ≤ max a b))) := by + classical + intro x y p + induction p using List.reverseRecOn with + | nil => + intro a b ha hb hn hc + simp at ha + | append_singleton l c ih => + intro a b ha hb hn hc + cases l with + | nil => + have hac : a = c := by simpa using ha.symm + have hbc : b = c := by simpa using hb.symm + subst a + subst b + intro z + constructor + · intro hz + have hzc : z = c := by simpa using hz + subst z + omega + · intro hz + have : z = c := by omega + simp [this] + | cons d t => + have hhead : (d :: t).head? = some a := by simpa using ha + have hnodup : (d :: t).Nodup := (List.nodup_append.mp hn).1 + have hchain : (d :: t).IsChain (fun u v : Int => v = u + 1 ∨ u = v + 1) := + List.IsChain.left_of_append hc + have hlast : ∃ u, (d :: t).getLast? = some u := by + induction t using List.reverseRecOn with + | nil => simp + | append_singleton l e => + exact ⟨e, by simpa [List.cons_append] using + (List.getLast?_concat (l := d :: l) (a := e))⟩ + obtain ⟨u, hu⟩ := hlast + have hi := ih a u hhead hu hnodup hchain + have hb' : b = c := by + have hcget : (d :: t ++ [c]).getLast? = some c := by + simpa [List.cons_append] using + (List.getLast?_concat (l := d :: t) (a := c)) + exact Option.some.inj (hb.symm.trans hcget) + have hs := hc.rel_getLast_dropLast (by + intro hh + cases t <;> simp at hh) + have hstep : c = u + 1 ∨ u = c + 1 := by + have hfull : (d :: t ++ [c]).getLast (by simp) = c := by + have hcget : (d :: t ++ [c]).getLast? = some c := by + simpa [List.cons_append] using + (List.getLast?_concat (l := d :: t) (a := c)) + exact Option.some.inj ((List.getLast?_eq_some_getLast _).symm.trans hcget) + have hne : (d :: t ++ [c]).dropLast ≠ [] := by + apply List.ne_nil_of_mem (a := d) + rw [List.dropLast_concat] + simp + have hdrop : (d :: t ++ [c]).dropLast.getLast hne = u := by + have hdrop_eq : (d :: t ++ [c]).dropLast = d :: t := by + rw [List.dropLast_concat] + have hdropget : (d :: t ++ [c]).dropLast.getLast? = some u := by + rw [hdrop_eq] + exact hu + exact Option.some.inj ((List.getLast?_eq_some_getLast _).symm.trans hdropget) + rw [hfull, hdrop] at hs + exact hs + have hnew : c ∉ d :: t := by + intro hcm + have hh := (List.nodup_append.mp hn).2.2 c hcm c (by simp) + exact hh rfl + intro z + constructor + · intro hz + have hz' : z ∈ d :: t ∨ z = c := by + simpa only [List.mem_append, List.mem_singleton, or_assoc] using hz + rcases hz' with hz | hzcval + · have hzold := (hi z).mp hz + rw [hb'] + have hout : ¬ (min a u ≤ c ∧ c ≤ max a u) := by + intro hh + exact hnew ((hi c).mpr hh) + rcases hstep with hstep | hstep <;> omega + · subst z + rw [hb'] + have hout : ¬ (min a u ≤ c ∧ c ≤ max a u) := by + intro hh + exact hnew ((hi c).mpr hh) + rcases hstep with hstep | hstep <;> omega + · intro hz + rcases hz with ⟨hz1, hz2⟩ + by_cases hzc : z = c + · simp [hzc] + · have hzold : min a u ≤ z ∧ z ≤ max a u := by + have hout : ¬ (z < min a u ∨ max a u < z) := by + intro hh + rcases hh with hh | hh <;> omega + omega + have : z ∈ d :: t := (hi z).mpr hzold + simpa [hzc] using this + +private theorem hindices_nodup : + ∀ (x : Int × Int), ∀ (y : Int × Int), ∀ (path : List (Int × Int)), ∀ (order : ℤ ≃ + { z : ℤ × ℤ // TriangularBoundaryStrip x y z }), (path.head? = some x ∧ path.getLast? = + some y ∧ path.Nodup ∧ (∀ z ∈ path, TriangularBoundaryStrip x y z) ∧ path.IsChain + TriangularLatticeAdjacent) → ( + let index : (Int × Int) → Int := fun z => + @dite Int (TriangularBoundaryStrip x y z) (Classical.propDecidable _) + (fun hz => order.symm ⟨z, hz⟩) (fun _ => 0) + let indices := path.map index + (∀ z, z ∈ path → (order (index z)).1 = z) → (indices.Nodup)) := by + classical + intro x y path order hdata index indices hindex_apply + apply List.Nodup.map_on (l := path) + · intro a ha b hb hab + have he : order (index a) = order (index b) := by + exact congrArg order hab + calc + a = (order (index a)).1 := (hindex_apply a ha).symm + _ = (order (index b)).1 := congrArg Subtype.val he + _ = b := hindex_apply b hb + · exact hdata.2.2.1 + +private theorem hindices_chain : + ∀ (x : Int × Int), ∀ (y : Int × Int), ∀ (path : List (Int × Int)), ∀ (order : ℤ ≃ + { z : ℤ × ℤ // TriangularBoundaryStrip x y z }), (∀ (m : ℤ), ∀ (n : ℤ), + TriangularLatticeAdjacent (↑((order : ℤ → { z : ℤ × ℤ // TriangularBoundaryStrip x y z }) + m) : ℤ × ℤ) (↑((order : ℤ → { z : ℤ × ℤ // TriangularBoundaryStrip x y z }) n) : ℤ × ℤ) ↔ + n = m + (1 : ℤ) ∨ m = n + (1 : ℤ)) → ((path.head? = some x ∧ path.getLast? = some y ∧ + path.Nodup ∧ (∀ z ∈ path, TriangularBoundaryStrip x y z) ∧ path.IsChain + TriangularLatticeAdjacent) → ( + let index : (Int × Int) → Int := fun z => + @dite Int (TriangularBoundaryStrip x y z) (Classical.propDecidable _) + (fun hz => order.symm ⟨z, hz⟩) (fun _ => 0) + let indices := path.map index + (∀ z, z ∈ path → (order (index z)).1 = z) → (indices.IsChain (fun u v : Int => v = u + 1 ∨ u + = v + 1)))) := by + classical + intro x y path order hadj hdata index indices hindex_apply + change List.IsChain (fun u v : Int => v = u + 1 ∨ u = v + 1) (path.map index) + rw [List.isChain_map] + apply List.IsChain.imp_of_mem_imp (l := path) + · intro a b ha hb hab + have q : TriangularLatticeAdjacent (order (index a)).1 (order (index b)).1 := by + rw [hindex_apply a ha, hindex_apply b hb] + exact hab + exact (hadj (index a) (index b)).mp q + · exact hdata.2.2.2.2 + +private theorem trim_property : + ∀ (x : Int × Int), ∀ (y : Int × Int), (ℤ ≃ { z : ℤ × ℤ // TriangularBoundaryStrip x y z }) → + ((ℤ) → ((ℤ) → ((∀ (p : List Int), ∀ (a : Int), ∀ (b : Int), p.head? = some a → p.getLast? + = some b → p.Nodup → p.IsChain (fun u v : Int => v = u + 1 ∨ u = v + 1) → (∀ z : Int, z ∈ + p ↔ min a b ≤ z ∧ z ≤ max a b)) → (∀ (l : List Int), ∀ (a : Int), ∀ (b : Int), l.head? = + some a → l.getLast? = some b → l.Nodup → + ∀ q, q ∈ (l.drop 1).dropLast ↔ q ∈ l ∧ q ≠ a ∧ q ≠ b)))) := by + classical + intro x y order m n walk l + cases l with + | nil => + intro a b ha hb hn q + simp at ha + | cons c t => + intro a b ha hb hn q + have hac : a = c := by simpa using ha.symm + subst a + cases t with + | nil => simp_all; omega + | cons d s => + have htail : (d :: s).getLast? = some b := by simpa using hb + have htail_nodup : (d :: s).Nodup := (List.nodup_cons.mp hn).2 + constructor + · intro hq + have hqt : q ∈ d :: s := List.mem_of_mem_dropLast hq + have hqc : q ≠ c := by + intro hqc + exact (List.nodup_cons.mp hn).1 (hqc ▸ hqt) + have hqb : q ≠ b := by + intro hqb + subst q + have hlast_mem : b ∈ (d :: s) := by + apply List.mem_of_getLast? + exact htail + have hdup : d :: s = (d :: s).dropLast ++ [b] := + (List.dropLast_append_getLast? b (by simpa using htail)).symm + rw [hdup] at htail_nodup + have hq' : b ∈ (d :: s).dropLast := by simpa using hq + exact ((List.nodup_append.mp htail_nodup).2.2 b hq' b (by simp)) rfl + exact ⟨by simp [hqt], hqc, hqb⟩ + · rintro ⟨hq, hqc, hqb⟩ + have hqt : q ∈ d :: s := by simpa [hqc] using hq + have hqopt : some q ≠ (d :: s).getLast? := by + intro he + have heq : q = b := Option.some.inj (he.trans htail) + exact hqb heq + exact List.mem_dropLast_of_mem_of_ne_getLast? hqt hqopt + +private theorem hmaptrim : + ∀ (x : Int × Int), ∀ (y : Int × Int), ∀ (path : List (Int × Int)), ∀ (order : ℤ ≃ + { z : ℤ × ℤ // TriangularBoundaryStrip x y z }), + let index : (Int × Int) → Int := fun z => + @dite Int (TriangularBoundaryStrip x y z) (Classical.propDecidable _) + (fun hz => order.symm ⟨z, hz⟩) (fun _ => 0) + let indices := path.map index + (∀ z, z ∈ path → (order (index z)).1 = z) → ((∀ z, TriangularBoundaryStrip x y z → (order + (index z)).1 = z) → (∀ z, TriangularBoundaryStrip x y z → + (z ∈ (path.drop 1).dropLast ↔ + index z ∈ (indices.drop 1).dropLast))) := by + classical + intro x y path order index indices hindex_apply hindex_boundary z hzb + constructor + · intro hz + change index z ∈ ((path.map index).drop 1).dropLast + rw [← List.map_drop, ← List.map_dropLast] + exact List.mem_map.mpr ⟨z, hz, rfl⟩ + · intro hz + change index z ∈ ((path.map index).drop 1).dropLast at hz + rw [← List.map_drop, ← List.map_dropLast] at hz + rcases List.mem_map.mp hz with ⟨w, hw, hwi⟩ + have hwpath : w ∈ path := List.mem_of_mem_drop (List.mem_of_mem_dropLast hw) + have heq : w = z := by + have he : order (index w) = order (index z) := by rw [hwi] + calc + w = (order (index w)).1 := (hindex_apply w hwpath).symm + _ = (order (index z)).1 := congrArg Subtype.val he + _ = z := hindex_boundary z hzb + exact heq ▸ hw + +private theorem hzmem : + ∀ (x : Int × Int), ∀ (y : Int × Int), ∀ (path : List (Int × Int)), ∀ (order : ℤ ≃ + { z : ℤ × ℤ // TriangularBoundaryStrip x y z }), ∀ (m : ℤ), ∀ (n : ℤ), + let index : (Int × Int) → Int := fun z => + @dite Int (TriangularBoundaryStrip x y z) (Classical.propDecidable _) + (fun hz => order.symm ⟨z, hz⟩) (fun _ => 0) + let indices := path.map index + (∀ z, z ∈ path → (order (index z)).1 = z) → ((∀ (z : ℤ), z ∈ indices ↔ min m n ≤ z ∧ z ≤ max + m n) → (∀ (z : ℤ × ℤ), ∀ (k : ℤ), (min m n ≤ k) → ((k ≤ max m n) → (((↑((order : ℤ → + { z : ℤ × ℤ // TriangularBoundaryStrip x y z }) k) : ℤ × ℤ) = z) → (z ∈ path))))) := by + classical + intro x y path order m n index indices hindex_apply hindset z k hk1 hk2 hk + have hi := (hindset k).mpr ⟨hk1, hk2⟩ + change k ∈ path.map index at hi + rcases List.mem_map.mp hi with ⟨w, hw, hwi⟩ + have heq : w = z := by + have he' := congrArg order hwi + have he'' := congrArg Subtype.val he' + rw [hindex_apply w hw, hk] at he'' + exact he'' + exact heq ▸ hw + +end StripOrderIntervalProof + +theorem TriangularStripSegmentOrderInterval + (x y : Int × Int) (hxy : x ≠ y) + (path : List (Int × Int)) + (hpath : TriangularStripSegment x y path) : + ∃ order : Int ≃ {z : Int × Int // TriangularBoundaryStrip x y z}, + (∀ m n : Int, + TriangularLatticeAdjacent (order m).1 (order n).1 ↔ + n = m + 1 ∨ m = n + 1) ∧ + ∃ m n : Int, + (order m).1 = x ∧ (order n).1 = y ∧ + (∀ z : Int × Int, z ∈ path ↔ + ∃ k : Int, + min m n ≤ k ∧ k ≤ max m n ∧ (order k).1 = z) ∧ + (∀ z : Int × Int, z ∈ (path.drop 1).dropLast ↔ + ∃ k : Int, + min m n < k ∧ k < max m n ∧ (order k).1 = z) := by +-- BODY + have hmain := (AffineTriangularStrip).2 x y hxy + obtain ⟨hinc, hstrip, order, hadj⟩ := hmain + have hdata : path.head? = some x ∧ path.getLast? = some y ∧ + path.Nodup ∧ (∀ z ∈ path, TriangularBoundaryStrip x y z) ∧ + path.IsChain TriangularLatticeAdjacent := by + simpa [TriangularStripSegment, hxy] using hpath + have hxmem : x ∈ path := by + apply List.mem_of_mem_head? + simp [hdata.1] + have hymem : y ∈ path := by + exact List.mem_of_getLast? hdata.2.1 + obtain ⟨m, hm⟩ := order.surjective ⟨x, hdata.2.2.2.1 x hxmem⟩ + obtain ⟨n, hn⟩ := order.surjective ⟨y, hdata.2.2.2.1 y hymem⟩ + have hmn : m ≠ n := by + intro he + apply hxy + have hh : (⟨x, _⟩ : {z : Int × Int // TriangularBoundaryStrip x y z}) = + ⟨y, _⟩ := hm.symm.trans ((congrArg order he).trans hn) + exact congrArg Subtype.val hh + have walk : ∀ (p : List Int) (a b : Int), + p.head? = some a → p.getLast? = some b → p.Nodup → + p.IsChain (fun u v : Int => v = u + 1 ∨ u = v + 1) → + (∀ z : Int, z ∈ p ↔ min a b ≤ z ∧ z ≤ max a b) := StripOrderIntervalProof.walk x y + have hfirst : path.head? = some x := hdata.1 + have hlast : path.getLast? = some y := hdata.2.1 + classical + let index : (Int × Int) → Int := fun z => if hz : TriangularBoundaryStrip x y z then + order.symm ⟨z, hz⟩ else 0 + let indices := path.map index + have hindex_apply : ∀ z, z ∈ path → (order (index z)).1 = z := by + intro z hz + simp [index, hdata.2.2.2.1 z hz] + have hindx : index x = m := by + apply order.injective + apply Subtype.ext + rw [hindex_apply x hxmem] + exact congrArg Subtype.val hm.symm + have hindy : index y = n := by + apply order.injective + apply Subtype.ext + rw [hindex_apply y hymem] + exact congrArg Subtype.val hn.symm + have hindices_head : indices.head? = some m := by + simp [indices, List.head?_map, hfirst, hindx] + have hindices_last : indices.getLast? = some n := by + simp [indices, List.getLast?_map, hlast, hindy] + have hindices_nodup : indices.Nodup := StripOrderIntervalProof.hindices_nodup x y path order + hdata hindex_apply + have hindices_chain : indices.IsChain (fun u v : Int => v = u + 1 ∨ u = v + 1) := + StripOrderIntervalProof.hindices_chain x y path order hadj hdata hindex_apply + have hindset := walk indices m n hindices_head hindices_last hindices_nodup hindices_chain + have hindex_boundary : ∀ z, TriangularBoundaryStrip x y z → + (order (index z)).1 = z := by + intro z hz + simp [index, hz] + have trim_property : ∀ (l : List Int) (a b : Int), + l.head? = some a → l.getLast? = some b → l.Nodup → + ∀ q, q ∈ (l.drop 1).dropLast ↔ q ∈ l ∧ q ≠ a ∧ q ≠ b := + StripOrderIntervalProof.trim_property x y order m n walk + have hmaptrim : ∀ z, TriangularBoundaryStrip x y z → + (z ∈ (path.drop 1).dropLast ↔ + index z ∈ (indices.drop 1).dropLast) := StripOrderIntervalProof.hmaptrim x y path order + hindex_apply hindex_boundary + refine ⟨order, hadj, m, n, ?_, ?_, ?_, ?_⟩ + · exact congrArg Subtype.val hm + · exact congrArg Subtype.val hn + · intro z + constructor + · intro hz + have hz' := (hindset (index z)).mp (by + apply List.mem_map.mpr + exact ⟨z, hz, rfl⟩) + rcases hz' with ⟨hk1, hk2⟩ + refine ⟨index z, hk1, hk2, ?_⟩ + exact hindex_apply z hz + · rintro ⟨k, hk1, hk2, hk⟩ + have hzmem : z ∈ path := StripOrderIntervalProof.hzmem x y path order m n hindex_apply + hindset z k hk1 hk2 hk + exact hzmem + · intro z + constructor + · intro hz + have hzpath : z ∈ path := List.mem_of_mem_drop (List.mem_of_mem_dropLast hz) + have hzb : TriangularBoundaryStrip x y z := hdata.2.2.2.1 z hzpath + have htrim := trim_property indices m n hindices_head hindices_last hindices_nodup (index z) + have hi := (hmaptrim z hzb).mp hz + have hbounds := (htrim.mp hi).1 + have hneq := (htrim.mp hi).2 + have hclosed := (hindset (index z)).mp hbounds + refine ⟨index z, ?_, ?_, hindex_boundary z hzb⟩ + · omega + · omega + · rintro ⟨k, hk1, hk2, hk⟩ + have hzb : TriangularBoundaryStrip x y z := by + rw [← hk] + exact (order k).property + have hik : index z = k := by + apply order.injective + apply Subtype.ext + rw [hindex_boundary z hzb, hk] + have hclosed : min m n ≤ k ∧ k ≤ max m n := by omega + have himem := (hindset k).mpr hclosed + have htrim := trim_property indices m n hindices_head hindices_last hindices_nodup (index z) + have hstrict : index z ≠ m ∧ index z ≠ n := by omega + have hinner := htrim.mpr ⟨by simpa [hik] using himem, hstrict.1, hstrict.2⟩ + exact (hmaptrim z hzb).mpr hinner + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/UniqueBoundedGridComplementComponent.lean b/LeanPool/ApollonianSuperharmonic/UniqueBoundedGridComplementComponent.lean new file mode 100644 index 0000000000..5bc062fced --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/UniqueBoundedGridComplementComponent.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: UniqueBoundedGridComplementComponent] + +/-! +# UniqueBoundedGridComplementComponent + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For sets of lattice-square centers $B,C\subseteq\mathbb Z[i]$, say that +$C$ is the *unique bounded grid-complement component* of the barrier +$B$ when $C$ is finite, nonempty, four-neighbor connected, and contained +in $B^c$; it is maximal among four-neighbor connected subsets of $B^c$; +and every finite maximal four-neighbor connected subset of $B^c$ equals +$C$. Here four-neighbor paths take steps $\pm1,\pm i$. This is the +square-center formulation of the unique bounded complementary component +used in the surrounding-ring argument. +-/ +def UniqueBoundedGridComplementComponent + (barrier component : Set GaussianInt) : Prop := +-- BODY + let GridConnected := fun S : Set GaussianInt => + S.Nonempty ∧ ∀ x ∈ S, ∀ y ∈ S, ∃ p : List GaussianInt, + p.head? = some x ∧ p.getLast? = some y ∧ + (∀ z ∈ p, z ∈ S) ∧ + ∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ + b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ + component.Finite ∧ component ⊆ barrierᶜ ∧ GridConnected component ∧ + (∀ D : Set GaussianInt, GridConnected D → component ⊆ D → + D ⊆ barrierᶜ → D = component) ∧ + ∀ D : Set GaussianInt, D.Finite → D ⊆ barrierᶜ → GridConnected D → + (∀ E : Set GaussianInt, GridConnected E → D ⊆ E → + E ⊆ barrierᶜ → E = D) → + D = component + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientation.lean b/LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientation.lean new file mode 100644 index 0000000000..f4e28e0ddc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientation.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple + +-- [TABLET NODE: UnitOccurrenceOrientation] + +/-! +# UnitOccurrenceOrientation + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +For a proper ordered band quadruple $q=(C_0,C_1,C_2,C_3)$, a selected +unit parent slot $i\in\mathbb Z/3\mathbb Z$, and +$\epsilon\in\{\mathsf{standard},\mathsf{rotated}\}$, the relation +$\operatorname{UnitOccurrenceOrientation}(q,i,\epsilon)$ is generated by +the following occurrence rules. + +Put $U_z=(1,1+2z)$. The two first proper successor families are +$$ + L_z=((4,1+8z+4i),U_z,(0,-1),U_{z+i}), + \qquad + R_z=((4,7+8z+4i),U_z,U_{z+i},(0,1)). +$$ +In $L_z$, the $U_z$ occurrence is standard and the $U_{z+i}$ occurrence +is rotated. In $R_z$, the $U_z$ occurrence is likewise standard and the +$U_{z+i}$ occurrence is likewise rotated. Cyclic rotation of the three +parent slots carries the orientation with the selected occurrence. Finally, +a proper successor +$$ + (A,X,B,D)\longmapsto(2(A+B+D)-X,A,B,D) +$$ +transports a certificate on a retained unit parent by inspecting the other +retained parent. If $B,D$ are both units, use the canonical primitive +orientation of their literal common side. When $B\longrightarrow D$, the +successor labels are +$(B\text{ rotated},D\text{ standard})$; when +$D\longrightarrow B$, they are +$(B\text{ standard},D\text{ rotated})$. In particular these labels do not +depend on, and are not obtained by negating, the predecessor labels. If the +sibling of the selected unit is a line or has curvature different from one, +the predecessor label is preserved. For the first successor which retains +both units in either root family, the direction rule reproduces the root +labels; hence both selected occurrences preserve their Boolean and there is +no exceptional mismatch transition. There is deliberately no constructor +transporting the replaced parent $X$, nor one selecting a chart from the +magnitude or direction of a whole boundary-string displacement. +-/ +inductive UnitOccurrenceOrientation : + (Fin 4 → CircleCoordinates) → Fin 3 → Bool → Prop where +-- BODY + | leftLower (z : GaussianInt) : + UnitOccurrenceOrientation + ![(4, 1 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z), (0, -1), (1, 1 + 2 * z + 2 * ⟨0, 1⟩)] + 0 true + | leftUpper (z : GaussianInt) : + UnitOccurrenceOrientation + ![(4, 1 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z), (0, -1), (1, 1 + 2 * z + 2 * ⟨0, 1⟩)] + 2 false + | rightUpper (z : GaussianInt) : + UnitOccurrenceOrientation + ![(4, 7 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (0, 1)] + 0 true + | rightLower (z : GaussianInt) : + UnitOccurrenceOrientation + ![(4, 7 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (0, 1)] + 1 false + | rotate {q : Fin 4 → CircleCoordinates} {i : Fin 3} + {orientation : Bool} : + UnitOccurrenceOrientation q i orientation → + UnitOccurrenceOrientation ![q 0, q 2, q 3, q 1] (i + 2) orientation + | retainSecondToThird {q : Fin 4 → CircleCoordinates} {orientation : Bool} : + ProperBandQuadruple q → (q 3).1 = 1 → + PrimitiveVectorOrientation (q 2) (q 3) → + UnitOccurrenceOrientation q 1 orientation → + UnitOccurrenceOrientation + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + 1 false + | retainSecondFromThird {q : Fin 4 → CircleCoordinates} {orientation : Bool} : + ProperBandQuadruple q → (q 3).1 = 1 → + PrimitiveVectorOrientation (q 3) (q 2) → + UnitOccurrenceOrientation q 1 orientation → + UnitOccurrenceOrientation + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + 1 true + | retainSecondOther {q : Fin 4 → CircleCoordinates} {orientation : Bool} : + ProperBandQuadruple q → (q 3).1 ≠ 1 → + UnitOccurrenceOrientation q 1 orientation → + UnitOccurrenceOrientation + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + 1 orientation + | retainThirdFromSecond {q : Fin 4 → CircleCoordinates} {orientation : Bool} : + ProperBandQuadruple q → (q 2).1 = 1 → + PrimitiveVectorOrientation (q 2) (q 3) → + UnitOccurrenceOrientation q 2 orientation → + UnitOccurrenceOrientation + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + 2 true + | retainThirdToSecond {q : Fin 4 → CircleCoordinates} {orientation : Bool} : + ProperBandQuadruple q → (q 2).1 = 1 → + PrimitiveVectorOrientation (q 3) (q 2) → + UnitOccurrenceOrientation q 2 orientation → + UnitOccurrenceOrientation + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + 2 false + | retainThirdOther {q : Fin 4 → CircleCoordinates} {orientation : Bool} : + ProperBandQuadruple q → (q 2).1 ≠ 1 → + UnitOccurrenceOrientation q 2 orientation → + UnitOccurrenceOrientation + ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, + 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), + q 0, q 2, q 3] + 2 orientation + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientationUnique.lean b/LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientationUnique.lean new file mode 100644 index 0000000000..554467686f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientationUnique.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P5455T2OccurrenceExists +public import LeanPool.ApollonianSuperharmonic.P5455T2OccurrenceDeterministic +public import LeanPool.ApollonianSuperharmonic.P5455T2LeftRegressions +public import LeanPool.ApollonianSuperharmonic.P5455T2RightRegressions +public import LeanPool.ApollonianSuperharmonic.P5455T2WholeJoin + +-- [TABLET NODE: UnitOccurrenceOrientationUnique] + +/-! +# UnitOccurrenceOrientationUnique + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem UnitOccurrenceOrientationUnique : + (∀ (q : Fin 4 → CircleCoordinates), ProperBandQuadruple q → + ∀ i : Fin 3, (q i.succ).1 = 1 → + ∃! orientation : Bool, + UnitOccurrenceOrientation q i orientation) ∧ + ∀ z : GaussianInt, + let qLeft : Fin 4 → CircleCoordinates := + ![(12, 7 + 24 * z + 12 * ⟨0, 1⟩), + (4, 1 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z + 2 * ⟨0, 1⟩), + (1, 1 + 2 * z)] + let qRight : Fin 4 → CircleCoordinates := + ![(12, 17 + 24 * z + 12 * ⟨0, 1⟩), + (4, 7 + 8 * z + 4 * ⟨0, 1⟩), + (1, 1 + 2 * z), + (1, 1 + 2 * z + 2 * ⟨0, 1⟩)] + let qLeftRepeat : Fin 4 → CircleCoordinates := + ![(24, 17 + 48 * z + 24 * ⟨0, 1⟩), + (12, 7 + 24 * z + 12 * ⟨0, 1⟩), + (1, 1 + 2 * z + 2 * ⟨0, 1⟩), + (1, 1 + 2 * z)] + let qRightRepeat : Fin 4 → CircleCoordinates := + ![(24, 31 + 48 * z + 24 * ⟨0, 1⟩), + (12, 17 + 24 * z + 12 * ⟨0, 1⟩), + (1, 1 + 2 * z), + (1, 1 + 2 * z + 2 * ⟨0, 1⟩)] + let v := BandVectors.1 (qLeft 1) (qLeft 3) + ProperBandQuadruple qLeft ∧ + PrimitiveVectorOrientation (qLeft 2) (qLeft 3) ∧ + UnitOccurrenceOrientation qLeft 1 false ∧ + UnitOccurrenceOrientation qLeft 2 true ∧ + ProperBandQuadruple qRight ∧ + PrimitiveVectorOrientation (qRight 3) (qRight 2) ∧ + UnitOccurrenceOrientation qRight 1 true ∧ + UnitOccurrenceOrientation qRight 2 false ∧ + ProperBandQuadruple qLeftRepeat ∧ + PrimitiveVectorOrientation (qLeftRepeat 2) (qLeftRepeat 3) ∧ + UnitOccurrenceOrientation qLeftRepeat 1 false ∧ + UnitOccurrenceOrientation qLeftRepeat 2 true ∧ + ProperBandQuadruple qRightRepeat ∧ + PrimitiveVectorOrientation (qRightRepeat 3) (qRightRepeat 2) ∧ + UnitOccurrenceOrientation qRightRepeat 1 true ∧ + UnitOccurrenceOrientation qRightRepeat 2 false ∧ + v.re * v.re + v.im * v.im = 5 ∧ + ∀ orientation : Bool, ¬ UnitTriangularStep orientation v := by +-- BODY + constructor + · intro q hq i hi + obtain ⟨o, ho⟩ := P5455T2OccurrenceExists q hq i hi + refine ⟨o, ho, ?_⟩ + intro o' ho' + exact P5455T2OccurrenceDeterministic q hq i hi o' o ho' ho + · intro z + dsimp only + obtain ⟨hl, hld, hl1, hl2, hll, hlld, hll1, hll2⟩ := + P5455T2LeftRegressions z + obtain ⟨hr, hrd, hr1, hr2, hrr, hrrd, hrr1, hrr2⟩ := + P5455T2RightRegressions z + have join := P5455T2WholeJoin z + exact ⟨hl, hld, hl1, hl2, hr, hrd, hr1, hr2, + hll, hlld, hll1, hll2, hrr, hrrd, hrr1, hrr2, join.1, join.2⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/UnitSquareOpposingStripInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/UnitSquareOpposingStripInterfacePath.lean new file mode 100644 index 0000000000..757dc84ffa --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/UnitSquareOpposingStripInterfacePath.lean @@ -0,0 +1,207 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AffineOpposingStripCorridor +public import LeanPool.ApollonianSuperharmonic.AffineTriangularCorridorStep +public import LeanPool.ApollonianSuperharmonic.AffineTriangularFaceVertices +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TriangularStripSegment +public import Mathlib.Data.List.Chain + +-- [TABLET NODE: UnitSquareOpposingStripInterfacePath] + +/-! +# UnitSquareOpposingStripInterfacePath + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem UnitSquareOpposingStripInterfacePath + (anchor : GaussianInt) (r s : Int × Int) (hrs : r ≠ s) + (hnadj : ¬ TriangularLatticeAdjacent r s) + (forward reverse : List (Int × Int)) + (hforward : TriangularStripSegment r s forward) + (hreverse : TriangularStripSegment s r reverse) : + let base : ProtoTile := ⟨{anchor}, anchor⟩ + let tileAt := fun z : Int × Int => + TileTranslation base (⟨z.1, z.2⟩ : GaussianInt) + ∃ p : List GaussianInt, + (∃ x, p.head? = some x ∧ x ∈ FootprintVertices (tileAt r)) ∧ + (∃ y, p.getLast? = some y ∧ y ∈ FootprintVertices (tileAt s)) ∧ + p.IsChain (fun x y => + y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) ∧ + (∀ x, x ∈ p → + (∃ a ∈ (forward.drop 1).dropLast, + x ∈ FootprintVertices (tileAt a)) ∧ + (∃ b ∈ (reverse.drop 1).dropLast, + x ∈ FootprintVertices (tileAt b))) ∧ + ∀ x y : GaussianInt, ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ x :: y :: l₂ → + (∃ a ∈ (forward.drop 1).dropLast, + {x, y} ∈ FootprintEdges (tileAt a)) ∧ + (∃ b ∈ (reverse.drop 1).dropLast, + {x, y} ∈ FootprintEdges (tileAt b)) := by +-- BODY + dsimp only + let tileAt := fun z : Int × Int => + TileTranslation (⟨{anchor}, anchor⟩ : ProtoTile) + (⟨z.1, z.2⟩ : GaussianInt) + let rho : AffineTriangularFace → GaussianInt := fun f => match f with + | .up z => anchor + (⟨z.1, z.2⟩ : GaussianInt) + 1 + | .down z => anchor + (⟨z.1, z.2⟩ : GaussianInt) + ⟨0, 1⟩ + let step := fun x y : GaussianInt => + y = x + 1 ∨ y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + have corner (f : AffineTriangularFace) (z : Int × Int) + (hz : z ∈ AffineTriangularFaceVertices f) : + rho f ∈ FootprintVertices (tileAt z) := by + cases f with + | up w => + simp only [AffineTriangularFaceVertices, Finset.mem_insert, + Finset.mem_singleton] at hz + rcases hz with rfl | rfl | rfl <;> + simp only [tileAt, rho, TileTranslation, Finset.image_singleton, + GaussianTranslation] + all_goals + simp only [FootprintVertices, Finset.singleton_nonempty, ite_eq_left, + Set.mem_ofPred_eq, Finset.mem_singleton, exists_eq_left] + simp [Zsqrtd.ext_iff, add_assoc] + | down w => + simp only [AffineTriangularFaceVertices, Finset.mem_insert, + Finset.mem_singleton] at hz + rcases hz with rfl | rfl | rfl <;> + simp only [tileAt, rho, TileTranslation, Finset.image_singleton, + GaussianTranslation] + all_goals + simp only [FootprintVertices, Finset.singleton_nonempty, ite_eq_left, + Set.mem_ofPred_eq, Finset.mem_singleton, exists_eq_left] + simp [Zsqrtd.ext_iff, add_assoc] + have bounds (z : Int × Int) (w : GaussianInt) + (hw : w ∈ FootprintVertices (tileAt z)) : + anchor.re + z.1 ≤ w.re ∧ w.re ≤ anchor.re + z.1 + 1 ∧ + anchor.im + z.2 ≤ w.im ∧ w.im ≤ anchor.im + z.2 + 1 := by + simp only [tileAt, TileTranslation, Finset.image_singleton, GaussianTranslation, + FootprintVertices, Finset.singleton_nonempty, ite_eq_left, + Set.mem_ofPred_eq, Finset.mem_singleton, exists_eq_left] at hw + simp [Zsqrtd.ext_iff] at hw + omega + have common_corners (u v : Int × Int) (huv : u ≠ v) (x y : GaussianInt) + (hxu : x ∈ FootprintVertices (tileAt u)) + (hyu : y ∈ FootprintVertices (tileAt u)) + (hxv : x ∈ FootprintVertices (tileAt v)) + (hyv : y ∈ FootprintVertices (tileAt v)) : x = y ∨ step x y := by + have h1 := bounds u x hxu + have h2 := bounds u y hyu + have h3 := bounds v x hxv + have h4 := bounds v y hyv + have hne : ¬ (u.1 = v.1 ∧ u.2 = v.2) := fun h => huv (Prod.ext h.1 h.2) + clear hxu hyu hxv hyv + simp [step, Zsqrtd.ext_iff] + omega + have square_edge (k x y : GaussianInt) + (hx : x ∈ FootprintVertices (⟨{k}, k⟩ : ProtoTile)) + (hy : y ∈ FootprintVertices (⟨{k}, k⟩ : ProtoTile)) + (hstep : step x y) : + {x, y} ∈ FootprintEdges (⟨{k}, k⟩ : ProtoTile) := by + simp only [FootprintVertices, Finset.singleton_nonempty, ite_eq_left, + Set.mem_ofPred_eq, Finset.mem_singleton, exists_eq_left] at hx hy + rcases hx with rfl | rfl | rfl | rfl <;> + rcases hy with rfl | rfl | rfl | rfl + all_goals simp only [step, Zsqrtd.ext_iff, Zsqrtd.re_add, Zsqrtd.im_add, + Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one] at hstep + all_goals first | omega | simp [FootprintEdges, Finset.pair_comm, add_assoc] + have edge (z : Int × Int) (x y : GaussianInt) + (hx : x ∈ FootprintVertices (tileAt z)) + (hy : y ∈ FootprintVertices (tileAt z)) (hstep : step x y) : + {x, y} ∈ FootprintEdges (tileAt z) := by + simp only [tileAt, TileTranslation, Finset.image_singleton, + GaussianTranslation] at hx hy ⊢ + exact square_edge _ x y hx hy hstep + let witnessed := fun x y : GaussianInt => step x y ∧ + (∃ a ∈ (forward.drop 1).dropLast, {x, y} ∈ FootprintEdges (tileAt a)) ∧ + (∃ b ∈ (reverse.drop 1).dropLast, {x, y} ∈ FootprintEdges (tileAt b)) + have corridor_step (f g : AffineTriangularFace) + (hfg : AffineTriangularCorridorStep forward reverse f g) : + rho f = rho g ∨ witnessed (rho f) (rho g) := by + obtain ⟨_, u, v, huv, _, huf, hvf, hug, hvg, howners⟩ := hfg + have hxu := corner f u huf + have hyu := corner g u hug + have hxv := corner f v hvf + have hyv := corner g v hvg + rcases common_corners u v huv (rho f) (rho g) hxu hyu hxv hyv with heq | hstep + · exact Or.inl heq + · right + refine ⟨hstep, ?_⟩ + rcases howners with ⟨ha, hb⟩ | ⟨ha, hb⟩ + · exact ⟨⟨u, ha, edge u _ _ hxu hyu hstep⟩, + ⟨v, hb, edge v _ _ hxv hyv hstep⟩⟩ + · exact ⟨⟨u, ha, edge u _ _ hxu hyu hstep⟩, + ⟨u, hb, edge u _ _ hxu hyu hstep⟩⟩ + -- Compress equal corners without forgetting the final changing step's witnesses. + have compress (l : List GaussianInt) + (hl : l.IsChain (fun x y => x = y ∨ witnessed x y)) : + ∃ p : List GaussianInt, p.head? = l.head? ∧ p.getLast? = l.getLast? ∧ + (∀ x ∈ p, x ∈ l) ∧ p.IsChain witnessed := by + induction l with + | nil => exact ⟨[], rfl, rfl, by simp, .nil⟩ + | cons x l ih => + cases l with + | nil => exact ⟨[x], rfl, rfl, by simp, .singleton _⟩ + | cons y l => + have h := List.isChain_cons_cons.mp hl + obtain ⟨p, hphead, hplast, hpmem, hpchain⟩ := ih h.2 + cases p with + | nil => simp at hphead + | cons z p => + have hzy : z = y := by simpa using hphead + subst z + rcases h.1 with hxy | hxy + · subst x + refine ⟨y :: p, rfl, ?_, ?_, hpchain⟩ + · simpa using hplast + · intro a ha + exact List.mem_cons_of_mem _ (hpmem a ha) + · refine ⟨x :: y :: p, rfl, ?_, ?_, ?_⟩ + · simpa using hplast + · intro a ha + rcases List.mem_cons.mp ha with rfl | ha + · exact List.mem_cons_self + · exact List.mem_cons_of_mem _ (hpmem a ha) + · exact List.isChain_cons_cons.mpr ⟨hxy, hpchain⟩ + obtain ⟨faces, _, hfirst, hlast, hvertices, hchain⟩ := + AffineOpposingStripCorridor r s hrs hnadj forward reverse hforward hreverse + have hraw : (faces.map rho).IsChain (fun x y => x = y ∨ witnessed x y) := + (List.isChain_map rho).mpr (hchain.imp fun _ _ h => corridor_step _ _ h) + obtain ⟨p, hphead, hplast, hpmem, hpchain⟩ := compress (faces.map rho) hraw + refine ⟨p, ?_, ?_, hpchain.imp (fun _ _ h => h.1), ?_, ?_⟩ + · obtain ⟨f, hf, hfr⟩ := hfirst + refine ⟨rho f, ?_, corner f r hfr⟩ + rw [hphead, List.head?_map, hf] + rfl + · obtain ⟨f, hf, hfs⟩ := hlast + refine ⟨rho f, ?_, corner f s hfs⟩ + rw [hplast, List.getLast?_map, hf] + rfl + · intro x hx + obtain ⟨f, hf, rfl⟩ := List.mem_map.mp (hpmem x hx) + obtain ⟨⟨a, ha, haf⟩, ⟨b, hb, hbf⟩⟩ := hvertices f hf + exact ⟨⟨a, ha, corner f a haf⟩, ⟨b, hb, corner f b hbf⟩⟩ + · intro x y l₁ l₂ hp + exact (List.isChain_iff_forall_rel_of_append_cons_cons.mp hpchain hp).2 + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/UnitTriangularStep.lean b/LeanPool/ApollonianSuperharmonic/UnitTriangularStep.lean new file mode 100644 index 0000000000..1b90482faa --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/UnitTriangularStep.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.Preamble + +-- [TABLET NODE: UnitTriangularStep] + +/-! +# UnitTriangularStep + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- +There are two positive triangular completions of the unit-square lattice. +For an orientation $\epsilon\in\{\mathsf{standard},\mathsf{rotated}\}$, +write $\operatorname{UnitStep}_{\epsilon}(v)$ when +$$ + v\in + \begin{cases} + \{\pm1,\pm i,\pm(1+i)\},& + \epsilon=\mathsf{standard},\\ + \{\pm1,\pm i,\pm(-1+i)\},& + \epsilon=\mathsf{rotated}. + \end{cases} +$$ +Thus each orientation selects exactly one six-neighbor triangular graph; +the union of the two graphs is not used as a tile-string adjacency graph. +-/ +def UnitTriangularStep (orientation : Bool) (v : GaussianInt) : Prop := +-- BODY + v ∈ if orientation then + ({1, -1, ⟨0, 1⟩, -⟨0, 1⟩, + 1 + ⟨0, 1⟩, -(1 + ⟨0, 1⟩)} : Finset GaussianInt) + else + ({1, -1, ⟨0, 1⟩, -⟨0, 1⟩, + -1 + ⟨0, 1⟩, -(-1 + ⟨0, 1⟩)} : Finset GaussianInt) + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/VectorDeterminant.lean b/LeanPool/ApollonianSuperharmonic/VectorDeterminant.lean new file mode 100644 index 0000000000..2b5fde114a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/VectorDeterminant.lean @@ -0,0 +1,231 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing + +-- [TABLET NODE: VectorDeterminant] + +/-! +# VectorDeterminant + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem VectorDeterminant (q : Fin 4 → CircleCoordinates) + (hq : SemiProperQuadruple q) (hc : 0 < (q 1).1) : + star (BandVectors.1 (q 1) (q 3)) * BandVectors.1 (q 2) (q 1) + + BandVectors.1 (q 1) (q 3) * star (BandVectors.1 (q 2) (q 1)) = + (-2 * (q 1).1 : ℤ) ∧ + Int.natAbs + ((BandVectors.1 (q 3) (q 1)).re * + (BandVectors.1 (q 2) (q 1)).im - + (BandVectors.1 (q 3) (q 1)).im * + (BandVectors.1 (q 2) (q 1)).re) = + (q 1).1.natAbs := by +-- BODY + have hrec := (VectorRecursionLaws q hq).1 + have hsq13 := (VectorSquareProduct q hq 1 3 (by decide)).1 + have hsq21 := (VectorSquareProduct q hq 2 1 (by decide)).1 + have hsq32 := (VectorSquareProduct q hq 3 2 (by decide)).1 + have hnon13 := VectorNonvanishing q hq 1 3 (by decide) (Or.inl hc) + have hnon21 := VectorNonvanishing q hq 2 1 (by decide) (Or.inr hc) + have nonnegative : ∀ r : Fin 4 → CircleCoordinates, + SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 := by + intro r hr + induction hr with + | base z => intro k; fin_cases k <;> simp + | rotate hr ih => + intro k + fin_cases k + · simpa using ih 0 + · simpa using ih 2 + · simpa using ih 3 + · simpa using ih 1 + | @successor r hr ih => + intro k + have classification := BandSuccessorClassification r hr + dsimp at classification + rcases classification with special | proper + · fin_cases k + · simp [special] + · simpa using ih 0 + · simpa using ih 2 + · simpa using ih 3 + · rcases proper with ⟨_, larger0, larger2, larger3⟩ + fin_cases k + · change 0 ≤ 2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1 + exact (ih 0).trans larger0.le + · exact ih 0 + · exact ih 2 + · exact ih 3 + have hcurv := nonnegative q hq + have hnorm13sq : Zsqrtd.norm + (BandVectors.1 (q 1) (q 3) * BandVectors.1 (q 1) (q 3)) = + ((q 1).1 + (q 3).1) ^ 2 := by + rw [show BandVectors.1 (q 1) (q 3) * BandVectors.1 (q 1) (q 3) = + BandVectors.1 (q 1) (q 3) ^ 2 by ring, hsq13] + exact TangencyCoordinateIdentity q hq 1 3 (by decide) + have hnorm21sq : Zsqrtd.norm + (BandVectors.1 (q 2) (q 1) * BandVectors.1 (q 2) (q 1)) = + ((q 2).1 + (q 1).1) ^ 2 := by + rw [show BandVectors.1 (q 2) (q 1) * BandVectors.1 (q 2) (q 1) = + BandVectors.1 (q 2) (q 1) ^ 2 by ring, hsq21] + exact TangencyCoordinateIdentity q hq 2 1 (by decide) + have hnorm13 : Zsqrtd.norm (BandVectors.1 (q 1) (q 3)) = + (q 1).1 + (q 3).1 := by + have hs : (Zsqrtd.norm (BandVectors.1 (q 1) (q 3))) ^ 2 = + ((q 1).1 + (q 3).1) ^ 2 := by + simpa [pow_two, Zsqrtd.norm_mul] using hnorm13sq + nlinarith [Zsqrtd.norm_nonneg (by norm_num : (-1 : ℤ) ≤ 0) + (BandVectors.1 (q 1) (q 3)), add_nonneg hc.le (hcurv 3)] + have hnorm21 : Zsqrtd.norm (BandVectors.1 (q 2) (q 1)) = + (q 2).1 + (q 1).1 := by + have hs : (Zsqrtd.norm (BandVectors.1 (q 2) (q 1))) ^ 2 = + ((q 2).1 + (q 1).1) ^ 2 := by + simpa [pow_two, Zsqrtd.norm_mul] using hnorm21sq + nlinarith [Zsqrtd.norm_nonneg (by norm_num : (-1 : ℤ) ≤ 0) + (BandVectors.1 (q 2) (q 1)), add_nonneg (hcurv 2) hc.le] + have hnorm13mul : + BandVectors.1 (q 1) (q 3) * star (BandVectors.1 (q 1) (q 3)) = + ((q 1).1 + (q 3).1 : ℤ) := by + have identity := Zsqrtd.norm_eq_mul_conj (BandVectors.1 (q 1) (q 3)) + rw [hnorm13] at identity + exact identity.symm + have hnorm21mul : + BandVectors.1 (q 2) (q 1) * star (BandVectors.1 (q 2) (q 1)) = + ((q 2).1 + (q 1).1 : ℤ) := by + have identity := Zsqrtd.norm_eq_mul_conj (BandVectors.1 (q 2) (q 1)) + rw [hnorm21] at identity + exact identity.symm + have hmul : BandVectors.1 (q 1) (q 3) * BandVectors.1 (q 2) (q 1) ≠ 0 := mul_ne_zero hnon13 hnon21 + have hcross : + (BandVectors.1 (q 1) (q 3) * BandVectors.1 (q 2) (q 1)) * + (star (BandVectors.1 (q 1) (q 3)) * BandVectors.1 (q 2) (q 1) + + BandVectors.1 (q 1) (q 3) * star (BandVectors.1 (q 2) (q 1))) = + (-2 * (q 1).1 : ℤ) * + (BandVectors.1 (q 1) (q 3) * BandVectors.1 (q 2) (q 1)) := by + have castidentity : ((-2 * (q 1).1 : ℤ) : GaussianInt) = + (-2 : GaussianInt) * (q 1).1 := by + norm_num [Int.cast_mul] + rw [castidentity] + calc + _ = (BandVectors.1 (q 1) (q 3) * star (BandVectors.1 (q 1) (q 3))) * + BandVectors.1 (q 2) (q 1) ^ 2 + + BandVectors.1 (q 1) (q 3) ^ 2 * + (BandVectors.1 (q 2) (q 1) * star (BandVectors.1 (q 2) (q 1))) := by ring + _ = ((q 1).1 + (q 3).1) * BandVectors.1 (q 2) (q 1) ^ 2 + + BandVectors.1 (q 1) (q 3) ^ 2 * ((q 2).1 + (q 1).1) := by + rw [hnorm13mul, hnorm21mul] + norm_num + _ = (-2 * (q 1).1 : GaussianInt) * + (BandVectors.1 (q 1) (q 3) * BandVectors.1 (q 2) (q 1)) := by + have hrel : BandVectors.1 (q 3) (q 2) ^ 2 = + (BandVectors.1 (q 1) (q 3) + BandVectors.1 (q 2) (q 1)) ^ 2 := by + rw [show BandVectors.1 (q 3) (q 2) = + -(BandVectors.1 (q 1) (q 3) + BandVectors.1 (q 2) (q 1)) by + have hsum : BandVectors.1 (q 3) (q 2) + + (BandVectors.1 (q 1) (q 3) + BandVectors.1 (q 2) (q 1)) = 0 := by + simpa [add_assoc] using hrec + exact eq_neg_of_add_eq_zero_left hsum] + ring + have hcoord := hsq32 + rw [hrel] at hcoord + simp only [zsmul_eq_mul] at hcoord + calc + _ = (q 1).1 * + (BandVectors.1 (q 1) (q 3) ^ 2 + + BandVectors.1 (q 2) (q 1) ^ 2) + + (q 3).1 * BandVectors.1 (q 2) (q 1) ^ 2 + + (q 2).1 * BandVectors.1 (q 1) (q 3) ^ 2 := by ring + _ = (q 1).1 * + (BandVectors.1 (q 1) (q 3) ^ 2 + + BandVectors.1 (q 2) (q 1) ^ 2) - + (q 1).1 * ((q 2).1 * (q 3).2 - + (q 3).1 * (q 2).2) := by + rw [hsq13, hsq21] + ring + _ = (-2 * (q 1).1 : GaussianInt) * + (BandVectors.1 (q 1) (q 3) * BandVectors.1 (q 2) (q 1)) := by + rw [← hcoord] + ring_nf + constructor + · apply (mul_left_cancel₀ hmul) + simpa [mul_comm] using hcross + · have tangency : BandTangency (q 1) (q 3) := by + refine ⟨q, hq, 1, 3, by decide, rfl, rfl⟩ + have directions := (PrimitiveVectorOrientationUnique (q 1) (q 3)).2 tangency + have system := Classical.choose_spec RecursiveVectorsExistUnique + dsimp [RecursiveVectorSystem, BandVectors] at system + have hfirst : + star (BandVectors.1 (q 1) (q 3)) * BandVectors.1 (q 2) (q 1) + + BandVectors.1 (q 1) (q 3) * star (BandVectors.1 (q 2) (q 1)) = + (-2 * (q 1).1 : ℤ) := by + apply (mul_left_cancel₀ hmul) + simpa [mul_comm] using hcross + rcases directions.2 with forward | backward + · have flip := system.1.2.2.2 (q 1) (q 3) forward.1 + have flip' : BandVectors.1 (q 3) (q 1) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 1) (q 3) := by + have flipone := flip.1 + change BandVectors.1 (q 3) (q 1) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 1) (q 3) at flipone + exact flipone + have realpart := congrArg (fun z : GaussianInt => z.re) hfirst + have determinant := congrArg (fun z : GaussianInt => z.im) flip' + have determinant' := congrArg (fun z : GaussianInt => z.re) flip' + simp? at realpart determinant determinant' + rw [determinant, determinant'] + have dot : + (BandVectors.1 (q 1) (q 3)).re * (BandVectors.1 (q 2) (q 1)).re + + (BandVectors.1 (q 1) (q 3)).im * (BandVectors.1 (q 2) (q 1)).im = + -(q 1).1 := by omega + have inner : + -(BandVectors.1 (q 1) (q 3)).im * (BandVectors.1 (q 2) (q 1)).im - + (BandVectors.1 (q 1) (q 3)).re * (BandVectors.1 (q 2) (q 1)).re = + (q 1).1 := by + calc + _ = -((BandVectors.1 (q 1) (q 3)).re * (BandVectors.1 (q 2) (q 1)).re + + (BandVectors.1 (q 1) (q 3)).im * (BandVectors.1 (q 2) (q 1)).im) := by ring + _ = _ := by omega + rw [inner] + · have flip := system.1.2.2.2 (q 3) (q 1) backward.1 + have flip' : BandVectors.1 (q 1) (q 3) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 3) (q 1) := by + have flipone := flip.1 + change BandVectors.1 (q 1) (q 3) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 3) (q 1) at flipone + exact flipone + have realpart := congrArg (fun z : GaussianInt => z.re) hfirst + have determinant := congrArg (fun z : GaussianInt => z.im) flip' + have determinant' := congrArg (fun z : GaussianInt => z.re) flip' + simp? at realpart determinant determinant' + have imagpart : (BandVectors.1 (q 3) (q 1)).im = + -(BandVectors.1 (q 1) (q 3)).re := by omega + rw [← determinant, imagpart] + have inner : + (BandVectors.1 (q 1) (q 3)).im * (BandVectors.1 (q 2) (q 1)).im - + -(BandVectors.1 (q 1) (q 3)).re * (BandVectors.1 (q 2) (q 1)).re = + -(q 1).1 := by + have dot : + (BandVectors.1 (q 1) (q 3)).re * (BandVectors.1 (q 2) (q 1)).re + + (BandVectors.1 (q 1) (q 3)).im * (BandVectors.1 (q 2) (q 1)).im = + -(q 1).1 := by omega + calc + _ = (BandVectors.1 (q 1) (q 3)).re * (BandVectors.1 (q 2) (q 1)).re + + (BandVectors.1 (q 1) (q 3)).im * (BandVectors.1 (q 2) (q 1)).im := by ring + _ = _ := dot + rw [inner] + simp + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/VectorNonvanishing.lean b/LeanPool/ApollonianSuperharmonic/VectorNonvanishing.lean new file mode 100644 index 0000000000..1394e821ca --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/VectorNonvanishing.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity + +-- [TABLET NODE: VectorNonvanishing] + +/-! +# VectorNonvanishing + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem VectorNonvanishing (q : Fin 4 → CircleCoordinates) + (hq : SemiProperQuadruple q) (i j : Fin 4) (hij : i ≠ j) + (hpositive : 0 < (q i).1 ∨ 0 < (q j).1) : + BandVectors.1 (q i) (q j) ≠ 0 := by +-- BODY + have nonnegative : ∀ r : Fin 4 → CircleCoordinates, + SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 := by + intro r hr + induction hr with + | base z => + intro k + fin_cases k <;> simp + | rotate hr ih => + intro k + fin_cases k + · simpa using ih 0 + · simpa using ih 2 + · simpa using ih 3 + · simpa using ih 1 + | @successor r hr ih => + intro k + have classification := BandSuccessorClassification r hr + dsimp at classification + rcases classification with special | proper + · fin_cases k + · simp [special] + · simpa using ih 0 + · simpa using ih 2 + · simpa using ih 3 + · rcases proper with ⟨_, larger0, larger2, larger3⟩ + fin_cases k + · change 0 ≤ 2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1 + exact (ih 0).trans larger0.le + · exact ih 0 + · exact ih 2 + · exact ih 3 + have hnonneg := nonnegative q hq + have hsum : 0 < (q i).1 + (q j).1 := by + rcases hpositive with hi | hj + · exact add_pos_of_pos_of_nonneg hi (hnonneg j) + · exact add_pos_of_nonneg_of_pos (hnonneg i) hj + intro hv + have hproduct := (VectorSquareProduct q hq i j hij).1 + have hzero : (q j).1 • (q i).2 - (q i).1 • (q j).2 = 0 := by + rw [← hproduct, hv] + simp + have hnorm : Zsqrtd.norm ((q j).1 • (q i).2 - (q i).1 • (q j).2) = 0 := by + rw [hzero] + simp + have hsquare : ((q i).1 + (q j).1) ^ 2 = 0 := by + rw [← TangencyCoordinateIdentity q hq i j hij] + exact hnorm + nlinarith + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/VectorRecursionLaws.lean b/LeanPool/ApollonianSuperharmonic/VectorRecursionLaws.lean new file mode 100644 index 0000000000..adbb64e5cc --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/VectorRecursionLaws.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorsExistUnique + +-- [TABLET NODE: VectorRecursionLaws] + +/-! +# VectorRecursionLaws + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem VectorRecursionLaws (q : Fin 4 → CircleCoordinates) + (hq : SemiProperQuadruple q) : + BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 1) (q 3) + + BandVectors.1 (q 2) (q 1) = 0 ∧ + BandVectors.2 (q 3) (q 2) + BandVectors.2 (q 1) (q 3) + + BandVectors.2 (q 2) (q 1) = 0 ∧ + BandVectors.1 (q 1) (q 0) = + BandVectors.1 (q 1) (q 3) - + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 2) (q 1) ∧ + BandVectors.2 (q 1) (q 0) = + BandVectors.2 (q 1) (q 3) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 2) (q 1) ∧ + (ProperBandQuadruple q → + ∀ j : Fin 3, + BandVectors.1 (q 0) (q j.succ) = + (⟨0, 1⟩ : GaussianInt) * + BandVectors.1 (q j.succ) (q 0) ∧ + BandVectors.2 (q 0) (q j.succ) = + -(⟨0, 1⟩ : GaussianInt) * + BandVectors.2 (q j.succ) (q 0)) := by +-- BODY + have systemLaw : RecursiveVectorSystem BandVectors := + by simpa [BandVectors] using (Classical.choose_spec RecursiveVectorsExistUnique).1 + rcases systemLaw with ⟨zeroLaw, baseLaw, stepLaw, flipLaw⟩ + induction hq with + | base z => + have baseFacts := baseLaw z + simp? at baseFacts + rcases baseFacts with ⟨v32, v21, v13, a32, a21, a13⟩ + have rotatedFacts := stepLaw (![(1, 1 + 2 * z), + (0, -1), (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)), (0, 1)]) + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate (SemiProperQuadruple.base z))) + rcases rotatedFacts with ⟨rv, ra, rv2, ra2⟩ + constructor + · simp [v32, v21, v13] + constructor + · simp [a32, a21, a13] + ring + constructor + · simpa using rv + constructor + · simpa using rv2 + intro proper j + exact ⟨flipLaw _ _ (PrimitiveVectorOrientation.parentChild proper j) |>.1, + flipLaw _ _ (PrimitiveVectorOrientation.parentChild proper j) |>.2⟩ + | rotate hq ih => + have rotatedFacts := stepLaw _ hq + rcases rotatedFacts with ⟨rv, ra, rv2, ra2⟩ + rcases ih with ⟨iv, ia, isv, isa, iproper⟩ + constructor + · simpa [add_assoc, add_left_comm, add_comm] using iv + constructor + · simpa [add_assoc, add_left_comm, add_comm] using ia + constructor + · simpa using rv + constructor + · simpa using rv2 + intro proper j + exact ⟨flipLaw _ _ (PrimitiveVectorOrientation.parentChild proper j) |>.1, + flipLaw _ _ (PrimitiveVectorOrientation.parentChild proper j) |>.2⟩ + | @successor predecessor hq ih => + have directFacts := stepLaw predecessor hq + rcases directFacts with ⟨directV, directW, directA, directB⟩ + rcases ih with ⟨oldV, oldA, oldW, oldB, oldFlip⟩ + dsimp + constructor + · rw [directW, directV] + rw [← oldV] + ring + constructor + · rw [directB, directA] + rw [← oldA] + ring + have rotatedFacts := stepLaw _ + (SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate (SemiProperQuadruple.successor hq))) + rcases rotatedFacts with ⟨rotatedV, rotatedW, rotatedA, rotatedB⟩ + constructor + · simpa using rotatedV + constructor + · simpa using rotatedA + intro proper j + exact ⟨flipLaw _ _ (PrimitiveVectorOrientation.parentChild proper j) |>.1, + flipLaw _ _ (PrimitiveVectorOrientation.parentChild proper j) |>.2⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/VectorSquareProduct.lean b/LeanPool/ApollonianSuperharmonic/VectorSquareProduct.lean new file mode 100644 index 0000000000..69b045b3b7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/VectorSquareProduct.lean @@ -0,0 +1,759 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorsExistUnique +public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.LinearCombination +public import Mathlib.Tactic.Ring + +-- [TABLET NODE: VectorSquareProduct] + +/-! +# VectorSquareProduct + +Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace VectorSquareProof + +private theorem ii_sq : + let ii : GaussianInt := ⟨0, 1⟩ + ii^2 = -1 := by + classical + intro ii + decide +kernel + +private theorem ii_cube : + let ii : GaussianInt := ⟨0, 1⟩ + ii^3 = -ii := by + classical + intro ii + decide +kernel + +private theorem system : + RecursiveVectorSystem BandVectors := by + classical + simpa [BandVectors] using (Classical.choose_spec RecursiveVectorsExistUnique).1 + +private theorem reverse : + let ii : GaussianInt := ⟨0, 1⟩ + (ii^2 = -1) → ( + let v := BandVectors.1 + let a := BandVectors.2 + let E (C D : CircleCoordinates) : Prop := + v C D ^ 2 = (D.1 : GaussianInt) * C.2 - (C.1 : GaussianInt) * D.2 ∧ + 2 * v C D * a C D = C.2 + D.2 + (∀ (C : CircleCoordinates), ∀ (D : CircleCoordinates), PrimitiveVectorOrientation C D → + BandVectors.1 D C = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 C D ∧ BandVectors.2 D C = -⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.2 C D) → (∀ (C : CircleCoordinates), ∀ (D : + CircleCoordinates), (PrimitiveVectorOrientation C D) → ((E C D) → (E D C)))) := by + classical + intro ii ii_sq v a E flipLaw C D ho h + rcases flipLaw C D ho with ⟨hv, ha⟩ + change v D C = ii * v C D at hv + change a D C = -ii * a C D at ha + rcases h with ⟨hs, hp⟩ + constructor + · rw [hv] + calc + (ii * v C D)^2 = -(v C D ^ 2) := by + ring_nf; simp only [ii_sq]; ring + _ = _ := by rw [hs]; ring + · rw [hv, ha] + calc + 2 * (ii * v C D) * (-ii * a C D) = 2 * v C D * a C D := by + ring_nf; simp only [ii_sq]; ring + _ = D.2 + C.2 := by rw [hp]; ring + +private theorem rootValues : + let ii : GaussianInt := ⟨0, 1⟩ + (ii^2 = -1) → ( + let v := BandVectors.1 + let a := BandVectors.2 + let B (z : GaussianInt) : Fin 4 → CircleCoordinates := + ![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ii), (0, 1), (0, -1)] + (∀ (z : GaussianInt), have q := ![((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z), ((1 : + ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩), + ((0 : ℤ), (1 : GaussianInt)), ((0 : ℤ), (-1 : GaussianInt))]; BandVectors.1 (q (3 : Fin + (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (2 : Fin (4 : ℕ))) + (q (1 : Fin (4 : ℕ))) = (-1 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : + Fin (4 : ℕ))) = (1 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : + ℕ))) = (1 : GaussianInt) ∧ BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = + (-1 : GaussianInt) - z - ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : + Fin (4 : ℕ))) = z + ⟨(0 : ℤ), (1 : ℤ)⟩) → ((∀ (C : CircleCoordinates), ∀ (D : + CircleCoordinates), PrimitiveVectorOrientation C D → BandVectors.1 D C = ⟨(0 : ℤ), (1 : + ℤ)⟩ * BandVectors.1 C D ∧ BandVectors.2 D C = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 C D) → + (∀ (z : GaussianInt), (v (B z 3) (B z 2) = 0 ∧ a (B z 3) (B z 2) = 1) ∧ + (v (B z 2) (B z 1) = -1 ∧ a (B z 2) (B z 1) = -1-z-ii) ∧ + (v (B z 3) (B z 1) = -ii ∧ a (B z 3) (B z 1) = ii*z-1) ∧ + (v (B z 1) (B z 0) = 1+ii ∧ a (B z 1) (B z 0) = 1+z-ii*z) ∧ + (v (B z 2) (B z 0) = -1 ∧ a (B z 2) (B z 0) = -1-z) ∧ + (v (B z 3) (B z 0) = -ii ∧ a (B z 3) (B z 0) = ii*z)))) := by + classical + intro ii ii_sq v a B baseLaw flipLaw z + have facts := baseLaw z + change v (B z 3) (B z 2) = 0 ∧ v (B z 2) (B z 1) = -1 ∧ + v (B z 1) (B z 3) = 1 ∧ a (B z 3) (B z 2) = 1 ∧ + a (B z 2) (B z 1) = -1-z-ii ∧ a (B z 1) (B z 3) = z+ii at facts + rcases facts with ⟨v32, v21, v13, a32, a21, a13⟩ + have f31 := flipLaw _ _ (PrimitiveVectorOrientation.base31 z) + change v (B z 1) (B z 3) = ii * v (B z 3) (B z 1) ∧ + a (B z 1) (B z 3) = -ii * a (B z 3) (B z 1) at f31 + have v31 : v (B z 3) (B z 1) = -ii := by + calc + _ = -ii * (ii * v (B z 3) (B z 1)) := by + ring_nf; simp only [ii_sq]; ring + _ = -ii := by rw [← f31.1, v13]; ring + have a31 : a (B z 3) (B z 1) = ii*z-1 := by + calc + _ = ii * (-ii * a (B z 3) (B z 1)) := by + ring_nf; simp only [ii_sq]; ring + _ = ii*z-1 := by + rw [← f31.2, a13] + ring_nf; simp only [ii_sq]; ring + have laws := VectorRecursionLaws (B z) (SemiProperQuadruple.base z) + have v10 : v (B z 1) (B z 0) = 1+ii := by + have h : v (B z 1) (B z 0) = v (B z 1) (B z 3) - ii*v (B z 2) (B z 1) := + laws.2.2.1 + rw [h, v13, v21] + ring + have a10 : a (B z 1) (B z 0) = 1+z-ii*z := by + have h : a (B z 1) (B z 0) = a (B z 1) (B z 3) + ii*a (B z 2) (B z 1) := + laws.2.2.2.1 + rw [h, a13, a21] + ring_nf; simp only [ii_sq]; ring + have shift : 1 + 2 * (z-ii) + 2*ii = 1+2*z := by ring + have shifted := baseLaw (z-ii) + change v (0,-1) (0,1) = 0 ∧ v (0,1) (1,1+2*(z-ii)+2*ii) = -1 ∧ + v (1,1+2*(z-ii)+2*ii) (0,-1) = 1 ∧ a (0,-1) (0,1) = 1 ∧ + a (0,1) (1,1+2*(z-ii)+2*ii) = -1-(z-ii)-ii ∧ + a (1,1+2*(z-ii)+2*ii) (0,-1) = z-ii+ii at shifted + rw [shift] at shifted + have v20 : v (B z 2) (B z 0) = -1 := shifted.2.1 + have a20 : a (B z 2) (B z 0) = -1-z := by + have h : a (B z 2) (B z 0) = -1-(z-ii)-ii := shifted.2.2.2.2.1 + rw [h] + ring + have f30 := flipLaw _ _ (PrimitiveVectorOrientation.base31 (z-ii)) + change v (1,1+2*(z-ii)+2*ii) (0,-1) = ii*v (0,-1) (1,1+2*(z-ii)+2*ii) ∧ + a (1,1+2*(z-ii)+2*ii) (0,-1) = -ii*a (0,-1) (1,1+2*(z-ii)+2*ii) at f30 + rw [shift] at f30 + change v (B z 0) (B z 3) = ii*v (B z 3) (B z 0) ∧ + a (B z 0) (B z 3) = -ii*a (B z 3) (B z 0) at f30 + have v03 : v (B z 0) (B z 3) = 1 := shifted.2.2.1 + have a03 : a (B z 0) (B z 3) = z-ii+ii := shifted.2.2.2.2.2 + have v30 : v (B z 3) (B z 0) = -ii := by + calc + _ = -ii * (ii * v (B z 3) (B z 0)) := by + ring_nf; simp only [ii_sq]; ring + _ = -ii := by rw [← f30.1, v03]; ring + have a30 : a (B z 3) (B z 0) = ii*z := by + calc + _ = ii * (-ii * a (B z 3) (B z 0)) := by + ring_nf; simp only [ii_sq]; ring + _ = ii*z := by rw [← f30.2, a03]; ring + exact ⟨⟨v32, a32⟩, ⟨v21, a21⟩, ⟨v31, a31⟩, ⟨v10, a10⟩, + ⟨v20, a20⟩, ⟨v30, a30⟩⟩ + +private theorem root : + let ii : GaussianInt := ⟨0, 1⟩ + (ii^2 = -1) → ( + let v := BandVectors.1 + let a := BandVectors.2 + let E (C D : CircleCoordinates) : Prop := + v C D ^ 2 = (D.1 : GaussianInt) * C.2 - (C.1 : GaussianInt) * D.2 ∧ + 2 * v C D * a C D = C.2 + D.2 + let B (z : GaussianInt) : Fin 4 → CircleCoordinates := + ![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ii), (0, 1), (0, -1)] + (∀ (C : CircleCoordinates), ∀ (D : CircleCoordinates), (PrimitiveVectorOrientation C D) → ((E + C D) → (E D C))) → ((∀ (z : GaussianInt), (v (B z 3) (B z 2) = 0 ∧ a (B z 3) (B z 2) = 1) + ∧ (v (B z 2) (B z 1) = -1 ∧ a (B z 2) (B z 1) = -1-z-ii) ∧ (v (B z 3) (B z 1) = -ii ∧ a + (B z 3) (B z 1) = ii*z-1) ∧ (v (B z 1) (B z 0) = 1+ii ∧ a (B z 1) (B z 0) = 1+z-ii*z) ∧ + (v (B z 2) (B z 0) = -1 ∧ a (B z 2) (B z 0) = -1-z) ∧ (v (B z 3) (B z 0) = -ii ∧ a (B z + 3) (B z 0) = ii*z)) → (∀ (z : GaussianInt), ∀ i j : Fin 4, i ≠ j → E (B z i) (B z j)))) + := by + classical + intro ii ii_sq v a E B reverse rootValues z + rcases rootValues z with ⟨⟨v32,a32⟩,⟨v21,a21⟩,⟨v31,a31⟩, + ⟨v10,a10⟩,⟨v20,a20⟩,⟨v30,a30⟩⟩ + have e32 : E (B z 3) (B z 2) := by + dsimp only [E]; rw [v32,a32]; simp [B] + have e21 : E (B z 2) (B z 1) := by + dsimp only [E]; rw [v21,a21] + constructor <;> simp [B]; ring_nf + have e31 : E (B z 3) (B z 1) := by + dsimp only [E]; rw [v31,a31] + constructor <;> simp [B] <;> ring_nf <;> simp only [ii_sq]; ring + have e10 : E (B z 1) (B z 0) := by + dsimp only [E]; rw [v10,a10] + constructor <;> simp [B] <;> ring_nf <;> simp only [ii_sq] <;> ring + have e20 : E (B z 2) (B z 0) := by + dsimp only [E]; rw [v20,a20] + constructor <;> simp [B]; ring_nf + have e30 : E (B z 3) (B z 0) := by + dsimp only [E]; rw [v30,a30] + constructor <;> simp [B] <;> ring_nf <;> simp only [ii_sq]; ring + have e23 := reverse _ _ (PrimitiveVectorOrientation.base32 z) e32 + have e12 := reverse _ _ (PrimitiveVectorOrientation.base21 z) e21 + have e13 := reverse _ _ (PrimitiveVectorOrientation.base31 z) e31 + have e01 := reverse _ _ (PrimitiveVectorOrientation.base10 z) e10 + have shift : 1+2*(z-ii)+2*ii = 1+2*z := by ring + have o20 : PrimitiveVectorOrientation (B z 2) (B z 0) := by + have h := PrimitiveVectorOrientation.base21 (z-ii) + change PrimitiveVectorOrientation (0,1) (1,1+2*(z-ii)+2*ii) at h + rw [shift] at h + exact h + have o30 : PrimitiveVectorOrientation (B z 3) (B z 0) := by + have h := PrimitiveVectorOrientation.base31 (z-ii) + change PrimitiveVectorOrientation (0,-1) (1,1+2*(z-ii)+2*ii) at h + rw [shift] at h + exact h + have e02 := reverse _ _ o20 e20 + have e03 := reverse _ _ o30 e30 + intro i j hij + fin_cases i <;> fin_cases j + · exact (hij rfl).elim + · exact e01 + · exact e02 + · exact e03 + · exact e10 + · exact (hij rfl).elim + · exact e12 + · exact e13 + · exact e20 + · exact e21 + · exact (hij rfl).elim + · exact e23 + · exact e30 + · exact e31 + · exact e32 + · exact (hij rfl).elim + +private theorem rotateEdges : + let v := BandVectors.1 + let a := BandVectors.2 + let E (C D : CircleCoordinates) : Prop := + v C D ^ 2 = (D.1 : GaussianInt) * C.2 - (C.1 : GaussianInt) * D.2 ∧ + 2 * v C D * a C D = C.2 + D.2 + let R (p : Fin 4 → CircleCoordinates) : Fin 4 → CircleCoordinates := + ![p 0, p 2, p 3, p 1] + ∀ (p : Fin 4 → CircleCoordinates), (∀ i j : Fin 4, i ≠ j → E (p i) (p j)) → (∀ i j : Fin 4, i + ≠ j → E (R p i) (R p j)) := by + classical + intro v a E R p ih + let f : Fin 4 → Fin 4 := ![0,2,3,1] + have hf : Function.Injective f := by decide +kernel + have he (k : Fin 4) : R p k = p (f k) := by fin_cases k <;> rfl + intro i j hij + rw [he i,he j] + exact ih (f i) (f j) (fun h => hij (hf h)) + +private theorem assemble : + let v := BandVectors.1 + let a := BandVectors.2 + let E (C D : CircleCoordinates) : Prop := + v C D ^ 2 = (D.1 : GaussianInt) * C.2 - (C.1 : GaussianInt) * D.2 ∧ + 2 * v C D * a C D = C.2 + D.2 + let S (p : Fin 4 → CircleCoordinates) : Fin 4 → CircleCoordinates := + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] + (∀ (C : CircleCoordinates), ∀ (D : CircleCoordinates), (PrimitiveVectorOrientation C D) → ((E + C D) → (E D C))) → (∀ (p : Fin 4 → CircleCoordinates), (∀ i j : Fin 4, i ≠ j → E (p i) (p + j)) → ((ProperBandQuadruple (S p)) → ((E (p 0) (S p 0)) → ((E (p 2) (S p 0)) → ((E (p 3) + (S p 0)) → (∀ i j : Fin 4, i ≠ j → E (S p i) (S p j))))))) := by + classical + intro v a E S reverse p ih hs e10 e20 e30 + let f : Fin 3 → Fin 4 := ![0,2,3] + have hf : Function.Injective f := by decide +kernel + have he (k : Fin 3) : S p k.succ = p (f k) := by fin_cases k <;> rfl + have child (k : Fin 3) : E (S p k.succ) (S p 0) := by + fin_cases k + · exact e10 + · exact e20 + · exact e30 + have flipped (k : Fin 3) : E (S p 0) (S p k.succ) := + reverse _ _ (PrimitiveVectorOrientation.parentChild hs k) (child k) + intro i j hij + cases i using Fin.cases with + | zero => + cases j using Fin.cases with + | zero => exact (hij rfl).elim + | succ l => exact flipped l + | succ k => + cases j using Fin.cases with + | zero => exact child k + | succ l => + rw [he k,he l] + exact ih (f k) (f l) (fun h => hij (congrArg Fin.succ (hf h))) + +private theorem properStep : + let ii : GaussianInt := ⟨0, 1⟩ + (ii^2 = -1) → ((ii^3 = -ii) → ( + let v := BandVectors.1 + let a := BandVectors.2 + let E (C D : CircleCoordinates) : Prop := + v C D ^ 2 = (D.1 : GaussianInt) * C.2 - (C.1 : GaussianInt) * D.2 ∧ + 2 * v C D * a C D = C.2 + D.2 + let S (p : Fin 4 → CircleCoordinates) : Fin 4 → CircleCoordinates := + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] + (∀ (p : Fin 4 → CircleCoordinates), (∀ i j : Fin 4, i ≠ j → E (p i) (p j)) → + ((ProperBandQuadruple (S p)) → ((E (p 0) (S p 0)) → ((E (p 2) (S p 0)) → ((E (p 3) (S p + 0)) → (∀ i j : Fin 4, i ≠ j → E (S p i) (S p j))))))) → (∀ (p : Fin 4 → + CircleCoordinates), (ProperBandQuadruple p) → ((∀ i j : Fin 4, i ≠ j → E (p i) (p j)) → + (∀ i j : Fin 4, i ≠ j → E (S p i) (S p j)))))) := by + classical + intro ii ii_sq ii_cube v a E S assemble p hp ih + let R (p : Fin 4 → CircleCoordinates) : Fin 4 → CircleCoordinates := + ![p 0, p 2, p 3, p 1] + have hs : ProperBandQuadruple (S p) := by + rcases BandSuccessorClassification p hp.1 with bad | good + · have nonneg := (SemiProperForestClassification p hp.1).1 + have h01 : (p 1).1 < (p 0).1 := hp.2 0 + have n1 := nonneg 1 + have n2 := nonneg 2 + have n3 := nonneg 3 + change 2*(p 0).1 + 2*(p 2).1 + 2*(p 3).1 - (p 1).1 = 1 at bad + omega + · exact good.1 + let x := v (p 0) (p 3) + let y := v (p 2) (p 0) + let t := v (p 3) (p 2) + let alpha := a (p 0) (p 3) + let beta := a (p 2) (p 0) + let gamma := a (p 3) (p 2) + rcases VectorRecursionLaws (S p) hs.1 with ⟨sumv,suma,new1v,new1a,_⟩ + change t+x+y = 0 at sumv + change gamma+alpha+beta = 0 at suma + change v (p 0) (S p 0) = x-ii*y at new1v + change a (p 0) (S p 0) = alpha+ii*beta at new1a + have tr : t = -x-y := by linear_combination sumv + have gr : gamma = -alpha-beta := by linear_combination suma + have pred := VectorRecursionLaws p hp.1 + have predV := pred.2.2.1 + have predA := pred.2.2.2.1 + change v (p 1) (p 0) = v (p 1) (p 3)-ii*v (p 2) (p 1) at predV + change a (p 1) (p 0) = a (p 1) (p 3)+ii*a (p 2) (p 1) at predA + have f14 := pred.2.2.2.2 hp 0 + have f12 := pred.2.2.2.2 hp 1 + have f13 := pred.2.2.2.2 hp 2 + change v (p 0) (p 1) = ii*v (p 1) (p 0) ∧ + a (p 0) (p 1) = -ii*a (p 1) (p 0) at f14 + change v (p 0) (p 2) = ii*v (p 2) (p 0) ∧ + a (p 0) (p 2) = -ii*a (p 2) (p 0) at f12 + change v (p 0) (p 3) = ii*v (p 3) (p 0) ∧ + a (p 0) (p 3) = -ii*a (p 3) (p 0) at f13 + have rot1 := VectorRecursionLaws (R p) (SemiProperQuadruple.rotate hp.1) + have rot2 := VectorRecursionLaws (R (R p)) + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hp.1)) + have rot2v : v (p 3) (p 0) = t-ii*v (p 1) (p 3) := rot2.2.2.1 + have rot2a : a (p 3) (p 0) = gamma+ii*a (p 1) (p 3) := rot2.2.2.2.1 + have h24v : v (p 2) (p 1) = y+ii*t := by + have h := rot1.2.2.1 + change y = v (p 2) (p 1)-ii*t at h + linear_combination -h + have h24a : a (p 2) (p 1) = beta-ii*gamma := by + have h := rot1.2.2.2.1 + change beta = a (p 2) (p 1)+ii*gamma at h + linear_combination -h + have h43v : v (p 1) (p 3) = x-ii*t := by + have h : x = ii*t + v (p 1) (p 3) := by + change v (p 0) (p 3) = _ + rw [f13.1, rot2v] + ring_nf; simp only [ii_sq]; ring + linear_combination -h + have h43a : a (p 1) (p 3) = alpha+ii*gamma := by + have h : alpha = -ii*gamma + a (p 1) (p 3) := by + change a (p 0) (p 3) = _ + rw [f13.2, rot2a] + ring_nf; simp only [ii_sq]; ring + linear_combination -h + -- Both complementary values have the minus sign from equation (12). + have h14v : v (p 0) (p 1) = -(x+ii*y) := by + rw [f14.1,predV,h43v,h24v,tr] + ring_nf; simp only [ii_sq,ii_cube]; ring + have h14a : a (p 0) (p 1) = -(alpha-ii*beta) := by + rw [f14.2,predA,h43a,h24a,gr] + ring_nf; simp only [ii_sq,ii_cube]; ring + have h12v : v (p 0) (p 2) = ii*y := f12.1 + have h12a : a (p 0) (p 2) = -ii*beta := f12.2 + have new2 := VectorRecursionLaws (R (S p)) + (SemiProperQuadruple.rotate hs.1) + have new3 := VectorRecursionLaws (R (R (S p))) + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hs.1)) + have new2v : v (p 2) (S p 0) = y-ii*t := new2.2.2.1 + have new2a : a (p 2) (S p 0) = beta+ii*gamma := new2.2.2.2.1 + have new3v : v (p 3) (S p 0) = t-ii*x := new3.2.2.1 + have new3a : a (p 3) (S p 0) = gamma+ii*alpha := new3.2.2.2.1 + rcases ih 0 3 (by decide) with ⟨hx,hax⟩ + rcases ih 2 0 (by decide) with ⟨hy,hay⟩ + rcases ih 3 2 (by decide) with ⟨ht,hat⟩ + change x^2 = _ at hx + change y^2 = _ at hy + change t^2 = _ at ht + change 2*x*alpha = _ at hax + change 2*y*beta = _ at hay + change 2*t*gamma = _ at hat + have e10 : E (p 0) (S p 0) := by + constructor + · calc + _ = 2*x^2 + 2*v (p 0) (p 2)^2 - v (p 0) (p 1)^2 := by + rw [new1v,h12v,h14v] + ring_nf + _ = _ := by + rw [hx,(ih 0 2 (by decide)).1,(ih 0 1 (by decide)).1] + dsimp [S] + simp only [Int.cast_sub,Int.cast_add,Int.cast_mul,Int.cast_ofNat] + ring + · calc + _ = 2*(2*x*alpha) + 2*(2*v (p 0) (p 2)*a (p 0) (p 2)) - + 2*v (p 0) (p 1)*a (p 0) (p 1) := by + rw [new1v,new1a,h12v,h12a,h14v,h14a] + ring_nf + _ = _ := by + rw [hax,(ih 0 2 (by decide)).2,(ih 0 1 (by decide)).2] + dsimp [S] + ring + have e20 : E (p 2) (S p 0) := by + constructor + · calc + _ = 2*y^2 - 2*t^2 - v (p 2) (p 1)^2 := by + rw [new2v,h24v] + ring_nf; simp only [ii_sq]; ring + _ = _ := by + rw [hy,ht,(ih 2 1 (by decide)).1] + dsimp [S] + simp only [Int.cast_sub,Int.cast_add,Int.cast_mul,Int.cast_ofNat] + ring + · calc + _ = 2*(2*y*beta) + 2*(2*t*gamma) - + 2*v (p 2) (p 1)*a (p 2) (p 1) := by + rw [new2v,new2a,h24v,h24a] + ring_nf; simp only [ii_sq]; ring + _ = _ := by + rw [hay,hat,(ih 2 1 (by decide)).2] + dsimp [S] + ring + have e30 : E (p 3) (S p 0) := by + constructor + · calc + _ = 2*t^2 - 2*x^2 + v (p 1) (p 3)^2 := by + rw [new3v,h43v] + ring_nf; simp only [ii_sq]; ring + _ = _ := by + rw [ht,hx,(ih 1 3 (by decide)).1] + dsimp [S] + simp only [Int.cast_sub,Int.cast_add,Int.cast_mul,Int.cast_ofNat] + ring + · calc + _ = 2*(2*t*gamma) + 2*(2*x*alpha) - + 2*v (p 1) (p 3)*a (p 1) (p 3) := by + rw [new3v,new3a,h43v,h43a] + ring_nf; simp only [ii_sq]; ring + _ = _ := by + rw [hat,hax,(ih 1 3 (by decide)).2] + dsimp [S] + ring + exact assemble p ih hs e10 e20 e30 + +private theorem rootStep : + let ii : GaussianInt := ⟨0, 1⟩ + (ii^2 = -1) → ((ii^3 = -ii) → ( + let v := BandVectors.1 + let a := BandVectors.2 + let E (C D : CircleCoordinates) : Prop := + v C D ^ 2 = (D.1 : GaussianInt) * C.2 - (C.1 : GaussianInt) * D.2 ∧ + 2 * v C D * a C D = C.2 + D.2 + let B (z : GaussianInt) : Fin 4 → CircleCoordinates := + ![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ii), (0, 1), (0, -1)] + let R (p : Fin 4 → CircleCoordinates) : Fin 4 → CircleCoordinates := + ![p 0, p 2, p 3, p 1] + let S (p : Fin 4 → CircleCoordinates) : Fin 4 → CircleCoordinates := + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] + (∀ (C : CircleCoordinates), ∀ (D : CircleCoordinates), PrimitiveVectorOrientation C D → + BandVectors.1 D C = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 C D ∧ BandVectors.2 D C = -⟨(0 : + ℤ), (1 : ℤ)⟩ * BandVectors.2 C D) → ((∀ (z : GaussianInt), (v (B z 3) (B z 2) = 0 ∧ a (B + z 3) (B z 2) = 1) ∧ (v (B z 2) (B z 1) = -1 ∧ a (B z 2) (B z 1) = -1-z-ii) ∧ (v (B z 3) + (B z 1) = -ii ∧ a (B z 3) (B z 1) = ii*z-1) ∧ (v (B z 1) (B z 0) = 1+ii ∧ a (B z 1) (B z + 0) = 1+z-ii*z) ∧ (v (B z 2) (B z 0) = -1 ∧ a (B z 2) (B z 0) = -1-z) ∧ (v (B z 3) (B z 0) + = -ii ∧ a (B z 3) (B z 0) = ii*z)) → ((∀ (z : GaussianInt), ∀ i j : Fin 4, i ≠ j → E (B z + i) (B z j)) → ((∀ (p : Fin 4 → CircleCoordinates), (∀ i j : Fin 4, i ≠ j → E (p i) (p j)) + → (∀ i j : Fin 4, i ≠ j → E (R p i) (R p j))) → ((∀ (p : Fin 4 → CircleCoordinates), (∀ i + j : Fin 4, i ≠ j → E (p i) (p j)) → ((ProperBandQuadruple (S p)) → ((E (p 0) (S p 0)) → + ((E (p 2) (S p 0)) → ((E (p 3) (S p 0)) → (∀ i j : Fin 4, i ≠ j → E (S p i) (S p j))))))) + → (∀ (z : GaussianInt), ∀ (k : Fin 3), ∀ i j : Fin 4, i ≠ j → + E (S (if k = 0 then B z else if k = 1 then R (B z) else R (R (B z))) i) + (S (if k = 0 then B z else if k = 1 then R (B z) else R (R (B z))) j)))))))) := by + classical + intro ii ii_sq ii_cube v a E B R S flipLaw rootValues root rotateEdges assemble z k + rcases rootValues z with ⟨⟨v32,a32⟩,⟨v21,a21⟩,⟨v31,a31⟩, + ⟨v10,a10⟩,⟨v20,a20⟩,⟨v30,a30⟩⟩ + have f01 : v (B z 0) (B z 1) = ii*v (B z 1) (B z 0) ∧ + a (B z 0) (B z 1) = -ii*a (B z 1) (B z 0) := + flipLaw _ _ (PrimitiveVectorOrientation.base10 z) + have f13 : v (B z 1) (B z 3) = ii*v (B z 3) (B z 1) ∧ + a (B z 1) (B z 3) = -ii*a (B z 3) (B z 1) := + flipLaw _ _ (PrimitiveVectorOrientation.base31 z) + have o20 : PrimitiveVectorOrientation (B z 2) (B z 0) := by + have h := PrimitiveVectorOrientation.base21 (z-ii) + have shift : 1+2*(z-ii)+2*ii = 1+2*z := by ring + change PrimitiveVectorOrientation (0,1) (1,1+2*(z-ii)+2*ii) at h + rw [shift] at h + exact h + have f02 : v (B z 0) (B z 2) = ii*v (B z 2) (B z 0) ∧ + a (B z 0) (B z 2) = -ii*a (B z 2) (B z 0) := flipLaw _ _ o20 + fin_cases k + · change ∀ i j : Fin 4, i ≠ j → E (S (B z) i) (S (B z) j) + have shift : S (B z) = B (z-ii) := by + funext l + fin_cases l <;> simp [S,B] <;> ring + rw [shift] + exact root (z-ii) + · change ∀ i j : Fin 4, i ≠ j → E (S (R (B z)) i) (S (R (B z)) j) + let Q : Fin 4 → CircleCoordinates := + ![(4,1+8*z+4*ii), B z 0, B z 3, B z 1] + have he : S (R (B z)) = Q := by + funext l + fin_cases l <;> simp [S,R,B,Q]; ring + rw [he] + have hr : SemiProperQuadruple (R (B z)) := + SemiProperQuadruple.rotate (SemiProperQuadruple.base z) + have hs : ProperBandQuadruple (Q) := by + rcases BandSuccessorClassification (R (B z)) hr with bad | good + · simp [R,B] at bad + · have h : ProperBandQuadruple (S (R (B z))) := good.1 + rw [he] at h + exact h + have laws1 := VectorRecursionLaws (Q) hs.1 + have laws2 := VectorRecursionLaws (R (Q)) + (SemiProperQuadruple.rotate hs.1) + have laws3 := VectorRecursionLaws (R (R (Q))) + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hs.1)) + have nv1 : v (B z 0) (Q 0) = + v (B z 0) (B z 1)-ii*v (B z 3) (B z 0) := laws1.2.2.1 + have na1 : a (B z 0) (Q 0) = + a (B z 0) (B z 1)+ii*a (B z 3) (B z 0) := laws1.2.2.2.1 + have nv2 : v (B z 3) (Q 0) = + v (B z 3) (B z 0)-ii*v (B z 1) (B z 3) := laws2.2.2.1 + have na2 : a (B z 3) (Q 0) = + a (B z 3) (B z 0)+ii*a (B z 1) (B z 3) := laws2.2.2.2.1 + have nv3 : v (B z 1) (Q 0) = + v (B z 1) (B z 3)-ii*v (B z 0) (B z 1) := laws3.2.2.1 + have na3 : a (B z 1) (Q 0) = + a (B z 1) (B z 3)+ii*a (B z 0) (B z 1) := laws3.2.2.2.1 + have dv1 : v (B z 0) (Q 0) = -2+ii := by + rw [nv1,f01.1,v10,v30] + ring_nf; simp only [ii_sq]; ring + have da1 : a (B z 0) (Q 0) = -2*z-ii-ii*z := by + rw [na1,f01.2,a10,a30] + ring_nf; simp only [ii_sq]; ring + have dv2 : v (B z 3) (Q 0) = -2*ii := by + rw [nv2,f13.1,v31,v30] + ring_nf; simp only [ii_cube]; ring + have da2 : a (B z 3) (Q 0) = 2*ii*z-1 := by + rw [na2,f13.2,a31,a30] + ring_nf; simp only [ii_sq,ii_cube]; ring + have dv3 : v (B z 1) (Q 0) = 2+ii := by + rw [nv3,f13.1,f01.1,v31,v10] + ring_nf; simp only [ii_sq,ii_cube]; ring + have da3 : a (B z 1) (Q 0) = 1+2*z+ii-ii*z := by + rw [na3,f13.2,f01.2,a31,a10] + ring_nf; simp only [ii_sq,ii_cube]; ring + have e10 : E (B z 0) (Q 0) := by + dsimp only [E]; rw [dv1,da1] + constructor <;> simp [Q,B] <;> ring_nf <;> simp only [ii_sq] <;> ring + have e20 : E (B z 3) (Q 0) := by + dsimp only [E]; rw [dv2,da2] + constructor <;> simp [Q,B] <;> ring_nf <;> simp only [ii_sq] <;> ring + have e30 : E (B z 1) (Q 0) := by + dsimp only [E]; rw [dv3,da3] + constructor <;> simp [Q,B] <;> ring_nf <;> simp only [ii_sq] <;> ring + have result := assemble (R (B z)) (rotateEdges (B z) (root z)) + (by rw [he]; exact hs) + (by rw [he]; change E (B z 0) (Q 0); exact e10) + (by rw [he]; change E (B z 3) (Q 0); exact e20) + (by rw [he]; change E (B z 1) (Q 0); exact e30) + rw [he] at result + exact result + · change ∀ i j : Fin 4, i ≠ j → + E (S (R (R (B z))) i) (S (R (R (B z))) j) + let Q : Fin 4 → CircleCoordinates := + ![(4,7+8*z+4*ii), B z 0, B z 1, B z 2] + have he : S (R (R (B z))) = Q := by + funext l + fin_cases l <;> simp [S,R,B,Q]; ring + rw [he] + have hr : SemiProperQuadruple (R (R (B z))) := + SemiProperQuadruple.rotate (SemiProperQuadruple.rotate (SemiProperQuadruple.base z)) + have hs : ProperBandQuadruple (Q) := by + rcases BandSuccessorClassification (R (R (B z))) hr with bad | good + · simp [R,B] at bad + · have h : ProperBandQuadruple (S (R (R (B z)))) := good.1 + rw [he] at h + exact h + have laws1 := VectorRecursionLaws (Q) hs.1 + have laws2 := VectorRecursionLaws (R (Q)) + (SemiProperQuadruple.rotate hs.1) + have laws3 := VectorRecursionLaws (R (R (Q))) + (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hs.1)) + have nv1 : v (B z 0) (Q 0) = + v (B z 0) (B z 2)-ii*v (B z 1) (B z 0) := laws1.2.2.1 + have na1 : a (B z 0) (Q 0) = + a (B z 0) (B z 2)+ii*a (B z 1) (B z 0) := laws1.2.2.2.1 + have nv2 : v (B z 1) (Q 0) = + v (B z 1) (B z 0)-ii*v (B z 2) (B z 1) := laws2.2.2.1 + have na2 : a (B z 1) (Q 0) = + a (B z 1) (B z 0)+ii*a (B z 2) (B z 1) := laws2.2.2.2.1 + have nv3 : v (B z 2) (Q 0) = + v (B z 2) (B z 1)-ii*v (B z 0) (B z 2) := laws3.2.2.1 + have na3 : a (B z 2) (Q 0) = + a (B z 2) (B z 1)+ii*a (B z 0) (B z 2) := laws3.2.2.2.1 + have dv1 : v (B z 0) (Q 0) = 1-2*ii := by + rw [nv1,f02.1,v20,v10] + ring_nf; simp only [ii_sq]; ring + have da1 : a (B z 0) (Q 0) = z+2*ii+2*ii*z := by + rw [na1,f02.2,a20,a10] + ring_nf; simp only [ii_sq]; ring + have dv2 : v (B z 1) (Q 0) = 1+2*ii := by + rw [nv2,v10,v21] + ring + have da2 : a (B z 1) (Q 0) = 2+z-ii-2*ii*z := by + rw [na2,a10,a21] + ring_nf; simp only [ii_sq]; ring + have dv3 : v (B z 2) (Q 0) = -2 := by + rw [nv3,f02.1,v21,v20] + ring_nf; simp only [ii_sq]; ring + have da3 : a (B z 2) (Q 0) = -2-2*z-ii := by + rw [na3,f02.2,a21,a20] + ring_nf; simp only [ii_sq]; ring + have e10 : E (B z 0) (Q 0) := by + dsimp only [E]; rw [dv1,da1] + constructor <;> simp [Q,B] <;> ring_nf <;> simp only [ii_sq] <;> ring + have e20 : E (B z 1) (Q 0) := by + dsimp only [E]; rw [dv2,da2] + constructor <;> simp [Q,B] <;> ring_nf <;> simp only [ii_sq] <;> ring + have e30 : E (B z 2) (Q 0) := by + dsimp only [E]; rw [dv3,da3] + constructor <;> simp [Q,B] <;> ring_nf + have result := assemble (R (R (B z))) + (rotateEdges (R (B z)) (rotateEdges (B z) (root z))) + (by rw [he]; exact hs) + (by rw [he]; change E (B z 0) (Q 0); exact e10) + (by rw [he]; change E (B z 1) (Q 0); exact e20) + (by rw [he]; change E (B z 2) (Q 0); exact e30) + rw [he] at result + exact result + +end VectorSquareProof + +theorem VectorSquareProduct (q : Fin 4 → CircleCoordinates) + (hq : SemiProperQuadruple q) (i j : Fin 4) (hij : i ≠ j) : + BandVectors.1 (q i) (q j) ^ 2 = + (q j).1 • (q i).2 - (q i).1 • (q j).2 ∧ + 2 * BandVectors.1 (q i) (q j) * BandVectors.2 (q i) (q j) = + (q i).2 + (q j).2 := by +-- BODY + let ii : GaussianInt := ⟨0, 1⟩ + have ii_sq : ii^2 = -1 := VectorSquareProof.ii_sq + have ii_cube : ii^3 = -ii := VectorSquareProof.ii_cube + let v := BandVectors.1 + let a := BandVectors.2 + let E (C D : CircleCoordinates) : Prop := + v C D ^ 2 = (D.1 : GaussianInt) * C.2 - (C.1 : GaussianInt) * D.2 ∧ + 2 * v C D * a C D = C.2 + D.2 + let B (z : GaussianInt) : Fin 4 → CircleCoordinates := + ![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ii), (0, 1), (0, -1)] + let R (p : Fin 4 → CircleCoordinates) : Fin 4 → CircleCoordinates := + ![p 0, p 2, p 3, p 1] + let S (p : Fin 4 → CircleCoordinates) : Fin 4 → CircleCoordinates := + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] + have system : RecursiveVectorSystem BandVectors := VectorSquareProof.system + rcases system with ⟨_, baseLaw, _, flipLaw⟩ + have reverse (C D : CircleCoordinates) (ho : PrimitiveVectorOrientation C D) + (h : E C D) : E D C := VectorSquareProof.reverse ii_sq flipLaw C D ho h + have rootValues (z : GaussianInt) : + (v (B z 3) (B z 2) = 0 ∧ a (B z 3) (B z 2) = 1) ∧ + (v (B z 2) (B z 1) = -1 ∧ a (B z 2) (B z 1) = -1-z-ii) ∧ + (v (B z 3) (B z 1) = -ii ∧ a (B z 3) (B z 1) = ii*z-1) ∧ + (v (B z 1) (B z 0) = 1+ii ∧ a (B z 1) (B z 0) = 1+z-ii*z) ∧ + (v (B z 2) (B z 0) = -1 ∧ a (B z 2) (B z 0) = -1-z) ∧ + (v (B z 3) (B z 0) = -ii ∧ a (B z 3) (B z 0) = ii*z) := VectorSquareProof.rootValues + ii_sq baseLaw flipLaw z + have root (z : GaussianInt) : ∀ i j : Fin 4, i ≠ j → E (B z i) (B z j) := + VectorSquareProof.root ii_sq reverse rootValues z + have rotateEdges (p : Fin 4 → CircleCoordinates) + (ih : ∀ i j : Fin 4, i ≠ j → E (p i) (p j)) : + ∀ i j : Fin 4, i ≠ j → E (R p i) (R p j) := VectorSquareProof.rotateEdges p ih + have assemble (p : Fin 4 → CircleCoordinates) + (ih : ∀ i j : Fin 4, i ≠ j → E (p i) (p j)) + (hs : ProperBandQuadruple (S p)) + (e10 : E (p 0) (S p 0)) (e20 : E (p 2) (S p 0)) + (e30 : E (p 3) (S p 0)) : + ∀ i j : Fin 4, i ≠ j → E (S p i) (S p j) := VectorSquareProof.assemble reverse p ih hs e10 + e20 e30 + have properStep (p : Fin 4 → CircleCoordinates) (hp : ProperBandQuadruple p) + (ih : ∀ i j : Fin 4, i ≠ j → E (p i) (p j)) : + ∀ i j : Fin 4, i ≠ j → E (S p i) (S p j) := VectorSquareProof.properStep ii_sq ii_cube + assemble p hp ih + have rootStep (z : GaussianInt) (k : Fin 3) : + ∀ i j : Fin 4, i ≠ j → + E (S (if k = 0 then B z else if k = 1 then R (B z) else R (R (B z))) i) + (S (if k = 0 then B z else if k = 1 then R (B z) else R (R (B z))) j) := + VectorSquareProof.rootStep ii_sq ii_cube flipLaw rootValues root rotateEdges + assemble z k + simp only [zsmul_eq_mul] + change E (q i) (q j) + induction hq generalizing i j with + | base z => exact root z i j hij + | @rotate p hp ih => + exact rotateEdges p ih i j hij + | @successor p hp ih => + change E (S p i) (S p j) + rcases (SemiProperForestClassification p hp).2 with h | h | h | h + · rcases h with ⟨z,hz⟩ + change p = B z at hz + rw [hz] + have h := rootStep z 0 + change (∀ i j : Fin 4, i ≠ j → E (S (B z) i) (S (B z) j)) at h + exact h i j hij + · rcases h with ⟨z,hz⟩ + change p = R (B z) at hz + rw [hz] + have h := rootStep z 1 + change (∀ i j : Fin 4, i ≠ j → E (S (R (B z)) i) (S (R (B z)) j)) at h + exact h i j hij + · rcases h with ⟨z,hz⟩ + change p = R (R (B z)) at hz + rw [hz] + have h := rootStep z 2 + change (∀ i j : Fin 4, i ≠ j → E (S (R (R (B z))) i) (S (R (R (B z))) j)) at h + exact h i j hij + · exact properStep p h ih i j hij + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/projects/apollonian-superharmonic.yaml b/LeanPool/projects/apollonian-superharmonic.yaml new file mode 100644 index 0000000000..9ce9ee5dfc --- /dev/null +++ b/LeanPool/projects/apollonian-superharmonic.yaml @@ -0,0 +1,58 @@ +slug: apollonian-superharmonic +title: Apollonian classification of integer superharmonic matrices +summary: Characterizes quadratic growths of integer-valued functions on the square + lattice with discrete Laplacian at most one by the downsets of matrices associated + to circles in the Apollonian band packing, together with nonpositive-trace matrices. + Constructs maximal periodic odometers and rotationally symmetric lattice tilings, + and identifies the tiling and integrality lattices. +branch: discrete potential theory +entry_module: LeanPool.ApollonianSuperharmonic +authors: +- Wesley Pegden +source: + title: The Apollonian structure of integer superharmonic matrices + arxiv: '1309.3267' + url: https://github.com/wpegden/superharmonic + github_repo: wpegden/superharmonic + commit: 45094b210503f117502dec51caf737e96da221f8 + announcement_url: https://www.math.cmu.edu/~wes/trellis.php + completion_date: '2026-11-08' + public_repository_created: '2026-11-10T00:58:00Z' +license: Apache-2.0 +status: verified +provenance: AI +main_declarations: +- ApollonianSuperharmonic.IntegerSuperharmonicCharacterization +- ApollonianSuperharmonic.BandOdometerTheorem +- ApollonianSuperharmonic.IntegralityTiling +- ApollonianSuperharmonic.LambdaTiling +- ApollonianSuperharmonic.BandLatticeEquality +main_results: +- declaration: ApollonianSuperharmonic.IntegerSuperharmonicCharacterization + informal: A real symmetric two-by-two matrix admits an integer-valued lattice + function with its quadratic growth and discrete Laplacian at most one if and + only if it is below a band-circle matrix in the positive-semidefinite order + or has nonpositive trace. +- declaration: ApollonianSuperharmonic.BandOdometerTheorem + informal: Every band-circle matrix has an integer superharmonic representative + with the integrality-lattice cocycle identity, maximal among functions above + it with discrete Laplacian at most one, up to a bounded difference. +- declaration: ApollonianSuperharmonic.IntegralityTiling + informal: Every band circle admits a quarter-turn-symmetric lattice tile whose + integrality-lattice translates tile the plane, with six neighboring tiles + except for circles of curvature one. +- declaration: ApollonianSuperharmonic.LambdaTiling + informal: Every band circle admits the analogous symmetric tiling by translates + along its recursively defined tiling lattice. +- declaration: ApollonianSuperharmonic.BandLatticeEquality + informal: For each band circle the recursively defined tiling lattice equals + the lattice of integer vectors sent to integer vectors by its circle matrix. +tags: +- apollonian-packings +- superharmonic-functions +- discrete-potential-theory +- lattice-tilings +msc: +- 31C20 +- 52C15 +- 60G50 From 6f2ef608c5b89c3e282d5efe9001881834fd17b1 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Thu, 12 Nov 2026 12:06:49 +0000 Subject: [PATCH 02/23] Optimize Apollonian superharmonic formalization and finish validation --- .../AcyclicIndegreeOrientation.lean | 7 +- .../AffineOpposingStripCorridor.lean | 7 +- .../AffineTriangularComplexChart.lean | 2 + .../AffineTriangularCorridorStep.lean | 2 + .../AffineTriangularFace.lean | 5 +- .../AffineTriangularFaceCoordinateSwap.lean | 2 + .../AffineTriangularFaceVertices.lean | 4 + .../AffineTriangularNoFourfoldCellOwners.lean | 8 +- .../AffineTriangularPlaneTriangulation.lean | 23 +- .../AffineTriangularStrip.lean | 6 +- .../AllowedSubtileIncidence.lean | 2 + ...owedSubtileIncidenceZeroOppositeChord.lean | 3 + .../AncestorOdometer.lean | 2 + .../AncestorOdometerCentralCovariance.lean | 4 +- ...storOdometerInnerSupportNormalization.lean | 6 +- ...storOdometerOuterSupportNormalization.lean | 6 +- .../AncestorOdometerRestriction.lean | 11 +- .../AncestorOdometerTrans.lean | 3 +- .../ApollonianSuperharmonic/AncestorTile.lean | 2 + .../AncestorTileCentralCovariance.lean | 4 +- .../BandCanonicalPeriodicExtension.lean | 14 +- .../ApollonianSuperharmonic/BandCircle.lean | 2 + .../BandCircleEnclosureDichotomy.lean | 3 +- .../BandCircleEuclideanData.lean | 2 + .../BandDescartesGapSubdivision.lean | 4 + .../BandDiskExteriorDensity.lean | 4 +- .../BandDoubleDecomposition.lean | 31 +- ...BandExceptionalRestorationSectorOrder.lean | 132 ++--- .../BandGenealogy.lean | 3 +- .../BandGeneralCircle.lean | 2 + .../BandInterfaceRootedForest.lean | 4 +- .../BandLatticeEquality.lean | 2 + .../BandModifiedCellPartition.lean | 2 + .../BandModifiedCoverage.lean | 2 + .../BandModifiedOrbitArea.lean | 5 +- .../BandModifiedPeriodicComplex.lean | 8 +- .../BandModifiedUnionEquality.lean | 3 +- .../BandOdometerInteriorTable.lean | 9 +- .../BandOdometerMaximality.lean | 6 +- .../BandOdometerTheorem.lean | 10 +- .../BandOrderedGeneralAggregatePatches.lean | 7 +- .../BandOrderedGeneralChildInterfaces.lean | 27 +- .../BandOrderedGeneralConfiguration.lean | 3 +- .../BandOrderedGeneralFinitePatches.lean | 9 +- .../BandOrderedGeneralGeometricSectors.lean | 33 +- ...eredGeneralInteriorStarClassification.lean | 10 +- .../BandOrderedGeneralInteriorWebRow.lean | 9 +- ...deredGeneralLargestParentOdometerRows.lean | 13 +- .../BandOrderedGeneralLayout.lean | 14 +- .../BandOrderedGeneralLayoutCertificate.lean | 27 +- ...ndOrderedGeneralMarkedSectorTransport.lean | 2 + ...ndOrderedGeneralMixedAggregatePatches.lean | 3 +- ...OrderedGeneralNestedRightOdometerRows.lean | 10 +- ...eredGeneralNormalizedOccurrenceBundle.lean | 12 +- .../BandOrderedGeneralOdometerRowData.lean | 7 +- ...dOrderedGeneralOuterMixedOdometerRows.lean | 9 +- .../BandOrderedGeneralPeriodicBlockCells.lean | 6 +- ...BandOrderedGeneralPositiveCutGeometry.lean | 392 +++++++-------- ...OrderedGeneralPositiveCutOdometerRows.lean | 13 +- .../BandOrderedGeneralRawSupport.lean | 58 +-- ...deredGeneralRightInterfaceCertificate.lean | 4 +- ...eneralRightInterfaceCertificateExists.lean | 17 +- ...dGeneralRightNormalizationCertificate.lean | 6 +- ...alRightNormalizationCertificateExists.lean | 24 +- ...redGeneralRightNormalizedBundleExists.lean | 2 + ...eredGeneralRightOuterMarkingCriterion.lean | 5 +- .../BandOrderedGeneralRightPlacement.lean | 4 +- ...OrderedGeneralRightRoutingCertificate.lean | 4 +- ...dGeneralRightRoutingCertificateExists.lean | 22 +- ...dOrderedGeneralRightSelectedAdjacency.lean | 18 +- ...rderedGeneralRightSelectedRowGeometry.lean | 56 +-- ...ndOrderedGeneralRoutedSelectedContact.lean | 20 +- .../BandOrderedGeneralSelectedContactRow.lean | 5 +- ...rderedGeneralSelectedContactRowExists.lean | 14 +- ...eredGeneralSelectedSCompanionGeometry.lean | 6 +- ...eralShiftedRoutedBoundaryLocalization.lean | 23 +- ...andOrderedGeneralSubtileCanonicalRows.lean | 32 +- ...eredGeneralSubtileCanonicalSeparation.lean | 4 +- ...redGeneralSubtileInterfaceCertificate.lean | 4 +- ...eralSubtileInterfaceCertificateExists.lean | 52 +- ...eneralSubtileNormalizationCertificate.lean | 7 +- ...SubtileNormalizationCertificateExists.lean | 52 +- ...dGeneralSubtileNormalizedBundleExists.lean | 2 + .../BandOrderedGeneralSubtilePlacement.lean | 3 +- ...deredGeneralSubtileRoutingCertificate.lean | 4 +- ...eneralSubtileRoutingCertificateExists.lean | 11 +- ...eredGeneralSubtileSelectedRowGeometry.lean | 6 +- ...ndOrientedBoundaryOccurrenceGenealogy.lean | 12 +- .../BandOrientedBoundaryParentChain.lean | 3 +- .../BandOrientedChildParentEndpoints.lean | 6 +- ...ndOrientedChildParentIncomingEndpoint.lean | 16 +- .../BandOrientedChildParentRightEndpoint.lean | 23 +- .../BandOrientedGapRefinement.lean | 2 + .../BandOrientedGapRefinementExists.lean | 15 +- ...lOccurrenceIntersectionClassification.lean | 15 +- .../BandOriginalPairSeparation.lean | 4 +- .../BandPackingExterior.lean | 3 + .../BandPackingShiftPotential.lean | 4 +- .../BandPackingSymmetry.lean | 4 +- ...BandPackingSymmetryAffineVectorAction.lean | 2 + ...PackingSymmetryAffineVectorCovariance.lean | 31 +- .../BandPackingSymmetryCircleAction.lean | 2 + .../BandPackingSymmetryCovariance.lean | 10 +- ...ackingSymmetryGlobalOdometerTransport.lean | 2 + ...ckingSymmetryInversePhaseCancellation.lean | 18 +- ...ndPackingSymmetryMarkedDataCovariance.lean | 59 +-- ...dPackingSymmetryPartialOdometerAction.lean | 2 + ...SymmetryPartialOdometerActionFormulas.lean | 6 +- ...ingSymmetryProjectiveVectorCovariance.lean | 22 +- .../BandPackingSymmetryProperCovariance.lean | 12 +- .../BandPackingSymmetryQuadrupleAction.lean | 3 + ...andPackingSymmetryReversesOrientation.lean | 2 + .../BandPackingSymmetryScopedPhase.lean | 3 +- .../BandPackingSymmetryScopedPhaseUnique.lean | 14 +- .../BandPackingSymmetrySlopeAction.lean | 3 +- .../BandPackingSymmetryT3T5Covariance.lean | 10 +- .../BandPackingSymmetryTileAction.lean | 2 + ...PackingSymmetryTileOdometerCovariance.lean | 39 +- .../BandPackingSymmetryTilingTransport.lean | 11 +- .../BandPackingSymmetryVectorAction.lean | 2 + .../BandParentBoundaryGenealogy.lean | 4 +- ...andParentRotationOccurrenceCovariance.lean | 3 +- .../BandPeriodicOdometer.lean | 5 +- .../BandPeriodicSuperharmonicity.lean | 22 +- ...ndPositiveCutBranchCompanionExclusion.lean | 151 +++--- .../BandPredecessorNoCollision.lean | 2 + .../BandPrototile.lean | 3 +- .../BandPrototileCentralSymmetry.lean | 5 +- .../BandPrototileCentroidUnique.lean | 51 +- .../BandPrototileCompleteSquareCentroid.lean | 10 +- .../BandPrototileExists.lean | 36 +- ...BandPrototileFootprintSlopeCovariance.lean | 25 +- .../BandPrototileReindexedDecomposition.lean | 27 +- .../BandPrototileTranslation.lean | 6 +- .../BandPrototileTranslationNormalForm.lean | 5 +- .../BandRegimeClassification.lean | 3 +- ...BandRegularTileTouchingClassification.lean | 4 +- .../BandRegularTranslatePeriodicComplex.lean | 12 +- .../BandRetainedBoundaryGenealogy.lean | 93 ++-- .../BandSignedOccurrenceHalfTurn.lean | 7 +- .../BandSubtileOccurrence.lean | 3 +- .../BandSubtileOccurrenceTranslation.lean | 3 +- .../BandSuccessorClassification.lean | 3 +- .../ApollonianSuperharmonic/BandTangency.lean | 4 +- .../BandTangencyDensity.lean | 9 +- .../BandTileAcyclicIndegree.lean | 46 +- .../BandTileSimultaneousInduction.lean | 58 +-- .../BandTileTopologyApplication.lean | 13 +- .../BandTwelveParentSurround.lean | 22 +- .../BandUnmodifiedCoreCertificate.lean | 3 +- .../BandUnmodifiedCoverage.lean | 2 + .../BandUnmodifiedPeriodicCore.lean | 7 +- .../BandVectorOrientationDichotomy.lean | 4 +- .../ApollonianSuperharmonic/BandVectors.lean | 3 +- .../BoundaryFootprintEdges.lean | 2 + .../BoundaryFootprintVertexDegreeTwo.lean | 4 +- .../BoundaryFootprintVertices.lean | 2 + .../BoundaryJoinChamberCertificate.lean | 22 +- .../BoundaryString.lean | 3 +- .../BoundaryStringConcatenation.lean | 26 +- .../BoundaryStringOdometerRespect.lean | 12 +- .../BoundedDifference.lean | 2 + .../CellDisjointCommonEdgesBoundary.lean | 3 +- .../CellDisjointCommonFootprintIncidence.lean | 14 +- .../CellSupportedFootprintVertices.lean | 2 + .../CentrallyReflectedAt.lean | 2 + .../CircleCoordinates.lean | 4 +- .../ApollonianSuperharmonic/CircleMatrix.lean | 3 + .../CircleMatrixEnclosureCriterion.lean | 4 +- .../CircleMatrixIncomingVector.lean | 8 +- .../ClosedSquareRealization.lean | 2 + .../CommonFootprintEdgeVertices.lean | 2 + .../ConnectedCommonBoundaryPath.lean | 6 +- .../ConnectedGridEdgeCarrierGraph.lean | 30 +- .../ConnectedGridEdgeCarrierUnion.lean | 7 + .../ConsecutivePatchInterface.lean | 2 + ...CoveredInterfaceOppositeIncidentCells.lean | 4 +- .../CurvatureOneBandCircleClassification.lean | 2 + .../CurvatureOneBandPrototileSingleton.lean | 5 +- .../CurvatureOneOdometer.lean | 2 + .../CurvatureOnePeriodicOdometer.lean | 31 +- .../CurvatureOneTileBase.lean | 2 + .../DiamondBaseT1.lean | 11 +- .../DiamondBaseT2.lean | 11 +- .../DiamondBaseTouching.lean | 2 + .../DiamondCellDomain.lean | 2 + .../DiamondCoordinateConfiguration.lean | 29 +- .../DiamondExceptionalLattice.lean | 4 +- ...xceptionalMatrixLatticeIdentification.lean | 15 +- .../DiamondExceptionalMaximality.lean | 11 +- .../DiamondLaplacianTable.lean | 10 +- .../DiamondOdometer.lean | 2 + .../DiamondOdometerExistsUnique.lean | 2 + ...amondOpposingBoundaryStarLocalization.lean | 22 +- .../DiamondOrientedChildParentEndpoints.lean | 4 +- .../DiamondParameter.lean | 3 +- .../DiamondPeakMatrix.lean | 6 + .../DiamondRecursiveQuadruple.lean | 3 + .../DiamondRegimeConverse.lean | 6 +- .../DiamondTerminalWebStencilLedger.lean | 2 + .../ApollonianSuperharmonic/DiamondTile.lean | 2 + .../DiamondTileAcyclicIndegree.lean | 4 +- .../DiamondTileGeometry.lean | 9 +- .../DiamondTileOdometerRestriction.lean | 5 +- .../DiamondTileRecursiveIdentification.lean | 10 +- .../DiamondVertexDomains.lean | 5 +- ...isjointBoundaryCommonEdgeGraphAcyclic.lean | 5 +- .../DisjointSquareUnionCommonEdgeCarrier.lean | 5 +- .../EuclideanCircleData.lean | 6 +- .../ExactPatchBoundaryInterface.lean | 2 + ...leInterfaceDisjointCompanionEndpoints.lean | 2 + .../ExactTileInterfaceTriple.lean | 2 + ...actTileInterfaceTripleLatticeTouching.lean | 2 + ...erfaceTriplePackingSymmetryCovariance.lean | 2 + ...xactTileInterfaceTripleRetargetMiddle.lean | 2 + .../ExactTileInterfaceTripleSwapLast.lean | 2 + .../ExactTileTiling.lean | 2 + .../ExceptionalConnectorSegments.lean | 4 +- .../ExceptionalModifiedABPath.lean | 11 +- .../ExceptionalRestorationSectorData.lean | 4 +- .../FiniteAcyclicGraphCardConnected.lean | 3 +- .../FiniteAcyclicOrientationObstruction.lean | 12 +- .../FiniteBiconnectedHorizontalRunTree.lean | 4 +- ...niteConnectedAcyclicDegreeTwoGridPath.lean | 3 +- .../FiniteConnectedCellSetNoCheckerboard.lean | 4 +- .../FiniteCycleComponentList.lean | 3 +- .../FiniteGridEdgeGraphEncoding.lean | 3 +- .../FiniteInducedTilePatch.lean | 2 + .../FinitePatchTopology.lean | 2 + .../FinitePolyominoDiskCriterion.lean | 6 +- .../FiniteSquareIncidenceIdentities.lean | 10 +- .../ApollonianSuperharmonic/FiniteTile.lean | 2 + .../FootprintDeletionRetention.lean | 2 + .../FootprintEdges.lean | 2 + .../FootprintVertices.lean | 2 + .../ApollonianSuperharmonic/FordBaseT1.lean | 14 +- .../ApollonianSuperharmonic/FordBaseT2.lean | 13 +- .../ApollonianSuperharmonic/FordBaseT6.lean | 15 +- .../FordBaseTouching.lean | 18 +- .../FordBoundaryMultiplicity.lean | 2 + .../FordCellDomain.lean | 2 + .../FordCenteredInteriorOdometerStencil.lean | 41 +- .../FordCircleCoordinate.lean | 2 + .../FordCoordinateConfiguration.lean | 70 ++- .../FordDoubledBoundary.lean | 2 + .../FordExceptionalLattice.lean | 4 +- ...xceptionalMatrixLatticeIdentification.lean | 17 +- .../FordExceptionalMaximality.lean | 19 +- .../FordFareyParameter.lean | 4 +- .../FordFareyParentsExist.lean | 9 + .../FordLaplacianTable.lean | 10 +- .../FordLeftBoundaryCompatibility.lean | 32 +- .../ApollonianSuperharmonic/FordOdometer.lean | 2 + .../FordOdometerFamilyExistsUnique.lean | 4 +- .../FordOpposingBoundaryStarLocalization.lean | 9 +- .../FordOrientedChildParentEndpoints.lean | 24 +- ...rdOrientedChildParentIncomingEndpoint.lean | 10 +- .../FordOrientedChildParentRightEndpoint.lean | 7 +- .../FordPeakMatrix.lean | 7 +- .../FordRecursiveQuadruple.lean | 3 + .../FordRecursiveVertexDomains.lean | 5 +- .../FordRegimeConverse.lean | 73 ++- .../FordTerminalWebStencilLedger.lean | 2 + .../ApollonianSuperharmonic/FordTile.lean | 2 + .../FordTileAcyclicIndegree.lean | 8 +- .../FordTileGeometry.lean | 23 +- .../FordTileOdometerRestriction.lean | 28 +- .../FordTileRecursiveIdentification.lean | 59 +-- .../FordVertexDomain.lean | 4 +- .../ForwardBoundaryStringData.lean | 8 +- .../FourNeighborAdjacent.lean | 2 + .../FourNeighborConnected.lean | 2 + .../FourNeighborLaplacian.lean | 2 + .../GaussianQuarterTurn.lean | 4 +- .../GaussianRealPoint.lean | 4 +- .../GaussianReflection.lean | 4 +- .../GaussianTranslation.lean | 4 +- .../GlobalOdometerExtends.lean | 2 + .../GridCellCenter.lean | 2 + .../GridEdgeCarrier.lean | 2 + .../GridHorizontalLogLiftDelta.lean | 2 + .../GridRayCrossingIndex.lean | 4 +- .../GridRayCrossingIndexAdjacentCell.lean | 13 +- .../GridRayCrossingIndexZeroOfEdgeLifts.lean | 2 + .../GridSegmentLogLiftDelta.lean | 6 +- .../GridStepLogLiftDelta.lean | 5 +- .../GridVerticalDownLogLiftDelta.lean | 13 +- .../GridVerticalUpLogLiftDelta.lean | 13 +- .../IncomingSuperbasisRelation.lean | 8 +- .../IntegerCeilDiv.lean | 4 +- .../IntegerLaplacianCastBridge.lean | 2 + .../IntegerLatticeFunction.lean | 4 +- .../IntegerPreservingNormalization.lean | 7 +- .../IntegerSuperharmonicCharacterization.lean | 2 + .../IntegerSuperharmonicClosedness.lean | 4 +- .../IntegerSuperharmonicRepresentative.lean | 2 + .../IntegralityLattice.lean | 3 + .../IntegralityLatticeIndex.lean | 4 +- .../IntegralityTiling.lean | 2 + .../IsolatedPrecursorCoverage.lean | 3 +- .../ApollonianSuperharmonic/LambdaTiling.lean | 4 +- .../LatticeAdjacentInterfacePath.lean | 43 +- .../ApollonianSuperharmonic/LatticeCell.lean | 4 +- ...LatticeDiskUnionIntersectionConnected.lean | 12 +- .../LatticeEdgeRegularity.lean | 27 +- .../LatticeFundamentalSet.lean | 4 +- .../LatticeQuadraticForm.lean | 6 +- .../ApollonianSuperharmonic/LatticeTile.lean | 2 + .../LatticeTileBoundarySimpleGridCycle.lean | 8 +- .../LatticeTileComplementGridConnected.lean | 7 +- .../LatticeTileDiskUnionInterface.lean | 9 +- .../LatticeTileFourNeighborConnected.lean | 5 +- .../LatticeTileGridEulerCount.lean | 8 +- .../LatticeTileGridStructure.lean | 7 +- .../LatticeTileNoCheckerboard.lean | 5 +- .../LatticeTileThreeDiskJunction.lean | 12 +- .../LatticeVertexBoundary.lean | 4 +- .../LatticeVertexIncidentCell.lean | 3 + .../LeftAdjacentOdometerCompatibility.lean | 17 +- .../LeftLatticeAdjacent.lean | 2 + ...tticeAdjacentPackingSymmetryTransport.lean | 39 +- .../LocalExponentialEstimate.lean | 3 + .../LocalLatticeInterfaceSectors.lean | 6 +- .../MarkedOdometerAdjacencyReduction.lean | 63 +-- ...difiedSubtileOccurrenceInterpretation.lean | 6 +- .../NoCheckerboardCellVertex.lean | 2 + .../OdometerAdjacencyInduction.lean | 8 +- .../OdometerCompatibility.lean | 2 + .../OdometerGluing.lean | 13 +- .../OdometerStringRespect.lean | 2 + ...dometerStringRespectCentralCovariance.lean | 7 +- ...RespectRegularFamilyCentralCovariance.lean | 5 +- .../OdometerTranslation.lean | 2 + .../ApollonianSuperharmonic/OdometerWeb.lean | 90 +--- .../OpenLatticeEdge.lean | 2 + .../OpposingBoundaryInterfaceExhaustion.lean | 4 +- .../OpposingBoundaryOdometerStrings.lean | 27 +- .../OpposingBoundaryStarLocalization.lean | 14 +- .../OpposingStringInterfacePath.lean | 24 +- ...siteRoutedCommonEdgeOutsideCellUnique.lean | 2 + ...eneralOdometerAdjacencyClassification.lean | 8 +- .../OrientedTouchingCovariance.lean | 13 +- .../OrientedUnimodularStripConcatenation.lean | 3 + .../OuterLayoutTouching.lean | 9 +- .../OuterTouchingAlternative.lean | 3 + ...eredGeneralMixedAggregateJunctionData.lean | 28 +- ...dGeneralMixedAggregatePairedEndpoints.lean | 81 ++- .../P2999T1CompleteSquareTransport.lean | 2 + .../P2999T1OrthogonalSlopeTransport.lean | 2 + .../P2999T1ShiftSlopeTransport.lean | 2 + .../P3019T1ChamberSegmentOrder.lean | 7 +- .../P3019T1ChamberStripGeometry.lean | 5 +- .../P3019T1UnimodularStripWindow.lean | 2 + ...045T1RightBoundaryDisplacementAlgebra.lean | 2 + .../P3055T1ExteriorCentralIncidence.lean | 3 + .../P3055T1ParentVectorNormalForms.lean | 2 + .../P3055T1SignedCentroidNormalForms.lean | 2 + .../P3092T1CenteredRectangleDisk.lean | 6 +- .../P3092T1DiamondCenteredRectangles.lean | 6 +- .../P3102T2CommonEdgeSectorTransition.lean | 2 + .../P3102T2IsolatedRoutedCellSurvival.lean | 2 + .../P3102T2OppositeOwnersCommonEdge.lean | 2 + .../P3102T2PeriodicFourSectorObstruction.lean | 2 + ...3161T1AggregateComplementConnectivity.lean | 2 + .../P3161T1AggregateInducedConnectivity.lean | 3 + .../P3161T1BlockTreeReachability.lean | 5 +- .../P3161T1SquareTriangleComplement.lean | 8 +- .../P3161T2IncidentBoundary.lean | 3 +- .../P3161T2PathExhaustion.lean | 3 +- .../P3161T2PathSubwalk.lean | 3 +- .../P3192T1FourOwnerTriangleExclusion.lean | 2 + .../P3192T1PeriodicIndicesInfinite.lean | 3 +- .../P3192T1SimplePathOrientation.lean | 2 + .../P3221T2ClosedWalkCirculation.lean | 4 +- .../P3221T2ConnectedPathIntegration.lean | 7 +- .../P3221T2IntegralSquareFilling.lean | 7 +- .../P3221T2TileFillingSupport.lean | 3 +- .../P3350T1GraphCellUnionConnected.lean | 2 + .../P3381T1AffineTriangleMap.lean | 11 +- .../P3381T1PairedTriangulation.lean | 5 + .../P3381T1PiecewiseAffinePolygonModel.lean | 5 +- .../P3381T1PolygonBoundary.lean | 7 +- .../P3381T1TriangleDeterminant.lean | 5 +- .../P3381T1TriangulationBoundary.lean | 11 +- .../P3475T1BoundaryReduction.lean | 2 + .../P3475T1BoundaryRestoration.lean | 2 + .../P3475T1BoundarySubdivision.lean | 2 + .../P3475T1GridBoundary.lean | 2 + .../P3475T1PolygonTriangleConstruction.lean | 2 + .../P3475T1PolygonalSeparation.lean | 8 +- .../P3475T1SquareUnionIdentification.lean | 68 +-- .../P3475T1TriangleTree.lean | 2 + .../P3475T1UnitSegmentIntersection.lean | 5 +- .../P3497T1SingleStraightDeletion.lean | 2 + .../P3497T1StrictCornerSplice.lean | 7 +- .../P3497T1SubdivisionComposition.lean | 5 +- .../P3497T1TriangleCornerNonzero.lean | 3 +- .../P3511T1AttachmentIntersection.lean | 6 +- .../P3511T1ConvexComparison.lean | 3 +- .../P3511T1ConvexRealization.lean | 6 +- .../P3511T1CyclicDissection.lean | 6 +- .../P3511T1LeafOrder.lean | 4 +- .../P3511T1SourceConstruction.lean | 8 +- .../P3511T1SourceDissection.lean | 5 +- .../P3523T1BoundaryFaceSplit.lean | 5 +- .../P3523T1FaceEnumeration.lean | 8 +- .../P3523T1InsertionConstruction.lean | 7 +- .../P3523T1InsertionData.lean | 5 +- .../P3523T1InsertionGeometry.lean | 2 + .../P3523T1InsertionIncidence.lean | 21 +- .../P3523T1InterpolatedTarget.lean | 2 + .../P3523T1OrderedInsertion.lean | 66 +-- .../P3523T1SplitDeterminants.lean | 5 +- .../P3523T1SubdivisionExit.lean | 2 + .../P3523T1TargetBoundary.lean | 5 +- .../P3523T1TargetHull.lean | 2 + .../P3523T1TwoTriangleSplit.lean | 8 +- .../P3544T1BoundaryCarrier.lean | 2 + .../P3544T1DiagonalSelection.lean | 9 +- .../P3544T1DiagonalSplit.lean | 25 +- .../P3544T1IndexedGluing.lean | 3 +- .../P3544T1LocalParity.lean | 5 +- .../P3544T1RayParity.lean | 4 +- .../P3544T1TriangleRayGeometry.lean | 12 +- .../P3555T2ParabolaChordCuts.lean | 13 +- .../P3555T2ParabolaHullFrontier.lean | 6 +- .../P3555T2ParabolaSupporting.lean | 6 + .../P3555T2SavedDissectionGeometry.lean | 23 +- .../P3597T1DirectionParity.lean | 2 + .../P3597T1GenericRayStability.lean | 10 +- .../P3597T1SideCrossing.lean | 15 +- .../P3597T1VertexSectors.lean | 6 +- .../P3650T1CyclicChildren.lean | 18 +- .../P3650T1CyclicChildrenExists.lean | 10 +- .../P3650T1EmptyTriangleDiagonal.lean | 5 +- .../P3650T1ExposedCorner.lean | 9 +- .../P3650T1ExposedCornerExists.lean | 9 +- .../P3650T1LocalCoherence.lean | 94 ++-- .../P3650T1MaximalHeightDiagonal.lean | 8 +- .../P3650T1OldArcEven.lean | 194 ++++---- .../P3650T1ParitySum.lean | 67 +-- .../P3650T1TriangleEntry.lean | 4 +- .../P3650T1VisibleDiagonal.lean | 3 + .../P3652T1ChildFillSeparation.lean | 4 + .../P3652T1DiagonalFaceIntersections.lean | 2 + .../P3652T1IndexedFaceLedger.lean | 350 ++++++++----- .../P3652T1ParentOddGluing.lean | 6 +- .../P3652T1TriangleFaceRestriction.lean | 3 + .../P3723T1AllContactDrawingExists.lean | 3 +- .../P3723T1AllContactRouting.lean | 2 + .../P3723T1ContactPorts.lean | 4 +- .../P3723T1ContactPortsExist.lean | 5 +- .../P3723T1ContactStabilizer.lean | 3 +- .../P3723T1ConvexRadialIntersection.lean | 7 +- .../P3723T1ConvexRadialParameterization.lean | 8 +- .../P3723T1EdgeContact.lean | 2 + .../P3723T1GridDiskBoundaryStars.lean | 2 + .../P3723T1GridDiskPairedModel.lean | 4 +- .../P3723T1PairedModelSegmentPullback.lean | 14 +- .../P3723T1PolygonalParameterization.lean | 9 +- .../P3767T1BarrierRegionMaximal.lean | 4 +- .../P3767T1FixedFaceComponents.lean | 3 + .../P3767T1FixedTrace.lean | 2 + .../P3767T1VertexEdgeIncidence.lean | 3 + .../P3776T1BoundedDisplacementSurjective.lean | 4 +- .../P3776T1CellCenterMembership.lean | 3 +- .../P3776T1DiskMapExponentialLift.lean | 4 +- .../P3776T1DualEdges.lean | 3 +- .../P3776T1DualEdgesExist.lean | 4 +- .../P3776T1EquivariantDisplacementBound.lean | 5 +- .../P3776T1FixedGeometry.lean | 12 +- .../P3776T1OpenStar.lean | 2 + .../P3776T1PlaneMapExists.lean | 2 + .../P3776T1SectorMaps.lean | 3 +- .../P3776T1SectorMapsExist.lean | 11 +- .../P3776T1StarWeights.lean | 2 + .../P3776T1StarWeightsExist.lean | 4 +- .../P3776T1TileContractions.lean | 2 + .../P3776T1TileContractionsExist.lean | 8 +- .../P3776T1WalkMap.lean | 3 +- .../P3776T1WalkMapProperties.lean | 12 +- .../P3821T1AngularIncrement.lean | 9 +- .../P3821T1AngularIncrementLaws.lean | 3 + .../P3821T1CircleComponentBound.lean | 6 +- .../P3821T1ComponentContours.lean | 94 ++-- .../P3821T1ControlledNeighborhood.lean | 11 +- .../P3821T1LoopIndex.lean | 4 + .../P3821T1LoopIndexLaws.lean | 3 + .../P3821T1ThreeArcCircle.lean | 2 + .../P3832T1ChamberOverlap.lean | 10 +- .../P3832T1CollapsedConeDescent.lean | 7 +- .../P3832T1ConeCollapse.lean | 5 +- .../P3832T1FiniteClosedCoverPasting.lean | 4 +- .../P3861T1ExtraArcLocalization.lean | 5 +- .../P3861T1FacialDomains.lean | 2 + .../P3861T1FixedFacialDeletion.lean | 2 + .../P3861T1RealPolygonDomains.lean | 5 +- .../P3861T1RoutedFaceOrientation.lean | 3 +- .../P3861T1RoutedFacialDomains.lean | 2 + .../P3889T1ExactRadialStar.lean | 4 +- .../P3889T1FaceGapCoverage.lean | 6 +- .../P3889T1TwoRaySectorDecomposition.lean | 9 +- .../P3889T1TwoRaySectors.lean | 12 +- .../P3913T1OffFaceExterior.lean | 4 +- .../P3913T1PeriodicPositionUnbounded.lean | 2 + .../P3913T1RoutedArcExterior.lean | 7 +- .../P3913T1RoutedFaceSubdivision.lean | 30 +- .../P3913T1RoutedTraceClosed.lean | 3 +- .../P3934T1ArcSide.lean | 2 + .../P3934T1ArcSideComparison.lean | 5 + .../P3934T1LocalSide.lean | 8 +- .../P3934T1PolygonalSide.lean | 2 + .../P3934T1PolygonalSidePropagation.lean | 6 +- .../P3934T1SectorContinuation.lean | 5 +- .../P3934T1SectorSelection.lean | 3 +- .../P3963T1DeletedPairExteriorConnected.lean | 2 + .../P3963T1EdgeFreeDiskCorners.lean | 2 + .../P3963T1ExteriorMixedCycleObstruction.lean | 2 + .../P3963T1MixedBoundaryCycle.lean | 13 +- .../P3996T1AdjacentParentPlacement.lean | 12 +- .../P3996T1CenteredQuarterTurnInclusion.lean | 4 +- .../P3996T1PlacementCompanionBlocks.lean | 6 +- .../P3996T1SRowAlignment.lean | 21 +- .../P3996T1SRowParameters.lean | 3 + .../P3996T1SRowTable.lean | 2 + .../P4055T1BandQuarterTurn.lean | 3 +- .../P4055T1ExactTripleImage.lean | 2 + .../P4055T1GridPathImage.lean | 12 +- ...4055T1OrderedGeneralOppositeEndpoints.lean | 8 +- .../P4055T1PackingGridEquivalence.lean | 2 + .../P4055T1PlacementNormalization.lean | 17 +- .../P4062T1CanonicalSupport.lean | 12 +- .../P4062T1InteriorGeometry.lean | 3 + .../P4062T1InteriorSquare.lean | 4 +- .../P4062T1LiteralReduction.lean | 9 +- .../P4062T1OrientationTransport.lean | 8 +- .../P4062T1OverlapDescent.lean | 8 +- .../P4062T1ParentGluing.lean | 2 + .../P4062T1ParentalRestriction.lean | 2 + .../P4062T1RankedAttachment.lean | 5 +- .../P4062T1RecursiveInteriors.lean | 4 + .../P4062T1RemainderGeometry.lean | 3 +- .../P4062T1RemainderPaths.lean | 6 +- .../P4062T1ZeroIncoming.lean | 3 +- .../P4085T1FordIncomingNormalization.lean | 3 +- .../P4085T1MinusTouching.lean | 2 + .../P4085T1RestrictedAdaptedActions.lean | 3 + .../P4112T1BoundaryMultiplicity.lean | 40 +- .../P4112T1LowerNeighbors.lean | 2 + .../P4112T1ParentalNeighbors.lean | 16 +- .../P4112T1PathGeometry.lean | 18 +- .../P4120T1AffineComparison.lean | 6 +- .../P4120T1DiamondGeometry.lean | 3 +- .../P4120T1FordGeometry.lean | 19 +- .../P4120T1GeneralDescent.lean | 10 +- .../P4120T1GeneralRowData.lean | 2 + .../P4120T1RootNormalization.lean | 5 +- .../P4158T1AncestorCells.lean | 2 + .../P4158T1EdgeSectorSelection.lean | 6 +- .../P4158T1LargeFirstRestrictions.lean | 16 +- .../P4158T1LargeSecondRestrictions.lean | 17 +- .../P4158T1MatchedFordPair.lean | 31 +- .../P4158T1SmallerStringEdges.lean | 20 +- .../P4158T1StringSlopeTelescoping.lean | 3 +- .../P4194T1DiamondBoundaryLedger.lean | 59 ++- .../P4194T1DiamondCellRows.lean | 4 +- .../P4194T1DiamondCentroid.lean | 8 +- .../P4194T1DiamondVertexIncidence.lean | 2 + .../P4207T1DiamondFormula.lean | 2 + .../P4207T1FloorArithmetic.lean | 3 +- .../P4207T1FormulaRestriction.lean | 4 +- .../P4207T1ShiftedPredecessor.lean | 2 + .../P4207T1UnitRestrictions.lean | 6 +- .../P4210T1FordCellRectangles.lean | 2 + .../P4210T1FordSquareCentroid.lean | 14 +- .../P4217T2RectangularBoundarySlope.lean | 2 + .../P4217T2SquareGeometry.lean | 2 + .../P4217T2SquareRestriction.lean | 2 + .../P4223T1DiamondRowNumerators.lean | 3 +- .../P4250T1DefinedHalfIntegralSlope.lean | 4 +- .../P4250T1IntegralAffinePlacement.lean | 3 +- .../P4250T1NestedCompatibility.lean | 15 +- .../P4250T1OrdinaryCompatibility.lean | 6 +- .../P4250T1ParentSlopePhase.lean | 6 +- .../P4250T1ReflectedGluingSlope.lean | 22 +- .../P4250T1SlopeOffset.lean | 4 +- .../P4250T2FiniteForestCompletion.lean | 7 +- .../P4250T2IndegreeSubtraction.lean | 2 + .../P4250T2InterfaceCycleExclusion.lean | 6 +- .../P4250T2InterfaceNeighborCount.lean | 61 +-- .../P4250T2PrecursorRootSeparation.lean | 9 +- .../P4261T1CentralCoordinates.lean | 7 +- .../P4261T1ContactAdjacency.lean | 7 +- .../P4261T1EdgeExterior.lean | 4 +- .../P4261T1ExteriorAdjacency.lean | 4 +- .../P4261T1ExteriorIndices.lean | 3 + .../P4261T1PlacedOdometer.lean | 4 +- .../P4261T1RightCoordinates.lean | 11 +- .../P4261T1SubtileCoordinates.lean | 5 +- .../P4261T2AdjacentMatrixSlope.lean | 2 + .../P4261T2AncestorSymmetry.lean | 8 +- .../P4261T2DiamondBoundary.lean | 7 +- .../P4261T2InterfacePropagation.lean | 3 +- .../P4261T2LiteralInterface.lean | 2 + .../P4261T2PairNormalization.lean | 6 +- .../P4261T2RegularEdgeReduction.lean | 7 +- .../P4261T2UnitBoundary.lean | 20 +- .../P4261T2UnitInterface.lean | 19 +- .../P4261T2UnitStringTelescoping.lean | 2 + .../P4339T1EmptyPrecursorRoots.lean | 21 +- .../P4339T1PositivePrecursorRoots.lean | 122 ++--- .../P4339T1PrecursorArcSeparation.lean | 9 +- .../P4339T1PrecursorSupportGeometry.lean | 5 +- .../P4366T1AttachedRemainderIndexZero.lean | 3 +- .../P4366T1PrecursorPathLoop.lean | 46 +- .../P4366T1PrecursorRemainderFamily.lean | 3 + .../P4366T1RemainderOuterAttachments.lean | 2 + .../P4366T2LocalSectors.lean | 7 +- .../P4366T2OuterGeometry.lean | 25 +- .../P4366T2WalkExhaustion.lean | 2 + .../P4387T1ParentSlopeNormalForms.lean | 2 + .../P4387T1PlacedCoordinates.lean | 7 +- .../P4397T1PathAvoidsPrecursorEdges.lean | 2 + .../P4397T1ReflectedEdgeNotBoundary.lean | 3 +- .../P4397T1SimplePathSplicing.lean | 6 +- .../P4397T1UnitEdgeCells.lean | 8 + .../P4418T3EndpointOwnerIndices.lean | 2 + .../P4418T3NestedCompanionEndpoint.lean | 30 +- .../P4418T3NestedCompanionGeometry.lean | 4 +- .../P4418T3OuterCompanionAlignment.lean | 8 +- .../P4418T3PresentedRowAdjacency.lean | 9 +- .../P4418T3RoutedBlockCriterion.lean | 4 +- .../P4418T3SelectedInterfaceData.lean | 4 + .../P4418T3SelectedInterfaceExists.lean | 73 +-- .../P4431T1OwnerTransitionSelector.lean | 10 +- .../P4456T2BandGraphTriangle.lean | 11 +- .../P4456T2CrosscutIndex.lean | 6 +- .../P4456T2DiamondNoChord.lean | 3 +- .../P4456T2EdgeInterior.lean | 19 +- .../P4456T2MissingEdge.lean | 15 +- .../P4456T2OrderedNoChord.lean | 11 +- .../P4456T2PackingNoChord.lean | 4 +- .../P4456T2ParentSide.lean | 3 +- .../P4456T2SquareEdges.lean | 4 +- .../P4456T2VertexInterior.lean | 20 +- .../P4458T1BoundaryFrame.lean | 22 +- .../P4458T1BoundaryPlacement.lean | 3 + .../P4458T1BoundarySide.lean | 6 +- .../P4458T1FirstProperRows.lean | 57 +-- .../P4458T1LargestParentRows.lean | 137 +++--- .../P4458T1RespectAppend.lean | 2 + .../P4458T1RestrictionFamily.lean | 2 + .../P4458T1SecondNewerRows.lean | 225 ++++----- .../P4458T1SmallPairRows.lean | 24 +- .../P4458T1ThirdNewerRows.lean | 23 +- .../P4536T1AFrameB.lean | 107 ++-- .../P4536T1AFrameD.lean | 51 +- .../P4536T1EndpointAlgebra.lean | 5 +- .../P4536T1EndpointDifferences.lean | 30 +- .../P4536T1HalfOffsetBridge.lean | 3 +- .../P4536T1RegularJoin.lean | 3 +- .../P4536T1SmallUnitSides.lean | 8 +- .../P4536T1TangentPairMatrix.lean | 8 +- .../P4549T1DeeperFrameB.lean | 25 +- .../P4549T1NegativeIncomingSide.lean | 5 +- .../P4564T2DiamondGeometry.lean | 10 +- .../P4564T2DiamondOrderExclusion.lean | 2 + .../P4564T2ElementaryQuarterTurn.lean | 3 +- .../P4564T2FordGeometry.lean | 12 +- .../P4564T2FordT6Transport.lean | 26 +- .../P4564T2GeneralT6Transport.lean | 5 +- .../P4564T2GeometryPullback.lean | 2 + .../P4566T1LiteralSuccessorCharts.lean | 3 +- .../P4566T1SmallPairCoordinates.lean | 2 + .../P4566T1SmallRetainedSides.lean | 5 +- .../P4566T1StrictRetainedGenealogy.lean | 3 +- .../P4566T1UnitPairCharts.lean | 11 +- .../P4590T1CentralDiskSectors.lean | 4 +- .../P4590T1JunctionRefinement.lean | 166 +++---- .../P4590T1JunctionRouting.lean | 6 +- .../P4590T1MixedCompanionMarks.lean | 11 +- .../P4590T1MixedInteriorGeometry.lean | 16 +- .../P4590T1OppositeCellsStar.lean | 3 +- .../P4590T1OriginalNonedges.lean | 4 +- .../P4590T1PositivePrototileDisk.lean | 4 +- .../P4590T1ReflectedCenterBoundary.lean | 2 + .../P4590T1RestoredBoundaryGeometry.lean | 98 ++-- .../P4590T1RightInteriorGeometry.lean | 58 +-- .../P4590T1RotationalDiskCenter.lean | 10 +- .../P4590T1SixLabelBoundaryCount.lean | 4 +- .../P4616T1FirstPredecessorCentroids.lean | 2 + .../P4616T1MixedCoarseSectors.lean | 3 +- .../P4616T1NestedCompanionFootprints.lean | 3 +- .../P4616T1OriginalMixedPaths.lean | 17 +- .../P4616T1PeriodicEndpointExclusion.lean | 2 + .../P4616T1ThirdOwnerPathEndpoint.lean | 3 +- .../P4623T1ZeroBlockExterior.lean | 2 + .../P4623T1ZeroBlockLinks.lean | 7 +- .../P4623T1ZeroBlockPaths.lean | 5 +- .../P4630T1AffineCellSymmetry.lean | 2 + .../P4630T1CellRouteLift.lean | 8 +- .../P4630T1ExteriorNeighbors.lean | 3 + .../P4630T1ExteriorWalks.lean | 4 +- .../P4630T1GridComplementCriterion.lean | 3 +- .../P4630T1ParentRotation.lean | 9 +- .../P4630T1RingIndex.lean | 4 + .../P4638T1AntipodalContactArcs.lean | 4 +- .../P4638T1ContactStarCoverage.lean | 4 +- .../P4638T1EmptyCurvature.lean | 3 +- .../P4638T1EmptyFordLocalization.lean | 16 +- .../P4638T1FordIncidentCells.lean | 5 +- .../P4638T1MidpointReflection.lean | 3 +- .../P4651T1ContactEdgeSeparation.lean | 2 + .../P4651T1CycleComplementaryArcs.lean | 4 +- .../P4651T1FreeBoundaryHalfTurn.lean | 2 + .../P4651T1GridHalfTurnTransport.lean | 3 +- .../P4670T1ComplementReflection.lean | 3 +- .../P4670T1OrdinaryEdges.lean | 2 + .../P4670T1SmallerGeometry.lean | 3 +- .../P4677T2DrawingData.lean | 5 +- .../P4677T2DrawingExists.lean | 3 +- .../P4677T2FacePoints.lean | 7 +- .../P4677T2IncidenceLedger.lean | 112 +++-- .../P4677T2PeriodicWalkAssembly.lean | 2 + .../P4677T2PrecursorWalk.lean | 4 +- .../P4677T2ThreeConnected.lean | 27 +- .../P4677T2TouchingWalk.lean | 4 +- .../ApollonianSuperharmonic/P4715T1Arc.lean | 2 + .../P4715T1BoundaryCycle.lean | 4 + .../P4715T1CoefficientEdges.lean | 7 +- .../P4715T1CoefficientFaces.lean | 20 +- .../P4715T1CoefficientTranslation.lean | 3 +- .../P4715T1FaceShift.lean | 3 + .../P4715T1Hexagon.lean | 2 + .../P4715T1HexagonSubdivision.lean | 4 +- .../P4715T1HexagonTessellation.lean | 5 +- .../P4715T1IndexAction.lean | 5 +- .../P4715T1LatticeCoordinates.lean | 5 +- .../P4715T1Offsets.lean | 3 + .../P4715T1OrbitRepresentatives.lean | 2 + .../P4715T1PatchEnumeration.lean | 5 +- .../P4715T1PatchFaces.lean | 4 + .../P4715T1PlaneMap.lean | 12 +- .../P4715T1Position.lean | 2 + .../P4715T1PositionInjective.lean | 5 +- .../P4715T1Region.lean | 2 + .../P4715T1VertexShift.lean | 3 + .../P4733T1ContainedWalk.lean | 2 + .../P4733T1Coordinates.lean | 2 + .../P4733T1EdgeOrbit.lean | 2 + .../P4733T1EdgeRow.lean | 6 +- .../P4733T1FacePairNormalForm.lean | 2 + .../P4733T1FacePairOrbit.lean | 2 + .../P4733T1OccurrenceTranslation.lean | 2 + .../P4733T1RepresentativeWalks.lean | 2 + .../P4733T1RowIncidence.lean | 6 +- .../P4733T1RowLabelRigidity.lean | 3 + .../P4733T1WalkExtension.lean | 3 +- .../P4733T1WalkTransport.lean | 3 +- .../P4780T1ActiveFacets.lean | 18 +- .../P4780T1HullHalfspaces.lean | 10 +- .../P4780T1IntegerCoverage.lean | 4 +- .../P4780T1InteriorSeparation.lean | 3 +- .../P4780T1NeighborCorners.lean | 4 +- .../P4780T1NeighborFacets.lean | 9 +- .../P4780T1OverlapBound.lean | 2 + .../P4780T1StrictInterior.lean | 3 +- .../P4783T1ParallelogramFan.lean | 9 +- .../P4783T1PatchCoordinates.lean | 4 + .../P4783T1PatchCoverage.lean | 2 + .../P4783T1PatchDeterminants.lean | 2 + .../P4793T1FacetForms.lean | 7 +- .../P4793T1PatchBoundaryTraces.lean | 2 + .../P4793T1PatchFacetLedger.lean | 3 + .../P4793T1PatchIntersections.lean | 2 + .../P4793T1PatchSeparators.lean | 3 + .../P4793T1SeparatorIntersection.lean | 2 + .../P4793T1SupportingFace.lean | 7 +- .../P4802T1CrossPatchFaces.lean | 2 + .../P4802T1HexagonOverlapSide.lean | 11 +- .../P4802T1PatchFaceRestriction.lean | 3 +- .../P4802T1SideRestriction.lean | 11 +- .../P4802T1SimplexFaces.lean | 4 +- .../P4802T1TriangleIndependent.lean | 8 +- .../P4812T1AffineDrawing.lean | 2 + .../P4812T1AffineTransport.lean | 4 +- .../P4812T1LatticeCoordinates.lean | 6 +- .../P4812T1ReflectedTouching.lean | 4 +- .../P4812T1RegularFaceWalks.lean | 11 +- .../P4818T1AffineTransversalExtension.lean | 4 +- .../P4818T1BoundaryRecovery.lean | 3 +- .../P4818T1ClosedOverlaps.lean | 4 +- .../P4818T1HalfOpen.lean | 2 + .../P4818T1OverlapDifferences.lean | 5 +- .../P4818T1Representatives.lean | 24 +- .../P4828T1CircularPlacement.lean | 5 +- .../P4828T1ConstructorSupport.lean | 2 + .../ApollonianSuperharmonic/P4828T1Disk.lean | 3 + .../P4828T1Evaluate.lean | 2 + .../P4828T1FiniteWordSeparation.lean | 6 +- .../ApollonianSuperharmonic/P4828T1Gap.lean | 5 +- .../P4828T1HistoryNormalForm.lean | 2 + .../P4828T1HistoryRealization.lean | 2 + .../P4828T1LeftRootGeometry.lean | 15 +- .../P4828T1LinePlacement.lean | 3 + .../P4828T1LineSupport.lean | 3 + .../P4828T1ParentsDistinct.lean | 2 + .../P4828T1ResidualPatches.lean | 6 +- .../P4828T1RightRootGeometry.lean | 14 +- .../ApollonianSuperharmonic/P4828T1Root.lean | 3 + .../P4828T1RootSeparation.lean | 2 + .../P4828T1Rotate.lean | 3 + .../P4828T1RotationLaws.lean | 4 + .../ApollonianSuperharmonic/P4828T1Step.lean | 3 + .../P4840T6ConstructorCovariance.lean | 2 + .../P4840T6DiamondRecurrence.lean | 2 + .../P4840T6NegatedRoot.lean | 4 +- .../P4840T6ProperGrowth.lean | 2 + .../P4840T6ShiftRoot.lean | 4 +- .../P4849T1Component.lean | 2 + .../P4849T1ComponentRestriction.lean | 2 + .../P4849T1InfiniteLimitComponent.lean | 4 +- .../P4849T1LargePositiveComponents.lean | 3 + .../P4849T1LocalLimitAdmissibility.lean | 2 + .../P4849T1MinimumTruncation.lean | 2 + .../P4849T1PeriodAnchoring.lean | 4 +- .../P4849T1PeriodResidues.lean | 5 +- .../P4849T1SetDiagonalSubsequence.lean | 5 +- .../P4903T1ScalarTangencies.lean | 7 +- .../P4903T1SignedDiskHull.lean | 5 +- .../P4909T1LineFan.lean | 2 + .../P4909T1OmittedDiskBarrier.lean | 6 +- .../P4909T1ParentEdges.lean | 8 +- .../P4909T1ParentPolygon.lean | 5 +- .../P4909T1TangentSegments.lean | 7 +- .../P4909T1TriangleFan.lean | 6 +- .../P4953T1HullHeight.lean | 4 +- .../P4953T1LiteralHulls.lean | 3 +- .../P4953T1QuadrilateralSections.lean | 6 +- .../P4953T1TriangleSections.lean | 11 +- .../P4981T1EdgePrescription.lean | 4 +- .../P4981T1EdgeRank.lean | 2 + .../P4981T1PrescriptionCoherence.lean | 3 +- .../P4981T1PrescriptionLocality.lean | 2 + .../P4981T1PrescriptionValue.lean | 2 + .../P4981T1ProperEquations.lean | 3 + .../P4981T1Recursion.lean | 3 + .../P4981T1RootEquations.lean | 3 + .../P4984T1BranchDecay.lean | 3 +- .../P4984T1ClosedGap.lean | 4 + .../P4984T1ClosedSubdivision.lean | 21 +- .../P4984T1ContactDiameter.lean | 3 +- .../P4984T1IncidentArcs.lean | 3 +- .../P4984T1RootGaps.lean | 8 +- .../P4984T1UnitIncidence.lean | 42 +- .../P4994T6Chamber.lean | 2 + .../P4994T6ChamberAdditions.lean | 3 + .../P4994T6ChartCovolume.lean | 2 + .../P4994T6NonunitBirth.lean | 9 +- .../P4994T6NonunitChamber.lean | 4 +- .../P4994T6Rotation.lean | 6 +- .../P4994T6RotationLaws.lean | 3 + .../P4994T6StepChamber.lean | 3 + .../P4994T6UnitChartRotation.lean | 2 + .../P4994T6UnitCoordinates.lean | 4 +- .../P4994T6UnitOccurrenceChamber.lean | 4 +- .../P4994T6UnitRootTable.lean | 4 +- .../P5023T1CircularEstimate.lean | 7 +- .../P5023T1CircularSide.lean | 4 + .../P5023T1ContactHull.lean | 2 + .../P5023T1ContactVertices.lean | 7 +- .../P5023T1ConvexDiameter.lean | 3 +- .../P5023T1LineEstimate.lean | 4 +- .../P5023T1LineSideGeometry.lean | 4 + .../P5050T1OmittedHullSeparation.lean | 5 +- .../P5050T1ParentSphereSection.lean | 3 + .../P5050T1RadialSection.lean | 3 +- .../P5050T1TangentLineSection.lean | 2 + .../P5050T1TangentTriangleSection.lean | 2 + .../P5064T3CrossParentSupport.lean | 2 + .../P5064T3LiteralLocalization.lean | 2 + .../P5064T3OrderedPredecessor.lean | 3 +- .../P5064T3PrecursorSupport.lean | 2 + .../P5064T3RectangleContacts.lean | 4 +- .../P5064T3Rectangles.lean | 3 + .../P5090T1TangentCircleMetric.lean | 4 +- .../P5090T1ThreeDiskContactTriangle.lean | 6 +- .../P5090T1TwoDiskLineTriangle.lean | 5 +- .../P5098T1ABIntervals.lean | 2 + .../P5098T1ACIntervals.lean | 2 + .../P5098T1ADIntervals.lean | 2 + .../P5098T1BCIntervals.lean | 2 + .../P5098T1BDIntervals.lean | 2 + .../P5098T1CDIntervals.lean | 2 + .../P5098T1EqualIntervals.lean | 2 + .../P5098T1OccurrenceSquares.lean | 14 +- .../P5098T1PeriodWindow.lean | 4 +- .../P5098T1SquareIntersection.lean | 2 + .../P5104T1CornerDeletionDisk.lean | 2 + .../P5110T1AnchoredTriples.lean | 2 + .../P5110T1ParentLocalization.lean | 31 +- .../P5110T1ParentModel.lean | 3 + .../P5110T1PositiveParentTriples.lean | 2 + .../P5110T1SquareInterface.lean | 5 +- .../P5110T1TranslationTriples.lean | 2 + .../P5116T1PredecessorDeletionDisk.lean | 4 +- .../P5116T1UnitDeletionDisk.lean | 2 + .../P5124T1BoundaryGeometry.lean | 6 +- .../P5124T1EmptyParents.lean | 8 +- .../P5124T1ParentModel.lean | 3 + .../P5124T1ParentPlacement.lean | 3 +- .../P5124T1SmallerParents.lean | 25 +- .../P5124T1TranslatedDiamonds.lean | 2 + .../P5124T1UnitParents.lean | 3 +- .../P5130T5BoundaryConsistency.lean | 3 + .../P5130T5DomainCover.lean | 3 +- .../P5130T5MixedOverlaps.lean | 16 +- .../P5130T5ParentArithmetic.lean | 9 +- .../P5130T5PeriodicExtension.lean | 12 +- .../P5130T5Prescription.lean | 6 +- .../P5130T5SameParentOverlaps.lean | 4 + .../P5130T5UnitCase.lean | 4 +- .../P5157T1AlternatingStaircase.lean | 5 +- .../P5157T1DiamondSingletonIntersections.lean | 5 +- .../P5157T1DiamondStaircaseIntersections.lean | 2 + .../P5157T1StaircasePoint.lean | 4 +- .../P5188T1CeilingBelow.lean | 5 +- .../P5188T1CeilingShift.lean | 5 +- .../P5188T1CeilingStability.lean | 5 +- .../P5188T1E1Boundary.lean | 4 +- .../P5188T1E2Boundary.lean | 3 + .../P5188T1E3E4Boundary.lean | 3 + .../P5203T1CapInterface.lean | 5 +- .../P5203T1DecreasingInterface.lean | 4 +- .../P5203T1IncreasingInterface.lean | 5 +- .../P5250T1CommonVertices.lean | 2 + .../P5250T1ConsecutiveEdges.lean | 3 + .../P5250T1RankedCommonEdges.lean | 2 + .../P5250T1SeparatedCells.lean | 2 + .../P5253T1BottomSquareContact.lean | 2 + .../P5253T1LeftSquareContacts.lean | 2 + .../P5253T1OneEdgeInterface.lean | 3 +- .../P5253T1SingletonBoundary.lean | 3 +- .../P5253T1TopSquareContacts.lean | 2 + .../P5260T1LiteralPlacement.lean | 7 +- .../P5260T1PlacementLedger.lean | 2 + .../P5260T1PredecessorInterfaces.lean | 15 +- .../P5260T1UnitInterfaces.lean | 13 +- .../P5269T1CenteredSquareTripleTransport.lean | 3 + .../P5269T1FordSquareNormalForm.lean | 3 +- .../P5269T1IncomingSquareJunctions.lean | 2 + .../P5290T1ColumnReflection.lean | 2 + .../P5290T1EqualDiamondPaths.lean | 7 +- .../P5290T1PredecessorPath.lean | 3 +- .../P5290T1RawBoundaryInterfaces.lean | 2 + .../P5290T1UnitContactPaths.lean | 20 +- .../P5300T1AffineCellObservables.lean | 2 + .../P5300T1CanonicalRowArithmetic.lean | 37 +- .../P5300T1CenteredCellGeometry.lean | 2 + .../P5327T1RightSquareJunctions.lean | 3 + .../P5332T1LiteralNormalization.lean | 7 +- .../P5332T1Parent1Rotation0Values.lean | 7 +- .../P5332T1Parent1Rotation1Values.lean | 6 +- .../P5332T1Parent1Rotation2Values.lean | 12 +- .../P5332T1Parent1Rotation3Values.lean | 6 +- .../P5332T1Parent2Rotation0Values.lean | 25 +- .../P5332T1Parent2Rotation1Values.lean | 6 +- .../P5332T1Parent2Rotation2Values.lean | 7 +- .../P5332T1Parent2Rotation3Values.lean | 9 +- .../P5332T1ParentRounding.lean | 10 +- .../P5332T1ParentRows.lean | 3 + .../P5332T1RightFirstValues.lean | 5 +- .../P5332T1RightHorizontalValues.lean | 5 +- .../P5332T1RightRounding.lean | 17 +- .../P5332T1RightRows.lean | 3 + .../P5332T1RightSecondValues.lean | 6 +- .../P5332T1SignedParentIntervals.lean | 3 +- .../P5332T1Stencil.lean | 5 +- .../P5332T1VectorPlacements.lean | 3 +- .../P5352T2DomainRows.lean | 3 +- .../P5352T2FirstUnit.lean | 6 +- .../P5352T2LiteralNormalization.lean | 3 +- .../P5352T2PlacementData.lean | 22 +- .../P5352T2Predecessor0.lean | 7 +- .../P5352T2Predecessor1.lean | 463 +++--------------- .../P5352T2Predecessor2.lean | 8 +- .../P5352T2Predecessor3.lean | 7 +- .../P5352T2RightFirst.lean | 6 +- .../P5352T2RightHorizontal.lean | 6 +- .../P5352T2RightSecond.lean | 6 +- .../P5352T2SecondUnit.lean | 6 +- .../P5352T2SourceCertificates.lean | 5 +- .../P5352T2Sources.lean | 5 +- .../P5352T2VectorPlacements.lean | 5 + .../P5416T1DiamondAxialDifferences.lean | 2 + .../P5416T1SecondUnitGeometry.lean | 3 + .../P5432T1EdgeLedger.lean | 3 +- .../P5432T1Interior.lean | 2 + .../P5432T1Normalization.lean | 3 +- .../P5435T1Cocycle.lean | 6 +- .../P5435T1PeriodGap.lean | 25 +- .../P5435T1ShellPaths.lean | 27 +- .../P5435T1WebGeometry.lean | 3 +- .../P5442T1Cocycle.lean | 3 +- .../P5442T1LaplacianBound.lean | 3 + .../P5442T1WebGeometry.lean | 3 +- .../P5448T1CanonicalFordBoundary.lean | 4 +- .../P5448T1CenteredFordGeometry.lean | 2 + .../P5448T1CommonAffineFordPair.lean | 5 +- .../P5455T2AlignedPredecessor.lean | 14 +- .../P5455T2CurvatureGrowth.lean | 2 + .../P5455T2LeftRegressions.lean | 2 + .../P5455T2OccurrenceDeterministic.lean | 11 +- .../P5455T2OccurrenceExists.lean | 2 + .../P5455T2OccurrenceRotation.lean | 2 + .../P5455T2RightRegressions.lean | 2 + .../P5455T2RootAlignment.lean | 2 + .../P5455T2WholeJoin.lean | 3 +- .../P5472T1AffineDifferenceTransport.lean | 2 + .../P5472T1CyclicAffineCommutation.lean | 2 + .../P5472T1CyclicPhaseCovariance.lean | 2 + .../P5472T1FordNormalization.lean | 25 +- .../P5472T1FordSlopeDifference.lean | 5 +- .../P5472T1LiteralFordPlacement.lean | 9 +- .../P5478T1ExteriorPlacementIndex.lean | 2 + .../P5485T1FullInterfaceMarking.lean | 3 +- .../P5485T1OtherCompanionCoordinates.lean | 2 + .../P5485T1RoutedInterfaceAvoidance.lean | 3 +- .../P5491T1AffinePairReduction.lean | 5 +- .../P5491T1DiamondParentBoundary.lean | 3 +- .../P5491T1DiamondRightBoundary.lean | 64 ++- .../P5491T1ExceptionalPresentation.lean | 4 +- .../P5491T1FordBoundarySlope.lean | 4 +- .../P5491T1FordParentBoundary.lean | 4 +- .../P5491T1FordRightBoundary.lean | 4 +- .../P5532T1FiniteOrientationGluing.lean | 4 +- .../P5532T1ForestAttachment.lean | 2 + .../P5532T1OrientationPullback.lean | 8 +- .../P5532T1OverlapNoEntry.lean | 3 +- .../P5532T1ParentInteriorGeometry.lean | 5 +- .../P5532T1RestrictionMassBalance.lean | 4 +- .../P5532T1SymmetryOrientationTransport.lean | 5 +- .../P5537T1PredecessorCoordinates.lean | 2 + .../P5537T1PredecessorValues.lean | 2 + .../P5537T1ScaledDiamondFormula.lean | 2 + .../P5537T1UnitParentBoundary.lean | 3 + .../P5570T1UnitNormalForm.lean | 3 +- .../P5570T1UnitQuadratic.lean | 2 + .../P5589T1EndpointCompatibility.lean | 5 +- .../P5589T1LinkedUnitValues.lean | 2 + .../P5589T1UnitInterfaceSelection.lean | 6 +- .../P5596T1CommonExtensionTransport.lean | 2 + .../P5596T1LeftWeb.lean | 21 +- .../P5596T1LineParent.lean | 6 +- .../P5606T1RightTerminalTransport.lean | 2 + .../P5606T1SubtileTerminalTransport.lean | 2 + ...eReachabilityAndBasepointConnectivity.lean | 4 +- .../P5620T1BoundaryComponentCycle.lean | 2 + ...25T1CentroidSlopeDifferenceCovariance.lean | 2 + ...MarkedRightOdometerAdjacencyReduction.lean | 10 +- ...0T1SymmetricMatrixPositivityCriterion.lean | 5 +- .../P5635T1EndpointDiagonalOwnership.lean | 4 +- .../P5635T1RightBoundaryInterfaceRecords.lean | 7 +- ...640T1NonpairedOccurrenceIntersections.lean | 4 +- ...ivePointDomainCoverSymmetryCovariance.lean | 2 + ...T1TriangulationBarycentricCoordinates.lean | 4 +- ...67T1CyclicChildrenOldArcsPreconnected.lean | 14 +- .../P5667T1RoundedSupportingSlope.lean | 3 + .../P5667T1StraightFrontierLocalSides.lean | 2 + .../P5682T1AlignedSquareRawInterfaces.lean | 2 + ...P5686T1UniformGlobalOdometerTransport.lean | 6 +- .../P5691T1DiamondReflectionFootprints.lean | 2 + .../P5691T1PosDefQuadraticLowerBound.lean | 2 + .../PSDQuadraticIntegerApproximation.lean | 3 +- .../ParentVectorsInTilingLattice.lean | 4 +- .../ParentalOrientationGluing.lean | 76 +-- .../PartialOdometer.lean | 2 + .../PartialOdometerAffineTranslate.lean | 2 + ...artialOdometerAffineTranslateFormulas.lean | 5 +- .../PartialOdometerHalfTurn.lean | 2 + .../PartialOdometerHalfTurnFormulas.lean | 3 +- .../PartialOdometerSlope.lean | 2 + .../PartialOdometerSquares.lean | 2 + .../PeriodicBoundaryWebConnected.lean | 10 +- .../PeriodicBoundaryWebLaplacian.lean | 23 +- .../PeriodicOdometerIndicatorRigidity.lean | 3 +- .../PeriodicQuadraticRemainder.lean | 9 +- .../PeriodicSubtileFaceIndex.lean | 3 + .../PeriodicSubtileIndex.lean | 3 + ...PeriodicTileAdjacentContactRegularity.lean | 2 + .../PeriodicTileComplex.lean | 3 +- .../PeriodicTileContactRouting.lean | 4 +- .../PeriodicTileContactRoutingRigidity.lean | 4 +- .../PeriodicTileCore.lean | 2 + .../PeriodicTileCoverage.lean | 2 + .../PeriodicTileIndexedMultiplicityOne.lean | 2 + ...eriodicTileIntersectionClassification.lean | 16 +- .../PeriodicTileIntersectionPaths.lean | 7 +- .../PeriodicTileMultiplicityOne.lean | 2 + .../PeriodicTileTotalIndegree.lean | 15 +- .../PlaneEmbeddingAgreement.lean | 2 + .../PlaneFaceOrientation.lean | 2 + .../PlaneTriangulation.lean | 9 +- .../PointwiseDiagonalCompactness.lean | 17 +- .../PositiveCurvatureGeneratorCocycles.lean | 13 +- .../PositiveCurvatureTileOdometerDomain.lean | 3 +- ...CurvatureTileOdometerSupportTransport.lean | 8 +- .../PositiveCurvatureTranslatedOdometers.lean | 39 +- .../PositiveCutCompanionRow.lean | 23 +- .../PositiveDefiniteRepresentativeGap.lean | 5 +- .../PositiveTracePackingDichotomy.lean | 3 +- .../ApollonianSuperharmonic/Preamble.lean | 13 +- .../PrecursorBoundaryArcData.lean | 4 +- .../PrimitiveVectorOrientation.lean | 2 + .../PrimitiveVectorOrientationUnique.lean | 7 +- .../ProperBandCurvatureStructure.lean | 6 +- .../ProperBandQuadruple.lean | 2 + .../ApollonianSuperharmonic/ProtoTile.lean | 2 + .../ProtoTileObservableExtensionality.lean | 3 +- .../QuadraticAffineLaplacian.lean | 2 + .../QuadraticGrowthAtInfinity.lean | 2 + .../QuarterTurnSymmetric.lean | 2 + ...QuarterTurnSymmetricCenteredTransport.lean | 7 +- ...rTurnSymmetricExactInterfaceTransport.lean | 13 +- .../QuarterTurnSymmetricOccurrence.lean | 2 + .../RealFourNeighborLaplacian.lean | 4 +- .../RealLaplacianContactComparison.lean | 2 + .../RealLaplacianLinearity.lean | 2 + .../RecursiveVectorSystem.lean | 2 + .../RecursiveVectorsExistUnique.lean | 11 +- .../RegularTileFamily.lean | 2 + .../RegularTileFamilyTranslationUnique.lean | 2 + .../RightLatticeAdjacent.lean | 3 + ...tticeAdjacentPackingSymmetryTransport.lean | 121 ++--- .../RightSubtileOdometerCompatibility.lean | 10 +- .../RootedFourNeighborForest.lean | 2 + .../SemiProperForestClassification.lean | 3 +- .../SemiProperQuadruple.lean | 3 + .../SimpleGridCycle.lean | 2 + .../SimpleGridCycleSubgraphDegreeTwo.lean | 4 +- .../SimpleGridPath.lean | 5 +- .../SimpleGridPathBetween.lean | 4 +- .../SimpleGridPathEndpointPairUnique.lean | 10 +- .../SimpleGridPathEquivariance.lean | 10 +- .../SimpleGridPathPointTrichotomy.lean | 5 +- .../SimpleGridPathVertexIncidentEdge.lean | 2 + .../SixSubtileFaceLabel.lean | 3 +- .../SixSubtileFaceVertices.lean | 4 + .../SixSubtileLabel.lean | 3 +- .../StandardSimplex.lean | 3 + .../SubtileLatticeAdjacent.lean | 3 + ...tticeAdjacentPackingSymmetryTransport.lean | 21 +- .../SubtileOccurrenceInterpretation.lean | 3 + ...ileOccurrenceInterpretationCovariance.lean | 11 +- .../SufficientBoundedMaximality.lean | 2 + .../SuperharmonicDownwardClosure.lean | 6 +- ...SwappedAffineTriangularChartAlignment.lean | 3 +- .../SymmetricMatrixCoordinateIdentity.lean | 3 + .../SymmetricMatrixCoordinates.lean | 7 +- .../TangencyCoordinateBaseTables.lean | 2 + .../TangencyCoordinateIdentity.lean | 3 +- .../TangencyCoordinateNormLaw.lean | 5 +- .../TangencyCoordinatePolarizationLaw.lean | 5 +- .../TangencyCoordinateRotation.lean | 2 + .../TangencyCoordinateSuccessorNorm.lean | 26 +- ...ngencyCoordinateSuccessorPolarization.lean | 2 + .../ThreeOwnerDesignatedOppositePair.lean | 4 +- .../ApollonianSuperharmonic/TileArea.lean | 2 + .../TileBordering.lean | 2 + .../TileCellComplement.lean | 2 + .../TileCellComplementCovariance.lean | 10 +- .../ApollonianSuperharmonic/TileCentroid.lean | 2 + .../TileDiskAreaCovariance.lean | 4 +- .../ApollonianSuperharmonic/TileHalfTurn.lean | 2 + .../TileHalfTurnFormulas.lean | 5 +- .../ApollonianSuperharmonic/TileOdometer.lean | 2 + .../TileOdometerAffineTranslation.lean | 6 +- .../TileOdometerBandPrototile.lean | 3 +- .../TileOdometerCentralSymmetry.lean | 4 +- .../TileOdometerExists.lean | 54 +- .../TileOdometerReindexedDecomposition.lean | 4 +- .../TileOdometerTranslationUniqueness.lean | 14 +- .../TileQuarterTurn.lean | 2 + .../TileQuarterTurnFormulas.lean | 16 +- .../TileRealization.lean | 2 + .../TileReflection.lean | 2 + .../TileReflectionFormulas.lean | 9 +- .../ApollonianSuperharmonic/TileString.lean | 4 +- .../TileStringCentralCovariance.lean | 14 +- .../TileStringCoordinateTransport.lean | 15 +- .../TileStringExists.lean | 3 +- ...eStringRegularFamilyCentralCovariance.lean | 19 +- .../TileStringUnique.lean | 3 +- .../TileSubodometer.lean | 2 + ...eSubodometerLiteralDecompositionPiece.lean | 5 +- .../TileT1DiskArea.lean | 11 +- .../TileT2QuarterTurn.lean | 11 +- .../TileT3TranslateTouching.lean | 12 +- .../TileT4ParentTranslateTouching.lean | 7 +- .../TileT5ParentTouching.lean | 5 +- .../ApollonianSuperharmonic/TileTouching.lean | 2 + .../TileTouchingCovariance.lean | 2 + .../TileTranslation.lean | 2 + .../TileTranslationFormulas.lean | 13 +- .../TilingLattice.lean | 2 + .../TilingLatticeBasis.lean | 12 +- .../TilingLatticeCocycleExtension.lean | 26 +- .../TilingLatticeInclusion.lean | 2 + .../TilingLatticeIndex.lean | 12 +- .../TopologicalDisk.lean | 8 +- .../TopologicalDiskExponentialLift.lean | 3 +- ...pologicalDiskGridRayCrossingIndexZero.lean | 2 + ...gicalDiskLocallyPuncturedPreconnected.lean | 3 + .../TouchingTriple.lean | 2 + .../TouchingTripleCovariance.lean | 2 + .../TouchingTriplePermutations.lean | 2 + .../TraceNonpositivePackingApproximation.lean | 3 +- .../TranslatedMinimumEnvelope.lean | 5 +- .../TriangularBoundaryStrip.lean | 2 + .../TriangularLatticeAdjacent.lean | 5 +- .../TriangularMaxIncrement.lean | 5 +- .../TriangularSignedHeight.lean | 5 +- .../TriangularStripSegment.lean | 2 + .../TriangularStripSegmentOrderInterval.lean | 3 + .../UniqueBoundedGridComplementComponent.lean | 4 +- .../UnitOccurrenceOrientation.lean | 3 +- .../UnitOccurrenceOrientationUnique.lean | 2 + .../UnitSquareOpposingStripInterfacePath.lean | 6 +- .../UnitTriangularStep.lean | 4 +- .../VectorDeterminant.lean | 45 +- .../VectorNonvanishing.lean | 36 +- .../VectorRecursionLaws.lean | 8 +- .../VectorSquareProduct.lean | 12 +- 1233 files changed, 6513 insertions(+), 5922 deletions(-) diff --git a/LeanPool/ApollonianSuperharmonic/AcyclicIndegreeOrientation.lean b/LeanPool/ApollonianSuperharmonic/AcyclicIndegreeOrientation.lean index bbd93a1439..82f5e676f3 100644 --- a/LeanPool/ApollonianSuperharmonic/AcyclicIndegreeOrientation.lean +++ b/LeanPool/ApollonianSuperharmonic/AcyclicIndegreeOrientation.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent -public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -- [TABLET NODE: AcyclicIndegreeOrientation] @@ -37,7 +38,7 @@ structure AcyclicIndegreeOrientation (D : Finset GaussianInt) /-- The chosen direction of each edge of the finite lattice graph. -/ edge : GaussianInt → GaussianInt → Prop /-- Decidable membership in the chosen directed edge relation. -/ - edge_decidable : ∀ x y, Decidable (edge x y) + edgeDecidable : ∀ x y, Decidable (edge x y) /-- A natural rank that increases strictly along each directed edge. -/ rank : GaussianInt → ℕ supported : ∀ x y, edge x y → @@ -46,7 +47,7 @@ structure AcyclicIndegreeOrientation (D : Finset GaussianInt) (edge x y ∧ ¬ edge y x) ∨ (edge y x ∧ ¬ edge x y) increasing : ∀ x y, edge x y → rank x < rank y indegree : ∀ x ∈ D, - ((D.filter fun y => @decide (edge y x) (edge_decidable y x)).card : ℤ) = σ x + ((D.filter fun y => @decide (edge y x) (edgeDecidable y x)).card : ℤ) = σ x end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean b/LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean index 993ed1dd30..93f76e2e17 100644 --- a/LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean +++ b/LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AffineTriangularCorridorStep -public import LeanPool.ApollonianSuperharmonic.TriangularStripSegmentOrderInterval +public import Mathlib.Init public import Mathlib.Data.List.Range +public import Mathlib.Topology.Basic + +public import LeanPool.ApollonianSuperharmonic.AffineTriangularCorridorStep +public import LeanPool.ApollonianSuperharmonic.AffineTriangularStrip -- [TABLET NODE: AffineOpposingStripCorridor] diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularComplexChart.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularComplexChart.lean index ee925c9841..845479272f 100644 --- a/LeanPool/ApollonianSuperharmonic/AffineTriangularComplexChart.lean +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularComplexChart.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularCorridorStep.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularCorridorStep.lean index 10c9c4c9d9..7a394785ff 100644 --- a/LeanPool/ApollonianSuperharmonic/AffineTriangularCorridorStep.lean +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularCorridorStep.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AffineTriangularFaceVertices public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularFace.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularFace.lean index 31f0aae5dd..4f9921a10e 100644 --- a/LeanPool/ApollonianSuperharmonic/AffineTriangularFace.lean +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularFace.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Algebra.Group.Prod +public import Mathlib.Algebra.Order.Ring.Int + -- [TABLET NODE: AffineTriangularFace] diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularFaceCoordinateSwap.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularFaceCoordinateSwap.lean index d4a19cb836..3490d67c3f 100644 --- a/LeanPool/ApollonianSuperharmonic/AffineTriangularFaceCoordinateSwap.lean +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularFaceCoordinateSwap.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AffineTriangularFace -- [TABLET NODE: AffineTriangularFaceCoordinateSwap] diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularFaceVertices.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularFaceVertices.lean index f63138f5cf..cdf2dc64bc 100644 --- a/LeanPool/ApollonianSuperharmonic/AffineTriangularFaceVertices.lean +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularFaceVertices.lean @@ -5,6 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Prod +public import Mathlib.Data.Finset.Card + public import LeanPool.ApollonianSuperharmonic.AffineTriangularFace -- [TABLET NODE: AffineTriangularFaceVertices] diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularNoFourfoldCellOwners.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularNoFourfoldCellOwners.lean index 2d566c248b..f45dcb034f 100644 --- a/LeanPool/ApollonianSuperharmonic/AffineTriangularNoFourfoldCellOwners.lean +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularNoFourfoldCellOwners.lean @@ -5,15 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AffineTriangularComplexChart -public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.OppositeRoutedCommonEdgeOutsideCellUnique -public import Mathlib.Tactic.Abel -- [TABLET NODE: AffineTriangularNoFourfoldCellOwners] diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean index 5d6d153ab3..ecd919ceed 100644 --- a/LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean @@ -5,18 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent -public import Mathlib.Tactic.FinCases -public import Mathlib.Tactic.NormNum -public import Mathlib.Data.List.Chain public import Mathlib.Analysis.Convex.Topology public import Mathlib.Analysis.Convex.PathConnected -public import Mathlib.Topology.Homeomorph.Lemmas -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.Ring -public import Mathlib.Tactic.FunProp -public import Mathlib.Tactic.ClearExclamation -- [TABLET NODE: AffineTriangularPlaneTriangulation] @@ -148,13 +142,16 @@ private theorem two_faces : all_goals first | solve | simp [fv, Prod.ext_iff] at h ⊢ - | simp? [fv, Prod.ext_iff] at h ⊢ + | simp only [Prod.ext_iff, Prod.fst_sub, Prod.snd_sub, Fin.isValue, + Matrix.cons_val_one, add_sub_cancel_right, Matrix.cons_val_zero, Prod.fst_add, + add_zero, Prod.snd_add, fv] at h ⊢ omega · refine ⟨⟨1, ?_⟩, ⟨2, ?_⟩⟩ all_goals first | solve | simp [fv, Prod.ext_iff] at h ⊢ - | simp? [fv, Prod.ext_iff] at h ⊢ + | simp only [Prod.ext_iff, Prod.fst_sub, Prod.snd_sub, Fin.isValue, Matrix.cons_val, + Prod.fst_add, add_zero, Prod.snd_add, fv] at h ⊢ omega · intro f i j hi hj cases f <;> fin_cases i <;> fin_cases j <;> @@ -863,7 +860,11 @@ private theorem endpoint_parameters : classical intro coord delta fraction_integer fraction_gap x y k l s t hs ht h hne fin_cases k <;> fin_cases l - all_goals simp? [delta, coord, Prod.ext_iff, smul_eq_mul] at h + all_goals simp only [Fin.mk_one, Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, + Prod.fst_add, add_zero, Prod.snd_add, Int.cast_add, Int.cast_one, Prod.mk_sub_mk, + sub_self, add_sub_cancel_left, Prod.smul_mk, smul_eq_mul, mul_zero, mul_one, + Prod.mk_add_mk, Fin.reduceFinMk, Matrix.cons_val, Prod.ext_iff, coord, delta, + Fin.zero_eta, Int.cast_inj] at h · have hx : x.1 ≠ y.1 := by intro hx have hy : x.2 = y.2 := by exact_mod_cast h.2 diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularStrip.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularStrip.lean index 1b889faf2b..7552464759 100644 --- a/LeanPool/ApollonianSuperharmonic/AffineTriangularStrip.lean +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularStrip.lean @@ -5,13 +5,15 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.TriangularStripSegment +public import Mathlib.Init public import Mathlib.Data.List.Chain public import Mathlib.Data.List.Nodup +public import Mathlib.GroupTheory.Perm.Basic public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.NormNum public import Mathlib.Tactic.Ring +public import LeanPool.ApollonianSuperharmonic.TriangularStripSegment + -- [TABLET NODE: AffineTriangularStrip] /-! diff --git a/LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidence.lean b/LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidence.lean index 64fa58e78a..d84155c7f3 100644 --- a/LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidence.lean +++ b/LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidence.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex -- [TABLET NODE: AllowedSubtileIncidence] diff --git a/LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidenceZeroOppositeChord.lean b/LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidenceZeroOppositeChord.lean index b97062c999..0fcb172244 100644 --- a/LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidenceZeroOppositeChord.lean +++ b/LeanPool/ApollonianSuperharmonic/AllowedSubtileIncidenceZeroOppositeChord.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Basic + public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence -- [TABLET NODE: AllowedSubtileIncidenceZeroOppositeChord] diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometer.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometer.lean index fbb0acbb84..097cbbd310 100644 --- a/LeanPool/ApollonianSuperharmonic/AncestorOdometer.lean +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometer.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorTile public import LeanPool.ApollonianSuperharmonic.TileOdometer diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerCentralCovariance.lean index 25883f73a5..c479c20abf 100644 --- a/LeanPool/ApollonianSuperharmonic/AncestorOdometerCentralCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerCentralCovariance.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometer public import LeanPool.ApollonianSuperharmonic.AncestorTileCentralCovariance -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerInnerSupportNormalization.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerInnerSupportNormalization.lean index 1e62e2f4a8..0a7733f683 100644 --- a/LeanPool/ApollonianSuperharmonic/AncestorOdometerInnerSupportNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerInnerSupportNormalization.lean @@ -5,11 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometer -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.TileCentroid -- [TABLET NODE: AncestorOdometerInnerSupportNormalization] diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerOuterSupportNormalization.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerOuterSupportNormalization.lean index 05b64b281b..618586b145 100644 --- a/LeanPool/ApollonianSuperharmonic/AncestorOdometerOuterSupportNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerOuterSupportNormalization.lean @@ -5,12 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometer -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.TileCentroid -- [TABLET NODE: AncestorOdometerOuterSupportNormalization] diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean index 5e35748230..d36670b181 100644 --- a/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean @@ -5,17 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometer -public import LeanPool.ApollonianSuperharmonic.AncestorTile -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision -public import LeanPool.ApollonianSuperharmonic.BandPrototile public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.PartialOdometer -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification -public import LeanPool.ApollonianSuperharmonic.TileOdometer -- [TABLET NODE: AncestorOdometerRestriction] diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerTrans.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerTrans.lean index 6be9c8a9df..e47fb264e0 100644 --- a/LeanPool/ApollonianSuperharmonic/AncestorOdometerTrans.lean +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerTrans.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometer -public import LeanPool.ApollonianSuperharmonic.AncestorTile -- [TABLET NODE: AncestorOdometerTrans] diff --git a/LeanPool/ApollonianSuperharmonic/AncestorTile.lean b/LeanPool/ApollonianSuperharmonic/AncestorTile.lean index 0f322bc6a6..317bc69cf6 100644 --- a/LeanPool/ApollonianSuperharmonic/AncestorTile.lean +++ b/LeanPool/ApollonianSuperharmonic/AncestorTile.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototile -- [TABLET NODE: AncestorTile] diff --git a/LeanPool/ApollonianSuperharmonic/AncestorTileCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/AncestorTileCentralCovariance.lean index 0045d37e50..6d1e145d8c 100644 --- a/LeanPool/ApollonianSuperharmonic/AncestorTileCentralCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/AncestorTileCentralCovariance.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorTile -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas diff --git a/LeanPool/ApollonianSuperharmonic/BandCanonicalPeriodicExtension.lean b/LeanPool/ApollonianSuperharmonic/BandCanonicalPeriodicExtension.lean index 8f0a54cc7f..b7ab3b632c 100644 --- a/LeanPool/ApollonianSuperharmonic/BandCanonicalPeriodicExtension.lean +++ b/LeanPool/ApollonianSuperharmonic/BandCanonicalPeriodicExtension.lean @@ -5,23 +5,16 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPeriodicOdometer -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.BandTileTopologyApplication -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.CircleMatrix -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm -public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.PeriodicBoundaryWebLaplacian -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -- [TABLET NODE: BandCanonicalPeriodicExtension] @@ -122,7 +115,8 @@ theorem BandCanonicalPeriodicExtension (C : BandCircle) apply hxb simp [BoundaryFootprintVertices, hn, hxa] have hfoot' := hfoot - simp? [FootprintVertices, hnonempty] at hfoot' + simp only [FootprintVertices, hnonempty, ↓reduceIte, Int.reduceNeg, Set.mem_ofPred_eq] + at hfoot' have some : x ∈ T.cells ∨ x - 1 ∈ T.cells ∨ x - 1 - ⟨0, 1⟩ ∈ T.cells ∨ x - ⟨0, 1⟩ ∈ T.cells := by rcases hfoot' with ⟨z, hz, rfl | rfl | rfl | rfl⟩ diff --git a/LeanPool/ApollonianSuperharmonic/BandCircle.lean b/LeanPool/ApollonianSuperharmonic/BandCircle.lean index a57da67b04..b0c23fd173 100644 --- a/LeanPool/ApollonianSuperharmonic/BandCircle.lean +++ b/LeanPool/ApollonianSuperharmonic/BandCircle.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle -- [TABLET NODE: BandCircle] diff --git a/LeanPool/ApollonianSuperharmonic/BandCircleEnclosureDichotomy.lean b/LeanPool/ApollonianSuperharmonic/BandCircleEnclosureDichotomy.lean index 92a5a1ebc1..35ab6b4775 100644 --- a/LeanPool/ApollonianSuperharmonic/BandCircleEnclosureDichotomy.lean +++ b/LeanPool/ApollonianSuperharmonic/BandCircleEnclosureDichotomy.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandDiskExteriorDensity public import LeanPool.ApollonianSuperharmonic.BandTangencyDensity -public import LeanPool.ApollonianSuperharmonic.EuclideanCircleData -- [TABLET NODE: BandCircleEnclosureDichotomy] diff --git a/LeanPool/ApollonianSuperharmonic/BandCircleEuclideanData.lean b/LeanPool/ApollonianSuperharmonic/BandCircleEuclideanData.lean index edfaf10394..c4830a4722 100644 --- a/LeanPool/ApollonianSuperharmonic/BandCircleEuclideanData.lean +++ b/LeanPool/ApollonianSuperharmonic/BandCircleEuclideanData.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandCircle public import LeanPool.ApollonianSuperharmonic.EuclideanCircleData diff --git a/LeanPool/ApollonianSuperharmonic/BandDescartesGapSubdivision.lean b/LeanPool/ApollonianSuperharmonic/BandDescartesGapSubdivision.lean index d422353af6..9fabd2909f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandDescartesGapSubdivision.lean +++ b/LeanPool/ApollonianSuperharmonic/BandDescartesGapSubdivision.lean @@ -5,10 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import Mathlib.Analysis.Complex.Basic -- [TABLET NODE: BandDescartesGapSubdivision] diff --git a/LeanPool/ApollonianSuperharmonic/BandDiskExteriorDensity.lean b/LeanPool/ApollonianSuperharmonic/BandDiskExteriorDensity.lean index 6a98d55e51..087bd7e9bb 100644 --- a/LeanPool/ApollonianSuperharmonic/BandDiskExteriorDensity.lean +++ b/LeanPool/ApollonianSuperharmonic/BandDiskExteriorDensity.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandDescartesGapSubdivision +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingExterior public import LeanPool.ApollonianSuperharmonic.BandOrientedGapRefinementExists +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: BandDiskExteriorDensity] diff --git a/LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean b/LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean index 5a5ab7a136..f947077587 100644 --- a/LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean +++ b/LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean @@ -5,16 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototile public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.BandParentBoundaryGenealogy -public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws @@ -159,8 +157,10 @@ private theorem rotatedT5 : have huy := congrArg Prod.snd hu have hvx := congrArg Prod.fst hv have hvy := congrArg Prod.snd hv - simp? [Function.iterate_succ_apply', GaussianRealPoint, GaussianQuarterTurn] - at hux huy hvx hvy + simp only [Prod.fst_sub, one_div, GaussianRealPoint, Int.reduceNeg, Fin.isValue, + Function.iterate_succ_apply', GaussianQuarterTurn, Int.cast_neg, + GaussianInt.intCast_im, GaussianInt.intCast_re, Prod.mk_add_mk, Prod.smul_mk, + smul_eq_mul, Prod.snd_sub, Prod.mk_sub_mk, sub_neg_eq_add] at hux huy hvx hvy have h : TouchingTriple T' U' V' := by apply ih T' U' V' hT' hU' hV' · apply Prod.ext <;> simp [GaussianRealPoint] <;> @@ -959,9 +959,22 @@ theorem BandDoubleDecomposition : have s1y := congrArg Prod.snd cs1 have s2x := congrArg Prod.fst cs2 have s2y := congrArg Prod.snd cs2 - simp? [GaussianRealPoint] at p0x p0y m0x m0y p1x p1y m1x m1y - simp? [GaussianRealPoint, hc] at p2x p2y m2x m2y q0x q0y s0x s0y - simp? [GaussianRealPoint, hd, he, hc, I] at q1x q1y q2x q2y s1x s1y s2x s2y + simp only [Fin.isValue, Prod.fst_sub, one_div, GaussianRealPoint, Int.reduceNeg, + GaussianInt.intCast_re, GaussianInt.intCast_im, Prod.mk_sub_mk, sub_neg_eq_add, + Prod.smul_mk, smul_eq_mul, one_smul, Prod.snd_sub, neg_smul, Prod.neg_mk] + at p0x p0y m0x m0y p1x p1y m1x m1y + simp only [Fin.isValue, Prod.fst_sub, one_div, GaussianRealPoint, Int.reduceNeg, hc, + Zsqrtd.re_sub, Zsqrtd.re_neg, Int.cast_sub, Int.cast_neg, GaussianInt.intCast_re, + Zsqrtd.im_sub, Zsqrtd.im_neg, GaussianInt.intCast_im, neg_sub, sub_neg_eq_add, + Prod.mk_sub_mk, Prod.smul_mk, smul_eq_mul, one_smul, Prod.snd_sub, neg_smul, + Prod.neg_mk] at p2x p2y m2x m2y q0x q0y s0x s0y + simp only [Fin.isValue, Prod.fst_sub, one_div, GaussianRealPoint, Int.reduceNeg, hd, + Zsqrtd.re_sub, Zsqrtd.re_mul, zero_mul, mul_one, neg_mul, one_mul, zero_add, + sub_neg_eq_add, Int.cast_add, GaussianInt.intCast_re, GaussianInt.intCast_im, + Zsqrtd.im_sub, Zsqrtd.im_mul, Int.cast_sub, neg_sub, Prod.mk_sub_mk, Prod.smul_mk, + smul_eq_mul, one_smul, Prod.snd_sub, he, hc, Zsqrtd.re_add, Zsqrtd.re_neg, Int.cast_neg, + Zsqrtd.im_add, Zsqrtd.im_neg, neg_add_rev, neg_smul, Prod.neg_mk, I] + at q1x q1y q2x q2y s1x s1y s2x s2y have qcenter : TileCentroid (Q 0 false) = x := by apply Prod.ext · linarith only [p0x, q0x] diff --git a/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean b/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean index 5337d34bdd..de2dc71485 100644 --- a/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean +++ b/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean @@ -5,41 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration -public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoreCertificate -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary -public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments public import LeanPool.ApollonianSuperharmonic.ExceptionalRestorationSectorData -public import LeanPool.ApollonianSuperharmonic.FordTileGeometry -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors -public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.TileCellComplement -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TileRealization -public import LeanPool.ApollonianSuperharmonic.TileTouching -public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.TopologicalDisk -public import LeanPool.ApollonianSuperharmonic.TouchingTriple -- [TABLET NODE: BandExceptionalRestorationSectorOrder] @@ -412,7 +382,7 @@ private theorem hOC : (Disjoint A.cells C.cells) → (Disjoint O.cells C.cells) ) := by classical intro q cfg C₀ T cert A C O hAC - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments apply Finset.disjoint_left.mpr intro x hxO hxC exact Finset.disjoint_left.mp hAC (seg.precursor_in_left hxO) hxC @@ -430,7 +400,7 @@ private theorem hOD : (Disjoint A.cells D.cells) → (Disjoint O.cells D.cells) ) := by classical intro q cfg C₀ T cert A D O hAD - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments apply Finset.disjoint_left.mpr intro x hxO hxD exact Finset.disjoint_left.mp hAD (seg.precursor_in_left hxO) hxD @@ -704,7 +674,7 @@ private theorem cutData : let O := cert.O let Q := cert.Q 1 true let S := cert.S 2 false - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (LatticeTile Q) → ((LatticeTile S) → ((O.cells.Nonempty → LatticeTile O) → ((Finset.Nonempty Q.cells) → ((Finset.Nonempty S.cells) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → (BoundaryFootprintVertices U ⊆ FootprintVertices U)) → @@ -748,7 +718,7 @@ private theorem cutDataR : let O := cert.O let R := cert.Q 2 true let V := cert.S 1 false - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (LatticeTile R) → ((LatticeTile V) → ((O.cells.Nonempty → LatticeTile O) → ((Finset.Nonempty R.cells) → ((Finset.Nonempty V.cells) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → (BoundaryFootprintVertices U ⊆ FootprintVertices U)) → @@ -781,7 +751,7 @@ private theorem cutNoC : let O := cert.O let Q := cert.Q 1 true let S := cert.S 2 false - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (Disjoint O.cells C.cells) → ((Disjoint Q.cells C.cells) → ((Disjoint S.cells C.cells) → (((O.cells.Nonempty) → ((∀ j : Fin 4, LatticeVertexIncidentCell seg.a j ∈ Q.cells ∨ LatticeVertexIncidentCell seg.a j ∈ S.cells ∨ LatticeVertexIncidentCell seg.a j ∈ @@ -810,7 +780,7 @@ private theorem cutNoD : let O := cert.O let R := cert.Q 2 true let V := cert.S 1 false - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (Disjoint O.cells D.cells) → ((Disjoint R.cells D.cells) → ((Disjoint V.cells D.cells) → (((O.cells.Nonempty) → ((∀ j : Fin 4, LatticeVertexIncidentCell seg.b j ∈ R.cells ∨ LatticeVertexIncidentCell seg.b j ∈ V.cells ∨ LatticeVertexIncidentCell seg.b j ∈ @@ -842,7 +812,7 @@ private theorem cuts_ne_marked : (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) let p2 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell p1 j ∈ C.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell p2 j ∈ D.cells) → (((O.cells.Nonempty) → (∀ (j : Fin 4), LatticeVertexIncidentCell seg.a j ∉ C.cells)) → (((O.cells.Nonempty) → (∀ (j : Fin @@ -912,7 +882,7 @@ private theorem leftInternal : let S := cert.S 2 false let p1 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (LatticeTile Q) → ((LatticeTile S) → ((Disjoint Q.cells S.cells) → ((∀ (l : List GaussianInt), ∀ (x : GaussianInt), ∀ (h : GaussianInt), ∀ (t : GaussianInt), l.Nodup → l.head? = some h → l.getLast? = some t → x ∈ l → x ≠ h → x ≠ t → ∃ pre y z post, l @@ -963,7 +933,7 @@ private theorem rightInternal : let V := cert.S 1 false let p2 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (LatticeTile R) → ((LatticeTile V) → ((Disjoint R.cells V.cells) → ((∀ (l : List GaussianInt), ∀ (x : GaussianInt), ∀ (h : GaussianInt), ∀ (t : GaussianInt), l.Nodup → l.head? = some h → l.getLast? = some t → x ∈ l → x ≠ h → x ≠ t → ∃ pre y z post, l @@ -1011,7 +981,7 @@ private theorem middleInternal : LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ Y.cells) → ( let A := cert.P 0 true let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (O.cells.Nonempty → LatticeTile O) → ((∀ (l : List GaussianInt), ∀ (x : GaussianInt), ∀ (h : GaussianInt), ∀ (t : GaussianInt), l.Nodup → l.head? = some h → l.getLast? = some t → x ∈ l → x ≠ h → x ≠ t → ∃ pre y z post, l = pre ++ y :: x :: z :: post) → (∀ @@ -1063,7 +1033,7 @@ private theorem middleRestored : C₀ T), let A := cert.P 0 true let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (∀ (x : GaussianInt), (x ∈ seg.middle) → ((x ≠ seg.a) → ((x ≠ seg.b) → ((∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ (TileCellComplement A O).cells ∨ LatticeVertexIncidentCell x j ∈ O.cells) ∧ O.cells.Nonempty)))) → (∀ (x : @@ -1085,7 +1055,7 @@ private theorem middleWalkEdge : let A := cert.P 0 true let B := cert.P 0 false let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (∀ (l : List GaussianInt), ∀ (x : GaussianInt), ∀ (h : GaussianInt), ∀ (t : GaussianInt), l.Nodup → l.head? = some h → l.getLast? = some t → x ∈ l → x ≠ h → x ≠ t → ∃ pre y z post, l = pre ++ y :: x :: z :: post) → (∀ (x : GaussianInt), (x ∈ seg.middle) → ((x @@ -1160,33 +1130,33 @@ private theorem sectorOrderCertificate : Disjoint (cert.Q (1 : Fin (3 : ℕ)) true).cells cert.O.cells) → ((Finset.Nonempty cert.O.cells → Disjoint (cert.Q (2 : Fin (3 : ℕ)) true).cells cert.O.cells) → ((Finset.Nonempty cert.O.cells → (∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptional_segments.a j ∈ (cert.Q (1 : Fin (3 : ℕ)) true).cells ∨ - LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S (2 : Fin (3 : ℕ)) - false).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ + cert.exceptionalSegments.a j ∈ (cert.Q (1 : Fin (3 : ℕ)) true).cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.S (2 : Fin (3 : ℕ)) + false).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ cert.O.cells) ∧ (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptional_segments.a j ∈ cert.O.cells) ∧ ((∃ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.Q (1 : Fin (3 : ℕ)) - true).cells ∧ LatticeVertexIncidentCell cert.exceptional_segments.a (j + (2 : Fin (4 + cert.exceptionalSegments.a j ∈ cert.O.cells) ∧ ((∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.Q (1 : Fin (3 : ℕ)) + true).cells ∧ LatticeVertexIncidentCell cert.exceptionalSegments.a (j + (2 : Fin (4 : ℕ))) ∈ (cert.S (2 : Fin (3 : ℕ)) false).cells) ∨ (∃ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.Q (1 : Fin (3 : ℕ)) - true).cells ∧ LatticeVertexIncidentCell cert.exceptional_segments.a (j + (2 : Fin (4 + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.Q (1 : Fin (3 : ℕ)) + true).cells ∧ LatticeVertexIncidentCell cert.exceptionalSegments.a (j + (2 : Fin (4 : ℕ))) ∈ cert.O.cells) ∨ ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptional_segments.a j ∈ (cert.S (2 : Fin (3 : ℕ)) false).cells ∧ - LatticeVertexIncidentCell cert.exceptional_segments.a (j + (2 : Fin (4 : ℕ))) ∈ + cert.exceptionalSegments.a j ∈ (cert.S (2 : Fin (3 : ℕ)) false).cells ∧ + LatticeVertexIncidentCell cert.exceptionalSegments.a (j + (2 : Fin (4 : ℕ))) ∈ cert.O.cells)) → ((Finset.Nonempty cert.O.cells → (∀ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q (2 : Fin (3 : ℕ)) - true).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S (1 : - Fin (3 : ℕ)) false).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q (2 : Fin (3 : ℕ)) + true).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S (1 : + Fin (3 : ℕ)) false).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ cert.O.cells) ∧ (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptional_segments.b j ∈ cert.O.cells) ∧ ((∃ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q (2 : Fin (3 : ℕ)) - true).cells ∧ LatticeVertexIncidentCell cert.exceptional_segments.b (j + (2 : Fin (4 + cert.exceptionalSegments.b j ∈ cert.O.cells) ∧ ((∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q (2 : Fin (3 : ℕ)) + true).cells ∧ LatticeVertexIncidentCell cert.exceptionalSegments.b (j + (2 : Fin (4 : ℕ))) ∈ (cert.S (1 : Fin (3 : ℕ)) false).cells) ∨ (∃ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q (2 : Fin (3 : ℕ)) - true).cells ∧ LatticeVertexIncidentCell cert.exceptional_segments.b (j + (2 : Fin (4 + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q (2 : Fin (3 : ℕ)) + true).cells ∧ LatticeVertexIncidentCell cert.exceptionalSegments.b (j + (2 : Fin (4 : ℕ))) ∈ cert.O.cells) ∨ ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptional_segments.b j ∈ (cert.S (1 : Fin (3 : ℕ)) false).cells ∧ - LatticeVertexIncidentCell cert.exceptional_segments.b (j + (2 : Fin (4 : ℕ))) ∈ + cert.exceptionalSegments.b j ∈ (cert.S (1 : Fin (3 : ℕ)) false).cells ∧ + LatticeVertexIncidentCell cert.exceptionalSegments.b (j + (2 : Fin (4 : ℕ))) ∈ cert.O.cells)) → ((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell p1 j ∈ Q.cells ∨ LatticeVertexIncidentCell p1 j ∈ S.cells ∨ LatticeVertexIncidentCell p1 j ∈ C.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell p1 j ∈ C.cells) → (((∃ (j : Fin (4 @@ -1203,25 +1173,25 @@ private theorem sectorOrderCertificate : : Fin (4 : ℕ))) ∈ D.cells) ∨ ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell p2 j ∈ V.cells ∧ LatticeVertexIncidentCell p2 (j + (2 : Fin (4 : ℕ))) ∈ D.cells) → ((Finset.Nonempty cert.O.cells → ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptional_segments.a j ∉ (cert.P (1 : Fin (3 : ℕ)) true).cells) → + cert.exceptionalSegments.a j ∉ (cert.P (1 : Fin (3 : ℕ)) true).cells) → ((Finset.Nonempty cert.O.cells → ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptional_segments.b j ∉ (cert.P (1 : Fin (3 : ℕ)) false).cells) → - ((Finset.Nonempty cert.O.cells → cert.exceptional_segments.a ≠ + cert.exceptionalSegments.b j ∉ (cert.P (1 : Fin (3 : ℕ)) false).cells) → + ((Finset.Nonempty cert.O.cells → cert.exceptionalSegments.a ≠ cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I1, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileFaceIndex)) ∧ cert.exceptional_segments.b ≠ cert.unmodified.core.rho + PeriodicSubtileFaceIndex)) ∧ cert.exceptionalSegments.b ≠ cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileFaceIndex))) → ((∀ x ∈ cert.exceptional_segments.left, x ≠ + PeriodicSubtileFaceIndex))) → ((∀ x ∈ cert.exceptionalSegments.left, x ≠ cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I1, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileFaceIndex)) → x ≠ cert.exceptional_segments.a → (∀ (j : Fin (4 : ℕ)), + PeriodicSubtileFaceIndex)) → x ≠ cert.exceptionalSegments.a → (∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ (cert.Q (1 : Fin (3 : ℕ)) true).cells ∨ LatticeVertexIncidentCell x j ∈ (cert.S (2 : Fin (3 : ℕ)) false).cells) ∧ ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ (cert.Q (1 : Fin (3 : ℕ)) true).cells ∧ LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ (cert.S (2 : Fin (3 : ℕ)) - false).cells) → ((∀ x ∈ cert.exceptional_segments.right, x ≠ - cert.exceptional_segments.b → x ≠ cert.unmodified.core.rho + false).cells) → ((∀ x ∈ cert.exceptionalSegments.right, x ≠ + cert.exceptionalSegments.b → x ≠ cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → (∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ @@ -1229,10 +1199,10 @@ private theorem sectorOrderCertificate : Fin (3 : ℕ)) false).cells) ∧ ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ (cert.Q (2 : Fin (3 : ℕ)) true).cells ∧ LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ (cert.S (1 : Fin (3 : ℕ)) false).cells) → ((∀ x ∈ - cert.exceptional_segments.middle, x ≠ cert.exceptional_segments.a → x ≠ - cert.exceptional_segments.b → ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ - (cert.P (0 : Fin (3 : ℕ)) true).cells) → ((∀ x ∈ cert.exceptional_segments.middle, x - ≠ cert.exceptional_segments.a → x ≠ cert.exceptional_segments.b → ∃ (e : Finset + cert.exceptionalSegments.middle, x ≠ cert.exceptionalSegments.a → x ≠ + cert.exceptionalSegments.b → ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ + (cert.P (0 : Fin (3 : ℕ)) true).cells) → ((∀ x ∈ cert.exceptionalSegments.middle, x + ≠ cert.exceptionalSegments.a → x ≠ cert.exceptionalSegments.b → ∃ (e : Finset GaussianInt), x ∈ e ∧ e ∈ FootprintEdges (TileCellComplement (cert.P (0 : Fin (3 : ℕ)) true) cert.O) ∩ FootprintEdges (cert.P (0 : Fin (3 : ℕ)) false) ∧ Finset.Nonempty (TileCellComplement (cert.P (0 : Fin (3 : ℕ)) true) cert.O).cells) → @@ -1240,13 +1210,13 @@ private theorem sectorOrderCertificate : true) (cert.S 2 false) (cert.Q 2 true) (cert.S 1 false) (cert.P 1 true) (cert.P 1 false) (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩)) - cert.exceptional_segments))))))))))))))))))))))))))))))) ) := by + cert.exceptionalSegments))))))))))))))))))))))))))))))) ) := by classical intro q cfg C₀ T cert A B C D O Q S R V p1 p2 hBne hQne hSne hRne hVne hQSC hRVD hcompB hQC hSC hRD hVD footprint_incident boundary_missing_incident hQO hRO cutData cutDataR hmark1cover hmark1C hmark1opp hmark2cover hmark2D hmark2opp cutNoC cutNoD cuts_ne_marked leftInternal rightInternal middleRestored middleWalkEdge - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments refine { left_opposite := by intro x hx guard hNoC hNoO @@ -1442,7 +1412,7 @@ theorem BandExceptionalRestorationSectorOrder (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩)) - cert.exceptional_segments := by + cert.exceptionalSegments := by -- BODY classical obtain ⟨three_owner_sectors, two_owner_sectors⟩ := @@ -1460,7 +1430,7 @@ theorem BandExceptionalRestorationSectorOrder (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) let p2 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments have tile_from_band := RestorationSectorGeometry.tile_from_band have hQ := RestorationSectorGeometry.hQ q cfg C₀ T cert tile_from_band have hS := RestorationSectorGeometry.hS q cfg C₀ T cert tile_from_band @@ -1571,7 +1541,7 @@ theorem BandExceptionalRestorationSectorOrder (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) (cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩)) - cert.exceptional_segments := RestorationSectorCertificate.sectorOrderCertificate q cfg C₀ T + cert.exceptionalSegments := RestorationSectorCertificate.sectorOrderCertificate q cfg C₀ T cert hBne hQne hSne hRne hVne hQSC hRVD hcompB hQC hSC hRD hVD footprint_incident boundary_missing_incident hQO hRO cutData cutDataR hmark1cover hmark1C hmark1opp hmark2cover hmark2D hmark2opp cutNoC cutNoD cuts_ne_marked leftInternal rightInternal diff --git a/LeanPool/ApollonianSuperharmonic/BandGenealogy.lean b/LeanPool/ApollonianSuperharmonic/BandGenealogy.lean index 7d7a3eecfe..09f168a905 100644 --- a/LeanPool/ApollonianSuperharmonic/BandGenealogy.lean +++ b/LeanPool/ApollonianSuperharmonic/BandGenealogy.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandCircle public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification -public import LeanPool.ApollonianSuperharmonic.Preamble -- [TABLET NODE: BandGenealogy] diff --git a/LeanPool/ApollonianSuperharmonic/BandGeneralCircle.lean b/LeanPool/ApollonianSuperharmonic/BandGeneralCircle.lean index 11470d4c45..9d4f29f695 100644 --- a/LeanPool/ApollonianSuperharmonic/BandGeneralCircle.lean +++ b/LeanPool/ApollonianSuperharmonic/BandGeneralCircle.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -- [TABLET NODE: BandGeneralCircle] diff --git a/LeanPool/ApollonianSuperharmonic/BandInterfaceRootedForest.lean b/LeanPool/ApollonianSuperharmonic/BandInterfaceRootedForest.lean index 7800ceeaea..f3e55fdda8 100644 --- a/LeanPool/ApollonianSuperharmonic/BandInterfaceRootedForest.lean +++ b/LeanPool/ApollonianSuperharmonic/BandInterfaceRootedForest.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOdometerInteriorTable public import LeanPool.ApollonianSuperharmonic.PeriodicTileTotalIndegree public import LeanPool.ApollonianSuperharmonic.P4250T2InterfaceCycleExclusion @@ -78,7 +80,7 @@ theorem BandInterfaceRootedForest @decide (∃ i s, x ∈ (hs i s).domain ∧ x ∉ BoundaryFootprintVertices (cert.P i s)) (Classical.propDecidable _) let W := D \ P - let R : Finset GaussianInt := {cert.precursor_boundary.a, cert.precursor_boundary.b} + let R : Finset GaussianInt := {cert.precursorBoundary.a, cert.precursorBoundary.b} have hD : ∀ x, x ∈ D ↔ x ∈ FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T := by intro x diff --git a/LeanPool/ApollonianSuperharmonic/BandLatticeEquality.lean b/LeanPool/ApollonianSuperharmonic/BandLatticeEquality.lean index 382dbd4f5b..a9273c4379 100644 --- a/LeanPool/ApollonianSuperharmonic/BandLatticeEquality.lean +++ b/LeanPool/ApollonianSuperharmonic/BandLatticeEquality.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.IntegralityLatticeIndex -- [TABLET NODE: BandLatticeEquality] diff --git a/LeanPool/ApollonianSuperharmonic/BandModifiedCellPartition.lean b/LeanPool/ApollonianSuperharmonic/BandModifiedCellPartition.lean index 866ee05987..2ced86a1f1 100644 --- a/LeanPool/ApollonianSuperharmonic/BandModifiedCellPartition.lean +++ b/LeanPool/ApollonianSuperharmonic/BandModifiedCellPartition.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeFundamentalSet public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.TileArea diff --git a/LeanPool/ApollonianSuperharmonic/BandModifiedCoverage.lean b/LeanPool/ApollonianSuperharmonic/BandModifiedCoverage.lean index 238b8537f7..dac2546856 100644 --- a/LeanPool/ApollonianSuperharmonic/BandModifiedCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/BandModifiedCoverage.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandModifiedUnionEquality public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoverage diff --git a/LeanPool/ApollonianSuperharmonic/BandModifiedOrbitArea.lean b/LeanPool/ApollonianSuperharmonic/BandModifiedOrbitArea.lean index f0572a3167..a42be2bdcc 100644 --- a/LeanPool/ApollonianSuperharmonic/BandModifiedOrbitArea.lean +++ b/LeanPool/ApollonianSuperharmonic/BandModifiedOrbitArea.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.TileArea +public import LeanPool.ApollonianSuperharmonic.TileCellComplement -- [TABLET NODE: BandModifiedOrbitArea] diff --git a/LeanPool/ApollonianSuperharmonic/BandModifiedPeriodicComplex.lean b/LeanPool/ApollonianSuperharmonic/BandModifiedPeriodicComplex.lean index c1a42410c0..e922cc9e05 100644 --- a/LeanPool/ApollonianSuperharmonic/BandModifiedPeriodicComplex.lean +++ b/LeanPool/ApollonianSuperharmonic/BandModifiedPeriodicComplex.lean @@ -5,18 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandModifiedCellPartition +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoreCertificate public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex -public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -public import LeanPool.ApollonianSuperharmonic.TileRealization public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: BandModifiedPeriodicComplex] diff --git a/LeanPool/ApollonianSuperharmonic/BandModifiedUnionEquality.lean b/LeanPool/ApollonianSuperharmonic/BandModifiedUnionEquality.lean index 7b5090aa75..f7f3ad1b7a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandModifiedUnionEquality.lean +++ b/LeanPool/ApollonianSuperharmonic/BandModifiedUnionEquality.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: BandModifiedUnionEquality] diff --git a/LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean b/LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean index b1313732fd..90bddde7af 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean @@ -5,13 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4120T1RootNormalization public import LeanPool.ApollonianSuperharmonic.P4120T1AffineComparison public import LeanPool.ApollonianSuperharmonic.P4120T1FordGeometry public import LeanPool.ApollonianSuperharmonic.P4120T1DiamondGeometry -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization public import LeanPool.ApollonianSuperharmonic.P4120T1GeneralRowData public import LeanPool.ApollonianSuperharmonic.P4120T1GeneralDescent public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorStarClassification @@ -20,10 +19,6 @@ public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNestedRightOdom public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLargestParentOdometerRows public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPositiveCutOdometerRows public import LeanPool.ApollonianSuperharmonic.FordCenteredInteriorOdometerStencil -public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction -public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable -public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction -public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable -- [TABLET NODE: BandOdometerInteriorTable] diff --git a/LeanPool/ApollonianSuperharmonic/BandOdometerMaximality.lean b/LeanPool/ApollonianSuperharmonic/BandOdometerMaximality.lean index 2ee309309b..6dd5e83cc6 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOdometerMaximality.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOdometerMaximality.lean @@ -5,13 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPeriodicSuperharmonicity -public import LeanPool.ApollonianSuperharmonic.BandGenealogy -public import LeanPool.ApollonianSuperharmonic.PeriodicBoundaryWebLaplacian +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicOdometerIndicatorRigidity public import LeanPool.ApollonianSuperharmonic.SufficientBoundedMaximality public import LeanPool.ApollonianSuperharmonic.TilingLattice -public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis -- [TABLET NODE: BandOdometerMaximality] diff --git a/LeanPool/ApollonianSuperharmonic/BandOdometerTheorem.lean b/LeanPool/ApollonianSuperharmonic/BandOdometerTheorem.lean index ea4706fc0a..a14c24b709 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOdometerTheorem.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOdometerTheorem.lean @@ -5,14 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.FordTileGeometry +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandLatticeEquality public import LeanPool.ApollonianSuperharmonic.BandOdometerMaximality -public import LeanPool.ApollonianSuperharmonic.BandPeriodicOdometer public import LeanPool.ApollonianSuperharmonic.BandPeriodicSuperharmonicity -public import LeanPool.ApollonianSuperharmonic.BandTileTopologyApplication -public import LeanPool.ApollonianSuperharmonic.CurvatureOneTileBase -- [TABLET NODE: BandOdometerTheorem] @@ -141,7 +139,9 @@ theorem BandOdometerTheorem : ∀ C : BandCircle, · simp [sub_eq_add_neg] · intro V hV hy rcases hV with ⟨a, ha, rfl⟩ - simp? [TileTranslation, GaussianTranslation] at hy ⊢ + simp only [TileTranslation, Finset.image_singleton, GaussianTranslation, + Finset.mem_singleton, add_sub_cancel, ProtoTile.mk.injEq, + Finset.singleton_inj, add_right_inj] at hy ⊢ obtain rfl := hy constructor · rfl diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralAggregatePatches.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralAggregatePatches.lean index 1863364e1b..2090f371b2 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralAggregatePatches.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralAggregatePatches.lean @@ -5,15 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch -public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex -public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex -public import LeanPool.ApollonianSuperharmonic.ProtoTile public import LeanPool.ApollonianSuperharmonic.P3161T1AggregateInducedConnectivity public import LeanPool.ApollonianSuperharmonic.P3161T1AggregateComplementConnectivity -public import Mathlib.Data.List.Chain -- [TABLET NODE: BandOrderedGeneralAggregatePatches] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean index e0ef3f4009..418fe0d0c7 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean @@ -5,33 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralAggregatePatches -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMixedAggregatePatches public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleRetargetMiddle -public import LeanPool.ApollonianSuperharmonic.FinitePatchTopology -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation -public import LeanPool.ApollonianSuperharmonic.LatticeTileThreeDiskJunction -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricExactInterfaceTransport -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance -public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.TileCellComplement -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandOrderedGeneralChildInterfaces] @@ -298,7 +279,9 @@ private theorem blockEq : · rintro ⟨a, ha, hx⟩ have hcoords : a.first = m ∧ a.second = n := by cases a with - | mk l r s => cases l <;> simp? [K] at ha <;> exact ha + | mk l r s => cases l <;> simp only [Finset.mem_insert, PeriodicSubtileIndex.mk.injEq, + reduceCtorEq, false_and, Finset.mem_singleton, true_and, false_or, K, or_false, + or_self] at ha <;> exact ha have haeq : a = ⟨a.label, m, n⟩ := by cases a with | mk l r s => diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralConfiguration.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralConfiguration.lean index 8c2ee28a92..5bc2baf85d 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralConfiguration.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralConfiguration.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandVectors -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -- [TABLET NODE: BandOrderedGeneralConfiguration] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralFinitePatches.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralFinitePatches.lean index e9f472ccca..ee53c5feb1 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralFinitePatches.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralFinitePatches.lean @@ -5,14 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.ConsecutivePatchInterface -public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch -public import LeanPool.ApollonianSuperharmonic.TileCellComplement public import LeanPool.ApollonianSuperharmonic.P4623T1ZeroBlockPaths public import LeanPool.ApollonianSuperharmonic.P4623T1ZeroBlockExterior public import LeanPool.ApollonianSuperharmonic.P4623T1ZeroBlockLinks -public import Mathlib.Data.List.Chain -- [TABLET NODE: BandOrderedGeneralFinitePatches] @@ -197,9 +196,9 @@ theorem BandOrderedGeneralFinitePatches length := n positive := hn neighbor := N - face := cert.modified_face_equiv.symm ∘ F + face := cert.modifiedFaceEquivalence.symm ∘ F neighbor_injective := hN - face_injective := cert.modified_face_equiv.symm.injective.comp hF + face_injective := cert.modifiedFaceEquivalence.symm.injective.comp hF neighbors_exact := ?_ consecutive_faces := ?_ }⟩⟩ diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean index 1ce34ddd8e..f0d1f72ec2 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean @@ -5,39 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidenceZeroOppositeChord -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices public import LeanPool.ApollonianSuperharmonic.ExactPatchBoundaryInterface -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch -public import LeanPool.ApollonianSuperharmonic.FinitePatchTopology -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.LatticeTileDiskUnionInterface -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex -public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PeriodicTileAdjacentContactRegularity -public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex -public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore -public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween -public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -public import LeanPool.ApollonianSuperharmonic.TileCellComplement -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -- [TABLET NODE: BandOrderedGeneralGeometricSectors] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorStarClassification.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorStarClassification.lean index d1b39a37a7..15c88db789 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorStarClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorStarClassification.lean @@ -5,21 +5,17 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorWebRow -public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn -public import LeanPool.ApollonianSuperharmonic.P4055T1BandQuarterTurn -public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry -public import LeanPool.ApollonianSuperharmonic.P4590T1CentralDiskSectors public import LeanPool.ApollonianSuperharmonic.P4590T1OriginalNonedges public import LeanPool.ApollonianSuperharmonic.P4590T1ReflectedCenterBoundary public import LeanPool.ApollonianSuperharmonic.P4590T1SixLabelBoundaryCount public import LeanPool.ApollonianSuperharmonic.P4590T1MixedInteriorGeometry public import LeanPool.ApollonianSuperharmonic.P4590T1RightInteriorGeometry public import LeanPool.ApollonianSuperharmonic.P4590T1RestoredBoundaryGeometry -public import LeanPool.ApollonianSuperharmonic.P4590T1JunctionRefinement public import LeanPool.ApollonianSuperharmonic.P4590T1JunctionRouting public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPositiveCutGeometry -public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior -- [TABLET NODE: BandOrderedGeneralInteriorStarClassification] @@ -183,7 +179,7 @@ theorem BandOrderedGeneralInteriorStarClassification exact ((P4456T2VertexInterior _ (hne 0 true) x (boundary_raw 0 true hAB.1)).2.mpr hall) hAB.1 obtain ⟨j, hj⟩ := hmissing - exact hj (cert.exceptional_segments.precursor_in_left (all_precursor j)) + exact hj (cert.exceptionalSegments.precursor_in_left (all_precursor j)) end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorWebRow.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorWebRow.lean index 3f1449485f..18e968752c 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorWebRow.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralInteriorWebRow.lean @@ -5,10 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PositiveCutCompanionRow -public import LeanPool.ApollonianSuperharmonic.TileTranslation -- [TABLET NODE: BandOrderedGeneralInteriorWebRow] @@ -276,12 +275,12 @@ inductive BandOrderedGeneralInteriorWebRow BandOrderedGeneralInteriorWebRow cert x marked | leftPositiveCut (unmarked : marked = false) - (at_cut : x = cert.exceptional_segments.a) + (at_cut : x = cert.exceptionalSegments.a) (geometry : PositiveCutCompanionRow cert x) : BandOrderedGeneralInteriorWebRow cert x marked | rightPositiveCut (unmarked : marked = false) - (at_cut : x = cert.exceptional_segments.b) + (at_cut : x = cert.exceptionalSegments.b) (geometry : PositiveCutCompanionRow cert x) : BandOrderedGeneralInteriorWebRow cert x marked diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean index 368ac54ebf..cdec0fd339 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean @@ -5,20 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorWebRow public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.OdometerWeb -public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope -public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandOrderedGeneralLargestParentOdometerRows] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean index 426515017c..a16df5d422 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean @@ -5,13 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandDoubleDecomposition public import LeanPool.ApollonianSuperharmonic.BandModifiedCoverage public import LeanPool.ApollonianSuperharmonic.BandModifiedOrbitArea public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry public import LeanPool.ApollonianSuperharmonic.BandPrototileReindexedDecomposition public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedPeriodicCore @@ -22,7 +22,9 @@ public import LeanPool.ApollonianSuperharmonic.OuterLayoutTouching public import LeanPool.ApollonianSuperharmonic.P4670T1SmallerGeometry public import LeanPool.ApollonianSuperharmonic.P4670T1ComplementReflection public import LeanPool.ApollonianSuperharmonic.P4670T1OrdinaryEdges -public import LeanPool.ApollonianSuperharmonic.P4638T1EmptyFordLocalization +public import LeanPool.ApollonianSuperharmonic.BandModifiedCellPartition +public import LeanPool.ApollonianSuperharmonic.BandModifiedPeriodicComplex +public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis -- [TABLET NODE: BandOrderedGeneralLayout] @@ -925,9 +927,9 @@ private theorem layoutCertificate : outer_touching := houter precursor_first := crossO1 precursor_second := crossO2 - precursor_boundary := Classical.choice arcs + precursorBoundary := Classical.choice arcs precursor_zero_curvature := zero - exceptional_segments := segments + exceptionalSegments := segments connector := segments.connector connector_segmented := rfl connector_nodup := segments.connector_nodup @@ -942,7 +944,7 @@ private theorem layoutCertificate : modified_lattice := mlattice modified_tile := mtiles modified_adjacency := madj - modified_face_equiv := me + modifiedFaceEquivalence := me modified_face_points := mpoints modified_face_vertices := mvertices modified_face_reps := mreps diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayoutCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayoutCertificate.lean index 81db7b27b9..5911300ea6 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayoutCertificate.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayoutCertificate.lean @@ -5,16 +5,17 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandModifiedPeriodicComplex +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoreCertificate public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.TileCellComplement -public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis -public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex +public import LeanPool.ApollonianSuperharmonic.TilingLattice -- [TABLET NODE: BandOrderedGeneralLayoutCertificate] @@ -214,20 +215,22 @@ structure BandOrderedGeneralLayoutCertificate (P 2 false) precursor_first : TouchingTriple (Q 1 true) (S 2 false) O precursor_second : TouchingTriple (Q 2 true) (S 1 false) O - precursor_boundary : PrecursorBoundaryArcData + /-- The boundary-arc decomposition around the common precursor tile. -/ + precursorBoundary : PrecursorBoundaryArcData (TileCellComplement (P 0 true) O) (TileCellComplement (P 0 false) O) O (S 0 true) (Q 1 true) (S 2 false) (Q 2 true) (S 1 false) precursor_zero_curvature : O.cells = ∅ → (cfg.firstPredecessor 1).1 = 0 - exceptional_segments : ExceptionalConnectorSegments + /-- The exceptional connector segments between the two distinguished unmodified vertices. -/ + exceptionalSegments : ExceptionalConnectorSegments (P 0 true) (P 0 false) O (Q 1 true) (S 2 false) (Q 2 true) (S 1 false) (unmodified.core.rho (unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) (unmodified.core.rho (unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩)) /-- The retained loop-erased connector between the two selected inner interfaces. -/ connector : List GaussianInt - connector_segmented : connector = exceptional_segments.connector + connector_segmented : connector = exceptionalSegments.connector connector_nodup : connector.Nodup connector_head : connector.head? = some (unmodified.core.rho (unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) @@ -258,16 +261,16 @@ structure BandOrderedGeneralLayoutCertificate modified_adjacency : ∀ a b, modified.plane.adjacent a b ↔ AllowedSubtileIncidence a b /-- Identify modified-complex faces with the fixed twelve-label periodic face ledger. -/ - modified_face_equiv : modified.plane.Face ≃ PeriodicSubtileFaceIndex + modifiedFaceEquivalence : modified.plane.Face ≃ PeriodicSubtileFaceIndex modified_face_points : ∀ f : PeriodicSubtileFaceIndex, - modified.rho (modified_face_equiv.symm f) = + modified.rho (modifiedFaceEquivalence.symm f) = unmodified.core.rho (unmodified.faceEquiv.symm f) modified_face_vertices : ∀ f i, modified.plane.faceVertex f i = - SixSubtileFaceVertices (modified_face_equiv f) i + SixSubtileFaceVertices (modifiedFaceEquivalence f) i modified_face_reps : ∀ f, f ∈ modified.faceOrbitReps ↔ - (modified_face_equiv f).first = 0 ∧ - (modified_face_equiv f).second = 0 + (modifiedFaceEquivalence f).first = 0 ∧ + (modifiedFaceEquivalence f).second = 0 precursor_isolated : ∀ m n : Int, ∀ x ∈ FootprintVertices (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)), diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMarkedSectorTransport.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMarkedSectorTransport.lean index 09c8d21cd8..353ae48062 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMarkedSectorTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMarkedSectorTransport.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightSelectedRowGeometry public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedSCompanionGeometry public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceExists diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMixedAggregatePatches.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMixedAggregatePatches.lean index 67161e6521..7cc594473a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMixedAggregatePatches.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralMixedAggregatePatches.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P1BandOrderedGeneralMixedAggregateJunctionData +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P1BandOrderedGeneralMixedAggregatePairedEndpoints -- [TABLET NODE: BandOrderedGeneralMixedAggregatePatches] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNestedRightOdometerRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNestedRightOdometerRows.lean index 1e2c86d918..34b1b2640c 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNestedRightOdometerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNestedRightOdometerRows.lean @@ -5,17 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorWebRow public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData -public import LeanPool.ApollonianSuperharmonic.BandCircle -public import LeanPool.ApollonianSuperharmonic.BandVectors -public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility public import LeanPool.ApollonianSuperharmonic.OdometerWeb -public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandOrderedGeneralNestedRightOdometerRows] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNormalizedOccurrenceBundle.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNormalizedOccurrenceBundle.lean index c6e1d8f625..c9029adbaf 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNormalizedOccurrenceBundle.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralNormalizedOccurrenceBundle.lean @@ -5,24 +5,16 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightPlacement public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtilePlacement -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.TileOdometer -- [TABLET NODE: BandOrderedGeneralNormalizedOccurrenceBundle] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOdometerRowData.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOdometerRowData.lean index a35c1bb679..3d35d4cef1 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOdometerRowData.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOdometerRowData.lean @@ -5,13 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandVectors -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends -public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope public import LeanPool.ApollonianSuperharmonic.TileOdometer -- [TABLET NODE: BandOrderedGeneralOdometerRowData] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean index 3a30b658ee..a4e7a07524 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean @@ -5,16 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorWebRow public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData public import LeanPool.ApollonianSuperharmonic.OdometerWeb -public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandOrderedGeneralOuterMixedOdometerRows] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPeriodicBlockCells.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPeriodicBlockCells.lean index e3aff0442a..a5415837f7 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPeriodicBlockCells.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPeriodicBlockCells.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.TileCellComplement public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: BandOrderedGeneralPeriodicBlockCells] @@ -77,7 +77,7 @@ theorem BandOrderedGeneralPeriodicBlockCells have hs' : x ∈ (TileCellComplement (layout.P 0 true) layout.O).cells := by simpa [ModifiedSubtileOccurrenceInterpretation, TileTranslation, GaussianTranslation] using hs - simp? [TileCellComplement] at hs' + simp only [TileCellComplement, Fin.isValue, Finset.mem_sdiff] at hs' exact ⟨0, true, hs'.1⟩ | B => exact ⟨0, false, by simpa [ModifiedSubtileOccurrenceInterpretation, TileTranslation, GaussianTranslation] using hs⟩ diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean index c326b1dd26..18be17dd9b 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean @@ -5,40 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandExceptionalRestorationSectorOrder -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandParentBoundaryGenealogy public import LeanPool.ApollonianSuperharmonic.BandPositiveCutBranchCompanionExclusion -public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments -public import LeanPool.ApollonianSuperharmonic.ExceptionalRestorationSectorData -public import LeanPool.ApollonianSuperharmonic.FordTile -public import LeanPool.ApollonianSuperharmonic.FordTileGeometry -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell public import LeanPool.ApollonianSuperharmonic.PositiveCutCompanionRow -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorsExistUnique -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem public import LeanPool.ApollonianSuperharmonic.ThreeOwnerDesignatedOppositePair -public import LeanPool.ApollonianSuperharmonic.TileRealization -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TileTouching -public import LeanPool.ApollonianSuperharmonic.TopologicalDisk -public import LeanPool.ApollonianSuperharmonic.TouchingTriple -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandOrderedGeneralPositiveCutGeometry] @@ -353,14 +325,14 @@ private theorem hAowners : (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileFaceIndex))) cert.exceptional_segments) → - ((cert.exceptional_segments.a ∈ cert.exceptional_segments.left) → (∀ j : Fin 4, - LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.Q 1 true).cells ∨ - LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S 2 false).cells ∨ - LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ cert.O.cells))) ) := by + PeriodicSubtileFaceIndex))) cert.exceptionalSegments) → + ((cert.exceptionalSegments.a ∈ cert.exceptionalSegments.left) → (∀ j : Fin 4, + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.Q 1 true).cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.S 2 false).cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ cert.O.cells))) ) := by classical intro q cfg C₀ T cert hO sector haLeft j - have ho := sector.left_owners cert.exceptional_segments.a haLeft (Or.inl hO) j + have ho := sector.left_owners cert.exceptionalSegments.a haLeft (Or.inl hO) j rcases ho with hq | hs | hc | ho · exact Or.inl hq · exact Or.inr (Or.inl hs) @@ -382,14 +354,14 @@ private theorem hBowners : (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileFaceIndex))) cert.exceptional_segments) → - ((cert.exceptional_segments.b ∈ cert.exceptional_segments.right) → (∀ j : Fin 4, - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q 2 true).cells ∨ - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 false).cells ∨ - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ cert.O.cells))) ) := by + PeriodicSubtileFaceIndex))) cert.exceptionalSegments) → + ((cert.exceptionalSegments.b ∈ cert.exceptionalSegments.right) → (∀ j : Fin 4, + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q 2 true).cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 false).cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ cert.O.cells))) ) := by classical intro q cfg C₀ T cert hO sector hbRight j - have ho := sector.right_owners cert.exceptional_segments.b hbRight (Or.inl hO) j + have ho := sector.right_owners cert.exceptionalSegments.b hbRight (Or.inl hO) j rcases ho with hq | hs | hc | ho · exact Or.inl hq · exact Or.inr (Or.inl hs) @@ -426,8 +398,8 @@ private theorem houterIntersection : simpa [SubtileOccurrenceInterpretation, TileTranslation, GaussianTranslation, gzero] using (BandOriginalPairSeparation cert.P cert.O cert.u cert.v - cert.exceptional_segments.precursor_in_left - cert.exceptional_segments.precursor_in_right cert.partition).1 0 0 + cert.exceptionalSegments.precursor_in_left + cert.exceptionalSegments.precursor_in_right cert.partition).1 0 0 private theorem hQ1S1 : (by @@ -493,13 +465,13 @@ private theorem selectA_Q : true).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑(cert.S (2 : Fin (3 : ℕ)) false).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑cert.O.cells : Set LatticeCell)) → ((∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptional_segments.a j ∈ (cert.Q 1 true).cells) → ((∃ j : Fin 4, - LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S 2 false).cells) → - ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.Q 1 - true).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S 2 - false).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ + cert.exceptionalSegments.a j ∈ (cert.Q 1 true).cells) → ((∃ j : Fin 4, + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.S 2 false).cells) → + ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.Q 1 + true).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.S 2 + false).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ cert.O.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptional_segments.a j ∈ cert.O.cells) → ((Disjoint (cert.Q (1 : Fin (3 : ℕ)) + cert.exceptionalSegments.a j ∈ cert.O.cells) → ((Disjoint (cert.Q (1 : Fin (3 : ℕ)) true).cells (cert.S (2 : Fin (3 : ℕ)) false).cells) → ((Disjoint (cert.S (2 : Fin (3 : ℕ)) false).cells cert.O.cells) → ((Disjoint cert.O.cells (cert.Q (1 : Fin (3 : ℕ)) true).cells) → (∀ D, D = cert.Q 1 true ∨ D = cert.S 2 false ∨ D = cert.O → ∃ U V R : @@ -508,18 +480,18 @@ private theorem selectA_Q : cert.O ∧ R = cert.S 2 false) ∨ (U = cert.O ∧ V = cert.Q 1 true ∧ R = cert.S 2 false) ∨ (U = cert.S 2 false ∧ V = cert.O ∧ R = cert.Q 1 true) ∨ (U = cert.O ∧ V = cert.S 2 false ∧ R = cert.Q 1 true)) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptional_segments.a j ∈ U.cells ∧ LatticeVertexIncidentCell - cert.exceptional_segments.a (j + 2) ∈ V.cells) ∧ cert.exceptional_segments.a ∈ - FootprintVertices U ∧ cert.exceptional_segments.a ∈ FootprintVertices V ∧ (∀ y, y = - cert.exceptional_segments.a ∨ y = cert.exceptional_segments.a + 1 ∨ y = - cert.exceptional_segments.a - 1 ∨ y = cert.exceptional_segments.a + ⟨0, 1⟩ ∨ y = - cert.exceptional_segments.a - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ + cert.exceptionalSegments.a j ∈ U.cells ∧ LatticeVertexIncidentCell + cert.exceptionalSegments.a (j + 2) ∈ V.cells) ∧ cert.exceptionalSegments.a ∈ + FootprintVertices U ∧ cert.exceptionalSegments.a ∈ FootprintVertices V ∧ (∀ y, y = + cert.exceptionalSegments.a ∨ y = cert.exceptionalSegments.a + 1 ∨ y = + cert.exceptionalSegments.a - 1 ∨ y = cert.exceptionalSegments.a + ⟨0, 1⟩ ∨ y = + cert.exceptionalSegments.a - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V)))))))))))))) ) := by classical intro q cfg C₀ T cert hQ2lat hS3lat hOlat hQ2check hS3check hOcheck hQ2occ hS3occ hAowners hOoccA hQS hSO hOQ D hD exact ThreeOwnerDesignatedOppositePair (cert.Q 1 true) (cert.S 2 false) cert.O - cert.exceptional_segments.a hQ2lat hS3lat hOlat hQS hSO hOQ + cert.exceptionalSegments.a hQ2lat hS3lat hOlat hQS hSO hOQ hQ2check hS3check hOcheck hAowners hQ2occ hS3occ hOoccA D hD private theorem selectB_Q : @@ -533,13 +505,13 @@ private theorem selectB_Q : true).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑(cert.S (1 : Fin (3 : ℕ)) false).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑cert.O.cells : Set LatticeCell)) → ((∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptional_segments.b j ∈ (cert.Q 2 true).cells) → ((∃ j : Fin 4, - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 false).cells) → - ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q 2 - true).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 - false).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ + cert.exceptionalSegments.b j ∈ (cert.Q 2 true).cells) → ((∃ j : Fin 4, + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 false).cells) → + ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q 2 + true).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 + false).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ cert.O.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptional_segments.b j ∈ cert.O.cells) → ((Disjoint (cert.Q (2 : Fin (3 : ℕ)) + cert.exceptionalSegments.b j ∈ cert.O.cells) → ((Disjoint (cert.Q (2 : Fin (3 : ℕ)) true).cells (cert.S (1 : Fin (3 : ℕ)) false).cells) → ((Disjoint (cert.S (1 : Fin (3 : ℕ)) false).cells cert.O.cells) → ((Disjoint cert.O.cells (cert.Q (2 : Fin (3 : ℕ)) true).cells) → (∀ D, D = cert.Q 2 true ∨ D = cert.S 1 false ∨ D = cert.O → ∃ U V R : @@ -548,18 +520,18 @@ private theorem selectB_Q : cert.O ∧ R = cert.S 1 false) ∨ (U = cert.O ∧ V = cert.Q 2 true ∧ R = cert.S 1 false) ∨ (U = cert.S 1 false ∧ V = cert.O ∧ R = cert.Q 2 true) ∨ (U = cert.O ∧ V = cert.S 1 false ∧ R = cert.Q 2 true)) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptional_segments.b j ∈ U.cells ∧ LatticeVertexIncidentCell - cert.exceptional_segments.b (j + 2) ∈ V.cells) ∧ cert.exceptional_segments.b ∈ - FootprintVertices U ∧ cert.exceptional_segments.b ∈ FootprintVertices V ∧ (∀ y, y = - cert.exceptional_segments.b ∨ y = cert.exceptional_segments.b + 1 ∨ y = - cert.exceptional_segments.b - 1 ∨ y = cert.exceptional_segments.b + ⟨0, 1⟩ ∨ y = - cert.exceptional_segments.b - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ + cert.exceptionalSegments.b j ∈ U.cells ∧ LatticeVertexIncidentCell + cert.exceptionalSegments.b (j + 2) ∈ V.cells) ∧ cert.exceptionalSegments.b ∈ + FootprintVertices U ∧ cert.exceptionalSegments.b ∈ FootprintVertices V ∧ (∀ y, y = + cert.exceptionalSegments.b ∨ y = cert.exceptionalSegments.b + 1 ∨ y = + cert.exceptionalSegments.b - 1 ∨ y = cert.exceptionalSegments.b + ⟨0, 1⟩ ∨ y = + cert.exceptionalSegments.b - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V)))))))))))))) ) := by classical intro q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck hQ3occ hS2occ hBowners hOoccB hQ3S2 hS2O hOQ3 D hD exact ThreeOwnerDesignatedOppositePair (cert.Q 2 true) (cert.S 1 false) cert.O - cert.exceptional_segments.b hQ3lat hS2lat hOlat hQ3S2 hS2O hOQ3 + cert.exceptionalSegments.b hQ3lat hS2lat hOlat hQ3S2 hS2O hOQ3 hQ3check hS2check hOcheck hBowners hQ3occ hS2occ hOoccB D hD private theorem normalize_selected : @@ -667,13 +639,13 @@ private theorem selectB_S : true).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑(cert.S (1 : Fin (3 : ℕ)) false).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑cert.O.cells : Set LatticeCell)) → ((∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptional_segments.b j ∈ (cert.Q 2 true).cells) → ((∃ j : Fin 4, - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 false).cells) → - ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q 2 - true).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 - false).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ + cert.exceptionalSegments.b j ∈ (cert.Q 2 true).cells) → ((∃ j : Fin 4, + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 false).cells) → + ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q 2 + true).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 + false).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ cert.O.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptional_segments.b j ∈ cert.O.cells) → ((Disjoint (cert.Q (2 : Fin (3 : ℕ)) + cert.exceptionalSegments.b j ∈ cert.O.cells) → ((Disjoint (cert.Q (2 : Fin (3 : ℕ)) true).cells (cert.S (1 : Fin (3 : ℕ)) false).cells) → ((Disjoint (cert.S (1 : Fin (3 : ℕ)) false).cells cert.O.cells) → ((Disjoint cert.O.cells (cert.Q (2 : Fin (3 : ℕ)) true).cells) → (∀ D, D = cert.S 1 false ∨ D = cert.Q 2 true ∨ D = cert.O → ∃ U V R : @@ -682,27 +654,27 @@ private theorem selectB_S : cert.O ∧ R = cert.Q 2 true) ∨ (U = cert.O ∧ V = cert.S 1 false ∧ R = cert.Q 2 true) ∨ (U = cert.Q 2 true ∧ V = cert.O ∧ R = cert.S 1 false) ∨ (U = cert.O ∧ V = cert.Q 2 true ∧ R = cert.S 1 false)) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptional_segments.b j ∈ U.cells ∧ LatticeVertexIncidentCell - cert.exceptional_segments.b (j + 2) ∈ V.cells) ∧ cert.exceptional_segments.b ∈ - FootprintVertices U ∧ cert.exceptional_segments.b ∈ FootprintVertices V ∧ (∀ y, y = - cert.exceptional_segments.b ∨ y = cert.exceptional_segments.b + 1 ∨ y = - cert.exceptional_segments.b - 1 ∨ y = cert.exceptional_segments.b + ⟨0, 1⟩ ∨ y = - cert.exceptional_segments.b - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ + cert.exceptionalSegments.b j ∈ U.cells ∧ LatticeVertexIncidentCell + cert.exceptionalSegments.b (j + 2) ∈ V.cells) ∧ cert.exceptionalSegments.b ∈ + FootprintVertices U ∧ cert.exceptionalSegments.b ∈ FootprintVertices V ∧ (∀ y, y = + cert.exceptionalSegments.b ∨ y = cert.exceptionalSegments.b + 1 ∨ y = + cert.exceptionalSegments.b - 1 ∨ y = cert.exceptionalSegments.b + ⟨0, 1⟩ ∨ y = + cert.exceptionalSegments.b - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V)))))))))))))) ) := by classical intro q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck hQ3occ hS2occ hBowners hOoccB hQ3S2 hS2O hOQ3 D hD have owners : ∀ j : Fin 4, - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 false).cells ∨ - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q 2 true).cells ∨ - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ cert.O.cells := by + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 false).cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q 2 true).cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ cert.O.cells := by intro j rcases hBowners j with hq | hs | ho · exact Or.inr (Or.inl hq) · exact Or.inl hs · exact Or.inr (Or.inr ho) exact ThreeOwnerDesignatedOppositePair (cert.S 1 false) (cert.Q 2 true) cert.O - cert.exceptional_segments.b hS2lat hQ3lat hOlat hQ3S2.symm hOQ3.symm hS2O.symm + cert.exceptionalSegments.b hS2lat hQ3lat hOlat hQ3S2.symm hOQ3.symm hS2O.symm hS2check hQ3check hOcheck owners hS2occ hQ3occ hOoccB D hD private theorem selectA_O : @@ -716,13 +688,13 @@ private theorem selectA_O : true).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑(cert.S (2 : Fin (3 : ℕ)) false).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑cert.O.cells : Set LatticeCell)) → ((∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptional_segments.a j ∈ (cert.Q 1 true).cells) → ((∃ j : Fin 4, - LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S 2 false).cells) → - ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.Q 1 - true).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S 2 - false).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ + cert.exceptionalSegments.a j ∈ (cert.Q 1 true).cells) → ((∃ j : Fin 4, + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.S 2 false).cells) → + ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.Q 1 + true).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.S 2 + false).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ cert.O.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptional_segments.a j ∈ cert.O.cells) → ((Disjoint (cert.Q (1 : Fin (3 : ℕ)) + cert.exceptionalSegments.a j ∈ cert.O.cells) → ((Disjoint (cert.Q (1 : Fin (3 : ℕ)) true).cells (cert.S (2 : Fin (3 : ℕ)) false).cells) → ((Disjoint (cert.S (2 : Fin (3 : ℕ)) false).cells cert.O.cells) → ((Disjoint cert.O.cells (cert.Q (1 : Fin (3 : ℕ)) true).cells) → (∀ D, D = cert.O ∨ D = cert.Q 1 true ∨ D = cert.S 2 false → ∃ U V R : @@ -731,27 +703,27 @@ private theorem selectA_O : false ∧ R = cert.Q 1 true) ∨ (U = cert.S 2 false ∧ V = cert.O ∧ R = cert.Q 1 true) ∨ (U = cert.Q 1 true ∧ V = cert.S 2 false ∧ R = cert.O) ∨ (U = cert.S 2 false ∧ V = cert.Q 1 true ∧ R = cert.O)) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptional_segments.a j ∈ U.cells ∧ LatticeVertexIncidentCell - cert.exceptional_segments.a (j + 2) ∈ V.cells) ∧ cert.exceptional_segments.a ∈ - FootprintVertices U ∧ cert.exceptional_segments.a ∈ FootprintVertices V ∧ (∀ y, y = - cert.exceptional_segments.a ∨ y = cert.exceptional_segments.a + 1 ∨ y = - cert.exceptional_segments.a - 1 ∨ y = cert.exceptional_segments.a + ⟨0, 1⟩ ∨ y = - cert.exceptional_segments.a - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ + cert.exceptionalSegments.a j ∈ U.cells ∧ LatticeVertexIncidentCell + cert.exceptionalSegments.a (j + 2) ∈ V.cells) ∧ cert.exceptionalSegments.a ∈ + FootprintVertices U ∧ cert.exceptionalSegments.a ∈ FootprintVertices V ∧ (∀ y, y = + cert.exceptionalSegments.a ∨ y = cert.exceptionalSegments.a + 1 ∨ y = + cert.exceptionalSegments.a - 1 ∨ y = cert.exceptionalSegments.a + ⟨0, 1⟩ ∨ y = + cert.exceptionalSegments.a - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V)))))))))))))) ) := by classical intro q cfg C₀ T cert hQ2lat hS3lat hOlat hQ2check hS3check hOcheck hQ2occ hS3occ hAowners hOoccA hQS hSO hOQ D hD have owners : ∀ j : Fin 4, - LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ cert.O.cells ∨ - LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.Q 1 true).cells ∨ - LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S 2 false).cells := by + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ cert.O.cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.Q 1 true).cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.S 2 false).cells := by intro j rcases hAowners j with hq | hs | ho · exact Or.inr (Or.inl hq) · exact Or.inr (Or.inr hs) · exact Or.inl ho exact ThreeOwnerDesignatedOppositePair cert.O (cert.Q 1 true) (cert.S 2 false) - cert.exceptional_segments.a hOlat hQ2lat hS3lat hOQ hQS hSO + cert.exceptionalSegments.a hOlat hQ2lat hS3lat hOQ hQS hSO hOcheck hQ2check hS3check owners hOoccA hQ2occ hS3occ D hD private theorem selectB_O : @@ -765,13 +737,13 @@ private theorem selectB_O : true).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑(cert.S (1 : Fin (3 : ℕ)) false).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑cert.O.cells : Set LatticeCell)) → ((∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptional_segments.b j ∈ (cert.Q 2 true).cells) → ((∃ j : Fin 4, - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 false).cells) → - ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q 2 - true).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 - false).cells ∨ LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ + cert.exceptionalSegments.b j ∈ (cert.Q 2 true).cells) → ((∃ j : Fin 4, + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 false).cells) → + ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q 2 + true).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 + false).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ cert.O.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptional_segments.b j ∈ cert.O.cells) → ((Disjoint (cert.Q (2 : Fin (3 : ℕ)) + cert.exceptionalSegments.b j ∈ cert.O.cells) → ((Disjoint (cert.Q (2 : Fin (3 : ℕ)) true).cells (cert.S (1 : Fin (3 : ℕ)) false).cells) → ((Disjoint (cert.S (1 : Fin (3 : ℕ)) false).cells cert.O.cells) → ((Disjoint cert.O.cells (cert.Q (2 : Fin (3 : ℕ)) true).cells) → (∀ D, D = cert.O ∨ D = cert.S 1 false ∨ D = cert.Q 2 true → ∃ U V R : @@ -780,27 +752,27 @@ private theorem selectB_O : true ∧ R = cert.S 1 false) ∨ (U = cert.Q 2 true ∧ V = cert.O ∧ R = cert.S 1 false) ∨ (U = cert.S 1 false ∧ V = cert.Q 2 true ∧ R = cert.O) ∨ (U = cert.Q 2 true ∧ V = cert.S 1 false ∧ R = cert.O)) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptional_segments.b j ∈ U.cells ∧ LatticeVertexIncidentCell - cert.exceptional_segments.b (j + 2) ∈ V.cells) ∧ cert.exceptional_segments.b ∈ - FootprintVertices U ∧ cert.exceptional_segments.b ∈ FootprintVertices V ∧ (∀ y, y = - cert.exceptional_segments.b ∨ y = cert.exceptional_segments.b + 1 ∨ y = - cert.exceptional_segments.b - 1 ∨ y = cert.exceptional_segments.b + ⟨0, 1⟩ ∨ y = - cert.exceptional_segments.b - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ + cert.exceptionalSegments.b j ∈ U.cells ∧ LatticeVertexIncidentCell + cert.exceptionalSegments.b (j + 2) ∈ V.cells) ∧ cert.exceptionalSegments.b ∈ + FootprintVertices U ∧ cert.exceptionalSegments.b ∈ FootprintVertices V ∧ (∀ y, y = + cert.exceptionalSegments.b ∨ y = cert.exceptionalSegments.b + 1 ∨ y = + cert.exceptionalSegments.b - 1 ∨ y = cert.exceptionalSegments.b + ⟨0, 1⟩ ∨ y = + cert.exceptionalSegments.b - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V)))))))))))))) ) := by classical intro q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck hQ3occ hS2occ hBowners hOoccB hQ3S2 hS2O hOQ3 D hD have owners : ∀ j : Fin 4, - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ cert.O.cells ∨ - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 false).cells ∨ - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q 2 true).cells := by + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ cert.O.cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 false).cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q 2 true).cells := by intro j rcases hBowners j with hq | hs | ho · exact Or.inr (Or.inr hq) · exact Or.inr (Or.inl hs) · exact Or.inl ho exact ThreeOwnerDesignatedOppositePair cert.O (cert.S 1 false) (cert.Q 2 true) - cert.exceptional_segments.b hOlat hS2lat hQ3lat hS2O.symm hQ3S2.symm hOQ3.symm + cert.exceptionalSegments.b hOlat hS2lat hQ3lat hS2O.symm hQ3S2.symm hOQ3.symm hOcheck hS2check hQ3check owners hOoccB hS2occ hQ3occ D hD private theorem hI2mul : @@ -1094,7 +1066,7 @@ private theorem hfixedPlusAbsent : (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ((∀ (X : ProtoTile), ∀ (x : + PeriodicSubtileFaceIndex))) cert.exceptionalSegments) → ((∀ (X : ProtoTile), ∀ (x : GaussianInt), (X.cells.Nonempty) → ((x ∈ FootprintVertices X) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ X.cells))) → ( let I : GaussianInt := ⟨0, 1⟩ @@ -1104,13 +1076,13 @@ private theorem hfixedPlusAbsent : ℕ))) (q (2 : Fin (4 : ℕ))))).cells = ∅ → (TileTranslation (cert.Q (1 : Fin (3 : ℕ)) true) (I * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).anchor = (cert.P (1 : Fin (3 : ℕ)) true).anchor)) → (((TileTranslation (cert.Q 1 true) (I * - BandVectors.1 (q 3) (q 2))).cells.Nonempty) → (cert.exceptional_segments.a ∉ + BandVectors.1 (q 3) (q 2))).cells.Nonempty) → (cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation (cert.Q 1 true) (I * BandVectors.1 (q 3) (q 2)))))))) ) := by classical intro q cfg C₀ T cert hO sector raw_incident I hfixedPlusUnique hfixedPlusNonempty ha rcases raw_incident _ _ hfixedPlusNonempty ha with ⟨j, hj⟩ - have hp : LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ + have hp : LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.P 1 true).cells := by rw [hfixedPlusUnique.1] at hj; exact hj exact (sector.positive_first_cut_no_companion hO j) hp @@ -1299,7 +1271,7 @@ private theorem hfixedMinusAbsent : (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ((∀ (X : ProtoTile), ∀ (x : + PeriodicSubtileFaceIndex))) cert.exceptionalSegments) → ((∀ (X : ProtoTile), ∀ (x : GaussianInt), (X.cells.Nonempty) → ((x ∈ FootprintVertices X) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ X.cells))) → ( let I : GaussianInt := ⟨0, 1⟩ @@ -1309,13 +1281,13 @@ private theorem hfixedMinusAbsent : : ℕ))) (q (2 : Fin (4 : ℕ))))).cells = ∅ → (TileTranslation (cert.S (1 : Fin (3 : ℕ)) false) (-I * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).anchor = (cert.P (1 : Fin (3 : ℕ)) false).anchor)) → (((TileTranslation (cert.S 1 false) (-I * - BandVectors.1 (q 3) (q 2))).cells.Nonempty) → (cert.exceptional_segments.b ∉ + BandVectors.1 (q 3) (q 2))).cells.Nonempty) → (cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation (cert.S 1 false) (-I * BandVectors.1 (q 3) (q 2)))))))) ) := by classical intro q cfg C₀ T cert hO sector raw_incident I hfixedMinusUnique hfixedMinusNonempty hb rcases raw_incident _ _ hfixedMinusNonempty hb with ⟨j, hj⟩ - have hp : LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ + have hp : LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.P 1 false).cells := by rw [hfixedMinusUnique.1] at hj; exact hj exact (sector.positive_second_cut_no_companion hO j) hp @@ -1330,33 +1302,33 @@ private theorem p2_a_O_row : ∀ (birth : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple birth) → (((birth (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (2 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) ∧ birth (3 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ - cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation (cert.Q (1 : Fin (3 + cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation (cert.Q (1 : Fin (3 : ℕ)) true) (BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : - ℕ))))) ∧ cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation (cert.S (1 + ℕ))))) ∧ cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation (cert.S (1 : Fin (3 : ℕ)) false) (-BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))))) ∨ (birth (0 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ)) ∧ birth (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (3 : Fin (4 : ℕ)) = q (3 : - Fin (4 : ℕ))) ∧ cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation + Fin (4 : ℕ))) ∧ cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) - (cfg.firstPredecessor (1 : Fin (4 : ℕ))))) ∧ cert.exceptional_segments.a ∉ + (cfg.firstPredecessor (1 : Fin (4 : ℕ))))) ∧ cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O (BandVectors.1 (cfg.firstPredecessor (1 : - Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))))) ∧ cert.exceptional_segments.b ∉ + Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))))) ∧ cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ)))))) ∧ - cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O + cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ)))))) → ((BandPrototile (ρ 1) cert.O) → ((BandPrototile (q 2) (cert.Q 1 true)) → ((BandPrototile (q 3) (cert.S 2 false)) → ((cert.Q (1 : Fin (3 : ℕ)) true ≠ cert.S (1 : Fin (3 : ℕ)) false) → ((cert.S (2 : Fin (3 : ℕ)) false ≠ cert.O) → ((cert.Q (2 : Fin (3 : ℕ)) true ≠ cert.O) → ((∃ (W : ProtoTile), (W = cert.S (2 : Fin (3 : ℕ)) false ∨ W = cert.O) ∧ ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptional_segments.a j ∈ (cert.Q (1 : Fin (3 : ℕ)) true).cells ∧ - LatticeVertexIncidentCell cert.exceptional_segments.a (j + (2 : Fin (4 : ℕ))) ∈ - W.cells ∧ cert.exceptional_segments.a ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) - true) ∧ cert.exceptional_segments.a ∈ FootprintVertices W ∧ ∀ (y : GaussianInt), y = - cert.exceptional_segments.a ∨ y = cert.exceptional_segments.a + (1 : GaussianInt) ∨ y - = cert.exceptional_segments.a - (1 : GaussianInt) ∨ y = cert.exceptional_segments.a + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = cert.exceptional_segments.a - (⟨(0 : ℤ), (1 + cert.exceptionalSegments.a j ∈ (cert.Q (1 : Fin (3 : ℕ)) true).cells ∧ + LatticeVertexIncidentCell cert.exceptionalSegments.a (j + (2 : Fin (4 : ℕ))) ∈ + W.cells ∧ cert.exceptionalSegments.a ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) + true) ∧ cert.exceptionalSegments.a ∈ FootprintVertices W ∧ ∀ (y : GaussianInt), y = + cert.exceptionalSegments.a ∨ y = cert.exceptionalSegments.a + (1 : GaussianInt) ∨ y + = cert.exceptionalSegments.a - (1 : GaussianInt) ∨ y = cert.exceptionalSegments.a + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = cert.exceptionalSegments.a - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∨ y ∈ FootprintVertices W) → ( let I : GaussianInt := ⟨0, 1⟩ @@ -1365,10 +1337,10 @@ private theorem p2_a_O_row : ((TileTranslation (cert.Q (1 : Fin (3 : ℕ)) true) (I * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).cells = ∅ → (TileTranslation (cert.Q (1 : Fin (3 : ℕ)) true) (I * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).anchor = - (cert.P (1 : Fin (3 : ℕ)) true).anchor)) → ((cert.exceptional_segments.a ∉ + (cert.P (1 : Fin (3 : ℕ)) true).anchor)) → ((cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation (cert.Q 1 true) (I * BandVectors.1 (q 3) (q 2)))) → ((birth 0 = q 2 ∧ birth 2 = q 3 ∧ birth 3 = ρ 1) → (Nonempty - (PositiveCutCompanionRow cert cert.exceptional_segments.a)))))))))))))) ) := by + (PositiveCutCompanionRow cert cert.exceptionalSegments.a)))))))))))))) ) := by classical intro q cfg C₀ T cert hO ρ birth hproper branchExclusions hOproto hQ2proto hS3proto hneQ1S1 hneA_SO hneB_QO selected_p2_a I hfixedPlusUnique hfixedPlusAbsent hp2 @@ -1379,7 +1351,7 @@ private theorem p2_a_O_row : · rfl · exact hp2.2.1 · exact hp2.2.2 - have hnotQ2a : cert.exceptional_segments.a ∉ FootprintVertices + have hnotQ2a : cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation (cert.Q 1 true) (BandVectors.1 (q 2) (ρ 1))) := by rcases branchExclusions with hEx | hEx · exact hEx.2.1 @@ -1468,33 +1440,33 @@ private theorem p2_b_O_row : ∀ (birth : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple birth) → (((birth (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (2 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) ∧ birth (3 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ - cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation (cert.Q (1 : Fin (3 + cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation (cert.Q (1 : Fin (3 : ℕ)) true) (BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : - ℕ))))) ∧ cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation (cert.S (1 + ℕ))))) ∧ cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation (cert.S (1 : Fin (3 : ℕ)) false) (-BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))))) ∨ (birth (0 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ)) ∧ birth (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (3 : Fin (4 : ℕ)) = q (3 : - Fin (4 : ℕ))) ∧ cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation + Fin (4 : ℕ))) ∧ cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) - (cfg.firstPredecessor (1 : Fin (4 : ℕ))))) ∧ cert.exceptional_segments.a ∉ + (cfg.firstPredecessor (1 : Fin (4 : ℕ))))) ∧ cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O (BandVectors.1 (cfg.firstPredecessor (1 : - Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))))) ∧ cert.exceptional_segments.b ∉ + Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))))) ∧ cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ)))))) ∧ - cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O + cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ)))))) → ((BandPrototile (ρ 1) cert.O) → ((BandPrototile (q 3) (cert.Q 2 true)) → ((BandPrototile (q 2) (cert.S 1 false)) → ((cert.Q (1 : Fin (3 : ℕ)) true ≠ cert.S (1 : Fin (3 : ℕ)) false) → ((cert.Q (2 : Fin (3 : ℕ)) true ≠ cert.O) → ((∃ (W : ProtoTile), (W = cert.Q (2 : Fin (3 : ℕ)) true ∨ W = cert.O) ∧ ∃ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S (1 : Fin (3 : ℕ)) - false).cells ∧ LatticeVertexIncidentCell cert.exceptional_segments.b (j + (2 : Fin (4 - : ℕ))) ∈ W.cells ∧ cert.exceptional_segments.b ∈ FootprintVertices (cert.S (1 : Fin - (3 : ℕ)) false) ∧ cert.exceptional_segments.b ∈ FootprintVertices W ∧ ∀ (y : - GaussianInt), y = cert.exceptional_segments.b ∨ y = cert.exceptional_segments.b + (1 - : GaussianInt) ∨ y = cert.exceptional_segments.b - (1 : GaussianInt) ∨ y = - cert.exceptional_segments.b + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = - cert.exceptional_segments.b - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S (1 : Fin (3 : ℕ)) + false).cells ∧ LatticeVertexIncidentCell cert.exceptionalSegments.b (j + (2 : Fin (4 + : ℕ))) ∈ W.cells ∧ cert.exceptionalSegments.b ∈ FootprintVertices (cert.S (1 : Fin + (3 : ℕ)) false) ∧ cert.exceptionalSegments.b ∈ FootprintVertices W ∧ ∀ (y : + GaussianInt), y = cert.exceptionalSegments.b ∨ y = cert.exceptionalSegments.b + (1 + : GaussianInt) ∨ y = cert.exceptionalSegments.b - (1 : GaussianInt) ∨ y = + cert.exceptionalSegments.b + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = + cert.exceptionalSegments.b - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices (cert.S (1 : Fin (3 : ℕ)) false) ∨ y ∈ FootprintVertices W) → ( let I : GaussianInt := ⟨0, 1⟩ (I ^ 2 = -1) → ((I ^ 3 = -I) → ((¬ (∃ r : ℕ, 3 = r + r)) → (((TileTranslation (cert.S (1 @@ -1503,10 +1475,10 @@ private theorem p2_b_O_row : : Fin (3 : ℕ)) false) (-I * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).cells = ∅ → (TileTranslation (cert.S (1 : Fin (3 : ℕ)) false) (-I * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))))).anchor = (cert.P (1 : Fin - (3 : ℕ)) false).anchor)) → ((cert.exceptional_segments.b ∉ FootprintVertices + (3 : ℕ)) false).anchor)) → ((cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation (cert.S 1 false) (-I * BandVectors.1 (q 3) (q 2)))) → ((birth 0 = q 2 ∧ birth 2 = q 3 ∧ birth 3 = ρ 1) → (Nonempty (PositiveCutCompanionRow cert - cert.exceptional_segments.b)))))))))))))))) ) := by + cert.exceptionalSegments.b)))))))))))))))) ) := by classical intro q cfg C₀ T cert hO ρ birth hproper branchExclusions hOproto hQ3proto hS2proto hneQ1S1 hneB_QO' selected_p2_b I hI2 hI3 hodd3 hfixedMinusUnique hfixedMinusAbsent hp2 @@ -1517,7 +1489,7 @@ private theorem p2_b_O_row : · rfl · exact hp2.2.1 · exact hp2.2.2 - have hnotS2b : cert.exceptional_segments.b ∉ FootprintVertices + have hnotS2b : cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation (cert.S 1 false) (-BandVectors.1 (q 2) (ρ 1))) := by rcases branchExclusions with hEx | hEx · exact hEx.2.2 @@ -1564,7 +1536,7 @@ private theorem p2_b_O_row : literalRow := Or.inr (Or.inr (Or.inl ⟨hbP2, rfl, rfl, rfl, rfl, rfl⟩)) }⟩ · subst W - have hnotS2b' : cert.exceptional_segments.b ∉ FootprintVertices + have hnotS2b' : cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation (cert.S 1 false) (-BandVectors.1 (q 2) (ρ 1))) := hnotS2b refine ⟨{ precursorNonempty := hO, @@ -1608,28 +1580,28 @@ private theorem p4_exclusions : ∀ (birth : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple birth) → (((birth (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (2 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) ∧ birth (3 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ))) ∧ - cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation (cert.Q (1 : Fin (3 + cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation (cert.Q (1 : Fin (3 : ℕ)) true) (BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : - ℕ))))) ∧ cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation (cert.S (1 + ℕ))))) ∧ cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation (cert.S (1 : Fin (3 : ℕ)) false) (-BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ))))) ∨ (birth (0 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ)) ∧ birth (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (3 : Fin (4 : ℕ)) = q (3 : - Fin (4 : ℕ))) ∧ cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation + Fin (4 : ℕ))) ∧ cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) - (cfg.firstPredecessor (1 : Fin (4 : ℕ))))) ∧ cert.exceptional_segments.a ∉ + (cfg.firstPredecessor (1 : Fin (4 : ℕ))))) ∧ cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O (BandVectors.1 (cfg.firstPredecessor (1 : - Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))))) ∧ cert.exceptional_segments.b ∉ + Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))))) ∧ cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (cfg.firstPredecessor (1 : Fin (4 : ℕ)))))) ∧ - cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O + cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-BandVectors.1 (cfg.firstPredecessor (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ)))))) → ( let I : GaussianInt := ⟨0, 1⟩ - (birth 0 = ρ 1 ∧ birth 2 = q 2 ∧ birth 3 = q 3) → (cert.exceptional_segments.a ∉ + (birth 0 = ρ 1 ∧ birth 2 = q 2 ∧ birth 3 = q 3) → (cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O (I * BandVectors.1 (q 2) (ρ 1))) ∧ - cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation cert.O - (BandVectors.1 (ρ 1) (q 3))) ∧ cert.exceptional_segments.b ∉ FootprintVertices + cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O + (BandVectors.1 (ρ 1) (q 3))) ∧ cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-I * BandVectors.1 (q 2) (ρ 1))) ∧ - cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O + cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-BandVectors.1 (ρ 1) (q 3)))))) ) := by classical intro q cfg C₀ T cert ρ birth hproper branchExclusions I hp4 @@ -1655,23 +1627,23 @@ private theorem p4_a_row : ((BandPrototile (q 3) (cert.S 2 false)) → ((cert.O ≠ cert.Q (1 : Fin (3 : ℕ)) true) → ((cert.O ≠ cert.S (1 : Fin (3 : ℕ)) false) → ((∃ (W : ProtoTile), (W = cert.Q (1 : Fin (3 : ℕ)) true ∨ W = cert.S (2 : Fin (3 : ℕ)) false) ∧ ∃ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ cert.O.cells ∧ - LatticeVertexIncidentCell cert.exceptional_segments.a (j + (2 : Fin (4 : ℕ))) ∈ - W.cells ∧ cert.exceptional_segments.a ∈ FootprintVertices cert.O ∧ - cert.exceptional_segments.a ∈ FootprintVertices W ∧ ∀ (y : GaussianInt), y = - cert.exceptional_segments.a ∨ y = cert.exceptional_segments.a + (1 : GaussianInt) ∨ y - = cert.exceptional_segments.a - (1 : GaussianInt) ∨ y = cert.exceptional_segments.a + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = cert.exceptional_segments.a - (⟨(0 : ℤ), (1 + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ cert.O.cells ∧ + LatticeVertexIncidentCell cert.exceptionalSegments.a (j + (2 : Fin (4 : ℕ))) ∈ + W.cells ∧ cert.exceptionalSegments.a ∈ FootprintVertices cert.O ∧ + cert.exceptionalSegments.a ∈ FootprintVertices W ∧ ∀ (y : GaussianInt), y = + cert.exceptionalSegments.a ∨ y = cert.exceptionalSegments.a + (1 : GaussianInt) ∨ y + = cert.exceptionalSegments.a - (1 : GaussianInt) ∨ y = cert.exceptionalSegments.a + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = cert.exceptionalSegments.a - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices cert.O ∨ y ∈ FootprintVertices W) → ( let I : GaussianInt := ⟨0, 1⟩ - ((birth 0 = ρ 1 ∧ birth 2 = q 2 ∧ birth 3 = q 3) → (cert.exceptional_segments.a ∉ + ((birth 0 = ρ 1 ∧ birth 2 = q 2 ∧ birth 3 = q 3) → (cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O (I * BandVectors.1 (q 2) (ρ 1))) ∧ - cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation cert.O - (BandVectors.1 (ρ 1) (q 3))) ∧ cert.exceptional_segments.b ∉ FootprintVertices + cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O + (BandVectors.1 (ρ 1) (q 3))) ∧ cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-I * BandVectors.1 (q 2) (ρ 1))) ∧ - cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O + cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-BandVectors.1 (ρ 1) (q 3))))) → ((birth 0 = ρ 1 ∧ birth 2 = q 2 ∧ birth 3 = q 3) → - (Nonempty (PositiveCutCompanionRow cert cert.exceptional_segments.a))))))))))) ) := by + (Nonempty (PositiveCutCompanionRow cert cert.exceptionalSegments.a))))))))))) ) := by classical intro q cfg C₀ T cert hO ρ birth hproper hOproto hQ2proto hS3proto hneA_OQ hneB_OS selected_p4_a I p4_exclusions hp4 @@ -1760,24 +1732,24 @@ private theorem p4_b_row : ((BandPrototile (q 2) (cert.S 1 false)) → ((cert.O ≠ cert.Q (1 : Fin (3 : ℕ)) true) → ((cert.O ≠ cert.S (1 : Fin (3 : ℕ)) false) → ((∃ (W : ProtoTile), (W = cert.S (1 : Fin (3 : ℕ)) false ∨ W = cert.Q (2 : Fin (3 : ℕ)) true) ∧ ∃ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ cert.O.cells ∧ - LatticeVertexIncidentCell cert.exceptional_segments.b (j + (2 : Fin (4 : ℕ))) ∈ - W.cells ∧ cert.exceptional_segments.b ∈ FootprintVertices cert.O ∧ - cert.exceptional_segments.b ∈ FootprintVertices W ∧ ∀ (y : GaussianInt), y = - cert.exceptional_segments.b ∨ y = cert.exceptional_segments.b + (1 : GaussianInt) ∨ y - = cert.exceptional_segments.b - (1 : GaussianInt) ∨ y = cert.exceptional_segments.b + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = cert.exceptional_segments.b - (⟨(0 : ℤ), (1 + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ cert.O.cells ∧ + LatticeVertexIncidentCell cert.exceptionalSegments.b (j + (2 : Fin (4 : ℕ))) ∈ + W.cells ∧ cert.exceptionalSegments.b ∈ FootprintVertices cert.O ∧ + cert.exceptionalSegments.b ∈ FootprintVertices W ∧ ∀ (y : GaussianInt), y = + cert.exceptionalSegments.b ∨ y = cert.exceptionalSegments.b + (1 : GaussianInt) ∨ y + = cert.exceptionalSegments.b - (1 : GaussianInt) ∨ y = cert.exceptionalSegments.b + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = cert.exceptionalSegments.b - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices cert.O ∨ y ∈ FootprintVertices W) → ( let I : GaussianInt := ⟨0, 1⟩ (I ^ 2 = -1) → ((I ^ 3 = -I) → ((¬ (∃ r : ℕ, 3 = r + r)) → (((birth 0 = ρ 1 ∧ birth 2 = q - 2 ∧ birth 3 = q 3) → (cert.exceptional_segments.a ∉ FootprintVertices + 2 ∧ birth 3 = q 3) → (cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O (I * BandVectors.1 (q 2) (ρ 1))) ∧ - cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation cert.O - (BandVectors.1 (ρ 1) (q 3))) ∧ cert.exceptional_segments.b ∉ FootprintVertices + cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O + (BandVectors.1 (ρ 1) (q 3))) ∧ cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-I * BandVectors.1 (q 2) (ρ 1))) ∧ - cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O + cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-BandVectors.1 (ρ 1) (q 3))))) → ((birth 0 = ρ 1 ∧ birth 2 = q 2 ∧ birth 3 = q 3) → - (Nonempty (PositiveCutCompanionRow cert cert.exceptional_segments.b)))))))))))))) ) + (Nonempty (PositiveCutCompanionRow cert cert.exceptionalSegments.b)))))))))))))) ) := by classical intro q cfg C₀ T cert hO ρ birth hproper hOproto hQ3proto hS2proto hneA_OQ hneB_OS @@ -1864,8 +1836,8 @@ theorem BandOrderedGeneralPositiveCutGeometry (C₀ : BandCircle) (T : ProtoTile) (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T) (hO : cert.O.cells.Nonempty) : - Nonempty (PositiveCutCompanionRow cert cert.exceptional_segments.a) ∧ - Nonempty (PositiveCutCompanionRow cert cert.exceptional_segments.b) := by + Nonempty (PositiveCutCompanionRow cert cert.exceptionalSegments.a) ∧ + Nonempty (PositiveCutCompanionRow cert cert.exceptionalSegments.b) := by -- BODY let ρ := cfg.firstPredecessor have genealogy := BandParentBoundaryGenealogy ρ cfg.firstProper @@ -1921,25 +1893,25 @@ theorem BandOrderedGeneralPositiveCutGeometry (PositiveCutGeometry.boundary_to_raw (PositiveCutGeometry.boundary_edge_footprint) (PositiveCutGeometry.edge_vertex_footprint)) have raw_incident := PositiveCutGeometry.raw_incident - have haLeft : cert.exceptional_segments.a ∈ cert.exceptional_segments.left := - (PositiveCutGeometry.getLast_mem_of_eq_some) _ _ cert.exceptional_segments.left_last - have hbRight : cert.exceptional_segments.b ∈ cert.exceptional_segments.right := - (PositiveCutGeometry.head_mem_of_eq_some) _ _ cert.exceptional_segments.right_head - have hcutA := (cert.exceptional_segments.first_cut_unique - cert.exceptional_segments.a).mpr rfl - have hcutB := (cert.exceptional_segments.second_cut_unique - cert.exceptional_segments.b).mpr rfl + have haLeft : cert.exceptionalSegments.a ∈ cert.exceptionalSegments.left := + (PositiveCutGeometry.getLast_mem_of_eq_some) _ _ cert.exceptionalSegments.left_last + have hbRight : cert.exceptionalSegments.b ∈ cert.exceptionalSegments.right := + (PositiveCutGeometry.head_mem_of_eq_some) _ _ cert.exceptionalSegments.right_head + have hcutA := (cert.exceptionalSegments.first_cut_unique + cert.exceptionalSegments.a).mpr rfl + have hcutB := (cert.exceptionalSegments.second_cut_unique + cert.exceptionalSegments.b).mpr rfl have hQ2occ : ∃ j : Fin 4, - LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.Q 1 true).cells := + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.Q 1 true).cells := boundary_incident _ _ hQ2ne hcutA.1 have hS3occ : ∃ j : Fin 4, - LatticeVertexIncidentCell cert.exceptional_segments.a j ∈ (cert.S 2 false).cells := + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.S 2 false).cells := boundary_incident _ _ hS3ne hcutA.2.1 have hQ3occ : ∃ j : Fin 4, - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.Q 2 true).cells := + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q 2 true).cells := boundary_incident _ _ hQ3ne hcutB.1 have hS2occ : ∃ j : Fin 4, - LatticeVertexIncidentCell cert.exceptional_segments.b j ∈ (cert.S 1 false).cells := + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 false).cells := boundary_incident _ _ hS2ne hcutB.2.1 have hAowners := PositiveCutGeometry.hAowners q cfg C₀ T cert hO sector haLeft have hBowners := PositiveCutGeometry.hBowners q cfg C₀ T cert hO sector hbRight @@ -1977,19 +1949,19 @@ theorem BandOrderedGeneralPositiveCutGeometry have hneB_OS := ne_of_disjoint _ _ hS2O.symm hOne have hneB_OQ := ne_of_disjoint _ _ hOQ3 hOne have selected_p2_a := normalize_selected (cert.Q 1 true) (cert.S 2 false) cert.O - cert.exceptional_segments.a hneA_QS hneA_QO hneA_SO + cert.exceptionalSegments.a hneA_QS hneA_QO hneA_SO ((PositiveCutGeometry.selectA_Q q cfg C₀ T cert hQ2lat hS3lat hOlat hQ2check hS3check hOcheck hQ2occ hS3occ hAowners hOoccA hQS hSO hOQ) (cert.Q 1 true) (Or.inl rfl)) have selected_p2_b := normalize_selected (cert.S 1 false) (cert.Q 2 true) cert.O - cert.exceptional_segments.b hneB_SQ hneB_SO' hneB_QO' + cert.exceptionalSegments.b hneB_SQ hneB_SO' hneB_QO' ((PositiveCutGeometry.selectB_S q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck hQ3occ hS2occ hBowners hOoccB hQ3S2 hS2O hOQ3) (cert.S 1 false) (Or.inl rfl)) have selected_p4_a := normalize_selected cert.O (cert.Q 1 true) (cert.S 2 false) - cert.exceptional_segments.a hneA_OQ hneA_OS hneA_QS + cert.exceptionalSegments.a hneA_OQ hneA_OS hneA_QS ((PositiveCutGeometry.selectA_O q cfg C₀ T cert hQ2lat hS3lat hOlat hQ2check hS3check hOcheck hQ2occ hS3occ hAowners hOoccA hQS hSO hOQ) cert.O (Or.inl rfl)) have selected_p4_b := normalize_selected cert.O (cert.S 1 false) (cert.Q 2 true) - cert.exceptional_segments.b hneB_OS hneB_OQ hneB_SQ + cert.exceptionalSegments.b hneB_OS hneB_OQ hneB_SQ ((PositiveCutGeometry.selectB_O q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck hQ3occ hS2occ hBowners hOoccB hQ3S2 hS2O hOQ3) cert.O (Or.inl rfl)) let I : GaussianInt := ⟨0, 1⟩ diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutOdometerRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutOdometerRows.lean index bf764e9dbb..d0aad43693 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutOdometerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutOdometerRows.lean @@ -5,20 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData -public import LeanPool.ApollonianSuperharmonic.BandCircle -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandVectors public import LeanPool.ApollonianSuperharmonic.OdometerWeb -public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain public import LeanPool.ApollonianSuperharmonic.PositiveCutCompanionRow -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandOrderedGeneralPositiveCutOdometerRows] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean index af5b778b71..e5cc5b01ba 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean @@ -5,22 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation -public import LeanPool.ApollonianSuperharmonic.ExceptionalModifiedABPath public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths public import LeanPool.ApollonianSuperharmonic.P3161T2PathExhaustion public import LeanPool.ApollonianSuperharmonic.P3161T2PathSubwalk -public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary -public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TouchingTriple -- [TABLET NODE: BandOrderedGeneralRawSupport] @@ -89,7 +81,7 @@ private theorem hf1At170 : C₀ T), let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = c) → h = f ∨ h = g) @@ -110,7 +102,7 @@ private theorem hf3 : C₀ T), let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = c) → h = f ∨ h = g) @@ -129,12 +121,12 @@ private theorem hf13 : ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T), - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ f1 ≠ f3 ) := by classical intro q cfg C₀ T cert f1 f3 h - have := congrArg cert.modified_face_equiv h + have := congrArg cert.modifiedFaceEquivalence h simp [f1, f3] at this private theorem hpair : @@ -144,8 +136,8 @@ private theorem hpair : ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T), - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (f1 = f ∨ f1 = g) → ((f3 = f ∨ f3 = g) → ((f1 ≠ f3) → ((f1 = f ∧ f3 = g) ∨ (f1 = g ∧ f3 = f)))) ) := by classical @@ -191,8 +183,8 @@ private theorem hz13 : ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T), - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ let z1 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) let z3 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), ((f1 = f ∧ f3 = g) ∨ @@ -214,8 +206,8 @@ private theorem hcomplete : C₀ T), let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ let z1 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) let z3 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) (cert.modified.tile a = TileCellComplement (cert.P 0 true) cert.O) → ((cert.modified.tile @@ -250,7 +242,7 @@ private theorem hz1C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T), let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ let z1 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) (cert.modified.tile c = cert.P 1 true) → ((cert.modified.rho f1 = z1) → (z1 ∈ FootprintVertices (cert.P 1 true))) ) := by @@ -604,7 +596,7 @@ private theorem hf1At418 : C₀ T), let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = b) → h = f ∨ h = g) @@ -625,7 +617,7 @@ private theorem hf2 : C₀ T), let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ - let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + let f2 := cert.modifiedFaceEquivalence.symm ⟨.I2, 0, 0⟩ ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = b) → h = f ∨ h = g) @@ -644,12 +636,12 @@ private theorem hf12 : ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T), - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f2 := cert.modifiedFaceEquivalence.symm ⟨.I2, 0, 0⟩ f1 ≠ f2 ) := by classical intro q cfg C₀ T cert f1 f2 h - have := congrArg cert.modified_face_equiv h + have := congrArg cert.modifiedFaceEquivalence h simp [f1, f2] at this private theorem hexhaustAt438 : @@ -661,8 +653,8 @@ private theorem hexhaustAt438 : C₀ T), let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f2 := cert.modifiedFaceEquivalence.symm ⟨.I2, 0, 0⟩ (cert.modified.tile a = TileCellComplement (cert.P 0 true) cert.O) → ((cert.modified.tile b = cert.P 0 false) → (∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (SimpleGridPathBetween (CommonFootprintEdgeVertices @@ -790,8 +782,8 @@ theorem BandOrderedGeneralRawSupport · let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ let z1 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) let z3 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) have translation_zero (U : ProtoTile) : TileTranslation U 0 = U := @@ -913,8 +905,8 @@ theorem BandOrderedGeneralRawSupport (fun h => Or.inr (Or.inr (Or.inr h))) · let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f2 := cert.modifiedFaceEquivalence.symm ⟨.I2, 0, 0⟩ have translation_zero (U : ProtoTile) : TileTranslation U 0 = U := RawSupportGeometry.translation_zeroAt397 U have htileA : cert.modified.tile a = diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificate.lean index 9dcf9bb9fd..7a439ce9bb 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificate.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificate.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizationCertificate public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.TouchingTriple -- [TABLET NODE: BandOrderedGeneralRightInterfaceCertificate] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean index 90c6652bc6..ef48c50e24 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean @@ -5,24 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightInterfaceCertificate -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizationCertificate -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceDisjointCompanionEndpoints -public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricExactInterfaceTransport -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance public import LeanPool.ApollonianSuperharmonic.TileT3TranslateTouching public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandOrderedGeneralRightInterfaceCertificateExists] @@ -497,7 +487,8 @@ private theorem incoming_relation : have e0 := laws.2.2.1 have e1 := second.2.2.1 have e2 := third.2.2.1 - simp? [r, s] at e1 e2 + simp only [Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, Int.reduceNeg, + Matrix.cons_val, r, s] at e1 e2 rw [e0, e1, e2] calc _ = (1 - (⟨0, 1⟩ : GaussianInt)) * diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificate.lean index b7af2ca935..98d2ce1db4 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificate.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificate.lean @@ -5,14 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent -- [TABLET NODE: BandOrderedGeneralRightNormalizationCertificate] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean index 9b84bcf09a..99db983864 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean @@ -5,33 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5658T1FivePointDomainCoverSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizationCertificate -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandOrderedGeneralRightNormalizationCertificateExists] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizedBundleExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizedBundleExists.lean index 990481b84f..5d65ebc7da 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizedBundleExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizedBundleExists.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightInterfaceCertificateExists public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizationCertificateExists diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightOuterMarkingCriterion.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightOuterMarkingCriterion.lean index f37a1606dd..e027436d11 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightOuterMarkingCriterion.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightOuterMarkingCriterion.lean @@ -5,10 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightSelectedRowGeometry -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.P5478T1ExteriorPlacementIndex public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceExists public import LeanPool.ApollonianSuperharmonic.P5485T1OtherCompanionCoordinates diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightPlacement.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightPlacement.lean index 5477233d87..e89a0b99ad 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightPlacement.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightPlacement.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.TileTranslation -- [TABLET NODE: BandOrderedGeneralRightPlacement] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificate.lean index 0562304189..b6553dd932 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificate.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificate.lean @@ -5,12 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightInterfaceCertificate public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -- [TABLET NODE: BandOrderedGeneralRightRoutingCertificate] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean index 3d46cbb37e..58739813de 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean @@ -5,23 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightRoutingCertificate -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightInterfaceCertificate public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralShiftedRoutedBoundaryLocalization -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence public import LeanPool.ApollonianSuperharmonic.CoveredInterfaceOppositeIncidentCells public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandOrderedGeneralRightRoutingCertificateExists] @@ -141,7 +132,8 @@ private theorem incoming_relation : have e0 := laws.2.2.1 have e1 := second.2.2.1 have e2 := third.2.2.1 - simp? [r, s] at e1 e2 + simp only [Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, Int.reduceNeg, + Matrix.cons_val, r, s] at e1 e2 rw [e0, e1, e2] calc _ = (1 - (⟨0, 1⟩ : GaussianInt)) * @@ -776,8 +768,10 @@ private theorem hstar : centralSlot centralSign hcentral m n labelOf exteriorIndex centralIndex hexteriorCell hcentralCell exteriorCorners centralCorners y hy fin_cases j <;> - simp? [LatticeVertexIncidentCell, sub_eq_add_neg, add_assoc, - add_comm, add_left_comm] at exteriorCorners centralCorners + simp only [LatticeVertexIncidentCell, sub_eq_add_neg, Int.reduceNeg, add_assoc, + Fin.mk_one, Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, add_comm, + add_left_comm, add_neg_cancel, add_zero, Fin.reduceAdd, Matrix.cons_val, zero_add, + Fin.reduceFinMk, add_neg_cancel_left, Fin.zero_eta] at exteriorCorners centralCorners · rcases hy with rfl | rfl | rfl | rfl | rfl · exact Or.inl exteriorCorners.1 · exact Or.inl exteriorCorners.2.1 diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedAdjacency.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedAdjacency.lean index 70d29422d2..ece72007ce 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedAdjacency.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedAdjacency.lean @@ -5,28 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandCircle -public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightPlacement public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.P3045T1RightBoundaryDisplacementAlgebra public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.TileSubodometer -public import LeanPool.ApollonianSuperharmonic.TileTranslation public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandOrderedGeneralRightSelectedAdjacency] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean index bfcf94cb85..7f0787c061 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean @@ -5,65 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5640T1NonpairedOccurrenceIntersections -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence public import LeanPool.ApollonianSuperharmonic.P5635T1RightBoundaryInterfaceRecords -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightPlacement -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizationCertificate public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightInterfaceCertificateExists public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow -public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints -public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentRightEndpoint -public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation -public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.CellSupportedFootprintVertices -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceDisjointCompanionEndpoints -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths -public import LeanPool.ApollonianSuperharmonic.P3045T1RightBoundaryDisplacementAlgebra -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricExactInterfaceTransport -public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.TileCellComplement -public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileRealization -public import LeanPool.ApollonianSuperharmonic.TileT2QuarterTurn -public import LeanPool.ApollonianSuperharmonic.TileT3TranslateTouching -public import LeanPool.ApollonianSuperharmonic.TileTouching -public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TouchingTriple -public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance -public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandOrderedGeneralRightSelectedRowGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRoutedSelectedContact.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRoutedSelectedContact.lean index 679bc89842..361f5841c2 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRoutedSelectedContact.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRoutedSelectedContact.lean @@ -5,29 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRowExists -public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation -public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex -public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths -public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation public import LeanPool.ApollonianSuperharmonic.P3102T2IsolatedRoutedCellSurvival public import LeanPool.ApollonianSuperharmonic.P3102T2OppositeOwnersCommonEdge -public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.TileCellComplement -- [TABLET NODE: BandOrderedGeneralRoutedSelectedContact] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRow.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRow.lean index b7286a08fc..9cd0213d73 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRow.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRow.lean @@ -5,10 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.TileCentroid -- [TABLET NODE: BandOrderedGeneralSelectedContactRow] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRowExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRowExists.lean index fe30873985..962d30d37e 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRowExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedContactRowExists.lean @@ -5,22 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex public import LeanPool.ApollonianSuperharmonic.P3055T1ExteriorCentralIncidence -public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms public import LeanPool.ApollonianSuperharmonic.P3055T1SignedCentroidNormalForms -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandOrderedGeneralSelectedContactRowExists] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedSCompanionGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedSCompanionGeometry.lean index 2889426917..d440bea8cc 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedSCompanionGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSelectedSCompanionGeometry.lean @@ -5,17 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightPlacement public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.P3996T1CenteredQuarterTurnInclusion public import LeanPool.ApollonianSuperharmonic.P3996T1PlacementCompanionBlocks public import LeanPool.ApollonianSuperharmonic.P3996T1AdjacentParentPlacement public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentRightEndpoint public import LeanPool.ApollonianSuperharmonic.P3996T1SRowAlignment -public import LeanPool.ApollonianSuperharmonic.TileT2QuarterTurn -- [TABLET NODE: BandOrderedGeneralSelectedSCompanionGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralShiftedRoutedBoundaryLocalization.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralShiftedRoutedBoundaryLocalization.lean index 2e3fb64dfc..3d51447539 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralShiftedRoutedBoundaryLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralShiftedRoutedBoundaryLocalization.lean @@ -5,32 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRowExists -public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation -public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex -public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex -public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths public import LeanPool.ApollonianSuperharmonic.P3102T2IsolatedRoutedCellSurvival public import LeanPool.ApollonianSuperharmonic.P3102T2OppositeOwnersCommonEdge -public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.TileCellComplement -public import LeanPool.ApollonianSuperharmonic.TileRealization -public import LeanPool.ApollonianSuperharmonic.TopologicalDisk -- [TABLET NODE: BandOrderedGeneralShiftedRoutedBoundaryLocalization] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalRows.lean index 1ad5ef3971..f5dabf5a9b 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalRows.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalRows.lean @@ -5,8 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Basic.Real.Basic +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum + public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -- [TABLET NODE: BandOrderedGeneralSubtileCanonicalRows] @@ -115,7 +122,9 @@ theorem BandOrderedGeneralSubtileCanonicalRows rw [smul_fst] at hc1 ⊢ rw [smul_snd] at hc2 ⊢ fin_cases e - · simp? at hreInt himInt + · simp only [Int.reduceNeg, ↓reduceIte, one_mul, Zsqrtd.re_sub, Zsqrtd.re_mul, zero_mul, + mul_one, neg_mul, zero_add, sub_neg_eq_add, Zsqrtd.im_sub, Zsqrtd.im_mul] + at hreInt himInt norm_num only [Bool.true_eq, ↓reduceIte, GaussianRealPoint] at hc1 hc2 ⊢ dsimp at hc1 hc2 ⊢ constructor @@ -125,7 +134,9 @@ theorem BandOrderedGeneralSubtileCanonicalRows · have him : ((edge j).im : ℝ) - ((edge j).re : ℝ) + 2 * (d.im : ℝ) = (z.im : ℝ) := by exact_mod_cast himInt linarith - · simp? at hreInt himInt + · simp only [Int.reduceNeg, Bool.false_eq_true, ↓reduceIte, neg_mul, one_mul, neg_sub, + Zsqrtd.re_sub, Zsqrtd.re_mul, zero_mul, mul_one, zero_add, Zsqrtd.im_sub, + Zsqrtd.im_mul] at hreInt himInt norm_num only [Bool.false_eq_true, ↓reduceIte, GaussianRealPoint] at hc1 hc2 ⊢ dsimp at hc1 hc2 ⊢ constructor @@ -166,21 +177,26 @@ theorem BandOrderedGeneralSubtileCanonicalRows all_goals focus refine ⟨?_, ?_⟩ - · simp? [SubtileOccurrenceInterpretation] + · simp only [SubtileOccurrenceInterpretation, Fin.isValue, Int.cast_one, one_mul, + Int.cast_zero, zero_mul, add_zero, one_div, Int.reduceNeg, zero_add, Int.cast_neg, + neg_mul] norm_num rw [one_div] apply translatedCentroid apply Zsqrtd.ext <;> - simp [hu, hv, pow_succ, - ] at hsre hsim h0re h0im h1re h1im h2re h2im f0re f0im f1re f1im f2re f2im ⊢ <;> + simp at hsre hsim h0re h0im h1re h1im h2re h2im <;> + simp [hu, hv, pow_succ] at f0re f0im f1re f1im f2re f2im ⊢ <;> omega - · simp? [SubtileOccurrenceInterpretation] + · simp only [SubtileOccurrenceInterpretation, Fin.isValue, Int.cast_one, one_mul, + Int.cast_zero, zero_mul, add_zero, one_div, Int.reduceNeg, zero_add, Int.cast_neg, + neg_mul] norm_num rw [one_div] apply translatedCentroid apply Zsqrtd.ext <;> - simp [hu, hv, Fin.neg_def, pow_succ, - notEven3] at hsre hsim h0re h0im h1re h1im h2re h2im f0re f0im f1re f1im f2re f2im ⊢ <;> + simp at hsre hsim h0re h0im h1re h1im h2re h2im <;> + simp [hu, hv, pow_succ, notEven3, show (-1 : Fin 3) = 2 by decide] + at f0re f0im f1re f1im f2re f2im ⊢ <;> omega end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean index c15e863340..4ac9af916a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: BandOrderedGeneralSubtileCanonicalSeparation] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificate.lean index 15dd117718..ba359aa1cc 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificate.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificate.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileNormalizationCertificate public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.TouchingTriple -- [TABLET NODE: BandOrderedGeneralSubtileInterfaceCertificate] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean index 5742ba7897..494f72fadd 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean @@ -5,27 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileInterfaceCertificate public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileCanonicalRows public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileCanonicalSeparation -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMixedAggregatePatches -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells -public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleLatticeTouching public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleRetargetMiddle -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleSwapLast public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TouchingTriple -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandOrderedGeneralSubtileInterfaceCertificateExists] @@ -252,7 +240,9 @@ private theorem occurrenceBand : classical intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q j e m n fin_cases j <;> cases e <;> - simp? [subtileOccurrenceLabel, Q, SubtileOccurrenceInterpretation] + simp only [Fin.mk_one, Fin.isValue, Fin.succ_one_eq_two, SubtileOccurrenceInterpretation, + subtileOccurrenceLabel, Q, Fin.reduceFinMk, Fin.reduceSucc, Fin.zero_eta, + Fin.succ_zero_eq_one] all_goals first | exact BandPrototileTranslation _ _ _ (normalization.layout.outer_occurrence 0 false).1 @@ -470,7 +460,10 @@ private theorem hUBand : generalize hp : normalization.normalizedParentSlot = p generalize ht : normalization.normalizedQuarterTurn = t fin_cases p <;> fin_cases t <;> - simp? [Q, U, uIndex, hp, ht, SubtileOccurrenceInterpretation] + simp only [Fin.mk_one, Fin.isValue, Fin.succ_one_eq_two, SubtileOccurrenceInterpretation, + hp, one_ne_zero, ↓reduceIte, ht, Fin.reduceFinMk, Fin.reduceEq, Int.cast_one, one_mul, + Int.cast_zero, zero_mul, add_zero, Q, U, uIndex, Int.reduceNeg, Int.cast_neg, neg_mul, + Fin.zero_eta, Fin.reduceSucc, zero_add, Fin.succ_zero_eq_one] all_goals first | exact BandPrototileTranslation _ _ _ (normalization.layout.outer_occurrence 0 true).1 @@ -519,7 +512,12 @@ private theorem hVBand : generalize hp : normalization.normalizedParentSlot = p generalize ht : normalization.normalizedQuarterTurn = t fin_cases p <;> fin_cases t <;> - simp? [V, vIndex, hp, ht, SubtileOccurrenceInterpretation] <;> + simp only [Even.zero, ↓reduceIte, Fin.mk_one, Fin.isValue, Fin.reduceAdd, Fin.reduceSucc, + SubtileOccurrenceInterpretation, hp, one_ne_zero, ht, Fin.zero_eta, Int.cast_zero, + zero_mul, Int.cast_one, one_mul, zero_add, V, vIndex, Fin.reduceFinMk, + Fin.succ_zero_eq_one, Fin.reduceEq, Int.reduceNeg, Int.cast_neg, neg_mul, + Fin.succ_one_eq_two, add_zero, sub_self, Fin.reduceSub, zero_sub, Nat.not_even_one, + even_two] <;> first | exact BandPrototileTranslation _ _ _ (normalization.layout.outer_occurrence 0 true).1 @@ -567,7 +565,10 @@ private theorem hUSym : generalize hp : normalization.normalizedParentSlot = p generalize ht : normalization.normalizedQuarterTurn = t fin_cases p <;> fin_cases t <;> - simp? [U, uIndex, hp, ht, SubtileOccurrenceInterpretation] <;> + simp only [SubtileOccurrenceInterpretation, hp, Fin.mk_one, Fin.isValue, one_ne_zero, + ↓reduceIte, ht, Fin.reduceFinMk, Fin.reduceEq, Int.cast_one, one_mul, Int.cast_zero, + zero_mul, add_zero, U, uIndex, Int.reduceNeg, Int.cast_neg, neg_mul, Fin.zero_eta, + zero_add] <;> apply quarterSymmetricTranslation <;> first | exact normalization.layout.parent_quarter_turn 0 true @@ -874,7 +875,10 @@ private theorem hUbarBand : generalize hp : normalization.normalizedParentSlot = p generalize ht : normalization.normalizedQuarterTurn = t fin_cases p <;> fin_cases t <;> - simp? [Q, Ubar, uBar, hp, ht, SubtileOccurrenceInterpretation] + simp only [Fin.mk_one, Fin.isValue, Fin.succ_one_eq_two, SubtileOccurrenceInterpretation, + hp, one_ne_zero, ↓reduceIte, ht, Fin.reduceFinMk, Fin.reduceEq, Int.cast_one, one_mul, + Int.cast_zero, zero_mul, add_zero, Q, Ubar, uBar, Fin.zero_eta, Int.reduceNeg, + Int.cast_neg, neg_mul, Fin.reduceSucc, zero_add, Fin.succ_zero_eq_one] all_goals first | exact BandPrototileTranslation _ _ _ (normalization.layout.outer_occurrence 0 true).1 @@ -1135,7 +1139,10 @@ private theorem hVbarBand : generalize hp : normalization.normalizedParentSlot = p generalize ht : normalization.normalizedQuarterTurn = t fin_cases p <;> fin_cases t <;> - simp? [Vbar, vBar, hp, ht] <;> + simp only [Even.zero, ↓reduceIte, Fin.mk_one, Fin.isValue, Fin.reduceAdd, Fin.reduceSucc, + hp, one_ne_zero, ht, Fin.zero_eta, Int.reduceNeg, Vbar, vBar, Fin.reduceFinMk, + Fin.succ_zero_eq_one, Fin.reduceEq, zero_add, Fin.succ_one_eq_two, sub_self, + Fin.reduceSub, zero_sub, Nat.not_even_one, even_two] <;> first | exact occurrenceBand 0 true _ _ | exact occurrenceBand 0 false _ _ @@ -1177,7 +1184,10 @@ private theorem hVSym : generalize hp : normalization.normalizedParentSlot = p generalize ht : normalization.normalizedQuarterTurn = t fin_cases p <;> fin_cases t <;> - simp? [V, vIndex, hp, ht, SubtileOccurrenceInterpretation] <;> + simp only [SubtileOccurrenceInterpretation, hp, Fin.mk_one, Fin.isValue, one_ne_zero, + ↓reduceIte, ht, Fin.reduceFinMk, Fin.reduceEq, Int.reduceNeg, Int.cast_zero, zero_mul, + Int.cast_neg, Int.cast_one, neg_mul, one_mul, zero_add, V, vIndex, Fin.zero_eta, + add_zero] <;> apply quarterSymmetricTranslation <;> first | exact normalization.layout.parent_quarter_turn 0 true diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificate.lean index 6bc85a00a6..e4a881c86e 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificate.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificate.lean @@ -5,15 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent -- [TABLET NODE: BandOrderedGeneralSubtileNormalizationCertificate] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean index f173f9ae7e..e1d649f039 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean @@ -5,33 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5658T1FivePointDomainCoverSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileNormalizationCertificate -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileCanonicalRows -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandOrderedGeneralSubtileNormalizationCertificateExists] @@ -52,8 +33,8 @@ private theorem hqrotSemi : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (q' : Fin (4 : ℕ) → - CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), ( + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ( ∀ (r : Fin (3 : ℕ)), ∀ (g + : BandPackingSymmetry), ( let q' := BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : @@ -63,7 +44,7 @@ private theorem hqrotSemi : ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] SemiProperQuadruple qrot)) ) := by classical - intro q hq q' r g hregime qrot + intro q hq r g hregime qrot fin_cases r · convert hq.1 using 1; funext j; fin_cases j <;> simp [qrot] · convert SemiProperQuadruple.rotate hq.1 using 1; @@ -76,8 +57,8 @@ private theorem hqrot : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (q' : Fin (4 : ℕ) → - CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), ( + ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ( ∀ (r : Fin (3 : ℕ)), ∀ (g + : BandPackingSymmetry), ( let q' := BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : @@ -87,7 +68,7 @@ private theorem hqrot : ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] (SemiProperQuadruple qrot) → (ProperBandQuadruple qrot))) ) := by classical - intro q hq q' r g hregime qrot hqrotSemi + intro q hq r g hregime qrot hqrotSemi refine ⟨hqrotSemi, ?_⟩ intro j fin_cases r <;> fin_cases j <;> simp [qrot] @@ -109,8 +90,8 @@ private theorem hgeneral : (P : FordFareyParameter), BandPackingSymmetryCircleAction g (FordCircleCoordinate P.p P.q) = C₀.1.1) ∨ ∃ (g : BandPackingSymmetry) (K : DiamondParameter), BandPackingSymmetryCircleAction g (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ))) = - C₀.1.1)) → ((q (0 : Fin (4 : ℕ)) = C₀.1.1) → (∀ (q' : Fin (4 : ℕ) → - CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), ( + C₀.1.1)) → ((q (0 : Fin (4 : ℕ)) = C₀.1.1) → ( ∀ (r : Fin (3 : ℕ)), ∀ (g : + BandPackingSymmetry), ( let q' := BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : @@ -121,7 +102,7 @@ private theorem hgeneral : let qbar := BandPackingSymmetryQuadrupleAction g qrot Nonempty (BandOrderedGeneralConfiguration qbar)))) ) := by classical - intro C₀ q horbit hq₀ q' r g hregime qrot qbar + intro C₀ q horbit hq₀ r g hregime qrot qbar dsimp [qbar, qrot] at hregime rcases hregime with hford | hrest · exfalso @@ -877,7 +858,10 @@ private theorem hexteriorBand : generalize hi : ibar = j at ⊢ generalize hs : sbar = t at ⊢ fin_cases j <;> fin_cases t <;> - simp? [exteriorIndex, hi, hs, SubtileOccurrenceInterpretation] + simp only [Fin.mk_one, Fin.isValue, Fin.succ_one_eq_two, SubtileOccurrenceInterpretation, + hi, one_ne_zero, ↓reduceIte, hs, Fin.reduceFinMk, Fin.reduceEq, Int.cast_one, one_mul, + Int.cast_zero, zero_mul, add_zero, exteriorIndex, Int.reduceNeg, Int.cast_neg, + neg_mul, Fin.zero_eta, Fin.reduceSucc, zero_add, Fin.succ_zero_eq_one] all_goals first | exact BandPrototileTranslation _ _ _ (layout.outer_occurrence 0 false).1 | exact BandPrototileTranslation _ _ _ (layout.outer_occurrence 0 true).1 @@ -1269,9 +1253,9 @@ theorem BandOrderedGeneralSubtileNormalizationCertificateExists obtain ⟨r, g, hregime⟩ := BandRegimeClassification q hq let qrot : Fin 4 → CircleCoordinates := ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - have hqrotSemi : SemiProperQuadruple qrot := SubtileNormalizationGeometry.hqrotSemi q hq q' r g + have hqrotSemi : SemiProperQuadruple qrot := SubtileNormalizationGeometry.hqrotSemi q hq r g hregime - have hqrot : ProperBandQuadruple qrot := SubtileNormalizationGeometry.hqrot q hq q' r g hregime + have hqrot : ProperBandQuadruple qrot := SubtileNormalizationGeometry.hqrot q hq r g hregime hqrotSemi let irot : Fin 3 := i - r have hrotParent : qrot irot.succ = q i.succ := by @@ -1283,7 +1267,7 @@ theorem BandOrderedGeneralSubtileNormalizationCertificateExists have hqbar₀ : qbar 0 = BandPackingSymmetryCircleAction g C₀.1.1 := by simp [qbar, qrot, BandPackingSymmetryQuadrupleAction, hq₀] have hgeneral : Nonempty (BandOrderedGeneralConfiguration qbar) := - SubtileNormalizationGeometry.hgeneral C₀ q horbit hq₀ q' r g hregime + SubtileNormalizationGeometry.hgeneral C₀ q horbit hq₀ r g hregime obtain ⟨cfg⟩ := hgeneral have hO₀rot : TileOdometer (qrot 0) T₀ h₀ := SubtileNormalizationGeometry.hO₀rot C₀ q T₀ h₀ hO₀ r hqrot₀ diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizedBundleExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizedBundleExists.lean index 4132c71e4c..e05e7f1b78 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizedBundleExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizedBundleExists.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileInterfaceCertificateExists public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileNormalizationCertificateExists diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtilePlacement.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtilePlacement.lean index c4d4f6f288..907bdf04ef 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtilePlacement.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtilePlacement.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -- [TABLET NODE: BandOrderedGeneralSubtilePlacement] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificate.lean index 4e8a242b3c..30f0d0067e 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificate.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificate.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileInterfaceCertificate public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -- [TABLET NODE: BandOrderedGeneralSubtileRoutingCertificate] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificateExists.lean index cdda0461b5..15c6ee1ee2 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileRoutingCertificateExists.lean @@ -5,14 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileRoutingCertificate public import LeanPool.ApollonianSuperharmonic.CoveredInterfaceOppositeIncidentCells public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity -public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -- [TABLET NODE: BandOrderedGeneralSubtileRoutingCertificateExists] @@ -130,7 +127,9 @@ theorem BandOrderedGeneralSubtileRoutingCertificateExists (LatticeVertexIncidentCell normalization.normalizedPoint (direction + 2)) hexteriorCell intro y hy fin_cases direction <;> - simp? [LatticeVertexIncidentCell] at hcentralCell hexteriorCell ⊢ <;> + simp only [LatticeVertexIncidentCell, Int.reduceNeg, Fin.mk_one, Fin.isValue, + Matrix.cons_val_one, Matrix.cons_val_zero, Fin.reduceAdd, Matrix.cons_val, + Fin.reduceFinMk, Fin.zero_eta, zero_add] at hcentralCell hexteriorCell ⊢ <;> rcases hy with rfl | rfl | rfl | rfl | rfl <;> solve | apply Or.inr diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileSelectedRowGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileSelectedRowGeometry.lean index e98ea5e847..e0b210d723 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileSelectedRowGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileSelectedRowGeometry.lean @@ -5,17 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceExists -public import LeanPool.ApollonianSuperharmonic.P4418T3OuterCompanionAlignment public import LeanPool.ApollonianSuperharmonic.P4418T3PresentedRowAdjacency public import LeanPool.ApollonianSuperharmonic.P4418T3RoutedBlockCriterion public import LeanPool.ApollonianSuperharmonic.P4418T3NestedCompanionGeometry public import LeanPool.ApollonianSuperharmonic.P4418T3NestedCompanionEndpoint public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality public import LeanPool.ApollonianSuperharmonic.TileSubodometer -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: BandOrderedGeneralSubtileSelectedRowGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryOccurrenceGenealogy.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryOccurrenceGenealogy.lean index 55db3edb8f..2ba2243a7a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryOccurrenceGenealogy.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryOccurrenceGenealogy.lean @@ -5,19 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrientedBoundaryParentChain -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandVectors -public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation -public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorsExistUnique -public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation -public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep -public import LeanPool.ApollonianSuperharmonic.P4566T1LiteralSuccessorCharts public import LeanPool.ApollonianSuperharmonic.P4566T1SmallRetainedSides public import LeanPool.ApollonianSuperharmonic.P4566T1StrictRetainedGenealogy diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryParentChain.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryParentChain.lean index 9a9fc0a261..c7ee68e896 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryParentChain.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedBoundaryParentChain.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -- [TABLET NODE: BandOrientedBoundaryParentChain] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentEndpoints.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentEndpoints.lean index b25e963877..65e47734a0 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentEndpoints.lean @@ -5,15 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentEndpoints public import LeanPool.ApollonianSuperharmonic.DiamondOrientedChildParentEndpoints -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout public import LeanPool.ApollonianSuperharmonic.P4055T1PlacementNormalization public import LeanPool.ApollonianSuperharmonic.P4055T1BandQuarterTurn public import LeanPool.ApollonianSuperharmonic.P4055T1OrderedGeneralOppositeEndpoints -public import LeanPool.ApollonianSuperharmonic.P4055T1PackingGridEquivalence -public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage -- [TABLET NODE: BandOrientedChildParentEndpoints] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentIncomingEndpoint.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentIncomingEndpoint.lean index bb84c8e444..6f73de9d37 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentIncomingEndpoint.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentIncomingEndpoint.lean @@ -5,17 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriplePackingSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentIncomingEndpoint -public import LeanPool.ApollonianSuperharmonic.OrientedTouchingCovariance -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.P4055T1BandQuarterTurn public import LeanPool.ApollonianSuperharmonic.P4085T1FordIncomingNormalization public import LeanPool.ApollonianSuperharmonic.P4085T1MinusTouching @@ -147,7 +141,11 @@ theorem BandOrientedChildParentIncomingEndpoint rw [(TileTranslationFormulas W _).2.2.2.2.1] have h₁ := congrArg Prod.fst hminus have h₂ := congrArg Prod.snd hminus - simp? [GaussianRealPoint, GaussianQuarterTurn] at h₁ h₂ ⊢ + simp only [Prod.fst_sub, one_div, GaussianRealPoint, Int.reduceNeg, + GaussianQuarterTurn, Zsqrtd.re_sub, sub_neg_eq_add, Int.cast_add, + GaussianInt.intCast_re, GaussianInt.intCast_im, Zsqrtd.im_sub, Int.cast_sub, + Prod.smul_mk, smul_eq_mul, Prod.snd_sub, Int.cast_neg, Zsqrtd.re_add, + Zsqrtd.im_add] at h₁ h₂ ⊢ apply Prod.ext <;> dsimp <;> linarith have hp := oriented (TileTranslation W (GaussianQuarterTurn y)) t (BandPrototileTranslation _ _ _ hW) hcplus diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean index 457c1059a8..7908c1467b 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean @@ -5,28 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototile public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriplePackingSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentRightEndpoint -public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandOrientedChildParentRightEndpoint] @@ -634,9 +619,9 @@ private theorem middleVector : classical intro r i s a P g k phaseForward phaseBackward actionCommute by_cases parity : Even s.val - · simp? [parity] + · simp only [Int.reduceNeg, parity, ↓reduceIte, Fin.isValue] rw [actionCommute, phaseBackward] - · simp? [parity] + · simp only [Int.reduceNeg, parity, ↓reduceIte, Fin.isValue] rw [actionCommute, phaseForward] private theorem transformedTriple : diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedGapRefinement.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedGapRefinement.lean index 7f7321d09e..09319384a5 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrientedGapRefinement.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedGapRefinement.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingExterior public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedGapRefinementExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedGapRefinementExists.lean index c35d94ebef..45c7b4c9ca 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrientedGapRefinementExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedGapRefinementExists.lean @@ -5,22 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandDescartesGapSubdivision +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandGenealogy public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification public import LeanPool.ApollonianSuperharmonic.BandOrientedGapRefinement -public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -public import LeanPool.ApollonianSuperharmonic.BandCircle -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision -public import LeanPool.ApollonianSuperharmonic.BandPackingExterior -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle -public import LeanPool.ApollonianSuperharmonic.P4828T1HistoryRealization -public import LeanPool.ApollonianSuperharmonic.P4828T1HistoryNormalForm -public import LeanPool.ApollonianSuperharmonic.P4984T1RootGaps -public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedSubdivision -public import LeanPool.ApollonianSuperharmonic.P4984T1ContactDiameter public import LeanPool.ApollonianSuperharmonic.P4984T1IncidentArcs public import LeanPool.ApollonianSuperharmonic.P4984T1UnitIncidence public import LeanPool.ApollonianSuperharmonic.P4984T1BranchDecay diff --git a/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean b/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean index 094cf47838..1343aa9d9b 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean @@ -5,24 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation -public import LeanPool.ApollonianSuperharmonic.CellSupportedFootprintVertices public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths -public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.TileCellComplement public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance -public import LeanPool.ApollonianSuperharmonic.TileRealization -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TopologicalDisk -- [TABLET NODE: BandOriginalOccurrenceIntersectionClassification] diff --git a/LeanPool/ApollonianSuperharmonic/BandOriginalPairSeparation.lean b/LeanPool/ApollonianSuperharmonic/BandOriginalPairSeparation.lean index f4d9755eba..0a098daf5c 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOriginalPairSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOriginalPairSeparation.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandModifiedCellPartition +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation -- [TABLET NODE: BandOriginalPairSeparation] diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingExterior.lean b/LeanPool/ApollonianSuperharmonic/BandPackingExterior.lean index f78154cce8..0c6426bf4f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingExterior.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingExterior.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData +public import Mathlib.Analysis.Complex.Basic -- [TABLET NODE: BandPackingExterior] diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingShiftPotential.lean b/LeanPool/ApollonianSuperharmonic/BandPackingShiftPotential.lean index 907d1364f9..95b52846d9 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingShiftPotential.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingShiftPotential.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: BandPackingShiftPotential] diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetry.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetry.lean index 4761a2db84..f9f706b23e 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetry.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: BandPackingSymmetry] diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorAction.lean index bef0f6fb34..43b2f1225c 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorAction.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorAction.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn public import LeanPool.ApollonianSuperharmonic.GaussianReflection diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean index 9ec2459162..5d7dae7842 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean @@ -5,21 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.BandVectors -public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity -public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct -- [TABLET NODE: BandPackingSymmetryAffineVectorCovariance] @@ -76,8 +66,8 @@ private theorem affineFacts : ⟨hv, ha⟩ | shift w => intro D E v a hv ha - simp? [BandPackingSymmetryAffineVectorAction, - BandPackingSymmetryVectorAction, BandPackingSymmetryCircleAction] + simp only [BandPackingSymmetryAffineVectorAction, BandPackingSymmetryVectorAction, + Int.reduceNeg, BandPackingSymmetryCircleAction, true_and] constructor · exact hv · have reflectionProduct : v * GaussianReflection v = @@ -940,7 +930,8 @@ theorem BandPackingSymmetryAffineVectorCovariance V ≠ 0 → c * d = 1 → 2 * V * A = 2 * (c * V) * b → b = d * A := AffineSymmetryCoordinates.unitCancel by_cases hrev : BandPackingSymmetryReversesOrientation g = true - · simp? [hrev] at hspatial + · simp only [hrev, ↓reduceIte, Fin.isValue, ite_mul, neg_mul, one_mul, mul_neg] + at hspatial let j : Fin 4 := (i + 2).succ let k : Fin 4 := (i + 1).succ let V := (BandPackingSymmetryAffineVectorAction g @@ -991,13 +982,14 @@ theorem BandPackingSymmetryAffineVectorCovariance BandVectors.2 (q (i + 2).succ) (q (i + 1).succ))).2 = A := AffineSymmetryCoordinates.slopeIndex g q i rw [slopeIndex] - cases negative <;> simp? [epsilon, hrev, j, - mul_comm] at final ⊢ + cases negative <;> simp only [Fin.isValue, Bool.false_eq_true, ↓reduceIte, mul_comm, + mul_neg, one_mul, neg_mul, hrev, epsilon, j, neg_neg] at final ⊢ · rw [quarterMul A] exact final · rw [quarterMul A] exact final - · simp? [hrev] at hspatial + · simp only [hrev, Bool.false_eq_true, ↓reduceIte, Fin.isValue, ite_mul, neg_mul, one_mul] + at hspatial let j : Fin 4 := (i + 2).succ let k : Fin 4 := (i + 1).succ let V := (BandPackingSymmetryAffineVectorAction g @@ -1030,7 +1022,8 @@ theorem BandPackingSymmetryAffineVectorCovariance have hi2 : ((if BandPackingSymmetryReversesOrientation g then -i else i) + 1).succ = (i + 1).succ := by simp [hrev] rw [hi1, hi2] - cases negative <;> simp? [epsilon, hrev] at final ⊢ + cases negative <;> simp only [Fin.isValue, Bool.false_eq_true, ↓reduceIte, one_mul, + hrev, epsilon, neg_mul] at final ⊢ · exact final · exact final diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCircleAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCircleAction.lean index b7f84d4544..ddad45f9c8 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCircleAction.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCircleAction.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry public import LeanPool.ApollonianSuperharmonic.CircleCoordinates public import LeanPool.ApollonianSuperharmonic.GaussianReflection diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCovariance.lean index 42ab2af0c4..6a5c79cb31 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCovariance.lean @@ -5,18 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.BandPrototile public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryGlobalOdometerTransport.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryGlobalOdometerTransport.lean index 78f9b6c676..f5dd285235 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryGlobalOdometerTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryGlobalOdometerTransport.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5686T1UniformGlobalOdometerTransport -- [TABLET NODE: BandPackingSymmetryGlobalOdometerTransport] diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryInversePhaseCancellation.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryInversePhaseCancellation.lean index c140c44baa..742b42da6e 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryInversePhaseCancellation.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryInversePhaseCancellation.lean @@ -5,21 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -- [TABLET NODE: BandPackingSymmetryInversePhaseCancellation] @@ -104,7 +96,11 @@ private theorem phaseComposition : cases rb : BandPackingSymmetryReversesOrientation b <;> cases db <;> cases da <;> fin_cases i all_goals - simp? [BandPackingSymmetryReversesOrientation, ra, rb] at hbi hai ⊢ + simp only [rb, Bool.false_eq_true, ↓reduceIte, Fin.mk_one, Fin.isValue, + Fin.succ_one_eq_two, neg_mul, one_mul, Fin.reduceAdd, Fin.succ_zero_eq_one, + Fin.reduceSucc, ra, BandPackingSymmetryReversesOrientation, bne_self_eq_false, + Bool.bne_false, mul_neg, neg_add_cancel, neg_neg, Bool.bne_true, Bool.not_false, + Fin.reduceFinMk, Fin.zero_eta, zero_add, neg_zero] at hbi hai ⊢ simp only [composition] rcases hbi with ⟨bin, brev, bcyc⟩ rcases hai with ⟨ain, arev, acyc⟩ diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean index c51f944f81..96f5e29ea3 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean @@ -5,32 +5,17 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TileSubodometer -public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandPackingSymmetryMarkedDataCovariance] @@ -55,8 +40,12 @@ private theorem negCellMap : GaussianQuarterTurn (LatticeVertexIncidentCell x (j - 1)) - 1 ) := by classical intro x j - fin_cases j <;> simp? [LatticeVertexIncidentCell, GaussianQuarterTurn, - Fin.sub_def] <;> ext <;> simp + fin_cases j <;> simp only [LatticeVertexIncidentCell, GaussianQuarterTurn, Int.reduceNeg, + Fin.mk_one, Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, sub_self, + Fin.reduceFinMk, Matrix.cons_val, Fin.sub_def, Fin.coe_ofNat_eq_mod, Nat.one_mod, + Nat.add_one_sub_one, Nat.mod_succ, Nat.reduceAdd, Nat.reduceMod, Zsqrtd.im_sub, + Zsqrtd.im_one, sub_zero, neg_sub, Zsqrtd.re_sub, Zsqrtd.re_one, Fin.zero_eta, zero_sub] <;> + ext <;> simp private theorem negStar : (by @@ -120,8 +109,11 @@ private theorem conjugateCellMap : -GaussianReflection (LatticeVertexIncidentCell x (1 - j)) - 1 ) := by classical intro x j - fin_cases j <;> simp? [LatticeVertexIncidentCell, GaussianReflection, - Fin.sub_def] <;> ext <;> simp + fin_cases j <;> simp only [LatticeVertexIncidentCell, GaussianReflection, Int.reduceNeg, + Fin.mk_one, Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, sub_self, + Fin.reduceFinMk, Matrix.cons_val, Fin.sub_def, Fin.coe_ofNat_eq_mod, Nat.mod_succ, + Nat.reduceSub, Nat.one_mod, Nat.reduceAdd, Nat.reduceMod, Zsqrtd.re_sub, Zsqrtd.re_one, + sub_zero, Zsqrtd.im_sub, Zsqrtd.im_one, neg_sub, Fin.zero_eta] <;> ext <;> simp private theorem conjugateCells : (by @@ -590,7 +582,7 @@ private theorem hAphase : classical exact ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : - ℕ)), ∀ (e : Bool), ∀ (delta : Bool), (∀ (i : Fin (3 : ℕ)), + ℕ)), ∀ (delta : Bool), (∀ (i : Fin (3 : ℕ)), let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); @@ -619,7 +611,7 @@ private theorem hAphase : (BandPackingSymmetryAffineVectorAction g Z).2 else (BandPackingSymmetryAffineVectorAction g Z).2)) ) := by classical - intro g q i e delta hcyc q' sigma W A Z A' + intro g q i delta hcyc q' sigma W A Z A' simpa [A', Z, q', sigma, BandPackingSymmetryReversesOrientation] using (hcyc i).2 @@ -778,8 +770,11 @@ private theorem hcentGoal : cases delta <;> simpa [GaussianRealPoint, smul_eq_mul] using hh rw [hpointSign] cases e <;> cases delta <;> - simp? [e', k, eReal, smul_eq_mul, - GaussianRealPoint] <;> ring <;> trivial + simp only [Bool.false_eq_true, ↓reduceIte, GaussianRealPoint, Int.reduceNeg, + GaussianInt.intCast_re, GaussianInt.intCast_im, Prod.smul_mk, smul_eq_mul, + Bool.bne_true, Bool.not_false, one_div, neg_smul, one_smul, Prod.neg_mk, mul_neg, + Prod.mk.injEq, k, eReal, e', bne_self_eq_false, Bool.bne_false, neg_neg] <;> ring <;> + trivial _ = _ := by rfl private theorem hposC : @@ -921,7 +916,7 @@ private theorem hAphase2 : classical exact ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : - ℕ)), ∀ (e : Bool), ∀ (delta : Bool), (∀ (i : Fin (3 : ℕ)), + ℕ)), ∀ (delta : Bool), (∀ (i : Fin (3 : ℕ)), let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); @@ -950,7 +945,7 @@ private theorem hAphase2 : (BandPackingSymmetryAffineVectorAction g Z).2 else (BandPackingSymmetryAffineVectorAction g Z).2)) ) := by classical - intro g q i e delta hcyc q' sigma W A Z A' + intro g q i delta hcyc q' sigma W A Z A' simpa [A', Z, q', sigma, BandPackingSymmetryReversesOrientation] using (hcyc i).2 @@ -1060,7 +1055,7 @@ private theorem hpointSignAt762 : classical exact ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : - ℕ)), ∀ (e : Bool), ∀ (delta : Bool), (BandPackingSymmetryScopedPhase g q delta) → ((∀ + ℕ)), ∀ (delta : Bool), (BandPackingSymmetryScopedPhase g q delta) → ((∀ (i : Fin (3 : ℕ)), let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : @@ -1101,7 +1096,7 @@ private theorem hpointSignAt762 : GaussianQuarterTurn A') = (if delta then (-1 : ℝ) else 1) • GaussianRealPoint (BandPackingSymmetryAffineVectorAction g M).2))))) ) := by classical - intro g q i e delta hphase hcyc q' sigma W A Z M W' A' hWphase2 hAphase2 hMphase2 + intro g q i delta hphase hcyc q' sigma W A Z M W' A' hWphase2 hAphase2 hMphase2 have hh := congrArg (fun z : GaussianInt × GaussianInt => GaussianRealPoint z.2) hMphase2 cases delta <;> simpa [GaussianRealPoint, smul_eq_mul] using hh @@ -1615,7 +1610,7 @@ private theorem forwardSub : have hpat : M = Z + -affineQuarter Z := by ext <;> simp [M, Z, affineQuarter, GaussianQuarterTurn]; ring have hactM := MarkedCovarianceGeometry.hactM affineFacts g q i hpat - have hAphase := MarkedCovarianceGeometry.hAphase g q i e delta hcyc + have hAphase := MarkedCovarianceGeometry.hAphase g q i delta hcyc have hMphase := MarkedCovarianceGeometry.hMphase g q i e delta hphase hcyc hWphase haffFst hactM hAphase have hmFst := congrArg Prod.fst hMphase @@ -1647,13 +1642,13 @@ private theorem forwardSub : let r' := BandPackingSymmetrySlopeAction g T' p' have hdiff := MarkedCovarianceGeometry.hdiff g T T' q i e p p' htrSlope have hWphase2 := MarkedCovarianceGeometry.hWphase2 g q i delta hphase - have hAphase2 := MarkedCovarianceGeometry.hAphase2 g q i e delta hcyc + have hAphase2 := MarkedCovarianceGeometry.hAphase2 g q i delta hcyc have hpat2 : M = Z + -affineQuarter Z := by ext <;> simp [M, Z, affineQuarter, GaussianQuarterTurn]; ring have hactM2 := MarkedCovarianceGeometry.hactM2 affineFacts g q i hpat2 have hMphase2 := MarkedCovarianceGeometry.hMphase2 affineFirst g q i e delta hphase hcyc hWphase2 hAphase2 hactM2 - have hpointSign := MarkedCovarianceGeometry.hpointSignAt762 g q i e delta hphase hcyc + have hpointSign := MarkedCovarianceGeometry.hpointSignAt762 g q i delta hphase hcyc hWphase2 hAphase2 hMphase2 have hdiff' := MarkedCovarianceGeometry.hdiff' g T T' q i e hcent delta hphase hcyc hcentM p p' hRe hIm hsourceSlope htrSlope hdiff hWphase2 hAphase2 hMphase2 hpointSign diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerAction.lean index b345663483..0e3898fcda 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerAction.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerAction.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerActionFormulas.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerActionFormulas.lean index 3353ac85d5..df751f47d7 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerActionFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryPartialOdometerActionFormulas.lean @@ -5,15 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -public import LeanPool.ApollonianSuperharmonic.GaussianReflection public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope -public import LeanPool.ApollonianSuperharmonic.P2999T1CompleteSquareTransport public import LeanPool.ApollonianSuperharmonic.P2999T1OrthogonalSlopeTransport public import LeanPool.ApollonianSuperharmonic.P2999T1ShiftSlopeTransport diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProjectiveVectorCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProjectiveVectorCovariance.lean index 443e90968a..2ad1de4c89 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProjectiveVectorCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProjectiveVectorCovariance.lean @@ -5,17 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct -- [TABLET NODE: BandPackingSymmetryProjectiveVectorCovariance] @@ -177,8 +171,11 @@ private theorem squareEdges : (j + 2).succ (j + 1).succ hj).1 cases he : O h <;> fin_cases i all_goals - simp? [j, W, T, O, A, BandPackingSymmetryQuadrupleAction, - he, neg1, neg2, zsmul_eq_mul] at hs' hs ⊢ + simp only [he, Bool.false_eq_true, ↓reduceIte, Fin.mk_one, Fin.isValue, Fin.reduceAdd, + Fin.succ_zero_eq_one, BandPackingSymmetryQuadrupleAction, Fin.succ_one_eq_two, + Fin.reduceSucc, Matrix.cons_val_one, Matrix.cons_val_zero, Matrix.cons_val, + zsmul_eq_mul, T, j, O, W, A, Fin.reduceFinMk, Fin.zero_eta, zero_add, neg1, neg_zero, + neg2] at hs' hs ⊢ first | exact hs'.trans hs.symm | rw [mul_pow, ii_sq, hs', hs]; ring @@ -285,7 +282,10 @@ private theorem phaseExists : simp only [sub_eq_add_neg, ladd, lneg, lquarter] cases he : O h <;> fin_cases i all_goals - simp? [s, b, he, neg1, neg2, e] at c0 c1 c2 row ⊢ + simp only [he, Bool.false_eq_true, ↓reduceIte, Fin.isValue, ite_mul, neg_mul, one_mul, + Fin.mk_one, Fin.succ_one_eq_two, Fin.reduceAdd, neg_add_rev, neg_neg, s, b, e, + Fin.reduceFinMk, Fin.reduceSucc, Fin.zero_eta, Fin.succ_zero_eq_one, zero_add, + neg_zero, neg1, neg2] at c0 c1 c2 row ⊢ rw [row] simp only [c0, c1, c2] cases d <;> simp <;> ring_nf <;> (try simp only [ii_sq]) <;> ring diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProperCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProperCovariance.lean index 77ee9170ee..8ff00d3cbf 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProperCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryProperCovariance.lean @@ -5,14 +5,16 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Data.Fin.VecNotation +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -- [TABLET NODE: BandPackingSymmetryProperCovariance] diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryQuadrupleAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryQuadrupleAction.lean index ad2afd380c..a4bcfb892f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryQuadrupleAction.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryQuadrupleAction.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryReversesOrientation.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryReversesOrientation.lean index 443b439e52..2bc3f66e95 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryReversesOrientation.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryReversesOrientation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry -- [TABLET NODE: BandPackingSymmetryReversesOrientation] diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhase.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhase.lean index a015b29109..28002ea1a6 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhase.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhase.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction public import LeanPool.ApollonianSuperharmonic.BandVectors -public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -- [TABLET NODE: BandPackingSymmetryScopedPhase] diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhaseUnique.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhaseUnique.lean index d67884b888..b730568f15 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhaseUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryScopedPhaseUnique.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing -- [TABLET NODE: BandPackingSymmetryScopedPhaseUnique] @@ -42,7 +42,8 @@ theorem BandPackingSymmetryScopedPhaseUnique apply hv cases v rw [Zsqrtd.ext_iff] at hz - simp? [BandPackingSymmetryVectorAction, GaussianQuarterTurn] at hz + simp only [Int.reduceNeg, BandPackingSymmetryVectorAction, GaussianQuarterTurn, + Zsqrtd.re_zero, neg_eq_zero, Zsqrtd.im_zero] at hz rcases hz with ⟨hre, him⟩ ext <;> simp_all [Zsqrtd.re_zero, Zsqrtd.im_zero] | conjugate => @@ -50,7 +51,9 @@ theorem BandPackingSymmetryScopedPhaseUnique apply hv cases v rw [Zsqrtd.ext_iff] at hz - simp? [BandPackingSymmetryVectorAction, GaussianReflection] at hz + simp only [Int.reduceNeg, BandPackingSymmetryVectorAction, GaussianReflection, + Zsqrtd.re_neg, Zsqrtd.re_zero, neg_eq_zero, Zsqrtd.im_neg, neg_neg, + Zsqrtd.im_zero] at hz rcases hz with ⟨hre, him⟩ ext <;> simp_all [Zsqrtd.re_zero, Zsqrtd.im_zero] | shift w => @@ -72,7 +75,8 @@ theorem BandPackingSymmetryScopedPhaseUnique cases negative₁ <;> cases negative₂ · rfl · have equal := (h₁ 0).1.symm.trans (h₂ 0).1 - simp? at equal + simp only [Bool.false_eq_true, ↓reduceIte, Fin.isValue, Fin.succ_zero_eq_one, one_mul, + neg_mul] at equal have opposite : BandPackingSymmetryVectorAction g (BandVectors.1 (q ((0 : Fin 3).succ : Fin 4)) (q 0)) = diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetrySlopeAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetrySlopeAction.lean index fa256bb23d..7bd5459f35 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetrySlopeAction.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetrySlopeAction.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction public import LeanPool.ApollonianSuperharmonic.TileCentroid diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean index 5edc1bc6fc..db93bd190d 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean @@ -5,22 +5,16 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandPackingSymmetryT3T5Covariance] diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileAction.lean index e18a4c72e3..efc549ee6e 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileAction.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileAction.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry public import LeanPool.ApollonianSuperharmonic.TileQuarterTurn public import LeanPool.ApollonianSuperharmonic.TileReflection diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean index 645629c98b..7b6f1a3a7f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean @@ -5,23 +5,16 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance public import LeanPool.ApollonianSuperharmonic.BandPrototileFootprintSlopeCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential -public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer -public import LeanPool.ApollonianSuperharmonic.OdometerTranslation public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TileOdometer public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -- [TABLET NODE: BandPackingSymmetryTileOdometerCovariance] @@ -1163,7 +1156,7 @@ private theorem hvalue' : have hxOuter : x ∈ h.domain := (hdom x).mpr ⟨p.1, p.2, hx⟩ have hd := actionDiff a h (hs p.1 p.2) x hxOuter hx rw [hvalue p.1 p.2 x hx] at hd - simp? at hd + simp only [sub_self] at hd exact (sub_eq_zero.mp hd).symm private theorem hcompat' : @@ -1452,16 +1445,21 @@ private theorem hslopeMix : (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ))), GaussianInt.intCast_im (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)))] at hh - simp? [u0, umix, scale, GaussianRealPoint, - GaussianQuarterTurn, smul_eq_mul, hp] at hh ⊢ + simp only [hp, Bool.false_eq_true, ↓reduceIte, one_div, neg_mul, one_mul, Fin.isValue, + Prod.fst_sub, ite_mul, GaussianRealPoint, Int.reduceNeg, GaussianQuarterTurn, + Zsqrtd.re_add, Int.cast_add, GaussianInt.intCast_re, Int.cast_neg, + GaussianInt.intCast_im, Zsqrtd.im_add, neg_smul, Prod.smul_mk, smul_eq_mul, + Prod.neg_mk, scale, umix, u0] at hh ⊢ exact hh · have hh := hdx rw [GaussianInt.intCast_re (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ))), GaussianInt.intCast_im (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)))] at hh - simp? [u0, umix, scale, GaussianRealPoint, - GaussianQuarterTurn, smul_eq_mul, hp] at hh ⊢ + simp only [hp, ↓reduceIte, one_div, one_mul, Fin.isValue, Prod.fst_sub, ite_mul, + GaussianRealPoint, Int.reduceNeg, GaussianQuarterTurn, Zsqrtd.re_add, Int.cast_add, + GaussianInt.intCast_re, Int.cast_neg, GaussianInt.intCast_im, Zsqrtd.im_add, + Prod.smul_mk, smul_eq_mul, scale, umix, u0] at hh ⊢ exact hh · cases hp : p.2 · have hh := hdy @@ -1469,16 +1467,21 @@ private theorem hslopeMix : (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ))), GaussianInt.intCast_im (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)))] at hh - simp? [u0, umix, scale, GaussianRealPoint, - GaussianQuarterTurn, smul_eq_mul, hp] at hh ⊢ + simp only [hp, Bool.false_eq_true, ↓reduceIte, one_div, neg_mul, one_mul, Fin.isValue, + Prod.snd_sub, ite_mul, GaussianRealPoint, Int.reduceNeg, GaussianQuarterTurn, + Zsqrtd.re_add, Int.cast_add, GaussianInt.intCast_re, Int.cast_neg, + GaussianInt.intCast_im, Zsqrtd.im_add, neg_smul, Prod.smul_mk, smul_eq_mul, + Prod.neg_mk, scale, umix, u0] at hh ⊢ exact hh · have hh := hdy rw [GaussianInt.intCast_re (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ))), GaussianInt.intCast_im (BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)))] at hh - simp? [u0, umix, scale, GaussianRealPoint, - GaussianQuarterTurn, smul_eq_mul, hp] at hh ⊢ + simp only [hp, ↓reduceIte, one_div, one_mul, Fin.isValue, Prod.snd_sub, ite_mul, + GaussianRealPoint, Int.reduceNeg, GaussianQuarterTurn, Zsqrtd.re_add, Int.cast_add, + GaussianInt.intCast_re, Int.cast_neg, GaussianInt.intCast_im, Zsqrtd.im_add, + Prod.smul_mk, smul_eq_mul, scale, umix, u0] at hh ⊢ exact hh private theorem hmix' : diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean index 3b38c4aab3..b2e305c869 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction public import LeanPool.ApollonianSuperharmonic.FootprintEdges @@ -17,8 +19,6 @@ public import LeanPool.ApollonianSuperharmonic.TileArea public import LeanPool.ApollonianSuperharmonic.TileCellComplement public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance -public import LeanPool.ApollonianSuperharmonic.TileTouching -public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance public import LeanPool.ApollonianSuperharmonic.TouchingTriple public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance @@ -535,13 +535,14 @@ private theorem conjugation : cases T with | mk cells anchor => apply congrArg₂ (fun c : FiniteTile => fun d : GaussianInt => ProtoTile.mk c d) - · simp? [TileQuarterTurn, TileReflection, TileTranslation, + · simp only [TileQuarterTurn, TileReflection, Int.reduceNeg, TileTranslation, GaussianTranslation, Finset.image_image, Function.comp_def] congr 1 funext x ext <;> simp [GaussianQuarterTurn, GaussianReflection]; ring - · simp? [TileQuarterTurn, TileReflection, TileTranslation, - GaussianTranslation, GaussianQuarterTurn, GaussianReflection] + · simp only [GaussianQuarterTurn, Int.reduceNeg, TileQuarterTurn, TileReflection, + GaussianReflection, TileTranslation, GaussianTranslation, Zsqrtd.re_add, + Zsqrtd.im_add, neg_add_rev, neg_neg] ext <;> simp []; ring · intro T simp only [BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean index d6682920bc..e0f922196d 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn public import LeanPool.ApollonianSuperharmonic.GaussianReflection diff --git a/LeanPool/ApollonianSuperharmonic/BandParentBoundaryGenealogy.lean b/LeanPool/ApollonianSuperharmonic/BandParentBoundaryGenealogy.lean index 5592aa7c75..29e496322b 100644 --- a/LeanPool/ApollonianSuperharmonic/BandParentBoundaryGenealogy.lean +++ b/LeanPool/ApollonianSuperharmonic/BandParentBoundaryGenealogy.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -- [TABLET NODE: BandParentBoundaryGenealogy] diff --git a/LeanPool/ApollonianSuperharmonic/BandParentRotationOccurrenceCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandParentRotationOccurrenceCovariance.lean index 404fa25292..c19d1f1673 100644 --- a/LeanPool/ApollonianSuperharmonic/BandParentRotationOccurrenceCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandParentRotationOccurrenceCovariance.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -- [TABLET NODE: BandParentRotationOccurrenceCovariance] diff --git a/LeanPool/ApollonianSuperharmonic/BandPeriodicOdometer.lean b/LeanPool/ApollonianSuperharmonic/BandPeriodicOdometer.lean index 9708a3971e..58a9a8e10f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPeriodicOdometer.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPeriodicOdometer.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CurvatureOnePeriodicOdometer -public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification public import LeanPool.ApollonianSuperharmonic.PeriodicQuadraticRemainder -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureGeneratorCocycles +public import LeanPool.ApollonianSuperharmonic.TilingLatticeCocycleExtension -- [TABLET NODE: BandPeriodicOdometer] diff --git a/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean b/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean index edf5f885a3..3f1f0b6c98 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean @@ -5,32 +5,16 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOdometerInteriorTable -public import LeanPool.ApollonianSuperharmonic.BandGenealogy public import LeanPool.ApollonianSuperharmonic.BandTileTopologyApplication -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.CircleMatrix -public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalMaximality -public import LeanPool.ApollonianSuperharmonic.ExactTileTiling -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -public import LeanPool.ApollonianSuperharmonic.FordExceptionalMaximality public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicRepresentative -public import LeanPool.ApollonianSuperharmonic.LatticeFundamentalSet -public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm public import LeanPool.ApollonianSuperharmonic.PeriodicBoundaryWebLaplacian -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.QuadraticGrowthAtInfinity -public import LeanPool.ApollonianSuperharmonic.RegularTileFamily public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.TilingLattice -public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex -- [TABLET NODE: BandPeriodicSuperharmonicity] @@ -227,7 +211,7 @@ private theorem tile_band : | unit z x U k hU hd ht => cases U with | mk cells anchor => - simp_all? + simp_all only exact BandPrototile.unit z x anchor | @decompose q hq S U hs k hU hsub hc hf hcent hd hv hcomp hsl ih => exact BandPrototile.decompose hq (fun i s => ih i s) hc hf hcent diff --git a/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean b/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean index 9e1d7eb208..6a20501faf 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean @@ -5,17 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -- [TABLET NODE: BandPositiveCutBranchCompanionExclusion] @@ -617,16 +610,16 @@ private theorem hnotA : (birth (0 : Fin (4 : ℕ))) (birth (Fin.succ (2 : Fin (3 : ℕ)))))) cert.O), ∀ (adjacent : ExactTileInterfaceTriple (cert.Q (1 : Fin (3 : ℕ)) true) cert.O (cert.S (2 : Fin (3 : ℕ)) false)), (right.point ≠ incoming.point) → ((adjacent.point = incoming.point) → - ((cert.exceptional_segments.a ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true)) → - ((cert.exceptional_segments.a ∈ FootprintVertices (cert.S (2 : Fin (3 : ℕ)) false)) → - ((cert.exceptional_segments.a ∈ FootprintVertices cert.O) → - (cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation (cert.Q 1 true) + ((cert.exceptionalSegments.a ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true)) → + ((cert.exceptionalSegments.a ∈ FootprintVertices (cert.S (2 : Fin (3 : ℕ)) false)) → + ((cert.exceptionalSegments.a ∈ FootprintVertices cert.O) → + (cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation (cert.Q 1 true) u)))))))) ) := by classical intro q cfg C₀ T cert birth exact_exclusion u hforward' right incoming adjacent hne halign haU haZ haW have hn := exact_exclusion _ _ _ _ right adjacent incoming.point hne halign - cert.exceptional_segments.a haU haW haZ + cert.exceptionalSegments.a haU haW haZ simpa [hforward'] using hn private theorem hWcent'At413 : @@ -726,16 +719,16 @@ private theorem hnotB : BandVectors.1 (birth (0 : Fin (4 : ℕ))) (birth (Fin.succ (2 : Fin (3 : ℕ)))))) cert.O), ∀ (adjacent' : ExactTileInterfaceTriple (cert.S (1 : Fin (3 : ℕ)) false) cert.O (cert.Q (2 : Fin (3 : ℕ)) true)), (right'.point ≠ incoming'.point) → - ((adjacent'.point = incoming'.point) → ((cert.exceptional_segments.b ∈ - FootprintVertices (cert.S (1 : Fin (3 : ℕ)) false)) → ((cert.exceptional_segments.b ∈ - FootprintVertices (cert.Q (2 : Fin (3 : ℕ)) true)) → ((cert.exceptional_segments.b ∈ - FootprintVertices cert.O) → (cert.exceptional_segments.b ∉ FootprintVertices + ((adjacent'.point = incoming'.point) → ((cert.exceptionalSegments.b ∈ + FootprintVertices (cert.S (1 : Fin (3 : ℕ)) false)) → ((cert.exceptionalSegments.b ∈ + FootprintVertices (cert.Q (2 : Fin (3 : ℕ)) true)) → ((cert.exceptionalSegments.b ∈ + FootprintVertices cert.O) → (cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation (cert.S 1 false) (-u)))))))))) ) := by classical intro q cfg C₀ T cert birth exact_exclusion I hI2 u hforward' right' incoming' adjacent' hne' halign' hbU hbZ hbW have hn := exact_exclusion _ _ _ _ right' adjacent' incoming'.point hne' halign' - cert.exceptional_segments.b hbU hbW hbZ + cert.exceptionalSegments.b hbU hbW hbZ simpa [I, hI2, hforward'] using hn private theorem hback3 : @@ -1198,9 +1191,9 @@ private theorem hnotA1 : FootprintVertices Z) → (cut ∉ FootprintVertices V)))))) → ( let I : GaussianInt := ⟨0, 1⟩ let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) - (BandVectors.1 (birth 2) (birth 0) = u) → ((cert.exceptional_segments.a ∈ - FootprintVertices cert.O) → ((cert.exceptional_segments.a ∈ FootprintVertices (cert.Q - (1 : Fin (3 : ℕ)) true)) → ((cert.exceptional_segments.a ∈ FootprintVertices (cert.S + (BandVectors.1 (birth 2) (birth 0) = u) → ((cert.exceptionalSegments.a ∈ + FootprintVertices cert.O) → ((cert.exceptionalSegments.a ∈ FootprintVertices (cert.Q + (1 : Fin (3 : ℕ)) true)) → ((cert.exceptionalSegments.a ∈ FootprintVertices (cert.S (2 : Fin (3 : ℕ)) false)) → (∀ (rightA1 : ExactTileInterfaceTriple cert.O (TileTranslation cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑(1 : Fin (4 : ℕ)) : ℕ) * if Even (↑(1 : Fin (4 : ℕ)) : ℕ) then BandVectors.1 (birth (0 : Fin (4 : ℕ))) @@ -1213,13 +1206,13 @@ private theorem hnotA1 : (cert.Q (1 : Fin (3 : ℕ)) true)), ∀ (adjacentA1 : ExactTileInterfaceTriple cert.O (cert.Q (1 : Fin (3 : ℕ)) true) (cert.S (2 : Fin (3 : ℕ)) false)), (rightA1.point ≠ incomingA1.point) → ((adjacentA1.point = incomingA1.point) → - (cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation cert.O (I * + (cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O (I * u))))))))) ) := by classical intro q cfg C₀ T cert birth exact_exclusion I u hback2 haO haQ2 haS3 rightA1 incomingA1 adjacentA1 hneA1 halignA1 have hn := exact_exclusion _ _ _ _ rightA1 adjacentA1 incomingA1.point - hneA1 halignA1 cert.exceptional_segments.a haO haQ2 haS3 + hneA1 halignA1 cert.exceptionalSegments.a haO haQ2 haS3 simpa [I, hback2] using hn private theorem hnotA2 : @@ -1235,9 +1228,9 @@ private theorem hnotA2 : GaussianInt), (cut ∈ FootprintVertices U) → ((cut ∈ FootprintVertices W) → ((cut ∈ FootprintVertices Z) → (cut ∉ FootprintVertices V)))))) → ( let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) - (BandVectors.1 (birth 0) (birth 3) = t) → ((cert.exceptional_segments.a ∈ - FootprintVertices cert.O) → ((cert.exceptional_segments.a ∈ FootprintVertices (cert.Q - (1 : Fin (3 : ℕ)) true)) → ((cert.exceptional_segments.a ∈ FootprintVertices (cert.S + (BandVectors.1 (birth 0) (birth 3) = t) → ((cert.exceptionalSegments.a ∈ + FootprintVertices cert.O) → ((cert.exceptionalSegments.a ∈ FootprintVertices (cert.Q + (1 : Fin (3 : ℕ)) true)) → ((cert.exceptionalSegments.a ∈ FootprintVertices (cert.S (2 : Fin (3 : ℕ)) false)) → (∀ (rightA2 : ExactTileInterfaceTriple cert.O (TileTranslation cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑(0 : Fin (4 : ℕ)) : ℕ) * if Even (↑(0 : Fin (4 : ℕ)) : ℕ) then BandVectors.1 (birth (0 : Fin (4 : ℕ))) @@ -1250,13 +1243,13 @@ private theorem hnotA2 : (cert.S (2 : Fin (3 : ℕ)) false)), ∀ (adjacentA2 : ExactTileInterfaceTriple cert.O (cert.S (2 : Fin (3 : ℕ)) false) (cert.Q (1 : Fin (3 : ℕ)) true)), (rightA2.point ≠ incomingA2.point) → ((adjacentA2.point = incomingA2.point) → - (cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation cert.O t)))))))) ) + (cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O t)))))))) ) := by classical intro q cfg C₀ T cert birth exact_exclusion t hforward3 haO haQ2 haS3 rightA2 incomingA2 adjacentA2 hneA2 halignA2 have hn := exact_exclusion _ _ _ _ rightA2 adjacentA2 incomingA2.point - hneA2 halignA2 cert.exceptional_segments.a haO haS3 haQ2 + hneA2 halignA2 cert.exceptionalSegments.a haO haS3 haQ2 simpa [hforward3] using hn private theorem hnotB1 : @@ -1274,9 +1267,9 @@ private theorem hnotB1 : let I : GaussianInt := ⟨0, 1⟩ (I ^ 3 = -I) → ( let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) - (BandVectors.1 (birth 2) (birth 0) = u) → ((cert.exceptional_segments.b ∈ - FootprintVertices cert.O) → ((cert.exceptional_segments.b ∈ FootprintVertices (cert.Q - (2 : Fin (3 : ℕ)) true)) → ((cert.exceptional_segments.b ∈ FootprintVertices (cert.S + (BandVectors.1 (birth 2) (birth 0) = u) → ((cert.exceptionalSegments.b ∈ + FootprintVertices cert.O) → ((cert.exceptionalSegments.b ∈ FootprintVertices (cert.Q + (2 : Fin (3 : ℕ)) true)) → ((cert.exceptionalSegments.b ∈ FootprintVertices (cert.S (1 : Fin (3 : ℕ)) false)) → (∀ (rightB1 : ExactTileInterfaceTriple cert.O (TileTranslation cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑(3 : Fin (4 : ℕ)) : ℕ) * if Even (↑(3 : Fin (4 : ℕ)) : ℕ) then BandVectors.1 (birth (0 : Fin (4 : ℕ))) @@ -1289,21 +1282,21 @@ private theorem hnotB1 : (cert.S (1 : Fin (3 : ℕ)) false)), ∀ (adjacentB1 : ExactTileInterfaceTriple cert.O (cert.S (1 : Fin (3 : ℕ)) false) (cert.Q (2 : Fin (3 : ℕ)) true)), (rightB1.point ≠ incomingB1.point) → ((adjacentB1.point = incomingB1.point) → - (cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O (-((⟨0, 1⟩ : + (cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 2) (cfg.firstPredecessor 1)))))))))))) ) := by classical intro q cfg C₀ T cert birth exact_exclusion I hI3 u hback2 hbO hbQ3 hbS2 rightB1 incomingB1 adjacentB1 hneB1 halignB1 have hn := exact_exclusion _ _ _ _ rightB1 adjacentB1 incomingB1.point - hneB1 halignB1 cert.exceptional_segments.b hbO hbS2 hbQ3 + hneB1 halignB1 cert.exceptionalSegments.b hbO hbS2 hbQ3 have hn' := hn - have hn'' : cert.exceptional_segments.b ∉ FootprintVertices + have hn'' : cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (I ^ 3 * BandVectors.1 (birth 2) (birth 0))) := by split_ifs at hn' with hparity · rcases hparity with ⟨k, hk⟩ omega · simpa [I] using hn' - have hn''' : cert.exceptional_segments.b ∉ + have hn''' : cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-I * u)) := by simpa [hI3, hback2] using hn'' have hshift : -I * u = -((⟨0, 1⟩ : GaussianInt) * @@ -1328,9 +1321,9 @@ private theorem hnotB2 : let I : GaussianInt := ⟨0, 1⟩ (I ^ 2 = -1) → ( let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) - (BandVectors.1 (birth 0) (birth 3) = t) → ((Even 2) → ((cert.exceptional_segments.b ∈ - FootprintVertices cert.O) → ((cert.exceptional_segments.b ∈ FootprintVertices (cert.Q - (2 : Fin (3 : ℕ)) true)) → ((cert.exceptional_segments.b ∈ FootprintVertices (cert.S + (BandVectors.1 (birth 0) (birth 3) = t) → ((Even 2) → ((cert.exceptionalSegments.b ∈ + FootprintVertices cert.O) → ((cert.exceptionalSegments.b ∈ FootprintVertices (cert.Q + (2 : Fin (3 : ℕ)) true)) → ((cert.exceptionalSegments.b ∈ FootprintVertices (cert.S (1 : Fin (3 : ℕ)) false)) → (∀ (rightB2 : ExactTileInterfaceTriple cert.O (TileTranslation cert.O ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑(2 : Fin (4 : ℕ)) : ℕ) * if Even (↑(2 : Fin (4 : ℕ)) : ℕ) then BandVectors.1 (birth (0 : Fin (4 : ℕ))) @@ -1343,13 +1336,13 @@ private theorem hnotB2 : (cert.Q (2 : Fin (3 : ℕ)) true)), ∀ (adjacentB2 : ExactTileInterfaceTriple cert.O (cert.Q (2 : Fin (3 : ℕ)) true) (cert.S (1 : Fin (3 : ℕ)) false)), (rightB2.point ≠ incomingB2.point) → ((adjacentB2.point = incomingB2.point) → - (cert.exceptional_segments.b ∉ FootprintVertices (TileTranslation cert.O + (cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-t))))))))))) ) := by classical intro q cfg C₀ T cert birth exact_exclusion I hI2 t hforward3 hEven2 hbO hbQ3 hbS2 rightB2 incomingB2 adjacentB2 hneB2 halignB2 have hn := exact_exclusion _ _ _ _ rightB2 adjacentB2 incomingB2.point - hneB2 halignB2 cert.exceptional_segments.b hbO hbQ3 hbS2 + hneB2 halignB2 cert.exceptionalSegments.b hbO hbQ3 hbS2 simpa [I, hI2, hEven2, hforward3] using hn end PositiveCutExclusionGeometry @@ -1416,16 +1409,16 @@ private theorem fourthParentExclusion : : ℝ)) → ((birth (0 : Fin (4 : ℕ)) = cfg.firstPredecessor (1 : Fin (4 : ℕ)) ∧ birth (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) ∧ birth (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ))) → (((birth 0 = q 2 ∧ birth 2 = q 3 ∧ birth 3 = cfg.firstPredecessor 1) ∧ - cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation (cert.Q 1 true) - (BandVectors.1 (q 2) (cfg.firstPredecessor 1))) ∧ cert.exceptional_segments.b ∉ + cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation (cert.Q 1 true) + (BandVectors.1 (q 2) (cfg.firstPredecessor 1))) ∧ cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation (cert.S 1 false) (-BandVectors.1 (q 2) (cfg.firstPredecessor 1)))) ∨ ((birth 0 = cfg.firstPredecessor 1 ∧ birth 2 = q 2 ∧ - birth 3 = q 3) ∧ cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation + birth 3 = q 3) ∧ cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 2) (cfg.firstPredecessor 1))) ∧ - cert.exceptional_segments.a ∉ FootprintVertices (TileTranslation cert.O - (BandVectors.1 (cfg.firstPredecessor 1) (q 3))) ∧ cert.exceptional_segments.b ∉ + cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O + (BandVectors.1 (cfg.firstPredecessor 1) (q 3))) ∧ cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-((⟨0, 1⟩ : GaussianInt) * BandVectors.1 - (q 2) (cfg.firstPredecessor 1)))) ∧ cert.exceptional_segments.b ∉ FootprintVertices + (q 2) (cfg.firstPredecessor 1)))) ∧ cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-BandVectors.1 (cfg.firstPredecessor 1) (q 3)))))))))))))))))))))))) ) := by classical @@ -1511,16 +1504,16 @@ private theorem fourthParentExclusion : (I ^ 2 * (BandVectors.1 (birth 0) (birth 2) - BandVectors.1 (birth 2) (birth 0))) := PositiveCutExclusionGeometry.hB2Z q cfg C₀ T cert birth hS2O (PositiveCutExclusionGeometry.hB2Zvec q cfg birth hI2 hforward2 hback2) - have haBoundary := (cert.exceptional_segments.first_cut_unique - cert.exceptional_segments.a).mpr rfl - have haO := boundary_to_raw cert.O cert.exceptional_segments.a haBoundary.2.2 - have haQ2 := boundary_to_raw (cert.Q 1 true) cert.exceptional_segments.a haBoundary.1 - have haS3 := boundary_to_raw (cert.S 2 false) cert.exceptional_segments.a haBoundary.2.1 - have hbBoundary := (cert.exceptional_segments.second_cut_unique - cert.exceptional_segments.b).mpr rfl - have hbO := boundary_to_raw cert.O cert.exceptional_segments.b hbBoundary.2.2 - have hbQ3 := boundary_to_raw (cert.Q 2 true) cert.exceptional_segments.b hbBoundary.1 - have hbS2 := boundary_to_raw (cert.S 1 false) cert.exceptional_segments.b hbBoundary.2.1 + have haBoundary := (cert.exceptionalSegments.first_cut_unique + cert.exceptionalSegments.a).mpr rfl + have haO := boundary_to_raw cert.O cert.exceptionalSegments.a haBoundary.2.2 + have haQ2 := boundary_to_raw (cert.Q 1 true) cert.exceptionalSegments.a haBoundary.1 + have haS3 := boundary_to_raw (cert.S 2 false) cert.exceptionalSegments.a haBoundary.2.1 + have hbBoundary := (cert.exceptionalSegments.second_cut_unique + cert.exceptionalSegments.b).mpr rfl + have hbO := boundary_to_raw cert.O cert.exceptionalSegments.b hbBoundary.2.2 + have hbQ3 := boundary_to_raw (cert.Q 2 true) cert.exceptionalSegments.b hbBoundary.1 + have hbS2 := boundary_to_raw (cert.S 1 false) cert.exceptionalSegments.b hbBoundary.2.1 have endpointA1 := BandOrientedChildParentEndpoints birth hproper (1 : Fin 3) 1 cert.O (cert.Q 1 true) (cert.S 2 false) hOproto hQ2proto hS3proto hbirth0pos hbirth2pos hbirth3pos @@ -1579,26 +1572,26 @@ theorem BandPositiveCutBranchCompanionExclusion birth 3 = q 3)) : ((birth 0 = q 2 ∧ birth 2 = q 3 ∧ birth 3 = cfg.firstPredecessor 1) ∧ - cert.exceptional_segments.a ∉ FootprintVertices + cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation (cert.Q 1 true) (BandVectors.1 (q 2) (cfg.firstPredecessor 1))) ∧ - cert.exceptional_segments.b ∉ FootprintVertices + cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation (cert.S 1 false) (-BandVectors.1 (q 2) (cfg.firstPredecessor 1)))) ∨ ((birth 0 = cfg.firstPredecessor 1 ∧ birth 2 = q 2 ∧ birth 3 = q 3) ∧ - cert.exceptional_segments.a ∉ FootprintVertices + cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 2) (cfg.firstPredecessor 1))) ∧ - cert.exceptional_segments.a ∉ FootprintVertices + cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O (BandVectors.1 (cfg.firstPredecessor 1) (q 3))) ∧ - cert.exceptional_segments.b ∉ FootprintVertices + cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 2) (cfg.firstPredecessor 1)))) ∧ - cert.exceptional_segments.b ∉ FootprintVertices + cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-BandVectors.1 (cfg.firstPredecessor 1) (q 3)))) := by -- BODY @@ -1678,11 +1671,11 @@ theorem BandPositiveCutBranchCompanionExclusion hU hW hZ hUpos hWpos hZpos hWcent' (by simpa [I, hargAdj, gaussianPoint_Iminus_one] using hZcent') rcases endpoint with ⟨right, incoming, adjacent, hne, halign, _, _, _⟩ - have haBoundary := (cert.exceptional_segments.first_cut_unique - cert.exceptional_segments.a).mpr rfl - have haU := boundary_to_raw (cert.Q 1 true) cert.exceptional_segments.a haBoundary.1 - have haZ := boundary_to_raw (cert.S 2 false) cert.exceptional_segments.a haBoundary.2.1 - have haW := boundary_to_raw cert.O cert.exceptional_segments.a haBoundary.2.2 + have haBoundary := (cert.exceptionalSegments.first_cut_unique + cert.exceptionalSegments.a).mpr rfl + have haU := boundary_to_raw (cert.Q 1 true) cert.exceptionalSegments.a haBoundary.1 + have haZ := boundary_to_raw (cert.S 2 false) cert.exceptionalSegments.a haBoundary.2.1 + have haW := boundary_to_raw cert.O cert.exceptionalSegments.a haBoundary.2.2 have hnotA := PositiveCutExclusionGeometry.hnotA q cfg C₀ T cert birth exact_exclusion hforward' right incoming adjacent hne halign haU haZ haW have hU' : BandPrototile (birth 0) (cert.S 1 false) := by @@ -1703,37 +1696,37 @@ theorem BandPositiveCutBranchCompanionExclusion (by simpa [I, hI2, hargA, gaussianPoint_neg] using hWcent') (by simpa [I, hI2, hargAdj, gaussianPoint_Iminus_one, gaussianPoint_neg] using hZcent') rcases endpoint' with ⟨right', incoming', adjacent', hne', halign', _, _, _⟩ - have hbBoundary := (cert.exceptional_segments.second_cut_unique - cert.exceptional_segments.b).mpr rfl - have hbU := boundary_to_raw (cert.S 1 false) cert.exceptional_segments.b hbBoundary.2.1 - have hbZ := boundary_to_raw (cert.Q 2 true) cert.exceptional_segments.b hbBoundary.1 - have hbW := boundary_to_raw cert.O cert.exceptional_segments.b hbBoundary.2.2 + have hbBoundary := (cert.exceptionalSegments.second_cut_unique + cert.exceptionalSegments.b).mpr rfl + have hbU := boundary_to_raw (cert.S 1 false) cert.exceptionalSegments.b hbBoundary.2.1 + have hbZ := boundary_to_raw (cert.Q 2 true) cert.exceptionalSegments.b hbBoundary.1 + have hbW := boundary_to_raw cert.O cert.exceptionalSegments.b hbBoundary.2.2 exact Or.inl ⟨hp2, hnotA, (PositiveCutExclusionGeometry.hnotB q cfg C₀ T cert birth exact_exclusion hI2 hforward' right' incoming' adjacent' hne' halign' hbU hbZ hbW)⟩ · -- The four p4 endpoint packages are used only in this branch. have fourthParentExclusion : ((birth 0 = q 2 ∧ birth 2 = q 3 ∧ birth 3 = cfg.firstPredecessor 1) ∧ - cert.exceptional_segments.a ∉ FootprintVertices + cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation (cert.Q 1 true) (BandVectors.1 (q 2) (cfg.firstPredecessor 1))) ∧ - cert.exceptional_segments.b ∉ FootprintVertices + cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation (cert.S 1 false) (-BandVectors.1 (q 2) (cfg.firstPredecessor 1)))) ∨ ((birth 0 = cfg.firstPredecessor 1 ∧ birth 2 = q 2 ∧ birth 3 = q 3) ∧ - cert.exceptional_segments.a ∉ FootprintVertices + cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 2) (cfg.firstPredecessor 1))) ∧ - cert.exceptional_segments.a ∉ FootprintVertices + cert.exceptionalSegments.a ∉ FootprintVertices (TileTranslation cert.O (BandVectors.1 (cfg.firstPredecessor 1) (q 3))) ∧ - cert.exceptional_segments.b ∉ FootprintVertices + cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 2) (cfg.firstPredecessor 1)))) ∧ - cert.exceptional_segments.b ∉ FootprintVertices + cert.exceptionalSegments.b ∉ FootprintVertices (TileTranslation cert.O (-BandVectors.1 (cfg.firstPredecessor 1) (q 3)))) := PositiveCutBranchConclusion.fourthParentExclusion q cfg C₀ T cert birth hproper diff --git a/LeanPool/ApollonianSuperharmonic/BandPredecessorNoCollision.lean b/LeanPool/ApollonianSuperharmonic/BandPredecessorNoCollision.lean index f9f57b5426..f2e5bc4d36 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPredecessorNoCollision.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPredecessorNoCollision.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4828T1HistoryNormalForm public import LeanPool.ApollonianSuperharmonic.P4828T1HistoryRealization public import LeanPool.ApollonianSuperharmonic.P4828T1RootSeparation diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototile.lean b/LeanPool/ApollonianSuperharmonic/BandPrototile.lean index 85e8e37c01..4e1a762b79 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototile.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototile.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandVectors public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.TileCentroid diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileCentralSymmetry.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileCentralSymmetry.lean index 20b6cae62e..317aca72f4 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileCentralSymmetry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileCentralSymmetry.lean @@ -5,14 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototile public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileRealization -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: BandPrototileCentralSymmetry] diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileCentroidUnique.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileCentroidUnique.lean index 4046216427..79e4c3f44b 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileCentroidUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileCentroidUnique.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandGenealogy -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification + public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification -- [TABLET NODE: BandPrototileCentroidUnique] @@ -32,34 +33,8 @@ theorem BandPrototileCentroidUnique (C : CircleCoordinates) (T U : ProtoTile) revert hU revert U have nonnegative : ∀ r : Fin 4 → CircleCoordinates, - SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 := by - intro r hr - induction hr with - | base z => intro k; fin_cases k <;> simp - | rotate hr ih => - intro k - fin_cases k - · simpa using ih 0 - · simpa using ih 2 - · simpa using ih 3 - · simpa using ih 1 - | @successor r hr ih => - intro k - have classification := BandSuccessorClassification r hr - dsimp at classification - rcases classification with special | proper - · fin_cases k - · simp [special] - · simpa using ih 0 - · simpa using ih 2 - · simpa using ih 3 - · rcases proper with ⟨_, larger0, larger2, larger3⟩ - fin_cases k - · change 0 ≤ 2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1 - exact (ih 0).trans larger0.le - · exact ih 0 - · exact ih 2 - · exact ih 3 + SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 := + fun r hr => (SemiProperForestClassification r hr).1 have no_unit : ∀ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → (r 0).1 = 1 → ¬ ProperBandQuadruple r := by intro r hr @@ -98,7 +73,9 @@ theorem BandPrototileCentroidUnique (C : CircleCoordinates) (T U : ProtoTile) generalize coordinate : ((0 : ℤ), w) = D at hU ⊢ cases hU with | line w' y hw' => - simp? [TileCentroid] at hcent ⊢ + simp only [TileCentroid, Finset.not_nonempty_empty, ↓reduceIte, Int.reduceNeg, + GaussianInt.intCast_re, GaussianInt.intCast_im, Prod.mk.injEq, forall_const, + true_and] at hcent ⊢ apply GaussianInt.toComplex_injective apply Complex.ext · exact hcent.1 @@ -122,7 +99,11 @@ theorem BandPrototileCentroidUnique (C : CircleCoordinates) (T U : ProtoTile) cases hU with | line w' y hw' => simp_all [] | unit z' y => - simp? [TileCentroid] at hcent ⊢ + simp only [TileCentroid, Finset.singleton_nonempty, ↓reduceIte, Int.reduceNeg, + Finset.sum_singleton, GaussianInt.intCast_re, Finset.card_singleton, + Nat.cast_one, div_one, one_div, GaussianInt.intCast_im, Prod.mk.injEq, + add_left_inj, Finset.singleton_inj, Finset.singleton_ne_empty, + IsEmpty.forall_iff, and_true] at hcent ⊢ have equal : x = y := by apply GaussianInt.toComplex_injective apply Complex.ext @@ -222,7 +203,9 @@ theorem BandPrototileCentroidUnique (C : CircleCoordinates) (T U : ProtoTile) intro hempty have centered := hcent have uempty : U.cells = ∅ := by rw [← cells_equal]; exact hempty - simp? [TileCentroid, hempty, uempty] at centered + simp only [TileCentroid, hempty, Finset.not_nonempty_empty, ↓reduceIte, + Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, uempty, + Prod.mk.injEq] at centered apply GaussianInt.toComplex_injective apply Complex.ext · exact centered.1 diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean index 19a08472e2..d942e2c9d1 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares -public import LeanPool.ApollonianSuperharmonic.TileCentroid -- [TABLET NODE: BandPrototileCompleteSquareCentroid] @@ -504,7 +504,8 @@ private theorem sumRe_formula : push_cast at hs rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib, Finset.sum_add_distrib, Finset.sum_const] at hs - simp? at hs + simp only [Int.reduceNeg, GaussianInt.intCast_re, smul_add, nsmul_eq_mul, Finset.sum_const, + mul_one] at hs have hEq : squares.sum (fun x => (x.re : Real)) = squares.sum (fun x => (GaussianInt.toComplex x).re) := by apply Finset.sum_congr rfl @@ -549,7 +550,8 @@ private theorem sumIm_formula : push_cast at hs rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib, Finset.sum_add_distrib, Finset.sum_const] at hs - simp? at hs + simp only [Int.reduceNeg, GaussianInt.intCast_im, smul_add, nsmul_eq_mul, Finset.sum_const, + mul_one] at hs have hEq : squares.sum (fun x => (x.im : Real)) = squares.sum (fun x => (GaussianInt.toComplex x).im) := by apply Finset.sum_congr rfl diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean index 5974dd0d74..00a8a92395 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean @@ -5,26 +5,18 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandGenealogy -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.BandPrototileReindexedDecomposition -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BandPrototileExists] @@ -314,7 +306,8 @@ private theorem hcells0 : ∀ (x : GaussianInt), x ∈ T0.cells ↔ ∃ i s, x ∈ (U i s).cells ) := by classical intro q r g q' T1 S a U T0 x - simp? [T0] + simp only [Fintype.univ_bool, Finset.biUnion_insert, Finset.singleton_biUnion, + Finset.mem_biUnion, Finset.mem_univ, Finset.mem_union, true_and, Bool.exists_bool, T0] constructor · rintro ⟨i, hi | hi⟩ · exact ⟨i, Or.inr hi⟩ @@ -721,13 +714,16 @@ private theorem hcent' : hs2m hs2p transCent i s fin_cases i <;> cases s · simp [U, p0, a] - · simp? [U, p0] + · simp only [Fin.isValue, Int.reduceNeg, neg_mul, Fin.zero_eta, ↓reduceIte, zero_add, + Fin.reduceSucc, Fin.succ_one_eq_two, one_smul, U, p0] change TileCentroid (TileTranslation T1 (a - I * a)) - p0 = d a rw [transCent] dsimp [p0] ext <;> simp [d, I, GaussianRealPoint] <;> ring - · simp? [U, p0] + · simp only [Fin.isValue, Int.reduceNeg, neg_mul, Fin.mk_one, one_ne_zero, ↓reduceIte, + Bool.false_eq_true, Fin.reduceAdd, Fin.succ_zero_eq_one, Fin.reduceSucc, neg_smul, + one_smul, U, p0] change TileCentroid (TileTranslation (S 1 false) (-((⟨0, 1⟩ : GaussianInt) * a))) - p0 = -d (BandVectors.1 (q' 1) (q' 3)) @@ -747,7 +743,8 @@ private theorem hcent' : rw [pointI] at hd dsimp [d] at hh hd ⊢ linarith - · simp? [U, p0] + · simp only [Fin.isValue, Int.reduceNeg, neg_mul, Fin.mk_one, one_ne_zero, ↓reduceIte, + Fin.reduceAdd, Fin.succ_zero_eq_one, Fin.reduceSucc, one_smul, U, p0] change TileCentroid (TileTranslation (S 1 true) a) - p0 = d (BandVectors.1 (q' 1) (q' 3)) rw [transCent] @@ -761,7 +758,9 @@ private theorem hcent' : have hd := congrArg Prod.snd dIdent1 simp [GaussianRealPoint] at hh hd ⊢ linarith - · simp? [U, p0] + · simp only [Fin.isValue, Int.reduceNeg, neg_mul, Fin.reduceFinMk, Fin.reduceEq, ↓reduceIte, + Bool.false_eq_true, Fin.reduceAdd, Fin.succ_one_eq_two, Fin.succ_zero_eq_one, neg_smul, + one_smul, U, p0] change TileCentroid (TileTranslation (S 2 false) a) - p0 = -d v rw [transCent] @@ -775,7 +774,8 @@ private theorem hcent' : have hd := congrArg Prod.snd dIdent4 simp [GaussianRealPoint] at hh hd ⊢ linarith - · simp? [U, p0] + · simp only [Fin.isValue, Int.reduceNeg, neg_mul, Fin.reduceFinMk, Fin.reduceEq, ↓reduceIte, + Fin.reduceAdd, Fin.succ_one_eq_two, Fin.succ_zero_eq_one, one_smul, U, p0] change TileCentroid (TileTranslation (S 2 true) (-((⟨0, 1⟩ : GaussianInt) * a))) - p0 = d v @@ -1679,7 +1679,7 @@ private theorem sRe : simp_rw [hre] at hs rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib, Finset.sum_const, Finset.sum_const] at hs - simp? at hs + simp only [Int.reduceNeg, GaussianInt.intCast_re, nsmul_eq_mul, mul_one] at hs have hEq : T0.cells.sum (fun x => (x.re : Real)) = T0.cells.sum (fun x => (GaussianInt.toComplex x).re) := by apply Finset.sum_congr rfl @@ -1736,7 +1736,7 @@ private theorem sIm : simp_rw [him] at hs rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib, Finset.sum_const, Finset.sum_const] at hs - simp? at hs + simp only [Int.reduceNeg, GaussianInt.intCast_im, nsmul_eq_mul, mul_one] at hs have hEq : T0.cells.sum (fun x => (x.im : Real)) = T0.cells.sum (fun x => (GaussianInt.toComplex x).im) := by apply Finset.sum_congr rfl diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileFootprintSlopeCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileFootprintSlopeCovariance.lean index 31f7f31a1f..2f0a1cbff9 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileFootprintSlopeCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileFootprintSlopeCovariance.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas public import LeanPool.ApollonianSuperharmonic.BandPrototileCompleteSquareCentroid public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas @@ -110,27 +111,17 @@ theorem BandPrototileFootprintSlopeCovariance · have hc := congrArg Prod.fst centroid.2 simp only [TileCentroid, ite_eq_left hne] at hc norm_num [Finset.sum_add_distrib] at hc ⊢ - have hnS : (squares.card : ℝ) ≠ 0 := by + have cardNonzero : ((PartialOdometerSquares h).card : ℝ) ≠ 0 := by exact_mod_cast (Nat.ne_of_gt (Finset.card_pos.mpr squares_nonempty)) - have hnT : (T.cells.card : ℝ) ≠ 0 := by - exact_mod_cast (Nat.ne_of_gt (Finset.card_pos.mpr hne)) - have hnS' : (PartialOdometerSquares h).card ≠ 0 := by - exact Nat.ne_of_gt (by simpa [squares] using Finset.card_pos.mpr squares_nonempty) - have hnT' : T.cells.card ≠ 0 := Nat.ne_of_gt (Finset.card_pos.mpr hne) - field_simp [hnS, hnT, hnS', hnT'] at hc ⊢ - linarith + rw [add_div, mul_div_cancel_left₀ _ cardNonzero] at hc + linarith only [hc] · have hc := congrArg Prod.snd centroid.2 simp only [TileCentroid, ite_eq_left hne] at hc norm_num [Finset.sum_add_distrib] at hc ⊢ - have hnS : (squares.card : ℝ) ≠ 0 := by + have cardNonzero : ((PartialOdometerSquares h).card : ℝ) ≠ 0 := by exact_mod_cast (Nat.ne_of_gt (Finset.card_pos.mpr squares_nonempty)) - have hnT : (T.cells.card : ℝ) ≠ 0 := by - exact_mod_cast (Nat.ne_of_gt (Finset.card_pos.mpr hne)) - have hnS' : (PartialOdometerSquares h).card ≠ 0 := by - exact Nat.ne_of_gt (by simpa [squares] using Finset.card_pos.mpr squares_nonempty) - have hnT' : T.cells.card ≠ 0 := Nat.ne_of_gt (Finset.card_pos.mpr hne) - field_simp [hnS, hnT, hnS', hnT'] at hc ⊢ - linarith + rw [add_div, mul_div_cancel_left₀ _ cardNonzero] at hc + linarith only [hc] exact hcent have result := formulas.2.2.2.2.2.2.2 replacement replacement_nonempty replacement_cells diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileReindexedDecomposition.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileReindexedDecomposition.lean index 80c21401be..d6f531e4de 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileReindexedDecomposition.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileReindexedDecomposition.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification + public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification -- [TABLET NODE: BandPrototileReindexedDecomposition] @@ -29,26 +32,8 @@ theorem BandPrototileReindexedDecomposition (q : Fin 4 → CircleCoordinates) (∀ x, x ∈ T.cells ↔ ∃ i s, x ∈ (S i s).cells) := by -- BODY have nonnegative : ∀ r : Fin 4 → CircleCoordinates, - SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 := by - intro r hr - induction hr with - | base z => intro k; fin_cases k <;> simp - | rotate hr ih => - intro k - fin_cases k <;> simp_all - | @successor r hr ih => - intro k - have cl := BandSuccessorClassification r hr - dsimp at cl - rcases cl with special | proper - · fin_cases k <;> simp_all - · rcases proper with ⟨_, h0, h2, h3⟩ - fin_cases k - · change 0 ≤ 2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1 - exact (ih 0).trans h0.le - · exact ih 0 - · exact ih 2 - · exact ih 3 + SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 := + fun r hr => (SemiProperForestClassification r hr).1 have noUnit : ∀ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → (r 0).1 = 1 → ¬ ProperBandQuadruple r := by intro r hr diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileTranslation.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileTranslation.lean index bd885ffee2..acf03f2163 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileTranslation.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileTranslation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototile public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas @@ -28,10 +30,10 @@ theorem BandPrototileTranslation : ∀ (C : CircleCoordinates) (T : ProtoTile) intro C T u h induction h generalizing u with | line w x hw => - simp? [TileTranslation, GaussianTranslation] + simp only [TileTranslation, Finset.image_empty, GaussianTranslation] exact BandPrototile.line w (x + u) hw | unit z x anchor => - simp? [TileTranslation, GaussianTranslation] + simp only [TileTranslation, Finset.image_singleton, GaussianTranslation] exact BandPrototile.unit z (x + u) (anchor + u) | @decompose q hq S T hS hcells hfoot hcentroid ih => refine @BandPrototile.decompose q hq diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean index 7c3a110633..cc2413924a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean @@ -5,11 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandGenealogy -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: BandPrototileTranslationNormalForm] diff --git a/LeanPool/ApollonianSuperharmonic/BandRegimeClassification.lean b/LeanPool/ApollonianSuperharmonic/BandRegimeClassification.lean index 8f338b336f..ac52accbaf 100644 --- a/LeanPool/ApollonianSuperharmonic/BandRegimeClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/BandRegimeClassification.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandRetainedBoundaryGenealogy -public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration public import LeanPool.ApollonianSuperharmonic.DiamondRegimeConverse public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse diff --git a/LeanPool/ApollonianSuperharmonic/BandRegularTileTouchingClassification.lean b/LeanPool/ApollonianSuperharmonic/BandRegularTileTouchingClassification.lean index cfee99fcc0..9eff553ac8 100644 --- a/LeanPool/ApollonianSuperharmonic/BandRegularTileTouchingClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/BandRegularTileTouchingClassification.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification public import LeanPool.ApollonianSuperharmonic.RegularTileFamilyTranslationUnique public import LeanPool.ApollonianSuperharmonic.TileBordering -public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance -- [TABLET NODE: BandRegularTileTouchingClassification] diff --git a/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean b/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean index de3cd8ecaa..821eba61d2 100644 --- a/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean +++ b/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean @@ -5,23 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AffineTriangularPlaneTriangulation public import LeanPool.ApollonianSuperharmonic.AffineTriangularComplexChart public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation -public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.SimpleGridPath -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis -public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex -public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance public import LeanPool.ApollonianSuperharmonic.P4812T1LatticeCoordinates public import LeanPool.ApollonianSuperharmonic.P4812T1AffineTransport public import LeanPool.ApollonianSuperharmonic.P4812T1ReflectedTouching public import LeanPool.ApollonianSuperharmonic.P4812T1RegularFaceWalks -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -- [TABLET NODE: BandRegularTranslatePeriodicComplex] diff --git a/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean b/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean index 5145b34452..1b42ff26a3 100644 --- a/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean +++ b/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean @@ -5,18 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrientedBoundaryParentChain public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration public import LeanPool.ApollonianSuperharmonic.BandParentBoundaryGenealogy -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision -public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification -- [TABLET NODE: BandRetainedBoundaryGenealogy] @@ -195,7 +190,8 @@ private theorem hq0large : have hp1lt := hp.2 0 have hqformula := congrArg (fun z : Fin 4 → CircleCoordinates => (z 0).1) hsucc - simp? at hqformula + simp only [Fin.isValue, Nat.succ_eq_add_one, Nat.reduceAdd, Matrix.cons_val_zero] + at hqformula have hqformula' : (q 0).1 = 2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1 := by simpa using hqformula @@ -293,9 +289,14 @@ private theorem hs'At413 : (fun z => BandPackingSymmetryQuadrupleAction .conjugate z) hsucc change BandPackingSymmetryQuadrupleAction .conjugate q = _ convert hss using 1; - simp? [pp, pr, BandPackingSymmetryQuadrupleAction, - BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, - GaussianReflection, negOneSucc, negTwoSucc]; + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, Fin.isValue, GaussianReflection, Int.reduceNeg, + BandPackingSymmetryReversesOrientation, ↓reduceIte, neg_zero, Fin.succ_zero_eq_one, + negOneSucc, negTwoSucc, Matrix.cons_val_zero, Matrix.cons_val, Matrix.cons_val_one, + Zsqrtd.re_sub, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.re_ofNat, Nat.cast_ofNat, + Zsqrtd.im_ofNat, mul_zero, zero_mul, add_zero, Zsqrtd.im_sub, Zsqrtd.im_add, + Zsqrtd.im_mul, neg_sub, Matrix.vecCons_inj, Prod.mk.injEq, sub_left_inj, and_true, pp, + pr]; try { constructor · ring · ext <;> simp [] <;> ring } @@ -318,9 +319,13 @@ private theorem hs'At528 : have hss := congrArg (fun z => BandPackingSymmetryQuadrupleAction .conjugate z) hsucc change BandPackingSymmetryQuadrupleAction .conjugate base = _ convert hss using 1; - simp? [pp, BandPackingSymmetryQuadrupleAction, - BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, - GaussianReflection, negOneSucc, negTwoSucc]; + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, Fin.isValue, GaussianReflection, Int.reduceNeg, + BandPackingSymmetryReversesOrientation, ↓reduceIte, neg_zero, Fin.succ_zero_eq_one, + negOneSucc, negTwoSucc, Matrix.cons_val_zero, Matrix.cons_val, Matrix.cons_val_one, + Zsqrtd.re_sub, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.re_ofNat, Nat.cast_ofNat, + Zsqrtd.im_ofNat, mul_zero, zero_mul, add_zero, Zsqrtd.im_sub, Zsqrtd.im_add, + Zsqrtd.im_mul, neg_sub, Matrix.vecCons_inj, Prod.mk.injEq, sub_left_inj, and_true, pp]; try { constructor · ring · ext <;> simp [] <;> ring } @@ -343,9 +348,13 @@ private theorem hs'At631 : have hss := congrArg (fun z => BandPackingSymmetryQuadrupleAction .conjugate z) hsucc change BandPackingSymmetryQuadrupleAction .conjugate base = _ convert hss using 1; - simp? [pp, BandPackingSymmetryQuadrupleAction, - BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, - GaussianReflection, negOneSucc, negTwoSucc]; + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, Fin.isValue, GaussianReflection, Int.reduceNeg, + BandPackingSymmetryReversesOrientation, ↓reduceIte, neg_zero, Fin.succ_zero_eq_one, + negOneSucc, negTwoSucc, Matrix.cons_val_zero, Matrix.cons_val, Matrix.cons_val_one, + Zsqrtd.re_sub, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.re_ofNat, Nat.cast_ofNat, + Zsqrtd.im_ofNat, mul_zero, zero_mul, add_zero, Zsqrtd.im_sub, Zsqrtd.im_add, + Zsqrtd.im_mul, neg_sub, Matrix.vecCons_inj, Prod.mk.injEq, sub_left_inj, and_true, pp]; try { constructor · ring · ext <;> simp [] <;> ring } @@ -461,8 +470,10 @@ private theorem hnl'At549 : ∀ i : Fin 4, (u i).1 ≠ 0) := by classical intro q hnoLine u i - fin_cases i <;> simp? [u, BandPackingSymmetryQuadrupleAction, - BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] <;> + fin_cases i <;> simp only [BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, Fin.isValue, BandPackingSymmetryReversesOrientation, + ↓reduceIte, neg_zero, Fin.succ_zero_eq_one, Fin.mk_one, Matrix.cons_val_one, + Matrix.cons_val_zero, ne_eq, u, Fin.reduceFinMk, Matrix.cons_val, Fin.zero_eta] <;> apply hnoLine private theorem h0'At562 : @@ -615,7 +626,9 @@ private theorem hnl'At620 : ∀ i : Fin 4, (u i).1 ≠ 0) := by classical intro q hnoLine u i - fin_cases i <;> simp? [u] <;> apply hnoLine + fin_cases i <;> simp only [Fin.isValue, Fin.mk_one, Matrix.cons_val_one, + Matrix.cons_val_zero, ne_eq, u, Fin.reduceFinMk, Matrix.cons_val, Fin.zero_eta] <;> apply + hnoLine private theorem haum'At623 : ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), (q i).1 = (1 : @@ -633,7 +646,9 @@ private theorem haum'At623 : ∀ i j : Fin 4, (u i).1 = 1 → (u j).1 = 1 → i = j)) := by classical intro q hatMostOneUnit p hsecond u i j hi hj - fin_cases i <;> fin_cases j <;> simp? [u] at hi hj ⊢ <;> + fin_cases i <;> fin_cases j <;> simp only [Fin.isValue, Fin.mk_one, Matrix.cons_val_one, + Matrix.cons_val_zero, Fin.reduceFinMk, Matrix.cons_val, Fin.reduceEq, u, Fin.zero_eta, + one_ne_zero, zero_ne_one] at hi hj ⊢ <;> (exfalso; have e := hatMostOneUnit _ _ hi hj; omega) private theorem huAt646 : @@ -657,8 +672,11 @@ private theorem hnl'At656 : let u := BandPackingSymmetryQuadrupleAction .conjugate base ∀ i : Fin 4, (u i).1 ≠ 0) := by classical - intro q hnoLine base u i; fin_cases i <;> simp? [u, base, BandPackingSymmetryQuadrupleAction, - BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] <;> apply hnoLine + intro q hnoLine base u i; fin_cases i <;> simp only [BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, Fin.isValue, Matrix.cons_val_zero, + BandPackingSymmetryReversesOrientation, ↓reduceIte, neg_zero, Fin.succ_zero_eq_one, + Matrix.cons_val_one, Matrix.cons_val_succ, Matrix.cons_val, Fin.mk_one, ne_eq, u, base, + Fin.reduceFinMk, Fin.zero_eta] <;> apply hnoLine private theorem haum'At660 : ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), (q i).1 = (1 : @@ -677,8 +695,11 @@ private theorem haum'At660 : ∀ i j : Fin 4, (u i).1 = 1 → (u j).1 = 1 → i = j)) := by classical intro q hatMostOneUnit p hsecond base u i j hi hj - fin_cases i <;> fin_cases j <;> simp? [u, base, BandPackingSymmetryQuadrupleAction, - BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] at hi hj ⊢ <;> + fin_cases i <;> fin_cases j <;> simp only [BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, Fin.isValue, Matrix.cons_val_zero, + BandPackingSymmetryReversesOrientation, ↓reduceIte, neg_zero, Fin.succ_zero_eq_one, + Matrix.cons_val_one, Matrix.cons_val_succ, Matrix.cons_val, Fin.mk_one, Fin.reduceFinMk, + Fin.reduceEq, u, base, Fin.zero_eta, one_ne_zero, zero_ne_one] at hi hj ⊢ <;> (exfalso; have e := hatMostOneUnit _ _ hi hj; omega) private theorem h0'At670 : @@ -799,7 +820,9 @@ private theorem hnl'At720 : ∀ i : Fin 4, (u i).1 ≠ 0) := by classical intro q hnoLine u i - fin_cases i <;> simp? [u] <;> apply hnoLine + fin_cases i <;> simp only [Fin.isValue, Fin.mk_one, Matrix.cons_val_one, + Matrix.cons_val_zero, ne_eq, u, Fin.reduceFinMk, Matrix.cons_val, Fin.zero_eta] <;> apply + hnoLine private theorem haum'At723 : ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), (q i).1 = (1 : @@ -817,7 +840,9 @@ private theorem haum'At723 : ∀ i j : Fin 4, (u i).1 = 1 → (u j).1 = 1 → i = j)) := by classical intro q hatMostOneUnit p hthird u i j hi hj - fin_cases i <;> fin_cases j <;> simp? [u] at hi hj ⊢ <;> + fin_cases i <;> fin_cases j <;> simp only [Fin.isValue, Fin.mk_one, Matrix.cons_val_one, + Matrix.cons_val_zero, Fin.reduceFinMk, Matrix.cons_val, Fin.reduceEq, u, Fin.zero_eta, + one_ne_zero, zero_ne_one] at hi hj ⊢ <;> (exfalso; have e := hatMostOneUnit _ _ hi hj; omega) private theorem hs'At727 : @@ -853,8 +878,11 @@ private theorem hnl'At757 : let u := BandPackingSymmetryQuadrupleAction .conjugate base ∀ i : Fin 4, (u i).1 ≠ 0) := by classical - intro q hnoLine base u i; fin_cases i <;> simp? [u, base, BandPackingSymmetryQuadrupleAction, - BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] <;> apply hnoLine + intro q hnoLine base u i; fin_cases i <;> simp only [BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, Fin.isValue, Matrix.cons_val_zero, + BandPackingSymmetryReversesOrientation, ↓reduceIte, neg_zero, Fin.succ_zero_eq_one, + Matrix.cons_val_one, Matrix.cons_val_succ, Matrix.cons_val, Fin.mk_one, ne_eq, u, base, + Fin.reduceFinMk, Fin.zero_eta] <;> apply hnoLine private theorem haum'At761 : ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), ∀ (j : Fin (4 : ℕ)), (q i).1 = (1 : @@ -873,8 +901,11 @@ private theorem haum'At761 : ∀ i j : Fin 4, (u i).1 = 1 → (u j).1 = 1 → i = j)) := by classical intro q hatMostOneUnit p hthird base u i j hi hj - fin_cases i <;> fin_cases j <;> simp? [u, base, BandPackingSymmetryQuadrupleAction, - BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction] at hi hj ⊢ <;> + fin_cases i <;> fin_cases j <;> simp only [BandPackingSymmetryQuadrupleAction, + BandPackingSymmetryCircleAction, Fin.isValue, Matrix.cons_val_zero, + BandPackingSymmetryReversesOrientation, ↓reduceIte, neg_zero, Fin.succ_zero_eq_one, + Matrix.cons_val_one, Matrix.cons_val_succ, Matrix.cons_val, Fin.mk_one, Fin.reduceFinMk, + Fin.reduceEq, u, base, Fin.zero_eta, one_ne_zero, zero_ne_one] at hi hj ⊢ <;> (exfalso; have e := hatMostOneUnit _ _ hi hj; omega) private theorem h0'At771 : diff --git a/LeanPool/ApollonianSuperharmonic/BandSignedOccurrenceHalfTurn.lean b/LeanPool/ApollonianSuperharmonic/BandSignedOccurrenceHalfTurn.lean index 32e1e5d604..33e44ec700 100644 --- a/LeanPool/ApollonianSuperharmonic/BandSignedOccurrenceHalfTurn.lean +++ b/LeanPool/ApollonianSuperharmonic/BandSignedOccurrenceHalfTurn.lean @@ -5,15 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint public import LeanPool.ApollonianSuperharmonic.TileArea -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: BandSignedOccurrenceHalfTurn] diff --git a/LeanPool/ApollonianSuperharmonic/BandSubtileOccurrence.lean b/LeanPool/ApollonianSuperharmonic/BandSubtileOccurrence.lean index 9802f4c67f..2227893e4e 100644 --- a/LeanPool/ApollonianSuperharmonic/BandSubtileOccurrence.lean +++ b/LeanPool/ApollonianSuperharmonic/BandSubtileOccurrence.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -- [TABLET NODE: BandSubtileOccurrence] diff --git a/LeanPool/ApollonianSuperharmonic/BandSubtileOccurrenceTranslation.lean b/LeanPool/ApollonianSuperharmonic/BandSubtileOccurrenceTranslation.lean index 67e1109442..08c39a17ac 100644 --- a/LeanPool/ApollonianSuperharmonic/BandSubtileOccurrenceTranslation.lean +++ b/LeanPool/ApollonianSuperharmonic/BandSubtileOccurrenceTranslation.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: BandSubtileOccurrenceTranslation] diff --git a/LeanPool/ApollonianSuperharmonic/BandSuccessorClassification.lean b/LeanPool/ApollonianSuperharmonic/BandSuccessorClassification.lean index d06f335c09..f3633e4208 100644 --- a/LeanPool/ApollonianSuperharmonic/BandSuccessorClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/BandSuccessorClassification.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification -public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity -- [TABLET NODE: BandSuccessorClassification] diff --git a/LeanPool/ApollonianSuperharmonic/BandTangency.lean b/LeanPool/ApollonianSuperharmonic/BandTangency.lean index af3f17918e..8f22c66050 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTangency.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTangency.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle +public import Mathlib.Init + +public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -- [TABLET NODE: BandTangency] diff --git a/LeanPool/ApollonianSuperharmonic/BandTangencyDensity.lean b/LeanPool/ApollonianSuperharmonic/BandTangencyDensity.lean index ebcf895fce..05ad722350 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTangencyDensity.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTangencyDensity.lean @@ -5,13 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandDescartesGapSubdivision -public import LeanPool.ApollonianSuperharmonic.BandGenealogy -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision -public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification -public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrientedGapRefinementExists -public import LeanPool.ApollonianSuperharmonic.BandOrientedGapRefinement +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: BandTangencyDensity] diff --git a/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean b/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean index 9c5adebe29..ca08de2b52 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean @@ -5,58 +5,18 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandInterfaceRootedForest public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation -public import LeanPool.ApollonianSuperharmonic.BandCanonicalPeriodicExtension public import LeanPool.ApollonianSuperharmonic.BandCircle -public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation -public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryGlobalOdometerTransport -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization public import LeanPool.ApollonianSuperharmonic.DiamondTileAcyclicIndegree -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate public import LeanPool.ApollonianSuperharmonic.FordTileAcyclicIndegree -public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -public import LeanPool.ApollonianSuperharmonic.GaussianReflection public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends -public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.ParentalOrientationGluing -public import LeanPool.ApollonianSuperharmonic.PeriodicTileTotalIndegree -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.TileRealization public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -public import LeanPool.ApollonianSuperharmonic.TopologicalDisk -public import LeanPool.ApollonianSuperharmonic.P4564T2ElementaryQuarterTurn -public import LeanPool.ApollonianSuperharmonic.P5532T1OrientationPullback public import LeanPool.ApollonianSuperharmonic.P5532T1SymmetryOrientationTransport -public import LeanPool.ApollonianSuperharmonic.AncestorOdometerRestriction public import LeanPool.ApollonianSuperharmonic.P5532T1RestrictionMassBalance public import LeanPool.ApollonianSuperharmonic.P5532T1ParentInteriorGeometry public import LeanPool.ApollonianSuperharmonic.P5532T1OverlapNoEntry @@ -88,7 +48,7 @@ private theorem emptyOrientation : intro σ exact ⟨{ edge := fun _ _ => False - edge_decidable := fun _ _ => Classical.propDecidable _ + edgeDecidable := fun _ _ => Classical.propDecidable _ rank := fun _ => 0 supported := by intro x y he; cases he oriented := by simp diff --git a/LeanPool/ApollonianSuperharmonic/BandTileSimultaneousInduction.lean b/LeanPool/ApollonianSuperharmonic/BandTileSimultaneousInduction.lean index 7944e6c72e..55d85b247f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTileSimultaneousInduction.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTileSimultaneousInduction.lean @@ -5,81 +5,27 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4564T2ElementaryQuarterTurn public import LeanPool.ApollonianSuperharmonic.P4564T2FordGeometry public import LeanPool.ApollonianSuperharmonic.P4564T2DiamondGeometry public import LeanPool.ApollonianSuperharmonic.P4564T2GeometryPullback -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality public import LeanPool.ApollonianSuperharmonic.P4564T2FordT6Transport public import LeanPool.ApollonianSuperharmonic.P4564T2GeneralT6Transport public import LeanPool.ApollonianSuperharmonic.P4564T2DiamondOrderExclusion -public import LeanPool.ApollonianSuperharmonic.TileT1DiskArea public import LeanPool.ApollonianSuperharmonic.TileT2QuarterTurn public import LeanPool.ApollonianSuperharmonic.TileT3TranslateTouching public import LeanPool.ApollonianSuperharmonic.TileT4ParentTranslateTouching public import LeanPool.ApollonianSuperharmonic.TileT5ParentTouching -public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRawSupport -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryT3T5Covariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport -public import LeanPool.ApollonianSuperharmonic.BandParentRotationOccurrenceCovariance -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification -public import LeanPool.ApollonianSuperharmonic.DiamondBaseT1 -public import LeanPool.ApollonianSuperharmonic.DiamondBaseT2 -public import LeanPool.ApollonianSuperharmonic.DiamondBaseTouching -public import LeanPool.ApollonianSuperharmonic.FordBaseT1 -public import LeanPool.ApollonianSuperharmonic.FordBaseT2 -public import LeanPool.ApollonianSuperharmonic.FordBaseT6 -public import LeanPool.ApollonianSuperharmonic.FordBaseTouching public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence -public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance -public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance -public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretationCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle -public import LeanPool.ApollonianSuperharmonic.BandCircle public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.FordFareyParameter -public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate -public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse -public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple -public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification public import LeanPool.ApollonianSuperharmonic.TileCellComplement -public import LeanPool.ApollonianSuperharmonic.TileTouching -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.TileRealization -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -public import LeanPool.ApollonianSuperharmonic.FordTileGeometry public import LeanPool.ApollonianSuperharmonic.TileArea -- [TABLET NODE: BandTileSimultaneousInduction] diff --git a/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean index 155be17248..953bc2b859 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean @@ -5,17 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TileBordering public import LeanPool.ApollonianSuperharmonic.RegularTileFamily -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis -- [TABLET NODE: BandTileTopologyApplication] @@ -262,7 +256,8 @@ private theorem hcAt267 : classical intro q hsum have hsum' := hsum.1 - simp? [Fin.sum_univ_succ] at hsum' + simp only [Fin.isValue, Fin.sum_univ_succ, Fin.succ_zero_eq_one, Fin.succ_one_eq_two, + Finset.univ_unique, Fin.default_eq_zero, Finset.sum_singleton, Fin.reduceSucc] at hsum' have heq : BandVectors.1 (q 3) (q 0) = -(BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0)) := by apply (eq_neg_iff_add_eq_zero).2 diff --git a/LeanPool/ApollonianSuperharmonic/BandTwelveParentSurround.lean b/LeanPool/ApollonianSuperharmonic/BandTwelveParentSurround.lean index def5d371eb..5a913670dc 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTwelveParentSurround.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTwelveParentSurround.lean @@ -5,30 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches -public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.FinitePatchTopology -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex -public import LeanPool.ApollonianSuperharmonic.ProtoTile -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.TileCellComplement -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.UniqueBoundedGridComplementComponent -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne public import LeanPool.ApollonianSuperharmonic.P4630T1AffineCellSymmetry public import LeanPool.ApollonianSuperharmonic.P4630T1CellRouteLift public import LeanPool.ApollonianSuperharmonic.P4630T1ExteriorNeighbors diff --git a/LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoreCertificate.lean b/LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoreCertificate.lean index bc48acb66a..3441c9bac6 100644 --- a/LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoreCertificate.lean +++ b/LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoreCertificate.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence -public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileFaceIndex public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation diff --git a/LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoverage.lean b/LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoverage.lean index 7d1379bef9..08fc7a2981 100644 --- a/LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/BandUnmodifiedCoverage.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoreCertificate public import LeanPool.ApollonianSuperharmonic.PeriodicTileCoverage diff --git a/LeanPool/ApollonianSuperharmonic/BandUnmodifiedPeriodicCore.lean b/LeanPool/ApollonianSuperharmonic/BandUnmodifiedPeriodicCore.lean index 182c2b9355..0ad26515de 100644 --- a/LeanPool/ApollonianSuperharmonic/BandUnmodifiedPeriodicCore.lean +++ b/LeanPool/ApollonianSuperharmonic/BandUnmodifiedPeriodicCore.lean @@ -5,18 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoreCertificate -public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.P4677T2DrawingExists -public import LeanPool.ApollonianSuperharmonic.P4677T2IncidenceLedger public import LeanPool.ApollonianSuperharmonic.P4677T2ThreeConnected public import LeanPool.ApollonianSuperharmonic.P4677T2FacePoints -public import LeanPool.ApollonianSuperharmonic.P4677T2TouchingWalk public import LeanPool.ApollonianSuperharmonic.P4677T2PrecursorWalk public import LeanPool.ApollonianSuperharmonic.P4677T2PeriodicWalkAssembly public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.LatticeFundamentalSet -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.TouchingTriple -- [TABLET NODE: BandUnmodifiedPeriodicCore] diff --git a/LeanPool/ApollonianSuperharmonic/BandVectorOrientationDichotomy.lean b/LeanPool/ApollonianSuperharmonic/BandVectorOrientationDichotomy.lean index 48ebc70eaf..4fdb7a9e9b 100644 --- a/LeanPool/ApollonianSuperharmonic/BandVectorOrientationDichotomy.lean +++ b/LeanPool/ApollonianSuperharmonic/BandVectorOrientationDichotomy.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandVectors -public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorsExistUnique -- [TABLET NODE: BandVectorOrientationDichotomy] diff --git a/LeanPool/ApollonianSuperharmonic/BandVectors.lean b/LeanPool/ApollonianSuperharmonic/BandVectors.lean index 8bf5012b43..511d38a98f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandVectors.lean +++ b/LeanPool/ApollonianSuperharmonic/BandVectors.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.RecursiveVectorsExistUnique -public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation -- [TABLET NODE: BandVectors] diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryFootprintEdges.lean b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintEdges.lean index 05247456dd..a3f271179e 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryFootprintEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintEdges.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProtoTile -- [TABLET NODE: BoundaryFootprintEdges] diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertexDegreeTwo.lean b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertexDegreeTwo.lean index 62bd67d2ff..bea0871bf0 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertexDegreeTwo.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertexDegreeTwo.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import Mathlib.Init +public import Mathlib.Data.Set.Card + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertices.lean b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertices.lean index d23f73683a..3bec2f1e3b 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertices.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintVertices.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -- [TABLET NODE: BoundaryFootprintVertices] diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryJoinChamberCertificate.lean b/LeanPool/ApollonianSuperharmonic/BoundaryJoinChamberCertificate.lean index 08d8be729b..dd1c89dfa1 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryJoinChamberCertificate.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryJoinChamberCertificate.lean @@ -5,30 +5,16 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification -public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification -public import LeanPool.ApollonianSuperharmonic.BandTangency +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy -public import LeanPool.ApollonianSuperharmonic.BandVectors -public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice -public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem -public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.TilingLattice -public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis -public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.TriangularSignedHeight public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation -public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep -public import LeanPool.ApollonianSuperharmonic.VectorDeterminant -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.P4994T6RotationLaws -public import LeanPool.ApollonianSuperharmonic.P4994T6ChartCovolume public import LeanPool.ApollonianSuperharmonic.P4994T6NonunitChamber public import LeanPool.ApollonianSuperharmonic.P4994T6UnitOccurrenceChamber public import LeanPool.ApollonianSuperharmonic.P4994T6UnitChartRotation @@ -136,7 +122,9 @@ theorem BoundaryJoinChamberCertificate have hpim := congrArg (fun z : GaussianInt => z.im) hp have hrre := congrArg (fun z : GaussianInt => z.re) hr have hrim := congrArg (fun z : GaussianInt => z.im) hr - simp? at hpre hpim hrre hrim + simp only [Int.reduceNeg, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.re_intCast, + Zsqrtd.im_intCast, mul_zero, zero_mul, add_zero, Zsqrtd.im_add, Zsqrtd.im_mul] + at hpre hpim hrre hrim have factor : u.re * v.im - u.im * v.re = (e.re * f.im - e.im * f.re) * (p.1 * r.2 - p.2 * r.1) := by rw [← hpre, ← hpim, ← hrre, ← hrim] diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryString.lean b/LeanPool/ApollonianSuperharmonic/BoundaryString.lean index b8cbb48a03..672ea27a26 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryString.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryString.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileString -public import LeanPool.ApollonianSuperharmonic.BandPrototile public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation -- [TABLET NODE: BoundaryString] diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean b/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean index 14efdd17a7..fa897fad83 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean @@ -5,19 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AffineTriangularStrip -public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryString public import LeanPool.ApollonianSuperharmonic.BoundaryJoinChamberCertificate public import LeanPool.ApollonianSuperharmonic.OrientedUnimodularStripConcatenation -public import LeanPool.ApollonianSuperharmonic.TileString public import LeanPool.ApollonianSuperharmonic.TileStringCoordinateTransport -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TriangularBoundaryStrip -public import LeanPool.ApollonianSuperharmonic.TriangularMaxIncrement -public import LeanPool.ApollonianSuperharmonic.TriangularStripSegment -public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: BoundaryStringConcatenation] @@ -572,8 +565,11 @@ private theorem hmaxRep : D.sup' hDne (fun z => |TriangularSignedHeight u v (u + z)|) ) := by classical intro D hDne u v - simp? [D, TriangularMaxIncrement, TriangularSignedHeight, Prod.add_def, - abs_sub_comm, max_left_comm] + simp only [TriangularMaxIncrement, abs_sub_comm, Int.reduceNeg, TriangularSignedHeight, + Prod.add_def, add_sub_cancel_left, Finset.insert_nonempty, Finset.sup'_insert, mul_zero, + mul_one, zero_sub, neg_sub, sub_zero, mul_neg, Finset.singleton_nonempty, + Finset.sup'_singleton, max_left_comm, le_max_iff, Std.le_refl, true_or, sup_of_le_right, + or_true, D] have hcross : u.1 - v.1 - (u.2 - v.2) = -(v.1 - u.1 - (v.2 - u.2)) := by ring rw [hcross, abs_neg] @@ -917,8 +913,12 @@ theorem BoundaryStringConcatenation have hGplusIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) hGplus have hGminusRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) hGminus have hGminusIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) hGminus - simp? [Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, Zsqrtd.im_sub, - Zsqrtd.re_mul, Zsqrtd.im_mul] at hGplusRe hGplusIm hGminusRe hGminusIm + simp only [Int.reduceNeg, Fin.isValue, Zsqrtd.re_sub, Zsqrtd.re_add, Zsqrtd.re_mul, + zero_mul, mul_one, neg_mul, one_mul, zero_add, sub_neg_eq_add, Int.cast_add, + GaussianInt.intCast_re, GaussianInt.intCast_im, Zsqrtd.re_ofNat, Nat.cast_ofNat, + mul_neg, Zsqrtd.im_ofNat, mul_zero, Zsqrtd.im_mul, add_zero, Int.cast_neg, Int.cast_mul, + Int.cast_ofNat, Zsqrtd.im_sub, Zsqrtd.im_add, Int.cast_sub, neg_zero, Zsqrtd.re_neg, + Zsqrtd.im_neg] at hGplusRe hGplusIm hGminusRe hGminusIm have hplus := BoundaryConcatenationGeometry.hplus q i T₀ Tminus Rplus hRplus hminus' hGplusRe hGplusIm have hminusInc := BoundaryConcatenationGeometry.hminusInc q i T₀ Tminus Rminus hRminus hminus' diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean b/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean index 5c3622bbf1..e9170a9e92 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean @@ -5,19 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometerTrans public import LeanPool.ApollonianSuperharmonic.AncestorOdometerRestriction -public import LeanPool.ApollonianSuperharmonic.BandOrientedBoundaryOccurrenceGenealogy -public import LeanPool.ApollonianSuperharmonic.BandParentBoundaryGenealogy -public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique public import LeanPool.ApollonianSuperharmonic.BoundaryStringConcatenation public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain public import LeanPool.ApollonianSuperharmonic.TileStringExists public import LeanPool.ApollonianSuperharmonic.TileStringUnique -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.P4458T1FirstProperRows public import LeanPool.ApollonianSuperharmonic.P4458T1LargestParentRows public import LeanPool.ApollonianSuperharmonic.P4458T1SmallPairRows @@ -539,7 +535,7 @@ private theorem hxk : minus_family := htiles.2.2.2.2.1 _ (List.mem_of_mem_head? htiles.2.1) plus_family := htiles.2.2.2.2.1 _ (List.mem_of_getLast? htiles.2.2.1) chart := hchart, minus_centroid := hcminus, plus_centroid := hcplus - outer_slope := p₀, minus_slope := pminus, plus_slope := pplus + outerSlope := p₀, minusSlope := pminus, plusSlope := pplus slope_outer := hs₀, slope_minus := hsminus, slope_plus := hsplus minus_difference := dm, plus_difference := dp } ∀ (U : ProtoTile), ∀ (k : PartialOdometer), (AncestorOdometer Cᵢ.1.1 initial.outer.1.1 U @@ -598,7 +594,7 @@ theorem BoundaryStringOdometerRespect : minus_family := htiles.2.2.2.2.1 _ (List.mem_of_mem_head? htiles.2.1) plus_family := htiles.2.2.2.2.1 _ (List.mem_of_getLast? htiles.2.2.1) chart := hchart, minus_centroid := hcminus, plus_centroid := hcplus - outer_slope := p₀, minus_slope := pminus, plus_slope := pplus + outerSlope := p₀, minusSlope := pminus, plusSlope := pplus slope_outer := hs₀, slope_minus := hsminus, slope_plus := hsplus minus_difference := dm, plus_difference := dp } have construct : ∀ n : ℕ, ∀ (C : BandCircle) (ε : Bool) diff --git a/LeanPool/ApollonianSuperharmonic/BoundedDifference.lean b/LeanPool/ApollonianSuperharmonic/BoundedDifference.lean index a481877c3c..28cc802912 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundedDifference.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundedDifference.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction -- [TABLET NODE: BoundedDifference] diff --git a/LeanPool/ApollonianSuperharmonic/CellDisjointCommonEdgesBoundary.lean b/LeanPool/ApollonianSuperharmonic/CellDisjointCommonEdgesBoundary.lean index f4c07683e8..8c4c680526 100644 --- a/LeanPool/ApollonianSuperharmonic/CellDisjointCommonEdgesBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/CellDisjointCommonEdgesBoundary.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.ProtoTile -- [TABLET NODE: CellDisjointCommonEdgesBoundary] diff --git a/LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean b/LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean index 0ecef01d1c..64768207f2 100644 --- a/LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean +++ b/LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean @@ -5,12 +5,20 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Basic +public import Mathlib.Topology.Order.Real +public import Mathlib.Topology.MetricSpace.Pseudo.Constructions +public import Mathlib.Basic.Real.Basic +public import Mathlib.Tactic.ByContra +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Topology.Connected.Basic +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices -public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.ProtoTile public import LeanPool.ApollonianSuperharmonic.TileRealization -- [TABLET NODE: CellDisjointCommonFootprintIncidence] diff --git a/LeanPool/ApollonianSuperharmonic/CellSupportedFootprintVertices.lean b/LeanPool/ApollonianSuperharmonic/CellSupportedFootprintVertices.lean index e2ef03fe27..16eb9b0fae 100644 --- a/LeanPool/ApollonianSuperharmonic/CellSupportedFootprintVertices.lean +++ b/LeanPool/ApollonianSuperharmonic/CellSupportedFootprintVertices.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProtoTile -- [TABLET NODE: CellSupportedFootprintVertices] diff --git a/LeanPool/ApollonianSuperharmonic/CentrallyReflectedAt.lean b/LeanPool/ApollonianSuperharmonic/CentrallyReflectedAt.lean index 380a21d74e..75697c7614 100644 --- a/LeanPool/ApollonianSuperharmonic/CentrallyReflectedAt.lean +++ b/LeanPool/ApollonianSuperharmonic/CentrallyReflectedAt.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileRealization -- [TABLET NODE: CentrallyReflectedAt] diff --git a/LeanPool/ApollonianSuperharmonic/CircleCoordinates.lean b/LeanPool/ApollonianSuperharmonic/CircleCoordinates.lean index 79050d653a..b119c3ee2a 100644 --- a/LeanPool/ApollonianSuperharmonic/CircleCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/CircleCoordinates.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: CircleCoordinates] diff --git a/LeanPool/ApollonianSuperharmonic/CircleMatrix.lean b/LeanPool/ApollonianSuperharmonic/CircleMatrix.lean index 52834ee760..5d8332fc9b 100644 --- a/LeanPool/ApollonianSuperharmonic/CircleMatrix.lean +++ b/LeanPool/ApollonianSuperharmonic/CircleMatrix.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData +public import Mathlib.LinearAlgebra.Matrix.Defs -- [TABLET NODE: CircleMatrix] diff --git a/LeanPool/ApollonianSuperharmonic/CircleMatrixEnclosureCriterion.lean b/LeanPool/ApollonianSuperharmonic/CircleMatrixEnclosureCriterion.lean index 0b23d98664..4ea2c1f6b8 100644 --- a/LeanPool/ApollonianSuperharmonic/CircleMatrixEnclosureCriterion.lean +++ b/LeanPool/ApollonianSuperharmonic/CircleMatrixEnclosureCriterion.lean @@ -5,11 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5630T1SymmetricMatrixPositivityCriterion -public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData public import LeanPool.ApollonianSuperharmonic.CircleMatrix public import LeanPool.ApollonianSuperharmonic.SymmetricMatrixCoordinateIdentity public import LeanPool.ApollonianSuperharmonic.SymmetricMatrixCoordinates +public import Mathlib.Analysis.Complex.Basic -- [TABLET NODE: CircleMatrixEnclosureCriterion] diff --git a/LeanPool/ApollonianSuperharmonic/CircleMatrixIncomingVector.lean b/LeanPool/ApollonianSuperharmonic/CircleMatrixIncomingVector.lean index 2ff286eaf9..f07737c927 100644 --- a/LeanPool/ApollonianSuperharmonic/CircleMatrixIncomingVector.lean +++ b/LeanPool/ApollonianSuperharmonic/CircleMatrixIncomingVector.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing public import LeanPool.ApollonianSuperharmonic.CircleMatrix @@ -120,7 +121,10 @@ theorem CircleMatrixIncomingVector (C : BandCircle) ring have hre := congr_arg Zsqrtd.re hgauss have him := congr_arg Zsqrtd.im hgauss - simp? at hre him + simp only [Int.reduceNeg, Fin.isValue, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.re_star, + neg_mul, one_mul, Zsqrtd.im_star, mul_neg, neg_neg, Zsqrtd.re_ofNat, Nat.cast_ofNat, + Zsqrtd.re_intCast, Zsqrtd.im_ofNat, mul_zero, Zsqrtd.im_intCast, add_zero, + Zsqrtd.im_mul, zero_mul, Zsqrtd.im_add] at hre him rw [hchild] at hre him have hrer : ((BandVectors.1 (q j.succ) (C.1.1)).re : ℝ) + diff --git a/LeanPool/ApollonianSuperharmonic/ClosedSquareRealization.lean b/LeanPool/ApollonianSuperharmonic/ClosedSquareRealization.lean index 912678468e..3e37b22d9a 100644 --- a/LeanPool/ApollonianSuperharmonic/ClosedSquareRealization.lean +++ b/LeanPool/ApollonianSuperharmonic/ClosedSquareRealization.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeCell -- [TABLET NODE: ClosedSquareRealization] diff --git a/LeanPool/ApollonianSuperharmonic/CommonFootprintEdgeVertices.lean b/LeanPool/ApollonianSuperharmonic/CommonFootprintEdgeVertices.lean index 5401621883..e35c385a8c 100644 --- a/LeanPool/ApollonianSuperharmonic/CommonFootprintEdgeVertices.lean +++ b/LeanPool/ApollonianSuperharmonic/CommonFootprintEdgeVertices.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FootprintEdges -- [TABLET NODE: CommonFootprintEdgeVertices] diff --git a/LeanPool/ApollonianSuperharmonic/ConnectedCommonBoundaryPath.lean b/LeanPool/ApollonianSuperharmonic/ConnectedCommonBoundaryPath.lean index 748997c83f..42b843ede3 100644 --- a/LeanPool/ApollonianSuperharmonic/ConnectedCommonBoundaryPath.lean +++ b/LeanPool/ApollonianSuperharmonic/ConnectedCommonBoundaryPath.lean @@ -5,17 +5,15 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonFootprintIncidence -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices public import LeanPool.ApollonianSuperharmonic.ConnectedGridEdgeCarrierGraph public import LeanPool.ApollonianSuperharmonic.DisjointBoundaryCommonEdgeGraphAcyclic public import LeanPool.ApollonianSuperharmonic.DisjointSquareUnionCommonEdgeCarrier public import LeanPool.ApollonianSuperharmonic.FiniteConnectedAcyclicDegreeTwoGridPath -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.ProtoTile public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle public import LeanPool.ApollonianSuperharmonic.SimpleGridCycleSubgraphDegreeTwo public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween diff --git a/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierGraph.lean b/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierGraph.lean index 65e13ee729..aa9d157cab 100644 --- a/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierGraph.lean +++ b/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierGraph.lean @@ -5,9 +5,20 @@ Authors: Wesley Pegden -/ module -public import Mathlib.Combinatorics.SimpleGraph.Matching +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Basic +public import Mathlib.Basic.Real.Basic +public import Mathlib.Data.Finset.Card +public import Mathlib.Tactic.ByContra +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring +public import Mathlib.Topology.Connected.Basic +public import Mathlib.Topology.Order.Compact + public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.GridEdgeCarrier +public import Mathlib.Combinatorics.SimpleGraph.Connectivity.Connected -- [TABLET NODE: ConnectedGridEdgeCarrierGraph] @@ -79,7 +90,11 @@ private theorem horizontal_inter (a c : GaussianInt) : Set.uIcc (GaussianRealPoint a) (GaussianRealPoint b) := carrier_pair a b rintro ⟨⟨x, y⟩, hx, hy⟩ rw [carrier_pair] at hx hy - simp? [Set.uIcc, GaussianRealPoint] at hx hy + simp only [Set.uIcc, GaussianRealPoint, Int.reduceNeg, GaussianInt.intCast_re, + GaussianInt.intCast_im, Zsqrtd.re_add, Zsqrtd.re_one, Int.cast_add, Int.cast_one, + Zsqrtd.im_add, Zsqrtd.im_one, add_zero, Prod.mk_le_mk, le_add_iff_nonneg_right, + zero_le_one, Std.le_refl, and_self, inf_of_le_left, sup_of_le_right, Set.mem_Icc] + at hx hy rw [← GaussianInt.intCast_re a, ← GaussianInt.intCast_im a] at hx rw [← GaussianInt.intCast_re c, ← GaussianInt.intCast_im c] at hy have him : a.im = c.im := by @@ -122,7 +137,10 @@ private theorem vertical_inter (a c : GaussianInt) : z ∈ ({c, c + J} : Finset GaussianInt)) rintro ⟨⟨x, y⟩, hx, hy⟩ rw [carrier_pair] at hx hy - simp? [Set.uIcc, GaussianRealPoint, J] at hx hy + simp only [Set.uIcc, GaussianRealPoint, Int.reduceNeg, GaussianInt.intCast_re, + GaussianInt.intCast_im, Zsqrtd.re_add, add_zero, Zsqrtd.im_add, Int.cast_add, + Int.cast_one, Prod.mk_le_mk, Std.le_refl, le_add_iff_nonneg_right, zero_le_one, + and_self, inf_of_le_left, sup_of_le_right, Set.mem_Icc, J] at hx hy rw [← GaussianInt.intCast_re a, ← GaussianInt.intCast_im a] at hx rw [← GaussianInt.intCast_re c, ← GaussianInt.intCast_im c] at hy have hre : a.re = c.re := by @@ -165,7 +183,11 @@ private theorem cross_inter (a c : GaussianInt) : z ∈ ({c, c + J} : Finset GaussianInt)) rintro ⟨⟨x, y⟩, hx, hy⟩ rw [carrier_pair] at hx hy - simp? [Set.uIcc, GaussianRealPoint, J] at hx hy + simp only [Set.uIcc, GaussianRealPoint, Int.reduceNeg, GaussianInt.intCast_re, + GaussianInt.intCast_im, Zsqrtd.re_add, Zsqrtd.re_one, Int.cast_add, Int.cast_one, + Zsqrtd.im_add, Zsqrtd.im_one, add_zero, Prod.mk_le_mk, le_add_iff_nonneg_right, + zero_le_one, Std.le_refl, and_self, inf_of_le_left, sup_of_le_right, Set.mem_Icc, J] + at hx hy rw [← GaussianInt.intCast_re a, ← GaussianInt.intCast_im a] at hx rw [← GaussianInt.intCast_re c, ← GaussianInt.intCast_im c] at hy have hca : c.re = a.re ∨ c.re = a.re + 1 := by diff --git a/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierUnion.lean b/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierUnion.lean index 837e6ed038..78d7e51404 100644 --- a/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierUnion.lean +++ b/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierUnion.lean @@ -5,6 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Basic +public import Mathlib.Basic.Real.Basic +public import Mathlib.Data.Finset.Card +public import Mathlib.Topology.Connected.Basic +public import Mathlib.Topology.Order.IntermediateValue + public import Mathlib.Combinatorics.SimpleGraph.Connectivity.Connected public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.GridEdgeCarrier diff --git a/LeanPool/ApollonianSuperharmonic/ConsecutivePatchInterface.lean b/LeanPool/ApollonianSuperharmonic/ConsecutivePatchInterface.lean index a0cecdddc2..c52195b13f 100644 --- a/LeanPool/ApollonianSuperharmonic/ConsecutivePatchInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/ConsecutivePatchInterface.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch -- [TABLET NODE: ConsecutivePatchInterface] diff --git a/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean b/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean index 739e4d9a39..db8524df06 100644 --- a/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean +++ b/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean @@ -5,12 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent -public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy diff --git a/LeanPool/ApollonianSuperharmonic/CurvatureOneBandCircleClassification.lean b/LeanPool/ApollonianSuperharmonic/CurvatureOneBandCircleClassification.lean index 01382941dc..5628750075 100644 --- a/LeanPool/ApollonianSuperharmonic/CurvatureOneBandCircleClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/CurvatureOneBandCircleClassification.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandCircle public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification diff --git a/LeanPool/ApollonianSuperharmonic/CurvatureOneBandPrototileSingleton.lean b/LeanPool/ApollonianSuperharmonic/CurvatureOneBandPrototileSingleton.lean index 6ca6162690..6593a35e68 100644 --- a/LeanPool/ApollonianSuperharmonic/CurvatureOneBandPrototileSingleton.lean +++ b/LeanPool/ApollonianSuperharmonic/CurvatureOneBandPrototileSingleton.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.CircleCoordinates -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.BandCircle -- [TABLET NODE: CurvatureOneBandPrototileSingleton] diff --git a/LeanPool/ApollonianSuperharmonic/CurvatureOneOdometer.lean b/LeanPool/ApollonianSuperharmonic/CurvatureOneOdometer.lean index 3c4d9b63cd..d13b00efb1 100644 --- a/LeanPool/ApollonianSuperharmonic/CurvatureOneOdometer.lean +++ b/LeanPool/ApollonianSuperharmonic/CurvatureOneOdometer.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PartialOdometer -- [TABLET NODE: CurvatureOneOdometer] diff --git a/LeanPool/ApollonianSuperharmonic/CurvatureOnePeriodicOdometer.lean b/LeanPool/ApollonianSuperharmonic/CurvatureOnePeriodicOdometer.lean index 6ab665581b..9f42abae71 100644 --- a/LeanPool/ApollonianSuperharmonic/CurvatureOnePeriodicOdometer.lean +++ b/LeanPool/ApollonianSuperharmonic/CurvatureOnePeriodicOdometer.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CircleMatrix public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicRepresentative -public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm public import LeanPool.ApollonianSuperharmonic.TileOdometer public import LeanPool.ApollonianSuperharmonic.TilingLattice @@ -77,7 +78,11 @@ private theorem linear_difference : apply (eq_div_iff (by norm_num : (2 : ℝ) ≠ 0)).2 exact_mod_cast hh' rw [circle_formula] - simp? [g, LatticeQuadraticForm, Matrix.mulVec, dotProduct] + simp only [Int.reduceNeg, Int.cast_add, Int.cast_sub, Int.cast_mul, Int.cast_one, + GaussianInt.intCast_re, GaussianInt.intCast_im, LatticeQuadraticForm, one_div, + dotProduct, Matrix.mulVec, Nat.succ_eq_add_one, Nat.reduceAdd, Matrix.cons_val', + Matrix.cons_val_fin_one, Fin.sum_univ_two, Fin.isValue, Matrix.cons_val_zero, + Matrix.cons_val_one, neg_mul, neg_add_rev, g] rw [half x.re, half x.im] rw [← GaussianInt.intCast_re z, ← GaussianInt.intCast_im z, ← GaussianInt.intCast_re x, ← GaussianInt.intCast_im x] @@ -97,7 +102,11 @@ private theorem difference : classical intro C z g circle_formula α β half x rw [circle_formula] - simp? [g, LatticeQuadraticForm, Matrix.mulVec, dotProduct] + simp only [Int.reduceNeg, Int.cast_add, Int.cast_sub, Int.cast_mul, Int.cast_one, + GaussianInt.intCast_re, GaussianInt.intCast_im, LatticeQuadraticForm, one_div, + dotProduct, Matrix.mulVec, Nat.succ_eq_add_one, Nat.reduceAdd, Matrix.cons_val', + Matrix.cons_val_fin_one, Fin.sum_univ_two, Fin.isValue, Matrix.cons_val_zero, + Matrix.cons_val_one, neg_mul, g] rw [half x.re, half x.im] rw [← GaussianInt.intCast_re z, ← GaussianInt.intCast_im z, ← GaussianInt.intCast_re x, ← GaussianInt.intCast_im x] @@ -176,11 +185,13 @@ theorem CurvatureOnePeriodicOdometer (C : BandCircle) · ext x simp [CurvatureOneOdometer, FootprintVertices] · intro x hx - simp? [CurvatureOneOdometer] at hx ⊢ + simp only [CurvatureOneOdometer, Int.reduceNeg, Finset.mem_insert, Finset.mem_singleton] + at hx ⊢ rcases hx with rfl | rfl | rfl | rfl <;> simp [hne0, hne1] · refine ⟨0, ?_⟩ intro x hx - simp? [CurvatureOneOdometer] at hx ⊢ + simp only [CurvatureOneOdometer, Int.reduceNeg, Finset.mem_insert, Finset.mem_singleton, + add_zero] at hx ⊢ rcases hx with rfl | rfl | rfl | rfl <;> simp [hne0, hne1] · unfold IntegerSuperharmonicRepresentative constructor @@ -246,7 +257,9 @@ theorem CurvatureOnePeriodicOdometer (C : BandCircle) _ = ε * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) / 2 := by ring nlinarith [habs, hbound] · intro x - simp? [FourNeighborLaplacian] + simp only [FourNeighborLaplacian, Int.reduceNeg, Zsqrtd.re_add, Zsqrtd.re_one, + add_sub_cancel_right, Zsqrtd.im_add, Zsqrtd.im_one, add_zero, Zsqrtd.re_sub, + Zsqrtd.im_sub, sub_zero, tsub_le_iff_right] have hp : (x.re + 1) * x.re / 2 = x.re * (x.re - 1) / 2 + 1 * 0 / 2 + x.re * 1 := by convert triangular x.re 1 using 1 <;> ring have hm : (x.re - 1) * (x.re - 1 - 1) / 2 = x.re * (x.re - 1) / 2 + (-1) * (-1 - 1) / 2 + @@ -268,13 +281,15 @@ theorem CurvatureOnePeriodicOdometer (C : BandCircle) rw [hlat] at hv refine ⟨⟨(1 + z.re) * v.re + z.im * v.im, z.im * v.re - z.re * v.im⟩, ?_, ?_⟩ · rw [circle_formula] - simp? [] + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Int.reduceNeg, Int.cast_add, + Int.cast_one, GaussianInt.intCast_re, GaussianInt.intCast_im, Int.cast_mul, + Int.cast_sub] rw [← GaussianInt.intCast_re z, ← GaussianInt.intCast_im z, ← GaussianInt.intCast_re v, ← GaussianInt.intCast_im v] ext i; fin_cases i <;> simp [Matrix.mulVec, dotProduct] ring · intro x - simp? [] + simp only [Int.reduceNeg] rw [triangular x.re v.re, triangular x.im v.im] ring · refine ⟨(-(1 + (z.re : ℝ)) / 2, (z.re : ℝ) / 2), ?_⟩ diff --git a/LeanPool/ApollonianSuperharmonic/CurvatureOneTileBase.lean b/LeanPool/ApollonianSuperharmonic/CurvatureOneTileBase.lean index bd0df82c22..9a89aa4c7b 100644 --- a/LeanPool/ApollonianSuperharmonic/CurvatureOneTileBase.lean +++ b/LeanPool/ApollonianSuperharmonic/CurvatureOneTileBase.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordTileGeometry public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance public import LeanPool.ApollonianSuperharmonic.ExactTileTiling diff --git a/LeanPool/ApollonianSuperharmonic/DiamondBaseT1.lean b/LeanPool/ApollonianSuperharmonic/DiamondBaseT1.lean index 5967f22e1b..a13dfaf1e1 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondBaseT1.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondBaseT1.lean @@ -5,28 +5,21 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain -public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple public import LeanPool.ApollonianSuperharmonic.DiamondTile public import LeanPool.ApollonianSuperharmonic.DiamondTileGeometry public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.SimpleGridPath public import LeanPool.ApollonianSuperharmonic.TileCellComplement public import LeanPool.ApollonianSuperharmonic.TileArea public import LeanPool.ApollonianSuperharmonic.TileTouching -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TopologicalDisk public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.P5116T1UnitDeletionDisk public import LeanPool.ApollonianSuperharmonic.P5116T1PredecessorDeletionDisk -public import LeanPool.ApollonianSuperharmonic.P3092T1CenteredRectangleDisk public import LeanPool.ApollonianSuperharmonic.LatticeTileDiskUnionInterface -public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -- [TABLET NODE: DiamondBaseT1] diff --git a/LeanPool/ApollonianSuperharmonic/DiamondBaseT2.lean b/LeanPool/ApollonianSuperharmonic/DiamondBaseT2.lean index 6bd70038b1..afcdd0f261 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondBaseT2.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondBaseT2.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondTile public import LeanPool.ApollonianSuperharmonic.DiamondParameter public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public meta import Lean.Meta.Tactic.NormCast -- [TABLET NODE: DiamondBaseT2] @@ -53,7 +56,7 @@ private theorem mem_domain (K : DiamondParameter) (z : GaussianInt) : z ∈ Diam refine ⟨y, hy, ?_⟩ have hre := congrArg Zsqrtd.re hz have him := congrArg Zsqrtd.im hz - simp? at hre him + simp only [Nat.cast_min, Nat.cast_add, Nat.cast_one, Int.reduceNeg] at hre him have hj' : (j : Int) < 2 * ((y + 1).min (2 * k - y) : Int) := by exact_mod_cast hj norm_num [Nat.cast_min] at hre ⊢ @@ -158,7 +161,7 @@ private theorem reflectY_mem (K : DiamondParameter) (z : GaussianInt) (hz : z rw [hfirst, hsecond] exact Nat.min_comm _ _ refine ⟨2 * k - 1 - y, by omega, ?_, ?_, ?_⟩ - · simp? [reflectY] + · simp only [Int.reduceNeg, reflectY] have hsub : ((2 * k - 1 - y : Nat) : Int) = 2 * (k : Int) - 1 - y := by omega rw [hsub] omega @@ -185,7 +188,7 @@ private theorem sum_re_reflect (K : DiamondParameter) : (domain K).sum (fun z => apply Zsqrtd.ext · simp [reflectX] at heq ⊢ omega - · simp? [reflectX] at heq ⊢ + · simp only [Int.reduceNeg, Zsqrtd.mk.injEq, sub_left_inj, neg_inj, reflectX] at heq ⊢ exact heq.2 · intro z hz refine ⟨reflectX z, reflectX_mem z hz, ?_⟩ @@ -224,7 +227,7 @@ private theorem sum_im_reflect (K : DiamondParameter) : (domain K).sum (fun z => · exact fun z hz => reflectY_mem z hz · intro z hz w hw heq apply Zsqrtd.ext - · simp? [reflectY] at heq ⊢ + · simp only [Int.reduceNeg, Zsqrtd.mk.injEq, sub_right_inj, reflectY] at heq ⊢ exact heq.1 · simp [reflectY] at heq ⊢ omega diff --git a/LeanPool/ApollonianSuperharmonic/DiamondBaseTouching.lean b/LeanPool/ApollonianSuperharmonic/DiamondBaseTouching.lean index ce1261f01c..10a14763b9 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondBaseTouching.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondBaseTouching.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.P5124T1ParentPlacement public import LeanPool.ApollonianSuperharmonic.P5124T1UnitParents diff --git a/LeanPool/ApollonianSuperharmonic/DiamondCellDomain.lean b/LeanPool/ApollonianSuperharmonic/DiamondCellDomain.lean index a1893f803f..d1823c0fdd 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondCellDomain.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondCellDomain.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FiniteTile -- [TABLET NODE: DiamondCellDomain] diff --git a/LeanPool/ApollonianSuperharmonic/DiamondCoordinateConfiguration.lean b/LeanPool/ApollonianSuperharmonic/DiamondCoordinateConfiguration.lean index 0d94d37477..ccd12aae31 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondCoordinateConfiguration.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondCoordinateConfiguration.lean @@ -5,15 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandCircle -public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle public import LeanPool.ApollonianSuperharmonic.BandVectors public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple -public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -- [TABLET NODE: DiamondCoordinateConfiguration] @@ -88,7 +85,8 @@ private theorem root10'At246 : ⟨1, 1⟩)))) := by classical intro r21 r13 root10 coordU - simp? at root10 + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Int.reduceNeg, Fin.isValue, + Matrix.cons_val_one, Matrix.cons_val_zero, Matrix.cons_val] at root10 try change BandVectors.1 (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) (1, 1) = BandVectors.1 (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) (0, -1) - @@ -370,10 +368,15 @@ private theorem circleWitness : intro K currentSemi refine ⟨⟨⟨(DiamondRecursiveQuadruple K) 0, ?_⟩, ?_⟩, rfl⟩ · constructor - · simp? [DiamondRecursiveQuadruple] + · simp only [DiamondRecursiveQuadruple, Nat.cast_mul, Nat.cast_ofNat, Nat.cast_add, + Nat.cast_one, Int.reduceNeg, Fin.isValue, Matrix.cons_val_zero, Int.succ_ofNat_pos, + mul_pos_iff_of_pos_right, Nat.ofNat_pos, mul_pos_iff_of_pos_left, Int.natCast_pos, + mul_eq_zero, OfNat.ofNat_ne_zero, Int.natCast_eq_zero, false_or] exact Or.inl (by exact_mod_cast K.2) · exact ⟨DiamondRecursiveQuadruple K, currentSemi, 0, rfl⟩ - · simp? [DiamondRecursiveQuadruple] + · simp only [DiamondRecursiveQuadruple, Nat.cast_mul, Nat.cast_ofNat, Nat.cast_add, + Nat.cast_one, Int.reduceNeg, Fin.isValue, Matrix.cons_val_zero, Int.succ_ofNat_pos, + mul_pos_iff_of_pos_right, Nat.ofNat_pos, mul_pos_iff_of_pos_left, Int.natCast_pos] exact_mod_cast K.2 private theorem proper : @@ -448,7 +451,9 @@ private theorem claims : induction n with | zero => have root := baseLaw (0 : GaussianInt) - simp? at root + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, mul_zero, add_zero, Int.reduceNeg, + Fin.isValue, Matrix.cons_val, Matrix.cons_val_one, Matrix.cons_val_zero, sub_zero, + zero_add] at root have rootStep := stepLaw (![(1, 1), (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)), (0, 1), (0, -1)]) (SemiProperQuadruple.base (0 : GaussianInt)) @@ -479,7 +484,7 @@ private theorem claims : have hy : BandVectors.1 (configuration 0 2) (configuration 0 1) = ⟨-1, 1⟩ := by have hh := root01 - simp? at hh + simp only [mul_zero, add_zero, Int.reduceNeg] at hh change BandVectors.1 (1, 1) (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) = (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)) (1, 1) at hh @@ -602,7 +607,9 @@ private theorem slopeClaims : induction n with | zero => have root := baseLaw (0 : GaussianInt) - simp? at root + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, mul_zero, add_zero, Int.reduceNeg, + Fin.isValue, Matrix.cons_val, Matrix.cons_val_one, Matrix.cons_val_zero, sub_zero, + zero_add] at root have rootRec := VectorRecursionLaws (![(1, 1), (1, 1 + 2 * (⟨0, 1⟩ : GaussianInt)), (0, 1), (0, -1)]) (SemiProperQuadruple.base (0 : GaussianInt)) diff --git a/LeanPool/ApollonianSuperharmonic/DiamondExceptionalLattice.lean b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalLattice.lean index 9d1aced1e4..835e15fad0 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondExceptionalLattice.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalLattice.lean @@ -5,8 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondParameter -public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: DiamondExceptionalLattice] diff --git a/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMatrixLatticeIdentification.lean b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMatrixLatticeIdentification.lean index 78c8b339f1..14f2515e8c 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMatrixLatticeIdentification.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMatrixLatticeIdentification.lean @@ -5,11 +5,15 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.CircleMatrix -public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalLattice public import LeanPool.ApollonianSuperharmonic.DiamondPeakMatrix public import LeanPool.ApollonianSuperharmonic.IntegralityLattice +public meta import Lean.Meta.Tactic.NormCast +public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple +public import Mathlib.Algebra.Order.Algebra +public import Mathlib.Data.EReal.Inv -- [TABLET NODE: DiamondExceptionalMatrixLatticeIdentification] @@ -56,7 +60,12 @@ theorem DiamondExceptionalMatrixLatticeIdentification (K : DiamondParameter) rw [matrixIdentity] at hu have first := hu 0 have second := hu 1 - simp? [DiamondPeakMatrix, Matrix.mulVec] at first second + simp only [Matrix.mulVec, DiamondPeakMatrix, Nat.succ_eq_add_one, Nat.reduceAdd, + one_div, Matrix.smul_cons, smul_eq_mul, mul_one, Matrix.smul_empty, Fin.isValue, + Matrix.cons_val', Matrix.cons_val_fin_one, Matrix.cons_val_zero, Int.reduceNeg, + GaussianInt.intCast_re, GaussianInt.intCast_im, Matrix.dotProduct_cons, + Matrix.head_cons, Matrix.tail_cons, Matrix.dotProduct_of_isEmpty, add_zero, + Matrix.cons_val_one] at first second rcases first with ⟨n, first⟩ rcases second with ⟨m, second⟩ field_simp at first second diff --git a/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean index 7d14a8d41d..a47b9d5a69 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean @@ -5,23 +5,18 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalLattice -public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalMatrixLatticeIdentification public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable public import LeanPool.ApollonianSuperharmonic.DiamondOdometer -public import LeanPool.ApollonianSuperharmonic.DiamondOdometerExistsUnique -public import LeanPool.ApollonianSuperharmonic.DiamondParameter public import LeanPool.ApollonianSuperharmonic.DiamondPeakMatrix -public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains public import LeanPool.ApollonianSuperharmonic.FiniteAcyclicOrientationObstruction -public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import LeanPool.ApollonianSuperharmonic.P5435T1Cocycle public import LeanPool.ApollonianSuperharmonic.P5435T1WebGeometry public import LeanPool.ApollonianSuperharmonic.P5432T1EdgeLedger -public import Mathlib.Data.List.Chain -- [TABLET NODE: DiamondExceptionalMaximality] @@ -563,7 +558,7 @@ theorem DiamondExceptionalMaximality (K : DiamondParameter) : { edge := fun x y => x ∈ Df ∧ y ∈ Df ∧ FourNeighborAdjacent x y ∧ (x.re.natAbs < y.re.natAbs ∨ (x.re = y.re ∧ ¬ Even (x.re+x.im) ∧ Even (y.re+y.im))) - edge_decidable := fun _ _ => Classical.propDecidable _ + edgeDecidable := fun _ _ => Classical.propDecidable _ rank := fun x => 2*x.re.natAbs + if Even (x.re+x.im) then 1 else 0 supported := hsupp oriented := horient diff --git a/LeanPool/ApollonianSuperharmonic/DiamondLaplacianTable.lean b/LeanPool/ApollonianSuperharmonic/DiamondLaplacianTable.lean index c4709a3465..a467c1740e 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondLaplacianTable.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondLaplacianTable.lean @@ -5,16 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondOdometer -public import LeanPool.ApollonianSuperharmonic.DiamondOdometerExistsUnique -public import LeanPool.ApollonianSuperharmonic.DiamondParameter -public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -public import Mathlib.Tactic.Abel -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.LinearCombination -public import Mathlib.Tactic.Ring -public import Mathlib.Algebra.Group.Int.Even -- [TABLET NODE: DiamondLaplacianTable] diff --git a/LeanPool/ApollonianSuperharmonic/DiamondOdometer.lean b/LeanPool/ApollonianSuperharmonic/DiamondOdometer.lean index 933e02d183..7846f9e147 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondOdometer.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondOdometer.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondOdometerExistsUnique -- [TABLET NODE: DiamondOdometer] diff --git a/LeanPool/ApollonianSuperharmonic/DiamondOdometerExistsUnique.lean b/LeanPool/ApollonianSuperharmonic/DiamondOdometerExistsUnique.lean index aaf41ce8db..e9b036b1d7 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondOdometerExistsUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondOdometerExistsUnique.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4818T1Representatives public import LeanPool.ApollonianSuperharmonic.P4818T1BoundaryRecovery public import LeanPool.ApollonianSuperharmonic.P4818T1OverlapDifferences diff --git a/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean index fca38544e9..f8f9b2d320 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean @@ -5,24 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometer -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain -public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.DiamondParameter public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction -public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct -- [TABLET NODE: DiamondOpposingBoundaryStarLocalization] @@ -193,12 +183,16 @@ private theorem hshift : rw [hT0'cent, hT0cent, hv30'] at hh have hr' : (u'.re : ℝ) - u.re = 0 := by have h := congrArg Prod.fst hh - simp? [GaussianRealPoint] at h + simp only [GaussianRealPoint, Int.reduceNeg, GaussianInt.intCast_re, + GaussianInt.intCast_im, add_sub_add_left_eq_sub, Prod.mk_sub_mk, Int.cast_zero, + Int.cast_neg, Int.cast_mul, Int.cast_ofNat, Int.cast_natCast] at h rw [← GaussianInt.intCast_re, ← GaussianInt.intCast_re] at h linarith have hi' : (u'.im : ℝ) - u.im = -(2 * (K.1 : Int)) := by have h := congrArg Prod.snd hh - simp? [GaussianRealPoint] at h + simp only [GaussianRealPoint, Int.reduceNeg, GaussianInt.intCast_re, + GaussianInt.intCast_im, add_sub_add_left_eq_sub, Prod.mk_sub_mk, Int.cast_zero, + Int.cast_neg, Int.cast_mul, Int.cast_ofNat, Int.cast_natCast] at h rw [← GaussianInt.intCast_im, ← GaussianInt.intCast_im] at h push_cast at h ⊢ simpa [GaussianInt.intCast_im] using h diff --git a/LeanPool/ApollonianSuperharmonic/DiamondOrientedChildParentEndpoints.lean b/LeanPool/ApollonianSuperharmonic/DiamondOrientedChildParentEndpoints.lean index 64682303f0..80c164c00e 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondOrientedChildParentEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondOrientedChildParentEndpoints.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5260T1LiteralPlacement -public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger public import LeanPool.ApollonianSuperharmonic.P5260T1UnitInterfaces public import LeanPool.ApollonianSuperharmonic.P5260T1PredecessorInterfaces -public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage -- [TABLET NODE: DiamondOrientedChildParentEndpoints] diff --git a/LeanPool/ApollonianSuperharmonic/DiamondParameter.lean b/LeanPool/ApollonianSuperharmonic/DiamondParameter.lean index 63528c084f..a809885c94 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondParameter.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondParameter.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + -- [TABLET NODE: DiamondParameter] diff --git a/LeanPool/ApollonianSuperharmonic/DiamondPeakMatrix.lean b/LeanPool/ApollonianSuperharmonic/DiamondPeakMatrix.lean index c95f08d875..9463940184 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondPeakMatrix.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondPeakMatrix.lean @@ -5,7 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Basic.Real.Basic +public import Mathlib.Data.Fin.VecNotation + public import LeanPool.ApollonianSuperharmonic.DiamondParameter +public import Mathlib.LinearAlgebra.Matrix.Defs -- [TABLET NODE: DiamondPeakMatrix] diff --git a/LeanPool/ApollonianSuperharmonic/DiamondRecursiveQuadruple.lean b/LeanPool/ApollonianSuperharmonic/DiamondRecursiveQuadruple.lean index d5289a4a52..29d4ba009f 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondRecursiveQuadruple.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondRecursiveQuadruple.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.CircleCoordinates public import LeanPool.ApollonianSuperharmonic.DiamondParameter diff --git a/LeanPool/ApollonianSuperharmonic/DiamondRegimeConverse.lean b/LeanPool/ApollonianSuperharmonic/DiamondRegimeConverse.lean index 6cd2e6271f..f1e3abf672 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondRegimeConverse.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondRegimeConverse.lean @@ -5,11 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification -public import LeanPool.ApollonianSuperharmonic.DiamondParameter +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification public import LeanPool.ApollonianSuperharmonic.P4840T6ProperGrowth public import LeanPool.ApollonianSuperharmonic.P4840T6ShiftRoot public import LeanPool.ApollonianSuperharmonic.P4840T6NegatedRoot diff --git a/LeanPool/ApollonianSuperharmonic/DiamondTerminalWebStencilLedger.lean b/LeanPool/ApollonianSuperharmonic/DiamondTerminalWebStencilLedger.lean index 0390343734..031a58fa7c 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondTerminalWebStencilLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondTerminalWebStencilLedger.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2LiteralNormalization public import LeanPool.ApollonianSuperharmonic.P5352T2VectorPlacements public import LeanPool.ApollonianSuperharmonic.P5352T2RightFirst diff --git a/LeanPool/ApollonianSuperharmonic/DiamondTile.lean b/LeanPool/ApollonianSuperharmonic/DiamondTile.lean index 260760d0ce..f5b691814f 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondTile.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondTile.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain public import LeanPool.ApollonianSuperharmonic.ProtoTile diff --git a/LeanPool/ApollonianSuperharmonic/DiamondTileAcyclicIndegree.lean b/LeanPool/ApollonianSuperharmonic/DiamondTileAcyclicIndegree.lean index 0487438809..056e76ac39 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondTileAcyclicIndegree.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondTileAcyclicIndegree.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5432T1Normalization public import LeanPool.ApollonianSuperharmonic.P5432T1EdgeLedger public import LeanPool.ApollonianSuperharmonic.P4062T1OrientationTransport @@ -59,7 +61,7 @@ theorem DiamondTileAcyclicIndegree : let o : AcyclicIndegreeOrientation E (fun x => 2 + FourNeighborLaplacian (DiamondOdometer K) x) := { edge := edge - edge_decidable := fun _ _ => Classical.propDecidable _ + edgeDecidable := fun _ _ => Classical.propDecidable _ rank := rank supported := hsupported oriented := horiented diff --git a/LeanPool/ApollonianSuperharmonic/DiamondTileGeometry.lean b/LeanPool/ApollonianSuperharmonic/DiamondTileGeometry.lean index 152f2ffd74..4ebad6f558 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondTileGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondTileGeometry.lean @@ -5,18 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondTile public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.TileArea -public import LeanPool.ApollonianSuperharmonic.TileRealization -public import LeanPool.ApollonianSuperharmonic.TopologicalDisk public import LeanPool.ApollonianSuperharmonic.P3092T1DiamondCenteredRectangles public import LeanPool.ApollonianSuperharmonic.P3092T1CenteredRectangleDisk -public import Mathlib.Algebra.BigOperators.Intervals -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.Ring -- [TABLET NODE: DiamondTileGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/DiamondTileOdometerRestriction.lean b/LeanPool/ApollonianSuperharmonic/DiamondTileOdometerRestriction.lean index afb68a3229..2057c772f9 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondTileOdometerRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondTileOdometerRestriction.lean @@ -5,15 +5,18 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondOdometer public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence -public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains public import LeanPool.ApollonianSuperharmonic.DiamondTileGeometry public import LeanPool.ApollonianSuperharmonic.P4207T1UnitRestrictions public import LeanPool.ApollonianSuperharmonic.P4207T1ShiftedPredecessor public import LeanPool.ApollonianSuperharmonic.P4223T1DiamondRowNumerators +public import Mathlib.Tactic.ENatToNat +public import Mathlib.Tactic.Polynomial.Basic -- [TABLET NODE: DiamondTileOdometerRestriction] diff --git a/LeanPool/ApollonianSuperharmonic/DiamondTileRecursiveIdentification.lean b/LeanPool/ApollonianSuperharmonic/DiamondTileRecursiveIdentification.lean index cf28ad977f..9c18cbfddd 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondTileRecursiveIdentification.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondTileRecursiveIdentification.lean @@ -5,18 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration public import LeanPool.ApollonianSuperharmonic.DiamondTile -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCentroid -- [TABLET NODE: DiamondTileRecursiveIdentification] diff --git a/LeanPool/ApollonianSuperharmonic/DiamondVertexDomains.lean b/LeanPool/ApollonianSuperharmonic/DiamondVertexDomains.lean index 0882e7d1ac..da3ace2f66 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondVertexDomains.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondVertexDomains.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Topology.Basic + public import LeanPool.ApollonianSuperharmonic.DiamondParameter -public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: DiamondVertexDomains] diff --git a/LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean b/LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean index 2917004bfe..59349115b5 100644 --- a/LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean +++ b/LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean @@ -5,12 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import Mathlib.Combinatorics.SimpleGraph.Acyclic -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.ProtoTile public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle -- [TABLET NODE: DisjointBoundaryCommonEdgeGraphAcyclic] diff --git a/LeanPool/ApollonianSuperharmonic/DisjointSquareUnionCommonEdgeCarrier.lean b/LeanPool/ApollonianSuperharmonic/DisjointSquareUnionCommonEdgeCarrier.lean index 8da7a9721d..c1bb1a79c5 100644 --- a/LeanPool/ApollonianSuperharmonic/DisjointSquareUnionCommonEdgeCarrier.lean +++ b/LeanPool/ApollonianSuperharmonic/DisjointSquareUnionCommonEdgeCarrier.lean @@ -5,12 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.GridEdgeCarrier -public import LeanPool.ApollonianSuperharmonic.ProtoTile public import LeanPool.ApollonianSuperharmonic.TileRealization -- [TABLET NODE: DisjointSquareUnionCommonEdgeCarrier] diff --git a/LeanPool/ApollonianSuperharmonic/EuclideanCircleData.lean b/LeanPool/ApollonianSuperharmonic/EuclideanCircleData.lean index 844b41bb6e..da90f6e30c 100644 --- a/LeanPool/ApollonianSuperharmonic/EuclideanCircleData.lean +++ b/LeanPool/ApollonianSuperharmonic/EuclideanCircleData.lean @@ -5,8 +5,10 @@ Authors: Wesley Pegden -/ module -public import Mathlib.Analysis.Complex.Basic -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.Algebra.Order.BigOperators.Expect +public import Mathlib.Analysis.Complex.Order -- [TABLET NODE: EuclideanCircleData] diff --git a/LeanPool/ApollonianSuperharmonic/ExactPatchBoundaryInterface.lean b/LeanPool/ApollonianSuperharmonic/ExactPatchBoundaryInterface.lean index f71643b13d..c4fae7b375 100644 --- a/LeanPool/ApollonianSuperharmonic/ExactPatchBoundaryInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/ExactPatchBoundaryInterface.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch diff --git a/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceDisjointCompanionEndpoints.lean b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceDisjointCompanionEndpoints.lean index 0a23e7599a..bdaee96fb6 100644 --- a/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceDisjointCompanionEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceDisjointCompanionEndpoints.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors diff --git a/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTriple.lean b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTriple.lean index 5e5bf622e1..a528a85b34 100644 --- a/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTriple.lean +++ b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTriple.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween diff --git a/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleLatticeTouching.lean b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleLatticeTouching.lean index 110548ce8b..6ce36cf8cd 100644 --- a/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleLatticeTouching.lean +++ b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleLatticeTouching.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary public import LeanPool.ApollonianSuperharmonic.LatticeTile diff --git a/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTriplePackingSymmetryCovariance.lean b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTriplePackingSymmetryCovariance.lean index c5d3291250..41f49cedf5 100644 --- a/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTriplePackingSymmetryCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTriplePackingSymmetryCovariance.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport public import LeanPool.ApollonianSuperharmonic.P4055T1PackingGridEquivalence public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage diff --git a/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleRetargetMiddle.lean b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleRetargetMiddle.lean index 75df31bec5..6e02c1ae56 100644 --- a/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleRetargetMiddle.lean +++ b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleRetargetMiddle.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality diff --git a/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleSwapLast.lean b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleSwapLast.lean index 3c9683b7c6..af8a91f047 100644 --- a/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleSwapLast.lean +++ b/LeanPool/ApollonianSuperharmonic/ExactTileInterfaceTripleSwapLast.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -- [TABLET NODE: ExactTileInterfaceTripleSwapLast] diff --git a/LeanPool/ApollonianSuperharmonic/ExactTileTiling.lean b/LeanPool/ApollonianSuperharmonic/ExactTileTiling.lean index da7b08a654..5c5d84db5a 100644 --- a/LeanPool/ApollonianSuperharmonic/ExactTileTiling.lean +++ b/LeanPool/ApollonianSuperharmonic/ExactTileTiling.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeTile -- [TABLET NODE: ExactTileTiling] diff --git a/LeanPool/ApollonianSuperharmonic/ExceptionalConnectorSegments.lean b/LeanPool/ApollonianSuperharmonic/ExceptionalConnectorSegments.lean index ab4e00f0ec..1d8be499ea 100644 --- a/LeanPool/ApollonianSuperharmonic/ExceptionalConnectorSegments.lean +++ b/LeanPool/ApollonianSuperharmonic/ExceptionalConnectorSegments.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -- [TABLET NODE: ExceptionalConnectorSegments] diff --git a/LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean b/LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean index b78fbe18a8..3f77c1561c 100644 --- a/LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean +++ b/LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean @@ -5,21 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.SimpleGridPath -public import LeanPool.ApollonianSuperharmonic.TileCellComplement -public import LeanPool.ApollonianSuperharmonic.TileTouching -public import LeanPool.ApollonianSuperharmonic.TouchingTriple public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary public import LeanPool.ApollonianSuperharmonic.P3161T2PathSubwalk -public import Mathlib.Data.List.Chain -- [TABLET NODE: ExceptionalModifiedABPath] diff --git a/LeanPool/ApollonianSuperharmonic/ExceptionalRestorationSectorData.lean b/LeanPool/ApollonianSuperharmonic/ExceptionalRestorationSectorData.lean index b6a523f458..80957329b1 100644 --- a/LeanPool/ApollonianSuperharmonic/ExceptionalRestorationSectorData.lean +++ b/LeanPool/ApollonianSuperharmonic/ExceptionalRestorationSectorData.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.TileCellComplement -- [TABLET NODE: ExceptionalRestorationSectorData] diff --git a/LeanPool/ApollonianSuperharmonic/FiniteAcyclicGraphCardConnected.lean b/LeanPool/ApollonianSuperharmonic/FiniteAcyclicGraphCardConnected.lean index dd56efa5e1..d2f0ac337f 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteAcyclicGraphCardConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteAcyclicGraphCardConnected.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import Mathlib.Combinatorics.SimpleGraph.Acyclic -public import LeanPool.ApollonianSuperharmonic.Preamble -- [TABLET NODE: FiniteAcyclicGraphCardConnected] diff --git a/LeanPool/ApollonianSuperharmonic/FiniteAcyclicOrientationObstruction.lean b/LeanPool/ApollonianSuperharmonic/FiniteAcyclicOrientationObstruction.lean index 47adb37e5d..d0c34eaea0 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteAcyclicOrientationObstruction.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteAcyclicOrientationObstruction.lean @@ -5,7 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation +public meta import Lean.Meta.Tactic.NormCast +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -- [TABLET NODE: FiniteAcyclicOrientationObstruction] @@ -32,13 +36,13 @@ theorem FiniteAcyclicOrientationObstruction obtain ⟨x, hx, hmax⟩ := Finset.exists_max_image Y o.rank hY have hxD : x ∈ D := hsub hx have hsubset : Y.filter (fun y => o.edge y x) ⊆ - D.filter (fun y => @decide (o.edge y x) (o.edge_decidable y x)) := by + D.filter (fun y => @decide (o.edge y x) (o.edgeDecidable y x)) := by intro y hy have hyY := (Finset.mem_filter.mp hy).1 have hye := (Finset.mem_filter.mp hy).2 exact Finset.mem_filter.mpr ⟨hsub hyY, by simp [hye]⟩ have hcard : ((Y.filter (fun y => o.edge y x)).card : ℤ) ≤ - ((D.filter (fun y => @decide (o.edge y x) (o.edge_decidable y x))).card : ℤ) := by + ((D.filter (fun y => @decide (o.edge y x) (o.edgeDecidable y x))).card : ℤ) := by exact_mod_cast Finset.card_le_card hsubset have hneighbor : ∀ y ∈ Y, FourNeighborAdjacent x y → o.edge y x := by intro y hy hxy @@ -54,7 +58,7 @@ theorem FiniteAcyclicOrientationObstruction exact Finset.mem_filter.mpr ⟨(Finset.mem_filter.mp hy).1, hneighbor y (Finset.mem_filter.mp hy).1 (Finset.mem_filter.mp hy).2⟩ have hcount' : ((Y.filter (fun y => FourNeighborAdjacent x y)).card : ℤ) ≤ - ((D.filter (fun y => @decide (o.edge y x) (o.edge_decidable y x))).card : ℤ) := by + ((D.filter (fun y => @decide (o.edge y x) (o.edgeDecidable y x))).card : ℤ) := by have hcountInt : ((Y.filter (fun y => FourNeighborAdjacent x y)).card : ℤ) ≤ ((Y.filter (fun y => o.edge y x)).card : ℤ) := by exact_mod_cast hcount @@ -117,7 +121,7 @@ theorem FiniteAcyclicOrientationObstruction unfold FourNeighborLaplacian simp only [] unfold FourNeighborLaplacian at hineq - simp? [hx] at hineq ⊢ + simp only [Int.reduceNeg, hx, ↓reduceIte] at hineq ⊢ clear hcount' linarith [hineq] diff --git a/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean b/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean index 6d2dff7ead..ee6bbd076d 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import Mathlib.Combinatorics.SimpleGraph.Acyclic -public import Mathlib.Data.Finset.Card public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell -public import LeanPool.ApollonianSuperharmonic.ProtoTile /-! # FiniteBiconnectedHorizontalRunTree diff --git a/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean b/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean index 6a6bda9491..9c9a5b9239 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import Mathlib.Combinatorics.SimpleGraph.Acyclic -public import Mathlib.Combinatorics.SimpleGraph.Matching public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween diff --git a/LeanPool/ApollonianSuperharmonic/FiniteConnectedCellSetNoCheckerboard.lean b/LeanPool/ApollonianSuperharmonic/FiniteConnectedCellSetNoCheckerboard.lean index b766e7a70f..5df92e6e6a 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteConnectedCellSetNoCheckerboard.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteConnectedCellSetNoCheckerboard.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex -public import Mathlib.Data.List.Chain -public import Mathlib.Tactic.Abel -- [TABLET NODE: FiniteConnectedCellSetNoCheckerboard] diff --git a/LeanPool/ApollonianSuperharmonic/FiniteCycleComponentList.lean b/LeanPool/ApollonianSuperharmonic/FiniteCycleComponentList.lean index 0d7a8e1314..d9d4acfd71 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteCycleComponentList.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteCycleComponentList.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import Mathlib.Combinatorics.SimpleGraph.Matching -public import LeanPool.ApollonianSuperharmonic.Preamble /-! # FiniteCycleComponentList diff --git a/LeanPool/ApollonianSuperharmonic/FiniteGridEdgeGraphEncoding.lean b/LeanPool/ApollonianSuperharmonic/FiniteGridEdgeGraphEncoding.lean index 72c68e0eeb..1fe3efa173 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteGridEdgeGraphEncoding.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteGridEdgeGraphEncoding.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import Mathlib.Combinatorics.SimpleGraph.Acyclic -public import Mathlib.Data.Set.Card public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent -- [TABLET NODE: FiniteGridEdgeGraphEncoding] diff --git a/LeanPool/ApollonianSuperharmonic/FiniteInducedTilePatch.lean b/LeanPool/ApollonianSuperharmonic/FiniteInducedTilePatch.lean index e9aee8bef0..246bb79426 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteInducedTilePatch.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteInducedTilePatch.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation public import LeanPool.ApollonianSuperharmonic.ProtoTile diff --git a/LeanPool/ApollonianSuperharmonic/FinitePatchTopology.lean b/LeanPool/ApollonianSuperharmonic/FinitePatchTopology.lean index 51c5d1a142..04d013f467 100644 --- a/LeanPool/ApollonianSuperharmonic/FinitePatchTopology.lean +++ b/LeanPool/ApollonianSuperharmonic/FinitePatchTopology.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ExactTileTiling public import LeanPool.ApollonianSuperharmonic.FiniteConnectedCellSetNoCheckerboard public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch diff --git a/LeanPool/ApollonianSuperharmonic/FinitePolyominoDiskCriterion.lean b/LeanPool/ApollonianSuperharmonic/FinitePolyominoDiskCriterion.lean index 44695eb325..e33180df05 100644 --- a/LeanPool/ApollonianSuperharmonic/FinitePolyominoDiskCriterion.lean +++ b/LeanPool/ApollonianSuperharmonic/FinitePolyominoDiskCriterion.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import Mathlib.Analysis.Convex.GaugeRescale -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex @@ -16,9 +17,6 @@ public import LeanPool.ApollonianSuperharmonic.P3475T1GridBoundary public import LeanPool.ApollonianSuperharmonic.P3475T1PolygonTriangleConstruction public import LeanPool.ApollonianSuperharmonic.P3475T1PolygonalSeparation public import LeanPool.ApollonianSuperharmonic.P3475T1SquareUnionIdentification -public import LeanPool.ApollonianSuperharmonic.P3381T1PiecewiseAffinePolygonModel -public import LeanPool.ApollonianSuperharmonic.ProtoTile -public import LeanPool.ApollonianSuperharmonic.TileRealization -- [TABLET NODE: FinitePolyominoDiskCriterion] diff --git a/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean b/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean index 8a18e2c870..4a51e130fb 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean @@ -5,13 +5,17 @@ Authors: Wesley Pegden -/ module -public import Mathlib.Algebra.BigOperators.Group.Finset.Basic -public import Mathlib.Data.Multiset.Bind +public import Mathlib.Init +public import Mathlib.Data.Finset.Card +public import Mathlib.Data.Set.Card +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex -public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import Mathlib.Algebra.Order.Ring.Star /-! # FiniteSquareIncidenceIdentities diff --git a/LeanPool/ApollonianSuperharmonic/FiniteTile.lean b/LeanPool/ApollonianSuperharmonic/FiniteTile.lean index 7de02a2215..66db3c188e 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteTile.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteTile.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeCell -- [TABLET NODE: FiniteTile] diff --git a/LeanPool/ApollonianSuperharmonic/FootprintDeletionRetention.lean b/LeanPool/ApollonianSuperharmonic/FootprintDeletionRetention.lean index 0d9407d381..49352c8bd8 100644 --- a/LeanPool/ApollonianSuperharmonic/FootprintDeletionRetention.lean +++ b/LeanPool/ApollonianSuperharmonic/FootprintDeletionRetention.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CellSupportedFootprintVertices public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices diff --git a/LeanPool/ApollonianSuperharmonic/FootprintEdges.lean b/LeanPool/ApollonianSuperharmonic/FootprintEdges.lean index 0c3d54f16a..1396ef2d26 100644 --- a/LeanPool/ApollonianSuperharmonic/FootprintEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/FootprintEdges.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProtoTile -- [TABLET NODE: FootprintEdges] diff --git a/LeanPool/ApollonianSuperharmonic/FootprintVertices.lean b/LeanPool/ApollonianSuperharmonic/FootprintVertices.lean index c5e4d8bd08..4b7232e181 100644 --- a/LeanPool/ApollonianSuperharmonic/FootprintVertices.lean +++ b/LeanPool/ApollonianSuperharmonic/FootprintVertices.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProtoTile -- [TABLET NODE: FootprintVertices] diff --git a/LeanPool/ApollonianSuperharmonic/FordBaseT1.lean b/LeanPool/ApollonianSuperharmonic/FordBaseT1.lean index b53f811357..fbef426033 100644 --- a/LeanPool/ApollonianSuperharmonic/FordBaseT1.lean +++ b/LeanPool/ApollonianSuperharmonic/FordBaseT1.lean @@ -5,29 +5,19 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.FordFareyParameter public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple public import LeanPool.ApollonianSuperharmonic.FordTileGeometry public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.SimpleGridPath public import LeanPool.ApollonianSuperharmonic.TileCellComplement -public import LeanPool.ApollonianSuperharmonic.TileRealization public import LeanPool.ApollonianSuperharmonic.TileTouching -public import LeanPool.ApollonianSuperharmonic.TopologicalDisk public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.P5104T1CornerDeletionDisk public import LeanPool.ApollonianSuperharmonic.LatticeTileDiskUnionInterface -public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.TileTranslation -- [TABLET NODE: FordBaseT1] diff --git a/LeanPool/ApollonianSuperharmonic/FordBaseT2.lean b/LeanPool/ApollonianSuperharmonic/FordBaseT2.lean index 129affbd36..4b0e468c66 100644 --- a/LeanPool/ApollonianSuperharmonic/FordBaseT2.lean +++ b/LeanPool/ApollonianSuperharmonic/FordBaseT2.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordTile public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric +public meta import Lean.Meta.Tactic.NormCast -- [TABLET NODE: FordBaseT2] @@ -56,7 +59,10 @@ theorem FordBaseT2 (q : Nat) (hq : 0 < q) : (q : Int) * ((q - 1 : Nat) : Int) / 2 := by rw [← Nat.cast_sum] simp [Finset.sum_range_id] - simp? [domain, Finset.sum_product] + simp only [Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, Finset.coe_range, + Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, implies_true, + Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, Finset.sum_const, + Finset.card_range, Int.nsmul_eq_mul, domain] conv_lhs => rw [← Finset.mul_sum (Finset.range q) (fun x => (x : Int)) (q : Int)] rw [range_sum] ring @@ -66,7 +72,10 @@ theorem FordBaseT2 (q : Nat) (hq : 0 < q) : (q : Int) * ((q - 1 : Nat) : Int) / 2 := by rw [← Nat.cast_sum] simp [Finset.sum_range_id] - simp? [domain, Finset.sum_product] + simp only [Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, Finset.coe_range, + Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, implies_true, + Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, Finset.sum_const, + Finset.card_range, Int.nsmul_eq_mul, domain] rw [range_sum] ring have centroid_formula : TileCentroid (FordTile q) = diff --git a/LeanPool/ApollonianSuperharmonic/FordBaseT6.lean b/LeanPool/ApollonianSuperharmonic/FordBaseT6.lean index c930b2b015..89d0f867c5 100644 --- a/LeanPool/ApollonianSuperharmonic/FordBaseT6.lean +++ b/LeanPool/ApollonianSuperharmonic/FordBaseT6.lean @@ -5,24 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.FordCellDomain -public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.FordFareyParameter -public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple -public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.P5064T3OrderedPredecessor public import LeanPool.ApollonianSuperharmonic.P5064T3LiteralLocalization public import LeanPool.ApollonianSuperharmonic.P5064T3RectangleContacts diff --git a/LeanPool/ApollonianSuperharmonic/FordBaseTouching.lean b/LeanPool/ApollonianSuperharmonic/FordBaseTouching.lean index 448cc61173..f92d2f01d8 100644 --- a/LeanPool/ApollonianSuperharmonic/FordBaseTouching.lean +++ b/LeanPool/ApollonianSuperharmonic/FordBaseTouching.lean @@ -5,29 +5,15 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.FordCellDomain -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordTile -public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import LeanPool.ApollonianSuperharmonic.SimpleGridPath -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileTouching public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.TouchingTriple -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.P5110T1TranslationTriples public import LeanPool.ApollonianSuperharmonic.P5110T1PositiveParentTriples public import LeanPool.ApollonianSuperharmonic.P5110T1AnchoredTriples public import LeanPool.ApollonianSuperharmonic.P5110T1ParentLocalization -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -- [TABLET NODE: FordBaseTouching] diff --git a/LeanPool/ApollonianSuperharmonic/FordBoundaryMultiplicity.lean b/LeanPool/ApollonianSuperharmonic/FordBoundaryMultiplicity.lean index 66c9d9f122..1a70248e35 100644 --- a/LeanPool/ApollonianSuperharmonic/FordBoundaryMultiplicity.lean +++ b/LeanPool/ApollonianSuperharmonic/FordBoundaryMultiplicity.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains public import LeanPool.ApollonianSuperharmonic.LatticeVertexBoundary diff --git a/LeanPool/ApollonianSuperharmonic/FordCellDomain.lean b/LeanPool/ApollonianSuperharmonic/FordCellDomain.lean index 87467ac5da..ef0c9e441e 100644 --- a/LeanPool/ApollonianSuperharmonic/FordCellDomain.lean +++ b/LeanPool/ApollonianSuperharmonic/FordCellDomain.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FiniteTile -- [TABLET NODE: FordCellDomain] diff --git a/LeanPool/ApollonianSuperharmonic/FordCenteredInteriorOdometerStencil.lean b/LeanPool/ApollonianSuperharmonic/FordCenteredInteriorOdometerStencil.lean index 576e02adbe..adcf1adfe8 100644 --- a/LeanPool/ApollonianSuperharmonic/FordCenteredInteriorOdometerStencil.lean +++ b/LeanPool/ApollonianSuperharmonic/FordCenteredInteriorOdometerStencil.lean @@ -5,49 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryGlobalOdometerTransport -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.FordCellDomain -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -public import LeanPool.ApollonianSuperharmonic.FordFareyParameter -public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordOdometerFamilyExistsUnique -public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse -public import LeanPool.ApollonianSuperharmonic.FordTile -public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends -public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation -public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.P5448T1CenteredFordGeometry public import LeanPool.ApollonianSuperharmonic.P5448T1CommonAffineFordPair -public import LeanPool.ApollonianSuperharmonic.P5448T1CanonicalFordBoundary -public import Mathlib.Tactic.Ring -- [TABLET NODE: FordCenteredInteriorOdometerStencil] diff --git a/LeanPool/ApollonianSuperharmonic/FordCircleCoordinate.lean b/LeanPool/ApollonianSuperharmonic/FordCircleCoordinate.lean index 6125aef47d..d833437fb4 100644 --- a/LeanPool/ApollonianSuperharmonic/FordCircleCoordinate.lean +++ b/LeanPool/ApollonianSuperharmonic/FordCircleCoordinate.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CircleCoordinates -- [TABLET NODE: FordCircleCoordinate] diff --git a/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean b/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean index b3e5c07304..71eac2d964 100644 --- a/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean +++ b/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean @@ -5,16 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandCircle -public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle public import LeanPool.ApollonianSuperharmonic.BandVectors -public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple -public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -- [TABLET NODE: FordCoordinateConfiguration] @@ -206,8 +202,11 @@ private theorem hsemiAt342 : classical intro n Q q1pos hgtq pd qd hqdpos hqdlt hd1 hd2 hred hq1gt R hsucc convert hsucc using 1; - simp? [FordRecursiveQuadruple, R, pd, qd, Q.sum_p, Q.sum_q, - FordCircleCoordinate, hqdpos.ne'] + simp only [FordRecursiveQuadruple, FordCircleCoordinate, Q.sum_q, Nat.cast_mul, + Nat.cast_add, Int.reduceNeg, Q.sum_p, hqdpos.ne', ↓reduceIte, Fin.isValue, + Matrix.cons_val_zero, Matrix.cons_val, mul_zero, add_zero, Matrix.cons_val_one, + mul_neg, mul_one, Matrix.vecCons_inj, Prod.mk.injEq, ite_eq_right_iff, zero_eq_mul, + Int.natCast_eq_zero, or_self, and_true, qd, pd, R] all_goals try rw [Nat.cast_sub (by omega)] repeat' first | constructor | (ext <;> simp; ring) all_goals try ring @@ -254,7 +253,8 @@ private theorem hv13At359 : intro n Q q1pos hgtq pd qd hqdlt hd1 hd2 hred hq1gt R rv32 rv13 direct have hx := direct.2.1 rw [rv13, rv32] at hx - simp? [FordRecursiveQuadruple, R] at hx + simp only [FordRecursiveQuadruple, Fin.isValue, Matrix.cons_val_zero, Matrix.cons_val, + Int.reduceNeg, mul_neg, R] at hx have hqdrel : qd + Q.q₂ = Q.q₁ := by dsimp [qd] omega @@ -456,15 +456,25 @@ private theorem hsemiAt448 : FordCircleCoordinate Q.p₁ Q.q₁ := by simp [FordRecursiveQuadruple, R, q1pos'.ne'] convert hfinal using 1; - simp? [FordRecursiveQuadruple, R, Q.sum_p, Q.sum_q, - FordCircleCoordinate, rcond] - all_goals try simp? [rotatedTuple] - repeat' first | constructor | (ext <;> simp? <;> ring) + simp only [FordRecursiveQuadruple, FordCircleCoordinate, Q.sum_q, Nat.cast_mul, + Nat.cast_add, Int.reduceNeg, Q.sum_p, rcond, ↓reduceIte, Nat.succ_eq_add_one, + Nat.reduceAdd, Fin.isValue, Matrix.cons_val_zero, Matrix.cons_val, + Matrix.cons_val_one, Matrix.vecCons_inj, Prod.mk.injEq, and_true, R] + all_goals try simp only [Fin.isValue, Matrix.cons_val_zero, Matrix.cons_val, + Matrix.cons_val_one, Int.reduceNeg, rotatedTuple] + repeat' first | constructor | (ext <;> simp only [Fin.isValue, Int.reduceNeg, Zsqrtd.im_sub, + Zsqrtd.im_add, Zsqrtd.im_mul, Zsqrtd.re_ofNat, Nat.cast_ofNat, Zsqrtd.im_ofNat, + zero_mul, add_zero, Zsqrtd.re_sub, Zsqrtd.re_add, Zsqrtd.re_mul, mul_zero] <;> ring) all_goals try ring all_goals try rw [rentry] - all_goals try simp? [FordCircleCoordinate] - all_goals try simp? [FordRecursiveQuadruple, R, q1pos'.ne'] - all_goals try simp? [FordCircleCoordinate, pd, qd] + all_goals try simp only [Fin.isValue, FordCircleCoordinate, Nat.cast_mul, Int.reduceNeg, + one_mul] + all_goals try simp only [FordRecursiveQuadruple, q1pos'.ne', ↓reduceIte, Fin.isValue, + Matrix.cons_val_zero, Matrix.cons_val, zero_mul, add_zero, R, Int.reduceNeg, + Zsqrtd.im_neg, Zsqrtd.im_one, neg_zero, Zsqrtd.re_neg, Zsqrtd.re_one, neg_mul, one_mul, + neg_add_cancel_right] + all_goals try simp only [FordCircleCoordinate, Nat.cast_mul, Int.reduceNeg, qd, pd, one_mul, + Int.reduceSub] all_goals try rw [Nat.cast_sub (by omega)] all_goals try ring @@ -577,7 +587,9 @@ private theorem ha32At503 : (⟨0, 1⟩ : GaussianInt) * (Q.p₁ : GaussianInt) := by simpa [rotatedTuple, FordRecursiveQuadruple, R, q1pos'.ne'] using ra13 rw [ra32', ra13'] at hx - simp? [rotatedTuple, FordRecursiveQuadruple, R, q1pos'.ne'] at hx + simp only [FordRecursiveQuadruple, q1pos'.ne', ↓reduceIte, Fin.isValue, + Matrix.cons_val_zero, Matrix.cons_val, Matrix.cons_val_one, Int.reduceNeg, rotatedTuple, + R] at hx calc BandVectors.2 ((FordRecursiveQuadruple Q) 3) ((FordRecursiveQuadruple Q) 2) = @@ -657,13 +669,18 @@ private theorem hproper : refine ⟨hs.1, ?_⟩ intro j fin_cases j - · simp? [FordRecursiveQuadruple, FordCircleCoordinate, hq1pos.ne', Nat.cast_mul] + · simp only [FordRecursiveQuadruple, FordCircleCoordinate, Nat.cast_mul, Int.reduceNeg, + hq1pos.ne', ↓reduceIte, Fin.zero_eta, Fin.isValue, Fin.succ_zero_eq_one, + Matrix.cons_val_one, Matrix.cons_val_zero] change (P.q₁ : Int) * P.q₁ < (P.q : Int) * P.q exact_mod_cast Nat.mul_self_lt_mul_self P.q₁_lt - · simp? [FordRecursiveQuadruple, FordCircleCoordinate, Nat.cast_mul] + · simp only [FordRecursiveQuadruple, FordCircleCoordinate, Nat.cast_mul, Int.reduceNeg, + Fin.mk_one, Fin.isValue, Fin.succ_one_eq_two, Matrix.cons_val, Matrix.cons_val_zero] change (P.q₂ : Int) * P.q₂ < (P.q : Int) * P.q exact_mod_cast Nat.mul_self_lt_mul_self hq2lt - · simp? [FordRecursiveQuadruple, FordCircleCoordinate, Nat.cast_mul] + · simp only [FordRecursiveQuadruple, FordCircleCoordinate, Nat.cast_mul, Int.reduceNeg, + Fin.reduceFinMk, Fin.reduceSucc, Matrix.cons_val, Fin.isValue, Matrix.cons_val_zero, + mul_self_pos, ne_eq, Int.natCast_eq_zero] exact Nat.ne_of_gt P.q_pos end FordConfigurationProof @@ -1197,17 +1214,22 @@ theorem FordCoordinateConfiguration (P : FordFareyParameter) : have coord2 := FordConfigurationDetails.coord2 Q have hsemi : SemiProperQuadruple (FordRecursiveQuadruple Q) := by convert ht using 1; - simp? [FordRecursiveQuadruple, FordCircleCoordinate, z, qone, - hqone, hp, hq, Q.sum_p] + simp only [FordRecursiveQuadruple, FordCircleCoordinate, hq, Nat.reduceMul, + Nat.cast_ofNat, Int.reduceNeg, Q.sum_p, hp, qone, one_ne_zero, ↓reduceIte, + mul_one, Nat.cast_one, hqone, Fin.isValue, Matrix.cons_val_zero, + Matrix.cons_val, Matrix.cons_val_one, mul_zero, add_zero, Int.reduceAdd, + sub_zero, mul_neg, Matrix.vecCons_inj, Prod.mk.injEq, true_and, and_true, z] constructor · ext <;> simp; ring constructor · ext <;> simp; ring · ext <;> simp have b1 := baseLaw z - simp? at b1 + simp only [Int.reduceNeg, Fin.isValue, Matrix.cons_val, Matrix.cons_val_one, + Matrix.cons_val_zero] at b1 have b2 := baseLaw ⟨0, Q.p₂ - 1⟩ - simp? at b2 + simp only [Int.reduceNeg, Fin.isValue, Matrix.cons_val, Matrix.cons_val_one, + Matrix.cons_val_zero, Zsqrtd.add_def, add_zero, sub_add_cancel] at b2 have f1 := flipLaw _ _ (PrimitiveVectorOrientation.base31 ⟨0, Q.p₂ - 1⟩) have hv13 := FordConfigurationDetails.hv13At868 Q qone hqone hp hq coord1 b1 have hv32 := FordConfigurationProof.hv32At253 Q qone hqone hp hq coord2 b2 f1 diff --git a/LeanPool/ApollonianSuperharmonic/FordDoubledBoundary.lean b/LeanPool/ApollonianSuperharmonic/FordDoubledBoundary.lean index 36edaf1ce2..1f12bfb3ea 100644 --- a/LeanPool/ApollonianSuperharmonic/FordDoubledBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/FordDoubledBoundary.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordVertexDomain -- [TABLET NODE: FordDoubledBoundary] diff --git a/LeanPool/ApollonianSuperharmonic/FordExceptionalLattice.lean b/LeanPool/ApollonianSuperharmonic/FordExceptionalLattice.lean index 8f1e7e5828..227d622ad5 100644 --- a/LeanPool/ApollonianSuperharmonic/FordExceptionalLattice.lean +++ b/LeanPool/ApollonianSuperharmonic/FordExceptionalLattice.lean @@ -5,8 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordFareyParameter -public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: FordExceptionalLattice] diff --git a/LeanPool/ApollonianSuperharmonic/FordExceptionalMatrixLatticeIdentification.lean b/LeanPool/ApollonianSuperharmonic/FordExceptionalMatrixLatticeIdentification.lean index af058b47a8..11b02ed3c1 100644 --- a/LeanPool/ApollonianSuperharmonic/FordExceptionalMatrixLatticeIdentification.lean +++ b/LeanPool/ApollonianSuperharmonic/FordExceptionalMatrixLatticeIdentification.lean @@ -5,11 +5,15 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.CircleMatrix -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordExceptionalLattice public import LeanPool.ApollonianSuperharmonic.FordPeakMatrix public import LeanPool.ApollonianSuperharmonic.IntegralityLattice +public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate +public import Mathlib.Algebra.Order.Algebra +public import Mathlib.Analysis.Normed.Field.Basic +public import Mathlib.Data.EReal.Inv -- [TABLET NODE: FordExceptionalMatrixLatticeIdentification] @@ -54,8 +58,13 @@ theorem FordExceptionalMatrixLatticeIdentification (P : FordFareyParameter) ![((u.re : ℤ) : ℝ), ((u.im : ℤ) : ℝ)] i = (n : ℝ) at hu have hzero := hu 0 have hone := hu 1 - simp? [hmatrix, hC, FordCircleCoordinate, Matrix.mulVec, - ] at hzero hone + simp only [Matrix.mulVec, Fin.isValue, hmatrix, Nat.succ_eq_add_one, Nat.reduceAdd, hC, + FordCircleCoordinate, Nat.cast_mul, Int.reduceNeg, Int.cast_mul, Int.cast_natCast, + mul_inv_rev, Int.cast_one, Int.cast_ofNat, sub_self, Matrix.smul_cons, smul_eq_mul, + Matrix.smul_empty, mul_zero, Matrix.cons_val', Matrix.cons_val_fin_one, + Matrix.cons_val_zero, GaussianInt.intCast_re, GaussianInt.intCast_im, + Matrix.dotProduct_cons, Matrix.head_cons, Matrix.tail_cons, + Matrix.dotProduct_of_isEmpty, add_zero, Matrix.cons_val_one, zero_mul] at hzero hone rcases hzero with ⟨zeroValue, zeroEquation⟩ rcases hone with ⟨oneValue, oneEquation⟩ rw [GaussianInt.toComplex_def₂] at zeroEquation oneEquation diff --git a/LeanPool/ApollonianSuperharmonic/FordExceptionalMaximality.lean b/LeanPool/ApollonianSuperharmonic/FordExceptionalMaximality.lean index 4dce465f97..a1e4bf1bcf 100644 --- a/LeanPool/ApollonianSuperharmonic/FordExceptionalMaximality.lean +++ b/LeanPool/ApollonianSuperharmonic/FordExceptionalMaximality.lean @@ -5,31 +5,16 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FiniteAcyclicOrientationObstruction -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary public import LeanPool.ApollonianSuperharmonic.FordExceptionalLattice -public import LeanPool.ApollonianSuperharmonic.FordExceptionalMatrixLatticeIdentification -public import LeanPool.ApollonianSuperharmonic.FordBoundaryMultiplicity -public import LeanPool.ApollonianSuperharmonic.FordFareyParameter -public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordOdometerFamilyExistsUnique public import LeanPool.ApollonianSuperharmonic.FordPeakMatrix -public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains -public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv -public import LeanPool.ApollonianSuperharmonic.LatticeVertexBoundary -public import LeanPool.ApollonianSuperharmonic.P5442T1Cocycle public import LeanPool.ApollonianSuperharmonic.P5442T1LaplacianBound public import LeanPool.ApollonianSuperharmonic.FordTileAcyclicIndegree -public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction -public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport -public import LeanPool.ApollonianSuperharmonic.P4062T1OrientationTransport -public import Mathlib.Data.List.Chain -- [TABLET NODE: FordExceptionalMaximality] diff --git a/LeanPool/ApollonianSuperharmonic/FordFareyParameter.lean b/LeanPool/ApollonianSuperharmonic/FordFareyParameter.lean index e6432ae408..d5c3fd24f8 100644 --- a/LeanPool/ApollonianSuperharmonic/FordFareyParameter.lean +++ b/LeanPool/ApollonianSuperharmonic/FordFareyParameter.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Algebra.Order.Ring.Int + -- [TABLET NODE: FordFareyParameter] diff --git a/LeanPool/ApollonianSuperharmonic/FordFareyParentsExist.lean b/LeanPool/ApollonianSuperharmonic/FordFareyParentsExist.lean index 2913d68dfd..0c63d3eb75 100644 --- a/LeanPool/ApollonianSuperharmonic/FordFareyParentsExist.lean +++ b/LeanPool/ApollonianSuperharmonic/FordFareyParentsExist.lean @@ -5,7 +5,16 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.Nat.ModEq +public import Mathlib.Basic.ExistsUnique +public import Mathlib.Tactic.ByContra +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public meta import Lean.Meta.Tactic.NormCast -- [TABLET NODE: FordFareyParentsExist] diff --git a/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean index e2cfeeb977..6419afbd33 100644 --- a/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean +++ b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean @@ -5,18 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordOdometer public import LeanPool.ApollonianSuperharmonic.FordBoundaryMultiplicity -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv -public import LeanPool.ApollonianSuperharmonic.LatticeVertexBoundary public import Mathlib.RingTheory.Int.Basic -public import Mathlib.Algebra.BigOperators.Group.Finset.Piecewise -public import Mathlib.Algebra.BigOperators.Fin -public import Mathlib.Tactic.ClearExcept -- [TABLET NODE: FordLaplacianTable] diff --git a/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean index adbd006a86..2638048be4 100644 --- a/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean @@ -5,21 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordOdometerFamilyExistsUnique -public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple -public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: FordLeftBoundaryCompatibility] @@ -49,7 +41,8 @@ private theorem hcurv : have hc := (BandPackingSymmetryCovariance g0).1 (q 0) have he := congrFun heq0 0 have hecurv := congrArg Prod.fst he - simp? [BandPackingSymmetryQuadrupleAction] at hecurv + simp only [BandPackingSymmetryQuadrupleAction, Fin.isValue, Matrix.cons_val_zero, neg_zero, + ite_self, Fin.succ_zero_eq_one, Matrix.cons_val_one, Matrix.cons_val_succ] at hecurv rw [hc] at hecurv have hqp : (1 : ℝ) < P0.q := by exact_mod_cast hP0 simp [FordRecursiveQuadruple, FordCircleCoordinate] at hecurv @@ -331,9 +324,12 @@ private theorem hshift : rw [hcentT, hcentT'] at hc2 rw [(TileTranslationFormulas (FordTile P2.q) u).2.2.2.2.1, (TileTranslationFormulas (FordTile P2.q) u').2.2.2.2.1] at hc2 - simp? [hg2] at hc hc2 + simp only [Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, Prod.mk_sub_mk, + add_sub_add_left_eq_sub, bne_iff_ne, ne_eq, ite_not, hg2, Bool.false_eq_true, + ↓reduceIte, Fin.isValue, ite_smul, neg_smul, one_smul] at hc hc2 by_cases hs : ew = negative - · simp? [hs] at hc hc2 ⊢ + · simp only [hs, ↓reduceIte, Fin.isValue, Prod.fst_neg, Prod.snd_neg, bne_self_eq_false, + Bool.false_eq_true, Int.reduceNeg, neg_smul, one_smul] at hc hc2 ⊢ unfold GaussianRealPoint at hc hc2 simp only [GaussianInt.toComplex, Zsqrtd.lift_apply_apply, Complex.add_re, Complex.add_im, Complex.mul_re, Complex.mul_im, Complex.intCast_re, @@ -345,7 +341,8 @@ private theorem hshift : exact_mod_cast hc · dsimp at hc2 ⊢ exact_mod_cast hc2 - · simp? [hs] at hc hc2 ⊢ + · simp only [hs, ↓reduceIte, Fin.isValue, bne_iff_ne, ne_eq, not_false_eq_true, one_smul] + at hc hc2 ⊢ unfold GaussianRealPoint at hc hc2 simp only [GaussianInt.toComplex, Zsqrtd.lift_apply_apply, Complex.add_re, Complex.add_im, Complex.mul_re, Complex.mul_im, Complex.intCast_re, @@ -856,13 +853,16 @@ theorem FordLeftBoundaryCompatibility cases hkS : PartialOdometerSlope k with | none => simp [hkS] at hslopeH | some z => - simp? [hkS] at hslopeH hslopeH' + simp only [Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, hkS, + Option.map_some, Option.some.injEq] at hslopeH hslopeH' have hsreFord := hsre' have hsimFord := hsim' have heq2bar : BandPackingSymmetryQuadrupleAction g2 barq = FordRecursiveQuadruple P2 := by simpa [barq] using heq2 rw [heq2bar] at hsreFord hsimFord - simp? [hg2] at hsreFord hsimFord + simp only [bne_iff_ne, ne_eq, ite_not, Int.reduceNeg, hg2, Bool.false_eq_true, + ↓reduceIte, Fin.isValue, GaussianInt.intCast_re, ite_mul, neg_mul, one_mul, + GaussianInt.intCast_im] at hsreFord hsimFord simp only [GaussianInt.toComplex, Zsqrtd.lift_apply_apply, Complex.add_re, Complex.add_im, Complex.mul_re, Complex.mul_im, Complex.intCast_re, Complex.intCast_im, Complex.I_re, Complex.I_im, zero_mul, add_zero, diff --git a/LeanPool/ApollonianSuperharmonic/FordOdometer.lean b/LeanPool/ApollonianSuperharmonic/FordOdometer.lean index 6333dad3bd..ef0fe6ed49 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOdometer.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOdometer.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordOdometerFamilyExistsUnique -- [TABLET NODE: FordOdometer] diff --git a/LeanPool/ApollonianSuperharmonic/FordOdometerFamilyExistsUnique.lean b/LeanPool/ApollonianSuperharmonic/FordOdometerFamilyExistsUnique.lean index e8c15e1fbc..b9a0f2e432 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOdometerFamilyExistsUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOdometerFamilyExistsUnique.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5130T5DomainCover -public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic public import LeanPool.ApollonianSuperharmonic.P5130T5MixedOverlaps public import LeanPool.ApollonianSuperharmonic.P5130T5SameParentOverlaps public import LeanPool.ApollonianSuperharmonic.P5130T5BoundaryConsistency diff --git a/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean index cc0b8cd05a..88b7736c50 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4158T1MatchedFordPair public import LeanPool.ApollonianSuperharmonic.P4158T1LargeFirstRestrictions public import LeanPool.ApollonianSuperharmonic.P4158T1LargeSecondRestrictions @@ -12,14 +14,7 @@ public import LeanPool.ApollonianSuperharmonic.P4158T1AncestorCells public import LeanPool.ApollonianSuperharmonic.P4158T1SmallerStringEdges public import LeanPool.ApollonianSuperharmonic.P4158T1EdgeSectorSelection public import LeanPool.ApollonianSuperharmonic.P4158T1StringSlopeTelescoping -public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex -public import LeanPool.ApollonianSuperharmonic.BandGenealogy -public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryOdometerStrings -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: FordOpposingBoundaryStarLocalization] diff --git a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean index 76cb0ecd62..0c62be8e24 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean @@ -5,28 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.FordCellDomain -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.FordFareyParameter -public import LeanPool.ApollonianSuperharmonic.FordTile -public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleSwapLast -public import Mathlib.Data.List.Chain public import LeanPool.ApollonianSuperharmonic.P5269T1FordSquareNormalForm public import LeanPool.ApollonianSuperharmonic.P5269T1CenteredSquareTripleTransport @@ -1007,7 +990,8 @@ private theorem norm2 : classical intro P hq sq hs T hT obtain ⟨w, hw⟩ := P5269T1FordSquareNormalForm P hq 2 T hT - (by simp? [FordRecursiveQuadruple, FordCircleCoordinate]; positivity) + (by simp only [FordRecursiveQuadruple, FordCircleCoordinate, Nat.cast_mul, Int.reduceNeg, + Fin.isValue, Matrix.cons_val, mul_self_pos, ne_eq, Int.natCast_eq_zero]; positivity) exact ⟨w.re, w.im, hw⟩ private theorem indices : diff --git a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean index f5f2720929..9be276e6cc 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean @@ -5,17 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5269T1FordSquareNormalForm public import LeanPool.ApollonianSuperharmonic.P5269T1IncomingSquareJunctions public import LeanPool.ApollonianSuperharmonic.P5269T1CenteredSquareTripleTransport -public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid -public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleLatticeTouching -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.FordTileGeometry -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -- [TABLET NODE: FordOrientedChildParentIncomingEndpoint] diff --git a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentRightEndpoint.lean b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentRightEndpoint.lean index a4405f12ae..1087c1ce8e 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentRightEndpoint.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentRightEndpoint.lean @@ -5,14 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5269T1FordSquareNormalForm public import LeanPool.ApollonianSuperharmonic.P5327T1RightSquareJunctions public import LeanPool.ApollonianSuperharmonic.P5269T1CenteredSquareTripleTransport -public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid -public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -- [TABLET NODE: FordOrientedChildParentRightEndpoint] diff --git a/LeanPool/ApollonianSuperharmonic/FordPeakMatrix.lean b/LeanPool/ApollonianSuperharmonic/FordPeakMatrix.lean index 6a3b83b8c0..f295286bf4 100644 --- a/LeanPool/ApollonianSuperharmonic/FordPeakMatrix.lean +++ b/LeanPool/ApollonianSuperharmonic/FordPeakMatrix.lean @@ -5,7 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Basic.Real.Basic +public import Mathlib.Data.Fin.VecNotation + +public import Mathlib.LinearAlgebra.Matrix.Defs -- [TABLET NODE: FordPeakMatrix] diff --git a/LeanPool/ApollonianSuperharmonic/FordRecursiveQuadruple.lean b/LeanPool/ApollonianSuperharmonic/FordRecursiveQuadruple.lean index d8bb62a5b4..6c2982a89c 100644 --- a/LeanPool/ApollonianSuperharmonic/FordRecursiveQuadruple.lean +++ b/LeanPool/ApollonianSuperharmonic/FordRecursiveQuadruple.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate public import LeanPool.ApollonianSuperharmonic.FordFareyParameter diff --git a/LeanPool/ApollonianSuperharmonic/FordRecursiveVertexDomains.lean b/LeanPool/ApollonianSuperharmonic/FordRecursiveVertexDomains.lean index a6888defe7..09f38f60c6 100644 --- a/LeanPool/ApollonianSuperharmonic/FordRecursiveVertexDomains.lean +++ b/LeanPool/ApollonianSuperharmonic/FordRecursiveVertexDomains.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.FordFareyParameter -public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: FordRecursiveVertexDomains] diff --git a/LeanPool/ApollonianSuperharmonic/FordRegimeConverse.lean b/LeanPool/ApollonianSuperharmonic/FordRegimeConverse.lean index 1d03116e31..ddb666c1ac 100644 --- a/LeanPool/ApollonianSuperharmonic/FordRegimeConverse.lean +++ b/LeanPool/ApollonianSuperharmonic/FordRegimeConverse.lean @@ -5,13 +5,19 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification -public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate -public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import Mathlib.Init +public import Mathlib.Algebra.CharP.Defs +public import Mathlib.Data.Fin.VecNotation +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification +public meta import Lean.Meta.Tactic.NormCast +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: FordRegimeConverse] @@ -191,8 +197,15 @@ private theorem desiredAt325 : intro predecessor i predecessorLine g P hP successorAction determinantCoprime next0 actionPredecessor rw [successorAction predecessor, actionPredecessor] - simp? [next0, FordRecursiveQuadruple, FordCircleCoordinate] - split_ifs <;> simp_all? [P.sum_q, P.sum_p] <;> ring + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, FordRecursiveQuadruple, FordCircleCoordinate, + Nat.cast_mul, Int.reduceNeg, Fin.isValue, Matrix.cons_val_zero, Matrix.cons_val, + mul_zero, add_zero, Matrix.cons_val_one, mul_neg, mul_one, Nat.cast_add, + Matrix.vecCons_inj, Prod.mk.injEq, right_eq_ite_iff, mul_eq_zero, Int.natCast_eq_zero, + or_self, and_true, next0] + split_ifs <;> simp_all only [Fin.isValue, Nat.succ_eq_add_one, Nat.reduceAdd, P.sum_q, + Nat.cast_add, Int.reduceNeg, P.sum_p, Nat.add_eq_zero_iff, false_and, true_and, + IsEmpty.forall_iff, and_true, zero_add, sub_zero, add_zero, CharP.cast_eq_zero, + mul_zero] <;> ring repeat' first | constructor | (ext <;> simp; ring) all_goals try (intro hp; have := P.q₂_pos; omega) @@ -290,15 +303,26 @@ private theorem desiredAt381 : have successorY := successorAction y rw [actionY, actionPredecessor] at successorY convert successorY using 1 <;> - simp? [y, next2, FordRecursiveQuadruple, - FordCircleCoordinate, P.sum_q, P.sum_p] <;> + simp only [Fin.isValue, Matrix.cons_val_zero, Matrix.cons_val, Matrix.cons_val_one, y, + FordRecursiveQuadruple, FordCircleCoordinate, P.sum_q, Nat.cast_mul, Nat.cast_add, + Int.reduceNeg, P.sum_p, Nat.succ_eq_add_one, Nat.reduceAdd, mul_zero, add_zero, + mul_neg, mul_one, Matrix.vecCons_inj, Prod.mk.injEq, and_true, next2] <;> ring all_goals split_ifs <;> - simp_all? [] <;> + simp_all only [Fin.isValue, Nat.succ_eq_add_one, Nat.reduceAdd, Matrix.cons_val, + Matrix.cons_val_one, Matrix.cons_val_zero, CharP.cast_eq_zero, zero_mul, ne_eq, + OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, add_zero, zero_add, Int.reduceNeg, + one_mul, neg_add_cancel, true_and] <;> try constructor all_goals try ring all_goals ext <;> simp_all; ring +private theorem existsLineBeforeRotation (q : Fin 4 → CircleCoordinates) + (line : ∃ i : Fin 4, (![q 0, q 2, q 3, q 1] i).1 = 0) : + ∃ i : Fin 4, (q i).1 = 0 := by + obtain ⟨i, coordinate⟩ := line + fin_cases i <;> simp_all <;> aesop + end FordRegimeProof theorem FordRegimeConverse (q : Fin 4 → CircleCoordinates) @@ -320,9 +344,7 @@ theorem FordRegimeConverse (q : Fin 4 → CircleCoordinates) simp at bad | @rotate q hq ih => have predecessorProper : ProperBandQuadruple q := FordRegimeProof.predecessorProper q hq - obtain ⟨i, hi⟩ := hline - have predecessorLine : ∃ i : Fin 4, (q i).1 = 0 := by - fin_cases i <;> simp_all <;> aesop + have predecessorLine := FordRegimeProof.existsLineBeforeRotation q hline obtain ⟨r, g, P, hP, hg, hw, hz, heq⟩ := ih predecessorProper predecessorLine fin_cases r · refine ⟨2, g, P, hP, hg, hw, ?_, ?_⟩ @@ -352,9 +374,16 @@ theorem FordRegimeConverse (q : Fin 4 → CircleCoordinates) refine ⟨2, .shift (-z), standard, by norm_num, by rfl, ?_, ?_, ?_⟩ · exact ⟨-z, Or.inl rfl⟩ · simp [hz] - · simp? [standard, hz, FordRecursiveQuadruple, FordCircleCoordinate, - BandPackingSymmetryQuadrupleAction, BandPackingSymmetryCircleAction, - BandPackingSymmetryReversesOrientation] + · simp only [BandPackingSymmetryQuadrupleAction, BandPackingSymmetryCircleAction, hz, + Nat.succ_eq_add_one, Nat.reduceAdd, Int.reduceNeg, Fin.isValue, + Matrix.cons_val_zero, mul_one, Matrix.cons_val, mul_zero, add_zero, Int.reduceAdd, + Matrix.cons_val_one, sub_zero, mul_neg, Fin.reduceSucc, Fin.reduceAdd, + Fin.succ_zero_eq_one, Fin.succ_one_eq_two, Int.cast_ofNat, + BandPackingSymmetryReversesOrientation, Bool.false_eq_true, ↓reduceIte, + Int.cast_one, add_neg_cancel_right, Int.cast_zero, zero_mul, neg_zero, + FordRecursiveQuadruple, FordCircleCoordinate, Nat.reduceMul, Nat.cast_ofNat, + Int.reduceMul, one_ne_zero, Nat.cast_one, Matrix.vecCons_inj, Prod.mk.injEq, + true_and, and_true, standard] repeat' first | constructor | (ext <;> simp <;> ring) · rcases root with ⟨z, hz⟩ let standard : FordFareyParameter := @@ -368,9 +397,15 @@ theorem FordRegimeConverse (q : Fin 4 → CircleCoordinates) by norm_num, by rfl, ?_, ?_, ?_⟩ · exact ⟨z + 1 + ⟨0, 1⟩, Or.inr rfl⟩ · simp [hz] - · simp? [standard, hz, FordRecursiveQuadruple, FordCircleCoordinate, - BandPackingSymmetryQuadrupleAction, BandPackingSymmetryCircleAction, - BandPackingSymmetryReversesOrientation] + · simp only [BandPackingSymmetryQuadrupleAction, BandPackingSymmetryCircleAction, hz, + Nat.succ_eq_add_one, Nat.reduceAdd, Int.reduceNeg, Fin.isValue, + Matrix.cons_val_zero, mul_one, Matrix.cons_val, Int.reduceAdd, mul_zero, add_zero, + Matrix.cons_val_one, sub_zero, sub_neg_eq_add, Fin.succ_zero_eq_one, + Fin.succ_one_eq_two, Fin.reduceSucc, neg_add_rev, Int.cast_ofNat, + BandPackingSymmetryReversesOrientation, bne_self_eq_false, Bool.false_eq_true, + ↓reduceIte, Int.cast_one, FordRecursiveQuadruple, + FordCircleCoordinate, Nat.reduceMul, Nat.cast_ofNat, Int.reduceMul, one_ne_zero, + Nat.cast_one, Matrix.vecCons_inj, Prod.mk.injEq, true_and, and_true, standard] repeat' first | constructor | (ext <;> simp <;> ring) · obtain ⟨i, hi⟩ := hline have retainedLine : diff --git a/LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean b/LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean index 08e09f8b43..845da8e3bc 100644 --- a/LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1LiteralNormalization public import LeanPool.ApollonianSuperharmonic.P5332T1VectorPlacements public import LeanPool.ApollonianSuperharmonic.P5332T1RightFirstValues diff --git a/LeanPool/ApollonianSuperharmonic/FordTile.lean b/LeanPool/ApollonianSuperharmonic/FordTile.lean index 3d5c7776de..5afcba7fee 100644 --- a/LeanPool/ApollonianSuperharmonic/FordTile.lean +++ b/LeanPool/ApollonianSuperharmonic/FordTile.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordCellDomain public import LeanPool.ApollonianSuperharmonic.ProtoTile diff --git a/LeanPool/ApollonianSuperharmonic/FordTileAcyclicIndegree.lean b/LeanPool/ApollonianSuperharmonic/FordTileAcyclicIndegree.lean index 9737c796b1..cc8179a040 100644 --- a/LeanPool/ApollonianSuperharmonic/FordTileAcyclicIndegree.lean +++ b/LeanPool/ApollonianSuperharmonic/FordTileAcyclicIndegree.lean @@ -5,15 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4062T1LiteralReduction public import LeanPool.ApollonianSuperharmonic.P4062T1OrientationTransport public import LeanPool.ApollonianSuperharmonic.P4062T1ParentalRestriction public import LeanPool.ApollonianSuperharmonic.P4062T1OverlapDescent -public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorGeometry public import LeanPool.ApollonianSuperharmonic.P4062T1ParentGluing public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderGeometry public import LeanPool.ApollonianSuperharmonic.P4062T1RankedAttachment -public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable -- [TABLET NODE: FordTileAcyclicIndegree] @@ -68,7 +68,7 @@ theorem FordTileAcyclicIndegree (P : FordFareyParameter) subst D exact ⟨{ edge := fun _ _ => False - edge_decidable := fun _ _ => Classical.propDecidable _ + edgeDecidable := fun _ _ => Classical.propDecidable _ rank := fun _ => 0 supported := by intro x y he; cases he oriented := by intro x hx; simp at hx @@ -142,7 +142,7 @@ theorem FordTileAcyclicIndegree (P : FordFareyParameter) have hsigma : σ x₀ = 0 := by simp [σ, hlap] let o₀ : AcyclicIndegreeOrientation {x₀} σ := { edge := fun _ _ => False - edge_decidable := fun _ _ => Classical.propDecidable _ + edgeDecidable := fun _ _ => Classical.propDecidable _ rank := fun _ => 0 supported := by intro x y he; cases he oriented := by diff --git a/LeanPool/ApollonianSuperharmonic/FordTileGeometry.lean b/LeanPool/ApollonianSuperharmonic/FordTileGeometry.lean index 1d068b1f03..df2e3b33a8 100644 --- a/LeanPool/ApollonianSuperharmonic/FordTileGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/FordTileGeometry.lean @@ -5,10 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.FordTile public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.TileArea +public meta import Lean.Meta.Tactic.NormCast +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: FordTileGeometry] @@ -28,7 +32,12 @@ private theorem squareRealization (q : ℕ) (hq : 0 < q) : TileRealization (Ford ext p constructor · intro hp - simp? [TileRealization, FordTile, FordCellDomain, ClosedSquareRealization] at hp + simp only [TileRealization, FordTile, FordCellDomain, Int.reduceNeg, + Finset.product_eq_sprod, Finset.mem_image, Finset.mem_product, Finset.mem_range, + Prod.exists, ClosedSquareRealization, GaussianInt.intCast_re, GaussianInt.intCast_im, + Set.iUnion_exists, Set.mem_iUnion, Set.mem_Icc, exists_and_left, exists_prop, + exists_and_right, ↓existsAndEq, GaussianInt.re_toComplex, Int.cast_natCast, + GaussianInt.im_toComplex, and_true] at hp rcases hp with ⟨x, y, hxy, hlt, hup⟩ rcases hxy with ⟨hxl, hyl⟩ rcases hup with ⟨hxu, hyu⟩ @@ -120,7 +129,8 @@ theorem FordTileGeometry (q : Nat) (hq : 0 < q) : ⟨((q : Real) * (p.1.1 / 2 + 1 / 2), (q : Real) * (p.1.2 / 2 + 1 / 2)), by have hp := Metric.mem_closedBall.mp p.2 - simp? [Prod.dist_eq, Real.dist_eq] at hp + simp only [Prod.dist_eq, Prod.fst_zero, Real.dist_eq, sub_zero, Prod.snd_zero, + sup_le_iff] at hp rcases abs_le.mp hp.1 with ⟨hx1, hx2⟩ rcases abs_le.mp hp.2 with ⟨hy1, hy2⟩ have hqreal : (0 : Real) < q := by exact_mod_cast hq @@ -133,7 +143,8 @@ theorem FordTileGeometry (q : Nat) (hq : 0 < q) : let backward : Set.Icc (0, 0) ((q : Real), (q : Real)) → (Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) := fun p => ⟨(2 * (p.1.1 / q - 1 / 2), 2 * (p.1.2 / q - 1 / 2)), by - simp? [Metric.mem_closedBall, Prod.dist_eq, Real.dist_eq] + simp only [one_div, Metric.mem_closedBall, Prod.dist_eq, Prod.fst_zero, Real.dist_eq, + sub_zero, abs_mul, Nat.abs_ofNat, Prod.snd_zero, sup_le_iff] have hqreal : (0 : Real) < q := by exact_mod_cast hq rcases p.2 with ⟨⟨hx1, hy1⟩, ⟨hx2, hy2⟩⟩ have hx : -(1 / 2 : Real) ≤ (p.1.1 / q - 1 / 2) ∧ @@ -200,7 +211,7 @@ theorem FordTileGeometry (q : Nat) (hq : 0 < q) : refine ⟨2 * e / q, by positivity, ?_⟩ intro a hab change dist (a : Real × Real) (b : Real × Real) < 2 * e / q at hab - simp? [Prod.dist_eq, Real.dist_eq] at hab ⊢ + simp only [Prod.dist_eq, Real.dist_eq, max_lt_iff, one_div] at hab ⊢ constructor · rw [show (q : Real) * (((a : Real × Real).1) / 2 + 2⁻¹) - (q : Real) * (((b : Real × Real).1) / 2 + 2⁻¹) = @@ -238,7 +249,7 @@ theorem FordTileGeometry (q : Nat) (hq : 0 < q) : refine ⟨e * q / 2, by positivity, ?_⟩ intro a hab change dist (a : Real × Real) (b : Real × Real) < e * q / 2 at hab - simp? [Prod.dist_eq, Real.dist_eq] at hab ⊢ + simp only [Prod.dist_eq, Real.dist_eq, max_lt_iff, one_div] at hab ⊢ constructor · rw [show 2 * (((a : Real × Real).1) / q - 2⁻¹) - 2 * (((b : Real × Real).1) / q - 2⁻¹) = diff --git a/LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean b/LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean index b32786b639..f7db63fae8 100644 --- a/LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean @@ -5,34 +5,17 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordOdometerFamilyExistsUnique public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -public import LeanPool.ApollonianSuperharmonic.FordFareyParameter -public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist -public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains public import LeanPool.ApollonianSuperharmonic.FordTile public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain -public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer -public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv -public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.OdometerTranslation -public import LeanPool.ApollonianSuperharmonic.PartialOdometer -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope -public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.TileOdometer public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation public import LeanPool.ApollonianSuperharmonic.P4217T2SquareGeometry public import LeanPool.ApollonianSuperharmonic.P4217T2RectangularBoundarySlope -public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport -- [TABLET NODE: FordTileOdometerRestriction] @@ -249,7 +232,7 @@ private theorem red : rw [hd] at gd have he := Int.eq_one_of_dvd_one (by omega : 0 ≤ (g : Int)) gd have : g = 1 := by exact_mod_cast he - simp? [g] at this ⊢ + simp only [Nat.dvd_one, g] at this ⊢ exact this private theorem kcert : @@ -408,7 +391,10 @@ private theorem dom : have hx := (kd i s x).mp hx have hs := R.sum_q fin_cases i <;> cases s <;> - simp? [FordRecursiveVertexDomains, FordVertexDomain] at hx ⊢ <;> + simp only [Fin.mk_one, Fin.isValue, one_ne_zero, ↓reduceIte, FordRecursiveVertexDomains, + Int.reduceNeg, Bool.false_eq_true, Matrix.cons_val, Set.mem_ofPred_eq, + FordVertexDomain, Fin.reduceFinMk, Fin.reduceEq, Fin.zero_eta, Matrix.cons_val_one, + Matrix.cons_val_zero] at hx ⊢ <;> (try subst x) <;> dsimp at * <;> omega private theorem values : diff --git a/LeanPool/ApollonianSuperharmonic/FordTileRecursiveIdentification.lean b/LeanPool/ApollonianSuperharmonic/FordTileRecursiveIdentification.lean index 8a54d50a85..22228c682d 100644 --- a/LeanPool/ApollonianSuperharmonic/FordTileRecursiveIdentification.lean +++ b/LeanPool/ApollonianSuperharmonic/FordTileRecursiveIdentification.lean @@ -5,21 +5,15 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.FordCellDomain -public import LeanPool.ApollonianSuperharmonic.FordFareyParameter public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple public import LeanPool.ApollonianSuperharmonic.FordTile -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.TileCentroid public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport @@ -37,6 +31,24 @@ Changes: pool module paths, public exports, project namespace and current Mathli namespace ApollonianSuperharmonic +private theorem fordDeterminantCoprime : ∀ (a : Int) (b d : Nat) (c : Int), + a * (d : Int) - (b : Int) * c = 1 → Nat.Coprime b a.natAbs := by + intro a b d c hd + rw [Nat.coprime_iff_gcd_eq_one] + apply Nat.dvd_one.mp + let g := Nat.gcd b a.natAbs + have gb : g ∣ b := Nat.gcd_dvd_left _ _ + have ga : g ∣ a.natAbs := Nat.gcd_dvd_right _ _ + have gb' : (g : Int) ∣ (b : Int) := by exact_mod_cast gb + have ga' : (g : Int) ∣ a := (Int.dvd_natAbs).mp (by exact_mod_cast ga) + have gd : (g : Int) ∣ a * (d : Int) - (b : Int) * c := + dvd_sub (dvd_mul_of_dvd_left ga' _) (dvd_mul_of_dvd_left gb' _) + have gd1 : (g : Int) ∣ 1 := by simpa [hd] using gd + have ge : (g : Int) = 1 := + Int.eq_one_of_dvd_one (by exact_mod_cast (Nat.zero_le g)) gd1 + have gn : g = 1 := by exact_mod_cast ge + simp [g, gn] + theorem FordTileRecursiveIdentification (P : FordFareyParameter) : BandPrototile (FordCircleCoordinate P.p P.q) (FordTile P.q) ∧ (P.q = 1 → FordTile P.q = ⟨{0}, 0⟩) ∧ @@ -71,7 +83,8 @@ theorem FordTileRecursiveIdentification (P : FordFareyParameter) : refine ⟨?_, fun _ => htile, ?_⟩ · rw [htile] convert BandPrototile.unit ⟨0, P.p⟩ 0 0 using 1; - simp? [FordCircleCoordinate, hu] + simp only [FordCircleCoordinate, hu, mul_one, Nat.cast_one, Int.reduceNeg, + Prod.mk.injEq, true_and] ext <;> simp · intro hgt omega @@ -91,23 +104,7 @@ theorem FordTileRecursiveIdentification (P : FordFareyParameter) : simpa [P.sum_q, P.sum_p] using P.det₁ norm_num [Nat.cast_add] at h1 nlinarith [h1] - have determinantCoprime : ∀ (a : Int) (b d : Nat) (c : Int), - a * (d : Int) - (b : Int) * c = 1 → Nat.Coprime b a.natAbs := by - intro a b d c hd - rw [Nat.coprime_iff_gcd_eq_one] - apply Nat.dvd_one.mp - let g := Nat.gcd b a.natAbs - have gb : g ∣ b := Nat.gcd_dvd_left _ _ - have ga : g ∣ a.natAbs := Nat.gcd_dvd_right _ _ - have gb' : (g : Int) ∣ (b : Int) := by exact_mod_cast gb - have ga' : (g : Int) ∣ a := (Int.dvd_natAbs).mp (by exact_mod_cast ga) - have gd : (g : Int) ∣ a * (d : Int) - (b : Int) * c := - dvd_sub (dvd_mul_of_dvd_left ga' _) (dvd_mul_of_dvd_left gb' _) - have gd1 : (g : Int) ∣ 1 := by simpa [hd] using gd - have ge : (g : Int) = 1 := - Int.eq_one_of_dvd_one (by exact_mod_cast (Nat.zero_le g)) gd1 - have gn : g = 1 := by exact_mod_cast ge - simp [g, gn] + have determinantCoprime := fordDeterminantCoprime have red1 := determinantCoprime P.p₁ P.q₁ P.q₂ P.p₂ cross have red2 : Nat.Coprime P.q₂ P.p₂.natAbs := by have h := determinantCoprime (-P.p₂) P.q₂ P.q₁ (-P.p₁) (by nlinarith [cross]) @@ -242,8 +239,14 @@ theorem FordTileRecursiveIdentification (P : FordFareyParameter) : have cempty (a : GaussianInt) : TileCentroid (⟨∅, a⟩ : ProtoTile) = ((a.re : Real), (a.im : Real)) := by simp [TileCentroid] fin_cases i <;> cases s <;> - simp? [S, h32, h13, h21, ctrans, cr, c1, c2, cempty, - GaussianRealPoint, Prod.ext_iff] <;> + simp only [Int.reduceNeg, Fin.mk_one, Fin.isValue, Matrix.cons_val', + Bool.false_eq_true, ↓reduceIte, Matrix.cons_val_fin_one, Matrix.cons_val_one, + Matrix.cons_val_zero, ctrans, c2, Int.cast_zero, add_zero, Int.cast_natCast, cr, + Prod.mk_sub_mk, one_div, GaussianRealPoint, Fin.reduceAdd, Fin.succ_zero_eq_one, + Fin.reduceSucc, h13, neg_zero, sub_zero, zero_sub, Prod.smul_mk, smul_eq_mul, + mul_neg, neg_smul, one_smul, Prod.neg_mk, neg_neg, Prod.ext_iff, S, + Fin.reduceFinMk, Matrix.cons_val, cempty, Fin.succ_one_eq_two, h21, Int.cast_neg, + sub_neg_eq_add, neg_inj, Fin.zero_eta, c1, zero_add, h32, and_self] <;> (try constructor) <;> linarith only [cs] refine ⟨?_, ?_, ?_⟩ · exact BandPrototile.decompose hq hS hcells hfoot hcentroid diff --git a/LeanPool/ApollonianSuperharmonic/FordVertexDomain.lean b/LeanPool/ApollonianSuperharmonic/FordVertexDomain.lean index 772a481ecd..db29ac0676 100644 --- a/LeanPool/ApollonianSuperharmonic/FordVertexDomain.lean +++ b/LeanPool/ApollonianSuperharmonic/FordVertexDomain.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: FordVertexDomain] diff --git a/LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean b/LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean index 4ca3b9436c..ebf991967c 100644 --- a/LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean +++ b/LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean @@ -5,18 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy -public import LeanPool.ApollonianSuperharmonic.BandTangency public import LeanPool.ApollonianSuperharmonic.BoundaryString -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.RegularTileFamily public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition public import LeanPool.ApollonianSuperharmonic.TileStringExists public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -- [TABLET NODE: ForwardBoundaryStringData] diff --git a/LeanPool/ApollonianSuperharmonic/FourNeighborAdjacent.lean b/LeanPool/ApollonianSuperharmonic/FourNeighborAdjacent.lean index 842be4409a..a72e0fd472 100644 --- a/LeanPool/ApollonianSuperharmonic/FourNeighborAdjacent.lean +++ b/LeanPool/ApollonianSuperharmonic/FourNeighborAdjacent.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeCell -- [TABLET NODE: FourNeighborAdjacent] diff --git a/LeanPool/ApollonianSuperharmonic/FourNeighborConnected.lean b/LeanPool/ApollonianSuperharmonic/FourNeighborConnected.lean index cf820a495d..0dad56d231 100644 --- a/LeanPool/ApollonianSuperharmonic/FourNeighborConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/FourNeighborConnected.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent -- [TABLET NODE: FourNeighborConnected] diff --git a/LeanPool/ApollonianSuperharmonic/FourNeighborLaplacian.lean b/LeanPool/ApollonianSuperharmonic/FourNeighborLaplacian.lean index c736addaca..3cc90b1ce3 100644 --- a/LeanPool/ApollonianSuperharmonic/FourNeighborLaplacian.lean +++ b/LeanPool/ApollonianSuperharmonic/FourNeighborLaplacian.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction -- [TABLET NODE: FourNeighborLaplacian] diff --git a/LeanPool/ApollonianSuperharmonic/GaussianQuarterTurn.lean b/LeanPool/ApollonianSuperharmonic/GaussianQuarterTurn.lean index 62c29a7120..ec9705e8b4 100644 --- a/LeanPool/ApollonianSuperharmonic/GaussianQuarterTurn.lean +++ b/LeanPool/ApollonianSuperharmonic/GaussianQuarterTurn.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: GaussianQuarterTurn] diff --git a/LeanPool/ApollonianSuperharmonic/GaussianRealPoint.lean b/LeanPool/ApollonianSuperharmonic/GaussianRealPoint.lean index 80bae2a064..ef17c2d7a0 100644 --- a/LeanPool/ApollonianSuperharmonic/GaussianRealPoint.lean +++ b/LeanPool/ApollonianSuperharmonic/GaussianRealPoint.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: GaussianRealPoint] diff --git a/LeanPool/ApollonianSuperharmonic/GaussianReflection.lean b/LeanPool/ApollonianSuperharmonic/GaussianReflection.lean index 64ce8d0fc8..ed2fc04fa1 100644 --- a/LeanPool/ApollonianSuperharmonic/GaussianReflection.lean +++ b/LeanPool/ApollonianSuperharmonic/GaussianReflection.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: GaussianReflection] diff --git a/LeanPool/ApollonianSuperharmonic/GaussianTranslation.lean b/LeanPool/ApollonianSuperharmonic/GaussianTranslation.lean index 99d7eae345..243a683802 100644 --- a/LeanPool/ApollonianSuperharmonic/GaussianTranslation.lean +++ b/LeanPool/ApollonianSuperharmonic/GaussianTranslation.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: GaussianTranslation] diff --git a/LeanPool/ApollonianSuperharmonic/GlobalOdometerExtends.lean b/LeanPool/ApollonianSuperharmonic/GlobalOdometerExtends.lean index 9ec1092cef..ff565344b0 100644 --- a/LeanPool/ApollonianSuperharmonic/GlobalOdometerExtends.lean +++ b/LeanPool/ApollonianSuperharmonic/GlobalOdometerExtends.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PartialOdometer -- [TABLET NODE: GlobalOdometerExtends] diff --git a/LeanPool/ApollonianSuperharmonic/GridCellCenter.lean b/LeanPool/ApollonianSuperharmonic/GridCellCenter.lean index 4037cedb72..fe0bb47f11 100644 --- a/LeanPool/ApollonianSuperharmonic/GridCellCenter.lean +++ b/LeanPool/ApollonianSuperharmonic/GridCellCenter.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeCell -- [TABLET NODE: GridCellCenter] diff --git a/LeanPool/ApollonianSuperharmonic/GridEdgeCarrier.lean b/LeanPool/ApollonianSuperharmonic/GridEdgeCarrier.lean index f7c49952ad..67611a9c67 100644 --- a/LeanPool/ApollonianSuperharmonic/GridEdgeCarrier.lean +++ b/LeanPool/ApollonianSuperharmonic/GridEdgeCarrier.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -- [TABLET NODE: GridEdgeCarrier] diff --git a/LeanPool/ApollonianSuperharmonic/GridHorizontalLogLiftDelta.lean b/LeanPool/ApollonianSuperharmonic/GridHorizontalLogLiftDelta.lean index ec25d9153e..9e0fbd4bf6 100644 --- a/LeanPool/ApollonianSuperharmonic/GridHorizontalLogLiftDelta.lean +++ b/LeanPool/ApollonianSuperharmonic/GridHorizontalLogLiftDelta.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GridCellCenter public import LeanPool.ApollonianSuperharmonic.GridSegmentLogLiftDelta diff --git a/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndex.lean b/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndex.lean index 3f825654f5..0df079005d 100644 --- a/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndex.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import Mathlib.Init + +public import LeanPool.ApollonianSuperharmonic.LatticeCell -- [TABLET NODE: GridRayCrossingIndex] diff --git a/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexAdjacentCell.lean b/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexAdjacentCell.lean index 92bf64ca6c..9273f4c430 100644 --- a/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexAdjacentCell.lean +++ b/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexAdjacentCell.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndex @@ -212,11 +215,17 @@ private theorem northDeltaWest (q a : GaussianInt) : private theorem northDeltaNorth (q a : GaussianInt) : NorthStepDelta q a (a + ⟨0, 1⟩) := by - simp [NorthStepDelta, gaussian_eq_iff]; omega + by_cases horizontal : a.re ≤ q.re <;> + by_cases same : a.im = q.im <;> + by_cases above : a.im = q.im + 1 <;> + simp [NorthStepDelta, gaussian_eq_iff, horizontal, same, above] <;> omega private theorem northDeltaSouth (q a : GaussianInt) : NorthStepDelta q a (a - ⟨0, 1⟩) := by - simp [NorthStepDelta, gaussian_eq_iff]; omega + by_cases horizontal : a.re ≤ q.re <;> + by_cases same : a.im = q.im <;> + by_cases above : a.im = q.im + 1 <;> + simp [NorthStepDelta, gaussian_eq_iff, horizontal, same, above] <;> omega private theorem north_step_delta (q a b : GaussianInt) (hab : FourNeighborAdjacent a b) : (if b = a + ⟨0, 1⟩ ∧ a.im = (q + ⟨0, 1⟩).im ∧ diff --git a/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexZeroOfEdgeLifts.lean b/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexZeroOfEdgeLifts.lean index 30778fab9b..dd9ef68c01 100644 --- a/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexZeroOfEdgeLifts.lean +++ b/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexZeroOfEdgeLifts.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndex public import LeanPool.ApollonianSuperharmonic.GridStepLogLiftDelta diff --git a/LeanPool/ApollonianSuperharmonic/GridSegmentLogLiftDelta.lean b/LeanPool/ApollonianSuperharmonic/GridSegmentLogLiftDelta.lean index f2ccbe5bb5..5aaaa17114 100644 --- a/LeanPool/ApollonianSuperharmonic/GridSegmentLogLiftDelta.lean +++ b/LeanPool/ApollonianSuperharmonic/GridSegmentLogLiftDelta.lean @@ -5,12 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + public import Mathlib.Analysis.Complex.CoveringMap -public import Mathlib.Analysis.SpecialFunctions.Complex.Arg public import Mathlib.Analysis.Convex.Contractible -public import Mathlib.Topology.Algebra.Order.Support -public import Mathlib.Topology.Algebra.Module.LocallyConvex public import Mathlib.Topology.Homotopy.Lifting /-! diff --git a/LeanPool/ApollonianSuperharmonic/GridStepLogLiftDelta.lean b/LeanPool/ApollonianSuperharmonic/GridStepLogLiftDelta.lean index 0f91408b19..f083f7963b 100644 --- a/LeanPool/ApollonianSuperharmonic/GridStepLogLiftDelta.lean +++ b/LeanPool/ApollonianSuperharmonic/GridStepLogLiftDelta.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.GridHorizontalLogLiftDelta public import LeanPool.ApollonianSuperharmonic.GridVerticalDownLogLiftDelta @@ -81,7 +83,8 @@ theorem GridStepLogLiftDelta (q a b : GaussianInt) rw [ite_eq_right (by intro hc; exact hneU hc.1)] simp only [true_and] by_cases hc : a.im - 1 = q.im ∧ a.re ≤ q.re - · simp? [hc] at h ⊢ + · simp only [Icc.mk_one, Icc.mk_zero, Int.reduceNeg, map_sub, Zsqrtd.im_sub, hc, and_self, + ↓reduceIte, Int.cast_neg, Int.cast_one, mul_neg, mul_one, sub_neg_eq_add] at h ⊢ convert h using 1 · simpa [hc] using h diff --git a/LeanPool/ApollonianSuperharmonic/GridVerticalDownLogLiftDelta.lean b/LeanPool/ApollonianSuperharmonic/GridVerticalDownLogLiftDelta.lean index 44d11a94f7..17af92ae6a 100644 --- a/LeanPool/ApollonianSuperharmonic/GridVerticalDownLogLiftDelta.lean +++ b/LeanPool/ApollonianSuperharmonic/GridVerticalDownLogLiftDelta.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GridCellCenter public import LeanPool.ApollonianSuperharmonic.GridSegmentLogLiftDelta -public import Mathlib.Analysis.SpecialFunctions.Complex.Arg /-! # GridVerticalDownLogLiftDelta @@ -105,7 +105,14 @@ theorem GridVerticalDownLogLiftDelta (q a : GaussianInt) rw [← sq_eq_sq₀ (norm_nonneg _) (norm_nonneg _), Complex.sq_norm, Complex.sq_norm] dsimp [z0, z1, GridCellCenter] - simp? [Complex.normSq_apply] + simp only [Int.reduceNeg, map_sub, one_div, Complex.ofReal_inv, Complex.ofReal_ofNat, + Complex.normSq_apply, Complex.sub_re, GaussianInt.re_toComplex, Int.cast_zero, + sub_zero, Complex.add_re, Complex.intCast_re, GaussianInt.intCast_re, + Complex.inv_re, Complex.re_ofNat, div_self_mul_self', + Complex.mul_re, GaussianInt.intCast_im, Complex.I_re, mul_zero, Complex.add_im, + Complex.intCast_im, Complex.inv_im, Complex.im_ofNat, neg_zero, zero_div, add_zero, + Complex.I_im, mul_one, sub_self, Complex.sub_im, GaussianInt.im_toComplex, + Int.cast_one, Complex.mul_im, zero_add, add_right_inj] rw [← hiC] ring rw [show M ⟨1, by norm_num⟩ - M ⟨0, by norm_num⟩ = diff --git a/LeanPool/ApollonianSuperharmonic/GridVerticalUpLogLiftDelta.lean b/LeanPool/ApollonianSuperharmonic/GridVerticalUpLogLiftDelta.lean index 9eea584be8..ed02f68768 100644 --- a/LeanPool/ApollonianSuperharmonic/GridVerticalUpLogLiftDelta.lean +++ b/LeanPool/ApollonianSuperharmonic/GridVerticalUpLogLiftDelta.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GridCellCenter public import LeanPool.ApollonianSuperharmonic.GridSegmentLogLiftDelta -public import Mathlib.Analysis.SpecialFunctions.Complex.Arg /-! # GridVerticalUpLogLiftDelta @@ -114,7 +114,14 @@ theorem GridVerticalUpLogLiftDelta (q a : GaussianInt) rw [← sq_eq_sq₀ (norm_nonneg _) (norm_nonneg _)] rw [Complex.sq_norm, Complex.sq_norm] dsimp [z0, z1, GridCellCenter] - simp? [Complex.normSq_apply] + simp only [Int.reduceNeg, map_add, one_div, Complex.ofReal_inv, Complex.ofReal_ofNat, + Complex.normSq_apply, Complex.sub_re, Complex.add_re, GaussianInt.re_toComplex, + Int.cast_zero, add_zero, Complex.intCast_re, GaussianInt.intCast_re, Complex.inv_re, + Complex.re_ofNat, div_self_mul_self', Complex.mul_re, + GaussianInt.intCast_im, Complex.I_re, mul_zero, Complex.add_im, Complex.intCast_im, + Complex.inv_im, Complex.im_ofNat, neg_zero, zero_div, Complex.I_im, mul_one, + sub_self, Complex.sub_im, GaussianInt.im_toComplex, Int.cast_one, Complex.mul_im, + zero_add, add_right_inj] have hi : ((a.im : Int) : Real) = (q.im : Int) := by exact_mod_cast hcross.1 have hiC : (a : ℂ).im = (q : ℂ).im := by simpa using hi diff --git a/LeanPool/ApollonianSuperharmonic/IncomingSuperbasisRelation.lean b/LeanPool/ApollonianSuperharmonic/IncomingSuperbasisRelation.lean index 7a93975b8d..b57e3a07bd 100644 --- a/LeanPool/ApollonianSuperharmonic/IncomingSuperbasisRelation.lean +++ b/LeanPool/ApollonianSuperharmonic/IncomingSuperbasisRelation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: IncomingSuperbasisRelation] @@ -45,8 +47,10 @@ theorem IncomingSuperbasisRelation (q : Fin 4 → CircleCoordinates) rcases firstLaw with ⟨sumFirst, sumSecond, incomingFirst, incomingSecond, _⟩ rcases secondLaw with ⟨_, _, rotatedFirst, rotatedSecond, _⟩ rcases thirdLaw with ⟨_, _, rotatedAgainFirst, rotatedAgainSecond, _⟩ - simp? at rotatedFirst rotatedSecond rotatedAgainFirst rotatedAgainSecond - simp? [Fin.sum_univ_succ] + simp only [Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, Int.reduceNeg, + Matrix.cons_val] at rotatedFirst rotatedSecond rotatedAgainFirst rotatedAgainSecond + simp only [Fin.isValue, Fin.sum_univ_succ, Fin.succ_zero_eq_one, Fin.succ_one_eq_two, + Finset.univ_unique, Fin.default_eq_zero, Finset.sum_singleton, Fin.reduceSucc] constructor · rw [incomingFirst, rotatedFirst, rotatedAgainFirst] calc diff --git a/LeanPool/ApollonianSuperharmonic/IntegerCeilDiv.lean b/LeanPool/ApollonianSuperharmonic/IntegerCeilDiv.lean index 5ce9f455b3..21daf35b91 100644 --- a/LeanPool/ApollonianSuperharmonic/IntegerCeilDiv.lean +++ b/LeanPool/ApollonianSuperharmonic/IntegerCeilDiv.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Algebra.Order.Ring.Int + -- [TABLET NODE: IntegerCeilDiv] diff --git a/LeanPool/ApollonianSuperharmonic/IntegerLaplacianCastBridge.lean b/LeanPool/ApollonianSuperharmonic/IntegerLaplacianCastBridge.lean index 972edb87a4..eb0cc18bdc 100644 --- a/LeanPool/ApollonianSuperharmonic/IntegerLaplacianCastBridge.lean +++ b/LeanPool/ApollonianSuperharmonic/IntegerLaplacianCastBridge.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import LeanPool.ApollonianSuperharmonic.RealFourNeighborLaplacian diff --git a/LeanPool/ApollonianSuperharmonic/IntegerLatticeFunction.lean b/LeanPool/ApollonianSuperharmonic/IntegerLatticeFunction.lean index 4b58149944..91c6bcb857 100644 --- a/LeanPool/ApollonianSuperharmonic/IntegerLatticeFunction.lean +++ b/LeanPool/ApollonianSuperharmonic/IntegerLatticeFunction.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: IntegerLatticeFunction] diff --git a/LeanPool/ApollonianSuperharmonic/IntegerPreservingNormalization.lean b/LeanPool/ApollonianSuperharmonic/IntegerPreservingNormalization.lean index f0eec727c9..f93a3ae67c 100644 --- a/LeanPool/ApollonianSuperharmonic/IntegerPreservingNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/IntegerPreservingNormalization.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicRepresentative -public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm -public import LeanPool.ApollonianSuperharmonic.QuadraticGrowthAtInfinity +public import Mathlib.LinearAlgebra.Matrix.Notation -- [TABLET NODE: IntegerPreservingNormalization] diff --git a/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicCharacterization.lean b/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicCharacterization.lean index 0ec80dbd74..3f788d9f25 100644 --- a/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicCharacterization.lean +++ b/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicCharacterization.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOdometerTheorem public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicClosedness public import LeanPool.ApollonianSuperharmonic.PositiveDefiniteRepresentativeGap diff --git a/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicClosedness.lean b/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicClosedness.lean index c7962f52ba..b85eb4fbd1 100644 --- a/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicClosedness.lean +++ b/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicClosedness.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import Mathlib.Topology.Instances.Matrix +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import LeanPool.ApollonianSuperharmonic.IntegerPreservingNormalization public import LeanPool.ApollonianSuperharmonic.PointwiseDiagonalCompactness public import LeanPool.ApollonianSuperharmonic.TranslatedMinimumEnvelope diff --git a/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicRepresentative.lean b/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicRepresentative.lean index de41aaaa14..78cfff66a9 100644 --- a/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicRepresentative.lean +++ b/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicRepresentative.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import Mathlib.LinearAlgebra.Matrix.Symmetric public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import LeanPool.ApollonianSuperharmonic.QuadraticGrowthAtInfinity diff --git a/LeanPool/ApollonianSuperharmonic/IntegralityLattice.lean b/LeanPool/ApollonianSuperharmonic/IntegralityLattice.lean index fc28862268..b49ce52186 100644 --- a/LeanPool/ApollonianSuperharmonic/IntegralityLattice.lean +++ b/LeanPool/ApollonianSuperharmonic/IntegralityLattice.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import Mathlib.LinearAlgebra.Matrix.Notation -- [TABLET NODE: IntegralityLattice] diff --git a/LeanPool/ApollonianSuperharmonic/IntegralityLatticeIndex.lean b/LeanPool/ApollonianSuperharmonic/IntegralityLatticeIndex.lean index 696d5914f1..ebc0768914 100644 --- a/LeanPool/ApollonianSuperharmonic/IntegralityLatticeIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/IntegralityLatticeIndex.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex public import LeanPool.ApollonianSuperharmonic.TilingLatticeInclusion -public import LeanPool.ApollonianSuperharmonic.CircleMatrix -public import LeanPool.ApollonianSuperharmonic.Preamble -- [TABLET NODE: IntegralityLatticeIndex] diff --git a/LeanPool/ApollonianSuperharmonic/IntegralityTiling.lean b/LeanPool/ApollonianSuperharmonic/IntegralityTiling.lean index 879f22d28e..c1f7d94ef1 100644 --- a/LeanPool/ApollonianSuperharmonic/IntegralityTiling.lean +++ b/LeanPool/ApollonianSuperharmonic/IntegralityTiling.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandLatticeEquality public import LeanPool.ApollonianSuperharmonic.LambdaTiling diff --git a/LeanPool/ApollonianSuperharmonic/IsolatedPrecursorCoverage.lean b/LeanPool/ApollonianSuperharmonic/IsolatedPrecursorCoverage.lean index 71ed1b9aeb..74f027b5a9 100644 --- a/LeanPool/ApollonianSuperharmonic/IsolatedPrecursorCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/IsolatedPrecursorCoverage.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileArea public import LeanPool.ApollonianSuperharmonic.TileCellComplement -public import LeanPool.ApollonianSuperharmonic.FordTileGeometry public import LeanPool.ApollonianSuperharmonic.P4638T1AntipodalContactArcs public import LeanPool.ApollonianSuperharmonic.P4638T1ContactStarCoverage public import LeanPool.ApollonianSuperharmonic.P4638T1EmptyCurvature diff --git a/LeanPool/ApollonianSuperharmonic/LambdaTiling.lean b/LeanPool/ApollonianSuperharmonic/LambdaTiling.lean index f86593e500..864397d9fa 100644 --- a/LeanPool/ApollonianSuperharmonic/LambdaTiling.lean +++ b/LeanPool/ApollonianSuperharmonic/LambdaTiling.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileExists public import LeanPool.ApollonianSuperharmonic.BandTileTopologyApplication public import LeanPool.ApollonianSuperharmonic.CurvatureOneTileBase -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.BandGenealogy -- [TABLET NODE: LambdaTiling] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean index aa0cd65273..5a7893b37f 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean @@ -5,36 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -public import LeanPool.ApollonianSuperharmonic.OrientedTouchingCovariance -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.SimpleGridPath public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileRealization -public import LeanPool.ApollonianSuperharmonic.TileTouching -public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TouchingTriple -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: LatticeAdjacentInterfacePath] @@ -171,7 +148,8 @@ private theorem boundary_subset_footprint : · have : x = z + ⟨0, 1⟩ := by simpa using hxz subst x exact Or.inr (Or.inr (Or.inr (by simp [sub_eq_add_neg, add_comm, add_left_comm]))) - · simp? [BoundaryFootprintVertices, FootprintVertices, hne] at hx ⊢ + · simp only [BoundaryFootprintVertices, hne, ↓reduceIte, Set.mem_singleton_iff, + FootprintVertices] at hx ⊢ exact hx private theorem touching_path : @@ -318,8 +296,8 @@ private theorem quarter_translate : | mk cells anchor => apply congrArg₂ (fun c : Finset GaussianInt => fun a : GaussianInt => (⟨c, a⟩ : ProtoTile)) - · simp? [TileQuarterTurn, TileTranslation, GaussianTranslation, - Finset.image_image, Function.comp_def] + · simp only [TileTranslation, GaussianTranslation, Finset.image_image, Function.comp_def, + TileQuarterTurn] congr 1 funext z ext <;> simp [GaussianQuarterTurn]; ring @@ -706,7 +684,8 @@ private theorem hT2 : ((x.im : Int) : Real) + 1 / 2) := by simp [TileCentroid] rw [hcent] - simp? [TileRealization] + simp only [TileRealization, Finset.mem_singleton, Set.iUnion_iUnion_eq_left, + Int.reduceNeg, GaussianInt.intCast_re, one_div, GaussianInt.intCast_im] rw [← GaussianInt.intCast_re x, ← GaussianInt.intCast_im x] change (r, t) ∈ ClosedSquareRealization x ↔ ((((x.re : Int) : Real) + (2 : Real)⁻¹) - @@ -755,7 +734,7 @@ private theorem hT5 : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (ProperBandQuadruple q) → + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → (((0 : ℤ) < (q (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) → (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (D : ProtoTile), ∀ (j : Fin @@ -766,7 +745,7 @@ private theorem hT5 : (BandVectors.1 (q ((j + 1).succ)) (q 0)) - GaussianRealPoint (BandVectors.1 (q 0) (q ((j + 1).succ)))) → TouchingTriple A B D)) ) := by classical - intro q i hq hrootPos A B D j hA hB hD hcentB hcentD + intro q hq hrootPos A B D j hA hB hD hcentB hcentD have hgt : 1 < (q 0).1 := by by_contra hn have hzero : ∀ k : Fin 3, (q k.succ).1 = 0 := by @@ -998,7 +977,7 @@ theorem LatticeAdjacentInterfacePath : (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q ((j + 1).succ)) (q 0)) - GaussianRealPoint (BandVectors.1 (q 0) (q ((j + 1).succ)))) → - TouchingTriple A B D := LatticeInterfacePathGeometry.hT5 q i hq hrootPos + TouchingTriple A B D := LatticeInterfacePathGeometry.hT5 q hq hrootPos let unitI : GaussianInt := ⟨0, 1⟩ have qturn_mul (z : GaussianInt) : GaussianQuarterTurn z = unitI * z := by ext <;> simp [GaussianQuarterTurn, unitI] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeCell.lean b/LeanPool/ApollonianSuperharmonic/LatticeCell.lean index 49cc01eacc..90cff1d34e 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeCell.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeCell.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: LatticeCell] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeDiskUnionIntersectionConnected.lean b/LeanPool/ApollonianSuperharmonic/LatticeDiskUnionIntersectionConnected.lean index 9b75d1e020..c3ca740b4e 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeDiskUnionIntersectionConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeDiskUnionIntersectionConnected.lean @@ -5,25 +5,17 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices public import LeanPool.ApollonianSuperharmonic.ConnectedGridEdgeCarrierUnion public import LeanPool.ApollonianSuperharmonic.DisjointBoundaryCommonEdgeGraphAcyclic public import LeanPool.ApollonianSuperharmonic.DisjointSquareUnionCommonEdgeCarrier public import LeanPool.ApollonianSuperharmonic.FiniteAcyclicGraphCardConnected public import LeanPool.ApollonianSuperharmonic.FiniteGridEdgeGraphEncoding -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.LatticeTileGridEulerCount -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.ProtoTile -public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle -public import LeanPool.ApollonianSuperharmonic.TileRealization -- [TABLET NODE: LatticeDiskUnionIntersectionConnected] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeEdgeRegularity.lean b/LeanPool/ApollonianSuperharmonic/LatticeEdgeRegularity.lean index dc4574e682..9a1995cd50 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeEdgeRegularity.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeEdgeRegularity.lean @@ -5,43 +5,20 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandCircle -public import LeanPool.ApollonianSuperharmonic.BandGenealogy -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport -public import LeanPool.ApollonianSuperharmonic.BandParentRotationOccurrenceCovariance public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm -public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton -public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.FordCellDomain -public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected public import LeanPool.ApollonianSuperharmonic.OpenLatticeEdge public import LeanPool.ApollonianSuperharmonic.P4456T2DiamondNoChord public import LeanPool.ApollonianSuperharmonic.P4456T2MissingEdge public import LeanPool.ApollonianSuperharmonic.P4456T2OrderedNoChord public import LeanPool.ApollonianSuperharmonic.P4456T2PackingNoChord -public import LeanPool.ApollonianSuperharmonic.P4456T2SquareEdges -public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -- [TABLET NODE: LatticeEdgeRegularity] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeFundamentalSet.lean b/LeanPool/ApollonianSuperharmonic/LatticeFundamentalSet.lean index 5b23bf4050..cc2eb11f5b 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeFundamentalSet.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeFundamentalSet.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: LatticeFundamentalSet] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeQuadraticForm.lean b/LeanPool/ApollonianSuperharmonic/LatticeQuadraticForm.lean index 025617dc6e..91f9a1395c 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeQuadraticForm.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeQuadraticForm.lean @@ -5,7 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + +public import Mathlib.Data.Matrix.Mul +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: LatticeQuadraticForm] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTile.lean b/LeanPool/ApollonianSuperharmonic/LatticeTile.lean index 43edf3a9f9..369ae29c3a 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTile.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTile.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TopologicalDisk public import LeanPool.ApollonianSuperharmonic.TileRealization diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean index 39a7f46711..67857ff234 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean @@ -5,19 +5,15 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertexDegreeTwo -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.P5620T1BoundaryComponentCycle public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected -public import LeanPool.ApollonianSuperharmonic.LatticeTileNoCheckerboard -public import LeanPool.ApollonianSuperharmonic.ProtoTile public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle -public import LeanPool.ApollonianSuperharmonic.TileRealization public import LeanPool.ApollonianSuperharmonic.TopologicalDiskGridRayCrossingIndexZero -- [TABLET NODE: LatticeTileBoundarySimpleGridCycle] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean index f7593bbe96..b07a34249f 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean @@ -5,14 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex -public import LeanPool.ApollonianSuperharmonic.ProtoTile -public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle -- [TABLET NODE: LatticeTileComplementGridConnected] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileDiskUnionInterface.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileDiskUnionInterface.lean index 32b5d3207a..c0192f94bc 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileDiskUnionInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileDiskUnionInterface.lean @@ -5,20 +5,15 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonFootprintIncidence -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices public import LeanPool.ApollonianSuperharmonic.ConnectedCommonBoundaryPath -public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.LatticeDiskUnionIntersectionConnected -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.ProtoTile public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween -public import LeanPool.ApollonianSuperharmonic.TileRealization -- [TABLET NODE: LatticeTileDiskUnionInterface] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileFourNeighborConnected.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileFourNeighborConnected.lean index 79196d1837..ecc3695762 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileFourNeighborConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileFourNeighborConnected.lean @@ -5,12 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.LatticeTileNoCheckerboard -public import LeanPool.ApollonianSuperharmonic.ProtoTile -public import LeanPool.ApollonianSuperharmonic.TileRealization -- [TABLET NODE: LatticeTileFourNeighborConnected] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean index 989d5b390a..0886c1cfe9 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean @@ -5,15 +5,14 @@ Authors: Wesley Pegden -/ module -public import Mathlib.Data.Set.Card +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FiniteBiconnectedHorizontalRunTree public import LeanPool.ApollonianSuperharmonic.FiniteSquareIncidenceIdentities public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.LatticeTileComplementGridConnected -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.ProtoTile /-! # LatticeTileGridEulerCount @@ -405,7 +404,8 @@ private theorem hsum : simp only [Finset.sum_add_distrib] at hp simp_rw [← Finset.mul_sum] at hp simp only [Finset.sum_add_distrib] at hp - simp? [hAB, hBD, hDC, hCA, hfull] at hp + simp only [Finset.sum_boole, Nat.cast_id, hAB, hBD, hDC, hCA, Multiset.mem_toFinset, + imp_self, implies_true, Multiset.sum_count_eq_card, hfull] at hp have hbag : cornerBag.card = 4 * T.cells.card := by simp [cornerBag, Nat.mul_comm] dsimp only [N] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileGridStructure.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileGridStructure.lean index bb389fa2bb..632a1914bc 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileGridStructure.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileGridStructure.lean @@ -5,17 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.LatticeTileBoundarySimpleGridCycle -public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected -public import LeanPool.ApollonianSuperharmonic.LatticeTileNoCheckerboard public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex -public import LeanPool.ApollonianSuperharmonic.ProtoTile public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle -public import LeanPool.ApollonianSuperharmonic.TileRealization -- [TABLET NODE: LatticeTileGridStructure] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileNoCheckerboard.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileNoCheckerboard.lean index 8e30d0b2ee..abe1a4f919 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileNoCheckerboard.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileNoCheckerboard.lean @@ -5,11 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex -public import LeanPool.ApollonianSuperharmonic.ProtoTile -public import LeanPool.ApollonianSuperharmonic.TileRealization public import LeanPool.ApollonianSuperharmonic.TopologicalDiskLocallyPuncturedPreconnected /-! diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean index 69b669dbd1..f205bfe84a 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean @@ -5,21 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.LatticeTileDiskUnionInterface -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridEulerCount -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors -public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex -public import LeanPool.ApollonianSuperharmonic.ProtoTile -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy -public import LeanPool.ApollonianSuperharmonic.TileRealization -- [TABLET NODE: LatticeTileThreeDiskJunction] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeVertexBoundary.lean b/LeanPool/ApollonianSuperharmonic/LatticeVertexBoundary.lean index 80a558f256..d4e4cf1106 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeVertexBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeVertexBoundary.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: LatticeVertexBoundary] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeVertexIncidentCell.lean b/LeanPool/ApollonianSuperharmonic/LatticeVertexIncidentCell.lean index 88b50206d4..bf45b4ac30 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeVertexIncidentCell.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeVertexIncidentCell.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.LatticeCell -- [TABLET NODE: LatticeVertexIncidentCell] diff --git a/LeanPool/ApollonianSuperharmonic/LeftAdjacentOdometerCompatibility.lean b/LeanPool/ApollonianSuperharmonic/LeftAdjacentOdometerCompatibility.lean index 90c700675f..1c54712715 100644 --- a/LeanPool/ApollonianSuperharmonic/LeftAdjacentOdometerCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/LeftAdjacentOdometerCompatibility.lean @@ -5,9 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4261T2LiteralInterface -public import LeanPool.ApollonianSuperharmonic.P4261T2AdjacentMatrixSlope -public import LeanPool.ApollonianSuperharmonic.P4261T2UnitBoundary +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4261T2UnitStringTelescoping public import LeanPool.ApollonianSuperharmonic.P4261T2DiamondBoundary public import LeanPool.ApollonianSuperharmonic.P4261T2RegularEdgeReduction @@ -15,22 +14,10 @@ public import LeanPool.ApollonianSuperharmonic.P4261T2InterfacePropagation public import LeanPool.ApollonianSuperharmonic.P4261T2UnitInterface public import LeanPool.ApollonianSuperharmonic.P4261T2PairNormalization public import LeanPool.ApollonianSuperharmonic.P4261T2AncestorSymmetry -public import LeanPool.ApollonianSuperharmonic.P4158T1StringSlopeTelescoping -public import LeanPool.ApollonianSuperharmonic.P4055T1PackingGridEquivalence public import LeanPool.ApollonianSuperharmonic.FordLeftBoundaryCompatibility public import LeanPool.ApollonianSuperharmonic.FordOpposingBoundaryStarLocalization public import LeanPool.ApollonianSuperharmonic.DiamondOpposingBoundaryStarLocalization public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryStarLocalization -public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryInterfaceExhaustion -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -- [TABLET NODE: LeftAdjacentOdometerCompatibility] diff --git a/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacent.lean b/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacent.lean index 8d525641ec..51dfdca1a7 100644 --- a/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacent.lean +++ b/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacent.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CircleMatrix public import LeanPool.ApollonianSuperharmonic.TileOdometer public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep diff --git a/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean index 8cbd22904d..86a3d055a7 100644 --- a/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean @@ -5,14 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance -public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -- [TABLET NODE: LeftLatticeAdjacentPackingSymmetryTransport] @@ -204,7 +200,8 @@ private theorem affine_neg : rcases w with ⟨wa, wb⟩ apply Prod.ext · simp [BandPackingSymmetryAffineVectorAction, GaussianReflection] - · simp? [BandPackingSymmetryAffineVectorAction, GaussianReflection] + · simp only [BandPackingSymmetryAffineVectorAction, Int.reduceNeg, GaussianReflection, + Zsqrtd.re_neg, Zsqrtd.im_neg, neg_neg, Prod.neg_mk, neg_add_rev] have hrel : ({re := -va, im := vb} : GaussianInt) = -({re := va, im := -vb} : GaussianInt) := by ext <;> simp @@ -527,12 +524,15 @@ theorem LeftLatticeAdjacentPackingSymmetryTransport have hv := (hvec i).1 have hvr := congrArg (fun z : GaussianInt => (z.re : ℝ)) hv by_cases hn : negative - · simp? [he, hn] at hvr ⊢ + · simp only [Int.reduceNeg, Fin.isValue, GaussianInt.intCast_re, hn, ↓reduceIte, + neg_mul, one_mul, Zsqrtd.re_neg, Int.cast_neg, he, bne_self_eq_false, + Bool.false_eq_true] at hvr ⊢ rw [← GaussianInt.intCast_re] at ⊢ have hcoord := hvr try simp only [real_coord] at hcoord linarith [hs.1, hcoord] - · simp? [he, hn] at hvr ⊢ + · simp only [Int.reduceNeg, Fin.isValue, GaussianInt.intCast_re, hn, Bool.false_eq_true, + ↓reduceIte, one_mul, he, Bool.bne_false] at hvr ⊢ rw [← GaussianInt.intCast_re] at ⊢ have hcoord := hvr try simp only [real_coord] at hcoord @@ -549,7 +549,9 @@ theorem LeftLatticeAdjacentPackingSymmetryTransport have hv := (hvec i).1 have hvr := congrArg (fun z : GaussianInt => (z.re : ℝ)) hv by_cases hn : negative - · simp? [he, hn] at hvr ⊢ + · simp only [Int.reduceNeg, Fin.isValue, GaussianInt.intCast_re, hn, ↓reduceIte, + neg_mul, one_mul, Zsqrtd.re_neg, Int.cast_neg, he, Bool.bne_true, Bool.not_false] + at hvr ⊢ try rw [← GaussianInt.intCast_re] at ⊢ have hcoord := hvr try simp only [real_coord] at hcoord @@ -561,7 +563,8 @@ theorem LeftLatticeAdjacentPackingSymmetryTransport BandVectors.2 (q i.succ) (q 0))).2.re : ℝ) := LeftLatticeTransportGeometry.hscoordAt393 g q i T T' p p' hs linarith [hscoord, hcoord] - · simp? [he, hn] at hvr ⊢ + · simp only [Int.reduceNeg, Fin.isValue, GaussianInt.intCast_re, hn, Bool.false_eq_true, + ↓reduceIte, one_mul, he, bne_self_eq_false, neg_mul] at hvr ⊢ try rw [← GaussianInt.intCast_re] at ⊢ have hcoord := hvr try simp only [real_coord] at hcoord @@ -585,12 +588,15 @@ theorem LeftLatticeAdjacentPackingSymmetryTransport have hv := (hvec i).1 have hvi := congrArg (fun z : GaussianInt => (z.im : ℝ)) hv by_cases hn : negative - · simp? [he, hn] at hvi ⊢ + · simp only [Int.reduceNeg, Fin.isValue, GaussianInt.intCast_im, hn, ↓reduceIte, + neg_mul, one_mul, Zsqrtd.im_neg, Int.cast_neg, he, bne_self_eq_false, + Bool.false_eq_true] at hvi ⊢ rw [← GaussianInt.intCast_im] at ⊢ have hcoord := hvi try simp only [imag_coord] at hcoord linarith [hs.2, hcoord] - · simp? [he, hn] at hvi ⊢ + · simp only [Int.reduceNeg, Fin.isValue, GaussianInt.intCast_im, hn, Bool.false_eq_true, + ↓reduceIte, one_mul, he, Bool.bne_false] at hvi ⊢ rw [← GaussianInt.intCast_im] at ⊢ have hcoord := hvi try simp only [imag_coord] at hcoord @@ -607,7 +613,9 @@ theorem LeftLatticeAdjacentPackingSymmetryTransport have hv := (hvec i).1 have hvi := congrArg (fun z : GaussianInt => (z.im : ℝ)) hv by_cases hn : negative - · simp? [he, hn] at hvi ⊢ + · simp only [Int.reduceNeg, Fin.isValue, GaussianInt.intCast_im, hn, ↓reduceIte, + neg_mul, one_mul, Zsqrtd.im_neg, Int.cast_neg, he, Bool.bne_true, Bool.not_false] + at hvi ⊢ try rw [← GaussianInt.intCast_im] at ⊢ have hcoord := hvi try simp only [imag_coord] at hcoord @@ -619,7 +627,8 @@ theorem LeftLatticeAdjacentPackingSymmetryTransport BandVectors.2 (q i.succ) (q 0))).2.im : ℝ) := LeftLatticeTransportGeometry.hscoordAt451 g q i T T' p p' hs linarith [hscoord, hcoord] - · simp? [he, hn] at hvi ⊢ + · simp only [Int.reduceNeg, Fin.isValue, GaussianInt.intCast_im, hn, Bool.false_eq_true, + ↓reduceIte, one_mul, he, bne_self_eq_false, neg_mul] at hvi ⊢ try rw [← GaussianInt.intCast_im] at ⊢ have hcoord := hvi try simp only [imag_coord] at hcoord diff --git a/LeanPool/ApollonianSuperharmonic/LocalExponentialEstimate.lean b/LeanPool/ApollonianSuperharmonic/LocalExponentialEstimate.lean index e575f99359..a7c3985edf 100644 --- a/LeanPool/ApollonianSuperharmonic/LocalExponentialEstimate.lean +++ b/LeanPool/ApollonianSuperharmonic/LocalExponentialEstimate.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.RealFourNeighborLaplacian +public meta import Lean.Meta.Tactic.NormCast -- [TABLET NODE: LocalExponentialEstimate] diff --git a/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean b/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean index 254b96ce6b..3a0bff651f 100644 --- a/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean @@ -5,9 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.LatticeTile @@ -16,7 +15,6 @@ public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge -public import LeanPool.ApollonianSuperharmonic.TileRealization public import LeanPool.ApollonianSuperharmonic.TouchingTriple -- [TABLET NODE: LocalLatticeInterfaceSectors] diff --git a/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean index 1031f3ef3a..d87d7a67a5 100644 --- a/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean @@ -5,67 +5,18 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5630T1MarkedRightOdometerAdjacencyReduction -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence -public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMarkedSectorTransport -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRoutedSelectedContact -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightOuterMarkingCriterion -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightSelectedAdjacency -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightSelectedRowGeometry -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizedBundleExists -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRowExists public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileSelectedRowGeometry public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileNormalizedBundleExists -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMixedAggregatePatches -public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryMarkedDataCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.CoveredInterfaceOppositeIncidentCells -public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity -public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentInterfacePath -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.LatticeTileThreeDiskJunction public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacentPackingSymmetryTransport public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition -public import LeanPool.ApollonianSuperharmonic.TileOdometer public import LeanPool.ApollonianSuperharmonic.TileSubodometer -public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween -- [TABLET NODE: MarkedOdometerAdjacencyReduction] @@ -1323,8 +1274,9 @@ private theorem slopeDiffCov : rcases p' with ⟨p'x, p'y⟩ have h1 := congrArg Prod.fst hdiff have h2 := congrArg Prod.snd hdiff - simp? [BandPackingSymmetrySlopeAction, - slopeDifferenceAction] at h1 h2 ⊢ + simp only [Prod.mk_sub_mk, BandPackingSymmetrySlopeAction, sub_neg_eq_add, + Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, Prod.mk.injEq, + slopeDifferenceAction] at h1 h2 ⊢ exact ⟨by linarith [h2], by linarith [h1]⟩ | conjugate => intro c U V p p' w hc hcent hdiff @@ -1332,8 +1284,9 @@ private theorem slopeDiffCov : rcases p' with ⟨p'x, p'y⟩ have h1 := congrArg Prod.fst hdiff have h2 := congrArg Prod.snd hdiff - simp? [BandPackingSymmetrySlopeAction, - slopeDifferenceAction] at h1 h2 ⊢ + simp only [Prod.mk_sub_mk, BandPackingSymmetrySlopeAction, sub_neg_eq_add, + Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, Prod.mk.injEq, + slopeDifferenceAction] at h1 h2 ⊢ exact ⟨by linarith [h1], by linarith [h2]⟩ | comp a b iha ihb => intro c U V p p' w hc hcent hdiff diff --git a/LeanPool/ApollonianSuperharmonic/ModifiedSubtileOccurrenceInterpretation.lean b/LeanPool/ApollonianSuperharmonic/ModifiedSubtileOccurrenceInterpretation.lean index 77b5742e20..cd2da3eaf3 100644 --- a/LeanPool/ApollonianSuperharmonic/ModifiedSubtileOccurrenceInterpretation.lean +++ b/LeanPool/ApollonianSuperharmonic/ModifiedSubtileOccurrenceInterpretation.lean @@ -5,8 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.TileCellComplement +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex +public import LeanPool.ApollonianSuperharmonic.TileTranslation -- [TABLET NODE: ModifiedSubtileOccurrenceInterpretation] diff --git a/LeanPool/ApollonianSuperharmonic/NoCheckerboardCellVertex.lean b/LeanPool/ApollonianSuperharmonic/NoCheckerboardCellVertex.lean index 859c38f73e..ff4e663710 100644 --- a/LeanPool/ApollonianSuperharmonic/NoCheckerboardCellVertex.lean +++ b/LeanPool/ApollonianSuperharmonic/NoCheckerboardCellVertex.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeCell -- [TABLET NODE: NoCheckerboardCellVertex] diff --git a/LeanPool/ApollonianSuperharmonic/OdometerAdjacencyInduction.lean b/LeanPool/ApollonianSuperharmonic/OdometerAdjacencyInduction.lean index abfd769adc..58ff742d28 100644 --- a/LeanPool/ApollonianSuperharmonic/OdometerAdjacencyInduction.lean +++ b/LeanPool/ApollonianSuperharmonic/OdometerAdjacencyInduction.lean @@ -5,12 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.OrderedGeneralOdometerAdjacencyClassification -public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction -public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist public import LeanPool.ApollonianSuperharmonic.P5491T1ExceptionalPresentation public import LeanPool.ApollonianSuperharmonic.P5491T1AffinePairReduction public import LeanPool.ApollonianSuperharmonic.P5491T1FordBoundarySlope @@ -21,8 +19,6 @@ public import LeanPool.ApollonianSuperharmonic.P5491T1DiamondParentBoundary public import LeanPool.ApollonianSuperharmonic.P5332T1VectorPlacements public import LeanPool.ApollonianSuperharmonic.P5352T2VectorPlacements public import LeanPool.ApollonianSuperharmonic.P5352T2SourceCertificates -public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid -public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic -- [TABLET NODE: OdometerAdjacencyInduction] diff --git a/LeanPool/ApollonianSuperharmonic/OdometerCompatibility.lean b/LeanPool/ApollonianSuperharmonic/OdometerCompatibility.lean index 87dd1ceab0..c4e7fcf674 100644 --- a/LeanPool/ApollonianSuperharmonic/OdometerCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/OdometerCompatibility.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PartialOdometer -- [TABLET NODE: OdometerCompatibility] diff --git a/LeanPool/ApollonianSuperharmonic/OdometerGluing.lean b/LeanPool/ApollonianSuperharmonic/OdometerGluing.lean index cfa0f4b9fd..9b25b3a0ff 100644 --- a/LeanPool/ApollonianSuperharmonic/OdometerGluing.lean +++ b/LeanPool/ApollonianSuperharmonic/OdometerGluing.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure public import LeanPool.ApollonianSuperharmonic.P3221T2ClosedWalkCirculation public import LeanPool.ApollonianSuperharmonic.P3221T2ConnectedPathIntegration @@ -463,9 +464,7 @@ private theorem hgcompat : exact ∀ (adjacent_symm : ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → (FourNeighborAdjacent b a)), ∀ (adjacent_irrefl : ∀ (a : GaussianInt), ¬ - FourNeighborAdjacent a a), ∀ (corner : ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ - T.cells) → (∀ (a : GaussianInt), (a = x ∨ a = x + 1 ∨ a = x + ⟨0, 1⟩ ∨ a = x + 1 + - ⟨0, 1⟩) → (a ∈ FootprintVertices T))), ∀ (edge_vertices : ∀ (T : ProtoTile), ∀ (a : + FourNeighborAdjacent a a), ∀ (edge_vertices : ∀ (T : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, b} : Finset GaussianInt) ∈ FootprintEdges T) → (a ∈ FootprintVertices T ∧ b ∈ FootprintVertices T)), ∀ (footprint_constant : ∀ (W : ProtoTile), (LatticeTile W) → (∀ (F : GaussianInt → ℤ), (∀ a, ∀ b, @@ -512,8 +511,8 @@ private theorem hgcompat : (∀ (x : {x // x ∈ FootprintVertices T}), g.value x = f x) → (∀ i, OdometerCompatibility g (h i)) ) := by classical - intro adjacent_symm adjacent_irrefl corner edge_vertices footprint_constant n T U h hU hdom - hcells hverts E covered D dmember G z hz f hfedge dom hdomain g hgvalue i + intro adjacent_symm adjacent_irrefl edge_vertices footprint_constant n T U h hU hdom + hcells hverts E covered D dmember G z hz f hfedge dom hdomain g hgvalue i obtain ⟨c, hc⟩ := footprint_constant (U i) (hU i) (fun x => g.value x - (h i).value x) (by intro a b hadj he @@ -927,7 +926,7 @@ theorem OdometerGluing : simp [hx'] } have hgvalue (x : {x // x ∈ FootprintVertices T}) : g.value x = f x := by simp [g, x.property] - have hgcompat := OdometerGluingProof.hgcompat adjacent_symm adjacent_irrefl corner + have hgcompat := OdometerGluingProof.hgcompat adjacent_symm adjacent_irrefl edge_vertices footprint_constant n T U h hU hdom hcells hverts dmember z hz f hfedge hdomain hgvalue refine ⟨g, hdomain, hgcompat, ?_⟩ diff --git a/LeanPool/ApollonianSuperharmonic/OdometerStringRespect.lean b/LeanPool/ApollonianSuperharmonic/OdometerStringRespect.lean index 2fb1a5adf2..9a9606d14a 100644 --- a/LeanPool/ApollonianSuperharmonic/OdometerStringRespect.lean +++ b/LeanPool/ApollonianSuperharmonic/OdometerStringRespect.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.TileString diff --git a/LeanPool/ApollonianSuperharmonic/OdometerStringRespectCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/OdometerStringRespectCentralCovariance.lean index 1d7c8df6b0..89a12f7d09 100644 --- a/LeanPool/ApollonianSuperharmonic/OdometerStringRespectCentralCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/OdometerStringRespectCentralCovariance.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry public import LeanPool.ApollonianSuperharmonic.TileStringCentralCovariance @@ -91,7 +91,8 @@ theorem OdometerStringRespectCentralCovariance · left rcases hunit with ⟨hor, orig, v, hv, hct, hx, hy⟩ refine ⟨hor, orig, -v, ?_, ?_, ?_, ?_⟩ - · cases orig <;> simp? [UnitTriangularStep] at hv + · cases orig <;> simp only [UnitTriangularStep, Bool.false_eq_true, ↓reduceIte, + Int.reduceNeg, neg_add_rev, neg_neg, Finset.mem_insert, Finset.mem_singleton] at hv all_goals rcases hv with rfl | rfl | rfl | rfl | rfl | rfl <;> simp [UnitTriangularStep] · rw [hcent] diff --git a/LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean index 0f9d91dcb0..2120499daa 100644 --- a/LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean @@ -5,11 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.OdometerStringRespectCentralCovariance public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -- [TABLET NODE: OdometerStringRespectRegularFamilyCentralCovariance] diff --git a/LeanPool/ApollonianSuperharmonic/OdometerTranslation.lean b/LeanPool/ApollonianSuperharmonic/OdometerTranslation.lean index 69a9d69a1b..bced2ff0d7 100644 --- a/LeanPool/ApollonianSuperharmonic/OdometerTranslation.lean +++ b/LeanPool/ApollonianSuperharmonic/OdometerTranslation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PartialOdometer -- [TABLET NODE: OdometerTranslation] diff --git a/LeanPool/ApollonianSuperharmonic/OdometerWeb.lean b/LeanPool/ApollonianSuperharmonic/OdometerWeb.lean index daba94fb8d..5ccd834a9d 100644 --- a/LeanPool/ApollonianSuperharmonic/OdometerWeb.lean +++ b/LeanPool/ApollonianSuperharmonic/OdometerWeb.lean @@ -5,102 +5,16 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -public import LeanPool.ApollonianSuperharmonic.AncestorOdometer -public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints -public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentIncomingEndpoint -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryMarkedDataCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance -public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm -public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex -public import LeanPool.ApollonianSuperharmonic.BoundaryStringOdometerRespect -public import LeanPool.ApollonianSuperharmonic.BoundaryString -public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector -public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer -public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton -public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain -public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable -public import LeanPool.ApollonianSuperharmonic.DiamondOdometerExistsUnique -public import LeanPool.ApollonianSuperharmonic.DiamondOrientedChildParentEndpoints -public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction -public import LeanPool.ApollonianSuperharmonic.DiamondTerminalWebStencilLedger -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceDisjointCompanionEndpoints -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.FordCellDomain -public import LeanPool.ApollonianSuperharmonic.FordFareyParameter -public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable -public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordOdometerFamilyExistsUnique -public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentEndpoints -public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentRightEndpoint -public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse -public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction -public import LeanPool.ApollonianSuperharmonic.FordTileGeometry -public import LeanPool.ApollonianSuperharmonic.FordTerminalWebStencilLedger -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain -public import LeanPool.ApollonianSuperharmonic.LeftAdjacentOdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors public import LeanPool.ApollonianSuperharmonic.MarkedOdometerAdjacencyReduction -public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect -public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryOdometerStrings -public import LeanPool.ApollonianSuperharmonic.OpposingStringInterfacePath -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths -public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex -public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.RightSubtileOdometerCompatibility public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition -public import LeanPool.ApollonianSuperharmonic.TileHalfTurn -public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity -public import LeanPool.ApollonianSuperharmonic.TouchingTriple -public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations -public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep -public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation -public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct -public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification -public import LeanPool.ApollonianSuperharmonic.P5570T1UnitNormalForm -public import LeanPool.ApollonianSuperharmonic.P5570T1UnitQuadratic -public import LeanPool.ApollonianSuperharmonic.CurvatureOnePeriodicOdometer -public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryGlobalOdometerTransport -public import LeanPool.ApollonianSuperharmonic.P3996T1AdjacentParentPlacement -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleRetargetMiddle -public import LeanPool.ApollonianSuperharmonic.P5589T1EndpointCompatibility -public import LeanPool.ApollonianSuperharmonic.P5589T1UnitInterfaceSelection -public import LeanPool.ApollonianSuperharmonic.P5589T1LinkedUnitValues public import LeanPool.ApollonianSuperharmonic.P5596T1LeftWeb -public import LeanPool.ApollonianSuperharmonic.P5491T1ExceptionalPresentation public import LeanPool.ApollonianSuperharmonic.P5606T1RightTerminalTransport public import LeanPool.ApollonianSuperharmonic.P5606T1SubtileTerminalTransport diff --git a/LeanPool/ApollonianSuperharmonic/OpenLatticeEdge.lean b/LeanPool/ApollonianSuperharmonic/OpenLatticeEdge.lean index 28851fc0e9..034b3171a0 100644 --- a/LeanPool/ApollonianSuperharmonic/OpenLatticeEdge.lean +++ b/LeanPool/ApollonianSuperharmonic/OpenLatticeEdge.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -- [TABLET NODE: OpenLatticeEdge] diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryInterfaceExhaustion.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryInterfaceExhaustion.lean index 5a7bbb18c2..5f7df4a291 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryInterfaceExhaustion.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryInterfaceExhaustion.lean @@ -5,13 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryOdometerStrings public import LeanPool.ApollonianSuperharmonic.OpposingStringInterfacePath public import LeanPool.ApollonianSuperharmonic.P4366T2OuterGeometry public import LeanPool.ApollonianSuperharmonic.P4366T2WalkExhaustion public import LeanPool.ApollonianSuperharmonic.P4366T2LocalSectors -public import LeanPool.ApollonianSuperharmonic.P4158T1AncestorCells -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -- [TABLET NODE: OpposingBoundaryInterfaceExhaustion] diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean index b6802056e7..7c44823dcb 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean @@ -5,40 +5,17 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometerCentralCovariance -public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization public import LeanPool.ApollonianSuperharmonic.AncestorOdometerOuterSupportNormalization public import LeanPool.ApollonianSuperharmonic.AncestorOdometer -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.BoundaryStringOdometerRespect -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.BoundaryString public import LeanPool.ApollonianSuperharmonic.ForwardBoundaryStringData -public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import LeanPool.ApollonianSuperharmonic.OdometerStringRespectCentralCovariance public import LeanPool.ApollonianSuperharmonic.OdometerStringRespectRegularFamilyCentralCovariance public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas -public import LeanPool.ApollonianSuperharmonic.PartialOdometer -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProtoTile -public import LeanPool.ApollonianSuperharmonic.RegularTileFamily -public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation -public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry -public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.TileString -public import LeanPool.ApollonianSuperharmonic.TileStringCentralCovariance public import LeanPool.ApollonianSuperharmonic.TileStringRegularFamilyCentralCovariance -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique -public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing -- [TABLET NODE: OpposingBoundaryOdometerStrings] diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean index 5329bc0bdb..94c46671a2 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean @@ -5,21 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AffineTriangularNoFourfoldCellOwners +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometer -public import LeanPool.ApollonianSuperharmonic.BandGenealogy -public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification -public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryInterfaceExhaustion -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: OpposingBoundaryStarLocalization] diff --git a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean index 946d244f77..f88d76533c 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean @@ -5,28 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AffineOpposingStripCorridor -public import LeanPool.ApollonianSuperharmonic.AffineTriangularComplexChart -public import LeanPool.ApollonianSuperharmonic.AffineTriangularCorridorStep -public import LeanPool.ApollonianSuperharmonic.AffineTriangularFaceCoordinateSwap -public import LeanPool.ApollonianSuperharmonic.AffineTriangularFaceVertices -public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple public import LeanPool.ApollonianSuperharmonic.SwappedAffineTriangularChartAlignment -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas public import LeanPool.ApollonianSuperharmonic.TileString public import LeanPool.ApollonianSuperharmonic.TileStringCoordinateTransport -public import LeanPool.ApollonianSuperharmonic.TileTouching -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.TriangularStripSegment public import LeanPool.ApollonianSuperharmonic.UnitSquareOpposingStripInterfacePath -public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep -- [TABLET NODE: OpposingStringInterfacePath] @@ -274,8 +260,10 @@ private theorem hcellCalc : ∀ (z : Int × Int), (tileAt z).cells = (turnedAt z).cells)) ) := by classical intro C base x hcells tileAt x0 unitAt turnedAt z - simp? [tileAt, turnedAt, unitAt, TileTranslation, TileQuarterTurn, - GaussianTranslation, hcells, x0, GaussianQuarterTurn] + simp only [TileTranslation, Int.reduceNeg, Zsqrtd.smul_val, mul_zero, mul_one, mul_neg, + hcells, Finset.image_singleton, GaussianTranslation, TileQuarterTurn, + GaussianQuarterTurn, Zsqrtd.add_def, neg_add_rev, neg_sub, sub_neg_eq_add, + Finset.singleton_inj, tileAt, turnedAt, unitAt, x0] ext <;> simp []; omega private theorem hvertsEqAt314 : diff --git a/LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean b/LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean index 2b992c3c86..c811221909 100644 --- a/LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary diff --git a/LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean b/LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean index 5d4bf4e47f..bd4ff47c54 100644 --- a/LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean @@ -5,17 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout -public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryMarkedDataCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacentPackingSymmetryTransport public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization public import LeanPool.ApollonianSuperharmonic.P4261T1CentralCoordinates public import LeanPool.ApollonianSuperharmonic.P4261T1RightCoordinates public import LeanPool.ApollonianSuperharmonic.P4261T1EdgeExterior diff --git a/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean b/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean index 7ba6b4afc1..0f21583f26 100644 --- a/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean @@ -5,14 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance -public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations -- [TABLET NODE: OrientedTouchingCovariance] @@ -96,9 +93,9 @@ private theorem same_touch : by_cases ha0 : A.cells = ∅ <;> by_cases hb0 : B.cells = ∅ <;> by_cases hc0 : C.cells = ∅ <;> first - | simp? [ha0, hb0, hc0, ba, bb, bc, - haa ha0, hbb hb0, hcc hc0] - | simp? [ha0, hb0, hc0, ha, hb, hc, ba, bb, bc] + | simp only [ha0, Finset.not_nonempty_empty, hb0, disjoint_self, Finset.bot_eq_empty, ba, + bb, true_and, false_and, and_self, haa ha0, hbb hb0, false_or, hc0, bc, hcc hc0] + | simp only [ha, hb, ba, bb, hc, bc] all_goals first | simp [ha0, hb0, hc0, ← haa ha0, ← hbb hb0, ← hcc hc0, ← ha, ← hb, ← hc, ← ba, ← bb, ← bc, ← ea, ← eb, ← ec] diff --git a/LeanPool/ApollonianSuperharmonic/OrientedUnimodularStripConcatenation.lean b/LeanPool/ApollonianSuperharmonic/OrientedUnimodularStripConcatenation.lean index 7e7e9079a0..e465d132a4 100644 --- a/LeanPool/ApollonianSuperharmonic/OrientedUnimodularStripConcatenation.lean +++ b/LeanPool/ApollonianSuperharmonic/OrientedUnimodularStripConcatenation.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.List.Infix + public import LeanPool.ApollonianSuperharmonic.P3019T1ChamberSegmentOrder public import LeanPool.ApollonianSuperharmonic.P3019T1UnimodularStripWindow diff --git a/LeanPool/ApollonianSuperharmonic/OuterLayoutTouching.lean b/LeanPool/ApollonianSuperharmonic/OuterLayoutTouching.lean index 374f1345f7..755dee4538 100644 --- a/LeanPool/ApollonianSuperharmonic/OuterLayoutTouching.lean +++ b/LeanPool/ApollonianSuperharmonic/OuterLayoutTouching.lean @@ -5,13 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototile public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn public import LeanPool.ApollonianSuperharmonic.OuterTouchingAlternative public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations public import LeanPool.ApollonianSuperharmonic.TileTranslation public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws @@ -792,7 +793,11 @@ theorem OuterLayoutTouching : have hEy := congrArg Prod.snd centerE have hFx := congrArg Prod.fst centerF have hFy := congrArg Prod.snd centerF - simp? [GaussianRealPoint] at hAx hAy hBx hBy hCx hCy hDx hDy hEx hEy hFx hFy + simp only [Prod.fst_sub, one_div, GaussianRealPoint, Int.reduceNeg, GaussianInt.intCast_re, + GaussianInt.intCast_im, Prod.mk_sub_mk, sub_neg_eq_add, Prod.smul_mk, smul_eq_mul, + one_smul, Prod.snd_sub, neg_smul, Prod.neg_mk, Zsqrtd.re_sub, Zsqrtd.re_neg, + Int.cast_sub, Int.cast_neg, Zsqrtd.im_sub, Zsqrtd.im_neg, neg_sub] + at hAx hAy hBx hBy hCx hCy hDx hDy hEx hEy hFx hFy have literal (K : CircleCoordinates) (X X' Y : ProtoTile) (z : GaussianInt) (hX : BandPrototile K X) (hX' : BandPrototile K X') (hoff : TileCentroid X' - TileCentroid X = GaussianRealPoint z) diff --git a/LeanPool/ApollonianSuperharmonic/OuterTouchingAlternative.lean b/LeanPool/ApollonianSuperharmonic/OuterTouchingAlternative.lean index b52b99a20e..8e5c842104 100644 --- a/LeanPool/ApollonianSuperharmonic/OuterTouchingAlternative.lean +++ b/LeanPool/ApollonianSuperharmonic/OuterTouchingAlternative.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileArea public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.FootprintVertices -- [TABLET NODE: OuterTouchingAlternative] diff --git a/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean index ddaff55e3e..855e1e251a 100644 --- a/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean +++ b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean @@ -5,41 +5,17 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandPrototile public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.FiniteConnectedCellSetNoCheckerboard -public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch public import LeanPool.ApollonianSuperharmonic.FinitePatchTopology -public import LeanPool.ApollonianSuperharmonic.FinitePolyominoDiskCriterion -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected -public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.LatticeTileComplementGridConnected -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex -public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex -public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.ProtoTile public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.TileCellComplement public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileRealization -public import LeanPool.ApollonianSuperharmonic.TileTouching -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TopologicalDisk -public import LeanPool.ApollonianSuperharmonic.TouchingTriple public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: P1BandOrderedGeneralMixedAggregateJunctionData] diff --git a/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean index be815b2c2a..28d4b4f0db 100644 --- a/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean @@ -5,56 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence -public import LeanPool.ApollonianSuperharmonic.CellSupportedFootprintVertices public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleRetargetMiddle public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleSwapLast -public import LeanPool.ApollonianSuperharmonic.FiniteConnectedCellSetNoCheckerboard -public import LeanPool.ApollonianSuperharmonic.FiniteInducedTilePatch -public import LeanPool.ApollonianSuperharmonic.FinitePatchTopology -public import LeanPool.ApollonianSuperharmonic.FinitePolyominoDiskCriterion -public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.LatticeTileComplementGridConnected -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure public import LeanPool.ApollonianSuperharmonic.LatticeTileThreeDiskJunction -public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.P1BandOrderedGeneralMixedAggregateJunctionData -public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex -public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex -public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths -public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.ProtoTile -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEndpointPairUnique -public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -public import LeanPool.ApollonianSuperharmonic.TileCellComplement -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileRealization -public import LeanPool.ApollonianSuperharmonic.TileTouching -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TopologicalDisk -public import LeanPool.ApollonianSuperharmonic.TouchingTriple -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: P1BandOrderedGeneralMixedAggregatePairedEndpoints] @@ -262,7 +220,13 @@ private theorem literalData : all_goals simp only [Fin.reduceAdd, Fin.reduceSucc, ↓reduceIte, one_smul] at h0 h1 h2 simp only [Fin.reduceSucc] at f0 f1 f2 - simp? [cert.period_u, cert.period_v, f0, f1, f2, w1, w2, w3] + simp only [Fin.mk_one, Fin.isValue, Fin.reduceAdd, Int.reduceNeg, one_ne_zero, + ↓reduceIte, cert.period_v, f1, w2, Zsqrtd.re_mul, Zsqrtd.re_sub, zero_mul, mul_one, + neg_mul, one_mul, zero_add, sub_neg_eq_add, Zsqrtd.im_sub, Zsqrtd.im_mul, neg_sub, + Int.cast_sub, GaussianInt.intCast_re, GaussianInt.intCast_im, Int.cast_add, one_div, + Fin.reduceSucc, w3, f2, cert.period_u, f0, w1, Zsqrtd.re_add, Zsqrtd.im_add, + Fin.succ_one_eq_two, smul_add, Fin.reduceFinMk, Fin.reduceEq, Zsqrtd.re_neg, + Zsqrtd.im_neg, neg_add_rev, Int.cast_neg, Fin.succ_zero_eq_one, Fin.zero_eta] have re := congrArg (fun z : GaussianInt => z.re) superbasis have im := congrArg (fun z : GaussianInt => z.im) superbasis have r0 := congrArg Prod.fst h0 @@ -271,8 +235,13 @@ private theorem literalData : have s1 := congrArg Prod.snd h1 have r2 := congrArg Prod.fst h2 have s2 := congrArg Prod.snd h2 - simp? [GaussianRealPoint, Prod.smul_mk, smul_eq_mul] at r0 s0 r1 s1 r2 s2 ⊢ - simp? at re im + simp only [Fin.isValue, Prod.fst_sub, one_div, GaussianRealPoint, Int.reduceNeg, + GaussianInt.intCast_re, GaussianInt.intCast_im, Prod.mk_sub_mk, sub_neg_eq_add, + Prod.smul_mk, smul_eq_mul, Prod.snd_sub, Zsqrtd.re_sub, Zsqrtd.re_mul, zero_mul, + mul_one, neg_mul, one_mul, zero_add, Int.cast_add, Zsqrtd.im_sub, Zsqrtd.im_mul, + Int.cast_sub, neg_sub, Prod.mk_add_mk] at r0 s0 r1 s1 r2 s2 ⊢ + simp only [Int.reduceNeg, Fin.isValue, Zsqrtd.re_add, Zsqrtd.re_zero, Zsqrtd.im_add, + Zsqrtd.im_zero] at re im have rr : ((BandVectors.1 (q 3) (q 2)).re : Real) + ((BandVectors.1 (q 1) (q 3)).re : Real) + ((BandVectors.1 (q 2) (q 1)).re : Real) = 0 := by exact_mod_cast re @@ -479,8 +448,13 @@ private theorem markedMembership : have h2 := rho_mem f 2 fin_cases i all_goals - simp? [pLit, qLit, markedPoint, f, SixSubtileFaceVertices, - SubtileOccurrenceInterpretation, trzero] at h0 h1 h2 ⊢ + simp only [SubtileOccurrenceInterpretation, SixSubtileFaceVertices, Fin.mk_one, + Fin.isValue, Fin.reduceEq, ↓reduceIte, zero_add, Matrix.cons_val_zero, Int.cast_zero, + zero_mul, add_zero, trzero, Matrix.cons_val_one, Int.cast_one, one_mul, + Matrix.cons_val, one_ne_zero, Fin.reduceAdd, Int.reduceNeg, Set.mem_inter_iff, + Fin.succ_one_eq_two, f, pLit, qLit, markedPoint, Fin.reduceFinMk, neg_add_cancel, + Int.cast_neg, neg_mul, Fin.reduceSucc, Fin.zero_eta, zero_ne_one, + Fin.succ_zero_eq_one] at h0 h1 h2 ⊢ · exact ⟨⟨⟨(cert.outer_occurrence 2 true).2.1 h2, h0⟩, h1⟩, (by rw [← cert.period_u] @@ -725,8 +699,13 @@ private theorem oddMembership : have h2 := rho_mem f 2 fin_cases i all_goals - simp? [pOdd, qOdd, oddPoint, show (-1 : Fin 3) = 2 by decide, - f, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, trzero] at h0 h1 h2 ⊢ + simp only [SubtileOccurrenceInterpretation, SixSubtileFaceVertices, Fin.mk_one, + Fin.isValue, one_ne_zero, ↓reduceIte, Fin.reduceEq, zero_sub, Int.reduceNeg, sub_self, + Matrix.cons_val_zero, Int.cast_zero, zero_mul, Int.cast_one, one_mul, zero_add, + Matrix.cons_val_one, Int.cast_neg, neg_mul, add_zero, Matrix.cons_val, trzero, + Set.mem_inter_iff, Fin.succ_one_eq_two, f, pOdd, qOdd, oddPoint, Fin.reduceFinMk, + Fin.reduceSub, Fin.reduceSucc, Fin.zero_eta, show (-1 : Fin 3) = 2 by decide, + Fin.succ_zero_eq_one] at h0 h1 h2 ⊢ · exact ⟨⟨⟨(cert.outer_occurrence 1 false).2.1 h1, h0⟩, h2⟩, (by rw [← cert.period_u] diff --git a/LeanPool/ApollonianSuperharmonic/P2999T1CompleteSquareTransport.lean b/LeanPool/ApollonianSuperharmonic/P2999T1CompleteSquareTransport.lean index 9ef3a808f9..687866ad0d 100644 --- a/LeanPool/ApollonianSuperharmonic/P2999T1CompleteSquareTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/P2999T1CompleteSquareTransport.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares diff --git a/LeanPool/ApollonianSuperharmonic/P2999T1OrthogonalSlopeTransport.lean b/LeanPool/ApollonianSuperharmonic/P2999T1OrthogonalSlopeTransport.lean index e345db5386..11af350b4c 100644 --- a/LeanPool/ApollonianSuperharmonic/P2999T1OrthogonalSlopeTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/P2999T1OrthogonalSlopeTransport.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P2999T1CompleteSquareTransport public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope diff --git a/LeanPool/ApollonianSuperharmonic/P2999T1ShiftSlopeTransport.lean b/LeanPool/ApollonianSuperharmonic/P2999T1ShiftSlopeTransport.lean index 8cefeb706b..10ca1d0560 100644 --- a/LeanPool/ApollonianSuperharmonic/P2999T1ShiftSlopeTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/P2999T1ShiftSlopeTransport.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction diff --git a/LeanPool/ApollonianSuperharmonic/P3019T1ChamberSegmentOrder.lean b/LeanPool/ApollonianSuperharmonic/P3019T1ChamberSegmentOrder.lean index 0036989d69..9caacce45a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3019T1ChamberSegmentOrder.lean +++ b/LeanPool/ApollonianSuperharmonic/P3019T1ChamberSegmentOrder.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P3019T1ChamberStripGeometry +public import Mathlib.Init +public import Mathlib.Data.List.Nodup public import Mathlib.Data.List.Chain -public import Mathlib.Data.List.Pairwise + +public import LeanPool.ApollonianSuperharmonic.P3019T1ChamberStripGeometry +public import LeanPool.ApollonianSuperharmonic.TriangularStripSegment -- [TABLET NODE: P3019T1ChamberSegmentOrder] diff --git a/LeanPool/ApollonianSuperharmonic/P3019T1ChamberStripGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3019T1ChamberStripGeometry.lean index 8df68bb985..c90e16f97b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3019T1ChamberStripGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3019T1ChamberStripGeometry.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.TriangularStripSegment +public import Mathlib.Init public import Mathlib.Tactic.Linarith +public import LeanPool.ApollonianSuperharmonic.TriangularBoundaryStrip +public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent + -- [TABLET NODE: P3019T1ChamberStripGeometry] /-! diff --git a/LeanPool/ApollonianSuperharmonic/P3019T1UnimodularStripWindow.lean b/LeanPool/ApollonianSuperharmonic/P3019T1UnimodularStripWindow.lean index 94d17f9760..c4f78de1aa 100644 --- a/LeanPool/ApollonianSuperharmonic/P3019T1UnimodularStripWindow.lean +++ b/LeanPool/ApollonianSuperharmonic/P3019T1UnimodularStripWindow.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3019T1ChamberStripGeometry public import Mathlib.Tactic.LinearCombination diff --git a/LeanPool/ApollonianSuperharmonic/P3045T1RightBoundaryDisplacementAlgebra.lean b/LeanPool/ApollonianSuperharmonic/P3045T1RightBoundaryDisplacementAlgebra.lean index 236b30d553..750e09051d 100644 --- a/LeanPool/ApollonianSuperharmonic/P3045T1RightBoundaryDisplacementAlgebra.lean +++ b/LeanPool/ApollonianSuperharmonic/P3045T1RightBoundaryDisplacementAlgebra.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: P3045T1RightBoundaryDisplacementAlgebra] diff --git a/LeanPool/ApollonianSuperharmonic/P3055T1ExteriorCentralIncidence.lean b/LeanPool/ApollonianSuperharmonic/P3055T1ExteriorCentralIncidence.lean index 73011cbb76..5b98d4515e 100644 --- a/LeanPool/ApollonianSuperharmonic/P3055T1ExteriorCentralIncidence.lean +++ b/LeanPool/ApollonianSuperharmonic/P3055T1ExteriorCentralIncidence.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Basic + public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence -- [TABLET NODE: P3055T1ExteriorCentralIncidence] diff --git a/LeanPool/ApollonianSuperharmonic/P3055T1ParentVectorNormalForms.lean b/LeanPool/ApollonianSuperharmonic/P3055T1ParentVectorNormalForms.lean index b6210b74e0..e2ab5fc3ad 100644 --- a/LeanPool/ApollonianSuperharmonic/P3055T1ParentVectorNormalForms.lean +++ b/LeanPool/ApollonianSuperharmonic/P3055T1ParentVectorNormalForms.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws diff --git a/LeanPool/ApollonianSuperharmonic/P3055T1SignedCentroidNormalForms.lean b/LeanPool/ApollonianSuperharmonic/P3055T1SignedCentroidNormalForms.lean index 5bdd370bca..407c173ece 100644 --- a/LeanPool/ApollonianSuperharmonic/P3055T1SignedCentroidNormalForms.lean +++ b/LeanPool/ApollonianSuperharmonic/P3055T1SignedCentroidNormalForms.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms diff --git a/LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean b/LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean index 766e71da5e..00acf3a720 100644 --- a/LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean +++ b/LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean @@ -5,13 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TopologicalDisk -public import Mathlib.Analysis.Normed.Group.Constructions public import Mathlib.Analysis.Normed.Module.Basic public import Mathlib.Topology.Order.Lattice -public import Mathlib.Topology.Homeomorph.Lemmas -public import Mathlib.Tactic.FieldSimp -public import Mathlib.Tactic.Linarith -- [TABLET NODE: P3092T1CenteredRectangleDisk] diff --git a/LeanPool/ApollonianSuperharmonic/P3092T1DiamondCenteredRectangles.lean b/LeanPool/ApollonianSuperharmonic/P3092T1DiamondCenteredRectangles.lean index 52870be7e4..2996028895 100644 --- a/LeanPool/ApollonianSuperharmonic/P3092T1DiamondCenteredRectangles.lean +++ b/LeanPool/ApollonianSuperharmonic/P3092T1DiamondCenteredRectangles.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondTile public import LeanPool.ApollonianSuperharmonic.TileRealization -public import Mathlib.Order.Interval.Finset.Nat -public import Mathlib.Algebra.Order.Floor.Semiring -public import Mathlib.Tactic.Linarith +public meta import Lean.Meta.Tactic.NormCast -- [TABLET NODE: P3092T1DiamondCenteredRectangles] diff --git a/LeanPool/ApollonianSuperharmonic/P3102T2CommonEdgeSectorTransition.lean b/LeanPool/ApollonianSuperharmonic/P3102T2CommonEdgeSectorTransition.lean index 3361664c04..55717c260a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3102T2CommonEdgeSectorTransition.lean +++ b/LeanPool/ApollonianSuperharmonic/P3102T2CommonEdgeSectorTransition.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell diff --git a/LeanPool/ApollonianSuperharmonic/P3102T2IsolatedRoutedCellSurvival.lean b/LeanPool/ApollonianSuperharmonic/P3102T2IsolatedRoutedCellSurvival.lean index 09723cc80f..88a2fe08e3 100644 --- a/LeanPool/ApollonianSuperharmonic/P3102T2IsolatedRoutedCellSurvival.lean +++ b/LeanPool/ApollonianSuperharmonic/P3102T2IsolatedRoutedCellSurvival.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation public import LeanPool.ApollonianSuperharmonic.FootprintVertices diff --git a/LeanPool/ApollonianSuperharmonic/P3102T2OppositeOwnersCommonEdge.lean b/LeanPool/ApollonianSuperharmonic/P3102T2OppositeOwnersCommonEdge.lean index 92540bfd9d..537e8c0eb9 100644 --- a/LeanPool/ApollonianSuperharmonic/P3102T2OppositeOwnersCommonEdge.lean +++ b/LeanPool/ApollonianSuperharmonic/P3102T2OppositeOwnersCommonEdge.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3102T2PeriodicFourSectorObstruction public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths diff --git a/LeanPool/ApollonianSuperharmonic/P3102T2PeriodicFourSectorObstruction.lean b/LeanPool/ApollonianSuperharmonic/P3102T2PeriodicFourSectorObstruction.lean index 86687a4e8c..c3cfe66b92 100644 --- a/LeanPool/ApollonianSuperharmonic/P3102T2PeriodicFourSectorObstruction.lean +++ b/LeanPool/ApollonianSuperharmonic/P3102T2PeriodicFourSectorObstruction.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition public import LeanPool.ApollonianSuperharmonic.PeriodicTileAdjacentContactRegularity public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure diff --git a/LeanPool/ApollonianSuperharmonic/P3161T1AggregateComplementConnectivity.lean b/LeanPool/ApollonianSuperharmonic/P3161T1AggregateComplementConnectivity.lean index 840c456df5..432e9d9ed8 100644 --- a/LeanPool/ApollonianSuperharmonic/P3161T1AggregateComplementConnectivity.lean +++ b/LeanPool/ApollonianSuperharmonic/P3161T1AggregateComplementConnectivity.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3161T1BlockTreeReachability public import LeanPool.ApollonianSuperharmonic.P3161T1SquareTriangleComplement diff --git a/LeanPool/ApollonianSuperharmonic/P3161T1AggregateInducedConnectivity.lean b/LeanPool/ApollonianSuperharmonic/P3161T1AggregateInducedConnectivity.lean index 4d2958cb8a..4c43c2ce0c 100644 --- a/LeanPool/ApollonianSuperharmonic/P3161T1AggregateInducedConnectivity.lean +++ b/LeanPool/ApollonianSuperharmonic/P3161T1AggregateInducedConnectivity.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.Finset.Card + public import LeanPool.ApollonianSuperharmonic.P3161T1BlockTreeReachability -- [TABLET NODE: P3161T1AggregateInducedConnectivity] diff --git a/LeanPool/ApollonianSuperharmonic/P3161T1BlockTreeReachability.lean b/LeanPool/ApollonianSuperharmonic/P3161T1BlockTreeReachability.lean index 83b3f9a526..5844be3a90 100644 --- a/LeanPool/ApollonianSuperharmonic/P3161T1BlockTreeReachability.lean +++ b/LeanPool/ApollonianSuperharmonic/P3161T1BlockTreeReachability.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import Mathlib.Init +public import Mathlib.Algebra.Group.Prod public import Mathlib.Logic.Relation +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence + -- [TABLET NODE: P3161T1BlockTreeReachability] /-! diff --git a/LeanPool/ApollonianSuperharmonic/P3161T1SquareTriangleComplement.lean b/LeanPool/ApollonianSuperharmonic/P3161T1SquareTriangleComplement.lean index 6ddd0a080a..fe04847f23 100644 --- a/LeanPool/ApollonianSuperharmonic/P3161T1SquareTriangleComplement.lean +++ b/LeanPool/ApollonianSuperharmonic/P3161T1SquareTriangleComplement.lean @@ -5,9 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble -public import Mathlib.Order.SuccPred.Int +public import Mathlib.Init +public import Mathlib.Algebra.Group.Prod +public import Mathlib.Data.Finset.Card public import Mathlib.Order.SuccPred.Relation +public import Mathlib.Tactic.NormNum + +public import Mathlib.Order.SuccPred.Int -- [TABLET NODE: P3161T1SquareTriangleComplement] diff --git a/LeanPool/ApollonianSuperharmonic/P3161T2IncidentBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3161T2IncidentBoundary.lean index 73d33e658b..b6690b2337 100644 --- a/LeanPool/ApollonianSuperharmonic/P3161T2IncidentBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P3161T2IncidentBoundary.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import Mathlib.Tactic.FinCases -- [TABLET NODE: P3161T2IncidentBoundary] diff --git a/LeanPool/ApollonianSuperharmonic/P3161T2PathExhaustion.lean b/LeanPool/ApollonianSuperharmonic/P3161T2PathExhaustion.lean index 0dd0ea03d6..0105ae154b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3161T2PathExhaustion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3161T2PathExhaustion.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween -public import Mathlib.Data.List.Basic -- [TABLET NODE: P3161T2PathExhaustion] diff --git a/LeanPool/ApollonianSuperharmonic/P3161T2PathSubwalk.lean b/LeanPool/ApollonianSuperharmonic/P3161T2PathSubwalk.lean index 21c684d31e..862472bdb5 100644 --- a/LeanPool/ApollonianSuperharmonic/P3161T2PathSubwalk.lean +++ b/LeanPool/ApollonianSuperharmonic/P3161T2PathSubwalk.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SimpleGridPath -public import Mathlib.Data.List.Basic -- [TABLET NODE: P3161T2PathSubwalk] diff --git a/LeanPool/ApollonianSuperharmonic/P3192T1FourOwnerTriangleExclusion.lean b/LeanPool/ApollonianSuperharmonic/P3192T1FourOwnerTriangleExclusion.lean index f9599599af..afd6014592 100644 --- a/LeanPool/ApollonianSuperharmonic/P3192T1FourOwnerTriangleExclusion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3192T1FourOwnerTriangleExclusion.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices public import LeanPool.ApollonianSuperharmonic.FootprintVertices diff --git a/LeanPool/ApollonianSuperharmonic/P3192T1PeriodicIndicesInfinite.lean b/LeanPool/ApollonianSuperharmonic/P3192T1PeriodicIndicesInfinite.lean index d1dd945da5..c03b9ddf7e 100644 --- a/LeanPool/ApollonianSuperharmonic/P3192T1PeriodicIndicesInfinite.lean +++ b/LeanPool/ApollonianSuperharmonic/P3192T1PeriodicIndicesInfinite.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne -public import Mathlib.Data.Set.Finite.Lattice -- [TABLET NODE: P3192T1PeriodicIndicesInfinite] diff --git a/LeanPool/ApollonianSuperharmonic/P3192T1SimplePathOrientation.lean b/LeanPool/ApollonianSuperharmonic/P3192T1SimplePathOrientation.lean index 0bb9e1d747..5b25954ec9 100644 --- a/LeanPool/ApollonianSuperharmonic/P3192T1SimplePathOrientation.lean +++ b/LeanPool/ApollonianSuperharmonic/P3192T1SimplePathOrientation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge diff --git a/LeanPool/ApollonianSuperharmonic/P3221T2ClosedWalkCirculation.lean b/LeanPool/ApollonianSuperharmonic/P3221T2ClosedWalkCirculation.lean index 6cc74cdf73..f3350029e6 100644 --- a/LeanPool/ApollonianSuperharmonic/P3221T2ClosedWalkCirculation.lean +++ b/LeanPool/ApollonianSuperharmonic/P3221T2ClosedWalkCirculation.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3221T2IntegralSquareFilling public import LeanPool.ApollonianSuperharmonic.P3221T2TileFillingSupport -public import Mathlib.Algebra.BigOperators.Group.List.Basic -public import Mathlib.Data.List.Chain -- [TABLET NODE: P3221T2ClosedWalkCirculation] diff --git a/LeanPool/ApollonianSuperharmonic/P3221T2ConnectedPathIntegration.lean b/LeanPool/ApollonianSuperharmonic/P3221T2ConnectedPathIntegration.lean index 479a085348..8354401802 100644 --- a/LeanPool/ApollonianSuperharmonic/P3221T2ConnectedPathIntegration.lean +++ b/LeanPool/ApollonianSuperharmonic/P3221T2ConnectedPathIntegration.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble -public import Mathlib.Combinatorics.SimpleGraph.Connectivity.Connected -public import Mathlib.Algebra.BigOperators.Group.List.Basic +public import Mathlib.Init +public import Mathlib.Algebra.Order.Ring.Int + +public import Mathlib.Combinatorics.SimpleGraph.Walk.Operations -- [TABLET NODE: P3221T2ConnectedPathIntegration] diff --git a/LeanPool/ApollonianSuperharmonic/P3221T2IntegralSquareFilling.lean b/LeanPool/ApollonianSuperharmonic/P3221T2IntegralSquareFilling.lean index 8b30d2d9c2..97bb2d4b56 100644 --- a/LeanPool/ApollonianSuperharmonic/P3221T2IntegralSquareFilling.lean +++ b/LeanPool/ApollonianSuperharmonic/P3221T2IntegralSquareFilling.lean @@ -5,11 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble -public import Mathlib.Data.Finsupp.Basic -public import Mathlib.Algebra.BigOperators.Group.Finset.Basic -public import Mathlib.Data.Set.Finite.Lattice +public import Mathlib.Init + public import Mathlib.Data.Int.Interval +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: P3221T2IntegralSquareFilling] diff --git a/LeanPool/ApollonianSuperharmonic/P3221T2TileFillingSupport.lean b/LeanPool/ApollonianSuperharmonic/P3221T2TileFillingSupport.lean index 444ba84fee..9db789b710 100644 --- a/LeanPool/ApollonianSuperharmonic/P3221T2TileFillingSupport.lean +++ b/LeanPool/ApollonianSuperharmonic/P3221T2TileFillingSupport.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.LatticeTileComplementGridConnected -public import Mathlib.Data.Finsupp.Basic -- [TABLET NODE: P3221T2TileFillingSupport] diff --git a/LeanPool/ApollonianSuperharmonic/P3350T1GraphCellUnionConnected.lean b/LeanPool/ApollonianSuperharmonic/P3350T1GraphCellUnionConnected.lean index fbc116c9e2..6e52be8544 100644 --- a/LeanPool/ApollonianSuperharmonic/P3350T1GraphCellUnionConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/P3350T1GraphCellUnionConnected.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition diff --git a/LeanPool/ApollonianSuperharmonic/P3381T1AffineTriangleMap.lean b/LeanPool/ApollonianSuperharmonic/P3381T1AffineTriangleMap.lean index afe9a620f6..899b4f1770 100644 --- a/LeanPool/ApollonianSuperharmonic/P3381T1AffineTriangleMap.lean +++ b/LeanPool/ApollonianSuperharmonic/P3381T1AffineTriangleMap.lean @@ -5,13 +5,12 @@ Authors: Wesley Pegden -/ module -public import Mathlib.Topology.Homeomorph.Lemmas -public import Mathlib.Topology.Instances.Real.Lemmas -public import Mathlib.Tactic.FunProp -public import Mathlib.Tactic.FieldSimp -public import Mathlib.Tactic.Ring -public import Mathlib.Tactic.Linarith +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public import Mathlib.Algebra.BigOperators.Fin +public import Mathlib.Topology.Algebra.Ring.Real -- [TABLET NODE: P3381T1AffineTriangleMap] diff --git a/LeanPool/ApollonianSuperharmonic/P3381T1PairedTriangulation.lean b/LeanPool/ApollonianSuperharmonic/P3381T1PairedTriangulation.lean index 59e69b31c8..4cf07d2e3a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3381T1PairedTriangulation.lean +++ b/LeanPool/ApollonianSuperharmonic/P3381T1PairedTriangulation.lean @@ -5,8 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.Set.Card +public import Mathlib.Topology.MetricSpace.Bounded + public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public import Mathlib.Analysis.Convex.Hull -- [TABLET NODE: P3381T1PairedTriangulation] diff --git a/LeanPool/ApollonianSuperharmonic/P3381T1PiecewiseAffinePolygonModel.lean b/LeanPool/ApollonianSuperharmonic/P3381T1PiecewiseAffinePolygonModel.lean index 1f1cb88cc5..0b39a0d1ee 100644 --- a/LeanPool/ApollonianSuperharmonic/P3381T1PiecewiseAffinePolygonModel.lean +++ b/LeanPool/ApollonianSuperharmonic/P3381T1PiecewiseAffinePolygonModel.lean @@ -5,10 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P3381T1AffineTriangleMap +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3381T1TriangulationBoundary -public import Mathlib.Analysis.Convex.Combination -public import Mathlib.Data.Set.Card -- [TABLET NODE: P3381T1PiecewiseAffinePolygonModel] diff --git a/LeanPool/ApollonianSuperharmonic/P3381T1PolygonBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3381T1PolygonBoundary.lean index cf6a09a4bf..1da6cd423a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3381T1PolygonBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P3381T1PolygonBoundary.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module -public import Mathlib.Analysis.Convex.Hull -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Topology.Basic +public import Mathlib.Basic.Real.Basic + +public import Mathlib.Analysis.Convex.Segment -- [TABLET NODE: P3381T1PolygonBoundary] diff --git a/LeanPool/ApollonianSuperharmonic/P3381T1TriangleDeterminant.lean b/LeanPool/ApollonianSuperharmonic/P3381T1TriangleDeterminant.lean index c83ecd224e..98a3401a8f 100644 --- a/LeanPool/ApollonianSuperharmonic/P3381T1TriangleDeterminant.lean +++ b/LeanPool/ApollonianSuperharmonic/P3381T1TriangleDeterminant.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Basic.Real.Basic + -- [TABLET NODE: P3381T1TriangleDeterminant] diff --git a/LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean index b0645b88be..2e04392892 100644 --- a/LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean @@ -5,19 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3381T1PairedTriangulation -public import LeanPool.ApollonianSuperharmonic.P3381T1AffineTriangleMap public import LeanPool.ApollonianSuperharmonic.P5662T1TriangulationBarycentricCoordinates public import Mathlib.Topology.Connected.PathConnected -public import Mathlib.Analysis.Convex.Topology -public import Mathlib.Tactic.FinCases -public import Mathlib.Tactic.NormNum -public import Mathlib.Analysis.Convex.Combination -public import Mathlib.Analysis.Convex.PathConnected -public import Mathlib.Data.Set.Card public import Mathlib.Analysis.Normed.Module.Convex -public import Mathlib.Algebra.Group.Fin.Basic -public import Mathlib.Tactic.LinearCombination -- [TABLET NODE: P3381T1TriangulationBoundary] diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1BoundaryReduction.lean b/LeanPool/ApollonianSuperharmonic/P3475T1BoundaryReduction.lean index 6f48ab6ba1..d79b73c65b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3475T1BoundaryReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/P3475T1BoundaryReduction.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3475T1BoundarySubdivision public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant public import LeanPool.ApollonianSuperharmonic.P3497T1SingleStraightDeletion diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1BoundaryRestoration.lean b/LeanPool/ApollonianSuperharmonic/P3475T1BoundaryRestoration.lean index 5e31664da6..107ef3df80 100644 --- a/LeanPool/ApollonianSuperharmonic/P3475T1BoundaryRestoration.lean +++ b/LeanPool/ApollonianSuperharmonic/P3475T1BoundaryRestoration.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3475T1BoundarySubdivision public import LeanPool.ApollonianSuperharmonic.P3475T1TriangleTree public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionGeometry diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1BoundarySubdivision.lean b/LeanPool/ApollonianSuperharmonic/P3475T1BoundarySubdivision.lean index 4dba76cf2b..a97038283b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3475T1BoundarySubdivision.lean +++ b/LeanPool/ApollonianSuperharmonic/P3475T1BoundarySubdivision.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary -- [TABLET NODE: P3475T1BoundarySubdivision] diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean index 19843736dd..8ecdbfac01 100644 --- a/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertexDegreeTwo public import LeanPool.ApollonianSuperharmonic.P5620T1BoundaryComponentCycle public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1PolygonTriangleConstruction.lean b/LeanPool/ApollonianSuperharmonic/P3475T1PolygonTriangleConstruction.lean index a991b9c662..70a910de33 100644 --- a/LeanPool/ApollonianSuperharmonic/P3475T1PolygonTriangleConstruction.lean +++ b/LeanPool/ApollonianSuperharmonic/P3475T1PolygonTriangleConstruction.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3475T1TriangleTree public import LeanPool.ApollonianSuperharmonic.P3511T1SourceConstruction public import LeanPool.ApollonianSuperharmonic.P3511T1ConvexComparison diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1PolygonalSeparation.lean b/LeanPool/ApollonianSuperharmonic/P3475T1PolygonalSeparation.lean index 4a656e85c4..091e0732dc 100644 --- a/LeanPool/ApollonianSuperharmonic/P3475T1PolygonalSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/P3475T1PolygonalSeparation.lean @@ -5,14 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3475T1TriangleTree -public import LeanPool.ApollonianSuperharmonic.P3381T1TriangulationBoundary -public import LeanPool.ApollonianSuperharmonic.P5662T1TriangulationBarycentricCoordinates public import LeanPool.ApollonianSuperharmonic.P3381T1PiecewiseAffinePolygonModel -public import LeanPool.ApollonianSuperharmonic.P3381T1AffineTriangleMap -public import Mathlib.Analysis.Convex.PathConnected -public import Mathlib.Analysis.Convex.Topology -public import Mathlib.Topology.Connected.Clopen -- [TABLET NODE: P3475T1PolygonalSeparation] diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1SquareUnionIdentification.lean b/LeanPool/ApollonianSuperharmonic/P3475T1SquareUnionIdentification.lean index 312dffb083..79b311390b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3475T1SquareUnionIdentification.lean +++ b/LeanPool/ApollonianSuperharmonic/P3475T1SquareUnionIdentification.lean @@ -5,18 +5,16 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary public import LeanPool.ApollonianSuperharmonic.P3475T1UnitSegmentIntersection -public import Mathlib.Analysis.Convex.Basic -public import Mathlib.Analysis.Convex.Segment public import Mathlib.Analysis.Convex.PathConnected -public import Mathlib.Topology.EMetricSpace.Lipschitz public import Mathlib.Topology.MetricSpace.Lipschitz -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.NormNum public import LeanPool.ApollonianSuperharmonic.TileRealization -- [TABLET NODE: P3475T1SquareUnionIdentification] @@ -137,9 +135,9 @@ private theorem east_center_segment_outside : simp only [TileRealization, Set.mem_iUnion] at htile rcases htile with ⟨c, hc, hq⟩ simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hq - simp? [cellCenter, - add_zero, - smul_eq_mul] at hq + simp only [Int.reduceNeg, GaussianInt.intCast_re, one_div, GaussianInt.intCast_im, + Prod.smul_mk, smul_eq_mul, map_add, map_one, Complex.add_re, Complex.one_re, + Complex.add_im, Complex.one_im, add_zero, Prod.mk_add_mk, cellCenter] at hq simp only [GaussianInt.toComplex_def] at hq norm_num [Complex.mul_re, Complex.mul_im] at hq have hreC : (GaussianInt.toComplex c).re = (c.re : Real) := by @@ -192,9 +190,10 @@ private theorem north_center_segment_outside : simp only [TileRealization, Set.mem_iUnion] at htile rcases htile with ⟨c, hc, hq⟩ simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] at hq - simp? [cellCenter, - Int.cast_zero, Int.cast_one, add_zero, - smul_eq_mul] at hq + simp only [Int.reduceNeg, GaussianInt.intCast_re, one_div, GaussianInt.intCast_im, + Prod.smul_mk, smul_eq_mul, map_add, Complex.add_re, GaussianInt.re_toComplex, + Int.cast_zero, add_zero, Complex.add_im, GaussianInt.im_toComplex, Int.cast_one, + Prod.mk_add_mk, cellCenter] at hq simp only [GaussianInt.toComplex_def] at hq norm_num [Complex.mul_re, Complex.mul_im] at hq have hreC : (GaussianInt.toComplex c).re = (c.re : Real) := @@ -270,7 +269,8 @@ private theorem center_not_tile : intro T cellCenter a ha htile simp only [TileRealization, Set.mem_iUnion] at htile obtain ⟨c, hc, hq⟩ := htile - simp? [ClosedSquareRealization, cellCenter, Prod.le_def] at hq + simp only [ClosedSquareRealization, Int.reduceNeg, GaussianInt.intCast_re, + GaussianInt.intCast_im, one_div, Set.mem_Icc, Prod.le_def, cellCenter] at hq have hreC : (GaussianInt.toComplex c).re = (c.re : Real) := (GaussianInt.intCast_re c).symm have himC : (GaussianInt.toComplex c).im = (c.im : Real) := @@ -370,7 +370,7 @@ private theorem list_center_transport : simp at hx | singleton a => intro hx hy _ _ - simp? at hx hy + simp only [List.head?_cons, Option.some.injEq, List.getLast?_singleton] at hx hy subst x subst y exact Iff.rfl @@ -731,8 +731,9 @@ private theorem east_same_center_segment_avoids : rw [segment_eq_image] refine ⟨q.2 - (a.im : Real), ⟨by linarith [hylo], by linarith [hyhi]⟩, ?_⟩ apply Prod.ext - · simp? [GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.re_one, - Int.cast_add, Int.cast_one, smul_eq_mul] + · simp only [Int.reduceNeg, GaussianInt.intCast_im, GaussianRealPoint, Zsqrtd.re_add, + Zsqrtd.re_one, Int.cast_add, GaussianInt.intCast_re, Int.cast_one, Zsqrtd.im_add, + Zsqrtd.im_one, add_zero, Prod.smul_mk, smul_eq_mul, Prod.mk_add_mk] rw [(GaussianInt.intCast_re a).symm, hqxMid] ring · simp [GaussianRealPoint, Zsqrtd.im_add, Zsqrtd.im_one, @@ -839,11 +840,13 @@ private theorem north_same_center_segment_avoids : rw [segment_eq_image] refine ⟨q.1 - (a.re : Real), ⟨by linarith [hxlo], by linarith [hxhi]⟩, ?_⟩ apply Prod.ext - · simp? [GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.re_one, - Int.cast_add, Int.cast_one, smul_eq_mul] + · simp only [Int.reduceNeg, GaussianInt.intCast_re, GaussianRealPoint, Zsqrtd.re_add, + add_zero, Zsqrtd.im_add, Int.cast_add, GaussianInt.intCast_im, Int.cast_one, + Prod.smul_mk, smul_eq_mul, Zsqrtd.re_one, Zsqrtd.im_one, Prod.mk_add_mk] ring - · simp? [GaussianRealPoint, Zsqrtd.im_add, Zsqrtd.im_one, - Int.cast_add, Int.cast_one, smul_eq_mul] + · simp only [Int.reduceNeg, GaussianInt.intCast_re, GaussianRealPoint, Zsqrtd.re_add, + add_zero, Zsqrtd.im_add, Int.cast_add, GaussianInt.intCast_im, Int.cast_one, + Prod.smul_mk, smul_eq_mul, Zsqrtd.re_one, Zsqrtd.im_one, Prod.mk_add_mk] rw [(GaussianInt.intCast_im a).symm, hqyMid] ring change q ∈ ⋃ i, segment ℝ (p.vertex i) (p.vertex (i + 1)) at hC @@ -873,8 +876,9 @@ private theorem north_same_center_segment_avoids : rw [hpoint] at hx linarith [hqx] · have hpoint : (GaussianRealPoint (a + ⟨0, 1⟩ + 1)).1 = (a.re : Real) + 1 := by - simp? [GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.re_one, - Int.cast_add, Int.cast_one, GaussianInt.intCast_re, add_assoc] + simp only [GaussianRealPoint, Int.reduceNeg, add_assoc, Zsqrtd.re_add, + Zsqrtd.re_one, zero_add, Int.cast_add, GaussianInt.intCast_re, Int.cast_one, + Zsqrtd.im_add, Zsqrtd.im_one, add_zero, GaussianInt.intCast_im] have hx := congrArg Prod.fst hqend rw [hpoint] at hx linarith [hqx] @@ -965,7 +969,7 @@ private theorem list_occupied_center_transport : simp at hx | singleton a => intro hx hy _ _ - simp? at hx hy + simp only [List.head?_cons, Option.some.injEq, List.getLast?_singleton] at hx hy subst x subst y exact Iff.rfl @@ -1196,15 +1200,14 @@ private theorem qSeedSide : rw [segment_eq_image] refine ⟨1 / 2, by norm_num, ?_⟩ apply Prod.ext - · simp? [qSeed, GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.im_add, - Zsqrtd.re_one, Zsqrtd.im_one, Int.cast_add, Int.cast_one, - add_zero, - smul_eq_mul] + · simp only [one_div, GaussianRealPoint, Int.reduceNeg, Zsqrtd.re_add, Zsqrtd.re_one, + Int.cast_add, GaussianInt.intCast_re, Int.cast_one, Zsqrtd.im_add, Zsqrtd.im_one, + add_zero, GaussianInt.intCast_im, Prod.smul_mk, smul_eq_mul, Prod.mk_add_mk, qSeed] rw [(GaussianInt.intCast_re seed).symm] ring - · simp? [qSeed, GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.im_add, - Zsqrtd.re_one, Zsqrtd.im_one, Int.cast_add, Int.cast_one, - add_zero, smul_eq_mul] + · simp only [one_div, GaussianRealPoint, Int.reduceNeg, Zsqrtd.re_add, Zsqrtd.re_one, + Int.cast_add, GaussianInt.intCast_re, Int.cast_one, Zsqrtd.im_add, Zsqrtd.im_one, + add_zero, GaussianInt.intCast_im, Prod.smul_mk, smul_eq_mul, Prod.mk_add_mk, qSeed] rw [(GaussianInt.intCast_im seed).symm] ring @@ -1377,8 +1380,9 @@ private theorem hrNotSide : rw [segment_eq_image] refine ⟨r.2 - (seed.im : Real), ⟨by linarith [hryLower], by linarith [hryUpper]⟩, ?_⟩ apply Prod.ext - · simp? [GaussianRealPoint, Zsqrtd.re_add, Zsqrtd.re_one, - Int.cast_add, Int.cast_one, smul_eq_mul] + · simp only [Int.reduceNeg, GaussianInt.intCast_im, GaussianRealPoint, Zsqrtd.re_add, + Zsqrtd.re_one, Int.cast_add, GaussianInt.intCast_re, Int.cast_one, Zsqrtd.im_add, + Zsqrtd.im_one, add_zero, Prod.smul_mk, smul_eq_mul, Prod.mk_add_mk] rw [hr, (GaussianInt.intCast_re seed).symm] ring · simp [GaussianRealPoint, Zsqrtd.im_add, Zsqrtd.im_one, @@ -1484,7 +1488,7 @@ private theorem tile_cover : · exact boundary_carrier_in_tile hqBoundary · let c : GaussianInt := ⟨Int.floor q.1, Int.floor q.2⟩ have hqSquare : q ∈ ClosedSquareRealization c := by - simp? [ClosedSquareRealization, c, Set.mem_Icc, Prod.le_def] + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, c] constructor · constructor · exact_mod_cast Int.floor_le q.1 diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1TriangleTree.lean b/LeanPool/ApollonianSuperharmonic/P3475T1TriangleTree.lean index 8a458c9147..a29f44fe5e 100644 --- a/LeanPool/ApollonianSuperharmonic/P3475T1TriangleTree.lean +++ b/LeanPool/ApollonianSuperharmonic/P3475T1TriangleTree.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3381T1PairedTriangulation -- [TABLET NODE: P3475T1TriangleTree] diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1UnitSegmentIntersection.lean b/LeanPool/ApollonianSuperharmonic/P3475T1UnitSegmentIntersection.lean index 07b73d377c..0ececc06c6 100644 --- a/LeanPool/ApollonianSuperharmonic/P3475T1UnitSegmentIntersection.lean +++ b/LeanPool/ApollonianSuperharmonic/P3475T1UnitSegmentIntersection.lean @@ -5,12 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint public import Mathlib.Analysis.Convex.Segment -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.NormNum -public import Mathlib.Tactic.Ring -- [TABLET NODE: P3475T1UnitSegmentIntersection] diff --git a/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean b/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean index b1aa68197f..e5ba7b309f 100644 --- a/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3475T1BoundarySubdivision public import LeanPool.ApollonianSuperharmonic.P3497T1StrictCornerSplice diff --git a/LeanPool/ApollonianSuperharmonic/P3497T1StrictCornerSplice.lean b/LeanPool/ApollonianSuperharmonic/P3497T1StrictCornerSplice.lean index 41f74b4770..b6dc55c714 100644 --- a/LeanPool/ApollonianSuperharmonic/P3497T1StrictCornerSplice.lean +++ b/LeanPool/ApollonianSuperharmonic/P3497T1StrictCornerSplice.lean @@ -5,12 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Linarith + public import Mathlib.Analysis.Convex.Basic public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant -public import Mathlib.Tactic.FieldSimp -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.NormNum -public import Mathlib.Tactic.Ring -- [TABLET NODE: P3497T1StrictCornerSplice] diff --git a/LeanPool/ApollonianSuperharmonic/P3497T1SubdivisionComposition.lean b/LeanPool/ApollonianSuperharmonic/P3497T1SubdivisionComposition.lean index 2cce41c98c..f32441184a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3497T1SubdivisionComposition.lean +++ b/LeanPool/ApollonianSuperharmonic/P3497T1SubdivisionComposition.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P3475T1BoundarySubdivision +public import Mathlib.Init public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.Ring + +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundarySubdivision -- [TABLET NODE: P3497T1SubdivisionComposition] diff --git a/LeanPool/ApollonianSuperharmonic/P3497T1TriangleCornerNonzero.lean b/LeanPool/ApollonianSuperharmonic/P3497T1TriangleCornerNonzero.lean index 171c48da5f..6abc1933a7 100644 --- a/LeanPool/ApollonianSuperharmonic/P3497T1TriangleCornerNonzero.lean +++ b/LeanPool/ApollonianSuperharmonic/P3497T1TriangleCornerNonzero.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3497T1StrictCornerSplice -public import Mathlib.Tactic.FinCases public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary -- [TABLET NODE: P3497T1TriangleCornerNonzero] diff --git a/LeanPool/ApollonianSuperharmonic/P3511T1AttachmentIntersection.lean b/LeanPool/ApollonianSuperharmonic/P3511T1AttachmentIntersection.lean index d524a1b464..4cb5b016c2 100644 --- a/LeanPool/ApollonianSuperharmonic/P3511T1AttachmentIntersection.lean +++ b/LeanPool/ApollonianSuperharmonic/P3511T1AttachmentIntersection.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble -public import Mathlib.Analysis.Convex.Hull +public import Mathlib.Init +public import Mathlib.Basic.Real.Basic public import Mathlib.Data.Set.Card +public import Mathlib.Analysis.Convex.Hull + -- [TABLET NODE: P3511T1AttachmentIntersection] /-! diff --git a/LeanPool/ApollonianSuperharmonic/P3511T1ConvexComparison.lean b/LeanPool/ApollonianSuperharmonic/P3511T1ConvexComparison.lean index 8ebb18b3c6..b16df9ae2a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3511T1ConvexComparison.lean +++ b/LeanPool/ApollonianSuperharmonic/P3511T1ConvexComparison.lean @@ -5,11 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3511T1SourceDissection public import LeanPool.ApollonianSuperharmonic.P3511T1ConvexRealization public import LeanPool.ApollonianSuperharmonic.P3555T2ParabolaHullFrontier public import LeanPool.ApollonianSuperharmonic.P3555T2SavedDissectionGeometry -public import Mathlib.Data.List.FinRange -- [TABLET NODE: P3511T1ConvexComparison] diff --git a/LeanPool/ApollonianSuperharmonic/P3511T1ConvexRealization.lean b/LeanPool/ApollonianSuperharmonic/P3511T1ConvexRealization.lean index 88c23a6a2f..0185943977 100644 --- a/LeanPool/ApollonianSuperharmonic/P3511T1ConvexRealization.lean +++ b/LeanPool/ApollonianSuperharmonic/P3511T1ConvexRealization.lean @@ -5,8 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary +public import Mathlib.Init +public import Mathlib.Topology.Basic +public import Mathlib.Topology.MetricSpace.Bounded + public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public import Mathlib.Analysis.Convex.Hull -- [TABLET NODE: P3511T1ConvexRealization] diff --git a/LeanPool/ApollonianSuperharmonic/P3511T1CyclicDissection.lean b/LeanPool/ApollonianSuperharmonic/P3511T1CyclicDissection.lean index bf189fe5d9..4d1a231371 100644 --- a/LeanPool/ApollonianSuperharmonic/P3511T1CyclicDissection.lean +++ b/LeanPool/ApollonianSuperharmonic/P3511T1CyclicDissection.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Data.Fin.VecNotation public import Mathlib.Data.List.Rotate -public import Mathlib.Data.List.OfFn + -- [TABLET NODE: P3511T1CyclicDissection] diff --git a/LeanPool/ApollonianSuperharmonic/P3511T1LeafOrder.lean b/LeanPool/ApollonianSuperharmonic/P3511T1LeafOrder.lean index ffa442de49..091c4c7a27 100644 --- a/LeanPool/ApollonianSuperharmonic/P3511T1LeafOrder.lean +++ b/LeanPool/ApollonianSuperharmonic/P3511T1LeafOrder.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3511T1SourceDissection -public import Mathlib.Data.List.FinRange -public import Mathlib.Data.List.TakeDrop -- [TABLET NODE: P3511T1LeafOrder] diff --git a/LeanPool/ApollonianSuperharmonic/P3511T1SourceConstruction.lean b/LeanPool/ApollonianSuperharmonic/P3511T1SourceConstruction.lean index 4f6098c2e2..97809f5a20 100644 --- a/LeanPool/ApollonianSuperharmonic/P3511T1SourceConstruction.lean +++ b/LeanPool/ApollonianSuperharmonic/P3511T1SourceConstruction.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3511T1SourceDissection -public import LeanPool.ApollonianSuperharmonic.P3544T1TriangleRayGeometry public import LeanPool.ApollonianSuperharmonic.P3544T1DiagonalSelection public import LeanPool.ApollonianSuperharmonic.P3544T1IndexedGluing -public import Mathlib.Tactic.FinCases -- [TABLET NODE: P3511T1SourceConstruction] @@ -96,8 +96,8 @@ theorem P3511T1SourceConstruction : simp [f, hneighbor] | succ m => obtain ⟨S⟩ := P3544T1DiagonalSelection q (Nat.succ_pos m) - obtain ⟨XL, ⟨L⟩, hL, hcL⟩ := ih S.left_n S.left_lt S.left - obtain ⟨XR, ⟨R⟩, hR, hcR⟩ := ih S.right_n S.right_lt S.right + obtain ⟨XL, ⟨L⟩, hL, hcL⟩ := ih S.leftParameter S.left_lt S.left + obtain ⟨XR, ⟨R⟩, hR, hcR⟩ := ih S.rightParameter S.right_lt S.right have hLfill := hL.trans (P3544T1LocalParity S.left).1 have hRfill := hR.trans (P3544T1LocalParity S.right).1 obtain ⟨Z, _hfaces, hfill, hpath⟩ := diff --git a/LeanPool/ApollonianSuperharmonic/P3511T1SourceDissection.lean b/LeanPool/ApollonianSuperharmonic/P3511T1SourceDissection.lean index a0462d0cd5..e850b68a04 100644 --- a/LeanPool/ApollonianSuperharmonic/P3511T1SourceDissection.lean +++ b/LeanPool/ApollonianSuperharmonic/P3511T1SourceDissection.lean @@ -5,10 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.Set.Card + public import LeanPool.ApollonianSuperharmonic.P3511T1CyclicDissection public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant -public import Mathlib.Data.Set.Card +public import Mathlib.Analysis.Convex.Hull -- [TABLET NODE: P3511T1SourceDissection] diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1BoundaryFaceSplit.lean b/LeanPool/ApollonianSuperharmonic/P3523T1BoundaryFaceSplit.lean index 8770a9053e..d40ef7e332 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1BoundaryFaceSplit.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1BoundaryFaceSplit.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionData +public import Mathlib.Init +public import Mathlib.Data.Finset.Union +public import Mathlib.Data.Finset.Card + -- [TABLET NODE: P3523T1BoundaryFaceSplit] diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1FaceEnumeration.lean b/LeanPool/ApollonianSuperharmonic/P3523T1FaceEnumeration.lean index a3008c924c..f2bd3f25c5 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1FaceEnumeration.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1FaceEnumeration.lean @@ -5,8 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionConstruction -public import Mathlib.Data.Fintype.EquivFin +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Data.Finset.Sort +public import Mathlib.Data.Finset.Card + +public import Mathlib.Algebra.Order.Algebra -- [TABLET NODE: P3523T1FaceEnumeration] diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionConstruction.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionConstruction.lean index 84d7cfb342..2f427d3983 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionConstruction.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionConstruction.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3523T1BoundaryFaceSplit -public import LeanPool.ApollonianSuperharmonic.P3523T1InterpolatedTarget -public import Mathlib.Data.Finset.Image +public import LeanPool.ApollonianSuperharmonic.P3475T1BoundarySubdivision +public import LeanPool.ApollonianSuperharmonic.P3475T1TriangleTree +public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionData -- [TABLET NODE: P3523T1InsertionConstruction] diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionData.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionData.lean index 673e033cd2..b449379812 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionData.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionData.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble -public import Mathlib.Data.Finset.Union +public import Mathlib.Init +public import Mathlib.Data.Finset.Card + -- [TABLET NODE: P3523T1InsertionData] diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean index be0a4b23a5..8e915fa198 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionIncidence public import LeanPool.ApollonianSuperharmonic.P3523T1TargetBoundary public import LeanPool.ApollonianSuperharmonic.P3523T1TargetHull diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean index 06866f73b4..adbc4c498f 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3523T1OrderedInsertion public import LeanPool.ApollonianSuperharmonic.P3523T1FaceEnumeration @@ -60,7 +62,7 @@ private theorem hsplit_card : rw [Finset.mem_biUnion] at hG rcases hG with ⟨F, hF, hG⟩ by_cases hp : a ∈ F ∧ b ∈ F - · simp? [hp] at hG + · simp only [hp, and_self, ↓reduceIte, Finset.mem_insert, Finset.mem_singleton] at hG rcases hG with hG | hG · subst G have hnot : d ∉ F.erase b := fun hx => hd F hF (Finset.mem_of_mem_erase hx) @@ -70,7 +72,7 @@ private theorem hsplit_card : have hnot : d ∉ F.erase a := fun hx => hd F hF (Finset.mem_of_mem_erase hx) rw [Finset.card_insert_of_notMem hnot, Finset.card_erase_of_mem hp.1] rw [hf F hF] - · simp? [hp] at hG + · simp only [hp, ↓reduceIte, Finset.mem_singleton] at hG subst G exact hf F hF @@ -90,7 +92,7 @@ private theorem hsplit_sub : rw [Finset.mem_biUnion] at hG rcases hG with ⟨F, hF, hG⟩ by_cases hp : a ∈ F ∧ b ∈ F - · simp? [hp] at hG + · simp only [hp, and_self, ↓reduceIte, Finset.mem_insert, Finset.mem_singleton] at hG rcases hG with hG | hG · subst G intro x hx @@ -104,7 +106,7 @@ private theorem hsplit_sub : rcases hx with rfl | hx · exact Or.inl rfl · exact Or.inr (hf F hF (Finset.mem_of_mem_erase hx)) - · simp? [hp] at hG + · simp only [hp, ↓reduceIte, Finset.mem_singleton] at hG subst G intro x hx simp only [Finset.mem_insert] @@ -613,9 +615,9 @@ private theorem hindexed_ledger : by_cases hbnd : {i, j} ∈ c.boundary c.steps.length · have hbSucc := (hboundary_final_pair i j hij).mp hbnd by_cases hex : ∃ F ∈ fs, i ∈ F ∧ j ∈ F - · simp? [hbnd, hbSucc] at h ⊢ + · simp only [hbnd, ↓reduceIte, hbSucc] at h ⊢ exact h - · simp? [hbnd, hbSucc] at h ⊢ + · simp only [hbnd, ↓reduceIte, hbSucc] at h ⊢ exact h · have hbSucc : ¬(j = i + 1 ∨ i = j + 1) := by intro hsucc @@ -626,7 +628,7 @@ private theorem hindexed_ledger : have hidx := (hindexed_exists i j).2 hex have hidx' : ∃ k : Fin fs.card, (∃ y, f k y = i) ∧ ∃ y, f k y = j := by simpa only [Set.mem_range] using hidx - simp? [hbnd, hbSucc, hex', hidx'] at h ⊢ + simp only [hbnd, ↓reduceIte, hex', hbSucc, Set.mem_range, hidx'] at h ⊢ exact h · have hidx : ¬∃ k : Fin fs.card, i ∈ Set.range (f k) ∧ j ∈ Set.range (f k) := by intro hk @@ -635,7 +637,8 @@ private theorem hindexed_ledger : simpa [fs] using hex have hidx' : ¬∃ k : Fin fs.card, (∃ y, f k y = i) ∧ ∃ y, f k y = j := by simpa only [Set.mem_range] using hidx - simp? [hbnd, hbSucc, hex', hidx'] at h ⊢ + simp only [hbnd, ↓reduceIte, hex', Finset.card_eq_zero, Finset.filter_eq_empty_iff, + not_and, hbSucc, Set.mem_range, hidx'] at h ⊢ exact h private theorem hboundary0_pair : @@ -842,7 +845,7 @@ private theorem hsplit_eq : by_cases hp : a ∈ H ∧ b ∈ H · have hEq := huniq H hH hp subst H - simp? [hpF] at hGH + simp only [hpF, and_self, ↓reduceIte, Finset.mem_insert, Finset.mem_singleton] at hGH rcases hGH with rfl | rfl · simp [FL, FR, hFL, hFLFR] · simp [FR, hFR] diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InterpolatedTarget.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InterpolatedTarget.lean index 8100d5d4da..ba13ca94cf 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1InterpolatedTarget.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InterpolatedTarget.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3475T1BoundarySubdivision public import LeanPool.ApollonianSuperharmonic.P3475T1TriangleTree diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean b/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean index 67cdef257e..f0b05e21ef 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean @@ -5,8 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Linarith + public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionConstruction public import LeanPool.ApollonianSuperharmonic.P3523T1SubdivisionExit +public import LeanPool.ApollonianSuperharmonic.P3523T1InterpolatedTarget /-! # P3523T1OrderedInsertion @@ -1294,18 +1298,11 @@ private theorem getNotTake : have hidx := hn.getElem_inj_iff.mp heq' omega -private theorem hkpos : - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary - n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real - × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (h : ℕ), ∀ [NeZero (n + (3 : ℕ))], - ∀ (j : Fin (n + (3 : ℕ))), ∀ (k : Fin (n + (3 : ℕ))), ∀ (hk : s.start (0 : Fin (r + (3 : ℕ))) - + k = j), ∀ (hparam : s.parameter j ≠ 0), ∀ (hp : (j - 1) + 1 = j), (∀ {α : Type}, ∀ (l : - List α), ∀ (p : α → Bool), ∀ (k : Nat), ∀ (h : Nat), ∀ (hn : l.Nodup), ∀ (hk : k < - l.length), ∀ (hpos : 0 < k), ∀ (hlen : h < (l.filter p).length), (p (l.get ⟨k - 1, - by omega⟩) = true) → (((l.filter p).get ⟨h, hlen⟩ = l.get ⟨k, hk⟩) → (l.get ⟨k - 1, - by omega⟩ ∈ (l.filter p).take h))) → (0 < k.val) := by +private theorem hkpos (r n : Nat) (q : P3381T1PolygonBoundary r) + (p : P3381T1PolygonBoundary n) (s : P3475T1BoundarySubdivision q p) + [NeZero (n + 3)] (j k : Fin (n + 3)) + (hk : s.start 0 + k = j) (hparam : s.parameter j ≠ 0) : 0 < k.val := by classical - intro r n q p s X K t h this j k hk hparam hp filterPrev by_contra hnot have hkval : k.val = 0 := by omega have hkz : k = 0 := Fin.ext hkval @@ -1313,37 +1310,21 @@ private theorem hkpos : have hjstart : j = s.start 0 := by simpa using hk.symm exact hparam (by rw [hjstart]; exact s.parameter_start 0) -private theorem hkprev : - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary - n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real - × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (h : ℕ), ∀ [NeZero (n + (3 : ℕ))], - ∀ (j : Fin (n + (3 : ℕ))), ∀ (k : Fin (n + (3 : ℕ))), ∀ (hp : (j - 1) + 1 = j), - let raw := List.ofFn (fun k : Fin (n + 3) => s.start 0 + k) - let kp : Fin (n + 3) := ⟨k.val - 1, by omega⟩ - (raw.length = n + 3) → ((0 < k.val) → (kp + 1 = k)) := by +private theorem hkprev (n : Nat) (k : Fin (n + 3)) (positive : 0 < k.val) : + let previous : Fin (n + 3) := ⟨k.val - 1, by omega⟩ + previous + 1 = k := by classical - intro r n q p s X K t h this j k hp raw kp hrawLen hkpos + intro previous apply Fin.ext - rw [Fin.val_add_eq_of_add_lt (by simp [kp]; omega)] - simp [kp] + rw [Fin.val_add_eq_of_add_lt (by simp [previous]; omega)] + simp [previous] omega -private theorem hprevLabel : - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary - n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real - × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (h : ℕ), ∀ [NeZero (n + (3 : ℕ))], - ∀ (j : Fin (n + (3 : ℕ))), ∀ (k : Fin (n + (3 : ℕ))), ∀ (hk : s.start (0 : Fin (r + (3 : ℕ))) - + k = j), ∀ (hp : (j - 1) + 1 = j), - let kp : Fin (n + 3) := ⟨k.val - 1, by omega⟩ - (kp + 1 = k) → (s.start 0 + kp = j - 1) := by - classical - intro r n q p s X K t h this j k hk hp kp hkprev - apply add_right_cancel - calc - (s.start 0 + kp) + 1 = s.start 0 + (kp + 1) := by simp [add_assoc] - _ = s.start 0 + k := by rw [hkprev] - _ = j := hk - _ = (j - 1) + 1 := hp.symm +private theorem hprevLabel {n : Nat} [NeZero n] + (start previous current target : Fin n) (step : previous + 1 = current) + (alignment : start + current = target) : start + previous = target - 1 := by + apply (eq_sub_iff_add_eq).2 + rw [add_assoc, step, alignment] private theorem hfilterCur : ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary @@ -1717,12 +1698,9 @@ theorem P3523T1OrderedInsertion {r n : Nat} let pred := fun z : Fin (n + 3) => decide (s.parameter z ≠ 0) let kp : Fin (n + 3) := ⟨k.val - 1, by omega⟩ have hrawLen : raw.length = n + 3 := by simp [raw] - have hkpos := OrderedInsertionDetails.hkpos r n q p s X K t h j k hk hparam - hp filterPrev - have hkprev := OrderedInsertionDetails.hkprev r n q p s X K t h j k hp - hrawLen hkpos - have hprevLabel := OrderedInsertionDetails.hprevLabel r n q p - s X K t h j k hk hp hkprev + have hkpos := OrderedInsertionDetails.hkpos r n q p s j k hk hparam + have hkprev := OrderedInsertionDetails.hkprev n k hkpos + have hprevLabel := OrderedInsertionDetails.hprevLabel (s.start 0) kp k j hkprev hk have hrawPrev := OrderedInsertionGeometry.hrawPrevAt546 r n q p s X K t h j k hp hrawLen hprevLabel have hrawCur := OrderedInsertionGeometry.hrawCurAt556 r n q p s j k hk hrawLen diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1SplitDeterminants.lean b/LeanPool/ApollonianSuperharmonic/P3523T1SplitDeterminants.lean index c38b6a551f..1fa4e0a0f3 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1SplitDeterminants.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1SplitDeterminants.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public import Mathlib.Init public import Mathlib.Data.Fin.VecNotation +public import Mathlib.Tactic.Ring + +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant -- [TABLET NODE: P3523T1SplitDeterminants] diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1SubdivisionExit.lean b/LeanPool/ApollonianSuperharmonic/P3523T1SubdivisionExit.lean index 2ea3137ad5..af9033972e 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1SubdivisionExit.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1SubdivisionExit.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3475T1BoundarySubdivision /-! diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean index cb63ed540a..f7d2aab244 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P3523T1OrderedInsertion +public import Mathlib.Init +public import Mathlib.Tactic.Linarith + +public import LeanPool.ApollonianSuperharmonic.P3523T1InterpolatedTarget -- [TABLET NODE: P3523T1TargetBoundary] diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1TargetHull.lean b/LeanPool/ApollonianSuperharmonic/P3523T1TargetHull.lean index 48f77778d6..07bbb1d412 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1TargetHull.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1TargetHull.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3523T1InterpolatedTarget -- [TABLET NODE: P3523T1TargetHull] diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean b/LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean index 54f81a7426..13208346d1 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Linarith + public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant public import Mathlib.Analysis.Convex.Hull public import Mathlib.Analysis.Convex.Combination -public import Mathlib.Data.Fin.VecNotation -- [TABLET NODE: P3523T1TwoTriangleSplit] @@ -88,7 +90,9 @@ private theorem hull3 (P Q R x : Real × Real) (hPQ : P ≠ Q) (hPR : P ≠ R) rw [Finset.mem_convexHull'] constructor · rintro ⟨w, hpos, hsum, hvec⟩ - simp? [Finset.sum_insert, hPQ, hPR, hQR] at hpos hsum hvec + simp only [Finset.mem_insert, Finset.mem_singleton, forall_eq_or_imp, forall_eq, hPQ, hPR, + or_self, not_false_eq_true, Finset.sum_insert, hQR, Finset.sum_singleton] + at hpos hsum hvec rcases hpos with ⟨hP, hQ, hR⟩ refine ⟨w P, w Q, w R, ?_, ?_, ?_, ?_, ?_⟩ · exact hP diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1BoundaryCarrier.lean b/LeanPool/ApollonianSuperharmonic/P3544T1BoundaryCarrier.lean index f216d4f398..866e567776 100644 --- a/LeanPool/ApollonianSuperharmonic/P3544T1BoundaryCarrier.lean +++ b/LeanPool/ApollonianSuperharmonic/P3544T1BoundaryCarrier.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3381T1PolygonBoundary -- [TABLET NODE: P3544T1BoundaryCarrier] diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSelection.lean b/LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSelection.lean index f7ed176504..cf14b96f5e 100644 --- a/LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSelection.lean +++ b/LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSelection.lean @@ -5,10 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3544T1DiagonalSplit -public import LeanPool.ApollonianSuperharmonic.P3650T1ExposedCorner -public import LeanPool.ApollonianSuperharmonic.P3650T1VisibleDiagonal -public import LeanPool.ApollonianSuperharmonic.P3650T1CyclicChildren public import LeanPool.ApollonianSuperharmonic.P3650T1ExposedCornerExists public import LeanPool.ApollonianSuperharmonic.P3650T1TriangleEntry public import LeanPool.ApollonianSuperharmonic.P3650T1EmptyTriangleDiagonal @@ -53,8 +52,8 @@ theorem P3544T1DiagonalSelection {n : Nat} (p : P3381T1PolygonBoundary n) obtain ⟨hsides, hendpoints⟩ := P3650T1LocalCoherence p D.a D.b D.distinct C D.odd hleft hright hsum exact ⟨{ - left_n := C.left_n - right_n := C.right_n + leftParameter := C.leftParameter + rightParameter := C.rightParameter left_lt := C.left_lt right_lt := C.right_lt left := C.left diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSplit.lean b/LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSplit.lean index 398ac2f7ec..63e8267fe9 100644 --- a/LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSplit.lean +++ b/LeanPool/ApollonianSuperharmonic/P3544T1DiagonalSplit.lean @@ -5,7 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public import LeanPool.ApollonianSuperharmonic.P3544T1RayParity +public import Mathlib.Analysis.Normed.Group.Basic +public import Mathlib.Data.EReal.Inv +public import Mathlib.Topology.Algebra.InfiniteSum.Order -- [TABLET NODE: P3544T1DiagonalSplit] @@ -58,19 +65,19 @@ is part of this split data. structure P3544T1DiagonalSplit {n : Nat} (p : P3381T1PolygonBoundary n) where -- BODY /-- The size parameter of the left child polygon. -/ - left_n : Nat + leftParameter : Nat /-- The size parameter of the right child polygon. -/ - right_n : Nat - left_lt : left_n < n - right_lt : right_n < n + rightParameter : Nat + left_lt : leftParameter < n + right_lt : rightParameter < n /-- The boundary following the first saved cyclic arc and the diagonal. -/ - left : P3381T1PolygonBoundary left_n + left : P3381T1PolygonBoundary leftParameter /-- The boundary following the complementary saved cyclic arc and the diagonal. -/ - right : P3381T1PolygonBoundary right_n + right : P3381T1PolygonBoundary rightParameter /-- Embed the left child labels into the original cyclic boundary. -/ - il : Fin (left_n + 3) → Fin (n + 3) + il : Fin (leftParameter + 3) → Fin (n + 3) /-- Embed the right child labels into the original cyclic boundary. -/ - ir : Fin (right_n + 3) → Fin (n + 3) + ir : Fin (rightParameter + 3) → Fin (n + 3) il_injective : Function.Injective il ir_injective : Function.Injective ir left_vertex : left.vertex = p.vertex ∘ il diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1IndexedGluing.lean b/LeanPool/ApollonianSuperharmonic/P3544T1IndexedGluing.lean index ef9261c9b6..ef3193c59d 100644 --- a/LeanPool/ApollonianSuperharmonic/P3544T1IndexedGluing.lean +++ b/LeanPool/ApollonianSuperharmonic/P3544T1IndexedGluing.lean @@ -5,12 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3544T1DiagonalSplit public import LeanPool.ApollonianSuperharmonic.P3511T1SourceDissection public import LeanPool.ApollonianSuperharmonic.P3652T1ChildFillSeparation public import LeanPool.ApollonianSuperharmonic.P3652T1ParentOddGluing public import LeanPool.ApollonianSuperharmonic.P3652T1DiagonalFaceIntersections -public import LeanPool.ApollonianSuperharmonic.P3652T1IndexedFaceLedger -- [TABLET NODE: P3544T1IndexedGluing] diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1LocalParity.lean b/LeanPool/ApollonianSuperharmonic/P3544T1LocalParity.lean index 3c0c8f750c..8839e25bf7 100644 --- a/LeanPool/ApollonianSuperharmonic/P3544T1LocalParity.lean +++ b/LeanPool/ApollonianSuperharmonic/P3544T1LocalParity.lean @@ -5,12 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3544T1RayParity public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant public import Mathlib.Topology.Connected.PathConnected -public import LeanPool.ApollonianSuperharmonic.P3597T1GenericRayStability -public import LeanPool.ApollonianSuperharmonic.P3597T1DirectionParity -public import LeanPool.ApollonianSuperharmonic.P3597T1SideCrossing public import LeanPool.ApollonianSuperharmonic.P3597T1VertexSectors -- [TABLET NODE: P3544T1LocalParity] diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1RayParity.lean b/LeanPool/ApollonianSuperharmonic/P3544T1RayParity.lean index 24d6e36bc4..9f5ccd2221 100644 --- a/LeanPool/ApollonianSuperharmonic/P3544T1RayParity.lean +++ b/LeanPool/ApollonianSuperharmonic/P3544T1RayParity.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P3544T1BoundaryCarrier +public import Mathlib.Init public import Mathlib.Data.Set.Card +public import LeanPool.ApollonianSuperharmonic.P3544T1BoundaryCarrier + -- [TABLET NODE: P3544T1RayParity] /-! diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean index 13c987c28a..e9d30044ba 100644 --- a/LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean @@ -5,17 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity -public import Mathlib.Analysis.Convex.Combination -public import Mathlib.Analysis.Convex.PathConnected -public import Mathlib.Tactic.FieldSimp -public import Mathlib.Tactic.FinCases -public import Mathlib.Tactic.FunProp -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.LinearCombination -public import Mathlib.Tactic.Module -public import Mathlib.Tactic.NormNum -public import Mathlib.Tactic.Ring -- [TABLET NODE: P3544T1TriangleRayGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean index 9f4f04480d..dba6753e49 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean @@ -5,12 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P3555T2ParabolaSupporting +public import Mathlib.Init +public import Mathlib.Tactic.Linarith + public import Mathlib.Analysis.Convex.Hull public import Mathlib.Analysis.Convex.Join -public import Mathlib.Data.List.Rotate -public import Mathlib.Data.List.OfFn -public import Mathlib.Data.List.NodupEquivFin +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant -- [TABLET NODE: P3555T2ParabolaChordCuts] @@ -256,7 +256,7 @@ private theorem hrankDiff : by_cases hwrap : x + (s-p) < m · rw [Nat.mod_eq_of_lt hwrap, show x + (s-p) + m - x = m + (s-p) by omega, Nat.add_mod] - simp? [Nat.mod_self] + simp only [Nat.mod_self, zero_add, dvd_refl, Nat.mod_mod_of_dvd] exact Nat.mod_eq_of_lt hd · have hwrap' : m ≤ x + (s-p) := by omega have hmod : (x + (s-p)) % m = x + (s-p) - m := by @@ -691,7 +691,8 @@ private theorem hrankV : simpa [hidx] using hji have hposB : ib < p := by apply Fin.lt_def.mpr - simp [ib, p] + dsimp [ib, p] + omega have hiaB : ia ≤ ib := by apply Fin.le_iff_val_le_val.mpr simp [ia, ib] diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean index 604917207c..7dedbc1a5c 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean @@ -5,11 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.P3555T2ParabolaSupporting public import Mathlib.Analysis.Convex.Topology -public import Mathlib.Analysis.Convex.Combination -public import Mathlib.Algebra.Order.Floor.Semiring public import LeanPool.ApollonianSuperharmonic.P3381T1AffineTriangleMap +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: P3555T2ParabolaHullFrontier] diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaSupporting.lean b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaSupporting.lean index c4d12ca8ee..8e6b0ffd6b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaSupporting.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaSupporting.lean @@ -5,7 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.Fin.VecNotation +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring + public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public meta import Lean.Meta.Tactic.NormCast -- [TABLET NODE: P3555T2ParabolaSupporting] diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean index f6f198dfd5..203ba97978 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3555T2ParabolaChordCuts public import LeanPool.ApollonianSuperharmonic.P3511T1CyclicDissection public import Mathlib.Analysis.Convex.Combination +public import LeanPool.ApollonianSuperharmonic.P3555T2ParabolaSupporting -- [TABLET NODE: P3555T2SavedDissectionGeometry] @@ -39,7 +42,7 @@ private theorem hsetAt164 : change (∃ i, i ∈ [a, b, c] ∧ q i = x) ↔ ∃ j : Fin 3, q (f j) = x constructor · rintro ⟨i, hi, hix⟩ - simp? at hi + simp only [List.mem_cons, List.not_mem_nil, or_false] at hi rcases hi with rfl | rfl | rfl · exact ⟨0, by simpa [f] using hix⟩ · exact ⟨1, by simpa [f] using hix⟩ @@ -356,8 +359,11 @@ private theorem hendpoint_intersection : · simp [hxa, hxb, haT, hbT] at hx rw [hSform] at hzS ⊢ rw [hTform] at hzT ⊢ - simp? [haS, hbS, haT, hbT, convexHull_pair, - ] at hzS hzT ⊢ + simp only [haS, ↓reduceIte, hbS, Set.image_empty, convexHull_empty, + Set.mem_empty_iff_false, Set.image_insert_eq, Set.image_singleton, convexHull_pair, + haT, hbT, Set.inter_self, convexHull_singleton, Set.mem_singleton_iff, + Set.mem_insert_iff, or_true, Set.inter_singleton_of_mem, true_or, + Set.singleton_inter_of_mem] at hzS hzT ⊢ all_goals first | exact hzS @@ -663,8 +669,8 @@ private theorem hfaces : private theorem hchildNextAt805 : ∀ (n : Nat), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : - ℕ)))), ∀ (v : List (Fin (n + (3 : ℕ)))), ∀ (k : Fin (a :: (u ++ b :: v)).length), ∀ - (hlenL : (a :: (u ++ b :: v)).length = u.length + v.length + 2), ∀ (hkA : (↑k : ℕ) ≤ + ℕ)))), ∀ (v : List (Fin (n + (3 : ℕ)))), ∀ (k : Fin (a :: (u ++ b :: v)).length), ∀ (hkA + : (↑k : ℕ) ≤ u.length), let iA : Fin (a :: (u ++ [b])).length := ⟨k.val, by have hlen : (a :: (u ++ [b])).length = u.length + 2 := by simp @@ -677,7 +683,7 @@ private theorem hchildNextAt805 : Nat.mod_lt _ (Nat.zero_lt_of_lt iA.isLt)⟩ = (a :: (u ++ [b])).get iA1) := by classical - intro n a b u v k hlenL hkA iA iA1 hk1Lt + intro n a b u v k hkA iA iA1 hk1Lt apply congrArg apply Fin.ext have hlen : (a :: (u ++ [b])).length = u.length + 2 := by simp @@ -775,7 +781,7 @@ private theorem hchildNextAt907 : apply Fin.ext have hlen : (b :: (v ++ [a])).length = v.length + 2 := by simp have hstep : iB.val + 1 < (b :: (v ++ [a])).length := by - have hvlen : v.length < (b :: (v ++ [a])).length := by simp + have hvlen : v.length < (b :: (v ++ [a])).length := by omega omega have hiB1 : iB1.val = iB.val + 1 := by dsimp [iB, iB1, k1]; omega exact (Nat.mod_eq_of_lt hstep).trans hiB1.symm @@ -973,8 +979,7 @@ private theorem leftBoundaryCase : rw [hnextIndex] _ = (a :: (u ++ [b])).get iA1 := by exact hAget k1 (by dsimp [k1]; omega) - have hchildNext := SavedDissectionProof.hchildNextAt805 n a b u v k - hlenL hkA hk1Lt + have hchildNext := SavedDissectionProof.hchildNextAt805 n a b u v k hkA hk1Lt have hincA := (hgoodA hndA hcycA).2.2.2.2 iA rcases hincA with ⟨f, hfA, huniqA⟩ have hfAfirst : (a :: (u ++ [b])).get iA ∈ Set.range f := hfA.2.1 diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean b/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean index 15f1c18355..7f5a6aead1 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3597T1GenericRayStability -- [TABLET NODE: P3597T1DirectionParity] diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1GenericRayStability.lean b/LeanPool/ApollonianSuperharmonic/P3597T1GenericRayStability.lean index 7544bbdd78..4e023bfe94 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1GenericRayStability.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1GenericRayStability.lean @@ -5,8 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P3544T1RayParity +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real +public import Mathlib.Algebra.CharZero.Infinite + public import Mathlib.Analysis.Convex.Topology +public import LeanPool.ApollonianSuperharmonic.P3544T1BoundaryCarrier -- [TABLET NODE: P3597T1GenericRayStability] @@ -47,7 +51,7 @@ private theorem genericRayDirection {n : Nat} (p : P3381T1PolygonBoundary n) : intro hz have hz' : w.2 - q * w.1 = 0 := by simpa [w] using hz by_cases hzero : w.1 = 0 - · simp? [hzero] at hz' + · simp only [hzero, mul_zero, sub_zero] at hz' exact hw (Prod.ext hzero hz') · apply hnot apply (eq_div_iff hzero).2 @@ -79,7 +83,7 @@ private theorem genericRayDirection {n : Nat} (p : P3381T1PolygonBoundary n) : intro hz have hz' : w.2 - q * w.1 = 0 := by simpa [w] using hz by_cases hzero : w.1 = 0 - · simp? [hzero] at hz' + · simp only [hzero, mul_zero, sub_zero] at hz' exact hw (Prod.ext hzero hz') · apply hnot apply (eq_div_iff hzero).2 diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean b/LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean index 2004c6bcf3..3f1cd266fc 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean @@ -5,16 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3597T1DirectionParity public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant -public import Mathlib.Tactic.FunProp -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.Ring -public import Mathlib.Topology.Algebra.GroupWithZero -public import Mathlib.Topology.MetricSpace.Algebra -public import Mathlib.Topology.Algebra.UniformRing -public import Mathlib.Analysis.Normed.Ring.Lemmas -public import Mathlib.Analysis.Normed.Module.Basic +public import LeanPool.ApollonianSuperharmonic.P3544T1RayParity +public import Mathlib.Analysis.Normed.Field.Basic +public import Mathlib.Analysis.Normed.Group.Uniform -- [TABLET NODE: P3597T1SideCrossing] @@ -668,7 +665,7 @@ private theorem hQline : field_simp [hsecond] have hy1 : y.1 = a.1 := by have : (y.1 - a.1) * (b.2 - a.2) = 0 := by - simp? [hfirst] at hF' + simp only [hfirst, zero_mul, zero_sub, zero_eq_neg, mul_eq_zero] at hF' rcases hF' with h | h · rw [h] ring diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean b/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean index 053432dcae..ba1e7cf672 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.P3597T1SideCrossing public import Mathlib.Topology.Connected.PathConnected -public import Mathlib.Analysis.Convex.Topology public import Mathlib.Analysis.Normed.Module.Convex public import Mathlib.Topology.LocallyConstant.Basic @@ -2206,7 +2208,7 @@ private theorem hprev : by_cases h : i.val = 0 · simp [prev, h] · have hiv := i.isLt - simp? [prev, h] + simp only [h, ↓reduceIte, Fin.coe_ofNat_eq_mod, Nat.one_mod, prev] rw [Nat.sub_add_cancel (Nat.one_le_iff_ne_zero.mpr h), Nat.mod_eq_of_lt hiv] private theorem hprevne : diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildren.lean b/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildren.lean index 0635865979..50f04d4f10 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildren.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildren.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3544T1BoundaryCarrier -- [TABLET NODE: P3650T1CyclicChildren] @@ -43,19 +45,19 @@ structure P3650T1CyclicChildren {n : Nat} (p : P3381T1PolygonBoundary n) (a b : Fin (n + 3)) where -- BODY /-- The size parameter of the left child polygon. -/ - left_n : Nat + leftParameter : Nat /-- The size parameter of the right child polygon. -/ - right_n : Nat - left_lt : left_n < n - right_lt : right_n < n + rightParameter : Nat + left_lt : leftParameter < n + right_lt : rightParameter < n /-- The boundary following the first saved cyclic arc and the diagonal. -/ - left : P3381T1PolygonBoundary left_n + left : P3381T1PolygonBoundary leftParameter /-- The boundary following the complementary saved cyclic arc and the diagonal. -/ - right : P3381T1PolygonBoundary right_n + right : P3381T1PolygonBoundary rightParameter /-- Embed the left child labels into the original cyclic boundary. -/ - il : Fin (left_n + 3) → Fin (n + 3) + il : Fin (leftParameter + 3) → Fin (n + 3) /-- Embed the right child labels into the original cyclic boundary. -/ - ir : Fin (right_n + 3) → Fin (n + 3) + ir : Fin (rightParameter + 3) → Fin (n + 3) il_injective : Function.Injective il ir_injective : Function.Injective ir left_vertex : left.vertex = p.vertex ∘ il diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean b/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean index 5897dd4569..5a009a5596 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3650T1CyclicChildren -- [TABLET NODE: P3650T1CyclicChildrenExists] @@ -708,7 +710,7 @@ private theorem hright_order (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab (by simpa only [List.length_ofFn] using hbound) have hirlast : ir ⟨N - k, hbound⟩ = a := by change rot ⟨posR ⟨N - k, hbound⟩, hposRlt _⟩ = a - simp? [posR] + simp only [↓reduceIte, Fin.zero_eta, posR] exact hrotzero simpa only [hpos] using hget.trans hirlast · have hjlt : j + 1 < N - k := by @@ -958,7 +960,7 @@ private theorem hopen_old_disjoint (n : Nat) (p : P3381T1PolygonBoundary n) (a : dsimp only [CyclicChildrenConstruction.N] at * intro hxj have hxC : x ∈ P3544T1BoundaryCarrier p := by - simp? [P3544T1BoundaryCarrier] + simp only [P3544T1BoundaryCarrier, Set.mem_iUnion] exact ⟨j, hxj⟩ exact (Set.disjoint_left.mp hclear) hx hxC @@ -2334,8 +2336,8 @@ theorem P3650T1CyclicChildrenExists {n : Nat} (p : P3381T1PolygonBoundary n) classical have hk_bounds := CyclicChildrenConstruction.hk_bounds n a b hab hnext hprev refine ⟨{ - left_n := (CyclicChildrenConstruction.leftN n a b) - right_n := (CyclicChildrenConstruction.rightN n a b) + leftParameter := (CyclicChildrenConstruction.leftN n a b) + rightParameter := (CyclicChildrenConstruction.rightN n a b) left_lt := (CyclicChildrenConstruction.hleftLt n a b hab hnext hprev) right_lt := (CyclicChildrenConstruction.hrightLt n a b hab hnext hprev) left := (CyclicChildrenConstruction.leftPoly n p a b hab hnext hprev hclear) diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean b/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean index f34204ab21..6bf4f8b5e6 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean @@ -5,13 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import Mathlib.LinearAlgebra.AffineSpace.FiniteDimensional public import LeanPool.ApollonianSuperharmonic.P3650T1VisibleDiagonal public import Mathlib.Analysis.Normed.Affine.AddTorsorBases -public import Mathlib.Analysis.Convex.Combination -public import Mathlib.Analysis.Convex.Topology -public import Mathlib.Topology.Order.IntermediateValue public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity -- [TABLET NODE: P3650T1EmptyTriangleDiagonal] diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCorner.lean b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCorner.lean index ef366d9289..dc0d293eac 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCorner.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCorner.lean @@ -5,7 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + +public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant +public import LeanPool.ApollonianSuperharmonic.P3544T1RayParity +public import Mathlib.Analysis.Normed.Group.Basic +public import Mathlib.Data.EReal.Inv +public import Mathlib.Topology.Algebra.InfiniteSum.Order -- [TABLET NODE: P3650T1ExposedCorner] diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean index 1ddf9d32f0..7f2e618614 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Order.Interval.Set.Infinite + public import LeanPool.ApollonianSuperharmonic.P3650T1ExposedCorner -public import Mathlib.Data.Set.Finite.Range -public import Mathlib.Tactic.Linarith +public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity -- [TABLET NODE: P3650T1ExposedCornerExists] @@ -430,7 +432,8 @@ private theorem hFc : F c = 0 ) := by classical intro n p v b B a c cross D L F - simp? [F, L, cross] + simp only [Prod.fst_sub, Prod.snd_sub, LinearMap.coe_mk, AddHom.coe_mk, mul_eq_zero, + inv_eq_zero, F, L, cross] left ring diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean b/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean index 9577344e62..65db7ac556 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3650T1CyclicChildren public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: P3650T1LocalCoherence] @@ -160,7 +163,7 @@ private theorem hidxL : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (C : P3650T1CyclicChildren p a b), ∀ t : Fin (n + 3), t ∈ ({a, b} : Set (Fin - (n + 3))) → ∃ i : Fin (C.left_n + 3), C.left.vertex i = p.vertex t ) := by + (n + 3))) → ∃ i : Fin (C.leftParameter + 3), C.left.vertex i = p.vertex t ) := by classical intro n p a b C t ht have ht' : t ∈ Set.range C.il ∩ Set.range C.ir := by @@ -177,7 +180,7 @@ private theorem hidxR : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (C : P3650T1CyclicChildren p a b), ∀ t : Fin (n + 3), t ∈ ({a, b} : Set (Fin - (n + 3))) → ∃ i : Fin (C.right_n + 3), C.right.vertex i = p.vertex t ) := by + (n + 3))) → ∃ i : Fin (C.rightParameter + 3), C.right.vertex i = p.vertex t ) := by classical intro n p a b C t ht have ht' : t ∈ Set.range C.il ∩ Set.range C.ir := by @@ -195,7 +198,7 @@ private theorem hidxLz : ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (C : P3650T1CyclicChildren p a b), ∀ (z : ℝ × ℝ), (z = p.vertex a ∨ z = p.vertex b) → ((∀ t : Fin (n + 3), t ∈ ({a, b} : Set (Fin (n + 3))) → ∃ i : Fin - (C.left_n + 3), C.left.vertex i = p.vertex t) → (∃ i : Fin (C.left_n + 3), + (C.leftParameter + 3), C.left.vertex i = p.vertex t) → (∃ i : Fin (C.leftParameter + 3), C.left.vertex i = z)) ) := by classical intro n p a b C z hzab hidxL @@ -212,7 +215,8 @@ private theorem hidxRz : ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (C : P3650T1CyclicChildren p a b), ∀ (z : ℝ × ℝ), (z = p.vertex a ∨ z = p.vertex b) → ((∀ t : Fin (n + 3), t ∈ ({a, b} : Set (Fin (n + 3))) → ∃ i : Fin - (C.right_n + 3), C.right.vertex i = p.vertex t) → (∃ i : Fin (C.right_n + 3), + (C.rightParameter + 3), C.right.vertex i = p.vertex t) → (∃ i : Fin (C.rightParameter + + 3), C.right.vertex i = z)) ) := by classical intro n p a b C z hzab hidxR @@ -303,7 +307,8 @@ private theorem hOLin : let OL := P3544T1RayParity C.left (Disjoint OL Cp) → ((∀ (O : Set (Real × Real)), ∀ (K : Set (Real × Real)), (closure O = O ∪ K) → ((IsOpen O) → (∀ (S : Set (Real × Real)), (IsPreconnected S) → ((Disjoint S K) - → (((S ∩ O).Nonempty) → (S ⊆ O)))))) → (∀ (z : ℝ × ℝ), ∀ (iL : Fin (C.left_n + (3 : + → (((S ∩ O).Nonempty) → (S ⊆ O)))))) → (∀ (z : ℝ × ℝ), ∀ (iL : Fin (C.leftParameter + + (3 : ℕ))), (C.left.vertex iL = z) → (∀ (rL : ℝ), (IsPathConnected (Metric.ball (C.left.vertex iL) rL ∩ P3544T1RayParity C.left)) → ((IsOpen Op) → ((closure Op = Op ∪ Cp) → ((((Metric.ball z rL ∩ OL) ∩ Op).Nonempty) → (Metric.ball z rL ∩ OL ⊆ @@ -330,7 +335,8 @@ private theorem hORin : let OR := P3544T1RayParity C.right (Disjoint OR Cp) → ((∀ (O : Set (Real × Real)), ∀ (K : Set (Real × Real)), (closure O = O ∪ K) → ((IsOpen O) → (∀ (S : Set (Real × Real)), (IsPreconnected S) → ((Disjoint S K) - → (((S ∩ O).Nonempty) → (S ⊆ O)))))) → (∀ (z : ℝ × ℝ), ∀ (iR : Fin (C.right_n + (3 : + → (((S ∩ O).Nonempty) → (S ⊆ O)))))) → (∀ (z : ℝ × ℝ), ∀ (iR : Fin (C.rightParameter + + (3 : ℕ))), (C.right.vertex iR = z) → (∀ (rR : ℝ), (IsPathConnected (Metric.ball (C.right.vertex iR) rR ∩ P3544T1RayParity C.right)) → ((IsOpen Op) → ((closure Op = Op ∪ Cp) → ((((Metric.ball z rR ∩ OR) ∩ Op).Nonempty) → (Metric.ball z rR ∩ OR ⊆ @@ -461,7 +467,7 @@ private theorem hlastL : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (C : P3650T1CyclicChildren p a b), - let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) + let ilast : Fin (C.leftParameter + 3) := Fin.last (C.leftParameter + 2) C.il ilast = b ) := by classical intro n p a b C ilast @@ -470,7 +476,7 @@ private theorem hlastL : (List.ofFn C.il).getLast? = some ((List.ofFn C.il).getLast (by simp)) := List.getLast?_eq_getLast_of_ne_nil (by simp) - _ = some (C.il (Fin.last (C.left_n + 2))) := + _ = some (C.il (Fin.last (C.leftParameter + 2))) := congrArg some (List.getLast_ofFn_succ C.il) _ = some (C.il ilast) := by simp [ilast] have ho : (List.ofFn C.il).getLast? = some b := by @@ -486,7 +492,7 @@ private theorem hlastR : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (C : P3650T1CyclicChildren p a b), - let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + let irlast : Fin (C.rightParameter + 3) := Fin.last (C.rightParameter + 2) C.ir irlast = a ) := by classical intro n p a b C irlast @@ -495,7 +501,7 @@ private theorem hlastR : (List.ofFn C.ir).getLast? = some ((List.ofFn C.ir).getLast (by simp)) := List.getLast?_eq_getLast_of_ne_nil (by simp) - _ = some (C.ir (Fin.last (C.right_n + 2))) := + _ = some (C.ir (Fin.last (C.rightParameter + 2))) := congrArg some (List.getLast_ofFn_succ C.ir) _ = some (C.ir irlast) := by simp [irlast] have ho : (List.ofFn C.ir).getLast? = some a := by @@ -511,7 +517,7 @@ private theorem hwrapL : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (C : P3650T1CyclicChildren p a b), - let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) + let ilast : Fin (C.leftParameter + 3) := Fin.last (C.leftParameter + 2) ilast + 1 = 0 ) := by classical intro n p a b C ilast @@ -524,7 +530,7 @@ private theorem hwrapR : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (C : P3650T1CyclicChildren p a b), - let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + let irlast : Fin (C.rightParameter + 3) := Fin.last (C.rightParameter + 2) irlast + 1 = 0 ) := by classical intro n p a b C irlast @@ -537,7 +543,7 @@ private theorem hleftB : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (C : P3650T1CyclicChildren p a b), - let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) + let ilast : Fin (C.leftParameter + 3) := Fin.last (C.leftParameter + 2) (C.il ilast = b) → (C.left.vertex ilast = p.vertex b) ) := by classical intro n p a b C ilast hlastL @@ -551,7 +557,7 @@ private theorem hleftA : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (C : P3650T1CyclicChildren p a b), - let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) + let ilast : Fin (C.leftParameter + 3) := Fin.last (C.leftParameter + 2) (C.il 0 = a) → ((ilast + 1 = 0) → (C.left.vertex (ilast + 1) = p.vertex a)) ) := by classical intro n p a b C ilast hfirstL hwrapL @@ -565,7 +571,7 @@ private theorem hrightA : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (C : P3650T1CyclicChildren p a b), - let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + let irlast : Fin (C.rightParameter + 3) := Fin.last (C.rightParameter + 2) (C.ir irlast = a) → (C.right.vertex irlast = p.vertex a) ) := by classical intro n p a b C irlast hlastR @@ -579,7 +585,7 @@ private theorem hrightB : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (C : P3650T1CyclicChildren p a b), - let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + let irlast : Fin (C.rightParameter + 3) := Fin.last (C.rightParameter + 2) (C.ir 0 = b) → ((irlast + 1 = 0) → (C.right.vertex (irlast + 1) = p.vertex b)) ) := by classical intro n p a b C irlast hfirstR hwrapR @@ -608,12 +614,13 @@ private theorem hcanonL : 3)), ∀ (C : P3650T1CyclicChildren p a b), let OL := P3544T1RayParity C.left ∀ (x : ℝ × ℝ), - let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) + let ilast : Fin (C.leftParameter + 3) := Fin.last (C.leftParameter + 2) (C.left.vertex ilast = p.vertex b) → ((C.left.vertex (ilast + 1) = p.vertex a) → (∀ (rL : ℝ), ∀ (sL : Bool), (∀ y ∈ Metric.ball x rL, y ∈ P3544T1RayParity C.left ↔ if sL = true then (0 : ℝ) < P3381T1TriangleDeterminant ![C.left.vertex ilast, C.left.vertex - (ilast + (1 : Fin (C.left_n + (3 : ℕ)))), y] else P3381T1TriangleDeterminant - ![C.left.vertex ilast, C.left.vertex (ilast + (1 : Fin (C.left_n + (3 : ℕ)))), y] < + (ilast + (1 : Fin (C.leftParameter + (3 : ℕ)))), y] else P3381T1TriangleDeterminant + ![C.left.vertex ilast, C.left.vertex (ilast + (1 : Fin (C.leftParameter + (3 : ℕ)))), + y] < (0 : ℝ)) → ( let H : Real × Real → Real := fun y => P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] @@ -634,13 +641,13 @@ private theorem hcanonR : 3)), ∀ (C : P3650T1CyclicChildren p a b), let OR := P3544T1RayParity C.right ∀ (x : ℝ × ℝ), - let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + let irlast : Fin (C.rightParameter + 3) := Fin.last (C.rightParameter + 2) (C.right.vertex irlast = p.vertex a) → ((C.right.vertex (irlast + 1) = p.vertex b) → (∀ (rR : ℝ), ∀ (sR : Bool), (∀ y ∈ Metric.ball x rR, y ∈ P3544T1RayParity C.right ↔ if sR = true then (0 : ℝ) < P3381T1TriangleDeterminant ![C.right.vertex irlast, - C.right.vertex (irlast + (1 : Fin (C.right_n + (3 : ℕ)))), y] else + C.right.vertex (irlast + (1 : Fin (C.rightParameter + (3 : ℕ)))), y] else P3381T1TriangleDeterminant ![C.right.vertex irlast, C.right.vertex (irlast + (1 : - Fin (C.right_n + (3 : ℕ)))), y] < (0 : ℝ)) → ( + Fin (C.rightParameter + (3 : ℕ)))), y] < (0 : ℝ)) → ( let H : Real × Real → Real := fun y => P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] ∀ y ∈ Metric.ball x rR, (y ∈ OR ↔ if sR then 0 < H y else H y < 0)))) ) := by @@ -686,19 +693,21 @@ private theorem hxdet : let OL := P3544T1RayParity C.left let OR := P3544T1RayParity C.right ∀ (x : ℝ × ℝ), (x ∈ openSegment ℝ (p.vertex a) (p.vertex b)) → ( - let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) - let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + let ilast : Fin (C.leftParameter + 3) := Fin.last (C.leftParameter + 2) + let irlast : Fin (C.rightParameter + 3) := Fin.last (C.rightParameter + 2) (x ∈ openSegment Real (C.left.vertex ilast) (C.left.vertex (ilast + 1))) → ((x ∈ openSegment Real (C.right.vertex irlast) (C.right.vertex (irlast + 1))) → (∀ (rL : ℝ), ∀ (sL : Bool), (∀ y ∈ Metric.ball x rL, y ∈ P3544T1RayParity C.left ↔ if sL = true then (0 : ℝ) < P3381T1TriangleDeterminant ![C.left.vertex ilast, C.left.vertex - (ilast + (1 : Fin (C.left_n + (3 : ℕ)))), y] else P3381T1TriangleDeterminant - ![C.left.vertex ilast, C.left.vertex (ilast + (1 : Fin (C.left_n + (3 : ℕ)))), y] < + (ilast + (1 : Fin (C.leftParameter + (3 : ℕ)))), y] else P3381T1TriangleDeterminant + ![C.left.vertex ilast, C.left.vertex (ilast + (1 : Fin (C.leftParameter + (3 : ℕ)))), + y] < (0 : ℝ)) → (∀ (rR : ℝ), ∀ (sR : Bool), (∀ y ∈ Metric.ball x rR, y ∈ P3544T1RayParity C.right ↔ if sR = true then (0 : ℝ) < P3381T1TriangleDeterminant - ![C.right.vertex irlast, C.right.vertex (irlast + (1 : Fin (C.right_n + (3 : ℕ)))), + ![C.right.vertex irlast, C.right.vertex (irlast + (1 : Fin (C.rightParameter + (3 : + ℕ)))), y] else P3381T1TriangleDeterminant ![C.right.vertex irlast, C.right.vertex (irlast - + (1 : Fin (C.right_n + (3 : ℕ)))), y] < (0 : ℝ)) → ( + + (1 : Fin (C.rightParameter + (3 : ℕ)))), y] < (0 : ℝ)) → ( let H : Real × Real → Real := fun y => P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] (∀ y ∈ Metric.ball x rL, (y ∈ OL ↔ if !sL then 0 < H y else H y < 0)) → ((∀ y ∈ @@ -867,17 +876,18 @@ private theorem hsignsOpp : let OL := P3544T1RayParity C.left let OR := P3544T1RayParity C.right ∀ (x : ℝ × ℝ), - let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) - let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + let ilast : Fin (C.leftParameter + 3) := Fin.last (C.leftParameter + 2) + let irlast : Fin (C.rightParameter + 3) := Fin.last (C.rightParameter + 2) ∀ (rL : ℝ), ∀ (sL : Bool), (∀ y ∈ Metric.ball x rL, y ∈ P3544T1RayParity C.left ↔ if sL = true then (0 : ℝ) < P3381T1TriangleDeterminant ![C.left.vertex ilast, - C.left.vertex (ilast + (1 : Fin (C.left_n + (3 : ℕ)))), y] else + C.left.vertex (ilast + (1 : Fin (C.leftParameter + (3 : ℕ)))), y] else P3381T1TriangleDeterminant ![C.left.vertex ilast, C.left.vertex (ilast + (1 : Fin - (C.left_n + (3 : ℕ)))), y] < (0 : ℝ)) → (∀ (rR : ℝ), ∀ (sR : Bool), (∀ y ∈ + (C.leftParameter + (3 : ℕ)))), y] < (0 : ℝ)) → (∀ (rR : ℝ), ∀ (sR : Bool), (∀ y ∈ Metric.ball x rR, y ∈ P3544T1RayParity C.right ↔ if sR = true then (0 : ℝ) < P3381T1TriangleDeterminant ![C.right.vertex irlast, C.right.vertex (irlast + (1 : - Fin (C.right_n + (3 : ℕ)))), y] else P3381T1TriangleDeterminant ![C.right.vertex - irlast, C.right.vertex (irlast + (1 : Fin (C.right_n + (3 : ℕ)))), y] < (0 : ℝ)) → ( + Fin (C.rightParameter + (3 : ℕ)))), y] else P3381T1TriangleDeterminant ![C.right.vertex + irlast, C.right.vertex (irlast + (1 : Fin (C.rightParameter + (3 : ℕ)))), y] < (0 : + ℝ)) → ( let H : Real × Real → Real := fun y => P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] (∀ y ∈ Metric.ball x rL, (y ∈ OL ↔ if !sL then 0 < H y else H y < 0)) → ((∀ y ∈ @@ -981,14 +991,18 @@ theorem P3650T1LocalCoherence {n : Nat} (p : P3381T1PolygonBoundary n) have hzclosure : z ∈ closure (openSegment Real (p.vertex a) (p.vertex b)) := LocalCoherenceProof.hzclosure n p a b z hzab have hidxL : ∀ t : Fin (n + 3), t ∈ ({a, b} : Set (Fin (n + 3))) → - ∃ i : Fin (C.left_n + 3), C.left.vertex i = p.vertex t := LocalCoherenceProof.hidxL n p a + ∃ i : Fin (C.leftParameter + 3), C.left.vertex i = p.vertex t := + LocalCoherenceProof.hidxL n p a b C have hidxR : ∀ t : Fin (n + 3), t ∈ ({a, b} : Set (Fin (n + 3))) → - ∃ i : Fin (C.right_n + 3), C.right.vertex i = p.vertex t := LocalCoherenceProof.hidxR n p + ∃ i : Fin (C.rightParameter + 3), C.right.vertex i = p.vertex t := + LocalCoherenceProof.hidxR n p a b C - have hidxLz : ∃ i : Fin (C.left_n + 3), C.left.vertex i = z := LocalCoherenceProof.hidxLz n p + have hidxLz : ∃ i : Fin (C.leftParameter + 3), C.left.vertex i = z := + LocalCoherenceProof.hidxLz n p a b C z hzab hidxL - have hidxRz : ∃ i : Fin (C.right_n + 3), C.right.vertex i = z := LocalCoherenceProof.hidxRz n + have hidxRz : ∃ i : Fin (C.rightParameter + 3), C.right.vertex i = z := + LocalCoherenceProof.hidxRz n p a b C z hzab hidxR obtain ⟨iL, hiL⟩ := hidxLz obtain ⟨iR, hiR⟩ := hidxRz @@ -1049,8 +1063,8 @@ theorem P3650T1LocalCoherence {n : Nat} (p : P3381T1PolygonBoundary n) (y ∈ OR ↔ if s then P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] < 0 else 0 < P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y]) := by intro x hx - let ilast : Fin (C.left_n + 3) := Fin.last (C.left_n + 2) - let irlast : Fin (C.right_n + 3) := Fin.last (C.right_n + 2) + let ilast : Fin (C.leftParameter + 3) := Fin.last (C.leftParameter + 2) + let irlast : Fin (C.rightParameter + 3) := Fin.last (C.rightParameter + 2) have hfirstL : C.il 0 = a := LocalCoherenceProof.hfirstL n p a b C have hfirstR : C.ir 0 = b := LocalCoherenceProof.hfirstR n p a b C have hlastL : C.il ilast = b := LocalCoherenceProof.hlastL n p a b C diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean b/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean index 4d0e5164ef..f2f199bc86 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean @@ -5,12 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3650T1VisibleDiagonal -public import LeanPool.ApollonianSuperharmonic.P3650T1TriangleEntry public import Mathlib.Analysis.Normed.Affine.AddTorsorBases -public import Mathlib.Analysis.Convex.Combination -public import Mathlib.Analysis.Convex.Topology -public import Mathlib.Topology.Connected.PathConnected +public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity +public import Mathlib.LinearAlgebra.AffineSpace.FiniteDimensional -- [TABLET NODE: P3650T1MaximalHeightDiagonal] diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean index eaa08e8389..ed7297df6c 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean @@ -5,12 +5,21 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3650T1VisibleDiagonal public import LeanPool.ApollonianSuperharmonic.P3650T1CyclicChildren -public import LeanPool.ApollonianSuperharmonic.P3650T1ParitySum -public import LeanPool.ApollonianSuperharmonic.P3650T1TriangleEntry public import LeanPool.ApollonianSuperharmonic.P3544T1TriangleRayGeometry public import LeanPool.ApollonianSuperharmonic.P5667T1CyclicChildrenOldArcsPreconnected +public import Mathlib.Algebra.Order.BigOperators.Expect +public import Mathlib.Algebra.Order.Field.Power +public import Mathlib.Algebra.Order.Ring.Star +public import Mathlib.Analysis.Normed.Group.AddTorsor +public import Mathlib.Analysis.Real.Sqrt +public import Mathlib.LinearAlgebra.AffineSpace.FiniteDimensional +public import Mathlib.Logic.Equiv.PartialEquiv +public import Mathlib.RingTheory.SimpleModule.Basic +public import Mathlib.Topology.Algebra.Module.ModuleTopology -- [TABLET NODE: P3650T1OldArcEven] @@ -211,7 +220,10 @@ private theorem leftFirstIndex : have hu0 : C.u[0]? = some (D.a + 1) := by simpa [List.getElem?_append, C.hu] using hrot1 have hleft1 := congrArg (fun l => l[1]?) C.left_order - simp? at hleft1 + simp only [List.ofFn_succ, Fin.succ_zero_eq_one, Fin.succ_one_eq_two, List.length_cons, + List.length_ofFn, lt_add_iff_pos_left, add_pos_iff, Order.lt_two_iff, zero_le, or_true, + getElem?_pos, List.getElem_cons_succ, List.getElem_cons_zero, List.length_append, + List.length_nil, zero_add, Order.lt_add_one_iff, Option.some.injEq] at hleft1 have hu0val : C.u[0]'C.hu = D.a + 1 := by have hopt := hu0 rw [List.getElem?_eq_getElem C.hu] at hopt @@ -289,7 +301,7 @@ private theorem cyclicStep : · rw [ite_eq_left hz] have hmod : m + 2 + (2 : Nat) = m + 3 + 1 := by omega norm_num [hmod, hz] - · simp? [hz] + · simp only [hz, ↓reduceIte, Fin.coe_ofNat_eq_mod, Nat.add_mod_mod] have hwrap : i.val + 1 = m + 3 ∨ i.val + 1 < m + 3 := by omega rcases hwrap with hwrap | hlt · have hleft : i.val - 1 + 2 = m + 3 := by omega @@ -532,7 +544,7 @@ private theorem rightPreviousParent : P3650T1VisibleDiagonal p E), (P3650T1CyclicChildren p D.a D.b) → (∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), ∀ (a : Fin (m + 3)), ∀ (b : Fin (m + 3)), ∀ (K : P3650T1CyclicChildren q a b), (K.rotation % (m + 3) = a.val) → (K.ir - ⟨K.right_n + 1, by omega⟩ = a - 1))) := by + ⟨K.rightParameter + 1, by omega⟩ = a - 1))) := by classical intro n p E D C m q a b K hrot have hidx : (m + 2 + K.rotation) % (m + 3) = (a - 1).val := by @@ -574,22 +586,22 @@ private theorem rightPreviousParent : exact List.getLast?_append_of_ne_nil [b] (List.ne_nil_of_length_pos K.hv) rw [K.parent_order, hparentlast] at hrotlast? have hvlast : K.v.getLast? = some (a-1) := hrotlast? - have hlenV : K.v.length = K.right_n + 1 := by + have hlenV : K.v.length = K.rightParameter + 1 := by have h := congrArg List.length K.right_order simp at h omega - have hget : (List.ofFn K.ir)[K.right_n+1]? = - some (K.ir ⟨K.right_n+1, by omega⟩) := by - have hbnd : K.right_n+1 < (List.ofFn K.ir).length := by simp + have hget : (List.ofFn K.ir)[K.rightParameter+1]? = + some (K.ir ⟨K.rightParameter+1, by omega⟩) := by + have hbnd : K.rightParameter+1 < (List.ofFn K.ir).length := by simp rw [List.getElem?_eq_getElem hbnd, List.getElem_ofFn hbnd] rw [K.right_order] at hget simp only [List.getElem?_cons_succ] at hget - rw [List.getElem?_append_left (by omega : K.right_n < K.v.length)] at hget - have hvget : K.v.getLast? = some (K.ir ⟨K.right_n+1, by omega⟩) := by + rw [List.getElem?_append_left (by omega : K.rightParameter < K.v.length)] at hget + have hvget : K.v.getLast? = some (K.ir ⟨K.rightParameter+1, by omega⟩) := by rw [List.getLast?_eq_getElem?] - rw [show K.v.length - 1 = K.right_n by omega] + rw [show K.v.length - 1 = K.rightParameter by omega] exact hget - have hright : some (a - 1) = some (K.ir ⟨K.right_n+1, by omega⟩) := + have hright : some (a - 1) = some (K.ir ⟨K.rightParameter+1, by omega⟩) := hvlast.symm.trans hvget have hne : K.v ≠ [] := List.ne_nil_of_length_pos K.hv have hright' := hright @@ -603,7 +615,7 @@ private theorem hbaseChild : P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (C.il 1 = D.a + 1) → ((∀ {m : Nat}, ∀ (i : Fin (m + 3)), (i - 1) + 2 = i + 1) → ((D.a = E.b - (1 : Fin (n + (3 : ℕ)))) → ((D.b = E.b + (1 : Fin (n + (3 : ℕ)))) → (C.u = [E.b] ∧ - C.left_n = 0)))) ) := by + C.leftParameter = 0)))) ) := by classical intro n p E D C leftFirstIndex cyclicStep ha hb have hN : 0 < n + 3 := by omega @@ -614,7 +626,9 @@ private theorem hbaseChild : conv_rhs at hrot0 => rw [List.getElem?_eq_getElem (Nat.mod_lt _ (by simp []))] rw [List.getElem_ofFn] - simp? at hrot0 + simp only [List.length_cons, List.length_append, lt_add_iff_pos_left, Order.lt_add_one_iff, + zero_le, getElem?_pos, List.getElem_cons_zero, zero_add, List.ofFn_succ, + Fin.succ_zero_eq_one, Fin.succ_one_eq_two, List.length_ofFn, Option.some.injEq] at hrot0 have hrLen : C.rotation % (List.ofFn (fun i : Fin (n + 3) => i)).length = D.a.val := by simpa only [hrotLen] using (congrArg Fin.val hrot0).symm have hr : C.rotation % (n + 3) = D.a.val := by simpa [hrotLen] using hrLen @@ -698,7 +712,7 @@ private theorem hbaseChild : have hposeq := (hnd.getElem_inj_iff).mp (hleftCell.trans hlast.symm) omega have huval : (C.u)[0]'(by omega) = E.b := by - have hleftn : 1 < C.left_n + 3 := by omega + have hleftn : 1 < C.leftParameter + 3 := by omega have hleftOrder := congrArg (fun l => l[1]?) C.left_order simp only [List.getElem?_ofFn, dite_eq_left hleftn] at hleftOrder simp only [List.getElem?_cons_succ, @@ -726,7 +740,8 @@ private theorem hleftIndices : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (D.a = E.b - - (1 : Fin (n + (3 : ℕ)))) → ((C.u = [E.b] ∧ C.left_n = 0) → (List.ofFn C.il = [D.a, + - (1 : Fin (n + (3 : ℕ)))) → ((C.u = [E.b] ∧ C.leftParameter = 0) → (List.ofFn C.il = + [D.a, E.b, D.b])) ) := by classical intro n p E D C ha hbaseChild @@ -810,13 +825,13 @@ private theorem hseedRAt680 : · intro hdiag exact middleNotSegment (by simpa [ha, hb, P3381T1TriangleDeterminant] using E.nondegenerate) hdiag - · let S : Finset Real := Finset.univ.image (fun i : Fin (C.right_n + 3) => + · let S : Finset Real := Finset.univ.image (fun i : Fin (C.rightParameter + 3) => E.ell (C.right.vertex i)) have hS : S.Nonempty := by refine ⟨E.ell (C.right.vertex 0), ?_⟩ exact Finset.mem_image.mpr ⟨0, Finset.mem_univ _, rfl⟩ let H := S.max' hS - have hbound (i : Fin (C.right_n + 3)) : E.ell (C.right.vertex i) < + have hbound (i : Fin (C.rightParameter + 3)) : E.ell (C.right.vertex i) < E.ell (p.vertex E.b) := by have hirne : C.ir i ≠ E.b := by intro heq @@ -839,7 +854,7 @@ private theorem hseedRAt680 : intro y hy rcases Finset.mem_image.mp hy with ⟨i, hi, rfl⟩ exact hbound i - have hbelow (i : Fin (C.right_n + 3)) : E.ell (C.right.vertex i) ≤ H := by + have hbelow (i : Fin (C.rightParameter + 3)) : E.ell (C.right.vertex i) ≤ H := by apply Finset.le_max' exact Finset.mem_image.mpr ⟨i, Finset.mem_univ _, rfl⟩ have hB : H < E.ell (p.vertex E.b) := hH @@ -862,7 +877,7 @@ private theorem hseedLAt728 : Fin (n + (3 : ℕ))), p.vertex i ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))} → i = E.b - (1 : Fin (n + (3 : ℕ))) ∨ i = - E.b ∨ i = E.b + (1 : Fin (n + (3 : ℕ)))) → ((C.u = [E.b] ∧ C.left_n = 0) → + E.b ∨ i = E.b + (1 : Fin (n + (3 : ℕ)))) → ((C.u = [E.b] ∧ C.leftParameter = 0) → ((Set.range C.il = {D.a, E.b, D.b}) → ((Set.range C.left.vertex = {p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)}) → (∃ x, x ∈ CR \ e ∧ x ∉ OL))))))))) ) := by @@ -876,9 +891,9 @@ private theorem hseedLAt728 : have hfirst : C.ir 0 = D.b := by have h := congrArg List.head? C.right_order simpa using h - have hlast : C.ir (Fin.last (C.right_n + 2)) = D.a := by + have hlast : C.ir (Fin.last (C.rightParameter + 2)) = D.a := by have hlast? : (List.ofFn C.ir).getLast? = - some (C.ir (Fin.last (C.right_n + 2))) := by + some (C.ir (Fin.last (C.rightParameter + 2))) := by rw [List.getLast?_eq_getLast_of_ne_nil (by simp)] rw [List.getLast_ofFn_succ] have h := congrArg List.getLast? C.right_order @@ -890,18 +905,18 @@ private theorem hseedLAt728 : simp rw [hrhs] at h exact Option.some.inj h - have hii : (1 : Fin (C.right_n + 3)) ≠ Fin.last (C.right_n + 2) := by + have hii : (1 : Fin (C.rightParameter + 3)) ≠ Fin.last (C.rightParameter + 2) := by intro he have hv := congrArg Fin.val he simp at hv - have heq' : C.ir 1 = C.ir (Fin.last (C.right_n + 2)) := heq.trans hlast.symm + have heq' : C.ir 1 = C.ir (Fin.last (C.rightParameter + 2)) := heq.trans hlast.symm exact hii (C.ir_injective heq') have hjneB : j ≠ D.b := by intro heq have hfirst : C.ir 0 = D.b := by have h := congrArg List.head? C.right_order simpa using h - have hi' : (1 : Fin (C.right_n + 3)) ≠ 0 := by + have hi' : (1 : Fin (C.rightParameter + 3)) ≠ 0 := by intro he have hv := congrArg Fin.val he norm_num at hv @@ -1291,7 +1306,7 @@ private theorem hrightLast : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), C.ir - (Fin.last (C.right_n + 2)) = D.a ) := by + (Fin.last (C.rightParameter + 2)) = D.a ) := by classical intro n p E D C have hlast? : (List.ofFn C.ir).getLast? = some (C.ir (Fin.last _)) := by @@ -1325,7 +1340,7 @@ private theorem hleftLast : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), C.il - (Fin.last (C.left_n + 2)) = D.b ) := by + (Fin.last (C.leftParameter + 2)) = D.b ) := by classical intro n p E D C have hlast? : (List.ofFn C.il).getLast? = some (C.il (Fin.last _)) := by @@ -1833,7 +1848,8 @@ private theorem hrightCenterAt1156 : P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (D.a = E.b) → ( let vb := p.vertex E.b - (C.ir (Fin.last (C.right_n + 2)) = D.a) → (C.right.vertex (Fin.last (C.right_n + 2)) = + (C.ir (Fin.last (C.rightParameter + 2)) = D.a) → (C.right.vertex (Fin.last + (C.rightParameter + 2)) = vb)) ) := by classical intro n p E D C ha vb hrightLast @@ -1858,7 +1874,7 @@ private theorem hrightWrap : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), Fin.last - (C.right_n + 2) + 1 = (0 : Fin (C.right_n + 3)) ) := by + (C.rightParameter + 2) + 1 = (0 : Fin (C.rightParameter + 3)) ) := by classical intro n p E D C apply Fin.ext @@ -1871,7 +1887,7 @@ private theorem hrightIncidentPrevAt1166 : ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), let va := p.vertex (E.b - 1) - (C.ir ⟨C.right_n+1, by omega⟩ = E.b - 1) → (C.right.vertex ⟨C.right_n + 1, + (C.ir ⟨C.rightParameter+1, by omega⟩ = E.b - 1) → (C.right.vertex ⟨C.rightParameter + 1, by omega⟩ = va)) := by classical intro n p E D C va hrightPrev @@ -1921,19 +1937,22 @@ private theorem havoidAt1176 : i (AffineMap.lineMap x y t) = (1 - t) * A.coord i x + t * A.coord i y) → (∀ (r₀ : ℝ), let r : Real := min r₀ 1 - (∀ x ∈ Metric.ball (C.right.vertex (Fin.last (C.right_n + (2 : ℕ)))) r, x ∉ ⋃ - (j : Fin (C.right_n + (3 : ℕ))), if j ≠ Fin.last (C.right_n + (2 : ℕ)) ∧ j + (1 : Fin - (C.right_n + (3 : ℕ))) ≠ Fin.last (C.right_n + (2 : ℕ)) then segment ℝ - (C.right.vertex j) (C.right.vertex (j + (1 : Fin (C.right_n + (3 : ℕ))))) else ∅) → ( + (∀ x ∈ Metric.ball (C.right.vertex (Fin.last (C.rightParameter + (2 : ℕ)))) r, x ∉ ⋃ + (j : Fin (C.rightParameter + (3 : ℕ))), if j ≠ Fin.last (C.rightParameter + (2 : ℕ)) + ∧ j + (1 : Fin + (C.rightParameter + (3 : ℕ))) ≠ Fin.last (C.rightParameter + (2 : ℕ)) then segment ℝ + (C.right.vertex j) (C.right.vertex (j + (1 : Fin (C.rightParameter + (3 : ℕ))))) else + ∅) → ( let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) let δ : Real := min δ₀ (1/2) let U : Real × Real := AffineMap.lineMap vb va (-δ) let X : Real × Real := AffineMap.lineMap vb vc δ let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t (0 < δ) → ((∀ (t : Real), A.coord 0 (γ t) = -(1-t)*δ) → ((∀ (t : Real), A.coord 2 (γ t) = - t*δ) → ((C.right.vertex (Fin.last (C.right_n - + 2)) = vb) → ((C.right.vertex 0 = p.vertex D.b) → ((Fin.last (C.right_n + 2) + 1 = - (0 : Fin (C.right_n + 3))) → ((C.right.vertex ⟨C.right_n + t*δ) → ((C.right.vertex (Fin.last (C.rightParameter + + 2)) = vb) → ((C.right.vertex 0 = p.vertex D.b) → ((Fin.last (C.rightParameter + 2) + + 1 = + (0 : Fin (C.rightParameter + 3))) → ((C.right.vertex ⟨C.rightParameter + 1, by omega⟩ = va) → ((∀ (t : Real), (t ∈ Set.Icc (0 : Real) 1) → (γ t ∈ Metric.ball vb r)) → (∀ t ∈ Set.Icc (0 : Real) 1, γ t ∉ CR)))))))))))))))) := by classical @@ -1942,19 +1961,19 @@ private theorem havoidAt1176 : hrightIncidentPrev hballPath t ht hcarrier have hnear' := hnear (γ t) (by rw [hrightCenter]; exact hballPath t ht) obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hcarrier - have hinc : i = Fin.last (C.right_n + 2) ∨ - i + 1 = Fin.last (C.right_n + 2) := by + have hinc : i = Fin.last (C.rightParameter + 2) ∨ + i + 1 = Fin.last (C.rightParameter + 2) := by by_contra hn - have hnot : i ≠ Fin.last (C.right_n + 2) ∧ - i + 1 ≠ Fin.last (C.right_n + 2) := by + have hnot : i ≠ Fin.last (C.rightParameter + 2) ∧ + i + 1 ≠ Fin.last (C.rightParameter + 2) := by constructor · intro he exact hn (Or.inl he) · intro he exact hn (Or.inr he) have hsegment : - γ t ∈ (if i ≠ Fin.last (C.right_n + 2) ∧ - i + 1 ≠ Fin.last (C.right_n + 2) then + γ t ∈ (if i ≠ Fin.last (C.rightParameter + 2) ∧ + i + 1 ≠ Fin.last (C.rightParameter + 2) then segment Real (C.right.vertex i) (C.right.vertex (i + 1)) else ∅) := by rw [ite_eq_left hnot] exact hi @@ -1985,24 +2004,24 @@ private theorem havoidAt1176 : rw [ht1] at h2 simp at h2 exact (ne_of_gt hδ) h2.symm - · have hidx : i = ⟨C.right_n + 1, by omega⟩ := by + · have hidx : i = ⟨C.rightParameter + 1, by omega⟩ := by have hv0 := congrArg Fin.val hprevEdge - have hnotlast : i ≠ Fin.last (C.right_n + 2) := by + have hnotlast : i ≠ Fin.last (C.rightParameter + 2) := by intro he rw [he, Fin.val_add_one] at hv0 simp at hv0 - have hv : i.val + 1 = C.right_n + 2 := by + have hv : i.val + 1 = C.rightParameter + 2 := by simpa [Fin.val_add_one, hnotlast] using hv0 - have hv' : i.val + 1 = (C.right_n + 1) + 1 := by + have hv' : i.val + 1 = (C.rightParameter + 1) + 1 := by simpa [Nat.add_assoc] using hv exact Fin.ext (Nat.add_right_cancel hv') rw [hidx] at hi have hnextLast : - (⟨C.right_n + 1, by omega⟩ : Fin (C.right_n + 3)) + 1 = - Fin.last (C.right_n + 2) := by + (⟨C.rightParameter + 1, by omega⟩ : Fin (C.rightParameter + 3)) + 1 = + Fin.last (C.rightParameter + 2) := by apply Fin.ext - have hne : (⟨C.right_n + 1, by omega⟩ : Fin (C.right_n + 3)) ≠ - Fin.last (C.right_n + 2) := by + have hne : (⟨C.rightParameter + 1, by omega⟩ : Fin (C.rightParameter + 3)) ≠ + Fin.last (C.rightParameter + 2) := by intro he have hv := congrArg Fin.val he simp at hv @@ -2517,7 +2536,7 @@ private theorem hleftWrap : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), Fin.last - (C.left_n + 2) + 1 = (0 : Fin (C.left_n + 3)) ) := by + (C.leftParameter + 2) + 1 = (0 : Fin (C.leftParameter + 3)) ) := by classical intro n p E D C apply Fin.ext @@ -2529,7 +2548,8 @@ private theorem hleftEnd : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (C.il - (Fin.last (C.left_n + 2)) = D.b) → (C.left.vertex (Fin.last (C.left_n + 2)) = + (Fin.last (C.leftParameter + 2)) = D.b) → (C.left.vertex (Fin.last (C.leftParameter + + 2)) = p.vertex D.b) ) := by classical intro n p E D C hleftLast @@ -2580,18 +2600,21 @@ private theorem havoidAt1419 : Real), ∀ (t : Real), A.coord i (AffineMap.lineMap x y t) = (1 - t) * A.coord i x + t * A.coord i y) → (∀ (r₀ : ℝ), let r : Real := min r₀ 1 - (∀ x ∈ Metric.ball (C.left.vertex (0 : Fin (C.left_n + (3 : ℕ)))) r, x ∉ ⋃ (j : Fin - (C.left_n + (3 : ℕ))), if j ≠ (0 : Fin (C.left_n + (3 : ℕ))) ∧ j + (1 : Fin (C.left_n - + (3 : ℕ))) ≠ (0 : Fin (C.left_n + (3 : ℕ))) then segment ℝ (C.left.vertex j) - (C.left.vertex (j + (1 : Fin (C.left_n + (3 : ℕ))))) else ∅) → ( + (∀ x ∈ Metric.ball (C.left.vertex (0 : Fin (C.leftParameter + (3 : ℕ)))) r, x ∉ ⋃ (j : Fin + (C.leftParameter + (3 : ℕ))), if j ≠ (0 : Fin (C.leftParameter + (3 : ℕ))) ∧ j + (1 : + Fin (C.leftParameter + + (3 : ℕ))) ≠ (0 : Fin (C.leftParameter + (3 : ℕ))) then segment ℝ (C.left.vertex j) + (C.left.vertex (j + (1 : Fin (C.leftParameter + (3 : ℕ))))) else ∅) → ( let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) let δ : Real := min δ₀ (1/2) let U : Real × Real := AffineMap.lineMap vb vc (-δ) let X : Real × Real := AffineMap.lineMap vb va δ let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t (0 < δ) → ((∀ (t : Real), A.coord 0 (γ t) = t*δ) → ((∀ (t : Real), A.coord 2 (γ t) = - -(1-t)*δ) → ((C.left.vertex 0 = vb) → ((C.left.vertex 1 = vc) → ((Fin.last (C.left_n - + 2) + 1 = (0 : Fin (C.left_n + 3))) → ((C.left.vertex (Fin.last (C.left_n + 2)) = + -(1-t)*δ) → ((C.left.vertex 0 = vb) → ((C.left.vertex 1 = vc) → ((Fin.last + (C.leftParameter + + 2) + 1 = (0 : Fin (C.leftParameter + 3))) → ((C.left.vertex (Fin.last + (C.leftParameter + 2)) = p.vertex D.b) → ((∀ (t : Real), (t ∈ Set.Icc (0 : Real) 1) → (γ t ∈ Metric.ball (C.left.vertex 0) r)) → (∀ t ∈ Set.Icc (0 : Real) 1, γ t ∉ CL))))))))))))))) ) := by classical @@ -2635,7 +2658,7 @@ private theorem havoidAt1419 : have hsnonneg : 0 ≤ s := hs.1 have hδneg : -δ < 0 := neg_lt_zero.mpr hδ linarith only [h2', hsnonneg, hδneg] - · have hidx : i = Fin.last (C.left_n + 2) := by + · have hidx : i = Fin.last (C.leftParameter + 2) := by have hv := congrArg Fin.val hlastEdge rw [Fin.val_add_one] at hv split_ifs at hv with hwrap @@ -2707,7 +2730,8 @@ private theorem hrightCenterAt1503 : P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (D.a = E.b) → ( let vb := p.vertex E.b - (C.ir (Fin.last (C.right_n + 2)) = D.a) → (C.right.vertex (Fin.last (C.right_n + 2)) = + (C.ir (Fin.last (C.rightParameter + 2)) = D.a) → (C.right.vertex (Fin.last + (C.rightParameter + 2)) = vb)) ) := by classical intro n p E D C ha vb hrightLast @@ -2721,7 +2745,7 @@ private theorem hrightIncidentPrevAt1506 : ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), let va := p.vertex (E.b - 1) - (C.ir ⟨C.right_n+1, by omega⟩ = E.b - 1) → (C.right.vertex ⟨C.right_n + 1, + (C.ir ⟨C.rightParameter+1, by omega⟩ = E.b - 1) → (C.right.vertex ⟨C.rightParameter + 1, by omega⟩ = va)) := by classical intro n p E D C va hrightPrev @@ -2733,14 +2757,14 @@ private theorem hrightNextLast : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : - P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (⟨C.right_n - + 1, by omega⟩ : Fin (C.right_n + 3)) + 1 = - Fin.last (C.right_n + 2) ) := by + P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (⟨C.rightParameter + + 1, by omega⟩ : Fin (C.rightParameter + 3)) + 1 = + Fin.last (C.rightParameter + 2) ) := by classical intro n p E D C apply Fin.ext - have hne : (⟨C.right_n + 1, by omega⟩ : Fin (C.right_n + 3)) ≠ - Fin.last (C.right_n + 2) := by + have hne : (⟨C.rightParameter + 1, by omega⟩ : Fin (C.rightParameter + 3)) ≠ + Fin.last (C.rightParameter + 2) := by intro he have hv := congrArg Fin.val he simp at hv @@ -2762,15 +2786,16 @@ private theorem hXcarrierAt1521 : let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) let δ : Real := min δ₀ (1/2) let X : Real × Real := AffineMap.lineMap vb va δ - (0 < δ) → ((δ < 1) → ((C.right.vertex (Fin.last (C.right_n - + 2)) = vb) → ((C.right.vertex ⟨C.right_n + 1, by omega⟩ = va) → (((⟨C.right_n + 1, - by omega⟩ : Fin (C.right_n + 3)) + 1 = - Fin.last (C.right_n + 2)) → (X ∈ CR)))))) := by + (0 < δ) → ((δ < 1) → ((C.right.vertex (Fin.last (C.rightParameter + + 2)) = vb) → ((C.right.vertex ⟨C.rightParameter + 1, by omega⟩ = va) → + (((⟨C.rightParameter + 1, + by omega⟩ : Fin (C.rightParameter + 3)) + 1 = + Fin.last (C.rightParameter + 2)) → (X ∈ CR)))))) := by classical intro n p E D C CR va vb vc r₀ r δ₀ δ X hδ hδlt1 hrightCenter hrightIncidentPrev hrightNextLast change X ∈ P3544T1BoundaryCarrier C.right change X ∈ ⋃ i, segment Real (C.right.vertex i) (C.right.vertex (i + 1)) - refine Set.mem_iUnion.mpr ⟨⟨C.right_n + 1, by omega⟩, ?_⟩ + refine Set.mem_iUnion.mpr ⟨⟨C.rightParameter + 1, by omega⟩, ?_⟩ rw [hrightNextLast, hrightIncidentPrev, hrightCenter] rw [segment_symm] rw [segment_eq_image_lineMap] @@ -2917,7 +2942,7 @@ private theorem rightPreviousParent : P3650T1VisibleDiagonal p E), (P3650T1CyclicChildren p D.a D.b) → (∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), ∀ (a : Fin (m + 3)), ∀ (b : Fin (m + 3)), ∀ (K : P3650T1CyclicChildren q a b), (K.rotation % (m + 3) = a.val) → (K.ir - ⟨K.right_n + 1, by omega⟩ = a - 1))) := by + ⟨K.rightParameter + 1, by omega⟩ = a - 1))) := by classical intro n p E D C m q a b K hrot exact OldArcParityProof.rightPreviousParent n p E D C @@ -2955,8 +2980,10 @@ private theorem hseedRAt3047 : let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ ((0 : ℝ) < (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex D.b)) → ((C.ir (Fin.last - (C.right_n + (2 : ℕ))) = D.a) → ((C.ir ⟨C.right_n+1, by omega⟩ = E.b - 1) → ((C.ir (0 : - Fin (C.right_n + (3 : ℕ))) = D.b) → ((C.il (0 : Fin (C.left_n + (3 : ℕ))) = D.a) → + (C.rightParameter + (2 : ℕ))) = D.a) → ((C.ir ⟨C.rightParameter+1, by omega⟩ = E.b - + 1) → ((C.ir (0 : + Fin (C.rightParameter + (3 : ℕ))) = D.b) → ((C.il (0 : Fin (C.leftParameter + (3 : + ℕ))) = D.a) → ((C.il 1 = E.b + 1) → (( (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b - (1 : Fin (n + (3 : ℕ))))) = (1 : ℝ)) → (( @@ -2981,11 +3008,11 @@ private theorem hseedRAt3047 : va vb vc vv hind hspan A hcoord0 hrightLast hrightPrev hrightFirst hleftFirst hleftNext hcoordA0 hcoordA2 hcoordB0 hcoordB2 hcoordC0 hcoordC2 hcoordLine lineMapSub let CR := P3544T1BoundaryCarrier C.right - obtain ⟨r₀, hr₀, hnear₀⟩ := nonincidentBall C.right (Fin.last (C.right_n + 2)) + obtain ⟨r₀, hr₀, hnear₀⟩ := nonincidentBall C.right (Fin.last (C.rightParameter + 2)) let r : Real := min r₀ 1 have hr : 0 < r := lt_min hr₀ zero_lt_one have hnear (x : Real × Real) (hx : x ∈ - Metric.ball (C.right.vertex (Fin.last (C.right_n + 2))) r) := + Metric.ball (C.right.vertex (Fin.last (C.rightParameter + 2))) r) := hnear₀ x (Metric.ball_subset_ball (min_le_left r₀ 1) hx) let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) let δ : Real := min δ₀ (1/2) @@ -3067,8 +3094,10 @@ private theorem hseedLAt3101 : let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ ((0 : ℝ) < (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex D.b)) → ((C.ir (Fin.last - (C.right_n + (2 : ℕ))) = D.a) → ((C.ir ⟨C.right_n+1, by omega⟩ = E.b - 1) → ((C.il - (Fin.last (C.left_n + (2 : ℕ))) = D.b) → ((C.il (0 : Fin (C.left_n + (3 : ℕ))) = D.a) + (C.rightParameter + (2 : ℕ))) = D.a) → ((C.ir ⟨C.rightParameter+1, by omega⟩ = E.b - + 1) → ((C.il + (Fin.last (C.leftParameter + (2 : ℕ))) = D.b) → ((C.il (0 : Fin (C.leftParameter + (3 + : ℕ))) = D.a) → ((C.il 1 = E.b + 1) → (( (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (p.vertex (E.b - (1 : Fin (n + (3 : ℕ))))) = (1 : ℝ)) → (( @@ -3224,7 +3253,8 @@ theorem P3650T1OldArcEven {n : Nat} (p : P3381T1PolygonBoundary n) have rightPreviousParent {m : Nat} (q : P3381T1PolygonBoundary m) (a b : Fin (m + 3)) (K : P3650T1CyclicChildren q a b) (hrot : K.rotation % (m + 3) = a.val) : - K.ir ⟨K.right_n + 1, by omega⟩ = a - 1 := OldArcAssembly.rightPreviousParent n p E D C (m + K.ir ⟨K.rightParameter + 1, by omega⟩ = a - 1 := OldArcAssembly.rightPreviousParent n p E D + C (m := m) q a b K hrot rcases D.route with hbase | htop · rcases hbase with ⟨ha, hb, hempty⟩ @@ -3269,7 +3299,7 @@ theorem P3650T1OldArcEven {n : Nat} (p : P3381T1PolygonBoundary n) rw [List.getElem_ofFn] have hrotval : C.rotation % (n + 3) = D.a.val := OldArcParityProof.hrotvalAt999 n p E D C hrot0 have hrightLast := OldArcParityProof.hrightLast n p E D C - have hrightPrev : C.ir ⟨C.right_n+1, by omega⟩ = E.b - 1 := by + have hrightPrev : C.ir ⟨C.rightParameter+1, by omega⟩ = E.b - 1 := by rw [rightPreviousParent p D.a D.b C hrotval, ha] have hrightFirst := OldArcParityProof.hrightFirst n p E D C have hleftLast := OldArcParityProof.hleftLast n p E D C diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1ParitySum.lean b/LeanPool/ApollonianSuperharmonic/P3650T1ParitySum.lean index e6c446b654..7d8ebc8351 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1ParitySum.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1ParitySum.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3650T1CyclicChildren public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity @@ -198,19 +200,20 @@ private theorem hleftCount : ((edges L).map fun e => weight x d e.1 e.2).sum (∀ {k : Nat}, ∀ (f : Fin (k + 3) → Fin (n + 3)), ∀ (x : Real × Real), ∀ (d : Real × Real), (∑ i : Fin (k + 3), weight x d (f i) (f (i + 1))) = edgeWeight x d (List.ofFn - f)) → (∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), {i : Fin (C.left_n + (3 : ℕ)) | ∃ (t : ℝ), (0 : + f)) → (∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), {i : Fin (C.leftParameter + (3 : ℕ)) | ∃ (t : + ℝ), (0 : ℝ) < t ∧ x + t • d ∈ segment ℝ (C.left.vertex i) (C.left.vertex (i + (1 : Fin - (C.left_n + (3 : ℕ)))))}.ncard = edgeWeight x d (a :: (C.u ++ [b])))) ) := by + (C.leftParameter + (3 : ℕ)))))}.ncard = edgeWeight x d (a :: (C.u ++ [b])))) ) := by classical intro n p a b C hit weight cardPred edges edgeWeight hsum_ofFn x d rw [cardPred] have h := hsum_ofFn C.il x d rw [C.left_order] at h calc - (∑ i : Fin (C.left_n + 3), + (∑ i : Fin (C.leftParameter + 3), if ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (C.left.vertex i) (C.left.vertex (i + 1)) then 1 else 0) = - ∑ i : Fin (C.left_n + 3), weight x d (C.il i) (C.il (i + 1)) := by + ∑ i : Fin (C.leftParameter + 3), weight x d (C.il i) (C.il (i + 1)) := by apply Finset.sum_congr rfl intro i hi simp [weight, hit, C.left_vertex] @@ -234,19 +237,20 @@ private theorem hrightCount : ((edges L).map fun e => weight x d e.1 e.2).sum (∀ {k : Nat}, ∀ (f : Fin (k + 3) → Fin (n + 3)), ∀ (x : Real × Real), ∀ (d : Real × Real), (∑ i : Fin (k + 3), weight x d (f i) (f (i + 1))) = edgeWeight x d (List.ofFn - f)) → (∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), {i : Fin (C.right_n + (3 : ℕ)) | ∃ (t : ℝ), (0 : + f)) → (∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), {i : Fin (C.rightParameter + (3 : ℕ)) | ∃ (t : + ℝ), (0 : ℝ) < t ∧ x + t • d ∈ segment ℝ (C.right.vertex i) (C.right.vertex (i + (1 : Fin - (C.right_n + (3 : ℕ)))))}.ncard = edgeWeight x d (b :: (C.v ++ [a])))) ) := by + (C.rightParameter + (3 : ℕ)))))}.ncard = edgeWeight x d (b :: (C.v ++ [a])))) ) := by classical intro n p a b C hit weight cardPred edges edgeWeight hsum_ofFn x d rw [cardPred] have h := hsum_ofFn C.ir x d rw [C.right_order] at h calc - (∑ i : Fin (C.right_n + 3), + (∑ i : Fin (C.rightParameter + 3), if ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (C.right.vertex i) (C.right.vertex (i + 1)) then 1 else 0) = - ∑ i : Fin (C.right_n + 3), weight x d (C.ir i) (C.ir (i + 1)) := by + ∑ i : Fin (C.rightParameter + 3), weight x d (C.ir i) (C.ir (i + 1)) := by apply Finset.sum_congr rfl intro i hi simp [weight, hit, C.right_vertex] @@ -357,10 +361,10 @@ private theorem hcount : List.zipWith Prod.mk l (l.rotate 1) let edgeWeight (x d : Real × Real) (L : List (Fin (n + 3))) : Nat := ((edges L).map fun e => weight x d e.1 e.2).sum - (∀ (x : Real × Real), ∀ (d : Real × Real), Set.ncard {i : Fin (C.left_n + 3) | ∃ t : + (∀ (x : Real × Real), ∀ (d : Real × Real), Set.ncard {i : Fin (C.leftParameter + 3) | ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (C.left.vertex i) (C.left.vertex (i + 1))} = edgeWeight x d (a :: (C.u ++ [b]))) → ((∀ (x : Real × Real), ∀ (d : Real × Real), - Set.ncard {i : Fin (C.right_n + 3) | ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real + Set.ncard {i : Fin (C.rightParameter + 3) | ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (C.right.vertex i) (C.right.vertex (i + 1))} = edgeWeight x d (b :: (C.v ++ [a]))) → ((∀ (x : Real × Real), ∀ (d : Real × Real), Set.ncard {i : Fin (n + 3) | ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1))} = edgeWeight x d @@ -368,11 +372,14 @@ private theorem hcount : edgeWeight x d (List.ofFn (fun i : Fin (n + 3) => i)) = edgeWeight x d (a :: (C.u ++ b :: C.v))) → ((∀ (x : Real × Real), ∀ (d : Real × Real), edgeWeight x d (a :: (C.u ++ [b])) + edgeWeight x d (b :: (C.v ++ [a])) = edgeWeight x d (a :: (C.u ++ b :: - C.v)) + 2 * weight x d a b) → (∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), {i : Fin (C.left_n + (3 + C.v)) + 2 * weight x d a b) → (∀ (x : ℝ × ℝ), ∀ (d : ℝ × ℝ), {i : Fin + (C.leftParameter + (3 : ℕ)) | ∃ (t : ℝ), (0 : ℝ) < t ∧ x + t • d ∈ segment ℝ (C.left.vertex i) - (C.left.vertex (i + (1 : Fin (C.left_n + (3 : ℕ)))))}.ncard + {i : Fin (C.right_n + + (C.left.vertex (i + (1 : Fin (C.leftParameter + (3 : ℕ)))))}.ncard + {i : Fin + (C.rightParameter + (3 : ℕ)) | ∃ (t : ℝ), (0 : ℝ) < t ∧ x + t • d ∈ segment ℝ (C.right.vertex i) - (C.right.vertex (i + (1 : Fin (C.right_n + (3 : ℕ)))))}.ncard = {i : Fin (n + (3 : + (C.right.vertex (i + (1 : Fin (C.rightParameter + (3 : ℕ)))))}.ncard = {i : Fin (n + + (3 : ℕ)) | ∃ (t : ℝ), (0 : ℝ) < t ∧ x + t • d ∈ segment ℝ (p.vertex i) (p.vertex (i + (1 : Fin (n + (3 : ℕ)))))}.ncard + (2 : ℕ) * if ∃ (t : ℝ), (0 : ℝ) < t ∧ x + t • d ∈ segment ℝ (p.vertex a) (p.vertex b) then (1 : ℕ) else (0 : ℕ)))))) ) := by @@ -391,14 +398,18 @@ private theorem hcommon : ∉ P3544T1BoundaryCarrier C.right → ∃ (d : ℝ × ℝ), (∀ (i : Fin (n + (3 : ℕ))), d.1 * (p.vertex i - x).2 - d.2 * (p.vertex i - x).1 ≠ (0 : ℝ)) ∧ (∀ (i : Fin (n + (3 : ℕ))), d.1 * (p.vertex (i + (1 : Fin (n + (3 : ℕ)))) - p.vertex i).2 - d.2 * (p.vertex - (i + (1 : Fin (n + (3 : ℕ)))) - p.vertex i).1 ≠ (0 : ℝ)) ∧ (∀ (i : Fin (C.left_n + (3 + (i + (1 : Fin (n + (3 : ℕ)))) - p.vertex i).1 ≠ (0 : ℝ)) ∧ (∀ (i : Fin + (C.leftParameter + (3 : ℕ))), d.1 * (C.left.vertex i - x).2 - d.2 * (C.left.vertex i - x).1 ≠ (0 : ℝ)) ∧ (∀ - (i : Fin (C.left_n + (3 : ℕ))), d.1 * (C.left.vertex (i + (1 : Fin (C.left_n + (3 : - ℕ)))) - C.left.vertex i).2 - d.2 * (C.left.vertex (i + (1 : Fin (C.left_n + (3 : - ℕ)))) - C.left.vertex i).1 ≠ (0 : ℝ)) ∧ (∀ (i : Fin (C.right_n + (3 : ℕ))), d.1 * + (i : Fin (C.leftParameter + (3 : ℕ))), d.1 * (C.left.vertex (i + (1 : Fin + (C.leftParameter + (3 : + ℕ)))) - C.left.vertex i).2 - d.2 * (C.left.vertex (i + (1 : Fin (C.leftParameter + (3 : + ℕ)))) - C.left.vertex i).1 ≠ (0 : ℝ)) ∧ (∀ (i : Fin (C.rightParameter + (3 : ℕ))), d.1 * (C.right.vertex i - x).2 - d.2 * (C.right.vertex i - x).1 ≠ (0 : ℝ)) ∧ ∀ (i : Fin - (C.right_n + (3 : ℕ))), d.1 * (C.right.vertex (i + (1 : Fin (C.right_n + (3 : ℕ)))) - - C.right.vertex i).2 - d.2 * (C.right.vertex (i + (1 : Fin (C.right_n + (3 : ℕ)))) - + (C.rightParameter + (3 : ℕ))), d.1 * (C.right.vertex (i + (1 : Fin (C.rightParameter + + (3 : ℕ)))) - + C.right.vertex i).2 - d.2 * (C.right.vertex (i + (1 : Fin (C.rightParameter + (3 : + ℕ)))) - C.right.vertex i).1 ≠ (0 : ℝ) ) := by classical intro n p a b C x hxL hxR @@ -426,7 +437,7 @@ private theorem hcommon : simp at hv omega let Idx := (Fin (n + 3) × Bool) ⊕ - ((Fin (C.left_n + 3) × Bool) ⊕ (Fin (C.right_n + 3) × Bool)) + ((Fin (C.leftParameter + 3) × Bool) ⊕ (Fin (C.rightParameter + 3) × Bool)) let vec : Idx → Real × Real := fun j => match j with | Sum.inl (i, isVertex) => @@ -441,35 +452,35 @@ private theorem hcommon : intro j rcases j with ⟨i, isVertex⟩ | j · by_cases htag : isVertex - · simp? [vec, htag] + · simp only [htag, ↓reduceIte, ne_eq, vec] intro hzero have hv : p.vertex i ∈ P3544T1BoundaryCarrier p := by exact Set.mem_iUnion.mpr ⟨i, left_mem_segment Real _ _⟩ exact hxParent ((sub_eq_zero.mp hzero) ▸ hv) - · simp? [vec, htag] + · simp only [htag, Bool.false_eq_true, ↓reduceIte, ne_eq, vec] intro hzero apply finSucc_ne i apply p.injective exact sub_eq_zero.mp hzero · rcases j with ⟨i, isVertex⟩ | ⟨i, isVertex⟩ · by_cases htag : isVertex - · simp? [vec, htag] + · simp only [htag, ↓reduceIte, ne_eq, vec] intro hzero have hv : C.left.vertex i ∈ P3544T1BoundaryCarrier C.left := by exact Set.mem_iUnion.mpr ⟨i, left_mem_segment Real _ _⟩ exact hxL ((sub_eq_zero.mp hzero) ▸ hv) - · simp? [vec, htag] + · simp only [htag, Bool.false_eq_true, ↓reduceIte, ne_eq, vec] intro hzero apply finSucc_ne i apply C.left.injective exact sub_eq_zero.mp hzero · by_cases htag : isVertex - · simp? [vec, htag] + · simp only [htag, ↓reduceIte, ne_eq, vec] intro hzero have hv : C.right.vertex i ∈ P3544T1BoundaryCarrier C.right := by exact Set.mem_iUnion.mpr ⟨i, left_mem_segment Real _ _⟩ exact hxR ((sub_eq_zero.mp hzero) ▸ hv) - · simp? [vec, htag] + · simp only [htag, Bool.false_eq_true, ↓reduceIte, ne_eq, vec] intro hzero apply finSucc_ne i apply C.right.injective @@ -541,9 +552,9 @@ theorem P3650T1ParitySum {n : Nat} (p : P3381T1PolygonBoundary n) classical exact (∀ x d : Real × Real, - Set.ncard {i : Fin (C.left_n + 3) | ∃ t : Real, 0 < t ∧ + Set.ncard {i : Fin (C.leftParameter + 3) | ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (C.left.vertex i) (C.left.vertex (i + 1))} + - Set.ncard {i : Fin (C.right_n + 3) | ∃ t : Real, 0 < t ∧ + Set.ncard {i : Fin (C.rightParameter + 3) | ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (C.right.vertex i) (C.right.vertex (i + 1))} = Set.ncard {i : Fin (n + 3) | ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1))} + diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean b/LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean index d47d97b2fd..d33400a00f 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean @@ -5,12 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import Mathlib.LinearAlgebra.AffineSpace.FiniteDimensional public import LeanPool.ApollonianSuperharmonic.P3650T1ExposedCorner public import Mathlib.Analysis.Normed.Affine.AddTorsorBases -public import Mathlib.Analysis.Convex.Combination -public import Mathlib.Analysis.Convex.Topology -- [TABLET NODE: P3650T1TriangleEntry] diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1VisibleDiagonal.lean b/LeanPool/ApollonianSuperharmonic/P3650T1VisibleDiagonal.lean index c9b86d3d68..13288e6b83 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1VisibleDiagonal.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1VisibleDiagonal.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3650T1ExposedCorner +public import Mathlib.Analysis.Convex.Hull -- [TABLET NODE: P3650T1VisibleDiagonal] diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1ChildFillSeparation.lean b/LeanPool/ApollonianSuperharmonic/P3652T1ChildFillSeparation.lean index 945251d0ce..47009b44f9 100644 --- a/LeanPool/ApollonianSuperharmonic/P3652T1ChildFillSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/P3652T1ChildFillSeparation.lean @@ -5,7 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3544T1DiagonalSplit +public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity +public import Mathlib.Algebra.CharP.Invertible -- [TABLET NODE: P3652T1ChildFillSeparation] diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1DiagonalFaceIntersections.lean b/LeanPool/ApollonianSuperharmonic/P3652T1DiagonalFaceIntersections.lean index 125654e8d0..81c969f56b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3652T1DiagonalFaceIntersections.lean +++ b/LeanPool/ApollonianSuperharmonic/P3652T1DiagonalFaceIntersections.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3652T1TriangleFaceRestriction public import LeanPool.ApollonianSuperharmonic.P3652T1IndexedFaceLedger diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean index ce0dfb1ea2..2bc77b4b82 100644 --- a/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3544T1DiagonalSplit public import LeanPool.ApollonianSuperharmonic.P3511T1SourceDissection +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: P3652T1IndexedFaceLedger] @@ -269,7 +272,7 @@ private theorem hlenL : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), - S.left_n + 3 = S.u.length + 2 ) := by + S.leftParameter + 3 = S.u.length + 2 ) := by classical intro n p S have h := congrArg List.length S.left_order @@ -281,7 +284,7 @@ private theorem hlenR : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), - S.right_n + 3 = S.v.length + 2 ) := by + S.rightParameter + 3 = S.v.length + 2 ) := by classical intro n p S have h := congrArg List.length S.right_order @@ -293,8 +296,10 @@ private theorem hleftcoord : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + 3 - = S.u.length + S.v.length + 2) → ((S.left_n + 3 = S.u.length + 2) → ((S.right_n + 3 = - S.v.length + 2) → (∀ (x : Fin (S.left_n + (3 : ℕ))), (↑(S.il x) : ℕ) = ((↑x : ℕ) + + = S.u.length + S.v.length + 2) → ((S.leftParameter + 3 = S.u.length + 2) → + ((S.rightParameter + 3 = + S.v.length + 2) → (∀ (x : Fin (S.leftParameter + (3 : ℕ))), (↑(S.il x) : ℕ) = ((↑x : + ℕ) + S.rotation) % (n + (3 : ℕ))))) ) := by classical intro n p S hlenP hlenL hlenR x @@ -342,7 +347,8 @@ private theorem haCoord : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + 3 - = S.u.length + S.v.length + 2) → ((S.left_n + 3 = S.u.length + 2) → ((S.right_n + 3 = + = S.u.length + S.v.length + 2) → ((S.leftParameter + 3 = S.u.length + 2) → + ((S.rightParameter + 3 = S.v.length + 2) → (S.a.val = S.rotation % (n + 3)))) ) := by classical intro n p S hlenP hlenL hlenR @@ -364,8 +370,10 @@ private theorem hrightcoord : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + 3 - = S.u.length + S.v.length + 2) → ((S.left_n + 3 = S.u.length + 2) → ((S.right_n + 3 = - S.v.length + 2) → ((S.a.val = S.rotation % (n + 3)) → (∀ (y : Fin (S.right_n + (3 : + = S.u.length + S.v.length + 2) → ((S.leftParameter + 3 = S.u.length + 2) → + ((S.rightParameter + 3 = + S.v.length + 2) → ((S.a.val = S.rotation % (n + 3)) → (∀ (y : Fin (S.rightParameter + + (3 : ℕ))), (↑(S.ir y) : ℕ) = (S.u.length + (1 : ℕ) + (↑y : ℕ) + S.rotation) % (n + (3 : ℕ)))))) ) := by classical @@ -537,12 +545,13 @@ private theorem hleftA : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ (x - : Fin (S.left_n + 3)), (S.il x).val = (x.val + S.rotation) % (n + 3)) → ((S.a.val = - S.rotation % (n + 3)) → (S.il (0 : Fin (S.left_n + 3)) = S.a)) ) := by + : Fin (S.leftParameter + 3)), (S.il x).val = (x.val + S.rotation) % (n + 3)) → + ((S.a.val = + S.rotation % (n + 3)) → (S.il (0 : Fin (S.leftParameter + 3)) = S.a)) ) := by classical intro n p S hleftcoord haCoord apply Fin.ext - have h := hleftcoord (0 : Fin (S.left_n + 3)) + have h := hleftcoord (0 : Fin (S.leftParameter + 3)) simpa only [Fin.val_zero, Nat.zero_add, haCoord] using h private theorem hleftB : @@ -550,7 +559,7 @@ private theorem hleftB : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), S.il - (Fin.last (S.left_n + 2)) = S.b ) := by + (Fin.last (S.leftParameter + 2)) = S.b ) := by classical intro n p S have h := congrArg List.getLast? S.left_order @@ -562,7 +571,7 @@ private theorem hrightB : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), S.ir - (0 : Fin (S.right_n + 3)) = S.b ) := by + (0 : Fin (S.rightParameter + 3)) = S.b ) := by classical intro n p S have h := congrArg List.head? S.right_order @@ -573,7 +582,7 @@ private theorem hrightA : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), S.ir - (Fin.last (S.right_n + 2)) = S.a ) := by + (Fin.last (S.rightParameter + 2)) = S.a ) := by classical intro n p S have h := congrArg List.getLast? S.right_order @@ -585,12 +594,15 @@ private theorem hleftSucc : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + 3 - = S.u.length + S.v.length + 2) → ((S.left_n + 3 = S.u.length + 2) → ((S.right_n + 3 = - S.v.length + 2) → ((∀ (x : Fin (S.left_n + 3)), (S.il x).val = (x.val + S.rotation) % + = S.u.length + S.v.length + 2) → ((S.leftParameter + 3 = S.u.length + 2) → + ((S.rightParameter + 3 = + S.v.length + 2) → ((∀ (x : Fin (S.leftParameter + 3)), (S.il x).val = (x.val + + S.rotation) % (n + 3)) → ((∀ {m : Nat}, ∀ {r : Nat}, ∀ {x : Nat}, ∀ {y : Nat}, (0 < m) → ((x < m) → ((y < m) → (((r + x) % m = (r + y) % m) → (x = y))))) → ((∀ {m : Nat}, ∀ {r : Nat}, ∀ {x : Nat}, (1 < m) → (((r + x) % m + 1) % m = (r + (x + 1)) % m)) → (∀ (x : Fin - (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.left_n + (3 : ℕ))), (↑(S.il y) : ℕ) = ((↑(S.il + (S.leftParameter + (3 : ℕ))), ∀ (y : Fin (S.leftParameter + (3 : ℕ))), (↑(S.il y) : + ℕ) = ((↑(S.il x) : ℕ) + (1 : ℕ)) % (n + (3 : ℕ)) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ))))))) ) := by classical intro n p S hlenP hlenL hlenR hleftcoord hmodShift hmodSucc x y @@ -618,9 +630,11 @@ private theorem hleftOrd : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ (z - : Fin (n + 3)), (z + 1).val = (z.val + 1) % (n + 3)) → ((∀ (x : Fin (S.left_n + 3)), - ∀ (y : Fin (S.left_n + 3)), (S.il y).val = ((S.il x).val + 1) % (n + 3) ↔ y.val = - x.val + 1) → (∀ (x : Fin (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.left_n + (3 : ℕ))), + : Fin (n + 3)), (z + 1).val = (z.val + 1) % (n + 3)) → ((∀ (x : Fin (S.leftParameter + + 3)), + ∀ (y : Fin (S.leftParameter + 3)), (S.il y).val = ((S.il x).val + 1) % (n + 3) ↔ y.val = + x.val + 1) → (∀ (x : Fin (S.leftParameter + (3 : ℕ))), ∀ (y : Fin (S.leftParameter + + (3 : ℕ))), S.il y = S.il x + (1 : Fin (n + (3 : ℕ))) ∨ S.il x = S.il y + (1 : Fin (n + (3 : ℕ))) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : ℕ) + (1 : ℕ))) ) := by classical @@ -648,17 +662,20 @@ private theorem hrightSucc : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + 3 - = S.u.length + S.v.length + 2) → ((S.left_n + 3 = S.u.length + 2) → ((S.right_n + 3 = - S.v.length + 2) → ((∀ (y : Fin (S.right_n + 3)), (S.ir y).val = (S.u.length + 1 + + = S.u.length + S.v.length + 2) → ((S.leftParameter + 3 = S.u.length + 2) → + ((S.rightParameter + 3 = + S.v.length + 2) → ((∀ (y : Fin (S.rightParameter + 3)), (S.ir y).val = (S.u.length + 1 + y.val + S.rotation) % (n + 3)) → ((∀ {m : Nat}, ∀ {r : Nat}, ∀ {x : Nat}, ∀ {y : Nat}, (0 < m) → ((x < m) → ((y < m) → (((r + x) % m = (r + y) % m) → (x = y))))) → ((∀ {m : Nat}, ∀ {r : Nat}, ∀ {x : Nat}, (1 < m) → (((r + x) % m + 1) % m = (r + (x - + 1)) % m)) → (∀ (x : Fin (S.right_n + (3 : ℕ))), ∀ (y : Fin (S.right_n + (3 : ℕ))), - (↑x : ℕ) + (1 : ℕ) < S.right_n + (3 : ℕ) → (((↑(S.ir x) : ℕ) + (1 : ℕ)) % (n + (3 : + + 1)) % m)) → (∀ (x : Fin (S.rightParameter + (3 : ℕ))), ∀ (y : Fin (S.rightParameter + + (3 : ℕ))), + (↑x : ℕ) + (1 : ℕ) < S.rightParameter + (3 : ℕ) → (((↑(S.ir x) : ℕ) + (1 : ℕ)) % (n + + (3 : ℕ)) = (↑(S.ir y) : ℕ) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ)))))))) ) := by classical intro n p S hlenP hlenL hlenR hrightcoord hmodShift hmodSucc x y hx - have hoff : S.u.length + 1 + (S.right_n + 2) = n + 3 := by omega + have hoff : S.u.length + 1 + (S.rightParameter + 2) = n + 3 := by omega have hxCoord : (S.ir x).val = (S.rotation + (S.u.length + 1 + x.val)) % (n + 3) := by simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hrightcoord x @@ -677,7 +694,7 @@ private theorem hrightSucc : · intro h have he : (S.rotation + (tx + 1)) % (n + 3) = (S.rotation + ty) % (n + 3) := hs.symm.trans h - by_cases hyLast : y.val = S.right_n + 2 + by_cases hyLast : y.val = S.rightParameter + 2 · have htyM : ty = n + 3 := by dsimp [ty]; omega by_cases htxM : tx + 1 = n + 3 · have hval : y.val = x.val + 1 := by dsimp [tx, ty] at htxM htyM ⊢; omega @@ -711,36 +728,39 @@ private theorem hrightOrd : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + 3 - = S.u.length + S.v.length + 2) → ((S.left_n + 3 = S.u.length + 2) → ((S.right_n + 3 = - S.v.length + 2) → ((∀ (y : Fin (S.right_n + 3)), (S.ir y).val = (S.u.length + 1 + + = S.u.length + S.v.length + 2) → ((S.leftParameter + 3 = S.u.length + 2) → + ((S.rightParameter + 3 = + S.v.length + 2) → ((∀ (y : Fin (S.rightParameter + 3)), (S.ir y).val = (S.u.length + 1 + y.val + S.rotation) % (n + 3)) → ((∀ {m : Nat}, ∀ {r : Nat}, ∀ {x : Nat}, ∀ {y : Nat}, (0 < m) → ((x < m) → ((y < m) → (((r + x) % m = (r + y) % m) → (x = y))))) → ((∀ {m : Nat}, ∀ {r : Nat}, ∀ {x : Nat}, (1 < m) → (((r + x) % m + 1) % m = (r + (x + 1)) % m)) → ((∀ (z : Fin (n + 3)), (z + 1).val = (z.val + 1) % (n + 3)) → ((∀ (x : - Fin (S.right_n + 3)), ∀ (y : Fin (S.right_n + 3)), (x.val + 1 < S.right_n + 3) → + Fin (S.rightParameter + 3)), ∀ (y : Fin (S.rightParameter + 3)), (x.val + 1 < + S.rightParameter + 3) → (((S.ir x).val + 1) % (n + 3) = (S.ir y).val ↔ y.val = x.val + 1)) → (∀ (x : Fin - (S.right_n + (3 : ℕ))), ∀ (y : Fin (S.right_n + (3 : ℕ))), x ≠ y → (S.ir y = S.ir x + + (S.rightParameter + (3 : ℕ))), ∀ (y : Fin (S.rightParameter + (3 : ℕ))), x ≠ y → + (S.ir y = S.ir x + (1 : Fin (n + (3 : ℕ))) ∨ S.ir x = S.ir y + (1 : Fin (n + (3 : ℕ))) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : ℕ) + (1 : ℕ)))))))))) ) := by classical intro n p S hlenP hlenL hlenR hrightcoord hmodShift hmodSucc hparentSuccVal hrightSucc x y hxy - have hxlast : x.val + 1 = S.right_n + 3 ∨ x.val + 1 < S.right_n + 3 := by omega - have hylast : y.val + 1 = S.right_n + 3 ∨ y.val + 1 < S.right_n + 3 := by omega + have hxlast : x.val + 1 = S.rightParameter + 3 ∨ x.val + 1 < S.rightParameter + 3 := by omega + have hylast : y.val + 1 = S.rightParameter + 3 ∨ y.val + 1 < S.rightParameter + 3 := by omega constructor · rintro (h | h) · have hv := congrArg Fin.val h rw [hparentSuccVal] at hv rcases hxlast with hxlast | hxlt - · have hylt : y.val + 1 < S.right_n + 3 := by + · have hylt : y.val + 1 < S.rightParameter + 3 := by rcases hylast with hylast | hylt · exfalso; exact hxy (Fin.ext (by omega)) · exact hylt - have hM : S.u.length + 1 + (S.right_n + 2) = n + 3 := by omega + have hM : S.u.length + 1 + (S.rightParameter + 2) = n + 3 := by omega have hxEndCoord : (S.ir x).val = S.rotation % (n + 3) := by - have hxl : x.val = S.right_n + 2 := by omega + have hxl : x.val = S.rightParameter + 2 := by omega rw [hrightcoord, hxl] calc - (S.u.length + 1 + (S.right_n + 2) + S.rotation) % (n + 3) = + (S.u.length + 1 + (S.rightParameter + 2) + S.rotation) % (n + 3) = ((n + 3) + S.rotation) % (n + 3) := by rw [hM] _ = S.rotation % (n + 3) := by rw [Nat.add_mod, Nat.mod_self, zero_add] @@ -764,12 +784,12 @@ private theorem hrightOrd : rcases hylast with hylast | hylt · rcases hxlast with hxlast | hxlt · exfalso; exact hxy.symm (Fin.ext (by omega)) - · have hM : S.u.length + 1 + (S.right_n + 2) = n + 3 := by omega + · have hM : S.u.length + 1 + (S.rightParameter + 2) = n + 3 := by omega have hyEndCoord : (S.ir y).val = S.rotation % (n + 3) := by - have hyl : y.val = S.right_n + 2 := by omega + have hyl : y.val = S.rightParameter + 2 := by omega rw [hrightcoord, hyl] calc - (S.u.length + 1 + (S.right_n + 2) + S.rotation) % (n + 3) = + (S.u.length + 1 + (S.rightParameter + 2) + S.rotation) % (n + 3) = ((n + 3) + S.rotation) % (n + 3) := by rw [hM] _ = S.rotation % (n + 3) := by rw [Nat.add_mod, Nat.mod_self, zero_add] @@ -789,13 +809,13 @@ private theorem hrightOrd : omega · exact Or.inr (hrightSucc y x hylt |>.mp hv.symm) · rintro (h | h) - · have hxlt : x.val + 1 < S.right_n + 3 := by omega + · have hxlt : x.val + 1 < S.rightParameter + 3 := by omega have hv := (hrightSucc x y hxlt).mpr h left apply Fin.ext rw [hparentSuccVal] exact hv.symm - · have hylt : y.val + 1 < S.right_n + 3 := by omega + · have hylt : y.val + 1 < S.rightParameter + 3 := by omega have hv := (hrightSucc y x hylt).mpr h right apply Fin.ext @@ -807,33 +827,36 @@ private theorem hleftWrap : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (S.il - (0 : Fin (S.left_n + 3)) = S.a) → ((S.il (Fin.last (S.left_n + 2)) = S.b) → (∀ (x : - Fin (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.left_n + (3 : ℕ))), (↑x : ℕ) + (1 : ℕ) = - S.left_n + (3 : ℕ) ∧ (↑y : ℕ) = (0 : ℕ) ∨ (↑y : ℕ) + (1 : ℕ) = S.left_n + (3 : ℕ) ∧ + (0 : Fin (S.leftParameter + 3)) = S.a) → ((S.il (Fin.last (S.leftParameter + 2)) = + S.b) → (∀ (x : + Fin (S.leftParameter + (3 : ℕ))), ∀ (y : Fin (S.leftParameter + (3 : ℕ))), (↑x : ℕ) + + (1 : ℕ) = + S.leftParameter + (3 : ℕ) ∧ (↑y : ℕ) = (0 : ℕ) ∨ (↑y : ℕ) + (1 : ℕ) = S.leftParameter + + (3 : ℕ) ∧ (↑x : ℕ) = (0 : ℕ) ↔ S.il x = S.b ∧ S.il y = S.a ∨ S.il y = S.b ∧ S.il x = S.a)) ) := by classical intro n p S hleftA hleftB x y constructor · rintro (h | h) - · have hx : x = Fin.last (S.left_n + 2) := by + · have hx : x = Fin.last (S.leftParameter + 2) := by apply Fin.ext simp only [Fin.val_last] omega have hy : y = 0 := Fin.ext (by simpa only [Fin.val_zero] using h.2) exact Or.inl ⟨by rw [hx, hleftB], by rw [hy, hleftA]⟩ - · have hy : y = Fin.last (S.left_n + 2) := by + · have hy : y = Fin.last (S.leftParameter + 2) := by apply Fin.ext simp only [Fin.val_last] omega have hx : x = 0 := Fin.ext (by simpa only [Fin.val_zero] using h.2) exact Or.inr ⟨by rw [hy, hleftB], by rw [hx, hleftA]⟩ · rintro (h | h) - · have hx : x = Fin.last (S.left_n + 2) := S.il_injective (h.1.trans hleftB.symm) + · have hx : x = Fin.last (S.leftParameter + 2) := S.il_injective (h.1.trans hleftB.symm) have hy : y = 0 := S.il_injective (h.2.trans hleftA.symm) subst x subst y exact Or.inl ⟨by simp, by simp⟩ - · have hy : y = Fin.last (S.left_n + 2) := S.il_injective (h.1.trans hleftB.symm) + · have hy : y = Fin.last (S.leftParameter + 2) := S.il_injective (h.1.trans hleftB.symm) have hx : x = 0 := S.il_injective (h.2.trans hleftA.symm) subst x subst y @@ -846,13 +869,18 @@ private theorem hleftAdj : ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ {m : Nat}, ∀ (x : Fin (m + 3)), ∀ (y : Fin (m + 3)), (y = x + 1 ∨ x = y + 1) ↔ (y.val = x.val + 1 ∨ x.val = y.val + 1 ∨ (x.val + 1 = m + 3 ∧ y.val = 0) ∨ (y.val + 1 = m + - 3 ∧ x.val = 0))) → ((∀ (x : Fin (S.left_n + 3)), ∀ (y : Fin (S.left_n + 3)), (S.il y + 3 ∧ x.val = 0))) → ((∀ (x : Fin (S.leftParameter + 3)), ∀ (y : Fin (S.leftParameter + + 3)), (S.il y = S.il x + 1 ∨ S.il x = S.il y + 1) ↔ (y.val = x.val + 1 ∨ x.val = y.val + 1)) → ((∀ - (x : Fin (S.left_n + 3)), ∀ (y : Fin (S.left_n + 3)), ((x.val + 1 = S.left_n + 3 ∧ - y.val = 0) ∨ (y.val + 1 = S.left_n + 3 ∧ x.val = 0)) ↔ ((S.il x = S.b ∧ S.il y = S.a) - ∨ (S.il y = S.b ∧ S.il x = S.a))) → (∀ (x : Fin (S.left_n + (3 : ℕ))), ∀ (y : Fin - (S.left_n + (3 : ℕ))), y = x + (1 : Fin (S.left_n + (3 : ℕ))) ∨ x = y + (1 : Fin - (S.left_n + (3 : ℕ))) ↔ (S.il y = S.il x + (1 : Fin (n + (3 : ℕ))) ∨ S.il x = S.il y + (x : Fin (S.leftParameter + 3)), ∀ (y : Fin (S.leftParameter + 3)), ((x.val + 1 = + S.leftParameter + 3 ∧ + y.val = 0) ∨ (y.val + 1 = S.leftParameter + 3 ∧ x.val = 0)) ↔ ((S.il x = S.b ∧ S.il y + = S.a) + ∨ (S.il y = S.b ∧ S.il x = S.a))) → (∀ (x : Fin (S.leftParameter + (3 : ℕ))), ∀ (y : Fin + (S.leftParameter + (3 : ℕ))), y = x + (1 : Fin (S.leftParameter + (3 : ℕ))) ∨ x = y + + (1 : Fin + (S.leftParameter + (3 : ℕ))) ↔ (S.il y = S.il x + (1 : Fin (n + (3 : ℕ))) ∨ S.il x = + S.il y + (1 : Fin (n + (3 : ℕ)))) ∨ S.il x = S.a ∧ S.il y = S.b ∨ S.il y = S.a ∧ S.il x = S.b))) ) := by classical @@ -865,33 +893,36 @@ private theorem hrightWrap : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (S.ir - (0 : Fin (S.right_n + 3)) = S.b) → ((S.ir (Fin.last (S.right_n + 2)) = S.a) → (∀ (x : - Fin (S.right_n + (3 : ℕ))), ∀ (y : Fin (S.right_n + (3 : ℕ))), (↑x : ℕ) + (1 : ℕ) = - S.right_n + (3 : ℕ) ∧ (↑y : ℕ) = (0 : ℕ) ∨ (↑y : ℕ) + (1 : ℕ) = S.right_n + (3 : ℕ) ∧ + (0 : Fin (S.rightParameter + 3)) = S.b) → ((S.ir (Fin.last (S.rightParameter + 2)) = + S.a) → (∀ (x : + Fin (S.rightParameter + (3 : ℕ))), ∀ (y : Fin (S.rightParameter + (3 : ℕ))), (↑x : ℕ) + + (1 : ℕ) = + S.rightParameter + (3 : ℕ) ∧ (↑y : ℕ) = (0 : ℕ) ∨ (↑y : ℕ) + (1 : ℕ) = + S.rightParameter + (3 : ℕ) ∧ (↑x : ℕ) = (0 : ℕ) ↔ S.ir x = S.a ∧ S.ir y = S.b ∨ S.ir y = S.a ∧ S.ir x = S.b)) ) := by classical intro n p S hrightB hrightA x y constructor · rintro (h | h) - · have hx : x = Fin.last (S.right_n + 2) := by + · have hx : x = Fin.last (S.rightParameter + 2) := by apply Fin.ext simp only [Fin.val_last] omega have hy : y = 0 := Fin.ext (by simpa only [Fin.val_zero] using h.2) exact Or.inl ⟨by rw [hx, hrightA], by rw [hy, hrightB]⟩ - · have hy : y = Fin.last (S.right_n + 2) := by + · have hy : y = Fin.last (S.rightParameter + 2) := by apply Fin.ext simp only [Fin.val_last] omega have hx : x = 0 := Fin.ext (by simpa only [Fin.val_zero] using h.2) exact Or.inr ⟨by rw [hy, hrightA], by rw [hx, hrightB]⟩ · rintro (h | h) - · have hx : x = Fin.last (S.right_n + 2) := S.ir_injective (h.1.trans hrightA.symm) + · have hx : x = Fin.last (S.rightParameter + 2) := S.ir_injective (h.1.trans hrightA.symm) have hy : y = 0 := S.ir_injective (h.2.trans hrightB.symm) subst x subst y exact Or.inl ⟨by simp, by simp⟩ - · have hy : y = Fin.last (S.right_n + 2) := S.ir_injective (h.1.trans hrightA.symm) + · have hy : y = Fin.last (S.rightParameter + 2) := S.ir_injective (h.1.trans hrightA.symm) have hx : x = 0 := S.ir_injective (h.2.trans hrightB.symm) subst x subst y @@ -904,13 +935,19 @@ private theorem hrightAdj : ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ {m : Nat}, ∀ (x : Fin (m + 3)), ∀ (y : Fin (m + 3)), (y = x + 1 ∨ x = y + 1) ↔ (y.val = x.val + 1 ∨ x.val = y.val + 1 ∨ (x.val + 1 = m + 3 ∧ y.val = 0) ∨ (y.val + 1 = m + - 3 ∧ x.val = 0))) → ((∀ (x : Fin (S.right_n + 3)), ∀ (y : Fin (S.right_n + 3)), (x ≠ + 3 ∧ x.val = 0))) → ((∀ (x : Fin (S.rightParameter + 3)), ∀ (y : Fin (S.rightParameter + + 3)), (x ≠ y) → ((S.ir y = S.ir x + 1 ∨ S.ir x = S.ir y + 1) ↔ (y.val = x.val + 1 ∨ x.val = - y.val + 1))) → ((∀ (x : Fin (S.right_n + 3)), ∀ (y : Fin (S.right_n + 3)), ((x.val + - 1 = S.right_n + 3 ∧ y.val = 0) ∨ (y.val + 1 = S.right_n + 3 ∧ x.val = 0)) ↔ ((S.ir x - = S.a ∧ S.ir y = S.b) ∨ (S.ir y = S.a ∧ S.ir x = S.b))) → (∀ (x : Fin (S.right_n + (3 - : ℕ))), ∀ (y : Fin (S.right_n + (3 : ℕ))), x ≠ y → (y = x + (1 : Fin (S.right_n + (3 - : ℕ))) ∨ x = y + (1 : Fin (S.right_n + (3 : ℕ))) ↔ (S.ir y = S.ir x + (1 : Fin (n + + y.val + 1))) → ((∀ (x : Fin (S.rightParameter + 3)), ∀ (y : Fin (S.rightParameter + + 3)), ((x.val + + 1 = S.rightParameter + 3 ∧ y.val = 0) ∨ (y.val + 1 = S.rightParameter + 3 ∧ x.val = + 0)) ↔ ((S.ir x + = S.a ∧ S.ir y = S.b) ∨ (S.ir y = S.a ∧ S.ir x = S.b))) → (∀ (x : Fin + (S.rightParameter + (3 + : ℕ))), ∀ (y : Fin (S.rightParameter + (3 : ℕ))), x ≠ y → (y = x + (1 : Fin + (S.rightParameter + (3 + : ℕ))) ∨ x = y + (1 : Fin (S.rightParameter + (3 : ℕ))) ↔ (S.ir y = S.ir x + (1 : Fin + (n + (3 : ℕ))) ∨ S.ir x = S.ir y + (1 : Fin (n + (3 : ℕ)))) ∨ S.ir x = S.a ∧ S.ir y = S.b ∨ S.ir y = S.a ∧ S.ir x = S.b)))) ) := by classical @@ -944,16 +981,22 @@ private theorem hcrossNoAdj : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + 3 - = S.u.length + S.v.length + 2) → ((S.left_n + 3 = S.u.length + 2) → ((S.right_n + 3 = - S.v.length + 2) → ((∀ (x : Fin (S.left_n + 3)), (S.il x).val = (x.val + S.rotation) % - (n + 3)) → ((∀ (y : Fin (S.right_n + 3)), (S.ir y).val = (S.u.length + 1 + y.val + + = S.u.length + S.v.length + 2) → ((S.leftParameter + 3 = S.u.length + 2) → + ((S.rightParameter + 3 = + S.v.length + 2) → ((∀ (x : Fin (S.leftParameter + 3)), (S.il x).val = (x.val + + S.rotation) % + (n + 3)) → ((∀ (y : Fin (S.rightParameter + 3)), (S.ir y).val = (S.u.length + 1 + + y.val + S.rotation) % (n + 3)) → ((∀ {m : Nat}, ∀ {r : Nat}, ∀ {x : Nat}, ∀ {y : Nat}, (0 < m) → ((x < m) → ((y < m) → (((r + x) % m = (r + y) % m) → (x = y))))) → ((∀ {m : Nat}, ∀ {r : Nat}, ∀ {x : Nat}, (1 < m) → (((r + x) % m + 1) % m = (r + (x + 1)) - % m)) → ((S.il (0 : Fin (S.left_n + 3)) = S.a) → ((S.il (Fin.last (S.left_n + 2)) = - S.b) → ((S.ir (0 : Fin (S.right_n + 3)) = S.b) → ((S.ir (Fin.last (S.right_n + 2)) = + % m)) → ((S.il (0 : Fin (S.leftParameter + 3)) = S.a) → ((S.il (Fin.last + (S.leftParameter + 2)) = + S.b) → ((S.ir (0 : Fin (S.rightParameter + 3)) = S.b) → ((S.ir (Fin.last + (S.rightParameter + 2)) = S.a) → ((∀ (z : Fin (n + 3)), (z + 1).val = (z.val + 1) % (n + 3)) → (∀ (x : Fin - (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.right_n + (3 : ℕ))), S.il x ∉ Set.range S.ir → + (S.leftParameter + (3 : ℕ))), ∀ (y : Fin (S.rightParameter + (3 : ℕ))), S.il x ∉ + Set.range S.ir → S.ir y ∉ Set.range S.il → ¬(S.ir y = S.il x + (1 : Fin (n + (3 : ℕ))) ∨ S.il x = S.ir y + (1 : Fin (n + (3 : ℕ)))))))))))))))) ) := by classical @@ -964,11 +1007,11 @@ private theorem hcrossNoAdj : apply hxNot have hx' : x = 0 := Fin.ext (by simpa only [Fin.val_zero] using hx) rw [hx', hleftA] - exact ⟨Fin.last (S.right_n + 2), hrightA⟩ - have hxlast : x.val ≠ S.left_n + 2 := by + exact ⟨Fin.last (S.rightParameter + 2), hrightA⟩ + have hxlast : x.val ≠ S.leftParameter + 2 := by intro hx apply hxNot - have hx' : x = Fin.last (S.left_n + 2) := by + have hx' : x = Fin.last (S.leftParameter + 2) := by apply Fin.ext simp only [Fin.val_last] omega @@ -982,11 +1025,11 @@ private theorem hcrossNoAdj : apply hyNot have hy' : y = 0 := Fin.ext (by simpa only [Fin.val_zero] using hy) rw [hy', hrightB] - exact ⟨Fin.last (S.left_n + 2), hleftB⟩ - have hylast : y.val ≠ S.right_n + 2 := by + exact ⟨Fin.last (S.leftParameter + 2), hleftB⟩ + have hylast : y.val ≠ S.rightParameter + 2 := by intro hy apply hyNot - have hy' : y = Fin.last (S.right_n + 2) := by + have hy' : y = Fin.last (S.rightParameter + 2) := by apply Fin.ext simp only [Fin.val_last] omega @@ -1048,8 +1091,10 @@ private theorem hparentPairCover : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ (i - : Fin (n + 3)), i ∈ Set.range S.il ∨ i ∈ Set.range S.ir) → ((∀ (x : Fin (S.left_n + - 3)), ∀ (y : Fin (S.right_n + 3)), (S.il x ∉ Set.range S.ir) → ((S.ir y ∉ Set.range + : Fin (n + 3)), i ∈ Set.range S.il ∨ i ∈ Set.range S.ir) → ((∀ (x : Fin + (S.leftParameter + + 3)), ∀ (y : Fin (S.rightParameter + 3)), (S.il x ∉ Set.range S.ir) → ((S.ir y ∉ + Set.range S.il) → (¬(S.ir y = S.il x + 1 ∨ S.il x = S.ir y + 1)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) → i ∈ Set.range S.il ∧ j ∈ Set.range S.il ∨ i ∈ Set.range S.ir ∧ j ∈ @@ -1086,8 +1131,10 @@ private theorem hdiagPair : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (S.il - (0 : Fin (S.left_n + 3)) = S.a) → ((S.il (Fin.last (S.left_n + 2)) = S.b) → ((S.ir (0 - : Fin (S.right_n + 3)) = S.b) → ((S.ir (Fin.last (S.right_n + 2)) = S.a) → (∀ (i : + (0 : Fin (S.leftParameter + 3)) = S.a) → ((S.il (Fin.last (S.leftParameter + 2)) = + S.b) → ((S.ir (0 + : Fin (S.rightParameter + 3)) = S.b) → ((S.ir (Fin.last (S.rightParameter + 2)) = + S.a) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ≠ j → (i ∈ Set.range S.il ∧ i ∈ Set.range S.ir ∧ j ∈ Set.range S.il ∧ j ∈ Set.range S.ir ↔ i = S.a ∧ j = S.b ∨ i = S.b ∧ j = S.a))))) ) := by @@ -1113,10 +1160,10 @@ private theorem hdiagPair : subst j exact False.elim (hij rfl) · rintro (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩) - · exact ⟨⟨0, hleftA⟩, ⟨Fin.last (S.right_n + 2), hrightA⟩, - ⟨Fin.last (S.left_n + 2), hleftB⟩, ⟨0, hrightB⟩⟩ - · exact ⟨⟨Fin.last (S.left_n + 2), hleftB⟩, ⟨0, hrightB⟩, - ⟨0, hleftA⟩, ⟨Fin.last (S.right_n + 2), hrightA⟩⟩ + · exact ⟨⟨0, hleftA⟩, ⟨Fin.last (S.rightParameter + 2), hrightA⟩, + ⟨Fin.last (S.leftParameter + 2), hleftB⟩, ⟨0, hrightB⟩⟩ + · exact ⟨⟨Fin.last (S.leftParameter + 2), hleftB⟩, ⟨0, hrightB⟩, + ⟨0, hleftA⟩, ⟨Fin.last (S.rightParameter + 2), hrightA⟩⟩ private theorem hleftCountImage : (by @@ -1124,9 +1171,11 @@ private theorem hleftCountImage : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), ∀ (x : Fin - (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.left_n + (3 : ℕ))), x ≠ y → {k : Fin L.count | + (S.leftParameter + (3 : ℕ))), ∀ (y : Fin (S.leftParameter + (3 : ℕ))), x ≠ y → {k : + Fin L.count | S.il x ∈ Set.range (S.il ∘ L.face k) ∧ S.il y ∈ Set.range (S.il ∘ L.face k)}.ncard = - if y = x + (1 : Fin (S.left_n + (3 : ℕ))) ∨ x = y + (1 : Fin (S.left_n + (3 : ℕ))) + if y = x + (1 : Fin (S.leftParameter + (3 : ℕ))) ∨ x = y + (1 : Fin (S.leftParameter + + (3 : ℕ))) then (1 : ℕ) else if ∃ (k : Fin L.count), x ∈ Set.range (L.face k) ∧ y ∈ Set.range (L.face k) then (2 : ℕ) else (0 : ℕ) ) := by classical @@ -1163,9 +1212,11 @@ private theorem hrightCountImage : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), ∀ (x : Fin - (S.right_n + (3 : ℕ))), ∀ (y : Fin (S.right_n + (3 : ℕ))), x ≠ y → {k : Fin R.count | + (S.rightParameter + (3 : ℕ))), ∀ (y : Fin (S.rightParameter + (3 : ℕ))), x ≠ y → {k : + Fin R.count | S.ir x ∈ Set.range (S.ir ∘ R.face k) ∧ S.ir y ∈ Set.range (S.ir ∘ R.face k)}.ncard = - if y = x + (1 : Fin (S.right_n + (3 : ℕ))) ∨ x = y + (1 : Fin (S.right_n + (3 : ℕ))) + if y = x + (1 : Fin (S.rightParameter + (3 : ℕ))) ∨ x = y + (1 : Fin + (S.rightParameter + (3 : ℕ))) then (1 : ℕ) else if ∃ (k : Fin R.count), x ∈ Set.range (R.face k) ∧ y ∈ Set.range (R.face k) then (2 : ℕ) else (0 : ℕ) ) := by classical @@ -1282,7 +1333,8 @@ private theorem hleftFaceMem : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), ∀ (x : Fin - (S.left_n + (3 : ℕ))), ∀ (k : Fin L.count), S.il x ∈ Set.range (S.il ∘ L.face k) ↔ x + (S.leftParameter + (3 : ℕ))), ∀ (k : Fin L.count), S.il x ∈ Set.range (S.il ∘ L.face + k) ↔ x ∈ Set.range (L.face k) ) := by classical intro n p S XL L x k @@ -1299,7 +1351,8 @@ private theorem hrightFaceMem : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), ∀ (x : Fin - (S.right_n + (3 : ℕ))), ∀ (k : Fin R.count), S.ir x ∈ Set.range (S.ir ∘ R.face k) ↔ x + (S.rightParameter + (3 : ℕ))), ∀ (k : Fin R.count), S.ir x ∈ Set.range (S.ir ∘ R.face + k) ↔ x ∈ Set.range (R.face k) ) := by classical intro n p S XR R x k @@ -1316,8 +1369,9 @@ private theorem hleftUsedMap : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (x : Fin - (S.left_n + 3)), ∀ (k : Fin L.count), S.il x ∈ Set.range (S.il ∘ L.face k) ↔ x ∈ - Set.range (L.face k)) → (∀ (x : Fin (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.left_n + (3 + (S.leftParameter + 3)), ∀ (k : Fin L.count), S.il x ∈ Set.range (S.il ∘ L.face k) ↔ x ∈ + Set.range (L.face k)) → (∀ (x : Fin (S.leftParameter + (3 : ℕ))), ∀ (y : Fin + (S.leftParameter + (3 : ℕ))), (∃ (k : Fin L.count), x ∈ Set.range (L.face k) ∧ y ∈ Set.range (L.face k)) ↔ ∃ (k : Fin L.count), S.il x ∈ Set.range (S.il ∘ L.face k) ∧ S.il y ∈ Set.range (S.il ∘ L.face k)) ) := by @@ -1335,8 +1389,9 @@ private theorem hrightUsedMap : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (∀ (x : Fin - (S.right_n + 3)), ∀ (k : Fin R.count), S.ir x ∈ Set.range (S.ir ∘ R.face k) ↔ x ∈ - Set.range (R.face k)) → (∀ (x : Fin (S.right_n + (3 : ℕ))), ∀ (y : Fin (S.right_n + + (S.rightParameter + 3)), ∀ (k : Fin R.count), S.ir x ∈ Set.range (S.ir ∘ R.face k) ↔ x ∈ + Set.range (R.face k)) → (∀ (x : Fin (S.rightParameter + (3 : ℕ))), ∀ (y : Fin + (S.rightParameter + (3 : ℕ))), (∃ (k : Fin R.count), x ∈ Set.range (R.face k) ∧ y ∈ Set.range (R.face k)) ↔ ∃ (k : Fin R.count), S.ir x ∈ Set.range (S.ir ∘ R.face k) ∧ S.ir y ∈ Set.range (S.ir ∘ R.face k)) ) := by @@ -1354,13 +1409,16 @@ private theorem hleftCountMapped : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (x : Fin - (S.left_n + 3)), ∀ (y : Fin (S.left_n + 3)), (y = x + 1 ∨ x = y + 1) ↔ (S.il y = S.il + (S.leftParameter + 3)), ∀ (y : Fin (S.leftParameter + 3)), (y = x + 1 ∨ x = y + 1) ↔ + (S.il y = S.il x + 1 ∨ S.il x = S.il y + 1) ∨ (S.il x = S.a ∧ S.il y = S.b) ∨ (S.il y = S.a ∧ S.il x - = S.b)) → ((∀ (x : Fin (S.left_n + 3)), ∀ (y : Fin (S.left_n + 3)), (x ≠ y) → + = S.b)) → ((∀ (x : Fin (S.leftParameter + 3)), ∀ (y : Fin (S.leftParameter + 3)), (x + ≠ y) → (Set.ncard {k : Fin L.count | S.il x ∈ Set.range (S.il ∘ L.face k) ∧ S.il y ∈ Set.range (S.il ∘ L.face k)} = if y = x + 1 ∨ x = y + 1 then 1 else if ∃ k, x ∈ Set.range (L.face k) ∧ y ∈ Set.range (L.face k) then 2 else 0)) → ((∀ (x : Fin - (S.left_n + 3)), ∀ (y : Fin (S.left_n + 3)), (∃ k : Fin L.count, x ∈ Set.range + (S.leftParameter + 3)), ∀ (y : Fin (S.leftParameter + 3)), (∃ k : Fin L.count, x ∈ + Set.range (L.face k) ∧ y ∈ Set.range (L.face k)) ↔ (∃ k : Fin L.count, S.il x ∈ Set.range (S.il ∘ L.face k) ∧ S.il y ∈ Set.range (S.il ∘ L.face k))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.il → j ∈ Set.range S.il → i ≠ j → {k : Fin @@ -1387,13 +1445,16 @@ private theorem hrightCountMapped : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (∀ (x : Fin - (S.right_n + 3)), ∀ (y : Fin (S.right_n + 3)), (x ≠ y) → ((y = x + 1 ∨ x = y + 1) ↔ + (S.rightParameter + 3)), ∀ (y : Fin (S.rightParameter + 3)), (x ≠ y) → ((y = x + 1 ∨ + x = y + 1) ↔ (S.ir y = S.ir x + 1 ∨ S.ir x = S.ir y + 1) ∨ (S.ir x = S.a ∧ S.ir y = S.b) ∨ (S.ir y - = S.a ∧ S.ir x = S.b))) → ((∀ (x : Fin (S.right_n + 3)), ∀ (y : Fin (S.right_n + 3)), + = S.a ∧ S.ir x = S.b))) → ((∀ (x : Fin (S.rightParameter + 3)), ∀ (y : Fin + (S.rightParameter + 3)), (x ≠ y) → (Set.ncard {k : Fin R.count | S.ir x ∈ Set.range (S.ir ∘ R.face k) ∧ S.ir y ∈ Set.range (S.ir ∘ R.face k)} = if y = x + 1 ∨ x = y + 1 then 1 else if ∃ k, x ∈ Set.range (R.face k) ∧ y ∈ Set.range (R.face k) then 2 else 0)) → ((∀ (x : Fin - (S.right_n + 3)), ∀ (y : Fin (S.right_n + 3)), (∃ k : Fin R.count, x ∈ Set.range + (S.rightParameter + 3)), ∀ (y : Fin (S.rightParameter + 3)), (∃ k : Fin R.count, x ∈ + Set.range (R.face k) ∧ y ∈ Set.range (R.face k)) ↔ (∃ k : Fin R.count, S.ir x ∈ Set.range (S.ir ∘ R.face k) ∧ S.ir y ∈ Set.range (S.ir ∘ R.face k))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.ir → j ∈ Set.range S.ir → i ≠ j → {k : Fin @@ -1475,8 +1536,10 @@ private theorem hnotDiagBoundary : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (S.il - (0 : Fin (S.left_n + 3)) = S.a) → ((S.il (Fin.last (S.left_n + 2)) = S.b) → ((∀ (x : - Fin (S.left_n + 3)), ∀ (y : Fin (S.left_n + 3)), (S.il y = S.il x + 1 ∨ S.il x = S.il + (0 : Fin (S.leftParameter + 3)) = S.a) → ((S.il (Fin.last (S.leftParameter + 2)) = + S.b) → ((∀ (x : + Fin (S.leftParameter + 3)), ∀ (y : Fin (S.leftParameter + 3)), (S.il y = S.il x + 1 ∨ + S.il x = S.il y + 1) ↔ (y.val = x.val + 1 ∨ x.val = y.val + 1)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b → ¬(j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))))))) ) := by @@ -1484,22 +1547,24 @@ private theorem hnotDiagBoundary : intro n p S hleftA hleftB hleftOrd i j hdiag rcases hdiag with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ · intro h - have hlocal : S.il (Fin.last (S.left_n + 2)) = - S.il (0 : Fin (S.left_n + 3)) + 1 ∨ - S.il (0 : Fin (S.left_n + 3)) = - S.il (Fin.last (S.left_n + 2)) + 1 := by + have hlocal : S.il (Fin.last (S.leftParameter + 2)) = + S.il (0 : Fin (S.leftParameter + 3)) + 1 ∨ + S.il (0 : Fin (S.leftParameter + 3)) = + S.il (Fin.last (S.leftParameter + 2)) + 1 := by simpa only [hleftA, hleftB] using h - have hnum := (hleftOrd (0 : Fin (S.left_n + 3)) (Fin.last (S.left_n + 2))).mp hlocal + have hnum := (hleftOrd (0 : Fin (S.leftParameter + 3)) (Fin.last (S.leftParameter + 2))).mp + hlocal have hu : 0 < S.u.length := S.hu simp only [Fin.val_zero, Fin.val_last] at hnum omega · intro h - have hlocal : S.il (0 : Fin (S.left_n + 3)) = - S.il (Fin.last (S.left_n + 2)) + 1 ∨ - S.il (Fin.last (S.left_n + 2)) = - S.il (0 : Fin (S.left_n + 3)) + 1 := by + have hlocal : S.il (0 : Fin (S.leftParameter + 3)) = + S.il (Fin.last (S.leftParameter + 2)) + 1 ∨ + S.il (Fin.last (S.leftParameter + 2)) = + S.il (0 : Fin (S.leftParameter + 3)) + 1 := by simpa only [hleftA, hleftB] using h - have hnum := (hleftOrd (Fin.last (S.left_n + 2)) (0 : Fin (S.left_n + 3))).mp hlocal + have hnum := (hleftOrd (Fin.last (S.leftParameter + 2)) (0 : Fin (S.leftParameter + 3))).mp + hlocal have hu : 0 < S.u.length := S.hu simp only [Fin.val_zero, Fin.val_last] at hnum omega @@ -2037,13 +2102,16 @@ private theorem hleftOrd : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + - (3 : ℕ) = S.u.length + S.v.length + (2 : ℕ)) → ((S.left_n + (3 : ℕ) = S.u.length + (2 - : ℕ)) → ((S.right_n + (3 : ℕ) = S.v.length + (2 : ℕ)) → ((∀ (x : Fin (S.left_n + (3 : + (3 : ℕ) = S.u.length + S.v.length + (2 : ℕ)) → ((S.leftParameter + (3 : ℕ) = + S.u.length + (2 + : ℕ)) → ((S.rightParameter + (3 : ℕ) = S.v.length + (2 : ℕ)) → ((∀ (x : Fin + (S.leftParameter + (3 : ℕ))), (↑(S.il x) : ℕ) = ((↑x : ℕ) + S.rotation) % (n + (3 : ℕ))) → ((∀ {m : ℕ}, ∀ {r : ℕ}, ∀ {x : ℕ}, ∀ {y : ℕ}, (0 : ℕ) < m → x < m → y < m → (r + x) % m = (r + y) % m → x = y) → ((∀ {m : ℕ}, ∀ {r : ℕ}, ∀ {x : ℕ}, (1 : ℕ) < m → ((r + x) % m + (1 : ℕ)) % m = (r + (x + (1 : ℕ))) % m) → ((∀ (z : Fin (n + 3)), (z + 1).val = (z.val + 1) % - (n + 3)) → (∀ (x : Fin (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.left_n + (3 : ℕ))), S.il + (n + 3)) → (∀ (x : Fin (S.leftParameter + (3 : ℕ))), ∀ (y : Fin (S.leftParameter + (3 + : ℕ))), S.il y = S.il x + (1 : Fin (n + (3 : ℕ))) ∨ S.il x = S.il y + (1 : Fin (n + (3 : ℕ))) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : ℕ) + (1 : ℕ)))))))) ) := by classical @@ -2061,9 +2129,12 @@ private theorem hleftCountMapped : Fin (m + (3 : ℕ))), ∀ (y : Fin (m + (3 : ℕ))), y = x + (1 : Fin (m + (3 : ℕ))) ∨ x = y + (1 : Fin (m + (3 : ℕ))) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) + (1 : ℕ) = m + (3 : ℕ) ∧ (↑y : ℕ) = (0 : ℕ) ∨ (↑y : ℕ) + (1 : ℕ) - = m + (3 : ℕ) ∧ (↑x : ℕ) = (0 : ℕ)) → ((S.il (0 : Fin (S.left_n + (3 : ℕ))) = S.a) → - ((S.il (Fin.last (S.left_n + (2 : ℕ))) = S.b) → ((∀ (x : Fin (S.left_n + (3 : ℕ))), ∀ - (y : Fin (S.left_n + (3 : ℕ))), S.il y = S.il x + (1 : Fin (n + (3 : ℕ))) ∨ S.il x = + = m + (3 : ℕ) ∧ (↑x : ℕ) = (0 : ℕ)) → ((S.il (0 : Fin (S.leftParameter + (3 : ℕ))) = + S.a) → + ((S.il (Fin.last (S.leftParameter + (2 : ℕ))) = S.b) → ((∀ (x : Fin (S.leftParameter + + (3 : ℕ))), ∀ + (y : Fin (S.leftParameter + (3 : ℕ))), S.il y = S.il x + (1 : Fin (n + (3 : ℕ))) ∨ + S.il x = S.il y + (1 : Fin (n + (3 : ℕ))) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : ℕ) + (1 : ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.il → j ∈ Set.range S.il → i ≠ j → {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face @@ -2085,8 +2156,10 @@ private theorem hrightCountMapped : exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (n + (3 : ℕ) = - S.u.length + S.v.length + (2 : ℕ)) → ((S.left_n + (3 : ℕ) = S.u.length + (2 : ℕ)) → - ((S.right_n + (3 : ℕ) = S.v.length + (2 : ℕ)) → ((∀ (y : Fin (S.right_n + (3 : ℕ))), + S.u.length + S.v.length + (2 : ℕ)) → ((S.leftParameter + (3 : ℕ) = S.u.length + (2 : + ℕ)) → + ((S.rightParameter + (3 : ℕ) = S.v.length + (2 : ℕ)) → ((∀ (y : Fin (S.rightParameter + + (3 : ℕ))), (↑(S.ir y) : ℕ) = (S.u.length + (1 : ℕ) + (↑y : ℕ) + S.rotation) % (n + (3 : ℕ))) → ((∀ {m : ℕ}, ∀ {r : ℕ}, ∀ {x : ℕ}, ∀ {y : ℕ}, (0 : ℕ) < m → x < m → y < m → (r + x) % m = (r + y) % m → x = y) → ((∀ {m : ℕ}, ∀ {r : ℕ}, ∀ {x : ℕ}, (1 : ℕ) < m → ((r + x) @@ -2094,8 +2167,9 @@ private theorem hrightCountMapped : ℕ))), ∀ (y : Fin (m + (3 : ℕ))), y = x + (1 : Fin (m + (3 : ℕ))) ∨ x = y + (1 : Fin (m + (3 : ℕ))) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) + (1 : ℕ) = m + (3 : ℕ) ∧ (↑y : ℕ) = (0 : ℕ) ∨ (↑y : ℕ) + (1 : ℕ) = m + (3 : ℕ) - ∧ (↑x : ℕ) = (0 : ℕ)) → ((S.ir (0 : Fin (S.right_n + (3 : ℕ))) = S.b) → ((S.ir - (Fin.last (S.right_n + (2 : ℕ))) = S.a) → ((∀ (z : Fin (n + 3)), (z + 1).val = (z.val + ∧ (↑x : ℕ) = (0 : ℕ)) → ((S.ir (0 : Fin (S.rightParameter + (3 : ℕ))) = S.b) → ((S.ir + (Fin.last (S.rightParameter + (2 : ℕ))) = S.a) → ((∀ (z : Fin (n + 3)), (z + 1).val = + (z.val + 1) % (n + 3)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.ir → j ∈ Set.range S.ir → i ≠ j → {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)}.ncard = if j = i + (1 : Fin (n + (3 : @@ -2145,8 +2219,10 @@ private theorem hnotDiagBoundary : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (S.il - (0 : Fin (S.left_n + (3 : ℕ))) = S.a) → ((S.il (Fin.last (S.left_n + (2 : ℕ))) = S.b) - → ((∀ (x : Fin (S.left_n + (3 : ℕ))), ∀ (y : Fin (S.left_n + (3 : ℕ))), S.il y = S.il + (0 : Fin (S.leftParameter + (3 : ℕ))) = S.a) → ((S.il (Fin.last (S.leftParameter + (2 + : ℕ))) = S.b) + → ((∀ (x : Fin (S.leftParameter + (3 : ℕ))), ∀ (y : Fin (S.leftParameter + (3 : ℕ))), + S.il y = S.il x + (1 : Fin (n + (3 : ℕ))) ∨ S.il x = S.il y + (1 : Fin (n + (3 : ℕ))) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : ℕ) + (1 : ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b → ¬(j = i + (1 : Fin @@ -2160,15 +2236,19 @@ private theorem hcoverPair : classical exact ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (n + - (3 : ℕ) = S.u.length + S.v.length + (2 : ℕ)) → ((S.left_n + (3 : ℕ) = S.u.length + (2 - : ℕ)) → ((S.right_n + (3 : ℕ) = S.v.length + (2 : ℕ)) → ((∀ (x : Fin (S.left_n + (3 : + (3 : ℕ) = S.u.length + S.v.length + (2 : ℕ)) → ((S.leftParameter + (3 : ℕ) = + S.u.length + (2 + : ℕ)) → ((S.rightParameter + (3 : ℕ) = S.v.length + (2 : ℕ)) → ((∀ (x : Fin + (S.leftParameter + (3 : ℕ))), (↑(S.il x) : ℕ) = ((↑x : ℕ) + S.rotation) % (n + (3 : ℕ))) → ((∀ (y : Fin - (S.right_n + (3 : ℕ))), (↑(S.ir y) : ℕ) = (S.u.length + (1 : ℕ) + (↑y : ℕ) + + (S.rightParameter + (3 : ℕ))), (↑(S.ir y) : ℕ) = (S.u.length + (1 : ℕ) + (↑y : ℕ) + S.rotation) % (n + (3 : ℕ))) → ((∀ {m : ℕ}, ∀ {r : ℕ}, ∀ {x : ℕ}, ∀ {y : ℕ}, (0 : ℕ) < m → x < m → y < m → (r + x) % m = (r + y) % m → x = y) → ((∀ {m : ℕ}, ∀ {r : ℕ}, ∀ {x : ℕ}, (1 : ℕ) < m → ((r + x) % m + (1 : ℕ)) % m = (r + (x + (1 : ℕ))) % m) → - ((S.il (0 : Fin (S.left_n + (3 : ℕ))) = S.a) → ((S.il (Fin.last (S.left_n + (2 : ℕ))) - = S.b) → ((S.ir (0 : Fin (S.right_n + (3 : ℕ))) = S.b) → ((S.ir (Fin.last (S.right_n + ((S.il (0 : Fin (S.leftParameter + (3 : ℕ))) = S.a) → ((S.il (Fin.last + (S.leftParameter + (2 : ℕ))) + = S.b) → ((S.ir (0 : Fin (S.rightParameter + (3 : ℕ))) = S.b) → ((S.ir (Fin.last + (S.rightParameter + (2 : ℕ))) = S.a) → ((∀ (z : Fin (n + 3)), (z + 1).val = (z.val + 1) % (n + 3)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ)))) → (i ∈ Set.range S.il ∧ j ∈ Set.range S.il ∨ i ∈ @@ -2534,10 +2614,11 @@ theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} have hlenP := IndexedFaceLedgerProof.hlenP n p S have hlenL := IndexedFaceLedgerProof.hlenL n p S have hlenR := IndexedFaceLedgerProof.hlenR n p S - have hleftcoord (x : Fin (S.left_n + 3)) := IndexedFaceLedgerProof.hleftcoord n p S hlenP + have hleftcoord (x : Fin (S.leftParameter + 3)) := IndexedFaceLedgerProof.hleftcoord n p S hlenP hlenL hlenR x have haCoord := IndexedFaceLedgerProof.haCoord n p S hlenP hlenL hlenR - have hrightcoord (y : Fin (S.right_n + 3)) := IndexedFaceLedgerProof.hrightcoord n p S hlenP + have hrightcoord (y : Fin (S.rightParameter + 3)) := IndexedFaceLedgerProof.hrightcoord n p S + hlenP hlenL hlenR haCoord y have hmodShift {m r x y : Nat} (hm : 0 < m) (hx : x < m) (hy : y < m) (he : (r + x) % m = (r + y) % m) := IndexedLedgerAssembly.hmodShift n p S (m := m) (r := @@ -2551,7 +2632,8 @@ theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} have hrightA := IndexedFaceLedgerProof.hrightA n p S have hparentSuccVal (z : Fin (n + 3)) : (z + 1).val = (z.val + 1) % (n + 3) := by rw [Fin.val_add, Fin.val_one] - have hleftOrd (x y : Fin (S.left_n + 3)) := IndexedLedgerAssembly.hleftOrd n p S hlenP hlenL + have hleftOrd (x y : Fin (S.leftParameter + 3)) := IndexedLedgerAssembly.hleftOrd n p S hlenP + hlenL hlenR hleftcoord hmodShift hmodSucc hparentSuccVal x y have hdiagPair (i j : Fin (n + 3)) (hij : i ≠ j) := IndexedFaceLedgerProof.hdiagPair n p S hleftA hleftB hrightB hrightA i j hij diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1ParentOddGluing.lean b/LeanPool/ApollonianSuperharmonic/P3652T1ParentOddGluing.lean index bc36a0b553..15e42426da 100644 --- a/LeanPool/ApollonianSuperharmonic/P3652T1ParentOddGluing.lean +++ b/LeanPool/ApollonianSuperharmonic/P3652T1ParentOddGluing.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3544T1DiagonalSplit -public import Mathlib.Analysis.Convex.PathConnected -public import Mathlib.Analysis.Normed.Module.Convex +public import LeanPool.ApollonianSuperharmonic.P3544T1LocalParity +public import Mathlib.Algebra.CharP.Invertible -- [TABLET NODE: P3652T1ParentOddGluing] diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1TriangleFaceRestriction.lean b/LeanPool/ApollonianSuperharmonic/P3652T1TriangleFaceRestriction.lean index efdf33db7a..f0f49fa2d3 100644 --- a/LeanPool/ApollonianSuperharmonic/P3652T1TriangleFaceRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/P3652T1TriangleFaceRestriction.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Linarith + public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant public import Mathlib.Analysis.Convex.Combination diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean index 9ea9fdfa6c..11fa41122b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting public import LeanPool.ApollonianSuperharmonic.P3723T1GridDiskBoundaryStars public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas /-! # P3723T1AllContactDrawingExists diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactRouting.lean b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactRouting.lean index 95c26ea4c1..f4f0e2340f 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactRouting.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactRouting.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3723T1ContactPorts public import LeanPool.ApollonianSuperharmonic.P3723T1PolygonalParameterization diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1ContactPorts.lean b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPorts.lean index 7692bb9e77..a6fa2faad3 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1ContactPorts.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPorts.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3723T1EdgeContact -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.TileRealization -- [TABLET NODE: P3723T1ContactPorts] diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean index 36bd0e9669..ac106537ea 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean @@ -5,13 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3723T1ContactPorts public import LeanPool.ApollonianSuperharmonic.P3723T1ContactStabilizer public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import Mathlib.Topology.Order.DenselyOrdered -public import Mathlib.Data.Quot -- [TABLET NODE: P3723T1ContactPortsExist] diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1ContactStabilizer.lean b/LeanPool/ApollonianSuperharmonic/P3723T1ContactStabilizer.lean index 77dcd16d27..e57d1a540e 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1ContactStabilizer.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1ContactStabilizer.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore -public import Mathlib.Tactic.Linarith -- [TABLET NODE: P3723T1ContactStabilizer] diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialIntersection.lean b/LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialIntersection.lean index 66f643219a..793a77bccc 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialIntersection.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialIntersection.lean @@ -5,12 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + public import Mathlib.Analysis.Convex.Topology -public import Mathlib.Analysis.Convex.PathConnected -public import Mathlib.Topology.Homeomorph.Lemmas -public import Mathlib.Tactic.FieldSimp -public import Mathlib.Tactic.Linarith /-! # P3723T1ConvexRadialIntersection diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialParameterization.lean b/LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialParameterization.lean index efed3818a3..eb26d484df 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialParameterization.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1ConvexRadialParameterization.lean @@ -5,12 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import Mathlib.Analysis.Convex.Topology -public import Mathlib.Analysis.Convex.PathConnected -public import Mathlib.Topology.Homeomorph.Lemmas -public import Mathlib.Tactic.FieldSimp -public import Mathlib.Tactic.Linarith /-! # P3723T1ConvexRadialParameterization diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1EdgeContact.lean b/LeanPool/ApollonianSuperharmonic/P3723T1EdgeContact.lean index df61ca553e..cda56a4919 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1EdgeContact.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1EdgeContact.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex -- [TABLET NODE: P3723T1EdgeContact] diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1GridDiskBoundaryStars.lean b/LeanPool/ApollonianSuperharmonic/P3723T1GridDiskBoundaryStars.lean index c057c346a0..58308e92b1 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1GridDiskBoundaryStars.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1GridDiskBoundaryStars.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3723T1GridDiskPairedModel public import LeanPool.ApollonianSuperharmonic.P3723T1ConvexRadialIntersection public import LeanPool.ApollonianSuperharmonic.P3723T1ConvexRadialParameterization diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1GridDiskPairedModel.lean b/LeanPool/ApollonianSuperharmonic/P3723T1GridDiskPairedModel.lean index c5bdc788f8..0960614c56 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1GridDiskPairedModel.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1GridDiskPairedModel.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeTileComplementGridConnected public import LeanPool.ApollonianSuperharmonic.P3475T1GridBoundary public import LeanPool.ApollonianSuperharmonic.P3475T1BoundaryReduction @@ -13,7 +14,6 @@ public import LeanPool.ApollonianSuperharmonic.P3475T1PolygonTriangleConstructio public import LeanPool.ApollonianSuperharmonic.P3475T1PolygonalSeparation public import LeanPool.ApollonianSuperharmonic.P3475T1SquareUnionIdentification public import LeanPool.ApollonianSuperharmonic.P3475T1BoundaryRestoration -public import LeanPool.ApollonianSuperharmonic.P3381T1PiecewiseAffinePolygonModel -- [TABLET NODE: P3723T1GridDiskPairedModel] diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1PairedModelSegmentPullback.lean b/LeanPool/ApollonianSuperharmonic/P3723T1PairedModelSegmentPullback.lean index 1c2e884bae..a9cb5ade46 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1PairedModelSegmentPullback.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1PairedModelSegmentPullback.lean @@ -5,9 +5,17 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import LeanPool.ApollonianSuperharmonic.P3723T1PolygonalParameterization -public import LeanPool.ApollonianSuperharmonic.P3381T1PiecewiseAffinePolygonModel -public import Mathlib.Data.Finset.Sort +public import LeanPool.ApollonianSuperharmonic.P3381T1PairedTriangulation +public import Mathlib.Algebra.Order.Ring.Star +public import Mathlib.Analysis.Convex.Topology +public import Mathlib.Analysis.Normed.Group.Basic +public import Mathlib.Data.EReal.Inv +public import Mathlib.Topology.Algebra.InfiniteSum.Order +public import Mathlib.Topology.Metrizable.Uniformity -- [TABLET NODE: P3723T1PairedModelSegmentPullback] @@ -77,7 +85,7 @@ private theorem hFbounds : rcases hxpair with rfl | rfl <;> norm_num · obtain ⟨k, _, hxk⟩ := Finset.mem_biUnion.mp hxends by_cases hk : (I k).Nonempty - · simp? [hk] at hxk + · simp only [hk, ↓reduceIte, Finset.mem_insert, Finset.mem_singleton] at hxk rcases hxk with hxlo | hxhi · subst x have hm := hlo_mem k hk diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1PolygonalParameterization.lean b/LeanPool/ApollonianSuperharmonic/P3723T1PolygonalParameterization.lean index b50224881c..c8c259cb05 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1PolygonalParameterization.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1PolygonalParameterization.lean @@ -5,8 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble -public import Mathlib.Analysis.Convex.Segment +public import Mathlib.Init +public import Mathlib.Order.Fin.Basic +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Basic.Real.Basic +public import Mathlib.Order.Interval.Set.Basic + +public import Mathlib.Algebra.Order.Algebra -- [TABLET NODE: P3723T1PolygonalParameterization] diff --git a/LeanPool/ApollonianSuperharmonic/P3767T1BarrierRegionMaximal.lean b/LeanPool/ApollonianSuperharmonic/P3767T1BarrierRegionMaximal.lean index 74e87b33bb..b302858bcb 100644 --- a/LeanPool/ApollonianSuperharmonic/P3767T1BarrierRegionMaximal.lean +++ b/LeanPool/ApollonianSuperharmonic/P3767T1BarrierRegionMaximal.lean @@ -5,8 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init public import Mathlib.Topology.Connected.Basic +public import Mathlib.Topology.Defs.Basic + -- [TABLET NODE: P3767T1BarrierRegionMaximal] diff --git a/LeanPool/ApollonianSuperharmonic/P3767T1FixedFaceComponents.lean b/LeanPool/ApollonianSuperharmonic/P3767T1FixedFaceComponents.lean index 4537c84517..38e7ecf77a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3767T1FixedFaceComponents.lean +++ b/LeanPool/ApollonianSuperharmonic/P3767T1FixedFaceComponents.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.FinCases + public import LeanPool.ApollonianSuperharmonic.P3767T1FixedTrace public import LeanPool.ApollonianSuperharmonic.P3767T1BarrierRegionMaximal public import LeanPool.ApollonianSuperharmonic.P3767T1VertexEdgeIncidence diff --git a/LeanPool/ApollonianSuperharmonic/P3767T1FixedTrace.lean b/LeanPool/ApollonianSuperharmonic/P3767T1FixedTrace.lean index 5b6e0b6f87..67be9852e3 100644 --- a/LeanPool/ApollonianSuperharmonic/P3767T1FixedTrace.lean +++ b/LeanPool/ApollonianSuperharmonic/P3767T1FixedTrace.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation -- [TABLET NODE: P3767T1FixedTrace] diff --git a/LeanPool/ApollonianSuperharmonic/P3767T1VertexEdgeIncidence.lean b/LeanPool/ApollonianSuperharmonic/P3767T1VertexEdgeIncidence.lean index 0ecf42183b..d87d2d2e76 100644 --- a/LeanPool/ApollonianSuperharmonic/P3767T1VertexEdgeIncidence.lean +++ b/LeanPool/ApollonianSuperharmonic/P3767T1VertexEdgeIncidence.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: P3767T1VertexEdgeIncidence] diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean b/LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean index a0d3edf054..54090ebb63 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3776T1DiskMapExponentialLift -public import Mathlib.Analysis.SpecialFunctions.Trigonometric.Complex -public import Mathlib.Analysis.SpecialFunctions.Complex.Log -- [TABLET NODE: P3776T1BoundedDisplacementSurjective] diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1CellCenterMembership.lean b/LeanPool/ApollonianSuperharmonic/P3776T1CellCenterMembership.lean index a8d0ed5821..f2fdccd9a7 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1CellCenterMembership.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1CellCenterMembership.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileRealization public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import Mathlib.Tactic.Linarith -- [TABLET NODE: P3776T1CellCenterMembership] diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1DiskMapExponentialLift.lean b/LeanPool/ApollonianSuperharmonic/P3776T1DiskMapExponentialLift.lean index 787b346312..28c88a0d8b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1DiskMapExponentialLift.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1DiskMapExponentialLift.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + public import Mathlib.Analysis.Complex.CoveringMap public import Mathlib.Analysis.Normed.Module.Connected -public import Mathlib.Topology.Algebra.Module.LocallyConvex public import Mathlib.Topology.Homotopy.Lifting -- [TABLET NODE: P3776T1DiskMapExponentialLift] diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1DualEdges.lean b/LeanPool/ApollonianSuperharmonic/P3776T1DualEdges.lean index 63515312e5..799300c22c 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1DualEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1DualEdges.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3776T1WalkMap public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore -public import Mathlib.Tactic.Linarith -- [TABLET NODE: P3776T1DualEdges] diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean b/LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean index 466d87d590..226e34d5b0 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3776T1DualEdges public import LeanPool.ApollonianSuperharmonic.P3776T1WalkMapProperties -public import Mathlib.Topology.Algebra.Field -public import Mathlib.Topology.Algebra.Order.Field -- [TABLET NODE: P3776T1DualEdgesExist] diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1EquivariantDisplacementBound.lean b/LeanPool/ApollonianSuperharmonic/P3776T1EquivariantDisplacementBound.lean index 0f612cef62..0c8b3232e7 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1EquivariantDisplacementBound.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1EquivariantDisplacementBound.lean @@ -5,13 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeFundamentalSet public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import Mathlib.Topology.MetricSpace.ProperSpace public import Mathlib.Analysis.Normed.Group.Bounded public import Mathlib.Analysis.Normed.Group.Real -public import Mathlib.Algebra.Order.Floor.Ring -public import Mathlib.Tactic.Linarith -- [TABLET NODE: P3776T1EquivariantDisplacementBound] diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1FixedGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3776T1FixedGeometry.lean index 4dafe3da77..32e4de306e 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1FixedGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1FixedGeometry.lean @@ -5,21 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3776T1OpenStar public import LeanPool.ApollonianSuperharmonic.P3767T1FixedFaceComponents -public import Mathlib.Topology.Compactness.LocallyFinite -public import Mathlib.Topology.MetricSpace.ProperSpace public import Mathlib.Analysis.Normed.Group.Bounded public import Mathlib.Analysis.Normed.Group.Real public import Mathlib.Analysis.Normed.Group.Constructions -public import Mathlib.Topology.Order.IntermediateValue -public import Mathlib.Topology.Algebra.Group.Basic -public import Mathlib.Tactic.FinCases -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.NormNum -public import Mathlib.Tactic.Tauto -public import Mathlib.Data.Int.Interval -public import Mathlib.Algebra.Order.Floor.Ring -- [TABLET NODE: P3776T1FixedGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1OpenStar.lean b/LeanPool/ApollonianSuperharmonic/P3776T1OpenStar.lean index 850ea3a81e..3ee54f891c 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1OpenStar.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1OpenStar.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore -- [TABLET NODE: P3776T1OpenStar] diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1PlaneMapExists.lean b/LeanPool/ApollonianSuperharmonic/P3776T1PlaneMapExists.lean index 9be72a8df5..ee29df3658 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1PlaneMapExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1PlaneMapExists.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3776T1StarWeightsExist public import LeanPool.ApollonianSuperharmonic.P3776T1TileContractionsExist public import LeanPool.ApollonianSuperharmonic.P3776T1DualEdgesExist diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1SectorMaps.lean b/LeanPool/ApollonianSuperharmonic/P3776T1SectorMaps.lean index 6f51a7bc59..81406a89cf 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1SectorMaps.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1SectorMaps.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3776T1DualEdges public import LeanPool.ApollonianSuperharmonic.P3776T1TileContractions public import LeanPool.ApollonianSuperharmonic.StandardSimplex -public import Mathlib.Topology.ContinuousMap.Basic -- [TABLET NODE: P3776T1SectorMaps] diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean b/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean index c366993243..ef33352945 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean @@ -5,12 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import Mathlib.Algebra.Order.Interval.Set.Instances public import LeanPool.ApollonianSuperharmonic.P3776T1SectorMaps public import LeanPool.ApollonianSuperharmonic.P3832T1CollapsedConeDescent public import LeanPool.ApollonianSuperharmonic.P3832T1ChamberOverlap public import LeanPool.ApollonianSuperharmonic.P3832T1FiniteClosedCoverPasting +public import Mathlib.Algebra.BigOperators.Fin -- [TABLET NODE: P3776T1SectorMapsExist] @@ -1625,7 +1628,7 @@ private theorem sectorGlobalChosen_edge : have hrad : (sectorParam o s ho).1.1 = rad := by apply Subtype.ext have vals := sectorParam_values o s ho - simp? [o, sectorJ, sectorK] at vals + simp only [ne_eq, o, sectorJ, sectorK] at vals calc (sectorParam o s ho).1.1 = 2*(s.1 i-s.1 k)+3*s.1 k := vals.1 _ = 2*(r:ℝ) := by rw [hi,hk]; ring @@ -1633,7 +1636,7 @@ private theorem sectorGlobalChosen_edge : have hbeta : (sectorParam o s ho).1.2 = rad := by apply Subtype.ext have vals := sectorParam_values o s ho - simp? [o, sectorJ, sectorK] at vals + simp only [ne_eq, o, sectorJ, sectorK] at vals calc (sectorParam o s ho).1.2 = 2*(s.1 i-s.1 k) := vals.2 _ = 2*(r:ℝ) := by rw [hi,hk]; ring @@ -1671,7 +1674,7 @@ private theorem sectorGlobalChosen_edge : have hrad : (sectorParam o s ho).1.1 = rad := by apply Subtype.ext have vals := sectorParam_values o s ho - simp? [o, sectorJ, sectorK] at vals + simp only [ne_eq, o, sectorJ, sectorK] at vals calc (sectorParam o s ho).1.1 = 2*(s.1 j-s.1 k)+3*s.1 k := vals.1 _ = 2*(1-(r:ℝ)) := by rw [hj,hk]; ring @@ -1679,7 +1682,7 @@ private theorem sectorGlobalChosen_edge : have hbeta : (sectorParam o s ho).1.2 = rad := by apply Subtype.ext have vals := sectorParam_values o s ho - simp? [o, sectorJ, sectorK] at vals + simp only [ne_eq, o, sectorJ, sectorK] at vals calc (sectorParam o s ho).1.2 = 2*(s.1 j-s.1 k) := vals.2 _ = 2*(1-(r:ℝ)) := by rw [hj,hk]; ring diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1StarWeights.lean b/LeanPool/ApollonianSuperharmonic/P3776T1StarWeights.lean index 6a7adfc0a9..6c51345e5b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1StarWeights.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1StarWeights.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3776T1OpenStar public import LeanPool.ApollonianSuperharmonic.StandardSimplex diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1StarWeightsExist.lean b/LeanPool/ApollonianSuperharmonic/P3776T1StarWeightsExist.lean index 6d6863fd5e..1d4a0870ba 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1StarWeightsExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1StarWeightsExist.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry public import LeanPool.ApollonianSuperharmonic.P3776T1StarWeights public import Mathlib.Topology.MetricSpace.HausdorffDistance -public import Mathlib.Topology.Algebra.Monoid -public import Mathlib.Algebra.BigOperators.Finprod -- [TABLET NODE: P3776T1StarWeightsExist] diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1TileContractions.lean b/LeanPool/ApollonianSuperharmonic/P3776T1TileContractions.lean index 70a9785392..53e52cbe8f 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1TileContractions.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1TileContractions.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore -- [TABLET NODE: P3776T1TileContractions] diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1TileContractionsExist.lean b/LeanPool/ApollonianSuperharmonic/P3776T1TileContractionsExist.lean index 701e6159f1..d4157165ae 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1TileContractionsExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1TileContractionsExist.lean @@ -5,10 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3776T1TileContractions -public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import Mathlib.Analysis.Normed.Module.Convex +public import Mathlib.Algebra.Order.Algebra +public import Mathlib.Analysis.Normed.Module.Basic +public import Mathlib.Data.EReal.Inv +public import Mathlib.Tactic.Bound -- [TABLET NODE: P3776T1TileContractionsExist] diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1WalkMap.lean b/LeanPool/ApollonianSuperharmonic/P3776T1WalkMap.lean index 65e027e092..3f10ffc4e0 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1WalkMap.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1WalkMap.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import Mathlib.Algebra.Order.Floor.Ring /-! # P3776T1WalkMap diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean b/LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean index 91452bf197..b2231f8338 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean @@ -5,15 +5,17 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3776T1WalkMap public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import Mathlib.Tactic.Linarith -public import Mathlib.Topology.Algebra.Module.Basic -public import Mathlib.Analysis.Normed.Module.Basic public import Mathlib.Tactic.Module public import Mathlib.Data.List.GetD +public import Mathlib.Analysis.Normed.Group.Basic +public import Mathlib.Topology.Algebra.InfiniteSum.Order +public import Mathlib.Topology.Algebra.Ring.Real -- [TABLET NODE: P3776T1WalkMapProperties] @@ -377,12 +379,12 @@ private theorem walk_end : have hlen : n + 1 = p.length := by dsimp [n]; omega have hleft : ((n - 1 : Nat) : Real) / ((p.length : Real) - 1) ≤ (t1 : Real) := by rw [div_le_iff₀ hden] - simp? [t1] + simp only [one_mul, t1] rw [← hncast] exact_mod_cast (Nat.sub_le n 1) have hright' : (t1 : Real) ≤ ((n - 1 + 1 : Nat) : Real) / ((p.length : Real) - 1) := by rw [le_div_iff₀ hden] - simp? [t1, Nat.sub_add_cancel (by omega : 1 ≤ n)] + simp only [one_mul, Nat.sub_add_cancel (by omega : 1 ≤ n), tsub_le_iff_right, t1] exact_mod_cast hlen.symm.le have hval := hseg p (n - 1) (by dsimp [n]; omega) t1 hleft hright' rw [← hlen] at hval diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrement.lean b/LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrement.lean index 20c5f3cdc9..e08fa56282 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrement.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrement.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module -public import Mathlib.Analysis.SpecialFunctions.Complex.Circle -public import Mathlib.Topology.Homotopy.Path -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.Algebra.Order.Algebra +public import Mathlib.Analysis.SpecialFunctions.Log.Basic +public import Mathlib.Analysis.SpecialFunctions.Trigonometric.Basic +public import Mathlib.Topology.UnitInterval -- [TABLET NODE: P3821T1AngularIncrement] diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrementLaws.lean b/LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrementLaws.lean index 3e0ac012b9..ac2fed910a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrementLaws.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1AngularIncrementLaws.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3821T1AngularIncrement public import Mathlib.Topology.Homotopy.Lifting +public import Mathlib.Analysis.SpecialFunctions.Complex.Circle -- [TABLET NODE: P3821T1AngularIncrementLaws] diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean b/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean index ff46374722..df23c4ab6a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean @@ -5,13 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3821T1ControlledNeighborhood public import LeanPool.ApollonianSuperharmonic.P3821T1ComponentContours -public import LeanPool.ApollonianSuperharmonic.P3821T1LoopIndexLaws -public import Mathlib.Analysis.Complex.Basic public import Mathlib.Analysis.Normed.Module.Connected -public import Mathlib.Topology.Connected.PathConnected -public import Mathlib.Topology.Homeomorph.Lemmas public import Mathlib.LinearAlgebra.Complex.FiniteDimensional -- [TABLET NODE: P3821T1CircleComponentBound] diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean index ed10e4778a..308356ad11 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean @@ -5,30 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3821T1LoopIndex -public import LeanPool.ApollonianSuperharmonic.P3821T1AngularIncrementLaws -public import Mathlib.Topology.Connected.LocallyConnected -public import Mathlib.Topology.MetricSpace.Bounded -public import Mathlib.Topology.MetricSpace.Thickening -public import Mathlib.Analysis.Convex.PathConnected -public import Mathlib.Analysis.Normed.Module.Connected public import Mathlib.GroupTheory.Perm.Cycle.Concrete -public import Mathlib.GroupTheory.Perm.Cycle.Factors -public import Mathlib.Algebra.BigOperators.Group.Finset.Basic -public import Mathlib.Data.List.Chain -public import Mathlib.Basic.Real.Basic public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent -public import Mathlib.Data.Fin.VecNotation -public import Mathlib.Algebra.BigOperators.Fin public import Mathlib.Algebra.BigOperators.Field public import LeanPool.ApollonianSuperharmonic.P3821T1LoopIndexLaws public import LeanPool.ApollonianSuperharmonic.GridStepLogLiftDelta -public import Mathlib.Analysis.Normed.Group.Bounded -public import LeanPool.ApollonianSuperharmonic.GridCellCenter -public import Mathlib.Topology.Algebra.Order.Floor -public import Mathlib.Order.Interval.Set.Infinite -public import Mathlib.Analysis.Complex.Norm -public import Mathlib.Analysis.Complex.Basic -- [TABLET NODE: P3821T1ComponentContours] @@ -125,23 +109,47 @@ private theorem grid_edge_avoids : omega rcases hab with rfl | rfl | rfl | rfl · have hi := congrArg Complex.im ht - simp? [Path.segment_apply, AffineMap.lineMap_apply, GridCellCenter, - Complex.real_smul, Complex.mul_im] at hi + simp only [Path.segment_apply, map_add, map_one, AffineMap.lineMap_apply, vsub_eq_sub, + add_sub_cancel_left, Complex.real_smul, mul_one, vadd_eq_add, Complex.add_im, + Complex.ofReal_im, zero_add, GridCellCenter, Int.reduceNeg, GaussianInt.intCast_re, + one_div, Complex.ofReal_inv, Complex.ofReal_ofNat, GaussianInt.intCast_im, + Complex.inv_im, Complex.im_ofNat, neg_zero, Complex.normSq_ofNat, zero_div, add_zero, + Complex.mul_im, Complex.add_re, Complex.ofReal_re, Complex.inv_re, Complex.re_ofNat, + div_self_mul_self', Complex.I_im, Complex.I_re, mul_zero] at hi rw [← GaussianInt.intCast_im a, ← GaussianInt.intCast_im r] at hi exact hhalf a.im r.im (by linarith) · have hi := congrArg Complex.im ht - simp? [Path.segment_apply, AffineMap.lineMap_apply, GridCellCenter, - Complex.real_smul, Complex.mul_im] at hi + simp only [Path.segment_apply, map_sub, map_one, AffineMap.lineMap_apply, vsub_eq_sub, + sub_sub_cancel_left, smul_neg, Complex.real_smul, mul_one, vadd_eq_add, + Complex.add_im, Complex.neg_im, Complex.ofReal_im, neg_zero, zero_add, GridCellCenter, + Int.reduceNeg, GaussianInt.intCast_re, one_div, Complex.ofReal_inv, + Complex.ofReal_ofNat, GaussianInt.intCast_im, Complex.inv_im, Complex.im_ofNat, + Complex.normSq_ofNat, zero_div, add_zero, Complex.mul_im, Complex.add_re, + Complex.ofReal_re, Complex.inv_re, Complex.re_ofNat, div_self_mul_self', Complex.I_im, + Complex.I_re, mul_zero] at hi rw [← GaussianInt.intCast_im a, ← GaussianInt.intCast_im r] at hi exact hhalf a.im r.im (by linarith) · have hi := congrArg Complex.re ht - simp? [Path.segment_apply, AffineMap.lineMap_apply, GridCellCenter, - Complex.real_smul, Complex.mul_re] at hi + simp only [Int.reduceNeg, Path.segment_apply, map_add, AffineMap.lineMap_apply, + vsub_eq_sub, add_sub_cancel_left, Complex.real_smul, vadd_eq_add, Complex.add_re, + Complex.mul_re, Complex.ofReal_re, GaussianInt.re_toComplex, Int.cast_zero, mul_zero, + Complex.ofReal_im, GaussianInt.im_toComplex, Int.cast_one, mul_one, sub_self, + zero_add, GridCellCenter, GaussianInt.intCast_re, one_div, Complex.ofReal_inv, + Complex.ofReal_ofNat, GaussianInt.intCast_im, Complex.inv_re, Complex.re_ofNat, + Complex.normSq_ofNat, div_self_mul_self', Complex.I_re, Complex.add_im, + Complex.inv_im, Complex.im_ofNat, neg_zero, zero_div, add_zero, Complex.I_im] at hi rw [← GaussianInt.intCast_re a, ← GaussianInt.intCast_re r] at hi exact hhalf a.re r.re (by linarith) · have hi := congrArg Complex.re ht - simp? [Path.segment_apply, AffineMap.lineMap_apply, GridCellCenter, - Complex.real_smul, Complex.mul_re] at hi + simp only [Int.reduceNeg, Path.segment_apply, map_sub, AffineMap.lineMap_apply, + vsub_eq_sub, sub_sub_cancel_left, smul_neg, Complex.real_smul, vadd_eq_add, + Complex.add_re, Complex.neg_re, Complex.mul_re, Complex.ofReal_re, + GaussianInt.re_toComplex, Int.cast_zero, mul_zero, Complex.ofReal_im, + GaussianInt.im_toComplex, Int.cast_one, mul_one, sub_self, neg_zero, zero_add, + GridCellCenter, GaussianInt.intCast_re, one_div, Complex.ofReal_inv, + Complex.ofReal_ofNat, GaussianInt.intCast_im, Complex.inv_re, Complex.re_ofNat, + Complex.normSq_ofNat, div_self_mul_self', Complex.I_re, Complex.add_im, + Complex.inv_im, Complex.im_ofNat, zero_div, add_zero, Complex.I_im] at hi rw [← GaussianInt.intCast_re a, ← GaussianInt.intCast_re r] at hi exact hhalf a.re r.re (by linarith) @@ -965,13 +973,17 @@ private theorem edge_not_openbox : · have h1 : (v.im : ℝ) < (a.im : ℝ) := by have hx := hv.2.2.1 rw [segment_im] at hx - simp? [corner] at hx + simp only [Int.reduceNeg, GaussianInt.intCast_im, Fin.zero_eta, Fin.isValue, + Matrix.cons_val_zero, zero_add, Matrix.cons_val_one, map_add, map_one, + Complex.add_im, Complex.one_im, add_zero, corner] at hx rw [← GaussianInt.intCast_im v, ← GaussianInt.intCast_im a] at hx nlinarith [t₀.2.1, t₀.2.2] have h2 : (a.im : ℝ) < (v.im : ℝ) + 1 := by have hx := hv.2.2.2 rw [segment_im] at hx - simp? [corner] at hx + simp only [Int.reduceNeg, Fin.zero_eta, Fin.isValue, Matrix.cons_val_zero, zero_add, + Matrix.cons_val_one, map_add, map_one, Complex.add_im, Complex.one_im, add_zero, + GaussianInt.intCast_im, corner] at hx rw [← GaussianInt.intCast_im a, ← GaussianInt.intCast_im v] at hx nlinarith [t₀.2.1, t₀.2.2] have h1' : v.im < a.im := by exact_mod_cast h1 @@ -980,13 +992,19 @@ private theorem edge_not_openbox : · have h1 : (v.re : ℝ) < (a.re : ℝ) + 1 := by have hx := hv.1 rw [segment_re] at hx - simp? [corner] at hx + simp only [Int.reduceNeg, GaussianInt.intCast_re, Fin.mk_one, Fin.isValue, + Matrix.cons_val_one, Matrix.cons_val_zero, map_add, map_one, Complex.add_re, + Complex.one_re, Fin.reduceAdd, Matrix.cons_val, GaussianInt.re_toComplex, + Int.cast_zero, add_zero, corner] at hx rw [← GaussianInt.intCast_re v, ← GaussianInt.intCast_re a] at hx nlinarith [t₀.2.1, t₀.2.2] have h2 : (a.re : ℝ) + 1 < (v.re : ℝ) + 1 := by have hx := hv.2.1 rw [segment_re] at hx - simp? [corner] at hx + simp only [Int.reduceNeg, Fin.mk_one, Fin.isValue, Matrix.cons_val_one, + Matrix.cons_val_zero, map_add, map_one, Complex.add_re, Complex.one_re, + Fin.reduceAdd, Matrix.cons_val, GaussianInt.re_toComplex, Int.cast_zero, add_zero, + GaussianInt.intCast_re, corner] at hx rw [← GaussianInt.intCast_re a, ← GaussianInt.intCast_re v] at hx nlinarith [t₀.2.1, t₀.2.2] have h1' : v.re < a.re + 1 := by exact_mod_cast h1 @@ -995,13 +1013,17 @@ private theorem edge_not_openbox : · have h1 : (v.im : ℝ) < (a.im : ℝ) + 1 := by have hx := hv.2.2.1 rw [segment_im] at hx - simp? [corner] at hx + simp only [Int.reduceNeg, GaussianInt.intCast_im, Fin.reduceFinMk, Matrix.cons_val, + map_add, map_one, Complex.add_im, Complex.one_im, add_zero, + GaussianInt.im_toComplex, Int.cast_one, Fin.isValue, Fin.reduceAdd, corner] at hx rw [← GaussianInt.intCast_im v, ← GaussianInt.intCast_im a] at hx nlinarith [t₀.2.1, t₀.2.2] have h2 : (a.im : ℝ) + 1 < (v.im : ℝ) + 1 := by have hx := hv.2.2.2 rw [segment_im] at hx - simp? [corner] at hx + simp only [Int.reduceNeg, Fin.reduceFinMk, Matrix.cons_val, map_add, map_one, + Complex.add_im, Complex.one_im, add_zero, GaussianInt.im_toComplex, Int.cast_one, + Fin.isValue, Fin.reduceAdd, GaussianInt.intCast_im, corner] at hx rw [← GaussianInt.intCast_im a, ← GaussianInt.intCast_im v] at hx nlinarith [t₀.2.1, t₀.2.2] have h1' : v.im < a.im + 1 := by exact_mod_cast h1 @@ -1010,13 +1032,17 @@ private theorem edge_not_openbox : · have h1 : (v.re : ℝ) < (a.re : ℝ) := by have hx := hv.1 rw [segment_re] at hx - simp? [corner] at hx + simp only [Int.reduceNeg, GaussianInt.intCast_re, Fin.reduceFinMk, Matrix.cons_val, + map_add, Complex.add_re, GaussianInt.re_toComplex, Int.cast_zero, add_zero, + Fin.isValue, Fin.reduceAdd, Matrix.cons_val_zero, corner] at hx rw [← GaussianInt.intCast_re v, ← GaussianInt.intCast_re a] at hx nlinarith [t₀.2.1, t₀.2.2] have h2 : (a.re : ℝ) < (v.re : ℝ) + 1 := by have hx := hv.2.1 rw [segment_re] at hx - simp? [corner] at hx + simp only [Int.reduceNeg, Fin.reduceFinMk, Matrix.cons_val, map_add, Complex.add_re, + GaussianInt.re_toComplex, Int.cast_zero, add_zero, Fin.isValue, Fin.reduceAdd, + Matrix.cons_val_zero, GaussianInt.intCast_re, corner] at hx rw [← GaussianInt.intCast_re a, ← GaussianInt.intCast_re v] at hx nlinarith [t₀.2.1, t₀.2.2] have h1' : v.re < a.re := by exact_mod_cast h1 diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean index 5e3da1bb66..6e0c103fe1 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean @@ -5,12 +5,13 @@ Authors: Wesley Pegden -/ module -public import Mathlib.Analysis.SpecialFunctions.Complex.Circle -public import Mathlib.Topology.ContinuousMap.Basic -public import Mathlib.Topology.UniformSpace.HeineCantor -public import Mathlib.Topology.MetricSpace.Pseudo.Basic +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import Mathlib.Algebra.BigOperators.Field -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Algebra.Order.Algebra +public import Mathlib.Analysis.Complex.Circle +public import Mathlib.Analysis.SpecialFunctions.Log.Basic -- [TABLET NODE: P3821T1ControlledNeighborhood] diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndex.lean b/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndex.lean index 9a43011c7d..216bd4a1e4 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndex.lean @@ -5,7 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3821T1AngularIncrement +public import Mathlib.Analysis.Complex.Circle +public import Mathlib.Topology.CompactOpen -- [TABLET NODE: P3821T1LoopIndex] diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndexLaws.lean b/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndexLaws.lean index 344a0a43d3..d6dd9e36e5 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndexLaws.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndexLaws.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.P3821T1LoopIndex public import LeanPool.ApollonianSuperharmonic.P3821T1AngularIncrementLaws public import Mathlib.Topology.Algebra.Order.Floor diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean index dab34c9dfc..2864fd05a3 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation public import Mathlib.Analysis.SpecialFunctions.Complex.Circle diff --git a/LeanPool/ApollonianSuperharmonic/P3832T1ChamberOverlap.lean b/LeanPool/ApollonianSuperharmonic/P3832T1ChamberOverlap.lean index a893f00103..4627d44249 100644 --- a/LeanPool/ApollonianSuperharmonic/P3832T1ChamberOverlap.lean +++ b/LeanPool/ApollonianSuperharmonic/P3832T1ChamberOverlap.lean @@ -5,11 +5,19 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Data.Fintype.Prod +public import Mathlib.Data.Fintype.Sets +public import Mathlib.Data.Fintype.Fin +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Data.Fintype.Card public import Mathlib.Basic.Real.Basic +public import Mathlib.Data.Finset.Card +public import Mathlib.Data.Set.Basic public import Mathlib.Tactic.FinCases public import Mathlib.Tactic.Linarith + -- [TABLET NODE: P3832T1ChamberOverlap] /-! diff --git a/LeanPool/ApollonianSuperharmonic/P3832T1CollapsedConeDescent.lean b/LeanPool/ApollonianSuperharmonic/P3832T1CollapsedConeDescent.lean index 1a3d177171..f0e7ad0f13 100644 --- a/LeanPool/ApollonianSuperharmonic/P3832T1CollapsedConeDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P3832T1CollapsedConeDescent.lean @@ -5,11 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3832T1ConeCollapse -public import Mathlib.Topology.ContinuousMap.Basic -public import Mathlib.Topology.Separation.Hausdorff -public import Mathlib.Topology.Defs.Induced -public import Mathlib.Tactic.FieldSimp +public import Mathlib.Topology.Algebra.Ring.Real -- [TABLET NODE: P3832T1CollapsedConeDescent] diff --git a/LeanPool/ApollonianSuperharmonic/P3832T1ConeCollapse.lean b/LeanPool/ApollonianSuperharmonic/P3832T1ConeCollapse.lean index e59c52f834..25eba9a567 100644 --- a/LeanPool/ApollonianSuperharmonic/P3832T1ConeCollapse.lean +++ b/LeanPool/ApollonianSuperharmonic/P3832T1ConeCollapse.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble -public import Mathlib.Topology.Instances.Real.Lemmas +public import Mathlib.Init + +public import Mathlib.Data.EReal.Operations -- [TABLET NODE: P3832T1ConeCollapse] diff --git a/LeanPool/ApollonianSuperharmonic/P3832T1FiniteClosedCoverPasting.lean b/LeanPool/ApollonianSuperharmonic/P3832T1FiniteClosedCoverPasting.lean index dc3175b719..80db2f8027 100644 --- a/LeanPool/ApollonianSuperharmonic/P3832T1FiniteClosedCoverPasting.lean +++ b/LeanPool/ApollonianSuperharmonic/P3832T1FiniteClosedCoverPasting.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init public import Mathlib.Topology.ContinuousMap.Basic -public import Mathlib.Topology.LocallyFinite + -- [TABLET NODE: P3832T1FiniteClosedCoverPasting] diff --git a/LeanPool/ApollonianSuperharmonic/P3861T1ExtraArcLocalization.lean b/LeanPool/ApollonianSuperharmonic/P3861T1ExtraArcLocalization.lean index 018e14a81f..c9f15330f9 100644 --- a/LeanPool/ApollonianSuperharmonic/P3861T1ExtraArcLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P3861T1ExtraArcLocalization.lean @@ -5,10 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3861T1FacialDomains -public import LeanPool.ApollonianSuperharmonic.P3767T1BarrierRegionMaximal -public import LeanPool.ApollonianSuperharmonic.P3767T1VertexEdgeIncidence -public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry public import LeanPool.ApollonianSuperharmonic.P3889T1ExactRadialStar public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectors public import LeanPool.ApollonianSuperharmonic.P3889T1FaceGapCoverage diff --git a/LeanPool/ApollonianSuperharmonic/P3861T1FacialDomains.lean b/LeanPool/ApollonianSuperharmonic/P3861T1FacialDomains.lean index 68f689e2dc..041a4f5151 100644 --- a/LeanPool/ApollonianSuperharmonic/P3861T1FacialDomains.lean +++ b/LeanPool/ApollonianSuperharmonic/P3861T1FacialDomains.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting -- [TABLET NODE: P3861T1FacialDomains] diff --git a/LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean b/LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean index 159645f3c3..95674ea575 100644 --- a/LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry public import LeanPool.ApollonianSuperharmonic.P3821T1ThreeArcCircle public import LeanPool.ApollonianSuperharmonic.P3821T1CircleComponentBound diff --git a/LeanPool/ApollonianSuperharmonic/P3861T1RealPolygonDomains.lean b/LeanPool/ApollonianSuperharmonic/P3861T1RealPolygonDomains.lean index 848b1e3ca4..7bcd416411 100644 --- a/LeanPool/ApollonianSuperharmonic/P3861T1RealPolygonDomains.lean +++ b/LeanPool/ApollonianSuperharmonic/P3861T1RealPolygonDomains.lean @@ -5,14 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3475T1BoundaryReduction public import LeanPool.ApollonianSuperharmonic.P3475T1PolygonTriangleConstruction -public import LeanPool.ApollonianSuperharmonic.P3475T1BoundaryRestoration public import LeanPool.ApollonianSuperharmonic.P3475T1PolygonalSeparation -public import Mathlib.Topology.MetricSpace.Lipschitz public import Mathlib.Topology.MetricSpace.Contracting public import Mathlib.Analysis.Normed.Affine.AddTorsor -public import Mathlib.Topology.Order.Compact -- [TABLET NODE: P3861T1RealPolygonDomains] diff --git a/LeanPool/ApollonianSuperharmonic/P3861T1RoutedFaceOrientation.lean b/LeanPool/ApollonianSuperharmonic/P3861T1RoutedFaceOrientation.lean index 7e62b15b45..27a167b563 100644 --- a/LeanPool/ApollonianSuperharmonic/P3861T1RoutedFaceOrientation.lean +++ b/LeanPool/ApollonianSuperharmonic/P3861T1RoutedFaceOrientation.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3861T1FacialDomains public import LeanPool.ApollonianSuperharmonic.P3861T1FixedFacialDeletion public import LeanPool.ApollonianSuperharmonic.PlaneFaceOrientation -public import LeanPool.ApollonianSuperharmonic.P3767T1BarrierRegionMaximal public import LeanPool.ApollonianSuperharmonic.P3934T1PolygonalSidePropagation public import LeanPool.ApollonianSuperharmonic.P3934T1ArcSideComparison diff --git a/LeanPool/ApollonianSuperharmonic/P3861T1RoutedFacialDomains.lean b/LeanPool/ApollonianSuperharmonic/P3861T1RoutedFacialDomains.lean index 7a85c422ea..8b3c4692bd 100644 --- a/LeanPool/ApollonianSuperharmonic/P3861T1RoutedFacialDomains.lean +++ b/LeanPool/ApollonianSuperharmonic/P3861T1RoutedFacialDomains.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3861T1FacialDomains public import LeanPool.ApollonianSuperharmonic.P3861T1FixedFacialDeletion public import LeanPool.ApollonianSuperharmonic.P3861T1RealPolygonDomains diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean b/LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean index f1539e1e81..7276a1a2a2 100644 --- a/LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean +++ b/LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean @@ -5,8 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting -public import LeanPool.ApollonianSuperharmonic.P3767T1VertexEdgeIncidence public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry public import Mathlib.Analysis.Normed.MulAction diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean index dce2fb4d87..6fd0426bd9 100644 --- a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean @@ -5,13 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.P3861T1FacialDomains public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectorDecomposition -public import LeanPool.ApollonianSuperharmonic.P3767T1BarrierRegionMaximal -public import LeanPool.ApollonianSuperharmonic.P3767T1VertexEdgeIncidence public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry public import Mathlib.Analysis.Normed.Module.Connected -public import Mathlib.LinearAlgebra.Dimension.Constructions -- [TABLET NODE: P3889T1FaceGapCoverage] diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectorDecomposition.lean b/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectorDecomposition.lean index 2f5f9ace81..deab296f12 100644 --- a/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectorDecomposition.lean +++ b/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectorDecomposition.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble -public import Mathlib.Analysis.Normed.Module.Basic -public import Mathlib.Topology.Connected.Basic +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + +public import Mathlib.Analysis.Normed.Group.Basic +public import Mathlib.Data.EReal.Operations +public import Mathlib.Topology.Algebra.InfiniteSum.Order -- [TABLET NODE: P3889T1TwoRaySectorDecomposition] diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean b/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean index 5e0449a4e3..2278d084a1 100644 --- a/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean @@ -5,16 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectorDecomposition -public import Mathlib.Analysis.Convex.PathConnected public import Mathlib.Analysis.Normed.Module.Convex -public import Mathlib.Tactic.FieldSimp -public import Mathlib.Tactic.FunProp -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.NormNum -public import Mathlib.Tactic.Positivity -public import Mathlib.Tactic.Push -public import Mathlib.Tactic.Ring +public import Mathlib.Tactic.Positivity.Finset -- [TABLET NODE: P3889T1TwoRaySectors] diff --git a/LeanPool/ApollonianSuperharmonic/P3913T1OffFaceExterior.lean b/LeanPool/ApollonianSuperharmonic/P3913T1OffFaceExterior.lean index 4214c950b3..1685659c90 100644 --- a/LeanPool/ApollonianSuperharmonic/P3913T1OffFaceExterior.lean +++ b/LeanPool/ApollonianSuperharmonic/P3913T1OffFaceExterior.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting -public import LeanPool.ApollonianSuperharmonic.P3767T1VertexEdgeIncidence -public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry public import LeanPool.ApollonianSuperharmonic.P3913T1PeriodicPositionUnbounded -- [TABLET NODE: P3913T1OffFaceExterior] diff --git a/LeanPool/ApollonianSuperharmonic/P3913T1PeriodicPositionUnbounded.lean b/LeanPool/ApollonianSuperharmonic/P3913T1PeriodicPositionUnbounded.lean index 3a6c6886f5..4a975ebb51 100644 --- a/LeanPool/ApollonianSuperharmonic/P3913T1PeriodicPositionUnbounded.lean +++ b/LeanPool/ApollonianSuperharmonic/P3913T1PeriodicPositionUnbounded.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry diff --git a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedArcExterior.lean b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedArcExterior.lean index 7249f92841..5329c388de 100644 --- a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedArcExterior.lean +++ b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedArcExterior.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Lemmas +public import Mathlib.Topology.Order.IntermediateValue public import Mathlib.Topology.Order.DenselyOrdered -public import Mathlib.Tactic.FinCases + +public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting -- [TABLET NODE: P3913T1RoutedArcExterior] diff --git a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean index f121999617..46b265237a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean +++ b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean @@ -5,8 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting -public import Mathlib.Algebra.BigOperators.Group.Finset.Basic +public import Mathlib.Analysis.Convex.Segment -- [TABLET NODE: P3913T1RoutedFaceSubdivision] @@ -846,7 +848,7 @@ private theorem block_edge : have hlast : i = Fin.last (n + 2) := by apply Fin.ext change i.val = (Fin.last (n + 2)).val - simp? + simp only [Fin.val_last] rw [hval] omega have hnext : i + 1 = (⟨0, by omega⟩ : Fin (n + 3)) := by @@ -1578,8 +1580,8 @@ private theorem no_cross01 : classical exact ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : - P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ - (hi : ∀ (k : Fin (3 : ℕ)), Function.Injective (g k)), ∀ (s : (k : Fin (3 : ℕ)) → + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ + (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), let m0 := (s 0).count let m1 := (s 1).count @@ -1600,7 +1602,7 @@ private theorem no_cross01 : m0), ∀ (j : Fin m1), w (0 : Fin (3 : ℕ)) i.castSucc = w (1 : Fin (3 : ℕ)) j.castSucc → False))) ) := by classical - intro ι P D f g hi s m0 m1 τ w v w_arc w_ne_finish arc01 i j h + intro ι P D f g s m0 m1 τ w v w_arc w_ne_finish arc01 i j h have hx : w 0 i.castSucc ∈ D.edgeArc (v 0) (v 1) ∩ D.edgeArc (v 1) (v 2) := ⟨w_arc 0 i.castSucc, h ▸ w_arc 1 j.castSucc⟩ rw [arc01] at hx @@ -1612,8 +1614,8 @@ private theorem no_cross12 : classical exact ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : - P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ - (hi : ∀ (k : Fin (3 : ℕ)), Function.Injective (g k)), ∀ (s : (k : Fin (3 : ℕ)) → + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ + (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), let m1 := (s 1).count let m2 := (s 2).count @@ -1634,7 +1636,7 @@ private theorem no_cross12 : m1), ∀ (j : Fin m2), w (1 : Fin (3 : ℕ)) i.castSucc = w (2 : Fin (3 : ℕ)) j.castSucc → False))) ) := by classical - intro ι P D f g hi s m1 m2 τ w v w_arc w_ne_finish arc12 i j h + intro ι P D f g s m1 m2 τ w v w_arc w_ne_finish arc12 i j h have hx : w 1 i.castSucc ∈ D.edgeArc (v 1) (v 2) ∩ D.edgeArc (v 2) (v 0) := ⟨w_arc 1 i.castSucc, h ▸ w_arc 2 j.castSucc⟩ rw [arc12] at hx @@ -1646,8 +1648,8 @@ private theorem no_cross02 : classical exact ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : - P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ - (hi : ∀ (k : Fin (3 : ℕ)), Function.Injective (g k)), ∀ (s : (k : Fin (3 : ℕ)) → + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ + (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), let m0 := (s 0).count let m2 := (s 2).count @@ -1668,7 +1670,7 @@ private theorem no_cross02 : m0), ∀ (j : Fin m2), w (0 : Fin (3 : ℕ)) i.castSucc = w (2 : Fin (3 : ℕ)) j.castSucc → False))) ) := by classical - intro ι P D f g hi s m0 m2 τ w v w_arc w_ne_finish arc20 i j h + intro ι P D f g s m0 m2 τ w v w_arc w_ne_finish arc20 i j h have hx : w 2 j.castSucc ∈ D.edgeArc (v 2) (v 0) ∩ D.edgeArc (v 0) (v 1) := ⟨w_arc 2 j.castSucc, h.symm ▸ w_arc 0 i.castSucc⟩ rw [arc20] at hx @@ -1976,10 +1978,10 @@ theorem P3913T1RoutedFaceSubdivision : w k i.castSucc ≠ D.position (v (k + 1)) := RoutedSubdivisionProof.w_ne_finish ι P D f g hi s (RoutedFaceDetails.w_finish ι P D f g hi h1 s) k i have q_injective : Function.Injective q := RoutedSubdivisionProof.q_injective g hi s q0 q1 q2 - (RoutedFaceDetails.no_cross01 ι P D f g hi s w_arc w_ne_finish (RoutedFaceDetails.arc01 ι P - D f arc_inter_singleton)) (RoutedFaceDetails.no_cross12 ι P D f g hi s w_arc + (RoutedFaceDetails.no_cross01 ι P D f g s w_arc w_ne_finish (RoutedFaceDetails.arc01 ι P + D f arc_inter_singleton)) (RoutedFaceDetails.no_cross12 ι P D f g s w_arc w_ne_finish (RoutedFaceDetails.arc12 ι P D f arc_inter_singleton)) - (RoutedFaceDetails.no_cross02 ι P D f g hi s w_arc w_ne_finish (RoutedFaceDetails.arc20 + (RoutedFaceDetails.no_cross02 ι P D f g s w_arc w_ne_finish (RoutedFaceDetails.arc20 ι P D f arc_inter_singleton)) (RoutedFaceDetails.w_block_injective g hi s) let b0 (i : Fin m0) : Fin M := Fin.castAdd (m1 + m2) i let b1 (i : Fin m1) : Fin M := Fin.natAdd m0 (Fin.castAdd m2 i) diff --git a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedTraceClosed.lean b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedTraceClosed.lean index ed2e5065a2..1b8016ddaf 100644 --- a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedTraceClosed.lean +++ b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedTraceClosed.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting public import LeanPool.ApollonianSuperharmonic.P3776T1FixedGeometry -public import LeanPool.ApollonianSuperharmonic.P3767T1VertexEdgeIncidence -- [TABLET NODE: P3913T1RoutedTraceClosed] diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSide.lean b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSide.lean index a2cf95ebc6..34872a3a18 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSide.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSide.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3934T1PolygonalSide -- [TABLET NODE: P3934T1ArcSide] diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean index 667d5c760d..72324e14dc 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean @@ -5,7 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3934T1ArcSide +public import Mathlib.Algebra.Order.Ring.Star +public import Mathlib.Analysis.Normed.Module.Basic +public import Mathlib.Tactic.Module -- [TABLET NODE: P3934T1ArcSideComparison] diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1LocalSide.lean b/LeanPool/ApollonianSuperharmonic/P3934T1LocalSide.lean index d314c0b7a5..09396e9184 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1LocalSide.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1LocalSide.lean @@ -5,8 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble -public import Mathlib.Analysis.Normed.Module.Basic +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + +public import Mathlib.Analysis.Normed.Group.Basic +public import Mathlib.Data.EReal.Operations +public import Mathlib.Topology.Algebra.InfiniteSum.Order -- [TABLET NODE: P3934T1LocalSide] diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSide.lean b/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSide.lean index b825a8bc34..147a66e419 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSide.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSide.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3934T1LocalSide public import LeanPool.ApollonianSuperharmonic.P3723T1PolygonalParameterization diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSidePropagation.lean b/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSidePropagation.lean index c3aff777e9..42b57b986c 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSidePropagation.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSidePropagation.lean @@ -5,11 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3934T1PolygonalSide -public import LeanPool.ApollonianSuperharmonic.P3934T1SectorSelection public import LeanPool.ApollonianSuperharmonic.P3934T1SectorContinuation -public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectors public import LeanPool.ApollonianSuperharmonic.P5667T1StraightFrontierLocalSides +public import Mathlib.Algebra.EuclideanDomain.Basic +public import Mathlib.Algebra.EuclideanDomain.Field -- [TABLET NODE: P3934T1PolygonalSidePropagation] diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean b/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean index 6bcf943ce3..e6a36b518a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean @@ -5,11 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectorDecomposition public import LeanPool.ApollonianSuperharmonic.P3934T1LocalSide -public import Mathlib.Analysis.Convex.PathConnected public import Mathlib.Analysis.Normed.Module.Convex -public import Mathlib.Tactic.FunProp -- [TABLET NODE: P3934T1SectorContinuation] diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1SectorSelection.lean b/LeanPool/ApollonianSuperharmonic/P3934T1SectorSelection.lean index 61406e3207..27f65900eb 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1SectorSelection.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1SectorSelection.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectorDecomposition -public import Mathlib.Topology.MetricSpace.Pseudo.Defs -- [TABLET NODE: P3934T1SectorSelection] diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1DeletedPairExteriorConnected.lean b/LeanPool/ApollonianSuperharmonic/P3963T1DeletedPairExteriorConnected.lean index 2ade4b1ecf..0b2ece2b0d 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1DeletedPairExteriorConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1DeletedPairExteriorConnected.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1EdgeFreeDiskCorners.lean b/LeanPool/ApollonianSuperharmonic/P3963T1EdgeFreeDiskCorners.lean index efa19cc8e3..2b1946821f 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1EdgeFreeDiskCorners.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1EdgeFreeDiskCorners.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean index c337a605ca..d9c3f554e7 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean index 6ffb74760f..fe26ba4396 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean @@ -5,9 +5,16 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.ZMod.Basic +public import Mathlib.Data.Finset.Card +public import Mathlib.Data.List.Cycle +public import Mathlib.Tactic.ByContra +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle public import Mathlib.Data.List.TakeWhile -public import Mathlib.Data.List.Cycle -- [TABLET NODE: P3963T1MixedBoundaryCycle] @@ -32,7 +39,7 @@ private theorem rotate_chain : classical intro p k a b hh ht hc hchain hk by_cases hz : k = 0 - · simp? [hz] + · simp only [hz, List.rotate_zero] exact hchain · have hp : 0 < k := Nat.pos_of_ne_zero hz rw [List.rotate_eq_drop_append_take (Nat.le_of_lt hk)] @@ -152,7 +159,7 @@ private theorem hcross : (List.mem_rotate (l := p₁) (a := v) (n := p₁.idxOf z)).mp hvc₁ rw [hV₁] exact List.mem_toFinset.mpr hvp₁ - simp? [Q] at hv + simp only [List.mem_cons, List.mem_append, List.not_mem_nil, or_false, Q] at hv rcases hv with rfl | hv | rfl · exact hxnotprefix₁ hw · have hvnot : v ∉ V₁ := by diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1AdjacentParentPlacement.lean b/LeanPool/ApollonianSuperharmonic/P3996T1AdjacentParentPlacement.lean index 9e8b502dda..ae63c4cc5f 100644 --- a/LeanPool/ApollonianSuperharmonic/P3996T1AdjacentParentPlacement.lean +++ b/LeanPool/ApollonianSuperharmonic/P3996T1AdjacentParentPlacement.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileReindexedDecomposition public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: P3996T1AdjacentParentPlacement] @@ -118,7 +120,13 @@ theorem P3996T1AdjacentParentPlacement have hc1 := congrArg Prod.fst hc have hc2 := congrArg Prod.snd hc cases hs : sign <;> - simp? [hs, GaussianRealPoint, I] at hc1 hc2 ⊢ <;> + simp only [hs, Prod.fst_sub, Bool.false_eq_true, ↓reduceIte, one_div, GaussianRealPoint, + Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, Prod.mk_sub_mk, + sub_neg_eq_add, Prod.smul_mk, smul_eq_mul, neg_smul, one_smul, Prod.neg_mk, + Prod.snd_sub, neg_mul, one_mul, neg_sub, Zsqrtd.re_add, Zsqrtd.re_sub, Zsqrtd.re_mul, + zero_mul, mul_one, zero_add, Zsqrtd.re_ofNat, Nat.cast_ofNat, Zsqrtd.im_ofNat, + mul_zero, add_zero, Int.cast_add, Int.cast_sub, Int.cast_neg, Int.cast_mul, + Int.cast_ofNat, Zsqrtd.im_add, Zsqrtd.im_sub, Zsqrtd.im_mul, I] at hc1 hc2 ⊢ <;> apply Prod.ext <;> simp <;> linarith end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1CenteredQuarterTurnInclusion.lean b/LeanPool/ApollonianSuperharmonic/P3996T1CenteredQuarterTurnInclusion.lean index 66c9b3fc2d..5cf98502b0 100644 --- a/LeanPool/ApollonianSuperharmonic/P3996T1CenteredQuarterTurnInclusion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3996T1CenteredQuarterTurnInclusion.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P3996T1CenteredQuarterTurnInclusion] diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean b/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean index 72564dcb1f..d049f35261 100644 --- a/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean +++ b/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean @@ -5,15 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3996T1SRowTable public import LeanPool.ApollonianSuperharmonic.P3045T1RightBoundaryDisplacementAlgebra public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: P3996T1PlacementCompanionBlocks] diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean b/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean index 8ded38a1f1..01cf138f6a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean +++ b/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean @@ -5,11 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3996T1SRowTable public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms -- [TABLET NODE: P3996T1SRowAlignment] @@ -688,10 +687,18 @@ private theorem rowAlignment : cOff p0plus p0minus p1plus p1minus p0plusAbs p0minusAbs p1plusAbs p1minusAbs edgeVector w q13 certU certV qnormal q31 q23 cases row <;> simp only [P3996T1SRowTable] at hz <;> cases hz <;> rename_i presentation - all_goals simp? [SubtileOccurrenceInterpretation, - hfp, hsp, hfc, hft, hfr, hsc, hsr, q1pos, q2pos, q3pos, - certU, certV, p0plus, p0minus, p1plus, p1minus, - cOff, I, GaussianRealPoint] + all_goals simp only [hfp, Fin.isValue, hfc, Fin.succ_zero_eq_one, + SubtileOccurrenceInterpretation, Int.cast_one, certU, Int.reduceNeg, one_mul, certV, + Fin.succ_one_eq_two, hft, Int.cast_zero, zero_mul, add_zero, q1pos, q2pos, ↓reduceIte, + and_self, Fin.coe_ofNat_eq_mod, Nat.reduceMod, even_two, one_div, GaussianRealPoint, + Zsqrtd.re_mul, Zsqrtd.re_add, neg_mul, Zsqrtd.im_add, Int.cast_add, Int.cast_mul, + GaussianInt.intCast_re, map_pow, Int.cast_neg, GaussianInt.intCast_im, Zsqrtd.im_mul, + Prod.smul_mk, smul_eq_mul, p0plus, Prod.mk_sub_mk, sub_neg_eq_add, true_and, I, cOff, + neg_add_rev, zero_add, Fin.reduceSucc, hfr, q3pos, Nat.mod_succ, mul_ite, + right_eq_ite_iff, mul_eq_mul_left_iff, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, + pow_eq_zero_iff, Nat.one_mod, pow_one, Nat.not_even_one, mul_one, neg_sub, p0minus, + Prod.neg_mk, neg_neg, Bool.false_eq_true, Nat.zero_mod, pow_zero, Even.zero, hsp, hsc, + hsr, p1minus, p1plus] all_goals refine ⟨?_, ?_, ?_⟩ case positiveS1.refl.refine_1 => simpa [SubtileOccurrenceInterpretation, TileTranslation, GaussianTranslation, certU, certV, diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1SRowParameters.lean b/LeanPool/ApollonianSuperharmonic/P3996T1SRowParameters.lean index 78de87ba18..4de0b97e17 100644 --- a/LeanPool/ApollonianSuperharmonic/P3996T1SRowParameters.lean +++ b/LeanPool/ApollonianSuperharmonic/P3996T1SRowParameters.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex public import LeanPool.ApollonianSuperharmonic.CircleCoordinates diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1SRowTable.lean b/LeanPool/ApollonianSuperharmonic/P3996T1SRowTable.lean index 21391859f3..3dfa080be8 100644 --- a/LeanPool/ApollonianSuperharmonic/P3996T1SRowTable.lean +++ b/LeanPool/ApollonianSuperharmonic/P3996T1SRowTable.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow public import LeanPool.ApollonianSuperharmonic.P3996T1SRowParameters diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1BandQuarterTurn.lean b/LeanPool/ApollonianSuperharmonic/P4055T1BandQuarterTurn.lean index 304c772f54..ef8a619e75 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1BandQuarterTurn.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1BandQuarterTurn.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -- [TABLET NODE: P4055T1BandQuarterTurn] diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1ExactTripleImage.lean b/LeanPool/ApollonianSuperharmonic/P4055T1ExactTripleImage.lean index a5600d001c..9571fe9213 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1ExactTripleImage.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1ExactTripleImage.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple public import LeanPool.ApollonianSuperharmonic.P4055T1GridPathImage diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1GridPathImage.lean b/LeanPool/ApollonianSuperharmonic/P4055T1GridPathImage.lean index c781d0ec25..11d97b0316 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1GridPathImage.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1GridPathImage.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween -- [TABLET NODE: P4055T1GridPathImage] @@ -59,11 +61,11 @@ theorem P4055T1GridPathImage : ∀ (f : GaussianInt → GaussianInt), cases q with | nil => simp_all | cons w q => - simp? at hm + simp only [List.map_cons, List.nil_append, List.cons.injEq] at hm rw [← hm.1, ← hm.2.1] exact st z w (hs z w [] q (by simp)) | cons z' l' => - simp? at hm + simp only [List.map_cons, List.cons_append, List.cons.injEq] at hm apply ih (fun c d k m hcm => hs c d (z :: k) m (by simp [hcm])) a b l' l₂ hm.2 exact recover p hs a b l₁ l₂ hmap @@ -89,17 +91,17 @@ theorem P4055T1GridPathImage : ∀ (f : GaussianInt → GaussianInt), intro k m r s h cases k with | nil => - simp? at h + simp only [List.map_cons, List.nil_append, List.cons.injEq] at h cases q with | nil => simp_all | cons w q => - simp? at h + simp only [List.map_cons, List.cons.injEq] at h have hz : z = r := fi h.1 have hw : w = s := fi h.2.1 subst r; subst s exact ⟨[], q, by simp []⟩ | cons z' k' => - simp? at h + simp only [List.map_cons, List.cons_append, List.cons.injEq] at h rcases ihq k' m r s h.2 with ⟨k₀, m₀, hm⟩ exact ⟨z :: k₀, m₀, by simp [hm]⟩ have hdecomp : ∃ k m, p = k ++ a₀ :: b₀ :: m := by diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean index 9424679370..63abdad7b6 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean @@ -5,14 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMixedAggregatePatches -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: P4055T1OrderedGeneralOppositeEndpoints] diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1PackingGridEquivalence.lean b/LeanPool/ApollonianSuperharmonic/P4055T1PackingGridEquivalence.lean index 5de60dacec..99c0bc1ced 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1PackingGridEquivalence.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1PackingGridEquivalence.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -- [TABLET NODE: P4055T1PackingGridEquivalence] diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean index b33cf5e37a..c7e5a085ed 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean @@ -5,12 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: P4055T1PlacementNormalization] @@ -894,9 +891,11 @@ private theorem reversedAdjacent : · have hn : ¬ Even (-s₀ - 1).val := by intro ht exact (hp.mp ht) h - simp? [h, hn]; fin_cases a₀ <;> fin_cases i₀ <;> decide +kernel + simp only [Fin.isValue, hn, ↓reduceIte, neg_sub, h]; fin_cases a₀ <;> fin_cases i₀ <;> decide + +kernel · have he : Even (-s₀ - 1).val := hp.mpr h - simp? [h, he]; fin_cases a₀ <;> fin_cases i₀ <;> decide +kernel + simp only [Fin.isValue, he, ↓reduceIte, neg_sub, h]; fin_cases a₀ <;> fin_cases i₀ <;> decide + +kernel private theorem normalizedAdjacent : (by @@ -915,9 +914,9 @@ private theorem normalizedAdjacent : cases rev · simp only [Bool.false_eq_true, ↓reduceIte] by_cases h : Even s₀.val - · simp? [h]; fin_cases a₀ <;> fin_cases i₀ <;> + · simp only [h, ↓reduceIte, Fin.isValue]; fin_cases a₀ <;> fin_cases i₀ <;> fin_cases s₀ <;> decide +kernel - · simp? [h]; fin_cases a₀ <;> fin_cases i₀ <;> + · simp only [h, ↓reduceIte, Fin.isValue]; fin_cases a₀ <;> fin_cases i₀ <;> fin_cases s₀ <;> decide +kernel · simp only [↓reduceIte] exact reversedAdjacent a₀ i₀ s₀ diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean b/LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean index bac3b4aaeb..a2ecb0223d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean @@ -5,12 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordTile public import LeanPool.ApollonianSuperharmonic.FordVertexDomain public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import Mathlib.Tactic.NormNum -public import Mathlib.Tactic.Linarith -- [TABLET NODE: P4062T1CanonicalSupport] @@ -67,7 +67,9 @@ private theorem hfootSquare (q : Nat) (hqpos : 0 < q) : classical have hc : (FordTile q).cells.Nonempty := by refine ⟨⟨0, 0⟩, ?_⟩ - simp? [FordTile, FordCellDomain] + simp only [FordTile, FordCellDomain, Int.reduceNeg, Finset.product_eq_sprod, + Finset.mem_image, Finset.mem_product, Finset.mem_range, Zsqrtd.mk.injEq, + Int.natCast_eq_zero, Prod.exists, exists_eq_right_right, exists_eq_right, and_self] exact hqpos ext x simp only [FootprintVertices, ite_eq_left hc, FordVertexDomain, @@ -148,7 +150,9 @@ private theorem hfootSquare (q : Nat) (hqpos : 0 < q) : private theorem hFcells (q : Nat) (hqpos : 0 < q) : (FordTile q).cells.Nonempty := by classical refine ⟨⟨0, 0⟩, ?_⟩ - simp? [FordTile, FordCellDomain] + simp only [FordTile, FordCellDomain, Int.reduceNeg, Finset.product_eq_sprod, + Finset.mem_image, Finset.mem_product, Finset.mem_range, Zsqrtd.mk.injEq, + Int.natCast_eq_zero, Prod.exists, exists_eq_right_right, exists_eq_right, and_self] exact hqpos private theorem hcellTiles (q : Nat) (z : GaussianInt) : diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean index 94229c2403..c667b8e6cf 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4062T1RecursiveInteriors public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public meta import Lean.Meta.Tactic.NormCast -- [TABLET NODE: P4062T1InteriorGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1InteriorSquare.lean b/LeanPool/ApollonianSuperharmonic/P4062T1InteriorSquare.lean index 04d3250b52..ae51922321 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1InteriorSquare.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1InteriorSquare.lean @@ -5,8 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import Mathlib.Init + public import Mathlib.Data.Int.Interval +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: P4062T1InteriorSquare] diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean b/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean index cf200409f7..9716b84b53 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean @@ -5,11 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorSquare -- [TABLET NODE: P4062T1LiteralReduction] @@ -65,7 +66,9 @@ private theorem hFcells : classical intro P refine ⟨⟨0, 0⟩, ?_⟩ - simp? [FordTile, FordCellDomain] + simp only [FordTile, FordCellDomain, Int.reduceNeg, Finset.product_eq_sprod, + Finset.mem_image, Finset.mem_product, Finset.mem_range, Zsqrtd.mk.injEq, + Int.natCast_eq_zero, Prod.exists, exists_eq_right_right, exists_eq_right, and_self] exact P.q_pos private theorem hTcells : @@ -232,7 +235,7 @@ private theorem hcanonicalFoot : classical intro P k hkdom y hy hy' hz hz' have hbox : y ∈ FordVertexDomain P.q := by - simp? [FordVertexDomain] + simp only [FordVertexDomain, Int.reduceNeg, Set.mem_ofPred_eq] exact ⟨hy, hy', hz, hz'⟩ have hset : y ∈ (k.domain : Set GaussianInt) := by rw [hkdom] diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1OrientationTransport.lean b/LeanPool/ApollonianSuperharmonic/P4062T1OrientationTransport.lean index e20e41aaab..c86d1d3586 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1OrientationTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1OrientationTransport.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation -- [TABLET NODE: P4062T1OrientationTransport] @@ -61,7 +63,7 @@ theorem P4062T1OrientationTransport · right; right; right; rw [h]; abel let t : AcyclicIndegreeOrientation E τ := { edge := fun x y => o.edge (x-u) (y-u) - edge_decidable := fun x y => o.edge_decidable (x-u) (y-u) + edgeDecidable := fun x y => o.edgeDecidable (x-u) (y-u) rank := fun x => o.rank (x-u) supported := by intro x y he @@ -74,9 +76,9 @@ theorem P4062T1OrientationTransport indegree := by intro x hx have hc : (E.filter (fun y => @decide (o.edge (y-u) (x-u)) - (o.edge_decidable (y-u) (x-u)))).card = + (o.edgeDecidable (y-u) (x-u)))).card = (D.filter (fun y => @decide (o.edge y (x-u)) - (o.edge_decidable y (x-u)))).card := by + (o.edgeDecidable y (x-u)))).card := by apply Finset.card_bij (fun y _ => y-u) · intro y hy simp only [Finset.mem_filter, decide_eq_true_eq] at hy ⊢ diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean index 4934e182e6..18e6823985 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean @@ -5,8 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4062T1ParentalRestriction -public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist +public import Mathlib.Init + +public import LeanPool.ApollonianSuperharmonic.FordOdometer +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.P4062T1RecursiveInteriors +public import Mathlib.RingTheory.Int.Basic -- [TABLET NODE: P4062T1OverlapDescent] diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1ParentGluing.lean b/LeanPool/ApollonianSuperharmonic/P4062T1ParentGluing.lean index 49bb5e497d..7fae9e6689 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1ParentGluing.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1ParentGluing.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorGeometry public import LeanPool.ApollonianSuperharmonic.P4062T1ZeroIncoming public import LeanPool.ApollonianSuperharmonic.ParentalOrientationGluing diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean index 76a1e1be53..ffb3d90015 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4062T1RecursiveInteriors public import LeanPool.ApollonianSuperharmonic.FordOdometer public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1RankedAttachment.lean b/LeanPool/ApollonianSuperharmonic/P4062T1RankedAttachment.lean index c895284912..9f5be1a1e2 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1RankedAttachment.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1RankedAttachment.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation -public import Mathlib.Order.Interval.Finset.Nat /-! # P4062T1RankedAttachment @@ -96,7 +97,7 @@ theorem P4062T1RankedAttachment (D E : Finset GaussianInt) omega let t : AcyclicIndegreeOrientation D σ := { edge := edge - edge_decidable := fun _ _ => Classical.propDecidable _ + edgeDecidable := fun _ _ => Classical.propDecidable _ rank := rank supported := support oriented := oriented diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1RecursiveInteriors.lean b/LeanPool/ApollonianSuperharmonic/P4062T1RecursiveInteriors.lean index 5463b080a0..4608d3a6ad 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1RecursiveInteriors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1RecursiveInteriors.lean @@ -5,6 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Topology.Basic + public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorSquare public import LeanPool.ApollonianSuperharmonic.FordFareyParameter diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1RemainderGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4062T1RemainderGeometry.lean index 9346dd992c..4e7fb8888e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1RemainderGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1RemainderGeometry.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderPaths public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorGeometry public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable -public import LeanPool.ApollonianSuperharmonic.P4112T1PathGeometry public import LeanPool.ApollonianSuperharmonic.P4112T1BoundaryMultiplicity public import LeanPool.ApollonianSuperharmonic.P4112T1ParentalNeighbors public import LeanPool.ApollonianSuperharmonic.P4112T1LowerNeighbors diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1RemainderPaths.lean b/LeanPool/ApollonianSuperharmonic/P4062T1RemainderPaths.lean index f54d2bba71..2e24fddc5e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1RemainderPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1RemainderPaths.lean @@ -5,7 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4062T1RecursiveInteriors +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorSquare -- [TABLET NODE: P4062T1RemainderPaths] diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1ZeroIncoming.lean b/LeanPool/ApollonianSuperharmonic/P4062T1ZeroIncoming.lean index fb1f0c0c81..4cc25f4eb2 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1ZeroIncoming.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1ZeroIncoming.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation -public import Mathlib.Algebra.BigOperators.Group.Finset.Basic -- [TABLET NODE: P4062T1ZeroIncoming] diff --git a/LeanPool/ApollonianSuperharmonic/P4085T1FordIncomingNormalization.lean b/LeanPool/ApollonianSuperharmonic/P4085T1FordIncomingNormalization.lean index 854cd9209f..96b93695ae 100644 --- a/LeanPool/ApollonianSuperharmonic/P4085T1FordIncomingNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4085T1FordIncomingNormalization.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.P4085T1RestrictedAdaptedActions diff --git a/LeanPool/ApollonianSuperharmonic/P4085T1MinusTouching.lean b/LeanPool/ApollonianSuperharmonic/P4085T1MinusTouching.lean index c5afe8eb23..2de0bca22e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4085T1MinusTouching.lean +++ b/LeanPool/ApollonianSuperharmonic/P4085T1MinusTouching.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality diff --git a/LeanPool/ApollonianSuperharmonic/P4085T1RestrictedAdaptedActions.lean b/LeanPool/ApollonianSuperharmonic/P4085T1RestrictedAdaptedActions.lean index 1413b5f5d9..bc2a9d5d5c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4085T1RestrictedAdaptedActions.lean +++ b/LeanPool/ApollonianSuperharmonic/P4085T1RestrictedAdaptedActions.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1BoundaryMultiplicity.lean b/LeanPool/ApollonianSuperharmonic/P4112T1BoundaryMultiplicity.lean index 039bc7ea8f..32f8f1836a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1BoundaryMultiplicity.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1BoundaryMultiplicity.lean @@ -5,8 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderPaths public import LeanPool.ApollonianSuperharmonic.FordBoundaryMultiplicity +public meta import Lean.Meta.Tactic.NormCast +public import Mathlib.Algebra.BigOperators.Fin /-! # P4112T1BoundaryMultiplicity @@ -145,13 +149,16 @@ theorem P4112T1BoundaryMultiplicity (P : FordFareyParameter) (hP : 2 < P.q) : · fin_cases j · simp only [P4062T1RemainderPaths, hlt] at ⊢ have hle : P.q₂ ≤ P.q₁ := Nat.le_of_lt hlt - simp? [P4062T1RemainderPaths, P4062T1InteriorSquare, hlt] at hx + simp only [P4062T1RemainderPaths, hlt, ↓reduceIte, Int.reduceNeg, P4062T1InteriorSquare, + Finset.product_eq_sprod, Fin.zero_eta, Fin.isValue, Matrix.cons_val_zero, + Finset.mem_filter, Finset.mem_image, Finset.mem_product, Finset.mem_Icc, + Prod.exists] at hx rcases hx with ⟨⟨a, b, hmem, heq⟩, hp⟩ rcases hmem with ⟨⟨ha1, ha2⟩, hb1, hb2⟩ subst x - simp? at hp + simp only at hp by_cases hroot : (⟨a, b⟩ : GaussianInt) = ⟨(P.q₁ : Int), (P.q₂ : Int)⟩ - · simp? at hroot + · simp only [Int.reduceNeg, Zsqrtd.mk.injEq] at hroot rcases hroot with ⟨rfl, rfl⟩ simp_all [] · rcases hp with hp | hp <;> rcases hp with ⟨h1, h2⟩ <;> @@ -159,13 +166,16 @@ theorem P4112T1BoundaryMultiplicity (P : FordFareyParameter) (hP : 2 < P.q) : split_ifs <;> omega · simp only [P4062T1RemainderPaths, hlt] at ⊢ have hle : P.q₂ ≤ P.q₁ := Nat.le_of_lt hlt - simp? [P4062T1RemainderPaths, P4062T1InteriorSquare, hlt] at hx + simp only [P4062T1RemainderPaths, hlt, ↓reduceIte, Int.reduceNeg, P4062T1InteriorSquare, + Finset.product_eq_sprod, Fin.mk_one, Fin.isValue, Matrix.cons_val_one, + Matrix.cons_val_fin_one, Finset.mem_filter, Finset.mem_image, Finset.mem_product, + Finset.mem_Icc, Prod.exists] at hx rcases hx with ⟨⟨a, b, hmem, heq⟩, hp⟩ rcases hmem with ⟨⟨ha1, ha2⟩, hb1, hb2⟩ subst x - simp? at hp + simp only at hp by_cases hroot : (⟨a, b⟩ : GaussianInt) = ⟨(P.q₂ : Int), (P.q₁ : Int)⟩ - · simp? at hroot + · simp only [Int.reduceNeg, Zsqrtd.mk.injEq] at hroot rcases hroot with ⟨rfl, rfl⟩ simp_all [] · rcases hp with hp | hp <;> rcases hp with ⟨h1, h2⟩ <;> @@ -176,13 +186,16 @@ theorem P4112T1BoundaryMultiplicity (P : FordFareyParameter) (hP : 2 < P.q) : have hleNat : P.q₁ ≤ P.q₂ := Nat.le_of_not_gt hlt have hlt' : P.q₁ < P.q₂ := Nat.lt_of_le_of_ne hleNat hneq have hle : P.q₁ ≤ P.q₂ := Nat.le_of_lt hlt' - simp? [P4062T1RemainderPaths, P4062T1InteriorSquare, hlt] at hx + simp only [P4062T1RemainderPaths, hlt, ↓reduceIte, Int.reduceNeg, P4062T1InteriorSquare, + Finset.product_eq_sprod, Fin.zero_eta, Fin.isValue, Matrix.cons_val_zero, + Finset.mem_filter, Finset.mem_image, Finset.mem_product, Finset.mem_Icc, + Prod.exists] at hx rcases hx with ⟨⟨a, b, hmem, heq⟩, hp⟩ rcases hmem with ⟨⟨ha1, ha2⟩, hb1, hb2⟩ subst x - simp? at hp + simp only at hp by_cases hroot : (⟨a, b⟩ : GaussianInt) = ⟨(P.q₁ : Int), (P.q₁ : Int)⟩ - · simp? at hroot + · simp only [Int.reduceNeg, Zsqrtd.mk.injEq] at hroot rcases hroot with ⟨rfl, rfl⟩ simp_all [] · rcases hp with hp | hp <;> rcases hp with ⟨h1, h2⟩ <;> @@ -192,13 +205,16 @@ theorem P4112T1BoundaryMultiplicity (P : FordFareyParameter) (hP : 2 < P.q) : have hleNat : P.q₁ ≤ P.q₂ := Nat.le_of_not_gt hlt have hlt' : P.q₁ < P.q₂ := Nat.lt_of_le_of_ne hleNat hneq have hle : P.q₁ ≤ P.q₂ := Nat.le_of_lt hlt' - simp? [P4062T1RemainderPaths, P4062T1InteriorSquare, hlt] at hx + simp only [P4062T1RemainderPaths, hlt, ↓reduceIte, Int.reduceNeg, P4062T1InteriorSquare, + Finset.product_eq_sprod, Fin.mk_one, Fin.isValue, Matrix.cons_val_one, + Matrix.cons_val_fin_one, Finset.mem_filter, Finset.mem_image, Finset.mem_product, + Finset.mem_Icc, Prod.exists] at hx rcases hx with ⟨⟨a, b, hmem, heq⟩, hp⟩ rcases hmem with ⟨⟨ha1, ha2⟩, hb1, hb2⟩ subst x - simp? at hp + simp only at hp by_cases hroot : (⟨a, b⟩ : GaussianInt) = ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ - · simp? at hroot + · simp only [Int.reduceNeg, Zsqrtd.mk.injEq] at hroot rcases hroot with ⟨rfl, rfl⟩ simp_all [] · rcases hp with hp | hp <;> rcases hp with ⟨h1, h2⟩ <;> diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean index ff6fcec594..398d501ae4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4112T1PathGeometry /-! diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean index 64ea5cd4f5..9e886d0f53 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean @@ -5,8 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderPaths public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent +public meta import Lean.Meta.Tactic.NormCast +public import LeanPool.ApollonianSuperharmonic.P4062T1RecursiveInteriors /-! # P4112T1ParentalNeighbors @@ -934,25 +938,29 @@ theorem P4112T1ParentalNeighbors (P : FordFareyParameter) (hP : 2 < P.q) : fin_cases j · rcases x with ⟨u, v⟩ by_cases h : P.q₂ < P.q₁ - · simp? [P4062T1RemainderPaths, h, Finset.mem_filter] at hx + · simp only [P4062T1RemainderPaths, h, ↓reduceIte, Int.reduceNeg, Fin.zero_eta, + Fin.isValue, Matrix.cons_val_zero, Finset.mem_filter] at hx rcases hx with ⟨hxbox, hxline⟩ have hb := (squareCoordinates P.q ⟨u, v⟩).mp hxbox exact rowR u v hb hxline h - · simp? [P4062T1RemainderPaths, h, Finset.mem_filter] at hx + · simp only [P4062T1RemainderPaths, h, ↓reduceIte, Int.reduceNeg, Fin.zero_eta, + Fin.isValue, Matrix.cons_val_zero, Finset.mem_filter] at hx rcases hx with ⟨hxbox, hxline⟩ have hb := (squareCoordinates P.q ⟨u, v⟩).mp hxbox have ho : P.q₁ < P.q₂ := by omega exact rowSmall u v hb hxline ho · rcases x with ⟨u, v⟩ by_cases h : P.q₂ < P.q₁ - · simp? [P4062T1RemainderPaths, h, Finset.mem_filter] at hx + · simp only [P4062T1RemainderPaths, h, ↓reduceIte, Int.reduceNeg, Fin.mk_one, Fin.isValue, + Matrix.cons_val_one, Matrix.cons_val_fin_one, Finset.mem_filter] at hx rcases hx with ⟨hxbox, hxline⟩ have hb := (squareCoordinates P.q ⟨u, v⟩).mp hxbox have hb' : 1 ≤ v ∧ v ≤ (P.q : Int)-1 ∧ 1 ≤ u ∧ u ≤ (P.q : Int)-1 := ⟨hb.2.2.1, hb.2.2.2, hb.1, hb.2.1⟩ rw [transpose_filter_card] exact rowR v u hb' hxline h - · simp? [P4062T1RemainderPaths, h, Finset.mem_filter] at hx + · simp only [P4062T1RemainderPaths, h, ↓reduceIte, Int.reduceNeg, Fin.mk_one, Fin.isValue, + Matrix.cons_val_one, Matrix.cons_val_fin_one, Finset.mem_filter] at hx rcases hx with ⟨hxbox, hxline⟩ have hb := (squareCoordinates P.q ⟨u, v⟩).mp hxbox have ho : P.q₁ < P.q₂ := by omega diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean index 16c116b351..037771bc43 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean @@ -5,9 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Constructions +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderPaths public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import Mathlib.Data.Nat.Dist +public meta import Lean.Meta.Tactic.NormCast +public import LeanPool.ApollonianSuperharmonic.P4062T1RecursiveInteriors /-! # P4112T1PathGeometry @@ -240,7 +246,8 @@ private theorem memB0Large : classical intro P B r s hsum hs hr squareCoordinates x hlarge change P.q₂ < P.q₁ at hlarge - simp? [B, P4062T1RemainderPaths, hlarge, Finset.mem_filter] + simp only [P4062T1RemainderPaths, hlarge, ↓reduceIte, Int.reduceNeg, Fin.isValue, + Matrix.cons_val_zero, Finset.mem_filter, B] rw [squareCoordinates] omega @@ -257,7 +264,8 @@ private theorem memB1Large : classical intro P B r s hsum hs hr squareCoordinates x hlarge change P.q₂ < P.q₁ at hlarge - simp? [B, P4062T1RemainderPaths, hlarge, Finset.mem_filter] + simp only [P4062T1RemainderPaths, hlarge, ↓reduceIte, Int.reduceNeg, Fin.isValue, + Matrix.cons_val_one, Matrix.cons_val_fin_one, Finset.mem_filter, B] rw [squareCoordinates] omega @@ -275,7 +283,8 @@ private theorem memB0Small : intro P B r s hsum hs hr squareCoordinates x hsmall change P.q₁ < P.q₂ at hsmall have hfalse : ¬ P.q₂ < P.q₁ := by omega - simp? [B, P4062T1RemainderPaths, hfalse, Finset.mem_filter] + simp only [P4062T1RemainderPaths, hfalse, ↓reduceIte, Int.reduceNeg, Fin.isValue, + Matrix.cons_val_zero, Finset.mem_filter, B] rw [squareCoordinates] omega @@ -293,7 +302,8 @@ private theorem memB1Small : intro P B r s hsum hs hr squareCoordinates x hsmall change P.q₁ < P.q₂ at hsmall have hfalse : ¬ P.q₂ < P.q₁ := by omega - simp? [B, P4062T1RemainderPaths, hfalse, Finset.mem_filter] + simp only [P4062T1RemainderPaths, hfalse, ↓reduceIte, Int.reduceNeg, Fin.isValue, + Matrix.cons_val_one, Matrix.cons_val_fin_one, Finset.mem_filter, B] rw [squareCoordinates] omega diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1AffineComparison.lean b/LeanPool/ApollonianSuperharmonic/P4120T1AffineComparison.lean index b09a85f7e7..720f8b6aa9 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1AffineComparison.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1AffineComparison.lean @@ -5,13 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary -public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import Mathlib.Tactic.Abel -- [TABLET NODE: P4120T1AffineComparison] diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1DiamondGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4120T1DiamondGeometry.lean index c55ba6776a..412af820e4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1DiamondGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1DiamondGeometry.lean @@ -5,13 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondBoundaryLedger -public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCentroid -- [TABLET NODE: P4120T1DiamondGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean index 289b04eb7c..4fe3d215d5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean @@ -5,14 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification public import LeanPool.ApollonianSuperharmonic.FordBoundaryMultiplicity public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: P4120T1FordGeometry] @@ -195,7 +196,10 @@ private theorem fordCentroid : (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 := by rw [← Nat.cast_sum] simp [Finset.sum_range_id] - simp? [domain, Finset.sum_product] + simp only [Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, Finset.coe_range, + Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, implies_true, + Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, Finset.sum_const, + Finset.card_range, Int.nsmul_eq_mul, domain] conv_lhs => rw [← Finset.mul_sum (Finset.range P.q) (fun n => (n : Int)) (P.q : Int)] rw [hrange] @@ -206,7 +210,10 @@ private theorem fordCentroid : (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 := by rw [← Nat.cast_sum] simp [Finset.sum_range_id] - simp? [domain, Finset.sum_product] + simp only [Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, Finset.coe_range, + Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, implies_true, + Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, Finset.sum_const, + Finset.card_range, Int.nsmul_eq_mul, domain] rw [hrange] ring change (if domain.Nonempty then @@ -417,7 +424,9 @@ private theorem hSc00 : intro P Sc h00 hrpos have hne : (FordTile P.q₁).cells.Nonempty := by refine ⟨⟨0, 0⟩, ?_⟩ - simp? [FordTile, FordCellDomain] + simp only [FordTile, FordCellDomain, Int.reduceNeg, Finset.product_eq_sprod, + Finset.mem_image, Finset.mem_product, Finset.mem_range, Zsqrtd.mk.injEq, + Int.natCast_eq_zero, Prod.exists, exists_eq_right_right, exists_eq_right, and_self] exact hrpos have ha : (Sc 0 true).cells = ∅ → (Sc 0 true).anchor = (FordTile P.q₁).anchor := by diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean index b5315cf87c..fada65efd3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean @@ -5,14 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidenceZeroOppositeChord public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -- [TABLET NODE: P4120T1GeneralDescent] @@ -1410,7 +1408,7 @@ private theorem parentMap_injective : ⟨owner (parentCellIndex q), Finset.mem_image.mpr ⟨parentCellIndex q, Finset.mem_univ _, rfl⟩⟩ := by have hsum := hpq - simp? [parentMap, hp, hq] at hsum + simp only [Fin.isValue, hp, ↓reduceIte, hq, Sum.inl.injEq, parentMap] at hsum exact hsum exact congrArg Subtype.val hsub apply Subtype.ext diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralRowData.lean b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralRowData.lean index 94c3455aa1..e2745ac6f0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralRowData.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralRowData.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1RootNormalization.lean b/LeanPool/ApollonianSuperharmonic/P4120T1RootNormalization.lean index fd4d238fc7..d1fe0c56e4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1RootNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1RootNormalization.lean @@ -5,13 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification public import LeanPool.ApollonianSuperharmonic.BandParentRotationOccurrenceCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryGlobalOdometerTransport -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -- [TABLET NODE: P4120T1RootNormalization] diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1AncestorCells.lean b/LeanPool/ApollonianSuperharmonic/P4158T1AncestorCells.lean index a4b2b291cc..65360add64 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1AncestorCells.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1AncestorCells.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorTile public import LeanPool.ApollonianSuperharmonic.BandPrototileReindexedDecomposition public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean index 5b858af3d6..c43210da73 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean @@ -5,13 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometer public import LeanPool.ApollonianSuperharmonic.FordFareyParameter public import LeanPool.ApollonianSuperharmonic.FordTile public import LeanPool.ApollonianSuperharmonic.TileString -public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.AffineTriangularNoFourfoldCellOwners -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne -- [TABLET NODE: P4158T1EdgeSectorSelection] @@ -1575,7 +1575,7 @@ private theorem hxroot : apply Zsqrtd.ext_iff.mpr constructor · simp [Zsqrtd.re_add] - · simp? [Zsqrtd.im_add] + · simp only [Int.reduceNeg, Zsqrtd.im_add] rw [← hqsum] ring diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean index 2bbfabea0a..e1e68f705e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean @@ -5,16 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometer -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -- [TABLET NODE: P4158T1LargeFirstRestrictions] @@ -412,7 +410,10 @@ private theorem fordCentroid : (n : Int) * ((n - 1 : Nat) : Int) / 2 := by rw [← Nat.cast_sum] simp [Finset.sum_range_id] - simp? [D, Finset.sum_product] + simp only [Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, Finset.coe_range, + Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, implies_true, + Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, Finset.sum_const, + Finset.card_range, Int.nsmul_eq_mul, D] conv_lhs => rw [← Finset.mul_sum (Finset.range n) (fun a => (a : Int)) (n : Int)] rw [hrange] @@ -423,7 +424,10 @@ private theorem fordCentroid : (n : Int) * ((n - 1 : Nat) : Int) / 2 := by rw [← Nat.cast_sum] simp [Finset.sum_range_id] - simp? [D, Finset.sum_product] + simp only [Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, Finset.coe_range, + Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, implies_true, + Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, Finset.sum_const, + Finset.card_range, Int.nsmul_eq_mul, D] rw [hrange] ring change (if D.Nonempty then diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean index efc895f106..75dade4e2c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean @@ -5,16 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometer -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: P4158T1LargeSecondRestrictions] @@ -333,7 +332,10 @@ private theorem fordCentroid : (n : Int) * ((n - 1 : Nat) : Int) / 2 := by rw [← Nat.cast_sum] simp [Finset.sum_range_id] - simp? [domain, FordCellDomain, Finset.sum_product] + simp only [FordCellDomain, Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, + Finset.coe_range, Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, + implies_true, Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, + Finset.sum_const, Finset.card_range, Int.nsmul_eq_mul, domain] conv_lhs => rw [← Finset.mul_sum (Finset.range n) (fun x => (x : Int)) (n : Int)] rw [hrange] ring @@ -343,7 +345,10 @@ private theorem fordCentroid : (n : Int) * ((n - 1 : Nat) : Int) / 2 := by rw [← Nat.cast_sum] simp [Finset.sum_range_id] - simp? [domain, FordCellDomain, Finset.sum_product] + simp only [FordCellDomain, Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, + Finset.coe_range, Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, + implies_true, Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, + Finset.sum_const, Finset.card_range, Int.nsmul_eq_mul, domain] rw [hrange] ring change (if domain.Nonempty then diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean index f38bc9774e..fe5eed4b29 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean @@ -5,12 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction -public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -- [TABLET NODE: P4158T1MatchedFordPair] @@ -57,17 +55,19 @@ private theorem hqgt : have hsumq : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by exact_mod_cast P.sum_q have hc := congrArg (fun x : CircleCoordinates => x.1) hCi - simp? [FordRecursiveQuadruple, FordCircleCoordinate] at hc + simp only [FordRecursiveQuadruple, FordCircleCoordinate, Nat.cast_mul, Int.reduceNeg, + Matrix.cons_val_succ] at hc have : 1 < P.q := by fin_cases i - · simp? [] at hc + · simp only [Int.reduceNeg, Fin.zero_eta, Fin.isValue, Matrix.cons_val_zero] at hc split at hc · norm_num at hc exact (by omega : False).elim · have hq : 1 < P.q₁ := by nlinarith [hlarge, hc] have hqNat : 1 < P.q₁ := by exact_mod_cast hq omega - · simp? [] at hc + · simp only [Int.reduceNeg, Fin.mk_one, Fin.isValue, Matrix.cons_val_one, + Matrix.cons_val_zero] at hc have hq : 1 < P.q₂ := by nlinarith [hlarge, hc] have hqNat : 1 < P.q₂ := by exact_mod_cast hq omega @@ -114,14 +114,17 @@ private theorem hneq : have hselected : 1 < P.q₁ := by fin_cases i · have hc := congrArg (fun x : CircleCoordinates => x.1) hCi - simp? [FordRecursiveQuadruple, FordCircleCoordinate] at hc + simp only [FordRecursiveQuadruple, FordCircleCoordinate, Nat.cast_mul, Int.reduceNeg, + Fin.zero_eta, Fin.isValue, Fin.succ_zero_eq_one, Matrix.cons_val_one, + Matrix.cons_val_zero] at hc split at hc · norm_num at hc exact (by omega : False).elim · have hh : 1 < P.q₁ := by nlinarith [hlarge, hc] exact hh · have hc := congrArg (fun x : CircleCoordinates => x.1) hCi - simp? [FordRecursiveQuadruple, FordCircleCoordinate] at hc + simp only [FordRecursiveQuadruple, FordCircleCoordinate, Nat.cast_mul, Int.reduceNeg, + Fin.mk_one, Fin.isValue, Fin.succ_one_eq_two, Matrix.cons_val] at hc have hh : 1 < P.q₂ := by nlinarith [hlarge, hc] omega · exact False.elim (hidx rfl) @@ -277,7 +280,10 @@ private theorem hfordcent : (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 := by rw [← Nat.cast_sum] simp [Finset.sum_range_id] - simp? [domain, Finset.sum_product] + simp only [Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, Finset.coe_range, + Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, implies_true, + Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, Finset.sum_const, + Finset.card_range, Int.nsmul_eq_mul, domain] conv_lhs => rw [← Finset.mul_sum (Finset.range P.q) (fun n => (n : Int)) (P.q : Int)] rw [hrange] @@ -288,7 +294,10 @@ private theorem hfordcent : (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 := by rw [← Nat.cast_sum] simp [Finset.sum_range_id] - simp? [domain, Finset.sum_product] + simp only [Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, Finset.coe_range, + Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, implies_true, + Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, Finset.sum_const, + Finset.card_range, Int.nsmul_eq_mul, domain] rw [hrange] ring change (if domain.Nonempty then diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean index 6e4581cc8b..7cb93fbb38 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean @@ -5,23 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometer -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist -public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport -public import LeanPool.ApollonianSuperharmonic.BandGenealogy -public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification -public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct -public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity public import LeanPool.ApollonianSuperharmonic.OpposingStringInterfacePath public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -- [TABLET NODE: P4158T1SmallerStringEdges] @@ -65,7 +55,8 @@ private theorem hqone : have he : P.q = 1 := by have := P.q_pos; omega have hunit := P.unit_case he rcases hsmall with ⟨rfl, hlt⟩ | ⟨rfl, hlt⟩ - · simp? [FordRecursiveQuadruple, hunit.2.1] at hCi + · simp only [FordRecursiveQuadruple, hunit.2.1, ↓reduceIte, Fin.isValue, + Fin.succ_zero_eq_one, Matrix.cons_val_one, Matrix.cons_val_zero] at hCi have := congrArg Prod.fst hCi omega · have hq2 : P.q₂ = 1 := hunit.2.2.2 @@ -98,7 +89,8 @@ private theorem hC0pos : classical intro P C0 hC0 hqone rw [← hC0] - simp? [FordRecursiveQuadruple, FordCircleCoordinate] + simp only [FordRecursiveQuadruple, FordCircleCoordinate, Nat.cast_mul, Int.reduceNeg, + Fin.isValue, Matrix.cons_val_zero, mul_self_pos, ne_eq, Int.natCast_eq_zero] positivity private theorem hCicurv : diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1StringSlopeTelescoping.lean b/LeanPool/ApollonianSuperharmonic/P4158T1StringSlopeTelescoping.lean index 6c830cf742..f114088930 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1StringSlopeTelescoping.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1StringSlopeTelescoping.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -- [TABLET NODE: P4158T1StringSlopeTelescoping] diff --git a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean index 38c22df39b..11c2e3ba1b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean @@ -5,8 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.Set.Card +public import Mathlib.Tactic.ByContra +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Ring + public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import Mathlib.Algebra.BigOperators.Fin -- [TABLET NODE: P4194T1DiamondBoundaryLedger] @@ -341,9 +348,10 @@ private theorem unitBoundary : · simp [add_assoc, add_comm, add_left_comm] constructor · intro hx - simp? [BoundaryFootprintVertices, BoundaryFootprintEdges, - Finset.mem_singleton, sub_eq_add_neg, - Zsqrtd.ext_iff] at hx + simp only [BoundaryFootprintVertices, Finset.singleton_nonempty, ↓reduceIte, + BoundaryFootprintEdges, Finset.mem_singleton, Zsqrtd.ext_iff, Int.reduceNeg, + sub_eq_add_neg, Zsqrtd.re_add, Zsqrtd.re_neg, neg_zero, add_zero, Zsqrtd.im_add, + Zsqrtd.im_neg, not_and, Zsqrtd.re_one, Zsqrtd.im_one, Set.mem_ofPred_eq] at hx rcases hx with ⟨e, ⟨w, hEdge⟩, hv⟩ rcases hEdge with ⟨he, hc⟩ | ⟨he, hc⟩ · subst e @@ -664,14 +672,33 @@ private theorem hmidClass : by_cases hl : z.re = -(m : Int) + 1 · by_cases hr : z.re = (m : Int) - 1 · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> - simp? [hl] <;> (try split_ifs) <;> omega + simp only [Int.reduceNeg, hl, ↓reduceIte, mul_one, mul_ite, mul_zero, + le_neg_add_iff_add_le, add_neg_cancel_left, Nat.not_ofNat_le_one, + neg_add_le_iff_le_add, false_and, not_false_eq_true, Nat.add_eq_right, + Nat.add_eq_zero_iff, OfNat.ofNat_ne_zero, ite_eq_right_iff, imp_false, neg_sub, + false_iff, not_or, Nat.reduceEqDiff, Nat.add_eq_left, and_self, add_sub_cancel, + and_true] <;> (try split_ifs) <;> omega · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> - simp? [hl] <;> (try split_ifs) <;> omega + simp only [Int.reduceNeg, hl, ↓reduceIte, mul_one, mul_ite, mul_zero, + le_neg_add_iff_add_le, add_neg_cancel_left, Nat.not_ofNat_le_one, + neg_add_le_iff_le_add, false_and, not_false_eq_true, Nat.add_eq_right, + Nat.add_eq_zero_iff, OfNat.ofNat_ne_zero, ite_eq_right_iff, imp_false, neg_sub, + false_iff, not_or, Nat.reduceEqDiff, Nat.add_eq_left, and_self, add_sub_cancel, + and_true] <;> (try split_ifs) <;> omega · by_cases hr : z.re = (m : Int) - 1 · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> - simp? [hr] <;> (try split_ifs) <;> omega + simp only [Int.reduceNeg, hr, mul_ite, mul_one, mul_zero, ↓reduceIte, + neg_add_le_iff_le_add, tsub_le_iff_right, not_and, not_le, sub_right_inj, + OfNat.one_ne_ofNat, neg_sub, false_or, true_or, iff_true, Nat.add_eq_zero_iff, + ite_eq_right_iff, OfNat.ofNat_ne_zero, imp_false, and_false, not_imp, not_lt, + false_and, false_iff] <;> (try split_ifs) <;> omega · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> - simp? [hl, hr, hc] <;> (try split_ifs) <;> omega + simp only [Int.reduceNeg, hl, ↓reduceIte, mul_zero, hr, add_zero, hc, and_self, + not_true_eq_false, OfNat.zero_ne_ofNat, neg_sub, false_iff, not_or, + not_false_eq_true, false_or, tsub_le_iff_right, and_true, true_iff, true_and, + neg_add_le_iff_le_add, not_and, not_le, mul_ite, mul_one, zero_add, + ite_eq_left_iff, not_imp, not_lt, imp_false, ite_eq_right_iff, + OfNat.ofNat_ne_zero, and_congr_left_iff] <;> (try split_ifs) <;> omega private theorem htwoOff : ∀ (m : Nat), ∀ (C : Fin 3 → Bool → ProtoTile), ∀ (z : GaussianInt), @@ -838,14 +865,24 @@ private theorem hdescent : by_cases hl : z.re = -(m : Int) + 1 · by_cases hr : z.re = (m : Int) - 1 · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> - simp? [hl] at hformula <;> (try split_ifs at hformula) <;> omega + simp only [Int.reduceNeg, hl, ↓reduceIte, mul_one, mul_ite, mul_zero, + le_neg_add_iff_add_le, add_neg_cancel_left, Nat.not_ofNat_le_one, + neg_add_le_iff_le_add, false_and, not_false_eq_true] at hformula <;> (try + split_ifs at hformula) <;> omega · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> - simp? [hl] at hformula <;> (try split_ifs at hformula) <;> omega + simp only [Int.reduceNeg, hl, ↓reduceIte, mul_one, mul_ite, mul_zero, + le_neg_add_iff_add_le, add_neg_cancel_left, Nat.not_ofNat_le_one, + neg_add_le_iff_le_add, false_and, not_false_eq_true] at hformula <;> (try + split_ifs at hformula) <;> omega · by_cases hr : z.re = (m : Int) - 1 · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> - simp? [hr] at hformula <;> (try split_ifs at hformula) <;> omega + simp only [Int.reduceNeg, hr, mul_ite, mul_one, mul_zero, ↓reduceIte, + neg_add_le_iff_le_add, tsub_le_iff_right, not_and, not_le] at hformula <;> (try + split_ifs at hformula) <;> omega · by_cases hc : -(m : Int) + 3 ≤ z.re ∧ z.re ≤ (m : Int) - 3 <;> - simp? [hl, hr, hc] at hformula <;> (try split_ifs at hformula) <;> omega + simp only [Int.reduceNeg, hl, ↓reduceIte, mul_zero, hr, add_zero, hc, and_self, + not_true_eq_false, neg_add_le_iff_le_add, not_and, not_le, mul_ite, mul_one, + zero_add] at hformula <;> (try split_ifs at hformula) <;> omega have hfourlo := (hloFourAtMid hmid).2 ((hmidcore).2 hcore) refine Or.inr ⟨false, ?_⟩ intro j diff --git a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondCellRows.lean b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondCellRows.lean index 4c11b43a28..3969a8ca44 100644 --- a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondCellRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondCellRows.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import Mathlib.Tactic.FinCases -public import Mathlib.Tactic.NormNum -- [TABLET NODE: P4194T1DiamondCellRows] diff --git a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondCentroid.lean b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondCentroid.lean index 08e8fcaea1..6ed3d22f67 100644 --- a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondCentroid.lean +++ b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondCentroid.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows public import LeanPool.ApollonianSuperharmonic.DiamondTile public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import Mathlib.Tactic.Linarith +public meta import Lean.Meta.Tactic.NormCast -- [TABLET NODE: P4194T1DiamondCentroid] @@ -51,7 +53,7 @@ theorem P4194T1DiamondCentroid (n : Nat) (hn : 0 < n) : apply Zsqrtd.ext · simp [reflectX] at heq ⊢ omega - · simp? [reflectX] at heq ⊢ + · simp only [Int.reduceNeg, Zsqrtd.mk.injEq, sub_left_inj, neg_inj, reflectX] at heq ⊢ exact heq.2 · intro z hz refine ⟨reflectX z, reflectX_mem z hz, ?_⟩ @@ -70,7 +72,7 @@ theorem P4194T1DiamondCentroid (n : Nat) (hn : 0 < n) : · exact fun z hz => reflectY_mem z hz · intro z hz w hw heq apply Zsqrtd.ext - · simp? [reflectY] at heq ⊢ + · simp only [Int.reduceNeg, Zsqrtd.mk.injEq, sub_right_inj, reflectY] at heq ⊢ exact heq.1 · simp [reflectY] at heq ⊢ omega diff --git a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondVertexIncidence.lean b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondVertexIncidence.lean index 6141c72e0b..5ab0fa0532 100644 --- a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondVertexIncidence.lean +++ b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondVertexIncidence.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows public import LeanPool.ApollonianSuperharmonic.DiamondTile public import LeanPool.ApollonianSuperharmonic.FootprintVertices diff --git a/LeanPool/ApollonianSuperharmonic/P4207T1DiamondFormula.lean b/LeanPool/ApollonianSuperharmonic/P4207T1DiamondFormula.lean index 5e10ba7726..3b68edfdcc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4207T1DiamondFormula.lean +++ b/LeanPool/ApollonianSuperharmonic/P4207T1DiamondFormula.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction -- [TABLET NODE: P4207T1DiamondFormula] diff --git a/LeanPool/ApollonianSuperharmonic/P4207T1FloorArithmetic.lean b/LeanPool/ApollonianSuperharmonic/P4207T1FloorArithmetic.lean index 50409720d2..154720cba0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4207T1FloorArithmetic.lean +++ b/LeanPool/ApollonianSuperharmonic/P4207T1FloorArithmetic.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4207T1DiamondFormula -public import Mathlib.Tactic.Ring -- [TABLET NODE: P4207T1FloorArithmetic] diff --git a/LeanPool/ApollonianSuperharmonic/P4207T1FormulaRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4207T1FormulaRestriction.lean index 0e2294e84f..6b9c42279c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4207T1FormulaRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4207T1FormulaRestriction.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4207T1DiamondFormula public import LeanPool.ApollonianSuperharmonic.PartialOdometer -public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.ProtoTile -- [TABLET NODE: P4207T1FormulaRestriction] diff --git a/LeanPool/ApollonianSuperharmonic/P4207T1ShiftedPredecessor.lean b/LeanPool/ApollonianSuperharmonic/P4207T1ShiftedPredecessor.lean index cc69f68097..f64576f7f1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4207T1ShiftedPredecessor.lean +++ b/LeanPool/ApollonianSuperharmonic/P4207T1ShiftedPredecessor.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4207T1FormulaRestriction public import LeanPool.ApollonianSuperharmonic.DiamondTile public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic diff --git a/LeanPool/ApollonianSuperharmonic/P4207T1UnitRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4207T1UnitRestrictions.lean index ae06fa581f..2ea2b2c10d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4207T1UnitRestrictions.lean +++ b/LeanPool/ApollonianSuperharmonic/P4207T1UnitRestrictions.lean @@ -5,13 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.P4207T1FormulaRestriction public import LeanPool.ApollonianSuperharmonic.DiamondParameter -public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer public import LeanPool.ApollonianSuperharmonic.OdometerTranslation public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope -public import Mathlib.Algebra.Ring.Int.Parity +public import Mathlib.LinearAlgebra.Matrix.Notation -- [TABLET NODE: P4207T1UnitRestrictions] diff --git a/LeanPool/ApollonianSuperharmonic/P4210T1FordCellRectangles.lean b/LeanPool/ApollonianSuperharmonic/P4210T1FordCellRectangles.lean index e4103d35f5..0d1f6ea68a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4210T1FordCellRectangles.lean +++ b/LeanPool/ApollonianSuperharmonic/P4210T1FordCellRectangles.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordTile public import LeanPool.ApollonianSuperharmonic.TileTranslation diff --git a/LeanPool/ApollonianSuperharmonic/P4210T1FordSquareCentroid.lean b/LeanPool/ApollonianSuperharmonic/P4210T1FordSquareCentroid.lean index 684e9f074f..50cb024325 100644 --- a/LeanPool/ApollonianSuperharmonic/P4210T1FordSquareCentroid.lean +++ b/LeanPool/ApollonianSuperharmonic/P4210T1FordSquareCentroid.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.FordCellDomain +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordTile public import LeanPool.ApollonianSuperharmonic.TileCentroid +public meta import Lean.Meta.Tactic.NormCast -- [TABLET NODE: P4210T1FordSquareCentroid] @@ -54,13 +56,19 @@ theorem P4210T1FordSquareCentroid (q : Nat) (hq : 0 < q) : simp [Finset.sum_range_id] have domain_re_sum : domain.sum (fun z : GaussianInt => z.re) = (q : Int) * ((q - 1 : Nat) : Int) / 2 * (q : Int) := by - simp? [domain, FordCellDomain, Finset.sum_product] + simp only [FordCellDomain, Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, + Finset.coe_range, Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, + implies_true, Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, + Finset.sum_const, Finset.card_range, Int.nsmul_eq_mul, domain] conv_lhs => rw [← Finset.mul_sum (Finset.range q) (fun x => (x : Int)) (q : Int)] rw [range_sum] ring have domain_im_sum : domain.sum (fun z : GaussianInt => z.im) = (q : Int) * ((q - 1 : Nat) : Int) / 2 * (q : Int) := by - simp? [domain, FordCellDomain, Finset.sum_product] + simp only [FordCellDomain, Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, + Finset.coe_range, Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, + implies_true, Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, + Finset.sum_const, Finset.card_range, Int.nsmul_eq_mul, domain] rw [range_sum] ring change (if domain.Nonempty then diff --git a/LeanPool/ApollonianSuperharmonic/P4217T2RectangularBoundarySlope.lean b/LeanPool/ApollonianSuperharmonic/P4217T2RectangularBoundarySlope.lean index f73c73f249..82d90d4d2c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4217T2RectangularBoundarySlope.lean +++ b/LeanPool/ApollonianSuperharmonic/P4217T2RectangularBoundarySlope.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope -- [TABLET NODE: P4217T2RectangularBoundarySlope] diff --git a/LeanPool/ApollonianSuperharmonic/P4217T2SquareGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4217T2SquareGeometry.lean index 666ded1798..96aefa7fcf 100644 --- a/LeanPool/ApollonianSuperharmonic/P4217T2SquareGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4217T2SquareGeometry.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4217T2SquareRestriction public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles diff --git a/LeanPool/ApollonianSuperharmonic/P4217T2SquareRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4217T2SquareRestriction.lean index 76ae193793..276c3520a0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4217T2SquareRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4217T2SquareRestriction.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PartialOdometer public import LeanPool.ApollonianSuperharmonic.FordVertexDomain diff --git a/LeanPool/ApollonianSuperharmonic/P4223T1DiamondRowNumerators.lean b/LeanPool/ApollonianSuperharmonic/P4223T1DiamondRowNumerators.lean index 4ef493aa22..2275961c9b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4223T1DiamondRowNumerators.lean +++ b/LeanPool/ApollonianSuperharmonic/P4223T1DiamondRowNumerators.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic -public import Mathlib.Algebra.BigOperators.Intervals -- [TABLET NODE: P4223T1DiamondRowNumerators] diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1DefinedHalfIntegralSlope.lean b/LeanPool/ApollonianSuperharmonic/P4250T1DefinedHalfIntegralSlope.lean index 2edcb8b974..e5bd3e98af 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1DefinedHalfIntegralSlope.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1DefinedHalfIntegralSlope.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -- [TABLET NODE: P4250T1DefinedHalfIntegralSlope] diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1IntegralAffinePlacement.lean b/LeanPool/ApollonianSuperharmonic/P4250T1IntegralAffinePlacement.lean index 42599c780b..3c263062b7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1IntegralAffinePlacement.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1IntegralAffinePlacement.lean @@ -5,11 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -- [TABLET NODE: P4250T1IntegralAffinePlacement] diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean b/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean index 81e13df4db..893a0cd8d4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean @@ -5,21 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4250T1SlopeOffset -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRawSupport -public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn -public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition -public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain public import LeanPool.ApollonianSuperharmonic.RightSubtileOdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent -- [TABLET NODE: P4250T1NestedCompatibility] diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean b/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean index 6cbc7b7a16..9b39b3a170 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean @@ -5,12 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4250T1SlopeOffset -public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification public import LeanPool.ApollonianSuperharmonic.RightSubtileOdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent -- [TABLET NODE: P4250T1OrdinaryCompatibility] diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1ParentSlopePhase.lean b/LeanPool/ApollonianSuperharmonic/P4250T1ParentSlopePhase.lean index 72d4986418..c035474268 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1ParentSlopePhase.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1ParentSlopePhase.lean @@ -5,13 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4250T1SlopeOffset public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration -public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -- [TABLET NODE: P4250T1ParentSlopePhase] diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean b/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean index 616a832331..c3da94355b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean @@ -5,20 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4250T1SlopeOffset public import LeanPool.ApollonianSuperharmonic.P4250T1DefinedHalfIntegralSlope public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry -public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P4250T1ReflectedGluingSlope] @@ -305,7 +299,8 @@ private theorem reflectedChild : have hi := congrArg Prod.snd hcentSum have hur := congrArg Prod.fst hu have hui := congrArg Prod.snd hu - simp? [GaussianRealPoint] at hur hui + simp only [Prod.smul_fst, smul_eq_mul, GaussianRealPoint, Int.reduceNeg, + GaussianInt.intCast_re, GaussianInt.intCast_im, Prod.smul_snd] at hur hui rw [← GaussianInt.intCast_re u] at hur rw [← GaussianInt.intCast_im u] at hui dsimp at hr hi @@ -588,11 +583,13 @@ private theorem childOdoConst : have he := congrArg Prod.fst (Option.some.inj hslopes) have hi := congrArg Prod.snd (Option.some.inj hslopes) have hrealr : (aa.re : Real) = 0 := by - simp? [] at he + simp only [Fin.isValue, ite_smul, one_smul, neg_smul, Prod.fst_add, Int.reduceNeg, + GaussianInt.intCast_re, add_eq_left] at he rw [← GaussianInt.intCast_re aa] at he linarith have hreali : (aa.im : Real) = 0 := by - simp? [] at hi + simp only [Fin.isValue, ite_smul, one_smul, neg_smul, Prod.snd_add, Int.reduceNeg, + GaussianInt.intCast_im, add_eq_left] at hi rw [← GaussianInt.intCast_im aa] at hi linarith apply Zsqrtd.ext @@ -624,7 +621,8 @@ private theorem gChildConst : rcases hgcompat j s with hdisj | ⟨c, hc⟩ · obtain ⟨z, hz⟩ := childNonempty j s have hzfoot : z ∈ FootprintVertices (cert.P j s) := by - simp? [FootprintVertices, childNonempty j s] + simp only [FootprintVertices, childNonempty j s, ↓reduceIte, Int.reduceNeg, + Set.mem_ofPred_eq] exact ⟨z, hz, Or.inl rfl⟩ have hdomChild := PositiveCurvatureTileOdometerDomain (q j.succ) (cert.P j s) (h j s) (positive j) (ho j s) diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1SlopeOffset.lean b/LeanPool/ApollonianSuperharmonic/P4250T1SlopeOffset.lean index 916a590ed4..19a903171c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1SlopeOffset.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1SlopeOffset.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: P4250T1SlopeOffset] diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean b/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean index 46eae27968..658302d01b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean @@ -5,11 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.RootedFourNeighborForest public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import Mathlib.Combinatorics.SimpleGraph.Acyclic -public import Mathlib.Combinatorics.SimpleGraph.DegreeSum -- [TABLET NODE: P4250T2FiniteForestCompletion] @@ -67,7 +68,7 @@ private theorem hHacyclic : intro z hz induction p with | nil => - simp? [SimpleGraph.Walk.support] at hz + simp only [SimpleGraph.Walk.support, List.mem_cons, List.not_mem_nil, or_false] at hz subst z exact hu | @cons u v w hadj p ih => @@ -390,7 +391,7 @@ private theorem allWalkW : intro W R adjacentSymm H u v q hu z hz induction q with | nil => - simp? [SimpleGraph.Walk.support] at hz + simp only [SimpleGraph.Walk.support, List.mem_cons, List.not_mem_nil, or_false] at hz subst z exact hu | @cons u v w hadj q ih => diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2IndegreeSubtraction.lean b/LeanPool/ApollonianSuperharmonic/P4250T2IndegreeSubtraction.lean index 5a78756fca..5cb0b1c7f6 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2IndegreeSubtraction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2IndegreeSubtraction.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation -- [TABLET NODE: P4250T2IndegreeSubtraction] diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean index 805c2c5bbb..d97ce1291c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean @@ -5,12 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.TopologicalDiskGridRayCrossingIndexZero -- [TABLET NODE: P4250T2InterfaceCycleExclusion] diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean index 76b1c8ccf6..a139f4335f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean @@ -5,14 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorStarClassification -public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.CurvatureOneTileBase -public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity -public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors -public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -- [TABLET NODE: P4250T2InterfaceNeighborCount] @@ -219,7 +214,10 @@ private theorem edge_endpoint : as_aux_lemma => intro hy fin_cases j - all_goals simp? [LatticeVertexIncidentCell] at hj hj' hy + all_goals simp only [LatticeVertexIncidentCell, Int.reduceNeg, Fin.mk_one, Fin.isValue, + Matrix.cons_val_one, Matrix.cons_val_zero, Fin.reduceAdd, Matrix.cons_val, + Nat.succ_eq_add_one, Nat.reduceAdd, Fin.reduceFinMk, Fin.zero_eta, zero_add] + at hj hj' hy · have he := vertical_interior U z hj hj' apply hreg z (z + ⟨0, 1⟩) · exact Or.inr (Or.inr (Or.inl rfl)) @@ -740,11 +738,11 @@ private theorem hnoO : BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : Finset GaussianInt), (∀ x ∈ D \ P, x ∈ FootprintVertices cert.O ↔ x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((∀ + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell z j ∈ U.cells) → (z ∈ FootprintVertices U)) → (∀ (x : GaussianInt), (x ∈ D \ P) → ((x ∉ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (∀ + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (∀ (j : Fin 4), LatticeVertexIncidentCell x j ∉ cert.O.cells)))) ) := by classical @@ -983,11 +981,11 @@ private theorem hcoverAt684 : BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : Finset GaussianInt), (∀ x ∈ D \ P, x ∈ FootprintVertices cert.O ↔ x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((∀ + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell z j ∈ U.cells) → (z ∈ FootprintVertices U)) → (∀ (x : GaussianInt), (x ∈ D \ P) → ((x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((∀ + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ((∀ (U : ProtoTile), TileTranslation U 0 = U) → (∀ (j : Fin 4), LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells))))) ) := by @@ -1154,7 +1152,10 @@ private theorem hFdAt757 : intro c ha hb have hcAB : (c ∈ (cert.P 0 true).cells ∧ c ∈ (cert.P 0 false).cells) ↔ c ∈ cert.O.cells := by rw [← Finset.mem_inter, hAB] - fin_cases a <;> fin_cases b <;> simp? [F, TileCellComplement] at hne ha hb + fin_cases a <;> fin_cases b <;> simp only [Fin.mk_one, Fin.isValue, Fin.reduceFinMk, ne_eq, + Fin.reduceEq, not_false_eq_true, TileCellComplement, Matrix.cons_val_one, + Matrix.cons_val_zero, Finset.mem_sdiff, Matrix.cons_val, F, Fin.zero_eta, one_ne_zero, + not_true_eq_false, zero_ne_one] at hne ha hb all_goals clear * - hcAB ha hb tauto @@ -1208,7 +1209,7 @@ private theorem hsectors : BandOrderedGeneralLayoutCertificate q cfg C T), (∀ (i : Fin 3), ∀ (s : Bool), (i = 1 ∨ i = 2) → (LatticeTile (cert.Q i s))) → ((∀ (i : Fin 3), ∀ (s : Bool), (i = 1 ∨ i = 2) → (LatticeTile (cert.S i s))) → (∀ (x : GaussianInt), (x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ( + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ( let F : Fin 3 → ProtoTile := ![TileCellComplement (cert.P 0 true) cert.O, TileCellComplement (cert.P 0 false) cert.O, cert.O] @@ -1230,14 +1231,14 @@ private theorem hsectors : rcases Finset.mem_insert.mp hxR with ha | hb · exact triple_sectors (cert.Q 1 true) (cert.S 2 false) (Q_lattice 1 true (Or.inl rfl)) (S_lattice 2 false (Or.inr rfl)) - cert.precursor_boundary.first_touching - cert.precursor_boundary.first_plus_child cert.precursor_boundary.first_minus_child - ((cert.precursor_boundary.first_transition x).mpr ha) + cert.precursorBoundary.first_touching + cert.precursorBoundary.first_plus_child cert.precursorBoundary.first_minus_child + ((cert.precursorBoundary.first_transition x).mpr ha) · exact triple_sectors (cert.Q 2 true) (cert.S 1 false) (Q_lattice 2 true (Or.inr rfl)) (S_lattice 1 false (Or.inl rfl)) - cert.precursor_boundary.second_touching - cert.precursor_boundary.second_plus_child cert.precursor_boundary.second_minus_child - ((cert.precursor_boundary.second_transition x).mpr (Finset.mem_singleton.mp hb)) + cert.precursorBoundary.second_touching + cert.precursorBoundary.second_plus_child cert.precursorBoundary.second_minus_child + ((cert.precursorBoundary.second_transition x).mpr (Finset.mem_singleton.mp hb)) private theorem hcoverAt811 : (by @@ -1414,7 +1415,7 @@ private theorem rootNeighborCount : BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : Finset GaussianInt), (∀ x ∈ D \ P, x ∈ FootprintVertices cert.O ↔ x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((∀ + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell z j ∈ U.cells) → (z ∈ FootprintVertices U)) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ (z : @@ -1444,7 +1445,7 @@ private theorem rootNeighborCount : (FourNeighborAdjacent y x) (Classical.propDecidable _)).card = (Finset.univ.filter fun j : Fin 4 => ∃ i s, LatticeVertexIncidentCell x j ∈ (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells).card) → ((x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ((P.filter fun y => @decide (FourNeighborAdjacent y x) (Classical.propDecidable _)).card = if cert.O.cells = ∅ then 2 else 3)))))))))))))))) ) := by @@ -1454,12 +1455,12 @@ private theorem rootNeighborCount : neighbor_count hxR by_cases hempty : cert.O.cells = ∅ · rw [ite_eq_left hempty, neighbor_count] - have hbranch := cert.precursor_boundary.branch + have hbranch := cert.precursorBoundary.branch rcases hbranch with ⟨hne, _⟩ | hbranch · exact (Finset.nonempty_iff_ne_empty.mp hne hempty).elim - have hxa : x = cert.precursor_boundary.a := by + have hxa : x = cert.precursorBoundary.a := by simpa [hbranch.2.1] using hxR - have htransition := (cert.precursor_boundary.first_transition x).mpr hxa + have htransition := (cert.precursorBoundary.first_transition x).mpr hxa have hQlat := Q_lattice 1 true (Or.inl rfl) have hSlat := S_lattice 2 false (Or.inr rfl) obtain ⟨jA, hjA⟩ := foot_incident _ (LatticeTileGridStructure _ hQlat).1.1 x @@ -1467,9 +1468,9 @@ private theorem rootNeighborCount : obtain ⟨jB, hjB⟩ := foot_incident _ (LatticeTileGridStructure _ hSlat).1.1 x (boundary_foot _ x htransition.2.1) have hA : LatticeVertexIncidentCell x jA ∈ (cert.P 0 true).cells := - (Finset.mem_sdiff.mp (cert.precursor_boundary.first_plus_child hjA)).1 + (Finset.mem_sdiff.mp (cert.precursorBoundary.first_plus_child hjA)).1 have hB : LatticeVertexIncidentCell x jB ∈ (cert.P 0 false).cells := - (Finset.mem_sdiff.mp (cert.precursor_boundary.first_minus_child hjB)).1 + (Finset.mem_sdiff.mp (cert.precursorBoundary.first_minus_child hjB)).1 have hzero (U : ProtoTile) : TileTranslation U 0 = U := InterfaceNeighborGeometry.hzeroAt680 U have hcover (j : Fin 4) : @@ -1592,14 +1593,14 @@ theorem P4250T2InterfaceNeighborCount : x ∈ FootprintVertices (cert.P i s) ∧ x ∉ BoundaryFootprintVertices (cert.P i s)) → ((∀ x ∈ D \ P, x ∈ FootprintVertices cert.O ↔ - x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((∀ + x ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ((∀ x ∈ D \ P, Nat.card {is : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2 → GaussianRealPoint x = TileCentroid T → - x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ( + x ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ( let W := D \ P - let R : Finset GaussianInt := {cert.precursor_boundary.a, cert.precursor_boundary.b} + let R : Finset GaussianInt := {cert.precursorBoundary.a, cert.precursorBoundary.b} ∀ x ∈ W, let k := Nat.card {is : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2PrecursorRootSeparation.lean b/LeanPool/ApollonianSuperharmonic/P4250T2PrecursorRootSeparation.lean index 0d1f715d2b..6fd115e15b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2PrecursorRootSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2PrecursorRootSeparation.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorStarClassification +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4339T1EmptyPrecursorRoots public import LeanPool.ApollonianSuperharmonic.P4339T1PositivePrecursorRoots public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorArcSeparation @@ -38,7 +39,7 @@ theorem P4250T2PrecursorRootSeparation e ∈ BoundaryFootprintEdges (cert.P i s) ∧ e ∈ BoundaryFootprintEdges T) : let W := D \ P - let R : Finset GaussianInt := {cert.precursor_boundary.a, cert.precursor_boundary.b} + let R : Finset GaussianInt := {cert.precursorBoundary.a, cert.precursorBoundary.b} R ⊆ W ∧ (∀ x ∈ W, x ∈ FootprintVertices cert.O ↔ x ∈ R) ∧ (∀ x ∈ R, @@ -70,8 +71,8 @@ theorem P4250T2PrecursorRootSeparation · intro x hx exact ⟨(hcount x hx).1, iff_of_true (hcount x hx).2 hO⟩ · intro x _ _ hcentral - have ha : cert.precursor_boundary.a ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + have ha : cert.precursorBoundary.a ∈ + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt) := by simp have hxa := realPoint_injective (hcentral.trans (hcount _ ha).2.symm) simpa only [hxa] using ha diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean index 3f474d8ea5..c6c7eb8a82 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean @@ -5,14 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer public import LeanPool.ApollonianSuperharmonic.TileSubodometerLiteralDecompositionPiece -public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P4261T1CentralCoordinates] diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1ContactAdjacency.lean b/LeanPool/ApollonianSuperharmonic/P4261T1ContactAdjacency.lean index f3784e1e8e..7eacaf4e87 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1ContactAdjacency.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1ContactAdjacency.lean @@ -5,17 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer public import LeanPool.ApollonianSuperharmonic.P4261T1ExteriorIndices public import LeanPool.ApollonianSuperharmonic.P3055T1ExteriorCentralIncidence -public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms -public import LeanPool.ApollonianSuperharmonic.P3055T1SignedCentroidNormalForms public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.P4387T1PlacedCoordinates -public import LeanPool.ApollonianSuperharmonic.P4387T1ParentSlopeNormalForms -- [TABLET NODE: P4261T1ContactAdjacency] diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1EdgeExterior.lean b/LeanPool/ApollonianSuperharmonic/P4261T1EdgeExterior.lean index f9e50a9f17..8facbef332 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1EdgeExterior.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1EdgeExterior.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4261T1ExteriorIndices public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.TileTranslation -- [TABLET NODE: P4261T1EdgeExterior] diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1ExteriorAdjacency.lean b/LeanPool/ApollonianSuperharmonic/P4261T1ExteriorAdjacency.lean index 95a710ea4b..e8b8c33351 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1ExteriorAdjacency.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1ExteriorAdjacency.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer public import LeanPool.ApollonianSuperharmonic.P4261T1ExteriorIndices public import LeanPool.ApollonianSuperharmonic.P3045T1RightBoundaryDisplacementAlgebra -public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms -public import LeanPool.ApollonianSuperharmonic.P3055T1SignedCentroidNormalForms public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1ExteriorIndices.lean b/LeanPool/ApollonianSuperharmonic/P4261T1ExteriorIndices.lean index 96fba73e2a..bf7c7b9c98 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1ExteriorIndices.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1ExteriorIndices.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.Finset.Card + public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex -- [TABLET NODE: P4261T1ExteriorIndices] diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1PlacedOdometer.lean b/LeanPool/ApollonianSuperharmonic/P4261T1PlacedOdometer.lean index b615f112cd..21a2691338 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1PlacedOdometer.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1PlacedOdometer.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.SixSubtileLabel public import LeanPool.ApollonianSuperharmonic.P4250T1SlopeOffset -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.TileOdometer -- [TABLET NODE: P4261T1PlacedOdometer] diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean index 22636c3af8..ab5b083758 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean @@ -5,17 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer public import LeanPool.ApollonianSuperharmonic.TileSubodometerLiteralDecompositionPiece -public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms -public import LeanPool.ApollonianSuperharmonic.P3055T1SignedCentroidNormalForms public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: P4261T1RightCoordinates] @@ -1039,7 +1036,9 @@ theorem P4261T1RightCoordinates hselectedValue rH r hdomainT hdomainSuppliedFresh hvalueSuppliedFresh have hsumA := RightCoordinateGeometry.hsumA q cfg have hsumAPoint := congrArg GaussianRealPoint hsumA - simp? [GaussianRealPoint] at hsumAPoint + simp only [GaussianRealPoint, Int.reduceNeg, Fin.isValue, GaussianInt.intCast_re, + GaussianInt.intCast_im, Zsqrtd.re_sub, Zsqrtd.re_neg, Int.cast_sub, Int.cast_neg, + Zsqrtd.im_sub, Zsqrtd.im_neg, Prod.mk.injEq] at hsumAPoint have hsumARe := RightCoordinateGeometry.hsumARe q hsumAPoint have hsumAIm := RightCoordinateGeometry.hsumAIm q hsumAPoint have hSlopePeriod := RightCoordinateGeometry.hSlopePeriod q cfg C₀ T₀ cert N T pN p0 q' i' e' diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean index e65b3a08d0..4bae6b4a9f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean @@ -5,12 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer public import LeanPool.ApollonianSuperharmonic.P4261T1ExteriorIndices public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileCanonicalRows -public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms -public import LeanPool.ApollonianSuperharmonic.P3055T1SignedCentroidNormalForms -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2AdjacentMatrixSlope.lean b/LeanPool/ApollonianSuperharmonic/P4261T2AdjacentMatrixSlope.lean index 985fcd5e2a..524c75d684 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2AdjacentMatrixSlope.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2AdjacentMatrixSlope.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean b/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean index b0be6b3bce..9a85b7d6d7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean @@ -5,15 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometer -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -- [TABLET NODE: P4261T2AncestorSymmetry] diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2DiamondBoundary.lean b/LeanPool/ApollonianSuperharmonic/P4261T2DiamondBoundary.lean index 330277489d..8d3f3b309e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2DiamondBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2DiamondBoundary.lean @@ -5,13 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction -public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.DiamondOdometerExistsUnique public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -- [TABLET NODE: P4261T2DiamondBoundary] diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2InterfacePropagation.lean b/LeanPool/ApollonianSuperharmonic/P4261T2InterfacePropagation.lean index cf22bf8350..b7e6b9d0f7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2InterfacePropagation.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2InterfacePropagation.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4261T2LiteralInterface public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import Mathlib.Data.List.Chain -- [TABLET NODE: P4261T2InterfacePropagation] diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2LiteralInterface.lean b/LeanPool/ApollonianSuperharmonic/P4261T2LiteralInterface.lean index bad80db23e..a694eaed55 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2LiteralInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2LiteralInterface.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometer public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect public import LeanPool.ApollonianSuperharmonic.FootprintEdges diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2PairNormalization.lean b/LeanPool/ApollonianSuperharmonic/P4261T2PairNormalization.lean index 088e95cbf4..e15a3824f3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2PairNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2PairNormalization.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import LeanPool.ApollonianSuperharmonic.BandCircle -- [TABLET NODE: P4261T2PairNormalization] diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2RegularEdgeReduction.lean b/LeanPool/ApollonianSuperharmonic/P4261T2RegularEdgeReduction.lean index 71ddcbc525..2c3c5e4c87 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2RegularEdgeReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2RegularEdgeReduction.lean @@ -5,17 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4261T2UnitBoundary public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.BandGenealogy public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile public import LeanPool.ApollonianSuperharmonic.P4250T1DefinedHalfIntegralSlope -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas public import LeanPool.ApollonianSuperharmonic.RegularTileFamilyTranslationUnique -- [TABLET NODE: P4261T2RegularEdgeReduction] diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean index 005b929677..07b0ddfd19 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean @@ -5,13 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification -public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton -public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import LeanPool.ApollonianSuperharmonic.TileOdometer -- [TABLET NODE: P4261T2UnitBoundary] @@ -439,8 +437,10 @@ private theorem verticalPositive : have h11 : (x + 1 + ⟨0, 1⟩) - x = 1 + ⟨0, 1⟩ := by abel have h00 : (x + ⟨0, 1⟩) - (x + ⟨0, 1⟩) = 0 := by simp have h10 : (x + 1 + ⟨0, 1⟩) - (x + ⟨0, 1⟩) = 1 := by abel - simp? [CurvatureOneOdometer, h01, h11, h10, - Zsqrtd.ext_iff] + simp only [CurvatureOneOdometer, Int.reduceNeg, Zsqrtd.ext_iff, Zsqrtd.re_add, + Zsqrtd.re_one, add_zero, Zsqrtd.im_add, Zsqrtd.im_one, zero_add, h10, zero_ne_one, + and_false, ↓reduceIte, h11, and_self, sub_self, Zsqrtd.re_zero, Zsqrtd.im_zero, h01, + and_true] have hcoefMul : x.re * β.re - x.re * α.re = x.re * z.im := by calc x.re * β.re - x.re * α.re = x.re * (β.re - α.re) := by ring @@ -605,7 +605,8 @@ private theorem hRe : classical intro C z hCz have he := congrArg (fun q : CircleCoordinates => q.2.re) hCz - simp? at he + simp only [Int.reduceNeg, Zsqrtd.re_add, Zsqrtd.re_one, Zsqrtd.re_mul, Zsqrtd.re_ofNat, + Nat.cast_ofNat, Zsqrtd.im_ofNat, mul_zero, zero_mul, add_zero] at he exact_mod_cast he private theorem hIm : @@ -618,7 +619,8 @@ private theorem hIm : classical intro C z hCz have he := congrArg (fun q : CircleCoordinates => q.2.im) hCz - simp? at he + simp only [Int.reduceNeg, Zsqrtd.im_add, Zsqrtd.im_one, Zsqrtd.im_mul, Zsqrtd.re_ofNat, + Nat.cast_ofNat, Zsqrtd.im_ofNat, zero_mul, add_zero, zero_add] at he exact_mod_cast he private theorem hmatrixUnit : diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean index 4a57b45cb5..a990478adc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean @@ -5,29 +5,16 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4261T2LiteralInterface public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryOdometerStrings public import LeanPool.ApollonianSuperharmonic.OpposingStringInterfacePath -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry -public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation -public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths public import LeanPool.ApollonianSuperharmonic.P4158T1AncestorCells public import LeanPool.ApollonianSuperharmonic.P4250T1DefinedHalfIntegralSlope -public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct -public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity -public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance -public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEndpointPairUnique +public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleRetargetMiddle -- [TABLET NODE: P4261T2UnitInterface] diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitStringTelescoping.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitStringTelescoping.lean index 4f47181b26..2c506102d4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2UnitStringTelescoping.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitStringTelescoping.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4261T2AdjacentMatrixSlope public import LeanPool.ApollonianSuperharmonic.P4250T1DefinedHalfIntegralSlope public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect diff --git a/LeanPool/ApollonianSuperharmonic/P4339T1EmptyPrecursorRoots.lean b/LeanPool/ApollonianSuperharmonic/P4339T1EmptyPrecursorRoots.lean index 98f5edfa13..736518782c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4339T1EmptyPrecursorRoots.lean +++ b/LeanPool/ApollonianSuperharmonic/P4339T1EmptyPrecursorRoots.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry -public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary -- [TABLET NODE: P4339T1EmptyPrecursorRoots] @@ -33,7 +34,7 @@ theorem P4339T1EmptyPrecursorRoots x ∉ BoundaryFootprintVertices (cert.P i s)) (hO : cert.O.cells = ∅) : let W := D \ P - let R : Finset GaussianInt := {cert.precursor_boundary.a, cert.precursor_boundary.b} + let R : Finset GaussianInt := {cert.precursorBoundary.a, cert.precursorBoundary.b} R ⊆ W ∧ (∀ x ∈ W, x ∈ FootprintVertices cert.O ↔ x ∈ R) ∧ (∀ x ∈ R, @@ -45,14 +46,14 @@ theorem P4339T1EmptyPrecursorRoots dsimp only obtain ⟨hcent, _, _, _, hQ, hS, hpair, hdisjoint⟩ := P4339T1PrecursorSupportGeometry C q cfg T cert - obtain ⟨hab, hanchor⟩ : cert.precursor_boundary.a = cert.precursor_boundary.b ∧ - cert.precursor_boundary.a = cert.O.anchor := by - rcases cert.precursor_boundary.branch with hp | ⟨_, hab, ha, _⟩ + obtain ⟨hab, hanchor⟩ : cert.precursorBoundary.a = cert.precursorBoundary.b ∧ + cert.precursorBoundary.a = cert.O.anchor := by + rcases cert.precursorBoundary.branch with hp | ⟨_, hab, ha, _⟩ · exact ((Finset.nonempty_iff_ne_empty.mp hp.1) hO).elim · exact ⟨hab, ha⟩ - let a := cert.precursor_boundary.a + let a := cert.precursorBoundary.a have hR (x : GaussianInt) : - x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + x ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt) ↔ x = a := by simp [← hab, a] have hfootO (x : GaussianInt) : x ∈ FootprintVertices cert.O ↔ x = a := by @@ -134,13 +135,13 @@ theorem P4339T1EmptyPrecursorRoots (hfootO a).mpr rfl) (LatticeVertexIncidentCell a j) hcorner simpa only [SubtileOccurrenceInterpretation, Int.cast_zero, zero_mul, zero_add, trans_zero] using hisolated - have hfirst := (cert.precursor_boundary.first_transition a).mpr rfl + have hfirst := (cert.precursorBoundary.first_transition a).mpr rfl obtain ⟨jA, hjA⟩ := boundary_incident _ a hQ hfirst.1 obtain ⟨jB, hjB⟩ := boundary_incident _ a hS hfirst.2.1 have hA : LatticeVertexIncidentCell a jA ∈ (cert.P 0 true).cells := - (Finset.mem_sdiff.mp (cert.precursor_boundary.first_plus_child hjA)).1 + (Finset.mem_sdiff.mp (cert.precursorBoundary.first_plus_child hjA)).1 have hB : LatticeVertexIncidentCell a jB ∈ (cert.P 0 false).cells := - (Finset.mem_sdiff.mp (cert.precursor_boundary.first_minus_child hjB)).1 + (Finset.mem_sdiff.mp (cert.precursorBoundary.first_minus_child hjB)).1 have hAB : Disjoint (cert.P 0 true).cells (cert.P 0 false).cells := Finset.disjoint_iff_inter_eq_empty.mpr (hpair.trans hO) have hboundaryA : a ∈ BoundaryFootprintVertices (cert.P 0 true) := diff --git a/LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean b/LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean index 7dd124e6f3..d3ee4e48f7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean +++ b/LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorStarClassification -public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary -- [TABLET NODE: P4339T1PositivePrecursorRoots] @@ -235,12 +235,12 @@ private theorem haPlus : ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (plusArc : List GaussianInt), - (plusArc.head? = some cert.precursor_boundary.a) → (cert.precursor_boundary.a ∈ + (plusArc.head? = some cert.precursorBoundary.a) → (cert.precursorBoundary.a ∈ (plusArc.toFinset : Set GaussianInt)) ) := by classical intro C q cfg T cert plusArc hplusHead have hn : plusArc ≠ [] := by intro h; simp [h] at hplusHead - have heq : plusArc.head hn = cert.precursor_boundary.a := by + have heq : plusArc.head hn = cert.precursorBoundary.a := by have hh := hplusHead rw [List.head?_eq_some_head hn] at hh exact Option.some.inj hh @@ -253,12 +253,12 @@ private theorem hbPlus : ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (plusArc : List GaussianInt), - (plusArc.getLast? = some cert.precursor_boundary.b) → (cert.precursor_boundary.b ∈ + (plusArc.getLast? = some cert.precursorBoundary.b) → (cert.precursorBoundary.b ∈ (plusArc.toFinset : Set GaussianInt)) ) := by classical intro C q cfg T cert plusArc hplusLast have hn : plusArc ≠ [] := by intro h; simp [h] at hplusLast - have heq : plusArc.getLast hn = cert.precursor_boundary.b := by + have heq : plusArc.getLast hn = cert.precursorBoundary.b := by have hh := hplusLast rw [List.getLast?_eq_getLast_of_ne_nil hn] at hh exact Option.some.inj hh @@ -271,12 +271,12 @@ private theorem hbMinus : ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (minusArc : List GaussianInt), - (minusArc.head? = some cert.precursor_boundary.b) → (cert.precursor_boundary.b ∈ + (minusArc.head? = some cert.precursorBoundary.b) → (cert.precursorBoundary.b ∈ (minusArc.toFinset : Set GaussianInt)) ) := by classical intro C q cfg T cert minusArc hminusHead have hn : minusArc ≠ [] := by intro h; simp [h] at hminusHead - have heq : minusArc.head hn = cert.precursor_boundary.b := by + have heq : minusArc.head hn = cert.precursorBoundary.b := by have hh := hminusHead rw [List.head?_eq_some_head hn] at hh exact Option.some.inj hh @@ -289,12 +289,12 @@ private theorem haMinus : ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (minusArc : List GaussianInt), - (minusArc.getLast? = some cert.precursor_boundary.a) → (cert.precursor_boundary.a ∈ + (minusArc.getLast? = some cert.precursorBoundary.a) → (cert.precursorBoundary.a ∈ (minusArc.toFinset : Set GaussianInt)) ) := by classical intro C q cfg T cert minusArc hminusLast have hn : minusArc ≠ [] := by intro h; simp [h] at hminusLast - have heq : minusArc.getLast hn = cert.precursor_boundary.a := by + have heq : minusArc.getLast hn = cert.precursorBoundary.a := by have hh := hminusLast rw [List.getLast?_eq_getLast_of_ne_nil hn] at hh exact Option.some.inj hh @@ -341,8 +341,8 @@ private theorem hR : ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt) ↔ x = - cert.precursor_boundary.a ∨ x = cert.precursor_boundary.b ) := by + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt) ↔ x = + cert.precursorBoundary.a ∨ x = cert.precursorBoundary.b ) := by classical intro C q cfg T cert x simp @@ -354,18 +354,18 @@ private theorem endpoint_boundaries : ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (plusArc : List GaussianInt), ∀ - (minusArc : List GaussianInt), (cert.precursor_boundary.a ∈ (plusArc.toFinset : Set - GaussianInt)) → ((cert.precursor_boundary.b ∈ (plusArc.toFinset : Set GaussianInt)) → - ((cert.precursor_boundary.b ∈ (minusArc.toFinset : Set GaussianInt)) → - ((cert.precursor_boundary.a ∈ (minusArc.toFinset : Set GaussianInt)) → ((∀ (x : + (minusArc : List GaussianInt), (cert.precursorBoundary.a ∈ (plusArc.toFinset : Set + GaussianInt)) → ((cert.precursorBoundary.b ∈ (plusArc.toFinset : Set GaussianInt)) → + ((cert.precursorBoundary.b ∈ (minusArc.toFinset : Set GaussianInt)) → + ((cert.precursorBoundary.a ∈ (minusArc.toFinset : Set GaussianInt)) → ((∀ (x : GaussianInt), (x ∈ (plusArc.toFinset : Set GaussianInt)) → (x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∧ x ∈ BoundaryFootprintVertices cert.O)) → ((∀ (x : GaussianInt), (x ∈ (minusArc.toFinset : Set GaussianInt)) → (x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 false) cert.O) ∧ x ∈ BoundaryFootprintVertices cert.O)) → ((∀ (x : GaussianInt), x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt) ↔ x = - cert.precursor_boundary.a ∨ x = cert.precursor_boundary.b) → (∀ (x : GaussianInt), (x - ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (x + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt) ↔ x = + cert.precursorBoundary.a ∨ x = cert.precursorBoundary.b) → (∀ (x : GaussianInt), (x + ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∧ x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 false) cert.O) ∧ x ∈ BoundaryFootprintVertices cert.O)))))))) ) := by @@ -391,13 +391,13 @@ private theorem hboundaryA : BoundaryFootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells))) → ((∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → (x ∈ FootprintVertices U))) → ((∀ (x : GaussianInt), - (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → + (x ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∧ x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 false) cert.O) ∧ x ∈ BoundaryFootprintVertices cert.O)) → (((TileCellComplement (cert.P 0 true) cert.O).cells.Nonempty) → (((TileCellComplement (cert.P 0 false) - cert.O).cells.Nonempty) → (∀ (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, - cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices + cert.O).cells.Nonempty) → (∀ (x : GaussianInt), (x ∈ ({cert.precursorBoundary.a, + cert.precursorBoundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices (cert.P 0 true)))))))))) ) := by classical intro C q cfg T cert hO hpair raw_incident boundary_incident boundary_footprint @@ -428,13 +428,13 @@ private theorem hboundaryB : true).cells ∩ (cert.P (0 : Fin (3 : ℕ)) false).cells = cert.O.cells) → ((∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells))) → ((∀ (x : - GaussianInt), (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + GaussianInt), (x ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∧ x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 false) cert.O) ∧ x ∈ BoundaryFootprintVertices cert.O)) → (((TileCellComplement (cert.P 0 true) cert.O).cells.Nonempty) → (((TileCellComplement (cert.P 0 false) - cert.O).cells.Nonempty) → (∀ (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, - cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices + cert.O).cells.Nonempty) → (∀ (x : GaussianInt), (x ∈ ({cert.precursorBoundary.a, + cert.precursorBoundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices (cert.P 0 false))))))) ) := by classical intro C q cfg T cert hpair boundary_incident endpoint_boundaries hcompA_nonempty @@ -466,11 +466,11 @@ private theorem other_absent : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ LatticeVertexIncidentCell x j ∈ (cert.P 0 false).cells)) → ((∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → (x ∈ - FootprintVertices U))) → ((∀ (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, - cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices + FootprintVertices U))) → ((∀ (x : GaussianInt), (x ∈ ({cert.precursorBoundary.a, + cert.precursorBoundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∧ x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 false) cert.O) ∧ x ∈ BoundaryFootprintVertices cert.O)) - → (∀ (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} + → (∀ (x : GaussianInt), (x ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (∀ (i : Fin 3), ∀ (s : Bool), (i ≠ 0) → (∀ (j : Fin 4), LatticeVertexIncidentCell x j ∉ (cert.P i s).cells))))))) ) := by classical @@ -493,14 +493,14 @@ private theorem hboundary : BandOrderedGeneralLayoutCertificate q cfg C T), (∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells))) → ((∀ (x : GaussianInt), (x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices (cert.P 0 true))) → ((∀ (x : GaussianInt), (x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices (cert.P 0 false))) → ((∀ (x : GaussianInt), (x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (∀ + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (∀ (i : Fin 3), ∀ (s : Bool), (i ≠ 0) → (∀ (j : Fin 4), LatticeVertexIncidentCell x j ∉ - (cert.P i s).cells))) → (∀ (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, - cert.precursor_boundary.b} : Finset GaussianInt)) → (∀ (i : Fin 3), ∀ (s : Bool), x ∈ + (cert.P i s).cells))) → (∀ (x : GaussianInt), (x ∈ ({cert.precursorBoundary.a, + cert.precursorBoundary.b} : Finset GaussianInt)) → (∀ (i : Fin 3), ∀ (s : Bool), x ∈ BoundaryFootprintVertices (cert.P i s) ↔ i = 0))))) ) := by classical intro C q cfg T cert boundary_incident hboundaryA hboundaryB other_absent x hxR i s @@ -524,11 +524,11 @@ private theorem endpoint_inD : (Finset.Nonempty cert.O.cells) → ((∀ (x : GaussianInt), (x ∈ FootprintVertices cert.O) → (x ∈ D)) → ((∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → (x ∈ FootprintVertices U))) → ((∀ (x : - GaussianInt), (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + GaussianInt), (x ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∧ x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 false) cert.O) ∧ x ∈ BoundaryFootprintVertices cert.O)) → (∀ (x : GaussianInt), (x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (x ∈ D))))) ) := by classical intro C q cfg T cert D hO inD boundary_footprint endpoint_boundaries x hxR @@ -545,12 +545,12 @@ private theorem endpoint_notP : Bool), x ∈ FootprintVertices (cert.P i s) ∧ x ∉ BoundaryFootprintVertices (cert.P i s)) → ((∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ FootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells))) → ((∀ - (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + (x : GaussianInt), (x ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (∀ (i : Fin 3), ∀ (s : Bool), (i ≠ 0) → (∀ (j : Fin 4), LatticeVertexIncidentCell x j ∉ (cert.P i s).cells))) → ((∀ (x : GaussianInt), (x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (∀ + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (∀ (i : Fin 3), ∀ (s : Bool), x ∈ BoundaryFootprintVertices (cert.P i s) ↔ i = 0)) → (∀ - (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + (x : GaussianInt), (x ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (x ∉ P))))) ) := by classical intro C q cfg T cert D P hP raw_incident other_absent hboundary x hxR hp @@ -568,10 +568,10 @@ private theorem hRsubset : ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : - Finset GaussianInt), (∀ (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, - cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ D)) → ((∀ (x : GaussianInt), - (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → - (x ∉ P)) → (({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + Finset GaussianInt), (∀ (x : GaussianInt), (x ∈ ({cert.precursorBoundary.a, + cert.precursorBoundary.b} : Finset GaussianInt)) → (x ∈ D)) → ((∀ (x : GaussianInt), + (x ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → + (x ∉ P)) → (({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt) ⊆ D \ P)) ) := by classical intro C q cfg T cert D P endpoint_inD endpoint_notP x hx @@ -603,14 +603,14 @@ private theorem hWfoot : cert.O) ∩ BoundaryFootprintVertices cert.O) → ((BoundaryFootprintVertices cert.O = (↑plusArc.toFinset : Set GaussianInt) ∪ (↑minusArc.toFinset : Set GaussianInt)) → (((↑plusArc.toFinset : Set GaussianInt) ∩ (↑minusArc.toFinset : Set GaussianInt) = - {cert.precursor_boundary.a, cert.precursor_boundary.b}) → ((∀ (x : GaussianInt), x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt) ↔ x = - cert.precursor_boundary.a ∨ x = cert.precursor_boundary.b) → ((∀ (x : GaussianInt), - (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → + {cert.precursorBoundary.a, cert.precursorBoundary.b}) → ((∀ (x : GaussianInt), x ∈ + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt) ↔ x = + cert.precursorBoundary.a ∨ x = cert.precursorBoundary.b) → ((∀ (x : GaussianInt), + (x ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 true) cert.O) ∧ x ∈ BoundaryFootprintVertices (TileCellComplement (cert.P 0 false) cert.O) ∧ x ∈ BoundaryFootprintVertices cert.O)) → (∀ x ∈ D \ P, x ∈ FootprintVertices cert.O ↔ x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt))))))))))))))) ) := by classical intro C q cfg T cert D P hP hO raw_incident full_nonboundary hallAB hOA hOB boundary_footprint @@ -640,10 +640,10 @@ private theorem hWfoot : exact hxOB rcases hxArcs with hxplus | hxminus · by_cases hxR : x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt) + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt) · exact hxR - · have hxnotA : x ≠ cert.precursor_boundary.a ∧ - x ≠ cert.precursor_boundary.b := by + · have hxnotA : x ≠ cert.precursorBoundary.a ∧ + x ≠ cert.precursorBoundary.b := by simpa [hR] using hxR have noBcomp (j : Fin 4) : LatticeVertexIncidentCell x j ∉ @@ -686,10 +686,10 @@ private theorem hWfoot : have hAnotb := full_nonboundary (cert.P 0 true) x hallA exact (hxnotP ((hP x).mpr ⟨hxD, 0, true, hAfoot, hAnotb⟩)).elim · by_cases hxR : x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt) + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt) · exact hxR - · have hxnotA : x ≠ cert.precursor_boundary.a ∧ - x ≠ cert.precursor_boundary.b := by + · have hxnotA : x ≠ cert.precursorBoundary.a ∧ + x ≠ cert.precursorBoundary.b := by simpa [hR] using hxR have noAcomp (j : Fin 4) : LatticeVertexIncidentCell x j ∉ @@ -741,9 +741,9 @@ private theorem hcount : ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), (∀ (x : GaussianInt), (x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (∀ + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (∀ (i : Fin 3), ∀ (s : Bool), x ∈ BoundaryFootprintVertices (cert.P i s) ↔ i = 0)) → (∀ - (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + (x : GaussianInt), (x ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (Nat.card {is : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2)) ) := by classical @@ -772,11 +772,11 @@ private theorem hnoncentral : GaussianInt), (∀ (x : GaussianInt), x ∈ D ↔ x ∈ FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T) → ((Finset.Nonempty cert.O.cells) → ((cert.O.cells = ∅ ↔ (cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → ((∀ (x : GaussianInt), (x ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → (x ∈ - D)) → ((∀ (x : GaussianInt), (x ∈ ({cert.precursor_boundary.a, - cert.precursor_boundary.b} : Finset GaussianInt)) → (Nat.card + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (x ∈ + D)) → ((∀ (x : GaussianInt), (x ∈ ({cert.precursorBoundary.a, + cert.precursorBoundary.b} : Finset GaussianInt)) → (Nat.card {is : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2)) → (∀ (x - : GaussianInt), (x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + : GaussianInt), (x ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → (GaussianRealPoint x ≠ TileCentroid T))))))) ) := by classical intro C q cfg T cert hlat D hD hO hzero endpoint_inD hcount x hxR @@ -802,7 +802,7 @@ theorem P4339T1PositivePrecursorRoots x ∉ BoundaryFootprintVertices (cert.P i s)) (hO : cert.O.cells.Nonempty) : let W := D \ P - let R : Finset GaussianInt := {cert.precursor_boundary.a, cert.precursor_boundary.b} + let R : Finset GaussianInt := {cert.precursorBoundary.a, cert.precursorBoundary.b} R ⊆ W ∧ (∀ x ∈ W, x ∈ FootprintVertices cert.O ↔ x ∈ R) ∧ (∀ x ∈ R, @@ -828,7 +828,7 @@ theorem P4339T1PositivePrecursorRoots have hOB := PositivePrecursorGeometry.hOB C q cfg T cert have boundary_footprint := PositivePrecursorGeometry.boundary_footprint boundary_incident (PositivePrecursorGeometry.incident_footprint) - have hbranch := cert.precursor_boundary.branch + have hbranch := cert.precursorBoundary.branch rcases hbranch with ⟨_, plusArc, minusArc, _, _, hplusHead, hplusLast, hminusHead, hminusLast, hplusSet, hminusSet, _, _, hunion, hinter, _, _⟩ | hdeg · have haPlus := PositivePrecursorGeometry.haPlus C q cfg T cert plusArc hplusHead diff --git a/LeanPool/ApollonianSuperharmonic/P4339T1PrecursorArcSeparation.lean b/LeanPool/ApollonianSuperharmonic/P4339T1PrecursorArcSeparation.lean index f64217b719..fc7c73ee45 100644 --- a/LeanPool/ApollonianSuperharmonic/P4339T1PrecursorArcSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/P4339T1PrecursorArcSeparation.lean @@ -5,9 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry -public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell -public import LeanPool.ApollonianSuperharmonic.TopologicalDiskGridRayCrossingIndexZero +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4366T1RemainderOuterAttachments public import LeanPool.ApollonianSuperharmonic.P4366T1PrecursorPathLoop public import LeanPool.ApollonianSuperharmonic.P4366T1AttachedRemainderIndexZero @@ -36,10 +35,10 @@ theorem P4339T1PrecursorArcSeparation : e ∈ BoundaryFootprintEdges (cert.P i s) ∧ e ∈ BoundaryFootprintEdges T) → ((cert.O.cells.Nonempty) → ((∀ x ∈ D \ P, x ∈ FootprintVertices cert.O ↔ - x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + x ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ( let W := D \ P - let R : Finset GaussianInt := {cert.precursor_boundary.a, cert.precursor_boundary.b} + let R : Finset GaussianInt := {cert.precursorBoundary.a, cert.precursorBoundary.b} ∀ a ∈ R, ∀ b ∈ R, ∀ V, ∀ E, SimpleGridPathBetween V E a b → V ⊆ (W : Set GaussianInt) → a = b))))))) := by intro C q cfg T cert hT hlat D P hD hP hattach hO hroots diff --git a/LeanPool/ApollonianSuperharmonic/P4339T1PrecursorSupportGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4339T1PrecursorSupportGeometry.lean index 3c3529afb6..291a6450e4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4339T1PrecursorSupportGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4339T1PrecursorSupportGeometry.lean @@ -5,12 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction public import LeanPool.ApollonianSuperharmonic.CurvatureOneTileBase -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -- [TABLET NODE: P4339T1PrecursorSupportGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P4366T1AttachedRemainderIndexZero.lean b/LeanPool/ApollonianSuperharmonic/P4366T1AttachedRemainderIndexZero.lean index 6bc945dd84..285cabcb67 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T1AttachedRemainderIndexZero.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T1AttachedRemainderIndexZero.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -- [TABLET NODE: P4366T1AttachedRemainderIndexZero] diff --git a/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean index 856fec378f..37d1762358 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean @@ -5,12 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4366T1PrecursorRemainderFamily public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween -public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary public import LeanPool.ApollonianSuperharmonic.P4397T1PathAvoidsPrecursorEdges public import LeanPool.ApollonianSuperharmonic.P4397T1SimplePathSplicing @@ -267,12 +267,12 @@ private theorem ordered : ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (a : GaussianInt), ∀ (b : - GaussianInt), (a ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + GaussianInt), (a ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ((b ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((a + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ((a ≠ b) → ((a = - cert.precursor_boundary.a ∧ b = cert.precursor_boundary.b) ∨ (a = - cert.precursor_boundary.b ∧ b = cert.precursor_boundary.a)))) ) := by + cert.precursorBoundary.a ∧ b = cert.precursorBoundary.b) ∨ (a = + cert.precursorBoundary.b ∧ b = cert.precursorBoundary.a)))) ) := by classical intro C q cfg T cert a b ha hb hab simp only [Finset.mem_insert, Finset.mem_singleton] at ha hb @@ -289,16 +289,16 @@ private theorem hreflectab : ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (a : GaussianInt), ∀ (b : - GaussianInt), (a ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + GaussianInt), (a ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ((b ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((a + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ((a ≠ b) → (∀ (g : List GaussianInt), (g.head? = some a) → ((g.getLast? = some b) → (((a = - cert.precursor_boundary.a ∧ b = cert.precursor_boundary.b) ∨ (a = - cert.precursor_boundary.b ∧ b = cert.precursor_boundary.a)) → ((GaussianRealPoint - cert.precursor_boundary.b = ((2 : ℝ) * (TileCentroid cert.O).1 - (GaussianRealPoint - cert.precursor_boundary.a).1, (2 : ℝ) * (TileCentroid cert.O).2 - (GaussianRealPoint - cert.precursor_boundary.a).2)) → (GaussianRealPoint b = (2 * (TileCentroid cert.O).1 + cert.precursorBoundary.a ∧ b = cert.precursorBoundary.b) ∨ (a = + cert.precursorBoundary.b ∧ b = cert.precursorBoundary.a)) → ((GaussianRealPoint + cert.precursorBoundary.b = ((2 : ℝ) * (TileCentroid cert.O).1 - (GaussianRealPoint + cert.precursorBoundary.a).1, (2 : ℝ) * (TileCentroid cert.O).2 - (GaussianRealPoint + cert.precursorBoundary.a).2)) → (GaussianRealPoint b = (2 * (TileCentroid cert.O).1 - (GaussianRealPoint a).1, 2 * (TileCentroid cert.O).2 - (GaussianRealPoint a).2)))))))) ) := by classical @@ -320,16 +320,16 @@ private theorem roots_ab : ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (a : GaussianInt), ∀ (b : - GaussianInt), (a ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset + GaussianInt), (a ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ((b ∈ - ({cert.precursor_boundary.a, cert.precursor_boundary.b} : Finset GaussianInt)) → ((a + ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ((a ≠ b) → (∀ (g : List GaussianInt), (g.head? = some a) → ((g.getLast? = some b) → (((a = - cert.precursor_boundary.a ∧ b = cert.precursor_boundary.b) ∨ (a = - cert.precursor_boundary.b ∧ b = cert.precursor_boundary.a)) → ((GaussianRealPoint b = + cert.precursorBoundary.a ∧ b = cert.precursorBoundary.b) ∨ (a = + cert.precursorBoundary.b ∧ b = cert.precursorBoundary.a)) → ((GaussianRealPoint b = (2 * (TileCentroid cert.O).1 - (GaussianRealPoint a).1, 2 * (TileCentroid cert.O).2 - - (GaussianRealPoint a).2)) → (∀ (z : GaussianInt), (z ∈ ({cert.precursor_boundary.a, - cert.precursor_boundary.b} : + (GaussianRealPoint a).2)) → (∀ (z : GaussianInt), (z ∈ ({cert.precursorBoundary.a, + cert.precursorBoundary.b} : Finset GaussianInt)) → (z = a ∨ z = b)))))))) ) := by classical intro C q cfg T cert a b ha hb hab g hga hgb ordered hreflectab z hz @@ -615,12 +615,12 @@ theorem P4366T1PrecursorPathLoop (hOband : BandPrototile (cfg.firstPredecessor 1) cert.O) (hroots : ∀ x ∈ D \ P, x ∈ FootprintVertices cert.O ↔ - x ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + x ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) (a b : GaussianInt) - (ha : a ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + (ha : a ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) - (hb : b ∈ ({cert.precursor_boundary.a, cert.precursor_boundary.b} : + (hb : b ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) (hab : a ≠ b) (V : Set GaussianInt) (E : Set (Finset GaussianInt)) (hpath : SimpleGridPathBetween V E a b) @@ -684,7 +684,7 @@ theorem P4366T1PrecursorPathLoop obtain ⟨plusArc, minusArc, hpn, hmn, hph, hpl, hmh, hml, hpf, hmf, hpe, hme, _, _, hreflect, _⟩ := (show ∃ plusArc minusArc : List GaussianInt, _ from by - rcases cert.precursor_boundary.branch with hp | hn + rcases cert.precursorBoundary.branch with hp | hn · exact hp.2 · exact ((Finset.nonempty_iff_ne_empty.mp hO) hn.1).elim) have hreflectab := PrecursorLoopGeometry.hreflectab C q cfg T cert a b ha hb hab g hga hgb diff --git a/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorRemainderFamily.lean b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorRemainderFamily.lean index be1f49f832..6a65ce2835 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorRemainderFamily.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorRemainderFamily.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.TileCellComplement -- [TABLET NODE: P4366T1PrecursorRemainderFamily] diff --git a/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean b/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean index d00750d341..60bca055e2 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry public import LeanPool.ApollonianSuperharmonic.P4366T1PrecursorRemainderFamily diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean index 8b21b7dd68..f056f37268 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean @@ -5,17 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometer public import LeanPool.ApollonianSuperharmonic.P5635T1EndpointDiagonalOwnership public import LeanPool.ApollonianSuperharmonic.AffineTriangularNoFourfoldCellOwners -public import LeanPool.ApollonianSuperharmonic.BandGenealogy public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleLatticeTouching -public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity -public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors public import LeanPool.ApollonianSuperharmonic.P4158T1AncestorCells -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge public import LeanPool.ApollonianSuperharmonic.TileString public import LeanPool.ApollonianSuperharmonic.P4431T1OwnerTransitionSelector diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean index ab734187d7..ae85fb7a01 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean @@ -5,23 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMixedAggregatePatches -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification -public import LeanPool.ApollonianSuperharmonic.BandGenealogy public import LeanPool.ApollonianSuperharmonic.BoundaryString public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleRetargetMiddle public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEndpointPairUnique -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing -- [TABLET NODE: P4366T2OuterGeometry] @@ -265,7 +256,9 @@ private theorem hsumCent : have hminy := congrArg Prod.snd hmin have hplx := congrArg Prod.fst hpl have hply := congrArg Prod.snd hpl - simp? [GaussianRealPoint] at hminx hminy hplx hply + simp only [Prod.fst_sub, one_div, GaussianRealPoint, Int.reduceNeg, Fin.isValue, + GaussianInt.intCast_re, GaussianInt.intCast_im, Prod.mk_sub_mk, Prod.smul_mk, + smul_eq_mul, Prod.snd_sub, Prod.mk_add_mk] at hminx hminy hplx hply apply Prod.ext · simp only [Prod.fst_add] simp only [GaussianRealPoint] @@ -320,7 +313,9 @@ private theorem hFrootCent : have hcy := congrArg Prod.snd hcentroid have hux := congrArg Prod.fst huCenter have huy := congrArg Prod.snd huCenter - simp? [GaussianRealPoint] at hcx hcy hux huy + simp only [Prod.fst_sub, GaussianRealPoint, Int.reduceNeg, Fin.isValue, + GaussianInt.intCast_re, GaussianInt.intCast_im, Prod.snd_sub, Prod.fst_add, + Prod.smul_fst, smul_eq_mul, Prod.snd_add, Prod.smul_snd] at hcx hcy hux huy apply Prod.ext · change -(TileCentroid T0).1 + (centerShift.re : Real) = (TileCentroid T0').1 @@ -359,7 +354,9 @@ private theorem hFroot'Cent : have hcy := congrArg Prod.snd hcentroid have hux := congrArg Prod.fst huCenter have huy := congrArg Prod.snd huCenter - simp? [GaussianRealPoint] at hcx hcy hux huy + simp only [Prod.fst_sub, GaussianRealPoint, Int.reduceNeg, Fin.isValue, + GaussianInt.intCast_re, GaussianInt.intCast_im, Prod.snd_sub, Prod.fst_add, + Prod.smul_fst, smul_eq_mul, Prod.snd_add, Prod.smul_snd] at hcx hcy hux huy apply Prod.ext · change -(TileCentroid T0').1 + (centerShift.re : Real) = (TileCentroid T0).1 rw [GaussianInt.intCast_re centerShift] at ⊢ diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2WalkExhaustion.lean b/LeanPool/ApollonianSuperharmonic/P4366T2WalkExhaustion.lean index c4371a2b7b..4b5e047106 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2WalkExhaustion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2WalkExhaustion.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3161T2PathExhaustion -- [TABLET NODE: P4366T2WalkExhaustion] diff --git a/LeanPool/ApollonianSuperharmonic/P4387T1ParentSlopeNormalForms.lean b/LeanPool/ApollonianSuperharmonic/P4387T1ParentSlopeNormalForms.lean index 65b447e6d4..37225a2661 100644 --- a/LeanPool/ApollonianSuperharmonic/P4387T1ParentSlopeNormalForms.lean +++ b/LeanPool/ApollonianSuperharmonic/P4387T1ParentSlopeNormalForms.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws diff --git a/LeanPool/ApollonianSuperharmonic/P4387T1PlacedCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4387T1PlacedCoordinates.lean index 1965c1378c..9e972abf2e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4387T1PlacedCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4387T1PlacedCoordinates.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer public import LeanPool.ApollonianSuperharmonic.P3055T1SignedCentroidNormalForms public import LeanPool.ApollonianSuperharmonic.P4387T1ParentSlopeNormalForms @@ -66,7 +68,10 @@ theorem P4387T1PlacedCoordinates · have hs := pa.slope_offset cases hl : a.label <;> simp only [hl] at hs ⊢ all_goals - simp? [af.1, af.2.2.2.2.1, af.2.2.2.2.2.1] at hs + simp only [Bool.false_eq_true, ↓reduceIte, Fin.isValue, Fin.reduceAdd, + Fin.succ_one_eq_two, Fin.succ_zero_eq_one, neg_smul, one_smul, af.2.2.2.2.1, + Int.reduceNeg, neg_mul, sub_neg_eq_add, af.2.2.2.2.2.1, Fin.reduceSucc, af.1, + zero_add] at hs have h₁ := congrArg Prod.fst hs have h₂ := congrArg Prod.snd hs apply Prod.ext diff --git a/LeanPool/ApollonianSuperharmonic/P4397T1PathAvoidsPrecursorEdges.lean b/LeanPool/ApollonianSuperharmonic/P4397T1PathAvoidsPrecursorEdges.lean index 92b919e979..a624321fa3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4397T1PathAvoidsPrecursorEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4397T1PathAvoidsPrecursorEdges.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4397T1ReflectedEdgeNotBoundary -- [TABLET NODE: P4397T1PathAvoidsPrecursorEdges] diff --git a/LeanPool/ApollonianSuperharmonic/P4397T1ReflectedEdgeNotBoundary.lean b/LeanPool/ApollonianSuperharmonic/P4397T1ReflectedEdgeNotBoundary.lean index 03b67d9f74..ac29da3203 100644 --- a/LeanPool/ApollonianSuperharmonic/P4397T1ReflectedEdgeNotBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P4397T1ReflectedEdgeNotBoundary.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt -public import Mathlib.Tactic.Linarith -- [TABLET NODE: P4397T1ReflectedEdgeNotBoundary] diff --git a/LeanPool/ApollonianSuperharmonic/P4397T1SimplePathSplicing.lean b/LeanPool/ApollonianSuperharmonic/P4397T1SimplePathSplicing.lean index f922fd574d..ba8f34bd78 100644 --- a/LeanPool/ApollonianSuperharmonic/P4397T1SimplePathSplicing.lean +++ b/LeanPool/ApollonianSuperharmonic/P4397T1SimplePathSplicing.lean @@ -5,8 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble -public import Mathlib.Data.List.Zip +public import Mathlib.Init +public import Mathlib.Data.List.Nodup +public import Mathlib.Data.List.Pairwise + -- [TABLET NODE: P4397T1SimplePathSplicing] diff --git a/LeanPool/ApollonianSuperharmonic/P4397T1UnitEdgeCells.lean b/LeanPool/ApollonianSuperharmonic/P4397T1UnitEdgeCells.lean index 8fcdc91d39..4f9931ce8f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4397T1UnitEdgeCells.lean +++ b/LeanPool/ApollonianSuperharmonic/P4397T1UnitEdgeCells.lean @@ -5,6 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Basic +public import Mathlib.Basic.Real.Basic +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring +public import Mathlib.Topology.Order.Basic + public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3EndpointOwnerIndices.lean b/LeanPool/ApollonianSuperharmonic/P4418T3EndpointOwnerIndices.lean index 79a60fbd0b..9686f96b02 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3EndpointOwnerIndices.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3EndpointOwnerIndices.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow -- [TABLET NODE: P4418T3EndpointOwnerIndices] diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean b/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean index 0bce04e66b..0ab92ea40b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4418T3EndpointOwnerIndices public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceData public import LeanPool.ApollonianSuperharmonic.P3996T1SRowAlignment @@ -72,12 +74,12 @@ private theorem hpath : intro q cfg C T cert a b z E occ V W hindices cases hchild : z.childIsExterior · have hi := hindices - simp? [hchild] at hi + simp only [hchild, Bool.false_eq_true, ↓reduceIte] at hi rcases hi with ⟨hc, hp⟩ simpa [V, W, occ, SubtileOccurrenceInterpretation, hc, hp, Set.inter_comm] using E.pathCA · have hi := hindices - simp? [hchild] at hi + simp only [hchild, ↓reduceIte] at hi rcases hi with ⟨hc, hp⟩ simpa [V, W, occ, SubtileOccurrenceInterpretation, hc, hp, Set.inter_comm] using E.pathCA @@ -114,11 +116,11 @@ private theorem hdataEndpoints : (FootprintEdges (occ a) ∩ FootprintEdges (occ b)) E.point E.otherCA := by cases hchild : z.childIsExterior · have hi := hindices - simp? [hchild] at hi + simp only [hchild, Bool.false_eq_true, ↓reduceIte] at hi rcases hi with ⟨hc, hp⟩ simpa [V, W, occ, hc, hp, Set.inter_comm] using hpath · have hi := hindices - simp? [hchild] at hi + simp only [hchild, ↓reduceIte] at hi rcases hi with ⟨hc, hp⟩ simpa [V, W, occ, hc, hp, Set.inter_comm] using hpath have hp := SimpleGridPathEndpointPairUnique data.path hpath' @@ -347,7 +349,8 @@ private theorem holdShift : classical intro q cfg C T cert a b row data z hz E hsub occ V W K hindices hpath hdataEndpoints hpointPair hKDisjoint hLV hLW hLK oldCoords - cases row <;> simp? [P3996T1SRowTable] at hz + cases row <;> simp only [P3996T1SRowTable, Fin.isValue, Int.reduceNeg, Option.some.injEq, + reduceCtorEq] at hz all_goals cases hz all_goals simp [oldCoords, nestedOldCoordinates] all_goals ring @@ -389,7 +392,8 @@ private theorem hchildBlockNe : classical intro q cfg C T cert a b row data z hz E hsub occ V W K hindices hpath hdataEndpoints hpointPair hKDisjoint hLV hLW hLK oldCoords holdShift - cases row <;> simp? [P3996T1SRowTable] at hz + cases row <;> simp only [P3996T1SRowTable, Fin.isValue, Int.reduceNeg, Option.some.injEq, + reduceCtorEq] at hz all_goals cases hz simp [oldCoords, nestedOldCoordinates] @@ -432,7 +436,8 @@ private theorem hparentBlockNe : classical intro q cfg C T cert a b row data z hz E hsub occ V W K hindices hpath hdataEndpoints hpointPair hKDisjoint hLV hLW hLK oldCoords holdShift hchildBlockNe - cases row <;> simp? [P3996T1SRowTable] at hz + cases row <;> simp only [P3996T1SRowTable, Fin.isValue, Int.reduceNeg, Option.some.injEq, + reduceCtorEq] at hz all_goals cases hz simp [oldCoords, nestedOldCoordinates] @@ -479,7 +484,8 @@ private theorem hwrongBlockNe : intro q cfg C T cert a b row data z hz E hsub occ V W K hindices hpath hdataEndpoints hpointPair hKDisjoint hLV hLW hLK oldCoords holdShift hchildBlockNe hparentBlockNe owners wrongOwner - cases row <;> simp? [P3996T1SRowTable] at hz + cases row <;> simp only [P3996T1SRowTable, Fin.isValue, Int.reduceNeg, Option.some.injEq, + reduceCtorEq] at hz all_goals cases hz simp [wrongOwner, owners, oldCoords, @@ -696,7 +702,7 @@ private theorem hNoWrong : hLV hLK hLW hET hpointE obtain ⟨j, hjK⟩ := hsectorE.2.2.1 have hjData := hsectorData.1 j - simp? [hslot] at heq + simp only [hslot, Fin.isValue, ↓reduceIte] at heq rw [← heq] at hjData rcases hjData with hjV | hjW | hjG · exact (Finset.disjoint_left.mp hKV) hjK hjV @@ -712,7 +718,7 @@ private theorem hNoWrong : hLV hLK hLW hET hpointE obtain ⟨j, hjK⟩ := hsectorE.2.2.1 have hjData := hsectorData.1 j - simp? [hslot] at heq + simp only [Fin.isValue, hslot, ↓reduceIte] at heq rw [← heq] at hjData rcases hjData with hjV | hjW | hjG · exact (Finset.disjoint_left.mp hKV) hjK hjV @@ -803,12 +809,12 @@ theorem P4418T3NestedCompanionEndpoint hKV hKW hKGwrong hTVW hTVW' hcommon₀ hcommon₁ hET by_cases hslot : z.parentSlot = 0 · have hn := hNoWrong - simp? [hslot] at hn + simp only [hslot, Fin.isValue, ↓reduceIte, ne_eq] at hn rcases hpointPair with hp | hp · simpa [hslot] using hp · exact False.elim (hn hp) · have hn := hNoWrong - simp? [hslot] at hn + simp only [Fin.isValue, hslot, ↓reduceIte, ne_eq] at hn rcases hpointPair with hp | hp · exact False.elim (hn hp) · simpa [hslot] using hp diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionGeometry.lean index b824dd20b5..dbe42a6a1f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionGeometry.lean @@ -5,12 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3996T1SRowAlignment public import LeanPool.ApollonianSuperharmonic.P3996T1AdjacentParentPlacement public import LeanPool.ApollonianSuperharmonic.P3996T1CenteredQuarterTurnInclusion public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentRightEndpoint -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.TileT2QuarterTurn -- [TABLET NODE: P4418T3NestedCompanionGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean b/LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean index 152c46ff06..0e35abf9f4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean @@ -5,17 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle public import LeanPool.ApollonianSuperharmonic.P3996T1SRowTable -public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms public import LeanPool.ApollonianSuperharmonic.P3055T1SignedCentroidNormalForms -public import LeanPool.ApollonianSuperharmonic.P3045T1RightBoundaryDisplacementAlgebra -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing -- [TABLET NODE: P4418T3OuterCompanionAlignment] diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean b/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean index ed67fea3bd..8aea239598 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean @@ -5,14 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4418T3OuterCompanionAlignment -public import LeanPool.ApollonianSuperharmonic.P4261T1ContactAdjacency -public import LeanPool.ApollonianSuperharmonic.P4261T1CentralCoordinates public import LeanPool.ApollonianSuperharmonic.P4387T1ParentSlopeNormalForms -public import LeanPool.ApollonianSuperharmonic.P4387T1PlacedCoordinates public import LeanPool.ApollonianSuperharmonic.P3996T1SRowAlignment -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.TileSubodometer -- [TABLET NODE: P4418T3PresentedRowAdjacency] diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean b/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean index 7b46bca623..40527621b4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4418T3EndpointOwnerIndices public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceData public import LeanPool.ApollonianSuperharmonic.P3996T1SRowTable @@ -13,8 +15,6 @@ public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors public import LeanPool.ApollonianSuperharmonic.OppositeRoutedCommonEdgeOutsideCellUnique public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -- [TABLET NODE: P4418T3RoutedBlockCriterion] diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceData.lean b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceData.lean index 8fcf4cbf7f..d42c3088c1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceData.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceData.lean @@ -5,9 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices -- [TABLET NODE: P4418T3SelectedInterfaceData] diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean index 5a6669f1c1..191cecba4d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean @@ -5,17 +5,17 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4418T3EndpointOwnerIndices public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceData -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths -public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations +public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance -- [TABLET NODE: P4418T3SelectedInterfaceExists] @@ -630,10 +630,10 @@ private theorem faceVertex : ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (f : PeriodicSubtileFaceIndex), ∀ (i : Fin 3), cert.modified.plane.faceVertex - (cert.modified_face_equiv.symm f) i = SixSubtileFaceVertices f i ) := by + (cert.modifiedFaceEquivalence.symm f) i = SixSubtileFaceVertices f i ) := by classical intro q cfg C T cert f i - simpa using cert.modified_face_vertices (cert.modified_face_equiv.symm f) i + simpa using cert.modified_face_vertices (cert.modifiedFaceEquivalence.symm f) i private theorem faceDistinct : (by @@ -657,12 +657,12 @@ private theorem faceDistinct : (SubtileOccurrenceInterpretation P u v b))) → ( let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modified_face_equiv.symm face0 - let F1 := cert.modified_face_equiv.symm face1 + let F0 := cert.modifiedFaceEquivalence.symm face0 + let F1 := cert.modifiedFaceEquivalence.symm face1 F0 ≠ F1) ) := by classical intro q cfg C T cert a b row P O u v retargeted face0 face1 F0 F1 h - have hf := congrArg cert.modified_face_equiv h + have hf := congrArg cert.modifiedFaceEquivalence h cases row <;> simp [F0, F1, face0, face1, selectedFirstFace, selectedSecondFace] at hf private theorem faceTable : @@ -688,10 +688,10 @@ private theorem faceTable : let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modified_face_equiv.symm face0 - let F1 := cert.modified_face_equiv.symm face1 + let F0 := cert.modifiedFaceEquivalence.symm face0 + let F1 := cert.modifiedFaceEquivalence.symm face1 (∀ (f : PeriodicSubtileFaceIndex), ∀ (i : Fin 3), cert.modified.plane.faceVertex - (cert.modified_face_equiv.symm f) i = + (cert.modifiedFaceEquivalence.symm f) i = SixSubtileFaceVertices f i) → ((F0 ≠ F1) → ((∃ iA iB iO : Fin 3, cert.modified.plane.faceVertex F0 iA = a ∧ cert.modified.plane.faceVertex F0 iB = b ∧ cert.modified.plane.faceVertex F0 iO = owners.1) ∧ (∃ jA jB jO : Fin 3, @@ -700,8 +700,9 @@ private theorem faceTable : classical intro q cfg C T cert a b row P O u v retargeted owners face0 face1 F0 F1 faceVertex faceDistinct cases row <;> - simp? [F0, F1, face0, face1, owners, P4418T3EndpointOwnerIndices, - faceVertex, SixSubtileFaceVertices, selectedFirstFace, selectedSecondFace] <;> decide + simp only [selectedFirstFace, Int.reduceNeg, faceVertex, SixSubtileFaceVertices, + neg_add_cancel, P4418T3EndpointOwnerIndices, exists_and_left, exists_and_right, + selectedSecondFace, F0, face0, owners, F1, face1, zero_add, zero_sub, sub_self] <;> decide private theorem reversePath : (by @@ -766,8 +767,8 @@ private theorem hne : let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modified_face_equiv.symm face0 - let F1 := cert.modified_face_equiv.symm face1 + let F0 := cert.modifiedFaceEquivalence.symm face0 + let F1 := cert.modifiedFaceEquivalence.symm face1 (F0 ≠ F1) → (((∃ iA iB iO : Fin 3, cert.modified.plane.faceVertex F0 iA = a ∧ cert.modified.plane.faceVertex F0 iB = b ∧ cert.modified.plane.faceVertex F0 iO = owners.1) ∧ (∃ jA jB jO : Fin 3, cert.modified.plane.faceVertex F1 jA = a ∧ @@ -800,8 +801,8 @@ private theorem allowed : let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modified_face_equiv.symm face0 - let F1 := cert.modified_face_equiv.symm face1 + let F0 := cert.modifiedFaceEquivalence.symm face0 + let F1 := cert.modifiedFaceEquivalence.symm face1 (F0 ≠ F1) → (((∃ iA iB iO : Fin 3, cert.modified.plane.faceVertex F0 iA = a ∧ cert.modified.plane.faceVertex F0 iB = b ∧ cert.modified.plane.faceVertex F0 iO = owners.1) ∧ (∃ jA jB jO : Fin 3, cert.modified.plane.faceVertex F1 jA = a ∧ @@ -933,8 +934,8 @@ private theorem pathAtOwners : let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modified_face_equiv.symm face0 - let F1 := cert.modified_face_equiv.symm face1 + let F0 := cert.modifiedFaceEquivalence.symm face0 + let F1 := cert.modifiedFaceEquivalence.symm face1 (F0 ≠ F1) → (((∃ iA iB iO : Fin 3, cert.modified.plane.faceVertex F0 iA = a ∧ cert.modified.plane.faceVertex F0 iB = b ∧ cert.modified.plane.faceVertex F0 iO = owners.1) ∧ (∃ jA jB jO : Fin 3, cert.modified.plane.faceVertex F1 jA = a ∧ @@ -1005,8 +1006,8 @@ private theorem endpointsDistinct : let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modified_face_equiv.symm face0 - let F1 := cert.modified_face_equiv.symm face1 + let F0 := cert.modifiedFaceEquivalence.symm face0 + let F1 := cert.modifiedFaceEquivalence.symm face1 (∀ (p : List GaussianInt), (p.Nodup) → ((2 ≤ p.length) → (p.head? ≠ p.getLast?))) → ((SimpleGridPathBetween (FootprintVertices (occurrence a) ∩ FootprintVertices (occurrence b)) (FootprintEdges (occurrence a) ∩ FootprintEdges (occurrence b)) @@ -1041,7 +1042,7 @@ private theorem commonPair0 : (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b))) → ( let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row - let F0 := cert.modified_face_equiv.symm face0 + let F0 := cert.modifiedFaceEquivalence.symm face0 ∀ (iA : Fin (3 : ℕ)), ∀ (iB : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F0 iA = a) → ((cert.modified.plane.faceVertex F0 iB = b) → (cert.modified.rho F0 ∈ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ @@ -1072,7 +1073,7 @@ private theorem commonPair1 : (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b))) → ( let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F1 := cert.modified_face_equiv.symm face1 + let F1 := cert.modifiedFaceEquivalence.symm face1 ∀ (jA : Fin (3 : ℕ)), ∀ (jB : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F1 jA = a) → ((cert.modified.plane.faceVertex F1 jB = b) → (cert.modified.rho F1 ∈ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ @@ -1107,7 +1108,7 @@ private theorem ownerPoint0 : let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row - let F0 := cert.modified_face_equiv.symm face0 + let F0 := cert.modifiedFaceEquivalence.symm face0 ∀ (iO : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F0 iO = owners.1) → (cert.modified.rho F0 ∈ FootprintVertices (occurrence owners.1)))) ) := by classical @@ -1142,7 +1143,7 @@ private theorem ownerPoint1 : let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F1 := cert.modified_face_equiv.symm face1 + let F1 := cert.modifiedFaceEquivalence.symm face1 ∀ (jO : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F1 jO = owners.2) → (cert.modified.rho F1 ∈ FootprintVertices (occurrence owners.2)))) ) := by classical @@ -1174,7 +1175,7 @@ private theorem originalPair0 : (SubtileOccurrenceInterpretation P u v b))) → ( let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row - let F0 := cert.modified_face_equiv.symm face0 + let F0 := cert.modifiedFaceEquivalence.symm face0 (cert.modified.rho F0 ∈ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)) → (cert.modified.rho F0 ∈ FootprintVertices (occurrence a) ∩ FootprintVertices @@ -1205,7 +1206,7 @@ private theorem originalPair1 : (SubtileOccurrenceInterpretation P u v b))) → ( let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F1 := cert.modified_face_equiv.symm face1 + let F1 := cert.modifiedFaceEquivalence.symm face1 (cert.modified.rho F1 ∈ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)) → (cert.modified.rho F1 ∈ FootprintVertices (occurrence a) ∩ FootprintVertices @@ -1289,8 +1290,8 @@ private theorem disjointData : let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modified_face_equiv.symm face0 - let F1 := cert.modified_face_equiv.symm face1 + let F0 := cert.modifiedFaceEquivalence.symm face0 + let F1 := cert.modifiedFaceEquivalence.symm face1 (F0 ≠ F1) → ((a ≠ b) → ((AllowedSubtileIncidence a b) → (((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty) → ((∃ x y : @@ -1390,8 +1391,8 @@ private theorem touchingData : let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modified_face_equiv.symm face0 - let F1 := cert.modified_face_equiv.symm face1 + let F0 := cert.modifiedFaceEquivalence.symm face0 + let F1 := cert.modifiedFaceEquivalence.symm face1 (F0 ≠ F1) → ((a ≠ b) → ((AllowedSubtileIncidence a b) → (((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty) → ((∃ x y : @@ -1636,8 +1637,8 @@ private theorem selectedCertificate : let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modified_face_equiv.symm face0 - let F1 := cert.modified_face_equiv.symm face1 + let F0 := cert.modifiedFaceEquivalence.symm face0 + let F1 := cert.modifiedFaceEquivalence.symm face1 (F0 ≠ F1) → (((∃ iA iB iO : Fin 3, cert.modified.plane.faceVertex F0 iA = a ∧ cert.modified.plane.faceVertex F0 iB = b ∧ cert.modified.plane.faceVertex F0 iO = owners.1) ∧ (∃ jA jB jO : Fin 3, cert.modified.plane.faceVertex F1 jA = a ∧ @@ -1864,10 +1865,10 @@ theorem P4418T3SelectedInterfaceExists let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modified_face_equiv.symm face0 - let F1 := cert.modified_face_equiv.symm face1 + let F0 := cert.modifiedFaceEquivalence.symm face0 + let F1 := cert.modifiedFaceEquivalence.symm face1 have faceVertex (f : PeriodicSubtileFaceIndex) (i : Fin 3) : - cert.modified.plane.faceVertex (cert.modified_face_equiv.symm f) i = + cert.modified.plane.faceVertex (cert.modifiedFaceEquivalence.symm f) i = SixSubtileFaceVertices f i := SelectedInterfaceGeometry.faceVertex q cfg C T cert f i have faceDistinct : F0 ≠ F1 := SelectedInterfaceGeometry.faceDistinct q cfg C T cert a b row retargeted diff --git a/LeanPool/ApollonianSuperharmonic/P4431T1OwnerTransitionSelector.lean b/LeanPool/ApollonianSuperharmonic/P4431T1OwnerTransitionSelector.lean index fc2888c993..1fb257dadc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4431T1OwnerTransitionSelector.lean +++ b/LeanPool/ApollonianSuperharmonic/P4431T1OwnerTransitionSelector.lean @@ -5,10 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble -public import Mathlib.Data.Fintype.Pi +public import Mathlib.Init +public import Mathlib.Data.Fintype.Fin +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Data.Fin.VecNotation +public import Mathlib.Tactic.ClearExcept public import Mathlib.Tactic.FinCases + -- [TABLET NODE: P4431T1OwnerTransitionSelector] /-! @@ -56,7 +60,7 @@ theorem P4431T1OwnerTransitionSelector {α : Type*} clear * - o encode fin_cases i <;> fin_cases j <;> simp only [ Fin.isValue, Fin.zero_eta, ↓reduceIte, encode, Fin.mk_one, left_eq_ite_iff, - zero_ne_one, imp_false, Decidable.not_not, Fin.reduceFinMk, ite_eq_left_iff, one_ne_zero ] <;> + Fin.reduceFinMk, ite_eq_left_iff ] <;> (try split_ifs) <;> simp_all [eq_comm] have ho : ![encode (o 0), encode (o 1), encode (o 2), encode (o 3)] = fun i => encode (o i) := by diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean b/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean index d415ac6266..911bb6bfc5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean @@ -5,18 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected -public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance public import LeanPool.ApollonianSuperharmonic.TouchingTriple public import LeanPool.ApollonianSuperharmonic.AffineTriangularComplexChart -public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.TouchingTriplePermutations -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -- [TABLET NODE: P4456T2BandGraphTriangle] diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean b/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean index 88e25af13d..30d97e6085 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean @@ -5,13 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4456T2EdgeInterior -public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndex public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.LatticeTileBoundarySimpleGridCycle -public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexAdjacentCell -- [TABLET NODE: P4456T2CrosscutIndex] diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2DiamondNoChord.lean b/LeanPool/ApollonianSuperharmonic/P4456T2DiamondNoChord.lean index 190a04cb63..8b722ecbb5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2DiamondNoChord.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2DiamondNoChord.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4456T2EdgeInterior -public import LeanPool.ApollonianSuperharmonic.DiamondCellDomain public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows public import LeanPool.ApollonianSuperharmonic.DiamondTile diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2EdgeInterior.lean b/LeanPool/ApollonianSuperharmonic/P4456T2EdgeInterior.lean index 4e6104db1d..393adb0a63 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2EdgeInterior.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2EdgeInterior.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Constructions +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells public import LeanPool.ApollonianSuperharmonic.OpenLatticeEdge -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization public import LeanPool.ApollonianSuperharmonic.TileRealization -- [TABLET NODE: P4456T2EdgeInterior] @@ -94,11 +97,13 @@ private theorem vertical : let pR : ℝ × ℝ := ((q.re : ℝ)+1+ε, (q.im : ℝ)+1/2) have hLball : pL ∈ Metric.ball m r := by rw [Metric.mem_ball, Prod.dist_eq] - simp? [pL, m, Real.dist_eq, abs_of_pos hε] + simp only [Int.reduceNeg, GaussianInt.intCast_re, Real.dist_eq, sub_sub_cancel_left, + abs_neg, abs_of_pos hε, GaussianInt.intCast_im, one_div, dist_self, max_lt_iff, m, pL] exact ⟨hεr, hr⟩ have hRball : pR ∈ Metric.ball m r := by rw [Metric.mem_ball, Prod.dist_eq] - simp? [pR, m, Real.dist_eq, abs_of_pos hε] + simp only [Int.reduceNeg, GaussianInt.intCast_re, Real.dist_eq, add_sub_cancel_left, + abs_of_pos hε, GaussianInt.intCast_im, one_div, dist_self, max_lt_iff, m, pR] exact ⟨hεr, hr⟩ have hpL : pL ∈ TileRealization T := interior_subset (hball hLball) have hpR : pR ∈ TileRealization T := interior_subset (hball hRball) @@ -200,11 +205,15 @@ private theorem horizontal : let pU : ℝ × ℝ := ((q.re : ℝ)+1/2, (q.im : ℝ)+1+ε) have hDball : pD ∈ Metric.ball m r := by rw [Metric.mem_ball, Prod.dist_eq] - simp? [pD, m, Real.dist_eq, abs_of_pos hε] + simp only [Int.reduceNeg, GaussianInt.intCast_re, one_div, dist_self, + GaussianInt.intCast_im, Real.dist_eq, sub_sub_cancel_left, abs_neg, abs_of_pos hε, + max_lt_iff, m, pD] exact ⟨hr, hεr⟩ have hUball : pU ∈ Metric.ball m r := by rw [Metric.mem_ball, Prod.dist_eq] - simp? [pU, m, Real.dist_eq, abs_of_pos hε] + simp only [Int.reduceNeg, GaussianInt.intCast_re, one_div, dist_self, + GaussianInt.intCast_im, Real.dist_eq, add_sub_cancel_left, abs_of_pos hε, max_lt_iff, + m, pU] exact ⟨hr, hεr⟩ have hpD : pD ∈ TileRealization T := interior_subset (hball hDball) have hpU : pU ∈ TileRealization T := interior_subset (hball hUball) diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean b/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean index 449e2cf7f8..e2a2745acb 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean @@ -5,22 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4456T2BandGraphTriangle -public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent -public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary -public import LeanPool.ApollonianSuperharmonic.TouchingTriple -public import LeanPool.ApollonianSuperharmonic.P4456T2EdgeInterior -public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected -- [TABLET NODE: P4456T2MissingEdge] diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean b/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean index 5695b1fe81..2d8e79bfbd 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean @@ -5,16 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4456T2CrosscutIndex -public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected -public import LeanPool.ApollonianSuperharmonic.TouchingTriple -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -public import LeanPool.ApollonianSuperharmonic.TileTouching -public import LeanPool.ApollonianSuperharmonic.SimpleGridPath -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.P4456T2ParentSide public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2PackingNoChord.lean b/LeanPool/ApollonianSuperharmonic/P4456T2PackingNoChord.lean index 51664ec09f..fd2cb2561a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2PackingNoChord.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2PackingNoChord.lean @@ -5,12 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas public import LeanPool.ApollonianSuperharmonic.OpenLatticeEdge public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent -public import Mathlib.Topology.Algebra.Ring.Basic public import Mathlib.Topology.Algebra.Ring.Real -- [TABLET NODE: P4456T2PackingNoChord] diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2ParentSide.lean b/LeanPool/ApollonianSuperharmonic/P4456T2ParentSide.lean index 1e1b4c92b7..870d3559c2 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2ParentSide.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2ParentSide.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells public import LeanPool.ApollonianSuperharmonic.P4456T2EdgeInterior public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean b/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean index aead84a059..23862ca544 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4456T2EdgeInterior -public import LeanPool.ApollonianSuperharmonic.FordCellDomain public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior public import LeanPool.ApollonianSuperharmonic.FordTile diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2VertexInterior.lean b/LeanPool/ApollonianSuperharmonic/P4456T2VertexInterior.lean index 664785437d..6260f8a037 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2VertexInterior.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2VertexInterior.lean @@ -5,10 +5,19 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Constructions +public import Mathlib.Basic.Real.Basic +public import Mathlib.Data.Finset.Card +public import Mathlib.Tactic.ByContra +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Positivity +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.TileRealization @@ -244,8 +253,11 @@ theorem P4456T2VertexInterior (T : ProtoTile) (hne : T.cells.Nonempty) if k = 2 then (X - δ, Y - δ) else (X + δ, Y - δ) have hQball (k : Fin 4) : Q k ∈ Metric.ball (GaussianRealPoint x) ε := by fin_cases k <;> - simp? [Q, X, Y, GaussianRealPoint, Metric.mem_ball, Prod.dist_eq, - Real.dist_eq, hδabs] <;> exact hδeps + simp only [GaussianRealPoint, Int.reduceNeg, GaussianInt.intCast_re, + GaussianInt.intCast_im, Fin.isValue, Fin.mk_one, ↓reduceIte, + Metric.mem_ball, Prod.dist_eq, Real.dist_eq, sub_sub_cancel_left, abs_neg, + hδabs, add_sub_cancel_left, max_self, Q, X, Y, Fin.reduceFinMk, Fin.reduceEq, + Fin.zero_eta] <;> exact hδeps have hQreal (k : Fin 4) : Q k ∈ TileRealization T := hsub (hQball k) have hsector : LatticeVertexIncidentCell x j ∈ T.cells := VertexInteriorLemmas.hsector T x j hnot ε hδpos hδone hQreal diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1BoundaryFrame.lean b/LeanPool/ApollonianSuperharmonic/P4458T1BoundaryFrame.lean index 07472ba9fe..f76ecf1774 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1BoundaryFrame.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1BoundaryFrame.lean @@ -5,8 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BoundaryString +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.RegularTileFamily +public import LeanPool.ApollonianSuperharmonic.TilingLattice +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation -- [TABLET NODE: P4458T1BoundaryFrame] @@ -68,18 +72,18 @@ structure P4458T1BoundaryFrame (C : BandCircle) (orientation : Bool) (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q slot.succ) (q 0) + BandVectors.1 (q 0) (q slot.succ)) /-- The defined slope of the outer odometer. -/ - outer_slope : ℝ × ℝ + outerSlope : ℝ × ℝ /-- The defined slope at the initial boundary endpoint. -/ - minus_slope : ℝ × ℝ + minusSlope : ℝ × ℝ /-- The defined slope at the terminal boundary endpoint. -/ - plus_slope : ℝ × ℝ - slope_outer : PartialOdometerSlope odometer = some outer_slope - slope_minus : PartialOdometerSlope hminus = some minus_slope - slope_plus : PartialOdometerSlope hplus = some plus_slope - minus_difference : minus_slope - outer_slope = + plusSlope : ℝ × ℝ + slope_outer : PartialOdometerSlope odometer = some outerSlope + slope_minus : PartialOdometerSlope hminus = some minusSlope + slope_plus : PartialOdometerSlope hplus = some plusSlope + minus_difference : minusSlope - outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (q slot.succ) (q 0) - BandVectors.2 (q 0) (q slot.succ)) - plus_difference : plus_slope - outer_slope = + plus_difference : plusSlope - outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (q slot.succ) (q 0) + BandVectors.2 (q 0) (q slot.succ)) diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1BoundaryPlacement.lean b/LeanPool/ApollonianSuperharmonic/P4458T1BoundaryPlacement.lean index 8334809144..dda2450923 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1BoundaryPlacement.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1BoundaryPlacement.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4458T1BoundarySide +public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily -- [TABLET NODE: P4458T1BoundaryPlacement] diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1BoundarySide.lean b/LeanPool/ApollonianSuperharmonic/P4458T1BoundarySide.lean index 535aa6e723..d26ea8b1d6 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1BoundarySide.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1BoundarySide.lean @@ -5,8 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent +public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryFrame +public import LeanPool.ApollonianSuperharmonic.TileString -- [TABLET NODE: P4458T1BoundarySide] diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean index de47b60ac0..17550a337f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean @@ -5,30 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization -public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy -public import LeanPool.ApollonianSuperharmonic.BandVectors -public import LeanPool.ApollonianSuperharmonic.CircleMatrix -public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryPlacement public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorsExistUnique -public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TilingLattice -public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique -public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct -- [TABLET NODE: P4458T1FirstProperRows] @@ -887,9 +872,9 @@ private theorem hDoffset : ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] let r : Fin 4 → CircleCoordinates := cyc F.q F.slot let wa := BandVectors.2 (r 3) (r 2) - ∀ (joinSlope : ℝ × ℝ), (joinSlope.1 - F.outer_slope.1 = -(1 / 2 : ℝ) * ((↑wa.re : ℝ) - - (↑wa.im : ℝ))) → ((joinSlope.2 - F.outer_slope.2 = -(1 / 2 : ℝ) * ((↑wa.im : ℝ) + - (↑wa.re : ℝ))) → (joinSlope - F.outer_slope = -(1 / 2 : ℝ) • GaussianRealPoint ((1 + + ∀ (joinSlope : ℝ × ℝ), (joinSlope.1 - F.outerSlope.1 = -(1 / 2 : ℝ) * ((↑wa.re : ℝ) - + (↑wa.im : ℝ))) → ((joinSlope.2 - F.outerSlope.2 = -(1 / 2 : ℝ) * ((↑wa.im : ℝ) + + (↑wa.re : ℝ))) → (joinSlope - F.outerSlope = -(1 / 2 : ℝ) • GaussianRealPoint ((1 + I) * wa))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F I cyc r wa joinSlope hre him @@ -917,15 +902,15 @@ private theorem hminusSlope : let wa := BandVectors.2 (r 3) (r 2) (wa = -xa - ya) → ((BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → (∀ (joinSlope : ℝ × ℝ), (joinSlope - - F.outer_slope = -(1 / 2 : ℝ) • GaussianRealPoint ((1 + I) * wa)) → ((F.minus_slope - - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r 1) (r 0) - - BandVectors.2 (r 0) (r 1))) → (joinSlope - F.minus_slope = GaussianRealPoint ya))))) + F.outerSlope = -(1 / 2 : ℝ) • GaussianRealPoint ((1 + I) * wa)) → ((F.minusSlope - + F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r 1) (r 0) - + BandVectors.2 (r 0) (r 1))) → (joinSlope - F.minusSlope = GaussianRealPoint ya))))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F I cyc r xa ya wa hwa harec haflip joinSlope hDoffset hFminus - rw [show joinSlope - F.minus_slope = - (joinSlope - F.outer_slope) - (F.minus_slope - F.outer_slope) by abel] + rw [show joinSlope - F.minusSlope = + (joinSlope - F.outerSlope) - (F.minusSlope - F.outerSlope) by abel] rw [hDoffset, hFminus, haflip, harec, hwa] apply Prod.ext <;> norm_num [GaussianRealPoint, I, Prod.smul_mk, @@ -947,15 +932,15 @@ private theorem hplusSlope : let wa := BandVectors.2 (r 3) (r 2) (wa = -xa - ya) → ((BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → (∀ (joinSlope : ℝ × ℝ), (joinSlope - - F.outer_slope = -(1 / 2 : ℝ) • GaussianRealPoint ((1 + I) * wa)) → ((F.plus_slope - - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r 1) (r 0) + - BandVectors.2 (r 0) (r 1))) → (F.plus_slope - joinSlope = GaussianRealPoint (-I * + F.outerSlope = -(1 / 2 : ℝ) • GaussianRealPoint ((1 + I) * wa)) → ((F.plusSlope - + F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r 1) (r 0) + + BandVectors.2 (r 0) (r 1))) → (F.plusSlope - joinSlope = GaussianRealPoint (-I * xa)))))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F I cyc r xa ya wa hwa harec haflip joinSlope hDoffset hFplus - rw [show F.plus_slope - joinSlope = - (F.plus_slope - F.outer_slope) - (joinSlope - F.outer_slope) by abel] + rw [show F.plusSlope - joinSlope = + (F.plusSlope - F.outerSlope) - (joinSlope - F.outerSlope) by abel] rw [hFplus, hDoffset, haflip, harec, hwa] apply Prod.ext <;> norm_num [GaussianRealPoint, I, Prod.smul_mk, @@ -983,13 +968,13 @@ private theorem hleftAdjacent : let join := TileTranslation base (u + y) (TileCentroid join - TileCentroid Rminus = GaussianRealPoint y) → ((TileOdometer C.1.1 join (D.functions F.slot false)) → (∀ (joinSlope : ℝ × ℝ), (PartialOdometerSlope - (D.functions F.slot false) = some joinSlope) → ((joinSlope - F.minus_slope = + (D.functions F.slot false) = some joinSlope) → ((joinSlope - F.minusSlope = GaussianRealPoint ya) → (LeftLatticeAdjacent C Rminus join hminus (D.functions F.slot false))))))))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F D cyc hunit r y ya hyStep hyRe hyIm u join hjoinCenter hjoinOdo joinSlope hjoinSlope hminusSlope - refine ⟨F.minus_odo, hjoinOdo, F.minus_slope, joinSlope, + refine ⟨F.minus_odo, hjoinOdo, F.minusSlope, joinSlope, F.slope_minus, hjoinSlope, Or.inl ⟨hunit, orientation, y, hyStep, hjoinCenter, ?_, ?_⟩⟩ · rw [← hyRe] exact congrArg Prod.fst hminusSlope @@ -1020,13 +1005,13 @@ private theorem hrightAdjacent : let join := TileTranslation base (u + y) (TileOdometer C.1.1 join (D.functions F.slot false)) → ((TileCentroid Rplus - TileCentroid join = GaussianRealPoint (I * x)) → (∀ (joinSlope : ℝ × ℝ), - (PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → ((F.plus_slope - + (PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → ((F.plusSlope - joinSlope = GaussianRealPoint (-I * xa)) → (LeftLatticeAdjacent C join Rplus (D.functions F.slot false) hplus)))))))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F D I cyc hunit r x y xa hxStep hxRe hxIm u join hjoinOdo hrightCenter joinSlope hjoinSlope hplusSlope - refine ⟨hjoinOdo, F.plus_odo, joinSlope, F.plus_slope, + refine ⟨hjoinOdo, F.plus_odo, joinSlope, F.plusSlope, hjoinSlope, F.slope_plus, Or.inl ⟨hunit, orientation, I * x, hxStep, hrightCenter, ?_, ?_⟩⟩ · rw [← hxRe] exact congrArg Prod.fst hplusSlope @@ -1209,10 +1194,10 @@ theorem P4458T1FirstProperRows child.2 - root.2 = -(1 / 2 : ℝ) * ((wa.im : ℝ) + (wa.re : ℝ)) := FirstProperRowProof.hSlopeInfo C orientation base Rminus Rplus hminus hplus F D hCpositive rcases hSlopeInfo with ⟨rootSlope, joinSlope, hrootSlope, hjoinSlope, hre, him⟩ - have hrootSlopeEq : rootSlope = F.outer_slope := + have hrootSlopeEq : rootSlope = F.outerSlope := Option.some.inj (hrootSlope.symm.trans F.slope_outer) rw [hrootSlopeEq] at hre him - have hDoffset : joinSlope - F.outer_slope = + have hDoffset : joinSlope - F.outerSlope = -(1 / 2 : ℝ) • GaussianRealPoint ((1 + I) * wa) := FirstProperRowDetails.hDoffset C orientation base Rminus Rplus hminus hplus F joinSlope hre him have pairString (U V : ProtoTile) (d : GaussianInt) diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean index d5a60c7512..f278d1c42d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean @@ -5,24 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy -public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryFrame public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryPlacement -public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.TileString public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: P4458T1LargestParentRows] @@ -817,7 +808,7 @@ private theorem hFminusSlope : let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - F.minus_slope - F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r + F.minusSlope - F.outerSlope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re - (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im)) ) := by @@ -835,7 +826,7 @@ private theorem hFplusSlope : let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - F.plus_slope - F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r + F.plusSlope - F.outerSlope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im)) ) := by @@ -1254,10 +1245,10 @@ private theorem hminusSlope : let wa : GaussianInt := BandVectors.2 (r 3) (r 2) let xa : GaussianInt := BandVectors.2 (r 1) (r 3) let ya : GaussianInt := BandVectors.2 (r 2) (r 1) - ∀ (rootSlope : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (rootSlope = F.outer_slope) → ((joinSlope - + ∀ (rootSlope : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (rootSlope = F.outerSlope) → ((joinSlope - rootSlope = (-(1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ) + (1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ), -(1 - / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - (1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ))) → ((F.minus_slope - - F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r + / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - (1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ))) → ((F.minusSlope - + F.outerSlope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re - (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im))) → ((-(1 + I) * wa - BandVectors.2 (r 1) (r 0) + @@ -1270,7 +1261,7 @@ private theorem hminusSlope : xa).re + (GaussianInt.toComplex ya).im) → (((GaussianInt.toComplex wa).re + (GaussianInt.toComplex xa).re + (GaussianInt.toComplex ya).re = 0) → (((GaussianInt.toComplex wa).im + (GaussianInt.toComplex xa).im + - (GaussianInt.toComplex ya).im = 0) → (joinSlope - F.minus_slope = GaussianRealPoint + (GaussianInt.toComplex ya).im = 0) → (joinSlope - F.minusSlope = GaussianRealPoint ya)))))))))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r I wa xa ya rootSlope joinSlope @@ -1284,7 +1275,7 @@ private theorem hminusSlope : (1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ), -(1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - (1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ)) := hDoffset - have hFminusSlope' : F.minus_slope - rootSlope = + have hFminusSlope' : F.minusSlope - rootSlope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re - (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), @@ -1293,8 +1284,8 @@ private theorem hminusSlope : (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im)) := by rw [hrootSlopeEq] exact hFminusSlope - rw [show joinSlope - F.minus_slope = - (joinSlope - rootSlope) - (F.minus_slope - rootSlope) by + rw [show joinSlope - F.minusSlope = + (joinSlope - rootSlope) - (F.minusSlope - rootSlope) by ext <;> dsimp <;> ring] rw [hDoffset', hFminusSlope'] apply Prod.ext @@ -1319,10 +1310,10 @@ private theorem hplusSlope : let wa : GaussianInt := BandVectors.2 (r 3) (r 2) let xa : GaussianInt := BandVectors.2 (r 1) (r 3) let ya : GaussianInt := BandVectors.2 (r 2) (r 1) - ∀ (rootSlope : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (rootSlope = F.outer_slope) → ((joinSlope - + ∀ (rootSlope : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (rootSlope = F.outerSlope) → ((joinSlope - rootSlope = (-(1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ) + (1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ), -(1 - / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - (1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ))) → ((F.plus_slope - - F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r + / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - (1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ))) → ((F.plusSlope - + F.outerSlope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im))) → (((1 - I) * BandVectors.2 (r 1) (r 0) + (1 + I) @@ -1335,7 +1326,7 @@ private theorem hplusSlope : xa).re + (GaussianInt.toComplex ya).im) → (((GaussianInt.toComplex wa).re + (GaussianInt.toComplex xa).re + (GaussianInt.toComplex ya).re = 0) → (((GaussianInt.toComplex wa).im + (GaussianInt.toComplex xa).im + - (GaussianInt.toComplex ya).im = 0) → (F.plus_slope - joinSlope = GaussianRealPoint + (GaussianInt.toComplex ya).im = 0) → (F.plusSlope - joinSlope = GaussianRealPoint (-I * xa))))))))))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r I wa xa ya rootSlope joinSlope @@ -1348,7 +1339,7 @@ private theorem hplusSlope : (1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ), -(1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - (1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ)) := hDoffset - have hFplusSlope' : F.plus_slope - rootSlope = + have hFplusSlope' : F.plusSlope - rootSlope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), @@ -1357,8 +1348,8 @@ private theorem hplusSlope : (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im)) := by rw [hrootSlopeEq] exact hFplusSlope - rw [show F.plus_slope - joinSlope = - (F.plus_slope - rootSlope) - (joinSlope - rootSlope) by + rw [show F.plusSlope - joinSlope = + (F.plusSlope - rootSlope) - (joinSlope - rootSlope) by ext <;> dsimp <;> ring] rw [hFplusSlope', hDoffset'] apply Prod.ext @@ -1502,8 +1493,8 @@ private theorem hleftSlope1 : ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] let ya : GaussianInt := BandVectors.2 (r 2) (r 1) - ∀ (joinSlope : ℝ × ℝ), (joinSlope - F.minus_slope = GaussianRealPoint ya) → (joinSlope.1 - - F.minus_slope.1 = (ya.re : ℝ)) ) := by + ∀ (joinSlope : ℝ × ℝ), (joinSlope - F.minusSlope = GaussianRealPoint ya) → (joinSlope.1 + - F.minusSlope.1 = (ya.re : ℝ)) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r ya joinSlope hleftSlope have h := congrArg Prod.fst hleftSlope @@ -1520,8 +1511,8 @@ private theorem hleftSlope2 : ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] let ya : GaussianInt := BandVectors.2 (r 2) (r 1) - ∀ (joinSlope : ℝ × ℝ), (joinSlope - F.minus_slope = GaussianRealPoint ya) → (joinSlope.2 - - F.minus_slope.2 = (ya.im : ℝ)) ) := by + ∀ (joinSlope : ℝ × ℝ), (joinSlope - F.minusSlope = GaussianRealPoint ya) → (joinSlope.2 + - F.minusSlope.2 = (ya.im : ℝ)) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r ya joinSlope hleftSlope have h := congrArg Prod.snd hleftSlope @@ -1546,13 +1537,13 @@ private theorem hleftAdjacent : (TileOdometer C.1.1 join (D.functions F.slot false)) → (∀ (joinSlope : ℝ × ℝ), (PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → ((y = BandVectors.1 (p 2) (p 0)) → ((ya = BandVectors.2 (p 2) (p 0)) → ((TileCentroid join - - TileCentroid Rminus = GaussianRealPoint y) → ((joinSlope.1 - F.minus_slope.1 = - (ya.re : ℝ)) → ((joinSlope.2 - F.minus_slope.2 = (ya.im : ℝ)) → (LeftLatticeAdjacent + - TileCentroid Rminus = GaussianRealPoint y) → ((joinSlope.1 - F.minusSlope.1 = + (ya.re : ℝ)) → ((joinSlope.2 - F.minusSlope.2 = (ya.im : ℝ)) → (LeftLatticeAdjacent C Rminus join hminus (D.functions F.slot false)))))))))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F D p hp r y ya hCcoord u join hjoinOdo joinSlope hjoinSlope hy haya hleftCent hleftSlope1 hleftSlope2 - refine ⟨F.minus_odo, hjoinOdo, F.minus_slope, joinSlope, + refine ⟨F.minus_odo, hjoinOdo, F.minusSlope, joinSlope, F.slope_minus, hjoinSlope, ?_⟩ · right refine ⟨p, 1, true, hp, hCcoord.symm, ?_, ?_, ?_⟩ @@ -1573,8 +1564,8 @@ private theorem hrightSlope1 : F.q ((F.slot + 2).succ)] let I : GaussianInt := ⟨0, 1⟩ let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - ∀ (joinSlope : ℝ × ℝ), (F.plus_slope - joinSlope = GaussianRealPoint (-I * xa)) → - (F.plus_slope.1 - joinSlope.1 = ((-I * xa).re : ℝ)) ) := by + ∀ (joinSlope : ℝ × ℝ), (F.plusSlope - joinSlope = GaussianRealPoint (-I * xa)) → + (F.plusSlope.1 - joinSlope.1 = ((-I * xa).re : ℝ)) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r I xa joinSlope hrightSlope have h := congrArg Prod.fst hrightSlope @@ -1592,8 +1583,8 @@ private theorem hrightSlope2 : F.q ((F.slot + 2).succ)] let I : GaussianInt := ⟨0, 1⟩ let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - ∀ (joinSlope : ℝ × ℝ), (F.plus_slope - joinSlope = GaussianRealPoint (-I * xa)) → - (F.plus_slope.2 - joinSlope.2 = ((-I * xa).im : ℝ)) ) := by + ∀ (joinSlope : ℝ × ℝ), (F.plusSlope - joinSlope = GaussianRealPoint (-I * xa)) → + (F.plusSlope.2 - joinSlope.2 = ((-I * xa).im : ℝ)) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r I xa joinSlope hrightSlope have h := congrArg Prod.snd hrightSlope @@ -1629,13 +1620,13 @@ private theorem hrightAdjacent : GaussianInt) * BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) = -BandVectors.2 (p (3 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ)))) → ((x = BandVectors.1 (p 0) (p 3)) → ((xa = BandVectors.2 (p 0) (p 3)) → (((3 : Fin 4) = Fin.succ (2 : Fin 3)) - → ((F.plus_slope.1 - joinSlope.1 = ((-I * xa).re : ℝ)) → ((F.plus_slope.2 - + → ((F.plusSlope.1 - joinSlope.1 = ((-I * xa).re : ℝ)) → ((F.plusSlope.2 - joinSlope.2 = ((-I * xa).im : ℝ)) → (LeftLatticeAdjacent C join Rplus (D.functions F.slot false) hplus))))))))))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F D p hp r I x y xa hCcoord u join hjoinOdo hPlusJoin joinSlope hjoinSlope horientation hx hxa hindex3 hrightSlope1 hrightSlope2 - refine ⟨hjoinOdo, F.plus_odo, joinSlope, F.plus_slope, + refine ⟨hjoinOdo, F.plus_odo, joinSlope, F.plusSlope, hjoinSlope, F.slope_plus, ?_⟩ rcases horientation with horient | horient · right @@ -1643,14 +1634,14 @@ private theorem hrightAdjacent : · rw [hPlusJoin, hx, horient.1] simp [GaussianRealPoint, ← hindex3] · simpa [hindex3] using (calc - F.plus_slope.1 - joinSlope.1 = ((-I * xa).re : ℝ) := hrightSlope1 + F.plusSlope.1 - joinSlope.1 = ((-I * xa).re : ℝ) := hrightSlope1 _ = ((BandVectors.2 (p 3) (p 0)).re : ℝ) := by rw [hxa] have ha := congrArg (fun z : GaussianInt => z.re) horient.2 exact_mod_cast ha ) · simpa [hindex3] using (calc - F.plus_slope.2 - joinSlope.2 = ((-I * xa).im : ℝ) := hrightSlope2 + F.plusSlope.2 - joinSlope.2 = ((-I * xa).im : ℝ) := hrightSlope2 _ = ((BandVectors.2 (p 3) (p 0)).im : ℝ) := by rw [hxa] have ha := congrArg (fun z : GaussianInt => z.im) horient.2 @@ -1661,14 +1652,14 @@ private theorem hrightAdjacent : · rw [hPlusJoin, hx, horient.1] simp [GaussianRealPoint] · simpa [hindex3] using (calc - F.plus_slope.1 - joinSlope.1 = ((-I * xa).re : ℝ) := hrightSlope1 + F.plusSlope.1 - joinSlope.1 = ((-I * xa).re : ℝ) := hrightSlope1 _ = -((BandVectors.2 (p 3) (p 0)).re : ℝ) := by rw [hxa] have ha := congrArg (fun z : GaussianInt => z.re) horient.2 exact_mod_cast ha ) · simpa [hindex3] using (calc - F.plus_slope.2 - joinSlope.2 = ((-I * xa).im : ℝ) := hrightSlope2 + F.plusSlope.2 - joinSlope.2 = ((-I * xa).im : ℝ) := hrightSlope2 _ = -((BandVectors.2 (p 3) (p 0)).im : ℝ) := by rw [hxa] have ha := congrArg (fun z : GaussianInt => z.im) horient.2 @@ -1827,13 +1818,13 @@ private theorem leftString : ((PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → ((joinSlope.1 - rootSlope.1 = -(1 / 2 : ℝ) * ((↑wa.re : ℝ) - (↑wa.im : ℝ))) → ((joinSlope.2 - rootSlope.2 = -(1 / 2 : ℝ) * ((↑wa.im : ℝ) + (↑wa.re : ℝ))) → ((rootSlope = - F.outer_slope) → ((joinSlope - rootSlope = (-(1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ) + (1 / 2 + F.outerSlope) → ((joinSlope - rootSlope = (-(1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ) + (1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ), -(1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - (1 / 2 : ℝ) * ((wa.re : - ℤ) : ℝ))) → ((F.minus_slope - F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex + ℤ) : ℝ))) → ((F.minusSlope - F.outerSlope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re - (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - - (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im))) → ((F.plus_slope - - F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im))) → ((F.plusSlope - + F.outerSlope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im))) → ((wa.re + xa.re + ya.re = 0) → ((wa.im + xa.im + @@ -1863,15 +1854,15 @@ private theorem leftString : (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - (GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex wa).im + (GaussianInt.toComplex wa).re = -2 * (GaussianInt.toComplex xa).re) → ((joinSlope - - F.minus_slope = GaussianRealPoint ya) → ((F.plus_slope - joinSlope = + F.minusSlope = GaussianRealPoint ya) → ((F.plusSlope - joinSlope = GaussianRealPoint (-I * xa)) → ((y = BandVectors.1 (p 2) (p 0)) → ((x = BandVectors.1 (p 0) (p 3)) → ((xa = BandVectors.2 (p 0) (p 3)) → ((ya = BandVectors.2 (p 2) (p 0)) → ((TileCentroid join - TileCentroid Rminus = GaussianRealPoint y) → ((TileTouching - Rminus join) → ((TileTouching join Rplus) → ((joinSlope - F.minus_slope = - GaussianRealPoint ya) → ((joinSlope.1 - F.minus_slope.1 = (ya.re : ℝ)) → - ((joinSlope.2 - F.minus_slope.2 = (ya.im : ℝ)) → ((LeftLatticeAdjacent C Rminus join - hminus (D.functions F.slot false)) → ((F.plus_slope - joinSlope = GaussianRealPoint - (-I * xa)) → ((F.plus_slope.1 - joinSlope.1 = ((-I * xa).re : ℝ)) → ((F.plus_slope.2 + Rminus join) → ((TileTouching join Rplus) → ((joinSlope - F.minusSlope = + GaussianRealPoint ya) → ((joinSlope.1 - F.minusSlope.1 = (ya.re : ℝ)) → + ((joinSlope.2 - F.minusSlope.2 = (ya.im : ℝ)) → ((LeftLatticeAdjacent C Rminus join + hminus (D.functions F.slot false)) → ((F.plusSlope - joinSlope = GaussianRealPoint + (-I * xa)) → ((F.plusSlope.1 - joinSlope.1 = ((-I * xa).re : ℝ)) → ((F.plusSlope.2 - joinSlope.2 = ((-I * xa).im : ℝ)) → ((LeftLatticeAdjacent C join Rplus (D.functions F.slot false) hplus) → ((Rminus.cells.Nonempty) → ((Rminus ≠ join) → ((join ≠ Rplus) → ((C.1.1.1 ≠ 1) → (TileString C orientation base Rminus join [Rminus, @@ -1995,13 +1986,13 @@ private theorem rightString : ((PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → ((joinSlope.1 - rootSlope.1 = -(1 / 2 : ℝ) * ((↑wa.re : ℝ) - (↑wa.im : ℝ))) → ((joinSlope.2 - rootSlope.2 = -(1 / 2 : ℝ) * ((↑wa.im : ℝ) + (↑wa.re : ℝ))) → ((rootSlope = - F.outer_slope) → ((joinSlope - rootSlope = (-(1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ) + (1 / 2 + F.outerSlope) → ((joinSlope - rootSlope = (-(1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ) + (1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ), -(1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - (1 / 2 : ℝ) * ((wa.re : - ℤ) : ℝ))) → ((F.minus_slope - F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex + ℤ) : ℝ))) → ((F.minusSlope - F.outerSlope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re - (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - - (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im))) → ((F.plus_slope - - F.outer_slope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im))) → ((F.plusSlope - + F.outerSlope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im))) → ((wa.re + xa.re + ya.re = 0) → ((wa.im + xa.im + @@ -2031,15 +2022,15 @@ private theorem rightString : (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - (GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex wa).im + (GaussianInt.toComplex wa).re = -2 * (GaussianInt.toComplex xa).re) → ((joinSlope - - F.minus_slope = GaussianRealPoint ya) → ((F.plus_slope - joinSlope = + F.minusSlope = GaussianRealPoint ya) → ((F.plusSlope - joinSlope = GaussianRealPoint (-I * xa)) → ((y = BandVectors.1 (p 2) (p 0)) → ((x = BandVectors.1 (p 0) (p 3)) → ((xa = BandVectors.2 (p 0) (p 3)) → ((ya = BandVectors.2 (p 2) (p 0)) → ((TileCentroid join - TileCentroid Rminus = GaussianRealPoint y) → ((TileTouching - Rminus join) → ((TileTouching join Rplus) → ((joinSlope - F.minus_slope = - GaussianRealPoint ya) → ((joinSlope.1 - F.minus_slope.1 = (ya.re : ℝ)) → - ((joinSlope.2 - F.minus_slope.2 = (ya.im : ℝ)) → ((LeftLatticeAdjacent C Rminus join - hminus (D.functions F.slot false)) → ((F.plus_slope - joinSlope = GaussianRealPoint - (-I * xa)) → ((F.plus_slope.1 - joinSlope.1 = ((-I * xa).re : ℝ)) → ((F.plus_slope.2 + Rminus join) → ((TileTouching join Rplus) → ((joinSlope - F.minusSlope = + GaussianRealPoint ya) → ((joinSlope.1 - F.minusSlope.1 = (ya.re : ℝ)) → + ((joinSlope.2 - F.minusSlope.2 = (ya.im : ℝ)) → ((LeftLatticeAdjacent C Rminus join + hminus (D.functions F.slot false)) → ((F.plusSlope - joinSlope = GaussianRealPoint + (-I * xa)) → ((F.plusSlope.1 - joinSlope.1 = ((-I * xa).re : ℝ)) → ((F.plusSlope.2 - joinSlope.2 = ((-I * xa).im : ℝ)) → ((LeftLatticeAdjacent C join Rplus (D.functions F.slot false) hplus) → ((Rplus.cells.Nonempty) → ((Rminus ≠ join) → ((join ≠ Rplus) → ((C.1.1.1 ≠ 1) → ((TileString C orientation base Rminus join [Rminus, join]) → @@ -2373,7 +2364,7 @@ private theorem largestParentCertificate : (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).re : ℝ))) → - ((rootSlope = F.outer_slope) → ((joinSlope - rootSlope = (-(1 / 2 : ℝ) * + ((rootSlope = F.outerSlope) → ((joinSlope - rootSlope = (-(1 / 2 : ℝ) * (↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + @@ -2391,7 +2382,7 @@ private theorem largestParentCertificate : F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).re : ℝ))) → (( let r := ![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, - F.q (F.slot + (2 : Fin (3 : ℕ))).succ]; F.minus_slope - F.outer_slope = ((1 / 2 : ℝ) + F.q (F.slot + (2 : Fin (3 : ℕ))).succ]; F.minusSlope - F.outerSlope = ((1 / 2 : ℝ) * (((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))))).re - ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))))).re), (1 / 2 : ℝ) * @@ -2399,7 +2390,7 @@ private theorem largestParentCertificate : (0 : Fin (4 : ℕ))))).im - ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))))).im))) → (( let r := ![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, - F.q (F.slot + (2 : Fin (3 : ℕ))).succ]; F.plus_slope - F.outer_slope = ((1 / 2 : ℝ) * + F.q (F.slot + (2 : Fin (3 : ℕ))).succ]; F.plusSlope - F.outerSlope = ((1 / 2 : ℝ) * (((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))))).re + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))))).re), (1 / 2 : ℝ) * @@ -2679,8 +2670,8 @@ private theorem largestParentCertificate : (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : - ℕ))).succ] (3 : Fin (4 : ℕ))))).re) → ((joinSlope - F.minus_slope = GaussianRealPoint - ya) → ((F.plus_slope - joinSlope = GaussianRealPoint (-(⟨(0 : ℤ), (1 : ℤ)⟩ : + ℕ))).succ] (3 : Fin (4 : ℕ))))).re) → ((joinSlope - F.minusSlope = GaussianRealPoint + ya) → ((F.plusSlope - joinSlope = GaussianRealPoint (-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q @@ -2722,7 +2713,7 @@ private theorem largestParentCertificate : hplus F p hp hCcoord u hjoinFamily hy hleftCent hbasep have hrightTouch := LargestParentGeometry.hrightTouch C orientation base Rminus Rplus hminus hplus F p hp hCcoord u hjoinFamily hPlusJoin horientation hx hbasep hindex3 - have hleftSlope : joinSlope - F.minus_slope = GaussianRealPoint ya := by + have hleftSlope : joinSlope - F.minusSlope = GaussianRealPoint ya := by rw [hminusSlope] have hleftSlope1 := LargestParentGeometry.hleftSlope1 C orientation base Rminus Rplus hminus hplus F joinSlope hleftSlope @@ -2731,7 +2722,7 @@ private theorem largestParentCertificate : have hleftAdjacent := LargestParentGeometry.hleftAdjacent C orientation base Rminus Rplus hminus hplus F D p hp hCcoord u hjoinOdo joinSlope hjoinSlope hy haya hleftCent hleftSlope1 hleftSlope2 - have hrightSlope : F.plus_slope - joinSlope = GaussianRealPoint (-I * xa) := hplusSlope + have hrightSlope : F.plusSlope - joinSlope = GaussianRealPoint (-I * xa) := hplusSlope have hrightSlope1 := LargestParentGeometry.hrightSlope1 C orientation base Rminus Rplus hminus hplus F joinSlope hrightSlope have hrightSlope2 := LargestParentGeometry.hrightSlope2 C orientation base Rminus Rplus hminus @@ -2895,7 +2886,7 @@ theorem P4458T1LargestParentRows hplus F D hCpositive rcases hSlopeInfo with ⟨rootSlope, joinSlope, hrootSlope, hjoinSlope, hjoinSlopeRe, hjoinSlopeIm⟩ - have hrootSlopeEq : rootSlope = F.outer_slope := + have hrootSlopeEq : rootSlope = F.outerSlope := Option.some.inj (hrootSlope.symm.trans F.slope_outer) have hDoffset := LargestParentGeometry.hDoffset C orientation base Rminus Rplus hminus hplus F rootSlope joinSlope hjoinSlopeRe hjoinSlopeIm @@ -2943,7 +2934,7 @@ theorem P4458T1LargestParentRows hminus hplus F toRealRe toRealIm hplusVectorRe' have hplusVectorImC := LargestParentGeometry.hplusVectorImC C orientation base Rminus Rplus hminus hplus F toRealRe toRealIm hplusVectorIm' - have hminusSlope : joinSlope - F.minus_slope = GaussianRealPoint ya := + have hminusSlope : joinSlope - F.minusSlope = GaussianRealPoint ya := LargestParentGeometry.hminusSlope C orientation base Rminus Rplus hminus hplus F rootSlope joinSlope hrootSlopeEq hDoffset hFminusSlope hminusSlopeVector ha10ReC ha10ImC ha01ReC ha01ImC hsumReC hsumImC diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean b/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean index 1c001c680b..8eb00090de 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect public import LeanPool.ApollonianSuperharmonic.AncestorOdometer diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1RestrictionFamily.lean b/LeanPool/ApollonianSuperharmonic/P4458T1RestrictionFamily.lean index e9f36413db..946c710011 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1RestrictionFamily.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1RestrictionFamily.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryFrame public import LeanPool.ApollonianSuperharmonic.AncestorOdometer public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean index a439b268be..ea40050b54 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean @@ -5,25 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification -public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy -public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryFrame public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryPlacement -public import LeanPool.ApollonianSuperharmonic.P4458T1BoundarySide -public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.TileString -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: P4458T1SecondNewerRows] @@ -874,8 +863,8 @@ private theorem hminusSlopeOffset : let ya : GaussianInt := BandVectors.2 (r 2) (r 1) ∀ (rootNeg : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (joinSlope.1 - rootNeg.1 = -(1 / 2 : ℝ) * ((↑wa.re : ℝ) - (↑wa.im : ℝ))) → ((joinSlope.2 - rootNeg.2 = -(1 / 2 : ℝ) * ((↑wa.im - : ℝ) + (↑wa.re : ℝ))) → ((rootNeg = F.outer_slope) → (∀ (rootSlope : ℝ × ℝ), ∀ - (aSlope : ℝ × ℝ), (rootSlope = F.outer_slope) → ((BandVectors.2 (p 2) (p 0) = xa) → + : ℝ) + (↑wa.re : ℝ))) → ((rootNeg = F.outerSlope) → (∀ (rootSlope : ℝ × ℝ), ∀ + (aSlope : ℝ × ℝ), (rootSlope = F.outerSlope) → ((BandVectors.2 (p 2) (p 0) = xa) → ((BandVectors.2 (p 0) (p 2) = -I * xa) → ((aSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * (ya.re - ya.im)) → ((aSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * (ya.im + ya.re)) → (((wa.re : ℝ) + (xa.re : ℝ) + (ya.re : ℝ) = 0) → (((wa.im : ℝ) + (xa.im : ℝ) + (ya.im @@ -935,7 +924,7 @@ private theorem hFplusSlope : let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - ∀ (rootSlope : ℝ × ℝ), (rootSlope = F.outer_slope) → (F.plus_slope - rootSlope = (1 / 2 : + ∀ (rootSlope : ℝ × ℝ), (rootSlope = F.outerSlope) → (F.plusSlope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r rootSlope hrootSlopeEq @@ -952,8 +941,8 @@ private theorem hFplusRe : let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - ∀ (rootSlope : ℝ × ℝ), (F.plus_slope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.2 (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) → (F.plus_slope.1 - + ∀ (rootSlope : ℝ × ℝ), (F.plusSlope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) → (F.plusSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re) + ((GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re))) ) := by classical @@ -971,8 +960,8 @@ private theorem hFplusIm : let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - ∀ (rootSlope : ℝ × ℝ), (F.plus_slope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.2 (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) → (F.plus_slope.2 - + ∀ (rootSlope : ℝ × ℝ), (F.plusSlope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) → (F.plusSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im) + ((GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im))) ) := by classical @@ -1041,7 +1030,8 @@ private theorem ha01ReAt517 : classical intro C orientation base Rminus Rplus hminus hplus F r I xa ya haflip ha10Im have h := congrArg (fun z : GaussianInt => z.re) haflip - simp? [I, Zsqrtd.re_mul] at h + simp only [Int.reduceNeg, Fin.isValue, neg_mul, Zsqrtd.re_neg, Zsqrtd.re_mul, zero_mul, + mul_one, one_mul, zero_add, neg_neg, I] at h rw [ha10Im] at h omega @@ -1064,7 +1054,8 @@ private theorem ha01ImAt522 : classical intro C orientation base Rminus Rplus hminus hplus F a p r I xa ya haflip ha10Re have h := congrArg (fun z : GaussianInt => z.im) haflip - simp? [I, Zsqrtd.im_mul] at h + simp only [Int.reduceNeg, Fin.isValue, neg_mul, Zsqrtd.im_neg, Zsqrtd.im_mul, zero_mul, + one_mul, zero_add, I] at h rw [ha10Re] at h omega @@ -1120,9 +1111,9 @@ private theorem hFplusRe' : ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] ∀ (rootSlope : ℝ × ℝ), (∀ (z : GaussianInt), (GaussianInt.toComplex z).re = (z.re : ℝ)) → - ((F.plus_slope.1 - rootSlope.1 = (1 / 2 : ℝ) * (((GaussianInt.toComplex + ((F.plusSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re) + ((GaussianInt.toComplex (BandVectors.2 (r 0) (r - 1))).re))) → (F.plus_slope.1 - rootSlope.1 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r + 1))).re))) → (F.plusSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).re : ℝ) + ((BandVectors.2 (r 0) (r 1)).re : ℝ)))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r rootSlope toRealRe hFplusRe @@ -1139,9 +1130,9 @@ private theorem hFplusIm' : ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] ∀ (rootSlope : ℝ × ℝ), (∀ (z : GaussianInt), (GaussianInt.toComplex z).im = (z.im : ℝ)) → - ((F.plus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) * (((GaussianInt.toComplex + ((F.plusSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im) + ((GaussianInt.toComplex (BandVectors.2 (r 0) (r - 1))).im))) → (F.plus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r + 1))).im))) → (F.plusSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).im : ℝ) + ((BandVectors.2 (r 0) (r 1)).im : ℝ)))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r rootSlope toRealIm hFplusIm @@ -1166,10 +1157,10 @@ private theorem hplusSlopeOffset : = xa.im + ya.re) → (((BandVectors.2 (r 0) (r 1)).re = xa.im + ya.re) → (((BandVectors.2 (r 0) (r 1)).im = -xa.re + ya.im) → (((BandVectors.2 (p 2) (p 0) + BandVectors.2 (p 0) (p 2)).re = xa.re + xa.im) → (((BandVectors.2 (p 2) (p 0) + - BandVectors.2 (p 0) (p 2)).im = xa.im - xa.re) → ((F.plus_slope.1 - rootSlope.1 = (1 + BandVectors.2 (p 0) (p 2)).im = xa.im - xa.re) → ((F.plusSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).re : ℝ) + ((BandVectors.2 (r 0) (r 1)).re : - ℝ))) → ((F.plus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r - 0)).im : ℝ) + ((BandVectors.2 (r 0) (r 1)).im : ℝ))) → (F.plus_slope - aSlope = (1 / + ℝ))) → ((F.plusSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r + 0)).im : ℝ) + ((BandVectors.2 (r 0) (r 1)).im : ℝ))) → (F.plusSlope - aSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p 2) (p 0) + BandVectors.2 (p 0) (p 2)))))))))))) ) := by classical @@ -1177,8 +1168,8 @@ private theorem hplusSlopeOffset : ha10Re ha10Im ha01Re ha01Im hplusReVec hplusImVec hFplusRe' hFplusIm' apply Prod.ext · calc - F.plus_slope.1 - aSlope.1 = - (F.plus_slope.1 - rootSlope.1) - (aSlope.1 - rootSlope.1) := by ring + F.plusSlope.1 - aSlope.1 = + (F.plusSlope.1 - rootSlope.1) - (aSlope.1 - rootSlope.1) := by ring _ = (1 / 2 : ℝ) * (xa.re + xa.im) := by rw [hFplusRe', hARe', ha10Re, ha01Re] push_cast @@ -1192,8 +1183,8 @@ private theorem hplusSlopeOffset : congr 1 exact_mod_cast hplusReVec.symm · calc - F.plus_slope.2 - aSlope.2 = - (F.plus_slope.2 - rootSlope.2) - (aSlope.2 - rootSlope.2) := by ring + F.plusSlope.2 - aSlope.2 = + (F.plusSlope.2 - rootSlope.2) - (aSlope.2 - rootSlope.2) := by ring _ = (1 / 2 : ℝ) * (xa.im - xa.re) := by rw [hFplusIm', hAIm', ha10Im, ha01Im] push_cast @@ -1233,7 +1224,7 @@ private theorem hFminusSlopeAt641 : let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - ∀ (rootSlope : ℝ × ℝ), (rootSlope = F.outer_slope) → (F.minus_slope - rootSlope = (1 / 2 + ∀ (rootSlope : ℝ × ℝ), (rootSlope = F.outerSlope) → (F.minusSlope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) ) := by classical @@ -1251,8 +1242,8 @@ private theorem hFminusReAt646 : let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - ∀ (rootSlope : ℝ × ℝ), (F.minus_slope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) → (F.minus_slope.1 - + ∀ (rootSlope : ℝ × ℝ), (F.minusSlope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) → (F.minusSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).re : ℝ) - ((BandVectors.2 (r 0) (r 1)).re : ℝ))) ) := by classical @@ -1270,8 +1261,8 @@ private theorem hFminusImAt652 : let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - ∀ (rootSlope : ℝ × ℝ), (F.minus_slope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) → (F.minus_slope.2 - + ∀ (rootSlope : ℝ × ℝ), (F.minusSlope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) → (F.minusSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).im : ℝ) - ((BandVectors.2 (r 0) (r 1)).im : ℝ))) ) := by classical @@ -1295,33 +1286,33 @@ private theorem hdirectSlope : ∀ (joinSlope : ℝ × ℝ), ∀ (rootSlope : ℝ × ℝ), (joinSlope.2 - rootSlope.2 = -(1 / 2 : ℝ) * ((↑wa.im : ℝ) + (↑wa.re : ℝ))) → ((joinSlope.1 - rootSlope.1 = -(1 / 2 : ℝ) * ((↑wa.re : ℝ) - (↑wa.im : ℝ))) → (((↑wa.re : ℝ) + (↑xa.re : ℝ) + (↑ya.re : ℝ) = (0 : - ℝ)) → (((↑wa.im : ℝ) + (↑xa.im : ℝ) + (↑ya.im : ℝ) = (0 : ℝ)) → ((F.minus_slope.1 - + ℝ)) → (((↑wa.im : ℝ) + (↑xa.im : ℝ) + (↑ya.im : ℝ) = (0 : ℝ)) → ((F.minusSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ)))).re : ℝ) - (↑(BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).re : - ℝ))) → ((F.minus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (r (1 : Fin + ℝ))) → ((F.minusSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ)))).im : ℝ) - (↑(BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im : ℝ))) → ((((BandVectors.2 (r 1) (r 0)).re : ℝ) = (xa.re : ℝ) - (ya.im : ℝ)) → ((((BandVectors.2 (r 1) (r 0)).im : ℝ) = (xa.im : ℝ) + (ya.re : ℝ)) → ((((BandVectors.2 (r 0) (r 1)).re : ℝ) = (xa.im : ℝ) + (ya.re : ℝ)) → ((((BandVectors.2 (r 0) (r 1)).im : ℝ) = -(xa.re : ℝ) + (ya.im : ℝ)) → (joinSlope - - F.minus_slope = GaussianRealPoint ya)))))))))) ) := by + F.minusSlope = GaussianRealPoint ya)))))))))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r wa xa ya joinSlope rootSlope hjoinSlopeIm hjoinSlopeRe hasumReR hasumImR hFminusRe hFminusIm ha10ReR ha10ImR ha01ReR ha01ImR apply Prod.ext · calc - joinSlope.1 - F.minus_slope.1 = + joinSlope.1 - F.minusSlope.1 = (joinSlope.1 - rootSlope.1) - - (F.minus_slope.1 - rootSlope.1) := by ring + (F.minusSlope.1 - rootSlope.1) := by ring _ = (ya.re : ℝ) := by rw [hjoinSlopeRe, hFminusRe, ha10ReR, ha01ReR] linarith [hasumReR, hasumImR] · calc - joinSlope.2 - F.minus_slope.2 = + joinSlope.2 - F.minusSlope.2 = (joinSlope.2 - rootSlope.2) - - (F.minus_slope.2 - rootSlope.2) := by ring + (F.minusSlope.2 - rootSlope.2) := by ring _ = (ya.im : ℝ) := by rw [hjoinSlopeIm, hFminusIm, ha10ImR, ha01ImR] @@ -1407,13 +1398,13 @@ private theorem hleftAdjacent : let join : ProtoTile := TileTranslation base (u + y) (TileOdometer C.1.1 join (D.functions F.slot false)) → (∀ (joinSlope : ℝ × ℝ), (PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → ((r 1 = p 2) → - ((r 2 = p 3) → ((joinSlope - F.minus_slope = GaussianRealPoint ya) → ((TileCentroid + ((r 2 = p 3) → ((joinSlope - F.minusSlope = GaussianRealPoint ya) → ((TileCentroid join - TileCentroid Rminus = GaussianRealPoint y) → ((t 0 = C.1.1) → (LeftLatticeAdjacent C Rminus join hminus (D.functions F.slot false))))))))))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F D p t ht ht0 ht1 r y ya u join hjoinOdo joinSlope hjoinSlope hr1 hr2 hdirectSlope hleftCent htC - refine ⟨F.minus_odo, hjoinOdo, F.minus_slope, joinSlope, + refine ⟨F.minus_odo, hjoinOdo, F.minusSlope, joinSlope, F.slope_minus, hjoinSlope, ?_⟩ right refine ⟨t, 0, true, ht, htC, ?_, ?_, ?_⟩ @@ -1588,7 +1579,7 @@ private theorem leftString : 0) → ((F.q (a + 1).succ = p 2) → ((F.q (a + 2).succ = p 3) → (∀ (rootNeg : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (PartialOdometerSlope F.odometer = some rootNeg) → (∀ (hjoinSlope : PartialOdometerSlope (D.functions F.slot false) = some - joinSlope), (rootNeg = F.outer_slope) → (∀ (hSB : F.slot = a + (1 : Fin + joinSlope), (rootNeg = F.outerSlope) → (∀ (hSB : F.slot = a + (1 : Fin (3 : ℕ))), (r 1 = p 2) → ((r 2 = p 3) → ((r 3 = p 0) → ((F.q a.succ = p 0) → ((0 < (F.q a.succ).1) → (∀ (rootSlope : ℝ × ℝ), (joinSlope.2 - rootSlope.2 = -(1 / 2 : ℝ) * ((↑wa.im : ℝ) + (↑wa.re : @@ -1602,7 +1593,7 @@ private theorem leftString : true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : - ℕ))).succ)).re : ℝ))) → ((rootSlope = F.outer_slope) → ( + ℕ))).succ)).re : ℝ))) → ((rootSlope = F.outerSlope) → ( let outerA : BandCircle := ⟨⟨p 0, ⟨Or.inl (ProperBandCurvatureStructure p hp).1, ⟨p, hp.1, 0, rfl⟩⟩⟩, (ProperBandCurvatureStructure p hp).1⟩ @@ -1625,13 +1616,13 @@ private theorem leftString : (↑xa.re : ℝ) + (↑ya.re : ℝ) = (0 : ℝ)) → (((↑wa.im : ℝ) + (↑xa.im : ℝ) + (↑ya.im : ℝ) = (0 : ℝ)) → (∀ (hminusSlopeOffset : joinSlope - aSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : - ℕ))) - BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))))), (F.plus_slope - + ℕ))) - BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))))), (F.plusSlope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 - : ℕ))))) → ((F.plus_slope.1 - rootSlope.1 = (1 / 2 : ℝ) * + : ℕ))))) → ((F.plusSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * (((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))))).re + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 - (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))))).re)) → ((F.plus_slope.2 - + (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))))).re)) → ((F.plusSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * (((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))))).im + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 @@ -1643,13 +1634,13 @@ private theorem leftString : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) + BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ)))).re = xa.re + xa.im) → (((BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) + BandVectors.2 (p (0 : - Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ)))).im = xa.im - xa.re) → ((F.plus_slope.1 - + Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ)))).im = xa.im - xa.re) → ((F.plusSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ)))).re : ℝ) + (↑(BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin - (4 : ℕ)))).re : ℝ))) → ((F.plus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) * + (4 : ℕ)))).re : ℝ))) → ((F.plusSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ)))).im : ℝ) + (↑(BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im : ℝ))) → (∀ - (hplusSlopeOffset : F.plus_slope - aSlope = (1 / 2 : ℝ) • GaussianRealPoint + (hplusSlopeOffset : F.plusSlope - aSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) + BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))))), let G : P4458T1BoundaryFrame C orientation base join Rplus @@ -1698,9 +1689,9 @@ private theorem leftString : apply Prod.ext <;> simp [GaussianRealPoint, I, Prod.smul_mk, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring - outer_slope := aSlope - minus_slope := joinSlope - plus_slope := F.plus_slope + outerSlope := aSlope + minusSlope := joinSlope + plusSlope := F.plusSlope slope_outer := haSlope slope_minus := hjoinSlope slope_plus := F.slope_plus @@ -1709,18 +1700,18 @@ private theorem leftString : } (G.outer.1.1 = F.q a.succ) → ((P4458T1BoundarySide F join Rplus (D.functions F.slot false) hplus) → - ((F.minus_slope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r (1 : + ((F.minusSlope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin - (4 : ℕ))))) → ((F.minus_slope.1 - rootSlope.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (r (1 + (4 : ℕ))))) → ((F.minusSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ)))).re : ℝ) - (↑(BandVectors.2 (r (0 : Fin (4 : - ℕ))) (r (1 : Fin (4 : ℕ)))).re : ℝ))) → ((F.minus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) + ℕ))) (r (1 : Fin (4 : ℕ)))).re : ℝ))) → ((F.minusSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ)))).im : ℝ) - (↑(BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im : ℝ))) → ((((BandVectors.2 (r 1) (r 0)).re : ℝ) = (xa.re : ℝ) - (ya.im : ℝ)) → ((((BandVectors.2 (r 1) (r 0)).im : ℝ) = (xa.im : ℝ) + (ya.re : ℝ)) → ((((BandVectors.2 (r 0) (r 1)).re : ℝ) = (xa.im : ℝ) + (ya.re : ℝ)) → ((((BandVectors.2 (r 0) (r 1)).im : ℝ) = -(xa.re : ℝ) + (ya.im : ℝ)) → ((joinSlope - - F.minus_slope = GaussianRealPoint ya) → ((TileCentroid join - TileCentroid Rminus = + F.minusSlope = GaussianRealPoint ya) → ((TileCentroid join - TileCentroid Rminus = GaussianRealPoint y) → ((TileTouching Rminus join) → ((LeftLatticeAdjacent C Rminus join hminus (D.functions F.slot false)) → ((Rminus.cells.Nonempty) → ((join.cells.Nonempty) → ((Rminus ≠ join) → ((C.1.1.1 ≠ 1) → (TileString C @@ -2353,7 +2344,7 @@ private theorem hFminusSlopeAt991 : let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - ∀ (rootA : ℝ × ℝ), (rootA = F.outer_slope) → (F.minus_slope - rootA = (1 / 2 : ℝ) • + ∀ (rootA : ℝ × ℝ), (rootA = F.outerSlope) → (F.minusSlope - rootA = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r rootA hrootAEq @@ -2370,8 +2361,8 @@ private theorem hFminusReAt996 : let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - ∀ (rootA : ℝ × ℝ), (F.minus_slope - rootA = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) → (F.minus_slope.1 - rootA.1 + ∀ (rootA : ℝ × ℝ), (F.minusSlope - rootA = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) → (F.minusSlope.1 - rootA.1 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).re : ℝ) - ((BandVectors.2 (r 0) (r 1)).re : ℝ))) ) := by classical @@ -2389,8 +2380,8 @@ private theorem hFminusImAt1002 : let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - ∀ (rootA : ℝ × ℝ), (F.minus_slope - rootA = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) → (F.minus_slope.2 - rootA.2 + ∀ (rootA : ℝ × ℝ), (F.minusSlope - rootA = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) → (F.minusSlope.2 - rootA.2 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).im : ℝ) - ((BandVectors.2 (r 0) (r 1)).im : ℝ))) ) := by classical @@ -2419,18 +2410,18 @@ private theorem hleftAslopeMinus : ((((BandVectors.2 (r 0) (r 1)).im : ℝ) = -(xa.re : ℝ) + (ya.im : ℝ)) → ((((BandVectors.2 (p 0) (p 3)).re : ℝ) = ((BandVectors.2 (p 3) (p 0)).im : ℝ)) → ((((BandVectors.2 (p 0) (p 3)).im : ℝ) = -((BandVectors.2 (p 3) (p 0)).re : ℝ)) → - ((F.minus_slope.1 - rootA.1 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).re : ℝ) - - ((BandVectors.2 (r 0) (r 1)).re : ℝ))) → ((F.minus_slope.2 - rootA.2 = (1 / 2 : ℝ) * + ((F.minusSlope.1 - rootA.1 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).re : ℝ) - + ((BandVectors.2 (r 0) (r 1)).re : ℝ))) → ((F.minusSlope.2 - rootA.2 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).im : ℝ) - ((BandVectors.2 (r 0) (r 1)).im : ℝ))) → - (F.minus_slope - slopeA = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p 3) (p 0) + (F.minusSlope - slopeA = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p 3) (p 0) - BandVectors.2 (p 0) (p 3))))))))))))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F p r xa ya rootA slopeA hARe' hAIm' hyaA ha10ReR ha10ImR ha01ReR ha01ImR hRotAReR hRotAImR hFminusRe hFminusIm apply Prod.ext · calc - F.minus_slope.1 - slopeA.1 = - (F.minus_slope.1 - rootA.1) - + F.minusSlope.1 - slopeA.1 = + (F.minusSlope.1 - rootA.1) - (slopeA.1 - rootA.1) := by ring _ = (1 / 2 : ℝ) * (((BandVectors.2 (p 3) (p 0)).re : ℝ) - @@ -2443,8 +2434,8 @@ private theorem hleftAslopeMinus : simp [GaussianRealPoint, Prod.smul_mk, Zsqrtd.re_sub, Int.cast_sub] · calc - F.minus_slope.2 - slopeA.2 = - (F.minus_slope.2 - rootA.2) - + F.minusSlope.2 - slopeA.2 = + (F.minusSlope.2 - rootA.2) - (slopeA.2 - rootA.2) := by ring _ = (1 / 2 : ℝ) * (((BandVectors.2 (p 3) (p 0)).im : ℝ) - @@ -2923,7 +2914,7 @@ private theorem hFplusSlopeB : let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - ∀ (rootB : ℝ × ℝ), (rootB = F.outer_slope) → (F.plus_slope - rootB = (1 / 2 : ℝ) • + ∀ (rootB : ℝ × ℝ), (rootB = F.outerSlope) → (F.plusSlope - rootB = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r rootB hrootBEq @@ -2940,8 +2931,8 @@ private theorem hFplusReB : let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - ∀ (rootB : ℝ × ℝ), (F.plus_slope - rootB = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 - (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) → (F.plus_slope.1 - rootB.1 = (1 / 2 : ℝ) * + ∀ (rootB : ℝ × ℝ), (F.plusSlope - rootB = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 + (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) → (F.plusSlope.1 - rootB.1 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).re : ℝ) + ((BandVectors.2 (r 0) (r 1)).re : ℝ))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r rootB hFplusSlopeB @@ -2958,8 +2949,8 @@ private theorem hFplusImB : let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - ∀ (rootB : ℝ × ℝ), (F.plus_slope - rootB = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 - (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) → (F.plus_slope.2 - rootB.2 = (1 / 2 : ℝ) * + ∀ (rootB : ℝ × ℝ), (F.plusSlope - rootB = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 + (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) → (F.plusSlope.2 - rootB.2 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).im : ℝ) + ((BandVectors.2 (r 0) (r 1)).im : ℝ))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r rootB hFplusSlopeB @@ -3064,11 +3055,11 @@ private theorem hrightBplusSlope : ℝ)) → ((((BandVectors.2 (r 0) (r 1)).re : ℝ) = (xa.im : ℝ) + (ya.re : ℝ)) → ((((BandVectors.2 (r 0) (r 1)).im : ℝ) = -(xa.re : ℝ) + (ya.im : ℝ)) → ((slopeB.1 - rootB.1 = (1 / 2 : ℝ) * ((ya.re : ℝ) - (ya.im : ℝ))) → ((slopeB.2 - rootB.2 = (1 / 2 - : ℝ) * ((ya.im : ℝ) + (ya.re : ℝ))) → ((F.plus_slope.1 - rootB.1 = (1 / 2 : ℝ) * + : ℝ) * ((ya.im : ℝ) + (ya.re : ℝ))) → ((F.plusSlope.1 - rootB.1 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).re : ℝ) + ((BandVectors.2 (r 0) (r 1)).re : ℝ))) → - ((F.plus_slope.2 - rootB.2 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).im : ℝ) + + ((F.plusSlope.2 - rootB.2 = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).im : ℝ) + ((BandVectors.2 (r 0) (r 1)).im : ℝ))) → ((BandVectors.2 (t 1) (t 0) = xa) → - ((BandVectors.2 (t 0) (t 1) = -I * xa) → (F.plus_slope - slopeB = (1 / 2 : ℝ) • + ((BandVectors.2 (t 0) (t 1) = -I * xa) → (F.plusSlope - slopeB = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (t 1) (t 0) + BandVectors.2 (t 0) (t 1)))))))))))) ) := by classical @@ -3076,8 +3067,8 @@ private theorem hrightBplusSlope : ha01ReR ha01ImR hBRe' hBIm' hFplusReB hFplusImB hTvecA hTflipA apply Prod.ext · calc - F.plus_slope.1 - slopeB.1 = - (F.plus_slope.1 - rootB.1) - (slopeB.1 - rootB.1) := by ring + F.plusSlope.1 - slopeB.1 = + (F.plusSlope.1 - rootB.1) - (slopeB.1 - rootB.1) := by ring _ = (1 / 2 : ℝ) * ((xa.re : ℝ) + (xa.im : ℝ)) := by rw [hFplusReB, hBRe', ha10ReR, ha01ReR] ring @@ -3092,8 +3083,8 @@ private theorem hrightBplusSlope : simp [GaussianRealPoint, Zsqrtd.re_add, Int.cast_add] · calc - F.plus_slope.2 - slopeB.2 = - (F.plus_slope.2 - rootB.2) - (slopeB.2 - rootB.2) := by ring + F.plusSlope.2 - slopeB.2 = + (F.plusSlope.2 - rootB.2) - (slopeB.2 - rootB.2) := by ring _ = (1 / 2 : ℝ) * ((xa.im : ℝ) - (xa.re : ℝ)) := by rw [hFplusImB, hBIm', ha10ImR, ha01ImR] ring @@ -3144,7 +3135,7 @@ private theorem hrightAnc : TileCentroid (D.tiles (a + 1) true) = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (t 1) (t 0) + BandVectors.1 (t 0) (t 1))), ∀ (hrightBminusSlope : joinSlope - slopeB = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (t 1) (t 0) - BandVectors.2 (t 0) (t - 1))), ∀ (hrightBplusSlope : F.plus_slope - slopeB = (1 / 2 : ℝ) • GaussianRealPoint + 1))), ∀ (hrightBplusSlope : F.plusSlope - slopeB = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (t 1) (t 0) + BandVectors.2 (t 0) (t 1))), let Gright : P4458T1BoundaryFrame C orientation base join Rplus (D.functions F.slot false) hplus := { @@ -3168,9 +3159,9 @@ private theorem hrightAnc : exact olderChart hSD (by simpa only [ht1C] using hunit) minus_centroid := hrightBminus plus_centroid := hrightBplus - outer_slope := slopeB - minus_slope := joinSlope - plus_slope := F.plus_slope + outerSlope := slopeB + minusSlope := joinSlope + plusSlope := F.plusSlope slope_outer := hslopeB slope_minus := hjoinSlope slope_plus := F.slope_plus @@ -3405,7 +3396,7 @@ private theorem firstParentPlacement : (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).re : ℝ))) → - ((rootNeg = F.outer_slope) → ((F.slot = a + (1 : Fin (3 : ℕ))) → ((r 1 = p 2) → ((r 2 + ((rootNeg = F.outerSlope) → ((F.slot = a + (1 : Fin (3 : ℕ))) → ((r 1 = p 2) → ((r 2 = p 3) → ((r 3 = p 0) → (∀ (hApos : 0 < (p 0).1), (F.q a.succ = p 0) → ((0 < (F.q a.succ).1) → (∀ (rootSlope : ℝ × ℝ), ∀ (aSlope : ℝ × ℝ), (PartialOdometerSlope F.odometer = some rootSlope) → ((PartialOdometerSlope (D.functions a true) = some @@ -3416,7 +3407,7 @@ private theorem firstParentPlacement : (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((rootSlope - = F.outer_slope) → ( + = F.outerSlope) → ( let directOuter : BandCircle := ⟨⟨p 0, ⟨Or.inl hApos, ⟨p, hp.1, 0, rfl⟩⟩⟩, hApos⟩ (directOuter.1.1 = F.q a.succ) → ((p 2 = C.1.1) → ((TileOdometer (p 0) (D.tiles a true) @@ -3471,7 +3462,7 @@ private theorem firstParentPlacement : ℕ))).succ] (1 : Fin (4 : ℕ)))).im = (0 : ℤ)) → (((wa.re : ℝ) + (xa.re : ℝ) + (ya.re : ℝ) = 0) → (((wa.im : ℝ) + (xa.im : ℝ) + (ya.im : ℝ) = 0) → ((joinSlope - aSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : - ℕ))) - BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))))) → ((F.plus_slope - + ℕ))) - BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))))) → ((F.plusSlope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot @@ -3479,7 +3470,7 @@ private theorem firstParentPlacement : + BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + - (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))))) → ((F.plus_slope.1 - rootSlope.1 = (1 / + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))))) → ((F.plusSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * (((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q @@ -3488,7 +3479,7 @@ private theorem firstParentPlacement : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : - ℕ))).succ] (1 : Fin (4 : ℕ))))).re)) → ((F.plus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) * + ℕ))).succ] (1 : Fin (4 : ℕ))))).re)) → ((F.plusSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * (((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot @@ -3559,7 +3550,7 @@ private theorem firstParentPlacement : F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : - ℕ)))).re) → ((F.plus_slope.1 - rootSlope.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q + ℕ)))).re) → ((F.plusSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : @@ -3567,7 +3558,7 @@ private theorem firstParentPlacement : F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : - ℕ)))).re : ℝ))) → ((F.plus_slope.2 - rootSlope.2 = (1 / 2 : ℝ) * ((↑(BandVectors.2 + ℕ)))).re : ℝ))) → ((F.plusSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : @@ -3575,7 +3566,7 @@ private theorem firstParentPlacement : F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : - ℕ)))).im : ℝ))) → ((F.plus_slope - aSlope = (1 / 2 : ℝ) • GaussianRealPoint + ℕ)))).im : ℝ))) → ((F.plusSlope - aSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) + BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))))) → (Nonempty (P4458T1BoundaryPlacement F D))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) @@ -3639,9 +3630,9 @@ private theorem firstParentPlacement : apply Prod.ext <;> simp [GaussianRealPoint, I, Prod.smul_mk, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring - outer_slope := aSlope - minus_slope := joinSlope - plus_slope := F.plus_slope + outerSlope := aSlope + minusSlope := joinSlope + plusSlope := F.plusSlope slope_outer := haSlope slope_minus := hjoinSlope slope_plus := F.slope_plus @@ -3772,7 +3763,7 @@ private theorem secondParentPlacement : F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : - ℕ)))).re : ℝ))) → ((rootNeg = F.outer_slope) → ((F.slot = a + (2 : Fin (3 : ℕ))) → + ℕ)))).re : ℝ))) → ((rootNeg = F.outerSlope) → ((F.slot = a + (2 : Fin (3 : ℕ))) → ((r 1 = p 3) → ((r 2 = p 0) → ((r 3 = p 2) → (∀ (hApos : 0 < (p 0).1), ((0 : ℤ) < (p (2 : Fin (4 : ℕ))).1) → (∀ (rootA : ℝ × ℝ), ∀ (slopeA : ℝ × ℝ), (PartialOdometerSlope (D.functions a true) = some slopeA) → (∀ (rootB : ℝ × ℝ), ∀ (slopeB : ℝ × ℝ), @@ -3785,7 +3776,7 @@ private theorem secondParentPlacement : : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (1 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + (1 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 - : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((rootB = F.outer_slope) → ( + : Fin (3 : ℕ)) + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((rootB = F.outerSlope) → ( let recursiveOuter : BandCircle := ⟨⟨p 0, ⟨Or.inl hApos, ⟨p, hp.1, 0, rfl⟩⟩⟩, hApos⟩ (recursiveOuter.1.1 = F.q a.succ) → ((TileOdometer (p (0 : Fin (4 : ℕ))) (D.tiles a true) @@ -3816,7 +3807,7 @@ private theorem secondParentPlacement : (ya.re : ℝ)) → ((((BandVectors.2 (r 0) (r 1)).im : ℝ) = -(xa.re : ℝ) + (ya.im : ℝ)) → ((((BandVectors.2 (p 0) (p 3)).re : ℝ) = ((BandVectors.2 (p 3) (p 0)).im : ℝ)) → ((((BandVectors.2 (p 0) (p 3)).im : ℝ) = -((BandVectors.2 (p 3) (p 0)).re : ℝ)) → - ((F.minus_slope.1 - rootA.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : Fin (4 : + ((F.minusSlope.1 - rootA.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 @@ -3824,7 +3815,7 @@ private theorem secondParentPlacement : (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ)))).re : ℝ))) → - ((F.minus_slope.2 - rootA.2 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : Fin (4 : + ((F.minusSlope.2 - rootA.2 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (0 : Fin (4 @@ -3866,9 +3857,9 @@ private theorem secondParentPlacement : minus_centroid := hleftAminus plus_centroid := (SecondNewerRowsGeometry.hleftAplus C orientation base Rminus Rplus hminus hplus F D a p hcenter u hjoinCenterEq hr1 hr2 hleftAminus) - outer_slope := slopeA - minus_slope := F.minus_slope - plus_slope := joinSlope + outerSlope := slopeA + minusSlope := F.minusSlope + plusSlope := joinSlope slope_outer := hslopeA slope_minus := F.slope_minus slope_plus := hjoinSlope @@ -3961,9 +3952,9 @@ private theorem secondParentPlacement : exact olderChart hSD (by simpa only [ht1C] using hunit) minus_centroid := hrightBminus plus_centroid := hrightBplus - outer_slope := slopeB - minus_slope := joinSlope - plus_slope := F.plus_slope + outerSlope := slopeB + minusSlope := joinSlope + plusSlope := F.plusSlope slope_outer := hslopeB slope_minus := hjoinSlope slope_plus := F.slope_plus @@ -4202,7 +4193,7 @@ private theorem directParentCase : (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : ℕ)))).re : ℝ))) → - ((rootNeg = F.outer_slope) → ((F.slot = a + (1 : Fin (3 : ℕ))) → (Nonempty + ((rootNeg = F.outerSlope) → ((F.slot = a + (1 : Fin (3 : ℕ))) → (Nonempty (P4458T1BoundaryPlacement F D))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) ) := by classical @@ -4227,7 +4218,7 @@ private theorem directParentCase : obtain hAzero | ⟨rootSlope, aSlope, hrootSlope, haSlope, hARe, hAIm⟩ := hAdata · rw [hAcoord] at hAzero omega - have hrootSlopeEq : rootSlope = F.outer_slope := + have hrootSlopeEq : rootSlope = F.outerSlope := Option.some.inj (hrootSlope.symm.trans F.slope_outer) let directOuter : BandCircle := ⟨⟨p 0, ⟨Or.inl hApos, ⟨p, hp.1, 0, rfl⟩⟩⟩, hApos⟩ @@ -4385,7 +4376,7 @@ private theorem recursiveParentCase : F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (3 : Fin (4 : ℕ))) (![F.q (0 : Fin (4 : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : - ℕ)))).re : ℝ))) → ((rootNeg = F.outer_slope) → ((F.slot = a + (2 : Fin (3 : ℕ))) → + ℕ)))).re : ℝ))) → ((rootNeg = F.outerSlope) → ((F.slot = a + (2 : Fin (3 : ℕ))) → (Nonempty (P4458T1BoundaryPlacement F D)))))))))))))))))))))))))))) ) := by classical intro C orientation base Rminus Rplus hminus hplus F D a p hp hD t ht ht0 ht1 olderChart r I x @@ -4404,13 +4395,13 @@ private theorem recursiveParentCase : obtain hAzero | ⟨rootA, slopeA, hrootA, hslopeA, hARe, hAIm⟩ := hAdata · rw [hqA] at hAzero omega - have hrootAEq : rootA = F.outer_slope := + have hrootAEq : rootA = F.outerSlope := Option.some.inj (hrootA.symm.trans F.slope_outer) have hBdata := D.slopes (a + 1) true obtain hBzero | ⟨rootB, slopeB, hrootB, hslopeB, hBRe, hBIm⟩ := hBdata · rw [hqB] at hBzero omega - have hrootBEq : rootB = F.outer_slope := + have hrootBEq : rootB = F.outerSlope := Option.some.inj (hrootB.symm.trans F.slope_outer) let recursiveOuter : BandCircle := ⟨⟨p 0, ⟨Or.inl hApos, ⟨p, hp.1, 0, rfl⟩⟩⟩, hApos⟩ @@ -4648,7 +4639,7 @@ theorem P4458T1SecondNewerRows : hplus F D p hCpositive obtain ⟨rootNeg, joinSlope, hrootNeg, hjoinSlope, hjoinSlopeRe, hjoinSlopeIm⟩ := hSlopeInfo - have hrootNegEq : rootNeg = F.outer_slope := + have hrootNegEq : rootNeg = F.outerSlope := Option.some.inj (hrootNeg.symm.trans F.slope_outer) rcases hslot with hSB | hSD · have directParentCase : Nonempty (P4458T1BoundaryPlacement F D) := diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1SmallPairRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1SmallPairRows.lean index 21de3466b5..e6c6db7d47 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1SmallPairRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1SmallPairRows.lean @@ -5,31 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization -public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData -public import LeanPool.ApollonianSuperharmonic.BandOrientedBoundaryOccurrenceGenealogy -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy -public import LeanPool.ApollonianSuperharmonic.CircleMatrix -public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryFrame +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryPlacement -public import LeanPool.ApollonianSuperharmonic.P4458T1BoundarySide -public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily -public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct public import LeanPool.ApollonianSuperharmonic.P4536T1AFrameB public import LeanPool.ApollonianSuperharmonic.P4536T1AFrameD -public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointDifferences public import LeanPool.ApollonianSuperharmonic.P4536T1RegularJoin public import LeanPool.ApollonianSuperharmonic.P4536T1SmallUnitSides diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1ThirdNewerRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1ThirdNewerRows.lean index 0b31e6cfbc..78f6eed31f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1ThirdNewerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1ThirdNewerRows.lean @@ -5,24 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification -public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy -public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryFrame +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryPlacement -public import LeanPool.ApollonianSuperharmonic.P4458T1BoundarySide -public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily -public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.TileString -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.P4536T1AFrameB public import LeanPool.ApollonianSuperharmonic.P4536T1AFrameD public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointDifferences @@ -115,12 +100,12 @@ theorem P4458T1ThirdNewerRows : GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (t 0) (t 1)) := by rw [hcent] simpa only [hslot, idx, hqE, hqB, ht0, ht1] using hright - have hrightDiff : F.plus_slope - s = + have hrightDiff : F.plusSlope - s = GaussianRealPoint (-(⟨0, 1⟩ : GaussianInt) * BandVectors.2 (t 0) (t 1)) := by simpa only [hslot, idx, hqE, hqB, ht0, ht1] using hrightSlope obtain ⟨hstring, hlink⟩ := P4549T1NegativeIncomingSide t ht htC base J Rplus (D.functions F.slot false) hplus F.base_band hfamily F.plus_family - hodo F.plus_odo s F.plus_slope hs F.slope_plus hrightCent hrightDiff + hodo F.plus_odo s F.plusSlope hs F.slope_plus hrightCent hrightDiff exact ⟨⟨J, hcells, hodo, hanc, hocc, .recursive G a houter hancestor, .direct hstring hlink⟩⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean index 9f8eb3b92c..5f298a9e4a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointAlgebra public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: P4536T1AFrameB] @@ -164,7 +165,10 @@ private theorem hcentJ : rw [hslot] at h rw [hslot] at hcent rw [← hcent] at h - fin_cases a <;> simp? [r, I, x] at h ⊢ + fin_cases a <;> simp only [Bool.false_eq_true, ↓reduceIte, one_div, Fin.mk_one, Fin.isValue, + Fin.reduceAdd, Fin.succ_one_eq_two, Fin.succ_zero_eq_one, neg_smul, one_smul, + Fin.reduceSucc, Matrix.cons_val_one, Matrix.cons_val_zero, Matrix.cons_val, + Int.reduceNeg, neg_sub, x, r, I, Fin.reduceFinMk, zero_add, Fin.zero_eta] at h ⊢ all_goals rw [h] ext <;> simp [GaussianRealPoint, @@ -281,10 +285,14 @@ private theorem hcentR : rw [hslot] at h fin_cases a all_goals - simp? [] at h ⊢ + simp only [one_div, Fin.mk_one, Fin.isValue, Fin.reduceAdd, Fin.reduceSucc, + Fin.reduceFinMk, Fin.succ_zero_eq_one, Fin.zero_eta, zero_add, Fin.succ_one_eq_two] + at h ⊢ have hv' := hv have vf' := vflip - simp? [r] at hv' vf' + simp only [Fin.isValue, Fin.mk_one, Fin.succ_one_eq_two, Fin.reduceAdd, Fin.reduceSucc, + Fin.succ_zero_eq_one, Matrix.cons_val, Matrix.cons_val_zero, r, Fin.reduceFinMk, + Fin.zero_eta, zero_add] at hv' vf' rw [hv', vf'] at h simpa [y, w, I, r, GaussianRealPoint, Zsqrtd.re_mul, Zsqrtd.im_mul] using h @@ -469,22 +477,22 @@ private theorem hslopeJ : (D.functions a true)) → ((BandPrototile (p 0) (D.tiles a true)) → ((F.q a.succ = p 0) → ((F.q ((a + 1).succ) = p 2) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (p 2) (p 0) + BandVectors.1 (p 0) (p 2))) → (∀ - (sJ : ℝ × ℝ), (sJ.1 - F.outer_slope.1 = (if false = true then (1 : ℝ) else (-1 : ℝ)) + (sJ : ℝ × ℝ), (sJ.1 - F.outerSlope.1 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) - (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sJ.2 - F.outer_slope.2 = (if false + (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sJ.2 - F.outerSlope.2 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((0 < (F.q a.succ).1) → (∀ (sA : ℝ × ℝ), (PartialOdometerSlope (D.functions a - true) = some sA) → ((sA.1 - F.outer_slope.1 = (if true = true then (1 : ℝ) else (-1 : ℝ)) + true) = some sA) → ((sA.1 - F.outerSlope.1 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + - (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sA.2 - F.outer_slope.2 = (if true = true then (1 + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sA.2 - F.outerSlope.2 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : - ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (sJ - F.outer_slope = (1 / 2 : + ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (sJ - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa))))))))))))))))))))))))))))))))))))))))) := by classical intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J r hr hcoord hA hB hE @@ -496,19 +504,19 @@ private theorem hslopeJ : rw [hslot] fin_cases a <;> simp [r, xa] rw [hJvec] at hreJ himJ - have h1 : sJ.1 - F.outer_slope.1 = + have h1 : sJ.1 - F.outerSlope.1 = -1 * (1 / 2 : ℝ) * ((xa.re : ℝ) - (xa.im : ℝ)) := by simpa using hreJ - have h2 : sJ.2 - F.outer_slope.2 = + have h2 : sJ.2 - F.outerSlope.2 = -1 * (1 / 2 : ℝ) * ((xa.im : ℝ) + (xa.re : ℝ)) := by simpa using himJ apply Prod.ext - · change sJ.1 - F.outer_slope.1 = + · change sJ.1 - F.outerSlope.1 = (1 / 2 : ℝ) * ((-(xa - (-I) * xa)).re : ℝ) rw [h1] simp [I, xa, Zsqrtd.re_mul] ring - · change sJ.2 - F.outer_slope.2 = + · change sJ.2 - F.outerSlope.2 = (1 / 2 : ℝ) * ((-(xa - (-I) * xa)).im : ℝ) rw [h2] simp [I, xa, Zsqrtd.im_mul] @@ -623,14 +631,14 @@ private theorem hslopeA : ((F.q ((a + 1).succ) = p 2) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (p 2) (p 0) + BandVectors.1 (p 0) (p 2))) → (∀ (sJ : ℝ × ℝ), (0 < (F.q a.succ).1) → (∀ (sA : ℝ × ℝ), (PartialOdometerSlope (D.functions - a true) = some sA) → ((sA.1 - F.outer_slope.1 = (if true = true then (1 : ℝ) else (-1 : + a true) = some sA) → ((sA.1 - F.outerSlope.1 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q - (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sA.2 - F.outer_slope.2 = (if true = true + (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sA.2 - F.outerSlope.2 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + (2 : - Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((sJ - F.outer_slope - = (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa))) → (sA - F.outer_slope = (1 / 2 : + Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((sJ - F.outerSlope + = (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa))) → (sA - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (wa - (-I) * wa))))))))))))))))))))))))))))))))))))))) := by classical intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J r hr hcoord hA hB hE @@ -642,13 +650,13 @@ private theorem hslopeA : fin_cases a <;> simp [r, wa] have h1 := hreA have h2 := himA - have h1 : sA.1 - F.outer_slope.1 = (1 / 2 : ℝ) * + have h1 : sA.1 - F.outerSlope.1 = (1 / 2 : ℝ) * (((BandVectors.2 (F.q ((a + 2).succ)) (F.q ((a + 1).succ))).re : ℤ) - ((BandVectors.2 (F.q ((a + 2).succ)) (F.q ((a + 1).succ))).im : ℤ)) := by simpa using hreA - have h2 : sA.2 - F.outer_slope.2 = (1 / 2 : ℝ) * + have h2 : sA.2 - F.outerSlope.2 = (1 / 2 : ℝ) * (((BandVectors.2 (F.q ((a + 2).succ)) (F.q ((a + 1).succ))).im : ℤ) + ((BandVectors.2 (F.q ((a + 2).succ)) @@ -656,9 +664,15 @@ private theorem hslopeA : simpa using himA rw [hslotvec] at h1 h2 apply Prod.ext - · simp? [GaussianRealPoint, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h1 ⊢ + · simp only [one_div, Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, + Prod.fst_sub, GaussianRealPoint, neg_mul, sub_neg_eq_add, Zsqrtd.re_add, Zsqrtd.re_mul, + zero_mul, mul_one, one_mul, zero_add, Int.cast_add, Int.cast_neg, Zsqrtd.im_add, + Zsqrtd.im_mul, Prod.smul_mk, smul_eq_mul, I] at h1 ⊢ exact_mod_cast h1 - · simp? [GaussianRealPoint, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h2 ⊢ + · simp only [one_div, Int.reduceNeg, GaussianInt.intCast_im, GaussianInt.intCast_re, + Prod.snd_sub, GaussianRealPoint, neg_mul, sub_neg_eq_add, Zsqrtd.re_add, Zsqrtd.re_mul, + zero_mul, mul_one, one_mul, zero_add, Int.cast_add, Int.cast_neg, Zsqrtd.im_add, + Zsqrtd.im_mul, Prod.smul_mk, smul_eq_mul, I] at h2 ⊢ exact_mod_cast h2 private theorem hminusSlope : @@ -672,13 +686,13 @@ private theorem hminusSlope : let xa := BandVectors.2 (r 1) (r 3) let ya := BandVectors.2 (r 2) (r 1) (-(xa - -I * xa) - (wa - -I * wa) = ya - -I * ya) → (∀ (sJ : ℝ × ℝ), ∀ (sA : ℝ × ℝ), (sJ - - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa))) → ((sA - - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (wa - (-I) * wa)) → (sJ - sA = (1 / 2 : + F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa))) → ((sA - + F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (wa - (-I) * wa)) → (sJ - sA = (1 / 2 : ℝ) • GaussianRealPoint (ya - (-I) * ya)))) := by classical intro C orientation base Rminus Rplus hminus hplus F a r I wa xa ya aThird sJ sA hslopeJ hslopeA calc - _ = (sJ - F.outer_slope) - (sA - F.outer_slope) := by abel + _ = (sJ - F.outerSlope) - (sA - F.outerSlope) := by abel _ = _ := by rw [hslopeJ, hslopeA] have h := congrArg (fun z : GaussianInt => @@ -795,16 +809,16 @@ private theorem hplusSlopeRoot : ((F.q ((a + 1).succ) = p 2) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (p 2) (p 0) + BandVectors.1 (p 0) (p 2))) → (∀ (sJ : ℝ × ℝ), (0 < (F.q a.succ).1) → (∀ (sA : ℝ × ℝ), (PartialOdometerSlope (D.functions - a true) = some sA) → ((sA.1 - F.outer_slope.1 = (if true = true then (1 : ℝ) else (-1 : + a true) = some sA) → ((sA.1 - F.outerSlope.1 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q - (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sA.2 - F.outer_slope.2 = (if true = true + (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sA.2 - F.outerSlope.2 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + (2 : - Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((sJ - F.outer_slope - = (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa))) → ((sA - F.outer_slope = (1 / 2 : + Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((sJ - F.outerSlope + = (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa))) → ((sA - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (wa - (-I) * wa)) → ((sJ - sA = (1 / 2 : ℝ) • GaussianRealPoint - (ya - (-I) * ya)) → (F.plus_slope - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (ya + + (ya - (-I) * ya)) → (F.plusSlope - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (ya + I * wa + (-I) * (ya + I * wa)))))))))))))))))))))))))))))))))))))))))) := by classical intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J r hr hcoord hA hB hE @@ -817,7 +831,9 @@ private theorem hplusSlopeRoot : all_goals have hIn := ha have hFlip := hflipa - simp? [r] at hIn hFlip h ⊢ + simp only [Fin.isValue, Fin.mk_one, Fin.succ_one_eq_two, Fin.reduceAdd, Fin.reduceSucc, + Fin.succ_zero_eq_one, Matrix.cons_val, Matrix.cons_val_zero, neg_mul, one_div, r, + Fin.reduceFinMk, Fin.zero_eta, zero_add] at hIn hFlip h ⊢ rw [hIn, hFlip] at h simpa [I, ya, wa, GaussianRealPoint, Zsqrtd.re_mul, Zsqrtd.im_mul] using h @@ -834,15 +850,15 @@ private theorem hplusSlope : let halfPoint : GaussianInt → ℝ × ℝ := fun z => (1 / 2 : ℝ) • GaussianRealPoint z (∀ (u : GaussianInt), ∀ (v : GaussianInt), halfPoint u - halfPoint v = halfPoint (u - v)) → - (∀ (sA : ℝ × ℝ), (sA - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (wa - (-I) * wa)) - → ((F.plus_slope - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (ya + I * wa + (-I) * + (∀ (sA : ℝ × ℝ), (sA - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (wa - (-I) * wa)) + → ((F.plusSlope - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (ya + I * wa + (-I) * (ya + I * wa))) → (((ya + I * wa + (-I) * (ya + I * wa)) - (wa - (-I) * wa) = ya + (-I) * - ya) → (F.plus_slope - sA = (1 / 2 : ℝ) • GaussianRealPoint (ya + (-I) * ya))))) := by + ya) → (F.plusSlope - sA = (1 / 2 : ℝ) • GaussianRealPoint (ya + (-I) * ya))))) := by classical intro C orientation base Rminus Rplus hminus hplus F a r I wa ya halfPoint halfPoint_sub sA hslopeA hplusSlopeRoot hplusDelta calc - _ = (F.plus_slope - F.outer_slope) - (sA - F.outer_slope) := by abel + _ = (F.plusSlope - F.outerSlope) - (sA - F.outerSlope) := by abel _ = halfPoint ((ya + I * wa + (-I) * (ya + I * wa)) - (wa - (-I) * wa)) := by @@ -1123,7 +1139,8 @@ private theorem hcentK : classical intro C orientation base Rminus Rplus hminus hplus F D a r I w have h := (D.occurrences a true).2.2 - simp? [r, I, w] at h ⊢ + simp only [↓reduceIte, one_div, Fin.isValue, one_smul, Matrix.cons_val, Int.reduceNeg, w, r, + I] at h ⊢ rw [h] ext <;> simp [GaussianRealPoint, Zsqrtd.re_mul, Zsqrtd.im_mul] @@ -1243,8 +1260,8 @@ private theorem hplusSlopeP : ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] let I : GaussianInt := ⟨0, 1⟩ let ya := BandVectors.2 (r 2) (r 1) - ∀ (sA : ℝ × ℝ), (F.plus_slope - sA = (1 / 2 : ℝ) • GaussianRealPoint (ya + (-I) * ya)) → - ((BandVectors.2 (p 2) (p 0) + BandVectors.2 (p 0) (p 2) = ya + (-I) * ya) → (F.plus_slope + ∀ (sA : ℝ × ℝ), (F.plusSlope - sA = (1 / 2 : ℝ) • GaussianRealPoint (ya + (-I) * ya)) → + ((BandVectors.2 (p 2) (p 0) + BandVectors.2 (p 0) (p 2) = ya + (-I) * ya) → (F.plusSlope - sA = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p 2) (p 0) + BandVectors.2 (p 0) (p 2)))) := by classical @@ -1450,7 +1467,7 @@ theorem P4536T1AFrameB rcases D.slopes F.slot false with hzJ | ⟨rootJ, sJ, hrootJ, hsJ, hreJ, himJ⟩ · have : (F.q F.slot.succ).1 = 0 := hzJ omega - have hrootJeq : rootJ = F.outer_slope := + have hrootJeq : rootJ = F.outerSlope := Option.some.inj (hrootJ.symm.trans F.slope_outer) subst rootJ have hqapos : 0 < (F.q a.succ).1 := AFrameBDetails.hqapos C orientation base Rminus Rplus @@ -1458,16 +1475,16 @@ theorem P4536T1AFrameB rcases D.slopes a true with hzA | ⟨rootA, sA, hrootA, hsA, hreA, himA⟩ · have : (F.q a.succ).1 = 0 := hzA omega - have hrootAeq : rootA = F.outer_slope := + have hrootAeq : rootA = F.outerSlope := Option.some.inj (hrootA.symm.trans F.slope_outer) subst rootA - have hslopeJ : sJ - F.outer_slope = + have hslopeJ : sJ - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa)) := AFrameBProof.hslopeJ C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J hr hcoord hA hB hE hparent laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird aFourth vflip aflip hcentJ hcentK hcentR hcentJK hcentRK hodoK hbandK hAcoord hBcoord hcentRnew sJ hreJ himJ hqapos sA hsA hreA himA - have hslopeA : sA - F.outer_slope = + have hslopeA : sA - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (wa - (-I) * wa) := AFrameBProof.hslopeA C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J hr hcoord hA hB hE hparent laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird aFourth vflip aflip @@ -1501,9 +1518,9 @@ theorem P4536T1AFrameB Rplus hminus hplus F a p hvp (AFrameBDetails.hyv C orientation base Rminus Rplus hminus hplus F a p hAcoord hBcoord))) plus_centroid := hcentRnew - outer_slope := sA - minus_slope := sJ - plus_slope := F.plus_slope + outerSlope := sA + minusSlope := sJ + plusSlope := F.plusSlope slope_outer := hsA slope_minus := hsJ slope_plus := F.slope_plus @@ -1512,7 +1529,7 @@ theorem P4536T1AFrameB Rplus hminus hplus F a p hap hya)) plus_difference := by calc - _ = F.plus_slope - sA := rfl + _ = F.plusSlope - sA := rfl _ = _ := (AFrameBDetails.hplusSlopeP C orientation base Rminus Rplus hminus hplus F a p sA (AFrameBProof.hplusSlope C orientation base Rminus Rplus hminus hplus F a halfPoint_sub sA hslopeA (AFrameBProof.hplusSlopeRoot C orientation base diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean index 20355bfb96..e0ac662e82 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointAlgebra public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: P4536T1AFrameD] @@ -1248,7 +1249,7 @@ private theorem hrootAEq : ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (rootA : ℝ × ℝ), - (PartialOdometerSlope F.odometer = some rootA) → (rootA = F.outer_slope) := by + (PartialOdometerSlope F.odometer = some rootA) → (rootA = F.outerSlope) := by classical intro C orientation base Rminus Rplus hminus hplus F rootA hrootA exact Option.some.inj (hrootA.symm.trans F.slope_outer) @@ -1257,7 +1258,7 @@ private theorem hrootJEq : ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (rootJ : ℝ × ℝ), - (PartialOdometerSlope F.odometer = some rootJ) → (rootJ = F.outer_slope) := by + (PartialOdometerSlope F.odometer = some rootJ) → (rootJ = F.outerSlope) := by classical intro C orientation base Rminus Rplus hminus hplus F rootJ hrootJ exact Option.some.inj (hrootJ.symm.trans F.slope_outer) @@ -1272,22 +1273,22 @@ private theorem slopeK : let wa := BandVectors.2 (r 3) (r 2) let e : GaussianInt := -I (BandVectors.2 (F.q ((a + 2).succ)) (F.q ((a + 1).succ)) = wa) → (∀ (sA : ℝ × ℝ), (sA.1 - - F.outer_slope.1 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + F.outerSlope.1 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : - Fin (3 : ℕ))).succ)).im : ℝ))) → ((sA.2 - F.outer_slope.2 = (if true = true then (1 : ℝ) + Fin (3 : ℕ))).succ)).im : ℝ))) → ((sA.2 - F.outerSlope.2 = (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : - ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (sA - F.outer_slope = + ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (sA - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (wa - e * wa)))) := by classical intro C orientation base Rminus Rplus hminus hplus F a r I wa e hvecA sA hARe hAIm have hre := hARe have him := hAIm rw [hvecA] at hre him - change sA.1 - F.outer_slope.1 = 1 * (1 / 2 : ℝ) * + change sA.1 - F.outerSlope.1 = 1 * (1 / 2 : ℝ) * (((wa.re : ℤ) : ℝ) - ((wa.im : ℤ) : ℝ)) at hre - change sA.2 - F.outer_slope.2 = 1 * (1 / 2 : ℝ) * + change sA.2 - F.outerSlope.2 = 1 * (1 / 2 : ℝ) * (((wa.im : ℤ) : ℝ) + ((wa.re : ℤ) : ℝ)) at him apply Prod.ext · simp [GaussianRealPoint, e, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at hre ⊢ @@ -1305,23 +1306,23 @@ private theorem slopeJ : let ya := BandVectors.2 (r 2) (r 1) let e : GaussianInt := -I (BandVectors.2 (F.q ((F.slot + 2).succ)) (F.q ((F.slot + 1).succ)) = ya) → (∀ (sJ : ℝ × ℝ), - (sJ.1 - F.outer_slope.1 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + (sJ.1 - F.outerSlope.1 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q - (F.slot + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sJ.2 - F.outer_slope.2 = (if false = + (F.slot + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sJ.2 - F.outerSlope.2 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).re : - ℝ))) → (sJ - F.outer_slope = + ℝ))) → (sJ - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (-(ya - e * ya))))) := by classical intro C orientation base Rminus Rplus hminus hplus F a r I ya e hvecJ sJ hJRe hJIm have hre := hJRe have him := hJIm rw [hvecJ] at hre him - change sJ.1 - F.outer_slope.1 = -1 * (1 / 2 : ℝ) * + change sJ.1 - F.outerSlope.1 = -1 * (1 / 2 : ℝ) * (((ya.re : ℤ) : ℝ) - ((ya.im : ℤ) : ℝ)) at hre - change sJ.2 - F.outer_slope.2 = -1 * (1 / 2 : ℝ) * + change sJ.2 - F.outerSlope.2 = -1 * (1 / 2 : ℝ) * (((ya.im : ℤ) : ℝ) + ((ya.re : ℤ) : ℝ)) at him apply Prod.ext · simp [GaussianRealPoint, e, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at hre ⊢ @@ -1342,12 +1343,12 @@ private theorem slopeMinusRoot : (BandVectors.2 (r 3) (r 0) = wa + I * xa) → ((BandVectors.2 (r 0) (r 3) = -I * BandVectors.2 (r 3) (r 0)) → ( let e : GaussianInt := -I - F.minus_slope - F.outer_slope = + F.minusSlope - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint ((wa - e * xa) - e * (wa - e * xa)))))) := by classical intro C orientation base Rminus Rplus hminus hplus F a r hparentR hzero I wa xa ain aflip' e have h := F.minus_difference - change F.minus_slope - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint + change F.minusSlope - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (F.q F.slot.succ) (F.q 0) - BandVectors.2 (F.q 0) (F.q F.slot.succ)) at h rw [hparentR, hzero, aflip', ain] at h @@ -1374,15 +1375,15 @@ private theorem slopeMinusA : {Z : GaussianInt}, (X - Y = Z) → ((1 / 2 : ℝ) • GaussianRealPoint X - (1 / 2 : ℝ) • GaussianRealPoint Y = (1 / 2 : ℝ) • GaussianRealPoint Z)) → ( let e : GaussianInt := -I - ∀ (sA : ℝ × ℝ), (sA - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (wa - e * wa)) → - ((F.minus_slope - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint ((wa - e * xa) - e * - (wa - e * xa))) → (F.minus_slope - sA = + ∀ (sA : ℝ × ℝ), (sA - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (wa - e * wa)) → + ((F.minusSlope - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint ((wa - e * xa) - e * + (wa - e * xa))) → (F.minusSlope - sA = (1 / 2 : ℝ) • GaussianRealPoint (-e * xa - xa))))) := by classical intro C orientation base Rminus Rplus hminus hplus F a r I wa xa ya ha halfDiff e sA slopeK slopeMinusRoot calc - _ = (F.minus_slope - F.outer_slope) - (sA - F.outer_slope) := by abel + _ = (F.minusSlope - F.outerSlope) - (sA - F.outerSlope) := by abel _ = _ := by rw [slopeMinusRoot, slopeK]; exact halfDiff ha.2.2.2.2.1 private theorem slopeJminusA : @@ -1406,15 +1407,15 @@ private theorem slopeJminusA : {Z : GaussianInt}, (X - Y = Z) → ((1 / 2 : ℝ) • GaussianRealPoint X - (1 / 2 : ℝ) • GaussianRealPoint Y = (1 / 2 : ℝ) • GaussianRealPoint Z)) → ( let e : GaussianInt := -I - ∀ (sA : ℝ × ℝ), ∀ (sJ : ℝ × ℝ), (sA - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (wa - e - * wa)) → ((sJ - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint (-(ya - e * ya))) → (sJ - + ∀ (sA : ℝ × ℝ), ∀ (sJ : ℝ × ℝ), (sA - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (wa - e + * wa)) → ((sJ - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (-(ya - e * ya))) → (sJ - sA = (1 / 2 : ℝ) • GaussianRealPoint (-e * xa + xa))))) := by classical intro C orientation base Rminus Rplus hminus hplus F a r I wa xa ya ha halfDiff e sA sJ slopeK slopeJ calc - _ = (sJ - F.outer_slope) - (sA - F.outer_slope) := by abel + _ = (sJ - F.outerSlope) - (sA - F.outerSlope) := by abel _ = _ := by rw [slopeJ, slopeK]; exact halfDiff ha.2.2.2.2.2.1 private theorem centMinusA : @@ -1647,9 +1648,9 @@ theorem P4536T1AFrameD chart := hchart minus_centroid := centMinusA plus_centroid := centJA - outer_slope := sA - minus_slope := F.minus_slope - plus_slope := sJ + outerSlope := sA + minusSlope := F.minusSlope + plusSlope := sJ slope_outer := hsA slope_minus := F.slope_minus slope_plus := hsJ diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1EndpointAlgebra.lean b/LeanPool/ApollonianSuperharmonic/P4536T1EndpointAlgebra.lean index 76406900e5..1af6e10755 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1EndpointAlgebra.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1EndpointAlgebra.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble -public import Mathlib.Tactic.LinearCombination +public import Mathlib.Init public import Mathlib.Tactic.Ring +public import Mathlib.Tactic.LinearCombination + -- [TABLET NODE: P4536T1EndpointAlgebra] /-! diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1EndpointDifferences.lean b/LeanPool/ApollonianSuperharmonic/P4536T1EndpointDifferences.lean index cacf2704c5..627f151e77 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1EndpointDifferences.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1EndpointDifferences.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointAlgebra public import LeanPool.ApollonianSuperharmonic.P4536T1HalfOffsetBridge @@ -35,9 +37,9 @@ theorem P4536T1EndpointDifferences TileCentroid Rplus - TileCentroid (D.tiles F.slot false) = GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) * BandVectors.1 (F.q F.slot.succ) (F.q (F.slot + 2).succ)) ∧ - s - F.minus_slope = + s - F.minusSlope = GaussianRealPoint (BandVectors.2 (F.q (F.slot + 1).succ) (F.q F.slot.succ)) ∧ - F.plus_slope - s = + F.plusSlope - s = GaussianRealPoint (-(⟨0, 1⟩ : GaussianInt) * BandVectors.2 (F.q F.slot.succ) (F.q (F.slot + 2).succ)) := by -- BODY @@ -103,30 +105,30 @@ theorem P4536T1EndpointDifferences have pos : 0 < (F.q F.slot.succ).1 := F.parent ▸ C.2 rcases D.slopes F.slot false with hz | ⟨root, s, hroot, hs, hre, him⟩ · omega - have hrootEq : root = F.outer_slope := Option.some.inj (hroot.symm.trans F.slope_outer) + have hrootEq : root = F.outerSlope := Option.some.inj (hroot.symm.trans F.slope_outer) subst root - have an : s - F.outer_slope = + have an : s - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (-(wa - (-I) * wa)) := by - change s.1 - F.outer_slope.1 = -1 * (1 / 2 : ℝ) * + change s.1 - F.outerSlope.1 = -1 * (1 / 2 : ℝ) * ((wa.re : ℝ) - (wa.im : ℝ)) at hre - change s.2 - F.outer_slope.2 = -1 * (1 / 2 : ℝ) * + change s.2 - F.outerSlope.2 = -1 * (1 / 2 : ℝ) * ((wa.im : ℝ) + (wa.re : ℝ)) at him apply Prod.ext · simp [GaussianRealPoint, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at hre ⊢ linarith [hre] · simp [GaussianRealPoint, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at him ⊢ linarith [him] - have am : F.minus_slope - F.outer_slope = (1 / 2 : ℝ) • + have am : F.minusSlope - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint ((xa - (-I) * ya) - (-I) * (xa - (-I) * ya)) := by have h := F.minus_difference - change F.minus_slope - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint + change F.minusSlope - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1)) at h rw [aflip, laws.2.2.2.1] at h simpa only [sub_neg_eq_add, neg_mul] using h - have ap : F.plus_slope - F.outer_slope = (1 / 2 : ℝ) • + have ap : F.plusSlope - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint ((xa - (-I) * ya) + (-I) * (xa - (-I) * ya)) := by have h := F.plus_difference - change F.plus_slope - F.outer_slope = (1 / 2 : ℝ) • GaussianRealPoint + change F.plusSlope - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r 1) (r 0) + BandVectors.2 (r 0) (r 1)) at h rw [aflip, laws.2.2.2.1] at h simpa only [sub_neg_eq_add, neg_mul] using h @@ -144,13 +146,13 @@ theorem P4536T1EndpointDifferences rw [vp, vn] apply P4536T1HalfOffsetBridge simpa only [sub_neg_eq_add, mul_assoc] using hv.2.1 - · change s - F.minus_slope = GaussianRealPoint ya + · change s - F.minusSlope = GaussianRealPoint ya calc - _ = (s - F.outer_slope) - (F.minus_slope - F.outer_slope) := by abel + _ = (s - F.outerSlope) - (F.minusSlope - F.outerSlope) := by abel _ = _ := by rw [an, am]; exact P4536T1HalfOffsetBridge _ _ _ ha.1 - · change F.plus_slope - s = GaussianRealPoint (-I * xa) + · change F.plusSlope - s = GaussianRealPoint (-I * xa) calc - _ = (F.plus_slope - F.outer_slope) - (s - F.outer_slope) := by abel + _ = (F.plusSlope - F.outerSlope) - (s - F.outerSlope) := by abel _ = _ := by rw [ap, an] apply P4536T1HalfOffsetBridge diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1HalfOffsetBridge.lean b/LeanPool/ApollonianSuperharmonic/P4536T1HalfOffsetBridge.lean index 502e2929dd..36a14c83ae 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1HalfOffsetBridge.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1HalfOffsetBridge.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import Mathlib.Tactic.Linarith -- [TABLET NODE: P4536T1HalfOffsetBridge] diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1RegularJoin.lean b/LeanPool/ApollonianSuperharmonic/P4536T1RegularJoin.lean index 267e0dd107..c25b4e9e47 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1RegularJoin.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1RegularJoin.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique @@ -12,7 +14,6 @@ public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P4536T1RegularJoin] diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1SmallUnitSides.lean b/LeanPool/ApollonianSuperharmonic/P4536T1SmallUnitSides.lean index eeda61b34d..6024e5d4db 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1SmallUnitSides.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1SmallUnitSides.lean @@ -5,12 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointDifferences public import LeanPool.ApollonianSuperharmonic.P4536T1TangentPairMatrix public import LeanPool.ApollonianSuperharmonic.BandOrientedBoundaryOccurrenceGenealogy public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TileString -- [TABLET NODE: P4536T1SmallUnitSides] @@ -150,7 +152,7 @@ theorem P4536T1SmallUnitSides exact hrot have hi : (a + 1) + 1 = a + 2 := by fin_cases a <;> decide rw [hslot, hi, hqD, hqB] at cvL caL - exact unit_side Rminus J hminus _ F.minus_slope s _ _ hu F.minus_odo hodo + exact unit_side Rminus J hminus _ F.minusSlope s _ _ hu F.minus_odo hodo F.minus_family hfamily F.slope_minus hs (steps.1 orientation chart) cvL caL (P4536T1TangentPairMatrix C p hp.1 3 2 (by decide) hc) · intro hslot @@ -171,7 +173,7 @@ theorem P4536T1SmallUnitSides exact hrot have hi : (a + 2) + 2 = a + 1 := by fin_cases a <;> decide rw [hslot, hi, hqD, hqB] at cvR caR - apply unit_side J Rplus _ hplus s F.plus_slope _ _ hu hodo F.plus_odo + apply unit_side J Rplus _ hplus s F.plusSlope _ _ hu hodo F.plus_odo hfamily F.plus_family hs F.slope_plus (steps.2 orientation chart) cvR caR have hm := P4536T1TangentPairMatrix C p hp.1 2 3 (by decide) hc rcases BandVectorOrientationDichotomy (p 3) (p 2) diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1TangentPairMatrix.lean b/LeanPool/ApollonianSuperharmonic/P4536T1TangentPairMatrix.lean index 6b5842f28d..80d3eb7636 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1TangentPairMatrix.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1TangentPairMatrix.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CircleMatrix public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing -public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct -- [TABLET NODE: P4536T1TangentPairMatrix] @@ -64,7 +65,10 @@ theorem P4536T1TangentPairMatrix (C : BandCircle) ring have hre := congrArg Zsqrtd.re hgauss have him := congrArg Zsqrtd.im hgauss - simp? at hre him + simp only [Int.reduceNeg, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.re_star, neg_mul, one_mul, + Zsqrtd.im_star, mul_neg, neg_neg, Zsqrtd.re_ofNat, Nat.cast_ofNat, Zsqrtd.re_intCast, + Zsqrtd.im_ofNat, mul_zero, Zsqrtd.im_intCast, add_zero, Zsqrtd.im_mul, zero_mul, + Zsqrtd.im_add] at hre him rw [hC] at hre him have hrer : ((BandVectors.1 (q i) C.1.1).re : ℝ) + ((C.1.1.2.re : ℝ) * (BandVectors.1 (q i) C.1.1).re + diff --git a/LeanPool/ApollonianSuperharmonic/P4549T1DeeperFrameB.lean b/LeanPool/ApollonianSuperharmonic/P4549T1DeeperFrameB.lean index 60928d711f..143f62f188 100644 --- a/LeanPool/ApollonianSuperharmonic/P4549T1DeeperFrameB.lean +++ b/LeanPool/ApollonianSuperharmonic/P4549T1DeeperFrameB.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointAlgebra -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws @@ -125,9 +126,9 @@ theorem P4549T1DeeperFrameB ext <;> simp [GaussianRealPoint, y, I, Zsqrtd.re_mul, Zsqrtd.im_mul] rcases D.slopes F.slot false with hz | ⟨root, sJ, hroot, hsJ, hre, him⟩ · omega - have hrootEq : root = F.outer_slope := Option.some.inj (hroot.symm.trans F.slope_outer) + have hrootEq : root = F.outerSlope := Option.some.inj (hroot.symm.trans F.slope_outer) subst root - have an : sJ - F.outer_slope = + have an : sJ - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa)) := by rw [hslot, idx3, idx4, hqA, hqE] at hre him apply Prod.ext <;> @@ -135,15 +136,15 @@ theorem P4549T1DeeperFrameB linarith rcases D.slopes (a + 2) true with hz | ⟨root, sE, hroot, hsE, hre, him⟩ · omega - have hrootEq : root = F.outer_slope := Option.some.inj (hroot.symm.trans F.slope_outer) + have hrootEq : root = F.outerSlope := Option.some.inj (hroot.symm.trans F.slope_outer) subst root - have ae : sE - F.outer_slope = + have ae : sE - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (ya - (-I) * ya) := by rw [idx1, idx2, hqA, hqB] at hre him apply Prod.ext <;> simp [GaussianRealPoint, ya, I, Zsqrtd.re_mul, Zsqrtd.im_mul] at hre him ⊢ <;> linarith - have am : F.minus_slope - F.outer_slope = (1 / 2 : ℝ) • + have am : F.minusSlope - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint ((ya - (-I) * wa) - (-I) * (ya - (-I) * wa)) := by rw [F.minus_difference, aflip, arec] have vmE : TileCentroid Rminus - TileCentroid (D.tiles (a + 2) true) = @@ -158,14 +159,14 @@ theorem P4549T1DeeperFrameB _ = (TileCentroid J - TileCentroid F.tile) - (TileCentroid (D.tiles (a + 2) true) - TileCentroid F.tile) := by abel _ = _ := by rw [vn, ve]; exact half_sub _ _ _ hv.2 - have amE : F.minus_slope - sE = + have amE : F.minusSlope - sE = (1 / 2 : ℝ) • GaussianRealPoint (za - wa) := by calc - _ = (F.minus_slope - F.outer_slope) - (sE - F.outer_slope) := by abel + _ = (F.minusSlope - F.outerSlope) - (sE - F.outerSlope) := by abel _ = _ := by rw [am, ae]; exact half_sub _ _ _ ha.1 have anE : sJ - sE = (1 / 2 : ℝ) • GaussianRealPoint (za + wa) := by calc - _ = (sJ - F.outer_slope) - (sE - F.outer_slope) := by abel + _ = (sJ - F.outerSlope) - (sE - F.outerSlope) := by abel _ = _ := by rw [an, ae]; exact half_sub _ _ _ ha.2 let outer : BandCircle := ⟨⟨p 3, Or.inl hEpos, t, ht.1, 0, ht0⟩, hEpos⟩ @@ -190,9 +191,9 @@ theorem P4549T1DeeperFrameB chart := hchart minus_centroid := by simpa only [Fin.succ_zero_eq_one, ht0, ht1, z, w] using vmE plus_centroid := by simpa only [Fin.succ_zero_eq_one, ht0, ht1, z, w] using vnE - outer_slope := sE - minus_slope := F.minus_slope - plus_slope := sJ + outerSlope := sE + minusSlope := F.minusSlope + plusSlope := sJ slope_outer := hsE slope_minus := F.slope_minus slope_plus := hsJ diff --git a/LeanPool/ApollonianSuperharmonic/P4549T1NegativeIncomingSide.lean b/LeanPool/ApollonianSuperharmonic/P4549T1NegativeIncomingSide.lean index 0a665d61af..ba648af319 100644 --- a/LeanPool/ApollonianSuperharmonic/P4549T1NegativeIncomingSide.lean +++ b/LeanPool/ApollonianSuperharmonic/P4549T1NegativeIncomingSide.lean @@ -5,12 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TileString -public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: P4549T1NegativeIncomingSide] diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean index 59a588caba..1c0252d7ba 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean @@ -5,23 +5,17 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance -public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.TileCellComplement public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric public import LeanPool.ApollonianSuperharmonic.DiamondBaseT1 public import LeanPool.ApollonianSuperharmonic.DiamondBaseT2 public import LeanPool.ApollonianSuperharmonic.DiamondBaseTouching -public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.DiamondTileGeometry public import LeanPool.ApollonianSuperharmonic.TileArea -- [TABLET NODE: P4564T2DiamondGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondOrderExclusion.lean b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondOrderExclusion.lean index 0d23b3ef16..ba9733dc1b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondOrderExclusion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondOrderExclusion.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2ElementaryQuarterTurn.lean b/LeanPool/ApollonianSuperharmonic/P4564T2ElementaryQuarterTurn.lean index 3f8bfadec3..95a9fbc2ae 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2ElementaryQuarterTurn.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2ElementaryQuarterTurn.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -- [TABLET NODE: P4564T2ElementaryQuarterTurn] diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean index 95a1e73ef0..2dc712231f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean @@ -5,25 +5,17 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance -public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.TileCellComplement public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric public import LeanPool.ApollonianSuperharmonic.FordBaseT1 public import LeanPool.ApollonianSuperharmonic.FordBaseT2 public import LeanPool.ApollonianSuperharmonic.FordBaseTouching -public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.FordTileGeometry -public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration public import LeanPool.ApollonianSuperharmonic.TileArea -- [TABLET NODE: P4564T2FordGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean b/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean index aff370e723..6da23594a1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean @@ -5,23 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordBaseT6 public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse -public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate -public import LeanPool.ApollonianSuperharmonic.FordFareyParameter -public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.FordTileGeometry public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretationCovariance -public import LeanPool.ApollonianSuperharmonic.TileArea -- [TABLET NODE: P4564T2FordT6Transport] @@ -63,7 +55,11 @@ private theorem hlineq : have hparent : ∃ j : Fin 3, (q j.succ).1 = 0 := by cases hor : BandPackingSymmetryReversesOrientation g <;> fin_cases a <;> - simp? [BandPackingSymmetryQuadrupleAction, hor] at hact + simp only [BandPackingSymmetryQuadrupleAction, Fin.isValue, Fin.mk_one, + Fin.succ_one_eq_two, Fin.reduceAdd, Fin.reduceSucc, Fin.succ_zero_eq_one, + Matrix.cons_val_zero, hor, Bool.false_eq_true, ↓reduceIte, Matrix.cons_val_one, + Matrix.cons_val, neg_zero, Matrix.cons_val_succ, Fin.reduceFinMk, Fin.zero_eta, + zero_add] at hact all_goals first | exact ⟨0, (hcurv (q 1)).symm.trans hact⟩ @@ -216,7 +212,9 @@ private theorem horder : have hc : ∀ C, (BandPackingSymmetryCircleAction gN C).1 = C.1 := (BandPackingSymmetryCovariance gN).1 rw [← hr2hat, ← hr0hat] - simp? [BandPackingSymmetryQuadrupleAction, horientationAdapt, hrev, hc, hr2, hr0] + simp only [BandPackingSymmetryQuadrupleAction, Fin.isValue, hr0, horientationAdapt, hrev, + Bool.false_eq_true, ↓reduceIte, Fin.succ_zero_eq_one, Fin.succ_one_eq_two, hr2, + Fin.reduceSucc, Matrix.cons_val, hc, Matrix.cons_val_zero, ge_iff_le] exact h12 private theorem hlarge' : @@ -235,7 +233,9 @@ private theorem hlarge' : have hc : ∀ C, (BandPackingSymmetryCircleAction gN C).1 = C.1 := (BandPackingSymmetryCovariance gN).1 rw [← hr2hat] - simp? [BandPackingSymmetryQuadrupleAction, horientationAdapt, hrev, hc, hr2] + simp only [BandPackingSymmetryQuadrupleAction, Fin.isValue, horientationAdapt, hrev, + Bool.false_eq_true, ↓reduceIte, Fin.succ_zero_eq_one, Fin.succ_one_eq_two, hr2, + Fin.reduceSucc, Matrix.cons_val, hc, gt_iff_lt] exact hlarge private theorem hT' : diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean b/LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean index b9973febdd..fa79da2014 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean @@ -5,16 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRawSupport public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.P4055T1PackingGridEquivalence -- [TABLET NODE: P4564T2GeneralT6Transport] diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2GeometryPullback.lean b/LeanPool/ApollonianSuperharmonic/P4564T2GeometryPullback.lean index 48236d2e32..26a9892801 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2GeometryPullback.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2GeometryPullback.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandParentRotationOccurrenceCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport diff --git a/LeanPool/ApollonianSuperharmonic/P4566T1LiteralSuccessorCharts.lean b/LeanPool/ApollonianSuperharmonic/P4566T1LiteralSuccessorCharts.lean index 9c3ea038b3..b7b1cba0db 100644 --- a/LeanPool/ApollonianSuperharmonic/P4566T1LiteralSuccessorCharts.lean +++ b/LeanPool/ApollonianSuperharmonic/P4566T1LiteralSuccessorCharts.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4566T1UnitPairCharts -public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique -- [TABLET NODE: P4566T1LiteralSuccessorCharts] diff --git a/LeanPool/ApollonianSuperharmonic/P4566T1SmallPairCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4566T1SmallPairCoordinates.lean index 2922431845..0aed6a2820 100644 --- a/LeanPool/ApollonianSuperharmonic/P4566T1SmallPairCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4566T1SmallPairCoordinates.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -- [TABLET NODE: P4566T1SmallPairCoordinates] diff --git a/LeanPool/ApollonianSuperharmonic/P4566T1SmallRetainedSides.lean b/LeanPool/ApollonianSuperharmonic/P4566T1SmallRetainedSides.lean index 4124ee7686..7955e541c6 100644 --- a/LeanPool/ApollonianSuperharmonic/P4566T1SmallRetainedSides.lean +++ b/LeanPool/ApollonianSuperharmonic/P4566T1SmallRetainedSides.lean @@ -5,10 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4566T1LiteralSuccessorCharts +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandVectors public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep public import LeanPool.ApollonianSuperharmonic.P4566T1SmallPairCoordinates +public import LeanPool.ApollonianSuperharmonic.P4566T1UnitPairCharts +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique -- [TABLET NODE: P4566T1SmallRetainedSides] diff --git a/LeanPool/ApollonianSuperharmonic/P4566T1StrictRetainedGenealogy.lean b/LeanPool/ApollonianSuperharmonic/P4566T1StrictRetainedGenealogy.lean index 4b36743644..db6569ce44 100644 --- a/LeanPool/ApollonianSuperharmonic/P4566T1StrictRetainedGenealogy.lean +++ b/LeanPool/ApollonianSuperharmonic/P4566T1StrictRetainedGenealogy.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4566T1LiteralSuccessorCharts -public import LeanPool.ApollonianSuperharmonic.BandOrientedBoundaryParentChain -- [TABLET NODE: P4566T1StrictRetainedGenealogy] diff --git a/LeanPool/ApollonianSuperharmonic/P4566T1UnitPairCharts.lean b/LeanPool/ApollonianSuperharmonic/P4566T1UnitPairCharts.lean index d5d24f9802..a637825521 100644 --- a/LeanPool/ApollonianSuperharmonic/P4566T1UnitPairCharts.lean +++ b/LeanPool/ApollonianSuperharmonic/P4566T1UnitPairCharts.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique -public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -- [TABLET NODE: P4566T1UnitPairCharts] @@ -46,7 +47,9 @@ theorem P4566T1UnitPairCharts (1, 1 + 2 * z), (0, -1), (1, 1 + 2 * z + 2 * ⟨0, 1⟩)] := by intro a b hab ha hb hd fin_cases a <;> fin_cases b - all_goals simp? at ha hb hd + all_goals simp only [Int.reduceNeg, Fin.mk_one, Fin.isValue, Fin.succ_one_eq_two, + Matrix.cons_val, zero_ne_one, Fin.reduceFinMk, Fin.reduceSucc, Fin.zero_eta, + Fin.succ_zero_eq_one, Matrix.cons_val_one, Matrix.cons_val_zero] at ha hb hd all_goals try { exact (hab rfl).elim } · exact (noReverse (PrimitiveVectorOrientation.base10 z) hd).elim · exact ⟨UnitOccurrenceOrientation.leftUpper z, UnitOccurrenceOrientation.leftLower z⟩ @@ -55,7 +58,9 @@ theorem P4566T1UnitPairCharts (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * ⟨0, 1⟩), (0, 1)] := by intro a b hab ha hb hd fin_cases a <;> fin_cases b - all_goals simp? at ha hb hd + all_goals simp only [Int.reduceNeg, Fin.mk_one, Fin.isValue, Fin.succ_one_eq_two, + Matrix.cons_val, Fin.reduceFinMk, Fin.reduceSucc, zero_ne_one, Fin.zero_eta, + Fin.succ_zero_eq_one, Matrix.cons_val_one, Matrix.cons_val_zero] at ha hb hd all_goals try { exact (hab rfl).elim } · exact (noReverse (PrimitiveVectorOrientation.base10 z) hd).elim · exact ⟨UnitOccurrenceOrientation.rightLower z, UnitOccurrenceOrientation.rightUpper z⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1CentralDiskSectors.lean b/LeanPool/ApollonianSuperharmonic/P4590T1CentralDiskSectors.lean index 7190161fe6..bf9463cddd 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1CentralDiskSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1CentralDiskSectors.lean @@ -5,14 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4590T1RotationalDiskCenter public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import Mathlib.Tactic.FinCases -- [TABLET NODE: P4590T1CentralDiskSectors] diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean index 62fe629062..c38e713b5d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean @@ -5,27 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralGeometricSectors -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells -public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention -public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn -public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4590T1PositivePrototileDisk -public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry -public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors -public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -public import LeanPool.ApollonianSuperharmonic.P4055T1BandQuarterTurn -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEndpointPairUnique public import LeanPool.ApollonianSuperharmonic.P4616T1ThirdOwnerPathEndpoint -- [TABLET NODE: P4590T1JunctionRefinement] @@ -329,14 +312,15 @@ private theorem classifyBCface : let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ ∀ (F : cert.modified.plane.Face), ((∃ i, cert.modified.plane.faceVertex F i = b) ∧ - ∃ i, cert.modified.plane.faceVertex F i = c) → (cert.modified_face_equiv F = ⟨.I1, 0, - 0⟩ ∨ cert.modified_face_equiv F = ⟨.J3, -1, -1⟩) ) := by + ∃ i, cert.modified.plane.faceVertex F i = c) → (cert.modifiedFaceEquivalence F = + ⟨.I1, 0, + 0⟩ ∨ cert.modifiedFaceEquivalence F = ⟨.J3, -1, -1⟩) ) := by classical intro q cfg C T cert b c F hF obtain ⟨i, hi⟩ := hF.1 obtain ⟨j, hj⟩ := hF.2 rw [cert.modified_face_vertices] at hi hj - generalize hidx : cert.modified_face_equiv F = face at hi hj ⊢ + generalize hidx : cert.modifiedFaceEquivalence F = face at hi hj ⊢ rcases face with ⟨label, m, n⟩ cases label <;> fin_cases i <;> fin_cases j <;> simp [SixSubtileFaceVertices, b, c] at hi hj ⊢ <;> omega @@ -348,12 +332,13 @@ private theorem rhoFace : ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm face)) ) := by classical intro q cfg C T cert F face hF - have hEq : F = cert.modified_face_equiv.symm face := by - have hh := congrArg cert.modified_face_equiv.symm hF + have hEq : F = cert.modifiedFaceEquivalence.symm face := by + have hh := congrArg cert.modifiedFaceEquivalence.symm hF simpa using hh rw [hEq, cert.modified_face_points] @@ -363,9 +348,9 @@ private theorem hfpoint : exact ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (f : cert.modified.plane.Face), ((cert.modified_face_equiv : + T), ∀ (f : cert.modified.plane.Face), ((cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) f = (⟨SixSubtileFaceLabel.I1, (0 - : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) f = (⟨SixSubtileFaceLabel.J3, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( let p1 := cert.unmodified.core.rho @@ -373,7 +358,8 @@ private theorem hfpoint : let pJ := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.J3, -1, -1⟩) (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho f = p1 ∨ cert.modified.rho f = pJ)) ) := by classical @@ -388,9 +374,9 @@ private theorem hgpoint : exact ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (g : cert.modified.plane.Face), ((cert.modified_face_equiv : + T), ∀ (g : cert.modified.plane.Face), ((cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) g = (⟨SixSubtileFaceLabel.I1, (0 - : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) g = (⟨SixSubtileFaceLabel.J3, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( let p1 := cert.unmodified.core.rho @@ -398,7 +384,8 @@ private theorem hgpoint : let pJ := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.J3, -1, -1⟩) (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho g = p1 ∨ cert.modified.rho g = pJ)) ) := by classical @@ -440,7 +427,7 @@ private theorem hJvertex : T), let faceJ : PeriodicSubtileFaceIndex := ⟨.J3, -1, -1⟩ let aJ : PeriodicSubtileIndex := ⟨.A, -1, -1⟩ - cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ) 0 = aJ ) := by + cert.modified.plane.faceVertex (cert.modifiedFaceEquivalence.symm faceJ) 0 = aJ ) := by classical intro q cfg C T cert faceJ aJ rw [cert.modified_face_vertices] @@ -457,11 +444,11 @@ private theorem hpJa : (cert.unmodified.faceEquiv.symm ⟨.J3, -1, -1⟩) let faceJ : PeriodicSubtileFaceIndex := ⟨.J3, -1, -1⟩ let aJ : PeriodicSubtileIndex := ⟨.A, -1, -1⟩ - (cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ) 0 = aJ) → (pJ ∈ + (cert.modified.plane.faceVertex (cert.modifiedFaceEquivalence.symm faceJ) 0 = aJ) → (pJ ∈ FootprintVertices (cert.modified.tile aJ)) ) := by classical intro q cfg C T cert pJ faceJ aJ hJvertex - have h := cert.modified.rho_common (cert.modified_face_equiv.symm faceJ) 0 + have h := cert.modified.rho_common (cert.modifiedFaceEquivalence.symm faceJ) 0 rw [cert.modified_face_points, hJvertex] at h simpa [pJ, faceJ] using h @@ -510,11 +497,11 @@ private theorem hp1C : let faceI : PeriodicSubtileFaceIndex := ⟨.I1, 0, 0⟩ let cI : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ have hvertex : cert.modified.plane.faceVertex - (cert.modified_face_equiv.symm faceI) 2 = cI := by + (cert.modifiedFaceEquivalence.symm faceI) 2 = cI := by rw [cert.modified_face_vertices] simp [faceI, cI, SixSubtileFaceVertices] have h := cert.modified.rho_common - (cert.modified_face_equiv.symm faceI) 2 + (cert.modifiedFaceEquivalence.symm faceI) 2 rw [hvertex, cert.modified_tile, cert.modified_face_points] at h simpa [p1, faceI, cI, ModifiedSubtileOccurrenceInterpretation, TileTranslation, GaussianTranslation, htransZero, Finset.image_id] using h @@ -702,14 +689,14 @@ private theorem classifyADface : let a0 : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ ∀ (F : cert.modified.plane.Face), ((∃ i, cert.modified.plane.faceVertex F i = a0) ∧ - ∃ i, cert.modified.plane.faceVertex F i = d0) → (cert.modified_face_equiv F = ⟨.I2, - 0, 0⟩ ∨ cert.modified_face_equiv F = ⟨.J4, 0, 0⟩) ) := by + ∃ i, cert.modified.plane.faceVertex F i = d0) → (cert.modifiedFaceEquivalence F = ⟨.I2, + 0, 0⟩ ∨ cert.modifiedFaceEquivalence F = ⟨.J4, 0, 0⟩) ) := by classical intro q cfg C T cert a0 d0 F hF obtain ⟨i, hi⟩ := hF.1 obtain ⟨j, hj⟩ := hF.2 rw [cert.modified_face_vertices] at hi hj - generalize hidx : cert.modified_face_equiv F = face at hi hj ⊢ + generalize hidx : cert.modifiedFaceEquivalence F = face at hi hj ⊢ rcases face with ⟨label, m, n⟩ cases label <;> fin_cases i <;> fin_cases j <;> simp [SixSubtileFaceVertices, a0, d0] at hi hj ⊢ <;> omega @@ -721,12 +708,13 @@ private theorem rhoFace2 : ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm face)) ) := by classical intro q cfg C T cert F face hF - have hEq : F = cert.modified_face_equiv.symm face := by - have hh := congrArg cert.modified_face_equiv.symm hF + have hEq : F = cert.modifiedFaceEquivalence.symm face := by + have hh := congrArg cert.modifiedFaceEquivalence.symm hF simpa using hh rw [hEq, cert.modified_face_points] @@ -736,9 +724,9 @@ private theorem hf2point : exact ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (f2 : cert.modified.plane.Face), ((cert.modified_face_equiv : + T), ∀ (f2 : cert.modified.plane.Face), ((cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) f2 = (⟨SixSubtileFaceLabel.I2, - (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) f2 = (⟨SixSubtileFaceLabel.J4, (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( let p2 := cert.unmodified.core.rho @@ -746,7 +734,8 @@ private theorem hf2point : let pJ4 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.J4, 0, 0⟩) (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho f2 = p2 ∨ cert.modified.rho f2 = pJ4)) ) := by classical @@ -761,9 +750,9 @@ private theorem hg2point : exact ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (g2 : cert.modified.plane.Face), ((cert.modified_face_equiv : + T), ∀ (g2 : cert.modified.plane.Face), ((cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) g2 = (⟨SixSubtileFaceLabel.I2, - (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) g2 = (⟨SixSubtileFaceLabel.J4, (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( let p2 := cert.unmodified.core.rho @@ -771,7 +760,8 @@ private theorem hg2point : let pJ4 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.J4, 0, 0⟩) (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho g2 = p2 ∨ cert.modified.rho g2 = pJ4)) ) := by classical @@ -813,7 +803,7 @@ private theorem hJ4vertex : T), let faceJ4 : PeriodicSubtileFaceIndex := ⟨.J4, 0, 0⟩ let bJ4 : PeriodicSubtileIndex := ⟨.B, 1, 1⟩ - cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ4) 1 = bJ4 ) := by + cert.modified.plane.faceVertex (cert.modifiedFaceEquivalence.symm faceJ4) 1 = bJ4 ) := by classical intro q cfg C T cert faceJ4 bJ4 rw [cert.modified_face_vertices] @@ -830,11 +820,11 @@ private theorem hpJ4b : (cert.unmodified.faceEquiv.symm ⟨.J4, 0, 0⟩) let faceJ4 : PeriodicSubtileFaceIndex := ⟨.J4, 0, 0⟩ let bJ4 : PeriodicSubtileIndex := ⟨.B, 1, 1⟩ - (cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ4) 1 = bJ4) → (pJ4 ∈ + (cert.modified.plane.faceVertex (cert.modifiedFaceEquivalence.symm faceJ4) 1 = bJ4) → (pJ4 ∈ FootprintVertices (cert.modified.tile bJ4)) ) := by classical intro q cfg C T cert pJ4 faceJ4 bJ4 hJ4vertex - have hh := cert.modified.rho_common (cert.modified_face_equiv.symm faceJ4) 1 + have hh := cert.modified.rho_common (cert.modifiedFaceEquivalence.symm faceJ4) 1 rw [cert.modified_face_points, hJ4vertex] at hh simpa [pJ4, faceJ4] using hh @@ -853,11 +843,11 @@ private theorem hp2D : let faceI2 : PeriodicSubtileFaceIndex := ⟨.I2, 0, 0⟩ let dI2 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ have hvertex : cert.modified.plane.faceVertex - (cert.modified_face_equiv.symm faceI2) 2 = dI2 := by + (cert.modifiedFaceEquivalence.symm faceI2) 2 = dI2 := by rw [cert.modified_face_vertices] simp [faceI2, dI2, SixSubtileFaceVertices] have hh := cert.modified.rho_common - (cert.modified_face_equiv.symm faceI2) 2 + (cert.modifiedFaceEquivalence.symm faceI2) 2 rw [hvertex, cert.modified_tile, cert.modified_face_points] at hh simpa [p2, faceI2, dI2, ModifiedSubtileOccurrenceInterpretation, TileTranslation, GaussianTranslation, htransZero, Finset.image_id] using hh @@ -1001,14 +991,14 @@ private theorem classifyCFface : let c0 : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ let f0 : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ ∀ (F : cert.modified.plane.Face), ((∃ i, cert.modified.plane.faceVertex F i = c0) ∧ - ∃ i, cert.modified.plane.faceVertex F i = f0) → (cert.modified_face_equiv F = ⟨.I3, - 0, 0⟩ ∨ cert.modified_face_equiv F = ⟨.J8, 0, 0⟩) ) := by + ∃ i, cert.modified.plane.faceVertex F i = f0) → (cert.modifiedFaceEquivalence F = ⟨.I3, + 0, 0⟩ ∨ cert.modifiedFaceEquivalence F = ⟨.J8, 0, 0⟩) ) := by classical intro q cfg C T cert c0 f0 F hF obtain ⟨i, hi⟩ := hF.1 obtain ⟨j, hj⟩ := hF.2 rw [cert.modified_face_vertices] at hi hj - generalize hidx : cert.modified_face_equiv F = face at hi hj ⊢ + generalize hidx : cert.modifiedFaceEquivalence F = face at hi hj ⊢ rcases face with ⟨label, m, n⟩ cases label <;> fin_cases i <;> fin_cases j <;> simp [SixSubtileFaceVertices, c0, f0] at hi hj ⊢ <;> omega @@ -1020,12 +1010,13 @@ private theorem rhoFace3 : ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm face)) ) := by classical intro q cfg C T cert F face hF - have hEq : F = cert.modified_face_equiv.symm face := by - have hh := congrArg cert.modified_face_equiv.symm hF + have hEq : F = cert.modifiedFaceEquivalence.symm face := by + have hh := congrArg cert.modifiedFaceEquivalence.symm hF simpa using hh rw [hEq, cert.modified_face_points] @@ -1035,9 +1026,9 @@ private theorem hf3point : exact ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (f3 : cert.modified.plane.Face), ((cert.modified_face_equiv : + T), ∀ (f3 : cert.modified.plane.Face), ((cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) f3 = (⟨SixSubtileFaceLabel.I3, - (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) f3 = (⟨SixSubtileFaceLabel.J8, (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( let p3 := cert.unmodified.core.rho @@ -1045,7 +1036,8 @@ private theorem hf3point : let pJ8 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.J8, 0, 0⟩) (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho f3 = p3 ∨ cert.modified.rho f3 = pJ8)) ) := by classical @@ -1060,9 +1052,9 @@ private theorem hg3point : exact ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (g3 : cert.modified.plane.Face), ((cert.modified_face_equiv : + T), ∀ (g3 : cert.modified.plane.Face), ((cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) g3 = (⟨SixSubtileFaceLabel.I3, - (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) g3 = (⟨SixSubtileFaceLabel.J8, (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( let p3 := cert.unmodified.core.rho @@ -1070,7 +1062,8 @@ private theorem hg3point : let pJ8 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.J8, 0, 0⟩) (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho g3 = p3 ∨ cert.modified.rho g3 = pJ8)) ) := by classical @@ -1112,7 +1105,7 @@ private theorem hJ8vertex : T), let faceJ8 : PeriodicSubtileFaceIndex := ⟨.J8, 0, 0⟩ let dJ8 : PeriodicSubtileIndex := ⟨.D, -1, 0⟩ - cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ8) 1 = dJ8 ) := by + cert.modified.plane.faceVertex (cert.modifiedFaceEquivalence.symm faceJ8) 1 = dJ8 ) := by classical intro q cfg C T cert faceJ8 dJ8 rw [cert.modified_face_vertices] @@ -1129,11 +1122,11 @@ private theorem hpJ8d : (cert.unmodified.faceEquiv.symm ⟨.J8, 0, 0⟩) let faceJ8 : PeriodicSubtileFaceIndex := ⟨.J8, 0, 0⟩ let dJ8 : PeriodicSubtileIndex := ⟨.D, -1, 0⟩ - (cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ8) 1 = dJ8) → (pJ8 ∈ + (cert.modified.plane.faceVertex (cert.modifiedFaceEquivalence.symm faceJ8) 1 = dJ8) → (pJ8 ∈ FootprintVertices (cert.modified.tile dJ8)) ) := by classical intro q cfg C T cert pJ8 faceJ8 dJ8 hJ8vertex - have hh := cert.modified.rho_common (cert.modified_face_equiv.symm faceJ8) 1 + have hh := cert.modified.rho_common (cert.modifiedFaceEquivalence.symm faceJ8) 1 rw [cert.modified_face_points, hJ8vertex] at hh simpa [pJ8, faceJ8] using hh @@ -1152,11 +1145,11 @@ private theorem hp3F : let faceI3 : PeriodicSubtileFaceIndex := ⟨.I3, 0, 0⟩ let fI3 : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ have hvertex : cert.modified.plane.faceVertex - (cert.modified_face_equiv.symm faceI3) 2 = fI3 := by + (cert.modifiedFaceEquivalence.symm faceI3) 2 = fI3 := by rw [cert.modified_face_vertices] simp [faceI3, fI3, SixSubtileFaceVertices] have hh := cert.modified.rho_common - (cert.modified_face_equiv.symm faceI3) 2 + (cert.modifiedFaceEquivalence.symm faceI3) 2 rw [hvertex, cert.modified_tile, cert.modified_face_points] at hh simpa [p3, faceI3, fI3, ModifiedSubtileOccurrenceInterpretation, TileTranslation, GaussianTranslation, htransZero, Finset.image_id] using hh @@ -1297,12 +1290,13 @@ private theorem rhoFace4 : ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm face)) ) := by classical intro q cfg C T cert F face hF - have hEq : F = cert.modified_face_equiv.symm face := by - have hh := congrArg cert.modified_face_equiv.symm hF + have hEq : F = cert.modifiedFaceEquivalence.symm face := by + have hh := congrArg cert.modifiedFaceEquivalence.symm hF simpa using hh rw [hEq, cert.modified_face_points] @@ -1312,9 +1306,9 @@ private theorem hf4point : exact ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (f4 : cert.modified.plane.Face), ((cert.modified_face_equiv : + T), ∀ (f4 : cert.modified.plane.Face), ((cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) f4 = (⟨SixSubtileFaceLabel.I4, - (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) f4 = (⟨SixSubtileFaceLabel.J7, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( let p4 := cert.unmodified.core.rho @@ -1322,7 +1316,8 @@ private theorem hf4point : let pJ7 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.J7, 1, 0⟩) (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho f4 = p4 ∨ cert.modified.rho f4 = pJ7)) ) := by classical @@ -1337,9 +1332,9 @@ private theorem hg4point : exact ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (g4 : cert.modified.plane.Face), ((cert.modified_face_equiv : + T), ∀ (g4 : cert.modified.plane.Face), ((cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) g4 = (⟨SixSubtileFaceLabel.I4, - (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modified_face_equiv : + (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modifiedFaceEquivalence : cert.modified.plane.Face → PeriodicSubtileFaceIndex) g4 = (⟨SixSubtileFaceLabel.J7, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( let p4 := cert.unmodified.core.rho @@ -1347,7 +1342,8 @@ private theorem hg4point : let pJ7 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.J7, 1, 0⟩) (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modified_face_equiv F = face) → (cert.modified.rho F = cert.unmodified.core.rho + (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = + cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho g4 = p4 ∨ cert.modified.rho g4 = pJ7)) ) := by classical @@ -1389,7 +1385,7 @@ private theorem hJ7vertex : T), let faceJ7 : PeriodicSubtileFaceIndex := ⟨.J7, 1, 0⟩ let cJ7 : PeriodicSubtileIndex := ⟨.C, 1, 0⟩ - cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ7) 0 = cJ7 ) := by + cert.modified.plane.faceVertex (cert.modifiedFaceEquivalence.symm faceJ7) 0 = cJ7 ) := by classical intro q cfg C T cert faceJ7 cJ7 rw [cert.modified_face_vertices] @@ -1406,11 +1402,11 @@ private theorem hpJ7c : (cert.unmodified.faceEquiv.symm ⟨.J7, 1, 0⟩) let faceJ7 : PeriodicSubtileFaceIndex := ⟨.J7, 1, 0⟩ let cJ7 : PeriodicSubtileIndex := ⟨.C, 1, 0⟩ - (cert.modified.plane.faceVertex (cert.modified_face_equiv.symm faceJ7) 0 = cJ7) → (pJ7 ∈ + (cert.modified.plane.faceVertex (cert.modifiedFaceEquivalence.symm faceJ7) 0 = cJ7) → (pJ7 ∈ FootprintVertices (cert.modified.tile cJ7)) ) := by classical intro q cfg C T cert pJ7 faceJ7 cJ7 hJ7vertex - have hh := cert.modified.rho_common (cert.modified_face_equiv.symm faceJ7) 0 + have hh := cert.modified.rho_common (cert.modifiedFaceEquivalence.symm faceJ7) 0 rw [cert.modified_face_points, hJ7vertex] at hh simpa [pJ7, faceJ7] using hh @@ -2053,13 +2049,13 @@ private theorem fourthJunction : have classifyDEface (F : cert.modified.plane.Face) (hF : (∃ i, cert.modified.plane.faceVertex F i = d0) ∧ ∃ i, cert.modified.plane.faceVertex F i = e0) : - cert.modified_face_equiv F = ⟨.I4, 0, 0⟩ ∨ - cert.modified_face_equiv F = ⟨.J7, 1, 0⟩ := + cert.modifiedFaceEquivalence F = ⟨.I4, 0, 0⟩ ∨ + cert.modifiedFaceEquivalence F = ⟨.J7, 1, 0⟩ := (by obtain ⟨i, hi⟩ := hF.1 obtain ⟨j, hj⟩ := hF.2 rw [cert.modified_face_vertices] at hi hj - generalize hidx : cert.modified_face_equiv F = face at hi hj ⊢ + generalize hidx : cert.modifiedFaceEquivalence F = face at hi hj ⊢ rcases face with ⟨label, m, n⟩ cases label <;> fin_cases i <;> fin_cases j <;> simp [SixSubtileFaceVertices, d0, e0] at hi hj ⊢ <;> omega) diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRouting.lean b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRouting.lean index bc1fcba47c..0ca045c717 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRouting.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRouting.lean @@ -5,13 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4590T1MixedCompanionMarks -public import LeanPool.ApollonianSuperharmonic.P4590T1PositivePrototileDisk public import LeanPool.ApollonianSuperharmonic.P4590T1OppositeCellsStar public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorWebRow -public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -- [TABLET NODE: P4590T1JunctionRouting] diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1MixedCompanionMarks.lean b/LeanPool/ApollonianSuperharmonic/P4590T1MixedCompanionMarks.lean index 0f1a1b0e62..951c525d0e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1MixedCompanionMarks.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1MixedCompanionMarks.lean @@ -5,24 +5,17 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints public import LeanPool.ApollonianSuperharmonic.P3996T1AdjacentParentPlacement -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.P4590T1PositivePrototileDisk -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEndpointPairUnique public import LeanPool.ApollonianSuperharmonic.P4590T1JunctionRefinement -public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior -public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry public import LeanPool.ApollonianSuperharmonic.P4616T1OriginalMixedPaths public import LeanPool.ApollonianSuperharmonic.P4616T1MixedCoarseSectors public import LeanPool.ApollonianSuperharmonic.P4616T1PeriodicEndpointExclusion public import LeanPool.ApollonianSuperharmonic.P4616T1FirstPredecessorCentroids public import LeanPool.ApollonianSuperharmonic.P4616T1NestedCompanionFootprints -public import LeanPool.ApollonianSuperharmonic.P4616T1ThirdOwnerPathEndpoint -- [TABLET NODE: P4590T1MixedCompanionMarks] diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean index 3c1cf4bb7e..0dc0353cb8 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean @@ -5,22 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralGeometricSectors -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths -public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention -public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells -public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn -public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4590T1OppositeCellsStar -public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry -public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -- [TABLET NODE: P4590T1MixedInteriorGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1OppositeCellsStar.lean b/LeanPool/ApollonianSuperharmonic/P4590T1OppositeCellsStar.lean index 9fbd5537f8..3758fc814c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1OppositeCellsStar.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1OppositeCellsStar.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import Mathlib.Tactic.FinCases -- [TABLET NODE: P4590T1OppositeCellsStar] diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1OriginalNonedges.lean b/LeanPool/ApollonianSuperharmonic/P4590T1OriginalNonedges.lean index c9dc0857d1..cc214422c5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1OriginalNonedges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1OriginalNonedges.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralGeometricSectors -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry -- [TABLET NODE: P4590T1OriginalNonedges] diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1PositivePrototileDisk.lean b/LeanPool/ApollonianSuperharmonic/P4590T1PositivePrototileDisk.lean index c46c984bda..6c4f007fb7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1PositivePrototileDisk.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1PositivePrototileDisk.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.FordTileGeometry -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -- [TABLET NODE: P4590T1PositivePrototileDisk] diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1ReflectedCenterBoundary.lean b/LeanPool/ApollonianSuperharmonic/P4590T1ReflectedCenterBoundary.lean index 50f6546e28..e5384e774c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1ReflectedCenterBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1ReflectedCenterBoundary.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean index bffa52d690..2e311882e2 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean @@ -5,22 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRawSupport +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandExceptionalRestorationSectorOrder public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry public import LeanPool.ApollonianSuperharmonic.P4590T1PositivePrototileDisk -public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior public import LeanPool.ApollonianSuperharmonic.P4590T1OppositeCellsStar -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths -public import LeanPool.ApollonianSuperharmonic.P3161T2PathExhaustion -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRawSupport -public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation -public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments -public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence -- [TABLET NODE: P4590T1RestoredBoundaryGeometry] @@ -45,7 +35,7 @@ private theorem hempty_anchor : (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (TileCentroid O = TileCentroid T) → (O.cells = ∅ → GaussianRealPoint seg.a = TileCentroid T) ) := by classical @@ -65,7 +55,7 @@ private theorem hnonemptyO : (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), (GaussianRealPoint x ≠ TileCentroid T) → ( let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (O.cells = ∅ → GaussianRealPoint seg.a = TileCentroid T) → (O.cells.Nonempty ∨ x ≠ seg.a)) ) := by classical @@ -90,7 +80,7 @@ private theorem rawBoundary : (cert.P (0 : Fin (3 : ℕ)) true)) → ((x ∈ BoundaryFootprintVertices (cert.P (0 : Fin (3 : ℕ)) false)) → ( let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (O.cells.Nonempty ∨ x ≠ seg.a) → (∀ (U : ProtoTile), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → (x ∈ FootprintVertices U))))))))) ) := by classical @@ -121,7 +111,7 @@ private theorem boundary_sectors : (cert.P (0 : Fin (3 : ℕ)) true)) → ((x ∈ BoundaryFootprintVertices (cert.P (0 : Fin (3 : ℕ)) false)) → ( let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (O.cells.Nonempty ∨ x ≠ seg.a) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → (x ∈ FootprintVertices U))) → (∀ (U : ProtoTile), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → ((∃ j : Fin 4, @@ -296,7 +286,7 @@ private theorem hf1 : cfg C T), let ia : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let ib : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = ia) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = ib) → h = f ∨ h = @@ -317,7 +307,7 @@ private theorem hf2 : cfg C T), let ia : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let ib : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ - let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + let f2 := cert.modifiedFaceEquivalence.symm ⟨.I2, 0, 0⟩ ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = ia) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = ib) → h = f ∨ h = @@ -336,12 +326,12 @@ private theorem hf12 : ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f2 := cert.modifiedFaceEquivalence.symm ⟨.I2, 0, 0⟩ f1 ≠ f2 ) := by classical intro q cfg C T cert f1 f2 h - have := congrArg cert.modified_face_equiv h + have := congrArg cert.modifiedFaceEquivalence h simp [f1, f2] at this private theorem hexhaust : @@ -354,11 +344,11 @@ private theorem hexhaust : let A := cert.P 0 true let B := cert.P 0 false let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments let ia : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let ib : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f2 := cert.modifiedFaceEquivalence.symm ⟨.I2, 0, 0⟩ (cert.modified.tile ia = TileCellComplement A O) → ((cert.modified.tile ib = B) → ((FootprintVertices (cert.modified.tile ia) ∩ FootprintVertices (cert.modified.tile ib) = CommonFootprintEdgeVertices (cert.modified.tile ia) (cert.modified.tile ib)) → @@ -407,7 +397,7 @@ private theorem hsegMembership : let A := cert.P 0 true let B := cert.P 0 false let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (x ∉ FootprintVertices O → x ∈ FootprintVertices (TileCellComplement A O) ∩ FootprintVertices B) → ((∀ z ∈ FootprintVertices (TileCellComplement A O) ∩ FootprintVertices B, z ∈ seg.connector) → ((seg.connector.Sublist seg.walk) → (x ∉ @@ -438,7 +428,7 @@ private theorem incidentRaw : let A := cert.P 0 true let B := cert.P 0 false let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (O.cells.Nonempty ∨ x ≠ seg.a) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → (x ∈ FootprintVertices U))) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → ((∃ j : Fin 4, @@ -503,7 +493,7 @@ private theorem hOcuts : let A := cert.P 0 true let B := cert.P 0 false let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (TileCentroid cert.O = TileCentroid T ∧ (cert.O.cells = ∅ ↔ (cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) ∧ BandPrototile (cfg.firstPredecessor (1 : Fin (4 : ℕ))) cert.O ∧ (Finset.Nonempty cert.O.cells → LatticeTile cert.O) ∧ Finset.Nonempty @@ -582,7 +572,7 @@ private theorem hOcuts : exact P3161T2IncidentBoundary _ x ⟨jB, hDplusIn⟩ ⟨jA, hOoutsidePlus⟩ have hDminusB : x ∈ BoundaryFootprintVertices (TileCellComplement B O) := by exact P3161T2IncidentBoundary _ x ⟨jA, hDminusIn⟩ ⟨jB, hOoutsideMinus⟩ - rcases cert.precursor_boundary.branch with hbranch | hempty + rcases cert.precursorBoundary.branch with hbranch | hempty · rcases hbranch with ⟨_, plusArc, minusArc, _, _, _, _, _, _, hplusSet, hminusSet, _, _, _, hinter, _, _⟩ have hplus : x ∈ (plusArc.toFinset : Set GaussianInt) := by @@ -591,14 +581,14 @@ private theorem hOcuts : have hminus : x ∈ (minusArc.toFinset : Set GaussianInt) := by rw [hminusSet] exact ⟨hDminusB, hOB⟩ - have haa : cert.precursor_boundary.a = seg.a := by - apply (seg.first_cut_unique cert.precursor_boundary.a).mp - exact (cert.precursor_boundary.first_transition cert.precursor_boundary.a).mpr rfl - have hbb : cert.precursor_boundary.b = seg.b := by - apply (seg.second_cut_unique cert.precursor_boundary.b).mp - exact (cert.precursor_boundary.second_transition cert.precursor_boundary.b).mpr rfl - have hpair : x ∈ ({cert.precursor_boundary.a, - cert.precursor_boundary.b} : Set GaussianInt) := by + have haa : cert.precursorBoundary.a = seg.a := by + apply (seg.first_cut_unique cert.precursorBoundary.a).mp + exact (cert.precursorBoundary.first_transition cert.precursorBoundary.a).mpr rfl + have hbb : cert.precursorBoundary.b = seg.b := by + apply (seg.second_cut_unique cert.precursorBoundary.b).mp + exact (cert.precursorBoundary.second_transition cert.precursorBoundary.b).mpr rfl + have hpair : x ∈ ({cert.precursorBoundary.a, + cert.precursorBoundary.b} : Set GaussianInt) := by rw [← hinter] exact ⟨hplus, hminus⟩ rw [haa, hbb] at hpair @@ -690,7 +680,7 @@ private theorem hp1_not : PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ((∀ (i : Fin 3), ∀ (s : + PeriodicSubtileFaceIndex))) cert.exceptionalSegments) → ((∀ (i : Fin 3), ∀ (s : Bool), ((i, s) ≠ ((0 : Fin 3), true)) → (((i, s) ≠ ((0 : Fin 3), false)) → ((x ∈ BoundaryFootprintVertices (cert.P i s)) → (False)))) → ( let p1 := cert.unmodified.core.rho @@ -731,7 +721,7 @@ private theorem hp2_not : PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ((∀ (i : Fin 3), ∀ (s : + PeriodicSubtileFaceIndex))) cert.exceptionalSegments) → ((∀ (i : Fin 3), ∀ (s : Bool), ((i, s) ≠ ((0 : Fin 3), true)) → (((i, s) ≠ ((0 : Fin 3), false)) → ((x ∈ BoundaryFootprintVertices (cert.P i s)) → (False)))) → ( let p2 := cert.unmodified.core.rho @@ -761,7 +751,7 @@ private theorem hcutApositive : (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (O.cells.Nonempty ∨ x ≠ seg.a) → (x = seg.a → O.cells.Nonempty) ) := by classical intro q cfg C T cert x O seg hnonemptyO hxa @@ -777,7 +767,7 @@ private theorem hcutBpositive : (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), (GaussianRealPoint x ≠ TileCentroid T) → ( let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (O.cells = ∅ → GaussianRealPoint seg.a = TileCentroid T) → (x = seg.b → O.cells.Nonempty)) ) := by classical @@ -800,7 +790,7 @@ private theorem hCnone : cfg C T), ∀ (x : GaussianInt), let Ctile := cert.P 1 true let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (ExceptionalRestorationSectorData (cert.P (0 : Fin (3 : ℕ)) true) (cert.P (0 : Fin (3 : ℕ)) false) cert.O (cert.Q (1 : Fin (3 : ℕ)) true) (cert.S (2 : Fin (3 : ℕ)) false) (cert.Q (2 : Fin (3 : ℕ)) true) (cert.S (1 : Fin (3 : ℕ)) false) (cert.P (1 : Fin (3 @@ -810,7 +800,7 @@ private theorem hCnone : PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ((O.cells.Nonempty ∨ x ≠ + PeriodicSubtileFaceIndex))) cert.exceptionalSegments) → ((O.cells.Nonempty ∨ x ≠ seg.a) → ( let p1 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) @@ -832,7 +822,7 @@ private theorem hOnoneAt589 : (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (ExceptionalRestorationSectorData (cert.P (0 : Fin (3 : ℕ)) true) (cert.P (0 : Fin (3 : ℕ)) false) cert.O (cert.Q (1 : Fin (3 : ℕ)) true) (cert.S (2 : Fin (3 : ℕ)) false) (cert.Q (2 : Fin (3 : ℕ)) true) (cert.S (1 : Fin (3 : ℕ)) false) (cert.P (1 : Fin (3 @@ -842,7 +832,7 @@ private theorem hOnoneAt589 : PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ((x ∈ seg.left) → ((¬x = + PeriodicSubtileFaceIndex))) cert.exceptionalSegments) → ((x ∈ seg.left) → ((¬x = seg.a) → (∀ j : Fin 4, LatticeVertexIncidentCell x j ∉ O.cells))) ) := by classical intro q cfg C T cert x O seg sec hleft hxa j hj @@ -858,7 +848,7 @@ private theorem hguardR : ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (¬x = seg.b) → ( let O := cert.O O.cells.Nonempty ∨ x ≠ seg.b) ) := by @@ -877,7 +867,7 @@ private theorem hDnone : cfg C T), ∀ (x : GaussianInt), let Dtile := cert.P 1 false let O := cert.O - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (ExceptionalRestorationSectorData (cert.P (0 : Fin (3 : ℕ)) true) (cert.P (0 : Fin (3 : ℕ)) false) cert.O (cert.Q (1 : Fin (3 : ℕ)) true) (cert.S (2 : Fin (3 : ℕ)) false) (cert.Q (2 : Fin (3 : ℕ)) true) (cert.S (1 : Fin (3 : ℕ)) false) (cert.P (1 : Fin (3 @@ -887,7 +877,7 @@ private theorem hDnone : PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ( + PeriodicSubtileFaceIndex))) cert.exceptionalSegments) → ( let p2 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) (x ≠ p2) → ((x ∈ seg.right) → ((O.cells.Nonempty ∨ x ≠ seg.b) → (∀ j : Fin 4, @@ -905,7 +895,7 @@ private theorem hOnoneAt624 : ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (x : GaussianInt), - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments (¬x = seg.b) → ( let O := cert.O (ExceptionalRestorationSectorData (cert.P (0 : Fin (3 : ℕ)) true) (cert.P (0 : Fin (3 : @@ -917,7 +907,7 @@ private theorem hOnoneAt624 : PeriodicSubtileFaceIndex))) (cert.unmodified.core.rho ((cert.unmodified.faceEquiv.symm : PeriodicSubtileFaceIndex → cert.unmodified.core.plane.Face) (⟨SixSubtileFaceLabel.I2, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileFaceIndex))) cert.exceptional_segments) → ((x ∈ seg.right) → (∀ j : + PeriodicSubtileFaceIndex))) cert.exceptionalSegments) → ((x ∈ seg.right) → (∀ j : Fin 4, LatticeVertexIncidentCell x j ∉ O.cells))) ) := by classical intro q cfg C T cert x seg hxb O sec hright j hj @@ -946,8 +936,8 @@ theorem P4590T1RestoredBoundaryGeometry : y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ FootprintVertices (cert.Q 2 true) ∨ y ∈ FootprintVertices (cert.S 1 false)) ∧ x ∉ FootprintVertices (cert.P 1 false)) ∨ - (x = cert.exceptional_segments.a ∧ cert.O.cells.Nonempty) ∨ - (x = cert.exceptional_segments.b ∧ cert.O.cells.Nonempty)))))))) := by + (x = cert.exceptionalSegments.a ∧ cert.O.cells.Nonempty) ∨ + (x = cert.exceptionalSegments.b ∧ cert.O.cells.Nonempty)))))))) := by intro q cfg C T cert hT x hx hxb hk hnoncentral hA hB -- BODY classical @@ -960,7 +950,7 @@ theorem P4590T1RestoredBoundaryGeometry : let S := cert.S 2 false let R := cert.Q 2 true let V := cert.S 1 false - let seg := cert.exceptional_segments + let seg := cert.exceptionalSegments let sec := BandExceptionalRestorationSectorOrder q cfg C T cert have hsec := sec have hpre := P4339T1PrecursorSupportGeometry C q cfg T cert @@ -1005,8 +995,8 @@ theorem P4590T1RestoredBoundaryGeometry : hxB' hdeletedNe let ia : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let ib : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f2 := cert.modified_face_equiv.symm ⟨.I2, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f2 := cert.modifiedFaceEquivalence.symm ⟨.I2, 0, 0⟩ have translation_zero := RestoredBoundaryGeometry.translation_zero have htileA := RestoredBoundaryGeometry.htileA q cfg C T cert translation_zero have htileB := RestoredBoundaryGeometry.htileB q cfg C T cert translation_zero diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean index 710faa1ab2..aa2412ba12 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean @@ -5,27 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRawSupport -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralGeometricSectors -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths -public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn -public import LeanPool.ApollonianSuperharmonic.P4055T1BandQuarterTurn +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4590T1PositivePrototileDisk public import LeanPool.ApollonianSuperharmonic.P4590T1OppositeCellsStar -public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary -public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry -public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas -- [TABLET NODE: P4590T1RightInteriorGeometry] @@ -672,7 +656,7 @@ private theorem hf1 : cfg C T), let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = c) → h = f ∨ h = g) @@ -693,7 +677,7 @@ private theorem hf3 : cfg C T), let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = c) → h = f ∨ h = g) @@ -712,12 +696,12 @@ private theorem hf13 : ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ f1 ≠ f3 ) := by classical intro q cfg C T cert f1 f3 h - have hh := congrArg cert.modified_face_equiv h + have hh := congrArg cert.modifiedFaceEquivalence h simp [f1, f3] at hh private theorem hpair : @@ -727,8 +711,8 @@ private theorem hpair : ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (f1 = f ∨ f1 = g) → ((f3 = f ∨ f3 = g) → ((f1 ≠ f3) → ((f1 = f ∧ f3 = g) ∨ (f1 = g ∧ f3 = f)))) ) := by classical @@ -774,8 +758,8 @@ private theorem hz13 : ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), ((f1 = f ∧ f3 = g) ∨ (f1 = g ∧ f3 = f)) → ((cert.modified.rho f1 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) → ((cert.modified.rho f3 = @@ -799,8 +783,8 @@ private theorem hcomplete : cfg C T), let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ (cert.modified.tile a = TileCellComplement (cert.P 0 true) cert.O) → ((cert.modified.tile c = cert.P 1 true) → ((FootprintVertices (cert.modified.tile a) ∩ FootprintVertices (cert.modified.tile c) = CommonFootprintEdgeVertices (cert.modified.tile a) @@ -900,7 +884,7 @@ private theorem hz1Amod : (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ (cert.modified.tile a = TileCellComplement (cert.P 0 true) cert.O) → ((cert.modified.rho f1 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) → ((cert.modified.plane.faceVertex f1 0 = a) → ( @@ -920,7 +904,7 @@ private theorem hz1B : ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ (cert.modified.rho f1 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) → ( let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ @@ -942,7 +926,7 @@ private theorem hz1C : (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ (cert.modified.tile c = cert.P 1 true) → ((cert.modified.rho f1 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) → ((cert.modified.plane.faceVertex f1 2 = c) → ( @@ -982,7 +966,7 @@ private theorem hz3Amod : (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ - let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ (cert.modified.tile a = TileCellComplement (cert.P 0 true) cert.O) → ((cert.modified.rho f3 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩)) → ((cert.modified.plane.faceVertex f3 0 = a) → ( @@ -1003,7 +987,7 @@ private theorem hz3C : (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ (cert.modified.tile c = cert.P 1 true) → ((cert.modified.rho f3 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩)) → ((cert.modified.plane.faceVertex f3 1 = c) → ( @@ -1023,7 +1007,7 @@ private theorem hz3F : ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), - let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ (cert.modified.rho f3 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩)) → ( let fidx : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ @@ -1994,8 +1978,8 @@ private theorem positiveCase : (LatticeTileGridStructure _ hCtile).1.1 let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let f1 := cert.modified_face_equiv.symm ⟨.I1, 0, 0⟩ - let f3 := cert.modified_face_equiv.symm ⟨.I3, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ have translation_zero := RightInteriorGeometry.translation_zero have htileA := RightInteriorGeometry.htileA q cfg C T cert translation_zero have htileC := RightInteriorGeometry.htileC q cfg C T cert translation_zero diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RotationalDiskCenter.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RotationalDiskCenter.lean index 5b7e3a8182..fe8d3baf1e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1RotationalDiskCenter.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RotationalDiskCenter.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TopologicalDiskExponentialLift -public import Mathlib.Topology.Connected.TotallyDisconnected -- [TABLET NODE: P4590T1RotationalDiskCenter] @@ -75,7 +76,12 @@ theorem P4590T1RotationalDiskCenter (S : Set (Real × Real)) (hS : TopologicalDi have h1i := congrArg Complex.im h1 have h2i := congrArg Complex.im h2 have hni := congrArg Complex.im hn - simp? [a] at h0i h1i h2i hni + simp only [Complex.ofReal_div, Complex.ofReal_ofNat, Complex.sub_im, Complex.mul_im, + Complex.div_ofNat_re, Complex.ofReal_re, Complex.I_im, mul_one, Complex.div_ofNat_im, + Complex.ofReal_im, zero_div, Complex.I_re, mul_zero, add_zero, sub_left_inj, + Complex.add_im, Complex.intCast_re, Complex.mul_re, Complex.re_ofNat, + Complex.im_ofNat, sub_zero, zero_mul, Complex.intCast_im, sub_self, a] + at h0i h1i h2i hni have hreal : (1 : Real) + 4 * (n : Real) = 0 := by nlinarith [Real.pi_pos] exact_mod_cast hreal diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1SixLabelBoundaryCount.lean b/LeanPool/ApollonianSuperharmonic/P4590T1SixLabelBoundaryCount.lean index 0baaa36304..c97f0736e5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1SixLabelBoundaryCount.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1SixLabelBoundaryCount.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Data.Set.Card + -- [TABLET NODE: P4590T1SixLabelBoundaryCount] diff --git a/LeanPool/ApollonianSuperharmonic/P4616T1FirstPredecessorCentroids.lean b/LeanPool/ApollonianSuperharmonic/P4616T1FirstPredecessorCentroids.lean index 1ac6f6f5b4..9a5d665a87 100644 --- a/LeanPool/ApollonianSuperharmonic/P4616T1FirstPredecessorCentroids.lean +++ b/LeanPool/ApollonianSuperharmonic/P4616T1FirstPredecessorCentroids.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas diff --git a/LeanPool/ApollonianSuperharmonic/P4616T1MixedCoarseSectors.lean b/LeanPool/ApollonianSuperharmonic/P4616T1MixedCoarseSectors.lean index 08baa62488..0a97702ff5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4616T1MixedCoarseSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4616T1MixedCoarseSectors.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -- [TABLET NODE: P4616T1MixedCoarseSectors] diff --git a/LeanPool/ApollonianSuperharmonic/P4616T1NestedCompanionFootprints.lean b/LeanPool/ApollonianSuperharmonic/P4616T1NestedCompanionFootprints.lean index 9afcfbb688..fc913c8ca6 100644 --- a/LeanPool/ApollonianSuperharmonic/P4616T1NestedCompanionFootprints.lean +++ b/LeanPool/ApollonianSuperharmonic/P4616T1NestedCompanionFootprints.lean @@ -5,12 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P4616T1NestedCompanionFootprints] diff --git a/LeanPool/ApollonianSuperharmonic/P4616T1OriginalMixedPaths.lean b/LeanPool/ApollonianSuperharmonic/P4616T1OriginalMixedPaths.lean index a9b87db615..e546554d9d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4616T1OriginalMixedPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/P4616T1OriginalMixedPaths.lean @@ -5,11 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionPaths -public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry -public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -- [TABLET NODE: P4616T1OriginalMixedPaths] @@ -133,8 +132,8 @@ theorem P4616T1OriginalMixedPaths have liftFace (F : PeriodicSubtileFaceIndex) (hF : (∃ i, SixSubtileFaceVertices F i = a) ∧ ∃ i, SixSubtileFaceVertices F i = b) : - (∃ i, cert.modified.plane.faceVertex (cert.modified_face_equiv.symm F) i = a) ∧ - ∃ i, cert.modified.plane.faceVertex (cert.modified_face_equiv.symm F) i = b := by + (∃ i, cert.modified.plane.faceVertex (cert.modifiedFaceEquivalence.symm F) i = a) ∧ + ∃ i, cert.modified.plane.faceVertex (cert.modifiedFaceEquivalence.symm F) i = b := by constructor · obtain ⟨i, hi⟩ := hF.1 exact ⟨i, by rw [cert.modified_face_vertices]; simpa using hi⟩ @@ -142,14 +141,14 @@ theorem P4616T1OriginalMixedPaths exact ⟨i, by rw [cert.modified_face_vertices]; simpa using hi⟩ have hfc := allFaces _ (liftFace f hf) have hgc := allFaces _ (liftFace g hg) - have hne : cert.modified_face_equiv.symm f ≠ cert.modified_face_equiv.symm g := - fun h => hfg (cert.modified_face_equiv.symm.injective h) + have hne : cert.modifiedFaceEquivalence.symm f ≠ cert.modifiedFaceEquivalence.symm g := + fun h => hfg (cert.modifiedFaceEquivalence.symm.injective h) rw [regular.adjacent_raw_eq_edge_vertices a b hadj'] have hpath : SimpleGridPathBetween (CommonFootprintEdgeVertices (cert.modified.tile a) (cert.modified.tile b)) (FootprintEdges (cert.modified.tile a) ∩ FootprintEdges (cert.modified.tile b)) - (cert.modified.rho (cert.modified_face_equiv.symm f)) - (cert.modified.rho (cert.modified_face_equiv.symm g)) := by + (cert.modified.rho (cert.modifiedFaceEquivalence.symm f)) + (cert.modified.rho (cert.modifiedFaceEquivalence.symm g)) := by rcases hfc with hfc | hfc <;> rcases hgc with hgc | hgc · exact (hne (hfc.trans hgc.symm)).elim · simpa only [hfc, hgc] using hp diff --git a/LeanPool/ApollonianSuperharmonic/P4616T1PeriodicEndpointExclusion.lean b/LeanPool/ApollonianSuperharmonic/P4616T1PeriodicEndpointExclusion.lean index 9a1c2c2e61..e6c7b82b6b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4616T1PeriodicEndpointExclusion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4616T1PeriodicEndpointExclusion.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell diff --git a/LeanPool/ApollonianSuperharmonic/P4616T1ThirdOwnerPathEndpoint.lean b/LeanPool/ApollonianSuperharmonic/P4616T1ThirdOwnerPathEndpoint.lean index 4f71662264..43be873c4a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4616T1ThirdOwnerPathEndpoint.lean +++ b/LeanPool/ApollonianSuperharmonic/P4616T1ThirdOwnerPathEndpoint.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge -- [TABLET NODE: P4616T1ThirdOwnerPathEndpoint] diff --git a/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockExterior.lean b/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockExterior.lean index 0ea7b05b27..7611c0704b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockExterior.lean +++ b/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockExterior.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3161T1AggregateComplementConnectivity -- [TABLET NODE: P4623T1ZeroBlockExterior] diff --git a/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockLinks.lean b/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockLinks.lean index 4da508a4ef..049f3f376f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockLinks.lean +++ b/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockLinks.lean @@ -5,9 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.Fintype.Fin +public import Mathlib.Data.Fintype.Prod +public import Mathlib.Data.Finset.Card +public import Mathlib.Tactic.FinCases + public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -public import Mathlib.Tactic.FinCases -- [TABLET NODE: P4623T1ZeroBlockLinks] diff --git a/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockPaths.lean b/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockPaths.lean index 0d5e761b4d..5d9fce2b2a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/P4623T1ZeroBlockPaths.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence +public import Mathlib.Init +public import Mathlib.Data.Finset.Card public import Mathlib.Logic.Relation +public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence + -- [TABLET NODE: P4623T1ZeroBlockPaths] /-! diff --git a/LeanPool/ApollonianSuperharmonic/P4630T1AffineCellSymmetry.lean b/LeanPool/ApollonianSuperharmonic/P4630T1AffineCellSymmetry.lean index 27916e68bd..ca42ef6c40 100644 --- a/LeanPool/ApollonianSuperharmonic/P4630T1AffineCellSymmetry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4630T1AffineCellSymmetry.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas diff --git a/LeanPool/ApollonianSuperharmonic/P4630T1CellRouteLift.lean b/LeanPool/ApollonianSuperharmonic/P4630T1CellRouteLift.lean index 6abbe8301a..c4b701908b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4630T1CellRouteLift.lean +++ b/LeanPool/ApollonianSuperharmonic/P4630T1CellRouteLift.lean @@ -5,14 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.P4630T1RingIndex public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import Mathlib.Data.List.Chain -public import Mathlib.Logic.Relation -- [TABLET NODE: P4630T1CellRouteLift] @@ -233,7 +233,9 @@ private theorem disk : by_contra hc obtain ⟨i, k, hl, he, _⟩ := dirty a ha x hx hc fin_cases i <;> fin_cases k <;> - simp? [P4630T1RingIndex] at hl he + simp only [P4630T1RingIndex, Int.reduceNeg, Fin.mk_one, Fin.isValue, Fin.reduceFinMk, + Matrix.cons_val', Matrix.cons_val, Matrix.cons_val_fin_one, Matrix.cons_val_one, + Matrix.cons_val_zero, reduceCtorEq, Fin.zero_eta] at hl he · exact h₁ he · exact h₂ he change TopologicalDisk (TileRealization (V a)) diff --git a/LeanPool/ApollonianSuperharmonic/P4630T1ExteriorNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4630T1ExteriorNeighbors.lean index 9f68cf7a60..8288d57f23 100644 --- a/LeanPool/ApollonianSuperharmonic/P4630T1ExteriorNeighbors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4630T1ExteriorNeighbors.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence public import LeanPool.ApollonianSuperharmonic.P4630T1RingIndex +public import Mathlib.LinearAlgebra.Matrix.Notation -- [TABLET NODE: P4630T1ExteriorNeighbors] diff --git a/LeanPool/ApollonianSuperharmonic/P4630T1ExteriorWalks.lean b/LeanPool/ApollonianSuperharmonic/P4630T1ExteriorWalks.lean index 7d1476c555..4eb627ee97 100644 --- a/LeanPool/ApollonianSuperharmonic/P4630T1ExteriorWalks.lean +++ b/LeanPool/ApollonianSuperharmonic/P4630T1ExteriorWalks.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence public import LeanPool.ApollonianSuperharmonic.P4630T1RingIndex -public import Mathlib.Logic.Relation +public import Mathlib.LinearAlgebra.Matrix.Notation -- [TABLET NODE: P4630T1ExteriorWalks] diff --git a/LeanPool/ApollonianSuperharmonic/P4630T1GridComplementCriterion.lean b/LeanPool/ApollonianSuperharmonic/P4630T1GridComplementCriterion.lean index a1d1e54642..1f8348984b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4630T1GridComplementCriterion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4630T1GridComplementCriterion.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected public import LeanPool.ApollonianSuperharmonic.UniqueBoundedGridComplementComponent -public import Mathlib.Data.List.Chain -- [TABLET NODE: P4630T1GridComplementCriterion] diff --git a/LeanPool/ApollonianSuperharmonic/P4630T1ParentRotation.lean b/LeanPool/ApollonianSuperharmonic/P4630T1ParentRotation.lean index 1cee69b310..ecdea02d9a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4630T1ParentRotation.lean +++ b/LeanPool/ApollonianSuperharmonic/P4630T1ParentRotation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn public import LeanPool.ApollonianSuperharmonic.P4630T1RingIndex @@ -88,7 +90,12 @@ theorem P4630T1ParentRotation have him := congrArg Zsqrtd.im laws.1 fin_cases i all_goals - simp? [W, r, s, U, V, GaussianQuarterTurn] at hre him ⊢ + simp only [Int.reduceNeg, Fin.isValue, Zsqrtd.re_add, Zsqrtd.re_zero, Zsqrtd.im_add, + Zsqrtd.im_zero, V, GaussianQuarterTurn, neg_add_rev, U, Fin.mk_one, + Matrix.cons_val_one, Matrix.cons_val_zero, Fin.reduceAdd, Fin.succ_zero_eq_one, + Fin.reduceSucc, Zsqrtd.add_def, s, W, r, Fin.reduceFinMk, Matrix.cons_val, + Fin.succ_one_eq_two, Fin.zero_eta, zero_add, Zsqrtd.im_sub, Zsqrtd.im_neg, neg_sub, + Zsqrtd.re_sub, Zsqrtd.re_neg, neg_neg] at hre him ⊢ apply Zsqrtd.ext_iff.mpr simp constructor <;> omega diff --git a/LeanPool/ApollonianSuperharmonic/P4630T1RingIndex.lean b/LeanPool/ApollonianSuperharmonic/P4630T1RingIndex.lean index 7701f7fe2f..e4d9be0da9 100644 --- a/LeanPool/ApollonianSuperharmonic/P4630T1RingIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/P4630T1RingIndex.lean @@ -5,6 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Data.Fin.VecNotation + public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex -- [TABLET NODE: P4630T1RingIndex] diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1AntipodalContactArcs.lean b/LeanPool/ApollonianSuperharmonic/P4638T1AntipodalContactArcs.lean index 558a673f0e..82bb6e276f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1AntipodalContactArcs.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1AntipodalContactArcs.lean @@ -5,12 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.P4590T1CentralDiskSectors public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport public import LeanPool.ApollonianSuperharmonic.P4651T1GridHalfTurnTransport public import LeanPool.ApollonianSuperharmonic.P4651T1FreeBoundaryHalfTurn diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean b/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean index 37de1a53e4..e52a1ef8ce 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean @@ -5,11 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition +public import LeanPool.ApollonianSuperharmonic.FootprintVertices -- [TABLET NODE: P4638T1ContactStarCoverage] diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyCurvature.lean b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyCurvature.lean index 980b2af2a7..dfdda82ede 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyCurvature.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyCurvature.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -- [TABLET NODE: P4638T1EmptyCurvature] diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean index 2174b4fdd4..923dd0d196 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean @@ -5,17 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -- [TABLET NODE: P4638T1EmptyFordLocalization] @@ -64,7 +59,12 @@ private theorem hp : intro r hr p refine ⟨SemiProperQuadruple.rotate hr.1, ?_⟩ intro j - fin_cases j <;> simp? [p] <;> first | exact hr.2 0 | exact hr.2 1 | exact hr.2 2 + fin_cases j <;> simp only [Fin.isValue, Fin.mk_one, Fin.succ_one_eq_two, Matrix.cons_val, + Matrix.cons_val_zero, p, Fin.reduceFinMk, Fin.reduceSucc, Fin.zero_eta, + Fin.succ_zero_eq_one, Matrix.cons_val_one] + · exact hr.2 1 + · exact hr.2 2 + · exact hr.2 0 private theorem hq1 : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1FordIncidentCells.lean b/LeanPool/ApollonianSuperharmonic/P4638T1FordIncidentCells.lean index a1109294eb..dacda6bd93 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1FordIncidentCells.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1FordIncidentCells.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import Mathlib.Tactic.NormNum +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: P4638T1FordIncidentCells] diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1MidpointReflection.lean b/LeanPool/ApollonianSuperharmonic/P4638T1MidpointReflection.lean index 997bd44c5d..9b8f417ca4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1MidpointReflection.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1MidpointReflection.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P4638T1MidpointReflection] diff --git a/LeanPool/ApollonianSuperharmonic/P4651T1ContactEdgeSeparation.lean b/LeanPool/ApollonianSuperharmonic/P4651T1ContactEdgeSeparation.lean index ea918144d6..b3d7e39ca6 100644 --- a/LeanPool/ApollonianSuperharmonic/P4651T1ContactEdgeSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/P4651T1ContactEdgeSeparation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells diff --git a/LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean b/LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean index 908ca04796..13b4643823 100644 --- a/LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean +++ b/LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle public import LeanPool.ApollonianSuperharmonic.SimpleGridPath public import LeanPool.ApollonianSuperharmonic.SimpleGridCycleSubgraphDegreeTwo @@ -38,7 +40,7 @@ private theorem splitInterior : cases s with | nil => intro hn x hx hh hl - simp? at hx + simp only [List.mem_cons, List.not_mem_nil, or_false] at hx subst x exact False.elim (hh rfl) | cons v t => diff --git a/LeanPool/ApollonianSuperharmonic/P4651T1FreeBoundaryHalfTurn.lean b/LeanPool/ApollonianSuperharmonic/P4651T1FreeBoundaryHalfTurn.lean index e24d7ee4d9..4a0f64d6bc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4651T1FreeBoundaryHalfTurn.lean +++ b/LeanPool/ApollonianSuperharmonic/P4651T1FreeBoundaryHalfTurn.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4590T1CentralDiskSectors public import LeanPool.ApollonianSuperharmonic.P4397T1ReflectedEdgeNotBoundary public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior diff --git a/LeanPool/ApollonianSuperharmonic/P4651T1GridHalfTurnTransport.lean b/LeanPool/ApollonianSuperharmonic/P4651T1GridHalfTurnTransport.lean index f96c6d1deb..566feddc9f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4651T1GridHalfTurnTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4651T1GridHalfTurnTransport.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership -public import Mathlib.Tactic.Linarith -- [TABLET NODE: P4651T1GridHalfTurnTransport] diff --git a/LeanPool/ApollonianSuperharmonic/P4670T1ComplementReflection.lean b/LeanPool/ApollonianSuperharmonic/P4670T1ComplementReflection.lean index ff357b2f69..ff7dfd0e3b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4670T1ComplementReflection.lean +++ b/LeanPool/ApollonianSuperharmonic/P4670T1ComplementReflection.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt public import LeanPool.ApollonianSuperharmonic.TileCellComplement public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership -public import Mathlib.Tactic.Linarith -- [TABLET NODE: P4670T1ComplementReflection] diff --git a/LeanPool/ApollonianSuperharmonic/P4670T1OrdinaryEdges.lean b/LeanPool/ApollonianSuperharmonic/P4670T1OrdinaryEdges.lean index 7e7a8b9abf..9567abd820 100644 --- a/LeanPool/ApollonianSuperharmonic/P4670T1OrdinaryEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4670T1OrdinaryEdges.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas diff --git a/LeanPool/ApollonianSuperharmonic/P4670T1SmallerGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4670T1SmallerGeometry.lean index 64b0c3ac04..5d32592629 100644 --- a/LeanPool/ApollonianSuperharmonic/P4670T1SmallerGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4670T1SmallerGeometry.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrence public import LeanPool.ApollonianSuperharmonic.FordTileGeometry -public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -- [TABLET NODE: P4670T1SmallerGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2DrawingData.lean b/LeanPool/ApollonianSuperharmonic/P4677T2DrawingData.lean index be88aa53f8..95ad7bba5b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2DrawingData.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2DrawingData.lean @@ -5,10 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Constructions +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation -- [TABLET NODE: P4677T2DrawingData] diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2DrawingExists.lean b/LeanPool/ApollonianSuperharmonic/P4677T2DrawingExists.lean index e44cb62846..00dd765655 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2DrawingExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2DrawingExists.lean @@ -5,12 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4677T2DrawingData public import LeanPool.ApollonianSuperharmonic.P4715T1LatticeCoordinates public import LeanPool.ApollonianSuperharmonic.P4715T1PlaneMap public import LeanPool.ApollonianSuperharmonic.P4715T1CoefficientEdges public import LeanPool.ApollonianSuperharmonic.P4715T1CoefficientFaces -public import LeanPool.ApollonianSuperharmonic.P4715T1CoefficientTranslation public import LeanPool.ApollonianSuperharmonic.P4715T1OrbitRepresentatives -- [TABLET NODE: P4677T2DrawingExists] diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean b/LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean index 506af00d4c..6e4bb3d6cc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4677T2DrawingData public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.TouchingTriple @@ -471,7 +473,10 @@ private theorem occurrence_shift (P : Fin 3 → Bool → ProtoTile) (u : Gaussia cases f with | mk l m n => cases l <;> fin_cases i <;> - simp? [SixSubtileFaceVertices, SubtileOccurrenceInterpretation] <;> + simp only [SubtileOccurrenceInterpretation, SixSubtileFaceVertices, Fin.mk_one, + Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, Int.cast_add, Int.cast_one, + zero_add, Int.cast_zero, zero_mul, one_mul, Int.cast_sub, zero_sub, Int.reduceNeg, + Int.cast_neg, neg_mul, add_zero, Fin.reduceFinMk, Matrix.cons_val, Fin.zero_eta] <;> rw [translate_comp] <;> congr 1 <;> ring_nf private noncomputable abbrev rho (u : GaussianInt) (v : GaussianInt) (p1 : GaussianInt) (p2 : diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2IncidenceLedger.lean b/LeanPool/ApollonianSuperharmonic/P4677T2IncidenceLedger.lean index efb5ec8cde..2ad25ed270 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2IncidenceLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2IncidenceLedger.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.FinCases + public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -public import Mathlib.Tactic.FinCases public import Mathlib.Data.Int.Interval @@ -24,6 +26,30 @@ Changes: pool module paths, public exports, project namespace and current Mathli namespace ApollonianSuperharmonic +private theorem incidenceFaceEdges (f : PeriodicSubtileFaceIndex) : + AllowedSubtileIncidence (SixSubtileFaceVertices f 0) (SixSubtileFaceVertices f 1) ∧ + AllowedSubtileIncidence (SixSubtileFaceVertices f 0) (SixSubtileFaceVertices f 2) ∧ + AllowedSubtileIncidence (SixSubtileFaceVertices f 1) (SixSubtileFaceVertices f 2) := by + rcases f with ⟨l, m, n⟩ + cases l <;> dsimp [SixSubtileFaceVertices] + · exact ⟨.AB m n, .AC m n, .BC m n⟩ + · exact ⟨.AB m n, .AD m n, .BD m n⟩ + · exact ⟨.AC m n, .AF m n, .CF m n⟩ + · exact ⟨.BD m n, .BE m n, .DE m n⟩ + · exact ⟨.AB01 m n, .AE01 m n, .BE m (n + 1)⟩ + · refine ⟨.AB01 m n, .AF m n, ?_⟩ + simpa using AllowedSubtileIncidence.BF0m1 m (n + 1) + · exact ⟨.AB11 m n, .AC11 m n, .BC (m + 1) (n + 1)⟩ + · refine ⟨.AB11 m n, .AD m n, ?_⟩ + simpa using AllowedSubtileIncidence.BDm1m1 (m + 1) (n + 1) + · refine ⟨.AC11 m n, .AE01 m n, ?_⟩ + simpa using AllowedSubtileIncidence.CEm10 (m + 1) (n + 1) + · refine ⟨.BDm1m1 m n, .BF0m1 m n, ?_⟩ + simpa using AllowedSubtileIncidence.DF10 (m - 1) (n - 1) + · exact ⟨.CDm10 m n, .CEm10 m n, .DE (m - 1) n⟩ + · refine ⟨.CDm10 m n, .CF m n, ?_⟩ + simpa using AllowedSubtileIncidence.DF10 (m - 1) n + theorem P4677T2IncidenceLedger : (∀ a b, AllowedSubtileIncidence a b ↔ AllowedSubtileIncidence b a) ∧ (∀ a, ¬ AllowedSubtileIncidence a a) ∧ @@ -74,44 +100,38 @@ theorem P4677T2IncidenceLedger : rcases a with ⟨al, m, n⟩ rcases b with ⟨bl, p, q⟩ cases al <;> cases bl <;> simp only [forward] at h - all_goals repeat' (rcases h with h | h) - all_goals first - | (convert AllowedSubtileIncidence.AB m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] - <;> omega) - | (convert AllowedSubtileIncidence.AB01 m n using 1 <;> simp - [PeriodicSubtileIndex.mk.injEq] <;> omega) - | (convert AllowedSubtileIncidence.AB11 m n using 1 <;> simp - [PeriodicSubtileIndex.mk.injEq] <;> omega) - | (convert AllowedSubtileIncidence.AC m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] - <;> omega) - | (convert AllowedSubtileIncidence.AC11 m n using 1 <;> simp - [PeriodicSubtileIndex.mk.injEq] <;> omega) - | (convert AllowedSubtileIncidence.AD m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] - <;> omega) - | (convert AllowedSubtileIncidence.AE01 m n using 1 <;> simp - [PeriodicSubtileIndex.mk.injEq] <;> omega) - | (convert AllowedSubtileIncidence.AF m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] - <;> omega) - | (convert AllowedSubtileIncidence.BC m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] - <;> omega) - | (convert AllowedSubtileIncidence.BDm1m1 m n using 1 <;> simp - [PeriodicSubtileIndex.mk.injEq] <;> omega) - | (convert AllowedSubtileIncidence.BD m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] - <;> omega) - | (convert AllowedSubtileIncidence.BE m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] - <;> omega) - | (convert AllowedSubtileIncidence.BF0m1 m n using 1 <;> simp - [PeriodicSubtileIndex.mk.injEq] <;> omega) - | (convert AllowedSubtileIncidence.CDm10 m n using 1 <;> simp - [PeriodicSubtileIndex.mk.injEq] <;> omega) - | (convert AllowedSubtileIncidence.CEm10 m n using 1 <;> simp - [PeriodicSubtileIndex.mk.injEq] <;> omega) - | (convert AllowedSubtileIncidence.CF m n using 1 <;> simp [PeriodicSubtileIndex.mk.injEq] - <;> omega) - | (convert AllowedSubtileIncidence.DE m n using 1; - simp [PeriodicSubtileIndex.mk.injEq]; omega) - | (convert AllowedSubtileIncidence.DF10 m n using 1; simp - [PeriodicSubtileIndex.mk.injEq]; omega) + · rcases h with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact AllowedSubtileIncidence.AB _ _ + · exact AllowedSubtileIncidence.AB01 _ _ + · exact AllowedSubtileIncidence.AB11 _ _ + · rcases h with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact AllowedSubtileIncidence.AC _ _ + · exact AllowedSubtileIncidence.AC11 _ _ + · rcases h with ⟨rfl, rfl⟩ + exact AllowedSubtileIncidence.AD _ _ + · rcases h with ⟨rfl, rfl⟩ + exact AllowedSubtileIncidence.AE01 _ _ + · rcases h with ⟨rfl, rfl⟩ + exact AllowedSubtileIncidence.AF _ _ + · rcases h with ⟨rfl, rfl⟩ + exact AllowedSubtileIncidence.BC _ _ + · rcases h with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · exact AllowedSubtileIncidence.BD _ _ + · exact AllowedSubtileIncidence.BDm1m1 _ _ + · rcases h with ⟨rfl, rfl⟩ + exact AllowedSubtileIncidence.BE _ _ + · rcases h with ⟨rfl, rfl⟩ + exact AllowedSubtileIncidence.BF0m1 _ _ + · rcases h with ⟨rfl, rfl⟩ + exact AllowedSubtileIncidence.CDm10 _ _ + · rcases h with ⟨rfl, rfl⟩ + exact AllowedSubtileIncidence.CEm10 _ _ + · rcases h with ⟨rfl, rfl⟩ + exact AllowedSubtileIncidence.CF _ _ + · rcases h with ⟨rfl, rfl⟩ + exact AllowedSubtileIncidence.DE _ _ + · rcases h with ⟨rfl, rfl⟩ + exact AllowedSubtileIncidence.DF10 _ _ have normal_iff (a b) : AllowedSubtileIncidence a b ↔ forward a b ∨ forward b a := ⟨normal, fun h => h.elim (positive a b) (fun h => .symm (positive b a h))⟩ refine ⟨fun a b => ⟨AllowedSubtileIncidence.symm, AllowedSubtileIncidence.symm⟩, @@ -145,10 +165,12 @@ theorem P4677T2IncidenceLedger : cases l <;> fin_cases i <;> fin_cases j <;> simp [SixSubtileFaceVertices, PeriodicSubtileIndex.mk.injEq] at hij ⊢ · intro f i j hij - rcases f with ⟨l, m, n⟩ - cases l <;> fin_cases i <;> fin_cases j <;> try contradiction - all_goals rw [normal_iff] - all_goals simp [SixSubtileFaceVertices, forward] + obtain ⟨h01, h02, h12⟩ := incidenceFaceEdges f + fin_cases i <;> fin_cases j + all_goals first + | exact (hij rfl).elim + | assumption + | apply AllowedSubtileIncidence.symm; assumption · intro a b hab have occurs (f : PeriodicSubtileFaceIndex) (a : PeriodicSubtileIndex) : (∃ i, SixSubtileFaceVertices f i = a) ↔ @@ -188,8 +210,6 @@ theorem P4677T2IncidenceLedger : case' DE m n => refine ⟨⟨.I4, m, n⟩, ⟨.J7, m + 1, n⟩, ?_, ?_, ?_, ?_⟩ case' DF10 m n => refine ⟨⟨.J6, m + 1, n + 1⟩, ⟨.J8, m + 1, n⟩, ?_, ?_, ?_, ?_⟩ all_goals first - | (solve | (try simp only [occurs]); simp [SixSubtileFaceVertices, - PeriodicSubtileIndex.mk.injEq, PeriodicSubtileFaceIndex.mk.injEq]) | (intro h hh simp only [occurs] at hh rcases h with ⟨hl, p, q⟩ @@ -197,6 +217,8 @@ theorem P4677T2IncidenceLedger : simp [SixSubtileFaceVertices, PeriodicSubtileIndex.mk.injEq, PeriodicSubtileFaceIndex.mk.injEq] at hh ⊢ <;> omega) + | (solve | (try simp only [occurs]); simp [SixSubtileFaceVertices, + PeriodicSubtileIndex.mk.injEq, PeriodicSubtileFaceIndex.mk.injEq]) end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2PeriodicWalkAssembly.lean b/LeanPool/ApollonianSuperharmonic/P4677T2PeriodicWalkAssembly.lean index f0c0ff4dcb..c3fc8e64e1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2PeriodicWalkAssembly.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2PeriodicWalkAssembly.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4733T1RepresentativeWalks public import LeanPool.ApollonianSuperharmonic.P4733T1FacePairNormalForm public import LeanPool.ApollonianSuperharmonic.P4733T1WalkExtension diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean index d8b4cf9884..d53a4a4c56 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4677T2TouchingWalk -public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected public import LeanPool.ApollonianSuperharmonic.TouchingTriple public import LeanPool.ApollonianSuperharmonic.LatticeTileBoundarySimpleGridCycle -public import Mathlib.Data.List.Chain -- [TABLET NODE: P4677T2PrecursorWalk] diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean b/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean index 3e00f81b79..19796f2b74 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean @@ -5,13 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4677T2IncidenceLedger public import LeanPool.ApollonianSuperharmonic.P3161T1BlockTreeReachability -public import Mathlib.Logic.Relation -public import Mathlib.Data.List.Basic -public import Mathlib.Data.List.Nodup -public import Mathlib.Data.List.Chain -public import Mathlib.Tactic.FinCases -- [TABLET NODE: P4677T2ThreeConnected] @@ -142,7 +139,7 @@ private theorem adjacent : | mk l m n => cases l · intro u hu - simp? [linkList] at hu + simp only [List.mem_cons, List.not_mem_nil, or_false, linkList] at hu rcases hu with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl · exact .AB m n · exact .AD m n @@ -153,7 +150,7 @@ private theorem adjacent : · exact .AF m n · exact .AC m n · intro u hu - simp? [linkList] at hu + simp only [List.mem_cons, List.not_mem_nil, or_false, linkList] at hu rcases hu with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl · simpa [sub_add_cancel] using (AllowedSubtileIncidence.AB11 (m-1) (n-1)).symm · exact AllowedSubtileIncidence.BDm1m1 m n @@ -164,7 +161,7 @@ private theorem adjacent : · exact (AllowedSubtileIncidence.AB m n).symm · exact .BC m n · intro u hu - simp? [linkList] at hu + simp only [List.mem_cons, List.not_mem_nil, or_false, linkList] at hu rcases hu with rfl | rfl | rfl | rfl | rfl | rfl · simpa [sub_add_cancel] using (AllowedSubtileIncidence.AC11 (m-1) (n-1)).symm · exact (AllowedSubtileIncidence.BC m n).symm @@ -173,7 +170,7 @@ private theorem adjacent : · exact AllowedSubtileIncidence.CDm10 m n · exact AllowedSubtileIncidence.CEm10 m n · intro u hu - simp? [linkList] at hu + simp only [List.mem_cons, List.not_mem_nil, or_false, linkList] at hu rcases hu with rfl | rfl | rfl | rfl | rfl | rfl · exact (AllowedSubtileIncidence.AD m n).symm · exact (AllowedSubtileIncidence.BD m n).symm @@ -183,14 +180,14 @@ private theorem adjacent : · simpa [add_sub_cancel_right] using (AllowedSubtileIncidence.BDm1m1 (m+1) (n+1)).symm · intro u hu - simp? [linkList] at hu + simp only [List.mem_cons, List.not_mem_nil, or_false, linkList] at hu rcases hu with rfl | rfl | rfl | rfl · simpa [sub_add_cancel] using (AllowedSubtileIncidence.AE01 m (n-1)).symm · simpa [add_sub_cancel_right] using (AllowedSubtileIncidence.CEm10 (m+1) n).symm · exact (AllowedSubtileIncidence.DE m n).symm · exact (AllowedSubtileIncidence.BE m n).symm · intro u hu - simp? [linkList] at hu + simp only [List.mem_cons, List.not_mem_nil, or_false, linkList] at hu rcases hu with rfl | rfl | rfl | rfl · exact (AllowedSubtileIncidence.AF m n).symm · simpa [add_sub_cancel_right] using (AllowedSubtileIncidence.BF0m1 m (n+1)).symm @@ -310,7 +307,7 @@ private theorem cut_chain : rw [hi] at hdchain simpa [hi, List.drop] using hdchain · by_cases hd : p.drop (i + 1) = [] - · simp? [hd] + · simp only [hd, List.nil_append] exact htchain · apply List.IsChain.append hdchain htchain intro x hx y hy @@ -577,7 +574,9 @@ private theorem common_neighbor : have hyy : AllowedSubtileIncidence y y := by simpa [this] using h exact (P4677T2IncidenceLedger.2.1 y) hyy have hk : ∃ k : Fin 3, k ≠ i ∧ k ≠ j := by - fin_cases i <;> fin_cases j <;> simp_all? <;> + fin_cases i <;> fin_cases j <;> simp_all only [ne_eq, and_imp, forall_exists_index, + Fin.mk_one, Fin.isValue, Fin.reduceFinMk, Fin.reduceEq, not_false_eq_true, + Fin.zero_eta, not_true_eq_false] <;> first | exact ⟨0, by decide, by decide⟩ | exact ⟨1, by decide, by decide⟩ | exact ⟨2, by decide, by decide⟩ @@ -800,7 +799,7 @@ private theorem closure_list : · intro w hw rcases List.mem_append.mp hw with hwp | hwz · exact hsafe w hwp - · simp? at hwz + · simp only [List.mem_cons, List.not_mem_nil, or_false] at hwz subst w exact hyz.2.2 diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2TouchingWalk.lean b/LeanPool/ApollonianSuperharmonic/P4677T2TouchingWalk.lean index 4171d48bf2..fece021c9c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2TouchingWalk.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2TouchingWalk.lean @@ -5,11 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileTouching public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge -public import Mathlib.Data.List.Chain +public import LeanPool.ApollonianSuperharmonic.FootprintVertices -- [TABLET NODE: P4677T2TouchingWalk] diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1Arc.lean b/LeanPool/ApollonianSuperharmonic/P4715T1Arc.lean index 81790947e0..a5895c5084 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1Arc.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1Arc.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4715T1Position public import Mathlib.Analysis.Convex.Segment diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1BoundaryCycle.lean b/LeanPool/ApollonianSuperharmonic/P4715T1BoundaryCycle.lean index e808ade8f0..8c9d0ecc5c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1BoundaryCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1BoundaryCycle.lean @@ -5,6 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Data.Fin.VecNotation + public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex -- [TABLET NODE: P4715T1BoundaryCycle] diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientEdges.lean b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientEdges.lean index eebf3e1c48..08558ba212 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientEdges.lean @@ -5,15 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonTessellation -public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonSubdivision +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4715T1PatchEnumeration -public import LeanPool.ApollonianSuperharmonic.P4715T1PositionInjective public import LeanPool.ApollonianSuperharmonic.P4677T2IncidenceLedger public import LeanPool.ApollonianSuperharmonic.P4802T1PatchFaceRestriction public import LeanPool.ApollonianSuperharmonic.P4802T1CrossPatchFaces -public import Mathlib.Topology.Homeomorph.Lemmas -public import Mathlib.Tactic.FunProp -- [TABLET NODE: P4715T1CoefficientEdges] diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean index bad3b4fb7b..1def4471b0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean @@ -5,16 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonTessellation +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonSubdivision public import LeanPool.ApollonianSuperharmonic.P4715T1PatchEnumeration -public import LeanPool.ApollonianSuperharmonic.P4715T1PositionInjective public import LeanPool.ApollonianSuperharmonic.P4715T1Region public import LeanPool.ApollonianSuperharmonic.P4677T2IncidenceLedger public import Mathlib.Analysis.Convex.PathConnected -public import Mathlib.Tactic.Ring -public import Mathlib.Tactic.NormNum -public import Mathlib.Tactic.Linarith -- [TABLET NODE: P4715T1CoefficientFaces] @@ -184,7 +182,9 @@ private theorem mem_bottom_segment : · rintro ⟨t, ht, heq⟩ have h1 := congrArg Prod.fst heq have h2 := congrArg Prod.snd heq - simp? [AffineMap.lineMap_apply] at h1 h2 + simp only [AffineMap.lineMap_apply, vsub_eq_sub, Prod.mk_sub_mk, sub_zero, sub_self, + Prod.smul_mk, smul_eq_mul, mul_one, mul_zero, vadd_eq_add, Prod.mk_add_mk, add_zero] + at h1 h2 exact ⟨h2.symm, by simpa [h1] using ht.1, by simpa [h1] using ht.2⟩ · rintro ⟨h2,h1,h1le⟩ refine ⟨z.1, ⟨h1,h1le⟩, ?_⟩ @@ -203,7 +203,9 @@ private theorem mem_diagonal_segment : · rintro ⟨t, ht, heq⟩ have h1 := congrArg Prod.fst heq have h2 := congrArg Prod.snd heq - simp? [AffineMap.lineMap_apply] at h1 h2 + simp only [AffineMap.lineMap_apply, vsub_eq_sub, Prod.mk_sub_mk, zero_sub, sub_zero, + Prod.smul_mk, smul_eq_mul, mul_neg, mul_one, vadd_eq_add, Prod.mk_add_mk, add_zero] + at h1 h2 exact ⟨by linarith [h1,h2], by linarith [h1,ht.2], by linarith [h2,ht.1]⟩ · rintro ⟨hsum,h1,h2⟩ refine ⟨z.2, ⟨h2, by linarith [hsum,h1]⟩, ?_⟩ @@ -222,7 +224,9 @@ private theorem mem_left_segment : · rintro ⟨t, ht, heq⟩ have h1 := congrArg Prod.fst heq have h2 := congrArg Prod.snd heq - simp? [AffineMap.lineMap_apply] at h1 h2 + simp only [AffineMap.lineMap_apply, vsub_eq_sub, Prod.mk_sub_mk, sub_self, sub_zero, + Prod.smul_mk, smul_eq_mul, mul_zero, mul_one, vadd_eq_add, Prod.mk_add_mk, add_zero] + at h1 h2 exact ⟨h1.symm, by simpa [h2] using ht.1, by simpa [h2] using ht.2⟩ · rintro ⟨h1,h2,h2le⟩ refine ⟨z.2, ⟨h2,h2le⟩, ?_⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientTranslation.lean b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientTranslation.lean index 3fdbf30d0b..a8b4b2a1b3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientTranslation.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientTranslation.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4715T1IndexAction public import LeanPool.ApollonianSuperharmonic.P4715T1Arc public import LeanPool.ApollonianSuperharmonic.P4715T1Region -public import Mathlib.Tactic.Module -- [TABLET NODE: P4715T1CoefficientTranslation] diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1FaceShift.lean b/LeanPool/ApollonianSuperharmonic/P4715T1FaceShift.lean index 90fd7617c6..7a5b2982a3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1FaceShift.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1FaceShift.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Prod + public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileFaceIndex -- [TABLET NODE: P4715T1FaceShift] diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1Hexagon.lean b/LeanPool/ApollonianSuperharmonic/P4715T1Hexagon.lean index 9078e37604..d4aee92602 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1Hexagon.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1Hexagon.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4715T1Position public import LeanPool.ApollonianSuperharmonic.P4715T1BoundaryCycle public import Mathlib.Analysis.Convex.Hull diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1HexagonSubdivision.lean b/LeanPool/ApollonianSuperharmonic/P4715T1HexagonSubdivision.lean index 11ddde5883..f6224c1c29 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1HexagonSubdivision.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1HexagonSubdivision.lean @@ -5,14 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4715T1Hexagon public import LeanPool.ApollonianSuperharmonic.P4715T1PatchFaces public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -public import LeanPool.ApollonianSuperharmonic.P4783T1PatchCoverage public import LeanPool.ApollonianSuperharmonic.P4783T1PatchDeterminants public import LeanPool.ApollonianSuperharmonic.P4793T1PatchIntersections public import LeanPool.ApollonianSuperharmonic.P4793T1PatchBoundaryTraces -public import Mathlib.Analysis.Convex.Topology -- [TABLET NODE: P4715T1HexagonSubdivision] diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1HexagonTessellation.lean b/LeanPool/ApollonianSuperharmonic/P4715T1HexagonTessellation.lean index f7986c3442..6f8b87f803 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1HexagonTessellation.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1HexagonTessellation.lean @@ -5,17 +5,16 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4715T1Hexagon public import LeanPool.ApollonianSuperharmonic.P4715T1VertexShift public import LeanPool.ApollonianSuperharmonic.P4715T1Arc -public import LeanPool.ApollonianSuperharmonic.P4780T1StrictInterior -public import LeanPool.ApollonianSuperharmonic.P4780T1ActiveFacets public import LeanPool.ApollonianSuperharmonic.P4780T1IntegerCoverage public import LeanPool.ApollonianSuperharmonic.P4780T1InteriorSeparation public import LeanPool.ApollonianSuperharmonic.P4780T1NeighborFacets public import LeanPool.ApollonianSuperharmonic.P4780T1NeighborCorners public import LeanPool.ApollonianSuperharmonic.P4715T1CoefficientTranslation -public import Mathlib.Tactic.Abel -- [TABLET NODE: P4715T1HexagonTessellation] diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1IndexAction.lean b/LeanPool/ApollonianSuperharmonic/P4715T1IndexAction.lean index 6b9b66bde0..7f31498bc1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1IndexAction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1IndexAction.lean @@ -5,11 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.Fintype.Fin +public import Mathlib.Tactic.FinCases + public import LeanPool.ApollonianSuperharmonic.P4715T1VertexShift public import LeanPool.ApollonianSuperharmonic.P4715T1FaceShift public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -public import Mathlib.Tactic.FinCases -- [TABLET NODE: P4715T1IndexAction] diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1LatticeCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4715T1LatticeCoordinates.lean index 0af507a894..6e01329870 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1LatticeCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1LatticeCoordinates.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import Mathlib.Tactic.Ring +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: P4715T1LatticeCoordinates] diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1Offsets.lean b/LeanPool/ApollonianSuperharmonic/P4715T1Offsets.lean index 6977111e10..c98c2cb97e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1Offsets.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1Offsets.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Basic.Real.Basic + public import LeanPool.ApollonianSuperharmonic.SixSubtileLabel -- [TABLET NODE: P4715T1Offsets] diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1OrbitRepresentatives.lean b/LeanPool/ApollonianSuperharmonic/P4715T1OrbitRepresentatives.lean index ce45b7880c..5a5bd40937 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1OrbitRepresentatives.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1OrbitRepresentatives.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4715T1IndexAction public import LeanPool.ApollonianSuperharmonic.P4677T2IncidenceLedger diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1PatchEnumeration.lean b/LeanPool/ApollonianSuperharmonic/P4715T1PatchEnumeration.lean index f3761f47c6..6ccd8f316f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1PatchEnumeration.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1PatchEnumeration.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.Fintype.Fin +public import Mathlib.Tactic.FinCases + public import LeanPool.ApollonianSuperharmonic.P4715T1PatchFaces public import LeanPool.ApollonianSuperharmonic.P4715T1FaceShift -public import Mathlib.Tactic.FinCases -- [TABLET NODE: P4715T1PatchEnumeration] diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1PatchFaces.lean b/LeanPool/ApollonianSuperharmonic/P4715T1PatchFaces.lean index 15c00df58e..7b416cd9d3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1PatchFaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1PatchFaces.lean @@ -5,6 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Data.Fin.VecNotation + public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileFaceIndex -- [TABLET NODE: P4715T1PatchFaces] diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1PlaneMap.lean b/LeanPool/ApollonianSuperharmonic/P4715T1PlaneMap.lean index f845b78f39..6710fbd77d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1PlaneMap.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1PlaneMap.lean @@ -5,15 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint public import Mathlib.Topology.Algebra.Module.Equiv.Basic -public import Mathlib.Topology.Algebra.Module.Equiv.Pi -public import Mathlib.Topology.Algebra.Module.Equiv.Prod -public import Mathlib.Topology.Algebra.Module.Equiv.Submodule -public import Mathlib.Analysis.Normed.Module.Basic -public import Mathlib.Tactic.FunProp -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.Ring +public import Mathlib.Analysis.Normed.Group.Basic +public import Mathlib.Topology.Algebra.InfiniteSum.Order +public import Mathlib.Topology.Algebra.Ring.Real -- [TABLET NODE: P4715T1PlaneMap] diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1Position.lean b/LeanPool/ApollonianSuperharmonic/P4715T1Position.lean index 11032698b8..7fdd5127aa 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1Position.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1Position.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4715T1Offsets public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1PositionInjective.lean b/LeanPool/ApollonianSuperharmonic/P4715T1PositionInjective.lean index d49e6147d1..3b60545def 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1PositionInjective.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1PositionInjective.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4715T1Position -public import Mathlib.Tactic.NormNum +public import Mathlib.Init public import Mathlib.Tactic.Linarith +public import LeanPool.ApollonianSuperharmonic.P4715T1Position + -- [TABLET NODE: P4715T1PositionInjective] /-! diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1Region.lean b/LeanPool/ApollonianSuperharmonic/P4715T1Region.lean index 19fb5a17bf..140ae85f18 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1Region.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1Region.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4715T1Position public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1VertexShift.lean b/LeanPool/ApollonianSuperharmonic/P4715T1VertexShift.lean index bd30ed594e..36814de0d3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1VertexShift.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1VertexShift.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Prod + public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex -- [TABLET NODE: P4715T1VertexShift] diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1ContainedWalk.lean b/LeanPool/ApollonianSuperharmonic/P4733T1ContainedWalk.lean index 1c73c4c764..5e0304e6d4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4733T1ContainedWalk.lean +++ b/LeanPool/ApollonianSuperharmonic/P4733T1ContainedWalk.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1Coordinates.lean b/LeanPool/ApollonianSuperharmonic/P4733T1Coordinates.lean index 8398ae6403..a1a7e0eb4d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4733T1Coordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4733T1Coordinates.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4677T2DrawingData -- [TABLET NODE: P4733T1Coordinates] diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1EdgeOrbit.lean b/LeanPool/ApollonianSuperharmonic/P4733T1EdgeOrbit.lean index 30d2443da7..83a0f10d11 100644 --- a/LeanPool/ApollonianSuperharmonic/P4733T1EdgeOrbit.lean +++ b/LeanPool/ApollonianSuperharmonic/P4733T1EdgeOrbit.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4733T1EdgeRow public import LeanPool.ApollonianSuperharmonic.P4733T1Coordinates diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1EdgeRow.lean b/LeanPool/ApollonianSuperharmonic/P4733T1EdgeRow.lean index ad5f80a4f3..c4f9fa5d32 100644 --- a/LeanPool/ApollonianSuperharmonic/P4733T1EdgeRow.lean +++ b/LeanPool/ApollonianSuperharmonic/P4733T1EdgeRow.lean @@ -5,7 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileFaceIndex +public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex -- [TABLET NODE: P4733T1EdgeRow] diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1FacePairNormalForm.lean b/LeanPool/ApollonianSuperharmonic/P4733T1FacePairNormalForm.lean index a00b6d0626..abd26f565c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4733T1FacePairNormalForm.lean +++ b/LeanPool/ApollonianSuperharmonic/P4733T1FacePairNormalForm.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4733T1FacePairOrbit public import LeanPool.ApollonianSuperharmonic.P4733T1EdgeOrbit public import LeanPool.ApollonianSuperharmonic.P4733T1RowIncidence diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1FacePairOrbit.lean b/LeanPool/ApollonianSuperharmonic/P4733T1FacePairOrbit.lean index c6a630f497..ce793cc4c4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4733T1FacePairOrbit.lean +++ b/LeanPool/ApollonianSuperharmonic/P4733T1FacePairOrbit.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4733T1EdgeRow public import LeanPool.ApollonianSuperharmonic.P4677T2DrawingData diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1OccurrenceTranslation.lean b/LeanPool/ApollonianSuperharmonic/P4733T1OccurrenceTranslation.lean index 3f4cd5cdfa..8485ddf5ff 100644 --- a/LeanPool/ApollonianSuperharmonic/P4733T1OccurrenceTranslation.lean +++ b/LeanPool/ApollonianSuperharmonic/P4733T1OccurrenceTranslation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4677T2DrawingData public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1RepresentativeWalks.lean b/LeanPool/ApollonianSuperharmonic/P4733T1RepresentativeWalks.lean index b0ae33e765..2c34dd7d5a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4733T1RepresentativeWalks.lean +++ b/LeanPool/ApollonianSuperharmonic/P4733T1RepresentativeWalks.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4733T1EdgeRow public import LeanPool.ApollonianSuperharmonic.P4733T1RowIncidence public import LeanPool.ApollonianSuperharmonic.P4733T1ContainedWalk diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1RowIncidence.lean b/LeanPool/ApollonianSuperharmonic/P4733T1RowIncidence.lean index aa1a6a5a41..bb77056a1b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4733T1RowIncidence.lean +++ b/LeanPool/ApollonianSuperharmonic/P4733T1RowIncidence.lean @@ -5,9 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.Fintype.Fin +public import Mathlib.Tactic.FinCases + public import LeanPool.ApollonianSuperharmonic.P4733T1EdgeRow public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence -public import Mathlib.Tactic.FinCases +public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices -- [TABLET NODE: P4733T1RowIncidence] diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1RowLabelRigidity.lean b/LeanPool/ApollonianSuperharmonic/P4733T1RowLabelRigidity.lean index 608d32ac0a..98f3871f17 100644 --- a/LeanPool/ApollonianSuperharmonic/P4733T1RowLabelRigidity.lean +++ b/LeanPool/ApollonianSuperharmonic/P4733T1RowLabelRigidity.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.Fintype.Prod + public import LeanPool.ApollonianSuperharmonic.P4733T1EdgeRow -- [TABLET NODE: P4733T1RowLabelRigidity] diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1WalkExtension.lean b/LeanPool/ApollonianSuperharmonic/P4733T1WalkExtension.lean index d0b54b41f5..3438c2ef3d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4733T1WalkExtension.lean +++ b/LeanPool/ApollonianSuperharmonic/P4733T1WalkExtension.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4733T1FacePairOrbit -public import LeanPool.ApollonianSuperharmonic.P4733T1RowIncidence -- [TABLET NODE: P4733T1WalkExtension] diff --git a/LeanPool/ApollonianSuperharmonic/P4733T1WalkTransport.lean b/LeanPool/ApollonianSuperharmonic/P4733T1WalkTransport.lean index 87e3ad6796..4b57f6a215 100644 --- a/LeanPool/ApollonianSuperharmonic/P4733T1WalkTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4733T1WalkTransport.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4733T1ContainedWalk public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import Mathlib.Data.List.Chain -- [TABLET NODE: P4733T1WalkTransport] diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1ActiveFacets.lean b/LeanPool/ApollonianSuperharmonic/P4780T1ActiveFacets.lean index c63dd8ae77..60554671d3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4780T1ActiveFacets.lean +++ b/LeanPool/ApollonianSuperharmonic/P4780T1ActiveFacets.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4780T1HullHalfspaces public import LeanPool.ApollonianSuperharmonic.P4715T1Arc @@ -34,8 +36,12 @@ theorem P4780T1ActiveFacets (j : Fin 6) : · intro hp fin_cases j all_goals - simp? [P4715T1Arc, P4715T1Position, P4715T1BoundaryCycle, - P4715T1Offsets] at hp ⊢ + simp only [P4715T1Arc, P4715T1Position, P4715T1BoundaryCycle, Int.reduceNeg, Fin.mk_one, + Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, Int.cast_zero, + P4715T1Offsets, Prod.mk_add_mk, zero_add, Fin.reduceAdd, Matrix.cons_val, + Int.cast_neg, Int.cast_one, add_zero, neg_le_sub_iff_le_add, tsub_le_iff_right, + Nat.succ_eq_add_one, Nat.reduceAdd, Set.mem_inter_iff, Set.mem_ofPred_eq, + Fin.reduceFinMk, Fin.zero_eta] at hp ⊢ rw [segment_eq_image] at hp rcases hp with ⟨θ, ⟨hθ0, hθ1⟩, hp⟩ have hfst := congrArg Prod.fst hp @@ -45,8 +51,12 @@ theorem P4780T1ActiveFacets (j : Fin 6) : · intro hp fin_cases j all_goals - simp? [P4715T1Arc, P4715T1Position, P4715T1BoundaryCycle, - P4715T1Offsets] at hp ⊢ + simp only [neg_le_sub_iff_le_add, tsub_le_iff_right, zero_add, Nat.succ_eq_add_one, + Nat.reduceAdd, Fin.mk_one, Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, + Set.mem_inter_iff, Set.mem_ofPred_eq, P4715T1Arc, P4715T1Position, + P4715T1BoundaryCycle, Int.reduceNeg, Int.cast_zero, P4715T1Offsets, Prod.mk_add_mk, + Fin.reduceAdd, Matrix.cons_val, Int.cast_neg, Int.cast_one, add_zero, + Fin.reduceFinMk, Fin.zero_eta] at hp ⊢ rcases hp with ⟨⟨hx0, hx1, hy0, hy1, hz0, hz1⟩, heq⟩ rw [segment_eq_image] · refine ⟨-3*p.1, ⟨by linarith, by linarith⟩, ?_⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1HullHalfspaces.lean b/LeanPool/ApollonianSuperharmonic/P4780T1HullHalfspaces.lean index cdc2132242..40487231b4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4780T1HullHalfspaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P4780T1HullHalfspaces.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Linarith + public import LeanPool.ApollonianSuperharmonic.P4715T1Hexagon public import Mathlib.Analysis.Convex.Combination @@ -58,11 +61,14 @@ theorem P4780T1HullHalfspaces : let zz : Fin 3 → Real × Real := ![a, b, c] apply mem_convexHull_of_exists_fintype (w := ww) (z := zz) · intro i - fin_cases i <;> simp? [ww] <;> assumption + fin_cases i <;> simp only [Fin.mk_one, Fin.isValue, Matrix.cons_val_one, + Matrix.cons_val_zero, ww, Fin.reduceFinMk, Matrix.cons_val, Fin.zero_eta] <;> assumption · simp [ww, Fin.sum_univ_succ] linarith · intro i - fin_cases i <;> simp? [zz] <;> assumption + fin_cases i <;> simp only [Fin.mk_one, Fin.isValue, Matrix.cons_val_one, + Matrix.cons_val_zero, Set.mem_range, Function.comp_apply, zz, Fin.reduceFinMk, + Matrix.cons_val, Fin.zero_eta] <;> assumption · simpa [ww, zz, Fin.sum_univ_succ, add_assoc] using hp have hv0 : (0, 0) ∈ V := by exact ⟨0, by norm_num [P4715T1Position, P4715T1BoundaryCycle, P4715T1Offsets]⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1IntegerCoverage.lean b/LeanPool/ApollonianSuperharmonic/P4780T1IntegerCoverage.lean index 793db9029c..e20f3cedcc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4780T1IntegerCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/P4780T1IntegerCoverage.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4780T1HullHalfspaces +public import Mathlib.Init public import Mathlib.Algebra.Order.Archimedean.Real.Basic +public import LeanPool.ApollonianSuperharmonic.P4780T1HullHalfspaces + -- [TABLET NODE: P4780T1IntegerCoverage] /-! diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1InteriorSeparation.lean b/LeanPool/ApollonianSuperharmonic/P4780T1InteriorSeparation.lean index ba9b1d3bce..6527b61fae 100644 --- a/LeanPool/ApollonianSuperharmonic/P4780T1InteriorSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/P4780T1InteriorSeparation.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4780T1OverlapBound public import LeanPool.ApollonianSuperharmonic.P4780T1StrictInterior -public import Mathlib.Topology.Algebra.Group.Basic -- [TABLET NODE: P4780T1InteriorSeparation] diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1NeighborCorners.lean b/LeanPool/ApollonianSuperharmonic/P4780T1NeighborCorners.lean index 84ab417530..295bc46b7b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4780T1NeighborCorners.lean +++ b/LeanPool/ApollonianSuperharmonic/P4780T1NeighborCorners.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.Fintype.Card + public import LeanPool.ApollonianSuperharmonic.P4715T1VertexShift public import LeanPool.ApollonianSuperharmonic.P4715T1BoundaryCycle -public import Mathlib.Data.Fintype.Sets -- [TABLET NODE: P4780T1NeighborCorners] diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1NeighborFacets.lean b/LeanPool/ApollonianSuperharmonic/P4780T1NeighborFacets.lean index 5f7752152c..f1f0a706b7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4780T1NeighborFacets.lean +++ b/LeanPool/ApollonianSuperharmonic/P4780T1NeighborFacets.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4780T1ActiveFacets -- [TABLET NODE: P4780T1NeighborFacets] @@ -42,7 +44,12 @@ theorem P4780T1NeighborFacets (j : Fin 6) : ext p fin_cases j all_goals - simp? [ht, P4780T1HullHalfspaces] + simp only [P4780T1HullHalfspaces, neg_le_sub_iff_le_add, tsub_le_iff_right, zero_add, + Nat.succ_eq_add_one, Nat.reduceAdd, Int.reduceNeg, Fin.mk_one, Fin.isValue, + Matrix.cons_val_one, Matrix.cons_val_zero, Int.cast_zero, Int.cast_neg, Int.cast_one, + ht, Set.mem_ofPred_eq, Prod.snd_sub, sub_neg_eq_add, Prod.fst_sub, sub_zero, + Set.mem_inter_iff, and_congr_right_iff, and_imp, Fin.reduceFinMk, Matrix.cons_val, + sub_add_cancel, Fin.zero_eta] intro ha1 ha2 ha3 ha4 ha5 ha6 constructor · rintro ⟨hb1, hb2, hb3, hb4, hb5, hb6⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1OverlapBound.lean b/LeanPool/ApollonianSuperharmonic/P4780T1OverlapBound.lean index e2bb5224c0..2b381d008e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4780T1OverlapBound.lean +++ b/LeanPool/ApollonianSuperharmonic/P4780T1OverlapBound.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4780T1HullHalfspaces -- [TABLET NODE: P4780T1OverlapBound] diff --git a/LeanPool/ApollonianSuperharmonic/P4780T1StrictInterior.lean b/LeanPool/ApollonianSuperharmonic/P4780T1StrictInterior.lean index 062e362e51..316f72a789 100644 --- a/LeanPool/ApollonianSuperharmonic/P4780T1StrictInterior.lean +++ b/LeanPool/ApollonianSuperharmonic/P4780T1StrictInterior.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4780T1HullHalfspaces public import Mathlib.Topology.Algebra.Module.FiniteDimension -public import Mathlib.Topology.Maps.Basic -- [TABLET NODE: P4780T1StrictInterior] diff --git a/LeanPool/ApollonianSuperharmonic/P4783T1ParallelogramFan.lean b/LeanPool/ApollonianSuperharmonic/P4783T1ParallelogramFan.lean index 9e44875bb5..2889cceda0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4783T1ParallelogramFan.lean +++ b/LeanPool/ApollonianSuperharmonic/P4783T1ParallelogramFan.lean @@ -5,9 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Basic.Real.Basic +public import Mathlib.Data.Fin.VecNotation +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring + public import Mathlib.Analysis.Convex.Combination -public import Mathlib.Tactic.Module -- [TABLET NODE: P4783T1ParallelogramFan] diff --git a/LeanPool/ApollonianSuperharmonic/P4783T1PatchCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4783T1PatchCoordinates.lean index 6a5f7f362d..97657e828a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4783T1PatchCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4783T1PatchCoordinates.lean @@ -5,9 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.NormNum + public import LeanPool.ApollonianSuperharmonic.P4715T1Position public import LeanPool.ApollonianSuperharmonic.P4715T1PatchFaces public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices +public import Mathlib.LinearAlgebra.Matrix.Notation -- [TABLET NODE: P4783T1PatchCoordinates] diff --git a/LeanPool/ApollonianSuperharmonic/P4783T1PatchCoverage.lean b/LeanPool/ApollonianSuperharmonic/P4783T1PatchCoverage.lean index affb42ebfe..7b614d9ec2 100644 --- a/LeanPool/ApollonianSuperharmonic/P4783T1PatchCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/P4783T1PatchCoverage.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4715T1Hexagon public import LeanPool.ApollonianSuperharmonic.P4715T1PatchFaces public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceVertices diff --git a/LeanPool/ApollonianSuperharmonic/P4783T1PatchDeterminants.lean b/LeanPool/ApollonianSuperharmonic/P4783T1PatchDeterminants.lean index 83eda2488e..b5ec4351b9 100644 --- a/LeanPool/ApollonianSuperharmonic/P4783T1PatchDeterminants.lean +++ b/LeanPool/ApollonianSuperharmonic/P4783T1PatchDeterminants.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4783T1PatchCoordinates -- [TABLET NODE: P4783T1PatchDeterminants] diff --git a/LeanPool/ApollonianSuperharmonic/P4793T1FacetForms.lean b/LeanPool/ApollonianSuperharmonic/P4793T1FacetForms.lean index d6a57765f0..1481dc8f2c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4793T1FacetForms.lean +++ b/LeanPool/ApollonianSuperharmonic/P4793T1FacetForms.lean @@ -5,11 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble -public import Mathlib.LinearAlgebra.AffineSpace.AffineMap +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Basic.Real.Basic public import Mathlib.Data.Fin.VecNotation public import Mathlib.Tactic.Ring +public import Mathlib.LinearAlgebra.AffineSpace.AffineMap + -- [TABLET NODE: P4793T1FacetForms] /-! diff --git a/LeanPool/ApollonianSuperharmonic/P4793T1PatchBoundaryTraces.lean b/LeanPool/ApollonianSuperharmonic/P4793T1PatchBoundaryTraces.lean index 4413108dca..4e4d39f701 100644 --- a/LeanPool/ApollonianSuperharmonic/P4793T1PatchBoundaryTraces.lean +++ b/LeanPool/ApollonianSuperharmonic/P4793T1PatchBoundaryTraces.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4793T1PatchFacetLedger public import LeanPool.ApollonianSuperharmonic.P4793T1SupportingFace public import LeanPool.ApollonianSuperharmonic.P4783T1PatchCoverage diff --git a/LeanPool/ApollonianSuperharmonic/P4793T1PatchFacetLedger.lean b/LeanPool/ApollonianSuperharmonic/P4793T1PatchFacetLedger.lean index aad9951dac..fa1c631afb 100644 --- a/LeanPool/ApollonianSuperharmonic/P4793T1PatchFacetLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P4793T1PatchFacetLedger.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Linarith + public import LeanPool.ApollonianSuperharmonic.P4793T1FacetForms public import LeanPool.ApollonianSuperharmonic.P4783T1PatchCoordinates public import LeanPool.ApollonianSuperharmonic.P4715T1BoundaryCycle diff --git a/LeanPool/ApollonianSuperharmonic/P4793T1PatchIntersections.lean b/LeanPool/ApollonianSuperharmonic/P4793T1PatchIntersections.lean index 1d9c7cb6df..617987a8cd 100644 --- a/LeanPool/ApollonianSuperharmonic/P4793T1PatchIntersections.lean +++ b/LeanPool/ApollonianSuperharmonic/P4793T1PatchIntersections.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4793T1PatchSeparators public import LeanPool.ApollonianSuperharmonic.P4793T1SeparatorIntersection public import LeanPool.ApollonianSuperharmonic.P4715T1PositionInjective diff --git a/LeanPool/ApollonianSuperharmonic/P4793T1PatchSeparators.lean b/LeanPool/ApollonianSuperharmonic/P4793T1PatchSeparators.lean index e02eda5f9e..21245c2e49 100644 --- a/LeanPool/ApollonianSuperharmonic/P4793T1PatchSeparators.lean +++ b/LeanPool/ApollonianSuperharmonic/P4793T1PatchSeparators.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Linarith + public import LeanPool.ApollonianSuperharmonic.P4783T1PatchCoordinates -- [TABLET NODE: P4793T1PatchSeparators] diff --git a/LeanPool/ApollonianSuperharmonic/P4793T1SeparatorIntersection.lean b/LeanPool/ApollonianSuperharmonic/P4793T1SeparatorIntersection.lean index 832e526101..bf76643498 100644 --- a/LeanPool/ApollonianSuperharmonic/P4793T1SeparatorIntersection.lean +++ b/LeanPool/ApollonianSuperharmonic/P4793T1SeparatorIntersection.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4793T1SupportingFace -- [TABLET NODE: P4793T1SeparatorIntersection] diff --git a/LeanPool/ApollonianSuperharmonic/P4793T1SupportingFace.lean b/LeanPool/ApollonianSuperharmonic/P4793T1SupportingFace.lean index b0bae395f8..ce8751e62d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4793T1SupportingFace.lean +++ b/LeanPool/ApollonianSuperharmonic/P4793T1SupportingFace.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble -public import Mathlib.Analysis.Convex.Hull +public import Mathlib.Init +public import Mathlib.Basic.Real.Basic public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring + +public import Mathlib.Analysis.Convex.Hull -- [TABLET NODE: P4793T1SupportingFace] diff --git a/LeanPool/ApollonianSuperharmonic/P4802T1CrossPatchFaces.lean b/LeanPool/ApollonianSuperharmonic/P4802T1CrossPatchFaces.lean index 658cf1cefe..da00cee74f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4802T1CrossPatchFaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P4802T1CrossPatchFaces.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4802T1HexagonOverlapSide public import LeanPool.ApollonianSuperharmonic.P4802T1SideRestriction public import LeanPool.ApollonianSuperharmonic.P4802T1SimplexFaces diff --git a/LeanPool/ApollonianSuperharmonic/P4802T1HexagonOverlapSide.lean b/LeanPool/ApollonianSuperharmonic/P4802T1HexagonOverlapSide.lean index af9eaf0754..87a864495d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4802T1HexagonOverlapSide.lean +++ b/LeanPool/ApollonianSuperharmonic/P4802T1HexagonOverlapSide.lean @@ -5,7 +5,16 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonTessellation +public import Mathlib.Init + +public import LeanPool.ApollonianSuperharmonic.P4715T1CoefficientTranslation +public import LeanPool.ApollonianSuperharmonic.P4780T1NeighborFacets +public import LeanPool.ApollonianSuperharmonic.P4780T1OverlapBound +public import Mathlib.Algebra.Order.Field.Power +public import Mathlib.Analysis.Normed.Group.Basic +public import Mathlib.Analysis.Real.Sqrt +public import Mathlib.Data.EReal.Inv +public import Mathlib.Tactic.IntervalCases -- [TABLET NODE: P4802T1HexagonOverlapSide] diff --git a/LeanPool/ApollonianSuperharmonic/P4802T1PatchFaceRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4802T1PatchFaceRestriction.lean index 613cce985c..d443010620 100644 --- a/LeanPool/ApollonianSuperharmonic/P4802T1PatchFaceRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4802T1PatchFaceRestriction.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4802T1SimplexFaces public import LeanPool.ApollonianSuperharmonic.P4802T1TriangleIndependent public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonSubdivision -public import LeanPool.ApollonianSuperharmonic.P4715T1PositionInjective -- [TABLET NODE: P4802T1PatchFaceRestriction] diff --git a/LeanPool/ApollonianSuperharmonic/P4802T1SideRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4802T1SideRestriction.lean index 4163390dc6..0ad93152ba 100644 --- a/LeanPool/ApollonianSuperharmonic/P4802T1SideRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4802T1SideRestriction.lean @@ -5,11 +5,18 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4715T1CoefficientTranslation -public import LeanPool.ApollonianSuperharmonic.P4715T1BoundaryCycle public import LeanPool.ApollonianSuperharmonic.P4793T1SupportingFace public import LeanPool.ApollonianSuperharmonic.P4793T1FacetForms -public import LeanPool.ApollonianSuperharmonic.P4715T1HexagonTessellation +public import LeanPool.ApollonianSuperharmonic.P4780T1ActiveFacets +public import Mathlib.Algebra.Order.Field.Power +public import Mathlib.Analysis.Normed.Field.Basic +public import Mathlib.Analysis.Real.Sqrt +public import Mathlib.Data.EReal.Inv +public import Mathlib.Logic.Equiv.PartialEquiv +public import Mathlib.Tactic.IntervalCases -- [TABLET NODE: P4802T1SideRestriction] diff --git a/LeanPool/ApollonianSuperharmonic/P4802T1SimplexFaces.lean b/LeanPool/ApollonianSuperharmonic/P4802T1SimplexFaces.lean index e46582784c..14010244b3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4802T1SimplexFaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P4802T1SimplexFaces.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Basic.Real.Basic + public import Mathlib.Analysis.Convex.Combination -- [TABLET NODE: P4802T1SimplexFaces] diff --git a/LeanPool/ApollonianSuperharmonic/P4802T1TriangleIndependent.lean b/LeanPool/ApollonianSuperharmonic/P4802T1TriangleIndependent.lean index 392759e59e..8bb2d1e53c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4802T1TriangleIndependent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4802T1TriangleIndependent.lean @@ -5,11 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble -public import Mathlib.Analysis.Convex.Combination -public import Mathlib.Data.Fin.VecNotation +public import Mathlib.Init +public import Mathlib.Basic.Real.Basic public import Mathlib.Tactic.FinCases + public import Mathlib.Tactic.LinearCombination +public import Mathlib.Algebra.Order.Algebra +public import Mathlib.LinearAlgebra.AffineSpace.Independent -- [TABLET NODE: P4802T1TriangleIndependent] diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1AffineDrawing.lean b/LeanPool/ApollonianSuperharmonic/P4812T1AffineDrawing.lean index 1fa818ae27..3826430f0f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4812T1AffineDrawing.lean +++ b/LeanPool/ApollonianSuperharmonic/P4812T1AffineDrawing.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1AffineTransport.lean b/LeanPool/ApollonianSuperharmonic/P4812T1AffineTransport.lean index 9a59762a8d..e4f5433969 100644 --- a/LeanPool/ApollonianSuperharmonic/P4812T1AffineTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4812T1AffineTransport.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4812T1AffineDrawing -public import Mathlib.Data.List.Chain -public import Mathlib.Topology.Homeomorph.Lemmas -- [TABLET NODE: P4812T1AffineTransport] diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1LatticeCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4812T1LatticeCoordinates.lean index 0ef24d3e05..3593fac6b8 100644 --- a/LeanPool/ApollonianSuperharmonic/P4812T1LatticeCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4812T1LatticeCoordinates.lean @@ -5,12 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import Mathlib.Tactic.FunProp -public import Mathlib.Tactic.FieldSimp -public import Mathlib.Tactic.Ring -public import Mathlib.Analysis.Convex.Topology -- [TABLET NODE: P4812T1LatticeCoordinates] diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1ReflectedTouching.lean b/LeanPool/ApollonianSuperharmonic/P4812T1ReflectedTouching.lean index 64f9782d8f..bcd2b376cc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4812T1ReflectedTouching.lean +++ b/LeanPool/ApollonianSuperharmonic/P4812T1ReflectedTouching.lean @@ -5,14 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance public import LeanPool.ApollonianSuperharmonic.TileQuarterTurn public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.TileTouching public import LeanPool.ApollonianSuperharmonic.TouchingTriple -public import Mathlib.Tactic.Ring -- [TABLET NODE: P4812T1ReflectedTouching] diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean index febc35e0d4..530204eadd 100644 --- a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean +++ b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean @@ -5,19 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4812T1AffineDrawing -public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance public import LeanPool.ApollonianSuperharmonic.P4677T2TouchingWalk public import LeanPool.ApollonianSuperharmonic.P4733T1WalkTransport -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation public import LeanPool.ApollonianSuperharmonic.TouchingTriple -public import LeanPool.ApollonianSuperharmonic.TileTouching -public import LeanPool.ApollonianSuperharmonic.SimpleGridPath -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -- [TABLET NODE: P4812T1RegularFaceWalks] diff --git a/LeanPool/ApollonianSuperharmonic/P4818T1AffineTransversalExtension.lean b/LeanPool/ApollonianSuperharmonic/P4818T1AffineTransversalExtension.lean index ca45140591..c7b5c9d96c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4818T1AffineTransversalExtension.lean +++ b/LeanPool/ApollonianSuperharmonic/P4818T1AffineTransversalExtension.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction -public import Mathlib.Tactic.Abel -public import Mathlib.Tactic.Ring -- [TABLET NODE: P4818T1AffineTransversalExtension] diff --git a/LeanPool/ApollonianSuperharmonic/P4818T1BoundaryRecovery.lean b/LeanPool/ApollonianSuperharmonic/P4818T1BoundaryRecovery.lean index 3fb6e9852a..eef84ccec7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4818T1BoundaryRecovery.lean +++ b/LeanPool/ApollonianSuperharmonic/P4818T1BoundaryRecovery.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4818T1HalfOpen public import LeanPool.ApollonianSuperharmonic.P4818T1ClosedOverlaps -public import Mathlib.Tactic.Ring -- [TABLET NODE: P4818T1BoundaryRecovery] diff --git a/LeanPool/ApollonianSuperharmonic/P4818T1ClosedOverlaps.lean b/LeanPool/ApollonianSuperharmonic/P4818T1ClosedOverlaps.lean index 0fa6788ceb..bfae7561bf 100644 --- a/LeanPool/ApollonianSuperharmonic/P4818T1ClosedOverlaps.lean +++ b/LeanPool/ApollonianSuperharmonic/P4818T1ClosedOverlaps.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.Ring -- [TABLET NODE: P4818T1ClosedOverlaps] diff --git a/LeanPool/ApollonianSuperharmonic/P4818T1HalfOpen.lean b/LeanPool/ApollonianSuperharmonic/P4818T1HalfOpen.lean index d4054d3cf3..7e039e65be 100644 --- a/LeanPool/ApollonianSuperharmonic/P4818T1HalfOpen.lean +++ b/LeanPool/ApollonianSuperharmonic/P4818T1HalfOpen.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains -- [TABLET NODE: P4818T1HalfOpen] diff --git a/LeanPool/ApollonianSuperharmonic/P4818T1OverlapDifferences.lean b/LeanPool/ApollonianSuperharmonic/P4818T1OverlapDifferences.lean index 6e24b48b3c..52eee0a444 100644 --- a/LeanPool/ApollonianSuperharmonic/P4818T1OverlapDifferences.lean +++ b/LeanPool/ApollonianSuperharmonic/P4818T1OverlapDifferences.lean @@ -5,11 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4818T1ClosedOverlaps public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic -public import Mathlib.Algebra.Ring.Int.Parity -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.Ring -- [TABLET NODE: P4818T1OverlapDifferences] diff --git a/LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean b/LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean index e99d5d0c9a..2df8f6423c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean +++ b/LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean @@ -5,10 +5,30 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4818T1HalfOpen public import LeanPool.ApollonianSuperharmonic.P4818T1ClosedOverlaps -public import Mathlib.Data.Int.Interval -public import Mathlib.Tactic +public import Mathlib.Analysis.SpecialFunctions.Pow.NNReal +public import Mathlib.Tactic.Basify +public import Mathlib.Tactic.Echelon.Zsqrtd +public import Mathlib.Tactic.Inclusion.Extension.Core.Core +public import Mathlib.Tactic.Inclusion.Extension.IntervalDyadicReal.Hypotheses +public import Mathlib.Tactic.Inclusion.Extension.IntervalDyadicReal.Rational +public import Mathlib.Tactic.Measurability.Init +public import Mathlib.Tactic.NormNum.Irrational +public import Mathlib.Tactic.NormNum.IsCoprime +public import Mathlib.Tactic.NormNum.IsSquare +public import Mathlib.Tactic.NormNum.LegendreSymbol +public import Mathlib.Tactic.NormNum.ModEq +public import Mathlib.Tactic.NormNum.NatFib +public import Mathlib.Tactic.NormNum.NatLog +public import Mathlib.Tactic.NormNum.NatSqrt +public import Mathlib.Tactic.NormNum.Ordinal +public import Mathlib.Tactic.NormNum.Parity +public import Mathlib.Tactic.NormNum.Prime +public import Mathlib.Tactic.NormNum.RealSqrt +public import Mathlib.Tactic.ReduceModChar -- [TABLET NODE: P4818T1Representatives] diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean b/LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean index e741219111..a5a7f93c5c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean @@ -5,12 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.P4828T1Gap public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity public import Mathlib.Analysis.Convex.Combination -public import Mathlib.Analysis.Complex.Norm public import Mathlib.Topology.MetricSpace.Lipschitz +public import LeanPool.ApollonianSuperharmonic.P4828T1Disk -- [TABLET NODE: P4828T1CircularPlacement] diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1ConstructorSupport.lean b/LeanPool/ApollonianSuperharmonic/P4828T1ConstructorSupport.lean index faae0fafa3..ab0f0516c2 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1ConstructorSupport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1ConstructorSupport.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4828T1RotationLaws public import LeanPool.ApollonianSuperharmonic.P4828T1Step public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1Disk.lean b/LeanPool/ApollonianSuperharmonic/P4828T1Disk.lean index cb219effc1..e6426376fa 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1Disk.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1Disk.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import LeanPool.ApollonianSuperharmonic.CircleCoordinates public import Mathlib.Analysis.Complex.Norm diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1Evaluate.lean b/LeanPool/ApollonianSuperharmonic/P4828T1Evaluate.lean index 3f9f7f1f3e..0147f74cee 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1Evaluate.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1Evaluate.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate public import LeanPool.ApollonianSuperharmonic.P4828T1Step public import LeanPool.ApollonianSuperharmonic.P4828T1Root diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1FiniteWordSeparation.lean b/LeanPool/ApollonianSuperharmonic/P4828T1FiniteWordSeparation.lean index c67a662c97..271ac922dd 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1FiniteWordSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1FiniteWordSeparation.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init public import Mathlib.Data.List.Induction -public import Mathlib.Order.SetNotation +public import Mathlib.Data.Set.Basic +public import Mathlib.Data.Set.Lattice.Disjoint + -- [TABLET NODE: P4828T1FiniteWordSeparation] diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1Gap.lean b/LeanPool/ApollonianSuperharmonic/P4828T1Gap.lean index 7176354c29..5ed0558ff4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1Gap.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1Gap.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4828T1Disk +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import LeanPool.ApollonianSuperharmonic.P4909T1ParentPolygon +public import Mathlib.Analysis.Complex.Norm -- [TABLET NODE: P4828T1Gap] diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1HistoryNormalForm.lean b/LeanPool/ApollonianSuperharmonic/P4828T1HistoryNormalForm.lean index 67d287f75f..f1208a616e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1HistoryNormalForm.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1HistoryNormalForm.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4828T1Evaluate public import LeanPool.ApollonianSuperharmonic.P4828T1RotationLaws public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1HistoryRealization.lean b/LeanPool/ApollonianSuperharmonic/P4828T1HistoryRealization.lean index 429152bd26..d5e22c996c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1HistoryRealization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1HistoryRealization.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4828T1Evaluate public import LeanPool.ApollonianSuperharmonic.P4828T1LeftRootGeometry public import LeanPool.ApollonianSuperharmonic.P4828T1RightRootGeometry diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean index 1c9b6f6d8c..9f328a944d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean @@ -5,12 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4828T1Root public import LeanPool.ApollonianSuperharmonic.P4828T1Gap public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple public import Mathlib.Analysis.Convex.Combination public import Mathlib.Analysis.Complex.ReImTopology +public import LeanPool.ApollonianSuperharmonic.P4828T1Disk -- [TABLET NODE: P4828T1LeftRootGeometry] @@ -132,7 +135,11 @@ private theorem hvertices (a : GaussianInt) : (vertices a) = {(bl a), (br a), (t constructor · rintro ⟨j, hj, hp⟩ fin_cases j - · simp? [q, P4828T1Root] at hj hp + · simp only [P4828T1Root, Bool.false_eq_true, ↓reduceIte, Int.reduceNeg, Fin.zero_eta, + Fin.isValue, Fin.succ_zero_eq_one, Matrix.cons_val_one, Matrix.cons_val_zero, + zero_lt_one, map_add, map_one, map_mul, Int.cast_one, Complex.ofReal_one, div_one, + Matrix.cons_val_succ, Complex.add_im, Complex.one_im, Complex.mul_im, zero_add, q] + at hj hp rcases hp with hp | ⟨k, hk, hp⟩ · subst p simp only [Set.mem_insert_iff, Set.mem_singleton_iff] @@ -148,7 +155,11 @@ private theorem hvertices (a : GaussianInt) : (vertices a) = {(bl a), (br a), (t ] · simp [] at hk · simp [q, P4828T1Root] at hj - · simp? [q, P4828T1Root] at hj hp + · simp only [P4828T1Root, Bool.false_eq_true, ↓reduceIte, Int.reduceNeg, Fin.reduceFinMk, + Fin.reduceSucc, Matrix.cons_val, zero_lt_one, map_add, map_one, map_mul, Int.cast_one, + Complex.ofReal_one, div_one, Matrix.cons_val_succ, Complex.add_im, Complex.one_im, + Complex.mul_im, zero_add, GaussianInt.im_toComplex, mul_one, GaussianInt.re_toComplex, + Int.cast_zero, mul_zero, add_zero, q] at hj hp rcases hp with hp | ⟨k, hk, hp⟩ · subst p simp only [Set.mem_insert_iff, Set.mem_singleton_iff] diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1LinePlacement.lean b/LeanPool/ApollonianSuperharmonic/P4828T1LinePlacement.lean index 28ec1ea60e..d04e1e2d99 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1LinePlacement.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1LinePlacement.lean @@ -5,12 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4828T1Gap public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity public import LeanPool.ApollonianSuperharmonic.P4903T1ScalarTangencies public import LeanPool.ApollonianSuperharmonic.P4903T1SignedDiskHull +public import LeanPool.ApollonianSuperharmonic.P4828T1Disk -- [TABLET NODE: P4828T1LinePlacement] diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1LineSupport.lean b/LeanPool/ApollonianSuperharmonic/P4828T1LineSupport.lean index b510ffbbc4..80af1a7490 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1LineSupport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1LineSupport.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.CircleCoordinates -- [TABLET NODE: P4828T1LineSupport] diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1ParentsDistinct.lean b/LeanPool/ApollonianSuperharmonic/P4828T1ParentsDistinct.lean index e8c5dd04c8..d40ca00b7b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1ParentsDistinct.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1ParentsDistinct.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1ResidualPatches.lean b/LeanPool/ApollonianSuperharmonic/P4828T1ResidualPatches.lean index 16e41bb3cc..22e26bf2c5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1ResidualPatches.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1ResidualPatches.lean @@ -5,15 +5,19 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4828T1Gap public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate public import LeanPool.ApollonianSuperharmonic.P4828T1Step -public import LeanPool.ApollonianSuperharmonic.P4828T1ParentsDistinct public import LeanPool.ApollonianSuperharmonic.P4909T1TriangleFan public import LeanPool.ApollonianSuperharmonic.P4909T1LineFan public import LeanPool.ApollonianSuperharmonic.P4909T1OmittedDiskBarrier public import LeanPool.ApollonianSuperharmonic.P4909T1TangentSegments +public import LeanPool.ApollonianSuperharmonic.P4828T1Disk +public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity -- [TABLET NODE: P4828T1ResidualPatches] diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean index ea35472d08..939e3bb7ff 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean @@ -5,12 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4828T1Root public import LeanPool.ApollonianSuperharmonic.P4828T1Gap public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple public import Mathlib.Analysis.Convex.Combination public import Mathlib.Analysis.Complex.ReImTopology +public import LeanPool.ApollonianSuperharmonic.P4828T1Disk -- [TABLET NODE: P4828T1RightRootGeometry] @@ -132,7 +135,10 @@ private theorem hvertices (a : GaussianInt) : (vertices a) = {(bl a), (br a), (t constructor · rintro ⟨j, hj, hp⟩ fin_cases j - · simp? [q, P4828T1Root] at hj hp + · simp only [P4828T1Root, ↓reduceIte, Int.reduceNeg, Fin.zero_eta, Fin.isValue, + Fin.succ_zero_eq_one, Matrix.cons_val_one, Matrix.cons_val_zero, zero_lt_one, map_add, + map_one, map_mul, Int.cast_one, Complex.ofReal_one, div_one, Matrix.cons_val_succ, + Complex.add_im, Complex.one_im, Complex.mul_im, zero_add, q] at hj hp rcases hp with hp | ⟨k, hk, hp⟩ · subst p simp only [Set.mem_insert_iff, Set.mem_singleton_iff] @@ -147,7 +153,11 @@ private theorem hvertices (a : GaussianInt) : (vertices a) = {(bl a), (br a), (t apply Complex.ext <;> simp [br, L, y, htwo_re, htwo_im, ]; norm_num - · simp? [q, P4828T1Root] at hj hp + · simp only [P4828T1Root, ↓reduceIte, Int.reduceNeg, Fin.mk_one, Fin.isValue, + Fin.succ_one_eq_two, Matrix.cons_val, zero_lt_one, map_add, map_one, map_mul, + Int.cast_one, Complex.ofReal_one, div_one, Matrix.cons_val_succ, Complex.add_im, + Complex.one_im, Complex.mul_im, zero_add, GaussianInt.im_toComplex, mul_one, + GaussianInt.re_toComplex, Int.cast_zero, mul_zero, add_zero, q] at hj hp rcases hp with hp | ⟨k, hk, hp⟩ · subst p simp only [Set.mem_insert_iff, Set.mem_singleton_iff] diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1Root.lean b/LeanPool/ApollonianSuperharmonic/P4828T1Root.lean index bb4b42a3eb..b7c3d2fef0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1Root.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1Root.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.CircleCoordinates -- [TABLET NODE: P4828T1Root] diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1RootSeparation.lean b/LeanPool/ApollonianSuperharmonic/P4828T1RootSeparation.lean index c39c624c3f..736b94999c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1RootSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1RootSeparation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4828T1LeftRootGeometry public import LeanPool.ApollonianSuperharmonic.P4828T1RightRootGeometry diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1Rotate.lean b/LeanPool/ApollonianSuperharmonic/P4828T1Rotate.lean index e7e826da02..5438f77826 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1Rotate.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1Rotate.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.CircleCoordinates -- [TABLET NODE: P4828T1Rotate] diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1RotationLaws.lean b/LeanPool/ApollonianSuperharmonic/P4828T1RotationLaws.lean index efb21f5900..80d3b99914 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1RotationLaws.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1RotationLaws.lean @@ -5,6 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Tactic.FinCases + public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1Step.lean b/LeanPool/ApollonianSuperharmonic/P4828T1Step.lean index e715702f54..e63d04e409 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1Step.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1Step.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.CircleCoordinates -- [TABLET NODE: P4828T1Step] diff --git a/LeanPool/ApollonianSuperharmonic/P4840T6ConstructorCovariance.lean b/LeanPool/ApollonianSuperharmonic/P4840T6ConstructorCovariance.lean index ce49232398..fb0c856610 100644 --- a/LeanPool/ApollonianSuperharmonic/P4840T6ConstructorCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/P4840T6ConstructorCovariance.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction -- [TABLET NODE: P4840T6ConstructorCovariance] diff --git a/LeanPool/ApollonianSuperharmonic/P4840T6DiamondRecurrence.lean b/LeanPool/ApollonianSuperharmonic/P4840T6DiamondRecurrence.lean index 2153c22661..b4adf1f096 100644 --- a/LeanPool/ApollonianSuperharmonic/P4840T6DiamondRecurrence.lean +++ b/LeanPool/ApollonianSuperharmonic/P4840T6DiamondRecurrence.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple -- [TABLET NODE: P4840T6DiamondRecurrence] diff --git a/LeanPool/ApollonianSuperharmonic/P4840T6NegatedRoot.lean b/LeanPool/ApollonianSuperharmonic/P4840T6NegatedRoot.lean index 811b581d07..4f8be17a8a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4840T6NegatedRoot.lean +++ b/LeanPool/ApollonianSuperharmonic/P4840T6NegatedRoot.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: P4840T6NegatedRoot] diff --git a/LeanPool/ApollonianSuperharmonic/P4840T6ProperGrowth.lean b/LeanPool/ApollonianSuperharmonic/P4840T6ProperGrowth.lean index f4411d351c..34832743bc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4840T6ProperGrowth.lean +++ b/LeanPool/ApollonianSuperharmonic/P4840T6ProperGrowth.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -- [TABLET NODE: P4840T6ProperGrowth] diff --git a/LeanPool/ApollonianSuperharmonic/P4840T6ShiftRoot.lean b/LeanPool/ApollonianSuperharmonic/P4840T6ShiftRoot.lean index aae3cb37d6..0ff33abeeb 100644 --- a/LeanPool/ApollonianSuperharmonic/P4840T6ShiftRoot.lean +++ b/LeanPool/ApollonianSuperharmonic/P4840T6ShiftRoot.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: P4840T6ShiftRoot] diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1Component.lean b/LeanPool/ApollonianSuperharmonic/P4849T1Component.lean index 25800941f4..78e8524e68 100644 --- a/LeanPool/ApollonianSuperharmonic/P4849T1Component.lean +++ b/LeanPool/ApollonianSuperharmonic/P4849T1Component.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected -- [TABLET NODE: P4849T1Component] diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1ComponentRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4849T1ComponentRestriction.lean index 9fc4b8dc78..7089afddfc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4849T1ComponentRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4849T1ComponentRestriction.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4849T1Component public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1InfiniteLimitComponent.lean b/LeanPool/ApollonianSuperharmonic/P4849T1InfiniteLimitComponent.lean index 08d7e56943..21f97fe7c8 100644 --- a/LeanPool/ApollonianSuperharmonic/P4849T1InfiniteLimitComponent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4849T1InfiniteLimitComponent.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4849T1Component -- [TABLET NODE: P4849T1InfiniteLimitComponent] @@ -193,7 +195,7 @@ private theorem hXinf : subst x cases rest with | nil => - simp? at hlast + simp only [List.getLast?_singleton, Option.some.injEq] at hlast subst b exact (hbX huX).elim | cons v tail => diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean b/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean index 14b2d36ee5..8e3f7544f8 100644 --- a/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean +++ b/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4849T1Component public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import Mathlib.Combinatorics.SimpleGraph.Connectivity.Connected +public meta import Lean.Meta.Tactic.NormCast -- [TABLET NODE: P4849T1LargePositiveComponents] diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1LocalLimitAdmissibility.lean b/LeanPool/ApollonianSuperharmonic/P4849T1LocalLimitAdmissibility.lean index 2f5c9230d9..42f773c5ac 100644 --- a/LeanPool/ApollonianSuperharmonic/P4849T1LocalLimitAdmissibility.lean +++ b/LeanPool/ApollonianSuperharmonic/P4849T1LocalLimitAdmissibility.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -- [TABLET NODE: P4849T1LocalLimitAdmissibility] diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1MinimumTruncation.lean b/LeanPool/ApollonianSuperharmonic/P4849T1MinimumTruncation.lean index 6a997bba10..ac90e81895 100644 --- a/LeanPool/ApollonianSuperharmonic/P4849T1MinimumTruncation.lean +++ b/LeanPool/ApollonianSuperharmonic/P4849T1MinimumTruncation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -- [TABLET NODE: P4849T1MinimumTruncation] diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1PeriodAnchoring.lean b/LeanPool/ApollonianSuperharmonic/P4849T1PeriodAnchoring.lean index 34e7f6fa7f..e3e98f28d3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4849T1PeriodAnchoring.lean +++ b/LeanPool/ApollonianSuperharmonic/P4849T1PeriodAnchoring.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -public import Mathlib.Data.Fintype.Pigeonhole -public import Mathlib.Order.Interval.Finset.Nat -- [TABLET NODE: P4849T1PeriodAnchoring] diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1PeriodResidues.lean b/LeanPool/ApollonianSuperharmonic/P4849T1PeriodResidues.lean index 477b4fdee2..9a166e7072 100644 --- a/LeanPool/ApollonianSuperharmonic/P4849T1PeriodResidues.lean +++ b/LeanPool/ApollonianSuperharmonic/P4849T1PeriodResidues.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction +public import Mathlib.Init public import Mathlib.Algebra.Ring.Periodic +public import Mathlib.Tactic.Linarith + +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction public import Mathlib.Data.Int.Interval -- [TABLET NODE: P4849T1PeriodResidues] diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1SetDiagonalSubsequence.lean b/LeanPool/ApollonianSuperharmonic/P4849T1SetDiagonalSubsequence.lean index 9f3bebe3f7..291762e3cb 100644 --- a/LeanPool/ApollonianSuperharmonic/P4849T1SetDiagonalSubsequence.lean +++ b/LeanPool/ApollonianSuperharmonic/P4849T1SetDiagonalSubsequence.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.LatticeCell +public import Mathlib.Init + public import Mathlib.Topology.Sequences public import Mathlib.Topology.Instances.Discrete +public import Mathlib.Algebra.Order.Ring.Star +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: P4849T1SetDiagonalSubsequence] diff --git a/LeanPool/ApollonianSuperharmonic/P4903T1ScalarTangencies.lean b/LeanPool/ApollonianSuperharmonic/P4903T1ScalarTangencies.lean index c53866da87..33bf77bd22 100644 --- a/LeanPool/ApollonianSuperharmonic/P4903T1ScalarTangencies.lean +++ b/LeanPool/ApollonianSuperharmonic/P4903T1ScalarTangencies.lean @@ -5,7 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Basic.Real.Basic +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + -- [TABLET NODE: P4903T1ScalarTangencies] diff --git a/LeanPool/ApollonianSuperharmonic/P4903T1SignedDiskHull.lean b/LeanPool/ApollonianSuperharmonic/P4903T1SignedDiskHull.lean index 311d445585..4b63f9b273 100644 --- a/LeanPool/ApollonianSuperharmonic/P4903T1SignedDiskHull.lean +++ b/LeanPool/ApollonianSuperharmonic/P4903T1SignedDiskHull.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Tactic.Positivity +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import Mathlib.Analysis.Complex.Norm public import Mathlib.Analysis.Convex.Hull public import Mathlib.LinearAlgebra.Complex.Module diff --git a/LeanPool/ApollonianSuperharmonic/P4909T1LineFan.lean b/LeanPool/ApollonianSuperharmonic/P4909T1LineFan.lean index bd825f5cb7..ba144645b1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4909T1LineFan.lean +++ b/LeanPool/ApollonianSuperharmonic/P4909T1LineFan.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4909T1ParentEdges public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate public import LeanPool.ApollonianSuperharmonic.P4828T1Step diff --git a/LeanPool/ApollonianSuperharmonic/P4909T1OmittedDiskBarrier.lean b/LeanPool/ApollonianSuperharmonic/P4909T1OmittedDiskBarrier.lean index 178a19277e..fbb33457ea 100644 --- a/LeanPool/ApollonianSuperharmonic/P4909T1OmittedDiskBarrier.lean +++ b/LeanPool/ApollonianSuperharmonic/P4909T1OmittedDiskBarrier.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import Mathlib.Analysis.Complex.Norm -public import Mathlib.Topology.Order.IntermediateValue -public import Mathlib.Topology.Order.DenselyOrdered -- [TABLET NODE: P4909T1OmittedDiskBarrier] diff --git a/LeanPool/ApollonianSuperharmonic/P4909T1ParentEdges.lean b/LeanPool/ApollonianSuperharmonic/P4909T1ParentEdges.lean index 2fcc8f7f15..c13c4e9e1d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4909T1ParentEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4909T1ParentEdges.lean @@ -5,7 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4909T1ParentPolygon +public import Mathlib.Init + +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates +public import Mathlib.Analysis.Convex.Segment +public import Mathlib.Analysis.Normed.Group.Basic +public import Mathlib.Analysis.Real.Sqrt +public import Mathlib.LinearAlgebra.Complex.Module -- [TABLET NODE: P4909T1ParentEdges] diff --git a/LeanPool/ApollonianSuperharmonic/P4909T1ParentPolygon.lean b/LeanPool/ApollonianSuperharmonic/P4909T1ParentPolygon.lean index 0f74511df9..8e2eb3edaf 100644 --- a/LeanPool/ApollonianSuperharmonic/P4909T1ParentPolygon.lean +++ b/LeanPool/ApollonianSuperharmonic/P4909T1ParentPolygon.lean @@ -5,10 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CircleCoordinates -public import Mathlib.Analysis.Complex.Norm public import Mathlib.Analysis.Convex.Hull public import Mathlib.LinearAlgebra.Complex.Module +public import Mathlib.Analysis.Normed.Group.Basic +public import Mathlib.Analysis.Real.Sqrt -- [TABLET NODE: P4909T1ParentPolygon] diff --git a/LeanPool/ApollonianSuperharmonic/P4909T1TangentSegments.lean b/LeanPool/ApollonianSuperharmonic/P4909T1TangentSegments.lean index 45b3d2ef1c..c664c101dd 100644 --- a/LeanPool/ApollonianSuperharmonic/P4909T1TangentSegments.lean +++ b/LeanPool/ApollonianSuperharmonic/P4909T1TangentSegments.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4828T1Disk -public import Mathlib.Analysis.Convex.Hull +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import Mathlib.LinearAlgebra.Complex.Module +public import Mathlib.Analysis.Complex.Norm +public import Mathlib.Analysis.Convex.Segment -- [TABLET NODE: P4909T1TangentSegments] diff --git a/LeanPool/ApollonianSuperharmonic/P4909T1TriangleFan.lean b/LeanPool/ApollonianSuperharmonic/P4909T1TriangleFan.lean index a0449c8c24..8010450905 100644 --- a/LeanPool/ApollonianSuperharmonic/P4909T1TriangleFan.lean +++ b/LeanPool/ApollonianSuperharmonic/P4909T1TriangleFan.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.P4909T1ParentEdges public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate public import LeanPool.ApollonianSuperharmonic.P4828T1Step @@ -12,7 +15,8 @@ public import Mathlib.LinearAlgebra.AffineSpace.FiniteDimensional public import Mathlib.LinearAlgebra.Complex.FiniteDimensional public import Mathlib.Analysis.Convex.Combination public import Mathlib.Topology.MetricSpace.Lipschitz -public import Mathlib.Topology.Order.OrderClosed +public import LeanPool.ApollonianSuperharmonic.P4909T1ParentPolygon +public import Mathlib.Analysis.Complex.Norm -- [TABLET NODE: P4909T1TriangleFan] diff --git a/LeanPool/ApollonianSuperharmonic/P4953T1HullHeight.lean b/LeanPool/ApollonianSuperharmonic/P4953T1HullHeight.lean index 767d3f11ec..f888844bf5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4953T1HullHeight.lean +++ b/LeanPool/ApollonianSuperharmonic/P4953T1HullHeight.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import Mathlib.Analysis.Complex.Norm public import Mathlib.Analysis.Convex.Hull public import Mathlib.LinearAlgebra.Complex.Module diff --git a/LeanPool/ApollonianSuperharmonic/P4953T1LiteralHulls.lean b/LeanPool/ApollonianSuperharmonic/P4953T1LiteralHulls.lean index 624381595e..11812a7dda 100644 --- a/LeanPool/ApollonianSuperharmonic/P4953T1LiteralHulls.lean +++ b/LeanPool/ApollonianSuperharmonic/P4953T1LiteralHulls.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import Mathlib.Tactic.Tauto +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4909T1ParentPolygon public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate diff --git a/LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean b/LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean index 29a9d79494..c4c72fa367 100644 --- a/LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean +++ b/LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean @@ -5,11 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import Mathlib.Analysis.Complex.Norm public import Mathlib.Analysis.Convex.Hull -public import Mathlib.Analysis.Convex.Join public import Mathlib.LinearAlgebra.Complex.Module +public import Mathlib.Topology.EMetricSpace.Lipschitz -- [TABLET NODE: P4953T1QuadrilateralSections] diff --git a/LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean b/LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean index 9b4901d57a..16cb400113 100644 --- a/LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean +++ b/LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Tactic.Positivity +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import Mathlib.Analysis.Complex.Norm public import Mathlib.Analysis.Convex.Hull public import Mathlib.LinearAlgebra.Complex.Module @@ -930,7 +933,7 @@ private theorem hfaceAB (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x linarith [ht.2] · change 0 ≤ b.coord 2 (AffineMap.lineMap A B t) rw [(b.coord 2).apply_lineMap, hcoord20, hcoord22] - simp? [AffineMap.lineMap_apply_ring] + simp only [AffineMap.lineMap_apply_ring, mul_zero, mul_one, zero_add] exact ht.1 · change b.coord 0 (AffineMap.lineMap A B t) = 0 rw [(b.coord 0).apply_lineMap, hcoord01, hcoord02] @@ -991,7 +994,7 @@ private theorem hfacexB (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x simp [] · change 0 ≤ b.coord 2 (AffineMap.lineMap x B t) rw [(b.coord 2).apply_lineMap, hcoord20x, hcoord22] - simp? [AffineMap.lineMap_apply_ring] + simp only [AffineMap.lineMap_apply_ring, mul_zero, mul_one, zero_add] exact ht.1 · change b.coord 1 (AffineMap.lineMap x B t) = 0 rw [(b.coord 1).apply_lineMap, hcoord10, hcoord12] @@ -1049,7 +1052,7 @@ private theorem hfacexA (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x linarith [ht.2] · change 0 ≤ b.coord 1 (AffineMap.lineMap x A t) rw [(b.coord 1).apply_lineMap, hcoord10, hcoord11] - simp? [AffineMap.lineMap_apply_ring] + simp only [AffineMap.lineMap_apply_ring, mul_zero, mul_one, zero_add] exact ht.1 · change 0 ≤ b.coord 2 (AffineMap.lineMap x A t) rw [(b.coord 2).apply_lineMap, hcoord20x, hcoord20] diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1EdgePrescription.lean b/LeanPool/ApollonianSuperharmonic/P4981T1EdgePrescription.lean index ab35405106..24836db7fc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4981T1EdgePrescription.lean +++ b/LeanPool/ApollonianSuperharmonic/P4981T1EdgePrescription.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation +public import Mathlib.Init + +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -- [TABLET NODE: P4981T1EdgePrescription] diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1EdgeRank.lean b/LeanPool/ApollonianSuperharmonic/P4981T1EdgeRank.lean index 078197a7e6..d4e028e782 100644 --- a/LeanPool/ApollonianSuperharmonic/P4981T1EdgeRank.lean +++ b/LeanPool/ApollonianSuperharmonic/P4981T1EdgeRank.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CircleCoordinates -- [TABLET NODE: P4981T1EdgeRank] diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionCoherence.lean b/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionCoherence.lean index 3b09008907..e706a169ba 100644 --- a/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionCoherence.lean +++ b/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionCoherence.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4981T1PrescriptionValue public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision -public import LeanPool.ApollonianSuperharmonic.P4828T1ParentsDistinct -- [TABLET NODE: P4981T1PrescriptionCoherence] diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionLocality.lean b/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionLocality.lean index 5178b49ead..1b36b70483 100644 --- a/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionLocality.lean +++ b/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionLocality.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4981T1EdgeRank public import LeanPool.ApollonianSuperharmonic.P4981T1PrescriptionValue public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionValue.lean b/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionValue.lean index 2ae234d535..9ca2eb7278 100644 --- a/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionValue.lean +++ b/LeanPool/ApollonianSuperharmonic/P4981T1PrescriptionValue.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4981T1EdgePrescription -- [TABLET NODE: P4981T1PrescriptionValue] diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1ProperEquations.lean b/LeanPool/ApollonianSuperharmonic/P4981T1ProperEquations.lean index 59f05d418e..f73beb71d4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4981T1ProperEquations.lean +++ b/LeanPool/ApollonianSuperharmonic/P4981T1ProperEquations.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4981T1PrescriptionValue public import LeanPool.ApollonianSuperharmonic.P4981T1Recursion +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation -- [TABLET NODE: P4981T1ProperEquations] diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1Recursion.lean b/LeanPool/ApollonianSuperharmonic/P4981T1Recursion.lean index 5a65228259..255b88a137 100644 --- a/LeanPool/ApollonianSuperharmonic/P4981T1Recursion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4981T1Recursion.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.CircleCoordinates -- [TABLET NODE: P4981T1Recursion] diff --git a/LeanPool/ApollonianSuperharmonic/P4981T1RootEquations.lean b/LeanPool/ApollonianSuperharmonic/P4981T1RootEquations.lean index 024f20c37e..c5d79ab8cb 100644 --- a/LeanPool/ApollonianSuperharmonic/P4981T1RootEquations.lean +++ b/LeanPool/ApollonianSuperharmonic/P4981T1RootEquations.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4981T1PrescriptionValue public import LeanPool.ApollonianSuperharmonic.P4981T1Recursion +public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation -- [TABLET NODE: P4981T1RootEquations] diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1BranchDecay.lean b/LeanPool/ApollonianSuperharmonic/P4984T1BranchDecay.lean index 98476d8e6b..3cf87d4a60 100644 --- a/LeanPool/ApollonianSuperharmonic/P4984T1BranchDecay.lean +++ b/LeanPool/ApollonianSuperharmonic/P4984T1BranchDecay.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4984T1ContactDiameter public import LeanPool.ApollonianSuperharmonic.P4828T1HistoryRealization -public import Mathlib.Analysis.SpecificLimits.Basic -- [TABLET NODE: P4984T1BranchDecay] diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1ClosedGap.lean b/LeanPool/ApollonianSuperharmonic/P4984T1ClosedGap.lean index 961b8a55dd..2da71b7e43 100644 --- a/LeanPool/ApollonianSuperharmonic/P4984T1ClosedGap.lean +++ b/LeanPool/ApollonianSuperharmonic/P4984T1ClosedGap.lean @@ -5,7 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import LeanPool.ApollonianSuperharmonic.P4909T1ParentPolygon +public import Mathlib.Analysis.Complex.Norm -- [TABLET NODE: P4984T1ClosedGap] diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1ClosedSubdivision.lean b/LeanPool/ApollonianSuperharmonic/P4984T1ClosedSubdivision.lean index ae264bcb1b..ca23ab07b5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4984T1ClosedSubdivision.lean +++ b/LeanPool/ApollonianSuperharmonic/P4984T1ClosedSubdivision.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap public import LeanPool.ApollonianSuperharmonic.P4828T1Gap public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport @@ -15,9 +17,9 @@ public import LeanPool.ApollonianSuperharmonic.P4909T1LineFan public import LeanPool.ApollonianSuperharmonic.P4909T1OmittedDiskBarrier public import LeanPool.ApollonianSuperharmonic.P4909T1TangentSegments public import Mathlib.Analysis.Convex.Topology -public import Mathlib.Analysis.Normed.Group.Uniform public import Mathlib.Analysis.Normed.Module.RCLike.Real -public import Mathlib.Analysis.RCLike.Basic +public import LeanPool.ApollonianSuperharmonic.P4828T1Disk +public import Mathlib.Algebra.Order.BigOperators.Expect -- [TABLET NODE: P4984T1ClosedSubdivision] @@ -196,7 +198,7 @@ private theorem support : have hci : ((q i).1 : ℝ) ≠ 0 := by exact_mod_cast ne_of_gt hi have hre : (p i).re = (q i).2.re / (q i).1 := by simp [p] rcases hs.normals k hk with hn | hn - · simp? [hn] + · simp only [hn, ↓reduceIte] rw [hn] at hh norm_num at hh rw [hnum] at hh @@ -228,11 +230,11 @@ private theorem footDist : have hh := support k i hk hi rw [Complex.dist_eq] by_cases hn : (q k).2 = -1 - · simp? [hn] at hh ⊢ + · simp only [hn, ↓reduceIte] at hh ⊢ have hv : p i - (⟨L, (p i).im⟩ : ℂ) = (r i : ℂ) := by apply Complex.ext <;> simp [hh] rw [hv, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg hr] - · simp? [hn] at hh ⊢ + · simp only [hn, ↓reduceIte] at hh ⊢ have hv : p i - (⟨L + 2, (p i).im⟩ : ℂ) = (-r i : ℂ) := by apply Complex.ext <;> simp [hh] rw [hv, norm_neg, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg hr] @@ -270,11 +272,11 @@ private theorem lineDist : rw [Complex.sub_re, hz] at hab rw [Complex.dist_eq] by_cases hn : (q k).2 = -1 - · simp? [hn] at hh hab + · simp only [hn, ↓reduceIte] at hh hab have heq : L - (p i).re = -r i := by linarith rw [heq, abs_neg, abs_of_pos (rpos i hi)] at hab exact hab - · simp? [hn] at hh hab + · simp only [hn, ↓reduceIte] at hh hab have heq : L + 2 - (p i).re = r i := by linarith rw [heq, abs_of_pos (rpos i hi)] at hab exact hab @@ -620,7 +622,10 @@ theorem P4984T1ClosedSubdivision (L : Real) have oldRetained (b j : Fin 3) (hjb : j ≠ b) : ∃ k : Fin 3, idx b k = j.succ := by clear * - b j hjb idx - fin_cases b <;> fin_cases j <;> simp_all? [idx] + fin_cases b <;> fin_cases j <;> simp_all only [Fin.mk_one, Fin.isValue, Fin.reduceFinMk, + ne_eq, Fin.reduceEq, not_false_eq_true, Nat.reduceAdd, Nat.succ_eq_add_one, + Fin.reduceAdd, Fin.succ_zero_eq_one, Fin.succ_one_eq_two, idx, Fin.zero_eta, + one_ne_zero, zero_add, Fin.reduceSucc, not_true_eq_false, zero_ne_one] all_goals first | exact ⟨1, rfl⟩ | exact ⟨2, rfl⟩ have rpos (i : Fin 4) (hi : 0 < (q i).1) : 0 < r i := by dsimp [r] diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1ContactDiameter.lean b/LeanPool/ApollonianSuperharmonic/P4984T1ContactDiameter.lean index dfaf1735a9..0bb523e0c1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4984T1ContactDiameter.lean +++ b/LeanPool/ApollonianSuperharmonic/P4984T1ContactDiameter.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap public import LeanPool.ApollonianSuperharmonic.P4828T1Gap public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.P5023T1ContactHull public import LeanPool.ApollonianSuperharmonic.P5023T1CircularSide public import LeanPool.ApollonianSuperharmonic.P5023T1CircularEstimate diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean b/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean index 3f89bc7217..ad46301775 100644 --- a/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean +++ b/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean @@ -5,13 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedSubdivision public import LeanPool.ApollonianSuperharmonic.P4828T1Gap public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport public import LeanPool.ApollonianSuperharmonic.P4828T1ConstructorSupport public import LeanPool.ApollonianSuperharmonic.P4828T1ParentsDistinct -public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity public import LeanPool.ApollonianSuperharmonic.P5050T1ParentSphereSection public import LeanPool.ApollonianSuperharmonic.P5050T1OmittedHullSeparation diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1RootGaps.lean b/LeanPool/ApollonianSuperharmonic/P4984T1RootGaps.lean index d8a2294d09..d46688645e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4984T1RootGaps.lean +++ b/LeanPool/ApollonianSuperharmonic/P4984T1RootGaps.lean @@ -5,12 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap public import LeanPool.ApollonianSuperharmonic.P4828T1Root public import LeanPool.ApollonianSuperharmonic.BandPackingExterior -public import LeanPool.ApollonianSuperharmonic.P4953T1LiteralHulls public import Mathlib.Analysis.Convex.Combination -public import Mathlib.Basic.Complex.BigOperators -- [TABLET NODE: P4984T1RootGaps] @@ -115,7 +116,8 @@ private theorem rectHull : have ht1 : t ≤ 1 := by change (z.im - v) / 2 ≤ 1; linarith have hw : ∀ i, 0 ≤ w i := by intro i - fin_cases i <;> simp? [w] <;> positivity + fin_cases i <;> simp only [Fin.mk_one, Fin.isValue, Matrix.cons_val_one, + Matrix.cons_val_zero, w, Fin.reduceFinMk, Matrix.cons_val, Fin.zero_eta] <;> positivity have hsum : (∑ i : Fin 4, w i) = 1 := by simp [Fin.sum_univ_succ, w]; ring have heq : (∑ i : Fin 4, w i • c i) = z := by diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean b/LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean index c155f1998c..a54af0501a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean +++ b/LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4984T1RootGaps public import LeanPool.ApollonianSuperharmonic.P4828T1Evaluate -public import Mathlib.Analysis.Normed.Module.Connected public import Mathlib.Analysis.SpecialFunctions.Pow.Real -- [TABLET NODE: P4984T1UnitIncidence] @@ -148,10 +149,10 @@ private theorem hQimage : have hx' : (if left then -(Real.sqrt (1 - t^2)) else Real.sqrt (1 - t^2)) = p.re - u.re := by cases left - · simp? at hx ⊢ + · simp only [Bool.false_eq_true, ↓reduceIte, sub_nonneg] at hx ⊢ have hxrel : 0 ≤ p.re - u.re := by linarith [hx] rw [hsqrt, abs_of_nonneg hxrel] - · simp? at hx ⊢ + · simp only [↓reduceIte, tsub_le_iff_right, zero_add] at hx ⊢ have hxrel : p.re - u.re ≤ 0 := by linarith [hx] rw [hsqrt, abs_of_nonpos hxrel] ring @@ -725,12 +726,16 @@ private theorem upperLeftRootGap : Fin 4) = 0 ∨ (0 : Fin 4) = 2) ((0 : Fin 4) = 0 ∨ (0 : Fin 4) = 1))) := by classical intro a u huDef Q roots A hu - simp? [A, roots, P4828T1Evaluate] + simp only [Int.reduceNeg, GaussianInt.intCast_re, P4828T1Evaluate, List.foldl_nil, + Fin.isValue, Matrix.cons_val_zero, Fin.reduceEq, or_false, decide_true, zero_ne_one, A, + roots] have hL := UnitIncidenceDetails.hLAt468 a rw [hL] rw [P4984T1RootGaps.1 a] ext p - simp? [Q, dist_eq_norm] + simp only [Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, map_add, map_one, + map_mul, dist_eq_norm, Set.mem_inter_iff, Set.mem_ofPred_eq, mem_sphere_iff_norm, + tsub_le_iff_right, zero_add, sub_nonneg, ↓reduceIte, Q] constructor · rintro ⟨⟨hxl, hxr, hyl, hyr, _, _⟩, hnorm⟩ refine ⟨hnorm, ?_, ?_⟩ @@ -798,12 +803,16 @@ private theorem upperRightRootGap : Fin 4) = 0 ∨ (1 : Fin 4) = 2) ((1 : Fin 4) = 0 ∨ (1 : Fin 4) = 1))) := by classical intro a u huDef Q roots A hu - simp? [A, roots, P4828T1Evaluate] + simp only [Int.reduceNeg, GaussianInt.intCast_re, P4828T1Evaluate, List.foldl_nil, + Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, one_ne_zero, Fin.reduceEq, + or_self, decide_false, or_true, decide_true, A, roots] have hL := UnitIncidenceDetails.hLAt542 a rw [hL] rw [P4984T1RootGaps.2.1 a] ext p - simp? [Q, dist_eq_norm] + simp only [Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, map_add, map_one, + map_mul, dist_eq_norm, Set.mem_inter_iff, Set.mem_ofPred_eq, mem_sphere_iff_norm, + tsub_le_iff_right, zero_add, sub_nonneg, Bool.false_eq_true, ↓reduceIte, Q] constructor · rintro ⟨⟨hxl, hxr, hyl, hyr, _, _⟩, hnorm⟩ refine ⟨hnorm, ?_, ?_⟩ @@ -873,12 +882,18 @@ private theorem lowerLeftRootGap : Fin 4) = 0 ∨ (2 : Fin 4) = 2) ((2 : Fin 4) = 0 ∨ (2 : Fin 4) = 1))) := by classical intro a u huDef Q roots A hu - simp? [A, roots, P4828T1Evaluate] + simp only [Int.reduceNeg, GaussianInt.intCast_re, P4828T1Evaluate, List.foldl_nil, + Fin.isValue, Matrix.cons_val, map_sub, Complex.sub_re, GaussianInt.re_toComplex, + Int.cast_zero, sub_zero, Fin.reduceEq, or_true, decide_true, or_self, decide_false, A, + roots] have hLz := UnitIncidenceDetails.hLzAt615 a rw [← hLz] rw [P4984T1RootGaps.1 (a - ⟨0, 1⟩)] ext p - simp? [Q, dist_eq_norm] + simp only [Int.reduceNeg, Zsqrtd.re_sub, sub_zero, GaussianInt.intCast_re, Zsqrtd.im_sub, + Int.cast_sub, GaussianInt.intCast_im, Int.cast_one, map_add, map_one, map_mul, map_sub, + dist_eq_norm, Set.mem_inter_iff, Set.mem_ofPred_eq, mem_sphere_iff_norm, + tsub_le_iff_right, zero_add, sub_nonneg, ↓reduceIte, Bool.false_eq_true, Q] constructor · rintro ⟨⟨hxl, hxr, hyl, hyr, _, _⟩, hnorm⟩ refine ⟨hnorm, ?_, ?_⟩ @@ -951,12 +966,17 @@ private theorem lowerRightRootGap : Fin 4) = 0 ∨ (3 : Fin 4) = 2) ((3 : Fin 4) = 0 ∨ (3 : Fin 4) = 1))) := by classical intro a u huDef Q roots A hu - simp? [A, roots, P4828T1Evaluate] + simp only [Int.reduceNeg, GaussianInt.intCast_re, P4828T1Evaluate, List.foldl_nil, + Fin.isValue, Matrix.cons_val, map_sub, Complex.sub_re, GaussianInt.re_toComplex, + Int.cast_zero, sub_zero, Fin.reduceEq, or_self, decide_false, A, roots] have hLz := UnitIncidenceDetails.hLzAt692 a rw [← hLz] rw [P4984T1RootGaps.2.1 (a - ⟨0, 1⟩)] ext p - simp? [Q, dist_eq_norm] + simp only [Int.reduceNeg, Zsqrtd.re_sub, sub_zero, GaussianInt.intCast_re, Zsqrtd.im_sub, + Int.cast_sub, GaussianInt.intCast_im, Int.cast_one, map_add, map_one, map_mul, map_sub, + dist_eq_norm, Set.mem_inter_iff, Set.mem_ofPred_eq, mem_sphere_iff_norm, + tsub_le_iff_right, zero_add, sub_nonneg, Bool.false_eq_true, ↓reduceIte, Q] constructor · rintro ⟨⟨hxl, hxr, hyl, hyr, _, _⟩, hnorm⟩ refine ⟨hnorm, ?_, ?_⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6Chamber.lean b/LeanPool/ApollonianSuperharmonic/P4994T6Chamber.lean index b580e17cda..c86f6b4ee0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4994T6Chamber.lean +++ b/LeanPool/ApollonianSuperharmonic/P4994T6Chamber.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4994T6Rotation -- [TABLET NODE: P4994T6Chamber] diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6ChamberAdditions.lean b/LeanPool/ApollonianSuperharmonic/P4994T6ChamberAdditions.lean index df3535c291..6b8e281768 100644 --- a/LeanPool/ApollonianSuperharmonic/P4994T6ChamberAdditions.lean +++ b/LeanPool/ApollonianSuperharmonic/P4994T6ChamberAdditions.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Ring + public import LeanPool.ApollonianSuperharmonic.P4994T6Chamber -- [TABLET NODE: P4994T6ChamberAdditions] diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6ChartCovolume.lean b/LeanPool/ApollonianSuperharmonic/P4994T6ChartCovolume.lean index b6b13de202..0c437c3c83 100644 --- a/LeanPool/ApollonianSuperharmonic/P4994T6ChartCovolume.lean +++ b/LeanPool/ApollonianSuperharmonic/P4994T6ChartCovolume.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex -- [TABLET NODE: P4994T6ChartCovolume] diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6NonunitBirth.lean b/LeanPool/ApollonianSuperharmonic/P4994T6NonunitBirth.lean index 45123666f4..c89b8eadde 100644 --- a/LeanPool/ApollonianSuperharmonic/P4994T6NonunitBirth.lean +++ b/LeanPool/ApollonianSuperharmonic/P4994T6NonunitBirth.lean @@ -5,12 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4994T6StepChamber public import LeanPool.ApollonianSuperharmonic.P4994T6ChartCovolume -public import LeanPool.ApollonianSuperharmonic.VectorDeterminant public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification -public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P4994T6NonunitBirth] @@ -69,7 +68,9 @@ theorem P4994T6NonunitBirth : have hpim := congrArg (fun z : GaussianInt => z.im) hp have hrre := congrArg (fun z : GaussianInt => z.re) hr have hrim := congrArg (fun z : GaussianInt => z.im) hr - simp? at hpre hpim hrre hrim + simp only [Int.reduceNeg, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.re_intCast, + Zsqrtd.im_intCast, mul_zero, zero_mul, add_zero, Fin.isValue, Zsqrtd.im_add, + Zsqrtd.im_mul, Zsqrtd.re_neg, Zsqrtd.im_neg] at hpre hpim hrre hrim have factor : (BandVectors.1 (q 2) (q 0)).re * (-BandVectors.1 (q 3) (q 0)).im - (BandVectors.1 (q 2) (q 0)).im * (-BandVectors.1 (q 3) (q 0)).re = diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6NonunitChamber.lean b/LeanPool/ApollonianSuperharmonic/P4994T6NonunitChamber.lean index 17403c4c33..28c99850f9 100644 --- a/LeanPool/ApollonianSuperharmonic/P4994T6NonunitChamber.lean +++ b/LeanPool/ApollonianSuperharmonic/P4994T6NonunitChamber.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4994T6NonunitBirth -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.P4994T6ChamberAdditions -public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification -- [TABLET NODE: P4994T6NonunitChamber] diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6Rotation.lean b/LeanPool/ApollonianSuperharmonic/P4994T6Rotation.lean index b45259f8f9..01facce49f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4994T6Rotation.lean +++ b/LeanPool/ApollonianSuperharmonic/P4994T6Rotation.lean @@ -5,7 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Algebra.Order.Ring.Int +public import Mathlib.Algebra.Group.Equiv.Defs +public import Mathlib.Algebra.Group.Prod + -- [TABLET NODE: P4994T6Rotation] diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6RotationLaws.lean b/LeanPool/ApollonianSuperharmonic/P4994T6RotationLaws.lean index 3c16e85406..8be83bedbc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4994T6RotationLaws.lean +++ b/LeanPool/ApollonianSuperharmonic/P4994T6RotationLaws.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Ring + public import LeanPool.ApollonianSuperharmonic.P4994T6Rotation public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.TriangularSignedHeight diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6StepChamber.lean b/LeanPool/ApollonianSuperharmonic/P4994T6StepChamber.lean index f24725d110..cf7eeda2b2 100644 --- a/LeanPool/ApollonianSuperharmonic/P4994T6StepChamber.lean +++ b/LeanPool/ApollonianSuperharmonic/P4994T6StepChamber.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.NormNum + public import LeanPool.ApollonianSuperharmonic.P4994T6Chamber public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6UnitChartRotation.lean b/LeanPool/ApollonianSuperharmonic/P4994T6UnitChartRotation.lean index 5650caaa00..09a73b18c4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4994T6UnitChartRotation.lean +++ b/LeanPool/ApollonianSuperharmonic/P4994T6UnitChartRotation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4994T6UnitCoordinates public import LeanPool.ApollonianSuperharmonic.P4994T6Rotation public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6UnitCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4994T6UnitCoordinates.lean index 217c2fbc81..5bd0e9fd28 100644 --- a/LeanPool/ApollonianSuperharmonic/P4994T6UnitCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4994T6UnitCoordinates.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: P4994T6UnitCoordinates] diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6UnitOccurrenceChamber.lean b/LeanPool/ApollonianSuperharmonic/P4994T6UnitOccurrenceChamber.lean index c3fb3b1ec8..d84a03c949 100644 --- a/LeanPool/ApollonianSuperharmonic/P4994T6UnitOccurrenceChamber.lean +++ b/LeanPool/ApollonianSuperharmonic/P4994T6UnitOccurrenceChamber.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4994T6UnitRootTable +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4994T6UnitCoordinates public import LeanPool.ApollonianSuperharmonic.P4994T6ChamberAdditions -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientationUnique public import LeanPool.ApollonianSuperharmonic.P4566T1UnitPairCharts diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6UnitRootTable.lean b/LeanPool/ApollonianSuperharmonic/P4994T6UnitRootTable.lean index d75eecab4c..470da2c922 100644 --- a/LeanPool/ApollonianSuperharmonic/P4994T6UnitRootTable.lean +++ b/LeanPool/ApollonianSuperharmonic/P4994T6UnitRootTable.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandVectors -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.P4828T1Root -- [TABLET NODE: P4994T6UnitRootTable] diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1CircularEstimate.lean b/LeanPool/ApollonianSuperharmonic/P5023T1CircularEstimate.lean index 87fd7a361e..827a4ebd41 100644 --- a/LeanPool/ApollonianSuperharmonic/P5023T1CircularEstimate.lean +++ b/LeanPool/ApollonianSuperharmonic/P5023T1CircularEstimate.lean @@ -5,11 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import Mathlib.Analysis.Real.Sqrt -public import Mathlib.Tactic.FieldSimp -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.Ring -- [TABLET NODE: P5023T1CircularEstimate] diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean b/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean index affd670c75..f2f36bb49b 100644 --- a/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean +++ b/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean @@ -5,11 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.P5023T1ContactVertices public import LeanPool.ApollonianSuperharmonic.P4828T1Gap public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity +public import LeanPool.ApollonianSuperharmonic.P4828T1Disk -- [TABLET NODE: P5023T1CircularSide] diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1ContactHull.lean b/LeanPool/ApollonianSuperharmonic/P5023T1ContactHull.lean index 61b82618f8..c7a82ae3f3 100644 --- a/LeanPool/ApollonianSuperharmonic/P5023T1ContactHull.lean +++ b/LeanPool/ApollonianSuperharmonic/P5023T1ContactHull.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5023T1ContactVertices public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1ContactVertices.lean b/LeanPool/ApollonianSuperharmonic/P5023T1ContactVertices.lean index 12b6551e2a..2d287dab81 100644 --- a/LeanPool/ApollonianSuperharmonic/P5023T1ContactVertices.lean +++ b/LeanPool/ApollonianSuperharmonic/P5023T1ContactVertices.lean @@ -5,7 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4909T1ParentPolygon +public import Mathlib.Init + +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates +public import Mathlib.Algebra.Order.Algebra +public import Mathlib.Analysis.Normed.Group.Basic +public import Mathlib.Analysis.Real.Sqrt -- [TABLET NODE: P5023T1ContactVertices] diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1ConvexDiameter.lean b/LeanPool/ApollonianSuperharmonic/P5023T1ConvexDiameter.lean index 84c83c3b34..f72112215c 100644 --- a/LeanPool/ApollonianSuperharmonic/P5023T1ConvexDiameter.lean +++ b/LeanPool/ApollonianSuperharmonic/P5023T1ConvexDiameter.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + public import Mathlib.Analysis.Complex.Basic public import Mathlib.Analysis.Normed.Module.Convex diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1LineEstimate.lean b/LeanPool/ApollonianSuperharmonic/P5023T1LineEstimate.lean index d0e00501b8..d452d5e160 100644 --- a/LeanPool/ApollonianSuperharmonic/P5023T1LineEstimate.lean +++ b/LeanPool/ApollonianSuperharmonic/P5023T1LineEstimate.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + public import Mathlib.Analysis.Real.Sqrt -public import Mathlib.Tactic.Linarith -- [TABLET NODE: P5023T1LineEstimate] diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1LineSideGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5023T1LineSideGeometry.lean index 12616bb2ab..f9b0ee755a 100644 --- a/LeanPool/ApollonianSuperharmonic/P5023T1LineSideGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P5023T1LineSideGeometry.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.P5023T1ContactVertices public import LeanPool.ApollonianSuperharmonic.P4828T1Gap public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport @@ -12,6 +15,7 @@ public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity public import LeanPool.ApollonianSuperharmonic.P4953T1LiteralHulls public import LeanPool.ApollonianSuperharmonic.P4953T1HullHeight +public import LeanPool.ApollonianSuperharmonic.P4828T1Disk -- [TABLET NODE: P5023T1LineSideGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean b/LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean index 6247676802..0341445954 100644 --- a/LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport public import LeanPool.ApollonianSuperharmonic.P4828T1Step public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate @@ -13,7 +15,6 @@ public import LeanPool.ApollonianSuperharmonic.P4953T1LiteralHulls public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity public import Mathlib.Analysis.Complex.Basic -public import Mathlib.Analysis.Convex.Topology -- [TABLET NODE: P5050T1OmittedHullSeparation] diff --git a/LeanPool/ApollonianSuperharmonic/P5050T1ParentSphereSection.lean b/LeanPool/ApollonianSuperharmonic/P5050T1ParentSphereSection.lean index 1926e450a9..245484f960 100644 --- a/LeanPool/ApollonianSuperharmonic/P5050T1ParentSphereSection.lean +++ b/LeanPool/ApollonianSuperharmonic/P5050T1ParentSphereSection.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport public import LeanPool.ApollonianSuperharmonic.P4953T1LiteralHulls diff --git a/LeanPool/ApollonianSuperharmonic/P5050T1RadialSection.lean b/LeanPool/ApollonianSuperharmonic/P5050T1RadialSection.lean index 7803318f1e..7c67894d5b 100644 --- a/LeanPool/ApollonianSuperharmonic/P5050T1RadialSection.lean +++ b/LeanPool/ApollonianSuperharmonic/P5050T1RadialSection.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + public import Mathlib.Analysis.Convex.PathConnected public import Mathlib.Analysis.Convex.Join public import Mathlib.Analysis.Complex.Basic diff --git a/LeanPool/ApollonianSuperharmonic/P5050T1TangentLineSection.lean b/LeanPool/ApollonianSuperharmonic/P5050T1TangentLineSection.lean index 88f6d23b4a..06943011a7 100644 --- a/LeanPool/ApollonianSuperharmonic/P5050T1TangentLineSection.lean +++ b/LeanPool/ApollonianSuperharmonic/P5050T1TangentLineSection.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5050T1RadialSection public import LeanPool.ApollonianSuperharmonic.P4953T1QuadrilateralSections public import Mathlib.Analysis.Normed.Module.Convex diff --git a/LeanPool/ApollonianSuperharmonic/P5050T1TangentTriangleSection.lean b/LeanPool/ApollonianSuperharmonic/P5050T1TangentTriangleSection.lean index 5c30a2b256..e17dfb043b 100644 --- a/LeanPool/ApollonianSuperharmonic/P5050T1TangentTriangleSection.lean +++ b/LeanPool/ApollonianSuperharmonic/P5050T1TangentTriangleSection.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5050T1RadialSection public import LeanPool.ApollonianSuperharmonic.P4909T1TangentSegments diff --git a/LeanPool/ApollonianSuperharmonic/P5064T3CrossParentSupport.lean b/LeanPool/ApollonianSuperharmonic/P5064T3CrossParentSupport.lean index 13f3946765..6371c22b76 100644 --- a/LeanPool/ApollonianSuperharmonic/P5064T3CrossParentSupport.lean +++ b/LeanPool/ApollonianSuperharmonic/P5064T3CrossParentSupport.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5064T3Rectangles public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas diff --git a/LeanPool/ApollonianSuperharmonic/P5064T3LiteralLocalization.lean b/LeanPool/ApollonianSuperharmonic/P5064T3LiteralLocalization.lean index 513ebf9f3a..c4e85faa07 100644 --- a/LeanPool/ApollonianSuperharmonic/P5064T3LiteralLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P5064T3LiteralLocalization.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5064T3Rectangles public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique diff --git a/LeanPool/ApollonianSuperharmonic/P5064T3OrderedPredecessor.lean b/LeanPool/ApollonianSuperharmonic/P5064T3OrderedPredecessor.lean index 5ff8a502ea..bc1a679c28 100644 --- a/LeanPool/ApollonianSuperharmonic/P5064T3OrderedPredecessor.lean +++ b/LeanPool/ApollonianSuperharmonic/P5064T3OrderedPredecessor.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision -- [TABLET NODE: P5064T3OrderedPredecessor] diff --git a/LeanPool/ApollonianSuperharmonic/P5064T3PrecursorSupport.lean b/LeanPool/ApollonianSuperharmonic/P5064T3PrecursorSupport.lean index f924e33f7d..52a1e90252 100644 --- a/LeanPool/ApollonianSuperharmonic/P5064T3PrecursorSupport.lean +++ b/LeanPool/ApollonianSuperharmonic/P5064T3PrecursorSupport.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5064T3Rectangles public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas diff --git a/LeanPool/ApollonianSuperharmonic/P5064T3RectangleContacts.lean b/LeanPool/ApollonianSuperharmonic/P5064T3RectangleContacts.lean index 53f7b1faec..9364ce2cbd 100644 --- a/LeanPool/ApollonianSuperharmonic/P5064T3RectangleContacts.lean +++ b/LeanPool/ApollonianSuperharmonic/P5064T3RectangleContacts.lean @@ -5,13 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5064T3Rectangles public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidence public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport public import LeanPool.ApollonianSuperharmonic.P5098T1SquareIntersection public import LeanPool.ApollonianSuperharmonic.P5098T1OccurrenceSquares public import LeanPool.ApollonianSuperharmonic.P5098T1EqualIntervals diff --git a/LeanPool/ApollonianSuperharmonic/P5064T3Rectangles.lean b/LeanPool/ApollonianSuperharmonic/P5064T3Rectangles.lean index 6a248f6f03..bdb3a6e279 100644 --- a/LeanPool/ApollonianSuperharmonic/P5064T3Rectangles.lean +++ b/LeanPool/ApollonianSuperharmonic/P5064T3Rectangles.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.FordTile public import LeanPool.ApollonianSuperharmonic.TileTranslation diff --git a/LeanPool/ApollonianSuperharmonic/P5090T1TangentCircleMetric.lean b/LeanPool/ApollonianSuperharmonic/P5090T1TangentCircleMetric.lean index b2644087e7..2604d50170 100644 --- a/LeanPool/ApollonianSuperharmonic/P5090T1TangentCircleMetric.lean +++ b/LeanPool/ApollonianSuperharmonic/P5090T1TangentCircleMetric.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import Mathlib.Analysis.Complex.Norm public import Mathlib.LinearAlgebra.Complex.Module diff --git a/LeanPool/ApollonianSuperharmonic/P5090T1ThreeDiskContactTriangle.lean b/LeanPool/ApollonianSuperharmonic/P5090T1ThreeDiskContactTriangle.lean index 026149676a..4299c09831 100644 --- a/LeanPool/ApollonianSuperharmonic/P5090T1ThreeDiskContactTriangle.lean +++ b/LeanPool/ApollonianSuperharmonic/P5090T1ThreeDiskContactTriangle.lean @@ -5,11 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Tactic.Positivity +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import Mathlib.Analysis.Convex.Combination public import Mathlib.Analysis.Complex.Norm public import Mathlib.LinearAlgebra.Complex.Module -public import Mathlib.Analysis.Normed.Module.Basic -- [TABLET NODE: P5090T1ThreeDiskContactTriangle] diff --git a/LeanPool/ApollonianSuperharmonic/P5090T1TwoDiskLineTriangle.lean b/LeanPool/ApollonianSuperharmonic/P5090T1TwoDiskLineTriangle.lean index c909c03f9b..b26a69a493 100644 --- a/LeanPool/ApollonianSuperharmonic/P5090T1TwoDiskLineTriangle.lean +++ b/LeanPool/ApollonianSuperharmonic/P5090T1TwoDiskLineTriangle.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Tactic.Positivity +public import Mathlib.Topology.MetricSpace.Pseudo.Real + public import Mathlib.Analysis.Convex.Combination public import Mathlib.Analysis.Complex.Norm public import Mathlib.LinearAlgebra.Complex.Module diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1ABIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5098T1ABIntervals.lean index eed8c000f9..43097a116e 100644 --- a/LeanPool/ApollonianSuperharmonic/P5098T1ABIntervals.lean +++ b/LeanPool/ApollonianSuperharmonic/P5098T1ABIntervals.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5098T1PeriodWindow public import Mathlib.Tactic.IntervalCases diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1ACIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5098T1ACIntervals.lean index 9f8298229e..3bb06b424e 100644 --- a/LeanPool/ApollonianSuperharmonic/P5098T1ACIntervals.lean +++ b/LeanPool/ApollonianSuperharmonic/P5098T1ACIntervals.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5098T1PeriodWindow public import Mathlib.Tactic.IntervalCases diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1ADIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5098T1ADIntervals.lean index a1b6d25cb1..0d766fdbfa 100644 --- a/LeanPool/ApollonianSuperharmonic/P5098T1ADIntervals.lean +++ b/LeanPool/ApollonianSuperharmonic/P5098T1ADIntervals.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5098T1PeriodWindow public import Mathlib.Tactic.IntervalCases diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1BCIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5098T1BCIntervals.lean index 2aa446ed66..bcd928df42 100644 --- a/LeanPool/ApollonianSuperharmonic/P5098T1BCIntervals.lean +++ b/LeanPool/ApollonianSuperharmonic/P5098T1BCIntervals.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5098T1PeriodWindow public import Mathlib.Tactic.IntervalCases diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1BDIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5098T1BDIntervals.lean index 9792b9a740..70d14fd5ee 100644 --- a/LeanPool/ApollonianSuperharmonic/P5098T1BDIntervals.lean +++ b/LeanPool/ApollonianSuperharmonic/P5098T1BDIntervals.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5098T1PeriodWindow public import Mathlib.Tactic.IntervalCases diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1CDIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5098T1CDIntervals.lean index c121e6a230..a448faab01 100644 --- a/LeanPool/ApollonianSuperharmonic/P5098T1CDIntervals.lean +++ b/LeanPool/ApollonianSuperharmonic/P5098T1CDIntervals.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5098T1PeriodWindow public import Mathlib.Tactic.IntervalCases diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1EqualIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5098T1EqualIntervals.lean index 91e412749f..a63d878e00 100644 --- a/LeanPool/ApollonianSuperharmonic/P5098T1EqualIntervals.lean +++ b/LeanPool/ApollonianSuperharmonic/P5098T1EqualIntervals.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5098T1PeriodWindow public import Mathlib.Tactic.IntervalCases diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1OccurrenceSquares.lean b/LeanPool/ApollonianSuperharmonic/P5098T1OccurrenceSquares.lean index ab048b53cc..9c034c4a56 100644 --- a/LeanPool/ApollonianSuperharmonic/P5098T1OccurrenceSquares.lean +++ b/LeanPool/ApollonianSuperharmonic/P5098T1OccurrenceSquares.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5064T3Rectangles public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import Mathlib.Tactic.Ring +public import Mathlib.LinearAlgebra.Matrix.Notation -- [TABLET NODE: P5098T1OccurrenceSquares] @@ -43,9 +45,13 @@ theorem P5098T1OccurrenceSquares (r s : Nat) (o : PeriodicSubtileIndex) : rcases o with ⟨l, m, n⟩ cases l all_goals - simp? [SubtileOccurrenceInterpretation, P5064T3Rectangles, - TileTranslation, GaussianTranslation, FordTile, FordCellDomain, - Finset.image_image] + simp only [SubtileOccurrenceInterpretation, TileTranslation, Int.reduceNeg, Nat.cast_add, + Zsqrtd.smul_val, mul_neg, neg_add_rev, Zsqrtd.add_def, P5064T3Rectangles, FordTile, + FordCellDomain, Finset.product_eq_sprod, Finset.image_image, GaussianTranslation, + zero_add, Fin.isValue, Matrix.cons_val', Bool.false_eq_true, ↓reduceIte, + Matrix.cons_val_fin_one, Matrix.cons_val, Matrix.cons_val_one, Finset.image_empty, + neg_mul, Finset.range_zero, Finset.product_empty, ProtoTile.mk.injEq, Zsqrtd.mk.injEq, + add_right_inj, true_and, Matrix.cons_val_zero] try { constructor · apply Finset.image_congr intro x hx diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1PeriodWindow.lean b/LeanPool/ApollonianSuperharmonic/P5098T1PeriodWindow.lean index 06f0107d80..709508285f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5098T1PeriodWindow.lean +++ b/LeanPool/ApollonianSuperharmonic/P5098T1PeriodWindow.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Tactic.ByContra public import Mathlib.Tactic.Linarith + -- [TABLET NODE: P5098T1PeriodWindow] /-! diff --git a/LeanPool/ApollonianSuperharmonic/P5098T1SquareIntersection.lean b/LeanPool/ApollonianSuperharmonic/P5098T1SquareIntersection.lean index 57ecbf7de1..f18d7429ec 100644 --- a/LeanPool/ApollonianSuperharmonic/P5098T1SquareIntersection.lean +++ b/LeanPool/ApollonianSuperharmonic/P5098T1SquareIntersection.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport public import LeanPool.ApollonianSuperharmonic.P4456T2SquareEdges diff --git a/LeanPool/ApollonianSuperharmonic/P5104T1CornerDeletionDisk.lean b/LeanPool/ApollonianSuperharmonic/P5104T1CornerDeletionDisk.lean index 2803547e54..33315b58b4 100644 --- a/LeanPool/ApollonianSuperharmonic/P5104T1CornerDeletionDisk.lean +++ b/LeanPool/ApollonianSuperharmonic/P5104T1CornerDeletionDisk.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FinitePolyominoDiskCriterion public import LeanPool.ApollonianSuperharmonic.P5617T1RectangleReachabilityAndBasepointConnectivity diff --git a/LeanPool/ApollonianSuperharmonic/P5110T1AnchoredTriples.lean b/LeanPool/ApollonianSuperharmonic/P5110T1AnchoredTriples.lean index 99c4d4391d..a3de7647b7 100644 --- a/LeanPool/ApollonianSuperharmonic/P5110T1AnchoredTriples.lean +++ b/LeanPool/ApollonianSuperharmonic/P5110T1AnchoredTriples.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5110T1ParentModel public import LeanPool.ApollonianSuperharmonic.P5110T1SquareInterface public import LeanPool.ApollonianSuperharmonic.TouchingTriple diff --git a/LeanPool/ApollonianSuperharmonic/P5110T1ParentLocalization.lean b/LeanPool/ApollonianSuperharmonic/P5110T1ParentLocalization.lean index 9a40d99769..fcef69a01d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5110T1ParentLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P5110T1ParentLocalization.lean @@ -5,14 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5110T1ParentModel public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P5110T1ParentLocalization] @@ -73,14 +71,17 @@ theorem P5110T1ParentLocalization (P : FordFareyParameter) (hq : 1 < P.q) have ncells (j : Fin 3) (b : Bool) : (N j b).cells = (P5110T1ParentModel P.q₁ P.q₂ j b).cells := by fin_cases j <;> cases b - all_goals simp? [N, P5110T1ParentModel, TileTranslation, h0, h1, h2, - Finset.image_image, ← P.sum_q] + all_goals simp only [Nat.succ_eq_add_one, Nat.reduceAdd, TileTranslation, Int.reduceNeg, + Fin.isValue, h0, h1, Finset.image_image, h2, Finset.image_empty, Fin.mk_one, + Bool.false_eq_true, ↓reduceIte, Matrix.cons_val_one, Matrix.cons_val_zero, + P5110T1ParentModel, ← P.sum_q, N, Fin.reduceFinMk, Matrix.cons_val, Fin.zero_eta] all_goals apply Finset.image_congr intro z hz have hsum := P.sum_q apply Zsqrtd.ext - all_goals simp? [GaussianTranslation] + all_goals simp only [Int.reduceNeg, Function.comp_apply, GaussianTranslation, + Zsqrtd.im_add, add_zero, Zsqrtd.re_add, add_neg_cancel_right] all_goals omega have square_nonempty (n : Nat) (hn : 0 < n) (u : GaussianInt) : (TileTranslation (FordTile n) u).cells.Nonempty := by @@ -95,7 +96,10 @@ theorem P5110T1ParentLocalization (P : FordFareyParameter) (hq : 1 < P.q) · exact ((square_nonempty P.q₁ hr _).ne_empty hmempty).elim · exact ((square_nonempty P.q₂ P.q₂_pos _).ne_empty hmempty).elim · exact ((square_nonempty P.q₂ P.q₂_pos _).ne_empty hmempty).elim - · simp? [N, P5110T1ParentModel, TileTranslation, ha2, GaussianTranslation] + · simp only [Nat.succ_eq_add_one, Nat.reduceAdd, TileTranslation, Int.reduceNeg, + Fin.isValue, GaussianTranslation, ha2, Zsqrtd.add_def, add_zero, add_neg_cancel, + Fin.reduceFinMk, Bool.false_eq_true, ↓reduceIte, Matrix.cons_val, P5110T1ParentModel, + Nat.cast_add, N] ext <;> simp · simp [N, P5110T1ParentModel, TileTranslation, ha2, GaussianTranslation] have ncent : TileCentroid (N i plus) = @@ -146,8 +150,15 @@ theorem P5110T1ParentLocalization (P : FordFareyParameter) (hq : 1 < P.q) ((FordRecursiveQuadruple P) i.succ)))) := by fin_cases i <;> cases plus all_goals - simp? [P5110T1ParentModel, ct, ce, croot, c1, c2, - f0, f1, f2, h10, h20, h30, GaussianRealPoint] + simp only [P5110T1ParentModel, Bool.false_eq_true, ↓reduceIte, Nat.succ_eq_add_one, + Nat.reduceAdd, Int.reduceNeg, Nat.cast_add, Fin.mk_one, Fin.isValue, + Matrix.cons_val_one, Matrix.cons_val_zero, ct, c2, Int.cast_zero, add_zero, + Int.cast_add, Int.cast_natCast, croot, Prod.mk_sub_mk, one_div, GaussianRealPoint, + Fin.succ_one_eq_two, h20, Int.cast_neg, f1, Prod.neg_mk, neg_neg, Prod.mk_add_mk, + Prod.smul_mk, smul_eq_mul, Prod.mk.injEq, Fin.reduceFinMk, Matrix.cons_val, ce, + Zsqrtd.re_zero, Zsqrtd.im_zero, zero_sub, Fin.reduceSucc, h30, f2, neg_zero, + zero_add, mul_neg, neg_inj, and_self, Fin.zero_eta, c1, Fin.succ_zero_eq_one, h10, + f0] have hsum : (P.q : Real) = (P.q₁ : Real) + (P.q₂ : Real) := by exact_mod_cast P.sum_q first | (constructor <;> linarith) | linarith diff --git a/LeanPool/ApollonianSuperharmonic/P5110T1ParentModel.lean b/LeanPool/ApollonianSuperharmonic/P5110T1ParentModel.lean index f98b5f8d3e..da5d2f60a3 100644 --- a/LeanPool/ApollonianSuperharmonic/P5110T1ParentModel.lean +++ b/LeanPool/ApollonianSuperharmonic/P5110T1ParentModel.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.FordTile public import LeanPool.ApollonianSuperharmonic.TileTranslation diff --git a/LeanPool/ApollonianSuperharmonic/P5110T1PositiveParentTriples.lean b/LeanPool/ApollonianSuperharmonic/P5110T1PositiveParentTriples.lean index 6ffa75196d..1de1fe7171 100644 --- a/LeanPool/ApollonianSuperharmonic/P5110T1PositiveParentTriples.lean +++ b/LeanPool/ApollonianSuperharmonic/P5110T1PositiveParentTriples.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5110T1ParentModel public import LeanPool.ApollonianSuperharmonic.P5110T1SquareInterface public import LeanPool.ApollonianSuperharmonic.TouchingTriple diff --git a/LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean b/LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean index 0db5168eb7..1b538edbf7 100644 --- a/LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean @@ -5,11 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TileTouching public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport -public import Mathlib.Data.List.Chain +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath -- [TABLET NODE: P5110T1SquareInterface] diff --git a/LeanPool/ApollonianSuperharmonic/P5110T1TranslationTriples.lean b/LeanPool/ApollonianSuperharmonic/P5110T1TranslationTriples.lean index 950b8224e3..0c73b6aef4 100644 --- a/LeanPool/ApollonianSuperharmonic/P5110T1TranslationTriples.lean +++ b/LeanPool/ApollonianSuperharmonic/P5110T1TranslationTriples.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5110T1SquareInterface public import LeanPool.ApollonianSuperharmonic.TouchingTriple diff --git a/LeanPool/ApollonianSuperharmonic/P5116T1PredecessorDeletionDisk.lean b/LeanPool/ApollonianSuperharmonic/P5116T1PredecessorDeletionDisk.lean index e6449eb384..a5ea3a1749 100644 --- a/LeanPool/ApollonianSuperharmonic/P5116T1PredecessorDeletionDisk.lean +++ b/LeanPool/ApollonianSuperharmonic/P5116T1PredecessorDeletionDisk.lean @@ -5,12 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FinitePolyominoDiskCriterion public import LeanPool.ApollonianSuperharmonic.P5617T1RectangleReachabilityAndBasepointConnectivity public import LeanPool.ApollonianSuperharmonic.DiamondTile public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslation -- [TABLET NODE: P5116T1PredecessorDeletionDisk] diff --git a/LeanPool/ApollonianSuperharmonic/P5116T1UnitDeletionDisk.lean b/LeanPool/ApollonianSuperharmonic/P5116T1UnitDeletionDisk.lean index f263dc57bb..912bb8d2dd 100644 --- a/LeanPool/ApollonianSuperharmonic/P5116T1UnitDeletionDisk.lean +++ b/LeanPool/ApollonianSuperharmonic/P5116T1UnitDeletionDisk.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FinitePolyominoDiskCriterion public import LeanPool.ApollonianSuperharmonic.P5617T1RectangleReachabilityAndBasepointConnectivity public import LeanPool.ApollonianSuperharmonic.DiamondTile diff --git a/LeanPool/ApollonianSuperharmonic/P5124T1BoundaryGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5124T1BoundaryGeometry.lean index c906fff977..d681a71a86 100644 --- a/LeanPool/ApollonianSuperharmonic/P5124T1BoundaryGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P5124T1BoundaryGeometry.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows -public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.DiamondTile -- [TABLET NODE: P5124T1BoundaryGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P5124T1EmptyParents.lean b/LeanPool/ApollonianSuperharmonic/P5124T1EmptyParents.lean index b88571d7fc..03fd4653a5 100644 --- a/LeanPool/ApollonianSuperharmonic/P5124T1EmptyParents.lean +++ b/LeanPool/ApollonianSuperharmonic/P5124T1EmptyParents.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5124T1ParentModel public import LeanPool.ApollonianSuperharmonic.P5124T1BoundaryGeometry public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P5124T1EmptyParents] @@ -242,8 +245,9 @@ private theorem hUe : rcases he with ⟨z, he⟩ cases z with | mk x y => - simp? [hUc, Zsqrtd.ext_iff, - sub_eq_add_neg, add_comm] at he + simp only [Int.reduceNeg, add_comm, hUc, Finset.mem_singleton, Zsqrtd.ext_iff, + sub_eq_add_neg, Zsqrtd.re_add, Zsqrtd.re_neg, neg_zero, add_zero, Zsqrtd.im_add, + Zsqrtd.im_neg, not_and, Zsqrtd.add_def, Zsqrtd.re_one, Zsqrtd.im_one] at he rcases he with ⟨he, hc⟩ | ⟨he, hc⟩ all_goals rcases hc with hc | hc diff --git a/LeanPool/ApollonianSuperharmonic/P5124T1ParentModel.lean b/LeanPool/ApollonianSuperharmonic/P5124T1ParentModel.lean index e3e3d72bd9..c02155a326 100644 --- a/LeanPool/ApollonianSuperharmonic/P5124T1ParentModel.lean +++ b/LeanPool/ApollonianSuperharmonic/P5124T1ParentModel.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.DiamondTile public import LeanPool.ApollonianSuperharmonic.TileTranslation diff --git a/LeanPool/ApollonianSuperharmonic/P5124T1ParentPlacement.lean b/LeanPool/ApollonianSuperharmonic/P5124T1ParentPlacement.lean index 52c0db1a38..31a856893c 100644 --- a/LeanPool/ApollonianSuperharmonic/P5124T1ParentPlacement.lean +++ b/LeanPool/ApollonianSuperharmonic/P5124T1ParentPlacement.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5124T1ParentModel public import LeanPool.ApollonianSuperharmonic.DiamondTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCentroid -- [TABLET NODE: P5124T1ParentPlacement] diff --git a/LeanPool/ApollonianSuperharmonic/P5124T1SmallerParents.lean b/LeanPool/ApollonianSuperharmonic/P5124T1SmallerParents.lean index 2f20e4951f..eedd0eaf42 100644 --- a/LeanPool/ApollonianSuperharmonic/P5124T1SmallerParents.lean +++ b/LeanPool/ApollonianSuperharmonic/P5124T1SmallerParents.lean @@ -5,9 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.CharP.Defs +public import Mathlib.Data.Finset.Card +public import Mathlib.Tactic.NormNum + public import LeanPool.ApollonianSuperharmonic.P5124T1ParentModel public import LeanPool.ApollonianSuperharmonic.P5124T1TranslatedDiamonds -public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase public import LeanPool.ApollonianSuperharmonic.P5157T1DiamondStaircaseIntersections public import LeanPool.ApollonianSuperharmonic.P5157T1DiamondSingletonIntersections @@ -69,15 +73,24 @@ theorem P5124T1SmallerParents (k : Nat) (hk : 1 < k) : have horizontalPath (z : GaussianInt) : SimpleGridPath {z, z + 1} {{z, z + 1}} := by have H := (P5157T1AlternatingStaircase z true 1 (Or.inl rfl) 1 (by decide)).2 - simp? [P5157T1StaircasePoint, Nat.le_one_iff_eq_zero_or_eq_one, - or_and_right, exists_or, show (⟨0, 0⟩ : GaussianInt) = 0 from rfl, - show (⟨1, 0⟩ : GaussianInt) = 1 from rfl] at H + simp only [Nat.le_one_iff_eq_zero_or_eq_one, P5157T1StaircasePoint, Int.reduceNeg, + ↓reduceIte, Int.natCast_ediv, Nat.cast_add, Nat.cast_one, Nat.cast_ofNat, one_mul, + or_and_right, exists_or, ↓existsAndEq, CharP.cast_eq_zero, zero_add, Int.reduceDiv, + EuclideanDomain.zero_div, show (⟨0, 0⟩ : GaussianInt) = 0 from rfl, add_zero, + true_and, Int.reduceAdd, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, + EuclideanDomain.div_self, show (⟨1, 0⟩ : GaussianInt) = 1 from rfl, Order.lt_one_iff, + exists_eq_left, Set.ofPred_eq_eq_singleton] at H convert H using 1; ext v; simp have verticalPath (z : GaussianInt) : SimpleGridPath {z, z + ⟨0, 1⟩} {{z, z + ⟨0, 1⟩}} := by have H := (P5157T1AlternatingStaircase z false 1 (Or.inl rfl) 1 (by decide)).2 - simp? [P5157T1StaircasePoint, Nat.le_one_iff_eq_zero_or_eq_one, - or_and_right, exists_or, show (⟨0, 0⟩ : GaussianInt) = 0 from rfl] at H + simp only [Nat.le_one_iff_eq_zero_or_eq_one, P5157T1StaircasePoint, Int.reduceNeg, + Bool.false_eq_true, ↓reduceIte, Int.natCast_ediv, Nat.cast_ofNat, Nat.cast_add, + Nat.cast_one, one_mul, or_and_right, exists_or, ↓existsAndEq, CharP.cast_eq_zero, + EuclideanDomain.zero_div, zero_add, Int.reduceDiv, + show (⟨0, 0⟩ : GaussianInt) = 0 from rfl, add_zero, true_and, Int.reduceAdd, ne_eq, + OfNat.ofNat_ne_zero, not_false_eq_true, EuclideanDomain.div_self, Order.lt_one_iff, + exists_eq_left, Set.ofPred_eq_eq_singleton] at H convert H using 1; ext v; simp have tp : TileTouching D Eplus := Or.inl ⟨dne, epne, dp, by rw [vp, ep]; exact hp⟩ have tq : TileTouching L Eplus := Or.inl ⟨lne, epne, dq, by rw [vq, eq]; exact hq⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P5124T1TranslatedDiamonds.lean b/LeanPool/ApollonianSuperharmonic/P5124T1TranslatedDiamonds.lean index 4e9515de8a..e5da8975d6 100644 --- a/LeanPool/ApollonianSuperharmonic/P5124T1TranslatedDiamonds.lean +++ b/LeanPool/ApollonianSuperharmonic/P5124T1TranslatedDiamonds.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5203T1IncreasingInterface public import LeanPool.ApollonianSuperharmonic.P5203T1DecreasingInterface public import LeanPool.ApollonianSuperharmonic.P5203T1CapInterface diff --git a/LeanPool/ApollonianSuperharmonic/P5124T1UnitParents.lean b/LeanPool/ApollonianSuperharmonic/P5124T1UnitParents.lean index a2314b819a..eee36ed9a9 100644 --- a/LeanPool/ApollonianSuperharmonic/P5124T1UnitParents.lean +++ b/LeanPool/ApollonianSuperharmonic/P5124T1UnitParents.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5124T1ParentModel public import LeanPool.ApollonianSuperharmonic.P5124T1TranslatedDiamonds -public import LeanPool.ApollonianSuperharmonic.P5253T1SingletonBoundary public import LeanPool.ApollonianSuperharmonic.P5253T1OneEdgeInterface public import LeanPool.ApollonianSuperharmonic.P5253T1TopSquareContacts public import LeanPool.ApollonianSuperharmonic.P5253T1LeftSquareContacts diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5BoundaryConsistency.lean b/LeanPool/ApollonianSuperharmonic/P5130T5BoundaryConsistency.lean index 19b4f6daa8..9b1f648b75 100644 --- a/LeanPool/ApollonianSuperharmonic/P5130T5BoundaryConsistency.lean +++ b/LeanPool/ApollonianSuperharmonic/P5130T5BoundaryConsistency.lean @@ -5,12 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5130T5Prescription public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv public import LeanPool.ApollonianSuperharmonic.P5188T1E1Boundary public import LeanPool.ApollonianSuperharmonic.P5188T1E2Boundary public import LeanPool.ApollonianSuperharmonic.P5188T1E3E4Boundary +public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains -- [TABLET NODE: P5130T5BoundaryConsistency] diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5DomainCover.lean b/LeanPool/ApollonianSuperharmonic/P5130T5DomainCover.lean index a99ef0b2e6..5a399f6c81 100644 --- a/LeanPool/ApollonianSuperharmonic/P5130T5DomainCover.lean +++ b/LeanPool/ApollonianSuperharmonic/P5130T5DomainCover.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains public import LeanPool.ApollonianSuperharmonic.FordVertexDomain -public import Mathlib.Tactic.FinCases -- [TABLET NODE: P5130T5DomainCover] diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5MixedOverlaps.lean b/LeanPool/ApollonianSuperharmonic/P5130T5MixedOverlaps.lean index e534fd5bba..ee553151b9 100644 --- a/LeanPool/ApollonianSuperharmonic/P5130T5MixedOverlaps.lean +++ b/LeanPool/ApollonianSuperharmonic/P5130T5MixedOverlaps.lean @@ -5,11 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5130T5Prescription public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv -public import Mathlib.Tactic.Ring +public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains -- [TABLET NODE: P5130T5MixedOverlaps] @@ -79,7 +81,8 @@ theorem P5130T5MixedOverlaps (P P₁ P₂ : FordFareyParameter) have hcross := (P5130T5ParentArithmetic P hq).2.2.2.2.2.2 refine ⟨?_, ?_, ?_, ?_⟩ · intro x hx hy - simp? [FordRecursiveVertexDomains] at hx hy + simp only [FordRecursiveVertexDomains, Int.reduceNeg, Fin.isValue, Matrix.cons_val_zero, + Set.mem_ofPred_eq, Matrix.cons_val] at hx hy have hr : x.re = (P.q₁ : Int) := by omega have ex : x = ⟨P.q₁, x.im⟩ := by ext <;> simp [hr] have ey : x - ⟨(P.q₁ : Int), 0⟩ = (⟨0, x.im⟩ : GaussianInt) := by @@ -91,7 +94,8 @@ theorem P5130T5MixedOverlaps (P P₁ P₂ : FordFareyParameter) _ = g₂ (x - ⟨(P.q₁ : Int), 0⟩) + P.p₁ * x.im := by rw [ey, (eb x.im (by omega) (by omega)).2.2.1, zero_add] · intro x hx hy - simp? [FordRecursiveVertexDomains] at hx hy + simp only [FordRecursiveVertexDomains, Int.reduceNeg, Fin.isValue, Matrix.cons_val_zero, + Set.mem_ofPred_eq, Matrix.cons_val] at hx hy have hi : x.im = (P.q₁ : Int) := by omega have ex : x = ⟨x.re, P.q₁⟩ := by ext <;> simp [hi] have ey : x - ⟨0, (P.q₁ : Int)⟩ = (⟨x.re, 0⟩ : GaussianInt) := by @@ -103,7 +107,8 @@ theorem P5130T5MixedOverlaps (P P₁ P₂ : FordFareyParameter) _ = g₂ (x - ⟨0, (P.q₁ : Int)⟩) + P.p₁ * x.re := by rw [ey, (eb x.re (by omega) (by omega)).2.2.2, zero_add] · intro x hx hy - simp? [FordRecursiveVertexDomains] at hx hy + simp only [FordRecursiveVertexDomains, Int.reduceNeg, Fin.isValue, Matrix.cons_val_one, + Matrix.cons_val_zero, Set.mem_ofPred_eq, Matrix.cons_val] at hx hy have hi : x.im = (P.q₂ : Int) := by omega have ex : x - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ = (⟨x.re - P.q₂, 0⟩ : GaussianInt) := by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub, hi] @@ -116,7 +121,8 @@ theorem P5130T5MixedOverlaps (P P₁ P₂ : FordFareyParameter) (eb (x.re - P.q₁) (by omega) (by omega)).2.1, hi] nlinarith [hcross] · intro x hx hy - simp? [FordRecursiveVertexDomains] at hx hy + simp only [FordRecursiveVertexDomains, Int.reduceNeg, Fin.isValue, Matrix.cons_val_one, + Matrix.cons_val_zero, Set.mem_ofPred_eq, Matrix.cons_val] at hx hy have hr : x.re = (P.q₂ : Int) := by omega have ex : x - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ = (⟨0, x.im - P.q₂⟩ : GaussianInt) := by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub, hr] diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5ParentArithmetic.lean b/LeanPool/ApollonianSuperharmonic/P5130T5ParentArithmetic.lean index d93abb1f76..99f1125f94 100644 --- a/LeanPool/ApollonianSuperharmonic/P5130T5ParentArithmetic.lean +++ b/LeanPool/ApollonianSuperharmonic/P5130T5ParentArithmetic.lean @@ -5,8 +5,15 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import Mathlib.Init +public import Mathlib.Algebra.Ring.Divisibility.Basic +public import Mathlib.Algebra.Group.Int.Units +public import Mathlib.Tactic.ByContra public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum + +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public meta import Lean.Meta.Tactic.NormCast -- [TABLET NODE: P5130T5ParentArithmetic] diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5PeriodicExtension.lean b/LeanPool/ApollonianSuperharmonic/P5130T5PeriodicExtension.lean index 8d9d57d739..76e6426958 100644 --- a/LeanPool/ApollonianSuperharmonic/P5130T5PeriodicExtension.lean +++ b/LeanPool/ApollonianSuperharmonic/P5130T5PeriodicExtension.lean @@ -5,12 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary public import LeanPool.ApollonianSuperharmonic.FordFareyParameter public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv public import LeanPool.ApollonianSuperharmonic.P4818T1AffineTransversalExtension -public import Mathlib.Tactic.Ring -public import Mathlib.Tactic.Abel -- [TABLET NODE: P5130T5PeriodicExtension] @@ -137,7 +137,8 @@ private theorem hrep (P : FordFareyParameter) (hq : 0 < (q P)) (x : GaussianInt) have hwi : 0 ≤ w.im ∧ w.im < q := ⟨hwi0, hwi1⟩ have hwrep := congr_arg Zsqrtd.re hwt have himrep := congr_arg Zsqrtd.im hwt - simp? [a, b, zsmul_eq_mul] at hwrep himrep + simp only [Int.reduceNeg, zsmul_eq_mul, Zsqrtd.smul_val, mul_zero, mul_neg, Zsqrtd.re_add, + add_zero, Zsqrtd.im_add, a, b] at hwrep himrep have hdivr : x.re / q = l := by apply (Int.ediv_eq_iff_of_pos hq).2 constructor <;> rw [hwrep] <;> nlinarith [hwr.1, hwr.2] @@ -368,7 +369,7 @@ theorem P5130T5PeriodicExtension (P : FordFareyParameter) have hrel : y + a + b = x := by apply Zsqrtd.ext · simp [y, a, b, q] - · simp? [y, a, b, q] + · simp only [Int.reduceNeg, Zsqrtd.im_add, y, a, q, b] rw [hqs] ring have hstep : g x = g y + α y + β (y + a) + (P.q₁ : Int) * P.p := by @@ -377,7 +378,8 @@ theorem P5130T5PeriodicExtension (P : FordFareyParameter) _ = g (y + a) + β (y + a) + (P.q₁ : Int) * P.p := hb (y + a) _ = g y + α y + β (y + a) + (P.q₁ : Int) * P.p := by rw [ha y]; ring rw [hstep] - simp? [α, β, y, a, q] + simp only [Int.reduceNeg, neg_mul, AddMonoidHom.coe_mk, ZeroHom.coe_mk, Zsqrtd.re_add, + add_zero, Zsqrtd.im_add, y, α, β, a, q] have hps : P.p = P.p₁ + P.p₂ := P.sum_p rw [hqs, hps] ring diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5Prescription.lean b/LeanPool/ApollonianSuperharmonic/P5130T5Prescription.lean index 13cc757fd2..45e3e3478a 100644 --- a/LeanPool/ApollonianSuperharmonic/P5130T5Prescription.lean +++ b/LeanPool/ApollonianSuperharmonic/P5130T5Prescription.lean @@ -5,7 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction -- [TABLET NODE: P5130T5Prescription] diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean b/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean index f6bdc8e89a..aa2fb25c87 100644 --- a/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean +++ b/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean @@ -5,11 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5130T5Prescription public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains +public import Mathlib.LinearAlgebra.Matrix.Notation -- [TABLET NODE: P5130T5SameParentOverlaps] diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5UnitCase.lean b/LeanPool/ApollonianSuperharmonic/P5130T5UnitCase.lean index c5791a97be..cbc38c50c7 100644 --- a/LeanPool/ApollonianSuperharmonic/P5130T5UnitCase.lean +++ b/LeanPool/ApollonianSuperharmonic/P5130T5UnitCase.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary public import LeanPool.ApollonianSuperharmonic.FordFareyParameter public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv -public import Mathlib.Tactic.Ring +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction -- [TABLET NODE: P5130T5UnitCase] diff --git a/LeanPool/ApollonianSuperharmonic/P5157T1AlternatingStaircase.lean b/LeanPool/ApollonianSuperharmonic/P5157T1AlternatingStaircase.lean index b499f5da12..148811f569 100644 --- a/LeanPool/ApollonianSuperharmonic/P5157T1AlternatingStaircase.lean +++ b/LeanPool/ApollonianSuperharmonic/P5157T1AlternatingStaircase.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.P5157T1StaircasePoint public import Mathlib.Data.List.ChainOfFn -public import Mathlib.Data.List.FinRange +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath -- [TABLET NODE: P5157T1AlternatingStaircase] diff --git a/LeanPool/ApollonianSuperharmonic/P5157T1DiamondSingletonIntersections.lean b/LeanPool/ApollonianSuperharmonic/P5157T1DiamondSingletonIntersections.lean index 7ee395a45c..8934797380 100644 --- a/LeanPool/ApollonianSuperharmonic/P5157T1DiamondSingletonIntersections.lean +++ b/LeanPool/ApollonianSuperharmonic/P5157T1DiamondSingletonIntersections.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P5124T1BoundaryGeometry +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows -- [TABLET NODE: P5157T1DiamondSingletonIntersections] diff --git a/LeanPool/ApollonianSuperharmonic/P5157T1DiamondStaircaseIntersections.lean b/LeanPool/ApollonianSuperharmonic/P5157T1DiamondStaircaseIntersections.lean index 2d82da1c2b..c0d18dcb64 100644 --- a/LeanPool/ApollonianSuperharmonic/P5157T1DiamondStaircaseIntersections.lean +++ b/LeanPool/ApollonianSuperharmonic/P5157T1DiamondStaircaseIntersections.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5250T1SeparatedCells public import LeanPool.ApollonianSuperharmonic.P5250T1CommonVertices public import LeanPool.ApollonianSuperharmonic.P5250T1ConsecutiveEdges diff --git a/LeanPool/ApollonianSuperharmonic/P5157T1StaircasePoint.lean b/LeanPool/ApollonianSuperharmonic/P5157T1StaircasePoint.lean index 810b25c7a0..af12356f61 100644 --- a/LeanPool/ApollonianSuperharmonic/P5157T1StaircasePoint.lean +++ b/LeanPool/ApollonianSuperharmonic/P5157T1StaircasePoint.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.SimpleGridPath +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: P5157T1StaircasePoint] diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1CeilingBelow.lean b/LeanPool/ApollonianSuperharmonic/P5188T1CeilingBelow.lean index b467beb50c..ade1c0f80e 100644 --- a/LeanPool/ApollonianSuperharmonic/P5188T1CeilingBelow.lean +++ b/LeanPool/ApollonianSuperharmonic/P5188T1CeilingBelow.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv -public import Mathlib.Tactic.Linarith +public import Mathlib.Init public import Mathlib.Tactic.Ring +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv + -- [TABLET NODE: P5188T1CeilingBelow] /-! diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1CeilingShift.lean b/LeanPool/ApollonianSuperharmonic/P5188T1CeilingShift.lean index ec49e5b196..f087bd0ba0 100644 --- a/LeanPool/ApollonianSuperharmonic/P5188T1CeilingShift.lean +++ b/LeanPool/ApollonianSuperharmonic/P5188T1CeilingShift.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv -public import Mathlib.Tactic.Linarith +public import Mathlib.Init public import Mathlib.Tactic.Ring +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv + -- [TABLET NODE: P5188T1CeilingShift] /-! diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1CeilingStability.lean b/LeanPool/ApollonianSuperharmonic/P5188T1CeilingStability.lean index 9d2092d59e..4a464c932a 100644 --- a/LeanPool/ApollonianSuperharmonic/P5188T1CeilingStability.lean +++ b/LeanPool/ApollonianSuperharmonic/P5188T1CeilingStability.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import Mathlib.Init public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.Ring + +public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv -- [TABLET NODE: P5188T1CeilingStability] diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1E1Boundary.lean b/LeanPool/ApollonianSuperharmonic/P5188T1E1Boundary.lean index 5db1bb0425..d9d2e938a3 100644 --- a/LeanPool/ApollonianSuperharmonic/P5188T1E1Boundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5188T1E1Boundary.lean @@ -5,12 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingStability public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingBelow -public import Mathlib.Tactic.Ring +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction -- [TABLET NODE: P5188T1E1Boundary] diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean b/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean index 26879b464b..0b9d1d9372 100644 --- a/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv @@ -12,6 +14,7 @@ public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingStability public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingBelow public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift public import Mathlib.Tactic.LinearCombination +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction -- [TABLET NODE: P5188T1E2Boundary] diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1E3E4Boundary.lean b/LeanPool/ApollonianSuperharmonic/P5188T1E3E4Boundary.lean index 19055ef22c..fcab666cb8 100644 --- a/LeanPool/ApollonianSuperharmonic/P5188T1E3E4Boundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5188T1E3E4Boundary.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv @@ -12,6 +14,7 @@ public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingStability public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingBelow public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift public import Mathlib.Tactic.LinearCombination +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction -- [TABLET NODE: P5188T1E3E4Boundary] diff --git a/LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean b/LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean index 9009ecc589..b520838bc7 100644 --- a/LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence public import LeanPool.ApollonianSuperharmonic.P5124T1BoundaryGeometry -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance +public import LeanPool.ApollonianSuperharmonic.SimpleGridPath +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P5203T1CapInterface] diff --git a/LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean b/LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean index 5bbdf62dc7..3a3153f129 100644 --- a/LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence -public import LeanPool.ApollonianSuperharmonic.P5124T1BoundaryGeometry public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P5203T1DecreasingInterface] diff --git a/LeanPool/ApollonianSuperharmonic/P5203T1IncreasingInterface.lean b/LeanPool/ApollonianSuperharmonic/P5203T1IncreasingInterface.lean index 1c153fc260..1c8c42a02d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5203T1IncreasingInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P5203T1IncreasingInterface.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence -public import LeanPool.ApollonianSuperharmonic.P5124T1BoundaryGeometry public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P5203T1IncreasingInterface] diff --git a/LeanPool/ApollonianSuperharmonic/P5250T1CommonVertices.lean b/LeanPool/ApollonianSuperharmonic/P5250T1CommonVertices.lean index 4558b89169..ee1052c25d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5250T1CommonVertices.lean +++ b/LeanPool/ApollonianSuperharmonic/P5250T1CommonVertices.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.P5157T1StaircasePoint diff --git a/LeanPool/ApollonianSuperharmonic/P5250T1ConsecutiveEdges.lean b/LeanPool/ApollonianSuperharmonic/P5250T1ConsecutiveEdges.lean index d0f54a3843..0ec29f4232 100644 --- a/LeanPool/ApollonianSuperharmonic/P5250T1ConsecutiveEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P5250T1ConsecutiveEdges.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5124T1BoundaryGeometry public import LeanPool.ApollonianSuperharmonic.P5157T1StaircasePoint +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P5250T1ConsecutiveEdges] diff --git a/LeanPool/ApollonianSuperharmonic/P5250T1RankedCommonEdges.lean b/LeanPool/ApollonianSuperharmonic/P5250T1RankedCommonEdges.lean index 72db7587c8..7bdcc5ede7 100644 --- a/LeanPool/ApollonianSuperharmonic/P5250T1RankedCommonEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P5250T1RankedCommonEdges.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -- [TABLET NODE: P5250T1RankedCommonEdges] diff --git a/LeanPool/ApollonianSuperharmonic/P5250T1SeparatedCells.lean b/LeanPool/ApollonianSuperharmonic/P5250T1SeparatedCells.lean index cec9203409..f673858ce8 100644 --- a/LeanPool/ApollonianSuperharmonic/P5250T1SeparatedCells.lean +++ b/LeanPool/ApollonianSuperharmonic/P5250T1SeparatedCells.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows public import LeanPool.ApollonianSuperharmonic.DiamondTile public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas diff --git a/LeanPool/ApollonianSuperharmonic/P5253T1BottomSquareContact.lean b/LeanPool/ApollonianSuperharmonic/P5253T1BottomSquareContact.lean index 7f8ca62be8..8ed199c0c6 100644 --- a/LeanPool/ApollonianSuperharmonic/P5253T1BottomSquareContact.lean +++ b/LeanPool/ApollonianSuperharmonic/P5253T1BottomSquareContact.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5253T1SingletonBoundary public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas diff --git a/LeanPool/ApollonianSuperharmonic/P5253T1LeftSquareContacts.lean b/LeanPool/ApollonianSuperharmonic/P5253T1LeftSquareContacts.lean index 77a31c8d13..19223495c9 100644 --- a/LeanPool/ApollonianSuperharmonic/P5253T1LeftSquareContacts.lean +++ b/LeanPool/ApollonianSuperharmonic/P5253T1LeftSquareContacts.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5253T1SingletonBoundary public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas diff --git a/LeanPool/ApollonianSuperharmonic/P5253T1OneEdgeInterface.lean b/LeanPool/ApollonianSuperharmonic/P5253T1OneEdgeInterface.lean index 7d71b394c7..946ccb6217 100644 --- a/LeanPool/ApollonianSuperharmonic/P5253T1OneEdgeInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P5253T1OneEdgeInterface.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileTouching -public import Mathlib.Tactic.NormNum -- [TABLET NODE: P5253T1OneEdgeInterface] diff --git a/LeanPool/ApollonianSuperharmonic/P5253T1SingletonBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5253T1SingletonBoundary.lean index 9a7dde1944..68cfaf3e54 100644 --- a/LeanPool/ApollonianSuperharmonic/P5253T1SingletonBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5253T1SingletonBoundary.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import Mathlib.Tactic.Tauto -- [TABLET NODE: P5253T1SingletonBoundary] diff --git a/LeanPool/ApollonianSuperharmonic/P5253T1TopSquareContacts.lean b/LeanPool/ApollonianSuperharmonic/P5253T1TopSquareContacts.lean index 1f6fa61c76..04da83257b 100644 --- a/LeanPool/ApollonianSuperharmonic/P5253T1TopSquareContacts.lean +++ b/LeanPool/ApollonianSuperharmonic/P5253T1TopSquareContacts.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5253T1SingletonBoundary public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas diff --git a/LeanPool/ApollonianSuperharmonic/P5260T1LiteralPlacement.lean b/LeanPool/ApollonianSuperharmonic/P5260T1LiteralPlacement.lean index 631e1baa0e..fa482494ca 100644 --- a/LeanPool/ApollonianSuperharmonic/P5260T1LiteralPlacement.lean +++ b/LeanPool/ApollonianSuperharmonic/P5260T1LiteralPlacement.lean @@ -5,14 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm public import LeanPool.ApollonianSuperharmonic.P5124T1ParentPlacement -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.P5300T1CanonicalRowArithmetic public import LeanPool.ApollonianSuperharmonic.P5300T1CenteredCellGeometry public import LeanPool.ApollonianSuperharmonic.P5300T1AffineCellObservables diff --git a/LeanPool/ApollonianSuperharmonic/P5260T1PlacementLedger.lean b/LeanPool/ApollonianSuperharmonic/P5260T1PlacementLedger.lean index 0af72b626f..43885f3b54 100644 --- a/LeanPool/ApollonianSuperharmonic/P5260T1PlacementLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P5260T1PlacementLedger.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5124T1ParentModel -- [TABLET NODE: P5260T1PlacementLedger] diff --git a/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean b/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean index 3a506d8b9f..b0f9051b88 100644 --- a/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean @@ -5,23 +5,18 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -public import LeanPool.ApollonianSuperharmonic.P5203T1CapInterface -public import LeanPool.ApollonianSuperharmonic.P5157T1DiamondStaircaseIntersections -public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase public import LeanPool.ApollonianSuperharmonic.P5253T1BottomSquareContact public import LeanPool.ApollonianSuperharmonic.P5253T1LeftSquareContacts public import LeanPool.ApollonianSuperharmonic.P5253T1OneEdgeInterface -public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary public import LeanPool.ApollonianSuperharmonic.DiamondBaseT2 public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCentroid public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn public import LeanPool.ApollonianSuperharmonic.P5124T1SmallerParents public import LeanPool.ApollonianSuperharmonic.P5691T1DiamondReflectionFootprints @@ -1085,7 +1080,8 @@ private theorem pathRAB0 : rw [← translateZero D] at hi rw [quarterVertices shiftLow, quarterVertices 0, quarterEdges shiftLow, quarterEdges 0] at hi - simp? [Q, GaussianQuarterTurn] at hi + simp only [GaussianQuarterTurn, Int.reduceNeg, Zsqrtd.im_zero, neg_zero, Zsqrtd.re_zero, Q] + at hi have hQshift : (⟨-shiftLow.im, shiftLow.re⟩ : GaussianInt) = shiftR := by simpa [Q, GaussianQuarterTurn] using shiftQuarter rw [show u + (⟨-shiftLow.im, shiftLow.re⟩ : GaussianInt) = u + shiftR by @@ -3139,7 +3135,8 @@ theorem P5260T1PredecessorInterfaces (k : Nat) (hk : 1 < k) (b : Bool) : QuarterTurnSymmetricCenteredTransport D (DiamondBaseT2 ⟨k, hkpos⟩) have hcentroid := P4194T1DiamondCentroid k hkpos rw [hcentroid] at hu - simp? [GaussianRealPoint] at hu + simp only [GaussianRealPoint, Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, + zero_add, sub_zero, Prod.mk.injEq] at hu have huEq := PredecessorInterfaceGeometry.huEq k u hu let Q : GaussianInt → GaussianInt := GaussianQuarterTurn let F : GaussianInt → GaussianInt := fun z => Q z + u diff --git a/LeanPool/ApollonianSuperharmonic/P5260T1UnitInterfaces.lean b/LeanPool/ApollonianSuperharmonic/P5260T1UnitInterfaces.lean index 75ff6c79b6..d12a3eb2a0 100644 --- a/LeanPool/ApollonianSuperharmonic/P5260T1UnitInterfaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P5260T1UnitInterfaces.lean @@ -5,20 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -public import LeanPool.ApollonianSuperharmonic.P5203T1IncreasingInterface -public import LeanPool.ApollonianSuperharmonic.P5203T1DecreasingInterface -public import LeanPool.ApollonianSuperharmonic.P5253T1TopSquareContacts -public import LeanPool.ApollonianSuperharmonic.P5253T1LeftSquareContacts -public import LeanPool.ApollonianSuperharmonic.P5253T1BottomSquareContact -public import LeanPool.ApollonianSuperharmonic.P5253T1OneEdgeInterface -public import LeanPool.ApollonianSuperharmonic.P5157T1DiamondStaircaseIntersections -public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase -public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas public import LeanPool.ApollonianSuperharmonic.P5290T1RawBoundaryInterfaces public import LeanPool.ApollonianSuperharmonic.P5290T1EqualDiamondPaths public import LeanPool.ApollonianSuperharmonic.P5290T1UnitContactPaths diff --git a/LeanPool/ApollonianSuperharmonic/P5269T1CenteredSquareTripleTransport.lean b/LeanPool/ApollonianSuperharmonic/P5269T1CenteredSquareTripleTransport.lean index 9506d20a16..6d03f02b8a 100644 --- a/LeanPool/ApollonianSuperharmonic/P5269T1CenteredSquareTripleTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/P5269T1CenteredSquareTripleTransport.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.P4055T1ExactTripleImage public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality diff --git a/LeanPool/ApollonianSuperharmonic/P5269T1FordSquareNormalForm.lean b/LeanPool/ApollonianSuperharmonic/P5269T1FordSquareNormalForm.lean index 1fcf9b9fcb..4020b12d27 100644 --- a/LeanPool/ApollonianSuperharmonic/P5269T1FordSquareNormalForm.lean +++ b/LeanPool/ApollonianSuperharmonic/P5269T1FordSquareNormalForm.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P5269T1FordSquareNormalForm] diff --git a/LeanPool/ApollonianSuperharmonic/P5269T1IncomingSquareJunctions.lean b/LeanPool/ApollonianSuperharmonic/P5269T1IncomingSquareJunctions.lean index 8fbba2b351..d4d4ae5e3c 100644 --- a/LeanPool/ApollonianSuperharmonic/P5269T1IncomingSquareJunctions.lean +++ b/LeanPool/ApollonianSuperharmonic/P5269T1IncomingSquareJunctions.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5682T1AlignedSquareRawInterfaces public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleLatticeTouching public import LeanPool.ApollonianSuperharmonic.FordTileGeometry diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1ColumnReflection.lean b/LeanPool/ApollonianSuperharmonic/P5290T1ColumnReflection.lean index d89ea33621..38594187f9 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1ColumnReflection.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1ColumnReflection.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean b/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean index eb045d33c1..e3aa948969 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean @@ -5,13 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger public import LeanPool.ApollonianSuperharmonic.P5203T1IncreasingInterface public import LeanPool.ApollonianSuperharmonic.P5203T1DecreasingInterface -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import LeanPool.ApollonianSuperharmonic.P4055T1GridPathImage -public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport public import LeanPool.ApollonianSuperharmonic.DiamondBaseT2 public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCentroid @@ -589,7 +589,8 @@ private theorem hcEq : intro k hk D c hc have hcent := P4194T1DiamondCentroid k hk rw [hcent] at hc - simp? [GaussianRealPoint] at hc + simp only [GaussianRealPoint, Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, + zero_add, sub_zero, Prod.mk.injEq] at hc rcases hc with ⟨hr, hi⟩ apply Zsqrtd.ext · rw [← GaussianInt.intCast_re c] at hr diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean b/LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean index 63bef50983..2cf901ebe8 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5157T1DiamondStaircaseIntersections public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween -- [TABLET NODE: P5290T1PredecessorPath] diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1RawBoundaryInterfaces.lean b/LeanPool/ApollonianSuperharmonic/P5290T1RawBoundaryInterfaces.lean index acc8657597..42da9341ad 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1RawBoundaryInterfaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1RawBoundaryInterfaces.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary public import LeanPool.ApollonianSuperharmonic.FootprintVertices diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean b/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean index d70a269411..679fe03a71 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean @@ -5,13 +5,17 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.Finset.Card +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Ring + public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger public import LeanPool.ApollonianSuperharmonic.P5253T1TopSquareContacts public import LeanPool.ApollonianSuperharmonic.P5253T1LeftSquareContacts public import LeanPool.ApollonianSuperharmonic.P5253T1BottomSquareContact public import LeanPool.ApollonianSuperharmonic.P5253T1OneEdgeInterface -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween -- [TABLET NODE: P5290T1UnitContactPaths] @@ -335,8 +339,10 @@ private theorem zeroUnitContacts (k : Nat) (hk : 0 < k) (hk1 : 1 < k) : (Or.inr (Or.inr (Or.inl rfl))) refine ⟨?_, ?_, ?_, ?_⟩ · intro T U a b hmem - simp? [P5260T1PlacementLedger, - P5124T1ParentModel] at hmem + simp only [P5260T1PlacementLedger, Bool.false_eq_true, ↓reduceIte, Nat.succ_eq_add_one, + Nat.reduceAdd, P5124T1ParentModel, Int.reduceNeg, Fin.isValue, Matrix.cons_val_zero, + Matrix.cons_val_one, Matrix.cons_val, neg_mul, Zsqrtd.add_def, add_zero, + List.mem_cons, Prod.mk.injEq, List.not_mem_nil, or_false] at hmem rcases hmem with hmem | hmem | hmem | hmem | hmem · rcases hmem with ⟨rfl, rfl, rfl, rfl⟩ simpa [D, x0, y0] using hTopPath @@ -547,8 +553,10 @@ private theorem oneUnitContacts (k : Nat) (hk : 0 < k) : (Or.inr (Or.inr (Or.inl rfl))) refine ⟨?_, ?_, ?_, ?_⟩ · intro T U a b hmem - simp? [P5260T1PlacementLedger, - P5124T1ParentModel] at hmem + simp only [P5260T1PlacementLedger, Bool.false_eq_true, ↓reduceIte, Nat.succ_eq_add_one, + Nat.reduceAdd, P5124T1ParentModel, Int.reduceNeg, Fin.isValue, Matrix.cons_val_zero, + Matrix.cons_val_one, Matrix.cons_val, neg_mul, Fin.reduceEq, List.mem_cons, + Prod.mk.injEq, List.not_mem_nil, or_false] at hmem rcases hmem with hmem | hmem | hmem | hmem | hmem · rcases hmem with ⟨rfl, rfl, rfl, rfl⟩ simpa [D, c1, x1, y1] using hDWPath diff --git a/LeanPool/ApollonianSuperharmonic/P5300T1AffineCellObservables.lean b/LeanPool/ApollonianSuperharmonic/P5300T1AffineCellObservables.lean index b472a68f51..79b955cd1c 100644 --- a/LeanPool/ApollonianSuperharmonic/P5300T1AffineCellObservables.lean +++ b/LeanPool/ApollonianSuperharmonic/P5300T1AffineCellObservables.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas diff --git a/LeanPool/ApollonianSuperharmonic/P5300T1CanonicalRowArithmetic.lean b/LeanPool/ApollonianSuperharmonic/P5300T1CanonicalRowArithmetic.lean index 048ae0c333..a2640eb45c 100644 --- a/LeanPool/ApollonianSuperharmonic/P5300T1CanonicalRowArithmetic.lean +++ b/LeanPool/ApollonianSuperharmonic/P5300T1CanonicalRowArithmetic.lean @@ -5,9 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger -public import LeanPool.ApollonianSuperharmonic.P5124T1ParentPlacement public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCentroid +public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: P5300T1CanonicalRowArithmetic] @@ -120,7 +125,12 @@ theorem P5300T1CanonicalRowArithmetic (K : DiamondParameter) (-(K.1 : Real) - 1 / 2, (K.1 : Real) - 1 / 2), ((K.1 : Real), 0)] t := by fin_cases t <;> - simp? [P, P5124T1ParentModel, singleton, ht, centroid, Nat.cast_sub hk]; + simp only [P5124T1ParentModel, ↓reduceIte, Nat.succ_eq_add_one, Nat.reduceAdd, + Int.reduceNeg, Fin.mk_one, Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, + singleton, Int.cast_sub, Int.cast_neg, Int.cast_natCast, Int.cast_one, one_div, + Prod.mk.injEq, P, Fin.reduceFinMk, Matrix.cons_val, ht, centroid, Nat.cast_sub hk, + Nat.cast_one, zero_add, sub_add_sub_cancel, sub_self, Fin.zero_eta, Int.cast_zero, + Int.cast_mul, Int.cast_ofNat]; first | (constructor <;> ring) have image_add (A : Finset GaussianInt) (u v : GaussianInt) : (A.image (GaussianTranslation u)).image (GaussianTranslation v) = @@ -158,15 +168,26 @@ theorem P5300T1CanonicalRowArithmetic (K : DiamondParameter) first | ring1 · change M.1.1.cells = (TileTranslation (P i) tW).cells fin_cases i <;> fin_cases s <;> - simp? [M, b, P, tW, P5260T1PlacementLedger, P5124T1ParentModel, - TileTranslation, GaussianTranslation, image_add, Zsqrtd.ext_iff] <;> + simp only [P5260T1PlacementLedger, Nat.mod_self, zero_ne_one, decide_false, + Bool.false_eq_true, ↓reduceIte, Nat.succ_eq_add_one, Nat.reduceAdd, + P5124T1ParentModel, Int.reduceNeg, TileTranslation, GaussianTranslation, + Fin.isValue, Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, neg_mul, + Fin.mk_one, Finset.image_singleton, add_zero, M, b, tW, P, Fin.reduceFinMk, + image_add, Fin.zero_eta, Nat.mod_succ, decide_true, Zsqrtd.add_def, + sub_add_add_cancel, neg_add_cancel, Finset.singleton_inj, Zsqrtd.ext_iff, true_and, + zero_add, Nat.reduceMod, Nat.zero_mod] <;> ring · change M.1.2.cells = (TileTranslation (P j) tZ).cells fin_cases i <;> fin_cases s <;> - simp? [M, b, P, j, tZ, P5260T1PlacementLedger, P5124T1ParentModel, - TileTranslation, GaussianTranslation, image_add, Nat.even_iff, - hp0, hp2, hn0, hn1, hn2, - Zsqrtd.ext_iff] <;> + simp only [P5260T1PlacementLedger, Nat.mod_self, zero_ne_one, decide_false, + Bool.false_eq_true, ↓reduceIte, Nat.succ_eq_add_one, Nat.reduceAdd, + P5124T1ParentModel, Int.reduceNeg, TileTranslation, GaussianTranslation, + Fin.isValue, Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, neg_mul, + Fin.mk_one, even_two, sub_self, Finset.image_singleton, Zsqrtd.add_def, zero_add, + Finset.singleton_inj, Zsqrtd.ext_iff, true_and, M, b, tZ, P, j, Fin.reduceFinMk, + hp2, sub_add_add_cancel, neg_add_cancel, Fin.zero_eta, hp0, image_add, add_zero, + Nat.mod_succ, decide_true, Nat.even_iff, one_ne_zero, hn1, hn2, hn0, Nat.reduceMod, + Nat.zero_mod, Even.zero] <;> ring · change TileCentroid (TileTranslation (P i) (if s.val < 2 then tW else C - tW - c i)) - diff --git a/LeanPool/ApollonianSuperharmonic/P5300T1CenteredCellGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5300T1CenteredCellGeometry.lean index a8aa13488d..2f706e1e7b 100644 --- a/LeanPool/ApollonianSuperharmonic/P5300T1CenteredCellGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P5300T1CenteredCellGeometry.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5124T1ParentModel public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple diff --git a/LeanPool/ApollonianSuperharmonic/P5327T1RightSquareJunctions.lean b/LeanPool/ApollonianSuperharmonic/P5327T1RightSquareJunctions.lean index f377c14810..a010cea043 100644 --- a/LeanPool/ApollonianSuperharmonic/P5327T1RightSquareJunctions.lean +++ b/LeanPool/ApollonianSuperharmonic/P5327T1RightSquareJunctions.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.P5682T1AlignedSquareRawInterfaces public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1LiteralNormalization.lean b/LeanPool/ApollonianSuperharmonic/P5332T1LiteralNormalization.lean index 3481ee781e..fbf2d3e85a 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1LiteralNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1LiteralNormalization.lean @@ -5,13 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid -public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.P4062T1CanonicalSupport -public import LeanPool.ApollonianSuperharmonic.P4217T2SquareGeometry -public import LeanPool.ApollonianSuperharmonic.P4217T2RectangularBoundarySlope public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation0Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation0Values.lean index 2867b7bf58..ca8012aaca 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation0Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation0Values.lean @@ -5,13 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain -public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift -public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic -- [TABLET NODE: P5332T1Parent1Rotation0Values] diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation1Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation1Values.lean index dfa21fb7f6..78c59df3d0 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation1Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation1Values.lean @@ -5,12 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain -public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift -- [TABLET NODE: P5332T1Parent1Rotation1Values] diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation2Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation2Values.lean index 94c6ae1084..471d18e8fe 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation2Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation2Values.lean @@ -5,12 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain -public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift -- [TABLET NODE: P5332T1Parent1Rotation2Values] @@ -99,7 +97,11 @@ theorem P5332T1Parent1Rotation2Values (P A : FordFareyParameter) (hq : 1 < P.q) have hx0 := hx have hx'0 := hx' change 0 ≤ X ∧ X ≤ (P.q : Int) ∧ 0 ≤ Y ∧ Y ≤ (P.q : Int) at hx0 - simp? [P5332T1ParentRows, FordVertexDomain] at hx'0 + simp only [FordVertexDomain, Int.reduceNeg, P5332T1ParentRows, Nat.succ_eq_add_one, + Nat.reduceAdd, add_zero, mul_zero, neg_zero, EuclideanDomain.zero_div, zero_add, + sub_zero, zero_sub, neg_neg, Fin.isValue, Matrix.cons_val', Matrix.cons_val, + Matrix.cons_val_fin_one, Matrix.cons_val_zero, Set.mem_ofPred_eq, Zsqrtd.re_sub, + Zsqrtd.im_sub, sub_neg_eq_add] at hx'0 have hY : Y = 0 := by omega subst Y have hXr : X ≤ (P.q₁ : Int) := by simpa [hAq] using hx'0.2.1 diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation3Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation3Values.lean index 279a2b742d..c4e3d5c9ed 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation3Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation3Values.lean @@ -5,12 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain -public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift -- [TABLET NODE: P5332T1Parent1Rotation3Values] diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean index 32a4acaadf..28692ade25 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean @@ -5,12 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain -public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift -- [TABLET NODE: P5332T1Parent2Rotation0Values] @@ -114,21 +112,26 @@ private theorem values : intro P A hq f hbase qsum rpos spos hsn Y hAqInt hdisp hx0 hx'0 hY hlow t valLeft valChildEast valA hother l fin_cases l - · simp? [] + · simp only [Int.reduceNeg, Nat.succ_eq_add_one, Nat.reduceAdd, Fin.zero_eta, Fin.isValue, + Matrix.cons_val_zero, add_zero] have hh := hbase ⟨0,Y⟩ hx0 rw [hh, valLeft Y (by omega) (by omega)] simp [P5332T1ParentRows] - · simp? [] + · simp only [Int.reduceNeg, Nat.succ_eq_add_one, Nat.reduceAdd, Fin.mk_one, Fin.isValue, + Matrix.cons_val_one, Matrix.cons_val_zero] have eastArg : (⟨0,Y⟩ : GaussianInt) + 1 = ⟨1,Y⟩ := by ext <;> simp rw [eastArg] have hh := hbase ⟨1,Y⟩ (by change 0 ≤ (1 : Int) ∧ 1 ≤ (P.q : Int) ∧ 0 ≤ Y ∧ Y ≤ P.q omega) rw [hh, valChildEast Y (by omega) (by omega)] - simp? [P5332T1ParentRows, IntegerCeilDiv] + simp only [IntegerCeilDiv, P5332T1ParentRows, Nat.succ_eq_add_one, Nat.reduceAdd, + Int.reduceNeg, neg_add_rev, neg_sub, Fin.isValue, Matrix.cons_val', + Matrix.cons_val_zero, Matrix.cons_val_fin_one, Matrix.cons_val_one, neg_inj] have hy : Y = (P.q₂ : Int)-t := by dsimp [t]; omega rw [hy] - · simp? [Fin.reduceFinMk] + · simp only [Int.reduceNeg, Nat.succ_eq_add_one, Nat.reduceAdd, Fin.reduceFinMk, + Matrix.cons_val, Fin.isValue] have arg : (⟨0,Y⟩ : GaussianInt)-1 = ⟨-1,Y⟩ := by ext <;> simp have hp := hother (⟨0,Y⟩-1) (by rw [arg] @@ -159,14 +162,16 @@ private theorem values : -(P.p₂*((P.q₂ : Int)-t)/(P.q₂ : Int)) := by rfl rw [hrowval] simpa only [hy] using hp - · simp? [Fin.reduceFinMk] + · simp only [Int.reduceNeg, Nat.succ_eq_add_one, Nat.reduceAdd, Fin.reduceFinMk, + Matrix.cons_val, Zsqrtd.add_def, add_zero, Fin.isValue] have northArg : (⟨0,Y⟩ : GaussianInt) + ⟨0,1⟩ = ⟨0,Y+1⟩ := by ext <;> simp have hh := hbase ⟨0,Y+1⟩ (by change (0 : Int) ≤ 0 ∧ 0 ≤ (P.q : Int) ∧ 0 ≤ Y+1 ∧ Y+1 ≤ (P.q : Int) omega) rw [hh, valLeft (Y+1) (by omega) (by omega)] simp [P5332T1ParentRows] - · simp? [Fin.reduceFinMk] + · simp only [Int.reduceNeg, Nat.succ_eq_add_one, Nat.reduceAdd, Fin.reduceFinMk, + Matrix.cons_val, Fin.isValue] have southArg : (⟨0,Y⟩ : GaussianInt) - ⟨0,1⟩ = ⟨0,Y-1⟩ := by ext <;> simp have southPlus : (⟨0,Y⟩ : GaussianInt) + (-⟨0,1⟩) = ⟨0,Y-1⟩ := by ext <;> simp; ring diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean index 56ba37b7e1..701bfb9557 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean @@ -5,12 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain -public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift -- [TABLET NODE: P5332T1Parent2Rotation1Values] diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean index 9cc0d4ed46..cdc2fd8141 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean @@ -5,13 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows -public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain -public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic -- [TABLET NODE: P5332T1Parent2Rotation2Values] diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation3Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation3Values.lean index d503c1b343..443d32e3a6 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation3Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation3Values.lean @@ -5,12 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain -public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift -- [TABLET NODE: P5332T1Parent2Rotation3Values] @@ -134,7 +132,8 @@ theorem P5332T1Parent2Rotation3Values (P A : FordFareyParameter) (hq : 1 < P.q) have hn : ¬ (2 ≤ X ∧ X ≤ (A.q : Int)-2 ∧ 2 ≤ (0:Int) ∧ 0 ≤ (A.q : Int)-2) := by omega exact ⟨by omega, hn⟩ have hzbd := hab hmem - simp? [IntegerCeilDiv] at hzbd + simp only [Int.reduceNeg, IntegerCeilDiv, Fin.isValue, mul_zero, neg_zero, + EuclideanDomain.zero_div] at hzbd exact hzbd rw [hz] at hh norm_num at hh ⊢ diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1ParentRounding.lean b/LeanPool/ApollonianSuperharmonic/P5332T1ParentRounding.lean index f1765cca4f..ad7f53026e 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1ParentRounding.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1ParentRounding.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic public import LeanPool.ApollonianSuperharmonic.P5332T1SignedParentIntervals @@ -41,20 +43,20 @@ theorem P5332T1ParentRounding (P : FordFareyParameter) (hq : 1 < P.q) nlinarith [P.det₂] have fm (K : Int) : (K*(P.q : Int)-1)/(P.q : Int) = K-1 := by apply (Int.ediv_eq_iff_of_pos (by omega)).mpr - constructor <;> nlinarith + constructor <;> nlinarith only [hq'] have fp (K : Int) : (K*(P.q : Int)+1)/(P.q : Int) = K := by apply (Int.ediv_eq_iff_of_pos (by omega)).mpr - constructor <;> nlinarith + constructor <;> nlinarith only [hq'] have cm (K : Int) : -((-(K*(P.q : Int)-1))/(P.q : Int)) = K := by have hh : (-(K*(P.q : Int)-1))/(P.q : Int) = -K := by apply (Int.ediv_eq_iff_of_pos (by omega)).mpr - constructor <;> nlinarith + constructor <;> nlinarith only [hq'] rw [hh] ring have cp (K : Int) : -((-(K*(P.q : Int)+1))/(P.q : Int)) = K+1 := by have hh : (-(K*(P.q : Int)+1))/(P.q : Int) = -(K+1) := by apply (Int.ediv_eq_iff_of_pos (by omega)).mpr - constructor <;> nlinarith + constructor <;> nlinarith only [hq'] rw [hh] ring by_cases ht0 : t = 0 diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1ParentRows.lean b/LeanPool/ApollonianSuperharmonic/P5332T1ParentRows.lean index deeaa5f716..bfefe89b55 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1ParentRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1ParentRows.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1Stencil +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter -- [TABLET NODE: P5332T1ParentRows] diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1RightFirstValues.lean b/LeanPool/ApollonianSuperharmonic/P5332T1RightFirstValues.lean index 0231841562..6249fc2b18 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1RightFirstValues.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1RightFirstValues.lean @@ -5,12 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1RightRows public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift -- [TABLET NODE: P5332T1RightFirstValues] diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1RightHorizontalValues.lean b/LeanPool/ApollonianSuperharmonic/P5332T1RightHorizontalValues.lean index e882de0061..fc67a51652 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1RightHorizontalValues.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1RightHorizontalValues.lean @@ -5,12 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1RightRows public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift -- [TABLET NODE: P5332T1RightHorizontalValues] diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1RightRounding.lean b/LeanPool/ApollonianSuperharmonic/P5332T1RightRounding.lean index de9bab1bc5..2b864f3311 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1RightRounding.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1RightRounding.lean @@ -5,8 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1RightRows -public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public meta import Lean.Meta.Tactic.NormCast -- [TABLET NODE: P5332T1RightRounding] @@ -49,27 +51,28 @@ theorem P5332T1RightRounding (P : FordFareyParameter) (hq : 1 < P.q) nlinarith only [hm, hk] have fm (K : Int) : (K*(P.q : Int)-1)/(P.q : Int) = K-1 := by apply (Int.ediv_eq_iff_of_pos (by omega)).mpr - constructor <;> nlinarith + constructor <;> nlinarith only [hq'] have fp (K : Int) : (K*(P.q : Int)+1)/(P.q : Int) = K := by apply (Int.ediv_eq_iff_of_pos (by omega)).mpr - constructor <;> nlinarith + constructor <;> nlinarith only [hq'] have ceil (N K : Int) (lo : K*(P.q : Int) < N) (hi : N ≤ K*(P.q : Int)+P.q) : -((-N)/(P.q : Int)) = K+1 := by have hh : (-N)/(P.q : Int) = -(K+1) := by apply (Int.ediv_eq_iff_of_pos (by omega)).mpr - constructor <;> nlinarith + constructor <;> nlinarith only [hq', lo, hi] rw [hh] ring have cm (K : Int) : -((-(K*(P.q : Int)-1))/(P.q : Int)) = K := by - convert ceil (K*(P.q : Int)-1) (K-1) (by nlinarith) (by nlinarith) using 1; ring + convert ceil (K*(P.q : Int)-1) (K-1) + (by nlinarith only [hq']) (by nlinarith only [hq']) using 1; ring have cp (K : Int) : -((-(K*(P.q : Int)+1))/(P.q : Int)) = K+1 := ceil _ K (by omega) (by omega) have fnm (K : Int) : (1-K*(P.q : Int))/(P.q : Int) = -K := by apply (Int.ediv_eq_iff_of_pos (by omega)).mpr - constructor <;> nlinarith + constructor <;> nlinarith only [hq'] have fnp (K : Int) : (-1-K*(P.q : Int))/(P.q : Int) = -(K+1) := by apply (Int.ediv_eq_iff_of_pos (by omega)).mpr - constructor <;> nlinarith + constructor <;> nlinarith only [hq'] have dq (K : Int) : K*(P.q : Int)/(P.q : Int) = K := Int.mul_ediv_cancel K (by omega) have cq (K : Int) : -((-(K*(P.q : Int)))/(P.q : Int)) = K := by diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1RightRows.lean b/LeanPool/ApollonianSuperharmonic/P5332T1RightRows.lean index 179d5fa1d9..06e2bd8a70 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1RightRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1RightRows.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1Stencil +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter -- [TABLET NODE: P5332T1RightRows] diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean b/LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean index 7290054dd3..f017d1ed67 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean @@ -5,13 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1RightRows public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain public import LeanPool.ApollonianSuperharmonic.P4210T1FordCellRectangles -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingShift -public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic -- [TABLET NODE: P5332T1RightSecondValues] diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1SignedParentIntervals.lean b/LeanPool/ApollonianSuperharmonic/P5332T1SignedParentIntervals.lean index cccb7615b0..e37aacb49f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1SignedParentIntervals.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1SignedParentIntervals.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.IntegerCeilDiv +public import Mathlib.Init public import Mathlib.Tactic.Linarith public import Mathlib.Tactic.Ring + -- [TABLET NODE: P5332T1SignedParentIntervals] /-! diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Stencil.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Stencil.lean index 0776549c0c..6226590ef2 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Stencil.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Stencil.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: P5332T1Stencil] diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1VectorPlacements.lean b/LeanPool/ApollonianSuperharmonic/P5332T1VectorPlacements.lean index 1bd38d5058..4ab7c084f5 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1VectorPlacements.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1VectorPlacements.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1RightRows public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -- [TABLET NODE: P5332T1VectorPlacements] diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2DomainRows.lean b/LeanPool/ApollonianSuperharmonic/P5352T2DomainRows.lean index 0a69c77d1c..2fd074a272 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2DomainRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2DomainRows.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction -public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows -- [TABLET NODE: P5352T2DomainRows] diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean b/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean index f72fe5a1d8..739828f9f9 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows -public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic -public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.P5352T2Sources -- [TABLET NODE: P5352T2FirstUnit] diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2LiteralNormalization.lean b/LeanPool/ApollonianSuperharmonic/P5352T2LiteralNormalization.lean index 0dd934ac55..173a99cdad 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2LiteralNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2LiteralNormalization.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2SourceCertificates public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2PlacementData.lean b/LeanPool/ApollonianSuperharmonic/P5352T2PlacementData.lean index 95a47293f9..93174595d9 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2PlacementData.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2PlacementData.lean @@ -5,7 +5,27 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P5352T2Sources +public import Mathlib.Init + +public import Mathlib.Analysis.SpecialFunctions.Pow.NNReal +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt +public import Mathlib.Tactic.Echelon.Zsqrtd +public import Mathlib.Tactic.Inclusion.Extension.Core.Core +public import Mathlib.Tactic.Inclusion.Extension.IntervalDyadicReal.Hypotheses +public import Mathlib.Tactic.Inclusion.Extension.IntervalDyadicReal.Rational +public import Mathlib.Tactic.Measurability.Init +public import Mathlib.Tactic.NormNum.Irrational +public import Mathlib.Tactic.NormNum.IsCoprime +public import Mathlib.Tactic.NormNum.IsSquare +public import Mathlib.Tactic.NormNum.LegendreSymbol +public import Mathlib.Tactic.NormNum.ModEq +public import Mathlib.Tactic.NormNum.NatFib +public import Mathlib.Tactic.NormNum.NatLog +public import Mathlib.Tactic.NormNum.NatSqrt +public import Mathlib.Tactic.NormNum.Ordinal +public import Mathlib.Tactic.NormNum.Parity +public import Mathlib.Tactic.NormNum.Prime +public import Mathlib.Tactic.NormNum.RealSqrt -- [TABLET NODE: P5352T2PlacementData] diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean index 6655652538..4f5d28041b 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows -public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable +public import LeanPool.ApollonianSuperharmonic.P5352T2Sources -- [TABLET NODE: P5352T2Predecessor0] @@ -865,7 +867,8 @@ theorem P5352T2Predecessor0 (K : DiamondParameter) (hk : 1 < K.1) have hdchild := (P5352T2DomainRows K z).1.mp hz have hdpred := (P5352T2DomainRows ⟨K.1-1, by omega⟩ (z-d)).1.mp hpz rcases z with ⟨p,q⟩ - simp? [d] at hdpred + simp only [Int.reduceNeg, Zsqrtd.im_sub, Int.sub_nonneg, tsub_le_iff_right, Zsqrtd.re_sub, + neg_le_sub_iff_le_add, neg_sub, neg_add_rev, neg_add_le_iff_le_add, d] at hdpred have hcast : (↑(K.1-1) : Int) = k-1 := by dsimp [k]; omega rw [hcast] at hdpred change (0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ -q-1 ≤ p ∧ p ≤ q+1 ∧ diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean index 01ecb14549..04dd70d480 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows -public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable +public import LeanPool.ApollonianSuperharmonic.P5352T2Sources -- [TABLET NODE: P5352T2Predecessor1] @@ -435,8 +437,7 @@ private theorem hPcenterQ : (by classical exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : - Int), + ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), let k : Int := K.1 let d : GaussianInt := ⟨k,k+1⟩ let pred := P5352T2Sources K hk 3 @@ -447,7 +448,7 @@ private theorem hPcenterQ : (p-k) : Int)=k-p), DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q (p-k) (k-p)))) := by classical - intro K hk f B k d pred p hcast hpz Q absP absPm absKm + intro K hk k d pred p hcast hpz Q absP absPm absKm have he : (⟨p,2*k+1-p⟩:GaussianInt)-d=⟨p-k,k-p⟩ := by ext <;> simp [d]; ring have hm : (⟨p-k,k-p⟩:GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1)) := by have hh := hpz @@ -455,65 +456,13 @@ private theorem hPcenterQ : simpa [pred,P5352T2Sources] using hh simpa [Q] using (P5352T2DomainRows ⟨K.1-1,by omega⟩ ⟨p-k,k-p⟩).2 hm -private theorem absKme : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : - Int), - let k : Int := K.1 - let d : GaussianInt := ⟨k,k+1⟩ - let child := P5352T2Sources K hk 0 - let pred := P5352T2Sources K hk 3 - ∀ (p : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), ∀ (hp1 : (1 : ℤ) ≤ p), ∀ - (hpk : p ≤ k), ∀ (hz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∈ FootprintVertices child.1), ∀ - (hpz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - d ∈ FootprintVertices pred.1), ∀ (hcover : ∀ - (y : GaussianInt), y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - - p⟩ + (1 : GaussianInt) ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - (1 : GaussianInt) ∨ y - = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - - p⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ FootprintVertices child.1 ∨ y - d ∈ FootprintVertices - pred.1), ∀ (hdpred : k < (2 : ℤ) * k + (1 : ℤ) - p ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : - ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ k ≤ p + (k - (1 : ℤ)) ∧ p ≤ k - (1 : ℤ) + k ∧ k - < p - k + (1 : ℤ) + ((2 : ℤ) * k + (1 : ℤ) - p) ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p - (k - + (1 : ℤ)) + (1 : ℤ) + k ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (1 : ℤ) + (p - k) + (2 : ℤ) * - (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ p ≤ (2 : ℤ) * (k - (1 : ℤ)) - ((2 : ℤ) * k + (1 : ℤ) - - p - (k + (1 : ℤ))) + (1 : ℤ) + k), ∀ (hdchild : (0 : ℤ) ≤ (2 : ℤ) * k + (1 : ℤ) - p - ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : ℤ) * k ∧ -k ≤ p ∧ p ≤ k ∧ -((2 : ℤ) * k + (1 : ℤ) - - p) - (1 : ℤ) ≤ p ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p + (1 : ℤ) ∧ -((2 : ℤ) * k - ((2 : - ℤ) * k + (1 : ℤ) - p) + (1 : ℤ)) ≤ p ∧ p ≤ (2 : ℤ) * k - ((2 : ℤ) * k + (1 : ℤ) - p) - + (1 : ℤ)), ∀ (hW : (⟨p-1,2*k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile - K.1)), ∀ (hS : (⟨p,2*k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)), ∀ - (hPe : (⟨p+1-k,k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ - (hPn : (⟨p-k,k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ - (hearg : (⟨p,2*k+1-p⟩:GaussianInt)+1-d=⟨p+1-k,k-p⟩), ∀ (hnarg : - (⟨p,2*k+1-p⟩:GaussianInt)+⟨0,1⟩-d=⟨p-k,k+1-p⟩), ∀ (hcenterC : f ⟨p,2*k+1-p⟩ = - DiamondOdometer K ⟨p,2*k+1-p⟩), ∀ (hWval : f (⟨p,2*k+1-p⟩-1)=DiamondOdometer K - (⟨p,2*k+1-p⟩-1)), ∀ (hSval : f (⟨p,2*k+1-p⟩-⟨0,1⟩)=DiamondOdometer K - (⟨p,2*k+1-p⟩-⟨0,1⟩)), ∀ (hPval : ∀ (y : GaussianInt), ∀ (w : GaussianInt), (y-d ∈ - FootprintVertices pred.1) → ((y-d=w) → (f y = DiamondOdometer (⟨K.1-1,by - omega⟩) w + k*y.re+B))), ∀ (hPcenter : f ⟨p,2*k+1-p⟩ = - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩ + k*p+B), ∀ (hPeval : f (⟨p,2*k+1-p⟩+1) = - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩ + k*(p+1)+B), ∀ (hPnval : f - (⟨p,2*k+1-p⟩+⟨0,1⟩) = - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩ + k*p+B), - let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 - ∀ (qc : DiamondOdometer K ⟨p,2*k+1-p⟩=Q p (2*k+1-p)), ∀ (qw : DiamondOdometer K - ⟨p-1,2*k+1-p⟩=Q (p-1) (2*k+1-p)), ∀ (qs : DiamondOdometer K ⟨p,2*k-p⟩=Q p (2*k-p)), ∀ - (qe : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩=Q (p+1-k) (k-p)), ∀ (qn : - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩=Q (p-k) (k+1-p)), ∀ (absP : - (Int.natAbs p : Int)=p), ∀ (absPm : (Int.natAbs (p-1) : Int)=p-1), ∀ (absKm : - (Int.natAbs (p-k) : Int)=k-p), (Q (p-k) (k-p)=(k-p)*(k-p-1)/2-(p-k)^2) → - ((DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q (p-k) (k-p)) → ((f ⟨p,2*k+1-p⟩=Q - (p-k) (k-p)+k*p+B) → ((Int.natAbs (p+1-k) : Int)=if p=k then 1 else k-p-1)))) := by - classical - intro K hk f B k d child pred p hcast hp1 hpk hz hpz hcover hdpred hdchild hW hS hPe hPn hearg - hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval Q qc qw qs qe qn absP absPm absKm - qpc hPcenterQ hPcval - by_cases hpk : p=k +private theorem absKme (p k : Int) (hpk : p ≤ k) : + (Int.natAbs (p + 1 - k) : Int) = if p = k then 1 else k - p - 1 := by + by_cases equal : p = k · subst p norm_num - · rw [Int.natCast_natAbs,abs_of_nonpos (by omega)] - simp [hpk] + · rw [Int.natCast_natAbs, abs_of_nonpos (by omega)] + simp [equal] omega private theorem hqvals : @@ -553,7 +502,7 @@ private theorem hqvals : · simp only [Q,absKme] by_cases hp : p=k · simp [hp] - · simp? [hp] + · simp only [hp, ↓reduceIte] rw [show (p+1-k)-(k-p)=2*(p-k)+1 by ring,sqOdd] congr 1; ring · simp only [Q,absKm] @@ -612,81 +561,24 @@ private theorem hsval : _ = DiamondOdometer K ⟨p,2*k-p⟩ := by rw [hscoord] _ = Q p (2*k-p) := qs -private theorem hEAt404 : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : - Int), - let k : Int := K.1 - let d : GaussianInt := ⟨k,k+1⟩ - let child := P5352T2Sources K hk 0 - let pred := P5352T2Sources K hk 3 - ∀ (p : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), ∀ (hp1 : (1 : ℤ) ≤ p), ∀ - (hpk : p ≤ k), ∀ (hz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∈ FootprintVertices child.1), ∀ - (hpz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - d ∈ FootprintVertices pred.1), ∀ (hcover : ∀ - (y : GaussianInt), y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - - p⟩ + (1 : GaussianInt) ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - (1 : GaussianInt) ∨ y - = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - - p⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ FootprintVertices child.1 ∨ y - d ∈ FootprintVertices - pred.1), ∀ (hdpred : k < (2 : ℤ) * k + (1 : ℤ) - p ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : - ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ k ≤ p + (k - (1 : ℤ)) ∧ p ≤ k - (1 : ℤ) + k ∧ k - < p - k + (1 : ℤ) + ((2 : ℤ) * k + (1 : ℤ) - p) ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p - (k - + (1 : ℤ)) + (1 : ℤ) + k ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (1 : ℤ) + (p - k) + (2 : ℤ) * - (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ p ≤ (2 : ℤ) * (k - (1 : ℤ)) - ((2 : ℤ) * k + (1 : ℤ) - - p - (k + (1 : ℤ))) + (1 : ℤ) + k), ∀ (hdchild : (0 : ℤ) ≤ (2 : ℤ) * k + (1 : ℤ) - p - ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : ℤ) * k ∧ -k ≤ p ∧ p ≤ k ∧ -((2 : ℤ) * k + (1 : ℤ) - - p) - (1 : ℤ) ≤ p ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p + (1 : ℤ) ∧ -((2 : ℤ) * k - ((2 : - ℤ) * k + (1 : ℤ) - p) + (1 : ℤ)) ≤ p ∧ p ≤ (2 : ℤ) * k - ((2 : ℤ) * k + (1 : ℤ) - p) - + (1 : ℤ)), ∀ (hW : (⟨p-1,2*k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile - K.1)), ∀ (hS : (⟨p,2*k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)), ∀ - (hPe : (⟨p+1-k,k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ - (hPn : (⟨p-k,k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ - (hearg : (⟨p,2*k+1-p⟩:GaussianInt)+1-d=⟨p+1-k,k-p⟩), ∀ (hnarg : - (⟨p,2*k+1-p⟩:GaussianInt)+⟨0,1⟩-d=⟨p-k,k+1-p⟩), ∀ (hcenterC : f ⟨p,2*k+1-p⟩ = - DiamondOdometer K ⟨p,2*k+1-p⟩), ∀ (hWval : f (⟨p,2*k+1-p⟩-1)=DiamondOdometer K - (⟨p,2*k+1-p⟩-1)), ∀ (hSval : f (⟨p,2*k+1-p⟩-⟨0,1⟩)=DiamondOdometer K - (⟨p,2*k+1-p⟩-⟨0,1⟩)), ∀ (hPval : ∀ (y : GaussianInt), ∀ (w : GaussianInt), (y-d ∈ - FootprintVertices pred.1) → ((y-d=w) → (f y = DiamondOdometer (⟨K.1-1,by - omega⟩) w + k*y.re+B))), ∀ (hPcenter : f ⟨p,2*k+1-p⟩ = - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩ + k*p+B), ∀ (hPeval : f (⟨p,2*k+1-p⟩+1) = - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩ + k*(p+1)+B), ∀ (hPnval : f - (⟨p,2*k+1-p⟩+⟨0,1⟩) = - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩ + k*p+B), - let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 - ∀ (qc : DiamondOdometer K ⟨p,2*k+1-p⟩=Q p (2*k+1-p)), ∀ (qw : DiamondOdometer K - ⟨p-1,2*k+1-p⟩=Q (p-1) (2*k+1-p)), ∀ (qs : DiamondOdometer K ⟨p,2*k-p⟩=Q p (2*k-p)), ∀ - (qe : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩=Q (p+1-k) (k-p)), ∀ (qn : - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩=Q (p-k) (k+1-p)), ∀ (tdiffRev : ∀ - (a : Int), (a-1)*(a-2)/2-a*(a-1)/2=1-a), ∀ (absP : (Int.natAbs p : Int)=p), ∀ - (absPm : (Int.natAbs (p-1) : Int)=p-1), ∀ (absKm : (Int.natAbs (p-k) : Int)=k-p), (Q - (p-k) (k-p)=(k-p)*(k-p-1)/2-(p-k)^2) → ((DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q - (p-k) (k-p)) → ((f ⟨p,2*k+1-p⟩=Q (p-k) (k-p)+k*p+B) → (((Int.natAbs (p+1-k) : Int)=if - p=k then 1 else k-p-1) → ((Q p ((2 : ℤ) * k + (1 : ℤ) - p) = p * (p - (1 : ℤ)) / (2 : - ℤ) - (p - k) * (p - k - (1 : ℤ))) → ((Q (p - (1 : ℤ)) ((2 : ℤ) * k + (1 : ℤ) - p) = - (p - (1 : ℤ)) * (p - (2 : ℤ)) / (2 : ℤ) - (p - k - (1 : ℤ)) ^ (2 : ℕ)) → ((Q p ((2 : - ℤ) * k - p) = p * (p - (1 : ℤ)) / (2 : ℤ) - (p - k) ^ (2 : ℕ)) → ((Q (p + (1 : ℤ) - - k) (k - p) = if p = k then (0 : ℤ) else (k - p - (1 : ℤ)) * (k - p - (2 : ℤ)) / (2 : - ℤ) - ((p - k) ^ (2 : ℕ) + (p - k))) → ((Q (p - k) (k + (1 : ℤ) - p) = (k - p) * (k - - p - (1 : ℤ)) / (2 : ℤ) - ((p - k - (1 : ℤ)) ^ (2 : ℕ) + (p - k - (1 : ℤ)))) → ((f - ⟨p,2*k+1-p⟩=Q p (2*k+1-p)) → (((⟨p,2*k+1-p⟩:GaussianInt)-1=⟨p-1,2*k+1-p⟩) → - (((⟨p,2*k+1-p⟩:GaussianInt)-⟨0,1⟩=⟨p,2*k-p⟩) → ((f (⟨p,2*k+1-p⟩-1)=Q (p-1) (2*k+1-p)) - → ((f (⟨p,2*k+1-p⟩-⟨0,1⟩)=Q p (2*k-p)) → ((f (⟨p,2*k+1-p⟩+1)=Q (p+1-k) - (k-p)+k*(p+1)+B) → ((f (⟨p,2*k+1-p⟩+⟨0,1⟩)=Q (p-k) (k+1-p)+k*p+B) → (f - (⟨p,2*k+1-p⟩+1)-f ⟨p,2*k+1-p⟩ = if p=k then k else k+1))))))))))))))))) := by - classical - intro K hk f B k d child pred p hcast hp1 hpk hz hpz hcover hdpred hdchild hW hS hPe hPn hearg - hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval Q qc qw qs qe qn tdiffRev absP - absPm absKm qpc hPcenterQ hPcval absKme hqc hqw hqs hqe hqn hcval hwcoord hscoord hwval - hsval heval hnval - rw [heval,hPcval,hqe,qpc] - by_cases hp : p=k +private theorem hEAt404 (p k B : Int) (f : IntegerLatticeFunction) + (Q : Int → Int → Int) + (triangular : ∀ a : Int, (a - 1) * (a - 2) / 2 - a * (a - 1) / 2 = 1 - a) + (east : f (⟨p, 2 * k + 1 - p⟩ + 1) = Q (p + 1 - k) (k - p) + k * (p + 1) + B) + (center : f ⟨p, 2 * k + 1 - p⟩ = Q (p - k) (k - p) + k * p + B) + (eastFormula : Q (p + 1 - k) (k - p) = if p = k then 0 else + (k - p - 1) * (k - p - 2) / 2 - ((p - k) ^ 2 + (p - k))) + (centerFormula : Q (p - k) (k - p) = (k - p) * (k - p - 1) / 2 - (p - k) ^ 2) : + f (⟨p, 2 * k + 1 - p⟩ + 1) - f ⟨p, 2 * k + 1 - p⟩ = + if p = k then k else k + 1 := by + rw [east, center, eastFormula, centerFormula] + by_cases equal : p = k · subst p simp ring - · simp only [ite_eq_right hp] - have ht := tdiffRev (k-p) - nlinarith only [ht] + · simp only [ite_eq_right equal] + have difference := triangular (k - p) + nlinarith only [difference] private theorem hWdiff : (by @@ -710,251 +602,50 @@ private theorem hWdiff : _ = (1-p)+(p-k-1) := by rw [tdiffRev p]; ring _ = -k := by ring -private theorem hNdiff : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : - Int), - let k : Int := K.1 - let d : GaussianInt := ⟨k,k+1⟩ - let child := P5352T2Sources K hk 0 - let pred := P5352T2Sources K hk 3 - ∀ (p : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), ∀ (hp1 : (1 : ℤ) ≤ p), ∀ - (hpk : p ≤ k), ∀ (hz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∈ FootprintVertices child.1), ∀ - (hpz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - d ∈ FootprintVertices pred.1), ∀ (hcover : ∀ - (y : GaussianInt), y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - - p⟩ + (1 : GaussianInt) ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - (1 : GaussianInt) ∨ y - = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - - p⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ FootprintVertices child.1 ∨ y - d ∈ FootprintVertices - pred.1), ∀ (hdpred : k < (2 : ℤ) * k + (1 : ℤ) - p ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : - ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ k ≤ p + (k - (1 : ℤ)) ∧ p ≤ k - (1 : ℤ) + k ∧ k - < p - k + (1 : ℤ) + ((2 : ℤ) * k + (1 : ℤ) - p) ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p - (k - + (1 : ℤ)) + (1 : ℤ) + k ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (1 : ℤ) + (p - k) + (2 : ℤ) * - (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ p ≤ (2 : ℤ) * (k - (1 : ℤ)) - ((2 : ℤ) * k + (1 : ℤ) - - p - (k + (1 : ℤ))) + (1 : ℤ) + k), ∀ (hdchild : (0 : ℤ) ≤ (2 : ℤ) * k + (1 : ℤ) - p - ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : ℤ) * k ∧ -k ≤ p ∧ p ≤ k ∧ -((2 : ℤ) * k + (1 : ℤ) - - p) - (1 : ℤ) ≤ p ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p + (1 : ℤ) ∧ -((2 : ℤ) * k - ((2 : - ℤ) * k + (1 : ℤ) - p) + (1 : ℤ)) ≤ p ∧ p ≤ (2 : ℤ) * k - ((2 : ℤ) * k + (1 : ℤ) - p) - + (1 : ℤ)), ∀ (hW : (⟨p-1,2*k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile - K.1)), ∀ (hS : (⟨p,2*k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)), ∀ - (hPe : (⟨p+1-k,k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ - (hPn : (⟨p-k,k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ - (hearg : (⟨p,2*k+1-p⟩:GaussianInt)+1-d=⟨p+1-k,k-p⟩), ∀ (hnarg : - (⟨p,2*k+1-p⟩:GaussianInt)+⟨0,1⟩-d=⟨p-k,k+1-p⟩), ∀ (hcenterC : f ⟨p,2*k+1-p⟩ = - DiamondOdometer K ⟨p,2*k+1-p⟩), ∀ (hWval : f (⟨p,2*k+1-p⟩-1)=DiamondOdometer K - (⟨p,2*k+1-p⟩-1)), ∀ (hSval : f (⟨p,2*k+1-p⟩-⟨0,1⟩)=DiamondOdometer K - (⟨p,2*k+1-p⟩-⟨0,1⟩)), ∀ (hPval : ∀ (y : GaussianInt), ∀ (w : GaussianInt), (y-d ∈ - FootprintVertices pred.1) → ((y-d=w) → (f y = DiamondOdometer (⟨K.1-1,by - omega⟩) w + k*y.re+B))), ∀ (hPcenter : f ⟨p,2*k+1-p⟩ = - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩ + k*p+B), ∀ (hPeval : f (⟨p,2*k+1-p⟩+1) = - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩ + k*(p+1)+B), ∀ (hPnval : f - (⟨p,2*k+1-p⟩+⟨0,1⟩) = - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩ + k*p+B), - let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 - ∀ (qc : DiamondOdometer K ⟨p,2*k+1-p⟩=Q p (2*k+1-p)), ∀ (qw : DiamondOdometer K - ⟨p-1,2*k+1-p⟩=Q (p-1) (2*k+1-p)), ∀ (qs : DiamondOdometer K ⟨p,2*k-p⟩=Q p (2*k-p)), ∀ - (qe : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩=Q (p+1-k) (k-p)), ∀ (qn : - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩=Q (p-k) (k+1-p)), ∀ (absP : - (Int.natAbs p : Int)=p), ∀ (absPm : (Int.natAbs (p-1) : Int)=p-1), ∀ (absKm : - (Int.natAbs (p-k) : Int)=k-p), (Q (p-k) (k-p)=(k-p)*(k-p-1)/2-(p-k)^2) → - ((DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q (p-k) (k-p)) → ((f ⟨p,2*k+1-p⟩=Q - (p-k) (k-p)+k*p+B) → (((Int.natAbs (p+1-k) : Int)=if p=k then 1 else k-p-1) → ((Q p - ((2 : ℤ) * k + (1 : ℤ) - p) = p * (p - (1 : ℤ)) / (2 : ℤ) - (p - k) * (p - k - (1 : - ℤ))) → ((Q (p - (1 : ℤ)) ((2 : ℤ) * k + (1 : ℤ) - p) = (p - (1 : ℤ)) * (p - (2 : ℤ)) - / (2 : ℤ) - (p - k - (1 : ℤ)) ^ (2 : ℕ)) → ((Q p ((2 : ℤ) * k - p) = p * (p - (1 : - ℤ)) / (2 : ℤ) - (p - k) ^ (2 : ℕ)) → ((Q (p + (1 : ℤ) - k) (k - p) = if p = k then (0 - : ℤ) else (k - p - (1 : ℤ)) * (k - p - (2 : ℤ)) / (2 : ℤ) - ((p - k) ^ (2 : ℕ) + (p - - k))) → ((Q (p - k) (k + (1 : ℤ) - p) = (k - p) * (k - p - (1 : ℤ)) / (2 : ℤ) - ((p - - k - (1 : ℤ)) ^ (2 : ℕ) + (p - k - (1 : ℤ)))) → ((f ⟨p,2*k+1-p⟩=Q p (2*k+1-p)) → - (((⟨p,2*k+1-p⟩:GaussianInt)-1=⟨p-1,2*k+1-p⟩) → - (((⟨p,2*k+1-p⟩:GaussianInt)-⟨0,1⟩=⟨p,2*k-p⟩) → ((f (⟨p,2*k+1-p⟩-1)=Q (p-1) (2*k+1-p)) - → ((f (⟨p,2*k+1-p⟩-⟨0,1⟩)=Q p (2*k-p)) → ((f (⟨p,2*k+1-p⟩+1)=Q (p+1-k) - (k-p)+k*(p+1)+B) → ((f (⟨p,2*k+1-p⟩+⟨0,1⟩)=Q (p-k) (k+1-p)+k*p+B) → ((f - (⟨p,2*k+1-p⟩+1)-f ⟨p,2*k+1-p⟩ = if p=k then k else k+1) → ((f (⟨p,2*k+1-p⟩-1)-f - ⟨p,2*k+1-p⟩ = -k) → (f (⟨p,2*k+1-p⟩+⟨0,1⟩)-f ⟨p,2*k+1-p⟩ = if p=k then 0 else - p-k))))))))))))))))))) := by - classical - intro K hk f B k d child pred p hcast hp1 hpk hz hpz hcover hdpred hdchild hW hS hPe hPn hearg - hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval Q qc qw qs qe qn absP absPm absKm - qpc hPcenterQ hPcval absKme hqc hqw hqs hqe hqn hcval hwcoord hscoord hwval hsval heval - hnval hE hWdiff - rw [hnval,hPcval,hqn,qpc] - by_cases hp : p=k +private theorem hNdiff (p k B : Int) (f : IntegerLatticeFunction) + (Q : Int → Int → Int) + (north : f (⟨p, 2 * k + 1 - p⟩ + ⟨0, 1⟩) = Q (p - k) (k + 1 - p) + k * p + B) + (center : f ⟨p, 2 * k + 1 - p⟩ = Q (p - k) (k - p) + k * p + B) + (northFormula : Q (p - k) (k + 1 - p) = + (k - p) * (k - p - 1) / 2 - ((p - k - 1) ^ 2 + (p - k - 1))) + (centerFormula : Q (p - k) (k - p) = (k - p) * (k - p - 1) / 2 - (p - k) ^ 2) : + f (⟨p, 2 * k + 1 - p⟩ + ⟨0, 1⟩) - f ⟨p, 2 * k + 1 - p⟩ = + if p = k then 0 else p - k := by + rw [north, center, northFormula, centerFormula] + by_cases equal : p = k · subst p simp - · simp only [ite_eq_right hp] + · simp only [ite_eq_right equal] ring -private theorem hSdiff : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : - Int), - let k : Int := K.1 - let d : GaussianInt := ⟨k,k+1⟩ - let child := P5352T2Sources K hk 0 - let pred := P5352T2Sources K hk 3 - ∀ (p : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), ∀ (hp1 : (1 : ℤ) ≤ p), ∀ - (hpk : p ≤ k), ∀ (hz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∈ FootprintVertices child.1), ∀ - (hpz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - d ∈ FootprintVertices pred.1), ∀ (hcover : ∀ - (y : GaussianInt), y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - - p⟩ + (1 : GaussianInt) ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - (1 : GaussianInt) ∨ y - = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - - p⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ FootprintVertices child.1 ∨ y - d ∈ FootprintVertices - pred.1), ∀ (hdpred : k < (2 : ℤ) * k + (1 : ℤ) - p ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : - ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ k ≤ p + (k - (1 : ℤ)) ∧ p ≤ k - (1 : ℤ) + k ∧ k - < p - k + (1 : ℤ) + ((2 : ℤ) * k + (1 : ℤ) - p) ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p - (k - + (1 : ℤ)) + (1 : ℤ) + k ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (1 : ℤ) + (p - k) + (2 : ℤ) * - (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ p ≤ (2 : ℤ) * (k - (1 : ℤ)) - ((2 : ℤ) * k + (1 : ℤ) - - p - (k + (1 : ℤ))) + (1 : ℤ) + k), ∀ (hdchild : (0 : ℤ) ≤ (2 : ℤ) * k + (1 : ℤ) - p - ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : ℤ) * k ∧ -k ≤ p ∧ p ≤ k ∧ -((2 : ℤ) * k + (1 : ℤ) - - p) - (1 : ℤ) ≤ p ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p + (1 : ℤ) ∧ -((2 : ℤ) * k - ((2 : - ℤ) * k + (1 : ℤ) - p) + (1 : ℤ)) ≤ p ∧ p ≤ (2 : ℤ) * k - ((2 : ℤ) * k + (1 : ℤ) - p) - + (1 : ℤ)), ∀ (hW : (⟨p-1,2*k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile - K.1)), ∀ (hS : (⟨p,2*k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)), ∀ - (hPe : (⟨p+1-k,k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ - (hPn : (⟨p-k,k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ - (hearg : (⟨p,2*k+1-p⟩:GaussianInt)+1-d=⟨p+1-k,k-p⟩), ∀ (hnarg : - (⟨p,2*k+1-p⟩:GaussianInt)+⟨0,1⟩-d=⟨p-k,k+1-p⟩), ∀ (hcenterC : f ⟨p,2*k+1-p⟩ = - DiamondOdometer K ⟨p,2*k+1-p⟩), ∀ (hWval : f (⟨p,2*k+1-p⟩-1)=DiamondOdometer K - (⟨p,2*k+1-p⟩-1)), ∀ (hSval : f (⟨p,2*k+1-p⟩-⟨0,1⟩)=DiamondOdometer K - (⟨p,2*k+1-p⟩-⟨0,1⟩)), ∀ (hPval : ∀ (y : GaussianInt), ∀ (w : GaussianInt), (y-d ∈ - FootprintVertices pred.1) → ((y-d=w) → (f y = DiamondOdometer (⟨K.1-1,by - omega⟩) w + k*y.re+B))), ∀ (hPcenter : f ⟨p,2*k+1-p⟩ = - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩ + k*p+B), ∀ (hPeval : f (⟨p,2*k+1-p⟩+1) = - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩ + k*(p+1)+B), ∀ (hPnval : f - (⟨p,2*k+1-p⟩+⟨0,1⟩) = - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩ + k*p+B), - let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 - ∀ (qc : DiamondOdometer K ⟨p,2*k+1-p⟩=Q p (2*k+1-p)), ∀ (qw : DiamondOdometer K - ⟨p-1,2*k+1-p⟩=Q (p-1) (2*k+1-p)), ∀ (qs : DiamondOdometer K ⟨p,2*k-p⟩=Q p (2*k-p)), ∀ - (qe : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩=Q (p+1-k) (k-p)), ∀ (qn : - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩=Q (p-k) (k+1-p)), ∀ (absP : - (Int.natAbs p : Int)=p), ∀ (absPm : (Int.natAbs (p-1) : Int)=p-1), ∀ (absKm : - (Int.natAbs (p-k) : Int)=k-p), (Q (p-k) (k-p)=(k-p)*(k-p-1)/2-(p-k)^2) → - ((DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q (p-k) (k-p)) → ((f ⟨p,2*k+1-p⟩=Q - (p-k) (k-p)+k*p+B) → (((Int.natAbs (p+1-k) : Int)=if p=k then 1 else k-p-1) → ((Q p - ((2 : ℤ) * k + (1 : ℤ) - p) = p * (p - (1 : ℤ)) / (2 : ℤ) - (p - k) * (p - k - (1 : - ℤ))) → ((Q (p - (1 : ℤ)) ((2 : ℤ) * k + (1 : ℤ) - p) = (p - (1 : ℤ)) * (p - (2 : ℤ)) - / (2 : ℤ) - (p - k - (1 : ℤ)) ^ (2 : ℕ)) → ((Q p ((2 : ℤ) * k - p) = p * (p - (1 : - ℤ)) / (2 : ℤ) - (p - k) ^ (2 : ℕ)) → ((Q (p + (1 : ℤ) - k) (k - p) = if p = k then (0 - : ℤ) else (k - p - (1 : ℤ)) * (k - p - (2 : ℤ)) / (2 : ℤ) - ((p - k) ^ (2 : ℕ) + (p - - k))) → ((Q (p - k) (k + (1 : ℤ) - p) = (k - p) * (k - p - (1 : ℤ)) / (2 : ℤ) - ((p - - k - (1 : ℤ)) ^ (2 : ℕ) + (p - k - (1 : ℤ)))) → ((f ⟨p,2*k+1-p⟩=Q p (2*k+1-p)) → - (((⟨p,2*k+1-p⟩:GaussianInt)-1=⟨p-1,2*k+1-p⟩) → - (((⟨p,2*k+1-p⟩:GaussianInt)-⟨0,1⟩=⟨p,2*k-p⟩) → ((f (⟨p,2*k+1-p⟩-1)=Q (p-1) (2*k+1-p)) - → ((f (⟨p,2*k+1-p⟩-⟨0,1⟩)=Q p (2*k-p)) → ((f (⟨p,2*k+1-p⟩+1)=Q (p+1-k) - (k-p)+k*(p+1)+B) → ((f (⟨p,2*k+1-p⟩+⟨0,1⟩)=Q (p-k) (k+1-p)+k*p+B) → ((f - (⟨p,2*k+1-p⟩+1)-f ⟨p,2*k+1-p⟩ = if p=k then k else k+1) → ((f (⟨p,2*k+1-p⟩-1)-f - ⟨p,2*k+1-p⟩ = -k) → ((f (⟨p,2*k+1-p⟩+⟨0,1⟩)-f ⟨p,2*k+1-p⟩ = if p=k then 0 else p-k) → - (f (⟨p,2*k+1-p⟩-⟨0,1⟩)-f ⟨p,2*k+1-p⟩ = if p=k then 0 else k-p)))))))))))))))))))) := by - classical - intro K hk f B k d child pred p hcast hp1 hpk hz hpz hcover hdpred hdchild hW hS hPe hPn hearg - hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval Q qc qw qs qe qn absP absPm absKm - qpc hPcenterQ hPcval absKme hqc hqw hqs hqe hqn hcval hwcoord hscoord hwval hsval heval - hnval hE hWdiff hNdiff - rw [hsval,hcval,hqs,hqc] - by_cases hp : p=k +private theorem hSdiff (p k : Int) (f : IntegerLatticeFunction) + (Q : Int → Int → Int) + (south : f (⟨p, 2 * k + 1 - p⟩ - ⟨0, 1⟩) = Q p (2 * k - p)) + (center : f ⟨p, 2 * k + 1 - p⟩ = Q p (2 * k + 1 - p)) + (southFormula : Q p (2 * k - p) = p * (p - 1) / 2 - (p - k) ^ 2) + (centerFormula : Q p (2 * k + 1 - p) = p * (p - 1) / 2 - (p - k) * (p - k - 1)) : + f (⟨p, 2 * k + 1 - p⟩ - ⟨0, 1⟩) - f ⟨p, 2 * k + 1 - p⟩ = + if p = k then 0 else k - p := by + rw [south, center, southFormula, centerFormula] + by_cases equal : p = k · subst p simp - · simp only [ite_eq_right hp] + · simp only [ite_eq_right equal] ring -private theorem hcompAt434 : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : - Int), - let k : Int := K.1 - let d : GaussianInt := ⟨k,k+1⟩ - let r : GaussianInt := ⟨2*k,0⟩ - let child := P5352T2Sources K hk 0 - let pred := P5352T2Sources K hk 3 - ∀ (hchildTile : child.1 = DiamondTile K.1), ∀ (p : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) - = k - (1 : ℤ)), ∀ (hp1 : (1 : ℤ) ≤ p), ∀ (hpk : p ≤ k), ∀ (childMem : ∀ (a : Int), ∀ - (b : Int), (0≤b) → ((b≤2*k) → ((-k≤a) → ((a≤k) → ((-b-1≤a) → ((a≤b+1) → - ((-(2*k-b+1)≤a) → ((a≤2*k-b+1) → ((⟨a,b⟩ : GaussianInt) ∈ FootprintVertices - (DiamondTile K.1)))))))))), ∀ (hz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ ∈ - FootprintVertices child.1), ∀ (hpz : ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - d ∈ - FootprintVertices pred.1), ∀ (hcover : ∀ (y : GaussianInt), y = ⟨p, (2 : ℤ) * k + (1 - : ℤ) - p⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ + (1 : GaussianInt) ∨ y = ⟨p, (2 : ℤ) - * k + (1 : ℤ) - p⟩ - (1 : GaussianInt) ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ + ⟨(0 : - ℤ), (1 : ℤ)⟩ ∨ y = ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ - FootprintVertices child.1 ∨ y - d ∈ FootprintVertices pred.1), ∀ (hdpred : k < (2 : - ℤ) * k + (1 : ℤ) - p ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 - : ℤ)) ∧ k ≤ p + (k - (1 : ℤ)) ∧ p ≤ k - (1 : ℤ) + k ∧ k < p - k + (1 : ℤ) + ((2 : ℤ) - * k + (1 : ℤ) - p) ∧ p ≤ (2 : ℤ) * k + (1 : ℤ) - p - (k + (1 : ℤ)) + (1 : ℤ) + k ∧ (2 - : ℤ) * k + (1 : ℤ) - p ≤ (1 : ℤ) + (p - k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) - ∧ p ≤ (2 : ℤ) * (k - (1 : ℤ)) - ((2 : ℤ) * k + (1 : ℤ) - p - (k + (1 : ℤ))) + (1 : ℤ) - + k), ∀ (hdchild : (0 : ℤ) ≤ (2 : ℤ) * k + (1 : ℤ) - p ∧ (2 : ℤ) * k + (1 : ℤ) - p ≤ - (2 : ℤ) * k ∧ -k ≤ p ∧ p ≤ k ∧ -((2 : ℤ) * k + (1 : ℤ) - p) - (1 : ℤ) ≤ p ∧ p ≤ (2 : - ℤ) * k + (1 : ℤ) - p + (1 : ℤ) ∧ -((2 : ℤ) * k - ((2 : ℤ) * k + (1 : ℤ) - p) + (1 : - ℤ)) ≤ p ∧ p ≤ (2 : ℤ) * k - ((2 : ℤ) * k + (1 : ℤ) - p) + (1 : ℤ)), ∀ (hW : - (⟨p-1,2*k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)), ∀ (hS : - (⟨p,2*k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)), ∀ (hPe : - (⟨p+1-k,k-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ (hPn : - (⟨p-k,k+1-p⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1))), ∀ (hearg - : (⟨p,2*k+1-p⟩:GaussianInt)+1-d=⟨p+1-k,k-p⟩), ∀ (hnarg : - (⟨p,2*k+1-p⟩:GaussianInt)+⟨0,1⟩-d=⟨p-k,k+1-p⟩), ∀ (hcenterC : f ⟨p,2*k+1-p⟩ = - DiamondOdometer K ⟨p,2*k+1-p⟩), ∀ (hWval : f (⟨p,2*k+1-p⟩-1)=DiamondOdometer K - (⟨p,2*k+1-p⟩-1)), ∀ (hSval : f (⟨p,2*k+1-p⟩-⟨0,1⟩)=DiamondOdometer K - (⟨p,2*k+1-p⟩-⟨0,1⟩)), ∀ (hPval : ∀ (y : GaussianInt), ∀ (w : GaussianInt), (y-d ∈ - FootprintVertices pred.1) → ((y-d=w) → (f y = DiamondOdometer (⟨K.1-1,by - omega⟩) w + k*y.re+B))), ∀ (hPcenter : f ⟨p,2*k+1-p⟩ = - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩ + k*p+B), ∀ (hPeval : f (⟨p,2*k+1-p⟩+1) = - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩ + k*(p+1)+B), ∀ (hPnval : f - (⟨p,2*k+1-p⟩+⟨0,1⟩) = - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩ + k*p+B), - let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 - ∀ (qc : DiamondOdometer K ⟨p,2*k+1-p⟩=Q p (2*k+1-p)), ∀ (qw : DiamondOdometer K - ⟨p-1,2*k+1-p⟩=Q (p-1) (2*k+1-p)), ∀ (qs : DiamondOdometer K ⟨p,2*k-p⟩=Q p (2*k-p)), ∀ - (qe : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p+1-k,k-p⟩=Q (p+1-k) (k-p)), ∀ (qn : - DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩=Q (p-k) (k+1-p)), ∀ (absP : - (Int.natAbs p : Int)=p), ∀ (absPm : (Int.natAbs (p-1) : Int)=p-1), ∀ (absKm : - (Int.natAbs (p-k) : Int)=k-p), (Q (p-k) (k-p)=(k-p)*(k-p-1)/2-(p-k)^2) → - ((DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q (p-k) (k-p)) → ((f ⟨p,2*k+1-p⟩=Q - (p-k) (k-p)+k*p+B) → (((Int.natAbs (p+1-k) : Int)=if p=k then 1 else k-p-1) → ((Q p - ((2 : ℤ) * k + (1 : ℤ) - p) = p * (p - (1 : ℤ)) / (2 : ℤ) - (p - k) * (p - k - (1 : - ℤ))) → ((Q (p - (1 : ℤ)) ((2 : ℤ) * k + (1 : ℤ) - p) = (p - (1 : ℤ)) * (p - (2 : ℤ)) - / (2 : ℤ) - (p - k - (1 : ℤ)) ^ (2 : ℕ)) → ((Q p ((2 : ℤ) * k - p) = p * (p - (1 : - ℤ)) / (2 : ℤ) - (p - k) ^ (2 : ℕ)) → ((Q (p + (1 : ℤ) - k) (k - p) = if p = k then (0 - : ℤ) else (k - p - (1 : ℤ)) * (k - p - (2 : ℤ)) / (2 : ℤ) - ((p - k) ^ (2 : ℕ) + (p - - k))) → ((Q (p - k) (k + (1 : ℤ) - p) = (k - p) * (k - p - (1 : ℤ)) / (2 : ℤ) - ((p - - k - (1 : ℤ)) ^ (2 : ℕ) + (p - k - (1 : ℤ)))) → ((f ⟨p,2*k+1-p⟩=Q p (2*k+1-p)) → - (((⟨p,2*k+1-p⟩:GaussianInt)-1=⟨p-1,2*k+1-p⟩) → - (((⟨p,2*k+1-p⟩:GaussianInt)-⟨0,1⟩=⟨p,2*k-p⟩) → ((f (⟨p,2*k+1-p⟩-1)=Q (p-1) (2*k+1-p)) - → ((f (⟨p,2*k+1-p⟩-⟨0,1⟩)=Q p (2*k-p)) → ((f (⟨p,2*k+1-p⟩+1)=Q (p+1-k) - (k-p)+k*(p+1)+B) → ((f (⟨p,2*k+1-p⟩+⟨0,1⟩)=Q (p-k) (k+1-p)+k*p+B) → ((f - (⟨p,2*k+1-p⟩+1)-f ⟨p,2*k+1-p⟩ = if p=k then k else k+1) → ((f (⟨p,2*k+1-p⟩-1)-f - ⟨p,2*k+1-p⟩ = -k) → ((f (⟨p,2*k+1-p⟩+⟨0,1⟩)-f ⟨p,2*k+1-p⟩ = if p=k then 0 else p-k) → - ((f (⟨p,2*k+1-p⟩-⟨0,1⟩)-f ⟨p,2*k+1-p⟩ = if p=k then 0 else k-p) → - ((⟨p,2*k+1-p⟩:GaussianInt)-r ∈ FootprintVertices child.1 ↔ p=k))))))))))))))))))))) - := by - classical - intro K hk f B k d r child pred hchildTile p hcast hp1 hpk childMem hz hpz hcover hdpred - hdchild hW hS hPe hPn hearg hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval Q qc qw - qs qe qn absP absPm absKm qpc hPcenterQ hPcval absKme hqc hqw hqs hqe hqn hcval hwcoord - hscoord hwval hsval heval hnval hE hWdiff hNdiff hSdiff +private theorem hcompAt434 (K : DiamondParameter) (hk : 1 < K.1) (p : Int) + (upper : p ≤ (K.1 : Int)) : + (⟨p, 2 * (K.1 : Int) + 1 - p⟩ : GaussianInt) - ⟨2 * (K.1 : Int), 0⟩ ∈ + FootprintVertices (DiamondTile K.1) ↔ p = (K.1 : Int) := by + have positive : 2 ≤ (K.1 : Int) := by exact_mod_cast (show 2 ≤ K.1 by omega) + rw [(P5352T2DomainRows K _).1] + simp only [Zsqrtd.im_sub, Zsqrtd.re_sub, sub_zero] constructor - · intro hh - have hb := (P5352T2DomainRows K ((⟨p,2*k+1-p⟩:GaussianInt)-r)).1.mp (hchildTile ▸ hh) - simp [r] at hb + · intro bounds omega - · intro hp + · intro equal subst p - have he : (⟨k,k+1⟩:GaussianInt)-r=⟨-k,k+1⟩ := by ext <;> simp [r]; ring - have hc : (⟨k,2*k+1-k⟩:GaussianInt)=⟨k,k+1⟩ := by ext <;> simp; omega - have heFull : (⟨k,2*k+1-k⟩:GaussianInt)-r=⟨-k,k+1⟩ := by rw [hc,he] - have hm := childMem (-k) (k+1) (by omega) (by omega) (by omega) (by omega) - (by omega) (by omega) (by omega) (by omega) - have hm' : (⟨-k,k+1⟩:GaussianInt) ∈ FootprintVertices child.1 := by - rw [hchildTile] - exact hm - rw [heFull] - exact hm' + omega private theorem hlap0 : (by @@ -1038,7 +729,9 @@ theorem P5352T2Predecessor1 (K : DiamondParameter) (hk : 1 < K.1) have hdchild := (P5352T2DomainRows K z).1.mp hz have hdpred := (P5352T2DomainRows ⟨K.1-1,by omega⟩ (z-d)).1.mp hpz rcases z with ⟨p,q⟩ - simp? [d] at hdpred + simp only [Int.reduceNeg, Zsqrtd.im_sub, Int.sub_nonneg, Order.add_one_le_iff, + tsub_le_iff_right, Zsqrtd.re_sub, neg_le_sub_iff_le_add, neg_sub, neg_add_rev, + neg_add_le_iff_le_add, d] at hdpred have hcast : ((K.1-1 : Nat) : Int)=k-1 := by dsimp [k]; omega rw [hcast] at hdpred change (0≤q ∧ q≤2*k ∧ -k≤p ∧ p≤k ∧ -q-1≤p ∧ p≤q+1 ∧ @@ -1143,13 +836,10 @@ theorem P5352T2Predecessor1 (K : DiamondParameter) (hk : 1 < K.1) rw [Int.natCast_natAbs,abs_of_nonpos (by omega)]; omega have qpc := FirstPredecessorProof.qpc K p sqEven absKm have hPcenterQ : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q (p-k) (k-p) := - FirstPredecessorProof.hPcenterQ K hk f B p hcast hpz absP absPm absKm + FirstPredecessorProof.hPcenterQ K hk p hcast hpz absP absPm absKm have hPcval : f ⟨p,2*k+1-p⟩=Q (p-k) (k-p)+k*p+B := by rw [hPcenter,hPcenterQ] - have absKme := FirstPredecessorProof.absKme K hk f B p hcast hp1 hpk hz hpz hcover hdpred - hdchild hW - hS hPe hPn hearg hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval qc qw qs qe qn - absP absPm absKm qpc hPcenterQ hPcval + have absKme := FirstPredecessorProof.absKme p k hpk have hqvals := FirstPredecessorProof.hqvals K p sqEven sqOdd absP absPm absKm absKme rcases hqvals with ⟨hqc,hqw,hqs,hqe,hqn⟩ @@ -1162,28 +852,13 @@ theorem P5352T2Predecessor1 (K : DiamondParameter) (hk : 1 < K.1) qs hscoord have heval : f (⟨p,2*k+1-p⟩+1)=Q (p+1-k) (k-p)+k*(p+1)+B := by simpa [qe] using hPeval have hnval : f (⟨p,2*k+1-p⟩+⟨0,1⟩)=Q (p-k) (k+1-p)+k*p+B := by simpa [qn] using hPnval - have hE := FirstPredecessorProof.hEAt404 K hk f B p hcast hp1 hpk hz hpz hcover hdpred - hdchild hW - hS hPe hPn hearg hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval qc qw qs qe qn - tdiffRev absP absPm absKm qpc hPcenterQ hPcval absKme hqc hqw hqs hqe hqn hcval hwcoord - hscoord hwval hsval heval hnval + have hE := FirstPredecessorProof.hEAt404 p k B f Q tdiffRev heval hPcval hqe qpc have hWdiff := FirstPredecessorProof.hWdiff K f p tdiffRev hqc hqw hcval hwval - have hNdiff := FirstPredecessorProof.hNdiff K hk f B p hcast hp1 hpk hz hpz hcover hdpred - hdchild hW - hS hPe hPn hearg hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval qc qw qs qe qn - absP absPm absKm qpc hPcenterQ hPcval absKme hqc hqw hqs hqe hqn hcval hwcoord hscoord - hwval hsval heval hnval hE hWdiff - have hSdiff := FirstPredecessorProof.hSdiff K hk f B p hcast hp1 hpk hz hpz hcover hdpred - hdchild hW - hS hPe hPn hearg hnarg hcenterC hWval hSval hPval hPcenter hPeval hPnval qc qw qs qe qn - absP absPm absKm qpc hPcenterQ hPcval absKme hqc hqw hqs hqe hqn hcval hwcoord hscoord - hwval hsval heval hnval hE hWdiff hNdiff - have hcomp := FirstPredecessorProof.hcompAt434 K hk f B hchildTile p hcast hp1 hpk childMem - hz hpz - hcover hdpred hdchild hW hS hPe hPn hearg hnarg hcenterC hWval hSval hPval hPcenter - hPeval hPnval qc qw qs qe qn absP absPm absKm qpc hPcenterQ hPcval absKme hqc hqw hqs - hqe hqn hcval hwcoord hscoord hwval hsval heval hnval hE hWdiff hNdiff hSdiff + have hNdiff := FirstPredecessorProof.hNdiff p k B f Q hnval hPcval hqn qpc + have hSdiff := FirstPredecessorProof.hSdiff p k f Q hsval hcval hqs hqc + have hcomp := (by + simpa only [hchildTile] using FirstPredecessorProof.hcompAt434 K hk p hpk) have hlap0 (hp : p=k) := FirstPredecessorProof.hlap0 K f lap_identity p hE hWdiff hNdiff hSdiff hp have hlap1 (hp : p≠k) := FirstPredecessorProof.hlap1 K f lap_identity p hE hWdiff hNdiff diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean index d4c4a5f0fd..fc17c960cd 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows -public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable +public import LeanPool.ApollonianSuperharmonic.P5352T2Sources -- [TABLET NODE: P5352T2Predecessor2] @@ -984,7 +986,9 @@ theorem P5352T2Predecessor2 (K : DiamondParameter) (hk : 1 < K.1) have hdchild := (P5352T2DomainRows K z).1.mp hz have hdpred := (P5352T2DomainRows ⟨K.1-1,by omega⟩ (z-d)).1.mp hpz rcases z with ⟨a,b⟩ - simp? [d] at hdpred + simp only [Int.reduceNeg, Zsqrtd.im_sub, Int.sub_nonneg, Order.add_one_le_iff, + tsub_le_iff_right, Zsqrtd.re_sub, sub_neg_eq_add, neg_sub, neg_add_rev, + neg_add_le_iff_le_add, d] at hdpred have hcast : ((K.1-1 : Nat) : Int)=k-1 := by dsimp [k]; omega rw [hcast] at hdpred change (0≤b ∧ b≤2*k ∧ -k≤a ∧ a≤k ∧ -b-1≤a ∧ a≤b+1 ∧ diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean index ac9f632ec6..7a2fddb6be 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows -public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable +public import LeanPool.ApollonianSuperharmonic.P5352T2Sources -- [TABLET NODE: P5352T2Predecessor3] @@ -561,7 +563,8 @@ private theorem qPredWeq : simp only [Q, Int.natCast_natAbs] have ha : k-k-1 = (-1 : Int) := by omega rw [ha] - simp? + simp only [Int.reduceNeg, abs_neg, abs_one, sub_self, mul_zero, EuclideanDomain.zero_div, + zero_sub, neg_sub] rw [show (-1:Int)-(k+k-2)=1-2*k by ring, floorOdd] norm_num ring diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2RightFirst.lean b/LeanPool/ApollonianSuperharmonic/P5352T2RightFirst.lean index bd807f0325..836441f358 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2RightFirst.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2RightFirst.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows -public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic -public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.P5352T2Sources -- [TABLET NODE: P5352T2RightFirst] diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean b/LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean index b7b22d096c..3dcde8e711 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows -public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic -public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.P5352T2Sources -- [TABLET NODE: P5352T2RightHorizontal] diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean b/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean index 8c7d0396b2..0ec621323e 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows -public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic -public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.P5352T2Sources -- [TABLET NODE: P5352T2RightSecond] diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2SecondUnit.lean b/LeanPool/ApollonianSuperharmonic/P5352T2SecondUnit.lean index c8628acfaf..fa3ea6e48b 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2SecondUnit.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2SecondUnit.lean @@ -5,12 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData -public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows -public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic -public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable public import LeanPool.ApollonianSuperharmonic.P5416T1SecondUnitGeometry public import LeanPool.ApollonianSuperharmonic.P5416T1DiamondAxialDifferences +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -- [TABLET NODE: P5352T2SecondUnit] diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2SourceCertificates.lean b/LeanPool/ApollonianSuperharmonic/P5352T2SourceCertificates.lean index 9847c8381e..5ea8bce1f1 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2SourceCertificates.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2SourceCertificates.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2Sources -public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCentroid +public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: P5352T2SourceCertificates] diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Sources.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Sources.lean index e5cbf47989..959336cd0a 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Sources.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Sources.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer +public import LeanPool.ApollonianSuperharmonic.DiamondOdometer +public import LeanPool.ApollonianSuperharmonic.DiamondTile -- [TABLET NODE: P5352T2Sources] diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2VectorPlacements.lean b/LeanPool/ApollonianSuperharmonic/P5352T2VectorPlacements.lean index 2be6af55aa..14065a8f08 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2VectorPlacements.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2VectorPlacements.lean @@ -5,8 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.P5352T2Sources +public import Mathlib.Tactic.Polynomial.Basic -- [TABLET NODE: P5352T2VectorPlacements] diff --git a/LeanPool/ApollonianSuperharmonic/P5416T1DiamondAxialDifferences.lean b/LeanPool/ApollonianSuperharmonic/P5416T1DiamondAxialDifferences.lean index be5bdd64b3..02a9fb472d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5416T1DiamondAxialDifferences.lean +++ b/LeanPool/ApollonianSuperharmonic/P5416T1DiamondAxialDifferences.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic -- [TABLET NODE: P5416T1DiamondAxialDifferences] diff --git a/LeanPool/ApollonianSuperharmonic/P5416T1SecondUnitGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5416T1SecondUnitGeometry.lean index 3a7380eba9..133298321f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5416T1SecondUnitGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P5416T1SecondUnitGeometry.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows +public import LeanPool.ApollonianSuperharmonic.P5352T2Sources -- [TABLET NODE: P5416T1SecondUnitGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P5432T1EdgeLedger.lean b/LeanPool/ApollonianSuperharmonic/P5432T1EdgeLedger.lean index bdbc710aec..8c7071e57b 100644 --- a/LeanPool/ApollonianSuperharmonic/P5432T1EdgeLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P5432T1EdgeLedger.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent -public import Mathlib.Algebra.Group.Int.Even -- [TABLET NODE: P5432T1EdgeLedger] diff --git a/LeanPool/ApollonianSuperharmonic/P5432T1Interior.lean b/LeanPool/ApollonianSuperharmonic/P5432T1Interior.lean index 1849828ef0..de34942598 100644 --- a/LeanPool/ApollonianSuperharmonic/P5432T1Interior.lean +++ b/LeanPool/ApollonianSuperharmonic/P5432T1Interior.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains diff --git a/LeanPool/ApollonianSuperharmonic/P5432T1Normalization.lean b/LeanPool/ApollonianSuperharmonic/P5432T1Normalization.lean index 0c10c1540d..30b51db158 100644 --- a/LeanPool/ApollonianSuperharmonic/P5432T1Normalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P5432T1Normalization.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5432T1Interior public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian diff --git a/LeanPool/ApollonianSuperharmonic/P5435T1Cocycle.lean b/LeanPool/ApollonianSuperharmonic/P5435T1Cocycle.lean index 160ccb71f8..f275dd751e 100644 --- a/LeanPool/ApollonianSuperharmonic/P5435T1Cocycle.lean +++ b/LeanPool/ApollonianSuperharmonic/P5435T1Cocycle.lean @@ -5,10 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalLattice public import LeanPool.ApollonianSuperharmonic.DiamondOdometer public import LeanPool.ApollonianSuperharmonic.DiamondPeakMatrix -public import Mathlib.Tactic +public import Mathlib.Algebra.Order.Ring.Star +public import Mathlib.Tactic.ENatToNat +public import Mathlib.Tactic.Polynomial.Basic -- [TABLET NODE: P5435T1Cocycle] diff --git a/LeanPool/ApollonianSuperharmonic/P5435T1PeriodGap.lean b/LeanPool/ApollonianSuperharmonic/P5435T1PeriodGap.lean index ac0947c496..e6fbf06249 100644 --- a/LeanPool/ApollonianSuperharmonic/P5435T1PeriodGap.lean +++ b/LeanPool/ApollonianSuperharmonic/P5435T1PeriodGap.lean @@ -5,8 +5,31 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalLattice -public import Mathlib.Tactic +public import Mathlib.Analysis.SpecialFunctions.Pow.NNReal +public import Mathlib.Tactic.Basify +public import Mathlib.Tactic.ENatToNat +public import Mathlib.Tactic.Echelon.Zsqrtd +public import Mathlib.Tactic.Inclusion.Extension.Core.Core +public import Mathlib.Tactic.Inclusion.Extension.IntervalDyadicReal.Hypotheses +public import Mathlib.Tactic.Inclusion.Extension.IntervalDyadicReal.Rational +public import Mathlib.Tactic.Measurability.Init +public import Mathlib.Tactic.NormNum.Irrational +public import Mathlib.Tactic.NormNum.IsCoprime +public import Mathlib.Tactic.NormNum.IsSquare +public import Mathlib.Tactic.NormNum.LegendreSymbol +public import Mathlib.Tactic.NormNum.ModEq +public import Mathlib.Tactic.NormNum.NatFib +public import Mathlib.Tactic.NormNum.NatLog +public import Mathlib.Tactic.NormNum.NatSqrt +public import Mathlib.Tactic.NormNum.Ordinal +public import Mathlib.Tactic.NormNum.Parity +public import Mathlib.Tactic.NormNum.Prime +public import Mathlib.Tactic.NormNum.RealSqrt +public import Mathlib.Tactic.Polynomial.Basic +public import Mathlib.Tactic.ReduceModChar -- [TABLET NODE: P5435T1PeriodGap] diff --git a/LeanPool/ApollonianSuperharmonic/P5435T1ShellPaths.lean b/LeanPool/ApollonianSuperharmonic/P5435T1ShellPaths.lean index c76f523de4..9cf4dcdd7f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5435T1ShellPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/P5435T1ShellPaths.lean @@ -5,10 +5,31 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected -public import Mathlib.Data.List.Chain -public import Mathlib.Tactic +public import Mathlib.Analysis.SpecialFunctions.Pow.NNReal +public import Mathlib.Tactic.Basify +public import Mathlib.Tactic.Echelon.Zsqrtd +public import Mathlib.Tactic.Inclusion.Extension.Core.Core +public import Mathlib.Tactic.Inclusion.Extension.IntervalDyadicReal.Hypotheses +public import Mathlib.Tactic.Inclusion.Extension.IntervalDyadicReal.Rational +public import Mathlib.Tactic.Measurability.Init +public import Mathlib.Tactic.NormNum.Irrational +public import Mathlib.Tactic.NormNum.IsCoprime +public import Mathlib.Tactic.NormNum.IsSquare +public import Mathlib.Tactic.NormNum.LegendreSymbol +public import Mathlib.Tactic.NormNum.ModEq +public import Mathlib.Tactic.NormNum.NatFib +public import Mathlib.Tactic.NormNum.NatLog +public import Mathlib.Tactic.NormNum.NatSqrt +public import Mathlib.Tactic.NormNum.Ordinal +public import Mathlib.Tactic.NormNum.Parity +public import Mathlib.Tactic.NormNum.Prime +public import Mathlib.Tactic.NormNum.RealSqrt +public import Mathlib.Tactic.Polynomial.Basic +public import Mathlib.Tactic.ReduceModChar -- [TABLET NODE: P5435T1ShellPaths] @@ -159,7 +180,7 @@ theorem P5435T1ShellPaths (K : DiamondParameter) : · have ht := pmem (-1) (-1) (Or.inr rfl) (Or.inr rfl) 1 (K.1-1) (by omega) (by omega) (by omega) (by omega) convert ht using 1 - ext <;> simp? [pt, k] + ext <;> simp only [Int.reduceNeg, Nat.cast_one, mul_one, pt, neg_mul, one_mul, k] have hcast : ((K.1-1 : Nat) : Int)=(K.1 : Int)-1 := by omega rw [hcast] ring diff --git a/LeanPool/ApollonianSuperharmonic/P5435T1WebGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5435T1WebGeometry.lean index 36e382fe0a..57f2e73077 100644 --- a/LeanPool/ApollonianSuperharmonic/P5435T1WebGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P5435T1WebGeometry.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5435T1ShellPaths public import LeanPool.ApollonianSuperharmonic.P5435T1PeriodGap public import LeanPool.ApollonianSuperharmonic.P4818T1Representatives -public import Mathlib.Data.List.Chain -- [TABLET NODE: P5435T1WebGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P5442T1Cocycle.lean b/LeanPool/ApollonianSuperharmonic/P5442T1Cocycle.lean index b19398060e..de5a9ff900 100644 --- a/LeanPool/ApollonianSuperharmonic/P5442T1Cocycle.lean +++ b/LeanPool/ApollonianSuperharmonic/P5442T1Cocycle.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordExceptionalLattice public import LeanPool.ApollonianSuperharmonic.FordOdometer public import LeanPool.ApollonianSuperharmonic.FordPeakMatrix -public import Mathlib.Tactic.LinearCombination -- [TABLET NODE: P5442T1Cocycle] diff --git a/LeanPool/ApollonianSuperharmonic/P5442T1LaplacianBound.lean b/LeanPool/ApollonianSuperharmonic/P5442T1LaplacianBound.lean index c58cf16443..812ef27880 100644 --- a/LeanPool/ApollonianSuperharmonic/P5442T1LaplacianBound.lean +++ b/LeanPool/ApollonianSuperharmonic/P5442T1LaplacianBound.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5442T1WebGeometry public import LeanPool.ApollonianSuperharmonic.P4062T1ParentalRestriction public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderGeometry +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: P5442T1LaplacianBound] diff --git a/LeanPool/ApollonianSuperharmonic/P5442T1WebGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5442T1WebGeometry.lean index beaba40887..c0c6a4763f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5442T1WebGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P5442T1WebGeometry.lean @@ -5,11 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5442T1Cocycle public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorSquare public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected -public import Mathlib.Data.List.Chain -- [TABLET NODE: P5442T1WebGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P5448T1CanonicalFordBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5448T1CanonicalFordBoundary.lean index 795f79c7a8..d35ff45e2f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5448T1CanonicalFordBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5448T1CanonicalFordBoundary.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.P5130T5ParentArithmetic -public import LeanPool.ApollonianSuperharmonic.P5188T1CeilingBelow -- [TABLET NODE: P5448T1CanonicalFordBoundary] diff --git a/LeanPool/ApollonianSuperharmonic/P5448T1CenteredFordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5448T1CenteredFordGeometry.lean index 016df4d79a..0d207105ef 100644 --- a/LeanPool/ApollonianSuperharmonic/P5448T1CenteredFordGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P5448T1CenteredFordGeometry.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5472T1FordNormalization public import LeanPool.ApollonianSuperharmonic.P5472T1CyclicPhaseCovariance public import LeanPool.ApollonianSuperharmonic.P5472T1LiteralFordPlacement diff --git a/LeanPool/ApollonianSuperharmonic/P5448T1CommonAffineFordPair.lean b/LeanPool/ApollonianSuperharmonic/P5448T1CommonAffineFordPair.lean index f04747f9f9..43257d329e 100644 --- a/LeanPool/ApollonianSuperharmonic/P5448T1CommonAffineFordPair.lean +++ b/LeanPool/ApollonianSuperharmonic/P5448T1CommonAffineFordPair.lean @@ -5,12 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas public import LeanPool.ApollonianSuperharmonic.P5448T1CanonicalFordBoundary -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.Ring -- [TABLET NODE: P5448T1CommonAffineFordPair] diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2AlignedPredecessor.lean b/LeanPool/ApollonianSuperharmonic/P5455T2AlignedPredecessor.lean index b509016d9f..cef2df2d64 100644 --- a/LeanPool/ApollonianSuperharmonic/P5455T2AlignedPredecessor.lean +++ b/LeanPool/ApollonianSuperharmonic/P5455T2AlignedPredecessor.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5455T2CurvatureGrowth public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision @@ -40,18 +42,24 @@ theorem P5455T2AlignedPredecessor have b := hp'.2 2 change (p 2).1 < (p 0).1 at a change (p' 3).1 < (p' 0).1 at b - simp? [P4828T1Step] at e0 e2 + simp only [P4828T1Step, Fin.isValue, Fin.succ_zero_eq_one, Matrix.cons_val_one, + Matrix.cons_val_zero, Fin.mk_one, zero_add, Fin.succ_one_eq_two, Matrix.cons_val, + Fin.reduceSucc, Fin.reduceAdd] at e0 e2 rw [e0, e2] at b omega · have a := hp.2 2 have b := hp'.2 1 change (p 3).1 < (p 0).1 at a change (p' 2).1 < (p' 0).1 at b - simp? [P4828T1Step] at e0 e1 + simp only [P4828T1Step, Fin.isValue, Fin.succ_zero_eq_one, Matrix.cons_val_one, + Matrix.cons_val_zero, Fin.reduceFinMk, zero_add, Fin.reduceSucc, Matrix.cons_val, + Fin.succ_one_eq_two, Fin.reduceAdd] at e0 e1 rw [e0, e1] at b omega subst r - simp? [P4828T1Step] at e0 e1 e2 + simp only [P4828T1Step, Fin.isValue, Fin.succ_zero_eq_one, Matrix.cons_val_one, + Matrix.cons_val_zero, add_zero, Fin.succ_one_eq_two, Matrix.cons_val, Fin.reduceSucc] + at e0 e1 e2 have cx := congrArg Prod.fst hchild have wx := congrArg Prod.snd hchild simp only [P4828T1Step, Matrix.cons_val_zero] at cx wx diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2CurvatureGrowth.lean b/LeanPool/ApollonianSuperharmonic/P5455T2CurvatureGrowth.lean index 38ddf6252b..0450cda86d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5455T2CurvatureGrowth.lean +++ b/LeanPool/ApollonianSuperharmonic/P5455T2CurvatureGrowth.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification public import LeanPool.ApollonianSuperharmonic.P4828T1Step diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2LeftRegressions.lean b/LeanPool/ApollonianSuperharmonic/P5455T2LeftRegressions.lean index d3d58bf58e..33f37e5d6d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5455T2LeftRegressions.lean +++ b/LeanPool/ApollonianSuperharmonic/P5455T2LeftRegressions.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5455T2CurvatureGrowth public import LeanPool.ApollonianSuperharmonic.P5455T2OccurrenceRotation public import LeanPool.ApollonianSuperharmonic.P4828T1LeftRootGeometry diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean index 7d3ab0e07a..839d53df1f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean +++ b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean @@ -5,11 +5,12 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.P5455T2CurvatureGrowth -public import LeanPool.ApollonianSuperharmonic.P5455T2OccurrenceRotation +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5455T2RootAlignment public import LeanPool.ApollonianSuperharmonic.P5455T2AlignedPredecessor public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique +public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation -- [TABLET NODE: P5455T2OccurrenceDeterministic] @@ -230,7 +231,8 @@ private theorem main : have hnpre : (p 0).1.toNat = (p 0).1.toNat := rfl rcases rowA with ⟨hj, hpre, stateA⟩ | ⟨hj, hpre, stateA⟩ · rw [← hjEq] at rowB - simp? [hj] at rowB + simp only [hj, Fin.isValue, ne_eq, true_and, Fin.reduceEq, false_and, or_false] + at rowB rcases rowB with ⟨hpre', stateB⟩ have hunit : (p 2).1 = 1 := by have hidx : i + r = 1 := by rw [hia, hj]; exact sub_add_cancel 1 r @@ -267,7 +269,8 @@ private theorem main : · exact (hsib hF.1).elim · exact (hsib hR.1).elim · rw [← hjEq] at rowB - simp? [hj] at rowB + simp only [hj, Fin.isValue, Fin.reduceEq, ne_eq, false_and, true_and, false_or] + at rowB rcases rowB with ⟨hpre', stateB⟩ have hunit : (p 3).1 = 1 := by have hidx : i + r = 2 := by rw [hia, hj]; exact sub_add_cancel 2 r diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceExists.lean b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceExists.lean index c8e04a12a8..cd74241aa8 100644 --- a/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceExists.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5455T2CurvatureGrowth public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceRotation.lean b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceRotation.lean index a606320d45..7a9d5e70b6 100644 --- a/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceRotation.lean +++ b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceRotation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.UnitOccurrenceOrientation public import LeanPool.ApollonianSuperharmonic.P4828T1RotationLaws diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2RightRegressions.lean b/LeanPool/ApollonianSuperharmonic/P5455T2RightRegressions.lean index ac7556e561..79515eeb24 100644 --- a/LeanPool/ApollonianSuperharmonic/P5455T2RightRegressions.lean +++ b/LeanPool/ApollonianSuperharmonic/P5455T2RightRegressions.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5455T2CurvatureGrowth public import LeanPool.ApollonianSuperharmonic.P5455T2OccurrenceRotation public import LeanPool.ApollonianSuperharmonic.P4828T1RightRootGeometry diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2RootAlignment.lean b/LeanPool/ApollonianSuperharmonic/P5455T2RootAlignment.lean index b187c723f6..81b068a629 100644 --- a/LeanPool/ApollonianSuperharmonic/P5455T2RootAlignment.lean +++ b/LeanPool/ApollonianSuperharmonic/P5455T2RootAlignment.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4828T1Root public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2WholeJoin.lean b/LeanPool/ApollonianSuperharmonic/P5455T2WholeJoin.lean index 25a544e3ce..c4f2f3e131 100644 --- a/LeanPool/ApollonianSuperharmonic/P5455T2WholeJoin.lean +++ b/LeanPool/ApollonianSuperharmonic/P5455T2WholeJoin.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4994T6UnitRootTable -public import LeanPool.ApollonianSuperharmonic.P4828T1LeftRootGeometry public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep -- [TABLET NODE: P5455T2WholeJoin] diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1AffineDifferenceTransport.lean b/LeanPool/ApollonianSuperharmonic/P5472T1AffineDifferenceTransport.lean index 8af0da2072..6da63230d8 100644 --- a/LeanPool/ApollonianSuperharmonic/P5472T1AffineDifferenceTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/P5472T1AffineDifferenceTransport.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1CyclicAffineCommutation.lean b/LeanPool/ApollonianSuperharmonic/P5472T1CyclicAffineCommutation.lean index 5b5ac7f4a4..66dae44d44 100644 --- a/LeanPool/ApollonianSuperharmonic/P5472T1CyclicAffineCommutation.lean +++ b/LeanPool/ApollonianSuperharmonic/P5472T1CyclicAffineCommutation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction -- [TABLET NODE: P5472T1CyclicAffineCommutation] diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1CyclicPhaseCovariance.lean b/LeanPool/ApollonianSuperharmonic/P5472T1CyclicPhaseCovariance.lean index 36a29655ed..741ad4516e 100644 --- a/LeanPool/ApollonianSuperharmonic/P5472T1CyclicPhaseCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/P5472T1CyclicPhaseCovariance.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5472T1CyclicAffineCommutation public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1FordNormalization.lean b/LeanPool/ApollonianSuperharmonic/P5472T1FordNormalization.lean index 13e0b970a2..33b8cbd765 100644 --- a/LeanPool/ApollonianSuperharmonic/P5472T1FordNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P5472T1FordNormalization.lean @@ -5,11 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -- [TABLET NODE: P5472T1FordNormalization] @@ -126,15 +127,22 @@ private theorem hsuccCov : · rw [hs] funext i fin_cases i <;> - simp? [succ, BandPackingSymmetryQuadrupleAction, - BandPackingSymmetryCircleAction, BandPackingSymmetryReversesOrientation]; + simp only [BandPackingSymmetryQuadrupleAction, BandPackingSymmetryCircleAction, + Fin.isValue, Matrix.cons_val_zero, Int.cast_sub, Int.cast_add, Int.cast_mul, + Int.cast_ofNat, BandPackingSymmetryReversesOrientation, Bool.false_eq_true, + ↓reduceIte, Fin.succ_zero_eq_one, Matrix.cons_val_one, Fin.succ_one_eq_two, + Matrix.cons_val, Fin.reduceSucc, Fin.mk_one, succ, Fin.reduceFinMk, Fin.zero_eta, + Prod.mk.injEq, true_and]; (try ext) <;> simp [] <;> ring · rw [hs] funext i fin_cases i <;> - simp? [succ, BandPackingSymmetryQuadrupleAction, - BandPackingSymmetryCircleAction, BandPackingSymmetryReversesOrientation, - ]; (try ext) <;> + simp only [BandPackingSymmetryQuadrupleAction, BandPackingSymmetryCircleAction, + Fin.isValue, Matrix.cons_val_zero, neg_sub, Int.cast_sub, Int.cast_add, + Int.cast_mul, Int.cast_ofNat, BandPackingSymmetryReversesOrientation, + bne_self_eq_false, Bool.false_eq_true, ↓reduceIte, Fin.succ_zero_eq_one, + Matrix.cons_val_one, Fin.succ_one_eq_two, Matrix.cons_val, Fin.reduceSucc, + Fin.mk_one, succ, Fin.reduceFinMk, Fin.zero_eta, Prod.mk.injEq, true_and]; (try ext) <;> simp [] <;> ring private theorem hF0 : @@ -243,7 +251,8 @@ private theorem houter : rw [hqSucc, hsuccCov] funext i fin_cases i - · simp? [succ] + · simp only [Fin.isValue, Fin.zero_eta, Matrix.cons_val_zero, Nat.succ_eq_add_one, + Nat.reduceAdd, Prod.mk.injEq, succ] constructor · rw [hsF0, hsF2, hsF3, hsF1] · rw [hsF0, hsF2, hsF3, hsF1] diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean b/LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean index 60be18a8b3..ceaf255e92 100644 --- a/LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean +++ b/LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas public import LeanPool.ApollonianSuperharmonic.P5472T1AffineDifferenceTransport public import LeanPool.ApollonianSuperharmonic.FordFareyParameter @@ -67,7 +68,7 @@ theorem P5472T1FordSlopeDifference have hq1pos : 0 < (q 1).1 := by have hh := congrArg Prod.fst hrootCircle rw [hcurvSym] at hh - simp? [FordCircleCoordinate] at hh + simp only [Fin.isValue, FordCircleCoordinate, Nat.cast_mul, Int.reduceNeg] at hh have : 0 < F.q * F.q := Nat.mul_pos F.q_pos F.q_pos omega let I : GaussianInt := ⟨0, 1⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1LiteralFordPlacement.lean b/LeanPool/ApollonianSuperharmonic/P5472T1LiteralFordPlacement.lean index d5ae3c2de8..2903fedef8 100644 --- a/LeanPool/ApollonianSuperharmonic/P5472T1LiteralFordPlacement.lean +++ b/LeanPool/ApollonianSuperharmonic/P5472T1LiteralFordPlacement.lean @@ -5,15 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction -public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation -- [TABLET NODE: P5472T1LiteralFordPlacement] @@ -537,7 +535,8 @@ private theorem hcurvPos : ∀ (F : FordFareyParameter), 0 < (FordCircleCoordinate F.p F.q).1 ) := by classical intro F - simp? [FordCircleCoordinate] + simp only [FordCircleCoordinate, Nat.cast_mul, Int.reduceNeg, mul_self_pos, ne_eq, + Int.natCast_eq_zero] exact Nat.ne_of_gt F.q_pos private theorem hfootFord : diff --git a/LeanPool/ApollonianSuperharmonic/P5478T1ExteriorPlacementIndex.lean b/LeanPool/ApollonianSuperharmonic/P5478T1ExteriorPlacementIndex.lean index 61b2c8ce27..979c9c9059 100644 --- a/LeanPool/ApollonianSuperharmonic/P5478T1ExteriorPlacementIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/P5478T1ExteriorPlacementIndex.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms diff --git a/LeanPool/ApollonianSuperharmonic/P5485T1FullInterfaceMarking.lean b/LeanPool/ApollonianSuperharmonic/P5485T1FullInterfaceMarking.lean index dd128c4866..756db36c33 100644 --- a/LeanPool/ApollonianSuperharmonic/P5485T1FullInterfaceMarking.lean +++ b/LeanPool/ApollonianSuperharmonic/P5485T1FullInterfaceMarking.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -- [TABLET NODE: P5485T1FullInterfaceMarking] diff --git a/LeanPool/ApollonianSuperharmonic/P5485T1OtherCompanionCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P5485T1OtherCompanionCoordinates.lean index f72edb686e..945c3b3bc1 100644 --- a/LeanPool/ApollonianSuperharmonic/P5485T1OtherCompanionCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P5485T1OtherCompanionCoordinates.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4418T3EndpointOwnerIndices public import LeanPool.ApollonianSuperharmonic.P3055T1ParentVectorNormalForms diff --git a/LeanPool/ApollonianSuperharmonic/P5485T1RoutedInterfaceAvoidance.lean b/LeanPool/ApollonianSuperharmonic/P5485T1RoutedInterfaceAvoidance.lean index 35a37eb4e7..5ed1ee15a1 100644 --- a/LeanPool/ApollonianSuperharmonic/P5485T1RoutedInterfaceAvoidance.lean +++ b/LeanPool/ApollonianSuperharmonic/P5485T1RoutedInterfaceAvoidance.lean @@ -5,11 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceData public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors public import LeanPool.ApollonianSuperharmonic.OppositeRoutedCommonEdgeOutsideCellUnique public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -- [TABLET NODE: P5485T1RoutedInterfaceAvoidance] diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1AffinePairReduction.lean b/LeanPool/ApollonianSuperharmonic/P5491T1AffinePairReduction.lean index 7205ecf578..2d5f7d207d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5491T1AffinePairReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/P5491T1AffinePairReduction.lean @@ -5,10 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P5491T1AffinePairReduction] diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1DiamondParentBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondParentBoundary.lean index 4818b83ac5..59b3e6a3e7 100644 --- a/LeanPool/ApollonianSuperharmonic/P5491T1DiamondParentBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondParentBoundary.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData -public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows public import LeanPool.ApollonianSuperharmonic.P5537T1UnitParentBoundary public import LeanPool.ApollonianSuperharmonic.P5537T1PredecessorCoordinates public import LeanPool.ApollonianSuperharmonic.P5537T1PredecessorValues diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean index cf132aae4f..ca1dd2d9c8 100644 --- a/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean @@ -5,9 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows -public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic +public import LeanPool.ApollonianSuperharmonic.P5352T2Sources -- [TABLET NODE: P5491T1DiamondRightBoundary] @@ -534,12 +536,18 @@ private theorem hpositive : i.val = 0 then -(n*(n+1))/2 else if i.val = 1 then n*(n-1)/2 else n*(n-1)))))) ) := by classical intro K hk n hF hfloorEven hfloorOdd tri foot i x hx hxD + have habsB : |(K.1 : Int)| = (K.1 : Int) := + abs_of_nonneg (show 0 ≤ (K.1 : Int) by omega) + have triangularCurvature := tri (K.1 : Int) let u : Int := x.re let v : Int := x.im have hxy := (foot x).mp hx have hxyD := (foot (x-(P5352T2PlacementData K.1 i).1.1)).mp hxD fin_cases i - · simp? [P5352T2PlacementData] at hxyD + · simp only [Int.reduceNeg, P5352T2PlacementData, Nat.succ_eq_add_one, Nat.reduceAdd, + neg_mul, Fin.zero_eta, Fin.isValue, Matrix.cons_val_zero, Zsqrtd.im_sub, Int.sub_nonneg, + Order.add_one_le_iff, tsub_le_iff_right, Zsqrtd.re_sub, sub_neg_eq_add, + add_le_iff_nonpos_left, neg_sub, neg_add_rev, neg_add_le_iff_le_add] at hxyD have hd : v-u = 2*n ∨ v-u = 2*n+1 := by omega rcases hd with hd | hd @@ -549,7 +557,8 @@ private theorem hpositive : have hxe : x = ⟨-n+1+r,n+1+r⟩ := by ext <;> simp [r,v]; omega rw [hxe] - simp? [P5352T2PlacementData] + simp only [Fin.isValue, Int.reduceNeg, P5352T2PlacementData, Nat.succ_eq_add_one, + Nat.reduceAdd, neg_mul, Fin.zero_eta, Matrix.cons_val_zero, one_mul, ↓reduceIte] rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), hF _ (by simpa [hxe] using hx)] simp only [n] @@ -580,7 +589,8 @@ private theorem hpositive : have hxe : x = ⟨-n+r,n+1+r⟩ := by ext <;> simp [r,v]; omega rw [hxe] - simp? [P5352T2PlacementData] + simp only [Fin.isValue, Int.reduceNeg, P5352T2PlacementData, Nat.succ_eq_add_one, + Nat.reduceAdd, neg_mul, Fin.zero_eta, Matrix.cons_val_zero, one_mul, ↓reduceIte] rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), hF _ (by simpa [hxe] using hx)] simp only [n, Zsqrtd.re_sub, Zsqrtd.im_sub, Int.natCast_natAbs] @@ -604,7 +614,10 @@ private theorem hpositive : have habsRe : -(-(K.1:Int)+r) = (K.1:Int)-r := by ring rw [habsRe] linear_combination ht1 - ht2 + hpoly + ht3' - · simp? [P5352T2PlacementData] at hxyD + · simp only [Int.reduceNeg, P5352T2PlacementData, Nat.succ_eq_add_one, Nat.reduceAdd, + neg_mul, Fin.mk_one, Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, + Zsqrtd.im_sub, Int.sub_nonneg, tsub_le_iff_right, Zsqrtd.re_sub, sub_neg_eq_add, + add_le_iff_nonpos_left, neg_sub, neg_add_rev, neg_add_le_iff_le_add] at hxyD have hd : u+v = -1 ∨ u+v = 0 := by omega rcases hd with hd | hd · let r : Int := v @@ -612,7 +625,9 @@ private theorem hpositive : have hrn : r < n := by dsimp [r]; omega have hxe : x = ⟨-r-1,r⟩ := by ext <;> simp [r,v]; omega rw [hxe] - simp? [P5352T2PlacementData] + simp only [Fin.isValue, Int.reduceNeg, P5352T2PlacementData, Nat.succ_eq_add_one, + Nat.reduceAdd, neg_mul, Fin.mk_one, Matrix.cons_val_one, Matrix.cons_val_zero, + zero_mul, add_zero, one_ne_zero, ↓reduceIte] rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), hF _ (by simpa [hxe] using hx)] simp only [n, Zsqrtd.re_sub, Zsqrtd.im_sub, Int.natCast_natAbs] @@ -626,22 +641,21 @@ private theorem hpositive : have ht1 := tri ((K.1:Int)-r-1) have ht2 := tri (r+1) have hpoly := DiamondBoundaryDetails.hpolyAt356 K x - have ht3 := tri (K.1:Int) - have ht3' : 2*((K.1:Int)*((K.1:Int)-1)/2) = - (K.1:Int)*((K.1:Int)-1) := by simpa using ht3 apply (mul_left_cancel₀ (by norm_num : (2:Int) ≠ 0)) have hre : -r-1 - (-(K.1:Int)) = (K.1:Int)-r-1 := by ring have hbr : -(-r-1) = r+1 := by ring rw [hre, hbr] have htr : r+1-1 = r := by omega rw [htr] at ht2 ⊢ - linear_combination ht1 - ht2 + hpoly - ht3' + linear_combination ht1 - ht2 + hpoly - triangularCurvature · let r : Int := v have hr0 : 0 ≤ r := by dsimp [r]; omega have hrn : r < n := by dsimp [r]; omega have hxe : x = ⟨-r,r⟩ := by ext <;> simp [r,v]; omega rw [hxe] - simp? [P5352T2PlacementData] + simp only [Fin.isValue, Int.reduceNeg, P5352T2PlacementData, Nat.succ_eq_add_one, + Nat.reduceAdd, neg_mul, Fin.mk_one, Matrix.cons_val_one, Matrix.cons_val_zero, + mul_neg, neg_neg, zero_mul, add_zero, one_ne_zero, ↓reduceIte] rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), hF _ (by simpa [hxe] using hx)] simp only [n, Zsqrtd.re_sub, Zsqrtd.im_sub, Int.natCast_natAbs] @@ -655,28 +669,28 @@ private theorem hpositive : have ht1 := tri ((K.1:Int)-r) have ht2 := tri r have hpoly := DiamondBoundaryDetails.hpolyAt395 K x - have ht3 := tri (K.1:Int) - have ht3' : 2*((K.1:Int)*((K.1:Int)-1)/2) = - (K.1:Int)*((K.1:Int)-1) := by simpa using ht3 apply (mul_left_cancel₀ (by norm_num : (2:Int) ≠ 0)) have hre : -r - (-(K.1:Int)) = (K.1:Int)-r := by ring have hbaseT : -(-r)*(-(-r)-1) = r*(r-1) := by ring rw [hre, hbaseT] - linear_combination ht1 - ht2 + hpoly - ht3' - · simp? [P5352T2PlacementData] at hxyD + linear_combination ht1 - ht2 + hpoly - triangularCurvature + · simp only [Int.reduceNeg, P5352T2PlacementData, Nat.succ_eq_add_one, Nat.reduceAdd, + neg_mul, Fin.reduceFinMk, Matrix.cons_val, Zsqrtd.im_sub, sub_zero, Zsqrtd.re_sub, + neg_le_sub_iff_le_add, tsub_le_iff_right, neg_add_rev, neg_sub, neg_add_le_iff_le_add] + at hxyD have hu : u = n := by omega have hv : v = n-1 ∨ v = n ∨ v = n+1 := by omega rcases hv with hv | hv | hv · have hxe : x = ⟨n,n-1⟩ := by ext <;> simp [u,v,hu,hv] rw [hxe] - simp? [P5352T2PlacementData] + simp only [Fin.isValue, Int.reduceNeg, P5352T2PlacementData, Nat.succ_eq_add_one, + Nat.reduceAdd, neg_mul, Fin.reduceFinMk, Matrix.cons_val, OfNat.ofNat_ne_zero, + ↓reduceIte, OfNat.ofNat_ne_one] rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), hF _ (by simpa [hxe] using hx)] simp only [n, Zsqrtd.re_sub, Zsqrtd.im_sub, Int.natCast_natAbs] have habsT := DiamondBoundaryDetails.habsTAt417 K hk x hxy hxyD - have habsB : |(K.1:Int)| = (K.1:Int) := - abs_of_nonneg (show 0 ≤ (K.1:Int) by omega) rw [habsT, habsB] simp only [sub_zero] have hf := DiamondBoundaryDetails.hfAt425 K hfloorOdd @@ -685,14 +699,14 @@ private theorem hpositive : ring · have hxe : x = ⟨n,n⟩ := by ext <;> simp [u,v,hu,hv] rw [hxe] - simp? [P5352T2PlacementData] + simp only [Fin.isValue, Int.reduceNeg, P5352T2PlacementData, Nat.succ_eq_add_one, + Nat.reduceAdd, neg_mul, Fin.reduceFinMk, Matrix.cons_val, OfNat.ofNat_ne_zero, + ↓reduceIte, OfNat.ofNat_ne_one] rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), hF _ (by simpa [hxe] using hx)] simp only [n, Zsqrtd.re_sub, Zsqrtd.im_sub, Int.natCast_natAbs] have habsT := DiamondBoundaryDetails.habsTAt438 K hk x hxy hxyD - have habsB : |(K.1:Int)| = (K.1:Int) := - abs_of_nonneg (show 0 ≤ (K.1:Int) by omega) rw [habsT, habsB] simp only [sub_zero] have hf := DiamondBoundaryDetails.hfAt446 K hfloorEven @@ -701,14 +715,14 @@ private theorem hpositive : ring · have hxe : x = ⟨n,n+1⟩ := by ext <;> simp [u,v,hu,hv] rw [hxe] - simp? [P5352T2PlacementData] + simp only [Fin.isValue, Int.reduceNeg, P5352T2PlacementData, Nat.succ_eq_add_one, + Nat.reduceAdd, neg_mul, Fin.reduceFinMk, Matrix.cons_val, OfNat.ofNat_ne_zero, + ↓reduceIte, OfNat.ofNat_ne_one] rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), hF _ (by simpa [hxe] using hx)] simp only [n, Zsqrtd.re_sub, Zsqrtd.im_sub, Int.natCast_natAbs] have habsT := DiamondBoundaryDetails.habsTAt459 K hk x hxy hxyD - have habsB : |(K.1:Int)| = (K.1:Int) := - abs_of_nonneg (show 0 ≤ (K.1:Int) by omega) rw [habsT, habsB] simp only [sub_zero] have hf := DiamondBoundaryDetails.hfAt467 K hfloorOdd diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1ExceptionalPresentation.lean b/LeanPool/ApollonianSuperharmonic/P5491T1ExceptionalPresentation.lean index 737db3a376..ae3a5d83b4 100644 --- a/LeanPool/ApollonianSuperharmonic/P5491T1ExceptionalPresentation.lean +++ b/LeanPool/ApollonianSuperharmonic/P5491T1ExceptionalPresentation.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1FordBoundarySlope.lean b/LeanPool/ApollonianSuperharmonic/P5491T1FordBoundarySlope.lean index 27068652bd..8c963e0efa 100644 --- a/LeanPool/ApollonianSuperharmonic/P5491T1FordBoundarySlope.lean +++ b/LeanPool/ApollonianSuperharmonic/P5491T1FordBoundarySlope.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain public import LeanPool.ApollonianSuperharmonic.P4217T2RectangularBoundarySlope -- [TABLET NODE: P5491T1FordBoundarySlope] diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1FordParentBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5491T1FordParentBoundary.lean index da9328da44..fc72f88e4a 100644 --- a/LeanPool/ApollonianSuperharmonic/P5491T1FordParentBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5491T1FordParentBoundary.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1ParentRows public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -- [TABLET NODE: P5491T1FordParentBoundary] diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1FordRightBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5491T1FordRightBoundary.lean index 5f87de3f98..14ce158c3d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5491T1FordRightBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5491T1FordRightBoundary.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5332T1RightRows public import LeanPool.ApollonianSuperharmonic.FordOdometer -public import LeanPool.ApollonianSuperharmonic.FordVertexDomain -public import LeanPool.ApollonianSuperharmonic.FordDoubledBoundary -- [TABLET NODE: P5491T1FordRightBoundary] diff --git a/LeanPool/ApollonianSuperharmonic/P5532T1FiniteOrientationGluing.lean b/LeanPool/ApollonianSuperharmonic/P5532T1FiniteOrientationGluing.lean index 51ca8dbb97..cce02b16c1 100644 --- a/LeanPool/ApollonianSuperharmonic/P5532T1FiniteOrientationGluing.lean +++ b/LeanPool/ApollonianSuperharmonic/P5532T1FiniteOrientationGluing.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ParentalOrientationGluing -- [TABLET NODE: P5532T1FiniteOrientationGluing] @@ -39,7 +41,7 @@ theorem P5532T1FiniteOrientationGluing {ι : Type*} [Fintype ι] | empty => refine ⟨{ edge := fun _ _ => False - edge_decidable := fun _ _ => Classical.propDecidable _ + edgeDecidable := fun _ _ => Classical.propDecidable _ rank := fun _ => 0 supported := by intro x y he; cases he oriented := by simp diff --git a/LeanPool/ApollonianSuperharmonic/P5532T1ForestAttachment.lean b/LeanPool/ApollonianSuperharmonic/P5532T1ForestAttachment.lean index b4cc0309a9..95719dae5c 100644 --- a/LeanPool/ApollonianSuperharmonic/P5532T1ForestAttachment.lean +++ b/LeanPool/ApollonianSuperharmonic/P5532T1ForestAttachment.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.RootedFourNeighborForest public import LeanPool.ApollonianSuperharmonic.P4062T1RankedAttachment diff --git a/LeanPool/ApollonianSuperharmonic/P5532T1OrientationPullback.lean b/LeanPool/ApollonianSuperharmonic/P5532T1OrientationPullback.lean index 0057e1b080..84fb1a7f24 100644 --- a/LeanPool/ApollonianSuperharmonic/P5532T1OrientationPullback.lean +++ b/LeanPool/ApollonianSuperharmonic/P5532T1OrientationPullback.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation -- [TABLET NODE: P5532T1OrientationPullback] @@ -38,7 +40,7 @@ theorem P5532T1OrientationPullback (D E : Finset GaussianInt) exact hinj heq ▸ hy refine ⟨{ edge := fun x y => o.edge (L x) (L y) - edge_decidable := fun x y => o.edge_decidable (L x) (L y) + edgeDecidable := fun x y => o.edgeDecidable (L x) (L y) rank := fun x => o.rank (L x) supported := ?_ oriented := ?_ @@ -54,9 +56,9 @@ theorem P5532T1OrientationPullback (D E : Finset GaussianInt) · intro x hx have hc : (D.filter fun y => @decide (o.edge (L y) (L x)) - (o.edge_decidable (L y) (L x))).card = + (o.edgeDecidable (L y) (L x))).card = (E.filter fun y => @decide (o.edge y (L x)) - (o.edge_decidable y (L x))).card := by + (o.edgeDecidable y (L x))).card := by apply Finset.card_bij (fun y _ => L y) · intro y hy exact Finset.mem_filter.mpr ⟨(hmem y).mp (Finset.mem_filter.mp hy).1, diff --git a/LeanPool/ApollonianSuperharmonic/P5532T1OverlapNoEntry.lean b/LeanPool/ApollonianSuperharmonic/P5532T1OverlapNoEntry.lean index 10e91dd68b..e8697c0be4 100644 --- a/LeanPool/ApollonianSuperharmonic/P5532T1OverlapNoEntry.lean +++ b/LeanPool/ApollonianSuperharmonic/P5532T1OverlapNoEntry.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation -public import Mathlib.Algebra.BigOperators.Group.Finset.Basic -- [TABLET NODE: P5532T1OverlapNoEntry] diff --git a/LeanPool/ApollonianSuperharmonic/P5532T1ParentInteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5532T1ParentInteriorGeometry.lean index 6d0c454322..0d10023b55 100644 --- a/LeanPool/ApollonianSuperharmonic/P5532T1ParentInteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P5532T1ParentInteriorGeometry.lean @@ -5,11 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.P4456T2VertexInterior -public import LeanPool.ApollonianSuperharmonic.P4397T1UnitEdgeCells -- [TABLET NODE: P5532T1ParentInteriorGeometry] diff --git a/LeanPool/ApollonianSuperharmonic/P5532T1RestrictionMassBalance.lean b/LeanPool/ApollonianSuperharmonic/P5532T1RestrictionMassBalance.lean index 4d882357dc..52b76a52eb 100644 --- a/LeanPool/ApollonianSuperharmonic/P5532T1RestrictionMassBalance.lean +++ b/LeanPool/ApollonianSuperharmonic/P5532T1RestrictionMassBalance.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandCanonicalPeriodicExtension public import LeanPool.ApollonianSuperharmonic.PeriodicTileTotalIndegree -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -- [TABLET NODE: P5532T1RestrictionMassBalance] diff --git a/LeanPool/ApollonianSuperharmonic/P5532T1SymmetryOrientationTransport.lean b/LeanPool/ApollonianSuperharmonic/P5532T1SymmetryOrientationTransport.lean index a7f4cb804b..c43f636895 100644 --- a/LeanPool/ApollonianSuperharmonic/P5532T1SymmetryOrientationTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/P5532T1SymmetryOrientationTransport.lean @@ -5,15 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5532T1OrientationPullback public import LeanPool.ApollonianSuperharmonic.P5686T1UniformGlobalOdometerTransport public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -- [TABLET NODE: P5532T1SymmetryOrientationTransport] diff --git a/LeanPool/ApollonianSuperharmonic/P5537T1PredecessorCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P5537T1PredecessorCoordinates.lean index 61f133e867..3b07b01727 100644 --- a/LeanPool/ApollonianSuperharmonic/P5537T1PredecessorCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P5537T1PredecessorCoordinates.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows -- [TABLET NODE: P5537T1PredecessorCoordinates] diff --git a/LeanPool/ApollonianSuperharmonic/P5537T1PredecessorValues.lean b/LeanPool/ApollonianSuperharmonic/P5537T1PredecessorValues.lean index d3cb870628..5116229dbc 100644 --- a/LeanPool/ApollonianSuperharmonic/P5537T1PredecessorValues.lean +++ b/LeanPool/ApollonianSuperharmonic/P5537T1PredecessorValues.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5537T1ScaledDiamondFormula -- [TABLET NODE: P5537T1PredecessorValues] diff --git a/LeanPool/ApollonianSuperharmonic/P5537T1ScaledDiamondFormula.lean b/LeanPool/ApollonianSuperharmonic/P5537T1ScaledDiamondFormula.lean index f6a5cc441e..75622f4e4e 100644 --- a/LeanPool/ApollonianSuperharmonic/P5537T1ScaledDiamondFormula.lean +++ b/LeanPool/ApollonianSuperharmonic/P5537T1ScaledDiamondFormula.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic -- [TABLET NODE: P5537T1ScaledDiamondFormula] diff --git a/LeanPool/ApollonianSuperharmonic/P5537T1UnitParentBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5537T1UnitParentBoundary.lean index 4c26a65a0a..14f3a03f07 100644 --- a/LeanPool/ApollonianSuperharmonic/P5537T1UnitParentBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5537T1UnitParentBoundary.lean @@ -5,9 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows public import LeanPool.ApollonianSuperharmonic.P5537T1ScaledDiamondFormula +public import LeanPool.ApollonianSuperharmonic.P5352T2Sources -- [TABLET NODE: P5537T1UnitParentBoundary] diff --git a/LeanPool/ApollonianSuperharmonic/P5570T1UnitNormalForm.lean b/LeanPool/ApollonianSuperharmonic/P5570T1UnitNormalForm.lean index b885fa90b0..404418c61d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5570T1UnitNormalForm.lean +++ b/LeanPool/ApollonianSuperharmonic/P5570T1UnitNormalForm.lean @@ -5,12 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5570T1UnitQuadratic public import LeanPool.ApollonianSuperharmonic.CurvatureOnePeriodicOdometer public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -- [TABLET NODE: P5570T1UnitNormalForm] diff --git a/LeanPool/ApollonianSuperharmonic/P5570T1UnitQuadratic.lean b/LeanPool/ApollonianSuperharmonic/P5570T1UnitQuadratic.lean index 224a812155..8335cc0224 100644 --- a/LeanPool/ApollonianSuperharmonic/P5570T1UnitQuadratic.lean +++ b/LeanPool/ApollonianSuperharmonic/P5570T1UnitQuadratic.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction -- [TABLET NODE: P5570T1UnitQuadratic] diff --git a/LeanPool/ApollonianSuperharmonic/P5589T1EndpointCompatibility.lean b/LeanPool/ApollonianSuperharmonic/P5589T1EndpointCompatibility.lean index 7eb3ea50e9..909a8eed90 100644 --- a/LeanPool/ApollonianSuperharmonic/P5589T1EndpointCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/P5589T1EndpointCompatibility.lean @@ -5,10 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.RightSubtileOdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: P5589T1EndpointCompatibility] diff --git a/LeanPool/ApollonianSuperharmonic/P5589T1LinkedUnitValues.lean b/LeanPool/ApollonianSuperharmonic/P5589T1LinkedUnitValues.lean index 6b819d53b7..e008aecb91 100644 --- a/LeanPool/ApollonianSuperharmonic/P5589T1LinkedUnitValues.lean +++ b/LeanPool/ApollonianSuperharmonic/P5589T1LinkedUnitValues.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4261T2UnitStringTelescoping public import LeanPool.ApollonianSuperharmonic.P5570T1UnitNormalForm public import LeanPool.ApollonianSuperharmonic.AncestorOdometer diff --git a/LeanPool/ApollonianSuperharmonic/P5589T1UnitInterfaceSelection.lean b/LeanPool/ApollonianSuperharmonic/P5589T1UnitInterfaceSelection.lean index 84e0f112a6..4f5fc93498 100644 --- a/LeanPool/ApollonianSuperharmonic/P5589T1UnitInterfaceSelection.lean +++ b/LeanPool/ApollonianSuperharmonic/P5589T1UnitInterfaceSelection.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.OpposingStringInterfacePath public import LeanPool.ApollonianSuperharmonic.P4366T2WalkExhaustion public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect @@ -13,11 +15,7 @@ public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple public import LeanPool.ApollonianSuperharmonic.TouchingTriple public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain public import LeanPool.ApollonianSuperharmonic.P4158T1AncestorCells -public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge -- [TABLET NODE: P5589T1UnitInterfaceSelection] diff --git a/LeanPool/ApollonianSuperharmonic/P5596T1CommonExtensionTransport.lean b/LeanPool/ApollonianSuperharmonic/P5596T1CommonExtensionTransport.lean index a34d371e1a..9cd3621717 100644 --- a/LeanPool/ApollonianSuperharmonic/P5596T1CommonExtensionTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/P5596T1CommonExtensionTransport.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryGlobalOdometerTransport public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas public import LeanPool.ApollonianSuperharmonic.P4055T1PackingGridEquivalence diff --git a/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean b/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean index e4638b6496..d1a0df1b29 100644 --- a/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean +++ b/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean @@ -5,33 +5,16 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.LeftAdjacentOdometerCompatibility public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification -public import LeanPool.ApollonianSuperharmonic.P5570T1UnitNormalForm public import LeanPool.ApollonianSuperharmonic.P5570T1UnitQuadratic -public import LeanPool.ApollonianSuperharmonic.CurvatureOnePeriodicOdometer -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryOdometerStrings -public import LeanPool.ApollonianSuperharmonic.BoundaryString public import LeanPool.ApollonianSuperharmonic.P3996T1AdjacentParentPlacement public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentIncomingEndpoint -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleRetargetMiddle public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceDisjointCompanionEndpoints -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton -public import LeanPool.ApollonianSuperharmonic.FordTileGeometry -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing -public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct -public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity public import LeanPool.ApollonianSuperharmonic.P5589T1EndpointCompatibility public import LeanPool.ApollonianSuperharmonic.P5589T1UnitInterfaceSelection public import LeanPool.ApollonianSuperharmonic.P5589T1LinkedUnitValues diff --git a/LeanPool/ApollonianSuperharmonic/P5596T1LineParent.lean b/LeanPool/ApollonianSuperharmonic/P5596T1LineParent.lean index 310443e855..8a34540961 100644 --- a/LeanPool/ApollonianSuperharmonic/P5596T1LineParent.lean +++ b/LeanPool/ApollonianSuperharmonic/P5596T1LineParent.lean @@ -5,14 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5596T1CommonExtensionTransport public import LeanPool.ApollonianSuperharmonic.P5332T1LiteralNormalization -public import LeanPool.ApollonianSuperharmonic.FordOdometerFamilyExistsUnique public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable -public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse -public import LeanPool.ApollonianSuperharmonic.FordCoordinateConfiguration public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -- [TABLET NODE: P5596T1LineParent] diff --git a/LeanPool/ApollonianSuperharmonic/P5606T1RightTerminalTransport.lean b/LeanPool/ApollonianSuperharmonic/P5606T1RightTerminalTransport.lean index 03c7e361d1..80b7f4b13d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5606T1RightTerminalTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/P5606T1RightTerminalTransport.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5596T1CommonExtensionTransport public import LeanPool.ApollonianSuperharmonic.FordTerminalWebStencilLedger public import LeanPool.ApollonianSuperharmonic.DiamondTerminalWebStencilLedger diff --git a/LeanPool/ApollonianSuperharmonic/P5606T1SubtileTerminalTransport.lean b/LeanPool/ApollonianSuperharmonic/P5606T1SubtileTerminalTransport.lean index a83ec2c9dd..d7d2f63ab5 100644 --- a/LeanPool/ApollonianSuperharmonic/P5606T1SubtileTerminalTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/P5606T1SubtileTerminalTransport.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5596T1CommonExtensionTransport public import LeanPool.ApollonianSuperharmonic.FordTerminalWebStencilLedger public import LeanPool.ApollonianSuperharmonic.DiamondTerminalWebStencilLedger diff --git a/LeanPool/ApollonianSuperharmonic/P5617T1RectangleReachabilityAndBasepointConnectivity.lean b/LeanPool/ApollonianSuperharmonic/P5617T1RectangleReachabilityAndBasepointConnectivity.lean index 652354e6b9..2e42c8b0a3 100644 --- a/LeanPool/ApollonianSuperharmonic/P5617T1RectangleReachabilityAndBasepointConnectivity.lean +++ b/LeanPool/ApollonianSuperharmonic/P5617T1RectangleReachabilityAndBasepointConnectivity.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected -public import Mathlib.Data.List.Chain -public import Mathlib.Logic.Relation -- [TABLET NODE: P5617T1RectangleReachabilityAndBasepointConnectivity] diff --git a/LeanPool/ApollonianSuperharmonic/P5620T1BoundaryComponentCycle.lean b/LeanPool/ApollonianSuperharmonic/P5620T1BoundaryComponentCycle.lean index d2e28b42e4..5d475c0a02 100644 --- a/LeanPool/ApollonianSuperharmonic/P5620T1BoundaryComponentCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/P5620T1BoundaryComponentCycle.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.FiniteCycleComponentList public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent diff --git a/LeanPool/ApollonianSuperharmonic/P5625T1CentroidSlopeDifferenceCovariance.lean b/LeanPool/ApollonianSuperharmonic/P5625T1CentroidSlopeDifferenceCovariance.lean index e7ef6e06bf..52e8eb71ad 100644 --- a/LeanPool/ApollonianSuperharmonic/P5625T1CentroidSlopeDifferenceCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/P5625T1CentroidSlopeDifferenceCovariance.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction diff --git a/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean index 96662561fb..6f1819e69d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean @@ -5,17 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizedBundleExists public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRoutedSelectedContact -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightSelectedRowGeometry public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightSelectedAdjacency public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightOuterMarkingCriterion public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMarkedSectorTransport -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryMarkedDataCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -- [TABLET NODE: P5630T1MarkedRightOdometerAdjacencyReduction] @@ -689,7 +687,9 @@ private theorem coverShape : intro a A B constructor · intro h j - fin_cases j <;> simp? [LatticeVertexIncidentCell] <;> + fin_cases j <;> simp only [LatticeVertexIncidentCell, Int.reduceNeg, Fin.mk_one, + Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, Fin.reduceFinMk, + Matrix.cons_val, Fin.zero_eta] <;> first | exact h _ (by simp) · intro h z hz rcases hz with hz | hz | hz | hz diff --git a/LeanPool/ApollonianSuperharmonic/P5630T1SymmetricMatrixPositivityCriterion.lean b/LeanPool/ApollonianSuperharmonic/P5630T1SymmetricMatrixPositivityCriterion.lean index bca55ec8ef..c88bee0cab 100644 --- a/LeanPool/ApollonianSuperharmonic/P5630T1SymmetricMatrixPositivityCriterion.lean +++ b/LeanPool/ApollonianSuperharmonic/P5630T1SymmetricMatrixPositivityCriterion.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import Mathlib.Analysis.Real.Sqrt +public import Mathlib.LinearAlgebra.Matrix.PosDef -- [TABLET NODE: P5630T1SymmetricMatrixPositivityCriterion] diff --git a/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean b/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean index b59299d865..91e7f39d41 100644 --- a/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean +++ b/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleLatticeTouching -public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge -- [TABLET NODE: P5635T1EndpointDiagonalOwnership] diff --git a/LeanPool/ApollonianSuperharmonic/P5635T1RightBoundaryInterfaceRecords.lean b/LeanPool/ApollonianSuperharmonic/P5635T1RightBoundaryInterfaceRecords.lean index e969b142fb..f140358f74 100644 --- a/LeanPool/ApollonianSuperharmonic/P5635T1RightBoundaryInterfaceRecords.lean +++ b/LeanPool/ApollonianSuperharmonic/P5635T1RightBoundaryInterfaceRecords.lean @@ -5,15 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightPlacement public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentRightEndpoint -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.P3045T1RightBoundaryDisplacementAlgebra -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: P5635T1RightBoundaryInterfaceRecords] diff --git a/LeanPool/ApollonianSuperharmonic/P5640T1NonpairedOccurrenceIntersections.lean b/LeanPool/ApollonianSuperharmonic/P5640T1NonpairedOccurrenceIntersections.lean index e895f9f25d..f352046f3d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5640T1NonpairedOccurrenceIntersections.lean +++ b/LeanPool/ApollonianSuperharmonic/P5640T1NonpairedOccurrenceIntersections.lean @@ -5,13 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation -public import LeanPool.ApollonianSuperharmonic.CellSupportedFootprintVertices public import LeanPool.ApollonianSuperharmonic.FootprintDeletionRetention public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: P5640T1NonpairedOccurrenceIntersections] diff --git a/LeanPool/ApollonianSuperharmonic/P5658T1FivePointDomainCoverSymmetryCovariance.lean b/LeanPool/ApollonianSuperharmonic/P5658T1FivePointDomainCoverSymmetryCovariance.lean index e1c513fa6a..da11f10d81 100644 --- a/LeanPool/ApollonianSuperharmonic/P5658T1FivePointDomainCoverSymmetryCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/P5658T1FivePointDomainCoverSymmetryCovariance.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction diff --git a/LeanPool/ApollonianSuperharmonic/P5662T1TriangulationBarycentricCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P5662T1TriangulationBarycentricCoordinates.lean index 5c3444bfb7..3a6d0df192 100644 --- a/LeanPool/ApollonianSuperharmonic/P5662T1TriangulationBarycentricCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P5662T1TriangulationBarycentricCoordinates.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3381T1PairedTriangulation public import LeanPool.ApollonianSuperharmonic.P3381T1AffineTriangleMap public import Mathlib.Analysis.Convex.Combination -public import Mathlib.Tactic.FinCases -public import Mathlib.Tactic.NormNum -- [TABLET NODE: P5662T1TriangulationBarycentricCoordinates] diff --git a/LeanPool/ApollonianSuperharmonic/P5667T1CyclicChildrenOldArcsPreconnected.lean b/LeanPool/ApollonianSuperharmonic/P5667T1CyclicChildrenOldArcsPreconnected.lean index 7127ba5b91..70d86b48b4 100644 --- a/LeanPool/ApollonianSuperharmonic/P5667T1CyclicChildrenOldArcsPreconnected.lean +++ b/LeanPool/ApollonianSuperharmonic/P5667T1CyclicChildrenOldArcsPreconnected.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3650T1CyclicChildren public import Mathlib.Analysis.Convex.PathConnected public import Mathlib.Analysis.Convex.Topology @@ -216,7 +218,7 @@ theorem P5667T1CyclicChildrenOldArcsPreconnected {n : Nat} (p : P3381T1PolygonBo have hfirst : C.il 0 = a := by have h := congrArg List.head? C.left_order simpa using h - have hlast : C.il (Fin.last (C.left_n + 2)) = b := by + have hlast : C.il (Fin.last (C.leftParameter + 2)) = b := by have hlast? : (List.ofFn C.il).getLast? = some (C.il (Fin.last _)) := by rw [List.getLast?_eq_getLast_of_ne_nil (by simp)] rw [List.getLast_ofFn_succ] @@ -232,19 +234,19 @@ theorem P5667T1CyclicChildrenOldArcsPreconnected {n : Nat} (p : P3381T1PolygonBo have hvfirst : C.left.vertex 0 = p.vertex a := by rw [C.left_vertex] simpa using congrArg p.vertex hfirst - have hvlast : C.left.vertex (Fin.last (C.left_n + 2)) = p.vertex b := by + have hvlast : C.left.vertex (Fin.last (C.leftParameter + 2)) = p.vertex b := by rw [C.left_vertex] simpa using congrArg p.vertex hlast have hq := polygonOldArcPreconnected C.left have heq : segment Real (C.left.vertex 0) - (C.left.vertex (Fin.last (C.left_n + 2))) = e := by + (C.left.vertex (Fin.last (C.leftParameter + 2))) = e := by rw [hvfirst, hvlast] simpa [CL, e, heq] using hq have rightArcPreconnected : IsPreconnected (CR \ e) := by have hfirst : C.ir 0 = b := by have h := congrArg List.head? C.right_order simpa using h - have hlast : C.ir (Fin.last (C.right_n + 2)) = a := by + have hlast : C.ir (Fin.last (C.rightParameter + 2)) = a := by have hlast? : (List.ofFn C.ir).getLast? = some (C.ir (Fin.last _)) := by rw [List.getLast?_eq_getLast_of_ne_nil (by simp)] rw [List.getLast_ofFn_succ] @@ -260,12 +262,12 @@ theorem P5667T1CyclicChildrenOldArcsPreconnected {n : Nat} (p : P3381T1PolygonBo have hvfirst : C.right.vertex 0 = p.vertex b := by rw [C.right_vertex] simpa using congrArg p.vertex hfirst - have hvlast : C.right.vertex (Fin.last (C.right_n + 2)) = p.vertex a := by + have hvlast : C.right.vertex (Fin.last (C.rightParameter + 2)) = p.vertex a := by rw [C.right_vertex] simpa using congrArg p.vertex hlast have hq := polygonOldArcPreconnected C.right have heq : segment Real (C.right.vertex 0) - (C.right.vertex (Fin.last (C.right_n + 2))) = e := by + (C.right.vertex (Fin.last (C.rightParameter + 2))) = e := by rw [hvfirst, hvlast] exact segment_symm Real _ _ simpa [CR, e, heq] using hq diff --git a/LeanPool/ApollonianSuperharmonic/P5667T1RoundedSupportingSlope.lean b/LeanPool/ApollonianSuperharmonic/P5667T1RoundedSupportingSlope.lean index c34f0d0884..725de40493 100644 --- a/LeanPool/ApollonianSuperharmonic/P5667T1RoundedSupportingSlope.lean +++ b/LeanPool/ApollonianSuperharmonic/P5667T1RoundedSupportingSlope.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm +public import Mathlib.LinearAlgebra.Matrix.PosDef -- [TABLET NODE: P5667T1RoundedSupportingSlope] diff --git a/LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean b/LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean index ecf211ff4c..6989c8936b 100644 --- a/LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean +++ b/LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P3934T1LocalSide public import LeanPool.ApollonianSuperharmonic.P3934T1SectorSelection public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectors diff --git a/LeanPool/ApollonianSuperharmonic/P5682T1AlignedSquareRawInterfaces.lean b/LeanPool/ApollonianSuperharmonic/P5682T1AlignedSquareRawInterfaces.lean index a401193834..0895d7fb84 100644 --- a/LeanPool/ApollonianSuperharmonic/P5682T1AlignedSquareRawInterfaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P5682T1AlignedSquareRawInterfaces.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5110T1SquareInterface public import LeanPool.ApollonianSuperharmonic.P3192T1SimplePathOrientation public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary diff --git a/LeanPool/ApollonianSuperharmonic/P5686T1UniformGlobalOdometerTransport.lean b/LeanPool/ApollonianSuperharmonic/P5686T1UniformGlobalOdometerTransport.lean index a477130903..b0cec2ded2 100644 --- a/LeanPool/ApollonianSuperharmonic/P5686T1UniformGlobalOdometerTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/P5686T1UniformGlobalOdometerTransport.lean @@ -5,14 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import Mathlib.Tactic.LinearCombination -public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -public import LeanPool.ApollonianSuperharmonic.GaussianReflection public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends -- [TABLET NODE: P5686T1UniformGlobalOdometerTransport] diff --git a/LeanPool/ApollonianSuperharmonic/P5691T1DiamondReflectionFootprints.lean b/LeanPool/ApollonianSuperharmonic/P5691T1DiamondReflectionFootprints.lean index f689c4cbba..05034a5cdb 100644 --- a/LeanPool/ApollonianSuperharmonic/P5691T1DiamondReflectionFootprints.lean +++ b/LeanPool/ApollonianSuperharmonic/P5691T1DiamondReflectionFootprints.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondCellRows public import LeanPool.ApollonianSuperharmonic.DiamondTile public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas diff --git a/LeanPool/ApollonianSuperharmonic/P5691T1PosDefQuadraticLowerBound.lean b/LeanPool/ApollonianSuperharmonic/P5691T1PosDefQuadraticLowerBound.lean index 44f5fa92c9..2743dda867 100644 --- a/LeanPool/ApollonianSuperharmonic/P5691T1PosDefQuadraticLowerBound.lean +++ b/LeanPool/ApollonianSuperharmonic/P5691T1PosDefQuadraticLowerBound.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm public import Mathlib.LinearAlgebra.Matrix.PosDef diff --git a/LeanPool/ApollonianSuperharmonic/PSDQuadraticIntegerApproximation.lean b/LeanPool/ApollonianSuperharmonic/PSDQuadraticIntegerApproximation.lean index 8caeadab79..7b91ac0c76 100644 --- a/LeanPool/ApollonianSuperharmonic/PSDQuadraticIntegerApproximation.lean +++ b/LeanPool/ApollonianSuperharmonic/PSDQuadraticIntegerApproximation.lean @@ -5,13 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import Mathlib.Order.Int.LeastGreatest public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import LeanPool.ApollonianSuperharmonic.IntegerLaplacianCastBridge public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm public import LeanPool.ApollonianSuperharmonic.RealLaplacianContactComparison -public import LeanPool.ApollonianSuperharmonic.RealLaplacianLinearity public import LeanPool.ApollonianSuperharmonic.P5667T1RoundedSupportingSlope -- [TABLET NODE: PSDQuadraticIntegerApproximation] diff --git a/LeanPool/ApollonianSuperharmonic/ParentVectorsInTilingLattice.lean b/LeanPool/ApollonianSuperharmonic/ParentVectorsInTilingLattice.lean index 6f10a97abb..8017d8534f 100644 --- a/LeanPool/ApollonianSuperharmonic/ParentVectorsInTilingLattice.lean +++ b/LeanPool/ApollonianSuperharmonic/ParentVectorsInTilingLattice.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TilingLattice -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: ParentVectorsInTilingLattice] diff --git a/LeanPool/ApollonianSuperharmonic/ParentalOrientationGluing.lean b/LeanPool/ApollonianSuperharmonic/ParentalOrientationGluing.lean index de3f9d37a9..f1e885de61 100644 --- a/LeanPool/ApollonianSuperharmonic/ParentalOrientationGluing.lean +++ b/LeanPool/ApollonianSuperharmonic/ParentalOrientationGluing.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation -- [TABLET NODE: ParentalOrientationGluing] @@ -27,8 +29,8 @@ private theorem incoming_one : AcyclicIndegreeOrientation D₁ σ), (∀ x ∈ D₁ ∩ D₂, ∀ y ∈ D₁, o₁.edge y x → y ∈ D₂) → let I := D₁ ∩ D₂ ∀ x ∈ I, - (D₁.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))) = - (I.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))) := by + (D₁.filter (fun y => @decide (o₁.edge y x) (o₁.edgeDecidable y x))) = + (I.filter (fun y => @decide (o₁.edge y x) (o₁.edgeDecidable y x))) := by classical intro D₁ D₂ σ o₁ hclosed₁ I x hx change x ∈ D₁ ∩ D₂ at hx @@ -39,7 +41,7 @@ private theorem incoming_one : refine ⟨Finset.mem_inter.mpr ⟨h.1, ?_⟩, h.2⟩ exact hclosed₁ x hx y h.1 - (@of_decide_eq_true (o₁.edge y x) (o₁.edge_decidable y x) h.2) + (@of_decide_eq_true (o₁.edge y x) (o₁.edgeDecidable y x) h.2) · intro h exact ⟨(Finset.mem_inter.mp (show y ∈ D₁ ∩ D₂ from h.1)).1, h.2⟩ @@ -48,8 +50,8 @@ private theorem incoming_two : AcyclicIndegreeOrientation D₂ σ), (∀ x ∈ D₁ ∩ D₂, ∀ y ∈ D₂, o₂.edge y x → y ∈ D₁) → let I := D₁ ∩ D₂ ∀ x ∈ I, - (D₂.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x))) = - (I.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x))) := by + (D₂.filter (fun y => @decide (o₂.edge y x) (o₂.edgeDecidable y x))) = + (I.filter (fun y => @decide (o₂.edge y x) (o₂.edgeDecidable y x))) := by classical intro D₁ D₂ σ o₂ hclosed₂ I x hx change x ∈ D₁ ∩ D₂ at hx @@ -60,7 +62,7 @@ private theorem incoming_two : refine ⟨Finset.mem_inter.mpr ⟨?_, h.1⟩, h.2⟩ exact hclosed₂ x hx y h.1 - (@of_decide_eq_true (o₂.edge y x) (o₂.edge_decidable y x) h.2) + (@of_decide_eq_true (o₂.edge y x) (o₂.edgeDecidable y x) h.2) · intro h exact ⟨(Finset.mem_inter.mp (show y ∈ D₁ ∩ D₂ from h.1)).2, h.2⟩ @@ -68,12 +70,12 @@ private theorem incoming_card : ∀ (D₁ : Finset GaussianInt), ∀ (D₂ : Finset GaussianInt), ∀ (σ : GaussianInt → ℤ), ∀ (o₁ : AcyclicIndegreeOrientation D₁ σ), ∀ (o₂ : AcyclicIndegreeOrientation D₂ σ), let I := D₁ ∩ D₂ - (∀ x ∈ I, (D₁.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))) = (I.filter - (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x)))) → (∀ x ∈ I, (D₂.filter (fun y - => @decide (o₂.edge y x) (o₂.edge_decidable y x))) = (I.filter (fun y => @decide (o₂.edge - y x) (o₂.edge_decidable y x)))) → ∀ x ∈ I, - (I.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))).card = - (I.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x))).card := by + (∀ x ∈ I, (D₁.filter (fun y => @decide (o₁.edge y x) (o₁.edgeDecidable y x))) = (I.filter + (fun y => @decide (o₁.edge y x) (o₁.edgeDecidable y x)))) → (∀ x ∈ I, (D₂.filter (fun y + => @decide (o₂.edge y x) (o₂.edgeDecidable y x))) = (I.filter (fun y => @decide (o₂.edge + y x) (o₂.edgeDecidable y x)))) → ∀ x ∈ I, + (I.filter (fun y => @decide (o₁.edge y x) (o₁.edgeDecidable y x))).card = + (I.filter (fun y => @decide (o₂.edge y x) (o₂.edgeDecidable y x))).card := by classical intro D₁ D₂ σ o₁ o₂ I incoming_one incoming_two x hx change x ∈ D₁ ∩ D₂ at hx @@ -88,8 +90,8 @@ private theorem agreement : ∀ (D₁ : Finset GaussianInt), ∀ (D₂ : Finset GaussianInt), ∀ (σ : GaussianInt → ℤ), ∀ (o₁ : AcyclicIndegreeOrientation D₁ σ), ∀ (o₂ : AcyclicIndegreeOrientation D₂ σ), let I := D₁ ∩ D₂ - (∀ x ∈ I, (I.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))).card = - (I.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x))).card) → + (∀ x ∈ I, (I.filter (fun y => @decide (o₁.edge y x) (o₁.edgeDecidable y x))).card = + (I.filter (fun y => @decide (o₂.edge y x) (o₂.edgeDecidable y x))).card) → ∀ x ∈ I, ∀ y ∈ I, o₁.edge x y ↔ o₂.edge x y := by classical intro D₁ D₂ σ o₁ o₂ I incoming_card @@ -111,26 +113,26 @@ private theorem agreement : intro he exact hn (he ▸ hwz)⟩⟩ exact (Nat.not_lt_of_ge (hmin w hwb)) (o₁.increasing w z hwz) - have hsub : I.filter (fun w => @decide (o₁.edge w z) (o₁.edge_decidable w z)) ⊆ - I.filter (fun w => @decide (o₂.edge w z) (o₂.edge_decidable w z)) := by + have hsub : I.filter (fun w => @decide (o₁.edge w z) (o₁.edgeDecidable w z)) ⊆ + I.filter (fun w => @decide (o₂.edge w z) (o₂.edgeDecidable w z)) := by intro w hw have hwI := (Finset.mem_filter.mp hw).1 have he := (Finset.mem_filter.mp hw).2 have he' : o₁.edge w z := @of_decide_eq_true (o₁.edge w z) - (o₁.edge_decidable w z) he + (o₁.edgeDecidable w z) he have ho := hin w hwI he' - have hot : @decide (o₂.edge w z) (o₂.edge_decidable w z) = true := by - exact (show @decide (o₂.edge w z) (o₂.edge_decidable w z) = true from - (@decide_eq_true_eq (o₂.edge w z) (o₂.edge_decidable w z)).mpr ho) + have hot : @decide (o₂.edge w z) (o₂.edgeDecidable w z) = true := by + exact (show @decide (o₂.edge w z) (o₂.edgeDecidable w z) = true from + (@decide_eq_true_eq (o₂.edge w z) (o₂.edgeDecidable w z)).mpr ho) exact Finset.mem_filter.mpr ⟨hwI, hot⟩ have heq := Finset.eq_of_subset_of_card_le hsub (by rw [incoming_card z (Finset.mem_filter.mp hz).1]) have hback : ∀ w ∈ I, o₂.edge w z → o₁.edge w z := by intro w hw hwz - have hm : w ∈ I.filter (fun q => @decide (o₂.edge q z) (o₂.edge_decidable q z)) := + have hm : w ∈ I.filter (fun q => @decide (o₂.edge q z) (o₂.edgeDecidable q z)) := Finset.mem_filter.mpr ⟨hw, by simp [hwz]⟩ have hm' := heq ▸ hm - exact @of_decide_eq_true (o₁.edge w z) (o₁.edge_decidable w z) + exact @of_decide_eq_true (o₁.edge w z) (o₁.edgeDecidable w z) (Finset.mem_filter.mp hm').2 have hzall : ∀ w ∈ I, o₁.edge w z ↔ o₂.edge w z := by intro w hw @@ -305,7 +307,7 @@ private theorem rank_increasing : have hyI : y ∈ I ↔ y ∈ D₂ := by simp [I, h1.2] by_cases hx' : x ∈ I · by_cases hy' : y ∈ I - · simp? [rank, hx', hy'] + · simp only [hx', ↓reduceIte, hy', gt_iff_lt, rank] exact o₁.increasing x y he · simp [rank, hx', hy', h1.2] have hm : 0 < M := by simp [M] @@ -316,22 +318,22 @@ private theorem rank_increasing : · by_cases hy' : y ∈ I · have hbad : x ∈ D₂ := hclosed₁ y hy' x h1.1 he exact (hx' (Finset.mem_inter.mpr ⟨h1.1, hbad⟩)).elim - · simp? [rank, hx', hy', h1.1, h1.2] + · simp only [hx', ↓reduceIte, h1.1, hy', h1.2, add_lt_add_iff_right, gt_iff_lt, rank] exact o₁.increasing x y he · by_cases h2 : x ∈ D₂ ∧ y ∈ D₂ · have he := (by simpa [edge, h1, h2] using hxy : o₂.edge x y) by_cases hx' : x ∈ I · by_cases hy' : y ∈ I - · simp? [rank, hx', hy'] + · simp only [hx', ↓reduceIte, hy', gt_iff_lt, rank] exact o₁.increasing x y ((agreement x hx' y hy').2 he) - · simp? [rank, hx', hy'] + · simp only [hx', ↓reduceIte, hy', gt_iff_lt, rank] by_cases hyD1 : y ∈ D₁ · simp [hyD1] have hp := rank_one_bound x (Finset.mem_inter.mp (show x ∈ D₁ ∩ D₂ from hx')).1 have hm : 0 < M := by simp [M] simp [M] at * omega - · simp? [hyD1] + · simp only [hyD1, ↓reduceIte] have hp := rank_one_bound x (Finset.mem_inter.mp (show x ∈ D₁ ∩ D₂ from hx')).1 have hm : 0 < M := by simp [M] simp [M] at * @@ -343,7 +345,7 @@ private theorem rank_increasing : intro q; exact hy' (Finset.mem_inter.mpr ⟨q, h2.2⟩) have hxD1 : ¬ x ∈ D₁ := by intro q; exact hx' (Finset.mem_inter.mpr ⟨q, h2.1⟩) - simp? [rank, hx', hy', hyD1, hxD1] + simp only [hx', ↓reduceIte, hxD1, hy', hyD1, add_lt_add_iff_right, gt_iff_lt, rank] exact o₂.increasing x y he · simp [edge, h1, h2] at hxy @@ -367,16 +369,16 @@ theorem ParentalOrientationGluing let I := D₁ ∩ D₂ let U := D₁ ∪ D₂ have incoming_one : ∀ x ∈ I, - (D₁.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))) = - (I.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))) := + (D₁.filter (fun y => @decide (o₁.edge y x) (o₁.edgeDecidable y x))) = + (I.filter (fun y => @decide (o₁.edge y x) (o₁.edgeDecidable y x))) := ParentalOrientationLemmas.incoming_one D₁ D₂ σ o₁ hclosed₁ have incoming_two : ∀ x ∈ I, - (D₂.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x))) = - (I.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x))) := + (D₂.filter (fun y => @decide (o₂.edge y x) (o₂.edgeDecidable y x))) = + (I.filter (fun y => @decide (o₂.edge y x) (o₂.edgeDecidable y x))) := ParentalOrientationLemmas.incoming_two D₁ D₂ σ o₂ hclosed₂ have incoming_card : ∀ x ∈ I, - (I.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x))).card = - (I.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x))).card := + (I.filter (fun y => @decide (o₁.edge y x) (o₁.edgeDecidable y x))).card = + (I.filter (fun y => @decide (o₂.edge y x) (o₂.edgeDecidable y x))).card := ParentalOrientationLemmas.incoming_card D₁ D₂ σ o₁ o₂ incoming_one incoming_two let B := I.filter (fun x => ∃ y ∈ I, o₁.edge x y ≠ o₂.edge x y) have agreement : ∀ x ∈ I, ∀ y ∈ I, o₁.edge x y ↔ o₂.edge x y := @@ -406,7 +408,7 @@ theorem ParentalOrientationGluing rank_one_bound let o : AcyclicIndegreeOrientation U σ := { edge := edge - edge_decidable := fun x y => Classical.propDecidable _ + edgeDecidable := fun x y => Classical.propDecidable _ rank := rank supported := edge_support oriented := edge_oriented @@ -416,7 +418,7 @@ theorem ParentalOrientationGluing by_cases hx1 : x ∈ D₁ · have hi := o₁.indegree x hx1 have hf : U.filter (fun y => @decide (edge y x) (Classical.propDecidable _)) = - D₁.filter (fun y => @decide (o₁.edge y x) (o₁.edge_decidable y x)) := by + D₁.filter (fun y => @decide (o₁.edge y x) (o₁.edgeDecidable y x)) := by ext y simp only [Finset.mem_filter] constructor @@ -440,7 +442,7 @@ theorem ParentalOrientationGluing · have hx2 : x ∈ D₂ := Finset.mem_union.mp hx |>.resolve_left hx1 have hi := o₂.indegree x hx2 have hf : U.filter (fun y => @decide (edge y x) (Classical.propDecidable _)) = - D₂.filter (fun y => @decide (o₂.edge y x) (o₂.edge_decidable y x)) := by + D₂.filter (fun y => @decide (o₂.edge y x) (o₂.edgeDecidable y x)) := by ext y simp only [Finset.mem_filter] constructor diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometer.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometer.lean index 7a6ded71e5..1ba051eb0a 100644 --- a/LeanPool/ApollonianSuperharmonic/PartialOdometer.lean +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometer.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction -- [TABLET NODE: PartialOdometer] diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslate.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslate.lean index 7fa48b6ed5..3b70d15acb 100644 --- a/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslate.lean +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslate.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GaussianTranslation public import LeanPool.ApollonianSuperharmonic.PartialOdometer diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslateFormulas.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslateFormulas.lean index cd50653bc0..9333a75ff3 100644 --- a/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslateFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslateFormulas.lean @@ -5,11 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslate -public import LeanPool.ApollonianSuperharmonic.PartialOdometer -public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope -public import LeanPool.ApollonianSuperharmonic.GaussianTranslation public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: PartialOdometerAffineTranslateFormulas] diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurn.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurn.lean index f82c868b10..88319017d6 100644 --- a/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurn.lean +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurn.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PartialOdometer -- [TABLET NODE: PartialOdometerHalfTurn] diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurnFormulas.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurnFormulas.lean index c77d12e221..0e1716b6d4 100644 --- a/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurnFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurnFormulas.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurn public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope -public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares -- [TABLET NODE: PartialOdometerHalfTurnFormulas] diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometerSlope.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometerSlope.lean index f0dcb76f38..468e7a4d12 100644 --- a/LeanPool/ApollonianSuperharmonic/PartialOdometerSlope.lean +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometerSlope.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares -- [TABLET NODE: PartialOdometerSlope] diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometerSquares.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometerSquares.lean index 893032bf13..1490a2d5f5 100644 --- a/LeanPool/ApollonianSuperharmonic/PartialOdometerSquares.lean +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometerSquares.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PartialOdometer -- [TABLET NODE: PartialOdometerSquares] diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean index 06698a14c0..6acefe96ee 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean @@ -5,13 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.LambdaTiling -public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary +public import LeanPool.ApollonianSuperharmonic.RegularTileFamily -- [TABLET NODE: PeriodicBoundaryWebConnected] @@ -439,7 +437,7 @@ private theorem pathConcat : have hzy : z' = y := Option.some.inj (by simpa using hqlast) have hzz : z' = z := Option.some.inj (by simpa using hqhead) have hzy' : z = y := hzz.symm.trans hzy - simp? [r, hplast] + simp only [List.tail_cons, List.append_nil, hplast, Option.some.injEq, r] rw [hzy'] | cons w ws => have hqs : (w :: ws).getLast? = some y := by simpa using hqlast diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean index 77fcdddd4d..43000ecbcd 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean @@ -5,33 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AffineTriangularNoFourfoldCellOwners -public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData -public import LeanPool.ApollonianSuperharmonic.BandGenealogy -public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.CircleMatrix -public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector -public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -public import LeanPool.ApollonianSuperharmonic.LeftAdjacentOdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.OdometerWeb -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex -public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import LeanPool.ApollonianSuperharmonic.TilingLattice -- [TABLET NODE: PeriodicBoundaryWebLaplacian] diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean b/LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean index 03414b1b5e..875c956410 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandTileAcyclicIndegree public import LeanPool.ApollonianSuperharmonic.FiniteAcyclicOrientationObstruction public import LeanPool.ApollonianSuperharmonic.PeriodicBoundaryWebConnected -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: PeriodicOdometerIndicatorRigidity] diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicQuadraticRemainder.lean b/LeanPool/ApollonianSuperharmonic/PeriodicQuadraticRemainder.lean index e5d6cabb6d..c9a7c36c2e 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicQuadraticRemainder.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicQuadraticRemainder.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm -public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis -public import LeanPool.ApollonianSuperharmonic.TilingLatticeCocycleExtension +public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureGeneratorCocycles -- [TABLET NODE: PeriodicQuadraticRemainder] @@ -90,7 +91,9 @@ theorem PeriodicQuadraticRemainder (C : BandCircle) · intro mn hm have hr := congrArg (fun z : GaussianInt => z.re) hm have hi := congrArg (fun z : GaussianInt => z.im) hm - simp? at hr hi + simp only [Int.reduceNeg, mul_one, Zsqrtd.smul_val, mul_zero, Zsqrtd.re_add, + Zsqrtd.re_intCast, add_zero, Zsqrtd.im_add, Zsqrtd.im_intCast, zero_add] + at hr hi exact Prod.ext (by exact_mod_cast hr) (by exact_mod_cast hi) · have hpos := C.2 have hgt : 1 < C.1.1.1 := by omega diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicSubtileFaceIndex.lean b/LeanPool/ApollonianSuperharmonic/PeriodicSubtileFaceIndex.lean index 375f125b45..b1170059c3 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicSubtileFaceIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicSubtileFaceIndex.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Order.Ring.Int + public import LeanPool.ApollonianSuperharmonic.SixSubtileFaceLabel -- [TABLET NODE: PeriodicSubtileFaceIndex] diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicSubtileIndex.lean b/LeanPool/ApollonianSuperharmonic/PeriodicSubtileIndex.lean index 944ed72922..3d6cdf93dc 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicSubtileIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicSubtileIndex.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Order.Ring.Int + public import LeanPool.ApollonianSuperharmonic.SixSubtileLabel -- [TABLET NODE: PeriodicSubtileIndex] diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileAdjacentContactRegularity.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileAdjacentContactRegularity.lean index d4e4a118f9..4d8c53052b 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileAdjacentContactRegularity.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileAdjacentContactRegularity.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileComplex.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileComplex.lean index fe6c9caaf1..b1912e9b1c 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileComplex.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileComplex.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore public import LeanPool.ApollonianSuperharmonic.TileArea -public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices -- [TABLET NODE: PeriodicTileComplex] diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRouting.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRouting.lean index 04a4d5ee0a..781666edfd 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRouting.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRouting.lean @@ -5,9 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex -public import LeanPool.ApollonianSuperharmonic.TileRealization -public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -- [TABLET NODE: PeriodicTileContactRouting] diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRoutingRigidity.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRoutingRigidity.lean index 7e27fb7967..260855958c 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRoutingRigidity.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRoutingRigidity.lean @@ -5,14 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PlaneEmbeddingAgreement public import LeanPool.ApollonianSuperharmonic.P3723T1ContactPortsExist public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactDrawingExists public import LeanPool.ApollonianSuperharmonic.P3861T1RoutedFacialDomains public import LeanPool.ApollonianSuperharmonic.P3861T1RoutedFaceOrientation public import LeanPool.ApollonianSuperharmonic.P3861T1ExtraArcLocalization -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.FinCases -- [TABLET NODE: PeriodicTileContactRoutingRigidity] diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileCore.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileCore.lean index e2598efae6..9ff9023acf 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileCore.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileCore.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileCoverage.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileCoverage.lean index c04b6bed86..ddbae4404f 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileCoverage.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicTileCore public import LeanPool.ApollonianSuperharmonic.P3776T1PlaneMapExists public import LeanPool.ApollonianSuperharmonic.P3776T1EquivariantDisplacementBound diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileIndexedMultiplicityOne.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileIndexedMultiplicityOne.lean index c650e69316..b5f833b966 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileIndexedMultiplicityOne.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileIndexedMultiplicityOne.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicTileCoverage public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionClassification.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionClassification.lean index 6662b9240a..f102607399 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionClassification.lean @@ -5,28 +5,16 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FinitePatchTopology -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure public import LeanPool.ApollonianSuperharmonic.LatticeTileDiskUnionInterface -public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex public import LeanPool.ApollonianSuperharmonic.PeriodicTileAdjacentContactRegularity -public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex public import LeanPool.ApollonianSuperharmonic.PeriodicTileContactRoutingRigidity -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne public import LeanPool.ApollonianSuperharmonic.P3963T1DeletedPairExteriorConnected public import LeanPool.ApollonianSuperharmonic.P3963T1EdgeFreeDiskCorners -public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation -public import LeanPool.ApollonianSuperharmonic.ProtoTile -public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle public import LeanPool.ApollonianSuperharmonic.SimpleGridPath -public import LeanPool.ApollonianSuperharmonic.TileRealization -- [TABLET NODE: PeriodicTileIntersectionClassification] diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionPaths.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionPaths.lean index 079aad1018..d24f2d4fe7 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionPaths.lean @@ -5,18 +5,15 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicTileAdjacentContactRegularity public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors public import LeanPool.ApollonianSuperharmonic.P3192T1SimplePathOrientation public import LeanPool.ApollonianSuperharmonic.P3192T1FourOwnerTriangleExclusion public import LeanPool.ApollonianSuperharmonic.P3192T1PeriodicIndicesInfinite -public import LeanPool.ApollonianSuperharmonic.P3767T1FixedFaceComponents -public import LeanPool.ApollonianSuperharmonic.P3821T1ThreeArcCircle -public import LeanPool.ApollonianSuperharmonic.P3821T1CircleComponentBound -- [TABLET NODE: PeriodicTileIntersectionPaths] diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileMultiplicityOne.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileMultiplicityOne.lean index 0e4739e3ea..c2ca638354 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileMultiplicityOne.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileMultiplicityOne.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ExactTileTiling public import LeanPool.ApollonianSuperharmonic.PeriodicTileComplex public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean index 110a8368b7..720e73ba6b 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean @@ -5,29 +5,20 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandCircleEuclideanData -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.CircleMatrix public import LeanPool.ApollonianSuperharmonic.ExactTileTiling -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm -public import LeanPool.ApollonianSuperharmonic.LatticeTile -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure public import LeanPool.ApollonianSuperharmonic.PartialOdometer -public import LeanPool.ApollonianSuperharmonic.ProtoTile public import LeanPool.ApollonianSuperharmonic.RegularTileFamily -public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle -public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex -public import LeanPool.ApollonianSuperharmonic.LatticeTileGridEulerCount public import LeanPool.ApollonianSuperharmonic.QuadraticAffineLaplacian public import LeanPool.ApollonianSuperharmonic.RealLaplacianLinearity public import LeanPool.ApollonianSuperharmonic.IntegerLaplacianCastBridge -public import LeanPool.ApollonianSuperharmonic.FiniteSquareIncidenceIdentities -- [TABLET NODE: PeriodicTileTotalIndegree] @@ -1836,7 +1827,7 @@ private theorem hB_lap : apply Finset.sum_congr rfl intro x hx have hx' : x ∈ BoundaryFootprintVertices T := by - simp? [B, Finset.mem_filter] at hx + simp only [Finset.mem_filter, B] at hx exact hx.2 rw [hweb x hx'] norm_num diff --git a/LeanPool/ApollonianSuperharmonic/PlaneEmbeddingAgreement.lean b/LeanPool/ApollonianSuperharmonic/PlaneEmbeddingAgreement.lean index df0bc253f6..650c2ed061 100644 --- a/LeanPool/ApollonianSuperharmonic/PlaneEmbeddingAgreement.lean +++ b/LeanPool/ApollonianSuperharmonic/PlaneEmbeddingAgreement.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PeriodicTileContactRouting public import LeanPool.ApollonianSuperharmonic.PlaneFaceOrientation diff --git a/LeanPool/ApollonianSuperharmonic/PlaneFaceOrientation.lean b/LeanPool/ApollonianSuperharmonic/PlaneFaceOrientation.lean index ee454e4ce5..53045cb6b3 100644 --- a/LeanPool/ApollonianSuperharmonic/PlaneFaceOrientation.lean +++ b/LeanPool/ApollonianSuperharmonic/PlaneFaceOrientation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation -- [TABLET NODE: PlaneFaceOrientation] diff --git a/LeanPool/ApollonianSuperharmonic/PlaneTriangulation.lean b/LeanPool/ApollonianSuperharmonic/PlaneTriangulation.lean index 119f22c53d..73de9ce48f 100644 --- a/LeanPool/ApollonianSuperharmonic/PlaneTriangulation.lean +++ b/LeanPool/ApollonianSuperharmonic/PlaneTriangulation.lean @@ -5,7 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Topology.MetricSpace.Pseudo.Constructions +public import Mathlib.Topology.MetricSpace.Pseudo.Real +public import Mathlib.Basic.Real.Basic +public import Mathlib.Data.Set.Finite.Basic +public import Mathlib.Tactic.NormNum + -- [TABLET NODE: PlaneTriangulation] diff --git a/LeanPool/ApollonianSuperharmonic/PointwiseDiagonalCompactness.lean b/LeanPool/ApollonianSuperharmonic/PointwiseDiagonalCompactness.lean index 4aa09e855e..5b79dfbac0 100644 --- a/LeanPool/ApollonianSuperharmonic/PointwiseDiagonalCompactness.lean +++ b/LeanPool/ApollonianSuperharmonic/PointwiseDiagonalCompactness.lean @@ -5,14 +5,15 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import Mathlib.Topology.Algebra.Ring.Real -public import Mathlib.Topology.Instances.Matrix -public import Mathlib.Topology.MetricSpace.ProperSpace.Real public import Mathlib.Topology.Sequences public import LeanPool.ApollonianSuperharmonic.IntegerLaplacianCastBridge public import LeanPool.ApollonianSuperharmonic.LocalExponentialEstimate public import LeanPool.ApollonianSuperharmonic.QuadraticAffineLaplacian public import LeanPool.ApollonianSuperharmonic.RealLaplacianLinearity +public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: PointwiseDiagonalCompactness] @@ -196,8 +197,13 @@ private theorem hub : have hb1 := hb k 1 dsimp [w] at hw dsimp [w] at hp - simp? [LatticeQuadraticForm, Matrix.mulVec, dotProduct] at hw ⊢ - simp? [LatticeQuadraticForm, Matrix.mulVec, dotProduct] at hp + simp only [LatticeQuadraticForm, one_div, dotProduct, Int.reduceNeg, GaussianInt.intCast_re, + GaussianInt.intCast_im, Matrix.mulVec, Fin.sum_univ_two, Fin.isValue, + Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val_fin_one, mul_zero, zero_add, + tsub_le_iff_right, ge_iff_le] at hw ⊢ + simp only [LatticeQuadraticForm, one_div, dotProduct, Int.reduceNeg, GaussianInt.intCast_re, + GaussianInt.intCast_im, Matrix.mulVec, Fin.sum_univ_two, Fin.isValue, + Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val_fin_one, sub_nonneg] at hp have e00 : |B k 0 0| ≤ |l00| + |u00| := by rw [abs_le] constructor <;> nlinarith [h00'.1, h00'.2, neg_le_abs l00, neg_le_abs u00, @@ -782,7 +788,8 @@ theorem PointwiseDiagonalCompactness : have e2 := h2 K (by dsimp [K]; omega) have e3 := h3 K (by dsimp [K]; omega) have e4 := h4 K (by dsimp [K]; omega) - simp? [FourNeighborLaplacian, e0, e1, e2, e3, e4] at hu ⊢ + simp only [FourNeighborLaplacian, e1, e2, Int.reduceNeg, e3, e4, e0, tsub_le_iff_right, + ge_iff_le] at hu ⊢ exact hu · intro x have h00 := (hconv 0 0).comp output_mono.tendsto_atTop diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean index 7f1ed857f5..d047e83c5e 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.OdometerGluing +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTranslatedOdometers public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends -public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation +public import LeanPool.ApollonianSuperharmonic.BandTileTopologyApplication -- [TABLET NODE: PositiveCurvatureGeneratorCocycles] @@ -460,7 +461,9 @@ theorem PositiveCurvatureGeneratorCocycles (C : BandCircle) (BandVectors.1 (q 3) (q 0)) (BandVectors.2 (q 3) (q 0)) (by have rr := rel.1 - simp? [Fin.sum_univ_succ] at rr + simp only [Fin.isValue, Fin.sum_univ_succ, Fin.succ_zero_eq_one, + Fin.succ_one_eq_two, Finset.univ_unique, Fin.default_eq_zero, + Finset.sum_singleton, Fin.reduceSucc] at rr have hv : BandVectors.1 (q 3) (q 0) = -(BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0)) := GeneratorCocycleGeometry.hvAt384 q rr @@ -470,7 +473,9 @@ theorem PositiveCurvatureGeneratorCocycles (C : BandCircle) ring) (by have rr := rel.2 - simp? [Fin.sum_univ_succ] at rr + simp only [Fin.isValue, Fin.sum_univ_succ, Fin.succ_zero_eq_one, + Fin.succ_one_eq_two, Finset.univ_unique, Fin.default_eq_zero, + Finset.sum_singleton, Fin.reduceSucc] at rr have hv : BandVectors.2 (q 3) (q 0) = -(BandVectors.2 (q 1) (q 0) + BandVectors.2 (q 2) (q 0)) := GeneratorCocycleGeometry.hvAt395 q rr diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerDomain.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerDomain.lean index fecf46ce64..81e51f5b8f 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerDomain.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerDomain.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileOdometer -- [TABLET NODE: PositiveCurvatureTileOdometerDomain] diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerSupportTransport.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerSupportTransport.lean index f7d560f8fa..531521e64c 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerSupportTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerSupportTransport.lean @@ -5,12 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandCircle -public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileOdometer -- [TABLET NODE: PositiveCurvatureTileOdometerSupportTransport] diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean index 78359f2391..f775f6f4a7 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean @@ -5,26 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandGenealogy -public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex -public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector -public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation -public import LeanPool.ApollonianSuperharmonic.LeftAdjacentOdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.LambdaTiling -public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation public import LeanPool.ApollonianSuperharmonic.TileOdometerExists -public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis -- [TABLET NODE: PositiveCurvatureTranslatedOdometers] @@ -512,15 +497,18 @@ private theorem adjacentCompatibility : ((BandVectors.1 (q i.succ) (q 0)).im : ℝ) := PositiveTranslationGeometry.hi'At344 C q lattice_coords kl mn i hi apply Prod.ext - · simp? [GaussianRealPoint] + · simp only [Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, + Prod.mk_sub_mk, add_sub_add_left_eq_sub, GaussianRealPoint, Fin.isValue, one_smul] rw [← GaussianInt.intCast_re, ← GaussianInt.intCast_re, ← GaussianInt.intCast_re] linarith - · simp? [GaussianRealPoint] + · simp only [Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, + Prod.mk_sub_mk, add_sub_add_left_eq_sub, GaussianRealPoint, Fin.isValue, one_smul] rw [← GaussianInt.intCast_im, ← GaussianInt.intCast_im, ← GaussianInt.intCast_im] linarith - · simp? [] + · simp only [Int.reduceNeg, GaussianInt.intCast_re, add_sub_add_left_eq_sub, ↓reduceIte, + Fin.isValue, one_mul] rw [← GaussianInt.intCast_re, ← GaussianInt.intCast_re, ← GaussianInt.intCast_re] have hslope := slope_step kl mn i hstep @@ -529,7 +517,8 @@ private theorem adjacentCompatibility : ((BandVectors.2 (q i.succ) (q 0)).re : ℝ) := PositiveTranslationGeometry.hr'At361 q kl mn i hr linarith - · simp? [] + · simp only [Int.reduceNeg, GaussianInt.intCast_im, add_sub_add_left_eq_sub, ↓reduceIte, + Fin.isValue, one_mul] rw [← GaussianInt.intCast_im, ← GaussianInt.intCast_im, ← GaussianInt.intCast_im] have hslope := slope_step kl mn i hstep @@ -567,7 +556,9 @@ private theorem adjacentCompatibility : have hr := congrArg (fun z : GaussianInt => z.re) hstep'' have hi := congrArg (fun z : GaussianInt => z.im) hstep'' apply Prod.ext - · simp? [GaussianRealPoint] + · simp only [Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, + Prod.mk_sub_mk, add_sub_add_left_eq_sub, Bool.false_eq_true, ↓reduceIte, + GaussianRealPoint, Fin.isValue, neg_smul, one_smul, Prod.neg_mk] rw [← GaussianInt.intCast_re, ← GaussianInt.intCast_re, ← GaussianInt.intCast_re] have hr' : ((shift mn).re : ℝ) - (shift kl).re = @@ -577,7 +568,9 @@ private theorem adjacentCompatibility : rw [← GaussianInt.intCast_re, ← GaussianInt.intCast_re, ← GaussianInt.intCast_re] at hr' linarith - · simp? [GaussianRealPoint] + · simp only [Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, + Prod.mk_sub_mk, add_sub_add_left_eq_sub, Bool.false_eq_true, ↓reduceIte, + GaussianRealPoint, Fin.isValue, neg_smul, one_smul, Prod.neg_mk] rw [← GaussianInt.intCast_im, ← GaussianInt.intCast_im, ← GaussianInt.intCast_im] have hi' : ((shift mn).im : ℝ) - (shift kl).im = diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCutCompanionRow.lean b/LeanPool/ApollonianSuperharmonic/PositiveCutCompanionRow.lean index 45fbc4794e..90651afe3c 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveCutCompanionRow.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveCutCompanionRow.lean @@ -5,13 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandVectors -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.TileTranslation -- [TABLET NODE: PositiveCutCompanionRow] @@ -139,35 +136,35 @@ structure PositiveCutCompanionRow literalRow : (birth = ![q 2, birth 1, q 3, cfg.firstPredecessor 1] ∧ parentIndex = 1 ∧ rotation = 1 ∧ - x = cert.exceptional_segments.a ∧ + x = cert.exceptionalSegments.a ∧ child = cert.Q 1 true ∧ parent = cert.S 2 false) ∨ (birth = ![q 2, birth 1, q 3, cfg.firstPredecessor 1] ∧ parentIndex = 2 ∧ rotation = 0 ∧ - x = cert.exceptional_segments.a ∧ + x = cert.exceptionalSegments.a ∧ child = cert.Q 1 true ∧ parent = cert.O) ∨ (birth = ![q 2, birth 1, q 3, cfg.firstPredecessor 1] ∧ parentIndex = 1 ∧ rotation = 3 ∧ - x = cert.exceptional_segments.b ∧ + x = cert.exceptionalSegments.b ∧ child = cert.S 1 false ∧ parent = cert.Q 2 true) ∨ (birth = ![q 2, birth 1, q 3, cfg.firstPredecessor 1] ∧ parentIndex = 2 ∧ rotation = 2 ∧ - x = cert.exceptional_segments.b ∧ + x = cert.exceptionalSegments.b ∧ child = cert.S 1 false ∧ parent = cert.O) ∨ (birth = ![cfg.firstPredecessor 1, birth 1, q 2, q 3] ∧ parentIndex = 1 ∧ rotation = 1 ∧ - x = cert.exceptional_segments.a ∧ + x = cert.exceptionalSegments.a ∧ child = cert.O ∧ parent = cert.Q 1 true) ∨ (birth = ![cfg.firstPredecessor 1, birth 1, q 2, q 3] ∧ parentIndex = 2 ∧ rotation = 0 ∧ - x = cert.exceptional_segments.a ∧ + x = cert.exceptionalSegments.a ∧ child = cert.O ∧ parent = cert.S 2 false) ∨ (birth = ![cfg.firstPredecessor 1, birth 1, q 2, q 3] ∧ parentIndex = 1 ∧ rotation = 3 ∧ - x = cert.exceptional_segments.b ∧ + x = cert.exceptionalSegments.b ∧ child = cert.O ∧ parent = cert.S 1 false) ∨ (birth = ![cfg.firstPredecessor 1, birth 1, q 2, q 3] ∧ parentIndex = 2 ∧ rotation = 2 ∧ - x = cert.exceptional_segments.b ∧ + x = cert.exceptionalSegments.b ∧ child = cert.O ∧ parent = cert.Q 2 true) end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/PositiveDefiniteRepresentativeGap.lean b/LeanPool/ApollonianSuperharmonic/PositiveDefiniteRepresentativeGap.lean index ca4b56e8aa..12a6287fe4 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveDefiniteRepresentativeGap.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveDefiniteRepresentativeGap.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.CircleMatrix public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicRepresentative -public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm -public import LeanPool.ApollonianSuperharmonic.QuadraticGrowthAtInfinity public import LeanPool.ApollonianSuperharmonic.P5691T1PosDefQuadraticLowerBound -- [TABLET NODE: PositiveDefiniteRepresentativeGap] diff --git a/LeanPool/ApollonianSuperharmonic/PositiveTracePackingDichotomy.lean b/LeanPool/ApollonianSuperharmonic/PositiveTracePackingDichotomy.lean index b391c85892..e0317334e7 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveTracePackingDichotomy.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveTracePackingDichotomy.lean @@ -5,9 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandCircleEnclosureDichotomy public import LeanPool.ApollonianSuperharmonic.CircleMatrixEnclosureCriterion -public import LeanPool.ApollonianSuperharmonic.SymmetricMatrixCoordinates -- [TABLET NODE: PositiveTracePackingDichotomy] diff --git a/LeanPool/ApollonianSuperharmonic/Preamble.lean b/LeanPool/ApollonianSuperharmonic/Preamble.lean index e211d004af..41dab072be 100644 --- a/LeanPool/ApollonianSuperharmonic/Preamble.lean +++ b/LeanPool/ApollonianSuperharmonic/Preamble.lean @@ -5,17 +5,8 @@ Authors: Wesley Pegden -/ module --- Preamble: shared imports for all tablet nodes. --- Add specific Mathlib imports here (never `import Mathlib`). -public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -public import Mathlib.Data.Fin.VecNotation -public import Mathlib.LinearAlgebra.Matrix.ToLin -public import Mathlib.LinearAlgebra.Matrix.Trace -public import Mathlib.LinearAlgebra.Matrix.PosDef -public import Mathlib.Data.Finset.Card -public import Mathlib.Topology.Homeomorph.Defs -public import Mathlib.Topology.MetricSpace.Isometry -public import Mathlib.SetTheory.Cardinal.Finite +-- Keep standard syntax linters active; each module imports its mathematical dependencies. +public import Mathlib.Init /-! # Preamble diff --git a/LeanPool/ApollonianSuperharmonic/PrecursorBoundaryArcData.lean b/LeanPool/ApollonianSuperharmonic/PrecursorBoundaryArcData.lean index 63beb71a52..fd4b3cfde5 100644 --- a/LeanPool/ApollonianSuperharmonic/PrecursorBoundaryArcData.lean +++ b/LeanPool/ApollonianSuperharmonic/PrecursorBoundaryArcData.lean @@ -5,8 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint public import LeanPool.ApollonianSuperharmonic.TileCentroid public import LeanPool.ApollonianSuperharmonic.TouchingTriple diff --git a/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientation.lean b/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientation.lean index cac86d9b72..7dcc58b7e5 100644 --- a/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientation.lean +++ b/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -- [TABLET NODE: PrimitiveVectorOrientation] diff --git a/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientationUnique.lean b/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientationUnique.lean index ef07110140..b2aa8105ff 100644 --- a/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientationUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientationUnique.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandTangency public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -- [TABLET NODE: PrimitiveVectorOrientationUnique] @@ -42,7 +42,8 @@ private theorem baseGood : ∀ z, Good (![ (1, 1 + 2 * z), all_goals norm_num [Zsqrtd.ext_iff] at hsame · intro i j hij fin_cases i <;> fin_cases j - all_goals simp? + all_goals simp only [Int.reduceNeg, Fin.mk_one, Fin.isValue, Matrix.cons_val_one, + Matrix.cons_val_zero, Fin.reduceFinMk, Matrix.cons_val, Fin.zero_eta, or_self] · exact (hij rfl).elim · exact Or.inr (PrimitiveVectorOrientation.base10 z) · convert Or.inr (PrimitiveVectorOrientation.base21 (z - ⟨0, 1⟩)) using 1; ring diff --git a/LeanPool/ApollonianSuperharmonic/ProperBandCurvatureStructure.lean b/LeanPool/ApollonianSuperharmonic/ProperBandCurvatureStructure.lean index c045eb8a30..c051474cd2 100644 --- a/LeanPool/ApollonianSuperharmonic/ProperBandCurvatureStructure.lean +++ b/LeanPool/ApollonianSuperharmonic/ProperBandCurvatureStructure.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification @@ -106,7 +108,9 @@ theorem ProperBandCurvatureStructure (q : Fin 4 → CircleCoordinates) · have old := ih proper rcases old with ⟨child, oldnonneg, oldunique⟩ fin_cases i <;> fin_cases j - all_goals simp? at hi hj + all_goals simp only [Fin.isValue, Fin.mk_one, Fin.succ_one_eq_two, + Matrix.cons_val, Fin.reduceFinMk, Fin.reduceSucc, Fin.zero_eta, + Fin.succ_zero_eq_one, Matrix.cons_val_one, Matrix.cons_val_zero] at hi hj · omega · omega · omega diff --git a/LeanPool/ApollonianSuperharmonic/ProperBandQuadruple.lean b/LeanPool/ApollonianSuperharmonic/ProperBandQuadruple.lean index c18a0d9c9b..9f69ae1dfc 100644 --- a/LeanPool/ApollonianSuperharmonic/ProperBandQuadruple.lean +++ b/LeanPool/ApollonianSuperharmonic/ProperBandQuadruple.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -- [TABLET NODE: ProperBandQuadruple] diff --git a/LeanPool/ApollonianSuperharmonic/ProtoTile.lean b/LeanPool/ApollonianSuperharmonic/ProtoTile.lean index 7dc12fdcaf..da25a2c6f6 100644 --- a/LeanPool/ApollonianSuperharmonic/ProtoTile.lean +++ b/LeanPool/ApollonianSuperharmonic/ProtoTile.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FiniteTile -- [TABLET NODE: ProtoTile] diff --git a/LeanPool/ApollonianSuperharmonic/ProtoTileObservableExtensionality.lean b/LeanPool/ApollonianSuperharmonic/ProtoTileObservableExtensionality.lean index a95746a38b..22e029659e 100644 --- a/LeanPool/ApollonianSuperharmonic/ProtoTileObservableExtensionality.lean +++ b/LeanPool/ApollonianSuperharmonic/ProtoTileObservableExtensionality.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.TileCentroid diff --git a/LeanPool/ApollonianSuperharmonic/QuadraticAffineLaplacian.lean b/LeanPool/ApollonianSuperharmonic/QuadraticAffineLaplacian.lean index af351aeec8..6144203fa0 100644 --- a/LeanPool/ApollonianSuperharmonic/QuadraticAffineLaplacian.lean +++ b/LeanPool/ApollonianSuperharmonic/QuadraticAffineLaplacian.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import Mathlib.LinearAlgebra.Matrix.Trace public import Mathlib.LinearAlgebra.Matrix.Symmetric public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm diff --git a/LeanPool/ApollonianSuperharmonic/QuadraticGrowthAtInfinity.lean b/LeanPool/ApollonianSuperharmonic/QuadraticGrowthAtInfinity.lean index e0b55fa98d..8dd1b183c8 100644 --- a/LeanPool/ApollonianSuperharmonic/QuadraticGrowthAtInfinity.lean +++ b/LeanPool/ApollonianSuperharmonic/QuadraticGrowthAtInfinity.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm diff --git a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetric.lean b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetric.lean index d2021a7a53..36af6ca570 100644 --- a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetric.lean +++ b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetric.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileCentroid public import LeanPool.ApollonianSuperharmonic.TileRealization diff --git a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean index c0749b3674..227f73f624 100644 --- a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean @@ -5,13 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricOccurrence -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileRealization -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: QuarterTurnSymmetricCenteredTransport] diff --git a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricExactInterfaceTransport.lean b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricExactInterfaceTransport.lean index 7ab454bd44..f786ebf457 100644 --- a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricExactInterfaceTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricExactInterfaceTransport.lean @@ -5,19 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: QuarterTurnSymmetricExactInterfaceTransport] @@ -241,14 +236,14 @@ private theorem path_map : intro k m h cases k with | nil => - simp? at h + simp only [List.map_cons, List.nil_append, List.cons.injEq, add_left_inj] at h rcases h with ⟨hz, hrest⟩ have hz' : z = c := qinj hz subst z cases q with | nil => simp_all | cons w q => - simp? at hrest + simp only [List.map_cons, List.cons.injEq, add_left_inj] at hrest have hw' : w = d := qinj hrest.1 subst w exact ⟨[], q, by simp []⟩ diff --git a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricOccurrence.lean b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricOccurrence.lean index 65f08bb2b6..202963bb7d 100644 --- a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricOccurrence.lean +++ b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricOccurrence.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas diff --git a/LeanPool/ApollonianSuperharmonic/RealFourNeighborLaplacian.lean b/LeanPool/ApollonianSuperharmonic/RealFourNeighborLaplacian.lean index 5707816cec..7f2df10a0d 100644 --- a/LeanPool/ApollonianSuperharmonic/RealFourNeighborLaplacian.lean +++ b/LeanPool/ApollonianSuperharmonic/RealFourNeighborLaplacian.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: RealFourNeighborLaplacian] diff --git a/LeanPool/ApollonianSuperharmonic/RealLaplacianContactComparison.lean b/LeanPool/ApollonianSuperharmonic/RealLaplacianContactComparison.lean index e6cf5ea7d3..8e8a0dd9cd 100644 --- a/LeanPool/ApollonianSuperharmonic/RealLaplacianContactComparison.lean +++ b/LeanPool/ApollonianSuperharmonic/RealLaplacianContactComparison.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.RealFourNeighborLaplacian -- [TABLET NODE: RealLaplacianContactComparison] diff --git a/LeanPool/ApollonianSuperharmonic/RealLaplacianLinearity.lean b/LeanPool/ApollonianSuperharmonic/RealLaplacianLinearity.lean index 2b05b1633e..6ae99a50a0 100644 --- a/LeanPool/ApollonianSuperharmonic/RealLaplacianLinearity.lean +++ b/LeanPool/ApollonianSuperharmonic/RealLaplacianLinearity.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.RealFourNeighborLaplacian -- [TABLET NODE: RealLaplacianLinearity] diff --git a/LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean b/LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean index 756797f379..4e18e25efb 100644 --- a/LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean +++ b/LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandTangency public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation diff --git a/LeanPool/ApollonianSuperharmonic/RecursiveVectorsExistUnique.lean b/LeanPool/ApollonianSuperharmonic/RecursiveVectorsExistUnique.lean index f8038e14b7..8a38628a9d 100644 --- a/LeanPool/ApollonianSuperharmonic/RecursiveVectorsExistUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/RecursiveVectorsExistUnique.lean @@ -5,17 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision -public import LeanPool.ApollonianSuperharmonic.BandGenealogy -public import LeanPool.ApollonianSuperharmonic.BandTangency -public import LeanPool.ApollonianSuperharmonic.CircleCoordinates -public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem -public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple public import LeanPool.ApollonianSuperharmonic.P4981T1PrescriptionCoherence public import LeanPool.ApollonianSuperharmonic.P4981T1PrescriptionLocality public import LeanPool.ApollonianSuperharmonic.P4981T1ProperEquations diff --git a/LeanPool/ApollonianSuperharmonic/RegularTileFamily.lean b/LeanPool/ApollonianSuperharmonic/RegularTileFamily.lean index 80c96f0940..30de6de092 100644 --- a/LeanPool/ApollonianSuperharmonic/RegularTileFamily.lean +++ b/LeanPool/ApollonianSuperharmonic/RegularTileFamily.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileTranslation -- [TABLET NODE: RegularTileFamily] diff --git a/LeanPool/ApollonianSuperharmonic/RegularTileFamilyTranslationUnique.lean b/LeanPool/ApollonianSuperharmonic/RegularTileFamilyTranslationUnique.lean index 9974390fea..872449b936 100644 --- a/LeanPool/ApollonianSuperharmonic/RegularTileFamilyTranslationUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/RegularTileFamilyTranslationUnique.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.RegularTileFamily public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas diff --git a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacent.lean b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacent.lean index 24a80d1b55..41985a82cf 100644 --- a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacent.lean +++ b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacent.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.BandCircle -- [TABLET NODE: RightLatticeAdjacent] diff --git a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean index 8bf00e635e..21ed8b3b0b 100644 --- a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean @@ -5,28 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares -public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: RightLatticeAdjacentPackingSymmetryTransport] @@ -218,7 +202,8 @@ private theorem affine_neg : rcases w with ⟨wa, wb⟩ apply Prod.ext · simp [BandPackingSymmetryAffineVectorAction, GaussianReflection] - · simp? [BandPackingSymmetryAffineVectorAction, GaussianReflection] + · simp only [BandPackingSymmetryAffineVectorAction, Int.reduceNeg, GaussianReflection, + Zsqrtd.re_neg, Zsqrtd.im_neg, neg_neg, Prod.neg_mk, neg_add_rev] have hrel : ({re := -va, im := vb} : GaussianInt) = -({re := va, im := -vb} : GaussianInt) := by ext <;> simp @@ -366,9 +351,10 @@ private theorem affine_flip_second : rcases v with ⟨va,vb⟩ rcases u with ⟨ua,ub⟩ rcases w with ⟨wa,wb⟩ - simp? [BandPackingSymmetryAffineVectorAction, - BandPackingSymmetryReversesOrientation, GaussianQuarterTurn, - GaussianReflection] + simp only [BandPackingSymmetryAffineVectorAction, GaussianQuarterTurn, Int.reduceNeg, + GaussianReflection, BandPackingSymmetryReversesOrientation, Bool.false_eq_true, + ↓reduceIte, Zsqrtd.im_add, Zsqrtd.im_mul, mul_neg, neg_add_rev, neg_neg, + Zsqrtd.re_add, Zsqrtd.re_mul, neg_mul, one_mul] ext <;> simp; ring | negate => intro v u @@ -379,9 +365,9 @@ private theorem affine_flip_second : intro v u rcases v with ⟨va,vb⟩ rcases u with ⟨ua,ub⟩ - simp? [BandPackingSymmetryAffineVectorAction, - BandPackingSymmetryReversesOrientation, GaussianQuarterTurn, - GaussianReflection] + simp only [BandPackingSymmetryAffineVectorAction, GaussianReflection, Int.reduceNeg, + GaussianQuarterTurn, Zsqrtd.re_neg, neg_neg, Zsqrtd.im_neg, + BandPackingSymmetryReversesOrientation, ↓reduceIte] ext <;> simp | comp a b iha ihb => intro v u @@ -764,6 +750,9 @@ private theorem transportedAdjacency : intro g q i e T T' h h' p p' hcent hslopeRe hslopeIm negative hphase hvec hOT hOT' hsr hsr' centroid_transport vector_sign vector_neg affine_neg real_coord imag_coord slope_transport newIndex newIndex_eq oldPair newFlipRe newFlipIm affineRightRe affineRightIm + have hv := (hvec i).1 + have hvr := congrArg (fun z : GaussianInt => (z.re : ℝ)) hv + have hvi := congrArg (fun z : GaussianInt => (z.im : ℝ)) hv refine ⟨negative, BandPackingSymmetrySlopeAction g T p, BandPackingSymmetrySlopeAction g T' p', ?_⟩ refine ⟨hphase, ?_, ?_, hsr, hsr', ?_, ?_, ?_, ?_⟩ @@ -794,25 +783,29 @@ private theorem transportedAdjacency : (BandVectors.2 (q 0) (q i.succ)) hc (by simpa [he] using hslopeRe) (by simpa [he] using hslopeIm) rw [oldPair] at hs - have hv := (hvec i).1 - have hvr := congrArg (fun z : GaussianInt => (z.re : ℝ)) hv - have hvi := congrArg (fun z : GaussianInt => (z.im : ℝ)) hv by_cases hn : negative <;> by_cases hr : BandPackingSymmetryReversesOrientation g = true - all_goals simp? [he, hn, hr] at ⊢ - all_goals simp? [newIndex_eq, hr] at newFlipRe newFlipIm + all_goals simp only [he, hn, Bool.bne_false, hr, bne_self_eq_false, Bool.false_eq_true, + ↓reduceIte, Int.reduceNeg, Fin.isValue, GaussianInt.intCast_re, neg_mul, one_mul, + Bool.bne_true, Bool.not_false] at ⊢ + all_goals simp only [Int.reduceNeg, Fin.isValue, newIndex_eq, hr, Bool.false_eq_true, + ↓reduceIte, GaussianInt.intCast_re, GaussianInt.intCast_im] at newFlipRe newFlipIm all_goals try rw [real_coord] at newFlipRe all_goals try rw [imag_coord] at newFlipIm all_goals simp only [hn, hr] at hvr hvi all_goals norm_num at hvr hvi all_goals rw [← GaussianInt.intCast_re] at hvr ⊢ all_goals rw [← GaussianInt.intCast_im] at hvi - all_goals simp? [hr] at affineRightRe affineRightIm + all_goals simp only [Int.reduceNeg, Fin.isValue, GaussianInt.intCast_re, hr, + Bool.false_eq_true, ↓reduceIte, map_neg, Complex.neg_re, GaussianInt.re_toComplex, + Int.cast_neg, GaussianInt.intCast_im, neg_neg, Complex.neg_im, + GaussianInt.im_toComplex] at affineRightRe affineRightIm all_goals rw [← GaussianInt.intCast_re] at affineRightRe all_goals rw [← GaussianInt.intCast_im] at affineRightIm all_goals rw [real_coord] at hvr affineRightIm all_goals rw [imag_coord] at hvi affineRightRe - all_goals simp? [GaussianQuarterTurn] at hs + all_goals simp only [Int.reduceNeg, GaussianQuarterTurn, Fin.isValue, + GaussianInt.intCast_re, GaussianInt.intCast_im] at hs all_goals rw [real_coord] at hs all_goals rw [imag_coord] at hs all_goals ring_nf at hs ⊢ @@ -831,25 +824,28 @@ private theorem transportedAdjacency : rw [affine_neg] at hs rw [oldPair] at hs norm_num at hs - have hv := (hvec i).1 - have hvr := congrArg (fun z : GaussianInt => (z.re : ℝ)) hv - have hvi := congrArg (fun z : GaussianInt => (z.im : ℝ)) hv by_cases hn : negative <;> by_cases hr : BandPackingSymmetryReversesOrientation g = true - all_goals simp? [he, hn, hr] at ⊢ - all_goals simp? [newIndex_eq, hr] at newFlipRe newFlipIm + all_goals simp only [he, hn, Bool.bne_true, Bool.not_false, hr, Bool.bne_false, + ↓reduceIte, Int.reduceNeg, Fin.isValue, Bool.false_eq_true, GaussianInt.intCast_re, + one_mul, bne_self_eq_false, neg_mul] at ⊢ + all_goals simp only [Int.reduceNeg, Fin.isValue, newIndex_eq, hr, Bool.false_eq_true, + ↓reduceIte, GaussianInt.intCast_re, GaussianInt.intCast_im] at newFlipRe newFlipIm all_goals try rw [real_coord] at newFlipRe all_goals try rw [imag_coord] at newFlipIm all_goals simp only [hn, hr] at hvr hvi all_goals norm_num at hvr hvi all_goals rw [← GaussianInt.intCast_re] at hvr ⊢ all_goals rw [← GaussianInt.intCast_im] at hvi - all_goals simp? [hr] at affineRightRe affineRightIm + all_goals simp only [Int.reduceNeg, Fin.isValue, GaussianInt.intCast_re, hr, + Bool.false_eq_true, ↓reduceIte, map_neg, Complex.neg_re, GaussianInt.re_toComplex, + Int.cast_neg, GaussianInt.intCast_im, neg_neg, Complex.neg_im, + GaussianInt.im_toComplex] at affineRightRe affineRightIm all_goals rw [← GaussianInt.intCast_re] at affineRightRe all_goals rw [← GaussianInt.intCast_im] at affineRightIm all_goals rw [real_coord] at hvr affineRightIm all_goals rw [imag_coord] at hvi affineRightRe - all_goals simp? [GaussianQuarterTurn] at hs + all_goals simp only [GaussianQuarterTurn, Int.reduceNeg, Fin.isValue] at hs all_goals rw [real_coord] at hs all_goals rw [imag_coord] at hs all_goals ring_nf at hs ⊢ @@ -865,13 +861,13 @@ private theorem transportedAdjacency : (BandVectors.1 (q 0) (q i.succ)) (BandVectors.2 (q 0) (q i.succ)) hc (by simpa [he] using hslopeRe) (by simpa [he] using hslopeIm) rw [oldPair] at hs - have hv := (hvec i).1 - have hvi := congrArg (fun z : GaussianInt => (z.im : ℝ)) hv - have hvr := congrArg (fun z : GaussianInt => (z.re : ℝ)) hv by_cases hn : negative <;> by_cases hr : BandPackingSymmetryReversesOrientation g = true - all_goals simp? [he, hn, hr] at ⊢ - all_goals simp? [newIndex_eq, hr] at newFlipRe newFlipIm + all_goals simp only [he, hn, Bool.bne_false, hr, bne_self_eq_false, Bool.false_eq_true, + ↓reduceIte, Int.reduceNeg, Fin.isValue, GaussianInt.intCast_im, neg_mul, one_mul, + Bool.bne_true, Bool.not_false] at ⊢ + all_goals simp only [Int.reduceNeg, Fin.isValue, newIndex_eq, hr, Bool.false_eq_true, + ↓reduceIte, GaussianInt.intCast_re, GaussianInt.intCast_im] at newFlipRe newFlipIm all_goals try rw [real_coord] at newFlipRe all_goals try rw [imag_coord] at newFlipIm all_goals simp only [hn, hr] at hvi @@ -881,13 +877,17 @@ private theorem transportedAdjacency : all_goals rw [← GaussianInt.intCast_im] at ⊢ all_goals rw [← GaussianInt.intCast_im] at hvi all_goals rw [← GaussianInt.intCast_re] at hvr - all_goals simp? [hr] at affineRightRe affineRightIm + all_goals simp only [Int.reduceNeg, Fin.isValue, GaussianInt.intCast_re, hr, + Bool.false_eq_true, ↓reduceIte, map_neg, Complex.neg_re, GaussianInt.re_toComplex, + Int.cast_neg, GaussianInt.intCast_im, neg_neg, Complex.neg_im, + GaussianInt.im_toComplex] at affineRightRe affineRightIm all_goals rw [← GaussianInt.intCast_re] at affineRightRe all_goals rw [← GaussianInt.intCast_im] at affineRightIm all_goals rw [imag_coord] at hvi affineRightRe all_goals rw [real_coord] at hvr all_goals rw [real_coord] at affineRightIm - all_goals simp? [GaussianQuarterTurn] at hs + all_goals simp only [Int.reduceNeg, GaussianQuarterTurn, Fin.isValue, + GaussianInt.intCast_re, GaussianInt.intCast_im] at hs all_goals rw [real_coord] at hs all_goals rw [imag_coord] at hs all_goals ring_nf at hs ⊢ @@ -906,13 +906,13 @@ private theorem transportedAdjacency : rw [affine_neg] at hs rw [oldPair] at hs norm_num at hs - have hv := (hvec i).1 - have hvi := congrArg (fun z : GaussianInt => (z.im : ℝ)) hv - have hvr := congrArg (fun z : GaussianInt => (z.re : ℝ)) hv by_cases hn : negative <;> by_cases hr : BandPackingSymmetryReversesOrientation g = true - all_goals simp? [he, hn, hr] at ⊢ - all_goals simp? [newIndex_eq, hr] at newFlipRe newFlipIm + all_goals simp only [he, hn, Bool.bne_true, Bool.not_false, hr, Bool.bne_false, + ↓reduceIte, Int.reduceNeg, Fin.isValue, Bool.false_eq_true, GaussianInt.intCast_im, + one_mul, bne_self_eq_false, neg_mul] at ⊢ + all_goals simp only [Int.reduceNeg, Fin.isValue, newIndex_eq, hr, Bool.false_eq_true, + ↓reduceIte, GaussianInt.intCast_re, GaussianInt.intCast_im] at newFlipRe newFlipIm all_goals try rw [real_coord] at newFlipRe all_goals try rw [imag_coord] at newFlipIm all_goals simp only [hn, hr] at hvi @@ -922,13 +922,16 @@ private theorem transportedAdjacency : all_goals rw [← GaussianInt.intCast_im] at ⊢ all_goals rw [← GaussianInt.intCast_im] at hvi all_goals rw [← GaussianInt.intCast_re] at hvr - all_goals simp? [hr] at affineRightRe affineRightIm + all_goals simp only [Int.reduceNeg, Fin.isValue, GaussianInt.intCast_re, hr, + Bool.false_eq_true, ↓reduceIte, map_neg, Complex.neg_re, GaussianInt.re_toComplex, + Int.cast_neg, GaussianInt.intCast_im, neg_neg, Complex.neg_im, + GaussianInt.im_toComplex] at affineRightRe affineRightIm all_goals rw [← GaussianInt.intCast_re] at affineRightRe all_goals rw [← GaussianInt.intCast_im] at affineRightIm all_goals rw [imag_coord] at hvi affineRightRe all_goals rw [real_coord] at hvr all_goals rw [real_coord] at affineRightIm - all_goals simp? [GaussianQuarterTurn] at hs + all_goals simp only [GaussianQuarterTurn, Int.reduceNeg, Fin.isValue] at hs all_goals rw [real_coord] at hs all_goals rw [imag_coord] at hs all_goals ring_nf at hs ⊢ @@ -1051,8 +1054,12 @@ theorem RightLatticeAdjacentPackingSymmetryTransport have phaseSlope := (hvec i).2 have phaseSlopeRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) phaseSlope have phaseSlopeIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) phaseSlope - simp? [] at oldFlipRe oldFlipIm newFlipRe newFlipIm - simp? [] at oldFlipVecRe oldFlipVecIm newFlipVecRe newFlipVecIm + simp only [Int.reduceNeg, Fin.isValue, GaussianInt.intCast_re, neg_mul, Zsqrtd.re_neg, + Zsqrtd.re_mul, zero_mul, mul_one, one_mul, zero_add, neg_neg, GaussianInt.intCast_im, + Zsqrtd.im_neg, Zsqrtd.im_mul, Int.cast_neg] at oldFlipRe oldFlipIm newFlipRe newFlipIm + simp only [Int.reduceNeg, Fin.isValue, GaussianInt.intCast_re, Zsqrtd.re_mul, zero_mul, + mul_one, neg_mul, one_mul, zero_add, Int.cast_neg, GaussianInt.intCast_im, + Zsqrtd.im_mul] at oldFlipVecRe oldFlipVecIm newFlipVecRe newFlipVecIm simp only [real_coord, imag_coord] at newFlipRe newFlipIm try try @@ -1060,7 +1067,9 @@ theorem RightLatticeAdjacentPackingSymmetryTransport rw [imag_coord] at oldFlipVecIm newFlipVecIm rw [imag_coord] at oldFlipVecRe newFlipVecRe rw [real_coord] at oldFlipVecIm newFlipVecIm - simp? [GaussianQuarterTurn] at affineRightRe affineRightIm phaseSlopeRe phaseSlopeIm + simp only [Int.reduceNeg, GaussianQuarterTurn, Fin.isValue, GaussianInt.intCast_re, + GaussianInt.intCast_im, mul_ite, mul_neg, ite_mul, neg_mul, one_mul] + at affineRightRe affineRightIm phaseSlopeRe phaseSlopeIm try rw [← GaussianInt.intCast_re] at oldFlipRe try try rw [← GaussianInt.intCast_re] at affineRightRe diff --git a/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean b/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean index b89b2c409b..fa4a733c77 100644 --- a/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean @@ -5,17 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.OdometerAdjacencyInduction public import LeanPool.ApollonianSuperharmonic.LeftAdjacentOdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentInterfacePath -public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition -public import LeanPool.ApollonianSuperharmonic.TileSubodometer -- [TABLET NODE: RightSubtileOdometerCompatibility] diff --git a/LeanPool/ApollonianSuperharmonic/RootedFourNeighborForest.lean b/LeanPool/ApollonianSuperharmonic/RootedFourNeighborForest.lean index 6779d8b18e..eaab507334 100644 --- a/LeanPool/ApollonianSuperharmonic/RootedFourNeighborForest.lean +++ b/LeanPool/ApollonianSuperharmonic/RootedFourNeighborForest.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent -- [TABLET NODE: RootedFourNeighborForest] diff --git a/LeanPool/ApollonianSuperharmonic/SemiProperForestClassification.lean b/LeanPool/ApollonianSuperharmonic/SemiProperForestClassification.lean index e25f6b0ef0..65e9908d22 100644 --- a/LeanPool/ApollonianSuperharmonic/SemiProperForestClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/SemiProperForestClassification.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -- [TABLET NODE: SemiProperForestClassification] diff --git a/LeanPool/ApollonianSuperharmonic/SemiProperQuadruple.lean b/LeanPool/ApollonianSuperharmonic/SemiProperQuadruple.lean index 11d4951d7c..06d1fc6ad0 100644 --- a/LeanPool/ApollonianSuperharmonic/SemiProperQuadruple.lean +++ b/LeanPool/ApollonianSuperharmonic/SemiProperQuadruple.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.CircleCoordinates -- [TABLET NODE: SemiProperQuadruple] diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridCycle.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridCycle.lean index c0a0e68bf9..1c20a1c44f 100644 --- a/LeanPool/ApollonianSuperharmonic/SimpleGridCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridCycle.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent -- [TABLET NODE: SimpleGridCycle] diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridCycleSubgraphDegreeTwo.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridCycleSubgraphDegreeTwo.lean index 0249a3be71..dce9765b52 100644 --- a/LeanPool/ApollonianSuperharmonic/SimpleGridCycleSubgraphDegreeTwo.lean +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridCycleSubgraphDegreeTwo.lean @@ -5,8 +5,10 @@ Authors: Wesley Pegden -/ module -public import Mathlib.Combinatorics.SimpleGraph.Matching +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle +public import Mathlib.Combinatorics.SimpleGraph.Connectivity.Subgraph -- [TABLET NODE: SimpleGridCycleSubgraphDegreeTwo] diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPath.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPath.lean index 8cbd9956e4..8183701383 100644 --- a/LeanPool/ApollonianSuperharmonic/SimpleGridPath.lean +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPath.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: SimpleGridPath] diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathBetween.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathBetween.lean index 638b158d1b..1176656efa 100644 --- a/LeanPool/ApollonianSuperharmonic/SimpleGridPathBetween.lean +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathBetween.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.SimpleGridPath +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: SimpleGridPathBetween] diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean index 12a05c1f98..3d522507c5 100644 --- a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween -- [TABLET NODE: SimpleGridPathEndpointPairUnique] @@ -175,13 +177,14 @@ private theorem interior_edges : intro he subst l rw [hrt] at hu - simp? at hu + simp only [List.nil_append, List.head?_cons, Option.some.injEq] at hu exact hzu hu have ht : t ≠ [] := by intro he subst t rw [hrt] at hv - simp? at hv + simp only [List.getLast?_append, List.getLast?_singleton, Option.some_or, + Option.some.injEq] at hv exact hzv hv let a := l.getLast hl let l₀ := l.dropLast @@ -206,7 +209,8 @@ private theorem interior_edges : · subst a have hbad := hr rw [hrt, ← hlt] at hbad - simp? [List.nodup_append] at hbad + simp only [List.append_assoc, List.cons_append, List.nil_append, List.nodup_append, + List.nodup_cons, List.mem_cons, not_or, ne_eq, forall_eq_or_imp] at hbad exact hbad.2.1.1.1 haz · subst b have hbad := hr diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean index f17d5067d5..3c2517fecf 100644 --- a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GaussianReflection public import LeanPool.ApollonianSuperharmonic.GaussianTranslation public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn @@ -54,7 +56,7 @@ private theorem transport : ∀ (p : List GaussianInt) (f : GaussianInt → Gaus intro a b l₁ l₂ h cases l₁ with | nil => - simp? at h + simp only [List.map_cons, List.nil_append, List.cons.injEq] at h rcases h with ⟨rfl, rfl, hys⟩ exact hstep x y (hp x y [] ys (by simp)) | cons z zs => @@ -120,18 +122,18 @@ private theorem forward : ∀ (f : GaussianInt → GaussianInt), Function.Inject intro k m a b h cases k with | nil => - simp? at h + simp only [List.map_cons, List.nil_append, List.cons.injEq] at h cases xs with | nil => simp_all | cons y ys => - simp? at h + simp only [List.map_cons, List.cons.injEq] at h have hxa : x = a := hf h.1 have hya : y = b := hf h.2.1 subst a subst b exact ⟨[], ys, by simp []⟩ | cons z zs => - simp? at h + simp only [List.map_cons, List.cons_append, List.cons.injEq] at h have hz : z = f x := h.1.symm subst z rcases ih zs m a b h.2 with ⟨k₀, m₀, hm⟩ diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathPointTrichotomy.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathPointTrichotomy.lean index cd7187eb23..2c7f2bd29b 100644 --- a/LeanPool/ApollonianSuperharmonic/SimpleGridPathPointTrichotomy.lean +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathPointTrichotomy.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween -- [TABLET NODE: SimpleGridPathPointTrichotomy] @@ -110,7 +112,8 @@ lemma SimpleGridPathPointTrichotomy intro hzx have hbad := hp rw [hsplit, ← hlt, htform] at hbad - simp? [List.nodup_append] at hbad + simp only [List.append_assoc, List.cons_append, List.nil_append, List.nodup_append, + List.nodup_cons, List.mem_cons, not_or, ne_eq, forall_eq_or_imp] at hbad exact hbad.2.1.1.1 hzx rcases hzw with hzx | hzw · exact hznotx hzx diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathVertexIncidentEdge.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathVertexIncidentEdge.lean index d19b3077ab..c2d4ccd787 100644 --- a/LeanPool/ApollonianSuperharmonic/SimpleGridPathVertexIncidentEdge.lean +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathVertexIncidentEdge.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SimpleGridPath -- [TABLET NODE: SimpleGridPathVertexIncidentEdge] diff --git a/LeanPool/ApollonianSuperharmonic/SixSubtileFaceLabel.lean b/LeanPool/ApollonianSuperharmonic/SixSubtileFaceLabel.lean index 6b91b584f0..dc3919295a 100644 --- a/LeanPool/ApollonianSuperharmonic/SixSubtileFaceLabel.lean +++ b/LeanPool/ApollonianSuperharmonic/SixSubtileFaceLabel.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + -- [TABLET NODE: SixSubtileFaceLabel] diff --git a/LeanPool/ApollonianSuperharmonic/SixSubtileFaceVertices.lean b/LeanPool/ApollonianSuperharmonic/SixSubtileFaceVertices.lean index 3aa651dea9..6fd406220c 100644 --- a/LeanPool/ApollonianSuperharmonic/SixSubtileFaceVertices.lean +++ b/LeanPool/ApollonianSuperharmonic/SixSubtileFaceVertices.lean @@ -5,6 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic +public import Mathlib.Data.Fin.VecNotation + public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileFaceIndex public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex diff --git a/LeanPool/ApollonianSuperharmonic/SixSubtileLabel.lean b/LeanPool/ApollonianSuperharmonic/SixSubtileLabel.lean index 29dbac99d2..c33d16c845 100644 --- a/LeanPool/ApollonianSuperharmonic/SixSubtileLabel.lean +++ b/LeanPool/ApollonianSuperharmonic/SixSubtileLabel.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + -- [TABLET NODE: SixSubtileLabel] diff --git a/LeanPool/ApollonianSuperharmonic/StandardSimplex.lean b/LeanPool/ApollonianSuperharmonic/StandardSimplex.lean index 5325ecf728..40e8da95ff 100644 --- a/LeanPool/ApollonianSuperharmonic/StandardSimplex.lean +++ b/LeanPool/ApollonianSuperharmonic/StandardSimplex.lean @@ -5,6 +5,9 @@ Authors: Alexander Bentkamp, Yury Kudryashov, Yaël Dillies, Joël Riou -/ module +public import Mathlib.Init +public import Mathlib.Data.Fintype.Card + public import Mathlib.Basic.Real.Basic public import Mathlib.Algebra.BigOperators.Group.Finset.Defs diff --git a/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacent.lean b/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacent.lean index 63f7ae7ee3..8cfdbd516a 100644 --- a/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacent.lean +++ b/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacent.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.BandCircle -- [TABLET NODE: SubtileLatticeAdjacent] diff --git a/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean index f7f175c6b9..f59f02ac4f 100644 --- a/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean @@ -5,29 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProperCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryQuadrupleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryReversesOrientation public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares -public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: SubtileLatticeAdjacentPackingSymmetryTransport] diff --git a/LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretation.lean b/LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretation.lean index 7dc85daa21..40c7d655b0 100644 --- a/LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretation.lean +++ b/LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretation.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileIndex public import LeanPool.ApollonianSuperharmonic.TileTranslation diff --git a/LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretationCovariance.lean b/LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretationCovariance.lean index 9828b2e2da..da8980fbd4 100644 --- a/LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretationCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/SubtileOccurrenceInterpretationCovariance.lean @@ -5,12 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -public import LeanPool.ApollonianSuperharmonic.GaussianReflection +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurn +public import LeanPool.ApollonianSuperharmonic.TileReflection -- [TABLET NODE: SubtileOccurrenceInterpretationCovariance] @@ -104,7 +103,7 @@ theorem SubtileOccurrenceInterpretationCovariance cases o with | mk label first second => cases label <;> - simp? [SubtileOccurrenceInterpretation] + simp only [SubtileOccurrenceInterpretation, Fin.isValue] <;> rw [translation_commute] <;> rw [quarter_commute] <;> rw [reflection_commute] diff --git a/LeanPool/ApollonianSuperharmonic/SufficientBoundedMaximality.lean b/LeanPool/ApollonianSuperharmonic/SufficientBoundedMaximality.lean index 58df13499b..4ce08f1bf0 100644 --- a/LeanPool/ApollonianSuperharmonic/SufficientBoundedMaximality.lean +++ b/LeanPool/ApollonianSuperharmonic/SufficientBoundedMaximality.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundedDifference public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian diff --git a/LeanPool/ApollonianSuperharmonic/SuperharmonicDownwardClosure.lean b/LeanPool/ApollonianSuperharmonic/SuperharmonicDownwardClosure.lean index 001739e45b..6aaf94b8ce 100644 --- a/LeanPool/ApollonianSuperharmonic/SuperharmonicDownwardClosure.lean +++ b/LeanPool/ApollonianSuperharmonic/SuperharmonicDownwardClosure.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.IntegerLaplacianCastBridge +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicRepresentative public import LeanPool.ApollonianSuperharmonic.PSDQuadraticIntegerApproximation -public import LeanPool.ApollonianSuperharmonic.QuadraticGrowthAtInfinity -public import LeanPool.ApollonianSuperharmonic.RealLaplacianLinearity -- [TABLET NODE: SuperharmonicDownwardClosure] diff --git a/LeanPool/ApollonianSuperharmonic/SwappedAffineTriangularChartAlignment.lean b/LeanPool/ApollonianSuperharmonic/SwappedAffineTriangularChartAlignment.lean index 9ebf42da66..f7d8d8d19a 100644 --- a/LeanPool/ApollonianSuperharmonic/SwappedAffineTriangularChartAlignment.lean +++ b/LeanPool/ApollonianSuperharmonic/SwappedAffineTriangularChartAlignment.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AffineTriangularComplexChart public import LeanPool.ApollonianSuperharmonic.AffineTriangularFaceCoordinateSwap public import LeanPool.ApollonianSuperharmonic.AffineTriangularFaceVertices -public import LeanPool.ApollonianSuperharmonic.TileTranslation -- [TABLET NODE: SwappedAffineTriangularChartAlignment] diff --git a/LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinateIdentity.lean b/LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinateIdentity.lean index ed593ae02f..4ca1767b03 100644 --- a/LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinateIdentity.lean +++ b/LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinateIdentity.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SymmetricMatrixCoordinates +public import Mathlib.LinearAlgebra.Matrix.Symmetric -- [TABLET NODE: SymmetricMatrixCoordinateIdentity] diff --git a/LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinates.lean b/LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinates.lean index 8956e2f4b5..45c42025fb 100644 --- a/LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/SymmetricMatrixCoordinates.lean @@ -5,8 +5,11 @@ Authors: Wesley Pegden -/ module -public import Mathlib.Analysis.Complex.Basic -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.Algebra.Order.BigOperators.Expect +public import Mathlib.Analysis.Complex.Order +public import Mathlib.LinearAlgebra.Matrix.Trace -- [TABLET NODE: SymmetricMatrixCoordinates] diff --git a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateBaseTables.lean b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateBaseTables.lean index e6ee46c1bb..a8548f5287 100644 --- a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateBaseTables.lean +++ b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateBaseTables.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateNormLaw public import LeanPool.ApollonianSuperharmonic.TangencyCoordinatePolarizationLaw diff --git a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateIdentity.lean b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateIdentity.lean index dc29ae86a2..3346d3ac19 100644 --- a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateIdentity.lean +++ b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateIdentity.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -public import LeanPool.ApollonianSuperharmonic.Preamble public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateBaseTables public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateRotation public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateSuccessorNorm diff --git a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateNormLaw.lean b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateNormLaw.lean index 49de61dbb9..25d0e96e80 100644 --- a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateNormLaw.lean +++ b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateNormLaw.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates -- [TABLET NODE: TangencyCoordinateNormLaw] diff --git a/LeanPool/ApollonianSuperharmonic/TangencyCoordinatePolarizationLaw.lean b/LeanPool/ApollonianSuperharmonic/TangencyCoordinatePolarizationLaw.lean index 28ecaee00d..deb557f5a1 100644 --- a/LeanPool/ApollonianSuperharmonic/TangencyCoordinatePolarizationLaw.lean +++ b/LeanPool/ApollonianSuperharmonic/TangencyCoordinatePolarizationLaw.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import Mathlib.Init +public import Mathlib.Algebra.Group.Fin.Basic + +public import LeanPool.ApollonianSuperharmonic.CircleCoordinates -- [TABLET NODE: TangencyCoordinatePolarizationLaw] diff --git a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateRotation.lean b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateRotation.lean index d1cef7fc54..645d176530 100644 --- a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateRotation.lean +++ b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateRotation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateNormLaw public import LeanPool.ApollonianSuperharmonic.TangencyCoordinatePolarizationLaw diff --git a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorNorm.lean b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorNorm.lean index 99f4281933..5527403027 100644 --- a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorNorm.lean +++ b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorNorm.lean @@ -5,6 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.LinearCombination +public import Mathlib.Data.Fin.VecNotation +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.Ring + public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateNormLaw public import LeanPool.ApollonianSuperharmonic.TangencyCoordinatePolarizationLaw @@ -31,8 +38,14 @@ theorem TangencyCoordinateSuccessorNorm (q : Fin 4 → CircleCoordinates) -- BODY intro i j hij fin_cases i <;> fin_cases j <;> - simp_all? [TangencyCoordinateNormLaw, TangencyCoordinatePolarizationLaw, - Zsqrtd.norm_def] + simp_all only [TangencyCoordinateNormLaw, ne_eq, Int.reduceNeg, zsmul_eq_mul, + Zsqrtd.norm_def, Zsqrtd.re_sub, Zsqrtd.re_mul, Zsqrtd.re_intCast, Zsqrtd.im_intCast, + mul_zero, zero_mul, add_zero, Zsqrtd.im_sub, Zsqrtd.im_mul, neg_mul, one_mul, neg_sub, + TangencyCoordinatePolarizationLaw, Fin.mk_one, Fin.isValue, Fin.reduceFinMk, + Fin.reduceEq, not_false_eq_true, Matrix.cons_val, Matrix.cons_val_one, + Matrix.cons_val_zero, Fin.zero_eta, Int.cast_sub, Int.cast_add, + Int.cast_mul, Int.cast_ofNat, Zsqrtd.re_add, Zsqrtd.re_ofNat, Nat.cast_ofNat, + Zsqrtd.im_ofNat, Zsqrtd.im_add, sub_self, not_true_eq_false] case «0».«1» | «1».«0» => have a := hn 0 2 (by decide) have b := hn 0 3 (by decide) @@ -40,8 +53,7 @@ theorem TangencyCoordinateSuccessorNorm (q : Fin 4 → CircleCoordinates) have d := hp 2 3 0 (by decide) (by decide) (by decide) have e := hp 2 1 0 (by decide) (by decide) (by decide) have f := hp 3 1 0 (by decide) (by decide) (by decide) - ring_nf at a b c d e f ⊢ - linarith + linear_combination 4 * a + 4 * b + c + 8 * d - 4 * e - 4 * f case «0».«2» | «2».«0» => have a := hn 0 2 (by decide) have b := hn 2 3 (by decide) @@ -49,8 +61,7 @@ theorem TangencyCoordinateSuccessorNorm (q : Fin 4 → CircleCoordinates) have d := hp 0 3 2 (by decide) (by decide) (by decide) have e := hp 0 1 2 (by decide) (by decide) (by decide) have f := hp 3 1 2 (by decide) (by decide) (by decide) - ring_nf at a b c d e f ⊢ - linarith + linear_combination 4 * a + 4 * b + c + 8 * d - 4 * e - 4 * f case «0».«3» | «3».«0» => have a := hn 0 3 (by decide) have b := hn 2 3 (by decide) @@ -58,8 +69,7 @@ theorem TangencyCoordinateSuccessorNorm (q : Fin 4 → CircleCoordinates) have d := hp 0 2 3 (by decide) (by decide) (by decide) have e := hp 0 1 3 (by decide) (by decide) (by decide) have f := hp 2 1 3 (by decide) (by decide) (by decide) - ring_nf at a b c d e f ⊢ - linarith + linear_combination 4 * a + 4 * b + c + 8 * d - 4 * e - 4 * f end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorPolarization.lean b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorPolarization.lean index c7378266f5..dad4d29c86 100644 --- a/LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorPolarization.lean +++ b/LeanPool/ApollonianSuperharmonic/TangencyCoordinateSuccessorPolarization.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateNormLaw public import LeanPool.ApollonianSuperharmonic.TangencyCoordinatePolarizationLaw diff --git a/LeanPool/ApollonianSuperharmonic/ThreeOwnerDesignatedOppositePair.lean b/LeanPool/ApollonianSuperharmonic/ThreeOwnerDesignatedOppositePair.lean index 1c5873e93c..054cf0af57 100644 --- a/LeanPool/ApollonianSuperharmonic/ThreeOwnerDesignatedOppositePair.lean +++ b/LeanPool/ApollonianSuperharmonic/ThreeOwnerDesignatedOppositePair.lean @@ -5,12 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex -public import Mathlib.Tactic.FinCases -public import Mathlib.Tactic.NormNum -- [TABLET NODE: ThreeOwnerDesignatedOppositePair] diff --git a/LeanPool/ApollonianSuperharmonic/TileArea.lean b/LeanPool/ApollonianSuperharmonic/TileArea.lean index 18b1a16612..6a00d87b85 100644 --- a/LeanPool/ApollonianSuperharmonic/TileArea.lean +++ b/LeanPool/ApollonianSuperharmonic/TileArea.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProtoTile -- [TABLET NODE: TileArea] diff --git a/LeanPool/ApollonianSuperharmonic/TileBordering.lean b/LeanPool/ApollonianSuperharmonic/TileBordering.lean index ff2485e14c..c51d257b09 100644 --- a/LeanPool/ApollonianSuperharmonic/TileBordering.lean +++ b/LeanPool/ApollonianSuperharmonic/TileBordering.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges -- [TABLET NODE: TileBordering] diff --git a/LeanPool/ApollonianSuperharmonic/TileCellComplement.lean b/LeanPool/ApollonianSuperharmonic/TileCellComplement.lean index 9703ce7415..ead3d9a68d 100644 --- a/LeanPool/ApollonianSuperharmonic/TileCellComplement.lean +++ b/LeanPool/ApollonianSuperharmonic/TileCellComplement.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProtoTile -- [TABLET NODE: TileCellComplement] diff --git a/LeanPool/ApollonianSuperharmonic/TileCellComplementCovariance.lean b/LeanPool/ApollonianSuperharmonic/TileCellComplementCovariance.lean index c823d1392a..52c6e209ad 100644 --- a/LeanPool/ApollonianSuperharmonic/TileCellComplementCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/TileCellComplementCovariance.lean @@ -5,12 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileCellComplement -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurn +public import LeanPool.ApollonianSuperharmonic.TileReflection +public import LeanPool.ApollonianSuperharmonic.TileTranslation -- [TABLET NODE: TileCellComplementCovariance] diff --git a/LeanPool/ApollonianSuperharmonic/TileCentroid.lean b/LeanPool/ApollonianSuperharmonic/TileCentroid.lean index bffeb6d8dd..f417fb7fed 100644 --- a/LeanPool/ApollonianSuperharmonic/TileCentroid.lean +++ b/LeanPool/ApollonianSuperharmonic/TileCentroid.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProtoTile -- [TABLET NODE: TileCentroid] diff --git a/LeanPool/ApollonianSuperharmonic/TileDiskAreaCovariance.lean b/LeanPool/ApollonianSuperharmonic/TileDiskAreaCovariance.lean index 9b80b588f4..8922abda2f 100644 --- a/LeanPool/ApollonianSuperharmonic/TileDiskAreaCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/TileDiskAreaCovariance.lean @@ -5,12 +5,14 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.TileArea public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TopologicalDisk +public import Mathlib.Topology.MetricSpace.Isometry -- [TABLET NODE: TileDiskAreaCovariance] diff --git a/LeanPool/ApollonianSuperharmonic/TileHalfTurn.lean b/LeanPool/ApollonianSuperharmonic/TileHalfTurn.lean index c70a80c9f9..eece957e09 100644 --- a/LeanPool/ApollonianSuperharmonic/TileHalfTurn.lean +++ b/LeanPool/ApollonianSuperharmonic/TileHalfTurn.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ProtoTile -- [TABLET NODE: TileHalfTurn] diff --git a/LeanPool/ApollonianSuperharmonic/TileHalfTurnFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileHalfTurnFormulas.lean index 155d13c35a..07c6913406 100644 --- a/LeanPool/ApollonianSuperharmonic/TileHalfTurnFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/TileHalfTurnFormulas.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.TileCentroid public import LeanPool.ApollonianSuperharmonic.TileHalfTurn @@ -89,7 +90,7 @@ theorem TileHalfTurnFormulas : ∀ T : ProtoTile, · exact image_empty T.cells constructor · apply proto_equal - · simp? [TileHalfTurn] + · simp only [TileHalfTurn, Int.reduceNeg, Finset.image_nonempty] change (T.cells.image (fun x => -x - 1 - ⟨0, 1⟩)).image (fun x => -x - 1 - ⟨0, 1⟩) = T.cells rw [Finset.image_image] diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometer.lean b/LeanPool/ApollonianSuperharmonic/TileOdometer.lean index 02388b3766..42d26ed2fe 100644 --- a/LeanPool/ApollonianSuperharmonic/TileOdometer.lean +++ b/LeanPool/ApollonianSuperharmonic/TileOdometer.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototile public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerAffineTranslation.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerAffineTranslation.lean index c45712270b..a66a433bf8 100644 --- a/LeanPool/ApollonianSuperharmonic/TileOdometerAffineTranslation.lean +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerAffineTranslation.lean @@ -5,13 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer -public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.OdometerTranslation public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: TileOdometerAffineTranslation] diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerBandPrototile.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerBandPrototile.lean index eb840ce65f..19f210e11f 100644 --- a/LeanPool/ApollonianSuperharmonic/TileOdometerBandPrototile.lean +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerBandPrototile.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPrototile +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileOdometer -- [TABLET NODE: TileOdometerBandPrototile] diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean index a0a4581077..7e10c6edfc 100644 --- a/LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean @@ -5,10 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.OdometerTranslation +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurn public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TileOdometer public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean index 5e171de512..5883b18ebb 100644 --- a/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean @@ -5,56 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandGenealogy +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileExists -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm -public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas -public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayout -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRawSupport -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification -public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer -public import LeanPool.ApollonianSuperharmonic.DiamondTileOdometerRestriction -public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction -public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.OdometerGluing -public import LeanPool.ApollonianSuperharmonic.OdometerTranslation -public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas -public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas -public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem -public import LeanPool.ApollonianSuperharmonic.RightSubtileOdometerCompatibility -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification -public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation -public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry -public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition -public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileRealization -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation -public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile -public import LeanPool.ApollonianSuperharmonic.P4250T1DefinedHalfIntegralSlope public import LeanPool.ApollonianSuperharmonic.P4250T1ParentSlopePhase public import LeanPool.ApollonianSuperharmonic.P4250T1IntegralAffinePlacement public import LeanPool.ApollonianSuperharmonic.P4250T1OrdinaryCompatibility @@ -411,7 +364,8 @@ private theorem hnvalue : have hv := (PartialOdometerAffineTranslateFormulas (hs i s) 0 0 (-c i s)).2.2.1 x hx have he := hc i s x ((hndom i s x).1 hx) - simp? at hv + simp only [sub_zero, Int.reduceNeg, Zsqrtd.re_zero, zero_mul, add_zero, Zsqrtd.im_zero] + at hv change (hn i s).value x = (hs i s).value x + -c i s at hv omega diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerReindexedDecomposition.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerReindexedDecomposition.lean index b8d13a87d3..4e81956a22 100644 --- a/LeanPool/ApollonianSuperharmonic/TileOdometerReindexedDecomposition.lean +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerReindexedDecomposition.lean @@ -5,8 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileOdometer -- [TABLET NODE: TileOdometerReindexedDecomposition] diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean index 1fd0cdefc3..1426055a79 100644 --- a/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean @@ -5,20 +5,14 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.CurvatureOneOdometer public import LeanPool.ApollonianSuperharmonic.OdometerGluing -public import LeanPool.ApollonianSuperharmonic.OdometerTranslation public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TileOdometer public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: TileOdometerTranslationUniqueness] @@ -283,7 +277,9 @@ private theorem square_disk : constructor <;> constructor <;> linarith [hp.1.1, hp.1.2, hp.2.1, hp.2.2] have hg : ∀ p, p ∈ TileRealization V → g p ∈ Metric.closedBall (0 : ℝ × ℝ) 1 := by intro p hp - simp? [TileRealization, hx, ClosedSquareRealization, Prod.le_def] at hp + simp only [TileRealization, hx, Finset.mem_singleton, ClosedSquareRealization, + Int.reduceNeg, GaussianInt.intCast_re, GaussianInt.intCast_im, + Set.iUnion_iUnion_eq_left, Set.mem_Icc, Prod.le_def] at hp rw [← GaussianInt.intCast_re, ← GaussianInt.intCast_im] at hp simp only [Metric.mem_closedBall, Prod.dist_eq, Real.dist_eq, Prod.fst_zero, Prod.snd_zero, sub_zero, max_le_iff, abs_le, g] diff --git a/LeanPool/ApollonianSuperharmonic/TileQuarterTurn.lean b/LeanPool/ApollonianSuperharmonic/TileQuarterTurn.lean index 93ffe9da20..3c8a991130 100644 --- a/LeanPool/ApollonianSuperharmonic/TileQuarterTurn.lean +++ b/LeanPool/ApollonianSuperharmonic/TileQuarterTurn.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn public import LeanPool.ApollonianSuperharmonic.ProtoTile diff --git a/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean index d53d0b4a90..a19859cb18 100644 --- a/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices @@ -354,7 +356,8 @@ private theorem quarterTurnCentroid (T : ProtoTile) : intro a b hab rcases a with ⟨a, c⟩ rcases b with ⟨b, d⟩ - simp? [GaussianQuarterTurn] at hab ⊢ + simp only [GaussianQuarterTurn, Int.reduceNeg, sub_left_inj, Zsqrtd.mk.injEq, neg_inj] + at hab ⊢ exact ⟨hab.2, hab.1⟩ have coordRe (x : GaussianInt) : (GaussianInt.toComplex x).re = (x.re : Real) := by @@ -376,7 +379,9 @@ private theorem quarterTurnCentroid (T : ProtoTile) : have sumImInt (x : GaussianInt) : ((GaussianQuarterTurn x - 1).im : Real) = (x.re : Real) := quarter_im_cast x - simp? [TileCentroid, h] + simp only [TileCentroid, Finset.image_nonempty, h, ↓reduceIte, Int.reduceNeg, + Int.cast_sum, GaussianInt.intCast_re, one_div, GaussianInt.intCast_im, neg_add_rev, + Prod.mk.injEq, add_left_inj] rw [Finset.card_image_of_injective T.cells hinj] rw [Finset.sum_image hinj.injOn] rw [Finset.sum_image hinj.injOn] @@ -486,7 +491,8 @@ theorem TileQuarterTurnFormulas : ∀ T : ProtoTile, by_cases h : T.cells.Nonempty · have hnew : (T.cells.image (fun x => GaussianQuarterTurn x - 1)).Nonempty := h.image _ - simp? [FootprintVertices, h, hnew] + simp only [FootprintVertices, hnew, ↓reduceIte, Finset.mem_image, Int.reduceNeg, + exists_exists_and_eq_and, sub_add_cancel, Set.mem_ofPred_eq, h, Set.mem_image] constructor · rintro ⟨a, ha, hv⟩ rcases hv with rfl | rfl | rfl | rfl @@ -562,8 +568,8 @@ theorem TileQuarterTurnFormulas : ∀ T : ProtoTile, minus_one_add_one, minus_one_add_up] · refine Or.inr (Or.inl ?_) rw [← he, h3] - simp? [Finset.image_insert, turn_up, pair_swap, - minus_one_add_up] + simp only [Int.reduceNeg, pair_swap, Finset.image_insert, turn_up, + Finset.image_singleton, minus_one_add_up] rw [turn_shift, ← minus_one_add_up] have edge_formula : BoundaryFootprintEdges (TileQuarterTurn T) = diff --git a/LeanPool/ApollonianSuperharmonic/TileRealization.lean b/LeanPool/ApollonianSuperharmonic/TileRealization.lean index d68e3b4cc2..08431202c4 100644 --- a/LeanPool/ApollonianSuperharmonic/TileRealization.lean +++ b/LeanPool/ApollonianSuperharmonic/TileRealization.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization public import LeanPool.ApollonianSuperharmonic.ProtoTile diff --git a/LeanPool/ApollonianSuperharmonic/TileReflection.lean b/LeanPool/ApollonianSuperharmonic/TileReflection.lean index fb01d8f2ea..524cbcdde9 100644 --- a/LeanPool/ApollonianSuperharmonic/TileReflection.lean +++ b/LeanPool/ApollonianSuperharmonic/TileReflection.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GaussianReflection public import LeanPool.ApollonianSuperharmonic.ProtoTile diff --git a/LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean index 39130e131d..b8fbab375e 100644 --- a/LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices @@ -366,7 +368,9 @@ theorem TileReflectionFormulas : ∀ T : ProtoTile, · have hinj : Function.Injective f := by intro a b hab simpa only [f_involutive] using congrArg f hab - simp? [TileCentroid, h] + simp only [TileCentroid, Int.reduceNeg, Finset.image_nonempty, h, ↓reduceIte, + Int.cast_sum, GaussianInt.intCast_re, one_div, GaussianInt.intCast_im, neg_add_rev, + Prod.mk.injEq, add_left_inj] rw [Finset.card_image_of_injective T.cells hinj] rw [Finset.sum_image hinj.injOn] rw [Finset.sum_image hinj.injOn] @@ -386,7 +390,8 @@ theorem TileReflectionFormulas : ∀ T : ProtoTile, · have hnew : (T.cells.image (fun x => GaussianReflection x - ⟨0, 1⟩)).Nonempty := h.image _ - simp? [FootprintVertices, h, hnew] + simp only [FootprintVertices, Int.reduceNeg, hnew, ↓reduceIte, Finset.mem_image, + exists_exists_and_eq_and, sub_add_cancel, Set.mem_ofPred_eq, h, Set.mem_image] constructor · rintro ⟨a, ha, hv⟩ rcases hv with rfl | rfl | rfl | rfl diff --git a/LeanPool/ApollonianSuperharmonic/TileString.lean b/LeanPool/ApollonianSuperharmonic/TileString.lean index 9f611a9bf5..a5dab8526d 100644 --- a/LeanPool/ApollonianSuperharmonic/TileString.lean +++ b/LeanPool/ApollonianSuperharmonic/TileString.lean @@ -5,11 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.RegularTileFamily public import LeanPool.ApollonianSuperharmonic.TileTouching public import LeanPool.ApollonianSuperharmonic.TilingLattice -public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import LeanPool.ApollonianSuperharmonic.TileCentroid public import LeanPool.ApollonianSuperharmonic.BandPrototile public import LeanPool.ApollonianSuperharmonic.UnitTriangularStep diff --git a/LeanPool/ApollonianSuperharmonic/TileStringCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/TileStringCentralCovariance.lean index 1ba0264adf..ebe3a1399a 100644 --- a/LeanPool/ApollonianSuperharmonic/TileStringCentralCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/TileStringCentralCovariance.lean @@ -5,12 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas public import LeanPool.ApollonianSuperharmonic.TileString public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -- [TABLET NODE: TileStringCentralCovariance] @@ -116,8 +115,9 @@ private theorem transform_translate : rw [ProtoTile.mk.injEq] constructor · ext x - simp? [transform, TileTranslation, TileHalfTurn, - GaussianTranslation, Finset.image_image] + simp only [TileTranslation, TileHalfTurn, Int.reduceNeg, GaussianTranslation, + Finset.image_image, Finset.image_nonempty, neg_add_rev, Finset.mem_image, + Function.comp_apply, transform] constructor · rintro ⟨a, ha, heq⟩ refine ⟨a, ha, ?_⟩ @@ -485,12 +485,12 @@ theorem TileStringCentralCovariance have hpre₀ : pre₀ ≠ [] := by intro hz subst pre₀ - simp? at hpreeq + simp only [List.map_nil] at hpreeq exact hpre hpreeq have hpost₀ : post₀ ≠ [] := by intro hz subst post₀ - simp? at hposteq + simp only [List.map_nil] at hposteq exact hpost hposteq rcases hbelow pre₀ V post₀ hdecomp hpre₀ hpost₀ with ⟨hpos, W, hWreg, hVW, hWneg⟩ diff --git a/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean b/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean index dcc496c921..e5de92714f 100644 --- a/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean @@ -5,18 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AffineTriangularStrip -public import LeanPool.ApollonianSuperharmonic.BandGenealogy public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification -public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.RegularTileFamilyTranslationUnique public import LeanPool.ApollonianSuperharmonic.TileString -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis -public import LeanPool.ApollonianSuperharmonic.VectorDeterminant -public import Mathlib.Data.List.Forall2 -public import Mathlib.Data.List.Nodup -- [TABLET NODE: TileStringCoordinateTransport] @@ -68,7 +61,9 @@ private theorem chart : · intro z hz have hr := congrArg Zsqrtd.re hz have hi := congrArg Zsqrtd.im hz - simp? [a, b, ho] at hr hi + simp only [Int.reduceNeg, ho, ↓reduceIte, mul_one, Zsqrtd.smul_val, mul_zero, + Zsqrtd.re_add, Zsqrtd.re_intCast, add_zero, Zsqrtd.im_add, Zsqrtd.im_intCast, + zero_add, a, b] at hr hi exact Prod.ext hr hi · cases ho : orientation <;> simp [a, b, ho] · obtain ⟨q, hsemi, hqC, hsmall, _⟩ := Or.resolve_left (BandGenealogy C) hc diff --git a/LeanPool/ApollonianSuperharmonic/TileStringExists.lean b/LeanPool/ApollonianSuperharmonic/TileStringExists.lean index 02501909c4..1de433d25f 100644 --- a/LeanPool/ApollonianSuperharmonic/TileStringExists.lean +++ b/LeanPool/ApollonianSuperharmonic/TileStringExists.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AffineTriangularStrip +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileStringCoordinateTransport -- [TABLET NODE: TileStringExists] diff --git a/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean index 243d0d40b8..fc09d2c5bf 100644 --- a/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean @@ -5,26 +5,11 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.AffineTriangularStrip -public import LeanPool.ApollonianSuperharmonic.BandCircle -public import LeanPool.ApollonianSuperharmonic.BandPrototile -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry -public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation -public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization -public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.RegularTileFamily -public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileRealization +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileString public import LeanPool.ApollonianSuperharmonic.TileStringCoordinateTransport public import LeanPool.ApollonianSuperharmonic.TileStringCentralCovariance -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.TriangularMaxIncrement -public import LeanPool.ApollonianSuperharmonic.TriangularSignedHeight -public import LeanPool.ApollonianSuperharmonic.TriangularStripSegment -- [TABLET NODE: TileStringRegularFamilyCentralCovariance] diff --git a/LeanPool/ApollonianSuperharmonic/TileStringUnique.lean b/LeanPool/ApollonianSuperharmonic/TileStringUnique.lean index 71ae7a5052..5296fdeea0 100644 --- a/LeanPool/ApollonianSuperharmonic/TileStringUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/TileStringUnique.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileStringCoordinateTransport -public import LeanPool.ApollonianSuperharmonic.AffineTriangularStrip -- [TABLET NODE: TileStringUnique] diff --git a/LeanPool/ApollonianSuperharmonic/TileSubodometer.lean b/LeanPool/ApollonianSuperharmonic/TileSubodometer.lean index 0108e562a8..75a452d712 100644 --- a/LeanPool/ApollonianSuperharmonic/TileSubodometer.lean +++ b/LeanPool/ApollonianSuperharmonic/TileSubodometer.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileOdometer -- [TABLET NODE: TileSubodometer] diff --git a/LeanPool/ApollonianSuperharmonic/TileSubodometerLiteralDecompositionPiece.lean b/LeanPool/ApollonianSuperharmonic/TileSubodometerLiteralDecompositionPiece.lean index 93eedaa2f3..221c72f9a4 100644 --- a/LeanPool/ApollonianSuperharmonic/TileSubodometerLiteralDecompositionPiece.lean +++ b/LeanPool/ApollonianSuperharmonic/TileSubodometerLiteralDecompositionPiece.lean @@ -5,12 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain -public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition public import LeanPool.ApollonianSuperharmonic.TileSubodometer +public import LeanPool.ApollonianSuperharmonic.BandCircle -- [TABLET NODE: TileSubodometerLiteralDecompositionPiece] diff --git a/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean b/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean index bb1f3b5f2c..b266b09938 100644 --- a/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean +++ b/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean @@ -5,18 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches -public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn -public import LeanPool.ApollonianSuperharmonic.ConsecutivePatchInterface -public import LeanPool.ApollonianSuperharmonic.ExactPatchBoundaryInterface -public import LeanPool.ApollonianSuperharmonic.FinitePatchTopology -public import LeanPool.ApollonianSuperharmonic.LatticeTileDiskUnionInterface -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.TileCellComplement public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance diff --git a/LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean b/LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean index 49dc91cc76..5cce1a9d5c 100644 --- a/LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean +++ b/LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean @@ -5,17 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandTwelveParentSurround public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate -public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -public import LeanPool.ApollonianSuperharmonic.ProtoTile -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.TileCentroid -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileRealization -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.UniqueBoundedGridComplementComponent -- [TABLET NODE: TileT2QuarterTurn] diff --git a/LeanPool/ApollonianSuperharmonic/TileT3TranslateTouching.lean b/LeanPool/ApollonianSuperharmonic/TileT3TranslateTouching.lean index 10aeaaae45..a75d4e1a84 100644 --- a/LeanPool/ApollonianSuperharmonic/TileT3TranslateTouching.lean +++ b/LeanPool/ApollonianSuperharmonic/TileT3TranslateTouching.lean @@ -5,19 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.PeriodicTileIndexedMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport -public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas -public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas -public import LeanPool.ApollonianSuperharmonic.TouchingTriple -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells -public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation public import LeanPool.ApollonianSuperharmonic.TileT1DiskArea public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleLatticeTouching -public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance -- [TABLET NODE: TileT3TranslateTouching] diff --git a/LeanPool/ApollonianSuperharmonic/TileT4ParentTranslateTouching.lean b/LeanPool/ApollonianSuperharmonic/TileT4ParentTranslateTouching.lean index fe789ff192..76b9ef2418 100644 --- a/LeanPool/ApollonianSuperharmonic/TileT4ParentTranslateTouching.lean +++ b/LeanPool/ApollonianSuperharmonic/TileT4ParentTranslateTouching.lean @@ -5,10 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import Mathlib.Init + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMixedAggregatePatches -- [TABLET NODE: TileT4ParentTranslateTouching] diff --git a/LeanPool/ApollonianSuperharmonic/TileT5ParentTouching.lean b/LeanPool/ApollonianSuperharmonic/TileT5ParentTouching.lean index cb3c625c3a..b805b91ea0 100644 --- a/LeanPool/ApollonianSuperharmonic/TileT5ParentTouching.lean +++ b/LeanPool/ApollonianSuperharmonic/TileT5ParentTouching.lean @@ -5,10 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces -public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation -public import LeanPool.ApollonianSuperharmonic.PeriodicTileMultiplicityOne -public import LeanPool.ApollonianSuperharmonic.TouchingTriple -- [TABLET NODE: TileT5ParentTouching] diff --git a/LeanPool/ApollonianSuperharmonic/TileTouching.lean b/LeanPool/ApollonianSuperharmonic/TileTouching.lean index fab4be5544..c57a625a1a 100644 --- a/LeanPool/ApollonianSuperharmonic/TileTouching.lean +++ b/LeanPool/ApollonianSuperharmonic/TileTouching.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.SimpleGridPath diff --git a/LeanPool/ApollonianSuperharmonic/TileTouchingCovariance.lean b/LeanPool/ApollonianSuperharmonic/TileTouchingCovariance.lean index 29a1d561e9..7dc8cf2221 100644 --- a/LeanPool/ApollonianSuperharmonic/TileTouchingCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/TileTouchingCovariance.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas diff --git a/LeanPool/ApollonianSuperharmonic/TileTranslation.lean b/LeanPool/ApollonianSuperharmonic/TileTranslation.lean index 11a4e9267c..d7ac4f8d31 100644 --- a/LeanPool/ApollonianSuperharmonic/TileTranslation.lean +++ b/LeanPool/ApollonianSuperharmonic/TileTranslation.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GaussianTranslation public import LeanPool.ApollonianSuperharmonic.ProtoTile diff --git a/LeanPool/ApollonianSuperharmonic/TileTranslationFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileTranslationFormulas.lean index ab2b0ef7d0..861e802cde 100644 --- a/LeanPool/ApollonianSuperharmonic/TileTranslationFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/TileTranslationFormulas.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint public import LeanPool.ApollonianSuperharmonic.TileCentroid public import LeanPool.ApollonianSuperharmonic.TileRealization public import LeanPool.ApollonianSuperharmonic.TileTranslation @@ -95,7 +96,8 @@ private theorem translationCentroid (T : ProtoTile) (u : GaussianInt) : (GaussianInt.toComplex (GaussianTranslation u x)).im = (GaussianInt.toComplex x).im + (GaussianInt.toComplex u).im := by cases x; cases u; simp [GaussianTranslation] - simp? [TileCentroid, h] + simp only [TileCentroid, Finset.image_nonempty, h, ↓reduceIte, Int.reduceNeg, + Int.cast_sum, GaussianInt.intCast_re, one_div, GaussianInt.intCast_im, Prod.mk.injEq] rw [Finset.card_image_of_injective T.cells hinj] rw [Finset.sum_image hinj.injOn] rw [Finset.sum_image hinj.injOn] @@ -121,7 +123,9 @@ private theorem translationVertices (T : ProtoTile) (u : GaussianInt) : dsimp [TileTranslation] by_cases h : T.cells.Nonempty · ext v - simp? [FootprintVertices, h, GaussianTranslation] + simp only [FootprintVertices, Finset.image_nonempty, h, ↓reduceIte, Finset.mem_image, + GaussianTranslation, Int.reduceNeg, exists_exists_and_eq_and, Set.mem_ofPred_eq, + Set.mem_image] constructor · rintro ⟨a, ha, hv⟩ rcases hv with h0 | h1 | h2 | h3 @@ -145,7 +149,8 @@ private theorem translationEdges (T : ProtoTile) (u : GaussianInt) : FootprintEdges T := by dsimp [TileTranslation] ext e - simp? [FootprintEdges, GaussianTranslation] + simp only [FootprintEdges, Finset.mem_image, GaussianTranslation, Int.reduceNeg, + exists_exists_and_eq_and, Set.mem_ofPred_eq, Set.mem_image] constructor · rintro ⟨a, ha, he⟩ rcases he with h0 | h1 | h2 | h3 diff --git a/LeanPool/ApollonianSuperharmonic/TilingLattice.lean b/LeanPool/ApollonianSuperharmonic/TilingLattice.lean index 499fc66537..d634ccfa34 100644 --- a/LeanPool/ApollonianSuperharmonic/TilingLattice.lean +++ b/LeanPool/ApollonianSuperharmonic/TilingLattice.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandVectors public import LeanPool.ApollonianSuperharmonic.BandCircle diff --git a/LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean b/LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean index 88e149d286..6cac264f23 100644 --- a/LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean +++ b/LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -- [TABLET NODE: TilingLatticeBasis] @@ -43,7 +44,8 @@ private theorem relation : have e0 := first.2.2.1 have e1 := second.2.2.1 have e2 := third.2.2.1 - simp? [r, s] at e1 e2 + simp only [Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, Int.reduceNeg, + Matrix.cons_val, r, s] at e1 e2 rw [e0, e1, e2] calc _ = (1 - (⟨0, 1⟩ : GaussianInt)) * @@ -180,7 +182,7 @@ private theorem generator_mem : · rw [hx, ← hk, ← hl, hr0, ← hC] exact AddSubgroup.subset_closure (by simp) · rw [hx, ← hk, ← hl, hr0, ← hC] - simp? at hl ⊢ + simp only [Fin.reduceFinMk, Fin.reduceSucc, Fin.isValue] at hl ⊢ have cneg : BandVectors.1 (q 3) (q 0) = -(BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0)) := by apply eq_neg_of_add_eq_zero_left @@ -406,7 +408,9 @@ private theorem unique_coordinates : intro q determinantNumber determinant_nonzero m n h have realpart := congrArg (fun z : GaussianInt => z.re) h have imagpart := congrArg (fun z : GaussianInt => z.im) h - simp? at realpart imagpart + simp only [Int.reduceNeg, Fin.isValue, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.re_intCast, + Zsqrtd.im_intCast, mul_zero, zero_mul, add_zero, Zsqrtd.im_add, Zsqrtd.im_mul] + at realpart imagpart have realzero : (m.1 - n.1) * (BandVectors.1 (q 1) (q 0)).re + (m.2 - n.2) * (BandVectors.1 (q 2) (q 0)).re = 0 := by diff --git a/LeanPool/ApollonianSuperharmonic/TilingLatticeCocycleExtension.lean b/LeanPool/ApollonianSuperharmonic/TilingLatticeCocycleExtension.lean index 50bfaf400e..2b4ee37641 100644 --- a/LeanPool/ApollonianSuperharmonic/TilingLatticeCocycleExtension.lean +++ b/LeanPool/ApollonianSuperharmonic/TilingLatticeCocycleExtension.lean @@ -5,9 +5,33 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector -public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureGeneratorCocycles public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction +public import Mathlib.Analysis.SpecialFunctions.Pow.NNReal +public import Mathlib.Combinatorics.SimpleGraph.Init +public import Mathlib.Tactic.Basify +public import Mathlib.Tactic.Echelon.Zsqrtd +public import Mathlib.Tactic.Inclusion.Extension.Core.Core +public import Mathlib.Tactic.Inclusion.Extension.IntervalDyadicReal.Hypotheses +public import Mathlib.Tactic.Inclusion.Extension.IntervalDyadicReal.Rational +public import Mathlib.Tactic.Measurability.Init +public import Mathlib.Tactic.NormNum.Irrational +public import Mathlib.Tactic.NormNum.IsCoprime +public import Mathlib.Tactic.NormNum.IsSquare +public import Mathlib.Tactic.NormNum.LegendreSymbol +public import Mathlib.Tactic.NormNum.ModEq +public import Mathlib.Tactic.NormNum.NatFib +public import Mathlib.Tactic.NormNum.NatLog +public import Mathlib.Tactic.NormNum.NatSqrt +public import Mathlib.Tactic.NormNum.Ordinal +public import Mathlib.Tactic.NormNum.Parity +public import Mathlib.Tactic.NormNum.Prime +public import Mathlib.Tactic.NormNum.RealSqrt +public import Mathlib.Tactic.Polynomial.Basic +public import Mathlib.Tactic.ReduceModChar -- [TABLET NODE: TilingLatticeCocycleExtension] diff --git a/LeanPool/ApollonianSuperharmonic/TilingLatticeInclusion.lean b/LeanPool/ApollonianSuperharmonic/TilingLatticeInclusion.lean index 9b566df664..2ce00db096 100644 --- a/LeanPool/ApollonianSuperharmonic/TilingLatticeInclusion.lean +++ b/LeanPool/ApollonianSuperharmonic/TilingLatticeInclusion.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector public import LeanPool.ApollonianSuperharmonic.IntegralityLattice public import LeanPool.ApollonianSuperharmonic.TilingLattice diff --git a/LeanPool/ApollonianSuperharmonic/TilingLatticeIndex.lean b/LeanPool/ApollonianSuperharmonic/TilingLatticeIndex.lean index afe2eb4307..b02ab2e6fa 100644 --- a/LeanPool/ApollonianSuperharmonic/TilingLatticeIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/TilingLatticeIndex.lean @@ -5,13 +5,12 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.VectorDeterminant public import LeanPool.ApollonianSuperharmonic.TilingLattice public import LeanPool.ApollonianSuperharmonic.LatticeFundamentalSet public import LeanPool.ApollonianSuperharmonic.BandGenealogy -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.Preamble public import Mathlib.LinearAlgebra.FreeModule.Finite.CardQuotient -- [TABLET NODE: TilingLatticeIndex] @@ -49,7 +48,8 @@ private theorem relation : have e0 := first.2.2.1 have e1 := second.2.2.1 have e2 := third.2.2.1 - simp? [r, s] at e1 e2 + simp only [Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, Int.reduceNeg, + Matrix.cons_val, r, s] at e1 e2 rw [e0, e1, e2] calc _ = (1 - (⟨0, 1⟩ : GaussianInt)) * @@ -251,7 +251,9 @@ private theorem f_injective : intro q a b K determinant_positive f x y hxy have hre := congrArg (fun z : GaussianInt => z.re) (congrArg Subtype.val hxy) have him := congrArg (fun z : GaussianInt => z.im) (congrArg Subtype.val hxy) - simp? [f] at hre him + simp only [Int.reduceNeg, Fin.isValue, zsmul_eq_mul, LinearMap.coe_mk, AddHom.coe_mk, + Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.re_intCast, Zsqrtd.im_intCast, mul_zero, zero_mul, + add_zero, Zsqrtd.im_add, Zsqrtd.im_mul, f] at hre him have h0 : (a.re * b.im - a.im * b.re) * (x 0 - y 0) = 0 := by calc _ = b.im * ((x 0 * a.re + x 1 * b.re) - (y 0 * a.re + y 1 * b.re)) - diff --git a/LeanPool/ApollonianSuperharmonic/TopologicalDisk.lean b/LeanPool/ApollonianSuperharmonic/TopologicalDisk.lean index fa4f4cdb6f..1b8d4d1e63 100644 --- a/LeanPool/ApollonianSuperharmonic/TopologicalDisk.lean +++ b/LeanPool/ApollonianSuperharmonic/TopologicalDisk.lean @@ -5,7 +5,13 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Topology.MetricSpace.Pseudo.Constructions +public import Mathlib.Basic.Real.Basic +public import Mathlib.Data.Set.Basic +public import Mathlib.Topology.Homeomorph.Defs +public import Mathlib.Topology.MetricSpace.Pseudo.Real + -- [TABLET NODE: TopologicalDisk] diff --git a/LeanPool/ApollonianSuperharmonic/TopologicalDiskExponentialLift.lean b/LeanPool/ApollonianSuperharmonic/TopologicalDiskExponentialLift.lean index 7b20494021..8a93abd2ed 100644 --- a/LeanPool/ApollonianSuperharmonic/TopologicalDiskExponentialLift.lean +++ b/LeanPool/ApollonianSuperharmonic/TopologicalDiskExponentialLift.lean @@ -5,10 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TopologicalDisk public import Mathlib.Analysis.Complex.CoveringMap public import Mathlib.Analysis.Normed.Module.Connected -public import Mathlib.Topology.Algebra.Module.LocallyConvex public import Mathlib.Topology.Homotopy.Lifting /-! diff --git a/LeanPool/ApollonianSuperharmonic/TopologicalDiskGridRayCrossingIndexZero.lean b/LeanPool/ApollonianSuperharmonic/TopologicalDiskGridRayCrossingIndexZero.lean index f17b25c0d6..68afc9e92b 100644 --- a/LeanPool/ApollonianSuperharmonic/TopologicalDiskGridRayCrossingIndexZero.lean +++ b/LeanPool/ApollonianSuperharmonic/TopologicalDiskGridRayCrossingIndexZero.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.GridRayCrossingIndexZeroOfEdgeLifts public import LeanPool.ApollonianSuperharmonic.TopologicalDiskExponentialLift diff --git a/LeanPool/ApollonianSuperharmonic/TopologicalDiskLocallyPuncturedPreconnected.lean b/LeanPool/ApollonianSuperharmonic/TopologicalDiskLocallyPuncturedPreconnected.lean index 409049fe81..d4b4d5ed5e 100644 --- a/LeanPool/ApollonianSuperharmonic/TopologicalDiskLocallyPuncturedPreconnected.lean +++ b/LeanPool/ApollonianSuperharmonic/TopologicalDiskLocallyPuncturedPreconnected.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Tactic.Positivity + public import LeanPool.ApollonianSuperharmonic.TopologicalDisk public import Mathlib.Analysis.Convex.PathConnected diff --git a/LeanPool/ApollonianSuperharmonic/TouchingTriple.lean b/LeanPool/ApollonianSuperharmonic/TouchingTriple.lean index 1c072cff3f..ce0309d40e 100644 --- a/LeanPool/ApollonianSuperharmonic/TouchingTriple.lean +++ b/LeanPool/ApollonianSuperharmonic/TouchingTriple.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileTouching -- [TABLET NODE: TouchingTriple] diff --git a/LeanPool/ApollonianSuperharmonic/TouchingTripleCovariance.lean b/LeanPool/ApollonianSuperharmonic/TouchingTripleCovariance.lean index 3570b03cc7..dc59347a33 100644 --- a/LeanPool/ApollonianSuperharmonic/TouchingTripleCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/TouchingTripleCovariance.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance public import LeanPool.ApollonianSuperharmonic.TouchingTriple diff --git a/LeanPool/ApollonianSuperharmonic/TouchingTriplePermutations.lean b/LeanPool/ApollonianSuperharmonic/TouchingTriplePermutations.lean index a02d424f19..5e4fd4d459 100644 --- a/LeanPool/ApollonianSuperharmonic/TouchingTriplePermutations.lean +++ b/LeanPool/ApollonianSuperharmonic/TouchingTriplePermutations.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TouchingTriple -- [TABLET NODE: TouchingTriplePermutations] diff --git a/LeanPool/ApollonianSuperharmonic/TraceNonpositivePackingApproximation.lean b/LeanPool/ApollonianSuperharmonic/TraceNonpositivePackingApproximation.lean index 9dab5c9ac8..29ea3fe1c9 100644 --- a/LeanPool/ApollonianSuperharmonic/TraceNonpositivePackingApproximation.lean +++ b/LeanPool/ApollonianSuperharmonic/TraceNonpositivePackingApproximation.lean @@ -5,7 +5,8 @@ Authors: Wesley Pegden -/ module -public import Mathlib.Topology.Instances.Matrix +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandDiskExteriorDensity public import LeanPool.ApollonianSuperharmonic.CircleMatrixEnclosureCriterion diff --git a/LeanPool/ApollonianSuperharmonic/TranslatedMinimumEnvelope.lean b/LeanPool/ApollonianSuperharmonic/TranslatedMinimumEnvelope.lean index 2353a2ce7b..fd3fafb05e 100644 --- a/LeanPool/ApollonianSuperharmonic/TranslatedMinimumEnvelope.lean +++ b/LeanPool/ApollonianSuperharmonic/TranslatedMinimumEnvelope.lean @@ -5,12 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicRepresentative public import LeanPool.ApollonianSuperharmonic.IntegerLaplacianCastBridge -public import LeanPool.ApollonianSuperharmonic.QuadraticAffineLaplacian -public import LeanPool.ApollonianSuperharmonic.QuadraticGrowthAtInfinity public import LeanPool.ApollonianSuperharmonic.RealLaplacianContactComparison public import Mathlib.Order.Int.LeastGreatest +public import Mathlib.Algebra.BigOperators.Fin -- [TABLET NODE: TranslatedMinimumEnvelope] diff --git a/LeanPool/ApollonianSuperharmonic/TriangularBoundaryStrip.lean b/LeanPool/ApollonianSuperharmonic/TriangularBoundaryStrip.lean index 0d0c94bc48..ae2e699537 100644 --- a/LeanPool/ApollonianSuperharmonic/TriangularBoundaryStrip.lean +++ b/LeanPool/ApollonianSuperharmonic/TriangularBoundaryStrip.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TriangularMaxIncrement public import LeanPool.ApollonianSuperharmonic.TriangularSignedHeight diff --git a/LeanPool/ApollonianSuperharmonic/TriangularLatticeAdjacent.lean b/LeanPool/ApollonianSuperharmonic/TriangularLatticeAdjacent.lean index af60b95151..4b4ed38fc1 100644 --- a/LeanPool/ApollonianSuperharmonic/TriangularLatticeAdjacent.lean +++ b/LeanPool/ApollonianSuperharmonic/TriangularLatticeAdjacent.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Algebra.Order.Ring.Int +public import Mathlib.Algebra.Group.Prod + -- [TABLET NODE: TriangularLatticeAdjacent] diff --git a/LeanPool/ApollonianSuperharmonic/TriangularMaxIncrement.lean b/LeanPool/ApollonianSuperharmonic/TriangularMaxIncrement.lean index 7e365ca370..a5f5657627 100644 --- a/LeanPool/ApollonianSuperharmonic/TriangularMaxIncrement.lean +++ b/LeanPool/ApollonianSuperharmonic/TriangularMaxIncrement.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Algebra.Group.Prod +public import Mathlib.Algebra.Order.Ring.Int + -- [TABLET NODE: TriangularMaxIncrement] diff --git a/LeanPool/ApollonianSuperharmonic/TriangularSignedHeight.lean b/LeanPool/ApollonianSuperharmonic/TriangularSignedHeight.lean index bbdfde99d1..39e18ef2a1 100644 --- a/LeanPool/ApollonianSuperharmonic/TriangularSignedHeight.lean +++ b/LeanPool/ApollonianSuperharmonic/TriangularSignedHeight.lean @@ -5,7 +5,10 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init +public import Mathlib.Algebra.Group.Prod +public import Mathlib.Algebra.Order.Ring.Int + -- [TABLET NODE: TriangularSignedHeight] diff --git a/LeanPool/ApollonianSuperharmonic/TriangularStripSegment.lean b/LeanPool/ApollonianSuperharmonic/TriangularStripSegment.lean index 461b7dee00..023bc71a27 100644 --- a/LeanPool/ApollonianSuperharmonic/TriangularStripSegment.lean +++ b/LeanPool/ApollonianSuperharmonic/TriangularStripSegment.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.TriangularBoundaryStrip public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent diff --git a/LeanPool/ApollonianSuperharmonic/TriangularStripSegmentOrderInterval.lean b/LeanPool/ApollonianSuperharmonic/TriangularStripSegmentOrderInterval.lean index 78f64c502c..55b582d4dc 100644 --- a/LeanPool/ApollonianSuperharmonic/TriangularStripSegmentOrderInterval.lean +++ b/LeanPool/ApollonianSuperharmonic/TriangularStripSegmentOrderInterval.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import Mathlib.Data.List.Infix + public import LeanPool.ApollonianSuperharmonic.AffineTriangularStrip -- [TABLET NODE: TriangularStripSegmentOrderInterval] diff --git a/LeanPool/ApollonianSuperharmonic/UniqueBoundedGridComplementComponent.lean b/LeanPool/ApollonianSuperharmonic/UniqueBoundedGridComplementComponent.lean index 5bc062fced..5ecd5e738c 100644 --- a/LeanPool/ApollonianSuperharmonic/UniqueBoundedGridComplementComponent.lean +++ b/LeanPool/ApollonianSuperharmonic/UniqueBoundedGridComplementComponent.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: UniqueBoundedGridComplementComponent] diff --git a/LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientation.lean b/LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientation.lean index f4e28e0ddc..04dce2cd66 100644 --- a/LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientation.lean +++ b/LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientation.lean @@ -5,8 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -- [TABLET NODE: UnitOccurrenceOrientation] diff --git a/LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientationUnique.lean b/LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientationUnique.lean index 554467686f..9f71a9dd68 100644 --- a/LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientationUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/UnitOccurrenceOrientationUnique.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.P5455T2OccurrenceExists public import LeanPool.ApollonianSuperharmonic.P5455T2OccurrenceDeterministic public import LeanPool.ApollonianSuperharmonic.P5455T2LeftRegressions diff --git a/LeanPool/ApollonianSuperharmonic/UnitSquareOpposingStripInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/UnitSquareOpposingStripInterfacePath.lean index 757dc84ffa..876bb51ecd 100644 --- a/LeanPool/ApollonianSuperharmonic/UnitSquareOpposingStripInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/UnitSquareOpposingStripInterfacePath.lean @@ -5,15 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.AffineOpposingStripCorridor -public import LeanPool.ApollonianSuperharmonic.AffineTriangularCorridorStep -public import LeanPool.ApollonianSuperharmonic.AffineTriangularFaceVertices public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.TileTranslation -public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.TriangularStripSegment -public import Mathlib.Data.List.Chain -- [TABLET NODE: UnitSquareOpposingStripInterfacePath] diff --git a/LeanPool/ApollonianSuperharmonic/UnitTriangularStep.lean b/LeanPool/ApollonianSuperharmonic/UnitTriangularStep.lean index 1b90482faa..6c68fe799d 100644 --- a/LeanPool/ApollonianSuperharmonic/UnitTriangularStep.lean +++ b/LeanPool/ApollonianSuperharmonic/UnitTriangularStep.lean @@ -5,7 +5,9 @@ Authors: Wesley Pegden -/ module -public import LeanPool.ApollonianSuperharmonic.Preamble +public import Mathlib.Init + +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: UnitTriangularStep] diff --git a/LeanPool/ApollonianSuperharmonic/VectorDeterminant.lean b/LeanPool/ApollonianSuperharmonic/VectorDeterminant.lean index 2b5fde114a..9217784c99 100644 --- a/LeanPool/ApollonianSuperharmonic/VectorDeterminant.lean +++ b/LeanPool/ApollonianSuperharmonic/VectorDeterminant.lean @@ -5,6 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification + public import LeanPool.ApollonianSuperharmonic.VectorNonvanishing -- [TABLET NODE: VectorDeterminant] @@ -39,34 +42,8 @@ theorem VectorDeterminant (q : Fin 4 → CircleCoordinates) have hnon13 := VectorNonvanishing q hq 1 3 (by decide) (Or.inl hc) have hnon21 := VectorNonvanishing q hq 2 1 (by decide) (Or.inr hc) have nonnegative : ∀ r : Fin 4 → CircleCoordinates, - SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 := by - intro r hr - induction hr with - | base z => intro k; fin_cases k <;> simp - | rotate hr ih => - intro k - fin_cases k - · simpa using ih 0 - · simpa using ih 2 - · simpa using ih 3 - · simpa using ih 1 - | @successor r hr ih => - intro k - have classification := BandSuccessorClassification r hr - dsimp at classification - rcases classification with special | proper - · fin_cases k - · simp [special] - · simpa using ih 0 - · simpa using ih 2 - · simpa using ih 3 - · rcases proper with ⟨_, larger0, larger2, larger3⟩ - fin_cases k - · change 0 ≤ 2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1 - exact (ih 0).trans larger0.le - · exact ih 0 - · exact ih 2 - · exact ih 3 + SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 := + fun r hr => (SemiProperForestClassification r hr).1 have hcurv := nonnegative q hq have hnorm13sq : Zsqrtd.norm (BandVectors.1 (q 1) (q 3) * BandVectors.1 (q 1) (q 3)) = @@ -182,7 +159,11 @@ theorem VectorDeterminant (q : Fin 4 → CircleCoordinates) have realpart := congrArg (fun z : GaussianInt => z.re) hfirst have determinant := congrArg (fun z : GaussianInt => z.im) flip' have determinant' := congrArg (fun z : GaussianInt => z.re) flip' - simp? at realpart determinant determinant' + simp only [Int.reduceNeg, Fin.isValue, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.re_star, + Zsqrtd.im_star, mul_neg, neg_mul, one_mul, neg_neg, Int.cast_neg, Int.cast_mul, + Int.cast_ofNat, Zsqrtd.re_neg, Zsqrtd.re_ofNat, Nat.cast_ofNat, Zsqrtd.re_intCast, + Zsqrtd.im_ofNat, mul_zero, Zsqrtd.im_intCast, add_zero, Zsqrtd.im_mul, zero_mul, + zero_add, mul_one] at realpart determinant determinant' rw [determinant, determinant'] have dot : (BandVectors.1 (q 1) (q 3)).re * (BandVectors.1 (q 2) (q 1)).re + @@ -207,7 +188,11 @@ theorem VectorDeterminant (q : Fin 4 → CircleCoordinates) have realpart := congrArg (fun z : GaussianInt => z.re) hfirst have determinant := congrArg (fun z : GaussianInt => z.im) flip' have determinant' := congrArg (fun z : GaussianInt => z.re) flip' - simp? at realpart determinant determinant' + simp only [Int.reduceNeg, Fin.isValue, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.re_star, + Zsqrtd.im_star, mul_neg, neg_mul, one_mul, neg_neg, Int.cast_neg, Int.cast_mul, + Int.cast_ofNat, Zsqrtd.re_neg, Zsqrtd.re_ofNat, Nat.cast_ofNat, Zsqrtd.re_intCast, + Zsqrtd.im_ofNat, mul_zero, Zsqrtd.im_intCast, add_zero, Zsqrtd.im_mul, zero_mul, + zero_add, mul_one] at realpart determinant determinant' have imagpart : (BandVectors.1 (q 3) (q 1)).im = -(BandVectors.1 (q 1) (q 3)).re := by omega rw [← determinant, imagpart] diff --git a/LeanPool/ApollonianSuperharmonic/VectorNonvanishing.lean b/LeanPool/ApollonianSuperharmonic/VectorNonvanishing.lean index 1394e821ca..e432aeb046 100644 --- a/LeanPool/ApollonianSuperharmonic/VectorNonvanishing.lean +++ b/LeanPool/ApollonianSuperharmonic/VectorNonvanishing.lean @@ -5,8 +5,10 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification + public import LeanPool.ApollonianSuperharmonic.VectorSquareProduct -public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity -- [TABLET NODE: VectorNonvanishing] @@ -27,36 +29,8 @@ theorem VectorNonvanishing (q : Fin 4 → CircleCoordinates) BandVectors.1 (q i) (q j) ≠ 0 := by -- BODY have nonnegative : ∀ r : Fin 4 → CircleCoordinates, - SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 := by - intro r hr - induction hr with - | base z => - intro k - fin_cases k <;> simp - | rotate hr ih => - intro k - fin_cases k - · simpa using ih 0 - · simpa using ih 2 - · simpa using ih 3 - · simpa using ih 1 - | @successor r hr ih => - intro k - have classification := BandSuccessorClassification r hr - dsimp at classification - rcases classification with special | proper - · fin_cases k - · simp [special] - · simpa using ih 0 - · simpa using ih 2 - · simpa using ih 3 - · rcases proper with ⟨_, larger0, larger2, larger3⟩ - fin_cases k - · change 0 ≤ 2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1 - exact (ih 0).trans larger0.le - · exact ih 0 - · exact ih 2 - · exact ih 3 + SemiProperQuadruple r → ∀ k : Fin 4, 0 ≤ (r k).1 := + fun r hr => (SemiProperForestClassification r hr).1 have hnonneg := nonnegative q hq have hsum : 0 < (q i).1 + (q j).1 := by rcases hpositive with hi | hj diff --git a/LeanPool/ApollonianSuperharmonic/VectorRecursionLaws.lean b/LeanPool/ApollonianSuperharmonic/VectorRecursionLaws.lean index adbb64e5cc..871f47176f 100644 --- a/LeanPool/ApollonianSuperharmonic/VectorRecursionLaws.lean +++ b/LeanPool/ApollonianSuperharmonic/VectorRecursionLaws.lean @@ -5,10 +5,9 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandVectors -public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorsExistUnique -- [TABLET NODE: VectorRecursionLaws] @@ -50,7 +49,8 @@ theorem VectorRecursionLaws (q : Fin 4 → CircleCoordinates) induction hq with | base z => have baseFacts := baseLaw z - simp? at baseFacts + simp only [Int.reduceNeg, Fin.isValue, Matrix.cons_val, Matrix.cons_val_one, + Matrix.cons_val_zero] at baseFacts rcases baseFacts with ⟨v32, v21, v13, a32, a21, a13⟩ have rotatedFacts := stepLaw (![(1, 1 + 2 * z), (0, -1), (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)), (0, 1)]) diff --git a/LeanPool/ApollonianSuperharmonic/VectorSquareProduct.lean b/LeanPool/ApollonianSuperharmonic/VectorSquareProduct.lean index 69b045b3b7..6beee43ff8 100644 --- a/LeanPool/ApollonianSuperharmonic/VectorSquareProduct.lean +++ b/LeanPool/ApollonianSuperharmonic/VectorSquareProduct.lean @@ -5,19 +5,11 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Init + public import LeanPool.ApollonianSuperharmonic.BandSuccessorClassification public import LeanPool.ApollonianSuperharmonic.BandVectors public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws -public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorsExistUnique -public import LeanPool.ApollonianSuperharmonic.RecursiveVectorSystem -public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple -public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation -public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification -public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple -public import Mathlib.Tactic.FinCases -public import Mathlib.Tactic.LinearCombination -public import Mathlib.Tactic.Ring -- [TABLET NODE: VectorSquareProduct] From 6713da160436c1757cb5c649296234d45c6f3c0b Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Thu, 12 Nov 2026 13:11:13 +0000 Subject: [PATCH 03/23] Simplify finite ownership selection proof --- .../P4431T1OwnerTransitionSelector.lean | 45 +++---------------- 1 file changed, 5 insertions(+), 40 deletions(-) diff --git a/LeanPool/ApollonianSuperharmonic/P4431T1OwnerTransitionSelector.lean b/LeanPool/ApollonianSuperharmonic/P4431T1OwnerTransitionSelector.lean index 1fb257dadc..ac086ce6f1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4431T1OwnerTransitionSelector.lean +++ b/LeanPool/ApollonianSuperharmonic/P4431T1OwnerTransitionSelector.lean @@ -6,11 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init -public import Mathlib.Data.Fintype.Fin +public import Aesop public import Mathlib.Algebra.Group.Fin.Basic -public import Mathlib.Data.Fin.VecNotation -public import Mathlib.Tactic.ClearExcept -public import Mathlib.Tactic.FinCases -- [TABLET NODE: P4431T1OwnerTransitionSelector] @@ -40,42 +37,10 @@ theorem P4431T1OwnerTransitionSelector {α : Type*} (o i = o (i + 3) ∨ o (i + 1) = o (i + 2)) := by -- BODY classical - have finite_selection : - ∀ (a b c d : Fin 4) (sa sb sc sd : Bool), - let p : Fin 4 → Fin 4 := ![a, b, c, d] - let t : Fin 4 → Bool := ![sa, sb, sc, sd] - (∀ i k, t i ≠ t (i + 1) → - (p k = p i → t k = t i) ∧ - (p k = p (i + 1) → t k = t (i + 1))) → - (a = b ∨ a = c ∨ a = d ∨ b = c ∨ b = d ∨ c = d) → - ¬ ((a = c ∧ b ≠ a ∧ d ≠ a) ∨ - (b = d ∧ a ≠ b ∧ c ≠ b)) → - (sa ≠ sc ∨ sb ≠ sd) → - ∃ i, t i ≠ t (i + 1) ∧ - (p i = p (i + 3) ∨ p (i + 1) = p (i + 2)) := by - exact ((((by decide +kernel)))) - let encode : α → Fin 4 := fun a => - if a = o 0 then 0 else if a = o 1 then 1 else if a = o 2 then 2 else 3 - have encode_eq (i j : Fin 4) : encode (o i) = encode (o j) ↔ o i = o j := by - clear * - o encode - fin_cases i <;> fin_cases j <;> - simp only [ Fin.isValue, Fin.zero_eta, ↓reduceIte, encode, Fin.mk_one, left_eq_ite_iff, - Fin.reduceFinMk, ite_eq_left_iff ] <;> - (try split_ifs) <;> simp_all [eq_comm] - have ho : ![encode (o 0), encode (o 1), encode (o 2), encode (o 3)] = - fun i => encode (o i) := by - funext i - fin_cases i <;> rfl - have hs : ![s 0, s 1, s 2, s 3] = s := by - funext i - fin_cases i <;> rfl - have hf := finite_selection (encode (o 0)) (encode (o 1)) - (encode (o 2)) (encode (o 3)) (s 0) (s 1) (s 2) (s 3) - dsimp only at hf - rw [ho, hs] at hf - simp only [ne_eq, encode_eq] at hf - exact hf (fun i k h => ⟨hleft i k h, hright i k h⟩) - hrepeat hchecker hopposite + cases h0 : s 0 <;> cases h1 : s 1 <;> cases h2 : s 2 <;> cases h3 : s 3 + all_goals simp [Fin.forall_fin_succ, h0, h1, h2, h3] at hleft hright hopposite + all_goals simp [Fin.exists_fin_succ, h0, h1, h2, h3] + all_goals aesop end ApollonianSuperharmonic From e38241e06e3b764ac61223d4447cdf5aba982ae5 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Thu, 12 Nov 2026 14:06:20 +0000 Subject: [PATCH 04/23] Share the tile odometer domain proof --- .../BandOdometerTheorem.lean | 57 +------------ LeanPool/ApollonianSuperharmonic/Imports.lean | 1 + .../IntegralityLattice.lean | 2 +- .../PositiveCurvatureGeneratorCocycles.lean | 50 +----------- .../PositiveCurvatureTileOdometerDomain.lean | 60 +------------- .../TileOdometerDomain.lean | 80 +++++++++++++++++++ 6 files changed, 89 insertions(+), 161 deletions(-) create mode 100644 LeanPool/ApollonianSuperharmonic/TileOdometerDomain.lean diff --git a/LeanPool/ApollonianSuperharmonic/BandOdometerTheorem.lean b/LeanPool/ApollonianSuperharmonic/BandOdometerTheorem.lean index a14c24b709..81f40710ac 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOdometerTheorem.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOdometerTheorem.lean @@ -9,6 +9,7 @@ public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.BandLatticeEquality +public import LeanPool.ApollonianSuperharmonic.TileOdometerDomain public import LeanPool.ApollonianSuperharmonic.BandOdometerMaximality public import LeanPool.ApollonianSuperharmonic.BandPeriodicSuperharmonicity @@ -37,62 +38,8 @@ theorem BandOdometerTheorem : ∀ C : BandCircle, -- BODY intro C obtain ⟨T, h, g, hT, hodo, hext, hcocycle, hremainder⟩ := BandPeriodicOdometer C - have domain_from_odo : ∀ (c : CircleCoordinates) (U : ProtoTile) (k : PartialOdometer), - TileOdometer c U k → (k.domain : Set GaussianInt) = FootprintVertices U := by - intro c U k ho - induction ho with - | line w x hw k hdom => - simp [hdom, FootprintVertices] - | unit z x U k hU hdom htrans => - exact hdom - | @decompose q hq S U hs k hU hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => - ext y - change (y ∈ k.domain) ↔ y ∈ FootprintVertices U - rw [hdom] - have child (i : Fin 3) (s : Bool) : - (hs i s).domain = FootprintVertices (S i s) := - ih i s - change (∃ i s, y ∈ (hs i s).domain) ↔ y ∈ FootprintVertices U - have union : (∃ i s, y ∈ (hs i s).domain) ↔ - ∃ i s, y ∈ FootprintVertices (S i s) := by - constructor - · rintro ⟨i, s, hy⟩ - exact ⟨i, s, (Set.ext_iff.mp (child i s) y).mp hy⟩ - · rintro ⟨i, s, hy⟩ - exact ⟨i, s, (Set.ext_iff.mp (child i s) y).mpr hy⟩ - rw [union] - clear hq hU hsub hcentroid hvalue hcompat hslope ih child union - classical - simp only [FootprintVertices] - constructor - · rintro ⟨i, s, hy⟩ - exact hfoot i s hy - · intro hy - by_cases hu : U.cells.Nonempty - · simp only [ite_eq_left hu, Set.mem_ofPred_eq] at hy - rcases hy with ⟨x, hx, hv⟩ - rcases (hcells x).mp hx with ⟨i, s, hxs⟩ - have hs : (S i s).cells.Nonempty := ⟨x, hxs⟩ - refine ⟨i, s, ?_⟩ - simp only [ite_eq_left hs, Set.mem_ofPred_eq] - exact ⟨x, hxs, hv⟩ - · have hs_empty : ∀ i s, ¬ (S i s).cells.Nonempty := by - intro i s hs - rcases hs with ⟨x, hx⟩ - apply hu - exact ⟨x, (hcells x).mpr ⟨i, s, hx⟩⟩ - have ha : (S 0 false).anchor = U.anchor := by - have hh := hfoot 0 false - rw [FootprintVertices, ite_eq_right (hs_empty 0 false), - FootprintVertices, ite_eq_right hu] at hh - have hm := hh (Set.mem_singleton _) - simpa using hm - simp only [ite_eq_right hu, Set.mem_singleton_iff] at hy - refine ⟨0, false, ?_⟩ - simp only [ite_eq_right (hs_empty 0 false), Set.mem_singleton_iff] - simpa [ha] using hy have hdom : (h.domain : Set GaussianInt) = FootprintVertices T := by - exact domain_from_odo _ _ _ hodo + exact TileOdometerDomain _ _ _ hodo classical have tiling_data : LatticeTile T ∧ ExactTileTiling (RegularTileFamily T (TilingLattice C)) := by diff --git a/LeanPool/ApollonianSuperharmonic/Imports.lean b/LeanPool/ApollonianSuperharmonic/Imports.lean index 420c4c07ff..b5722c7cb0 100644 --- a/LeanPool/ApollonianSuperharmonic/Imports.lean +++ b/LeanPool/ApollonianSuperharmonic/Imports.lean @@ -1186,6 +1186,7 @@ public import LeanPool.ApollonianSuperharmonic.TileOdometer public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.TileOdometerDomain public import LeanPool.ApollonianSuperharmonic.TileOdometerExists public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness diff --git a/LeanPool/ApollonianSuperharmonic/IntegralityLattice.lean b/LeanPool/ApollonianSuperharmonic/IntegralityLattice.lean index b49ce52186..5f9b7afcf6 100644 --- a/LeanPool/ApollonianSuperharmonic/IntegralityLattice.lean +++ b/LeanPool/ApollonianSuperharmonic/IntegralityLattice.lean @@ -31,7 +31,7 @@ $$ $$ Matrix linearity shows directly that this set contains zero and is closed under addition and negation, so $L_C$ is regarded as an additive subgroup of -$\mathbb Z[i]$. This is the matrix-integrality lattice from equation (1.5) +$\mathbb Z[i]$. This is the matrix-integrality lattice from equation (1.4) of the paper. -/ def IntegralityLattice (C : BandCircle) : AddSubgroup GaussianInt where diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean index d047e83c5e..5281b06928 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean @@ -9,6 +9,7 @@ public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTranslatedOdometers public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends +public import LeanPool.ApollonianSuperharmonic.TileOdometerDomain public import LeanPool.ApollonianSuperharmonic.BandTileTopologyApplication -- [TABLET NODE: PositiveCurvatureGeneratorCocycles] @@ -26,53 +27,6 @@ namespace ApollonianSuperharmonic namespace GeneratorCocycleGeometry -private theorem domain_from_odo : - (by - classical - exact - ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), TileOdometer c U k - → (k.domain : Set GaussianInt) = FootprintVertices U ) := by - classical - intro c U k ho - induction ho with - | line w x hw k hdom => - simp [hdom, FootprintVertices] - | unit z x U k hU hdom htrans => exact hdom - | @decompose q hq S U hs k hU hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => - ext y - change (y ∈ k.domain) ↔ y ∈ FootprintVertices U - rw [hdom] - have child (i : Fin 3) (s : Bool) : - (hs i s).domain = FootprintVertices (S i s) := ih i s - constructor - · rintro ⟨i, s, hy⟩ - exact hfoot i s ((Set.ext_iff.mp (child i s) y).mp hy) - · intro hy - by_cases hu : U.cells.Nonempty - · simp only [FootprintVertices, ite_eq_left hu, Set.mem_ofPred_eq] at hy - rcases hy with ⟨x, hx, hv⟩ - rcases (hcells x).mp hx with ⟨i, s, hxs⟩ - refine ⟨i, s, (Set.ext_iff.mp (child i s) y).mpr ?_⟩ - simp only [FootprintVertices, ite_eq_left (show (S i s).cells.Nonempty from ⟨x, hxs⟩), - Set.mem_ofPred_eq] - exact ⟨x, hxs, hv⟩ - · have hs_empty : ∀ i s, ¬ (S i s).cells.Nonempty := by - intro i s hi - apply hu - rcases hi with ⟨x, hx⟩ - exact ⟨x, (hcells x).mpr ⟨i, s, hx⟩⟩ - simp only [FootprintVertices, ite_eq_right hu, Set.mem_singleton_iff] at hy - have hh := hfoot 0 false - rw [FootprintVertices, ite_eq_right (hs_empty 0 false), - FootprintVertices, ite_eq_right hu] at hh - refine ⟨0, false, (Set.ext_iff.mp (child 0 false) y).mpr ?_⟩ - have ha : (S 0 false).anchor = U.anchor := by - simpa [Set.singleton_subset_iff] using hh - simp only [FootprintVertices, ite_eq_right (hs_empty 0 false), - Set.mem_singleton_iff] - rw [ha] - exact hy - private theorem hcoords : (by classical @@ -394,7 +348,7 @@ theorem PositiveCurvatureGeneratorCocycles (C : BandCircle) -- BODY obtain ⟨q, T, h, H, hq, hqC, hT, hodo, htrans, hcompat⟩ := PositiveCurvatureTranslatedOdometers C hc - have domain_from_odo := GeneratorCocycleGeometry.domain_from_odo + have domain_from_odo := TileOdometerDomain have hdom : (h.domain : Set GaussianInt) = FootprintVertices T := domain_from_odo _ _ _ hodo have tiling : ExactTileTiling (RegularTileFamily T (TilingLattice C)) := diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerDomain.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerDomain.lean index 81e51f5b8f..d408cc6855 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerDomain.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerDomain.lean @@ -7,7 +7,7 @@ module public import Mathlib.Init -public import LeanPool.ApollonianSuperharmonic.TileOdometer +public import LeanPool.ApollonianSuperharmonic.TileOdometerDomain -- [TABLET NODE: PositiveCurvatureTileOdometerDomain] @@ -25,63 +25,9 @@ namespace ApollonianSuperharmonic theorem PositiveCurvatureTileOdometerDomain : ∀ (C : CircleCoordinates), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), (0 < C.1) → ((TileOdometer C T h) → ((h.domain : Set GaussianInt) = FootprintVertices T)) := by - intro C T h hC hO + intro C T h _ hO -- BODY - have domain_from_odo : ∀ (c : CircleCoordinates) (U : ProtoTile) (k : PartialOdometer), - TileOdometer c U k → (k.domain : Set GaussianInt) = FootprintVertices U := by - intro c U k ho - induction ho with - | line w x hw k hdom => - simp [hdom, FootprintVertices] - | unit z x U k hU hdom htrans => - exact hdom - | @decompose q hq S U hs k hU hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => - ext y - change (y ∈ k.domain) ↔ y ∈ FootprintVertices U - rw [hdom] - have child (i : Fin 3) (s : Bool) : - (hs i s).domain = FootprintVertices (S i s) := - ih i s - change (∃ i s, y ∈ (hs i s).domain) ↔ y ∈ FootprintVertices U - have union : (∃ i s, y ∈ (hs i s).domain) ↔ - ∃ i s, y ∈ FootprintVertices (S i s) := by - constructor - · rintro ⟨i, s, hy⟩ - exact ⟨i, s, (Set.ext_iff.mp (child i s) y).mp hy⟩ - · rintro ⟨i, s, hy⟩ - exact ⟨i, s, (Set.ext_iff.mp (child i s) y).mpr hy⟩ - rw [union] - clear hq hU hsub hcentroid hvalue hcompat hslope ih child union - classical - simp only [FootprintVertices] - constructor - · rintro ⟨i, s, hy⟩ - exact hfoot i s hy - · intro hy - by_cases hu : U.cells.Nonempty - · simp only [ite_eq_left hu, Set.mem_ofPred_eq] at hy - rcases hy with ⟨x, hx, hv⟩ - rcases (hcells x).mp hx with ⟨i, s, hxs⟩ - have hs : (S i s).cells.Nonempty := ⟨x, hxs⟩ - refine ⟨i, s, ?_⟩ - simp only [ite_eq_left hs, Set.mem_ofPred_eq] - exact ⟨x, hxs, hv⟩ - · have hs_empty : ∀ i s, ¬ (S i s).cells.Nonempty := by - intro i s hs - rcases hs with ⟨x, hx⟩ - apply hu - exact ⟨x, (hcells x).mpr ⟨i, s, hx⟩⟩ - have ha : (S 0 false).anchor = U.anchor := by - have hh := hfoot 0 false - rw [FootprintVertices, ite_eq_right (hs_empty 0 false), - FootprintVertices, ite_eq_right hu] at hh - have hm := hh (Set.mem_singleton _) - simpa using hm - simp only [ite_eq_right hu, Set.mem_singleton_iff] at hy - refine ⟨0, false, ?_⟩ - simp only [ite_eq_right (hs_empty 0 false), Set.mem_singleton_iff] - simpa [ha] using hy - exact domain_from_odo C T h hO + exact TileOdometerDomain C T h hO end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerDomain.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerDomain.lean new file mode 100644 index 0000000000..327217d5f6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerDomain.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Init + +public import LeanPool.ApollonianSuperharmonic.TileOdometer + +/-! +# Domain of a tile odometer + +The domain agrees with the prototile footprint, including the assigned singleton +anchor in the curvature-zero case. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- Every recursively constructed tile odometer is defined on its prototile footprint. -/ +theorem TileOdometerDomain (c : CircleCoordinates) (U : ProtoTile) (k : PartialOdometer) + (ho : TileOdometer c U k) : (k.domain : Set GaussianInt) = FootprintVertices U := by + induction ho with + | line w x hw k hdom => + simp [hdom, FootprintVertices] + | unit z x U k hU hdom htrans => + exact hdom + | @decompose q hq S U hs k hU hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => + ext y + change (y ∈ k.domain) ↔ y ∈ FootprintVertices U + rw [hdom] + have child (i : Fin 3) (s : Bool) : + (hs i s).domain = FootprintVertices (S i s) := + ih i s + change (∃ i s, y ∈ (hs i s).domain) ↔ y ∈ FootprintVertices U + have union : (∃ i s, y ∈ (hs i s).domain) ↔ + ∃ i s, y ∈ FootprintVertices (S i s) := by + constructor + · rintro ⟨i, s, hy⟩ + exact ⟨i, s, (Set.ext_iff.mp (child i s) y).mp hy⟩ + · rintro ⟨i, s, hy⟩ + exact ⟨i, s, (Set.ext_iff.mp (child i s) y).mpr hy⟩ + rw [union] + clear hq hU hsub hcentroid hvalue hcompat hslope ih child union + classical + simp only [FootprintVertices] + constructor + · rintro ⟨i, s, hy⟩ + exact hfoot i s hy + · intro hy + by_cases hu : U.cells.Nonempty + · simp only [ite_eq_left hu, Set.mem_ofPred_eq] at hy + rcases hy with ⟨x, hx, hv⟩ + rcases (hcells x).mp hx with ⟨i, s, hxs⟩ + have hs : (S i s).cells.Nonempty := ⟨x, hxs⟩ + refine ⟨i, s, ?_⟩ + simp only [ite_eq_left hs, Set.mem_ofPred_eq] + exact ⟨x, hxs, hv⟩ + · have hs_empty : ∀ i s, ¬ (S i s).cells.Nonempty := by + intro i s hs + rcases hs with ⟨x, hx⟩ + apply hu + exact ⟨x, (hcells x).mpr ⟨i, s, hx⟩⟩ + have ha : (S 0 false).anchor = U.anchor := by + have hh := hfoot 0 false + rw [FootprintVertices, ite_eq_right (hs_empty 0 false), + FootprintVertices, ite_eq_right hu] at hh + have hm := hh (Set.mem_singleton _) + simpa using hm + simp only [ite_eq_right hu, Set.mem_singleton_iff] at hy + refine ⟨0, false, ?_⟩ + simp only [ite_eq_right (hs_empty 0 false), Set.mem_singleton_iff] + simpa [ha] using hy + +end ApollonianSuperharmonic + +end From 2fe2f14f1a8e3e3915694b1e45c852c91f225096 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Thu, 12 Nov 2026 14:43:17 +0000 Subject: [PATCH 05/23] Finish shared odometer API and document retained scope --- LeanPool/ApollonianSuperharmonic.lean | 6 ++- .../AncestorOdometerRestriction.lean | 50 +------------------ LeanPool/ApollonianSuperharmonic/Imports.lean | 1 - .../ApollonianSuperharmonic/Preamble.lean | 26 ---------- 4 files changed, 6 insertions(+), 77 deletions(-) delete mode 100644 LeanPool/ApollonianSuperharmonic/Preamble.lean diff --git a/LeanPool/ApollonianSuperharmonic.lean b/LeanPool/ApollonianSuperharmonic.lean index 8777e961a5..d1cbaf625a 100644 --- a/LeanPool/ApollonianSuperharmonic.lean +++ b/LeanPool/ApollonianSuperharmonic.lean @@ -32,8 +32,10 @@ Adapted from Wesley Pegden's Apache-2.0 Trellis formalization at commit Pegden and Smart, *The Apollonian structure of integer superharmonic matrices*. Trellis produced the Lean proofs using AI agents; the project records `AI` provenance. -The imported scope is the dependency closure of the five public root theorems. -The upstream paper, process tooling and development history are not imported. +The entry module exposes the five headline results. The project also preserves +explicit Ford and diamond lattice and maximality results, additional odometer +cocycles, and supporting geometric lemmas from upstream. The upstream paper, +process tooling and development history are not imported. The upstream reference notes explain two local repairs to the printed proof: edge-supported interfaces with isolated corners, and occurrence-oriented unit strings. -/ diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean index d36670b181..b1cceb12ec 100644 --- a/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean @@ -8,6 +8,7 @@ module public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.AncestorOdometer +public import LeanPool.ApollonianSuperharmonic.TileOdometerDomain public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique -- [TABLET NODE: AncestorOdometerRestriction] @@ -25,53 +26,6 @@ namespace ApollonianSuperharmonic namespace AncestorRestrictionProof -private theorem domain_from_odo : - (by - classical - exact - ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), TileOdometer c U k → - (k.domain : Set GaussianInt) = FootprintVertices U ) := by - classical - intro c U k ho - induction ho with - | line w x hw k hdom => - simp [hdom, FootprintVertices] - | unit z x U k hU hdom htrans => - exact hdom - | @decompose q hq S U hs k hU hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => - ext y - change (y ∈ k.domain) ↔ y ∈ FootprintVertices U - rw [hdom] - have child (i : Fin 3) (s : Bool) : - ((hs i s).domain : Set GaussianInt) = FootprintVertices (S i s) := - ih i s - change (∃ i s, y ∈ (hs i s).domain) ↔ y ∈ FootprintVertices U - constructor - · rintro ⟨i, s, hy⟩ - exact hfoot i s ((Set.ext_iff.mp (child i s) y).mp hy) - · intro hy - by_cases hu : U.cells.Nonempty - · simp only [FootprintVertices, ite_eq_left hu, Set.mem_ofPred_eq] at hy - rcases hy with ⟨x, hx, hv⟩ - rcases (hcells x).mp hx with ⟨i, s, hxs⟩ - have hs' : (S i s).cells.Nonempty := ⟨x, hxs⟩ - refine ⟨i, s, (Set.ext_iff.mp (child i s) y).mpr ?_⟩ - simp only [FootprintVertices, ite_eq_left hs', Set.mem_ofPred_eq] - exact ⟨x, hxs, hv⟩ - · have hs' : ∀ i s, ¬ (S i s).cells.Nonempty := by - intro i s hne - rcases hne with ⟨x, hx⟩ - exact hu ⟨x, (hcells x).mpr ⟨i, s, hx⟩⟩ - simp only [FootprintVertices, ite_eq_right hu, Set.mem_singleton_iff] at hy - have ha : (S 0 false).anchor = U.anchor := by - have hh := hfoot 0 false - rw [FootprintVertices, ite_eq_right (hs' 0 false), - FootprintVertices, ite_eq_right hu] at hh - simpa using hh (Set.mem_singleton _) - refine ⟨0, false, (Set.ext_iff.mp (child 0 false) y).mpr ?_⟩ - simp only [FootprintVertices, ite_eq_right (hs' 0 false), Set.mem_singleton_iff] - simpa [ha] using hy - private theorem positive_cells : (by classical @@ -500,7 +454,7 @@ theorem AncestorOdometerRestriction have domain_from_odo : ∀ (c : CircleCoordinates) (U : ProtoTile) (k : PartialOdometer), TileOdometer c U k → (k.domain : Set GaussianInt) = FootprintVertices U := - AncestorRestrictionProof.domain_from_odo + TileOdometerDomain have positive_cells : ∀ (c : CircleCoordinates) (U : ProtoTile), 0 < c.1 → BandPrototile c U → U.cells.Nonempty := AncestorRestrictionProof.positive_cells let vertices : ProtoTile → Finset GaussianInt := fun U => diff --git a/LeanPool/ApollonianSuperharmonic/Imports.lean b/LeanPool/ApollonianSuperharmonic/Imports.lean index b5722c7cb0..9c6484ddce 100644 --- a/LeanPool/ApollonianSuperharmonic/Imports.lean +++ b/LeanPool/ApollonianSuperharmonic/Imports.lean @@ -1118,7 +1118,6 @@ public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTranslatedOdomet public import LeanPool.ApollonianSuperharmonic.PositiveCutCompanionRow public import LeanPool.ApollonianSuperharmonic.PositiveDefiniteRepresentativeGap public import LeanPool.ApollonianSuperharmonic.PositiveTracePackingDichotomy -public import LeanPool.ApollonianSuperharmonic.Preamble public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique diff --git a/LeanPool/ApollonianSuperharmonic/Preamble.lean b/LeanPool/ApollonianSuperharmonic/Preamble.lean deleted file mode 100644 index 41dab072be..0000000000 --- a/LeanPool/ApollonianSuperharmonic/Preamble.lean +++ /dev/null @@ -1,26 +0,0 @@ -/- -Copyright (c) 2026 Wesley Pegden. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Wesley Pegden --/ -module - --- Keep standard syntax linters active; each module imports its mathematical dependencies. -public import Mathlib.Init - -/-! -# Preamble - -Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. -Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. --/ - -@[expose] public section - -namespace ApollonianSuperharmonic - - - -end ApollonianSuperharmonic - -end From d805f5722e40b717960be4415154c2b0f79989a5 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Thu, 12 Nov 2026 16:35:10 +0000 Subject: [PATCH 06/23] Reuse shared Apollonian geometry proofs and narrow helper contracts --- ...alRightNormalizationCertificateExists.lean | 27 ++-- .../BandPackingSymmetryTilingTransport.lean | 99 +----------- .../CellDisjointCommonFootprintIncidence.lean | 152 +----------------- ...CoveredInterfaceOppositeIncidentCells.lean | 149 +---------------- LeanPool/ApollonianSuperharmonic/Imports.lean | 1 + .../LatticeTileThreeDiskJunction.lean | 93 +++-------- ...siteRoutedCommonEdgeOutsideCellUnique.lean | 125 +------------- .../P4984T1IncidentArcs.lean | 53 +----- .../P5050T1OmittedHullSeparation.lean | 52 +----- .../P5050T1ParentSphereSection.lean | 56 +------ .../ProperBandCircleCenterDistance.lean | 73 +++++++++ .../RecursiveVectorSystem.lean | 5 +- 12 files changed, 133 insertions(+), 752 deletions(-) create mode 100644 LeanPool/ApollonianSuperharmonic/ProperBandCircleCenterDistance.lean diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean index 99db983864..2679882df0 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean @@ -577,21 +577,18 @@ private theorem boundaryData : (pieces a s) (functions a s) hparentPos (hpieceOdometer a s) exact ⟨hu.1, hu.2, ho.1, hd.trans ho.1⟩ -private theorem hslots : - (by - classical - exact - (ProtoTile) → ((ProtoTile) → ((Fin (4 : ℕ) → CircleCoordinates) → (∀ (i₀ : Fin (3 : ℕ)), - ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), - let irot : Fin 3 := i₀ - r - let reverse := BandPackingSymmetryReversesOrientation g - let idir : Fin 3 := if reverse then -irot else irot - let firstSlot : Fin 3 := idir + 1 - let secondSlot : Fin 3 := idir + 2 - (firstSlot = 0 ∧ secondSlot = 1 ∧ idir = 2) ∨ (firstSlot = 1 ∧ secondSlot = 2 ∧ idir = 0) - ∨ (firstSlot = 2 ∧ secondSlot = 0 ∧ idir = 1)))) ) := by +private theorem cyclicSlots : + ∀ (i₀ r : Fin 3) (g : BandPackingSymmetry), + let irot : Fin 3 := i₀ - r + let reverse := BandPackingSymmetryReversesOrientation g + let idir : Fin 3 := if reverse then -irot else irot + let firstSlot : Fin 3 := idir + 1 + let secondSlot : Fin 3 := idir + 2 + (firstSlot = 0 ∧ secondSlot = 1 ∧ idir = 2) ∨ + (firstSlot = 1 ∧ secondSlot = 2 ∧ idir = 0) ∨ + (firstSlot = 2 ∧ secondSlot = 0 ∧ idir = 1) := by classical - intro T N q i₀ r g irot reverse idir firstSlot secondSlot + intro i₀ r g irot reverse idir firstSlot secondSlot have hi : idir = 0 ∨ idir = 1 ∨ idir = 2 := by omega rcases hi with hi | hi | hi <;> simp [firstSlot, secondSlot, hi] @@ -813,7 +810,7 @@ theorem BandOrderedGeneralRightNormalizationCertificateExists rightFirstSlot := firstSlot rightSecondSlot := secondSlot rightDirectionSlot := idir - right_slots_cyclic := (RightNormalizationGeometry.hslots T N q i₀ r g) + right_slots_cyclic := (RightNormalizationGeometry.cyclicSlots i₀ r g) rightNeighborPositive := positive right_adjacency_centroid := hcentBar' right_adjacency_slope_real := hslopeReBar' diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean index b2e305c869..a1abf607a9 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean @@ -155,78 +155,6 @@ private theorem image_subsingletonAt247 : exact h ⟨⟨a, ha.1, rfl⟩, ⟨a, ha.2, rfl⟩⟩ ⟨⟨b, hb.1, rfl⟩, ⟨b, hb.2, rfl⟩⟩ -private theorem quarter_symmetryAt307 : - (by - classical - exact - ∀ T : ProtoTile, QuarterTurnSymmetric T ↔ QuarterTurnSymmetric (TileQuarterTurn T) - ) := by - classical - intro T - unfold QuarterTurnSymmetric - have first := TileQuarterTurnFormulas T - simp only [first.2.2.2.1, first.2.2.2.2.1] - simp only [Set.mem_image] - constructor - · intro h p - constructor - · intro hp - rcases hp with ⟨q, hq, rfl⟩ - refine ⟨((TileCentroid T).1 - (q.2 - (TileCentroid T).2), - (TileCentroid T).2 + (q.1 - (TileCentroid T).1)), (h q).mp hq, ?_⟩ - dsimp - ring - · intro hp - rcases hp with ⟨q, hq, hpq⟩ - have heq' := congrArg Prod.fst hpq - have heq'' := congrArg Prod.snd hpq - dsimp at heq' heq'' - have qeq : q = - ((TileCentroid T).1 - ((-p.1) - (TileCentroid T).2), - (TileCentroid T).2 + (p.2 - (TileCentroid T).1)) := by - apply Prod.ext - · dsimp - linarith [heq''] - · dsimp - linarith [heq'] - refine ⟨(p.2, -p.1), ?_, ?_⟩ - · apply (h (p.2, -p.1)).mpr - exact qeq ▸ hq - · dsimp - ring - · intro h p - constructor - · intro hp - have hh := h (-p.2, p.1) - have hr : (-p.2, p.1) ∈ (fun p => (-p.2, p.1)) '' - TileRealization T := ⟨p, hp, rfl⟩ - rcases hh.mp hr with ⟨q, hq, heq⟩ - have heq' := congrArg Prod.fst heq - have heq'' := congrArg Prod.snd heq - have qeq : q = - ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), - (TileCentroid T).2 + (p.1 - (TileCentroid T).1)) := by - apply Prod.ext <;> dsimp at heq' heq'' ⊢ <;> linarith - rw [← qeq] - exact hq - · intro hp - have hh := h (-p.2, p.1) - have hc : ∃ x ∈ TileRealization T, - (-x.2, x.1) = - (-(TileCentroid T).2 - ((-p.2, p.1).2 - (TileCentroid T).1), - (TileCentroid T).1 + ((-p.2, p.1).1 - - -(TileCentroid T).2)) := by - refine ⟨((TileCentroid T).1 - (p.2 - (TileCentroid T).2), - (TileCentroid T).2 + (p.1 - (TileCentroid T).1)), hp, ?_⟩ - dsimp - ring_nf - rcases hh.mpr hc with ⟨q, hq, heq⟩ - have heq' := congrArg Prod.fst heq - have heq'' := congrArg Prod.snd heq - dsimp at heq' heq'' - rw [show q = p by apply Prod.ext <;> linarith] at hq - exact hq - private theorem reflection_symmetry : (by classical @@ -296,29 +224,6 @@ private theorem reflection_symmetry : apply Prod.ext <;> dsimp [target] at first_eq second_eq ⊢ <;> linarith exact qeq ▸ hq -private theorem image_subsingletonAt436 : - (by - classical - exact - ∀ (f : GaussianInt → GaussianInt), Function.Injective f → ∀ (A : Set GaussianInt), ∀ (B : - Set GaussianInt), (A ∩ B).Subsingleton ↔ (f '' A ∩ f '' B).Subsingleton - ) := by - classical - intro f hf A B - constructor - · intro h x hx y hy - rcases hx with ⟨⟨a, ha, rfl⟩, ⟨b, hb, hab⟩⟩ - rcases hy with ⟨⟨c, hc, rfl⟩, ⟨d, hd, hcd⟩⟩ - have hab' : a = b := hf hab.symm - have hcd' : c = d := hf hcd.symm - subst b - subst d - exact congrArg f (h ⟨ha, hb⟩ ⟨hc, hd⟩) - · intro h a ha b hb - apply hf - exact h ⟨⟨a, ha.1, rfl⟩, ⟨a, ha.2, rfl⟩⟩ - ⟨⟨b, hb.1, rfl⟩, ⟨b, hb.2, rfl⟩⟩ - end TilingTransportProof namespace TilingTransportDetails @@ -489,10 +394,10 @@ private theorem conjugation : (fun i s => BandPackingSymmetryTileAction BandPackingSymmetry.conjugate (S i s)) (BandPackingSymmetryVectorAction BandPackingSymmetry.conjugate u) (BandPackingSymmetryVectorAction BandPackingSymmetry.conjugate v) o := by - have quarter_symmetry := TilingTransportProof.quarter_symmetryAt307 + have quarter_symmetry := TilingTransportProof.quarter_symmetryAt181 have image_subsingleton (f : GaussianInt → GaussianInt) (hf : Function.Injective f) (A B : Set GaussianInt) := - TilingTransportProof.image_subsingletonAt436 f hf A B + TilingTransportProof.image_subsingletonAt247 f hf A B have reflection_injective : Function.Injective (fun z : GaussianInt => -GaussianReflection z) := TilingTransportDetails.reflection_injective diff --git a/LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean b/LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean index 64768207f2..e8d096aab4 100644 --- a/LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean +++ b/LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean @@ -6,15 +6,12 @@ Authors: Wesley Pegden module public import Mathlib.Init -public import Mathlib.Topology.MetricSpace.Basic -public import Mathlib.Topology.Order.Real -public import Mathlib.Topology.MetricSpace.Pseudo.Constructions -public import Mathlib.Basic.Real.Basic -public import Mathlib.Tactic.ByContra -public import Mathlib.Tactic.Linarith -public import Mathlib.Tactic.NormNum +public import Mathlib.Data.EReal.Basic +public import Mathlib.Topology.MetricSpace.Pseudo.Defs +public import Mathlib.Topology.MetricSpace.Pseudo.Lemmas +public import Mathlib.Topology.Order.T5 +public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary public import Mathlib.Topology.Connected.Basic -public import Mathlib.Topology.MetricSpace.Pseudo.Real public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices @@ -38,84 +35,6 @@ namespace CommonFootprintIncidence private noncomputable def I : GaussianInt := ⟨0, 1⟩ -private theorem horiz_unique (x y : GaussianInt) - (h : ({x, x + 1} : Finset GaussianInt) = {y, y + 1}) : x = y := by - classical - have hx : x = y ∨ x = y + 1 := by - have : x ∈ ({y, y + 1} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hy : y = x ∨ y = x + 1 := by - have : y ∈ ({x, x + 1} : Finset GaussianInt) := by rw [h]; simp - simpa using this - rcases hx with hxy | hxy - · exact hxy - rcases hy with hyx | hyx - · exact hyx.symm - · exfalso - have hre := congrArg Zsqrtd.re hxy - have hre' := congrArg Zsqrtd.re hyx - norm_num at hre hre' - omega - -private theorem vert_unique (x y : GaussianInt) - (h : ({x, x + I} : Finset GaussianInt) = {y, y + I}) : x = y := by - classical - let I : GaussianInt := ⟨0, 1⟩ - change ({x, x + I} : Finset GaussianInt) = {y, y + I} at h - have hx : x = y ∨ x = y + I := by - have : x ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hy : y = x ∨ y = x + I := by - have : y ∈ ({x, x + I} : Finset GaussianInt) := by rw [h]; simp - simpa using this - rcases hx with hxy | hxy - · exact hxy - rcases hy with hyx | hyx - · exact hyx.symm - · exfalso - have him := congrArg Zsqrtd.im hxy - have him' := congrArg Zsqrtd.im hyx - simp [I] at him him' - omega - -private theorem horiz_ne_vert (x y : GaussianInt) : - ({x, x + 1} : Finset GaussianInt) ≠ {y, y + I} := by - classical - let I : GaussianInt := ⟨0, 1⟩ - change (({x, x + 1} : Finset GaussianInt) ≠ {y, y + I}) - intro h - have hx : x = y ∨ x = y + I := by - have : x ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hx1 : x + 1 = y ∨ x + 1 = y + I := by - have : x + 1 ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - rcases hx with hx | hx <;> rcases hx1 with hx1 | hx1 - all_goals - have hre := congrArg Zsqrtd.re hx - have him := congrArg Zsqrtd.im hx - have hre1 := congrArg Zsqrtd.re hx1 - have him1 := congrArg Zsqrtd.im hx1 - simp [I] at hre him hre1 him1 - omega - -private theorem footprint_normalize (T : ProtoTile) (e : Finset GaussianInt) - (he : e ∈ FootprintEdges T) : - (∃ z, e = {z, z + 1} ∧ (z ∈ T.cells ∨ z - I ∈ T.cells)) ∨ - (∃ z, e = {z, z + I} ∧ (z ∈ T.cells ∨ z - 1 ∈ T.cells)) := by - classical - let I : GaussianInt := ⟨0, 1⟩ - change ((∃ z, e = {z, z + 1} ∧ (z ∈ T.cells ∨ z - I ∈ T.cells)) ∨ - (∃ z, e = {z, z + I} ∧ (z ∈ T.cells ∨ z - 1 ∈ T.cells))) - rcases he with ⟨x, hx, h | h | h | h⟩ - · exact Or.inl ⟨x, h, Or.inl hx⟩ - · exact Or.inr ⟨x, h, Or.inl hx⟩ - · refine Or.inr ⟨x + 1, h, Or.inr ?_⟩ - simpa [add_sub_cancel_right] using hx - · refine Or.inl ⟨x + I, ?_, Or.inr ?_⟩ - · simpa [I, Zsqrtd.ext_iff, add_comm, add_left_comm, add_assoc] using h - simpa [I, Zsqrtd.ext_iff] using hx - private theorem boundary_footprint (T : ProtoTile) (e : Finset GaussianInt) (he : e ∈ BoundaryFootprintEdges T) : e ∈ FootprintEdges T := by classical @@ -130,65 +49,6 @@ private theorem boundary_footprint (T : ProtoTile) (e : Finset GaussianInt) · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ congr 1 <;> simp [] -private theorem hEdge (U : ProtoTile) (V : ProtoTile) (hdisjoint : Disjoint U.cells V.cells) : - FootprintEdges U ∩ FootprintEdges V = - BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V := by - classical - let I : GaussianInt := ⟨0, 1⟩ - have horiz_unique (x y : GaussianInt) - (h : ({x, x + 1} : Finset GaussianInt) = {y, y + 1}) : x = y := horiz_unique x y h - have vert_unique (x y : GaussianInt) - (h : ({x, x + I} : Finset GaussianInt) = {y, y + I}) : x = y := vert_unique x y h - have horiz_ne_vert (x y : GaussianInt) : - ({x, x + 1} : Finset GaussianInt) ≠ {y, y + I} := horiz_ne_vert x y - have footprint_normalize (T : ProtoTile) (e : Finset GaussianInt) - (he : e ∈ FootprintEdges T) : - (∃ z, e = {z, z + 1} ∧ (z ∈ T.cells ∨ z - I ∈ T.cells)) ∨ - (∃ z, e = {z, z + I} ∧ (z ∈ T.cells ∨ z - 1 ∈ T.cells)) := footprint_normalize T e he - have boundary_footprint (T : ProtoTile) (e : Finset GaussianInt) - (he : e ∈ BoundaryFootprintEdges T) : e ∈ FootprintEdges T := boundary_footprint T e he - as_aux_lemma => - ext e - constructor - · rintro ⟨heU, heV⟩ - have hd := Finset.disjoint_left.mp hdisjoint - rcases footprint_normalize U e heU with ⟨z, hz, hzU⟩ | ⟨z, hz, hzU⟩ <;> - rcases footprint_normalize V e heV with ⟨w, hw, hwV⟩ | ⟨w, hw, hwV⟩ - · have bzw : z = w := horiz_unique z w (hz.symm.trans hw) - subst w - constructor <;> refine ⟨z, Or.inl ⟨?_, ?_⟩⟩ - · exact hz - · rcases hzU with hzU | hzU <;> rcases hwV with hzV | hzV - · exact (hd hzU hzV).elim - · exact Or.inl ⟨hzU, fun hbad => hd hbad hzV⟩ - · exact Or.inr ⟨fun hbad => hd hbad hzV, hzU⟩ - · exact (hd hzU hzV).elim - · exact hz - · rcases hzU with hzU | hzU <;> rcases hwV with hzV | hzV - · exact (hd hzU hzV).elim - · exact Or.inr ⟨fun hbad => hd hzU hbad, hzV⟩ - · exact Or.inl ⟨hzV, fun hbad => hd hzU hbad⟩ - · exact (hd hzU hzV).elim - · exact (horiz_ne_vert z w (hz.symm.trans hw)).elim - · exact (horiz_ne_vert w z (hw.symm.trans hz)).elim - · have bzw : z = w := vert_unique z w (hz.symm.trans hw) - subst w - constructor <;> refine ⟨z, Or.inr ⟨?_, ?_⟩⟩ - · exact hz - · rcases hzU with hzU | hzU <;> rcases hwV with hzV | hzV - · exact (hd hzU hzV).elim - · exact Or.inl ⟨hzU, fun hbad => hd hbad hzV⟩ - · exact Or.inr ⟨fun hbad => hd hbad hzV, hzU⟩ - · exact (hd hzU hzV).elim - · exact hz - · rcases hzU with hzU | hzU <;> rcases hwV with hzV | hzV - · exact (hd hzU hzV).elim - · exact Or.inr ⟨fun hbad => hd hzU hbad, hzV⟩ - · exact Or.inl ⟨hzV, fun hbad => hd hzU hbad⟩ - · exact (hd hzU hzV).elim - · rintro ⟨heU, heV⟩ - exact ⟨boundary_footprint U e heU, boundary_footprint V e heV⟩ - private noncomputable def toR : GaussianInt → Real × Real := fun z => ((z.re : Int), (z.im : Int)) private theorem vertex_realization (T : ProtoTile) (hne : T.cells.Nonempty) @@ -475,7 +335,7 @@ theorem CellDisjointCommonFootprintIncidence (U V : ProtoTile) (he : e ∈ BoundaryFootprintEdges T) : e ∈ FootprintEdges T := CommonFootprintIncidence.boundary_footprint T e he have hEdge : FootprintEdges U ∩ FootprintEdges V = - BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V := CommonFootprintIncidence.hEdge U V + BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V := CellDisjointCommonEdgesBoundary U V hdisjoint have edge_vertex_footprint (T : ProtoTile) (e : Finset GaussianInt) (he : e ∈ FootprintEdges T) (z : GaussianInt) (hz : z ∈ e) : diff --git a/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean b/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean index db8524df06..7d698f999f 100644 --- a/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean +++ b/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices @@ -137,149 +138,6 @@ private theorem hcheckQ : simpa [Q, LatticeVertexIncidentCell] using (LatticeTileGridStructure B hBlat).2.1 c -private theorem htrans : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (B : ProtoTile), (Disjoint A.cells B.cells) → (∀ (D : ProtoTile), ∀ - (c : GaussianInt), (c ∈ FootprintVertices A ∩ FootprintVertices B ∩ FootprintVertices - D) → ((∀ (y : GaussianInt), y = c ∨ y = c + (1 : GaussianInt) ∨ y = c - (1 : - GaussianInt) ∨ y = c + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = c - (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices A ∨ y ∈ FootprintVertices B) → ( - let P : Fin 4 → Prop := fun j => LatticeVertexIncidentCell c j ∈ A.cells - let Q : Fin 4 → Prop := fun j => LatticeVertexIncidentCell c j ∈ B.cells - let R : Fin 4 → Prop := fun j => LatticeVertexIncidentCell c j ∈ D.cells - (∀ ⦃a : LatticeCell⦄, a ∈ A.cells → a ∉ B.cells) → ((∀ j, ¬ (P j ∧ Q j)) → ((∀ j, ¬ (P j - ∧ R j)) → ((∀ j, ¬ (Q j ∧ R j)) → (((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell c - j ∈ A.cells ∨ LatticeVertexIncidentCell c j ∈ B.cells ∨ LatticeVertexIncidentCell c j - ∈ D.cells) ∧ (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell c j ∈ A.cells) ∧ (∃ (j : - Fin (4 : ℕ)), LatticeVertexIncidentCell c j ∈ B.cells) ∧ (∃ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell c j ∈ D.cells) ∧ ((∃ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell c j ∈ A.cells ∧ LatticeVertexIncidentCell c (j + (2 : Fin - (4 : ℕ))) ∈ B.cells) ∨ (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell c j ∈ A.cells - ∧ LatticeVertexIncidentCell c (j + (2 : Fin (4 : ℕ))) ∈ D.cells) ∨ ∃ (j : Fin (4 : - ℕ)), LatticeVertexIncidentCell c j ∈ B.cells ∧ LatticeVertexIncidentCell c (j + (2 : - Fin (4 : ℕ))) ∈ D.cells)) → ((∀ j, P j ∨ Q j ∨ R j) → ((¬ ((P 0 ∧ P 2 ∧ ¬ P 1 ∧ ¬ P - 3) ∨ (P 1 ∧ P 3 ∧ ¬ P 0 ∧ ¬ P 2))) → ((¬ ((Q 0 ∧ Q 2 ∧ ¬ Q 1 ∧ ¬ Q 3) ∨ (Q 1 ∧ Q 3 ∧ - ¬ Q 0 ∧ ¬ Q 2))) → (∀ (e : Finset GaussianInt), (c ∈ e) → ((e ∈ FootprintEdges A ∩ - FootprintEdges B) → (∃ j, (P j ∧ Q (j + 1)) ∨ (Q j ∧ P (j + 1))))))))))))))) ) := by - classical - intro A B hAB D c hc hstarc P Q R hdAB hPQ hPR hQR hlocal hcover hcheckP hcheckQ e hce he - change ∃ j : Fin 4, - (LatticeVertexIncidentCell c j ∈ A.cells ∧ - LatticeVertexIncidentCell c (j + 1) ∈ B.cells) ∨ - (LatticeVertexIncidentCell c j ∈ B.cells ∧ - LatticeVertexIncidentCell c (j + 1) ∈ A.cells) - let I : GaussianInt := ⟨0, 1⟩ - have horiz_unique (u v : GaussianInt) - (h : ({u, u + 1} : Finset GaussianInt) = {v, v + 1}) : u = v := by - have hu : u = v ∨ u = v + 1 := by - have : u ∈ ({v, v + 1} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hv : v = u ∨ v = u + 1 := by - have : v ∈ ({u, u + 1} : Finset GaussianInt) := by rw [h]; simp - simpa using this - rcases hu with huv | huv - · exact huv - rcases hv with hvu | hvu - · exact hvu.symm - · have hre := congrArg Zsqrtd.re huv - have hre' := congrArg Zsqrtd.re hvu - norm_num at hre hre' - omega - have vert_unique (u v : GaussianInt) - (h : ({u, u + I} : Finset GaussianInt) = {v, v + I}) : u = v := by - have hu : u = v ∨ u = v + I := by - have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hv : v = u ∨ v = u + I := by - have : v ∈ ({u, u + I} : Finset GaussianInt) := by rw [h]; simp - simpa using this - rcases hu with huv | huv - · exact huv - rcases hv with hvu | hvu - · exact hvu.symm - · have him := congrArg Zsqrtd.im huv - have him' := congrArg Zsqrtd.im hvu - simp [I] at him him' - omega - have horiz_ne_vert (u v : GaussianInt) : - ({u, u + 1} : Finset GaussianInt) ≠ {v, v + I} := by - intro h - have hu : u = v ∨ u = v + I := by - have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hu1 : u + 1 = v ∨ u + 1 = v + I := by - have : u + 1 ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - rcases hu with hu | hu <;> rcases hu1 with hu1 | hu1 - all_goals - have hre := congrArg Zsqrtd.re hu - have him := congrArg Zsqrtd.im hu - have hre1 := congrArg Zsqrtd.re hu1 - have him1 := congrArg Zsqrtd.im hu1 - simp [I] at hre him hre1 him1 - omega - have hboundary := CellDisjointCommonEdgesBoundary A B hAB - have he' : e ∈ BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B := by - rw [← hboundary] - exact he - rcases he'.1 with ⟨u, ⟨heu, hu⟩ | ⟨heu, hu⟩⟩ - · rcases he'.2 with ⟨v, ⟨hev, hv⟩ | ⟨hev, hv⟩⟩ - · have huv : u = v := horiz_unique u v (heu.symm.trans hev) - subst v - have hxuv : c = u ∨ c = u + 1 := by - rw [heu] at hce - simpa using hce - rcases hxuv with rfl | rfl - · rcases hu with hu | hu <;> rcases hv with hv | hv - · exact (hdAB hu.1 hv.1).elim - · exact ⟨3, Or.inr ⟨by - simpa [LatticeVertexIncidentCell, I] using hv.2, by - simpa [LatticeVertexIncidentCell, I] using hu.1⟩⟩ - · exact ⟨3, Or.inl ⟨by - simpa [LatticeVertexIncidentCell, I] using hu.2, by - simpa [LatticeVertexIncidentCell, I] using hv.1⟩⟩ - · exact (hdAB hu.2 hv.2).elim - · rcases hu with hu | hu <;> rcases hv with hv | hv - · exact (hdAB hu.1 hv.1).elim - · exact ⟨1, Or.inl ⟨by - simpa [LatticeVertexIncidentCell, I] using hu.1, by - simpa [LatticeVertexIncidentCell, I] using hv.2⟩⟩ - · exact ⟨1, Or.inr ⟨by - simpa [LatticeVertexIncidentCell, I] using hv.1, by - simpa [LatticeVertexIncidentCell, I] using hu.2⟩⟩ - · exact (hdAB hu.2 hv.2).elim - · exact (horiz_ne_vert u v (heu.symm.trans hev)).elim - · rcases he'.2 with ⟨v, ⟨hev, hv⟩ | ⟨hev, hv⟩⟩ - · exact (horiz_ne_vert v u (hev.symm.trans heu)).elim - · have huv : u = v := vert_unique u v (heu.symm.trans hev) - subst v - have hxuv : c = u ∨ c = u + I := by - rw [heu] at hce - simpa using hce - rcases hxuv with rfl | rfl - · rcases hu with hu | hu <;> rcases hv with hv | hv - · exact (hdAB hu.1 hv.1).elim - · exact ⟨0, Or.inl ⟨by - simpa [LatticeVertexIncidentCell, I] using hu.1, by - simpa [LatticeVertexIncidentCell, I] using hv.2⟩⟩ - · exact ⟨0, Or.inr ⟨by - simpa [LatticeVertexIncidentCell, I] using hv.1, by - simpa [LatticeVertexIncidentCell, I] using hu.2⟩⟩ - · exact (hdAB hu.2 hv.2).elim - · rcases hu with hu | hu <;> rcases hv with hv | hv - · exact (hdAB hu.1 hv.1).elim - · exact ⟨2, Or.inr ⟨by - simpa [LatticeVertexIncidentCell, I, sub_eq_add_neg, - add_comm, add_left_comm, add_assoc] using hv.2, by - simpa [LatticeVertexIncidentCell, I] using hu.1⟩⟩ - · exact ⟨2, Or.inl ⟨by - simpa [LatticeVertexIncidentCell, I, sub_eq_add_neg, - add_comm, add_left_comm, add_assoc] using hu.2, by - simpa [LatticeVertexIncidentCell, I] using hv.1⟩⟩ - · exact (hdAB hu.2 hv.2).elim - private theorem hnoR : (by classical @@ -507,8 +365,9 @@ theorem CoveredInterfaceOppositeIncidentCells have hcheckQ : ¬ ((Q 0 ∧ Q 2 ∧ ¬ Q 1 ∧ ¬ Q 3) ∨ (Q 1 ∧ Q 3 ∧ ¬ Q 0 ∧ ¬ Q 2)) := OppositeIncidentGeometry.hcheckQ B hBlat c rcases hedgec with ⟨e, hce, he⟩ - have htrans : ∃ j, (P j ∧ Q (j + 1)) ∨ (Q j ∧ P (j + 1)) := OppositeIncidentGeometry.htrans A - B hAB D c hc hstarc hdAB hPQ hPR hQR hlocal hcover hcheckP hcheckQ e hce he + have htrans : ∃ j, (P j ∧ Q (j + 1)) ∨ (Q j ∧ P (j + 1)) := by + obtain ⟨j, _, hj⟩ := P3102T2CommonEdgeSectorTransition A B c e hAB hce he + exact ⟨j, hj⟩ have hnoR : ∀ j, ¬ (R j ∧ R (j + 1)) := OppositeIncidentGeometry.hnoR A B hAinduced hBinduced D c hAD hBD hc hstarc simpa [P, Q] using diff --git a/LeanPool/ApollonianSuperharmonic/Imports.lean b/LeanPool/ApollonianSuperharmonic/Imports.lean index 9c6484ddce..61eb4a9e43 100644 --- a/LeanPool/ApollonianSuperharmonic/Imports.lean +++ b/LeanPool/ApollonianSuperharmonic/Imports.lean @@ -1121,6 +1121,7 @@ public import LeanPool.ApollonianSuperharmonic.PositiveTracePackingDichotomy public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientation public import LeanPool.ApollonianSuperharmonic.PrimitiveVectorOrientationUnique +public import LeanPool.ApollonianSuperharmonic.ProperBandCircleCenterDistance public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple public import LeanPool.ApollonianSuperharmonic.ProtoTile diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean index f205bfe84a..e93283b6af 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean @@ -108,35 +108,13 @@ private theorem edge_finite : · exact ⟨(⟨c, hc⟩, true, false), by simpa [edge, I] using h.symm⟩ · exact ⟨(⟨c, hc⟩, true, true), by simpa [edge, I] using h.symm⟩ -private theorem hunionAB_C : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (AB : ProtoTile), ∀ (BC : - ProtoTile), ∀ (CA : ProtoTile), ∀ (ABC : ProtoTile), (∀ (z : LatticeCell), z ∈ - AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) → ((∀ (z : LatticeCell), z ∈ ABC.cells ↔ z ∈ - A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) → ((FourNeighborConnected (↑A.cells : Set - LatticeCell) ∧ NoCheckerboardCellVertex (↑A.cells : Set LatticeCell) ∧ - SimpleGridCycle (BoundaryFootprintVertices A) (BoundaryFootprintEdges A)) → - ((FourNeighborConnected (↑B.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex - (↑B.cells : Set LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices B) - (BoundaryFootprintEdges B)) → ((FourNeighborConnected (↑C.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑C.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices C) (BoundaryFootprintEdges C)) → ((FourNeighborConnected - (↑AB.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑AB.cells : Set - LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices AB) (BoundaryFootprintEdges - AB)) → ((FourNeighborConnected (↑BC.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑BC.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices BC) (BoundaryFootprintEdges BC)) → ((FourNeighborConnected - (↑CA.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑CA.cells : Set - LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices CA) (BoundaryFootprintEdges - CA)) → ((FourNeighborConnected (↑ABC.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑ABC.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices ABC) (BoundaryFootprintEdges ABC)) → (forall z : - LatticeCell, z ∈ ABC.cells ↔ z ∈ AB.cells ∨ z ∈ C.cells))))))))) ) := by +private theorem hunionAB_C (A B C AB ABC : ProtoTile) + (hunionAB : ∀ z : LatticeCell, z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) + (hunionABC : ∀ z : LatticeCell, z ∈ ABC.cells ↔ + z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) : + ∀ z : LatticeCell, z ∈ ABC.cells ↔ z ∈ AB.cells ∨ z ∈ C.cells := by classical - intro A B C AB BC CA ABC hunionAB hunionABC hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid - hABCgrid z + intro z rw [hunionABC z, hunionAB z] tauto @@ -249,15 +227,9 @@ private theorem hcellsABC : simpa using hunionAB_C z rw [h, Finset.card_union_of_disjoint hdisjointAB_C, hcellsAB] -private theorem horiz_unique : - (by - classical - exact - (ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → - ((ProtoTile) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), (({x, x + 1} : Finset - GaussianInt) = {y, y + 1}) → (x = y)))))))) ) := by +private theorem horiz_unique (x y : GaussianInt) + (h : ({x, x + 1} : Finset GaussianInt) = {y, y + 1}) : x = y := by classical - intro A B C AB BC CA ABC x y h have hx : x = y ∨ x = y + 1 := by have : x ∈ ({y, y + 1} : Finset GaussianInt) := by rw [← h]; simp simpa using this @@ -274,16 +246,10 @@ private theorem horiz_unique : omega private theorem vert_unique : - (by - classical - exact - (ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → - ((ProtoTile) → ( - let I : GaussianInt := ⟨0, 1⟩ - ∀ (x : GaussianInt), ∀ (y : GaussianInt), (({x, x + I} : Finset GaussianInt) = {y, - y + I}) → (x = y)))))))) ) := by + let I : GaussianInt := ⟨0, 1⟩ + ∀ x y : GaussianInt, ({x, x + I} : Finset GaussianInt) = {y, y + I} → x = y := by classical - intro A B C AB BC CA ABC I x y h + intro I x y h have hx : x = y ∨ x = y + I := by have : x ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp simpa using this @@ -300,16 +266,10 @@ private theorem vert_unique : omega private theorem horiz_ne_vert : - (by - classical - exact - (ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → ((ProtoTile) → - ((ProtoTile) → ( - let I : GaussianInt := ⟨0, 1⟩ - ∀ (x : GaussianInt), ∀ (y : GaussianInt), ({x, x + 1} : Finset GaussianInt) ≠ {y, - y + I}))))))) ) := by + let I : GaussianInt := ⟨0, 1⟩ + ∀ x y : GaussianInt, ({x, x + 1} : Finset GaussianInt) ≠ {y, y + I} := by classical - intro A B C AB BC CA ABC I x y h + intro I x y h have hx : x = y ∨ x = y + I := by have : x ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp simpa using this @@ -647,16 +607,10 @@ private theorem htripleVfinite : exact ((vertex_finite A).inter_of_left (FootprintVertices B)).inter_of_left (FootprintVertices C) -private theorem htripleVnonempty : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), (ProtoTile) → ((ProtoTile) → - ((ProtoTile) → ((ProtoTile) → (((FootprintVertices A ∩ FootprintVertices B ∩ - FootprintVertices C).ncard = 1) → ((FootprintVertices A ∩ FootprintVertices B ∩ - FootprintVertices C).Nonempty))))) ) := by +private theorem htripleVnonempty (A B C : ProtoTile) + (htripleVcard : (FootprintVertices A ∩ FootprintVertices B ∩ FootprintVertices C).ncard = 1) : + (FootprintVertices A ∩ FootprintVertices B ∩ FootprintVertices C).Nonempty := by classical - intro A B C AB BC CA ABC htripleVcard by_contra hempty rw [Set.not_nonempty_iff_eq_empty] at hempty rw [hempty, Set.ncard_empty] at htripleVcard @@ -947,8 +901,7 @@ theorem LatticeTileThreeDiskJunction have hEAB := edge_union A B AB hunionAB have hEBC := edge_union B C BC hunionBC have hECA := edge_union C A CA hunionCA - have hunionAB_C := ThreeDiskJunctionGeometry.hunionAB_C A B C AB BC CA ABC hunionAB hunionABC - hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid hABCgrid + have hunionAB_C := ThreeDiskJunctionGeometry.hunionAB_C A B C AB ABC hunionAB hunionABC have hVABC := vertex_union AB C ABC hABne hCne hABCne hunionAB_C have hEABC := edge_union AB C ABC hunionAB_C obtain ⟨hVrawAB, ⟨xAB, yAB, hpathAB0⟩, -, -⟩ := @@ -991,12 +944,11 @@ theorem LatticeTileThreeDiskJunction let I : GaussianInt := ⟨0, 1⟩ have horiz_unique (x y : GaussianInt) (h : ({x, x + 1} : Finset GaussianInt) = {y, y + 1}) := - ThreeDiskJunctionGeometry.horiz_unique A B C AB BC CA ABC x y h + ThreeDiskJunctionGeometry.horiz_unique x y h have vert_unique (x y : GaussianInt) (h : ({x, x + I} : Finset GaussianInt) = {y, y + I}) := - ThreeDiskJunctionGeometry.vert_unique A B C AB BC CA ABC x y h - have horiz_ne_vert (x y : GaussianInt) := ThreeDiskJunctionGeometry.horiz_ne_vert A B C AB BC - CA ABC x y + ThreeDiskJunctionGeometry.vert_unique x y h + have horiz_ne_vert (x y : GaussianInt) := ThreeDiskJunctionGeometry.horiz_ne_vert x y have footprint_normalize (T : ProtoTile) (e : Finset GaussianInt) (he : e ∈ FootprintEdges T) := ThreeDiskJunctionGeometry.footprint_normalize T e he have htripleEdges : @@ -1045,8 +997,7 @@ theorem LatticeTileThreeDiskJunction hcellsBC hcellsCA hcellsABC hIEvAB hIEvBC hIEvCA hIEeAB hIEeBC hIEeCA hIEvABC hIEeABC hIEvCross hIEeCross hEulerA hEulerB hEulerC hEulerAB hEulerBC hEulerCA hEulerABC have htripleVfinite := ThreeDiskJunctionGeometry.htripleVfinite A B C vertex_finite - have htripleVnonempty := ThreeDiskJunctionGeometry.htripleVnonempty A B C AB BC CA ABC - htripleVcard + have htripleVnonempty := ThreeDiskJunctionGeometry.htripleVnonempty A B C htripleVcard obtain ⟨rho, hrho⟩ := htripleVnonempty have huniqueRho (z : GaussianInt) := ThreeDiskJunctionGeometry.huniqueRho A B C htripleVcard htripleVfinite rho hrho z diff --git a/LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean b/LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean index c811221909..2e237e21db 100644 --- a/LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean @@ -6,10 +6,10 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell -public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary -- [TABLET NODE: OppositeRoutedCommonEdgeOutsideCellUnique] @@ -40,127 +40,8 @@ theorem OppositeRoutedCommonEdgeOutsideCellUnique LatticeVertexIncidentCell x r = LatticeVertexIncidentCell x s := by -- BODY let I : GaussianInt := ⟨0, 1⟩ - have horiz_unique (u v : GaussianInt) - (h : ({u, u + 1} : Finset GaussianInt) = {v, v + 1}) : u = v := by - have hu : u = v ∨ u = v + 1 := by - have : u ∈ ({v, v + 1} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hv : v = u ∨ v = u + 1 := by - have : v ∈ ({u, u + 1} : Finset GaussianInt) := by rw [h]; simp - simpa using this - rcases hu with huv | huv - · exact huv - rcases hv with hvu | hvu - · exact hvu.symm - · have hre := congrArg Zsqrtd.re huv - have hre' := congrArg Zsqrtd.re hvu - norm_num at hre hre' - omega - have vert_unique (u v : GaussianInt) - (h : ({u, u + I} : Finset GaussianInt) = {v, v + I}) : u = v := by - have hu : u = v ∨ u = v + I := by - have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hv : v = u ∨ v = u + I := by - have : v ∈ ({u, u + I} : Finset GaussianInt) := by rw [h]; simp - simpa using this - rcases hu with huv | huv - · exact huv - rcases hv with hvu | hvu - · exact hvu.symm - · have him := congrArg Zsqrtd.im huv - have him' := congrArg Zsqrtd.im hvu - simp [I] at him him' - omega - have horiz_ne_vert (u v : GaussianInt) : - ({u, u + 1} : Finset GaussianInt) ≠ {v, v + I} := by - intro h - have hu : u = v ∨ u = v + I := by - have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hu1 : u + 1 = v ∨ u + 1 = v + I := by - have : u + 1 ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - rcases hu with hu | hu <;> rcases hu1 with hu1 | hu1 - all_goals - have hre := congrArg Zsqrtd.re hu - have him := congrArg Zsqrtd.im hu - have hre1 := congrArg Zsqrtd.re hu1 - have him1 := congrArg Zsqrtd.im hu1 - simp [I] at hre him hre1 him1 - omega - -- A common boundary edge separates a consecutive pair of occupied cells. - have common_edge_transition (U V : ProtoTile) (y : GaussianInt) - (e : Finset GaussianInt) (hdUV : Disjoint U.cells V.cells) - (hye : y ∈ e) - (he : e ∈ BoundaryFootprintEdges U ∩ BoundaryFootprintEdges V) : - ∃ a : Fin 4, - ((LatticeVertexIncidentCell y a ∈ U.cells ∧ - LatticeVertexIncidentCell y (a + 1) ∈ V.cells) ∨ - (LatticeVertexIncidentCell y a ∈ V.cells ∧ - LatticeVertexIncidentCell y (a + 1) ∈ U.cells)) := by - have hd := Finset.disjoint_left.mp hdUV - rcases he.1 with ⟨u, ⟨heu, hu⟩ | ⟨heu, hu⟩⟩ - · rcases he.2 with ⟨v, ⟨hev, hv⟩ | ⟨hev, hv⟩⟩ - · have huv : u = v := horiz_unique u v (heu.symm.trans hev) - subst v - have hyuv : y = u ∨ y = u + 1 := by - rw [heu] at hye - simpa using hye - rcases hyuv with rfl | rfl - · rcases hu with hu | hu <;> rcases hv with hv | hv - · exact (hd hu.1 hv.1).elim - · refine ⟨3, Or.inr ⟨?_, ?_⟩⟩ - · simpa [LatticeVertexIncidentCell, I] using hv.2 - · simpa [LatticeVertexIncidentCell, I] using hu.1 - · refine ⟨3, Or.inl ⟨?_, ?_⟩⟩ - · simpa [LatticeVertexIncidentCell, I] using hu.2 - · simpa [LatticeVertexIncidentCell, I] using hv.1 - · exact (hd hu.2 hv.2).elim - · rcases hu with hu | hu <;> rcases hv with hv | hv - · exact (hd hu.1 hv.1).elim - · refine ⟨1, Or.inl ⟨?_, ?_⟩⟩ - · simpa [LatticeVertexIncidentCell, I] using hu.1 - · simpa [LatticeVertexIncidentCell, I] using hv.2 - · refine ⟨1, Or.inr ⟨?_, ?_⟩⟩ - · simpa [LatticeVertexIncidentCell, I] using hv.1 - · simpa [LatticeVertexIncidentCell, I] using hu.2 - · exact (hd hu.2 hv.2).elim - · exact (horiz_ne_vert u v (heu.symm.trans hev)).elim - · rcases he.2 with ⟨v, ⟨hev, hv⟩ | ⟨hev, hv⟩⟩ - · exact (horiz_ne_vert v u (hev.symm.trans heu)).elim - · have huv : u = v := vert_unique u v (heu.symm.trans hev) - subst v - have hyuv : y = u ∨ y = u + I := by - rw [heu] at hye - simpa using hye - rcases hyuv with rfl | rfl - · rcases hu with hu | hu <;> rcases hv with hv | hv - · exact (hd hu.1 hv.1).elim - · refine ⟨0, Or.inl ⟨?_, ?_⟩⟩ - · simpa [LatticeVertexIncidentCell, I] using hu.1 - · simpa [LatticeVertexIncidentCell, I] using hv.2 - · refine ⟨0, Or.inr ⟨?_, ?_⟩⟩ - · simpa [LatticeVertexIncidentCell, I] using hv.1 - · simpa [LatticeVertexIncidentCell, I] using hu.2 - · exact (hd hu.2 hv.2).elim - · have hcell2 : LatticeVertexIncidentCell (u + I) 2 = u - 1 := by - ext <;> simp [LatticeVertexIncidentCell, I] - have hcell3 : LatticeVertexIncidentCell (u + I) 3 = u := by - simp [LatticeVertexIncidentCell, I] - rcases hu with hu | hu <;> rcases hv with hv | hv - · exact (hd hu.1 hv.1).elim - · refine ⟨2, Or.inr ⟨?_, ?_⟩⟩ - · simpa only [hcell2] using hv.2 - · simpa only [show (2 : Fin 4) + 1 = 3 from rfl, hcell3] using hu.1 - · refine ⟨2, Or.inl ⟨?_, ?_⟩⟩ - · simpa only [hcell2] using hu.2 - · simpa only [show (2 : Fin 4) + 1 = 3 from rfl, hcell3] using hv.1 - · exact (hd hu.2 hv.2).elim - have hboundary : edge ∈ BoundaryFootprintEdges E ∩ BoundaryFootprintEdges F := by - rw [← CellDisjointCommonEdgesBoundary E F hdisjoint] - exact hedge - obtain ⟨a, ha⟩ := common_edge_transition E F x edge hdisjoint hx hboundary + obtain ⟨a, _, ha⟩ := + P3102T2CommonEdgeSectorTransition E F x edge hdisjoint hx hedge have ha0 : LatticeVertexIncidentCell x a ∈ E.cells ∨ LatticeVertexIncidentCell x a ∈ F.cells := by rcases ha with ha | ha diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean b/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean index ad46301775..b3ecfc3b23 100644 --- a/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean +++ b/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.ProperBandCircleCenterDistance public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedSubdivision @@ -31,56 +32,6 @@ namespace ApollonianSuperharmonic namespace IncidentArcGeometry -private theorem circleDistance : - (by - classical - exact - ∀ (v : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple v → ∀ (i : Fin (4 : ℕ)), ∀ - (k : Fin (4 : ℕ)), i ≠ k → (0 : ℤ) < (v i).1 → (0 : ℤ) < (v k).1 → dist - ((GaussianInt.toComplex : GaussianInt → ℂ) (v i).2 / (↑(v i).1 : ℂ)) - ((GaussianInt.toComplex : GaussianInt → ℂ) (v k).2 / (↑(v k).1 : ℂ)) = (1 : ℝ) / (↑(v - i).1 : ℝ) + (1 : ℝ) / (↑(v k).1 : ℝ) ) := by - classical - intro v hv i k hik hi hk - let w : GaussianInt := (v k).1 • (v i).2 - (v i).1 • (v k).2 - have ht := TangencyCoordinateIdentity v hv.1 i k hik - have normCast (w : GaussianInt) : - Complex.normSq (w : Complex) = (Zsqrtd.norm w : Real) := by - simp [Complex.normSq, Zsqrtd.norm_def] - have hn : Complex.normSq (w : Complex) = - (((v i).1 + (v k).1 : ℤ)^2 : Real) := by - change Complex.normSq - (((v k).1 • (v i).2 - (v i).1 • (v k).2 : GaussianInt) : Complex) = _ - rw [normCast] - exact_mod_cast ht - have hnsq : ‖(w : Complex)‖ ^ 2 = - (((v i).1 + (v k).1 : ℤ) : Real) ^ 2 := by - rw [← Complex.normSq_eq_norm_sq, hn] - have hnorm : ‖(w : Complex)‖ = - (((v i).1 + (v k).1 : ℤ) : Real) := by - have hnonneg := norm_nonneg (w : Complex) - have hsum : 0 ≤ (((v i).1 + (v k).1 : ℤ) : Real) := by positivity - nlinarith - have hdiff : - ((v i).2 : Complex) / (v i).1 - ((v k).2 : Complex) / (v k).1 = - (w : Complex) / (((v i).1 * (v k).1 : ℤ) : Complex) := by - dsimp [w] - push_cast - simp only [map_sub, map_zsmul] - have hia : (v i).1 ≠ 0 := ne_of_gt hi - have hkb : (v k).1 ≠ 0 := ne_of_gt hk - field_simp [hia, hkb] - ring - rw [Complex.dist_eq, hdiff, Complex.norm_div, Complex.norm_intCast, hnorm] - have ha : 0 < ((v i).1 : Real) := by exact_mod_cast hi - have hb : 0 < ((v k).1 : Real) := by exact_mod_cast hk - have hab : 0 < (((v i).1 * (v k).1 : ℤ) : Real) := by - exact_mod_cast mul_pos hi hk - rw [abs_of_pos hab] - push_cast - field_simp [ne_of_gt ha, ne_of_gt hb] - ring - private theorem hparentContactDistance : (by classical @@ -756,7 +707,7 @@ theorem P4984T1IncidentArcs (L : Real) classical have circleDistance (v : Fin 4 → CircleCoordinates) (hv : ProperBandQuadruple v) (i k : Fin 4) (hik : i ≠ k) - (hi : 0 < (v i).1) (hk : 0 < (v k).1) := IncidentArcGeometry.circleDistance v hv i k hik hi hk + (hi : 0 < (v i).1) (hk : 0 < (v k).1) := ProperBandCircleCenterDistance v hv i k hik hi hk have hparentContactDistance : dist (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)) (((q 0).2 : Complex) / ((q 0).1 : Real)) = diff --git a/LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean b/LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean index 0341445954..d10436d23f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean @@ -6,14 +6,14 @@ Authors: Wesley Pegden module public import Mathlib.Init -public import Mathlib.Tactic.Positivity +public import Mathlib.Tactic.Positivity.Finset +public import LeanPool.ApollonianSuperharmonic.ProperBandCircleCenterDistance public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport public import LeanPool.ApollonianSuperharmonic.P4828T1Step public import LeanPool.ApollonianSuperharmonic.P4828T1Rotate public import LeanPool.ApollonianSuperharmonic.P4953T1LiteralHulls public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity public import Mathlib.Analysis.Complex.Basic -- [TABLET NODE: P5050T1OmittedHullSeparation] @@ -31,52 +31,6 @@ namespace ApollonianSuperharmonic namespace OmittedHullLemmas -private theorem circleDistance : - ∀ (v : Fin 4 → CircleCoordinates), (ProperBandQuadruple v) → ∀ (i : Fin 4), ∀ (k : Fin 4), (i - ≠ k) → (0 < (v i).1) → (0 < (v k).1) → dist (((v i).2 : Complex) / (v i).1) - (((v k).2 : Complex) / (v k).1) = - 1 / (v i).1 + 1 / (v k).1 := by - classical - intro v hv i k hik hi hk - let w : GaussianInt := (v k).1 • (v i).2 - (v i).1 • (v k).2 - have ht := TangencyCoordinateIdentity v hv.1 i k hik - have normCast (w : GaussianInt) : - Complex.normSq (w : Complex) = (Zsqrtd.norm w : Real) := by - simp [Complex.normSq, Zsqrtd.norm_def] - have hn : Complex.normSq (w : Complex) = - (((v i).1 + (v k).1 : ℤ)^2 : Real) := by - change Complex.normSq - (((v k).1 • (v i).2 - (v i).1 • (v k).2 : GaussianInt) : Complex) = _ - rw [normCast] - exact_mod_cast ht - have hnsq : ‖(w : Complex)‖ ^ 2 = - (((v i).1 + (v k).1 : ℤ) : Real) ^ 2 := by - rw [← Complex.normSq_eq_norm_sq, hn] - have hnorm : ‖(w : Complex)‖ = - (((v i).1 + (v k).1 : ℤ) : Real) := by - have hnonneg := norm_nonneg (w : Complex) - have hsum : 0 ≤ (((v i).1 + (v k).1 : ℤ) : Real) := by positivity - nlinarith - have hdiff : - ((v i).2 : Complex) / (v i).1 - ((v k).2 : Complex) / (v k).1 = - (w : Complex) / (((v i).1 * (v k).1 : ℤ) : Complex) := by - dsimp [w] - push_cast - simp only [map_sub, map_zsmul] - have hia : (v i).1 ≠ 0 := ne_of_gt hi - have hkb : (v k).1 ≠ 0 := ne_of_gt hk - field_simp [hia, hkb] - ring - rw [Complex.dist_eq, hdiff, Complex.norm_div, Complex.norm_intCast, hnorm] - have ha : 0 < ((v i).1 : Real) := by exact_mod_cast hi - have hb : 0 < ((v k).1 : Real) := by exact_mod_cast hk - have hab : 0 < (((v i).1 * (v k).1 : ℤ) : Real) := by - exact_mod_cast mul_pos hi hk - rw [abs_of_pos hab] - push_cast - field_simp [ne_of_gt ha, ne_of_gt hb] - ring - private theorem projectionAffine : ∀ (a : Complex), ∀ (x : Complex), ∀ (d : Real), (d ≠ 0) → ∃ D : Complex →ᵃ[Real] Real, ∀ z, D z = ((x - a) * (starRingEnd Complex) (z - a)).re / d := by @@ -531,7 +485,7 @@ theorem P5050T1OmittedHullSeparation (L : ℝ) (hi : 0 < (v i).1) (hk : 0 < (v k).1) : dist (((v i).2 : Complex) / (v i).1) (((v k).2 : Complex) / (v k).1) = - 1 / (v i).1 + 1 / (v k).1 := OmittedHullLemmas.circleDistance v hv i k hik hi hk + 1 / (v i).1 + 1 / (v k).1 := ProperBandCircleCenterDistance v hv i k hik hi hk have projectionAffine (a x : Complex) (d : Real) (hd : d ≠ 0) : ∃ D : Complex →ᵃ[Real] Real, ∀ z, D z = ((x - a) * (starRingEnd Complex) (z - a)).re / d := diff --git a/LeanPool/ApollonianSuperharmonic/P5050T1ParentSphereSection.lean b/LeanPool/ApollonianSuperharmonic/P5050T1ParentSphereSection.lean index 245484f960..044d741b77 100644 --- a/LeanPool/ApollonianSuperharmonic/P5050T1ParentSphereSection.lean +++ b/LeanPool/ApollonianSuperharmonic/P5050T1ParentSphereSection.lean @@ -6,13 +6,13 @@ Authors: Wesley Pegden module public import Mathlib.Init -public import Mathlib.Tactic.Positivity +public import Mathlib.Tactic.Positivity.Finset +public import LeanPool.ApollonianSuperharmonic.ProperBandCircleCenterDistance public import LeanPool.ApollonianSuperharmonic.P4984T1ClosedGap public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport public import LeanPool.ApollonianSuperharmonic.P4953T1LiteralHulls public import LeanPool.ApollonianSuperharmonic.ProperBandCurvatureStructure -public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity public import LeanPool.ApollonianSuperharmonic.P5050T1TangentTriangleSection public import LeanPool.ApollonianSuperharmonic.P5050T1TangentLineSection @@ -31,56 +31,6 @@ namespace ApollonianSuperharmonic namespace ParentSphereProof -private theorem circleDistance : - (by - classical - exact - ∀ (v : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple v → ∀ (i : Fin (4 : ℕ)), ∀ - (k : Fin (4 : ℕ)), i ≠ k → (0 : ℤ) < (v i).1 → (0 : ℤ) < (v k).1 → dist - ((GaussianInt.toComplex : GaussianInt → ℂ) (v i).2 / (↑(v i).1 : ℂ)) - ((GaussianInt.toComplex : GaussianInt → ℂ) (v k).2 / (↑(v k).1 : ℂ)) = (1 : ℝ) / (↑(v - i).1 : ℝ) + (1 : ℝ) / (↑(v k).1 : ℝ) ) := by - classical - intro v hv i k hik hi hk - let w : GaussianInt := (v k).1 • (v i).2 - (v i).1 • (v k).2 - have ht := TangencyCoordinateIdentity v hv.1 i k hik - have normCast (w : GaussianInt) : - Complex.normSq (w : Complex) = (Zsqrtd.norm w : Real) := by - simp [Complex.normSq, Zsqrtd.norm_def] - have hn : Complex.normSq (w : Complex) = - (((v i).1 + (v k).1 : ℤ)^2 : Real) := by - change Complex.normSq - (((v k).1 • (v i).2 - (v i).1 • (v k).2 : GaussianInt) : Complex) = _ - rw [normCast] - exact_mod_cast ht - have hnsq : ‖(w : Complex)‖ ^ 2 = - (((v i).1 + (v k).1 : ℤ) : Real) ^ 2 := by - rw [← Complex.normSq_eq_norm_sq, hn] - have hnorm : ‖(w : Complex)‖ = - (((v i).1 + (v k).1 : ℤ) : Real) := by - have hnonneg := norm_nonneg (w : Complex) - have hsum : 0 ≤ (((v i).1 + (v k).1 : ℤ) : Real) := by positivity - nlinarith - have hdiff : - ((v i).2 : Complex) / (v i).1 - ((v k).2 : Complex) / (v k).1 = - (w : Complex) / (((v i).1 * (v k).1 : ℤ) : Complex) := by - dsimp [w] - push_cast - simp only [map_sub, map_zsmul] - have hia : (v i).1 ≠ 0 := ne_of_gt hi - have hkb : (v k).1 ≠ 0 := ne_of_gt hk - field_simp [hia, hkb] - ring - rw [Complex.dist_eq, hdiff, Complex.norm_div, Complex.norm_intCast, hnorm] - have ha : 0 < ((v i).1 : Real) := by exact_mod_cast hi - have hb : 0 < ((v k).1 : Real) := by exact_mod_cast hk - have hab : 0 < (((v i).1 * (v k).1 : ℤ) : Real) := by - exact_mod_cast mul_pos hi hk - rw [abs_of_pos hab] - push_cast - field_simp [ne_of_gt ha, ne_of_gt hb] - ring - private theorem parentHull : (by classical @@ -300,7 +250,7 @@ theorem P5050T1ParentSphereSection (L : ℝ) (hi : 0 < (v i).1) (hk : 0 < (v k).1) : dist (((v i).2 : Complex) / (v i).1) (((v k).2 : Complex) / (v k).1) = - 1 / (v i).1 + 1 / (v k).1 := ParentSphereProof.circleDistance v hv i k hik hi hk + 1 / (v i).1 + 1 / (v k).1 := ProperBandCircleCenterDistance v hv i k hik hi hk have parentHull (v : Fin 4 → CircleCoordinates) (hv : ∀ i : Fin 3, 0 < (v i.succ).1) : P4909T1ParentPolygon L v = diff --git a/LeanPool/ApollonianSuperharmonic/ProperBandCircleCenterDistance.lean b/LeanPool/ApollonianSuperharmonic/ProperBandCircleCenterDistance.lean new file mode 100644 index 0000000000..c42d5e1755 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ProperBandCircleCenterDistance.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import Mathlib.Tactic.Positivity.Finset +public import Mathlib.Analysis.Complex.Basic +public import LeanPool.ApollonianSuperharmonic.TangencyCoordinateIdentity + +/-! +# Distance between positive circles in a proper band quadruple + +Adapted from Wesley Pegden's Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +The shared proof converts the integral tangency identity to a Euclidean distance. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- The centers of two positive tangent band circles are separated by the sum of their radii. -/ +theorem ProperBandCircleCenterDistance (v : Fin 4 → CircleCoordinates) + (hv : ProperBandQuadruple v) (i k : Fin 4) (hik : i ≠ k) + (hi : 0 < (v i).1) (hk : 0 < (v k).1) : + dist (((v i).2 : Complex) / (v i).1) (((v k).2 : Complex) / (v k).1) = + 1 / ((v i).1 : Real) + 1 / ((v k).1 : Real) := by + classical + let w : GaussianInt := (v k).1 • (v i).2 - (v i).1 • (v k).2 + have ht := TangencyCoordinateIdentity v hv.1 i k hik + have normCast (w : GaussianInt) : + Complex.normSq (w : Complex) = (Zsqrtd.norm w : Real) := by + simp [Complex.normSq, Zsqrtd.norm_def] + have hn : Complex.normSq (w : Complex) = + (((v i).1 + (v k).1 : ℤ)^2 : Real) := by + change Complex.normSq + (((v k).1 • (v i).2 - (v i).1 • (v k).2 : GaussianInt) : Complex) = _ + rw [normCast] + exact_mod_cast ht + have hnsq : ‖(w : Complex)‖ ^ 2 = + (((v i).1 + (v k).1 : ℤ) : Real) ^ 2 := by + rw [← Complex.normSq_eq_norm_sq, hn] + have hnorm : ‖(w : Complex)‖ = + (((v i).1 + (v k).1 : ℤ) : Real) := by + have hnonneg := norm_nonneg (w : Complex) + have hsum : 0 ≤ (((v i).1 + (v k).1 : ℤ) : Real) := by positivity + nlinarith + have hdiff : + ((v i).2 : Complex) / (v i).1 - ((v k).2 : Complex) / (v k).1 = + (w : Complex) / (((v i).1 * (v k).1 : ℤ) : Complex) := by + dsimp [w] + push_cast + simp only [map_sub, map_zsmul] + have hia : (v i).1 ≠ 0 := ne_of_gt hi + have hkb : (v k).1 ≠ 0 := ne_of_gt hk + field_simp [hia, hkb] + ring + rw [Complex.dist_eq, hdiff, Complex.norm_div, Complex.norm_intCast, hnorm] + have ha : 0 < ((v i).1 : Real) := by exact_mod_cast hi + have hb : 0 < ((v k).1 : Real) := by exact_mod_cast hk + have hab : 0 < (((v i).1 * (v k).1 : ℤ) : Real) := by + exact_mod_cast mul_pos hi hk + rw [abs_of_pos hab] + push_cast + field_simp [ne_of_gt ha, ne_of_gt hb] + ring + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean b/LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean index 4e18e25efb..dc369959da 100644 --- a/LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean +++ b/LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean @@ -39,10 +39,9 @@ $$ v_{20}&=v_{21}-iv_{32},&v_{03}&=v_{13}+iv_{32},\\ a_{20}&=a_{21}+ia_{32},&a_{03}&=a_{13}-ia_{32}. \end{aligned} -\end{aligned} $$ -These are exactly the recursion rules of equation (4.2), and parent -rotations provide the other cases. Finally, only when $C\to D$ is the +These successor relations are the unnumbered recursion display in Section 5.3 +of the cited paper; parent rotations provide the other cases. Finally, only when $C\to D$ is the canonical orientation of \operatorname{PrimitiveVectorOrientation}, the opposite ordered value is prescribed once by $$ From dfd58c0d8d25d8f04efb474bc805adf1905b64ef Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Thu, 12 Nov 2026 17:38:46 +0000 Subject: [PATCH 07/23] Share recurring geometric facts and remove duplicate private proofs --- ...deredGeneralLargestParentOdometerRows.lean | 146 +------- .../BandOrderedGeneralRawSupport.lean | 32 +- ...eneralRightInterfaceCertificateExists.lean | 78 +--- ...dGeneralRightRoutingCertificateExists.lean | 77 +--- .../BandTileAcyclicIndegree.lean | 41 +-- .../BandVectorParentSums.lean | 84 +++++ .../BoundaryFrameRowGeometry.lean | 107 ++++++ .../ExposedCornerAffineBasis.lean | 77 ++++ LeanPool/ApollonianSuperharmonic/Imports.lean | 4 + .../LatticeAdjacentPackingSymmetryFacts.lean | 206 +++++++++++ ...tticeAdjacentPackingSymmetryTransport.lean | 344 +----------------- .../MarkedOdometerAdjacencyReduction.lean | 18 +- .../OrientedTouchingCovariance.lean | 82 +---- .../P3523T1InsertionGeometry.lean | 115 +----- .../P3523T1OrderedInsertion.lean | 77 +--- .../P3597T1VertexSectors.lean | 15 +- .../P3650T1EmptyTriangleDiagonal.lean | 83 +---- .../P3650T1MaximalHeightDiagonal.lean | 54 +-- .../P3650T1OldArcEven.lean | 107 +----- .../P3650T1TriangleEntry.lean | 54 +-- .../P3723T1AllContactDrawingExists.lean | 140 +------ .../P3889T1FaceGapCoverage.lean | 95 +---- .../P3963T1ExteriorMixedCycleObstruction.lean | 88 +---- ...4055T1OrderedGeneralOppositeEndpoints.lean | 90 +---- .../P4366T2LocalSectors.lean | 16 +- .../P4456T2CrosscutIndex.lean | 20 +- .../P4458T1LargestParentRows.lean | 80 +--- .../P4458T1SecondNewerRows.lean | 146 +------- .../P4536T1AFrameD.lean | 207 +---------- .../P4564T2DiamondGeometry.lean | 20 +- .../P4564T2FordGeometry.lean | 46 +-- .../P4984T1UnitIncidence.lean | 173 +-------- .../P5491T1DiamondRightBoundary.lean | 60 +-- ...MarkedRightOdometerAdjacencyReduction.lean | 17 +- .../P5635T1EndpointDiagonalOwnership.lean | 58 +-- .../PositiveCurvatureTranslatedOdometers.lean | 18 +- ...tticeAdjacentPackingSymmetryTransport.lean | 301 +-------------- 37 files changed, 614 insertions(+), 2762 deletions(-) create mode 100644 LeanPool/ApollonianSuperharmonic/BandVectorParentSums.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BoundaryFrameRowGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ExposedCornerAffineBasis.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeAdjacentPackingSymmetryFacts.lean diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean index cdec0fd339..cc062edd38 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean @@ -1142,50 +1142,6 @@ private theorem hSpackAt712 : exact False.elim ((cfg.noLine 2) hbad) · simpa [Fin.add_def] using hgood -private theorem hPplusPackAt731 : - (by - classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> - Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> - ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> - PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData - q cfg C0 T cert h P r Q S u v g) → ( - let B : GaussianInt := BandVectors.2 (q 3) (q 2) - ∃ p pP : Real × Real, PartialOdometerSlope h = some p ∧ PartialOdometerSlope (r 0 true) = - some pP ∧ pP.1 - p.1 = (1 / 2) * (((B.re : Int) : Real) - ((B.im : Int) : Real)) ∧ - pP.2 - p.2 = (1 / 2) * (((B.im : Int) : Real) + ((B.re : Int) : Real))) ) := by - classical - intro q cfg C0 T cert h P r Q S u v g data B - rcases data.hPslope 0 true with hzero | hgood - · have hbad : (q 1).1 = 0 := by simpa using hzero - exact False.elim ((cfg.noLine 1) hbad) - · simpa [Fin.add_def, B] using hgood - -private theorem hPminusPackAt742 : - (by - classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> - Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> - ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> - PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData - q cfg C0 T cert h P r Q S u v g) → ( - let B : GaussianInt := BandVectors.2 (q 3) (q 2) - ∃ p pP : Real × Real, PartialOdometerSlope h = some p ∧ PartialOdometerSlope (r 0 false) - = some pP ∧ pP.1 - p.1 = -(1 / 2) * (((B.re : Int) : Real) - ((B.im : Int) : Real)) ∧ - pP.2 - p.2 = -(1 / 2) * (((B.im : Int) : Real) + ((B.re : Int) : Real))) ) := by - classical - intro q cfg C0 T cert h P r Q S u v g data B - rcases data.hPslope 0 false with hzero | hgood - · have hbad : (q 1).1 = 0 := by simpa using hzero - exact False.elim ((cfg.noLine 1) hbad) - · simpa [Fin.add_def, B] using hgood - private theorem hQdeltaAt765 : (by classical @@ -1236,48 +1192,6 @@ private theorem hSdeltaAt772 : · change pS.2 - pSroot.2 = _ simpa [sOff, Prod.smul_mk] using hSim -private theorem hPplusDeltaAt779 : - (by - classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), - let sOff (z : GaussianInt) : Real × Real := - (1 / 2 : Real) • - (((z.re : Int) : Real) - ((z.im : Int) : Real), - ((z.im : Int) : Real) + ((z.re : Int) : Real)) - let B : GaussianInt := BandVectors.2 (q 3) (q 2) - ∀ (pRoot : ℝ × ℝ), ∀ (pPplus : ℝ × ℝ), (pPplus.1 - pRoot.1 = (1 / 2 : ℝ) * ((↑B.re : ℝ) - - (↑B.im : ℝ))) → ((pPplus.2 - pRoot.2 = (1 / 2 : ℝ) * ((↑B.im : ℝ) + (↑B.re : ℝ))) → - (pPplus - pRoot = sOff B)) ) := by - classical - intro q sOff B pRoot pPplus hPplusRe hPplusIm - apply Prod.ext - · change pPplus.1 - pRoot.1 = _ - simpa [sOff, Prod.smul_mk] using hPplusRe - · change pPplus.2 - pRoot.2 = _ - simpa [sOff, Prod.smul_mk] using hPplusIm - -private theorem hPminusDeltaAt785 : - (by - classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), - let sOff (z : GaussianInt) : Real × Real := - (1 / 2 : Real) • - (((z.re : Int) : Real) - ((z.im : Int) : Real), - ((z.im : Int) : Real) + ((z.re : Int) : Real)) - let B : GaussianInt := BandVectors.2 (q 3) (q 2) - ∀ (pRoot' : ℝ × ℝ), ∀ (pPminus : ℝ × ℝ), (pPminus.1 - pRoot'.1 = -(1 / 2 : ℝ) * ((↑B.re : - ℝ) - (↑B.im : ℝ))) → ((pPminus.2 - pRoot'.2 = -(1 / 2 : ℝ) * ((↑B.im : ℝ) + (↑B.re : - ℝ))) → (pPminus - pRoot' = -sOff B)) ) := by - classical - intro q sOff B pRoot' pPminus hPminusRe hPminusIm - apply Prod.ext - · change pPminus.1 - pRoot'.1 = _ - simpa [sOff, Prod.smul_mk] using hPminusRe - · change pPminus.2 - pRoot'.2 = _ - simpa [sOff, Prod.smul_mk] using hPminusIm - private theorem hPminusDelta' : (by classical @@ -1355,20 +1269,6 @@ private theorem hP1At810 : intro q cfg C0 T cert h P r Q S u v g data cOff simpa [cOff, Fin.add_def] using data.hPcent 1 false -private theorem hq13At813 : - (by - classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), (BandOrderedGeneralConfiguration q) → ( - let U : GaussianInt := BandVectors.1 (q 2) (q 1) - let W : GaussianInt := BandVectors.1 (q 3) (q 2) - BandVectors.1 (q 1) (q 3) = -U - W) ) := by - classical - intro q cfg U W - have hsum := (VectorRecursionLaws q cfg.proper.1).1 - dsimp [U, W] - linear_combination hsum - private theorem hform'At819 : (by classical @@ -1497,38 +1397,6 @@ private theorem htranslateCentAt864 : linear_combination hf _ = TileCentroid (P 1 false) := hP1centre.symm -private theorem hsumVAt899 : - (by - classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), - let I : GaussianInt := ⟨0, 1⟩ - let W : GaussianInt := BandVectors.1 (q 3) (q 2) - (BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = I * BandVectors.1 (q (3 : - Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → (BandVectors.1 (cfg.secondPredecessor 1) - (cfg.secondPredecessor 0) + BandVectors.1 (cfg.secondPredecessor 0) - (cfg.secondPredecessor 1) = W + I * W) ) := by - classical - intro q cfg I W hflipV0 - rw [cfg.secondVectorOne, cfg.secondChild, cfg.secondParentOne, hflipV0] - -private theorem hsumAAt903 : - (by - classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), - let I : GaussianInt := ⟨0, 1⟩ - let B : GaussianInt := BandVectors.2 (q 3) (q 2) - (BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = -I * BandVectors.2 (q (3 : - Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → (BandVectors.2 (cfg.secondPredecessor 1) - (cfg.secondPredecessor 0) + BandVectors.2 (cfg.secondPredecessor 0) - (cfg.secondPredecessor 1) = B - I * B) ) := by - classical - intro q cfg I B hflipA - rw [cfg.secondParentOne, cfg.secondChild, hflipA] - dsimp [B] - ring - private theorem hcentTargetAt909 : (by classical @@ -2058,9 +1926,9 @@ private theorem reflectedLargestCase : centroidAlgebra hQleafOff hSleafOff hPplus hPminus have hQpack := LargestParentOdometerGeometry.hQpackAt693 q cfg C0 T cert h P r Q S u v g data have hSpack := LargestParentOdometerGeometry.hSpackAt712 q cfg C0 T cert h P r Q S u v g data - have hPplusPack := LargestParentOdometerGeometry.hPplusPackAt731 q cfg C0 T cert h P r Q S u + have hPplusPack := LargestParentOdometerGeometry.hPplusPackAt364 q cfg C0 T cert h P r Q S u v g data - have hPminusPack := LargestParentOdometerGeometry.hPminusPackAt742 q cfg C0 T cert h P r Q S + have hPminusPack := LargestParentOdometerGeometry.hPminusPackAt375 q cfg C0 T cert h P r Q S u v g data obtain ⟨pQroot, pQ, hQroot, hQleafSlope, hQre, hQim⟩ := hQpack obtain ⟨pSroot, pS, hSroot, hSleafSlope, hSre, hSim⟩ := hSpack @@ -2076,16 +1944,16 @@ private theorem reflectedLargestCase : Option.some.inj (hRoot.symm.trans hRoot') have hQdelta := LargestParentOdometerGeometry.hQdeltaAt765 q cfg pQroot pQ hQre hQim have hSdelta := LargestParentOdometerGeometry.hSdeltaAt772 q cfg pSroot pS hSre hSim - have hPplusDelta := LargestParentOdometerGeometry.hPplusDeltaAt779 q pRoot pPplus hPplusRe + have hPplusDelta := LargestParentOdometerGeometry.hPplusDeltaAt412 q pRoot pPplus hPplusRe hPplusIm - have hPminusDelta := LargestParentOdometerGeometry.hPminusDeltaAt785 q pRoot' pPminus + have hPminusDelta := LargestParentOdometerGeometry.hPminusDeltaAt418 q pRoot' pPminus hPminusRe hPminusIm have hslopeDiff := LargestParentOdometerGeometry.hslopeDiffAt794 q cfg a21 a13 slopeAlgebra pQroot pQ pSroot pS pRoot pPplus pPminus hQalign hSalign hQdelta hSdelta hPplusDelta (LargestParentOdometerGeometry.hPminusDelta' q pRoot pRoot' pPminus hrootAlign hPminusDelta) have hP1 := LargestParentOdometerGeometry.hP1At810 q cfg C0 T cert h P r Q S u v g data - have hq13 := LargestParentOdometerGeometry.hq13At813 q cfg + have hq13 := LargestParentOdometerGeometry.hq13At444 q cfg have hform := (TileTranslationFormulas (S 1 false) (((I : GaussianInt) ^ (3 : Nat)) * W)).2.2.2.2.1 have htranslateCent := LargestParentOdometerGeometry.htranslateCentAt864 q cfg T P S v13 @@ -2106,8 +1974,8 @@ private theorem reflectedLargestCase : BandVectors.2 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) at hflipA rw [cfg.secondChild, cfg.secondParentOne] at hflipV0 hflipA - have hsumV := LargestParentOdometerGeometry.hsumVAt899 q cfg hflipV0 - have hsumA := LargestParentOdometerGeometry.hsumAAt903 q cfg hflipA + have hsumV := LargestParentOdometerGeometry.hsumVAt525 q cfg hflipV0 + have hsumA := LargestParentOdometerGeometry.hsumAAt529 q cfg hflipA have hcentTarget := LargestParentOdometerGeometry.hcentTargetAt909 q cfg Q S hcentdiff hsumV have hslopePair := LargestParentOdometerGeometry.hslopePairAt916 q cfg pQ pS hslopeDiff hsumA have hadj := LargestParentOdometerGeometry.hadjAt922 q cfg C0 T cert h P r Q S u v g data diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean index e5cc5b01ba..04bbb157f0 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean @@ -544,34 +544,6 @@ private theorem hzmodified : rw [hretain] exact hz -private theorem translation_zeroAt397 : - (by - classical - exact - ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by - classical - intro U - have hzero : GaussianTranslation (0 : GaussianInt) = id := by - funext z - simp [GaussianTranslation] - cases U - simp [TileTranslation, hzero, GaussianTranslation] - -private theorem htileAAt403 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ - (∀ (U : ProtoTile), TileTranslation U 0 = U) → (cert.modified.tile a = TileCellComplement - (cert.P 0 true) cert.O) ) := by - classical - intro q cfg C₀ T cert a translation_zero - rw [cert.modified_tile] - simp [a, ModifiedSubtileOccurrenceInterpretation, translation_zero] - private theorem htileB : (by classical @@ -908,9 +880,9 @@ theorem BandOrderedGeneralRawSupport let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ let f2 := cert.modifiedFaceEquivalence.symm ⟨.I2, 0, 0⟩ have translation_zero (U : ProtoTile) : TileTranslation U 0 = U := - RawSupportGeometry.translation_zeroAt397 U + RawSupportGeometry.translation_zeroAt149 U have htileA : cert.modified.tile a = - TileCellComplement (cert.P 0 true) cert.O := RawSupportGeometry.htileAAt403 q cfg C₀ T + TileCellComplement (cert.P 0 true) cert.O := RawSupportGeometry.htileAAt155 q cfg C₀ T cert translation_zero have htileB : cert.modified.tile b = cert.P 0 false := RawSupportGeometry.htileB q cfg C₀ T cert translation_zero diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean index ef48c50e24..ee6f26f8a9 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandVectorParentSums public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightInterfaceCertificate public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceDisjointCompanionEndpoints @@ -450,79 +451,6 @@ private theorem touch2m : simpa [turn_three, turn_two, turn2, turn0, turn_neg] using thirdTurnTouching F _ _ normalization.fixed_quarter_turn touch2 -private theorem incoming_relation : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralRightNormalizationCertificate C T N h k x), - let q := normalization.normalizedPresentation - (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 - : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : - ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) - + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : - Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin - (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 - : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q - (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = - BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ - (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q - j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin - (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → (BandVectors.1 (q - 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) ) := by - classical - intro C T N h k x normalization q laws - let r : Fin 4 -> CircleCoordinates := ![q 0, q 2, q 3, q 1] - have hr : SemiProperQuadruple r := by - simpa [r] using SemiProperQuadruple.rotate - normalization.configuration.proper.1 - let s : Fin 4 -> CircleCoordinates := ![r 0, r 2, r 3, r 1] - have hs : SemiProperQuadruple s := by - simpa [s] using SemiProperQuadruple.rotate hr - have second := VectorRecursionLaws r hr - have third := VectorRecursionLaws s hs - have e0 := laws.2.2.1 - have e1 := second.2.2.1 - have e2 := third.2.2.1 - simp only [Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, Int.reduceNeg, - Matrix.cons_val, r, s] at e1 e2 - rw [e0, e1, e2] - calc - _ = (1 - (⟨0, 1⟩ : GaussianInt)) * - (BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 1) (q 3) + - BandVectors.1 (q 2) (q 1)) := by ring - _ = 0 := by rw [laws.1]; simp - -private theorem outgoing_relation : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralRightNormalizationCertificate C T N h k x), - let q := normalization.normalizedPresentation - (GaussianQuarterTurn (BandVectors.1 (q 1) (q 0)) = BandVectors.1 (q 0) (q 1)) → - ((GaussianQuarterTurn (BandVectors.1 (q 2) (q 0)) = BandVectors.1 (q 0) (q 2)) → - ((GaussianQuarterTurn (BandVectors.1 (q 3) (q 0)) = BandVectors.1 (q 0) (q 3)) → - ((BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = - 0) → (BandVectors.1 (q 0) (q 1) + BandVectors.1 (q 0) (q 2) + BandVectors.1 (q 0) (q - 3) = 0)))) ) := by - classical - intro C T N h k x normalization q turn0 turn1 turn2 incoming_relation - rw [← turn0, ← turn1, ← turn2] - calc - _ = GaussianQuarterTurn (BandVectors.1 (q 1) (q 0) + - BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0)) := by - rcases BandVectors.1 (q 1) (q 0) with ⟨a0, b0⟩ - rcases BandVectors.1 (q 2) (q 0) with ⟨a1, b1⟩ - rcases BandVectors.1 (q 3) (q 0) with ⟨a2, b2⟩ - apply Zsqrtd.ext <;> simp [GaussianQuarterTurn]; ring - _ = GaussianQuarterTurn 0 := congrArg GaussianQuarterTurn incoming_relation - _ = 0 := by rfl - private theorem period2 : (by classical @@ -1231,9 +1159,7 @@ theorem BandOrderedGeneralRightInterfaceCertificateExists have period2 : BandVectors.1 (q 0) (q 3) = -normalization.layout.u - normalization.layout.v := RightInterfaceCertificateGeometry.period2 C T N h k x normalization - (RightInterfaceCertificateGeometry.outgoing_relation C T N h k x normalization - turn0 turn1 turn2 (RightInterfaceCertificateGeometry.incoming_relation C T N h k x - normalization laws)) + (BandVectorOutgoingSum q normalization.configuration.proper) period0 period1 have rightInterfaceCertificate : Nonempty (BandOrderedGeneralRightInterfaceCertificate normalization) := diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean index 58739813de..a59bcd1234 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandVectorParentSums public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightRoutingCertificate public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralShiftedRoutedBoundaryLocalization @@ -95,79 +96,6 @@ private theorem turn_flip : rcases BandVectors.1 (q s.succ) (q 0) with ⟨a, b⟩ apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] -private theorem incoming_relation : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralRightNormalizationCertificate C T N h k x), - let q := normalization.normalizedPresentation - (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 - : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : - ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) - + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : - Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin - (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 - : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q - (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = - BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ - (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q - j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin - (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → (BandVectors.1 (q - 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) ) := by - classical - intro C T N h k x normalization q laws - let r : Fin 4 -> CircleCoordinates := ![q 0, q 2, q 3, q 1] - have hr : SemiProperQuadruple r := by - simpa [r] using SemiProperQuadruple.rotate - normalization.configuration.proper.1 - let s : Fin 4 -> CircleCoordinates := ![r 0, r 2, r 3, r 1] - have hs : SemiProperQuadruple s := by - simpa [s] using SemiProperQuadruple.rotate hr - have second := VectorRecursionLaws r hr - have third := VectorRecursionLaws s hs - have e0 := laws.2.2.1 - have e1 := second.2.2.1 - have e2 := third.2.2.1 - simp only [Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, Int.reduceNeg, - Matrix.cons_val, r, s] at e1 e2 - rw [e0, e1, e2] - calc - _ = (1 - (⟨0, 1⟩ : GaussianInt)) * - (BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 1) (q 3) + - BandVectors.1 (q 2) (q 1)) := by ring - _ = 0 := by rw [laws.1]; simp - -private theorem outgoing_relation : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralRightNormalizationCertificate C T N h k x), - let q := normalization.normalizedPresentation - (GaussianQuarterTurn (BandVectors.1 (q 1) (q 0)) = BandVectors.1 (q 0) (q 1)) → - ((GaussianQuarterTurn (BandVectors.1 (q 2) (q 0)) = BandVectors.1 (q 0) (q 2)) → - ((GaussianQuarterTurn (BandVectors.1 (q 3) (q 0)) = BandVectors.1 (q 0) (q 3)) → - ((BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = - 0) → (BandVectors.1 (q 0) (q 1) + BandVectors.1 (q 0) (q 2) + BandVectors.1 (q 0) (q - 3) = 0)))) ) := by - classical - intro C T N h k x normalization q turn0 turn1 turn2 incoming_relation - rw [← turn0, ← turn1, ← turn2] - calc - _ = GaussianQuarterTurn (BandVectors.1 (q 1) (q 0) + - BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0)) := by - rcases BandVectors.1 (q 1) (q 0) with ⟨a0, b0⟩ - rcases BandVectors.1 (q 2) (q 0) with ⟨a1, b1⟩ - rcases BandVectors.1 (q 3) (q 0) with ⟨a2, b2⟩ - apply Zsqrtd.ext <;> simp [GaussianQuarterTurn]; ring - _ = GaussianQuarterTurn 0 := congrArg GaussianQuarterTurn incoming_relation - _ = 0 := by rfl - private theorem period2 : (by classical @@ -1099,8 +1027,7 @@ theorem BandOrderedGeneralRightRoutingCertificateExists have hexteriorOccurrence := RightRoutingGeometry.hexteriorOccurrence C T N h k x normalization j selectedSlot selectedSign hselected (RightRoutingGeometry.hdisplacement C T N h k x normalization period0 period1 (RightRoutingGeometry.period2 C T N h k x normalization - (RightRoutingGeometry.outgoing_relation C T N h k x normalization turn0 turn1 turn2 - (RightRoutingGeometry.incoming_relation C T N h k x normalization laws)) period0 period1)) + (BandVectorOutgoingSum q normalization.configuration.proper) period0 period1)) hshift have houterObservables := ProtoTileObservableExtensionality normalization.normalizedRoot diff --git a/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean b/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean index ca08de2b52..b2d43bee3d 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean @@ -618,43 +618,6 @@ private theorem closed : rw [hpair a b hab, ite_eq_right hz] simp [hempty] at hx -private theorem hPo : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r - : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), - let qr : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let p := BandPackingSymmetryQuadrupleAction s qr - let V := BandPackingSymmetryTileAction s U - let l := BandPackingSymmetryPartialOdometerAction s k - ∀ (hp : ProperBandQuadruple p), ∀ (hpos : 0 < (p 0).1), ∀ (cfg : - BandOrderedGeneralConfiguration p), - let B : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ - ∀ (cert : BandOrderedGeneralLayoutCertificate p cfg B V), - let restrict (W : ProtoTile) : PartialOdometer := - let d := l.domain.filter fun x => decide (x ∈ FootprintVertices W) - { domain := d - value := fun x => if x ∈ d then l.value x else 0 - value_outside := by intro x hx; exact ite_eq_right hx } - let ls := fun i s => restrict (cert.P i s) - ∀ (G : IntegerLatticeFunction), - let D := l.domain.filter fun x => - @decide (x ∉ BoundaryFootprintVertices V) (Classical.propDecidable _) - let A := fun a : Fin 3 × Bool => (ls a.1 a.2).domain.filter fun x => - @decide (x ∉ BoundaryFootprintVertices (cert.P a.1 a.2)) - (Classical.propDecidable _) - let σ := fun x => 2 + FourNeighborLaplacian G x - (AcyclicIndegreeOrientation (Finset.univ.biUnion A) σ) → ( - let P := D.filter fun x => @decide (∃ i t, x ∈ (ls i t).domain ∧ - x ∉ BoundaryFootprintVertices (cert.P i t)) (Classical.propDecidable _) - (Finset.univ.biUnion A = P) → (Nonempty (AcyclicIndegreeOrientation P σ))) ) := by - classical - intro U k q r s qr p V l hp hpos cfg B cert restrict ls G D A σ oUnion P hUnion - rw [← hUnion] - exact ⟨oUnion⟩ - end BandAcyclicIndegreeGeometry theorem BandTileAcyclicIndegree : @@ -817,7 +780,9 @@ theorem BandTileAcyclicIndegree : let P := D.filter fun x => @decide (∃ i t, x ∈ (ls i t).domain ∧ x ∉ BoundaryFootprintVertices (cert.P i t)) (Classical.propDecidable _) change Finset.univ.biUnion A = P at hUnion - have hPo := BandAcyclicIndegreeGeometry.hPo U k q r s hp hpos cfg cert G oUnion hUnion + have hPo : Nonempty (AcyclicIndegreeOrientation P σ) := by + rw [← hUnion] + exact ⟨oUnion⟩ obtain ⟨R, hf, hcard, hres⟩ := BandInterfaceRootedForest B p cfg V cert l ls G hV hlat hl hldom hls hlsdom heG hrest htile hweb hperiod hPo obtain ⟨oD, _⟩ := P5532T1ForestAttachment D P R σ (Finset.filter_subset _ _) diff --git a/LeanPool/ApollonianSuperharmonic/BandVectorParentSums.lean b/LeanPool/ApollonianSuperharmonic/BandVectorParentSums.lean new file mode 100644 index 0000000000..c1e89b1253 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandVectorParentSums.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Ring + +/-! +# Parent-vector sum identities + +Adapted from Wesley Pegden's Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- The three parent vectors pointing into the child sum to zero. -/ +theorem BandVectorIncomingSum (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) : + BandVectors.1 (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + + BandVectors.1 (q 3) (q 0) = 0 := by + classical + have laws := VectorRecursionLaws q hq.1 + let r : Fin 4 -> CircleCoordinates := ![q 0, q 2, q 3, q 1] + have hr : SemiProperQuadruple r := by + simpa [r] using SemiProperQuadruple.rotate + hq.1 + let s : Fin 4 -> CircleCoordinates := ![r 0, r 2, r 3, r 1] + have hs : SemiProperQuadruple s := by + simpa [s] using SemiProperQuadruple.rotate hr + have second := VectorRecursionLaws r hr + have third := VectorRecursionLaws s hs + have e0 := laws.2.2.1 + have e1 := second.2.2.1 + have e2 := third.2.2.1 + simp only [Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, Int.reduceNeg, + Matrix.cons_val, r, s] at e1 e2 + rw [e0, e1, e2] + calc + _ = (1 - (⟨0, 1⟩ : GaussianInt)) * + (BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 1) (q 3) + + BandVectors.1 (q 2) (q 1)) := by ring + _ = 0 := by rw [laws.1]; simp + + +/-- The three vectors pointing from the child to its parents sum to zero. -/ +theorem BandVectorOutgoingSum (q : Fin 4 → CircleCoordinates) (hq : ProperBandQuadruple q) : + BandVectors.1 (q 0) (q 1) + BandVectors.1 (q 0) (q 2) + + BandVectors.1 (q 0) (q 3) = 0 := by + classical + have flip := (VectorRecursionLaws q hq.1).2.2.2.2 hq + have turn (j : Fin 3) : GaussianQuarterTurn (BandVectors.1 (q j.succ) (q 0)) = + BandVectors.1 (q 0) (q j.succ) := by + rw [(flip j).1] + rcases BandVectors.1 (q j.succ) (q 0) with ⟨a, b⟩ + ext <;> simp [GaussianQuarterTurn, Zsqrtd.re_mul, Zsqrtd.im_mul] + have turn0 : GaussianQuarterTurn (BandVectors.1 (q 1) (q 0)) = + BandVectors.1 (q 0) (q 1) := turn 0 + have turn1 : GaussianQuarterTurn (BandVectors.1 (q 2) (q 0)) = + BandVectors.1 (q 0) (q 2) := turn 1 + have turn2 : GaussianQuarterTurn (BandVectors.1 (q 3) (q 0)) = + BandVectors.1 (q 0) (q 3) := turn 2 + have incoming_relation := BandVectorIncomingSum q hq + rw [← turn0, ← turn1, ← turn2] + calc + _ = GaussianQuarterTurn (BandVectors.1 (q 1) (q 0) + + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0)) := by + rcases BandVectors.1 (q 1) (q 0) with ⟨a0, b0⟩ + rcases BandVectors.1 (q 2) (q 0) with ⟨a1, b1⟩ + rcases BandVectors.1 (q 3) (q 0) with ⟨a2, b2⟩ + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn]; ring + _ = GaussianQuarterTurn 0 := congrArg GaussianQuarterTurn incoming_relation + _ = 0 := by rfl + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryFrameRowGeometry.lean b/LeanPool/ApollonianSuperharmonic/BoundaryFrameRowGeometry.lean new file mode 100644 index 0000000000..b4df81b926 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BoundaryFrameRowGeometry.lean @@ -0,0 +1,107 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Ring +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum + +/-! +# Shared boundary-frame row geometry + +Adapted from Wesley Pegden's Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace BoundaryFrameRowGeometry + +/-- The parent presentation selected by a boundary frame is proper. -/ +theorem presentationProper : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + ProperBandQuadruple r ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r + have rot : ∀ i : Fin 3, + ProperBandQuadruple + ![F.q 0, F.q i.succ, F.q ((i + 1).succ), F.q ((i + 2).succ)] := by + intro i + fin_cases i + · convert F.proper using 1; funext j; fin_cases j <;> rfl + · refine ⟨SemiProperQuadruple.rotate F.proper.1, ?_⟩ + intro j + fin_cases j + · simpa using F.proper.2 1 + · simpa using F.proper.2 2 + · simpa using F.proper.2 0 + · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate F.proper.1), ?_⟩ + intro j + fin_cases j + · simpa using F.proper.2 2 + · simpa using F.proper.2 0 + · simpa using F.proper.2 1 + simpa [r] using rot F.slot + +/-- The shared frame-centroid identities determine the tile displacement. -/ +theorem centroidDifference : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let I : GaussianInt := ⟨0, 1⟩ + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • + (GaussianRealPoint w - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) → + ((TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → (((↑(-w + I * w - + BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin + (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).re : ℝ) = (↑((2 : GaussianInt) * y).re : ℝ)) → + (((↑(-w + I * w - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im : ℝ) = (↑((2 : + GaussianInt) * y).im : ℝ)) → (TileCentroid (D.tiles F.slot false) - TileCentroid + Rminus = GaussianRealPoint y)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r I w y hUcenter hMcenter hcenterRe + hcenterIm + rw [show TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile) - + (TileCentroid Rminus - TileCentroid F.tile) by + ext <;> dsimp <;> ring] + rw [hUcenter, hMcenter] + apply Prod.ext + · simp [GaussianRealPoint, w, y, Prod.smul_mk] + norm_num at hcenterRe ⊢ + linarith + · simp [GaussianRealPoint, w, y, Prod.smul_mk] + norm_num at hcenterIm ⊢ + linarith + +end BoundaryFrameRowGeometry + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ExposedCornerAffineBasis.lean b/LeanPool/ApollonianSuperharmonic/ExposedCornerAffineBasis.lean new file mode 100644 index 0000000000..672e8ba37a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ExposedCornerAffineBasis.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Init +public import Mathlib.LinearAlgebra.AffineSpace.FiniteDimensional +public import Mathlib.Analysis.Normed.Affine.AddTorsorBases +public import LeanPool.ApollonianSuperharmonic.P3650T1ExposedCorner + +/-! +# Affine basis at an exposed polygon corner + +Adapted from Wesley Pegden's Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- The three vertices at an exposed corner form the height-coordinate affine basis. -/ +theorem ExposedCornerAffineBasis : + (by + classical + exact + ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∃ A : + AffineBasis (Fin 3) Real (Real × Real), (∀ i, A i = ![p.vertex (E.b - 1), p.vertex + E.b, p.vertex (E.b + 1)] i) ∧ E.height = A.coord 1 ) := by + classical + intro n p E + let a := p.vertex (E.b - 1) + let b := p.vertex E.b + let c := p.vertex (E.b + 1) + let v : Fin 3 → Real × Real := ![a, b, c] + have hdet : (b.1 - a.1) * (c.2 - a.2) - + (c.1 - a.1) * (b.2 - a.2) ≠ 0 := by + simpa [P3381T1TriangleDeterminant, a, b, c] using E.nondegenerate + have hind : AffineIndependent Real v := by + apply (affineIndependent_iff_of_fintype Real v).mpr + intro z hz hsum i + rw [Finset.weightedVSub_eq_linear_combination Finset.univ hz] at hsum + have hz' : z 0 + z 1 + z 2 = 0 := by + simpa [Fin.sum_univ_succ, ← add_assoc] using hz + have hx : z 0 * a.1 + z 1 * b.1 + z 2 * c.1 = 0 := by + simpa [Fin.sum_univ_succ, v, ← add_assoc] using congrArg Prod.fst hsum + have hy : z 0 * a.2 + z 1 * b.2 + z 2 * c.2 = 0 := by + simpa [Fin.sum_univ_succ, v, ← add_assoc] using congrArg Prod.snd hsum + have hx' : z 1 * (b.1 - a.1) + z 2 * (c.1 - a.1) = 0 := by + linear_combination hx - a.1 * hz' + have hy' : z 1 * (b.2 - a.2) + z 2 * (c.2 - a.2) = 0 := by + linear_combination hy - a.2 * hz' + have hz1 : z 1 = 0 := by + apply (mul_eq_zero.mp (show z 1 * ((b.1 - a.1) * (c.2 - a.2) - + (c.1 - a.1) * (b.2 - a.2)) = 0 by + linear_combination (c.2 - a.2) * hx' - (c.1 - a.1) * hy')).resolve_right hdet + have hz2 : z 2 = 0 := by + apply (mul_eq_zero.mp (show z 2 * ((b.1 - a.1) * (c.2 - a.2) - + (c.1 - a.1) * (b.2 - a.2)) = 0 by + linear_combination (b.1 - a.1) * hy' - (b.2 - a.2) * hx')).resolve_right hdet + fin_cases i <;> simp_all + have hspan : affineSpan Real (Set.range v) = ⊤ := by + apply hind.affineSpan_eq_top_iff_card_eq_finrank_add_one.mpr + simp [Module.finrank_prod] + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ + refine ⟨A, fun _ => rfl, ?_⟩ + apply AffineMap.ext_on A.tot + rintro x ⟨i, rfl⟩ + fin_cases i <;> simp only [AffineBasis.coord_apply] + · exact E.height_prev + · exact E.height_top + · exact E.height_next + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/Imports.lean b/LeanPool/ApollonianSuperharmonic/Imports.lean index 61eb4a9e43..5e5dc4cddf 100644 --- a/LeanPool/ApollonianSuperharmonic/Imports.lean +++ b/LeanPool/ApollonianSuperharmonic/Imports.lean @@ -160,10 +160,12 @@ public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoreCertificate public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoverage public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedPeriodicCore public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy +public import LeanPool.ApollonianSuperharmonic.BandVectorParentSums public import LeanPool.ApollonianSuperharmonic.BandVectors public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertexDegreeTwo public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.BoundaryFrameRowGeometry public import LeanPool.ApollonianSuperharmonic.BoundaryJoinChamberCertificate public import LeanPool.ApollonianSuperharmonic.BoundaryString public import LeanPool.ApollonianSuperharmonic.BoundaryStringConcatenation @@ -227,6 +229,7 @@ public import LeanPool.ApollonianSuperharmonic.ExactTileTiling public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments public import LeanPool.ApollonianSuperharmonic.ExceptionalModifiedABPath public import LeanPool.ApollonianSuperharmonic.ExceptionalRestorationSectorData +public import LeanPool.ApollonianSuperharmonic.ExposedCornerAffineBasis public import LeanPool.ApollonianSuperharmonic.FiniteAcyclicGraphCardConnected public import LeanPool.ApollonianSuperharmonic.FiniteAcyclicOrientationObstruction public import LeanPool.ApollonianSuperharmonic.FiniteBiconnectedHorizontalRunTree @@ -309,6 +312,7 @@ public import LeanPool.ApollonianSuperharmonic.IntegralityTiling public import LeanPool.ApollonianSuperharmonic.IsolatedPrecursorCoverage public import LeanPool.ApollonianSuperharmonic.LambdaTiling public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentInterfacePath +public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts public import LeanPool.ApollonianSuperharmonic.LatticeCell public import LeanPool.ApollonianSuperharmonic.LatticeDiskUnionIntersectionConnected public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity diff --git a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentPackingSymmetryFacts.lean b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentPackingSymmetryFacts.lean new file mode 100644 index 0000000000..e965159b02 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentPackingSymmetryFacts.lean @@ -0,0 +1,206 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.TileOdometerDomain + +/-! +# Shared packing-symmetry transport facts + +Adapted from Wesley Pegden's Apache-2.0 Trellis formalization of Levine–Pegden–Smart. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +namespace LatticeAdjacentPackingSymmetryFacts + +/-- A tile odometer with a defined slope has a nonempty tile. -/ +theorem tileCellsNonempty (c : CircleCoordinates) (T : ProtoTile) + (h : PartialOdometer) (p : ℝ × ℝ) (hO : TileOdometer c T h) + (hp : PartialOdometerSlope h = some p) : T.cells.Nonempty := by + classical + have hd := TileOdometerDomain c T h hO + by_contra hn + have hde : (h.domain : Set GaussianInt) = {T.anchor} := by + rw [hd] + simp [FootprintVertices, hn] + have hs : (PartialOdometerSquares h).Nonempty := by + by_contra hs + simp [PartialOdometerSlope, hs] at hp + rcases hs with ⟨x, hx⟩ + simp only [PartialOdometerSquares, Finset.mem_filter] at hx + have hz : x + 1 = T.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.2.1 + have hz0 : x = T.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.1 + have hzbad : x + 1 = x := hz.trans hz0.symm + have hzbad' := congrArg (fun z : GaussianInt => z.re) hzbad + norm_num at hzbad' + + +/-- The slope action preserves a specified slope on a nonempty tile. -/ +theorem slopeAction : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (p : ℝ × ℝ), + (PartialOdometerSlope h = some p) → ((T.cells.Nonempty) → ((Finset.Nonempty T.cells → + PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = Option.map + (BandPackingSymmetrySlopeAction g T) (PartialOdometerSlope h)) → + (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = some + (BandPackingSymmetrySlopeAction g T p)))) ) := by + classical + intro g T h p hp hTne hST + simpa [Option.map] using (hST hTne).trans (congrArg (Option.map + (BandPackingSymmetrySlopeAction g T)) hp) + +/-- Packing symmetry transports a centroid difference. -/ +theorem centroidTransport : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (v : GaussianInt), + TileCentroid V - TileCentroid U = GaussianRealPoint v → TileCentroid + (BandPackingSymmetryTileAction a V) - TileCentroid (BandPackingSymmetryTileAction a + U) = GaussianRealPoint (BandPackingSymmetryVectorAction a v) ) := by + classical + intro a U V v hv + have hc := (P5625T1CentroidSlopeDifferenceCovariance.2 + a U V (0, 0) (0, 0) v 0 1 + (by simpa using hv) (by ext <;> simp [GaussianRealPoint])).1 + simpa only [one_smul, P5625T1CentroidSlopeDifferenceCovariance.1] using hc + +/-- Scoped phase determines the transported parent vector. -/ +theorem vectorSign : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), + (BandPackingSymmetryScopedPhase g q negative) → (∀ (j : Fin 3), GaussianRealPoint + (BandPackingSymmetryVectorAction g (BandVectors.1 (q j.succ) (q 0))) = (if negative + then (-1 : ℝ) else 1) • GaussianRealPoint (BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g + then -j else j).succ) (BandPackingSymmetryQuadrupleAction g q 0))) ) := by + classical + intro g q negative hphase j + have hp := hphase j + dsimp [BandPackingSymmetryScopedPhase] at hp + have hv := hp.1 + by_cases hn : negative + · have hh := congrArg Neg.neg (congrArg GaussianRealPoint hv) + simpa [hn, GaussianRealPoint] using hh.symm + · have hh := (congrArg GaussianRealPoint hv).symm + simpa [hn, GaussianRealPoint] using hh + +/-- The vector action commutes with negation. -/ +theorem vectorNegation : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (v : GaussianInt), BandPackingSymmetryVectorAction a (-v) + = -BandPackingSymmetryVectorAction a v ) := by + classical + intro a + induction a with + | identity => intro v; rfl + | negate => + intro v + rcases v with ⟨a, b⟩ + rfl + | conjugate => + intro v + rcases v with ⟨a, b⟩ + rfl + | shift w => intro v; rfl + | comp a b iha ihb => + intro v + change BandPackingSymmetryVectorAction a + (BandPackingSymmetryVectorAction b (-v)) = + -BandPackingSymmetryVectorAction a + (BandPackingSymmetryVectorAction b v) + rw [ihb, iha] + +/-- The affine vector action commutes with simultaneous negation. -/ +theorem affineNegation : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (v : GaussianInt), ∀ (u : GaussianInt), + BandPackingSymmetryAffineVectorAction a (-v, -u) = + -BandPackingSymmetryAffineVectorAction a (v, u) ) := by + classical + intro a + induction a with + | identity => intro v u; rfl + | shift w => + intro v u + rcases v with ⟨va, vb⟩ + rcases u with ⟨ua, ub⟩ + rcases w with ⟨wa, wb⟩ + apply Prod.ext + · simp [BandPackingSymmetryAffineVectorAction, GaussianReflection] + · simp only [BandPackingSymmetryAffineVectorAction, Int.reduceNeg, GaussianReflection, + Zsqrtd.re_neg, Zsqrtd.im_neg, neg_neg, Prod.neg_mk, neg_add_rev] + have hrel : ({re := -va, im := vb} : GaussianInt) = + -({re := va, im := -vb} : GaussianInt) := by + ext <;> simp + rw [hrel] + ring + | negate => + intro v u + rcases v with ⟨va, vb⟩ + rcases u with ⟨ua, ub⟩ + rfl + | conjugate => + intro v u + rcases v with ⟨va, vb⟩ + rcases u with ⟨ua, ub⟩ + rfl + | comp a b iha ihb => + intro v u + change BandPackingSymmetryAffineVectorAction a + (BandPackingSymmetryAffineVectorAction b (-v, -u)) = _ + rw [ihb] + apply iha + +/-- Packing symmetry transports a slope difference. -/ +theorem slopeTransport : + (by + classical + exact + ∀ (a : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : ℝ × ℝ), ∀ (y : + ℝ × ℝ), ∀ (v : GaussianInt), ∀ (u : GaussianInt), TileCentroid V - TileCentroid U = + GaussianRealPoint v → x.1 - y.1 = (u.re : ℝ) → x.2 - y.2 = (u.im : ℝ) → + (BandPackingSymmetrySlopeAction a V x).1 - (BandPackingSymmetrySlopeAction a U y).1 = + (BandPackingSymmetryAffineVectorAction a (v, u)).2.re ∧ + (BandPackingSymmetrySlopeAction a V x).2 - (BandPackingSymmetrySlopeAction a U y).2 = + (BandPackingSymmetryAffineVectorAction a (v, u)).2.im ) := by + classical + intro a U V x y v u hc hx hy + have hp : x - y = (1 : ℝ) • GaussianRealPoint u := by + apply Prod.ext + · simpa [GaussianRealPoint] using hx + · simpa [GaussianRealPoint] using hy + have hs := (P5625T1CentroidSlopeDifferenceCovariance.2 + a U V x y v u 1 (by simpa using hc) hp).2 + constructor + · simpa [GaussianRealPoint] using congrArg Prod.fst hs + · simpa [GaussianRealPoint] using congrArg Prod.snd hs + +end LatticeAdjacentPackingSymmetryFacts + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean index 86a3d055a7..0e4a841ab7 100644 --- a/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance @@ -25,228 +26,6 @@ namespace ApollonianSuperharmonic namespace LeftLatticeTransportGeometry -private theorem hTne : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (T : ProtoTile), ∀ (h : - PartialOdometer), ∀ (p : ℝ × ℝ), (TileOdometer (q (0 : Fin (4 : ℕ))) T h) → - ((PartialOdometerSlope h = some p) → (T.cells.Nonempty))) ) := by - classical - intro q hq T h p hO hp - have hd := PositiveCurvatureTileOdometerDomain (q 0) T h - (ProperBandCurvatureStructure q hq).1 hO - by_contra hn - have hde : (h.domain : Set GaussianInt) = {T.anchor} := by - rw [hd] - simp [FootprintVertices, hn] - have hs : (PartialOdometerSquares h).Nonempty := by - by_contra hs - simp [PartialOdometerSlope, hs] at hp - rcases hs with ⟨x, hx⟩ - simp only [PartialOdometerSquares, Finset.mem_filter] at hx - have hz : x + 1 = T.anchor := by - apply Set.mem_singleton_iff.mp - rw [← hde] - exact hx.2.1 - have hz0 : x = T.anchor := by - apply Set.mem_singleton_iff.mp - rw [← hde] - exact hx.1 - have hzbad : x + 1 = x := hz.trans hz0.symm - have hzbad' := congrArg (fun z : GaussianInt => z.re) hzbad - norm_num at hzbad' - -private theorem hT'ne : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (T' : ProtoTile), ∀ (h' : - PartialOdometer), ∀ (p' : ℝ × ℝ), (TileOdometer (q (0 : Fin (4 : ℕ))) T' h') → - ((PartialOdometerSlope h' = some p') → (T'.cells.Nonempty))) ) := by - classical - intro q hq T' h' p' hO' hp' - have hd := PositiveCurvatureTileOdometerDomain (q 0) T' h' - (ProperBandCurvatureStructure q hq).1 hO' - by_contra hn - have hde : (h'.domain : Set GaussianInt) = {T'.anchor} := by - rw [hd] - simp [FootprintVertices, hn] - have hs : (PartialOdometerSquares h').Nonempty := by - by_contra hs - simp [PartialOdometerSlope, hs] at hp' - rcases hs with ⟨x, hx⟩ - simp only [PartialOdometerSquares, Finset.mem_filter] at hx - have hz : x + 1 = T'.anchor := by - apply Set.mem_singleton_iff.mp - rw [← hde] - exact hx.2.1 - have hz0 : x = T'.anchor := by - apply Set.mem_singleton_iff.mp - rw [← hde] - exact hx.1 - have hzbad : x + 1 = x := hz.trans hz0.symm - have hzbad' := congrArg (fun z : GaussianInt => z.re) hzbad - norm_num at hzbad' - -private theorem hsr : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (p : ℝ × ℝ), - (PartialOdometerSlope h = some p) → ((T.cells.Nonempty) → ((Finset.Nonempty T.cells → - PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = Option.map - (BandPackingSymmetrySlopeAction g T) (PartialOdometerSlope h)) → - (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = some - (BandPackingSymmetrySlopeAction g T p)))) ) := by - classical - intro g T h p hp hTne hST - simpa [Option.map] using (hST hTne).trans (congrArg (Option.map - (BandPackingSymmetrySlopeAction g T)) hp) - -private theorem hsr' : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), ∀ (p' : ℝ × - ℝ), (PartialOdometerSlope h' = some p') → ((T'.cells.Nonempty) → ((Finset.Nonempty - T'.cells → PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h') = - Option.map (BandPackingSymmetrySlopeAction g T') (PartialOdometerSlope h')) → - (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h') = some - (BandPackingSymmetrySlopeAction g T' p')))) ) := by - classical - intro g T' h' p' hp' hT'ne hST' - simpa [Option.map] using (hST' hT'ne).trans (congrArg (Option.map - (BandPackingSymmetrySlopeAction g T')) hp') - -private theorem centroid_transport : - (by - classical - exact - ∀ (a : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (v : GaussianInt), - TileCentroid V - TileCentroid U = GaussianRealPoint v → TileCentroid - (BandPackingSymmetryTileAction a V) - TileCentroid (BandPackingSymmetryTileAction a - U) = GaussianRealPoint (BandPackingSymmetryVectorAction a v) ) := by - classical - intro a U V v hv - have hc := (P5625T1CentroidSlopeDifferenceCovariance.2 - a U V (0, 0) (0, 0) v 0 1 - (by simpa using hv) (by ext <;> simp [GaussianRealPoint])).1 - simpa only [one_smul, P5625T1CentroidSlopeDifferenceCovariance.1] using hc - -private theorem vector_sign : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), - (BandPackingSymmetryScopedPhase g q negative) → (∀ (j : Fin 3), GaussianRealPoint - (BandPackingSymmetryVectorAction g (BandVectors.1 (q j.succ) (q 0))) = (if negative - then (-1 : ℝ) else 1) • GaussianRealPoint (BandVectors.1 - (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g - then -j else j).succ) (BandPackingSymmetryQuadrupleAction g q 0))) ) := by - classical - intro g q negative hphase j - have hp := hphase j - dsimp [BandPackingSymmetryScopedPhase] at hp - have hv := hp.1 - by_cases hn : negative - · have hh := congrArg Neg.neg (congrArg GaussianRealPoint hv) - simpa [hn, GaussianRealPoint] using hh.symm - · have hh := (congrArg GaussianRealPoint hv).symm - simpa [hn, GaussianRealPoint] using hh - -private theorem vector_neg : - (by - classical - exact - ∀ (a : BandPackingSymmetry), ∀ (v : GaussianInt), BandPackingSymmetryVectorAction a (-v) - = -BandPackingSymmetryVectorAction a v ) := by - classical - intro a - induction a with - | identity => intro v; rfl - | negate => - intro v - rcases v with ⟨a, b⟩ - rfl - | conjugate => - intro v - rcases v with ⟨a, b⟩ - rfl - | shift w => intro v; rfl - | comp a b iha ihb => - intro v - change BandPackingSymmetryVectorAction a - (BandPackingSymmetryVectorAction b (-v)) = - -BandPackingSymmetryVectorAction a - (BandPackingSymmetryVectorAction b v) - rw [ihb, iha] - -private theorem affine_neg : - (by - classical - exact - ∀ (a : BandPackingSymmetry), ∀ (v : GaussianInt), ∀ (u : GaussianInt), - BandPackingSymmetryAffineVectorAction a (-v, -u) = - -BandPackingSymmetryAffineVectorAction a (v, u) ) := by - classical - intro a - induction a with - | identity => intro v u; rfl - | shift w => - intro v u - rcases v with ⟨va, vb⟩ - rcases u with ⟨ua, ub⟩ - rcases w with ⟨wa, wb⟩ - apply Prod.ext - · simp [BandPackingSymmetryAffineVectorAction, GaussianReflection] - · simp only [BandPackingSymmetryAffineVectorAction, Int.reduceNeg, GaussianReflection, - Zsqrtd.re_neg, Zsqrtd.im_neg, neg_neg, Prod.neg_mk, neg_add_rev] - have hrel : ({re := -va, im := vb} : GaussianInt) = - -({re := va, im := -vb} : GaussianInt) := by - ext <;> simp - rw [hrel] - ring - | negate => - intro v u - rcases v with ⟨va, vb⟩ - rcases u with ⟨ua, ub⟩ - rfl - | conjugate => - intro v u - rcases v with ⟨va, vb⟩ - rcases u with ⟨ua, ub⟩ - rfl - | comp a b iha ihb => - intro v u - change BandPackingSymmetryAffineVectorAction a - (BandPackingSymmetryAffineVectorAction b (-v, -u)) = _ - rw [ihb] - apply iha - -private theorem slope_transport : - (by - classical - exact - ∀ (a : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : ℝ × ℝ), ∀ (y : - ℝ × ℝ), ∀ (v : GaussianInt), ∀ (u : GaussianInt), TileCentroid V - TileCentroid U = - GaussianRealPoint v → x.1 - y.1 = (u.re : ℝ) → x.2 - y.2 = (u.im : ℝ) → - (BandPackingSymmetrySlopeAction a V x).1 - (BandPackingSymmetrySlopeAction a U y).1 = - (BandPackingSymmetryAffineVectorAction a (v, u)).2.re ∧ - (BandPackingSymmetrySlopeAction a V x).2 - (BandPackingSymmetrySlopeAction a U y).2 = - (BandPackingSymmetryAffineVectorAction a (v, u)).2.im ) := by - classical - intro a U V x y v u hc hx hy - have hp : x - y = (1 : ℝ) • GaussianRealPoint u := by - apply Prod.ext - · simpa [GaussianRealPoint] using hx - · simpa [GaussianRealPoint] using hy - have hs := (P5625T1CentroidSlopeDifferenceCovariance.2 - a U V x y v u 1 (by simpa using hc) hp).2 - constructor - · simpa [GaussianRealPoint] using congrArg Prod.fst hs - · simpa [GaussianRealPoint] using congrArg Prod.snd hs - private theorem hcAt337 : (by classical @@ -273,32 +52,6 @@ private theorem hcAt345 : intro q i e T T' hcent he simpa [he, GaussianRealPoint] using hcent -private theorem hcAt356 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' - : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 - : ℝ)) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) → ((e = - true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 (q - i.succ) (q 0)))) ) := by - classical - intro q i e T T' hcent he - simpa [he] using hcent - -private theorem hcAt377 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' - : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 - : ℝ)) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) → ((¬e = - true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (-(BandVectors.1 (q - i.succ) (q 0))))) ) := by - classical - intro q i e T T' hcent he - simpa [he, GaussianRealPoint] using hcent - private theorem hscoordAt393 : (by classical @@ -318,51 +71,6 @@ private theorem hscoordAt393 : intro g q i T T' p p' hs simpa using hs.1 -private theorem hscoordAt405 : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T : - ProtoTile), ∀ (T' : ProtoTile), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), - ((BandPackingSymmetrySlopeAction g T' p').1 - (BandPackingSymmetrySlopeAction g T - p).1 = (↑(-BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : - Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.re : ℝ) ∧ - (BandPackingSymmetrySlopeAction g T' p').2 - (BandPackingSymmetrySlopeAction g T p).2 - = (↑(-BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin - (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.im : ℝ)) → - ((BandPackingSymmetrySlopeAction g T' p').1 - (BandPackingSymmetrySlopeAction g T - p).1 = -((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q 0), - BandVectors.2 (q i.succ) (q 0))).2.re : ℝ)) ) := by - classical - intro g q i T T' p p' hs - simpa using hs.1 - -private theorem hcAt414 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' - : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 - : ℝ)) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) → ((e = - true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 (q - i.succ) (q 0)))) ) := by - classical - intro q i e T T' hcent he - simpa [he] using hcent - -private theorem hcAt435 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' - : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 - : ℝ)) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) → ((¬e = - true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (-(BandVectors.1 (q - i.succ) (q 0))))) ) := by - classical - intro q i e T T' hcent he - simpa [he, GaussianRealPoint] using hcent - private theorem hscoordAt451 : (by classical @@ -382,25 +90,6 @@ private theorem hscoordAt451 : intro g q i T T' p p' hs simpa using hs.2 -private theorem hscoordAt463 : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T : - ProtoTile), ∀ (T' : ProtoTile), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), - ((BandPackingSymmetrySlopeAction g T' p').1 - (BandPackingSymmetrySlopeAction g T - p).1 = (↑(-BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : - Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.re : ℝ) ∧ - (BandPackingSymmetrySlopeAction g T' p').2 - (BandPackingSymmetrySlopeAction g T p).2 - = (↑(-BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin - (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2.im : ℝ)) → - ((BandPackingSymmetrySlopeAction g T' p').2 - (BandPackingSymmetrySlopeAction g T - p).2 = -((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q 0), - BandVectors.2 (q i.succ) (q 0))).2.im : ℝ)) ) := by - classical - intro g q i T T' p p' hs - simpa using hs.2 - end LeftLatticeTransportGeometry theorem LeftLatticeAdjacentPackingSymmetryTransport @@ -452,19 +141,19 @@ theorem LeftLatticeAdjacentPackingSymmetryTransport dsimp obtain ⟨negative, hphase, hvec⟩ := BandPackingSymmetryAffineVectorCovariance g q hq - have hTne := LeftLatticeTransportGeometry.hTne q hq T h p hO hp - have hT'ne := LeftLatticeTransportGeometry.hT'ne q hq T' h' p' hO' hp' + have hTne := LatticeAdjacentPackingSymmetryFacts.tileCellsNonempty (q 0) T h p hO hp + have hT'ne := LatticeAdjacentPackingSymmetryFacts.tileCellsNonempty (q 0) T' h' p' hO' hp' obtain ⟨hOT, _, hST⟩ := BandPackingSymmetryTileOdometerCovariance g (q 0) T h hO obtain ⟨hOT', _, hST'⟩ := BandPackingSymmetryTileOdometerCovariance g (q 0) T' h' hO' - have hsr := LeftLatticeTransportGeometry.hsr g T h p hp hTne hST - have hsr' := LeftLatticeTransportGeometry.hsr' g T' h' p' hp' hT'ne hST' + have hsr := LatticeAdjacentPackingSymmetryFacts.slopeAction g T h p hp hTne hST + have hsr' := LatticeAdjacentPackingSymmetryFacts.slopeAction g T' h' p' hp' hT'ne hST' have centroid_transport : ∀ (a : BandPackingSymmetry) (U V : ProtoTile) (v : GaussianInt), TileCentroid V - TileCentroid U = GaussianRealPoint v → TileCentroid (BandPackingSymmetryTileAction a V) - TileCentroid (BandPackingSymmetryTileAction a U) = GaussianRealPoint (BandPackingSymmetryVectorAction a v) := - LeftLatticeTransportGeometry.centroid_transport + LatticeAdjacentPackingSymmetryFacts.centroidTransport have vector_sign (j : Fin 3) : GaussianRealPoint (BandPackingSymmetryVectorAction g (BandVectors.1 (q j.succ) (q 0))) = @@ -474,20 +163,21 @@ theorem LeftLatticeAdjacentPackingSymmetryTransport (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g then -j else j).succ) (BandPackingSymmetryQuadrupleAction g q 0)) := - LeftLatticeTransportGeometry.vector_sign g q negative hphase j + LatticeAdjacentPackingSymmetryFacts.vectorSign g q negative hphase j have vector_neg : ∀ (a : BandPackingSymmetry) (v : GaussianInt), BandPackingSymmetryVectorAction a (-v) = - -BandPackingSymmetryVectorAction a v := LeftLatticeTransportGeometry.vector_neg + -BandPackingSymmetryVectorAction a v := LatticeAdjacentPackingSymmetryFacts.vectorNegation have affine_neg : ∀ (a : BandPackingSymmetry) (v u : GaussianInt), BandPackingSymmetryAffineVectorAction a (-v, -u) = - -BandPackingSymmetryAffineVectorAction a (v, u) := LeftLatticeTransportGeometry.affine_neg + -BandPackingSymmetryAffineVectorAction a (v, u) := + LatticeAdjacentPackingSymmetryFacts.affineNegation have real_coord (z : GaussianInt) : (GaussianInt.toComplex z).re = (z.re : ℝ) := (GaussianInt.intCast_re z).symm have imag_coord (z : GaussianInt) : (GaussianInt.toComplex z).im = (z.im : ℝ) := (GaussianInt.intCast_im z).symm - have slope_transport := LeftLatticeTransportGeometry.slope_transport + have slope_transport := LatticeAdjacentPackingSymmetryFacts.slopeTransport refine ⟨negative, BandPackingSymmetrySlopeAction g T p, BandPackingSymmetrySlopeAction g T' p', ?_⟩ refine ⟨hphase, ?_, ?_, hsr, hsr', ?_, ?_, ?_, ?_⟩ @@ -515,7 +205,7 @@ theorem LeftLatticeAdjacentPackingSymmetryTransport · by_cases he : e = true · have hc : TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) := - LeftLatticeTransportGeometry.hcAt356 q i e T T' hcent he + LeftLatticeTransportGeometry.hcAt337 q i e T T' hcent he have hs := slope_transport g T T' p' p (BandVectors.1 (q i.succ) (q 0)) (BandVectors.2 (q i.succ) (q 0)) hc @@ -539,7 +229,7 @@ theorem LeftLatticeAdjacentPackingSymmetryTransport linarith [hs.1, hcoord] · have hc : TileCentroid T' - TileCentroid T = GaussianRealPoint (-(BandVectors.1 (q i.succ) (q 0))) := - LeftLatticeTransportGeometry.hcAt377 q i e T T' hcent he + LeftLatticeTransportGeometry.hcAt345 q i e T T' hcent he have hs := slope_transport g T T' p' p (-(BandVectors.1 (q i.succ) (q 0))) (-(BandVectors.2 (q i.succ) (q 0))) hc @@ -574,12 +264,12 @@ theorem LeftLatticeAdjacentPackingSymmetryTransport -((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q 0), BandVectors.2 (q i.succ) (q 0))).2.re : ℝ) := - LeftLatticeTransportGeometry.hscoordAt405 g q i T T' p p' hs + LeftLatticeTransportGeometry.hscoordAt393 g q i T T' p p' hs linarith [hscoord, hcoord] · by_cases he : e = true · have hc : TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) := - LeftLatticeTransportGeometry.hcAt414 q i e T T' hcent he + LeftLatticeTransportGeometry.hcAt337 q i e T T' hcent he have hs := slope_transport g T T' p' p (BandVectors.1 (q i.succ) (q 0)) (BandVectors.2 (q i.succ) (q 0)) hc @@ -603,7 +293,7 @@ theorem LeftLatticeAdjacentPackingSymmetryTransport linarith [hs.2, hcoord] · have hc : TileCentroid T' - TileCentroid T = GaussianRealPoint (-(BandVectors.1 (q i.succ) (q 0))) := - LeftLatticeTransportGeometry.hcAt435 q i e T T' hcent he + LeftLatticeTransportGeometry.hcAt345 q i e T T' hcent he have hs := slope_transport g T T' p' p (-(BandVectors.1 (q i.succ) (q 0))) (-(BandVectors.2 (q i.succ) (q 0))) hc @@ -638,7 +328,7 @@ theorem LeftLatticeAdjacentPackingSymmetryTransport -((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q 0), BandVectors.2 (q i.succ) (q 0))).2.im : ℝ) := - LeftLatticeTransportGeometry.hscoordAt463 g q i T T' p p' hs + LeftLatticeTransportGeometry.hscoordAt451 g q i T T' p p' hs linarith [hscoord, hcoord] · exact (BandPackingSymmetryPartialOdometerActionFormulas g h h').2.2.2.2.2.2.1 diff --git a/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean index d87d7a67a5..44b38d1295 100644 --- a/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean @@ -2631,22 +2631,6 @@ private theorem hnewAdjAt1521 : t', BandPackingSymmetryProperCovariance ginv r hr, hselectedCoord, hfixedCoord, hcentOriginal, hslopeReInv, hslopeImInv⟩ -private theorem hpointInvAt1538 : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : - PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : - BandPackingSymmetry), (∀ (v : GaussianInt), BandPackingSymmetryVectorAction ginv - (BandPackingSymmetryVectorAction bundle.symmetry v) = v) → - ((BandPackingSymmetryVectorAction bundle.symmetry x = bundle.normalizedPoint) → - (BandPackingSymmetryVectorAction ginv bundle.normalizedPoint = x)) ) := by - classical - intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv hvecL hpoint - rw [← hpoint] - exact hvecL x - private theorem hmarkedOriginalAt1545 : (by classical @@ -3383,7 +3367,7 @@ private theorem reverseAdjacencyCase : ((⟨0, 1⟩ : GaussianInt) ^ t.val * (if Even t.val then BandVectors.1 (r 0) (r j.succ) else BandVectors.1 (r j.succ) (r 0))) - have hpointInv := MarkedAdjacencyGeometry.hpointInvAt1538 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv + have hpointInv := MarkedAdjacencyGeometry.hpointInvAt1389 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv hvecL hpoint have hmarkCov := (markedData.2.2 ginv r hr j t delta hphaseInv diff --git a/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean b/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean index 0f21583f26..a42d7f7f65 100644 --- a/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean @@ -384,40 +384,6 @@ private theorem firstAt463 : (hT2 0 X hX) (hT2 i.succ Y hY) (fun A B hA hB hz => hT4 A B i hA hB hz) hcent -private theorem firstAt482 : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (∀ (a : Fin (4 : ℕ)), ∀ (T : ProtoTile), - BandPrototile (q a) T → QuarterTurnSymmetric T) → ((∀ (T₀ : ProtoTile), ∀ (Tᵢ : - ProtoTile), ∀ (i : Fin (3 : ℕ)), BandPrototile (q (0 : Fin (4 : ℕ))) T₀ → - BandPrototile (q i.succ) Tᵢ → TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • - (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple - T₀ (TileTranslation T₀ (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) Tᵢ) → ((∀ (C - : CircleCoordinates), ∀ (D : CircleCoordinates), ∀ (T : ProtoTile), ∀ (U : - ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), BandPrototile C T → - BandPrototile D U → QuarterTurnSymmetric T → QuarterTurnSymmetric U → (∀ (X : - ProtoTile), ∀ (Y : ProtoTile), BandPrototile C X → BandPrototile D Y → TileCentroid Y - - TileCentroid X = (1 / 2 : Real) • (GaussianRealPoint x + GaussianRealPoint y) → - TouchingTriple X (TileTranslation X x) Y) → (TileCentroid U - TileCentroid T = (1 / 2 - : Real) • (GaussianRealPoint (GaussianQuarterTurn x) + GaussianRealPoint - (GaussianQuarterTurn y))) → TouchingTriple T (TileTranslation T (GaussianQuarterTurn - x)) U) → (∀ (i : Fin (3 : ℕ)), ∀ (X : ProtoTile), ∀ (Y : ProtoTile), BandPrototile (q - 0) X → BandPrototile (q i.succ) Y → TileCentroid Y - TileCentroid X = (1 / 2 : Real) - • (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0))) + - GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ)))) → - TouchingTriple X (TileTranslation X (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q - 0)))) Y))) - ) := by - classical - intro q hT2 hT4 turn4 i X Y hX hY hcent - exact turn4 (q 0) (q i.succ) X Y - (BandVectors.1 (q i.succ) (q 0)) - (BandVectors.1 (q 0) (q i.succ)) hX hY - (hT2 0 X hX) (hT2 i.succ Y hY) - (fun A B hA hB hz => hT4 A B i hA hB hz) hcent - private theorem base : (by classical @@ -461,50 +427,6 @@ private theorem base : hX hY hZ (hT2 0 X hX) (hT2 i.succ Y hY) (hT2 (i + 1).succ Z hZ) (fun A B C hA hB hC ha' hb' => hT5 A B C i hA hB hC ha' hb') ha hb -private theorem firstAt532 : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (∀ (a : Fin (4 : ℕ)), ∀ (T : ProtoTile), - BandPrototile (q a) T → QuarterTurnSymmetric T) → ((∀ (T₀ : ProtoTile), ∀ (Tᵢ : - ProtoTile), ∀ (Tⱼ : ProtoTile), ∀ (i : Fin (3 : ℕ)), BandPrototile (q (0 : Fin (4 : - ℕ))) T₀ → BandPrototile (q i.succ) Tᵢ → BandPrototile (q (i + (1 : Fin (3 : - ℕ))).succ) Tⱼ → TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • (GaussianRealPoint - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 - (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid Tⱼ - TileCentroid T₀ = (1 / 2 : ℝ) - • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : - ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + (1 : Fin (3 : - ℕ))).succ))) → TouchingTriple T₀ Tᵢ Tⱼ) → ((∀ (C : CircleCoordinates), ∀ (D : - CircleCoordinates), ∀ (E : CircleCoordinates), ∀ (T : ProtoTile), ∀ (U : ProtoTile), - ∀ (V : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), ∀ - (w : GaussianInt), BandPrototile C T → BandPrototile D U → BandPrototile E V → - QuarterTurnSymmetric T → QuarterTurnSymmetric U → QuarterTurnSymmetric V → (∀ (X : - ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), BandPrototile C X → BandPrototile D - Y → BandPrototile E Z → TileCentroid Y - TileCentroid X = (1 / 2 : Real) • - (GaussianRealPoint x + GaussianRealPoint y) → TileCentroid Z - TileCentroid X = (1 / - 2 : Real) • (GaussianRealPoint z - GaussianRealPoint w) → TouchingTriple X Y Z) → - TileCentroid U - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint - (GaussianQuarterTurn x) + GaussianRealPoint (GaussianQuarterTurn y)) → TileCentroid V - - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint (GaussianQuarterTurn z) - - GaussianRealPoint (GaussianQuarterTurn w)) → TouchingTriple T U V) → (∀ (i : Fin (3 : - ℕ)), ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), BandPrototile (q 0) X → - BandPrototile (q i.succ) Y → BandPrototile (q ((i + 1).succ)) Z → TileCentroid Y - - TileCentroid X = (1 / 2 : Real) • (GaussianRealPoint (GaussianQuarterTurn - (BandVectors.1 (q i.succ) (q 0))) + GaussianRealPoint (GaussianQuarterTurn - (BandVectors.1 (q 0) (q i.succ)))) → TileCentroid Z - TileCentroid X = (1 / 2 : Real) - • (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q ((i + 1).succ)) (q 0))) - - GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q ((i + 1).succ))))) → - TouchingTriple X Y Z))) - ) := by - classical - intro q hT2 hT5 turn5 i X Y Z hX hY hZ ha hb - exact turn5 (q 0) (q i.succ) (q ((i + 1).succ)) X Y Z - (BandVectors.1 (q i.succ) (q 0)) (BandVectors.1 (q 0) (q i.succ)) - (BandVectors.1 (q ((i + 1).succ)) (q 0)) - (BandVectors.1 (q 0) (q ((i + 1).succ))) hX hY hZ - (hT2 0 X hX) (hT2 i.succ Y hY) (hT2 (i + 1).succ Z hZ) - (fun A B C hA hB hC ha' hb' => hT5 A B C i hA hB hC ha' hb') ha hb - private theorem base3 : (by classical @@ -747,7 +669,7 @@ theorem OrientedTouchingCovariance : GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ)))) → TouchingTriple X (TileTranslation X (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)))) Y := - TouchingCovarianceProof.firstAt482 q hT2 hT4 turn4 i + TouchingCovarianceProof.firstAt463 q hT2 hT4 turn4 i exact turn4 (q 0) (q i.succ) T₀ Tᵢ (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)))) (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ)))) h₀ hᵢ @@ -786,7 +708,7 @@ theorem OrientedTouchingCovariance : TileCentroid Z - TileCentroid X = (1 / 2 : Real) • (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q ((i + 1).succ)) (q 0))) - GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q ((i + 1).succ))))) → - TouchingTriple X Y Z := TouchingCovarianceProof.firstAt532 q hT2 hT5 turn5 i + TouchingTriple X Y Z := TouchingCovarianceProof.base q hT2 hT5 turn5 i exact turn5 (q 0) (q i.succ) (q ((i + 1).succ)) T₀ Tᵢ Tⱼ (GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0))) (GaussianQuarterTurn (BandVectors.1 (q 0) (q i.succ))) diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean index 8e915fa198..1d09c5d996 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean @@ -1137,87 +1137,6 @@ private theorem hchildrenAt804 : · exact ⟨F, hF, by simp [hhit]⟩ · exact ⟨F, hF, by simp [hhit]⟩ -private theorem hleftFaceAt816 : - (by - classical - exact - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : - P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set - (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), - let c := P3523T1InsertionConstruction s t - ∀ (h : ℕ), ∀ (hh : h < c.steps.length), - let e := c.steps.get ⟨h, hh⟩ - (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).1 ≠ - ((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.2) → (∀ (F : Finset (Fin - (n + (3 : ℕ)))), ∀ (z : Fin (n + (3 : ℕ))), (e.2.2 ≠ z) → ((F = {e.1, e.2.2, z}) → - (insert e.2.1 (F.erase e.2.2) = ({e.1, e.2.1, z} : Finset (Fin (n + 3)))))) ) := by - classical - intro r n q p s X K t c h hh e hab F z hbz hFeq - rw [hFeq] - ext y - simp only [Finset.mem_insert, Finset.mem_erase, - Finset.mem_singleton] - constructor - · rintro (hd | ⟨hne, ha | hb | hz⟩) - · exact Or.inr (Or.inl hd) - · exact Or.inl ha - · exact (hne hb).elim - · exact Or.inr (Or.inr hz) - · rintro (ha | hd | hz) - · exact Or.inr ⟨fun h => hab (ha.symm.trans h), Or.inl ha⟩ - · exact Or.inl hd - · exact Or.inr ⟨fun h => hbz (h.symm.trans hz), Or.inr (Or.inr hz)⟩ - -private theorem hrightFaceAt832 : - (by - classical - exact - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : - P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set - (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), - let c := P3523T1InsertionConstruction s t - ∀ (h : ℕ), ∀ (hh : h < c.steps.length), - let e := c.steps.get ⟨h, hh⟩ - (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).1 ≠ - ((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.2) → (∀ (F : Finset (Fin - (n + (3 : ℕ)))), ∀ (z : Fin (n + (3 : ℕ))), (e.1 ≠ z) → ((F = {e.1, e.2.2, z}) → - (insert e.2.1 (F.erase e.1) = ({e.2.1, e.2.2, z} : Finset (Fin (n + 3)))))) ) := by - classical - intro r n q p s X K t c h hh e hab F z haz hFeq - rw [hFeq] - ext y - simp only [Finset.mem_insert, Finset.mem_erase, - Finset.mem_singleton] - constructor - · rintro (hd | ⟨hne, ha | hb | hz⟩) - · exact Or.inl hd - · exact (hne ha).elim - · exact Or.inr (Or.inl hb) - · exact Or.inr (Or.inr hz) - · rintro (hd | hb | hz) - · exact Or.inl hd - · exact Or.inr ⟨fun h => hab (h.symm.trans hb), Or.inr (Or.inl hb)⟩ - · exact Or.inr ⟨fun h => haz (h.symm.trans hz), Or.inr (Or.inr hz)⟩ - -private theorem hdet'At850 : - (by - classical - exact - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : - P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set - (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), - let c := P3523T1InsertionConstruction s t - (∀ {I : Type}, ∀ {J : Type}, ∀ (v : I → J), ∀ (a : I), ∀ (b : I), ∀ (z : I), v ∘ ![a, b, - z] = ![v a, v b, v z]) → (∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (h : ℕ), ∀ (hh : h < - c.steps.length), - let e := c.steps.get ⟨h, hh⟩ - ∀ (z : Fin (n + (3 : ℕ))), (P3381T1TriangleDeterminant (v ∘ ![e.1, e.2.2, z]) ≠ (0 : - ℝ)) → (P3381T1TriangleDeterminant ![v e.1, v e.2.2, v z] ≠ 0)) ) := by - classical - intro r n q p s X K t c mapTriple v h hh e z hdet - rw [mapTriple v e.1 e.2.2 z] at hdet - exact hdet - private theorem hxSplit : (by classical @@ -1631,32 +1550,6 @@ private theorem mixedPair : _ = convexHull Real (v '' ((H : Set _) ∩ ((insert d (F.erase a) : Finset _) : Set _))) := by rw [Set.inter_comm] -private theorem hfacesRecAt1185 : - (by - classical - exact - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : - P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set - (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), - let c := P3523T1InsertionConstruction s t - ∀ (h : ℕ), ∀ (hh : h < c.steps.length), - let e := c.steps.get ⟨h, hh⟩ - c.faces (h + 1) = P3523T1BoundaryFaceSplit (c.faces h) e.1 e.2.1 e.2.2 ) := by - classical - intro r n q p s X K t c h hh e - change (c.steps.take (h + 1)).foldl - (fun fs e => P3523T1BoundaryFaceSplit fs e.1 e.2.1 e.2.2) - (Finset.univ.image fun k : Fin t.count => - Finset.univ.image (s.start ∘ t.face k)) = - P3523T1BoundaryFaceSplit - ((c.steps.take h).foldl - (fun fs e => P3523T1BoundaryFaceSplit fs e.1 e.2.1 e.2.2) - (Finset.univ.image fun k : Fin t.count => - Finset.univ.image (s.start ∘ t.face k))) - (c.steps[h].1) (c.steps[h].2.1) (c.steps[h].2.2) - rw [List.take_succ_eq_append_getElem hh] - simp only [List.foldl_append, List.foldl_cons, List.foldl_nil] - private theorem splitFacts : (by classical @@ -2326,13 +2219,13 @@ private theorem coverState : existsThird hshape.1 hhit.1 hhit.2 hab have hleftFace : insert e.2.1 (F.erase e.2.2) = ({e.1, e.2.1, z} : Finset (Fin (n + 3))) := - FacialInsertionGeometry.hleftFaceAt816 r n q p s X K t h hh hab F z hbz hFeq + FacialInsertionGeometry.hleftFaceAt728 r n q p s X K t h hh hab F z hbz hFeq have hrightFace : insert e.2.1 (F.erase e.1) = ({e.2.1, e.2.2, z} : Finset (Fin (n + 3))) := - FacialInsertionGeometry.hrightFaceAt832 r n q p s X K t h hh hab F z haz hFeq + FacialInsertionGeometry.hrightFaceAt744 r n q p s X K t h hh hab F z haz hFeq have hdet := hnondeg h hleFace F hF ![e.1, e.2.2, z] (tripleInj hab haz hbz) (by rw [hFeq]; exact tripleRange _ _ _) - have hdet' := FacialInsertionGeometry.hdet'At850 r n q p s X K t mapTriple v h hh z hdet + have hdet' := FacialInsertionGeometry.hdet'At762 r n q p s X K t mapTriple v h hh z hdet obtain ⟨u, hu0, hu1, hvalue⟩ := hinterp h hh have hgeo := splitHull v e.1 e.2.1 e.2.2 z hab haz hbz u ⟨hu0, hu1⟩ hvalue hdet' @@ -2476,7 +2369,7 @@ private theorem pairState : rcases hstep h hh with ⟨hab, haV, hbV, hdV, hboundary, _⟩ have hfacesRec : c.faces (h + 1) = P3523T1BoundaryFaceSplit (c.faces h) e.1 e.2.1 e.2.2 := - FacialInsertionGeometry.hfacesRecAt1185 r n q p s X K t h hh + FacialInsertionGeometry.hfacesRecAt698 r n q p s X K t h hh rw [hfacesRec] at hF hG obtain ⟨F₀, hF₀, hbranchF⟩ := (split_mem_cases (c.faces h) e.1 e.2.1 e.2.2 F).mp hF diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean b/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean index f0b05e21ef..1be76d61df 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean @@ -663,35 +663,6 @@ private theorem hvertices : List.mem_filter.mpr ⟨hxsource, by simp [hz]⟩ simpa [List.map_map] using hxfilter -private theorem pairCasesAt830 : - ∀ (n : Nat), ∀ {a : Fin (n + 3)}, ∀ {b : Fin (n + 3)}, ∀ {c : Fin (n + 3)}, ∀ - {d : Fin (n + 3)}, (a ≠ b) → ((({a, b} : Finset (Fin (n + 3))) = {c, d}) → ((a = c ∧ b = - d) ∨ (a = d ∧ b = c))) := by - classical - intro n a b c d hab h - have hac : a = c ∨ a = d := by - have ha : a ∈ ({c, d} : Finset (Fin (n + 3))) := by - rw [← h] - simp - simpa only [Finset.mem_insert, Finset.mem_singleton] using ha - rcases hac with hac | had - · have hb : b = c ∨ b = d := by - have hb' : b ∈ ({c, d} : Finset (Fin (n + 3))) := by - rw [← h] - simp - simpa only [Finset.mem_insert, Finset.mem_singleton] using hb' - rcases hb with hbc | hbd - · exact False.elim (hab (hac.trans hbc.symm)) - · exact Or.inl ⟨hac, hbd⟩ - · have hb : b = c ∨ b = d := by - have hb' : b ∈ ({c, d} : Finset (Fin (n + 3))) := by - rw [← h] - simp - simpa only [Finset.mem_insert, Finset.mem_singleton] using hb' - rcases hb with hbc | hbd - · exact Or.inr ⟨had, hbc⟩ - · exact False.elim (hab (had.trans hbd.symm)) - private theorem boundaryEdgeInj : ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), (∀ {a : Fin (n + 3)}, ∀ {b : Fin (n + 3)}, @@ -896,50 +867,6 @@ private theorem targetPairInj : rw [Nat.mod_eq_of_lt (by omega : 2 < n + 3)] at hv omega -private theorem keepBoundaryAt1047 : - ∀ (n : Nat), - let boundaryStep := fun - (es : Finset (Finset (Fin (n + 3)))) - (e : Fin (n + 3) × Fin (n + 3) × Fin (n + 3)) => - insert {e.1, e.2.1} - (insert {e.2.1, e.2.2} (es.erase {e.1, e.2.2})) - ∀ (l : List (Fin (n + 3) × Fin (n + 3) × Fin (n + 3))), ∀ (A : Finset (Finset (Fin (n + - 3)))), ∀ (P : Finset (Fin (n + 3))), (P ∈ A ∨ ∃ e ∈ l, - P = {e.1, e.2.1} ∨ P = {e.2.1, e.2.2}) → ((∀ e ∈ l, P ≠ {e.1, e.2.2}) → (P ∈ l.foldl - boundaryStep A)) := by - classical - intro n boundaryStep l A P hseed hno - induction l generalizing A with - | nil => - rcases hseed with hA | ⟨e, he, _⟩ - · simpa using hA - · simp at he - | cons a l ih => - simp only [List.foldl_cons] - rcases hseed with hA | ⟨e, he, hedge⟩ - · apply ih (A := boundaryStep A a) - · left - change P ∈ insert {a.1, a.2.1} - (insert {a.2.1, a.2.2} (A.erase {a.1, a.2.2})) - simp only [Finset.mem_insert, Finset.mem_erase] - exact Or.inr (Or.inr ⟨hno a (by simp), hA⟩) - · intro b hb - exact hno b (by simp [hb]) - · rcases List.mem_cons.mp he with heq | heTail - · subst e - apply ih (A := boundaryStep A a) - · left - rcases hedge with h1 | h2 - · simp [boundaryStep, h1] - · simp [boundaryStep, h2] - · intro b hb - exact hno b (by simp [hb]) - · apply ih (A := boundaryStep A a) - · right - exact ⟨e, heTail, hedge⟩ - · intro b hb - exact hno b (by simp [hb]) - private theorem memStep : ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real @@ -1446,7 +1373,7 @@ private theorem hboundary : (insert {e.2.1, e.2.2} (es.erase {e.1, e.2.2})) have pairCases {a b c d : Fin (n + 3)} (hab : a ≠ b) (h : ({a, b} : Finset (Fin (n + 3))) = {c, d}) : - (a = c ∧ b = d) ∨ (a = d ∧ b = c) := OrderedInsertionGeometry.pairCasesAt830 n (a := a) + (a = c ∧ b = d) ∨ (a = d ∧ b = c) := OrderedInsertionGeometry.pairCasesAt487 n (a := a) (b := b) (c := c) (d := d) hab h have adjacentNe (i : Fin (r + 3)) : i ≠ i + 1 := by intro heq @@ -1511,7 +1438,7 @@ private theorem hboundary : (hseed : P ∈ A ∨ ∃ e ∈ l, P = {e.1, e.2.1} ∨ P = {e.2.1, e.2.2}) (hno : ∀ e ∈ l, P ≠ {e.1, e.2.2}) : - P ∈ l.foldl boundaryStep A := OrderedInsertionGeometry.keepBoundaryAt1047 n l A P hseed + P ∈ l.foldl boundaryStep A := OrderedInsertionGeometry.keepBoundaryAt383 n l A P hseed hno have hinjShift : Function.Injective (fun k : Fin (n + 3) => s.start 0 + k) := by intro a b hab diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean b/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean index ba1e7cf672..3e84c4d70b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean @@ -3142,19 +3142,6 @@ private theorem hMconstant : intro n p i O C v rK prev a b cross r u hconstOn Lm hLmoff hLmpath xM hxM x hx exact hconstOn Lm hLmpath.isConnected (fun y hy => hLmoff y hy) x hx xM hxM -private theorem hOoffAt2603 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let O := P3544T1RayParity p - let C := P3544T1BoundaryCarrier p - ∀ x, x ∈ O → x ∉ C ) := by - classical - intro n p O C x hx - change x ∉ C ∧ _ at hx - exact hx.1 - end VertexSectorDetails theorem P3597T1VertexSectors {n : Nat} (p : P3381T1PolygonBoundary n) @@ -3344,7 +3331,7 @@ theorem P3597T1VertexSectors {n : Nat} (p : P3381T1PolygonBoundary n) hconstOn hLpoff hLppath xP hxP have hMconstant := VertexSectorDetails.hMconstant n p i rK hconstOn hLmoff hLmpath xM hxM - have hOoff := VertexSectorDetails.hOoffAt2603 n p + have hOoff := VertexSectorDetails.hOoffAt2413 n p by_cases hn : xP ∈ O · have hOddEq : Metric.ball v r ∩ O = Lp := VertexSectorProof.hOddEqAt1554 n p i rK hLcover xP xM hOpp hPconstant hMconstant hOoff hn diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean b/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean index 6bf4f8b5e6..304e3a7bd7 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean @@ -840,50 +840,6 @@ private theorem hfalseAt549 : rw [← hintAvoid] exact ⟨hqint, Set.mem_iUnion.mpr ⟨j, hqseg⟩⟩ -private theorem hqt0At555 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), - let a := p.vertex (E.b - 1) - let b := p.vertex E.b - let c := p.vertex (E.b + 1) - let v : Fin 3 → Real × Real := ![a, b, c] - ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), - let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ - ∀ (x : ℝ × ℝ), ∀ (j : Fin (n + (3 : ℕ))), ((0 : ℝ) < (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → - ℝ) x ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : ℝ) < (A.coord (2 : - Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x) → (∀ (t : ℝ), - let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) - (q t = x) → (0 < A.coord 0 (q t))) ) := by - classical - intro n p E a b c v hind hspan A x j hxb t q hqtq - calc - _ = A.coord 0 x := congrArg _ hqtq - _ > 0 := hxb.1 - -private theorem hqt2At558 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), - let a := p.vertex (E.b - 1) - let b := p.vertex E.b - let c := p.vertex (E.b + 1) - let v : Fin 3 → Real × Real := ![a, b, c] - ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), - let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ - ∀ (x : ℝ × ℝ), ∀ (j : Fin (n + (3 : ℕ))), ((0 : ℝ) < (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → - ℝ) x ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : ℝ) < (A.coord (2 : - Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x) → (∀ (t : ℝ), - let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) - (q t = x) → (0 < A.coord 2 (q t))) ) := by - classical - intro n p E a b c v hind hspan A x j hxb t q hqtq - calc - _ = A.coord 2 x := congrArg _ hqtq - _ > 0 := hxb.2.2 - private theorem hq1At579 : (by classical @@ -916,37 +872,6 @@ private theorem hq1At579 : rw [this] exact mul_pos (div_pos (sub_pos.mpr hts) (sub_pos.mpr ht'.2)) hposnext -private theorem hqsegAt597 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (j : Fin (n + (3 : ℕ))), - let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) - ∀ (s : ℝ), (s ∈ Set.Ioo (0 : Real) 1) → (q s ∈ segment Real (p.vertex j) (p.vertex (j + - 1))) ) := by - classical - intro n p j q s hs01 - rw [segment_eq_image_lineMap] - exact ⟨s, ⟨le_of_lt hs01.1, le_of_lt hs01.2⟩, rfl⟩ - -private theorem hfalseAt600 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), - let a := p.vertex (E.b - 1) - let b := p.vertex E.b - let c := p.vertex (E.b + 1) - let T := convexHull Real ({a, b, c} : Set (Real × Real)) - (interior T ∩ P3544T1BoundaryCarrier p = ∅) → (∀ (j : Fin (n + (3 : ℕ))), - let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) - ∀ (s : ℝ), (q s ∈ interior T) → ((q s ∈ segment Real (p.vertex j) (p.vertex (j + 1))) → - (q s ∈ (∅ : Set (Real × Real))))) ) := by - classical - intro n p E a b c T hintAvoid j q s hqint hqseg - rw [← hintAvoid] - exact ⟨hqint, Set.mem_iUnion.mpr ⟨j, hqseg⟩⟩ - private theorem hα0 : (by classical @@ -1946,9 +1871,9 @@ private theorem hbaseAvoid : hintAvoid j s hqint hqseg simp at hfalse · by_cases hposnext : 0 < A.coord 1 (p.vertex (j + 1)) - · have hqt0 := TriangleDiagonalGeometry.hqt0At555 n p E hind hspan x + · have hqt0 := TriangleDiagonalGeometry.hqt0At504 n p E hind hspan x j hxb t hqtq - have hqt2 := TriangleDiagonalGeometry.hqt2At558 n p E hind hspan x + have hqt2 := TriangleDiagonalGeometry.hqt2At507 n p E hind hspan x j hxb t hqtq have hn : (fun s => A.coord 0 (q s)) ⁻¹' Set.Ioi (0 : Real) ∈ nhds t := (hfc 0).continuousAt.preimage_mem_nhds @@ -1977,8 +1902,8 @@ private theorem hbaseAvoid : · exact hq0 · exact hq1 · exact hq2) - have hqseg := TriangleDiagonalGeometry.hqsegAt597 n p j s hs01 - have hfalse : q s ∈ (∅ : Set (Real × Real)) := TriangleDiagonalGeometry.hfalseAt600 n p E + have hqseg := TriangleDiagonalGeometry.hqsegAt546 n p j s hs01 + have hfalse : q s ∈ (∅ : Set (Real × Real)) := TriangleDiagonalGeometry.hfalseAt549 n p E hintAvoid j s hqint hqseg simp at hfalse · have hαnonpos : A.coord 1 (p.vertex j) ≤ 0 := le_of_not_gt hposj diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean b/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean index f2f199bc86..0a77fd9a62 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.ExposedCornerAffineBasis public import LeanPool.ApollonianSuperharmonic.P3650T1VisibleDiagonal public import Mathlib.Analysis.Normed.Affine.AddTorsorBases @@ -51,57 +52,6 @@ private theorem hSne : exact ⟨by aesop, by aesop, by aesop, hi⟩ exact h ⟨i, Finset.mem_filter.mpr ⟨Finset.mem_univ _, hm⟩⟩ -private theorem hbasis : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∃ A : - AffineBasis (Fin 3) Real (Real × Real), (∀ i, A i = ![p.vertex (E.b - 1), p.vertex - E.b, p.vertex (E.b + 1)] i) ∧ E.height = A.coord 1 ) := by - classical - intro n p E - let a := p.vertex (E.b - 1) - let b := p.vertex E.b - let c := p.vertex (E.b + 1) - let v : Fin 3 → Real × Real := ![a, b, c] - have hdet : (b.1 - a.1) * (c.2 - a.2) - - (c.1 - a.1) * (b.2 - a.2) ≠ 0 := by - simpa [P3381T1TriangleDeterminant, a, b, c] using E.nondegenerate - have hind : AffineIndependent Real v := by - apply (affineIndependent_iff_of_fintype Real v).mpr - intro z hz hsum i - rw [Finset.weightedVSub_eq_linear_combination Finset.univ hz] at hsum - have hz' : z 0 + z 1 + z 2 = 0 := by - simpa [Fin.sum_univ_succ, ← add_assoc] using hz - have hx : z 0 * a.1 + z 1 * b.1 + z 2 * c.1 = 0 := by - simpa [Fin.sum_univ_succ, v, ← add_assoc] using congrArg Prod.fst hsum - have hy : z 0 * a.2 + z 1 * b.2 + z 2 * c.2 = 0 := by - simpa [Fin.sum_univ_succ, v, ← add_assoc] using congrArg Prod.snd hsum - have hx' : z 1 * (b.1 - a.1) + z 2 * (c.1 - a.1) = 0 := by - linear_combination hx - a.1 * hz' - have hy' : z 1 * (b.2 - a.2) + z 2 * (c.2 - a.2) = 0 := by - linear_combination hy - a.2 * hz' - have hz1 : z 1 = 0 := by - apply (mul_eq_zero.mp (show z 1 * ((b.1 - a.1) * (c.2 - a.2) - - (c.1 - a.1) * (b.2 - a.2)) = 0 by - linear_combination (c.2 - a.2) * hx' - (c.1 - a.1) * hy')).resolve_right hdet - have hz2 : z 2 = 0 := by - apply (mul_eq_zero.mp (show z 2 * ((b.1 - a.1) * (c.2 - a.2) - - (c.1 - a.1) * (b.2 - a.2)) = 0 by - linear_combination (b.1 - a.1) * hy' - (b.2 - a.2) * hx')).resolve_right hdet - fin_cases i <;> simp_all - have hspan : affineSpan Real (Set.range v) = ⊤ := by - apply hind.affineSpan_eq_top_iff_card_eq_finrank_add_one.mpr - simp [Module.finrank_prod] - let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ - refine ⟨A, fun _ => rfl, ?_⟩ - apply AffineMap.ext_on A.tot - rintro x ⟨i, rfl⟩ - fin_cases i <;> simp only [AffineBasis.coord_apply] - · exact E.height_prev - · exact E.height_top - · exact E.height_next - private theorem hrange : (by classical @@ -833,7 +783,7 @@ theorem P3650T1MaximalHeightDiagonal {n : Nat} (p : P3381T1PolygonBoundary n) have hdprev : d ≠ E.b - 1 := hdprops.1 have hdb : d ≠ E.b := hdprops.2.1 have hdnext : d ≠ E.b + 1 := hdprops.2.2.1 - have hbasis := MaximalHeightGeometry.hbasis n p E + have hbasis := ExposedCornerAffineBasis n p E obtain ⟨A, hA, hheight⟩ := hbasis have hA0 : A 0 = p.vertex (E.b - 1) := hA 0 have hA1 : A 1 = p.vertex E.b := hA 1 diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean index ed7297df6c..9ad5584f69 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean @@ -2161,73 +2161,6 @@ private theorem hXnotDiagAt1281 : simp at h2 exact (ne_of_gt hδ) h2.symm -private theorem hscaleAt1324 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), - let va := p.vertex (E.b - 1) - let vb := p.vertex E.b - let vc := p.vertex (E.b + 1) - ∀ (r₀ : ℝ), - let r : Real := min r₀ 1 - (0 < r) → ( - let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) - δ₀ * (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) = r) ) := by - classical - intro n p E va vb vc r₀ r hr δ₀ - change (r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1))) * - (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) = r - field_simp - -private theorem hδaAt1328 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), - let va := p.vertex (E.b - 1) - let vb := p.vertex E.b - let vc := p.vertex (E.b + 1) - ∀ (r₀ : ℝ), - let r : Real := min r₀ 1 - let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) - let δ : Real := min δ₀ (1/2) - (0 < δ₀) → ((δ₀ * (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) = r) → (δ * ‖va - vb‖ < r)) ) := by - classical - intro n p E va vb vc r₀ r δ₀ δ hδ₀ hscale - have hbound : ‖va - vb‖ < 2 * (‖va - vb‖ + ‖vc - vb‖ + 1) := by - linarith only [norm_nonneg (va - vb), norm_nonneg (vc - vb)] - calc - δ * ‖va - vb‖ ≤ δ₀ * ‖va - vb‖ := - mul_le_mul_of_nonneg_right (min_le_left δ₀ (1/2)) (norm_nonneg _) - _ < δ₀ * (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) := - mul_lt_mul_of_pos_left hbound hδ₀ - _ = r := hscale - -private theorem hδcAt1337 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), - let va := p.vertex (E.b - 1) - let vb := p.vertex E.b - let vc := p.vertex (E.b + 1) - ∀ (r₀ : ℝ), - let r : Real := min r₀ 1 - let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) - let δ : Real := min δ₀ (1/2) - (0 < δ₀) → ((δ₀ * (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) = r) → (δ * ‖vc - vb‖ < r)) ) := by - classical - intro n p E va vb vc r₀ r δ₀ δ hδ₀ hscale - have hbound : ‖vc - vb‖ < 2 * (‖va - vb‖ + ‖vc - vb‖ + 1) := by - linarith only [norm_nonneg (va - vb), norm_nonneg (vc - vb)] - calc - δ * ‖vc - vb‖ ≤ δ₀ * ‖vc - vb‖ := - mul_le_mul_of_nonneg_right (min_le_left δ₀ (1/2)) (norm_nonneg _) - _ < δ₀ * (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) := - mul_lt_mul_of_pos_left hbound hδ₀ - _ = r := hscale - private theorem hUdiffAt1346 : (by classical @@ -2722,36 +2655,6 @@ private theorem hXnotAt1500 : have h := hXeven 1 ⟨by norm_num, by norm_num⟩ simpa only [γ, AffineMap.lineMap_apply_one] using h -private theorem hrightCenterAt1503 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : - P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (D.a = E.b) - → ( - let vb := p.vertex E.b - (C.ir (Fin.last (C.rightParameter + 2)) = D.a) → (C.right.vertex (Fin.last - (C.rightParameter + 2)) = - vb)) ) := by - classical - intro n p E D C ha vb hrightLast - rw [C.right_vertex] - simp [hrightLast, ha, vb] - -private theorem hrightIncidentPrevAt1506 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : - P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), - let va := p.vertex (E.b - 1) - (C.ir ⟨C.rightParameter+1, by omega⟩ = E.b - 1) → (C.right.vertex ⟨C.rightParameter + 1, - by omega⟩ = va)) := by - classical - intro n p E D C va hrightPrev - rw [C.right_vertex] - exact congrArg p.vertex hrightPrev - private theorem hrightNextLast : (by classical @@ -3137,9 +3040,9 @@ private theorem hseedLAt3101 : have hδ₀ : 0 < δ₀ := by dsimp [δ₀]; positivity have hδ : 0 < δ := lt_min hδ₀ (by norm_num) have hδlt1 : δ < 1 := lt_of_le_of_lt (min_le_right δ₀ (1/2)) (by norm_num) - have hscale := OldArcParityProof.hscaleAt1324 n p E r₀ hr - have hδa := OldArcParityProof.hδaAt1328 n p E r₀ hδ₀ hscale - have hδc := OldArcParityProof.hδcAt1337 n p E r₀ hδ₀ hscale + have hscale := OldArcParityProof.hscaleAt1080 n p E r₀ hr + have hδa := OldArcParityProof.hδaAt1084 n p E r₀ hδ₀ hscale + have hδc := OldArcParityProof.hδcAt1093 n p E r₀ hδ₀ hscale have hUdiff := OldArcParityProof.hUdiffAt1346 n p E lineMapSub r₀ have hXdiff := OldArcParityProof.hXdiffAt1349 n p E lineMapSub r₀ have hUball := OldArcParityProof.hUballAt1352 n p E r₀ hδ hδc hUdiff @@ -3168,8 +3071,8 @@ private theorem hseedLAt3101 : have hXeven := parityEvenAlongPath C.left γ hcont havoid (by simpa only [γ, AffineMap.lineMap_apply_zero] using hUeven) have hXnot := OldArcParityProof.hXnotAt1500 n p E D C r₀ hXeven - have hrightCenter := OldArcParityProof.hrightCenterAt1503 n p E D C ha hrightLast - have hrightIncidentPrev := OldArcParityProof.hrightIncidentPrevAt1506 n p E D C hrightPrev + have hrightCenter := OldArcParityProof.hrightCenterAt1156 n p E D C ha hrightLast + have hrightIncidentPrev := OldArcParityProof.hrightIncidentPrevAt1166 n p E D C hrightPrev have hrightNextLast := OldArcParityProof.hrightNextLast n p E D C have hXcarrier := OldArcParityProof.hXcarrierAt1521 n p E D C r₀ hδ hδlt1 hrightCenter hrightIncidentPrev hrightNextLast diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean b/LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean index d33400a00f..c00e3b37d8 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.ExposedCornerAffineBasis public import Mathlib.LinearAlgebra.AffineSpace.FiniteDimensional @@ -27,57 +28,6 @@ namespace ApollonianSuperharmonic namespace TriangleEntryGeometry -private theorem hbasis : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∃ A : - AffineBasis (Fin 3) Real (Real × Real), (∀ i, A i = ![p.vertex (E.b - 1), p.vertex - E.b, p.vertex (E.b + 1)] i) ∧ E.height = A.coord 1 ) := by - classical - intro n p E - let a := p.vertex (E.b - 1) - let b := p.vertex E.b - let c := p.vertex (E.b + 1) - let v : Fin 3 → Real × Real := ![a, b, c] - have hdet : (b.1 - a.1) * (c.2 - a.2) - - (c.1 - a.1) * (b.2 - a.2) ≠ 0 := by - simpa [P3381T1TriangleDeterminant, a, b, c] using E.nondegenerate - have hind : AffineIndependent Real v := by - apply (affineIndependent_iff_of_fintype Real v).mpr - intro z hz hsum i - rw [Finset.weightedVSub_eq_linear_combination Finset.univ hz] at hsum - have hz' : z 0 + z 1 + z 2 = 0 := by - simpa [Fin.sum_univ_succ, ← add_assoc] using hz - have hx : z 0 * a.1 + z 1 * b.1 + z 2 * c.1 = 0 := by - simpa [Fin.sum_univ_succ, v, ← add_assoc] using congrArg Prod.fst hsum - have hy : z 0 * a.2 + z 1 * b.2 + z 2 * c.2 = 0 := by - simpa [Fin.sum_univ_succ, v, ← add_assoc] using congrArg Prod.snd hsum - have hx' : z 1 * (b.1 - a.1) + z 2 * (c.1 - a.1) = 0 := by - linear_combination hx - a.1 * hz' - have hy' : z 1 * (b.2 - a.2) + z 2 * (c.2 - a.2) = 0 := by - linear_combination hy - a.2 * hz' - have hz1 : z 1 = 0 := by - apply (mul_eq_zero.mp (show z 1 * ((b.1 - a.1) * (c.2 - a.2) - - (c.1 - a.1) * (b.2 - a.2)) = 0 by - linear_combination (c.2 - a.2) * hx' - (c.1 - a.1) * hy')).resolve_right hdet - have hz2 : z 2 = 0 := by - apply (mul_eq_zero.mp (show z 2 * ((b.1 - a.1) * (c.2 - a.2) - - (c.1 - a.1) * (b.2 - a.2)) = 0 by - linear_combination (b.1 - a.1) * hy' - (b.2 - a.2) * hx')).resolve_right hdet - fin_cases i <;> simp_all - have hspan : affineSpan Real (Set.range v) = ⊤ := by - apply hind.affineSpan_eq_top_iff_card_eq_finrank_add_one.mpr - simp [Module.finrank_prod] - let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ - refine ⟨A, fun _ => rfl, ?_⟩ - apply AffineMap.ext_on A.tot - rintro x ⟨i, rfl⟩ - fin_cases i <;> simp only [AffineBasis.coord_apply] - · exact E.height_prev - · exact E.height_top - · exact E.height_next - private theorem hrange : (by classical @@ -343,7 +293,7 @@ theorem P3650T1TriangleEntry {n : Nat} (p : P3381T1PolygonBoundary n) -- BODY classical -- The determinant makes the neighboring vertices an affine basis. - have hbasis := TriangleEntryGeometry.hbasis n p E + have hbasis := ExposedCornerAffineBasis n p E intro j w hjprev hjtop hw hws obtain ⟨A, hA, hheight⟩ := hbasis have hA0 : A 0 = p.vertex (E.b - 1) := hA 0 diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean index 11fa41122b..7a3ba55494 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean @@ -1686,138 +1686,6 @@ private theorem hfvalueAt807 : f s = left s := Set.piecewise_eqOn A left right hsA _ = g a b t := by simp [left, htval] -private theorem hcastAt824 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (i : Fin (m + n)), i.castSucc = (⟨i.val, by omega⟩ : Fin (m + n + 1)))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i - apply Fin.ext - rfl - -private theorem hsuccAt827 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (i : Fin (m + n)), i.succ = (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i - apply Fin.ext - rfl - -private theorem hlo'At830 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (i : Fin (m + n)), ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), (tm i.castSucc ≤ - (↑s : ℝ)) → ((i.castSucc = (⟨i.val, by omega⟩ : Fin (m + n + 1))) → (tm ⟨i.val, - by omega⟩ ≤ (s : Real))))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm i s hlo - hcast - rw [← hcast] - exact hlo - -private theorem hhi'At833 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (i : Fin (m + n)), ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ((↑s : ℝ) ≤ tm - i.succ) → ((i.succ = (⟨i.val + 1, by omega⟩ : Fin (m + n + 1))) → ((s : Real) ≤ - tm ⟨i.val + 1, by omega⟩)))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm i s hhi - hsucc - rw [← hsucc] - exact hhi - private theorem hcurIndex : (by classical @@ -3215,14 +3083,14 @@ private theorem hpoly : obtain ⟨C, V, hpiece⟩ := polyba.affine_on k refine ⟨C + 2 • V, -2 • V, ?_⟩ intro s hlo hhi - have hcast := ContactDrawingGeometry.hcastAt824 ι P D a b localStar rep_spec + have hcast := ContactDrawingGeometry.hcastAt761 ι P D a b localStar rep_spec pulled_contact hab polyab polyba i - have hsucc := ContactDrawingGeometry.hsuccAt827 ι P D a b localStar rep_spec + have hsucc := ContactDrawingGeometry.hsuccAt764 ι P D a b localStar rep_spec pulled_contact hab polyab polyba i - have hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real) := ContactDrawingGeometry.hlo'At830 ι P D a b + have hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real) := ContactDrawingGeometry.hlo'At767 ι P D a b localStar rep_spec pulled_contact hab polyab polyba i s hlo hcast - have hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩ := ContactDrawingGeometry.hhi'At833 ι P D + have hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩ := ContactDrawingGeometry.hhi'At770 ι P D a b localStar rep_spec pulled_contact hab polyab polyba i s hhi hsucc have hcurIndex := ContactDrawingGeometry.hcurIndex ι P D a b localStar rep_spec diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean index 6fd0426bd9..f3884bc7bb 100644 --- a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean @@ -704,47 +704,6 @@ private theorem hqsecAt467 : rw [S.cover] exact ⟨hq.2, hqNotRay⟩ -private theorem hqNotRayAt479 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : - P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), - let x := D.position a - let B := Metric.ball x r - ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), - let U := F.region f - (∀ (q : Real × Real), (q ∈ B) → ((q ∈ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ {q | ∃ - t : Real, 0 ≤ t ∧ q = x + t • u d}) → (q ∈ frontier U))) → ((IsOpen U) → (∀ (q : ℝ × - ℝ), (q ∈ F.region f ∩ B) → (q ∉ ({q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ {q | ∃ t - : Real, 0 ≤ t ∧ q = x + t • u d})))) ) := by - classical - intro ι P D F a r u x B f c d U rayFront hUopen q hq hqRay - have hqf : q ∈ frontier U := rayFront q hq.2 hqRay - have hqnotU : q ∉ U := by - intro hqU - have : q ∈ frontier U := hqf - rw [frontier, hUopen.interior_eq] at this - exact this.2 hqU - exact hqnotU hq.1 - -private theorem hqsecAt489 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : - P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), - let x := D.position a - let B := Metric.ball x r - ∀ (f : P.plane.Face), ∀ (c : ι), ∀ (d : ι), ∀ (S : P3889T1TwoRaySectorDecomposition x r - (u c) (u d)), ∀ (q : ℝ × ℝ), (q ∈ F.region f ∩ B) → ((q ∉ ({q | ∃ t : Real, 0 ≤ t ∧ q - = x + t • u c} ∪ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u d})) → (q ∈ S.left ∪ - S.right)) ) := by - classical - intro ι P D F a r u x B f c d S q hq hqNotRay - rw [S.cover] - exact ⟨hq.2, hqNotRay⟩ - private theorem hrho : (by classical @@ -1462,36 +1421,6 @@ private theorem hdetplus : rw [heq] exact mul_pos heps hsum -private theorem huAt935 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (u : ι → ℝ × ℝ), (∀ (c : ι), - P.plane.adjacent a c → ‖u c‖ = (1 : ℝ)) → (∀ (e : ι), (P.plane.adjacent a e) → (u e ≠ - 0)) ) := by - classical - intro ι P a u hunit e hae heq - have h := hunit e hae - rw [heq, norm_zero] at h - norm_num at h - -private theorem hsumAt940 : - (by - classical - exact - ∀ (ι : Type), ∀ (u : ι → ℝ × ℝ), ∀ (e : ι), (u e ≠ 0) → (0 < (u e).1 ^ 2 + (u e).2 ^ 2) ) - := by - classical - intro ι u e hu - have hne : (u e).1 ^ 2 + (u e).2 ^ 2 ≠ 0 := by - intro hs - have h1 : (u e).1 = 0 := by nlinarith [sq_nonneg (u e).1, sq_nonneg (u e).2] - have h2 : (u e).2 = 0 := by nlinarith [sq_nonneg (u e).1, sq_nonneg (u e).2] - exact hu (by ext <;> assumption) - have hnonneg : 0 ≤ (u e).1 ^ 2 + (u e).2 ^ 2 := - add_nonneg (sq_nonneg _) (sq_nonneg _) - exact lt_of_le_of_ne hnonneg (Ne.symm hne) - private theorem hqminus1 : (by classical @@ -1629,20 +1558,6 @@ private theorem hdistAt997 : rw [hsub, norm_neg, hnorm] simpa [dist_comm] using this -private theorem ht'At1003 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : - ι), ∀ (p : ℝ × ℝ), - let x := D.position a - let rho : Real := ‖p - x‖ - ∀ (z : ℝ × ℝ), (z ∈ Metric.sphere x rho) → (∀ (t : ℝ), (dist z x = t) → (t = rho)) ) := by - classical - intro ι P D a p x rho z hzS t hdist - calc t = dist z x := hdist.symm - _ = rho := by simpa [Metric.mem_sphere, dist_eq_norm] using hzS - private theorem hSphereConnected : (by classical @@ -1873,9 +1788,9 @@ private theorem hfaceFillsSector : ext q constructor · intro hq - have hqNotRay := FaceGapProof.hqNotRayAt479 ι P D F a r + have hqNotRay := FaceGapProof.hqNotRayAt457 ι P D F a r u f c d rayFront hUopen q hq - have hqsec := FaceGapProof.hqsecAt489 ι P D F a r u f c d S q hq + have hqsec := FaceGapProof.hqsecAt467 ι P D F a r u f c d S q hq hqNotRay rcases hqsec with hqL | hqR · exact ((Set.disjoint_left.mp hUV) hq.1 (hL hqL)).elim @@ -2008,8 +1923,8 @@ private theorem hKlocal : let v : Real × Real := (-(u e).2, (u e).1) have hvnorm : ‖v‖ = 1 := by simpa [v, Prod.norm_def, Real.norm_eq_abs, max_comm] using hunit e hae - have hu := FaceGapProof.huAt935 ι P a u hunit e hae - have hsum := FaceGapProof.hsumAt940 ι u e hu + have hu := FaceGapProof.huAt878 ι P a u hunit e hae + have hsum := FaceGapProof.hsumAt883 ι u e hu let qminus := z + eps • (-v) have hdetminus := FaceGapProof.hdetminus ι u z e t δ₁ δ₂ heps hsum exact (Set.disjoint_left.mp (hd hfg) (hneg₁ qminus (FaceGapProof.hqminus1 ι u z e t δ₁ @@ -2026,7 +1941,7 @@ private theorem hKlocal : · obtain ⟨t, ht0, hzeq⟩ := hzd.2 have hnorm := FaceGapProof.hnormAt994 ι P a u hunit d had t ht0 have hdist := FaceGapProof.hdistAt997 ι P D a u z d t hzeq hnorm - have ht' := FaceGapProof.ht'At1003 ι P D a p z hzS t hdist + have ht' := FaceGapProof.ht'At987 ι P D a p z hzS t hdist have htpos : 0 < t := by rw [ht']; exact hrho have htr : t < r := by rw [ht']; exact hrho' exact finishRay d hdi hda had t htpos htr hzeq diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean index d9c3f554e7..beca934a26 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean @@ -999,33 +999,6 @@ private theorem hWeqAt1029 : have h := crossNorthEq c2 hnc simpa [I, c1, c2, c2i] using h -private theorem hWeqAt1062 : - ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (p : List GaussianInt), ∀ (u : - GaussianInt), ∀ (v : GaussianInt), - let c1 : GaussianInt := x - 1 - let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ - (∀ (a : GaussianInt), ∀ (b : GaussianInt), ((a, b) ∈ p.zip p.tail ++ [(v, u)]) → (({a, b} : - Finset GaussianInt) ∈ F)) → ( - let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p - (∀ (q : GaussianInt), ((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ (q + ⟨0, 1⟩, - q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)]) → (GridRayCrossingIndex (q + ⟨0, 1⟩) p = - GridRayCrossingIndex q p)) → ((c2 + 1 + ⟨0, 1⟩ = x) → ((c2 + ⟨0, 1⟩ = x - 1) → ((({x - 1, - x} : Finset GaussianInt) ∉ F) → (I c1 = I c2))))) := by - classical - intro F x p u v c1 c2 cyclicToEdge I crossNorthEq c2addi c2i hWabsent - have hnc : - (c2 + 1 + ⟨0, 1⟩, c2 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ - (c2 + ⟨0, 1⟩, c2 + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] := by - constructor - · intro h - apply hWabsent - simpa [c2, c2addi, c2i, Finset.pair_comm] using cyclicToEdge _ _ h - · intro h - apply hWabsent - convert cyclicToEdge _ _ h using 1; simp [c2]; ring - have h := crossNorthEq c2 hnc - simpa [I, c1, c2, c2i] using h - private theorem hNeqAt1093 : ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (p : List GaussianInt), ∀ (u : GaussianInt), ∀ (v : GaussianInt), @@ -1053,61 +1026,6 @@ private theorem hNeqAt1093 : have h := crossEastEq c1 hnc simpa [I, c0, c1, c1add] using h -private theorem hEeqAt1127 : - ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (p : List GaussianInt), ∀ (u : - GaussianInt), ∀ (v : GaussianInt), - let c0 : GaussianInt := x - let c3 : GaussianInt := x - ⟨0, 1⟩ - (∀ (a : GaussianInt), ∀ (b : GaussianInt), ((a, b) ∈ p.zip p.tail ++ [(v, u)]) → (({a, b} : - Finset GaussianInt) ∈ F)) → ( - let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p - (∀ (q : GaussianInt), ((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ (q + ⟨0, 1⟩, - q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)]) → (GridRayCrossingIndex (q + ⟨0, 1⟩) p = - GridRayCrossingIndex q p)) → ((c3 + ⟨0, 1⟩ = x) → ((({x, x + 1} : Finset GaussianInt) ∉ - F) → (I c0 = I c3)))) := by - classical - intro F x p u v c0 c3 cyclicToEdge I crossNorthEq c3i hEabsent - have hnc : - (c3 + 1 + ⟨0, 1⟩, c3 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ - (c3 + ⟨0, 1⟩, c3 + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] := by - constructor - · intro h - apply hEabsent - convert cyclicToEdge _ _ h using 1; simp [c3, Finset.pair_comm]; ring - · intro h - apply hEabsent - convert cyclicToEdge _ _ h using 1; simp [c3, Finset.pair_comm]; ring - have h := crossNorthEq c3 hnc - simpa [I, c0, c3, c3i] using h - -private theorem hSeqAt1158 : - ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (p : List GaussianInt), ∀ (u : - GaussianInt), ∀ (v : GaussianInt), - let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ - let c3 : GaussianInt := x - ⟨0, 1⟩ - (∀ (a : GaussianInt), ∀ (b : GaussianInt), ((a, b) ∈ p.zip p.tail ++ [(v, u)]) → (({a, b} : - Finset GaussianInt) ∈ F)) → ( - let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p - (∀ (q : GaussianInt), ((q + 1, q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ (q + 1 + ⟨0, 1⟩, - q + 1) ∉ p.zip p.tail ++ [(v, u)]) → (GridRayCrossingIndex (q + 1) p = - GridRayCrossingIndex q p)) → ((c2 + 1 = x - ⟨0, 1⟩) → ((({x - ⟨0, 1⟩, x} : Finset - GaussianInt) ∉ F) → (I c3 = I c2)))) := by - classical - intro F x p u v c2 c3 cyclicToEdge I crossEastEq c2add hSabsent - have c2addi : c2 + 1 + ⟨0, 1⟩ = x := by dsimp [c2]; ring - have hnc : - (c2 + 1, c2 + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ - (c2 + 1 + ⟨0, 1⟩, c2 + 1) ∉ p.zip p.tail ++ [(v, u)] := by - constructor - · intro h - apply hSabsent - convert cyclicToEdge _ _ h using 1; simp [c2]; ring - · intro h - apply hSabsent - simpa [c2, c2add, c2addi, Finset.pair_comm] using cyclicToEdge _ _ h - have h := crossEastEq c2 hnc - simpa [I, c2, c3, c2add] using h - private theorem verticalSupport : (List GaussianInt) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : GaussianInt), (({a, b} : Finset GaussianInt) = {c, d}) → ((c ≠ d) → ((a = c ∧ b = d) ∨ (a @@ -1976,7 +1894,7 @@ private theorem hindexDiff : simpa [c1, c1add, c1addi] using hNcyc have h := crossEastJump c1 hc simpa [I, c0, c1, c1add] using h - have hWeq : I c1 = I c2 := ExteriorMixedCycleProof.hWeqAt1062 F x p u v cyclicToEdge + have hWeq : I c1 = I c2 := ExteriorMixedCycleProof.hWeqAt1029 F x p u v cyclicToEdge crossNorthEq c2addi c2i hWabsent refine Or.inr ⟨hexterior, ?_⟩ have hneg : I c0 - I c2 = I c0 - I c1 := by rw [hWeq] @@ -2020,7 +1938,7 @@ private theorem hindexDiff : simpa [c2, c2add] using hScyc have h := crossEastJump c2 hc simpa [I, c2, c3, c2add] using h - have hEeq : I c0 = I c3 := ExteriorMixedCycleProof.hEeqAt1127 F x p u v cyclicToEdge + have hEeq : I c0 = I c3 := ExteriorMixedCycleProof.hEeqAt936 F x p u v cyclicToEdge crossNorthEq c3i hEabsent refine Or.inr ⟨hexterior, ?_⟩ have hEq : I c0 - I c2 = I c3 - I c2 := by rw [hEeq] @@ -2040,7 +1958,7 @@ private theorem hindexDiff : simpa [c3, c3i, c3addi] using Or.symm hEcyc have h := crossNorthJump c3 hc simpa [I, c0, c3, c3i] using h - have hSeq : I c3 = I c2 := ExteriorMixedCycleProof.hSeqAt1158 F x p u v cyclicToEdge + have hSeq : I c3 = I c2 := ExteriorMixedCycleProof.hSeqAt999 F x p u v cyclicToEdge crossEastEq c2add hSabsent refine Or.inr ⟨hexterior, ?_⟩ have hEq : I c0 - I c2 = I c0 - I c3 := by rw [hSeq] diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean index 63abdad7b6..36eac02892 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean @@ -405,84 +405,6 @@ private theorem hZlabel : · have ht : Even t.val := htpar.mpr hs simp [hs, ht] -private theorem hFf : - (by - classical - exact - ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : - ProtoTile), ∀ (W : ProtoTile), ∀ (Z : ProtoTile), - let q : GaussianInt := ⟨0, 1⟩ - ∀ (aU : GaussianInt), (GaussianRealPoint aU = ((TileCentroid U).1 + (TileCentroid U).2, - (TileCentroid U).2 - (TileCentroid U).1)) → (((TileTranslation (TileQuarterTurn U) - aU).cells = U.cells) → ((U.cells = ∅ → (TileTranslation (TileQuarterTurn U) - aU).anchor = U.anchor) → ((FootprintVertices (TileTranslation (TileQuarterTurn U) aU) - = FootprintVertices U) → (∀ (aW : GaussianInt), ∀ (aZ : GaussianInt), - let Wp := TileTranslation W (aU - aW) - let Zp := TileTranslation Z (aU - aZ) - (BandPrototile (r i.succ) Wp) → ((BandPrototile (r ((if Even s.val then i - 1 else i + - 1).succ)) Zp) → (((aU.re : Real) = (TileCentroid U).1 + (TileCentroid U).2) → - (((aU.im : Real) = (TileCentroid U).2 - (TileCentroid U).1) → ((TileCentroid Wp - - TileCentroid U = (-(TileCentroid W - TileCentroid U).2, (TileCentroid W - - TileCentroid U).1)) → ((TileCentroid Zp - TileCentroid U = (-(TileCentroid Z - - TileCentroid U).2, (TileCentroid Z - TileCentroid U).1)) → ( - let t : Fin 4 := s + 1 - (TileCentroid Wp - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * - (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ)))) → ((TileCentroid - Zp - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * (if Even t.val - then BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r 0) (r ((i + 1).succ)) - else BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r - 0)))) → (((pairedEndpointPackage r U) i t Wp - Zp) → ( - let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU - let f : GaussianInt → GaussianInt := fun x => - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) - ∀ (x : GaussianInt), f (F x) = x))))))))))))) ) := by - classical - intro r i s U W Z q aU haU hUc hUa hUv aW aZ Wp Zp hWp hZp haUre haUim hWpCent hZpCent t hWsrc - hZsrc sourceData F f x - rcases x with ⟨xr, xi⟩ - rcases aU with ⟨ar, ai⟩ - simp [f, F, GaussianQuarterTurn] - -private theorem hfF : - (by - classical - exact - ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : - ProtoTile), ∀ (W : ProtoTile), ∀ (Z : ProtoTile), - let q : GaussianInt := ⟨0, 1⟩ - ∀ (aU : GaussianInt), (GaussianRealPoint aU = ((TileCentroid U).1 + (TileCentroid U).2, - (TileCentroid U).2 - (TileCentroid U).1)) → (((TileTranslation (TileQuarterTurn U) - aU).cells = U.cells) → ((U.cells = ∅ → (TileTranslation (TileQuarterTurn U) - aU).anchor = U.anchor) → ((FootprintVertices (TileTranslation (TileQuarterTurn U) aU) - = FootprintVertices U) → (∀ (aW : GaussianInt), ∀ (aZ : GaussianInt), - let Wp := TileTranslation W (aU - aW) - let Zp := TileTranslation Z (aU - aZ) - (BandPrototile (r i.succ) Wp) → ((BandPrototile (r ((if Even s.val then i - 1 else i + - 1).succ)) Zp) → (((aU.re : Real) = (TileCentroid U).1 + (TileCentroid U).2) → - (((aU.im : Real) = (TileCentroid U).2 - (TileCentroid U).1) → ((TileCentroid Wp - - TileCentroid U = (-(TileCentroid W - TileCentroid U).2, (TileCentroid W - - TileCentroid U).1)) → ((TileCentroid Zp - TileCentroid U = (-(TileCentroid Z - - TileCentroid U).2, (TileCentroid Z - TileCentroid U).1)) → ( - let t : Fin 4 := s + 1 - (TileCentroid Wp - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * - (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ)))) → ((TileCentroid - Zp - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * (if Even t.val - then BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r 0) (r ((i + 1).succ)) - else BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r - 0)))) → (((pairedEndpointPackage r U) i t Wp - Zp) → ( - let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU - let f : GaussianInt → GaussianInt := fun x => - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) - (∀ (x : GaussianInt), f (F x) = x) → (∀ (x : GaussianInt), F (f x) = x)))))))))))))) ) := by - classical - intro r i s U W Z q aU haU hUc hUa hUv aW aZ Wp Zp hWp hZp haUre haUim hWpCent hZpCent t hWsrc - hZsrc sourceData F f hFf x - rcases x with ⟨xr, xi⟩ - rcases aU with ⟨ar, ai⟩ - simp [f, F, GaussianQuarterTurn] - private theorem hf : (by classical @@ -1462,10 +1384,14 @@ theorem P4055T1OrderedGeneralOppositeEndpoints : let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU let f : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) - have hFf := OppositeEndpointGeometry.hFf r i s U W Z aU haU hUc hUa hUv aW aZ hWp hZp haUre - haUim hWpCent hZpCent hWsrc hZsrc sourceData - have hfF := OppositeEndpointGeometry.hfF r i s U W Z aU haU hUc hUa hUv aW aZ hWp hZp haUre - haUim hWpCent hZpCent hWsrc hZsrc sourceData hFf + have hFf (x : GaussianInt) : f (F x) = x := by + rcases x with ⟨xr, xi⟩ + rcases aU with ⟨ar, ai⟩ + simp [f, F, GaussianQuarterTurn] + have hfF (x : GaussianInt) : F (f x) = x := by + rcases x with ⟨xr, xi⟩ + rcases aU with ⟨ar, ai⟩ + simp [f, F, GaussianQuarterTurn] have hf := OppositeEndpointGeometry.hf aU hfF have hUedges := OppositeEndpointGeometry.hUedges U aU hUc have hFvU := OppositeEndpointGeometry.hFvU U diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean index f056f37268..09368bf524 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean @@ -637,20 +637,6 @@ private theorem hpathLast : path = pre ++ x :: [] := hsplit _ = pre' ++ z :: x :: [] := by rw [← hpreEq]; simp [List.append_assoc] -private theorem hUVAt597 : - (by - classical - exact - ∀ (Ci : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (a : - TilingLattice Ci), ∀ (b : TilingLattice Ci), (P.tile a = P.tile b) → (a = b)) → (∀ (U - : ProtoTile), ∀ (V : ProtoTile), ∀ (ia : ↥(TilingLattice Ci)), ∀ (ib : - ↥(TilingLattice Ci)), (P.tile ia = U) → ((P.tile ib = V) → ((ia ≠ ib) → (U ≠ V)))) ) - := by - classical - intro Ci P index_eq_of_tile_eq U V ia ib hUidx hVidx hidxne hEq - exact hidxne (index_eq_of_tile_eq ia ib - (hUidx.trans (hEq.trans hVidx.symm))) - private theorem hleft : (by classical @@ -1642,7 +1628,7 @@ private theorem terminalSector : simpa [Finset.pair_comm] using last_edge_unique path hnodup x z pre' hpathLast e ((hedgesPath e).mp he) hxe) - have hUV : U ≠ V := LocalSectorGeometry.hUVAt597 Ci P index_eq_of_tile_eq U V ia ib hUidx + have hUV : U ≠ V := LocalSectorGeometry.hUVAt563 Ci P index_eq_of_tile_eq U V ia ib hUidx hVidx hidxne exact ⟨z, U, V, g, k, Or.inr ⟨pre', [], hpathLast⟩, hUV, ⟨by simpa [Finset.pair_comm] using hedgeU, diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean b/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean index 30d97e6085..4008ba99b8 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean @@ -702,24 +702,6 @@ private theorem hsetAt695 : · simpa [hu, hv] using heq · simpa [hu, hv, Finset.pair_comm] using heq -private theorem hcdEqAt703 : - (by - classical - exact - ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (p : List GaussianInt), - let k := p.idxOf x - let q := p.rotate k - let j := q.idxOf y - let r := q.take (j + 1) - ∀ (c : LatticeCell), ∀ (d : LatticeCell), ∀ (z : GaussianInt), ∀ (w : GaussianInt), (z = - c ∧ w = d ∨ z = d ∧ w = c) → ((GridRayCrossingIndex w r = GridRayCrossingIndex z r) → - (GridRayCrossingIndex c r = GridRayCrossingIndex d r)) ) := by - classical - intro x y p k q j r c d z w hincident hzero' - rcases hincident with ⟨hzc, hwd⟩ | ⟨hzd, hwc⟩ - · simpa [hzc, hwd] using hzero'.symm - · simpa [hzd, hwc] using hzero' - end CrosscutIndexProof theorem P4456T2CrosscutIndex (T : ProtoTile) (hT : LatticeTile T) @@ -954,7 +936,7 @@ theorem P4456T2CrosscutIndex (T : ProtoTile) (hT : LatticeTile T) have hzero := (hcross z).2.2.1 (by simpa [edges] using habsent) have hzero' : GridRayCrossingIndex w r = GridRayCrossingIndex z r := by simpa [hwz] using hzero - have hcdEq := CrosscutIndexProof.hcdEqAt703 x y p c d z w hincident hzero' + have hcdEq := CrosscutIndexProof.hcdEqAt689 x y p c d z w hincident hzero' change GridRayCrossingIndex c r ≠ GridRayCrossingIndex d r at hsideDiff exact False.elim (hsideDiff hcdEq) diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean index f278d1c42d..634e1b11c2 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BoundaryFrameRowGeometry public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification @@ -137,39 +138,6 @@ private theorem hnegativeSlope : omega · exact ⟨child, hchild⟩ -private theorem hr : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - ProperBandQuadruple r ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r - have rot : ∀ i : Fin 3, - ProperBandQuadruple - ![F.q 0, F.q i.succ, F.q ((i + 1).succ), F.q ((i + 2).succ)] := by - intro i - fin_cases i - · convert F.proper using 1; funext j; fin_cases j <;> rfl - · refine ⟨SemiProperQuadruple.rotate F.proper.1, ?_⟩ - intro j - fin_cases j - · simpa using F.proper.2 1 - · simpa using F.proper.2 2 - · simpa using F.proper.2 0 - · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate F.proper.1), ?_⟩ - intro j - fin_cases j - · simpa using F.proper.2 2 - · simpa using F.proper.2 0 - · simpa using F.proper.2 1 - simpa [r] using rot F.slot - private theorem hrstep : (by classical @@ -331,46 +299,6 @@ private theorem hcenterVector : norm_num [I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> omega -private theorem hcenter : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let I : GaussianInt := ⟨0, 1⟩ - let w : GaussianInt := BandVectors.1 (r 3) (r 2) - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • - (GaussianRealPoint w - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) → - ((TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → (((↑(-w + I * w - - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin - (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).re : ℝ) = (↑((2 : GaussianInt) * y).re : ℝ)) → - (((↑(-w + I * w - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im : ℝ) = (↑((2 : - GaussianInt) * y).im : ℝ)) → (TileCentroid (D.tiles F.slot false) - TileCentroid - Rminus = GaussianRealPoint y)))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D r I w y hUcenter hMcenter hcenterRe - hcenterIm - rw [show TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = - (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile) - - (TileCentroid Rminus - TileCentroid F.tile) by - ext <;> dsimp <;> ring] - rw [hUcenter, hMcenter] - apply Prod.ext - · simp [GaussianRealPoint, w, y, Prod.smul_mk] - norm_num at hcenterRe ⊢ - linarith - · simp [GaussianRealPoint, w, y, Prod.smul_mk] - norm_num at hcenterIm ⊢ - linarith - private theorem hyLattice : (by classical @@ -2803,7 +2731,8 @@ theorem P4458T1LargestParentRows let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - have hr : ProperBandQuadruple r := LargestParentGeometry.hr C orientation base Rminus Rplus + have hr : ProperBandQuadruple r := + BoundaryFrameRowGeometry.presentationProper C orientation base Rminus Rplus hminus hplus F have hrstep := LargestParentGeometry.hrstep C orientation base Rminus Rplus hminus hplus F p hstep have hr1 : r 1 = p 0 := by simpa [r] using hq1 @@ -2836,7 +2765,8 @@ theorem P4458T1LargestParentRows hminus hplus F hvrec hvflip hvsumRe hvsumIm have hcenterRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) hcenterVector have hcenterIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) hcenterVector - have hcenter := LargestParentGeometry.hcenter C orientation base Rminus Rplus hminus hplus F D + have hcenter := + BoundaryFrameRowGeometry.centroidDifference C orientation base Rminus Rplus hminus hplus F D hUcenter hMcenter hcenterRe hcenterIm have hCcoord : C.1.1 = p 0 := F.parent.symm.trans hq1 have hRparent : r 1 = C.1.1 := by simpa [r] using F.parent diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean index ea40050b54..b163cffb08 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BoundaryFrameRowGeometry public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification @@ -45,39 +46,6 @@ private theorem hnegativeSlope : · omega · exact ⟨child, hchild⟩ -private theorem hr : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - ProperBandQuadruple r ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r - have rot : ∀ i : Fin 3, - ProperBandQuadruple - ![F.q 0, F.q i.succ, F.q ((i + 1).succ), F.q ((i + 2).succ)] := by - intro i - fin_cases i - · convert F.proper using 1; funext j; fin_cases j <;> rfl - · refine ⟨SemiProperQuadruple.rotate F.proper.1, ?_⟩ - intro j - fin_cases j - · simpa using F.proper.2 1 - · simpa using F.proper.2 2 - · simpa using F.proper.2 0 - · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate F.proper.1), ?_⟩ - intro j - fin_cases j - · simpa using F.proper.2 2 - · simpa using F.proper.2 0 - · simpa using F.proper.2 1 - simpa [r] using rot F.slot - private theorem hvsumRe : (by classical @@ -180,46 +148,6 @@ private theorem hcenterVector : apply Zsqrtd.ext <;> norm_num [I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> omega -private theorem hcenter : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let I : GaussianInt := ⟨0, 1⟩ - let w : GaussianInt := BandVectors.1 (r 3) (r 2) - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • - (GaussianRealPoint w - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) → - ((TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → (((↑(-w + I * w - - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin - (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).re : ℝ) = (↑((2 : GaussianInt) * y).re : ℝ)) → - (((↑(-w + I * w - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im : ℝ) = (↑((2 : - GaussianInt) * y).im : ℝ)) → (TileCentroid (D.tiles F.slot false) - TileCentroid - Rminus = GaussianRealPoint y)))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D r I w y hUcenter hMcenter hcenterRe - hcenterIm - rw [show TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = - (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile) - - (TileCentroid Rminus - TileCentroid F.tile) by - ext <;> dsimp <;> ring] - rw [hUcenter, hMcenter] - apply Prod.ext - · simp [GaussianRealPoint, w, y, Prod.smul_mk] - norm_num at hcenterRe ⊢ - linarith - · simp [GaussianRealPoint, w, y, Prod.smul_mk] - norm_num at hcenterIm ⊢ - linarith - private theorem hyLattice : (by classical @@ -2219,28 +2147,6 @@ private theorem hAIm'At948 : intro C orientation base Rminus Rplus hminus hplus F a p r xa hqB hqD hr1 hr3 rootA slopeA hAIm simpa [hqD, hqB, hr1, hr3, xa] using hAIm -private theorem ha10ReAt951 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), (Fin (3 : - ℕ)) → ((Fin (4 : ℕ) → CircleCoordinates) → ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let I : GaussianInt := ⟨0, 1⟩ - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - let ya : GaussianInt := BandVectors.2 (r 2) (r 1) - (BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.2 (r 1) (r 0)).re = xa.re - - ya.im))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p r I xa ya harec - have h := congrArg (fun z : GaussianInt => z.re) harec - norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ - omega - private theorem ha10ImAt955 : (by classical @@ -2488,44 +2394,6 @@ private theorem hjoinSlopeImA : rw [← hrootNegA] exact hjoinSlopeIm -private theorem hasumReAt1051 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let wa : GaussianInt := BandVectors.2 (r 3) (r 2) - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - let ya : GaussianInt := BandVectors.2 (r 2) (r 1) - (wa + xa + ya = 0) → (wa.re + xa.re + ya.re = 0) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum - have h := congrArg (fun z : GaussianInt => z.re) hasum - simpa [wa, xa, ya] using h - -private theorem hasumImAt1054 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let wa : GaussianInt := BandVectors.2 (r 3) (r 2) - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - let ya : GaussianInt := BandVectors.2 (r 2) (r 1) - (wa + xa + ya = 0) → (wa.im + xa.im + ya.im = 0) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum - have h := congrArg (fun z : GaussianInt => z.im) hasum - simpa [wa, xa, ya] using h - private theorem hleftAplusSlope : (by classical @@ -4466,7 +4334,7 @@ private theorem recursiveParentCase : hplus F a p hqB hqD hr1 hr3 rootA slopeA hARe have hAIm' := SecondNewerRowsGeometry.hAIm'At948 C orientation base Rminus Rplus hminus hplus F a p hqB hqD hr1 hr3 rootA slopeA hAIm - have ha10Re := SecondNewerRowsGeometry.ha10ReAt951 C orientation base Rminus Rplus hminus + have ha10Re := SecondNewerRowsGeometry.ha10ReAt509 C orientation base Rminus Rplus hminus hplus F a p harec have ha10Im := SecondNewerRowsGeometry.ha10ImAt955 C orientation base Rminus Rplus hminus hplus F harec @@ -4497,9 +4365,9 @@ private theorem recursiveParentCase : have hFminusIm := SecondNewerRowsGeometry.hFminusImAt1002 C orientation base Rminus Rplus hminus hplus F rootA hFminusSlope have hrootNegA : rootNeg = rootA := hrootNegEq.trans hrootAEq.symm - have hasumRe := SecondNewerRowsGeometry.hasumReAt1051 C orientation base Rminus Rplus + have hasumRe := SecondNewerRowsGeometry.hasumReAt438 C orientation base Rminus Rplus hminus hplus F hasum - have hasumIm := SecondNewerRowsGeometry.hasumImAt1054 C orientation base Rminus Rplus + have hasumIm := SecondNewerRowsGeometry.hasumImAt441 C orientation base Rminus Rplus hminus hplus F hasum have hasumReR : (wa.re : ℝ) + (xa.re : ℝ) + (ya.re : ℝ) = 0 := by exact_mod_cast hasumRe @@ -4548,7 +4416,8 @@ theorem P4458T1SecondNewerRows : let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] - have hr : ProperBandQuadruple r := SecondNewerRowsGeometry.hr C orientation base Rminus Rplus + have hr : ProperBandQuadruple r := + BoundaryFrameRowGeometry.presentationProper C orientation base Rminus Rplus hminus hplus F have hRparent : r 1 = C.1.1 := by simpa [r] using F.parent let I : GaussianInt := ⟨0, 1⟩ @@ -4586,7 +4455,8 @@ theorem P4458T1SecondNewerRows : have hcenterRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) hcenterVector have hcenterIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) hcenterVector have hcenter : TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = - GaussianRealPoint y := SecondNewerRowsGeometry.hcenter C orientation base Rminus Rplus + GaussianRealPoint y := + BoundaryFrameRowGeometry.centroidDifference C orientation base Rminus Rplus hminus hplus F D hUcenter hMcenter hcenterRe hcenterIm have hyLattice := SecondNewerRowsGeometry.hyLattice C orientation base Rminus Rplus hminus hplus F hr hRparent diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean index e0ac662e82..1cbfd701a9 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean @@ -1016,198 +1016,6 @@ private theorem hvecA : intro C orientation base Rminus Rplus hminus hplus F a r wa hindicesA rw [hindicesA.1, hindicesA.2] -private theorem hslotplus2 : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q - 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * - (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → - ((F.slot = a + 2) → (∀ (J : ProtoTile), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (ProperBandQuadruple r) → ((r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p - 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → ((r 1 = p 0) → ((r 2 = p - 2) → ((r 3 = p 3) → ((F.q F.slot.succ = r 3) → ((F.q 0 = r 0) → ( - let I : GaussianInt := ⟨0, 1⟩ - let wv := BandVectors.1 (r 3) (r 2) - let xv := BandVectors.1 (r 1) (r 3) - let yv := BandVectors.1 (r 2) (r 1) - let wa := BandVectors.2 (r 3) (r 2) - let xa := BandVectors.2 (r 1) (r 3) - let ya := BandVectors.2 (r 2) (r 1) - (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : - ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 - : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r - (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 - (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : - Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : - ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) - (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r - j.succ) (r (0 : Fin (4 : ℕ))))) → ( - let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] - (ProperBandQuadruple rr) → ((BandVectors.1 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + - BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + BandVectors.1 (rr (2 : Fin - (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (rr (3 : Fin (4 : - ℕ))) (rr (2 : Fin (4 : ℕ))) + BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) - + BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) = BandVectors.1 (rr (1 : Fin - (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (rr (2 : Fin (4 : - ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) - = BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple rr → ∀ - (j : Fin (3 : ℕ)), BandVectors.1 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ - * BandVectors.1 (rr j.succ) (rr (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (0 : Fin (4 : ℕ))) - (rr j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (rr j.succ) (rr (0 : Fin (4 : ℕ))))) → - ((BandVectors.1 (r 3) (r 0) = wv - I * xv) → ((BandVectors.2 (r 3) (r 0) = wa + I * xa) → - ((-(wv - I * wv) - (xv - I * yv - I * (xv - I * yv)) = (2 : GaussianInt) * yv ∧ xv - I * - yv + I * (xv - I * yv) + (wv - I * wv) = (2 : GaussianInt) * I * xv ∧ -(xv - I * xv) - - (wv - I * wv) = yv - I * yv ∧ yv - I * wv + I * (yv - I * wv) - (wv - I * wv) = yv + I * - yv ∧ wv - I * xv - I * (wv - I * xv) - (wv - I * wv) = -I * xv - xv ∧ -(yv - I * yv) - - (wv - I * wv) = -I * xv + xv ∧ yv - I * wv - I * (yv - I * wv) - (yv - I * yv) = -I * wv - - wv ∧ -(xv - I * xv) - (yv - I * yv) = -I * wv + wv ∧ -(yv - I * yv) - (xv - I * xv) = - wv - I * wv ∧ wv - I * xv + I * (wv - I * xv) - (xv - I * xv) = wv + I * wv) → ((-(wa - - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya + - -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - - (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya - + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - - -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - - -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I - * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * - xa) = wa + -I * wa) → ((BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : - ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin - (4 : ℕ))) ∧ BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → - ((BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : - ℤ)⟩ * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : ℤ), (1 : - ℤ)⟩ * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → - ((BandVectors.1 (r 0) (r 3) = I * BandVectors.1 (r 3) (r 0)) → ((BandVectors.2 (r 0) (r - 3) = -I * BandVectors.2 (r 3) (r 0)) → ((TileCentroid Rminus - TileCentroid F.tile = (1 / - 2 : ℝ) • GaussianRealPoint ((wv - I * xv) - I * (wv - I * xv))) → ((TileCentroid J - - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(yv - I * yv))) → ((TileCentroid - (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (wv - I * wv)) → - ((TileCentroid Rminus - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint - (-I * xv - xv)) → ((TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • - GaussianRealPoint (-I * xv + xv)) → ( - let e : GaussianInt := -I - (BandVectors.1 (p 0) (p 3) = xv) → ((BandVectors.2 (p 0) (p 3) = xa) → ((xv = I * - BandVectors.1 (p 3) (p 0)) → ((BandVectors.1 (p 3) (p 0) = -I * xv) → ((xa = e * - BandVectors.2 (p 3) (p 0)) → ((BandVectors.2 (p 3) (p 0) = -e * xa) → ((BandVectors.1 (p - 3) (p 0) - BandVectors.1 (p 0) (p 3) = -I * xv - xv) → ((BandVectors.1 (p 3) (p 0) + - BandVectors.1 (p 0) (p 3) = -I * xv + xv) → ((BandVectors.2 (p 3) (p 0) - BandVectors.2 - (p 0) (p 3) = -e * xa - xa) → ((BandVectors.2 (p 3) (p 0) + BandVectors.2 (p 0) (p 3) = - -e * xa + xa) → ((F.q a.succ = p 0) → ((F.q ((a + 2).succ) = r 3 ∧ F.q ((a + 1).succ) = r - 2) → ((BandVectors.2 (F.q ((a + 2).succ)) (F.q ((a + 1).succ)) = wa) → (F.slot + 2 = a + - 1)))))))))))))))))))))))))))))))))))))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J r hr hrstep r1 r2 r3 - hparentR hzero I wv xv yv wa xa ya laws rr hrr lawsR win ain hv ha vflip aflip vflip' - aflip' centMinus centJ centK hcentR hcentJ e hxcoordV hxcoordA hxv hza hxa hzaA hminusVecV - hplusVecV hminusVecA hplusVecA houterA hindicesA hvecA - rw [hslot] - fin_cases a <;> decide - -private theorem hslotplus1 : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q - 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * - (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → - ((F.slot = a + 2) → (∀ (J : ProtoTile), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (ProperBandQuadruple r) → ((r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p - 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → ((r 1 = p 0) → ((r 2 = p - 2) → ((r 3 = p 3) → ((F.q F.slot.succ = r 3) → ((F.q 0 = r 0) → ( - let I : GaussianInt := ⟨0, 1⟩ - let wv := BandVectors.1 (r 3) (r 2) - let xv := BandVectors.1 (r 1) (r 3) - let yv := BandVectors.1 (r 2) (r 1) - let wa := BandVectors.2 (r 3) (r 2) - let xa := BandVectors.2 (r 1) (r 3) - let ya := BandVectors.2 (r 2) (r 1) - (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : - ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 - : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r - (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 - (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : - Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : - ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) - (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r - j.succ) (r (0 : Fin (4 : ℕ))))) → ( - let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] - (ProperBandQuadruple rr) → ((BandVectors.1 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + - BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + BandVectors.1 (rr (2 : Fin - (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (rr (3 : Fin (4 : - ℕ))) (rr (2 : Fin (4 : ℕ))) + BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) - + BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) = BandVectors.1 (rr (1 : Fin - (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (rr (2 : Fin (4 : - ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) - = BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple rr → ∀ - (j : Fin (3 : ℕ)), BandVectors.1 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ - * BandVectors.1 (rr j.succ) (rr (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (0 : Fin (4 : ℕ))) - (rr j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (rr j.succ) (rr (0 : Fin (4 : ℕ))))) → - ((BandVectors.1 (r 3) (r 0) = wv - I * xv) → ((BandVectors.2 (r 3) (r 0) = wa + I * xa) → - ((-(wv - I * wv) - (xv - I * yv - I * (xv - I * yv)) = (2 : GaussianInt) * yv ∧ xv - I * - yv + I * (xv - I * yv) + (wv - I * wv) = (2 : GaussianInt) * I * xv ∧ -(xv - I * xv) - - (wv - I * wv) = yv - I * yv ∧ yv - I * wv + I * (yv - I * wv) - (wv - I * wv) = yv + I * - yv ∧ wv - I * xv - I * (wv - I * xv) - (wv - I * wv) = -I * xv - xv ∧ -(yv - I * yv) - - (wv - I * wv) = -I * xv + xv ∧ yv - I * wv - I * (yv - I * wv) - (yv - I * yv) = -I * wv - - wv ∧ -(xv - I * xv) - (yv - I * yv) = -I * wv + wv ∧ -(yv - I * yv) - (xv - I * xv) = - wv - I * wv ∧ wv - I * xv + I * (wv - I * xv) - (xv - I * xv) = wv + I * wv) → ((-(wa - - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya + - -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - - (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya - + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - - -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - - -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I - * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * - xa) = wa + -I * wa) → ((BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : - ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin - (4 : ℕ))) ∧ BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → - ((BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : - ℤ)⟩ * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : ℤ), (1 : - ℤ)⟩ * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → - ((BandVectors.1 (r 0) (r 3) = I * BandVectors.1 (r 3) (r 0)) → ((BandVectors.2 (r 0) (r - 3) = -I * BandVectors.2 (r 3) (r 0)) → ((TileCentroid Rminus - TileCentroid F.tile = (1 / - 2 : ℝ) • GaussianRealPoint ((wv - I * xv) - I * (wv - I * xv))) → ((TileCentroid J - - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(yv - I * yv))) → ((TileCentroid - (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (wv - I * wv)) → - ((TileCentroid Rminus - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint - (-I * xv - xv)) → ((TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • - GaussianRealPoint (-I * xv + xv)) → ( - let e : GaussianInt := -I - (BandVectors.1 (p 0) (p 3) = xv) → ((BandVectors.2 (p 0) (p 3) = xa) → ((xv = I * - BandVectors.1 (p 3) (p 0)) → ((BandVectors.1 (p 3) (p 0) = -I * xv) → ((xa = e * - BandVectors.2 (p 3) (p 0)) → ((BandVectors.2 (p 3) (p 0) = -e * xa) → ((BandVectors.1 (p - 3) (p 0) - BandVectors.1 (p 0) (p 3) = -I * xv - xv) → ((BandVectors.1 (p 3) (p 0) + - BandVectors.1 (p 0) (p 3) = -I * xv + xv) → ((BandVectors.2 (p 3) (p 0) - BandVectors.2 - (p 0) (p 3) = -e * xa - xa) → ((BandVectors.2 (p 3) (p 0) + BandVectors.2 (p 0) (p 3) = - -e * xa + xa) → ((F.q a.succ = p 0) → ((F.q ((a + 2).succ) = r 3 ∧ F.q ((a + 1).succ) = r - 2) → ((BandVectors.2 (F.q ((a + 2).succ)) (F.q ((a + 1).succ)) = wa) → ((F.slot + 2 = a + - 1) → (F.slot + 1 = a))))))))))))))))))))))))))))))))))))))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J r hr hrstep r1 r2 r3 - hparentR hzero I wv xv yv wa xa ya laws rr hrr lawsR win ain hv ha vflip aflip vflip' - aflip' centMinus centJ centK hcentR hcentJ e hxcoordV hxcoordA hxv hza hxa hzaA hminusVecV - hplusVecV hminusVecA hplusVecA houterA hindicesA hvecA hslotplus2 - rw [hslot] - fin_cases a <;> decide - private theorem hindicesJ : ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : @@ -1583,15 +1391,12 @@ theorem P4536T1AFrameD ⟨⟨p 0, Or.inl positiveA, p, hp.1, 0, rfl⟩, positiveA⟩ have hindicesA := FrameDiagonalProof.hindicesA C orientation base Rminus Rplus hminus hplus F a have hvecA := FrameDiagonalProof.hvecA C orientation base Rminus Rplus hminus hplus F a hindicesA - have hslotplus2 := FrameDiagonalProof.hslotplus2 C orientation base Rminus - Rplus hminus hplus F D a p hstep hslot J hr hrstep r1 r2 r3 hparentR hzero laws hrr lawsR - win ain hv ha vflip aflip vflip' aflip' centMinus centJ centK hcentR hcentJ hxcoordV - hxcoordA hxv hza hxa hzaA hminusVecV hplusVecV hminusVecA hplusVecA houterA hindicesA hvecA - have hslotplus1 := FrameDiagonalProof.hslotplus1 C orientation base Rminus - Rplus hminus hplus F D a p hstep hslot J hr hrstep r1 r2 r3 hparentR hzero laws hrr lawsR - win ain hv ha vflip aflip vflip' aflip' centMinus centJ centK hcentR hcentJ hxcoordV - hxcoordA hxv hza hxa hzaA hminusVecV hplusVecV hminusVecA hplusVecA houterA hindicesA hvecA - hslotplus2 + have hslotplus2 : F.slot + 2 = a + 1 := by + rw [hslot] + fin_cases a <;> decide + have hslotplus1 : F.slot + 1 = a := by + rw [hslot] + fin_cases a <;> decide have hindicesJ := FrameDiagonalProof.hindicesJ C orientation base Rminus Rplus hminus hplus F a hslotplus2 hslotplus1 have hvecJ := FrameDiagonalProof.hvecJ C orientation base Rminus Rplus diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean index 1c0252d7ba..b5b2542f85 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean @@ -716,24 +716,6 @@ private theorem htriple'At567 : hobsV.2.2).mp exact hbaseTouch.2.1 i U' hU'band hcenter' -private theorem hperiodVAt575 : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (T : ProtoTile), - let q := DiamondRecursiveQuadruple K - ∀ (w : GaussianInt), - let T' := TileTranslation T (-w) - (∀ (X : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), TileTranslation - (TileTranslation X a) b = TileTranslation (TileTranslation X b) a) → - ((TileTranslation T' w = T) → (∀ (i : Fin (3 : ℕ)), - let v := BandVectors.1 (q i.succ) (q 0) - TileTranslation (TileTranslation T' v) w = TileTranslation T v)) ) := by - classical - intro K T q w T' translate_swap hTrestore i v - rw [← hTrestore] - exact translate_swap T' v w - private theorem hcenterU' : (by classical @@ -1001,7 +983,7 @@ theorem P4564T2DiamondGeometry : have htripleW := (TouchingTripleCovariance T' (TileTranslation T' v) U' w).1.mp htriple' have hperiodV : TileTranslation (TileTranslation T' v) w = - TileTranslation T v := DiamondInterfaceGeometry.hperiodVAt575 K T w translate_swap + TileTranslation T v := DiamondInterfaceGeometry.hperiodVAt540 K T w translate_swap hTrestore i have hUrestore : TileTranslation U' w = U := by simpa [U'] using cancel_translation U diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean index 2dc712231f..1778ca4292 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean @@ -703,34 +703,6 @@ private theorem hbaseAt490 : rw [translated_center_diff U] exact hcent -private theorem hAneAt500 : - (by - classical - exact - ∀ (P : FordFareyParameter), - let F := FordTile P.q - ∀ (w : GaussianInt), (F.cells.Nonempty) → ((TileTranslation F w).cells.Nonempty) ) := by - classical - intro P F w hFcells - rw [(TileTranslationFormulas F w).1] - exact hFcells.image _ - -private theorem hBneAt503 : - (by - classical - exact - ∀ (P : FordFareyParameter), - let q := FordRecursiveQuadruple P - let F := FordTile P.q - ∀ (w : GaussianInt), (F.cells.Nonempty) → (∀ (i : Fin (3 : ℕ)), - let a := BandVectors.1 (q i.succ) (q 0) - (TileTranslation (TileTranslation F a) w).cells.Nonempty) ) := by - classical - intro P q F w hFcells i a - rw [(TileTranslationFormulas (TileTranslation F a) w).1, - (TileTranslationFormulas F a).1] - exact (hFcells.image _).image _ - private theorem hbaseAt517 : (by classical @@ -760,18 +732,6 @@ private theorem hbaseAt517 : · rw [translated_center_diff V] exact hVcent -private theorem hAneAt528 : - (by - classical - exact - ∀ (P : FordFareyParameter), - let F := FordTile P.q - ∀ (w : GaussianInt), (F.cells.Nonempty) → ((TileTranslation F w).cells.Nonempty) ) := by - classical - intro P F w hFcells - rw [(TileTranslationFormulas F w).1] - exact hFcells.image _ - end FordInterfaceGeometry theorem P4564T2FordGeometry (P : FordFareyParameter) (hP : 1 < P.q) @@ -951,8 +911,8 @@ theorem P4564T2FordGeometry (P : FordFareyParameter) (hP : 1 < P.q) (TileTranslation (TileTranslation F a) w) (TileTranslation (TileTranslation U (-w)) w) at hmove rw [translate_cancel U] at hmove - have hAne := FordInterfaceGeometry.hAneAt500 P w hFcells - have hBne := FordInterfaceGeometry.hBneAt503 P w hFcells i + have hAne := FordInterfaceGeometry.hAneAt467 P w hFcells + have hBne := FordInterfaceGeometry.hBneAt470 P w hFcells i exact (triple_same_cells (TileTranslation F w) T (TileTranslation (TileTranslation F a) w) (TileTranslation T a) U hcellsT.symm (translated_root_cells a) hAne hBne).mp hmove @@ -970,7 +930,7 @@ theorem P4564T2FordGeometry (P : FordFareyParameter) (hP : 1 < P.q) (TileTranslation (TileTranslation U (-w)) w) (TileTranslation (TileTranslation V (-w)) w) at hmove rw [translate_cancel U, translate_cancel V] at hmove - have hAne := FordInterfaceGeometry.hAneAt528 P w hFcells + have hAne := FordInterfaceGeometry.hAneAt467 P w hFcells exact (triple_same_root (TileTranslation F w) T U V hcellsT.symm hAne).mp hmove diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean b/LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean index a54af0501a..99ac40a09f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean +++ b/LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean @@ -45,25 +45,6 @@ private theorem hdistAt190 : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)) nlinarith [hn, hsum, hyone] -private theorem hdistAt273 : - ∀ (a : GaussianInt), ∀ (u : ℂ), ∀ (p : ℂ), ((p.re - u.re)^2 + (p.im - u.im)^2 = 1) → ((p.im - - u.im ≤ 1) → ((((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = ⟨u.re, u.im + 2⟩) → (1 - ≤ ‖p - ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)‖))) := by - classical - intro a u p hsum hyone hupper - have hs : Complex.normSq - (p - ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)) = - (p.re - u.re)^2 + (p.im - (u.im + 2))^2 := by - rw [hupper] - simp [Complex.normSq, Complex.sub_re, Complex.sub_im, pow_two] - have hn : ‖p - ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)‖^2 = - (p.re - u.re)^2 + (p.im - (u.im + 2))^2 := by - rw [← Complex.normSq_eq_norm_sq] - exact hs - have hnn := norm_nonneg (p - - ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex)) - nlinarith [hn, hsum, hyone] - private theorem hdistAt357 : ∀ (a : GaussianInt), ∀ (u : ℂ), ∀ (p : ℂ), ((p.re - u.re)^2 + (p.im - u.im)^2 = 1) → ((-1 ≤ p.im - u.im) → ((((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex) = ⟨u.re, u.im - 2⟩) → @@ -83,25 +64,6 @@ private theorem hdistAt357 : ((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex)) nlinarith [hn, hsum, hyminus] -private theorem hdistAt445 : - ∀ (a : GaussianInt), ∀ (u : ℂ), ∀ (p : ℂ), ((p.re - u.re)^2 + (p.im - u.im)^2 = 1) → ((-1 ≤ - p.im - u.im) → ((((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex) = ⟨u.re, u.im - 2⟩) → - (1 ≤ ‖p - ((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex)‖))) := by - classical - intro a u p hsum hyminus hbelow - have hs : Complex.normSq - (p - ((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex)) = - (p.re - u.re)^2 + (p.im - (u.im - 2))^2 := by - rw [hbelow] - simp [Complex.normSq, Complex.sub_re, Complex.sub_im, pow_two] - have hn : ‖p - ((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex)‖^2 = - (p.re - u.re)^2 + (p.im - (u.im - 2))^2 := by - rw [← Complex.normSq_eq_norm_sq] - exact hs - have hnn := norm_nonneg (p - - ((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex)) - nlinarith [hn, hsum, hyminus] - private theorem hQimage : ∀ (a : GaussianInt), ∀ (u : ℂ), (u = (GaussianInt.toComplex : GaussianInt → ℂ) ((1 : GaussianInt) + (2 : GaussianInt) * a)) → ( @@ -416,54 +378,6 @@ private theorem hupper'At534 : simp only [GaussianInt.toComplex_add, GaussianInt.toComplex_mul, GaussianInt.toComplex_one] -private theorem hLAt542 : - ∀ (a : GaussianInt), 2 * (GaussianInt.toComplex a).re = 2 * (a.re : Real) := by - classical - intro a - calc - _ = 2 * ((a.re : ℤ) : Real) := by rw [← GaussianInt.intCast_re] - _ = _ := rfl - -private theorem hsumAt566 : - ∀ (u : ℂ), ∀ (p : ℂ), (‖p - u‖ = (1 : ℝ)) → ((p.re - u.re)^2 + (p.im - u.im)^2 = 1) := by - classical - intro u p hnorm - have hs : Complex.normSq (p - u) = 1 := by - calc - Complex.normSq (p - u) = ‖p - u‖^2 := Complex.normSq_eq_norm_sq _ - _ = 1 := by rw [hnorm]; norm_num - change (p - u).re * (p - u).re + (p - u).im * (p - u).im = 1 at hs - rw [Complex.sub_re, Complex.sub_im] at hs - nlinarith [hs] - -private theorem hupperAt575 : - ∀ (a : GaussianInt), ∀ (u : ℂ), ((u : Complex) = ⟨2 * (a.re : Real) + 1, 2 * (a.im : Real)⟩) - → (((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = ⟨u.re, u.im + 2⟩) := by - classical - intro a u hu - rw [GaussianInt.toComplex_def₂] - apply Complex.ext <;> simp [hu, Zsqrtd.re_add, Zsqrtd.re_mul, - Zsqrtd.im_add, Zsqrtd.im_mul]; ring - -private theorem hownAt601 : - ∀ (a : GaussianInt), ∀ (u : ℂ), (u = (GaussianInt.toComplex : GaussianInt → ℂ) ((1 : - GaussianInt) + (2 : GaussianInt) * a)) → ((1 + GaussianInt.toComplex 2 * - GaussianInt.toComplex a) = u) := by - classical - intro a u huDef - rw [huDef] - simp only [GaussianInt.toComplex_add, GaussianInt.toComplex_mul, - GaussianInt.toComplex_one] - -private theorem hupper'At607 : - ∀ (a : GaussianInt), (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a + - GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) = - GaussianInt.toComplex (1 + 2 * a + 2 * (⟨0, 1⟩ : GaussianInt)) := by - classical - intro a - simp only [GaussianInt.toComplex_add, GaussianInt.toComplex_mul, - GaussianInt.toComplex_one] - private theorem hLzAt615 : ∀ (a : GaussianInt), 2 * (((a - ⟨0, 1⟩ : GaussianInt).re : ℤ) : Real) = 2 * (GaussianInt.toComplex a).re := by @@ -472,18 +386,6 @@ private theorem hLzAt615 : rw [GaussianInt.intCast_re, GaussianInt.toComplex_sub, Complex.sub_re] simp -private theorem hsumAt639 : - ∀ (u : ℂ), ∀ (p : ℂ), (‖p - u‖ = (1 : ℝ)) → ((p.re - u.re)^2 + (p.im - u.im)^2 = 1) := by - classical - intro u p hnorm - have hs : Complex.normSq (p - u) = 1 := by - calc - Complex.normSq (p - u) = ‖p - u‖^2 := Complex.normSq_eq_norm_sq _ - _ = 1 := by rw [hnorm]; norm_num - change (p - u).re * (p - u).re + (p - u).im * (p - u).im = 1 at hs - rw [Complex.sub_re, Complex.sub_im] at hs - nlinarith [hs] - private theorem hbelowAt648 : ∀ (a : GaussianInt), ∀ (u : ℂ), ((u : Complex) = ⟨2 * (a.re : Real) + 1, 2 * (a.im : Real)⟩) → (((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex) = ⟨u.re, u.im - 2⟩) := by @@ -513,55 +415,6 @@ private theorem hown'At681 : GaussianInt.toComplex_one, GaussianInt.toComplex_sub] ring -private theorem hLzAt692 : - ∀ (a : GaussianInt), 2 * (((a - ⟨0, 1⟩ : GaussianInt).re : ℤ) : Real) = 2 * - (GaussianInt.toComplex a).re := by - classical - intro a - rw [GaussianInt.intCast_re, GaussianInt.toComplex_sub, Complex.sub_re] - simp - -private theorem hsumAt716 : - ∀ (u : ℂ), ∀ (p : ℂ), (‖p - u‖ = (1 : ℝ)) → ((p.re - u.re)^2 + (p.im - u.im)^2 = 1) := by - classical - intro u p hnorm - have hs : Complex.normSq (p - u) = 1 := by - calc - Complex.normSq (p - u) = ‖p - u‖^2 := Complex.normSq_eq_norm_sq _ - _ = 1 := by rw [hnorm]; norm_num - change (p - u).re * (p - u).re + (p - u).im * (p - u).im = 1 at hs - rw [Complex.sub_re, Complex.sub_im] at hs - nlinarith [hs] - -private theorem hbelowAt725 : - ∀ (a : GaussianInt), ∀ (u : ℂ), ((u : Complex) = ⟨2 * (a.re : Real) + 1, 2 * (a.im : Real)⟩) - → (((1 + 2 * (a - ⟨0, 1⟩) : GaussianInt) : Complex) = ⟨u.re, u.im - 2⟩) := by - classical - intro a u hu - rw [GaussianInt.toComplex_def₂] - apply Complex.ext <;> simp [hu, Zsqrtd.re_add, Zsqrtd.re_mul, - Zsqrtd.im_add, Zsqrtd.im_mul, Zsqrtd.re_sub, Zsqrtd.im_sub] <;> ring - -private theorem hbelow'At751 : - ∀ (a : GaussianInt), (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex (a - ⟨0, 1⟩ : - GaussianInt)) = GaussianInt.toComplex (1 + 2 * (a - ⟨0, 1⟩)) := by - classical - intro a - simp only [GaussianInt.toComplex_add, GaussianInt.toComplex_mul, - GaussianInt.toComplex_one] - -private theorem hown'At759 : - ∀ (a : GaussianInt), ∀ (u : ℂ), (u = (GaussianInt.toComplex : GaussianInt → ℂ) ((1 : - GaussianInt) + (2 : GaussianInt) * a)) → ((1 + GaussianInt.toComplex 2 * - GaussianInt.toComplex (a - ⟨0, 1⟩ : GaussianInt) + GaussianInt.toComplex 2 * - GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) = u) := by - classical - intro a u huDef - rw [huDef] - simp only [GaussianInt.toComplex_add, GaussianInt.toComplex_mul, - GaussianInt.toComplex_one, GaussianInt.toComplex_sub] - ring - private theorem hγcontinuous : ∀ (u : ℂ), let γ (left upper : Bool) (t : Real) : Complex := @@ -806,7 +659,7 @@ private theorem upperRightRootGap : simp only [Int.reduceNeg, GaussianInt.intCast_re, P4828T1Evaluate, List.foldl_nil, Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, one_ne_zero, Fin.reduceEq, or_self, decide_false, or_true, decide_true, A, roots] - have hL := UnitIncidenceDetails.hLAt542 a + have hL := UnitIncidenceDetails.hLAt468 a rw [hL] rw [P4984T1RootGaps.2.1 a] ext p @@ -829,11 +682,11 @@ private theorem upperRightRootGap : rw [hu]; simp [GaussianInt.intCast_re] have huIm : u.im = 2 * (GaussianInt.toComplex a).im := by rw [hu]; simp [GaussianInt.intCast_im] - have hsum := UnitIncidenceDetails.hsumAt566 u + have hsum := UnitIncidenceDetails.hsumAt494 u p hnorm have hyone : p.im - u.im ≤ 1 := by nlinarith [hsum] - have hupper := UnitIncidenceDetails.hupperAt575 a u hu - have hdist := UnitIncidenceProof.hdistAt273 a u p hsum hyone hupper + have hupper := UnitIncidenceDetails.hupperAt503 a u hu + have hdist := UnitIncidenceProof.hdistAt190 a u p hsum hyone hupper refine ⟨?_, hnorm⟩ change (2 * (GaussianInt.toComplex a).re + 1 ≤ p.re ∧ p.re ≤ 2 * (GaussianInt.toComplex a).re + 2 ∧ @@ -854,13 +707,13 @@ private theorem upperRightRootGap : · rw [← huIm] nlinarith [hyone] · have hown : (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a) = u := - UnitIncidenceDetails.hownAt601 a u huDef + UnitIncidenceDetails.hownAt528 a u huDef rw [hown] linarith [hnorm] · have hupper' : (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a + GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) = GaussianInt.toComplex (1 + 2 * a + 2 * (⟨0, 1⟩ : GaussianInt)) := - UnitIncidenceDetails.hupper'At607 a + UnitIncidenceDetails.hupper'At534 a rw [hupper'] exact hdist @@ -910,7 +763,7 @@ private theorem lowerLeftRootGap : rw [hu]; simp [GaussianInt.intCast_re] have huIm : u.im = 2 * (GaussianInt.toComplex a).im := by rw [hu]; simp [GaussianInt.intCast_im] - have hsum := UnitIncidenceDetails.hsumAt639 u + have hsum := UnitIncidenceDetails.hsumAt494 u p hnorm have hyminus : -1 ≤ p.im - u.im := by nlinarith [hsum] have hbelow := UnitIncidenceDetails.hbelowAt648 a u hu @@ -969,7 +822,7 @@ private theorem lowerRightRootGap : simp only [Int.reduceNeg, GaussianInt.intCast_re, P4828T1Evaluate, List.foldl_nil, Fin.isValue, Matrix.cons_val, map_sub, Complex.sub_re, GaussianInt.re_toComplex, Int.cast_zero, sub_zero, Fin.reduceEq, or_self, decide_false, A, roots] - have hLz := UnitIncidenceDetails.hLzAt692 a + have hLz := UnitIncidenceDetails.hLzAt615 a rw [← hLz] rw [P4984T1RootGaps.2.1 (a - ⟨0, 1⟩)] ext p @@ -993,11 +846,11 @@ private theorem lowerRightRootGap : rw [hu]; simp [GaussianInt.intCast_re] have huIm : u.im = 2 * (GaussianInt.toComplex a).im := by rw [hu]; simp [GaussianInt.intCast_im] - have hsum := UnitIncidenceDetails.hsumAt716 u + have hsum := UnitIncidenceDetails.hsumAt494 u p hnorm have hyminus : -1 ≤ p.im - u.im := by nlinarith [hsum] - have hbelow := UnitIncidenceDetails.hbelowAt725 a u hu - have hdist := UnitIncidenceProof.hdistAt445 a u p hsum hyminus hbelow + have hbelow := UnitIncidenceDetails.hbelowAt648 a u hu + have hdist := UnitIncidenceProof.hdistAt357 a u p hsum hyminus hbelow refine ⟨?_, hnorm⟩ change (2 * (GaussianInt.toComplex a).re + 1 ≤ p.re ∧ p.re ≤ 2 * (GaussianInt.toComplex a).re + 2 ∧ @@ -1020,14 +873,14 @@ private theorem lowerRightRootGap : · have hbelow' : (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex (a - ⟨0, 1⟩ : GaussianInt)) = GaussianInt.toComplex (1 + 2 * (a - ⟨0, 1⟩)) := - UnitIncidenceDetails.hbelow'At751 a + UnitIncidenceDetails.hbelow'At673 a rw [GaussianInt.toComplex_sub] at hbelow' rw [hbelow'] exact hdist · have hown' : (1 + GaussianInt.toComplex 2 * GaussianInt.toComplex (a - ⟨0, 1⟩ : GaussianInt) + GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) = u := - UnitIncidenceDetails.hown'At759 a u huDef + UnitIncidenceDetails.hown'At681 a u huDef rw [GaussianInt.toComplex_sub] at hown' rw [hown'] linarith [hnorm] diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean index ca1dd2d9c8..3843920129 100644 --- a/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean @@ -277,18 +277,6 @@ private theorem hpolyAt310 : intro K n x v r ring -private theorem hdvdAt315 : - (by - classical - exact - ∀ (K : DiamondParameter), ((2 : ℤ) * (((↑K.1 : ℤ) + (1 : ℤ)) * ((↑K.1 : ℤ) + (1 - : ℤ) - (1 : ℤ)) / (2 : ℤ)) = ((↑K.1 : ℤ) + (1 : ℤ)) * ((↑K.1 : ℤ) + (1 : ℤ) - - (1 : ℤ))) → ((2:Int) ∣ (K.1:Int)*((K.1:Int)+1)) ) := by - classical - intro K ht3 - refine ⟨((K.1:Int)+1)*(K.1:Int)/2, ?_⟩ - simpa [mul_comm] using ht3.symm - private theorem hs1At341 : (by classical @@ -410,27 +398,6 @@ private theorem hfAt425 : rw [he, hfloorOdd (-(K.1:Int))] ring -private theorem habsTAt438 : - (by - classical - exact - ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( - let n : Int := K.1 - ∀ (x : GaussianInt), ((0 : ℤ) ≤ x.im ∧ x.im ≤ (2 : ℤ) * n ∧ -n ≤ x.re ∧ x.re ≤ n ∧ -x.im - - (1 : ℤ) ≤ x.re ∧ x.re ≤ x.im + (1 : ℤ) ∧ -((2 : ℤ) * n - x.im + (1 : ℤ)) ≤ x.re ∧ - x.re ≤ (2 : ℤ) * n - x.im + (1 : ℤ)) → (((0 : ℤ) ≤ x.im ∧ x.im ≤ (2 : ℤ) * (↑K.1 - : ℤ) ∧ (2 : ℤ) * (↑K.1 : ℤ) ≤ x.re + (↑K.1 : ℤ) ∧ x.re ≤ (↑K.1 : ℤ) + - (2 : ℤ) * (↑K.1 : ℤ) ∧ -x.im ≤ x.re - (2 : ℤ) * (↑K.1 : ℤ) + (1 : ℤ) ∧ x.re - ≤ x.im + (1 : ℤ) + (2 : ℤ) * (↑K.1 : ℤ) ∧ x.im ≤ (1 : ℤ) + (x.re - (2 : ℤ) * - (↑K.1 : ℤ)) + (2 : ℤ) * (↑K.1 : ℤ) ∧ x.re ≤ (2 : ℤ) * (↑K.1 : ℤ) - - x.im + (1 : ℤ) + (2 : ℤ) * (↑K.1 : ℤ)) → (|(K.1:Int)-2*(K.1:Int)| = (K.1:Int)))) - ) := by - classical - intro K hk n x hxy hxyD - rw [show (K.1:Int)-2*(K.1:Int) = -(K.1:Int) by ring] - rw [abs_of_neg (show -(K.1:Int) < 0 by omega)] - simp - private theorem hfAt446 : (by classical @@ -443,27 +410,6 @@ private theorem hfAt446 : rw [he, hfloorEven] ring -private theorem habsTAt459 : - (by - classical - exact - ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( - let n : Int := K.1 - ∀ (x : GaussianInt), ((0 : ℤ) ≤ x.im ∧ x.im ≤ (2 : ℤ) * n ∧ -n ≤ x.re ∧ x.re ≤ n ∧ -x.im - - (1 : ℤ) ≤ x.re ∧ x.re ≤ x.im + (1 : ℤ) ∧ -((2 : ℤ) * n - x.im + (1 : ℤ)) ≤ x.re ∧ - x.re ≤ (2 : ℤ) * n - x.im + (1 : ℤ)) → (((0 : ℤ) ≤ x.im ∧ x.im ≤ (2 : ℤ) * (↑K.1 - : ℤ) ∧ (2 : ℤ) * (↑K.1 : ℤ) ≤ x.re + (↑K.1 : ℤ) ∧ x.re ≤ (↑K.1 : ℤ) + - (2 : ℤ) * (↑K.1 : ℤ) ∧ -x.im ≤ x.re - (2 : ℤ) * (↑K.1 : ℤ) + (1 : ℤ) ∧ x.re - ≤ x.im + (1 : ℤ) + (2 : ℤ) * (↑K.1 : ℤ) ∧ x.im ≤ (1 : ℤ) + (x.re - (2 : ℤ) * - (↑K.1 : ℤ)) + (2 : ℤ) * (↑K.1 : ℤ) ∧ x.re ≤ (2 : ℤ) * (↑K.1 : ℤ) - - x.im + (1 : ℤ) + (2 : ℤ) * (↑K.1 : ℤ)) → (|(K.1:Int)-2*(K.1:Int)| = (K.1:Int)))) - ) := by - classical - intro K hk n x hxy hxyD - rw [show (K.1:Int)-2*(K.1:Int) = -(K.1:Int) by ring] - rw [abs_of_neg (show -(K.1:Int) < 0 by omega)] - simp - private theorem hfAt467 : (by classical @@ -606,7 +552,7 @@ private theorem hpositive : have ht2 := tri ((K.1:Int)-r) have hpoly := DiamondBoundaryDetails.hpolyAt310 K x have ht3 := tri ((K.1:Int)+1) - have hdvd := DiamondBoundaryDetails.hdvdAt315 K ht3 + have hdvd := DiamondBoundaryDetails.hdvdAt275 K ht3 have ht3' : 2*((K.1:Int)*((K.1:Int)+1)/2) = (K.1:Int)*((K.1:Int)+1) := by simpa [mul_comm] using ht3 rw [Int.neg_ediv_of_dvd hdvd] @@ -705,7 +651,7 @@ private theorem hpositive : rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), hF _ (by simpa [hxe] using hx)] simp only [n, Zsqrtd.re_sub, Zsqrtd.im_sub, Int.natCast_natAbs] - have habsT := DiamondBoundaryDetails.habsTAt438 K + have habsT := DiamondBoundaryDetails.habsTAt417 K hk x hxy hxyD rw [habsT, habsB] simp only [sub_zero] @@ -721,7 +667,7 @@ private theorem hpositive : rw [hF _ (by simpa [P5352T2PlacementData, n, hxe] using hxD), hF _ (by simpa [hxe] using hx)] simp only [n, Zsqrtd.re_sub, Zsqrtd.im_sub, Int.natCast_natAbs] - have habsT := DiamondBoundaryDetails.habsTAt459 K + have habsT := DiamondBoundaryDetails.habsTAt417 K hk x hxy hxyD rw [habsT, habsB] simp only [sub_zero] diff --git a/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean index 6f1819e69d..b7f394650c 100644 --- a/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean @@ -622,21 +622,6 @@ private theorem hnewAdj : t', BandPackingSymmetryProperCovariance ginv bundle.normalizedPresentation hq, hrootCoord, hselectedCoord, hcentOriginal, hslopeReInv, hslopeImInv⟩ -private theorem actionCurvatureAt449 : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (c : CircleCoordinates), (BandPackingSymmetryCircleAction - g c).1 = c.1 ) := by - classical - intro g - induction g with - | identity => intro c; rfl - | negate => intro c; rfl - | conjugate => intro c; rfl - | shift w => intro c; rfl - | comp a b iha ihb => intro c; simp [BandPackingSymmetryCircleAction, iha, ihb] - private theorem hsizeOriginal : (by classical @@ -1050,7 +1035,7 @@ theorem P5630T1MarkedRightOdometerAdjacencyReduction : hselectedCoord (MarkedRightAdjacencyGeometry.hOFixedOriginal C T T₀ h h₀ x bundle ginv htileL hfunL hOFixedInv (MarkedRightAdjacencyGeometry.hrootAction C T T₀ h h₀ x bundle ginv hcircleL hnorm)) hOSelectedOriginal hslopeFixedOriginal hcentOriginal hrootCoord - have actionCurvature := MarkedRightAdjacencyGeometry.actionCurvatureAt449 + have actionCurvature := MarkedRightAdjacencyGeometry.actionCurvatureAt244 have hsizeOriginal := MarkedRightAdjacencyGeometry.hsizeOriginal C T T₀ h h₀ x bundle C' hsize ginv hnorm actionCurvature hinverseProper hinversePositive hinverseCircle have hcoverOriginal := MarkedRightAdjacencyGeometry.hcoverOriginal C T T₀ h h₀ x markedData diff --git a/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean b/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean index 91e7f39d41..ea4dc9d9af 100644 --- a/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean +++ b/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean @@ -1471,58 +1471,6 @@ private theorem hcell2side : (h.1.symm.trans hA.1)) · exact Or.inl (hGood.2.trans h.2) -private theorem hside0At880 : - (by - classical - exact - ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (x : GaussianInt), ∀ (jAB : Fin (4 : ℕ)), - (LatticeVertexIncidentCell x jAB ∈ T0.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : - Fin (4 : ℕ))) ∈ T0'.cells ∨ LatticeVertexIncidentCell x jAB ∈ T0'.cells ∧ - LatticeVertexIncidentCell x (jAB + (1 : Fin (4 : ℕ))) ∈ T0.cells) → - (LatticeVertexIncidentCell x jAB ∈ T0.cells ∨ LatticeVertexIncidentCell x jAB ∈ - T0'.cells) ) := by - classical - intro T0 T0' x jAB htransABx - rcases htransABx with h | h - · exact Or.inl h.1 - · exact Or.inr h.1 - -private theorem hside1At885 : - (by - classical - exact - ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (x : GaussianInt), ∀ (jAB : Fin (4 : ℕ)), - (LatticeVertexIncidentCell x jAB ∈ T0.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : - Fin (4 : ℕ))) ∈ T0'.cells ∨ LatticeVertexIncidentCell x jAB ∈ T0'.cells ∧ - LatticeVertexIncidentCell x (jAB + (1 : Fin (4 : ℕ))) ∈ T0.cells) → - (LatticeVertexIncidentCell x (jAB + 1) ∈ T0.cells ∨ LatticeVertexIncidentCell x (jAB - + 1) ∈ T0'.cells) ) := by - classical - intro T0 T0' x jAB htransABx - rcases htransABx with h | h - · exact Or.inr h.2 - · exact Or.inl h.2 - -private theorem ho01neAt890 : - (by - classical - exact - ∀ (ι : Type), ∀ (owner : GaussianInt → ι), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (ia - : ι), ∀ (ib : ι), (ia ≠ ib) → (∀ (x : GaussianInt), - let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => - if LatticeVertexIncidentCell x j ∈ T0.cells then 0 - else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 - ∀ (jAB : Fin (4 : ℕ)), - let o0 := owner (LatticeVertexIncidentCell x jAB) - let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) - ((outerLabel x jAB = 0 ∧ o0 = ia ∧ o1 = ib) ∨ (outerLabel x jAB = 1 ∧ o0 = ib ∧ o1 = ia)) - → (o0 ≠ o1)) ) := by - classical - intro ι owner T0 T0' ia ib hidxne x outerLabel jAB o0 o1 hownerAligned' heq - rcases hownerAligned' with hA | hA - · exact hidxne (hA.2.1.symm.trans (heq.trans hA.2.2)) - · exact hidxne (hA.2.1.symm.trans (heq.trans hA.2.2)).symm - private theorem ho02neAt895 : (by classical @@ -1958,9 +1906,9 @@ theorem P5635T1EndpointDiagonalOwnership {ι : Type} simpa [o3] using owner_eq_endpoint x (jAB + 3) hcell3 have hcell2side := EndpointDiagonalGeometry.hcell2side ι owner T0 T0' R ia ib x label_side_mem hsectorCover jAB hlabelsAB hownerAligned' hGood - have hside0 := EndpointDiagonalGeometry.hside0At880 T0 T0' x jAB htransABx - have hside1 := EndpointDiagonalGeometry.hside1At885 T0 T0' x jAB htransABx - have ho01ne := EndpointDiagonalGeometry.ho01neAt890 ι owner T0 T0' ia ib hidxne x jAB + have hside0 := EndpointDiagonalGeometry.hside0At763 T0 T0' x jAB htransABx + have hside1 := EndpointDiagonalGeometry.hside1At768 T0 T0' x jAB htransABx + have ho01ne := EndpointDiagonalGeometry.ho01neAt773 ι owner T0 T0' ia ib hidxne x jAB hownerAligned' have ho02ne := EndpointDiagonalGeometry.ho02neAt895 ι P owner T0 T0' R U V ia ib hUidx hVidx hUsub hVsub x label_eq_zero_mem label_eq_one_mem owner_ne_T0_index owner_ne_T0'_index diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean index f775f6f4a7..8aabd1e0ab 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean @@ -383,22 +383,6 @@ private theorem hr'At433 : intro q slopeShift kl mn i hr exact_mod_cast hr -private theorem hslope'At443 : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), - let slopeShift (kl : Int × Int) : GaussianInt := - (kl.1 : GaussianInt) * BandVectors.2 (q 1) (q 0) + - (kl.2 : GaussianInt) * BandVectors.2 (q 2) (q 0) - ∀ (kl : ℤ × ℤ), ∀ (mn : ℤ × ℤ), ∀ (i : Fin (3 : ℕ)), (slopeShift kl - slopeShift mn = - BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))) → (slopeShift mn - slopeShift kl = - -BandVectors.2 (q i.succ) (q 0)) ) := by - classical - intro q slopeShift kl mn i hslope - rw [← hslope] - ring - private theorem hi'At448 : (by classical @@ -600,7 +584,7 @@ private theorem adjacentCompatibility : -1 * (BandVectors.2 (q i.succ) (q 0)).im have hslope := slope_step mn kl i hstep' have hslope' : slopeShift mn - slopeShift kl = - -BandVectors.2 (q i.succ) (q 0) := PositiveTranslationGeometry.hslope'At443 q + -BandVectors.2 (q i.succ) (q 0) := PositiveTranslationGeometry.hslope'At428 q kl mn i hslope have hi := congrArg (fun z : GaussianInt => z.im) hslope' have hi' : ((slopeShift mn).im : ℝ) - (slopeShift kl).im = diff --git a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean index 21ed8b3b0b..d72932d103 100644 --- a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase @@ -27,228 +28,6 @@ namespace ApollonianSuperharmonic namespace RightLatticeTransportGeometry -private theorem hTne : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (T : ProtoTile), ∀ (h : - PartialOdometer), ∀ (p : ℝ × ℝ), (TileOdometer (q (0 : Fin (4 : ℕ))) T h) → - ((PartialOdometerSlope h = some p) → (T.cells.Nonempty))) ) := by - classical - intro q hq T h p hO hp - have hd := PositiveCurvatureTileOdometerDomain (q 0) T h - (ProperBandCurvatureStructure q hq).1 hO - by_contra hn - have hde : (h.domain : Set GaussianInt) = {T.anchor} := by - rw [hd] - simp [FootprintVertices, hn] - have hs : (PartialOdometerSquares h).Nonempty := by - by_contra hs - simp [PartialOdometerSlope, hs] at hp - rcases hs with ⟨x, hx⟩ - simp only [PartialOdometerSquares, Finset.mem_filter] at hx - have hz : x + 1 = T.anchor := by - apply Set.mem_singleton_iff.mp - rw [← hde] - exact hx.2.1 - have hz0 : x = T.anchor := by - apply Set.mem_singleton_iff.mp - rw [← hde] - exact hx.1 - have hzbad : x + 1 = x := hz.trans hz0.symm - have hzbad' := congrArg (fun z : GaussianInt => z.re) hzbad - norm_num at hzbad' - -private theorem hT'ne : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (T' : ProtoTile), ∀ (h' : - PartialOdometer), ∀ (p' : ℝ × ℝ), (TileOdometer (q (0 : Fin (4 : ℕ))) T' h') → - ((PartialOdometerSlope h' = some p') → (T'.cells.Nonempty))) ) := by - classical - intro q hq T' h' p' hO' hp' - have hd := PositiveCurvatureTileOdometerDomain (q 0) T' h' - (ProperBandCurvatureStructure q hq).1 hO' - by_contra hn - have hde : (h'.domain : Set GaussianInt) = {T'.anchor} := by - rw [hd] - simp [FootprintVertices, hn] - have hs : (PartialOdometerSquares h').Nonempty := by - by_contra hs - simp [PartialOdometerSlope, hs] at hp' - rcases hs with ⟨x, hx⟩ - simp only [PartialOdometerSquares, Finset.mem_filter] at hx - have hz : x + 1 = T'.anchor := by - apply Set.mem_singleton_iff.mp - rw [← hde] - exact hx.2.1 - have hz0 : x = T'.anchor := by - apply Set.mem_singleton_iff.mp - rw [← hde] - exact hx.1 - have hzbad : x + 1 = x := hz.trans hz0.symm - have hzbad' := congrArg (fun z : GaussianInt => z.re) hzbad - norm_num at hzbad' - -private theorem hsr : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (p : ℝ × ℝ), - (PartialOdometerSlope h = some p) → ((T.cells.Nonempty) → ((Finset.Nonempty T.cells → - PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = Option.map - (BandPackingSymmetrySlopeAction g T) (PartialOdometerSlope h)) → - (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h) = some - (BandPackingSymmetrySlopeAction g T p)))) ) := by - classical - intro g T h p hp hTne hST - simpa [Option.map] using (hST hTne).trans (congrArg (Option.map - (BandPackingSymmetrySlopeAction g T)) hp) - -private theorem hsr' : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), ∀ (p' : ℝ × - ℝ), (PartialOdometerSlope h' = some p') → ((T'.cells.Nonempty) → ((Finset.Nonempty - T'.cells → PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h') = - Option.map (BandPackingSymmetrySlopeAction g T') (PartialOdometerSlope h')) → - (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h') = some - (BandPackingSymmetrySlopeAction g T' p')))) ) := by - classical - intro g T' h' p' hp' hT'ne hST' - simpa [Option.map] using (hST' hT'ne).trans (congrArg (Option.map - (BandPackingSymmetrySlopeAction g T')) hp') - -private theorem centroid_transport : - (by - classical - exact - ∀ (a : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (v : GaussianInt), - TileCentroid V - TileCentroid U = GaussianRealPoint v → TileCentroid - (BandPackingSymmetryTileAction a V) - TileCentroid (BandPackingSymmetryTileAction a - U) = GaussianRealPoint (BandPackingSymmetryVectorAction a v) ) := by - classical - intro a U V v hv - have hc := (P5625T1CentroidSlopeDifferenceCovariance.2 - a U V (0, 0) (0, 0) v 0 1 - (by simpa using hv) (by ext <;> simp [GaussianRealPoint])).1 - simpa only [one_smul, P5625T1CentroidSlopeDifferenceCovariance.1] using hc - -private theorem vector_signAt246 : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), - (BandPackingSymmetryScopedPhase g q negative) → (∀ (j : Fin 3), GaussianRealPoint - (BandPackingSymmetryVectorAction g (BandVectors.1 (q j.succ) (q 0))) = (if negative - then (-1 : ℝ) else 1) • GaussianRealPoint (BandVectors.1 - (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g - then -j else j).succ) (BandPackingSymmetryQuadrupleAction g q 0))) ) := by - classical - intro g q negative hphase j - have hp := hphase j - dsimp [BandPackingSymmetryScopedPhase] at hp - have hv := hp.1 - by_cases hn : negative - · have hh := congrArg Neg.neg (congrArg GaussianRealPoint hv) - simpa [hn, GaussianRealPoint] using hh.symm - · have hh := (congrArg GaussianRealPoint hv).symm - simpa [hn, GaussianRealPoint] using hh - -private theorem vector_neg : - (by - classical - exact - ∀ (a : BandPackingSymmetry), ∀ (v : GaussianInt), BandPackingSymmetryVectorAction a (-v) - = -BandPackingSymmetryVectorAction a v ) := by - classical - intro a - induction a with - | identity => intro v; rfl - | negate => - intro v - rcases v with ⟨a, b⟩ - rfl - | conjugate => - intro v - rcases v with ⟨a, b⟩ - rfl - | shift w => intro v; rfl - | comp a b iha ihb => - intro v - change BandPackingSymmetryVectorAction a - (BandPackingSymmetryVectorAction b (-v)) = - -BandPackingSymmetryVectorAction a - (BandPackingSymmetryVectorAction b v) - rw [ihb, iha] - -private theorem affine_neg : - (by - classical - exact - ∀ (a : BandPackingSymmetry), ∀ (v : GaussianInt), ∀ (u : GaussianInt), - BandPackingSymmetryAffineVectorAction a (-v, -u) = - -BandPackingSymmetryAffineVectorAction a (v, u) ) := by - classical - intro a - induction a with - | identity => intro v u; rfl - | shift w => - intro v u - rcases v with ⟨va, vb⟩ - rcases u with ⟨ua, ub⟩ - rcases w with ⟨wa, wb⟩ - apply Prod.ext - · simp [BandPackingSymmetryAffineVectorAction, GaussianReflection] - · simp only [BandPackingSymmetryAffineVectorAction, Int.reduceNeg, GaussianReflection, - Zsqrtd.re_neg, Zsqrtd.im_neg, neg_neg, Prod.neg_mk, neg_add_rev] - have hrel : ({re := -va, im := vb} : GaussianInt) = - -({re := va, im := -vb} : GaussianInt) := by - ext <;> simp - rw [hrel] - ring - | negate => - intro v u - rcases v with ⟨va, vb⟩ - rcases u with ⟨ua, ub⟩ - rfl - | conjugate => - intro v u - rcases v with ⟨va, vb⟩ - rcases u with ⟨ua, ub⟩ - rfl - | comp a b iha ihb => - intro v u - change BandPackingSymmetryAffineVectorAction a - (BandPackingSymmetryAffineVectorAction b (-v, -u)) = _ - rw [ihb] - apply iha - -private theorem slope_transport : - (by - classical - exact - ∀ (a : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : ℝ × ℝ), ∀ (y : - ℝ × ℝ), ∀ (v : GaussianInt), ∀ (u : GaussianInt), TileCentroid V - TileCentroid U = - GaussianRealPoint v → x.1 - y.1 = (u.re : ℝ) → x.2 - y.2 = (u.im : ℝ) → - (BandPackingSymmetrySlopeAction a V x).1 - (BandPackingSymmetrySlopeAction a U y).1 = - (BandPackingSymmetryAffineVectorAction a (v, u)).2.re ∧ - (BandPackingSymmetrySlopeAction a V x).2 - (BandPackingSymmetrySlopeAction a U y).2 = - (BandPackingSymmetryAffineVectorAction a (v, u)).2.im ) := by - classical - intro a U V x y v u hc hx hy - have hp : x - y = (1 : ℝ) • GaussianRealPoint u := by - apply Prod.ext - · simpa [GaussianRealPoint] using hx - · simpa [GaussianRealPoint] using hy - have hs := (P5625T1CentroidSlopeDifferenceCovariance.2 - a U V x y v u 1 (by simpa using hc) hp).2 - constructor - · simpa [GaussianRealPoint] using congrArg Prod.fst hs - · simpa [GaussianRealPoint] using congrArg Prod.snd hs - private theorem vector_signAt350 : (by classical @@ -563,58 +342,6 @@ private theorem hcAt637 : intro q i e T T' hcent he simpa [he, GaussianRealPoint] using hcent -private theorem hcAt647 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' - : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 - : ℝ)) • GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((e = - true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 (q 0) (q - i.succ)))) ) := by - classical - intro q i e T T' hcent he - simpa [he] using hcent - -private theorem hcAt695 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' - : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 - : ℝ)) • GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((¬e = - true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (-(BandVectors.1 (q 0) - (q i.succ))))) ) := by - classical - intro q i e T T' hcent he - simpa [he, GaussianRealPoint] using hcent - -private theorem hcAt742 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' - : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 - : ℝ)) • GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((e = - true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 (q 0) (q - i.succ)))) ) := by - classical - intro q i e T T' hcent he - simpa [he] using hcent - -private theorem hcAt785 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (e : Bool), ∀ (T : ProtoTile), ∀ (T' - : ProtoTile), (TileCentroid T' - TileCentroid T = (if e = true then (1 : ℝ) else (-1 - : ℝ)) • GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((¬e = - true) → (TileCentroid T' - TileCentroid T = GaussianRealPoint (-(BandVectors.1 (q 0) - (q i.succ))))) ) := by - classical - intro q i e T T' hcent he - simpa [he, GaussianRealPoint] using hcent - end RightLatticeTransportGeometry namespace RightAdjacencyAssembly @@ -777,7 +504,7 @@ private theorem transportedAdjacency : · by_cases he : e = true · have hc : TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) := - RightLatticeTransportGeometry.hcAt647 q i e T T' hcent he + RightLatticeTransportGeometry.hcAt631 q i e T T' hcent he have hs := slope_transport g T T' p' p (BandVectors.1 (q 0) (q i.succ)) (BandVectors.2 (q 0) (q i.succ)) hc @@ -815,7 +542,7 @@ private theorem transportedAdjacency : affineRightIm] · have hc : TileCentroid T' - TileCentroid T = GaussianRealPoint (-(BandVectors.1 (q 0) (q i.succ))) := - RightLatticeTransportGeometry.hcAt695 q i e T T' hcent he + RightLatticeTransportGeometry.hcAt637 q i e T T' hcent he have hs := slope_transport g T T' p' p (-(BandVectors.1 (q 0) (q i.succ))) (-(BandVectors.2 (q 0) (q i.succ))) hc @@ -856,7 +583,7 @@ private theorem transportedAdjacency : · by_cases he : e = true · have hc : TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)) := - RightLatticeTransportGeometry.hcAt742 q i e T T' hcent he + RightLatticeTransportGeometry.hcAt631 q i e T T' hcent he have hs := slope_transport g T T' p' p (BandVectors.1 (q 0) (q i.succ)) (BandVectors.2 (q 0) (q i.succ)) hc (by simpa [he] using hslopeRe) (by simpa [he] using hslopeIm) @@ -897,7 +624,7 @@ private theorem transportedAdjacency : affineRightIm] · have hc : TileCentroid T' - TileCentroid T = GaussianRealPoint (-(BandVectors.1 (q 0) (q i.succ))) := - RightLatticeTransportGeometry.hcAt785 q i e T T' hcent he + RightLatticeTransportGeometry.hcAt637 q i e T T' hcent he have hs := slope_transport g T T' p' p (-(BandVectors.1 (q 0) (q i.succ))) (-(BandVectors.2 (q 0) (q i.succ))) hc @@ -993,17 +720,17 @@ theorem RightLatticeAdjacentPackingSymmetryTransport dsimp obtain ⟨negative, hphase, hvec⟩ := BandPackingSymmetryAffineVectorCovariance g q hq - have hTne := RightLatticeTransportGeometry.hTne q hq T h p hO hp - have hT'ne := RightLatticeTransportGeometry.hT'ne q hq T' h' p' hO' hp' + have hTne := LatticeAdjacentPackingSymmetryFacts.tileCellsNonempty (q 0) T h p hO hp + have hT'ne := LatticeAdjacentPackingSymmetryFacts.tileCellsNonempty (q 0) T' h' p' hO' hp' obtain ⟨hOT, _, hST⟩ := BandPackingSymmetryTileOdometerCovariance g (q 0) T h hO obtain ⟨hOT', _, hST'⟩ := BandPackingSymmetryTileOdometerCovariance g (q 0) T' h' hO' - have hsr := RightLatticeTransportGeometry.hsr g T h p hp hTne hST - have hsr' := RightLatticeTransportGeometry.hsr' g T' h' p' hp' hT'ne hST' - have centroid_transport := RightLatticeTransportGeometry.centroid_transport - have vector_sign (j : Fin 3) := RightLatticeTransportGeometry.vector_signAt246 g q negative + have hsr := LatticeAdjacentPackingSymmetryFacts.slopeAction g T h p hp hTne hST + have hsr' := LatticeAdjacentPackingSymmetryFacts.slopeAction g T' h' p' hp' hT'ne hST' + have centroid_transport := LatticeAdjacentPackingSymmetryFacts.centroidTransport + have vector_sign (j : Fin 3) := LatticeAdjacentPackingSymmetryFacts.vectorSign g q negative hphase j - have vector_neg := RightLatticeTransportGeometry.vector_neg - have affine_neg := RightLatticeTransportGeometry.affine_neg + have vector_neg := LatticeAdjacentPackingSymmetryFacts.vectorNegation + have affine_neg := LatticeAdjacentPackingSymmetryFacts.affineNegation have affine_first (a : BandPackingSymmetry) (v u : GaussianInt) : (BandPackingSymmetryAffineVectorAction a (v, u)).1 = BandPackingSymmetryVectorAction a v := @@ -1014,7 +741,7 @@ theorem RightLatticeAdjacentPackingSymmetryTransport have imag_coord (z : GaussianInt) : (GaussianInt.toComplex z).im = (z.im : ℝ) := (GaussianInt.intCast_im z).symm - have slope_transport := RightLatticeTransportGeometry.slope_transport + have slope_transport := LatticeAdjacentPackingSymmetryFacts.slopeTransport have vector_sign (j : Fin 3) := RightLatticeTransportGeometry.vector_signAt350 g q negative hphase j have vector_flip := RightLatticeTransportGeometry.vector_flip vector_neg From 5e970f10b5fb065dfa46a0ee07cf87a1b7a6370d Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Thu, 12 Nov 2026 18:00:07 +0000 Subject: [PATCH 08/23] Narrow private helper captures and strengthen boundary concatenation --- .../BandOrderedGeneralGeometricSectors.lean | 69 +-- ...eralSubtileInterfaceCertificateExists.lean | 157 +++--- ...PackingSymmetryAffineVectorCovariance.lean | 46 +- ...ndPackingSymmetryMarkedDataCovariance.lean | 324 ++++++------ .../BandVectorParentSums.lean | 1 - .../BoundaryStringConcatenation.lean | 76 +-- .../BoundaryStringOdometerRespect.lean | 5 - .../FordLeftBoundaryCompatibility.lean | 27 +- .../ForwardBoundaryStringData.lean | 47 +- ...tticeAdjacentPackingSymmetryTransport.lean | 2 - .../OdometerAdjacencyInduction.lean | 56 +-- .../OpposingBoundaryOdometerStrings.lean | 217 +++----- .../P3650T1LocalCoherence.lean | 39 +- .../P3934T1SectorContinuation.lean | 29 +- .../P3963T1ExteriorMixedCycleObstruction.lean | 70 +-- ...4055T1OrderedGeneralOppositeEndpoints.lean | 176 +++---- .../P4055T1PlacementNormalization.lean | 463 +++++++----------- .../P4158T1SmallerStringEdges.lean | 32 +- .../P4261T1CentralCoordinates.lean | 24 +- .../P4261T1RightCoordinates.lean | 50 +- .../P4261T2UnitInterface.lean | 29 +- .../P4366T1PrecursorPathLoop.lean | 28 +- .../P4418T3NestedCompanionEndpoint.lean | 210 +++----- .../P4418T3RoutedBlockCriterion.lean | 61 ++- .../P4418T3SelectedInterfaceExists.lean | 381 ++++++++------ .../P4536T1AFrameB.lean | 35 +- .../P4638T1EmptyFordLocalization.lean | 172 +++---- .../P4677T2PrecursorWalk.lean | 20 +- .../P5023T1CircularSide.lean | 93 ++-- .../PeriodicBoundaryWebLaplacian.lean | 48 +- ...tticeAdjacentPackingSymmetryTransport.lean | 4 - .../SimpleGridPathEndpointPairUnique.lean | 22 +- 32 files changed, 1238 insertions(+), 1775 deletions(-) diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean index f0d1f72ec2..b9705bce80 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean @@ -230,21 +230,13 @@ private theorem hpos : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let P := cert.modified - ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), ∀ - (a : PeriodicSubtileIndex), ∀ (x : GaussianInt), ∀ (j : Fin (4 : ℕ)), - (LatticeVertexIncidentCell x j ∈ (P.tile a).cells) → (∀ (k : Fin (4 : ℕ)), - let owner : Fin 4 → PeriodicSubtileIndex := fun r => - (hindexed (LatticeVertexIncidentCell x r)).choose - (owner j = a) → ((j ≠ k) → ((¬ (k = j + 1 ∨ j = k + 1)) → ((k = j + 2) → ( - let l := j + 1 - let m := j + 3 - j ≠ l ∧ j ≠ k ∧ j ≠ m ∧ l ≠ k ∧ l ≠ m ∧ k ≠ m))))) ) := by + ∀ (j k : Fin (4 : ℕ)), + k = j + (2 : Fin (4 : ℕ)) → + let l := j + (1 : Fin (4 : ℕ)); + let m := j + (3 : Fin (4 : ℕ)); + j ≠ l ∧ j ≠ k ∧ j ≠ m ∧ l ≠ k ∧ l ≠ m ∧ k ≠ m) := by classical - intro q cfg C₀ T cert P hindexed a x j hja k owner hja' hjk hnotconsecutive hop l m + intro j k hop l m rw [hop] fin_cases j <;> decide @@ -252,21 +244,12 @@ private theorem hlk : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let P := cert.modified - ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), ∀ - (a : PeriodicSubtileIndex), ∀ (x : GaussianInt), ∀ (j : Fin (4 : ℕ)), - (LatticeVertexIncidentCell x j ∈ (P.tile a).cells) → (∀ (k : Fin (4 : ℕ)), - let owner : Fin 4 → PeriodicSubtileIndex := fun r => - (hindexed (LatticeVertexIncidentCell x r)).choose - (owner j = a) → ((j ≠ k) → ((¬ (k = j + 1 ∨ j = k + 1)) → ((k = j + 2) → ( - let l := j + 1 - let m := j + 3 - (j ≠ l ∧ j ≠ k ∧ j ≠ m ∧ l ≠ k ∧ l ≠ m ∧ k ≠ m) → (l + 1 = k)))))) ) := by + ∀ (j k : Fin (4 : ℕ)), + k = j + (2 : Fin (4 : ℕ)) → + let l := j + (1 : Fin (4 : ℕ)); + l + (1 : Fin (4 : ℕ)) = k) := by classical - intro q cfg C₀ T cert P hindexed a x j hja k owner hja' hjk hnotconsecutive hop l m hpos + intro j k hop l rw [hop] fin_cases j <;> decide @@ -274,21 +257,12 @@ private theorem hkm : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let P := cert.modified - ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), ∀ - (a : PeriodicSubtileIndex), ∀ (x : GaussianInt), ∀ (j : Fin (4 : ℕ)), - (LatticeVertexIncidentCell x j ∈ (P.tile a).cells) → (∀ (k : Fin (4 : ℕ)), - let owner : Fin 4 → PeriodicSubtileIndex := fun r => - (hindexed (LatticeVertexIncidentCell x r)).choose - (owner j = a) → ((j ≠ k) → ((¬ (k = j + 1 ∨ j = k + 1)) → ((k = j + 2) → ( - let l := j + 1 - let m := j + 3 - (j ≠ l ∧ j ≠ k ∧ j ≠ m ∧ l ≠ k ∧ l ≠ m ∧ k ≠ m) → ((l + 1 = k) → (k + 1 = m))))))) ) := by + ∀ (j k : Fin (4 : ℕ)), + k = j + (2 : Fin (4 : ℕ)) → + let m := j + (3 : Fin (4 : ℕ)); + k + (1 : Fin (4 : ℕ)) = m) := by classical - intro q cfg C₀ T cert P hindexed a x j hja k owner hja' hjk hnotconsecutive hop l m hpos hlk + intro j k hop m rw [hop] fin_cases j <;> decide @@ -1045,12 +1019,11 @@ private theorem hnoPinch : -- The remaining incident sectors are owned by the two other labels. have hfalse : False := by have hpos : j ≠ l ∧ j ≠ k ∧ j ≠ m ∧ l ≠ k ∧ l ≠ m ∧ k ≠ m := - GeometricSectorGeometry.hpos q cfg C₀ T cert hindexed a x j hja k hja' hjk - hnotconsecutive hop - have hlk : l + 1 = k := GeometricSectorGeometry.hlk q cfg C₀ T cert hindexed a x j hja - k hja' hjk hnotconsecutive hop hpos - have hkm : k + 1 = m := GeometricSectorGeometry.hkm q cfg C₀ T cert hindexed a x j hja - k hja' hjk hnotconsecutive hop hpos hlk + GeometricSectorGeometry.hpos j k hop + have hlk : l + 1 = k := GeometricSectorGeometry.hlk j + k hop + have hkm : k + 1 = m := GeometricSectorGeometry.hkm j + k hop have hmj : m + 1 = j := by fin_cases j <;> simp [m] have hlA : owner l ≠ a := GeometricSectorGeometry.hlA q cfg C₀ T cert hindexed radialMembers a b hnoedge x j k ho hkb' hlk diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean index 494f72fadd..6780fc8557 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean @@ -1485,38 +1485,51 @@ private theorem hincomingPoint : (by classical exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), - let Q := normalization.normalizedPresentation - ∀ (g : GaussianInt), ∀ (uIndex : PeriodicSubtileIndex), ∀ (wBlock : ℤ × ℤ), ∀ (wShift : - GaussianInt), ∀ (V : ProtoTile), ∀ (W : ProtoTile), (W = TileTranslation - normalization.normalizedRoot wShift) → (((TileTranslation (TileQuarterTurn W) - g).cells = (TileTranslation normalization.normalizedRoot ((↑wBlock.1 : GaussianInt) * - normalization.layout.u + (↑wBlock.2 : GaussianInt) * normalization.layout.v)).cells) - → ((LatticeTile W) → ((Disjoint normalization.normalizedRoot.cells W.cells) → - ((Disjoint normalization.normalizedFixed.cells W.cells) → ((Disjoint W.cells V.cells) - → ( - let source := SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v uIndex - ∀ (incomingRaw : ExactTileInterfaceTriple normalization.normalizedRoot (TileTranslation - normalization.normalizedRoot ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ - (↑normalization.normalizedQuarterTurn : ℕ) * if Even - (↑normalization.normalizedQuarterTurn : ℕ) then BandVectors.1 (Q - normalization.normalizedParentSlot.succ) (Q (0 : Fin (4 : ℕ))) else BandVectors.1 (Q - (0 : Fin (4 : ℕ))) (Q normalization.normalizedParentSlot.succ))) source), ∀ (hWExact - : W = TileTranslation normalization.normalizedRoot ((⟨0, 1⟩ : GaussianInt) ^ - normalization.normalizedQuarterTurn.val * (if Even - normalization.normalizedQuarterTurn.val then BandVectors.1 (Q - normalization.normalizedParentSlot.succ) (Q 0) else BandVectors.1 (Q 0) (Q - normalization.normalizedParentSlot.succ)))), - let incomingData : ExactTileInterfaceTriple - normalization.normalizedRoot W source := hWExact.symm ▸ incomingRaw - incomingData.point = incomingRaw.point)))))) ) := by + ∀ (C₀ Cᵢ : BandCircle) + (q : Fin (4 : ℕ) → CircleCoordinates) + (i : Fin (3 : ℕ)) (T₀ Tᵢ : ProtoTile) + (h₀ hᵢ : PartialOdometer) (x : GaussianInt) + (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ + Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation; + ∀ (uIndex : PeriodicSubtileIndex) + (W : ProtoTile), + let source := + SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v + uIndex; + ∀ + (incomingRaw : + ExactTileInterfaceTriple + normalization.normalizedRoot + (TileTranslation normalization.normalizedRoot + ({ re := (0 : ℤ), im := (1 : ℤ) } ^ + (↑normalization.normalizedQuarterTurn : ℕ) * + if Even (↑normalization.normalizedQuarterTurn : ℕ) then + BandVectors.1 + (Q normalization.normalizedParentSlot.succ) + (Q (0 : Fin (4 : ℕ))) + else + BandVectors.1 (Q (0 : Fin (4 : ℕ))) + (Q normalization.normalizedParentSlot.succ))) + source) + (hWExact : + W = + TileTranslation normalization.normalizedRoot + ({ re := (0 : ℤ), im := (1 : ℤ) } ^ + (↑normalization.normalizedQuarterTurn : ℕ) * + if Even (↑normalization.normalizedQuarterTurn : ℕ) then + BandVectors.1 + (Q normalization.normalizedParentSlot.succ) + (Q (0 : Fin (4 : ℕ))) + else + BandVectors.1 (Q (0 : Fin (4 : ℕ))) + (Q normalization.normalizedParentSlot.succ))), + let incomingData := Eq.symm hWExact ▸ incomingRaw; + incomingData.point = incomingRaw.point) := by classical - intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q g uIndex wBlock wShift V W hW hWBar hWLattice - hRootW hFixedW hWV source incomingRaw hWExact incomingData + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q uIndex W source incomingRaw hWExact incomingData dsimp [incomingData] cases hWExact rfl @@ -1525,39 +1538,51 @@ private theorem hincomingOtherCA : (by classical exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), - let Q := normalization.normalizedPresentation - ∀ (g : GaussianInt), ∀ (uIndex : PeriodicSubtileIndex), ∀ (wBlock : ℤ × ℤ), ∀ (wShift : - GaussianInt), ∀ (V : ProtoTile), ∀ (W : ProtoTile), (W = TileTranslation - normalization.normalizedRoot wShift) → (((TileTranslation (TileQuarterTurn W) - g).cells = (TileTranslation normalization.normalizedRoot ((↑wBlock.1 : GaussianInt) * - normalization.layout.u + (↑wBlock.2 : GaussianInt) * normalization.layout.v)).cells) - → ((LatticeTile W) → ((Disjoint normalization.normalizedRoot.cells W.cells) → - ((Disjoint normalization.normalizedFixed.cells W.cells) → ((Disjoint W.cells V.cells) - → ( - let source := SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v uIndex - ∀ (incomingRaw : ExactTileInterfaceTriple normalization.normalizedRoot (TileTranslation - normalization.normalizedRoot ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ - (↑normalization.normalizedQuarterTurn : ℕ) * if Even - (↑normalization.normalizedQuarterTurn : ℕ) then BandVectors.1 (Q - normalization.normalizedParentSlot.succ) (Q (0 : Fin (4 : ℕ))) else BandVectors.1 (Q - (0 : Fin (4 : ℕ))) (Q normalization.normalizedParentSlot.succ))) source), ∀ (hWExact - : W = TileTranslation normalization.normalizedRoot ((⟨0, 1⟩ : GaussianInt) ^ - normalization.normalizedQuarterTurn.val * (if Even - normalization.normalizedQuarterTurn.val then BandVectors.1 (Q - normalization.normalizedParentSlot.succ) (Q 0) else BandVectors.1 (Q 0) (Q - normalization.normalizedParentSlot.succ)))), - let incomingData : ExactTileInterfaceTriple - normalization.normalizedRoot W source := hWExact.symm ▸ incomingRaw - (incomingData.point = incomingRaw.point) → (incomingData.otherCA = - incomingRaw.otherCA))))))) ) := by + ∀ (C₀ Cᵢ : BandCircle) + (q : Fin (4 : ℕ) → CircleCoordinates) + (i : Fin (3 : ℕ)) (T₀ Tᵢ : ProtoTile) + (h₀ hᵢ : PartialOdometer) (x : GaussianInt) + (normalization : + BandOrderedGeneralSubtileNormalizationCertificate C₀ + Cᵢ q i T₀ Tᵢ h₀ hᵢ x), + let Q := normalization.normalizedPresentation; + ∀ (uIndex : PeriodicSubtileIndex) + (W : ProtoTile), + let source := + SubtileOccurrenceInterpretation + normalization.layout.P normalization.layout.u normalization.layout.v + uIndex; + ∀ + (incomingRaw : + ExactTileInterfaceTriple + normalization.normalizedRoot + (TileTranslation normalization.normalizedRoot + ({ re := (0 : ℤ), im := (1 : ℤ) } ^ + (↑normalization.normalizedQuarterTurn : ℕ) * + if Even (↑normalization.normalizedQuarterTurn : ℕ) then + BandVectors.1 + (Q normalization.normalizedParentSlot.succ) + (Q (0 : Fin (4 : ℕ))) + else + BandVectors.1 (Q (0 : Fin (4 : ℕ))) + (Q normalization.normalizedParentSlot.succ))) + source) + (hWExact : + W = + TileTranslation normalization.normalizedRoot + ({ re := (0 : ℤ), im := (1 : ℤ) } ^ + (↑normalization.normalizedQuarterTurn : ℕ) * + if Even (↑normalization.normalizedQuarterTurn : ℕ) then + BandVectors.1 + (Q normalization.normalizedParentSlot.succ) + (Q (0 : Fin (4 : ℕ))) + else + BandVectors.1 (Q (0 : Fin (4 : ℕ))) + (Q normalization.normalizedParentSlot.succ))), + let incomingData := Eq.symm hWExact ▸ incomingRaw; + incomingData.otherCA = incomingRaw.otherCA) := by classical - intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q g uIndex wBlock wShift V W hW hWBar hWLattice - hRootW hFixedW hWV source incomingRaw hWExact incomingData hincomingPoint + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q uIndex W source incomingRaw hWExact incomingData dsimp [incomingData] cases hWExact rfl @@ -2149,11 +2174,9 @@ private theorem subtileInterfaceCertificate : let incomingData : ExactTileInterfaceTriple normalization.normalizedRoot W source := hWExact.symm ▸ incomingRaw have hincomingPoint := SubtileInterfaceAssembly.hincomingPoint C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x - normalization g uIndex - wBlock wShift V W hW hWBar hWLattice hRootW hFixedW hWV incomingRaw hWExact + normalization uIndex W incomingRaw hWExact have hincomingOtherCA := SubtileInterfaceAssembly.hincomingOtherCA C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x - normalization g uIndex - wBlock wShift V W hW hWBar hWLattice hRootW hFixedW hWV incomingRaw hWExact hincomingPoint + normalization uIndex W incomingRaw hWExact obtain ⟨startSource, hswapPoint, hswapOtherAB, hswapOtherBC, hswapOtherCA⟩ := ExactTileInterfaceTripleSwapLast normalization.normalizedRoot W source incomingData diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean index 5d7dae7842..e88515c718 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean @@ -621,42 +621,15 @@ private theorem hu : (by classical exact - ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), - (BandPackingSymmetryScopedPhase g q negative) → (∀ (i : Fin (3 : ℕ)), - let epsilon : GaussianInt := if negative then -1 else 1 - (epsilon * epsilon = 1) → ((∀ (V : GaussianInt), ∀ (A : GaussianInt), ∀ (b : - GaussianInt), V ≠ 0 → 2 * V * A = 2 * (epsilon * V) * b → b = epsilon * A) → - ((BandVectors.2 (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = epsilon * - (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : - ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2) → (((BandVectors.1 - (BandPackingSymmetryQuadrupleAction g q (-i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = if negative = true then - -BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) - else BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : - ℕ))))) ∧ (BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g q (-i).succ) = -if negative = true then - -BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) - else BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q - i.succ))) ∧ BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 : - ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ) = - if negative = true then -GaussianQuarterTurn (BandPackingSymmetryVectorAction g - (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))) - else GaussianQuarterTurn (BandPackingSymmetryVectorAction g (BandVectors.1 (q (i + (2 - : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)))) → ( - let j : Fin 4 := (i + 2).succ - let k : Fin 4 := (i + 1).succ - let V := (BandPackingSymmetryAffineVectorAction g - (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).1 - let A := (BandPackingSymmetryAffineVectorAction g - (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).2 - (2 * V * A = 2 * (epsilon * GaussianQuarterTurn V) * (BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q (-i + 2).succ) - (BandPackingSymmetryQuadrupleAction g q (-i + 1).succ))) → ((epsilon * - GaussianQuarterTurn 1) * (-epsilon * GaussianQuarterTurn 1) = 1)))))) ) := by + ∀ (negative : Bool), + let epsilon := + if negative = true then (-1 : GaussianInt) else (1 : GaussianInt); + epsilon * GaussianQuarterTurn (1 : GaussianInt) * + (-epsilon * + GaussianQuarterTurn (1 : GaussianInt)) = + (1 : GaussianInt)) := by classical - intro g q negative hphase i epsilon epsilonSquare slopeCancel incomingSlope hspatial j k V A hprod + intro negative epsilon cases negative <;> ext <;> norm_num [epsilon, GaussianQuarterTurn] private theorem quarterMul : @@ -959,8 +932,7 @@ theorem BandPackingSymmetryAffineVectorCovariance have hv : V ≠ 0 := by exact cyclicFacts j k hjk have hu : (epsilon * GaussianQuarterTurn 1) * - (-epsilon * GaussianQuarterTurn 1) = 1 := AffineSymmetryCoordinates.hu g q negative - hphase i epsilonSquare slopeCancel incomingSlope hspatial hprod + (-epsilon * GaussianQuarterTurn 1) = 1 := AffineSymmetryCoordinates.hu negative have qmul : GaussianQuarterTurn V = GaussianQuarterTurn 1 * V := by ext <;> simp [GaussianQuarterTurn] have quarterMul : ∀ z : GaussianInt, diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean index 96f5e29ea3..1ed375deb9 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean @@ -619,54 +619,80 @@ private theorem hMphase : (by classical exact - let affineQuarter : GaussianInt × GaussianInt → GaussianInt × GaussianInt := - fun z => (GaussianQuarterTurn z.1, -GaussianQuarterTurn z.2) - ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : - ℕ)), ∀ (e : Bool), ∀ (delta : Bool), (BandPackingSymmetryScopedPhase g q delta) → ((∀ - (i : Fin (3 : ℕ)), - let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); - let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : - Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); - let cyclic := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 - : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ - BandVectors.2 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : - ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : - ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation g = true then - -GaussianQuarterTurn cyclic.2 else cyclic.2) → ( - let q' := BandPackingSymmetryQuadrupleAction g q - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j - let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) - let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) - let Z : GaussianInt × GaussianInt := (W, A) - let M : GaussianInt × GaussianInt := - (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) - let W' := BandVectors.1 (q' ((sigma i + 2).succ)) - (q' ((sigma i + 1).succ)) - let A' := BandVectors.2 (q' ((sigma i + 2).succ)) - (q' ((sigma i + 1).succ)) - (W' = (if delta then (-1 : GaussianInt) else 1) * (if - BandPackingSymmetryReversesOrientation g then GaussianQuarterTurn - (BandPackingSymmetryVectorAction g W) else BandPackingSymmetryVectorAction g W)) → - (((BandPackingSymmetryAffineVectorAction g Z).1 = BandPackingSymmetryVectorAction g - Z.1) → ((BandPackingSymmetryAffineVectorAction g M = if - BandPackingSymmetryReversesOrientation g then BandPackingSymmetryAffineVectorAction g - Z + affineQuarter (BandPackingSymmetryAffineVectorAction g Z) else - BandPackingSymmetryAffineVectorAction g Z - affineQuarter - (BandPackingSymmetryAffineVectorAction g Z)) → ((A' = (if delta then (-1 : - GaussianInt) else 1) * (if BandPackingSymmetryReversesOrientation g then - -GaussianQuarterTurn (BandPackingSymmetryAffineVectorAction g Z).2 else - (BandPackingSymmetryAffineVectorAction g Z).2)) → ((W' - GaussianQuarterTurn W', A' + - GaussianQuarterTurn A') = if delta then -(BandPackingSymmetryAffineVectorAction g M) - else BandPackingSymmetryAffineVectorAction g M)))))) ) := by + let affineQuarter := fun (z : GaussianInt × GaussianInt) => + (GaussianQuarterTurn z.1, + -GaussianQuarterTurn z.2); + ∀ (g : BandPackingSymmetry) + (q : Fin (4 : ℕ) → CircleCoordinates) + (i : Fin (3 : ℕ)) (delta : Bool), + let q' := BandPackingSymmetryQuadrupleAction g q; + let sigma := fun (j : Fin (3 : ℕ)) => + if + BandPackingSymmetryReversesOrientation g = + true then + -j + else j; + let W := + BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ); + let A := + BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ); + let Z := (W, A); + let M := + (W - GaussianQuarterTurn W, + A + GaussianQuarterTurn A); + let W' := + BandVectors.1 + (q' (sigma i + (2 : Fin (3 : ℕ))).succ) + (q' (sigma i + (1 : Fin (3 : ℕ))).succ); + let A' := + BandVectors.2 + (q' (sigma i + (2 : Fin (3 : ℕ))).succ) + (q' (sigma i + (1 : Fin (3 : ℕ))).succ); + (W' = + (if delta = true then (-1 : GaussianInt) else (1 : GaussianInt)) * + if + BandPackingSymmetryReversesOrientation g = + true then + GaussianQuarterTurn + (BandPackingSymmetryVectorAction g W) + else BandPackingSymmetryVectorAction g W) → + (BandPackingSymmetryAffineVectorAction g Z).1 = + BandPackingSymmetryVectorAction g Z.1 → + (BandPackingSymmetryAffineVectorAction g M = + if + BandPackingSymmetryReversesOrientation g = + true then + BandPackingSymmetryAffineVectorAction g Z + + affineQuarter + (BandPackingSymmetryAffineVectorAction g + Z) + else + BandPackingSymmetryAffineVectorAction g Z - + affineQuarter + (BandPackingSymmetryAffineVectorAction g + Z)) → + (A' = + (if delta = true then (-1 : GaussianInt) else (1 : GaussianInt)) * + if + BandPackingSymmetryReversesOrientation + g = + true then + -GaussianQuarterTurn + (BandPackingSymmetryAffineVectorAction + g Z).2 + else + (BandPackingSymmetryAffineVectorAction g + Z).2) → + (W' - GaussianQuarterTurn W', + A' + GaussianQuarterTurn A') = + if delta = true then + -BandPackingSymmetryAffineVectorAction g M + else + BandPackingSymmetryAffineVectorAction g M) := by classical - intro affineQuarter g q i e delta hphase hcyc q' sigma W A Z M W' A' hWphase haffFst hactM hAphase + intro affineQuarter g q i delta q' sigma W A Z M W' A' hWphase haffFst hactM hAphase rw [hWphase, hAphase, ← haffFst, hactM] cases delta <;> cases hor : BandPackingSymmetryReversesOrientation g <;> ext <;> simp [affineQuarter, GaussianQuarterTurn] <;> ring @@ -1054,49 +1080,45 @@ private theorem hpointSignAt762 : (by classical exact - ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : - ℕ)), ∀ (delta : Bool), (BandPackingSymmetryScopedPhase g q delta) → ((∀ - (i : Fin (3 : ℕ)), - let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); - let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : - Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); - let cyclic := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 - : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ - BandVectors.2 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : - ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : - ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation g = true then - -GaussianQuarterTurn cyclic.2 else cyclic.2) → ( - let q' := BandPackingSymmetryQuadrupleAction g q - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j - let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) - let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) - let Z : GaussianInt × GaussianInt := (W, A) - let M : GaussianInt × GaussianInt := - (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) - let W' := BandVectors.1 (q' ((sigma i + 2).succ)) - (q' ((sigma i + 1).succ)) - let A' := BandVectors.2 (q' ((sigma i + 2).succ)) - (q' ((sigma i + 1).succ)) - (W' = (if delta then (-1 : GaussianInt) else 1) * (if - BandPackingSymmetryReversesOrientation g then GaussianQuarterTurn - (BandPackingSymmetryVectorAction g W) else BandPackingSymmetryVectorAction g W)) → - ((A' = (if delta then (-1 : GaussianInt) else 1) * (if - BandPackingSymmetryReversesOrientation g then -GaussianQuarterTurn - (BandPackingSymmetryAffineVectorAction g Z).2 else - (BandPackingSymmetryAffineVectorAction g Z).2)) → (((W' - GaussianQuarterTurn W', A' - + GaussianQuarterTurn A') = if delta then -(BandPackingSymmetryAffineVectorAction g - M) else BandPackingSymmetryAffineVectorAction g M) → (GaussianRealPoint (A' + - GaussianQuarterTurn A') = (if delta then (-1 : ℝ) else 1) • GaussianRealPoint - (BandPackingSymmetryAffineVectorAction g M).2))))) ) := by + ∀ (g : BandPackingSymmetry) + (q : Fin (4 : ℕ) → CircleCoordinates) + (i : Fin (3 : ℕ)) (delta : Bool), + let q' := BandPackingSymmetryQuadrupleAction g q; + let sigma := fun (j : Fin (3 : ℕ)) => + if + BandPackingSymmetryReversesOrientation g = + true then + -j + else j; + let W := + BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ); + let A := + BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ); + let M := + (W - GaussianQuarterTurn W, + A + GaussianQuarterTurn A); + let W' := + BandVectors.1 + (q' (sigma i + (2 : Fin (3 : ℕ))).succ) + (q' (sigma i + (1 : Fin (3 : ℕ))).succ); + let A' := + BandVectors.2 + (q' (sigma i + (2 : Fin (3 : ℕ))).succ) + (q' (sigma i + (1 : Fin (3 : ℕ))).succ); + ((W' - GaussianQuarterTurn W', + A' + GaussianQuarterTurn A') = + if delta = true then + -BandPackingSymmetryAffineVectorAction g M + else BandPackingSymmetryAffineVectorAction g M) → + GaussianRealPoint + (A' + GaussianQuarterTurn A') = + (if delta = true then (-1 : ℝ) else (1 : ℝ)) • + GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g M).2) := by classical - intro g q i delta hphase hcyc q' sigma W A Z M W' A' hWphase2 hAphase2 hMphase2 + intro g q i delta q' sigma W A M W' A' hMphase2 have hh := congrArg (fun z : GaussianInt × GaussianInt => GaussianRealPoint z.2) hMphase2 cases delta <;> simpa [GaussianRealPoint, smul_eq_mul] using hh @@ -1105,76 +1127,54 @@ private theorem hdiff' : (by classical exact - ∀ (g : BandPackingSymmetry), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (q : Fin (4 : ℕ) → - CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (e : Bool), (TileCentroid T' - - TileCentroid T = (if e = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • - (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin - (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q - (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (delta : - Bool), (BandPackingSymmetryScopedPhase g q delta) → ((∀ (i : Fin (3 : ℕ)), - let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); - let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : - Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); - let cyclic := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 - : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ - BandVectors.2 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : - ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : - ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation g = true then - -GaussianQuarterTurn cyclic.2 else cyclic.2) → ( - let q' := BandPackingSymmetryQuadrupleAction g q - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j - let e' := xor e delta - let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) - let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) - let Z : GaussianInt × GaussianInt := (W, A) - let M : GaussianInt × GaussianInt := - (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) - let W' := BandVectors.1 (q' ((sigma i + 2).succ)) - (q' ((sigma i + 1).succ)) - let A' := BandVectors.2 (q' ((sigma i + 2).succ)) - (q' ((sigma i + 1).succ)) - let eReal : ℝ := if e then 1 else -1 - let k : ℝ := eReal / 2 - (TileCentroid T' - TileCentroid T = k • GaussianRealPoint M.1) → (∀ (p : ℝ × ℝ), ∀ (p' : - ℝ × ℝ), (p'.1 - p.1 = (if e = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * - ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : - ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : - Fin (3 : ℕ))).succ)).im : ℝ))) → ((p'.2 - p.2 = (if e = true then (1 : ℝ) else (-1 : - ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : - Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q - (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((p' - p = k • GaussianRealPoint M.2) → - ((TileCentroid (BandPackingSymmetryTileAction g T') - TileCentroid - (BandPackingSymmetryTileAction g T) = k • GaussianRealPoint - (BandPackingSymmetryAffineVectorAction g (M.1, M.2)).1 ∧ - BandPackingSymmetrySlopeAction g T' p' - BandPackingSymmetrySlopeAction g T p = k • - GaussianRealPoint (BandPackingSymmetryAffineVectorAction g (M.1, M.2)).2) → ( - let r := BandPackingSymmetrySlopeAction g T p - let r' := BandPackingSymmetrySlopeAction g T' p' - (r' - r = k • GaussianRealPoint (BandPackingSymmetryAffineVectorAction g M).2) → ((W' = - (if delta then (-1 : GaussianInt) else 1) * (if - BandPackingSymmetryReversesOrientation g then GaussianQuarterTurn - (BandPackingSymmetryVectorAction g W) else BandPackingSymmetryVectorAction g W)) → - ((A' = (if delta then (-1 : GaussianInt) else 1) * (if - BandPackingSymmetryReversesOrientation g then -GaussianQuarterTurn - (BandPackingSymmetryAffineVectorAction g Z).2 else - (BandPackingSymmetryAffineVectorAction g Z).2)) → (((W' - GaussianQuarterTurn W', A' - + GaussianQuarterTurn A') = if delta then -(BandPackingSymmetryAffineVectorAction g - M) else BandPackingSymmetryAffineVectorAction g M) → ((GaussianRealPoint (A' + - GaussianQuarterTurn A') = (if delta then (-1 : ℝ) else 1) • GaussianRealPoint - (BandPackingSymmetryAffineVectorAction g M).2) → (r' - r = (if e' then (1 : ℝ) else - -1) • ((1 / 2 : ℝ) • GaussianRealPoint (A' + GaussianQuarterTurn A'))))))))))))))) ) - := by + ∀ (g : BandPackingSymmetry) + (T T' : ProtoTile) + (q : Fin (4 : ℕ) → CircleCoordinates) + (i : Fin (3 : ℕ)) (e delta : Bool), + let q' := BandPackingSymmetryQuadrupleAction g q; + let sigma := fun (j : Fin (3 : ℕ)) => + if + BandPackingSymmetryReversesOrientation g = + true then + -j + else j; + let e' := e ^^ delta; + let W := + BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ); + let A := + BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ); + let M := + (W - GaussianQuarterTurn W, + A + GaussianQuarterTurn A); + let A' := + BandVectors.2 + (q' (sigma i + (2 : Fin (3 : ℕ))).succ) + (q' (sigma i + (1 : Fin (3 : ℕ))).succ); + let eReal := if e = true then (1 : ℝ) else (-1 : ℝ); + let k := eReal / (2 : ℝ); + ∀ (p p' : ℝ × ℝ), + let r := BandPackingSymmetrySlopeAction g T p; + let r' := BandPackingSymmetrySlopeAction g T' p'; + r' - r = + k • + GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g + M).2 → + GaussianRealPoint + (A' + GaussianQuarterTurn A') = + (if delta = true then (-1 : ℝ) else (1 : ℝ)) • + GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g + M).2 → + r' - r = + (if e' = true then (1 : ℝ) else (-1 : ℝ)) • + (1 / 2 : ℝ) • + GaussianRealPoint + (A' + GaussianQuarterTurn A')) := by classical - intro g T T' q i e hcent delta hphase hcyc q' sigma e' W A Z M W' A' eReal k hcentM p p' hRe - hIm hsourceSlope htrSlope r r' hdiff hWphase2 hAphase2 hMphase2 hpointSign + intro g T T' q i e delta q' sigma e' W A M A' eReal k p p' r r' hdiff hpointSign rw [hdiff, hpointSign] cases e <;> cases delta <;> ext <;> simp [e', k, eReal, smul_smul, smul_eq_mul] <;> ring @@ -1611,7 +1611,7 @@ private theorem forwardSub : ext <;> simp [M, Z, affineQuarter, GaussianQuarterTurn]; ring have hactM := MarkedCovarianceGeometry.hactM affineFacts g q i hpat have hAphase := MarkedCovarianceGeometry.hAphase g q i delta hcyc - have hMphase := MarkedCovarianceGeometry.hMphase g q i e delta hphase hcyc hWphase + have hMphase := MarkedCovarianceGeometry.hMphase g q i delta hWphase haffFst hactM hAphase have hmFst := congrArg Prod.fst hMphase have hcentGoal := MarkedCovarianceGeometry.hcentGoal affineFirst g C' T T' h h' q i e @@ -1648,10 +1648,8 @@ private theorem forwardSub : have hactM2 := MarkedCovarianceGeometry.hactM2 affineFacts g q i hpat2 have hMphase2 := MarkedCovarianceGeometry.hMphase2 affineFirst g q i e delta hphase hcyc hWphase2 hAphase2 hactM2 - have hpointSign := MarkedCovarianceGeometry.hpointSignAt762 g q i delta hphase hcyc - hWphase2 hAphase2 hMphase2 - have hdiff' := MarkedCovarianceGeometry.hdiff' g T T' q i e hcent delta hphase hcyc - hcentM p p' hRe hIm hsourceSlope htrSlope hdiff hWphase2 hAphase2 hMphase2 hpointSign + have hpointSign := MarkedCovarianceGeometry.hpointSignAt762 g q i delta hMphase2 + have hdiff' := MarkedCovarianceGeometry.hdiff' g T T' q i e delta p p' hdiff hpointSign refine ⟨r, r', hsr, hsr', ?_, ?_⟩ · cases e <;> cases delta <;> have hr := congrArg Prod.fst hdiff' <;> diff --git a/LeanPool/ApollonianSuperharmonic/BandVectorParentSums.lean b/LeanPool/ApollonianSuperharmonic/BandVectorParentSums.lean index c1e89b1253..d50e1b884d 100644 --- a/LeanPool/ApollonianSuperharmonic/BandVectorParentSums.lean +++ b/LeanPool/ApollonianSuperharmonic/BandVectorParentSums.lean @@ -9,7 +9,6 @@ public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple public import LeanPool.ApollonianSuperharmonic.VectorRecursionLaws public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn -public import Mathlib.Tactic.FinCases public import Mathlib.Tactic.Ring /-! diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean b/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean index fa897fad83..41e83b4d7a 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean @@ -75,27 +75,18 @@ private theorem hcyc : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (Cᵢ : BandCircle), ∀ (i : - Fin 3), (q i.succ = Cᵢ.1.1) → (∀ (orientation : Bool), ∀ (leftOrientation : Bool), ∀ - (rightOrientation : Bool), ((q i.succ).1 = (1 : ℤ) → UnitOccurrenceOrientation q i - orientation) → (((q i.succ).1 = (1 : ℤ) → UnitOccurrenceOrientation q i - leftOrientation) → (((q i.succ).1 = (1 : ℤ) → UnitOccurrenceOrientation q i - rightOrientation) → (∀ (T₀ : ProtoTile), ∀ (Tminus : ProtoTile), ∀ (Rminus : - ProtoTile), ∀ (Rplus : ProtoTile), (BandPrototile (q i.succ) Tminus) → ((TileCentroid - Tminus - TileCentroid T₀ = (-1 : ℝ) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 - (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin - (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((TileCentroid Rminus - - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : - Fin (4 : ℕ))) - BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((TileCentroid - Rplus - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q i.succ) - (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → - (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + BandVectors.1 (q ((i + - 1).succ)) (q i.succ) + BandVectors.1 (q i.succ) (q ((i + 2).succ)) = 0))))))))) ) := by - classical - intro q hq Cᵢ i hCᵢ orientation leftOrientation rightOrientation horientation hleftOrientation - hrightOrientation T₀ Tminus Rminus Rplus hTminus hminus hRminus hRplus + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q → + ∀ (i : Fin (3 : ℕ)), + BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ) + + BandVectors.1 + (q (i + (1 : Fin (3 : ℕ))).succ) (q i.succ) + + BandVectors.1 (q i.succ) + (q (i + (2 : Fin (3 : ℕ))).succ) = + (0 : GaussianInt)) := by + classical + intro q hq i fin_cases i all_goals convert (VectorRecursionLaws q hq.1).1 using 1; @@ -105,29 +96,17 @@ private theorem hin : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (Cᵢ : BandCircle), ∀ (i : - Fin 3), (q i.succ = Cᵢ.1.1) → (∀ (orientation : Bool), ∀ (leftOrientation : Bool), ∀ - (rightOrientation : Bool), ((q i.succ).1 = (1 : ℤ) → UnitOccurrenceOrientation q i - orientation) → (((q i.succ).1 = (1 : ℤ) → UnitOccurrenceOrientation q i - leftOrientation) → (((q i.succ).1 = (1 : ℤ) → UnitOccurrenceOrientation q i - rightOrientation) → (∀ (T₀ : ProtoTile), ∀ (Tminus : ProtoTile), ∀ (Rminus : - ProtoTile), ∀ (Rplus : ProtoTile), (BandPrototile (q i.succ) Tminus) → ((TileCentroid - Tminus - TileCentroid T₀ = (-1 : ℝ) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 - (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin - (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((TileCentroid Rminus - - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : - Fin (4 : ℕ))) - BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((TileCentroid - Rplus - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q i.succ) - (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → - ((BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + BandVectors.1 (q ((i + - 1).succ)) (q i.succ) + BandVectors.1 (q i.succ) (q ((i + 2).succ)) = 0) → - (BandVectors.1 (q i.succ) (q 0) = BandVectors.1 (q i.succ) (q ((i + 2).succ)) - (⟨0, - 1⟩ : GaussianInt) * BandVectors.1 (q ((i + 1).succ)) (q i.succ))))))))))) ) := by - classical - intro q hq Cᵢ i hCᵢ orientation leftOrientation rightOrientation horientation hleftOrientation - hrightOrientation T₀ Tminus Rminus Rplus hTminus hminus hRminus hRplus hcyc + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q → + ∀ (i : Fin (3 : ℕ)), + BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) = + BandVectors.1 (q i.succ) + (q (i + (2 : Fin (3 : ℕ))).succ) - + { re := (0 : ℤ), im := (1 : ℤ) } * + BandVectors.1 + (q (i + (1 : Fin (3 : ℕ))).succ) (q i.succ)) := by + classical + intro q hq i fin_cases i · exact (VectorRecursionLaws q hq.1).2.2.1 · have h := (VectorRecursionLaws (![q 0, q 2, q 3, q 1]) @@ -833,7 +812,6 @@ theorem BoundaryStringConcatenation (T₀ base Tminus Rminus Rplus : ProtoTile) (left right : List ProtoTile) (hT₀ : BandPrototile (q 0) T₀) - (hTminus : BandPrototile (q i.succ) Tminus) (hminus : TileCentroid Tminus - TileCentroid T₀ = (-1 : ℝ) • ((1 / 2 : ℝ) • (GaussianRealPoint @@ -883,15 +861,11 @@ theorem BoundaryStringConcatenation obtain ⟨s, hs, hsuniq⟩ := (hfamily Rplus).mp hRplusMem obtain ⟨P, hP, hPuniq⟩ := (htransport Rminus Tminus left r m hr hm).mp hleft' obtain ⟨Q, hQ, hQuniq⟩ := (htransport Tminus Rplus right m s hm hs).mp hright' - have hcyc := BoundaryConcatenationGeometry.hcyc q hq Cᵢ i hCᵢ orientation leftOrientation - rightOrientation horientation hleftOrientation hrightOrientation T₀ Tminus Rminus Rplus - hTminus hminus hRminus hRplus + have hcyc := BoundaryConcatenationGeometry.hcyc q hq i have hin : BandVectors.1 (q i.succ) (q 0) = BandVectors.1 (q i.succ) (q ((i + 2).succ)) - (⟨0, 1⟩ : GaussianInt) * - BandVectors.1 (q ((i + 1).succ)) (q i.succ) := BoundaryConcatenationGeometry.hin q hq - Cᵢ i hCᵢ orientation leftOrientation rightOrientation horientation hleftOrientation - hrightOrientation T₀ Tminus Rminus Rplus hTminus hminus hRminus hRplus hcyc + BandVectors.1 (q ((i + 1).succ)) (q i.succ) := BoundaryConcatenationGeometry.hin q hq i have hflip := (VectorRecursionLaws q hq.1).2.2.2.2 hq i let I : GaussianInt := ⟨0, 1⟩ let w := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean b/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean index e9170a9e92..8ac0c3bb1e 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean @@ -635,17 +635,12 @@ theorem BoundaryStringOdometerRespect : R S g h F hn (U := U) (V := V) (k := k) (l := l) side obtain ⟨left, hl, hlhead, hllast, hleft, hleftAnc⟩ := realize P.left obtain ⟨right, hr, hrhead, hrlast, hright, hrightAnc⟩ := realize P.right - have joinOdometer : TileOdometer C.1.1 P.join (D.functions F.slot false) := - AncestorOdometerRestriction C.1.1 F.outer.1.1 P.join F.tile - (D.functions F.slot false) F.odometer P.ancestor have chart (hc : (F.q F.slot.succ).1 = 1) : UnitOccurrenceOrientation F.q F.slot ε := F.chart (by simpa [F.parent] using hc) obtain ⟨_, _, joined⟩ := BoundaryStringConcatenation F.q F.proper F.outer C F.slot F.child F.parent ε ε ε chart chart chart F.tile B P.join R S left right (by simpa only [F.child] using F.outer_band) - (by simpa only [F.parent] using - TileOdometerBandPrototile _ _ _ joinOdometer) (by simpa using P.occurrence.2.2) F.minus_centroid F.plus_centroid hleft.1 hright.1 obtain ⟨_, _, _, _, _, _, hjoined, _, _⟩ := joined diff --git a/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean index 2638048be4..3200bdd0a1 100644 --- a/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean @@ -112,23 +112,14 @@ private theorem hpoint : (by classical exact - ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (q : Fin 4 -> CircleCoordinates), ∀ (p : ℝ × ℝ), - ∀ (p' : ℝ × ℝ), ∀ (w : Fin (4 : ℕ) → CircleCoordinates), ∀ (iw : Fin (3 : ℕ)), ∀ (ew - : Bool), (TileCentroid T' - TileCentroid T = (if ew = true then (1 : ℝ) else (-1 : - ℝ)) • GaussianRealPoint (BandVectors.1 (w iw.succ) (w (0 : Fin (4 : ℕ))))) → ((p'.1 - - p.1 = (if ew = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (w iw.succ) (w (0 - : Fin (4 : ℕ)))).re : ℝ)) → ((p'.2 - p.2 = (if ew = true then (1 : ℝ) else (-1 : ℝ)) - * (↑(BandVectors.2 (w iw.succ) (w (0 : Fin (4 : ℕ)))).im : ℝ)) → (∀ (r2 : Fin (3 : - ℕ)), ∀ (g2 : BandPackingSymmetry), ∀ (P2 : FordFareyParameter), ((w (r2 + (2 : Fin (3 - : ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g2 ![w (0 : Fin (4 : - ℕ)), w r2.succ, w (r2 + (1 : Fin (3 : ℕ))).succ, w (r2 + (2 : Fin (3 : ℕ))).succ] = - FordRecursiveQuadruple P2) → ( - let barq : Fin 4 → CircleCoordinates := - ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] - (ProperBandQuadruple barq) → ((barq 0 = q 0) → (∀ (t : Fin (3 : ℕ)), (t + r2 = iw) → - (barq t.succ = w iw.succ)))))))) ) := by + ∀ (w : Fin (4 : ℕ) → CircleCoordinates) + (iw r2 : Fin (3 : ℕ)), + let barq := + ![w (0 : Fin (4 : ℕ)), w r2.succ, w (r2 + (1 : Fin (3 : ℕ))).succ, + w (r2 + (2 : Fin (3 : ℕ))).succ]; + ∀ (t : Fin (3 : ℕ)), t + r2 = iw → barq t.succ = w iw.succ) := by classical - intro T T' q p p' w iw ew hwcent hwslope hwslope' r2 g2 P2 hz2 heq2 barq hbar hbar0 t ht + intro w iw r2 barq t ht revert ht fin_cases r2 <;> fin_cases t <;> fin_cases iw <;> simp [barq] @@ -799,8 +790,8 @@ theorem FordLeftBoundaryCompatibility have hidx : ∃ t : Fin 3, (t + r2 : Fin 3) = iw := by fin_cases r2 <;> fin_cases iw <;> decide obtain ⟨t, ht⟩ := hidx - have hpoint := FordBoundaryCompatibilityGeometry.hpoint T T' q p p' - w iw ew hwcent hwslope hwslope' r2 g2 P2 hz2 heq2 hbar hbar0 t ht + have hpoint := FordBoundaryCompatibilityGeometry.hpoint + w iw r2 t ht have hcentbar := FordBoundaryCompatibilityGeometry.hcentbar C T T' q hC w iw ew hwchild hwcent r2 hbar0 t hpoint diff --git a/LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean b/LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean index ebf991967c..6db3d648cb 100644 --- a/LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean +++ b/LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean @@ -121,45 +121,13 @@ private theorem htangent : (by classical exact - ∀ (q : Fin 4 -> CircleCoordinates), (ProperBandQuadruple q) → (∀ (Cᵢ : BandCircle), ∀ (i - : Fin 3), (q i.succ = Cᵢ.1.1) → (∀ (orientation : Bool), (Cᵢ.1.1.1 = (1 : ℤ) → - UnitOccurrenceOrientation q i orientation) → ((0 < (q i.succ).1) → (∀ (S : Fin (3 : - ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), - let B := S i false - let g := hs i false - (TileOdometer Cᵢ.1.1 B g) → ((BandPrototile Cᵢ.1.1 B) → (∀ (pouter : ℝ × ℝ), ∀ (pseed : ℝ - × ℝ), (PartialOdometerSlope (hs i false) = some pseed) → ((pseed.1 - pouter.1 = (if - false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 - : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q - (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((pseed.2 - - pouter.2 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * - ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : - ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : - Fin (3 : ℕ))).succ)).re : ℝ))) → ((BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q - (i + (1 : Fin (3 : ℕ))).succ) + BandVectors.1 (q i.succ) (q (i + (2 : Fin (3 : - ℕ))).succ) + BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q i.succ) = (0 : - GaussianInt)) → ((BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 - : ℕ))).succ) + BandVectors.2 (q i.succ) (q (i + (2 : Fin (3 : ℕ))).succ) + - BandVectors.2 (q (i + (1 : Fin (3 : ℕ))).succ) (q i.succ) = (0 : GaussianInt)) → - ((BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q i.succ) (q (i + - (2 : Fin (3 : ℕ))).succ) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (i + - (1 : Fin (3 : ℕ))).succ) (q i.succ)) → ((BandVectors.2 (q i.succ) (q (0 : Fin (4 : - ℕ))) = BandVectors.2 (q i.succ) (q (i + (2 : Fin (3 : ℕ))).succ) + (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) * BandVectors.2 (q (i + (1 : Fin (3 : ℕ))).succ) (q i.succ)) → - ((BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - * BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) → ((BandVectors.2 (q (0 : Fin (4 : - ℕ))) (q i.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (q i.succ) (q - (0 : Fin (4 : ℕ)))) → ((pseed + GaussianRealPoint (-BandVectors.2 (q ((i + 1).succ)) - (q i.succ)) = pouter + (1 / 2 : Real) • GaussianRealPoint (BandVectors.2 (q i.succ) - (q 0) - BandVectors.2 (q 0) (q i.succ))) → ( - let uminus := -BandVectors.1 (q ((i + 1).succ)) (q i.succ) - (BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q i.succ) ∈ TilingLattice Cᵢ) → - ((BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q i.succ) ∈ TilingLattice Cᵢ) → - ((uminus ∈ TilingLattice Cᵢ) → (BandTangency (q i.succ) (q ((i + - 2).succ))))))))))))))))))))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q → + ∀ (i : Fin (3 : ℕ)), + BandTangency (q i.succ) + (q (i + (2 : Fin (3 : ℕ))).succ)) := by classical - intro q hq Cᵢ i hCᵢ orientation horientation hparent S hs B g hBodometer hB pouter pseed hpseed - hpre hpim hvsum hasum hvchild hachild hvflip haflip hseedIdentity uminus hvji hvki huminus + intro q hq i refine ⟨q, hq.1, i.succ, (i + 2).succ, ?_, rfl, rfl⟩ fin_cases i <;> decide @@ -325,8 +293,7 @@ theorem ForwardBoundaryStringData have huminus : uminus ∈ TilingLattice Cᵢ := (TilingLattice Cᵢ).neg_mem hvji have htangent : BandTangency (q i.succ) (q ((i + 2).succ)) := ForwardBoundaryGeometry.htangent - q hq Cᵢ i hCᵢ orientation horientation hparent S hs hBodometer hB pouter pseed hpseed hpre - hpim hvsum hasum hvchild hachild hvflip haflip hseedIdentity hvji hvki huminus + q hq i have huplus : uplus ∈ TilingLattice Cᵢ := ForwardBoundaryGeometry.huplus q Cᵢ i hvki htangent have hRminus : Rminus ∈ RegularTileFamily B (TilingLattice Cᵢ) := ⟨uminus, huminus, rfl⟩ diff --git a/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean index 0e4a841ab7..4c9f90c2e9 100644 --- a/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean @@ -8,8 +8,6 @@ module public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts -public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance -- [TABLET NODE: LeftLatticeAdjacentPackingSymmetryTransport] diff --git a/LeanPool/ApollonianSuperharmonic/OdometerAdjacencyInduction.lean b/LeanPool/ApollonianSuperharmonic/OdometerAdjacencyInduction.lean index 58ff742d28..d61faa8c3b 100644 --- a/LeanPool/ApollonianSuperharmonic/OdometerAdjacencyInduction.lean +++ b/LeanPool/ApollonianSuperharmonic/OdometerAdjacencyInduction.lean @@ -327,47 +327,20 @@ private theorem hpos' : (by classical exact - ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (S : ProtoTile), ∀ (k : PartialOdometer), ∀ (p : - ℝ × ℝ), ∀ (q : ℝ × ℝ), ∀ (Q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), - (TileOdometer (Q i.succ) S k) → (∀ (s : Fin (4 : ℕ)), (Q i.succ = D.1.1) → - ((TileCentroid S - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (Q i.succ) (Q (0 : Fin (4 : ℕ))) + - BandVectors.1 (Q (0 : Fin (4 : ℕ))) (Q i.succ)))) → ((q.1 - p.1 = ((1 / 2 : ℝ) • - GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 - (Q i.succ) (Q (0 : Fin (4 : ℕ))) + BandVectors.2 (Q (0 : Fin (4 : ℕ))) (Q - i.succ)))).1) → ((q.2 - p.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ - : GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (Q i.succ) (Q (0 : Fin (4 : ℕ))) + - BandVectors.2 (Q (0 : Fin (4 : ℕ))) (Q i.succ)))).2) → (((0 : ℤ) < (Q i.succ).1) → (∀ - (g : BandPackingSymmetry), ∀ (r : ℝ × ℝ), ∀ (t : ℝ × ℝ), ∀ (s' : Fin (4 : ℕ)), - (TileOdometer (BandPackingSymmetryQuadrupleAction g Q ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) - (BandPackingSymmetryTileAction g S) (BandPackingSymmetryPartialOdometerAction g k)) → - ((TileCentroid (BandPackingSymmetryTileAction g S) - TileCentroid - (BandPackingSymmetryTileAction g T) = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 - : ℤ)⟩ : GaussianInt) ^ (↑s' : ℕ) * (BandVectors.1 (BandPackingSymmetryQuadrupleAction - g Q ((fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true - then -j else j) i).succ) (BandPackingSymmetryQuadrupleAction g Q (0 : Fin (4 : ℕ))) + - BandVectors.1 (BandPackingSymmetryQuadrupleAction g Q (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g Q ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))) → ((t.1 - - r.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s' - : ℕ) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction g Q ((fun (j : Fin (3 : ℕ)) - => if BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) - (BandPackingSymmetryQuadrupleAction g Q (0 : Fin (4 : ℕ))) + BandVectors.2 - (BandPackingSymmetryQuadrupleAction g Q (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g Q ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))).1) → - ((t.2 - r.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - ^ (↑s' : ℕ) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction g Q ((fun (j : Fin - (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true then -j else j) - i).succ) (BandPackingSymmetryQuadrupleAction g Q (0 : Fin (4 : ℕ))) + BandVectors.2 - (BandPackingSymmetryQuadrupleAction g Q (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g Q ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))).2) → (0 < - ((BandPackingSymmetryQuadrupleAction g Q) (if BandPackingSymmetryReversesOrientation - g then -i else i).succ).1)))))))))) ) := by + ∀ (Q : Fin (4 : ℕ) → CircleCoordinates) + (i : Fin (3 : ℕ)), + (0 : ℤ) < (Q i.succ).1 → + ∀ (g : BandPackingSymmetry), + (0 : ℤ) < + (BandPackingSymmetryQuadrupleAction g Q + (if + BandPackingSymmetryReversesOrientation + g = + true then + -i + else i).succ).1) := by classical - intro D T S k p q Q i hk s hparent hc ha hb hpos g r t s' hk' hc' ha' hb' + intro Q i hpos g have hp' := (BandPackingSymmetryCovariance g).1 (Q i.succ) cases hg : BandPackingSymmetryReversesOrientation g <;> fin_cases i <;> simpa [BandPackingSymmetryQuadrupleAction,hg] using hp'.symm ▸ hpos @@ -538,8 +511,7 @@ theorem OdometerAdjacencyInduction : apply hcompat.mp have hpos' : 0 < ((BandPackingSymmetryQuadrupleAction g Q) (if BandPackingSymmetryReversesOrientation g then -i else i).succ).1 := - AdjacencyInductionGeometry.hpos' D T S k p q Q i hk s hparent hc ha hb hpos g r t s' - hk' hc' ha' hb' + AdjacencyInductionGeometry.hpos' Q i hpos g rcases hcanon with ⟨P,hP,h0,hparents⟩ | ⟨K,hK,h0,hparents⟩ · obtain ⟨j,hj⟩ := hparents (if BandPackingSymmetryReversesOrientation g then -i else i) rw [h0] at hh' diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean index 7c44823dcb..79a27e027a 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean @@ -62,26 +62,10 @@ private theorem htranslateZero : (by classical exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), ∀ (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → - UnitOccurrenceOrientation q i o), - let orientation := Classical.choose horientationExists - ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List - ProtoTile), ∀ (hseed : PartialOdometer), (Rminus ∈ RegularTileFamily base - (TilingLattice Cᵢ)) → ((TileOdometer Cᵢ.1.1 Rminus hseed) → ((BoundaryString C₀ Cᵢ i - orientation T₀ base Rminus Rplus tiles) → (∀ (q' : Fin (4 : ℕ) → CircleCoordinates), - (TileString Cᵢ orientation base Rminus Rplus tiles) → ((TileCentroid Rminus - - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q' i.succ) (q' (0 : - Fin (4 : ℕ))) - BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' i.succ))) → (∀ (centerShift - : GaussianInt), ∀ (reverseTiles : List ProtoTile), (GaussianRealPoint centerShift = - TileCentroid Rminus + TileCentroid Rplus) → ((TileString Cᵢ orientation base Rplus - Rminus reverseTiles) → (((TileTranslation (TileHalfTurn Rminus) centerShift).cells = - Rplus.cells) → (((TileTranslation (TileHalfTurn Rplus) centerShift).cells = - Rminus.cells) → (TileTranslation Rminus (0 : GaussianInt) = Rminus))))))))) ) := by + ∀ (Rminus : ProtoTile), + TileTranslation Rminus (0 : GaussianInt) = Rminus) := by classical - intro q C₀ Cᵢ i T₀ horientationExists orientation base Rminus Rplus tiles hseed hRminus hseedO - hboundaryOriginal q' hstring hcentroidMinus centerShift reverseTiles hcenters hreverse - hminusCells hplusCells + intro Rminus cases Rminus with | mk cs anchor => have hfun : GaussianTranslation (0 : GaussianInt) = id := by @@ -454,28 +438,19 @@ private theorem hRplusBand : (by classical exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), ∀ (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → - UnitOccurrenceOrientation q i o), - let orientation := Classical.choose horientationExists - ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List - ProtoTile), (BandPrototile Cᵢ.1.1 base) → ((Rplus ∈ RegularTileFamily base - (TilingLattice Cᵢ)) → ((BoundaryString C₀ Cᵢ i orientation T₀ base Rminus Rplus - tiles) → (∀ (q' : Fin (4 : ℕ) → CircleCoordinates), (TileString Cᵢ orientation base - Rminus Rplus tiles) → ((TileCentroid Rplus - TileCentroid T₀ = (1 / 2 : ℝ) • - GaussianRealPoint (BandVectors.1 (q' i.succ) (q' (0 : Fin (4 : ℕ))) + BandVectors.1 - (q' (0 : Fin (4 : ℕ))) (q' i.succ))) → (∀ (centerShift : GaussianInt), ∀ - (reverseTiles : List ProtoTile), (GaussianRealPoint centerShift = TileCentroid Rminus - + TileCentroid Rplus) → ((TileString Cᵢ orientation base Rplus Rminus reverseTiles) → - (((TileTranslation (TileHalfTurn Rminus) centerShift).cells = Rplus.cells) → - (((TileTranslation (TileHalfTurn Rplus) centerShift).cells = Rminus.cells) → - ((TileCentroid Rminus + TileCentroid Rplus = TileCentroid T₀ + TileCentroid T₀ + - GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) → (BandPrototile Cᵢ.1.1 - Rplus)))))))))) ) := by - classical - intro q C₀ Cᵢ i T₀ horientationExists orientation base Rminus Rplus tiles hbase hRplus - hboundaryOriginal q' hstring hcentroidPlus centerShift reverseTiles hcenters hreverse - hminusCells hplusCells hsumCentroid + ∀ (Cᵢ : BandCircle) + (base Rplus : ProtoTile), + BandPrototile + Cᵢ.1.1 + base → + Rplus ∈ + RegularTileFamily base + (TilingLattice Cᵢ) → + BandPrototile + Cᵢ.1.1 + Rplus) := by + classical + intro Cᵢ base Rplus hbase hRplus rcases hRplus with ⟨w, hw, rfl⟩ exact BandPrototileTranslation Cᵢ.1.1 base w hbase @@ -610,37 +585,19 @@ private theorem hRminusBand : (by classical exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), ∀ (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → - UnitOccurrenceOrientation q i o), - let orientation := Classical.choose horientationExists - ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List - ProtoTile), ∀ (hseed : PartialOdometer), (BandPrototile Cᵢ.1.1 base) → ((Rminus ∈ - RegularTileFamily base (TilingLattice Cᵢ)) → ((TileOdometer Cᵢ.1.1 Rminus hseed) → - ((BoundaryString C₀ Cᵢ i orientation T₀ base Rminus Rplus tiles) → (∀ (q' : Fin (4 : - ℕ) → CircleCoordinates), (TileString Cᵢ orientation base Rminus Rplus tiles) → - ((TileCentroid Rminus - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.1 (q' i.succ) (q' (0 : Fin (4 : ℕ))) - BandVectors.1 (q' (0 : Fin (4 : - ℕ))) (q' i.succ))) → (∀ (centerShift : GaussianInt), ∀ (reverseTiles : List - ProtoTile), (GaussianRealPoint centerShift = TileCentroid Rminus + TileCentroid - Rplus) → ((TileString Cᵢ orientation base Rplus Rminus reverseTiles) → - (((TileTranslation (TileHalfTurn Rminus) centerShift).cells = Rplus.cells) → - (((TileTranslation (TileHalfTurn Rplus) centerShift).cells = Rminus.cells) → ( - let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) - let hminus := PartialOdometerAffineTranslate hseed 0 d 0 - (TileTranslation Rminus (0 : GaussianInt) = Rminus) → ((TileOdometer Cᵢ.1.1 Rminus - hminus) → ((TileCentroid Rminus + TileCentroid Rplus = TileCentroid T₀ + TileCentroid - T₀ + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) → (∀ (couter : GaussianInt), - let a : GaussianInt := -couter - let hplus := PartialOdometerAffineTranslate - (PartialOdometerHalfTurn hminus) centerShift a 0 - (TileOdometer Cᵢ.1.1 (TileTranslation (TileHalfTurn Rminus) centerShift) hplus) → - (BandPrototile Cᵢ.1.1 Rminus)))))))))))))) ) := by + ∀ (Cᵢ : BandCircle) + (base Rminus : ProtoTile), + BandPrototile + Cᵢ.1.1 + base → + Rminus ∈ + RegularTileFamily base + (TilingLattice Cᵢ) → + BandPrototile + Cᵢ.1.1 + Rminus) := by classical - intro q C₀ Cᵢ i T₀ horientationExists orientation base Rminus Rplus tiles hseed hbase hRminus - hseedO hboundaryOriginal q' hstring hcentroidMinus centerShift reverseTiles hcenters - hreverse hminusCells hplusCells d hminus htranslateZero hOminus hsumCentroid couter a hplus - hplusRawO + intro Cᵢ base Rminus hbase hRminus rcases hRminus with ⟨w, hw, rfl⟩ exact BandPrototileTranslation Cᵢ.1.1 base w hbase @@ -1280,31 +1237,25 @@ private theorem hinteriorCells : (by classical exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (horientationExists : ∃ o : Bool, - Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), - let orientation := Classical.choose horientationExists - ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List - ProtoTile), (BoundaryString C₀ Cᵢ i orientation T₀ base Rminus Rplus tiles) → - ((TileString Cᵢ orientation base Rminus Rplus tiles) → (∀ (centerShift : - GaussianInt), ∀ (reverseTiles : List ProtoTile), (TileString Cᵢ orientation base - Rplus Rminus reverseTiles) → ((List.Forall₂ (fun (T U : ProtoTile) => - (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells) tiles reverseTiles) → - ((tiles.head? = some Rminus) → ((tiles.getLast? = some Rplus) → ((2 ≤ tiles.length) → - (∀ (hs : List PartialOdometer), (OdometerStringRespect Cᵢ orientation base Rminus - Rplus tiles hs) → ((∀ T ∈ (List.drop (1 : ℕ) tiles).dropLast, ∃ (h : - PartialOdometer), (T, h) ∈ tiles.zip hs ∧ AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀ h h₀) → - ((hs.length = tiles.length) → ((∀ {α : Type}, ∀ {β : Type}, ∀ (r : α → β → Prop), ∀ - {xs : List α}, ∀ {ys : List β}, List.Forall₂ r xs ys → List.Forall₂ r xs.dropLast - ys.dropLast) → ( - let cellRelation : ProtoTile → ProtoTile → Prop := fun T U => - (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells - List.Forall₂ cellRelation ((tiles.drop 1).dropLast) ((reverseTiles.drop - 1).dropLast)))))))))))) ) := by - classical - intro q C₀ Cᵢ i T₀ h₀ horientationExists orientation base Rminus Rplus tiles hboundaryOriginal - hstring centerShift reverseTiles hreverse hcellPairs htilesHead htilesLast htilesLength hs - hrespect hancestorForward hlengthEq forall2_dropLast cellRelation + ∀ (tiles : List ProtoTile) (centerShift : GaussianInt) + (reverseTiles : List ProtoTile), + List.Forall₂ + (fun (T U : ProtoTile) => + (TileTranslation + (TileHalfTurn T) centerShift).cells = + U.cells) + tiles reverseTiles → + (2 : ℕ) ≤ tiles.length → + (∀ {α β : Type} (r : α → β → Prop) {xs : List α} {ys : List β}, + List.Forall₂ r xs ys → List.Forall₂ r xs.dropLast ys.dropLast) → + let cellRelation := fun (T U : ProtoTile) => + (TileTranslation + (TileHalfTurn T) centerShift).cells = + U.cells; + List.Forall₂ cellRelation (List.drop (1 : ℕ) tiles).dropLast + (List.drop (1 : ℕ) reverseTiles).dropLast) := by + classical + intro tiles centerShift reverseTiles hcellPairs htilesLength forall2_dropLast cellRelation cases hcellPairs with | nil => simp at htilesLength | cons hfirst htail => @@ -1996,35 +1947,27 @@ private theorem hTband : (by classical exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (Cᵢ : BandCircle), ∀ (i : Fin 3), ∀ - (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), - let orientation := Classical.choose horientationExists - ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (centerShift : - GaussianInt), ∀ (reverseTiles : List ProtoTile), (TileString Cᵢ orientation base - Rplus Rminus reverseTiles) → (∀ (couter : GaussianInt), ∀ (eouter : ℤ), - let a : GaussianInt := -couter - let b : Int := -eouter - ∀ (eback : ℤ), - let bplus : Int := -eback - ∀ (hs : List PartialOdometer), - let constAt : Nat → Int := fun n => - if n = 0 then 0 else if n + 1 = hs.length then bplus else b - let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => - PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) - let gs := hs.mapIdx transformAt - let cellRelation : ProtoTile → ProtoTile → Prop := fun T U => - (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells - (∀ (xs : List ProtoTile), ((xs.drop 1).dropLast).Sublist xs) → (∀ (T : ProtoTile), (T ∈ - (List.drop (1 : ℕ) reverseTiles).dropLast) → (∀ (g : PartialOdometer), ((T, g) ∈ - (List.drop (1 : ℕ) reverseTiles).dropLast.zip (List.drop (1 : ℕ) gs).dropLast) → - (((T, g) ∈ ((reverseTiles.zip gs).drop 1).dropLast) → (∀ (U : ProtoTile), ∀ (h : - PartialOdometer), (cellRelation (U, h).1 (T, g).1 ∧ (T, g).2 = - PartialOdometerAffineTranslate (PartialOdometerHalfTurn (U, h).2) centerShift a b) → - (BandPrototile Cᵢ.1.1 T)))))) ) := by - classical - intro q Cᵢ i horientationExists orientation base Rminus Rplus centerShift reverseTiles hreverse - couter eouter a b eback bplus hs constAt transformAt gs cellRelation trimSublist T hT g - hTgInterior hTgTrim U h hpairedData + ∀ (q : Fin (4 : ℕ) → CircleCoordinates) + (Cᵢ : BandCircle) (i : Fin (3 : ℕ)) + (horientationExists : + ∃ (o : Bool), + Cᵢ.1.1.1 = + (1 : ℤ) → + UnitOccurrenceOrientation q i o), + let orientation := Classical.choose horientationExists; + ∀ (base Rminus Rplus : ProtoTile) + (reverseTiles : List ProtoTile), + TileString Cᵢ orientation base Rplus Rminus + reverseTiles → + (∀ (xs : List ProtoTile), + (List.drop (1 : ℕ) xs).dropLast.Sublist xs) → + ∀ T ∈ (List.drop (1 : ℕ) reverseTiles).dropLast, + BandPrototile + Cᵢ.1.1 + T) := by + classical + intro q Cᵢ i horientationExists orientation base Rminus Rplus reverseTiles hreverse + trimSublist T hT rcases hreverse with ⟨hbaseR, _, _, _, hmemR, _, _⟩ have hTmem : T ∈ reverseTiles := (trimSublist reverseTiles).subset hT rcases hmemR T hTmem with ⟨v, hv, rfl⟩ @@ -2158,10 +2101,8 @@ private theorem opposingBoundaryConclusion : touter couter eouter eback hminusBackEq htilesLength hs hhsLast hlengthEq let cellRelation : ProtoTile → ProtoTile → Prop := fun T U => (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells - have hinteriorCells := OpposingBoundaryGeometry.hinteriorCells q C₀ Cᵢ i T₀ h₀ - horientationExists base Rminus Rplus tiles hboundaryOriginal hstring centerShift - reverseTiles hreverse hcellPairs htilesHead htilesLast htilesLength hs hrespect - hancestorForward hlengthEq (OpposingBoundaryGeometry.forall2_dropLast) + have hinteriorCells := OpposingBoundaryGeometry.hinteriorCells tiles centerShift + reverseTiles hcellPairs htilesLength (OpposingBoundaryGeometry.forall2_dropLast) have interiorTransforms := OpposingBoundaryGeometry.interiorTransforms C₀ Cᵢ i T₀' tiles q' centerShift touter couter eouter eback hs have hgsTail := OpposingBoundaryGeometry.hgsTail q C₀ Cᵢ i T₀ h₀ horientationExists base Rminus @@ -2277,8 +2218,7 @@ private theorem opposingBoundaryConclusion : T (TileTranslation (TileHalfTurn T₀) centerShift) g houterAffine hpositive hstrict (OpposingBoundaryGeometry.hcentralTarget C₀ Cᵢ T₀ h₀ centerShift couter eouter T g U h hpairedData hcentral) (OpposingBoundaryGeometry.hTband q Cᵢ i - horientationExists base Rminus Rplus centerShift reverseTiles hreverse couter eouter - eback hs trimSublist T hT g hTgInterior hTgTrim U h hpairedData) hpairedData.1 + horientationExists base Rminus Rplus reverseTiles hreverse trimSublist T hT) hpairedData.1 have houter := AncestorOdometerOuterSupportNormalization Cᵢ.1.1 C₀.1.1 T (TileTranslation (TileHalfTurn T₀) centerShift) T₀' g houterAffine hC₀positive hstrict hinner hT₀'band houterCells @@ -2372,9 +2312,7 @@ theorem OpposingBoundaryOdometerStrings (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)) let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) let hminus := PartialOdometerAffineTranslate hseed 0 d 0 - have htranslateZero := OpposingBoundaryGeometry.htranslateZero q C₀ Cᵢ i T₀ horientationExists - base Rminus Rplus tiles hseed hRminus hseedO hboundaryOriginal q' hstring hcentroidMinus - centerShift reverseTiles hcenters hreverse hminusCells hplusCells + have htranslateZero := OpposingBoundaryGeometry.htranslateZero Rminus have hOminus := OpposingBoundaryGeometry.hOminus q Cᵢ i Rminus hseed hseedO htranslateZero have hminusSlopeCalc : pseed + GaussianRealPoint d = pminus := by simpa [pminus, d, hpouter_eq] using hseedSlopeData @@ -2452,9 +2390,8 @@ theorem OpposingBoundaryOdometerStrings have hOplus : TileOdometer Cᵢ.1.1 Rplus hplus := PositiveCurvatureTileOdometerSupportTransport Cᵢ.1.1 (TileTranslation (TileHalfTurn Rminus) centerShift) Rplus hplus - hpositive hplusRawO (OpposingBoundaryGeometry.hRplusBand q C₀ Cᵢ i T₀ horientationExists - base Rminus Rplus tiles hbase hRplus hboundaryOriginal q' hstring hcentroidPlus - centerShift reverseTiles hcenters hreverse hminusCells hplusCells hsumCentroid) + hpositive hplusRawO (OpposingBoundaryGeometry.hRplusBand Cᵢ + base Rplus hbase hRplus) hminusCells have haRe : p₀.1 + p₀'.1 = (a.re : Real) := by simpa only [Prod.fst_add, GaussianRealPoint] using congrArg Prod.fst haSlope @@ -2466,10 +2403,8 @@ theorem OpposingBoundaryOdometerStrings have hsplus := OpposingBoundaryGeometry.hsplus q i p₀ hseed centerShift hsminus couter hplusSlopeCalc have finiteTranslationFix := OpposingBoundaryGeometry.finiteTranslationFix - have hRminusBand := OpposingBoundaryGeometry.hRminusBand q C₀ Cᵢ i T₀ horientationExists base - Rminus Rplus tiles hseed hbase hRminus hseedO hboundaryOriginal q' hstring hcentroidMinus - centerShift reverseTiles hcenters hreverse hminusCells hplusCells htranslateZero hOminus - hsumCentroid couter hplusRawO + have hRminusBand := OpposingBoundaryGeometry.hRminusBand Cᵢ base + Rminus hbase hRminus let hback := PartialOdometerAffineTranslate (PartialOdometerHalfTurn hplus) centerShift a 0 have hbackO : TileOdometer Cᵢ.1.1 Rminus hback := diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean b/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean index 65db7ac556..cbe0a3f631 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean @@ -687,35 +687,15 @@ private theorem hxdet : (by classical exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + - 3)), ∀ (C : P3650T1CyclicChildren p a b), - let Op := P3544T1RayParity p - let OL := P3544T1RayParity C.left - let OR := P3544T1RayParity C.right - ∀ (x : ℝ × ℝ), (x ∈ openSegment ℝ (p.vertex a) (p.vertex b)) → ( - let ilast : Fin (C.leftParameter + 3) := Fin.last (C.leftParameter + 2) - let irlast : Fin (C.rightParameter + 3) := Fin.last (C.rightParameter + 2) - (x ∈ openSegment Real (C.left.vertex ilast) (C.left.vertex (ilast + 1))) → ((x ∈ - openSegment Real (C.right.vertex irlast) (C.right.vertex (irlast + 1))) → (∀ (rL : - ℝ), ∀ (sL : Bool), (∀ y ∈ Metric.ball x rL, y ∈ P3544T1RayParity C.left ↔ if sL = - true then (0 : ℝ) < P3381T1TriangleDeterminant ![C.left.vertex ilast, C.left.vertex - (ilast + (1 : Fin (C.leftParameter + (3 : ℕ)))), y] else P3381T1TriangleDeterminant - ![C.left.vertex ilast, C.left.vertex (ilast + (1 : Fin (C.leftParameter + (3 : ℕ)))), - y] < - (0 : ℝ)) → (∀ (rR : ℝ), ∀ (sR : Bool), (∀ y ∈ Metric.ball x rR, y ∈ - P3544T1RayParity C.right ↔ if sR = true then (0 : ℝ) < P3381T1TriangleDeterminant - ![C.right.vertex irlast, C.right.vertex (irlast + (1 : Fin (C.rightParameter + (3 : - ℕ)))), - y] else P3381T1TriangleDeterminant ![C.right.vertex irlast, C.right.vertex (irlast - + (1 : Fin (C.rightParameter + (3 : ℕ)))), y] < (0 : ℝ)) → ( - let H : Real × Real → Real := fun y => - P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] - (∀ y ∈ Metric.ball x rL, (y ∈ OL ↔ if !sL then 0 < H y else H y < 0)) → ((∀ y ∈ - Metric.ball x rR, (y ∈ OR ↔ if sR then 0 < H y else H y < 0)) → ((x ∈ Op) → (∀ (rp : - ℝ), (Metric.ball x rp ⊆ Op) → (H x = 0))))))))) ) := by + ∀ (n : ℕ) (p : P3381T1PolygonBoundary n) + (a b : Fin (n + (3 : ℕ))), + ∀ x ∈ openSegment ℝ (p.vertex a) (p.vertex b), + let H := fun (y : ℝ × ℝ) => + P3381T1TriangleDeterminant + ![p.vertex a, p.vertex b, y]; + H x = (0 : ℝ)) := by classical - intro n p a b C Op OL OR x hx ilast irlast hxL hxR rL sL hsideL rR sR hsideR H hcanonL hcanonR - hxop rp hparentball + intro n p a b x hx H have hxseg : x ∈ segment Real (p.vertex a) (p.vertex b) := openSegment_subset_segment Real (p.vertex a) (p.vertex b) hx rw [segment_eq_image] at hxseg @@ -1105,8 +1085,7 @@ theorem P3650T1LocalCoherence {n : Nat} (p : P3381T1PolygonBoundary n) let dx := (p.vertex b).1 - (p.vertex a).1 let dy := (p.vertex b).2 - (p.vertex a).2 have hcoord : dx ≠ 0 ∨ dy ≠ 0 := LocalCoherenceProof.hcoord n p a b hABne - have hxdet : H x = 0 := LocalCoherenceProof.hxdet n p a b C x hx hxL hxR rL sL hsideL rR sR - hsideR hcanonL hcanonR hxop rp hparentball + have hxdet : H x = 0 := LocalCoherenceProof.hxdet n p a b x hx have hshift (u v : Real) : H (x.1 + u, x.2 + v) = H x + dx * v - dy * u := LocalCoherenceProof.hshift n p a b x u v have hshiftV (v : Real) : H (x.1, x.2 + v) = H x + dx * v := by diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean b/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean index e6a36b518a..7bfadd8eb3 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean @@ -873,19 +873,19 @@ private theorem flipSide : exact ⟨hb, by rw [hfg] at hg; linarith⟩ private theorem hform : - ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), (‖u‖ = 1) → ((u - ≠ v) → ((P3889T1TwoRaySectorDecomposition x r u v) → ( - let det : (Real × Real) → (Real × - Real) → Real := - fun a b => a.1 * b.2 - a.2 * b.1 - (u ≠ (0, 0)) → ((u.1 ≠ 0 ∨ u.2 ≠ 0) → ((v = -u) → ( - let A : (Real × Real) → Real := fun p => - det u (p - x) - ∀ (w : Real × Real), (w = u ∨ w = v) → (∀ (t : Real), ∀ (q : Real × Real), -u.1 * (q.2 - (x.2 - + t * w.2)) - - -u.2 * (q.1 - (x.1 + t * w.1)) = -A q))))))) := by - classical - intro x r u v hu huv E det hu_ne hcoord hvneg A w hw t q + (by + classical + exact + ∀ (x u v : ℝ × ℝ), + let det := fun (a b : ℝ × ℝ) => a.1 * b.2 - a.2 * b.1; + v = -u → + let A := fun (p : ℝ × ℝ) => det u (p - x); + ∀ (w : ℝ × ℝ), + w = u ∨ w = v → + ∀ (t : ℝ) (q : ℝ × ℝ), + -u.1 * (q.2 - (x.2 + t * w.2)) - -u.2 * (q.1 - (x.1 + t * w.1)) = -A q) := by + classical + intro x u v det hvneg A w hw t q rcases hw with rfl | hwv · dsimp [A, det] ring @@ -2278,8 +2278,7 @@ private theorem oppositeContinuation : have hform (w : Real × Real) (hw : w = u ∨ w = v) (t : Real) (q : Real × Real) : -u.1 * (q.2 - (x.2 + t * w.2)) - - -u.2 * (q.1 - (x.1 + t * w.1)) = -A q := SectorContinuationGeometry.hform x r u v hu huv - E hu_ne hcoord hvneg w hw t q + -u.2 * (q.1 - (x.1 + t * w.1)) = -A q := SectorContinuationGeometry.hform x u v hvneg w hw t q have hdist (w : Real × Real) (hw : ‖w‖ = 1) (t : Real) (ht : 0 < t) := SectorContinuationFacts.hdist x w hw t ht have hdelta (t : Real) (htr : t < r) : 0 < r - t := by diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean index beca934a26..8681714ea5 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean @@ -1561,66 +1561,22 @@ private theorem hpne : simp [h] at hlen private theorem huMem : - ∀ (W : Set GaussianInt), ∀ (F : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (u : - GaussianInt), ∀ (v : GaussianInt), (p.Nodup) → (((4 : ℕ) ≤ p.length) → ((p.head? = some - u) → ((p.getLast? = some v) → ((W = (↑p.toFinset : Set GaussianInt)) → ((∀ (a : - GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), - p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → ((∀ (e : Finset GaussianInt), e ∈ F - ↔ e = {v, u} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List - GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((3 ≤ p.length) → (( - let cyclicEdges := p.zip p.tail ++ [(v, u)]; - ∀ (q : LatticeCell), ((q + (1 : LatticeCell), q + (1 : - LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges ∧ (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 - : ℤ)⟩, q + (1 : LatticeCell)) ∉ cyclicEdges → GridRayCrossingIndex (q + (1 : - LatticeCell)) p = GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell), q + (1 : - LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 - : ℤ)⟩, q + (1 : LatticeCell)) ∈ cyclicEdges → (GridRayCrossingIndex (q + (1 : - LatticeCell)) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ)) ∧ ((q + (1 : LatticeCell) + - ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges ∧ (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + - (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges → GridRayCrossingIndex (q + ⟨(0 : - ℤ), (1 : ℤ)⟩) p = GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : - ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : - LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges → (GridRayCrossingIndex (q + ⟨(0 : ℤ), - (1 : ℤ)⟩) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ))) → ((∀ (g : Finset - GaussianInt), (g ∈ F) → (g = {v, u} ∨ ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ g = {a, b})) - → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, b} : Finset GaussianInt) ∈ F) → ((a, - b) ∈ (p.zip p.tail) ++ [(v, u)] ∨ (b, a) ∈ (p.zip p.tail) ++ [(v, u)])) → ((p ≠ []) → (u - ∈ p)))))))))))) := by + (by + classical + exact + ∀ (p : List GaussianInt) (u : GaussianInt), p.head? = some u → u ∈ p) := by classical - intro W F p u v hnodup hlen hhead hlast hvertices hsteps hedges hlen3 hcross hcycleEdge - cyclicPair hpne + intro p u hhead rcases (List.head?_eq_some_iff.mp hhead) with ⟨l, rfl⟩ simp private theorem hvMem : - ∀ (W : Set GaussianInt), ∀ (F : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (u : - GaussianInt), ∀ (v : GaussianInt), (p.Nodup) → (((4 : ℕ) ≤ p.length) → ((p.head? = some - u) → ((p.getLast? = some v) → ((W = (↑p.toFinset : Set GaussianInt)) → ((∀ (a : - GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), - p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → ((∀ (e : Finset GaussianInt), e ∈ F - ↔ e = {v, u} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List - GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((3 ≤ p.length) → (( - let cyclicEdges := p.zip p.tail ++ [(v, u)]; - ∀ (q : LatticeCell), ((q + (1 : LatticeCell), q + (1 : - LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges ∧ (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 - : ℤ)⟩, q + (1 : LatticeCell)) ∉ cyclicEdges → GridRayCrossingIndex (q + (1 : - LatticeCell)) p = GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell), q + (1 : - LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 - : ℤ)⟩, q + (1 : LatticeCell)) ∈ cyclicEdges → (GridRayCrossingIndex (q + (1 : - LatticeCell)) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ)) ∧ ((q + (1 : LatticeCell) + - ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges ∧ (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + - (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges → GridRayCrossingIndex (q + ⟨(0 : - ℤ), (1 : ℤ)⟩) p = GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : - ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : - LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges → (GridRayCrossingIndex (q + ⟨(0 : ℤ), - (1 : ℤ)⟩) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ))) → ((∀ (g : Finset - GaussianInt), (g ∈ F) → (g = {v, u} ∨ ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ g = {a, b})) - → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, b} : Finset GaussianInt) ∈ F) → ((a, - b) ∈ (p.zip p.tail) ++ [(v, u)] ∨ (b, a) ∈ (p.zip p.tail) ++ [(v, u)])) → ((p ≠ []) → ((u - ∈ p) → (v ∈ p))))))))))))) := by + (by + classical + exact + ∀ (p : List GaussianInt) (v : GaussianInt), p.getLast? = some v → v ∈ p) := by classical - intro W F p u v hnodup hlen hhead hlast hvertices hsteps hedges hlen3 hcross hcycleEdge - cyclicPair hpne huMem + intro p v hlast rcases (List.getLast?_eq_some_iff.mp hlast) with ⟨l, rfl⟩ simp @@ -2068,10 +2024,8 @@ theorem P3963T1ExteriorMixedCycleObstruction hlast hclose hsteps hedges hcross hcycleEdge (ExteriorMixedCycleProof.adjNe p) pairCases (ExteriorMixedCycleProof.adjacentMemZip) a b hab have hpne : p ≠ [] := ExteriorIndexCases.hpne p hlen - have huMem : u ∈ p := ExteriorIndexCases.huMem W F p u v hnodup hlen hhead hlast hvertices - hsteps hedges hlen3 hcross hcycleEdge cyclicPair hpne - have hvMem : v ∈ p := ExteriorIndexCases.hvMem W F p u v hnodup hlen hhead hlast hvertices - hsteps hedges hlen3 hcross hcycleEdge cyclicPair hpne huMem + have huMem : u ∈ p := ExteriorIndexCases.huMem p u hhead + have hvMem : v ∈ p := ExteriorIndexCases.hvMem p v hlast have vertexInW (z : GaussianInt) (hz : z ∈ p) : z ∈ W := ExteriorIndexCases.vertexInW W p hvertices z hz have hWfinite : W.Finite := ExteriorIndexCases.hWfinite W p hvertices diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean index 36eac02892..94652e7c21 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean @@ -954,54 +954,40 @@ private theorem hdispR : (by classical exact - ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : - ProtoTile), ∀ (W : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if (Even s.val) - then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < (r (if - Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → - ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → ((TileCentroid Z - TileCentroid U - = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if - Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : - ℕ))).succ) - BandVectors.1 (r (i - (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - else BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : ℕ))).succ))) → ( - let q : GaussianInt := ⟨0, 1⟩ - ∀ (aU : GaussianInt), ∀ (aW : GaussianInt), ∀ (aZ : GaussianInt), - let Wp := TileTranslation W (aU - aW) - let Zp := TileTranslation Z (aU - aZ) - (BandPrototile (r ((if Even s.val then i - 1 else i + 1).succ)) Zp) → (((-(TileCentroid W - - TileCentroid U).2, (TileCentroid W - TileCentroid U).1) = (1 / 2 : Real) • - GaussianRealPoint (q * (q ^ s.val * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 - (r 0) (r i.succ))))) → ( - let t : Fin 4 := s + 1 - (Even t.val ↔ ¬ Even s.val) → ((q ^ 2 = -1) → ((q ^ 3 = -q) → ((∀ (x : GaussianInt), q * - (q * x) = -x) → ((q ^ t.val = q * q ^ s.val) → ((TileCentroid Wp - TileCentroid U = - (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * (BandVectors.1 (r i.succ) (r 0) + - BandVectors.1 (r 0) (r i.succ)))) → (((-(TileCentroid Z - TileCentroid U).2, - (TileCentroid Z - TileCentroid U).1) = (1 / 2 : Real) • GaussianRealPoint (q * (q ^ - s.val * (if Even s.val then BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r - ((i - 1).succ)) (r 0) else BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r - 0) (r ((i + 1).succ)))))) → ((TileCentroid Zp - TileCentroid U = (1 / 2 : Real) • - GaussianRealPoint (q ^ t.val * (if Even t.val then BandVectors.1 (r ((i + 1).succ)) - (r 0) - BandVectors.1 (r 0) (r ((i + 1).succ)) else BandVectors.1 (r 0) (r ((i - - 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r 0)))) → (((r ((if Even t.val then i + - 1 else i - 1).succ)) = (r ((if Even s.val then i - 1 else i + 1).succ))) → ( - let uL : GaussianInt := q ^ s.val * - (if Even s.val then BandVectors.1 (r i.succ) (r 0) - else BandVectors.1 (r 0) (r i.succ)) - ((pairedEndpointPackage r U) i t Wp - Zp) → ( - let q3 : GaussianInt → GaussianInt := fun x => - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) - let vR : GaussianInt := q ^ t.val * - (if Even t.val then BandVectors.1 (r 0) (r i.succ) - else BandVectors.1 (r i.succ) (r 0)) - (Even (0 : Nat)) → ((Even (2 : Nat)) → ((¬ Even (1 : Nat)) → ((¬ Even (3 : Nat)) → ((∀ (x - : GaussianInt), q3 x = q ^ 3 * x) → (q3 vR = uL))))))))))))))))))))) ) := by + ∀ (r : Fin (4 : ℕ) → CircleCoordinates) + (i : Fin (3 : ℕ)) (s : Fin (4 : ℕ)), + let q := { re := (0 : ℤ), im := (1 : ℤ) }; + let t := s + (1 : Fin (4 : ℕ)); + q ^ (2 : ℕ) = (-1 : GaussianInt) → + q ^ (3 : ℕ) = -q → + (∀ (x : GaussianInt), q * (q * x) = -x) → + let uL := + q ^ (↑s : ℕ) * + if Even (↑s : ℕ) then + BandVectors.1 (r i.succ) + (r (0 : Fin (4 : ℕ))) + else + BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r i.succ); + let q3 := fun (x : GaussianInt) => + GaussianQuarterTurn + (GaussianQuarterTurn + (GaussianQuarterTurn x)); + let vR := + q ^ (↑t : ℕ) * + if Even (↑t : ℕ) then + BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r i.succ) + else + BandVectors.1 (r i.succ) + (r (0 : Fin (4 : ℕ))); + Even (0 : ℕ) → + Even (2 : ℕ) → + ¬Even (1 : ℕ) → + ¬Even (3 : ℕ) → + (∀ (x : GaussianInt), q3 x = q ^ (3 : ℕ) * x) → q3 vR = uL) := by classical - intro r i s U W Z hZ hZpos hWcent hZcent q aU aW aZ Wp Zp hZp hWrot t htpar hq2 hq3 hq2act - hpower hWsrc hZrot hZsrc hZlabel uL sourceData q3 vR even0 even2 notEven1 notEven3 hq3mul + intro r i s q t hq2 hq3 hq2act uL q3 vR even0 even2 notEven1 notEven3 hq3mul let uR : GaussianInt := q ^ s.val * (if Even s.val then BandVectors.1 (r 0) (r i.succ) else BandVectors.1 (r i.succ) (r 0)) @@ -1014,62 +1000,40 @@ private theorem hdispL : (by classical exact - ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : - ProtoTile), ∀ (W : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if (Even s.val) - then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < (r (if - Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → - ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → ((TileCentroid Z - TileCentroid U - = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if - Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : - ℕ))).succ) - BandVectors.1 (r (i - (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - else BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : ℕ))).succ))) → ( - let q : GaussianInt := ⟨0, 1⟩ - ∀ (aU : GaussianInt), ∀ (aW : GaussianInt), ∀ (aZ : GaussianInt), - let Wp := TileTranslation W (aU - aW) - let Zp := TileTranslation Z (aU - aZ) - (BandPrototile (r ((if Even s.val then i - 1 else i + 1).succ)) Zp) → (((-(TileCentroid W - - TileCentroid U).2, (TileCentroid W - TileCentroid U).1) = (1 / 2 : Real) • - GaussianRealPoint (q * (q ^ s.val * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 - (r 0) (r i.succ))))) → ( - let t : Fin 4 := s + 1 - (Even t.val ↔ ¬ Even s.val) → ((q ^ 2 = -1) → ((q ^ 3 = -q) → ((∀ (x : GaussianInt), q * - (q * x) = -x) → ((q ^ t.val = q * q ^ s.val) → ((TileCentroid Wp - TileCentroid U = - (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * (BandVectors.1 (r i.succ) (r 0) + - BandVectors.1 (r 0) (r i.succ)))) → (((-(TileCentroid Z - TileCentroid U).2, - (TileCentroid Z - TileCentroid U).1) = (1 / 2 : Real) • GaussianRealPoint (q * (q ^ - s.val * (if Even s.val then BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r - ((i - 1).succ)) (r 0) else BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r - 0) (r ((i + 1).succ)))))) → ((TileCentroid Zp - TileCentroid U = (1 / 2 : Real) • - GaussianRealPoint (q ^ t.val * (if Even t.val then BandVectors.1 (r ((i + 1).succ)) - (r 0) - BandVectors.1 (r 0) (r ((i + 1).succ)) else BandVectors.1 (r 0) (r ((i - - 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r 0)))) → (((r ((if Even t.val then i + - 1 else i - 1).succ)) = (r ((if Even s.val then i - 1 else i + 1).succ))) → ( - let uR : GaussianInt := q ^ s.val * - (if Even s.val then BandVectors.1 (r 0) (r i.succ) - else BandVectors.1 (r i.succ) (r 0)) - let uL : GaussianInt := q ^ s.val * - (if Even s.val then BandVectors.1 (r i.succ) (r 0) - else BandVectors.1 (r 0) (r i.succ)) - ((pairedEndpointPackage r U) i t Wp - Zp) → ( - let q3 : GaussianInt → GaussianInt := fun x => - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) - let vR : GaussianInt := q ^ t.val * - (if Even t.val then BandVectors.1 (r 0) (r i.succ) - else BandVectors.1 (r i.succ) (r 0)) - let vL : GaussianInt := q ^ t.val * - (if Even t.val then BandVectors.1 (r i.succ) (r 0) - else BandVectors.1 (r 0) (r i.succ)) - (Even (0 : Nat)) → ((Even (2 : Nat)) → ((¬ Even (1 : Nat)) → ((¬ Even (3 : Nat)) → ((∀ (x - : GaussianInt), q3 x = q ^ 3 * x) → ((q3 vR = uL) → (q3 vL = uR)))))))))))))))))))))) - ) := by + ∀ (r : Fin (4 : ℕ) → CircleCoordinates) + (i : Fin (3 : ℕ)) (s : Fin (4 : ℕ)), + let q := { re := (0 : ℤ), im := (1 : ℤ) }; + let t := s + (1 : Fin (4 : ℕ)); + q ^ (2 : ℕ) = (-1 : GaussianInt) → + q ^ (3 : ℕ) = -q → + (∀ (x : GaussianInt), q * (q * x) = -x) → + let uR := + q ^ (↑s : ℕ) * + if Even (↑s : ℕ) then + BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r i.succ) + else + BandVectors.1 (r i.succ) + (r (0 : Fin (4 : ℕ))); + let q3 := fun (x : GaussianInt) => + GaussianQuarterTurn + (GaussianQuarterTurn + (GaussianQuarterTurn x)); + let vL := + q ^ (↑t : ℕ) * + if Even (↑t : ℕ) then + BandVectors.1 (r i.succ) + (r (0 : Fin (4 : ℕ))) + else + BandVectors.1 (r (0 : Fin (4 : ℕ))) + (r i.succ); + Even (0 : ℕ) → + Even (2 : ℕ) → + ¬Even (1 : ℕ) → + ¬Even (3 : ℕ) → + (∀ (x : GaussianInt), q3 x = q ^ (3 : ℕ) * x) → q3 vL = uR) := by classical - intro r i s U W Z hZ hZpos hWcent hZcent q aU aW aZ Wp Zp hZp hWrot t htpar hq2 hq3 hq2act - hpower hWsrc hZrot hZsrc hZlabel uR uL sourceData q3 vR vL even0 even2 notEven1 notEven3 - hq3mul hdispR + intro r i s q t hq2 hq3 hq2act uR q3 vL even0 even2 notEven1 notEven3 hq3mul rw [hq3mul] fin_cases s <;> simp [vL, uR, t, even0, even2, notEven1, notEven3, hq2, hq3] <;> @@ -1441,12 +1405,10 @@ theorem P4055T1OrderedGeneralOppositeEndpoints : have notEven1 := OppositeEndpointGeometry.notEven1 r i s have notEven3 := OppositeEndpointGeometry.notEven3 r i s have hq3mul := OppositeEndpointGeometry.hq3mul hq3 - have hdispR := OppositeEndpointGeometry.hdispR r i s U W Z hZ hZpos hWcent hZcent - aU aW aZ hZp hWrot htpar hq2 hq3 hq2act hpower hWsrc hZrot hZsrc hZlabel sourceData even0 + have hdispR := OppositeEndpointGeometry.hdispR r i s hq2 hq3 hq2act even0 + even2 notEven1 notEven3 hq3mul + have hdispL := OppositeEndpointGeometry.hdispL r i s hq2 hq3 hq2act even0 even2 notEven1 notEven3 hq3mul - have hdispL := OppositeEndpointGeometry.hdispL r i s U W Z hZ hZpos hWcent hZcent - aU aW aZ hZp hWrot htpar hq2 hq3 hq2act hpower hWsrc hZrot hZsrc hZlabel sourceData even0 - even2 notEven1 notEven3 hq3mul hdispR have hstep := OppositeEndpointGeometry.hstep r i s U W Z aU haU hUc hUa hUv aW aZ hWp hZp haUre haUim hWpCent hZpCent hWsrc hZsrc sourceData hFf hfF hf hUedges hFvU hFeU hFvW hFvZ hFeW hFeZ hinvV hinvE hFtranslate hFtranslateE diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean index c7e5a085ed..bc7325884c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean @@ -95,43 +95,23 @@ private theorem hWlabel : (by classical exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W - : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r i.succ) W) → ((BandPrototile (r - (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → - (((0 : ℤ) < (r i.succ).1) → (((0 : ℤ) < (r (if Even (↑s : ℕ) then i - (1 : Fin (3 : - ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → ((TileCentroid W - TileCentroid U = (1 / 2 - : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * - (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) - (r i.succ)))) → ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint - ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 - (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - BandVectors.1 (r (i - (1 : - Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) else BandVectors.1 (r (i + (1 : Fin (3 : - ℕ))).succ) (r (0 : Fin (4 : ℕ))) - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : - Fin (3 : ℕ))).succ))) → (∀ (a : Fin 3), ∀ (g : BandPackingSymmetry), - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - (ProperBandQuadruple q) → (∀ (negative : Bool), (BandPackingSymmetryScopedPhase g q - negative) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : - Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 - : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g r negative) → - ((∀ (t : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : - ℕ)) = q (2 : Fin (4 : ℕ)) → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → - BandPackingSymmetryScopedPhase g t negative) → (∀ (g' : BandPackingSymmetry), - (BandPackingSymmetryScopedPhase g' q false) → ((∀ (r : Fin (4 : ℕ) → - CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) - → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : - ℕ)) → BandPackingSymmetryScopedPhase g' r false) → ((∀ (t : Fin (4 : ℕ) → - CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) - → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g' t - false) → ( - let qg := BandPackingSymmetryQuadrupleAction g' q - let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' - then -(i - a) else i - a - (ProperBandQuadruple qg) → ((BandPrototile (qg 0) (BandPackingSymmetryTileAction g' U)) → - (qg k.succ = BandPackingSymmetryCircleAction g' (r i.succ)))))))))))))))) ) := by - classical - intro r i s U W Z hW hZ hWpos hZpos hWcent hZcent a g q hq negative hphase hphase1 hphase2 g' - hfalse hfalse1 hfalse2 qg k hproperG hU' + ∀ (r : Fin (4 : ℕ) → CircleCoordinates) + (i a : Fin (3 : ℕ)), + let q := + ![r (0 : Fin (4 : ℕ)), r a.succ, r (a + (1 : Fin (3 : ℕ))).succ, + r (a + (2 : Fin (3 : ℕ))).succ]; + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q; + let k := + if + BandPackingSymmetryReversesOrientation g' = + true then + -(i - a) + else i - a; + qg k.succ = + BandPackingSymmetryCircleAction g' (r i.succ)) := by + classical + intro r i a q g' qg k dsimp [qg, k, q, BandPackingSymmetryQuadrupleAction] cases ho : BandPackingSymmetryReversesOrientation g' <;> fin_cases a <;> fin_cases i <;> @@ -141,33 +121,14 @@ private theorem cyclicIndex : (by classical exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (U : ProtoTile), ∀ (a : Fin 3), ∀ (g - : BandPackingSymmetry), - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - (ProperBandQuadruple q) → (∀ (negative : Bool), (BandPackingSymmetryScopedPhase g q - negative) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : - Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 - : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g r negative) → - ((∀ (t : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : - ℕ)) = q (2 : Fin (4 : ℕ)) → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → - BandPackingSymmetryScopedPhase g t negative) → (∀ (g' : BandPackingSymmetry), - (BandPackingSymmetryScopedPhase g' q false) → ((∀ (r : Fin (4 : ℕ) → - CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) - → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : - ℕ)) → BandPackingSymmetryScopedPhase g' r false) → ((∀ (t : Fin (4 : ℕ) → - CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) - → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g' t - false) → ( - let qg := BandPackingSymmetryQuadrupleAction g' q - let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' - then -(i - a) else i - a - (ProperBandQuadruple qg) → ((BandPrototile (qg 0) (BandPackingSymmetryTileAction g' U)) → - ((qg k.succ = BandPackingSymmetryCircleAction g' (r i.succ)) → (∀ (j₀ : Fin 3), q - j₀.succ = r (a + j₀).succ)))))))))) ) := by + ∀ (r : Fin (4 : ℕ) → CircleCoordinates) + (a : Fin (3 : ℕ)), + let q := + ![r (0 : Fin (4 : ℕ)), r a.succ, r (a + (1 : Fin (3 : ℕ))).succ, + r (a + (2 : Fin (3 : ℕ))).succ]; + ∀ (j₀ : Fin (3 : ℕ)), q j₀.succ = r (a + j₀).succ) := by classical - intro r i U a g q hq negative hphase hphase1 hphase2 g' hfalse hfalse1 hfalse2 qg k hproperG - hU' hWlabel j₀ + intro r a q j₀ dsimp [q] fin_cases a <;> fin_cases j₀ <;> rfl @@ -1769,106 +1730,83 @@ private theorem hdR : (by classical exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W - : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if Even (↑s : ℕ) then i - (1 : - Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < (r (if Even (↑s : ℕ) - then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → ((TileCentroid W - - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : - Fin (4 : ℕ))) (r i.succ)))) → ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • - GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) - then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - - BandVectors.1 (r (i - (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) else - BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - BandVectors.1 - (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : ℕ))).succ))) → (∀ (a : Fin 3), - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - ∀ (g' : BandPackingSymmetry), - let qg := BandPackingSymmetryQuadrupleAction g' q - let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' - then -(i - a) else i - a - let sigma : Fin 3 → Fin 3 := fun m => - if BandPackingSymmetryReversesOrientation g' then -m else m - (Even 0) → ((Even 2) → ((¬ Even 1) → ((¬ Even 3) → ((∀ (s₀ : Fin 4), ((-s₀ - 1 : Fin 4) : - Nat) = (3 - s₀.val) % 4) → ( - let ii : GaussianInt := ⟨0, 1⟩ - (ii ^ 2 = -1) → ((ii ^ 3 = -ii) → (((-ii) ^ 2 = -1) → (((-ii) ^ 3 = ii) → ((∀ (g₀ : - BandPackingSymmetry), ∀ (n : Nat), ∀ (x : GaussianInt), - BandPackingSymmetryVectorAction g₀ (ii ^ n * x) = (if - BandPackingSymmetryReversesOrientation g₀ then (-ii) ^ n else ii ^ n) * - BandPackingSymmetryVectorAction g₀ x) → ( - let vR := BandVectors.1 (r i.succ) (r 0) - let vL := BandVectors.1 (r 0) (r i.succ) - let vR' := BandVectors.1 (qg k.succ) (qg 0) - let vL' := BandVectors.1 (qg 0) (qg k.succ) - (vL' = ii * vR') → ( - let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' - then -s - 1 else s - (BandPackingSymmetryVectorAction g' (ii ^ s.val * (vR + vL)) = ii ^ t.val * (vR' + vL')) - → (((if Even t.val then k - 1 else k + 1) = if BandPackingSymmetryReversesOrientation - g' then -((if Even s.val then i - 1 else i + 1) - a) else (if Even s.val then i - 1 - else i + 1) - a) → ( - let j : Fin 3 := if Even t.val then k - 1 else k + 1 - ((if BandPackingSymmetryReversesOrientation g' then -j else j) = (if Even s.val then i - - 1 else i + 1) - a) → ((q ((if BandPackingSymmetryReversesOrientation g' then -j else - j).succ) = r ((if Even s.val then i - 1 else i + 1).succ)) → ((qg j.succ = - BandPackingSymmetryCircleAction g' (r ((if Even s.val then i - 1 else i + 1).succ))) → ( - let adj : Fin 3 := if Even s.val then i - 1 else i + 1 - let mZ : Fin 3 := adj - a - ((if BandPackingSymmetryReversesOrientation g' then -j else j) = mZ) → (((if - BandPackingSymmetryReversesOrientation g' then -mZ else mZ) = j) → ((sigma mZ = j) → - ((BandVectors.1 (qg j.succ) (qg 0) = BandPackingSymmetryVectorAction g' - (BandVectors.1 (r adj.succ) (r 0))) → ((BandVectors.1 (qg 0) (qg j.succ) = if - BandPackingSymmetryReversesOrientation g' then -BandPackingSymmetryVectorAction g' - (BandVectors.1 (r 0) (r adj.succ)) else BandPackingSymmetryVectorAction g' - (BandVectors.1 (r 0) (r adj.succ))) → ( - let xZ := BandVectors.1 (r adj.succ) (r 0) - let yZ := BandVectors.1 (r 0) (r adj.succ) - let xZ' := BandVectors.1 (qg j.succ) (qg 0) - let yZ' := BandVectors.1 (qg 0) (qg j.succ) - (yZ' = ii * xZ') → ((BandPackingSymmetryVectorAction g' xZ = xZ') → - ((BandPackingSymmetryVectorAction g' yZ = if BandPackingSymmetryReversesOrientation - g' then -yZ' else yZ') → ((BandPackingSymmetryVectorAction g' (if Even s.val then yZ - - xZ else xZ - yZ) = if Even s.val then (if BandPackingSymmetryReversesOrientation g' - then -yZ' - xZ' else yZ' - xZ') else (if BandPackingSymmetryReversesOrientation g' - then xZ' + yZ' else xZ' - yZ')) → ((BandPackingSymmetryVectorAction g' (ii ^ s.val * - (if Even s.val then yZ - xZ else xZ - yZ)) = ii ^ t.val * (if Even t.val then yZ' - - xZ' else xZ' - yZ')) → ((BandPrototile (qg j.succ) (BandPackingSymmetryTileAction g' - Z)) → ((0 < (qg j.succ).1) → ((TileCentroid (BandPackingSymmetryTileAction g' W) - - TileCentroid (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • - GaussianRealPoint (BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val - * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))))) → - ((TileCentroid (BandPackingSymmetryTileAction g' Z) - TileCentroid - (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • GaussianRealPoint - (BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val * (if Even s.val - then BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r 0) - else BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r 0) (r ((i + - 1).succ)))))) → ((BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val - * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))) = ii ^ t.val * - (BandVectors.1 (qg k.succ) (qg 0) + BandVectors.1 (qg 0) (qg k.succ))) → - ((TileCentroid (BandPackingSymmetryTileAction g' W) - TileCentroid - (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • GaussianRealPoint (ii ^ t.val - * (BandVectors.1 (qg k.succ) (qg 0) + BandVectors.1 (qg 0) (qg k.succ)))) → - ((BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val * (if Even s.val - then BandVectors.1 (r 0) (r adj.succ) - BandVectors.1 (r adj.succ) (r 0) else - BandVectors.1 (r adj.succ) (r 0) - BandVectors.1 (r 0) (r adj.succ))) = ii ^ t.val * - (if Even t.val then BandVectors.1 (qg 0) (qg j.succ) - BandVectors.1 (qg j.succ) (qg - 0) else BandVectors.1 (qg j.succ) (qg 0) - BandVectors.1 (qg 0) (qg j.succ))) → - ((TileCentroid (BandPackingSymmetryTileAction g' Z) - TileCentroid - (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • GaussianRealPoint (ii ^ t.val - * (if Even t.val then BandVectors.1 (qg 0) (qg j.succ) - BandVectors.1 (qg j.succ) - (qg 0) else BandVectors.1 (qg j.succ) (qg 0) - BandVectors.1 (qg 0) (qg j.succ)))) → - ((BandPackingSymmetryVectorAction g' vR = vR') → ((BandPackingSymmetryVectorAction g' - vL = if BandPackingSymmetryReversesOrientation g' then -vL' else vL') → - (BandPackingSymmetryVectorAction g' (ii ^ s.val * (if Even s.val then vL else vR)) = - ii ^ t.val * (if Even t.val then vL' else - vR'))))))))))))))))))))))))))))))))))))))))) ) := by - classical - intro r i s U W Z hZ hZpos hWcent hZcent a q g' qg k sigma evenZero evenTwo notEvenOne - notEvenThree hnegVal ii iiSq iiCube negIiSq negIiCube lpow vR vL vR' vL' hbackEq' t hdispW - hZindex j hZparentIndex hZcircle hZlabel adj mZ hZrel hZsigma hZsigma' hZphaseForward - hZphaseBackward xZ yZ xZ' yZ' hZflip hZactionForward hZactionBackward hZsourceAction hZvec - hZ' hZpos' hWcent' hZcent' hWvec hWcentNorm hZvec' hZcentNorm hvR hvL + ∀ (r : Fin (4 : ℕ) → CircleCoordinates) + (i : Fin (3 : ℕ)) (s : Fin (4 : ℕ)) (a : Fin (3 : ℕ)), + let q := + ![r (0 : Fin (4 : ℕ)), r a.succ, r (a + (1 : Fin (3 : ℕ))).succ, + r (a + (2 : Fin (3 : ℕ))).succ]; + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q; + let k := + if + BandPackingSymmetryReversesOrientation g' = + true then + -(i - a) + else i - a; + Even (0 : ℕ) → + Even (2 : ℕ) → + ¬Even (1 : ℕ) → + ¬Even (3 : ℕ) → + (∀ (s₀ : Fin (4 : ℕ)), + (↑(-s₀ - (1 : Fin (4 : ℕ))) : ℕ) = + ((3 : ℕ) - (↑s₀ : ℕ)) % (4 : ℕ)) → + let ii := { re := (0 : ℤ), im := (1 : ℤ) }; + ii ^ (2 : ℕ) = (-1 : GaussianInt) → + ii ^ (3 : ℕ) = -ii → + (-ii) ^ (2 : ℕ) = (-1 : GaussianInt) → + (-ii) ^ (3 : ℕ) = ii → + (∀ (g₀ : BandPackingSymmetry) + (n : ℕ) (x : GaussianInt), + BandPackingSymmetryVectorAction + g₀ (ii ^ n * x) = + (if + BandPackingSymmetryReversesOrientation + g₀ = + true then + (-ii) ^ n + else ii ^ n) * + BandPackingSymmetryVectorAction + g₀ x) → + let vR := + BandVectors.1 (r i.succ) + (r (0 : Fin (4 : ℕ))); + let vL := + BandVectors.1 + (r (0 : Fin (4 : ℕ))) (r i.succ); + let vR' := + BandVectors.1 (qg k.succ) + (qg (0 : Fin (4 : ℕ))); + let vL' := + BandVectors.1 + (qg (0 : Fin (4 : ℕ))) (qg k.succ); + vL' = ii * vR' → + let t := + if + BandPackingSymmetryReversesOrientation + g' = + true then + -s - (1 : Fin (4 : ℕ)) + else s; + BandPackingSymmetryVectorAction + g' vR = + vR' → + (BandPackingSymmetryVectorAction + g' vL = + if + BandPackingSymmetryReversesOrientation + g' = + true then + -vL' + else vL') → + BandPackingSymmetryVectorAction + g' + (ii ^ (↑s : ℕ) * + if Even (↑s : ℕ) then vL else vR) = + ii ^ (↑t : ℕ) * + if Even (↑t : ℕ) then vL' else vR') := by + classical + intro r i s a q g' qg k evenZero evenTwo notEvenOne notEvenThree hnegVal ii iiSq iiCube + negIiSq negIiCube lpow vR vL vR' vL' hbackEq' t hvR hvL rw [lpow] cases ho : BandPackingSymmetryReversesOrientation g' <;> fin_cases s <;> simp [t, ho, evenZero, evenTwo, notEvenOne, notEvenThree, @@ -1879,107 +1817,83 @@ private theorem hdL : (by classical exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W - : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if Even (↑s : ℕ) then i - (1 : - Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < (r (if Even (↑s : ℕ) - then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → ((TileCentroid W - - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : - Fin (4 : ℕ))) (r i.succ)))) → ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • - GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) - then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - - BandVectors.1 (r (i - (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) else - BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - BandVectors.1 - (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : ℕ))).succ))) → (∀ (a : Fin 3), - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - ∀ (g' : BandPackingSymmetry), - let qg := BandPackingSymmetryQuadrupleAction g' q - let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' - then -(i - a) else i - a - let sigma : Fin 3 → Fin 3 := fun m => - if BandPackingSymmetryReversesOrientation g' then -m else m - (Even 0) → ((Even 2) → ((¬ Even 1) → ((¬ Even 3) → ((∀ (s₀ : Fin 4), ((-s₀ - 1 : Fin 4) : - Nat) = (3 - s₀.val) % 4) → ( - let ii : GaussianInt := ⟨0, 1⟩ - (ii ^ 2 = -1) → ((ii ^ 3 = -ii) → (((-ii) ^ 2 = -1) → (((-ii) ^ 3 = ii) → ((∀ (g₀ : - BandPackingSymmetry), ∀ (n : Nat), ∀ (x : GaussianInt), - BandPackingSymmetryVectorAction g₀ (ii ^ n * x) = (if - BandPackingSymmetryReversesOrientation g₀ then (-ii) ^ n else ii ^ n) * - BandPackingSymmetryVectorAction g₀ x) → ( - let vR := BandVectors.1 (r i.succ) (r 0) - let vL := BandVectors.1 (r 0) (r i.succ) - let vR' := BandVectors.1 (qg k.succ) (qg 0) - let vL' := BandVectors.1 (qg 0) (qg k.succ) - (vL' = ii * vR') → ( - let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' - then -s - 1 else s - (BandPackingSymmetryVectorAction g' (ii ^ s.val * (vR + vL)) = ii ^ t.val * (vR' + vL')) - → (((if Even t.val then k - 1 else k + 1) = if BandPackingSymmetryReversesOrientation - g' then -((if Even s.val then i - 1 else i + 1) - a) else (if Even s.val then i - 1 - else i + 1) - a) → ( - let j : Fin 3 := if Even t.val then k - 1 else k + 1 - ((if BandPackingSymmetryReversesOrientation g' then -j else j) = (if Even s.val then i - - 1 else i + 1) - a) → ((q ((if BandPackingSymmetryReversesOrientation g' then -j else - j).succ) = r ((if Even s.val then i - 1 else i + 1).succ)) → ((qg j.succ = - BandPackingSymmetryCircleAction g' (r ((if Even s.val then i - 1 else i + 1).succ))) → ( - let adj : Fin 3 := if Even s.val then i - 1 else i + 1 - let mZ : Fin 3 := adj - a - ((if BandPackingSymmetryReversesOrientation g' then -j else j) = mZ) → (((if - BandPackingSymmetryReversesOrientation g' then -mZ else mZ) = j) → ((sigma mZ = j) → - ((BandVectors.1 (qg j.succ) (qg 0) = BandPackingSymmetryVectorAction g' - (BandVectors.1 (r adj.succ) (r 0))) → ((BandVectors.1 (qg 0) (qg j.succ) = if - BandPackingSymmetryReversesOrientation g' then -BandPackingSymmetryVectorAction g' - (BandVectors.1 (r 0) (r adj.succ)) else BandPackingSymmetryVectorAction g' - (BandVectors.1 (r 0) (r adj.succ))) → ( - let xZ := BandVectors.1 (r adj.succ) (r 0) - let yZ := BandVectors.1 (r 0) (r adj.succ) - let xZ' := BandVectors.1 (qg j.succ) (qg 0) - let yZ' := BandVectors.1 (qg 0) (qg j.succ) - (yZ' = ii * xZ') → ((BandPackingSymmetryVectorAction g' xZ = xZ') → - ((BandPackingSymmetryVectorAction g' yZ = if BandPackingSymmetryReversesOrientation - g' then -yZ' else yZ') → ((BandPackingSymmetryVectorAction g' (if Even s.val then yZ - - xZ else xZ - yZ) = if Even s.val then (if BandPackingSymmetryReversesOrientation g' - then -yZ' - xZ' else yZ' - xZ') else (if BandPackingSymmetryReversesOrientation g' - then xZ' + yZ' else xZ' - yZ')) → ((BandPackingSymmetryVectorAction g' (ii ^ s.val * - (if Even s.val then yZ - xZ else xZ - yZ)) = ii ^ t.val * (if Even t.val then yZ' - - xZ' else xZ' - yZ')) → ((BandPrototile (qg j.succ) (BandPackingSymmetryTileAction g' - Z)) → ((0 < (qg j.succ).1) → ((TileCentroid (BandPackingSymmetryTileAction g' W) - - TileCentroid (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • - GaussianRealPoint (BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val - * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))))) → - ((TileCentroid (BandPackingSymmetryTileAction g' Z) - TileCentroid - (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • GaussianRealPoint - (BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val * (if Even s.val - then BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r 0) - else BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r 0) (r ((i + - 1).succ)))))) → ((BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val - * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))) = ii ^ t.val * - (BandVectors.1 (qg k.succ) (qg 0) + BandVectors.1 (qg 0) (qg k.succ))) → - ((TileCentroid (BandPackingSymmetryTileAction g' W) - TileCentroid - (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • GaussianRealPoint (ii ^ t.val - * (BandVectors.1 (qg k.succ) (qg 0) + BandVectors.1 (qg 0) (qg k.succ)))) → - ((BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val * (if Even s.val - then BandVectors.1 (r 0) (r adj.succ) - BandVectors.1 (r adj.succ) (r 0) else - BandVectors.1 (r adj.succ) (r 0) - BandVectors.1 (r 0) (r adj.succ))) = ii ^ t.val * - (if Even t.val then BandVectors.1 (qg 0) (qg j.succ) - BandVectors.1 (qg j.succ) (qg - 0) else BandVectors.1 (qg j.succ) (qg 0) - BandVectors.1 (qg 0) (qg j.succ))) → - ((TileCentroid (BandPackingSymmetryTileAction g' Z) - TileCentroid - (BandPackingSymmetryTileAction g' U) = (1 / 2 : Real) • GaussianRealPoint (ii ^ t.val - * (if Even t.val then BandVectors.1 (qg 0) (qg j.succ) - BandVectors.1 (qg j.succ) - (qg 0) else BandVectors.1 (qg j.succ) (qg 0) - BandVectors.1 (qg 0) (qg j.succ)))) → - ((BandPackingSymmetryVectorAction g' vR = vR') → ((BandPackingSymmetryVectorAction g' - vL = if BandPackingSymmetryReversesOrientation g' then -vL' else vL') → - ((BandPackingSymmetryVectorAction g' (ii ^ s.val * (if Even s.val then vL else vR)) = - ii ^ t.val * (if Even t.val then vL' else vR')) → (BandPackingSymmetryVectorAction g' - (ii ^ s.val * (if Even s.val then vR else vL)) = ii ^ t.val * (if Even t.val then vR' - else vL')))))))))))))))))))))))))))))))))))))))))) ) := by - classical - intro r i s U W Z hZ hZpos hWcent hZcent a q g' qg k sigma evenZero evenTwo notEvenOne - notEvenThree hnegVal ii iiSq iiCube negIiSq negIiCube lpow vR vL vR' vL' hbackEq' t hdispW - hZindex j hZparentIndex hZcircle hZlabel adj mZ hZrel hZsigma hZsigma' hZphaseForward - hZphaseBackward xZ yZ xZ' yZ' hZflip hZactionForward hZactionBackward hZsourceAction hZvec - hZ' hZpos' hWcent' hZcent' hWvec hWcentNorm hZvec' hZcentNorm hvR hvL hdR + ∀ (r : Fin (4 : ℕ) → CircleCoordinates) + (i : Fin (3 : ℕ)) (s : Fin (4 : ℕ)) (a : Fin (3 : ℕ)), + let q := + ![r (0 : Fin (4 : ℕ)), r a.succ, r (a + (1 : Fin (3 : ℕ))).succ, + r (a + (2 : Fin (3 : ℕ))).succ]; + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q; + let k := + if + BandPackingSymmetryReversesOrientation g' = + true then + -(i - a) + else i - a; + Even (0 : ℕ) → + Even (2 : ℕ) → + ¬Even (1 : ℕ) → + ¬Even (3 : ℕ) → + (∀ (s₀ : Fin (4 : ℕ)), + (↑(-s₀ - (1 : Fin (4 : ℕ))) : ℕ) = + ((3 : ℕ) - (↑s₀ : ℕ)) % (4 : ℕ)) → + let ii := { re := (0 : ℤ), im := (1 : ℤ) }; + ii ^ (2 : ℕ) = (-1 : GaussianInt) → + ii ^ (3 : ℕ) = -ii → + (-ii) ^ (2 : ℕ) = (-1 : GaussianInt) → + (-ii) ^ (3 : ℕ) = ii → + (∀ (g₀ : BandPackingSymmetry) + (n : ℕ) (x : GaussianInt), + BandPackingSymmetryVectorAction + g₀ (ii ^ n * x) = + (if + BandPackingSymmetryReversesOrientation + g₀ = + true then + (-ii) ^ n + else ii ^ n) * + BandPackingSymmetryVectorAction + g₀ x) → + let vR := + BandVectors.1 (r i.succ) + (r (0 : Fin (4 : ℕ))); + let vL := + BandVectors.1 + (r (0 : Fin (4 : ℕ))) (r i.succ); + let vR' := + BandVectors.1 (qg k.succ) + (qg (0 : Fin (4 : ℕ))); + let vL' := + BandVectors.1 + (qg (0 : Fin (4 : ℕ))) (qg k.succ); + vL' = ii * vR' → + let t := + if + BandPackingSymmetryReversesOrientation + g' = + true then + -s - (1 : Fin (4 : ℕ)) + else s; + BandPackingSymmetryVectorAction + g' vR = + vR' → + (BandPackingSymmetryVectorAction + g' vL = + if + BandPackingSymmetryReversesOrientation + g' = + true then + -vL' + else vL') → + BandPackingSymmetryVectorAction + g' + (ii ^ (↑s : ℕ) * + if Even (↑s : ℕ) then vR else vL) = + ii ^ (↑t : ℕ) * + if Even (↑t : ℕ) then vR' else vL') := by + classical + intro r i s a q g' qg k evenZero evenTwo notEvenOne notEvenThree hnegVal ii iiSq iiCube + negIiSq negIiCube lpow vR vL vR' vL' hbackEq' t hvR hvL rw [lpow] cases ho : BandPackingSymmetryReversesOrientation g' <;> fin_cases s <;> simp [t, ho, evenZero, evenTwo, notEvenOne, notEvenThree, @@ -2067,10 +1981,9 @@ theorem P4055T1PlacementNormalization let W' : ProtoTile := BandPackingSymmetryTileAction g' W let Z' : ProtoTile := BandPackingSymmetryTileAction g' Z have hU' := PlacementNormalizationProof.hU' r U hU a g g' horientg htileCov - have hWlabel := PlacementNormalizationProof.hWlabel r i s U W Z hW hZ hWpos hZpos hWcent hZcent - a g hq negative hphase hphase1 hphase2 g' hfalse hfalse1 hfalse2 hproperG hU' - have cyclicIndex (j₀ : Fin 3) := PlacementNormalizationProof.cyclicIndex r i U a g hq negative - hphase hphase1 hphase2 g' hfalse hfalse1 hfalse2 hproperG hU' hWlabel j₀ + have hWlabel := PlacementNormalizationProof.hWlabel r i + a g' + have cyclicIndex (j₀ : Fin 3) := PlacementNormalizationProof.cyclicIndex r a j₀ have cyclicCancel (x y : Fin 3) : x + (y - x) = y := by fin_cases x <;> fin_cases y <;> decide +kernel have actionParent (j₀ : Fin 3) := PlacementNormalizationProof.actionParent r a g' j₀ @@ -2213,16 +2126,10 @@ theorem P4055T1PlacementNormalization have hvR : BandPackingSymmetryVectorAction g' vR = vR' := by simpa [vR, vR'] using hvectorForward.symm have hvL := PlacementNormalizationProof.hvL r i a g' hvectorBackward - have hdR := PlacementNormalizationProof.hdR r i s U W Z hZ hZpos hWcent hZcent a g' evenZero - evenTwo notEvenOne notEvenThree hnegVal iiSq iiCube negIiSq negIiCube lpow hbackEq' hdispW - hZindex hZparentIndex hZcircle hZlabel hZrel hZsigma hZsigma' hZphaseForward - hZphaseBackward hZflip hZactionForward hZactionBackward hZsourceAction hZvec hZ' hZpos' - hWcent' hZcent' hWvec hWcentNorm hZvec' hZcentNorm hvR hvL - have hdL := PlacementNormalizationProof.hdL r i s U W Z hZ hZpos hWcent hZcent a g' evenZero - evenTwo notEvenOne notEvenThree hnegVal iiSq iiCube negIiSq negIiCube lpow hbackEq' hdispW - hZindex hZparentIndex hZcircle hZlabel hZrel hZsigma hZsigma' hZphaseForward - hZphaseBackward hZflip hZactionForward hZactionBackward hZsourceAction hZvec hZ' hZpos' - hWcent' hZcent' hWvec hWcentNorm hZvec' hZcentNorm hvR hvL hdR + have hdR := PlacementNormalizationProof.hdR r i s a g' evenZero + evenTwo notEvenOne notEvenThree hnegVal iiSq iiCube negIiSq negIiCube lpow hbackEq' hvR hvL + have hdL := PlacementNormalizationProof.hdL r i s a g' evenZero + evenTwo notEvenOne notEvenThree hnegVal iiSq iiCube negIiSq negIiCube lpow hbackEq' hvR hvL exact ⟨g', hquadg, hproperG, hU', hW', hZ', hUpos', hWpos', hZpos', hWcentNorm, hZcentNorm, hdR, hdL⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean index 7cb93fbb38..ce1bdf1b20 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean @@ -97,26 +97,17 @@ private theorem hCicurv : (by classical exact - ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P - i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ - P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (T'.cells - = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), - (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) - → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ ((x - u).re - = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) - then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ (x - u).im ≤ (↑P.q : ℤ)) → (∀ - (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), (TileCentroid Rminus - TileCentroid T = - (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 - (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + - BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P - i.succ))) → ((0 < P.q₁) → ( - let n := if i = 0 then P.q₁ else P.q₂ - (0 < n) → ((n < P.q) → (Ci.1.1.1 = (n : Int) ^ 2))))))))) ) := by + ∀ (P : FordFareyParameter) + (Ci : BandCircle) (i : Fin (3 : ℕ)), + FordRecursiveQuadruple P i.succ = + Ci.1.1 → + i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁ → + (0 : ℕ) < P.q₁ → + let n := if i = (0 : Fin (3 : ℕ)) then P.q₁ else P.q₂; + Ci.1.1.1 = + (↑n : ℤ) ^ (2 : ℕ)) := by classical - intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hrpos n hnpos hnq + intro P Ci i hCi hsmall hrpos n rw [← hCi] rcases hsmall with ⟨rfl, _⟩ | ⟨rfl, _⟩ · simp [n, FordRecursiveQuadruple, FordCircleCoordinate, ne_of_gt hrpos, pow_two] @@ -1022,8 +1013,7 @@ theorem P4158T1SmallerStringEdges have hnq : n < P.q := by dsimp [n]; split_ifs <;> omega have hCipos : 0 < Ci.1.1.1 := by omega have hC0pos := SmallerStringGeometry.hC0pos P C0 hC0 hqone - have hCicurv := SmallerStringGeometry.hCicurv P Ci i hCi hsmall T T' u hc' hsegment Rminus - Rplus hcm hcp hrpos hnpos hnq + have hCicurv := SmallerStringGeometry.hCicurv P Ci i hCi hsmall hrpos have hnlarge := SmallerStringGeometry.hnlarge P C0 Ci i hlarge hnpos hCicurv have hFord := SmallerStringGeometry.hFord P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hrpos (P.q₂_pos) hnpos hnq hCicurv hnlarge diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean index c6c7eb8a82..751bbb9771 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean @@ -43,19 +43,16 @@ private theorem hvector : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : - PartialOdometer), ∀ (q' : Fin (4 : ℕ) → CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ - (hs : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs' : Fin (3 : ℕ) → Bool → - PartialOdometer), (q' i'.succ = C.1.1) → ((T.cells = (S' i' hs).cells) → (((↑h.domain - : Set GaussianInt) = (↑(hs' i' hs).domain : Set GaussianInt)) → ((∀ x ∈ h.domain, - h.value x = (hs' i' hs).value x) → (∀ (r : Fin (3 : ℕ)), (∀ (j : Fin (3 : ℕ)), q' - j.succ = q (j + r).succ) → ( - let j : Fin 3 := i' + r - (q' i'.succ = q j.succ) → (BandVectors.1 (q' ((i' + 2).succ)) (q' ((i' + 1).succ)) = - BandVectors.1 (q ((j + 2).succ)) (q ((j + 1).succ)))))))) ) := by + ∀ (q q' : Fin (4 : ℕ) → CircleCoordinates) + (i' r : Fin (3 : ℕ)), + (∀ (j : Fin (3 : ℕ)), q' j.succ = q (j + r).succ) → + let j := i' + r; + BandVectors.1 (q' (i' + (2 : Fin (3 : ℕ))).succ) + (q' (i' + (1 : Fin (3 : ℕ))).succ) = + BandVectors.1 (q (j + (2 : Fin (3 : ℕ))).succ) + (q (j + (1 : Fin (3 : ℕ))).succ)) := by classical - intro q C T h q' i' hs S' hs' hq'i' hselectedCells hselectedDomain hselectedValue r hrotate j - hparent + intro q q' i' r hrotate j rw [hrotate (i' + 2), hrotate (i' + 1)]; dsimp [j]; fin_cases r <;> fin_cases i' <;> rfl private theorem hsCent : @@ -523,8 +520,7 @@ theorem P4261T1CentralCoordinates let j : Fin 3 := i' + r have hparent : q' i'.succ = q j.succ := by simpa [j] using hrotate i' - have hvector := CentralCoordinateGeometry.hvector q C T h q' i' hs S' hs' hq'i' hselectedCells - hselectedDomain hselectedValue r hrotate hparent + have hvector := CentralCoordinateGeometry.hvector q q' i' r hrotate have hsCent := CentralCoordinateGeometry.hsCent q T₀ q' i' hs S' hcent' R hrootCent r hvector have hbandSelected := CentralCoordinateGeometry.hbandSelected q q' i' hs S' hs' hchild' r hparent have hbandFresh : BandPrototile (q j.succ) (R j hs) := diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean index ab5b083758..478c9ff38e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean @@ -46,40 +46,32 @@ private theorem hvector : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : - PartialOdometer), ∀ (q'' : Fin (4 : ℕ) → CircleCoordinates), ∀ (i'' : Fin (3 : ℕ)), ∀ - (s : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs' : Fin (3 : ℕ) → Bool → - PartialOdometer), (q'' i''.succ = C.1.1) → ((T.cells = (S' i'' s).cells) → - (((↑h.domain : Set GaussianInt) = (↑(hs' i'' s).domain : Set GaussianInt)) → ((∀ x ∈ - h.domain, h.value x = (hs' i'' s).value x) → (∀ (r : Fin (3 : ℕ)), (∀ (j : Fin (3 : - ℕ)), q'' j.succ = q (j + r).succ) → ( - let j : Fin 3 := i'' + r - (q'' i''.succ = q j.succ) → (BandVectors.1 (q'' ((i'' + 2).succ)) (q'' ((i'' + 1).succ)) - = BandVectors.1 (q ((j + 2).succ)) (q ((j + 1).succ)))))))) ) := by + ∀ (q q'' : Fin (4 : ℕ) → CircleCoordinates) + (i'' r : Fin (3 : ℕ)), + (∀ (j : Fin (3 : ℕ)), q'' j.succ = q (j + r).succ) → + let j := i'' + r; + BandVectors.1 (q'' (i'' + (2 : Fin (3 : ℕ))).succ) + (q'' (i'' + (1 : Fin (3 : ℕ))).succ) = + BandVectors.1 (q (j + (2 : Fin (3 : ℕ))).succ) + (q (j + (1 : Fin (3 : ℕ))).succ)) := by classical - intro q C T h q'' i'' s S' hs' hq''i hselectedCells hselectedDomain hselectedValue r hrotate j - hparent + intro q q'' i'' r hrotate j rw [hrotate (i'' + 2), hrotate (i'' + 1)]; dsimp [j]; fin_cases r <;> fin_cases i'' <;> rfl private theorem hslopeVector : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : - PartialOdometer), ∀ (q'' : Fin (4 : ℕ) → CircleCoordinates), ∀ (i'' : Fin (3 : ℕ)), ∀ - (s : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs' : Fin (3 : ℕ) → Bool → - PartialOdometer), (q'' i''.succ = C.1.1) → ((T.cells = (S' i'' s).cells) → - (((↑h.domain : Set GaussianInt) = (↑(hs' i'' s).domain : Set GaussianInt)) → ((∀ x ∈ - h.domain, h.value x = (hs' i'' s).value x) → (∀ (r : Fin (3 : ℕ)), (∀ (j : Fin (3 : - ℕ)), q'' j.succ = q (j + r).succ) → ( - let j : Fin 3 := i'' + r - (q'' i''.succ = q j.succ) → ((BandVectors.1 (q'' ((i'' + 2).succ)) (q'' ((i'' + 1).succ)) - = BandVectors.1 (q ((j + 2).succ)) (q ((j + 1).succ))) → (BandVectors.2 (q'' ((i'' + - 2).succ)) (q'' ((i'' + 1).succ)) = BandVectors.2 (q ((j + 2).succ)) (q ((j + - 1).succ))))))))) ) := by + ∀ (q q'' : Fin (4 : ℕ) → CircleCoordinates) + (i'' r : Fin (3 : ℕ)), + (∀ (j : Fin (3 : ℕ)), q'' j.succ = q (j + r).succ) → + let j := i'' + r; + BandVectors.2 (q'' (i'' + (2 : Fin (3 : ℕ))).succ) + (q'' (i'' + (1 : Fin (3 : ℕ))).succ) = + BandVectors.2 (q (j + (2 : Fin (3 : ℕ))).succ) + (q (j + (1 : Fin (3 : ℕ))).succ)) := by classical - intro q C T h q'' i'' s S' hs' hq''i hselectedCells hselectedDomain hselectedValue r hrotate j - hparent hvector + intro q q'' i'' r hrotate j rw [hrotate (i'' + 2), hrotate (i'' + 1)]; dsimp [j]; fin_cases r <;> fin_cases i'' <;> rfl private theorem hsCent : @@ -979,10 +971,8 @@ theorem P4261T1RightCoordinates let j : Fin 3 := i'' + r have hparent : q'' i''.succ = q j.succ := by simpa [j] using hrotate i'' - have hvector := RightCoordinateGeometry.hvector q C T h q'' i'' s S' hs' hq''i hselectedCells - hselectedDomain hselectedValue r hrotate hparent - have hslopeVector := RightCoordinateGeometry.hslopeVector q C T h q'' i'' s S' hs' hq''i - hselectedCells hselectedDomain hselectedValue r hrotate hparent hvector + have hvector := RightCoordinateGeometry.hvector q q'' i'' r hrotate + have hslopeVector := RightCoordinateGeometry.hslopeVector q q'' i'' r hrotate have hsCent := RightCoordinateGeometry.hsCent q N q'' i'' s S' hcent' R hrootCent r hvector have hbandSelected := RightCoordinateGeometry.hbandSelected q q'' i'' s S' hs' hchild' r hparent have hbandFresh : BandPrototile (q j.succ) (R j s) := diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean index a990478adc..674a39566b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean @@ -963,24 +963,14 @@ private theorem hfinishIndex : (by classical exact - ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (Epositive : - ExactTileInterfaceTriple T U Rplus), ∀ (path : List GaussianInt), (path.Nodup) → (((2 - : ℕ) ≤ path.length) → ((path.head? = some Epositive.point) → ((path.getLast? = some - Epositive.otherAB) → ((FootprintVertices T ∩ FootprintVertices U = (↑path.toFinset : - Set GaussianInt)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List - GaussianInt), ∀ (l₂ : List GaussianInt), path = l₁ ++ a :: b :: l₂ → b = a + (1 : - GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ∨ b = a - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → ((∀ (e : Finset GaussianInt), e ∈ - FootprintEdges T ∩ FootprintEdges U ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : - List GaussianInt) (l₂ : List GaussianInt), path = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → - ((∀ a b : GaussianInt, {a, b} ∈ FootprintEdges T ∩ FootprintEdges U → path.idxOf a + - 1 = path.idxOf b ∨ path.idxOf b + 1 = path.idxOf a) → ((∀ {a : GaussianInt}, ∀ - {b : GaussianInt}, (a ∈ path) → ((path.idxOf a = path.idxOf b) → (a = b))) → - ((path.idxOf Epositive.otherAB = path.length - 1) → (path.idxOf Epositive.point = - 0)))))))))) ) := by + ∀ (T U Rplus : ProtoTile) + (Epositive : ExactTileInterfaceTriple T U Rplus) + (path : List GaussianInt), + (2 : ℕ) ≤ path.length → + path.head? = some Epositive.point → + List.idxOf Epositive.point path = (0 : ℕ)) := by classical - intro T U Rplus Epositive path hpathNodup hpathLength hpathHead hpathLast hpathVertices - hpathStep hpathEdges hpathIndex hpathIndexInjective hstartIndex + intro T U Rplus Epositive path hpathLength hpathHead cases path with | nil => simp at hpathLength | cons a rest => @@ -1387,9 +1377,8 @@ theorem P4261T2UnitInterface reverseFunctions hrestrictionsForward hrestrictionsBackward walk hwalkEdges path (UnitInterfaceGeometry.hcovered q C D i T U Rplus Epositive walk hwalkOuterEdges path hpathLength hpathIndex hpathIndexInjective hstartIndex - (UnitInterfaceGeometry.hfinishIndex T U Rplus Epositive path hpathNodup hpathLength - hpathHead hpathLast hpathVertices hpathStep hpathEdges hpathIndex hpathIndexInjective - hstartIndex) (UnitInterfaceGeometry.hpathIndexEdge path hpathNodup) + (UnitInterfaceGeometry.hfinishIndex T U Rplus Epositive path hpathLength + hpathHead) (UnitInterfaceGeometry.hpathIndexEdge path hpathNodup) (UnitInterfaceGeometry.hwalkHeadPos T U centerShift Rminus Rplus Epositive Eimage hvFT hvFU hvFR heFT heFU heFR hnegativePoint walk hwalkStart) (UnitInterfaceGeometry.hwalkLastPos T U Rplus Epositive walk hwalkFinish) diff --git a/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean index 37d1762358..82fb06c50b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean @@ -550,27 +550,12 @@ private theorem he'At460 : (by classical exact - ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : - BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : - BandOrderedGeneralLayoutCertificate q cfg C T), - let F := P4366T1PrecursorRemainderFamily cert.P cert.O - ∀ (g : List GaussianInt), ∀ (k : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : - GaussianInt), ((g.dropLast ++ k.dropLast).head? = some x) → (((g.dropLast ++ - k.dropLast).getLast? = some y) → (((g.dropLast ++ k.dropLast).zip (g.dropLast ++ - k.dropLast).tail ++ [(y, x)] = g.zip g.tail ++ k.zip k.tail) → ( - let p := g.dropLast ++ k.dropLast - let edges := (p.zip p.tail) ++ [(y, x)] - (∀ (u : GaussianInt), ∀ (v : GaussianInt), (u, v) ∈ edges ↔ (u, v) ∈ g.zip g.tail ∨ (u, - v) ∈ k.zip k.tail) → ((∀ (u : GaussianInt), ∀ (v : GaussianInt), ((u, v) ∈ edges) → - (FourNeighborAdjacent u v)) → ((∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (z : - GaussianInt), ∀ (w : GaussianInt), ((((u = z + 1 ∧ v = z + 1 + ⟨0, 1⟩) ∨ (v = z + 1 ∧ - u = z + 1 + ⟨0, 1⟩)) ∧ w = z + 1 ∨ ((u = z + 1 + ⟨0, 1⟩ ∧ v = z + ⟨0, 1⟩) ∨ (v = z + - 1 + ⟨0, 1⟩ ∧ u = z + ⟨0, 1⟩)) ∧ w = z + ⟨0, 1⟩)) → (∀ (i : Fin 3), ∀ (s : Bool), (z ∈ - (F i s).cells) → ((w ∈ (F i s).cells) → ((u, v) ∉ edges)))) → (∀ (u : GaussianInt), ∀ - (v : GaussianInt), ((u, v) ∈ p.zip p.tail ∨ u = y ∧ v = x) → ((u, v) ∈ edges))))))) ) - := by + ∀ (g k : List GaussianInt) (x y : GaussianInt), + let p := g.dropLast ++ k.dropLast; + let edges := p.zip p.tail ++ [(y, x)]; + ∀ (u v : GaussianInt), (u, v) ∈ p.zip p.tail ∨ u = y ∧ v = x → (u, v) ∈ edges) := by classical - intro C q cfg T cert F g k x y hhead hlast hedges p edges hcycles allsteps exclude_pair u v he + intro g k x y p edges u v he rcases he with he | ⟨rfl, rfl⟩ · simp only [edges, List.mem_append]; exact Or.inl he · simp [edges] @@ -740,8 +725,7 @@ theorem P4366T1PrecursorPathLoop exact allsteps u v (by simp only [edges, List.mem_append]; exact Or.inl he) · exact allsteps y x (by simp [edges]) · intro u v he - have he' := PrecursorLoopGeometry.he'At460 C q cfg T cert g k x y hhead hlast hedges hcycles - allsteps exclude_pair u v he + have he' := PrecursorLoopGeometry.he'At460 g k x y u v he exact ((hcycles u v).mp he').elim ((PrecursorLoopGeometry.gsegments T edge_vertices g gsteps gstar) u v) ((PrecursorLoopGeometry.ksegments C q cfg T cert hOT realization_mono k ksteps kedge_raw) u v) diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean b/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean index 0ab92ea40b..7f4571e3dc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean @@ -316,39 +316,23 @@ private theorem holdShift : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : - P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v - a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) - (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices - q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (z : - P3996T1SRowParameters), (P3996T1SRowTable q cfg C T cert row = some z) → (∀ (E : - ExactTileInterfaceTriple (SubtileOccurrenceInterpretation cert.P cert.u cert.v - z.childIndex) (TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u cert.v - z.childIndex) z.rightShift) (SubtileOccurrenceInterpretation cert.P cert.u cert.v - z.parentIndex)), ((TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u - cert.v z.childIndex) z.rightShift).cells ⊆ (TileTranslation T z.oldShift).cells) → ( - let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v - let V := occ z.childIndex - let W := occ z.parentIndex - let K := TileTranslation V z.rightShift - (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex - = b ∧ z.parentIndex = a) → ((SimpleGridPathBetween (FootprintVertices V ∩ - FootprintVertices W) (FootprintEdges V ∩ FootprintEdges W) E.point E.otherCA) → - ((({data.first, data.last} : Finset GaussianInt) = ({E.point, E.otherCA} : Finset - GaussianInt)) → ((E.point = data.first ∨ E.point = data.last) → ((∀ (i : - PeriodicSubtileIndex), ∀ (r : Int), ∀ (s : Int), (z.oldShift = (r : GaussianInt) * - cert.u + (s : GaussianInt) * cert.v) → (((i.first, i.second) ≠ (r, s)) → (Disjoint - K.cells (occ i).cells))) → ((LatticeTile V) → ((LatticeTile W) → ((LatticeTile K) → ( - let oldCoords : Int × Int := nestedOldCoordinates row - z.oldShift = (oldCoords.1 : GaussianInt) * cert.u + (oldCoords.2 : GaussianInt) * - cert.v)))))))))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) + (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert + a b) + (z : P3996T1SRowParameters), + P3996T1SRowTable q cfg C T cert row = some z → + let oldCoords := nestedOldCoordinates row; + z.oldShift = + (↑oldCoords.1 : GaussianInt) * cert.u + + (↑oldCoords.2 : GaussianInt) * cert.v) := by classical - intro q cfg C T cert a b row data z hz E hsub occ V W K hindices hpath hdataEndpoints - hpointPair hKDisjoint hLV hLW hLK oldCoords + intro q cfg C T cert a b row z hz oldCoords cases row <;> simp only [P3996T1SRowTable, Fin.isValue, Int.reduceNeg, Option.some.injEq, reduceCtorEq] at hz all_goals cases hz @@ -359,39 +343,21 @@ private theorem hchildBlockNe : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : - P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v - a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) - (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices - q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (z : - P3996T1SRowParameters), (P3996T1SRowTable q cfg C T cert row = some z) → (∀ (E : - ExactTileInterfaceTriple (SubtileOccurrenceInterpretation cert.P cert.u cert.v - z.childIndex) (TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u cert.v - z.childIndex) z.rightShift) (SubtileOccurrenceInterpretation cert.P cert.u cert.v - z.parentIndex)), ((TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u - cert.v z.childIndex) z.rightShift).cells ⊆ (TileTranslation T z.oldShift).cells) → ( - let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v - let V := occ z.childIndex - let W := occ z.parentIndex - let K := TileTranslation V z.rightShift - (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex - = b ∧ z.parentIndex = a) → ((SimpleGridPathBetween (FootprintVertices V ∩ - FootprintVertices W) (FootprintEdges V ∩ FootprintEdges W) E.point E.otherCA) → - ((({data.first, data.last} : Finset GaussianInt) = ({E.point, E.otherCA} : Finset - GaussianInt)) → ((E.point = data.first ∨ E.point = data.last) → ((∀ (i : - PeriodicSubtileIndex), ∀ (r : Int), ∀ (s : Int), (z.oldShift = (r : GaussianInt) * - cert.u + (s : GaussianInt) * cert.v) → (((i.first, i.second) ≠ (r, s)) → (Disjoint - K.cells (occ i).cells))) → ((LatticeTile V) → ((LatticeTile W) → ((LatticeTile K) → ( - let oldCoords : Int × Int := nestedOldCoordinates row - (z.oldShift = (oldCoords.1 : GaussianInt) * cert.u + (oldCoords.2 : GaussianInt) * - cert.v) → ((z.childIndex.first, z.childIndex.second) ≠ oldCoords))))))))))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) + (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert + a b) + (z : P3996T1SRowParameters), + P3996T1SRowTable q cfg C T cert row = some z → + let oldCoords := nestedOldCoordinates row; + (z.childIndex.first, z.childIndex.second) ≠ oldCoords) := by classical - intro q cfg C T cert a b row data z hz E hsub occ V W K hindices hpath hdataEndpoints - hpointPair hKDisjoint hLV hLW hLK oldCoords holdShift + intro q cfg C T cert a b row z hz oldCoords cases row <;> simp only [P3996T1SRowTable, Fin.isValue, Int.reduceNeg, Option.some.injEq, reduceCtorEq] at hz all_goals @@ -402,40 +368,21 @@ private theorem hparentBlockNe : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : - P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v - a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) - (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices - q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (z : - P3996T1SRowParameters), (P3996T1SRowTable q cfg C T cert row = some z) → (∀ (E : - ExactTileInterfaceTriple (SubtileOccurrenceInterpretation cert.P cert.u cert.v - z.childIndex) (TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u cert.v - z.childIndex) z.rightShift) (SubtileOccurrenceInterpretation cert.P cert.u cert.v - z.parentIndex)), ((TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u - cert.v z.childIndex) z.rightShift).cells ⊆ (TileTranslation T z.oldShift).cells) → ( - let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v - let V := occ z.childIndex - let W := occ z.parentIndex - let K := TileTranslation V z.rightShift - (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex - = b ∧ z.parentIndex = a) → ((SimpleGridPathBetween (FootprintVertices V ∩ - FootprintVertices W) (FootprintEdges V ∩ FootprintEdges W) E.point E.otherCA) → - ((({data.first, data.last} : Finset GaussianInt) = ({E.point, E.otherCA} : Finset - GaussianInt)) → ((E.point = data.first ∨ E.point = data.last) → ((∀ (i : - PeriodicSubtileIndex), ∀ (r : Int), ∀ (s : Int), (z.oldShift = (r : GaussianInt) * - cert.u + (s : GaussianInt) * cert.v) → (((i.first, i.second) ≠ (r, s)) → (Disjoint - K.cells (occ i).cells))) → ((LatticeTile V) → ((LatticeTile W) → ((LatticeTile K) → ( - let oldCoords : Int × Int := nestedOldCoordinates row - (z.oldShift = (oldCoords.1 : GaussianInt) * cert.u + (oldCoords.2 : GaussianInt) * - cert.v) → (((z.childIndex.first, z.childIndex.second) ≠ oldCoords) → - ((z.parentIndex.first, z.parentIndex.second) ≠ oldCoords)))))))))))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) + (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert + a b) + (z : P3996T1SRowParameters), + P3996T1SRowTable q cfg C T cert row = some z → + let oldCoords := nestedOldCoordinates row; + (z.parentIndex.first, z.parentIndex.second) ≠ oldCoords) := by classical - intro q cfg C T cert a b row data z hz E hsub occ V W K hindices hpath hdataEndpoints - hpointPair hKDisjoint hLV hLW hLK oldCoords holdShift hchildBlockNe + intro q cfg C T cert a b row z hz oldCoords cases row <;> simp only [P3996T1SRowTable, Fin.isValue, Int.reduceNeg, Option.some.injEq, reduceCtorEq] at hz all_goals @@ -446,44 +393,26 @@ private theorem hwrongBlockNe : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : - P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v - a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) - (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices - q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (z : - P3996T1SRowParameters), (P3996T1SRowTable q cfg C T cert row = some z) → (∀ (E : - ExactTileInterfaceTriple (SubtileOccurrenceInterpretation cert.P cert.u cert.v - z.childIndex) (TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u cert.v - z.childIndex) z.rightShift) (SubtileOccurrenceInterpretation cert.P cert.u cert.v - z.parentIndex)), ((TileTranslation (SubtileOccurrenceInterpretation cert.P cert.u - cert.v z.childIndex) z.rightShift).cells ⊆ (TileTranslation T z.oldShift).cells) → ( - let occ := SubtileOccurrenceInterpretation cert.P cert.u cert.v - let V := occ z.childIndex - let W := occ z.parentIndex - let K := TileTranslation V z.rightShift - (if z.childIsExterior = true then z.childIndex = a ∧ z.parentIndex = b else z.childIndex - = b ∧ z.parentIndex = a) → ((SimpleGridPathBetween (FootprintVertices V ∩ - FootprintVertices W) (FootprintEdges V ∩ FootprintEdges W) E.point E.otherCA) → - ((({data.first, data.last} : Finset GaussianInt) = ({E.point, E.otherCA} : Finset - GaussianInt)) → ((E.point = data.first ∨ E.point = data.last) → ((∀ (i : - PeriodicSubtileIndex), ∀ (r : Int), ∀ (s : Int), (z.oldShift = (r : GaussianInt) * - cert.u + (s : GaussianInt) * cert.v) → (((i.first, i.second) ≠ (r, s)) → (Disjoint - K.cells (occ i).cells))) → ((LatticeTile V) → ((LatticeTile W) → ((LatticeTile K) → ( - let oldCoords : Int × Int := nestedOldCoordinates row - (z.oldShift = (oldCoords.1 : GaussianInt) * cert.u + (oldCoords.2 : GaussianInt) * - cert.v) → (((z.childIndex.first, z.childIndex.second) ≠ oldCoords) → - (((z.parentIndex.first, z.parentIndex.second) ≠ oldCoords) → ( - let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row - let wrongOwner := if z.parentSlot = 0 then owners.2 else owners.1 - (wrongOwner.first, wrongOwner.second) ≠ oldCoords))))))))))))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) + (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert + a b) + (z : P3996T1SRowParameters), + P3996T1SRowTable q cfg C T cert row = some z → + let oldCoords := nestedOldCoordinates row; + let owners := + P4418T3EndpointOwnerIndices q cfg C T cert a b + row; + let wrongOwner := + if z.parentSlot = (0 : Fin (3 : ℕ)) then owners.2 else owners.1; + (wrongOwner.first, wrongOwner.second) ≠ oldCoords) := by classical - intro q cfg C T cert a b row data z hz E hsub occ V W K hindices hpath hdataEndpoints - hpointPair hKDisjoint hLV hLW hLK oldCoords holdShift hchildBlockNe hparentBlockNe owners - wrongOwner + intro q cfg C T cert a b row z hz oldCoords owners wrongOwner cases row <;> simp only [P3996T1SRowTable, Fin.isValue, Int.reduceNeg, Option.some.injEq, reduceCtorEq] at hz all_goals @@ -780,17 +709,12 @@ theorem P4418T3NestedCompanionEndpoint have hLK : LatticeTile K := (TileDiskAreaCovariance V z.rightShift).1.mp hLV let oldCoords : Int × Int := nestedOldCoordinates row - have holdShift := NestedCompanionGeometry.holdShift q cfg C T cert a b row data z hz E hsub - hindices hpath hdataEndpoints hpointPair hKDisjoint hLV hLW hLK - have hchildBlockNe := NestedCompanionGeometry.hchildBlockNe q cfg C T cert a b row data z hz E - hsub hindices hpath hdataEndpoints hpointPair hKDisjoint hLV hLW hLK holdShift - have hparentBlockNe := NestedCompanionGeometry.hparentBlockNe q cfg C T cert a b row data z hz - E hsub hindices hpath hdataEndpoints hpointPair hKDisjoint hLV hLW hLK holdShift hchildBlockNe + have holdShift := NestedCompanionGeometry.holdShift q cfg C T cert a b row z hz + have hchildBlockNe := NestedCompanionGeometry.hchildBlockNe q cfg C T cert a b row z hz + have hparentBlockNe := NestedCompanionGeometry.hparentBlockNe q cfg C T cert a b row z hz let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row let wrongOwner := if z.parentSlot = 0 then owners.2 else owners.1 - have hwrongBlockNe := NestedCompanionGeometry.hwrongBlockNe q cfg C T cert a b row data z hz E - hsub hindices hpath hdataEndpoints hpointPair hKDisjoint hLV hLW hLK holdShift - hchildBlockNe hparentBlockNe + have hwrongBlockNe := NestedCompanionGeometry.hwrongBlockNe q cfg C T cert a b row z hz have hKV : Disjoint K.cells V.cells := hKDisjoint z.childIndex oldCoords.1 oldCoords.2 holdShift hchildBlockNe have hKW : Disjoint K.cells W.cells := diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean b/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean index 40527621b4..a2cf94ecf1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean @@ -387,38 +387,34 @@ private theorem hxedge : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - (P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v - a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) - (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices - q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)) → (∀ (x : GaussianInt), ∀ - (j : Fin 4), ∀ (edge : Finset GaussianInt), (x ∈ edge) → ((edge ∈ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → - ((LatticeVertexIncidentCell x j ∈ (SubtileOccurrenceInterpretation cert.P cert.u - cert.v a).cells) → ((LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( - let shift : GaussianInt := match P3996T1SRowTable q cfg C T cert row with - | some z => z.oldShift - | none => match a.label with - | .A => if a.first = -1 then -cert.u else cert.u - | .B => if a.first = 1 then cert.u else -cert.u - | .C => -cert.v - | .D => cert.v - | .E | .F => 0 - let oldCoord : Int × Int := routedOldCoordinates row - (shift = (oldCoord.1 : GaussianInt) * cert.u + (oldCoord.2 : GaussianInt) * cert.v) → - (((a.first, a.second) ≠ oldCoord) → (((b.first, b.second) ≠ oldCoord) → ( - let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v a - let W := SubtileOccurrenceInterpretation cert.P cert.u cert.v b - ∃ e : Finset GaussianInt, x ∈ e ∧ e ∈ FootprintEdges V ∩ FootprintEdges W)))))))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) + (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) (x : GaussianInt) + (edge : Finset GaussianInt), + x ∈ edge → + edge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P + cert.u cert.v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P + cert.u cert.v b) → + let V := + SubtileOccurrenceInterpretation cert.P cert.u + cert.v a; + let W := + SubtileOccurrenceInterpretation cert.P cert.u + cert.v b; + ∃ (e : Finset GaussianInt), + x ∈ e ∧ + e ∈ + FootprintEdges V ∩ + FootprintEdges W) := by classical - intro q cfg C T cert a b row data x j edge hx hedge ha hb shift oldCoord hshift a_coord_ne - b_coord_ne V W + intro q cfg C T cert a b x edge hx hedge V W rcases hedge with ⟨heV, heW⟩ exact ⟨edge, hx, by simpa [V, W] using ⟨heV, heW⟩⟩ @@ -816,8 +812,7 @@ theorem P4418T3RoutedBlockCriterion a_coord_ne root_disjoint hVroot have hWold := RoutedBlockGeometry.hWold q cfg C T cert a b row data x j edge hedge ha hb hshift b_coord_ne root_disjoint hWroot - have hxedge := RoutedBlockGeometry.hxedge q cfg C T cert a b row data x j edge hx hedge ha hb - hshift a_coord_ne b_coord_ne + have hxedge := RoutedBlockGeometry.hxedge q cfg C T cert a b x edge hx hedge have htri := SimpleGridPathPointTrichotomy _ _ data.first data.last x data.path hxedge let o₀ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 let o₁ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean index 191cecba4d..b7bd41f1f8 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean @@ -669,36 +669,49 @@ private theorem faceTable : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - let P := cert.P - let O := cert.O - let u := cert.u - let v := cert.v - ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b))) → ( - let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row - let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row - let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modifiedFaceEquivalence.symm face0 - let F1 := cert.modifiedFaceEquivalence.symm face1 - (∀ (f : PeriodicSubtileFaceIndex), ∀ (i : Fin 3), cert.modified.plane.faceVertex - (cert.modifiedFaceEquivalence.symm f) i = - SixSubtileFaceVertices f i) → ((F0 ≠ F1) → ((∃ iA iB iO : Fin 3, - cert.modified.plane.faceVertex F0 iA = a ∧ cert.modified.plane.faceVertex F0 iB = b ∧ - cert.modified.plane.faceVertex F0 iO = owners.1) ∧ (∃ jA jB jO : Fin 3, - cert.modified.plane.faceVertex F1 jA = a ∧ cert.modified.plane.faceVertex F1 jB = b ∧ - cert.modified.plane.faceVertex F1 jO = owners.2))))) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) + (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert + a b), + let owners := + P4418T3EndpointOwnerIndices q cfg C T cert a b row; + let face0 := + selectedFirstFace q cfg C T cert a b row; + let face1 := + selectedSecondFace q cfg C T cert a b row; + let F0 := + (cert.modifiedFaceEquivalence.symm : + PeriodicSubtileFaceIndex → + cert.modified.plane.Face) + face0; + let F1 := + (cert.modifiedFaceEquivalence.symm : + PeriodicSubtileFaceIndex → + cert.modified.plane.Face) + face1; + (∀ (f : PeriodicSubtileFaceIndex) (i : Fin (3 : ℕ)), + cert.modified.plane.faceVertex + ((cert.modifiedFaceEquivalence.symm : + PeriodicSubtileFaceIndex → + cert.modified.plane.Face) + f) + i = + SixSubtileFaceVertices f i) → + (∃ (iA : Fin (3 : ℕ)) (iB : Fin (3 : ℕ)) (iO : Fin (3 : ℕ)), + cert.modified.plane.faceVertex F0 iA = a ∧ + cert.modified.plane.faceVertex F0 iB = b ∧ + cert.modified.plane.faceVertex F0 iO = owners.1) ∧ + ∃ (jA : Fin (3 : ℕ)) (jB : Fin (3 : ℕ)) (jO : Fin (3 : ℕ)), + cert.modified.plane.faceVertex F1 jA = a ∧ + cert.modified.plane.faceVertex F1 jB = b ∧ + cert.modified.plane.faceVertex F1 jO = owners.2) := by classical - intro q cfg C T cert a b row P O u v retargeted owners face0 face1 F0 F1 faceVertex faceDistinct + intro q cfg C T cert a b row owners face0 face1 F0 F1 faceVertex cases row <;> simp only [selectedFirstFace, Int.reduceNeg, faceVertex, SixSubtileFaceVertices, neg_add_cancel, P4418T3EndpointOwnerIndices, exists_and_left, exists_and_right, @@ -987,35 +1000,43 @@ private theorem endpointsDistinct : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - let P := cert.P - let O := cert.O - let u := cert.u - let v := cert.v - ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b))) → ( - let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v - let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row - let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modifiedFaceEquivalence.symm face0 - let F1 := cert.modifiedFaceEquivalence.symm face1 - (∀ (p : List GaussianInt), (p.Nodup) → ((2 ≤ p.length) → (p.head? ≠ p.getLast?))) → - ((SimpleGridPathBetween (FootprintVertices (occurrence a) ∩ FootprintVertices - (occurrence b)) (FootprintEdges (occurrence a) ∩ FootprintEdges (occurrence b)) - (cert.modified.rho F0) (cert.modified.rho F1)) → (cert.modified.rho F0 ≠ - cert.modified.rho F1))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) + (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert + a b), + let occurrence := + SubtileOccurrenceInterpretation cert.P cert.u + cert.v; + let face0 := + selectedFirstFace q cfg C T cert a b row; + let face1 := + selectedSecondFace q cfg C T cert a b row; + let F0 := + (cert.modifiedFaceEquivalence.symm : + PeriodicSubtileFaceIndex → + cert.modified.plane.Face) + face0; + let F1 := + (cert.modifiedFaceEquivalence.symm : + PeriodicSubtileFaceIndex → + cert.modified.plane.Face) + face1; + (∀ (p : List GaussianInt), + p.Nodup → (2 : ℕ) ≤ p.length → p.head? ≠ p.getLast?) → + SimpleGridPathBetween + (FootprintVertices (occurrence a) ∩ + FootprintVertices (occurrence b)) + (FootprintEdges (occurrence a) ∩ + FootprintEdges (occurrence b)) + (cert.modified.rho F0) (cert.modified.rho F1) → + cert.modified.rho F0 ≠ cert.modified.rho F1) := by classical - intro q cfg C T cert a b row P O u v retargeted occurrence face0 face1 F0 F1 headLastNe - pathAtOwners + intro q cfg C T cert a b row occurrence face0 face1 F0 F1 headLastNe pathAtOwners rcases pathAtOwners with ⟨p, hnd, hlen, hh, hl, _, _, _⟩ intro heq apply headLastNe p hnd hlen @@ -1025,30 +1046,38 @@ private theorem commonPair0 : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - let P := cert.P - let O := cert.O - let u := cert.u - let v := cert.v - ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b))) → ( - let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row - let F0 := cert.modifiedFaceEquivalence.symm face0 - ∀ (iA : Fin (3 : ℕ)), ∀ (iB : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F0 iA = a) → - ((cert.modified.plane.faceVertex F0 iB = b) → (cert.modified.rho F0 ∈ - FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ - FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) + (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert + a b), + let P := cert.P; + let O := cert.O; + let u := cert.u; + let v := cert.v; + let face0 := + selectedFirstFace q cfg C T cert a b row; + let F0 := + (cert.modifiedFaceEquivalence.symm : + PeriodicSubtileFaceIndex → + cert.modified.plane.Face) + face0; + ∀ (iA iB : Fin (3 : ℕ)), + cert.modified.plane.faceVertex F0 iA = a → + cert.modified.plane.faceVertex F0 iB = b → + cert.modified.rho F0 ∈ + FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P + O u v a) ∩ + FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P + O u v b)) := by classical - intro q cfg C T cert a b row P O u v retargeted face0 F0 iA iB ha0 hb0 + intro q cfg C T cert a b row P O u v face0 F0 iA iB ha0 hb0 exact ⟨by simpa only [ha0, cert.modified_tile] using cert.modified.rho_common F0 iA, by simpa only [hb0, cert.modified_tile] using cert.modified.rho_common F0 iB⟩ @@ -1056,30 +1085,38 @@ private theorem commonPair1 : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - let P := cert.P - let O := cert.O - let u := cert.u - let v := cert.v - ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b))) → ( - let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F1 := cert.modifiedFaceEquivalence.symm face1 - ∀ (jA : Fin (3 : ℕ)), ∀ (jB : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F1 jA = a) → - ((cert.modified.plane.faceVertex F1 jB = b) → (cert.modified.rho F1 ∈ - FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ - FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) + (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert + a b), + let P := cert.P; + let O := cert.O; + let u := cert.u; + let v := cert.v; + let face1 := + selectedSecondFace q cfg C T cert a b row; + let F1 := + (cert.modifiedFaceEquivalence.symm : + PeriodicSubtileFaceIndex → + cert.modified.plane.Face) + face1; + ∀ (jA jB : Fin (3 : ℕ)), + cert.modified.plane.faceVertex F1 jA = a → + cert.modified.plane.faceVertex F1 jB = b → + cert.modified.rho F1 ∈ + FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P + O u v a) ∩ + FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P + O u v b)) := by classical - intro q cfg C T cert a b row P O u v retargeted face1 F1 jA jB ha1 hb1 + intro q cfg C T cert a b row P O u v face1 F1 jA jB ha1 hb1 exact ⟨by simpa only [ha1, cert.modified_tile] using cert.modified.rho_common F1 jA, by simpa only [hb1, cert.modified_tile] using cert.modified.rho_common F1 jB⟩ @@ -1087,33 +1124,44 @@ private theorem ownerPoint0 : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - let P := cert.P - let O := cert.O - let u := cert.u - let v := cert.v - (∀ (x : PeriodicSubtileIndex), FootprintVertices (ModifiedSubtileOccurrenceInterpretation - P O u v x) ⊆ FootprintVertices (SubtileOccurrenceInterpretation P u v x)) → - (((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ - FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b))) → ( - let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v - let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row - let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row - let F0 := cert.modifiedFaceEquivalence.symm face0 - ∀ (iO : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F0 iO = owners.1) → - (cert.modified.rho F0 ∈ FootprintVertices (occurrence owners.1)))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) + (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert + a b), + let P := cert.P; + let O := cert.O; + let u := cert.u; + let v := cert.v; + (∀ (x : PeriodicSubtileIndex), + FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u + v x) ⊆ + FootprintVertices + (SubtileOccurrenceInterpretation P u v x)) → + let occurrence := + SubtileOccurrenceInterpretation cert.P cert.u + cert.v; + let owners := + P4418T3EndpointOwnerIndices q cfg C T cert a b + row; + let face0 := + selectedFirstFace q cfg C T cert a b row; + let F0 := + (cert.modifiedFaceEquivalence.symm : + PeriodicSubtileFaceIndex → + cert.modified.plane.Face) + face0; + ∀ (iO : Fin (3 : ℕ)), + cert.modified.plane.faceVertex F0 iO = owners.1 → + cert.modified.rho F0 ∈ + FootprintVertices (occurrence owners.1)) := by classical - intro q cfg C T cert a b row P O u v modifiedFootSubset retargeted occurrence owners face0 F0 - iO ho0 + intro q cfg C T cert a b row P O u v modifiedFootSubset occurrence owners face0 F0 iO ho0 have h := cert.modified.rho_common F0 iO rw [ho0, cert.modified_tile] at h exact modifiedFootSubset owners.1 h @@ -1122,33 +1170,44 @@ private theorem ownerPoint1 : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - let P := cert.P - let O := cert.O - let u := cert.u - let v := cert.v - (∀ (x : PeriodicSubtileIndex), FootprintVertices (ModifiedSubtileOccurrenceInterpretation - P O u v x) ⊆ FootprintVertices (SubtileOccurrenceInterpretation P u v x)) → - (((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ - FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b))) → ( - let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v - let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row - let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F1 := cert.modifiedFaceEquivalence.symm face1 - ∀ (jO : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F1 jO = owners.2) → - (cert.modified.rho F1 ∈ FootprintVertices (occurrence owners.2)))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates) + (cfg : BandOrderedGeneralConfiguration q) + (C : BandCircle) + (T : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C T) + (a b : PeriodicSubtileIndex) + (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert + a b), + let P := cert.P; + let O := cert.O; + let u := cert.u; + let v := cert.v; + (∀ (x : PeriodicSubtileIndex), + FootprintVertices + (ModifiedSubtileOccurrenceInterpretation P O u + v x) ⊆ + FootprintVertices + (SubtileOccurrenceInterpretation P u v x)) → + let occurrence := + SubtileOccurrenceInterpretation cert.P cert.u + cert.v; + let owners := + P4418T3EndpointOwnerIndices q cfg C T cert a b + row; + let face1 := + selectedSecondFace q cfg C T cert a b row; + let F1 := + (cert.modifiedFaceEquivalence.symm : + PeriodicSubtileFaceIndex → + cert.modified.plane.Face) + face1; + ∀ (jO : Fin (3 : ℕ)), + cert.modified.plane.faceVertex F1 jO = owners.2 → + cert.modified.rho F1 ∈ + FootprintVertices (occurrence owners.2)) := by classical - intro q cfg C T cert a b row P O u v modifiedFootSubset retargeted occurrence owners face1 F1 - jO ho1 + intro q cfg C T cert a b row P O u v modifiedFootSubset occurrence owners face1 F1 jO ho1 have h := cert.modified.rho_common F1 jO rw [ho1, cert.modified_tile] at h exact modifiedFootSubset owners.2 h @@ -1668,17 +1727,17 @@ private theorem selectedCertificate : cert.modified.rho F0 ∈ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b) := - SelectedInterfaceGeometry.commonPair0 q cfg C T cert a b row retargeted iA iB ha0 hb0 + SelectedInterfaceGeometry.commonPair0 q cfg C T cert a b row iA iB ha0 hb0 have commonPair1 : cert.modified.rho F1 ∈ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b) := - SelectedInterfaceGeometry.commonPair1 q cfg C T cert a b row retargeted jA jB ha1 hb1 + SelectedInterfaceGeometry.commonPair1 q cfg C T cert a b row jA jB ha1 hb1 have ownerPoint0 : cert.modified.rho F0 ∈ FootprintVertices (occurrence owners.1) := - SelectedInterfaceGeometry.ownerPoint0 q cfg C T cert a b row modifiedFootSubset retargeted + SelectedInterfaceGeometry.ownerPoint0 q cfg C T cert a b row modifiedFootSubset iO ho0 have ownerPoint1 : cert.modified.rho F1 ∈ FootprintVertices (occurrence owners.2) := - SelectedInterfaceGeometry.ownerPoint1 q cfg C T cert a b row modifiedFootSubset retargeted + SelectedInterfaceGeometry.ownerPoint1 q cfg C T cert a b row modifiedFootSubset jO ho1 have originalPair0 : cert.modified.rho F0 ∈ FootprintVertices (occurrence a) ∩ FootprintVertices (occurrence b) := @@ -1881,7 +1940,7 @@ theorem P4418T3SelectedInterfaceExists cert.modified.plane.faceVertex F1 jA = a ∧ cert.modified.plane.faceVertex F1 jB = b ∧ cert.modified.plane.faceVertex F1 jO = owners.2) := SelectedInterfaceGeometry.faceTable q - cfg C T cert a b row retargeted faceVertex faceDistinct + cfg C T cert a b row faceVertex have reversePath {V : Set GaussianInt} {E : Set (Finset GaussianInt)} {x y : GaussianInt} (h : SimpleGridPathBetween V E x y) : SimpleGridPathBetween V E y x := SelectedInterfaceGeometry.reversePath (V := V) (E := E) (x @@ -1911,7 +1970,7 @@ theorem P4418T3SelectedInterfaceExists (cert.modified.rho F0) (cert.modified.rho F1) := SelectedInterfaceGeometry.pathAtOwners q cfg C T cert a b row retargeted faceDistinct faceTable reversePath hne modifiedEdges have endpointsDistinct : cert.modified.rho F0 ≠ cert.modified.rho F1 := - SelectedInterfaceGeometry.endpointsDistinct q cfg C T cert a b row retargeted headLastNe + SelectedInterfaceGeometry.endpointsDistinct q cfg C T cert a b row headLastNe pathAtOwners have selectedCertificate : let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean index 5f298a9e4a..9983a43c20 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean @@ -947,23 +947,24 @@ private theorem hE : simpa [r] using this private theorem hparent : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 - : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + - (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : - ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 - : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : - Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ((F.slot = a + (1 : Fin (3 : - ℕ))) → ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (ProperBandQuadruple r) → ((r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p - 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2)) → ((r 1 = p 0) → ((r 2 = p 2) → ((r 3 = p 3) - → (r 2 = C.1.1))))))) := by + (by + classical + exact + ∀ (C : BandCircle) (orientation : Bool) + (base Rminus Rplus : ProtoTile) + (hminus hplus : PartialOdometer) + (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus + hminus hplus) + (a : Fin (3 : ℕ)), + F.slot = a + (1 : Fin (3 : ℕ)) → + let r := + ![F.q (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, + F.q (a + (2 : Fin (3 : ℕ))).succ]; + r (2 : Fin (4 : ℕ)) = + C.1.1) := by classical - intro C orientation base Rminus Rplus hminus hplus F a p hstep hslot r hr hcoord hA hB hE + intro C orientation base Rminus Rplus hminus hplus F a hslot r rw [← F.parent, hslot] fin_cases a <;> simp [r] @@ -1388,7 +1389,7 @@ theorem P4536T1AFrameB have hE : r 3 = p 3 := AFrameBDetails.hE C orientation base Rminus Rplus hminus hplus F a p hstep have hparent : r 2 = C.1.1 := AFrameBDetails.hparent C orientation base Rminus Rplus hminus - hplus F a p hstep hslot hr hcoord hA hB hE + hplus F a hslot have hpB : p 2 = C.1.1 := hB.symm.trans hparent have hposA : 0 < (p 0).1 := (ProperBandCurvatureStructure p hp).1 have hposB : 0 < (p 2).1 := by rw [hpB]; exact C.2 diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean index 923dd0d196..861ca47049 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean @@ -92,42 +92,27 @@ private theorem hrecg : (by classical exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (g₀ : BandPackingSymmetry), ∀ (P : - FordFareyParameter), (BandPackingSymmetryReversesOrientation g₀ = false) → ((∃ (w : - GaussianInt), g₀ = BandPackingSymmetry.shift w ∨ g₀ = (BandPackingSymmetry.shift - w).comp BandPackingSymmetry.negate) → ((BandPackingSymmetryQuadrupleAction g₀ ![r (0 - : Fin (4 : ℕ)), r (Fin.succ (1 : Fin (3 : ℕ))), r ((1 : Fin (3 : ℕ)) + (1 : Fin (3 : - ℕ))).succ, r ((1 : Fin (3 : ℕ)) + (2 : Fin (3 : ℕ))).succ] = FordRecursiveQuadruple - P) → ( - let p : Fin 4 → CircleCoordinates := ![r 0, r 2, r 3, r 1] - (BandPackingSymmetryQuadrupleAction g₀ p = FordRecursiveQuadruple P) → (∀ (neg : Bool), - (BandPackingSymmetryScopedPhase g₀ p neg) → ((∀ (t : Fin (4 : ℕ) → - CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = p (2 : Fin (4 : ℕ)) - → t (1 : Fin (4 : ℕ)) = p (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g₀ t - neg) → ((∀ (C : CircleCoordinates), BandPackingSymmetryCircleAction - ((BandPackingSymmetry.negate.comp BandPackingSymmetry.negate).comp g₀) C = - BandPackingSymmetryCircleAction g₀ C) → ((BandPackingSymmetryReversesOrientation - ((BandPackingSymmetry.negate.comp BandPackingSymmetry.negate).comp g₀) = - BandPackingSymmetryReversesOrientation g₀) → ((∀ (p : Fin (4 : ℕ) → - CircleCoordinates), BandPackingSymmetryQuadrupleAction - ((BandPackingSymmetry.negate.comp BandPackingSymmetry.negate).comp g₀) p = - BandPackingSymmetryQuadrupleAction g₀ p) → ((∀ (v : GaussianInt), - BandPackingSymmetryVectorAction ((BandPackingSymmetry.negate.comp - BandPackingSymmetry.negate).comp g₀) v = -BandPackingSymmetryVectorAction g₀ v) → (∀ - (g : BandPackingSymmetry), (g = g₀ ∨ g = (BandPackingSymmetry.negate.comp - BandPackingSymmetry.negate).comp g₀) → ((∀ (C : CircleCoordinates), - BandPackingSymmetryCircleAction g C = BandPackingSymmetryCircleAction g₀ C) → - ((BandPackingSymmetryReversesOrientation g = BandPackingSymmetryReversesOrientation - g₀) → ((∀ (p : Fin (4 : ℕ) → CircleCoordinates), BandPackingSymmetryQuadrupleAction g - p = BandPackingSymmetryQuadrupleAction g₀ p) → ((BandPackingSymmetryScopedPhase g p - false) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : - Fin (4 : ℕ)) = p (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = p (2 : Fin (4 : ℕ)) → r (3 - : Fin (4 : ℕ)) = p (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g r false) → - (BandPackingSymmetryQuadrupleAction g p = FordRecursiveQuadruple P)))))))))))))))) ) - := by - classical - intro r g₀ P hg₀ hw₀ hrec p hrec' neg hphase hcyclic hcirc horient hquad hvec g hg hcirg - horientg hquadg hfalse hfalsecyc + ∀ (r : Fin (4 : ℕ) → CircleCoordinates) + (g₀ : BandPackingSymmetry) + (P : FordFareyParameter), + let p := + ![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), + r (1 : Fin (4 : ℕ))]; + BandPackingSymmetryQuadrupleAction g₀ p = + FordRecursiveQuadruple P → + ∀ (g : BandPackingSymmetry), + g = g₀ ∨ + g = + (BandPackingSymmetry.negate.comp + BandPackingSymmetry.negate).comp + g₀ → + (∀ (p : Fin (4 : ℕ) → CircleCoordinates), + BandPackingSymmetryQuadrupleAction g p = + BandPackingSymmetryQuadrupleAction g₀ p) → + BandPackingSymmetryQuadrupleAction g p = + FordRecursiveQuadruple P) := by + classical + intro r g₀ P p hrec' g hg hquadg rcases hg with rfl | rfl · exact hrec' · rw [hquadg p] @@ -415,70 +400,60 @@ private theorem hpointrot : (by classical exact - ∀ (g : BandPackingSymmetry), - let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 - ∀ (cellTurn_bij : Function.Bijective cellTurn), - let E1 : GaussianInt ≃ GaussianInt := Equiv.ofBijective cellTurn cellTurn_bij - let E2 : GaussianInt ≃ GaussianInt := E1.trans E1 - let E3 : GaussianInt ≃ GaussianInt := E2.trans E1 - let E : Fin 4 → GaussianInt ≃ GaussianInt := ![Equiv.refl _, E1, E2, E3] - let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := - if k = 0 then T else if k = 1 then TileQuarterTurn T else - if k = 2 then TileQuarterTurn (TileQuarterTurn T) else - TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)) - let RP (k : Fin 4) (x : Real × Real) : Real × Real := - if k = 0 then x else if k = 1 then (-x.2, x.1) else - if k = 2 then (-x.1, -x.2) else (x.2, -x.1) - let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := - if k = 0 then z else if k = 1 then GaussianQuarterTurn z else - if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) - ∀ (k : Fin (4 : ℕ)), (∀ (T : ProtoTile), BandPackingSymmetryTileAction g T = TP k T) → - ((∀ (z : GaussianInt), BandPackingSymmetryVectorAction g z = VP k z) → ((∀ T, - (BandPackingSymmetryTileAction g T).cells = T.cells.image (E k)) → ((∀ T, - (BandPackingSymmetryTileAction g T).anchor = VP k T.anchor) → ((∀ T, TileCentroid - (BandPackingSymmetryTileAction g T) = RP k (TileCentroid T)) → (∀ (z : GaussianInt), - RP k (GaussianRealPoint z) = GaussianRealPoint (VP k z)))))) ) := by - classical - intro g cellTurn cellTurn_bij E1 E2 E3 E TP RP VP k htilepow hvecpow hcellpow hanchorpow - hcentpow z + let RP := fun (k : Fin (4 : ℕ)) (x : ℝ × ℝ) => + if k = (0 : Fin (4 : ℕ)) then x + else + if k = (1 : Fin (4 : ℕ)) then (-x.2, x.1) + else if k = (2 : Fin (4 : ℕ)) then (-x.1, -x.2) else (x.2, -x.1); + let VP := fun (k : Fin (4 : ℕ)) (z : GaussianInt) => + if k = (0 : Fin (4 : ℕ)) then z + else + if k = (1 : Fin (4 : ℕ)) then GaussianQuarterTurn z + else + if k = (2 : Fin (4 : ℕ)) then + GaussianQuarterTurn + (GaussianQuarterTurn z) + else + GaussianQuarterTurn + (GaussianQuarterTurn + (GaussianQuarterTurn z)); + ∀ (k : Fin (4 : ℕ)) (z : GaussianInt), + RP k (GaussianRealPoint z) = + GaussianRealPoint (VP k z)) := by + classical + intro RP VP k z fin_cases k <;> ext <;> simp [RP, VP, GaussianRealPoint, GaussianQuarterTurn] private theorem hDrot : (by classical exact - ∀ (g : BandPackingSymmetry), - let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 - ∀ (cellTurn_bij : Function.Bijective cellTurn), - let E1 : GaussianInt ≃ GaussianInt := Equiv.ofBijective cellTurn cellTurn_bij - let E2 : GaussianInt ≃ GaussianInt := E1.trans E1 - let E3 : GaussianInt ≃ GaussianInt := E2.trans E1 - let E : Fin 4 → GaussianInt ≃ GaussianInt := ![Equiv.refl _, E1, E2, E3] - let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := - if k = 0 then T else if k = 1 then TileQuarterTurn T else - if k = 2 then TileQuarterTurn (TileQuarterTurn T) else - TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)) - let RP (k : Fin 4) (x : Real × Real) : Real × Real := - if k = 0 then x else if k = 1 then (-x.2, x.1) else - if k = 2 then (-x.1, -x.2) else (x.2, -x.1) - let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := - if k = 0 then z else if k = 1 then GaussianQuarterTurn z else - if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) - ∀ (k : Fin (4 : ℕ)), (∀ (T : ProtoTile), BandPackingSymmetryTileAction g T = TP k T) → - ((∀ (z : GaussianInt), BandPackingSymmetryVectorAction g z = VP k z) → ((∀ T, - (BandPackingSymmetryTileAction g T).cells = T.cells.image (E k)) → ((∀ T, - (BandPackingSymmetryTileAction g T).anchor = VP k T.anchor) → ((∀ T, TileCentroid - (BandPackingSymmetryTileAction g T) = RP k (TileCentroid T)) → ( - let D : GaussianInt → Real × Real := fun z => - (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint - z).1)) - (∀ (z : GaussianInt), RP k (GaussianRealPoint z) = GaussianRealPoint (VP k z)) → (∀ (z : - GaussianInt), RP k (D z) = D (VP k z))))))) ) := by - classical - intro g cellTurn cellTurn_bij E1 E2 E3 E TP RP VP k htilepow hvecpow hcellpow hanchorpow - hcentpow D hpointrot z + let RP := fun (k : Fin (4 : ℕ)) (x : ℝ × ℝ) => + if k = (0 : Fin (4 : ℕ)) then x + else + if k = (1 : Fin (4 : ℕ)) then (-x.2, x.1) + else if k = (2 : Fin (4 : ℕ)) then (-x.1, -x.2) else (x.2, -x.1); + let VP := fun (k : Fin (4 : ℕ)) (z : GaussianInt) => + if k = (0 : Fin (4 : ℕ)) then z + else + if k = (1 : Fin (4 : ℕ)) then GaussianQuarterTurn z + else + if k = (2 : Fin (4 : ℕ)) then + GaussianQuarterTurn + (GaussianQuarterTurn z) + else + GaussianQuarterTurn + (GaussianQuarterTurn + (GaussianQuarterTurn z)); + ∀ (k : Fin (4 : ℕ)), + let D := fun (z : GaussianInt) => + (1 / 2 : ℝ) • + (GaussianRealPoint z - + (-(GaussianRealPoint z).2, + (GaussianRealPoint z).1)); + ∀ (z : GaussianInt), RP k (D z) = D (VP k z)) := by + classical + intro RP VP k D z fin_cases k <;> ext <;> simp [D, RP, VP, GaussianRealPoint, GaussianQuarterTurn] <;> ring @@ -887,8 +862,7 @@ theorem P4638T1EmptyFordLocalization (r : Fin 4 → CircleCoordinates) obtain ⟨neg, hphase, _, hcyclic, hcirc, horient, hquad, hvec, g, hg, hcirg, horientg, hquadg, hfalse, hfalsecyc, _⟩ := BandPackingSymmetryProjectiveVectorCovariance g₀ p hp - have hrecg := EmptyFordGeometry.hrecg r g₀ P hg₀ hw₀ hrec hrec' neg hphase hcyclic hcirc - horient hquad hvec g hg hcirg horientg hquadg hfalse hfalsecyc + have hrecg := EmptyFordGeometry.hrecg r g₀ P hrec' g hg hquadg have hgfalse : BandPackingSymmetryReversesOrientation g = false := by rw [horientg, hg₀] have hphase2 : BandPackingSymmetryScopedPhase g p false := hfalse @@ -922,10 +896,8 @@ theorem P4638T1EmptyFordLocalization (r : Fin 4 → CircleCoordinates) have hchild := EmptyFordGeometry.hchild r P g hrecg hgfalse let D : GaussianInt → Real × Real := fun z => (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) - have hpointrot (z : GaussianInt) := EmptyFordGeometry.hpointrot g cellTurn_bij k htilepow - hvecpow hcellpow hanchorpow hcentpow z - have hDrot (z : GaussianInt) := EmptyFordGeometry.hDrot g cellTurn_bij k htilepow hvecpow - hcellpow hanchorpow hcentpow hpointrot z + have hpointrot (z : GaussianInt) := EmptyFordGeometry.hpointrot k z + have hDrot (z : GaussianInt) := EmptyFordGeometry.hDrot k z have hDcanonical := EmptyFordGeometry.hDcanonical r P g htargetvec k hvecpow hDrot have hRPadd (x y : Real × Real) : RP k (x + y) = RP k x + RP k y := by fin_cases k <;> ext <;> simp [RP] <;> ring diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean index d53a4a4c56..64ef554f7a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean @@ -391,21 +391,10 @@ private theorem qhead : (by classical exact - ∀ (O : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (q : List GaussianInt), ∀ - (q₀ : GaussianInt), ∀ (q₁ : GaussianInt), (q.Nodup) → (((4 : ℕ) ≤ q.length) → - ((q.head? = some q₀) → ((q.getLast? = some q₁) → ((BoundaryFootprintVertices O = - (↑q.toFinset : Set GaussianInt)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ - : List GaussianInt), ∀ (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ → - FourNeighborAdjacent a b) → ((∀ (e : Finset GaussianInt), e ∈ BoundaryFootprintEdges - O ↔ e = {q₁, q₀} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ - : List GaussianInt), q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((∀ (z : GaussianInt), (z - ∈ q) → (z ∈ BoundaryFootprintVertices O)) → ((a ∈ q) → ((b ∈ q) → ( - let S : GaussianInt → GaussianInt → Prop := fun u v => - u ∈ BoundaryFootprintVertices O ∧ v ∈ BoundaryFootprintVertices O ∧ - {u, v} ∈ BoundaryFootprintEdges O - (List.IsChain S q) → (∃ c l, q = c :: l))))))))))) ) := by + ∀ (q : List GaussianInt) (q₀ : GaussianInt), + q.head? = some q₀ → ∃ (c : GaussianInt) (l : List GaussianInt), q = c :: l) := by classical - intro O a b q q₀ q₁ hqnd hqlen hqhead hqlast hqvertices hqstep hqedges qmem aq bq S qchain + intro q q₀ hqhead cases q with | nil => simp at hqhead | cons c l => exact ⟨c, l, rfl⟩ @@ -567,8 +556,7 @@ theorem P4677T2PrecursorWalk : have qreverse {u v : GaussianInt} (h : Relation.ReflTransGen S u v) : Relation.ReflTransGen S v u := PrecursorWalkGeometry.qreverse O S_symm (u := u) (v := v) h - have qhead : ∃ c l, q = c :: l := PrecursorWalkGeometry.qhead O a b q q₀ q₁ hqnd hqlen hqhead - hqlast hqvertices hqstep hqedges qmem aq bq qchain + have qhead : ∃ c l, q = c :: l := PrecursorWalkGeometry.qhead q q₀ hqhead rcases qhead with ⟨c, l, rfl⟩ have hca : c = q₀ := by simpa using hqhead subst c diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean b/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean index f2f36bb49b..c8e8db85c9 100644 --- a/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean +++ b/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean @@ -270,30 +270,25 @@ private theorem hv₁ : (by classical exact - ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ((0 : ℤ) < (q - i.succ).1) → ( - let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) - let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) - let j : Fin 3 := i + 1 - let k : Fin 3 := i + 2 - (0 < (q i.succ).1) → ((0 < rad i.succ) → (((q i.succ).1 < (q 0).1) → ((rad 0 < rad i.succ) → - ((0 < rad i.succ + rad 0) → ((j ≠ i) → ((k ≠ i) → ((j ≠ k) → ((0 < (q j.succ).1 ∨ (q - j.succ).1 = 0) → ((0 < (q k.succ).1 ∨ (q k.succ).1 = 0) → ((¬ ((q j.succ).1 = 0 ∧ (q - k.succ).1 = 0)) → ((dist (p 0) (p i.succ) = rad 0 + rad i.succ) → ((0 ≤ (q j.succ).1 ∧ 0 - ≤ (q k.succ).1) → ( - let A : ℂ := p i.succ - let X : ℂ := p 0 - let e : ℂ := (X - A) / ((rad i.succ + rad 0 : ℝ) : ℂ) - (‖X - A‖ = rad i.succ + rad 0) → ((‖e‖ = 1) → ((Complex.normSq e = 1) → (((q i.succ).1 ≠ - 0) → - ( - let v₁ : ℂ := P5023T1ContactVertices L q (i + 1) - v₁ = if (q k.succ).1 = 0 then ⟨if (q k.succ).2 = -1 then L else L + 2, (p i.succ).im⟩ else - ((q i.succ).2 + (q k.succ).2 : ℂ) / (((q i.succ).1 : ℝ) + ((q k.succ).1 : - ℝ)))))))))))))))))))) ) := by + ∀ (L : ℝ) (q : Fin (4 : ℕ) → CircleCoordinates) + (i : Fin (3 : ℕ)), + let p := fun (a : Fin (4 : ℕ)) => + (GaussianInt.toComplex : GaussianInt → ℂ) (q a).2 / (↑(↑(q a).1 : ℝ) : ℂ); + let k := i + (2 : Fin (3 : ℕ)); + (q i.succ).1 ≠ (0 : ℤ) → + let v₁ := + P5023T1ContactVertices L q + (i + (1 : Fin (3 : ℕ))); + v₁ = + if (q k.succ).1 = (0 : ℤ) then + { re := if (q k.succ).2 = (-1 : GaussianInt) then L else L + (2 : ℝ), + im := (p i.succ).im } + else + ((GaussianInt.toComplex : GaussianInt → ℂ) (q i.succ).2 + + (GaussianInt.toComplex : GaussianInt → ℂ) (q k.succ).2) / + ((↑(↑(q i.succ).1 : ℝ) : ℂ) + (↑(↑(q k.succ).1 : ℝ) : ℂ))) := by classical - intro L q i hpos p rad j k hparent hr hless hRr hden hji hki hjk hjpos hkpos hnotbothzero - hchild_parent hside_nonneg A X e hcenterNorm heNorm heSq hparne v₁ + intro L q i p k hparne v₁ fin_cases i · have hp : (q (1 : Fin 4)).1 ≠ 0 := by simpa using hparne simp [v₁, P5023T1ContactVertices, p, k, hp, add_comm] @@ -306,33 +301,25 @@ private theorem hv₂ : (by classical exact - ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ((0 : ℤ) < (q - i.succ).1) → ( - let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) - let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) - let j : Fin 3 := i + 1 - let k : Fin 3 := i + 2 - (0 < (q i.succ).1) → ((0 < rad i.succ) → (((q i.succ).1 < (q 0).1) → ((rad 0 < rad i.succ) → - ((0 < rad i.succ + rad 0) → ((j ≠ i) → ((k ≠ i) → ((j ≠ k) → ((0 < (q j.succ).1 ∨ (q - j.succ).1 = 0) → ((0 < (q k.succ).1 ∨ (q k.succ).1 = 0) → ((¬ ((q j.succ).1 = 0 ∧ (q - k.succ).1 = 0)) → ((dist (p 0) (p i.succ) = rad 0 + rad i.succ) → ((0 ≤ (q j.succ).1 ∧ 0 - ≤ (q k.succ).1) → ( - let A : ℂ := p i.succ - let X : ℂ := p 0 - let e : ℂ := (X - A) / ((rad i.succ + rad 0 : ℝ) : ℂ) - (‖X - A‖ = rad i.succ + rad 0) → ((‖e‖ = 1) → ((Complex.normSq e = 1) → (((q i.succ).1 ≠ - 0) → - ( - let v₁ : ℂ := P5023T1ContactVertices L q (i + 1) - let v₂ : ℂ := P5023T1ContactVertices L q (i + 2) - (v₁ = if (q k.succ).1 = 0 then ⟨if (q k.succ).2 = -1 then L else L + 2, (p i.succ).im⟩ else - ((q i.succ).2 + (q k.succ).2 : ℂ) / (((q i.succ).1 : ℝ) + ((q k.succ).1 : ℝ))) → (v₂ = if - (q j.succ).1 = 0 then ⟨if (q j.succ).2 = -1 then L else L + 2, (p i.succ).im⟩ else ((q - i.succ).2 + (q j.succ).2 : ℂ) / (((q i.succ).1 : ℝ) + ((q j.succ).1 : - ℝ))))))))))))))))))))) ) := by + ∀ (L : ℝ) (q : Fin (4 : ℕ) → CircleCoordinates) + (i : Fin (3 : ℕ)), + let p := fun (a : Fin (4 : ℕ)) => + (GaussianInt.toComplex : GaussianInt → ℂ) (q a).2 / (↑(↑(q a).1 : ℝ) : ℂ); + let j := i + (1 : Fin (3 : ℕ)); + (q i.succ).1 ≠ (0 : ℤ) → + let v₂ := + P5023T1ContactVertices L q + (i + (2 : Fin (3 : ℕ))); + v₂ = + if (q j.succ).1 = (0 : ℤ) then + { re := if (q j.succ).2 = (-1 : GaussianInt) then L else L + (2 : ℝ), + im := (p i.succ).im } + else + ((GaussianInt.toComplex : GaussianInt → ℂ) (q i.succ).2 + + (GaussianInt.toComplex : GaussianInt → ℂ) (q j.succ).2) / + ((↑(↑(q i.succ).1 : ℝ) : ℂ) + (↑(↑(q j.succ).1 : ℝ) : ℂ))) := by classical - intro L q i hpos p rad j k hparent hr hless hRr hden hji hki hjk hjpos hkpos hnotbothzero - hchild_parent hside_nonneg A X e hcenterNorm heNorm heSq hparne v₁ v₂ hv₁ + intro L q i p j hparne v₂ fin_cases i · have hp : (q (1 : Fin 4)).1 ≠ 0 := by simpa using hparne simp [v₂, P5023T1ContactVertices, p, j, hp, add_comm] @@ -1125,15 +1112,11 @@ theorem P5023T1CircularSide : have hv₁ : v₁ = if (q k.succ).1 = 0 then ⟨if (q k.succ).2 = -1 then L else L + 2, (p i.succ).im⟩ else ((q i.succ).2 + (q k.succ).2 : ℂ) / - (((q i.succ).1 : ℝ) + ((q k.succ).1 : ℝ)) := CircularSideProof.hv₁ L q i hpos hparent hr - hless hRr hden hji hki hjk hjpos hkpos hnotbothzero hchild_parent hside_nonneg - hcenterNorm heNorm heSq hparne + (((q i.succ).1 : ℝ) + ((q k.succ).1 : ℝ)) := CircularSideProof.hv₁ L q i hparne have hv₂ : v₂ = if (q j.succ).1 = 0 then ⟨if (q j.succ).2 = -1 then L else L + 2, (p i.succ).im⟩ else ((q i.succ).2 + (q j.succ).2 : ℂ) / - (((q i.succ).1 : ℝ) + ((q j.succ).1 : ℝ)) := CircularSideProof.hv₂ L q i hpos hparent hr - hless hRr hden hji hki hjk hjpos hkpos hnotbothzero hchild_parent hside_nonneg - hcenterNorm heNorm heSq hparne hv₁ + (((q i.succ).1 : ℝ) + ((q j.succ).1 : ℝ)) := CircularSideProof.hv₂ L q i hparne let V (a : Fin 3) : ℂ := if (q a.succ).1 = 0 then ⟨if (q a.succ).2 = -1 then L else L + 2, A.im⟩ diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean index 43000ecbcd..5758d2a4d7 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean @@ -316,26 +316,32 @@ private theorem hvnotfour : (by classical exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (v : GaussianInt), ∀ (hv : - v ∈ TilingLattice C), (x ∈ BoundaryFootprintVertices (TileTranslation T v)) → (∀ (P : - PeriodicTileComplex ↥(TilingLattice C)), - let iv : TilingLattice C := ⟨v, hv⟩ - (x ∈ BoundaryFootprintVertices (P.tile iv)) → ((∃ y ∈ (P.tile iv).cells, y = x ∨ y = x - - 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → ((∃ y, y ∉ (P.tile iv).cells ∧ (y = x ∨ y - = x - 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩)) → (∀ (a0 : ↥(TilingLattice C)), (x ∈ - (P.tile a0).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - ∈ (P.tile a).cells) y → y = a0) → (∀ (a1 : ↥(TilingLattice C)), (x - (1 : - LatticeCell) ∈ (P.tile a1).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : - ↥(TilingLattice C)) => x - (1 : LatticeCell) ∈ (P.tile a).cells) y → y = a1) → (∀ (a2 - : ↥(TilingLattice C)), (x - (1 : LatticeCell) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ - (P.tile a2).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - - (1 : LatticeCell) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = - a2) → (∀ (a3 : ↥(TilingLattice C)), (x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile - a3).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (⟨(0 - : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = a3) → (¬ (iv = a0 ∧ iv = a1 - ∧ iv = a2 ∧ iv = a3))))))))))))) ) := by + ∀ (C : BandCircle) (x v : GaussianInt) + (hv : v ∈ TilingLattice C) + (P : + PeriodicTileComplex + ↥(TilingLattice C)), + let iv := ⟨v, hv⟩; + (∃ y ∉ (P.tile iv).cells, + y = x ∨ + y = x - (1 : LatticeCell) ∨ + y = + x - (1 : LatticeCell) - + { re := (0 : ℤ), im := (1 : ℤ) } ∨ + y = x - { re := (0 : ℤ), im := (1 : ℤ) }) → + ∀ (a0 : ↥(TilingLattice C)), + x ∈ (P.tile a0).cells → + ∀ (a1 : ↥(TilingLattice C)), + x - (1 : LatticeCell) ∈ (P.tile a1).cells → + ∀ (a2 : ↥(TilingLattice C)), + x - (1 : LatticeCell) - + { re := (0 : ℤ), im := (1 : ℤ) } ∈ + (P.tile a2).cells → + ∀ (a3 : ↥(TilingLattice C)), + x - { re := (0 : ℤ), im := (1 : ℤ) } ∈ (P.tile a3).cells → + ¬(iv = a0 ∧ iv = a1 ∧ iv = a2 ∧ iv = a3)) := by classical - intro C T x v hv hx P iv hxi hcorner hcornerOutside a0 ha0 hu0 a1 ha1 hu1 a2 ha2 hu2 a3 ha3 hu3 + intro C x v hv P iv hcornerOutside a0 ha0 a1 ha1 a2 ha2 a3 ha3 rintro ⟨h0, h1, h2, h3⟩ rcases hcornerOutside with ⟨y, hy, rfl | rfl | rfl | rfl⟩ · exact hy (by simpa [h0] using ha0) @@ -1644,8 +1650,8 @@ theorem PeriodicBoundaryWebLaplacian (C : BandCircle) obtain ⟨a2, ha2, hu2⟩ := PeriodicTileIndexedMultiplicityOne P (x - 1 - ⟨0, 1⟩) obtain ⟨a3, ha3, hu3⟩ := PeriodicTileIndexedMultiplicityOne P (x - ⟨0, 1⟩) - have hvnotfour := WebLaplacianGeometry.hvnotfour C T x v hv hx P hxi hcorner hcornerOutside - a0 ha0 hu0 a1 ha1 hu1 a2 ha2 hu2 a3 ha3 hu3 + have hvnotfour := WebLaplacianGeometry.hvnotfour C x v hv P hcornerOutside + a0 ha0 a1 ha1 a2 ha2 a3 ha3 have hfour := AffineTriangularNoFourfoldCellOwners P tileAt chart x a0 a1 a2 a3 ha0 ha1 ha2 ha3 have secondOwnerCoversThree {I : Type} (f : Fin 4 → I) diff --git a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean index d72932d103..f263ff5eb1 100644 --- a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean @@ -8,10 +8,6 @@ module public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts -public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction -- [TABLET NODE: RightLatticeAdjacentPackingSymmetryTransport] diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean index 3d522507c5..96fe633f66 100644 --- a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean @@ -347,20 +347,13 @@ private theorem endpoint_ne : simp at hrl private theorem hx'q : - ∀ (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (y : - GaussianInt), ∀ (x' : GaussianInt), ∀ (y' : GaussianInt), ∀ (q : List GaussianInt), - (q.Nodup) → (((2 : ℕ) ≤ q.length) → ((q.head? = some x') → ((q.getLast? = some y') → ((V - = (↑q.toFinset : Set GaussianInt)) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : - List GaussianInt), ∀ (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ → b = a + (1 : - GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + { re := (0 : ℤ), im := (1 : ℤ) } ∨ b = - a - { re := (0 : ℤ), im := (1 : ℤ) }) → ((∀ (e : Finset GaussianInt), e ∈ E ↔ ∃ (a : - GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), q = l₁ ++ - a :: b :: l₂ ∧ e = {a, b}) → ((q ≠ []) → ((∃ r, q = x' :: r) → ((∀ z : GaussianInt, z ∈ q - → q.head? = some z → z = x ∨ z = y) → ((∀ z : GaussianInt, z ∈ q → q.getLast? = some z → - z = x ∨ z = y) → (x' ∈ q))))))))))) := by + (by + classical + exact + ∀ (x' : GaussianInt) (q : List GaussianInt), + (2 : ℕ) ≤ q.length → q.head? = some x' → x' ∈ q) := by classical - intro V E x y x' y' q hq hqlen hx' hy' hV' hstep' hE' hqne hqform endpoint_class - endpoint_class_last + intro x' q hqlen hx' cases q with | nil => simp at hqlen | cons a r => @@ -468,8 +461,7 @@ theorem SimpleGridPathEndpointPairUnique have endpoint_ne : ∀ (r : List GaussianInt) (u v : GaussianInt), r.Nodup → 2 ≤ r.length → r.head? = some u → r.getLast? = some v → u ≠ v := EndpointPairProof.endpoint_ne - have hx'q : x' ∈ q := EndpointPairProof.hx'q V E x y x' y' q hq hqlen hx' hy' hV' hstep' hE' - hqne hqform endpoint_class endpoint_class_last + have hx'q : x' ∈ q := EndpointPairProof.hx'q x' q hqlen hx' have hy'q : y' ∈ q := EndpointPairProof.hy'q y' q hy' hqne have hxclass : x' = x ∨ x' = y := EndpointPairProof.hxclass x y x' q hx' endpoint_class hx'q have hyclass : y' = x ∨ y' = y := EndpointPairProof.hyclass x y y' q hy' endpoint_class_last hy'q From 381f4feb9148c88d364addc9f5c1af32890aaf51 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Thu, 12 Nov 2026 20:50:05 +0000 Subject: [PATCH 09/23] Share lattice geometry facts and narrow proof interfaces --- .../AffineLineMapProperties.lean | 40 + ...BandExceptionalRestorationSectorOrder.lean | 74 +- .../BandOdometerParentCentroids.lean | 67 + .../BandOrderedGeneralChildInterfaces.lean | 14 +- .../BandOrderedGeneralGeometricSectors.lean | 76 +- ...deredGeneralLargestParentOdometerRows.lean | 44 +- ...dOrderedGeneralOuterMixedOdometerRows.lean | 42 +- ...BandOrderedGeneralPositiveCutGeometry.lean | 91 +- .../BandOrderedGeneralRawSupport.lean | 39 +- ...eneralRightInterfaceCertificateExists.lean | 47 +- ...alRightNormalizationCertificateExists.lean | 62 +- ...dGeneralRightRoutingCertificateExists.lean | 39 +- ...rderedGeneralRightSelectedRowGeometry.lean | 23 +- ...eredGeneralSubtileCanonicalSeparation.lean | 373 ++- ...SubtileNormalizationCertificateExists.lean | 15 +- ...dGeneralSubtileNormalizedBundleExists.lean | 3 +- .../BandOrientedChildParentRightEndpoint.lean | 396 ++- ...lOccurrenceIntersectionClassification.lean | 18 +- ...PackingSymmetryAffineVectorCovariance.lean | 190 +- .../BandPackingSymmetryCurvature.lean | 43 + ...ndPackingSymmetryMarkedDataCovariance.lean | 106 +- .../BandPackingSymmetryT3T5Covariance.lean | 13 +- .../BandPackingSymmetryTilingTransport.lean | 33 +- .../BandParentVectorQuarterTurn.lean | 39 + .../BandPeriodicSuperharmonicity.lean | 20 +- ...ndPositiveCutBranchCompanionExclusion.lean | 83 +- .../BandPrototileExists.lean | 78 +- .../BandTileTopologyApplication.lean | 19 +- .../BandTwelveParentSurround.lean | 15 +- .../BoundaryFootprintInclusion.lean | 98 + .../BoundaryFrameJoinGeometry.lean | 339 +++ .../CircleMatrixSymmetry.lean | 41 + .../DiamondExceptionalMaximality.lean | 74 +- .../DiamondFootprintCoordinates.lean | 56 + .../DiamondQuadraticArithmetic.lean | 141 + .../EvenSquareQuotient.lean | 38 + .../ApollonianSuperharmonic/FordFareySum.lean | 34 + .../FordInteriorSquareCoordinates.lean | 46 + .../FordLaplacianTable.lean | 81 +- .../FordLeftBoundaryCompatibility.lean | 198 +- .../FordOrientedChildParentEndpoints.lean | 54 +- ...rdOrientedChildParentIncomingEndpoint.lean | 51 +- .../FordParentVectors.lean | 76 + .../FourNeighborLaplacianProperties.lean | 40 + .../GaussianCoordinateFacts.lean | 41 + .../GaussianQuarterTurnProperties.lean | 49 + .../GaussianRealPointProperties.lean | 64 + LeanPool/ApollonianSuperharmonic/Imports.lean | 31 + .../InteriorFootprintIncidence.lean | 74 + .../LatticeAdjacentInterfacePath.lean | 13 +- .../LatticeTileComplementGridConnected.lean | 59 +- .../LatticeTileGridEulerCount.lean | 44 +- .../LatticeTileNonempty.lean | 44 + .../LatticeTileThreeDiskJunction.lean | 145 +- .../LatticeVertexSectorFacts.lean | 134 + .../ListEndpointFacts.lean | 117 + .../LocalSideScaling.lean | 57 + .../MarkedOdometerAdjacencyReduction.lean | 347 +-- .../OpposingBoundaryOdometerStrings.lean | 519 ++-- .../OpposingStringInterfacePath.lean | 44 +- .../OrderedParentVectorSum.lean | 39 + .../OrientedTouchingCovariance.lean | 25 +- .../P3523T1OrderedInsertion.lean | 20 +- .../P3555T2ParabolaChordCuts.lean | 40 +- .../P3597T1VertexSectors.lean | 13 +- .../P3650T1EmptyTriangleDiagonal.lean | 114 +- .../P3650T1ExposedCornerExists.lean | 11 +- .../P3723T1AllContactDrawingExists.lean | 2531 ++++++++++------- .../P3723T1ContactPortsExist.lean | 12 +- .../P3913T1RoutedFaceSubdivision.lean | 69 +- .../P3934T1ArcSideComparison.lean | 888 ++++-- .../P3934T1PolygonalSidePropagation.lean | 30 +- .../P3963T1MixedBoundaryCycle.lean | 157 +- .../P3996T1SRowAlignment.lean | 12 +- ...4055T1OrderedGeneralOppositeEndpoints.lean | 33 +- .../P4055T1PlacementNormalization.lean | 170 +- .../P4062T1InteriorGeometry.lean | 28 +- .../P4062T1LiteralReduction.lean | 23 +- .../P4062T1OverlapDescent.lean | 22 +- .../P4062T1ParentalRestriction.lean | 20 +- .../P4112T1ParentalNeighbors.lean | 8 +- .../P4112T1PathGeometry.lean | 8 +- .../P4120T1FordGeometry.lean | 49 +- .../P4120T1GeneralDescent.lean | 47 +- .../P4158T1EdgeSectorSelection.lean | 312 +- .../P4158T1SmallerStringEdges.lean | 359 ++- .../P4250T1OrdinaryCompatibility.lean | 11 +- .../P4261T1RightCoordinates.lean | 340 ++- .../P4261T1SubtileCoordinates.lean | 160 +- .../P4366T2LocalSectors.lean | 109 +- .../P4418T3RoutedBlockCriterion.lean | 180 +- .../P4418T3SelectedInterfaceExists.lean | 146 +- .../P4456T2OrderedNoChord.lean | 64 +- .../P4458T1FirstProperRows.lean | 19 +- .../P4458T1LargestParentRows.lean | 341 +-- .../P4458T1RespectAppend.lean | 185 +- .../P4458T1SecondNewerRows.lean | 362 +-- .../P4536T1AFrameB.lean | 604 +--- .../P4536T1AFrameD.lean | 106 +- .../P4564T2DiamondGeometry.lean | 22 +- .../P4590T1RestoredBoundaryGeometry.lean | 29 +- .../P4590T1RightInteriorGeometry.lean | 52 +- .../P4651T1CycleComplementaryArcs.lean | 24 +- .../P4812T1RegularFaceWalks.lean | 180 +- .../P4828T1LeftRootGeometry.lean | 96 +- .../P4828T1RightRootGeometry.lean | 96 +- .../P4953T1QuadrilateralSections.lean | 7 +- .../P4953T1TriangleSections.lean | 8 +- .../P5203T1CapInterface.lean | 30 +- .../P5203T1DecreasingInterface.lean | 30 +- .../P5352T2Predecessor0.lean | 120 +- .../P5352T2Predecessor1.lean | 26 +- .../P5352T2Predecessor2.lean | 27 +- .../P5352T2Predecessor3.lean | 138 +- .../P5352T2RightFirst.lean | 133 +- .../P5352T2RightSecond.lean | 133 +- .../P5472T1LiteralFordPlacement.lean | 64 +- .../P5491T1DiamondRightBoundary.lean | 46 +- .../P5596T1LeftWeb.lean | 64 +- ...MarkedRightOdometerAdjacencyReduction.lean | 20 +- .../P5635T1EndpointDiagonalOwnership.lean | 393 +-- ...640T1NonpairedOccurrenceIntersections.lean | 12 +- .../P5667T1StraightFrontierLocalSides.lean | 34 +- .../PeriodicBoundaryWebLaplacian.lean | 66 +- .../PeriodicEdgeContactSymmetry.lean | 38 + .../PeriodicTileTotalIndegree.lean | 60 +- .../RootComplexCoordinates.lean | 115 + .../SignSquareProduct.lean | 33 + .../TileCornerMultiplicity.lean | 67 + .../TileHalfTurnGeometry.lean | 90 + .../TileQuarterTurnFormulas.lean | 15 +- .../TileQuarterTurnTranslation.lean | 52 + .../TileReflectionFormulas.lean | 15 +- .../TileStringCoordinateTransport.lean | 16 +- .../TileT1DiskArea.lean | 62 +- .../TileTouchingDisjoint.lean | 41 + .../TileTranslationProperties.lean | 68 + 137 files changed, 7514 insertions(+), 7926 deletions(-) create mode 100644 LeanPool/ApollonianSuperharmonic/AffineLineMapProperties.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOdometerParentCentroids.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCurvature.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandParentVectorQuarterTurn.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BoundaryFootprintInclusion.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BoundaryFrameJoinGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/CircleMatrixSymmetry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondFootprintCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/DiamondQuadraticArithmetic.lean create mode 100644 LeanPool/ApollonianSuperharmonic/EvenSquareQuotient.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordFareySum.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordInteriorSquareCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FordParentVectors.lean create mode 100644 LeanPool/ApollonianSuperharmonic/FourNeighborLaplacianProperties.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GaussianCoordinateFacts.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GaussianQuarterTurnProperties.lean create mode 100644 LeanPool/ApollonianSuperharmonic/GaussianRealPointProperties.lean create mode 100644 LeanPool/ApollonianSuperharmonic/InteriorFootprintIncidence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeTileNonempty.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeVertexSectorFacts.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ListEndpointFacts.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LocalSideScaling.lean create mode 100644 LeanPool/ApollonianSuperharmonic/OrderedParentVectorSum.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PeriodicEdgeContactSymmetry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/RootComplexCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/SignSquareProduct.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileCornerMultiplicity.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileHalfTurnGeometry.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileQuarterTurnTranslation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileTouchingDisjoint.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileTranslationProperties.lean diff --git a/LeanPool/ApollonianSuperharmonic/AffineLineMapProperties.lean b/LeanPool/ApollonianSuperharmonic/AffineLineMapProperties.lean new file mode 100644 index 0000000000..800b883f6a --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AffineLineMapProperties.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Basic.Real.Basic +public import Mathlib.Init +public import Mathlib.LinearAlgebra.AffineSpace.AffineMap +public import Mathlib.Tactic.Module + + +/-! +# AffineLineMapProperties + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace AffineLineMapProperties + +/-- Shared coordinates identity for AffineLineMapProperties. -/ +theorem coordinates : + (by + classical + exact + ∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x y t = x + t • (y - x) ) := by + classical + intro x y t + rw [AffineMap.lineMap_apply_module] + module + +end AffineLineMapProperties +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean b/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean index de2dc71485..8fc59325e7 100644 --- a/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean +++ b/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean @@ -6,8 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTouchingDisjoint -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction public import LeanPool.ApollonianSuperharmonic.ExceptionalRestorationSectorData @@ -171,18 +171,6 @@ private theorem nonempty_cells : have he : U.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hn simp [TileRealization, he] at hreal -private theorem touching_disjoint : - (by - classical - exact - ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → ((Y.cells.Nonempty) → - ((TileTouching X Y) → (Disjoint X.cells Y.cells))) ) := by - classical - intro X Y hX hY hxy - rcases hxy with ⟨_, _, hd, _⟩ | ⟨he, _⟩ | ⟨he, _⟩ - · exact hd - · simp [he] at hX - · simp [he] at hY private theorem trzero : (by @@ -405,24 +393,6 @@ private theorem hOD : intro x hxO hxD exact Finset.disjoint_left.mp hAD (seg.precursor_in_left hxO) hxD -private theorem boundary_edge_footprint : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges U) → (e ∈ - FootprintEdges U) ) := by - classical - intro U e he - let I : GaussianInt := ⟨0, 1⟩ - rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inl rfl⟩ - · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ - congr 1 <;> simp [I, Zsqrtd.ext_iff] - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ - congr 1 <;> simp [] private theorem edge_vertex_footprint : (by @@ -828,42 +798,6 @@ private theorem cuts_ne_marked : rcases hmark2D with ⟨j, hj⟩ exact cutNoD hOne j (heq ▸ hj) -private theorem splitInternal : - (by - classical - exact - ∀ (l : List GaussianInt), ∀ (x : GaussianInt), ∀ (h : GaussianInt), ∀ (t : GaussianInt), - l.Nodup → l.head? = some h → l.getLast? = some t → x ∈ l → x ≠ h → x ≠ t → ∃ pre y z - post, l = pre ++ y :: x :: z :: post ) := by - classical - intro l - induction l with - | nil => intro x h t hn hh ht hx; simp at hx - | cons a tail ih => - intro x h t hn hh ht hx hxh hxt - have hah : a = h := by simpa using hh - subst h - rcases List.mem_cons.mp hx with hxa | hx - · exact (hxh hxa).elim - · cases tail with - | nil => simp at hx - | cons b rest => - by_cases hxb : x = b - · subst x - have hrest : rest ≠ [] := by - intro he - subst rest - have hb : b = t := by simpa using ht - exact hxt hb - cases rest with - | nil => exact (hrest rfl).elim - | cons c u => - refine ⟨[], a, c, u, ?_⟩ - simp - · obtain ⟨pre, y, z, post, heq⟩ := - ih x b t hn.tail (by rfl) (by simpa using ht) hx hxb hxt - refine ⟨a :: pre, y, z, post, ?_⟩ - simp [heq] private theorem leftInternal : (by @@ -1439,7 +1373,7 @@ theorem BandExceptionalRestorationSectorOrder have hO := RestorationSectorGeometry.hO q cfg C₀ T cert tile_from_band have nonempty_cells := RestorationSectorGeometry.nonempty_cells - have touching_disjoint := RestorationSectorGeometry.touching_disjoint + have touching_disjoint := TileTouchingDisjoint.cells have hA : LatticeTile A := cert.parent_lattice 0 true have hB : LatticeTile B := cert.parent_lattice 0 false have hCparent : LatticeTile C := cert.parent_lattice 1 true @@ -1490,7 +1424,7 @@ theorem BandExceptionalRestorationSectorOrder have hVD : Disjoint V.cells D.cells := touching_disjoint V D hVne hDne cert.double_second.2.1 have boundary_raw := RestorationSectorGeometry.boundary_raw - (RestorationSectorGeometry.boundary_edge_footprint) + (BoundaryFootprintInclusion.boundaryEdge) (RestorationSectorGeometry.edge_vertex_footprint) have footprint_incident := RestorationSectorGeometry.footprint_incident have boundary_missing_incident := RestorationSectorGeometry.boundary_missing_incident @@ -1523,7 +1457,7 @@ theorem BandExceptionalRestorationSectorOrder have cutNoD := RestorationSectorGeometry.cutNoD q cfg C₀ T cert hOD hRD hVD cutDataR have cuts_ne_marked := RestorationSectorGeometry.cuts_ne_marked q cfg C₀ T cert hmark1C hmark2D cutNoC cutNoD - have splitInternal := RestorationSectorGeometry.splitInternal + have splitInternal := ListEndpointFacts.internalNeighbors have leftInternal := RestorationSectorGeometry.leftInternal q cfg C₀ T cert two_owner_sectors hQ hS hQSC splitInternal have rightInternal := RestorationSectorGeometry.rightInternal q cfg C₀ T cert two_owner_sectors diff --git a/LeanPool/ApollonianSuperharmonic/BandOdometerParentCentroids.lean b/LeanPool/ApollonianSuperharmonic/BandOdometerParentCentroids.lean new file mode 100644 index 0000000000..f2dc26ec96 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOdometerParentCentroids.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData +public import Mathlib.Init + + +/-! +# BandOdometerParentCentroids + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace BandOdometerParentCentroids + +/-- Shared positive identity for BandOdometerParentCentroids. -/ +theorem positive : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + TileCentroid (P 1 true) - TileCentroid T = cOff (BandVectors.1 (q 1) (q 3))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data cOff + simpa [cOff, Fin.add_def] using data.hPcent 1 true + +/-- Shared negative identity for BandOdometerParentCentroids. -/ +theorem negative : + (by + classical + exact + ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> + Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> + ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> + PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData + q cfg C0 T cert h P r Q S u v g) → ( + let cOff (z : GaussianInt) : Real × Real := + (1 / 2 : Real) • (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + TileCentroid (P 1 false) - TileCentroid T = -cOff (BandVectors.1 (q 1) (q 3))) ) := by + classical + intro q cfg C0 T cert h P r Q S u v g data cOff + simpa [cOff, Fin.add_def] using data.hPcent 1 false + +end BandOdometerParentCentroids +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean index 418fe0d0c7..c95103119b 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean @@ -6,12 +6,11 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.OrderedParentVectorSum public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralAggregatePatches -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralMixedAggregatePatches public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralPeriodicBlockCells -public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricExactInterfaceTransport -- [TABLET NODE: BandOrderedGeneralChildInterfaces] @@ -1232,15 +1231,6 @@ private theorem hturn2 : rw [hmul, cert.period_v] simpa using (hflip 1).1.symm -private theorem hsum : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (BandVectors.1 - (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) ) := by - classical - intro q cfg - simpa [Fin.sum_univ_succ, add_assoc] using (IncomingSuperbasisRelation q cfg.proper).1 private theorem hthird : (by @@ -1576,7 +1566,7 @@ theorem BandOrderedGeneralChildInterfaces ChildInterfaceGeometry.hturn2 q cfg C₀ T cert hmul hflip have hthird : BandVectors.1 (q 3) (q 0) = -BandVectors.1 (q 1) (q 0) - BandVectors.1 (q 2) (q 0) := ChildInterfaceGeometry.hthird q - (ChildInterfaceGeometry.hsum q cfg) + (OrderedParentVectorSum.incoming q cfg) have hturn3 : GaussianQuarterTurn (BandVectors.1 (q 3) (q 0)) = -cert.u - cert.v := by rw [hthird, hmul, mul_sub, mul_neg, ← hmul, ← hmul, hturn1, hturn2] have qneg1 : GaussianQuarterTurn (-BandVectors.1 (q 1) (q 0)) = -cert.u := by diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean index b9705bce80..4cddce360a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean @@ -838,38 +838,50 @@ private theorem hnd : private theorem hnWhole : (by classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let P := cert.modified - (∀ (whole : FiniteInducedTilePatch P.plane P.tile), (whole.indices = ({⟨.A, 0, 0⟩, ⟨.B, - 0, 0⟩, ⟨.C, 0, 0⟩, ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} : Finset - PeriodicSubtileIndex)) → (∀ (a : PeriodicSubtileIndex), (a ∈ whole.indices) → - (a.first = 0 ∧ a.second = 0))) → (∀ (whole : FiniteInducedTilePatch - cert.modified.plane cert.modified.tile), (whole.indices = {(⟨SixSubtileLabel.A, - (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), (⟨SixSubtileLabel.B, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex), (⟨SixSubtileLabel.C, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex), (⟨SixSubtileLabel.D, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex), (⟨SixSubtileLabel.E, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex), (⟨SixSubtileLabel.F, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex)}) → (∀ (d : PeriodicSubtileIndex), (d ∈ whole.indices) → (∀ - (rest : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (rest.indices - = whole.indices.erase d) → ((rest.unionTile = TileCellComplement T - (cert.modified.tile d)) → ((d ∉ rest.indices) → ((Disjoint (rest.unionTile).cells - (P.tile d).cells) → ((∀ z : LatticeCell, z ∈ whole.unionTile.cells ↔ z ∈ (P.tile - d).cells ∨ z ∈ rest.unionTile.cells) → ( - let n : PeriodicSubtileIndex := match d.label with - | .A => ⟨.B, 0, 0⟩ - | .B => ⟨.A, 0, 0⟩ - | .C => ⟨.A, 0, 0⟩ - | .D => ⟨.A, 0, 0⟩ - | .E => ⟨.B, 0, 0⟩ - | .F => ⟨.A, 0, 0⟩ - (AllowedSubtileIncidence d n) → ((n ≠ d) → (n ∈ whole.indices)))))))))) ) := by + exact + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C₀ : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T), + let P := cert.modified; + (∀ (whole : FiniteInducedTilePatch P.plane P.tile), + (whole.indices = + ({⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, ⟨.D, 0, 0⟩, + ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} : + Finset PeriodicSubtileIndex)) → + (∀ (a : PeriodicSubtileIndex), + (a ∈ whole.indices) → (a.first = 0 ∧ a.second = 0))) → + (∀ + (whole : + FiniteInducedTilePatch cert.modified.plane + cert.modified.tile), + (whole.indices = + {(⟨SixSubtileLabel.A, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), + (⟨SixSubtileLabel.B, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), + (⟨SixSubtileLabel.C, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), + (⟨SixSubtileLabel.D, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), + (⟨SixSubtileLabel.E, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), + (⟨SixSubtileLabel.F, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex)}) → + (∀ (d : PeriodicSubtileIndex), + (d ∈ whole.indices) → + (let n : PeriodicSubtileIndex := + match d.label with + | .A => ⟨.B, 0, 0⟩ + | .B => ⟨.A, 0, 0⟩ + | .C => ⟨.A, 0, 0⟩ + | .D => ⟨.A, 0, 0⟩ + | .E => ⟨.B, 0, 0⟩ + | .F => ⟨.A, 0, 0⟩; + (n ∈ whole.indices))))) := by classical - intro q cfg C₀ T cert P hzero whole hidx d hd rest hrestIdx hrestUnion hdnot hdisj hunion n hdn - hnd + intro q cfg C₀ T cert P hzero whole hidx d hd n cases d with | mk lab i j => have hz := hzero whole hidx ⟨lab, i, j⟩ hd @@ -1214,7 +1226,7 @@ theorem BandOrderedGeneralGeometricSectors have hnd : n ≠ d := GeometricSectorGeometry.hnd q cfg C₀ T cert hzero whole hidx d hd rest hrestIdx hrestUnion hdnot hdisj hunion hdn have hnWhole : n ∈ whole.indices := GeometricSectorGeometry.hnWhole q cfg C₀ T cert hzero - whole hidx d hd rest hrestIdx hrestUnion hdnot hdisj hunion hdn hnd + whole hidx d hd have hnrest : n ∈ rest.indices := GeometricSectorGeometry.hnrest q cfg C₀ T cert whole d rest hrestIdx hnd hnWhole have hneAdj : P.plane.adjacent d n := diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean index cc062edd38..735270c05e 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean @@ -6,9 +6,9 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandOdometerParentCentroids public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorWebRow -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData public import LeanPool.ApollonianSuperharmonic.OdometerWeb -- [TABLET NODE: BandOrderedGeneralLargestParentOdometerRows] @@ -594,25 +594,6 @@ private theorem hslopeDiffAt427 : _ = (1 / 2 : Real) • GaussianRealPoint (-I * (B - I * B)) := slopeAlgebra.1 -private theorem hP1At441 : - (by - classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> - Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> - ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> - PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData - q cfg C0 T cert h P r Q S u v g) → ( - let cOff (z : GaussianInt) : Real × Real := - (1 / 2 : Real) • (GaussianRealPoint z - - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) - TileCentroid (P 1 true) - TileCentroid T = cOff (BandVectors.1 (q 1) (q 3))) ) := by - classical - intro q cfg C0 T cert h P r Q S u v g data cOff - simpa [cOff, Fin.add_def] using data.hPcent 1 true - private theorem hq13At444 : (by classical @@ -1250,25 +1231,6 @@ private theorem hslopeDiffAt794 : (((-I : GaussianInt) ^ (3 : Nat)) * (B - I * B)) := slopeAlgebra.2 -private theorem hP1At810 : - (by - classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> - Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> - ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> - PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData - q cfg C0 T cert h P r Q S u v g) → ( - let cOff (z : GaussianInt) : Real × Real := - (1 / 2 : Real) • (GaussianRealPoint z - - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) - TileCentroid (P 1 false) - TileCentroid T = -cOff (BandVectors.1 (q 1) (q 3))) ) := by - classical - intro q cfg C0 T cert h P r Q S u v g data cOff - simpa [cOff, Fin.add_def] using data.hPcent 1 false - private theorem hform'At819 : (by classical @@ -1749,7 +1711,7 @@ private theorem positiveLargestCase : have hslopeDiff := LargestParentOdometerGeometry.hslopeDiffAt427 q cfg a21 a13 slopeAlgebra pQroot pQ pSroot pS pPplus pRoot' pPminus hQalign hSalign hQdelta hSdelta hPminusDelta (LargestParentOdometerGeometry.hPplusDelta' q pRoot pPplus pRoot' hrootAlign hPplusDelta) - have hP1 := LargestParentOdometerGeometry.hP1At441 q cfg C0 T cert h P r Q S u v g data + have hP1 := BandOdometerParentCentroids.positive q cfg C0 T cert h P r Q S u v g data have hq13 := LargestParentOdometerGeometry.hq13At444 q cfg have htranslateCent := LargestParentOdometerGeometry.htranslateCentAt448 q cfg T P Q v13 centroidAlgebra hQleafOff hPplus hP1 hq13 @@ -1952,7 +1914,7 @@ private theorem reflectedLargestCase : pQroot pQ pSroot pS pRoot pPplus pPminus hQalign hSalign hQdelta hSdelta hPplusDelta (LargestParentOdometerGeometry.hPminusDelta' q pRoot pRoot' pPminus hrootAlign hPminusDelta) - have hP1 := LargestParentOdometerGeometry.hP1At810 q cfg C0 T cert h P r Q S u v g data + have hP1 := BandOdometerParentCentroids.negative q cfg C0 T cert h P r Q S u v g data have hq13 := LargestParentOdometerGeometry.hq13At444 q cfg have hform := (TileTranslationFormulas (S 1 false) (((I : GaussianInt) ^ (3 : Nat)) * W)).2.2.2.2.1 diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean index a4e7a07524..96fc4fb4ba 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean @@ -6,9 +6,9 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandOdometerParentCentroids public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorWebRow -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData public import LeanPool.ApollonianSuperharmonic.OdometerWeb -- [TABLET NODE: BandOrderedGeneralOuterMixedOdometerRows] @@ -359,24 +359,6 @@ private theorem hdelta1 : · dsimp [sOff] simpa [Fin.add_def, hA] using hp1y -private theorem hc1minus : - (by - classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> - Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> - ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> - PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData - q cfg C0 T cert h P r Q S u v g) → ( - let cOff (z : GaussianInt) : Real × Real := - (1 / 2 : Real) • (GaussianRealPoint z - - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) - TileCentroid (P 1 false) - TileCentroid T = -cOff (BandVectors.1 (q 1) (q 3))) ) := by - classical - intro q cfg C0 T cert h P r Q S u v g data cOff - simpa [cOff, Fin.add_def] using data.hPcent 1 false private theorem hcent12 : (by @@ -904,24 +886,6 @@ private theorem hsumV12 : rw [cfg.firstVectorTwo, cfg.firstChild, cfg.firstParentTwo, hflip12] ring -private theorem hc1plus : - (by - classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C0 : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C0 T), ∀ (h : PartialOdometer), ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (r : Fin 3 -> - Bool -> PartialOdometer), ∀ (Q : Fin 3 -> Bool -> ProtoTile), ∀ (S : Fin 3 -> Bool -> - ProtoTile), ∀ (u : Fin 3 -> Bool -> PartialOdometer), ∀ (v : Fin 3 -> Bool -> - PartialOdometer), ∀ (g : IntegerLatticeFunction), (BandOrderedGeneralOdometerRowData - q cfg C0 T cert h P r Q S u v g) → ( - let cOff (z : GaussianInt) : Real × Real := - (1 / 2 : Real) • (GaussianRealPoint z - - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) - TileCentroid (P 1 true) - TileCentroid T = cOff (BandVectors.1 (q 1) (q 3))) ) := by - classical - intro q cfg C0 T cert h P r Q S u v g data cOff - simpa [cOff, Fin.add_def] using data.hPcent 1 true private theorem hcent21 : (by @@ -2237,7 +2201,7 @@ theorem BandOrderedGeneralOuterMixedOdometerRows have hdelta1 := OuterMixedOdometerGeometry.hdelta1 q hA p0 p1leaf hp1x hp1y have hc0plus : TileCentroid (P 0 true) - TileCentroid T = cOff W := by simpa [cOff, Fin.add_def] using data.hPcent 0 true - have hc1minus := OuterMixedOdometerGeometry.hc1minus q cfg C0 T cert h P r Q S u v g data + have hc1minus := BandOdometerParentCentroids.negative q cfg C0 T cert h P r Q S u v g data have hcent12 := OuterMixedOdometerGeometry.hcent12 q cfg T P firstLaws hW hc0plus hc1minus have hsumA12 := OuterMixedOdometerGeometry.hsumA12 q cfg firstLaws hrotA hA21 have hslope12 := OuterMixedOdometerGeometry.hslope12 q cfg hA p0 p0leaf p1leaf hdelta0 hdelta1 @@ -2275,7 +2239,7 @@ theorem BandOrderedGeneralOuterMixedOdometerRows have hdelta1p := OuterMixedOdometerGeometry.hdelta1p q p0 p1pleaf hp1px hp1py have hdelta0m := OuterMixedOdometerGeometry.hdelta0m q p0 p0mleaf hp0mx hp0my have hflip12pair := firstLaws.2.2.2.2 cfg.firstProper 1 - have hc1plus := OuterMixedOdometerGeometry.hc1plus q cfg C0 T cert h P r Q S u v g data + have hc1plus := BandOdometerParentCentroids.positive q cfg C0 T cert h P r Q S u v g data have hc0minus : TileCentroid (P 0 false) - TileCentroid T = -cOff W := by simpa [cOff, Fin.add_def] using data.hPcent 0 false have hcent21 := OuterMixedOdometerGeometry.hcent21 q cfg T P hW diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean index 18be17dd9b..65b3ed4049 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean @@ -166,71 +166,7 @@ private theorem hq3pos : have hne : (q 3).1 ≠ 0 := cfg.noLine 3 omega -private theorem boundary_edge_footprint : - (by - classical - exact - ∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges X) → (e ∈ - FootprintEdges X) ) := by - classical - intro X e he - let I : GaussianInt := ⟨0, 1⟩ - rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inl rfl⟩ - · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ - congr 1 <;> simp [I, Zsqrtd.ext_iff] - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ - congr 1 <;> simp [] - -private theorem edge_vertex_footprint : - (by - classical - exact - ∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges X) → (∀ (z : - GaussianInt), (z ∈ e) → (z ∈ FootprintVertices X)) ) := by - classical - intro X e he z hz - rcases he with ⟨c, hc, he⟩ - unfold FootprintVertices - rw [ite_eq_left ⟨c, hc⟩] - rcases he with h | h | h | h <;> subst e - all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hz - · rcases hz with rfl | rfl - · exact ⟨_, hc, Or.inl rfl⟩ - · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ - · rcases hz with rfl | rfl - · exact ⟨_, hc, Or.inl rfl⟩ - · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ - · rcases hz with rfl | rfl - · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ - · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ - · rcases hz with rfl | rfl - · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ - · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ - -private theorem boundary_to_raw : - (by - classical - exact - (∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges X) → (e ∈ - FootprintEdges X)) → ((∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ - FootprintEdges X) → (∀ (z : GaussianInt), (z ∈ e) → (z ∈ FootprintVertices X))) → (∀ - (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ BoundaryFootprintVertices X) → (x ∈ - FootprintVertices X))) ) := by - classical - intro boundary_edge_footprint edge_vertex_footprint X x hx - by_cases hne : X.cells.Nonempty - · unfold BoundaryFootprintVertices at hx - rw [ite_eq_left hne] at hx - rcases hx with ⟨e, he, hxe⟩ - exact edge_vertex_footprint X e (boundary_edge_footprint X e he) x hxe - · unfold BoundaryFootprintVertices at hx - rw [ite_eq_right hne] at hx - subst x - simp [FootprintVertices, hne] + private theorem boundary_incident : (by @@ -962,15 +898,6 @@ private theorem hP1abs : _ = (TileCentroid (cert.P 1 true) - TileCentroid T) + TileCentroid T := by abel _ = _ := by rw [hP1cent]; exact add_comm _ _ -private theorem pointAdd : - (by - classical - exact - ∀ (x : GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint (x + y) = GaussianRealPoint x - + GaussianRealPoint y ) := by - classical - intro x y - ext <;> simp [GaussianRealPoint] private theorem pointDouble : (by @@ -1200,14 +1127,6 @@ private theorem hP1minusabs : _ = (TileCentroid (cert.P 1 false) - TileCentroid T) + TileCentroid T := by abel _ = _ := by rw [hP1minuscent]; exact add_comm _ _ -private theorem pointNeg : - (by - classical - exact - ∀ (z : GaussianInt), GaussianRealPoint (-z) = -GaussianRealPoint z ) := by - classical - intro z - ext <;> simp [GaussianRealPoint] private theorem hfixedMinusCentroid : (by @@ -1890,8 +1809,8 @@ theorem BandOrderedGeneralPositiveCutGeometry have hS2check := no_checker _ hS2lat have hOcheck := no_checker _ hOlat have boundary_incident := PositiveCutGeometry.boundary_incident - (PositiveCutGeometry.boundary_to_raw (PositiveCutGeometry.boundary_edge_footprint) - (PositiveCutGeometry.edge_vertex_footprint)) + (BoundaryFootprintInclusion.boundaryVertex (BoundaryFootprintInclusion.boundaryEdge) + (BoundaryFootprintInclusion.edgeVertex)) have raw_incident := PositiveCutGeometry.raw_incident have haLeft : cert.exceptionalSegments.a ∈ cert.exceptionalSegments.left := (PositiveCutGeometry.getLast_mem_of_eq_some) _ _ cert.exceptionalSegments.left_last @@ -1977,7 +1896,7 @@ theorem BandOrderedGeneralPositiveCutGeometry have hvector := PositiveCutGeometry.hvector q cfg hρ2 hρ3 hstep hρ0 have translation_centroid := PositiveCutGeometry.translation_centroid have hpoint := PositiveCutGeometry.hpoint q cfg (PositiveCutGeometry.hI2mul hI2) - (PositiveCutGeometry.pointAdd) (PositiveCutGeometry.pointDouble) + (GaussianRealPointProperties.add) (PositiveCutGeometry.pointDouble) have hfixedPlusProto : BandPrototile (q 2) (TileTranslation (cert.Q 1 true) (I * BandVectors.1 (q 3) (q 2))) := BandPrototileTranslation (q 2) (cert.Q 1 true) @@ -2006,7 +1925,7 @@ theorem BandOrderedGeneralPositiveCutGeometry (PositiveCutGeometry.hS1abs q cfg C₀ T cert (PositiveCutGeometry.hS1cent q cfg C₀ T cert occurrence_centroid)) (PositiveCutGeometry.hP1minusabs q cfg C₀ T cert (PositiveCutGeometry.hP1minuscent q cfg C₀ T cert occurrence_centroid)) - (PositiveCutGeometry.pointNeg)) + (GaussianRealPointProperties.negation)) have p2_a_O_row := PositiveCutGeometry.p2_a_O_row q cfg C₀ T cert hO birth hproper branchExclusions hOproto hQ2proto hS3proto hneQ1S1 hneA_SO hneB_QO selected_p2_a hfixedPlusUnique (PositiveCutGeometry.hfixedPlusAbsent q cfg C₀ T cert hO sector diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean index 04bbb157f0..9b025a5304 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation @@ -29,19 +31,6 @@ namespace ApollonianSuperharmonic namespace RawSupportGeometry -private theorem translation_zeroAt149 : - (by - classical - exact - ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by - classical - intro U - have hzero : GaussianTranslation (0 : GaussianInt) = id := by - funext z - simp [GaussianTranslation] - cases U - simp [TileTranslation, hzero, GaussianTranslation] - private theorem htileAAt155 : (by classical @@ -341,24 +330,6 @@ private theorem raw_boundary : · exact P3161T2IncidentBoundary _ z ⟨jC, hjC⟩ ⟨jQ, fun h => Finset.disjoint_left.mp hQC.1 hjQ h⟩ -private theorem boundary_edge_footprint : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges U) → (e ∈ - FootprintEdges U) ) := by - classical - intro U e he - let I : GaussianInt := ⟨0, 1⟩ - rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inl rfl⟩ - · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ - congr 1 <;> simp [I, Zsqrtd.ext_iff] - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ - congr 1 <;> simp [] private theorem hQO : (by @@ -759,7 +730,7 @@ theorem BandOrderedGeneralRawSupport let z1 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) let z3 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) have translation_zero (U : ProtoTile) : TileTranslation U 0 = U := - RawSupportGeometry.translation_zeroAt149 U + TileTranslationProperties.zero U have htileA : cert.modified.tile a = TileCellComplement (cert.P 0 true) cert.O := RawSupportGeometry.htileAAt155 q cfg C₀ T cert translation_zero @@ -826,7 +797,7 @@ theorem BandOrderedGeneralRawSupport (raw_boundary z1 hz1Q hz1C) (raw_boundary z3 hz3Q hz3C) have boundary_edge_footprint (U : ProtoTile) (e : Finset GaussianInt) (he : e ∈ BoundaryFootprintEdges U) : e ∈ FootprintEdges U := - RawSupportGeometry.boundary_edge_footprint U e he + BoundaryFootprintInclusion.boundaryEdge U e he have hQO : Disjoint (cert.Q 1 true).cells cert.O.cells := RawSupportGeometry.hQO q cfg C₀ T cert hQne have hsupportEdges : ∀ x y : GaussianInt, ∀ l r : List GaussianInt, @@ -880,7 +851,7 @@ theorem BandOrderedGeneralRawSupport let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ let f2 := cert.modifiedFaceEquivalence.symm ⟨.I2, 0, 0⟩ have translation_zero (U : ProtoTile) : TileTranslation U 0 = U := - RawSupportGeometry.translation_zeroAt149 U + TileTranslationProperties.zero U have htileA : cert.modified.tile a = TileCellComplement (cert.P 0 true) cert.O := RawSupportGeometry.htileAAt155 q cfg C₀ T cert translation_zero diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean index ee6f26f8a9..fc7858a8c5 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurnProperties +public import LeanPool.ApollonianSuperharmonic.BandParentVectorQuarterTurn public import LeanPool.ApollonianSuperharmonic.BandVectorParentSums public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightInterfaceCertificate @@ -245,34 +247,6 @@ private theorem thirdTurnTouching : (centeredTurnTouching A _ _ hsym (centeredTurnTouching A a b hsym ht)) -private theorem turn_flip : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralRightNormalizationCertificate C T N h k x), - let q := normalization.normalizedPresentation - (∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q j.succ) = (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 - (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * - BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ)))) → (∀ (s : Fin 3), GaussianQuarterTurn - (BandVectors.1 (q s.succ) (q 0)) = BandVectors.1 (q 0) (q s.succ)) ) := by - classical - intro C T N h k x normalization q flip s - rw [(flip s).1] - rcases BandVectors.1 (q s.succ) (q 0) with ⟨a, b⟩ - apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] - -private theorem turn_neg : - (by - classical - exact - ∀ (z : GaussianInt), GaussianQuarterTurn (-z) = -GaussianQuarterTurn z ) := by - classical - intro z - rcases z with ⟨a, b⟩ - apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] private theorem turn_three : (by @@ -285,15 +259,6 @@ private theorem turn_three : rcases z with ⟨a, b⟩ apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] -private theorem turn_two : - (by - classical - exact - ∀ (z : GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn z) = -z ) := by - classical - intro z - rcases z with ⟨a, b⟩ - apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] private theorem touch0p : (by @@ -1057,17 +1022,17 @@ theorem BandOrderedGeneralRightInterfaceCertificateExists have flip := laws.2.2.2.2 normalization.configuration.proper have turn_flip (s : Fin 3) : GaussianQuarterTurn (BandVectors.1 (q s.succ) (q 0)) = - BandVectors.1 (q 0) (q s.succ) := RightInterfaceCertificateGeometry.turn_flip C T N h k x - normalization flip s + BandVectors.1 (q 0) (q s.succ) := BandParentVectorQuarterTurn.turn + (normalization).normalizedPresentation (fun j => (flip j).1) s have turn_neg (z : GaussianInt) : GaussianQuarterTurn (-z) = -GaussianQuarterTurn z := - RightInterfaceCertificateGeometry.turn_neg z + GaussianQuarterTurnProperties.negation z have turn_three (z : GaussianInt) : GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) = -GaussianQuarterTurn z := RightInterfaceCertificateGeometry.turn_three z have turn_two (z : GaussianInt) : GaussianQuarterTurn (GaussianQuarterTurn z) = -z := - RightInterfaceCertificateGeometry.turn_two z + GaussianQuarterTurnProperties.twice z have turn0 : GaussianQuarterTurn (BandVectors.1 (q 1) (q 0)) = BandVectors.1 (q 0) (q 1) := by simpa using turn_flip (0 : Fin 3) have turn1 : GaussianQuarterTurn (BandVectors.1 (q 2) (q 0)) = diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean index 2679882df0..741fad7f25 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean @@ -460,33 +460,38 @@ private theorem hadjbar : private theorem houterCentroid : (by classical - exact - ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i₀ : - Fin (3 : ℕ)), ∀ (e₀ : Bool), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let irot : Fin 3 := i₀ - r - let qbar := BandPackingSymmetryQuadrupleAction g qrot - ∀ (negative : Bool), ∀ (pTbar : ℝ × ℝ), ∀ (pNbar : ℝ × ℝ), - let reverse := BandPackingSymmetryReversesOrientation g - let idir : Fin 3 := if reverse then -irot else irot - let ebar : Bool := xor (xor e₀ negative) reverse - let positive : Bool := !ebar - (TileCentroid (BandPackingSymmetryTileAction g N) - TileCentroid - (BandPackingSymmetryTileAction g T) = (if positive = true then (-1 : Real) else 1) • - GaussianRealPoint (BandVectors.1 (qbar 0) (qbar idir.succ))) → ((pNbar.1 - pTbar.1 = - (if positive = true then (-1 : Real) else 1) * (BandVectors.2 (qbar 0) (qbar - idir.succ)).re) → ((pNbar.2 - pTbar.2 = (if positive = true then (-1 : Real) else 1) - * (BandVectors.2 (qbar 0) (qbar idir.succ)).im) → ( - let Tbar := BandPackingSymmetryTileAction g T - let Nbar := BandPackingSymmetryTileAction g N - let displacement : GaussianInt := - (if positive = true then (1 : GaussianInt) else -1) * - BandVectors.1 (qbar 0) (qbar idir.succ) - TileCentroid Tbar = TileCentroid (TileTranslation Nbar displacement)))) ) := by + exact + ∀ (T : ProtoTile), + ∀ (N : ProtoTile), + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i₀ : Fin (3 : ℕ)), + ∀ (e₀ : Bool), + ∀ (r : Fin (3 : ℕ)), + ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ]; + let irot : Fin 3 := i₀ - r; + let qbar := BandPackingSymmetryQuadrupleAction g qrot; + ∀ (negative : Bool), + let reverse := BandPackingSymmetryReversesOrientation g; + let idir : Fin 3 := if reverse then -irot else irot; + let ebar : Bool := xor (xor e₀ negative) reverse; + let positive : Bool := !ebar; + (TileCentroid (BandPackingSymmetryTileAction g N) - + TileCentroid (BandPackingSymmetryTileAction g T) = + (if positive = true then (-1 : Real) else 1) • + GaussianRealPoint + (BandVectors.1 (qbar 0) (qbar idir.succ))) → + (let Tbar := BandPackingSymmetryTileAction g T; + let Nbar := BandPackingSymmetryTileAction g N; + let displacement : GaussianInt := + (if positive = true then (1 : GaussianInt) else -1) * + BandVectors.1 (qbar 0) (qbar idir.succ); + TileCentroid Tbar = + TileCentroid (TileTranslation Nbar displacement))) := by classical - intro T N q i₀ e₀ r g qrot irot qbar negative pTbar pNbar reverse idir ebar positive hcentBar' - hslopeReBar' hslopeImBar' Tbar Nbar displacement + intro T N q i₀ e₀ r g qrot irot qbar negative reverse idir ebar positive hcentBar' Tbar Nbar + displacement rw [(TileTranslationFormulas Nbar displacement).2.2.2.2.1] have h₁ := congrArg Prod.fst hcentBar' have h₂ := congrArg Prod.snd hcentBar' @@ -736,9 +741,8 @@ theorem BandOrderedGeneralRightNormalizationCertificateExists let displacement : GaussianInt := (if positive = true then (1 : GaussianInt) else -1) * BandVectors.1 (qbar 0) (qbar idir.succ) - have houterCentroid := RightNormalizationGeometry.houterCentroid T N q i₀ e₀ r g negative pTbar - pNbar - hcentBar' hslopeReBar' hslopeImBar' + have houterCentroid := RightNormalizationGeometry.houterCentroid T N q i₀ e₀ r g negative + hcentBar' have htranslatedN : BandPrototile (qbar 0) (TileTranslation Nbar displacement) := BandPrototileTranslation _ _ _ hNbarBand diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean index a59bcd1234..ec687256ef 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandParentVectorQuarterTurn public import LeanPool.ApollonianSuperharmonic.BandVectorParentSums public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightRoutingCertificate @@ -77,25 +78,6 @@ private theorem hend : rw [← interface.interface_endpoints.1] exact (interface.endData.unique_common interface.endData.point).2 rfl -private theorem turn_flip : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralRightNormalizationCertificate C T N h k x), - let q := normalization.normalizedPresentation - (∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q j.succ) = (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 - (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * - BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ)))) → (∀ (s : Fin 3), GaussianQuarterTurn - (BandVectors.1 (q s.succ) (q 0)) = BandVectors.1 (q 0) (q s.succ)) ) := by - classical - intro C T N h k x normalization q flip s - rw [(flip s).1] - rcases BandVectors.1 (q s.succ) (q 0) with ⟨a, b⟩ - apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] - private theorem period2 : (by classical @@ -215,19 +197,6 @@ private theorem hcentralIndex : fin_cases centralSlot <;> cases centralSign <;> simp [centralIndex, labelOf] -private theorem translation_zero : - (by - classical - exact - ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by - classical - intro U - cases U with - | mk cells anchor => - have hc : cells.image (GaussianTranslation 0) = cells := by - ext z - simp [GaussianTranslation] - simp [TileTranslation, hc, GaussianTranslation] private theorem hcentralOccurrence : (by @@ -993,8 +962,8 @@ theorem BandOrderedGeneralRightRoutingCertificateExists have flip := laws.2.2.2.2 normalization.configuration.proper have turn_flip (s : Fin 3) : GaussianQuarterTurn (BandVectors.1 (q s.succ) (q 0)) = - BandVectors.1 (q 0) (q s.succ) := RightRoutingGeometry.turn_flip C T N h k x - normalization flip s + BandVectors.1 (q 0) (q s.succ) := BandParentVectorQuarterTurn.turn + (normalization).normalizedPresentation (fun j => (flip j).1) s have turn0 : GaussianQuarterTurn (BandVectors.1 (q 1) (q 0)) = BandVectors.1 (q 0) (q 1) := by simpa using turn_flip (0 : Fin 3) have turn1 : GaussianQuarterTurn (BandVectors.1 (q 2) (q 0)) = @@ -1074,7 +1043,7 @@ theorem BandOrderedGeneralRightRoutingCertificateExists selectedSlot selectedSign hselected hselectedCells have hcentralCell := RightRoutingGeometry.hcentralCell C T N h k x normalization j centralSlot centralSign hcentral (RightRoutingGeometry.hcentralOccurrence C T N h k x normalization - centralSlot centralSign (RightRoutingGeometry.translation_zero)) + centralSlot centralSign (TileTranslationProperties.zero)) have footprint_of_cell := RightRoutingGeometry.footprint_of_cell have exteriorCorners := footprint_of_cell _ _ hexteriorCell have centralCorners := footprint_of_cell _ _ hcentralCell diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean index 7f0787c061..edef3be3cb 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean @@ -9,7 +9,6 @@ public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.P5640T1NonpairedOccurrenceIntersections public import LeanPool.ApollonianSuperharmonic.P5635T1RightBoundaryInterfaceRecords -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightInterfaceCertificateExists public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSelectedContactRow @@ -65,25 +64,7 @@ private theorem turnOutgoing : rcases BandVectors.1 (q s.succ) (q 0) with ⟨a, b⟩ apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] -private theorem turnNeg : - (by - classical - exact - ∀ (z : GaussianInt), GaussianQuarterTurn (-z) = -GaussianQuarterTurn z ) := by - classical - intro z - rcases z with ⟨a, b⟩ - apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] -private theorem turnTwice : - (by - classical - exact - ∀ (z : GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn z) = -z ) := by - classical - intro z - rcases z with ⟨a, b⟩ - apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] private theorem turnThrice : (by @@ -4699,8 +4680,8 @@ theorem BandOrderedGeneralRightSelectedRowGeometry BandVectors.1 (q 0) (q s.succ) := SelectedRowGeometry.turnOutgoing C D T N h k x bundle turnFlip s have turnNeg (z : GaussianInt) : - GaussianQuarterTurn (-z) = -GaussianQuarterTurn z := SelectedRowGeometry.turnNeg z - have turnThrice := SelectedRowGeometry.turnThrice turnNeg (SelectedRowGeometry.turnTwice) + GaussianQuarterTurn (-z) = -GaussianQuarterTurn z := GaussianQuarterTurnProperties.negation z + have turnThrice := SelectedRowGeometry.turnThrice turnNeg (GaussianQuarterTurnProperties.twice) have fixedPositive : 0 < (q 0).1 := (ProperBandCurvatureStructure q cfg.proper).1 have boundaryRecords := P5635T1RightBoundaryInterfaceRecords diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean index 4ac9af916a..64458f4130 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance @@ -137,40 +138,37 @@ private theorem occurrence_subset_block : ModifiedSubtileOccurrenceInterpretation] using hz private theorem root_occurrence_disjoint : - ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (O : ProtoTile), ∀ (T : ProtoTile), ∀ (W : ProtoTile), ∀ - (u : GaussianInt), ∀ (v : GaussianInt), ∀ (g : GaussianInt), ∀ (wShift : GaussianInt), ∀ - (wBlock : Int × Int), (LatticeTile T) → ((∀ (m : ℤ), ∀ (n : ℤ), ∀ (z : LatticeCell), z ∈ - (TileTranslation T ((↑m : GaussianInt) * u + (↑n : GaussianInt) * v)).cells ↔ ∃ (label : - SixSubtileLabel), z ∈ (ModifiedSubtileOccurrenceInterpretation P O u v ⟨label, m, - n⟩).cells) → ((∀ (m : ℤ), ∀ (n : ℤ), ∀ (r : ℤ), ∀ (s : ℤ), (m, n) ≠ (r, s) → Disjoint - (TileTranslation T ((↑m : GaussianInt) * u + (↑n : GaussianInt) * v)).cells - (TileTranslation T ((↑r : GaussianInt) * u + (↑s : GaussianInt) * v)).cells) → ((W = - TileTranslation T wShift) → (((TileTranslation (TileQuarterTurn T) g).cells = T.cells) → - (((TileTranslation (TileQuarterTurn W) g).cells = (TileTranslation T ((↑wBlock.1 : - GaussianInt) * u + (↑wBlock.2 : GaussianInt) * v)).cells) → ((LatticeTile T) → ((∀ (m : - ℤ), ∀ (n : ℤ), ∀ (r : ℤ), ∀ (s : ℤ), (m, n) ≠ (r, s) → Disjoint (TileTranslation T - ((↑m : - GaussianInt) * u + (↑n : GaussianInt) * v)).cells (TileTranslation T ((↑r : GaussianInt) - * u + (↑s : GaussianInt) * v)).cells) → ((∀ (o : PeriodicSubtileIndex), - (SubtileOccurrenceInterpretation P u v o).cells ⊆ (TileTranslation T ((o.first : - GaussianInt) * u + (o.second : GaussianInt) * v)).cells) → (∀ (o : PeriodicSubtileIndex), - (o.first, o.second) ≠ ((0 : ℤ), (0 : ℤ)) → Disjoint T.cells - (SubtileOccurrenceInterpretation P u v o).cells))))))))) := by + ∀ (P : Fin 3 → Bool → ProtoTile), + ∀ (T : ProtoTile), + ∀ (u : GaussianInt), + ∀ (v : GaussianInt), + ((∀ (m : ℤ), + ∀ (n : ℤ), + ∀ (r : ℤ), + ∀ (s : ℤ), + (m, n) ≠ (r, s) → + Disjoint + (TileTranslation T + ((↑m : GaussianInt) * u + + (↑n : GaussianInt) * v)).cells + (TileTranslation T + ((↑r : GaussianInt) * u + + (↑s : GaussianInt) * v)).cells) → + ((∀ (o : PeriodicSubtileIndex), + (SubtileOccurrenceInterpretation P u v o).cells ⊆ + (TileTranslation T + ((o.first : GaussianInt) * u + + (o.second : GaussianInt) * v)).cells) → + (∀ (o : PeriodicSubtileIndex), + (o.first, o.second) ≠ ((0 : ℤ), (0 : ℤ)) → + Disjoint T.cells + (SubtileOccurrenceInterpretation P u v o).cells))) := by classical - intro P O T W u v g wShift wBlock hRootLattice hBlockCells hBlockDisjoint hW hrootBar hWBar - hTlattice hblocks occurrence_subset_block o hnonzero + intro P T u v hblocks occurrence_subset_block o hnonzero have h := hblocks 0 0 o.first o.second (by intro heq exact hnonzero heq.symm) - have hzero : (TileTranslation T 0).cells = T.cells := by - have ht : TileTranslation T 0 = T := by - cases T with - | mk cells anchor => - apply congrArg₂ ProtoTile.mk - · ext z - simp [GaussianTranslation] - · simp [GaussianTranslation] - exact congrArg ProtoTile.cells ht + have hzero := congrArg ProtoTile.cells (TileTranslationProperties.zero T) rw [← hzero] simpa using h.mono_right (occurrence_subset_block o) @@ -188,87 +186,240 @@ private theorem turn_map_injective : omega private theorem hrootW : - ∀ (P : Fin 3 → Bool → ProtoTile), ∀ (O : ProtoTile), ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ - (W : ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (g : GaussianInt), ∀ (wShift - : GaussianInt), ∀ (parentSlot : Fin 3), ∀ (turn : Fin 4), ∀ (uIndex : - PeriodicSubtileIndex), ∀ (uBar : PeriodicSubtileIndex), ∀ (vIndex : - PeriodicSubtileIndex), ∀ (vBar : PeriodicSubtileIndex), ∀ (wBlock : Int × Int), - (parentSlot = (0 : Fin (3 : ℕ)) ∧ turn = (0 : Fin (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.A, - (0 : ℤ), (-1 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ ∧ wBlock = ((1 : ℤ), (0 - : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.C, (1 : - ℤ), (1 : ℤ)⟩ ∨ parentSlot = (0 : Fin (3 : ℕ)) ∧ turn = (1 : Fin (4 : ℕ)) ∧ uIndex = - ⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ ∧ - wBlock = ((-1 : ℤ), (0 : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ ∧ vBar = - ⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ ∨ parentSlot = (0 : Fin (3 : ℕ)) ∧ turn = (2 : Fin - (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.A, - (-1 : ℤ), (-1 : ℤ)⟩ ∧ wBlock = ((-1 : ℤ), (0 : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.D, (-1 : - ℤ), (0 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ ∨ parentSlot = (0 : Fin (3 - : ℕ)) ∧ turn = (3 : Fin (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ ∧ - uBar = ⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ ∧ wBlock = ((1 : ℤ), (0 : ℤ)) ∧ vIndex = - ⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ ∨ - parentSlot = (1 : Fin (3 : ℕ)) ∧ turn = (0 : Fin (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.C, - (1 : ℤ), (1 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ ∧ wBlock = ((0 : ℤ), (1 - : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.E, (-1 : - ℤ), (0 : ℤ)⟩ ∨ parentSlot = (1 : Fin (3 : ℕ)) ∧ turn = (1 : Fin (4 : ℕ)) ∧ uIndex = - ⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ ∧ - wBlock = ((0 : ℤ), (-1 : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ ∧ vBar = - ⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ ∨ parentSlot = (1 : Fin (3 : ℕ)) ∧ turn = (2 : - Fin (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ ∧ uBar = - ⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ ∧ wBlock = ((0 : ℤ), (-1 : ℤ)) ∧ vIndex = - ⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ ∨ - parentSlot = (1 : Fin (3 : ℕ)) ∧ turn = (3 : Fin (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.C, - (1 : ℤ), (0 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ ∧ wBlock = ((0 : ℤ), (1 - : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.B, (1 : - ℤ), (1 : ℤ)⟩ ∨ parentSlot = (2 : Fin (3 : ℕ)) ∧ turn = (0 : Fin (4 : ℕ)) ∧ uIndex = - ⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ ∧ - wBlock = ((-1 : ℤ), (-1 : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ ∧ vBar = - ⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ ∨ parentSlot = (2 : Fin (3 : ℕ)) ∧ turn = (1 : Fin - (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.F, - (1 : ℤ), (0 : ℤ)⟩ ∧ wBlock = ((1 : ℤ), (1 : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.D, (-1 : ℤ), - (-1 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ ∨ parentSlot = (2 : Fin (3 : ℕ)) - ∧ turn = (2 : Fin (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ ∧ uBar = - ⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ ∧ wBlock = ((1 : ℤ), (1 : ℤ)) ∧ vIndex = - ⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ ∨ - parentSlot = (2 : Fin (3 : ℕ)) ∧ turn = (3 : Fin (4 : ℕ)) ∧ uIndex = ⟨SixSubtileLabel.E, - (0 : ℤ), (1 : ℤ)⟩ ∧ uBar = ⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ ∧ wBlock = ((-1 : ℤ), - (-1 : ℤ)) ∧ vIndex = ⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ ∧ vBar = ⟨SixSubtileLabel.D, - (-1 : ℤ), (0 : ℤ)⟩) → ((LatticeTile T) → ((∀ (m : ℤ), ∀ (n : ℤ), ∀ (z : LatticeCell), z ∈ - (TileTranslation T ((↑m : GaussianInt) * u + (↑n : GaussianInt) * v)).cells ↔ ∃ (label : - SixSubtileLabel), z ∈ (ModifiedSubtileOccurrenceInterpretation P O u v ⟨label, m, - n⟩).cells) → ((∀ (m : ℤ), ∀ (n : ℤ), ∀ (r : ℤ), ∀ (s : ℤ), (m, n) ≠ (r, s) → Disjoint - (TileTranslation T ((↑m : GaussianInt) * u + (↑n : GaussianInt) * v)).cells - (TileTranslation T ((↑r : GaussianInt) * u + (↑s : GaussianInt) * v)).cells) → ((W = - TileTranslation T wShift) → (((TileTranslation (TileQuarterTurn T) g).cells = T.cells) → - (((TileTranslation (TileQuarterTurn W) g).cells = (TileTranslation T ((↑wBlock.1 : - GaussianInt) * u + (↑wBlock.2 : GaussianInt) * v)).cells) → ((LatticeTile T) → ((∀ (m : - ℤ), ∀ (n : ℤ), ∀ (r : ℤ), ∀ (s : ℤ), (m, n) ≠ (r, s) → Disjoint (TileTranslation T - ((↑m : - GaussianInt) * u + (↑n : GaussianInt) * v)).cells (TileTranslation T ((↑r : GaussianInt) - * u + (↑s : GaussianInt) * v)).cells) → ((∀ (o : PeriodicSubtileIndex), - (SubtileOccurrenceInterpretation P u v o).cells ⊆ (TileTranslation T ((o.first : - GaussianInt) * u + (o.second : GaussianInt) * v)).cells) → ((∀ (o : - PeriodicSubtileIndex), ((o.first, o.second) ≠ (0, 0)) → (Disjoint T.cells - (SubtileOccurrenceInterpretation P u v o).cells)) → ((∀ (A : ProtoTile), ∀ (B : - ProtoTile), (Disjoint (TileTranslation (TileQuarterTurn A) g).cells (TileTranslation - (TileQuarterTurn B) g).cells) → (Disjoint A.cells B.cells)) → ((Disjoint T.cells U.cells) - → (Disjoint T.cells W.cells))))))))))))) := by + ∀ (T : ProtoTile), + ∀ (W : ProtoTile), + ∀ (u : GaussianInt), + ∀ (v : GaussianInt), + ∀ (g : GaussianInt), + ∀ (parentSlot : Fin 3), + ∀ (turn : Fin 4), + ∀ (uIndex : PeriodicSubtileIndex), + ∀ (uBar : PeriodicSubtileIndex), + ∀ (vIndex : PeriodicSubtileIndex), + ∀ (vBar : PeriodicSubtileIndex), + ∀ (wBlock : Int × Int), + (parentSlot = (0 : Fin (3 : ℕ)) ∧ + turn = (0 : Fin (4 : ℕ)) ∧ + uIndex = + ⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ ∧ + uBar = ⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ ∧ + wBlock = ((1 : ℤ), (0 : ℤ)) ∧ + vIndex = + ⟨SixSubtileLabel.C, (1 : ℤ), + (0 : ℤ)⟩ ∧ + vBar = + ⟨SixSubtileLabel.C, (1 : ℤ), + (1 : ℤ)⟩ ∨ + parentSlot = (0 : Fin (3 : ℕ)) ∧ + turn = (1 : Fin (4 : ℕ)) ∧ + uIndex = + ⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ ∧ + uBar = + ⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ ∧ + wBlock = ((-1 : ℤ), (0 : ℤ)) ∧ + vIndex = + ⟨SixSubtileLabel.F, (1 : ℤ), + (0 : ℤ)⟩ ∧ + vBar = + ⟨SixSubtileLabel.E, (0 : ℤ), + (1 : ℤ)⟩ ∨ + parentSlot = (0 : Fin (3 : ℕ)) ∧ + turn = (2 : Fin (4 : ℕ)) ∧ + uIndex = + ⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ ∧ + uBar = + ⟨SixSubtileLabel.A, (-1 : ℤ), + (-1 : ℤ)⟩ ∧ + wBlock = ((-1 : ℤ), (0 : ℤ)) ∧ + vIndex = + ⟨SixSubtileLabel.D, (-1 : ℤ), + (0 : ℤ)⟩ ∧ + vBar = + ⟨SixSubtileLabel.D, (-1 : ℤ), + (-1 : ℤ)⟩ ∨ + parentSlot = (0 : Fin (3 : ℕ)) ∧ + turn = (3 : Fin (4 : ℕ)) ∧ + uIndex = + ⟨SixSubtileLabel.A, (-1 : ℤ), + (-1 : ℤ)⟩ ∧ + uBar = + ⟨SixSubtileLabel.A, (0 : ℤ), + (-1 : ℤ)⟩ ∧ + wBlock = ((1 : ℤ), (0 : ℤ)) ∧ + vIndex = + ⟨SixSubtileLabel.E, (-1 : ℤ), + (0 : ℤ)⟩ ∧ + vBar = + ⟨SixSubtileLabel.F, (0 : ℤ), + (-1 : ℤ)⟩ ∨ + parentSlot = (1 : Fin (3 : ℕ)) ∧ + turn = (0 : Fin (4 : ℕ)) ∧ + uIndex = + ⟨SixSubtileLabel.C, (1 : ℤ), + (1 : ℤ)⟩ ∧ + uBar = + ⟨SixSubtileLabel.D, (-1 : ℤ), + (0 : ℤ)⟩ ∧ + wBlock = ((0 : ℤ), (1 : ℤ)) ∧ + vIndex = + ⟨SixSubtileLabel.E, (0 : ℤ), + (1 : ℤ)⟩ ∧ + vBar = + ⟨SixSubtileLabel.E, (-1 : ℤ), + (0 : ℤ)⟩ ∨ + parentSlot = (1 : Fin (3 : ℕ)) ∧ + turn = (1 : Fin (4 : ℕ)) ∧ + uIndex = + ⟨SixSubtileLabel.D, (-1 : ℤ), + (0 : ℤ)⟩ ∧ + uBar = + ⟨SixSubtileLabel.D, (-1 : ℤ), + (-1 : ℤ)⟩ ∧ + wBlock = ((0 : ℤ), (-1 : ℤ)) ∧ + vIndex = + ⟨SixSubtileLabel.B, (0 : ℤ), + (1 : ℤ)⟩ ∧ + vBar = + ⟨SixSubtileLabel.A, + (-1 : ℤ), (-1 : ℤ)⟩ ∨ + parentSlot = (1 : Fin (3 : ℕ)) ∧ + turn = (2 : Fin (4 : ℕ)) ∧ + uIndex = + ⟨SixSubtileLabel.D, (-1 : ℤ), + (-1 : ℤ)⟩ ∧ + uBar = + ⟨SixSubtileLabel.C, (1 : ℤ), + (0 : ℤ)⟩ ∧ + wBlock = ((0 : ℤ), (-1 : ℤ)) ∧ + vIndex = + ⟨SixSubtileLabel.F, + (0 : ℤ), (-1 : ℤ)⟩ ∧ + vBar = + ⟨SixSubtileLabel.F, + (1 : ℤ), (0 : ℤ)⟩ ∨ + parentSlot = (1 : Fin (3 : ℕ)) ∧ + turn = (3 : Fin (4 : ℕ)) ∧ + uIndex = + ⟨SixSubtileLabel.C, (1 : ℤ), + (0 : ℤ)⟩ ∧ + uBar = + ⟨SixSubtileLabel.C, (1 : ℤ), + (1 : ℤ)⟩ ∧ + wBlock = ((0 : ℤ), (1 : ℤ)) ∧ + vIndex = + ⟨SixSubtileLabel.A, + (0 : ℤ), (-1 : ℤ)⟩ ∧ + vBar = + ⟨SixSubtileLabel.B, + (1 : ℤ), (1 : ℤ)⟩ ∨ + parentSlot = (2 : Fin (3 : ℕ)) ∧ + turn = (0 : Fin (4 : ℕ)) ∧ + uIndex = + ⟨SixSubtileLabel.E, + (-1 : ℤ), (0 : ℤ)⟩ ∧ + uBar = + ⟨SixSubtileLabel.F, + (0 : ℤ), (-1 : ℤ)⟩ ∧ + wBlock = + ((-1 : ℤ), (-1 : ℤ)) ∧ + vIndex = + ⟨SixSubtileLabel.A, + (-1 : ℤ), + (-1 : ℤ)⟩ ∧ + vBar = + ⟨SixSubtileLabel.A, + (0 : ℤ), (-1 : ℤ)⟩ ∨ + parentSlot = (2 : Fin (3 : ℕ)) ∧ + turn = (1 : Fin (4 : ℕ)) ∧ + uIndex = + ⟨SixSubtileLabel.F, + (0 : ℤ), (-1 : ℤ)⟩ ∧ + uBar = + ⟨SixSubtileLabel.F, + (1 : ℤ), (0 : ℤ)⟩ ∧ + wBlock = + ((1 : ℤ), (1 : ℤ)) ∧ + vIndex = + ⟨SixSubtileLabel.D, + (-1 : ℤ), + (-1 : ℤ)⟩ ∧ + vBar = + ⟨SixSubtileLabel.C, + (1 : ℤ), + (0 : ℤ)⟩ ∨ + parentSlot = (2 : Fin (3 : ℕ)) ∧ + turn = (2 : Fin (4 : ℕ)) ∧ + uIndex = + ⟨SixSubtileLabel.F, + (1 : ℤ), (0 : ℤ)⟩ ∧ + uBar = + ⟨SixSubtileLabel.E, + (0 : ℤ), (1 : ℤ)⟩ ∧ + wBlock = + ((1 : ℤ), (1 : ℤ)) ∧ + vIndex = + ⟨SixSubtileLabel.B, + (1 : ℤ), + (1 : ℤ)⟩ ∧ + vBar = + ⟨SixSubtileLabel.B, + (0 : ℤ), + (1 : ℤ)⟩ ∨ + parentSlot = (2 : Fin (3 : ℕ)) ∧ + turn = (3 : Fin (4 : ℕ)) ∧ + uIndex = + ⟨SixSubtileLabel.E, + (0 : ℤ), (1 : ℤ)⟩ ∧ + uBar = + ⟨SixSubtileLabel.E, + (-1 : ℤ), (0 : ℤ)⟩ ∧ + wBlock = + ((-1 : ℤ), + (-1 : ℤ)) ∧ + vIndex = + ⟨SixSubtileLabel.C, + (1 : ℤ), + (1 : ℤ)⟩ ∧ + vBar = + ⟨SixSubtileLabel.D, + (-1 : ℤ), + (0 : ℤ)⟩) → + (((TileTranslation (TileQuarterTurn T) g).cells = + T.cells) → + (((TileTranslation (TileQuarterTurn W) g).cells = + (TileTranslation T + ((↑wBlock.1 : GaussianInt) * u + + (↑wBlock.2 : GaussianInt) * v)).cells) → + ((∀ (m : ℤ), + ∀ (n : ℤ), + ∀ (r : ℤ), + ∀ (s : ℤ), + (m, n) ≠ (r, s) → + Disjoint + (TileTranslation T + ((↑m : GaussianInt) * u + + (↑n : GaussianInt) * v)).cells + (TileTranslation T + ((↑r : GaussianInt) * u + + (↑s : GaussianInt) * + v)).cells) → + ((∀ (A : ProtoTile), + ∀ (B : ProtoTile), + (Disjoint + (TileTranslation (TileQuarterTurn A) + g).cells + (TileTranslation (TileQuarterTurn B) + g).cells) → + (Disjoint A.cells B.cells)) → + (Disjoint T.cells W.cells))))) := by classical - intro P O T U W u v g wShift parentSlot turn uIndex uBar vIndex vBar wBlock hrow hRootLattice - hBlockCells hBlockDisjoint hW hrootBar hWBar hTlattice hblocks occurrence_subset_block - root_occurrence_disjoint pull_disjoint hrootfixed + intro T W u v g parentSlot turn uIndex uBar vIndex vBar wBlock hrow hrootBar hWBar hblocks + pull_disjoint apply pull_disjoint rw [hrootBar, hWBar] have h := hblocks 0 0 wBlock.1 wBlock.2 (by exact (rowSeparation parentSlot turn uIndex uBar vIndex vBar wBlock hrow).1) - have hzero : (TileTranslation T 0).cells = T.cells := by - have ht : TileTranslation T 0 = T := by - cases T with - | mk cells anchor => - apply congrArg₂ ProtoTile.mk - · ext z - simp [GaussianTranslation] - · simp [GaussianTranslation] - exact congrArg ProtoTile.cells ht + have hzero := congrArg ProtoTile.cells (TileTranslationProperties.zero T) simpa [hzero] using h end GeneralSeparationProof @@ -396,8 +547,7 @@ theorem BandOrderedGeneralSubtileCanonicalSeparation have root_occurrence_disjoint (o : PeriodicSubtileIndex) (hnonzero : (o.first, o.second) ≠ (0, 0)) : Disjoint T.cells (SubtileOccurrenceInterpretation P u v o).cells := - GeneralSeparationProof.root_occurrence_disjoint P O T W u v g wShift wBlock - hRootLattice hBlockCells hBlockDisjoint hW hrootBar hWBar hTlattice hblocks + GeneralSeparationProof.root_occurrence_disjoint P T u v hblocks occurrence_subset_block o hnonzero have turn_map_injective : Function.Injective (fun z : LatticeCell => GaussianTranslation g (GaussianQuarterTurn z - 1)) := @@ -418,10 +568,9 @@ theorem BandOrderedGeneralSubtileCanonicalSeparation rw [hfixedSource] simpa using root_occurrence_disjoint uIndex (by exact (rowSeparation parentSlot turn uIndex uBar vIndex vBar wBlock hrow).2.1) - have hrootW : Disjoint T.cells W.cells := GeneralSeparationProof.hrootW P O T U W u v g wShift - parentSlot turn uIndex uBar vIndex vBar wBlock hrow hRootLattice hBlockCells hBlockDisjoint - hW hrootBar hWBar hTlattice hblocks occurrence_subset_block root_occurrence_disjoint - pull_disjoint hrootfixed + have hrootW : Disjoint T.cells W.cells := GeneralSeparationProof.hrootW T W u v g + parentSlot turn uIndex uBar vIndex vBar wBlock hrow hrootBar hWBar hblocks + pull_disjoint have hfixedW : Disjoint U.cells W.cells := by apply pull_disjoint rw [hfixedBar, hWBar] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean index e1d649f039..37b1a0d5c4 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean @@ -531,19 +531,6 @@ private theorem hpieceIndexCentral : intro labelOf pieceIndex j e fin_cases j <;> cases e <;> simp [pieceIndex, labelOf] -private theorem translation_zero : - (by - classical - exact - ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by - classical - intro U - cases U with - | mk cells anchor => - have hc : cells.image (GaussianTranslation 0) = cells := by - ext z - simp [GaussianTranslation] - simp [TileTranslation, hc, GaussianTranslation] private theorem centralOccurrence : (by @@ -1395,7 +1382,7 @@ theorem BandOrderedGeneralSubtileNormalizationCertificateExists pieceIndex j e = ⟨.E, 0, 0⟩ ∨ pieceIndex j e = ⟨.F, 0, 0⟩ := SubtileNormalizationGeometry.hpieceIndexCentral j e have translation_zero (U : ProtoTile) : TileTranslation U 0 = U := - SubtileNormalizationGeometry.translation_zero U + TileTranslationProperties.zero U have centralOccurrence (j : Fin 3) (e : Bool) : SubtileOccurrenceInterpretation layout.P layout.u layout.v (pieceIndex j e) = layout.P j e := SubtileNormalizationGeometry.centralOccurrence q T₀ r diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizedBundleExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizedBundleExists.lean index e05e7f1b78..f9f7d390de 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizedBundleExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizedBundleExists.lean @@ -9,7 +9,8 @@ public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralNormalizedOccurrenceBundle public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileInterfaceCertificateExists -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileNormalizationCertificateExists +public import + LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileNormalizationCertificateExists public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileRoutingCertificateExists -- [TABLET NODE: BandOrderedGeneralSubtileNormalizedBundleExists] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean index 7908c1467b..677cf10bd9 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean @@ -7,11 +7,9 @@ module public import Mathlib.Init -public import LeanPool.ApollonianSuperharmonic.BandPrototile public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriplePackingSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentRightEndpoint -public import LeanPool.ApollonianSuperharmonic.TileTranslation -- [TABLET NODE: BandOrientedChildParentRightEndpoint] @@ -101,50 +99,29 @@ private theorem hUford : private theorem hWford : (by classical - exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W - : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r i.succ) W) → ((BandPrototile (r - (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → - (((0 : ℤ) < (r i.succ).1) → ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • - GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r - i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → - ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : - ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - BandVectors.1 (r (i - (1 : Fin (3 : - ℕ))).succ) (r (0 : Fin (4 : ℕ))) else BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) - (r (0 : Fin (4 : ℕ))) - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : - ℕ))).succ))) → ((0 ≤ (r ((if Even s.val then i - 1 else i + 1).succ)).1) → (((0 : ℤ) - = (r (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : - ℕ))).succ).1) → (∀ (a : Fin (3 : ℕ)), ∀ (g0 : BandPackingSymmetry), ∀ (P : - FordFareyParameter), (BandPackingSymmetryReversesOrientation g0 = false) → (((r (a + - (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g0 ![r - (0 : Fin (4 : ℕ)), r a.succ, r (a + (1 : Fin (3 : ℕ))).succ, r (a + (2 : Fin (3 : - ℕ))).succ] = FordRecursiveQuadruple P) → ( - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - (ProperBandQuadruple q) → (∀ (negative : Bool), (BandPackingSymmetryScopedPhase g0 q - negative) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : - Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 - : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g0 r negative) - → ((∀ (t : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : - ℕ)) = q (2 : Fin (4 : ℕ)) → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → - BandPackingSymmetryScopedPhase g0 t negative) → (∀ (g : BandPackingSymmetry), - (BandPackingSymmetryReversesOrientation g = BandPackingSymmetryReversesOrientation - g0) → ((BandPackingSymmetryScopedPhase g q false) → ((∀ (r : Fin (4 : ℕ) → - CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) - → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : - ℕ)) → BandPackingSymmetryScopedPhase g r false) → ((∀ (t : Fin (4 : ℕ) → - CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) - → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g t - false) → ((BandPrototile (BandPackingSymmetryCircleAction g (r i.succ)) - (BandPackingSymmetryTileAction g W)) → ( - let k : Fin 3 := i - a - (BandPackingSymmetryQuadrupleAction g q = FordRecursiveQuadruple P) → (BandPrototile - ((FordRecursiveQuadruple P) k.succ) (BandPackingSymmetryTileAction g - W))))))))))))))))))))) ) := by + exact + ∀ (r : Fin 4 → CircleCoordinates), + ∀ (i : Fin 3), + ∀ (W : ProtoTile), + (∀ (a : Fin (3 : ℕ)), + ∀ (g0 : BandPackingSymmetry), + ∀ (P : FordFareyParameter), + (BandPackingSymmetryReversesOrientation g0 = false) → + (let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ]; + (∀ (g : BandPackingSymmetry), + (BandPackingSymmetryReversesOrientation g = + BandPackingSymmetryReversesOrientation g0) → + ((BandPrototile + (BandPackingSymmetryCircleAction g (r i.succ)) + (BandPackingSymmetryTileAction g W)) → + (let k : Fin 3 := i - a; + (BandPackingSymmetryQuadrupleAction g q = + FordRecursiveQuadruple P) → + (BandPrototile ((FordRecursiveQuadruple P) k.succ) + (BandPackingSymmetryTileAction g W)))))))) := by classical - intro r i s U W Z hW hZ hWpos hWcent hZcent nonnegative zero a g0 P horient hzero hford q hq - negative hphase hphase1 hphase2 g horientg hfalse hfalse1 hfalse2 hW' k hzeroAction + intro r i W a g0 P horient q g horientg hW' k hzeroAction have he := congrFun hzeroAction k.succ have source : BandPackingSymmetryQuadrupleAction g q k.succ = @@ -157,52 +134,28 @@ private theorem hWford : private theorem phaseForward : (by classical - exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W - : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r i.succ) W) → ((BandPrototile (r - (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → - (((0 : ℤ) < (r i.succ).1) → ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • - GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r - i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → - ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : - ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - BandVectors.1 (r (i - (1 : Fin (3 : - ℕ))).succ) (r (0 : Fin (4 : ℕ))) else BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) - (r (0 : Fin (4 : ℕ))) - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : - ℕ))).succ))) → ((0 ≤ (r ((if Even s.val then i - 1 else i + 1).succ)).1) → (((0 : ℤ) - = (r (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : - ℕ))).succ).1) → (∀ (a : Fin (3 : ℕ)), ∀ (g0 : BandPackingSymmetry), ∀ (P : - FordFareyParameter), (BandPackingSymmetryReversesOrientation g0 = false) → (((r (a + - (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g0 ![r - (0 : Fin (4 : ℕ)), r a.succ, r (a + (1 : Fin (3 : ℕ))).succ, r (a + (2 : Fin (3 : - ℕ))).succ] = FordRecursiveQuadruple P) → ( - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - (ProperBandQuadruple q) → (∀ (negative : Bool), (BandPackingSymmetryScopedPhase g0 q - negative) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : - Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 - : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g0 r negative) - → ((∀ (t : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : - ℕ)) = q (2 : Fin (4 : ℕ)) → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → - BandPackingSymmetryScopedPhase g0 t negative) → (∀ (g : BandPackingSymmetry), - (BandPackingSymmetryReversesOrientation g = BandPackingSymmetryReversesOrientation - g0) → ((BandPackingSymmetryScopedPhase g q false) → ((∀ (r : Fin (4 : ℕ) → - CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) - → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : - ℕ)) → BandPackingSymmetryScopedPhase g r false) → ((∀ (t : Fin (4 : ℕ) → - CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) - → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g t - false) → ((BandPrototile (BandPackingSymmetryCircleAction g (r i.succ)) - (BandPackingSymmetryTileAction g W)) → ( - let k : Fin 3 := i - a - (BandPackingSymmetryQuadrupleAction g q = FordRecursiveQuadruple P) → ((BandPrototile - ((FordRecursiveQuadruple P) k.succ) (BandPackingSymmetryTileAction g W)) → - (BandVectors.1 ((FordRecursiveQuadruple P) k.succ) ((FordRecursiveQuadruple P) 0) = - BandPackingSymmetryVectorAction g (BandVectors.1 (r i.succ) (r - 0))))))))))))))))))))))) ) := by + exact + ∀ (r : Fin 4 → CircleCoordinates), + ∀ (i : Fin 3), + (∀ (a : Fin (3 : ℕ)), + ∀ (g0 : BandPackingSymmetry), + ∀ (P : FordFareyParameter), + (BandPackingSymmetryReversesOrientation g0 = false) → + (let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ]; + (∀ (g : BandPackingSymmetry), + (BandPackingSymmetryReversesOrientation g = + BandPackingSymmetryReversesOrientation g0) → + ((BandPackingSymmetryScopedPhase g q false) → + (let k : Fin 3 := i - a; + (BandPackingSymmetryQuadrupleAction g q = + FordRecursiveQuadruple P) → + (BandVectors.1 ((FordRecursiveQuadruple P) k.succ) + ((FordRecursiveQuadruple P) 0) = + BandPackingSymmetryVectorAction g + (BandVectors.1 (r i.succ) (r 0))))))))) := by classical - intro r i s U W Z hW hZ hWpos hWcent hZcent nonnegative zero a g0 P horient hzero hford q hq - negative hphase hphase1 hphase2 g horientg hfalse hfalse1 hfalse2 hW' k hzeroAction hWford + intro r i a g0 P horient q g horientg hfalse k hzeroAction have phase := (show BandPackingSymmetryScopedPhase g q false from hfalse) simp only [BandPackingSymmetryScopedPhase] at phase rw [hzeroAction] at phase @@ -213,55 +166,28 @@ private theorem phaseForward : private theorem phaseBackward : (by classical - exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W - : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r i.succ) W) → ((BandPrototile (r - (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → - (((0 : ℤ) < (r i.succ).1) → ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • - GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r - i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → - ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : - ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - BandVectors.1 (r (i - (1 : Fin (3 : - ℕ))).succ) (r (0 : Fin (4 : ℕ))) else BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) - (r (0 : Fin (4 : ℕ))) - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : - ℕ))).succ))) → ((0 ≤ (r ((if Even s.val then i - 1 else i + 1).succ)).1) → (((0 : ℤ) - = (r (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : - ℕ))).succ).1) → (∀ (a : Fin (3 : ℕ)), ∀ (g0 : BandPackingSymmetry), ∀ (P : - FordFareyParameter), (BandPackingSymmetryReversesOrientation g0 = false) → (((r (a + - (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g0 ![r - (0 : Fin (4 : ℕ)), r a.succ, r (a + (1 : Fin (3 : ℕ))).succ, r (a + (2 : Fin (3 : - ℕ))).succ] = FordRecursiveQuadruple P) → ( - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - (ProperBandQuadruple q) → (∀ (negative : Bool), (BandPackingSymmetryScopedPhase g0 q - negative) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : - Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 - : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g0 r negative) - → ((∀ (t : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : - ℕ)) = q (2 : Fin (4 : ℕ)) → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → - BandPackingSymmetryScopedPhase g0 t negative) → (∀ (g : BandPackingSymmetry), - (BandPackingSymmetryReversesOrientation g = BandPackingSymmetryReversesOrientation - g0) → ((BandPackingSymmetryScopedPhase g q false) → ((∀ (r : Fin (4 : ℕ) → - CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) - → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : - ℕ)) → BandPackingSymmetryScopedPhase g r false) → ((∀ (t : Fin (4 : ℕ) → - CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) - → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g t - false) → ((BandPrototile (BandPackingSymmetryCircleAction g (r i.succ)) - (BandPackingSymmetryTileAction g W)) → ( - let k : Fin 3 := i - a - (BandPackingSymmetryQuadrupleAction g q = FordRecursiveQuadruple P) → ((BandPrototile - ((FordRecursiveQuadruple P) k.succ) (BandPackingSymmetryTileAction g W)) → - ((BandVectors.1 ((FordRecursiveQuadruple P) k.succ) ((FordRecursiveQuadruple P) 0) = - BandPackingSymmetryVectorAction g (BandVectors.1 (r i.succ) (r 0))) → (BandVectors.1 - ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) k.succ) = - BandPackingSymmetryVectorAction g (BandVectors.1 (r 0) (r - i.succ)))))))))))))))))))))))) ) := by + exact + ∀ (r : Fin 4 → CircleCoordinates), + ∀ (i : Fin 3), + (∀ (a : Fin (3 : ℕ)), + ∀ (g0 : BandPackingSymmetry), + ∀ (P : FordFareyParameter), + (BandPackingSymmetryReversesOrientation g0 = false) → + (let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ]; + (∀ (g : BandPackingSymmetry), + (BandPackingSymmetryReversesOrientation g = + BandPackingSymmetryReversesOrientation g0) → + ((BandPackingSymmetryScopedPhase g q false) → + (let k : Fin 3 := i - a; + (BandPackingSymmetryQuadrupleAction g q = + FordRecursiveQuadruple P) → + (BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) k.succ) = + BandPackingSymmetryVectorAction g + (BandVectors.1 (r 0) (r i.succ))))))))) := by classical - intro r i s U W Z hW hZ hWpos hWcent hZcent nonnegative zero a g0 P horient hzero hford q hq - negative hphase hphase1 hphase2 g horientg hfalse hfalse1 hfalse2 hW' k hzeroAction hWford - phaseForward + intro r i a g0 P horient q g horientg hfalse k hzeroAction have phase := (show BandPackingSymmetryScopedPhase g q false from hfalse) simp only [BandPackingSymmetryScopedPhase] at phase rw [hzeroAction] at phase @@ -501,85 +427,100 @@ private theorem hUposFord : private theorem hWposFord : (by classical - exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W - : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r i.succ) W) → ((BandPrototile (r - (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → - (((0 : ℤ) < (r i.succ).1) → ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • - GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r - i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → - ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : - ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - BandVectors.1 (r (i - (1 : Fin (3 : - ℕ))).succ) (r (0 : Fin (4 : ℕ))) else BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) - (r (0 : Fin (4 : ℕ))) - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : - ℕ))).succ))) → ((0 ≤ (r ((if Even s.val then i - 1 else i + 1).succ)).1) → (((0 : ℤ) - = (r (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : - ℕ))).succ).1) → (∀ (a : Fin (3 : ℕ)), ∀ (g0 : BandPackingSymmetry), ∀ (P : - FordFareyParameter), (BandPackingSymmetryReversesOrientation g0 = false) → (((r (a + - (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g0 ![r - (0 : Fin (4 : ℕ)), r a.succ, r (a + (1 : Fin (3 : ℕ))).succ, r (a + (2 : Fin (3 : - ℕ))).succ] = FordRecursiveQuadruple P) → ( - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - (ProperBandQuadruple q) → (∀ (negative : Bool), (BandPackingSymmetryScopedPhase g0 q - negative) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : - Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 - : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g0 r negative) - → ((∀ (t : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : - ℕ)) = q (2 : Fin (4 : ℕ)) → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → - BandPackingSymmetryScopedPhase g0 t negative) → (∀ (g : BandPackingSymmetry), - (BandPackingSymmetryReversesOrientation g = BandPackingSymmetryReversesOrientation - g0) → ((BandPackingSymmetryScopedPhase g q false) → ((∀ (r : Fin (4 : ℕ) → - CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) - → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : Fin (4 : - ℕ)) → BandPackingSymmetryScopedPhase g r false) → ((∀ (t : Fin (4 : ℕ) → - CircleCoordinates), ProperBandQuadruple t → t (0 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) - → t (1 : Fin (4 : ℕ)) = q (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g t - false) → (((∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction g C).1 = C.1) - ∧ (∀ (C : CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T ↔ BandPrototile - (BandPackingSymmetryCircleAction g C) (BandPackingSymmetryTileAction g T)) ∧ ∀ (q : - Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → - ProtoTile), ProperBandQuadruple q → BandPrototile (q (0 : Fin (4 : ℕ))) T → (∀ (i : - Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : - LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → - let sigma := fun (i : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true - then -i else i; ∃ (negative : Bool) (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool) (S' - : Fin (3 : ℕ) → Bool → ProtoTile), BandPackingSymmetryScopedPhase g q negative ∧ (∀ - (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) - = (sigma i, s ^^ negative)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : - ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × - Bool) (i, s)).2 = BandPackingSymmetryTileAction g (S i s)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ - (s : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction g q) - (BandPackingSymmetryTileAction g T) i s (S' i s)) ∧ ∀ (x : LatticeCell), x ∈ - (BandPackingSymmetryTileAction g T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S' i - s).cells) → ((BandPrototile (BandPackingSymmetryCircleAction g (r i.succ)) - (BandPackingSymmetryTileAction g W)) → ( - let k : Fin 3 := i - a - (BandPackingSymmetryQuadrupleAction g q = FordRecursiveQuadruple P) → ((BandPrototile - ((FordRecursiveQuadruple P) k.succ) (BandPackingSymmetryTileAction g W)) → - ((BandVectors.1 ((FordRecursiveQuadruple P) k.succ) ((FordRecursiveQuadruple P) 0) = - BandPackingSymmetryVectorAction g (BandVectors.1 (r i.succ) (r 0))) → ((BandVectors.1 - ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) k.succ) = - BandPackingSymmetryVectorAction g (BandVectors.1 (r 0) (r i.succ))) → ((TileCentroid - (BandPackingSymmetryTileAction g W) - TileCentroid (BandPackingSymmetryTileAction g - U) = (1 / 2 : Real) • GaussianRealPoint (BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : - GaussianInt) ^ s.val * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r - i.succ))))) → ((BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val * - (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))) = (⟨0, 1⟩ : - GaussianInt) ^ s.val * (BandVectors.1 ((FordRecursiveQuadruple P) k.succ) - ((FordRecursiveQuadruple P) 0) + BandVectors.1 ((FordRecursiveQuadruple P) 0) - ((FordRecursiveQuadruple P) k.succ))) → ((TileCentroid (BandPackingSymmetryTileAction - g W) - TileCentroid (BandPackingSymmetryTileAction g U) = (1 / 2 : Real) • - GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * (BandVectors.1 - ((FordRecursiveQuadruple P) k.succ) ((FordRecursiveQuadruple P) 0) + BandVectors.1 - ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) k.succ)))) → (0 < - ((FordRecursiveQuadruple P) k.succ).1))))))))))))))))))))))))))) ) := by + exact + ∀ (r : Fin 4 → CircleCoordinates), + ∀ (i : Fin 3), + (((0 : ℤ) < (r i.succ).1) → + (∀ (a : Fin (3 : ℕ)), + ∀ (g0 : BandPackingSymmetry), + ∀ (P : FordFareyParameter), + (BandPackingSymmetryReversesOrientation g0 = false) → + (let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ]; + (∀ (g : BandPackingSymmetry), + (BandPackingSymmetryReversesOrientation g = + BandPackingSymmetryReversesOrientation g0) → + (((∀ (C : CircleCoordinates), + (BandPackingSymmetryCircleAction g C).1 = C.1) ∧ + (∀ (C : CircleCoordinates), + ∀ (T : ProtoTile), + BandPrototile C T ↔ + BandPrototile + (BandPackingSymmetryCircleAction g C) + (BandPackingSymmetryTileAction g T)) ∧ + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (T : ProtoTile), + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + ProperBandQuadruple q → + BandPrototile (q (0 : Fin (4 : ℕ))) T → + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + BandSubtileOccurrence q T i s + (S i s)) → + (∀ (x : LatticeCell), + x ∈ T.cells ↔ + ∃ (i : Fin (3 : ℕ)) (s : Bool), + x ∈ (S i s).cells) → + let sigma := fun (i : Fin (3 : ℕ)) => + if + BandPackingSymmetryReversesOrientation + g = + true then + -i + else i; + ∃ (negative : Bool) (e : + Fin (3 : ℕ) × Bool ≃ + Fin (3 : ℕ) × Bool) + (S' : + Fin (3 : ℕ) → Bool → ProtoTile), + BandPackingSymmetryScopedPhase g q + negative ∧ + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + (e : + Fin (3 : ℕ) × Bool → + Fin (3 : ℕ) × Bool) + (i, s) = + (sigma i, + s ^^ negative)) ∧ + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + S' + ((e : + Fin (3 : ℕ) × + Bool → + Fin (3 : ℕ) × + Bool) + (i, s)).1 + ((e : + Fin (3 : ℕ) × + Bool → + Fin (3 : ℕ) × + Bool) + (i, s)).2 = + BandPackingSymmetryTileAction + g (S i s)) ∧ + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + BandSubtileOccurrence + (BandPackingSymmetryQuadrupleAction + g q) + (BandPackingSymmetryTileAction + g T) + i s (S' i s)) ∧ + ∀ (x : LatticeCell), + x ∈ + (BandPackingSymmetryTileAction + g T).cells ↔ + ∃ (i : Fin (3 : ℕ)) (s : + Bool), + x ∈ (S' i s).cells) → + (let k : Fin 3 := i - a; + (BandPackingSymmetryQuadrupleAction g q = + FordRecursiveQuadruple P) → + (0 < ((FordRecursiveQuadruple P) k.succ).1)))))))) := by classical - intro r i s U W Z hW hZ hWpos hWcent hZcent nonnegative zero a g0 P horient hzero hford q hq - negative hphase hphase1 hphase2 g horientg hfalse hfalse1 hfalse2 tileCovariance hW' k - hzeroAction hWford phaseForward phaseBackward centroidAction vectorIdentity - transformedCentroid + intro r i hWpos a g0 P horient q g horientg tileCovariance k hzeroAction have he := congrArg (fun x => (x k.succ).1) hzeroAction have source : BandPackingSymmetryQuadrupleAction g q k.succ = @@ -710,25 +651,20 @@ theorem BandOrientedChildParentRightEndpoint hzeroAction have hWford : BandPrototile ((FordRecursiveQuadruple P) k.succ) - (BandPackingSymmetryTileAction g W) := OrientedRightEndpointGeometry.hWford r i s U W Z - hW hZ hWpos hWcent hZcent nonnegative zero a g0 P horient hzero hford hq negative - hphase hphase1 hphase2 g horientg hfalse hfalse1 hfalse2 hW' hzeroAction + (BandPackingSymmetryTileAction g W) := OrientedRightEndpointGeometry.hWford r i W a g0 P + horient g horientg hW' hzeroAction have phaseForward : BandVectors.1 ((FordRecursiveQuadruple P) k.succ) ((FordRecursiveQuadruple P) 0) = BandPackingSymmetryVectorAction g - (BandVectors.1 (r i.succ) (r 0)) := OrientedRightEndpointGeometry.phaseForward r i s - U W Z hW hZ hWpos hWcent hZcent nonnegative zero a g0 P horient hzero hford hq - negative hphase hphase1 hphase2 g horientg hfalse hfalse1 hfalse2 hW' hzeroAction - hWford + (BandVectors.1 (r i.succ) (r 0)) := OrientedRightEndpointGeometry.phaseForward r i a + g0 P horient g horientg hfalse hzeroAction have phaseBackward : BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) k.succ) = BandPackingSymmetryVectorAction g - (BandVectors.1 (r 0) (r i.succ)) := OrientedRightEndpointGeometry.phaseBackward r i s - U W Z hW hZ hWpos hWcent hZcent nonnegative zero a g0 P horient hzero hford hq - negative hphase hphase1 hphase2 g horientg hfalse hfalse1 hfalse2 hW' hzeroAction - hWford phaseForward + (BandVectors.1 (r 0) (r i.succ)) := OrientedRightEndpointGeometry.phaseBackward r i + a g0 P horient g horientg hfalse hzeroAction have centroidAction : TileCentroid (BandPackingSymmetryTileAction g W) - TileCentroid (BandPackingSymmetryTileAction g U) = @@ -777,10 +713,8 @@ theorem BandOrientedChildParentRightEndpoint OrientedRightEndpointGeometry.hUposFord r hUpos a g0 P horient g horientg tileCovariance hzeroAction have hWposFord : 0 < ((FordRecursiveQuadruple P) k.succ).1 := - OrientedRightEndpointGeometry.hWposFord r i s U W Z hW hZ hWpos hWcent hZcent nonnegative - zero a g0 P horient hzero hford hq negative hphase hphase1 hphase2 g horientg hfalse - hfalse1 hfalse2 tileCovariance hW' hzeroAction hWford phaseForward phaseBackward - centroidAction vectorIdentity transformedCentroid + OrientedRightEndpointGeometry.hWposFord r i hWpos a g0 P horient g horientg + tileCovariance hzeroAction have fordResult := FordOrientedChildParentRightEndpoint P hP k s (BandPackingSymmetryTileAction g U) (BandPackingSymmetryTileAction g W) hUford hWford hUposFord hWposFord diff --git a/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean b/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean index 1343aa9d9b..96c9bc882e 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeTileNonempty public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation @@ -79,21 +80,6 @@ private theorem hmodified : intro q cfg C₀ T cert P O u v a exact cert.modified_tile a -private theorem hnonempty : - (by - classical - exact - ∀ (X : ProtoTile), (LatticeTile X) → (X.cells.Nonempty) ) := by - classical - intro X hX - unfold LatticeTile TopologicalDisk TileRealization at hX - rcases hX with ⟨e⟩ - have hp : (0 : Real × Real) ∈ - (Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) := by simp - have hm := (e ⟨(0 : Real × Real), hp⟩).property - simp only [Set.mem_iUnion] at hm - obtain ⟨x, hx⟩ := hm - exact ⟨x, by simpa [TileRealization] using hx.1⟩ private theorem hmodA : (by @@ -1129,7 +1115,7 @@ theorem BandOriginalOccurrenceIntersectionClassification have htranscells (X : ProtoTile) (w : GaussianInt) : (TileTranslation X w).cells = X.cells.image (GaussianTranslation w) := (TileTranslationFormulas X w).1 - have hnonempty (X : ProtoTile) (hX : LatticeTile X) := OriginalIntersectionGeometry.hnonempty X hX + have hnonempty (X : ProtoTile) (hX : LatticeTile X) := LatticeTileNonempty.cells X hX have htranslate_complement (A B : ProtoTile) (w : GaussianInt) : TileTranslation (TileCellComplement A B) w = TileCellComplement (TileTranslation A w) (TileTranslation B w) := diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean index e88515c718..942ee001da 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean @@ -9,7 +9,6 @@ public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase -- [TABLET NODE: BandPackingSymmetryAffineVectorCovariance] @@ -719,89 +718,109 @@ private theorem hjkAt531 : private theorem hprodAt542 : (by classical - exact - ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), - (BandPackingSymmetryScopedPhase g q negative) → (∀ (i : Fin (3 : ℕ)), - let epsilon : GaussianInt := if negative then -1 else 1 - (epsilon * epsilon = 1) → ((∀ (V : GaussianInt), ∀ (A : GaussianInt), ∀ (b : - GaussianInt), V ≠ 0 → 2 * V * A = 2 * (epsilon * V) * b → b = epsilon * A) → - ((BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) ^ (2 : ℕ) = - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).1 • - (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g - = true then -i else i).succ).2 - (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ).1 • - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2 ∧ (2 : GaussianInt) * - BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) * BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g - = true then -i else i).succ) (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : - ℕ))) = (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ).2 + - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2) → - (((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : - ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = - BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) ∧ - Zsqrtd.norm (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 - : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = (q i.succ).1 + - (q (0 : Fin (4 : ℕ))).1 ∧ (2 : GaussianInt) * (BandPackingSymmetryAffineVectorAction - g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : - Fin (4 : ℕ))))).1 * (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q - i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2 = - (BandPackingSymmetryCircleAction g (q i.succ)).2 + (BandPackingSymmetryCircleAction g - (q (0 : Fin (4 : ℕ)))).2) → ((BandVectors.2 (BandPackingSymmetryQuadrupleAction g q - (if BandPackingSymmetryReversesOrientation g = true then -i else i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = epsilon * - (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : - ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2) → - ((¬BandPackingSymmetryReversesOrientation g = true) → (((BandVectors.1 - (BandPackingSymmetryQuadrupleAction g q i.succ) (BandPackingSymmetryQuadrupleAction g - q (0 : Fin (4 : ℕ))) = if negative = true then -BandPackingSymmetryVectorAction g - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) else BandPackingSymmetryVectorAction - g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) ∧ (BandVectors.1 - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g q i.succ) = if negative = true then - -BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) - else BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q - i.succ))) ∧ BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 : - ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ) = if - negative = true then -BandPackingSymmetryVectorAction g (BandVectors.1 (q (i + (2 : - Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) else - BandPackingSymmetryVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q - (i + (1 : Fin (3 : ℕ))).succ))) → ( - let j : Fin 4 := (i + 2).succ - let k : Fin 4 := (i + 1).succ - let V := (BandPackingSymmetryAffineVectorAction g - (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).1 - let A := (BandPackingSymmetryAffineVectorAction g - (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).2 - (j ≠ k) → (((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) (q k), - BandVectors.2 (q j) (q k))).1 = BandPackingSymmetryVectorAction g (BandVectors.1 (q - j) (q k)) ∧ Zsqrtd.norm (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) - (q k), BandVectors.2 (q j) (q k))).1 = (q j).1 + (q k).1 ∧ (2 : GaussianInt) * - (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) (q k), BandVectors.2 (q - j) (q k))).1 * (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) (q k), - BandVectors.2 (q j) (q k))).2 = (BandPackingSymmetryCircleAction g (q j)).2 + - (BandPackingSymmetryCircleAction g (q k)).2) → ((BandVectors.1 - (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 : ℕ))).succ) - (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ) ^ (2 : ℕ) = - (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ).1 • - (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 : ℕ))).succ).2 - - (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 : ℕ))).succ).1 • - (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ).2 ∧ (2 : - GaussianInt) * BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 - : ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ) * - BandVectors.2 (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 : ℕ))).succ) - (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ) = - (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 : ℕ))).succ).2 + - (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ).2) → (2 * V * A - = 2 * (epsilon * V) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction g q (i + - 2).succ) (BandPackingSymmetryQuadrupleAction g q (i + 1).succ))))))))))))) ) := by + exact + ∀ (g : BandPackingSymmetry), + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (negative : Bool), + (∀ (i : Fin (3 : ℕ)), + let epsilon : GaussianInt := if negative then -1 else 1; + ((¬BandPackingSymmetryReversesOrientation g = true) → + (((BandVectors.1 (BandPackingSymmetryQuadrupleAction g q i.succ) + (BandPackingSymmetryQuadrupleAction g q + (0 : Fin (4 : ℕ))) = + if negative = true then + -BandPackingSymmetryVectorAction g + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + else + BandPackingSymmetryVectorAction g + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) ∧ + (BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q + (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q i.succ) = + if negative = true then + -BandPackingSymmetryVectorAction g + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) + else + BandPackingSymmetryVectorAction g + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) ∧ + BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q + (i + (2 : Fin (3 : ℕ))).succ) + (BandPackingSymmetryQuadrupleAction g q + (i + (1 : Fin (3 : ℕ))).succ) = + if negative = true then + -BandPackingSymmetryVectorAction g + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)) + else + BandPackingSymmetryVectorAction g + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ))) → + (let j : Fin 4 := (i + 2).succ; + let k : Fin 4 := (i + 1).succ; + let V := + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).1; + let A := + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).2; + (((BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), + BandVectors.2 (q j) (q k))).1 = + BandPackingSymmetryVectorAction g + (BandVectors.1 (q j) (q k)) ∧ + Zsqrtd.norm + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), + BandVectors.2 (q j) (q k))).1 = + (q j).1 + (q k).1 ∧ + (2 : GaussianInt) * + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), + BandVectors.2 (q j) (q k))).1 * + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), + BandVectors.2 (q j) (q k))).2 = + (BandPackingSymmetryCircleAction g (q j)).2 + + (BandPackingSymmetryCircleAction g (q k)).2) → + ((BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q + (i + (2 : Fin (3 : ℕ))).succ) + (BandPackingSymmetryQuadrupleAction g q + (i + (1 : Fin (3 : ℕ))).succ) ^ + (2 : ℕ) = + (BandPackingSymmetryQuadrupleAction g q + (i + (1 : Fin (3 : ℕ))).succ).1 • + (BandPackingSymmetryQuadrupleAction g q + (i + (2 : Fin (3 : ℕ))).succ).2 - + (BandPackingSymmetryQuadrupleAction g q + (i + (2 : Fin (3 : ℕ))).succ).1 • + (BandPackingSymmetryQuadrupleAction g q + (i + (1 : Fin (3 : ℕ))).succ).2 ∧ + (2 : GaussianInt) * + BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q + (i + (2 : Fin (3 : ℕ))).succ) + (BandPackingSymmetryQuadrupleAction g q + (i + (1 : Fin (3 : ℕ))).succ) * + BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q + (i + (2 : Fin (3 : ℕ))).succ) + (BandPackingSymmetryQuadrupleAction g q + (i + (1 : Fin (3 : ℕ))).succ) = + (BandPackingSymmetryQuadrupleAction g q + (i + (2 : Fin (3 : ℕ))).succ).2 + + (BandPackingSymmetryQuadrupleAction g q + (i + (1 : Fin (3 : ℕ))).succ).2) → + (2 * V * A = + 2 * (epsilon * V) * + (BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q (i + 2).succ) + (BandPackingSymmetryQuadrupleAction g q + (i + 1).succ)))))))))) := by classical - intro g q negative hphase i epsilon epsilonSquare slopeCancel incomingProduct incomingAffine - incomingSlope hrev hspatial j k V A hjk aff prod + intro g q negative i epsilon hrev hspatial j k V A aff prod calc 2 * V * A = (BandPackingSymmetryCircleAction g (q j)).2 + (BandPackingSymmetryCircleAction g (q k)).2 := aff.2.2 @@ -982,9 +1001,8 @@ theorem BandPackingSymmetryAffineVectorCovariance 2 * (epsilon * V) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction g q (i + 2).succ) (BandPackingSymmetryQuadrupleAction g q - (i + 1).succ)) := AffineSymmetryCoordinates.hprodAt542 g q negative hphase i - epsilonSquare slopeCancel incomingProduct incomingAffine incomingSlope hrev - hspatial hjk aff prod + (i + 1).succ)) := AffineSymmetryCoordinates.hprodAt542 g q negative i hrev + hspatial aff prod have final := slopeCancel V A (BandVectors.2 (BandPackingSymmetryQuadrupleAction g q (i + 2).succ) (BandPackingSymmetryQuadrupleAction g q diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCurvature.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCurvature.lean new file mode 100644 index 0000000000..44f108e1c6 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCurvature.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction +public import Mathlib.Init + + +/-! +# BandPackingSymmetryCurvature + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace BandPackingSymmetryCurvature + +/-- Shared preserved identity for BandPackingSymmetryCurvature. -/ +theorem preserved : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (c : CircleCoordinates), (BandPackingSymmetryCircleAction + g c).1 = c.1 ) := by + classical + intro g + induction g with + | identity => intro c; rfl + | negate => intro c; rfl + | conjugate => intro c; rfl + | shift w => intro c; rfl + | comp a b iha ihb => intro c; simp [BandPackingSymmetryCircleAction, iha, ihb] + +end BandPackingSymmetryCurvature +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean index 1ed375deb9..eaae24c760 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean @@ -9,13 +9,10 @@ public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell public import LeanPool.ApollonianSuperharmonic.TileSubodometer -public import LeanPool.ApollonianSuperharmonic.TileTranslation -- [TABLET NODE: BandPackingSymmetryMarkedDataCovariance] @@ -1020,58 +1017,57 @@ private theorem hactM2 : private theorem hMphase2 : (by classical - exact + exact let affineQuarter : GaussianInt × GaussianInt → GaussianInt × GaussianInt := - fun z => (GaussianQuarterTurn z.1, -GaussianQuarterTurn z.2) - (∀ (k : BandPackingSymmetry), ∀ (z : GaussianInt × GaussianInt), - (BandPackingSymmetryAffineVectorAction k z).1 = BandPackingSymmetryVectorAction k - z.1) → (∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : - Fin (3 : ℕ)), ∀ (e : Bool), ∀ (delta : Bool), (BandPackingSymmetryScopedPhase g q - delta) → ((∀ (i : Fin (3 : ℕ)), - let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); - let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : - Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); - let cyclic := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 - : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ - BandVectors.2 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : - ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : - ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation g = true then - -GaussianQuarterTurn cyclic.2 else cyclic.2) → ( - let q' := BandPackingSymmetryQuadrupleAction g q - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j - let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) - let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) - let Z : GaussianInt × GaussianInt := (W, A) - let M : GaussianInt × GaussianInt := - (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) - let W' := BandVectors.1 (q' ((sigma i + 2).succ)) - (q' ((sigma i + 1).succ)) - let A' := BandVectors.2 (q' ((sigma i + 2).succ)) - (q' ((sigma i + 1).succ)) - (W' = (if delta then (-1 : GaussianInt) else 1) * (if - BandPackingSymmetryReversesOrientation g then GaussianQuarterTurn - (BandPackingSymmetryVectorAction g W) else BandPackingSymmetryVectorAction g W)) → - ((A' = (if delta then (-1 : GaussianInt) else 1) * (if - BandPackingSymmetryReversesOrientation g then -GaussianQuarterTurn - (BandPackingSymmetryAffineVectorAction g Z).2 else - (BandPackingSymmetryAffineVectorAction g Z).2)) → - ((BandPackingSymmetryAffineVectorAction g M = if - BandPackingSymmetryReversesOrientation g then BandPackingSymmetryAffineVectorAction g - Z + affineQuarter (BandPackingSymmetryAffineVectorAction g Z) else - BandPackingSymmetryAffineVectorAction g Z - affineQuarter - (BandPackingSymmetryAffineVectorAction g Z)) → ((W' - GaussianQuarterTurn W', A' + - GaussianQuarterTurn A') = if delta then -(BandPackingSymmetryAffineVectorAction g M) - else BandPackingSymmetryAffineVectorAction g M)))))) ) := by + fun z => (GaussianQuarterTurn z.1, -GaussianQuarterTurn z.2); + (∀ (k : BandPackingSymmetry), + ∀ (z : GaussianInt × GaussianInt), + (BandPackingSymmetryAffineVectorAction k z).1 = + BandPackingSymmetryVectorAction k z.1) → + (∀ (g : BandPackingSymmetry), + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), + ∀ (delta : Bool), + (let q' := BandPackingSymmetryQuadrupleAction g q; + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j; + let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)); + let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)); + let Z : GaussianInt × GaussianInt := (W, A); + let M : GaussianInt × GaussianInt := + (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A); + let W' := + BandVectors.1 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)); + let A' := + BandVectors.2 (q' ((sigma i + 2).succ)) + (q' ((sigma i + 1).succ)); + (W' = + (if delta then (-1 : GaussianInt) else 1) * + (if BandPackingSymmetryReversesOrientation g then + GaussianQuarterTurn (BandPackingSymmetryVectorAction g W) + else BandPackingSymmetryVectorAction g W)) → + ((A' = + (if delta then (-1 : GaussianInt) else 1) * + (if BandPackingSymmetryReversesOrientation g then + -GaussianQuarterTurn + (BandPackingSymmetryAffineVectorAction g Z).2 + else (BandPackingSymmetryAffineVectorAction g Z).2)) → + ((BandPackingSymmetryAffineVectorAction g M = + if BandPackingSymmetryReversesOrientation g then + BandPackingSymmetryAffineVectorAction g Z + + affineQuarter + (BandPackingSymmetryAffineVectorAction g Z) + else + BandPackingSymmetryAffineVectorAction g Z - + affineQuarter + (BandPackingSymmetryAffineVectorAction g Z)) → + ((W' - GaussianQuarterTurn W', + A' + GaussianQuarterTurn A') = + if delta then -(BandPackingSymmetryAffineVectorAction g M) + else BandPackingSymmetryAffineVectorAction g M)))))) := by classical - intro affineQuarter affineFirst g q i e delta hphase hcyc q' sigma W A Z M W' A' hWphase2 - hAphase2 hactM2 + intro affineQuarter affineFirst g q i delta q' sigma W A Z M W' A' hWphase2 hAphase2 hactM2 rw [hWphase2, hAphase2, ← affineFirst g Z, hactM2] cases delta <;> cases hor : BandPackingSymmetryReversesOrientation g <;> ext <;> simp [affineQuarter, GaussianQuarterTurn] <;> ring @@ -1646,8 +1642,8 @@ private theorem forwardSub : have hpat2 : M = Z + -affineQuarter Z := by ext <;> simp [M, Z, affineQuarter, GaussianQuarterTurn]; ring have hactM2 := MarkedCovarianceGeometry.hactM2 affineFacts g q i hpat2 - have hMphase2 := MarkedCovarianceGeometry.hMphase2 affineFirst g q i e delta hphase - hcyc hWphase2 hAphase2 hactM2 + have hMphase2 := MarkedCovarianceGeometry.hMphase2 affineFirst g q i delta hWphase2 + hAphase2 hactM2 have hpointSign := MarkedCovarianceGeometry.hpointSignAt762 g q i delta hMphase2 have hdiff' := MarkedCovarianceGeometry.hdiff' g T T' q i e delta p p' hdiff hpointSign refine ⟨r, r', hsr, hsr', ?_, ?_⟩ diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean index db93bd190d..9579411a45 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean @@ -6,10 +6,10 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport @@ -316,15 +316,6 @@ private theorem parent_half : · intro h; exact ((TouchingTriplePermutations _ _ _).mp h).2.1 simpa only [sub_eq_add_neg, add_comm] using hh.trans (ht.trans perm) -private theorem point_add : - (by - classical - exact - ∀ (x : GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint (x + y) = GaussianRealPoint x - + GaussianRealPoint y ) := by - classical - intro x y - ext <;> simp [GaussianRealPoint] private theorem point_sub : (by @@ -981,7 +972,7 @@ theorem BandPackingSymmetryT3T5Covariance : half_cov half_center have parent_half := PackingCovarianceProof.parent_half etranslate triple_obs translate_add translate_zero half_translate half_cov half_center half_other - have point_add := PackingCovarianceProof.point_add + have point_add := GaussianRealPointProperties.add have point_sub := PackingCovarianceProof.point_sub have point_neg (x : GaussianInt) : GaussianRealPoint (-x) = -GaussianRealPoint x := by ext <;> simp [GaussianRealPoint] diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean index a1abf607a9..80004e9232 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean @@ -6,20 +6,14 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnTranslation public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric -public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretationCovariance -public import LeanPool.ApollonianSuperharmonic.TileArea -public import LeanPool.ApollonianSuperharmonic.TileCellComplement public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance -public import LeanPool.ApollonianSuperharmonic.TouchingTriple public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance -- [TABLET NODE: BandPackingSymmetryTilingTransport] @@ -37,29 +31,6 @@ namespace ApollonianSuperharmonic namespace TilingTransportProof -private theorem quarter_translate : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (x : GaussianInt), TileQuarterTurn (TileTranslation T x) = - TileTranslation (TileQuarterTurn T) (GaussianQuarterTurn x) - ) := by - classical - intro T x - cases T with - | mk cells anchor => - have map : (fun z : GaussianInt => GaussianQuarterTurn (z + x) - 1) = - (fun z : GaussianInt => (GaussianQuarterTurn z - 1) + - GaussianQuarterTurn x) := by - funext z - ext <;> simp [GaussianQuarterTurn, add_comm]; ring - apply congrArg₂ (fun c : FiniteTile => fun d : GaussianInt => - ProtoTile.mk c d) - · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, - Finset.image_image, Function.comp_def, map] - · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, - GaussianQuarterTurn, add_comm] - private theorem quarter_symmetryAt181 : (by classical @@ -330,7 +301,7 @@ private theorem negation : · intro T U V exact (TouchingTripleCovariance T U V 0).2.1 · intro T v - exact (TilingTransportProof.quarter_translate) T v + exact (TileQuarterTurnTranslation.commute) T v · intro T have h := (TileQuarterTurnFormulas T).2.2.2.2.2.1 change FootprintVertices (TileQuarterTurn T) = diff --git a/LeanPool/ApollonianSuperharmonic/BandParentVectorQuarterTurn.lean b/LeanPool/ApollonianSuperharmonic/BandParentVectorQuarterTurn.lean new file mode 100644 index 0000000000..4c6e9e03a2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandParentVectorQuarterTurn.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import Mathlib.Init + + + +/-! +# BandParentVectorQuarterTurn + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace BandParentVectorQuarterTurn + +/-- The phase relation turns each incoming parent vector into its outgoing vector. -/ +theorem turn (q : Fin 4 → CircleCoordinates) + (phase : ∀ s : Fin 3, BandVectors.1 (q 0) (q s.succ) = + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q s.succ) (q 0)) (s : Fin 3) : + GaussianQuarterTurn (BandVectors.1 (q s.succ) (q 0)) = + BandVectors.1 (q 0) (q s.succ) := by + rw [phase s] + rcases BandVectors.1 (q s.succ) (q 0) with ⟨a, b⟩ + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + +end BandParentVectorQuarterTurn +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean b/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean index 3f1f0b6c98..b3d7cc25ff 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean @@ -6,15 +6,11 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.CircleMatrixSymmetry public import LeanPool.ApollonianSuperharmonic.BandOdometerInteriorTable public import LeanPool.ApollonianSuperharmonic.BandTileTopologyApplication -public import LeanPool.ApollonianSuperharmonic.CircleMatrix -public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends -public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicRepresentative public import LeanPool.ApollonianSuperharmonic.PeriodicBoundaryWebLaplacian -public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.TilingLattice -- [TABLET NODE: BandPeriodicSuperharmonicity] @@ -31,18 +27,6 @@ namespace ApollonianSuperharmonic namespace PeriodicSuperharmonicGeometry -private theorem hsym : - (by - classical - exact - ∀ (C : BandCircle), (CircleMatrix C).IsSymm ) := by - classical - intro C - unfold Matrix.IsSymm CircleMatrix - dsimp - ext i j - fin_cases i <;> fin_cases j <;> rfl - private theorem hRne : (by classical @@ -433,7 +417,7 @@ theorem BandPeriodicSuperharmonicity (C : BandCircle) -- BODY classical unfold IntegerSuperharmonicRepresentative - refine ⟨(PeriodicSuperharmonicGeometry.hsym C), ?_, ?_⟩ + refine ⟨(CircleMatrixSymmetry.symmetric C), ?_, ?_⟩ · unfold QuadraticGrowthAtInfinity obtain ⟨b, hb⟩ := hremainder obtain ⟨R, hR, hcard⟩ := TilingLatticeIndex C diff --git a/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean b/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean index 6a20501faf..407d8f2f43 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean @@ -7,7 +7,6 @@ module public import Mathlib.Init -public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints -- [TABLET NODE: BandPositiveCutBranchCompanionExclusion] @@ -39,71 +38,6 @@ private theorem positive_of_nonempty : | @decompose r hr S X hS hc hf hcent => exact (ProperBandCurvatureStructure r hr).1 -private theorem boundary_edge_footprint : - (by - classical - exact - ∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges X) → (e ∈ - FootprintEdges X) ) := by - classical - intro X e he - let I : GaussianInt := ⟨0, 1⟩ - rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inl rfl⟩ - · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ - congr 1 <;> simp [I, Zsqrtd.ext_iff] - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ - congr 1 <;> simp [] - -private theorem edge_vertex_footprint : - (by - classical - exact - ∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges X) → (∀ (z : - GaussianInt), (z ∈ e) → (z ∈ FootprintVertices X)) ) := by - classical - intro X e he z hz - rcases he with ⟨c, hc, he⟩ - unfold FootprintVertices - rw [ite_eq_left ⟨c, hc⟩] - rcases he with h | h | h | h <;> subst e - all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hz - · rcases hz with rfl | rfl - · exact ⟨_, hc, Or.inl rfl⟩ - · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ - · rcases hz with rfl | rfl - · exact ⟨_, hc, Or.inl rfl⟩ - · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ - · rcases hz with rfl | rfl - · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ - · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ - · rcases hz with rfl | rfl - · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ - · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ - -private theorem boundary_to_raw : - (by - classical - exact - (∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges X) → (e ∈ - FootprintEdges X)) → ((∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ - FootprintEdges X) → (∀ (z : GaussianInt), (z ∈ e) → (z ∈ FootprintVertices X))) → (∀ - (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ BoundaryFootprintVertices X) → (x ∈ - FootprintVertices X))) ) := by - classical - intro boundary_edge_footprint edge_vertex_footprint X x hx - by_cases hne : X.cells.Nonempty - · unfold BoundaryFootprintVertices at hx - rw [ite_eq_left hne] at hx - rcases hx with ⟨e, he, hxe⟩ - exact edge_vertex_footprint X e (boundary_edge_footprint X e he) x hxe - · unfold BoundaryFootprintVertices at hx - rw [ite_eq_right hne] at hx - subst x - simp [FootprintVertices, hne] private theorem exact_exclusion : (by @@ -317,15 +251,6 @@ private theorem hsum : simpa [w, t, u, cfg.firstParentTwo, cfg.firstParentThree] using (VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).1 -private theorem gaussianPoint_add : - (by - classical - exact - ∀ (x : GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint (x + y) = GaussianRealPoint x - + GaussianRealPoint y ) := by - classical - intro x y - ext <;> simp [GaussianRealPoint] private theorem gaussianPoint_neg : (by @@ -1595,9 +1520,9 @@ theorem BandPositiveCutBranchCompanionExclusion (TileTranslation cert.O (-BandVectors.1 (cfg.firstPredecessor 1) (q 3)))) := by -- BODY - have boundary_to_raw := PositiveCutExclusionGeometry.boundary_to_raw - (PositiveCutExclusionGeometry.boundary_edge_footprint) - (PositiveCutExclusionGeometry.edge_vertex_footprint) + have boundary_to_raw := BoundaryFootprintInclusion.boundaryVertex + (BoundaryFootprintInclusion.boundaryEdge) + (BoundaryFootprintInclusion.edgeVertex) have exact_exclusion := PositiveCutExclusionGeometry.exact_exclusion have occurrence_centroid := PositiveCutExclusionGeometry.occurrence_centroid have hcurv := ProperBandCurvatureStructure q cfg.proper @@ -1628,7 +1553,7 @@ theorem BandPositiveCutBranchCompanionExclusion GaussianRealPoint ((I - 1) * x) = -GaussianRealPoint ((1 - I) * x) := PositiveCutExclusionGeometry.gaussianPoint_Iminus_one gaussianPoint_neg x have hsumGaussianPoint := PositiveCutExclusionGeometry.hsumGaussianPoint q - cfg (PositiveCutExclusionGeometry.gaussianPoint_add) + cfg (GaussianRealPointProperties.add) (PositiveCutExclusionGeometry.hprod q cfg (PositiveCutExclusionGeometry.hsum q cfg)) have hsumGaussianPointFst := PositiveCutExclusionGeometry.hsumGaussianPointFst q cfg hsumGaussianPoint diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean index 00a8a92395..8e5a217b3a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean @@ -6,11 +6,11 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.BandGenealogy public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation -public import LeanPool.ApollonianSuperharmonic.BandPrototile public import LeanPool.ApollonianSuperharmonic.BandPrototileReindexedDecomposition public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification @@ -364,14 +364,6 @@ private theorem hfoot : obtain ⟨x, hx, hvertex⟩ := hv exact ⟨x, (hcells0 x).2 ⟨i, s, hx⟩, hvertex⟩ -private theorem pointNeg : - (by - classical - exact - ∀ (z : GaussianInt), GaussianRealPoint (-z) = -GaussianRealPoint z ) := by - classical - intro z - ext <;> simp [GaussianRealPoint] private theorem pointI : (by @@ -1290,39 +1282,37 @@ private theorem hcentral0 : private theorem gridCenter : (by classical - exact - (ℕ) → ((BandCircle) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g - : BandPackingSymmetry), - let q' : Fin 4 → CircleCoordinates := - BandPackingSymmetryQuadrupleAction g - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - ∀ (T1 : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), - let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) - let U : Fin 3 → Bool → ProtoTile := fun i s => - if i = 0 then - if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 - else if i = 1 then - if s then TileTranslation (S 1 s) a - else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) - else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) - else TileTranslation (S 2 s) a - let T0 : ProtoTile := - ⟨Finset.univ.biUnion (fun i : Fin 3 => - Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ - let reCells : Finset Int := T1.cells.image (fun x => x.re) - let imCells : Finset Int := T1.cells.image (fun x => x.im) - ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), - let mRe := reCells.min' reNe - let MRe := reCells.max' reNe - (∃ x ∈ T1.cells, x.re = mRe) → ((∃ x ∈ T1.cells, x.re = MRe) → ( - let mIm := imCells.min' imNe - let MIm := imCells.max' imNe - (∃ x ∈ T1.cells, x.im = mIm) → ((∃ x ∈ T1.cells, x.im = MIm) → (∀ (x : GaussianInt), - ((x.re : Real) + 1 / 2, (x.im : Real) + 1 / 2) ∈ TileRealization T0 ↔ x ∈ - T0.cells)))))) ) := by + exact + (∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (r : Fin (3 : ℕ)), + ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ]; + ∀ (T1 : ProtoTile), + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2); + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then + if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else + if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else + if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a; + let T0 : ProtoTile := + ⟨Finset.univ.biUnion + (fun i : Fin 3 => + Finset.univ.biUnion (fun s : Bool => (U i s).cells)), + T1.anchor⟩; + (∀ (x : GaussianInt), + ((x.re : Real) + 1 / 2, (x.im : Real) + 1 / 2) ∈ + TileRealization T0 ↔ + x ∈ T0.cells))) := by classical - intro n C q r g q' T1 S a U T0 reCells imCells reNe imNe mRe MRe minReCell maxReCell mIm MIm - minImCell maxImCell x + intro q r g q' T1 S a U T0 x constructor · intro hp simp only [TileRealization, Set.mem_iUnion] at hp @@ -1929,8 +1919,8 @@ private theorem hrootCent : PrototileConstruction.hcentral0 q r g T1 S hRinv pairMem pairMem' realization0 have gridCenter (x : GaussianInt) : ((x.re : Real) + 1 / 2, (x.im : Real) + 1 / 2) ∈ - TileRealization T0 ↔ x ∈ T0.cells := PrototileConstruction.gridCenter n C - q r g T1 S reNe imNe minReCell maxReCell minImCell maxImCell x + TileRealization T0 ↔ x ∈ T0.cells := PrototileConstruction.gridCenter + q r g T1 S x let tau : GaussianInt → GaussianInt := fun x => t0 - x - 1 - I have tau_invol (x : GaussianInt) : tau (tau x) = x := by apply Zsqrtd.ext <;> simp [tau, I] <;> omega @@ -2079,7 +2069,7 @@ private theorem existence : (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) have pointNeg (z : GaussianInt) : GaussianRealPoint (-z) = -GaussianRealPoint z := - PrototileConstruction.pointNeg z + GaussianRealPointProperties.negation z have pointI (z : GaussianInt) : GaussianRealPoint (I * z) = (-(GaussianRealPoint z).2, (GaussianRealPoint z).1) := diff --git a/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean index 953bc2b859..9b09b10f0d 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean @@ -8,8 +8,6 @@ module public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification -public import LeanPool.ApollonianSuperharmonic.TileBordering -public import LeanPool.ApollonianSuperharmonic.RegularTileFamily -- [TABLET NODE: BandTileTopologyApplication] @@ -95,21 +93,6 @@ private theorem translate_zero : simp [GaussianTranslation] · simp [GaussianTranslation] -private theorem realPoint_injective : - (by - classical - exact - Function.Injective GaussianRealPoint ) := by - classical - intro x y hxy - apply Zsqrtd.ext - · have h := congrArg Prod.fst hxy - dsimp [GaussianRealPoint] at h - exact_mod_cast h - · have h := congrArg Prod.snd hxy - dsimp [GaussianRealPoint] at h - exact_mod_cast h - private theorem hnonempty : (by classical @@ -667,7 +650,7 @@ theorem BandTileTopologyApplication (C : BandCircle) have translate_zero : TileTranslation T 0 = T := @TileTopologyGeometry.translate_zero C q T hT P htile hchart family_eq centroid_difference have realPoint_injective : Function.Injective GaussianRealPoint := - TileTopologyGeometry.realPoint_injective + GaussianRealPointProperties.injective have hpositive : 0 < (q 0).1 := (ProperBandCurvatureStructure q hq).1 have harea := (BandTileSimultaneousInduction q hq T hT).2.1 have hnonempty (x : GaussianInt) : diff --git a/LeanPool/ApollonianSuperharmonic/BandTwelveParentSurround.lean b/LeanPool/ApollonianSuperharmonic/BandTwelveParentSurround.lean index 5a913670dc..8276906a5b 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTwelveParentSurround.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTwelveParentSurround.lean @@ -6,11 +6,10 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.OrderedParentVectorSum public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches public import LeanPool.ApollonianSuperharmonic.PeriodicTileIntersectionClassification -public import LeanPool.ApollonianSuperharmonic.UniqueBoundedGridComplementComponent -public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation public import LeanPool.ApollonianSuperharmonic.P4630T1AffineCellSymmetry public import LeanPool.ApollonianSuperharmonic.P4630T1CellRouteLift public import LeanPool.ApollonianSuperharmonic.P4630T1ExteriorNeighbors @@ -33,16 +32,6 @@ namespace ApollonianSuperharmonic namespace TwelveParentGeometry -private theorem incoming : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (BandVectors.1 - (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) ) := by - classical - intro q cfg - simpa [Fin.sum_univ_succ, add_assoc] using - (IncomingSuperbasisRelation q cfg.proper).1 private theorem outgoing : (by @@ -475,7 +464,7 @@ theorem BandTwelveParentSurround Finset.univ.biUnion (fun k : Fin 4 => (R i k).cells)), 0⟩ have union (x : LatticeCell) : x ∈ ring.cells ↔ ∃ i k, x ∈ (R i k).cells := by simp [ring] - have incoming := TwelveParentGeometry.incoming q cfg + have incoming := OrderedParentVectorSum.incoming q cfg have flip := (VectorRecursionLaws q cfg.proper.1).2.2.2.2 cfg.proper have outgoing := TwelveParentGeometry.outgoing q incoming flip have third := TwelveParentGeometry.third q cfg C₀ T cert outgoing diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryFootprintInclusion.lean b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintInclusion.lean new file mode 100644 index 0000000000..fe42b90671 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintInclusion.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.FootprintEdges +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import Mathlib.Init + + +/-! +# BoundaryFootprintInclusion + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace BoundaryFootprintInclusion + +/-- Shared boundaryEdge identity for BoundaryFootprintInclusion. -/ +theorem boundaryEdge : + (by + classical + exact + ∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges U) → (e ∈ + FootprintEdges U) ) := by + classical + intro U e he + let I : GaussianInt := ⟨0, 1⟩ + rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inl rfl⟩ + · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ + congr 1 <;> simp [I, Zsqrtd.ext_iff] + · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ + · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ + · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ + congr 1 <;> simp [] + +/-- Shared edgeVertex identity for BoundaryFootprintInclusion. -/ +theorem edgeVertex : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges X) → (∀ (z : + GaussianInt), (z ∈ e) → (z ∈ FootprintVertices X)) ) := by + classical + intro X e he z hz + rcases he with ⟨c, hc, he⟩ + unfold FootprintVertices + rw [ite_eq_left ⟨c, hc⟩] + rcases he with h | h | h | h <;> subst e + all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hz + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inl rfl⟩ + · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ + · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + · rcases hz with rfl | rfl + · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ + · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ + +/-- Shared boundaryVertex identity for BoundaryFootprintInclusion. -/ +theorem boundaryVertex : + (by + classical + exact + (∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges X) → (e ∈ + FootprintEdges X)) → ((∀ (X : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ + FootprintEdges X) → (∀ (z : GaussianInt), (z ∈ e) → (z ∈ FootprintVertices X))) → (∀ + (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ BoundaryFootprintVertices X) → (x ∈ + FootprintVertices X))) ) := by + classical + intro boundary_edge_footprint edge_vertex_footprint X x hx + by_cases hne : X.cells.Nonempty + · unfold BoundaryFootprintVertices at hx + rw [ite_eq_left hne] at hx + rcases hx with ⟨e, he, hxe⟩ + exact edge_vertex_footprint X e (boundary_edge_footprint X e he) x hxe + · unfold BoundaryFootprintVertices at hx + rw [ite_eq_right hne] at hx + subst x + simp [FootprintVertices, hne] + +end BoundaryFootprintInclusion +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryFrameJoinGeometry.lean b/LeanPool/ApollonianSuperharmonic/BoundaryFrameJoinGeometry.lean new file mode 100644 index 0000000000..af8bd9388d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BoundaryFrameJoinGeometry.lean @@ -0,0 +1,339 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization +public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import Mathlib.Init + + +/-! +# BoundaryFrameJoinGeometry + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace BoundaryFrameJoinGeometry + +/-- Shared parentPrototile identity for BoundaryFrameJoinGeometry. -/ +theorem parentPrototile : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), (BandPrototile (F.q F.slot.succ) (D.tiles F.slot + false)) → (BandPrototile C.1.1 (D.tiles F.slot false)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D hUband + rw [← F.parent] + exact hUband + +/-- Shared selectedCentroid identity for BoundaryFrameJoinGeometry. -/ +theorem selectedCentroid : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then (1 : + ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 + : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : + ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : + ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → (TileCentroid (D.tiles + F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • (GaussianRealPoint w - + (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r w hUcent + simpa [r, w] using hUcent + +/-- Shared minusCentroid identity for BoundaryFrameJoinGeometry. -/ +theorem minusCentroid : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r + simpa [r] using F.minus_centroid + +/-- Shared firstVectorSumReal identity for BoundaryFrameJoinGeometry. -/ +theorem firstVectorSumReal : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (w + x + y = 0) → (w.re + x.re + y.re = 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r w x y hvsum + have h := congrArg (fun z : GaussianInt => z.re) hvsum + simpa [w, x, y] using h + +/-- Shared firstVectorSumImaginary identity for BoundaryFrameJoinGeometry. -/ +theorem firstVectorSumImaginary : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let w : GaussianInt := BandVectors.1 (r 3) (r 2) + let x : GaussianInt := BandVectors.1 (r 1) (r 3) + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (w + x + y = 0) → (w.im + x.im + y.im = 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r w x y hvsum + have h := congrArg (fun z : GaussianInt => z.im) hvsum + simpa [w, x, y] using h + +/-- Shared joinFamily identity for BoundaryFrameJoinGeometry. -/ +theorem joinFamily : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (y ∈ TilingLattice C) → (∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + join ∈ RegularTileFamily base (TilingLattice C)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r y hyLattice u join + refine ⟨(u : GaussianInt) + y, (TilingLattice C).add_mem u.property hyLattice, ?_⟩ + rfl + +/-- Shared joinCentroid identity for BoundaryFrameJoinGeometry. -/ +theorem joinCentroid : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (join = TileTranslation Rminus y) → (TileCentroid join = TileCentroid Rminus + + GaussianRealPoint y) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r y u join hjoin_eq + rw [hjoin_eq, (TileTranslationFormulas Rminus y).2.2.2.2.1] + apply Prod.ext <;> simp [GaussianRealPoint] + +/-- Shared joinCentroidEquality identity for BoundaryFrameJoinGeometry. -/ +theorem joinCentroidEquality : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = GaussianRealPoint y) → (∀ (u + : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (TileCentroid join = TileCentroid Rminus + GaussianRealPoint y) → (TileCentroid (D.tiles + F.slot false) = TileCentroid join)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r y hcenter u join hjoinCenter + calc + TileCentroid (D.tiles F.slot false) = + (TileCentroid (D.tiles F.slot false) - TileCentroid Rminus) + + TileCentroid Rminus := by ext <;> dsimp <;> ring + _ = GaussianRealPoint y + TileCentroid Rminus := by rw [hcenter] + _ = TileCentroid Rminus + GaussianRealPoint y := by ext <;> dsimp <;> ring + _ = TileCentroid join := hjoinCenter.symm + +/-- Shared joinAncestor identity for BoundaryFrameJoinGeometry. -/ +theorem joinAncestor : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), (0 < (F.q F.slot.succ).1) → (((F.q F.slot.succ).1 < + (F.q 0).1) → ((AncestorOdometer (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) + F.tile (D.functions F.slot false) + F.odometer) → ( + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (BandPrototile C.1.1 join) → (((D.tiles F.slot false).cells = join.cells ∧ ((D.tiles + F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = join.anchor)) → + (AncestorOdometer C.1.1 F.outer.1.1 join F.tile (D.functions F.slot false) + F.odometer))))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D hCpositive hstrict hselectedAnc r y u + join hjoinBand hjoinCells + have hstrictOuter : (F.q F.slot.succ).1 < F.outer.1.1.1 := by + rw [← F.child] + exact hstrict + have hAnc := AncestorOdometerInnerSupportNormalization + (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) join F.tile + (D.functions F.slot false) F.odometer hCpositive hstrictOuter hselectedAnc + (by simpa only [← F.parent] using hjoinBand) hjoinCells.1 + simpa only [← F.parent] using hAnc + +/-- Shared joinFootprint identity for BoundaryFrameJoinGeometry. -/ +theorem joinFootprint : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (FootprintVertices (D.tiles F.slot false) ⊆ FootprintVertices F.tile) → (∀ (u : + ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (FootprintVertices join = FootprintVertices (D.tiles F.slot false)) → (FootprintVertices + join ⊆ FootprintVertices F.tile)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r y hUfoot u join hjoinFootEq + rw [hjoinFootEq] + exact hUfoot + +/-- Shared joinOccurrence identity for BoundaryFrameJoinGeometry. -/ +theorem joinOccurrence : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : + P4458T1RestrictionFamily F), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let y : GaussianInt := BandVectors.1 (r 2) (r 1) + (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then (1 : + ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 + : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint + (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : + ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : + ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y) + (BandPrototile C.1.1 join) → ((TileCentroid (D.tiles F.slot false) = TileCentroid join) → + ((FootprintVertices join ⊆ FootprintVertices F.tile) → (BandSubtileOccurrence F.q + F.tile F.slot false join)))) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F D r y hUcent u join hjoinBand + hjoinCenterEq hjoinFoot + refine ⟨by simpa only [← F.parent] using hjoinBand, hjoinFoot, ?_⟩ + rw [← hjoinCenterEq] + exact hUcent + +/-- Shared plusCentroid identity for BoundaryFrameJoinGeometry. -/ +theorem plusCentroid : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 + (r 1) (r 0) + BandVectors.1 (r 0) (r 1)) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r + simpa [r] using F.plus_centroid + +/-- Shared secondVectorSumReal identity for BoundaryFrameJoinGeometry. -/ +theorem secondVectorSumReal : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (wa + xa + ya = 0) → (wa.re + xa.re + ya.re = 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum + have h := congrArg (fun z : GaussianInt => z.re) hasum + simpa [wa, xa, ya] using h + +/-- Shared secondVectorSumImaginary identity for BoundaryFrameJoinGeometry. -/ +theorem secondVectorSumImaginary : + (by + classical + exact + ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), + F.q ((F.slot + 2).succ)] + let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + (wa + xa + ya = 0) → (wa.im + xa.im + ya.im = 0) ) := by + classical + intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum + have h := congrArg (fun z : GaussianInt => z.im) hasum + simpa [wa, xa, ya] using h + +end BoundaryFrameJoinGeometry +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/CircleMatrixSymmetry.lean b/LeanPool/ApollonianSuperharmonic/CircleMatrixSymmetry.lean new file mode 100644 index 0000000000..eb932a31a7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/CircleMatrixSymmetry.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.CircleMatrix +public import Mathlib.Init +public import Mathlib.LinearAlgebra.Matrix.Symmetric + + +/-! +# CircleMatrixSymmetry + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace CircleMatrixSymmetry + +/-- Shared symmetric identity for CircleMatrixSymmetry. -/ +theorem symmetric : + (by + classical + exact + ∀ (C : BandCircle), (CircleMatrix C).IsSymm ) := by + classical + intro C + unfold Matrix.IsSymm CircleMatrix + dsimp + ext i j + fin_cases i <;> fin_cases j <;> rfl + +end CircleMatrixSymmetry +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean index a47b9d5a69..593d40d577 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean @@ -7,13 +7,8 @@ module public import Mathlib.Init -public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalLattice public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable -public import LeanPool.ApollonianSuperharmonic.DiamondOdometer -public import LeanPool.ApollonianSuperharmonic.DiamondPeakMatrix public import LeanPool.ApollonianSuperharmonic.FiniteAcyclicOrientationObstruction -public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected -public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import LeanPool.ApollonianSuperharmonic.P5435T1Cocycle public import LeanPool.ApollonianSuperharmonic.P5435T1WebGeometry public import LeanPool.ApollonianSuperharmonic.P5432T1EdgeLedger @@ -442,57 +437,24 @@ private theorem localMem : private theorem value : (by classical - exact - ∀ (K : DiamondParameter), - let D := DiamondVertexDomains K true - let S := DiamondVertexDomains K false \ D - let W : Set GaussianInt := - {x | ∃ v ∈ DiamondExceptionalLattice K, x - v ∈ S} - ((∀ (x : GaussianInt), FourNeighborLaplacian (DiamondOdometer K) (x + ⟨(0 : ℤ), (2 : ℤ) * - (↑K.1 : ℤ)⟩) = FourNeighborLaplacian (DiamondOdometer K) x ∧ FourNeighborLaplacian - (DiamondOdometer K) (x + ⟨(↑K.1 : ℤ) + (1 : ℤ), (↑K.1 : ℤ)⟩) = FourNeighborLaplacian - (DiamondOdometer K) x) ∧ (∀ x ∈ DiamondVertexDomains K false, x ∉ - DiamondVertexDomains K true → FourNeighborLaplacian (DiamondOdometer K) x = (1 : ℤ)) - ∧ ∀ x ∈ DiamondVertexDomains K true, FourNeighborLaplacian (DiamondOdometer K) x = - (if Even (x.re + x.im) then (1 : ℤ) else (-1 : ℤ)) - if x.re = (0 : ℤ) then (1 : ℤ) - else (0 : ℤ)) → ((FourNeighborConnected W ∧ ∀ x ∉ W, ∃ v ∈ DiamondExceptionalLattice - K, ∀ (y : GaussianInt), Relation.ReflTransGen (fun (u z : GaussianInt) => u ∉ W ∧ z ∉ - W ∧ FourNeighborAdjacent u z) x y → y - v ∈ D) → (∀ (finD : D.Finite), - let Df := finD.toFinset - (∀ x, x ∈ Df ↔ x ∈ DiamondVertexDomains K true) → ((∀ (x : GaussianInt), ∀ (y : - GaussianInt), (fun (x y : GaussianInt) => x ∈ Df ∧ y ∈ Df ∧ FourNeighborAdjacent x y - ∧ (x.re.natAbs < y.re.natAbs ∨ x.re = y.re ∧ ¬Even (x.re + x.im) ∧ Even (y.re + - y.im))) x y → x ∈ Df ∧ y ∈ Df ∧ FourNeighborAdjacent x y) → ((∀ x ∈ Df, ∀ y ∈ Df, - FourNeighborAdjacent x y → (fun (x y : GaussianInt) => x ∈ Df ∧ y ∈ Df ∧ - FourNeighborAdjacent x y ∧ (x.re.natAbs < y.re.natAbs ∨ x.re = y.re ∧ ¬Even (x.re + - x.im) ∧ Even (y.re + y.im))) x y ∧ ¬(fun (x y : GaussianInt) => x ∈ Df ∧ y ∈ Df ∧ - FourNeighborAdjacent x y ∧ (x.re.natAbs < y.re.natAbs ∨ x.re = y.re ∧ ¬Even (x.re + - x.im) ∧ Even (y.re + y.im))) y x ∨ (fun (x y : GaussianInt) => x ∈ Df ∧ y ∈ Df ∧ - FourNeighborAdjacent x y ∧ (x.re.natAbs < y.re.natAbs ∨ x.re = y.re ∧ ¬Even (x.re + - x.im) ∧ Even (y.re + y.im))) y x ∧ ¬(fun (x y : GaussianInt) => x ∈ Df ∧ y ∈ Df ∧ - FourNeighborAdjacent x y ∧ (x.re.natAbs < y.re.natAbs ∨ x.re = y.re ∧ ¬Even (x.re + - x.im) ∧ Even (y.re + y.im))) x y) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (fun - (x y : GaussianInt) => x ∈ Df ∧ y ∈ Df ∧ FourNeighborAdjacent x y ∧ (x.re.natAbs < - y.re.natAbs ∨ x.re = y.re ∧ ¬Even (x.re + x.im) ∧ Even (y.re + y.im))) x y → (fun (x - : GaussianInt) => (2 : ℕ) * x.re.natAbs + if Even (x.re + x.im) then (1 : ℕ) else (0 - : ℕ)) x < (fun (x : GaussianInt) => (2 : ℕ) * x.re.natAbs + if Even (x.re + x.im) - then (1 : ℕ) else (0 : ℕ)) y) → ((∀ x ∈ Df, (↑{y ∈ Df | @decide ((fun (x y : - GaussianInt) => x ∈ Df ∧ y ∈ Df ∧ FourNeighborAdjacent x y ∧ (x.re.natAbs < - y.re.natAbs ∨ x.re = y.re ∧ ¬Even (x.re + x.im) ∧ Even (y.re + y.im))) y x) - (Classical.propDecidable _) = true}.card : ℤ) = if x.re = (0 : ℤ) then if Even - (x.re + x.im) then (2 : ℤ) else (0 : - ℤ) else if Even (x.re + x.im) then (3 : ℤ) else (1 : ℤ)) → (∀ (X : Set GaussianInt), - ∀ (z : GaussianInt), - let R := fun u t => u ∉ X ∧ t ∉ X ∧ FourNeighborAdjacent u t - let Y : Set GaussianInt := {y | Relation.ReflTransGen R z y} - ∀ (v : GaussianInt), ∀ (Yfin : Y.Finite), - let Z := Yfin.toFinset.image (fun y => y-v) - ∀ (p : GaussianInt), (∀ t, (t=p ∨ FourNeighborAdjacent p t) → (t ∈ Z ↔ t+v ∉ X)) → (∀ (t - : GaussianInt), t = p ∨ FourNeighborAdjacent p t → (if t ∈ Z then (1 : ℤ) else (0 : - ℤ)) + X.indicator ((fun _ : GaussianInt => (1 : ℤ))) (t + v) = (1 : ℤ)))))))))) := by + exact + (∀ (X : Set GaussianInt), + ∀ (z : GaussianInt), + let R := fun u t => u ∉ X ∧ t ∉ X ∧ FourNeighborAdjacent u t; + let Y : Set GaussianInt := {y | Relation.ReflTransGen R z y}; + ∀ (v : GaussianInt), + ∀ (Yfin : Y.Finite), + let Z := Yfin.toFinset.image (fun y => y - v); + ∀ (p : GaussianInt), + (∀ t, + (t = p ∨ FourNeighborAdjacent p t) → (t ∈ Z ↔ t + v ∉ X)) → + (∀ (t : GaussianInt), + t = p ∨ FourNeighborAdjacent p t → + (if t ∈ Z then (1 : ℤ) else (0 : ℤ)) + + X.indicator (fun _ : GaussianInt => (1 : ℤ)) (t + v) = + (1 : ℤ)))) := by classical - intro K D S W tab geom finD Df hD hsupp horient hrank hcount X z R Y v Yfin Z p localMem t ht - let g := DiamondOdometer K + intro X z R Y v Yfin Z p localMem t ht have hm := localMem t ht by_cases h : t ∈ Z · simp [h, hm.mp h] @@ -596,7 +558,7 @@ theorem DiamondExceptionalMaximality (K : DiamondParameter) : have py : p+v ∈ Y := (memZ p).mp hp have localMem := ExceptionalMaximalityProof.localMem K X z Yout v Yfin p hp hobs memZ py have value (t : GaussianInt) (ht : t=p ∨ FourNeighborAdjacent p t) := - ExceptionalMaximalityProof.value K tab geom finD hD hsupp horient hrank hcount X z v Yfin p + ExceptionalMaximalityProof.value X z v Yfin p localMem t ht have e0 := value p (Or.inl rfl) have e1 := value (p+1) (Or.inr (Or.inl rfl)) diff --git a/LeanPool/ApollonianSuperharmonic/DiamondFootprintCoordinates.lean b/LeanPool/ApollonianSuperharmonic/DiamondFootprintCoordinates.lean new file mode 100644 index 0000000000..b1ac43b0a0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondFootprintCoordinates.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence +public import Mathlib.Init +public import Mathlib.Order.SuccPred.Int + + +/-! +# DiamondFootprintCoordinates + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace DiamondFootprintCoordinates + +/-- Shared coordinates identity for DiamondFootprintCoordinates. -/ +theorem coordinates : + (by + classical + exact + ∀ (k : Nat), ((0 : ℕ) < k) → (∀ (z : GaussianInt), z ∈ FootprintVertices (DiamondTile k) + ↔ (0 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑k : ℤ) ∧ -(↑k : ℤ) ≤ z.re ∧ z.re ≤ (↑k : ℤ) ∧ + -(z.im + (1 : ℤ)) ≤ z.re ∧ z.re ≤ z.im + (1 : ℤ) ∧ -((2 : ℤ) * (↑k : ℤ) - z.im + (1 : + ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * (↑k : ℤ) - z.im + (1 : ℤ)) + ) := by + classical + intro k hk z + rw [(P4194T1DiamondVertexIncidence k hk z).1] + simp only [Fin.exists_fin_succ, Fin.exists_fin_succ, Fin.exists_fin_succ, + Fin.exists_fin_succ] + rw [show LatticeVertexIncidentCell z 0 = z by rfl, + show LatticeVertexIncidentCell z (Fin.succ 0) = z - 1 by rfl, + show LatticeVertexIncidentCell z (Fin.succ 0).succ = z - 1 - ⟨0, 1⟩ by rfl, + show LatticeVertexIncidentCell z (Fin.succ 0).succ.succ = z - ⟨0, 1⟩ by rfl] + rw [(P4194T1DiamondCellRows k z).1, + (P4194T1DiamondCellRows k (z - 1)).1, + (P4194T1DiamondCellRows k (z - 1 - ⟨0, 1⟩)).1, + (P4194T1DiamondCellRows k (z - ⟨0, 1⟩)).1] + simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, + ] + simp [] + omega + +end DiamondFootprintCoordinates +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/DiamondQuadraticArithmetic.lean b/LeanPool/ApollonianSuperharmonic/DiamondQuadraticArithmetic.lean new file mode 100644 index 0000000000..4f2935ee09 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/DiamondQuadraticArithmetic.lean @@ -0,0 +1,141 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.DiamondParameter +public import LeanPool.ApollonianSuperharmonic.DiamondTile +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.IntegerLatticeFunction +public import Mathlib.Init +public import Mathlib.Tactic.LinearCombination + + +/-! +# DiamondQuadraticArithmetic + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace DiamondQuadraticArithmetic + +/-- Shared triangularScale identity for DiamondQuadraticArithmetic. -/ +theorem triangularScale : + (by + classical + exact + (∀ (a : ℤ), (2 : ℤ) * (a * (a - (1 : ℤ)) / (2 : ℤ)) = a * (a - (1 : + ℤ))) ) := by + classical + intro a + rcases Int.emod_two_eq_zero_or_one a with h | h + · have ha : a = 2*(a/2) := by omega + rw [ha] + rw [show 2*(a/2)*(2*(a/2)-1) = 2*((a/2)*(2*(a/2)-1)) by ring, + Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + · have ha : a = 2*(a/2)+1 := by omega + rw [ha] + rw [show (2*(a/2)+1)*(2*(a/2)+1-1) = 2*((2*(a/2)+1)*(a/2)) by ring, + Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + +/-- Shared squareScale identity for DiamondQuadraticArithmetic. -/ +theorem squareScale : + (by + classical + exact + (∀ (a : ℤ), (4 : ℤ) * (a ^ (2 : ℕ) / (4 : ℤ)) = a ^ (2 : ℕ) - a % (2 + : ℤ)) ) := by + classical + intro a + rcases Int.emod_two_eq_zero_or_one a with h | h + · have ha : a = 2*(a/2) := by omega + have he : a^2 = 4*(a/2)^2 := by + conv_lhs => rw [ha] + ring + rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (4:Int) ≠ 0), h] + ring + · have ha : a = 2*(a/2)+1 := by omega + have he : a^2 = 4*((a/2)^2+a/2)+1 := by + conv_lhs => rw [ha] + ring + rw [he, h] + omega + +/-- Shared quadraticScale identity for DiamondQuadraticArithmetic. -/ +theorem quadraticScale : + (by + classical + exact + let Q (a b : Int) : Int := + (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), 2*(a*(a-1)/2) = a*(a-1)) → ((∀ (a : Int), 4*(a^2/4) = a^2-a%2) → (∀ (a : + ℤ), ∀ (b : ℤ), (4 : ℤ) * Q a b = S a b)) ) := by + classical + intro Q S tri square a b + have ht := tri (Int.natAbs a : Int) + have hs := square (a-b) + have ha : (Int.natAbs a : Int)^2 = a^2 := by + rw [Int.natCast_natAbs, sq_abs] + dsimp [Q, S] + rw [Int.natCast_natAbs] at ht ha ⊢ + nlinarith only [ht, hs, ha] + +/-- Shared evenDifference identity for DiamondQuadraticArithmetic. -/ +theorem evenDifference : + (by + classical + exact + ( + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + ∀ (a : ℤ), ∀ (b : ℤ), ∀ (m : ℤ), a - b = (2 : ℤ) * m → S a b = (2 : ℤ) * a ^ (2 : ℕ) - (2 + : ℤ) * |a| - (4 : ℤ) * m ^ (2 : ℕ)) ) := by + classical + intro S a b m h + dsimp [S] + rw [h, show (2*m)%2 = 0 by omega] + ring + +/-- Shared oddDifference identity for DiamondQuadraticArithmetic. -/ +theorem oddDifference : + (by + classical + exact + ( + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + ∀ (a : ℤ), ∀ (b : ℤ), ∀ (m : ℤ), a - b = (2 : ℤ) * m + (1 : ℤ) → S a b = (2 : ℤ) * a ^ (2 + : ℕ) - (2 : ℤ) * |a| - (4 : ℤ) * m ^ (2 : ℕ) - (4 : ℤ) * m) ) := by + classical + intro S a b m h + dsimp [S] + rw [h, show (2*m+1)%2 = 1 by omega] + ring + +/-- Shared differenceScale identity for DiamondQuadraticArithmetic. -/ +theorem differenceScale : + (by + classical + exact + ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), + let Q (a b : Int) : Int := + (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + (∀ (a : Int), ∀ (b : Int), 4*Q a b = S a b) → ((∀ (x : GaussianInt), (x ∈ + FootprintVertices (DiamondTile K.1)) → (f x = Q x.re x.im)) → (∀ (x : GaussianInt), ∀ + (y : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) → y ∈ FootprintVertices + (DiamondTile K.1) → (4 : ℤ) * (f y - f x) = S y.re y.im - S x.re x.im)) ) := by + classical + intro K f Q S scale valC x y hx hy + rw [valC x hx, valC y hy] + linear_combination scale y.re y.im - scale x.re x.im + +end DiamondQuadraticArithmetic +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/EvenSquareQuotient.lean b/LeanPool/ApollonianSuperharmonic/EvenSquareQuotient.lean new file mode 100644 index 0000000000..906329b3b1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/EvenSquareQuotient.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4207T1FloorArithmetic +public import Mathlib.Init + + +/-! +# EvenSquareQuotient + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace EvenSquareQuotient + +/-- Shared square identity for EvenSquareQuotient. -/ +theorem square : + (by + classical + exact + ∀ (m : ℤ), ((2 : ℤ) * m) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) ) := by + classical + intro m + have h := P4207T1FloorArithmetic.1 0 m + simpa using h + +end EvenSquareQuotient +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordFareySum.lean b/LeanPool/ApollonianSuperharmonic/FordFareySum.lean new file mode 100644 index 0000000000..95dd152616 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordFareySum.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordFareyParameter +public import Mathlib.Init + + +/-! +# FordFareySum + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace FordFareySum + +/-- Shared denominatorSum identity for FordFareySum. -/ +theorem denominatorSum : + ∀ (P : FordFareyParameter), P.q = P.q₁ + P.q₂ := by + classical + intro P + exact P.sum_q + +end FordFareySum +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordInteriorSquareCoordinates.lean b/LeanPool/ApollonianSuperharmonic/FordInteriorSquareCoordinates.lean new file mode 100644 index 0000000000..4181c0d234 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordInteriorSquareCoordinates.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorSquare +public import Mathlib.Init + + +/-! +# FordInteriorSquareCoordinates + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace FordInteriorSquareCoordinates + +/-- Shared membership identity for FordInteriorSquareCoordinates. -/ +theorem membership : + ∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ + 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ + 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 := by + classical + intro q x + unfold P4062T1InteriorSquare + constructor + · intro hx + obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hx + obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab + exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, + (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ + · intro h + exact Finset.mem_image.mpr ⟨(x.re, x.im), + Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨h.1, h.2.1⟩, + Finset.mem_Icc.mpr h.2.2⟩, by cases x; rfl⟩ + +end FordInteriorSquareCoordinates +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean index 6419afbd33..11d2e4b4b2 100644 --- a/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean +++ b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean @@ -477,27 +477,66 @@ private theorem lowFormula : private theorem highFormula : ∀ (P : FordFareyParameter), - let g := FordOdometer P - (∀ (r : Int), ∀ (s : Int), FourNeighborLaplacian g ⟨r, s⟩ = g ⟨r + 1, s⟩ + g ⟨r - 1, s⟩ + g - ⟨r, s + 1⟩ + g ⟨r, s - 1⟩ - 4 * g ⟨r, s⟩) → ((GaussianInt) → ( - let a : Int := P.q₁ - let b : Int := P.q₂ - let A := P.p₁ - let B := P.p₂ - let cdiv (n d : Int) := -((-n) / d) - ((P.q : Int) = a + b) → ((A * b - B * a = 1) → ((0 < b) → ((0 < a) → (∀ (P₁ : - FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) → ((∀ (d - : Int), ∀ (n : Int), ∀ (k : Int), (d ≠ 0) → (cdiv (k * d - n) d = k - n / d)) → ((∀ (d : - Int), ∀ (n : Int), ∀ (k : Int), (d ≠ 0) → (cdiv (k * d + n) d = k + cdiv n d)) → ((∀ (r : - Int), (a ≤ r) → ((r ≤ P.q) → (g ⟨r, b⟩ = B * r + 1 ∧ g ⟨b, r⟩ = B * r + 1))) → ((∀ (r : - Int), (b ≤ r) → ((r ≤ P.q) → (g ⟨r, b + 1⟩ = cdiv (A * (r - b)) a + B * r + B + 1 ∧ g ⟨b - + 1, r⟩ = cdiv (A * (r - b)) a + B * r + B + 1))) → ((∀ (r : Int), (a ≤ r) → ((r ≤ P.q) → - (g ⟨r, b - 1⟩ = cdiv (B * (r - a) * (b - 1)) b + A * (b - 1) ∧ g ⟨b - 1, r⟩ = cdiv (B * - (r - a) * (b - 1)) b + A * (b - 1)))) → (∀ (t : ℤ), (0 : ℤ) < t → t ≤ a → t < b → - FourNeighborLaplacian g ⟨(↑P.q : ℤ) - t, b⟩ = cdiv (B * t) b - A * t / a ∧ - FourNeighborLaplacian g ⟨b, (↑P.q : ℤ) - t⟩ = cdiv (B * t) b - A * t / a))))))))))))) := by + let g := FordOdometer P; + (∀ (r : Int), + ∀ (s : Int), + FourNeighborLaplacian g ⟨r, s⟩ = + g ⟨r + 1, s⟩ + g ⟨r - 1, s⟩ + g ⟨r, s + 1⟩ + g ⟨r, s - 1⟩ - + 4 * g ⟨r, s⟩) → + (let a : Int := P.q₁; + let b : Int := P.q₂; + let A := P.p₁; + let B := P.p₂; + let cdiv (n d : Int) := -((-n) / d); + ((P.q : Int) = a + b) → + ((A * b - B * a = 1) → + ((0 < b) → + ((0 < a) → + (∀ (P₁ : FordFareyParameter), + (P₁.q = P.q₁) → + (∀ (P₂ : FordFareyParameter), + (P₂.q = P.q₂) → + ((∀ (d : Int), + ∀ (n : Int), + ∀ (k : Int), + (d ≠ 0) → (cdiv (k * d - n) d = k - n / d)) → + ((∀ (d : Int), + ∀ (n : Int), + ∀ (k : Int), + (d ≠ 0) → (cdiv (k * d + n) d = k + cdiv n d)) → + ((∀ (r : Int), + (a ≤ r) → + ((r ≤ P.q) → + (g ⟨r, b⟩ = B * r + 1 ∧ + g ⟨b, r⟩ = B * r + 1))) → + ((∀ (r : Int), + (b ≤ r) → + ((r ≤ P.q) → + (g ⟨r, b + 1⟩ = + cdiv (A * (r - b)) a + B * r + B + 1 ∧ + g ⟨b + 1, r⟩ = + cdiv (A * (r - b)) a + B * r + B + 1))) → + ((∀ (r : Int), + (a ≤ r) → + ((r ≤ P.q) → + (g ⟨r, b - 1⟩ = + cdiv (B * (r - a) * (b - 1)) b + + A * (b - 1) ∧ + g ⟨b - 1, r⟩ = + cdiv (B * (r - a) * (b - 1)) b + + A * (b - 1)))) → + (∀ (t : ℤ), + (0 : ℤ) < t → + t ≤ a → + t < b → + FourNeighborLaplacian g + ⟨(↑P.q : ℤ) - t, b⟩ = + cdiv (B * t) b - A * t / a ∧ + FourNeighborLaplacian g + ⟨b, (↑P.q : ℤ) - t⟩ = + cdiv (B * t) b - A * t / a)))))))))))) := by classical - intro P g lapCoord x a b A B cdiv hsum hdet hb ha0 P₁ hq₁ P₂ hq₂ cminus cplus edge2 near1 near2 + intro P g lapCoord a b A B cdiv hsum hdet hb ha0 P₁ hq₁ P₂ hq₂ cminus cplus edge2 near1 near2 t ht hta htb have hc := edge2 ((P.q : Int) - t) (by omega) (by omega) have hm := edge2 ((P.q : Int) - t - 1) (by omega) (by omega) @@ -1142,7 +1181,7 @@ private theorem interiorLaplacian : have highFormula (t : Int) (ht : 0 < t) (hta : t ≤ a) (htb : t < b) : FourNeighborLaplacian g ⟨(P.q : Int) - t, b⟩ = cdiv (B * t) b - A * t / a ∧ FourNeighborLaplacian g ⟨b, (P.q : Int) - t⟩ = cdiv (B * t) b - A * t / a := - FordLaplacianProof.highFormula P lapCoord x hsum hdet hb ha0 P₁ hq₁ P₂ hq₂ cminus + FordLaplacianProof.highFormula P lapCoord hsum hdet hb ha0 P₁ hq₁ P₂ hq₂ cminus (FordLaplacianDetails.cplus) (FordLaplacianProof.edge2 P ha x hsum hdet hb P₁ hq₁ P₂ hq₂ v2 v3 cmul) (FordLaplacianDetails.near1 P x hsum ha0 P₁ hq₁ P₂ hq₂ (FordLaplacianProof.v1 P x hsum P₁ hp₁ hq₁ P₂ hq₂ rec1 parentValue)) diff --git a/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean index 3200bdd0a1..ec78d5a635 100644 --- a/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean @@ -7,7 +7,6 @@ module public import Mathlib.Init -public import LeanPool.ApollonianSuperharmonic.FordOdometer public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport @@ -440,59 +439,57 @@ private theorem hvec : private theorem haRe : (by classical - exact - ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), ∀ (w : Fin (4 : ℕ) - → CircleCoordinates), ∀ (iw : Fin (3 : ℕ)), ∀ (ew : Bool), (TileCentroid T' - - TileCentroid T = (if ew = true then (1 : ℝ) else (-1 : ℝ)) • GaussianRealPoint - (BandVectors.1 (w iw.succ) (w (0 : Fin (4 : ℕ))))) → ((p'.1 - p.1 = (if ew = true - then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (w iw.succ) (w (0 : Fin (4 : ℕ)))).re - : ℝ)) → ((p'.2 - p.2 = (if ew = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 - (w iw.succ) (w (0 : Fin (4 : ℕ)))).im : ℝ)) → (∀ (r2 : Fin (3 : ℕ)), ∀ (g2 : - BandPackingSymmetry), ∀ (P2 : FordFareyParameter), - let barq : Fin 4 → CircleCoordinates := - ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] - ∀ (t : Fin (3 : ℕ)), (t + r2 = iw) → ((barq t.succ = w iw.succ) → ((TileCentroid T' - - TileCentroid T = (if ew = true then (1 : ℝ) else -1) • GaussianRealPoint - (BandVectors.1 (barq t.succ) (barq 0))) → ((p'.1 - p.1 = (if ew = true then (1 : ℝ) - else -1) * (BandVectors.2 (barq t.succ) (barq 0)).re) → ((p'.2 - p.2 = (if ew = true - then (1 : ℝ) else -1) * (BandVectors.2 (barq t.succ) (barq 0)).im) → (∀ (negative : - Bool), ∀ (r : ℝ × ℝ), ∀ (r' : ℝ × ℝ), (BandPackingSymmetryScopedPhase g2 barq - negative) → ((TileCentroid (BandPackingSymmetryTileAction g2 T') - TileCentroid - (BandPackingSymmetryTileAction g2 T) = (if (ew ^^ negative) = true then (1 : ℝ) else - (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction g2 - barq ((fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g2 = true - then -j else j) t).succ) (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : - ℕ))))) → ((r'.1 - r.1 = (if (ew ^^ negative) = true then (1 : ℝ) else (-1 : ℝ)) * - (↑(BandVectors.2 (BandPackingSymmetryQuadrupleAction g2 barq ((fun (j : Fin (3 : ℕ)) - => if BandPackingSymmetryReversesOrientation g2 = true then -j else j) t).succ) - (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : ℕ)))).re : ℝ)) → ((r'.2 - - r.2 = (if (ew ^^ negative) = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 - (BandPackingSymmetryQuadrupleAction g2 barq ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g2 = true then -j else j) t).succ) - (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : ℕ)))).im : ℝ)) → (∀ (u : - GaussianInt), ∀ (a : GaussianInt), ∀ (u' : GaussianInt), ∀ (a' : GaussianInt), (u' - - u = (if ew ^^ negative then 1 else -1) • BandVectors.1 - (BandPackingSymmetryQuadrupleAction g2 barq t.succ) - (BandPackingSymmetryQuadrupleAction g2 barq 0)) → ((u' - u = (if (ew ^^ negative) = - true then 1 else -1) • BandVectors.1 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 0)) → (∀ (z : ℝ × ℝ), (r'.1 - r.1 = if ew = negative then - -((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : - Fin (4 : ℕ)))).re : ℝ) + ((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) * (0 : ℝ) - (0 : ℝ))) else - (↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : - Fin (4 : ℕ)))).re : ℝ) + ((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) * (0 : ℝ) - (0 : ℝ))) → ((r'.2 - - r.2 = if ew = negative then -(↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) else (↑(BandVectors.2 - (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im - : ℝ)) → ((r.1 = z.1 + ((↑a.re : ℝ) + ((↑a.im : ℝ) * (0 : ℝ) - (0 : ℝ)))) → ((r'.1 = - z.1 + ((↑a'.re : ℝ) + ((↑a'.im : ℝ) * (0 : ℝ) - (0 : ℝ)))) → (a'.re - a.re = (if (ew - ^^ negative) = true then 1 else -1) * (BandVectors.2 (FordRecursiveQuadruple P2 - t.succ) (FordRecursiveQuadruple P2 0)).re)))))))))))))))))) ) := by + exact + ∀ (ew : Bool), + (∀ (P2 : FordFareyParameter), + ∀ (t : Fin (3 : ℕ)), + (∀ (negative : Bool), + ∀ (r : ℝ × ℝ), + ∀ (r' : ℝ × ℝ), + (∀ (a : GaussianInt), + ∀ (a' : GaussianInt), + (∀ (z : ℝ × ℝ), + (r'.1 - r.1 = + if ew = negative then + -((↑(BandVectors.2 + (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 + (0 : Fin (4 : ℕ)))).re : + ℝ) + + ((↑(BandVectors.2 + (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 + (0 : Fin (4 : ℕ)))).im : + ℝ) * + (0 : ℝ) - + (0 : ℝ))) + else + (↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 + (0 : Fin (4 : ℕ)))).re : + ℝ) + + ((↑(BandVectors.2 + (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 + (0 : Fin (4 : ℕ)))).im : + ℝ) * + (0 : ℝ) - + (0 : ℝ))) → + ((r.1 = + z.1 + + ((↑a.re : ℝ) + + ((↑a.im : ℝ) * (0 : ℝ) - (0 : ℝ)))) → + ((r'.1 = + z.1 + + ((↑a'.re : ℝ) + + ((↑a'.im : ℝ) * (0 : ℝ) - (0 : ℝ)))) → + (a'.re - a.re = + (if (ew ^^ negative) = true then 1 else -1) * + (BandVectors.2 + (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0)).re)))))))) := by classical - intro T T' p p' w iw ew hwcent hwslope hwslope' r2 g2 P2 barq t ht hpoint hcentbar hslopebar - hslopebar' negative r r' hphase hcent' hsre' hsim' u a u' a' hshift hvec z hsreFord - hsimFord sr sr' + intro ew P2 t negative r r' a a' z hsreFord sr sr' fin_cases t <;> cases ew <;> cases negative all_goals simp only [Bool.xor_true, Bool.xor_false, @@ -509,60 +506,36 @@ private theorem haRe : private theorem haIm : (by classical - exact - ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), ∀ (w : Fin (4 : ℕ) - → CircleCoordinates), ∀ (iw : Fin (3 : ℕ)), ∀ (ew : Bool), (TileCentroid T' - - TileCentroid T = (if ew = true then (1 : ℝ) else (-1 : ℝ)) • GaussianRealPoint - (BandVectors.1 (w iw.succ) (w (0 : Fin (4 : ℕ))))) → ((p'.1 - p.1 = (if ew = true - then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (w iw.succ) (w (0 : Fin (4 : ℕ)))).re - : ℝ)) → ((p'.2 - p.2 = (if ew = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 - (w iw.succ) (w (0 : Fin (4 : ℕ)))).im : ℝ)) → (∀ (r2 : Fin (3 : ℕ)), ∀ (g2 : - BandPackingSymmetry), ∀ (P2 : FordFareyParameter), - let barq : Fin 4 → CircleCoordinates := - ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] - ∀ (t : Fin (3 : ℕ)), (t + r2 = iw) → ((barq t.succ = w iw.succ) → ((TileCentroid T' - - TileCentroid T = (if ew = true then (1 : ℝ) else -1) • GaussianRealPoint - (BandVectors.1 (barq t.succ) (barq 0))) → ((p'.1 - p.1 = (if ew = true then (1 : ℝ) - else -1) * (BandVectors.2 (barq t.succ) (barq 0)).re) → ((p'.2 - p.2 = (if ew = true - then (1 : ℝ) else -1) * (BandVectors.2 (barq t.succ) (barq 0)).im) → (∀ (negative : - Bool), ∀ (r : ℝ × ℝ), ∀ (r' : ℝ × ℝ), (BandPackingSymmetryScopedPhase g2 barq - negative) → ((TileCentroid (BandPackingSymmetryTileAction g2 T') - TileCentroid - (BandPackingSymmetryTileAction g2 T) = (if (ew ^^ negative) = true then (1 : ℝ) else - (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction g2 - barq ((fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g2 = true - then -j else j) t).succ) (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : - ℕ))))) → ((r'.1 - r.1 = (if (ew ^^ negative) = true then (1 : ℝ) else (-1 : ℝ)) * - (↑(BandVectors.2 (BandPackingSymmetryQuadrupleAction g2 barq ((fun (j : Fin (3 : ℕ)) - => if BandPackingSymmetryReversesOrientation g2 = true then -j else j) t).succ) - (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : ℕ)))).re : ℝ)) → ((r'.2 - - r.2 = (if (ew ^^ negative) = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 - (BandPackingSymmetryQuadrupleAction g2 barq ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g2 = true then -j else j) t).succ) - (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : ℕ)))).im : ℝ)) → (∀ (u : - GaussianInt), ∀ (a : GaussianInt), ∀ (u' : GaussianInt), ∀ (a' : GaussianInt), (u' - - u = (if ew ^^ negative then 1 else -1) • BandVectors.1 - (BandPackingSymmetryQuadrupleAction g2 barq t.succ) - (BandPackingSymmetryQuadrupleAction g2 barq 0)) → ((u' - u = (if (ew ^^ negative) = - true then 1 else -1) • BandVectors.1 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 0)) → (∀ (z : ℝ × ℝ), (r'.1 - r.1 = if ew = negative then - -((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : - Fin (4 : ℕ)))).re : ℝ) + ((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) * (0 : ℝ) - (0 : ℝ))) else - (↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : - Fin (4 : ℕ)))).re : ℝ) + ((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) * (0 : ℝ) - (0 : ℝ))) → ((r'.2 - - r.2 = if ew = negative then -(↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) else (↑(BandVectors.2 - (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im - : ℝ)) → ((r.2 = z.2 + (↑a.im : ℝ)) → ((r'.2 = z.2 + (↑a'.im : ℝ)) → ((a'.re - a.re = - (if (ew ^^ negative) = true then 1 else -1) * (BandVectors.2 (FordRecursiveQuadruple - P2 t.succ) (FordRecursiveQuadruple P2 0)).re) → (a'.im - a.im = (if (ew ^^ negative) - = true then 1 else -1) * (BandVectors.2 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 0)).im))))))))))))))))))) ) := by + exact + ∀ (ew : Bool), + (∀ (P2 : FordFareyParameter), + ∀ (t : Fin (3 : ℕ)), + (∀ (negative : Bool), + ∀ (r : ℝ × ℝ), + ∀ (r' : ℝ × ℝ), + (∀ (a : GaussianInt), + ∀ (a' : GaussianInt), + (∀ (z : ℝ × ℝ), + ((r'.2 - r.2 = + if ew = negative then + -(↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 + (0 : Fin (4 : ℕ)))).im : + ℝ) + else + (↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 + (0 : Fin (4 : ℕ)))).im : + ℝ)) → + ((r.2 = z.2 + (↑a.im : ℝ)) → + ((r'.2 = z.2 + (↑a'.im : ℝ)) → + (a'.im - a.im = + (if (ew ^^ negative) = true then 1 else -1) * + (BandVectors.2 + (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0)).im))))))))) := by classical - intro T T' p p' w iw ew hwcent hwslope hwslope' r2 g2 P2 barq t ht hpoint hcentbar hslopebar - hslopebar' negative r r' hphase hcent' hsre' hsim' u a u' a' hshift hvec z hsreFord - hsimFord si si' haRe + intro ew P2 t negative r r' a a' z hsimFord si si' fin_cases t <;> cases ew <;> cases negative all_goals simp only [Bool.xor_true, Bool.xor_false, @@ -874,17 +847,14 @@ theorem FordLeftBoundaryCompatibility have haRe : a'.re - a.re = (if (ew ^^ negative) = true then 1 else -1) * (BandVectors.2 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 0)).re := FordBoundaryCompatibilityGeometry.haRe T T' p - p' w iw ew hwcent hwslope hwslope' r2 g2 P2 t ht hpoint hcentbar hslopebar - hslopebar' negative r r' hphase hcent' hsre' hsim' u a u' a' hshift hvec z - hsreFord hsimFord sr sr' + (FordRecursiveQuadruple P2 0)).re := FordBoundaryCompatibilityGeometry.haRe ew P2 + t negative r r' a a' z + hsreFord sr sr' have haIm : a'.im - a.im = (if (ew ^^ negative) = true then 1 else -1) * (BandVectors.2 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 0)).im := FordBoundaryCompatibilityGeometry.haIm T T' p - p' w iw ew hwcent hwslope hwslope' r2 g2 P2 t ht hpoint hcentbar hslopebar - hslopebar' negative r r' hphase hcent' hsre' hsim' u a u' a' hshift hvec z - hsreFord hsimFord si si' haRe + (FordRecursiveQuadruple P2 0)).im := FordBoundaryCompatibilityGeometry.haIm ew P2 + t negative r r' a a' z hsimFord si si' have hcoc : ∀ y : GaussianInt, FordOdometer P2 (y + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 0)) - FordOdometer P2 y = diff --git a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean index 0c62be8e24..dc04018062 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean @@ -6,9 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordParentVectors -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -public import LeanPool.ApollonianSuperharmonic.TileTranslation public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleSwapLast public import LeanPool.ApollonianSuperharmonic.P5269T1FordSquareNormalForm public import LeanPool.ApollonianSuperharmonic.P5269T1CenteredSquareTripleTransport @@ -917,52 +916,6 @@ private theorem hrAt727 : have hone := Int.eq_one_of_dvd_one (by omega : 0 ≤ (P.q:Int)) hdv omega -private theorem h01 : - (by - classical - exact - ∀ (P : FordFareyParameter), (BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : - GaussianInt)) → ((∀ (j : Fin (3 : ℕ)), BandVectors.1 (FordRecursiveQuadruple P (0 : - Fin (4 : ℕ))) (FordRecursiveQuadruple P j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - * BandVectors.1 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin - (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * - BandVectors.2 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin (4 - : ℕ)))) → (BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) - 1) = ⟨-(P.q₁:Int),P.q⟩)) ) := by - classical - intro P h10 hf - have h := (hf 0).1 - change BandVectors.1 ((FordRecursiveQuadruple P) 0) - ((FordRecursiveQuadruple P) 1) = (⟨0,1⟩ : GaussianInt) * - BandVectors.1 ((FordRecursiveQuadruple P) 1) ((FordRecursiveQuadruple P) 0) at h - rw [h10] at h - exact h.trans (by ext <;> simp) - -private theorem h02 : - (by - classical - exact - ∀ (P : FordFareyParameter), (BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : - GaussianInt)) → ((∀ (j : Fin (3 : ℕ)), BandVectors.1 (FordRecursiveQuadruple P (0 : - Fin (4 : ℕ))) (FordRecursiveQuadruple P j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - * BandVectors.1 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin - (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * - BandVectors.2 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin (4 - : ℕ)))) → (BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) - 2) = ⟨-(P.q₂:Int),-(P.q:Int)⟩)) ) := by - classical - intro P h20 hf - have h := (hf 1).1 - change BandVectors.1 ((FordRecursiveQuadruple P) 0) - ((FordRecursiveQuadruple P) 2) = (⟨0,1⟩ : GaussianInt) * - BandVectors.1 ((FordRecursiveQuadruple P) 2) ((FordRecursiveQuadruple P) 0) at h - rw [h20] at h - exact h.trans (by ext <;> simp) - private theorem norm1 : (by classical @@ -2078,9 +2031,10 @@ theorem FordOrientedChildParentEndpoints obtain ⟨hproper,h10,h20,h30,_⟩ := (FordCoordinateConfiguration P).2 hq have hf := (VectorRecursionLaws _ hproper.1).2.2.2.2 hproper have h01 : BandVectors.1 ((FordRecursiveQuadruple P) 0) - ((FordRecursiveQuadruple P) 1) = ⟨-(P.q₁:Int),P.q⟩ := FordEndpointProof.h01 P h10 hf + ((FordRecursiveQuadruple P) 1) = ⟨-(P.q₁:Int),P.q⟩ := FordParentVectors.firstParent P h10 hf have h02 : BandVectors.1 ((FordRecursiveQuadruple P) 0) - ((FordRecursiveQuadruple P) 2) = ⟨-(P.q₂:Int),-(P.q:Int)⟩ := FordEndpointProof.h02 P h20 hf + ((FordRecursiveQuadruple P) 2) = ⟨-(P.q₂:Int),-(P.q:Int)⟩ := + FordParentVectors.secondParent P h20 hf have norm1 (T : ProtoTile) (hT : BandPrototile ((FordRecursiveQuadruple P) 1) T) : ∃ a b : Int, T.cells = (sq P.q₁ a b).cells := FordEndpointProof.norm1 P hq hr0 T hT have norm2 (T : ProtoTile) (hT : BandPrototile ((FordRecursiveQuadruple P) 2) T) : diff --git a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean index 9be276e6cc..2172a3a265 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordParentVectors public import LeanPool.ApollonianSuperharmonic.P5269T1FordSquareNormalForm public import LeanPool.ApollonianSuperharmonic.P5269T1IncomingSquareJunctions @@ -182,52 +183,6 @@ private theorem hr : have hone := Int.eq_one_of_dvd_one (by omega : 0 ≤ (P.q:Int)) hdv omega -private theorem h01 : - (by - classical - exact - ∀ (P : FordFareyParameter), (BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : - GaussianInt)) → ((∀ (j : Fin (3 : ℕ)), BandVectors.1 (FordRecursiveQuadruple P (0 : - Fin (4 : ℕ))) (FordRecursiveQuadruple P j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - * BandVectors.1 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin - (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * - BandVectors.2 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin (4 - : ℕ)))) → (BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) - 1) = ⟨-(P.q₁:Int),P.q⟩)) ) := by - classical - intro P h10 hf - have h := (hf 0).1 - change BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 1) = - (⟨0,1⟩ : GaussianInt) * BandVectors.1 ((FordRecursiveQuadruple P) 1) - ((FordRecursiveQuadruple P) 0) at h - rw [h10] at h - exact h.trans (by ext <;> simp) - -private theorem h02 : - (by - classical - exact - ∀ (P : FordFareyParameter), (BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : - GaussianInt)) → ((∀ (j : Fin (3 : ℕ)), BandVectors.1 (FordRecursiveQuadruple P (0 : - Fin (4 : ℕ))) (FordRecursiveQuadruple P j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - * BandVectors.1 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin - (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * - BandVectors.2 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin (4 - : ℕ)))) → (BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) - 2) = ⟨-(P.q₂:Int),-(P.q:Int)⟩)) ) := by - classical - intro P h20 hf - have h := (hf 1).1 - change BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 2) = - (⟨0,1⟩ : GaussianInt) * BandVectors.1 ((FordRecursiveQuadruple P) 2) - ((FordRecursiveQuadruple P) 0) at h - rw [h20] at h - exact h.trans (by ext <;> simp) - end IncomingEndpointGeometry theorem FordOrientedChildParentIncomingEndpoint @@ -278,9 +233,9 @@ theorem FordOrientedChildParentIncomingEndpoint obtain ⟨hp,h10,h20,_,_⟩ := (FordCoordinateConfiguration P).2 hq have hf := (VectorRecursionLaws _ hp.1).2.2.2.2 hp have h01 : BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 1) = - ⟨-(P.q₁:Int),P.q⟩ := IncomingEndpointGeometry.h01 P h10 hf + ⟨-(P.q₁:Int),P.q⟩ := FordParentVectors.firstParent P h10 hf have h02 : BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) 2) = - ⟨-(P.q₂:Int),-(P.q:Int)⟩ := IncomingEndpointGeometry.h02 P h20 hf + ⟨-(P.q₂:Int),-(P.q:Int)⟩ := FordParentVectors.secondParent P h20 hf obtain ⟨⟨a,b⟩,hUc⟩ := P5269T1FordSquareNormalForm P hq 0 U hU hUpos have hcu := cent U P.q P.q_pos ⟨a,b⟩ hUc have he0 : Even (0 : Nat) := by decide diff --git a/LeanPool/ApollonianSuperharmonic/FordParentVectors.lean b/LeanPool/ApollonianSuperharmonic/FordParentVectors.lean new file mode 100644 index 0000000000..e3c0a07eb9 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordParentVectors.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple +public import Mathlib.Init + + +/-! +# FordParentVectors + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace FordParentVectors + +/-- Shared firstParent identity for FordParentVectors. -/ +theorem firstParent : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : + GaussianInt)) → ((∀ (j : Fin (3 : ℕ)), BandVectors.1 (FordRecursiveQuadruple P (0 : + Fin (4 : ℕ))) (FordRecursiveQuadruple P j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + * BandVectors.1 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin (4 + : ℕ)))) → (BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) + 1) = ⟨-(P.q₁:Int),P.q⟩)) ) := by + classical + intro P h10 hf + have h := (hf 0).1 + change BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) 1) = (⟨0,1⟩ : GaussianInt) * + BandVectors.1 ((FordRecursiveQuadruple P) 1) ((FordRecursiveQuadruple P) 0) at h + rw [h10] at h + exact h.trans (by ext <;> simp) + +/-- Shared secondParent identity for FordParentVectors. -/ +theorem secondParent : + (by + classical + exact + ∀ (P : FordFareyParameter), (BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : + GaussianInt)) → ((∀ (j : Fin (3 : ℕ)), BandVectors.1 (FordRecursiveQuadruple P (0 : + Fin (4 : ℕ))) (FordRecursiveQuadruple P j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) + * BandVectors.1 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin + (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.2 (FordRecursiveQuadruple P j.succ) (FordRecursiveQuadruple P (0 : Fin (4 + : ℕ)))) → (BandVectors.1 ((FordRecursiveQuadruple P) 0) ((FordRecursiveQuadruple P) + 2) = ⟨-(P.q₂:Int),-(P.q:Int)⟩)) ) := by + classical + intro P h20 hf + have h := (hf 1).1 + change BandVectors.1 ((FordRecursiveQuadruple P) 0) + ((FordRecursiveQuadruple P) 2) = (⟨0,1⟩ : GaussianInt) * + BandVectors.1 ((FordRecursiveQuadruple P) 2) ((FordRecursiveQuadruple P) 0) at h + rw [h20] at h + exact h.trans (by ext <;> simp) + +end FordParentVectors +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FourNeighborLaplacianProperties.lean b/LeanPool/ApollonianSuperharmonic/FourNeighborLaplacianProperties.lean new file mode 100644 index 0000000000..64b00012ac --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FourNeighborLaplacianProperties.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import Mathlib.Init + + +/-! +# FourNeighborLaplacianProperties + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace FourNeighborLaplacianProperties + +/-- Shared differences identity for FourNeighborLaplacianProperties. -/ +theorem differences : + (by + classical + exact + ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), FourNeighborLaplacian g x = g (x + + (1 : GaussianInt)) - g x + (g (x - (1 : GaussianInt)) - g x) + (g (x + ⟨(0 : ℤ), (1 : + ℤ)⟩) - g x) + (g (x - ⟨(0 : ℤ), (1 : ℤ)⟩) - g x) ) := by + classical + intro g x + unfold FourNeighborLaplacian + ring + +end FourNeighborLaplacianProperties +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GaussianCoordinateFacts.lean b/LeanPool/ApollonianSuperharmonic/GaussianCoordinateFacts.lean new file mode 100644 index 0000000000..9b1108961e --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GaussianCoordinateFacts.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Init +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt + + +/-! +# GaussianCoordinateFacts + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace GaussianCoordinateFacts + +/-- Shared equal identity for GaussianCoordinateFacts. -/ +theorem equal (u v : GaussianInt) (hre : u.re = v.re) + (him : u.im = v.im) : u = v := by + classical + rcases u with ⟨u, w⟩ + rcases v with ⟨v, z⟩ + simp_all + +/-- Shared pairSwap identity for GaussianCoordinateFacts. -/ +theorem pairSwap (u v : GaussianInt) : ({u, v} : Finset GaussianInt) = {v, u} := by + classical + ext z + simp [or_comm] + +end GaussianCoordinateFacts +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GaussianQuarterTurnProperties.lean b/LeanPool/ApollonianSuperharmonic/GaussianQuarterTurnProperties.lean new file mode 100644 index 0000000000..05c164fd53 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GaussianQuarterTurnProperties.lean @@ -0,0 +1,49 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import Mathlib.Init + + +/-! +# GaussianQuarterTurnProperties + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace GaussianQuarterTurnProperties + +/-- Shared negation identity for GaussianQuarterTurnProperties. -/ +theorem negation : + (by + classical + exact + ∀ (z : GaussianInt), GaussianQuarterTurn (-z) = -GaussianQuarterTurn z ) := by + classical + intro z + rcases z with ⟨a, b⟩ + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + +/-- Shared twice identity for GaussianQuarterTurnProperties. -/ +theorem twice : + (by + classical + exact + ∀ (z : GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn z) = -z ) := by + classical + intro z + rcases z with ⟨a, b⟩ + apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] + +end GaussianQuarterTurnProperties +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/GaussianRealPointProperties.lean b/LeanPool/ApollonianSuperharmonic/GaussianRealPointProperties.lean new file mode 100644 index 0000000000..cd9332fc67 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/GaussianRealPointProperties.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import Mathlib.Init + + +/-! +# GaussianRealPointProperties + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace GaussianRealPointProperties + +/-- Shared add identity for GaussianRealPointProperties. -/ +theorem add : + (by + classical + exact + ∀ (x : GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint (x + y) = GaussianRealPoint x + + GaussianRealPoint y ) := by + classical + intro x y + ext <;> simp [GaussianRealPoint] + +/-- Shared negation identity for GaussianRealPointProperties. -/ +theorem negation : + (by + classical + exact + ∀ (z : GaussianInt), GaussianRealPoint (-z) = -GaussianRealPoint z ) := by + classical + intro z + ext <;> simp [GaussianRealPoint] + +/-- Shared injective identity for GaussianRealPointProperties. -/ +theorem injective : + (by + classical + exact + Function.Injective GaussianRealPoint ) := by + classical + intro x y hxy + apply Zsqrtd.ext + · have h := congrArg Prod.fst hxy + dsimp [GaussianRealPoint] at h + exact_mod_cast h + · have h := congrArg Prod.snd hxy + dsimp [GaussianRealPoint] at h + exact_mod_cast h + +end GaussianRealPointProperties +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/Imports.lean b/LeanPool/ApollonianSuperharmonic/Imports.lean index 5e5dc4cddf..7e33f79e31 100644 --- a/LeanPool/ApollonianSuperharmonic/Imports.lean +++ b/LeanPool/ApollonianSuperharmonic/Imports.lean @@ -8,6 +8,7 @@ module -- shake: keep-all --deprecated_module: ignore -- Generated project imports; run `lake exe mk_all`. public import LeanPool.ApollonianSuperharmonic public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation +public import LeanPool.ApollonianSuperharmonic.AffineLineMapProperties public import LeanPool.ApollonianSuperharmonic.AffineOpposingStripCorridor public import LeanPool.ApollonianSuperharmonic.AffineTriangularComplexChart public import LeanPool.ApollonianSuperharmonic.AffineTriangularCorridorStep @@ -46,6 +47,7 @@ public import LeanPool.ApollonianSuperharmonic.BandModifiedPeriodicComplex public import LeanPool.ApollonianSuperharmonic.BandModifiedUnionEquality public import LeanPool.ApollonianSuperharmonic.BandOdometerInteriorTable public import LeanPool.ApollonianSuperharmonic.BandOdometerMaximality +public import LeanPool.ApollonianSuperharmonic.BandOdometerParentCentroids public import LeanPool.ApollonianSuperharmonic.BandOdometerTheorem public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralAggregatePatches public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralChildInterfaces @@ -110,6 +112,7 @@ public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAc public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCurvature public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryGlobalOdometerTransport public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryMarkedDataCovariance @@ -129,6 +132,7 @@ public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTranspor public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction public import LeanPool.ApollonianSuperharmonic.BandParentBoundaryGenealogy public import LeanPool.ApollonianSuperharmonic.BandParentRotationOccurrenceCovariance +public import LeanPool.ApollonianSuperharmonic.BandParentVectorQuarterTurn public import LeanPool.ApollonianSuperharmonic.BandPeriodicOdometer public import LeanPool.ApollonianSuperharmonic.BandPeriodicSuperharmonicity public import LeanPool.ApollonianSuperharmonic.BandPositiveCutBranchCompanionExclusion @@ -163,8 +167,10 @@ public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy public import LeanPool.ApollonianSuperharmonic.BandVectorParentSums public import LeanPool.ApollonianSuperharmonic.BandVectors public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertexDegreeTwo public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices +public import LeanPool.ApollonianSuperharmonic.BoundaryFrameJoinGeometry public import LeanPool.ApollonianSuperharmonic.BoundaryFrameRowGeometry public import LeanPool.ApollonianSuperharmonic.BoundaryJoinChamberCertificate public import LeanPool.ApollonianSuperharmonic.BoundaryString @@ -179,6 +185,7 @@ public import LeanPool.ApollonianSuperharmonic.CircleCoordinates public import LeanPool.ApollonianSuperharmonic.CircleMatrix public import LeanPool.ApollonianSuperharmonic.CircleMatrixEnclosureCriterion public import LeanPool.ApollonianSuperharmonic.CircleMatrixIncomingVector +public import LeanPool.ApollonianSuperharmonic.CircleMatrixSymmetry public import LeanPool.ApollonianSuperharmonic.ClosedSquareRealization public import LeanPool.ApollonianSuperharmonic.CommonFootprintEdgeVertices public import LeanPool.ApollonianSuperharmonic.ConnectedCommonBoundaryPath @@ -199,6 +206,7 @@ public import LeanPool.ApollonianSuperharmonic.DiamondCoordinateConfiguration public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalLattice public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalMatrixLatticeIdentification public import LeanPool.ApollonianSuperharmonic.DiamondExceptionalMaximality +public import LeanPool.ApollonianSuperharmonic.DiamondFootprintCoordinates public import LeanPool.ApollonianSuperharmonic.DiamondLaplacianTable public import LeanPool.ApollonianSuperharmonic.DiamondOdometer public import LeanPool.ApollonianSuperharmonic.DiamondOdometerExistsUnique @@ -206,6 +214,7 @@ public import LeanPool.ApollonianSuperharmonic.DiamondOpposingBoundaryStarLocali public import LeanPool.ApollonianSuperharmonic.DiamondOrientedChildParentEndpoints public import LeanPool.ApollonianSuperharmonic.DiamondParameter public import LeanPool.ApollonianSuperharmonic.DiamondPeakMatrix +public import LeanPool.ApollonianSuperharmonic.DiamondQuadraticArithmetic public import LeanPool.ApollonianSuperharmonic.DiamondRecursiveQuadruple public import LeanPool.ApollonianSuperharmonic.DiamondRegimeConverse public import LeanPool.ApollonianSuperharmonic.DiamondTerminalWebStencilLedger @@ -218,6 +227,7 @@ public import LeanPool.ApollonianSuperharmonic.DiamondVertexDomains public import LeanPool.ApollonianSuperharmonic.DisjointBoundaryCommonEdgeGraphAcyclic public import LeanPool.ApollonianSuperharmonic.DisjointSquareUnionCommonEdgeCarrier public import LeanPool.ApollonianSuperharmonic.EuclideanCircleData +public import LeanPool.ApollonianSuperharmonic.EvenSquareQuotient public import LeanPool.ApollonianSuperharmonic.ExactPatchBoundaryInterface public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceDisjointCompanionEndpoints public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple @@ -260,6 +270,8 @@ public import LeanPool.ApollonianSuperharmonic.FordExceptionalMatrixLatticeIdent public import LeanPool.ApollonianSuperharmonic.FordExceptionalMaximality public import LeanPool.ApollonianSuperharmonic.FordFareyParameter public import LeanPool.ApollonianSuperharmonic.FordFareyParentsExist +public import LeanPool.ApollonianSuperharmonic.FordFareySum +public import LeanPool.ApollonianSuperharmonic.FordInteriorSquareCoordinates public import LeanPool.ApollonianSuperharmonic.FordLaplacianTable public import LeanPool.ApollonianSuperharmonic.FordLeftBoundaryCompatibility public import LeanPool.ApollonianSuperharmonic.FordOdometer @@ -268,6 +280,7 @@ public import LeanPool.ApollonianSuperharmonic.FordOpposingBoundaryStarLocalizat public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentEndpoints public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentIncomingEndpoint public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentRightEndpoint +public import LeanPool.ApollonianSuperharmonic.FordParentVectors public import LeanPool.ApollonianSuperharmonic.FordPeakMatrix public import LeanPool.ApollonianSuperharmonic.FordRecursiveQuadruple public import LeanPool.ApollonianSuperharmonic.FordRecursiveVertexDomains @@ -283,8 +296,12 @@ public import LeanPool.ApollonianSuperharmonic.ForwardBoundaryStringData public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacianProperties +public import LeanPool.ApollonianSuperharmonic.GaussianCoordinateFacts public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurn +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurnProperties public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.GaussianReflection public import LeanPool.ApollonianSuperharmonic.GaussianTranslation public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends @@ -309,6 +326,7 @@ public import LeanPool.ApollonianSuperharmonic.IntegerSuperharmonicRepresentativ public import LeanPool.ApollonianSuperharmonic.IntegralityLattice public import LeanPool.ApollonianSuperharmonic.IntegralityLatticeIndex public import LeanPool.ApollonianSuperharmonic.IntegralityTiling +public import LeanPool.ApollonianSuperharmonic.InteriorFootprintIncidence public import LeanPool.ApollonianSuperharmonic.IsolatedPrecursorCoverage public import LeanPool.ApollonianSuperharmonic.LambdaTiling public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentInterfacePath @@ -326,14 +344,18 @@ public import LeanPool.ApollonianSuperharmonic.LatticeTileFourNeighborConnected public import LeanPool.ApollonianSuperharmonic.LatticeTileGridEulerCount public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure public import LeanPool.ApollonianSuperharmonic.LatticeTileNoCheckerboard +public import LeanPool.ApollonianSuperharmonic.LatticeTileNonempty public import LeanPool.ApollonianSuperharmonic.LatticeTileThreeDiskJunction public import LeanPool.ApollonianSuperharmonic.LatticeVertexBoundary public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.LatticeVertexSectorFacts public import LeanPool.ApollonianSuperharmonic.LeftAdjacentOdometerCompatibility public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport +public import LeanPool.ApollonianSuperharmonic.ListEndpointFacts public import LeanPool.ApollonianSuperharmonic.LocalExponentialEstimate public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors +public import LeanPool.ApollonianSuperharmonic.LocalSideScaling public import LeanPool.ApollonianSuperharmonic.MarkedOdometerAdjacencyReduction public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex @@ -352,6 +374,7 @@ public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryStarLocalization public import LeanPool.ApollonianSuperharmonic.OpposingStringInterfacePath public import LeanPool.ApollonianSuperharmonic.OppositeRoutedCommonEdgeOutsideCellUnique public import LeanPool.ApollonianSuperharmonic.OrderedGeneralOdometerAdjacencyClassification +public import LeanPool.ApollonianSuperharmonic.OrderedParentVectorSum public import LeanPool.ApollonianSuperharmonic.OrientedTouchingCovariance public import LeanPool.ApollonianSuperharmonic.OrientedUnimodularStripConcatenation public import LeanPool.ApollonianSuperharmonic.OuterLayoutTouching @@ -1096,6 +1119,7 @@ public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares public import LeanPool.ApollonianSuperharmonic.PeriodicBoundaryWebConnected public import LeanPool.ApollonianSuperharmonic.PeriodicBoundaryWebLaplacian +public import LeanPool.ApollonianSuperharmonic.PeriodicEdgeContactSymmetry public import LeanPool.ApollonianSuperharmonic.PeriodicOdometerIndicatorRigidity public import LeanPool.ApollonianSuperharmonic.PeriodicQuadraticRemainder public import LeanPool.ApollonianSuperharmonic.PeriodicSubtileFaceIndex @@ -1146,9 +1170,11 @@ public import LeanPool.ApollonianSuperharmonic.RegularTileFamilyTranslationUniqu public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacentPackingSymmetryTransport public import LeanPool.ApollonianSuperharmonic.RightSubtileOdometerCompatibility +public import LeanPool.ApollonianSuperharmonic.RootComplexCoordinates public import LeanPool.ApollonianSuperharmonic.RootedFourNeighborForest public import LeanPool.ApollonianSuperharmonic.SemiProperForestClassification public import LeanPool.ApollonianSuperharmonic.SemiProperQuadruple +public import LeanPool.ApollonianSuperharmonic.SignSquareProduct public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle public import LeanPool.ApollonianSuperharmonic.SimpleGridCycleSubgraphDegreeTwo public import LeanPool.ApollonianSuperharmonic.SimpleGridPath @@ -1183,9 +1209,11 @@ public import LeanPool.ApollonianSuperharmonic.TileBordering public import LeanPool.ApollonianSuperharmonic.TileCellComplement public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileCornerMultiplicity public import LeanPool.ApollonianSuperharmonic.TileDiskAreaCovariance public import LeanPool.ApollonianSuperharmonic.TileHalfTurn public import LeanPool.ApollonianSuperharmonic.TileHalfTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnGeometry public import LeanPool.ApollonianSuperharmonic.TileOdometer public import LeanPool.ApollonianSuperharmonic.TileOdometerAffineTranslation public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile @@ -1196,6 +1224,7 @@ public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecompositio public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness public import LeanPool.ApollonianSuperharmonic.TileQuarterTurn public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnTranslation public import LeanPool.ApollonianSuperharmonic.TileRealization public import LeanPool.ApollonianSuperharmonic.TileReflection public import LeanPool.ApollonianSuperharmonic.TileReflectionFormulas @@ -1214,8 +1243,10 @@ public import LeanPool.ApollonianSuperharmonic.TileT4ParentTranslateTouching public import LeanPool.ApollonianSuperharmonic.TileT5ParentTouching public import LeanPool.ApollonianSuperharmonic.TileTouching public import LeanPool.ApollonianSuperharmonic.TileTouchingCovariance +public import LeanPool.ApollonianSuperharmonic.TileTouchingDisjoint public import LeanPool.ApollonianSuperharmonic.TileTranslation public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.TilingLattice public import LeanPool.ApollonianSuperharmonic.TilingLatticeBasis public import LeanPool.ApollonianSuperharmonic.TilingLatticeCocycleExtension diff --git a/LeanPool/ApollonianSuperharmonic/InteriorFootprintIncidence.lean b/LeanPool/ApollonianSuperharmonic/InteriorFootprintIncidence.lean new file mode 100644 index 0000000000..0803748a7b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/InteriorFootprintIncidence.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary +public import Mathlib.Init + + +/-! +# InteriorFootprintIncidence + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace InteriorFootprintIncidence + +/-- Shared nonempty identity for InteriorFootprintIncidence. -/ +theorem nonempty : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ + BoundaryFootprintVertices T) → (T.cells.Nonempty)) ) := by + classical + intro T x hx hxb + by_contra hn + simp only [FootprintVertices, ite_eq_right hn, Set.mem_singleton_iff] at hx + apply hxb + simp [BoundaryFootprintVertices, hn, hx] + +/-- Shared someIncidentCell identity for InteriorFootprintIncidence. -/ +theorem someIncidentCell : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ + BoundaryFootprintVertices T) → ((T.cells.Nonempty) → (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T.cells))) ) := by + classical + intro T x hx hxb hne + rw [FootprintVertices, ite_eq_left hne] at hx + rcases hx with ⟨y, hy, rfl | rfl | rfl | rfl⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using hy⟩ + · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hy⟩ + · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hy⟩ + · refine ⟨2, ?_⟩ + simpa [LatticeVertexIncidentCell, sub_eq_add_neg, + add_assoc, add_comm, add_left_comm] using hy + +/-- Shared allIncidentCells identity for InteriorFootprintIncidence. -/ +theorem allIncidentCells : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∉ BoundaryFootprintVertices T) → ((∃ j : Fin + 4, LatticeVertexIncidentCell x j ∈ T.cells) → (∀ j : Fin 4, LatticeVertexIncidentCell + x j ∈ T.cells)) ) := by + classical + intro T x hxb hsome j + by_contra hj + exact hxb (P3161T2IncidentBoundary T x hsome ⟨j, hj⟩) + +end InteriorFootprintIncidence +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean index 5a7893b37f..21d0510470 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean @@ -8,9 +8,7 @@ module public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent -- [TABLET NODE: LatticeAdjacentInterfacePath] @@ -777,15 +775,6 @@ private theorem qturn_iter : _ = unitI * (unitI ^ n * z) := by rw [qturn_mul, ih] _ = unitI ^ (n + 1) * z := by rw [pow_succ]; ring -private theorem gaussianRealPoint_add : - (by - classical - exact - ∀ (x : GaussianInt), ∀ (y : GaussianInt), GaussianRealPoint (x + y) = GaussianRealPoint x - + GaussianRealPoint y ) := by - classical - intro x y - ext <;> simp [GaussianRealPoint] private theorem rotcenter : (by @@ -986,7 +975,7 @@ theorem LatticeAdjacentInterfacePath : qturn_mul n z have gaussianRealPoint_add (x y : GaussianInt) : GaussianRealPoint (x + y) = GaussianRealPoint x + GaussianRealPoint y := - LatticeInterfacePathGeometry.gaussianRealPoint_add x y + GaussianRealPointProperties.add x y have rotcenter (x y : GaussianInt) : GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * (x + y)) = GaussianRealPoint ((GaussianQuarterTurn^[s.val]) x) + diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean index b07a34249f..5540f8c8f5 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean @@ -7,8 +7,6 @@ module public import Mathlib.Init -public import LeanPool.ApollonianSuperharmonic.FourNeighborConnected -public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure -- [TABLET NODE: LatticeTileComplementGridConnected] @@ -294,34 +292,35 @@ private theorem hpNonempty : private theorem all_good : (by classical - exact + exact ∀ (T : ProtoTile), - let S : Set LatticeCell := T.cells - let step : LatticeCell → LatticeCell → Prop := fun a b => - FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S - let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step - let around (v q : LatticeCell) : Prop := - q = v ∨ q = v - 1 ∨ q = v - ⟨0, 1⟩ ∨ q = v - 1 - ⟨0, 1⟩ - ∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (p.Nodup) → (((4 : ℕ) - ≤ p.length) → ((p.head? = some x) → ((p.getLast? = some y) → - ((BoundaryFootprintVertices T = (↑p.toFinset : Set GaussianInt)) → ((∀ (a : - GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List - GaussianInt), p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → ((∀ (e : Finset - GaussianInt), e ∈ BoundaryFootprintEdges T ↔ e = {y, x} ∨ ∃ (a : GaussianInt) (b : - GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ - ∧ e = {a, b}) → (∀ (base : LatticeCell), - let good (v : LatticeCell) : Prop := - ∃ q, q ∉ S ∧ around v q ∧ reach q base - (good x) → ( - let edgeRel (a b : LatticeCell) : Prop := - FourNeighborAdjacent a b ∧ - ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T - (List.IsChain edgeRel p) → ((∀ (a : LatticeCell), ∀ (l : List LatticeCell), good a → - List.IsChain edgeRel (a :: l) → ∀ v ∈ a :: l, good v) → ((p ≠ []) → (∀ v ∈ p, good - v))))))))))) ) := by + let S : Set LatticeCell := T.cells; + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S; + let reach : LatticeCell → LatticeCell → Prop := + Relation.ReflTransGen step; + let around (v q : LatticeCell) : Prop := + q = v ∨ q = v - 1 ∨ q = v - ⟨0, 1⟩ ∨ q = v - 1 - ⟨0, 1⟩; + ∀ (p : List GaussianInt), + ∀ (x : GaussianInt), + ((p.head? = some x) → + (∀ (base : LatticeCell), + let good (v : LatticeCell) : Prop := + ∃ q, q ∉ S ∧ around v q ∧ reach q base; + (good x) → + (let edgeRel (a b : LatticeCell) : Prop := + FourNeighborAdjacent a b ∧ + ({ a, b } : Finset GaussianInt) ∈ BoundaryFootprintEdges T; + (List.IsChain edgeRel p) → + ((∀ (a : LatticeCell), + ∀ (l : List LatticeCell), + good a → + List.IsChain edgeRel (a :: l) → + ∀ v ∈ a :: l, good v) → + ((p ≠ []) → (∀ v ∈ p, good v))))))) := by classical - intro T S step reach around p x y hpNodup hpLength hpHead hpLast hpVerts hpAdjacent hpEdges - base good hgoodX edgeRel hpEdgeRel chain_good hpNonempty + intro T S step reach around p x hpHead base good hgoodX edgeRel hpEdgeRel chain_good + hpNonempty cases p with | nil => exact (hpNonempty rfl).elim | cons a l => @@ -669,8 +668,8 @@ theorem LatticeTileComplementGridConnected (T : ProtoTile) := b) ha hab have chain_good := ComplementGridPaths.chain_good T base good_step have hpNonempty := ComplementGridPaths.hpNonempty p x hpHead - have all_good := ComplementGridPaths.all_good T p x y hpNodup hpLength hpHead hpLast hpVerts - hpAdjacent hpEdges base hgoodX hpEdgeRel chain_good hpNonempty + have all_good := ComplementGridPaths.all_good T p x hpHead base hgoodX hpEdgeRel chain_good + hpNonempty have hxmem : x ∈ p := by exact List.mem_of_mem_head? (by simp [hpHead]) have hymem : y ∈ p := by diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean index 0886c1cfe9..cb9fcdd962 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean @@ -6,12 +6,10 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileCornerMultiplicity public import LeanPool.ApollonianSuperharmonic.FiniteBiconnectedHorizontalRunTree public import LeanPool.ApollonianSuperharmonic.FiniteSquareIncidenceIdentities -public import LeanPool.ApollonianSuperharmonic.FootprintEdges -public import LeanPool.ApollonianSuperharmonic.FootprintVertices -public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.LatticeTileComplementGridConnected /-! @@ -122,44 +120,6 @@ private theorem hcornerMem : rw [Multiset.mem_toFinset, Multiset.mem_bind] exact ⟨z, hz, by simp⟩ -private theorem hcornerCount : - (by - classical - exact - ∀ (T : ProtoTile), - let I : GaussianInt := ⟨0, 1⟩ - let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => - ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) - ∀ (z : GaussianInt), cornerBag.count z = (if z ∈ T.cells then 1 else 0) + (if z - 1 ∈ - T.cells then 1 else 0) + (if z - I ∈ T.cells then 1 else 0) + (if z - 1 - I ∈ T.cells - then 1 else 0) ) := by - classical - intro T I cornerBag z - dsimp only [cornerBag] - rw [Multiset.count_bind, ← Finset.sum_eq_multiset_sum] - simp only [Multiset.coe_count, List.count_cons, beq_iff_eq, - List.count_nil] - have h11 : ∀ c : GaussianInt, (c + 1 + I = z) ↔ - (c = z - 1 - I) := by - intro c - constructor <;> intro h - · rw [← h]; ring - · rw [h]; ring - have hI : ∀ c : GaussianInt, (c + I = z) ↔ (c = z - I) := by - intro c - constructor <;> intro h - · rw [← h]; ring - · rw [h]; ring - have h1 : ∀ c : GaussianInt, (c + 1 = z) ↔ (c = z - 1) := by - intro c - constructor <;> intro h - · rw [← h]; ring - · rw [h]; ring - simp_rw [h11, hI, h1] - simp only [Finset.sum_add_distrib, zero_add] - rw [Finset.sum_ite_eq', Finset.sum_ite_eq', Finset.sum_ite_eq', - Finset.sum_ite_eq'] - omega private theorem hpoint : (by @@ -448,7 +408,7 @@ theorem LatticeTileGridEulerCount (T : ProtoTile) (hT : LatticeTile T) : omega have hcornerMem {z : GaussianInt} (hz : z ∈ T.cells) := GridEulerGeometry.hcornerMem T (z := z) hz - have hcornerCount (z : GaussianInt) := GridEulerGeometry.hcornerCount T z + have hcornerCount (z : GaussianInt) := TileCornerMultiplicity.cornerCount T z have hpoint (z : GaussianInt) := GridEulerGeometry.hpoint T hcheck hcornerCount z have hAB := GridEulerGeometry.hAB T hcornerMem have hDC := GridEulerGeometry.hDC T diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileNonempty.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileNonempty.lean new file mode 100644 index 0000000000..2df1c5076f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileNonempty.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeTile +public import Mathlib.Init + + +/-! +# LatticeTileNonempty + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace LatticeTileNonempty + +/-- Shared cells identity for LatticeTileNonempty. -/ +theorem cells : + (by + classical + exact + ∀ (X : ProtoTile), (LatticeTile X) → (X.cells.Nonempty) ) := by + classical + intro X hX + unfold LatticeTile TopologicalDisk TileRealization at hX + rcases hX with ⟨e⟩ + have hp : (0 : Real × Real) ∈ + (Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) := by simp + have hm := (e ⟨(0 : Real × Real), hp⟩).property + simp only [Set.mem_iUnion] at hm + obtain ⟨x, hx⟩ := hm + exact ⟨x, by simpa [TileRealization] using hx.1⟩ + +end LatticeTileNonempty +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean index e93283b6af..89231c8f83 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean @@ -8,7 +8,6 @@ module public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple -public import LeanPool.ApollonianSuperharmonic.LatticeTile public import LeanPool.ApollonianSuperharmonic.LatticeTileDiskUnionInterface public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors public import LeanPool.ApollonianSuperharmonic.SimpleGridPathPointTrichotomy @@ -385,72 +384,6 @@ private theorem hIEeABC : (FootprintEdges AB) (FootprintEdges C) (edge_finite AB) (edge_finite C) -private theorem hcrossV : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (AB : ProtoTile), ∀ (BC : - ProtoTile), ∀ (CA : ProtoTile), ∀ (ABC : ProtoTile), (FourNeighborConnected (↑A.cells - : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑A.cells : Set LatticeCell) ∧ - SimpleGridCycle (BoundaryFootprintVertices A) (BoundaryFootprintEdges A)) → - ((FourNeighborConnected (↑B.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex - (↑B.cells : Set LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices B) - (BoundaryFootprintEdges B)) → ((FourNeighborConnected (↑C.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑C.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices C) (BoundaryFootprintEdges C)) → ((FourNeighborConnected - (↑AB.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑AB.cells : Set - LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices AB) (BoundaryFootprintEdges - AB)) → ((FourNeighborConnected (↑BC.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑BC.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices BC) (BoundaryFootprintEdges BC)) → ((FourNeighborConnected - (↑CA.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑CA.cells : Set - LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices CA) (BoundaryFootprintEdges - CA)) → ((FourNeighborConnected (↑ABC.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑ABC.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices ABC) (BoundaryFootprintEdges ABC)) → ((FootprintVertices - AB = FootprintVertices A ∪ FootprintVertices B) → (FootprintVertices AB ∩ - FootprintVertices C = (FootprintVertices A ∩ FootprintVertices C) ∪ - (FootprintVertices B ∩ FootprintVertices C))))))))) ) := by - classical - intro A B C AB BC CA ABC hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid hABCgrid hVAB - rw [hVAB] - ext z - simp only [Set.mem_inter_iff, Set.mem_union] - tauto - -private theorem hcrossE : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (AB : ProtoTile), ∀ (BC : - ProtoTile), ∀ (CA : ProtoTile), ∀ (ABC : ProtoTile), (FourNeighborConnected (↑A.cells - : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑A.cells : Set LatticeCell) ∧ - SimpleGridCycle (BoundaryFootprintVertices A) (BoundaryFootprintEdges A)) → - ((FourNeighborConnected (↑B.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex - (↑B.cells : Set LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices B) - (BoundaryFootprintEdges B)) → ((FourNeighborConnected (↑C.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑C.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices C) (BoundaryFootprintEdges C)) → ((FourNeighborConnected - (↑AB.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑AB.cells : Set - LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices AB) (BoundaryFootprintEdges - AB)) → ((FourNeighborConnected (↑BC.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑BC.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices BC) (BoundaryFootprintEdges BC)) → ((FourNeighborConnected - (↑CA.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑CA.cells : Set - LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices CA) (BoundaryFootprintEdges - CA)) → ((FourNeighborConnected (↑ABC.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑ABC.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices ABC) (BoundaryFootprintEdges ABC)) → ((FootprintEdges AB = - FootprintEdges A ∪ FootprintEdges B) → (FootprintEdges AB ∩ FootprintEdges C = - (FootprintEdges A ∩ FootprintEdges C) ∪ (FootprintEdges B ∩ FootprintEdges C))))))))) - ) := by - classical - intro A B C AB BC CA ABC hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid hABCgrid hEAB - rw [hEAB] - ext e - simp only [Set.mem_inter_iff, Set.mem_union] - tauto - private theorem hIEvCross : (by classical @@ -486,68 +419,6 @@ private theorem hIEeCross : ((edge_finite A).inter_of_left (FootprintEdges C)) ((edge_finite B).inter_of_left (FootprintEdges C)) -private theorem htripleVset : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (AB : ProtoTile), ∀ (BC : - ProtoTile), ∀ (CA : ProtoTile), ∀ (ABC : ProtoTile), (FourNeighborConnected (↑A.cells - : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑A.cells : Set LatticeCell) ∧ - SimpleGridCycle (BoundaryFootprintVertices A) (BoundaryFootprintEdges A)) → - ((FourNeighborConnected (↑B.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex - (↑B.cells : Set LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices B) - (BoundaryFootprintEdges B)) → ((FourNeighborConnected (↑C.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑C.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices C) (BoundaryFootprintEdges C)) → ((FourNeighborConnected - (↑AB.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑AB.cells : Set - LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices AB) (BoundaryFootprintEdges - AB)) → ((FourNeighborConnected (↑BC.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑BC.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices BC) (BoundaryFootprintEdges BC)) → ((FourNeighborConnected - (↑CA.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑CA.cells : Set - LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices CA) (BoundaryFootprintEdges - CA)) → ((FourNeighborConnected (↑ABC.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑ABC.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices ABC) (BoundaryFootprintEdges ABC)) → ((FootprintVertices A - ∩ FootprintVertices C) ∩ (FootprintVertices B ∩ FootprintVertices C) = - FootprintVertices A ∩ FootprintVertices B ∩ FootprintVertices C))))))) ) := by - classical - intro A B C AB BC CA ABC hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid hABCgrid - ext z - simp only [Set.mem_inter_iff] - tauto - -private theorem htripleEset : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (AB : ProtoTile), ∀ (BC : - ProtoTile), ∀ (CA : ProtoTile), ∀ (ABC : ProtoTile), (FourNeighborConnected (↑A.cells - : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑A.cells : Set LatticeCell) ∧ - SimpleGridCycle (BoundaryFootprintVertices A) (BoundaryFootprintEdges A)) → - ((FourNeighborConnected (↑B.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex - (↑B.cells : Set LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices B) - (BoundaryFootprintEdges B)) → ((FourNeighborConnected (↑C.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑C.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices C) (BoundaryFootprintEdges C)) → ((FourNeighborConnected - (↑AB.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑AB.cells : Set - LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices AB) (BoundaryFootprintEdges - AB)) → ((FourNeighborConnected (↑BC.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑BC.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices BC) (BoundaryFootprintEdges BC)) → ((FourNeighborConnected - (↑CA.cells : Set LatticeCell) ∧ NoCheckerboardCellVertex (↑CA.cells : Set - LatticeCell) ∧ SimpleGridCycle (BoundaryFootprintVertices CA) (BoundaryFootprintEdges - CA)) → ((FourNeighborConnected (↑ABC.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑ABC.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices ABC) (BoundaryFootprintEdges ABC)) → ((FootprintEdges A ∩ - FootprintEdges C) ∩ (FootprintEdges B ∩ FootprintEdges C) = FootprintEdges A ∩ - FootprintEdges B ∩ FootprintEdges C))))))) ) := by - classical - intro A B C AB BC CA ABC hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid hABCgrid - ext e - simp only [Set.mem_inter_iff] - tauto - private theorem htripleVcard : (by classical @@ -961,12 +832,14 @@ theorem LatticeTileThreeDiskJunction rw [← hEABC] at hIEeABC have hcrossV : FootprintVertices AB ∩ FootprintVertices C = (FootprintVertices A ∩ FootprintVertices C) ∪ - (FootprintVertices B ∩ FootprintVertices C) := ThreeDiskJunctionGeometry.hcrossV A B C AB - BC CA ABC hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid hABCgrid hVAB + (FootprintVertices B ∩ FootprintVertices C) := by + rw [hVAB] + exact Set.union_inter_distrib_right _ _ _ have hcrossE : FootprintEdges AB ∩ FootprintEdges C = (FootprintEdges A ∩ FootprintEdges C) ∪ - (FootprintEdges B ∩ FootprintEdges C) := ThreeDiskJunctionGeometry.hcrossE A B C AB BC CA - ABC hAgrid hBgrid hCgrid hABgrid hBCgrid hCAgrid hABCgrid hEAB + (FootprintEdges B ∩ FootprintEdges C) := by + rw [hEAB] + exact Set.union_inter_distrib_right _ _ _ rw [hcrossV] at hIEvABC rw [hcrossE] at hIEeABC have hIEvCross := ThreeDiskJunctionGeometry.hIEvCross A B C vertex_finite @@ -975,14 +848,12 @@ theorem LatticeTileThreeDiskJunction (FootprintVertices A ∩ FootprintVertices C) ∩ (FootprintVertices B ∩ FootprintVertices C) = FootprintVertices A ∩ FootprintVertices B ∩ FootprintVertices C := - ThreeDiskJunctionGeometry.htripleVset A B C AB BC CA ABC hAgrid hBgrid hCgrid hABgrid - hBCgrid hCAgrid hABCgrid + (Set.inter_inter_distrib_right _ _ _).symm have htripleEset : (FootprintEdges A ∩ FootprintEdges C) ∩ (FootprintEdges B ∩ FootprintEdges C) = FootprintEdges A ∩ FootprintEdges B ∩ FootprintEdges C := - ThreeDiskJunctionGeometry.htripleEset A B C AB BC CA ABC hAgrid hBgrid hCgrid hABgrid - hBCgrid hCAgrid hABCgrid + (Set.inter_inter_distrib_right _ _ _).symm rw [htripleVset] at hIEvCross rw [htripleEset, htripleEdges] at hIEeCross simp only [Set.ncard_empty, add_zero] at hIEeCross diff --git a/LeanPool/ApollonianSuperharmonic/LatticeVertexSectorFacts.lean b/LeanPool/ApollonianSuperharmonic/LatticeVertexSectorFacts.lean new file mode 100644 index 0000000000..bc6d4b5b28 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeVertexSectorFacts.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import Mathlib.Init + + +/-! +# LatticeVertexSectorFacts + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace LatticeVertexSectorFacts + +/-- Shared neighborDistinct identity for LatticeVertexSectorFacts. -/ +theorem neighborDistinct : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + ∀ (x : GaussianInt), ∀ (j : Fin 4), neighbor x j ≠ x ) := by + classical + intro neighbor x j + fin_cases j <;> simp [neighbor, Zsqrtd.ext_iff] + +/-- Shared edgeMembership identity for LatticeVertexSectorFacts. -/ +theorem edgeMembership : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + ∀ (x : GaussianInt), ∀ (j : Fin 4), x ∈ edgeAt x j ∧ neighbor x j ∈ edgeAt x j ) := by + classical + intro neighbor edgeAt x j + fin_cases j <;> simp [neighbor, edgeAt] + +/-- Shared edgePair identity for LatticeVertexSectorFacts. -/ +theorem edgePair : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + ∀ (x : GaussianInt), ∀ (j : Fin 4), edgeAt x j = {x, neighbor x j} ) := by + classical + intro neighbor edgeAt x j + fin_cases j <;> simp [edgeAt, neighbor, Finset.pair_comm] + +/-- Shared edgeInjective identity for LatticeVertexSectorFacts. -/ +theorem edgeInjective : + (by + classical + exact + let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := + ![{x, x + ⟨0, 1⟩}, {x - 1, x}, + {x - ⟨0, 1⟩, x}, {x, x + 1}] + (∀ (x : GaussianInt), ∀ (j : Fin 4), neighbor x j ≠ x) → ((∀ (x : GaussianInt), ∀ + {j : Fin 4}, ∀ {k : Fin 4}, (neighbor x j = neighbor x k) → (j = k)) → ((∀ (x : + GaussianInt), ∀ (j : Fin 4), x ∈ edgeAt x j ∧ neighbor x j ∈ edgeAt x j) → (∀ (x : + GaussianInt), ∀ {j : Fin 4}, ∀ {k : Fin 4}, (edgeAt x j = edgeAt x k) → (j = k)))) ) + := by + classical + intro neighbor edgeAt neighbor_ne_center neighbor_injective edgeAt_mem x j k h + have hx := (edgeAt_mem x j).1 + have hn := (edgeAt_mem x j).2 + have hnm : neighbor x j ∈ edgeAt x k := by rw [← h]; exact hn + have hchoices : neighbor x j = x ∨ neighbor x j = neighbor x k := by + fin_cases k + · simpa [edgeAt, neighbor] using hnm + · have hh : neighbor x j = x - 1 ∨ neighbor x j = x := by + simpa [edgeAt, neighbor] using hnm + exact Or.symm hh + · have hh : neighbor x j = x - ⟨0, 1⟩ ∨ neighbor x j = x := by + simpa [edgeAt, neighbor] using hnm + exact Or.symm hh + · simpa [edgeAt, neighbor] using hnm + exact neighbor_injective x (hchoices.resolve_left (neighbor_ne_center x j)) + +/-- Shared firstTileLabel identity for LatticeVertexSectorFacts. -/ +theorem firstTileLabel : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → + (outerLabel x j = 0) ) := by + classical + intro T0 T0' outerLabel x j hc + simp [outerLabel, hc] + +/-- Shared secondTileLabel identity for LatticeVertexSectorFacts. -/ +theorem secondTileLabel : + (by + classical + exact + ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), (Disjoint T0.cells T0'.cells) → ( + let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0'.cells) → + (outerLabel x j = 1)) ) := by + classical + intro T0 T0' hdis outerLabel x j hc + have hn : LatticeVertexIncidentCell x j ∉ T0.cells := + Finset.disjoint_left.mp hdis.symm hc + simp [outerLabel, hn, hc] + +end LatticeVertexSectorFacts +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ListEndpointFacts.lean b/LeanPool/ApollonianSuperharmonic/ListEndpointFacts.lean new file mode 100644 index 0000000000..49bccc472d --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ListEndpointFacts.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Init +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt + + +/-! +# ListEndpointFacts + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace ListEndpointFacts + +/-- Shared internalNeighbors identity for ListEndpointFacts. -/ +theorem internalNeighbors : + (by + classical + exact + ∀ (l : List GaussianInt), ∀ (x : GaussianInt), ∀ (h : GaussianInt), ∀ (t : GaussianInt), + l.Nodup → l.head? = some h → l.getLast? = some t → x ∈ l → x ≠ h → x ≠ t → ∃ pre y z + post, l = pre ++ y :: x :: z :: post ) := by + classical + intro l + induction l with + | nil => intro x h t hn hh ht hx; simp at hx + | cons a tail ih => + intro x h t hn hh ht hx hxh hxt + have hah : a = h := by simpa using hh + subst h + rcases List.mem_cons.mp hx with hxa | hx + · exact (hxh hxa).elim + · cases tail with + | nil => simp at hx + | cons b rest => + by_cases hxb : x = b + · subst x + have hrest : rest ≠ [] := by + intro he + subst rest + have hb : b = t := by simpa using ht + exact hxt hb + cases rest with + | nil => exact (hrest rfl).elim + | cons c u => + refine ⟨[], a, c, u, ?_⟩ + simp + · obtain ⟨pre, y, z, post, heq⟩ := + ih x b t hn.tail (by rfl) (by simpa using ht) hx hxb hxt + refine ⟨a :: pre, y, z, post, ?_⟩ + simp [heq] + +/-- A specified head belongs to its list. -/ +theorem headMembership {α : Type*} (l : List α) (a : α) + (hhead : l.head? = some a) : a ∈ l := by + cases l with + | nil => simp at hhead + | cons x xs => + simp only [List.head?_cons, Option.some.injEq] at hhead + subst x + simp + +/-- Zipping lists with specified heads separates the first pair. -/ +theorem zipHeadShape {α β : Type*} (left : List α) (right : List β) + (a : α) (b : β) (hleft : left.head? = some a) + (hright : right.head? = some b) : + left.zip right = [(a, b)] ++ left.tail.zip right.tail := by + cases left with + | nil => simp at hleft + | cons x xs => + cases right with + | nil => simp at hright + | cons y ys => + simp only [List.head?_cons, Option.some.injEq] at hleft hright + subst x + subst y + rfl + +/-- Replacing a list's last entry by a list starting there preserves its head. -/ +theorem headDropLastAppend {α : Type*} (left right : List α) (a b : α) + (hhead : left.head? = some a) (hlast : left.getLast? = some b) + (hright : right.head? = some b) : (left.dropLast ++ right).head? = some a := by + cases left with + | nil => simp at hhead + | cons x xs => cases xs <;> simp_all + +/-- Appending a nonempty final list preserves its last entry. -/ +theorem lastDropLastAppend {α : Type*} (left right : List α) (a : α) + (hlast : right.getLast? = some a) : (left.dropLast ++ right).getLast? = some a := by + cases right with + | nil => simp at hlast + | cons x xs => simpa using hlast + +/-- A nodup list's indexed entry does not occur in its preceding prefix. -/ +theorem getNotTake {α : Type*} (l : List α) (hn : l.Nodup) (m : Nat) + (hm : m < l.length) : l.get ⟨m, hm⟩ ∉ l.take m := by + intro hmem + rcases List.mem_take_iff_getElem.mp hmem with ⟨i, hi, heq⟩ + have hi' : i < m := by omega + have hiList : i < l.length := lt_trans hi' hm + have heq' : l[i] = l[m] := by simpa using heq + have hidx := hn.getElem_inj_iff.mp heq' + omega + +end ListEndpointFacts +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LocalSideScaling.lean b/LeanPool/ApollonianSuperharmonic/LocalSideScaling.lean new file mode 100644 index 0000000000..29cfffbc05 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LocalSideScaling.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3934T1LocalSide +public import Mathlib.Init + + +/-! +# LocalSideScaling + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace LocalSideScaling + +/-- Shared positiveScale identity for LocalSideScaling. -/ +theorem positiveScale : + (by + classical + exact + ∀ (W : Set (ℝ × ℝ)), ∀ (z : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (c : ℝ), ∀ (e : Bool), (0 : ℝ) < c → + P3934T1LocalSide W z w e → P3934T1LocalSide W z (c • w) e ) := by + classical + intro W z w c e hc hside + obtain ⟨r, hr, heq⟩ := hside + refine ⟨r, hr, ?_⟩ + have hdet (q : Real × Real) : + (c • w).1 * (q.2 - z.2) - (c • w).2 * (q.1 - z.1) = + c * (w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1)) := by + simp only [Prod.smul_fst, Prod.smul_snd] + ring + ext q + rw [heq] + simp only [Set.mem_ofPred_eq] + rw [hdet q] + constructor + · rintro ⟨hq, hs⟩ + refine ⟨hq, ?_⟩ + cases e <;> simp at hs ⊢ <;> + nlinarith [hc] + · rintro ⟨hq, hs⟩ + refine ⟨hq, ?_⟩ + cases e <;> simp at hs ⊢ <;> + nlinarith [hc] + +end LocalSideScaling +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean index 44b38d1295..5e1f9376be 100644 --- a/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean @@ -10,13 +10,7 @@ public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.P5630T1MarkedRightOdometerAdjacencyReduction public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileSelectedRowGeometry public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileNormalizedBundleExists -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction -public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacentPackingSymmetryTransport -public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.SubtileLatticeAdjacent -public import LeanPool.ApollonianSuperharmonic.TileSubodometer -public import LeanPool.ApollonianSuperharmonic.TileTranslation -- [TABLET NODE: MarkedOdometerAdjacencyReduction] @@ -109,61 +103,31 @@ private theorem hr₀ : private theorem hrᵢ : (by classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : - Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : - PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (p₀ : ℝ × ℝ), ∀ - (pᵢ : ℝ × ℝ), (q i.succ = Cᵢ.1.1) → ((TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) - • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 - (q i.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)))) - → ((pᵢ.1 - p₀.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))) + - BandVectors.2 (q (0 : Fin (4 : ℕ))) (q i.succ)))).1) → ((pᵢ.2 - p₀.2 = ((1 / 2 : ℝ) • - GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 - (q i.succ) (q (0 : Fin (4 : ℕ))) + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q - i.succ)))).2) → (∀ (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ - h₀ hᵢ x), - let g := bundle.symmetry - let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j - (0 < (q i.succ).1) → ((TileOdometer (q i.succ) Tᵢ hᵢ) → (∀ (transportedRootSlope : ℝ × - ℝ), ∀ (transportedFixedSlope : ℝ × ℝ), ∀ (transportedRotation : Fin (4 : ℕ)), - (TileOdometer (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) - (BandPackingSymmetryTileAction g Tᵢ) (BandPackingSymmetryPartialOdometerAction g hᵢ)) - → ((TileCentroid (BandPackingSymmetryTileAction g Tᵢ) - TileCentroid - (BandPackingSymmetryTileAction g T₀) = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 - : ℤ)⟩ : GaussianInt) ^ (↑transportedRotation : ℕ) * (BandVectors.1 - (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + BandVectors.1 - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))) → - ((transportedFixedSlope.1 - transportedRootSlope.1 = ((1 / 2 : ℝ) • GaussianRealPoint - ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑transportedRotation : ℕ) * (BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))).1) → - ((transportedFixedSlope.2 - transportedRootSlope.2 = ((1 / 2 : ℝ) • GaussianRealPoint - ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑transportedRotation : ℕ) * (BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))).2) → - (normalizationPresentation (sigma i).succ = - bundle.normalizedFixedCircle.1.1)))))))))) ) := by - classical - intro C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x p₀ pᵢ hqᵢ hcentroid hslopex hslopey bundle g - normalizationPresentation sigma hparentPositive hOᵢq transportedRootSlope - transportedFixedSlope transportedRotation hfixedOdometer hcentroidForward hslopeXForward - hslopeYForward + exact + ∀ (C₀ : BandCircle), + ∀ (Cᵢ : BandCircle), + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), + ∀ (T₀ : ProtoTile), + ∀ (Tᵢ : ProtoTile), + ∀ (h₀ : PartialOdometer), + ∀ (hᵢ : PartialOdometer), + ∀ (x : GaussianInt), + (q i.succ = Cᵢ.1.1) → + (∀ + (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ + T₀ Tᵢ h₀ hᵢ x), + let g := bundle.symmetry; + let normalizationPresentation := + BandPackingSymmetryQuadrupleAction g q; + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j + else j; + (normalizationPresentation (sigma i).succ = + bundle.normalizedFixedCircle.1.1))) := by + classical + intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x hqᵢ bundle g normalizationPresentation sigma have hact := congrArg (BandPackingSymmetryCircleAction g) hqᵢ have hcoord : (BandPackingSymmetryQuadrupleAction g q) (sigma i).succ = @@ -491,20 +455,6 @@ private theorem hnormAt536 : simp [BandPackingSymmetryQuadrupleAction, bundle.presentation_child] -private theorem actionCurvature : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (c : CircleCoordinates), (BandPackingSymmetryCircleAction - g c).1 = c.1 ) := by - classical - intro g - induction g with - | identity => intro c; rfl - | negate => intro c; rfl - | conjugate => intro c; rfl - | shift w => intro c; rfl - | comp a b iha ihb => intro c; simp [BandPackingSymmetryCircleAction, iha, ihb] private theorem hinverseCoordinate : (by @@ -2007,85 +1957,57 @@ private theorem hOFixedOriginalAt1322 : private theorem hselectedCoordAt1327 : (by classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : - Fin (3 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ - : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), - let g := bundle.symmetry - let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j - ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), (0 < (r j.succ).1) → (∀ - (transportedRotation : Fin (4 : ℕ)), ∀ (C' : BandCircle), ∀ (selectedSlope : ℝ × ℝ), - ∀ (ginv : BandPackingSymmetry), - let inversePresentation := - BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation - let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then - -bundle.selectedSlot else bundle.selectedSlot - ∀ (hinverseProper : ProperBandQuadruple inversePresentation), ∀ (hinversePositive : 0 < - (inversePresentation inverseSlot.succ).1), - let inverseCircle : BandCircle := - ⟨⟨inversePresentation inverseSlot.succ, - ⟨Or.inl hinversePositive, inversePresentation, hinverseProper.1, - ⟨inverseSlot.succ, rfl⟩⟩⟩, hinversePositive⟩ - (inverseCircle.1.1 = BandPackingSymmetryCircleAction ginv C'.1.1) → ( - let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign - let selectedFunction := bundle.functions bundle.selectedSlot bundle.selectedSign - ∀ (t : Fin (4 : ℕ)), (r j.succ = C'.1.1) → ((TileCentroid (bundle.pieces - bundle.selectedSlot bundle.selectedSign) - TileCentroid bundle.normalizedFixed = (1 / - 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t : ℕ) * - (BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) - (r j.succ)))) → ((selectedSlope.1 - bundle.normalizedFixedSlope.1 = (1 / 2 : ℝ) * - (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t : ℕ) * (BandVectors.2 - (r j.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r - j.succ)))).1) → ((selectedSlope.2 - bundle.normalizedFixedSlope.2 = (1 / 2 : ℝ) * - (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t : ℕ) * (BandVectors.2 - (r j.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r - j.succ)))).2) → ((bundle.normalizedPoint ∈ FootprintVertices (TileTranslation - bundle.normalizedRoot ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑transportedRotation : - ℕ) * if Even (↑transportedRotation : ℕ) then BandVectors.1 (normalizationPresentation - (0 : Fin (4 : ℕ))) (normalizationPresentation (sigma i).succ) else BandVectors.1 - (normalizationPresentation (sigma i).succ) (normalizationPresentation (0 : Fin (4 : - ℕ))))) ↔ bundle.normalizedPoint ∈ FootprintVertices (TileTranslation - bundle.normalizedFixed ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t : ℕ) * if Even (↑t : - ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r j.succ) else BandVectors.1 (r j.succ) - (r (0 : Fin (4 : ℕ)))))) → ((TileOdometer (r j.succ) selectedSupport - selectedFunction) → (∀ (pFixed : ℝ × ℝ), ∀ (pSelected : ℝ × ℝ), ∀ (t' : Fin (4 : ℕ)), - (TileOdometer (BandPackingSymmetryQuadrupleAction ginv r (if - BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) - (BandPackingSymmetryTileAction ginv selectedSupport) - (BandPackingSymmetryPartialOdometerAction ginv selectedFunction)) → ((TileCentroid - (BandPackingSymmetryTileAction ginv selectedSupport) - TileCentroid - (BandPackingSymmetryTileAction ginv bundle.normalizedFixed) = (1 / 2 : ℝ) • - GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t' : ℕ) * (BandVectors.1 - (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation - ginv = true then -j else j).succ) (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin - (4 : ℕ))) + BandVectors.1 (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : - ℕ))) (BandPackingSymmetryQuadrupleAction ginv r (if - BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ)))) → - ((pSelected.1 - pFixed.1 = (1 / 2 : ℝ) * (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt)) ^ (↑t' : ℕ) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv r - (if BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) - (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + BandVectors.2 - (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation - ginv = true then -j else j).succ)))).1) → ((pSelected.2 - pFixed.2 = (1 / 2 : ℝ) * - (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t' : ℕ) * - (BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv r (if - BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) - (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + BandVectors.2 - (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation - ginv = true then -j else j).succ)))).2) → ((BandPackingSymmetryQuadrupleAction ginv - r) (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ = - inverseCircle.1.1)))))))))))) ) := by - classical - intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma r j hparentPositive - transportedRotation C' selectedSlope ginv inversePresentation inverseSlot hinverseProper - hinversePositive inverseCircle hinverseCircle selectedSupport selectedFunction t hrj hcent - hslopeRe hslopeIm hmarked hOselected pFixed pSelected t' hOSelectedInv hcentInv hslopeReInv - hslopeImInv + exact + ∀ (C₀ : BandCircle), + ∀ (Cᵢ : BandCircle), + ∀ (T₀ : ProtoTile), + ∀ (Tᵢ : ProtoTile), + ∀ (h₀ : PartialOdometer), + ∀ (hᵢ : PartialOdometer), + ∀ (x : GaussianInt), + ∀ + (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ + h₀ hᵢ x), + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), + ∀ (j : Fin (3 : ℕ)), + (∀ (C' : BandCircle), + ∀ (ginv : BandPackingSymmetry), + let inversePresentation := + BandPackingSymmetryQuadrupleAction ginv + bundle.normalizedPresentation; + let inverseSlot := + if + BandPackingSymmetryReversesOrientation + ginv then + -bundle.selectedSlot + else bundle.selectedSlot; + ∀ + (hinverseProper : + ProperBandQuadruple inversePresentation), + ∀ + (hinversePositive : + 0 < (inversePresentation inverseSlot.succ).1), + let inverseCircle : BandCircle := + ⟨⟨inversePresentation inverseSlot.succ, + ⟨Or.inl hinversePositive, + inversePresentation, hinverseProper.1, + ⟨inverseSlot.succ, rfl⟩⟩⟩, + hinversePositive⟩; + (inverseCircle.1.1 = + BandPackingSymmetryCircleAction ginv + C'.1.1) → + ((r j.succ = C'.1.1) → + ((BandPackingSymmetryQuadrupleAction ginv r) + (if + BandPackingSymmetryReversesOrientation + ginv then + -j + else j).succ = + inverseCircle.1.1)))) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle r j C' ginv inversePresentation inverseSlot hinverseProper + hinversePositive inverseCircle hinverseCircle hrj have neg1 : -(1 : Fin 3) = 2 := rfl have neg2 : -(2 : Fin 3) = 1 := rfl calc @@ -2423,74 +2345,36 @@ private theorem hselectedCoordAt1468 : private theorem hfixedCoord : (by classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : - Fin (3 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ - : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), - let g := bundle.symmetry - let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j - ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), (0 < (r j.succ).1) → (∀ - (transportedRotation : Fin (4 : ℕ)), ∀ (selectedSlope : ℝ × ℝ), ∀ (ginv : - BandPackingSymmetry), (∀ (C : CircleCoordinates), BandPackingSymmetryCircleAction - ginv (BandPackingSymmetryCircleAction bundle.symmetry C) = C) → ( - let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign - ∀ (t : Fin (4 : ℕ)), (r j.succ = bundle.normalizedFixedCircle.1.1) → ((TileCentroid - bundle.normalizedFixed - TileCentroid - (bundle.pieces bundle.selectedSlot bundle.selectedSign) = (1 / 2 : ℝ) • - GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t : ℕ) * (BandVectors.1 (r - j.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r j.succ)))) → - ((bundle.normalizedFixedSlope.1 - selectedSlope.1 = (1 / 2 : ℝ) * (GaussianRealPoint - ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t : ℕ) * (BandVectors.2 (r j.succ) (r (0 : - Fin (4 : ℕ))) + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ)))).1) → - ((bundle.normalizedFixedSlope.2 - selectedSlope.2 = (1 / 2 : ℝ) * (GaussianRealPoint - ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t : ℕ) * (BandVectors.2 (r j.succ) (r (0 : - Fin (4 : ℕ))) + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ)))).2) → - ((bundle.normalizedPoint ∈ FootprintVertices (TileTranslation bundle.normalizedRoot - ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑transportedRotation : ℕ) * if Even - (↑transportedRotation : ℕ) then BandVectors.1 (normalizationPresentation (0 : Fin (4 - : ℕ))) (normalizationPresentation (sigma i).succ) else BandVectors.1 - (normalizationPresentation (sigma i).succ) (normalizationPresentation (0 : Fin (4 : - ℕ))))) ↔ bundle.normalizedPoint ∈ FootprintVertices (TileTranslation (bundle.pieces - bundle.selectedSlot bundle.selectedSign) ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑t : - ℕ) * if Even (↑t : ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r j.succ) else - BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ)))))) → ((TileOdometer (r j.succ) - bundle.normalizedFixed bundle.normalizedFixedFunction) → (∀ (pSelected : ℝ × ℝ), ∀ - (pFixed : ℝ × ℝ), ∀ (t' : Fin (4 : ℕ)), (TileOdometer - (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation - ginv = true then -j else j).succ) (BandPackingSymmetryTileAction ginv - bundle.normalizedFixed) (BandPackingSymmetryPartialOdometerAction ginv - bundle.normalizedFixedFunction)) → ((TileCentroid (BandPackingSymmetryTileAction ginv - bundle.normalizedFixed) - TileCentroid (BandPackingSymmetryTileAction ginv - selectedSupport) = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ^ (↑t' : ℕ) * (BandVectors.1 (BandPackingSymmetryQuadrupleAction ginv r - (if BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) - (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + BandVectors.1 - (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation - ginv = true then -j else j).succ)))) → ((pFixed.1 - pSelected.1 = (1 / 2 : ℝ) * - (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t' : ℕ) * - (BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv r (if - BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) - (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + BandVectors.2 - (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation - ginv = true then -j else j).succ)))).1) → ((pFixed.2 - pSelected.2 = (1 / 2 : ℝ) * - (GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑t' : ℕ) * - (BandVectors.2 (BandPackingSymmetryQuadrupleAction ginv r (if - BandPackingSymmetryReversesOrientation ginv = true then -j else j).succ) - (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) + BandVectors.2 - (BandPackingSymmetryQuadrupleAction ginv r (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction ginv r (if BandPackingSymmetryReversesOrientation - ginv = true then -j else j).succ)))).2) → ((BandPackingSymmetryQuadrupleAction ginv - r) (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ = - Cᵢ.1.1)))))))))))) ) := by - classical - intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma r j hparentPositive - transportedRotation selectedSlope ginv hcircleL selectedSupport t hrj hcent hslopeRe - hslopeIm hmarked hOfixed pSelected pFixed t' hOFixedInv hcentInv hslopeReInv hslopeImInv + exact + ∀ (C₀ : BandCircle), + ∀ (Cᵢ : BandCircle), + ∀ (T₀ : ProtoTile), + ∀ (Tᵢ : ProtoTile), + ∀ (h₀ : PartialOdometer), + ∀ (hᵢ : PartialOdometer), + ∀ (x : GaussianInt), + ∀ + (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ + h₀ hᵢ x), + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), + ∀ (j : Fin (3 : ℕ)), + (∀ (ginv : BandPackingSymmetry), + (∀ (C : CircleCoordinates), + BandPackingSymmetryCircleAction ginv + (BandPackingSymmetryCircleAction + bundle.symmetry C) = + C) → + ((r j.succ = bundle.normalizedFixedCircle.1.1) → + ((BandPackingSymmetryQuadrupleAction ginv r) + (if + BandPackingSymmetryReversesOrientation + ginv then + -j + else j).succ = + Cᵢ.1.1)))) := by + classical + intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle r j ginv hcircleL hrj have neg1 : -(1 : Fin 3) = 2 := rfl have neg2 : -(2 : Fin 3) = 1 := rfl calc @@ -3141,11 +3025,9 @@ private theorem forwardAdjacencyCase : have hselectedCoord : (BandPackingSymmetryQuadrupleAction ginv r) (if BandPackingSymmetryReversesOrientation ginv then -j else j).succ = - inverseCircle.1.1 := MarkedAdjacencyGeometry.hselectedCoordAt1327 C₀ Cᵢ q i T₀ Tᵢ - h₀ hᵢ x bundle r j hparentPositive transportedRotation C' selectedSlope ginv - hinverseProper hinversePositive hinverseCircle t hrj hcent hslopeRe hslopeIm - hmarked hOselected pFixed pSelected t' hOSelectedInv hcentInv hslopeReInv - hslopeImInv + inverseCircle.1.1 := MarkedAdjacencyGeometry.hselectedCoordAt1327 C₀ Cᵢ T₀ Tᵢ + h₀ hᵢ x bundle r j C' ginv + hinverseProper hinversePositive hinverseCircle hrj have hOSelectedOriginal : TileOdometer inverseCircle.1.1 T' h' := by simpa [hselectedCoord, h', T'] using hOSelectedInv have hslopeFixedOriginal : PartialOdometerSlope hᵢ = some pFixed := by @@ -3342,9 +3224,8 @@ private theorem reverseAdjacencyCase : (BandPackingSymmetryQuadrupleAction ginv r) 0 = inverseCircle.1.1 := MarkedAdjacencyGeometry.hselectedCoordAt1468 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle C' ginv hinverseProper hinversePositive hinverseCircle r hr0 - have hfixedCoord := MarkedAdjacencyGeometry.hfixedCoord C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle r j - hparentPositive transportedRotation selectedSlope ginv hcircleL t hrj hcent hslopeRe - hslopeIm hmarked hOfixed pSelected pFixed t' hOFixedInv hcentInv hslopeReInv hslopeImInv + have hfixedCoord := MarkedAdjacencyGeometry.hfixedCoord C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle r j ginv + hcircleL hrj have hOSelectedOriginal : TileOdometer inverseCircle.1.1 T' h' := by simpa [hselectedCoord, T', h'] using hOSelectedInv have hOFixedOriginal := MarkedAdjacencyGeometry.hOFixedOriginalAt1498 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x @@ -3593,9 +3474,7 @@ theorem MarkedOdometerAdjacencyReduction : hᵢ x horbit bundle) normalizationPresentation (sigma i) transportedRotation hnormalizedProper (MarkedAdjacencyGeometry.hr₀ C₀ Cᵢ q T₀ Tᵢ h₀ hᵢ x hq₀ bundle hnorm) - (MarkedAdjacencyGeometry.hrᵢ C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x p₀ pᵢ hqᵢ hcentroid hslopex - hslopey bundle hparentPositive hOᵢq transportedRootSlope transportedFixedSlope - transportedRotation hfixedOdometer hcentroidForward hslopeXForward hslopeYForward) + (MarkedAdjacencyGeometry.hrᵢ C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x hqᵢ bundle) (MarkedAdjacencyGeometry.hnormalizedCentroid C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle transportedRotation hcentroidForward) (MarkedAdjacencyGeometry.hnormalizedSlopeX C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle @@ -3612,7 +3491,7 @@ theorem MarkedOdometerAdjacencyReduction : htileR, hvecL, hvecR, hfunL, hfunR, hphase⟩ := (BandPackingSymmetryInversePhaseCancellation.2 bundle.symmetry) have hnorm := MarkedAdjacencyGeometry.hnormAt536 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle - have actionCurvature := MarkedAdjacencyGeometry.actionCurvature + have actionCurvature := BandPackingSymmetryCurvature.preserved let inversePresentation := BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean index 79a27e027a..e4090751b6 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean @@ -9,12 +9,9 @@ public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.AncestorOdometerCentralCovariance public import LeanPool.ApollonianSuperharmonic.AncestorOdometerOuterSupportNormalization -public import LeanPool.ApollonianSuperharmonic.AncestorOdometer public import LeanPool.ApollonianSuperharmonic.BoundaryStringOdometerRespect -public import LeanPool.ApollonianSuperharmonic.BoundaryString public import LeanPool.ApollonianSuperharmonic.ForwardBoundaryStringData public import LeanPool.ApollonianSuperharmonic.OdometerStringRespectRegularFamilyCentralCovariance -public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect public import LeanPool.ApollonianSuperharmonic.TileStringRegularFamilyCentralCovariance -- [TABLET NODE: OpposingBoundaryOdometerStrings] @@ -1176,32 +1173,46 @@ private theorem hgsHead : private theorem hgsLast : (by classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), (BandCircle) → ((BandCircle) → (∀ (i : Fin 3), - (ProtoTile) → (∀ (tiles : List ProtoTile), ∀ (hseed : PartialOdometer), (Fin (4 : ℕ) - → CircleCoordinates) → (∀ (centerShift : GaussianInt), - let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) - let hminus := PartialOdometerAffineTranslate hseed 0 d 0 - (GaussianInt) → (∀ (couter : GaussianInt), ∀ (eouter : ℤ), - let a : GaussianInt := -couter - let b : Int := -eouter - let hplus := PartialOdometerAffineTranslate - (PartialOdometerHalfTurn hminus) centerShift a 0 - ∀ (eback : ℤ), - let bplus : Int := -eback - let hminusBack := PartialOdometerAffineTranslate - (PartialOdometerHalfTurn hplus) centerShift a bplus - (hminus = hminusBack) → ((2 ≤ tiles.length) → (∀ (hs : List PartialOdometer), - (hs.getLast? = some hplus) → ((hs.length = tiles.length) → ( - let constAt : Nat → Int := fun n => - if n = 0 then 0 else if n + 1 = hs.length then bplus else b - let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => - PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) - let gs := hs.mapIdx transformAt - gs.getLast? = some hminus))))))))) ) := by - classical - intro q C₀ Cᵢ i T₀' tiles hseed q' centerShift d hminus touter couter eouter a b hplus eback - bplus hminusBack hminusBackEq htilesLength hs hhsLast hlengthEq constAt transformAt gs + exact + ∀ (q : Fin 4 → CircleCoordinates), + (∀ (i : Fin 3), + (∀ (tiles : List ProtoTile), + ∀ (hseed : PartialOdometer), + (∀ (centerShift : GaussianInt), + let d : GaussianInt := + -BandVectors.2 (q ((i + 1).succ)) (q i.succ); + let hminus := PartialOdometerAffineTranslate hseed 0 d 0; + (∀ (couter : GaussianInt), + ∀ (eouter : ℤ), + let a : GaussianInt := -couter; + let b : Int := -eouter; + let hplus := + PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hminus) centerShift a 0; + ∀ (eback : ℤ), + let bplus : Int := -eback; + let hminusBack := + PartialOdometerAffineTranslate + (PartialOdometerHalfTurn hplus) centerShift a bplus; + (hminus = hminusBack) → + ((2 ≤ tiles.length) → + (∀ (hs : List PartialOdometer), + (hs.getLast? = some hplus) → + ((hs.length = tiles.length) → + (let constAt : Nat → Int := fun n => + if n = 0 then 0 + else if n + 1 = hs.length then bplus else b; + let transformAt : + Nat → PartialOdometer → PartialOdometer := + fun n h => + PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a + (constAt n); + let gs := hs.mapIdx transformAt; + gs.getLast? = some hminus))))))))) := by + classical + intro q i tiles hseed centerShift d hminus couter eouter a b hplus eback bplus hminusBack + hminusBackEq htilesLength hs hhsLast hlengthEq constAt transformAt gs rw [List.getLast?_mapIdx, hhsLast] have hlastIndex : hs.length - 1 + 1 = hs.length := by omega have hlastNotZero : hs.length - 1 ≠ 0 := by omega @@ -1306,46 +1317,34 @@ private theorem interiorTransforms : private theorem hgsTail : (by classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (horientationExists : ∃ o : Bool, - Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), - let orientation := Classical.choose horientationExists - ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List - ProtoTile), ∀ (hseed : PartialOdometer), ∀ (centerShift : GaussianInt), - let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) - let hminus := PartialOdometerAffineTranslate hseed 0 d 0 - ∀ (couter : GaussianInt), ∀ (eouter : ℤ), - let a : GaussianInt := -couter - let b : Int := -eouter - let hplus := PartialOdometerAffineTranslate - (PartialOdometerHalfTurn hminus) centerShift a 0 - ∀ (eback : ℤ), - let bplus : Int := -eback - ∀ (hs : List PartialOdometer), (hs.head? = some hminus) → ((hs.getLast? = some hplus) → - ((OdometerStringRespect Cᵢ orientation base Rminus Rplus tiles hs) → ((∀ T ∈ - (List.drop (1 : ℕ) tiles).dropLast, ∃ (h : PartialOdometer), (T, h) ∈ tiles.zip hs ∧ - AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀ h h₀) → ((hs.length = tiles.length) → ((2 ≤ - hs.length) → ( - let constAt : Nat → Int := fun n => - if n = 0 then 0 else if n + 1 = hs.length then bplus else b - let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => - PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) - let gs := hs.mapIdx transformAt - (∀ n, ∀ l, List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a c) l (l.mapIdx (fun j h => transformAt (n + - j) h))) → ((List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a c) hs gs) → ((gs.head? = some hplus) → - ((gs.getLast? = some hminus) → ((∀ n, ∀ (l : List PartialOdometer), 0 < n → hs.length - = n + l.length → List.Forall₂ (fun h g => g = PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a b) l.dropLast ((l.mapIdx (fun j h => - transformAt (n + j) h)).dropLast)) → (gs.drop 1 = hs.tail.mapIdx (fun j h => - transformAt (1 + j) h)))))))))))) ) := by - classical - intro q C₀ Cᵢ i T₀ h₀ horientationExists orientation base Rminus Rplus tiles hseed centerShift - d hminus couter eouter a b hplus eback bplus hs hhsHead hhsLast hrespect hancestorForward - hlengthEq hlengthHs constAt transformAt gs transformForall htransform hgsHead hgsLast - interiorTransforms + exact + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (i : Fin 3), + ∀ (hseed : PartialOdometer), + ∀ (centerShift : GaussianInt), + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ); + let hminus := PartialOdometerAffineTranslate hseed 0 d 0; + ∀ (couter : GaussianInt), + ∀ (eouter : ℤ), + let a : GaussianInt := -couter; + let b : Int := -eouter; + ∀ (eback : ℤ), + let bplus : Int := -eback; + ∀ (hs : List PartialOdometer), + (hs.head? = some hminus) → + (let constAt : Nat → Int := fun n => + if n = 0 then 0 + else if n + 1 = hs.length then bplus else b; + let transformAt : + Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a (constAt n); + let gs := hs.mapIdx transformAt; + (gs.drop 1 = + hs.tail.mapIdx (fun j h => transformAt (1 + j) h)))) := by + classical + intro q i hseed centerShift d hminus couter eouter a b eback bplus hs hhsHead constAt + transformAt gs change (List.mapIdx transformAt hs).drop 1 = _ cases hs with | nil => simp at hhsHead @@ -1354,47 +1353,16 @@ private theorem hgsTail : private theorem htailLength : (by classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), (ProtoTile) → (∀ (h₀ : PartialOdometer), ∀ - (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), - let orientation := Classical.choose horientationExists - ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List - ProtoTile), ∀ (hseed : PartialOdometer), (Fin (4 : ℕ) → CircleCoordinates) → (∀ - (centerShift : GaussianInt), - let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) - let hminus := PartialOdometerAffineTranslate hseed 0 d 0 - (GaussianInt) → (∀ (couter : GaussianInt), ∀ (eouter : ℤ), - let a : GaussianInt := -couter - let b : Int := -eouter - let hplus := PartialOdometerAffineTranslate - (PartialOdometerHalfTurn hminus) centerShift a 0 - ∀ (eback : ℤ), - let bplus : Int := -eback - ∀ (hs : List PartialOdometer), (hs.head? = some hminus) → ((hs.getLast? = some hplus) → - ((OdometerStringRespect Cᵢ orientation base Rminus Rplus tiles hs) → ((∀ T ∈ - (List.drop (1 : ℕ) tiles).dropLast, ∃ (h : PartialOdometer), (T, h) ∈ tiles.zip hs ∧ - AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀ h h₀) → ((hs.length = tiles.length) → ((2 ≤ - hs.length) → ( - let constAt : Nat → Int := fun n => - if n = 0 then 0 else if n + 1 = hs.length then bplus else b - let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => - PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) - let gs := hs.mapIdx transformAt - (∀ n, ∀ l, List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a c) l (l.mapIdx (fun j h => transformAt (n + - j) h))) → ((List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a c) hs gs) → ((gs.head? = some hplus) → - ((gs.getLast? = some hminus) → ((∀ n, ∀ (l : List PartialOdometer), 0 < n → hs.length - = n + l.length → List.Forall₂ (fun h g => g = PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a b) l.dropLast ((l.mapIdx (fun j h => - transformAt (n + j) h)).dropLast)) → ((gs.drop 1 = hs.tail.mapIdx (fun j h => - transformAt (1 + j) h)) → (hs.length = 1 + hs.tail.length))))))))))))))) ) := by - classical - intro q C₀ Cᵢ i T₀ T₀' h₀ horientationExists orientation base Rminus Rplus tiles hseed q' - centerShift d hminus touter couter eouter a b hplus eback bplus hs hhsHead hhsLast hrespect - hancestorForward hlengthEq hlengthHs constAt transformAt gs transformForall htransform - hgsHead hgsLast interiorTransforms hgsTail + exact + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (i : Fin 3), + (∀ (hseed : PartialOdometer), + (let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ); + let hminus := PartialOdometerAffineTranslate hseed 0 d 0; + (∀ (hs : List PartialOdometer), + (hs.head? = some hminus) → (hs.length = 1 + hs.tail.length))))) := by + classical + intro q i hseed d hminus hs hhsHead cases hs with | nil => simp at hhsHead | cons x xs => simp [List.length_cons, List.tail]; omega @@ -1402,30 +1370,46 @@ private theorem htailLength : private theorem hinteriorTransforms : (by classical - exact - (BandCircle) → ((BandCircle) → ((Fin 3) → ((ProtoTile) → ((List ProtoTile) → ((Fin (4 : - ℕ) → CircleCoordinates) → (∀ (centerShift : GaussianInt), (GaussianInt) → (∀ (couter - : GaussianInt), ∀ (eouter : ℤ), - let a : GaussianInt := -couter - let b : Int := -eouter - ∀ (eback : ℤ), - let bplus : Int := -eback - ∀ (hs : List PartialOdometer), - let constAt : Nat → Int := fun n => - if n = 0 then 0 else if n + 1 = hs.length then bplus else b - let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => - PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) - let gs := hs.mapIdx transformAt - (∀ n, ∀ (l : List PartialOdometer), 0 < n → hs.length = n + l.length → List.Forall₂ (fun - h g => g = PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a - b) l.dropLast ((l.mapIdx (fun j h => transformAt (n + j) h)).dropLast)) → ((gs.drop 1 - = hs.tail.mapIdx (fun j h => transformAt (1 + j) h)) → ((hs.length = 1 + - hs.tail.length) → (List.Forall₂ (fun h g => g = PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a b) ((hs.drop 1).dropLast) ((gs.drop - 1).dropLast))))))))))) ) := by - classical - intro C₀ Cᵢ i T₀' tiles q' centerShift touter couter eouter a b eback bplus hs constAt - transformAt gs interiorTransforms hgsTail htailLength + exact + (∀ (centerShift : GaussianInt), + (∀ (couter : GaussianInt), + ∀ (eouter : ℤ), + let a : GaussianInt := -couter; + let b : Int := -eouter; + ∀ (eback : ℤ), + let bplus : Int := -eback; + ∀ (hs : List PartialOdometer), + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b; + let transformAt : Nat → PartialOdometer → PartialOdometer := + fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) + centerShift a (constAt n); + let gs := hs.mapIdx transformAt; + (∀ n, + ∀ (l : List PartialOdometer), + 0 < n → + hs.length = n + l.length → + List.Forall₂ + (fun h g => + g = + PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a b) + l.dropLast + ((l.mapIdx + (fun j h => transformAt (n + j) h)).dropLast)) → + ((gs.drop 1 = + hs.tail.mapIdx (fun j h => transformAt (1 + j) h)) → + ((hs.length = 1 + hs.tail.length) → + (List.Forall₂ + (fun h g => + g = + PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift a b) + ((hs.drop 1).dropLast) ((gs.drop 1).dropLast))))))) := by + classical + intro centerShift couter eouter a b eback bplus hs constAt transformAt gs interiorTransforms + hgsTail htailLength simpa [hgsTail] using interiorTransforms 1 hs.tail (by omega) htailLength private theorem zipForall₂ : @@ -1482,63 +1466,21 @@ private theorem zip_dropLast_eq : private theorem hzipDropOne : (by classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (horientationExists : ∃ o : Bool, - Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), - let orientation := Classical.choose horientationExists - ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List - ProtoTile), ∀ (hseed : PartialOdometer), (BoundaryString C₀ Cᵢ i orientation T₀ base - Rminus Rplus tiles) → ((TileString Cᵢ orientation base Rminus Rplus tiles) → (∀ - (centerShift : GaussianInt), ∀ (reverseTiles : List ProtoTile), (List.Forall₂ (fun (T - U : ProtoTile) => (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells) - tiles reverseTiles) → ( - let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) - let hminus := PartialOdometerAffineTranslate hseed 0 d 0 - ∀ (couter : GaussianInt), ∀ (eouter : ℤ), - let a : GaussianInt := -couter - let b : Int := -eouter - let hplus := PartialOdometerAffineTranslate - (PartialOdometerHalfTurn hminus) centerShift a 0 - ∀ (eback : ℤ), - let bplus : Int := -eback - (tiles.head? = some Rminus) → ((tiles.getLast? = some Rplus) → ((2 ≤ tiles.length) → (∀ - (hs : List PartialOdometer), (hs.head? = some hminus) → ((hs.getLast? = some hplus) → - ((OdometerStringRespect Cᵢ orientation base Rminus Rplus tiles hs) → ((∀ T ∈ - (List.drop (1 : ℕ) tiles).dropLast, ∃ (h : PartialOdometer), (T, h) ∈ tiles.zip hs ∧ - AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀ h h₀) → ((hs.length = tiles.length) → ((2 ≤ - hs.length) → ( - let constAt : Nat → Int := fun n => - if n = 0 then 0 else if n + 1 = hs.length then bplus else b - let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => - PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) - let gs := hs.mapIdx transformAt - (∀ n, ∀ l, List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a c) l (l.mapIdx (fun j h => transformAt (n + - j) h))) → ((List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a c) hs gs) → ((gs.head? = some hplus) → - ((gs.getLast? = some hminus) → ( - let cellRelation : ProtoTile → ProtoTile → Prop := fun T U => - (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells - (List.Forall₂ cellRelation ((tiles.drop 1).dropLast) ((reverseTiles.drop 1).dropLast)) → - ((∀ n, ∀ (l : List PartialOdometer), 0 < n → hs.length = n + l.length → List.Forall₂ - (fun h g => g = PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) - centerShift a b) l.dropLast ((l.mapIdx (fun j h => transformAt (n + j) h)).dropLast)) - → ((gs.drop 1 = hs.tail.mapIdx (fun j h => transformAt (1 + j) h)) → ((hs.length = 1 - + hs.tail.length) → ((List.Forall₂ (fun h g => g = PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a b) ((hs.drop 1).dropLast) ((gs.drop - 1).dropLast)) → ((List.Forall₂ (fun X Y => cellRelation X.1 Y.1 ∧ Y.2 = - PartialOdometerAffineTranslate (PartialOdometerHalfTurn X.2) centerShift a b) - (((tiles.drop 1).dropLast).zip ((hs.drop 1).dropLast)) (((reverseTiles.drop - 1).dropLast).zip ((gs.drop 1).dropLast))) → ((tiles.drop 1).zip (hs.drop 1) = - (tiles.zip hs).drop 1)))))))))))))))))))))) ) := by - classical - intro q C₀ Cᵢ i T₀ h₀ horientationExists orientation base Rminus Rplus tiles hseed - hboundaryOriginal hstring centerShift reverseTiles hcellPairs d hminus couter eouter a b - hplus eback bplus htilesHead htilesLast htilesLength hs hhsHead hhsLast hrespect - hancestorForward hlengthEq hlengthHs constAt transformAt gs transformForall htransform - hgsHead hgsLast cellRelation hinteriorCells interiorTransforms hgsTail htailLength - hinteriorTransforms hinteriorZip + exact + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (i : Fin 3), + ∀ (Rminus : ProtoTile), + ∀ (tiles : List ProtoTile), + ∀ (hseed : PartialOdometer), + (let d : GaussianInt := + -BandVectors.2 (q ((i + 1).succ)) (q i.succ); + let hminus := PartialOdometerAffineTranslate hseed 0 d 0; + (tiles.head? = some Rminus) → + (∀ (hs : List PartialOdometer), + (hs.head? = some hminus) → + ((tiles.drop 1).zip (hs.drop 1) = (tiles.zip hs).drop 1)))) := by + classical + intro q i Rminus tiles hseed d hminus htilesHead hs hhsHead cases tiles with | nil => simp at htilesHead | cons T ts => @@ -1549,64 +1491,22 @@ private theorem hzipDropOne : private theorem htailOdoLength : (by classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), (ProtoTile) → (∀ (h₀ : PartialOdometer), ∀ - (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), - let orientation := Classical.choose horientationExists - ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List - ProtoTile), ∀ (hseed : PartialOdometer), (BoundaryString C₀ Cᵢ i orientation T₀ base - Rminus Rplus tiles) → ((Fin (4 : ℕ) → CircleCoordinates) → ((TileString Cᵢ - orientation base Rminus Rplus tiles) → (∀ (centerShift : GaussianInt), ∀ - (reverseTiles : List ProtoTile), (List.Forall₂ (fun (T U : ProtoTile) => - (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells) tiles reverseTiles) → ( - let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) - let hminus := PartialOdometerAffineTranslate hseed 0 d 0 - (GaussianInt) → (∀ (couter : GaussianInt), ∀ (eouter : ℤ), - let a : GaussianInt := -couter - let b : Int := -eouter - let hplus := PartialOdometerAffineTranslate - (PartialOdometerHalfTurn hminus) centerShift a 0 - ∀ (eback : ℤ), - let bplus : Int := -eback - (tiles.head? = some Rminus) → ((tiles.getLast? = some Rplus) → ((2 ≤ tiles.length) → (∀ - (hs : List PartialOdometer), (hs.head? = some hminus) → ((hs.getLast? = some hplus) → - ((OdometerStringRespect Cᵢ orientation base Rminus Rplus tiles hs) → ((∀ T ∈ - (List.drop (1 : ℕ) tiles).dropLast, ∃ (h : PartialOdometer), (T, h) ∈ tiles.zip hs ∧ - AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀ h h₀) → ((hs.length = tiles.length) → ((2 ≤ - hs.length) → ( - let constAt : Nat → Int := fun n => - if n = 0 then 0 else if n + 1 = hs.length then bplus else b - let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => - PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) - let gs := hs.mapIdx transformAt - (∀ n, ∀ l, List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a c) l (l.mapIdx (fun j h => transformAt (n + - j) h))) → ((List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a c) hs gs) → ((gs.head? = some hplus) → - ((gs.getLast? = some hminus) → ( - let cellRelation : ProtoTile → ProtoTile → Prop := fun T U => - (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells - (List.Forall₂ cellRelation ((tiles.drop 1).dropLast) ((reverseTiles.drop 1).dropLast)) → - ((∀ n, ∀ (l : List PartialOdometer), 0 < n → hs.length = n + l.length → List.Forall₂ - (fun h g => g = PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) - centerShift a b) l.dropLast ((l.mapIdx (fun j h => transformAt (n + j) h)).dropLast)) - → ((gs.drop 1 = hs.tail.mapIdx (fun j h => transformAt (1 + j) h)) → ((hs.length = 1 - + hs.tail.length) → ((List.Forall₂ (fun h g => g = PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a b) ((hs.drop 1).dropLast) ((gs.drop - 1).dropLast)) → ((List.Forall₂ (fun X Y => cellRelation X.1 Y.1 ∧ Y.2 = - PartialOdometerAffineTranslate (PartialOdometerHalfTurn X.2) centerShift a b) - (((tiles.drop 1).dropLast).zip ((hs.drop 1).dropLast)) (((reverseTiles.drop - 1).dropLast).zip ((gs.drop 1).dropLast))) → (((tiles.drop 1).zip (hs.drop 1) = - (tiles.zip hs).drop 1) → ((tiles.drop 1).length = (hs.drop - 1).length)))))))))))))))))))))))))) ) := by - classical - intro q C₀ Cᵢ i T₀ T₀' h₀ horientationExists orientation base Rminus Rplus tiles hseed - hboundaryOriginal q' hstring centerShift reverseTiles hcellPairs d hminus touter couter - eouter a b hplus eback bplus htilesHead htilesLast htilesLength hs hhsHead hhsLast hrespect - hancestorForward hlengthEq hlengthHs constAt transformAt gs transformForall htransform - hgsHead hgsLast cellRelation hinteriorCells interiorTransforms hgsTail htailLength - hinteriorTransforms hinteriorZip hzipDropOne + exact + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (i : Fin 3), + (∀ (Rminus : ProtoTile), + ∀ (tiles : List ProtoTile), + ∀ (hseed : PartialOdometer), + (let d : GaussianInt := + -BandVectors.2 (q ((i + 1).succ)) (q i.succ); + let hminus := PartialOdometerAffineTranslate hseed 0 d 0; + ((tiles.head? = some Rminus) → + (∀ (hs : List PartialOdometer), + (hs.head? = some hminus) → + ((hs.length = tiles.length) → + ((tiles.drop 1).length = (hs.drop 1).length))))))) := by + classical + intro q i Rminus tiles hseed d hminus htilesHead hs hhsHead hlengthEq cases tiles with | nil => simp at htilesHead | cons T ts => @@ -1814,50 +1714,57 @@ private theorem hreverseZipDropOne : private theorem hreverseDropLength : (by classical - exact - (BandCircle) → ((BandCircle) → ((Fin 3) → ((ProtoTile) → ((List ProtoTile) → ((Fin (4 : - ℕ) → CircleCoordinates) → (∀ (centerShift : GaussianInt), ∀ (reverseTiles : List - ProtoTile), (GaussianInt) → (∀ (couter : GaussianInt), ∀ (eouter : ℤ), - let a : GaussianInt := -couter - let b : Int := -eouter - ∀ (eback : ℤ), - let bplus : Int := -eback - ∀ (hs : List PartialOdometer), - let constAt : Nat → Int := fun n => - if n = 0 then 0 else if n + 1 = hs.length then bplus else b - let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => - PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) - let gs := hs.mapIdx transformAt - (reverseTiles.length = gs.length) → ((reverseTiles.drop 1).length = (gs.drop - 1).length)))))))) ) := by + exact + (∀ (centerShift : GaussianInt), + ∀ (reverseTiles : List ProtoTile), + (∀ (couter : GaussianInt), + ∀ (eouter : ℤ), + let a : GaussianInt := -couter; + let b : Int := -eouter; + ∀ (eback : ℤ), + let bplus : Int := -eback; + ∀ (hs : List PartialOdometer), + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b; + let transformAt : Nat → PartialOdometer → PartialOdometer := + fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) + centerShift a (constAt n); + let gs := hs.mapIdx transformAt; + (reverseTiles.length = gs.length) → + ((reverseTiles.drop 1).length = (gs.drop 1).length)))) := by classical - intro C₀ Cᵢ i T₀' tiles q' centerShift reverseTiles touter couter eouter a b eback bplus hs - constAt transformAt gs hreverseFullLength + intro centerShift reverseTiles couter eouter a b eback bplus hs constAt transformAt gs + hreverseFullLength simp only [List.length_drop] at hreverseFullLength ⊢ omega private theorem hreverseInteriorLength : (by classical - exact - (BandCircle) → ((BandCircle) → ((Fin 3) → ((ProtoTile) → ((List ProtoTile) → ((Fin (4 : - ℕ) → CircleCoordinates) → (∀ (centerShift : GaussianInt), ∀ (reverseTiles : List - ProtoTile), (GaussianInt) → (∀ (couter : GaussianInt), ∀ (eouter : ℤ), - let a : GaussianInt := -couter - let b : Int := -eouter - ∀ (eback : ℤ), - let bplus : Int := -eback - ∀ (hs : List PartialOdometer), - let constAt : Nat → Int := fun n => - if n = 0 then 0 else if n + 1 = hs.length then bplus else b - let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => - PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) - let gs := hs.mapIdx transformAt - ((reverseTiles.drop 1).length = (gs.drop 1).length) → (((reverseTiles.drop - 1).dropLast).length = ((gs.drop 1).dropLast).length)))))))) ) := by + exact + (∀ (centerShift : GaussianInt), + ∀ (reverseTiles : List ProtoTile), + (∀ (couter : GaussianInt), + ∀ (eouter : ℤ), + let a : GaussianInt := -couter; + let b : Int := -eouter; + ∀ (eback : ℤ), + let bplus : Int := -eback; + ∀ (hs : List PartialOdometer), + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b; + let transformAt : Nat → PartialOdometer → PartialOdometer := + fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) + centerShift a (constAt n); + let gs := hs.mapIdx transformAt; + ((reverseTiles.drop 1).length = (gs.drop 1).length) → + (((reverseTiles.drop 1).dropLast).length = + ((gs.drop 1).dropLast).length)))) := by classical - intro C₀ Cᵢ i T₀' tiles q' centerShift reverseTiles touter couter eouter a b eback bplus hs - constAt transformAt gs hreverseDropLength + intro centerShift reverseTiles couter eouter a b eback bplus hs constAt transformAt gs + hreverseDropLength simp only [List.length_dropLast] at hreverseDropLength ⊢ omega @@ -2097,24 +2004,19 @@ private theorem opposingBoundaryConclusion : transformForall htransform have hgsHead := OpposingBoundaryGeometry.hgsHead q i hseed centerShift couter eouter eback hs hhsHead - have hgsLast := OpposingBoundaryGeometry.hgsLast q C₀ Cᵢ i T₀' tiles hseed q' centerShift - touter couter eouter eback hminusBackEq htilesLength hs hhsLast hlengthEq + have hgsLast := OpposingBoundaryGeometry.hgsLast q i tiles hseed centerShift couter eouter + eback hminusBackEq htilesLength hs hhsLast hlengthEq let cellRelation : ProtoTile → ProtoTile → Prop := fun T U => (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells have hinteriorCells := OpposingBoundaryGeometry.hinteriorCells tiles centerShift reverseTiles hcellPairs htilesLength (OpposingBoundaryGeometry.forall2_dropLast) have interiorTransforms := OpposingBoundaryGeometry.interiorTransforms C₀ Cᵢ i T₀' tiles q' centerShift touter couter eouter eback hs - have hgsTail := OpposingBoundaryGeometry.hgsTail q C₀ Cᵢ i T₀ h₀ horientationExists base Rminus - Rplus tiles hseed centerShift couter eouter eback hs hhsHead hhsLast hrespect - hancestorForward hlengthEq hlengthHs transformForall htransform hgsHead hgsLast - interiorTransforms - have htailLength := OpposingBoundaryGeometry.htailLength q C₀ Cᵢ i T₀ T₀' h₀ horientationExists - base Rminus Rplus tiles hseed q' centerShift touter couter eouter eback hs hhsHead hhsLast - hrespect hancestorForward hlengthEq hlengthHs transformForall htransform hgsHead hgsLast - interiorTransforms hgsTail - have hinteriorTransforms := OpposingBoundaryGeometry.hinteriorTransforms C₀ Cᵢ i T₀' tiles q' - centerShift touter couter eouter eback hs interiorTransforms hgsTail htailLength + have hgsTail := OpposingBoundaryGeometry.hgsTail q i hseed centerShift couter eouter eback hs + hhsHead + have htailLength := OpposingBoundaryGeometry.htailLength q i hseed hs hhsHead + have hinteriorTransforms := OpposingBoundaryGeometry.hinteriorTransforms + centerShift couter eouter eback hs interiorTransforms hgsTail htailLength have hinteriorZip : List.Forall₂ (fun X Y => cellRelation X.1 Y.1 ∧ Y.2 = PartialOdometerAffineTranslate @@ -2127,18 +2029,11 @@ private theorem opposingBoundaryConclusion : xs.length = ys.length → xs.dropLast.zip ys.dropLast = (xs.zip ys).dropLast := @OpposingBoundaryGeometry.zip_dropLast_eq C₀ Cᵢ i T₀' tiles q' touter hs - have hzipDropOne := OpposingBoundaryGeometry.hzipDropOne q C₀ Cᵢ i T₀ h₀ horientationExists - base Rminus Rplus tiles hseed hboundaryOriginal hstring centerShift reverseTiles hcellPairs - couter eouter eback htilesHead htilesLast htilesLength hs hhsHead hhsLast hrespect - hancestorForward hlengthEq hlengthHs transformForall htransform hgsHead hgsLast - hinteriorCells interiorTransforms hgsTail htailLength hinteriorTransforms hinteriorZip + have hzipDropOne := OpposingBoundaryGeometry.hzipDropOne q i Rminus tiles hseed htilesHead hs + hhsHead have hzipInteriorEq := OpposingBoundaryGeometry.hzipInteriorEq tiles hs zip_dropLast_eq - hzipDropOne (OpposingBoundaryGeometry.htailOdoLength q C₀ Cᵢ i T₀ T₀' h₀ horientationExists - base Rminus Rplus tiles hseed hboundaryOriginal q' hstring centerShift reverseTiles - hcellPairs touter couter eouter eback htilesHead htilesLast htilesLength hs hhsHead hhsLast - hrespect hancestorForward hlengthEq hlengthHs transformForall htransform hgsHead hgsLast - hinteriorCells interiorTransforms hgsTail htailLength hinteriorTransforms hinteriorZip - hzipDropOne) + hzipDropOne (OpposingBoundaryGeometry.htailOdoLength q i Rminus tiles hseed htilesHead hs + hhsHead hlengthEq) have zip_mem_left : ∀ {α β : Type} (xs : List α) (ys : List β), xs.length = ys.length → ∀ x, x ∈ xs → ∃ y, (x, y) ∈ xs.zip ys := @@ -2165,10 +2060,10 @@ private theorem opposingBoundaryConclusion : ∀ {y}, y ∈ ys → ∃ x, x ∈ xs ∧ r x y := @OpposingBoundaryGeometry.forall2_mem_right have trimSublist := OpposingBoundaryGeometry.trimSublist have hreverseFullLength := (OpposingBoundaryGeometry.forall2_length) hreverseRespect.2.1 - have hreverseDropLength := OpposingBoundaryGeometry.hreverseDropLength C₀ Cᵢ i T₀' tiles q' - centerShift reverseTiles touter couter eouter eback hs hreverseFullLength - have hreverseInteriorLength := OpposingBoundaryGeometry.hreverseInteriorLength C₀ Cᵢ i T₀' - tiles q' centerShift reverseTiles touter couter eouter eback hs hreverseDropLength + have hreverseDropLength := OpposingBoundaryGeometry.hreverseDropLength + centerShift reverseTiles couter eouter eback hs hreverseFullLength + have hreverseInteriorLength := OpposingBoundaryGeometry.hreverseInteriorLength centerShift + reverseTiles couter eouter eback hs hreverseDropLength have hreverseZipInteriorEq := OpposingBoundaryGeometry.hreverseZipInteriorEq centerShift reverseTiles couter eouter eback hs zip_dropLast_eq (OpposingBoundaryGeometry.hreverseZipDropOne centerShift reverseTiles couter eouter eback diff --git a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean index f88d76533c..c26e451fa2 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean @@ -8,9 +8,7 @@ module public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton -public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.SwappedAffineTriangularChartAlignment -public import LeanPool.ApollonianSuperharmonic.TileString public import LeanPool.ApollonianSuperharmonic.TileStringCoordinateTransport public import LeanPool.ApollonianSuperharmonic.UnitSquareOpposingStripInterfacePath @@ -568,30 +566,21 @@ private theorem chainAppendDrop : private theorem hfaceLen : (by classical - exact - ∀ (base : ProtoTile), ∀ (R : ProtoTile), ∀ (S : ProtoTile), (List ProtoTile) → ((List - ProtoTile) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), - let tileAt : Int × Int → ProtoTile := fun z => - TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) - ∀ (r : ℤ × ℤ), (R = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + - (↑z.2 : GaussianInt) * b)) r) → ((∀ (y : ℤ × ℤ), (fun (z : ℤ × ℤ) => R = (fun (z : ℤ - × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) - z) y → y = r) → (∀ (s : ℤ × ℤ), (S = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 - : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) s) → ((∀ (y : ℤ × ℤ), (fun (z : ℤ × - ℤ) => S = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 - : GaussianInt) * b)) z) y → y = s) → ((R = tileAt r) → ((S = tileAt s) → (∀ (F : List - (ℤ × ℤ)), ∀ (G : List (ℤ × ℤ)), (TriangularStripSegment r s F) → - ((TriangularStripSegment s r G) → ((r ≠ s) → ((¬ TriangularLatticeAdjacent r s) → (∀ - (faces : List AffineTriangularFace), (faces ≠ []) → ((∃ (f : AffineTriangularFace), - faces.head? = some f ∧ r ∈ AffineTriangularFaceVertices f) → ((∃ (f : - AffineTriangularFace), faces.getLast? = some f ∧ s ∈ AffineTriangularFaceVertices f) - → ((∀ f ∈ faces, (∃ a ∈ (List.drop (1 : ℕ) F).dropLast, a ∈ - AffineTriangularFaceVertices f) ∧ ∃ b ∈ (List.drop (1 : ℕ) G).dropLast, b ∈ - AffineTriangularFaceVertices f) → ((List.IsChain (AffineTriangularCorridorStep F G) - faces) → (2 ≤ faces.length))))))))))))))))) ) := by + exact + (∀ (r : ℤ × ℤ), + (∀ (s : ℤ × ℤ), + ((r ≠ s) → + ((¬TriangularLatticeAdjacent r s) → + (∀ (faces : List AffineTriangularFace), + (faces ≠ []) → + ((∃ (f : AffineTriangularFace), + faces.head? = some f ∧ r ∈ AffineTriangularFaceVertices f) → + ((∃ (f : AffineTriangularFace), + faces.getLast? = some f ∧ + s ∈ AffineTriangularFaceVertices f) → + (2 ≤ faces.length))))))))) := by classical - intro base R S forward reverse a b tileAt r hrcoord hruniq s hscoord hsuniq hR hS F G hFstrip - hGstrip hrs hnadjCoord faces hfacesNe hfirst hlast hfaceVertices hfaceChain + intro r s hrs hnadjCoord faces hfacesNe hfirst hlast rcases hfirst with ⟨f, hf, hfr⟩ rcases hlast with ⟨g, hg, hgs⟩ cases faces with @@ -1125,9 +1114,8 @@ private theorem finish : let joinWalk : List AffineTriangularFace → List GaussianInt := fun L => (L.zip L.tail).foldr (fun fg acc => PP.facePath (faceAt fg.1) (faceAt fg.2) ++ acc.drop 1) [] - have hfaceLen := OpposingInterfaceGeometry.hfaceLen base R S forward reverse a b r hrcoord - hruniq s hscoord hsuniq hR hS F G hFstrip hGstrip hrs hnadjCoord faces hfacesNe hfirst - hlast hfaceVertices hfaceChain + have hfaceLen := OpposingInterfaceGeometry.hfaceLen r s hrs hnadjCoord faces hfacesNe hfirst + hlast have walkFacts := OpposingInterfaceGeometry.walkFacts base a b F G ι PP faceAt (OpposingInterfaceGeometry.faceStepData base a b F G ι PP xi faceAt hadjXi htileXi hinjFace incident) chainOfEdges (OpposingInterfaceGeometry.chainAppendDrop base a b F G) diff --git a/LeanPool/ApollonianSuperharmonic/OrderedParentVectorSum.lean b/LeanPool/ApollonianSuperharmonic/OrderedParentVectorSum.lean new file mode 100644 index 0000000000..def727b072 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/OrderedParentVectorSum.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralConfiguration +public import LeanPool.ApollonianSuperharmonic.IncomingSuperbasisRelation +public import Mathlib.Init + + +/-! +# OrderedParentVectorSum + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace OrderedParentVectorSum + +/-- Shared incoming identity for OrderedParentVectorSum. -/ +theorem incoming : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (BandVectors.1 + (q 1) (q 0) + BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) ) := by + classical + intro q cfg + simpa [Fin.sum_univ_succ, add_assoc] using (IncomingSuperbasisRelation q cfg.proper).1 + +end OrderedParentVectorSum +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean b/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean index a42d7f7f65..11335d8fea 100644 --- a/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnTranslation public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetricCenteredTransport @@ -26,28 +27,6 @@ namespace ApollonianSuperharmonic namespace TouchingCovarianceProof -private theorem quarter_translate : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (x : GaussianInt), TileQuarterTurn (TileTranslation T x) = - TileTranslation (TileQuarterTurn T) (GaussianQuarterTurn x) - ) := by - classical - intro T x - cases T with - | mk cells anchor => - have map : (fun z : GaussianInt => GaussianQuarterTurn (z + x) - 1) = - (fun z : GaussianInt => (GaussianQuarterTurn z - 1) + - GaussianQuarterTurn x) := by - funext z - ext <;> simp [GaussianQuarterTurn, add_comm]; ring - apply congrArg₂ (fun c : FiniteTile => fun d : GaussianInt => - ProtoTile.mk c d) - · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, - Finset.image_image, Function.comp_def, map] - · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, - GaussianQuarterTurn, add_comm] private theorem same_touch : (by @@ -577,7 +556,7 @@ theorem OrientedTouchingCovariance : have quarter_translate (T : ProtoTile) (x : GaussianInt) : TileQuarterTurn (TileTranslation T x) = TileTranslation (TileQuarterTurn T) (GaussianQuarterTurn x) := - TouchingCovarianceProof.quarter_translate T x + TileQuarterTurnTranslation.commute T x have same_touch (A B C A' B' C' : ProtoTile) (ha : A.cells = A'.cells) (hb : B.cells = B'.cells) (hc : C.cells = C'.cells) diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean b/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean index 1be76d61df..1d43e883b0 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean @@ -6,7 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init -public import Mathlib.Tactic.Linarith +public import LeanPool.ApollonianSuperharmonic.ListEndpointFacts public import LeanPool.ApollonianSuperharmonic.P3523T1InsertionConstruction public import LeanPool.ApollonianSuperharmonic.P3523T1SubdivisionExit @@ -1210,21 +1210,6 @@ private theorem hstepsNodup : (List.ofFn fun k : Fin (n + 3) => s.start 0 + k))).Nodup exact hfilterNodup.map htupleInj -private theorem getNotTake : - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary - n), (P3475T1BoundarySubdivision q p) → (∀ (X : Set (Real × Real)), ∀ (K : Set (Real × - Real)), (P3475T1TriangleTree q X K) → ((ℕ) → ((Fin (n + (3 : ℕ))) → ((Fin (n + (3 : - ℕ))) → (∀ {α : Type}, ∀ (l : List α), (l.Nodup) → (∀ (m : Nat), ∀ (hm : m < l.length), - l.get ⟨m, hm⟩ ∉ l.take m)))))) := by - classical - intro r n q p s X K t h j k α l hn m hm hmem - rcases List.mem_take_iff_getElem.mp hmem with ⟨i, hi, heq⟩ - have hi' : i < m := by omega - have hiList : i < l.length := lt_trans hi' hm - have heq' : l[i] = l[m] := by simpa using heq - have hidx := hn.getElem_inj_iff.mp heq' - omega - private theorem hkpos (r n : Nat) (q : P3381T1PolygonBoundary r) (p : P3381T1PolygonBoundary n) (s : P3475T1BoundarySubdivision q p) [NeZero (n + 3)] (j k : Fin (n + 3)) @@ -1580,8 +1565,7 @@ theorem P3523T1OrderedInsertion {r n : Nat} OrderedInsertionGeometry.filterPrev r n q s X K t j (α := α) l p k h hn hk hpos hlen hp hcur have getNotTake {α : Type} (l : List α) (hn : l.Nodup) (m : Nat) - (hm : m < l.length) := OrderedInsertionDetails.getNotTake r - n q p s X K t h j k (α := α) l hn m hm + (hm : m < l.length) := ListEndpointFacts.getNotTake l hn m hm have fold_not_mem (l : List (Fin (n + 3) × Fin (n + 3) × Fin (n + 3))) (A : Finset (Fin (n + 3))) (x : Fin (n + 3)) (hx : x ∉ A) (hall : ∀ a ∈ l, a.2.1 ≠ x) := OrderedInsertionGeometry.fold_not_mem n diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean index dba6753e49..393da68fea 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean @@ -8,7 +8,6 @@ module public import Mathlib.Init public import Mathlib.Tactic.Linarith -public import Mathlib.Analysis.Convex.Hull public import Mathlib.Analysis.Convex.Join public import LeanPool.ApollonianSuperharmonic.P3381T1TriangleDeterminant @@ -166,17 +165,32 @@ private theorem hBNodup : exact haNotV (hxa ▸ hx)⟩ private theorem hsets : - ∀ (n : Nat), (Fin (n + 3) → Real × Real) → (∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : - List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), (∃ k : Nat, (a :: (u ++ b :: v)).Sublist - ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) → ( - let A := a :: (u ++ [b]) - let B := b :: (v ++ [a]) - ((u ++ b :: v).Nodup) → ((a ≠ b) → ((u.Nodup ∧ (b :: v).Nodup ∧ ∀ a ∈ u, ∀ b_1 ∈ b :: v, a ≠ - b_1) → ((u.Nodup) → ((b ∉ u) → ((v.Nodup) → ((b ∉ v) → ((a ∉ u) → ((a ∉ v) → ((∀ i, i ∈ u - → i ∈ v → False) → ((A.Nodup) → ((B.Nodup) → ({i | i ∈ A} ∩ {i | i ∈ B} = {a, - b})))))))))))))) := by - classical - intro n q a b u v hcyclic A B htailNodup hne hparts huNodup hbNotU hvNodup hbNotV haNotU haNotV + ∀ (n : Nat), + (∀ (a : Fin (n + 3)), + ∀ (b : Fin (n + 3)), + ∀ (u : List (Fin (n + 3))), + ∀ (v : List (Fin (n + 3))), + (∃ k : Nat, + (a :: (u ++ b :: v)).Sublist + ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) → + (let A := a :: (u ++ [b]); + let B := b :: (v ++ [a]); + ((u ++ b :: v).Nodup) → + ((a ≠ b) → + ((u.Nodup ∧ (b :: v).Nodup ∧ ∀ a ∈ u, ∀ b_1 ∈ b :: v, a ≠ b_1) → + ((u.Nodup) → + ((b ∉ u) → + ((v.Nodup) → + ((b ∉ v) → + ((a ∉ u) → + ((a ∉ v) → + ((∀ i, i ∈ u → i ∈ v → False) → + ((A.Nodup) → + ((B.Nodup) → + ({i | i ∈ A} ∩ {i | i ∈ B} = + {a, b})))))))))))))) := by + classical + intro n a b u v hcyclic A B htailNodup hne hparts huNodup hbNotU hvNodup hbNotV haNotU haNotV huvDisjoint hANodup hBNodup ext i simp [A, B, List.mem_cons, List.mem_append]; aesop @@ -1746,7 +1760,7 @@ theorem P3555T2ParabolaChordCuts {n : Nat} have huvDisjoint : ∀ i, i ∈ u → i ∈ v → False := ParabolaChordLemmas.huvDisjoint n b u v hparts have hANodup : A.Nodup := ParabolaChordLemmas.hANodup n a b u hne huNodup hbNotU haNotU have hBNodup : B.Nodup := ParabolaChordLemmas.hBNodup n a b v hne hvNodup hbNotV haNotV - have hsets : {i | i ∈ A} ∩ {i | i ∈ B} = {a, b} := ParabolaChordLemmas.hsets n q a b u v + have hsets : {i | i ∈ A} ∩ {i | i ∈ B} = {a, b} := ParabolaChordLemmas.hsets n a b u v hcyclic htailNodup hne hparts huNodup hbNotU hvNodup hbNotV haNotU haNotV huvDisjoint hANodup hBNodup have hnil (xs : List (Fin (n + 3))) : diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean b/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean index 3e84c4d70b..6386776b5c 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean @@ -6,10 +6,10 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.AffineLineMapProperties public import Mathlib.Tactic.Positivity public import LeanPool.ApollonianSuperharmonic.P3597T1SideCrossing -public import Mathlib.Topology.Connected.PathConnected public import Mathlib.Analysis.Normed.Module.Convex public import Mathlib.Topology.LocallyConstant.Basic @@ -2284,15 +2284,6 @@ private theorem hr : dsimp [r] positivity -private theorem hlineMap : - (by - classical - exact - ∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x y t = x + t • (y - x) ) := by - classical - intro x y t - rw [AffineMap.lineMap_apply_module] - module private theorem hdistRadial : (by @@ -3190,7 +3181,7 @@ theorem P3597T1VertexSectors {n : Nat} (p : P3381T1PolygonBoundary n) exact le_trans (min_le_right _ _) (min_le_left _ _) have hrBle : r ≤ dist v (p.vertex prev) / 2 := by exact le_trans (min_le_right _ _) (min_le_right _ _) - have hlineMap := VertexSectorDetails.hlineMap + have hlineMap := AffineLineMapProperties.coordinates have hsegA := VertexSectorProof.hsegA n p i hlineMap have hdistRadial := VertexSectorDetails.hdistRadial n p i have hnoPosMultiple := VertexSectorProof.hnoPosMultiple n p i diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean b/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean index 304e3a7bd7..b6a8c977be 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean @@ -1234,29 +1234,36 @@ private theorem hstraddle : private theorem hzeroHit : (by classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), - let a := p.vertex (E.b - 1) - let b := p.vertex E.b - let c := p.vertex (E.b + 1) - let v : Fin 3 → Real × Real := ![a, b, c] - ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), - let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ - ∀ (j : Fin (n + (3 : ℕ))), - let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) - (Set.Icc ((A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (q (0 : ℝ))) ((A.coord (2 : Fin (3 : - ℕ)) : ℝ × ℝ → ℝ) (q (1 : ℝ))) ⊆ (fun (s : ℝ) => (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → - ℝ) (q s)) '' Set.Icc (0 : ℝ) (1 : ℝ)) → (∀ (x : ℝ × ℝ), ((0 : ℝ) < (A.coord (0 : Fin - (3 : ℕ)) : ℝ × ℝ → ℝ) x ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : - ℝ) < (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x) → ((∀ (i : Fin 3), Continuous (fun s - => A.coord i (q s))) → ( - let z0 := A.coord 2 (p.vertex j) - let z1 := A.coord 2 (p.vertex (j + 1)) - (A.coord 0 x + A.coord 1 x + A.coord 2 x = 1) → (((z0 ≤ 0 ∧ 1 ≤ z1) ∨ (z1 ≤ 0 ∧ 1 ≤ z0)) - → ((A.coord 2 (q 0) = z0) → ((A.coord 2 (q 1) = z1) → (∃ s ∈ Set.Icc (0 : Real) 1, - A.coord 2 (q s) = 0))))))) ) := by - classical - intro n p E a b c v hind hspan A j q hrange x hxb hfc z0 z1 hxsum hstraddle hz0eq hz1eq + exact + ∀ (n : Nat), + ∀ (p : P3381T1PolygonBoundary n), + ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1); + let b := p.vertex E.b; + let c := p.vertex (E.b + 1); + let v : Fin 3 → Real × Real := ![a, b, c]; + ∀ (hind : AffineIndependent Real v), + ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := + ⟨v, hind, hspan⟩; + ∀ (j : Fin (n + (3 : ℕ))), + let q : Real → Real × Real := + AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)); + (Set.Icc ((A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (q (0 : ℝ))) + ((A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (q (1 : ℝ))) ⊆ + (fun (s : ℝ) => + (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (q s)) '' + Set.Icc (0 : ℝ) (1 : ℝ)) → + ((∀ (i : Fin 3), Continuous (fun s => A.coord i (q s))) → + (let z0 := A.coord 2 (p.vertex j); + let z1 := A.coord 2 (p.vertex (j + 1)); + (((z0 ≤ 0 ∧ 1 ≤ z1) ∨ (z1 ≤ 0 ∧ 1 ≤ z0)) → + ((A.coord 2 (q 0) = z0) → + ((A.coord 2 (q 1) = z1) → + (∃ s ∈ Set.Icc (0 : Real) 1, + A.coord 2 (q s) = 0))))))) := by + classical + intro n p E a b c v hind hspan A j q hrange hfc z0 z1 hstraddle hz0eq hz1eq rcases hstraddle with ⟨h0, h1⟩ | ⟨h1, h0⟩ · have hmemRange : 0 ∈ Set.Icc z0 z1 := ⟨h0, by linarith⟩ obtain ⟨s, hs, heq⟩ := hrange (by simpa [hz0eq, hz1eq] using hmemRange) @@ -1270,29 +1277,36 @@ private theorem hzeroHit : private theorem honeHit : (by classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), - let a := p.vertex (E.b - 1) - let b := p.vertex E.b - let c := p.vertex (E.b + 1) - let v : Fin 3 → Real × Real := ![a, b, c] - ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), - let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ - ∀ (j : Fin (n + (3 : ℕ))), - let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) - (Set.Icc ((A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (q (0 : ℝ))) ((A.coord (2 : Fin (3 : - ℕ)) : ℝ × ℝ → ℝ) (q (1 : ℝ))) ⊆ (fun (s : ℝ) => (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → - ℝ) (q s)) '' Set.Icc (0 : ℝ) (1 : ℝ)) → (∀ (x : ℝ × ℝ), ((0 : ℝ) < (A.coord (0 : Fin - (3 : ℕ)) : ℝ × ℝ → ℝ) x ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : - ℝ) < (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x) → ((∀ (i : Fin 3), Continuous (fun s - => A.coord i (q s))) → ( - let z0 := A.coord 2 (p.vertex j) - let z1 := A.coord 2 (p.vertex (j + 1)) - (A.coord 0 x + A.coord 1 x + A.coord 2 x = 1) → (((z0 ≤ 0 ∧ 1 ≤ z1) ∨ (z1 ≤ 0 ∧ 1 ≤ z0)) - → ((A.coord 2 (q 0) = z0) → ((A.coord 2 (q 1) = z1) → (∃ s ∈ Set.Icc (0 : Real) 1, - A.coord 2 (q s) = 1))))))) ) := by - classical - intro n p E a b c v hind hspan A j q hrange x hxb hfc z0 z1 hxsum hstraddle hz0eq hz1eq + exact + ∀ (n : Nat), + ∀ (p : P3381T1PolygonBoundary n), + ∀ (E : P3650T1ExposedCorner p), + let a := p.vertex (E.b - 1); + let b := p.vertex E.b; + let c := p.vertex (E.b + 1); + let v : Fin 3 → Real × Real := ![a, b, c]; + ∀ (hind : AffineIndependent Real v), + ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := + ⟨v, hind, hspan⟩; + ∀ (j : Fin (n + (3 : ℕ))), + let q : Real → Real × Real := + AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)); + (Set.Icc ((A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (q (0 : ℝ))) + ((A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (q (1 : ℝ))) ⊆ + (fun (s : ℝ) => + (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) (q s)) '' + Set.Icc (0 : ℝ) (1 : ℝ)) → + ((∀ (i : Fin 3), Continuous (fun s => A.coord i (q s))) → + (let z0 := A.coord 2 (p.vertex j); + let z1 := A.coord 2 (p.vertex (j + 1)); + (((z0 ≤ 0 ∧ 1 ≤ z1) ∨ (z1 ≤ 0 ∧ 1 ≤ z0)) → + ((A.coord 2 (q 0) = z0) → + ((A.coord 2 (q 1) = z1) → + (∃ s ∈ Set.Icc (0 : Real) 1, + A.coord 2 (q s) = 1))))))) := by + classical + intro n p E a b c v hind hspan A j q hrange hfc z0 z1 hstraddle hz0eq hz1eq rcases hstraddle with ⟨h0, h1⟩ | ⟨h1, h0⟩ · have hmemRange : 1 ∈ Set.Icc z0 z1 := ⟨by linarith, h1⟩ obtain ⟨s, hs, heq⟩ := hrange (by simpa [hz0eq, hz1eq] using hmemRange) @@ -1942,14 +1956,14 @@ private theorem hbaseAvoid : (by norm_num) (hfc 2).continuousOn have hz0eq : A.coord 2 (q 0) = z0 := by simpa [z0] using hline2 0 have hz1eq : A.coord 2 (q 1) = z1 := by simpa [z1] using hline2 1 - obtain ⟨s0, hs0, hzs0⟩ := (TriangleDiagonalGeometry.hzeroHit n p E hind hspan j hrange x - hxb hfc hxsum hstraddle hz0eq hz1eq) + obtain ⟨s0, hs0, hzs0⟩ := (TriangleDiagonalGeometry.hzeroHit n p E hind hspan j hrange hfc + hstraddle hz0eq hz1eq) have hq1zero : A.coord 1 (q s0) = 0 := hline1 s0 have hsideA := TriangleDiagonalGeometry.hsideA n p E hvertexSide j s0 (TriangleDiagonalGeometry.hqseg0 n p j s0 hs0) (TriangleDiagonalGeometry.hqa n p E hind hspan hcoordA j s0 hzs0 hq1zero) - obtain ⟨s1, hs1, hzs1⟩ := (TriangleDiagonalGeometry.honeHit n p E hind hspan j hrange x - hxb hfc hxsum hstraddle hz0eq hz1eq) + obtain ⟨s1, hs1, hzs1⟩ := (TriangleDiagonalGeometry.honeHit n p E hind hspan j hrange hfc + hstraddle hz0eq hz1eq) have hq1one : A.coord 1 (q s1) = 0 := hline1 s1 have hsideC := TriangleDiagonalGeometry.hsideC n p E hvertexSide j s1 (TriangleDiagonalGeometry.hqseg1 n p j s1 hs1) diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean index 7f2e618614..b94ac6b13d 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean @@ -193,15 +193,6 @@ private theorem hellw : _ = ell c - ell B := map_sub ell c B _ < 0 := by simpa [c, B, v] using hh -private theorem hlineMap : - (by - classical - exact - ∀ x y : Real × Real, ∀ t : Real, AffineMap.lineMap x y t = x + t • (y - x) ) := by - classical - intro x y t - rw [AffineMap.lineMap_apply_module] - module private theorem hcrosszero : (by @@ -3311,7 +3302,7 @@ theorem P3650T1ExposedCornerExists {n : Nat} (p : P3381T1PolygonBoundary n) : have hw : w ≠ 0 := sub_ne_zero.mpr hcB have hellu := ExposedCornerGeometry.hellu n p hqexists b hstrict hprevne have hellw := ExposedCornerGeometry.hellw n p hqexists b hstrict hnextne - have hlineMap := ExposedCornerGeometry.hlineMap + have hlineMap := AffineLineMapProperties.coordinates let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 have hdet := ExposedCornerGeometry.hdetAt218 n p hqexists b hprev hprevne hu hw hellu hellw hlineMap (ExposedCornerGeometry.hcrosszero) diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean index 7a3ba55494..6db6259f53 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.PeriodicEdgeContactSymmetry public import LeanPool.ApollonianSuperharmonic.P3723T1AllContactRouting public import LeanPool.ApollonianSuperharmonic.P3723T1GridDiskBoundaryStars @@ -27,15 +28,6 @@ open Set -- [TABLET NODE: P3723T1AllContactDrawingExists] namespace ContactDrawingGeometry -private theorem symmetric : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P - a b ↔ P3723T1EdgeContact P b a ) := by - classical - intro ι P a b - simp only [P3723T1EdgeContact, ne_comm, Set.inter_comm] private theorem present : (by @@ -504,32 +496,59 @@ private theorem hmeet : private theorem hfcont : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - let clip (x : Real) : Icc (0 : Real) 1 := - ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ - let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) - let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) - let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} - let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right - (Continuous left) → ((Continuous right) → ((∀ (s : Icc (0 : Real) 1), (s ∈ (Set.univ : - Set (Icc (0 : Real) 1)) ∩ frontier A) → (left s = right s)) → (Continuous f))) ) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g clip left right A f hleftc + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, + max_le (by norm_num) (min_le_left _ _)⟩; + let left : Icc (0 : Real) 1 → Real × Real := fun s => + g a b (clip (2 * s)); + let right : Icc (0 : Real) 1 → Real × Real := fun s => + g b a (clip (2 - 2 * s)); + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2}; + let f : Icc (0 : Real) 1 → Real × Real := + A.piecewise left right; + (Continuous left) → + ((Continuous right) → + ((∀ (s : Icc (0 : Real) 1), + (s ∈ + (Set.univ : Set (Icc (0 : Real) 1)) ∩ + frontier A) → + (left s = right s)) → + (Continuous f)))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g clip left right A f hleftc hrightc hmeet apply continuousOn_univ.mp apply ContinuousOn.piecewise (s := Set.univ) (t := A) hmeet @@ -1154,36 +1173,54 @@ private theorem htm_strict : private theorem htm_start : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - (0 < m) → (∀ (hnpos : 0 < n), - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - (∀ (j : Fin (m + 1)), tm ⟨j.val, by omega⟩ = polyab.time j / 2) → (tm 0 = 0)))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hmpos - hnpos tm left_eval + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count; + let n := polyba.count; + (∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + (∀ (j : Fin (m + 1)), + tm ⟨j.val, by omega⟩ = polyab.time j / 2) → + (tm 0 = 0)))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n hnpos tm + left_eval change tm ⟨0, by omega⟩ = 0 rw [left_eval ⟨0, by omega⟩] simp [polyab.start] @@ -1337,36 +1374,55 @@ private theorem hsuccAt764 : private theorem hlo'At767 : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (i : Fin (m + n)), ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), (tm i.castSucc ≤ - (↑s : ℝ)) → ((i.castSucc = (⟨i.val, by omega⟩ : Fin (m + n + 1))) → (tm ⟨i.val, - by omega⟩ ≤ (s : Real))))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm i s hlo + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count; + let n := polyba.count; + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + ∀ (i : Fin (m + n)), + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), + (tm i.castSucc ≤ (↑s : ℝ)) → + ((i.castSucc = + (⟨i.val, by omega⟩ : Fin (m + n + 1))) → + (tm ⟨i.val, by omega⟩ ≤ (s : Real))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm i s hlo hcast rw [← hcast] exact hlo @@ -1374,36 +1430,55 @@ private theorem hlo'At767 : private theorem hhi'At770 : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (i : Fin (m + n)), ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ((↑s : ℝ) ≤ tm - i.succ) → ((i.succ = (⟨i.val + 1, by omega⟩ : Fin (m + n + 1))) → ((s : Real) ≤ - tm ⟨i.val + 1, by omega⟩)))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm i s hhi + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count; + let n := polyba.count; + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + ∀ (i : Fin (m + n)), + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), + ((↑s : ℝ) ≤ tm i.succ) → + ((i.succ = + (⟨i.val + 1, by omega⟩ : Fin (m + n + 1))) → + ((s : Real) ≤ tm ⟨i.val + 1, by omega⟩)))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm i s hhi hsucc rw [← hsucc] exact hhi @@ -1411,39 +1486,577 @@ private theorem hhi'At770 : private theorem hlastbound : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (i : Fin (m + n)), ∀ (hleftidx : (↑i : ℕ) < m), - let j : Fin m := ⟨i.val, by omega⟩ - let j' : Fin (m + 1) := j.succ - polyab.time j' ≤ 1)) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i hleftidx - j j' + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count; + let n := polyba.count; + ∀ (i : Fin (m + n)), + ∀ (hleftidx : (↑i : ℕ) < m), + let j : Fin m := ⟨i.val, by omega⟩; + let j' : Fin (m + 1) := j.succ; + polyab.time j' ≤ 1)) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n i hleftidx j + j' calc polyab.time j' ≤ polyab.time (Fin.last m) := polyab.strict.monotone (Fin.le_last j') _ = 1 := polyab.finish private theorem hsAAt786 : + (by + classical + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let A : Set (Icc (0 : Real) 1) := + {s | (s : Real) ≤ 1 / 2}; + let m := polyab.count; + let n := polyba.count; + (let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + ∀ (i : Fin (m + n)), + ∀ (hleftidx : (↑i : ℕ) < m), + let j : Fin m := ⟨i.val, by omega⟩; + let j' : Fin (m + 1) := j.succ; + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), + ((s : Real) ≤ tm ⟨i.val + 1, by omega⟩) → + ((tm ⟨i.val + 1, by omega⟩ = + polyab.time j' / 2) → + ((polyab.time j' ≤ 1) → (s ∈ A)))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba A m n tm i + hleftidx j j' s hhi' hend hlastbound + change (s : Real) ≤ 1 / 2 + rw [hend] at hhi' + nlinarith [hlastbound] + +private theorem htlowerAt794 : + (by + classical + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count; + let n := polyba.count; + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + ∀ (i : Fin (m + n)), + ∀ (hleftidx : (↑i : ℕ) < m), + let j : Fin m := ⟨i.val, by omega⟩; + let j' : Fin (m + 1) := j.succ; + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), + (tm ⟨i.val, by omega⟩ ≤ (s : Real)) → + ∀ + (hhi' : + (s : Real) ≤ tm ⟨i.val + 1, by omega⟩), + (tm ⟨i.val, by omega⟩ = + polyab.time j.castSucc / 2) → + ∀ + (hend : + tm ⟨i.val + 1, by omega⟩ = + polyab.time j' / 2), + ∀ (hlastbound : polyab.time j' ≤ 1), + let t : Icc (0 : Real) 1 := + ⟨2 * (s : Real), + by + constructor + · nlinarith [s.property.1] + · nlinarith⟩; + polyab.time j.castSucc ≤ (t : Real)) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm i hleftidx + j j' s hlo' hhi' hstart hend hlastbound t + have h := hlo' + rw [hstart] at h + dsimp [t] + linarith + +private theorem htupperAt799 : + (by + classical + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count; + let n := polyba.count; + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + ∀ (i : Fin (m + n)), + ∀ (hleftidx : (↑i : ℕ) < m), + let j : Fin m := ⟨i.val, by omega⟩; + let j' : Fin (m + 1) := j.succ; + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), + ∀ (hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩), + ∀ + (hend : + tm ⟨i.val + 1, by omega⟩ = + polyab.time j' / 2), + ∀ (hlastbound : polyab.time j' ≤ 1), + let t : Icc (0 : Real) 1 := + ⟨2 * (s : Real), + by + constructor + · nlinarith [s.property.1] + · nlinarith⟩; + (t : Real) ≤ polyab.time j') := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm i hleftidx + j j' s hhi' hend hlastbound t + have h := hhi' + rw [hend] at h + dsimp [t] + linarith + +private theorem htvalAt804 : + (by + classical + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, + max_le (by norm_num) (min_le_left _ _)⟩; + let A : Set (Icc (0 : Real) 1) := + {s | (s : Real) ≤ 1 / 2}; + (∀ (s : Icc (0 : Real) 1), + (s ∈ A) → ((clip (2 * s) : Real) = 2 * s)) → + let m := polyab.count; + let n := polyba.count; + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + ∀ (i : Fin (m + n)), + ∀ (hleftidx : (↑i : ℕ) < m), + let j : Fin m := ⟨i.val, by omega⟩; + let j' : Fin (m + 1) := j.succ; + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), + ∀ + (hhi' : + (s : Real) ≤ tm ⟨i.val + 1, by omega⟩), + ∀ + (hend : + tm ⟨i.val + 1, by omega⟩ = + polyab.time j' / 2), + ∀ (hlastbound : polyab.time j' ≤ 1), + (s ∈ A) → + (let t : Icc (0 : Real) 1 := + ⟨2 * (s : Real), + by + constructor + · nlinarith [s.property.1] + · nlinarith⟩; + clip (2 * s) = t)) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba clip A + hscale_left m n tm i hleftidx j j' s hhi' hend hlastbound hsA t + apply Subtype.ext + exact hscale_left s hsA + +private theorem hfvalueAt807 : + (by + classical + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, + max_le (by norm_num) (min_le_left _ _)⟩; + let left : Icc (0 : Real) 1 → Real × Real := fun s => + g a b (clip (2 * s)); + let right : Icc (0 : Real) 1 → Real × Real := fun s => + g b a (clip (2 - 2 * s)); + let A : Set (Icc (0 : Real) 1) := + {s | (s : Real) ≤ 1 / 2}; + let f : Icc (0 : Real) 1 → Real × Real := + A.piecewise left right; + let m := polyab.count; + let n := polyba.count; + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + ∀ (i : Fin (m + n)), + ∀ (hleftidx : (↑i : ℕ) < m), + let j : Fin m := ⟨i.val, by omega⟩; + let j' : Fin (m + 1) := j.succ; + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), + ∀ (hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩), + ∀ + (hend : + tm ⟨i.val + 1, by omega⟩ = + polyab.time j' / 2), + ∀ (hlastbound : polyab.time j' ≤ 1), + (s ∈ A) → + (let t : Icc (0 : Real) 1 := + ⟨2 * (s : Real), + by + constructor + · nlinarith [s.property.1] + · nlinarith⟩; + (clip (2 * s) = t) → (f s = g a b t))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba clip left right A + f m n tm i hleftidx j j' s hhi' hend hlastbound hsA t htval + calc + f s = left s := Set.piecewise_eqOn A left right hsA + _ = g a b t := by simp [left, htval] + +private theorem hcurIndex : + (by + classical + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count; + let n := polyba.count; + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m; + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; + (⟨n - r, by omega⟩ : Fin (n + 1)) = k.succ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n i r hr k + apply Fin.ext + dsimp [k] + omega + +private theorem hnextIndex : + (by + classical + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count; + let n := polyba.count; + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m; + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; + (⟨n - r - 1, by omega⟩ : Fin (n + 1)) = k.castSucc) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n i r hr k + apply Fin.ext + dsimp [k] + +private theorem hendIndexAt843 : + (by + classical + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count; + let n := polyba.count; + ∀ (i : Fin (m + n)), + (¬(↑i : ℕ) < m) → + (let r : Nat := i.val - m; + ∀ (hr : r < n), + (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = + ⟨m + 1 + r, by omega⟩))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n i hleftidx r + hr + apply Fin.ext + dsimp [r] + omega + +private theorem hstartAt848 : (by classical exact @@ -1455,8 +2068,8 @@ private theorem hsAAt786 : a)), let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := if hab : P3723T1EdgeContact P a b then localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + @@ -1464,29 +2077,128 @@ private theorem hsAAt786 : else D.position a ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} let m := polyab.count let n := polyba.count - (0 < n) → ( + ∀ (hnpos : 0 < n), let tm : Fin (m + n + 1) → Real := fun i => if hi : i.val ≤ m then polyab.time ⟨i.val, by omega⟩ / 2 else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (i : Fin (m + n)), ∀ (hleftidx : (↑i : ℕ) < m), - let j : Fin m := ⟨i.val, by omega⟩ - let j' : Fin (m + 1) := j.succ - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ((s : Real) ≤ tm ⟨i.val + 1, - by omega⟩) → ((tm ⟨i.val + 1, by omega⟩ = polyab.time j' / 2) → ((polyab.time j' ≤ 1) → - (s ∈ A)))))) := by + ∀ (right_eval : ∀ (j : Fin n), tm ⟨m + 1 + j.val, by omega⟩ = + 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2), ∀ (htm_mid : tm ⟨m, by omega⟩ = 1 / + 2), ∀ (i : Fin (m + n)), ∀ (hleftidx : ¬(↑i : ℕ) < m), + let r : Nat := i.val - m + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ + tm ⟨i.val, by omega⟩ = + 1 - polyba.time k.succ / 2 ) := by classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba A m n hnpos tm - i hleftidx j j' s hhi' hend hlastbound - change (s : Real) ≤ 1 / 2 - rw [hend] at hhi' - nlinarith [hlastbound] + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm + right_eval htm_mid i hleftidx r hr k + by_cases hrzero : r = 0 + · have hiv : i.val = m := by dsimp [r] at hrzero ⊢; omega + have hindex : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = ⟨m, by omega⟩ := by + apply Fin.ext + exact hiv + have hksucc : k.succ = Fin.last n := by + apply Fin.ext + dsimp [k] + omega + calc + tm ⟨i.val, by omega⟩ = tm ⟨m, by omega⟩ := congrArg tm hindex + _ = 1 / 2 := htm_mid + _ = 1 - polyba.time k.succ / 2 := by rw [hksucc, polyba.finish]; norm_num + · let j : Fin n := ⟨r - 1, by omega⟩ + have hstartIndex : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = + ⟨m + 1 + j.val, by omega⟩ := by + apply Fin.ext + dsimp [j, r] + omega + calc + tm ⟨i.val, by omega⟩ = tm ⟨m + 1 + j.val, by omega⟩ := + congrArg tm hstartIndex + _ = 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2 := right_eval j + _ = 1 - polyba.time k.succ / 2 := by + have hidx : (⟨n - 1 - j.val, by omega⟩ : Fin (n + 1)) = k.succ := by + apply Fin.ext + dsimp [k, j, r] + omega + exact congrArg (fun z : Real => 1 - z / 2) + (congrArg polyba.time hidx) -private theorem htlowerAt794 : +private theorem hendAt880 : + (by + classical + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count; + let n := polyba.count; + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + (∀ (j : Fin n), + tm ⟨m + 1 + j.val, by omega⟩ = + 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2) → + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m; + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; + ((⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = + ⟨m + 1 + r, by omega⟩) → + (tm ⟨i.val + 1, by omega⟩ = + 1 - polyba.time k.castSucc / 2)) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm right_eval + i r hr k hendIndex + calc + tm ⟨i.val + 1, by omega⟩ = tm ⟨m + 1 + r, by omega⟩ := + congrArg tm hendIndex + _ = 1 - polyba.time ⟨n - 1 - r, by omega⟩ / 2 := + right_eval ⟨r, hr⟩ + _ = 1 - polyba.time k.castSucc / 2 := by + have hidx : (⟨n - 1 - r, by omega⟩ : Fin (n + 1)) = k.castSucc := by + apply Fin.ext + dsimp [k] + omega + exact congrArg (fun z : Real => 1 - z / 2) + (congrArg polyba.time hidx) + +private theorem hA_imp_mid : (by classical exact @@ -1498,8 +2210,8 @@ private theorem htlowerAt794 : a)), let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := if hab : P3723T1EdgeContact P a b then localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + @@ -1507,431 +2219,7 @@ private theorem htlowerAt794 : else D.position a ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (hnpos : 0 < n), - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (i : Fin (m + n)), ∀ (hleftidx : (↑i : ℕ) < m), - let j : Fin m := ⟨i.val, by omega⟩ - let j' : Fin (m + 1) := j.succ - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), ∀ - (hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩), ∀ (hstart : tm ⟨i.val, by omega⟩ = - polyab.time j.castSucc / 2), ∀ (hend : tm ⟨i.val + 1, by omega⟩ = polyab.time j' / - 2), ∀ (hlastbound : polyab.time j' ≤ 1), - let t : Icc (0 : Real) 1 := ⟨2 * (s : Real), by - constructor - · nlinarith [s.property.1] - · nlinarith⟩ - polyab.time j.castSucc ≤ (t : Real) ) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm i - hleftidx j j' s hlo' hhi' hstart hend hlastbound t - have h := hlo' - rw [hstart] at h - dsimp [t] - linarith - -private theorem htupperAt799 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (hnpos : 0 < n), - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (i : Fin (m + n)), ∀ (hleftidx : (↑i : ℕ) < m), - let j : Fin m := ⟨i.val, by omega⟩ - let j' : Fin (m + 1) := j.succ - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hhi' : (s : Real) ≤ tm ⟨i.val + 1, - by omega⟩), ∀ (hend : tm ⟨i.val + 1, by omega⟩ = polyab.time j' / 2), ∀ (hlastbound : - polyab.time j' ≤ 1), - let t : Icc (0 : Real) 1 := ⟨2 * (s : Real), by - constructor - · nlinarith [s.property.1] - · nlinarith⟩ - (t : Real) ≤ polyab.time j' ) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm i - hleftidx j j' s hhi' hend hlastbound t - have h := hhi' - rw [hend] at h - dsimp [t] - linarith - -private theorem htvalAt804 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let clip (x : Real) : Icc (0 : Real) 1 := - ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ - let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} - ∀ (hscale_left : ∀ (s : Icc (0 : Real) 1), (s ∈ A) → ((clip (2 * s) : Real) = 2 * s)), - let m := polyab.count - let n := polyba.count - ∀ (hnpos : 0 < n), - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (i : Fin (m + n)), ∀ (hleftidx : (↑i : ℕ) < m), - let j : Fin m := ⟨i.val, by omega⟩ - let j' : Fin (m + 1) := j.succ - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hhi' : (s : Real) ≤ tm ⟨i.val + 1, - by omega⟩), ∀ (hend : tm ⟨i.val + 1, by omega⟩ = polyab.time j' / 2), ∀ (hlastbound : - polyab.time j' ≤ 1), (s ∈ A) → ( - let t : Icc (0 : Real) 1 := ⟨2 * (s : Real), by - constructor - · nlinarith [s.property.1] - · nlinarith⟩ - clip (2 * s) = t)) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba clip A - hscale_left m n hnpos tm i hleftidx j j' s hhi' hend hlastbound hsA t - apply Subtype.ext - exact hscale_left s hsA - -private theorem hfvalueAt807 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let clip (x : Real) : Icc (0 : Real) 1 := - ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ - let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) - let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) - let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} - let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right - let m := polyab.count - let n := polyba.count - ∀ (hnpos : 0 < n), - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (i : Fin (m + n)), ∀ (hleftidx : (↑i : ℕ) < m), - let j : Fin m := ⟨i.val, by omega⟩ - let j' : Fin (m + 1) := j.succ - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hhi' : (s : Real) ≤ tm ⟨i.val + 1, - by omega⟩), ∀ (hend : tm ⟨i.val + 1, by omega⟩ = polyab.time j' / 2), ∀ (hlastbound : - polyab.time j' ≤ 1), (s ∈ A) → ( - let t : Icc (0 : Real) 1 := ⟨2 * (s : Real), by - constructor - · nlinarith [s.property.1] - · nlinarith⟩ - (clip (2 * s) = t) → (f s = g a b t))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba clip left - right A f m n hnpos tm i hleftidx j j' s hhi' hend hlastbound hsA t htval - calc - f s = left s := Set.piecewise_eqOn A left right hsA - _ = g a b t := by simp [left, htval] - -private theorem hcurIndex : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ - (⟨n - r, by omega⟩ : Fin (n + 1)) = k.succ ) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i r hr k - apply Fin.ext - dsimp [k] - omega - -private theorem hnextIndex : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ - (⟨n - r - 1, by omega⟩ : Fin (n + 1)) = k.castSucc ) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i r hr k - apply Fin.ext - dsimp [k] - -private theorem hendIndexAt843 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (i : Fin (m + n)), (¬(↑i : ℕ) < m) → ( - let r : Nat := i.val - m - ∀ (hr : r < n), (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = - ⟨m + 1 + r, by omega⟩))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i hleftidx - r hr - apply Fin.ext - dsimp [r] - omega - -private theorem hstartAt848 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (hnpos : 0 < n), - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (right_eval : ∀ (j : Fin n), tm ⟨m + 1 + j.val, by omega⟩ = - 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2), ∀ (htm_mid : tm ⟨m, by omega⟩ = 1 / - 2), ∀ (i : Fin (m + n)), ∀ (hleftidx : ¬(↑i : ℕ) < m), - let r : Nat := i.val - m - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ - tm ⟨i.val, by omega⟩ = - 1 - polyba.time k.succ / 2 ) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm - right_eval htm_mid i hleftidx r hr k - by_cases hrzero : r = 0 - · have hiv : i.val = m := by dsimp [r] at hrzero ⊢; omega - have hindex : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = ⟨m, by omega⟩ := by - apply Fin.ext - exact hiv - have hksucc : k.succ = Fin.last n := by - apply Fin.ext - dsimp [k] - omega - calc - tm ⟨i.val, by omega⟩ = tm ⟨m, by omega⟩ := congrArg tm hindex - _ = 1 / 2 := htm_mid - _ = 1 - polyba.time k.succ / 2 := by rw [hksucc, polyba.finish]; norm_num - · let j : Fin n := ⟨r - 1, by omega⟩ - have hstartIndex : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = - ⟨m + 1 + j.val, by omega⟩ := by - apply Fin.ext - dsimp [j, r] - omega - calc - tm ⟨i.val, by omega⟩ = tm ⟨m + 1 + j.val, by omega⟩ := - congrArg tm hstartIndex - _ = 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2 := right_eval j - _ = 1 - polyba.time k.succ / 2 := by - have hidx : (⟨n - 1 - j.val, by omega⟩ : Fin (n + 1)) = k.succ := by - apply Fin.ext - dsimp [k, j, r] - omega - exact congrArg (fun z : Real => 1 - z / 2) - (congrArg polyba.time hidx) - -private theorem hendAt880 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (right_eval : ∀ (j : Fin n), tm ⟨m + 1 + j.val, by omega⟩ = - 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2), ∀ (i : Fin (m + n)), - let r : Nat := i.val - m - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ - ((⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = - ⟨m + 1 + r, by omega⟩) → (tm ⟨i.val + 1, by omega⟩ = - 1 - polyba.time k.castSucc / 2)) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm - right_eval i r hr k hendIndex - calc - tm ⟨i.val + 1, by omega⟩ = tm ⟨m + 1 + r, by omega⟩ := - congrArg tm hendIndex - _ = 1 - polyba.time ⟨n - 1 - r, by omega⟩ / 2 := - right_eval ⟨r, hr⟩ - _ = 1 - polyba.time k.castSucc / 2 := by - have hidx : (⟨n - 1 - r, by omega⟩ : Fin (n + 1)) = k.castSucc := by - apply Fin.ext - dsimp [k] - omega - exact congrArg (fun z : Real => 1 - z / 2) - (congrArg polyba.time hidx) - -private theorem hA_imp_mid : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} let m := polyab.count let n := polyba.count ∀ (hnpos : 0 < n), @@ -1956,54 +2244,80 @@ private theorem hA_imp_mid : have hlow := hlo' rw [hi, htm_mid] at hlow change (s : Real) ≤ 1 / 2 at hsA - exact le_antisymm hsA hlow - exact ⟨heq, hhalf⟩ - · have hi : (⟨m, by omega⟩ : Fin (m + n + 1)) < ⟨i.val, by omega⟩ := by - apply Fin.mk_lt_mk.mpr - omega - have hmid : 1 / 2 < tm ⟨i.val, by omega⟩ := by - calc - 1 / 2 = tm ⟨m, by omega⟩ := htm_mid.symm - _ < tm ⟨i.val, by omega⟩ := htm_strict hi - have hlow := hlo' - change (s : Real) ≤ 1 / 2 at hsA - linarith - -private theorem hsRight : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let clip (x : Real) : Icc (0 : Real) 1 := - ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ - let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) - let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) - let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} - let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right - ∀ (p : ℝ × ℝ), (g a b ⟨1, by norm_num⟩ = p) → ((g b a ⟨1, by norm_num⟩ = p) → ( - let m := polyab.count - let n := polyba.count - ∀ (i : Fin (m + n)), ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), (s ∈ A → i.val = m ∧ (s : - Real) = 1 / 2) → (f s = right s))))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba clip left - right A f p hendab hendba m n i s hA_imp_mid + exact le_antisymm hsA hlow + exact ⟨heq, hhalf⟩ + · have hi : (⟨m, by omega⟩ : Fin (m + n + 1)) < ⟨i.val, by omega⟩ := by + apply Fin.mk_lt_mk.mpr + omega + have hmid : 1 / 2 < tm ⟨i.val, by omega⟩ := by + calc + 1 / 2 = tm ⟨m, by omega⟩ := htm_mid.symm + _ < tm ⟨i.val, by omega⟩ := htm_strict hi + have hlow := hlo' + change (s : Real) ≤ 1 / 2 at hsA + linarith + +private theorem hsRight : + (by + classical + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, + max_le (by norm_num) (min_le_left _ _)⟩; + let left : Icc (0 : Real) 1 → Real × Real := fun s => + g a b (clip (2 * s)); + let right : Icc (0 : Real) 1 → Real × Real := fun s => + g b a (clip (2 - 2 * s)); + let A : Set (Icc (0 : Real) 1) := + {s | (s : Real) ≤ 1 / 2}; + let f : Icc (0 : Real) 1 → Real × Real := + A.piecewise left right; + ∀ (p : ℝ × ℝ), + (g a b ⟨1, by norm_num⟩ = p) → + ((g b a ⟨1, by norm_num⟩ = p) → + (let m := polyab.count; + let n := polyba.count; + ∀ (i : Fin (m + n)), + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), + (s ∈ A → i.val = m ∧ (s : Real) = 1 / 2) → + (f s = right s))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba clip left right A + f p hendab hendba m n i s hA_imp_mid by_cases hsA : s ∈ A · obtain ⟨_, hhalf⟩ := hA_imp_mid hsA have hc1 : clip (2 * s) = ⟨1, by norm_num⟩ := by @@ -2027,33 +2341,50 @@ private theorem hsRight : private theorem hkbound : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ - polyba.time k.succ ≤ 1 ) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i r hr k + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count; + let n := polyba.count; + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m; + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; + polyba.time k.succ ≤ 1) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n i r hr k calc polyba.time k.succ ≤ polyba.time (Fin.last n) := polyba.strict.monotone (Fin.le_last k.succ) @@ -2062,41 +2393,60 @@ private theorem hkbound : private theorem hsHalf : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), (tm ⟨i.val, by omega⟩ ≤ (s : Real)) → ((tm - ⟨i.val, by omega⟩ = - 1 - polyba.time k.succ / 2) → ((polyba.time k.succ ≤ 1) → ((1 / 2 : Real) ≤ s)))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm i r hr - k s hlo' hstart hkbound + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count; + let n := polyba.count; + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m; + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), + (tm ⟨i.val, by omega⟩ ≤ (s : Real)) → + ((tm ⟨i.val, by omega⟩ = + 1 - polyba.time k.succ / 2) → + ((polyba.time k.succ ≤ 1) → + ((1 / 2 : Real) ≤ s)))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm i r hr k s + hlo' hstart hkbound have hlow := hlo' rw [hstart] at hlow nlinarith @@ -2104,50 +2454,73 @@ private theorem hsHalf : private theorem htlowerAt951 : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), ∀ - (hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩), ∀ (hstart : tm ⟨i.val, by omega⟩ = - 1 - polyba.time k.succ / 2), ∀ (hend : tm ⟨i.val + 1, by omega⟩ = - 1 - polyba.time k.castSucc / 2), ∀ (hkbound : polyba.time k.succ ≤ 1), ∀ (hsHalf : (1 / - 2 : Real) ≤ s), - let t : Icc (0 : Real) 1 := ⟨2 - 2 * (s : Real), by - constructor - · have hlow := hlo' - rw [hstart] at hlow - nlinarith [s.property.2] - · nlinarith [s.property.1, hsHalf]⟩ - polyba.time k.castSucc ≤ (t : Real) ) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm i r hr - k s hlo' hhi' hstart hend hkbound hsHalf t + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count; + let n := polyba.count; + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m; + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), + ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), + ((s : Real) ≤ tm ⟨i.val + 1, by omega⟩) → + ∀ + (hstart : + tm ⟨i.val, by omega⟩ = + 1 - polyba.time k.succ / 2), + (tm ⟨i.val + 1, by omega⟩ = + 1 - polyba.time k.castSucc / 2) → + ∀ (hkbound : polyba.time k.succ ≤ 1), + let t : Icc (0 : Real) 1 := + ⟨2 - 2 * (s : Real), + by + constructor + · have hlow := hlo' + rw [hstart] at hlow + nlinarith [s.property.2] + · nlinarith [s.property.1, hsHalf]⟩; + polyba.time k.castSucc ≤ (t : Real)) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm i r hr k s + hlo' hhi' hstart hend hkbound t have h := hhi' rw [hend] at h dsimp [t] @@ -2156,49 +2529,70 @@ private theorem htlowerAt951 : private theorem htupperAt956 : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), ∀ - (hstart : tm ⟨i.val, by omega⟩ = - 1 - polyba.time k.succ / 2), ∀ (hkbound : polyba.time k.succ ≤ 1), ∀ (hsHalf : (1 / 2 : - Real) ≤ s), - let t : Icc (0 : Real) 1 := ⟨2 - 2 * (s : Real), by - constructor - · have hlow := hlo' - rw [hstart] at hlow - nlinarith [s.property.2] - · nlinarith [s.property.1, hsHalf]⟩ - (t : Real) ≤ polyba.time k.succ ) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm i r hr - k s hlo' hstart hkbound hsHalf t + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count; + let n := polyba.count; + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m; + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), + ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), + ∀ + (hstart : + tm ⟨i.val, by omega⟩ = + 1 - polyba.time k.succ / 2), + ∀ (hkbound : polyba.time k.succ ≤ 1), + let t : Icc (0 : Real) 1 := + ⟨2 - 2 * (s : Real), + by + constructor + · have hlow := hlo' + rw [hstart] at hlow + nlinarith [s.property.2] + · nlinarith [s.property.1, hsHalf]⟩; + (t : Real) ≤ polyba.time k.succ) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm i r hr k s + hlo' hstart hkbound t have h := hlo' rw [hstart] at h dsimp [t] @@ -2207,54 +2601,78 @@ private theorem htupperAt956 : private theorem htvalAt961 : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let clip (x : Real) : Icc (0 : Real) 1 := - ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ - let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} - ∀ (hscale_right : ∀ (s : Icc (0 : Real) 1), (s ∉ A) → ((clip (2 - 2 * s) : Real) = 2 - 2 - * s)), - let m := polyab.count - let n := polyba.count - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), ∀ - (hstart : tm ⟨i.val, by omega⟩ = - 1 - polyba.time k.succ / 2), ∀ (hA_imp_mid : s ∈ A → i.val = m ∧ (s : Real) = 1 / 2), ∀ - (hkbound : polyba.time k.succ ≤ 1), ∀ (hsHalf : (1 / 2 : Real) ≤ s), - let t : Icc (0 : Real) 1 := ⟨2 - 2 * (s : Real), by - constructor - · have hlow := hlo' - rw [hstart] at hlow - nlinarith [s.property.2] - · nlinarith [s.property.1, hsHalf]⟩ - clip (2 - 2 * s) = t ) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba clip A - hscale_right m n tm i r hr k s hlo' hstart hA_imp_mid hkbound hsHalf t + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, + max_le (by norm_num) (min_le_left _ _)⟩; + let A : Set (Icc (0 : Real) 1) := + {s | (s : Real) ≤ 1 / 2}; + (∀ (s : Icc (0 : Real) 1), + (s ∉ A) → ((clip (2 - 2 * s) : Real) = 2 - 2 * s)) → + let m := polyab.count; + let n := polyba.count; + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m; + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), + ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), + ∀ + (hstart : + tm ⟨i.val, by omega⟩ = + 1 - polyba.time k.succ / 2), + (s ∈ A → i.val = m ∧ (s : Real) = 1 / 2) → + ∀ (hkbound : polyba.time k.succ ≤ 1), + let t : Icc (0 : Real) 1 := + ⟨2 - 2 * (s : Real), + by + constructor + · have hlow := hlo' + rw [hstart] at hlow + nlinarith [s.property.2] + · nlinarith [s.property.1, hsHalf]⟩; + clip (2 - 2 * s) = t) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba clip A + hscale_right m n tm i r hr k s hlo' hstart hA_imp_mid hkbound t apply Subtype.ext change (clip (2 - 2 * (s : Real)) : Real) = 2 - 2 * (s : Real) by_cases hsA : s ∈ A @@ -2267,55 +2685,82 @@ private theorem htvalAt961 : private theorem hfvalueAt970 : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let clip (x : Real) : Icc (0 : Real) 1 := - ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ - let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) - let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) - let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} - let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right - let m := polyab.count - let n := polyba.count - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), ∀ - (hstart : tm ⟨i.val, by omega⟩ = - 1 - polyba.time k.succ / 2), ∀ (hsRight : f s = right s), ∀ (hkbound : polyba.time - k.succ ≤ 1), ∀ (hsHalf : (1 / 2 : Real) ≤ s), - let t : Icc (0 : Real) 1 := ⟨2 - 2 * (s : Real), by - constructor - · have hlow := hlo' - rw [hstart] at hlow - nlinarith [s.property.2] - · nlinarith [s.property.1, hsHalf]⟩ - (clip (2 - 2 * s) = t) → (f s = g b a t) ) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba clip left - right A f m n tm i r hr k s hlo' hstart hsRight hkbound hsHalf t htval + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, + max_le (by norm_num) (min_le_left _ _)⟩; + let left : Icc (0 : Real) 1 → Real × Real := fun s => + g a b (clip (2 * s)); + let right : Icc (0 : Real) 1 → Real × Real := fun s => + g b a (clip (2 - 2 * s)); + let A : Set (Icc (0 : Real) 1) := + {s | (s : Real) ≤ 1 / 2}; + let f : Icc (0 : Real) 1 → Real × Real := + A.piecewise left right; + let m := polyab.count; + let n := polyba.count; + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + ∀ (i : Fin (m + n)), + let r : Nat := i.val - m; + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), + ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), + ∀ + (hstart : + tm ⟨i.val, by omega⟩ = + 1 - polyba.time k.succ / 2), + (f s = right s) → + ∀ (hkbound : polyba.time k.succ ≤ 1), + let t : Icc (0 : Real) 1 := + ⟨2 - 2 * (s : Real), + by + constructor + · have hlow := hlo' + rw [hstart] at hlow + nlinarith [s.property.2] + · nlinarith [s.property.1, hsHalf]⟩; + (clip (2 - 2 * s) = t) → (f s = g b a t)) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba clip left right A + f m n tm i r hr k s hlo' hstart hsRight hkbound t htval calc f s = right s := hsRight _ = g b a t := by simp [right, htval] @@ -2721,32 +3166,55 @@ private theorem hendAt1222 : private theorem vertex_mem : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - let halfArc (a b : ι) : Set (Real × Real) := - if P3723T1EdgeContact P a b then Set.range (g a b) else ∅ - let edgeArc (a b : ι) : Set (Real × Real) := halfArc a b ∪ halfArc b a - (∀ (x : ι), ∀ (y : ι), (P3723T1EdgeContact P x y) → (D.position x ∈ edgeArc x y)) → ((∀ - (x : ι), ∀ (y : ι), (P3723T1EdgeContact P x y) → (D.position y ∈ edgeArc x y)) → (∀ - (x : ι), ∀ (y : ι), ∀ (i : ι), (P3723T1EdgeContact P x y) → ((i = x ∨ i = y) → - (D.position i ∈ edgeArc x y)))))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g halfArc edgeArc hstart hend - x y i hxy hi + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), + (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + let halfArc (a b : ι) : Set (Real × Real) := + if P3723T1EdgeContact P a b then Set.range (g a b) else ∅; + let edgeArc (a b : ι) : Set (Real × Real) := + halfArc a b ∪ halfArc b a; + (∀ (x : ι), + ∀ (y : ι), + (P3723T1EdgeContact P x y) → + (D.position x ∈ edgeArc x y)) → + ((∀ (x : ι), + ∀ (y : ι), + (P3723T1EdgeContact P x y) → + (D.position y ∈ edgeArc x y)) → + (∀ (x : ι), + ∀ (y : ι), + ∀ (i : ι), + (P3723T1EdgeContact P x y) → + ((i = x ∨ i = y) → (D.position i ∈ edgeArc x y)))))) := by + classical + intro ι P D localStar rep rep_spec period pulled_contact g halfArc edgeArc hstart hend x y i + hxy hi rcases hi with hi | hi · rw [hi] exact hstart x y hxy @@ -2756,34 +3224,67 @@ private theorem vertex_mem : private theorem hab_mem : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - (∀ a, ∀ b, P3723T1EdgeContact P a b → - Continuous (g a b) ∧ Function.Injective (g a b) ∧ - g a b ⟨0, by norm_num⟩ = D.position a ∧ - D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ - Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ - Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ - {g a b ⟨1, by norm_num⟩}) → (∀ (c : ι), ∀ (d : ι), (P3723T1EdgeContact P b a) → (∀ - (i : ι), (i ∈ ({a, b} : Set ι) ∩ {c, d}) → ((i = a ∨ i = b) → ((i = c ∨ i = d) → - (D.position i ∈ Set.range (g a b) ∪ Set.range (g b a)))))))) := by + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + (P3723T1EdgeContact P a b) → + (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ + s + + GaussianRealPoint (period a) + else D.position a; + (∀ a, + ∀ b, + P3723T1EdgeContact P a b → + Continuous (g a b) ∧ + Function.Injective (g a b) ∧ + g a b ⟨0, by norm_num⟩ = D.position a ∧ + D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ + Nonempty + (P3723T1PolygonalParameterization + (g a b)) ∧ + Set.range (g a b) ⊆ + interior + (TileRealization (P.tile a)) ∪ + {g a b ⟨1, by norm_num⟩}) → + (∀ (c : ι), + ∀ (d : ι), + (P3723T1EdgeContact P b a) → + (∀ (i : ι), + (i ∈ ({ a, b } : Set ι) ∩ { c, d }) → + ((i = a ∨ i = b) → + (D.position i ∈ + Set.range (g a b) ∪ + Set.range (g b a))))))) := by classical intro ι P D a b localStar rep rep_spec period pulled_contact hab g gproperties c d hba i hi - hiab hicd + hiab rcases hiab with hi | hi · subst i left @@ -2795,36 +3296,65 @@ private theorem hab_mem : private theorem hcd_mem : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - (∀ a, ∀ b, P3723T1EdgeContact P a b → - Continuous (g a b) ∧ Function.Injective (g a b) ∧ - g a b ⟨0, by norm_num⟩ = D.position a ∧ - D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ - Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ - Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ - {g a b ⟨1, by norm_num⟩}) → (∀ (c : ι), ∀ (d : ι), (P3723T1EdgeContact P c d) → - ((P3723T1EdgeContact P d c) → (∀ (i : ι), (i ∈ ({a, b} : Set ι) ∩ {c, d}) → ((i - = a ∨ i = - b) → ((i = c ∨ i = d) → ((D.position i ∈ Set.range (g a b) ∪ Set.range (g b a)) → - (D.position i ∈ Set.range (g c d) ∪ Set.range (g d c)))))))))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g gproperties c d hcd hdc i hi - hiab hicd hab_mem + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := + Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) + (P.shift (-period a) b))), + (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + (∀ a, + ∀ b, + P3723T1EdgeContact P a b → + Continuous (g a b) ∧ + Function.Injective (g a b) ∧ + g a b ⟨0, by norm_num⟩ = D.position a ∧ + D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ + Nonempty + (P3723T1PolygonalParameterization + (g a b)) ∧ + Set.range (g a b) ⊆ + interior (TileRealization (P.tile a)) ∪ + {g a b ⟨1, by norm_num⟩}) → + (∀ (c : ι), + ∀ (d : ι), + (P3723T1EdgeContact P c d) → + ((P3723T1EdgeContact P d c) → + (∀ (i : ι), + (i ∈ ({ a, b } : Set ι) ∩ { c, d }) → + ((i = c ∨ i = d) → + (D.position i ∈ + Set.range (g c d) ∪ + Set.range (g d c)))))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact g gproperties c d hcd hdc i hi + hicd rcases hicd with hi | hi · subst i left @@ -3017,7 +3547,7 @@ private theorem hpoly : have htm_strict := ContactDrawingGeometry.htm_strict ι P D a b localStar rep_spec pulled_contact hab polyab polyba hnpos left_eval right_eval have htm_start := ContactDrawingGeometry.htm_start ι P D a b localStar rep_spec - pulled_contact hab polyab polyba hmpos hnpos left_eval + pulled_contact polyab polyba hnpos left_eval have htm_mid := ContactDrawingGeometry.htm_mid ι P D a b localStar rep_spec pulled_contact hab polyab polyba hnpos left_eval have htm_finish := ContactDrawingGeometry.htm_finish ι P D a b localStar rep_spec @@ -3043,9 +3573,9 @@ private theorem hpoly : have hsucc := ContactDrawingGeometry.hsuccAt764 ι P D a b localStar rep_spec pulled_contact hab polyab polyba i have hlo' := ContactDrawingGeometry.hlo'At767 ι P D a b localStar rep_spec pulled_contact - hab polyab polyba i s hlo hcast + polyab polyba i s hlo hcast have hhi' := ContactDrawingGeometry.hhi'At770 ι P D a b localStar rep_spec pulled_contact - hab polyab polyba i s hhi hsucc + polyab polyba i s hhi hsucc have hstartIndex : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = ⟨j.castSucc.val, by omega⟩ := by apply Fin.ext; rfl have hendIndex : (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = @@ -3055,21 +3585,21 @@ private theorem hpoly : have hend : tm ⟨i.val + 1, by omega⟩ = polyab.time j' / 2 := by rw [hendIndex, left_eval j'] have hlastbound := ContactDrawingGeometry.hlastbound ι P D a b localStar rep_spec - pulled_contact hab polyab polyba i hleftidx + pulled_contact polyab polyba i hleftidx have hsA := ContactDrawingGeometry.hsAAt786 ι P D a b localStar rep_spec pulled_contact - hab polyab polyba hnpos i hleftidx s hhi' hend hlastbound + polyab polyba i hleftidx s hhi' hend hlastbound let t : Icc (0 : Real) 1 := ⟨2 * (s : Real), by constructor · nlinarith [s.property.1] · nlinarith⟩ have htlower := ContactDrawingGeometry.htlowerAt794 ι P D a b localStar rep_spec - pulled_contact hab polyab polyba hnpos i hleftidx s hlo' hhi' hstart hend hlastbound + pulled_contact polyab polyba i hleftidx s hlo' hhi' hstart hend hlastbound have htupper := ContactDrawingGeometry.htupperAt799 ι P D a b localStar rep_spec - pulled_contact hab polyab polyba hnpos i hleftidx s hhi' hend hlastbound + pulled_contact polyab polyba i hleftidx s hhi' hend hlastbound have htval := ContactDrawingGeometry.htvalAt804 ι P D a b localStar rep_spec - pulled_contact hab polyab polyba hscale_left hnpos i hleftidx s hhi' hend hlastbound hsA + pulled_contact polyab polyba hscale_left i hleftidx s hhi' hend hlastbound hsA have hfvalue := ContactDrawingGeometry.hfvalueAt807 ι P D a b localStar rep_spec - pulled_contact hab polyab polyba hnpos i hleftidx s hhi' hend hlastbound hsA htval + pulled_contact polyab polyba i hleftidx s hhi' hend hlastbound hsA htval calc f s = g a b t := hfvalue _ = C + (t : Real) • V := hpiece t htlower htupper @@ -3088,32 +3618,30 @@ private theorem hpoly : have hsucc := ContactDrawingGeometry.hsuccAt764 ι P D a b localStar rep_spec pulled_contact hab polyab polyba i have hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real) := ContactDrawingGeometry.hlo'At767 ι P D a b - localStar rep_spec pulled_contact - hab polyab polyba i s hlo hcast + localStar rep_spec pulled_contact polyab polyba i s hlo hcast have hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩ := ContactDrawingGeometry.hhi'At770 ι P D - a b localStar rep_spec pulled_contact - hab polyab polyba i s hhi hsucc + a b localStar rep_spec pulled_contact polyab polyba i s hhi hsucc have hcurIndex := ContactDrawingGeometry.hcurIndex ι P D a b localStar rep_spec - pulled_contact hab polyab polyba i hr + pulled_contact polyab polyba i hr have hnextIndex := ContactDrawingGeometry.hnextIndex ι P D a b localStar rep_spec - pulled_contact hab polyab polyba i hr + pulled_contact polyab polyba i hr have hendIndex : (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = ⟨m + 1 + r, by omega⟩ := ContactDrawingGeometry.hendIndexAt843 ι P D a b localStar - rep_spec pulled_contact hab polyab polyba i hleftidx hr + rep_spec pulled_contact polyab polyba i hleftidx hr have hstart : tm ⟨i.val, by omega⟩ = 1 - polyba.time k.succ / 2 := ContactDrawingGeometry.hstartAt848 ι P D a b localStar rep_spec pulled_contact hab polyab polyba hnpos right_eval htm_mid i hleftidx hr have hend : tm ⟨i.val + 1, by omega⟩ = 1 - polyba.time k.castSucc / 2 := ContactDrawingGeometry.hendAt880 ι P D a b - localStar rep_spec pulled_contact hab polyab polyba right_eval i hr hendIndex + localStar rep_spec pulled_contact polyab polyba right_eval i hr hendIndex have hA_imp_mid := ContactDrawingGeometry.hA_imp_mid ι P D a b localStar rep_spec pulled_contact hab polyab polyba hnpos htm_strict htm_mid i hleftidx hr s hlo' have hsRight := ContactDrawingGeometry.hsRight ι P D a b localStar rep_spec - pulled_contact hab polyab polyba p hendab hendba i s hA_imp_mid + pulled_contact polyab polyba p hendab hendba i s hA_imp_mid have hkbound := ContactDrawingGeometry.hkbound ι P D a b localStar rep_spec - pulled_contact hab polyab polyba i hr + pulled_contact polyab polyba i hr have hsHalf := ContactDrawingGeometry.hsHalf ι P D a b localStar rep_spec pulled_contact - hab polyab polyba i hr s hlo' hstart hkbound + polyab polyba i hr s hlo' hstart hkbound let t : Icc (0 : Real) 1 := ⟨2 - 2 * (s : Real), by constructor · have hlow := hlo' @@ -3121,14 +3649,13 @@ private theorem hpoly : nlinarith [s.property.2] · nlinarith [s.property.1, hsHalf]⟩ have htlower := ContactDrawingGeometry.htlowerAt951 ι P D a b localStar rep_spec - pulled_contact hab polyab polyba i hr s hlo' hhi' hstart hend hkbound hsHalf + pulled_contact polyab polyba i hr s hlo' hhi' hstart hend hkbound have htupper := ContactDrawingGeometry.htupperAt956 ι P D a b localStar rep_spec - pulled_contact hab polyab polyba i hr s hlo' hstart hkbound hsHalf + pulled_contact polyab polyba i hr s hlo' hstart hkbound have htval := ContactDrawingGeometry.htvalAt961 ι P D a b localStar rep_spec - pulled_contact hab polyab polyba hscale_right i hr s hlo' hstart hA_imp_mid hkbound - hsHalf + pulled_contact polyab polyba hscale_right i hr s hlo' hstart hA_imp_mid hkbound have hfvalue := ContactDrawingGeometry.hfvalueAt970 ι P D a b localStar rep_spec - pulled_contact hab polyab polyba i hr s hlo' hstart hsRight hkbound hsHalf htval + pulled_contact polyab polyba i hr s hlo' hstart hsRight hkbound htval calc f s = g b a t := hfvalue _ = C + (t : Real) • V := hpiece t htlower htupper @@ -3196,7 +3723,7 @@ private theorem full_parameters : have hmeet (s : Icc (0 : Real) 1) (hs : s ∈ (Set.univ : Set (Icc (0 : Real) 1)) ∩ frontier A) := ContactDrawingGeometry.hmeet ι P D a b localStar rep_spec pulled_contact hab hg1ab hg1ba s hs - have hfcont := ContactDrawingGeometry.hfcont ι P D a b localStar rep_spec pulled_contact hab + have hfcont := ContactDrawingGeometry.hfcont ι P D a b localStar rep_spec pulled_contact hleftc hrightc hmeet have hscale_left (s : Icc (0 : Real) 1) (hs : s ∈ A) := ContactDrawingGeometry.hscale_left s hs have hscale_right (s : Icc (0 : Real) 1) (hs : s ∉ A) := ContactDrawingGeometry.hscale_right @@ -3341,8 +3868,8 @@ private theorem drawingCertificate : D.position y ∈ edgeArc x y := ContactDrawingGeometry.hendAt1222 ι P D symmetric a b localStar rep_spec pulled_contact hab gproperties x y hxy have vertex_mem (x y i : ι) (hxy : P3723T1EdgeContact P x y) - (hi : i = x ∨ i = y) := ContactDrawingGeometry.vertex_mem ι P D a b localStar rep_spec - pulled_contact hab hstart hend x y i hxy hi + (hi : i = x ∨ i = y) := ContactDrawingGeometry.vertex_mem ι P D localStar rep_spec + pulled_contact hstart hend x y i hxy hi have hfull : edgeArc a b = halfArc a b ∪ halfArc b a := rfl have hfull' : edgeArc c d = halfArc c d ∪ halfArc d c := rfl simp only [edgeArc, halfArc, ite_eq_left hab, ite_eq_left hba, ite_eq_left hcd, ite_eq_left @@ -3367,9 +3894,9 @@ private theorem drawingCertificate : have hiab : i = a ∨ i = b := by simpa using hi.1 have hicd : i = c ∨ i = d := by simpa using hi.2 have hab_mem := ContactDrawingGeometry.hab_mem ι P D a b localStar rep_spec pulled_contact - hab gproperties c d hba i hi hiab hicd + hab gproperties c d hba i hi hiab have hcd_mem := ContactDrawingGeometry.hcd_mem ι P D a b localStar rep_spec pulled_contact - hab gproperties c d hcd hdc i hi hiab hicd hab_mem + gproperties c d hcd hdc i hi hicd exact ⟨hab_mem, hcd_mem⟩ · intro K hK let cells : Set GaussianInt := @@ -3420,7 +3947,7 @@ theorem P3723T1AllContactDrawingExists {ι : Type} (P : PeriodicTileComplex ι) ∃ R : P3723T1AllContactRouting P, R.toP3723T1ContactPorts = D := by -- BODY classical - have symmetric (a b : ι) := ContactDrawingGeometry.symmetric ι P a b + have symmetric (a b : ι) := PeriodicEdgeContactSymmetry.symmetric ι P a b have present (a b : ι) (p : Real × Real) (hp : D.port a b = some p) := ContactDrawingGeometry.present ι P D a b p hp have port_exists (a b : ι) (hab : P3723T1EdgeContact P a b) := diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean index ac106537ea..cdf135978d 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.PeriodicEdgeContactSymmetry public import LeanPool.ApollonianSuperharmonic.P3723T1ContactPorts public import LeanPool.ApollonianSuperharmonic.P3723T1ContactStabilizer @@ -399,15 +400,6 @@ private theorem rep_spec : intro ι P rep a exact Classical.choose_spec (P.vertex_orbit_representatives a).exists -private theorem contact_symmetric : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P - a b ↔ P3723T1EdgeContact P b a ) := by - classical - intro ι P a b - simp only [P3723T1EdgeContact, ne_comm, Set.inter_comm] private theorem shift_injective : (by @@ -1192,7 +1184,7 @@ private theorem contact_symmetric : a b ↔ P3723T1EdgeContact P b a ) := by classical intro ι P a b - exact ContactPortGeometry.contact_symmetric ι P a b + exact PeriodicEdgeContactSymmetry.symmetric ι P a b private theorem common_edge_transport : (by diff --git a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean index 46b265237a..18a8976cd0 100644 --- a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean +++ b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean @@ -1861,32 +1861,49 @@ private theorem hxi : private theorem hxj : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : - P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ - (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((Fin (3 : ℕ)) → (∀ (s : (k - : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · have hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · have hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let v : Fin 3 → ι := P.plane.faceVertex f - (∀ (k : Fin 3), ∀ (r : Fin (s k).count), ∀ (x : Real × Real), (x ∈ segment Real (w k - r.castSucc) (w k r.succ)) → ((x = D.position (v k)) → (x = w k r.castSucc ∨ x = w k - r.succ))) → ((∀ (k : Fin 3), ∀ (r : Fin (s k).count), ∀ (x : Real × Real), (x ∈ - segment Real (w k r.castSucc) (w k r.succ)) → ((x = D.position (v (k + 1))) → (x = w - k r.castSucc ∨ x = w k r.succ))) → (∀ (x : ℝ × ℝ), ∀ (l : Fin (3 : ℕ)), ∀ (r' : Fin - (s l).count), (x ∈ segment ℝ (w l r'.castSucc) (w l r'.succ)) → (∀ (u : ι), - (D.position u = x) → ((u = v l ∨ u = v (l + (1 : Fin (3 : ℕ)))) → (x = w l - r'.castSucc ∨ x = w l r'.succ)))))))) := by + exact + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1AllContactRouting P), + ∀ (f : P.plane.Face), + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + (∀ + (s : + (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : + Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩; + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i); + let v : Fin 3 → ι := P.plane.faceVertex f; + (∀ (k : Fin 3), + ∀ (r : Fin (s k).count), + ∀ (x : Real × Real), + (x ∈ segment Real (w k r.castSucc) (w k r.succ)) → + ((x = D.position (v k)) → + (x = w k r.castSucc ∨ x = w k r.succ))) → + ((∀ (k : Fin 3), + ∀ (r : Fin (s k).count), + ∀ (x : Real × Real), + (x ∈ segment Real (w k r.castSucc) (w k r.succ)) → + ((x = D.position (v (k + 1))) → + (x = w k r.castSucc ∨ x = w k r.succ))) → + (∀ (x : ℝ × ℝ), + ∀ (l : Fin (3 : ℕ)), + ∀ (r' : Fin (s l).count), + (x ∈ segment ℝ (w l r'.castSucc) (w l r'.succ)) → + (∀ (u : ι), + (D.position u = x) → + ((u = v l ∨ u = v (l + (1 : Fin (3 : ℕ)))) → + (x = w l r'.castSucc ∨ x = w l r'.succ))))))) := by classical - intro ι P D f g hi k s τ w v piece_start_corner piece_finish_corner x l r' hx2 u hux hul + intro ι P D f g s τ w v piece_start_corner piece_finish_corner x l r' hx2 u hux hul rcases hul with hul | hul · apply piece_start_corner l r' x hx2 exact hux.symm.trans (congrArg D.position hul) @@ -2037,7 +2054,7 @@ theorem P3913T1RoutedFaceSubdivision : simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at huk hul have hxi := RoutedFaceDetails.hxi ι P D f g hi k s piece_start_corner piece_finish_corner x r hx1 u hux huk - have hxj := RoutedFaceDetails.hxj ι P D f g hi k + have hxj := RoutedFaceDetails.hxj ι P D f g s piece_start_corner piece_finish_corner x l r' hx2 u hux hul simpa [hli, hri, hlj, hrj] using And.intro hxi hxj · intro hx diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean index 72324e14dc..9a81501e70 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean @@ -50,48 +50,77 @@ private theorem reverseLocal : exact negSign k (B.1 * (q.2 - z.2) - B.2 * (q.1 - z.1)) private theorem hscale : - ∀ (S : Set (Real × Real)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : - (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization - g), ∀ (q : P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ - (hhrange : Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ - ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ - (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ - let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ - ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), - let GH := - Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont - let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont - let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm - let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ - let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ - ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time - j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ - let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ - let c : Real := min (phi α : Real) (β : Real) - ∀ (hcpos : 0 < c), ((c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), - let r1 : Set.Icc (0 : Real) 1 - := ⟨c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - ((r1 : Real) < (r2 : Real)) → ( - let xL : Set.Icc (0 : Real) 1 := phi.symm r1 - let xR : Set.Icc (0 : Real) 1 := phi.symm r2 - ∀ (Bg : ℝ × ℝ), ∀ (Bh : ℝ × ℝ), (((xR : Real) - (xL : Real)) • Bg = ((r2 : Real) - (r1 : - Real)) • Bh) → ( - let scale : Real := ((xR : Real) - (xL : Real)) / ((r2 : Real) - (r1 : - Real)) - Bh = scale • Bg)))) := by + ∀ (S : Set (Real × Real)), + ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (p : P3723T1PolygonalParameterization g), + ∀ (q : P3723T1PolygonalParameterization h), + ∀ (hgrange : Set.range g = S), + ∀ (hhrange : Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; + ∀ (hgfun_inj : Function.Injective gfun), + ∀ (hhfun_inj : Function.Injective hfun), + ∀ (hgfun_surj : Function.Surjective gfun), + ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; + let he : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; + ∀ (hgfun_cont : Continuous gfun), + ∀ (hhfun_cont : Continuous hfun), + let GH := + Continuous.homeoOfEquivCompactToT2 (f := ge) + hgfun_cont; + let HH := + Continuous.homeoOfEquivCompactToT2 (f := he) + hhfun_cont; + let phi : + Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := + GH.trans HH.symm; + let i1 : Fin (p.count + 1) := + ⟨1, by have hp := p.positive; omega⟩; + let j1 : Fin (q.count + 1) := + ⟨1, by have hq := q.positive; omega⟩; + ∀ (hpi : 0 < p.time i1), + ∀ (hqj : 0 < q.time j1), + ∀ (hpi1 : p.time i1 ≤ 1), + ∀ (hqj1 : q.time j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := + ⟨p.time i1, hpi.le, hpi1⟩; + let β : Set.Icc (0 : Real) 1 := + ⟨q.time j1, hqj.le, hqj1⟩; + let c : Real := min (phi α : Real) (β : Real); + ∀ (hcpos : 0 < c), + (∀ (hc_le_one : c ≤ 1), + let r1 : Set.Icc (0 : Real) 1 := + ⟨c / 3, + ⟨by linarith [hcpos], by + have := hc_le_one; linarith⟩⟩; + let r2 : Set.Icc (0 : Real) 1 := + ⟨2 * c / 3, + ⟨by linarith [hcpos], by + have := hc_le_one; linarith⟩⟩; + ((r1 : Real) < (r2 : Real)) → + (let xL : Set.Icc (0 : Real) 1 := + phi.symm r1; + let xR : Set.Icc (0 : Real) 1 := + phi.symm r2; + ∀ (Bg : ℝ × ℝ), + ∀ (Bh : ℝ × ℝ), + (((xR : Real) - (xL : Real)) • Bg = + ((r2 : Real) - (r1 : Real)) • + Bh) → + (let scale : Real := + ((xR : Real) - (xL : Real)) / + ((r2 : Real) - (r1 : Real)); + Bh = scale • Bg))) := by classical intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he - hgfun_cont hhfun_cont GH HH phi i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_b hc_le_one r1 r2 - hr12 xL xR Bg Bh hvel scale + hgfun_cont hhfun_cont GH HH phi i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_one r1 r2 hr12 + xL xR Bg Bh hvel scale have hfst := congrArg Prod.fst hvel have hsnd := congrArg Prod.snd hvel change ((xR : Real) - (xL : Real)) * Bg.1 = @@ -534,41 +563,67 @@ private theorem hphi_mono : exact False.elim ((not_lt_of_ge hle) this) private theorem hx0L : - ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : - P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : - Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ - ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ - (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ - let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ - ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), - let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont - let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont - let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm - let x0 : Set.Icc (0 : Real) 1 := ⟨0, by norm_num⟩ - (phi x0 = x0) → ((StrictMono phi) → ( - let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ - let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ - ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time - j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ - let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ - let c : Real := min (phi α : Real) (β : Real) - ∀ (hcpos : 0 < c), (c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), - let r1 : Set.Icc (0 : Real) 1 := ⟨c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - (0 < (r1 : Real)) → ( - let xL : Set.Icc (0 : Real) 1 := phi.symm r1 - (phi xL = r1) → (x0 < xL))))) := by + ∀ (S : Set (ℝ × ℝ)), + ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (p : P3723T1PolygonalParameterization g), + ∀ (q : P3723T1PolygonalParameterization h), + ∀ (hgrange : Set.range g = S), + ∀ (hhrange : Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; + ∀ (hgfun_inj : Function.Injective gfun), + ∀ (hhfun_inj : Function.Injective hfun), + ∀ (hgfun_surj : Function.Surjective gfun), + ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; + let he : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; + ∀ (hgfun_cont : Continuous gfun), + ∀ (hhfun_cont : Continuous hfun), + let GH := + Continuous.homeoOfEquivCompactToT2 (f := ge) + hgfun_cont; + let HH := + Continuous.homeoOfEquivCompactToT2 (f := he) + hhfun_cont; + let phi : + Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := + GH.trans HH.symm; + let x0 : Set.Icc (0 : Real) 1 := ⟨0, by norm_num⟩; + (phi x0 = x0) → + ((StrictMono phi) → + (let i1 : Fin (p.count + 1) := + ⟨1, by have hp := p.positive; omega⟩; + let j1 : Fin (q.count + 1) := + ⟨1, by have hq := q.positive; omega⟩; + ∀ (hpi : 0 < p.time i1), + ∀ (hqj : 0 < q.time j1), + ∀ (hpi1 : p.time i1 ≤ 1), + ∀ (hqj1 : q.time j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := + ⟨p.time i1, hpi.le, hpi1⟩; + let β : Set.Icc (0 : Real) 1 := + ⟨q.time j1, hqj.le, hqj1⟩; + let c : Real := + min (phi α : Real) (β : Real); + ∀ (hcpos : 0 < c), + (∀ (hc_le_one : c ≤ 1), + let r1 : Set.Icc (0 : Real) 1 := + ⟨c / 3, + ⟨by linarith [hcpos], by + have := hc_le_one; linarith⟩⟩; + (0 < (r1 : Real)) → + (let xL : Set.Icc (0 : Real) 1 := + phi.symm r1; + (phi xL = r1) → (x0 < xL))))) := by classical intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he hgfun_cont hhfun_cont GH HH phi x0 hphi0 hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos - hc_le_b hc_le_one r1 hr1pos xL hφL + hc_le_one r1 hr1pos xL hφL by_contra hh have hle : xL ≤ x0 := le_of_not_gt hh have hm := hphi_mono.monotone hle @@ -577,41 +632,67 @@ private theorem hx0L : exact (not_le_of_gt h0r) hm private theorem hx0R : - ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : - P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : - Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ - ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ - (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ - let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ - ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), - let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont - let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont - let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm - let x0 : Set.Icc (0 : Real) 1 := ⟨0, by norm_num⟩ - (phi x0 = x0) → ((StrictMono phi) → ( - let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ - let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ - ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time - j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ - let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ - let c : Real := min (phi α : Real) (β : Real) - ∀ (hcpos : 0 < c), (c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), - let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - (0 < (r2 : Real)) → ( - let xR : Set.Icc (0 : Real) 1 := phi.symm r2 - (phi xR = r2) → (x0 < xR))))) := by + ∀ (S : Set (ℝ × ℝ)), + ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (p : P3723T1PolygonalParameterization g), + ∀ (q : P3723T1PolygonalParameterization h), + ∀ (hgrange : Set.range g = S), + ∀ (hhrange : Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; + ∀ (hgfun_inj : Function.Injective gfun), + ∀ (hhfun_inj : Function.Injective hfun), + ∀ (hgfun_surj : Function.Surjective gfun), + ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; + let he : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; + ∀ (hgfun_cont : Continuous gfun), + ∀ (hhfun_cont : Continuous hfun), + let GH := + Continuous.homeoOfEquivCompactToT2 (f := ge) + hgfun_cont; + let HH := + Continuous.homeoOfEquivCompactToT2 (f := he) + hhfun_cont; + let phi : + Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := + GH.trans HH.symm; + let x0 : Set.Icc (0 : Real) 1 := ⟨0, by norm_num⟩; + (phi x0 = x0) → + ((StrictMono phi) → + (let i1 : Fin (p.count + 1) := + ⟨1, by have hp := p.positive; omega⟩; + let j1 : Fin (q.count + 1) := + ⟨1, by have hq := q.positive; omega⟩; + ∀ (hpi : 0 < p.time i1), + ∀ (hqj : 0 < q.time j1), + ∀ (hpi1 : p.time i1 ≤ 1), + ∀ (hqj1 : q.time j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := + ⟨p.time i1, hpi.le, hpi1⟩; + let β : Set.Icc (0 : Real) 1 := + ⟨q.time j1, hqj.le, hqj1⟩; + let c : Real := + min (phi α : Real) (β : Real); + ∀ (hcpos : 0 < c), + (∀ (hc_le_one : c ≤ 1), + let r2 : Set.Icc (0 : Real) 1 := + ⟨2 * c / 3, + ⟨by linarith [hcpos], by + have := hc_le_one; linarith⟩⟩; + (0 < (r2 : Real)) → + (let xR : Set.Icc (0 : Real) 1 := + phi.symm r2; + (phi xR = r2) → (x0 < xR))))) := by classical intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he hgfun_cont hhfun_cont GH HH phi x0 hphi0 hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos - hc_le_b hc_le_one r2 hr2pos xR hφR + hc_le_one r2 hr2pos xR hφR by_contra hh have hle : xR ≤ x0 := le_of_not_gt hh have hm := hphi_mono.monotone hle @@ -620,42 +701,65 @@ private theorem hx0R : exact (not_le_of_gt h0r) hm private theorem hxLa : - ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : - P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : - Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ - ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ - (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ - let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ - ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), - let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont - let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont - let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm - (StrictMono phi) → ( - let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ - let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ - ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time - j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ - let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ - let c : Real := min (phi α : Real) (β : Real) - ∀ (hcpos : 0 < c), (c ≤ (phi α : Real)) → ((c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), - let r1 : Set.Icc (0 : Real) 1 := ⟨c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - (0 < (r1 : Real)) → (((r1 : Real) < (r2 : Real)) → (((r2 : Real) < c) → ( - let xL : Set.Icc (0 : Real) 1 := phi.symm r1 - (phi xL = r1) → (xL < α))))))) := by + ∀ (S : Set (ℝ × ℝ)), + ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (p : P3723T1PolygonalParameterization g), + ∀ (q : P3723T1PolygonalParameterization h), + ∀ (hgrange : Set.range g = S), + ∀ (hhrange : Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; + ∀ (hgfun_inj : Function.Injective gfun), + ∀ (hhfun_inj : Function.Injective hfun), + ∀ (hgfun_surj : Function.Surjective gfun), + ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; + let he : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; + ∀ (hgfun_cont : Continuous gfun), + ∀ (hhfun_cont : Continuous hfun), + let GH := + Continuous.homeoOfEquivCompactToT2 (f := ge) + hgfun_cont; + let HH := + Continuous.homeoOfEquivCompactToT2 (f := he) + hhfun_cont; + let phi : + Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := + GH.trans HH.symm; + (StrictMono phi) → + (let i1 : Fin (p.count + 1) := + ⟨1, by have hp := p.positive; omega⟩; + let j1 : Fin (q.count + 1) := + ⟨1, by have hq := q.positive; omega⟩; + ∀ (hpi : 0 < p.time i1), + ∀ (hqj : 0 < q.time j1), + ∀ (hpi1 : p.time i1 ≤ 1), + ∀ (hqj1 : q.time j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := + ⟨p.time i1, hpi.le, hpi1⟩; + let β : Set.Icc (0 : Real) 1 := + ⟨q.time j1, hqj.le, hqj1⟩; + let c : Real := + min (phi α : Real) (β : Real); + ∀ (hcpos : 0 < c), + (c ≤ (phi α : Real)) → + (∀ (hc_le_one : c ≤ 1), + let r1 : Set.Icc (0 : Real) 1 := + ⟨c / 3, + ⟨by linarith [hcpos], by + have := hc_le_one; linarith⟩⟩; + (let xL : Set.Icc (0 : Real) 1 := + phi.symm r1; + (phi xL = r1) → (xL < α)))) := by classical intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he hgfun_cont hhfun_cont GH HH phi hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_a - hc_le_b hc_le_one r1 r2 hr1pos hr12 hr2c xL hφL + hc_le_one r1 xL hφL by_contra hh have hle : α ≤ xL := le_of_not_gt hh have hm := hphi_mono.monotone hle @@ -666,40 +770,66 @@ private theorem hxLa : exact (not_le_of_gt hrc') hm private theorem hxRa : - ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : - P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : - Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ - ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ - (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ - let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ - ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), - let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont - let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont - let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm - (StrictMono phi) → ( - let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ - let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ - ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time - j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ - let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ - let c : Real := min (phi α : Real) (β : Real) - ∀ (hcpos : 0 < c), (c ≤ (phi α : Real)) → ((c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), - let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - ((r2 : Real) < c) → ( - let xR : Set.Icc (0 : Real) 1 := phi.symm r2 - (phi xR = r2) → (xR < α))))) := by + ∀ (S : Set (ℝ × ℝ)), + ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (p : P3723T1PolygonalParameterization g), + ∀ (q : P3723T1PolygonalParameterization h), + ∀ (hgrange : Set.range g = S), + ∀ (hhrange : Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; + ∀ (hgfun_inj : Function.Injective gfun), + ∀ (hhfun_inj : Function.Injective hfun), + ∀ (hgfun_surj : Function.Surjective gfun), + ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; + let he : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; + ∀ (hgfun_cont : Continuous gfun), + ∀ (hhfun_cont : Continuous hfun), + let GH := + Continuous.homeoOfEquivCompactToT2 (f := ge) + hgfun_cont; + let HH := + Continuous.homeoOfEquivCompactToT2 (f := he) + hhfun_cont; + let phi : + Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := + GH.trans HH.symm; + (StrictMono phi) → + (let i1 : Fin (p.count + 1) := + ⟨1, by have hp := p.positive; omega⟩; + let j1 : Fin (q.count + 1) := + ⟨1, by have hq := q.positive; omega⟩; + ∀ (hpi : 0 < p.time i1), + ∀ (hqj : 0 < q.time j1), + ∀ (hpi1 : p.time i1 ≤ 1), + ∀ (hqj1 : q.time j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := + ⟨p.time i1, hpi.le, hpi1⟩; + let β : Set.Icc (0 : Real) 1 := + ⟨q.time j1, hqj.le, hqj1⟩; + let c : Real := + min (phi α : Real) (β : Real); + ∀ (hcpos : 0 < c), + (c ≤ (phi α : Real)) → + (∀ (hc_le_one : c ≤ 1), + let r2 : Set.Icc (0 : Real) 1 := + ⟨2 * c / 3, + ⟨by linarith [hcpos], by + have := hc_le_one; linarith⟩⟩; + ((r2 : Real) < c) → + (let xR : Set.Icc (0 : Real) 1 := + phi.symm r2; + (phi xR = r2) → (xR < α)))) := by classical intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he hgfun_cont hhfun_cont GH HH phi hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_a - hc_le_b hc_le_one r2 hr2c xR hφR + hc_le_one r2 hr2c xR hφR by_contra hh have hle : α ≤ xR := le_of_not_gt hh have hm := hphi_mono.monotone hle @@ -709,43 +839,72 @@ private theorem hxRa : exact (not_le_of_gt hrc') hm private theorem hxLR : - ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : - P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : - Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ - ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ - (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ - let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ - ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), - let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont - let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont - let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm - (StrictMono phi) → ( - let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ - let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ - ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time - j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ - let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ - let c : Real := min (phi α : Real) (β : Real) - ∀ (hcpos : 0 < c), (c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), - let r1 : Set.Icc (0 : Real) 1 := ⟨c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - ((r1 : Real) < (r2 : Real)) → ( - let xL : Set.Icc (0 : Real) 1 := phi.symm r1 - let xR : Set.Icc (0 : Real) 1 := phi.symm r2 - (phi xL = r1) → ((phi xR = r2) → (xL < xR))))) := by + ∀ (S : Set (ℝ × ℝ)), + ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (p : P3723T1PolygonalParameterization g), + ∀ (q : P3723T1PolygonalParameterization h), + ∀ (hgrange : Set.range g = S), + ∀ (hhrange : Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; + ∀ (hgfun_inj : Function.Injective gfun), + ∀ (hhfun_inj : Function.Injective hfun), + ∀ (hgfun_surj : Function.Surjective gfun), + ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; + let he : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; + ∀ (hgfun_cont : Continuous gfun), + ∀ (hhfun_cont : Continuous hfun), + let GH := + Continuous.homeoOfEquivCompactToT2 (f := ge) + hgfun_cont; + let HH := + Continuous.homeoOfEquivCompactToT2 (f := he) + hhfun_cont; + let phi : + Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := + GH.trans HH.symm; + (StrictMono phi) → + (let i1 : Fin (p.count + 1) := + ⟨1, by have hp := p.positive; omega⟩; + let j1 : Fin (q.count + 1) := + ⟨1, by have hq := q.positive; omega⟩; + ∀ (hpi : 0 < p.time i1), + ∀ (hqj : 0 < q.time j1), + ∀ (hpi1 : p.time i1 ≤ 1), + ∀ (hqj1 : q.time j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := + ⟨p.time i1, hpi.le, hpi1⟩; + let β : Set.Icc (0 : Real) 1 := + ⟨q.time j1, hqj.le, hqj1⟩; + let c : Real := + min (phi α : Real) (β : Real); + ∀ (hcpos : 0 < c), + (∀ (hc_le_one : c ≤ 1), + let r1 : Set.Icc (0 : Real) 1 := + ⟨c / 3, + ⟨by linarith [hcpos], by + have := hc_le_one; linarith⟩⟩; + let r2 : Set.Icc (0 : Real) 1 := + ⟨2 * c / 3, + ⟨by linarith [hcpos], by + have := hc_le_one; linarith⟩⟩; + ((r1 : Real) < (r2 : Real)) → + (let xL : Set.Icc (0 : Real) 1 := + phi.symm r1; + let xR : Set.Icc (0 : Real) 1 := + phi.symm r2; + (phi xL = r1) → + ((phi xR = r2) → (xL < xR))))) := by classical intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he - hgfun_cont hhfun_cont GH HH phi hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_b - hc_le_one r1 r2 hr12 xL xR hφL hφR + hgfun_cont hhfun_cont GH HH phi hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_one r1 + r2 hr12 xL xR hφL hφR by_contra hh have hle : xR ≤ xL := le_of_not_gt hh have hm := hphi_mono.monotone hle @@ -754,41 +913,74 @@ private theorem hxLR : exact (not_le_of_gt hlt) hm private theorem hEqL : - ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : - P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : - Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ - ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ - (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ - let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ - ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), - let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont - let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont - let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm - (∀ (x : Set.Icc (0 : Real) 1), h (phi x) = g x) → ( - let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ - let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ - ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time - j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ - let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ - let c : Real := min (phi α : Real) (β : Real) - ∀ (hcpos : 0 < c), (c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), - let r1 : Set.Icc (0 : Real) 1 := ⟨c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - let xL : Set.Icc (0 : Real) 1 := phi.symm r1 - (phi xL = r1) → (∀ (Ag : ℝ × ℝ), ∀ (Bg : ℝ × ℝ), ∀ (Ah : ℝ × ℝ), ∀ (Bh : ℝ × ℝ), (g xL = Ag + - (↑xL : ℝ) • Bg) → ((h r1 = Ah + (↑r1 : ℝ) • Bh) → (Ag + (xL : Real) • Bg = Ah + (r1 : - Real) • Bh))))) := by + ∀ (S : Set (ℝ × ℝ)), + ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (p : P3723T1PolygonalParameterization g), + ∀ (q : P3723T1PolygonalParameterization h), + ∀ (hgrange : Set.range g = S), + ∀ (hhrange : Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; + ∀ (hgfun_inj : Function.Injective gfun), + ∀ (hhfun_inj : Function.Injective hfun), + ∀ (hgfun_surj : Function.Surjective gfun), + ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; + let he : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; + ∀ (hgfun_cont : Continuous gfun), + ∀ (hhfun_cont : Continuous hfun), + let GH := + Continuous.homeoOfEquivCompactToT2 (f := ge) + hgfun_cont; + let HH := + Continuous.homeoOfEquivCompactToT2 (f := he) + hhfun_cont; + let phi : + Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := + GH.trans HH.symm; + (∀ (x : Set.Icc (0 : Real) 1), h (phi x) = g x) → + (let i1 : Fin (p.count + 1) := + ⟨1, by have hp := p.positive; omega⟩; + let j1 : Fin (q.count + 1) := + ⟨1, by have hq := q.positive; omega⟩; + ∀ (hpi : 0 < p.time i1), + ∀ (hqj : 0 < q.time j1), + ∀ (hpi1 : p.time i1 ≤ 1), + ∀ (hqj1 : q.time j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := + ⟨p.time i1, hpi.le, hpi1⟩; + let β : Set.Icc (0 : Real) 1 := + ⟨q.time j1, hqj.le, hqj1⟩; + let c : Real := + min (phi α : Real) (β : Real); + ∀ (hcpos : 0 < c), + (∀ (hc_le_one : c ≤ 1), + let r1 : Set.Icc (0 : Real) 1 := + ⟨c / 3, + ⟨by linarith [hcpos], by + have := hc_le_one; linarith⟩⟩; + let xL : Set.Icc (0 : Real) 1 := + phi.symm r1; + (phi xL = r1) → + (∀ (Ag : ℝ × ℝ), + ∀ (Bg : ℝ × ℝ), + ∀ (Ah : ℝ × ℝ), + ∀ (Bh : ℝ × ℝ), + (g xL = Ag + (↑xL : ℝ) • Bg) → + ((h r1 = + Ah + (↑r1 : ℝ) • Bh) → + (Ag + (xL : Real) • Bg = + Ah + + (r1 : Real) • Bh))))) := by classical intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he - hgfun_cont hhfun_cont GH HH phi hrel i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_b hc_le_one - r1 xL hφL Ag Bg Ah Bh hgL hhL + hgfun_cont hhfun_cont GH HH phi hrel i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_one r1 xL + hφL Ag Bg Ah Bh hgL hhL calc Ag + (xL : Real) • Bg = g xL := hgL.symm _ = h (phi xL) := (hrel xL).symm @@ -796,41 +988,74 @@ private theorem hEqL : _ = Ah + (r1 : Real) • Bh := hhL private theorem hEqR : - ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : - P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : - Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ - ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ - (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ - let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ - ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), - let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont - let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont - let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm - (∀ (x : Set.Icc (0 : Real) 1), h (phi x) = g x) → ( - let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ - let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ - ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time - j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ - let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ - let c : Real := min (phi α : Real) (β : Real) - ∀ (hcpos : 0 < c), (c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), - let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - let xR : Set.Icc (0 : Real) 1 := phi.symm r2 - (phi xR = r2) → (∀ (Ag : ℝ × ℝ), ∀ (Bg : ℝ × ℝ), ∀ (Ah : ℝ × ℝ), ∀ (Bh : ℝ × ℝ), (g xR = Ag + - (↑xR : ℝ) • Bg) → ((h r2 = Ah + (↑r2 : ℝ) • Bh) → (Ag + (xR : Real) • Bg = Ah + (r2 : - Real) • Bh))))) := by + ∀ (S : Set (ℝ × ℝ)), + ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (p : P3723T1PolygonalParameterization g), + ∀ (q : P3723T1PolygonalParameterization h), + ∀ (hgrange : Set.range g = S), + ∀ (hhrange : Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; + ∀ (hgfun_inj : Function.Injective gfun), + ∀ (hhfun_inj : Function.Injective hfun), + ∀ (hgfun_surj : Function.Surjective gfun), + ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; + let he : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; + ∀ (hgfun_cont : Continuous gfun), + ∀ (hhfun_cont : Continuous hfun), + let GH := + Continuous.homeoOfEquivCompactToT2 (f := ge) + hgfun_cont; + let HH := + Continuous.homeoOfEquivCompactToT2 (f := he) + hhfun_cont; + let phi : + Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := + GH.trans HH.symm; + (∀ (x : Set.Icc (0 : Real) 1), h (phi x) = g x) → + (let i1 : Fin (p.count + 1) := + ⟨1, by have hp := p.positive; omega⟩; + let j1 : Fin (q.count + 1) := + ⟨1, by have hq := q.positive; omega⟩; + ∀ (hpi : 0 < p.time i1), + ∀ (hqj : 0 < q.time j1), + ∀ (hpi1 : p.time i1 ≤ 1), + ∀ (hqj1 : q.time j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := + ⟨p.time i1, hpi.le, hpi1⟩; + let β : Set.Icc (0 : Real) 1 := + ⟨q.time j1, hqj.le, hqj1⟩; + let c : Real := + min (phi α : Real) (β : Real); + ∀ (hcpos : 0 < c), + (∀ (hc_le_one : c ≤ 1), + let r2 : Set.Icc (0 : Real) 1 := + ⟨2 * c / 3, + ⟨by linarith [hcpos], by + have := hc_le_one; linarith⟩⟩; + let xR : Set.Icc (0 : Real) 1 := + phi.symm r2; + (phi xR = r2) → + (∀ (Ag : ℝ × ℝ), + ∀ (Bg : ℝ × ℝ), + ∀ (Ah : ℝ × ℝ), + ∀ (Bh : ℝ × ℝ), + (g xR = Ag + (↑xR : ℝ) • Bg) → + ((h r2 = + Ah + (↑r2 : ℝ) • Bh) → + (Ag + (xR : Real) • Bg = + Ah + + (r2 : Real) • Bh))))) := by classical intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he - hgfun_cont hhfun_cont GH HH phi hrel i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_b hc_le_one - r2 xR hφR Ag Bg Ah Bh hgR hhR + hgfun_cont hhfun_cont GH HH phi hrel i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_one r2 xR + hφR Ag Bg Ah Bh hgR hhR calc Ag + (xR : Real) • Bg = g xR := hgR.symm _ = h (phi xR) := (hrel xR).symm @@ -838,43 +1063,80 @@ private theorem hEqR : _ = Ah + (r2 : Real) • Bh := hhR private theorem hvel : - ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : - P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), ∀ (hhrange : - Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ - ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ - (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ - let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ - ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), - let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont - let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont - let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm - let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ - let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ - ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time - j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ - let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ - let c : Real := min (phi α : Real) (β : Real) - ∀ (hcpos : 0 < c), (c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), - let r1 : Set.Icc (0 : Real) 1 := ⟨c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - let xL : Set.Icc (0 : Real) 1 := phi.symm r1 - let xR : Set.Icc (0 : Real) 1 := phi.symm r2 - ∀ (Ag : ℝ × ℝ), ∀ (Bg : ℝ × ℝ), ∀ (Ah : ℝ × ℝ), ∀ (Bh : ℝ × ℝ), (Ag + (xL : Real) • Bg = Ah + - (r1 : Real) • Bh) → ((Ag + (xR : Real) • Bg = Ah + (r2 : Real) • Bh) → (((xR : Real) - - (xL : Real)) • Bg = ((r2 : Real) - (r1 : Real)) • Bh))) := by + ∀ (S : Set (ℝ × ℝ)), + ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (p : P3723T1PolygonalParameterization g), + ∀ (q : P3723T1PolygonalParameterization h), + ∀ (hgrange : Set.range g = S), + ∀ (hhrange : Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; + ∀ (hgfun_inj : Function.Injective gfun), + ∀ (hhfun_inj : Function.Injective hfun), + ∀ (hgfun_surj : Function.Surjective gfun), + ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; + let he : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; + ∀ (hgfun_cont : Continuous gfun), + ∀ (hhfun_cont : Continuous hfun), + let GH := + Continuous.homeoOfEquivCompactToT2 (f := ge) + hgfun_cont; + let HH := + Continuous.homeoOfEquivCompactToT2 (f := he) + hhfun_cont; + let phi : + Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := + GH.trans HH.symm; + let i1 : Fin (p.count + 1) := + ⟨1, by have hp := p.positive; omega⟩; + let j1 : Fin (q.count + 1) := + ⟨1, by have hq := q.positive; omega⟩; + ∀ (hpi : 0 < p.time i1), + ∀ (hqj : 0 < q.time j1), + ∀ (hpi1 : p.time i1 ≤ 1), + ∀ (hqj1 : q.time j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := + ⟨p.time i1, hpi.le, hpi1⟩; + let β : Set.Icc (0 : Real) 1 := + ⟨q.time j1, hqj.le, hqj1⟩; + let c : Real := min (phi α : Real) (β : Real); + ∀ (hcpos : 0 < c), + (∀ (hc_le_one : c ≤ 1), + let r1 : Set.Icc (0 : Real) 1 := + ⟨c / 3, + ⟨by linarith [hcpos], by + have := hc_le_one; linarith⟩⟩; + let r2 : Set.Icc (0 : Real) 1 := + ⟨2 * c / 3, + ⟨by linarith [hcpos], by + have := hc_le_one; linarith⟩⟩; + let xL : Set.Icc (0 : Real) 1 := + phi.symm r1; + let xR : Set.Icc (0 : Real) 1 := + phi.symm r2; + ∀ (Ag : ℝ × ℝ), + ∀ (Bg : ℝ × ℝ), + ∀ (Ah : ℝ × ℝ), + ∀ (Bh : ℝ × ℝ), + (Ag + (xL : Real) • Bg = + Ah + (r1 : Real) • Bh) → + ((Ag + (xR : Real) • Bg = + Ah + (r2 : Real) • Bh) → + (((xR : Real) - (xL : Real)) • + Bg = + ((r2 : Real) - + (r1 : Real)) • + Bh))) := by classical intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he - hgfun_cont hhfun_cont GH HH phi i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_b hc_le_one r1 r2 - xL xR Ag Bg Ah Bh hEqL hEqR + hgfun_cont hhfun_cont GH HH phi i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_one r1 r2 xL xR + Ag Bg Ah Bh hEqL hEqR calc ((xR : Real) - (xL : Real)) • Bg = (Ag + (xR : Real) • Bg) - (Ag + (xL : Real) • Bg) := by module @@ -987,19 +1249,19 @@ private theorem compareCore : have hφR : phi xR = r2 := by simp [xR] have hx0L : x0 < xL := ArcComparisonCoreFacts.hx0L S g h p q hgrange hhrange hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi0 hphi_mono hpi hqj hpi1 hqj1 - hcpos hc_le_b hc_le_one hr1pos hφL + hcpos hc_le_one hr1pos hφL have hx0R : x0 < xR := ArcComparisonCoreFacts.hx0R S g h p q hgrange hhrange hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi0 hphi_mono hpi hqj hpi1 hqj1 - hcpos hc_le_b hc_le_one hr2pos hφR + hcpos hc_le_one hr2pos hφR have hxLa : xL < α := ArcComparisonCoreFacts.hxLa S g h p q hgrange hhrange hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi_mono hpi hqj hpi1 hqj1 hcpos hc_le_a - hc_le_b hc_le_one hr1pos hr12 hr2c hφL + hc_le_one hφL have hxRa : xR < α := ArcComparisonCoreFacts.hxRa S g h p q hgrange hhrange hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi_mono hpi hqj hpi1 hqj1 hcpos hc_le_a - hc_le_b hc_le_one hr2c hφR + hc_le_one hr2c hφR have hxLR : xL < xR := ArcComparisonCoreFacts.hxLR S g h p q hgrange hhrange hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi_mono hpi hqj hpi1 hqj1 hcpos - hc_le_b hc_le_one hr12 hφL hφR + hc_le_one hr12 hφL hφR have hu1β : r1 < β := by have h : (r1 : Real) < (β : Real) := lt_of_lt_of_le (by dsimp [r1]; linarith [hcpos]) hc_le_b exact_mod_cast h @@ -1042,13 +1304,13 @@ private theorem compareCore : have hhR := hhline r2 hqLow2 hqUp2 have hEqL : Ag + (xL : Real) • Bg = Ah + (r1 : Real) • Bh := ArcComparisonCoreFacts.hEqL S g h p q hgrange hhrange hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hrel - hpi hqj hpi1 hqj1 hcpos hc_le_b hc_le_one hφL Ag Bg Ah Bh hgL hhL + hpi hqj hpi1 hqj1 hcpos hc_le_one hφL Ag Bg Ah Bh hgL hhL have hEqR : Ag + (xR : Real) • Bg = Ah + (r2 : Real) • Bh := ArcComparisonCoreFacts.hEqR S g h p q hgrange hhrange hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hrel - hpi hqj hpi1 hqj1 hcpos hc_le_b hc_le_one hφR Ag Bg Ah Bh hgR hhR + hpi hqj hpi1 hqj1 hcpos hc_le_one hφR Ag Bg Ah Bh hgR hhR have hvel : ((xR : Real) - (xL : Real)) • Bg = ((r2 : Real) - (r1 : Real)) • Bh := ArcComparisonCoreFacts.hvel S g h p q hgrange hhrange hgfun_inj hhfun_inj hgfun_surj - hhfun_surj hgfun_cont hhfun_cont hpi hqj hpi1 hqj1 hcpos hc_le_b hc_le_one Ag Bg Ah Bh hEqL + hhfun_surj hgfun_cont hhfun_cont hpi hqj hpi1 hqj1 hcpos hc_le_one Ag Bg Ah Bh hEqL hEqR let scale : Real := ((xR : Real) - (xL : Real)) / ((r2 : Real) - (r1 : Real)) have hscale_pos : 0 < scale := by @@ -1056,7 +1318,7 @@ private theorem compareCore : exact div_pos (sub_pos.mpr (by exact_mod_cast hxLR)) (sub_pos.mpr hr12) have hscale := ArcComparisonGeometry.hscale S g h p q hgrange hhrange hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hpi hqj hpi1 hqj1 hcpos - hc_le_b hc_le_one hr12 Bg Bh hvel + hc_le_one hr12 Bg Bh hvel let z : Real × Real := g xL have hplowLstrict : p.time i0.castSucc < (xL : Real) := by rw [hiCast, hpstart] diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSidePropagation.lean b/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSidePropagation.lean index 42b57b986c..40e5db450e 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSidePropagation.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSidePropagation.lean @@ -274,34 +274,6 @@ private theorem isolatePiece : exact ⟨a, rfl⟩ exact (hnotK hmem).elim -private theorem scaleLocalSide : - (by - classical - exact - ∀ (W : Set (ℝ × ℝ)), ∀ (z : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (c : ℝ), ∀ (e : Bool), (0 : ℝ) < c → - P3934T1LocalSide W z w e → P3934T1LocalSide W z (c • w) e ) := by - classical - intro W z w c e hc hside - obtain ⟨r, hr, heq⟩ := hside - refine ⟨r, hr, ?_⟩ - have hdet (q : Real × Real) : - (c • w).1 * (q.2 - z.2) - (c • w).2 * (q.1 - z.1) = - c * (w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1)) := by - simp only [Prod.smul_fst, Prod.smul_snd] - ring - ext q - rw [heq] - simp only [Set.mem_ofPred_eq] - rw [hdet q] - constructor - · rintro ⟨hq, hs⟩ - refine ⟨hq, ?_⟩ - cases e <;> simp at hs ⊢ <;> - nlinarith [hc] - · rintro ⟨hq, hs⟩ - refine ⟨hq, ?_⟩ - cases e <;> simp at hs ⊢ <;> - nlinarith [hc] private theorem straightFrontierRays : (by @@ -1597,7 +1569,7 @@ theorem P3934T1PolygonalSidePropagation hinter compactRange compactImage avoidClosed k i t htlo hthi have scaleLocalSide (W : Set (Real × Real)) (z w : Real × Real) (c : Real) (e : Bool) (hc : 0 < c) - (hside : P3934T1LocalSide W z w e) := PolygonSidePropagation.scaleLocalSide W z w c e hc + (hside : P3934T1LocalSide W z w e) := LocalSideScaling.positiveScale W z w c e hc hside have straightFrontierRays (k : Fin 3) (i : Fin (s k).count) (A B : Real × Real) (hB : B ≠ 0) diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean index fe26ba4396..b54e351ee2 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean @@ -7,11 +7,6 @@ module public import Mathlib.Init public import Mathlib.Data.ZMod.Basic -public import Mathlib.Data.Finset.Card -public import Mathlib.Data.List.Cycle -public import Mathlib.Tactic.ByContra -public import Mathlib.Tactic.NormNum -public import Mathlib.Tactic.Ring public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle public import Mathlib.Data.List.TakeWhile @@ -799,23 +794,30 @@ private theorem hRedge : exact hc₁edgeChain.take _ private theorem hPplusUnion : - ∀ (V₁ : Set GaussianInt), ∀ (E₁ : Set (Finset GaussianInt)), ∀ (E₂ : Set (Finset - GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) - ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) - let prefix₂ := c₂.tail.takeWhile good - let Q := x :: (prefix₂ ++ [z]) - (Q.getLast? = some z) → ((∀ v ∈ R.tail.head?, ({z, v} : Finset GaussianInt) ∈ E₁) → ( - let edgeRel (u v : GaussianInt) : Prop := - ({u, v} : Finset GaussianInt) ∈ E₁ ∪ E₂ - (Q.IsChain edgeRel) → ((R.tail.IsChain edgeRel) → ((Q ++ R.tail).IsChain edgeRel))))) := by - classical - intro V₁ E₁ E₂ p₁ p₂ x c₂ good z c₁ good₁ w R prefix₂ Q hQlast hRstepE₁ edgeRel hQunion + ∀ (V₁ : Set GaussianInt), + ∀ (E₁ : Set (Finset GaussianInt)), + ∀ (E₂ : Set (Finset GaussianInt)), + ∀ (p₁ : List GaussianInt), + ∀ (p₂ : List GaussianInt), + ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x); + let good (z : GaussianInt) : Bool := + @decide (z ∉ V₁) (Classical.propDecidable _); + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + (let R := z :: (c₁.tail.takeWhile good₁ ++ [x]); + let prefix₂ := c₂.tail.takeWhile good; + let Q := x :: (prefix₂ ++ [z]); + (Q.getLast? = some z) → + ((∀ v ∈ R.tail.head?, ({ z, v } : Finset GaussianInt) ∈ E₁) → + (let edgeRel (u v : GaussianInt) : Prop := + ({ u, v } : Finset GaussianInt) ∈ E₁ ∪ E₂; + (Q.IsChain edgeRel) → + ((R.tail.IsChain edgeRel) → + ((Q ++ R.tail).IsChain edgeRel))))) := by + classical + intro V₁ E₁ E₂ p₁ p₂ x c₂ good z c₁ good₁ R prefix₂ Q hQlast hRstepE₁ edgeRel hQunion hRtailUnion apply List.IsChain.append hQunion hRtailUnion intro u hu v hv @@ -1144,29 +1146,43 @@ private theorem hpLenTwo : omega private theorem hsimple : - ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : - GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) - ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₂ := c₂.tail.takeWhile good - let prefix₁ := c₁.tail.takeWhile good₁ - let Q := x :: (prefix₂ ++ [z]) - ((Q ++ prefix₁).Nodup) → ( - let p := Q ++ prefix₁ - ∀ (hpne : p ≠ []), (FourNeighborAdjacent (p.getLast hpne) x) → ((p.head? = some x) → - ((p.getLast? = some (p.getLast hpne)) → ( - let v := p.getLast hpne - (∀ a, ∀ b, ∀ l₁, ∀ l₂, p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → ((4 ≤ p.length) → ( - let W : Set GaussianInt := (p.toFinset : Set GaussianInt) - let F : Set (Finset GaussianInt) := {e | e = {v, x} ∨ - ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}} - SimpleGridCycle W F))))))) := by - classical - intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q hpNodup p hpne hcloseP hphead hplast v + ∀ (V₁ : Set GaussianInt), + ∀ (p₁ : List GaussianInt), + ∀ (p₂ : List GaussianInt), + ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x); + let good (z : GaussianInt) : Bool := + @decide (z ∉ V₁) (Classical.propDecidable _); + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + (let prefix₂ := c₂.tail.takeWhile good; + let prefix₁ := c₁.tail.takeWhile good₁; + let Q := x :: (prefix₂ ++ [z]); + ((Q ++ prefix₁).Nodup) → + (let p := Q ++ prefix₁; + ∀ (hpne : p ≠ []), + (FourNeighborAdjacent (p.getLast hpne) x) → + ((p.head? = some x) → + ((p.getLast? = some (p.getLast hpne)) → + (let v := p.getLast hpne; + (∀ a, + ∀ b, + ∀ l₁, + ∀ l₂, + p = l₁ ++ a :: b :: l₂ → + FourNeighborAdjacent a b) → + ((4 ≤ p.length) → + (let W : Set GaussianInt := + (p.toFinset : Set GaussianInt); + let F : Set (Finset GaussianInt) := + {e | + e = { v, x } ∨ + ∃ a b l₁ l₂, + p = l₁ ++ a :: b :: l₂ ∧ e = { a, b }}; + SimpleGridCycle W F))))))) := by + classical + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ prefix₂ prefix₁ Q hpNodup p hpne hcloseP hphead hplast v hadjP hpLength W F refine ⟨p, x, v, hpNodup, hpLength, hphead, hplast, ?_, hcloseP, ?_, ?_⟩ · rfl @@ -1265,26 +1281,31 @@ private theorem hE₂At785 : exact (List.isChain_cons_cons.mp hq).1 private theorem hFfAt790 : - ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : - GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) - ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₂ := c₂.tail.takeWhile good - let prefix₁ := c₁.tail.takeWhile good₁ - let Q := x :: (prefix₂ ++ [z]) - let p := Q ++ prefix₁ - ∀ (hpne : p ≠ []), - let v := p.getLast hpne - let F : Set (Finset GaussianInt) := {e | e = {v, x} ∨ - ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}} - ∀ (c : GaussianInt), ∀ (cs : List GaussianInt), (prefix₂ = c :: cs) → (({x, c} : Finset - GaussianInt) ∈ F)) := by - classical - intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p hpne v F c cs hpref₂ + ∀ (V₁ : Set GaussianInt), + ∀ (p₁ : List GaussianInt), + ∀ (p₂ : List GaussianInt), + ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x); + let good (z : GaussianInt) : Bool := + @decide (z ∉ V₁) (Classical.propDecidable _); + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + (let prefix₂ := c₂.tail.takeWhile good; + let prefix₁ := c₁.tail.takeWhile good₁; + let Q := x :: (prefix₂ ++ [z]); + let p := Q ++ prefix₁; + ∀ (hpne : p ≠ []), + let v := p.getLast hpne; + let F : Set (Finset GaussianInt) := + {e | + e = { v, x } ∨ + ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = { a, b }}; + ∀ (c : GaussianInt), + ∀ (cs : List GaussianInt), + (prefix₂ = c :: cs) → (({ x, c } : Finset GaussianInt) ∈ F)) := by + classical + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ prefix₂ prefix₁ Q p hpne v F c cs hpref₂ simp only [F, Set.mem_ofPred_eq] right refine ⟨x, c, [], (cs ++ [z]) ++ prefix₁, ?_, rfl⟩ @@ -1341,7 +1362,7 @@ private theorem hFf : MixedCycleDetails.hFfAt774 V₁ p₁ p₂ x z w hpne hpref₂ | cons c cs => simpa only [List.headD] using - MixedCycleDetails.hFfAt790 V₁ p₁ p₂ x z w hpne c cs hpref₂ + MixedCycleDetails.hFfAt790 V₁ p₁ p₂ x z hpne c cs hpref₂ end MixedClosingEdges @@ -1479,7 +1500,7 @@ theorem P3963T1MixedBoundaryCycle intro u v huv exact Or.inl huv) have hPplusUnion : (Q ++ R.tail).IsChain edgeRel := MixedCycleDetails.hPplusUnion V₁ E₁ E₂ p₁ - p₂ x z w hQlast hRstepE₁ hQunion hRtailUnion + p₂ x z hQlast hRstepE₁ hQunion hRtailUnion have hQprefix := MixedCycleDetails.hQprefix V₁ p₂ x takeArc z zs hc₂shape hdecomp₂' have hQchain := MixedCycleDetails.hQchain V₁ p₂ x hc₂chain z @@ -1537,7 +1558,7 @@ theorem P3963T1MixedBoundaryCycle let W : Set GaussianInt := (p.toFinset : Set GaussianInt) let F : Set (Finset GaussianInt) := {e | e = {v, x} ∨ ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}} - have hsimple := MixedCycleDetails.hsimple V₁ p₁ p₂ x z w hpNodup hpne + have hsimple := MixedCycleDetails.hsimple V₁ p₁ p₂ x z hpNodup hpne hcloseP hphead hplast hadjP hpLength have hlastE₁ : ({v, x} : Finset GaussianInt) ∈ E₁ := MixedBoundaryCycleProof.hlastE₁ V₁ E₁ p₁ p₂ x z w hQlast hRtailE₁ hRstepE₁ hpne hRtail diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean b/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean index 01cf138f6a..2e96cb4791 100644 --- a/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean +++ b/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.P3996T1SRowTable public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation @@ -138,15 +139,6 @@ private theorem occF : simp only [SubtileOccurrenceInterpretation] exact BandPrototileTranslation _ _ _ (cert.outer_occurrence 2 false).1 -private theorem cellsTranslate : - (by - classical - exact - ∀ (X : ProtoTile), ∀ (d : GaussianInt), (TileTranslation X d).cells = X.cells.image - (GaussianTranslation d) ) := by - classical - intro X d - exact (TileTranslationFormulas X d).1 private theorem anchorTranslate : (by @@ -938,7 +930,7 @@ theorem P3996T1SRowAlignment have occF (m n : Int) : BandPrototile (q 3) (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.F, m, n⟩) := SRowAlignmentGeometry.occF q cfg C T cert m n - have cellsTranslate := SRowAlignmentGeometry.cellsTranslate + have cellsTranslate := TileTranslationProperties.cells have anchorTranslate := SRowAlignmentGeometry.anchorTranslate have centroidTranslate := SRowAlignmentGeometry.centroidTranslate have translationCentroidGP (X : ProtoTile) (d : GaussianInt) : diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean index 94652e7c21..8eaf15e260 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean @@ -255,31 +255,13 @@ private theorem hq6act : private theorem hpower : (by classical - exact - ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : - ProtoTile), ∀ (W : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if (Even s.val) - then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < (r (if - Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → - ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ)))) → ((TileCentroid Z - TileCentroid U - = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if - Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : - ℕ))).succ) - BandVectors.1 (r (i - (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - else BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : ℕ))).succ))) → ( - let q : GaussianInt := ⟨0, 1⟩ - ∀ (aU : GaussianInt), ∀ (aZ : GaussianInt), - let Zp := TileTranslation Z (aU - aZ) - (BandPrototile (r ((if Even s.val then i - 1 else i + 1).succ)) Zp) → (((-(TileCentroid W - - TileCentroid U).2, (TileCentroid W - TileCentroid U).1) = (1 / 2 : Real) • - GaussianRealPoint (q * (q ^ s.val * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 - (r 0) (r i.succ))))) → ( - let t : Fin 4 := s + 1 - (Even t.val ↔ ¬ Even s.val) → ((q ^ 2 = -1) → ((q ^ 4 = 1) → (q ^ t.val = q * q ^ - s.val))))))))) ) := by + exact + ∀ (s : Fin (4 : ℕ)), + (let q : GaussianInt := ⟨0, 1⟩; + (let t : Fin 4 := s + 1; + ((q ^ 2 = -1) → ((q ^ 4 = 1) → (q ^ t.val = q * q ^ s.val)))))) := by classical - intro r i s U W Z hZ hZpos hWcent hZcent q aU aZ Zp hZp hWrot t htpar hq2 hq4 + intro s q t hq2 hq4 fin_cases s · simp [t] · simp [t, pow_succ] @@ -1321,8 +1303,7 @@ theorem P4055T1OrderedGeneralOppositeEndpoints : have hq2act := OppositeEndpointGeometry.hq2act hq2 have hq4act := OppositeEndpointGeometry.hq4act hq4 have hq6act := OppositeEndpointGeometry.hq6act (OppositeEndpointGeometry.hq6 hq2) - have hpower := OppositeEndpointGeometry.hpower r i s U W Z hZ hZpos - hWcent hZcent aU aZ hZp hWrot htpar hq2 hq4 + have hpower := OppositeEndpointGeometry.hpower s hq2 hq4 have hWsrc : TileCentroid Wp - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))) := diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean index bc7325884c..b39e749898 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean @@ -1171,80 +1171,97 @@ private theorem hZsourceAction : private theorem hZvec : (by classical - exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W - : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if Even (↑s : ℕ) then i - (1 : - Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < (r (if Even (↑s : ℕ) - then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → ((TileCentroid W - - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : - Fin (4 : ℕ))) (r i.succ)))) → ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • - GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) - then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - - BandVectors.1 (r (i - (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) else - BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - BandVectors.1 - (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : ℕ))).succ))) → (∀ (a : Fin 3), - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - ∀ (g' : BandPackingSymmetry), - let qg := BandPackingSymmetryQuadrupleAction g' q - let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' - then -(i - a) else i - a - let sigma : Fin 3 → Fin 3 := fun m => - if BandPackingSymmetryReversesOrientation g' then -m else m - (Even 0) → ((Even 2) → ((¬ Even 1) → ((¬ Even 3) → ((∀ (s₀ : Fin 4), ((-s₀ - 1 : Fin 4) : - Nat) = (3 - s₀.val) % 4) → ( - let ii : GaussianInt := ⟨0, 1⟩ - (ii * ii = -1) → ((∀ (x : GaussianInt), -(ii * x) - x = -ii * (x - ii * x)) → ((∀ (x : - GaussianInt), -ii * (x + ii * x) = -1 * (ii * x - x)) → ((∀ (x : GaussianInt), -(-(ii - * x) - x) = ii * (x - ii * x)) → ((∀ (x : GaussianInt), ii * (x + ii * x) = ii * x - - x) → ((ii ^ 3 = -ii) → (((-ii) ^ 2 = -1) → (((-ii) ^ 3 = ii) → ((∀ (g₀ : - BandPackingSymmetry), ∀ (n : Nat), ∀ (x : GaussianInt), - BandPackingSymmetryVectorAction g₀ (ii ^ n * x) = (if - BandPackingSymmetryReversesOrientation g₀ then (-ii) ^ n else ii ^ n) * - BandPackingSymmetryVectorAction g₀ x) → ( - let vR := BandVectors.1 (r i.succ) (r 0) - let vL := BandVectors.1 (r 0) (r i.succ) - let vR' := BandVectors.1 (qg k.succ) (qg 0) - let vL' := BandVectors.1 (qg 0) (qg k.succ) - let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' - then -s - 1 else s - (BandPackingSymmetryVectorAction g' (ii ^ s.val * (vR + vL)) = ii ^ t.val * (vR' + vL')) - → (((if Even t.val then k - 1 else k + 1) = if BandPackingSymmetryReversesOrientation - g' then -((if Even s.val then i - 1 else i + 1) - a) else (if Even s.val then i - 1 - else i + 1) - a) → ( - let j : Fin 3 := if Even t.val then k - 1 else k + 1 - ((if BandPackingSymmetryReversesOrientation g' then -j else j) = (if Even s.val then i - - 1 else i + 1) - a) → ((q ((if BandPackingSymmetryReversesOrientation g' then -j else - j).succ) = r ((if Even s.val then i - 1 else i + 1).succ)) → ((qg j.succ = - BandPackingSymmetryCircleAction g' (r ((if Even s.val then i - 1 else i + 1).succ))) → ( - let adj : Fin 3 := if Even s.val then i - 1 else i + 1 - let mZ : Fin 3 := adj - a - ((if BandPackingSymmetryReversesOrientation g' then -j else j) = mZ) → (((if - BandPackingSymmetryReversesOrientation g' then -mZ else mZ) = j) → ((sigma mZ = j) → - ((BandVectors.1 (qg j.succ) (qg 0) = BandPackingSymmetryVectorAction g' - (BandVectors.1 (r adj.succ) (r 0))) → ((BandVectors.1 (qg 0) (qg j.succ) = if - BandPackingSymmetryReversesOrientation g' then -BandPackingSymmetryVectorAction g' - (BandVectors.1 (r 0) (r adj.succ)) else BandPackingSymmetryVectorAction g' - (BandVectors.1 (r 0) (r adj.succ))) → ( - let xZ := BandVectors.1 (r adj.succ) (r 0) - let yZ := BandVectors.1 (r 0) (r adj.succ) - let xZ' := BandVectors.1 (qg j.succ) (qg 0) - let yZ' := BandVectors.1 (qg 0) (qg j.succ) - (yZ' = ii * xZ') → ((BandPackingSymmetryVectorAction g' xZ = xZ') → - ((BandPackingSymmetryVectorAction g' yZ = if BandPackingSymmetryReversesOrientation - g' then -yZ' else yZ') → ((BandPackingSymmetryVectorAction g' (if Even s.val then yZ - - xZ else xZ - yZ) = if Even s.val then (if BandPackingSymmetryReversesOrientation g' - then -yZ' - xZ' else yZ' - xZ') else (if BandPackingSymmetryReversesOrientation g' - then xZ' + yZ' else xZ' - yZ')) → (BandPackingSymmetryVectorAction g' (ii ^ s.val * - (if Even s.val then yZ - xZ else xZ - yZ)) = ii ^ t.val * (if Even t.val then yZ' - - xZ' else xZ' - yZ'))))))))))))))))))))))))))))))))) ) := by - classical - intro r i s U W Z hZ hZpos hWcent hZcent a q g' qg k sigma evenZero evenTwo notEvenOne - notEvenThree hnegVal ii iiMul iiZCaseA iiZCaseB iiZCaseC iiZCaseD iiCube negIiSq negIiCube - lpow vR vL vR' vL' t hdispW hZindex j hZparentIndex hZcircle hZlabel adj mZ hZrel hZsigma - hZsigma' hZphaseForward hZphaseBackward xZ yZ xZ' yZ' hZflip hZactionForward - hZactionBackward hZsourceAction + exact + ∀ (r : Fin 4 → CircleCoordinates), + ∀ (i : Fin 3), + ∀ (s : Fin 4), + (∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ]; + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q; + let k : Fin 3 := + if BandPackingSymmetryReversesOrientation g' then -(i - a) + else i - a; + (Even 0) → + ((Even 2) → + ((¬Even 1) → + ((¬Even 3) → + ((∀ (s₀ : Fin 4), + ((-s₀ - 1 : Fin 4) : Nat) = (3 - s₀.val) % 4) → + (let ii : GaussianInt := ⟨0, 1⟩; + (ii * ii = -1) → + ((∀ (x : GaussianInt), + -(ii * x) - x = -ii * (x - ii * x)) → + ((∀ (x : GaussianInt), + -ii * (x + ii * x) = -1 * (ii * x - x)) → + ((∀ (x : GaussianInt), + -(-(ii * x) - x) = ii * (x - ii * x)) → + ((∀ (x : GaussianInt), + ii * (x + ii * x) = ii * x - x) → + ((ii ^ 3 = -ii) → + (((-ii) ^ 2 = -1) → + (((-ii) ^ 3 = ii) → + ((∀ (g₀ : BandPackingSymmetry), + ∀ (n : Nat), + ∀ (x : GaussianInt), + BandPackingSymmetryVectorAction + g₀ (ii ^ n * x) = + (if + BandPackingSymmetryReversesOrientation + g₀ then + (-ii) ^ n + else ii ^ n) * + BandPackingSymmetryVectorAction + g₀ x) → + (let t : Fin 4 := + if + BandPackingSymmetryReversesOrientation + g' then + -s - 1 + else s; + (let j : Fin 3 := + if Even t.val then k - 1 else k + 1; + (let adj : Fin 3 := + if Even s.val then i - 1 else i + 1; + (let xZ := + BandVectors.1 (r adj.succ) (r 0); + let yZ := + BandVectors.1 (r 0) (r adj.succ); + let xZ' := + BandVectors.1 (qg j.succ) (qg 0); + let yZ' := + BandVectors.1 (qg 0) (qg j.succ); + (yZ' = ii * xZ') → + ((BandPackingSymmetryVectorAction g' + (if Even s.val then yZ - xZ + else xZ - yZ) = + if Even s.val then + (if + BandPackingSymmetryReversesOrientation + g' then + -yZ' - xZ' + else yZ' - xZ') + else + (if + BandPackingSymmetryReversesOrientation + g' then + xZ' + yZ' + else xZ' - yZ')) → + (BandPackingSymmetryVectorAction + g' + (ii ^ s.val * + (if Even s.val then yZ - xZ + else xZ - yZ)) = + ii ^ t.val * + (if Even t.val then yZ' - xZ' + else + xZ' - + yZ')))))))))))))))))))))) := by + classical + intro r i s a q g' qg k evenZero evenTwo notEvenOne notEvenThree hnegVal ii iiMul iiZCaseA + iiZCaseB iiZCaseC iiZCaseD iiCube negIiSq negIiCube lpow t j adj xZ yZ xZ' yZ' hZflip + hZsourceAction rw [lpow, hZsourceAction] cases ho : BandPackingSymmetryReversesOrientation g' <;> fin_cases s <;> @@ -2095,10 +2112,9 @@ theorem P4055T1PlacementNormalization have hZactionBackward := PlacementNormalizationProof.hZactionBackward r i s a g' hZphaseBackward have hZsourceAction := PlacementNormalizationProof.hZsourceAction r i s a g' ladd lneg hZactionForward hZactionBackward - have hZvec := PlacementNormalizationProof.hZvec r i s U W Z hZ hZpos hWcent hZcent a g' + have hZvec := PlacementNormalizationProof.hZvec r i s a g' evenZero evenTwo notEvenOne notEvenThree hnegVal iiMul iiZCaseA iiZCaseB iiZCaseC iiZCaseD - iiCube negIiSq negIiCube lpow hdispW hZindex hZparentIndex hZcircle hZlabel hZrel hZsigma - hZsigma' hZphaseForward hZphaseBackward hZflip hZactionForward hZactionBackward hZsourceAction + iiCube negIiSq negIiCube lpow hZflip hZsourceAction have hZ' := PlacementNormalizationProof.hZ' r i s Z hZ a g' htileCov hZlabel have hUpos' := PlacementNormalizationProof.hUpos' r hUpos a g' htileCov hrootLabel have hWpos' := PlacementNormalizationProof.hWpos' r i hWpos a g' htileCov hWlabel diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean index c667b8e6cf..5db0e52155 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordInteriorSquareCoordinates +public import LeanPool.ApollonianSuperharmonic.FordFareySum public import LeanPool.ApollonianSuperharmonic.P4062T1RecursiveInteriors public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent @@ -26,11 +28,6 @@ namespace ApollonianSuperharmonic namespace InteriorGeometryProof -private theorem hsum : - ∀ (P : FordFareyParameter), P.q = P.q₁ + P.q₂ := by - classical - intro P - exact P.sum_q private theorem hq1pos : ∀ (P : FordFareyParameter), (2 < P.q) → ((P.q = P.q₁ + P.q₂) → (0 < P.q₁)) := by @@ -49,23 +46,6 @@ private theorem hq1pos : · have hp' : 1 ≤ P.p₁ := by omega nlinarith -private theorem squareCoordinates : - ∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ - 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ - 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 := by - classical - intro q x - unfold P4062T1InteriorSquare - constructor - · intro hx - obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hx - obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab - exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, - (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ - · intro h - exact Finset.mem_image.mpr ⟨(x.re, x.im), - Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨h.1, h.2.1⟩, - Finset.mem_Icc.mpr h.2.2⟩, by cases x; rfl⟩ private theorem coord0 : ∀ (P : FordFareyParameter), @@ -386,12 +366,12 @@ theorem P4062T1InteriorGeometry (P : FordFareyParameter) -- BODY classical let A := P4062T1RecursiveInteriors P - have hsum : P.q = P.q₁ + P.q₂ := InteriorGeometryProof.hsum P + have hsum : P.q = P.q₁ + P.q₂ := FordFareySum.denominatorSum P have hq1pos : 0 < P.q₁ := InteriorGeometryProof.hq1pos P hP hsum have squareCoordinates (q : Nat) (x : GaussianInt) : x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ - 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 := InteriorGeometryProof.squareCoordinates q x + 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 := FordInteriorSquareCoordinates.membership q x have coord0 (x : GaussianInt) (hx : x ∈ A 0) : 1 ≤ x.re ∧ x.re ≤ (P.q₁ : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (P.q₁ : Int)-1 := InteriorGeometryProof.coord0 P squareCoordinates x hx diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean b/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean index 9716b84b53..6ea7304d81 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean @@ -6,12 +6,12 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordInteriorSquareCoordinates public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness -public import LeanPool.ApollonianSuperharmonic.P4062T1InteriorSquare -- [TABLET NODE: P4062T1LiteralReduction] @@ -28,25 +28,6 @@ namespace ApollonianSuperharmonic namespace LiteralReductionGeometry -private theorem squareCoordinates : - (by - classical - exact - ∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : - Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 ) := by - classical - intro q x - unfold P4062T1InteriorSquare - constructor - · intro hx - obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hx - obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab - exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, - (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ - · intro h - exact Finset.mem_image.mpr ⟨(x.re, x.im), - Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨h.1, h.2.1⟩, - Finset.mem_Icc.mpr h.2.2⟩, by cases x; rfl⟩ private theorem hcurv : (by @@ -460,7 +441,7 @@ theorem P4062T1LiteralReduction : have squareCoordinates (q : Nat) (x : GaussianInt) : x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ - 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 := LiteralReductionGeometry.squareCoordinates q x + 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 := FordInteriorSquareCoordinates.membership q x obtain ⟨k, hkodo, hkdom, hkval⟩ := FordTileOdometerRestriction P have hcurv : 0 < (FordCircleCoordinate P.p P.q).1 := LiteralReductionGeometry.hcurv P obtain ⟨u, htrans, _⟩ := diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean index 18e6823985..96276344b1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordInteriorSquareCoordinates public import LeanPool.ApollonianSuperharmonic.FordOdometer public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian @@ -27,25 +28,6 @@ namespace ApollonianSuperharmonic namespace OverlapDescentDetails -private theorem squareCoordinates : - (by - classical - exact - ∀ (q : ℕ), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ (1 : ℤ) ≤ x.re ∧ x.re ≤ - (↑q : ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑q : ℤ) - (1 : ℤ) ) := by - classical - intro q x - unfold P4062T1InteriorSquare - constructor - · intro hx - obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hx - obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab - exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, - (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ - · intro h - exact Finset.mem_image.mpr ⟨(x.re, x.im), - Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨h.1, h.2.1⟩, - Finset.mem_Icc.mpr h.2.2⟩, by cases x; rfl⟩ private theorem hcrossdet : (by @@ -943,7 +925,7 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) (x-⟨(P.q₁ : Int), (P.q₁ : Int)⟩)) := by -- BODY classical - have squareCoordinates (q : Nat) (x : GaussianInt) := OverlapDescentDetails.squareCoordinates q x + have squareCoordinates (q : Nat) (x : GaussianInt) := FordInteriorSquareCoordinates.membership q x have hsum : P.q = P.q₁ + P.q₂ := P.sum_q have hcrossdet := OverlapDescentDetails.hcrossdet P have hpos₁ := OverlapDescentDetails.hpos₁ P P₁ P₂ hP hq₁ hsum diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean index ffb3d90015..07402ca4c2 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordInteriorSquareCoordinates public import LeanPool.ApollonianSuperharmonic.P4062T1RecursiveInteriors public import LeanPool.ApollonianSuperharmonic.FordOdometer @@ -27,23 +28,6 @@ namespace ApollonianSuperharmonic namespace ParentalRestrictionProof -private theorem squareCoordinates : - ∀ (q : ℕ), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ (1 : ℤ) ≤ x.re ∧ x.re ≤ (↑q : - ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑q : ℤ) - (1 : ℤ) := by - classical - intro q x - unfold P4062T1InteriorSquare - constructor - · intro hx - obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hx - obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab - exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, - (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ - · intro h - exact Finset.mem_image.mpr ⟨(x.re, x.im), - Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨h.1, h.2.1⟩, - Finset.mem_Icc.mpr h.2.2⟩, by cases x; rfl⟩ - private theorem hparent₁pos : ∀ (P : FordFareyParameter), ((2 : ℕ) < P.q) → ((P.q = P.q₁ + P.q₂) → (1 < P.q → 0 < P.q₁)) := by classical @@ -331,7 +315,7 @@ theorem P4062T1ParentalRestriction (P : FordFareyParameter) have squareCoordinates (q : Nat) (x : GaussianInt) : x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ - 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 := ParentalRestrictionProof.squareCoordinates q x + 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 := FordInteriorSquareCoordinates.membership q x have hqpos : 0 < P.q := P.q_pos have hsum : P.q = P.q₁ + P.q₂ := P.sum_q have hparent₁ : P.q₁ < P.q := P.q₁_lt diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean index 9e886d0f53..d5d3cd66bb 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordFareySum public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderPaths public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent @@ -94,11 +95,6 @@ private theorem cross : norm_num [Nat.cast_add] at h1 nlinarith [h1] -private theorem hsumN : - ∀ (P : FordFareyParameter), P.q = P.q₁ + P.q₂ := by - classical - intro P - exact P.sum_q private theorem unequal : ∀ (P : FordFareyParameter), (2 < P.q) → ((0 < (P.q₂ : Int)) → ((P.p₁ * (P.q₂ : Int) - (P.q₁ : @@ -861,7 +857,7 @@ theorem P4112T1ParentalNeighbors (P : FordFareyParameter) (hP : 2 < P.q) : have q1pos : 0 < P.q₁ := ParentalNeighborLemmas.q1pos P hP have q2posI : 0 < (P.q₂ : Int) := ParentalNeighborLemmas.q2posI P have cross : P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 := ParentalNeighborLemmas.cross P - have hsumN := ParentalNeighborLemmas.hsumN P + have hsumN := FordFareySum.denominatorSum P have unequal : P.q₁ ≠ P.q₂ := ParentalNeighborLemmas.unequal P hP q2posI cross hsumN have hsum : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := ParentalNeighborLemmas.hsum P have squareCoordinates (n : Nat) (z : GaussianInt) : diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean index 037771bc43..b35a856f03 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordFareySum public import Mathlib.Topology.MetricSpace.Pseudo.Constructions public import Mathlib.Topology.MetricSpace.Pseudo.Real @@ -30,11 +31,6 @@ namespace ApollonianSuperharmonic -- [TABLET NODE: P4112T1PathGeometry] namespace PathGeometryProof -private theorem hsum : - ∀ (P : FordFareyParameter), P.q = P.q₁ + P.q₂ := by - classical - intro P - exact P.sum_q private theorem hs : ∀ (P : FordFareyParameter), @@ -1333,7 +1329,7 @@ theorem P4112T1PathGeometry (P : FordFareyParameter) (hP : 2 < P.q) : (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1) let r := P.q₁ let s := P.q₂ - have hsum := PathGeometryProof.hsum P + have hsum := FordFareySum.denominatorSum P have hs := PathGeometryProof.hs P have hr := PathGeometryProof.hr P hP hsum have hrs := PathGeometryProof.hrs P hP hsum diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean index 4fe3d215d5..fcf1c005b5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean @@ -6,13 +6,13 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.InteriorFootprintIncidence public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification public import LeanPool.ApollonianSuperharmonic.FordBoundaryMultiplicity public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality -public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary public import Mathlib.Algebra.Order.Ring.Star -- [TABLET NODE: P4120T1FordGeometry] @@ -30,48 +30,7 @@ namespace ApollonianSuperharmonic namespace FordTileGeometry -private theorem hneAt131 : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ - BoundaryFootprintVertices T) → (T.cells.Nonempty)) ) := by - classical - intro T x hx hxb - by_contra hn - simp only [FootprintVertices, ite_eq_right hn, Set.mem_singleton_iff] at hx - apply hxb - simp [BoundaryFootprintVertices, hn, hx] - -private theorem hsome : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ - BoundaryFootprintVertices T) → ((T.cells.Nonempty) → (∃ j : Fin 4, - LatticeVertexIncidentCell x j ∈ T.cells))) ) := by - classical - intro T x hx hxb hne - rw [FootprintVertices, ite_eq_left hne] at hx - rcases hx with ⟨y, hy, rfl | rfl | rfl | rfl⟩ - · exact ⟨0, by simpa [LatticeVertexIncidentCell] using hy⟩ - · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hy⟩ - · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hy⟩ - · refine ⟨2, ?_⟩ - simpa [LatticeVertexIncidentCell, sub_eq_add_neg, - add_assoc, add_comm, add_left_comm] using hy -private theorem cells : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∉ BoundaryFootprintVertices T) → ((∃ j : Fin - 4, LatticeVertexIncidentCell x j ∈ T.cells) → (∀ j : Fin 4, LatticeVertexIncidentCell - x j ∈ T.cells)) ) := by - classical - intro T x hxb hsome j - by_contra hj - exact hxb (P3161T2IncidentBoundary T x hsome ⟨j, hj⟩) private theorem cellCanonical : (by @@ -1600,9 +1559,9 @@ theorem P4120T1FordGeometry x ∈ FootprintVertices (S i s) ∧ x ∉ BoundaryFootprintVertices (S i s)) := by -- BODY classical - have hne := FordTileGeometry.hneAt131 T x hx hxb - have hsome := FordTileGeometry.hsome T x hx hxb hne - have cells := FordTileGeometry.cells T x hxb hsome + have hne := InteriorFootprintIncidence.nonempty T x hx hxb + have hsome := InteriorFootprintIncidence.someIncidentCell T x hx hxb hne + have cells := InteriorFootprintIncidence.allIncidentCells T x hxb hsome let y : GaussianInt := x - u have cellCanonical (z : GaussianInt) := FordTileGeometry.cellCanonical P T u hcells z have squareCell (z : GaussianInt) := FordTileGeometry.squareCell P z diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean index fada65efd3..b4e8378f7b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.InteriorFootprintIncidence public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidenceZeroOppositeChord public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation @@ -27,48 +28,7 @@ namespace ApollonianSuperharmonic namespace GeneralDescentGeometry -private theorem hneAt129 : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ - BoundaryFootprintVertices T) → (T.cells.Nonempty)) ) := by - classical - intro T x hx hxb - by_contra hn - simp only [FootprintVertices, ite_eq_right hn, Set.mem_singleton_iff] at hx - apply hxb - simp [BoundaryFootprintVertices, hn, hx] -private theorem hsome : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ - BoundaryFootprintVertices T) → ((T.cells.Nonempty) → (∃ j : Fin 4, - LatticeVertexIncidentCell x j ∈ T.cells))) ) := by - classical - intro T x hx hxb hne - rw [FootprintVertices, ite_eq_left hne] at hx - rcases hx with ⟨y, hy, rfl | rfl | rfl | rfl⟩ - · exact ⟨0, by simpa [LatticeVertexIncidentCell] using hy⟩ - · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hy⟩ - · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hy⟩ - · refine ⟨2, ?_⟩ - simpa [LatticeVertexIncidentCell, sub_eq_add_neg, - add_assoc, add_comm, add_left_comm] using hy - -private theorem cells : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∉ BoundaryFootprintVertices T) → ((∃ j : Fin - 4, LatticeVertexIncidentCell x j ∈ T.cells) → (∀ j : Fin 4, LatticeVertexIncidentCell - x j ∈ T.cells)) ) := by - classical - intro T x hxb hsome j - by_contra hj - exact hxb (P3161T2IncidentBoundary T x hsome ⟨j, hj⟩) private theorem hpos : (by @@ -1494,8 +1454,9 @@ theorem P4120T1GeneralDescent x ∉ BoundaryFootprintVertices (cert.P i s) := by -- BODY classical - have cells := GeneralDescentGeometry.cells T x hxb (GeneralDescentGeometry.hsome T x hx hxb - (GeneralDescentGeometry.hneAt129 T x hx hxb)) + have cells := InteriorFootprintIncidence.allIncidentCells T x hxb + (InteriorFootprintIncidence.someIncidentCell T x hx hxb + (InteriorFootprintIncidence.nonempty T x hx hxb)) have hcurv := ProperBandCurvatureStructure q cfg.proper have hOsub := GeneralDescentGeometry.hOsub q cfg C T cert have modified_cell_owner := GeneralDescentGeometry.modified_cell_owner q cfg C T cert hOsub diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean index c43210da73..451d634432 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean @@ -271,74 +271,17 @@ private theorem ford_disjoint_im : simp [Zsqrtd.im_sub] at hW hV omega -private theorem q₁pos : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (i : Fin (3 : - ℕ)), (i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → - (((0 : ℕ) < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), - ∀ (h' : PartialOdometer), ∀ (u : GaussianInt), (T'.cells = (TileTranslation (FordTile - P.q) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) - else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) → (∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ - (hs : List PartialOdometer), ∀ (reverseHs : List PartialOdometer), (Rminus.cells = - (TileTranslation (FordTile (if i = (0 : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i - = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (0 : ℤ)⟩ : GaussianInt) else (⟨(0 : ℤ), (↑P.q - : ℤ)⟩ : GaussianInt))).cells) → ((Rplus.cells = (TileTranslation (FordTile (if i = (0 - : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q₂ : - ℤ), (↑P.q : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : GaussianInt))).cells) - → ((∀ (z : GaussianInt), ((z - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else - (0 : ℤ)) → (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (z - u).im - → (z - u).im < (↑P.q : ℤ) → ∃ (U : ProtoTile) (V : ProtoTile) (g : PartialOdometer) - (k : PartialOdometer), U ∈ (List.drop (1 : ℕ) tiles).dropLast ∧ V ∈ (List.drop (1 : - ℕ) reverseTiles).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ (V, k) ∈ reverseTiles.zip - reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 U T g h ∧ AncestorOdometer Ci.1.1 C0.1.1 V - T' k h' ∧ {z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U ∧ {z, - z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (x : GaussianInt), - ((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) → (((if i = (0 : - Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im) → (0 < P.q₁)))))))) ) - := by - classical - intro P C0 Ci i hsmall hrpos T T' h h' u hc' Rminus Rplus tiles reverseTiles hs reverseHs hRm - hRp hedges x hxr hxl - rcases hsmall with ⟨hi, hlt⟩ | ⟨hi, hlt⟩ - · subst i - omega - · subst i - omega - private theorem lower_lt_q : (by classical - exact - ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (i : Fin (3 : - ℕ)), (i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → - (((0 : ℕ) < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), - ∀ (h' : PartialOdometer), ∀ (u : GaussianInt), (T'.cells = (TileTranslation (FordTile - P.q) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) - else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) → (∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ - (hs : List PartialOdometer), ∀ (reverseHs : List PartialOdometer), (Rminus.cells = - (TileTranslation (FordTile (if i = (0 : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i - = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (0 : ℤ)⟩ : GaussianInt) else (⟨(0 : ℤ), (↑P.q - : ℤ)⟩ : GaussianInt))).cells) → ((Rplus.cells = (TileTranslation (FordTile (if i = (0 - : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q₂ : - ℤ), (↑P.q : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : GaussianInt))).cells) - → ((∀ (z : GaussianInt), ((z - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else - (0 : ℤ)) → (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (z - u).im - → (z - u).im < (↑P.q : ℤ) → ∃ (U : ProtoTile) (V : ProtoTile) (g : PartialOdometer) - (k : PartialOdometer), U ∈ (List.drop (1 : ℕ) tiles).dropLast ∧ V ∈ (List.drop (1 : - ℕ) reverseTiles).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ (V, k) ∈ reverseTiles.zip - reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 U T g h ∧ AncestorOdometer Ci.1.1 C0.1.1 V - T' k h' ∧ {z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U ∧ {z, - z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (x : GaussianInt), - ((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) → (((if i = (0 : - Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im) → (((x - u).im ≤ (↑P.q - : ℤ)) → ((if i = 0 then (P.q₁ : Int) else P.q₂) < P.q))))))))) ) := by - classical - intro P C0 Ci i hsmall hrpos T T' h h' u hc' Rminus Rplus tiles reverseTiles hs reverseHs hRm - hRp hedges x hxr hxl hxu + exact + ∀ (P : FordFareyParameter), + ∀ (i : Fin (3 : ℕ)), + (i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ + i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → + ((if i = 0 then (P.q₁ : Int) else P.q₂) < P.q)) := by + classical + intro P i hsmall rcases hsmall with ⟨hi, hlt⟩ | ⟨hi, hlt⟩ · subst i have hq : (P.q₁ : Int) + P.q₂ = P.q := by exact_mod_cast P.sum_q.symm @@ -630,62 +573,45 @@ private theorem cross_ne : private theorem forward_support : (by classical - exact - ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (i : Fin (3 : - ℕ)), (i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → (∀ - (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : - PartialOdometer), ∀ (u : GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) (u - + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else - (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) → (∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ - (hs : List PartialOdometer), ∀ (reverseHs : List PartialOdometer), (Rminus.cells = - (TileTranslation (FordTile (if i = (0 : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i - = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (0 : ℤ)⟩ : GaussianInt) else (⟨(0 : ℤ), (↑P.q - : ℤ)⟩ : GaussianInt))).cells) → ((Rplus.cells = (TileTranslation (FordTile (if i = (0 - : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q₂ : - ℤ), (↑P.q : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : GaussianInt))).cells) - → ((∀ (z : GaussianInt), ((z - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else - (0 : ℤ)) → (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (z - u).im - → (z - u).im < (↑P.q : ℤ) → ∃ (U : ProtoTile) (V : ProtoTile) (g : PartialOdometer) - (k : PartialOdometer), U ∈ (List.drop (1 : ℕ) tiles).dropLast ∧ V ∈ (List.drop (1 : - ℕ) reverseTiles).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ (V, k) ∈ reverseTiles.zip - reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 U T g h ∧ AncestorOdometer Ci.1.1 C0.1.1 V - T' k h' ∧ {z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U ∧ {z, - z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (PP : - PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ((x - u).re = if i = - (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) → (((if i = (0 : Fin (3 : ℕ)) then - (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im) → ((∀ (W : ProtoTile), ∀ (w : - GaussianInt), ({w, w + ⟨0, 1⟩} ∈ FootprintEdges W) → (w ∈ W.cells ∨ w - 1 ∈ W.cells)) - → (((if i = 0 then (P.q₁ : Int) else P.q₂) < P.q) → ( - let z : GaussianInt := - if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) - then x else x - ⟨0, 1⟩ - (((x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x)) → (((¬(x - u).im = (if - i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x - ⟨0, 1⟩)) → ((z = x ∨ z = x - ⟨0, 1⟩) → - (((z - u).re = (if i = 0 then (P.q : Int) else 0)) → (((if i = 0 then (P.q₁ : Int) - else P.q₂) ≤ (z-u).im) → (((z-u).im < P.q) → (∀ (U : ProtoTile), ∀ (V : ProtoTile), - ({z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U) → (({z, - z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (a : ↥(TilingLattice - Ci)), ∀ (b : ↥(TilingLattice Ci)), (PP.tile a = U) → ((U.cells ⊆ T.cells) → (({z, - z + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile a)) → (({z, z + ⟨0, 1⟩} ∈ FootprintEdges - (PP.tile b)) → ((∀ (c : GaussianInt), (c ∈ T.cells) → (0 ≤ (c-u).re ∧ (c-u).re < P.q - ∧ 0 ≤ (c-u).im ∧ (c-u).im < P.q)) → ((∀ (c : GaussianInt), (c ∈ T'.cells) → (0 ≤ - (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : - Int)⟩)).re ∧ (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), - (P.q₂ : Int)⟩)).re < P.q ∧ 0 ≤ (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else - ⟨-(P.q : Int), (P.q₂ : Int)⟩)).im ∧ (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ - else ⟨-(P.q : Int), (P.q₂ : Int)⟩)).im < P.q)) → ((∀ (w : GaussianInt), ((w-u).re = - (if i = 0 then (P.q : Int) else 0)) → (((if i = 0 then (P.q₁ : Int) else P.q₂) ≤ - (w-u).im) → (((w-u).im < P.q) → (∃ (aa bb : TilingLattice Ci) (gg kk : - PartialOdometer), aa ≠ bb ∧ (PP.tile aa, gg) ∈ tiles.zip hs ∧ (PP.tile bb, kk) ∈ - reverseTiles.zip reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 (PP.tile aa) T gg h ∧ - AncestorOdometer Ci.1.1 C0.1.1 (PP.tile bb) T' kk h' ∧ {w, w + ⟨0, 1⟩} ∈ - FootprintEdges (PP.tile aa) ∧ {w, w + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile bb))))) → (∃ - c, c ∈ U.cells ∧ (if i = 0 then c = z - 1 else c = z))))))))))))))))))))))))) ) := by - classical - intro P C0 Ci i hsmall T T' h h' u hc' Rminus Rplus tiles reverseTiles hs reverseHs hRm hRp - hedges PP x hxr hxl vertical_edge_cells lower_lt_q z z_low z_other z_incident hz_re hz_low - hz_high U V hEdgeU hEdgeV a b hUa U_in_T U_edge V_edge T_bounds T'_bounds indexed_edge + exact + ∀ (P : FordFareyParameter), + ∀ (Ci : BandCircle), + ∀ (i : Fin (3 : ℕ)), + (i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ + i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → + (∀ (T : ProtoTile), + ∀ (u : GaussianInt), + (∀ (PP : PeriodicTileComplex ↥(TilingLattice Ci)), + ∀ (x : GaussianInt), + ((∀ (W : ProtoTile), + ∀ (w : GaussianInt), + ({w, w + ⟨0, 1⟩} ∈ FootprintEdges W) → + (w ∈ W.cells ∨ w - 1 ∈ W.cells)) → + (let z : GaussianInt := + if + (x - u).im = + (if i = 0 then (P.q₁ : Int) else P.q₂) then + x + else x - ⟨0, 1⟩; + (((z - u).re = (if i = 0 then (P.q : Int) else 0)) → + (∀ (U : ProtoTile), + (∀ (a : ↥(TilingLattice Ci)), + (PP.tile a = U) → + ((U.cells ⊆ T.cells) → + (({z, z + ⟨0, 1⟩} ∈ + FootprintEdges (PP.tile a)) → + ((∀ (c : GaussianInt), + (c ∈ T.cells) → + (0 ≤ (c - u).re ∧ + (c - u).re < P.q ∧ + 0 ≤ (c - u).im ∧ + (c - u).im < P.q)) → + (∃ c, + c ∈ U.cells ∧ + (if i = 0 then c = z - 1 + else c = z))))))))))))) := by + classical + intro P Ci i hsmall T u PP x vertical_edge_cells z hz_re U a hUa U_in_T U_edge T_bounds have hsup := vertical_edge_cells U z (by simpa [hUa] using U_edge) rcases hsmall with ⟨hi, hlt⟩ | ⟨hi, hlt⟩ · subst i @@ -709,62 +635,76 @@ private theorem forward_support : private theorem reverse_support : (by classical - exact - ∀ (P : FordFareyParameter), ∀ (C0 : BandCircle), ∀ (Ci : BandCircle), ∀ (i : Fin (3 : - ℕ)), (i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → (∀ - (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : - PartialOdometer), ∀ (u : GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) (u - + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else - (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) → (∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (reverseTiles : List ProtoTile), ∀ - (hs : List PartialOdometer), ∀ (reverseHs : List PartialOdometer), (Rminus.cells = - (TileTranslation (FordTile (if i = (0 : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i - = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), (0 : ℤ)⟩ : GaussianInt) else (⟨(0 : ℤ), (↑P.q - : ℤ)⟩ : GaussianInt))).cells) → ((Rplus.cells = (TileTranslation (FordTile (if i = (0 - : Fin (3 : ℕ)) then P.q₁ else P.q₂)) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q₂ : - ℤ), (↑P.q : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : GaussianInt))).cells) - → ((∀ (z : GaussianInt), ((z - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else - (0 : ℤ)) → (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (z - u).im - → (z - u).im < (↑P.q : ℤ) → ∃ (U : ProtoTile) (V : ProtoTile) (g : PartialOdometer) - (k : PartialOdometer), U ∈ (List.drop (1 : ℕ) tiles).dropLast ∧ V ∈ (List.drop (1 : - ℕ) reverseTiles).dropLast ∧ (U, g) ∈ tiles.zip hs ∧ (V, k) ∈ reverseTiles.zip - reverseHs ∧ AncestorOdometer Ci.1.1 C0.1.1 U T g h ∧ AncestorOdometer Ci.1.1 C0.1.1 V - T' k h' ∧ {z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U ∧ {z, - z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (PP : - PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), ((x - u).re = if i = - (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) → (((if i = (0 : Fin (3 : ℕ)) then - (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im) → ((∀ (W : ProtoTile), ∀ (w : - GaussianInt), ({w, w + ⟨0, 1⟩} ∈ FootprintEdges W) → (w ∈ W.cells ∨ w - 1 ∈ W.cells)) - → (((if i = 0 then (P.q₁ : Int) else P.q₂) < P.q) → ( - let z : GaussianInt := - if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) - then x else x - ⟨0, 1⟩ - (((x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x)) → (((¬(x - u).im = (if - i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x - ⟨0, 1⟩)) → ((z = x ∨ z = x - ⟨0, 1⟩) → - (((z - u).re = (if i = 0 then (P.q : Int) else 0)) → (((if i = 0 then (P.q₁ : Int) - else P.q₂) ≤ (z-u).im) → (((z-u).im < P.q) → (∀ (U : ProtoTile), ∀ (V : ProtoTile), - ({z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges U) → (({z, - z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ (a : ↥(TilingLattice - Ci)), ∀ (b : ↥(TilingLattice Ci)), (PP.tile b = V) → ((V.cells ⊆ T'.cells) → (({z, - z + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile a)) → (({z, z + ⟨0, 1⟩} ∈ FootprintEdges - (PP.tile b)) → ((∀ (c : GaussianInt), (c ∈ T'.cells) → (0 ≤ (c-(u + if i = 0 then - ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : Int)⟩)).re ∧ (c-(u + if i = 0 - then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : Int)⟩)).re < P.q ∧ 0 ≤ - (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : - Int)⟩)).im ∧ (c-(u + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), - (P.q₂ : Int)⟩)).im < P.q)) → ((∀ (w : GaussianInt), ((w-u).re = (if i = 0 then (P.q : - Int) else 0)) → (((if i = 0 then (P.q₁ : Int) else P.q₂) ≤ (w-u).im) → (((w-u).im < - P.q) → (∃ (aa bb : TilingLattice Ci) (gg kk : PartialOdometer), aa ≠ bb ∧ (PP.tile - aa, gg) ∈ tiles.zip hs ∧ (PP.tile bb, kk) ∈ reverseTiles.zip reverseHs ∧ - AncestorOdometer Ci.1.1 C0.1.1 (PP.tile aa) T gg h ∧ AncestorOdometer Ci.1.1 C0.1.1 - (PP.tile bb) T' kk h' ∧ {w, w + ⟨0, 1⟩} ∈ FootprintEdges (PP.tile aa) ∧ {w, w + ⟨0, - 1⟩} ∈ FootprintEdges (PP.tile bb))))) → ((∃ c, c ∈ U.cells ∧ (if i = 0 then c = z - 1 - else c = z)) → (∃ c, c ∈ V.cells ∧ (if i = 0 then c = z else c = z - - 1))))))))))))))))))))))))) ) := by - classical - intro P C0 Ci i hsmall T T' h h' u hc' Rminus Rplus tiles reverseTiles hs reverseHs hRm hRp - hedges PP x hxr hxl vertical_edge_cells lower_lt_q z z_low z_other z_incident hz_re hz_low - hz_high U V hEdgeU hEdgeV a b hVb V_in_T' U_edge V_edge T'_bounds indexed_edge forward_support + exact + ∀ (P : FordFareyParameter), + ∀ (Ci : BandCircle), + ∀ (i : Fin (3 : ℕ)), + (i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ + i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → + (∀ (T' : ProtoTile), + ∀ (u : GaussianInt), + (∀ (PP : PeriodicTileComplex ↥(TilingLattice Ci)), + ∀ (x : GaussianInt), + ((∀ (W : ProtoTile), + ∀ (w : GaussianInt), + ({w, w + ⟨0, 1⟩} ∈ FootprintEdges W) → + (w ∈ W.cells ∨ w - 1 ∈ W.cells)) → + (let z : GaussianInt := + if + (x - u).im = + (if i = 0 then (P.q₁ : Int) else P.q₂) then + x + else x - ⟨0, 1⟩; + (((z - u).re = (if i = 0 then (P.q : Int) else 0)) → + (∀ (V : ProtoTile), + (∀ (b : ↥(TilingLattice Ci)), + (PP.tile b = V) → + ((V.cells ⊆ T'.cells) → + (({z, z + ⟨0, 1⟩} ∈ + FootprintEdges (PP.tile b)) → + ((∀ (c : GaussianInt), + (c ∈ T'.cells) → + (0 ≤ + (c - + (u + + if i = 0 then + ⟨(P.q : Int), (P.q₁ : Int)⟩ + else + ⟨-(P.q : Int), + (P.q₂ : Int)⟩)).re ∧ + (c - + (u + + if i = 0 then + ⟨(P.q : Int), + (P.q₁ : Int)⟩ + else + ⟨-(P.q : Int), + (P.q₂ : Int)⟩)).re < + P.q ∧ + 0 ≤ + (c - + (u + + if i = 0 then + ⟨(P.q : Int), + (P.q₁ : Int)⟩ + else + ⟨-(P.q : Int), + (P.q₂ : Int)⟩)).im ∧ + (c - + (u + + if i = 0 then + ⟨(P.q : Int), + (P.q₁ : Int)⟩ + else + ⟨-(P.q : Int), + (P.q₂ : Int)⟩)).im < + P.q)) → + (∃ c, + c ∈ V.cells ∧ + (if i = 0 then c = z + else c = z - 1))))))))))))) := by + classical + intro P Ci i hsmall T' u PP x vertical_edge_cells z hz_re V b hVb V_in_T' V_edge T'_bounds have hsup := vertical_edge_cells V z (by simpa [hVb] using V_edge) rcases hsmall with ⟨hi, hlt⟩ | ⟨hi, hlt⟩ · subst i @@ -2319,10 +2259,8 @@ theorem P4158T1EdgeSectorSelection : have translated_ford_cell := EdgeSectorGeometry.translated_ford_cell have ford_disjoint_re := EdgeSectorGeometry.ford_disjoint_re P Ci i u x translated_ford_bounds have ford_disjoint_im := EdgeSectorGeometry.ford_disjoint_im P Ci i u x translated_ford_bounds - have q₁pos := EdgeSectorGeometry.q₁pos P C0 Ci i hsmall hrpos T T' h h' u hc' Rminus Rplus - tiles reverseTiles hs reverseHs hRm hRp hedges x hxr hxl - have lower_lt_q := EdgeSectorGeometry.lower_lt_q P C0 Ci i hsmall hrpos T T' h h' u hc' - Rminus Rplus tiles reverseTiles hs reverseHs hRm hRp hedges x hxr hxl hxu + have q₁pos := hrpos + have lower_lt_q := EdgeSectorGeometry.lower_lt_q P i hsmall let z : GaussianInt := if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) then x else x - ⟨0, 1⟩ @@ -2352,14 +2290,10 @@ theorem P4158T1EdgeSectorSelection : have indexed_edge := EdgeSectorGeometry.indexed_edge P C0 Ci i T T' h h' u hdis orientation base Rminus Rplus tiles reverseTiles hs reverseHs hf hr hcontain hcontain' hedges PP regular_index vertical_edge_cells - have forward_support := EdgeSectorGeometry.forward_support P C0 Ci i hsmall T T' h h' u hc' - Rminus Rplus tiles reverseTiles hs reverseHs hRm hRp hedges PP x hxr hxl - vertical_edge_cells lower_lt_q z_low z_other z_incident hz_re hz_low hz_high U V hEdgeU - hEdgeV a b hUa U_in_T U_edge V_edge T_bounds T'_bounds indexed_edge - have reverse_support := EdgeSectorGeometry.reverse_support P C0 Ci i hsmall T T' h h' u hc' - Rminus Rplus tiles reverseTiles hs reverseHs hRm hRp hedges PP x hxr hxl - vertical_edge_cells lower_lt_q z_low z_other z_incident hz_re hz_low hz_high U V hEdgeU - hEdgeV a b hVb V_in_T' U_edge V_edge T'_bounds indexed_edge forward_support + have forward_support := EdgeSectorGeometry.forward_support P Ci i hsmall T u PP x + vertical_edge_cells hz_re U a hUa U_in_T U_edge T_bounds + have reverse_support := EdgeSectorGeometry.reverse_support P Ci i hsmall T' u PP x + vertical_edge_cells hz_re V b hVb V_in_T' V_edge T'_bounds obtain ⟨cf, hcf, hcfSide⟩ := forward_support obtain ⟨cb, hcb, hcbSide⟩ := reverse_support have hab := EdgeSectorGeometry.hab Ci T T' hdis PP U V a b hUa hVb U_in_T V_in_T' cf hcf diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean index ce1bdf1b20..fdc8cfca7c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean @@ -154,30 +154,25 @@ private theorem determinantCoprime : private theorem hFord : (by classical - exact - ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P - i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ - P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (T'.cells - = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), - (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) - → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ ((x - u).re - = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) - then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ (x - u).im ≤ (↑P.q : ℤ)) → (∀ - (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), (TileCentroid Rminus - TileCentroid T = - (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 - (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + - BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P - i.succ))) → ((0 < P.q₁) → (((0 : ℕ) < P.q₂) → ( - let n := if i = 0 then P.q₁ else P.q₂ - (0 < n) → ((n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ((∀ (a : Int), ∀ (b : - Nat), ∀ (d : Nat), ∀ (c : Int), (a * (d : Int) - (b : Int) * c = 1) → (Nat.Coprime b - a.natAbs)) → (BandPrototile Ci.1.1 (FordTile n)))))))))))))) ) := by + exact + ∀ (P : FordFareyParameter), + ∀ (Ci : BandCircle), + ∀ (i : Fin 3), + (FordRecursiveQuadruple P i.succ = Ci.1.1) → + ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ + i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → + ((0 < P.q₁) → + (((0 : ℕ) < P.q₂) → + (let n := if i = 0 then P.q₁ else P.q₂; + ((∀ (a : Int), + ∀ (b : Nat), + ∀ (d : Nat), + ∀ (c : Int), + (a * (d : Int) - (b : Int) * c = 1) → + (Nat.Coprime b a.natAbs)) → + (BandPrototile Ci.1.1 (FordTile n)))))))) := by classical - intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hrpos hspos n hnpos hnq - hCicurv hnlarge determinantCoprime + intro P Ci i hCi hsmall hrpos hspos n determinantCoprime rcases hsmall with ⟨rfl, _⟩ | ⟨rfl, _⟩ · obtain ⟨Q, ⟨hpQ, hqQ⟩, _⟩ := FordFareyParentsExist P.p₁ P.q₁ hrpos (determinantCoprime P.p₁ P.q₁ P.q P.p P.det₁) @@ -300,51 +295,91 @@ private theorem hcentT : private theorem hcmcand : (by classical - exact - ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P - i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ - P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (T'.cells - = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), - (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) - → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ ((x - u).re - = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) - then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ (x - u).im ≤ (↑P.q : ℤ)) → (∀ - (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), (TileCentroid Rminus - TileCentroid T = - (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 - (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + - BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P - i.succ))) → ( - let n := if i = 0 then P.q₁ else P.q₂ - (0 < n) → ((n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ((BandPrototile Ci.1.1 - (FordTile n)) → ((∀ (m : Nat), (0 < m) → (TileCentroid (FordTile m) = ((m : Real) / - 2, (m : Real) / 2))) → ((TileCentroid T = ((P.q : Real) / 2 + u.re, (P.q : Real) / 2 - + u.im)) → ( - let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ - (BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P - i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (FordRecursiveQuadruple - P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) → ((ProperBandQuadruple - (FordRecursiveQuadruple P) ∧ BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : - ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : - GaussianInt) ∧ BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : - GaussianInt) ∧ BandVectors.1 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨(0 : ℤ), -(↑P.q : ℤ)⟩ : GaussianInt) - ∧ BandVectors.2 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) = (⟨P.p₁, P.p⟩ : GaussianInt) ∧ BandVectors.2 - (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : - ℕ))) = (⟨P.p₂, -P.p⟩ : GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple P (3 : - Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨-P.p, (0 : ℤ)⟩ : - GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) = (⟨-P.p₂, (0 : ℤ)⟩ : GaussianInt) ∧ - BandVectors.2 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple P - (3 : Fin (4 : ℕ))) = (⟨(0 : ℤ), P.p₁⟩ : GaussianInt)) → (TileCentroid Rminus = - TileCentroid (TileTranslation (FordTile n) vm)))))))))))))))) ) := by + exact + ∀ (P : FordFareyParameter), + ∀ (i : Fin 3), + ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ + i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → + (∀ (T : ProtoTile), + ∀ (u : GaussianInt), + (∀ (Rminus : ProtoTile), + (TileCentroid Rminus - TileCentroid T = + (1 / 2 : ℝ) • + GaussianRealPoint + (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - + BandVectors.1 + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ))) → + (let n := if i = 0 then P.q₁ else P.q₂; + (0 < n) → + ((∀ (m : Nat), + (0 < m) → + (TileCentroid (FordTile m) = + ((m : Real) / 2, (m : Real) / 2))) → + ((TileCentroid T = + ((P.q : Real) / 2 + u.re, (P.q : Real) / 2 + u.im)) → + (let vm : GaussianInt := + u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩; + (BandVectors.1 + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ) = + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) → + ((ProperBandQuadruple (FordRecursiveQuadruple P) ∧ + BandVectors.1 + (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (0 : Fin (4 : ℕ))) = + (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) ∧ + BandVectors.1 + (FordRecursiveQuadruple P + (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (0 : Fin (4 : ℕ))) = + (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt) ∧ + BandVectors.1 + (FordRecursiveQuadruple P + (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (0 : Fin (4 : ℕ))) = + (⟨(0 : ℤ), -(↑P.q : ℤ)⟩ : GaussianInt) ∧ + BandVectors.2 + (FordRecursiveQuadruple P + (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (0 : Fin (4 : ℕ))) = + (⟨P.p₁, P.p⟩ : GaussianInt) ∧ + BandVectors.2 + (FordRecursiveQuadruple P + (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (0 : Fin (4 : ℕ))) = + (⟨P.p₂, -P.p⟩ : GaussianInt) ∧ + BandVectors.2 + (FordRecursiveQuadruple P + (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (0 : Fin (4 : ℕ))) = + (⟨-P.p, (0 : ℤ)⟩ : GaussianInt) ∧ + BandVectors.2 + (FordRecursiveQuadruple P + (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (2 : Fin (4 : ℕ))) = + (⟨-P.p₂, (0 : ℤ)⟩ : GaussianInt) ∧ + BandVectors.2 + (FordRecursiveQuadruple P + (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (3 : Fin (4 : ℕ))) = + (⟨(0 : ℤ), P.p₁⟩ : GaussianInt)) → + (TileCentroid Rminus = + TileCentroid + (TileTranslation (FordTile n) vm))))))))))) := by classical - intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp n hnpos hnq hCicurv hnlarge - hFord fordcent hcentT vm hflip hvecs + intro P i hsmall T u Rminus hcm n hnpos fordcent hcentT vm hflip hvecs rw [(TileTranslationFormulas _ _).2.2.2.2.1, fordcent n hnpos] rw [hflip] at hcm rcases hsmall with ⟨rfl, _⟩ | ⟨rfl, _⟩ @@ -366,53 +401,91 @@ private theorem hcmcand : private theorem hcpcand : (by classical - exact - ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P - i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ - P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (T'.cells - = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), - (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) - → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ ((x - u).re - = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) - then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ (x - u).im ≤ (↑P.q : ℤ)) → (∀ - (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), (TileCentroid Rminus - TileCentroid T = - (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 - (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + - BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P - i.succ))) → ( - let n := if i = 0 then P.q₁ else P.q₂ - (0 < n) → ((n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ((BandPrototile Ci.1.1 - (FordTile n)) → ((∀ (m : Nat), (0 < m) → (TileCentroid (FordTile m) = ((m : Real) / - 2, (m : Real) / 2))) → ((TileCentroid T = ((P.q : Real) / 2 + u.re, (P.q : Real) / 2 - + u.im)) → ( - let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ - let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩ - (BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P - i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (FordRecursiveQuadruple - P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) → ((ProperBandQuadruple - (FordRecursiveQuadruple P) ∧ BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : - ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : - GaussianInt) ∧ BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : - GaussianInt) ∧ BandVectors.1 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨(0 : ℤ), -(↑P.q : ℤ)⟩ : GaussianInt) - ∧ BandVectors.2 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) = (⟨P.p₁, P.p⟩ : GaussianInt) ∧ BandVectors.2 - (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : - ℕ))) = (⟨P.p₂, -P.p⟩ : GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple P (3 : - Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = (⟨-P.p, (0 : ℤ)⟩ : - GaussianInt) ∧ BandVectors.2 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) = (⟨-P.p₂, (0 : ℤ)⟩ : GaussianInt) ∧ - BandVectors.2 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple P - (3 : Fin (4 : ℕ))) = (⟨(0 : ℤ), P.p₁⟩ : GaussianInt)) → ((TileCentroid Rminus = - TileCentroid (TileTranslation (FordTile n) vm)) → (TileCentroid Rplus = TileCentroid - (TileTranslation (FordTile n) vp))))))))))))))))) ) := by + exact + ∀ (P : FordFareyParameter), + ∀ (i : Fin 3), + ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ + i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → + (∀ (T : ProtoTile), + ∀ (u : GaussianInt), + (∀ (Rplus : ProtoTile), + ((TileCentroid Rplus - TileCentroid T = + (1 / 2 : ℝ) • + GaussianRealPoint + (BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + + BandVectors.1 + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ))) → + (let n := if i = 0 then P.q₁ else P.q₂; + (0 < n) → + ((∀ (m : Nat), + (0 < m) → + (TileCentroid (FordTile m) = + ((m : Real) / 2, (m : Real) / 2))) → + ((TileCentroid T = + ((P.q : Real) / 2 + u.re, (P.q : Real) / 2 + u.im)) → + (let vp : GaussianInt := + u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩; + (BandVectors.1 + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ) = + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * + BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) → + ((ProperBandQuadruple (FordRecursiveQuadruple P) ∧ + BandVectors.1 + (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (0 : Fin (4 : ℕ))) = + (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) ∧ + BandVectors.1 + (FordRecursiveQuadruple P + (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (0 : Fin (4 : ℕ))) = + (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt) ∧ + BandVectors.1 + (FordRecursiveQuadruple P + (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (0 : Fin (4 : ℕ))) = + (⟨(0 : ℤ), -(↑P.q : ℤ)⟩ : GaussianInt) ∧ + BandVectors.2 + (FordRecursiveQuadruple P + (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (0 : Fin (4 : ℕ))) = + (⟨P.p₁, P.p⟩ : GaussianInt) ∧ + BandVectors.2 + (FordRecursiveQuadruple P + (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (0 : Fin (4 : ℕ))) = + (⟨P.p₂, -P.p⟩ : GaussianInt) ∧ + BandVectors.2 + (FordRecursiveQuadruple P + (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (0 : Fin (4 : ℕ))) = + (⟨-P.p, (0 : ℤ)⟩ : GaussianInt) ∧ + BandVectors.2 + (FordRecursiveQuadruple P + (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (2 : Fin (4 : ℕ))) = + (⟨-P.p₂, (0 : ℤ)⟩ : GaussianInt) ∧ + BandVectors.2 + (FordRecursiveQuadruple P + (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P + (3 : Fin (4 : ℕ))) = + (⟨(0 : ℤ), P.p₁⟩ : GaussianInt)) → + (TileCentroid Rplus = + TileCentroid + (TileTranslation (FordTile n) vp)))))))))))) := by classical - intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp n hnpos hnq hCicurv hnlarge - hFord fordcent hcentT vm vp hflip hvecs hcmcand + intro P i hsmall T u Rplus hcp n hnpos fordcent hcentT vp hflip hvecs rw [(TileTranslationFormulas _ _).2.2.2.2.1, fordcent n hnpos] rw [hflip] at hcp have hsumR : (P.q : Real) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q @@ -453,39 +526,20 @@ private theorem hdelta : private theorem hnormdelta : (by classical - exact - ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P - i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ - P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (T'.cells - = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), - (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) - → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ ((x - u).re - = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) - then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ (x - u).im ≤ (↑P.q : ℤ)) → (∀ - (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), (TileCentroid Rminus - TileCentroid T = - (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 - (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + - BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P - i.succ))) → (((P.q : Int) = P.q₁ + P.q₂) → ( - let n := if i = 0 then P.q₁ else P.q₂ - (0 < n) → ((n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ((BandPrototile Ci.1.1 - (FordTile n)) → ( - let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ - let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩ - (BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P - i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (FordRecursiveQuadruple - P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) → ((TileCentroid Rminus = - TileCentroid (TileTranslation (FordTile n) vm)) → ((TileCentroid Rplus = TileCentroid - (TileTranslation (FordTile n) vp)) → ((Rminus.cells = (TileTranslation (FordTile n) - vm).cells) → ((Rplus.cells = (TileTranslation (FordTile n) vp).cells) → - ((TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint (vp - vm)) → - (Zsqrtd.norm (vp - vm) = (P.q : Int) ^ 2 + (n : Int) ^ 2)))))))))))))))))) ) := by + exact + ∀ (P : FordFareyParameter), + ∀ (i : Fin 3), + ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ + i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → + (∀ (u : GaussianInt), + (((P.q : Int) = P.q₁ + P.q₂) → + (let n := if i = 0 then P.q₁ else P.q₂; + (let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩; + let vp : GaussianInt := + u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩; + (Zsqrtd.norm (vp - vm) = (P.q : Int) ^ 2 + (n : Int) ^ 2))))))) := by classical - intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hsum n hnpos hnq hCicurv - hnlarge hFord vm vp hflip hcmcand hcpcand heqm heqp hdelta + intro P i hsmall u hsum n vm vp rcases hsmall with ⟨rfl, _⟩ | ⟨rfl, _⟩ · simp [vm, vp, n, Zsqrtd.norm_def] nlinarith [hsum] @@ -1015,8 +1069,7 @@ theorem P4158T1SmallerStringEdges have hC0pos := SmallerStringGeometry.hC0pos P C0 hC0 hqone have hCicurv := SmallerStringGeometry.hCicurv P Ci i hCi hsmall hrpos have hnlarge := SmallerStringGeometry.hnlarge P C0 Ci i hlarge hnpos hCicurv - have hFord := SmallerStringGeometry.hFord P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus - hcm hcp hrpos (P.q₂_pos) hnpos hnq hCicurv hnlarge + have hFord := SmallerStringGeometry.hFord P Ci i hCi hsmall hrpos (P.q₂_pos) (SmallerStringGeometry.determinantCoprime P C0 Ci i) have fordcell (m : Nat) (z : GaussianInt) : z ∈ (FordTile m).cells ↔ @@ -1030,10 +1083,10 @@ theorem P4158T1SmallerStringEdges let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩ have hflip := ((VectorRecursionLaws (FordRecursiveQuadruple P) hq.1).2.2.2.2 hq i).1 have hvecs := (FordCoordinateConfiguration P).2 hqone - have hcmcand := SmallerStringGeometry.hcmcand P Ci i hCi hsmall T T' u hc' hsegment Rminus - Rplus hcm hcp hnpos hnq hCicurv hnlarge hFord fordcent hcentT hflip hvecs - have hcpcand := SmallerStringGeometry.hcpcand P Ci i hCi hsmall T T' u hc' hsegment Rminus - Rplus hcm hcp hnpos hnq hCicurv hnlarge hFord fordcent hcentT hflip hvecs hcmcand + have hcmcand := SmallerStringGeometry.hcmcand P i hsmall T u Rminus hcm hnpos fordcent hcentT + hflip hvecs + have hcpcand := SmallerStringGeometry.hcpcand P i hsmall T u + Rplus hcp hnpos fordcent hcentT hflip hvecs have heqm := (BandPrototileCentroidUnique Ci.1.1 Rminus _ (TileOdometerBandPrototile _ _ _ hOm) (BandPrototileTranslation _ _ vm hFord) hcmcand).1 @@ -1041,9 +1094,7 @@ theorem P4158T1SmallerStringEdges (TileOdometerBandPrototile _ _ _ hOp) (BandPrototileTranslation _ _ vp hFord) hcpcand).1 have hdelta := SmallerStringGeometry.hdelta P i u Rminus Rplus hcmcand hcpcand - have hnormdelta := SmallerStringGeometry.hnormdelta P Ci i hCi hsmall T T' u hc' hsegment - Rminus Rplus hcm hcp hsum hnpos hnq hCicurv hnlarge hFord hflip hcmcand hcpcand heqm heqp - hdelta + have hnormdelta := SmallerStringGeometry.hnormdelta P i hsmall u hsum have pointinj := SmallerStringGeometry.pointinj have hRS := SmallerStringGeometry.hRS P Ci i hlarge u Rminus Rplus hCicurv hdelta hnormdelta pointinj diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean b/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean index 9b39b3a170..4d9c4b1f76 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean @@ -7,7 +7,6 @@ module public import Mathlib.Init -public import LeanPool.ApollonianSuperharmonic.P4250T1SlopeOffset public import LeanPool.ApollonianSuperharmonic.RightSubtileOdometerCompatibility -- [TABLET NODE: P4250T1OrdinaryCompatibility] @@ -190,14 +189,6 @@ private theorem sY : rw [hneg, sneg, sadd] ext <;> simp <;> ring -private theorem gaussianPointNeg : - (by - classical - exact - ∀ (z : GaussianInt), GaussianRealPoint (-z) = -GaussianRealPoint z ) := by - classical - intro z - ext <;> simp [GaussianRealPoint] private theorem hV20 : (by @@ -1791,7 +1782,7 @@ theorem P4250T1OrdinaryCompatibility have sneg (a : GaussianInt) : sOff (-a) = -sOff a := by apply Prod.ext <;> simp [sOff, P4250T1SlopeOffset] <;> ring have sY := OrdinaryCompatibilityGeometry.sY q (OrdinaryCompatibilityGeometry.hY q laws) sadd sneg - have gaussianPointNeg := OrdinaryCompatibilityGeometry.gaussianPointNeg + have gaussianPointNeg := GaussianRealPointProperties.negation have hV20 := OrdinaryCompatibilityGeometry.hV20 q cfg have hflip12 := firstLaws.2.2.2.2 cfg.firstProper 1 have hsumV12 := OrdinaryCompatibilityGeometry.hsumV12 q cfg hV20 diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean index 478c9ff38e..36a21437b2 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean @@ -123,45 +123,90 @@ private theorem hbandSelected : private theorem hgeom : (by classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T₀), ∀ (N : ProtoTile), ∀ (pN : ℝ × ℝ), ∀ (p0 : ℝ × ℝ), ∀ (q' : Fin (4 : ℕ) → - CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), (q' (0 : Fin (4 : ℕ)) = - C₀.1.1) → ((TileCentroid T₀ - TileCentroid N = (if e' = true then (1 : ℝ) else (-1 : - ℝ)) • GaussianRealPoint (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' i'.succ))) → ((p0.1 - - pN.1 = (if e' = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (q' (0 : Fin (4 - : ℕ))) (q' i'.succ)).re : ℝ)) → ((p0.2 - pN.2 = (if e' = true then (1 : ℝ) else (-1 : - ℝ)) * (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) (q' i'.succ)).im : ℝ)) → (∀ (ra : Fin - (3 : ℕ)), - let k : Fin 3 := i' + ra - (q' i'.succ = q k.succ) → ( - let μ : Int := if e' = true then -1 else 1 - let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 - let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 - ( - let V := BandVectors.1; - let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); - let U := V (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); - let W := V (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); V (q (1 : Fin (4 : ℕ))) (q (3 : - Fin (4 : ℕ))) = -U - W ∧ V (q (1 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = I * U ∧ V (q - (3 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = I * (U + W) ∧ V (q (2 : Fin (4 : ℕ))) (q - (3 : Fin (4 : ℕ))) = I * W ∧ V (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = U - I * - (U + W) ∧ V (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = W + I * U ∧ V (q (0 : Fin - (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = -U - W + I * W ∧ V (cfg.firstPredecessor (2 : Fin - (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) + V (cfg.firstPredecessor (0 : Fin - (4 : ℕ))) (cfg.firstPredecessor (2 : Fin (4 : ℕ))) = ((1 : GaussianInt) + I) * U ∧ V - (cfg.firstPredecessor (3 : Fin (4 : ℕ))) (cfg.firstPredecessor (0 : Fin (4 : ℕ))) + V - (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor (3 : Fin (4 : ℕ))) = - (I - (1 : GaussianInt)) * (U + W) ∧ V (cfg.secondPredecessor (1 : Fin (4 : ℕ))) - (cfg.secondPredecessor (0 : Fin (4 : ℕ))) + V (cfg.secondPredecessor (0 : Fin (4 : - ℕ))) (cfg.secondPredecessor (1 : Fin (4 : ℕ))) = ((1 : GaussianInt) + I) * W) → - (GaussianRealPoint ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v) = -((if - e' = true then (1 : ℝ) else -1) • GaussianRealPoint (BandVectors.1 (q' 0) (q' - i'.succ))))))))) ) := by + exact + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C₀ : BandCircle), + ∀ (T₀ : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T₀), + ∀ (q' : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i' : Fin (3 : ℕ)), + ∀ (e' : Bool), + (q' (0 : Fin (4 : ℕ)) = C₀.1.1) → + (∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra; + (q' i'.succ = q k.succ) → + (let μ : Int := if e' = true then -1 else 1; + let m : Int := + if k = 0 then μ else if k = 2 then -μ else 0; + let n : Int := + if k = 1 then μ else if k = 2 then -μ else 0; + (let V := BandVectors.1; + let I := (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt); + let U := + V (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); + let W := + V (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); + V (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = + -U - W ∧ + V (q (1 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = + I * U ∧ + V (q (3 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = + I * (U + W) ∧ + V (q (2 : Fin (4 : ℕ))) + (q (3 : Fin (4 : ℕ))) = + I * W ∧ + V (q (0 : Fin (4 : ℕ))) + (q (1 : Fin (4 : ℕ))) = + U - I * (U + W) ∧ + V (q (0 : Fin (4 : ℕ))) + (q (2 : Fin (4 : ℕ))) = + W + I * U ∧ + V (q (0 : Fin (4 : ℕ))) + (q (3 : Fin (4 : ℕ))) = + -U - W + I * W ∧ + V + (cfg.firstPredecessor + (2 : Fin (4 : ℕ))) + (cfg.firstPredecessor + (0 : Fin (4 : ℕ))) + + V + (cfg.firstPredecessor + (0 : Fin (4 : ℕ))) + (cfg.firstPredecessor + (2 : Fin (4 : ℕ))) = + ((1 : GaussianInt) + I) * U ∧ + V + (cfg.firstPredecessor + (3 : Fin (4 : ℕ))) + (cfg.firstPredecessor + (0 : Fin (4 : ℕ))) + + V + (cfg.firstPredecessor + (0 : Fin (4 : ℕ))) + (cfg.firstPredecessor + (3 : Fin (4 : ℕ))) = + (I - (1 : GaussianInt)) * + (U + W) ∧ + V + (cfg.secondPredecessor + (1 : Fin (4 : ℕ))) + (cfg.secondPredecessor + (0 : Fin (4 : ℕ))) + + V + (cfg.secondPredecessor + (0 : Fin (4 : ℕ))) + (cfg.secondPredecessor + (1 : Fin (4 : ℕ))) = + ((1 : GaussianInt) + I) * W) → + (GaussianRealPoint + ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v) = + -((if e' = true then (1 : ℝ) else -1) • + GaussianRealPoint + (BandVectors.1 (q' 0) (q' i'.succ))))))) := by classical - intro q cfg C₀ T₀ cert N pN p0 q' i' e' hq'0 hcentAdj hslopeAdj1 hslopeAdj2 ra k hAdjChild μ m - n hforms + intro q cfg C₀ T₀ cert q' i' e' hq'0 ra k hAdjChild μ m n hforms have hchild : q' i'.succ = q k.succ := hAdjChild rw [cert.period_u, cert.period_v, hq'0, cert.child_eq, hchild] have h01 := hforms.2.2.2.2.1 @@ -612,46 +657,46 @@ private theorem hsumAIm : private theorem hSlopePeriod : (by classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T₀), ∀ (N : ProtoTile), ∀ (T : ProtoTile), ∀ (pN : ℝ × ℝ), ∀ (p0 : ℝ × ℝ), ∀ (q' : - Fin (4 : ℕ) → CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), (q' (0 : Fin - (4 : ℕ)) = C₀.1.1) → ((TileCentroid T₀ - TileCentroid N = (if e' = true then (1 : ℝ) - else (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' - i'.succ))) → ((p0.1 - pN.1 = (if e' = true then (1 : ℝ) else (-1 : ℝ)) * - (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) (q' i'.succ)).re : ℝ)) → ((p0.2 - pN.2 = (if - e' = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) (q' - i'.succ)).im : ℝ)) → (∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (R : Fin (3 : ℕ) → Bool - → ProtoTile), ∀ (r : Fin (3 : ℕ)), - let j : Fin 3 := i'' + r - ∀ (ra : Fin (3 : ℕ)), - let k : Fin 3 := i' + ra - (q' i'.succ = q k.succ) → ( - let μ : Int := if e' = true then -1 else 1 - let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 - let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 - (GaussianRealPoint ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v) = -((if e' = - true then (1 : ℝ) else -1) • GaussianRealPoint (BandVectors.1 (q' 0) (q' i'.succ)))) - → ((TileCentroid N - TileCentroid T₀ = GaussianRealPoint ((m : GaussianInt) * cert.u - + (n : GaussianInt) * cert.v)) → ( - let shift : GaussianInt := (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v - let Pshift : ProtoTile := TileTranslation (cert.P j s) shift - (BandPrototile (q j.succ) Pshift) → ((TileCentroid Pshift = TileCentroid (cert.P j s) + - GaussianRealPoint shift) → ((TileCentroid (R j s) = TileCentroid Pshift) → (((R j - s).cells = Pshift.cells) → ((T.cells = Pshift.cells) → ((FootprintVertices T = - FootprintVertices Pshift) → (((GaussianInt.toComplex (BandVectors.2 (q 0) (q 3))).re - = -(GaussianInt.toComplex (BandVectors.2 (q 0) (q 1))).re - (GaussianInt.toComplex - (BandVectors.2 (q 0) (q 2))).re) → (((GaussianInt.toComplex (BandVectors.2 (q 0) (q - 3))).im = -(GaussianInt.toComplex (BandVectors.2 (q 0) (q 1))).im - - (GaussianInt.toComplex (BandVectors.2 (q 0) (q 2))).im) → (GaussianRealPoint ((m : - GaussianInt) * BandVectors.2 (q 0) (q 1) + (n : GaussianInt) * BandVectors.2 (q 0) (q - 2)) = -((if e' = true then (1 : ℝ) else -1) • GaussianRealPoint (BandVectors.2 (q' 0) - (q' i'.succ)))))))))))))))))) ) := by + exact + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C₀ : BandCircle), + ∀ (T₀ : ProtoTile), + (BandOrderedGeneralLayoutCertificate q cfg C₀ T₀) → + ∀ (q' : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i' : Fin (3 : ℕ)), + ∀ (e' : Bool), + (q' (0 : Fin (4 : ℕ)) = C₀.1.1) → + (∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra; + (q' i'.succ = q k.succ) → + (let μ : Int := if e' = true then -1 else 1; + let m : Int := + if k = 0 then μ else if k = 2 then -μ else 0; + let n : Int := + if k = 1 then μ else if k = 2 then -μ else 0; + (((GaussianInt.toComplex + (BandVectors.2 (q 0) (q 3))).re = + -(GaussianInt.toComplex + (BandVectors.2 (q 0) (q 1))).re - + (GaussianInt.toComplex + (BandVectors.2 (q 0) (q 2))).re) → + (((GaussianInt.toComplex + (BandVectors.2 (q 0) (q 3))).im = + -(GaussianInt.toComplex + (BandVectors.2 (q 0) (q 1))).im - + (GaussianInt.toComplex + (BandVectors.2 (q 0) (q 2))).im) → + (GaussianRealPoint + ((m : GaussianInt) * + BandVectors.2 (q 0) (q 1) + + (n : GaussianInt) * + BandVectors.2 (q 0) (q 2)) = + -((if e' = true then (1 : ℝ) else -1) • + GaussianRealPoint + (BandVectors.2 (q' 0) (q' i'.succ))))))))) := by classical - intro q cfg C₀ T₀ cert N T pN p0 q' i' e' hq'0 hcentAdj hslopeAdj1 hslopeAdj2 i'' s R r j ra k - hAdjChild μ m n hgeom hNcent shift Pshift hbandShift hPshiftCent hlayoutCent hlayoutCells - hcellsT hfootT hsumARe hsumAIm + intro q cfg C₀ T₀ cert q' i' e' hq'0 ra k hAdjChild μ m n hsumARe hsumAIm rw [hq'0, cert.child_eq, hAdjChild] have hkvals : k.val = 0 ∨ k.val = 1 ∨ k.val = 2 := by omega rcases hkvals with hk | hk | hk @@ -667,42 +712,30 @@ private theorem hSlopePeriod : private theorem hAdjSlope : (by classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T₀), ∀ (N : ProtoTile), ∀ (T : ProtoTile), ∀ (pN : ℝ × ℝ), ∀ (p0 : ℝ × ℝ), ∀ (q' : - Fin (4 : ℕ) → CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), (q' (0 : Fin - (4 : ℕ)) = C₀.1.1) → ((TileCentroid T₀ - TileCentroid N = (if e' = true then (1 : ℝ) - else (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' - i'.succ))) → ((p0.1 - pN.1 = (if e' = true then (1 : ℝ) else (-1 : ℝ)) * - (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) (q' i'.succ)).re : ℝ)) → ((p0.2 - pN.2 = (if - e' = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) (q' - i'.succ)).im : ℝ)) → (∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (R : Fin (3 : ℕ) → Bool - → ProtoTile), ∀ (r : Fin (3 : ℕ)), - let j : Fin 3 := i'' + r - ∀ (ra : Fin (3 : ℕ)), - let k : Fin 3 := i' + ra - let μ : Int := if e' = true then -1 else 1 - let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 - let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 - (GaussianRealPoint ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v) = -((if e' = - true then (1 : ℝ) else -1) • GaussianRealPoint (BandVectors.1 (q' 0) (q' i'.succ)))) - → ((TileCentroid N - TileCentroid T₀ = GaussianRealPoint ((m : GaussianInt) * cert.u - + (n : GaussianInt) * cert.v)) → ( - let shift : GaussianInt := (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v - let Pshift : ProtoTile := TileTranslation (cert.P j s) shift - (BandPrototile (q j.succ) Pshift) → ((TileCentroid Pshift = TileCentroid (cert.P j s) + - GaussianRealPoint shift) → ((TileCentroid (R j s) = TileCentroid Pshift) → (((R j - s).cells = Pshift.cells) → ((T.cells = Pshift.cells) → ((FootprintVertices T = - FootprintVertices Pshift) → ((GaussianRealPoint ((m : GaussianInt) * BandVectors.2 (q - 0) (q 1) + (n : GaussianInt) * BandVectors.2 (q 0) (q 2)) = -((if e' = true then (1 : - ℝ) else -1) • GaussianRealPoint (BandVectors.2 (q' 0) (q' i'.succ)))) → ((pN.1 - - p0.1, pN.2 - p0.2) = -((if e' = true then (1 : ℝ) else -1) • GaussianRealPoint - (BandVectors.2 (q' 0) (q' i'.succ)))))))))))))))) ) := by + exact + ∀ (C₀ : BandCircle), + ∀ (pN : ℝ × ℝ), + ∀ (p0 : ℝ × ℝ), + ∀ (q' : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i' : Fin (3 : ℕ)), + ∀ (e' : Bool), + (q' (0 : Fin (4 : ℕ)) = C₀.1.1) → + ((p0.1 - pN.1 = + (if e' = true then (1 : ℝ) else (-1 : ℝ)) * + (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) + (q' i'.succ)).re : + ℝ)) → + ((p0.2 - pN.2 = + (if e' = true then (1 : ℝ) else (-1 : ℝ)) * + (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) + (q' i'.succ)).im : + ℝ)) → + ((pN.1 - p0.1, pN.2 - p0.2) = + -((if e' = true then (1 : ℝ) else -1) • + GaussianRealPoint + (BandVectors.2 (q' 0) (q' i'.succ))))))) := by classical - intro q cfg C₀ T₀ cert N T pN p0 q' i' e' hq'0 hcentAdj hslopeAdj1 hslopeAdj2 i'' s R r j ra k - μ m n hgeom hNcent shift Pshift hbandShift hPshiftCent hlayoutCent hlayoutCells hcellsT - hfootT hSlopePeriod + intro C₀ pN p0 q' i' e' hq'0 hslopeAdj1 hslopeAdj2 rw [hq'0] apply Prod.ext · change pN.1 - p0.1 = _ @@ -866,63 +899,17 @@ private theorem hshiftNonemptyAt458 : private theorem hmn : (by classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T₀), ∀ (N : ProtoTile), ∀ (T : ProtoTile), ∀ (pN : ℝ × ℝ), ∀ (p0 : ℝ × ℝ), ∀ (q' : - Fin (4 : ℕ) → CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (e' : Bool), (TileCentroid - T₀ - TileCentroid N = (if e' = true then (1 : ℝ) else (-1 : ℝ)) • GaussianRealPoint - (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' i'.succ))) → ((p0.1 - pN.1 = (if e' = true - then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) (q' - i'.succ)).re : ℝ)) → ((p0.2 - pN.2 = (if e' = true then (1 : ℝ) else (-1 : ℝ)) * - (↑(BandVectors.2 (q' (0 : Fin (4 : ℕ))) (q' i'.succ)).im : ℝ)) → (∀ (i'' : Fin (3 : - ℕ)), ∀ (s : Bool), ∀ (R : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (r : Fin (3 : ℕ)), - let j : Fin 3 := i'' + r - ∀ (ra : Fin (3 : ℕ)), - let k : Fin 3 := i' + ra - let μ : Int := if e' = true then -1 else 1 - let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 - let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 - (GaussianRealPoint ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v) = -((if e' = - true then (1 : ℝ) else -1) • GaussianRealPoint (BandVectors.1 (q' 0) (q' i'.succ)))) - → ((TileCentroid N - TileCentroid T₀ = GaussianRealPoint ((m : GaussianInt) * cert.u - + (n : GaussianInt) * cert.v)) → ( - let shift : GaussianInt := (m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v - let Pshift : ProtoTile := TileTranslation (cert.P j s) shift - (BandPrototile (q j.succ) Pshift) → ((TileCentroid Pshift = TileCentroid (cert.P j s) + - GaussianRealPoint shift) → ((TileCentroid (R j s) = TileCentroid Pshift) → (((R j - s).cells = Pshift.cells) → ((T.cells = Pshift.cells) → ((FootprintVertices T = - FootprintVertices Pshift) → ((GaussianRealPoint ((m : GaussianInt) * BandVectors.2 (q - 0) (q 1) + (n : GaussianInt) * BandVectors.2 (q 0) (q 2)) = -((if e' = true then (1 : - ℝ) else -1) • GaussianRealPoint (BandVectors.2 (q' 0) (q' i'.succ)))) → (((pN.1 - - p0.1, pN.2 - p0.2) = -((if e' = true then (1 : ℝ) else -1) • GaussianRealPoint - (BandVectors.2 (q' 0) (q' i'.succ)))) → ((GaussianRealPoint ((m : GaussianInt) * - BandVectors.2 (q 0) (q 1) + (n : GaussianInt) * BandVectors.2 (q 0) (q 2)) = (pN.1 - - p0.1, pN.2 - p0.2)) → (∀ (ps : ℝ × ℝ), (ps - p0 = (if s = true then (1 : ℝ) else -1) - • P4250T1SlopeOffset (BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))) + - GaussianRealPoint ((m : GaussianInt) * BandVectors.2 (q 0) (q 1) + (n : GaussianInt) - * BandVectors.2 (q 0) (q 2))) → ( - let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with - | .A => (0, true) - | .B => (0, false) - | .C => (1, true) - | .D => (1, false) - | .E => (2, true) - | .F => (2, false) - (∀ (kk : Fin 3), ∀ (t : Bool), ∃ l : SixSubtileLabel, slot l = (kk, t) ∧ - SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨l, m, n⟩ = TileTranslation - (cert.P kk t) shift) → (∀ (l : SixSubtileLabel), (SubtileOccurrenceInterpretation - cert.P cert.u cert.v (⟨l, m, n⟩ : PeriodicSubtileIndex) = TileTranslation (cert.P j - s) shift) → ( - let a : PeriodicSubtileIndex := ⟨l, m, n⟩ - (SubtileOccurrenceInterpretation cert.P cert.u cert.v a = Pshift) → - ((Pshift.cells.Nonempty) → ((TileCentroid T = TileCentroid Pshift) → (m ≠ 0 ∨ n ≠ - 0)))))))))))))))))))) ) := by + exact + ∀ (i' : Fin (3 : ℕ)), + ∀ (e' : Bool), + (∀ (ra : Fin (3 : ℕ)), + let k : Fin 3 := i' + ra; + let μ : Int := if e' = true then -1 else 1; + let m : Int := if k = 0 then μ else if k = 2 then -μ else 0; + let n : Int := if k = 1 then μ else if k = 2 then -μ else 0; + (m ≠ 0 ∨ n ≠ 0))) := by classical - intro q cfg C₀ T₀ cert N T pN p0 q' i' e' hcentAdj hslopeAdj1 hslopeAdj2 i'' s R r j ra k μ m n - hgeom hNcent shift Pshift hbandShift hPshiftCent hlayoutCent hlayoutCells hcellsT hfootT - hSlopePeriod hAdjSlope hSlopeShift ps hslopeFinal slot labelExists l hocc a hoccTile - hshiftNonempty hcentroidT + intro i' e' ra k μ m n have hkvals : k.val = 0 ∨ k.val = 1 ∨ k.val = 2 := by omega rcases hkvals with hk | hk | hk · have hh : k = 0 := Fin.ext hk @@ -988,8 +975,7 @@ theorem P4261T1RightCoordinates let m : Int := if k = 0 then μ else if k = 2 then -μ else 0 let n : Int := if k = 1 then μ else if k = 2 then -μ else 0 have hforms := P3055T1ParentVectorNormalForms q cfg - have hgeom := RightCoordinateGeometry.hgeom q cfg C₀ T₀ cert N pN p0 q' i' e' hq'0 hcentAdj - hslopeAdj1 hslopeAdj2 ra hAdjChild hforms + have hgeom := RightCoordinateGeometry.hgeom q cfg C₀ T₀ cert q' i' e' hq'0 ra hAdjChild hforms have hNcent := RightCoordinateGeometry.hNcent q cfg C₀ T₀ cert N q' i' e' hq'0 hcentAdj ra hgeom have hlayoutOcc := cert.outer_occurrence j s have hbandLayout : BandPrototile (q j.succ) (cert.P j s) := hlayoutOcc.1 @@ -1031,12 +1017,9 @@ theorem P4261T1RightCoordinates Zsqrtd.im_sub, Zsqrtd.im_neg, Prod.mk.injEq] at hsumAPoint have hsumARe := RightCoordinateGeometry.hsumARe q hsumAPoint have hsumAIm := RightCoordinateGeometry.hsumAIm q hsumAPoint - have hSlopePeriod := RightCoordinateGeometry.hSlopePeriod q cfg C₀ T₀ cert N T pN p0 q' i' e' - hq'0 hcentAdj hslopeAdj1 hslopeAdj2 i'' s R r ra hAdjChild hgeom hNcent hbandShift - hPshiftCent hlayoutCent hlayoutCells hcellsT hfootT hsumARe hsumAIm - have hAdjSlope := RightCoordinateGeometry.hAdjSlope q cfg C₀ T₀ cert N T pN p0 q' i' e' hq'0 - hcentAdj hslopeAdj1 hslopeAdj2 i'' s R r ra hgeom hNcent hbandShift hPshiftCent hlayoutCent - hlayoutCells hcellsT hfootT hSlopePeriod + have hSlopePeriod := RightCoordinateGeometry.hSlopePeriod q cfg C₀ T₀ cert q' i' e' + hq'0 ra hAdjChild hsumARe hsumAIm + have hAdjSlope := RightCoordinateGeometry.hAdjSlope C₀ pN p0 q' i' e' hq'0 hslopeAdj1 hslopeAdj2 have hSlopeShift := RightCoordinateGeometry.hSlopeShift q pN p0 q' i' e' ra hSlopePeriod hAdjSlope rcases hrootSlope j s with hzero | ⟨p, ps, hp, hps, hpx, hpy⟩ · have hpos := cfg.noLine j.succ @@ -1072,10 +1055,7 @@ theorem P4261T1RightCoordinates cfg C₀ T₀ cert i' e' i'' s r ra hparentNonempty have hcentroidT : TileCentroid T = TileCentroid Pshift := by simp [TileCentroid, hshiftNonempty, hcellsT] - have hmn : m ≠ 0 ∨ n ≠ 0 := RightCoordinateGeometry.hmn q cfg C₀ T₀ cert N T pN p0 q' i' e' - hcentAdj hslopeAdj1 hslopeAdj2 i'' s R r ra hgeom hNcent hbandShift hPshiftCent hlayoutCent - hlayoutCells hcellsT hfootT hSlopePeriod hAdjSlope hSlopeShift ps hslopeFinal labelExists l - hocc hoccTile hshiftNonempty hcentroidT + have hmn : m ≠ 0 ∨ n ≠ 0 := RightCoordinateGeometry.hmn i' e' ra refine ⟨a, ?_, ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩⟩ · simp only [a] rcases hmn with hm | hn diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean index 4bae6b4a9f..d0deb210db 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean @@ -395,46 +395,47 @@ private theorem hparentNonempty : private theorem hbandOcc : (by classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T₀), ∀ (T : ProtoTile), ∀ (i' : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (r : Fin (3 : - ℕ)), - let j : Fin 3 := i' + r - let incoming : Fin 3 → GaussianInt := fun k => - BandVectors.1 (q k.succ) (q 0) - let outgoing : Fin 3 → GaussianInt := fun k => - BandVectors.1 (q 0) (q k.succ) - let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => - if k = 0 then - if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ - else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ - else if k = 1 then - if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ - else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ - else - if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ - else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ - let a : PeriodicSubtileIndex := makeIndex j s - let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with - | .A => (0, true) - | .B => (0, false) - | .C => (1, true) - | .D => (1, false) - | .E => (2, true) - | .F => (2, false) - (a ∈ P4261T1ExteriorIndices ∧ (slot a.label).1 = j ∧ (slot a.label).2 = if a.label = - SixSubtileLabel.A ∨ a.label = SixSubtileLabel.C ∨ a.label = SixSubtileLabel.E then - true else false) → ((a ∈ P4261T1ExteriorIndices) → (((slot a.label).1 = j ∧ (slot - a.label).2 = (if a.label = .A ∨ a.label = .C ∨ a.label = .E then true else false)) → - ((TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) - - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * - (incoming j + outgoing j))) → ((TileCentroid T = TileCentroid - (SubtileOccurrenceInterpretation cert.P cert.u cert.v a)) → (BandPrototile (q (slot - a.label).1.succ) (SubtileOccurrenceInterpretation cert.P cert.u cert.v a)))))) ) := by + exact + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C₀ : BandCircle), + ∀ (T₀ : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T₀), + ∀ (i' : Fin (3 : ℕ)), + ∀ (s : Fin (4 : ℕ)), + ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r; + let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := + fun k t => + if k = 0 then + if t = 0 then ⟨.A, 0, -1⟩ + else + if t = 1 then ⟨.B, 1, 1⟩ + else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ + else + if k = 1 then + if t = 0 then ⟨.C, 1, 1⟩ + else + if t = 1 then ⟨.D, -1, 0⟩ + else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ + else + if t = 0 then ⟨.E, -1, 0⟩ + else + if t = 1 then ⟨.F, 0, -1⟩ + else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩; + let a : PeriodicSubtileIndex := makeIndex j s; + let slot : SixSubtileLabel → Fin 3 × Bool := fun l => + match l with + | .A => (0, true) + | .B => (0, false) + | .C => (1, true) + | .D => (1, false) + | .E => (2, true) + | .F => (2, false); + (BandPrototile (q (slot a.label).1.succ) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a))) := by classical - intro q cfg C₀ T₀ cert T i' s r j incoming outgoing makeIndex a slot htable ha hslot - hrowCentroid hsuppliedCentroid + intro q cfg C₀ T₀ cert i' s r j makeIndex a slot rcases a with ⟨lab, m, n⟩ cases lab <;> simp only [SubtileOccurrenceInterpretation, slot] <;> exact BandPrototileTranslation _ _ _ (cert.outer_occurrence _ _).1 @@ -495,49 +496,40 @@ private theorem hcells : private theorem hoccNonempty : (by classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T₀), ∀ (T : ProtoTile), ∀ (i' : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (r : Fin (3 : - ℕ)), - let j : Fin 3 := i' + r - let incoming : Fin 3 → GaussianInt := fun k => - BandVectors.1 (q k.succ) (q 0) - let outgoing : Fin 3 → GaussianInt := fun k => - BandVectors.1 (q 0) (q k.succ) - let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => - if k = 0 then - if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ - else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ - else if k = 1 then - if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ - else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ - else - if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ - else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ - let a : PeriodicSubtileIndex := makeIndex j s - let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with - | .A => (0, true) - | .B => (0, false) - | .C => (1, true) - | .D => (1, false) - | .E => (2, true) - | .F => (2, false) - (a ∈ P4261T1ExteriorIndices ∧ (slot a.label).1 = j ∧ (slot a.label).2 = if a.label = - SixSubtileLabel.A ∨ a.label = SixSubtileLabel.C ∨ a.label = SixSubtileLabel.E then - true else false) → ((a ∈ P4261T1ExteriorIndices) → (((slot a.label).1 = j ∧ (slot - a.label).2 = (if a.label = .A ∨ a.label = .C ∨ a.label = .E then true else false)) → - ((TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) - - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * - (incoming j + outgoing j))) → ((TileCentroid T = TileCentroid - (SubtileOccurrenceInterpretation cert.P cert.u cert.v a)) → ((∀ k, ∀ e, (cert.P k - e).cells.Nonempty) → ((BandPrototile (q (slot a.label).1.succ) - (SubtileOccurrenceInterpretation cert.P cert.u cert.v a)) → ((T.cells = - (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells) → - ((SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells.Nonempty)))))))) ) := by + exact + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C₀ : BandCircle), + ∀ (T₀ : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T₀), + ∀ (i' : Fin (3 : ℕ)), + ∀ (s : Fin (4 : ℕ)), + ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r; + let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := + fun k t => + if k = 0 then + if t = 0 then ⟨.A, 0, -1⟩ + else + if t = 1 then ⟨.B, 1, 1⟩ + else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ + else + if k = 1 then + if t = 0 then ⟨.C, 1, 1⟩ + else + if t = 1 then ⟨.D, -1, 0⟩ + else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ + else + if t = 0 then ⟨.E, -1, 0⟩ + else + if t = 1 then ⟨.F, 0, -1⟩ + else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩; + let a : PeriodicSubtileIndex := makeIndex j s; + ((∀ k, ∀ e, (cert.P k e).cells.Nonempty) → + ((SubtileOccurrenceInterpretation cert.P cert.u cert.v + a).cells.Nonempty))) := by classical - intro q cfg C₀ T₀ cert T i' s r j incoming outgoing makeIndex a slot htable ha hslot - hrowCentroid hsuppliedCentroid hparentNonempty hbandOcc hcells + intro q cfg C₀ T₀ cert i' s r j makeIndex a hparentNonempty rcases a with ⟨lab, m, n⟩ cases lab <;> rcases hparentNonempty _ _ with ⟨x, hx⟩ <;> @@ -1237,16 +1229,14 @@ theorem P4261T1SubtileCoordinates have hsuppliedCentroid := SubtileCoordinateGeometry.hsuppliedCentroid q cfg C₀ T₀ cert T q' i' s hq₀ hcent r hparent hrowCentroid have hparentNonempty := SubtileCoordinateGeometry.hparentNonempty q cfg C₀ T₀ cert - have hbandOcc := SubtileCoordinateGeometry.hbandOcc q cfg C₀ T₀ cert T i' s r htable ha hslot - hrowCentroid hsuppliedCentroid + have hbandOcc := SubtileCoordinateGeometry.hbandOcc q cfg C₀ T₀ cert i' s r have hbandT := SubtileCoordinateGeometry.hbandT q C T h hchild q' i' hqi r hparent have hcells : T.cells = (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells := SubtileCoordinateGeometry.hcells q cfg C₀ T₀ cert T i' s r hslot hsuppliedCentroid hbandOcc hbandT have hoccNonempty : (SubtileOccurrenceInterpretation cert.P cert.u cert.v a).cells.Nonempty := - SubtileCoordinateGeometry.hoccNonempty q cfg C₀ T₀ cert T i' s r htable ha hslot - hrowCentroid hsuppliedCentroid hparentNonempty hbandOcc hcells + SubtileCoordinateGeometry.hoccNonempty q cfg C₀ T₀ cert i' s r hparentNonempty have hTNonempty : T.cells.Nonempty := by rw [hcells]; exact hoccNonempty have hfoot := SubtileCoordinateGeometry.hfoot q cfg C₀ T₀ cert T i' s r hcells hoccNonempty hTNonempty diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean index 09368bf524..f91e8a7102 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean @@ -11,7 +11,6 @@ public import LeanPool.ApollonianSuperharmonic.AncestorOdometer public import LeanPool.ApollonianSuperharmonic.P5635T1EndpointDiagonalOwnership public import LeanPool.ApollonianSuperharmonic.AffineTriangularNoFourfoldCellOwners public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex -public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple public import LeanPool.ApollonianSuperharmonic.P4158T1AncestorCells public import LeanPool.ApollonianSuperharmonic.TileString public import LeanPool.ApollonianSuperharmonic.P4431T1OwnerTransitionSelector @@ -62,17 +61,6 @@ private theorem htiles_lattice : exact (TileDiskAreaCovariance base (a : GaussianInt)).1.mp (BandTileSimultaneousInduction q hproper base hbase').1 -private theorem neighbor_ne_center : - (by - classical - exact - let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := - ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] - ∀ (x : GaussianInt), ∀ (j : Fin 4), neighbor x j ≠ x ) := by - classical - intro neighbor x j - fin_cases j <;> simp [neighbor, Zsqrtd.ext_iff] - private theorem neighbor_injective : (by classical @@ -87,64 +75,7 @@ private theorem neighbor_injective : fin_cases j <;> fin_cases k <;> simp [neighbor, Zsqrtd.ext_iff] at h ⊢ <;> omega -private theorem edgeAt_mem : - (by - classical - exact - let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := - ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] - let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := - ![{x, x + ⟨0, 1⟩}, {x - 1, x}, - {x - ⟨0, 1⟩, x}, {x, x + 1}] - ∀ (x : GaussianInt), ∀ (j : Fin 4), x ∈ edgeAt x j ∧ neighbor x j ∈ edgeAt x j ) := by - classical - intro neighbor edgeAt x j - fin_cases j <;> simp [neighbor, edgeAt] -private theorem edgeAt_eq_pair : - (by - classical - exact - let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := - ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] - let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := - ![{x, x + ⟨0, 1⟩}, {x - 1, x}, - {x - ⟨0, 1⟩, x}, {x, x + 1}] - ∀ (x : GaussianInt), ∀ (j : Fin 4), edgeAt x j = {x, neighbor x j} ) := by - classical - intro neighbor edgeAt x j - fin_cases j <;> simp [edgeAt, neighbor, Finset.pair_comm] - -private theorem edgeAt_injective : - (by - classical - exact - let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := - ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] - let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := - ![{x, x + ⟨0, 1⟩}, {x - 1, x}, - {x - ⟨0, 1⟩, x}, {x, x + 1}] - (∀ (x : GaussianInt), ∀ (j : Fin 4), neighbor x j ≠ x) → ((∀ (x : GaussianInt), ∀ - {j : Fin 4}, ∀ {k : Fin 4}, (neighbor x j = neighbor x k) → (j = k)) → ((∀ (x : - GaussianInt), ∀ (j : Fin 4), x ∈ edgeAt x j ∧ neighbor x j ∈ edgeAt x j) → (∀ (x : - GaussianInt), ∀ {j : Fin 4}, ∀ {k : Fin 4}, (edgeAt x j = edgeAt x k) → (j = k)))) ) - := by - classical - intro neighbor edgeAt neighbor_ne_center neighbor_injective edgeAt_mem x j k h - have hx := (edgeAt_mem x j).1 - have hn := (edgeAt_mem x j).2 - have hnm : neighbor x j ∈ edgeAt x k := by rw [← h]; exact hn - have hchoices : neighbor x j = x ∨ neighbor x j = neighbor x k := by - fin_cases k - · simpa [edgeAt, neighbor] using hnm - · have hh : neighbor x j = x - 1 ∨ neighbor x j = x := by - simpa [edgeAt, neighbor] using hnm - exact Or.symm hh - · have hh : neighbor x j = x - ⟨0, 1⟩ ∨ neighbor x j = x := by - simpa [edgeAt, neighbor] using hnm - exact Or.symm hh - · simpa [edgeAt, neighbor] using hnm - exact neighbor_injective x (hchoices.resolve_left (neighbor_ne_center x j)) private theorem edge_of_sector_cell : (by @@ -204,35 +135,7 @@ private theorem edge_of_sector_cell : simpa [LatticeVertexIncidentCell] using h, Or.inl rfl⟩) -private theorem label_T0 : - (by - classical - exact - ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), - let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => - if LatticeVertexIncidentCell x j ∈ T0.cells then 0 - else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 - ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → - (outerLabel x j = 0) ) := by - classical - intro T0 T0' outerLabel x j hc - simp [outerLabel, hc] -private theorem label_T0' : - (by - classical - exact - ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), (Disjoint T0.cells T0'.cells) → ( - let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => - if LatticeVertexIncidentCell x j ∈ T0.cells then 0 - else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 - ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0'.cells) → - (outerLabel x j = 1)) ) := by - classical - intro T0 T0' hdis outerLabel x j hc - have hn : LatticeVertexIncidentCell x j ∉ T0.cells := - Finset.disjoint_left.mp hdis.symm hc - simp [outerLabel, hn, hc] private theorem forward_index : (by @@ -1896,18 +1799,18 @@ theorem P4366T2LocalSectors let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := ![{x, x + ⟨0, 1⟩}, {x - 1, x}, {x - ⟨0, 1⟩, x}, {x, x + 1}] - have edgeAt_mem := LocalSectorGeometry.edgeAt_mem - have edgeAt_eq_pair := LocalSectorGeometry.edgeAt_eq_pair + have edgeAt_mem := LatticeVertexSectorFacts.edgeMembership + have edgeAt_eq_pair := LatticeVertexSectorFacts.edgePair have edgeAt_injective (x : GaussianInt) {j k : Fin 4} - (h : edgeAt x j = edgeAt x k) := LocalSectorGeometry.edgeAt_injective - (LocalSectorGeometry.neighbor_ne_center) (LocalSectorGeometry.neighbor_injective Ci + (h : edgeAt x j = edgeAt x k) := LatticeVertexSectorFacts.edgeInjective + (LatticeVertexSectorFacts.neighborDistinct) (LocalSectorGeometry.neighbor_injective Ci path P) edgeAt_mem x (j := j) (k := k) h have edge_of_sector_cell := LocalSectorGeometry.edge_of_sector_cell let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => if LatticeVertexIncidentCell x j ∈ T0.cells then 0 else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 - have label_T0 := LocalSectorGeometry.label_T0 T0 T0' - have label_T0' := LocalSectorGeometry.label_T0' T0 T0' hdis + have label_T0 := LatticeVertexSectorFacts.firstTileLabel T0 T0' + have label_T0' := LatticeVertexSectorFacts.secondTileLabel T0 T0' hdis rcases hr with ⟨hbaseR, hheadR, hlastR, hpairR, hfamilyR, hchainR, hheightR⟩ have forward_index := LocalSectorGeometry.forward_index Ci base tiles hs hfamily P regular_index have reverse_index := LocalSectorGeometry.reverse_index Ci base reverseTiles reverseHs P diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean b/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean index a2cf94ecf1..84e9f141fa 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean @@ -288,43 +288,59 @@ private theorem hG₁root : private theorem hVold : (by classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - (P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v - a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) - (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices - q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)) → (∀ (x : GaussianInt), ∀ - (j : Fin 4), ∀ (edge : Finset GaussianInt), (edge ∈ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → - ((LatticeVertexIncidentCell x j ∈ (SubtileOccurrenceInterpretation cert.P cert.u - cert.v a).cells) → ((LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( - let shift : GaussianInt := match P3996T1SRowTable q cfg C T cert row with - | some z => z.oldShift - | none => match a.label with - | .A => if a.first = -1 then -cert.u else cert.u - | .B => if a.first = 1 then cert.u else -cert.u - | .C => -cert.v - | .D => cert.v - | .E | .F => 0 - let oldCoord : Int × Int := routedOldCoordinates row - (shift = (oldCoord.1 : GaussianInt) * cert.u + (oldCoord.2 : GaussianInt) * cert.v) → - (((a.first, a.second) ≠ oldCoord) → ((∀ (m : Int), ∀ (n : Int), ∀ (r : Int), ∀ (s : - Int), ((m, n) ≠ (r, s)) → (Disjoint (TileTranslation T ((m : GaussianInt) * cert.u + - (n : GaussianInt) * cert.v)).cells (TileTranslation T ((r : GaussianInt) * cert.u + - (s : GaussianInt) * cert.v)).cells)) → ( - let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v a - (∀ c : LatticeCell, c ∈ V.cells → c ∈ (TileTranslation T ((a.first : GaussianInt) * - cert.u + (a.second : GaussianInt) * cert.v)).cells) → (Disjoint V.cells - (TileTranslation T shift).cells)))))))) ) := by + exact + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (a : PeriodicSubtileIndex), + ∀ (b : PeriodicSubtileIndex), + ∀ + (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + (let shift : GaussianInt := + match P3996T1SRowTable q cfg C T cert row with + | some z => z.oldShift + | none => + match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => -cert.v + | .D => cert.v + | .E | .F => 0; + let oldCoord : Int × Int := routedOldCoordinates row; + (shift = + (oldCoord.1 : GaussianInt) * cert.u + + (oldCoord.2 : GaussianInt) * cert.v) → + (((a.first, a.second) ≠ oldCoord) → + ((∀ (m : Int), + ∀ (n : Int), + ∀ (r : Int), + ∀ (s : Int), + ((m, n) ≠ (r, s)) → + (Disjoint + (TileTranslation T + ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v)).cells + (TileTranslation T + ((r : GaussianInt) * cert.u + + (s : GaussianInt) * + cert.v)).cells)) → + (let V := + SubtileOccurrenceInterpretation cert.P cert.u cert.v + a; + (∀ c : LatticeCell, + c ∈ V.cells → + c ∈ + (TileTranslation T + ((a.first : GaussianInt) * cert.u + + (a.second : GaussianInt) * + cert.v)).cells) → + (Disjoint V.cells + (TileTranslation T shift).cells)))))) := by classical - intro q cfg C T cert a b row data x j edge hedge ha hb shift oldCoord hshift a_coord_ne - root_disjoint V hVroot + intro q cfg C T cert a b row shift oldCoord hshift a_coord_ne root_disjoint V hVroot rw [Finset.disjoint_left] intro c hcV hcOld have hV := hVroot c hcV @@ -337,43 +353,59 @@ private theorem hVold : private theorem hWold : (by classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - (P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v - a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) - (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices - q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)) → (∀ (x : GaussianInt), ∀ - (j : Fin 4), ∀ (edge : Finset GaussianInt), (edge ∈ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → - ((LatticeVertexIncidentCell x j ∈ (SubtileOccurrenceInterpretation cert.P cert.u - cert.v a).cells) → ((LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( - let shift : GaussianInt := match P3996T1SRowTable q cfg C T cert row with - | some z => z.oldShift - | none => match a.label with - | .A => if a.first = -1 then -cert.u else cert.u - | .B => if a.first = 1 then cert.u else -cert.u - | .C => -cert.v - | .D => cert.v - | .E | .F => 0 - let oldCoord : Int × Int := routedOldCoordinates row - (shift = (oldCoord.1 : GaussianInt) * cert.u + (oldCoord.2 : GaussianInt) * cert.v) → - (((b.first, b.second) ≠ oldCoord) → ((∀ (m : Int), ∀ (n : Int), ∀ (r : Int), ∀ (s : - Int), ((m, n) ≠ (r, s)) → (Disjoint (TileTranslation T ((m : GaussianInt) * cert.u + - (n : GaussianInt) * cert.v)).cells (TileTranslation T ((r : GaussianInt) * cert.u + - (s : GaussianInt) * cert.v)).cells)) → ( - let W := SubtileOccurrenceInterpretation cert.P cert.u cert.v b - (∀ c : LatticeCell, c ∈ W.cells → c ∈ (TileTranslation T ((b.first : GaussianInt) * - cert.u + (b.second : GaussianInt) * cert.v)).cells) → (Disjoint W.cells - (TileTranslation T shift).cells)))))))) ) := by + exact + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (a : PeriodicSubtileIndex), + ∀ (b : PeriodicSubtileIndex), + ∀ + (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + (let shift : GaussianInt := + match P3996T1SRowTable q cfg C T cert row with + | some z => z.oldShift + | none => + match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => -cert.v + | .D => cert.v + | .E | .F => 0; + let oldCoord : Int × Int := routedOldCoordinates row; + (shift = + (oldCoord.1 : GaussianInt) * cert.u + + (oldCoord.2 : GaussianInt) * cert.v) → + (((b.first, b.second) ≠ oldCoord) → + ((∀ (m : Int), + ∀ (n : Int), + ∀ (r : Int), + ∀ (s : Int), + ((m, n) ≠ (r, s)) → + (Disjoint + (TileTranslation T + ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v)).cells + (TileTranslation T + ((r : GaussianInt) * cert.u + + (s : GaussianInt) * + cert.v)).cells)) → + (let W := + SubtileOccurrenceInterpretation cert.P cert.u cert.v + b; + (∀ c : LatticeCell, + c ∈ W.cells → + c ∈ + (TileTranslation T + ((b.first : GaussianInt) * cert.u + + (b.second : GaussianInt) * + cert.v)).cells) → + (Disjoint W.cells + (TileTranslation T shift).cells)))))) := by classical - intro q cfg C T cert a b row data x j edge hedge ha hb shift oldCoord hshift b_coord_ne - root_disjoint W hWroot + intro q cfg C T cert a b row shift oldCoord hshift b_coord_ne root_disjoint W hWroot rw [Finset.disjoint_left] intro c hcW hcOld have hW := hWroot c hcW @@ -808,9 +840,9 @@ theorem P4418T3RoutedBlockCriterion have hWroot := RoutedBlockGeometry.hWroot q cfg C T cert b root_cells have hG₀root := RoutedBlockGeometry.hG₀root q cfg C T cert a b row root_cells have hG₁root := RoutedBlockGeometry.hG₁root q cfg C T cert a b row root_cells - have hVold := RoutedBlockGeometry.hVold q cfg C T cert a b row data x j edge hedge ha hb hshift + have hVold := RoutedBlockGeometry.hVold q cfg C T cert a b row hshift a_coord_ne root_disjoint hVroot - have hWold := RoutedBlockGeometry.hWold q cfg C T cert a b row data x j edge hedge ha hb hshift + have hWold := RoutedBlockGeometry.hWold q cfg C T cert a b row hshift b_coord_ne root_disjoint hWroot have hxedge := RoutedBlockGeometry.hxedge q cfg C T cert a b x edge hx hedge have htri := SimpleGridPathPointTrichotomy _ _ data.first data.last x data.path hxedge diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean index b7bd41f1f8..fd81c0c40a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean @@ -794,36 +794,18 @@ private theorem hne : private theorem allowed : (by classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - let P := cert.P - let O := cert.O - let u := cert.u - let v := cert.v - ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b))) → ( - let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row - let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row - let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modifiedFaceEquivalence.symm face0 - let F1 := cert.modifiedFaceEquivalence.symm face1 - (F0 ≠ F1) → (((∃ iA iB iO : Fin 3, cert.modified.plane.faceVertex F0 iA = a ∧ - cert.modified.plane.faceVertex F0 iB = b ∧ cert.modified.plane.faceVertex F0 iO = - owners.1) ∧ (∃ jA jB jO : Fin 3, cert.modified.plane.faceVertex F1 jA = a ∧ - cert.modified.plane.faceVertex F1 jB = b ∧ cert.modified.plane.faceVertex F1 jO = - owners.2)) → ((a ≠ b) → (AllowedSubtileIncidence a b)))) ) := by + exact + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (a : PeriodicSubtileIndex), + ∀ (b : PeriodicSubtileIndex), + (BandOrderedGeneralSelectedContactRow q cfg C T cert a b) → + (AllowedSubtileIncidence a b)) := by classical - intro q cfg C T cert a b row P O u v retargeted owners face0 face1 F0 F1 faceDistinct faceTable - hne + intro q cfg C T cert a b row cases row with | positiveL1 => exact .AB11 (-1) (-1) | positiveL2 => exact .AB01 0 (-1) @@ -1324,68 +1306,45 @@ private theorem latticeOccurrence : private theorem disjointData : (by classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - let P := cert.P - let O := cert.O - let u := cert.u - let v := cert.v - (∀ (x : PeriodicSubtileIndex), ∀ (y : PeriodicSubtileIndex), (x ≠ y) → ((¬ ((x.label = .A - ∧ y.label = .B ∨ x.label = .B ∧ y.label = .A) ∧ x.first = y.first ∧ x.second = - y.second)) → (Disjoint (SubtileOccurrenceInterpretation P u v x).cells - (SubtileOccurrenceInterpretation P u v y).cells))) → (((FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b))) → ( - let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v - let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row - let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row - let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modifiedFaceEquivalence.symm face0 - let F1 := cert.modifiedFaceEquivalence.symm face1 - (F0 ≠ F1) → ((a ≠ b) → ((AllowedSubtileIncidence a b) → (((FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty) → ((∃ x y : - GaussianInt, SimpleGridPathBetween (FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b)) (FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v b)) x y) → ((SimpleGridPathBetween - (FootprintVertices (occurrence a) ∩ FootprintVertices (occurrence b)) (FootprintEdges - (occurrence a) ∩ FootprintEdges (occurrence b)) (cert.modified.rho F0) - (cert.modified.rho F1)) → ((cert.modified.rho F0 ≠ cert.modified.rho F1) → (∀ (iA : - Fin (3 : ℕ)), ∀ (iB : Fin (3 : ℕ)), ∀ (iO : Fin (3 : ℕ)), - (cert.modified.plane.faceVertex F0 iA = a) → ((cert.modified.plane.faceVertex F0 iB = - b) → ((cert.modified.plane.faceVertex F0 iO = owners.1) → (∀ (jA : Fin (3 : ℕ)), ∀ - (jB : Fin (3 : ℕ)), ∀ (jO : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F1 jA = a) - → ((cert.modified.plane.faceVertex F1 jB = b) → ((cert.modified.plane.faceVertex F1 - jO = owners.2) → ((cert.modified.rho F0 ∈ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b)) → ((cert.modified.rho F1 ∈ - FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ - FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)) → - ((cert.modified.rho F0 ∈ FootprintVertices (occurrence owners.1)) → - ((cert.modified.rho F1 ∈ FootprintVertices (occurrence owners.2)) → - ((cert.modified.rho F0 ∈ FootprintVertices (occurrence a) ∩ FootprintVertices - (occurrence b)) → ((cert.modified.rho F1 ∈ FootprintVertices (occurrence a) ∩ - FootprintVertices (occurrence b)) → (Disjoint (occurrence a).cells (occurrence - b).cells ∧ Disjoint (occurrence a).cells (occurrence owners.1).cells ∧ Disjoint - (occurrence b).cells (occurrence owners.1).cells ∧ Disjoint (occurrence a).cells - (occurrence owners.2).cells ∧ Disjoint (occurrence b).cells (occurrence - owners.2).cells))))))))))))))))))))) ) := by + exact + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (a : PeriodicSubtileIndex), + ∀ (b : PeriodicSubtileIndex), + ∀ + (row : + BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let P := cert.P; + let u := cert.u; + let v := cert.v; + (∀ (x : PeriodicSubtileIndex), + ∀ (y : PeriodicSubtileIndex), + (x ≠ y) → + ((¬((x.label = .A ∧ y.label = .B ∨ + x.label = .B ∧ y.label = .A) ∧ + x.first = y.first ∧ x.second = y.second)) → + (Disjoint + (SubtileOccurrenceInterpretation P u v x).cells + (SubtileOccurrenceInterpretation P u v + y).cells))) → + (let occurrence := + SubtileOccurrenceInterpretation cert.P cert.u cert.v; + let owners := + P4418T3EndpointOwnerIndices q cfg C T cert a b row; + (Disjoint (occurrence a).cells (occurrence b).cells ∧ + Disjoint (occurrence a).cells + (occurrence owners.1).cells ∧ + Disjoint (occurrence b).cells + (occurrence owners.1).cells ∧ + Disjoint (occurrence a).cells + (occurrence owners.2).cells ∧ + Disjoint (occurrence b).cells + (occurrence owners.2).cells))) := by classical - intro q cfg C T cert a b row P O u v pairCells retargeted occurrence owners face0 face1 F0 F1 - faceDistinct hne allowed modifiedEdges modifiedPath pathAtOwners endpointsDistinct iA iB iO - ha0 hb0 ho0 jA jB jO ha1 hb1 ho1 commonPair0 commonPair1 ownerPoint0 ownerPoint1 - originalPair0 originalPair1 + intro q cfg C T cert a b row P u v pairCells occurrence owners cases row <;> dsimp [owners, P4418T3EndpointOwnerIndices] at * all_goals exact ⟨pairCells _ _ (by decide) (by decide), @@ -1753,10 +1712,7 @@ private theorem selectedCertificate : Disjoint (occurrence b).cells (occurrence owners.1).cells ∧ Disjoint (occurrence a).cells (occurrence owners.2).cells ∧ Disjoint (occurrence b).cells (occurrence owners.2).cells := - SelectedInterfaceGeometry.disjointData q cfg C T cert a b row pairCells retargeted - faceDistinct hne allowed modifiedEdges modifiedPath pathAtOwners endpointsDistinct iA - iB iO ha0 hb0 ho0 jA jB jO ha1 hb1 ho1 commonPair0 commonPair1 ownerPoint0 ownerPoint1 - originalPair0 originalPair1 + SelectedInterfaceGeometry.disjointData q cfg C T cert a b row pairCells have translateAdd (X : ProtoTile) (x y : GaussianInt) : TileTranslation (TileTranslation X x) y = TileTranslation X (x + y) := SelectedInterfaceGeometry.translateAdd X x y @@ -1948,7 +1904,7 @@ theorem P4418T3SelectedInterfaceExists have hne : a ≠ b := SelectedInterfaceGeometry.hne q cfg C T cert a b row retargeted faceDistinct faceTable have allowed : AllowedSubtileIncidence a b := SelectedInterfaceGeometry.allowed q cfg C T cert - a b row retargeted faceDistinct faceTable hne + a b row have modifiedEdges : (FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty := diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean b/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean index 2d8e79bfbd..daf5208d1b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnGeometry public import LeanPool.ApollonianSuperharmonic.P4456T2CrosscutIndex public import LeanPool.ApollonianSuperharmonic.P4456T2ParentSide @@ -93,63 +94,8 @@ private theorem ht : push_cast constructor <;> linarith -private theorem htau : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (u : GaussianInt), - let w := BandVectors.1 (q 3) (q 2) - let t : GaussianInt := - ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ - let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ - Function.Involutive tau ) := by - classical - intro q u w t tau z - dsimp [tau] - abel -private theorem hHcells : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (u : GaussianInt), - let w := BandVectors.1 (q 3) (q 2) - let t : GaussianInt := - ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ - let H : ProtoTile → ProtoTile := fun U => - TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t - let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ - ∀ U, (H U).cells = U.cells.image tau ) := by - classical - intro q u w t H tau U - simp only [H, TileTranslation, TileQuarterTurn, Finset.image_image] - apply Finset.image_congr - intro z hz - apply Zsqrtd.ext <;> simp [Function.comp_def, GaussianTranslation, - GaussianQuarterTurn, tau] <;> ring - -private theorem hHreal : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (u : GaussianInt), - let w := BandVectors.1 (q 3) (q 2) - let t : GaussianInt := - ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ - ((t.re : Real) = 2 * (TileCentroid T).1 ∧ (t.im : Real) = 2 * (TileCentroid T).2) → ( - let H : ProtoTile → ProtoTile := fun U => - TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t - ∀ U, TileRealization (H U) = (fun p : Real × Real => (2 * (TileCentroid T).1 - p.1, 2 * - (TileCentroid T).2 - p.2)) '' TileRealization U) ) := by - classical - intro q T u w t ht H U - dsimp only [H] - rw [(TileTranslationFormulas _ t).2.2.2.1, - (TileQuarterTurnFormulas (TileQuarterTurn U)).2.2.2.1, - (TileQuarterTurnFormulas U).2.2.2.1, Set.image_image, Set.image_image] - congr 1 - funext p - apply Prod.ext <;> dsimp <;> simp only [ht.1, ht.2] <;> ring + private theorem hcenter : (by @@ -618,9 +564,9 @@ theorem P4456T2OrderedNoChord let H : ProtoTile → ProtoTile := fun U => TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ - have htau := OrderedNoChordGeometry.htau q u - have hHcells := OrderedNoChordGeometry.hHcells q u - have hHreal := OrderedNoChordGeometry.hHreal q T u ht + have htau := TileHalfTurnGeometry.involutive q u + have hHcells := TileHalfTurnGeometry.cells q u + have hHreal := TileHalfTurnGeometry.realization q T u ht have hcenter := OrderedNoChordGeometry.hcenter have hHsigned := OrderedNoChordGeometry.hHsigned q cfg C T layout u htau hHcells hHreal hcenter have touch_flip := OrderedNoChordGeometry.touch_flip q cfg C T layout hne u hHsigned diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean index 17550a337f..7f903cd8c4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean @@ -6,8 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BoundaryFrameJoinGeometry -public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryPlacement @@ -794,20 +794,6 @@ private theorem hjoinCenterEq : have h := hcenter.trans hjoinCenter.symm simpa using congrArg (fun p : ℝ × ℝ => p + TileCentroid Rminus) h -private theorem hUbandC : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), (BandPrototile (F.q F.slot.succ) (D.tiles F.slot - false)) → (BandPrototile C.1.1 (D.tiles F.slot false)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D hUband - rw [← F.parent] - exact hUband - private theorem hjoinFoot : (by classical @@ -1176,7 +1162,8 @@ theorem P4458T1FirstProperRows FirstProperRowDetails.hjoinCenterEq C orientation base Rminus Rplus hminus hplus F D hcenter u hjoinCenter have hjoinCells := BandPrototileCentroidUnique C.1.1 - (D.tiles F.slot false) join (FirstProperRowDetails.hUbandC C orientation base Rminus Rplus + (D.tiles F.slot false) join (BoundaryFrameJoinGeometry.parentPrototile C orientation base + Rminus Rplus hminus hplus F D hUband) hjoinBand hjoinCenterEq have hjoinOdo : TileOdometer C.1.1 join (D.functions F.slot false) := PositiveCurvatureTileOdometerSupportTransport C.1.1 diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean index 634e1b11c2..c7c5c5abad 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean @@ -6,9 +6,9 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BoundaryFrameJoinGeometry public import LeanPool.ApollonianSuperharmonic.BoundaryFrameRowGeometry -public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification public import LeanPool.ApollonianSuperharmonic.BandVectorOrientationDichotomy public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryPlacement @@ -197,83 +197,9 @@ private theorem haflip : simpa [I] using (VectorRecursionLaws r hr.1).2.2.2.2 hr 0 |>.2 -private theorem hUcenter : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let w : GaussianInt := BandVectors.1 (r 3) (r 2) - (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then (1 : - ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 - : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint - (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : - ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : - ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → (TileCentroid (D.tiles - F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • (GaussianRealPoint w - - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D r w hUcent - simpa [r, w] using hUcent -private theorem hMcenter : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r - simpa [r] using F.minus_centroid -private theorem hvsumRe : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let w : GaussianInt := BandVectors.1 (r 3) (r 2) - let x : GaussianInt := BandVectors.1 (r 1) (r 3) - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (w + x + y = 0) → (w.re + x.re + y.re = 0) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r w x y hvsum - have h := congrArg (fun z : GaussianInt => z.re) hvsum - simpa [w, x, y] using h -private theorem hvsumIm : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let w : GaussianInt := BandVectors.1 (r 3) (r 2) - let x : GaussianInt := BandVectors.1 (r 1) (r 3) - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (w + x + y = 0) → (w.im + x.im + y.im = 0) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r w x y hvsum - have h := congrArg (fun z : GaussianInt => z.im) hvsum - simpa [w, x, y] using h private theorem hcenterVector : (by @@ -317,21 +243,6 @@ private theorem hyLattice : have h := (ParentVectorsInTilingLattice r hr 0 C hRparent).1 simpa [y] using h -private theorem translate_add : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), TileTranslation - (TileTranslation T v) z = TileTranslation T (v + z) ) := by - classical - intro T v z - cases T with - | mk cells anchor => - apply congrArg₂ ProtoTile.mk - · ext q - simp [TileTranslation, GaussianTranslation, add_comm, add_left_comm] - · simp [TileTranslation, GaussianTranslation, add_comm, add_left_comm] - private theorem hjoinBand : (by classical @@ -351,85 +262,9 @@ private theorem hjoinBand : simpa [join] using BandPrototileTranslation C.1.1 base (u + y) F.base_band -private theorem hjoinFamily : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (y ∈ TilingLattice C) → (∀ (u : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y) - join ∈ RegularTileFamily base (TilingLattice C)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r y hyLattice u join - refine ⟨(u : GaussianInt) + y, (TilingLattice C).add_mem u.property hyLattice, ?_⟩ - rfl -private theorem hjoinCenter : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - ∀ (u : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y) - (join = TileTranslation Rminus y) → (TileCentroid join = TileCentroid Rminus + - GaussianRealPoint y) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r y u join hjoin_eq - rw [hjoin_eq, (TileTranslationFormulas Rminus y).2.2.2.2.1] - apply Prod.ext <;> simp [GaussianRealPoint] -private theorem hjoinCenterEq : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = GaussianRealPoint y) → (∀ (u - : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y) - (TileCentroid join = TileCentroid Rminus + GaussianRealPoint y) → (TileCentroid (D.tiles - F.slot false) = TileCentroid join)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D r y hcenter u join hjoinCenter - calc - TileCentroid (D.tiles F.slot false) = - (TileCentroid (D.tiles F.slot false) - TileCentroid Rminus) + - TileCentroid Rminus := by ext <;> dsimp <;> ring - _ = GaussianRealPoint y + TileCentroid Rminus := by rw [hcenter] - _ = TileCentroid Rminus + GaussianRealPoint y := by ext <;> dsimp <;> ring - _ = TileCentroid join := hjoinCenter.symm - -private theorem hUbandC : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), (BandPrototile (F.q F.slot.succ) (D.tiles F.slot - false)) → (BandPrototile C.1.1 (D.tiles F.slot false)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D hUband - rw [← F.parent] - exact hUband + private theorem hjoinOdo : (by @@ -457,38 +292,6 @@ private theorem hjoinOdo : (by rw [← F.parent]; exact hCpositive) (by rw [← F.parent]; exact hselectedOdo) hjoinBand hjoinCells.1 -private theorem hjoinAncestor : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), (0 < (F.q F.slot.succ).1) → (((F.q F.slot.succ).1 < - (F.q 0).1) → ((AncestorOdometer (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) - F.tile (D.functions F.slot false) - F.odometer) → ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - ∀ (u : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y) - (BandPrototile C.1.1 join) → (((D.tiles F.slot false).cells = join.cells ∧ ((D.tiles - F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = join.anchor)) → - (AncestorOdometer C.1.1 F.outer.1.1 join F.tile (D.functions F.slot false) - F.odometer))))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D hCpositive hstrict hselectedAnc r y u - join hjoinBand hjoinCells - have hstrictOuter : (F.q F.slot.succ).1 < F.outer.1.1.1 := by - rw [← F.child] - exact hstrict - have hAnc := AncestorOdometerInnerSupportNormalization - (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) join F.tile - (D.functions F.slot false) F.odometer hCpositive hstrictOuter hselectedAnc - (by simpa only [← F.parent] using hjoinBand) hjoinCells.1 - simpa only [← F.parent] using hAnc private theorem positiveCells : (by @@ -546,56 +349,7 @@ private theorem hjoinFootEq : simp only [FootprintVertices, ite_eq_left hJnonempty, ite_eq_left hUnonempty] rw [hjoinCells.1] -private theorem hjoinFoot : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (FootprintVertices (D.tiles F.slot false) ⊆ FootprintVertices F.tile) → (∀ (u : - ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y) - (FootprintVertices join = FootprintVertices (D.tiles F.slot false)) → (FootprintVertices - join ⊆ FootprintVertices F.tile)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D r y hUfoot u join hjoinFootEq - rw [hjoinFootEq] - exact hUfoot -private theorem hjoinOccurrence : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then (1 : - ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 - : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint - (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : - ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : - ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (u : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y) - (BandPrototile C.1.1 join) → ((TileCentroid (D.tiles F.slot false) = TileCentroid join) → - ((FootprintVertices join ⊆ FootprintVertices F.tile) → (BandSubtileOccurrence F.q - F.tile F.slot false join)))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D r y hUcent u join hjoinBand - hjoinCenterEq hjoinFoot - refine ⟨by simpa only [← F.parent] using hjoinBand, hjoinFoot, ?_⟩ - rw [← hjoinCenterEq] - exact hUcent private theorem hplusVector : (by @@ -621,21 +375,6 @@ private theorem hplusVector : norm_num [I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> omega -private theorem hPcenter : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 - (r 1) (r 0) + BandVectors.1 (r 0) (r 1)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r - simpa [r] using F.plus_centroid private theorem hPlusJoin : (by @@ -762,43 +501,7 @@ private theorem hFplusSlope : intro C orientation base Rminus Rplus hminus hplus F r simpa [r, GaussianRealPoint, Prod.smul_mk] using F.plus_difference -private theorem hasumRe : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let wa : GaussianInt := BandVectors.2 (r 3) (r 2) - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - let ya : GaussianInt := BandVectors.2 (r 2) (r 1) - (wa + xa + ya = 0) → (wa.re + xa.re + ya.re = 0) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum - have h := congrArg (fun z : GaussianInt => z.re) hasum - simpa [wa, xa, ya] using h -private theorem hasumIm : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let wa : GaussianInt := BandVectors.2 (r 3) (r 2) - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - let ya : GaussianInt := BandVectors.2 (r 2) (r 1) - (wa + xa + ya = 0) → (wa.im + xa.im + ya.im = 0) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum - have h := congrArg (fun z : GaussianInt => z.im) hasum - simpa [wa, xa, ya] using h private theorem ha10Re : (by @@ -2756,11 +2459,15 @@ theorem P4458T1LargestParentRows have hvflip := LargestParentGeometry.hvflip C orientation base Rminus Rplus hminus hplus F hr have haflip := LargestParentGeometry.haflip C orientation base Rminus Rplus hminus hplus F hr rcases hselectedOcc with ⟨hUband, hUfoot, hUcent⟩ - have hUcenter := LargestParentGeometry.hUcenter C orientation base Rminus Rplus hminus hplus F + have hUcenter := BoundaryFrameJoinGeometry.selectedCentroid C orientation base Rminus Rplus + hminus hplus F D hUcent - have hMcenter := LargestParentGeometry.hMcenter C orientation base Rminus Rplus hminus hplus F - have hvsumRe := LargestParentGeometry.hvsumRe C orientation base Rminus Rplus hminus hplus F hvsum - have hvsumIm := LargestParentGeometry.hvsumIm C orientation base Rminus Rplus hminus hplus F hvsum + have hMcenter := BoundaryFrameJoinGeometry.minusCentroid C orientation base Rminus Rplus + hminus hplus F + have hvsumRe := BoundaryFrameJoinGeometry.firstVectorSumReal C orientation base Rminus Rplus + hminus hplus F hvsum + have hvsumIm := BoundaryFrameJoinGeometry.firstVectorSumImaginary C orientation base Rminus + Rplus hminus hplus F hvsum have hcenterVector := LargestParentGeometry.hcenterVector C orientation base Rminus Rplus hminus hplus F hvrec hvflip hvsumRe hvsumIm have hcenterRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) hcenterVector @@ -2777,24 +2484,26 @@ theorem P4458T1LargestParentRows let join : ProtoTile := TileTranslation base (u + y) have translate_add (T : ProtoTile) (v z : GaussianInt) : TileTranslation (TileTranslation T v) z = TileTranslation T (v + z) := - LargestParentGeometry.translate_add T v z + TileTranslationProperties.add T v z have hjoin_eq : join = TileTranslation Rminus y := by simpa [join, huRminus] using (translate_add base (u : GaussianInt) y).symm have hjoinBand := LargestParentGeometry.hjoinBand C orientation base Rminus Rplus hminus hplus F u - have hjoinFamily := LargestParentGeometry.hjoinFamily C orientation base Rminus Rplus hminus + have hjoinFamily := BoundaryFrameJoinGeometry.joinFamily C orientation base Rminus Rplus hminus hplus F hyLattice u - have hjoinCenter := LargestParentGeometry.hjoinCenter C orientation base Rminus Rplus hminus + have hjoinCenter := BoundaryFrameJoinGeometry.joinCentroid C orientation base Rminus Rplus hminus hplus F u hjoin_eq - have hjoinCenterEq := LargestParentGeometry.hjoinCenterEq C orientation base Rminus Rplus + have hjoinCenterEq := BoundaryFrameJoinGeometry.joinCentroidEquality C orientation base Rminus + Rplus hminus hplus F D hcenter u hjoinCenter - have hUbandC := LargestParentGeometry.hUbandC C orientation base Rminus Rplus hminus hplus F D + have hUbandC := BoundaryFrameJoinGeometry.parentPrototile C orientation base Rminus Rplus + hminus hplus F D hUband have hjoinCells := BandPrototileCentroidUnique C.1.1 (D.tiles F.slot false) join hUbandC hjoinBand hjoinCenterEq have hjoinOdo := LargestParentGeometry.hjoinOdo C orientation base Rminus Rplus hminus hplus F D hCpositive hselectedOdo u hjoinBand hjoinCells - have hjoinAncestor := LargestParentGeometry.hjoinAncestor C orientation base Rminus Rplus + have hjoinAncestor := BoundaryFrameJoinGeometry.joinAncestor C orientation base Rminus Rplus hminus hplus F D hCpositive hstrict hselectedAnc u hjoinBand hjoinCells have positiveCells := LargestParentGeometry.positiveCells C orientation base Rminus Rplus hminus hplus F @@ -2803,13 +2512,15 @@ theorem P4458T1LargestParentRows have hJnonempty : join.cells.Nonempty := by rw [← hjoinCells.1]; exact hUnonempty have hjoinFootEq := LargestParentGeometry.hjoinFootEq C orientation base Rminus Rplus hminus hplus F D u hjoinCells hUnonempty hJnonempty - have hjoinFoot := LargestParentGeometry.hjoinFoot C orientation base Rminus Rplus hminus hplus + have hjoinFoot := BoundaryFrameJoinGeometry.joinFootprint C orientation base Rminus Rplus + hminus hplus F D hUfoot u hjoinFootEq - have hjoinOccurrence := LargestParentGeometry.hjoinOccurrence C orientation base Rminus Rplus + have hjoinOccurrence := BoundaryFrameJoinGeometry.joinOccurrence C orientation base Rminus Rplus hminus hplus F D hUcent u hjoinBand hjoinCenterEq hjoinFoot have hplusVector := LargestParentGeometry.hplusVector C orientation base Rminus Rplus hminus hplus F hvrec hvflip hvsumRe hvsumIm - have hPcenter := LargestParentGeometry.hPcenter C orientation base Rminus Rplus hminus hplus F + have hPcenter := BoundaryFrameJoinGeometry.plusCentroid C orientation base Rminus Rplus hminus + hplus F have hPlusJoin := LargestParentGeometry.hPlusJoin C orientation base Rminus Rplus hminus hplus F D hUcenter u hjoinCenterEq hplusVector hPcenter have hSlopeInfo := LargestParentGeometry.hSlopeInfo C orientation base Rminus Rplus hminus @@ -2824,8 +2535,10 @@ theorem P4458T1LargestParentRows hplus F have hFplusSlope := LargestParentGeometry.hFplusSlope C orientation base Rminus Rplus hminus hplus F - have hasumRe := LargestParentGeometry.hasumRe C orientation base Rminus Rplus hminus hplus F hasum - have hasumIm := LargestParentGeometry.hasumIm C orientation base Rminus Rplus hminus hplus F hasum + have hasumRe := BoundaryFrameJoinGeometry.secondVectorSumReal C orientation base Rminus Rplus + hminus hplus F hasum + have hasumIm := BoundaryFrameJoinGeometry.secondVectorSumImaginary C orientation base Rminus + Rplus hminus hplus F hasum have ha10Re := LargestParentGeometry.ha10Re C orientation base Rminus Rplus hminus hplus F harec have ha10Im := LargestParentGeometry.ha10Im C orientation base Rminus Rplus hminus hplus F harec have ha01Re := LargestParentGeometry.ha01Re C orientation base Rminus Rplus hminus hplus F diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean b/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean index 8eb00090de..95a50538de 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.ListEndpointFacts public import LeanPool.ApollonianSuperharmonic.OdometerStringRespect public import LeanPool.ApollonianSuperharmonic.AncestorOdometer @@ -60,53 +61,6 @@ private theorem zipDropLast : congr 1 exact ih (y' :: ys) ht -private theorem hrightZipShape : - ∀ (C : BandCircle), ∀ (C₀ : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (R : - ProtoTile), ∀ (J : ProtoTile), ∀ (S : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (hJ : - PartialOdometer), ∀ (hS : PartialOdometer), ∀ (h₀ : PartialOdometer), ∀ (left : List - ProtoTile), ∀ (right : List ProtoTile), ∀ (hl : List PartialOdometer), ∀ (hr : List - PartialOdometer), (hr.head? = some hJ) → ((hr.getLast? = some hS) → ((TileString C - orientation base R S (left.dropLast ++ right)) → ((∀ U ∈ (List.drop (1 : ℕ) - right).dropLast, ∃ (g : PartialOdometer), (U, g) ∈ right.zip hr ∧ AncestorOdometer C.1.1 - C₀.1.1 U T₀ g h₀) → ((List.Forall₂ (fun (T : ProtoTile) (h : PartialOdometer) - => TileOdometer C.1.1 T h) right hr) → - ((List.IsChain (fun (X Y : ProtoTile × PartialOdometer) => LeftLatticeAdjacent C X.1 Y.1 - X.2 Y.2) (right.zip hr)) → ((right.length = hr.length) → ((right.head? = some J) → - ((right.getLast? = some S) → ((List.Pairwise (fun (T U : ProtoTile) => T ≠ U) right) → - ((∀ T ∈ right, T ∈ RegularTileFamily base (TilingLattice C)) → ((List.IsChain (fun (T U : - ProtoTile) => if C.1.1.1 = (1 : ℤ) then ∃ (v : - GaussianInt), UnitTriangularStep orientation v ∧ TileCentroid U - TileCentroid T = - GaussianRealPoint v else TileTouching T U) right) → ((∀ (pre : List ProtoTile), ∀ (T : - ProtoTile), ∀ (post : List ProtoTile), right = pre ++ T :: post → pre ≠ [] → post ≠ [] → - (0 : ℝ) ≤ (fun (T : ProtoTile) => ((TileCentroid T).2 - (TileCentroid J).2) * - ((TileCentroid S).1 - (TileCentroid J).1) - ((TileCentroid T).1 - (TileCentroid J).1) * - ((TileCentroid S).2 - (TileCentroid J).2)) T ∧ ∃ U ∈ RegularTileFamily base - (TilingLattice C), (fun (T U : ProtoTile) => if C.1.1.1 = (1 : ℤ) then ∃ (v : - GaussianInt), UnitTriangularStep orientation v - ∧ TileCentroid U - TileCentroid T = GaussianRealPoint v else TileTouching T U) T U ∧ (fun - (T : ProtoTile) => ((TileCentroid T).2 - (TileCentroid J).2) * ((TileCentroid S).1 - - (TileCentroid J).1) - ((TileCentroid T).1 - (TileCentroid J).1) * ((TileCentroid S).2 - - (TileCentroid J).2)) U < (0 : ℝ)) → ((List.Forall₂ (fun T h => TileOdometer C.1.1 T h) - (left.dropLast ++ right) (hl.dropLast ++ hr)) → (((left.dropLast ++ right).zip - (hl.dropLast ++ hr) = (left.zip hl).dropLast ++ right.zip hr) → (right.zip hr = [(J, hJ)] - ++ right.tail.zip hr.tail))))))))))))))) := by - classical - intro C C₀ orientation base R J S T₀ hJ hS h₀ left right hl hr hrhead hrlast hjoined hrightAnc - hrightOdo hrightChain hrightLen hrightTileHead hrightTileLast hrightNodup hrightMem - hrightTileChain hrightHeight hrel hzip - cases right with - | nil => simp at hrightTileHead - | cons t ts => - cases hr with - | nil => simp at hrhead - | cons g gs => - simp only [List.head?_cons] at hrightTileHead hrhead - injection hrightTileHead with ht - injection hrhead with hg - subst t - subst g - rfl - private theorem hUdropLast : ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), ∀ (U : ProtoTile), (U ∈ (List.drop (1 : ℕ) (left.dropLast ++ right)).dropLast) → (U ∈ (left.dropLast ++ right).dropLast) := by @@ -226,54 +180,6 @@ private theorem hleftZipDrop : rw [hleftZipShape] simp -private theorem hJmem : - ∀ (C : BandCircle), ∀ (C₀ : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (R : - ProtoTile), ∀ (J : ProtoTile), ∀ (S : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (hJ : - PartialOdometer), ∀ (h₀ : PartialOdometer), ∀ (left : List ProtoTile), ∀ (right : List - ProtoTile), ∀ (hl : List PartialOdometer), ∀ (hr : List PartialOdometer), (∀ U ∈ - (List.drop (1 : ℕ) right).dropLast, ∃ (g : PartialOdometer), (U, g) ∈ right.zip hr ∧ - AncestorOdometer C.1.1 C₀.1.1 U T₀ g h₀) → ((List.Forall₂ (fun (T : ProtoTile) - (h : PartialOdometer) => TileOdometer C.1.1 T - h) right hr) → ((List.IsChain (fun (X Y : ProtoTile × PartialOdometer) => - LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) (right.zip hr)) → ((right.length = hr.length) → - ((right.head? = some J) → ((right.getLast? = some S) → ((List.Pairwise (fun (T U : - ProtoTile) => T ≠ U) right) → ((∀ T ∈ right, T ∈ RegularTileFamily base (TilingLattice - C)) → ((List.IsChain (fun (T U : ProtoTile) => if C.1.1.1 = (1 : ℤ) then ∃ (v : - GaussianInt), UnitTriangularStep orientation v - ∧ TileCentroid U - TileCentroid T = GaussianRealPoint v else TileTouching T U) right) → - ((∀ (pre : List ProtoTile), ∀ (T : ProtoTile), ∀ (post : List ProtoTile), right = pre ++ - T :: post → pre ≠ [] → post ≠ [] → (0 : ℝ) ≤ (fun (T : ProtoTile) => ((TileCentroid T).2 - - (TileCentroid J).2) * ((TileCentroid S).1 - (TileCentroid J).1) - ((TileCentroid T).1 - - (TileCentroid J).1) * ((TileCentroid S).2 - (TileCentroid J).2)) T ∧ ∃ U ∈ - RegularTileFamily base (TilingLattice C), (fun (T U : ProtoTile) => if C.1.1.1 = (1 : ℤ) - then ∃ (v : GaussianInt), - UnitTriangularStep orientation v ∧ TileCentroid U - TileCentroid T = GaussianRealPoint v - else TileTouching T U) T U ∧ (fun (T : ProtoTile) => ((TileCentroid T).2 - (TileCentroid - J).2) * ((TileCentroid S).1 - (TileCentroid J).1) - ((TileCentroid T).1 - (TileCentroid - J).1) * ((TileCentroid S).2 - (TileCentroid J).2)) U < (0 : ℝ)) → ((List.Forall₂ (fun T h - => TileOdometer C.1.1 T h) (left.dropLast ++ right) (hl.dropLast ++ hr)) → - (((left.dropLast ++ right).zip (hl.dropLast ++ hr) = (left.zip hl).dropLast ++ right.zip - hr) → ((right.zip hr = [(J, hJ)] ++ right.tail.zip hr.tail) → ((List.IsChain (fun X Y => - LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) ([(J, hJ)] ++ right.tail.zip hr.tail)) → - ((((left.zip hl).dropLast ++ right.zip hr).IsChain (fun X Y => LeftLatticeAdjacent C X.1 - Y.1 X.2 Y.2)) → ((TileString C orientation base R S (left.dropLast ++ right)) → - (((left.dropLast ++ right).head? = some R) → (((left.dropLast ++ right).getLast? = some - S) → ((List.Pairwise (fun (T U : ProtoTile) => T ≠ U) (left.dropLast ++ right)) → - ((List.Nodup (left.dropLast ++ right)) → ((List.Disjoint left.dropLast right) → (J ∈ - right))))))))))))))))))))) := by - classical - intro C C₀ orientation base R J S T₀ hJ h₀ left right hl hr hrightAnc hrightOdo hrightChain - hrightLen hrightTileHead hrightTileLast hrightNodup hrightMem hrightTileChain hrightHeight - hrel hzip hrightZipShape hrightChainShape hnewChain hjoinedKeep hcatHead hcatLast - hcatPairwise hcatNodup hdisj - cases right with - | nil => simp at hrightTileHead - | cons t ts => - simp only [List.head?_cons] at hrightTileHead - injection hrightTileHead with ht - subst t - simp - private theorem leftPairDrop : ∀ (J : ProtoTile), ∀ (hJ : PartialOdometer), ∀ (left : List ProtoTile), ∀ (hl : List PartialOdometer), (left.zip hl = left.dropLast.zip hl.dropLast ++ [(J, hJ)]) → (∀ @@ -323,74 +229,6 @@ private theorem hrespect : intro C orientation base R S left right hl hr hrel hzip hnewChain hjoinedKeep exact ⟨hjoinedKeep, hrel, by rw [hzip]; exact hnewChain⟩ -private theorem hhead : - ∀ (C : BandCircle), ∀ (C₀ : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (R : - ProtoTile), ∀ (J : ProtoTile), ∀ (S : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (hR : - PartialOdometer), ∀ (hJ : PartialOdometer), ∀ (h₀ : PartialOdometer), ∀ (left : List - ProtoTile), ∀ (right : List ProtoTile), ∀ (hl : List PartialOdometer), ∀ (hr : List - PartialOdometer), (hl.head? = some hR) → ((hl.getLast? = some hJ) → ((hr.head? = some hJ) - → ((∀ U ∈ (List.drop (1 : ℕ) left).dropLast, ∃ (g : PartialOdometer), (U, g) ∈ left.zip - hl ∧ AncestorOdometer C.1.1 C₀.1.1 U T₀ g h₀) → ((List.Forall₂ (fun (T : ProtoTile) - (h : PartialOdometer) => TileOdometer C.1.1 T - h) left hl) → ((List.IsChain (fun (X Y : ProtoTile × PartialOdometer) => - LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) (left.zip hl)) → ((left.length = hl.length) → - ((List.Forall₂ (fun T h => TileOdometer C.1.1 T h) (left.dropLast ++ right) (hl.dropLast - ++ hr)) → (((left.dropLast ++ right).zip (hl.dropLast ++ hr) = (left.zip hl).dropLast ++ - right.zip hr) → (((left.zip hl).dropLast.IsChain (fun X Y => LeftLatticeAdjacent C X.1 - Y.1 X.2 Y.2)) → ((hl.dropLast ++ [hJ] = hl) → ((left.zip hl = left.dropLast.zip - hl.dropLast ++ [(J, hJ)]) → ((List.IsChain (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 - Y.2) (left.dropLast.zip hl.dropLast ++ [(J, hJ)])) → ((((left.zip hl).dropLast ++ - right.zip hr).IsChain (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2)) → (((left.zip - hl).dropLast = left.dropLast.zip hl.dropLast) → ((∀ {U : ProtoTile}, ∀ - {g : PartialOdometer}, ((U, g) ∈ left.zip hl) → ((U ≠ J) → ((U, g) ∈ left.dropLast.zip - hl.dropLast))) → ((∀ {U : ProtoTile}, ∀ {g : PartialOdometer}, ((U, g) ∈ - left.dropLast.zip hl.dropLast) → ((U, g) ∈ (left.dropLast ++ right).zip (hl.dropLast ++ - hr))) → ((∀ {U : ProtoTile}, ∀ {g : PartialOdometer}, ((U, g) ∈ right.zip hr) → ((U, g) ∈ - (left.dropLast ++ right).zip (hl.dropLast ++ hr))) → ((OdometerStringRespect C - orientation base R S (left.dropLast ++ right) (hl.dropLast ++ hr)) → ((hl.dropLast ++ - hr).head? = some hR))))))))))))))))))) := by - classical - intro C C₀ orientation base R J S T₀ hR hJ h₀ left right hl hr hlhead hllast hrhead hleftAnc - hleftOdo hleftChain hleftLen hrel hzip hleftTailChain hleftFunList hleftZipShape - hleftChainShape hnewChain hleftZipDrop leftPairDrop leftPairTransfer rightPairTransfer - hrespect - cases hl with - | nil => simp at hlhead - | cons x xs => cases xs <;> simp_all - -private theorem hlast : - ∀ (C : BandCircle), ∀ (C₀ : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (R : - ProtoTile), ∀ (J : ProtoTile), ∀ (S : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (hR : - PartialOdometer), ∀ (hJ : PartialOdometer), ∀ (hS : PartialOdometer), ∀ (h₀ : - PartialOdometer), ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), ∀ (hl : List - PartialOdometer), ∀ (hr : List PartialOdometer), (hr.head? = some hJ) → ((hr.getLast? = - some hS) → ((∀ U ∈ (List.drop (1 : ℕ) right).dropLast, ∃ (g : PartialOdometer), (U, g) ∈ - right.zip hr ∧ AncestorOdometer C.1.1 C₀.1.1 U T₀ g h₀) → ((List.Forall₂ (fun (T : - ProtoTile) (h : PartialOdometer) => TileOdometer C.1.1 T h) right hr) → ((List.IsChain - (fun (X Y : ProtoTile × - PartialOdometer) => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) (right.zip hr)) → - ((right.length = hr.length) → ((List.Forall₂ (fun T h => TileOdometer C.1.1 T h) - (left.dropLast ++ right) (hl.dropLast ++ hr)) → (((left.dropLast ++ right).zip - (hl.dropLast ++ hr) = (left.zip hl).dropLast ++ right.zip hr) → ((right.zip hr = [(J, - hJ)] ++ right.tail.zip hr.tail) → ((List.IsChain (fun X Y => LeftLatticeAdjacent C X.1 - Y.1 X.2 Y.2) ([(J, hJ)] ++ right.tail.zip hr.tail)) → ((((left.zip hl).dropLast ++ - right.zip hr).IsChain (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2)) → ((∀ - {U : ProtoTile}, ∀ {g : PartialOdometer}, ((U, g) ∈ left.dropLast.zip hl.dropLast) → ((U, - g) ∈ (left.dropLast ++ right).zip (hl.dropLast ++ hr))) → ((∀ {U : ProtoTile}, ∀ - {g : PartialOdometer}, ((U, g) ∈ right.zip hr) → ((U, g) ∈ (left.dropLast ++ right).zip - (hl.dropLast ++ hr))) → ((OdometerStringRespect C orientation base R S (left.dropLast ++ - right) (hl.dropLast ++ hr)) → (((hl.dropLast ++ hr).head? = some hR) → ((hl.dropLast ++ - hr).getLast? = some hS))))))))))))))) := by - classical - intro C C₀ orientation base R J S T₀ hR hJ hS h₀ left right hl hr hrhead hrlast hrightAnc - hrightOdo hrightChain hrightLen hrel hzip hrightZipShape hrightChainShape hnewChain - leftPairTransfer rightPairTransfer hrespect hhead - have hne : hr ≠ [] := by - intro he; simp [he] at hrlast - cases hr with - | nil => contradiction - | cons x xs => simpa using hrlast - private theorem hcatNe : ∀ (R : ProtoTile), ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), ((left.dropLast ++ right).head? = some R) → (left.dropLast ++ right ≠ []) := by @@ -593,9 +431,7 @@ theorem P4458T1RespectAppend RespectAppendDetails.hleftZipShape C J hJ left hl hleftOdo dropLastForall₂ hleftList hleftFunList have hrightZipShape : right.zip hr = [(J, hJ)] ++ right.tail.zip hr.tail := - RespectAppendProof.hrightZipShape C C₀ orientation base R J S T₀ hJ hS h₀ left right hl hr - hrhead hrlast hjoined hrightAnc hrightOdo hrightChain hrightLen hrightTileHead - hrightTileLast hrightNodup hrightMem hrightTileChain hrightHeight hrel hzip + ListEndpointFacts.zipHeadShape right hr J hJ hrightTileHead hrhead have hleftChainShape : List.IsChain (fun X Y => LeftLatticeAdjacent C X.1 Y.1 X.2 Y.2) (left.dropLast.zip hl.dropLast ++ [(J, hJ)]) := RespectAppendDetails.hleftChainShape C J hJ @@ -614,10 +450,7 @@ theorem P4458T1RespectAppend have hcatNodup : List.Nodup (left.dropLast ++ right) := hcatPairwise have hdisj : List.Disjoint left.dropLast right := List.disjoint_of_nodup_append hcatNodup - have hJmem : J ∈ right := RespectAppendDetails.hJmem C C₀ orientation base R J S T₀ hJ h₀ left - right hl hr hrightAnc hrightOdo hrightChain hrightLen hrightTileHead hrightTileLast - hrightNodup hrightMem hrightTileChain hrightHeight hrel hzip hrightZipShape - hrightChainShape hnewChain hjoinedKeep hcatHead hcatLast hcatPairwise hcatNodup hdisj + have hJmem : J ∈ right := ListEndpointFacts.headMembership right J hrightTileHead have leftPairDrop {U : ProtoTile} {g : PartialOdometer} (hpair : (U, g) ∈ left.zip hl) (hUJ : U ≠ J) : (U, g) ∈ left.dropLast.zip hl.dropLast := RespectAppendDetails.leftPairDrop J hJ left hl @@ -634,14 +467,10 @@ theorem P4458T1RespectAppend have hrespect : OdometerStringRespect C orientation base R S (left.dropLast ++ right) (hl.dropLast ++ hr) := RespectAppendDetails.hrespect C orientation base R S left right hl hr hrel hzip hnewChain hjoinedKeep - have hhead : (hl.dropLast ++ hr).head? = some hR := RespectAppendDetails.hhead C C₀ orientation - base R J S T₀ hR hJ h₀ left right hl hr hlhead hllast hrhead hleftAnc hleftOdo hleftChain - hleftLen hrel hzip hleftTailChain hleftFunList hleftZipShape hleftChainShape hnewChain - hleftZipDrop leftPairDrop leftPairTransfer rightPairTransfer hrespect - have hlast : (hl.dropLast ++ hr).getLast? = some hS := RespectAppendDetails.hlast C C₀ - orientation base R J S T₀ hR hJ hS h₀ left right hl hr hrhead hrlast hrightAnc hrightOdo - hrightChain hrightLen hrel hzip hrightZipShape hrightChainShape hnewChain leftPairTransfer - rightPairTransfer hrespect hhead + have hhead : (hl.dropLast ++ hr).head? = some hR := ListEndpointFacts.headDropLastAppend hl hr + hR hJ hlhead hllast hrhead + have hlast : (hl.dropLast ++ hr).getLast? = some hS := ListEndpointFacts.lastDropLastAppend hl + hr hS hrlast refine ⟨hhead, hlast, hrespect, ?_⟩ intro U hU have hUstart : U ∈ (left.dropLast ++ right).drop 1 := diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean index b163cffb08..432f7aa879 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean @@ -6,9 +6,9 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BoundaryFrameJoinGeometry public import LeanPool.ApollonianSuperharmonic.BoundaryFrameRowGeometry -public import LeanPool.ApollonianSuperharmonic.AncestorOdometerInnerSupportNormalization public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification public import LeanPool.ApollonianSuperharmonic.P4458T1BoundaryPlacement public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice @@ -46,83 +46,9 @@ private theorem hnegativeSlope : · omega · exact ⟨child, hchild⟩ -private theorem hvsumRe : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let w : GaussianInt := BandVectors.1 (r 3) (r 2) - let x : GaussianInt := BandVectors.1 (r 1) (r 3) - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (w + x + y = 0) → (w.re + x.re + y.re = 0) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r w x y hvsum - have h := congrArg (fun z : GaussianInt => z.re) hvsum - simpa [w, x, y] using h -private theorem hvsumIm : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let w : GaussianInt := BandVectors.1 (r 3) (r 2) - let x : GaussianInt := BandVectors.1 (r 1) (r 3) - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (w + x + y = 0) → (w.im + x.im + y.im = 0) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r w x y hvsum - have h := congrArg (fun z : GaussianInt => z.im) hvsum - simpa [w, x, y] using h -private theorem hUcenter : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let w : GaussianInt := BandVectors.1 (r 3) (r 2) - (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then (1 : - ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 - : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint - (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : - ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : - ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → (TileCentroid (D.tiles - F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • (GaussianRealPoint w - - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D r w hUcent - simpa [r, w] using hUcent -private theorem hMcenter : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r - simpa [r] using F.minus_centroid private theorem hcenterVector : (by @@ -166,100 +92,9 @@ private theorem hyLattice : have h := (ParentVectorsInTilingLattice r hr 0 C hRparent).1 simpa [y] using h -private theorem translate_add : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), TileTranslation - (TileTranslation T v) z = TileTranslation T (v + z) ) := by - classical - intro T v z - cases T with - | mk cells anchor => - apply congrArg₂ ProtoTile.mk - · ext q - simp [TileTranslation, GaussianTranslation, add_comm, add_left_comm] - · simp [TileTranslation, GaussianTranslation, add_comm, add_left_comm] - -private theorem hjoinFamily : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (y ∈ TilingLattice C) → (∀ (u : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y) - join ∈ RegularTileFamily base (TilingLattice C)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r y hyLattice u join - refine ⟨(u : GaussianInt) + y, (TilingLattice C).add_mem u.property hyLattice, ?_⟩ - rfl -private theorem hjoinCenter : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - ∀ (u : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y) - (join = TileTranslation Rminus y) → (TileCentroid join = TileCentroid Rminus + - GaussianRealPoint y) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r y u join hjoin_eq - rw [hjoin_eq, (TileTranslationFormulas Rminus y).2.2.2.2.1] - apply Prod.ext <;> simp [GaussianRealPoint] -private theorem hjoinCenterEq : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = GaussianRealPoint y) → (∀ (u - : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y) - (TileCentroid join = TileCentroid Rminus + GaussianRealPoint y) → (TileCentroid (D.tiles - F.slot false) = TileCentroid join)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D r y hcenter u join hjoinCenter - calc - TileCentroid (D.tiles F.slot false) = - (TileCentroid (D.tiles F.slot false) - TileCentroid Rminus) + - TileCentroid Rminus := by ext <;> dsimp <;> ring - _ = GaussianRealPoint y + TileCentroid Rminus := by rw [hcenter] - _ = TileCentroid Rminus + GaussianRealPoint y := by ext <;> dsimp <;> ring - _ = TileCentroid join := hjoinCenter.symm - -private theorem hUbandC : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), (BandPrototile (F.q F.slot.succ) (D.tiles F.slot - false)) → (BandPrototile C.1.1 (D.tiles F.slot false)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D hUband - rw [← F.parent] - exact hUband + private theorem hjoinOdo : (by @@ -289,38 +124,6 @@ private theorem hjoinOdo : (D.tiles F.slot false) join (D.functions F.slot false) C.2 hselectedOdo' hjoinBand hjoinCells.1 -private theorem hjoinAncestor : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), (0 < (F.q F.slot.succ).1) → (((F.q F.slot.succ).1 < - (F.q 0).1) → ((AncestorOdometer (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) - F.tile (D.functions F.slot false) - F.odometer) → ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - ∀ (u : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y) - (BandPrototile C.1.1 join) → (((D.tiles F.slot false).cells = join.cells ∧ ((D.tiles - F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = join.anchor)) → - (AncestorOdometer C.1.1 F.outer.1.1 join F.tile (D.functions F.slot false) - F.odometer))))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D hCpositive hstrict hselectedAnc r y u - join hjoinBand hjoinCells - have hstrictOuter : (F.q F.slot.succ).1 < F.outer.1.1.1 := by - rw [← F.child] - exact hstrict - have hAnc := AncestorOdometerInnerSupportNormalization - (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) join F.tile - (D.functions F.slot false) F.odometer hCpositive hstrictOuter hselectedAnc - (by simpa only [← F.parent] using hjoinBand) hjoinCells.1 - simpa only [← F.parent] using hAnc private theorem positiveCells : (by @@ -379,56 +182,7 @@ private theorem hjoinFootEq : simp only [FootprintVertices, ite_eq_left hJoinNonemptyBase, ite_eq_left hUnonempty] rw [hjoinCells.1] -private theorem hjoinFoot : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (FootprintVertices (D.tiles F.slot false) ⊆ FootprintVertices F.tile) → (∀ (u : - ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y) - (FootprintVertices join = FootprintVertices (D.tiles F.slot false)) → (FootprintVertices - join ⊆ FootprintVertices F.tile)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D r y hUfoot u join hjoinFootEq - rw [hjoinFootEq] - exact hUfoot -private theorem hjoinOccurrence : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then (1 : - ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 - : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint - (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : - ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : - ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (u : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y) - (BandPrototile C.1.1 join) → ((TileCentroid (D.tiles F.slot false) = TileCentroid join) → - ((FootprintVertices join ⊆ FootprintVertices F.tile) → (BandSubtileOccurrence F.q - F.tile F.slot false join)))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D r y hUcent u join hjoinBand - hjoinCenterEq hjoinFoot - refine ⟨by simpa only [← F.parent] using hjoinBand, hjoinFoot, ?_⟩ - rw [← hjoinCenterEq] - exact hUcent private theorem hq0 : (by @@ -736,44 +490,6 @@ private theorem hAIm'At435 : hAIm simpa [hqD, hqB, hr1, hr2, ya] using hAIm -private theorem hasumReAt438 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let wa : GaussianInt := BandVectors.2 (r 3) (r 2) - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - let ya : GaussianInt := BandVectors.2 (r 2) (r 1) - (wa + xa + ya = 0) → (wa.re + xa.re + ya.re = 0) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum - have h := congrArg (fun z : GaussianInt => z.re) hasum - simpa [wa, xa, ya] using h - -private theorem hasumImAt441 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let wa : GaussianInt := BandVectors.2 (r 3) (r 2) - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - let ya : GaussianInt := BandVectors.2 (r 2) (r 1) - (wa + xa + ya = 0) → (wa.im + xa.im + ya.im = 0) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum - have h := congrArg (fun z : GaussianInt => z.im) hasum - simpa [wa, xa, ya] using h - private theorem hminusSlopeOffset : (by classical @@ -1126,21 +842,6 @@ private theorem hplusSlopeOffset : congr 1 exact_mod_cast hplusImVec.symm -private theorem hPcenter : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 - (r 1) (r 0) + BandVectors.1 (r 0) (r 1)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r - simpa [r] using F.plus_centroid private theorem hFminusSlopeAt641 : (by @@ -2616,21 +2317,6 @@ private theorem hrightBminus : Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_mul, Zsqrtd.im_mul, hvrec, hvflip] <;> ring -private theorem hplusFcenter : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 - (r 1) (r 0) + BandVectors.1 (r 0) (r 1)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r - simpa [r] using F.plus_centroid private theorem hrightBplus : (by @@ -3493,7 +3179,8 @@ private theorem firstParentPlacement : have hPcenter : TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1)) := - SecondNewerRowsGeometry.hPcenter C orientation base Rminus Rplus hminus hplus F + BoundaryFrameJoinGeometry.plusCentroid C orientation base Rminus Rplus hminus + hplus F rw [hPcenter, hAocc, hvflip, hvrec, hBA, hvAB] apply Prod.ext <;> simp [GaussianRealPoint, I, Prod.smul_mk, @@ -3771,7 +3458,7 @@ private theorem secondParentPlacement : hTflip have hrightBplus := SecondNewerRowsGeometry.hrightBplus C orientation base Rminus Rplus hminus hplus F D a t hvrec hvflip hBocc hTvec hTflip - (SecondNewerRowsGeometry.hplusFcenter C orientation base Rminus Rplus hminus hplus F) + (BoundaryFrameJoinGeometry.plusCentroid C orientation base Rminus Rplus hminus hplus F) have hyaReR : (ya.re : ℝ) = ((BandVectors.2 (p 0) (p 3)).re : ℝ) := by rw [hyaA] have hyaImR : (ya.im : ℝ) = @@ -4118,9 +3805,11 @@ private theorem directParentCase : hplus F a p hqB hqD hr1 hr2 rootSlope aSlope hARe have hAIm' := SecondNewerRowsGeometry.hAIm'At435 C orientation base Rminus Rplus hminus hplus F a p hqB hqD hr1 hr2 rootSlope aSlope hAIm - have hasumRe := SecondNewerRowsGeometry.hasumReAt438 C orientation base Rminus Rplus hminus + have hasumRe := BoundaryFrameJoinGeometry.secondVectorSumReal C orientation base Rminus Rplus + hminus hplus F hasum - have hasumIm := SecondNewerRowsGeometry.hasumImAt441 C orientation base Rminus Rplus hminus + have hasumIm := BoundaryFrameJoinGeometry.secondVectorSumImaginary C orientation base Rminus + Rplus hminus hplus F hasum have hasumReR : (wa.re : ℝ) + (xa.re : ℝ) + (ya.re : ℝ) = 0 := by exact_mod_cast hasumRe @@ -4365,9 +4054,9 @@ private theorem recursiveParentCase : have hFminusIm := SecondNewerRowsGeometry.hFminusImAt1002 C orientation base Rminus Rplus hminus hplus F rootA hFminusSlope have hrootNegA : rootNeg = rootA := hrootNegEq.trans hrootAEq.symm - have hasumRe := SecondNewerRowsGeometry.hasumReAt438 C orientation base Rminus Rplus + have hasumRe := BoundaryFrameJoinGeometry.secondVectorSumReal C orientation base Rminus Rplus hminus hplus F hasum - have hasumIm := SecondNewerRowsGeometry.hasumImAt441 C orientation base Rminus Rplus + have hasumIm := BoundaryFrameJoinGeometry.secondVectorSumImaginary C orientation base Rminus Rplus hminus hplus F hasum have hasumReR : (wa.re : ℝ) + (xa.re : ℝ) + (ya.re : ℝ) = 0 := by exact_mod_cast hasumRe @@ -4439,17 +4128,20 @@ theorem P4458T1SecondNewerRows : simpa [I] using (VectorRecursionLaws r hr.1).2.2.2.2 hr 0 |>.1 have haflip : BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0) := by simpa [I] using (VectorRecursionLaws r hr.1).2.2.2.2 hr 0 |>.2 - have hvsumRe := SecondNewerRowsGeometry.hvsumRe C orientation base Rminus Rplus hminus hplus + have hvsumRe := BoundaryFrameJoinGeometry.firstVectorSumReal C orientation base Rminus Rplus + hminus hplus F hvsum - have hvsumIm := SecondNewerRowsGeometry.hvsumIm C orientation base Rminus Rplus hminus hplus + have hvsumIm := BoundaryFrameJoinGeometry.firstVectorSumImaginary C orientation base Rminus + Rplus hminus hplus F hvsum rcases hselectedOcc with ⟨hUband, hUfoot, hUcent⟩ - have hUcenter := SecondNewerRowsGeometry.hUcenter C orientation base Rminus Rplus hminus + have hUcenter := BoundaryFrameJoinGeometry.selectedCentroid C orientation base Rminus Rplus + hminus hplus F D hUcent have hMcenter : TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1)) := - SecondNewerRowsGeometry.hMcenter C orientation base Rminus Rplus hminus hplus F + BoundaryFrameJoinGeometry.minusCentroid C orientation base Rminus Rplus hminus hplus F have hcenterVector := SecondNewerRowsGeometry.hcenterVector C orientation base Rminus Rplus hminus hplus F p hvrec hvflip hvsumRe hvsumIm have hcenterRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) hcenterVector @@ -4465,25 +4157,27 @@ theorem P4458T1SecondNewerRows : let join : ProtoTile := TileTranslation base (u + y) have translate_add (T : ProtoTile) (v z : GaussianInt) : TileTranslation (TileTranslation T v) z = TileTranslation T (v + z) := - SecondNewerRowsGeometry.translate_add T v z + TileTranslationProperties.add T v z have hjoin_eq : join = TileTranslation Rminus y := by simpa [join, huRminus] using (translate_add base (u : GaussianInt) y).symm have hjoinBand : BandPrototile C.1.1 join := by simpa [join] using BandPrototileTranslation C.1.1 base (u + y) F.base_band - have hjoinFamily := SecondNewerRowsGeometry.hjoinFamily C orientation base Rminus Rplus + have hjoinFamily := BoundaryFrameJoinGeometry.joinFamily C orientation base Rminus Rplus hminus hplus F hyLattice u - have hjoinCenter := SecondNewerRowsGeometry.hjoinCenter C orientation base Rminus Rplus + have hjoinCenter := BoundaryFrameJoinGeometry.joinCentroid C orientation base Rminus Rplus hminus hplus F u hjoin_eq have hjoinCenterEq : TileCentroid (D.tiles F.slot false) = TileCentroid join := - SecondNewerRowsGeometry.hjoinCenterEq C orientation base Rminus Rplus hminus hplus F D + BoundaryFrameJoinGeometry.joinCentroidEquality C orientation base Rminus Rplus hminus + hplus F D hcenter u hjoinCenter - have hUbandC := SecondNewerRowsGeometry.hUbandC C orientation base Rminus Rplus hminus hplus + have hUbandC := BoundaryFrameJoinGeometry.parentPrototile C orientation base Rminus Rplus + hminus hplus F D hUband have hjoinCells := BandPrototileCentroidUnique C.1.1 (D.tiles F.slot false) join hUbandC hjoinBand hjoinCenterEq have hjoinOdo := SecondNewerRowsGeometry.hjoinOdo C orientation base Rminus Rplus hminus hplus F D hselectedOdo u hjoinBand hjoinCells - have hjoinAncestor := SecondNewerRowsGeometry.hjoinAncestor C orientation base Rminus Rplus + have hjoinAncestor := BoundaryFrameJoinGeometry.joinAncestor C orientation base Rminus Rplus hminus hplus F D hCpositive hstrict hselectedAnc u hjoinBand hjoinCells have positiveCells := SecondNewerRowsGeometry.positiveCells C orientation base Rminus Rplus hminus hplus F p @@ -4492,9 +4186,9 @@ theorem P4458T1SecondNewerRows : have hJoinNonemptyBase : join.cells.Nonempty := by rw [← hjoinCells.1]; exact hUnonempty have hjoinFootEq := SecondNewerRowsGeometry.hjoinFootEq C orientation base Rminus Rplus hminus hplus F D u hjoinCells hUnonempty hJoinNonemptyBase - have hjoinFoot := SecondNewerRowsGeometry.hjoinFoot C orientation base Rminus Rplus hminus + have hjoinFoot := BoundaryFrameJoinGeometry.joinFootprint C orientation base Rminus Rplus hminus hplus F D hUfoot u hjoinFootEq - have hjoinOccurrence := SecondNewerRowsGeometry.hjoinOccurrence C orientation base Rminus + have hjoinOccurrence := BoundaryFrameJoinGeometry.joinOccurrence C orientation base Rminus Rplus hminus hplus F D hUcent u hjoinBand hjoinCenterEq hjoinFoot have hq0 := SecondNewerRowsGeometry.hq0 C orientation base Rminus Rplus hminus hplus F a p hstep have hqA : F.q a.succ = p 0 := SecondNewerRowsGeometry.hqA C orientation base Rminus Rplus diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean index 9983a43c20..216409cd29 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean @@ -56,111 +56,31 @@ private theorem hr : exact rot a private theorem hcentJ : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q - (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : - ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + - (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : - Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 - : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p - (3 : Fin (4 : ℕ))]) → ((F.slot = a + (1 : Fin (3 : ℕ))) → (∀ (J : ProtoTile), - (TileCentroid J = TileCentroid (D.tiles F.slot false)) → ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (ProperBandQuadruple r) → ((r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p - 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2)) → ((r 1 = p 0) → ((r 2 = p 2) → ((r 3 = p 3) - → ((r 2 = C.1.1) → ( - let I : GaussianInt := ⟨0, 1⟩ - let w := BandVectors.1 (r 3) (r 2) - let x := BandVectors.1 (r 1) (r 3) - let y := BandVectors.1 (r 2) (r 1) - let wa := BandVectors.2 (r 3) (r 2) - let xa := BandVectors.2 (r 1) (r 3) - let ya := BandVectors.2 (r 2) (r 1) - (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : - ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 - : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r - (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 - (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : - Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : - ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) - (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r - j.succ) (r (0 : Fin (4 : ℕ))))) → ((SemiProperQuadruple ![r 0, r 2, r 3, r 1]) → - ((BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : - ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), - r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : - ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), - r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : - ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ - BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : - ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ - (ProperBandQuadruple ![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r - (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : - Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 : Fin - (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : - ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = - -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : - Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r - (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → ((BandVectors.1 (r 2) (r - 0) = y - I * w) → ((BandVectors.2 (r 2) (r 0) = ya + I * wa) → ((BandVectors.1 (r 0) (r - 2) = I * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → - ((BandVectors.1 (p 0) (p 2) = I * y) → ((BandVectors.2 (p 0) (p 2) = -I * ya) → ((-(w - I - * w) - (x - I * y - I * (x - I * y)) = (2 : GaussianInt) * y ∧ x - I * y + I * (x - I * - y) + (w - I * w) = (2 : GaussianInt) * I * x ∧ -(x - I * x) - (w - I * w) = y - I * y ∧ y - - I * w + I * (y - I * w) - (w - I * w) = y + I * y ∧ w - I * x - I * (w - I * x) - (w - - I * w) = -I * x - x ∧ -(y - I * y) - (w - I * w) = -I * x + x ∧ y - I * w - I * (y - I * - w) - (y - I * y) = -I * w - w ∧ -(x - I * x) - (y - I * y) = -I * w + w ∧ -(y - I * y) - - (x - I * x) = w - I * w ∧ w - I * x + I * (w - I * x) - (x - I * x) = w + I * w) → ((-(wa - - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya - + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - - (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya - + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - - -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - - -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I - * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * - xa) = wa + -I * wa) → ((-(xa - -I * xa) - (wa - -I * wa) = ya - -I * ya) → ((ya - -I * wa - + -I * (ya - -I * wa) - (wa - -I * wa) = ya + -I * ya) → ((BandVectors.1 (r 0) (r 2) = I - * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → (TileCentroid J - - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * - x)))))))))))))))))))))))))) := by + ∀ (C : BandCircle), + ∀ (orientation : Bool), + ∀ (base : ProtoTile), + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + ∀ (hminus : PartialOdometer), + ∀ (hplus : PartialOdometer), + ∀ + (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus + hplus), + ∀ (D : P4458T1RestrictionFamily F), + ∀ (a : Fin 3), + ((F.slot = a + (1 : Fin (3 : ℕ))) → + (∀ (J : ProtoTile), + (TileCentroid J = TileCentroid (D.tiles F.slot false)) → + (let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, + F.q (a + 2).succ]; + (let I : GaussianInt := ⟨0, 1⟩; + let x := BandVectors.1 (r 1) (r 3); + (TileCentroid J - TileCentroid F.tile = + (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * x))))))) := by classical - intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J hcent r hr hcoord hA - hB hE hparent I w x y wa xa ya laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird - aFourth vflip aflip + intro C orientation base Rminus Rplus hminus hplus F D a hslot J hcent r I x have h := (D.occurrences F.slot false).2.2 rw [hslot] at h rw [hslot] at hcent @@ -175,112 +95,32 @@ private theorem hcentJ : Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring private theorem hcentR : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q - (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : - ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + - (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : - Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 - : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p - (3 : Fin (4 : ℕ))]) → ((F.slot = a + (1 : Fin (3 : ℕ))) → (∀ (J : ProtoTile), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (ProperBandQuadruple r) → ((r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p - 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2)) → ((r 1 = p 0) → ((r 2 = p 2) → ((r 3 = p 3) - → ((r 2 = C.1.1) → ( - let I : GaussianInt := ⟨0, 1⟩ - let w := BandVectors.1 (r 3) (r 2) - let x := BandVectors.1 (r 1) (r 3) - let y := BandVectors.1 (r 2) (r 1) - let wa := BandVectors.2 (r 3) (r 2) - let xa := BandVectors.2 (r 1) (r 3) - let ya := BandVectors.2 (r 2) (r 1) - (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : - ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 - : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r - (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 - (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : - Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : - ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) - (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r - j.succ) (r (0 : Fin (4 : ℕ))))) → ((SemiProperQuadruple ![r 0, r 2, r 3, r 1]) → - ((BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : - ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), - r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : - ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), - r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : - ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ - BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : - ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ - (ProperBandQuadruple ![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r - (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : - Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 : Fin - (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : - ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = - -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : - Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r - (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → ((BandVectors.1 (r 2) (r - 0) = y - I * w) → ((BandVectors.2 (r 2) (r 0) = ya + I * wa) → ((BandVectors.1 (r 0) (r - 2) = I * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → - ((BandVectors.1 (p 0) (p 2) = I * y) → ((BandVectors.2 (p 0) (p 2) = -I * ya) → ((-(w - I - * w) - (x - I * y - I * (x - I * y)) = (2 : GaussianInt) * y ∧ x - I * y + I * (x - I * - y) + (w - I * w) = (2 : GaussianInt) * I * x ∧ -(x - I * x) - (w - I * w) = y - I * y ∧ y - - I * w + I * (y - I * w) - (w - I * w) = y + I * y ∧ w - I * x - I * (w - I * x) - (w - - I * w) = -I * x - x ∧ -(y - I * y) - (w - I * w) = -I * x + x ∧ y - I * w - I * (y - I * - w) - (y - I * y) = -I * w - w ∧ -(x - I * x) - (y - I * y) = -I * w + w ∧ -(y - I * y) - - (x - I * x) = w - I * w ∧ w - I * x + I * (w - I * x) - (x - I * x) = w + I * w) → ((-(wa - - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya - + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - - (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya - + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - - -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - - -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I - * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * - xa) = wa + -I * wa) → ((-(xa - -I * xa) - (wa - -I * wa) = ya - -I * ya) → ((ya - -I * wa - + -I * (ya - -I * wa) - (wa - -I * wa) = ya + -I * ya) → ((BandVectors.1 (r 0) (r 2) = I - * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → ((TileCentroid J - - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * x))) → ((TileCentroid - (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (w - I * w)) → - (TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint ((y - I * w) - + I * (y - I * w))))))))))))))))))))))))))) := by + ∀ (C : BandCircle), + ∀ (orientation : Bool), + ∀ (base : ProtoTile), + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + ∀ (hminus : PartialOdometer), + ∀ (hplus : PartialOdometer), + ∀ + (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus + hplus), + ∀ (a : Fin 3), + ((F.slot = a + (1 : Fin (3 : ℕ))) → + (let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ]; + (let I : GaussianInt := ⟨0, 1⟩; + let w := BandVectors.1 (r 3) (r 2); + let y := BandVectors.1 (r 2) (r 1); + ((BandVectors.1 (r 2) (r 0) = y - I * w) → + ((BandVectors.1 (r 0) (r 2) = I * (y - I * w)) → + (TileCentroid Rplus - TileCentroid F.tile = + (1 / 2 : ℝ) • + GaussianRealPoint + ((y - I * w) + I * (y - I * w)))))))) := by classical - intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J r hr hcoord hA hB hE - hparent I w x y wa xa ya laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird - aFourth vflip aflip hcentJ hcentK + intro C orientation base Rminus Rplus hminus hplus F a hslot r I w y hv vflip have h := F.plus_centroid rw [hslot] at h fin_cases a @@ -370,135 +210,57 @@ private theorem hcentRK : rw [halfPoint_sub, vAlg.2.2.2.1] private theorem hslopeJ : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q - (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : - ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + - (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : - Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 - : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p - (3 : Fin (4 : ℕ))]) → ((F.slot = a + (1 : Fin (3 : ℕ))) → (∀ (J : ProtoTile), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (ProperBandQuadruple r) → ((r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p - 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2)) → ((r 1 = p 0) → ((r 2 = p 2) → ((r 3 = p 3) - → ((r 2 = C.1.1) → ( - let I : GaussianInt := ⟨0, 1⟩ - let w := BandVectors.1 (r 3) (r 2) - let x := BandVectors.1 (r 1) (r 3) - let y := BandVectors.1 (r 2) (r 1) - let wa := BandVectors.2 (r 3) (r 2) - let xa := BandVectors.2 (r 1) (r 3) - let ya := BandVectors.2 (r 2) (r 1) - (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : - ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 - : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r - (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 - (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : - Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : - ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) - (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r - j.succ) (r (0 : Fin (4 : ℕ))))) → ((SemiProperQuadruple ![r 0, r 2, r 3, r 1]) → - ((BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : - ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), - r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : - ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), - r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : - ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ - BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : - ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ - (ProperBandQuadruple ![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r - (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : - Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 : Fin - (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : - ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = - -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : - Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r - (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → ((BandVectors.1 (r 2) (r - 0) = y - I * w) → ((BandVectors.2 (r 2) (r 0) = ya + I * wa) → ((BandVectors.1 (r 0) (r - 2) = I * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → - ((BandVectors.1 (p 0) (p 2) = I * y) → ((BandVectors.2 (p 0) (p 2) = -I * ya) → ((-(w - I - * w) - (x - I * y - I * (x - I * y)) = (2 : GaussianInt) * y ∧ x - I * y + I * (x - I * - y) + (w - I * w) = (2 : GaussianInt) * I * x ∧ -(x - I * x) - (w - I * w) = y - I * y ∧ y - - I * w + I * (y - I * w) - (w - I * w) = y + I * y ∧ w - I * x - I * (w - I * x) - (w - - I * w) = -I * x - x ∧ -(y - I * y) - (w - I * w) = -I * x + x ∧ y - I * w - I * (y - I * - w) - (y - I * y) = -I * w - w ∧ -(x - I * x) - (y - I * y) = -I * w + w ∧ -(y - I * y) - - (x - I * x) = w - I * w ∧ w - I * x + I * (w - I * x) - (x - I * x) = w + I * w) → ((-(wa - - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya - + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - - (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya - + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - - -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - - -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I - * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * - xa) = wa + -I * wa) → ((-(xa - -I * xa) - (wa - -I * wa) = ya - -I * ya) → ((ya - -I * wa - + -I * (ya - -I * wa) - (wa - -I * wa) = ya + -I * ya) → ((BandVectors.1 (r 0) (r 2) = I - * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → ((TileCentroid J - - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * x))) → ((TileCentroid - (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (w - I * w)) → - ((TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint ((y - I * w) - + I * (y - I * w))) → ((TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • - GaussianRealPoint (y - I * y)) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = - (1 / 2 : ℝ) • GaussianRealPoint (y + I * y)) → ((TileOdometer (p 0) (D.tiles a true) - (D.functions a true)) → ((BandPrototile (p 0) (D.tiles a true)) → ((F.q a.succ = p 0) → - ((F.q ((a + 1).succ) = p 2) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = (1 / - 2 : ℝ) • GaussianRealPoint (BandVectors.1 (p 2) (p 0) + BandVectors.1 (p 0) (p 2))) → (∀ - (sJ : ℝ × ℝ), (sJ.1 - F.outerSlope.1 = (if false = true then (1 : ℝ) else (-1 : ℝ)) - * (1 - / 2 : ℝ) * ((↑(BandVectors.2 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : - Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) - (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sJ.2 - F.outerSlope.2 = (if false - = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (F.slot + (2 : - Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 - (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)).re : - ℝ))) → ((0 < (F.q a.succ).1) → (∀ (sA : ℝ × ℝ), (PartialOdometerSlope (D.functions a - true) = some sA) → ((sA.1 - F.outerSlope.1 = (if true = true then (1 : ℝ) else (-1 : ℝ)) - * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin - (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + - (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sA.2 - F.outerSlope.2 = (if true = true then (1 - : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) - (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : - ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (sJ - F.outerSlope = (1 / 2 : - ℝ) • GaussianRealPoint (-(xa - (-I) * xa))))))))))))))))))))))))))))))))))))))))) := by + ∀ (C : BandCircle), + ∀ (orientation : Bool), + ∀ (base : ProtoTile), + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + ∀ (hminus : PartialOdometer), + ∀ (hplus : PartialOdometer), + ∀ + (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus + hplus), + ∀ (a : Fin 3), + ((F.slot = a + (1 : Fin (3 : ℕ))) → + (let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ]; + (let I : GaussianInt := ⟨0, 1⟩; + let xa := BandVectors.2 (r 1) (r 3); + (∀ (sJ : ℝ × ℝ), + (sJ.1 - F.outerSlope.1 = + (if false = true then (1 : ℝ) else (-1 : ℝ)) * + (1 / 2 : ℝ) * + ((↑(BandVectors.2 + (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) + (F.q + (F.slot + (1 : Fin (3 : ℕ))).succ)).re : + ℝ) - + (↑(BandVectors.2 + (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) + (F.q + (F.slot + (1 : Fin (3 : ℕ))).succ)).im : + ℝ))) → + ((sJ.2 - F.outerSlope.2 = + (if false = true then (1 : ℝ) else (-1 : ℝ)) * + (1 / 2 : ℝ) * + ((↑(BandVectors.2 + (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) + (F.q + (F.slot + + (1 : Fin (3 : ℕ))).succ)).im : + ℝ) + + (↑(BandVectors.2 + (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) + (F.q + (F.slot + + (1 : Fin (3 : ℕ))).succ)).re : + ℝ))) → + (sJ - F.outerSlope = + (1 / 2 : ℝ) • + GaussianRealPoint (-(xa - (-I) * xa)))))))) := by classical - intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J r hr hcoord hA hB hE - hparent I w x y wa xa ya laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird - aFourth vflip aflip hcentJ hcentK hcentR hcentJK hcentRK hodoK hbandK hAcoord hBcoord - hcentRnew sJ hreJ himJ hqapos sA hsA hreA himA + intro C orientation base Rminus Rplus hminus hplus F a hslot r I xa sJ hreJ himJ have hJvec : BandVectors.2 (F.q ((F.slot + 2).succ)) (F.q ((F.slot + 1).succ)) = xa := by rw [hslot] @@ -701,130 +463,32 @@ private theorem hminusSlope : constructor <;> nlinarith private theorem hplusSlopeRoot : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q - (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : - ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + - (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : - Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 - : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p - (3 : Fin (4 : ℕ))]) → ((F.slot = a + (1 : Fin (3 : ℕ))) → (∀ (J : ProtoTile), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (ProperBandQuadruple r) → ((r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p - 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2)) → ((r 1 = p 0) → ((r 2 = p 2) → ((r 3 = p 3) - → ((r 2 = C.1.1) → ( - let I : GaussianInt := ⟨0, 1⟩ - let w := BandVectors.1 (r 3) (r 2) - let x := BandVectors.1 (r 1) (r 3) - let y := BandVectors.1 (r 2) (r 1) - let wa := BandVectors.2 (r 3) (r 2) - let xa := BandVectors.2 (r 1) (r 3) - let ya := BandVectors.2 (r 2) (r 1) - (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : - ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 - : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r - (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 - (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : - Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : - ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) - (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r - j.succ) (r (0 : Fin (4 : ℕ))))) → ((SemiProperQuadruple ![r 0, r 2, r 3, r 1]) → - ((BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : - ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), - r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : - ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), - r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : - ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ - BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : - ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ - (ProperBandQuadruple ![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r - (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : - Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 : Fin - (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : - ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = - -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : - Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r - (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → ((BandVectors.1 (r 2) (r - 0) = y - I * w) → ((BandVectors.2 (r 2) (r 0) = ya + I * wa) → ((BandVectors.1 (r 0) (r - 2) = I * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → - ((BandVectors.1 (p 0) (p 2) = I * y) → ((BandVectors.2 (p 0) (p 2) = -I * ya) → ((-(w - I - * w) - (x - I * y - I * (x - I * y)) = (2 : GaussianInt) * y ∧ x - I * y + I * (x - I * - y) + (w - I * w) = (2 : GaussianInt) * I * x ∧ -(x - I * x) - (w - I * w) = y - I * y ∧ y - - I * w + I * (y - I * w) - (w - I * w) = y + I * y ∧ w - I * x - I * (w - I * x) - (w - - I * w) = -I * x - x ∧ -(y - I * y) - (w - I * w) = -I * x + x ∧ y - I * w - I * (y - I * - w) - (y - I * y) = -I * w - w ∧ -(x - I * x) - (y - I * y) = -I * w + w ∧ -(y - I * y) - - (x - I * x) = w - I * w ∧ w - I * x + I * (w - I * x) - (x - I * x) = w + I * w) → ((-(wa - - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya - + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - - (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya - + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - - -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - - -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I - * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * - xa) = wa + -I * wa) → ((-(xa - -I * xa) - (wa - -I * wa) = ya - -I * ya) → ((ya - -I * wa - + -I * (ya - -I * wa) - (wa - -I * wa) = ya + -I * ya) → ((BandVectors.1 (r 0) (r 2) = I - * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → ((TileCentroid J - - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * x))) → ((TileCentroid - (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (w - I * w)) → - ((TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint ((y - I * w) - + I * (y - I * w))) → ((TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • - GaussianRealPoint (y - I * y)) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = - (1 / 2 : ℝ) • GaussianRealPoint (y + I * y)) → ((TileOdometer (p 0) (D.tiles a true) - (D.functions a true)) → ((BandPrototile (p 0) (D.tiles a true)) → ((F.q a.succ = p 0) → - ((F.q ((a + 1).succ) = p 2) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = (1 / - 2 : ℝ) • GaussianRealPoint (BandVectors.1 (p 2) (p 0) + BandVectors.1 (p 0) (p 2))) → (∀ - (sJ : ℝ × ℝ), (0 < (F.q a.succ).1) → (∀ (sA : ℝ × ℝ), (PartialOdometerSlope (D.functions - a true) = some sA) → ((sA.1 - F.outerSlope.1 = (if true = true then (1 : ℝ) else (-1 : - ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : - Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q - (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sA.2 - F.outerSlope.2 = (if true = true - then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : - ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + (2 : - Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((sJ - F.outerSlope - = (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa))) → ((sA - F.outerSlope = (1 / 2 : - ℝ) • GaussianRealPoint (wa - (-I) * wa)) → ((sJ - sA = (1 / 2 : ℝ) • GaussianRealPoint - (ya - (-I) * ya)) → (F.plusSlope - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (ya + - I * wa + (-I) * (ya + I * wa)))))))))))))))))))))))))))))))))))))))))) := by + ∀ (C : BandCircle), + ∀ (orientation : Bool), + ∀ (base : ProtoTile), + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + ∀ (hminus : PartialOdometer), + ∀ (hplus : PartialOdometer), + ∀ + (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus + hplus), + ∀ (a : Fin 3), + ((F.slot = a + (1 : Fin (3 : ℕ))) → + (let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ]; + (let I : GaussianInt := ⟨0, 1⟩; + let wa := BandVectors.2 (r 3) (r 2); + let ya := BandVectors.2 (r 2) (r 1); + ((BandVectors.2 (r 2) (r 0) = ya + I * wa) → + ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → + (F.plusSlope - F.outerSlope = + (1 / 2 : ℝ) • + GaussianRealPoint + (ya + I * wa + (-I) * (ya + I * wa)))))))) := by classical - intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J r hr hcoord hA hB hE - hparent I w x y wa xa ya laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird - aFourth vflip aflip hcentJ hcentK hcentR hcentJK hcentRK hodoK hbandK hAcoord hBcoord - hcentRnew sJ hqapos sA hsA hreA himA hslopeJ hslopeA hminusSlope + intro C orientation base Rminus Rplus hminus hplus F a hslot r I wa ya ha hflipa have h := F.plus_difference rw [hslot] at h fin_cases a @@ -1430,17 +1094,14 @@ theorem P4536T1AFrameB halfPoint u - halfPoint v = halfPoint (u - v) := AFrameBDetails.halfPoint_sub u v have hcentJ : TileCentroid J - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * x)) := AFrameBProof.hcentJ C orientation - base Rminus Rplus hminus hplus F D a p hstep hslot J hcent hr hcoord hA hB hE - hparent laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird aFourth vflip - aflip + base Rminus Rplus hminus hplus F D a hslot J hcent have hcentK : TileCentroid (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (w - I * w) := AFrameBDetails.hcentK C orientation base Rminus Rplus hminus hplus F D a have hcentR : TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint ((y - I * w) + I * (y - I * w)) := AFrameBProof.hcentR - C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J hr hcoord hA hB - hE hparent laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird aFourth - vflip aflip hcentJ hcentK + C orientation base Rminus Rplus hminus hplus F a hslot hv + vflip have hcentJK : TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint (y - I * y) := AFrameBProof.hcentJK C orientation base Rminus Rplus hminus hplus F D a J vAlg halfPoint_sub hcentJ hcentK @@ -1481,10 +1142,8 @@ theorem P4536T1AFrameB subst rootA have hslopeJ : sJ - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa)) := AFrameBProof.hslopeJ C - orientation base Rminus Rplus hminus hplus F D a p hstep hslot J hr hcoord hA hB hE - hparent laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird aFourth vflip - aflip hcentJ hcentK hcentR hcentJK hcentRK hodoK hbandK hAcoord hBcoord hcentRnew - sJ hreJ himJ hqapos sA hsA hreA himA + orientation base Rminus Rplus hminus hplus F a hslot + sJ hreJ himJ have hslopeA : sA - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (wa - (-I) * wa) := AFrameBProof.hslopeA C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J hr hcoord hA hB hE hparent @@ -1534,10 +1193,7 @@ theorem P4536T1AFrameB _ = _ := (AFrameBDetails.hplusSlopeP C orientation base Rminus Rplus hminus hplus F a p sA (AFrameBProof.hplusSlope C orientation base Rminus Rplus hminus hplus F a halfPoint_sub sA hslopeA (AFrameBProof.hplusSlopeRoot C orientation base - Rminus Rplus hminus hplus F D a p hstep hslot J hr hcoord hA hB hE hparent laws - hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird aFourth vflip aflip - hcentJ hcentK hcentR hcentJK hcentRK hodoK hbandK hAcoord hBcoord hcentRnew sJ - hqapos sA hsA hreA himA hslopeJ hslopeA hminusSlope) (AFrameBDetails.hplusDelta + Rminus Rplus hminus hplus F a hslot ha hflipa) (AFrameBDetails.hplusDelta C orientation base Rminus Rplus hminus hplus F a aFourth)) (AFrameBDetails.hplusVec C orientation base Rminus Rplus hminus hplus F a p hap hya)) diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean index 1cbfd701a9..c583940d6b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean @@ -511,85 +511,32 @@ private theorem centMinus : simpa using h private theorem centJ : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q - 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * - (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → - ((F.slot = a + 2) → (∀ (J : ProtoTile), (TileCentroid J = TileCentroid (D.tiles F.slot - false)) → ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (ProperBandQuadruple r) → ((r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p - 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → ((r 1 = p 0) → ((r 2 = p - 2) → ((r 3 = p 3) → ((F.q F.slot.succ = r 3) → ((F.q 0 = r 0) → ( - let I : GaussianInt := ⟨0, 1⟩ - let wv := BandVectors.1 (r 3) (r 2) - let xv := BandVectors.1 (r 1) (r 3) - let yv := BandVectors.1 (r 2) (r 1) - let wa := BandVectors.2 (r 3) (r 2) - let xa := BandVectors.2 (r 1) (r 3) - let ya := BandVectors.2 (r 2) (r 1) - (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : - ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 - : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r - (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 - (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : - Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : - ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) - (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r - j.succ) (r (0 : Fin (4 : ℕ))))) → ( - let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] - (ProperBandQuadruple rr) → ((BandVectors.1 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + - BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + BandVectors.1 (rr (2 : Fin - (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (rr (3 : Fin (4 : - ℕ))) (rr (2 : Fin (4 : ℕ))) + BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) - + BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) = BandVectors.1 (rr (1 : Fin - (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (rr (2 : Fin (4 : - ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) - = BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple rr → ∀ - (j : Fin (3 : ℕ)), BandVectors.1 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ - * BandVectors.1 (rr j.succ) (rr (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (0 : Fin (4 : ℕ))) - (rr j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (rr j.succ) (rr (0 : Fin (4 : ℕ))))) → - ((BandVectors.1 (r 3) (r 0) = wv - I * xv) → ((BandVectors.2 (r 3) (r 0) = wa + I * xa) → - ((-(wv - I * wv) - (xv - I * yv - I * (xv - I * yv)) = (2 : GaussianInt) * yv ∧ xv - I * - yv + I * (xv - I * yv) + (wv - I * wv) = (2 : GaussianInt) * I * xv ∧ -(xv - I * xv) - - (wv - I * wv) = yv - I * yv ∧ yv - I * wv + I * (yv - I * wv) - (wv - I * wv) = yv + I * - yv ∧ wv - I * xv - I * (wv - I * xv) - (wv - I * wv) = -I * xv - xv ∧ -(yv - I * yv) - - (wv - I * wv) = -I * xv + xv ∧ yv - I * wv - I * (yv - I * wv) - (yv - I * yv) = -I * wv - - wv ∧ -(xv - I * xv) - (yv - I * yv) = -I * wv + wv ∧ -(yv - I * yv) - (xv - I * xv) = - wv - I * wv ∧ wv - I * xv + I * (wv - I * xv) - (xv - I * xv) = wv + I * wv) → ((-(wa - - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya + - -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - - (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya - + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - - -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - - -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I - * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * - xa) = wa + -I * wa) → ((BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : - ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin - (4 : ℕ))) ∧ BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → - ((BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : - ℤ)⟩ * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : ℤ), (1 : - ℤ)⟩ * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → - ((BandVectors.1 (r 0) (r 3) = I * BandVectors.1 (r 3) (r 0)) → ((BandVectors.2 (r 0) (r - 3) = -I * BandVectors.2 (r 3) (r 0)) → ((TileCentroid Rminus - TileCentroid F.tile = (1 / - 2 : ℝ) • GaussianRealPoint ((wv - I * xv) - I * (wv - I * xv))) → (TileCentroid J - - TileCentroid F.tile = - (1 / 2 : ℝ) • GaussianRealPoint (-(yv - I * yv)))))))))))))))))))))))) := by + ∀ (C : BandCircle), + ∀ (orientation : Bool), + ∀ (base : ProtoTile), + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + ∀ (hminus : PartialOdometer), + ∀ (hplus : PartialOdometer), + ∀ + (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus + hplus), + ∀ (D : P4458T1RestrictionFamily F), + ∀ (a : Fin 3), + ((F.slot = a + 2) → + (∀ (J : ProtoTile), + (TileCentroid J = TileCentroid (D.tiles F.slot false)) → + (let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, + F.q (a + 2).succ]; + (let I : GaussianInt := ⟨0, 1⟩; + let yv := BandVectors.1 (r 2) (r 1); + (TileCentroid J - TileCentroid F.tile = + (1 / 2 : ℝ) • + GaussianRealPoint (-(yv - I * yv))))))) := by classical - intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J hcent r hr hrstep r1 - r2 r3 hparentR hzero I wv xv yv wa xa ya laws rr hrr lawsR win ain hv ha vflip aflip vflip' - aflip' centMinus + intro C orientation base Rminus Rplus hminus hplus F D a hslot J hcent r I yv have h := (D.occurrences F.slot false).2.2 have hs2 : F.slot + 2 = a + 1 := by rw [hslot] @@ -1345,8 +1292,7 @@ theorem P4536T1AFrameD p r3 hparent hzero win vflip' have centJ := FrameDiagonalProof.centJ C orientation - base Rminus Rplus hminus hplus F D a p hstep hslot J hcent hr hrstep r1 r2 r3 hparentR - hzero laws hrr lawsR win ain hv ha vflip aflip vflip' aflip' centMinus + base Rminus Rplus hminus hplus F D a hslot J hcent have centK := FrameDiagonalProof.centK C orientation base Rminus Rplus hminus hplus F D a have halfDiff {X Y Z : GaussianInt} (hxy : X - Y = Z) := FrameDiagonalProof.halfDiff (X := X) diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean index b5b2542f85..aa072224f4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean @@ -6,17 +6,15 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeTileNonempty public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance public import LeanPool.ApollonianSuperharmonic.TouchingTripleCovariance -public import LeanPool.ApollonianSuperharmonic.TileCellComplement -public import LeanPool.ApollonianSuperharmonic.QuarterTurnSymmetric public import LeanPool.ApollonianSuperharmonic.DiamondBaseT1 public import LeanPool.ApollonianSuperharmonic.DiamondBaseT2 public import LeanPool.ApollonianSuperharmonic.DiamondBaseTouching -public import LeanPool.ApollonianSuperharmonic.TileArea -- [TABLET NODE: P4564T2DiamondGeometry] @@ -92,22 +90,6 @@ private theorem harea : rw [hT'cells] _ = Int.toNat (q 0).1 := hDarea -private theorem disk_cells_nonempty : - (by - classical - exact - ∀ (X : ProtoTile), (LatticeTile X) → (X.cells.Nonempty) ) := by - classical - intro X hX - unfold LatticeTile TopologicalDisk TileRealization at hX - rcases hX with ⟨e⟩ - have hp : (0 : Real × Real) ∈ - (Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) := by - simp - have hm := (e ⟨(0 : Real × Real), hp⟩).property - simp only [Set.mem_iUnion] at hm - obtain ⟨x, hx⟩ := hm - exact ⟨x, by simpa [TileRealization] using hx.1⟩ private theorem touching_same_cells : (by @@ -875,7 +857,7 @@ theorem P4564T2DiamondGeometry : hobs.2.2.1 have harea := DiamondInterfaceGeometry.harea K T hDarea w hT'cells have disk_cells_nonempty (X : ProtoTile) (hX : LatticeTile X) := - DiamondInterfaceGeometry.disk_cells_nonempty X hX + LatticeTileNonempty.cells X hX have touching_same_cells (A A' B : ProtoTile) (hc : A.cells = A'.cells) (hne : A.cells.Nonempty) (hbv : BoundaryFootprintVertices A = BoundaryFootprintVertices A') diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean index 2e311882e2..543d3c1669 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean @@ -217,18 +217,6 @@ private theorem hmodifiedCommon : simp only [FootprintVertices, hdeletedNe, ite_true, Set.mem_ofPred_eq] exact ⟨z, Finset.mem_sdiff.mpr ⟨hz, hzO⟩, hcorner⟩ -private theorem translation_zero : - (by - classical - exact - ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by - classical - intro U - have hzero : GaussianTranslation (0 : GaussianInt) = id := by - funext z - simp [GaussianTranslation] - cases U - simp [TileTranslation, hzero, GaussianTranslation] private theorem htileA : (by @@ -648,19 +636,6 @@ private theorem hRnonzero : rw [hRcoord] exact cfg.noLine 3 -private theorem touchingDisjoint : - (by - classical - exact - ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → ((Y.cells.Nonempty) → - ((TileTouching X Y) → (Disjoint X.cells Y.cells))) ) := by - classical - intro X Y hX hY hxy - rcases hxy with ⟨_, _, hd, _⟩ | ⟨he, _⟩ | ⟨he, _⟩ - · exact hd - · simp [he] at hX - · simp [he] at hY - private theorem hp1_not : (by classical @@ -997,7 +972,7 @@ theorem P4590T1RestoredBoundaryGeometry : let ib : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ let f2 := cert.modifiedFaceEquivalence.symm ⟨.I2, 0, 0⟩ - have translation_zero := RestoredBoundaryGeometry.translation_zero + have translation_zero := TileTranslationProperties.zero have htileA := RestoredBoundaryGeometry.htileA q cfg C T cert translation_zero have htileB := RestoredBoundaryGeometry.htileB q cfg C T cert translation_zero have hab : ia ≠ ib := by decide @@ -1054,7 +1029,7 @@ theorem P4590T1RestoredBoundaryGeometry : P4590T1PositivePrototileDisk (cfg.firstPredecessor 3) R (cert.plus_occurrence 2 true).1 hRpos have hRne : R.cells.Nonempty := (LatticeTileGridStructure _ hRlat).1.1 - have touchingDisjoint := RestoredBoundaryGeometry.touchingDisjoint + have touchingDisjoint := TileTouchingDisjoint.cells have hSCdisj : Disjoint S.cells Ctile.cells := touchingDisjoint S Ctile hSne hCne cert.double_first.2.1 have hCQdisj : Disjoint Ctile.cells Q.cells := diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean index aa2412ba12..21eb8a0170 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean @@ -254,42 +254,6 @@ private theorem outerBoundary : exact (ProtoTileObservableExtensionality (H (cert.P i true)) (cert.P i false) (outerCells i) hempty).2.1 -private theorem splitInternal : - (by - classical - exact - ∀ (l : List GaussianInt), ∀ (x : GaussianInt), ∀ (h : GaussianInt), ∀ (t : GaussianInt), - l.Nodup → l.head? = some h → l.getLast? = some t → x ∈ l → x ≠ h → x ≠ t → ∃ pre y z - post, l = pre ++ y :: x :: z :: post ) := by - classical - intro l - induction l with - | nil => intro x h t hn hh ht hx; simp at hx - | cons a tail ih => - intro x h t hn hh ht hx hxh hxt - have hah : a = h := by simpa using hh - subst h - rcases List.mem_cons.mp hx with hxa | hx - · exact (hxh hxa).elim - · cases tail with - | nil => simp at hx - | cons b rest => - by_cases hxb : x = b - · subst x - have hrest : rest ≠ [] := by - intro he - subst rest - have hb : b = t := by simpa using ht - exact hxt hb - cases rest with - | nil => exact (hrest rfl).elim - | cons c u => - refine ⟨[], a, c, u, ?_⟩ - simp - · obtain ⟨pre, y, z, post, heq⟩ := - ih x b t hn.tail (by rfl) (by simpa using ht) hx hxb hxt - refine ⟨a :: pre, y, z, post, ?_⟩ - simp [heq] private theorem twoPathEdges : (by @@ -515,18 +479,6 @@ private theorem interfaceConclusion : · exact Or.inl hUcell · exact Or.inr hVcell -private theorem translation_zero : - (by - classical - exact - ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by - classical - intro U - have hzero : GaussianTranslation (0 : GaussianInt) = id := by - funext z - simp [GaussianTranslation] - cases U - simp [TileTranslation, hzero, GaussianTranslation] private theorem htileA : (by @@ -1980,7 +1932,7 @@ private theorem positiveCase : let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ - have translation_zero := RightInteriorGeometry.translation_zero + have translation_zero := TileTranslationProperties.zero have htileA := RightInteriorGeometry.htileA q cfg C T cert translation_zero have htileC := RightInteriorGeometry.htileC q cfg C T cert translation_zero have hOA := RightInteriorGeometry.hOA q cfg C T cert @@ -2134,7 +2086,7 @@ theorem P4590T1RightInteriorGeometry : outerNonempty have outerBoundary := RightInteriorGeometry.outerBoundary q cfg C T cert u outerCells outerNonempty - have twoPathEdges := RightInteriorGeometry.twoPathEdges (RightInteriorGeometry.splitInternal) + have twoPathEdges := RightInteriorGeometry.twoPathEdges (ListEndpointFacts.internalNeighbors) have touching_disjoint := RightInteriorGeometry.touching_disjoint have edgeEndpoint := RightInteriorGeometry.edgeEndpoint have threeBoundaries := RightInteriorGeometry.threeBoundaries (RightInteriorGeometry.rawIncident) diff --git a/LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean b/LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean index 13b4643823..f091f0b94e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean +++ b/LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean @@ -7,8 +7,6 @@ module public import Mathlib.Init -public import LeanPool.ApollonianSuperharmonic.SimpleGridCycle -public import LeanPool.ApollonianSuperharmonic.SimpleGridPath public import LeanPool.ApollonianSuperharmonic.SimpleGridCycleSubgraphDegreeTwo public import LeanPool.ApollonianSuperharmonic.SimpleGridPathVertexIncidentEdge @@ -1187,21 +1185,11 @@ private theorem hcyX : · exact allTail pre a suf hcSplit haX cy hcs private theorem hcShape : - ∀ (V : Set GaussianInt), ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (E : - Set (Finset GaussianInt)), ∀ (a : GaussianInt), ∀ (c : List GaussianInt), ∀ (cx : - GaussianInt), ∀ (cy : GaussianInt), (c.Nodup) → (((4 : ℕ) ≤ c.length) → ((c.head? = some - cx) → ((c.getLast? = some cy) → ((V = (↑c.toFinset : Set GaussianInt)) → ((∀ (a : - GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), - c = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → ((∀ (e : Finset GaussianInt), e ∈ E - ↔ e = {cy, cx} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List - GaussianInt), c = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ( - let X : Set GaussianInt := Kplus ∪ Kminus - (c ≠ []) → ((cx ∈ c) → ((cy ∈ c) → ((∀ pre, ∀ x, ∀ s, c = pre ++ x :: s → x ∈ X → ∀ z, z ∈ s - → z ∈ X) → ((a ∈ c) → (∀ (pre : List GaussianInt), ∀ (suf : List GaussianInt), (c = pre - ++ a :: suf) → (c = cx :: c.tail))))))))))))) := by + ∀ (c : List GaussianInt), + ∀ (cx : GaussianInt), + (((4 : ℕ) ≤ c.length) → ((c.head? = some cx) → (c = cx :: c.tail))) := by classical - intro V Kplus Kminus E a c cx cy hcN hcLen hcHead hcLast hVcyc hcStep hcEdges X hcne hcxList - hcyList allTail haCycle pre suf hcSplit + intro c cx hcLen hcHead cases c with | nil => simp at hcLen | cons z zs => @@ -1431,8 +1419,8 @@ theorem P4651T1CycleComplementaryArcs : have hcloseE : ({cy, cx} : Finset GaussianInt) ∈ E := (hcEdges {cy, cx}).2 (Or.inl rfl) have hcxX := edgeClosure cy hcyX cx hcloseE - have hcShape : c = cx :: c.tail := CycleArcDetails.hcShape V Kplus Kminus E a c cx cy hcN hcLen - hcHead hcLast hVcyc hcStep hcEdges hcne hcxList hcyList allTail haCycle pre suf hcSplit + have hcShape : c = cx :: c.tail := CycleArcDetails.hcShape c cx hcLen + hcHead have hallC : ∀ z, z ∈ c → z ∈ X := CycleArcDetails.hallC Kplus Kminus c cx allTail hcxX hcShape have hVtoX : V ⊆ X := CycleArcDetails.hVtoX V Kplus Kminus c hVcyc hallC have hVparts : V = Kplus ∪ Kminus := by diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean index 530204eadd..2915311956 100644 --- a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean +++ b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean @@ -866,58 +866,132 @@ private theorem commonEdgeForAdjacent : private theorem hcAt922 : (by classical - exact - ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing - L k), ∀ (T : ProtoTile), - let a : L := k (1, 0) - let b : L := k (0, 1) - ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), ∀ (x : ↥L), - let rho : D.plane.Face → GaussianInt := fun f => - match D.faces.symm f with - | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) - | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) - ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), - let rowPath : Fin 3 → List GaussianInt := fun r => - if r = 0 then p0 else if r = 1 then p1 else p2 - (↥L) → ( - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] - (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (fc : D.plane.Face), ∀ (gc : D.plane.Face), ∀ (P - : List GaussianInt), (P4733T1ContainedWalk A B (rho fc) (rho gc) P) → ((path fc gc - = P) → ((path gc fc = P.reverse) → (∀ (f : D.plane.Face), ∀ (g : D.plane.Face), ((f = - fc ∧ g = gc) ∨ (f = gc ∧ g = fc)) → ((path f g).head? = some (rho f) ∧ (path f - g).getLast? = some (rho g) ∧ (∀ z ∈ path f g, z ∈ FootprintVertices A ∩ - FootprintVertices B) ∧ ∀ x y : GaussianInt, ∀ l₁ l₂ : List GaussianInt, path f g = l₁ - ++ x :: y :: l₂ → {x, y} ∈ FootprintEdges A ∩ FootprintEdges B))))) → (∀ (f : - D.plane.Face), ∀ (g : D.plane.Face), - let w := x - let fc := D.faces (.inl w) - let gc := D.faces (.inr (w - b)) - (f = fc ∧ g = gc ∨ f = gc ∧ g = fc) → ((path fc gc = p1.map (fun z => z + (w : - GaussianInt))) → ((path gc fc = (p1.map (fun z => z + (w : GaussianInt))).reverse) → - ((P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) (TileTranslation T ((w - - b : L) : GaussianInt)) (rho fc) (rho gc) (p1.map (fun z => z + (w : GaussianInt)))) - → ((path f g).head? = some (rho f) ∧ (path f g).getLast? = some (rho g) ∧ (∀ z ∈ path - f g, z ∈ FootprintVertices (TileTranslation T ↑w) ∩ FootprintVertices - (TileTranslation T ↑(w - b))) ∧ ∀ x' y' : GaussianInt, ∀ l₁ l₂ : List GaussianInt, - path f g = l₁ ++ x' :: y' :: l₂ → {x', y'} ∈ FootprintEdges (TileTranslation T ↑w) ∩ - FootprintEdges (TileTranslation T ↑(w - b))))))))) := by - classical - intro L k D T a b ru rd x rho p0 p1 p2 rowPath y path walkClaims f g w fc gc hpair hforward + exact + ∀ (L : AddSubgroup GaussianInt), + ∀ (k : (Int × Int) ≃+ L), + ∀ (D : P4812T1AffineDrawing L k), + ∀ (T : ProtoTile), + let a : L := k (1, 0); + let b : L := k (0, 1); + ∀ (ru : GaussianInt), + ∀ (rd : GaussianInt), + ∀ (x : ↥L), + let rho : D.plane.Face → GaussianInt := fun f => + match D.faces.symm f with + | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt); + ∀ (p0 : List GaussianInt), + ∀ (p1 : List GaussianInt), + ∀ (p2 : List GaussianInt), + let rowPath : Fin 3 → List GaussianInt := fun r => + if r = 0 then p0 else if r = 1 then p1 else p2; + (let path : + D.plane.Face → D.plane.Face → List GaussianInt := + fun f g => + by + letI : ∀ p : Prop, Decidable p := + Classical.propDecidable + exact + match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then + (rowPath 0).map (fun z => z + (x : GaussianInt)) + else + if y = x - b then + (rowPath 1).map + (fun z => z + (x : GaussianInt)) + else + if y = x + (a - b) then + (rowPath 2).map + (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then + ((rowPath 0).map + (fun z => z + (x : GaussianInt))).reverse + else + if y = x - b then + ((rowPath 1).map + (fun z => z + (x : GaussianInt))).reverse + else + if y = x + (a - b) then + ((rowPath 2).map + (fun z => + z + (x : GaussianInt))).reverse + else [] + | _, _ => []; + (∀ (A : ProtoTile), + ∀ (B : ProtoTile), + ∀ (fc : D.plane.Face), + ∀ (gc : D.plane.Face), + ∀ (P : List GaussianInt), + (P4733T1ContainedWalk A B (rho fc) (rho gc) + P) → + ((path fc gc = P) → + ((path gc fc = P.reverse) → + (∀ (f : D.plane.Face), + ∀ (g : D.plane.Face), + ((f = fc ∧ g = gc) ∨ + (f = gc ∧ g = fc)) → + ((path f g).head? = + some (rho f) ∧ + (path f g).getLast? = + some (rho g) ∧ + (∀ z ∈ path f g, + z ∈ + FootprintVertices A ∩ + FootprintVertices + B) ∧ + ∀ x y : GaussianInt, + ∀ l₁ l₂ : + List GaussianInt, + path f g = + l₁ ++ + x :: y :: l₂ → + { x, y } ∈ + FootprintEdges A ∩ + FootprintEdges + B))))) → + (∀ (f : D.plane.Face), + ∀ (g : D.plane.Face), + let w := x; + let fc := D.faces (.inl w); + let gc := D.faces (.inr (w - b)); + (f = fc ∧ g = gc ∨ f = gc ∧ g = fc) → + ((path fc gc = + p1.map (fun z => z + (w : GaussianInt))) → + ((path gc fc = + (p1.map + (fun z => + z + (w : GaussianInt))).reverse) → + ((P4733T1ContainedWalk + (TileTranslation T (w : GaussianInt)) + (TileTranslation T + ((w - b : L) : GaussianInt)) + (rho fc) (rho gc) + (p1.map + (fun z => z + (w : GaussianInt)))) → + ((path f g).head? = some (rho f) ∧ + (path f g).getLast? = some (rho g) ∧ + (∀ z ∈ path f g, + z ∈ + FootprintVertices + (TileTranslation T ↑w) ∩ + FootprintVertices + (TileTranslation T + ↑(w - b))) ∧ + ∀ x' y' : GaussianInt, + ∀ l₁ l₂ : List GaussianInt, + path f g = + l₁ ++ x' :: y' :: l₂ → + { x', y' } ∈ + FootprintEdges + (TileTranslation T ↑w) ∩ + FootprintEdges + (TileTranslation T + ↑(w - b))))))))) := by + classical + intro L k D T a b ru rd x rho p0 p1 p2 rowPath path walkClaims f g w fc gc hpair hforward hbackward hw exact walkClaims (TileTranslation T (w : GaussianInt)) (TileTranslation T ((w - b : L) : GaussianInt)) fc gc @@ -2082,7 +2156,7 @@ private theorem secondBackward : path f g = l₁ ++ x' :: y' :: l₂ → {x', y'} ∈ FootprintEdges (TileTranslation T ↑w) ∩ FootprintEdges (TileTranslation T ↑(w - b)) := RegularFaceWalkProof.hcAt922 - L k D T ru rd x p0 p1 p2 y walkClaims f g hpair hforward hbackward hw + L k D T ru rd x p0 p1 p2 walkClaims f g hpair hforward hbackward hw rcases hc with ⟨hh, hl, hv, he⟩ refine ⟨hh, hl, ?_, ?_⟩ · intro z hz diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean index 9f328a944d..32895bb136 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean @@ -6,13 +6,13 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.RootComplexCoordinates public import LeanPool.ApollonianSuperharmonic.P4828T1Root public import LeanPool.ApollonianSuperharmonic.P4828T1Gap public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple public import Mathlib.Analysis.Convex.Combination -public import Mathlib.Analysis.Complex.ReImTopology public import LeanPool.ApollonianSuperharmonic.P4828T1Disk -- [TABLET NODE: P4828T1LeftRootGeometry] @@ -50,62 +50,17 @@ private noncomputable def tl (a : GaussianInt) : Complex := ⟨(L a), (y a) + 2 private noncomputable def tr (a : GaussianInt) : Complex := ⟨(L a) + 1, (y a) + 2⟩ -private theorem hU0 (a : GaussianInt) : ((1 + 2 * a : GaussianInt) : Complex) = ⟨(L a) + 1, (y - a)⟩ := by - classical - let L : Real := 2 * (a.re : Real) - let y : Real := 2 * (a.im : Real) - change (((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩) - rw [GaussianInt.toComplex_def₂] - apply Complex.ext <;> simp [Zsqrtd.re_add, Zsqrtd.re_mul, - Zsqrtd.im_add, Zsqrtd.im_mul, L, y]; ring +private abbrev hU0 := RootComplexCoordinates.lowerGaussianCoordinate -private theorem hU1 (a : GaussianInt) : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = - ⟨(L a) + 1, (y a) + 2⟩ := by - classical - let L : Real := 2 * (a.re : Real) - let y : Real := 2 * (a.im : Real) - change (((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = - ⟨L + 1, y + 2⟩) - rw [GaussianInt.toComplex_def₂] - apply Complex.ext <;> simp [Zsqrtd.re_add, Zsqrtd.re_mul, - Zsqrtd.im_add, Zsqrtd.im_mul, L, y]; ring +private abbrev hU1 := RootComplexCoordinates.upperGaussianCoordinate -private theorem hU0c (a : GaussianInt) : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (a : Complex) = ⟨(L a) + 1, (y a)⟩ := by - classical - let L : Real := 2 * (a.re : Real) - let y : Real := 2 * (a.im : Real) - have hU0 : ((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩ := hU0 a - change ((1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (a : Complex) = ⟨L + 1, y⟩) - rw [GaussianInt.toComplex_add, GaussianInt.toComplex_one] at hU0 - rw [GaussianInt.toComplex_mul] at hU0 - exact hU0 +private abbrev hU0c := RootComplexCoordinates.lowerComplexCoordinate -private theorem hU1c (a : GaussianInt) : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (⟨0, 1⟩ : GaussianInt) = ⟨(L a) + 1, (y a) + 2⟩ := by - classical - let L : Real := 2 * (a.re : Real) - let y : Real := 2 * (a.im : Real) - have hU1 : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = - ⟨L + 1, y + 2⟩ := hU1 a - change ((1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (⟨0, 1⟩ : GaussianInt) = ⟨L + 1, y + 2⟩) - rw [GaussianInt.toComplex_add, GaussianInt.toComplex_add, - GaussianInt.toComplex_one] at hU1 - rw [GaussianInt.toComplex_mul, GaussianInt.toComplex_mul] at hU1 - exact hU1 +private abbrev hU1c := RootComplexCoordinates.upperComplexCoordinate -private theorem htwo_re : (GaussianInt.toComplex (2 : GaussianInt)).re = 2 := by - classical - norm_num [GaussianInt.toComplex_def] +private abbrev htwo_re := RootComplexCoordinates.twoReal -private theorem htwo_im : (GaussianInt.toComplex (2 : GaussianInt)).im = 0 := by - classical - norm_num [GaussianInt.toComplex_def] +private abbrev htwo_im := RootComplexCoordinates.twoImaginary private theorem hvertices (a : GaussianInt) : (vertices a) = {(bl a), (br a), (tl a), (tr a)} := by classical @@ -314,12 +269,7 @@ private theorem hHull (a : GaussianInt) : convexHull Real (vertices a) = ((Set.Icc L (L + 1)) ×ℂ (Set.Icc y (y + 2))) rw [hlin, himageLin, hcornerHull, hrectImageLin] -private theorem rectangleInterior (l u v w : Real) : - interior (Set.Icc l u ×ℂ Set.Icc v w) = - {z : Complex | l < z.re ∧ z.re < u ∧ v < z.im ∧ z.im < w} := by - classical - ext z - simp [Complex.interior_reProdIm, interior_Icc, Complex.mem_reProdIm, Set.mem_Ioo, and_assoc] +private abbrev rectangleInterior := RootComplexCoordinates.rectangleInterior private theorem hInterior (a : GaussianInt) : interior (convexHull Real (vertices a)) = {p : Complex | (L a) < p.re ∧ p.re < (L a) + 1 ∧ (y a) < p.im ∧ p.im < (y a) + 2} := by @@ -423,15 +373,9 @@ private theorem hchild (a : GaussianInt) : · simp [child, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.im_add, Zsqrtd.im_mul, y]; field_simp; ring -private theorem hs25 : Real.sqrt (25 : Real) = 5 := by - classical - rw [show (25 : Real) = 5 * 5 by norm_num] - exact Real.sqrt_mul_self (by norm_num) +private abbrev hs25 := RootComplexCoordinates.sqrtTwentyFive -private theorem hs16 : Real.sqrt (16 : Real) = 4 := by - classical - rw [show (16 : Real) = 4 * 4 by norm_num] - exact Real.sqrt_mul_self (by norm_num) +private abbrev hs16 := RootComplexCoordinates.sqrtSixteen private theorem hdist0 (a : GaussianInt) : dist (child a) (br a) = (5 : Real) / 4 := by classical @@ -496,16 +440,18 @@ theorem P4828T1LeftRootGeometry (a : GaussianInt) : let br : Complex := ⟨L + 1, y⟩ let tl : Complex := ⟨L, y + 2⟩ let tr : Complex := ⟨L + 1, y + 2⟩ - have hU0 : ((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩ := RootGeometryLeft.hU0 a + have hU0 : ((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩ := + RootComplexCoordinates.lowerGaussianCoordinate a have hU1 : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = - ⟨L + 1, y + 2⟩ := RootGeometryLeft.hU1 a + ⟨L + 1, y + 2⟩ := RootComplexCoordinates.upperGaussianCoordinate a have hU0c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (a : Complex) = ⟨L + 1, y⟩ := RootGeometryLeft.hU0c a + (a : Complex) = ⟨L + 1, y⟩ := RootComplexCoordinates.lowerComplexCoordinate a have hU1c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (⟨0, 1⟩ : GaussianInt) = ⟨L + 1, y + 2⟩ := RootGeometryLeft.hU1c a - have htwo_re : (GaussianInt.toComplex (2 : GaussianInt)).re = 2 := RootGeometryLeft.htwo_re - have htwo_im : (GaussianInt.toComplex (2 : GaussianInt)).im = 0 := RootGeometryLeft.htwo_im + (⟨0, 1⟩ : GaussianInt) = ⟨L + 1, y + 2⟩ := RootComplexCoordinates.upperComplexCoordinate a + have htwo_re : (GaussianInt.toComplex (2 : GaussianInt)).re = 2 := RootComplexCoordinates.twoReal + have htwo_im : (GaussianInt.toComplex (2 : GaussianInt)).im = 0 := + RootComplexCoordinates.twoImaginary have hvertices : vertices = {bl, br, tl, tr} := RootGeometryLeft.hvertices a have himage : Complex.equivRealProdLm '' vertices = ({L, L + 1} : Set Real) ×ˢ {y, y + 2} := RootGeometryLeft.himage a @@ -525,7 +471,7 @@ theorem P4828T1LeftRootGeometry (a : GaussianInt) : have rectangleInterior (l u v w : Real) : interior (Set.Icc l u ×ℂ Set.Icc v w) = {z : Complex | l < z.re ∧ z.re < u ∧ v < z.im ∧ z.im < w} := - RootGeometryLeft.rectangleInterior l u v w + RootComplexCoordinates.rectangleInterior l u v w have hInterior : interior (convexHull Real vertices) = {p : Complex | L < p.re ∧ p.re < L + 1 ∧ y < p.im ∧ p.im < y + 2} := RootGeometryLeft.hInterior a @@ -543,8 +489,8 @@ theorem P4828T1LeftRootGeometry (a : GaussianInt) : have hchild : ((q (0 : Fin 4)).2 : Complex) / ((q (0 : Fin 4)).1 : Real) = child := RootGeometryLeft.hchild a - have hs25 : Real.sqrt (25 : Real) = 5 := RootGeometryLeft.hs25 - have hs16 : Real.sqrt (16 : Real) = 4 := RootGeometryLeft.hs16 + have hs25 : Real.sqrt (25 : Real) = 5 := RootComplexCoordinates.sqrtTwentyFive + have hs16 : Real.sqrt (16 : Real) = 4 := RootComplexCoordinates.sqrtSixteen have hdist0 : dist child br = (5 : Real) / 4 := RootGeometryLeft.hdist0 a have hdist1 : dist child tr = (5 : Real) / 4 := RootGeometryLeft.hdist1 a · constructor diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean index 939e3bb7ff..b404bf908a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean @@ -6,13 +6,13 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.RootComplexCoordinates public import LeanPool.ApollonianSuperharmonic.P4828T1Root public import LeanPool.ApollonianSuperharmonic.P4828T1Gap public import LeanPool.ApollonianSuperharmonic.P4828T1LineSupport public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple public import Mathlib.Analysis.Convex.Combination -public import Mathlib.Analysis.Complex.ReImTopology public import LeanPool.ApollonianSuperharmonic.P4828T1Disk -- [TABLET NODE: P4828T1RightRootGeometry] @@ -50,62 +50,17 @@ private noncomputable def tl (a : GaussianInt) : Complex := ⟨(L a) + 1, (y a) private noncomputable def tr (a : GaussianInt) : Complex := ⟨(L a) + 2, (y a) + 2⟩ -private theorem hU0 (a : GaussianInt) : ((1 + 2 * a : GaussianInt) : Complex) = ⟨(L a) + 1, (y - a)⟩ := by - classical - let L : Real := 2 * (a.re : Real) - let y : Real := 2 * (a.im : Real) - change (((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩) - rw [GaussianInt.toComplex_def₂] - apply Complex.ext <;> simp [Zsqrtd.re_add, Zsqrtd.re_mul, - Zsqrtd.im_add, Zsqrtd.im_mul, L, y]; ring +private abbrev hU0 := RootComplexCoordinates.lowerGaussianCoordinate -private theorem hU1 (a : GaussianInt) : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = - ⟨(L a) + 1, (y a) + 2⟩ := by - classical - let L : Real := 2 * (a.re : Real) - let y : Real := 2 * (a.im : Real) - change (((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = - ⟨L + 1, y + 2⟩) - rw [GaussianInt.toComplex_def₂] - apply Complex.ext <;> simp [Zsqrtd.re_add, Zsqrtd.re_mul, - Zsqrtd.im_add, Zsqrtd.im_mul, L, y]; ring +private abbrev hU1 := RootComplexCoordinates.upperGaussianCoordinate -private theorem hU0c (a : GaussianInt) : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (a : Complex) = ⟨(L a) + 1, (y a)⟩ := by - classical - let L : Real := 2 * (a.re : Real) - let y : Real := 2 * (a.im : Real) - have hU0 : ((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩ := hU0 a - change ((1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (a : Complex) = ⟨L + 1, y⟩) - rw [GaussianInt.toComplex_add, GaussianInt.toComplex_one] at hU0 - rw [GaussianInt.toComplex_mul] at hU0 - exact hU0 +private abbrev hU0c := RootComplexCoordinates.lowerComplexCoordinate -private theorem hU1c (a : GaussianInt) : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (⟨0, 1⟩ : GaussianInt) = ⟨(L a) + 1, (y a) + 2⟩ := by - classical - let L : Real := 2 * (a.re : Real) - let y : Real := 2 * (a.im : Real) - have hU1 : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = - ⟨L + 1, y + 2⟩ := hU1 a - change ((1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (⟨0, 1⟩ : GaussianInt) = ⟨L + 1, y + 2⟩) - rw [GaussianInt.toComplex_add, GaussianInt.toComplex_add, - GaussianInt.toComplex_one] at hU1 - rw [GaussianInt.toComplex_mul, GaussianInt.toComplex_mul] at hU1 - exact hU1 +private abbrev hU1c := RootComplexCoordinates.upperComplexCoordinate -private theorem htwo_re : (GaussianInt.toComplex (2 : GaussianInt)).re = 2 := by - classical - norm_num [GaussianInt.toComplex_def] +private abbrev htwo_re := RootComplexCoordinates.twoReal -private theorem htwo_im : (GaussianInt.toComplex (2 : GaussianInt)).im = 0 := by - classical - norm_num [GaussianInt.toComplex_def] +private abbrev htwo_im := RootComplexCoordinates.twoImaginary private theorem hvertices (a : GaussianInt) : (vertices a) = {(bl a), (br a), (tl a), (tr a)} := by classical @@ -322,12 +277,7 @@ private theorem hHull (a : GaussianInt) : convexHull Real (vertices a) = ((Set.Icc (L + 1) (L + 2)) ×ℂ (Set.Icc y (y + 2))) rw [hlin, himageLin, hcornerHull, hrectImageLin] -private theorem rectangleInterior (l u v w : Real) : - interior (Set.Icc l u ×ℂ Set.Icc v w) = - {z : Complex | l < z.re ∧ z.re < u ∧ v < z.im ∧ z.im < w} := by - classical - ext z - simp [Complex.interior_reProdIm, interior_Icc, Complex.mem_reProdIm, Set.mem_Ioo, and_assoc] +private abbrev rectangleInterior := RootComplexCoordinates.rectangleInterior private theorem hInterior (a : GaussianInt) : interior (convexHull Real (vertices a)) = {p : Complex | (L a) + 1 < p.re ∧ p.re < (L a) + 2 ∧ @@ -437,15 +387,9 @@ private theorem hchild (a : GaussianInt) : Zsqrtd.im_mul, y]; field_simp; ring -private theorem hs25 : Real.sqrt (25 : Real) = 5 := by - classical - rw [show (25 : Real) = 5 * 5 by norm_num] - exact Real.sqrt_mul_self (by norm_num) +private abbrev hs25 := RootComplexCoordinates.sqrtTwentyFive -private theorem hs16 : Real.sqrt (16 : Real) = 4 := by - classical - rw [show (16 : Real) = 4 * 4 by norm_num] - exact Real.sqrt_mul_self (by norm_num) +private abbrev hs16 := RootComplexCoordinates.sqrtSixteen private theorem hdist0 (a : GaussianInt) : dist (child a) (bl a) = (5 : Real) / 4 := by classical @@ -511,16 +455,18 @@ theorem P4828T1RightRootGeometry (a : GaussianInt) : let br : Complex := ⟨L + 2, y⟩ let tl : Complex := ⟨L + 1, y + 2⟩ let tr : Complex := ⟨L + 2, y + 2⟩ - have hU0 : ((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩ := RootGeometryRight.hU0 a + have hU0 : ((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩ := + RootComplexCoordinates.lowerGaussianCoordinate a have hU1 : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = - ⟨L + 1, y + 2⟩ := RootGeometryRight.hU1 a + ⟨L + 1, y + 2⟩ := RootComplexCoordinates.upperGaussianCoordinate a have hU0c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (a : Complex) = ⟨L + 1, y⟩ := RootGeometryRight.hU0c a + (a : Complex) = ⟨L + 1, y⟩ := RootComplexCoordinates.lowerComplexCoordinate a have hU1c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (⟨0, 1⟩ : GaussianInt) = ⟨L + 1, y + 2⟩ := RootGeometryRight.hU1c a - have htwo_re : (GaussianInt.toComplex (2 : GaussianInt)).re = 2 := RootGeometryRight.htwo_re - have htwo_im : (GaussianInt.toComplex (2 : GaussianInt)).im = 0 := RootGeometryRight.htwo_im + (⟨0, 1⟩ : GaussianInt) = ⟨L + 1, y + 2⟩ := RootComplexCoordinates.upperComplexCoordinate a + have htwo_re : (GaussianInt.toComplex (2 : GaussianInt)).re = 2 := RootComplexCoordinates.twoReal + have htwo_im : (GaussianInt.toComplex (2 : GaussianInt)).im = 0 := + RootComplexCoordinates.twoImaginary have hvertices : vertices = {bl, br, tl, tr} := RootGeometryRight.hvertices a have himage : Complex.equivRealProdLm '' vertices = ({L + 1, L + 2} : Set Real) ×ˢ {y, y + 2} := RootGeometryRight.himage a @@ -540,7 +486,7 @@ theorem P4828T1RightRootGeometry (a : GaussianInt) : have rectangleInterior (l u v w : Real) : interior (Set.Icc l u ×ℂ Set.Icc v w) = {z : Complex | l < z.re ∧ z.re < u ∧ v < z.im ∧ z.im < w} := - RootGeometryRight.rectangleInterior l u v w + RootComplexCoordinates.rectangleInterior l u v w have hInterior : interior (convexHull Real vertices) = {p : Complex | L + 1 < p.re ∧ p.re < L + 2 ∧ y < p.im ∧ p.im < y + 2} := RootGeometryRight.hInterior a @@ -558,8 +504,8 @@ theorem P4828T1RightRootGeometry (a : GaussianInt) : have hchild : ((q (0 : Fin 4)).2 : Complex) / ((q (0 : Fin 4)).1 : Real) = child := RootGeometryRight.hchild a - have hs25 : Real.sqrt (25 : Real) = 5 := RootGeometryRight.hs25 - have hs16 : Real.sqrt (16 : Real) = 4 := RootGeometryRight.hs16 + have hs25 : Real.sqrt (25 : Real) = 5 := RootComplexCoordinates.sqrtTwentyFive + have hs16 : Real.sqrt (16 : Real) = 4 := RootComplexCoordinates.sqrtSixteen have hdist0 : dist child bl = (5 : Real) / 4 := RootGeometryRight.hdist0 a have hdist1 : dist child tl = (5 : Real) / 4 := RootGeometryRight.hdist1 a · constructor diff --git a/LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean b/LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean index c4c72fa367..6529f9b902 100644 --- a/LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean +++ b/LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.SignSquareProduct public import Mathlib.Topology.MetricSpace.Pseudo.Real public import Mathlib.Analysis.Complex.Norm @@ -42,9 +43,7 @@ private noncomputable abbrev d (A : ℂ) (B : ℂ) (y : ℝ) := A.re + (B.re - A private noncomputable abbrev Q (h : ℝ) (A : ℂ) (B : ℂ) := convexHull ℝ ({A, B, (fA h A), (fB h B)} : Set ℂ) -private theorem hσsq (σ : ℝ) (hσ : σ ^ 2 = 1) : σ * σ = 1 := by - classical - nlinarith [hσ] +private abbrev hσsq := SignSquareProduct.product private noncomputable abbrev T (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) : Set ℂ := by classical @@ -922,7 +921,7 @@ theorem P4953T1QuadrilateralSections (h σ : ℝ) (A B : ℂ) let fB : ℂ := ⟨h, B.im⟩ let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) - have hσsq : σ * σ = 1 := QuadrilateralSectionsConstruction.hσsq σ hσ + have hσsq : σ * σ = 1 := SignSquareProduct.product σ hσ let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} have hconv : Convex ℝ T := QuadrilateralSectionsConstruction.hconv h σ A B hAB diff --git a/LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean b/LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean index 16cb400113..c79349cb71 100644 --- a/LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean +++ b/LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean @@ -6,11 +6,11 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.SignSquareProduct public import Mathlib.Tactic.Positivity public import Mathlib.Topology.MetricSpace.Pseudo.Real public import Mathlib.Analysis.Complex.Norm -public import Mathlib.Analysis.Convex.Hull public import Mathlib.LinearAlgebra.Complex.Module public import Mathlib.LinearAlgebra.AffineSpace.FiniteDimensional public import Mathlib.Analysis.Convex.Combination @@ -72,10 +72,6 @@ private theorem huv (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < x.im) (hxB : x.i change (u < v) exact lt_trans huw hwv -private theorem hσmul (σ : ℝ) (hσ : σ ^ 2 = 1) : σ * σ = 1 := by - classical - nlinarith [hσ] - private theorem hδ (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hgap : 0 < σ * (A.re + (B.re - A.re) * (x.im - A.im) / (B.im - A.im) - x.re)) : 0 < (δ σ A x B) := by classical @@ -504,7 +500,7 @@ private theorem hperturb (σ : ℝ) (A : ℂ) (x : ℂ) (B : ℂ) (hAx : A.im < rw [hy] have hnorm : ‖(t : ℝ) • (z - b i)‖ = |t| * ‖z - b i‖ := by change ‖(t : ℂ) * (z - b i)‖ = _ - simp [Complex.norm_mul, Complex.norm_real, Real.norm_eq_abs, mul_comm] + rw [Complex.norm_mul, Complex.norm_real, Real.norm_eq_abs] rw [hnorm, abs_of_pos ht] calc (ε / (‖z - b i‖ + 1)) * ‖z - b i‖ < diff --git a/LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean b/LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean index b520838bc7..86203ad1b8 100644 --- a/LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean @@ -6,8 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.DiamondFootprintCoordinates -public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence public import LeanPool.ApollonianSuperharmonic.P5124T1BoundaryGeometry public import LeanPool.ApollonianSuperharmonic.SimpleGridPath public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas @@ -27,32 +27,6 @@ namespace ApollonianSuperharmonic namespace CapInterfaceProof -private theorem footprint : - (by - classical - exact - ∀ (k : Nat), ((0 : ℕ) < k) → (∀ (z : GaussianInt), z ∈ FootprintVertices (DiamondTile k) - ↔ (0 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑k : ℤ) ∧ -(↑k : ℤ) ≤ z.re ∧ z.re ≤ (↑k : ℤ) ∧ - -(z.im + (1 : ℤ)) ≤ z.re ∧ z.re ≤ z.im + (1 : ℤ) ∧ -((2 : ℤ) * (↑k : ℤ) - z.im + (1 : - ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * (↑k : ℤ) - z.im + (1 : ℤ)) - ) := by - classical - intro k hk z - rw [(P4194T1DiamondVertexIncidence k hk z).1] - simp only [Fin.exists_fin_succ, Fin.exists_fin_succ, Fin.exists_fin_succ, - Fin.exists_fin_succ] - rw [show LatticeVertexIncidentCell z 0 = z by rfl, - show LatticeVertexIncidentCell z (Fin.succ 0) = z - 1 by rfl, - show LatticeVertexIncidentCell z (Fin.succ 0).succ = z - 1 - ⟨0, 1⟩ by rfl, - show LatticeVertexIncidentCell z (Fin.succ 0).succ.succ = z - ⟨0, 1⟩ by rfl] - rw [(P4194T1DiamondCellRows k z).1, - (P4194T1DiamondCellRows k (z - 1)).1, - (P4194T1DiamondCellRows k (z - 1 - ⟨0, 1⟩)).1, - (P4194T1DiamondCellRows k (z - ⟨0, 1⟩)).1] - simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, - ] - simp [] - omega private theorem bounds : (by @@ -226,7 +200,7 @@ theorem P5203T1CapInterface (k : Nat) (hk : 0 < k) (u : GaussianInt) : -(k : Int) ≤ z.re ∧ z.re ≤ k ∧ -(z.im + 1) ≤ z.re ∧ z.re ≤ z.im + 1 ∧ -(2 * (k : Int) - z.im + 1) ≤ z.re ∧ - z.re ≤ 2 * (k : Int) - z.im + 1 := CapInterfaceProof.footprint k hk z + z.re ≤ 2 * (k : Int) - z.im + 1 := DiamondFootprintCoordinates.coordinates k hk z let D := DiamondTile k let d : GaussianInt := ⟨0, 2 * (k : Int)⟩ let T := TileTranslation D u diff --git a/LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean b/LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean index 3a3153f129..442678f82d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean @@ -6,8 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.DiamondFootprintCoordinates -public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence public import LeanPool.ApollonianSuperharmonic.P5157T1AlternatingStaircase public import LeanPool.ApollonianSuperharmonic.SimpleGridPathEquivariance public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas @@ -27,32 +27,6 @@ namespace ApollonianSuperharmonic namespace DecreasingInterfaceProof -private theorem footprint : - (by - classical - exact - ∀ (k : Nat), ((0 : ℕ) < k) → (∀ (z : GaussianInt), z ∈ FootprintVertices (DiamondTile k) - ↔ (0 : ℤ) ≤ z.im ∧ z.im ≤ (2 : ℤ) * (↑k : ℤ) ∧ -(↑k : ℤ) ≤ z.re ∧ z.re ≤ (↑k : ℤ) ∧ - -(z.im + (1 : ℤ)) ≤ z.re ∧ z.re ≤ z.im + (1 : ℤ) ∧ -((2 : ℤ) * (↑k : ℤ) - z.im + (1 : - ℤ)) ≤ z.re ∧ z.re ≤ (2 : ℤ) * (↑k : ℤ) - z.im + (1 : ℤ)) - ) := by - classical - intro k hk z - rw [(P4194T1DiamondVertexIncidence k hk z).1] - simp only [Fin.exists_fin_succ, Fin.exists_fin_succ, Fin.exists_fin_succ, - Fin.exists_fin_succ] - rw [show LatticeVertexIncidentCell z 0 = z by rfl, - show LatticeVertexIncidentCell z (Fin.succ 0) = z - 1 by rfl, - show LatticeVertexIncidentCell z (Fin.succ 0).succ = z - 1 - ⟨0, 1⟩ by rfl, - show LatticeVertexIncidentCell z (Fin.succ 0).succ.succ = z - ⟨0, 1⟩ by rfl] - rw [(P4194T1DiamondCellRows k z).1, - (P4194T1DiamondCellRows k (z - 1)).1, - (P4194T1DiamondCellRows k (z - 1 - ⟨0, 1⟩)).1, - (P4194T1DiamondCellRows k (z - ⟨0, 1⟩)).1] - simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, - ] - simp [] - omega private theorem boundary : (by @@ -325,7 +299,7 @@ theorem P5203T1DecreasingInterface (k : Nat) (hk : 0 < k) (u : GaussianInt) : -(k : Int) ≤ z.re ∧ z.re ≤ k ∧ -(z.im + 1) ≤ z.re ∧ z.re ≤ z.im + 1 ∧ -(2 * (k : Int) - z.im + 1) ≤ z.re ∧ - z.re ≤ 2 * (k : Int) - z.im + 1 := DecreasingInterfaceProof.footprint k hk z + z.re ≤ 2 * (k : Int) - z.im + 1 := DiamondFootprintCoordinates.coordinates k hk z let D := DiamondTile k let a : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ let T := TileTranslation D u diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean index 4f5d28041b..349bd780a0 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacianProperties public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows @@ -27,17 +28,6 @@ namespace ApollonianSuperharmonic namespace FirstPredecessorCases -private theorem lap_identity : - (by - classical - exact - ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), FourNeighborLaplacian g x = g (x + - (1 : GaussianInt)) - g x + (g (x - (1 : GaussianInt)) - g x) + (g (x + ⟨(0 : ℤ), (1 : - ℤ)⟩) - g x) + (g (x - ⟨(0 : ℤ), (1 : ℤ)⟩) - g x) ) := by - classical - intro g x - unfold FourNeighborLaplacian - ring private theorem endAlgebra : (by @@ -508,34 +498,19 @@ private theorem qPeLt : private theorem qPeEq : (by classical - exact - ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), - let k : Int := K.1 - let d : GaussianInt := ⟨k, 1-k⟩ - let r : GaussianInt := ⟨2*k, 0⟩ - ∀ (p : ℤ), ∀ (q : ℤ), ((1 : ℤ) ≤ p) → ((p ≤ k) → ( - let Q : Int → Int → Int := fun a b => - (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 - (q = p - (1 : ℤ)) → ( - let zA : GaussianInt := ⟨p,p-1⟩ - (zA-r ∈ FootprintVertices (DiamondTile K.1) ↔ p=k) → ((zA = (⟨p,p-1⟩ : GaussianInt)) → ( - let valS : Int := Q (p-k) (p-1-1-(1-k)) - let valC : Int := Q (p-k) (p-1-(1-k)) - ((zA+1)-d = (⟨p+1-k,p+k-2⟩ : GaussianInt)) → (((zA-⟨0,1⟩)-d = (⟨p-k,p+k-3⟩ : - GaussianInt)) → ( - let val0 : Int := Q p (p-1) - let valW : Int := Q (p-1) (p-1) - let valN : Int := Q p p - (f zA = val0) → ((f (zA-1) = valW) → ((f (zA+⟨0,1⟩) = valN) → ((f zA = valC + - (k-1)*(p-1)+B) → ((f (zA+1) = Q (p+1-k) (p-1-(1-k)) + (k-1)*(p-1)+B) → ((f (zA-⟨0,1⟩) - = valS + (k-1)*(p-2)+B) → ((val0 = p*(p-1)/2) → ((valW = (p-1)*(p-2)/2) → ((valN = - p*(p-1)/2) → ((Q p (p-2) = p*(p-1)/2-1) → ((∀ (m : Int), (1-2*m)^2/4 = m^2-m) → - ((valC = (k-p)*(k-p-1)/2-(k-1)^2) → (((p < k) → (Q (p+1-k) (p-1-(1-k)) = - (k-p-1)*(k-p-2)/2-((k-1)^2-(k-1)))) → (p = k → Q (p + (1 : ℤ) - k) (p - (1 : ℤ) - ((1 - : ℤ) - k)) = -((k - (1 : ℤ)) ^ (2 : ℕ) - (k - (1 : ℤ))))))))))))))))))))))) ) := by - classical - intro K f B k d r p q hp1 hpk Q hq zA hComp hzEq valS valC he hs val0 valW valN hC0 hCW hCN - hPcenter hPeast hPsouth qC0 qCW qCN qCS floorOdd qP0 qPeLt hpk' + exact + ∀ (K : DiamondParameter), + let k : Int := K.1; + ∀ (p : ℤ), + (let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int) - 1) / 2 - + (a - b) ^ 2 / 4; + ((∀ (m : Int), (1 - 2 * m) ^ 2 / 4 = m ^ 2 - m) → + (p = k → + Q (p + (1 : ℤ) - k) (p - (1 : ℤ) - ((1 : ℤ) - k)) = + -((k - (1 : ℤ)) ^ (2 : ℕ) - (k - (1 : ℤ))))))) := by + classical + intro K k p Q floorOdd hpk' subst p simp only [Q, Int.natCast_natAbs] rw [show k+1-k = 1 by omega, abs_of_nonneg (show 0 ≤ (1:Int) by omega)] @@ -614,27 +589,43 @@ private theorem tdiffRev : private theorem hEastDiff : (by classical - exact - ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), (∀ (a : Int), ∀ (b - : Int), 1-(b-a)+(b-1)=a) → ((∀ (b : Int), ∀ (c : Int), - -((b-1)^2-(b-1))+(b-1)*(b-1)+c- (0/2-(b-1)^2+(b-1)*(b-1)+c)=b-1) → ( - let k : Int := K.1 - ∀ (p : ℤ), ∀ (q : ℤ), (p ≤ k) → ( - let Q : Int → Int → Int := fun a b => - (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 - (q = p - (1 : ℤ)) → ( - let zA : GaussianInt := ⟨p,p-1⟩ - let valS : Int := Q (p-k) (p-1-1-(1-k)) - let valC : Int := Q (p-k) (p-1-(1-k)) - (f zA = valC + (k-1)*(p-1)+B) → ((f (zA+1) = Q (p+1-k) (p-1-(1-k)) + (k-1)*(p-1)+B) → - ((valC = (k-p)*(k-p-1)/2-(k-1)^2) → (((p < k) → (Q (p+1-k) (p-1-(1-k)) = - (k-p-1)*(k-p-2)/2-((k-1)^2-(k-1)))) → (((p = k) → (Q (p+1-k) (p-1-(1-k)) = - -((k-1)^2-(k-1)))) → ((valS = (k-p)*(k-p-1)/2-((k-1)^2-(k-1))) → ((∀ (a : Int), - (a-1)*(a-2)/2-a*(a-1)/2 = 1-a) → (f (zA+1)-f zA = if p=k then k-1 else p))))))))))) ) - := by - classical - intro K f B eastAlgebra endAlgebraB k p q hpk Q hq zA valS valC hPcenter hPeast qP0 qPeLt qPeEq - qPs tdiffRev + exact + ∀ (K : DiamondParameter), + ∀ (f : IntegerLatticeFunction), + ∀ (B : Int), + (∀ (a : Int), ∀ (b : Int), 1 - (b - a) + (b - 1) = a) → + ((∀ (b : Int), + ∀ (c : Int), + -((b - 1) ^ 2 - (b - 1)) + (b - 1) * (b - 1) + c - + (0 / 2 - (b - 1) ^ 2 + (b - 1) * (b - 1) + c) = + b - 1) → + (let k : Int := K.1; + ∀ (p : ℤ), + (p ≤ k) → + (let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int) - 1) / 2 - + (a - b) ^ 2 / 4; + (let zA : GaussianInt := ⟨p, p - 1⟩; + let valC : Int := Q (p - k) (p - 1 - (1 - k)); + (f zA = valC + (k - 1) * (p - 1) + B) → + ((f (zA + 1) = + Q (p + 1 - k) (p - 1 - (1 - k)) + (k - 1) * (p - 1) + + B) → + ((valC = (k - p) * (k - p - 1) / 2 - (k - 1) ^ 2) → + (((p < k) → + (Q (p + 1 - k) (p - 1 - (1 - k)) = + (k - p - 1) * (k - p - 2) / 2 - + ((k - 1) ^ 2 - (k - 1)))) → + (((p = k) → + (Q (p + 1 - k) (p - 1 - (1 - k)) = + -((k - 1) ^ 2 - (k - 1)))) → + ((∀ (a : Int), + (a - 1) * (a - 2) / 2 - a * (a - 1) / 2 = + 1 - a) → + (f (zA + 1) - f zA = + if p = k then k - 1 else p))))))))))) := by + classical + intro K f B eastAlgebra endAlgebraB k p hpk Q zA valC hPcenter hPeast qP0 qPeLt qPeEq tdiffRev by_cases hp : p=k · rw [hPeast, hPcenter, qPeEq hp, qP0] rw [hp] @@ -830,7 +821,7 @@ theorem P5352T2Predecessor0 (K : DiamondParameter) (hk : 1 < K.1) exact (by classical have lap_identity (g : IntegerLatticeFunction) (x : GaussianInt) := - FirstPredecessorCases.lap_identity g x + FourNeighborLaplacianProperties.differences g x have subDiff {a b c d : Int} (hab : a=b) (hcd : c=d) : a-c = b-d := by rw [hab, hcd] have eastAlgebra (a b : Int) : 1-(b-a)+(b-1)=a := by ring @@ -950,16 +941,15 @@ theorem P5352T2Predecessor0 (K : DiamondParameter) (hk : 1 < K.1) have floorOdd (m : Int) := FirstPredecessorCases.floorOdd K f B p q m have qP0 := FirstPredecessorCases.qP0 K f B p q hpk hq floorEven have qPeLt (hpk' : p < k) := FirstPredecessorCases.qPeLt K f B p q hq floorOdd hpk' - have qPeEq (hpk' : p = k) := FirstPredecessorCases.qPeEq K f B p q hp1 hpk hq hComp hzEq he - hs hC0 hCW hCN hPcenter hPeast hPsouth qC0 qCW qCN qCS floorOdd qP0 qPeLt hpk' + have qPeEq (hpk' : p = k) := FirstPredecessorCases.qPeEq K p floorOdd hpk' have qPs := FirstPredecessorCases.qPs K f B p q hpk hq floorOdd have hQdelta : valS - valC = k-1 := by linear_combination qPs-qP0 have tri (a : Int) := FirstPredecessorCases.tri K f B p q a have tdiff (a : Int) := FirstPredecessorCases.tdiff K f B p q tri a have tdiffRev (a : Int) := FirstPredecessorCases.tdiffRev K f B p q tdiff a - have hEastDiff := FirstPredecessorCases.hEastDiff K f B eastAlgebra endAlgebraB p q hpk hq - hPcenter hPeast qP0 qPeLt qPeEq qPs tdiffRev + have hEastDiff := FirstPredecessorCases.hEastDiff K f B eastAlgebra endAlgebraB p hpk + hPcenter hPeast qP0 qPeLt qPeEq tdiffRev have hWestDiff := FirstPredecessorCases.hWestDiff f subDiff p hC0 hCW qC0 qCW tdiffRev have hNorthDiff := FirstPredecessorCases.hNorthDiff f subDiff p hC0 hCN qC0 qCN have hSouthDiff := FirstPredecessorCases.hSouthDiff K f B subDiff productGap p hPcenter diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean index 04dd70d480..28a16bc9ca 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.EvenSquareQuotient +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacianProperties public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows @@ -27,17 +29,6 @@ namespace ApollonianSuperharmonic namespace FirstPredecessorProof -private theorem lap_identity : - (by - classical - exact - ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), FourNeighborLaplacian g x = g (x + - (1 : GaussianInt)) - g x + (g (x - (1 : GaussianInt)) - g x) + (g (x + ⟨(0 : ℤ), (1 : - ℤ)⟩) - g x) + (g (x - ⟨(0 : ℤ), (1 : ℤ)⟩) - g x) ) := by - classical - intro g x - unfold FourNeighborLaplacian - ring private theorem predMem : (by @@ -336,15 +327,6 @@ private theorem hPnval : have hv := hPval _ _ (by rw [hnarg]; exact hPn) hnarg simpa using hv -private theorem sqEven : - (by - classical - exact - ∀ (m : ℤ), ((2 : ℤ) * m) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) ) := by - classical - intro m - have h := P4207T1FloorArithmetic.1 0 m - simpa using h private theorem sqOdd : (by @@ -701,7 +683,7 @@ theorem P5352T2Predecessor1 (K : DiamondParameter) (hk : 1 < K.1) exact (by classical have lap_identity (g : IntegerLatticeFunction) (x : GaussianInt) := - FirstPredecessorProof.lap_identity g x + FourNeighborLaplacianProperties.differences g x let k : Int := K.1 let d : GaussianInt := ⟨k,k+1⟩ let r : GaussianInt := ⟨2*k,0⟩ @@ -822,7 +804,7 @@ theorem P5352T2Predecessor1 (K : DiamondParameter) (hk : 1 < K.1) have qn : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k+1-p⟩=Q (p-k) (k+1-p) := by simpa [Q] using (P5352T2DomainRows ⟨K.1-1,by omega⟩ ⟨p-k,k+1-p⟩).2 hPn -- The exact four increments follow by reducing the even and odd squares. - have sqEven (m : Int) := FirstPredecessorProof.sqEven m + have sqEven (m : Int) := EvenSquareQuotient.square m have sqOdd (m : Int) := FirstPredecessorProof.sqOdd K hk f B p hcast m have tri (a : Int) := FirstPredecessorProof.tri K hk f B p hcast a have tdiff (a : Int) := FirstPredecessorProof.tdiff K hk f B diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean index fc17c960cd..776998fd53 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.EvenSquareQuotient +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacianProperties public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows @@ -27,18 +29,6 @@ namespace ApollonianSuperharmonic namespace SecondPredecessorProof -private theorem lap_identity : - (by - classical - exact - ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), FourNeighborLaplacian g x = g (x + - (1 : GaussianInt)) - g x + (g (x - (1 : GaussianInt)) - g x) + (g (x + ⟨(0 : ℤ), (1 : - ℤ)⟩) - g x) + (g (x - ⟨(0 : ℤ), (1 : ℤ)⟩) - g x) ) := by - classical - intro g x - unfold FourNeighborLaplacian - ring - private theorem childValue : (by classical @@ -178,15 +168,6 @@ private theorem tdiffRev : have h := tdiff n omega -private theorem floorEven : - (by - classical - exact - ∀ (m : ℤ), ((2 : ℤ) * m) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) ) := by - classical - intro m - have h := P4207T1FloorArithmetic.1 0 m - simpa using h private theorem floorOdd : (by @@ -958,7 +939,7 @@ theorem P5352T2Predecessor2 (K : DiamondParameter) (hk : 1 < K.1) have lap_identity (g : IntegerLatticeFunction) (x : GaussianInt) : FourNeighborLaplacian g x = (g (x+1)-g x)+(g (x-1)-g x)+ - (g (x+⟨0,1⟩)-g x)+(g (x-⟨0,1⟩)-g x) := SecondPredecessorProof.lap_identity g x + (g (x+⟨0,1⟩)-g x)+(g (x-⟨0,1⟩)-g x) := FourNeighborLaplacianProperties.differences g x let k : Int := K.1 let d : GaussianInt := ⟨-k,k+1⟩ let r : GaussianInt := ⟨-2*k,0⟩ @@ -1022,7 +1003,7 @@ theorem P5352T2Predecessor2 (K : DiamondParameter) (hk : 1 < K.1) have tri (n : Int) := SecondPredecessorProof.tri K a b n have tdiff (n : Int) := SecondPredecessorProof.tdiff K a b tri n have tdiffRev (n : Int) := SecondPredecessorProof.tdiffRev K a b tdiff n - have floorEven (m : Int) := SecondPredecessorProof.floorEven m + have floorEven (m : Int) := EvenSquareQuotient.square m have floorOdd (m : Int) := SecondPredecessorProof.floorOdd K a b m have ht := SecondPredecessorProof.ht K a b hdpred hcast hdchild diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean index 7a2fddb6be..d7233b04e6 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean @@ -516,49 +516,16 @@ private theorem qPredWlt : private theorem qPredWeq : (by classical - exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : - Int), - let k : Int := K.1 - let child := P5352T2Sources K hk 0 - let pred := P5352T2Sources K hk 3 - let d : GaussianInt := ⟨-k, 1-k⟩ - let r : GaussianInt := ⟨-2*k, 0⟩ - let Q : Int → Int → Int := fun a b => - (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 - (∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (∀ (t : ℤ), ((1 : ℤ) ≤ t) → ((t ≤ k) → ((⟨-t, t - (1 - : ℤ)⟩ ∈ FootprintVertices child.1) → ((⟨-t, t - (1 : ℤ)⟩ - d ∈ FootprintVertices - pred.1) → ((∀ (y : GaussianInt), y = ⟨-t, t - (1 : ℤ)⟩ ∨ y = ⟨-t, t - (1 : ℤ)⟩ + (1 : - GaussianInt) ∨ y = ⟨-t, t - (1 : ℤ)⟩ - (1 : GaussianInt) ∨ y = ⟨-t, t - (1 : ℤ)⟩ + - ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨-t, t - (1 : ℤ)⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ - FootprintVertices child.1 ∨ y - d ∈ FootprintVertices pred.1) → (((0 : ℤ) ≤ t - (1 : - ℤ) ∧ t - (1 : ℤ) ≤ (2 : ℤ) * (↑K.1 : ℤ) ∧ -(↑K.1 : ℤ) ≤ -t ∧ -t ≤ (↑K.1 : ℤ) ∧ -(t - - (1 : ℤ)) - (1 : ℤ) ≤ -t ∧ -t ≤ t - (1 : ℤ) + (1 : ℤ) ∧ -((2 : ℤ) * (↑K.1 : ℤ) - (t - - (1 : ℤ)) + (1 : ℤ)) ≤ -t ∧ -t ≤ (2 : ℤ) * (↑K.1 : ℤ) - (t - (1 : ℤ)) + (1 : ℤ)) → - (((0 : ℤ) ≤ t - (1 : ℤ) - ((1 : ℤ) - k) ∧ t - (1 : ℤ) - ((1 : ℤ) - k) ≤ (2 : ℤ) * (k - - (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ -t - -k ∧ -t - -k ≤ k - (1 : ℤ) ∧ -(t - (1 : ℤ) - ((1 : - ℤ) - k)) - (1 : ℤ) ≤ -t - -k ∧ -t - -k ≤ t - (1 : ℤ) - ((1 : ℤ) - k) + (1 : ℤ) ∧ -((2 - : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) ≤ -t - -k ∧ -t - -k ≤ - (2 : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) → ( - let x : GaussianInt := ⟨-t,t-1⟩ - (x-r ∈ FootprintVertices (DiamondTile K.1) ↔ t=k) → ((x ∈ FootprintVertices (DiamondTile - K.1)) → (((⟨1-t,t-1⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → - (((⟨-t,t⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → ((x-d ∈ - FootprintVertices (DiamondTile (K.1-1))) → (((⟨k-t-1,k+t-2⟩ : GaussianInt) ∈ - FootprintVertices (DiamondTile (K.1-1))) → (((⟨k-t,k+t-3⟩ : GaussianInt) ∈ - FootprintVertices (DiamondTile (K.1-1))) → ((f x = Q (-t) (t-1)) → ((f (⟨1-t,t-1⟩ : - GaussianInt) = Q (1-t) (t-1)) → ((f (⟨-t,t⟩ : GaussianInt) = Q (-t) t) → ((f x = Q - (k-t) (k+t-2) + (1-k)*(-t) - (t-1)+B) → ((f (⟨-t-1,t-1⟩ : GaussianInt) = Q (k-t-1) - (k+t-2) + (1-k)*(-t-1) - (t-1)+B) → ((f (⟨-t,t-2⟩ : GaussianInt) = Q (k-t) (k+t-3) + - (1-k)*(-t) - (t-2)+B) → ((Q (-t) (t-1) = -(t*(t-1)/2)) → ((Q (1-t) (t-1) = - -(t*(t-1)/2)) → ((Q (-t) t = -(t*(t+1)/2)) → ((Q (k-t) (k+t-2) = - (k-t)*(k-t-1)/2-(t-1)^2) → (((t + (Int.natAbs a : Int) * ((Int.natAbs a : Int) - 1) / 2 - (a - b) ^ 2 / 4; + (∀ (m : Int), (1 - 2 * m) ^ 2 / 4 = m ^ 2 - m) → + (∀ (t : ℤ), + (t = k → Q (k - t - (1 : ℤ)) (k + t - (2 : ℤ)) = -(t * t - t)))) := by + classical + intro K k Q floorOdd t ht subst t simp only [Q, Int.natCast_natAbs] have ha : k-k-1 = (-1 : Int) := by omega @@ -609,51 +576,37 @@ private theorem hEastDiff : private theorem hWestDiff : (by classical - exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : - Int), - let k : Int := K.1 - let child := P5352T2Sources K hk 0 - let pred := P5352T2Sources K hk 3 - let d : GaussianInt := ⟨-k, 1-k⟩ - let r : GaussianInt := ⟨-2*k, 0⟩ - let Q : Int → Int → Int := fun a b => - (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 - (((K.1-1 : Nat) : Int) = k-1) → (∀ (t : ℤ), ((1 : ℤ) ≤ t) → ((t ≤ k) → ((⟨-t, t - (1 : - ℤ)⟩ ∈ FootprintVertices child.1) → ((⟨-t, t - (1 : ℤ)⟩ - d ∈ FootprintVertices - pred.1) → ((∀ (y : GaussianInt), y = ⟨-t, t - (1 : ℤ)⟩ ∨ y = ⟨-t, t - (1 : ℤ)⟩ + (1 : - GaussianInt) ∨ y = ⟨-t, t - (1 : ℤ)⟩ - (1 : GaussianInt) ∨ y = ⟨-t, t - (1 : ℤ)⟩ + - ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨-t, t - (1 : ℤ)⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ - FootprintVertices child.1 ∨ y - d ∈ FootprintVertices pred.1) → (((0 : ℤ) ≤ t - (1 : - ℤ) ∧ t - (1 : ℤ) ≤ (2 : ℤ) * (↑K.1 : ℤ) ∧ -(↑K.1 : ℤ) ≤ -t ∧ -t ≤ (↑K.1 : ℤ) ∧ -(t - - (1 : ℤ)) - (1 : ℤ) ≤ -t ∧ -t ≤ t - (1 : ℤ) + (1 : ℤ) ∧ -((2 : ℤ) * (↑K.1 : ℤ) - (t - - (1 : ℤ)) + (1 : ℤ)) ≤ -t ∧ -t ≤ (2 : ℤ) * (↑K.1 : ℤ) - (t - (1 : ℤ)) + (1 : ℤ)) → - (((0 : ℤ) ≤ t - (1 : ℤ) - ((1 : ℤ) - k) ∧ t - (1 : ℤ) - ((1 : ℤ) - k) ≤ (2 : ℤ) * (k - - (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ -t - -k ∧ -t - -k ≤ k - (1 : ℤ) ∧ -(t - (1 : ℤ) - ((1 : - ℤ) - k)) - (1 : ℤ) ≤ -t - -k ∧ -t - -k ≤ t - (1 : ℤ) - ((1 : ℤ) - k) + (1 : ℤ) ∧ -((2 - : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) ≤ -t - -k ∧ -t - -k ≤ - (2 : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) → ( - let x : GaussianInt := ⟨-t,t-1⟩ - (x-r ∈ FootprintVertices (DiamondTile K.1) ↔ t=k) → ((x ∈ FootprintVertices (DiamondTile - K.1)) → (((⟨1-t,t-1⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → - (((⟨-t,t⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → ((x-d ∈ - FootprintVertices (DiamondTile (K.1-1))) → (((⟨k-t-1,k+t-2⟩ : GaussianInt) ∈ - FootprintVertices (DiamondTile (K.1-1))) → (((⟨k-t,k+t-3⟩ : GaussianInt) ∈ - FootprintVertices (DiamondTile (K.1-1))) → ((f x = Q (-t) (t-1)) → ((f (⟨1-t,t-1⟩ : - GaussianInt) = Q (1-t) (t-1)) → ((f (⟨-t,t⟩ : GaussianInt) = Q (-t) t) → ((f x = Q - (k-t) (k+t-2) + (1-k)*(-t) - (t-1)+B) → ((f (⟨-t-1,t-1⟩ : GaussianInt) = Q (k-t-1) - (k+t-2) + (1-k)*(-t-1) - (t-1)+B) → ((f (⟨-t,t-2⟩ : GaussianInt) = Q (k-t) (k+t-3) + - (1-k)*(-t) - (t-2)+B) → ((∀ (n : Int), n*(n-1)/2-(n-1)*(n-2)/2=n-1) → ((Q (-t) (t-1) - = -(t*(t-1)/2)) → ((Q (1-t) (t-1) = -(t*(t-1)/2)) → ((Q (-t) t = -(t*(t+1)/2)) → ((Q - (k-t) (k+t-2) = (k-t)*(k-t-1)/2-(t-1)^2) → (((t + (Int.natAbs a : Int) * ((Int.natAbs a : Int) - 1) / 2 - + (a - b) ^ 2 / 4; + (∀ (t : ℤ), + ((t ≤ k) → + (let x : GaussianInt := ⟨-t, t - 1⟩; + ((f x = Q (-t) (t - 1)) → + ((f (⟨-t - 1, t - 1⟩ : GaussianInt) = + Q (k - t - 1) (k + t - 2) + (1 - k) * (-t - 1) - (t - 1) + + B) → + ((∀ (n : Int), + n * (n - 1) / 2 - (n - 1) * (n - 2) / 2 = n - 1) → + ((Q (k - t) (k + t - 2) = + (k - t) * (k - t - 1) / 2 - (t - 1) ^ 2) → + (((t < k) → + (Q (k - t - 1) (k + t - 2) = + (k - t - 1) * (k - t - 2) / 2 - (t * t - t))) → + (((t = k) → + (Q (k - t - 1) (k + t - 2) = -(t * t - t))) → + ((Q (-t) (t - 1) = + Q (k - t) (k + t - 2) + (1 - k) * (-t) - (t - 1) + + B) → + (f (x - 1) - f x = + if t = k then 0 else 1)))))))))))) := by + classical + intro K f B k Q t htk x hChildC hPredW tdiff qPredC qPredWlt qPredWeq hAgree have hw : x-1 = ⟨-t-1,t-1⟩ := by ext <;> simp [x] rw [hw, hPredW, hChildC, hAgree] by_cases ht : t=k @@ -990,16 +943,13 @@ theorem P5352T2Predecessor3 (K : DiamondParameter) (hk : 1 < K.1) have qPredC := FourthPredecessorCases.qPredC K f B hkm floorEven t htk hChildC hPredC hPredW have qPredWlt (ht : t dsimp <;> omega -private theorem tri : - (by - classical - exact - (DiamondParameter) → (∀ (a : ℤ), (2 : ℤ) * (a * (a - (1 : ℤ)) / (2 : ℤ)) = a * (a - (1 : - ℤ))) ) := by - classical - intro K a - rcases Int.emod_two_eq_zero_or_one a with h | h - · have ha : a = 2*(a/2) := by omega - rw [ha] - rw [show 2*(a/2)*(2*(a/2)-1) = 2*((a/2)*(2*(a/2)-1)) by ring, - Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] - · have ha : a = 2*(a/2)+1 := by omega - rw [ha] - rw [show (2*(a/2)+1)*(2*(a/2)+1-1) = 2*((2*(a/2)+1)*(a/2)) by ring, - Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] - -private theorem square : - (by - classical - exact - (DiamondParameter) → (∀ (a : ℤ), (4 : ℤ) * (a ^ (2 : ℕ) / (4 : ℤ)) = a ^ (2 : ℕ) - a % (2 - : ℤ)) ) := by - classical - intro K a - rcases Int.emod_two_eq_zero_or_one a with h | h - · have ha : a = 2*(a/2) := by omega - have he : a^2 = 4*(a/2)^2 := by - conv_lhs => rw [ha] - ring - rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (4:Int) ≠ 0), h] - ring - · have ha : a = 2*(a/2)+1 := by omega - have he : a^2 = 4*((a/2)^2+a/2)+1 := by - conv_lhs => rw [ha] - ring - rw [he, h] - omega - -private theorem scale : - (by - classical - exact - let Q (a b : Int) : Int := - (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 - let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 - (∀ (a : Int), 2*(a*(a-1)/2) = a*(a-1)) → ((∀ (a : Int), 4*(a^2/4) = a^2-a%2) → (∀ (a : - ℤ), ∀ (b : ℤ), (4 : ℤ) * Q a b = S a b)) ) := by - classical - intro Q S tri square a b - have ht := tri (Int.natAbs a : Int) - have hs := square (a-b) - have ha : (Int.natAbs a : Int)^2 = a^2 := by - rw [Int.natCast_natAbs, sq_abs] - dsimp [Q, S] - rw [Int.natCast_natAbs] at ht ha ⊢ - nlinarith only [ht, hs, ha] - -private theorem sEven : - (by - classical - exact - (DiamondParameter) → ( - let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 - ∀ (a : ℤ), ∀ (b : ℤ), ∀ (m : ℤ), a - b = (2 : ℤ) * m → S a b = (2 : ℤ) * a ^ (2 : ℕ) - (2 - : ℤ) * |a| - (4 : ℤ) * m ^ (2 : ℕ)) ) := by - classical - intro K S a b m h - dsimp [S] - rw [h, show (2*m)%2 = 0 by omega] - ring -private theorem sOdd : - (by - classical - exact - (DiamondParameter) → ( - let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 - ∀ (a : ℤ), ∀ (b : ℤ), ∀ (m : ℤ), a - b = (2 : ℤ) * m + (1 : ℤ) → S a b = (2 : ℤ) * a ^ (2 - : ℕ) - (2 : ℤ) * |a| - (4 : ℤ) * m ^ (2 : ℕ) - (4 : ℤ) * m) ) := by - classical - intro K S a b m h - dsimp [S] - rw [h, show (2*m+1)%2 = 1 by omega] - ring + + private theorem valR : (by @@ -189,22 +107,6 @@ private theorem valR : dsimp [Q] ring -private theorem diffC : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), - let Q (a b : Int) : Int := - (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 - let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 - (∀ (a : Int), ∀ (b : Int), 4*Q a b = S a b) → ((∀ (x : GaussianInt), (x ∈ - FootprintVertices (DiamondTile K.1)) → (f x = Q x.re x.im)) → (∀ (x : GaussianInt), ∀ - (y : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) → y ∈ FootprintVertices - (DiamondTile K.1) → (4 : ℤ) * (f y - f x) = S y.re y.im - S x.re x.im)) ) := by - classical - intro K f Q S scale valC x y hx hy - rw [valC x hx, valC y hy] - linear_combination scale y.re y.im - scale x.re x.im private theorem diffR : (by @@ -229,18 +131,6 @@ private theorem diffR : linear_combination scale (y.re-rho.re) (y.im-rho.im) - scale (x.re-rho.re) (x.im-rho.im) -private theorem lap : - (by - classical - exact - ∀ (f : IntegerLatticeFunction), ∀ (x : GaussianInt), FourNeighborLaplacian f x = f (x + - (1 : GaussianInt)) - f x + (f (x - (1 : GaussianInt)) - f x) + (f (x + ⟨(0 : ℤ), (1 : - ℤ)⟩) - f x) + (f (x - ⟨(0 : ℤ), (1 : ℤ)⟩) - f x) ) := by - classical - intro f x - unfold FourNeighborLaplacian - ring - private theorem cellsAt260 : (by classical @@ -720,19 +610,20 @@ theorem P5352T2RightFirst (K : DiamondParameter) (hk : 1 < K.1) let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 - have tri (a : Int) := DiamondRightFirst.tri K a - have square (a : Int) := DiamondRightFirst.square K a + have tri (a : Int) := DiamondQuadraticArithmetic.triangularScale a + have square (a : Int) := DiamondQuadraticArithmetic.squareScale a -- Scaling removes both divisions, including for negative odd arguments. - have scale (a b : Int) := DiamondRightFirst.scale tri square a b - have sEven (a b m : Int) (h : a-b = 2*m) := DiamondRightFirst.sEven K a b m h - have sOdd (a b m : Int) (h : a-b = 2*m+1) := DiamondRightFirst.sOdd K a b m h + have scale (a b : Int) := DiamondQuadraticArithmetic.quadraticScale tri square a b + have sEven (a b m : Int) (h : a-b = 2*m) := DiamondQuadraticArithmetic.evenDifference a b m h + have sOdd (a b m : Int) (h : a-b = 2*m+1) := DiamondQuadraticArithmetic.oddDifference a b m h have valC (x : GaussianInt) (hx : x ∈ FootprintVertices (DiamondTile K.1)) : f x = Q x.re x.im := (hC x hx).trans ((P5352T2DomainRows K x).2 hx) have valR (x : GaussianInt) (hx : x-rho ∈ FootprintVertices (DiamondTile K.1)) := DiamondRightFirst.valR K f B hR x hx have diffC (x y : GaussianInt) (hx : x ∈ FootprintVertices (DiamondTile K.1)) - (hy : y ∈ FootprintVertices (DiamondTile K.1)) := DiamondRightFirst.diffC K f scale valC + (hy : y ∈ FootprintVertices (DiamondTile K.1)) := + DiamondQuadraticArithmetic.differenceScale K f scale valC x y hx hy -- Subtract in the same translated source so B cancels. have diffR (x y : GaussianInt) @@ -741,7 +632,7 @@ theorem P5352T2RightFirst (K : DiamondParameter) (hk : 1 < K.1) valR x y hx hy have lap (x : GaussianInt) : FourNeighborLaplacian f x = (f (x+1)-f x)+(f (x-1)-f x)+ - (f (x+⟨0,1⟩)-f x)+(f (x-⟨0,1⟩)-f x) := DiamondRightFirst.lap f x + (f (x+⟨0,1⟩)-f x)+(f (x-⟨0,1⟩)-f x) := FourNeighborLaplacianProperties.differences f x rcases contact with ⟨t,ht0,htk,rfl⟩ | ⟨t,ht0,htk,rfl⟩ · have cells : covered ⟨-k+t,k+t+1⟩ ↔ 0 < t := DiamondRightFirst.cellsAt260 K hk cell fourCells t ht0 htk diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean b/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean index 0ec621323e..d7f4874c7f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean @@ -6,10 +6,11 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacianProperties +public import LeanPool.ApollonianSuperharmonic.DiamondQuadraticArithmetic public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows -public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import LeanPool.ApollonianSuperharmonic.P5352T2Sources -- [TABLET NODE: P5352T2RightSecond] @@ -265,92 +266,9 @@ private theorem footBS : dsimp [rho] omega -private theorem tri : - (by - classical - exact - (DiamondParameter) → (∀ (a : ℤ), (2 : ℤ) * (a * (a - (1 : ℤ)) / (2 : ℤ)) = a * (a - (1 : - ℤ))) ) := by - classical - intro K a - rcases Int.emod_two_eq_zero_or_one a with h | h - · have ha : a = 2*(a/2) := by omega - rw [ha] - rw [show 2*(a/2)*(2*(a/2)-1) = 2*((a/2)*(2*(a/2)-1)) by ring, - Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] - · have ha : a = 2*(a/2)+1 := by omega - rw [ha] - rw [show (2*(a/2)+1)*(2*(a/2)+1-1) = 2*((2*(a/2)+1)*(a/2)) by ring, - Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] - -private theorem square : - (by - classical - exact - (DiamondParameter) → (∀ (a : ℤ), (4 : ℤ) * (a ^ (2 : ℕ) / (4 : ℤ)) = a ^ (2 : ℕ) - a % (2 - : ℤ)) ) := by - classical - intro K a - rcases Int.emod_two_eq_zero_or_one a with h | h - · have ha : a = 2*(a/2) := by omega - have he : a^2 = 4*(a/2)^2 := by - conv_lhs => rw [ha] - ring - rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (4:Int) ≠ 0), h] - ring - · have ha : a = 2*(a/2)+1 := by omega - have he : a^2 = 4*((a/2)^2+a/2)+1 := by - conv_lhs => rw [ha] - ring - rw [he, h] - omega - -private theorem scale : - (by - classical - exact - let Q (a b : Int) : Int := - (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 - let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 - (∀ (a : Int), 2*(a*(a-1)/2) = a*(a-1)) → ((∀ (a : Int), 4*(a^2/4) = a^2-a%2) → (∀ (a : - ℤ), ∀ (b : ℤ), (4 : ℤ) * Q a b = S a b)) ) := by - classical - intro Q S tri square a b - have ht := tri (Int.natAbs a : Int) - have hs := square (a-b) - have ha : (Int.natAbs a : Int)^2 = a^2 := by - rw [Int.natCast_natAbs, sq_abs] - dsimp [Q, S] - rw [Int.natCast_natAbs] at ht ha ⊢ - nlinarith only [ht, hs, ha] - -private theorem sEven : - (by - classical - exact - (DiamondParameter) → ( - let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 - ∀ (a : ℤ), ∀ (b : ℤ), ∀ (m : ℤ), a - b = (2 : ℤ) * m → S a b = (2 : ℤ) * a ^ (2 : ℕ) - (2 - : ℤ) * |a| - (4 : ℤ) * m ^ (2 : ℕ)) ) := by - classical - intro K S a b m h - dsimp [S] - rw [h, show (2*m)%2 = 0 by omega] - ring -private theorem sOdd : - (by - classical - exact - (DiamondParameter) → ( - let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 - ∀ (a : ℤ), ∀ (b : ℤ), ∀ (m : ℤ), a - b = (2 : ℤ) * m + (1 : ℤ) → S a b = (2 : ℤ) * a ^ (2 - : ℕ) - (2 : ℤ) * |a| - (4 : ℤ) * m ^ (2 : ℕ) - (4 : ℤ) * m) ) := by - classical - intro K S a b m h - dsimp [S] - rw [h, show (2*m+1)%2 = 1 by omega] - ring + + private theorem valR : (by @@ -371,22 +289,6 @@ private theorem valR : dsimp [Q] ring -private theorem diffC : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), - let Q (a b : Int) : Int := - (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 - let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 - (∀ (a : Int), ∀ (b : Int), 4*Q a b = S a b) → ((∀ (x : GaussianInt), (x ∈ - FootprintVertices (DiamondTile K.1)) → (f x = Q x.re x.im)) → (∀ (x : GaussianInt), ∀ - (y : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) → y ∈ FootprintVertices - (DiamondTile K.1) → (4 : ℤ) * (f y - f x) = S y.re y.im - S x.re x.im)) ) := by - classical - intro K f Q S scale valC x y hx hy - rw [valC x hx, valC y hy] - linear_combination scale y.re y.im - scale x.re x.im private theorem diffR : (by @@ -410,18 +312,6 @@ private theorem diffR : linear_combination scale (y.re-rho.re) (y.im-rho.im) - scale (x.re-rho.re) (x.im-rho.im) -private theorem lap : - (by - classical - exact - ∀ (f : IntegerLatticeFunction), ∀ (x : GaussianInt), FourNeighborLaplacian f x = f (x + - (1 : GaussianInt)) - f x + (f (x - (1 : GaussianInt)) - f x) + (f (x + ⟨(0 : ℤ), (1 : - ℤ)⟩) - f x) + (f (x - ⟨(0 : ℤ), (1 : ℤ)⟩) - f x) ) := by - classical - intro f x - unfold FourNeighborLaplacian - ring - private theorem eastAt316 : (by classical @@ -747,18 +637,19 @@ theorem P5352T2RightSecond (K : DiamondParameter) (hk : 1 < K.1) let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 - have tri (a : Int) := DiamondRightSecond.tri K a - have square (a : Int) := DiamondRightSecond.square K a - have scale (a b : Int) := DiamondRightSecond.scale tri square a b - have sEven (a b m : Int) (h : a-b = 2*m) := DiamondRightSecond.sEven K a b m h - have sOdd (a b m : Int) (h : a-b = 2*m+1) := DiamondRightSecond.sOdd K a b m h + have tri (a : Int) := DiamondQuadraticArithmetic.triangularScale a + have square (a : Int) := DiamondQuadraticArithmetic.squareScale a + have scale (a b : Int) := DiamondQuadraticArithmetic.quadraticScale tri square a b + have sEven (a b m : Int) (h : a-b = 2*m) := DiamondQuadraticArithmetic.evenDifference a b m h + have sOdd (a b m : Int) (h : a-b = 2*m+1) := DiamondQuadraticArithmetic.oddDifference a b m h have valC (x : GaussianInt) (hx : x ∈ FootprintVertices (DiamondTile K.1)) : f x = Q x.re x.im := (hC x hx).trans ((P5352T2DomainRows K x).2 hx) have valR (x : GaussianInt) (hx : x-rho ∈ FootprintVertices (DiamondTile K.1)) := DiamondRightSecond.valR K f B hR x hx have diffC (x y : GaussianInt) (hx : x ∈ FootprintVertices (DiamondTile K.1)) - (hy : y ∈ FootprintVertices (DiamondTile K.1)) := DiamondRightSecond.diffC K f scale valC + (hy : y ∈ FootprintVertices (DiamondTile K.1)) := + DiamondQuadraticArithmetic.differenceScale K f scale valC x y hx hy -- Subtraction at the common center cancels B. have diffR (x y : GaussianInt) @@ -767,7 +658,7 @@ theorem P5352T2RightSecond (K : DiamondParameter) (hk : 1 < K.1) scale valR x y hx hy have lap (x : GaussianInt) : FourNeighborLaplacian f x = (f (x+1)-f x)+(f (x-1)-f x)+ - (f (x+⟨0,1⟩)-f x)+(f (x-⟨0,1⟩)-f x) := DiamondRightSecond.lap f x + (f (x+⟨0,1⟩)-f x)+(f (x-⟨0,1⟩)-f x) := FourNeighborLaplacianProperties.differences f x rcases contact with ⟨t,ht0,htk,rfl⟩ | ⟨t,ht0,htk,rfl⟩ · have cells := cellsA t ht0 htk have east : f ((⟨-1-t,t⟩ : GaussianInt)+1)-f ⟨-1-t,t⟩ = 0 := DiamondRightSecond.eastAt316 K diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1LiteralFordPlacement.lean b/LeanPool/ApollonianSuperharmonic/P5472T1LiteralFordPlacement.lean index 2903fedef8..75e48534b7 100644 --- a/LeanPool/ApollonianSuperharmonic/P5472T1LiteralFordPlacement.lean +++ b/LeanPool/ApollonianSuperharmonic/P5472T1LiteralFordPlacement.lean @@ -186,53 +186,21 @@ private theorem hPminusCent : private theorem hcenter' : (by classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (P : Fin 3 → Bool → ProtoTile), ∀ - (r : Fin 3 → Bool → PartialOdometer), ∀ (x : GaussianInt), (GaussianRealPoint x = - TileCentroid T) → (∀ (F : FordFareyParameter), ∀ (s : BandPackingSymmetry), ∀ (delta - : Bool), (BandPackingSymmetryReversesOrientation s = false) → ((∃ (z : GaussianInt), - s = BandPackingSymmetry.shift z ∨ s = (BandPackingSymmetry.shift z).comp - BandPackingSymmetry.negate) → ((BandPackingSymmetryScopedPhase s q delta) → - ((BandPackingSymmetryCircleAction s (q (1 : Fin (4 : ℕ))) = FordCircleCoordinate F.p - F.q) → ((BandVectors.1 (BandPackingSymmetryQuadrupleAction s q (3 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction s q (2 : Fin (4 : ℕ))) = (⟨-(↑F.q₁ : ℤ), (↑F.q₂ : - ℤ)⟩ : GaussianInt)) → ( - let c := BandPackingSymmetryVectorAction s x - let U := TileTranslation (BandPackingSymmetryTileAction s (P 0 (!delta))) (-c) - let V := TileTranslation (BandPackingSymmetryTileAction s (P 0 delta)) (-c) - let hp := PartialOdometerAffineTranslate - (BandPackingSymmetryPartialOdometerAction s (r 0 (!delta))) (-c) 0 0 - let hm := PartialOdometerAffineTranslate - (BandPackingSymmetryPartialOdometerAction s (r 0 delta)) (-c) 0 0 - (TileOdometer (FordCircleCoordinate F.p F.q) U hp) → ((TileOdometer (FordCircleCoordinate - F.p F.q) V hm) → (∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (P' : Fin (3 : - ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s_1 : Bool), P' ((e : Fin (3 : ℕ) × - Bool → Fin (3 : ℕ) × Bool) (i, s_1)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) - (i, s_1)).2 = BandPackingSymmetryTileAction s (P i s_1)) → ((∀ (i : Fin (3 : ℕ)), ∀ - (s_1 : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction s q) - (BandPackingSymmetryTileAction s T) i s_1 (P' i s_1)) → ((∀ (x : LatticeCell), x ∈ - (BandPackingSymmetryTileAction s T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (P' i - s).cells) → ((BandPackingSymmetryScopedPhase s q delta) → ((∀ (i : Fin (3 : ℕ)), ∀ - (s_1 : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s_1) = ((fun (i : Fin - (3 : ℕ)) => if BandPackingSymmetryReversesOrientation s = true then -i else i) i, s_1 - ^^ delta)) → ((TileCentroid (BandPackingSymmetryTileAction s (P 0 (!delta))) - - TileCentroid (BandPackingSymmetryTileAction s T) = (1 : Real) • ((1 / 2 : Real) • - (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) - (BandPackingSymmetryQuadrupleAction s q 2)) - (-(GaussianRealPoint (BandVectors.1 - (BandPackingSymmetryQuadrupleAction s q 3) (BandPackingSymmetryQuadrupleAction s q - 2))).2, (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) - (BandPackingSymmetryQuadrupleAction s q 2))).1)))) → ((TileCentroid - (BandPackingSymmetryTileAction s (P 0 delta)) - TileCentroid - (BandPackingSymmetryTileAction s T) = (-1 : Real) • ((1 / 2 : Real) • - (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) - (BandPackingSymmetryQuadrupleAction s q 2)) - (-(GaussianRealPoint (BandVectors.1 - (BandPackingSymmetryQuadrupleAction s q 3) (BandPackingSymmetryQuadrupleAction s q - 2))).2, (GaussianRealPoint (BandVectors.1 (BandPackingSymmetryQuadrupleAction s q 3) - (BandPackingSymmetryQuadrupleAction s q 2))).1)))) → (TileCentroid - (BandPackingSymmetryTileAction s T) = GaussianRealPoint c))))))))))))))) ) := by + exact + ∀ (T : ProtoTile), + ∀ (x : GaussianInt), + (GaussianRealPoint x = TileCentroid T) → + (∀ (s : BandPackingSymmetry), + ((∃ (z : GaussianInt), + s = BandPackingSymmetry.shift z ∨ + s = + (BandPackingSymmetry.shift z).comp + BandPackingSymmetry.negate) → + (let c := BandPackingSymmetryVectorAction s x; + (TileCentroid (BandPackingSymmetryTileAction s T) = + GaussianRealPoint c))))) := by classical - intro q T P r x hcenter F s delta hrev hword hphase hrootCircle hW c U V hp hm hplus' hminus' e - P' hPmap hPocc hPcover hdphase he hPplusCent hPminusCent + intro T x hcenter s hword c rcases hword with ⟨w, hs | hs⟩ · subst s simpa [c, BandPackingSymmetryTileAction, BandPackingSymmetryVectorAction] using @@ -692,9 +660,7 @@ theorem P5472T1LiteralFordPlacement have hPplusCent := LiteralFordPlacementGeometry.hPplusCent q T P s delta e P' hPmap hPocc hePlus have hPminusCent := LiteralFordPlacementGeometry.hPminusCent q T P s delta e P' hPmap hPocc heMinus - have hcenter' := LiteralFordPlacementGeometry.hcenter' q T P r x hcenter F s delta hrev hword - hphase hrootCircle hW hplus' hminus' e P' hPmap hPocc hPcover hdphase he hPplusCent - hPminusCent + have hcenter' := LiteralFordPlacementGeometry.hcenter' T x hcenter s hword have hsumReal : (F.q : Real) = (F.q₁ : Real) + F.q₂ := by exact_mod_cast F.sum_q have hDplus := LiteralFordPlacementGeometry.hDplus F hsumReal have hDminus := LiteralFordPlacementGeometry.hDminus F hsumReal diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean index 3843920129..fb9f07461b 100644 --- a/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.DiamondQuadraticArithmetic public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows @@ -44,28 +45,6 @@ private theorem tri : 2*((2*(a/2)+1)*(a/2)) by ring, Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] -private theorem square : - (by - classical - exact - (DiamondParameter) → (∀ (a : ℤ), (4 : ℤ) * (a ^ (2 : ℕ) / (4 : ℤ)) = a ^ (2 : ℕ) - a % (2 - : ℤ)) ) := by - classical - intro K a - rcases Int.emod_two_eq_zero_or_one a with h | h - · have ha : a = 2*(a/2) := by omega - have he : a^2 = 4*(a/2)^2 := by - conv_lhs => rw [ha] - ring - rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (4:Int) ≠ 0), h] - ring - · have ha : a = 2*(a/2)+1 := by omega - have he : a^2 = 4*((a/2)^2+a/2)+1 := by - conv_lhs => rw [ha] - ring - rw [he, h] - omega - private theorem hposResult : (by classical @@ -127,25 +106,6 @@ private theorem hfloorOdd : norm_num at hh ⊢ nlinarith -private theorem scale : - (by - classical - exact - let Q (a b : Int) : Int := - (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 - let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 - (∀ (a : Int), 2*(a*(a-1)/2) = a*(a-1)) → ((∀ (a : Int), 4*(a^2/4) = a^2-a%2) → (∀ (a : - ℤ), ∀ (b : ℤ), (4 : ℤ) * Q a b = S a b)) ) := by - classical - intro Q S tri square a b - have ht := tri (Int.natAbs a : Int) - have hs := square (a-b) - have ha : (Int.natAbs a : Int)^2 = a^2 := by - rw [Int.natCast_natAbs, sq_abs] - dsimp [Q, S] - rw [Int.natCast_natAbs] at ht ha ⊢ - nlinarith only [ht, hs, ha] - private theorem foot : (by classical @@ -701,8 +661,8 @@ theorem P5491T1DiamondRightBoundary (K : DiamondParameter) (hk : 1 < K.1) (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 have tri (a : Int) : 2*(a*(a-1)/2) = a*(a-1) := DiamondRightBoundaryProof.tri K a - have square (a : Int) : 4*(a^2/4) = a^2-a%2 := DiamondRightBoundaryProof.square K a - have scale (a b : Int) := DiamondBoundaryDetails.scale tri square a b + have square (a : Int) : 4*(a^2/4) = a^2-a%2 := DiamondQuadraticArithmetic.squareScale a + have scale (a b : Int) := DiamondQuadraticArithmetic.quadraticScale tri square a b have foot (z : GaussianInt) := DiamondBoundaryDetails.foot K z have hpositive : ∀ (i : Fin 3) (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) → diff --git a/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean b/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean index d1a0df1b29..b45a59bde9 100644 --- a/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean +++ b/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean @@ -7,11 +7,7 @@ module public import Mathlib.Init -public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends -public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -public import LeanPool.ApollonianSuperharmonic.LeftLatticeAdjacent public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification -public import LeanPool.ApollonianSuperharmonic.P5570T1UnitQuadratic public import LeanPool.ApollonianSuperharmonic.P3996T1AdjacentParentPlacement public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentIncomingEndpoint public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceDisjointCompanionEndpoints @@ -152,21 +148,49 @@ private theorem hbAt227 : private theorem hvalues : (by classical - exact - (BandCircle) → (∀ (h₁ : PartialOdometer), ∀ (h₂ : PartialOdometer), ∀ (g : - IntegerLatticeFunction), ∀ (x : GaussianInt), ∀ (c₁ : ℤ), (∀ x ∈ h₁.domain, g x = - h₁.value x + c₁) → (∀ (c₂ : ℤ), (∀ x ∈ h₂.domain, g x = h₂.value x + c₂) → ((∀ (y : - GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ - h₁.domain ∨ y ∈ h₂.domain) → ((ℕ) → (∀ (z : GaussianInt), ∀ (a₁ : GaussianInt), ∀ (b₁ - : ℤ), (∀ x ∈ h₁.domain, h₁.value x = P5570T1UnitQuadratic z x + a₁.re * x.re + - a₁.im * x.im + b₁) → (∀ (b₂ : ℤ), (∀ x ∈ h₂.domain, h₂.value x = - P5570T1UnitQuadratic z x + a₁.re * x.re + a₁.im * x.im + b₂) → ((b₁+c₁ = b₂+c₂) → - (∀ (y : GaussianInt), (y = x ∨ y = x+1 ∨ y = x-1 ∨ - y = x+⟨0,1⟩ ∨ y = x-⟨0,1⟩) → (g y = P5570T1UnitQuadratic z y + a₁.re*y.re + - a₁.im*y.im + (b₁+c₁)))))))))) ) := by + exact + (∀ (h₁ : PartialOdometer), + ∀ (h₂ : PartialOdometer), + ∀ (g : IntegerLatticeFunction), + ∀ (x : GaussianInt), + ∀ (c₁ : ℤ), + (∀ x ∈ h₁.domain, g x = h₁.value x + c₁) → + (∀ (c₂ : ℤ), + (∀ x ∈ h₂.domain, g x = h₂.value x + c₂) → + ((∀ (y : GaussianInt), + y = x ∨ + y = x + (1 : GaussianInt) ∨ + y = x - (1 : GaussianInt) ∨ + y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ + y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → + y ∈ h₁.domain ∨ y ∈ h₂.domain) → + (∀ (z : GaussianInt), + ∀ (a₁ : GaussianInt), + ∀ (b₁ : ℤ), + (∀ x ∈ h₁.domain, + h₁.value x = + P5570T1UnitQuadratic z x + a₁.re * x.re + + a₁.im * x.im + + b₁) → + (∀ (b₂ : ℤ), + (∀ x ∈ h₂.domain, + h₂.value x = + P5570T1UnitQuadratic z x + a₁.re * x.re + + a₁.im * x.im + + b₂) → + ((b₁ + c₁ = b₂ + c₂) → + (∀ (y : GaussianInt), + (y = x ∨ + y = x + 1 ∨ + y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → + (g y = + P5570T1UnitQuadratic z y + + a₁.re * y.re + + a₁.im * y.im + + (b₁ + c₁)))))))))) := by classical - intro C h₁ h₂ g x c₁ hg₁ c₂ hg₂ hstar n z a₁ b₁ hval₁ b₂ hval₂ hb y hy + intro h₁ h₂ g x c₁ hg₁ c₂ hg₂ hstar z a₁ b₁ hval₁ b₂ hval₂ hb y hy rcases hstar y hy with hy₁ | hy₂ · rw [hg₁ y hy₁, hval₁ y hy₁] ring @@ -1061,9 +1085,9 @@ theorem P5596T1LeftWeb (hy : y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) : g y = P5570T1UnitQuadratic z y + - a₁.re * y.re + a₁.im * y.im + (b₁ + c₁) := LeftWebGeometry.hvalues C h₁ h₂ g x c₁ + a₁.re * y.re + a₁.im * y.im + (b₁ + c₁) := LeftWebGeometry.hvalues h₁ h₂ g x c₁ hg₁ c₂ - hg₂ hstar n z a₁ b₁ hval₁ b₂ hval₂ hb y hy + hg₂ hstar z a₁ b₁ hval₁ b₂ hval₂ hb y hy have hperiodic := CurvatureOnePeriodicOdometer C z hz have hq : FourNeighborLaplacian (fun y => P5570T1UnitQuadratic z y + diff --git a/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean index b7f394650c..16becec209 100644 --- a/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCurvature public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizedBundleExists public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRoutedSelectedContact @@ -92,21 +93,6 @@ private theorem hparentPositive : rw [hq'] exact C'.property -private theorem actionCurvatureAt244 : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (c : CircleCoordinates), (BandPackingSymmetryCircleAction - g c).1 = c.1 ) := by - classical - intro g - induction g with - | identity => intro c; rfl - | negate => intro c; rfl - | conjugate => intro c; rfl - | shift w => intro c; rfl - | comp a b iha ihb => intro c; simp [BandPackingSymmetryCircleAction, iha, ihb] - private theorem hinverseCoordinate : (by classical @@ -983,7 +969,7 @@ theorem P5630T1MarkedRightOdometerAdjacencyReduction : ⟨delta, pFixed, pSelected, t', hphaseInv, ht', hOFixedInv, hOSelectedInv, hslopeFixedInv, hslopeSelectedInv, hcentInv, hslopeReInv, hslopeImInv, hcompat⟩ - have actionCurvature := MarkedRightAdjacencyGeometry.actionCurvatureAt244 + have actionCurvature := BandPackingSymmetryCurvature.preserved let inversePresentation := BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation let inverseSlot := if BandPackingSymmetryReversesOrientation ginv then @@ -1035,7 +1021,7 @@ theorem P5630T1MarkedRightOdometerAdjacencyReduction : hselectedCoord (MarkedRightAdjacencyGeometry.hOFixedOriginal C T T₀ h h₀ x bundle ginv htileL hfunL hOFixedInv (MarkedRightAdjacencyGeometry.hrootAction C T T₀ h h₀ x bundle ginv hcircleL hnorm)) hOSelectedOriginal hslopeFixedOriginal hcentOriginal hrootCoord - have actionCurvature := MarkedRightAdjacencyGeometry.actionCurvatureAt244 + have actionCurvature := BandPackingSymmetryCurvature.preserved have hsizeOriginal := MarkedRightAdjacencyGeometry.hsizeOriginal C T T₀ h h₀ x bundle C' hsize ginv hnorm actionCurvature hinverseProper hinversePositive hinverseCircle have hcoverOriginal := MarkedRightAdjacencyGeometry.hcoverOriginal C T T₀ h h₀ x markedData diff --git a/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean b/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean index ea4dc9d9af..a5b16aff2f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean +++ b/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeVertexSectorFacts public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleLatticeTouching public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors @@ -39,17 +40,6 @@ private theorem triple_label_pattern : classical exact ((((by decide +kernel)))) -private theorem neighbor_ne_center : - (by - classical - exact - let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := - ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] - ∀ (x : GaussianInt), ∀ (j : Fin 4), neighbor x j ≠ x ) := by - classical - intro neighbor x j - fin_cases j <;> simp [neighbor, Zsqrtd.ext_iff] - private theorem neighbor_injective : (by classical @@ -63,64 +53,8 @@ private theorem neighbor_injective : fin_cases j <;> fin_cases k <;> simp [neighbor, Zsqrtd.ext_iff] at h ⊢ <;> omega -private theorem edgeAt_mem : - (by - classical - exact - let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := - ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] - let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := - ![{x, x + ⟨0, 1⟩}, {x - 1, x}, - {x - ⟨0, 1⟩, x}, {x, x + 1}] - ∀ (x : GaussianInt), ∀ (j : Fin 4), x ∈ edgeAt x j ∧ neighbor x j ∈ edgeAt x j ) := by - classical - intro neighbor edgeAt x j - fin_cases j <;> simp [neighbor, edgeAt] -private theorem edgeAt_eq_pair : - (by - classical - exact - let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := - ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] - let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := - ![{x, x + ⟨0, 1⟩}, {x - 1, x}, - {x - ⟨0, 1⟩, x}, {x, x + 1}] - ∀ (x : GaussianInt), ∀ (j : Fin 4), edgeAt x j = {x, neighbor x j} ) := by - classical - intro neighbor edgeAt x j - fin_cases j <;> simp [edgeAt, neighbor, Finset.pair_comm] -private theorem edgeAt_injective : - (by - classical - exact - let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := - ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] - let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := - ![{x, x + ⟨0, 1⟩}, {x - 1, x}, - {x - ⟨0, 1⟩, x}, {x, x + 1}] - (∀ (x : GaussianInt), ∀ (j : Fin 4), neighbor x j ≠ x) → ((∀ (x : GaussianInt), ∀ - {j : Fin 4}, ∀ {k : Fin 4}, (neighbor x j = neighbor x k) → (j = k)) → ((∀ (x : - GaussianInt), ∀ (j : Fin 4), x ∈ edgeAt x j ∧ neighbor x j ∈ edgeAt x j) → (∀ (x : - GaussianInt), ∀ {j : Fin 4}, ∀ {k : Fin 4}, (edgeAt x j = edgeAt x k) → (j = k)))) ) - := by - classical - intro neighbor edgeAt neighbor_ne_center neighbor_injective edgeAt_mem x j k h - have hx := (edgeAt_mem x j).1 - have hn := (edgeAt_mem x j).2 - have hnm : neighbor x j ∈ edgeAt x k := by rw [← h]; exact hn - have hchoices : neighbor x j = x ∨ neighbor x j = neighbor x k := by - fin_cases k - · simpa [edgeAt, neighbor] using hnm - · have hh : neighbor x j = x - 1 ∨ neighbor x j = x := by - simpa [edgeAt, neighbor] using hnm - exact Or.symm hh - · have hh : neighbor x j = x - ⟨0, 1⟩ ∨ neighbor x j = x := by - simpa [edgeAt, neighbor] using hnm - exact Or.symm hh - · simpa [edgeAt, neighbor] using hnm - exact neighbor_injective x (hchoices.resolve_left (neighbor_ne_center x j)) private theorem edge_of_sector_pair : (by @@ -455,35 +389,7 @@ private theorem triple_sector_cover : exact (LocalLatticeInterfaceSectors.1 T0 T0' R x hT hT' hR htriple hx).1 -private theorem label_T0 : - (by - classical - exact - ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), - let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => - if LatticeVertexIncidentCell x j ∈ T0.cells then 0 - else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 - ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → - (outerLabel x j = 0) ) := by - classical - intro T0 T0' outerLabel x j hc - simp [outerLabel, hc] -private theorem label_T0' : - (by - classical - exact - ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), (Disjoint T0.cells T0'.cells) → ( - let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => - if LatticeVertexIncidentCell x j ∈ T0.cells then 0 - else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 - ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0'.cells) → - (outerLabel x j = 1)) ) := by - classical - intro T0 T0' hdis outerLabel x j hc - have hn : LatticeVertexIncidentCell x j ∉ T0.cells := - Finset.disjoint_left.mp hdis.symm hc - simp [outerLabel, hn, hc] private theorem label_R : (by @@ -884,52 +790,83 @@ private theorem hlabelRA : private theorem hlabelGood : (by classical - exact - ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (R : ProtoTile), ∀ (E : - ExactTileInterfaceTriple T0 T0' R), (Disjoint T0.cells R.cells) → ((Disjoint - T0'.cells R.cells) → (∀ (x : GaussianInt), (∀ (z : GaussianInt), z = x ∨ z = x + (1 : - GaussianInt) ∨ z = x - (1 : GaussianInt) ∨ z = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ∨ z = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → z ∈ FootprintVertices T0 ∨ z ∈ - FootprintVertices T0') → ( - let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := - ![{x, x + ⟨0, 1⟩}, {x - 1, x}, - {x - ⟨0, 1⟩, x}, {x, x + 1}] - (∀ (E : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), (x ∈ FootprintVertices T0) → ((x - ∈ FootprintVertices T0') → ((∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y - = x - ⟨0, 1⟩ → y ∈ FootprintVertices T0 ∨ y ∈ FootprintVertices T0') → ((Disjoint - E.cells T0.cells) → ((Disjoint E.cells T0'.cells) → ((LatticeVertexIncidentCell x j ∈ - E.cells) → ((LatticeVertexIncidentCell x (j + 1) ∈ E.cells) → (False)))))))) → ( - let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => - if LatticeVertexIncidentCell x j ∈ T0.cells then 0 - else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 - (∀ (R : ProtoTile), ∀ (x : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ - T0.cells ∨ LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j - ∈ R.cells) → (∀ (j : Fin 4), (outerLabel x j = 2) → (LatticeVertexIncidentCell x j ∈ - R.cells))) → ((x ∈ FootprintVertices T0 ∩ FootprintVertices T0' ∩ FootprintVertices - R) → ((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ T0.cells ∨ - LatticeVertexIncidentCell x j ∈ T0'.cells ∨ LatticeVertexIncidentCell x j ∈ R.cells) - → (∀ (jEdge : Fin (4 : ℕ)), ∀ (eAB : Finset GaussianInt), ∀ (jAB : Fin (4 : ℕ)), ∀ - (jBR : Fin (4 : ℕ)), ∀ (jRA : Fin (4 : ℕ)), (eAB = edgeAt E.point jAB) → - ((LatticeVertexIncidentCell E.point jAB ∈ T0.cells ∧ LatticeVertexIncidentCell - E.point (jAB + (1 : Fin (4 : ℕ))) ∈ T0'.cells ∨ LatticeVertexIncidentCell E.point jAB - ∈ T0'.cells ∧ LatticeVertexIncidentCell E.point (jAB + (1 : Fin (4 : ℕ))) ∈ T0.cells) - → ((jAB ≠ jBR) → ((jRA ≠ jAB) → ((eAB = edgeAt x jAB) → ((LatticeVertexIncidentCell x - jAB ∈ T0.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : Fin (4 : ℕ))) ∈ T0'.cells ∨ - LatticeVertexIncidentCell x jAB ∈ T0'.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : - Fin (4 : ℕ))) ∈ T0.cells) → ((jAB = jEdge) → ((({outerLabel x jAB, - outerLabel x (jAB + 1)} : Finset (Fin 3)) = {0, 1}) → ((outerLabel x (jAB + (2 : Fin - (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = outerLabel x - jAB ∨ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB - + (2 : Fin (4 : ℕ))) = outerLabel x (jAB + (1 : Fin (4 : ℕ))) ∨ outerLabel x (jAB + - (2 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 - : Fin (3 : ℕ)) ∨ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ - outerLabel x jAB = (2 : Fin (3 : ℕ))) → ((outerLabel x (jAB + 2) = 2 ∧ outerLabel x - (jAB + 3) = outerLabel x jAB) ∨ (outerLabel x (jAB + 3) = 2 ∧ outerLabel x (jAB + 2) - = outerLabel x (jAB + 1)))))))))))))))))) ) := by + exact + ∀ (T0 : ProtoTile), + ∀ (T0' : ProtoTile), + ∀ (R : ProtoTile), + (Disjoint T0.cells R.cells) → + ((Disjoint T0'.cells R.cells) → + (∀ (x : GaussianInt), + (∀ (z : GaussianInt), + z = x ∨ + z = x + (1 : GaussianInt) ∨ + z = x - (1 : GaussianInt) ∨ + z = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ + z = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → + z ∈ FootprintVertices T0 ∨ z ∈ FootprintVertices T0') → + ((∀ (E : ProtoTile), + ∀ (x : GaussianInt), + ∀ (j : Fin 4), + (x ∈ FootprintVertices T0) → + ((x ∈ FootprintVertices T0') → + ((∀ y, + y = x ∨ + y = x + 1 ∨ + y = x - 1 ∨ + y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices T0 ∨ + y ∈ FootprintVertices T0') → + ((Disjoint E.cells T0.cells) → + ((Disjoint E.cells T0'.cells) → + ((LatticeVertexIncidentCell x j ∈ E.cells) → + ((LatticeVertexIncidentCell x (j + 1) ∈ + E.cells) → + (False)))))))) → + (let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => + if LatticeVertexIncidentCell x j ∈ T0.cells then 0 + else + if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 + else 2; + (∀ (R : ProtoTile), + ∀ (x : GaussianInt), + (∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells ∨ + LatticeVertexIncidentCell x j ∈ R.cells) → + (∀ (j : Fin 4), + (outerLabel x j = 2) → + (LatticeVertexIncidentCell x j ∈ R.cells))) → + ((x ∈ + FootprintVertices T0 ∩ FootprintVertices T0' ∩ + FootprintVertices R) → + ((∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ T0.cells ∨ + LatticeVertexIncidentCell x j ∈ T0'.cells ∨ + LatticeVertexIncidentCell x j ∈ R.cells) → + (∀ (jAB : Fin (4 : ℕ)), + ((outerLabel x (jAB + (2 : Fin (4 : ℕ))) = + (2 : Fin (3 : ℕ)) ∧ + outerLabel x (jAB + (3 : Fin (4 : ℕ))) = + outerLabel x jAB ∨ + outerLabel x (jAB + (3 : Fin (4 : ℕ))) = + (2 : Fin (3 : ℕ)) ∧ + outerLabel x (jAB + (2 : Fin (4 : ℕ))) = + outerLabel x (jAB + (1 : Fin (4 : ℕ))) ∨ + outerLabel x (jAB + (2 : Fin (4 : ℕ))) = + (2 : Fin (3 : ℕ)) ∧ + outerLabel x (jAB + (3 : Fin (4 : ℕ))) = + (2 : Fin (3 : ℕ)) ∨ + outerLabel x (jAB + (3 : Fin (4 : ℕ))) = + (2 : Fin (3 : ℕ)) ∧ + outerLabel x jAB = (2 : Fin (3 : ℕ))) → + ((outerLabel x (jAB + 2) = 2 ∧ + outerLabel x (jAB + 3) = outerLabel x jAB) ∨ + (outerLabel x (jAB + 3) = 2 ∧ + outerLabel x (jAB + 2) = + outerLabel x (jAB + 1)))))))))))) := by classical - intro T0 T0' R E hTm hT'm x hstar edgeAt endpoint_repeat_impossible outerLabel label_eq_two_mem - hxTriple hsectorCover jEdge eAB jAB jBR jRA hABat htransAB hjABBR hjRAAB hABatx htransABx - hjABEdge hlabelAB hlabelPattern + intro T0 T0' R hTm hT'm x hstar endpoint_repeat_impossible outerLabel label_eq_two_mem + hxTriple hsectorCover jAB hlabelPattern rcases hlabelPattern with h | h | h | h · exact Or.inl h · exact Or.inr h @@ -1347,67 +1284,21 @@ private theorem hdiagAt813 : private theorem hfinalCellsAt833 : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (owner : GaussianInt → ι), ∀ (T0 : - ProtoTile), ∀ (T0' : ProtoTile), ∀ (R : ProtoTile), ∀ (U : ProtoTile), ∀ (V : - ProtoTile), ∀ (E : ExactTileInterfaceTriple T0 T0' R), ∀ (endpointIndex : ι), ∀ (ia : - ι), ∀ (ib : ι), ∀ (x : GaussianInt), - let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := - ![{x, x + ⟨0, 1⟩}, {x - 1, x}, - {x - ⟨0, 1⟩, x}, {x, x + 1}] - let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => - if LatticeVertexIncidentCell x j ∈ T0.cells then 0 - else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 - ∀ (jEdge : Fin (4 : ℕ)), ∀ (eAB : Finset GaussianInt), ∀ (jAB : Fin (4 : ℕ)), ∀ (jBR : - Fin (4 : ℕ)), ∀ (jRA : Fin (4 : ℕ)), (eAB = edgeAt E.point jAB) → - ((LatticeVertexIncidentCell E.point jAB ∈ T0.cells ∧ LatticeVertexIncidentCell - E.point (jAB + (1 : Fin (4 : ℕ))) ∈ T0'.cells ∨ LatticeVertexIncidentCell E.point jAB - ∈ T0'.cells ∧ LatticeVertexIncidentCell E.point (jAB + (1 : Fin (4 : ℕ))) ∈ T0.cells) - → ((jAB ≠ jBR) → ((jRA ≠ jAB) → ((eAB = edgeAt x jAB) → ((LatticeVertexIncidentCell x - jAB ∈ T0.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : Fin (4 : ℕ))) ∈ T0'.cells ∨ - LatticeVertexIncidentCell x jAB ∈ T0'.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : - Fin (4 : ℕ))) ∈ T0.cells) → ((jAB = jEdge) → ((({outerLabel x jAB, - outerLabel x (jAB + 1)} : Finset (Fin 3)) = {0, 1}) → ((outerLabel x (jAB + (2 : Fin - (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = outerLabel x - jAB ∨ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB - + (2 : Fin (4 : ℕ))) = outerLabel x (jAB + (1 : Fin (4 : ℕ))) ∨ outerLabel x (jAB + - (2 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 - : Fin (3 : ℕ)) ∨ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ - outerLabel x jAB = (2 : Fin (3 : ℕ))) → (((LatticeVertexIncidentCell x jAB ∈ (P.tile - ia).cells ∧ LatticeVertexIncidentCell x (jAB + 1) ∈ (P.tile ib).cells) ∨ - (LatticeVertexIncidentCell x jAB ∈ (P.tile ib).cells ∧ LatticeVertexIncidentCell x - (jAB + 1) ∈ (P.tile ia).cells)) → (((owner (LatticeVertexIncidentCell x jAB) = ia ∧ - owner (LatticeVertexIncidentCell x (jAB + 1)) = ib) ∨ (owner - (LatticeVertexIncidentCell x jAB) = ib ∧ owner (LatticeVertexIncidentCell x (jAB + - 1)) = ia)) → (((outerLabel x jAB = 0 ∧ owner (LatticeVertexIncidentCell x jAB) = ia ∧ - owner (LatticeVertexIncidentCell x (jAB + 1)) = ib) ∨ (outerLabel x jAB = 1 ∧ owner - (LatticeVertexIncidentCell x jAB) = ib ∧ owner (LatticeVertexIncidentCell x (jAB + - 1)) = ia)) → (((outerLabel x jAB = 0 ∧ outerLabel x (jAB + 1) = 1) ∨ (outerLabel x - jAB = 1 ∧ outerLabel x (jAB + 1) = 0)) → ( - let o0 := owner (LatticeVertexIncidentCell x jAB) - let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) - let o2 := owner (LatticeVertexIncidentCell x (jAB + 2)) - let o3 := owner (LatticeVertexIncidentCell x (jAB + 3)) - ((outerLabel x jAB = 0 ∧ o0 = ia ∧ o1 = ib) ∨ (outerLabel x jAB = 1 ∧ o0 = ib ∧ o1 = ia)) - → ((o0 = o1 ∨ o0 = o2 ∨ o0 = o3 ∨ o1 = o2 ∨ o1 = o3 ∨ o2 = o3) → ((outerLabel x (jAB - + (2 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = - outerLabel x jAB) → ((LatticeVertexIncidentCell x (jAB + 2) ∈ R.cells) → ((o2 = - endpointIndex) → ((LatticeVertexIncidentCell x (jAB + 3) ∈ T0.cells ∨ - LatticeVertexIncidentCell x (jAB + 3) ∈ T0'.cells) → ((LatticeVertexIncidentCell x - jAB ∈ T0.cells ∨ LatticeVertexIncidentCell x jAB ∈ T0'.cells) → - ((LatticeVertexIncidentCell x (jAB + 1) ∈ T0.cells ∨ LatticeVertexIncidentCell x (jAB - + 1) ∈ T0'.cells) → ((o0 ≠ o1) → ((o0 ≠ o2) → ((o1 ≠ o2) → ((o1 ≠ o3) → ((o2 ≠ o3) → - ((o0 = o3) → (((LatticeVertexIncidentCell x (jAB + 1) ∈ U.cells ∧ - LatticeVertexIncidentCell x (jAB + 3) ∈ V.cells) ∨ (LatticeVertexIncidentCell x (jAB - + 1) ∈ V.cells ∧ LatticeVertexIncidentCell x (jAB + 3) ∈ U.cells)) → ((x ∈ U.cells ∧ - x - 1 - ⟨0, 1⟩ ∈ V.cells) ∨ (x ∈ V.cells ∧ x - 1 - ⟨0, 1⟩ ∈ U.cells) ∨ (x - 1 ∈ - U.cells ∧ x - ⟨0, 1⟩ ∈ V.cells) ∨ (x - 1 ∈ V.cells ∧ x - ⟨0, 1⟩ ∈ - U.cells))))))))))))))))))))))))))))) ) := by + exact + ∀ (U : ProtoTile), + ∀ (V : ProtoTile), + ∀ (x : GaussianInt), + ∀ (jAB : Fin (4 : ℕ)), + (((LatticeVertexIncidentCell x (jAB + 1) ∈ U.cells ∧ + LatticeVertexIncidentCell x (jAB + 3) ∈ V.cells) ∨ + (LatticeVertexIncidentCell x (jAB + 1) ∈ V.cells ∧ + LatticeVertexIncidentCell x (jAB + 3) ∈ U.cells)) → + ((x ∈ U.cells ∧ x - 1 - ⟨0, 1⟩ ∈ V.cells) ∨ + (x ∈ V.cells ∧ x - 1 - ⟨0, 1⟩ ∈ U.cells) ∨ + (x - 1 ∈ U.cells ∧ x - ⟨0, 1⟩ ∈ V.cells) ∨ + (x - 1 ∈ V.cells ∧ x - ⟨0, 1⟩ ∈ U.cells)))) := by classical - intro ι P owner T0 T0' R U V E endpointIndex ia ib x edgeAt outerLabel jEdge eAB jAB jBR jRA - hABat htransAB hjABBR hjRAAB hABatx htransABx hjABEdge hlabelAB hlabelPattern hsectorAB - hownerAB hownerAligned hlabelsAB o0 o1 o2 o3 hownerAligned' hownerRepeat hGood hcell2 ho2 - hcell3side hside0 hside1 ho01ne ho02ne ho12ne ho13ne ho23ne ho03 hdiag + intro U V x jAB hdiag rcases hdiag with hdiag | hdiag · fin_cases jAB · exact Or.inr (Or.inr (Or.inl @@ -1644,66 +1535,21 @@ private theorem hdiagAt938 : private theorem hfinalCellsAt958 : (by classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (owner : GaussianInt → ι), ∀ (T0 : - ProtoTile), ∀ (T0' : ProtoTile), ∀ (R : ProtoTile), ∀ (U : ProtoTile), ∀ (V : - ProtoTile), ∀ (E : ExactTileInterfaceTriple T0 T0' R), ∀ (endpointIndex : ι), ∀ (ia : - ι), ∀ (ib : ι), ∀ (x : GaussianInt), - let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := - ![{x, x + ⟨0, 1⟩}, {x - 1, x}, - {x - ⟨0, 1⟩, x}, {x, x + 1}] - let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => - if LatticeVertexIncidentCell x j ∈ T0.cells then 0 - else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 - ∀ (jEdge : Fin (4 : ℕ)), ∀ (eAB : Finset GaussianInt), ∀ (jAB : Fin (4 : ℕ)), ∀ (jBR : - Fin (4 : ℕ)), ∀ (jRA : Fin (4 : ℕ)), (eAB = edgeAt E.point jAB) → - ((LatticeVertexIncidentCell E.point jAB ∈ T0.cells ∧ LatticeVertexIncidentCell - E.point (jAB + (1 : Fin (4 : ℕ))) ∈ T0'.cells ∨ LatticeVertexIncidentCell E.point jAB - ∈ T0'.cells ∧ LatticeVertexIncidentCell E.point (jAB + (1 : Fin (4 : ℕ))) ∈ T0.cells) - → ((jAB ≠ jBR) → ((jRA ≠ jAB) → ((eAB = edgeAt x jAB) → ((LatticeVertexIncidentCell x - jAB ∈ T0.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : Fin (4 : ℕ))) ∈ T0'.cells ∨ - LatticeVertexIncidentCell x jAB ∈ T0'.cells ∧ LatticeVertexIncidentCell x (jAB + (1 : - Fin (4 : ℕ))) ∈ T0.cells) → ((jAB = jEdge) → ((({outerLabel x jAB, - outerLabel x (jAB + 1)} : Finset (Fin 3)) = {0, 1}) → ((outerLabel x (jAB + (2 : Fin - (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = outerLabel x - jAB ∨ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB - + (2 : Fin (4 : ℕ))) = outerLabel x (jAB + (1 : Fin (4 : ℕ))) ∨ outerLabel x (jAB + - (2 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 - : Fin (3 : ℕ)) ∨ outerLabel x (jAB + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ - outerLabel x jAB = (2 : Fin (3 : ℕ))) → (((LatticeVertexIncidentCell x jAB ∈ (P.tile - ia).cells ∧ LatticeVertexIncidentCell x (jAB + 1) ∈ (P.tile ib).cells) ∨ - (LatticeVertexIncidentCell x jAB ∈ (P.tile ib).cells ∧ LatticeVertexIncidentCell x - (jAB + 1) ∈ (P.tile ia).cells)) → (((owner (LatticeVertexIncidentCell x jAB) = ia ∧ - owner (LatticeVertexIncidentCell x (jAB + 1)) = ib) ∨ (owner - (LatticeVertexIncidentCell x jAB) = ib ∧ owner (LatticeVertexIncidentCell x (jAB + - 1)) = ia)) → (((outerLabel x jAB = 0 ∧ owner (LatticeVertexIncidentCell x jAB) = ia ∧ - owner (LatticeVertexIncidentCell x (jAB + 1)) = ib) ∨ (outerLabel x jAB = 1 ∧ owner - (LatticeVertexIncidentCell x jAB) = ib ∧ owner (LatticeVertexIncidentCell x (jAB + - 1)) = ia)) → (((outerLabel x jAB = 0 ∧ outerLabel x (jAB + 1) = 1) ∨ (outerLabel x - jAB = 1 ∧ outerLabel x (jAB + 1) = 0)) → ( - let o0 := owner (LatticeVertexIncidentCell x jAB) - let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) - let o2 := owner (LatticeVertexIncidentCell x (jAB + 2)) - let o3 := owner (LatticeVertexIncidentCell x (jAB + 3)) - ((outerLabel x jAB = 0 ∧ o0 = ia ∧ o1 = ib) ∨ (outerLabel x jAB = 1 ∧ o0 = ib ∧ o1 = ia)) - → ((o0 = o1 ∨ o0 = o2 ∨ o0 = o3 ∨ o1 = o2 ∨ o1 = o3 ∨ o2 = o3) → ((outerLabel x (jAB - + (3 : Fin (4 : ℕ))) = (2 : Fin (3 : ℕ)) ∧ outerLabel x (jAB + (2 : Fin (4 : ℕ))) = - outerLabel x (jAB + (1 : Fin (4 : ℕ)))) → ((LatticeVertexIncidentCell x (jAB + 3) ∈ - R.cells) → ((o3 = endpointIndex) → ((LatticeVertexIncidentCell x (jAB + 2) ∈ T0.cells - ∨ LatticeVertexIncidentCell x (jAB + 2) ∈ T0'.cells) → ((LatticeVertexIncidentCell x - jAB ∈ T0.cells ∨ LatticeVertexIncidentCell x jAB ∈ T0'.cells) → - ((LatticeVertexIncidentCell x (jAB + 1) ∈ T0.cells ∨ LatticeVertexIncidentCell x (jAB - + 1) ∈ T0'.cells) → ((o0 ≠ o1) → ((o0 ≠ o2) → ((o0 ≠ o3) → ((o1 ≠ o3) → ((o2 ≠ o3) → - ((o1 = o2) → (((LatticeVertexIncidentCell x jAB ∈ U.cells ∧ LatticeVertexIncidentCell - x (jAB + 2) ∈ V.cells) ∨ (LatticeVertexIncidentCell x jAB ∈ V.cells ∧ - LatticeVertexIncidentCell x (jAB + 2) ∈ U.cells)) → ((x ∈ U.cells ∧ x - 1 - ⟨0, 1⟩ ∈ - V.cells) ∨ (x ∈ V.cells ∧ x - 1 - ⟨0, 1⟩ ∈ U.cells) ∨ (x - 1 ∈ U.cells ∧ x - ⟨0, 1⟩ ∈ - V.cells) ∨ (x - 1 ∈ V.cells ∧ x - ⟨0, 1⟩ ∈ U.cells))))))))))))))))))))))))))))) ) := by + exact + ∀ (U : ProtoTile), + ∀ (V : ProtoTile), + ∀ (x : GaussianInt), + ∀ (jAB : Fin (4 : ℕ)), + (((LatticeVertexIncidentCell x jAB ∈ U.cells ∧ + LatticeVertexIncidentCell x (jAB + 2) ∈ V.cells) ∨ + (LatticeVertexIncidentCell x jAB ∈ V.cells ∧ + LatticeVertexIncidentCell x (jAB + 2) ∈ U.cells)) → + ((x ∈ U.cells ∧ x - 1 - ⟨0, 1⟩ ∈ V.cells) ∨ + (x ∈ V.cells ∧ x - 1 - ⟨0, 1⟩ ∈ U.cells) ∨ + (x - 1 ∈ U.cells ∧ x - ⟨0, 1⟩ ∈ V.cells) ∨ + (x - 1 ∈ V.cells ∧ x - ⟨0, 1⟩ ∈ U.cells)))) := by classical - intro ι P owner T0 T0' R U V E endpointIndex ia ib x edgeAt outerLabel jEdge eAB jAB jBR jRA - hABat htransAB hjABBR hjRAAB hABatx htransABx hjABEdge hlabelAB hlabelPattern hsectorAB - hownerAB hownerAligned hlabelsAB o0 o1 o2 o3 hownerAligned' hownerRepeat hGood hcell3 ho3 - hcell2side hside0 hside1 ho01ne ho02ne ho03ne ho13ne ho23ne ho12 hdiag + intro U V x jAB hdiag rcases hdiag with hdiag | hdiag · fin_cases jAB · exact Or.inl (by simpa [LatticeVertexIncidentCell] using hdiag) @@ -1779,15 +1625,15 @@ theorem P5635T1EndpointDiagonalOwnership {ι : Type} let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := ![{x, x + ⟨0, 1⟩}, {x - 1, x}, {x - ⟨0, 1⟩, x}, {x, x + 1}] - have edgeAt_mem := EndpointDiagonalGeometry.edgeAt_mem + have edgeAt_mem := LatticeVertexSectorFacts.edgeMembership have edgeAt_injective (x : GaussianInt) {j k : Fin 4} - (h : edgeAt x j = edgeAt x k) := EndpointDiagonalGeometry.edgeAt_injective - (EndpointDiagonalGeometry.neighbor_ne_center) + (h : edgeAt x j = edgeAt x k) := LatticeVertexSectorFacts.edgeInjective + (LatticeVertexSectorFacts.neighborDistinct) (EndpointDiagonalGeometry.neighbor_injective) edgeAt_mem x (j := j) (k := k) h have endpoint_repeat_impossible := EndpointDiagonalGeometry.endpoint_repeat_impossible T0 T0' (EndpointDiagonalGeometry.edge_foreign_impossible edgeAt_mem edgeAt_injective (EndpointDiagonalGeometry.edge_of_sector_pair)) (EndpointDiagonalGeometry.star_induced_edge - T0 T0' hreg hreg' (EndpointDiagonalGeometry.edgeAt_eq_pair) + T0 T0' hreg hreg' (LatticeVertexSectorFacts.edgePair) (EndpointDiagonalGeometry.neighbor_in_star) (EndpointDiagonalGeometry.neighbor_four_adjacent)) have triple_transitions := EndpointDiagonalGeometry.triple_transitions T0 T0' hT hT' hdis (EndpointDiagonalGeometry.exact_point_boundary) (EndpointDiagonalGeometry.touching_path) @@ -1795,8 +1641,8 @@ theorem P5635T1EndpointDiagonalOwnership {ι : Type} let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => if LatticeVertexIncidentCell x j ∈ T0.cells then 0 else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 - have label_T0 := EndpointDiagonalGeometry.label_T0 T0 T0' - have label_T0' := EndpointDiagonalGeometry.label_T0' T0 T0' hdis + have label_T0 := LatticeVertexSectorFacts.firstTileLabel T0 T0' + have label_T0' := LatticeVertexSectorFacts.secondTileLabel T0 T0' hdis have label_R := EndpointDiagonalGeometry.label_R T0 T0' have label_mem := EndpointDiagonalGeometry.label_mem T0 T0' label_T0 label_T0' have label_eq_two_mem := EndpointDiagonalGeometry.label_eq_two_mem T0 T0' label_mem @@ -1854,9 +1700,8 @@ theorem P5635T1EndpointDiagonalOwnership {ι : Type} hjABBR hjBRRA hjRAAB hlabelAB (EndpointDiagonalGeometry.hlabelBR T0 T0' R hTm hT'm x label_T0' label_R jBR htransBRx) (EndpointDiagonalGeometry.hlabelRA T0 T0' R hTm hT'm x label_T0 label_R jRA htransRAx) - have hlabelGood := EndpointDiagonalGeometry.hlabelGood T0 T0' R E hTm hT'm x hstar - endpoint_repeat_impossible label_eq_two_mem hxTriple hsectorCover jEdge eAB jAB jBR jRA - hABat htransAB hjABBR hjRAAB hABatx htransABx hjABEdge hlabelAB hlabelPattern + have hlabelGood := EndpointDiagonalGeometry.hlabelGood T0 T0' R hTm hT'm x hstar + endpoint_repeat_impossible label_eq_two_mem hxTriple hsectorCover jAB hlabelPattern have hsectorAB := EndpointDiagonalGeometry.hsectorAB ι P ia ib x jEdge hsectorEdge jAB hjABEdge have hownerAB := EndpointDiagonalGeometry.hownerAB ι P owner U V ia ib hUidx hVidx x owner_unique jAB hsectorAB @@ -1894,11 +1739,7 @@ theorem P5635T1EndpointDiagonalOwnership {ι : Type} ho13ne ho23ne have hdiag := EndpointDiagonalGeometry.hdiagAt813 ι P owner owner_mem_iff T0 T0' U V ia ib hUidx hVidx x jAB hownerAligned' ho03 - have hfinalCells := EndpointDiagonalGeometry.hfinalCellsAt833 ι P owner T0 T0' R U V E - endpointIndex ia ib x jEdge eAB jAB jBR jRA hABat htransAB hjABBR hjRAAB hABatx htransABx - hjABEdge hlabelAB hlabelPattern hsectorAB hownerAB hownerAligned hlabelsAB hownerAligned' - hownerRepeat hGood hcell2 ho2 hcell3side hside0 hside1 ho01ne ho02ne ho12ne ho13ne ho23ne - ho03 hdiag + have hfinalCells := EndpointDiagonalGeometry.hfinalCellsAt833 U V x jAB hdiag exact hfinalCells · have hcell3 : LatticeVertexIncidentCell x (jAB + 3) ∈ R.cells := label_eq_two_mem R x hsectorCover (jAB + 3) hGood.1 @@ -1923,11 +1764,7 @@ theorem P5635T1EndpointDiagonalOwnership {ι : Type} ho13ne ho23ne have hdiag := EndpointDiagonalGeometry.hdiagAt938 ι P owner owner_mem_iff T0 T0' U V ia ib hUidx hVidx x jAB hownerAligned' ho12 - have hfinalCells := EndpointDiagonalGeometry.hfinalCellsAt958 ι P owner T0 T0' R U V E - endpointIndex ia ib x jEdge eAB jAB jBR jRA hABat htransAB hjABBR hjRAAB hABatx htransABx - hjABEdge hlabelAB hlabelPattern hsectorAB hownerAB hownerAligned hlabelsAB hownerAligned' - hownerRepeat hGood hcell3 ho3 hcell2side hside0 hside1 ho01ne ho02ne ho03ne ho13ne ho23ne - ho12 hdiag + have hfinalCells := EndpointDiagonalGeometry.hfinalCellsAt958 U V x jAB hdiag exact hfinalCells end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/P5640T1NonpairedOccurrenceIntersections.lean b/LeanPool/ApollonianSuperharmonic/P5640T1NonpairedOccurrenceIntersections.lean index f352046f3d..abb66f9c83 100644 --- a/LeanPool/ApollonianSuperharmonic/P5640T1NonpairedOccurrenceIntersections.lean +++ b/LeanPool/ApollonianSuperharmonic/P5640T1NonpairedOccurrenceIntersections.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation @@ -87,15 +88,6 @@ private theorem pairCells : intro q cfg C₀ T layout P O u v separation a b hab hnot exact separation.2 a b hab hnot -private theorem translationCells : - (by - classical - exact - ∀ (X : ProtoTile), ∀ (d : GaussianInt), (TileTranslation X d).cells = X.cells.image - (GaussianTranslation d) ) := by - classical - intro X d - exact (TileTranslationFormulas X d).1 private theorem cellInclusion : (by @@ -657,7 +649,7 @@ theorem P5640T1NonpairedOccurrenceIntersections a.label = .B ∧ b.label = .A) ∧ a.first = b.first ∧ a.second = b.second)) := NonpairedOccurrenceGeometry.pairCells q cfg C₀ T layout separation a b hab hnot have translationCells (X : ProtoTile) (d : GaussianInt) := - NonpairedOccurrenceGeometry.translationCells X d + TileTranslationProperties.cells X d have cellInclusion (X Y : ProtoTile) (hXY : X.cells ⊆ Y.cells) (d : GaussianInt) := NonpairedOccurrenceGeometry.cellInclusion translationCells X Y hXY d have isolatedPrecursor (m n : Int) := NonpairedOccurrenceGeometry.isolatedPrecursor q cfg C₀ T diff --git a/LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean b/LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean index 6989c8936b..e7c411a3e0 100644 --- a/LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean +++ b/LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean @@ -6,8 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LocalSideScaling -public import LeanPool.ApollonianSuperharmonic.P3934T1LocalSide public import LeanPool.ApollonianSuperharmonic.P3934T1SectorSelection public import LeanPool.ApollonianSuperharmonic.P3889T1TwoRaySectors @@ -26,36 +26,6 @@ namespace ApollonianSuperharmonic namespace StraightFrontierProof -private theorem scaleLocalSide : - (by - classical - exact - ∀ (W : Set (ℝ × ℝ)), ∀ (z : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (c : ℝ), ∀ (e : Bool), (0 : ℝ) < c → - P3934T1LocalSide W z w e → P3934T1LocalSide W z (c • w) e - ) := by - classical - intro W z w c e hc hside - obtain ⟨r, hr, heq⟩ := hside - refine ⟨r, hr, ?_⟩ - have hdet (q : Real × Real) : - (c • w).1 * (q.2 - z.2) - (c • w).2 * (q.1 - z.1) = - c * (w.1 * (q.2 - z.2) - w.2 * (q.1 - z.1)) := by - simp only [Prod.smul_fst, Prod.smul_snd] - ring - ext q - rw [heq] - simp only [Set.mem_ofPred_eq] - rw [hdet q] - constructor - · rintro ⟨hq, hs⟩ - refine ⟨hq, ?_⟩ - cases e <;> simp at hs ⊢ <;> - nlinarith [hc] - · rintro ⟨hq, hs⟩ - refine ⟨hq, ?_⟩ - cases e <;> simp at hs ⊢ <;> - nlinarith [hc] - private theorem hcol : (by classical @@ -869,7 +839,7 @@ theorem P5667T1StraightFrontierLocalSides have scaleLocalSide (W : Set (Real × Real)) (z w : Real × Real) (c : Real) (e : Bool) (hc : 0 < c) (hside : P3934T1LocalSide W z w e) : - P3934T1LocalSide W z (c • w) e := StraightFrontierProof.scaleLocalSide W z w c e hc hside + P3934T1LocalSide W z (c • w) e := LocalSideScaling.positiveScale W z w c e hc hside let n : Real := ‖B‖ have hn : 0 < n := by dsimp [n]; exact norm_pos_iff.mpr hB let d : Real × Real := n⁻¹ • B diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean index 5758d2a4d7..33984cad1e 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean @@ -7,13 +7,7 @@ module public import Mathlib.Init -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.CircleMatrix -public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian -public import LeanPool.ApollonianSuperharmonic.GlobalOdometerExtends public import LeanPool.ApollonianSuperharmonic.OdometerWeb -public import LeanPool.ApollonianSuperharmonic.TileOdometer -public import LeanPool.ApollonianSuperharmonic.TilingLattice -- [TABLET NODE: PeriodicBoundaryWebLaplacian] @@ -285,27 +279,44 @@ private theorem hcornerOutside : private theorem hvowner : (by classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (v : GaussianInt), ∀ (hv : - v ∈ TilingLattice C), (x ∈ BoundaryFootprintVertices (TileTranslation T v)) → (∀ (P : - PeriodicTileComplex ↥(TilingLattice C)), - let iv : TilingLattice C := ⟨v, hv⟩ - (x ∈ BoundaryFootprintVertices (P.tile iv)) → ((∃ y ∈ (P.tile iv).cells, y = x ∨ y = x - - 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → ((∃ y, y ∉ (P.tile iv).cells ∧ (y = x ∨ y - = x - 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩)) → (∀ (a0 : ↥(TilingLattice C)), (x ∈ - (P.tile a0).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - ∈ (P.tile a).cells) y → y = a0) → (∀ (a1 : ↥(TilingLattice C)), (x - (1 : - LatticeCell) ∈ (P.tile a1).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : - ↥(TilingLattice C)) => x - (1 : LatticeCell) ∈ (P.tile a).cells) y → y = a1) → (∀ (a2 - : ↥(TilingLattice C)), (x - (1 : LatticeCell) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ - (P.tile a2).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - - (1 : LatticeCell) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = - a2) → (∀ (a3 : ↥(TilingLattice C)), (x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile - a3).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (⟨(0 - : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = a3) → (iv = a0 ∨ iv = a1 ∨ - iv = a2 ∨ iv = a3)))))))))))) ) := by + exact + ∀ (C : BandCircle), + ∀ (x : GaussianInt), + ∀ (v : GaussianInt), + ∀ (hv : v ∈ TilingLattice C), + (∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + let iv : TilingLattice C := ⟨v, hv⟩; + ((∃ y ∈ (P.tile iv).cells, + y = x ∨ y = x - 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → + (∀ (a0 : ↥(TilingLattice C)), + ((∀ (y : ↥(TilingLattice C)), + (fun (a : ↥(TilingLattice C)) => x ∈ (P.tile a).cells) y → + y = a0) → + (∀ (a1 : ↥(TilingLattice C)), + ((∀ (y : ↥(TilingLattice C)), + (fun (a : ↥(TilingLattice C)) => + x - (1 : LatticeCell) ∈ (P.tile a).cells) + y → + y = a1) → + (∀ (a2 : ↥(TilingLattice C)), + ((∀ (y : ↥(TilingLattice C)), + (fun (a : ↥(TilingLattice C)) => + x - (1 : LatticeCell) - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ + (P.tile a).cells) + y → + y = a2) → + (∀ (a3 : ↥(TilingLattice C)), + ((∀ (y : ↥(TilingLattice C)), + (fun (a : ↥(TilingLattice C)) => + x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ + (P.tile a).cells) + y → + y = a3) → + (iv = a0 ∨ + iv = a1 ∨ iv = a2 ∨ iv = a3)))))))))))) := by classical - intro C T x v hv hx P iv hxi hcorner hcornerOutside a0 ha0 hu0 a1 ha1 hu1 a2 ha2 hu2 a3 ha3 hu3 + intro C x v hv P iv hcorner a0 hu0 a1 hu1 a2 hu2 a3 hu3 rcases hcorner with ⟨y, hy, rfl | rfl | rfl | rfl⟩ · exact Or.inl (hu0 iv hy) · exact Or.inr (Or.inl (hu1 iv hy)) @@ -1660,8 +1671,7 @@ theorem PeriodicBoundaryWebLaplacian (C : BandCircle) (WebLaplacianGeometry.atMostOneRemaining) (I := I) f m hother hnotinj let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] have hmexists := WebLaplacianGeometry.hmexists C v hv a0 a1 a2 a3 - (WebLaplacianGeometry.hvowner C T x v hv hx P hxi hcorner hcornerOutside a0 ha0 hu0 a1 - ha1 hu1 a2 ha2 hu2 a3 ha3 hu3) + (WebLaplacianGeometry.hvowner C x v hv P hcorner a0 hu0 a1 hu1 a2 hu2 a3 hu3) obtain ⟨m, hm⟩ := hmexists have hnotinj := WebLaplacianGeometry.hnotinj C a0 a1 a2 a3 hfour have hother := WebLaplacianGeometry.hother C v hv a0 a1 a2 a3 m hm diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicEdgeContactSymmetry.lean b/LeanPool/ApollonianSuperharmonic/PeriodicEdgeContactSymmetry.lean new file mode 100644 index 0000000000..ca918ce1ba --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PeriodicEdgeContactSymmetry.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.P3723T1EdgeContact +public import Mathlib.Init + + +/-! +# PeriodicEdgeContactSymmetry + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace PeriodicEdgeContactSymmetry + +/-- Shared symmetric identity for PeriodicEdgeContactSymmetry. -/ +theorem symmetric : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P + a b ↔ P3723T1EdgeContact P b a ) := by + classical + intro ι P a b + simp only [P3723T1EdgeContact, ne_comm, Set.inter_comm] + +end PeriodicEdgeContactSymmetry +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean index 720e73ba6b..e3ab42af44 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean @@ -6,15 +6,9 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.CircleMatrixSymmetry -public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices -public import LeanPool.ApollonianSuperharmonic.CircleMatrix -public import LeanPool.ApollonianSuperharmonic.ExactTileTiling -public import LeanPool.ApollonianSuperharmonic.FourNeighborAdjacent -public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity -public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm -public import LeanPool.ApollonianSuperharmonic.PartialOdometer public import LeanPool.ApollonianSuperharmonic.RegularTileFamily public import LeanPool.ApollonianSuperharmonic.QuadraticAffineLaplacian public import LeanPool.ApollonianSuperharmonic.RealLaplacianLinearity @@ -90,43 +84,6 @@ private theorem hordered : (D.filter fun z => z + I ∈ D).card) omega -private theorem hcornerCount : - (by - classical - exact - ∀ (T : ProtoTile), - let I : GaussianInt := ⟨0, 1⟩ - let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => - ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) - ∀ (z : GaussianInt), cornerBag.count z = (if z ∈ T.cells then 1 else 0) + (if z - 1 ∈ - T.cells then 1 else 0) + (if z - I ∈ T.cells then 1 else 0) + (if z - 1 - I ∈ T.cells - then 1 else 0) ) := by - classical - intro T I cornerBag z - dsimp only [cornerBag] - rw [Multiset.count_bind, ← Finset.sum_eq_multiset_sum] - simp only [Multiset.coe_count, List.count_cons, beq_iff_eq, - List.count_nil] - have h11 : ∀ c : GaussianInt, (c + 1 + I = z) ↔ (c = z - 1 - I) := by - intro c - constructor <;> intro h - · rw [← h]; ring - · rw [h]; ring - have hI : ∀ c : GaussianInt, (c + I = z) ↔ (c = z - I) := by - intro c - constructor <;> intro h - · rw [← h]; ring - · rw [h]; ring - have h1 : ∀ c : GaussianInt, (c + 1 = z) ↔ (c = z - 1) := by - intro c - constructor <;> intro h - · rw [← h]; ring - · rw [h]; ring - simp_rw [h11, hI, h1] - simp only [Finset.sum_add_distrib, zero_add] - rw [Finset.sum_ite_eq', Finset.sum_ite_eq', Finset.sum_ite_eq', - Finset.sum_ite_eq'] - omega private theorem hfull_not_boundary : (by @@ -1627,17 +1584,6 @@ private theorem hFstencil_sum : rw [← Finset.mul_sum] ring -private theorem hsym : - (by - classical - exact - ∀ (C : BandCircle), (CircleMatrix C).IsSymm ) := by - classical - intro C - unfold Matrix.IsSymm CircleMatrix - dsimp - ext i j - fin_cases i <;> fin_cases j <;> rfl private theorem hF_eq : (by @@ -1966,7 +1912,7 @@ private theorem hcountBridge : D.card + (BoundaryFootprintEdges T).ncard := PeriodicIndegreeGeometry.hvertex_partition T D heuler hinc (PeriodicIndegreeGeometry.hN4 T D hDmem hsectorAll hcells - (PeriodicIndegreeGeometry.hcornerCount T) (PeriodicIndegreeGeometry.hfull_not_boundary T + (TileCornerMultiplicity.cornerCount T) (PeriodicIndegreeGeometry.hfull_not_boundary T hcells)) -- A base point and direction give a unique tag for each footprint edge. let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => @@ -2108,7 +2054,7 @@ theorem PeriodicTileTotalIndegree (C : BandCircle) g (PeriodicIndegreeGeometry.hsumDelta_one C T g hcell_curv (PeriodicIndegreeGeometry.hsumDelta C T g b (PeriodicIndegreeGeometry.hFstencil_sum C T g hsumTranslate b hFperiod) (PeriodicIndegreeGeometry.hFlap C g b - (PeriodicIndegreeGeometry.hsym C) (PeriodicIndegreeGeometry.hF_eq C g b))) + (CircleMatrixSymmetry.symmetric C) (PeriodicIndegreeGeometry.hF_eq C g b))) (PeriodicIndegreeGeometry.htrace C) (PeriodicIndegreeGeometry.hcurvCast C)) (PeriodicIndegreeGeometry.hsum_partition T h hDfilterProp) (PeriodicIndegreeGeometry.hB_lap T g hweb))) diff --git a/LeanPool/ApollonianSuperharmonic/RootComplexCoordinates.lean b/LeanPool/ApollonianSuperharmonic/RootComplexCoordinates.lean new file mode 100644 index 0000000000..d61fb07ffb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/RootComplexCoordinates.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Analysis.Complex.ReImTopology +public import Mathlib.Init +public import Mathlib.NumberTheory.Zsqrtd.GaussianInt + + +/-! +# RootComplexCoordinates + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace RootComplexCoordinates + +/-- Shared lowerGaussianCoordinate identity for RootComplexCoordinates. -/ +theorem lowerGaussianCoordinate (a : GaussianInt) : ((1 + 2 * a : GaussianInt) : Complex) = ⟨(2 + * (a.re : Real)) + 1, (2 * (a.im : Real))⟩ := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + change (((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩) + rw [GaussianInt.toComplex_def₂] + apply Complex.ext <;> simp [Zsqrtd.re_add, Zsqrtd.re_mul, + Zsqrtd.im_add, Zsqrtd.im_mul, L, y]; ring + +/-- Shared upperGaussianCoordinate identity for RootComplexCoordinates. -/ +theorem upperGaussianCoordinate (a : GaussianInt) : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : + Complex) = + ⟨(2 * (a.re : Real)) + 1, (2 * (a.im : Real)) + 2⟩ := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + change (((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = + ⟨L + 1, y + 2⟩) + rw [GaussianInt.toComplex_def₂] + apply Complex.ext <;> simp [Zsqrtd.re_add, Zsqrtd.re_mul, + Zsqrtd.im_add, Zsqrtd.im_mul, L, y]; ring + +/-- Shared lowerComplexCoordinate identity for RootComplexCoordinates. -/ +theorem lowerComplexCoordinate (a : GaussianInt) : (1 : Complex) + GaussianInt.toComplex (2 : + GaussianInt) * + (a : Complex) = ⟨(2 * (a.re : Real)) + 1, (2 * (a.im : Real))⟩ := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + have lowerGaussianCoordinate : ((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩ := + lowerGaussianCoordinate a + change ((1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) = ⟨L + 1, y⟩) + rw [GaussianInt.toComplex_add, GaussianInt.toComplex_one] at lowerGaussianCoordinate + rw [GaussianInt.toComplex_mul] at lowerGaussianCoordinate + exact lowerGaussianCoordinate + +/-- Shared upperComplexCoordinate identity for RootComplexCoordinates. -/ +theorem upperComplexCoordinate (a : GaussianInt) : (1 : Complex) + GaussianInt.toComplex (2 : + GaussianInt) * + (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (⟨0, 1⟩ : GaussianInt) = ⟨(2 * (a.re : Real)) + 1, (2 * (a.im : Real)) + 2⟩ := by + classical + let L : Real := 2 * (a.re : Real) + let y : Real := 2 * (a.im : Real) + have upperGaussianCoordinate : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = + ⟨L + 1, y + 2⟩ := upperGaussianCoordinate a + change ((1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * + (⟨0, 1⟩ : GaussianInt) = ⟨L + 1, y + 2⟩) + rw [GaussianInt.toComplex_add, GaussianInt.toComplex_add, + GaussianInt.toComplex_one] at upperGaussianCoordinate + rw [GaussianInt.toComplex_mul, GaussianInt.toComplex_mul] at upperGaussianCoordinate + exact upperGaussianCoordinate + +/-- Shared twoReal identity for RootComplexCoordinates. -/ +theorem twoReal : (GaussianInt.toComplex (2 : GaussianInt)).re = 2 := by + classical + norm_num [GaussianInt.toComplex_def] + +/-- Shared twoImaginary identity for RootComplexCoordinates. -/ +theorem twoImaginary : (GaussianInt.toComplex (2 : GaussianInt)).im = 0 := by + classical + norm_num [GaussianInt.toComplex_def] + +/-- Shared rectangleInterior identity for RootComplexCoordinates. -/ +theorem rectangleInterior (l u v w : Real) : + interior (Set.Icc l u ×ℂ Set.Icc v w) = + {z : Complex | l < z.re ∧ z.re < u ∧ v < z.im ∧ z.im < w} := by + classical + ext z + simp [Complex.interior_reProdIm, interior_Icc, Complex.mem_reProdIm, Set.mem_Ioo, and_assoc] + +/-- Shared sqrtTwentyFive identity for RootComplexCoordinates. -/ +theorem sqrtTwentyFive : Real.sqrt (25 : Real) = 5 := by + classical + rw [show (25 : Real) = 5 * 5 by norm_num] + exact Real.sqrt_mul_self (by norm_num) + +/-- Shared sqrtSixteen identity for RootComplexCoordinates. -/ +theorem sqrtSixteen : Real.sqrt (16 : Real) = 4 := by + classical + rw [show (16 : Real) = 4 * 4 by norm_num] + exact Real.sqrt_mul_self (by norm_num) + +end RootComplexCoordinates +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/SignSquareProduct.lean b/LeanPool/ApollonianSuperharmonic/SignSquareProduct.lean new file mode 100644 index 0000000000..755e136fe8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/SignSquareProduct.lean @@ -0,0 +1,33 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Basic.Real.Basic +public import Mathlib.Init +public import Mathlib.Tactic.Linarith.Frontend + + +/-! +# SignSquareProduct + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace SignSquareProduct + +/-- Shared product identity for SignSquareProduct. -/ +theorem product (σ : ℝ) (hσ : σ ^ 2 = 1) : σ * σ = 1 := by + classical + nlinarith [hσ] + +end SignSquareProduct +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileCornerMultiplicity.lean b/LeanPool/ApollonianSuperharmonic/TileCornerMultiplicity.lean new file mode 100644 index 0000000000..4eca451ca2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileCornerMultiplicity.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProtoTile +public import Mathlib.Init + + +/-! +# TileCornerMultiplicity + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace TileCornerMultiplicity + +/-- Shared cornerCount identity for TileCornerMultiplicity. -/ +theorem cornerCount : + (by + classical + exact + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + ∀ (z : GaussianInt), cornerBag.count z = (if z ∈ T.cells then 1 else 0) + (if z - 1 ∈ + T.cells then 1 else 0) + (if z - I ∈ T.cells then 1 else 0) + (if z - 1 - I ∈ T.cells + then 1 else 0) ) := by + classical + intro T I cornerBag z + dsimp only [cornerBag] + rw [Multiset.count_bind, ← Finset.sum_eq_multiset_sum] + simp only [Multiset.coe_count, List.count_cons, beq_iff_eq, + List.count_nil] + have h11 : ∀ c : GaussianInt, (c + 1 + I = z) ↔ + (c = z - 1 - I) := by + intro c + constructor <;> intro h + · rw [← h]; ring + · rw [h]; ring + have hI : ∀ c : GaussianInt, (c + I = z) ↔ (c = z - I) := by + intro c + constructor <;> intro h + · rw [← h]; ring + · rw [h]; ring + have h1 : ∀ c : GaussianInt, (c + 1 = z) ↔ (c = z - 1) := by + intro c + constructor <;> intro h + · rw [← h]; ring + · rw [h]; ring + simp_rw [h11, hI, h1] + simp only [Finset.sum_add_distrib, zero_add] + rw [Finset.sum_ite_eq', Finset.sum_ite_eq', Finset.sum_ite_eq', + Finset.sum_ite_eq'] + omega + +end TileCornerMultiplicity +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileHalfTurnGeometry.lean b/LeanPool/ApollonianSuperharmonic/TileHalfTurnGeometry.lean new file mode 100644 index 0000000000..82b22f0819 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileHalfTurnGeometry.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import Mathlib.Init + + +/-! +# TileHalfTurnGeometry + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace TileHalfTurnGeometry + +/-- Shared involutive identity for TileHalfTurnGeometry. -/ +theorem involutive : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ + Function.Involutive tau ) := by + classical + intro q u w t tau z + dsimp [tau] + abel + +/-- Shared cells identity for TileHalfTurnGeometry. -/ +theorem cells : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t + let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ + ∀ U, (H U).cells = U.cells.image tau ) := by + classical + intro q u w t H tau U + simp only [H, TileTranslation, TileQuarterTurn, Finset.image_image] + apply Finset.image_congr + intro z hz + apply Zsqrtd.ext <;> simp [Function.comp_def, GaussianTranslation, + GaussianQuarterTurn, tau] <;> ring + +/-- Shared realization identity for TileHalfTurnGeometry. -/ +theorem realization : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + ((t.re : Real) = 2 * (TileCentroid T).1 ∧ (t.im : Real) = 2 * (TileCentroid T).2) → ( + let H : ProtoTile → ProtoTile := fun U => + TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t + ∀ U, TileRealization (H U) = (fun p : Real × Real => (2 * (TileCentroid T).1 - p.1, 2 * + (TileCentroid T).2 - p.2)) '' TileRealization U) ) := by + classical + intro q T u w t ht H U + dsimp only [H] + rw [(TileTranslationFormulas _ t).2.2.2.1, + (TileQuarterTurnFormulas (TileQuarterTurn U)).2.2.2.1, + (TileQuarterTurnFormulas U).2.2.2.1, Set.image_image, Set.image_image] + congr 1 + funext p + apply Prod.ext <;> dsimp <;> simp only [ht.1, ht.2] <;> ring + +end TileHalfTurnGeometry +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean index a19859cb18..81186c4b88 100644 --- a/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianCoordinateFacts public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.FootprintEdges @@ -82,12 +83,7 @@ private theorem quarter_im_base (x : GaussianInt) : rcases x with ⟨a, b⟩ simp [GaussianQuarterTurn, GaussianInt.toComplex_def] -private theorem gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) - (him : u.im = v.im) : u = v := by - classical - rcases u with ⟨u, w⟩ - rcases v with ⟨v, z⟩ - simp_all +private abbrev gaussian_equal := GaussianCoordinateFacts.equal private theorem turn_up (a : GaussianInt) : GaussianQuarterTurn (a + ⟨0, 1⟩) = GaussianQuarterTurn a - 1 := by @@ -124,10 +120,7 @@ private theorem minus_one_add_up (u : GaussianInt) : (him : u.im = v.im) : u = v := gaussian_equal u v hre him apply gaussian_equal <;> simp -private theorem pair_swap (u v : GaussianInt) : ({u, v} : Finset GaussianInt) = {v, u} := by - classical - ext z - simp [or_comm] +private abbrev pair_swap := GaussianCoordinateFacts.pairSwap private noncomputable def cellInverse : GaussianInt → GaussianInt := fun z => ⟨(z + 1).im, -(z + 1).re⟩ @@ -449,7 +442,7 @@ theorem TileQuarterTurnFormulas : ∀ T : ProtoTile, have minus_one_add_up (u : GaussianInt) : u - 1 + ⟨0, 1⟩ = ⟨u.re - 1, u.im + 1⟩ := QuarterTurnFormulas.minus_one_add_up u have pair_swap (u v : GaussianInt) : ({u, v} : Finset GaussianInt) = {v, u} := - QuarterTurnFormulas.pair_swap u v + GaussianCoordinateFacts.pairSwap u v dsimp [TileQuarterTurn] constructor · rfl diff --git a/LeanPool/ApollonianSuperharmonic/TileQuarterTurnTranslation.lean b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnTranslation.lean new file mode 100644 index 0000000000..d3e9c15a06 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnTranslation.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurn +public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import Mathlib.Init + + +/-! +# TileQuarterTurnTranslation + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace TileQuarterTurnTranslation + +/-- Shared commute identity for TileQuarterTurnTranslation. -/ +theorem commute : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (x : GaussianInt), TileQuarterTurn (TileTranslation T x) = + TileTranslation (TileQuarterTurn T) (GaussianQuarterTurn x) + ) := by + classical + intro T x + cases T with + | mk cells anchor => + have map : (fun z : GaussianInt => GaussianQuarterTurn (z + x) - 1) = + (fun z : GaussianInt => (GaussianQuarterTurn z - 1) + + GaussianQuarterTurn x) := by + funext z + ext <;> simp [GaussianQuarterTurn, add_comm]; ring + apply congrArg₂ (fun c : FiniteTile => fun d : GaussianInt => + ProtoTile.mk c d) + · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, + Finset.image_image, Function.comp_def, map] + · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, + GaussianQuarterTurn, add_comm] + +end TileQuarterTurnTranslation +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean index b8fbab375e..ab47bf22a6 100644 --- a/LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianCoordinateFacts public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertices public import LeanPool.ApollonianSuperharmonic.FootprintEdges @@ -31,12 +32,7 @@ namespace ReflectionFormulas private noncomputable def f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ -private theorem gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) - (him : u.im = v.im) : u = v := by - classical - rcases u with ⟨u, w⟩ - rcases v with ⟨v, z⟩ - simp_all +private abbrev gaussian_ext := GaussianCoordinateFacts.equal private theorem reflection_involutive (z : GaussianInt) : GaussianReflection (GaussianReflection z) = z := by @@ -197,10 +193,7 @@ private theorem f_im_cast (z : GaussianInt) : rcases z with ⟨a, b⟩ simp [f, GaussianReflection] -private theorem pair_swap (u v : GaussianInt) : ({u, v} : Finset GaussianInt) = {v, u} := by - classical - ext z - simp [or_comm] +private abbrev pair_swap := GaussianCoordinateFacts.pairSwap private theorem cell_formula (T : ProtoTile) (z : GaussianInt) : z ∈ (TileReflection T).cells ↔ f z ∈ T.cells := by @@ -326,7 +319,7 @@ theorem TileReflectionFormulas : ∀ T : ProtoTile, have f_im_cast (z : GaussianInt) : ((f z).im : Real) = -(z.im : Real) - 1 := ReflectionFormulas.f_im_cast z have pair_swap (u v : GaussianInt) : ({u, v} : Finset GaussianInt) = {v, u} := - ReflectionFormulas.pair_swap u v + GaussianCoordinateFacts.pairSwap u v dsimp [TileReflection] constructor · rfl diff --git a/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean b/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean index e5de92714f..5309c23d76 100644 --- a/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean @@ -179,20 +179,6 @@ private theorem family : · rintro ⟨z, hz, _⟩ exact ⟨index z, index_mem z, hz⟩ -private theorem point_inj : - (by - classical - exact - Function.Injective GaussianRealPoint ) := by - classical - intro x y hxy - apply Zsqrtd.ext - · have h := congrArg Prod.fst hxy - dsimp [GaussianRealPoint] at h - exact_mod_cast h - · have h := congrArg Prod.snd hxy - dsimp [GaussianRealPoint] at h - exact_mod_cast h private theorem index_sub : (by @@ -781,7 +767,7 @@ theorem TileStringCoordinateTransport (C : BandCircle) (orientation : Bool) index_mem translation_inj U have tile_mem (z : Int × Int) : tileAt z ∈ RegularTileFamily base (TilingLattice C) := ⟨index z, index_mem z, rfl⟩ - have point_inj : Function.Injective GaussianRealPoint := StringCoordinateGeometry.point_inj + have point_inj : Function.Injective GaussianRealPoint := GaussianRealPointProperties.injective have centroid (z : Int × Int) : TileCentroid (tileAt z) = ((TileCentroid base).1 + ((index z).re : Int), (TileCentroid base).2 + ((index z).im : Int)) := diff --git a/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean b/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean index b266b09938..2a0c71ba49 100644 --- a/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean +++ b/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileHalfTurnGeometry public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches public import LeanPool.ApollonianSuperharmonic.BandSignedOccurrenceHalfTurn @@ -233,63 +234,8 @@ private theorem ht : push_cast constructor <;> linarith -private theorem htau : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (u : GaussianInt), - let w := BandVectors.1 (q 3) (q 2) - let t : GaussianInt := - ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ - let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ - Function.Involutive tau ) := by - classical - intro q u w t tau z - dsimp [tau] - abel -private theorem hHcells : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (u : GaussianInt), - let w := BandVectors.1 (q 3) (q 2) - let t : GaussianInt := - ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ - let H : ProtoTile → ProtoTile := fun U => - TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t - let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ - ∀ U, (H U).cells = U.cells.image tau ) := by - classical - intro q u w t H tau U - simp only [H, TileTranslation, TileQuarterTurn, Finset.image_image] - apply Finset.image_congr - intro z hz - apply Zsqrtd.ext <;> simp [Function.comp_def, GaussianTranslation, - GaussianQuarterTurn, tau] <;> ring -private theorem hHreal : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (u : GaussianInt), - let w := BandVectors.1 (q 3) (q 2) - let t : GaussianInt := - ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ - ((t.re : Real) = 2 * (TileCentroid T).1 ∧ (t.im : Real) = 2 * (TileCentroid T).2) → ( - let H : ProtoTile → ProtoTile := fun U => - TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t - ∀ U, TileRealization (H U) = (fun p : Real × Real => (2 * (TileCentroid T).1 - p.1, 2 * - (TileCentroid T).2 - p.2)) '' TileRealization U) ) := by - classical - intro q T u w t ht H U - dsimp only [H] - rw [(TileTranslationFormulas _ t).2.2.2.1, - (TileQuarterTurnFormulas (TileQuarterTurn U)).2.2.2.1, - (TileQuarterTurnFormulas U).2.2.2.1, Set.image_image, Set.image_image] - congr 1 - funext p - apply Prod.ext <;> dsimp <;> simp only [ht.1, ht.2] <;> ring private theorem hcenter : (by @@ -434,9 +380,9 @@ theorem TileT1DiskArea (q : Fin 4 → CircleCoordinates) let H : ProtoTile → ProtoTile := fun U => TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ - have htau := DiskAreaGeometry.htau q u - have hHcells := DiskAreaGeometry.hHcells q u - have hHreal := DiskAreaGeometry.hHreal q T u ht + have htau := TileHalfTurnGeometry.involutive q u + have hHcells := TileHalfTurnGeometry.cells q u + have hHreal := TileHalfTurnGeometry.realization q T u ht have hcenter := DiskAreaGeometry.hcenter q T have hreflectCells := DiskAreaGeometry.hreflectCells q T u hHreal hcenter have hHT : (H T).cells = T.cells := diff --git a/LeanPool/ApollonianSuperharmonic/TileTouchingDisjoint.lean b/LeanPool/ApollonianSuperharmonic/TileTouchingDisjoint.lean new file mode 100644 index 0000000000..9f2236d5f5 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileTouchingDisjoint.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import Mathlib.Init + + +/-! +# TileTouchingDisjoint + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace TileTouchingDisjoint + +/-- Shared cells identity for TileTouchingDisjoint. -/ +theorem cells : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → ((Y.cells.Nonempty) → + ((TileTouching X Y) → (Disjoint X.cells Y.cells))) ) := by + classical + intro X Y hX hY hxy + rcases hxy with ⟨_, _, hd, _⟩ | ⟨he, _⟩ | ⟨he, _⟩ + · exact hd + · simp [he] at hX + · simp [he] at hY + +end TileTouchingDisjoint +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileTranslationProperties.lean b/LeanPool/ApollonianSuperharmonic/TileTranslationProperties.lean new file mode 100644 index 0000000000..d57fc633a0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileTranslationProperties.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas +public import Mathlib.Init + + +/-! +# TileTranslationProperties + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization of +Levine–Pegden–Smart, replacing repeated implementations at their common dependency level. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace TileTranslationProperties + +/-- Shared zero identity for TileTranslationProperties. -/ +theorem zero : + (by + classical + exact + ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by + classical + intro U + have hzero : GaussianTranslation (0 : GaussianInt) = id := by + funext z + simp [GaussianTranslation] + cases U + simp [TileTranslation, hzero, GaussianTranslation] + +/-- Shared cells identity for TileTranslationProperties. -/ +theorem cells : + (by + classical + exact + ∀ (X : ProtoTile), ∀ (d : GaussianInt), (TileTranslation X d).cells = X.cells.image + (GaussianTranslation d) ) := by + classical + intro X d + exact (TileTranslationFormulas X d).1 + +/-- Shared add identity for TileTranslationProperties. -/ +theorem add : + (by + classical + exact + ∀ (T : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), TileTranslation + (TileTranslation T v) z = TileTranslation T (v + z) ) := by + classical + intro T v z + cases T with + | mk cells anchor => + apply congrArg₂ ProtoTile.mk + · ext q + simp [TileTranslation, GaussianTranslation, add_comm, add_left_comm] + · simp [TileTranslation, GaussianTranslation, add_comm, add_left_comm] + +end TileTranslationProperties +end ApollonianSuperharmonic + +end From 12372a911a54016af6d9a18be04357c462d4747a Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Thu, 12 Nov 2026 23:18:15 +0000 Subject: [PATCH 10/23] Share remaining Apollonian infrastructure and localize elementary proofs --- ...BandExceptionalRestorationSectorOrder.lean | 28 +- .../BandLayoutCentroidCoordinates.lean | 58 + .../BandLayoutFaceSupport.lean | 69 + .../BandLayoutParentNonempty.lean | 41 + .../BandOrderedGeneralLayout.lean | 38 +- .../BandOrderedGeneralRawSupport.lean | 70 +- ...eneralRightInterfaceCertificateExists.lean | 96 +- ...alRightNormalizationCertificateExists.lean | 197 +- ...rderedGeneralRightSelectedRowGeometry.lean | 591 +---- ...eralSubtileInterfaceCertificateExists.lean | 28 +- ...SubtileNormalizationCertificateExists.lean | 238 +-- ...lOccurrenceIntersectionClassification.lean | 65 +- .../BandOriginalParentContainment.lean | 61 + .../BandPackingSymmetryCovariance.lean | 40 +- .../BandPackingSymmetryDomainTransport.lean | 36 + .../BandPackingSymmetryLinearIdentities.lean | 51 + ...ndPackingSymmetryMarkedDataCovariance.lean | 68 +- .../BandPackingSymmetryT3T5Covariance.lean | 56 +- ...PackingSymmetryTileOdometerCovariance.lean | 15 +- .../BandParentCentroidComparison.lean | 61 + .../BandPrototileCentroidBounds.lean | 66 + .../BandPrototileCompleteSquareCentroid.lean | 39 +- .../BandPrototileExists.lean | 106 +- .../BandPrototileQuarterTurn.lean | 54 + .../BandQuadrupleCyclicRotation.lean | 55 + .../BandRegularTranslatePeriodicComplex.lean | 15 +- .../BandRetainedBoundaryGenealogy.lean | 14 +- .../BandTileAcyclicIndegree.lean | 83 +- .../BoundaryStringConcatenation.lean | 16 +- .../BoundaryStringOdometerRespect.lean | 55 +- .../CellDisjointCommonFootprintIncidence.lean | 37 +- ...amondOpposingBoundaryStarLocalization.lean | 19 +- .../ExceptionalModifiedABPath.lean | 38 +- .../FiniteSquareIncidenceIdentities.lean | 31 +- .../FordCoordinateConfiguration.lean | 12 +- .../ApollonianSuperharmonic/FordFareySum.lean | 13 + .../FordLaplacianTable.lean | 45 +- .../FordLeftBoundaryCompatibility.lean | 71 +- .../FourNeighborLaplacianProperties.lean | 23 + LeanPool/ApollonianSuperharmonic/Imports.lean | 16 + .../LatticeAdjacentPackingSymmetryFacts.lean | 37 +- .../LatticeFootprintIncidence.lean | 52 + .../LatticeTileThreeDiskJunction.lean | 57 +- ...tticeAdjacentPackingSymmetryTransport.lean | 2 + .../ListEndpointFacts.lean | 27 + .../MarkedOdometerAdjacencyReduction.lean | 165 +- .../ModifiedSubtileFacts.lean | 39 + .../ObservableTileRetargeting.lean | 73 + .../OpposingBoundaryOdometerStrings.lean | 100 +- .../OpposingBoundaryStarLocalization.lean | 29 +- .../OpposingStringInterfacePath.lean | 40 +- ...eneralOdometerAdjacencyClassification.lean | 34 +- .../OrientedTouchingCovariance.lean | 44 +- .../P3523T1TargetBoundary.lean | 41 +- .../P3544T1TriangleRayGeometry.lean | 21 +- .../P3555T2ParabolaChordCuts.lean | 40 +- .../P3597T1SideCrossing.lean | 148 +- .../P3650T1ExposedCornerExists.lean | 426 +--- .../P3650T1LocalCoherence.lean | 16 +- .../P3650T1OldArcEven.lean | 171 +- .../P3652T1IndexedFaceLedger.lean | 40 +- .../P3723T1AllContactDrawingExists.lean | 1902 +++-------------- .../P3776T1SectorMapsExist.lean | 76 +- .../P3821T1ComponentContours.lean | 92 +- .../P3821T1ThreeArcCircle.lean | 58 +- .../P3889T1FaceGapCoverage.lean | 18 +- .../P3934T1ArcSideComparison.lean | 60 +- .../P3963T1MixedBoundaryCycle.lean | 94 +- .../P3996T1PlacementCompanionBlocks.lean | 107 +- ...4055T1OrderedGeneralOppositeEndpoints.lean | 108 +- .../P4062T1OverlapDescent.lean | 119 +- .../P4062T1ParentalRestriction.lean | 24 +- .../P4112T1ParentalNeighbors.lean | 12 +- .../P4158T1EdgeSectorSelection.lean | 18 +- .../P4158T1MatchedFordPair.lean | 39 +- .../P4158T1SmallerStringEdges.lean | 15 +- .../P4250T2InterfaceNeighborCount.lean | 57 +- .../P4261T1CentralCoordinates.lean | 85 +- .../P4261T1RightCoordinates.lean | 84 +- .../P4261T2AncestorSymmetry.lean | 15 +- .../P4261T2UnitBoundary.lean | 38 +- .../P4261T2UnitInterface.lean | 42 +- .../P4366T2LocalSectors.lean | 139 +- .../P4418T3SelectedInterfaceExists.lean | 125 +- .../P4456T2MissingEdge.lean | 33 +- .../P4456T2OrderedNoChord.lean | 32 +- .../P4458T1RespectAppend.lean | 11 +- .../P4458T1SecondNewerRows.lean | 124 +- .../P4564T2DiamondGeometry.lean | 28 +- .../P4590T1JunctionRefinement.lean | 79 +- .../P4590T1RightInteriorGeometry.lean | 99 +- .../P4638T1ContactStarCoverage.lean | 75 +- .../P4677T2PrecursorWalk.lean | 87 +- .../P5352T2FirstUnit.lean | 70 +- .../P5352T2Predecessor2.lean | 75 +- .../P5596T1LeftWeb.lean | 20 +- ...640T1NonpairedOccurrenceIntersections.lean | 78 +- .../PairAssignmentFacts.lean | 50 + .../PartialOdometerEquality.lean | 38 + .../PeriodicBoundaryWebConnected.lean | 39 +- .../PeriodicBoundaryWebLaplacian.lean | 27 +- .../PeriodicTileTotalIndegree.lean | 38 +- ...tticeAdjacentPackingSymmetryTransport.lean | 3 + .../SimpleGridPathEndpointPairUnique.lean | 34 +- ...tticeAdjacentPackingSymmetryTransport.lean | 25 +- .../TileCornerMultiplicity.lean | 17 + .../TileOdometerSlopeNonempty.lean | 55 + .../TileQuarterTurnTranslation.lean | 8 + .../TileT1DiskArea.lean | 32 +- .../TileTranslationProperties.lean | 10 + 110 files changed, 2014 insertions(+), 6817 deletions(-) create mode 100644 LeanPool/ApollonianSuperharmonic/BandLayoutCentroidCoordinates.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandLayoutFaceSupport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandLayoutParentNonempty.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandOriginalParentContainment.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryDomainTransport.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPackingSymmetryLinearIdentities.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandParentCentroidComparison.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPrototileCentroidBounds.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandPrototileQuarterTurn.lean create mode 100644 LeanPool/ApollonianSuperharmonic/BandQuadrupleCyclicRotation.lean create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeFootprintIncidence.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ModifiedSubtileFacts.lean create mode 100644 LeanPool/ApollonianSuperharmonic/ObservableTileRetargeting.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PairAssignmentFacts.lean create mode 100644 LeanPool/ApollonianSuperharmonic/PartialOdometerEquality.lean create mode 100644 LeanPool/ApollonianSuperharmonic/TileOdometerSlopeNonempty.lean diff --git a/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean b/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean index 8fc59325e7..bb441c4adc 100644 --- a/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean +++ b/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion public import LeanPool.ApollonianSuperharmonic.TileTouchingDisjoint public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction @@ -394,31 +395,8 @@ private theorem hOD : exact Finset.disjoint_left.mp hAD (seg.precursor_in_left hxO) hxD -private theorem edge_vertex_footprint : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges U) → (∀ (x : - GaussianInt), (x ∈ e) → (x ∈ FootprintVertices U)) ) := by - classical - intro U e he x hx - rcases he with ⟨c, hc, he⟩ - simp only [FootprintVertices, ite_eq_left (show U.cells.Nonempty from ⟨c, hc⟩), - Set.mem_ofPred_eq] - rcases he with h | h | h | h <;> subst e - all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hx - · rcases hx with rfl | rfl - · exact ⟨_, hc, Or.inl rfl⟩ - · exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ - · rcases hx with rfl | rfl - · exact ⟨_, hc, Or.inl rfl⟩ - · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ - · rcases hx with rfl | rfl - · exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ - · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ - · rcases hx with rfl | rfl - · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ - · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ +private abbrev edge_vertex_footprint := + BoundaryFootprintInclusion.edgeVertex private theorem boundary_raw : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandLayoutCentroidCoordinates.lean b/LeanPool/ApollonianSuperharmonic/BandLayoutCentroidCoordinates.lean new file mode 100644 index 0000000000..931de4cbc0 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandLayoutCentroidCoordinates.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import Mathlib.Init + + +/-! +# BandLayoutCentroidCoordinates + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace BandLayoutCentroidCoordinates + +/-- Shared doubledCenter fact. -/ +theorem doubledCenter : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : + BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg + C T), ∀ (u : GaussianInt), (GaussianRealPoint u = ((TileCentroid (layout.P (0 : Fin + (3 : ℕ)) false)).1 + (TileCentroid (layout.P (0 : Fin (3 : ℕ)) false)).2, + (TileCentroid (layout.P (0 : Fin (3 : ℕ)) false)).2 - (TileCentroid (layout.P (0 : + Fin (3 : ℕ)) false)).1)) → ( + let w := BandVectors.1 (q 3) (q 2) + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ + (t.re : Real) = 2 * (TileCentroid T).1 ∧ (t.im : Real) = 2 * (TileCentroid T).2) ) := by + classical + intro q cfg C T layout u hu w t + have hur := congrArg Prod.fst hu + have hui := congrArg Prod.snd hu + have hc := (layout.outer_occurrence 0 false).2.2 + have hcr := congrArg Prod.fst hc + have hci := congrArg Prod.snd hc + norm_num [GaussianRealPoint] at hur hui hcr hci + simp only [← GaussianInt.intCast_re, ← GaussianInt.intCast_im] at hur hui hcr hci + dsimp [t, w] + push_cast + constructor <;> linarith + + + + + +end BandLayoutCentroidCoordinates +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandLayoutFaceSupport.lean b/LeanPool/ApollonianSuperharmonic/BandLayoutFaceSupport.lean new file mode 100644 index 0000000000..bb19d50440 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandLayoutFaceSupport.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate + +/-! +# BandLayoutFaceSupport + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace BandLayoutFaceSupport + +/-- Shared firstFace fact. -/ +theorem firstFace : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : + cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i + = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = c) → h = f ∨ h = g) + → (f1 = f ∨ f1 = g) ) := by + classical + intro q cfg C₀ T cert a c f1 f g hfaces + apply hfaces + constructor + · exact ⟨0, by simp [f1, a, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + · exact ⟨2, by simp [f1, c, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + +/-- Shared thirdFace fact. -/ +theorem thirdFace : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ + ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : + cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i + = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = c) → h = f ∨ h = g) + → (f3 = f ∨ f3 = g) ) := by + classical + intro q cfg C₀ T cert a c f3 f g hfaces + apply hfaces + constructor + · exact ⟨0, by simp [f3, a, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + · exact ⟨1, by simp [f3, c, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ + +end BandLayoutFaceSupport +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandLayoutParentNonempty.lean b/LeanPool/ApollonianSuperharmonic/BandLayoutParentNonempty.lean new file mode 100644 index 0000000000..22adddc7eb --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandLayoutParentNonempty.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate +public import Mathlib.Init + + +/-! +# BandLayoutParentNonempty + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace BandLayoutParentNonempty + +/-- Every parent tile in a general layout has a cell. -/ +theorem cells (q : Fin 4 → CircleCoordinates) (cfg : BandOrderedGeneralConfiguration q) + (C₀ : BandCircle) (T₀ : ProtoTile) + (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T₀) (j : Fin 3) (hs : Bool) : + (cert.P j hs).cells.Nonempty := by + classical + rcases cert.parent_lattice j hs with ⟨e⟩ + have hball : (0 : ℝ × ℝ) ∈ Metric.closedBall (0 : ℝ × ℝ) 1 := by + simp + have hreal : (e ⟨(0 : ℝ × ℝ), hball⟩ : ℝ × ℝ) ∈ + TileRealization (cert.P j hs) := (e ⟨0, hball⟩).property + simp only [TileRealization, Set.mem_iUnion] at hreal + rcases hreal with ⟨x, hx, _⟩ + exact ⟨x, hx⟩ + +end BandLayoutParentNonempty +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean index a16df5d422..f2f867eb8f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion public import LeanPool.ApollonianSuperharmonic.BandDoubleDecomposition public import LeanPool.ApollonianSuperharmonic.BandModifiedCoverage @@ -123,22 +124,8 @@ private theorem qne : change (Q i s).cells.card = _ at ha exact Finset.card_pos.mp (by omega) -private theorem sne : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (S : - Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (0 : ℤ) ≤ - (cfg.firstPredecessor i.succ).1 ∧ TileArea (S i s) = (cfg.firstPredecessor - i.succ).1.toNat ∧ ((0 : ℤ) < (cfg.firstPredecessor i.succ).1 → LatticeTile (S i s))) - → ((∀ (i : Fin 3), (i = 1 ∨ i = 2) → (0 < (cfg.firstPredecessor i.succ).1)) → (∀ (i : - Fin 3), ∀ (s : Bool), (i = 1 ∨ i = 2) → ((S i s).cells.Nonempty))) ) := by - classical - intro q cfg S sg rpPos i s hi - have ha := (sg i s).2.1 - have hp := rpPos i hi - change (S i s).cells.card = _ at ha - exact Finset.card_pos.mp (by omega) +private abbrev sne := + ApollonianSuperharmonic.OrderedLayoutGeometry.qne private theorem oriented : (by @@ -489,23 +476,8 @@ private theorem diskNonempty : obtain ⟨x, hx, _⟩ := hp exact ⟨x, hx⟩ -private theorem boundaryEdge : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges U) → (e ∈ - FootprintEdges U) ) := by - classical - intro U e he - rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ - · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ - · exact ⟨z, hz, Or.inl rfl⟩ - · refine ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr ?_))⟩ - congr 1 <;> simp [Zsqrtd.ext_iff] - · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ - · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ - congr 1 <;> simp [] +private abbrev boundaryEdge := + BoundaryFootprintInclusion.boundaryEdge private theorem touchEdge : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean index 9b025a5304..995dccf25f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.PairAssignmentFacts +public import LeanPool.ApollonianSuperharmonic.BandLayoutFaceSupport public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties @@ -61,47 +63,11 @@ private theorem htileC : rw [cert.modified_tile] simp [c, ModifiedSubtileOccurrenceInterpretation, translation_zero] -private theorem hf1At170 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ - let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ - ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : - cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i - = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = c) → h = f ∨ h = g) - → (f1 = f ∨ f1 = g) ) := by - classical - intro q cfg C₀ T cert a c f1 f g hfaces - apply hfaces - constructor - · exact ⟨0, by simp [f1, a, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ - · exact ⟨2, by simp [f1, c, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ +private abbrev hf1At170 := + BandLayoutFaceSupport.firstFace -private theorem hf3 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ - let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ - ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : - cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i - = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = c) → h = f ∨ h = g) - → (f3 = f ∨ f3 = g) ) := by - classical - intro q cfg C₀ T cert a c f3 f g hfaces - apply hfaces - constructor - · exact ⟨0, by simp [f3, a, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ - · exact ⟨1, by simp [f3, c, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ +private abbrev hf3 := + BandLayoutFaceSupport.thirdFace private theorem hf13 : (by @@ -118,25 +84,6 @@ private theorem hf13 : have := congrArg cert.modifiedFaceEquivalence h simp [f1, f3] at this -private theorem hpair : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ - let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ - ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (f1 = f ∨ f1 = g) → - ((f3 = f ∨ f3 = g) → ((f1 ≠ f3) → ((f1 = f ∧ f3 = g) ∨ (f1 = g ∧ f3 = f)))) ) := by - classical - intro q cfg C₀ T cert f1 f3 f g hf1 hf3 hf13 - rcases hf1 with h1 | h1 <;> rcases hf3 with h3 | h3 - · exact False.elim (hf13 (h1.trans h3.symm)) - · exact Or.inl ⟨h1, h3⟩ - · exact Or.inr ⟨h1, h3⟩ - · exact False.elim (hf13 (h1.trans h3.symm)) - private theorem hend : (by classical @@ -747,8 +694,9 @@ theorem BandOrderedGeneralRawSupport have hf1 : f1 = f ∨ f1 = g := RawSupportGeometry.hf1At170 q cfg C₀ T cert f g hfaces have hf3 : f3 = f ∨ f3 = g := RawSupportGeometry.hf3 q cfg C₀ T cert f g hfaces have hf13 : f1 ≠ f3 := RawSupportGeometry.hf13 q cfg C₀ T cert - have hpair : (f1 = f ∧ f3 = g) ∨ (f1 = g ∧ f3 = f) := RawSupportGeometry.hpair q cfg C₀ T - cert f g hf1 hf3 hf13 + have hpair : (f1 = f ∧ f3 = g) ∨ (f1 = g ∧ f3 = f) := PairAssignmentFacts.assignment + (cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩) (cert.modifiedFaceEquivalence.symm ⟨.I3, + 0, 0⟩) f g hf1 hf3 hf13 have hrho1 : cert.modified.rho f1 = z1 := cert.modified_face_points _ have hrho3 : cert.modified.rho f3 = z3 := cert.modified_face_points _ have hend : cert.modified.rho f ≠ cert.modified.rho g := RawSupportGeometry.hend q cfg C₀ T diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean index fc7858a8c5..246d5af363 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnTranslation +public import LeanPool.ApollonianSuperharmonic.ObservableTileRetargeting public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurnProperties public import LeanPool.ApollonianSuperharmonic.BandParentVectorQuarterTurn public import LeanPool.ApollonianSuperharmonic.BandVectorParentSums @@ -32,59 +34,6 @@ namespace ApollonianSuperharmonic namespace RightInterfaceCertificateGeometry -private theorem tileTouchingRetarget : - (by - classical - exact - forall (A A' B B' : ProtoTile), A.cells = A'.cells -> (A.cells = ∅ -> A.anchor = - A'.anchor) -> B.cells = B'.cells -> (B.cells = ∅ -> B.anchor = B'.anchor) -> - TileTouching A B -> TileTouching A' B' ) := by - classical - intro A A' B B' hAc hAa hBc hBa ht - have hAo := ProtoTileObservableExtensionality A A' hAc hAa - have hBo := ProtoTileObservableExtensionality B B' hBc hBa - rcases ht with ht | ht | ht - · left - refine ⟨?_, ?_, ?_, ?_⟩ - · simpa [hAc] using ht.1 - · simpa [hBc] using ht.2.1 - · simpa [hAc, hBc] using ht.2.2.1 - · simpa [hAo.2.1, hAo.2.2.1, hBo.2.1, hBo.2.2.1] using ht.2.2.2 - · right; left - refine ⟨?_, ?_⟩ - · simpa [hAc] using ht.1 - · rw [← hAa ht.1, ← hBo.2.1] - exact ht.2 - · right; right - refine ⟨?_, ?_⟩ - · simpa [hBc] using ht.1 - · rw [← hBa ht.1, ← hAo.2.1] - exact ht.2 - -private theorem touchingRetarget : - (by - classical - exact - (forall (A A' B B' : ProtoTile), A.cells = A'.cells -> (A.cells = ∅ -> A.anchor = - A'.anchor) -> B.cells = B'.cells -> (B.cells = ∅ -> B.anchor = B'.anchor) -> - TileTouching A B -> TileTouching A' B') → (forall (A A' B B' D D' : ProtoTile), - A.cells = A'.cells -> (A.cells = ∅ -> A.anchor = A'.anchor) -> B.cells = B'.cells -> - (B.cells = ∅ -> B.anchor = B'.anchor) -> D.cells = D'.cells -> (D.cells = ∅ -> - D.anchor = D'.anchor) -> TouchingTriple A B D -> TouchingTriple A' B' D') ) := by - classical - intro tileTouchingRetarget A A' B B' D D' hAc hAa hBc hBa hDc hDa ht - have hAo := ProtoTileObservableExtensionality A A' hAc hAa - have hBo := ProtoTileObservableExtensionality B B' hBc hBa - have hDo := ProtoTileObservableExtensionality D D' hDc hDa - rcases ht with ⟨hAB, hBD, hDA, p, hp, hpu⟩ - refine ⟨tileTouchingRetarget A A' B B' hAc hAa hBc hBa hAB, - tileTouchingRetarget B B' D D' hBc hBa hDc hDa hBD, - tileTouchingRetarget D D' A A' hDc hDa hAc hAa hDA, p, ?_, ?_⟩ - · simpa [← hAo.2.1, ← hBo.2.1, ← hDo.2.1] using hp - · intro y hy - apply hpu y - simpa [← hAo.2.1, ← hBo.2.1, ← hDo.2.1] using hy - private theorem hAeAt211 : (by classical @@ -96,42 +45,6 @@ private theorem hAeAt211 : simp only [FootprintEdges] rw [hAc] -private theorem quarterTranslate : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (a : GaussianInt), ∀ (u : GaussianInt), TileTranslation - (TileQuarterTurn (TileTranslation A a)) u = TileTranslation (TileTranslation - (TileQuarterTurn A) u) (GaussianQuarterTurn a) ) := by - classical - intro A a u - rcases A with ⟨cells, anchor⟩ - rw [ProtoTile.mk.injEq] - constructor - · ext z - simp only [TileTranslation, TileQuarterTurn, Finset.mem_image, - GaussianTranslation] - constructor - · rintro ⟨y, hy, rfl⟩ - rcases hy with ⟨w, hw, rfl⟩ - rcases hw with ⟨v, hv, rfl⟩ - refine ⟨GaussianQuarterTurn v - 1 + u, ?_, ?_⟩ - · refine ⟨GaussianQuarterTurn v - 1, ?_, rfl⟩ - exact ⟨v, hv, rfl⟩ - · cases a; cases v; cases u - apply Zsqrtd.ext <;> - simp [GaussianQuarterTurn] <;> omega - · rintro ⟨y, hy, rfl⟩ - rcases hy with ⟨w, hw, rfl⟩ - rcases hw with ⟨v, hv, rfl⟩ - refine ⟨GaussianQuarterTurn (GaussianTranslation a v) - 1, ?_, ?_⟩ - · exact ⟨GaussianTranslation a v, ⟨v, hv, rfl⟩, rfl⟩ - · cases a; cases v; cases u - apply Zsqrtd.ext <;> - simp [GaussianQuarterTurn, GaussianTranslation] <;> omega - · ext <;> simp [TileTranslation, TileQuarterTurn, GaussianTranslation, - GaussianQuarterTurn] <;> omega - private theorem translateObs : (by classical @@ -944,8 +857,7 @@ theorem BandOrderedGeneralRightInterfaceCertificateExists Nonempty (BandOrderedGeneralRightInterfaceCertificate normalization) := by -- BODY classical - have touchingRetarget := RightInterfaceCertificateGeometry.touchingRetarget - (RightInterfaceCertificateGeometry.tileTouchingRetarget) + have touchingRetarget := ObservableTileRetargeting.triple have swapAB : forall (A B D : ProtoTile), ExactTileInterfaceTriple A B D -> ExactTileInterfaceTriple B A D := by intro A B D E @@ -996,7 +908,7 @@ theorem BandOrderedGeneralRightInterfaceCertificateExists simpa [hAo.1] using E.unique_common y } have centeredTurnTouching := RightInterfaceCertificateGeometry.centeredTurnTouching touchingRetarget - (RightInterfaceCertificateGeometry.quarterTranslate) + (TileQuarterTurnTranslation.translated) (RightInterfaceCertificateGeometry.translateObs) have centeredTurnExact := RightInterfaceCertificateGeometry.centeredTurnExact have thirdTurnExact := RightInterfaceCertificateGeometry.thirdTurnExact centeredTurnExact diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean index 741fad7f25..30095d01e7 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean @@ -6,6 +6,9 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileQuarterTurn +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryDomainTransport +public import LeanPool.ApollonianSuperharmonic.BandQuadrupleCyclicRotation public import LeanPool.ApollonianSuperharmonic.P5658T1FivePointDomainCoverSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralRightNormalizationCertificate @@ -28,59 +31,6 @@ namespace ApollonianSuperharmonic namespace RightNormalizationGeometry -private theorem hqrotSemi : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → (∀ (r : Fin (3 : ℕ)), - ∀ (g : BandPackingSymmetry), ( - let q' := BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 - : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : - FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : - DiamondParameter), (1 : ℕ) < K.1 ∧ q' = DiamondRecursiveQuadruple K) (Nonempty - (BandOrderedGeneralConfiguration q')))) → ( - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - SemiProperQuadruple qrot)) ) := by - classical - intro q hq r g hregime qrot - fin_cases r - · convert hq.1 using 1; funext j; fin_cases j <;> simp [qrot] - · convert SemiProperQuadruple.rotate hq.1 using 1; - funext j; fin_cases j <;> simp [qrot] - · convert SemiProperQuadruple.rotate - (SemiProperQuadruple.rotate hq.1) using 1; - funext j; fin_cases j <;> simp [qrot] - -private theorem hqrot : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → (∀ (r : Fin (3 : ℕ)), - ∀ (g : BandPackingSymmetry), ( - let q' := BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 - : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : - FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : - DiamondParameter), (1 : ℕ) < K.1 ∧ q' = DiamondRecursiveQuadruple K) (Nonempty - (BandOrderedGeneralConfiguration q')))) → ( - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - (SemiProperQuadruple qrot) → (ProperBandQuadruple qrot))) ) := by - classical - intro q hq r g hregime qrot hqrotSemi - refine ⟨hqrotSemi, ?_⟩ - intro j - fin_cases r <;> fin_cases j <;> simp [qrot] - · simpa using hq.2 (0 : Fin 3) - · simpa using hq.2 (1 : Fin 3) - · simpa using hq.2 (2 : Fin 3) - · simpa using hq.2 (1 : Fin 3) - · simpa using hq.2 (2 : Fin 3) - · simpa using hq.2 (0 : Fin 3) - · simpa using hq.2 (2 : Fin 3) - · simpa using hq.2 (0 : Fin 3) - · simpa using hq.2 (1 : Fin 3) - private theorem hgeneral : (by classical @@ -267,44 +217,6 @@ private theorem hslopeImBar' : intro q i₀ e₀ r g qrot irot qbar negative pTbar pNbar hslopeImBar reverse idir ebar positive simpa [qbar, reverse, idir, ebar, positive] using hslopeImBar -private theorem hxTbar : - (by - classical - exact - ∀ (h : PartialOdometer), (PartialOdometer) → (∀ (x : GaussianInt), (x ∈ h.domain) → (∀ (g - : BandPackingSymmetry), - let hbar := BandPackingSymmetryPartialOdometerAction g h - let xbar := BandPackingSymmetryVectorAction g x - xbar ∈ hbar.domain)) ) := by - classical - intro h k x hxT g hbar xbar - have hdom := (BandPackingSymmetryPartialOdometerActionFormulas g h k).1 - have hxset : BandPackingSymmetryVectorAction g x ∈ - ((BandPackingSymmetryPartialOdometerAction g h).domain : - Set GaussianInt) := by - rw [hdom] - exact ⟨x, hxT, rfl⟩ - exact hxset - -private theorem hxNbar : - (by - classical - exact - (PartialOdometer) → (∀ (k : PartialOdometer), ∀ (x : GaussianInt), (x ∈ k.domain) → (∀ (g - : BandPackingSymmetry), - let kbar := BandPackingSymmetryPartialOdometerAction g k - let xbar := BandPackingSymmetryVectorAction g x - xbar ∈ kbar.domain)) ) := by - classical - intro h k x hxN g kbar xbar - have hdom := (BandPackingSymmetryPartialOdometerActionFormulas g k h).1 - have hxset : BandPackingSymmetryVectorAction g x ∈ - ((BandPackingSymmetryPartialOdometerAction g k).domain : - Set GaussianInt) := by - rw [hdom] - exact ⟨x, hxN, rfl⟩ - exact hxset - private theorem hsmallT1 : (by classical @@ -324,43 +236,6 @@ private theorem hsmallT1 : have hI := BandTileSimultaneousInduction q' hq' T' hT' exact ⟨hI.1, hI.2.1, hI.2.2.1 S' hocc hcells⟩ -private theorem hsmallT2 : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let qbar := BandPackingSymmetryQuadrupleAction g qrot - ∀ (D : CircleCoordinates), ∀ (U : ProtoTile), BandPrototile D U → Int.toNat D.1 < - Int.toNat (qbar 0).1 → QuarterTurnSymmetric U ) := by - classical - intro q r g qrot qbar D U hU _ - cases hU with - | line w z hw => - intro p - simp [TileRealization, TileCentroid] - | unit z a anchor => - intro p - have hc : TileCentroid (⟨{a}, anchor⟩ : ProtoTile) = - (((a.re : Int) : Real) + (1 / 2 : Real), - ((a.im : Int) : Real) + (1 / 2 : Real)) := by - simp [TileCentroid] - rw [hc] - rcases p with ⟨px, py⟩ - simp only [TileRealization, Finset.mem_singleton, Set.mem_iUnion] - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - constructor - · rintro ⟨b, rfl, hlo, hhi⟩ - refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> - linarith [hlo.1, hlo.2, hhi.1, hhi.2] - · rintro ⟨b, rfl, hlo, hhi⟩ - refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> - linarith [hlo.1, hlo.2, hhi.1, hhi.2] - | @decompose q' hq' S' U' hS hcells hfoot hcent => - exact (BandTileSimultaneousInduction q' hq' U - (.decompose hq' hS hcells hfoot hcent)).2.2.2.1 - private theorem hsmallT4 : (by classical @@ -457,47 +332,6 @@ private theorem hadjbar : · simpa [qbar, reverse, idir, ebar] using hslopeReBar · simpa [qbar, reverse, idir, ebar] using hslopeImBar -private theorem houterCentroid : - (by - classical - exact - ∀ (T : ProtoTile), - ∀ (N : ProtoTile), - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), - ∀ (i₀ : Fin (3 : ℕ)), - ∀ (e₀ : Bool), - ∀ (r : Fin (3 : ℕ)), - ∀ (g : BandPackingSymmetry), - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ]; - let irot : Fin 3 := i₀ - r; - let qbar := BandPackingSymmetryQuadrupleAction g qrot; - ∀ (negative : Bool), - let reverse := BandPackingSymmetryReversesOrientation g; - let idir : Fin 3 := if reverse then -irot else irot; - let ebar : Bool := xor (xor e₀ negative) reverse; - let positive : Bool := !ebar; - (TileCentroid (BandPackingSymmetryTileAction g N) - - TileCentroid (BandPackingSymmetryTileAction g T) = - (if positive = true then (-1 : Real) else 1) • - GaussianRealPoint - (BandVectors.1 (qbar 0) (qbar idir.succ))) → - (let Tbar := BandPackingSymmetryTileAction g T; - let Nbar := BandPackingSymmetryTileAction g N; - let displacement : GaussianInt := - (if positive = true then (1 : GaussianInt) else -1) * - BandVectors.1 (qbar 0) (qbar idir.succ); - TileCentroid Tbar = - TileCentroid (TileTranslation Nbar displacement))) := by - classical - intro T N q i₀ e₀ r g qrot irot qbar negative reverse idir ebar positive hcentBar' Tbar Nbar - displacement - rw [(TileTranslationFormulas Nbar displacement).2.2.2.2.1] - have h₁ := congrArg Prod.fst hcentBar' - have h₂ := congrArg Prod.snd hcentBar' - apply Prod.ext <;> rcases positive with (_ | _) <;> - simp [displacement, GaussianRealPoint] at h₁ h₂ ⊢ <;> linarith - private theorem boundaryData : (by classical @@ -678,8 +512,7 @@ theorem BandOrderedGeneralRightNormalizationCertificateExists obtain ⟨r, g, hregime⟩ := BandRegimeClassification q hq let qrot : Fin 4 → CircleCoordinates := ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - have hqrot := RightNormalizationGeometry.hqrot q hq r g hregime - (RightNormalizationGeometry.hqrotSemi q hq r g hregime) + have hqrot := BandQuadrupleCyclicRotation.proper q hq r let irot : Fin 3 := i₀ - r have hrotParent : qrot irot.succ = q i₀.succ := by fin_cases r <;> fin_cases i₀ <;> simp [qrot, irot] @@ -716,8 +549,8 @@ theorem BandOrderedGeneralRightNormalizationCertificateExists let hbar := BandPackingSymmetryPartialOdometerAction g h let kbar := BandPackingSymmetryPartialOdometerAction g k let xbar := BandPackingSymmetryVectorAction g x - have hxTbar := RightNormalizationGeometry.hxTbar h k x hxT g - have hxNbar := RightNormalizationGeometry.hxNbar h k x hxN g + have hxTbar := BandPackingSymmetryDomainTransport.forward g h x hxT + have hxNbar := BandPackingSymmetryDomainTransport.forward g k x hxN have hTbarBand : BandPrototile (qbar 0) Tbar := TileOdometerBandPrototile _ _ _ hOTbar have hNbarBand : BandPrototile (qbar 0) Nbar := @@ -725,7 +558,9 @@ theorem BandOrderedGeneralRightNormalizationCertificateExists have hTind := BandTileSimultaneousInduction qbar hqbar Tbar hTbarBand have hNind := BandTileSimultaneousInduction qbar hqbar Nbar hNbarBand have hsmallT1 := RightNormalizationGeometry.hsmallT1 q r g - have hsmallT2 := RightNormalizationGeometry.hsmallT2 q r g + have hsmallT2 (D : CircleCoordinates) (U : ProtoTile) (hU : BandPrototile D U) + (_ : Int.toNat D.1 < Int.toNat (qbar 0).1) : QuarterTurnSymmetric U := + BandPrototileQuarterTurn.symmetry D U hU have hsmallT4 := RightNormalizationGeometry.hsmallT4 q r g have hsmallT5 := RightNormalizationGeometry.hsmallT5 q r g have hqbarPos : 0 < (qbar 0).1 := (ProperBandCurvatureStructure qbar hqbar).1 @@ -741,8 +576,18 @@ theorem BandOrderedGeneralRightNormalizationCertificateExists let displacement : GaussianInt := (if positive = true then (1 : GaussianInt) else -1) * BandVectors.1 (qbar 0) (qbar idir.succ) - have houterCentroid := RightNormalizationGeometry.houterCentroid T N q i₀ e₀ r g negative - hcentBar' + have houterCentroid := (show + TileCentroid Tbar = TileCentroid (TileTranslation Nbar displacement) + from by + classical + change TileCentroid Nbar - TileCentroid Tbar = + (if positive = true then (-1 : Real) else 1) • + GaussianRealPoint (BandVectors.1 (qbar 0) (qbar idir.succ)) at hcentBar' + rw [(TileTranslationFormulas Nbar displacement).2.2.2.2.1] + have h₁ := congrArg Prod.fst hcentBar' + have h₂ := congrArg Prod.snd hcentBar' + apply Prod.ext <;> rcases positive with (_ | _) <;> + simp [displacement, GaussianRealPoint] at h₁ h₂ ⊢ <;> linarith) have htranslatedN : BandPrototile (qbar 0) (TileTranslation Nbar displacement) := BandPrototileTranslation _ _ _ hNbarBand diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean index edef3be3cb..9456bc959f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnTranslation +public import LeanPool.ApollonianSuperharmonic.ObservableTileRetargeting public import LeanPool.ApollonianSuperharmonic.P5640T1NonpairedOccurrenceIntersections public import LeanPool.ApollonianSuperharmonic.P5635T1RightBoundaryInterfaceRecords @@ -205,100 +207,6 @@ private theorem hedge : simp only [FootprintEdges] rw [hcell] -private theorem tileTouchingRetarget : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), (A.cells = - A'.cells) → ((A.cells = ∅ → A.anchor = A'.anchor) → ((B.cells = B'.cells) → ((B.cells - = ∅ → B.anchor = B'.anchor) → ((TileTouching A B) → (TileTouching A' B'))))) ) := by - classical - intro A A' B B' hAc hAa hBc hBa ht - have hAo := ProtoTileObservableExtensionality A A' hAc hAa - have hBo := ProtoTileObservableExtensionality B B' hBc hBa - rcases ht with ht | ht | ht - · left - refine ⟨?_, ?_, ?_, ?_⟩ - · simpa [hAc] using ht.1 - · simpa [hBc] using ht.2.1 - · simpa [hAc, hBc] using ht.2.2.1 - · simpa [hAo.2.1, hAo.2.2.1, hBo.2.1, hBo.2.2.1] using ht.2.2.2 - · right; left - refine ⟨?_, ?_⟩ - · simpa [hAc] using ht.1 - · rw [← hAa ht.1, ← hBo.2.1] - exact ht.2 - · right; right - refine ⟨?_, ?_⟩ - · simpa [hBc] using ht.1 - · rw [← hBa ht.1, ← hAo.2.1] - exact ht.2 - -private theorem touchingRetarget : - (by - classical - exact - (∀ (A : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), (A.cells = - A'.cells) → ((A.cells = ∅ → A.anchor = A'.anchor) → ((B.cells = B'.cells) → ((B.cells - = ∅ → B.anchor = B'.anchor) → ((TileTouching A B) → (TileTouching A' B')))))) → (∀ (A - : ProtoTile), ∀ (A' : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (D : - ProtoTile), ∀ (D' : ProtoTile), (A.cells = A'.cells) → ((A.cells = ∅ → A.anchor = - A'.anchor) → ((B.cells = B'.cells) → ((B.cells = ∅ → B.anchor = B'.anchor) → - ((D.cells = D'.cells) → ((D.cells = ∅ → D.anchor = D'.anchor) → ((TouchingTriple A B - D) → (TouchingTriple A' B' D')))))))) ) := by - classical - intro tileTouchingRetarget A A' B B' D D' hAc hAa hBc hBa hDc hDa ht - have hAo := ProtoTileObservableExtensionality A A' hAc hAa - have hBo := ProtoTileObservableExtensionality B B' hBc hBa - have hDo := ProtoTileObservableExtensionality D D' hDc hDa - rcases ht with ⟨hAB, hBD, hDA, p, hp, hpu⟩ - refine ⟨tileTouchingRetarget A A' B B' hAc hAa hBc hBa hAB, - tileTouchingRetarget B B' D D' hBc hBa hDc hDa hBD, - tileTouchingRetarget D D' A A' hDc hDa hAc hAa hDA, p, ?_, ?_⟩ - · simpa [← hAo.2.1, ← hBo.2.1, ← hDo.2.1] using hp - · intro y hy - apply hpu y - simpa [← hAo.2.1, ← hBo.2.1, ← hDo.2.1] using hy - -private theorem quarterTranslate : - (by - classical - exact - ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : - PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), - (BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x) → (∀ (A : ProtoTile), ∀ - (a : GaussianInt), ∀ (u₀ : GaussianInt), TileTranslation (TileQuarterTurn - (TileTranslation A a)) u₀ = TileTranslation (TileTranslation (TileQuarterTurn A) u₀) - (GaussianQuarterTurn a)) ) := by - classical - intro C D T N h k x bundle A a u₀ - rcases A with ⟨cells, anchor⟩ - rw [ProtoTile.mk.injEq] - constructor - · ext z - simp only [TileTranslation, TileQuarterTurn, Finset.mem_image, - GaussianTranslation] - constructor - · rintro ⟨y, hy, rfl⟩ - rcases hy with ⟨w, hw, rfl⟩ - rcases hw with ⟨v, hv, rfl⟩ - refine ⟨GaussianQuarterTurn v - 1 + u₀, ?_, ?_⟩ - · refine ⟨GaussianQuarterTurn v - 1, ?_, rfl⟩ - exact ⟨v, hv, rfl⟩ - · cases a; cases v; cases u₀ - apply Zsqrtd.ext <;> - simp [GaussianQuarterTurn] <;> omega - · rintro ⟨y, hy, rfl⟩ - rcases hy with ⟨w, hw, rfl⟩ - rcases hw with ⟨v, hv, rfl⟩ - refine ⟨GaussianQuarterTurn (GaussianTranslation a v) - 1, ?_, ?_⟩ - · exact ⟨GaussianTranslation a v, ⟨v, hv, rfl⟩, rfl⟩ - · cases a; cases v; cases u₀ - apply Zsqrtd.ext <;> - simp [GaussianQuarterTurn, GaussianTranslation] <;> omega - · ext <;> simp [TileTranslation, TileQuarterTurn, GaussianTranslation, - GaussianQuarterTurn] <;> omega - private theorem translateObs : (by classical @@ -2014,78 +1922,6 @@ private theorem geomAt1214 : exact packageGeometry 0 1 1 false true g hgs hge hneq R1g R2g hW hX -private theorem hgeomAt1233 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : - PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : - BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration - bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed - bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint - bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign - bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), - let q := bundle.normalizedPresentation - let F := bundle.normalizedFixed - let root := bundle.normalizedRoot - let P := placement.layout.P - let u := placement.layout.u - let v := placement.layout.v - let selectedPath : Prop := - (∃ selectedStart selectedEnd : GaussianInt, - SimpleGridPathBetween - (FootprintVertices - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintVertices - (SubtileOccurrenceInterpretation P u v placement.centralIndex)) - (FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.centralIndex)) - selectedStart selectedEnd ∧ - selectedEdge ∈ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ - bundle.normalizedPoint ∈ selectedEdge) - let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) - (firstSign secondSign : Bool) ↦ - let firstCompanion := TileTranslation F - (sgn * BandVectors.1 (q 0) (q i.succ)) - let secondCompanion := TileTranslation F - (sgn * BandVectors.1 (q 0) (q j.succ)) - let firstPiece := TileTranslation (placement.layout.P i firstSign) - placement.rightNeighborDisplacement - let secondPiece := TileTranslation (placement.layout.P j secondSign) - placement.rightNeighborDisplacement - ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, - ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, - ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, - ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, - firstBoundaryData.point = firstData.point ∧ - secondBoundaryData.point = secondData.point ∧ - LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ - LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ - Disjoint F.cells firstCompanion.cells ∧ - Disjoint root.cells secondCompanion.cells ∧ - Disjoint F.cells secondCompanion.cells ∧ - Disjoint firstCompanion.cells secondCompanion.cells ∧ - TouchingTriple root F firstCompanion ∧ - TouchingTriple root F secondCompanion ∧ - firstData.point ≠ secondData.point ∧ - secondData.point = firstData.otherAB ∧ - secondData.otherAB = firstData.point ∧ selectedPath - (placement.rightFirstSlot = (0 : Fin (3 : ℕ))) → ((placement.rightSecondSlot = (1 : Fin - (3 : ℕ))) → ((rightGeometry 0 1 1 false true) → (rightGeometry - placement.rightFirstSlot placement.rightSecondSlot 1 false true))) ) := by - classical - intro C D T N h k x bundle placement selectedEdge q F root P u v selectedPath rightGeometry hi - hj geom - rw [hi, hj] - exact geom - private theorem hRAt1245 : (by classical @@ -2387,78 +2223,6 @@ private theorem geomAt1286 : exact packageGeometry 0 1 (-1) true false g hgs hge hneq R1g R2g hW hX -private theorem hgeomAt1305 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : - PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : - BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration - bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed - bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint - bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign - bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), - let q := bundle.normalizedPresentation - let F := bundle.normalizedFixed - let root := bundle.normalizedRoot - let P := placement.layout.P - let u := placement.layout.u - let v := placement.layout.v - let selectedPath : Prop := - (∃ selectedStart selectedEnd : GaussianInt, - SimpleGridPathBetween - (FootprintVertices - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintVertices - (SubtileOccurrenceInterpretation P u v placement.centralIndex)) - (FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.centralIndex)) - selectedStart selectedEnd ∧ - selectedEdge ∈ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ - bundle.normalizedPoint ∈ selectedEdge) - let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) - (firstSign secondSign : Bool) ↦ - let firstCompanion := TileTranslation F - (sgn * BandVectors.1 (q 0) (q i.succ)) - let secondCompanion := TileTranslation F - (sgn * BandVectors.1 (q 0) (q j.succ)) - let firstPiece := TileTranslation (placement.layout.P i firstSign) - placement.rightNeighborDisplacement - let secondPiece := TileTranslation (placement.layout.P j secondSign) - placement.rightNeighborDisplacement - ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, - ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, - ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, - ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, - firstBoundaryData.point = firstData.point ∧ - secondBoundaryData.point = secondData.point ∧ - LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ - LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ - Disjoint F.cells firstCompanion.cells ∧ - Disjoint root.cells secondCompanion.cells ∧ - Disjoint F.cells secondCompanion.cells ∧ - Disjoint firstCompanion.cells secondCompanion.cells ∧ - TouchingTriple root F firstCompanion ∧ - TouchingTriple root F secondCompanion ∧ - firstData.point ≠ secondData.point ∧ - secondData.point = firstData.otherAB ∧ - secondData.otherAB = firstData.point ∧ selectedPath - (placement.rightFirstSlot = (0 : Fin (3 : ℕ))) → ((placement.rightSecondSlot = (1 : Fin - (3 : ℕ))) → ((rightGeometry 0 1 (-1) true false) → (rightGeometry - placement.rightFirstSlot placement.rightSecondSlot (-1) true false))) ) := by - classical - intro C D T N h k x bundle placement selectedEdge q F root P u v selectedPath rightGeometry hi - hj geom - rw [hi, hj] - exact geom - private theorem hRAt1329 : (by classical @@ -2570,79 +2334,6 @@ private theorem hXAt1373 : intro C D T N h k x bundle placement root secondBoundarySubset hj hsecond simpa [hj, hsecond] using secondBoundarySubset -private theorem hgeomAt1378 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : - PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : - BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration - bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed - bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint - bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign - bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), - let q := bundle.normalizedPresentation - let F := bundle.normalizedFixed - let root := bundle.normalizedRoot - let P := placement.layout.P - let u := placement.layout.u - let v := placement.layout.v - let selectedPath : Prop := - (∃ selectedStart selectedEnd : GaussianInt, - SimpleGridPathBetween - (FootprintVertices - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintVertices - (SubtileOccurrenceInterpretation P u v placement.centralIndex)) - (FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.centralIndex)) - selectedStart selectedEnd ∧ - selectedEdge ∈ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ - bundle.normalizedPoint ∈ selectedEdge) - let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) - (firstSign secondSign : Bool) ↦ - let firstCompanion := TileTranslation F - (sgn * BandVectors.1 (q 0) (q i.succ)) - let secondCompanion := TileTranslation F - (sgn * BandVectors.1 (q 0) (q j.succ)) - let firstPiece := TileTranslation (placement.layout.P i firstSign) - placement.rightNeighborDisplacement - let secondPiece := TileTranslation (placement.layout.P j secondSign) - placement.rightNeighborDisplacement - ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, - ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, - ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, - ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, - firstBoundaryData.point = firstData.point ∧ - secondBoundaryData.point = secondData.point ∧ - LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ - LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ - Disjoint F.cells firstCompanion.cells ∧ - Disjoint root.cells secondCompanion.cells ∧ - Disjoint F.cells secondCompanion.cells ∧ - Disjoint firstCompanion.cells secondCompanion.cells ∧ - TouchingTriple root F firstCompanion ∧ - TouchingTriple root F secondCompanion ∧ - firstData.point ≠ secondData.point ∧ - secondData.point = firstData.otherAB ∧ - secondData.otherAB = firstData.point ∧ selectedPath - (placement.rightFirstSlot = (1 : Fin (3 : ℕ))) → ((placement.rightSecondSlot = (2 : Fin - (3 : ℕ))) → ((rightGeometry (1 : Fin (3 : ℕ)) (2 : Fin (3 : ℕ)) (1 : GaussianInt) - false true) → (rightGeometry placement.rightFirstSlot placement.rightSecondSlot 1 - false true))) ) := by - classical - intro C D T N h k x bundle placement selectedEdge q F root P u v selectedPath rightGeometry hi - hj geom - rw [hi, hj] - exact geom - private theorem hRAt1390 : (by classical @@ -2754,79 +2445,6 @@ private theorem hXAt1432 : intro C D T N h k x bundle placement root secondBoundarySubset hj hsecond simpa [hj, hsecond] using secondBoundarySubset -private theorem hgeomAt1437 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : - PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : - BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration - bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed - bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint - bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign - bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), - let q := bundle.normalizedPresentation - let F := bundle.normalizedFixed - let root := bundle.normalizedRoot - let P := placement.layout.P - let u := placement.layout.u - let v := placement.layout.v - let selectedPath : Prop := - (∃ selectedStart selectedEnd : GaussianInt, - SimpleGridPathBetween - (FootprintVertices - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintVertices - (SubtileOccurrenceInterpretation P u v placement.centralIndex)) - (FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.centralIndex)) - selectedStart selectedEnd ∧ - selectedEdge ∈ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ - bundle.normalizedPoint ∈ selectedEdge) - let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) - (firstSign secondSign : Bool) ↦ - let firstCompanion := TileTranslation F - (sgn * BandVectors.1 (q 0) (q i.succ)) - let secondCompanion := TileTranslation F - (sgn * BandVectors.1 (q 0) (q j.succ)) - let firstPiece := TileTranslation (placement.layout.P i firstSign) - placement.rightNeighborDisplacement - let secondPiece := TileTranslation (placement.layout.P j secondSign) - placement.rightNeighborDisplacement - ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, - ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, - ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, - ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, - firstBoundaryData.point = firstData.point ∧ - secondBoundaryData.point = secondData.point ∧ - LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ - LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ - Disjoint F.cells firstCompanion.cells ∧ - Disjoint root.cells secondCompanion.cells ∧ - Disjoint F.cells secondCompanion.cells ∧ - Disjoint firstCompanion.cells secondCompanion.cells ∧ - TouchingTriple root F firstCompanion ∧ - TouchingTriple root F secondCompanion ∧ - firstData.point ≠ secondData.point ∧ - secondData.point = firstData.otherAB ∧ - secondData.otherAB = firstData.point ∧ selectedPath - (placement.rightFirstSlot = (1 : Fin (3 : ℕ))) → ((placement.rightSecondSlot = (2 : Fin - (3 : ℕ))) → ((rightGeometry (1 : Fin (3 : ℕ)) (2 : Fin (3 : ℕ)) (-1 : GaussianInt) - true false) → (rightGeometry placement.rightFirstSlot placement.rightSecondSlot (-1) - true false))) ) := by - classical - intro C D T N h k x bundle placement selectedEdge q F root P u v selectedPath rightGeometry hi - hj geom - rw [hi, hj] - exact geom - private theorem hRAt1461 : (by classical @@ -2938,79 +2556,6 @@ private theorem hXAt1505 : intro C D T N h k x bundle placement root secondBoundarySubset hj hsecond simpa [hj, hsecond] using secondBoundarySubset -private theorem hgeomAt1510 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : - PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : - BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration - bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed - bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint - bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign - bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), - let q := bundle.normalizedPresentation - let F := bundle.normalizedFixed - let root := bundle.normalizedRoot - let P := placement.layout.P - let u := placement.layout.u - let v := placement.layout.v - let selectedPath : Prop := - (∃ selectedStart selectedEnd : GaussianInt, - SimpleGridPathBetween - (FootprintVertices - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintVertices - (SubtileOccurrenceInterpretation P u v placement.centralIndex)) - (FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.centralIndex)) - selectedStart selectedEnd ∧ - selectedEdge ∈ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ - bundle.normalizedPoint ∈ selectedEdge) - let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) - (firstSign secondSign : Bool) ↦ - let firstCompanion := TileTranslation F - (sgn * BandVectors.1 (q 0) (q i.succ)) - let secondCompanion := TileTranslation F - (sgn * BandVectors.1 (q 0) (q j.succ)) - let firstPiece := TileTranslation (placement.layout.P i firstSign) - placement.rightNeighborDisplacement - let secondPiece := TileTranslation (placement.layout.P j secondSign) - placement.rightNeighborDisplacement - ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, - ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, - ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, - ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, - firstBoundaryData.point = firstData.point ∧ - secondBoundaryData.point = secondData.point ∧ - LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ - LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ - Disjoint F.cells firstCompanion.cells ∧ - Disjoint root.cells secondCompanion.cells ∧ - Disjoint F.cells secondCompanion.cells ∧ - Disjoint firstCompanion.cells secondCompanion.cells ∧ - TouchingTriple root F firstCompanion ∧ - TouchingTriple root F secondCompanion ∧ - firstData.point ≠ secondData.point ∧ - secondData.point = firstData.otherAB ∧ - secondData.otherAB = firstData.point ∧ selectedPath - (placement.rightFirstSlot = (2 : Fin (3 : ℕ))) → ((placement.rightSecondSlot = (0 : Fin - (3 : ℕ))) → ((rightGeometry (2 : Fin (3 : ℕ)) (0 : Fin (3 : ℕ)) (1 : GaussianInt) - false true) → (rightGeometry placement.rightFirstSlot placement.rightSecondSlot 1 - false true))) ) := by - classical - intro C D T N h k x bundle placement selectedEdge q F root P u v selectedPath rightGeometry hi - hj geom - rw [hi, hj] - exact geom - private theorem hRAt1522 : (by classical @@ -3122,79 +2667,6 @@ private theorem hXAt1564 : intro C D T N h k x bundle placement root secondBoundarySubset hj hsecond simpa [hj, hsecond] using secondBoundarySubset -private theorem hgeomAt1569 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : - PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : - BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration - bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed - bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint - bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign - bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), - let q := bundle.normalizedPresentation - let F := bundle.normalizedFixed - let root := bundle.normalizedRoot - let P := placement.layout.P - let u := placement.layout.u - let v := placement.layout.v - let selectedPath : Prop := - (∃ selectedStart selectedEnd : GaussianInt, - SimpleGridPathBetween - (FootprintVertices - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintVertices - (SubtileOccurrenceInterpretation P u v placement.centralIndex)) - (FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.centralIndex)) - selectedStart selectedEnd ∧ - selectedEdge ∈ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ - bundle.normalizedPoint ∈ selectedEdge) - let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) - (firstSign secondSign : Bool) ↦ - let firstCompanion := TileTranslation F - (sgn * BandVectors.1 (q 0) (q i.succ)) - let secondCompanion := TileTranslation F - (sgn * BandVectors.1 (q 0) (q j.succ)) - let firstPiece := TileTranslation (placement.layout.P i firstSign) - placement.rightNeighborDisplacement - let secondPiece := TileTranslation (placement.layout.P j secondSign) - placement.rightNeighborDisplacement - ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, - ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, - ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, - ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, - firstBoundaryData.point = firstData.point ∧ - secondBoundaryData.point = secondData.point ∧ - LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ - LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ - Disjoint F.cells firstCompanion.cells ∧ - Disjoint root.cells secondCompanion.cells ∧ - Disjoint F.cells secondCompanion.cells ∧ - Disjoint firstCompanion.cells secondCompanion.cells ∧ - TouchingTriple root F firstCompanion ∧ - TouchingTriple root F secondCompanion ∧ - firstData.point ≠ secondData.point ∧ - secondData.point = firstData.otherAB ∧ - secondData.otherAB = firstData.point ∧ selectedPath - (placement.rightFirstSlot = (2 : Fin (3 : ℕ))) → ((placement.rightSecondSlot = (0 : Fin - (3 : ℕ))) → ((rightGeometry (2 : Fin (3 : ℕ)) (0 : Fin (3 : ℕ)) (-1 : GaussianInt) - true false) → (rightGeometry placement.rightFirstSlot placement.rightSecondSlot (-1) - true false))) ) := by - classical - intro C D T N h k x bundle placement selectedEdge q F root P u v selectedPath rightGeometry hi - hj geom - rw [hi, hj] - exact geom - end SelectedRowGeometry namespace SelectedRowNormalization @@ -3665,8 +3137,13 @@ private theorem firstCyclicCase : · have geom := SelectedRowGeometry.geomAt1214 C D T N h k x bundle placement selectedEdge edgeVertex hp packageGeometry firstBoundarySubset secondBoundarySubset hi hj R1 R2 g hgs hge hneq hfirst hsecond - have hgeom := SelectedRowGeometry.hgeomAt1233 C D T N h k x bundle placement selectedEdge - hi hj geom + have hgeom := (show + rightGeometry placement.rightFirstSlot placement.rightSecondSlot 1 false + true + from by + classical + rw [hi, hj] + exact geom) rcases chosenBoundary with ⟨hs, hsign⟩ | ⟨hs, hsign⟩ · have hselectedSign : bundle.selectedSign = false := by @@ -3714,8 +3191,13 @@ private theorem firstCyclicCase : · have geom := SelectedRowGeometry.geomAt1286 C D T N h k x bundle placement selectedEdge edgeVertex hp packageGeometry firstBoundarySubset secondBoundarySubset hi hj R1 R2 g hgs hge hneq hfirst hsecond - have hgeom := SelectedRowGeometry.hgeomAt1305 C D T N h k x bundle placement selectedEdge - hi hj geom + have hgeom := (show + rightGeometry placement.rightFirstSlot placement.rightSecondSlot (-1) true + false + from by + classical + rw [hi, hj] + exact geom) rcases chosenBoundary with ⟨hs, hsign⟩ | ⟨hs, hsign⟩ · have hselectedSign : bundle.selectedSign = true := by @@ -4058,8 +3540,13 @@ private theorem secondCyclicCase : have hX := SelectedRowGeometry.hXAt1373 C D T N h k x bundle placement secondBoundarySubset hj hsecond have geom := packageGeometry 1 2 1 false true g hgs hge hneq R1g R2g hW hX - have hgeom := SelectedRowGeometry.hgeomAt1378 C D T N h k x bundle placement selectedEdge - hi hj geom + have hgeom := (show + rightGeometry placement.rightFirstSlot placement.rightSecondSlot 1 false + true + from by + classical + rw [hi, hj] + exact geom) rcases chosenBoundary with ⟨hs, hsign⟩ | ⟨hs, hsign⟩ · have hs' : bundle.selectedSign = false := by @@ -4106,8 +3593,13 @@ private theorem secondCyclicCase : have hX := SelectedRowGeometry.hXAt1432 C D T N h k x bundle placement secondBoundarySubset hj hsecond have geom := packageGeometry 1 2 (-1) true false g hgs hge hneq R1g R2g hW hX - have hgeom := SelectedRowGeometry.hgeomAt1437 C D T N h k x bundle placement selectedEdge - hi hj geom + have hgeom := (show + rightGeometry placement.rightFirstSlot placement.rightSecondSlot (-1) true + false + from by + classical + rw [hi, hj] + exact geom) rcases chosenBoundary with ⟨hs, hsign⟩ | ⟨hs, hsign⟩ · have hs' : bundle.selectedSign = true := by @@ -4450,8 +3942,13 @@ private theorem thirdCyclicCase : have hX := SelectedRowGeometry.hXAt1505 C D T N h k x bundle placement secondBoundarySubset hj hsecond have geom := packageGeometry 2 0 1 false true g hgs hge hneq R1g R2g hW hX - have hgeom := SelectedRowGeometry.hgeomAt1510 C D T N h k x bundle placement selectedEdge - hi hj geom + have hgeom := (show + rightGeometry placement.rightFirstSlot placement.rightSecondSlot 1 false + true + from by + classical + rw [hi, hj] + exact geom) rcases chosenBoundary with ⟨hs, hsign⟩ | ⟨hs, hsign⟩ · have hs' : bundle.selectedSign = false := by @@ -4498,8 +3995,13 @@ private theorem thirdCyclicCase : have hX := SelectedRowGeometry.hXAt1564 C D T N h k x bundle placement secondBoundarySubset hj hsecond have geom := packageGeometry 2 0 (-1) true false g hgs hge hneq R1g R2g hW hX - have hgeom := SelectedRowGeometry.hgeomAt1569 C D T N h k x bundle placement selectedEdge - hi hj geom + have hgeom := (show + rightGeometry placement.rightFirstSlot placement.rightSecondSlot (-1) true + false + from by + classical + rw [hi, hj] + exact geom) rcases chosenBoundary with ⟨hs, hsign⟩ | ⟨hs, hsign⟩ · have hs' : bundle.selectedSign = true := by @@ -4707,10 +4209,9 @@ theorem BandOrderedGeneralRightSelectedRowGeometry (hanchor : A.cells = ∅ → A.anchor = A'.anchor) (E : ExactTileInterfaceTriple A B D) : ExactTileInterfaceTriple A' B D := SelectedRowExactInterfaces.retargetExactFirst A A' B D hcell hanchor E - have touchingRetarget := SelectedRowGeometry.touchingRetarget - (SelectedRowGeometry.tileTouchingRetarget) + have touchingRetarget := ObservableTileRetargeting.triple have centeredTurnTouching := SelectedRowGeometry.centeredTurnTouching touchingRetarget - (SelectedRowGeometry.quarterTranslate C D T N h k x bundle) (SelectedRowGeometry.translateObs) + (TileQuarterTurnTranslation.translated) (SelectedRowGeometry.translateObs) have exactPlus (ell : Fin 3) : ExactTileInterfaceTriple F (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ))) := by diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean index 6780fc8557..0cff6a2fa2 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnTranslation public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileInterfaceCertificate public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileCanonicalRows @@ -129,31 +130,6 @@ private theorem centeredCompare (g : GaussianInt) (C : CircleCoordinates) (Y Z : exact ⟨hcells.trans hunique.1, fun he => (hanchor he).trans (hunique.2 (hcells.symm.trans he))⟩ -private theorem quarterTranslate (A : ProtoTile) (a d : GaussianInt) : - TileTranslation (TileQuarterTurn (TileTranslation A a)) d = - TileTranslation (TileTranslation (TileQuarterTurn A) d) - (GaussianQuarterTurn a) := by - classical - rcases A with ⟨cells, anchor⟩ - rw [ProtoTile.mk.injEq] - constructor - · ext z - simp only [TileTranslation, TileQuarterTurn, Finset.mem_image, - GaussianTranslation] - constructor - · rintro ⟨y, ⟨w, ⟨v, hv, rfl⟩, rfl⟩, rfl⟩ - refine ⟨GaussianQuarterTurn v - 1 + d, ?_, ?_⟩ - · exact ⟨GaussianQuarterTurn v - 1, ⟨v, hv, rfl⟩, rfl⟩ - · apply Zsqrtd.ext <;> - simp [GaussianQuarterTurn] <;> omega - · rintro ⟨y, ⟨w, ⟨v, hv, rfl⟩, rfl⟩, rfl⟩ - refine ⟨GaussianQuarterTurn (GaussianTranslation a v) - 1, - ⟨GaussianTranslation a v, ⟨v, hv, rfl⟩, rfl⟩, ?_⟩ - apply Zsqrtd.ext <;> - simp [GaussianQuarterTurn, GaussianTranslation] <;> omega - · ext <;> simp [TileTranslation, TileQuarterTurn, GaussianTranslation, - GaussianQuarterTurn] <;> omega - end SubtileInterfaceGeometry namespace SubtileInterfacePreparation @@ -2407,7 +2383,7 @@ theorem BandOrderedGeneralSubtileInterfaceCertificateExists quarterSymmetricTranslation g hrootBar (SubtileInterfacePreparation.rotatedCentroid C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization g hg) (SubtileInterfaceGeometry.centeredCompare g) - (SubtileInterfaceGeometry.quarterTranslate) + (TileQuarterTurnTranslation.translated) (SubtileInterfacePreparation.hout0 C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization hflips) (SubtileInterfacePreparation.hout1 C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization hflips) rowsAt diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean index 37b1a0d5c4..24be74d6ae 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean @@ -6,6 +6,9 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileQuarterTurn +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryDomainTransport +public import LeanPool.ApollonianSuperharmonic.BandQuadrupleCyclicRotation public import LeanPool.ApollonianSuperharmonic.P5658T1FivePointDomainCoverSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileNormalizationCertificate @@ -29,59 +32,6 @@ namespace ApollonianSuperharmonic namespace SubtileNormalizationGeometry -private theorem hqrotSemi : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ( ∀ (r : Fin (3 : ℕ)), ∀ (g - : BandPackingSymmetry), ( - let q' := BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 - : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : - FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : - DiamondParameter), (1 : ℕ) < K.1 ∧ q' = DiamondRecursiveQuadruple K) (Nonempty - (BandOrderedGeneralConfiguration q')))) → ( - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - SemiProperQuadruple qrot)) ) := by - classical - intro q hq r g hregime qrot - fin_cases r - · convert hq.1 using 1; funext j; fin_cases j <;> simp [qrot] - · convert SemiProperQuadruple.rotate hq.1 using 1; - funext j; fin_cases j <;> simp [qrot] - · convert SemiProperQuadruple.rotate - (SemiProperQuadruple.rotate hq.1) using 1; - funext j; fin_cases j <;> simp [qrot] - -private theorem hqrot : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ( ∀ (r : Fin (3 : ℕ)), ∀ (g - : BandPackingSymmetry), ( - let q' := BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q r.succ, q (r + (1 - : Fin (3 : ℕ))).succ, q (r + (2 : Fin (3 : ℕ))).succ]; Xor (∃ (P : - FordFareyParameter), (1 : ℕ) < P.q ∧ q' = FordRecursiveQuadruple P) (Xor (∃ (K : - DiamondParameter), (1 : ℕ) < K.1 ∧ q' = DiamondRecursiveQuadruple K) (Nonempty - (BandOrderedGeneralConfiguration q')))) → ( - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - (SemiProperQuadruple qrot) → (ProperBandQuadruple qrot))) ) := by - classical - intro q hq r g hregime qrot hqrotSemi - refine ⟨hqrotSemi, ?_⟩ - intro j - fin_cases r <;> fin_cases j <;> simp [qrot] - · simpa using hq.2 (0 : Fin 3) - · simpa using hq.2 (1 : Fin 3) - · simpa using hq.2 (2 : Fin 3) - · simpa using hq.2 (1 : Fin 3) - · simpa using hq.2 (2 : Fin 3) - · simpa using hq.2 (0 : Fin 3) - · simpa using hq.2 (2 : Fin 3) - · simpa using hq.2 (0 : Fin 3) - · simpa using hq.2 (1 : Fin 3) - private theorem hgeneral : (by classical @@ -270,44 +220,6 @@ private theorem hqbarᵢPos : have hnl := cfg.noLine ibar.succ omega -private theorem hx₀bar : - (by - classical - exact - ∀ (h₀ : PartialOdometer), (PartialOdometer) → (∀ (x : GaussianInt), (x ∈ h₀.domain) → (∀ - (g : BandPackingSymmetry), - let h₀bar := BandPackingSymmetryPartialOdometerAction g h₀ - let xbar := BandPackingSymmetryVectorAction g x - xbar ∈ h₀bar.domain)) ) := by - classical - intro h₀ hᵢ x hx₀ g h₀bar xbar - have hdom := (BandPackingSymmetryPartialOdometerActionFormulas g h₀ hᵢ).1 - have hxset : BandPackingSymmetryVectorAction g x ∈ - ((BandPackingSymmetryPartialOdometerAction g h₀).domain : - Set GaussianInt) := by - rw [hdom] - exact ⟨x, hx₀, rfl⟩ - exact hxset - -private theorem hxᵢbar : - (by - classical - exact - (PartialOdometer) → (∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), (x ∈ hᵢ.domain) → (∀ - (g : BandPackingSymmetry), - let hᵢbar := BandPackingSymmetryPartialOdometerAction g hᵢ - let xbar := BandPackingSymmetryVectorAction g x - xbar ∈ hᵢbar.domain)) ) := by - classical - intro h₀ hᵢ x hxᵢ g hᵢbar xbar - have hdom := (BandPackingSymmetryPartialOdometerActionFormulas g hᵢ h₀).1 - have hxset : BandPackingSymmetryVectorAction g x ∈ - ((BandPackingSymmetryPartialOdometerAction g hᵢ).domain : - Set GaussianInt) := by - rw [hdom] - exact ⟨x, hxᵢ, rfl⟩ - exact hxset - private theorem hadjbar : (by classical @@ -393,43 +305,6 @@ private theorem hsmallT1 : have hI := BandTileSimultaneousInduction q' hq' T' hT' exact ⟨hI.1, hI.2.1, hI.2.2.1 S' hocc hcells⟩ -private theorem hsmallT2 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let qbar := BandPackingSymmetryQuadrupleAction g qrot - ∀ (D : CircleCoordinates), ∀ (U : ProtoTile), BandPrototile D U → Int.toNat D.1 < - Int.toNat (qbar 0).1 → QuarterTurnSymmetric U ) := by - classical - intro q r g qrot qbar D U hU _ - cases hU with - | line w z hw => - intro p - simp [TileRealization, TileCentroid] - | unit z a anchor => - intro p - have hc : TileCentroid (⟨{a}, anchor⟩ : ProtoTile) = - (((a.re : Int) : Real) + (1 / 2 : Real), - ((a.im : Int) : Real) + (1 / 2 : Real)) := by - simp [TileCentroid] - rw [hc] - rcases p with ⟨px, py⟩ - simp only [TileRealization, Finset.mem_singleton, Set.mem_iUnion] - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - constructor - · rintro ⟨b, rfl, hlo, hhi⟩ - refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> - linarith [hlo.1, hlo.2, hhi.1, hhi.2] - · rintro ⟨b, rfl, hlo, hhi⟩ - refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> - linarith [hlo.1, hlo.2, hhi.1, hhi.2] - | @decompose q' hq' S' U' hS hcells hfoot hcent => - exact (BandTileSimultaneousInduction q' hq' U - (.decompose hq' hS hcells hfoot hcent)).2.2.2.1 - private theorem hsmallT4 : (by classical @@ -716,92 +591,6 @@ private theorem hexteriorIndex : generalize hs : sbar = t at ⊢ fin_cases j <;> fin_cases t <;> simp [exteriorIndex, hi, hs] -private theorem hexteriorCentroid : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T₀ : ProtoTile), ∀ (r : Fin (3 : - ℕ)), ∀ (g : BandPackingSymmetry), - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let irot : Fin 3 := i - r - let qbar := BandPackingSymmetryQuadrupleAction g qrot - ∀ (hqbar : ProperBandQuadruple qbar), ∀ (cfg : BandOrderedGeneralConfiguration qbar), ∀ - (sbar : Fin (4 : ℕ)), - let reverse := BandPackingSymmetryReversesOrientation g - let ibar : Fin 3 := if reverse then -irot else irot - let T₀bar := BandPackingSymmetryTileAction g T₀ - ∀ (hqbar₀Pos : 0 < (qbar 0).1), - let C₀bar : BandCircle := - ⟨⟨qbar 0, ⟨Or.inl hqbar₀Pos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbar₀Pos⟩ - ∀ (layout : BandOrderedGeneralLayoutCertificate qbar cfg C₀bar T₀bar), - let incoming : Fin 3 → GaussianInt := fun j => - BandVectors.1 (qbar j.succ) (qbar 0) - let outgoing : Fin 3 → GaussianInt := fun j => - BandVectors.1 (qbar 0) (qbar j.succ) - let exteriorIndex : PeriodicSubtileIndex := - if ibar = 0 then - if sbar = 0 then ⟨.A, 0, -1⟩ - else if sbar = 1 then ⟨.B, 1, 1⟩ - else if sbar = 2 then ⟨.B, 0, 1⟩ - else ⟨.A, -1, -1⟩ - else if ibar = 1 then - if sbar = 0 then ⟨.C, 1, 1⟩ - else if sbar = 1 then ⟨.D, -1, 0⟩ - else if sbar = 2 then ⟨.D, -1, -1⟩ - else ⟨.C, 1, 0⟩ - else - if sbar = 0 then ⟨.E, -1, 0⟩ - else if sbar = 1 then ⟨.F, 0, -1⟩ - else if sbar = 2 then ⟨.F, 1, 0⟩ - else ⟨.E, 0, 1⟩ - ( - let uIndex := if ibar = (0 : Fin (3 : ℕ)) then if sbar = (0 : Fin (4 : ℕ)) then - (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar = (1 : - Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else - if sbar = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : - PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : - PeriodicSubtileIndex) else if ibar = (1 : Fin (3 : ℕ)) then if sbar = (0 : Fin (4 : - ℕ)) then (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar - = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex) else if sbar = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 - : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex) else if sbar = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.E, (-1 - : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar = (1 : Fin (4 : ℕ)) then - (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar = (2 : - Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else - (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); - let vIndex := if ibar = (0 : Fin (3 : ℕ)) then if sbar = (0 : Fin (4 : ℕ)) then - (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar = (1 : - Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else - if sbar = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex) else (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex) else if ibar = (1 : Fin (3 : ℕ)) then if sbar = (0 : Fin (4 : - ℕ)) then (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar - = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : - PeriodicSubtileIndex) else if sbar = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (0 : - ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : - PeriodicSubtileIndex) else if sbar = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.A, (-1 - : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar = (1 : Fin (4 : ℕ)) then - (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if sbar = (2 : - Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else - (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); - let U := SubtileOccurrenceInterpretation layout.P layout.u layout.v uIndex; - let V := SubtileOccurrenceInterpretation layout.P layout.u layout.v vIndex; TileCentroid - U - TileCentroid T₀bar = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ^ (↑sbar : ℕ) * (incoming ibar + outgoing ibar)) ∧ TileCentroid V - - TileCentroid T₀bar = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ^ (↑sbar : ℕ) * if Even (↑sbar : ℕ) then incoming (ibar + (1 : Fin (3 : - ℕ))) - outgoing (ibar + (1 : Fin (3 : ℕ))) else outgoing (ibar - (1 : Fin (3 : ℕ))) - - incoming (ibar - (1 : Fin (3 : ℕ))))) → (TileCentroid - (SubtileOccurrenceInterpretation layout.P layout.u layout.v exteriorIndex) - - TileCentroid T₀bar = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ - sbar.val * (incoming ibar + outgoing ibar))) ) := by - classical - intro q i T₀ r g qrot irot qbar hqbar cfg sbar reverse ibar T₀bar hqbar₀Pos C₀bar layout - incoming outgoing exteriorIndex hrows - simpa [exteriorIndex] using hrows.1 - private theorem hexteriorBand : (by classical @@ -1110,8 +899,14 @@ private theorem subtileNormalizationCertificate : layout.v exteriorIndex) - TileCentroid T₀bar = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ sbar.val * - (incoming ibar + outgoing ibar)) := SubtileNormalizationGeometry.hexteriorCentroid q - i T₀ r g hqbar cfg sbar hqbar₀Pos layout hrows + (incoming ibar + outgoing ibar)) := (show + TileCentroid (SubtileOccurrenceInterpretation layout.P layout.u + layout.v exteriorIndex) - TileCentroid T₀bar = (1 / 2 : ℝ) • + GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ sbar.val * (incoming + ibar + outgoing ibar)) + from by + classical + simpa [exteriorIndex] using hrows.1) have hexteriorBand : BandPrototile (qbar ibar.succ) (SubtileOccurrenceInterpretation layout.P layout.u layout.v exteriorIndex) := SubtileNormalizationGeometry.hexteriorBand q i T₀ r g hqbar cfg sbar @@ -1240,10 +1035,7 @@ theorem BandOrderedGeneralSubtileNormalizationCertificateExists obtain ⟨r, g, hregime⟩ := BandRegimeClassification q hq let qrot : Fin 4 → CircleCoordinates := ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - have hqrotSemi : SemiProperQuadruple qrot := SubtileNormalizationGeometry.hqrotSemi q hq r g - hregime - have hqrot : ProperBandQuadruple qrot := SubtileNormalizationGeometry.hqrot q hq r g hregime - hqrotSemi + have hqrot : ProperBandQuadruple qrot := BandQuadrupleCyclicRotation.proper q hq r let irot : Fin 3 := i - r have hrotParent : qrot irot.succ = q i.succ := by fin_cases r <;> fin_cases i <;> simp [qrot, irot] @@ -1303,8 +1095,8 @@ theorem BandOrderedGeneralSubtileNormalizationCertificateExists ⟨⟨qbar ibar.succ, ⟨Or.inl hqbarᵢPos, ⟨qbar, hqbar.1, ⟨ibar.succ, rfl⟩⟩⟩⟩, hqbarᵢPos⟩ - have hx₀bar : xbar ∈ h₀bar.domain := SubtileNormalizationGeometry.hx₀bar h₀ hᵢ x hx₀ g - have hxᵢbar : xbar ∈ hᵢbar.domain := SubtileNormalizationGeometry.hxᵢbar h₀ hᵢ x hxᵢ g + have hx₀bar : xbar ∈ h₀bar.domain := BandPackingSymmetryDomainTransport.forward g h₀ x hx₀ + have hxᵢbar : xbar ∈ hᵢbar.domain := BandPackingSymmetryDomainTransport.forward g hᵢ x hxᵢ have hadjbar : SubtileLatticeAdjacent C₀bar Cᵢbar T₀bar Tᵢbar h₀bar hᵢbar := SubtileNormalizationGeometry.hadjbar q i T₀ Tᵢ h₀ hᵢ r g hqbar p₀bar pᵢbar sbar hO₀bar hOᵢbar hp₀bar hpᵢbar hcentroidBar hslopexBar hslopeyBar @@ -1326,7 +1118,7 @@ theorem BandOrderedGeneralSubtileNormalizationCertificateExists SubtileNormalizationGeometry.hsmallT1 q r g have hsmallT2 : ∀ (D : CircleCoordinates) (U : ProtoTile), BandPrototile D U → Int.toNat D.1 < Int.toNat (qbar 0).1 → - QuarterTurnSymmetric U := SubtileNormalizationGeometry.hsmallT2 q r g + QuarterTurnSymmetric U := fun D U hU _ => BandPrototileQuarterTurn.symmetry D U hU have hsmallT4 : ∀ (q' : Fin 4 → CircleCoordinates) (T' U : ProtoTile), ProperBandQuadruple q' → BandPrototile (q' 0) T' → diff --git a/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean b/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean index 96c9bc882e..0d149ae82d 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileFacts +public import LeanPool.ApollonianSuperharmonic.BandOriginalParentContainment public import LeanPool.ApollonianSuperharmonic.LatticeTileNonempty public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate @@ -29,39 +31,11 @@ namespace ApollonianSuperharmonic namespace OriginalIntersectionGeometry -private theorem hOA : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let P := cert.P - let O := cert.O - O.cells ⊆ (P 0 true).cells ) := by - classical - intro q cfg C₀ T cert P O - change cert.O.cells ⊆ (cert.P 0 true).cells - rw [cert.precursor_eq] - intro x hx - exact (cert.plus_union x).2 ⟨0, false, hx⟩ +private abbrev hOA := + BandOriginalParentContainment.positiveParent -private theorem hOB : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let P := cert.P - let O := cert.O - O.cells ⊆ (P 0 false).cells ) := by - classical - intro q cfg C₀ T cert P O - change cert.O.cells ⊆ (cert.P 0 false).cells - rw [cert.precursor_cells] - intro x hx - exact (cert.minus_union x).2 ⟨0, true, hx⟩ +private abbrev hOB := + BandOriginalParentContainment.negativeParent private theorem hmodified : (by @@ -81,30 +55,6 @@ private theorem hmodified : exact cert.modified_tile a -private theorem hmodA : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let P := cert.P - let O := cert.O - let u := cert.u - let v := cert.v - (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (w : GaussianInt), TileTranslation - (TileCellComplement A B) w = TileCellComplement (TileTranslation A w) - (TileTranslation B w)) → (∀ (m : Int), ∀ (n : Int), - ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩ = TileCellComplement - (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) (TileTranslation O ((m : - GaussianInt) * u + (n : GaussianInt) * v))) ) := by - classical - intro q cfg C₀ T cert P O u v htranslate_complement m n - change TileTranslation (TileCellComplement (P 0 true) O) - ((m : GaussianInt) * u + (n : GaussianInt) * v) = _ - rw [htranslate_complement] - rfl - private theorem hmodother : (by classical @@ -1120,8 +1070,7 @@ theorem BandOriginalOccurrenceIntersectionClassification TileTranslation (TileCellComplement A B) w = TileCellComplement (TileTranslation A w) (TileTranslation B w) := (TileCellComplementCovariance A B w).1 - have hmodA (m n : Int) := OriginalIntersectionGeometry.hmodA q cfg C₀ T cert - htranslate_complement m n + have hmodA (m n : Int) := ModifiedSubtileFacts.modifiedA cert.P cert.O cert.u cert.v m n have hmodother (a : PeriodicSubtileIndex) (ha : a.label ≠ .A) : ModifiedSubtileOccurrenceInterpretation P O u v a = SubtileOccurrenceInterpretation P u v a := OriginalIntersectionGeometry.hmodother q cfg diff --git a/LeanPool/ApollonianSuperharmonic/BandOriginalParentContainment.lean b/LeanPool/ApollonianSuperharmonic/BandOriginalParentContainment.lean new file mode 100644 index 0000000000..c25b0e7867 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandOriginalParentContainment.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate + +/-! +# BandOriginalParentContainment + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace BandOriginalParentContainment + +/-- Shared positiveParent fact. -/ +theorem positiveParent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + O.cells ⊆ (P 0 true).cells ) := by + classical + intro q cfg C₀ T cert P O + change cert.O.cells ⊆ (cert.P 0 true).cells + rw [cert.precursor_eq] + intro x hx + exact (cert.plus_union x).2 ⟨0, false, hx⟩ + +/-- Shared negativeParent fact. -/ +theorem negativeParent : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : + BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg + C₀ T), + let P := cert.P + let O := cert.O + O.cells ⊆ (P 0 false).cells ) := by + classical + intro q cfg C₀ T cert P O + change cert.O.cells ⊆ (cert.P 0 false).cells + rw [cert.precursor_cells] + intro x hx + exact (cert.minus_union x).2 ⟨0, true, hx⟩ + +end BandOriginalParentContainment +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCovariance.lean index 6a5c79cb31..41fe83037c 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryCovariance.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryLinearIdentities public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase @@ -29,42 +30,11 @@ namespace ApollonianSuperharmonic namespace SymmetryCovarianceProof -private theorem rsub : - (by - classical - exact - let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := - BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) - (fun p => (-p.1, p.2)) (fun _ p => p) - (fun _ _ f k p => f (k p)) - ∀ (h : BandPackingSymmetry), ∀ (p : ℝ × ℝ), ∀ (t : ℝ × ℝ), R h (p - t) = R h p - R h t ) - := by - classical - intro R h p t - induction h generalizing p t with - | identity => rfl - | negate => ext <;> simp [R]; ring - | conjugate => ext <;> simp [R]; ring - | shift w => rfl - | comp h k ih ik => simp [R, ih, ik] +private abbrev rsub := + BandPackingSymmetryLinearIdentities.linearity.1 -private theorem rsmul : - (by - classical - exact - let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := - BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) - (fun p => (-p.1, p.2)) (fun _ p => p) - (fun _ _ f k p => f (k p)) - ∀ (h : BandPackingSymmetry), ∀ (c : ℝ), ∀ (p : ℝ × ℝ), R h (c • p) = c • R h p ) := by - classical - intro R h c p - induction h generalizing p with - | identity => rfl - | negate => ext <;> simp [R] - | conjugate => ext <;> simp [R] - | shift w => rfl - | comp h k ih ik => simp [R, ih, ik] +private abbrev rsmul := + BandPackingSymmetryLinearIdentities.linearity.2 private theorem rneg : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryDomainTransport.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryDomainTransport.lean new file mode 100644 index 0000000000..928102a28f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryDomainTransport.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas +public import Mathlib.Init + + +/-! +# BandPackingSymmetryDomainTransport + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace BandPackingSymmetryDomainTransport + +/-- A packing symmetry sends every domain point into the transformed domain. -/ +theorem forward (a : BandPackingSymmetry) (k : PartialOdometer) (x : GaussianInt) + (hx : x ∈ k.domain) : + BandPackingSymmetryVectorAction a x ∈ + (BandPackingSymmetryPartialOdometerAction a k).domain := by + change BandPackingSymmetryVectorAction a x ∈ + ((BandPackingSymmetryPartialOdometerAction a k).domain : Set GaussianInt) + rw [(BandPackingSymmetryPartialOdometerActionFormulas a k k).1] + exact ⟨x, hx, rfl⟩ + +end BandPackingSymmetryDomainTransport +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryLinearIdentities.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryLinearIdentities.lean new file mode 100644 index 0000000000..734f88d5ab --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryLinearIdentities.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry +public import Mathlib.Init + + +/-! +# BandPackingSymmetryLinearIdentities + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace BandPackingSymmetryLinearIdentities + +/-- The real linear part of a packing symmetry respects subtraction and scaling. -/ +theorem linearity : + let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := + BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) + (fun p => (-p.1, p.2)) (fun _ p => p) (fun _ _ f k p => f (k p)) + (∀ h p t, R h (p - t) = R h p - R h t) ∧ + (∀ (h : BandPackingSymmetry) (c : Real) (p : Real × Real), R h (c • p) = c • R h p) := by + classical + intro R + constructor + · intro h p t + induction h generalizing p t with + | identity => rfl + | negate => ext <;> simp [R]; ring + | conjugate => ext <;> simp [R]; ring + | shift w => rfl + | comp h k ih ik => simp [R, ih, ik] + · intro h c p + induction h generalizing p with + | identity => rfl + | negate => ext <;> simp [R] + | conjugate => ext <;> simp [R] + | shift w => rfl + | comp h k ih ik => simp [R, ih, ik] + +end BandPackingSymmetryLinearIdentities +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean index eaae24c760..de8b2098a9 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileOdometerSlopeNonempty public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation @@ -414,28 +415,8 @@ private theorem positiveSupport : exact ∀ (C : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (p : ℝ × ℝ), 0 < C.1 → TileOdometer C U k → PartialOdometerSlope k = some p → U.cells.Nonempty ) := by - classical - intro C U k p hpos hO hp - have hd := PositiveCurvatureTileOdometerDomain C U k hpos hO - by_contra hn - have hde : (k.domain : Set GaussianInt) = {U.anchor} := by - rw [hd] - simp [FootprintVertices, hn] - have hs : (PartialOdometerSquares k).Nonempty := by - by_contra hs - simp [PartialOdometerSlope, hs] at hp - rcases hs with ⟨x, hx⟩ - simp only [PartialOdometerSquares, Finset.mem_filter] at hx - have hz : x + 1 = U.anchor := by - apply Set.mem_singleton_iff.mp - rw [← hde] - exact hx.2.1 - have hz0 : x = U.anchor := by - apply Set.mem_singleton_iff.mp - rw [← hde] - exact hx.1 - have hzbad := congrArg (fun z : GaussianInt => z.re) (hz.trans hz0.symm) - norm_num at hzbad + intro C U k p _ hO hp + exact TileOdometerSlopeNonempty.cells C U k p hO hp private theorem hq0 : (by @@ -972,47 +953,8 @@ private theorem hAphase2 : simpa [A', Z, q', sigma, BandPackingSymmetryReversesOrientation] using (hcyc i).2 -private theorem hactM2 : - (by - classical - exact - let affineQuarter : GaussianInt × GaussianInt → GaussianInt × GaussianInt := - fun z => (GaussianQuarterTurn z.1, -GaussianQuarterTurn z.2) - (∀ k : BandPackingSymmetry, (∀ y, ∀ z, BandPackingSymmetryAffineVectorAction k (y + z) = - BandPackingSymmetryAffineVectorAction k y + BandPackingSymmetryAffineVectorAction k - z) ∧ (∀ y, BandPackingSymmetryAffineVectorAction k (-y) = - -BandPackingSymmetryAffineVectorAction k y) ∧ (∀ y, - BandPackingSymmetryAffineVectorAction k (affineQuarter y) = if - BandPackingSymmetryReversesOrientation k then -affineQuarter - (BandPackingSymmetryAffineVectorAction k y) else affineQuarter - (BandPackingSymmetryAffineVectorAction k y))) → (∀ (g : BandPackingSymmetry), ∀ (q : - Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), - let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) - let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) - let Z : GaussianInt × GaussianInt := (W, A) - let M : GaussianInt × GaussianInt := - (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) - (M = Z + -affineQuarter Z) → (BandPackingSymmetryAffineVectorAction g M = if - BandPackingSymmetryReversesOrientation g then BandPackingSymmetryAffineVectorAction g - Z + affineQuarter (BandPackingSymmetryAffineVectorAction g Z) else - BandPackingSymmetryAffineVectorAction g Z - affineQuarter - (BandPackingSymmetryAffineVectorAction g Z))) ) := by - classical - intro affineQuarter affineFacts g q i W A Z M hpat2 - calc - _ = BandPackingSymmetryAffineVectorAction g (Z + -affineQuarter Z) := - congrArg (BandPackingSymmetryAffineVectorAction g) hpat2 - _ = BandPackingSymmetryAffineVectorAction g Z + - BandPackingSymmetryAffineVectorAction g (-affineQuarter Z) := - (affineFacts g).1 _ _ - _ = BandPackingSymmetryAffineVectorAction g Z - - BandPackingSymmetryAffineVectorAction g (affineQuarter Z) := by - rw [(affineFacts g).2.1] - simp [sub_eq_add_neg] - _ = _ := by - rw [(affineFacts g).2.2] - cases BandPackingSymmetryReversesOrientation g <;> - ext <;> simp [affineQuarter, GaussianQuarterTurn]; ring +private abbrev hactM2 := + ApollonianSuperharmonic.MarkedCovarianceGeometry.hactM private theorem hMphase2 : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean index 9579411a45..d4303730c2 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryLinearIdentities +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance @@ -99,18 +101,8 @@ private theorem triple_obs : simp only [TouchingTriple, touching_obs ha hb, touching_obs hb hc, touching_obs hc ha, oa.2.1, ob.2.1, oc.2.1] -private theorem translate_add : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), TileTranslation - (TileTranslation A x) y = TileTranslation A (x + y) ) := by - classical - intro A x y - cases A - simp only [TileTranslation, Finset.image_image, Function.comp_def, - GaussianTranslation, add_assoc] - rfl +private abbrev translate_add := + TileTranslationProperties.add private theorem translate_zero : (by @@ -414,43 +406,11 @@ private theorem radd : | shift w => rfl | comp h k ih ik => simp [R, ih, ik] -private theorem rsub : - (by - classical - exact - let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := - BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) - (fun p => (-p.1, p.2)) (fun _ p => p) - (fun _ _ f k p => f (k p)) - ∀ (h : BandPackingSymmetry), ∀ (p : Real × Real), ∀ (t : Real × Real), R h (p - t) = R h - p - R h t ) := by - classical - intro R h p t - induction h generalizing p t with - | identity => rfl - | negate => ext <;> simp [R]; ring - | conjugate => ext <;> simp [R]; ring - | shift w => rfl - | comp h k ih ik => simp [R, ih, ik] +private abbrev rsub := + BandPackingSymmetryLinearIdentities.linearity.1 -private theorem rsmul : - (by - classical - exact - let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := - BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) - (fun p => (-p.1, p.2)) (fun _ p => p) - (fun _ _ f k p => f (k p)) - ∀ (h : BandPackingSymmetry), ∀ (c : Real), ∀ (p : Real × Real), R h (c • p) = c • R h p ) - := by - classical - intro R h c p - induction h generalizing p with - | identity => rfl - | negate => ext <;> simp [R] - | conjugate => ext <;> simp [R] - | shift w => rfl - | comp h k ih ik => simp [R, ih, ik] +private abbrev rsmul := + BandPackingSymmetryLinearIdentities.linearity.2 private theorem rpoint : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean index 7b6f1a3a7f..725b655564 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryDomainTransport public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhaseUnique @@ -165,19 +166,7 @@ private theorem zeroLine : have hp := (ProperBandCurvatureStructure _ hq).1 omega -private theorem actionForward : - (by - classical - exact - ∀ (a : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), (x ∈ k.domain) - → (BandPackingSymmetryVectorAction a x ∈ (BandPackingSymmetryPartialOdometerAction a - k).domain) ) := by - classical - intro a k x hx - change BandPackingSymmetryVectorAction a x ∈ - ((BandPackingSymmetryPartialOdometerAction a k).domain : Set GaussianInt) - rw [(BandPackingSymmetryPartialOdometerActionFormulas a k k).1] - exact ⟨x, hx, rfl⟩ +private abbrev actionForward := BandPackingSymmetryDomainTransport.forward private theorem actionDiff : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandParentCentroidComparison.lean b/LeanPool/ApollonianSuperharmonic/BandParentCentroidComparison.lean new file mode 100644 index 0000000000..2c87e2b3a7 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandParentCentroidComparison.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.BandVectors +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import Mathlib.Init + + +/-! +# BandParentCentroidComparison + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace BandParentCentroidComparison + +/-- Shared centroidEquality fact. -/ +theorem centroidEquality : + (by + classical + exact + ∀ (q : Fin 4 → CircleCoordinates), ∀ (T₀ : ProtoTile), ∀ (q' : Fin (4 : ℕ) → + CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), TileCentroid (S' j t) - TileCentroid + T₀ = (if t = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q' (j + (2 : Fin (3 : ℕ))).succ) (q' (j + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint (BandVectors.1 (q' (j + (2 : Fin (3 : ℕ))).succ) (q' (j + (1 : + Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q' (j + (2 : Fin (3 : + ℕ))).succ) (q' (j + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (R : Fin (3 : ℕ) → Bool → + ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (R i s) - TileCentroid + T₀ = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin + (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : + ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + (BandVectors.1 (q' ((i' + 2).succ)) (q' ((i' + 1).succ)) = BandVectors.1 (q ((j + + 2).succ)) (q ((j + 1).succ))) → (TileCentroid (S' i' hs) = TileCentroid (R j hs)))) ) + := by + classical + intro q T₀ q' i' hs S' hcent' R hrootCent r j hvector + calc + TileCentroid (S' i' hs) = + (TileCentroid (S' i' hs) - TileCentroid T₀) + TileCentroid T₀ := by abel + _ = (TileCentroid (R j hs) - TileCentroid T₀) + TileCentroid T₀ := by + rw [hcent' i' hs, hrootCent j hs, hvector] + _ = TileCentroid (R j hs) := by abel + + +end BandParentCentroidComparison +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileCentroidBounds.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileCentroidBounds.lean new file mode 100644 index 0000000000..6064dad4e2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileCentroidBounds.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileCentroid +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import Mathlib.Init + + +/-! +# BandPrototileCentroidBounds + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace BandPrototileCentroidBounds + +/-- Shared imaginaryCenter fact. -/ +theorem imaginaryCenter : + (by + classical + exact + ∀ (T : ProtoTile), + let c := TileCentroid T + let imCells : Finset Int := T.cells.image (fun x => x.im) + ∀ (imNe : imCells.Nonempty), (∀ p ∈ TileRealization T, (2 * c.1 - p.1, 2 * c.2 - p.2) ∈ + TileRealization T) → ((∀ p ∈ TileRealization T, (imCells.min' imNe : Real) ≤ p.2 ∧ + p.2 ≤ (imCells.max' imNe : Real) + 1) → ( + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + (∃ x ∈ T.cells, x.im = mIm) → ((∃ x ∈ T.cells, x.im = MIm) → (2 * c.2 = (mIm : Real) + + MIm + 1)))) + ) := by + classical + intro T c imCells imNe reflect_mem boundIm mIm MIm minImCell maxImCell + rcases minImCell with ⟨xmin, hxmin, hxminim⟩ + rcases maxImCell with ⟨xmax, hmax, hmaxim⟩ + have pmin : ((xmin.re : Real), (mIm : Real)) ∈ TileRealization T := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmin, hxmin, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + exact ⟨⟨by simp, by simp [hxminim]⟩, + ⟨by simp, by simp [hxminim]⟩⟩ + have pmax : ((xmax.re : Real), ((MIm : Real) + 1)) ∈ TileRealization T := by + simp only [TileRealization, Set.mem_iUnion] + refine ⟨xmax, hmax, ?_⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + exact ⟨⟨by simp, by simp [hmaxim]⟩, + ⟨by simp, by simp [hmaxim]⟩⟩ + have bmin := boundIm _ (reflect_mem _ pmin) + have bmax := boundIm _ (reflect_mem _ pmax) + dsimp at bmin bmax + norm_num at bmin bmax ⊢ + linarith + + +end BandPrototileCentroidBounds +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean index d942e2c9d1..209bad0137 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidBounds public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry public import LeanPool.ApollonianSuperharmonic.PartialOdometerSquares @@ -113,42 +114,8 @@ private theorem boundIm : exact_mod_cast hh linarith [hpx.2.2] -private theorem centerIm : - (by - classical - exact - ∀ (T : ProtoTile), - let c := TileCentroid T - let imCells : Finset Int := T.cells.image (fun x => x.im) - ∀ (imNe : imCells.Nonempty), (∀ p ∈ TileRealization T, (2 * c.1 - p.1, 2 * c.2 - p.2) ∈ - TileRealization T) → ((∀ p ∈ TileRealization T, (imCells.min' imNe : Real) ≤ p.2 ∧ - p.2 ≤ (imCells.max' imNe : Real) + 1) → ( - let mIm := imCells.min' imNe - let MIm := imCells.max' imNe - (∃ x ∈ T.cells, x.im = mIm) → ((∃ x ∈ T.cells, x.im = MIm) → (2 * c.2 = (mIm : Real) + - MIm + 1)))) - ) := by - classical - intro T c imCells imNe reflect_mem boundIm mIm MIm minImCell maxImCell - rcases minImCell with ⟨xmin, hxmin, hxminim⟩ - rcases maxImCell with ⟨xmax, hmax, hmaxim⟩ - have pmin : ((xmin.re : Real), (mIm : Real)) ∈ TileRealization T := by - simp only [TileRealization, Set.mem_iUnion] - refine ⟨xmin, hxmin, ?_⟩ - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - exact ⟨⟨by simp, by simp [hxminim]⟩, - ⟨by simp, by simp [hxminim]⟩⟩ - have pmax : ((xmax.re : Real), ((MIm : Real) + 1)) ∈ TileRealization T := by - simp only [TileRealization, Set.mem_iUnion] - refine ⟨xmax, hmax, ?_⟩ - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - exact ⟨⟨by simp, by simp [hmaxim]⟩, - ⟨by simp, by simp [hmaxim]⟩⟩ - have bmin := boundIm _ (reflect_mem _ pmin) - have bmax := boundIm _ (reflect_mem _ pmax) - dsimp at bmin bmax - norm_num at bmin bmax ⊢ - linarith +private abbrev centerIm := + BandPrototileCentroidBounds.imaginaryCenter private theorem tau_cell : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean index 8e5a217b3a..0717c71ae5 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidBounds public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.BandGenealogy @@ -938,41 +939,8 @@ private theorem maxImCell : rcases Finset.mem_image.mp (Finset.max'_mem imCells imNe) with ⟨x, hx, he⟩ exact ⟨x, hx, he⟩ -private theorem centerIm : - (by - classical - exact - ∀ (T1 : ProtoTile), - let c1 := TileCentroid T1 - let imCells : Finset Int := T1.cells.image (fun x => x.im) - ∀ (imNe : imCells.Nonempty), (∀ p ∈ TileRealization T1, (2 * c1.1 - p.1, 2 * c1.2 - p.2) - ∈ TileRealization T1) → ((∀ p ∈ TileRealization T1, (↑(imCells.min' imNe) : Real) ≤ - p.2 ∧ p.2 ≤ (↑(imCells.max' imNe) : Real) + 1) → ( - let mIm := imCells.min' imNe - let MIm := imCells.max' imNe - (∃ x ∈ T1.cells, x.im = mIm) → ((∃ x ∈ T1.cells, x.im = MIm) → (2 * c1.2 = (mIm : Real) + - MIm + 1)))) ) := by - classical - intro T1 c1 imCells imNe reflect1 hboundIm mIm MIm minImCell maxImCell - rcases minImCell with ⟨xmin, hxmin, hxminim⟩ - rcases maxImCell with ⟨xmax, hmax, hmaxim⟩ - have pmin : ((xmin.re : Real), (mIm : Real)) ∈ TileRealization T1 := by - simp only [TileRealization, Set.mem_iUnion] - refine ⟨xmin, hxmin, ?_⟩ - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - exact ⟨⟨by simp, by simp [hxminim]⟩, - ⟨by simp, by simp [hxminim]⟩⟩ - have pmax : ((xmax.re : Real), ((MIm : Real) + 1)) ∈ TileRealization T1 := by - simp only [TileRealization, Set.mem_iUnion] - refine ⟨xmax, hmax, ?_⟩ - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - exact ⟨⟨by simp, by simp [hmaxim]⟩, - ⟨by simp, by simp [hmaxim]⟩⟩ - have bmin := hboundIm _ (reflect1 _ pmin) - have bmax := hboundIm _ (reflect1 _ pmax) - dsimp at bmin bmax - norm_num at bmin bmax ⊢ - linarith +private abbrev centerIm := + BandPrototileCentroidBounds.imaginaryCenter private theorem ht1 : (by @@ -1575,58 +1543,6 @@ private theorem sumIm : · intro x hx exact (congrArg (fun z => (z.im : Real)) (tau_invol x)).symm -private theorem hre : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), - let q' : Fin 4 → CircleCoordinates := - BandPackingSymmetryQuadrupleAction g - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - ∀ (T1 : ProtoTile), - let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) - let I : GaussianInt := ⟨0, 1⟩ - let reCells : Finset Int := T1.cells.image (fun x => x.re) - let imCells : Finset Int := T1.cells.image (fun x => x.im) - ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), - let mRe := reCells.min' reNe - let MRe := reCells.max' reNe - let mIm := imCells.min' imNe - let MIm := imCells.max' imNe - let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ - let t0 : GaussianInt := t1 + a - I * a - let tau : GaussianInt → GaussianInt := fun x => t0 - x - 1 - I - ∀ x, ((tau x).re : Real) = (t0.re : Real) - (x.re : Real) - 1 ) := by - classical - intro q r g q' T1 a I reCells imCells reNe imNe mRe MRe mIm MIm t1 t0 tau x - simp [tau, I] - -private theorem him : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), - let q' : Fin 4 → CircleCoordinates := - BandPackingSymmetryQuadrupleAction g - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - ∀ (T1 : ProtoTile), - let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) - let I : GaussianInt := ⟨0, 1⟩ - let reCells : Finset Int := T1.cells.image (fun x => x.re) - let imCells : Finset Int := T1.cells.image (fun x => x.im) - ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), - let mRe := reCells.min' reNe - let MRe := reCells.max' reNe - let mIm := imCells.min' imNe - let MIm := imCells.max' imNe - let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ - let t0 : GaussianInt := t1 + a - I * a - let tau : GaussianInt → GaussianInt := fun x => t0 - x - 1 - I - ∀ x, ((tau x).im : Real) = (t0.im : Real) - (x.im : Real) - 1 ) := by - classical - intro q r g q' T1 a I reCells imCells reNe imNe mRe MRe mIm MIm t1 t0 tau x - simp [tau, I] - private theorem sRe : (by classical @@ -1940,11 +1856,19 @@ private theorem hrootCent : T0.cells.sum (fun x => ((tau x).im : Real)) := PrototileConstruction.sumIm q r g T1 S reNe imNe tau_invol tau_cells have hre : ∀ x, ((tau x).re : Real) = - (t0.re : Real) - (x.re : Real) - 1 := PrototileConstruction.hre q r g T1 - reNe imNe + (t0.re : Real) - (x.re : Real) - 1 := (show + ∀ x, ((tau x).re : Real) = (t0.re : Real) - (x.re : Real) - 1 + from by + classical + intro x + simp [tau, I]) have him : ∀ x, ((tau x).im : Real) = - (t0.im : Real) - (x.im : Real) - 1 := PrototileConstruction.him q r g T1 - reNe imNe + (t0.im : Real) - (x.im : Real) - 1 := (show + ∀ x, ((tau x).im : Real) = (t0.im : Real) - (x.im : Real) - 1 + from by + classical + intro x + simp [tau, I]) have sRe : 2 * T0.cells.sum (fun x => (x.re : Real)) = (T0.cells.card : Real) * (t0.re : Real) - T0.cells.card := PrototileConstruction.sRe q r g T1 S reNe imNe sumRe hre diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileQuarterTurn.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileQuarterTurn.lean new file mode 100644 index 0000000000..7ab44ac45b --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileQuarterTurn.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction + +/-! +# BandPrototileQuarterTurn + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace BandPrototileQuarterTurn + +/-- Every band prototile is quarter-turn symmetric. -/ +theorem symmetry (D : CircleCoordinates) (U : ProtoTile) (hU : BandPrototile D U) : + QuarterTurnSymmetric U := by + classical + cases hU with + | line w z hw => + intro p + simp [TileRealization, TileCentroid] + | unit z a anchor => + intro p + have hc : TileCentroid (⟨{a}, anchor⟩ : ProtoTile) = + (((a.re : Int) : Real) + (1 / 2 : Real), + ((a.im : Int) : Real) + (1 / 2 : Real)) := by + simp [TileCentroid] + rw [hc] + rcases p with ⟨px, py⟩ + simp only [TileRealization, Finset.mem_singleton, Set.mem_iUnion] + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor + · rintro ⟨b, rfl, hlo, hhi⟩ + refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> + linarith [hlo.1, hlo.2, hhi.1, hhi.2] + · rintro ⟨b, rfl, hlo, hhi⟩ + refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> + linarith [hlo.1, hlo.2, hhi.1, hhi.2] + | @decompose q' hq' S' U' hS hcells hfoot hcent => + exact (BandTileSimultaneousInduction q' hq' U + (.decompose hq' hS hcells hfoot hcent)).2.2.2.1 + +end BandPrototileQuarterTurn +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandQuadrupleCyclicRotation.lean b/LeanPool/ApollonianSuperharmonic/BandQuadrupleCyclicRotation.lean new file mode 100644 index 0000000000..7cca44b19f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandQuadrupleCyclicRotation.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProperBandQuadruple +public import Mathlib.Init + + +/-! +# BandQuadrupleCyclicRotation + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace BandQuadrupleCyclicRotation + +/-- Cyclically reordering the three parents preserves properness. -/ +theorem proper : ∀ (q : Fin 4 → CircleCoordinates), ProperBandQuadruple q → + ∀ (r : Fin 3), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ProperBandQuadruple qrot := by + classical + intro q hq r qrot + have hqrotSemi : SemiProperQuadruple qrot := by + fin_cases r + · convert hq.1 using 1; funext j; fin_cases j <;> simp [qrot] + · convert SemiProperQuadruple.rotate hq.1 using 1; + funext j; fin_cases j <;> simp [qrot] + · convert SemiProperQuadruple.rotate + (SemiProperQuadruple.rotate hq.1) using 1; + funext j; fin_cases j <;> simp [qrot] + refine ⟨hqrotSemi, ?_⟩ + intro j + fin_cases r <;> fin_cases j <;> simp [qrot] + · simpa using hq.2 (0 : Fin 3) + · simpa using hq.2 (1 : Fin 3) + · simpa using hq.2 (2 : Fin 3) + · simpa using hq.2 (1 : Fin 3) + · simpa using hq.2 (2 : Fin 3) + · simpa using hq.2 (0 : Fin 3) + · simpa using hq.2 (2 : Fin 3) + · simpa using hq.2 (0 : Fin 3) + · simpa using hq.2 (1 : Fin 3) + +end BandQuadrupleCyclicRotation +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean b/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean index 821eba61d2..7062976c76 100644 --- a/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean +++ b/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.AffineTriangularPlaneTriangulation public import LeanPool.ApollonianSuperharmonic.AffineTriangularComplexChart @@ -554,18 +555,8 @@ private theorem facescard : fun h => Sum.inl_ne_inr (D.faces.injective h) simp [faces, hn] -private theorem translate_add : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), TileTranslation - (TileTranslation U x) y = TileTranslation U (x + y) ) := by - classical - intro U x y - cases U - simp only [TileTranslation, Finset.image_image, Function.comp_def, - GaussianTranslation, add_assoc] - rfl +private abbrev translate_add := + TileTranslationProperties.add private theorem hzero : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean b/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean index 1b42ff26a3..4ee91fe5da 100644 --- a/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean +++ b/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean @@ -859,18 +859,8 @@ private theorem hs'At727 : intro q p hsucc u simpa [u] using hsucc -private theorem hb : - ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ( - let base : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] - ProperBandQuadruple base) := by - classical - intro q hq base - refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1), ?_⟩ - intro i - fin_cases i - · simpa [base] using hq.2 2 - · simpa [base] using hq.2 0 - · simpa [base] using hq.2 1 +private abbrev hb := + ApollonianSuperharmonic.RetainedBoundaryDetails.huAt713 private theorem hnl'At757 : ∀ (q : Fin 4 → CircleCoordinates), (∀ (i : Fin (4 : ℕ)), (q i).1 ≠ (0 : ℤ)) → ( diff --git a/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean b/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean index b2d43bee3d..38e4a774b7 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean @@ -450,69 +450,6 @@ private theorem hks : (fun x hx => (hkrest true x hx).1), (fun x hx => (hkrest true x hx).2.symm)⟩ -private theorem hrest : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r - : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), - let qr : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let p := BandPackingSymmetryQuadrupleAction s qr - let V := BandPackingSymmetryTileAction s U - let l := BandPackingSymmetryPartialOdometerAction s k - ∀ (hp : ProperBandQuadruple p), ∀ (hpos : 0 < (p 0).1), ∀ (cfg : - BandOrderedGeneralConfiguration p), - let B : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ - ∀ (cert : BandOrderedGeneralLayoutCertificate p cfg B V), - let restrict (W : ProtoTile) : PartialOdometer := - let d := l.domain.filter fun x => decide (x ∈ FootprintVertices W) - { domain := d - value := fun x => if x ∈ d then l.value x else 0 - value_outside := by intro x hx; exact ite_eq_right hx } - let ls := fun i s => restrict (cert.P i s) - (∀ i, ∀ s, ∀ x, x ∈ (ls i s).domain → x ∈ l.domain ∧ l.value x = (ls i s).value x) → (∀ - (G : IntegerLatticeFunction), (GlobalOdometerExtends G l) → (∀ i, ∀ t, - GlobalOdometerExtends G (ls i t))) ) := by - classical - intro U k q r s qr p V l hp hpos cfg B cert restrict ls hlrest G heG i t - obtain ⟨b, hb⟩ := heG - refine ⟨b, ?_⟩ - intro x hx - rw [hb x (hlrest i t x hx).1, (hlrest i t x hx).2] - -private theorem hkext : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r - : Fin (3 : ℕ)), ∀ (s : BandPackingSymmetry), - let qr : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let p := BandPackingSymmetryQuadrupleAction s qr - let V := BandPackingSymmetryTileAction s U - let l := BandPackingSymmetryPartialOdometerAction s k - ∀ (hp : ProperBandQuadruple p), ∀ (hpos : 0 < (p 0).1), ∀ (cfg : - BandOrderedGeneralConfiguration p), - let B : BandCircle := ⟨⟨p 0, Or.inl hpos, p, hp.1, 0, rfl⟩, hpos⟩ - ∀ (cert : BandOrderedGeneralLayoutCertificate p cfg B V), - let restrict (W : ProtoTile) : PartialOdometer := - let d := l.domain.filter fun x => decide (x ∈ FootprintVertices W) - { domain := d - value := fun x => if x ∈ d then l.value x else 0 - value_outside := by intro x hx; exact ite_eq_right hx } - let ls := fun i s => restrict (cert.P i s) - let ks := fun _ : Bool => restrict cert.O - (∀ s, ∀ x, x ∈ (ks s).domain → x ∈ (ls 0 s).domain ∧ (ls 0 s).value x = (ks s).value x) → - (∀ (G : IntegerLatticeFunction), (∀ i, ∀ t, GlobalOdometerExtends G (ls i t)) → - (GlobalOdometerExtends G (ks true))) ) := by - classical - intro U k q r s qr p V l hp hpos cfg B cert restrict ls ks hkrest G hrest - obtain ⟨b, hb⟩ := hrest 0 true - refine ⟨b, ?_⟩ - intro x hx - rw [hb x (hkrest true x hx).1, (hkrest true x hx).2] - private theorem kids : (by classical @@ -757,7 +694,15 @@ theorem BandTileAcyclicIndegree : (BandAcyclicIndegreeGeometry.hOancestor U q r s hp hpos cfg cert) obtain ⟨G, heG, hlat, htile, hweb, hperiod, hlap⟩ := BandCanonicalPeriodicExtension B p hp rfl V l f' hV hl hldom he' - have hrest := BandAcyclicIndegreeGeometry.hrest U k q r s hp hpos cfg cert hlrest G heG + have hrest := (show + ∀ i, ∀ t, GlobalOdometerExtends G (ls i t) + from by + classical + intro i t + obtain ⟨b, hb⟩ := heG + refine ⟨b, ?_⟩ + intro x hx + rw [hb x (hlrest i t x hx).1, (hlrest i t x hx).2]) let D := l.domain.filter fun x => @decide (x ∉ BoundaryFootprintVertices V) (Classical.propDecidable _) let A := fun a : Fin 3 × Bool => (ls a.1 a.2).domain.filter fun x => @@ -770,8 +715,14 @@ theorem BandTileAcyclicIndegree : hlsdom hls G hrest let os := fun a => Classical.choice (kids a) have mass := P5532T1RestrictionMassBalance (cfg.firstPredecessor 1) - cert.O (ks true) G (hks true) (hksdom true) (BandAcyclicIndegreeGeometry.hkext U k q r - s hp hpos cfg cert hkrest G hrest) + cert.O (ks true) G (hks true) (hksdom true) ((show + GlobalOdometerExtends G (ks true) + from by + classical + obtain ⟨b, hb⟩ := hrest 0 true + refine ⟨b, ?_⟩ + intro x hx + rw [hb x (hkrest true x hx).1, (hkrest true x hx).2])) obtain ⟨hAD, hpair, hcross, hUnion⟩ := P5532T1ParentInteriorGeometry B p cfg V cert l ls (ks true) hlat hldom hlsdom (hksdom true) have closed := BandAcyclicIndegreeGeometry.closed U k q r s hp hpos cfg cert G kids mass diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean b/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean index 41e83b4d7a..c60ff96718 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean @@ -493,20 +493,8 @@ private theorem hσm : _ = (a, b) + σ r := by rw [h] _ = σ r + (a, b) := by abel -private theorem hσs : - (by - classical - exact - ∀ (m : ℤ × ℤ), ∀ (s : ℤ × ℤ), ∀ (σ : ℤ × ℤ ≃+ ℤ × ℤ), ∀ (c : ℤ), ∀ (d : ℤ), (σ (s - m) = - (c, d)) → (σ s = σ m + (c, d)) ) := by - classical - intro m s σ c d hσsm - have h := hσsm - rw [map_sub] at h - calc - σ s = (σ s - σ m) + σ m := by abel - _ = (c, d) + σ m := by rw [h] - _ = σ m + (c, d) := by abel +private abbrev hσs := + ApollonianSuperharmonic.BoundaryConcatenationGeometry.hσm private theorem hDimage : (by diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean b/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean index 8ac0c3bb1e..76acc83a1f 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean @@ -504,51 +504,6 @@ private theorem realize : obtain ⟨m, hm, ha⟩ := inner W hW exact ⟨m, hm, AncestorOdometerTrans _ _ _ _ _ _ _ _ _ ha ancestor⟩ -private theorem hxk : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin (3 : ℕ)), ∀ (orientation : Bool), ∀ - (T₀ : ProtoTile), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : - ProtoTile), ∀ (tiles : List ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hminus : - PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (hO₀ : TileOdometer C₀.1.1 T₀ h₀), ∀ - (hOminus : TileOdometer Cᵢ.1.1 Rminus hminus), ∀ (hOplus : TileOdometer Cᵢ.1.1 Rplus - hplus), ∀ (p₀ : ℝ × ℝ), ∀ (pminus : ℝ × ℝ), ∀ (pplus : ℝ × ℝ), ∀ (hs₀ : - PartialOdometerSlope h₀ = some p₀), ∀ (hsminus : PartialOdometerSlope hminus = some - pminus), ∀ (hsplus : PartialOdometerSlope hplus = some pplus), ∀ (qb : Fin (4 : ℕ) → - CircleCoordinates), ∀ (hqb : ProperBandQuadruple qb), ∀ (hb₀ : qb (0 : Fin (4 : ℕ)) = - C₀.1.1), ∀ (hbᵢ : qb i.succ = Cᵢ.1.1), ∀ (hT₀ : BandPrototile C₀.1.1 T₀), ∀ (hchart : - Cᵢ.1.1.1 = (1 : ℤ) → UnitOccurrenceOrientation qb i orientation), ∀ (htiles : - TileString Cᵢ orientation base Rminus Rplus tiles), ∀ (hcminus : TileCentroid Rminus - - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (qb i.succ) (qb (0 - : Fin (4 : ℕ))) - BandVectors.1 (qb (0 : Fin (4 : ℕ))) (qb i.succ))), ∀ (hcplus : - TileCentroid Rplus - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 - (qb i.succ) (qb (0 : Fin (4 : ℕ))) + BandVectors.1 (qb (0 : Fin (4 : ℕ))) (qb - i.succ))), ∀ (dm : pminus - p₀ = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (qb - i.succ) (qb 0) - BandVectors.2 (qb 0) (qb i.succ))), ∀ (dp : pplus - p₀ = (1 / 2 : ℝ) - • GaussianRealPoint (BandVectors.2 (qb i.succ) (qb 0) + BandVectors.2 (qb 0) (qb - i.succ))), - let initial : P4458T1BoundaryFrame Cᵢ orientation base Rminus Rplus hminus hplus := - { outer := C₀, q := qb, proper := hqb, slot := i, child := hb₀, parent := hbᵢ - tile := T₀, odometer := h₀, outer_odo := hO₀, minus_odo := hOminus - plus_odo := hOplus, outer_band := hT₀, base_band := htiles.1 - minus_family := htiles.2.2.2.2.1 _ (List.mem_of_mem_head? htiles.2.1) - plus_family := htiles.2.2.2.2.1 _ (List.mem_of_getLast? htiles.2.2.1) - chart := hchart, minus_centroid := hcminus, plus_centroid := hcplus - outerSlope := p₀, minusSlope := pminus, plusSlope := pplus - slope_outer := hs₀, slope_minus := hsminus, slope_plus := hsplus - minus_difference := dm, plus_difference := dp } - ∀ (U : ProtoTile), ∀ (k : PartialOdometer), (AncestorOdometer Cᵢ.1.1 initial.outer.1.1 U - initial.tile k initial.odometer) → (∀ (x : - GaussianInt), (x ∈ FootprintVertices U) → (x ∈ k.domain)) ) := by - classical - intro C₀ Cᵢ i orientation T₀ base Rminus Rplus tiles h₀ hminus hplus hO₀ hOminus hOplus p₀ - pminus pplus hs₀ hsminus hsplus qb hqb hb₀ hbᵢ hT₀ hchart htiles hcminus hcplus dm dp - initial U k ha x hx - change x ∈ (k.domain : Set GaussianInt) - rw [ha.2.2.1] - exact hx - end BoundaryOdometerGeometry theorem BoundaryStringOdometerRespect : @@ -658,9 +613,13 @@ theorem BoundaryStringOdometerRespect : have domain := PositiveCurvatureTileOdometerDomain C₀.1.1 T₀ h₀ C₀.property hO₀ intro x hx rw [← domain] - exact ha.2.2.2.1 (BoundaryOdometerGeometry.hxk C₀ Cᵢ i orientation T₀ base Rminus Rplus tiles - h₀ hminus hplus hO₀ hOminus hOplus p₀ pminus pplus hs₀ hsminus hsplus qb hqb hb₀ hbᵢ hT₀ - hchart htiles hcminus hcplus dm dp U k ha x hx) + exact ha.2.2.2.1 ((show + x ∈ k.domain + from by + classical + change x ∈ (k.domain : Set GaussianInt) + rw [ha.2.2.1] + exact hx)) end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean b/LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean index e8d096aab4..8eefe98f9d 100644 --- a/LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean +++ b/LeanPool/ApollonianSuperharmonic/CellDisjointCommonFootprintIncidence.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion public import Mathlib.Data.EReal.Basic public import Mathlib.Topology.MetricSpace.Pseudo.Defs public import Mathlib.Topology.MetricSpace.Pseudo.Lemmas @@ -35,19 +36,7 @@ namespace CommonFootprintIncidence private noncomputable def I : GaussianInt := ⟨0, 1⟩ -private theorem boundary_footprint (T : ProtoTile) (e : Finset GaussianInt) - (he : e ∈ BoundaryFootprintEdges T) : e ∈ FootprintEdges T := by - classical - let I : GaussianInt := ⟨0, 1⟩ - rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inl rfl⟩ - · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ - congr 1 <;> simp [I, Zsqrtd.ext_iff] - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ - congr 1 <;> simp [] +private abbrev boundary_footprint := BoundaryFootprintInclusion.boundaryEdge private noncomputable def toR : GaussianInt → Real × Real := fun z => ((z.re : Int), (z.im : Int)) @@ -66,27 +55,7 @@ private theorem vertex_realization (T : ProtoTile) (hne : T.cells.Nonempty) subst z simp [ClosedSquareRealization, toR, Prod.le_def] -private theorem edge_vertex_footprint (T : ProtoTile) (e : Finset GaussianInt) - (he : e ∈ FootprintEdges T) (z : GaussianInt) (hz : z ∈ e) : - z ∈ FootprintVertices T := by - classical - rcases he with ⟨c, hc, he⟩ - unfold FootprintVertices - rw [ite_eq_left ⟨c, hc⟩] - rcases he with h | h | h | h <;> subst e - all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hz - · rcases hz with rfl | rfl - · exact ⟨_, hc, Or.inl rfl⟩ - · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ - · rcases hz with rfl | rfl - · exact ⟨_, hc, Or.inl rfl⟩ - · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ - · rcases hz with rfl | rfl - · exact ⟨_, hc, Or.inr (Or.inl rfl)⟩ - · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ - · rcases hz with rfl | rfl - · exact ⟨_, hc, Or.inr (Or.inr (Or.inl rfl))⟩ - · exact ⟨_, hc, Or.inr (Or.inr (Or.inr rfl))⟩ +private abbrev edge_vertex_footprint := BoundaryFootprintInclusion.edgeVertex private theorem local_cell (z c : GaussianInt) (p : Real × Real) (hpnear : dist p (toR z) < (1 / 2 : Real)) diff --git a/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean index f8f9b2d320..63b322e8cd 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean @@ -144,23 +144,8 @@ private theorem hT0cent : rw [hc, (TileTranslationFormulas (DiamondTile K.1) u).2.2.2.2.1] rfl -private theorem hT0'cent : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (T0' : ProtoTile), ∀ (u' : GaussianInt), (T0'.cells = - (TileTranslation (DiamondTile K.1) u').cells) → ((T0'.cells.Nonempty) → (TileCentroid - T0' = TileCentroid (DiamondTile K.1) + GaussianRealPoint u')) ) := by - classical - intro K T0' u' hu'Cell hT0'ne - have htrne : (TileTranslation (DiamondTile K.1) u').cells.Nonempty := by - rw [← hu'Cell] - exact hT0'ne - have hc : TileCentroid T0' = TileCentroid (TileTranslation (DiamondTile K.1) u') := by - unfold TileCentroid - rw [ite_eq_left hT0'ne, ite_eq_left htrne, hu'Cell] - rw [hc, (TileTranslationFormulas (DiamondTile K.1) u').2.2.2.2.1] - rfl +private abbrev hT0'cent := + ApollonianSuperharmonic.DiamondBoundaryStarGeometry.hT0cent private theorem hshift : (by diff --git a/LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean b/LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean index 3f77c1561c..878ff16b91 100644 --- a/LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean +++ b/LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt public import LeanPool.ApollonianSuperharmonic.ExceptionalConnectorSegments @@ -29,42 +30,9 @@ namespace ApollonianSuperharmonic namespace ExceptionalConnectorProof -private theorem boundary_edge : - ∀ (U : ProtoTile), ∀ e ∈ BoundaryFootprintEdges U, e ∈ FootprintEdges U := by - classical - intro U e he - let I : GaussianInt := ⟨0, 1⟩ - rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inl rfl⟩ - · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ - congr 1 <;> simp [I, Zsqrtd.ext_iff] - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ - congr 1 <;> simp [] +private abbrev boundary_edge := BoundaryFootprintInclusion.boundaryEdge -private theorem edge_vertex : - ∀ (U : ProtoTile), ∀ e ∈ FootprintEdges U, ∀ x ∈ e, x ∈ FootprintVertices U := by - classical - intro U e he x hx - rcases he with ⟨c, hc, he⟩ - simp only [FootprintVertices, ite_eq_left (show U.cells.Nonempty from ⟨c, hc⟩), - Set.mem_ofPred_eq] - rcases he with h | h | h | h <;> subst e - all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hx - · rcases hx with rfl | rfl - · exact ⟨_, hc, Or.inl rfl⟩ - · exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ - · rcases hx with rfl | rfl - · exact ⟨_, hc, Or.inl rfl⟩ - · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ - · rcases hx with rfl | rfl - · exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ - · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ - · rcases hx with rfl | rfl - · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ - · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ +private abbrev edge_vertex := BoundaryFootprintInclusion.edgeVertex private theorem incident : ∀ (U : ProtoTile), ∀ (x : GaussianInt), Finset.Nonempty U.cells → x ∈ FootprintVertices U → ∃ diff --git a/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean b/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean index 4a51e130fb..0673ade099 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.PairAssignmentFacts +public import LeanPool.ApollonianSuperharmonic.TileCornerMultiplicity public import Mathlib.Data.Finset.Card public import Mathlib.Data.Set.Card public import Mathlib.Tactic.NormNum @@ -54,19 +56,8 @@ private theorem hcountpos : rw [Multiset.mem_toFinset] at hz exact Multiset.count_pos.mpr hz -private theorem hvertexSet : - ∀ (T : ProtoTile), (T.cells.Nonempty) → ( - let I : GaussianInt := ⟨0, 1⟩ - let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => - ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) - (cornerBag.toFinset : Set GaussianInt) = FootprintVertices T) := by - classical - intro T hne I cornerBag - ext z - change z ∈ cornerBag.toFinset ↔ z ∈ FootprintVertices T - rw [Multiset.mem_toFinset] - dsimp only [cornerBag, I] - simp [FootprintVertices, hne] +private abbrev hvertexSet := + TileCornerMultiplicity.vertexSupport private theorem hvertexCard : ∀ (T : ProtoTile), @@ -400,18 +391,8 @@ private theorem hedgeIdentity : rw [hedgePartition, ← hedgeBagCard] at ⊢ omega -private theorem pair_eq : - ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ {d : GaussianInt}, (({a, b} - : Finset GaussianInt) = {c, d}) → ((a = c ∧ b = d) ∨ (a = d ∧ b = c)) := by - classical - intro a b c d h - have hs : ({a, b} : Set GaussianInt) = {c, d} := by - ext x - have hx := congrArg (fun s : Finset GaussianInt => x ∈ s) h - apply Iff.of_eq - change (x = a ∨ x = b) = (x = c ∨ x = d) - simpa only [Finset.mem_insert, Finset.mem_singleton] using hx - exact Set.pair_eq_pair_iff.mp hs +private abbrev pair_eq := + @PairAssignmentFacts.finsetPair GaussianInt inferInstance private theorem edgeOf_injective : (ProtoTile) → ( diff --git a/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean b/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean index 71eac2d964..3be0d70457 100644 --- a/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean +++ b/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordFareySum public import LeanPool.ApollonianSuperharmonic.BandCircle public import LeanPool.ApollonianSuperharmonic.BandVectors @@ -707,15 +708,8 @@ private theorem q2lt : have hsum := Q.sum_q omega -private theorem cross : - ∀ (Q : FordFareyParameter), Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1 := by - classical - intro Q - have h1 : Q.p₁ * ((Q.q₁ + Q.q₂ : Nat) : Int) - - (Q.q₁ : Int) * (Q.p₁ + Q.p₂) = 1 := by - simpa [Q.sum_q, Q.sum_p] using Q.det₁ - norm_num [Nat.cast_add] at h1 - nlinarith [h1] +private abbrev cross := + FordFareySum.determinant private theorem qone : ∀ (Q : FordFareyParameter), (0 < Q.q₁) → ((Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1) → diff --git a/LeanPool/ApollonianSuperharmonic/FordFareySum.lean b/LeanPool/ApollonianSuperharmonic/FordFareySum.lean index 95dd152616..49f5e5fd87 100644 --- a/LeanPool/ApollonianSuperharmonic/FordFareySum.lean +++ b/LeanPool/ApollonianSuperharmonic/FordFareySum.lean @@ -7,6 +7,8 @@ module public import LeanPool.ApollonianSuperharmonic.FordFareyParameter public import Mathlib.Init +public import Mathlib.Tactic.Linarith.Frontend + /-! @@ -28,6 +30,17 @@ theorem denominatorSum : intro P exact P.sum_q +/-- Shared determinant fact. -/ +theorem determinant : + ∀ (Q : FordFareyParameter), Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1 := by + classical + intro Q + have h1 : Q.p₁ * ((Q.q₁ + Q.q₂ : Nat) : Int) - + (Q.q₁ : Int) * (Q.p₁ + Q.p₂) = 1 := by + simpa [Q.sum_q, Q.sum_p] using Q.det₁ + norm_num [Nat.cast_add] at h1 + nlinarith [h1] + end FordFareySum end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean index 11d2e4b4b2..84fa37ad72 100644 --- a/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean +++ b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean @@ -853,30 +853,6 @@ private theorem outward : have hv := v3 t (a + 1) (by omega) (by omega) simpa only [add_sub_cancel_left, mul_one] using And.intro hl hv -private theorem near1 : - ∀ (P : FordFareyParameter), - let g := FordOdometer P - (GaussianInt) → ( - let a : Int := P.q₁ - let b : Int := P.q₂ - let A := P.p₁ - let B := P.p₂ - let cdiv (n d : Int) := -((-n) / d) - ((P.q : Int) = a + b) → ((0 < a) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : - FordFareyParameter), (P₂.q = P.q₂) → ((∀ (r : Int), ∀ (s : Int), (b ≤ r ∧ r ≤ P.q ∧ b ≤ s - ∧ s ≤ P.q) → ((r - b ≤ 1 ∨ a - 1 ≤ r - b ∨ s - b ≤ 1 ∨ a - 1 ≤ s - b) → (g ⟨r, s⟩ = cdiv - (A * (r - b) * (s - b)) a + B * r + B * s - B * b + 1))) → (∀ (r : ℤ), b ≤ r → r ≤ (↑P.q - : ℤ) → g ⟨r, b + (1 : ℤ)⟩ = cdiv (A * (r - b)) a + B * r + B + (1 : ℤ) ∧ g ⟨b + (1 : ℤ), - r⟩ = cdiv (A * (r - b)) a + B * r + B + (1 : ℤ))))))) := by - classical - intro P g x a b A B cdiv hsum ha0 P₁ hq₁ P₂ hq₂ v1 r ht ht' - have hl := v1 r (b + 1) (by omega) (by omega) - have hv := v1 (b + 1) r (by omega) (by omega) - simp only [add_sub_cancel_left, mul_one] at hl hv - constructor - · nlinarith only [hl] - · nlinarith only [hv] - private theorem near2 : ∀ (P : FordFareyParameter), let g := FordOdometer P @@ -1183,8 +1159,25 @@ private theorem interiorLaplacian : FourNeighborLaplacian g ⟨b, (P.q : Int) - t⟩ = cdiv (B * t) b - A * t / a := FordLaplacianProof.highFormula P lapCoord hsum hdet hb ha0 P₁ hq₁ P₂ hq₂ cminus (FordLaplacianDetails.cplus) (FordLaplacianProof.edge2 P ha x hsum hdet hb P₁ hq₁ P₂ - hq₂ v2 v3 cmul) (FordLaplacianDetails.near1 P x hsum ha0 P₁ hq₁ P₂ hq₂ - (FordLaplacianProof.v1 P x hsum P₁ hp₁ hq₁ P₂ hq₂ rec1 parentValue)) + hq₂ v2 v3 cmul) ((show + ∀ (r : ℤ), b ≤ r → r ≤ (↑P.q : ℤ) → g ⟨r, b + (1 : ℤ)⟩ = + cdiv (A * (r - b)) a + B * r + B + (1 : ℤ) ∧ g ⟨b + (1 : ℤ), + r⟩ = cdiv (A * (r - b)) a + B * r + B + (1 : ℤ) + from by + classical + intro r ht ht' + have hl := ((FordLaplacianProof.v1 P x hsum P₁ hp₁ hq₁ P₂ hq₂ rec1 + parentValue)) r (b + 1) (by omega) (by omega) + have hv := ((FordLaplacianProof.v1 P x hsum P₁ hp₁ hq₁ P₂ hq₂ rec1 + parentValue)) (b + 1) r (by omega) (by omega) + change g ⟨r, b + 1⟩ = cdiv (A * (r - b) * (b + 1 - b)) a + + B * r + B * (b + 1) - B * b + 1 at hl + change g ⟨b + 1, r⟩ = cdiv (A * (b + 1 - b) * (r - b)) a + + B * (b + 1) + B * r - B * b + 1 at hv + simp only [add_sub_cancel_left, mul_one] at hl hv + constructor + · nlinarith only [hl] + · nlinarith only [hv])) (FordLaplacianDetails.near2 P ha x hsum P₁ hq₁ P₂ hq₂ v2 v3) t ht hta htb have roundArm (t : Int) (ht : 0 < t) (hta : t < a) (htb : t < b) : cdiv (B * t) b - A * t / a = 1 := FordLaplacianProof.roundArm P hdet hb ha0 t ht hta htb diff --git a/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean index ec78d5a635..9e7beca517 100644 --- a/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean @@ -249,39 +249,8 @@ private theorem hcentT : ((GaussianTranslation u (FordTile P2.q).anchor).im : ℝ) exact_mod_cast congrArg (fun z => z.im) ha -private theorem hcentT' : - (by - classical - exact - ∀ (T' : ProtoTile), ∀ (g2 : BandPackingSymmetry), ∀ (P2 : FordFareyParameter), ∀ (u' : - GaussianInt), ((BandPackingSymmetryTileAction g2 T').cells = (TileTranslation - (FordTile P2.q) u').cells) → (((BandPackingSymmetryTileAction g2 T').cells = ∅ → - (BandPackingSymmetryTileAction g2 T').anchor = (TileTranslation (FordTile P2.q) - u').anchor) → (TileCentroid (BandPackingSymmetryTileAction g2 T') = TileCentroid - (TileTranslation (FordTile P2.q) u'))) ) := by - classical - intro T' g2 P2 u' hu' huempty' - rw [TileCentroid, TileCentroid] - by_cases hn : (BandPackingSymmetryTileAction g2 T').cells.Nonempty - · have hn' : (TileTranslation (FordTile P2.q) u').cells.Nonempty := by - rw [← hu'] - exact hn - simp [hu', hn'] - · have he : (BandPackingSymmetryTileAction g2 T').cells = ∅ := - Finset.not_nonempty_iff_eq_empty.mp hn - have ha := huempty' he - rw [(TileTranslationFormulas (FordTile P2.q) u').2.1] at ha - have ht : ¬ (TileTranslation (FordTile P2.q) u').cells.Nonempty := by - simpa [hu'] using hn - simp only [hn, ht, ite_false] - rw [(TileTranslationFormulas (FordTile P2.q) u').2.1] - apply Prod.ext - · change ((BandPackingSymmetryTileAction g2 T').anchor.re : ℝ) = - ((GaussianTranslation u' (FordTile P2.q).anchor).re : ℝ) - exact_mod_cast congrArg (fun z => z.re) ha - · change ((BandPackingSymmetryTileAction g2 T').anchor.im : ℝ) = - ((GaussianTranslation u' (FordTile P2.q).anchor).im : ℝ) - exact_mod_cast congrArg (fun z => z.im) ha +private abbrev hcentT' := + ApollonianSuperharmonic.FordBoundaryCompatibilityGeometry.hcentT private theorem hshift : (by @@ -380,40 +349,8 @@ private theorem heqH : rw [(BandPackingSymmetryPartialOdometerAction g2 h).value_outside x hx, (PartialOdometerAffineTranslate k u a b).value_outside x hnot] -private theorem heqH' : - (by - classical - exact - ∀ (h' : PartialOdometer), ∀ (g2 : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ (u' : - GaussianInt), ∀ (a' : GaussianInt), ∀ (b' : ℤ), (∀ (x : GaussianInt), x ∈ - (BandPackingSymmetryPartialOdometerAction g2 h').domain ↔ x - u' ∈ k.domain) → ((∀ x - ∈ (BandPackingSymmetryPartialOdometerAction g2 h').domain, - (BandPackingSymmetryPartialOdometerAction g2 h').value x = k.value (x - u') + a'.re * - x.re + a'.im * x.im + b') → (BandPackingSymmetryPartialOdometerAction g2 h' = - PartialOdometerAffineTranslate k u' a' b')) ) := by - classical - intro h' g2 k u' a' b' hud' huv' - apply (PartialOdometer.mk.injEq _ _ _ _ _ _).mpr - constructor - · apply Finset.ext - intro x - exact (hud' x).trans ((PartialOdometerAffineTranslateFormulas k u' a' b').2.1 x).symm - · apply funext - intro x - change (BandPackingSymmetryPartialOdometerAction g2 h').value x = - (PartialOdometerAffineTranslate k u' a' b').value x - by_cases hx : x ∈ (BandPackingSymmetryPartialOdometerAction g2 h').domain - · rw [(PartialOdometerAffineTranslateFormulas k u' a' b').2.2.1 x - (by - have hxa := (PartialOdometerAffineTranslateFormulas k u' a' b').2.1 x - exact hxa.mpr ((hud' x).mp hx))] - exact huv' x hx - · have hxa := (PartialOdometerAffineTranslateFormulas k u' a' b').2.1 x - have hnot : x ∉ (PartialOdometerAffineTranslate k u' a' b').domain := by - intro ha - exact hx ((hud' x).mpr (hxa.mp ha)) - rw [(BandPackingSymmetryPartialOdometerAction g2 h').value_outside x hx, - (PartialOdometerAffineTranslate k u' a' b').value_outside x hnot] +private abbrev heqH' := + ApollonianSuperharmonic.FordBoundaryCompatibilityGeometry.heqH private theorem hvec : (by diff --git a/LeanPool/ApollonianSuperharmonic/FourNeighborLaplacianProperties.lean b/LeanPool/ApollonianSuperharmonic/FourNeighborLaplacianProperties.lean index 64b00012ac..2afe3884d0 100644 --- a/LeanPool/ApollonianSuperharmonic/FourNeighborLaplacianProperties.lean +++ b/LeanPool/ApollonianSuperharmonic/FourNeighborLaplacianProperties.lean @@ -9,6 +9,7 @@ public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacian public import Mathlib.Init + /-! # FourNeighborLaplacianProperties @@ -34,6 +35,28 @@ theorem differences : unfold FourNeighborLaplacian ring +/-- Affine perturbations and translation preserve the four-neighbor Laplacian. -/ +theorem affineTranslate : + ∀ (f : GaussianInt → ℤ), ∀ (f' : GaussianInt → ℤ), ∀ (x : GaussianInt), ∀ (t : GaussianInt), + ∀ (A : ℤ), ∀ (B : ℤ), ∀ (C : ℤ), f x = f' (x - t) + A * x.re + B * x.im + C → f (x - (1 : + GaussianInt)) = f' (x - t - (1 : GaussianInt)) + A * (x - (1 : GaussianInt)).re + B * (x + - (1 : GaussianInt)).im + C → f (x + (1 : GaussianInt)) = f' (x - t + (1 : GaussianInt)) + + A * (x + (1 : GaussianInt)).re + B * (x + (1 : GaussianInt)).im + C → f (x - ⟨(0 : ℤ), + (1 : ℤ)⟩) = f' (x - t - ⟨(0 : ℤ), (1 : ℤ)⟩) + A * (x - ⟨(0 : ℤ), (1 : ℤ)⟩).re + B * (x - + ⟨(0 : ℤ), (1 : ℤ)⟩).im + C → f (x + ⟨(0 : ℤ), (1 : ℤ)⟩) = f' (x - t + ⟨(0 : ℤ), (1 : ℤ)⟩) + + A * (x + ⟨(0 : ℤ), (1 : ℤ)⟩).re + B * (x + ⟨(0 : ℤ), (1 : ℤ)⟩).im + C → + FourNeighborLaplacian f x = FourNeighborLaplacian f' (x - t) := by + classical + intro f f' x t A B C h0 hm hp hmi hpi + rw [FourNeighborLaplacian, hm, hp, hmi, hpi, h0, + FourNeighborLaplacian] + rw [show x - t - 1 = (x - t) - 1 by abel, + show x - t + 1 = (x - t) + 1 by abel, + show x - t - ⟨0, 1⟩ = (x - t) - ⟨0, 1⟩ by rfl, + show x - t + ⟨0, 1⟩ = (x - t) + ⟨0, 1⟩ by rfl] + simp + ring + end FourNeighborLaplacianProperties end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/Imports.lean b/LeanPool/ApollonianSuperharmonic/Imports.lean index 7e33f79e31..48bcbedb1d 100644 --- a/LeanPool/ApollonianSuperharmonic/Imports.lean +++ b/LeanPool/ApollonianSuperharmonic/Imports.lean @@ -40,6 +40,9 @@ public import LeanPool.ApollonianSuperharmonic.BandGenealogy public import LeanPool.ApollonianSuperharmonic.BandGeneralCircle public import LeanPool.ApollonianSuperharmonic.BandInterfaceRootedForest public import LeanPool.ApollonianSuperharmonic.BandLatticeEquality +public import LeanPool.ApollonianSuperharmonic.BandLayoutCentroidCoordinates +public import LeanPool.ApollonianSuperharmonic.BandLayoutFaceSupport +public import LeanPool.ApollonianSuperharmonic.BandLayoutParentNonempty public import LeanPool.ApollonianSuperharmonic.BandModifiedCellPartition public import LeanPool.ApollonianSuperharmonic.BandModifiedCoverage public import LeanPool.ApollonianSuperharmonic.BandModifiedOrbitArea @@ -105,6 +108,7 @@ public import LeanPool.ApollonianSuperharmonic.BandOrientedGapRefinement public import LeanPool.ApollonianSuperharmonic.BandOrientedGapRefinementExists public import LeanPool.ApollonianSuperharmonic.BandOriginalOccurrenceIntersectionClassification public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation +public import LeanPool.ApollonianSuperharmonic.BandOriginalParentContainment public import LeanPool.ApollonianSuperharmonic.BandPackingExterior public import LeanPool.ApollonianSuperharmonic.BandPackingShiftPotential public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetry @@ -113,8 +117,10 @@ public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCo public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCircleAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCurvature +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryDomainTransport public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryGlobalOdometerTransport public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryInversePhaseCancellation +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryLinearIdentities public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryMarkedDataCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas @@ -131,6 +137,7 @@ public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCo public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTilingTransport public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction public import LeanPool.ApollonianSuperharmonic.BandParentBoundaryGenealogy +public import LeanPool.ApollonianSuperharmonic.BandParentCentroidComparison public import LeanPool.ApollonianSuperharmonic.BandParentRotationOccurrenceCovariance public import LeanPool.ApollonianSuperharmonic.BandParentVectorQuarterTurn public import LeanPool.ApollonianSuperharmonic.BandPeriodicOdometer @@ -139,13 +146,16 @@ public import LeanPool.ApollonianSuperharmonic.BandPositiveCutBranchCompanionExc public import LeanPool.ApollonianSuperharmonic.BandPredecessorNoCollision public import LeanPool.ApollonianSuperharmonic.BandPrototile public import LeanPool.ApollonianSuperharmonic.BandPrototileCentralSymmetry +public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidBounds public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.BandPrototileCompleteSquareCentroid public import LeanPool.ApollonianSuperharmonic.BandPrototileExists public import LeanPool.ApollonianSuperharmonic.BandPrototileFootprintSlopeCovariance +public import LeanPool.ApollonianSuperharmonic.BandPrototileQuarterTurn public import LeanPool.ApollonianSuperharmonic.BandPrototileReindexedDecomposition public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm +public import LeanPool.ApollonianSuperharmonic.BandQuadrupleCyclicRotation public import LeanPool.ApollonianSuperharmonic.BandRegimeClassification public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex @@ -334,6 +344,7 @@ public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFac public import LeanPool.ApollonianSuperharmonic.LatticeCell public import LeanPool.ApollonianSuperharmonic.LatticeDiskUnionIntersectionConnected public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity +public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence public import LeanPool.ApollonianSuperharmonic.LatticeFundamentalSet public import LeanPool.ApollonianSuperharmonic.LatticeQuadraticForm public import LeanPool.ApollonianSuperharmonic.LatticeTile @@ -357,8 +368,10 @@ public import LeanPool.ApollonianSuperharmonic.LocalExponentialEstimate public import LeanPool.ApollonianSuperharmonic.LocalLatticeInterfaceSectors public import LeanPool.ApollonianSuperharmonic.LocalSideScaling public import LeanPool.ApollonianSuperharmonic.MarkedOdometerAdjacencyReduction +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileFacts public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation public import LeanPool.ApollonianSuperharmonic.NoCheckerboardCellVertex +public import LeanPool.ApollonianSuperharmonic.ObservableTileRetargeting public import LeanPool.ApollonianSuperharmonic.OdometerAdjacencyInduction public import LeanPool.ApollonianSuperharmonic.OdometerCompatibility public import LeanPool.ApollonianSuperharmonic.OdometerGluing @@ -1108,11 +1121,13 @@ public import LeanPool.ApollonianSuperharmonic.P5686T1UniformGlobalOdometerTrans public import LeanPool.ApollonianSuperharmonic.P5691T1DiamondReflectionFootprints public import LeanPool.ApollonianSuperharmonic.P5691T1PosDefQuadraticLowerBound public import LeanPool.ApollonianSuperharmonic.PSDQuadraticIntegerApproximation +public import LeanPool.ApollonianSuperharmonic.PairAssignmentFacts public import LeanPool.ApollonianSuperharmonic.ParentVectorsInTilingLattice public import LeanPool.ApollonianSuperharmonic.ParentalOrientationGluing public import LeanPool.ApollonianSuperharmonic.PartialOdometer public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslate public import LeanPool.ApollonianSuperharmonic.PartialOdometerAffineTranslateFormulas +public import LeanPool.ApollonianSuperharmonic.PartialOdometerEquality public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurn public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope @@ -1221,6 +1236,7 @@ public import LeanPool.ApollonianSuperharmonic.TileOdometerCentralSymmetry public import LeanPool.ApollonianSuperharmonic.TileOdometerDomain public import LeanPool.ApollonianSuperharmonic.TileOdometerExists public import LeanPool.ApollonianSuperharmonic.TileOdometerReindexedDecomposition +public import LeanPool.ApollonianSuperharmonic.TileOdometerSlopeNonempty public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness public import LeanPool.ApollonianSuperharmonic.TileQuarterTurn public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnFormulas diff --git a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentPackingSymmetryFacts.lean b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentPackingSymmetryFacts.lean index e965159b02..082aa4d29b 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentPackingSymmetryFacts.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentPackingSymmetryFacts.lean @@ -5,10 +5,17 @@ Authors: Wesley Pegden -/ module -public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetrySlopeAction +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryVectorAction +public import LeanPool.ApollonianSuperharmonic.GaussianRealPoint public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance -public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance -public import LeanPool.ApollonianSuperharmonic.TileOdometerDomain +public import LeanPool.ApollonianSuperharmonic.PartialOdometerSlope +public import LeanPool.ApollonianSuperharmonic.TileOdometerSlopeNonempty +public import Mathlib.Init + /-! # Shared packing-symmetry transport facts @@ -26,29 +33,7 @@ namespace LatticeAdjacentPackingSymmetryFacts theorem tileCellsNonempty (c : CircleCoordinates) (T : ProtoTile) (h : PartialOdometer) (p : ℝ × ℝ) (hO : TileOdometer c T h) (hp : PartialOdometerSlope h = some p) : T.cells.Nonempty := by - classical - have hd := TileOdometerDomain c T h hO - by_contra hn - have hde : (h.domain : Set GaussianInt) = {T.anchor} := by - rw [hd] - simp [FootprintVertices, hn] - have hs : (PartialOdometerSquares h).Nonempty := by - by_contra hs - simp [PartialOdometerSlope, hs] at hp - rcases hs with ⟨x, hx⟩ - simp only [PartialOdometerSquares, Finset.mem_filter] at hx - have hz : x + 1 = T.anchor := by - apply Set.mem_singleton_iff.mp - rw [← hde] - exact hx.2.1 - have hz0 : x = T.anchor := by - apply Set.mem_singleton_iff.mp - rw [← hde] - exact hx.1 - have hzbad : x + 1 = x := hz.trans hz0.symm - have hzbad' := congrArg (fun z : GaussianInt => z.re) hzbad - norm_num at hzbad' - + exact TileOdometerSlopeNonempty.cells c T h p hO hp /-- The slope action preserves a specified slope on a nonempty tile. -/ theorem slopeAction : diff --git a/LeanPool/ApollonianSuperharmonic/LatticeFootprintIncidence.lean b/LeanPool/ApollonianSuperharmonic/LatticeFootprintIncidence.lean new file mode 100644 index 0000000000..a965cbf1c2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeFootprintIncidence.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FootprintVertices +public import LeanPool.ApollonianSuperharmonic.LatticeVertexIncidentCell +public import Mathlib.Init + + +/-! +# LatticeFootprintIncidence + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace LatticeFootprintIncidence + +/-- Shared incidentCell fact. -/ +theorem incidentCell : + (by + classical + exact + ∀ (W : ProtoTile), ∀ (y : GaussianInt), (W.cells.Nonempty) → ((y ∈ FootprintVertices W) → + (∃ j : Fin 4, LatticeVertexIncidentCell y j ∈ W.cells)) ) := by + classical + intro W y hne hy + simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hy + rcases hy with ⟨c, hc, h | h | h | h⟩ + · exact ⟨0, by simpa [LatticeVertexIncidentCell] using h ▸ hc⟩ + · refine ⟨1, ?_⟩ + rw [h] + simpa [LatticeVertexIncidentCell] using hc + · refine ⟨3, ?_⟩ + rw [h] + simpa [LatticeVertexIncidentCell] using hc + · refine ⟨2, ?_⟩ + change y - 1 - ⟨0, 1⟩ ∈ W.cells + rw [h] + convert hc using 1 + ext <;> simp + + +end LatticeFootprintIncidence +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean index 89231c8f83..81a939db26 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean @@ -419,53 +419,6 @@ private theorem hIEeCross : ((edge_finite A).inter_of_left (FootprintEdges C)) ((edge_finite B).inter_of_left (FootprintEdges C)) -private theorem htripleVcard : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (AB : ProtoTile), ∀ (BC : - ProtoTile), ∀ (CA : ProtoTile), ∀ (ABC : ProtoTile), (AB.cells.card = A.cells.card + - B.cells.card) → ((BC.cells.card = B.cells.card + C.cells.card) → ((CA.cells.card = - C.cells.card + A.cells.card) → ((ABC.cells.card = A.cells.card + B.cells.card + - C.cells.card) → (((FootprintVertices AB).ncard + (FootprintVertices A ∩ - FootprintVertices B).ncard = (FootprintVertices A).ncard + (FootprintVertices - B).ncard) → (((FootprintVertices BC).ncard + (FootprintVertices B ∩ FootprintVertices - C).ncard = (FootprintVertices B).ncard + (FootprintVertices C).ncard) → - (((FootprintVertices CA).ncard + (FootprintVertices C ∩ FootprintVertices A).ncard = - (FootprintVertices C).ncard + (FootprintVertices A).ncard) → (((FootprintEdges - AB).ncard + (FootprintEdges A ∩ FootprintEdges B).ncard = (FootprintEdges A).ncard + - (FootprintEdges B).ncard) → (((FootprintEdges BC).ncard + (FootprintEdges B ∩ - FootprintEdges C).ncard = (FootprintEdges B).ncard + (FootprintEdges C).ncard) → - (((FootprintEdges CA).ncard + (FootprintEdges C ∩ FootprintEdges A).ncard = - (FootprintEdges C).ncard + (FootprintEdges A).ncard) → (((FootprintVertices - ABC).ncard + (FootprintVertices A ∩ FootprintVertices C ∪ FootprintVertices B ∩ - FootprintVertices C).ncard = (FootprintVertices AB).ncard + (FootprintVertices - C).ncard) → (((FootprintEdges ABC).ncard + (FootprintEdges A ∩ FootprintEdges C ∪ - FootprintEdges B ∩ FootprintEdges C).ncard = (FootprintEdges AB).ncard + - (FootprintEdges C).ncard) → (((FootprintVertices A ∩ FootprintVertices C ∪ - FootprintVertices B ∩ FootprintVertices C).ncard + (FootprintVertices A ∩ - FootprintVertices B ∩ FootprintVertices C).ncard = (FootprintVertices A ∩ - FootprintVertices C).ncard + (FootprintVertices B ∩ FootprintVertices C).ncard) → - (((FootprintEdges A ∩ FootprintEdges C ∪ FootprintEdges B ∩ FootprintEdges C).ncard = - (FootprintEdges A ∩ FootprintEdges C).ncard + (FootprintEdges B ∩ FootprintEdges - C).ncard) → (((FootprintVertices A).ncard + Finset.card A.cells = (FootprintEdges - A).ncard + (1 : ℕ)) → (((FootprintVertices B).ncard + Finset.card B.cells = - (FootprintEdges B).ncard + (1 : ℕ)) → (((FootprintVertices C).ncard + Finset.card - C.cells = (FootprintEdges C).ncard + (1 : ℕ)) → (((FootprintVertices AB).ncard + - Finset.card AB.cells = (FootprintEdges AB).ncard + (1 : ℕ)) → (((FootprintVertices - BC).ncard + Finset.card BC.cells = (FootprintEdges BC).ncard + (1 : ℕ)) → - (((FootprintVertices CA).ncard + Finset.card CA.cells = (FootprintEdges CA).ncard + - (1 : ℕ)) → (((FootprintVertices ABC).ncard + Finset.card ABC.cells = (FootprintEdges - ABC).ncard + (1 : ℕ)) → ((FootprintVertices A ∩ FootprintVertices B ∩ - FootprintVertices C).ncard = 1))))))))))))))))))))) ) := by - classical - intro A B C AB BC CA ABC hcellsAB hcellsBC hcellsCA hcellsABC hIEvAB hIEvBC hIEvCA hIEeAB - hIEeBC hIEeCA hIEvABC hIEeABC hIEvCross hIEeCross hEulerA hEulerB hEulerC hEulerAB hEulerBC - hEulerCA hEulerABC - rw [Set.inter_comm (FootprintVertices C) (FootprintVertices A)] at hIEvCA - rw [Set.inter_comm (FootprintEdges C) (FootprintEdges A)] at hIEeCA - omega - private theorem htripleVfinite : (by classical @@ -864,9 +817,13 @@ theorem LatticeTileThreeDiskJunction have hEulerBC := LatticeTileGridEulerCount BC hBC have hEulerCA := LatticeTileGridEulerCount CA hCA have hEulerABC := LatticeTileGridEulerCount ABC hABC - have htripleVcard := ThreeDiskJunctionGeometry.htripleVcard A B C AB BC CA ABC hcellsAB - hcellsBC hcellsCA hcellsABC hIEvAB hIEvBC hIEvCA hIEeAB hIEeBC hIEeCA hIEvABC hIEeABC - hIEvCross hIEeCross hEulerA hEulerB hEulerC hEulerAB hEulerBC hEulerCA hEulerABC + have htripleVcard := (show + (FootprintVertices A ∩ FootprintVertices B ∩ FootprintVertices C).ncard = 1 + from by + classical + rw [Set.inter_comm (FootprintVertices C) (FootprintVertices A)] at hIEvCA + rw [Set.inter_comm (FootprintEdges C) (FootprintEdges A)] at hIEeCA + omega) have htripleVfinite := ThreeDiskJunctionGeometry.htripleVfinite A B C vertex_finite have htripleVnonempty := ThreeDiskJunctionGeometry.htripleVnonempty A B C htripleVcard obtain ⟨rho, hrho⟩ := htripleVnonempty diff --git a/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean index 4c9f90c2e9..28447ec9a3 100644 --- a/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/LeftLatticeAdjacentPackingSymmetryTransport.lean @@ -7,6 +7,8 @@ module public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance -- [TABLET NODE: LeftLatticeAdjacentPackingSymmetryTransport] diff --git a/LeanPool/ApollonianSuperharmonic/ListEndpointFacts.lean b/LeanPool/ApollonianSuperharmonic/ListEndpointFacts.lean index 49bccc472d..45e764a5d8 100644 --- a/LeanPool/ApollonianSuperharmonic/ListEndpointFacts.lean +++ b/LeanPool/ApollonianSuperharmonic/ListEndpointFacts.lean @@ -5,8 +5,13 @@ Authors: Wesley Pegden -/ module +public import Mathlib.Data.List.Basic +public import Mathlib.Data.List.Nodup +public import Mathlib.Data.Nat.Basic public import Mathlib.Init public import Mathlib.NumberTheory.Zsqrtd.GaussianInt +public import Mathlib.Tactic.TypeStar + /-! @@ -111,6 +116,28 @@ theorem getNotTake {α : Type*} (l : List α) (hn : l.Nodup) (m : Nat) have hidx := hn.getElem_inj_iff.mp heq' omega +/-- A specified last element belongs to its list. -/ +theorem lastMembership {α : Type*} (S : α) (forward : List α) + (hflast : forward.getLast? = some S) : S ∈ forward := by + classical + have hopt : S ∈ forward.getLast? := by simp [hflast] + obtain ⟨hne, hget⟩ := List.mem_getLast?_eq_getLast hopt + rw [hget] + exact List.getLast_mem hne + +/-- Split a list at any member. -/ +theorem splitMembership {α : Type*} (r : List α) (z : α) (hz : z ∈ r) : + ∃ l t, r = l ++ z :: t := by + classical + induction r with + | nil => simp at hz + | cons a r ih => + simp only [List.mem_cons] at hz + rcases hz with rfl | hz + · exact ⟨[], r, rfl⟩ + · rcases ih hz with ⟨l, t, ht⟩ + exact ⟨a :: l, t, by simp [ht, List.cons_append]⟩ + end ListEndpointFacts end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean index 5e1f9376be..0e49a0947d 100644 --- a/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean @@ -210,110 +210,6 @@ private theorem hnormalizedCentroid : hcentroidForward simpa [bundle.normalized_root_eq, bundle.normalized_fixed_eq] using hcentroidForward -private theorem hnormalizedSlopeX : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : - Fin (3 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ - : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), - let g := bundle.symmetry - let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j - ∀ (transportedRootSlope : ℝ × ℝ), ∀ (transportedFixedSlope : ℝ × ℝ), ∀ - (transportedRotation : Fin (4 : ℕ)), (transportedFixedSlope.1 - - transportedRootSlope.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt)) ^ (↑transportedRotation : ℕ) * (BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))).1) → - ((transportedRootSlope = bundle.normalizedRootSlope) → ((transportedFixedSlope = - bundle.normalizedFixedSlope) → (bundle.normalizedFixedSlope.1 - - bundle.normalizedRootSlope.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : - GaussianInt) ^ transportedRotation.val * (BandVectors.2 (normalizationPresentation - (sigma i).succ) (normalizationPresentation 0) + BandVectors.2 - (normalizationPresentation 0) (normalizationPresentation (sigma i).succ)))).1))) ) := by - classical - intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma transportedRootSlope - transportedFixedSlope transportedRotation hslopeXForward htransportRootSlopeEq - htransportFixedSlopeEq - simpa [htransportRootSlopeEq, htransportFixedSlopeEq] using hslopeXForward - -private theorem hnormalizedSlopeY : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : - Fin (3 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ - : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), - let g := bundle.symmetry - let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j - ∀ (transportedRootSlope : ℝ × ℝ), ∀ (transportedFixedSlope : ℝ × ℝ), ∀ - (transportedRotation : Fin (4 : ℕ)), (transportedFixedSlope.2 - - transportedRootSlope.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt)) ^ (↑transportedRotation : ℕ) * (BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g q ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) i).succ)))).2) → - ((transportedRootSlope = bundle.normalizedRootSlope) → ((transportedFixedSlope = - bundle.normalizedFixedSlope) → (bundle.normalizedFixedSlope.2 - - bundle.normalizedRootSlope.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-⟨0, 1⟩ : - GaussianInt) ^ transportedRotation.val * (BandVectors.2 (normalizationPresentation - (sigma i).succ) (normalizationPresentation 0) + BandVectors.2 - (normalizationPresentation 0) (normalizationPresentation (sigma i).succ)))).2))) ) := by - classical - intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma transportedRootSlope - transportedFixedSlope transportedRotation hslopeYForward htransportRootSlopeEq - htransportFixedSlopeEq - simpa [htransportRootSlopeEq, htransportFixedSlopeEq] using hslopeYForward - -private theorem hrowUR : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : - Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : - PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), - let g := bundle.symmetry - let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j - ∀ (delta : Bool), ∀ (transportedRotation : Fin (4 : ℕ)), (transportedRotation = if - BandPackingSymmetryReversesOrientation g = true then -s - (1 : Fin (4 : ℕ)) + if - delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else s + if delta = true - then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ))) → ( - let rowUR := TileTranslation bundle.normalizedRoot - ((⟨0, 1⟩ : GaussianInt) ^ transportedRotation.val * - (if Even transportedRotation.val then - BandVectors.1 (normalizationPresentation 0) (normalizationPresentation (sigma i).succ) - else BandVectors.1 (normalizationPresentation (sigma i).succ) (normalizationPresentation - 0))) - rowUR = TileTranslation (BandPackingSymmetryTileAction g T₀) ((⟨0, 1⟩ : GaussianInt) ^ - (if BandPackingSymmetryReversesOrientation g then -s - 1 + (if delta then (2 : Fin 4) - else 0) else s + (if delta then (2 : Fin 4) else 0)).val * (if Even (if - BandPackingSymmetryReversesOrientation g then -s - 1 + (if delta then (2 : Fin 4) - else 0) else s + (if delta then (2 : Fin 4) else 0)).val then BandVectors.1 - (BandPackingSymmetryQuadrupleAction g q 0) (BandPackingSymmetryQuadrupleAction g q - (sigma i).succ) else BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (sigma - i).succ) (BandPackingSymmetryQuadrupleAction g q 0)))) ) := by - classical - intro C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma delta - transportedRotation hrotationForward rowUR - dsimp [rowUR] - rw [bundle.normalized_root_eq, hrotationForward] - private theorem hmarkedOld : (by classical @@ -843,41 +739,6 @@ private theorem hinverseCircleFixed : rw [bundle.normalized_fixed_circle_eq] _ = Cᵢ.1.1 := hcircleL Cᵢ.1.1 -private theorem hnotOriginal : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : - Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : - PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), - let g := bundle.symmetry - let normalizationPresentation := BandPackingSymmetryQuadrupleAction g q - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j - ∀ (transportedRotation : Fin (4 : ℕ)), - let oldUR := TileTranslation T₀ - ((⟨0, 1⟩ : GaussianInt) ^ s.val * - (if Even s.val then BandVectors.1 (q 0) (q i.succ) - else BandVectors.1 (q i.succ) (q 0))) - let rowUR := TileTranslation bundle.normalizedRoot - ((⟨0, 1⟩ : GaussianInt) ^ transportedRotation.val * - (if Even transportedRotation.val then - BandVectors.1 (normalizationPresentation 0) (normalizationPresentation (sigma i).succ) - else BandVectors.1 (normalizationPresentation (sigma i).succ) (normalizationPresentation - 0))) - (x ∈ FootprintVertices oldUR ↔ bundle.normalizedPoint ∈ FootprintVertices rowUR) → - ((bundle.normalizedPoint ∉ FootprintVertices (TileTranslation bundle.normalizedRoot - ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑transportedRotation : ℕ) * if Even - (↑transportedRotation : ℕ) then BandVectors.1 (normalizationPresentation (0 : Fin (4 - : ℕ))) (normalizationPresentation (sigma i).succ) else BandVectors.1 - (normalizationPresentation (sigma i).succ) (normalizationPresentation (0 : Fin (4 : - ℕ)))))) → (x ∉ FootprintVertices oldUR)) ) := by - classical - intro C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x bundle g normalizationPresentation sigma transportedRotation - oldUR rowUR hmarkedOld hnotMarked hx - exact hnotMarked (hmarkedOld.mp hx) - private theorem hpFixedEq : (by classical @@ -2721,8 +2582,12 @@ private theorem leftAdjacencyCase : rcases hleft with ⟨hCfixed, hleftAdj, hnotMarked⟩ have hinverseCircleFixed := MarkedAdjacencyGeometry.hinverseCircleFixed C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle C' ginv hcircleL hinverseProper hinversePositive hinverseCircle hCfixed - have hnotOriginal := MarkedAdjacencyGeometry.hnotOriginal C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x bundle - transportedRotation hmarkedOld hnotMarked + have hnotOriginal := (show + x ∉ FootprintVertices oldUR + from by + classical + intro hx + exact hnotMarked (hmarkedOld.mp hx)) rcases hleftAdj with ⟨hOFixed, hOSelected, pFixed, pSelected, hslopeFixed, hslopeSelected, hleftGeometry⟩ have hpFixedEq := MarkedAdjacencyGeometry.hpFixedEq C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle pFixed @@ -3466,8 +3331,10 @@ theorem MarkedOdometerAdjacencyReduction : have hmarkedTransport := markedData.2.2 g q hq i s delta hphaseForward T₀ x have hmarkedOld := MarkedAdjacencyGeometry.hmarkedOld C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x bundle delta - transportedRotation hmarkedTransport (MarkedAdjacencyGeometry.hrowUR C₀ Cᵢ q i s T₀ Tᵢ h₀ - hᵢ x bundle delta transportedRotation hrotationForward) + transportedRotation hmarkedTransport ((by + classical + dsimp [rowUR] + rw [bundle.normalized_root_eq, hrotationForward])) have subtileGeometry := BandOrderedGeneralSubtileSelectedRowGeometry C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle subtilePlacement selectedEdge hxSelectedEdge hselectedEdge row (MarkedAdjacencyGeometry.hnormalizedOrbit C₀ Cᵢ T₀ Tᵢ h₀ @@ -3477,12 +3344,12 @@ theorem MarkedOdometerAdjacencyReduction : (MarkedAdjacencyGeometry.hrᵢ C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x hqᵢ bundle) (MarkedAdjacencyGeometry.hnormalizedCentroid C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle transportedRotation hcentroidForward) - (MarkedAdjacencyGeometry.hnormalizedSlopeX C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle - transportedRootSlope transportedFixedSlope transportedRotation hslopeXForward - htransportRootSlopeEq htransportFixedSlopeEq) - (MarkedAdjacencyGeometry.hnormalizedSlopeY C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x bundle - transportedRootSlope transportedFixedSlope transportedRotation hslopeYForward - htransportRootSlopeEq htransportFixedSlopeEq) + ((by + classical + simpa [htransportRootSlopeEq, htransportFixedSlopeEq] using hslopeXForward)) + ((by + classical + simpa [htransportRootSlopeEq, htransportFixedSlopeEq] using hslopeYForward)) dsimp at subtileGeometry rcases subtileGeometry with ⟨C', selectedSlope, hC', hsub', hslope', hxFixed', hxSelected', diff --git a/LeanPool/ApollonianSuperharmonic/ModifiedSubtileFacts.lean b/LeanPool/ApollonianSuperharmonic/ModifiedSubtileFacts.lean new file mode 100644 index 0000000000..85b3777aa2 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ModifiedSubtileFacts.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ModifiedSubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation +public import LeanPool.ApollonianSuperharmonic.TileCellComplementCovariance +public import Mathlib.Init + + +/-! +# ModifiedSubtileFacts + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace ModifiedSubtileFacts + +/-- The modified A occurrence is the translated cell complement. -/ +theorem modifiedA (P : Fin 3 → Bool → ProtoTile) (O : ProtoTile) (u v : GaussianInt) + (m n : Int) : + ModifiedSubtileOccurrenceInterpretation P O u v ⟨.A, m, n⟩ = + TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A, m, n⟩) + (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)) := by + change TileTranslation (TileCellComplement (P 0 true) O) + ((m : GaussianInt) * u + (n : GaussianInt) * v) = _ + rw [(TileCellComplementCovariance _ _ _).1] + rfl + +end ModifiedSubtileFacts +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/ObservableTileRetargeting.lean b/LeanPool/ApollonianSuperharmonic/ObservableTileRetargeting.lean new file mode 100644 index 0000000000..fb56db5a4f --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/ObservableTileRetargeting.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.ProtoTileObservableExtensionality +public import LeanPool.ApollonianSuperharmonic.TileTouching +public import LeanPool.ApollonianSuperharmonic.TouchingTriple +public import Mathlib.Init + + +/-! +# Observable tile retargeting + +Touching depends on cell sets and, for empty tiles, their anchors. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace ObservableTileRetargeting + +/-- Retarget a touching pair along equal observable tile data. -/ +theorem tile (A A' B B' : ProtoTile) (hAc : A.cells = A'.cells) + (hAa : A.cells = ∅ → A.anchor = A'.anchor) (hBc : B.cells = B'.cells) + (hBa : B.cells = ∅ → B.anchor = B'.anchor) (ht : TileTouching A B) : + TileTouching A' B' := by + classical + have hAo := ProtoTileObservableExtensionality A A' hAc hAa + have hBo := ProtoTileObservableExtensionality B B' hBc hBa + rcases ht with ht | ht | ht + · left + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa [hAc] using ht.1 + · simpa [hBc] using ht.2.1 + · simpa [hAc, hBc] using ht.2.2.1 + · simpa [hAo.2.1, hAo.2.2.1, hBo.2.1, hBo.2.2.1] using ht.2.2.2 + · right; left + refine ⟨?_, ?_⟩ + · simpa [hAc] using ht.1 + · rw [← hAa ht.1, ← hBo.2.1] + exact ht.2 + · right; right + refine ⟨?_, ?_⟩ + · simpa [hBc] using ht.1 + · rw [← hBa ht.1, ← hAo.2.1] + exact ht.2 + +/-- Retarget a touching triple along equal observable tile data. -/ +theorem triple (A A' B B' D D' : ProtoTile) (hAc : A.cells = A'.cells) + (hAa : A.cells = ∅ → A.anchor = A'.anchor) (hBc : B.cells = B'.cells) + (hBa : B.cells = ∅ → B.anchor = B'.anchor) (hDc : D.cells = D'.cells) + (hDa : D.cells = ∅ → D.anchor = D'.anchor) (ht : TouchingTriple A B D) : + TouchingTriple A' B' D' := by + classical + have hAo := ProtoTileObservableExtensionality A A' hAc hAa + have hBo := ProtoTileObservableExtensionality B B' hBc hBa + have hDo := ProtoTileObservableExtensionality D D' hDc hDa + rcases ht with ⟨hAB, hBD, hDA, p, hp, hpu⟩ + refine ⟨tile A A' B B' hAc hAa hBc hBa hAB, + tile B B' D D' hBc hBa hDc hDa hBD, + tile D D' A A' hDc hDa hAc hAa hDA, p, ?_, ?_⟩ + · simpa [← hAo.2.1, ← hBo.2.1, ← hDo.2.1] using hp + · intro y hy + apply hpu y + simpa [← hAo.2.1, ← hBo.2.1, ← hDo.2.1] using hy + +end ObservableTileRetargeting +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean index e4090751b6..bf3a404aa6 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean @@ -1170,58 +1170,6 @@ private theorem hgsHead : rw [List.head?_mapIdx, hhsHead] simp [transformAt, constAt, hplus] -private theorem hgsLast : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), - (∀ (i : Fin 3), - (∀ (tiles : List ProtoTile), - ∀ (hseed : PartialOdometer), - (∀ (centerShift : GaussianInt), - let d : GaussianInt := - -BandVectors.2 (q ((i + 1).succ)) (q i.succ); - let hminus := PartialOdometerAffineTranslate hseed 0 d 0; - (∀ (couter : GaussianInt), - ∀ (eouter : ℤ), - let a : GaussianInt := -couter; - let b : Int := -eouter; - let hplus := - PartialOdometerAffineTranslate - (PartialOdometerHalfTurn hminus) centerShift a 0; - ∀ (eback : ℤ), - let bplus : Int := -eback; - let hminusBack := - PartialOdometerAffineTranslate - (PartialOdometerHalfTurn hplus) centerShift a bplus; - (hminus = hminusBack) → - ((2 ≤ tiles.length) → - (∀ (hs : List PartialOdometer), - (hs.getLast? = some hplus) → - ((hs.length = tiles.length) → - (let constAt : Nat → Int := fun n => - if n = 0 then 0 - else if n + 1 = hs.length then bplus else b; - let transformAt : - Nat → PartialOdometer → PartialOdometer := - fun n h => - PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a - (constAt n); - let gs := hs.mapIdx transformAt; - gs.getLast? = some hminus))))))))) := by - classical - intro q i tiles hseed centerShift d hminus couter eouter a b hplus eback bplus hminusBack - hminusBackEq htilesLength hs hhsLast hlengthEq constAt transformAt gs - rw [List.getLast?_mapIdx, hhsLast] - have hlastIndex : hs.length - 1 + 1 = hs.length := by omega - have hlastNotZero : hs.length - 1 ≠ 0 := by omega - simp only [Option.map_some] - apply congrArg some - dsimp [transformAt, constAt] - rw [ite_eq_right hlastNotZero, ite_eq_left hlastIndex] - exact hminusBackEq.symm - private theorem forall2_dropLast : (by classical @@ -1623,34 +1571,6 @@ private theorem hreverseTilesNonempty : rw [h] at hreverseHead simp at hreverseHead -private theorem hgsNonempty : - (by - classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (i : Fin 3), ∀ (hseed : PartialOdometer), ∀ - (centerShift : GaussianInt), - let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) - let hminus := PartialOdometerAffineTranslate hseed 0 d 0 - ∀ (couter : GaussianInt), ∀ (eouter : ℤ), - let a : GaussianInt := -couter - let b : Int := -eouter - let hplus := PartialOdometerAffineTranslate - (PartialOdometerHalfTurn hminus) centerShift a 0 - ∀ (eback : ℤ), - let bplus : Int := -eback - ∀ (hs : List PartialOdometer), - let constAt : Nat → Int := fun n => - if n = 0 then 0 else if n + 1 = hs.length then bplus else b - let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => - PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) - let gs := hs.mapIdx transformAt - (gs.head? = some hplus) → (gs ≠ []) ) := by - classical - intro q i hseed centerShift d hminus couter eouter a b hplus eback bplus hs constAt transformAt - gs hgsHead h - rw [h] at hgsHead - simp at hgsHead - private theorem forall2_length : (by classical @@ -2004,8 +1924,18 @@ private theorem opposingBoundaryConclusion : transformForall htransform have hgsHead := OpposingBoundaryGeometry.hgsHead q i hseed centerShift couter eouter eback hs hhsHead - have hgsLast := OpposingBoundaryGeometry.hgsLast q i tiles hseed centerShift couter eouter - eback hminusBackEq htilesLength hs hhsLast hlengthEq + have hgsLast := (show + gs.getLast? = some hminus + from by + classical + rw [List.getLast?_mapIdx, hhsLast] + have hlastIndex : hs.length - 1 + 1 = hs.length := by omega + have hlastNotZero : hs.length - 1 ≠ 0 := by omega + simp only [Option.map_some] + apply congrArg some + dsimp [transformAt, constAt] + rw [ite_eq_right hlastNotZero, ite_eq_left hlastIndex] + exact hminusBackEq.symm) let cellRelation : ProtoTile → ProtoTile → Prop := fun T U => (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells have hinteriorCells := OpposingBoundaryGeometry.hinteriorCells tiles centerShift @@ -2052,8 +1982,10 @@ private theorem opposingBoundaryConclusion : have hreverseHead : reverseTiles.head? = some Rplus := hreverse.2.1 have hreverseTilesNonempty := OpposingBoundaryGeometry.hreverseTilesNonempty Rplus reverseTiles hreverseHead - have hgsNonempty := OpposingBoundaryGeometry.hgsNonempty q i hseed centerShift couter eouter - eback hs hgsHead + have hgsNonempty : gs ≠ [] := by + have hhead : gs.head? = some hplus := hgsHead + intro h + simp [h] at hhead have forall2_mem_right : ∀ {α β : Type} {r : α → β → Prop} {xs : List α} {ys : List β}, List.Forall₂ r xs ys → diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean index 94c46671a2..de0d51c712 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean @@ -391,25 +391,6 @@ private theorem invStep : dotProduct, Fin.sum_univ_two] at heq ⊢ linear_combination heq -private theorem hlenPre : - (by - classical - exact - (BandCircle) → (∀ (Ci : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ - (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (hs : List - PartialOdometer), ∀ (hplus : PartialOdometer), (OdometerStringRespect Ci orientation - base Rminus Rplus tiles hs) → ((GaussianInt) → ((GaussianInt) → ((List GaussianInt) → - ((PeriodicTileComplex ↥(TilingLattice Ci)) → (∀ (preTiles : List ProtoTile), (tiles = - preTiles ++ [Rplus]) → (∀ (preHs : List PartialOdometer), (hs = preHs ++ [hplus]) → - (preTiles.length = preHs.length)))))))) ) := by - classical - intro C0 Ci orientation base Rminus Rplus tiles hs hplus hRespect a b rest P preTiles hpreTiles - preHs hpreHs - have hlen := (List.Forall₂.length_eq hRespect.2.1) - rw [hpreTiles, hpreHs, List.length_append, List.length_singleton, - List.length_append, List.length_singleton] at hlen - omega - private theorem hzipLast : (by classical @@ -905,8 +886,14 @@ theorem OpposingBoundaryStarLocalization obtain ⟨preHs, hpreHs⟩ := List.getLast?_eq_some_iff.mp hlast have hzipLast : tiles.zip hs = preTiles.zip preHs ++ [(Rplus, hplus)] := OpposingStarGeometry.hzipLast Rplus tiles hs hplus preTiles hpreTiles preHs hpreHs - (OpposingStarGeometry.hlenPre C0 Ci orientation base Rminus Rplus tiles hs hplus - hRespect a b rest P preTiles hpreTiles preHs hpreHs) + ((show + preTiles.length = preHs.length + from by + classical + have hlen := (List.Forall₂.length_eq hRespect.2.1) + rw [hpreTiles, hpreHs, List.length_append, List.length_singleton, + List.length_append, List.length_singleton] at hlen + omega)) have hUzip' := OpposingStarGeometry.hUzip' Rplus tiles hs hplus U g hUzip preTiles preHs hzipLast obtain ⟨postTiles, hpostTiles⟩ := diff --git a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean index c26e451fa2..d9d8da6178 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.ListEndpointFacts public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandPrototileSingleton public import LeanPool.ApollonianSuperharmonic.SwappedAffineTriangularChartAlignment @@ -39,18 +40,8 @@ private theorem hRmem : rw [List.eq_cons_of_mem_head? hopt] simp -private theorem hSmem : - (by - classical - exact - ∀ (S : ProtoTile), ∀ (forward : List ProtoTile), (forward.getLast? = some S) → (S ∈ - forward) ) := by - classical - intro S forward hflast - have hopt : S ∈ forward.getLast? := by simp [hflast] - obtain ⟨hne, hget⟩ := List.mem_getLast?_eq_getLast hopt - rw [hget] - exact List.getLast_mem hne +private abbrev hSmem := + @ListEndpointFacts.lastMembership ProtoTile private theorem hrs : (by @@ -424,29 +415,8 @@ private theorem hEdgeA'At404 : (fun e : Finset GaussianInt => e.image q) hEdgeA simpa [unitAt, Finset.image_insert, q, qInv, hqInv'] using hmem -private theorem hEdgeB'At409 : - (by - classical - exact - ∀ (x : GaussianInt), - let x0 : GaussianInt := ⟨x.im, -x.re - 1⟩ - let unitAt : Int × Int → ProtoTile := fun z => - TileTranslation (⟨{x0}, x0⟩ : ProtoTile) - (⟨z.1, z.2⟩ : GaussianInt) - let turnedAt : Int × Int → ProtoTile := fun z => TileQuarterTurn (unitAt z) - let q := GaussianQuarterTurn - let qInv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ - (∀ (z : GaussianInt), q (qInv z) = z) → ((∀ (z : Int × Int), FootprintEdges (turnedAt z) - = (fun e : Finset GaussianInt => e.image q) '' FootprintEdges (unitAt z)) → (∀ (v : - GaussianInt), ∀ (w : GaussianInt), ∀ (b' : ℤ × ℤ), ({qInv v, qInv w} ∈ FootprintEdges - ((fun (z : ℤ × ℤ) => TileTranslation (⟨{x0}, x0⟩ : ProtoTile) (⟨z.1, z.2⟩ : - GaussianInt)) b')) → ({v, w} ∈ FootprintEdges (turnedAt b')))) ) := by - classical - intro x x0 unitAt turnedAt q qInv hqInv' hqedges v w b' hEdgeB - rw [hqedges] - have hmem := Set.mem_image_of_mem - (fun e : Finset GaussianInt => e.image q) hEdgeB - simpa [unitAt, Finset.image_insert, q, qInv, hqInv'] using hmem +private abbrev hEdgeB'At409 := + ApollonianSuperharmonic.OpposingInterfaceGeometry.hEdgeA'At404 private theorem incident : (by diff --git a/LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean b/LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean index bd4ff47c54..55590a2c54 100644 --- a/LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean @@ -315,30 +315,6 @@ private theorem hsmall : · rw [hempty]; exact Set.subsingleton_empty · exact hsmall -private theorem hsmallg : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ : PartialOdometer), - ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), ∀ (g : BandPackingSymmetry), ∀ (qbar : - Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration qbar), ∀ - (Cg : BandCircle), ∀ (Ig : BandCircle), ∀ (Dg : BandCircle), ∀ (cert : - BandOrderedGeneralLayoutCertificate qbar cfg Cg (BandPackingSymmetryTileAction g - T₀)), ∀ (a : PeriodicSubtileIndex), (P4261T1PlacedOdometer cert - (BandPackingSymmetryPartialOdometerAction g h₀) Ig (BandPackingSymmetryTileAction g - T) (BandPackingSymmetryPartialOdometerAction g h) a) → (∀ (b : PeriodicSubtileIndex), - (P4261T1PlacedOdometer cert (BandPackingSymmetryPartialOdometerAction g h₀) Dg - (BandPackingSymmetryTileAction g T') (BandPackingSymmetryPartialOdometerAction g h') - b) → ((((FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v a)) - ∩ FootprintVertices (SubtileOccurrenceInterpretation cert.P cert.u cert.v - b)).Subsingleton) → ((((BandPackingSymmetryPartialOdometerAction g h').domain : Set - GaussianInt) ∩ (BandPackingSymmetryPartialOdometerAction g h).domain).Subsingleton))) - ) := by - classical - intro T T₀ h h₀ T' h' g qbar cfg Cg Ig Dg cert a pa b pb hsmall - rw [pb.domain, pa.domain, Set.inter_comm] - exact hsmall - private theorem forward : (by classical @@ -521,8 +497,14 @@ theorem OrderedGeneralOdometerAdjacencyClassification : b)).Subsingleton := OdometerAdjacencyGeometry.hsmall T₀ g qbar cfg Cg cert a b hraw have hsmallg : (((BandPackingSymmetryPartialOdometerAction g h').domain : Set GaussianInt) ∩ (BandPackingSymmetryPartialOdometerAction g h).domain).Subsingleton := - OdometerAdjacencyGeometry.hsmallg T T₀ h h₀ T' h' g qbar cfg Cg Ig Dg cert a pa b - pb hsmall + (show + (((BandPackingSymmetryPartialOdometerAction g h').domain : + Set GaussianInt) ∩ (BandPackingSymmetryPartialOdometerAction + g h).domain).Subsingleton + from by + classical + rw [pb.domain, pa.domain, Set.inter_comm] + exact hsmall) left intro x hx y hy have forward (f : PartialOdometer) (z : GaussianInt) (hz : z ∈ f.domain) : diff --git a/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean b/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean index 11335d8fea..cee8288ba1 100644 --- a/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean @@ -406,48 +406,8 @@ private theorem base : hX hY hZ (hT2 0 X hX) (hT2 i.succ Y hY) (hT2 (i + 1).succ Z hZ) (fun A B C hA hB hC ha' hb' => hT5 A B C i hA hB hC ha' hb') ha hb -private theorem base3 : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (∀ (a : Fin (4 : ℕ)), ∀ (T : ProtoTile), - BandPrototile (q a) T → QuarterTurnSymmetric T) → ((∀ (T₀ : ProtoTile), ∀ (Tᵢ : - ProtoTile), ∀ (Tⱼ : ProtoTile), ∀ (i : Fin (3 : ℕ)), BandPrototile (q (0 : Fin (4 : - ℕ))) T₀ → BandPrototile (q i.succ) Tᵢ → BandPrototile (q (i + (1 : Fin (3 : - ℕ))).succ) Tⱼ → TileCentroid Tᵢ - TileCentroid T₀ = (1 / 2 : ℝ) • (GaussianRealPoint - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 - (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid Tⱼ - TileCentroid T₀ = (1 / 2 : ℝ) - • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : - ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (i + (1 : Fin (3 : - ℕ))).succ))) → TouchingTriple T₀ Tᵢ Tⱼ) → ((∀ (C : CircleCoordinates), ∀ (D : - CircleCoordinates), ∀ (E : CircleCoordinates), ∀ (T : ProtoTile), ∀ (U : ProtoTile), - ∀ (V : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), ∀ - (w : GaussianInt), BandPrototile C T → BandPrototile D U → BandPrototile E V → - QuarterTurnSymmetric T → QuarterTurnSymmetric U → QuarterTurnSymmetric V → (∀ (X : - ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), BandPrototile C X → BandPrototile D - Y → BandPrototile E Z → TileCentroid Y - TileCentroid X = (1 / 2 : Real) • - (GaussianRealPoint x + GaussianRealPoint y) → TileCentroid Z - TileCentroid X = (1 / - 2 : Real) • (GaussianRealPoint z - GaussianRealPoint w) → TouchingTriple X Y Z) → - TileCentroid U - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint - (GaussianQuarterTurn x) + GaussianRealPoint (GaussianQuarterTurn y)) → TileCentroid V - - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint (GaussianQuarterTurn z) - - GaussianRealPoint (GaussianQuarterTurn w)) → TouchingTriple T U V) → (∀ (i : Fin (3 : - ℕ)), ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), BandPrototile (q 0) X → - BandPrototile (q i.succ) Y → BandPrototile (q ((i + 1).succ)) Z → TileCentroid Y - - TileCentroid X = (1 / 2 : Real) • (GaussianRealPoint (GaussianQuarterTurn - (BandVectors.1 (q i.succ) (q 0))) + GaussianRealPoint (GaussianQuarterTurn - (BandVectors.1 (q 0) (q i.succ)))) → TileCentroid Z - TileCentroid X = (1 / 2 : Real) - • (GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q ((i + 1).succ)) (q 0))) - - GaussianRealPoint (GaussianQuarterTurn (BandVectors.1 (q 0) (q ((i + 1).succ))))) → - TouchingTriple X Y Z))) - ) := by - classical - intro q hT2 hT5 turn5 i X Y Z hX hY hZ ha hb - exact turn5 (q 0) (q i.succ) (q ((i + 1).succ)) X Y Z - (BandVectors.1 (q i.succ) (q 0)) (BandVectors.1 (q 0) (q i.succ)) - (BandVectors.1 (q ((i + 1).succ)) (q 0)) (BandVectors.1 (q 0) (q ((i + 1).succ))) - hX hY hZ (hT2 0 X hX) (hT2 i.succ Y hY) (hT2 (i + 1).succ Z hZ) - (fun A B C hA hB hC ha' hb' => hT5 A B C i hA hB hC ha' hb') ha hb +private abbrev base3 := + ApollonianSuperharmonic.TouchingCovarianceProof.base private theorem firstAt570 : (by diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean index f7d2aab244..aa5b63b5aa 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean @@ -309,45 +309,8 @@ private theorem hx_i_endAt391 : _ = tgt (s.edge i) bi := by rw [hc, hb1] _ = Q (i + 1) := hqi.symm -private theorem hx_j_endAt415 : - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary - n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real - × Real)), ∀ (t : P3475T1TriangleTree q X K), - let Q := P3523T1InterpolatedTarget s t - let tgt (e : Fin (r + 3)) (u : Real) := - (1 - u) • t.target e + u • t.target (e + 1) - (∀ (e : Fin (r + 3)), Function.Injective (tgt e)) → (∀ (j : Fin (n + (3 : ℕ))), ∀ (x : ℝ × - ℝ), ∀ (bj : ℝ), (s.parameter j ≤ bj) → ((bj ≤ (1 : ℝ)) → ((Q (j + (1 : Fin (n + (3 : - ℕ)))) = tgt (s.edge j) bj) → (∀ (φ : ℝ), (φ ∈ Set.Icc (0 : ℝ) (1 : ℝ)) → ( - let cj := s.parameter j + φ * (bj - s.parameter j) - (Q j = tgt (s.edge j) (s.parameter j)) → ((x = tgt (s.edge j) cj) → ((x = t.target (s.edge j) - ∨ x = t.target (s.edge j + (1 : Fin (r + (3 : ℕ))))) → (x = Q j ∨ x = Q (j + 1))))))))) - := by - classical - intro r n q p s X K t Q tgt hcoarse_inj_tgt j x bj haj hbj hqj φ hφ cj hqj0 hx_j' hj_end - rcases hj_end with hj_end | hj_end - · have hc : cj = 0 := hcoarse_inj_tgt (s.edge j) (by - calc tgt (s.edge j) cj = x := hx_j'.symm - _ = t.target (s.edge j) := hj_end - _ = tgt (s.edge j) 0 := by simp [tgt]) - have ha0 : s.parameter j = 0 := by - dsimp [cj] at hc - nlinarith [s.parameter_nonneg j, hφ.1, hφ.2, haj] - left - calc x = tgt (s.edge j) cj := hx_j' - _ = tgt (s.edge j) (s.parameter j) := by rw [hc, ha0] - _ = Q j := hqj0.symm - · have hc : cj = 1 := hcoarse_inj_tgt (s.edge j) (by - calc tgt (s.edge j) cj = x := hx_j'.symm - _ = t.target (s.edge j + 1) := hj_end - _ = tgt (s.edge j) 1 := by simp [tgt]) - have hb1 : bj = 1 := by - dsimp [cj] at hc - nlinarith [haj, hbj, hφ.1, hφ.2] - right - calc x = tgt (s.edge j) cj := hx_j' - _ = tgt (s.edge j) bj := by rw [hc, hb1] - _ = Q (j + 1) := hqj.symm +private abbrev hx_j_endAt415 := + ApollonianSuperharmonic.TargetBoundaryProof.hx_i_endAt391 private theorem hfine_subset : ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean index e9d30044ba..d41168d5cb 100644 --- a/LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean @@ -427,25 +427,8 @@ private theorem hβc : field_simp [hDneq] ring -private theorem hγc : - (by - classical - exact - ∀ (p : P3381T1PolygonBoundary 0), - let a : Real × Real := p.vertex 0 - let b : Real × Real := p.vertex 1 - let c : Real × Real := p.vertex 2 - let D : Real := (b - a).1 * (c - a).2 - (c - a).1 * (b - a).2 - (D ≠ 0) → ( - let gamma : (Real × Real) → Real := fun x => - ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D - gamma c = 1) ) := by - classical - intro p a b c D hDneq gamma - dsimp [gamma] - field_simp [hDneq] - simp [D] - ring +private abbrev hγc := + ApollonianSuperharmonic.TriangleRayIntersections.hβb private theorem hSconv : (by diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean index 393da68fea..72d091e13b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean @@ -164,37 +164,6 @@ private theorem hBNodup : have hxa : x = a := hxy.trans hy exact haNotV (hxa ▸ hx)⟩ -private theorem hsets : - ∀ (n : Nat), - (∀ (a : Fin (n + 3)), - ∀ (b : Fin (n + 3)), - ∀ (u : List (Fin (n + 3))), - ∀ (v : List (Fin (n + 3))), - (∃ k : Nat, - (a :: (u ++ b :: v)).Sublist - ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) → - (let A := a :: (u ++ [b]); - let B := b :: (v ++ [a]); - ((u ++ b :: v).Nodup) → - ((a ≠ b) → - ((u.Nodup ∧ (b :: v).Nodup ∧ ∀ a ∈ u, ∀ b_1 ∈ b :: v, a ≠ b_1) → - ((u.Nodup) → - ((b ∉ u) → - ((v.Nodup) → - ((b ∉ v) → - ((a ∉ u) → - ((a ∉ v) → - ((∀ i, i ∈ u → i ∈ v → False) → - ((A.Nodup) → - ((B.Nodup) → - ({i | i ∈ A} ∩ {i | i ∈ B} = - {a, b})))))))))))))) := by - classical - intro n a b u v hcyclic A B htailNodup hne hparts huNodup hbNotU hvNodup hbNotV haNotU haNotV - huvDisjoint hANodup hBNodup - ext i - simp [A, B, List.mem_cons, List.mem_append]; aesop - private theorem hnil : ∀ (n : Nat), ∀ (xs : List (Fin (n + 3))), ([] : List (Fin (n + 3))).Sublist xs := by classical @@ -1760,9 +1729,12 @@ theorem P3555T2ParabolaChordCuts {n : Nat} have huvDisjoint : ∀ i, i ∈ u → i ∈ v → False := ParabolaChordLemmas.huvDisjoint n b u v hparts have hANodup : A.Nodup := ParabolaChordLemmas.hANodup n a b u hne huNodup hbNotU haNotU have hBNodup : B.Nodup := ParabolaChordLemmas.hBNodup n a b v hne hvNodup hbNotV haNotV - have hsets : {i | i ∈ A} ∩ {i | i ∈ B} = {a, b} := ParabolaChordLemmas.hsets n a b u v - hcyclic htailNodup hne hparts huNodup hbNotU hvNodup hbNotV haNotU haNotV huvDisjoint - hANodup hBNodup + have hsets : {i | i ∈ A} ∩ {i | i ∈ B} = {a, b} := (show + {i | i ∈ A} ∩ {i | i ∈ B} = {a, b} + from by + classical + ext i + simp [A, B, List.mem_cons, List.mem_append]; aesop) have hnil (xs : List (Fin (n + 3))) : ([] : List (Fin (n + 3))).Sublist xs := ParabolaChordLemmas.hnil n xs have hnilv := ParabolaChordLemmas.hnilv n v hnil diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean b/LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean index 3f1cd266fc..f2e5b899e6 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean @@ -795,91 +795,6 @@ private theorem hxGall : intro n p x d g G hGmem Gall exact Set.mem_iInter.mpr hGmem -private theorem hNopen : - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), - let a := p.vertex i - let b := p.vertex (i + 1) - ∀ (d : ℝ × ℝ), - let D : Fin (n + 3) → Real := fun j => - d.1 * (p.vertex (j + 1) - p.vertex j).2 - - d.2 * (p.vertex (j + 1) - p.vertex j).1 - let T : Fin (n + 3) → (Real × Real) → Real := fun j y => - (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - - (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) - let U : Fin (n + 3) → (Real × Real) → Real := fun j y => - (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) - let V : Fin (n + 3) → Set (Real × Real) := fun j => - if j = i then {y | 0 < U j y ∧ U j y < 1} - else if U j x < 0 then {y | U j y < 0} - else if 1 < U j x then {y | 1 < U j y} - else if 0 < T j x then {y | 0 < T j y ∧ 0 < U j y ∧ U j y < 1} - else {y | T j y < 0 ∧ 0 < U j y ∧ U j y < 1} - let Vall : Set (Real × Real) := ⋂ j, V j - (IsOpen Vall) → ( - let W : Fin (n + 3) → Set (Real × Real) := fun j => - if j = i then Set.univ else (segment Real (p.vertex j) (p.vertex (j + 1)))ᶜ - let Wall : Set (Real × Real) := ⋂ j, W j - (IsOpen Wall) → ( - let Q : (Real × Real) → Real := fun y => - if b.1 - a.1 = 0 then (y.2 - a.2) / (b.2 - a.2) - else (y.1 - a.1) / (b.1 - a.1) - let Qline : Set (Real × Real) := {y | 0 < Q y ∧ Q y < 1} - (IsOpen Qline) → ( - let g : Fin (n + 3) → (Real × Real) → Real := fun j y => - d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 - let G : Fin (n + 3) → Set (Real × Real) := fun j => - {y | g j y < 0} ∪ {y | 0 < g j y} - let Gall : Set (Real × Real) := ⋂ j, G j - (IsOpen Gall) → ( - let N : Set (Real × Real) := Vall ∩ (Wall ∩ (Qline ∩ Gall)) - IsOpen N)))) := by - classical - intro n p i x a b d D T U V Vall hVallopen W Wall hWallopen Q Qline hQlineopen g G Gall - hGallopen N - exact hVallopen.inter (hWallopen.inter (hQlineopen.inter hGallopen)) - -private theorem hxN : - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), - let a := p.vertex i - let b := p.vertex (i + 1) - ∀ (d : ℝ × ℝ), - let D : Fin (n + 3) → Real := fun j => - d.1 * (p.vertex (j + 1) - p.vertex j).2 - - d.2 * (p.vertex (j + 1) - p.vertex j).1 - let T : Fin (n + 3) → (Real × Real) → Real := fun j y => - (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - - (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) - let U : Fin (n + 3) → (Real × Real) → Real := fun j y => - (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) - let V : Fin (n + 3) → Set (Real × Real) := fun j => - if j = i then {y | 0 < U j y ∧ U j y < 1} - else if U j x < 0 then {y | U j y < 0} - else if 1 < U j x then {y | 1 < U j y} - else if 0 < T j x then {y | 0 < T j y ∧ 0 < U j y ∧ U j y < 1} - else {y | T j y < 0 ∧ 0 < U j y ∧ U j y < 1} - let Vall : Set (Real × Real) := ⋂ j, V j - (x ∈ Vall) → ( - let W : Fin (n + 3) → Set (Real × Real) := fun j => - if j = i then Set.univ else (segment Real (p.vertex j) (p.vertex (j + 1)))ᶜ - let Wall : Set (Real × Real) := ⋂ j, W j - (x ∈ Wall) → ( - let Q : (Real × Real) → Real := fun y => - if b.1 - a.1 = 0 then (y.2 - a.2) / (b.2 - a.2) - else (y.1 - a.1) / (b.1 - a.1) - let Qline : Set (Real × Real) := {y | 0 < Q y ∧ Q y < 1} - (x ∈ Qline) → ( - let g : Fin (n + 3) → (Real × Real) → Real := fun j y => - d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 - let G : Fin (n + 3) → Set (Real × Real) := fun j => - {y | g j y < 0} ∪ {y | 0 < g j y} - let Gall : Set (Real × Real) := ⋂ j, G j - (x ∈ Gall) → ( - let N : Set (Real × Real) := Vall ∩ (Wall ∩ (Qline ∩ Gall)) - x ∈ N)))) := by - classical - intro n p i x a b d D T U V Vall hxVall W Wall hxWall Q Qline hxQline g G Gall hxGall N - exact ⟨hxVall, ⟨hxWall, ⟨hxQline, hxGall⟩⟩⟩ - private theorem hcarrier : ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), let a := p.vertex i @@ -948,51 +863,6 @@ private theorem hcarrier : _ = y := hline'.symm exact Set.mem_iUnion.mpr ⟨i, hyseg⟩ -private theorem hgenericY : - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), ∀ (x : Real × Real), - let a := p.vertex i - let b := p.vertex (i + 1) - ∀ (d : ℝ × ℝ), - let D : Fin (n + 3) → Real := fun j => - d.1 * (p.vertex (j + 1) - p.vertex j).2 - - d.2 * (p.vertex (j + 1) - p.vertex j).1 - let T : Fin (n + 3) → (Real × Real) → Real := fun j y => - (((p.vertex j - y).1 * (p.vertex (j + 1) - p.vertex j).2 - - (p.vertex j - y).2 * (p.vertex (j + 1) - p.vertex j).1) / D j) - let U : Fin (n + 3) → (Real × Real) → Real := fun j y => - (((p.vertex j - y).1 * d.2 - (p.vertex j - y).2 * d.1) / D j) - let V : Fin (n + 3) → Set (Real × Real) := fun j => - if j = i then {y | 0 < U j y ∧ U j y < 1} - else if U j x < 0 then {y | U j y < 0} - else if 1 < U j x then {y | 1 < U j y} - else if 0 < T j x then {y | 0 < T j y ∧ 0 < U j y ∧ U j y < 1} - else {y | T j y < 0 ∧ 0 < U j y ∧ U j y < 1} - let Vall : Set (Real × Real) := ⋂ j, V j - let W : Fin (n + 3) → Set (Real × Real) := fun j => - if j = i then Set.univ else (segment Real (p.vertex j) (p.vertex (j + 1)))ᶜ - let Wall : Set (Real × Real) := ⋂ j, W j - let Q : (Real × Real) → Real := fun y => - if b.1 - a.1 = 0 then (y.2 - a.2) / (b.2 - a.2) - else (y.1 - a.1) / (b.1 - a.1) - let Qline : Set (Real × Real) := {y | 0 < Q y ∧ Q y < 1} - let g : Fin (n + 3) → (Real × Real) → Real := fun j y => - d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 - let G : Fin (n + 3) → Set (Real × Real) := fun j => - {y | g j y < 0} ∪ {y | 0 < g j y} - let Gall : Set (Real × Real) := ⋂ j, G j - let N : Set (Real × Real) := Vall ∩ (Wall ∩ (Qline ∩ Gall)) - ∀ (rN : ℝ), (Metric.ball x rN ⊆ N) → (∀ (y : Real × Real), (y ∈ Metric.ball x rN) → (∀ j, d.1 - * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 ≠ 0)) := by - classical - intro n p i x a b d D T U V Vall W Wall Q Qline g G Gall N rN hballN y hy - have hyGall : y ∈ Gall := (hballN hy).2.2.2 - intro j - have hGj := Set.mem_iInter.mp hyGall j - have hg : g j y < 0 ∨ 0 < g j y := by simpa [G] using hGj - rcases hg with h | h - · simpa [g] using (ne_of_lt h) - · simpa [g] using (ne_of_gt h) - private theorem hparity : ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (d : ℝ × ℝ), (∀ (i : Fin (n + (3 : ℕ))), d.1 * (p.vertex (i + (1 : Fin (n + (3 : ℕ)))) - p.vertex i).2 - d.2 * (p.vertex (i + (1 : @@ -1827,16 +1697,24 @@ theorem P3597T1SideCrossing {n : Nat} (p : P3381T1PolygonBoundary n) have hGallopen : IsOpen Gall := SideCrossingProof.hGallopen n p d hGopen have hxGall : x ∈ Gall := SideCrossingProof.hxGall n p x d hGmem let N : Set (Real × Real) := Vall ∩ (Wall ∩ (Qline ∩ Gall)) - have hNopen : IsOpen N := SideCrossingProof.hNopen n p i x d hVallopen hWallopen hQlineopen - hGallopen - have hxN : x ∈ N := SideCrossingProof.hxN n p i x d hxVall hxWall hxQline hxGall + have hNopen : IsOpen N := hVallopen.inter (hWallopen.inter (hQlineopen.inter hGallopen)) + have hxN : x ∈ N := ⟨hxVall, ⟨hxWall, ⟨hxQline, hxGall⟩⟩⟩ obtain ⟨rN, hrN, hballN⟩ := Metric.isOpen_iff.mp hNopen x hxN have hcarrier (y : Real × Real) (hy : y ∈ Metric.ball x rN) : y ∈ P3544T1BoundaryCarrier p ↔ F y = 0 := SideCrossingProof.hcarrier n p i x d hsegF hQline rN hballN y hy have hgenericY (y : Real × Real) (hy : y ∈ Metric.ball x rN) : - ∀ j, d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 ≠ 0 := SideCrossingProof.hgenericY - n p i x d rN hballN y hy + ∀ j, d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 ≠ 0 := (show + ∀ j, d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 ≠ 0 + from by + classical + have hyGall : y ∈ Gall := (hballN hy).2.2.2 + intro j + have hGj := Set.mem_iInter.mp hyGall j + have hg : g j y < 0 ∨ 0 < g j y := by simpa [G] using hGj + rcases hg with h | h + · simpa [g] using (ne_of_lt h) + · simpa [g] using (ne_of_gt h)) have hparity (y : Real × Real) (hyC : y ∉ P3544T1BoundaryCarrier p) (hgv : ∀ j, d.1 * (p.vertex j - y).2 - d.2 * (p.vertex j - y).1 ≠ 0) : (y ∈ P3544T1RayParity p ↔ diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean index b94ac6b13d..ced476ebdc 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean @@ -1600,35 +1600,6 @@ private theorem hNoff : · exact (ne_of_lt hx.2.2) (by simpa [V, hp] using hu0) · exact (ne_of_gt hx.2.1) (by simpa [U, hp] using hw0) -private theorem hWoff : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - ∀ (b : Fin (n + (3 : ℕ))), - let B := v b - let a := v (b - 1) - let c := v (b + 1) - let u : Real × Real := a - B - let w : Real × Real := c - B - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - let C := P3544T1BoundaryCarrier p - ∀ (rK : ℝ), - let r := min rK (min (dist B a / 2) (dist B c / 2)) - let U := if 0 < cross u w then u else w - let V := if 0 < cross u w then w else u - let W : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ - (cross U (x - B) < 0 ∨ 0 < cross V (x - B))} - (∀ x, x ∈ Metric.ball B r → x ∈ C → 0 ≤ cross U (x-B) ∧ cross V (x-B) ≤ 0) → (∀ x, x ∈ W - → x ∉ C) ) := by - classical - intro n p v b B a c u w cross C rK r U V W hcarrierSigns x hx hc - have hs := hcarrierSigns x hx.1 hc - rcases hx.2 with hn | hp - · exact (not_lt_of_ge hs.1) hn - · exact (not_lt_of_ge hs.2) hp - private theorem hcover : (by classical @@ -1820,37 +1791,6 @@ private theorem hyheight : rw [hval] linarith -private theorem hynotC : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => - ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) - ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), - let q := Classical.choose hqexists - ∀ (b : Fin (n + (3 : ℕ))), - let c := v (b + 1) - let B := v b - let e : Real × Real := (1, 0) - ∀ (ε : ℝ), - let y : Real × Real := B + ε • e - let ell : (Real × Real) →ₗ[Real] Real := - { toFun := fun x => x.1 + q * x.2 - map_add' := by intro x y; simp; ring - map_smul' := by intro c x; simp; ring } - let a := v (b - 1) - let C := P3544T1BoundaryCarrier p - ∀ (rK : ℝ), - let r := min rK (min (dist B a / 2) (dist B c / 2)) - (∀ x : Real × Real, x ∈ Metric.ball B r → x ∈ C → ell x ≤ ell B) → ((y ∈ Metric.ball B r) - → ((ell B < ell y) → (y ∉ C))) ) := by - classical - intro n p v f hqexists q b c B e ε y ell a C rK r hellCarrier hyball hyheight hyC - have hle := hellCarrier y hyball hyC - exact (not_lt_of_ge hle) hyheight - private theorem hYclass : (by classical @@ -2317,148 +2257,6 @@ private theorem htranslateS : rw [Metric.mem_ball, he] exact hz -private theorem hymS : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - ∀ (b : Fin (n + (3 : ℕ))), - let B := v b - let a := v (b - 1) - let c := v (b + 1) - let u : Real × Real := a - B - let w : Real × Real := c - B - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - ∀ (rK : ℝ), - let r := min rK (min (dist B a / 2) (dist B c / 2)) - let σ := min (1 / 2) (r / (4 * (dist B a + 1))) - let x0 := B + σ • u - ∀ (rS : ℝ), - let S := Metric.ball x0 rS ∩ Metric.ball B r - ∀ (δ : ℝ), (Metric.ball x0 δ ⊆ S) → ( - let qside : Real × Real := if 0 < cross u w then w else -w - ∀ (η : ℝ), (-(η • qside) ∈ Metric.ball (0 : Real × Real) δ) → ((∀ z : Real × Real, z ∈ - Metric.ball (0 : Real × Real) δ → x0 + z ∈ Metric.ball x0 δ) → ( - let ym := x0 - η • qside - ym ∈ S))) ) := by - classical - intro n p v b B a c u w cross rK r σ x0 rS S δ hballS qside η hηballNeg htranslateS ym - have hh := htranslateS (-(η • qside)) hηballNeg - simpa [ym, sub_eq_add_neg] using hballS hh - -private theorem hcrossUplus : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - ∀ (b : Fin (n + (3 : ℕ))), - let B := v b - let a := v (b - 1) - let c := v (b + 1) - let u : Real × Real := a - B - let w : Real × Real := c - B - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - ∀ (rK : ℝ), - let r := min rK (min (dist B a / 2) (dist B c / 2)) - (∀ z : Real × Real, IsLinearMap Real (cross z)) → ((∀ z : Real × Real, cross z z = 0) → ( - let σ := min (1 / 2) (r / (4 * (dist B a + 1))) - let x0 := B + σ • u - let qside : Real × Real := if 0 < cross u w then w else -w - ∀ (η : ℝ), - let yp := x0 + η • qside - (yp - B = σ • u + η • qside) → (cross u (yp-B) = η * cross u qside))) ) := by - classical - intro n p v b B a c u w cross rK r hcrossLinear hcrossSelf σ x0 qside η yp hyplus - rw [hyplus, (hcrossLinear u).map_add, (hcrossLinear u).map_smul, - (hcrossLinear u).map_smul, hcrossSelf] - simp only [smul_eq_mul, mul_zero, zero_add] - -private theorem hcrossUminus : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - ∀ (b : Fin (n + (3 : ℕ))), - let B := v b - let a := v (b - 1) - let c := v (b + 1) - let u : Real × Real := a - B - let w : Real × Real := c - B - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - ∀ (rK : ℝ), - let r := min rK (min (dist B a / 2) (dist B c / 2)) - (∀ z : Real × Real, IsLinearMap Real (cross z)) → ((∀ z : Real × Real, cross z z = 0) → ( - let σ := min (1 / 2) (r / (4 * (dist B a + 1))) - let x0 := B + σ • u - let qside : Real × Real := if 0 < cross u w then w else -w - ∀ (η : ℝ), - let ym := x0 - η • qside - (ym - B = σ • u - η • qside) → (cross u (ym-B) = -(η * cross u qside)))) ) := by - classical - intro n p v b B a c u w cross rK r hcrossLinear hcrossSelf σ x0 qside η ym hyminus - rw [hyminus, (hcrossLinear u).map_sub, (hcrossLinear u).map_smul, - (hcrossLinear u).map_smul, hcrossSelf] - simp only [smul_eq_mul, mul_zero, zero_sub] - -private theorem hcrossWplus : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - ∀ (b : Fin (n + (3 : ℕ))), - let B := v b - let a := v (b - 1) - let c := v (b + 1) - let u : Real × Real := a - B - let w : Real × Real := c - B - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - ∀ (rK : ℝ), - let r := min rK (min (dist B a / 2) (dist B c / 2)) - (∀ z : Real × Real, IsLinearMap Real (cross z)) → ( - let σ := min (1 / 2) (r / (4 * (dist B a + 1))) - let x0 := B + σ • u - let qside : Real × Real := if 0 < cross u w then w else -w - (cross w qside = 0) → (∀ (η : ℝ), - let yp := x0 + η • qside - (yp - B = σ • u + η • qside) → (cross w (yp-B) = σ * cross w u))) ) := by - classical - intro n p v b B a c u w cross rK r hcrossLinear σ x0 qside hcrossWq η yp hyplus - rw [hyplus, (hcrossLinear w).map_add, (hcrossLinear w).map_smul, - (hcrossLinear w).map_smul, hcrossWq] - simp only [smul_eq_mul, mul_zero, add_zero] - -private theorem hcrossWminus : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - ∀ (b : Fin (n + (3 : ℕ))), - let B := v b - let a := v (b - 1) - let c := v (b + 1) - let u : Real × Real := a - B - let w : Real × Real := c - B - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - ∀ (rK : ℝ), - let r := min rK (min (dist B a / 2) (dist B c / 2)) - (∀ z : Real × Real, IsLinearMap Real (cross z)) → ( - let σ := min (1 / 2) (r / (4 * (dist B a + 1))) - let x0 := B + σ • u - let qside : Real × Real := if 0 < cross u w then w else -w - (cross w qside = 0) → (∀ (η : ℝ), - let ym := x0 - η • qside - (ym - B = σ • u - η • qside) → (cross w (ym-B) = σ * cross w u))) ) := by - classical - intro n p v b B a c u w cross rK r hcrossLinear σ x0 qside hcrossWq η ym hyminus - rw [hyminus, (hcrossLinear w).map_sub, (hcrossLinear w).map_smul, - (hcrossLinear w).map_smul, hcrossWq] - simp only [smul_eq_mul, mul_zero, sub_zero] - private theorem hdetSide : (by classical @@ -2476,61 +2274,6 @@ private theorem hdetSide : simp [P3381T1TriangleDeterminant, cross, u, a, B] ring -private theorem hdetPlus : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - ∀ (b : Fin (n + (3 : ℕ))), - let B := v b - let a := v (b - 1) - let c := v (b + 1) - let u : Real × Real := a - B - let w : Real × Real := c - B - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - ∀ (rK : ℝ), - let r := min rK (min (dist B a / 2) (dist B c / 2)) - let σ := min (1 / 2) (r / (4 * (dist B a + 1))) - let x0 := B + σ • u - let qside : Real × Real := if 0 < cross u w then w else -w - (0 < cross u qside) → (∀ (η : ℝ), ((0 : ℝ) < η) → ( - let yp := x0 + η • qside - (cross u (yp-B) = η * cross u qside) → ((∀ z : Real × Real, P3381T1TriangleDeterminant - ![a, B, z] = -cross u (z-B)) → (P3381T1TriangleDeterminant ![a, B, yp] < 0)))) ) := by - classical - intro n p v b B a c u w cross rK r σ x0 qside hcrossUq η hη yp hcrossUplus hdetSide - rw [hdetSide, hcrossUplus] - exact neg_neg_of_pos (mul_pos hη hcrossUq) - -private theorem hdetMinus : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - ∀ (b : Fin (n + (3 : ℕ))), - let B := v b - let a := v (b - 1) - let c := v (b + 1) - let u : Real × Real := a - B - let w : Real × Real := c - B - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - ∀ (rK : ℝ), - let r := min rK (min (dist B a / 2) (dist B c / 2)) - let σ := min (1 / 2) (r / (4 * (dist B a + 1))) - let x0 := B + σ • u - let qside : Real × Real := if 0 < cross u w then w else -w - (0 < cross u qside) → (∀ (η : ℝ), ((0 : ℝ) < η) → ( - let ym := x0 - η • qside - (cross u (ym-B) = -(η * cross u qside)) → ((∀ z : Real × Real, - P3381T1TriangleDeterminant ![a, B, z] = -cross u (z-B)) → (0 < - P3381T1TriangleDeterminant ![a, B, ym])))) ) := by - classical - intro n p v b B a c u w cross rK r σ x0 qside hcrossUq η hη ym hcrossUminus hdetSide - rw [hdetSide, hcrossUminus] - exact neg_pos.mpr (neg_neg_of_pos (mul_pos hη hcrossUq)) - private theorem hOpp : (by classical @@ -2666,38 +2409,6 @@ private theorem hNanchor : exact hypnot (hOpp.mpr hm) exact ⟨ym, hNu, hymO⟩ -private theorem hNodd : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - ∀ (b : Fin (n + (3 : ℕ))), - let B := v b - let a := v (b - 1) - let c := v (b + 1) - let u : Real × Real := a - B - let w : Real × Real := c - B - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - let O := P3544T1RayParity p - let C := P3544T1BoundaryCarrier p - ∀ (rK : ℝ), - let r := min rK (min (dist B a / 2) (dist B c / 2)) - let U := if 0 < cross u w then u else w - let V := if 0 < cross u w then w else u - (∀ S : Set (Real × Real), IsConnected S → (∀ x, x ∈ S → x ∉ C) → ∀ x, x ∈ S → ∀ y, y ∈ S - → (x ∈ O ↔ y ∈ O)) → ( - let N : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ - 0 < cross U (x - B) ∧ cross V (x - B) < 0} - (IsPathConnected N) → ((∀ x, x ∈ N → x ∉ C) → ((∃ z, z ∈ N ∧ z ∈ O) → (∀ x, x ∈ N → x ∈ - O)))) ) := by - classical - intro n p v b B a c u w cross O C rK r U V hconstOn N hNpc hNoff hNanchor - obtain ⟨z, hzN, hzO⟩ := hNanchor - intro x hx - have hsame := hconstOn N hNpc.isConnected hNoff x hx z hzN - exact hsame.mpr hzO - private theorem hLocalCone : (by classical @@ -2785,33 +2496,6 @@ private theorem hN0pc : hcrossLinear).isPathConnected (ExposedCornerGeometry.hN0ne n p b rK hcrossLinear hUV hz0U hz0V τ hτ hτball) -private theorem hW0pc : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - ∀ (b : Fin (n + (3 : ℕ))), - let B := v b - let a := v (b - 1) - let c := v (b + 1) - let u : Real × Real := a - B - let w : Real × Real := c - B - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - ∀ (rK : ℝ), - let r := min rK (min (dist B a / 2) (dist B c / 2)) - let U := if 0 < cross u w then u else w - let V := if 0 < cross u w then w else u - let W1 : Set (Real × Real) := {z | z ∈ Metric.ball 0 r ∧ cross U z < 0} - let W2 : Set (Real × Real) := {z | z ∈ Metric.ball 0 r ∧ 0 < cross V z} - let W0 : Set (Real × Real) := W1 ∪ W2 - (Convex Real W1) → ((Convex Real W2) → ((W1.Nonempty) → ((W2.Nonempty) → (((W1 ∩ - W2).Nonempty) → (IsPathConnected W0))))) ) := by - classical - intro n p v b B a c u w cross rK r U V W1 W2 W0 hW1convex hW2convex hW1ne hW2ne hWoverlap - exact (hW1convex.isPathConnected hW1ne).union - (hW2convex.isPathConnected hW2ne) hWoverlap - private theorem hcover : (by classical @@ -2957,9 +2641,14 @@ private theorem hynotC : ℝ)) ∉ P3544T1BoundaryCarrier p))))) ) := by classical intro n p v f hqexists b hprev B a c rK r hcarrierLocal hsegmentHeight e ε y hyball hyheight - exact ExposedCornerGeometry.hynotC n p hqexists b ε rK - (ExposedCornerGeometry.hellCarrier n p hqexists b hprev rK hcarrierLocal hsegmentHeight) - hyball hyheight + exact (show + y ∉ (P3544T1BoundaryCarrier p) + from by + classical + intro hyC + have hle := ((ExposedCornerGeometry.hellCarrier n p hqexists b hprev rK hcarrierLocal + hsegmentHeight)) y hyball hyC + exact (not_lt_of_ge hle) hyheight) private theorem hWeven : (by @@ -3091,9 +2780,16 @@ private theorem hWeven : intro n p v f hqexists q b c B e ε y ell a u w hellu hellw cross hdet hparity rK r hcarrierLocal hsegParam hcrossLinear hcrossSelf hswap U V hconeUV hconstOn W hWpc hsegmentHeight hcover hyball hyheight hynotC d0 hdv0 hde0 badV badE T κ hκT hκbad - exact ExposedCornerGeometry.hWeven n p b rK hconstOn hWpc (ExposedCornerGeometry.hWoff - n p b rK (ExposedCornerGeometry.hcarrierSigns n p b hdet rK hcarrierLocal hsegParam - hcrossLinear hcrossSelf hswap)) ε (ExposedCornerGeometry.hYclass n p hqexists b ε rK + exact ExposedCornerGeometry.hWeven n p b rK hconstOn hWpc ((show + ∀ x, x ∈ W → x ∉ (P3544T1BoundaryCarrier p) + from by + classical + intro x hx hc + have hs := ((ExposedCornerGeometry.hcarrierSigns n p b hdet rK hcarrierLocal hsegParam + hcrossLinear hcrossSelf hswap)) x hx.1 hc + rcases hx.2 with hn | hp + · exact (not_lt_of_ge hs.1) hn + · exact (not_lt_of_ge hs.2) hp)) ε (ExposedCornerGeometry.hYclass n p hqexists b ε rK hconeUV hcover (ExposedCornerGeometry.hconeHeight n p hqexists b hellu hellw) hyball hyheight hynotC) (ExposedCornerGeometry.hyEven n p b hparity ε hynotC d0 κ (ExposedCornerGeometry.hdv n p b ε d0 hdv0 κ hκbad) (ExposedCornerGeometry.hde n p b ε d0 @@ -3258,15 +2954,50 @@ private theorem hLocalCone : hconeUV hconstOn N hNpc hcover hWeven σ hσ x0 rS sbit hrule S qside hcrossUq hcrossWq η hη yp ym hypS hymS hyplus hyminus hcrossUplus hcrossUminus hdetSide exact ExposedCornerGeometry.hLocalCone n p b rK hconeUV hcover hWeven - (ExposedCornerGeometry.hNodd n p b rK hconstOn hNpc (ExposedCornerGeometry.hNoff n - p b rK (ExposedCornerGeometry.hcarrierCross n p b rK hcarrierLocal hsegParam - hcrossLinear)) (ExposedCornerGeometry.hNanchor n p b hdet rK hswap hWeven hσ rS - hcrossUq η hη hypS hymS hcrossUplus hcrossUminus (ExposedCornerGeometry.hcrossWplus - n p b rK hcrossLinear hcrossWq η hyplus) (ExposedCornerGeometry.hcrossWminus n p b - rK hcrossLinear hcrossWq η hyminus) (ExposedCornerGeometry.hOpp n p b hprev rK rS - sbit hrule η hypS hymS (ExposedCornerGeometry.hdetPlus n p b rK hcrossUq η hη - hcrossUplus hdetSide) (ExposedCornerGeometry.hdetMinus n p b rK hcrossUq η hη - hcrossUminus hdetSide)))) + ((show + ∀ x, x ∈ N → x ∈ O + from by + classical + obtain ⟨z, hzN, hzO⟩ := ((ExposedCornerGeometry.hNanchor n p b hdet rK hswap + hWeven hσ rS + hcrossUq η hη hypS hymS hcrossUplus hcrossUminus ((show + cross w (yp-B) = σ * cross w u + from by + classical + change (∀ z, IsLinearMap ℝ (cross z)) at hcrossLinear + change cross w qside = 0 at hcrossWq + rw [hyplus, (hcrossLinear w).map_add, (hcrossLinear w).map_smul, + (hcrossLinear w).map_smul, hcrossWq] + simp only [smul_eq_mul, mul_zero, add_zero])) ((show + cross w (ym-B) = σ * cross w u + from by + classical + change (∀ z : Real × Real, IsLinearMap Real (cross z)) + at hcrossLinear + change cross w qside = 0 at hcrossWq + rw [hyminus, (hcrossLinear w).map_sub, (hcrossLinear + w).map_smul, + (hcrossLinear w).map_smul, hcrossWq] + simp only [smul_eq_mul, mul_zero, sub_zero])) + (ExposedCornerGeometry.hOpp n p b hprev rK rS + sbit hrule η hypS hymS ((show + P3381T1TriangleDeterminant ![a, B, yp] < 0 + from by + classical + rw [hdetSide, hcrossUplus] + exact neg_neg_of_pos (mul_pos hη hcrossUq))) ((show + 0 < P3381T1TriangleDeterminant ![a, B, ym] + from by + classical + rw [hdetSide, hcrossUminus] + exact neg_pos.mpr (neg_neg_of_pos (mul_pos hη + hcrossUq))))))) + intro x hx + have hsame := hconstOn N hNpc.isConnected ((ExposedCornerGeometry.hNoff n + p b rK (ExposedCornerGeometry.hcarrierCross n p b rK + hcarrierLocal hsegParam + hcrossLinear))) x hx z hzN + exact hsame.mpr hzO)) end ExposedCornerAssembly @@ -3323,7 +3054,6 @@ theorem P3650T1ExposedCornerExists {n : Nat} (p : P3381T1PolygonBoundary n) : have hheightTop : height B = 1 := by simpa [height] using hFB have hheightNext : height c = 0 := by simpa [height] using hFc let O := P3544T1RayParity p - let C := P3544T1BoundaryCarrier p rcases P3544T1LocalParity p with ⟨_, _, _, _, hlocal, hgeneric, hparity, _, hsides⟩ let J : Set (Fin (n + 3)) := {j | j ≠ b ∧ j + 1 ≠ b} @@ -3346,15 +3076,13 @@ theorem P3650T1ExposedCornerExists {n : Nat} (p : P3381T1PolygonBoundary n) : have hcarrierLocal := ExposedCornerGeometry.hcarrierLocal n p b hprev rK hballK hrKle (ExposedCornerGeometry.haddinj n) have hsegParam := ExposedCornerGeometry.hsegParam hlineMap - have hcrossLinear := ExposedCornerGeometry.hcrossLinear - have hcrossSelf := ExposedCornerGeometry.hcrossSelf + have hcrossLinear : ∀ z, IsLinearMap ℝ (cross z) := ExposedCornerGeometry.hcrossLinear + have hcrossSelf : ∀ z, cross z z = 0 := ExposedCornerGeometry.hcrossSelf have hswap : cross w u = -cross u w := by dsimp [cross]; ring have hpos : 0 < cross u w ∨ cross u w < 0 := lt_or_gt_of_ne hdet.symm let U := if 0 < cross u w then u else w let V := if 0 < cross u w then w else u have hUV := ExposedCornerGeometry.hUV n p b hswap hpos - have hUne := ExposedCornerGeometry.hUne n p b hu hw - have hVne := ExposedCornerGeometry.hVne n p b hu hw have hdecomp := ExposedCornerGeometry.hdecomp n p b hUV have hconeUV := ExposedCornerGeometry.hconeUV n p b hdet hcrossLinear hUV hdecomp have hsmallScale := ExposedCornerGeometry.hsmallScale @@ -3381,8 +3109,9 @@ theorem P3650T1ExposedCornerExists {n : Nat} (p : P3381T1PolygonBoundary n) : have hW2ne : W2.Nonempty := ⟨-(τ • z0), hτnegBall, hposV⟩ have hWoverlap : (W1 ∩ W2).Nonempty := ⟨-(τ • z0), ⟨hτnegBall, hnegU⟩, ⟨hτnegBall, hposV⟩⟩ - have hW0pc : IsPathConnected W0 := ExposedCornerAssembly.hW0pc n p b rK hW1convex hW2convex - hW1ne hW2ne hWoverlap + have hW0pc : IsPathConnected W0 := + (hW1convex.isPathConnected hW1ne).union + (hW2convex.isPathConnected hW2ne) hWoverlap let N : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ 0 < cross U (x - B) ∧ cross V (x - B) < 0} let W : Set (Real × Real) := {x | x ∈ Metric.ball B r ∧ @@ -3421,14 +3150,9 @@ theorem P3650T1ExposedCornerExists {n : Nat} (p : P3381T1PolygonBoundary n) : have hbadfinite : (Set.range badV ∪ Set.range badE).Finite := (Set.finite_range badV).union (Set.finite_range badE) obtain ⟨κ, hκT, hκbad⟩ := (Set.Ioi_infinite T).exists_notMem_finite hbadfinite - let d := d0 + κ • e - have hκpos : 0 < κ := lt_of_le_of_lt (le_max_left _ _) hκT - let hits : Set (Fin (n + 3)) := {i | ∃ t : Real, 0 < t ∧ y + t • d ∈ segment Real (v i) (v (i + - 1))} have hWeven := ExposedCornerAssembly.hWeven n p hqexists b ε hellu hellw hdet hparity rK hcarrierLocal hsegParam hcrossLinear hcrossSelf hswap hconeUV hconstOn hWpc hsegmentHeight hcover hyball hyheight hynotC d0 hdv0 hde0 κ hκT hκbad - have hdistBA : 0 < dist B a := hdistA let σ := min (1 / 2) (r / (4 * (dist B a + 1))) have hσ : 0 < σ := by dsimp [σ]; positivity have hσle : σ ≤ r / (4 * (dist B a + 1)) := min_le_right _ _ @@ -3453,12 +3177,20 @@ theorem P3650T1ExposedCornerExists {n : Nat} (p : P3381T1PolygonBoundary n) : let yp := x0 + η • qside let ym := x0 - η • qside have hypS : yp ∈ S := hballS (htranslateS (η • qside) hηball) - have hymS := ExposedCornerGeometry.hymS n p b rK rS δ hballS η (ExposedCornerGeometry.hηballNeg - n p b δ η hηball) htranslateS + have hymS : ym ∈ S := by + have hh := htranslateS (-(η • qside)) + (ExposedCornerGeometry.hηballNeg n p b δ η hηball) + simpa [ym, S, x0, σ, u, a, B, c, v, r, sub_eq_add_neg] using hballS hh have hyplus : yp - B = σ • u + η • qside := by dsimp [yp, x0]; abel have hyminus : ym - B = σ • u - η • qside := by dsimp [ym, x0]; abel - have hcrossUplus := ExposedCornerGeometry.hcrossUplus n p b rK hcrossLinear hcrossSelf η hyplus - have hcrossUminus := ExposedCornerGeometry.hcrossUminus n p b rK hcrossLinear hcrossSelf η hyminus + have hcrossUplus : cross u (yp - B) = η * cross u qside := by + rw [hyplus, (hcrossLinear u).map_add, (hcrossLinear u).map_smul, + (hcrossLinear u).map_smul, hcrossSelf] + simp only [smul_eq_mul, mul_zero, zero_add] + have hcrossUminus : cross u (ym - B) = -(η * cross u qside) := by + rw [hyminus, (hcrossLinear u).map_sub, (hcrossLinear u).map_smul, + (hcrossLinear u).map_smul, hcrossSelf] + simp only [smul_eq_mul, mul_zero, zero_sub] have hdetSide := ExposedCornerGeometry.hdetSide n p b have hLocalCone : ∀ x : Real × Real, x ∈ Metric.ball B r → (x ∈ O ↔ ∃ s t : Real, 0 < s ∧ 0 < t ∧ x = B + s • u + t • w) := diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean b/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean index cbe0a3f631..605604bde8 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean @@ -367,20 +367,8 @@ private theorem hnotA : exact Set.mem_iUnion.mpr ⟨a, left_mem_segment Real _ _⟩ simpa [h] using this -private theorem hnotB : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (b : Fin (n + 3)), - let Cp := P3544T1BoundaryCarrier p - ∀ (y : ℝ × ℝ), (y ∉ Cp) → (y ≠ p.vertex b) ) := by - classical - intro n p b Cp y hyCp h - apply hyCp - have : p.vertex b ∈ Cp := by - change p.vertex b ∈ ⋃ i, segment Real (p.vertex i) (p.vertex (i + 1)) - exact Set.mem_iUnion.mpr ⟨b, left_mem_segment Real _ _⟩ - simpa [h] using this +private abbrev hnotB := + ApollonianSuperharmonic.LocalCoherenceProof.hnotA private theorem hmem : (by diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean index 9ad5584f69..8d2fe3ce58 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean @@ -1044,35 +1044,6 @@ private theorem hspan : apply hind.affineSpan_eq_top_iff_card_eq_finrank_add_one.mpr norm_num [Module.finrank_prod] -private theorem hrange : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : - P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), - let e := segment Real (p.vertex D.a) (p.vertex D.b) - let CL := P3544T1BoundaryCarrier C.left - let CR := P3544T1BoundaryCarrier C.right - let OL := P3544T1RayParity C.left - let OR := P3544T1RayParity C.right - ((∃ x, x ∈ CL \ e ∧ x ∉ OR) → Disjoint (CL \ e) OR) → (((∃ x, x ∈ CR \ e ∧ x ∉ OL) → - Disjoint (CR \ e) OL) → ( - let va := p.vertex (E.b - 1) - let vb := p.vertex E.b - let vc := p.vertex (E.b + 1) - let vv : Fin 3 → Real × Real := ![va, vb, vc] - ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), - let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ - Set.range A = ({va, vb, vc} : Set (Real × Real)))) ) := by - classical - intro n p E D C e CL CR OL OR propagateRight propagateLeft va vb vc vv hind hspan A - rw [show (A : Fin 3 → Real × Real) = ![va, vb, vc] from funext (by - intro i - fin_cases i <;> rfl)] - ext x - simp - tauto - private theorem hcoord_nonneg : (by classical @@ -1789,57 +1760,6 @@ private theorem hX2At1147 : rw [hcoordLine 2 vb vc δ, hcoordB2, hcoordC2] ring -private theorem hγ0At1150 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), - let va := p.vertex (E.b - 1) - let vb := p.vertex E.b - let vc := p.vertex (E.b + 1) - let vv : Fin 3 → Real × Real := ![va, vb, vc] - ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), - let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ - (∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), A.coord i - (AffineMap.lineMap x y t) = (1 - t) * A.coord i x + t * A.coord i y) → (∀ (r₀ : ℝ), - let r : Real := min r₀ 1 - let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) - let δ : Real := min δ₀ (1/2) - let U : Real × Real := AffineMap.lineMap vb va (-δ) - let X : Real × Real := AffineMap.lineMap vb vc δ - let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t - (A.coord 0 U = -δ) → ((A.coord 0 X = 0) → (∀ (t : Real), A.coord 0 (γ t) = -(1-t)*δ))) ) - := by - classical - intro n p E va vb vc vv hind hspan A hcoordLine r₀ r δ₀ δ U X γ hU0 hX0 t - rw [hcoordLine 0 U X t, hU0, hX0] - ring - -private theorem hγ2At1153 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), - let va := p.vertex (E.b - 1) - let vb := p.vertex E.b - let vc := p.vertex (E.b + 1) - let vv : Fin 3 → Real × Real := ![va, vb, vc] - ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), - let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ - (∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), A.coord i - (AffineMap.lineMap x y t) = (1 - t) * A.coord i x + t * A.coord i y) → (∀ (r₀ : ℝ), - let r : Real := min r₀ 1 - let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) - let δ : Real := min δ₀ (1/2) - let U : Real × Real := AffineMap.lineMap vb va (-δ) - let X : Real × Real := AffineMap.lineMap vb vc δ - let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t - (A.coord 2 U = 0) → ((A.coord 2 X = δ) → (∀ (t : Real), A.coord 2 (γ t) = t*δ))) ) := by - classical - intro n p E va vb vc vv hind hspan A hcoordLine r₀ r δ₀ δ U X γ hU2 hX2 t - rw [hcoordLine 2 U X t, hU2, hX2] - ring - private theorem hrightCenterAt1156 : (by classical @@ -2385,57 +2305,6 @@ private theorem hX2At1391 : rw [hcoordLine 2 vb va δ, hcoordB2, hcoordA2] ring -private theorem hγ0At1394 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), - let va := p.vertex (E.b - 1) - let vb := p.vertex E.b - let vc := p.vertex (E.b + 1) - let vv : Fin 3 → Real × Real := ![va, vb, vc] - ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), - let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ - (∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), A.coord i - (AffineMap.lineMap x y t) = (1 - t) * A.coord i x + t * A.coord i y) → (∀ (r₀ : ℝ), - let r : Real := min r₀ 1 - let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) - let δ : Real := min δ₀ (1/2) - let U : Real × Real := AffineMap.lineMap vb vc (-δ) - let X : Real × Real := AffineMap.lineMap vb va δ - let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t - (A.coord 0 U = 0) → ((A.coord 0 X = δ) → (∀ (t : Real), A.coord 0 (γ t) = t*δ))) ) := by - classical - intro n p E va vb vc vv hind hspan A hcoordLine r₀ r δ₀ δ U X γ hU0 hX0 t - rw [hcoordLine 0 U X t, hU0, hX0] - ring - -private theorem hγ2At1397 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), - let va := p.vertex (E.b - 1) - let vb := p.vertex E.b - let vc := p.vertex (E.b + 1) - let vv : Fin 3 → Real × Real := ![va, vb, vc] - ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), - let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ - (∀ (i : Fin 3), ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (t : Real), A.coord i - (AffineMap.lineMap x y t) = (1 - t) * A.coord i x + t * A.coord i y) → (∀ (r₀ : ℝ), - let r : Real := min r₀ 1 - let δ₀ : Real := r / (2 * (‖va - vb‖ + ‖vc - vb‖ + 1)) - let δ : Real := min δ₀ (1/2) - let U : Real × Real := AffineMap.lineMap vb vc (-δ) - let X : Real × Real := AffineMap.lineMap vb va δ - let γ : Real → Real × Real := fun t => AffineMap.lineMap U X t - (A.coord 2 U = -δ) → ((A.coord 2 X = 0) → (∀ (t : Real), A.coord 2 (γ t) = -(1-t)*δ))) ) - := by - classical - intro n p E va vb vc vv hind hspan A hcoordLine r₀ r δ₀ δ U X γ hU2 hX2 t - rw [hcoordLine 2 U X t, hU2, hX2] - ring - private theorem hleftCenter : (by classical @@ -2942,8 +2811,18 @@ private theorem hseedRAt3047 : have hU2 := OldArcParityProof.hU2At1141 n p E hind hspan hcoordA2 hcoordB2 hcoordLine r₀ have hX0 := OldArcParityProof.hX0At1144 n p E hind hspan hcoordB0 hcoordC0 hcoordLine r₀ have hX2 := OldArcParityProof.hX2At1147 n p E hind hspan hcoordB2 hcoordC2 hcoordLine r₀ - have hγ0 (t : Real) := OldArcParityProof.hγ0At1150 n p E hind hspan hcoordLine r₀ hU0 hX0 t - have hγ2 (t : Real) := OldArcParityProof.hγ2At1153 n p E hind hspan hcoordLine r₀ hU2 hX2 t + have hγ0 (t : Real) := (show + A.coord 0 (γ t) = -(1-t)*δ + from by + classical + rw [hcoordLine 0 U X t, hU0, hX0] + ring) + have hγ2 (t : Real) := (show + A.coord 2 (γ t) = t*δ + from by + classical + rw [hcoordLine 2 U X t, hU2, hX2] + ring) have hrightCenter := OldArcParityProof.hrightCenterAt1156 n p E D C ha hrightLast have hrightZero := OldArcParityProof.hrightZero n p E D C hrightFirst have hrightWrap := OldArcParityProof.hrightWrap n p E D C @@ -3057,8 +2936,18 @@ private theorem hseedLAt3101 : have hU2 := OldArcParityProof.hU2At1385 n p E hind hspan hcoordB2 hcoordC2 hcoordLine r₀ have hX0 := OldArcParityProof.hX0At1388 n p E hind hspan hcoordA0 hcoordB0 hcoordLine r₀ have hX2 := OldArcParityProof.hX2At1391 n p E hind hspan hcoordA2 hcoordB2 hcoordLine r₀ - have hγ0 (t : Real) := OldArcParityProof.hγ0At1394 n p E hind hspan hcoordLine r₀ hU0 hX0 t - have hγ2 (t : Real) := OldArcParityProof.hγ2At1397 n p E hind hspan hcoordLine r₀ hU2 hX2 t + have hγ0 (t : Real) := (show + A.coord 0 (γ t) = t*δ + from by + classical + rw [hcoordLine 0 U X t, hU0, hX0] + ring) + have hγ2 (t : Real) := (show + A.coord 2 (γ t) = -(1-t)*δ + from by + classical + rw [hcoordLine 2 U X t, hU2, hX2] + ring) have hleftCenter := OldArcParityProof.hleftCenter n p E D C ha hleftFirst have hleftOne := OldArcParityProof.hleftOne n p E D C hleftNext have hleftWrap := OldArcParityProof.hleftWrap n p E D C @@ -3179,8 +3068,16 @@ theorem P3650T1OldArcEven {n : Nat} (p : P3381T1PolygonBoundary n) have hind := OldArcParityProof.hind n p E hdet have hspan := OldArcParityProof.hspan n p E hind let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ - have hrange : Set.range A = ({va, vb, vc} : Set (Real × Real)) := OldArcParityProof.hrange n - p E D C propagateRight propagateLeft hind hspan + have hrange : Set.range A = ({va, vb, vc} : Set (Real × Real)) := (show + Set.range A = ({va, vb, vc} : Set (Real × Real)) + from by + classical + rw [show (A : Fin 3 → Real × Real) = ![va, vb, vc] from funext (by + intro i + fin_cases i <;> rfl)] + ext x + simp + tauto) have htriangle : p.vertex D.b ∈ convexHull Real (Set.range A) := by simpa [hrange, va, vb, vc] using hvertex have hcoord_nonneg := OldArcParityProof.hcoord_nonneg n p E D hind hspan htriangle diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean index 2bc77b4b82..c1da3bcd12 100644 --- a/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean @@ -1817,24 +1817,8 @@ private theorem hjL : obtain ⟨z, hz⟩ := Set.mem_range.mp hjk exact ⟨L.face k z, by simpa only [Function.comp_apply] using hz⟩ -private theorem hnoRAt1259 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ (i - : Fin (n + 3)), ∀ (j : Fin (n + 3)), (i ≠ j) → ((i ∈ Set.range S.il ∧ i ∈ Set.range - S.ir ∧ j ∈ Set.range S.il ∧ j ∈ Set.range S.ir) ↔ ((i = S.a ∧ j = S.b) ∨ (i = S.b ∧ j - = S.a)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((¬(i = - S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b)) → ((i ∈ Set.range S.il) → ((j ∈ Set.range S.il) → - (¬ (i ∈ Set.range S.ir ∧ j ∈ Set.range S.ir)))))) ) := by - classical - intro n p S hdiagPair i j hij hdiag hiL hjL hh - have hd := (hdiagPair i j hij).1 ⟨hiL, hh.1, hjL, hh.2⟩ - have hd' : (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) := by - rcases hd with h | h - · exact Or.inl h - · exact Or.inr ⟨h.2, h.1⟩ - exact hdiag hd' +private abbrev hnoRAt1259 := + ApollonianSuperharmonic.IndexedFaceLedgerProof.hnoRAt1159 private theorem hcountLAt1267 : (by @@ -1887,24 +1871,8 @@ private theorem hjR : obtain ⟨z, hz⟩ := Set.mem_range.mp hjk exact ⟨R.face k z, by simpa only [Function.comp_apply] using hz⟩ -private theorem hnoLAt1285 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (∀ (i - : Fin (n + 3)), ∀ (j : Fin (n + 3)), (i ≠ j) → ((i ∈ Set.range S.il ∧ i ∈ Set.range - S.ir ∧ j ∈ Set.range S.il ∧ j ∈ Set.range S.ir) ↔ ((i = S.a ∧ j = S.b) ∨ (i = S.b ∧ j - = S.a)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((¬(i = - S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b)) → ((i ∈ Set.range S.ir) → ((j ∈ Set.range S.ir) → - (¬ (i ∈ Set.range S.il ∧ j ∈ Set.range S.il)))))) ) := by - classical - intro n p S hdiagPair i j hij hdiag hiR hjR hh - have hd := (hdiagPair i j hij).1 ⟨hh.1, hiR, hh.2, hjR⟩ - have hd' : (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b) := by - rcases hd with h | h - · exact Or.inl h - · exact Or.inr ⟨h.2, h.1⟩ - exact hdiag hd' +private abbrev hnoLAt1285 := + ApollonianSuperharmonic.IndexedFaceLedgerProof.hnoLAt1180 private theorem hcountRAt1293 : (by diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean index 6db6259f53..a4c03f7b8b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean @@ -493,70 +493,6 @@ private theorem hmeet : simp only [left, right, hscale₁, hscale₂] exact hend -private theorem hfcont : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - let clip (x : Real) : Icc (0 : Real) 1 := - ⟨max 0 (min 1 x), le_max_left _ _, - max_le (by norm_num) (min_le_left _ _)⟩; - let left : Icc (0 : Real) 1 → Real × Real := fun s => - g a b (clip (2 * s)); - let right : Icc (0 : Real) 1 → Real × Real := fun s => - g b a (clip (2 - 2 * s)); - let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2}; - let f : Icc (0 : Real) 1 → Real × Real := - A.piecewise left right; - (Continuous left) → - ((Continuous right) → - ((∀ (s : Icc (0 : Real) 1), - (s ∈ - (Set.univ : Set (Icc (0 : Real) 1)) ∩ - frontier A) → - (left s = right s)) → - (Continuous f)))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g clip left right A f hleftc - hrightc hmeet - apply continuousOn_univ.mp - apply ContinuousOn.piecewise (s := Set.univ) (t := A) hmeet - · exact hleftc.continuousOn.mono - (show Set.univ ∩ closure A ⊆ Set.univ from fun _ _ => Set.mem_univ _) - · exact hrightc.continuousOn.mono - (show Set.univ ∩ closure Aᶜ ⊆ Set.univ from fun _ _ => Set.mem_univ _) - private theorem hscale_left : (by classical @@ -978,43 +914,6 @@ private theorem hrange : f s = right s := Set.piecewise_eqOn_compl A left right hsA _ = g b a t := by simp [right, hscale] -private theorem left_eval : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (hnpos : 0 < n), - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (j : Fin (m + 1)), tm ⟨j.val, by omega⟩ = polyab.time j / 2)) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm j - have hcond : j.val ≤ m := by omega - simp only [tm, dite_eq_left hcond] - have hj : (⟨j.val, by omega⟩ : Fin (m + 1)) = j := Fin.ext rfl - exact congrArg (fun k : Fin (m + 1) => polyab.time k / 2) hj - private theorem right_eval : (by classical @@ -1170,100 +1069,6 @@ private theorem htm_strict : rw [hidxFin] at hstep linarith -private theorem htm_start : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let m := polyab.count; - let n := polyba.count; - (∀ (hnpos : 0 < n), - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; - (∀ (j : Fin (m + 1)), - tm ⟨j.val, by omega⟩ = polyab.time j / 2) → - (tm 0 = 0)))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n hnpos tm - left_eval - change tm ⟨0, by omega⟩ = 0 - rw [left_eval ⟨0, by omega⟩] - simp [polyab.start] - -private theorem htm_mid : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (hnpos : 0 < n), - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - (∀ (j : Fin (m + 1)), tm ⟨j.val, by omega⟩ = polyab.time j / 2) → (tm ⟨m, - by omega⟩ = 1 / 2))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm - left_eval - let jm : Fin (m + 1) := ⟨m, by omega⟩ - rw [left_eval jm] - have hjlast : jm = Fin.last m := by apply Fin.ext; rfl - rw [hjlast, polyab.finish] - private theorem htm_finish : (by classical @@ -1311,1222 +1116,80 @@ private theorem htm_finish : apply Fin.ext exact hidx rw [hzero, polyba.start] - ring - -private theorem hcastAt761 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (i : Fin (m + n)), i.castSucc = (⟨i.val, by omega⟩ : Fin (m + n + 1)))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i - apply Fin.ext - rfl - -private theorem hsuccAt764 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (i : Fin (m + n)), i.succ = (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n i - apply Fin.ext - rfl - -private theorem hlo'At767 : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let m := polyab.count; - let n := polyba.count; - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; - ∀ (i : Fin (m + n)), - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), - (tm i.castSucc ≤ (↑s : ℝ)) → - ((i.castSucc = - (⟨i.val, by omega⟩ : Fin (m + n + 1))) → - (tm ⟨i.val, by omega⟩ ≤ (s : Real))))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm i s hlo - hcast - rw [← hcast] - exact hlo - -private theorem hhi'At770 : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let m := polyab.count; - let n := polyba.count; - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; - ∀ (i : Fin (m + n)), - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), - ((↑s : ℝ) ≤ tm i.succ) → - ((i.succ = - (⟨i.val + 1, by omega⟩ : Fin (m + n + 1))) → - ((s : Real) ≤ tm ⟨i.val + 1, by omega⟩)))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm i s hhi - hsucc - rw [← hsucc] - exact hhi - -private theorem hlastbound : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let m := polyab.count; - let n := polyba.count; - ∀ (i : Fin (m + n)), - ∀ (hleftidx : (↑i : ℕ) < m), - let j : Fin m := ⟨i.val, by omega⟩; - let j' : Fin (m + 1) := j.succ; - polyab.time j' ≤ 1)) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n i hleftidx j - j' - calc - polyab.time j' ≤ polyab.time (Fin.last m) := - polyab.strict.monotone (Fin.le_last j') - _ = 1 := polyab.finish - -private theorem hsAAt786 : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let A : Set (Icc (0 : Real) 1) := - {s | (s : Real) ≤ 1 / 2}; - let m := polyab.count; - let n := polyba.count; - (let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; - ∀ (i : Fin (m + n)), - ∀ (hleftidx : (↑i : ℕ) < m), - let j : Fin m := ⟨i.val, by omega⟩; - let j' : Fin (m + 1) := j.succ; - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), - ((s : Real) ≤ tm ⟨i.val + 1, by omega⟩) → - ((tm ⟨i.val + 1, by omega⟩ = - polyab.time j' / 2) → - ((polyab.time j' ≤ 1) → (s ∈ A)))))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba A m n tm i - hleftidx j j' s hhi' hend hlastbound - change (s : Real) ≤ 1 / 2 - rw [hend] at hhi' - nlinarith [hlastbound] - -private theorem htlowerAt794 : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let m := polyab.count; - let n := polyba.count; - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; - ∀ (i : Fin (m + n)), - ∀ (hleftidx : (↑i : ℕ) < m), - let j : Fin m := ⟨i.val, by omega⟩; - let j' : Fin (m + 1) := j.succ; - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), - (tm ⟨i.val, by omega⟩ ≤ (s : Real)) → - ∀ - (hhi' : - (s : Real) ≤ tm ⟨i.val + 1, by omega⟩), - (tm ⟨i.val, by omega⟩ = - polyab.time j.castSucc / 2) → - ∀ - (hend : - tm ⟨i.val + 1, by omega⟩ = - polyab.time j' / 2), - ∀ (hlastbound : polyab.time j' ≤ 1), - let t : Icc (0 : Real) 1 := - ⟨2 * (s : Real), - by - constructor - · nlinarith [s.property.1] - · nlinarith⟩; - polyab.time j.castSucc ≤ (t : Real)) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm i hleftidx - j j' s hlo' hhi' hstart hend hlastbound t - have h := hlo' - rw [hstart] at h - dsimp [t] - linarith - -private theorem htupperAt799 : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let m := polyab.count; - let n := polyba.count; - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; - ∀ (i : Fin (m + n)), - ∀ (hleftidx : (↑i : ℕ) < m), - let j : Fin m := ⟨i.val, by omega⟩; - let j' : Fin (m + 1) := j.succ; - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), - ∀ (hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩), - ∀ - (hend : - tm ⟨i.val + 1, by omega⟩ = - polyab.time j' / 2), - ∀ (hlastbound : polyab.time j' ≤ 1), - let t : Icc (0 : Real) 1 := - ⟨2 * (s : Real), - by - constructor - · nlinarith [s.property.1] - · nlinarith⟩; - (t : Real) ≤ polyab.time j') := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm i hleftidx - j j' s hhi' hend hlastbound t - have h := hhi' - rw [hend] at h - dsimp [t] - linarith - -private theorem htvalAt804 : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let clip (x : Real) : Icc (0 : Real) 1 := - ⟨max 0 (min 1 x), le_max_left _ _, - max_le (by norm_num) (min_le_left _ _)⟩; - let A : Set (Icc (0 : Real) 1) := - {s | (s : Real) ≤ 1 / 2}; - (∀ (s : Icc (0 : Real) 1), - (s ∈ A) → ((clip (2 * s) : Real) = 2 * s)) → - let m := polyab.count; - let n := polyba.count; - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; - ∀ (i : Fin (m + n)), - ∀ (hleftidx : (↑i : ℕ) < m), - let j : Fin m := ⟨i.val, by omega⟩; - let j' : Fin (m + 1) := j.succ; - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), - ∀ - (hhi' : - (s : Real) ≤ tm ⟨i.val + 1, by omega⟩), - ∀ - (hend : - tm ⟨i.val + 1, by omega⟩ = - polyab.time j' / 2), - ∀ (hlastbound : polyab.time j' ≤ 1), - (s ∈ A) → - (let t : Icc (0 : Real) 1 := - ⟨2 * (s : Real), - by - constructor - · nlinarith [s.property.1] - · nlinarith⟩; - clip (2 * s) = t)) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba clip A - hscale_left m n tm i hleftidx j j' s hhi' hend hlastbound hsA t - apply Subtype.ext - exact hscale_left s hsA - -private theorem hfvalueAt807 : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let clip (x : Real) : Icc (0 : Real) 1 := - ⟨max 0 (min 1 x), le_max_left _ _, - max_le (by norm_num) (min_le_left _ _)⟩; - let left : Icc (0 : Real) 1 → Real × Real := fun s => - g a b (clip (2 * s)); - let right : Icc (0 : Real) 1 → Real × Real := fun s => - g b a (clip (2 - 2 * s)); - let A : Set (Icc (0 : Real) 1) := - {s | (s : Real) ≤ 1 / 2}; - let f : Icc (0 : Real) 1 → Real × Real := - A.piecewise left right; - let m := polyab.count; - let n := polyba.count; - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; - ∀ (i : Fin (m + n)), - ∀ (hleftidx : (↑i : ℕ) < m), - let j : Fin m := ⟨i.val, by omega⟩; - let j' : Fin (m + 1) := j.succ; - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), - ∀ (hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩), - ∀ - (hend : - tm ⟨i.val + 1, by omega⟩ = - polyab.time j' / 2), - ∀ (hlastbound : polyab.time j' ≤ 1), - (s ∈ A) → - (let t : Icc (0 : Real) 1 := - ⟨2 * (s : Real), - by - constructor - · nlinarith [s.property.1] - · nlinarith⟩; - (clip (2 * s) = t) → (f s = g a b t))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba clip left right A - f m n tm i hleftidx j j' s hhi' hend hlastbound hsA t htval - calc - f s = left s := Set.piecewise_eqOn A left right hsA - _ = g a b t := by simp [left, htval] - -private theorem hcurIndex : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let m := polyab.count; - let n := polyba.count; - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m; - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; - (⟨n - r, by omega⟩ : Fin (n + 1)) = k.succ) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n i r hr k - apply Fin.ext - dsimp [k] - omega - -private theorem hnextIndex : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let m := polyab.count; - let n := polyba.count; - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m; - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; - (⟨n - r - 1, by omega⟩ : Fin (n + 1)) = k.castSucc) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n i r hr k - apply Fin.ext - dsimp [k] - -private theorem hendIndexAt843 : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let m := polyab.count; - let n := polyba.count; - ∀ (i : Fin (m + n)), - (¬(↑i : ℕ) < m) → - (let r : Nat := i.val - m; - ∀ (hr : r < n), - (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = - ⟨m + 1 + r, by omega⟩))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n i hleftidx r - hr - apply Fin.ext - dsimp [r] - omega - -private theorem hstartAt848 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (hnpos : 0 < n), - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (right_eval : ∀ (j : Fin n), tm ⟨m + 1 + j.val, by omega⟩ = - 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2), ∀ (htm_mid : tm ⟨m, by omega⟩ = 1 / - 2), ∀ (i : Fin (m + n)), ∀ (hleftidx : ¬(↑i : ℕ) < m), - let r : Nat := i.val - m - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ - tm ⟨i.val, by omega⟩ = - 1 - polyba.time k.succ / 2 ) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm - right_eval htm_mid i hleftidx r hr k - by_cases hrzero : r = 0 - · have hiv : i.val = m := by dsimp [r] at hrzero ⊢; omega - have hindex : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = ⟨m, by omega⟩ := by - apply Fin.ext - exact hiv - have hksucc : k.succ = Fin.last n := by - apply Fin.ext - dsimp [k] - omega - calc - tm ⟨i.val, by omega⟩ = tm ⟨m, by omega⟩ := congrArg tm hindex - _ = 1 / 2 := htm_mid - _ = 1 - polyba.time k.succ / 2 := by rw [hksucc, polyba.finish]; norm_num - · let j : Fin n := ⟨r - 1, by omega⟩ - have hstartIndex : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = - ⟨m + 1 + j.val, by omega⟩ := by - apply Fin.ext - dsimp [j, r] - omega - calc - tm ⟨i.val, by omega⟩ = tm ⟨m + 1 + j.val, by omega⟩ := - congrArg tm hstartIndex - _ = 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2 := right_eval j - _ = 1 - polyba.time k.succ / 2 := by - have hidx : (⟨n - 1 - j.val, by omega⟩ : Fin (n + 1)) = k.succ := by - apply Fin.ext - dsimp [k, j, r] - omega - exact congrArg (fun z : Real => 1 - z / 2) - (congrArg polyba.time hidx) - -private theorem hendAt880 : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let m := polyab.count; - let n := polyba.count; - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; - (∀ (j : Fin n), - tm ⟨m + 1 + j.val, by omega⟩ = - 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2) → - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m; - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; - ((⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = - ⟨m + 1 + r, by omega⟩) → - (tm ⟨i.val + 1, by omega⟩ = - 1 - polyba.time k.castSucc / 2)) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm right_eval - i r hr k hendIndex - calc - tm ⟨i.val + 1, by omega⟩ = tm ⟨m + 1 + r, by omega⟩ := - congrArg tm hendIndex - _ = 1 - polyba.time ⟨n - 1 - r, by omega⟩ / 2 := - right_eval ⟨r, hr⟩ - _ = 1 - polyba.time k.castSucc / 2 := by - have hidx : (⟨n - 1 - r, by omega⟩ : Fin (n + 1)) = k.castSucc := by - apply Fin.ext - dsimp [k] - omega - exact congrArg (fun z : Real => 1 - z / 2) - (congrArg polyba.time hidx) - -private theorem hA_imp_mid : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} - let m := polyab.count - let n := polyba.count - ∀ (hnpos : 0 < n), - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - (StrictMono tm) → ((tm ⟨m, by omega⟩ = 1 / 2) → (∀ (i : Fin (m + - n)), (¬(↑i : ℕ) < m) → ( - let r : Nat := i.val - m - (r < n) → (∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), (tm ⟨i.val, by omega⟩ ≤ (s : - Real)) → (s ∈ A → i.val = m ∧ (s : Real) = 1 / 2))))))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba A m n hnpos tm - htm_strict htm_mid i hleftidx r hr s hlo' hsA - by_cases heq : i.val = m - · have hi : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = ⟨m, by omega⟩ := by - apply Fin.ext - exact heq - have hhalf : (s : Real) = 1 / 2 := by - have hlow := hlo' - rw [hi, htm_mid] at hlow - change (s : Real) ≤ 1 / 2 at hsA - exact le_antisymm hsA hlow - exact ⟨heq, hhalf⟩ - · have hi : (⟨m, by omega⟩ : Fin (m + n + 1)) < ⟨i.val, by omega⟩ := by - apply Fin.mk_lt_mk.mpr - omega - have hmid : 1 / 2 < tm ⟨i.val, by omega⟩ := by - calc - 1 / 2 = tm ⟨m, by omega⟩ := htm_mid.symm - _ < tm ⟨i.val, by omega⟩ := htm_strict hi - have hlow := hlo' - change (s : Real) ≤ 1 / 2 at hsA - linarith - -private theorem hsRight : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let clip (x : Real) : Icc (0 : Real) 1 := - ⟨max 0 (min 1 x), le_max_left _ _, - max_le (by norm_num) (min_le_left _ _)⟩; - let left : Icc (0 : Real) 1 → Real × Real := fun s => - g a b (clip (2 * s)); - let right : Icc (0 : Real) 1 → Real × Real := fun s => - g b a (clip (2 - 2 * s)); - let A : Set (Icc (0 : Real) 1) := - {s | (s : Real) ≤ 1 / 2}; - let f : Icc (0 : Real) 1 → Real × Real := - A.piecewise left right; - ∀ (p : ℝ × ℝ), - (g a b ⟨1, by norm_num⟩ = p) → - ((g b a ⟨1, by norm_num⟩ = p) → - (let m := polyab.count; - let n := polyba.count; - ∀ (i : Fin (m + n)), - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), - (s ∈ A → i.val = m ∧ (s : Real) = 1 / 2) → - (f s = right s))))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba clip left right A - f p hendab hendba m n i s hA_imp_mid - by_cases hsA : s ∈ A - · obtain ⟨_, hhalf⟩ := hA_imp_mid hsA - have hc1 : clip (2 * s) = ⟨1, by norm_num⟩ := by - apply Subtype.ext - change max 0 (min 1 (2 * (s : Real))) = 1 - rw [hhalf] - norm_num - have hc2 : clip (2 - 2 * s) = ⟨1, by norm_num⟩ := by - apply Subtype.ext - change max 0 (min 1 (2 - 2 * (s : Real))) = 1 - rw [hhalf] - norm_num - have hval : left s = right s := by - simp only [left, right, hc1, hc2] - exact hendab.trans hendba.symm - calc - f s = left s := Set.piecewise_eqOn A left right hsA - _ = right s := hval - · exact Set.piecewise_eqOn_compl A left right hsA - -private theorem hkbound : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let m := polyab.count; - let n := polyba.count; - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m; - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; - polyba.time k.succ ≤ 1) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n i r hr k - calc - polyba.time k.succ ≤ polyba.time (Fin.last n) := - polyba.strict.monotone (Fin.le_last k.succ) - _ = 1 := polyba.finish - -private theorem hsHalf : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let m := polyab.count; - let n := polyba.count; - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m; - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), - (tm ⟨i.val, by omega⟩ ≤ (s : Real)) → - ((tm ⟨i.val, by omega⟩ = - 1 - polyba.time k.succ / 2) → - ((polyba.time k.succ ≤ 1) → - ((1 / 2 : Real) ≤ s)))) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm i r hr k s - hlo' hstart hkbound - have hlow := hlo' - rw [hstart] at hlow - nlinarith - -private theorem htlowerAt951 : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let m := polyab.count; - let n := polyba.count; - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m; - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), - ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), - ((s : Real) ≤ tm ⟨i.val + 1, by omega⟩) → - ∀ - (hstart : - tm ⟨i.val, by omega⟩ = - 1 - polyba.time k.succ / 2), - (tm ⟨i.val + 1, by omega⟩ = - 1 - polyba.time k.castSucc / 2) → - ∀ (hkbound : polyba.time k.succ ≤ 1), - let t : Icc (0 : Real) 1 := - ⟨2 - 2 * (s : Real), - by - constructor - · have hlow := hlo' - rw [hstart] at hlow - nlinarith [s.property.2] - · nlinarith [s.property.1, hsHalf]⟩; - polyba.time k.castSucc ≤ (t : Real)) := by + ring + +private theorem hstartAt848 : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : + P3723T1EdgeContact P a b), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ (right_eval : ∀ (j : Fin n), tm ⟨m + 1 + j.val, by omega⟩ = + 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2), ∀ (htm_mid : tm ⟨m, by omega⟩ = 1 / + 2), ∀ (i : Fin (m + n)), ∀ (hleftidx : ¬(↑i : ℕ) < m), + let r : Nat := i.val - m + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ + tm ⟨i.val, by omega⟩ = + 1 - polyba.time k.succ / 2 ) := by classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm i r hr k s - hlo' hhi' hstart hend hkbound t - have h := hhi' - rw [hend] at h - dsimp [t] - linarith - -private theorem htupperAt956 : + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm + right_eval htm_mid i hleftidx r hr k + by_cases hrzero : r = 0 + · have hiv : i.val = m := by dsimp [r] at hrzero ⊢; omega + have hindex : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = ⟨m, by omega⟩ := by + apply Fin.ext + exact hiv + have hksucc : k.succ = Fin.last n := by + apply Fin.ext + dsimp [k] + omega + calc + tm ⟨i.val, by omega⟩ = tm ⟨m, by omega⟩ := congrArg tm hindex + _ = 1 / 2 := htm_mid + _ = 1 - polyba.time k.succ / 2 := by rw [hksucc, polyba.finish]; norm_num + · let j : Fin n := ⟨r - 1, by omega⟩ + have hstartIndex : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = + ⟨m + 1 + j.val, by omega⟩ := by + apply Fin.ext + dsimp [j, r] + omega + calc + tm ⟨i.val, by omega⟩ = tm ⟨m + 1 + j.val, by omega⟩ := + congrArg tm hstartIndex + _ = 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2 := right_eval j + _ = 1 - polyba.time k.succ / 2 := by + have hidx : (⟨n - 1 - j.val, by omega⟩ : Fin (n + 1)) = k.succ := by + apply Fin.ext + dsimp [k, j, r] + omega + exact congrArg (fun z : Real => 1 - z / 2) + (congrArg polyba.time hidx) + +private theorem hendAt880 : (by classical exact @@ -2570,119 +1233,93 @@ private theorem htupperAt956 : if hi : i.val ≤ m then polyab.time ⟨i.val, by omega⟩ / 2 else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m; - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), - ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), - ∀ - (hstart : - tm ⟨i.val, by omega⟩ = - 1 - polyba.time k.succ / 2), - ∀ (hkbound : polyba.time k.succ ≤ 1), - let t : Icc (0 : Real) 1 := - ⟨2 - 2 * (s : Real), - by - constructor - · have hlow := hlo' - rw [hstart] at hlow - nlinarith [s.property.2] - · nlinarith [s.property.1, hsHalf]⟩; - (t : Real) ≤ polyba.time k.succ) := by - classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm i r hr k s - hlo' hstart hkbound t - have h := hlo' - rw [hstart] at h - dsimp [t] - linarith - -private theorem htvalAt961 : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ (a : ι), - ∀ (b : ι), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := - Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) - (P.shift (-period a) b))), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), - ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let clip (x : Real) : Icc (0 : Real) 1 := - ⟨max 0 (min 1 x), le_max_left _ _, - max_le (by norm_num) (min_le_left _ _)⟩; - let A : Set (Icc (0 : Real) 1) := - {s | (s : Real) ≤ 1 / 2}; - (∀ (s : Icc (0 : Real) 1), - (s ∉ A) → ((clip (2 - 2 * s) : Real) = 2 - 2 * s)) → - let m := polyab.count; - let n := polyba.count; - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + (∀ (j : Fin n), + tm ⟨m + 1 + j.val, by omega⟩ = + 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2) → ∀ (i : Fin (m + n)), let r : Nat := i.val - m; ∀ (hr : r < n), let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), - ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), - ∀ - (hstart : - tm ⟨i.val, by omega⟩ = - 1 - polyba.time k.succ / 2), - (s ∈ A → i.val = m ∧ (s : Real) = 1 / 2) → - ∀ (hkbound : polyba.time k.succ ≤ 1), - let t : Icc (0 : Real) 1 := - ⟨2 - 2 * (s : Real), - by - constructor - · have hlow := hlo' - rw [hstart] at hlow - nlinarith [s.property.2] - · nlinarith [s.property.1, hsHalf]⟩; - clip (2 - 2 * s) = t) := by + ((⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = + ⟨m + 1 + r, by omega⟩) → + (tm ⟨i.val + 1, by omega⟩ = + 1 - polyba.time k.castSucc / 2)) := by classical - intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba clip A - hscale_right m n tm i r hr k s hlo' hstart hA_imp_mid hkbound t - apply Subtype.ext - change (clip (2 - 2 * (s : Real)) : Real) = 2 - 2 * (s : Real) - by_cases hsA : s ∈ A - · obtain ⟨_, hhalf⟩ := hA_imp_mid hsA - change max 0 (min 1 (2 - 2 * (s : Real))) = 2 - 2 * (s : Real) - rw [hhalf] - norm_num - · exact hscale_right s hsA + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm right_eval + i r hr k hendIndex + calc + tm ⟨i.val + 1, by omega⟩ = tm ⟨m + 1 + r, by omega⟩ := + congrArg tm hendIndex + _ = 1 - polyba.time ⟨n - 1 - r, by omega⟩ / 2 := + right_eval ⟨r, hr⟩ + _ = 1 - polyba.time k.castSucc / 2 := by + have hidx : (⟨n - 1 - r, by omega⟩ : Fin (n + 1)) = k.castSucc := by + apply Fin.ext + dsimp [k] + omega + exact congrArg (fun z : Real => 1 - z / 2) + (congrArg polyba.time hidx) + +private theorem hA_imp_mid : + (by + classical + exact + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), + ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc + (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep + a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a + b) → ( + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : + P3723T1PolygonalParameterization (g b a)), + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let m := polyab.count + let n := polyba.count + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then + polyab.time ⟨i.val, by omega⟩ / 2 + else + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + (StrictMono tm) → ((tm ⟨m, by omega⟩ = 1 / 2) → (∀ (i : Fin (m + + n)), (¬(↑i : ℕ) < m) → ( + let r : Nat := i.val - m + (r < n) → (∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), (tm ⟨i.val, by omega⟩ ≤ (s : + Real)) → (s ∈ A → i.val = m ∧ (s : Real) = 1 / 2))))))) := by + classical + intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba A m n hnpos tm + htm_strict htm_mid i hleftidx r hr s hlo' hsA + by_cases heq : i.val = m + · have hi : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = ⟨m, by omega⟩ := by + apply Fin.ext + exact heq + have hhalf : (s : Real) = 1 / 2 := by + have hlow := hlo' + rw [hi, htm_mid] at hlow + change (s : Real) ≤ 1 / 2 at hsA + exact le_antisymm hsA hlow + exact ⟨heq, hhalf⟩ + · have hi : (⟨m, by omega⟩ : Fin (m + n + 1)) < ⟨i.val, by omega⟩ := by + apply Fin.mk_lt_mk.mpr + omega + have hmid : 1 / 2 < tm ⟨i.val, by omega⟩ := by + calc + 1 / 2 = tm ⟨m, by omega⟩ := htm_mid.symm + _ < tm ⟨i.val, by omega⟩ := htm_strict hi + have hlow := hlo' + change (s : Real) ≤ 1 / 2 at hsA + linarith -private theorem hfvalueAt970 : +private theorem hsRight : (by classical exact @@ -2712,7 +1349,7 @@ private theorem hfvalueAt970 : (P3723T1EdgeContact P a b) → (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := if hab : P3723T1EdgeContact P a b then localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + @@ -2731,39 +1368,37 @@ private theorem hfvalueAt970 : {s | (s : Real) ≤ 1 / 2}; let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right; - let m := polyab.count; - let n := polyba.count; - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; - ∀ (i : Fin (m + n)), - let r : Nat := i.val - m; - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩; - ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), - ∀ (hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real)), - ∀ - (hstart : - tm ⟨i.val, by omega⟩ = - 1 - polyba.time k.succ / 2), - (f s = right s) → - ∀ (hkbound : polyba.time k.succ ≤ 1), - let t : Icc (0 : Real) 1 := - ⟨2 - 2 * (s : Real), - by - constructor - · have hlow := hlo' - rw [hstart] at hlow - nlinarith [s.property.2] - · nlinarith [s.property.1, hsHalf]⟩; - (clip (2 - 2 * s) = t) → (f s = g b a t)) := by + ∀ (p : ℝ × ℝ), + (g a b ⟨1, by norm_num⟩ = p) → + ((g b a ⟨1, by norm_num⟩ = p) → + (let m := polyab.count; + let n := polyba.count; + ∀ (i : Fin (m + n)), + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), + (s ∈ A → i.val = m ∧ (s : Real) = 1 / 2) → + (f s = right s))))) := by classical intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba clip left right A - f m n tm i r hr k s hlo' hstart hsRight hkbound t htval - calc - f s = right s := hsRight - _ = g b a t := by simp [right, htval] + f p hendab hendba m n i s hA_imp_mid + by_cases hsA : s ∈ A + · obtain ⟨_, hhalf⟩ := hA_imp_mid hsA + have hc1 : clip (2 * s) = ⟨1, by norm_num⟩ := by + apply Subtype.ext + change max 0 (min 1 (2 * (s : Real))) = 1 + rw [hhalf] + norm_num + have hc2 : clip (2 - 2 * s) = ⟨1, by norm_num⟩ := by + apply Subtype.ext + change max 0 (min 1 (2 - 2 * (s : Real))) = 1 + rw [hhalf] + norm_num + have hval : left s = right s := by + simp only [left, right, hc1, hc2] + exact hendab.trans hendba.symm + calc + f s = left s := Set.piecewise_eqOn A left right hsA + _ = right s := hval + · exact Set.piecewise_eqOn_compl A left right hsA private theorem parameter_homeomorph : (by @@ -3540,16 +2175,27 @@ private theorem hpoly : else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 have left_eval (j : Fin (m + 1)) : - tm ⟨j.val, by omega⟩ = polyab.time j / 2 := ContactDrawingGeometry.left_eval ι P D a b - localStar rep_spec pulled_contact hab polyab polyba hnpos j + tm ⟨j.val, by omega⟩ = polyab.time j / 2 := (show + tm ⟨j.val, by omega⟩ = polyab.time j / 2 + from by + classical + have hcond : j.val ≤ m := by omega + simp only [tm, dite_eq_left hcond] + have hj : (⟨j.val, by omega⟩ : Fin (m + 1)) = j := Fin.ext rfl + exact congrArg (fun k : Fin (m + 1) => polyab.time k / 2) hj) have right_eval (j : Fin n) := ContactDrawingGeometry.right_eval ι P D a b localStar rep_spec pulled_contact hab polyab polyba j have htm_strict := ContactDrawingGeometry.htm_strict ι P D a b localStar rep_spec pulled_contact hab polyab polyba hnpos left_eval right_eval - have htm_start := ContactDrawingGeometry.htm_start ι P D a b localStar rep_spec - pulled_contact polyab polyba hnpos left_eval - have htm_mid := ContactDrawingGeometry.htm_mid ι P D a b localStar rep_spec pulled_contact - hab polyab polyba hnpos left_eval + have htm_start : tm 0 = 0 := by + change tm ⟨0, by omega⟩ = 0 + rw [left_eval ⟨0, by omega⟩] + simp [polyab.start] + have htm_mid : tm ⟨m, by omega⟩ = 1 / 2 := by + let jm : Fin (m + 1) := ⟨m, by omega⟩ + rw [left_eval jm] + have hjlast : jm = Fin.last m := by apply Fin.ext; rfl + rw [hjlast, polyab.finish] have htm_finish := ContactDrawingGeometry.htm_finish ι P D a b localStar rep_spec pulled_contact hab polyab polyba hnpos right_eval refine ⟨{ @@ -3562,20 +2208,22 @@ private theorem hpoly : affine_on := ?_ }⟩ intro i + have hcast : i.castSucc = (⟨i.val, by omega⟩ : Fin (m + n + 1)) := by + apply Fin.ext; rfl + have hsucc : i.succ = (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) := by + apply Fin.ext; rfl by_cases hleftidx : i.val < m · let j : Fin m := ⟨i.val, by omega⟩ let j' : Fin (m + 1) := j.succ obtain ⟨C, V, hpiece⟩ := polyab.affine_on j refine ⟨C, 2 • V, ?_⟩ intro s hlo hhi - have hcast := ContactDrawingGeometry.hcastAt761 ι P D a b localStar rep_spec - pulled_contact hab polyab polyba i - have hsucc := ContactDrawingGeometry.hsuccAt764 ι P D a b localStar rep_spec - pulled_contact hab polyab polyba i - have hlo' := ContactDrawingGeometry.hlo'At767 ι P D a b localStar rep_spec pulled_contact - polyab polyba i s hlo hcast - have hhi' := ContactDrawingGeometry.hhi'At770 ι P D a b localStar rep_spec pulled_contact - polyab polyba i s hhi hsucc + have hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real) := by + rw [← hcast] + exact hlo + have hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩ := by + rw [← hsucc] + exact hhi have hstartIndex : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = ⟨j.castSucc.val, by omega⟩ := by apply Fin.ext; rfl have hendIndex : (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = @@ -3584,22 +2232,36 @@ private theorem hpoly : rw [hstartIndex, left_eval j.castSucc] have hend : tm ⟨i.val + 1, by omega⟩ = polyab.time j' / 2 := by rw [hendIndex, left_eval j'] - have hlastbound := ContactDrawingGeometry.hlastbound ι P D a b localStar rep_spec - pulled_contact polyab polyba i hleftidx - have hsA := ContactDrawingGeometry.hsAAt786 ι P D a b localStar rep_spec pulled_contact - polyab polyba i hleftidx s hhi' hend hlastbound + have hlastbound : polyab.time j' ≤ 1 := by + calc + polyab.time j' ≤ polyab.time (Fin.last m) := + polyab.strict.monotone (Fin.le_last j') + _ = 1 := polyab.finish + have hsA : s ∈ A := by + change (s : Real) ≤ 1 / 2 + rw [hend] at hhi' + nlinarith [hlastbound] let t : Icc (0 : Real) 1 := ⟨2 * (s : Real), by constructor · nlinarith [s.property.1] · nlinarith⟩ - have htlower := ContactDrawingGeometry.htlowerAt794 ι P D a b localStar rep_spec - pulled_contact polyab polyba i hleftidx s hlo' hhi' hstart hend hlastbound - have htupper := ContactDrawingGeometry.htupperAt799 ι P D a b localStar rep_spec - pulled_contact polyab polyba i hleftidx s hhi' hend hlastbound - have htval := ContactDrawingGeometry.htvalAt804 ι P D a b localStar rep_spec - pulled_contact polyab polyba hscale_left i hleftidx s hhi' hend hlastbound hsA - have hfvalue := ContactDrawingGeometry.hfvalueAt807 ι P D a b localStar rep_spec - pulled_contact polyab polyba i hleftidx s hhi' hend hlastbound hsA htval + have htlower : polyab.time j.castSucc ≤ (t : Real) := by + have h := hlo' + rw [hstart] at h + dsimp [t] + linarith + have htupper : (t : Real) ≤ polyab.time j' := by + have h := hhi' + rw [hend] at h + dsimp [t] + linarith + have htval : clip (2 * s) = t := by + apply Subtype.ext + exact hscale_left s hsA + have hfvalue : f s = g a b t := by + calc + f s = left s := Set.piecewise_eqOn A left right hsA + _ = g a b t := by simp [left, htval] calc f s = g a b t := hfvalue _ = C + (t : Real) • V := hpiece t htlower htupper @@ -3613,21 +2275,27 @@ private theorem hpoly : obtain ⟨C, V, hpiece⟩ := polyba.affine_on k refine ⟨C + 2 • V, -2 • V, ?_⟩ intro s hlo hhi - have hcast := ContactDrawingGeometry.hcastAt761 ι P D a b localStar rep_spec - pulled_contact hab polyab polyba i - have hsucc := ContactDrawingGeometry.hsuccAt764 ι P D a b localStar rep_spec - pulled_contact hab polyab polyba i - have hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real) := ContactDrawingGeometry.hlo'At767 ι P D a b - localStar rep_spec pulled_contact polyab polyba i s hlo hcast - have hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩ := ContactDrawingGeometry.hhi'At770 ι P D - a b localStar rep_spec pulled_contact polyab polyba i s hhi hsucc - have hcurIndex := ContactDrawingGeometry.hcurIndex ι P D a b localStar rep_spec - pulled_contact polyab polyba i hr - have hnextIndex := ContactDrawingGeometry.hnextIndex ι P D a b localStar rep_spec - pulled_contact polyab polyba i hr + have hlo' : tm ⟨i.val, by omega⟩ ≤ (s : Real) := by + rw [← hcast] + exact hlo + have hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩ := by + rw [← hsucc] + exact hhi + have hcurIndex : (⟨n - r, by omega⟩ : Fin (n + 1)) = k.succ := by + apply Fin.ext + dsimp [k] + omega + have hnextIndex : (⟨n - r - 1, by omega⟩ : Fin (n + 1)) = k.castSucc := by + apply Fin.ext + dsimp [k] have hendIndex : (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = - ⟨m + 1 + r, by omega⟩ := ContactDrawingGeometry.hendIndexAt843 ι P D a b localStar - rep_spec pulled_contact polyab polyba i hleftidx hr + ⟨m + 1 + r, by omega⟩ := (show + (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = ⟨m + 1 + r, by omega⟩ + from by + classical + apply Fin.ext + dsimp [r] + omega) have hstart : tm ⟨i.val, by omega⟩ = 1 - polyba.time k.succ / 2 := ContactDrawingGeometry.hstartAt848 ι P D a b localStar rep_spec pulled_contact hab polyab polyba hnpos right_eval htm_mid i hleftidx hr @@ -3638,24 +2306,44 @@ private theorem hpoly : pulled_contact hab polyab polyba hnpos htm_strict htm_mid i hleftidx hr s hlo' have hsRight := ContactDrawingGeometry.hsRight ι P D a b localStar rep_spec pulled_contact polyab polyba p hendab hendba i s hA_imp_mid - have hkbound := ContactDrawingGeometry.hkbound ι P D a b localStar rep_spec - pulled_contact polyab polyba i hr - have hsHalf := ContactDrawingGeometry.hsHalf ι P D a b localStar rep_spec pulled_contact - polyab polyba i hr s hlo' hstart hkbound + have hkbound : polyba.time k.succ ≤ 1 := by + calc + polyba.time k.succ ≤ polyba.time (Fin.last n) := + polyba.strict.monotone (Fin.le_last k.succ) + _ = 1 := polyba.finish + have hsHalf : (1 / 2 : Real) ≤ s := by + have hlow := hlo' + rw [hstart] at hlow + nlinarith let t : Icc (0 : Real) 1 := ⟨2 - 2 * (s : Real), by constructor · have hlow := hlo' rw [hstart] at hlow nlinarith [s.property.2] · nlinarith [s.property.1, hsHalf]⟩ - have htlower := ContactDrawingGeometry.htlowerAt951 ι P D a b localStar rep_spec - pulled_contact polyab polyba i hr s hlo' hhi' hstart hend hkbound - have htupper := ContactDrawingGeometry.htupperAt956 ι P D a b localStar rep_spec - pulled_contact polyab polyba i hr s hlo' hstart hkbound - have htval := ContactDrawingGeometry.htvalAt961 ι P D a b localStar rep_spec - pulled_contact polyab polyba hscale_right i hr s hlo' hstart hA_imp_mid hkbound - have hfvalue := ContactDrawingGeometry.hfvalueAt970 ι P D a b localStar rep_spec - pulled_contact polyab polyba i hr s hlo' hstart hsRight hkbound htval + have htlower : polyba.time k.castSucc ≤ (t : Real) := by + have h := hhi' + rw [hend] at h + dsimp [t] + linarith + have htupper : (t : Real) ≤ polyba.time k.succ := by + have h := hlo' + rw [hstart] at h + dsimp [t] + linarith + have htval : clip (2 - 2 * s) = t := by + apply Subtype.ext + change (clip (2 - 2 * (s : Real)) : Real) = 2 - 2 * (s : Real) + by_cases hsA : s ∈ A + · obtain ⟨_, hhalf⟩ := hA_imp_mid hsA + change max 0 (min 1 (2 - 2 * (s : Real))) = 2 - 2 * (s : Real) + rw [hhalf] + norm_num + · exact hscale_right s hsA + have hfvalue : f s = g b a t := by + calc + f s = right s := hsRight + _ = g b a t := by simp [right, htval] calc f s = g b a t := hfvalue _ = C + (t : Real) • V := hpiece t htlower htupper @@ -3723,8 +2411,16 @@ private theorem full_parameters : have hmeet (s : Icc (0 : Real) 1) (hs : s ∈ (Set.univ : Set (Icc (0 : Real) 1)) ∩ frontier A) := ContactDrawingGeometry.hmeet ι P D a b localStar rep_spec pulled_contact hab hg1ab hg1ba s hs - have hfcont := ContactDrawingGeometry.hfcont ι P D a b localStar rep_spec pulled_contact - hleftc hrightc hmeet + have hfcont := (show + Continuous f + from by + classical + apply continuousOn_univ.mp + apply ContinuousOn.piecewise (s := Set.univ) (t := A) hmeet + · exact hleftc.continuousOn.mono + (show Set.univ ∩ closure A ⊆ Set.univ from fun _ _ => Set.mem_univ _) + · exact hrightc.continuousOn.mono + (show Set.univ ∩ closure Aᶜ ⊆ Set.univ from fun _ _ => Set.mem_univ _)) have hscale_left (s : Icc (0 : Real) 1) (hs : s ∈ A) := ContactDrawingGeometry.hscale_left s hs have hscale_right (s : Icc (0 : Real) 1) (hs : s ∉ A) := ContactDrawingGeometry.hscale_right s hs diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean b/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean index ef33352945..d3aa5e42d6 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean @@ -1165,74 +1165,6 @@ private theorem sectorChosenCone_periodic : rw [sectorChosenCone_spec f o w] _ = sectorChosenCone f o z + GaussianRealPoint u := by rw [hw] -private theorem sectorGlobalChosen_spec : - ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : - P3776T1DualEdges P), - let SectorInterval := Set.Icc (0 : ℝ) 1 - let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} - let sectorCollapse := P3832T1ConeCollapse - ∀ (sectorSupportedHalfCone : ∀ {ι : Type}, ∀ (P : PeriodicTileCore ι), ∀ (H : - P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), ∀ (f : P.plane.Face), ∀ (a : - ι), ∀ (b : ι), (P.plane.adjacent a b) → ((∃ i, P.plane.faceVertex f i = a) → ((∃ i, - P.plane.faceVertex f i = b) → (∃ G : C(SectorCone, ℝ × ℝ), ∀ z : SectorInterval × - SectorInterval, G (sectorCollapse z) = H.homotopy a z.1 (E.half f a b z.2))))), - let SectorSimplex := StandardSimplex (Fin 3) - let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => - {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} - let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // - t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} - let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 - let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 - let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 - let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) - ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i - ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) - ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : - {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), - let sectorPiece (o : SectorOrder) - (G : C(SectorCone,ℝ×ℝ)) : C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := - ⟨fun s => G (sectorParam o s.1 s.2), - G.continuous.comp (sectorParam_continuous o)⟩ - let sectorChosenCone (f : P.plane.Face) (o : SectorOrder) : C(SectorCone,ℝ×ℝ) := - Classical.choose (sectorSupportedHalfCone P H E f - (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) - (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) - ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) - let sectorChosenPiece (f : P.plane.Face) (o : SectorOrder) : - C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := - sectorPiece o (sectorChosenCone f o) - ∀ (sectorGlobalMap : ∀ (f : P.plane.Face), ∃ F : C(SectorSimplex,ℝ×ℝ), ∀ o s (hs : s ∈ - sectorCh o), F s=sectorChosenPiece f o ⟨s,hs⟩), - let sectorGlobalChosen (f : P.plane.Face) : C(SectorSimplex,ℝ×ℝ) := - Classical.choose (sectorGlobalMap f) - ∀ (f : P.plane.Face), ∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), - sectorGlobalChosen f s = sectorChosenPiece f o ⟨s,hs⟩ := by - classical - intro ι P H E SectorInterval SectorCone sectorCollapse sectorSupportedHalfCone SectorSimplex - sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrderedSum sectorParam - sectorParam_continuous sectorPiece sectorChosenCone sectorChosenPiece sectorGlobalMap - sectorGlobalChosen f o s hs - exact Classical.choose_spec (sectorGlobalMap f) o s hs - private theorem sectorGlobalChosen_periodic : ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), @@ -1851,9 +1783,11 @@ theorem P3776T1SectorMapsExist {ι : Type} (P : PeriodicTileCore ι) let sectorGlobalChosen (f : P.plane.Face) : C(SectorSimplex,ℝ×ℝ) := Classical.choose (sectorGlobalMap f) have sectorGlobalChosen_spec (f : P.plane.Face) (o : SectorOrder) - (s : SectorSimplex) (hs : s ∈ sectorCh o) := SectorMapsProof.sectorGlobalChosen_spec ι P H - E sectorSupportedHalfCone - sectorOrderedSum sectorParam_continuous sectorGlobalMap f o s hs + (s : SectorSimplex) (hs : s ∈ sectorCh o) := (show + sectorGlobalChosen f s = sectorChosenPiece f o ⟨s,hs⟩ + from by + classical + exact Classical.choose_spec (sectorGlobalMap f) o s hs) have sectorGlobalChosen_periodic (u : P.lattice) (f : P.plane.Face) (s : SectorSimplex) := SectorMapsProof.sectorGlobalChosen_periodic ι P H E sectorSupportedHalfCone diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean index 308356ad11..7e3f570471 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean @@ -763,43 +763,11 @@ private theorem hip : nlinarith exact htsp n this -private theorem hrq : - ∀ (q : ℂ), ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), - let h : ℝ := min η (min εp εq) / 10 - (0 < h) → (∀ (s : ℝ), (∀ (n : ℤ), q.re / h - s ≠ (↑n : ℝ)) → (∀ (t : ℝ), - let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I - let rq : ℂ := (q - o) / (h : ℂ) - ∀ n : ℤ, rq.re ≠ n)) := by - classical - intro q η εp εq h hh s hspq t o rq n hn - have : q.re / h - s = n := by - dsimp [rq, o] at hn ⊢ - simp only [Complex.div_re, Complex.sub_re, Complex.add_re, Complex.mul_re, - Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, - mul_zero, zero_mul, sub_zero, add_zero] at hn - simp only [Complex.normSq_ofReal] at hn - field_simp [ne_of_gt hh] at hn ⊢ - nlinarith - exact hspq n this +private abbrev hrq := + ApollonianSuperharmonic.ComponentContoursProof.hrp -private theorem hiq : - ∀ (q : ℂ), ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), - let h : ℝ := min η (min εp εq) / 10 - (0 < h) → (∀ (s : ℝ), ∀ (t : ℝ), (∀ (n : ℤ), q.im / h - t ≠ (↑n : ℝ)) → ( - let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I - let rq : ℂ := (q - o) / (h : ℂ) - ∀ n : ℤ, rq.im ≠ n)) := by - classical - intro q η εp εq h hh s t htq o rq n hn - have : q.im / h - t = n := by - dsimp [rq, o] at hn ⊢ - simp only [Complex.div_im, Complex.sub_im, Complex.add_im, Complex.mul_im, - Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, - mul_zero, add_zero] at hn - simp only [Complex.normSq_ofReal] at hn - field_simp [ne_of_gt hh] at hn ⊢ - nlinarith - exact htq n this +private abbrev hiq := + ApollonianSuperharmonic.ComponentContoursProof.hip private theorem hpclose : ∀ (p : ℂ), @@ -1297,39 +1265,8 @@ private theorem hsumAt1198 : _ = P3821T1LoopIndex (loops j) (GridCellCenter up) := cell_index up rp hup j -private theorem hsumAt1214 : - ∀ (q : ℂ), - let openbox (u : GaussianInt) (z : ℂ) : Prop := - (u.re : ℝ) < z.re ∧ z.re < (u.re : ℝ) + 1 ∧ - (u.im : ℝ) < z.im ∧ z.im < (u.im : ℝ) + 1 - ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), - let h : ℝ := min η (min εp εq) / 10 - ∀ (s : ℝ), ∀ (t : ℝ), - let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I - let rq : ℂ := (q - o) / (h : ℂ) - ∀ (uq : GaussianInt), (openbox uq rq) → (∀ (n : ℕ), ∀ (loops : Fin n → C(Circle, ℂ)), - let g : Fin n → C(Circle, ℂ) := fun j => - ⟨fun z => (h : ℂ) * loops j z + o, (continuous_const.mul (loops j).continuous).add - continuous_const⟩ - (∀ (j : Fin n), ∀ (r : ℂ), (∀ z, loops j z ≠ r) → (P3821T1LoopIndex (g j) ((h : ℂ) * r + o) - = P3821T1LoopIndex (loops j) r)) → ((∀ (u : GaussianInt), ∀ (r : ℂ), (openbox u r) → (∀ - (j : Fin n), ∀ z, loops j z ≠ r)) → ((∀ (u : GaussianInt), ∀ (r : ℂ), (openbox u r) → - (∀ (j : Fin n), P3821T1LoopIndex (loops j) r = P3821T1LoopIndex (loops j) - (GridCellCenter u))) → (((h : ℂ) * rq + o = q) → ((∑ j, P3821T1LoopIndex (g j) q) = ∑ - j, P3821T1LoopIndex (loops j) (GridCellCenter uq)))))) := by - classical - intro q openbox η εp εq h s t o rq uq huq n loops g hscaled_index hloop_open_avoid cell_index - hqgrid - apply Finset.sum_congr rfl - intro j hj - calc - P3821T1LoopIndex (g j) q = - P3821T1LoopIndex (g j) ((h : ℂ) * rq + o) := by - exact congrArg (P3821T1LoopIndex (g j)) hqgrid.symm - _ = P3821T1LoopIndex (loops j) rq := - hscaled_index j rq (hloop_open_avoid uq rq huq j) - _ = P3821T1LoopIndex (loops j) (GridCellCenter uq) := - cell_index uq rq huq j +private abbrev hsumAt1214 := + ApollonianSuperharmonic.ComponentContoursProof.hsumAt1198 end ComponentContoursProof @@ -1611,21 +1548,8 @@ private theorem hpgrid : _ = (p - o) + o := congrArg (fun z : ℂ => z + o) hcancel _ = p := sub_add_cancel p o -private theorem hqgrid : - ∀ (q : ℂ), ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), - let h : ℝ := min η (min εp εq) / 10 - ∀ (s : ℝ), ∀ (t : ℝ), - let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I - let rq : ℂ := (q - o) / (h : ℂ) - ((h : ℂ) ≠ 0) → ((h : ℂ) * rq + o = q) := by - classical - intro q η εp εq h s t o rq hdenom - have hcancel : (h : ℂ) * ((q - o) / (h : ℂ)) = q - o := - mul_div_cancel₀ (q - o) hdenom - change (h : ℂ) * ((q - o) / (h : ℂ)) + o = q - calc - _ = (q - o) + o := congrArg (fun z : ℂ => z + o) hcancel - _ = q := sub_add_cancel q o +private abbrev hqgrid := + ApollonianSuperharmonic.ComponentContourDetails.hpgrid private theorem hpoint : let corner (u : GaussianInt) : Fin 4 → GaussianInt := diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean index 2864fd05a3..6d57dfb8cf 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean @@ -151,26 +151,6 @@ private theorem hf0 : ite_eq_right (by norm_num : ¬ (3 : ℝ) ≤ 2), q₀, q₂, hright, hleft] exact h₀a.trans h₂a.symm -private theorem hℓc : - ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₀ : - (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ∀ (h₁ : (↑(Set.Icc (0 : ℝ) - 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ∀ (h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ - (↑(P.edgeArc c a) : Type)), - let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := - ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ - let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) - let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) - let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) - let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x - let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x - (Continuous f) → (f 0 = f 3) → ∀ [this : Fact (0 < (3 : ℝ))], - let ℓ : AddCircle (3 : ℝ) → Real × Real := AddCircle.liftIco 3 0 f - Continuous ℓ := by - classical - intro ι P a b c h₀ h₁ h₂ clamp q₀ q₁ q₂ mid f hf hf0 this ℓ - apply AddCircle.liftIco_zero_continuous hf0 - exact hf.continuousOn - private theorem clamp_eq_self : let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ @@ -600,27 +580,6 @@ private theorem hf_inj : have hv := congrArg Subtype.val heq linarith -private theorem lift_eq : - ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₀ : - (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ∀ (h₁ : (↑(Set.Icc (0 : ℝ) - 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ∀ (h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ - (↑(P.edgeArc c a) : Type)), - let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := - ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ - let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) - let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) - let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) - let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x - let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x - ∀ [this : Fact (0 < (3 : ℝ))], - let ℓ : AddCircle (3 : ℝ) → Real × Real := AddCircle.liftIco 3 0 f - ∀ (x : ℝ), (x ∈ Set.Ico (0 : ℝ) 3) → ℓ (x : AddCircle (3 : ℝ)) = f x := by - classical - intro ι P a b c h₀ h₁ h₂ clamp q₀ q₁ q₂ mid f this ℓ x hx - dsimp [ℓ] - apply AddCircle.liftIco_coe_apply - simpa using hx - end ThreeArcCircleLemmas namespace ThreeArcCircleRange @@ -784,7 +743,12 @@ theorem P3821T1ThreeArcCircle {ι : Type} (P : PlaneTriangulation ι) have hf0 : f 0 = f 3 := ThreeArcCircleLemmas.hf0 ι P a b c h₀ h₀a h₁ h₂ h₂a let : Fact (0 < (3 : ℝ)) := ⟨by norm_num⟩ let ℓ : AddCircle (3 : ℝ) → Real × Real := AddCircle.liftIco 3 0 f - have hℓc : Continuous ℓ := ThreeArcCircleLemmas.hℓc ι P a b c h₀ h₁ h₂ hf hf0 (this := this) + have hℓc : Continuous ℓ := (show + Continuous ℓ + from by + classical + apply AddCircle.liftIco_zero_continuous hf0 + exact hf.continuousOn) have clamp_eq_self (x : ℝ) (hx : x ∈ Set.Icc (0 : ℝ) 1) : clamp x = ⟨x, hx⟩ := ThreeArcCircleLemmas.clamp_eq_self x hx have fseg₀ (x : ℝ) (hx : 0 ≤ x) (h₁x : x ≤ 1) : @@ -818,8 +782,14 @@ theorem P3821T1ThreeArcCircle {ι : Type} (P : PlaneTriangulation ι) f x = f y → x = y := ThreeArcCircleLemmas.hf_inj ι P a b c h₀ h₁ h₂ fseg₀ fseg₁ fseg₂ cross₀₁ cross₁₂ cross₀₂ have lift_eq (x : ℝ) (hx : x ∈ Set.Ico (0 : ℝ) 3) : - ℓ (x : AddCircle (3 : ℝ)) = f x := ThreeArcCircleLemmas.lift_eq ι P a b c h₀ h₁ h₂ (this := - this) x hx + ℓ (x : AddCircle (3 : ℝ)) = f x := (show + ∀ (x : ℝ), (x ∈ Set.Ico (0 : ℝ) 3) → ℓ (x : AddCircle (3 : ℝ)) = f x + from by + classical + intro x hx + dsimp [ℓ] + apply AddCircle.liftIco_coe_apply + simpa using hx) x hx let e : Circle → Real × Real := ℓ ∘ (AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm refine ⟨⟨e, ?_⟩, ?_, ?_⟩ · exact hℓc.comp (AddCircle.homeomorphCircle (by norm_num : (3 : ℝ) ≠ 0)).symm.continuous diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean index f3884bc7bb..173cba9f07 100644 --- a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean @@ -1541,22 +1541,8 @@ private theorem hnormAt994 : rw [norm_smul, hunit d had, Real.norm_eq_abs, abs_of_nonneg ht0] ring -private theorem hdistAt997 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : - ι), ∀ (u : ι → ℝ × ℝ), - let x := D.position a - ∀ (z : ℝ × ℝ), ∀ (d : ι), ∀ (t : ℝ), (z = x + t • u d) → ((‖t • u d‖ = t) → (dist z x = - t)) ) := by - classical - intro ι P D a u x z d t hzeq hnorm - have : dist x z = t := by - rw [dist_eq_norm, hzeq] - have hsub : x - (x + t • u d) = -(t • u d) := by abel - rw [hsub, norm_neg, hnorm] - simpa [dist_comm] using this +private abbrev hdistAt997 := + ApollonianSuperharmonic.FaceGapProof.hdistAt981 private theorem hSphereConnected : (by diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean index 9a81501e70..2d75095101 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean @@ -516,51 +516,8 @@ private theorem hgfun_surj : apply Subtype.ext exact hx -private theorem hhfun_surj : - ∀ (S : Set (ℝ × ℝ)), ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (hhrange : - Set.range h = S), - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ - Function.Surjective hfun := by - classical - intro S h hhrange hfun z - have hz : (z : Real × Real) ∈ Set.range h := by - rw [hhrange] - exact z.property - rcases hz with ⟨x, hx⟩ - refine ⟨x, ?_⟩ - apply Subtype.ext - exact hx - -private theorem hphi_mono : - ∀ (S : Set (ℝ × ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (hgrange : Set.range g = S), ∀ (hhrange : Set.range - h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ - ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ - (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ - let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ - ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), - let GH := Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont - let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont - let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm - let x0 : Set.Icc (0 : Real) 1 := ⟨0, by norm_num⟩ - let x1 : Set.Icc (0 : Real) 1 := ⟨1, by norm_num⟩ - (phi x0 = x0) → ((phi x1 = x1) → (StrictMono phi)) := by - classical - intro S g h hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he - hgfun_cont hhfun_cont GH HH phi x0 x1 hphi0 hphi1 - rcases phi.continuous.strictMono_of_inj phi.injective with hm | hm - · exact hm - · have h01 : x0 < x1 := by norm_num [x0, x1] - have := hm h01 - rw [hphi0, hphi1] at this - have hle : x0 ≤ x1 := by norm_num [x0, x1] - exact False.elim ((not_lt_of_ge hle) this) +private abbrev hhfun_surj := + ApollonianSuperharmonic.ArcComparisonMainProof.ArcComparisonCoreFacts.hgfun_surj private theorem hx0L : ∀ (S : Set (ℝ × ℝ)), @@ -1199,8 +1156,17 @@ private theorem compareCore : have hphi1 : phi x1 = x1 := by apply hhinj rw [hrel, hgb, hhb] - have hphi_mono : StrictMono phi := ArcComparisonCoreFacts.hphi_mono S g h hgrange hhrange - hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi0 hphi1 + have hphi_mono : StrictMono phi := (show + StrictMono phi + from by + classical + rcases phi.continuous.strictMono_of_inj phi.injective with hm | hm + · exact hm + · have h01 : x0 < x1 := by norm_num [x0, x1] + have := hm h01 + rw [hphi0, hphi1] at this + have hle : x0 ≤ x1 := by norm_num [x0, x1] + exact False.elim ((not_lt_of_ge hle) this)) let i0 : Fin p.count := ⟨0, p.positive⟩ let j0 : Fin q.count := ⟨0, q.positive⟩ let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean index b54e351ee2..306a955f99 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean @@ -605,24 +605,8 @@ private theorem sourceE₁ : intro u v l₁ l₂ heq exact (hedge₁ {u, v}).mpr (Or.inr ⟨u, v, l₁, l₂, heq, rfl⟩)) -private theorem sourceE₂ : - ∀ (E₂ : Set (Finset GaussianInt)), ∀ (p₂ : List GaussianInt), ∀ (a₂ : GaussianInt), ∀ (b₂ : - GaussianInt), (p₂.head? = some a₂) → ((p₂.getLast? = some b₂) → ((∀ (e : Finset - GaussianInt), e ∈ E₂ ↔ e = {b₂, a₂} ∨ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List - GaussianInt) (l₂ : List GaussianInt), p₂ = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((∀ (p : - List GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (E : Set (Finset - GaussianInt)), (p.head? = some a) → ((p.getLast? = some b) → ((({b, a} : Finset - GaussianInt) ∈ E) → ((∀ u, ∀ v, ∀ l₁, ∀ l₂, p = l₁ ++ u :: v :: l₂ → ({u, v} : Finset - GaussianInt) - ∈ E) → (Cycle.Chain (fun u v => ({u, v} : Finset GaussianInt) ∈ E) (p : Cycle - GaussianInt)))))) → (Cycle.Chain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₂) - (p₂ : Cycle GaussianInt))))) := by - classical - intro E₂ p₂ a₂ b₂ hhead₂ hlast₂ hedge₂ sourceEdgeChain - exact sourceEdgeChain p₂ a₂ b₂ E₂ hhead₂ hlast₂ - ((hedge₂ {b₂, a₂}).mpr (Or.inl rfl)) (by - intro u v l₁ l₂ heq - exact (hedge₂ {u, v}).mpr (Or.inr ⟨u, v, l₁, l₂, heq, rfl⟩)) +private abbrev sourceE₂ := + ApollonianSuperharmonic.MixedCycleDetails.sourceE₁ private theorem hp₂cycleeq : ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), (p₂.idxOf x < p₂.length) → ( @@ -1042,69 +1026,6 @@ private theorem hcloseP : have h := hPplusX.rel_getLast_head_of_append hpne (by simp) simpa using h -private theorem hpUnionChain : - ∀ (V₁ : Set GaussianInt), ∀ (E₁ : Set (Finset GaussianInt)), ∀ (E₂ : Set (Finset - GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) - ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₂ := c₂.tail.takeWhile good - let prefix₁ := c₁.tail.takeWhile good₁ - let Q := x :: (prefix₂ ++ [z]) - let edgeRel (u v : GaussianInt) : Prop := - ({u, v} : Finset GaussianInt) ∈ E₁ ∪ E₂ - let p := Q ++ prefix₁ - ((p ++ [x]).IsChain edgeRel) → (p.IsChain edgeRel)) := by - classical - intro V₁ E₁ E₂ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q edgeRel p hpPlusUnion - have h := hpPlusUnion.left_of_append - simpa using h - -private theorem hcloseUnion : - ∀ (V₁ : Set GaussianInt), ∀ (E₁ : Set (Finset GaussianInt)), ∀ (E₂ : Set (Finset - GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) - ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₂ := c₂.tail.takeWhile good - let prefix₁ := c₁.tail.takeWhile good₁ - let Q := x :: (prefix₂ ++ [z]) - let edgeRel (u v : GaussianInt) : Prop := - ({u, v} : Finset GaussianInt) ∈ E₁ ∪ E₂ - let p := Q ++ prefix₁ - ∀ (hpne : p ≠ []), ((p ++ [x]).IsChain edgeRel) → (edgeRel (p.getLast hpne) x)) := by - classical - intro V₁ E₁ E₂ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q edgeRel p hpne hpPlusUnion - have h := hpPlusUnion.rel_getLast_head_of_append hpne (by simp) - simpa using h - -private theorem hadjUnion : - ∀ (V₁ : Set GaussianInt), ∀ (E₁ : Set (Finset GaussianInt)), ∀ (E₂ : Set (Finset - GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) - ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₂ := c₂.tail.takeWhile good - let prefix₁ := c₁.tail.takeWhile good₁ - let Q := x :: (prefix₂ ++ [z]) - let edgeRel (u v : GaussianInt) : Prop := - ({u, v} : Finset GaussianInt) ∈ E₁ ∪ E₂ - let p := Q ++ prefix₁ - (p.IsChain edgeRel) → (∀ a, ∀ b, ∀ l₁, ∀ l₂, p = l₁ ++ a :: b :: l₂ → edgeRel a b)) := by - classical - intro V₁ E₁ E₂ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q edgeRel p hpUnionChain - rw [List.isChain_iff_forall_rel_of_append_cons_cons] at hpUnionChain - exact hpUnionChain - private theorem hadjP : ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), @@ -1537,11 +1458,12 @@ theorem P3963T1MixedBoundaryCycle z w hpne hPplusX have hpPlusUnion : (p ++ [x]).IsChain edgeRel := by simpa [p, R, prefix₁, List.append_assoc] using hPplusUnion - have hpUnionChain := MixedCycleDetails.hpUnionChain V₁ E₁ E₂ p₁ p₂ x z w - hpPlusUnion - have hcloseUnion := MixedCycleDetails.hcloseUnion V₁ E₁ E₂ p₁ p₂ x - z w hpne hpPlusUnion - have hadjUnion := MixedCycleDetails.hadjUnion V₁ E₁ E₂ p₁ p₂ x z w hpUnionChain + have hpUnionChain : p.IsChain edgeRel := by + simpa using hpPlusUnion.left_of_append + have hcloseUnion : edgeRel (p.getLast hpne) x := by + simpa using hpPlusUnion.rel_getLast_head_of_append hpne (by simp) + have hadjUnion : ∀ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ → edgeRel a b := + List.isChain_iff_forall_rel_of_append_cons_cons.mp hpUnionChain have hphead : p.head? = some x := by simp [p, Q] have hplast : p.getLast? = some (p.getLast hpne) := List.getLast?_eq_some_getLast hpne let v := p.getLast hpne diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean b/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean index d049f35261..d85ccd3b5e 100644 --- a/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean +++ b/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean @@ -582,47 +582,6 @@ private theorem first_center : bundle.configuration.proper i (i + 1) (i + 2) hcyc).1 exact centerAlgFirst _ _ _ _ (flip_incoming i) halg -private theorem second_center : - (by - classical - exact - ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : - PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), (∀ (i : Fin 3), - BandVectors.1 (bundle.normalizedPresentation 0) (bundle.normalizedPresentation - i.succ) = (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (bundle.normalizedPresentation - i.succ) (bundle.normalizedPresentation 0)) → ( - let I : GaussianInt := ⟨0, 1⟩ - let branchDisplacement (i : Fin 3) : Real × Real := - (1 / 2 : Real) • GaussianRealPoint ((I - 1) * - BandVectors.1 (bundle.normalizedPresentation i.succ) - (bundle.normalizedPresentation 0)) - let quarterTurn (p : Real × Real) : Real × Real := (-p.2, p.1) - let cOff (w : GaussianInt) : Real × Real := - (1 / 2 : Real) • (GaussianRealPoint w - - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) - let edgeCenter (a : GaussianInt) : Real × Real := - (1 / 2 : Real) • GaussianRealPoint ((I - 1) * a) - (∀ (e : GaussianInt), ∀ (d : GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (b = - I * a) → ((-(1 - I) * e + 2 * d = -(a + b)) → (-cOff e + GaussianRealPoint d = - quarterTurn (edgeCenter a)))) → ( - let q := bundle.normalizedPresentation - let o (i : Fin 3) := BandVectors.1 (q 0) (q i.succ) - let e (i : Fin 3) := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) - let d (i : Fin 3) := cOff (e i) - ∀ (i : Fin 3), -d i + GaussianRealPoint (o (i + 1)) = quarterTurn (branchDisplacement - i))) ) := by - classical - intro C D T N h k x bundle flip_incoming I branchDisplacement quarterTurn cOff edgeCenter - centerAlgSecond q o e d i - have hcyc : (i + 2 = 0 ∧ i = 1 ∧ i + 1 = 2) ∨ - (i + 2 = 1 ∧ i = 2 ∧ i + 1 = 0) ∨ - (i + 2 = 2 ∧ i = 0 ∧ i + 1 = 1) := by - fin_cases i <;> decide - have halg := (P3045T1RightBoundaryDisplacementAlgebra q - bundle.configuration.proper (i + 2) i (i + 1) hcyc).2.1 - exact centerAlgSecond _ _ _ _ (flip_incoming i) halg - private theorem cyclic_slots : (by classical @@ -1108,46 +1067,6 @@ private theorem row_data : · simp [hs, period0, period1, third_period] abel -private theorem identify : - (by - classical - exact - ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : - PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : - BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration - bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed - bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint - bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign - bundle.routedDirection), - let occurrence := SubtileOccurrenceInterpretation placement.layout.P - placement.layout.u placement.layout.v - let I : GaussianInt := ⟨0, 1⟩ - let branchDisplacement (i : Fin 3) : Real × Real := - (1 / 2 : Real) • GaussianRealPoint ((I - 1) * - BandVectors.1 (bundle.normalizedPresentation i.succ) - (bundle.normalizedPresentation 0)) - (∀ (i : Fin 3), branchDisplacement i ≠ (0, 0)) → ( - let quarterTurn (p : Real × Real) : Real × Real := (-p.2, p.1) - let branchCenter (E : Real × Real) (b : Fin 4) : Real × Real := - if b = 0 then -E - else if b = 1 then quarterTurn E - else if b = 2 then E - else -quarterTurn E - (∀ (E : Real × Real), (E ≠ (0, 0)) → (∀ (b : Fin 4), ∀ (c : Fin 4), (b ≠ c) → - (branchCenter E b ≠ branchCenter E c))) → ( - let exteriorCenter := TileCentroid (occurrence placement.exteriorIndex) - - TileCentroid bundle.normalizedFixed - ∀ (n : Fin (4 : ℕ)), (exteriorCenter = branchCenter (branchDisplacement - bundle.selectedSlot) n) → (∀ (m : Fin 4), (exteriorCenter = branchCenter - (branchDisplacement bundle.selectedSlot) m) → (n = m)))) ) := by - classical - intro C D T N h k x bundle placement occurrence I branchDisplacement branchDisplacement_nonzero - quarterTurn branchCenter four_centers_distinct exteriorCenter n hrow m hc - by_contra hne - exact (four_centers_distinct _ (branchDisplacement_nonzero _) n m hne) - (hrow.symm.trans hc) - end PlacementCompanionGeometry theorem P3996T1PlacementCompanionBlocks @@ -1250,8 +1169,19 @@ theorem P3996T1PlacementCompanionBlocks let d (i : Fin 3) := cOff (e i) have first_center := PlacementCompanionGeometry.first_center C D T N h k x bundle flip_incoming (PlacementCompanionGeometry.centerAlgFirst cancel2) - have second_center := PlacementCompanionGeometry.second_center C D T N h k x bundle - flip_incoming (PlacementCompanionGeometry.centerAlgSecond cancel2) + have second_center := (show + ∀ (i : Fin 3), -d i + GaussianRealPoint (o (i + 1)) = quarterTurn + (branchDisplacement i) + from by + classical + intro i + have hcyc : (i + 2 = 0 ∧ i = 1 ∧ i + 1 = 2) ∨ + (i + 2 = 1 ∧ i = 2 ∧ i + 1 = 0) ∨ + (i + 2 = 2 ∧ i = 0 ∧ i + 1 = 1) := by + fin_cases i <;> decide + have halg := (P3045T1RightBoundaryDisplacementAlgebra q + bundle.configuration.proper (i + 2) i (i + 1) hcyc).2.1 + exact ((PlacementCompanionGeometry.centerAlgSecond cancel2)) _ _ _ _ (flip_incoming i) halg) let exteriorCenter := TileCentroid (occurrence placement.exteriorIndex) - TileCentroid bundle.normalizedFixed have placement_center : exteriorCenter = @@ -1277,8 +1207,15 @@ theorem P3996T1PlacementCompanionBlocks translate_center) (PlacementCompanionGeometry.raw_centers C D T N h k x bundle first_center second_center) obtain ⟨n, hrow, hshift⟩ := row_data - have identify := PlacementCompanionGeometry.identify C D T N h k x bundle placement - branchDisplacement_nonzero four_centers_distinct n hrow + have identify := (show + ∀ (m : Fin 4), (exteriorCenter = branchCenter (branchDisplacement + bundle.selectedSlot) m) → (n = m) + from by + classical + intro m hc + by_contra hne + exact (four_centers_distinct _ (branchDisplacement_nonzero _) n m hne) + (hrow.symm.trans hc)) refine ⟨?_, ?_, ?_, ?_⟩ · intro hbranch have hn := identify 0 (placement_centers.1 hbranch) diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean index 8eaf15e260..64b7146b0e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean @@ -131,24 +131,8 @@ private theorem hWpCent : all_goals rw [haUre, haUim, haWre, haWim] all_goals dsimp; ring -private theorem hZpCent : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (Z : ProtoTile), ∀ (aU : GaussianInt), ∀ (aZ : GaussianInt), - let Zp := TileTranslation Z (aU - aZ) - ((aU.re : Real) = (TileCentroid U).1 + (TileCentroid U).2) → (((aU.im : Real) = - (TileCentroid U).2 - (TileCentroid U).1) → (((aZ.re : Real) = (TileCentroid Z).1 + - (TileCentroid Z).2) → (((aZ.im : Real) = (TileCentroid Z).2 - (TileCentroid Z).1) → - (TileCentroid Zp - TileCentroid U = (-(TileCentroid Z - TileCentroid U).2, - (TileCentroid Z - TileCentroid U).1))))) ) := by - classical - intro U Z aU aZ Zp haUre haUim haZre haZim - rw [(TileTranslationFormulas Z (aU - aZ)).2.2.2.2.1] - ext <;> simp only [] - all_goals simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Int.cast_sub] - all_goals rw [haUre, haUim, haZre, haZim] - all_goals dsimp; ring +private abbrev hZpCent := + ApollonianSuperharmonic.OppositeEndpointGeometry.hWpCent private theorem hWrot : (by @@ -496,26 +480,8 @@ private theorem hFvW : funext x simp [F, GaussianTranslation] -private theorem hFvZ : - (by - classical - exact - ∀ (Z : ProtoTile), ∀ (aU : GaussianInt), ∀ (aZ : GaussianInt), (FootprintVertices - (TileTranslation (TileQuarterTurn Z) aZ) = FootprintVertices Z) → ( - let Zp := TileTranslation Z (aU - aZ) - let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU - FootprintVertices Zp = F '' FootprintVertices Z) ) := by - classical - intro Z aU aZ hZv Zp F - rw [(TileTranslationFormulas Z (aU - aZ)).2.2.2.2.2.1] - conv_lhs => rw [← hZv] - rw [ - (TileTranslationFormulas (TileQuarterTurn Z) aZ).2.2.2.2.2.1, - (TileQuarterTurnFormulas Z).2.2.2.2.2.1] - simp only [Set.image_image] - congr 1 - funext x - simp [F, GaussianTranslation] +private abbrev hFvZ := + ApollonianSuperharmonic.OppositeEndpointGeometry.hFvW private theorem hFeW : (by @@ -540,28 +506,8 @@ private theorem hFeW : ext x simp [F, GaussianTranslation] -private theorem hFeZ : - (by - classical - exact - ∀ (Z : ProtoTile), ∀ (aU : GaussianInt), ∀ (aZ : GaussianInt), - let Zp := TileTranslation Z (aU - aZ) - let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU - (FootprintEdges (TileTranslation (TileQuarterTurn Z) aZ) = FootprintEdges Z) → - (FootprintEdges Zp = (fun e : Finset GaussianInt => e.image F) '' FootprintEdges Z) ) - := by - classical - intro Z aU aZ Zp F hZedges - rw [(TileTranslationFormulas Z (aU - aZ)).2.2.2.2.2.2.1] - conv_lhs => rw [← hZedges] - rw [ - (TileTranslationFormulas (TileQuarterTurn Z) aZ).2.2.2.2.2.2.1, - (TileQuarterTurnFormulas Z).2.2.2.2.2.2.1] - simp only [Set.image_image, Finset.image_image] - congr 1 - funext e - ext x - simp [F, GaussianTranslation] +private abbrev hFeZ := + ApollonianSuperharmonic.OppositeEndpointGeometry.hFeW private theorem hinvV : (by @@ -778,23 +724,8 @@ private theorem hparentWV : (hinvV _).symm _ = f '' FootprintVertices Wp := by rw [hFvW] -private theorem hparentZV : - (by - classical - exact - ∀ (Z : ProtoTile), ∀ (aU : GaussianInt), ∀ (aZ : GaussianInt), - let Zp := TileTranslation Z (aU - aZ) - let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU - let f : GaussianInt → GaussianInt := fun x => - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) - (FootprintVertices Zp = F '' FootprintVertices Z) → ((∀ (S : Set GaussianInt), f '' (F '' - S) = S) → (FootprintVertices Z = f '' FootprintVertices Zp)) ) := by - classical - intro Z aU aZ Zp F f hFvZ hinvV - calc - FootprintVertices Z = f '' (F '' FootprintVertices Z) := - (hinvV _).symm - _ = f '' FootprintVertices Zp := by rw [hFvZ] +private abbrev hparentZV := + ApollonianSuperharmonic.OppositeEndpointGeometry.hparentWV private theorem hparentWE : (by @@ -818,27 +749,8 @@ private theorem hparentWE : _ = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges Wp := by rw [hFeW] -private theorem hparentZE : - (by - classical - exact - ∀ (Z : ProtoTile), ∀ (aU : GaussianInt), ∀ (aZ : GaussianInt), - let Zp := TileTranslation Z (aU - aZ) - let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU - let f : GaussianInt → GaussianInt := fun x => - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) - (FootprintEdges Zp = (fun e : Finset GaussianInt => e.image F) '' FootprintEdges Z) → ((∀ - (E : Set (Finset GaussianInt)), (fun e : Finset GaussianInt => e.image f) '' ((fun e - : Finset GaussianInt => e.image F) '' E) = E) → (FootprintEdges Z = (fun e : Finset - GaussianInt => e.image f) '' FootprintEdges Zp)) ) := by - classical - intro Z aU aZ Zp F f hFeZ hinvE - calc - FootprintEdges Z = (fun e : Finset GaussianInt => e.image f) '' - ((fun e : Finset GaussianInt => e.image F) '' FootprintEdges Z) := - (hinvE _).symm - _ = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges Zp := by - rw [hFeZ] +private abbrev hparentZE := + ApollonianSuperharmonic.OppositeEndpointGeometry.hparentWE private theorem hchildV : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean index 96276344b1..18eba90257 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacianProperties public import LeanPool.ApollonianSuperharmonic.FordInteriorSquareCoordinates public import LeanPool.ApollonianSuperharmonic.FordOdometer @@ -131,31 +132,6 @@ private theorem hrec₃' : intro P P₂ hrec₃ x hx simpa [FordOdometer] using hrec₃ x hx -private theorem hlapAffine : - (by - classical - exact - ∀ (f : GaussianInt → ℤ), ∀ (f' : GaussianInt → ℤ), ∀ (x : GaussianInt), ∀ (t : - GaussianInt), ∀ (A : ℤ), ∀ (B : ℤ), ∀ (C : ℤ), f x = f' (x - t) + A * x.re + B * x.im - + C → f (x - (1 : GaussianInt)) = f' (x - t - (1 : GaussianInt)) + A * (x - (1 : - GaussianInt)).re + B * (x - (1 : GaussianInt)).im + C → f (x + (1 : GaussianInt)) = - f' (x - t + (1 : GaussianInt)) + A * (x + (1 : GaussianInt)).re + B * (x + (1 : - GaussianInt)).im + C → f (x - ⟨(0 : ℤ), (1 : ℤ)⟩) = f' (x - t - ⟨(0 : ℤ), (1 : ℤ)⟩) + - A * (x - ⟨(0 : ℤ), (1 : ℤ)⟩).re + B * (x - ⟨(0 : ℤ), (1 : ℤ)⟩).im + C → f (x + ⟨(0 : - ℤ), (1 : ℤ)⟩) = f' (x - t + ⟨(0 : ℤ), (1 : ℤ)⟩) + A * (x + ⟨(0 : ℤ), (1 : ℤ)⟩).re + B - * (x + ⟨(0 : ℤ), (1 : ℤ)⟩).im + C → FourNeighborLaplacian f x = FourNeighborLaplacian - f' (x - t) ) := by - classical - intro f f' x t A B C h0 hm hp hmi hpi - rw [FourNeighborLaplacian, hm, hp, hmi, hpi, h0, - FourNeighborLaplacian] - rw [show x - t - 1 = (x - t) - 1 by abel, - show x - t + 1 = (x - t) + 1 by abel, - show x - t - ⟨0, 1⟩ = (x - t) - ⟨0, 1⟩ by rfl, - show x - t + ⟨0, 1⟩ = (x - t) + ⟨0, 1⟩ by rfl] - simp - ring - private theorem hrec0Member : (by classical @@ -475,83 +451,6 @@ private theorem htargetAt327 : simp only [Zsqrtd.im_add] omega) using 1; ring -private theorem hyAt433 : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (FordFareyParameter) → (∀ (hP : - (2 : ℕ) < P.q), (∀ (q : Nat), ∀ (x : GaussianInt), x ∈ - P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : - Int) - 1) → (∀ (hsum : P.q = P.q₁ + P.q₂), ∀ (hcrossdet : P.p₁ * (P.q₂ : Int) - P.p₂ * - (P.q₁ : Int) = 1), ∀ (hpos₁ : 0 < P.q₁), ∀ (hpos₂ : 0 < P.q₂), ∀ (horder : P.q₂ < - P.q₁), ∀ (hdlt : P.q₁ - P.q₂ < P.q), ∀ (hdetdiff : (P.p₁-P.p₂) * (P.q₁ : Int) - - ((P.q₁-P.q₂ : Nat) : Int) * P.p₁ = 1), ∀ (H : FordFareyParameter), ∀ (hHq : H.q = - P.q₁ - P.q₂), ∀ (hredParent : Nat.Coprime P.q₁ P.p₁.natAbs), - let Q : FordFareyParameter := by - have hdet₂ : P.p₂ * (P.q₁ : Int) - - (P.q₂ : Int) * P.p₁ = -1 := by nlinarith only [hcrossdet] - refine FordFareyParameter.mk P.p₁ P.q₁ hpos₁ hredParent - (P.p₁-P.p₂) (P.q₁-P.q₂) P.p₂ P.q₂ ?_ ?_ ?_ ?_ ?_ ?_ ?_ - · ring - · omega - · exact hdetdiff - · exact hdet₂ - · omega - · exact hpos₂ - · intro hu - have : P.q₁ = 1 := by simpa using hu - omega - ∀ (R : FordFareyParameter), (R.p = P.p₁ ∧ R.q = P.q₁) → ((Q.p₁ = P.p₁-P.p₂ ∧ Q.q₁ = - P.q₁-P.q₂ ∧ Q.p₂ = P.p₂ ∧ Q.q₂ = P.q₂) → ((P₁.p₁ = P.p₁-P.p₂ ∧ P₁.q₁ = P.q₁-P.q₂ ∧ - P₁.p₂ = P.p₂ ∧ P₁.q₂ = P.q₂) → (∀ (x : GaussianInt), ((↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.re ∧ - x.re ≤ (↑P.q₁ : ℤ) - (1 : ℤ) ∧ (↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₁ : ℤ) - (1 - : ℤ)) → ( - let y : GaussianInt := x-⟨(P.q₂ : Int),(P.q₂ : Int)⟩ - y ∈ P4062T1InteriorSquare (P.q₁-P.q₂)))))))) := by - classical - intro P P₁ P₂ hP squareCoordinates hsum hcrossdet hpos₁ hpos₂ horder hdlt hdetdiff H hHq - hredParent Q R hR hpar hparP x hc y - apply (squareCoordinates (P.q₁-P.q₂) y).mpr - dsimp [y] - rw [Nat.cast_sub (by omega : P.q₂ ≤ P.q₁)] - exact ⟨by omega, by omega, by omega, by omega⟩ - -private theorem hcastAt445 : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (FordFareyParameter) → (∀ (hP : - (2 : ℕ) < P.q), ∀ (hsum : P.q = P.q₁ + P.q₂), ∀ (hcrossdet : P.p₁ * (P.q₂ : - Int) - P.p₂ * (P.q₁ : Int) = 1), ∀ (hpos₁ : 0 < P.q₁), ∀ (hpos₂ : 0 < P.q₂), ∀ - (horder : P.q₂ < P.q₁), ∀ (hdlt : P.q₁ - P.q₂ < P.q), ∀ (hdetdiff : (P.p₁-P.p₂) * - (P.q₁ : Int) - ((P.q₁-P.q₂ : Nat) : Int) * P.p₁ = 1), ∀ (H : FordFareyParameter), ∀ - (hHq : H.q = P.q₁ - P.q₂), ∀ (hredParent : Nat.Coprime P.q₁ P.p₁.natAbs), - let Q : FordFareyParameter := by - have hdet₂ : P.p₂ * (P.q₁ : Int) - - (P.q₂ : Int) * P.p₁ = -1 := by nlinarith only [hcrossdet] - refine FordFareyParameter.mk P.p₁ P.q₁ hpos₁ hredParent - (P.p₁-P.p₂) (P.q₁-P.q₂) P.p₂ P.q₂ ?_ ?_ ?_ ?_ ?_ ?_ ?_ - · ring - · omega - · exact hdetdiff - · exact hdet₂ - · omega - · exact hpos₂ - · intro hu - have : P.q₁ = 1 := by simpa using hu - omega - ∀ (R : FordFareyParameter), (R.p = P.p₁ ∧ R.q = P.q₁) → ((Q.p₁ = P.p₁-P.p₂ ∧ Q.q₁ = - P.q₁-P.q₂ ∧ Q.p₂ = P.p₂ ∧ Q.q₂ = P.q₂) → ((P₁.p₁ = P.p₁-P.p₂ ∧ P₁.q₁ = P.q₁-P.q₂ ∧ - P₁.p₂ = P.p₂ ∧ P₁.q₂ = P.q₂) → ((GaussianInt) → ((H.q : Int) = (P.q₁ : - Int)-P.q₂)))))) := by - classical - intro P P₁ P₂ hP hsum hcrossdet hpos₁ hpos₂ horder hdlt hdetdiff H hHq hredParent Q R hR hpar - hparP y - calc - (H.q : Int) = ((P.q₁-P.q₂ : Nat) : Int) := by exact_mod_cast hHq - _ = (P.q₁ : Int)-P.q₂ := by - rw [Nat.cast_sub (by omega : P.q₂ ≤ P.q₁)] - private theorem hdetdiffAt465 : (by classical @@ -952,8 +851,8 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) (hmi : f (x - ⟨0, 1⟩) = f' ((x - t) - ⟨0, 1⟩) + A * (x - ⟨0, 1⟩).re + B * (x - ⟨0, 1⟩).im + C) (hpi : f (x + ⟨0, 1⟩) = f' ((x - t) + ⟨0, 1⟩) + - A * (x + ⟨0, 1⟩).re + B * (x + ⟨0, 1⟩).im + C) := OverlapDescentDetails.hlapAffine f f' x - t A B C h0 hm hp hmi hpi + A * (x + ⟨0, 1⟩).re + B * (x + ⟨0, 1⟩).im + C) := + FourNeighborLaplacianProperties.affineTranslate f f' x t A B C h0 hm hp hmi hpi have hrec0Member (z : GaussianInt) (a : 0 ≤ z.re) (b : z.re ≤ (P.q₁ : Int)) (c : 0 ≤ z.im) (d : z.im ≤ (P.q₁ : Int)) := OverlapDescentDetails.hrec0Member P z a b c d @@ -1029,9 +928,11 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) · intro hx have hc := hcoords x hx let y : GaussianInt := x-⟨(P.q₂ : Int),(P.q₂ : Int)⟩ - have hy := OverlapDescentDetails.hyAt433 P P₁ P₂ - hP squareCoordinates hsum hcrossdet hpos₁ hpos₂ horder hdlt hdetdiff H hHq hredParent R - hR hpar hparP x hc + have hy : y ∈ P4062T1InteriorSquare (P.q₁-P.q₂) := by + apply (squareCoordinates (P.q₁-P.q₂) y).mpr + dsimp [y] + rw [Nat.cast_sub (by omega : P.q₂ ≤ P.q₁)] + exact ⟨by omega, by omega, by omega, by omega⟩ refine Finset.mem_image.mpr ⟨y, ?_, ?_⟩ · simpa [hHq] using hy · dsimp [y] @@ -1039,8 +940,8 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) · intro hx obtain ⟨y, hy, hxy⟩ := Finset.mem_image.mp hx have hyc := (squareCoordinates H.q y).mp hy - have hcast := OverlapDescentDetails.hcastAt445 P P₁ P₂ hP - hsum hcrossdet hpos₁ hpos₂ horder hdlt hdetdiff H hHq hredParent R hR hpar hparP y + have hcast : (H.q : Int) = (P.q₁ : Int)-P.q₂ := by + rw [hHq, Nat.cast_sub (by omega : P.q₂ ≤ P.q₁)] subst x apply Finset.mem_inter.mpr constructor diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean index 07402ca4c2..fe879d5f96 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacianProperties public import LeanPool.ApollonianSuperharmonic.FordInteriorSquareCoordinates public import LeanPool.ApollonianSuperharmonic.P4062T1RecursiveInteriors @@ -95,27 +96,6 @@ private theorem hrecursive : · intro x hx simpa [FordOdometer] using rec₃ x hx -private theorem hlapAffine : - ∀ (f : GaussianInt → ℤ), ∀ (f' : GaussianInt → ℤ), ∀ (x : GaussianInt), ∀ (t : GaussianInt), - ∀ (A : ℤ), ∀ (B : ℤ), ∀ (C : ℤ), f x = f' (x - t) + A * x.re + B * x.im + C → f (x - (1 : - GaussianInt)) = f' (x - t - (1 : GaussianInt)) + A * (x - (1 : GaussianInt)).re + B * (x - - (1 : GaussianInt)).im + C → f (x + (1 : GaussianInt)) = f' (x - t + (1 : GaussianInt)) - + A * (x + (1 : GaussianInt)).re + B * (x + (1 : GaussianInt)).im + C → f (x - ⟨(0 : ℤ), - (1 : ℤ)⟩) = f' (x - t - ⟨(0 : ℤ), (1 : ℤ)⟩) + A * (x - ⟨(0 : ℤ), (1 : ℤ)⟩).re + B * (x - - ⟨(0 : ℤ), (1 : ℤ)⟩).im + C → f (x + ⟨(0 : ℤ), (1 : ℤ)⟩) = f' (x - t + ⟨(0 : ℤ), (1 : ℤ)⟩) - + A * (x + ⟨(0 : ℤ), (1 : ℤ)⟩).re + B * (x + ⟨(0 : ℤ), (1 : ℤ)⟩).im + C → - FourNeighborLaplacian f x = FourNeighborLaplacian f' (x - t) := by - classical - intro f f' x t A B C h0 hm hp hmi hpi - rw [FourNeighborLaplacian, hm, hp, hmi, hpi, h0, - FourNeighborLaplacian] - rw [show x - t - 1 = (x - t) - 1 by abel, - show x - t + 1 = (x - t) + 1 by abel, - show x - t - ⟨0, 1⟩ = (x - t) - ⟨0, 1⟩ by rfl, - show x - t + ⟨0, 1⟩ = (x - t) + ⟨0, 1⟩ by rfl] - simp - ring - private theorem hchild0Lap : ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (FordFareyParameter) → ((P₁.q = P.q₁) → ((∀ x ∈ FordRecursiveVertexDomains P (0 : Fin (4 : ℕ)), FordOdometer P x = @@ -375,7 +355,7 @@ theorem P4062T1ParentalRestriction (P : FordFareyParameter) (hpi : f (x + ⟨0, 1⟩) = f' ((x - t) + ⟨0, 1⟩) + A * (x + ⟨0, 1⟩).re + B * (x + ⟨0, 1⟩).im + C) : FourNeighborLaplacian f x = FourNeighborLaplacian f' (x - t) := - ParentalRestrictionProof.hlapAffine f f' x t A B C h0 hm hp hmi hpi + FourNeighborLaplacianProperties.affineTranslate f f' x t A B C h0 hm hp hmi hpi have hrec0Member (z : GaussianInt) (hzr : 0 ≤ z.re) (hzr' : z.re ≤ (P.q₁ : Int)) (hzi : 0 ≤ z.im) (hzi' : z.im ≤ (P.q₁ : Int)) : diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean index d5d3cd66bb..3a0e2dc6df 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean @@ -85,16 +85,8 @@ private theorem q2posI : intro P exact_mod_cast P.q₂_pos -private theorem cross : - ∀ (P : FordFareyParameter), P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 := by - classical - intro P - have h1 : P.p₁ * ((P.q₁ + P.q₂ : Nat) : Int) - - (P.q₁ : Int) * (P.p₁ + P.p₂) = 1 := by - simpa [P.sum_q, P.sum_p] using P.det₁ - norm_num [Nat.cast_add] at h1 - nlinarith [h1] - +private abbrev cross := + FordFareySum.determinant private theorem unequal : ∀ (P : FordFareyParameter), (2 < P.q) → ((0 < (P.q₂ : Int)) → ((P.p₁ * (P.q₂ : Int) - (P.q₁ : diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean index 451d634432..254048174e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean @@ -1302,22 +1302,8 @@ private theorem he_ne_aAt851 : simpa [heq] using hcfA exact (Finset.disjoint_left.mp hdisET) hcfE (U_in_T hcf) -private theorem he_ne_bAt858 : - (by - classical - exact - ∀ (Ci : BandCircle), ∀ (T' : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (PP : - PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (V : ProtoTile), ∀ (b : ↥(TilingLattice - Ci)), (PP.tile b = V) → ((V.cells ⊆ T'.cells) → (∀ (cb : LatticeCell), (cb ∈ V.cells) - → (∀ (e : ↥(TilingLattice Ci)), (PP.tile e = Rplus) → ((Disjoint Rplus.cells - T'.cells) → (e ≠ b))))) ) := by - classical - intro Ci T' Rplus PP V b hVb V_in_T' cb hcb e he hdisET' heq - have hcbB : cb ∈ (PP.tile b).cells := by simpa [hVb] using hcb - have hcbE : cb ∈ Rplus.cells := by - rw [← he] - simpa [heq] using hcbB - exact (Finset.disjoint_left.mp hdisET') hcbE (V_in_T' hcb) +private abbrev he_ne_bAt858 := + ApollonianSuperharmonic.EdgeSectorGeometry.he_ne_bAt755 private theorem ht_ne_eAt866 : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean index fe5eed4b29..4052598104 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean @@ -224,23 +224,8 @@ private theorem hcentT : simp only [TileCentroid, ite_eq_left hTnon, ite_eq_left htn] rw [hu.1] -private theorem hcentT' : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), ∀ (H : - PartialOdometer), ∀ (v : GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) - v).cells ∧ (T'.cells = ∅ → T'.anchor = (TileTranslation (FordTile P.q) v).anchor) ∧ ∃ - (a : GaussianInt) (b : ℤ), (∀ (x : GaussianInt), x ∈ h'.domain ↔ x - v ∈ H.domain) ∧ - ∀ x ∈ h'.domain, h'.value x = H.value (x - v) + a.re * x.re + a.im * x.im + b) → - (((FordTile P.q).cells.Nonempty) → ((T'.cells.Nonempty) → (TileCentroid T' = - TileCentroid (TileTranslation (FordTile P.q) v)))) ) := by - classical - intro P T' h' H v hv hFnon hT'non - have htn : (TileTranslation (FordTile P.q) v).cells.Nonempty := by - simpa [TileTranslation] using hFnon.image (GaussianTranslation v) - simp only [TileCentroid, ite_eq_left hT'non, ite_eq_left htn] - rw [hv.1] +private abbrev hcentT' := + ApollonianSuperharmonic.MatchedFordGeometry.hcentT private theorem hfordcent : (by @@ -587,24 +572,8 @@ private theorem footprintT : simp only [ite_eq_left htn] rw [hu.1] -private theorem footprintT' : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), ∀ (H : - PartialOdometer), ∀ (v : GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) - v).cells ∧ (T'.cells = ∅ → T'.anchor = (TileTranslation (FordTile P.q) v).anchor) ∧ ∃ - (a : GaussianInt) (b : ℤ), (∀ (x : GaussianInt), x ∈ h'.domain ↔ x - v ∈ H.domain) ∧ - ∀ x ∈ h'.domain, h'.value x = H.value (x - v) + a.re * x.re + a.im * x.im + b) → - (((FordTile P.q).cells.Nonempty) → ((T'.cells.Nonempty) → (FootprintVertices T' = - FootprintVertices (TileTranslation (FordTile P.q) v)))) ) := by - classical - intro P T' h' H v hv hFnon hT'non - simp only [FootprintVertices, ite_eq_left hT'non] - have htn : (TileTranslation (FordTile P.q) v).cells.Nonempty := by - simpa [TileTranslation] using hFnon.image (GaussianTranslation v) - simp only [ite_eq_left htn] - rw [hv.1] +private abbrev footprintT' := + ApollonianSuperharmonic.MatchedFordGeometry.footprintT private theorem hinter : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean index fdc8cfca7c..d900a08de7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.ListEndpointFacts public import LeanPool.ApollonianSuperharmonic.AncestorOdometer public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile @@ -627,18 +628,8 @@ private theorem hRmem : rw [List.eq_cons_of_mem_head? hopt] simp -private theorem hSmem : - (by - classical - exact - ∀ (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), (tiles.getLast? = some Rplus) → (Rplus - ∈ tiles) ) := by - classical - intro Rplus tiles hlast - have hopt : Rplus ∈ tiles.getLast? := by simp [hlast] - obtain ⟨hne, hget⟩ := List.mem_getLast?_eq_getLast hopt - rw [hget] - exact List.getLast_mem hne +private abbrev hSmem := + @ListEndpointFacts.lastMembership ProtoTile private theorem hnotouch : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean index a139f4335f..5c507420b4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean @@ -656,48 +656,6 @@ private theorem neighbor_injective : intro x neighbor a b hab fin_cases a <;> fin_cases b <;> simp [neighbor, Zsqrtd.ext_iff] at hab ⊢ <;> omega -private theorem neighbor_exhaust : - (by - classical - exact - ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : - BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : - BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (D : Finset GaussianInt), ∀ (P : - Finset GaussianInt), ∀ (x : GaussianInt), (x ∈ D \ P) → ((x ∈ D) → ((x ∉ P) → ((x ∈ - FootprintVertices T ∧ x ∉ BoundaryFootprintVertices T) → ((∀ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell x j ∈ T.cells) → ((∀ (i : Fin 3), ∀ (s : Bool), (x ∈ - FootprintVertices (cert.P i s)) → (x ∈ BoundaryFootprintVertices (cert.P i s))) → ((∀ - {α : Type}, ∀ (F : α → ProtoTile), (∀ a, LatticeTile (F a)) → (∀ (owner : Fin 4 → α), - (∀ j, ∀ a, LatticeVertexIncidentCell x j ∈ (F a).cells ↔ owner j = a) → (¬ (owner 0 = - owner 2 ∧ owner 1 ≠ owner 0 ∧ owner 3 ≠ owner 0) ∧ ¬ (owner 1 = owner 3 ∧ owner 0 ≠ - owner 1 ∧ owner 2 ≠ owner 1)))) → ((∀ {α : Type}, ∀ (F : α → ProtoTile), (∀ a, ∀ b, a - ≠ b → Disjoint (F a).cells (F b).cells) → ((∀ j : Fin 4, ∃ a, - LatticeVertexIncidentCell x j ∈ (F a).cells) → (∃ owner : Fin 4 → α, ∀ j, ∀ a, - LatticeVertexIncidentCell x j ∈ (F a).cells ↔ owner j = a))) → (((∀ j : Fin 4, - LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∨ LatticeVertexIncidentCell x j - ∈ (cert.P 0 false).cells) → (∀ (j : Fin 4), (∃ i s, LatticeVertexIncidentCell x j ∈ - (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells) ↔ - (LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∧ LatticeVertexIncidentCell x - (j + 1) ∈ (cert.P 0 true).cells) ∨ (LatticeVertexIncidentCell x j ∈ (cert.P 0 - false).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P 0 false).cells))) → ( - let neighbor : Fin 4 → GaussianInt := ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] - (∀ (j : Fin 4), ∃ a b : Fin 4, LatticeVertexIncidentCell x j = LatticeVertexIncidentCell - (neighbor j) a ∧ LatticeVertexIncidentCell x (j + 1) = LatticeVertexIncidentCell - (neighbor j) b) → ((∀ (j : Fin 4), neighbor j ∈ P ↔ ∃ i s, LatticeVertexIncidentCell - x j ∈ (cert.P i s).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (cert.P i s).cells) - → ((Function.Injective neighbor) → ((∀ (j : Fin 4), FourNeighborAdjacent (neighbor j) - x) → (∀ (y : GaussianInt), (FourNeighborAdjacent y x) → (∃ j : Fin 4, neighbor j = - y)))))))))))))) ) := by - classical - intro C q cfg T cert D P x hx hxD hxP hxT hcells no_parent_interior no_diagonal label_sectors - common_parent_iff neighbor shared_cells neighbor_bridge neighbor_injective - neighbor_adjacent y hy - rcases hy with rfl | rfl | rfl | rfl - · exact ⟨1, by simp [neighbor]⟩ - · exact ⟨3, by simp [neighbor]⟩ - · exact ⟨2, by simp [neighbor]⟩ - · exact ⟨0, by simp [neighbor]⟩ - private theorem neighbor_count : (by classical @@ -1684,10 +1642,17 @@ theorem P4250T2InterfaceNeighborCount : fin_cases j <;> simp [neighbor, FourNeighborAdjacent] have neighbor_count := InterfaceNeighborGeometry.neighbor_count C q cfg T cert P x neighbor_bridge - neighbor_injective neighbor_adjacent (InterfaceNeighborGeometry.neighbor_exhaust C - q cfg T cert D P x hx hxD hxP hxT hcells no_parent_interior no_diagonal - label_sectors common_parent_iff shared_cells neighbor_bridge neighbor_injective - neighbor_adjacent) + neighbor_injective neighbor_adjacent ((show + ∀ (y : GaussianInt), (FourNeighborAdjacent y x) → (∃ j : Fin + 4, neighbor j = y) + from by + classical + intro y hy + rcases hy with rfl | rfl | rfl | rfl + · exact ⟨1, by simp [neighbor]⟩ + · exact ⟨3, by simp [neighbor]⟩ + · exact ⟨2, by simp [neighbor]⟩ + · exact ⟨0, by simp [neighbor]⟩)) constructor · intro hnotR have owner_exists := InterfaceNeighborGeometry.owner_exists C q cfg T cert x hcells diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean index 751bbb9771..4ac6d935cd 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean @@ -6,6 +6,9 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.PartialOdometerEquality +public import LeanPool.ApollonianSuperharmonic.BandLayoutParentNonempty +public import LeanPool.ApollonianSuperharmonic.BandParentCentroidComparison public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer public import LeanPool.ApollonianSuperharmonic.TileSubodometerLiteralDecompositionPiece @@ -55,36 +58,8 @@ private theorem hvector : intro q q' i' r hrotate j rw [hrotate (i' + 2), hrotate (i' + 1)]; dsimp [j]; fin_cases r <;> fin_cases i' <;> rfl -private theorem hsCent : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (T₀ : ProtoTile), ∀ (q' : Fin (4 : ℕ) → - CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → - ProtoTile), (∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), TileCentroid (S' j t) - TileCentroid - T₀ = (if t = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint - (BandVectors.1 (q' (j + (2 : Fin (3 : ℕ))).succ) (q' (j + (1 : Fin (3 : ℕ))).succ)) - - (-(GaussianRealPoint (BandVectors.1 (q' (j + (2 : Fin (3 : ℕ))).succ) (q' (j + (1 : - Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q' (j + (2 : Fin (3 : - ℕ))).succ) (q' (j + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (R : Fin (3 : ℕ) → Bool → - ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (R i s) - TileCentroid - T₀ = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint - (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin - (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (r : Fin (3 : ℕ)), - let j : Fin 3 := i' + r - (BandVectors.1 (q' ((i' + 2).succ)) (q' ((i' + 1).succ)) = BandVectors.1 (q ((j + - 2).succ)) (q ((j + 1).succ))) → (TileCentroid (S' i' hs) = TileCentroid (R j hs)))) ) - := by - classical - intro q T₀ q' i' hs S' hcent' R hrootCent r j hvector - calc - TileCentroid (S' i' hs) = - (TileCentroid (S' i' hs) - TileCentroid T₀) + TileCentroid T₀ := by abel - _ = (TileCentroid (R j hs) - TileCentroid T₀) + TileCentroid T₀ := by - rw [hcent' i' hs, hrootCent j hs, hvector] - _ = TileCentroid (R j hs) := by abel +private abbrev hsCent := + BandParentCentroidComparison.centroidEquality private theorem hbandSelected : (by @@ -126,26 +101,6 @@ private theorem hlayoutCent : rw [hrootCent j hs, hlayoutOcc.2.2] _ = TileCentroid (cert.P j hs) := by abel -private theorem hparentNonempty : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T₀), ∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (r : Fin (3 : ℕ)), - let j : Fin 3 := i' + r - (cert.P j hs).cells.Nonempty ) := by - classical - intro q cfg C₀ T₀ cert i' hs r j - rcases cert.parent_lattice j hs with ⟨e⟩ - have hball : (0 : ℝ × ℝ) ∈ Metric.closedBall (0 : ℝ × ℝ) 1 := by - simp - have hreal : (e ⟨(0 : ℝ × ℝ), hball⟩ : ℝ × ℝ) ∈ - TileRealization (cert.P j hs) := (e ⟨0, hball⟩).property - simp only [TileRealization, Set.mem_iUnion] at hreal - rcases hreal with ⟨x, hx, _⟩ - exact ⟨x, hx⟩ - private theorem hselectedNonempty : (by classical @@ -334,30 +289,6 @@ private theorem hvalueSuppliedFresh : exact hx ((Set.ext_iff.mp hdomainSuppliedFresh x).mpr hxFresh) rw [h.value_outside x hx, (rH j hs).value_outside x hxFresh] -private theorem hfunEq : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (C : BandCircle), ∀ - (T : ProtoTile), ∀ (h : PartialOdometer), (TileSubodometer C₀.1.1 C.1.1 T₀ T h₀ h) → - (∀ (i' : Fin (3 : ℕ)), ∀ (hs : Bool), ∀ (hs' : Fin (3 : ℕ) → Bool → PartialOdometer), - ((↑h.domain : Set GaussianInt) = (↑(hs' i' hs).domain : Set GaussianInt)) → ((∀ x ∈ - h.domain, h.value x = (hs' i' hs).value x) → (∀ (rH : Fin (3 : ℕ) → Bool → - PartialOdometer), ∀ (r : Fin (3 : ℕ)), - let j : Fin 3 := i' + r - ((h.domain : Set GaussianInt) = FootprintVertices T) → (((h.domain : Set GaussianInt) = - (rH j hs).domain) → ((∀ x, h.value x = (rH j hs).value x) → (h = rH j hs)))))) ) := by - classical - intro C₀ T₀ h₀ C T h hsub i' hs hs' hselectedDomain hselectedValue rH r j hdomainT - hdomainSuppliedFresh hvalueSuppliedFresh - cases h with - | mk hd hv hout => - have hdomEq : hd = (rH j hs).domain := Finset.coe_injective hdomainSuppliedFresh - have hvalEq : hv = (rH j hs).value := funext hvalueSuppliedFresh - cases hdomEq - cases hvalEq - rfl - private theorem centralLabel : (by classical @@ -534,7 +465,7 @@ theorem P4261T1CentralCoordinates have hlayoutCells : (R j hs).cells = (cert.P j hs).cells := (BandPrototileCentroidUnique (q j.succ) _ _ hbandFresh hbandLayout hlayoutCent).1 have hparentNonempty : (cert.P j hs).cells.Nonempty := - CentralCoordinateGeometry.hparentNonempty q cfg C₀ T₀ cert i' hs r + BandLayoutParentNonempty.cells q cfg C₀ T₀ cert (i' + r) hs have hselectedNonempty := CentralCoordinateGeometry.hselectedNonempty q cfg C₀ T₀ cert T i' hs S' hselectedCells R r hselectedCellsFresh hlayoutCells hparentNonempty have hcellsT : T.cells = (cert.P j hs).cells := CentralCoordinateGeometry.hcellsT q cfg C₀ T₀ @@ -555,8 +486,8 @@ theorem P4261T1CentralCoordinates hselectedDomain rH r hdomainSelFresh have hvalueSuppliedFresh := CentralCoordinateGeometry.hvalueSuppliedFresh h₀ h i' hs hs' hvalue' hselectedDomain hselectedValue rH hrootValue r hdomainSuppliedFresh - have hfunEq : h = rH j hs := CentralCoordinateGeometry.hfunEq C₀ T₀ h₀ C T h hsub i' hs hs' - hselectedDomain hselectedValue rH r hdomainT hdomainSuppliedFresh hvalueSuppliedFresh + have hfunEq : h = rH j hs := PartialOdometerEquality.extensionality h (rH (i' + r) hs) + hdomainSuppliedFresh hvalueSuppliedFresh let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with | .A => (0, true) | .B => (0, false) diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean index 36a21437b2..14f285c0a6 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean @@ -6,6 +6,9 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.PartialOdometerEquality +public import LeanPool.ApollonianSuperharmonic.BandLayoutParentNonempty +public import LeanPool.ApollonianSuperharmonic.BandParentCentroidComparison public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer public import LeanPool.ApollonianSuperharmonic.TileSubodometerLiteralDecompositionPiece @@ -74,36 +77,8 @@ private theorem hslopeVector : intro q q'' i'' r hrotate j rw [hrotate (i'' + 2), hrotate (i'' + 1)]; dsimp [j]; fin_cases r <;> fin_cases i'' <;> rfl -private theorem hsCent : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (N : ProtoTile), ∀ (q'' : Fin (4 : ℕ) → - CircleCoordinates), ∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (S' : Fin (3 : ℕ) → Bool → - ProtoTile), (∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), TileCentroid (S' j t) - TileCentroid - N = (if t = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint - (BandVectors.1 (q'' (j + (2 : Fin (3 : ℕ))).succ) (q'' (j + (1 : Fin (3 : ℕ))).succ)) - - (-(GaussianRealPoint (BandVectors.1 (q'' (j + (2 : Fin (3 : ℕ))).succ) (q'' (j + (1 - : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q'' (j + (2 : Fin (3 : - ℕ))).succ) (q'' (j + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (R : Fin (3 : ℕ) → Bool → - ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (R i s) - TileCentroid N - = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint - (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin - (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → (∀ (r : Fin (3 : ℕ)), - let j : Fin 3 := i'' + r - (BandVectors.1 (q'' ((i'' + 2).succ)) (q'' ((i'' + 1).succ)) = BandVectors.1 (q ((j + - 2).succ)) (q ((j + 1).succ))) → (TileCentroid (S' i'' s) = TileCentroid (R j s)))) ) - := by - classical - intro q N q'' i'' s S' hcent' R hrootCent r j hvector - calc - TileCentroid (S' i'' s) = - (TileCentroid (S' i'' s) - TileCentroid N) + TileCentroid N := by abel - _ = (TileCentroid (R j s) - TileCentroid N) + TileCentroid N := by - rw [hcent' i'' s, hrootCent j s, hvector] - _ = TileCentroid (R j s) := by abel +private abbrev hsCent := + BandParentCentroidComparison.centroidEquality private theorem hbandSelected : (by @@ -325,25 +300,6 @@ private theorem hlayoutCent : rw [heq] _ = TileCentroid Pshift := by rw [hPshiftCent]; abel -private theorem hparentNonempty : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T₀), ∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (r : Fin (3 : ℕ)), - let j : Fin 3 := i'' + r - (cert.P j s).cells.Nonempty ) := by - classical - intro q cfg C₀ T₀ cert i'' s r j - rcases cert.parent_lattice j s with ⟨e⟩ - have hball : (0 : ℝ × ℝ) ∈ Metric.closedBall (0 : ℝ × ℝ) 1 := by simp - have hreal : (e ⟨(0 : ℝ × ℝ), hball⟩ : ℝ × ℝ) ∈ - TileRealization (cert.P j s) := (e ⟨0, hball⟩).property - simp only [TileRealization, Set.mem_iUnion] at hreal - rcases hreal with ⟨x, hx, _⟩ - exact ⟨x, hx⟩ - private theorem hselectedNonempty : (by classical @@ -551,30 +507,6 @@ private theorem hvalueSuppliedFresh : exact hx ((Set.ext_iff.mp hdomainSuppliedFresh x).mpr hxF) rw [h.value_outside x hx, (rH j s).value_outside x hxFresh] -private theorem hfunEq : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (N : ProtoTile), ∀ (hN : PartialOdometer), ∀ (C : BandCircle), ∀ - (T : ProtoTile), ∀ (h : PartialOdometer), (TileSubodometer C₀.1.1 C.1.1 N T hN h) → - (∀ (i'' : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (hs' : Fin (3 : ℕ) → Bool → PartialOdometer), - ((↑h.domain : Set GaussianInt) = (↑(hs' i'' s).domain : Set GaussianInt)) → ((∀ x ∈ - h.domain, h.value x = (hs' i'' s).value x) → (∀ (rH : Fin (3 : ℕ) → Bool → - PartialOdometer), ∀ (r : Fin (3 : ℕ)), - let j : Fin 3 := i'' + r - ((h.domain : Set GaussianInt) = FootprintVertices T) → (((h.domain : Set GaussianInt) = - (rH j s).domain) → ((∀ x, h.value x = (rH j s).value x) → (h = rH j s)))))) ) := by - classical - intro C₀ N hN C T h hsub i'' s hs' hselectedDomain hselectedValue rH r j hdomainT - hdomainSuppliedFresh hvalueSuppliedFresh - cases h with - | mk hd hv hout => - have hdomEq : hd = (rH j s).domain := Finset.coe_injective hdomainSuppliedFresh - have hvalEq : hv = (rH j s).value := funext hvalueSuppliedFresh - cases hdomEq - cases hvalEq - rfl - private theorem hsumA : (by classical @@ -988,7 +920,7 @@ theorem P4261T1RightCoordinates hrootCent r ra hNcent hlayoutOcc hPshiftCent have hlayoutCells : (R j s).cells = Pshift.cells := (BandPrototileCentroidUnique (q j.succ) _ _ hbandFresh hbandShift hlayoutCent).1 - have hparentNonempty := RightCoordinateGeometry.hparentNonempty q cfg C₀ T₀ cert i'' s r + have hparentNonempty := BandLayoutParentNonempty.cells q cfg C₀ T₀ cert (i'' + r) s have hselectedNonempty := RightCoordinateGeometry.hselectedNonempty q cfg C₀ T₀ cert T i' e' i'' s S' hselectedCells R r hselectedCellsFresh ra hlayoutCells hparentNonempty have hcellsT : T.cells = Pshift.cells := RightCoordinateGeometry.hcellsT q cfg C₀ T₀ cert T i' @@ -1008,8 +940,8 @@ theorem P4261T1RightCoordinates hselectedDomain rH r hdomainSelFresh have hvalueSuppliedFresh := RightCoordinateGeometry.hvalueSuppliedFresh hN h i'' s hs' hvalue' hselectedDomain hselectedValue rH hrootValue r hdomainSuppliedFresh - have hfunEq := RightCoordinateGeometry.hfunEq C₀ N hN C T h hsub i'' s hs' hselectedDomain - hselectedValue rH r hdomainT hdomainSuppliedFresh hvalueSuppliedFresh + have hfunEq := PartialOdometerEquality.extensionality h (rH (i'' + r) s) hdomainSuppliedFresh + hvalueSuppliedFresh have hsumA := RightCoordinateGeometry.hsumA q cfg have hsumAPoint := congrArg GaussianRealPoint hsumA simp only [GaussianRealPoint, Int.reduceNeg, Fin.isValue, GaussianInt.intCast_re, diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean b/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean index 9a85b7d6d7..5d0106f917 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryDomainTransport public import LeanPool.ApollonianSuperharmonic.AncestorOdometer public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance @@ -97,19 +98,7 @@ private theorem hInclusion : (BandPackingSymmetryPartialOdometerActionFormulas g h k).1] exact Set.image_mono hIncl -private theorem actionForward : - (by - classical - exact - ∀ (a : BandPackingSymmetry), ∀ (p : PartialOdometer), ∀ (x : GaussianInt), (x ∈ p.domain) - → (BandPackingSymmetryVectorAction a x ∈ (BandPackingSymmetryPartialOdometerAction a - p).domain) ) := by - classical - intro a p x hx - change BandPackingSymmetryVectorAction a x ∈ - ((BandPackingSymmetryPartialOdometerAction a p).domain : Set GaussianInt) - rw [(BandPackingSymmetryPartialOdometerActionFormulas a p p).1] - exact ⟨x, hx, rfl⟩ +private abbrev actionForward := BandPackingSymmetryDomainTransport.forward private theorem literalRestriction : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean index 07b0ddfd19..8e5768b062 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean @@ -173,41 +173,11 @@ private theorem hImMem : · right; simpa using congrArg Zsqrtd.im e · right; simpa using congrArg Zsqrtd.im e -private theorem kReMem : - (by - classical - exact - ∀ (k : PartialOdometer), ∀ (v : LatticeCell), ((k.domain : Set GaussianInt) = {v, v + 1, - v + ⟨0, 1⟩, v + 1 + ⟨0, 1⟩}) → (∀ y ∈ k.domain, y.re = v.re ∨ y.re = v.re + (1 : ℤ)) - ) := by - classical - intro k v kdomSq y hy - change y ∈ (k.domain : Set GaussianInt) at hy - rw [kdomSq] at hy - rcases (by simpa using hy : y = v ∨ y = v + 1 ∨ - y = v + ⟨0, 1⟩ ∨ y = v + 1 + ⟨0, 1⟩) with e | e | e | e - · left; exact congrArg Zsqrtd.re e - · right; simpa using congrArg Zsqrtd.re e - · left; simpa using congrArg Zsqrtd.re e - · right; simpa using congrArg Zsqrtd.re e +private abbrev kReMem := + ApollonianSuperharmonic.UnitBoundaryProof.hReMem -private theorem kImMem : - (by - classical - exact - ∀ (k : PartialOdometer), ∀ (v : LatticeCell), ((k.domain : Set GaussianInt) = {v, v + 1, - v + ⟨0, 1⟩, v + 1 + ⟨0, 1⟩}) → (∀ y ∈ k.domain, y.im = v.im ∨ y.im = v.im + (1 : ℤ)) - ) := by - classical - intro k v kdomSq y hy - change y ∈ (k.domain : Set GaussianInt) at hy - rw [kdomSq] at hy - rcases (by simpa using hy : y = v ∨ y = v + 1 ∨ - y = v + ⟨0, 1⟩ ∨ y = v + 1 + ⟨0, 1⟩) with e | e | e | e - · left; exact congrArg Zsqrtd.im e - · left; simpa using congrArg Zsqrtd.im e - · right; simpa using congrArg Zsqrtd.im e - · right; simpa using congrArg Zsqrtd.im e +private abbrev kImMem := + ApollonianSuperharmonic.UnitBoundaryProof.hImMem private theorem horizontalPositive : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean index 674a39566b..fc56474bd0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean @@ -1002,39 +1002,6 @@ private theorem hpathIndexEdge : · simp [hsplit, List.idxOf_append, hxnot] · simp [hsplit, List.idxOf_append, hynot, hxy, Nat.add_comm] -private theorem hwalkHeadPos : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (centerShift : GaussianInt), ∀ (Rminus : - ProtoTile), ∀ (Rplus : ProtoTile), - let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift - ∀ (Epositive : ExactTileInterfaceTriple T U Rplus), ∀ (Eimage : ExactTileInterfaceTriple - (F T) (F U) (F Rplus)), ∀ (hvFT : FootprintVertices (F T) = FootprintVertices U), ∀ - (hvFU : FootprintVertices (F U) = FootprintVertices T), ∀ (hvFR : FootprintVertices - (F Rplus) = FootprintVertices Rminus), ∀ (heFT : FootprintEdges (F T) = - FootprintEdges U), ∀ (heFU : FootprintEdges (F U) = FootprintEdges T), ∀ (heFR : - FootprintEdges (F Rplus) = FootprintEdges Rminus), - let Enegative : ExactTileInterfaceTriple U T Rminus := { - point := Eimage.point - otherAB := Eimage.otherAB - otherBC := Eimage.otherBC - otherCA := Eimage.otherCA - pathAB := by simpa [hvFT, hvFU, heFT, heFU] using Eimage.pathAB - pathBC := by simpa [hvFU, hvFR, heFU, heFR] using Eimage.pathBC - pathCA := by simpa [hvFR, hvFT, heFR, heFT] using Eimage.pathCA - unique_common := by - intro z - simpa [hvFT, hvFU, hvFR] using Eimage.unique_common z } - (Enegative.point = Epositive.otherAB) → (∀ (walk : List GaussianInt), (∃ z, walk.head? = - some z ∧ z = Enegative.point) → (walk.head? = some Epositive.otherAB)) ) := by - classical - intro T U centerShift Rminus Rplus F Epositive Eimage hvFT hvFU hvFR heFT heFU heFR Enegative - hnegativePoint walk hwalkStart - obtain ⟨z, hz, hzpoint⟩ := hwalkStart - rw [hzpoint, hnegativePoint] at hz - exact hz - private theorem hwalkLastPos : (by classical @@ -1379,8 +1346,13 @@ theorem P4261T2UnitInterface hpathLength hpathIndex hpathIndexInjective hstartIndex (UnitInterfaceGeometry.hfinishIndex T U Rplus Epositive path hpathLength hpathHead) (UnitInterfaceGeometry.hpathIndexEdge path hpathNodup) - (UnitInterfaceGeometry.hwalkHeadPos T U centerShift Rminus Rplus Epositive Eimage hvFT - hvFU hvFR heFT heFU heFR hnegativePoint walk hwalkStart) + ((show + walk.head? = some Epositive.otherAB + from by + classical + obtain ⟨z, hz, hzpoint⟩ := hwalkStart + rw [hzpoint, hnegativePoint] at hz + exact hz)) (UnitInterfaceGeometry.hwalkLastPos T U Rplus Epositive walk hwalkFinish) (UnitInterfaceGeometry.hwalkVertexPath T U walk hwalkInOuter path hpathVertices))) }⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean index f91e8a7102..8f4cbd5ed0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.ListEndpointFacts public import LeanPool.ApollonianSuperharmonic.AncestorOdometer public import LeanPool.ApollonianSuperharmonic.P5635T1EndpointDiagonalOwnership @@ -483,21 +484,8 @@ private theorem last_edge_unique : hrevPath e hrevDecomp hxe simpa [Finset.pair_comm] using hresult -private theorem split_mem : - (by - classical - exact - ∀ (r : List GaussianInt), ∀ (z : GaussianInt), z ∈ r → ∃ l t, r = l ++ z :: t ) := by - classical - intro r z hz - induction r with - | nil => simp at hz - | cons a r ih => - simp only [List.mem_cons] at hz - rcases hz with rfl | hz - · exact ⟨[], r, rfl⟩ - · rcases ih hz with ⟨l, t, ht⟩ - exact ⟨a :: l, t, by simp [ht, List.cons_append]⟩ +private abbrev split_mem := + @ListEndpointFacts.splitMembership GaussianInt private theorem hsuf : (by @@ -556,70 +544,6 @@ private theorem hleft : path = pre ++ x :: y :: rest := hsplit _ = pre' ++ z :: x :: y :: rest := by rw [← hpreEq]; simp [List.append_assoc] -private theorem hzx : - (by - classical - exact - ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (path : List - GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), - (x ∈ path) → ((∀ (y : GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : - GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices T0 ∨ y ∈ FootprintVertices T0') → (∀ (pre - : List GaussianInt), ∀ (y : GaussianInt), ∀ (rest : List GaussianInt), (path = pre ++ - x :: y :: rest) → (∀ (hpre' : pre ≠ []), - let z := pre.getLast hpre' - let pre' := pre.dropLast - (path = pre' ++ z :: x :: y :: rest) → ((path = pre ++ x :: y :: rest) → (∀ (UL : - ProtoTile), ∀ (VL : ProtoTile), ∀ (iaL : ↥(TilingLattice Ci)), ∀ (ibL : - ↥(TilingLattice Ci)), ∀ (jL : Fin (4 : ℕ)), (({z, x} : Finset GaussianInt) = ![{x, x - + (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt)}, {x - (1 : GaussianInt), x}, {x - (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt), x}, {x, x + (1 : GaussianInt)}] jL) → (({z, x} ∈ - FootprintEdges UL) → (({z, x} ∈ FootprintEdges VL) → ((LatticeVertexIncidentCell x jL - ∈ (P.tile iaL).cells ∧ LatticeVertexIncidentCell x (jL + (1 : Fin (4 : ℕ))) ∈ (P.tile - ibL).cells ∨ LatticeVertexIncidentCell x jL ∈ (P.tile ibL).cells ∧ - LatticeVertexIncidentCell x (jL + (1 : Fin (4 : ℕ))) ∈ (P.tile iaL).cells) → (∀ (UR : - ProtoTile), ∀ (VR : ProtoTile), ∀ (iaR : ↥(TilingLattice Ci)), ∀ (ibR : - ↥(TilingLattice Ci)), ∀ (jR : Fin (4 : ℕ)), (({x, y} : Finset GaussianInt) = ![{x, x - + (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt)}, {x - (1 : GaussianInt), x}, {x - (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt), x}, {x, x + (1 : GaussianInt)}] jR) → (({x, y} ∈ - FootprintEdges UR) → (({x, y} ∈ FootprintEdges VR) → ((LatticeVertexIncidentCell x jR - ∈ (P.tile iaR).cells ∧ LatticeVertexIncidentCell x (jR + (1 : Fin (4 : ℕ))) ∈ (P.tile - ibR).cells ∨ LatticeVertexIncidentCell x jR ∈ (P.tile ibR).cells ∧ - LatticeVertexIncidentCell x (jR + (1 : Fin (4 : ℕ))) ∈ (P.tile iaR).cells) → (((pre' - ++ z :: x :: y :: rest).Nodup) → (((z :: x :: y :: rest).Nodup) → ((z ∉ x :: y :: - rest) → (z ≠ x)))))))))))))))) ) := by - classical - intro Ci T0 T0' path P x hx hstar pre y rest hsplit hpre' z pre' hleft hright UL VL iaL ibL jL - eL hedgeUL hedgeVL hsectorL UR VR iaR ibR jR eR hedgeUR hedgeVR hsectorR hnodupPath - htailNodup hznot heq - subst x - exact hznot (List.mem_cons_self ..) - -private theorem hzy : - (by - classical - exact - ∀ (path : List GaussianInt), ∀ (x : GaussianInt), ∀ (pre : List GaussianInt), ∀ (y : - GaussianInt), ∀ (rest : List GaussianInt), (path = pre ++ x :: y :: rest) → (∀ (hpre' - : pre ≠ []), - let z := pre.getLast hpre' - let pre' := pre.dropLast - (path = pre' ++ z :: x :: y :: rest) → ((path = pre ++ x :: y :: rest) → (∀ (UR : - ProtoTile), ∀ (VR : ProtoTile), ∀ (jR : Fin (4 : ℕ)), (({x, y} : Finset GaussianInt) - = ![{x, x + (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt)}, {x - (1 : GaussianInt), x}, {x - (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt), x}, {x, x + (1 : GaussianInt)}] jR) → (({x, y} ∈ - FootprintEdges UR) → (({x, y} ∈ FootprintEdges VR) → (((pre' ++ z :: x :: y :: - rest).Nodup) → (((z :: x :: y :: rest).Nodup) → ((z ∉ x :: y :: rest) → (z ≠ - y))))))))) ) := by - classical - intro path x pre y rest hsplit hpre' z pre' hleft hright UR VR jR eR hedgeUR hedgeVR hnodupPath - htailNodup hznot heq - subst y - exact hznot (List.mem_cons_of_mem x (List.mem_cons_self ..)) - private theorem hEdgeNe : (by classical @@ -884,48 +808,8 @@ private theorem hLaligned : · exact ⟨label_T0 x (jL + 1) (hULsub (by simpa [hULidx] using h.2)), owner_unique _ iaL (by simpa [hULidx] using h.2)⟩ -private theorem hRaligned : - (by - classical - exact - ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (P : PeriodicTileComplex - ↥(TilingLattice Ci)), - let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => - if LatticeVertexIncidentCell x j ∈ T0.cells then 0 - else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 - (∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → - (outerLabel x j = 0)) → ((∀ (x : GaussianInt), ∀ (j : Fin 4), - (LatticeVertexIncidentCell x j ∈ T0'.cells) → (outerLabel x j = 1)) → ( - let owner : GaussianInt → TilingLattice Ci := fun c => - Classical.choose (PeriodicTileIndexedMultiplicityOne P c) - (∀ (c : GaussianInt), ∀ (a : TilingLattice Ci), (c ∈ (P.tile a).cells) → (owner c = a)) → - (∀ (x : GaussianInt), ∀ (UR : ProtoTile), ∀ (VR : ProtoTile), ∀ (iaR : - ↥(TilingLattice Ci)), ∀ (ibR : ↥(TilingLattice Ci)), ∀ (jR : Fin (4 : ℕ)), (P.tile - iaR = UR) → ((P.tile ibR = VR) → ((LatticeVertexIncidentCell x jR ∈ (P.tile - iaR).cells ∧ LatticeVertexIncidentCell x (jR + (1 : Fin (4 : ℕ))) ∈ (P.tile - ibR).cells ∨ LatticeVertexIncidentCell x jR ∈ (P.tile ibR).cells ∧ - LatticeVertexIncidentCell x (jR + (1 : Fin (4 : ℕ))) ∈ (P.tile iaR).cells) → - ((UR.cells ⊆ T0.cells) → ((VR.cells ⊆ T0'.cells) → (((outerLabel x jR = 0 ∧ owner - (LatticeVertexIncidentCell x jR) = iaR) ∧ (outerLabel x (jR + 1) = 1 ∧ owner - (LatticeVertexIncidentCell x (jR + 1)) = ibR)) ∨ ((outerLabel x jR = 1 ∧ owner - (LatticeVertexIncidentCell x jR) = ibR) ∧ (outerLabel x (jR + 1) = 0 ∧ owner - (LatticeVertexIncidentCell x (jR + 1)) = iaR)))))))))) ) := by - classical - intro Ci T0 T0' P outerLabel label_T0 label_T0' owner owner_unique x UR VR iaR ibR jR hURidx - hVRidx hsectorR hURsub hVRsub - rcases hsectorR with h | h - · left - constructor - · exact ⟨label_T0 x jR (hURsub (by simpa [hURidx] using h.1)), - owner_unique _ iaR (by simpa [hURidx] using h.1)⟩ - · exact ⟨label_T0' x (jR + 1) (hVRsub (by simpa [hVRidx] using h.2)), - owner_unique _ ibR (by simpa [hVRidx] using h.2)⟩ - · right - constructor - · exact ⟨label_T0' x jR (hVRsub (by simpa [hVRidx] using h.1)), - owner_unique _ ibR (by simpa [hVRidx] using h.1)⟩ - · exact ⟨label_T0 x (jR + 1) (hURsub (by simpa [hURidx] using h.2)), - owner_unique _ iaR (by simpa [hURidx] using h.2)⟩ +private abbrev hRaligned := + ApollonianSuperharmonic.LocalSectorGeometry.hLaligned private theorem transition_is_path_edge : (by @@ -1635,11 +1519,14 @@ private theorem interiorSector : have htailNodup : (z :: x :: y :: rest).Nodup := (List.nodup_append.mp hnodupPath).2.1 have hznot : z ∉ x :: y :: rest := (List.nodup_cons.mp htailNodup).1 - have hzx := LocalSectorGeometry.hzx Ci T0 T0' path P x hx hstar pre y rest hsplit hpre' - hleft hright UL VL iaL ibL jL eL hedgeUL hedgeVL hsectorL UR VR iaR ibR jR eR hedgeUR - hedgeVR hsectorR hnodupPath htailNodup hznot - have hzy := LocalSectorGeometry.hzy path x pre y rest hsplit hpre' hleft hright UR VR jR - eR hedgeUR hedgeVR hnodupPath htailNodup hznot + have hzx : z ≠ x := by + intro heq + subst x + exact hznot (List.mem_cons_self ..) + have hzy : z ≠ y := by + intro heq + subst y + exact hznot (List.mem_cons_of_mem x (List.mem_cons_self ..)) have hEdgeNe : ({z, x} : Finset GaussianInt) ≠ {x, y} := LocalSectorGeometry.hEdgeNe x pre y hpre' hzx hzy have hjne := LocalSectorGeometry.hjne x pre y hpre' jL eL jR eR hzx hzy diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean index fd81c0c40a..1214b5a00f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties +public import LeanPool.ApollonianSuperharmonic.BandOriginalParentContainment public import LeanPool.ApollonianSuperharmonic.P4418T3EndpointOwnerIndices public import LeanPool.ApollonianSuperharmonic.P4418T3SelectedInterfaceData @@ -84,54 +86,11 @@ private def selectedSecondFace (q : Fin 4 → CircleCoordinates) namespace SelectedInterfaceGeometry -private theorem hOA : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), - let P := cert.P - let O := cert.O - O.cells ⊆ (P 0 true).cells ) := by - classical - intro q cfg C T cert P O - change cert.O.cells ⊆ (cert.P 0 true).cells - rw [cert.precursor_eq] - intro x hx - exact (cert.plus_union x).2 ⟨0, false, hx⟩ +private abbrev hOA := + BandOriginalParentContainment.positiveParent -private theorem hOB : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), - let P := cert.P - let O := cert.O - O.cells ⊆ (P 0 false).cells ) := by - classical - intro q cfg C T cert P O - change cert.O.cells ⊆ (cert.P 0 false).cells - rw [cert.precursor_cells] - intro x hx - exact (cert.minus_union x).2 ⟨0, true, hx⟩ - -private theorem cellInclusion : - (by - classical - exact - (∀ (X : ProtoTile), ∀ (d : GaussianInt), (TileTranslation X d).cells = X.cells.image - (GaussianTranslation d)) → (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells ⊆ Y.cells) - → (∀ (d : GaussianInt), (TileTranslation X d).cells ⊆ (TileTranslation Y d).cells)) ) - := by - classical - intro translatedCells X Y hXY d - rw [translatedCells, translatedCells] - intro z hz - obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz - exact Finset.mem_image.mpr ⟨w, hXY hw, rfl⟩ +private abbrev hOB := + BandOriginalParentContainment.negativeParent private theorem isolated : (by @@ -244,31 +203,6 @@ private theorem complementNonempty : rw [(TileCellComplementCovariance _ _ _).1] at ht simpa [SubtileOccurrenceInterpretation, P, u, v] using ht -private theorem deletionSupport : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), - let P := cert.P - let O := cert.O - let u := cert.u - let v := cert.v - (∀ (m : Int), ∀ (n : Int), (TileCellComplement (SubtileOccurrenceInterpretation P u v - ⟨.A,m,n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * - v))).cells.Nonempty) → (∀ (m : Int), ∀ (n : Int), ∀ (Y : ProtoTile), - (Y.cells.Nonempty) → ((TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * - v)).cells = ∅ ∨ ((TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) - (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))).cells.Nonempty ∧ - Y.cells.Nonempty))) ) := by - classical - intro q cfg C T cert P O u v complementNonempty m n Y hY - by_cases hO : O.cells = ∅ - · exact Or.inl ((TileTranslationFormulas O - ((m : GaussianInt) * u + (n : GaussianInt) * v)).2.2.1.mpr hO) - · exact Or.inr ⟨complementNonempty m n, hY⟩ - private theorem deleteEdge : (by classical @@ -757,40 +691,6 @@ private theorem reversePath : apply (hE e).mpr simpa using reverseRaw p.reverse e he -private theorem hne : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - let P := cert.P - let O := cert.O - let u := cert.u - let v := cert.v - ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b))) → ( - let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row - let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row - let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modifiedFaceEquivalence.symm face0 - let F1 := cert.modifiedFaceEquivalence.symm face1 - (F0 ≠ F1) → (((∃ iA iB iO : Fin 3, cert.modified.plane.faceVertex F0 iA = a ∧ - cert.modified.plane.faceVertex F0 iB = b ∧ cert.modified.plane.faceVertex F0 iO = - owners.1) ∧ (∃ jA jB jO : Fin 3, cert.modified.plane.faceVertex F1 jA = a ∧ - cert.modified.plane.faceVertex F1 jB = b ∧ cert.modified.plane.faceVertex F1 jO = - owners.2)) → (a ≠ b))) ) := by - classical - intro q cfg C T cert a b row P O u v retargeted owners face0 face1 F0 F1 faceDistinct faceTable h - cases row <;> cases h - private theorem allowed : (by classical @@ -1786,7 +1686,7 @@ theorem P4418T3SelectedInterfaceExists have cellInclusion (X Y : ProtoTile) (hXY : X.cells ⊆ Y.cells) (d : GaussianInt) : (TileTranslation X d).cells ⊆ (TileTranslation Y d).cells := - SelectedInterfaceGeometry.cellInclusion translatedCells X Y hXY d + TileTranslationProperties.cellsSubset X Y hXY d have isolated (m n : Int) : ∀ z ∈ CellSupportedFootprintVertices (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)), @@ -1808,8 +1708,7 @@ theorem P4418T3SelectedInterfaceExists (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v)).cells = ∅ ∨ ((TileCellComplement (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩) (TileTranslation O ((m : GaussianInt) * u + (n : GaussianInt) * v))).cells.Nonempty ∧ - Y.cells.Nonempty) := SelectedInterfaceGeometry.deletionSupport q cfg C T cert - complementNonempty m n Y hY + Y.cells.Nonempty) := (Or.inr ⟨complementNonempty m n, hY⟩) have deleteEdge (m n : Int) (Y : ProtoTile) (hYA : Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.A,m,n⟩).cells) (hYB : Disjoint Y.cells (SubtileOccurrenceInterpretation P u v ⟨.B,m,n⟩).cells) : @@ -1901,8 +1800,12 @@ theorem P4418T3SelectedInterfaceExists {x y : GaussianInt} (h : SimpleGridPathBetween V E x y) : SimpleGridPathBetween V E y x := SelectedInterfaceGeometry.reversePath (V := V) (E := E) (x := x) (y := y) h - have hne : a ≠ b := SelectedInterfaceGeometry.hne q cfg C T cert a b row retargeted - faceDistinct faceTable + have hne : a ≠ b := (show + a ≠ b + from by + classical + intro h + cases row <;> cases h) have allowed : AllowedSubtileIncidence a b := SelectedInterfaceGeometry.allowed q cfg C T cert a b row have modifiedEdges : diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean b/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean index e2a2745acb..9e17caf7e7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean @@ -338,37 +338,8 @@ private theorem hzeroaEdge : ⟨by simpa [hzero] using hy, hya⟩ exact hneqxy (hsub hxI hyI) -private theorem hzerobEdge : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ - (x : GaussianInt), (x ∈ FootprintVertices T) → (∀ (y : GaussianInt), (y ∈ - FootprintVertices T) → ((P.tile 0 = T) → (∀ (b : ↥(TilingLattice C)), (b ≠ 0) → ((x ∈ - FootprintVertices (P.tile b)) → ((y ∈ FootprintVertices (P.tile b)) → ((x ≠ y) → ((∀ - (a : ↥(TilingLattice C)), ∀ (b : ↥(TilingLattice C)), a ≠ b → ((FootprintEdges - (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty ↔ P.plane.adjacent a b) ∧ - ((FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty → SimpleGridPath - (CommonFootprintEdgeVertices (P.tile a) (P.tile b)) (FootprintEdges (P.tile a) ∩ - FootprintEdges (P.tile b)) ∧ FootprintVertices (P.tile a) ∩ FootprintVertices (P.tile - b) = CommonFootprintEdgeVertices (P.tile a) (P.tile b)) ∧ (¬(FootprintEdges (P.tile - a) ∩ FootprintEdges (P.tile b)).Nonempty → FootprintVertices (P.tile a) ∩ - FootprintVertices (P.tile b) = ∅ ∨ (FootprintVertices (P.tile a) ∩ FootprintVertices - (P.tile b)).Subsingleton)) → ((FootprintEdges (P.tile 0) ∩ FootprintEdges (P.tile - b)).Nonempty)))))))) ) := by - classical - intro C T P x hx y hy hzero b hb0 hxb hyb hneqxy hclass - by_contra hn - have hsmall := (hclass 0 b (Ne.symm hb0)).2.2 hn - rcases hsmall with hempty | hsub - · have hxI : x ∈ FootprintVertices (P.tile 0) ∩ FootprintVertices (P.tile b) := - ⟨by simpa [hzero] using hx, hxb⟩ - simp [hempty] at hxI - · have hxI : x ∈ FootprintVertices (P.tile 0) ∩ FootprintVertices (P.tile b) := - ⟨by simpa [hzero] using hx, hxb⟩ - have hyI : y ∈ FootprintVertices (P.tile 0) ∩ FootprintVertices (P.tile b) := - ⟨by simpa [hzero] using hy, hyb⟩ - exact hneqxy (hsub hxI hyI) +private abbrev hzerobEdge := + ApollonianSuperharmonic.MissingEdgeGeometry.hzeroaEdge private theorem habneq : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean b/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean index daf5208d1b..686d9e7bea 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandLayoutCentroidCoordinates public import LeanPool.ApollonianSuperharmonic.TileHalfTurnGeometry public import LeanPool.ApollonianSuperharmonic.P4456T2CrosscutIndex @@ -67,35 +68,8 @@ private theorem hsub : intro q cfg C T layout i s c hc exact (layout.outer_union c).mpr ⟨i, s, hc⟩ -private theorem ht : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (layout : BandOrderedGeneralLayoutCertificate q cfg - C T), ∀ (u : GaussianInt), (GaussianRealPoint u = ((TileCentroid (layout.P (0 : Fin - (3 : ℕ)) false)).1 + (TileCentroid (layout.P (0 : Fin (3 : ℕ)) false)).2, - (TileCentroid (layout.P (0 : Fin (3 : ℕ)) false)).2 - (TileCentroid (layout.P (0 : - Fin (3 : ℕ)) false)).1)) → ( - let w := BandVectors.1 (q 3) (q 2) - let t : GaussianInt := - ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ - (t.re : Real) = 2 * (TileCentroid T).1 ∧ (t.im : Real) = 2 * (TileCentroid T).2) ) := by - classical - intro q cfg C T layout u hu w t - have hur := congrArg Prod.fst hu - have hui := congrArg Prod.snd hu - have hc := (layout.outer_occurrence 0 false).2.2 - have hcr := congrArg Prod.fst hc - have hci := congrArg Prod.snd hc - norm_num [GaussianRealPoint] at hur hui hcr hci - simp only [← GaussianInt.intCast_re, ← GaussianInt.intCast_im] at hur hui hcr hci - dsimp [t, w] - push_cast - constructor <;> linarith - - - +private abbrev ht := + BandLayoutCentroidCoordinates.doubledCenter private theorem hcenter : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean b/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean index 95a50538de..4fea317343 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean @@ -358,15 +358,8 @@ private theorem hrightDrop : exact List.mem_dropLast_of_mem_of_ne_getLast hUR (by simpa [hrightGetLast] using hUneS) -private theorem hrightTailDrop : - ∀ (J : ProtoTile), ∀ (U : ProtoTile), (¬U = J) → (∀ (b : ProtoTile), ∀ (bs : List ProtoTile), - (U ∈ (J :: b :: bs).dropLast) → (U ∈ (b :: bs).dropLast)) := by - classical - intro J U hUJ b bs hrightDrop - simp only [List.dropLast_cons_cons, List.mem_cons] at hrightDrop - rcases hrightDrop with hEq | hmem - · exact (hUJ hEq).elim - · exact hmem +private abbrev hrightTailDrop := + ApollonianSuperharmonic.RespectAppendDetails.hUintAt389 end RespectAppendDetails diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean index 432f7aa879..a97909a6ae 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean @@ -50,30 +50,6 @@ private theorem hnegativeSlope : -private theorem hcenterVector : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), (Fin (4 : - ℕ) → CircleCoordinates) → ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let I : GaussianInt := ⟨0, 1⟩ - let w : GaussianInt := BandVectors.1 (r 3) (r 2) - let x : GaussianInt := BandVectors.1 (r 1) (r 3) - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (BandVectors.1 (r 1) (r 0) = x - I * y) → ((BandVectors.1 (r 0) (r 1) = I * BandVectors.1 - (r 1) (r 0)) → ((w.re + x.re + y.re = 0) → ((w.im + x.im + y.im = 0) → (-w + I * w - - BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1) = 2 * y))))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F p r I w x y hvrec hvflip hvsumRe hvsumIm - rw [hvflip, hvrec] - apply Zsqrtd.ext <;> - norm_num [I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> omega - private theorem hyLattice : (by classical @@ -2654,82 +2630,6 @@ private theorem hrightBplusSlope : simp [GaussianRealPoint, Zsqrtd.im_add, Int.cast_add] -private theorem hrightAnc : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → - CircleCoordinates), ∀ (hp : ProperBandQuadruple p), ∀ (t : Fin (4 : ℕ) → - CircleCoordinates), ∀ (ht : ProperBandQuadruple t), ∀ (ht0 : t (0 : Fin (4 : ℕ)) = p - (2 : Fin (4 : ℕ))), ∀ (olderChart : F.slot = a + (2 : Fin (3 : ℕ)) → C.1.1.1 = (1 : - ℤ) → UnitOccurrenceOrientation t (0 : Fin (3 : ℕ)) orientation), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - ∀ (u : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y) - ∀ (hjoinFamily : join ∈ RegularTileFamily base (TilingLattice C)), ∀ (hjoinOdo : - TileOdometer C.1.1 join (D.functions F.slot false)), ∀ (joinSlope : ℝ × ℝ), ∀ - (hjoinSlope : PartialOdometerSlope (D.functions F.slot false) = some joinSlope), ∀ - (hSD : F.slot = a + (2 : Fin (3 : ℕ))), ∀ (hBpos : 0 < (p 2).1), ∀ (slopeB : ℝ × ℝ), - ∀ (hslopeB : PartialOdometerSlope (D.functions (a + (1 : Fin (3 : ℕ))) true) = some - slopeB), - let outerB : BandCircle := - ⟨⟨p 2, ⟨Or.inl hBpos, ⟨p, hp.1, 2, rfl⟩⟩⟩, hBpos⟩ - ∀ (houterBOdo : TileOdometer (p 2) (D.tiles (a + 1) true) (D.functions (a + 1) true)), ∀ - (houterBBand : BandPrototile (p 2) (D.tiles (a + 1) true)), (AncestorOdometer (p 2) - F.outer.1.1 (D.tiles (a + 1) true) F.tile (D.functions (a + 1) - true) F.odometer) → (∀ (ht1C : t 1 = C.1.1), ∀ (hrightBminus : TileCentroid join - - TileCentroid (D.tiles (a + 1) true) = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 - (t 1) (t 0) - BandVectors.1 (t 0) (t 1))), ∀ (hrightBplus : TileCentroid Rplus - - TileCentroid (D.tiles (a + 1) true) = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 - (t 1) (t 0) + BandVectors.1 (t 0) (t 1))), ∀ (hrightBminusSlope : joinSlope - slopeB - = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (t 1) (t 0) - BandVectors.2 (t 0) (t - 1))), ∀ (hrightBplusSlope : F.plusSlope - slopeB = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.2 (t 1) (t 0) + BandVectors.2 (t 0) (t 1))), - let Gright : P4458T1BoundaryFrame C orientation base join Rplus - (D.functions F.slot false) hplus := { - outer := outerB - q := t - proper := ht - slot := 0 - child := by simpa [outerB] using ht0 - parent := ht1C - tile := D.tiles (a + 1) true - odometer := D.functions (a + 1) true - outer_odo := houterBOdo - minus_odo := hjoinOdo - plus_odo := F.plus_odo - outer_band := houterBBand - base_band := F.base_band - minus_family := hjoinFamily - plus_family := F.plus_family - chart := by - intro hunit - exact olderChart hSD (by simpa only [ht1C] using hunit) - minus_centroid := hrightBminus - plus_centroid := hrightBplus - outerSlope := slopeB - minusSlope := joinSlope - plusSlope := F.plusSlope - slope_outer := hslopeB - slope_minus := hjoinSlope - slope_plus := F.slope_plus - minus_difference := hrightBminusSlope - plus_difference := hrightBplusSlope - } - AncestorOdometer Gright.outer.1.1 F.outer.1.1 Gright.tile F.tile Gright.odometer - F.odometer)) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D a p hp t ht ht0 olderChart r y u join - hjoinFamily hjoinOdo joinSlope hjoinSlope hSD hBpos slopeB hslopeB outerB houterBOdo - houterBBand houterBAnc ht1C hrightBminus hrightBplus hrightBminusSlope hrightBplusSlope Gright - simpa only using houterBAnc - end SecondNewerRowsGeometry namespace SecondParentPlacements @@ -3520,11 +3420,14 @@ private theorem secondParentPlacement : have hrightParent : Gright.outer.1.1 = F.q (a + 1).succ := hrightOuterEq have hright : P4458T1BoundarySide F join Rplus (D.functions F.slot false) hplus := - .recursive Gright (a + 1) hrightParent (SecondNewerRowsGeometry.hrightAnc C orientation - base Rminus Rplus hminus hplus F D a p hp t ht ht0 olderChart u hjoinFamily hjoinOdo - joinSlope hjoinSlope hSD hBpos slopeB hslopeB houterBOdo houterBBand - (SecondNewerRowsGeometry.houterBAnc C orientation base Rminus Rplus hminus hplus F D - a p hqB hBpos) ht1C hrightBminus hrightBplus hrightBminusSlope hrightBplusSlope) + .recursive Gright (a + 1) hrightParent ((show + AncestorOdometer Gright.outer.1.1 F.outer.1.1 Gright.tile F.tile Gright.odometer + F.odometer + from by + classical + simpa only using ((SecondNewerRowsGeometry.houterBAnc C orientation base Rminus Rplus + hminus hplus F D + a p hqB hBpos)))) refine ⟨⟨join, hjoinCells.1.symm, hjoinOdo, hjoinAncestor, hjoinOccurrence, hleft, hright⟩⟩ @@ -4142,8 +4045,15 @@ theorem P4458T1SecondNewerRows : (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1)) := BoundaryFrameJoinGeometry.minusCentroid C orientation base Rminus Rplus hminus hplus F - have hcenterVector := SecondNewerRowsGeometry.hcenterVector C orientation base Rminus Rplus - hminus hplus F p hvrec hvflip hvsumRe hvsumIm + have hcenterVector := (show + -w + I * w - BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1) = 2 * y + from by + classical + change w.re + x.re + y.re = 0 at hvsumRe + change w.im + x.im + y.im = 0 at hvsumIm + rw [hvflip, hvrec] + apply Zsqrtd.ext <;> + norm_num [I, Zsqrtd.ext_iff, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> omega) have hcenterRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) hcenterVector have hcenterIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) hcenterVector have hcenter : TileCentroid (D.tiles F.slot false) - TileCentroid Rminus = diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean index aa072224f4..f8da9b51f4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean @@ -698,32 +698,8 @@ private theorem htriple'At567 : hobsV.2.2).mp exact hbaseTouch.2.1 i U' hU'band hcenter' -private theorem hcenterU' : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (T : ProtoTile), - let q := DiamondRecursiveQuadruple K - let D := DiamondTile K.1 - ∀ (w : GaussianInt), - let T' := TileTranslation T (-w) - (TileCentroid T' = TileCentroid D) → ((∀ (A : ProtoTile), ∀ (B : ProtoTile), TileCentroid - (TileTranslation A (-w)) - TileCentroid (TileTranslation B (-w)) = TileCentroid A - - TileCentroid B) → (∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), (TileCentroid U - - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 - (DiamondRecursiveQuadruple K i.succ) (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ)))) - + GaussianRealPoint (BandVectors.1 (DiamondRecursiveQuadruple K (0 : Fin (4 : ℕ))) - (DiamondRecursiveQuadruple K i.succ)))) → ( - let U' := TileTranslation U (-w) - TileCentroid U' - TileCentroid D = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q - i.succ) (q 0)) + GaussianRealPoint (BandVectors.1 (q 0) (q i.succ)))))) ) := by - classical - intro K T q D w T' hcent translate_centroid_diff i U hcenterU U' - calc - TileCentroid U' - TileCentroid D = - TileCentroid U' - TileCentroid T' := by rw [hcent] - _ = TileCentroid U - TileCentroid T := translate_centroid_diff U T - _ = _ := hcenterU +private abbrev hcenterU' := + ApollonianSuperharmonic.DiamondInterfaceGeometry.hcenter' private theorem hcenterV' : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean index c38e713b5d..268592134f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence public import LeanPool.ApollonianSuperharmonic.P4590T1PositivePrototileDisk public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry @@ -35,28 +36,8 @@ private theorem htransZero : funext z exact add_zero z -private theorem incident : - (by - classical - exact - ∀ (W : ProtoTile), ∀ (y : GaussianInt), (W.cells.Nonempty) → ((y ∈ FootprintVertices W) → - (∃ j : Fin 4, LatticeVertexIncidentCell y j ∈ W.cells)) ) := by - classical - intro W y hne hy - simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hy - rcases hy with ⟨c, hc, h | h | h | h⟩ - · exact ⟨0, by simpa [LatticeVertexIncidentCell] using h ▸ hc⟩ - · refine ⟨1, ?_⟩ - rw [h] - simpa [LatticeVertexIncidentCell] using hc - · refine ⟨3, ?_⟩ - rw [h] - simpa [LatticeVertexIncidentCell] using hc - · refine ⟨2, ?_⟩ - change y - 1 - ⟨0, 1⟩ ∈ W.cells - rw [h] - convert hc using 1 - ext <;> simp +private abbrev incident := + LatticeFootprintIncidence.incidentCell private theorem hfourCells : (by @@ -701,22 +682,8 @@ private theorem classifyADface : cases label <;> fin_cases i <;> fin_cases j <;> simp [SixSubtileFaceVertices, a0, d0] at hi hj ⊢ <;> omega -private theorem rhoFace2 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = - cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm face)) ) := by - classical - intro q cfg C T cert F face hF - have hEq : F = cert.modifiedFaceEquivalence.symm face := by - have hh := congrArg cert.modifiedFaceEquivalence.symm hF - simpa using hh - rw [hEq, cert.modified_face_points] +private abbrev rhoFace2 := + ApollonianSuperharmonic.JunctionRefinementGeometry.rhoFace private theorem hf2point : (by @@ -1003,22 +970,8 @@ private theorem classifyCFface : cases label <;> fin_cases i <;> fin_cases j <;> simp [SixSubtileFaceVertices, c0, f0] at hi hj ⊢ <;> omega -private theorem rhoFace3 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = - cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm face)) ) := by - classical - intro q cfg C T cert F face hF - have hEq : F = cert.modifiedFaceEquivalence.symm face := by - have hh := congrArg cert.modifiedFaceEquivalence.symm hF - simpa using hh - rw [hEq, cert.modified_face_points] +private abbrev rhoFace3 := + ApollonianSuperharmonic.JunctionRefinementGeometry.rhoFace private theorem hf3point : (by @@ -1283,22 +1236,8 @@ private theorem hxvDE : rw [← hregular.adjacent_raw_eq_edge_vertices d0 e0 hde] exact hxDE -private theorem rhoFace4 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = - cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm face)) ) := by - classical - intro q cfg C T cert F face hF - have hEq : F = cert.modifiedFaceEquivalence.symm face := by - have hh := congrArg cert.modifiedFaceEquivalence.symm hF - simpa using hh - rw [hEq, cert.modified_face_points] +private abbrev rhoFace4 := + ApollonianSuperharmonic.JunctionRefinementGeometry.rhoFace private theorem hf4point : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean index 21eb8a0170..ec8a2e9791 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean @@ -6,6 +6,9 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.PairAssignmentFacts +public import LeanPool.ApollonianSuperharmonic.BandLayoutCentroidCoordinates +public import LeanPool.ApollonianSuperharmonic.BandLayoutFaceSupport public import LeanPool.ApollonianSuperharmonic.P4590T1PositivePrototileDisk public import LeanPool.ApollonianSuperharmonic.P4590T1OppositeCellsStar @@ -27,32 +30,8 @@ namespace ApollonianSuperharmonic namespace RightInteriorGeometry -private theorem ht : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), ∀ (u : GaussianInt), (GaussianRealPoint u = ((TileCentroid (cert.P (0 : Fin - (3 : ℕ)) false)).1 + (TileCentroid (cert.P (0 : Fin (3 : ℕ)) false)).2, (TileCentroid - (cert.P (0 : Fin (3 : ℕ)) false)).2 - (TileCentroid (cert.P (0 : Fin (3 : ℕ)) - false)).1)) → ( - let w := BandVectors.1 (q 3) (q 2) - let t : GaussianInt := - ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ - (t.re : Real) = 2 * (TileCentroid T).1 ∧ (t.im : Real) = 2 * (TileCentroid T).2) ) := by - classical - intro q cfg C T cert u hu w t - have hur := congrArg Prod.fst hu - have hui := congrArg Prod.snd hu - have hc := (cert.outer_occurrence 0 false).2.2 - have hcr := congrArg Prod.fst hc - have hci := congrArg Prod.snd hc - norm_num [GaussianRealPoint] at hur hui hcr hci - simp only [← GaussianInt.intCast_re, ← GaussianInt.intCast_im] at hur hui hcr hci - dsimp [t, w] - push_cast - constructor <;> linarith +private abbrev ht := + BandLayoutCentroidCoordinates.doubledCenter private theorem hHcells : (by @@ -599,47 +578,11 @@ private theorem hisolated : cert.precursor_isolated 0 0 z (by simpa [translation_zero] using hzraw) cell hc -private theorem hf1 : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), - let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ - let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ - ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : - cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i - = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = c) → h = f ∨ h = g) - → (f1 = f ∨ f1 = g) ) := by - classical - intro q cfg C T cert a c f1 f g hfaces - apply hfaces - constructor - · exact ⟨0, by simp [f1, a, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ - · exact ⟨2, by simp [f1, c, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ +private abbrev hf1 := + BandLayoutFaceSupport.firstFace -private theorem hf3 : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), - let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ - let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ - ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (∀ (h : - cert.modified.plane.Face), ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i - = a) ∧ ∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex h i = c) → h = f ∨ h = g) - → (f3 = f ∨ f3 = g) ) := by - classical - intro q cfg C T cert a c f3 f g hfaces - apply hfaces - constructor - · exact ⟨0, by simp [f3, a, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ - · exact ⟨1, by simp [f3, c, cert.modified_face_vertices, SixSubtileFaceVertices]⟩ +private abbrev hf3 := + BandLayoutFaceSupport.thirdFace private theorem hf13 : (by @@ -656,25 +599,6 @@ private theorem hf13 : have hh := congrArg cert.modifiedFaceEquivalence h simp [f1, f3] at hh -private theorem hpair : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), - let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ - let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ - ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), (f1 = f ∨ f1 = g) → - ((f3 = f ∨ f3 = g) → ((f1 ≠ f3) → ((f1 = f ∧ f3 = g) ∨ (f1 = g ∧ f3 = f)))) ) := by - classical - intro q cfg C T cert f1 f3 f g hf1 hf3 hf13 - rcases hf1 with h1 | h1 <;> rcases hf3 with h3 | h3 - · exact False.elim (hf13 (h1.trans h3.symm)) - · exact Or.inl ⟨h1, h3⟩ - · exact Or.inr ⟨h1, h3⟩ - · exact False.elim (hf13 (h1.trans h3.symm)) - private theorem hend : (by classical @@ -1962,9 +1886,10 @@ private theorem positiveCase : have hraw := ((hclass a c hac).2.1 hcommon).2 obtain ⟨_, f, g, hfg, hf, hg, hfaces, hpath⟩ := (PeriodicTileIntersectionPaths cert.modified hregular a c hac).1.mpr hcommon - have hpair := RightInteriorGeometry.hpair q cfg C T cert f g (RightInteriorGeometry.hf1 q cfg + have hpair := PairAssignmentFacts.assignment (cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩) + (cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩) f g (RightInteriorGeometry.hf1 q cfg C T cert f g hfaces) (RightInteriorGeometry.hf3 q cfg C T cert f g hfaces) - (RightInteriorGeometry.hf13 q cfg C T cert) + (RightInteriorGeometry.hf13 q cfg C T cert) have hrho1 : cert.modified.rho f1 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) := cert.modified_face_points _ diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean b/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean index e52a1ef8ce..64211c612e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion public import LeanPool.ApollonianSuperharmonic.PrecursorBoundaryArcData public import LeanPool.ApollonianSuperharmonic.LatticeTileGridStructure @@ -96,18 +98,8 @@ private theorem hdisjPlusO : · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hDplus).elim · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hO).elim -private theorem hdisjMinusO : - (by - classical - exact - ∀ (Dminus : ProtoTile), ∀ (O : ProtoTile), (Finset.Nonempty O.cells) → ((TileTouching - Dminus O) → ((Dminus.cells.Nonempty) → (Disjoint Dminus.cells O.cells))) ) := by - classical - intro Dminus O hO htminus hDminus - rcases htminus with ⟨_, _, hd, _⟩ | ⟨hE, _⟩ | ⟨hE, _⟩ - · exact hd - · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hDminus).elim - · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hO).elim +private abbrev hdisjMinusO := + ApollonianSuperharmonic.ContactStarCases.hdisjPlusO private theorem hpathPlusO : (by @@ -124,38 +116,11 @@ private theorem hpathPlusO : · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hDplus).elim · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hO).elim -private theorem hpathMinusO : - (by - classical - exact - ∀ (Dminus : ProtoTile), ∀ (O : ProtoTile), (Finset.Nonempty O.cells) → ((TileTouching - Dminus O) → ((Dminus.cells.Nonempty) → (SimpleGridPath (BoundaryFootprintVertices - Dminus ∩ BoundaryFootprintVertices O) (BoundaryFootprintEdges Dminus ∩ - BoundaryFootprintEdges O)))) ) := by - classical - intro Dminus O hO htminus hDminus - rcases htminus with ⟨_, _, _, hp⟩ | ⟨hE, _⟩ | ⟨hE, _⟩ - · exact hp - · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hDminus).elim - · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hO).elim +private abbrev hpathMinusO := + ApollonianSuperharmonic.ContactStarCases.hpathPlusO -private theorem boundaryEdgeFootprint : - (by - classical - exact - ∀ (T : ProtoTile), ∀ e ∈ BoundaryFootprintEdges T, e ∈ FootprintEdges T ) := by - classical - intro T e he - let I : GaussianInt := ⟨0, 1⟩ - rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inl rfl⟩ - · refine ⟨z - I, hz, Or.inr (Or.inr (Or.inr ?_))⟩ - congr 1 <;> simp [I, Zsqrtd.ext_iff] - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ - congr 1 <;> simp [] +private abbrev boundaryEdgeFootprint := + BoundaryFootprintInclusion.boundaryEdge private theorem edgeAt_eq : (by @@ -296,28 +261,8 @@ private theorem boundaryVertexOfCross : exact ⟨edgeAt y j, boundaryEdgeOfCross T y j hcross, by fin_cases j <;> simp [edgeAt]⟩ -private theorem incident : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (y : GaussianInt), Finset.Nonempty T.cells → y ∈ FootprintVertices T - → ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell y j ∈ T.cells ) := by - classical - intro T y hne hy - simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hy - rcases hy with ⟨c, hc, h | h | h | h⟩ - · exact ⟨0, by simpa [LatticeVertexIncidentCell] using h ▸ hc⟩ - · refine ⟨1, ?_⟩ - rw [h] - simpa [LatticeVertexIncidentCell] using hc - · refine ⟨3, ?_⟩ - rw [h] - simpa [LatticeVertexIncidentCell] using hc - · refine ⟨2, ?_⟩ - change y - 1 - ⟨0, 1⟩ ∈ T.cells - rw [h] - convert hc using 1 - ext <;> simp +private abbrev incident := + LatticeFootprintIncidence.incidentCell private theorem coverLeft : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean index 64ef554f7a..b6d96ad1cf 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion public import LeanPool.ApollonianSuperharmonic.P4677T2TouchingWalk public import LeanPool.ApollonianSuperharmonic.TouchingTriple @@ -26,55 +27,11 @@ namespace ApollonianSuperharmonic namespace PrecursorWalkGeometry -private theorem boundary_edge_footprint : - (by - classical - exact - ∀ (T : ProtoTile), ∀ e ∈ BoundaryFootprintEdges T, e ∈ FootprintEdges T ) := by - classical - intro T e he - rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ - · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ - · exact ⟨z, hz, Or.inl rfl⟩ - · refine ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr ?_))⟩ - congr 1 <;> simp [Zsqrtd.ext_iff] - · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ - · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ - congr 1 <;> simp [] - -private theorem edge_vertex : - (by - classical - exact - ∀ (T : ProtoTile), ∀ e ∈ FootprintEdges T, ∀ z ∈ e, z ∈ FootprintVertices T ) := by - classical - intro T e he z hz - rcases he with ⟨c, hc, rfl | rfl | rfl | rfl⟩ - all_goals - simp only [FootprintVertices, - ite_eq_left (show T.cells.Nonempty from ⟨c, hc⟩), Set.mem_ofPred_eq] - refine ⟨c, hc, ?_⟩ - simp only [Finset.mem_insert, Finset.mem_singleton] at hz - rcases hz with rfl | rfl <;> simp - -private theorem boundary_vertex_footprint : - (by - classical - exact - (∀ (T : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges T) → (e ∈ - FootprintEdges T)) → ((∀ (T : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ - FootprintEdges T) → (∀ (z : GaussianInt), (z ∈ e) → (z ∈ FootprintVertices T))) → (∀ - (T : ProtoTile), ∀ z ∈ BoundaryFootprintVertices T, z ∈ FootprintVertices T)) ) := by - classical - intro boundary_edge_footprint edge_vertex T z hz - by_cases hne : T.cells.Nonempty - · simp only [BoundaryFootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hz - obtain ⟨e, he, hze⟩ := hz - exact edge_vertex T e (boundary_edge_footprint T e he) z hze - · have hanchor : z = T.anchor := by - simpa [BoundaryFootprintVertices, hne] using hz - simp [FootprintVertices, hne, hanchor] +private abbrev boundary_edge_footprint := BoundaryFootprintInclusion.boundaryEdge + +private abbrev edge_vertex := BoundaryFootprintInclusion.edgeVertex + +private abbrev boundary_vertex_footprint := BoundaryFootprintInclusion.boundaryVertex private theorem R_symm : (by @@ -214,36 +171,8 @@ private theorem p₁chain : exact ⟨edge_parent X hXc hXf _ he.1, edge_parentB Y hYc _ he.2⟩ -private theorem p₃chain : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (Z : ProtoTile), ∀ (W : ProtoTile), (Z.cells ⊆ - A.cells) → ((W.cells ⊆ B.cells) → ((FootprintVertices Z ⊆ FootprintVertices A) → - ((FootprintVertices W ⊆ FootprintVertices B) → (∀ (p₃ : List GaussianInt), (∀ z ∈ p₃, - z ∈ FootprintVertices Z ∩ FootprintVertices W) → ((∀ (a : GaussianInt), ∀ (b : - GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), p₃ = l₁ ++ a :: b - :: l₂ → {a, b} ∈ FootprintEdges Z ∩ FootprintEdges W) → ( - let R : GaussianInt → GaussianInt → Prop := fun u v => - u ∈ FootprintVertices A ∩ FootprintVertices B ∧ - v ∈ FootprintVertices A ∩ FootprintVertices B ∧ - {u, v} ∈ FootprintEdges A ∩ FootprintEdges B - (∀ (T : ProtoTile), (T.cells ⊆ A.cells) → ((FootprintVertices T ⊆ FootprintVertices A) → - (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges T) → (e ∈ FootprintEdges A)))) → ((∀ - (T : ProtoTile), (T.cells ⊆ B.cells) → (∀ (e : Finset GaussianInt), (e ∈ - FootprintEdges T) → (e ∈ FootprintEdges B))) → (List.IsChain R p₃)))))))) ) := by - classical - intro A B Z W hZc hWc hZf hWf p₃ hp₃v hp₃e R edge_parent edge_parentB - apply List.isChain_iff_forall_rel_of_append_cons_cons.mpr - intro u v l r h - refine ⟨?_, ?_, ?_⟩ - · have hu := hp₃v u (by simp [h]) - exact ⟨hZf hu.1, hWf hu.2⟩ - · have hv := hp₃v v (by simp [h]) - exact ⟨hZf hv.1, hWf hv.2⟩ - · have he := hp₃e u v l r h - exact ⟨edge_parent Z hZc hZf _ he.1, - edge_parentB W hWc _ he.2⟩ +private abbrev p₃chain := + ApollonianSuperharmonic.PrecursorWalkGeometry.p₁chain private theorem p₁mem : (by diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean b/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean index 739828f9f9..9956d9d933 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean @@ -291,33 +291,6 @@ private theorem hbAt256 : rw [Int.natCast_natAbs, abs_of_nonpos (by omega : -k ≤ 0)] omega -private theorem hlAt265 : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), - let k : Int := K.1 - let C (p q : Int) : Prop := - 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ - -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 - let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 - (∀ (p : Int), ∀ (q : Int), FourNeighborLaplacian f ⟨p,q⟩ = (f ⟨p+1,q⟩ - f ⟨p,q⟩) + (f - ⟨p-1,q⟩ - f ⟨p,q⟩) + (f ⟨p,q+1⟩ - f ⟨p,q⟩) + (f ⟨p,q-1⟩ - f ⟨p,q⟩)) → ((C (⟨-k, k⟩ : - GaussianInt).re - (⟨-k, k⟩ : GaussianInt).im) → ((U ((⟨-k, k⟩ : GaussianInt).re - (-k - (1 : ℤ))) - ((⟨-k, k⟩ : GaussianInt).im - k)) → ((f ⟨-k, k + (1 : - ℤ)⟩ = k * (k - (1 : ℤ)) / (2 : ℤ) - (k ^ (2 : ℕ) + k)) → ((f ⟨-k - (1 : ℤ), k⟩ = (-k - - (1 : ℤ)) * k + B) → ((f ⟨-k, k⟩ = (-k - (1 : ℤ)) * k + B) → (((Int.natAbs (1-k) : - Int) = k-1) → (((Int.natAbs (-k) : Int) = k) → ((f ⟨(1 : ℤ) - k, k⟩ = (k - (1 : ℤ)) * - (k - (2 : ℤ)) / (2 : ℤ) - (k ^ (2 : ℕ) - k)) → ((f ⟨-k, k - (1 : ℤ)⟩ = k * (k - (1 : - ℤ)) / (2 : ℤ) - (k ^ (2 : ℕ) - k)) → ((f ⟨-k, k⟩ = k * (k - (1 : ℤ)) / (2 : ℤ) - k ^ - (2 : ℕ)) → ((k * (k - (1 : ℤ)) / (2 : ℤ) - (k - (1 : ℤ)) * (k - (2 : ℤ)) / (2 : ℤ) = - k - (1 : ℤ)) → (FourNeighborLaplacian f ⟨-k,k⟩ = 1)))))))))))) ) := by - classical - intro K f B k C U lap center unitCenter hn hdiffW hdiffZ ha hb he hs hc ht - rw [lap, show -k+1 = 1-k by ring] - omega - private theorem hzAt275 : (by classical @@ -406,33 +379,6 @@ private theorem hmarkAt309 : dsimp [C] omega -private theorem hlAt331 : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), - let k : Int := K.1 - let C (p q : Int) : Prop := - 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ - -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 - let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 - (∀ (p : Int), ∀ (q : Int), FourNeighborLaplacian f ⟨p,q⟩ = (f ⟨p+1,q⟩ - f ⟨p,q⟩) + (f - ⟨p-1,q⟩ - f ⟨p,q⟩) + (f ⟨p,q+1⟩ - f ⟨p,q⟩) + (f ⟨p,q-1⟩ - f ⟨p,q⟩)) → ((C (⟨k, k⟩ : - GaussianInt).re - (⟨k, k⟩ : GaussianInt).im) → ((U ((⟨k, k⟩ : GaussianInt).re - k) ((⟨k, k⟩ : - GaussianInt).im - (k - (1 : ℤ)))) → ((f ⟨k, k - (1 : ℤ)⟩ - = k * (k - (1 : ℤ)) / (2 : ℤ)) → ((f ⟨k + (1 : ℤ), k⟩ = (1 : ℤ) + (k - (1 : ℤ)) * (k - + (1 : ℤ)) + B) → ((f ⟨k, k⟩ = (k - (1 : ℤ)) * k + B) → ((f ⟨k+1,k⟩ - f ⟨k,k⟩ = k) → - (((Int.natAbs (k-1) : Int) = k-1) → (((Int.natAbs k : Int) = k) → ((f ⟨k - (1 : ℤ), - k⟩ = (k - (1 : ℤ)) * (k - (2 : ℤ)) / (2 : ℤ)) → ((f ⟨k, k + (1 : ℤ)⟩ = k * (k - (1 : - ℤ)) / (2 : ℤ)) → ((f ⟨k, k⟩ = k * (k - (1 : ℤ)) / (2 : ℤ)) → ((k * (k - (1 : ℤ)) / (2 - : ℤ) - (k - (1 : ℤ)) * (k - (2 : ℤ)) / (2 : ℤ) = k - (1 : ℤ)) → - (FourNeighborLaplacian f ⟨k,k⟩ = 1))))))))))))) ) := by - classical - intro K f B k C U lap center unitCenter hs hdiffE hdiffZ he ha hb hw hn hc ht - rw [lap] - omega - end FirstUnitProof theorem P5352T2FirstUnit (K : DiamondParameter) (hk : 1 < K.1) @@ -544,8 +490,12 @@ theorem P5352T2FirstUnit (K : DiamondParameter) (hk : 1 < K.1) rw [show -k-(k-1) = 1-2*k by ring, sqp] at hs rw [show -k-k = -(2*k) by ring, neg_sq, sq0] at hc have ht := triDiff k - have hl : FourNeighborLaplacian f ⟨-k,k⟩ = 1 := FirstUnitProof.hlAt265 K f B lap center - unitCenter hn hdiffW hdiffZ ha hb he hs hc ht + have hl : FourNeighborLaplacian f ⟨-k,k⟩ = 1 := (show + FourNeighborLaplacian f ⟨-k,k⟩ = 1 + from by + classical + rw [lap, show -k+1 = 1-k by ring] + omega) exact ⟨fun h => False.elim (hmark h), fun _ => hl⟩ · have hw := covered (z.re-1) z.im (Or.inr (Or.inr (Or.inl (by ext <;> simp)))) @@ -595,8 +545,12 @@ theorem P5352T2FirstUnit (K : DiamondParameter) (hk : 1 < K.1) norm_num [P4207T1DiamondFormula, ha, hb] at hw hn hs hc rw [show k-1-1 = k-2 by ring] at hw have ht := triDiff k - have hl : FourNeighborLaplacian f ⟨k,k⟩ = 1 := FirstUnitProof.hlAt331 K f B lap center - unitCenter hs hdiffE hdiffZ he ha hb hw hn hc ht + have hl : FourNeighborLaplacian f ⟨k,k⟩ = 1 := (show + FourNeighborLaplacian f ⟨k,k⟩ = 1 + from by + classical + rw [lap] + omega) exact ⟨fun h => False.elim (hmark h), fun _ => hl⟩ end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean index 776998fd53..1fc2790f0b 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean @@ -546,59 +546,6 @@ private theorem qPC : rw [ha] norm_num [T] -private theorem qPN : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), - let k : Int := K.1 - ∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ -(k - (1 : - ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + b ∧ a + k ≤ b - (k + (1 : - ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ a + - k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : ℤ)) → (((↑(K.1 - (1 : ℕ)) : - ℤ) = k - (1 : ℤ)) → ( - let Q : Int → Int → Int := fun x y => - (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 - let T : Int → Int := fun n => n*(n-1)/2 - (b = (2 : ℤ) * k + (1 : ℤ) + a) → ( - let t : Int := -a - let zA : GaussianInt := ⟨-t,2*k+1-t⟩ - (f zA=Q (-t) (2*k+1-t)) → ((f zA=Q (k-t) (k-t)+(-t)-k*(2*k+1-t)+B) → ((f (zA-1)=Q (k-t-1) - (k-t)+(-t-1)-k*(2*k+1-t)+B) → ((f (zA+⟨0,1⟩)=Q (k-t) (k+1-t)+(-t)-k*(2*k+2-t)+B) → - ((Q (-t) (2*k+1-t)=T t-(k*k+k)) → ((Q (k-t) (k-t)=T (k-t)) → (Q (k-t) (k+1-t)=T - (k-t)))))))))) ) := by - classical - intro K f B k a b hdpred hcast Q T hb t zA hC hPC hPW hPN qC qPC - unfold Q - have ha : (Int.natAbs (k-t):Int)=k-t := by - rw [Int.natCast_natAbs,abs_of_nonneg (show 0≤k-t by omega)] - rw [ha] - norm_num [T] - -private theorem qPWlt : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), - let k : Int := K.1 - ∀ (a : ℤ), (ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → ( - let Q : Int → Int → Int := fun x y => - (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 - let T : Int → Int := fun n => n*(n-1)/2 - let t : Int := -a - let zA : GaussianInt := ⟨-t,2*k+1-t⟩ - (f zA=Q (-t) (2*k+1-t)) → ((f zA=Q (k-t) (k-t)+(-t)-k*(2*k+1-t)+B) → ((f (zA-1)=Q (k-t-1) - (k-t)+(-t-1)-k*(2*k+1-t)+B) → ((f (zA+⟨0,1⟩)=Q (k-t) (k+1-t)+(-t)-k*(2*k+2-t)+B) → - ((Q (-t) (2*k+1-t)=T t-(k*k+k)) → ((Q (k-t) (k-t)=T (k-t)) → ((Q (k-t) (k+1-t)=T - (k-t)) → (t < k → Q (k - t - (1 : ℤ)) (k - t) = T (k - t - (1 : ℤ))))))))))) ) := by - classical - intro K f B k a b hcast Q T t zA hC hPC hPW hPN qC qPC qPN hlt - unfold Q - have ha : (Int.natAbs (k-t-1):Int)=k-t-1 := by - rw [Int.natCast_natAbs,abs_of_nonneg (show 0≤k-t-1 by omega)] - rw [ha] - norm_num [T] - private theorem qPWeq : (by classical @@ -1045,10 +992,24 @@ theorem P5352T2Predecessor2 (K : DiamondParameter) (hk : 1 < K.1) hPC hPW hPN have qPC := SecondPredecessorProof.qPC K f B a b hdpred hcast hb hC hPC hPW hPN qC - have qPN := SecondPredecessorProof.qPN K f B a b hdpred hcast hb - hC hPC hPW hPN qC qPC - have qPWlt (hlt : t rcases hb with h3 | h3 + · exact False.elim (hab (h1.trans h3.symm)) + · exact Or.inl ⟨h1, h3⟩ + · exact Or.inr ⟨h1, h3⟩ + · exact False.elim (hab (h1.trans h3.symm)) + +/-- Equality of unordered pairs gives one of the two ordered assignments. -/ +theorem finsetPair {α : Type*} [DecidableEq α] {a b c d : α} + (h : ({a, b} : Finset α) = {c, d}) : (a = c ∧ b = d) ∨ (a = d ∧ b = c) := by + classical + have hs : ({a, b} : Set α) = {c, d} := by + ext x + have hx := congrArg (fun s : Finset α => x ∈ s) h + apply Iff.of_eq + change (x = a ∨ x = b) = (x = c ∨ x = d) + simpa only [Finset.mem_insert, Finset.mem_singleton] using hx + exact Set.pair_eq_pair_iff.mp hs + +end PairAssignmentFacts +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometerEquality.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometerEquality.lean new file mode 100644 index 0000000000..1ddb6e40a1 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometerEquality.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.PartialOdometer +public import Mathlib.Init + + +/-! +# PartialOdometerEquality + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace PartialOdometerEquality + +/-- Equal domains and values determine the partial odometer. -/ +theorem extensionality (h k : PartialOdometer) + (hdom : (h.domain : Set GaussianInt) = k.domain) (hvalue : ∀ x, h.value x = k.value x) : + h = k := by + cases h with + | mk hd hv hout => + have hdomEq : hd = k.domain := Finset.coe_injective hdom + have hvalEq : hv = k.value := funext hvalue + cases hdomEq + cases hvalEq + rfl + +end PartialOdometerEquality +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean index 6acefe96ee..cfae60a13d 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean @@ -605,42 +605,11 @@ private theorem indexBoundaryPath : h2head h2last h2mem h2chain exact ⟨l, hhead, hlast, hmem, hchain⟩ -private theorem indexedDisjoint : - (by - classical - exact - ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (a : TilingLattice - C), ∀ (b : TilingLattice C), (P.plane.adjacent a b) → (Disjoint (P.tile a).cells - (P.tile b).cells) ) := by - classical - intro C P a b hab - apply Finset.disjoint_left.mpr - intro x hxa hxb - obtain ⟨owner, howner, hunique⟩ := PeriodicTileIndexedMultiplicityOne P x - have ha : a = owner := hunique a hxa - have hb : b = owner := hunique b hxb - have hne : a ≠ b := by - intro hab' - rw [← hab'] at hab - exact P.plane.adjacent_irreflexive a hab - exact hne (ha.trans hb.symm) +private abbrev indexedDisjoint := + ApollonianSuperharmonic.BoundaryWebGeometry.indexedDisjointEarly -private theorem edgeBoundary : - (by - classical - exact - ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), (∀ (a : TilingLattice - C), ∀ (b : TilingLattice C), (P.plane.adjacent a b) → (Disjoint (P.tile a).cells - (P.tile b).cells)) → (∀ (a : TilingLattice C), ∀ (b : TilingLattice C), - (P.plane.adjacent a b) → (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges (P.tile a) - ∩ FootprintEdges (P.tile b)) → (e ∈ BoundaryFootprintEdges (P.tile a) ∩ - BoundaryFootprintEdges (P.tile b)))) ) := by - classical - intro C P indexedDisjoint a b hab e he - have he' := he - rw [CellDisjointCommonEdgesBoundary (P.tile a) (P.tile b) - (indexedDisjoint a b hab)] at he' - exact he' +private abbrev edgeBoundary := + ApollonianSuperharmonic.BoundaryWebGeometry.edgeBoundaryEarly private theorem noBoundaryIncident : (by diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean index 33984cad1e..043a574426 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean @@ -1267,31 +1267,8 @@ private theorem hxM : simpa [tileM] using hxv exact (Set.ext_iff.mp hdomu x).mpr hxv' -private theorem hxW : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (x : GaussianInt), ∀ (P - : PeriodicTileComplex ↥(TilingLattice C)), ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : - ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), - let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] - ∀ (w : Fin (4 : ℕ)), - let sector : Fin 4 → GaussianInt := - ![x, x - 1, x - 1 - ⟨0, 1⟩, x - ⟨0, 1⟩] - let u' : GaussianInt := owner w - ∀ (au' : GaussianInt), - let hu'Odo : PartialOdometer := PartialOdometerAffineTranslate h u' au' 0 - ((hu'Odo.domain : Set GaussianInt) = FootprintVertices (TileTranslation T u')) → ((P.tile - (owner w) = TileTranslation T u') → ((∀ (i : Fin 4), ∀ (y : GaussianInt), (y = sector - i ∨ y = sector i + 1 ∨ y = sector i + ⟨0, 1⟩ ∨ y = sector i + 1 + ⟨0, 1⟩) → (y ∈ - FootprintVertices (P.tile (owner i)))) → ((∀ i : Fin 4, x = sector i ∨ x = sector i + - 1 ∨ x = sector i + ⟨0, 1⟩ ∨ x = sector i + 1 + ⟨0, 1⟩) → (x ∈ hu'Odo.domain)))) ) := by - classical - intro C T h x P a0 a1 a2 a3 owner w sector u' au' hu'Odo hdomu' tileW cellVertex sectorCornerX - have hxv := cellVertex w x (sectorCornerX w) - have hxv' : x ∈ FootprintVertices (TileTranslation T u') := by - simpa [tileW] using hxv - exact (Set.ext_iff.mp hdomu' x).mpr hxv' +private abbrev hxW := + ApollonianSuperharmonic.WebLaplacianGeometry.hxM private theorem hstar : (by diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean index e3ab42af44..6373099307 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.PairAssignmentFacts +public import LeanPool.ApollonianSuperharmonic.TileCornerMultiplicity public import LeanPool.ApollonianSuperharmonic.CircleMatrixSymmetry public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity @@ -186,21 +188,8 @@ private theorem hvertex_partition : intro T D heuler I cornerBag N hinc hN4 omega -private theorem pair_eq : - (by - classical - exact - ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ {d : GaussianInt}, (({a, - b} : Finset GaussianInt) = {c, d}) → ((a = c ∧ b = d) ∨ (a = d ∧ b = c)) ) := by - classical - intro a b c d h - have hs : ({a, b} : Set GaussianInt) = {c, d} := by - ext x - have hx := congrArg (fun s : Finset GaussianInt => x ∈ s) h - apply Iff.of_eq - change (x = a ∨ x = b) = (x = c ∨ x = d) - simpa only [Finset.mem_insert, Finset.mem_singleton] using hx - exact Set.pair_eq_pair_iff.mp hs +private abbrev pair_eq := + @PairAssignmentFacts.finsetPair GaussianInt inferInstance private theorem edgeOf_injective : (by @@ -261,23 +250,8 @@ private theorem edgeOf_injective : norm_num at h1i h2i omega -private theorem hV : - (by - classical - exact - ∀ (T : ProtoTile), (T.cells.Nonempty) → ( - let I : GaussianInt := ⟨0, 1⟩ - let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => - ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) - let V := cornerBag.toFinset - (V : Set GaussianInt) = FootprintVertices T) ) := by - classical - intro T hcells I cornerBag V - ext z - change z ∈ cornerBag.toFinset ↔ z ∈ FootprintVertices T - rw [Multiset.mem_toFinset] - dsimp only [cornerBag, I] - simp [FootprintVertices, hcells] +private abbrev hV := + TileCornerMultiplicity.vertexSupport private theorem hEV : (by diff --git a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean index f263ff5eb1..dd245acc4c 100644 --- a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean @@ -7,6 +7,9 @@ module public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryPartialOdometerActionFormulas -- [TABLET NODE: RightLatticeAdjacentPackingSymmetryTransport] diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean index 96fe633f66..2be874ef26 100644 --- a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.ListEndpointFacts public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween @@ -72,23 +73,8 @@ private theorem hpform : simp only [List.head?_cons, Option.some.injEq] at hx exact ⟨r, by simp [hx]⟩ -private theorem hqform : - ∀ (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (x' : GaussianInt), ∀ (y' : - GaussianInt), ∀ (q : List GaussianInt), (q.Nodup) → (((2 : ℕ) ≤ q.length) → ((q.head? = - some x') → ((q.getLast? = some y') → ((V = (↑q.toFinset : Set GaussianInt)) → ((∀ (a : - GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), - q = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + - { re := (0 : ℤ), im := (1 : ℤ) } ∨ b = a - { re := (0 : ℤ), im := (1 : ℤ) }) → ((∀ (e : - Finset GaussianInt), e ∈ E ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List - GaussianInt) (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((q ≠ []) → - (∃ r, q = x' :: r)))))))) := by - classical - intro V E x' y' q hq hqlen hx' hy' hV' hstep' hE' hqne - cases q with - | nil => exact False.elim (hqne rfl) - | cons a r => - simp only [List.head?_cons, Option.some.injEq] at hx' - exact ⟨r, by simp [hx']⟩ +private abbrev hqform := + ApollonianSuperharmonic.EndpointPairProof.hpform private theorem endpoint_edge : ∀ (r : List GaussianInt), ∀ (z : GaussianInt), r.Nodup → 2 ≤ r.length → r.head? = some z → @@ -126,18 +112,8 @@ private theorem endpoint_edge : · simp [hab] · simpa using he -private theorem split_mem : - ∀ (r : List GaussianInt), ∀ (z : GaussianInt), z ∈ r → ∃ l t, r = l ++ z :: t := by - classical - intro r z hzmem - induction r with - | nil => simp at hzmem - | cons a r ih => - simp only [List.mem_cons] at hzmem - rcases hzmem with rfl | hzmem - · exact ⟨[], r, rfl⟩ - · rcases ih hzmem with ⟨l, t, ht⟩ - exact ⟨a :: l, t, by simp [ht, List.cons_append]⟩ +private abbrev split_mem := + @ListEndpointFacts.splitMembership GaussianInt private theorem endpoint_unique : (∀ (r : List GaussianInt), ∀ (z : GaussianInt), r.Nodup → 2 ≤ r.length → r.head? = some z → ∀ diff --git a/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean index f59f02ac4f..699f5439c0 100644 --- a/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileOdometerSlopeNonempty public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryScopedPhase @@ -132,28 +133,8 @@ private theorem support_nonempty : exact ∀ (C : CircleCoordinates), ∀ (U : ProtoTile), ∀ (h : PartialOdometer), ∀ (p : ℝ × ℝ), 0 < C.1 → TileOdometer C U h → PartialOdometerSlope h = some p → U.cells.Nonempty ) := by - classical - intro C U h p hpos hO hp - have hd := PositiveCurvatureTileOdometerDomain C U h hpos hO - by_contra hn - have hde : (h.domain : Set GaussianInt) = {U.anchor} := by - rw [hd] - simp [FootprintVertices, hn] - have hs : (PartialOdometerSquares h).Nonempty := by - by_contra hs - simp [PartialOdometerSlope, hs] at hp - rcases hs with ⟨x, hx⟩ - simp only [PartialOdometerSquares, Finset.mem_filter] at hx - have hz : x + 1 = U.anchor := by - apply Set.mem_singleton_iff.mp - rw [← hde] - exact hx.2.1 - have hz0 : x = U.anchor := by - apply Set.mem_singleton_iff.mp - rw [← hde] - exact hx.1 - have hzbad := congrArg (fun z : GaussianInt => z.re) (hz.trans hz0.symm) - norm_num at hzbad + intro C U k p _ hO hp + exact TileOdometerSlopeNonempty.cells C U k p hO hp private theorem hsr₀ : (by diff --git a/LeanPool/ApollonianSuperharmonic/TileCornerMultiplicity.lean b/LeanPool/ApollonianSuperharmonic/TileCornerMultiplicity.lean index 4eca451ca2..9db1e371ca 100644 --- a/LeanPool/ApollonianSuperharmonic/TileCornerMultiplicity.lean +++ b/LeanPool/ApollonianSuperharmonic/TileCornerMultiplicity.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.ProtoTile public import Mathlib.Init + /-! # TileCornerMultiplicity @@ -61,6 +63,21 @@ theorem cornerCount : Finset.sum_ite_eq'] omega +/-- Shared vertexSupport fact. -/ +theorem vertexSupport : + ∀ (T : ProtoTile), (T.cells.Nonempty) → ( + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => + ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + (cornerBag.toFinset : Set GaussianInt) = FootprintVertices T) := by + classical + intro T hne I cornerBag + ext z + change z ∈ cornerBag.toFinset ↔ z ∈ FootprintVertices T + rw [Multiset.mem_toFinset] + dsimp only [cornerBag, I] + simp [FootprintVertices, hne] + end TileCornerMultiplicity end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerSlopeNonempty.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerSlopeNonempty.lean new file mode 100644 index 0000000000..2d88f1f9b8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerSlopeNonempty.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.TileOdometerDomain +public import Mathlib.Init + + +/-! +# TileOdometerSlopeNonempty + +Shared facts adapted from Wesley Pegden's Apache-2.0 Trellis formalization. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic +namespace TileOdometerSlopeNonempty + +/-- A tile odometer with a defined slope has a nonempty tile. -/ +theorem cells (c : CircleCoordinates) (T : ProtoTile) + (h : PartialOdometer) (p : ℝ × ℝ) (hO : TileOdometer c T h) + (hp : PartialOdometerSlope h = some p) : T.cells.Nonempty := by + classical + have hd := TileOdometerDomain c T h hO + by_contra hn + have hde : (h.domain : Set GaussianInt) = {T.anchor} := by + rw [hd] + simp [FootprintVertices, hn] + have hs : (PartialOdometerSquares h).Nonempty := by + by_contra hs + simp [PartialOdometerSlope, hs] at hp + rcases hs with ⟨x, hx⟩ + simp only [PartialOdometerSquares, Finset.mem_filter] at hx + have hz : x + 1 = T.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.2.1 + have hz0 : x = T.anchor := by + apply Set.mem_singleton_iff.mp + rw [← hde] + exact hx.1 + have hzbad : x + 1 = x := hz.trans hz0.symm + have hzbad' := congrArg (fun z : GaussianInt => z.re) hzbad + norm_num at hzbad' + + + +end TileOdometerSlopeNonempty +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/TileQuarterTurnTranslation.lean b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnTranslation.lean index d3e9c15a06..4ed647b66b 100644 --- a/LeanPool/ApollonianSuperharmonic/TileQuarterTurnTranslation.lean +++ b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnTranslation.lean @@ -7,9 +7,11 @@ module public import LeanPool.ApollonianSuperharmonic.TileQuarterTurn public import LeanPool.ApollonianSuperharmonic.TileTranslation +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import Mathlib.Init + /-! # TileQuarterTurnTranslation @@ -46,6 +48,12 @@ theorem commute : · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, GaussianQuarterTurn, add_comm] +/-- Quarter-turn covariance commutes with a further translation. -/ +theorem translated (A : ProtoTile) (a u : GaussianInt) : + TileTranslation (TileQuarterTurn (TileTranslation A a)) u = + TileTranslation (TileTranslation (TileQuarterTurn A) u) (GaussianQuarterTurn a) := by + rw [commute, TileTranslationProperties.add, TileTranslationProperties.add, add_comm] + end TileQuarterTurnTranslation end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean b/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean index 2a0c71ba49..7d0283c1e1 100644 --- a/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean +++ b/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandLayoutCentroidCoordinates public import LeanPool.ApollonianSuperharmonic.TileHalfTurnGeometry public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralFinitePatches @@ -207,35 +208,8 @@ private theorem harea : exact_mod_cast (Int.natAbs_of_nonneg (le_of_lt C₀.property)).trans (Int.toNat_of_nonneg (le_of_lt C₀.property)).symm -private theorem ht : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), ∀ (u : GaussianInt), (GaussianRealPoint u = ((TileCentroid (cert.P (0 : Fin (3 - : ℕ)) false)).1 + (TileCentroid (cert.P (0 : Fin (3 : ℕ)) false)).2, (TileCentroid - (cert.P (0 : Fin (3 : ℕ)) false)).2 - (TileCentroid (cert.P (0 : Fin (3 : ℕ)) - false)).1)) → ( - let w := BandVectors.1 (q 3) (q 2) - let t : GaussianInt := - ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ - (t.re : Real) = 2 * (TileCentroid T).1 ∧ (t.im : Real) = 2 * (TileCentroid T).2) ) := by - classical - intro q cfg C₀ T cert u hu w t - have hur := congrArg Prod.fst hu - have hui := congrArg Prod.snd hu - have hc := (cert.outer_occurrence 0 false).2.2 - have hcr := congrArg Prod.fst hc - have hci := congrArg Prod.snd hc - norm_num [GaussianRealPoint] at hur hui hcr hci - simp only [← GaussianInt.intCast_re, ← GaussianInt.intCast_im] at hur hui hcr hci - dsimp [t, w] - push_cast - constructor <;> linarith - - - +private abbrev ht := + BandLayoutCentroidCoordinates.doubledCenter private theorem hcenter : (by diff --git a/LeanPool/ApollonianSuperharmonic/TileTranslationProperties.lean b/LeanPool/ApollonianSuperharmonic/TileTranslationProperties.lean index d57fc633a0..2085ead152 100644 --- a/LeanPool/ApollonianSuperharmonic/TileTranslationProperties.lean +++ b/LeanPool/ApollonianSuperharmonic/TileTranslationProperties.lean @@ -5,10 +5,12 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.TileTranslation public import LeanPool.ApollonianSuperharmonic.TileTranslationFormulas public import Mathlib.Init + /-! # TileTranslationProperties @@ -62,6 +64,14 @@ theorem add : simp [TileTranslation, GaussianTranslation, add_comm, add_left_comm] · simp [TileTranslation, GaussianTranslation, add_comm, add_left_comm] +/-- Cell inclusion is preserved by translating both tiles. -/ +theorem cellsSubset (X Y : ProtoTile) (hXY : X.cells ⊆ Y.cells) (d : GaussianInt) : + (TileTranslation X d).cells ⊆ (TileTranslation Y d).cells := by + rw [cells, cells] + intro z hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + exact Finset.mem_image.mpr ⟨w, hXY hw, rfl⟩ + end TileTranslationProperties end ApollonianSuperharmonic From 2257e80b4598543ba1a6bb5e5df8c22eadbe1114 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 13 Nov 2026 01:19:46 +0000 Subject: [PATCH 11/23] Share grid path reversal and remove redundant proof interfaces --- .../AffineOpposingStripCorridor.lean | 28 +- .../BandOdometerInteriorTable.lean | 24 +- .../BandOrderedGeneralChildInterfaces.lean | 33 +- .../BandOrderedGeneralLayout.lean | 14 +- ...alRightNormalizationCertificateExists.lean | 65 +- ...SubtileNormalizationCertificateExists.lean | 100 +-- ...PackingSymmetryAffineVectorCovariance.lean | 130 +--- ...PackingSymmetryTileOdometerCovariance.lean | 336 +------- .../BandTileTopologyApplication.lean | 26 +- .../BoundaryStringOdometerRespect.lean | 6 +- .../FiniteBiconnectedHorizontalRunTree.lean | 19 +- .../FordCoordinateConfiguration.lean | 44 +- .../FordLaplacianTable.lean | 160 ++-- .../FordOrientedChildParentEndpoints.lean | 722 +----------------- .../LatticeTileBoundarySimpleGridCycle.lean | 32 +- .../LatticeTileThreeDiskJunction.lean | 53 +- .../OpposingStringInterfacePath.lean | 21 +- .../P3523T1OrderedInsertion.lean | 12 +- .../P3555T2ParabolaChordCuts.lean | 42 +- .../P3555T2SavedDissectionGeometry.lean | 10 +- .../P3650T1MaximalHeightDiagonal.lean | 31 +- .../P3650T1OldArcEven.lean | 102 +-- .../P3652T1IndexedFaceLedger.lean | 356 +-------- .../P3723T1AllContactDrawingExists.lean | 83 +- .../P3723T1ContactPortsExist.lean | 591 +------------- .../P3776T1SectorMapsExist.lean | 93 +-- .../P3889T1FaceGapCoverage.lean | 142 ++-- .../P3913T1RoutedFaceSubdivision.lean | 270 ++----- .../P3934T1ArcSideComparison.lean | 10 +- .../P3963T1ExteriorMixedCycleObstruction.lean | 38 +- .../P3963T1MixedBoundaryCycle.lean | 280 +++---- .../P3996T1PlacementCompanionBlocks.lean | 21 +- .../P4062T1OverlapDescent.lean | 64 +- .../P4120T1GeneralDescent.lean | 18 +- .../P4158T1EdgeSectorSelection.lean | 32 +- .../P4158T1LargeFirstRestrictions.lean | 19 +- .../P4158T1LargeSecondRestrictions.lean | 22 +- .../P4158T1SmallerStringEdges.lean | 56 +- .../P4250T1ReflectedGluingSlope.lean | 13 +- .../P4250T2FiniteForestCompletion.lean | 85 +-- .../P4261T2UnitBoundary.lean | 65 +- .../P4366T2OuterGeometry.lean | 56 +- .../P4418T3OuterCompanionAlignment.lean | 12 +- .../P4418T3PresentedRowAdjacency.lean | 12 +- .../P4418T3SelectedInterfaceExists.lean | 41 +- .../P4456T2SquareEdges.lean | 16 +- .../P4458T1SecondNewerRows.lean | 114 +-- .../P4564T2FordT6Transport.lean | 7 +- .../P4812T1RegularFaceWalks.lean | 19 +- .../P4849T1LargePositiveComponents.lean | 60 +- .../P5023T1CircularSide.lean | 26 +- .../P5023T1ContactHull.lean | 10 +- .../P5130T5SameParentOverlaps.lean | 12 +- .../P5260T1PredecessorInterfaces.lean | 46 +- .../P5290T1EqualDiamondPaths.lean | 32 +- .../P5332T1RightSecondValues.lean | 22 +- .../P5352T2FirstUnit.lean | 34 +- .../P5352T2Predecessor0.lean | 56 +- .../P5352T2Predecessor1.lean | 40 +- .../P5352T2Predecessor2.lean | 32 +- .../P5352T2Predecessor3.lean | 65 +- .../P5352T2RightHorizontal.lean | 24 +- .../P5352T2RightSecond.lean | 28 +- .../P5596T1LeftWeb.lean | 18 +- .../PeriodicBoundaryWebLaplacian.lean | 13 +- .../SimpleGridPathBetween.lean | 30 +- .../TileOdometerExists.lean | 26 +- 67 files changed, 1162 insertions(+), 3957 deletions(-) diff --git a/LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean b/LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean index 93f76e2e17..016a56b8df 100644 --- a/LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean +++ b/LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean @@ -628,19 +628,19 @@ private theorem pmem : classical exact ∀ (P : List (ℤ × ℤ)), ∀ (A : ℤ), ∀ (B : ℤ), - let h : Int → Int := fun k => (B*k+A-1)/A - (TriangularMaxIncrement (0,0) (A,B) = A) → ((TriangularMaxIncrement (A,B) (0,0) = A) → ( - let N := A.toNat + let h : Int → Int := fun k => (B*k+A-1)/A; + ((TriangularMaxIncrement (A,B) (0,0) = A) → ( + let N := A.toNat; ((N : Int) = A) → ( - let p : Nat → Int × Int := fun k => (k, h k) - let PP := (List.range (N+1)).map p + let p : Nat → Int × Int := fun k => (k, h k); + let PP := (List.range (N+1)).map p; (PP.head? = some (0,0)) → ((PP.getLast? = some (A,B)) → ((P = PP) → ((∀ (path : List (Int × Int)), ∀ (a : Int × Int), ∀ (b : Int × Int), ∀ (z : Int × Int), (path.head? = some a) → ((path.getLast? = some b) → ((z ∈ path) → ((z ≠ a) → ((z ≠ b) → (z ∈ (path.drop 1).dropLast)))))) → (∀ (k : ℕ), (0 : ℕ) < k ∧ k < N → p k ∈ (List.drop (1 : ℕ) P).dropLast))))))) ) := by classical - intro P A B h hmax hrmax N hN p PP phead plast Peq interior k hk + intro P A B h hrmax N hN p PP phead plast Peq interior k hk rw [Peq] apply interior PP (0,0) (A,B) (p k) phead plast · apply List.mem_map.mpr @@ -653,19 +653,19 @@ private theorem qmem : classical exact ∀ (Q : List (ℤ × ℤ)), ∀ (A : ℤ), ∀ (B : ℤ), - let l : Int → Int := fun k => (B*k)/A - (TriangularMaxIncrement (0,0) (A,B) = A) → ((TriangularMaxIncrement (A,B) (0,0) = A) → ( - let N := A.toNat + let l : Int → Int := fun k => (B*k)/A; + ((TriangularMaxIncrement (A,B) (0,0) = A) → ( + let N := A.toNat; ((N : Int) = A) → ( - let q : Nat → Int × Int := fun k => (k, l k) - let QQ := ((List.range (N+1)).map q).reverse + let q : Nat → Int × Int := fun k => (k, l k); + let QQ := ((List.range (N+1)).map q).reverse; (((List.range (N+1)).map q).head? = some (0,0)) → ((((List.range (N+1)).map q).getLast? = some (A,B)) → ((Q = QQ) → ((∀ (path : List (Int × Int)), ∀ (a : Int × Int), ∀ (b : Int × Int), ∀ (z : Int × Int), (path.head? = some a) → ((path.getLast? = some b) → ((z ∈ path) → ((z ≠ a) → ((z ≠ b) → (z ∈ (path.drop 1).dropLast)))))) → (∀ (k : ℕ), (0 : ℕ) < k ∧ k < N → q k ∈ (List.drop (1 : ℕ) Q).dropLast))))))) ) := by classical - intro Q A B l hmax hrmax N hN q QQ qhead qlast Qeq interior k hk + intro Q A B l hrmax N hN q QQ qhead qlast Qeq interior k hk rw [Qeq] apply interior QQ (A,B) (0,0) (q k) · simpa [QQ] using qlast @@ -1158,9 +1158,9 @@ theorem AffineOpposingStripCorridor (ha : path.head? = some a) (hb : path.getLast? = some b) (hz : z ∈ path) (hza : z ≠ a) (hzb : z ≠ b) := OpposingStripProof.interior path a b z ha hb hz hza hzb - have pmem (k : Nat) (hk : 0 < k ∧ k < N) := OpposingStripDetails.pmem P A B hmax hrmax hN + have pmem (k : Nat) (hk : 0 < k ∧ k < N) := OpposingStripDetails.pmem P A B hrmax hN phead plast Peq interior k hk - have qmem (k : Nat) (hk : 0 < k ∧ k < N) := OpposingStripDetails.qmem Q A B hmax hrmax hN + have qmem (k : Nat) (hk : 0 < k ∧ k < N) := OpposingStripDetails.qmem Q A B hrmax hN qhead qlast Qeq interior k hk have gap (k : Int) := OpposingStripDetails.gap A B hA hl hh k have between (k : Int) := OpposingStripDetails.between A B diff --git a/LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean b/LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean index 90bddde7af..171ab00853 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean @@ -126,28 +126,6 @@ private theorem orderedGeneralRowDispatch : · intro _ exact lap -private theorem orderedGeneralCenteredDispatch : - (by - classical - exact - ∀ (q' : Fin 4 → CircleCoordinates), ∀ (cfg' : BandOrderedGeneralConfiguration q'), ∀ (C0' - : BandCircle), ∀ (T' : ProtoTile), ∀ (cert' : BandOrderedGeneralLayoutCertificate q' - cfg' C0' T'), ∀ (h' : PartialOdometer), ∀ (P' : Fin 3 → Bool → ProtoTile), ∀ (r' : - Fin 3 → Bool → PartialOdometer), ∀ (Q' : Fin 3 → Bool → ProtoTile), ∀ (S' : Fin 3 → - Bool → ProtoTile), ∀ (u' : Fin 3 → Bool → PartialOdometer), ∀ (v' : Fin 3 → Bool → - PartialOdometer), ∀ (g'' : IntegerLatticeFunction), ∀ (x' : GaussianInt), - BandOrderedGeneralOdometerRowData q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' → - GlobalOdometerExtends g'' h' → Nat.card - {is : Fin 3 × Bool // x' ∈ BoundaryFootprintVertices (cert'.P is.1 is.2)} = 2 → - GaussianRealPoint x' = TileCentroid T' → (cfg'.firstPredecessor 1).1 = 0 → - FourNeighborLaplacian g'' x' = 0 ) := by - classical - intro q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' - data hext' hk' hcenter' hzero' - exact FordCenteredInteriorOdometerStencil - q' cfg' C0' T' cert' h' P' r' Q' S' u' v' g'' x' - data hext' hk' hcenter' hzero' - private theorem layout : (by classical @@ -319,7 +297,7 @@ theorem BandOdometerInteriorTable : exact ⟨a.1, a.2, by simpa only [obs.1] using hp, obs.2.1.mp hf, fun hboundary => hb (obs.2.2.mpr hboundary)⟩ have orderedGeneralRowDispatch := InteriorTableGeometry.orderedGeneralRowDispatch - have orderedGeneralCenteredDispatch := InteriorTableGeometry.orderedGeneralCenteredDispatch + have orderedGeneralCenteredDispatch := FordCenteredInteriorOdometerStencil dsimp only rcases regimes with ⟨P, hP, hqP⟩ | ⟨K, hK, hqK⟩ | ⟨cfg⟩ · subst qn diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean index c95103119b..56b2f5ca15 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean @@ -316,28 +316,6 @@ private theorem blockDisjoint : rw [blockEq m n, blockEq r s] exact (BandOrderedGeneralPeriodicBlockCells q cfg C₀ T cert).2 m n r s hne -private theorem patchUnion : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let K : Int → Int → Finset PeriodicSubtileIndex := fun m n ↦ - {⟨.A, m, n⟩, ⟨.B, m, n⟩, ⟨.C, m, n⟩, - ⟨.D, m, n⟩, ⟨.E, m, n⟩, ⟨.F, m, n⟩} - let blockTile (m n : Int) : ProtoTile := - ⟨(K m n).biUnion (fun a => (cert.modified.tile a).cells), 0⟩ - ∀ (p : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), ∀ (σ : Finset (Int - × Int)), (p.indices = σ.biUnion (fun mn => K mn.1 mn.2)) → ((∀ x, x ∈ - p.unionTile.cells ↔ - ∃ mn ∈ σ, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile a).cells) → (∀ x, x ∈ - p.unionTile.cells ↔ ∃ mn ∈ σ, x ∈ (blockTile mn.1 mn.2).cells)) ) := by - classical - intro q cfg C₀ T cert K blockTile p σ hp he x - rw [he x] - simp only [blockTile, Finset.mem_biUnion] - private theorem hUA : (by classical @@ -1461,7 +1439,16 @@ theorem BandOrderedGeneralChildInterfaces (TileTranslation T ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells := ChildInterfaceGeometry.blockEq q cfg C₀ T cert m n have blockDisjoint := ChildInterfaceGeometry.blockDisjoint q cfg C₀ T cert blockEq - have patchUnion := ChildInterfaceGeometry.patchUnion q cfg C₀ T cert + have patchUnion := (show + ∀ (p : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), ∀ (σ : Finset + (Int × Int)), (p.indices = σ.biUnion (fun mn => K mn.1 mn.2)) → ((∀ x, x ∈ + p.unionTile.cells ↔ ∃ mn ∈ σ, ∃ a ∈ K mn.1 mn.2, x ∈ (cert.modified.tile a).cells) → + (∀ x, x ∈ p.unionTile.cells ↔ ∃ mn ∈ σ, x ∈ (blockTile mn.1 mn.2).cells)) + from by + classical + intro p σ hp he x + rw [he x] + simp only [blockTile, Finset.mem_biUnion]) let σA : Finset (Int × Int) := {(0,0)} let σB : Finset (Int × Int) := {(0,1)} let σC : Finset (Int × Int) := {(1,1)} diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean index f2f867eb8f..996e6a65fa 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean @@ -638,10 +638,10 @@ private theorem commonVertices : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((BandCircle) → - (∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), - let O := Q 0 false - (Finset GaussianInt) → (((FootprintEdges (TileCellComplement (P 0 true) O) ∩ + ( + (∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), + let O := Q 0 false; + (((FootprintEdges (TileCellComplement (P 0 true) O) ∩ FootprintEdges (P 0 false)).Nonempty) → ((∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges U) → (∀ (x : GaussianInt), (x ∈ e) → (x ∈ FootprintVertices U))) → (∃ x y : GaussianInt, x ≠ y ∧ x ∈ FootprintVertices @@ -649,7 +649,7 @@ private theorem commonVertices : FootprintVertices (TileCellComplement (P 0 true) O) ∩ FootprintVertices (P 0 false)))))) ) := by classical - intro q cfg C₀ P Q O R abEdge edgeVertex + intro P Q O abEdge edgeVertex obtain ⟨e, heA, heB⟩ := abEdge have hc : e.card = 2 := by obtain ⟨z, _, h⟩ := heA @@ -1099,8 +1099,8 @@ theorem BandOrderedGeneralLayout (hQcells 1 true) (hScells 2 false) (hQcells 2 true) (hScells 1 false) (qne 1 true (Or.inl rfl)) (sne 2 false (Or.inr rfl)) (qne 2 true (Or.inr rfl)) (sne 1 false (Or.inl rfl)) crossO1 crossO2 point1 point2 - compQ.2 compB.2 central osym isolated arcs (OrderedLayoutGeometry.commonVertices q cfg C₀ P Q - R abEdge (OrderedLayoutGeometry.edgeVertex)) + compQ.2 compB.2 central osym isolated arcs + (OrderedLayoutGeometry.commonVertices P Q abEdge OrderedLayoutGeometry.edgeVertex) obtain ⟨M, mlattice, mtiles, madj, me, mpoints, mvertices, mreps⟩ := BandModifiedPeriodicComplex P O u v L K (OrderedLayoutGeometry.modifiedDisks q P Q pdisks compQ) hpartition hOA hOB diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean index 30095d01e7..3b6f598473 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightNormalizationCertificateExists.lean @@ -221,62 +221,18 @@ private theorem hsmallT1 : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let qbar := BandPackingSymmetryQuadrupleAction g qrot ∀ (q' : Fin 4 → CircleCoordinates), ∀ (T' : ProtoTile), ∀ (S' : Fin 3 → Bool → ProtoTile), ProperBandQuadruple q' → BandPrototile (q' 0) T' → (∀ i, ∀ s, BandSubtileOccurrence q' T' i s (S' i s)) → (∀ z, z ∈ T'.cells ↔ ∃ i s, z ∈ (S' i - s).cells) → Int.toNat (q' 0).1 < Int.toNat (qbar 0).1 → LatticeTile T' ∧ TileArea T' + s).cells) → + LatticeTile T' ∧ TileArea T' = Int.toNat (q' 0).1 ∧ ∀ i, ∀ s, LatticeTile (TileCellComplement T' (S' i s)) ∧ TileTouching (TileCellComplement T' (S' i s)) (S' i s) ) := by classical - intro q r g qrot qbar q' T' S' hq' hT' hocc hcells _ + intro q' T' S' hq' hT' hocc hcells have hI := BandTileSimultaneousInduction q' hq' T' hT' exact ⟨hI.1, hI.2.1, hI.2.2.1 S' hocc hcells⟩ -private theorem hsmallT4 : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let qbar := BandPackingSymmetryQuadrupleAction g qrot - ∀ (q' : Fin 4 → CircleCoordinates), ∀ (T' : ProtoTile), ∀ (U : ProtoTile), - ProperBandQuadruple q' → BandPrototile (q' 0) T' → Int.toNat (q' 0).1 < Int.toNat - (qbar 0).1 → 1 < (q' 0).1 → ∀ i : Fin 3, BandPrototile (q' i.succ) U → TileCentroid U - - TileCentroid T' = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q' i.succ) - (q' 0)) + GaussianRealPoint (BandVectors.1 (q' 0) (q' i.succ))) → TouchingTriple T' - (TileTranslation T' (BandVectors.1 (q' i.succ) (q' 0))) U ) := by - classical - intro q r g qrot qbar q' T' U hq' hT' _ hlarge i hU hcentU - exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.1 - hlarge i U hU hcentU - -private theorem hsmallT5 : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let qbar := BandPackingSymmetryQuadrupleAction g qrot - ∀ (q' : Fin 4 → CircleCoordinates), ∀ (T' : ProtoTile), ∀ (U : ProtoTile), ∀ (V : - ProtoTile), ProperBandQuadruple q' → BandPrototile (q' 0) T' → Int.toNat (q' 0).1 < - Int.toNat (qbar 0).1 → ∀ i : Fin 3, BandPrototile (q' i.succ) U → BandPrototile (q' - ((i + 1).succ)) V → TileCentroid U - TileCentroid T' = (1 / 2 : Real) • - (GaussianRealPoint (BandVectors.1 (q' i.succ) (q' 0)) + GaussianRealPoint - (BandVectors.1 (q' 0) (q' i.succ))) → TileCentroid V - TileCentroid T' = (1 / 2 : - Real) • (GaussianRealPoint (BandVectors.1 (q' ((i + 1).succ)) (q' 0)) - - GaussianRealPoint (BandVectors.1 (q' 0) (q' ((i + 1).succ)))) → TouchingTriple T' U V - ) := by - classical - intro q r g qrot qbar q' T' U V hq' hT' _ i hU hV hcentU hcentV - exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.2.1 - i U V hU hV hcentU hcentV - private theorem hadjbar : (by classical @@ -557,17 +513,24 @@ theorem BandOrderedGeneralRightNormalizationCertificateExists TileOdometerBandPrototile _ _ _ hONbar have hTind := BandTileSimultaneousInduction qbar hqbar Tbar hTbarBand have hNind := BandTileSimultaneousInduction qbar hqbar Nbar hNbarBand - have hsmallT1 := RightNormalizationGeometry.hsmallT1 q r g have hsmallT2 (D : CircleCoordinates) (U : ProtoTile) (hU : BandPrototile D U) (_ : Int.toNat D.1 < Int.toNat (qbar 0).1) : QuarterTurnSymmetric U := BandPrototileQuarterTurn.symmetry D U hU - have hsmallT4 := RightNormalizationGeometry.hsmallT4 q r g - have hsmallT5 := RightNormalizationGeometry.hsmallT5 q r g have hqbarPos : 0 < (qbar 0).1 := (ProperBandCurvatureStructure qbar hqbar).1 let Cbar : BandCircle := ⟨⟨qbar 0, ⟨Or.inl hqbarPos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbarPos⟩ obtain ⟨layout⟩ := BandOrderedGeneralLayout qbar cfg Cbar - rfl Nbar hNbarBand hsmallT1 hsmallT2 hsmallT4 hsmallT5 + rfl Nbar hNbarBand (by + intro q' T' S' hq' hT' hocc hcells retainedInput7 + exact RightNormalizationGeometry.hsmallT1 q' T' S' hq' hT' hocc hcells) hsmallT2 + (by + intro q' T' U hq' hT' _ hlarge i hU hcentU + exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.1 + hlarge i U hU hcentU) + (by + intro q' T' U V hq' hT' _ i hU hV hcentU hcentV + exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.2.1 + i U V hU hV hcentU hcentV) obtain ⟨pieces, functions, hrootBand, hpieceOdometer, hpieceCells, hpieceFootprint, hpieceCentroid, hfunctionDomains, hfunctionRestriction, hfunctionCompatibility, hpieceSlope⟩ := diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean index 24be74d6ae..7d05a477b1 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean @@ -203,19 +203,21 @@ private theorem hqbarᵢPos : (by classical exact - (BandCircle) → (∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), (Fin 4) → (∀ (r : Fin + (∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), + (∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let irot : Fin 3 := i - r - let qbar := BandPackingSymmetryQuadrupleAction g qrot - (ProperBandQuadruple qbar) → ((BandOrderedGeneralConfiguration qbar) → ((Bool) → ((Fin (4 - : ℕ)) → ( - let reverse := BandPackingSymmetryReversesOrientation g - let ibar : Fin 3 := if reverse then -irot else irot + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ]; + let irot : Fin 3 := i - r; + let qbar := BandPackingSymmetryQuadrupleAction g qrot; + (ProperBandQuadruple qbar) → ((BandOrderedGeneralConfiguration qbar) → ( + ( + ( + let reverse := BandPackingSymmetryReversesOrientation g; + let ibar : Fin 3 := if reverse then -irot else irot; 0 < (qbar ibar.succ).1)))))) ) := by classical - intro Cᵢ q i s r g qrot irot qbar hqbar cfg negative sbar reverse ibar + intro q i r g qrot irot qbar hqbar cfg reverse ibar have hn := (ProperBandCurvatureStructure qbar hqbar).2.1 ibar have hnl := cfg.noLine ibar.succ omega @@ -290,62 +292,18 @@ private theorem hsmallT1 : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let qbar := BandPackingSymmetryQuadrupleAction g qrot ∀ (q' : Fin 4 → CircleCoordinates), ∀ (T' : ProtoTile), ∀ (S' : Fin 3 → Bool → ProtoTile), ProperBandQuadruple q' → BandPrototile (q' 0) T' → (∀ i, ∀ s, BandSubtileOccurrence q' T' i s (S' i s)) → (∀ z, z ∈ T'.cells ↔ ∃ i s, z ∈ (S' i - s).cells) → Int.toNat (q' 0).1 < Int.toNat (qbar 0).1 → LatticeTile T' ∧ TileArea T' + s).cells) → + LatticeTile T' ∧ TileArea T' = Int.toNat (q' 0).1 ∧ ∀ i, ∀ s, LatticeTile (TileCellComplement T' (S' i s)) ∧ TileTouching (TileCellComplement T' (S' i s)) (S' i s) ) := by classical - intro q r g qrot qbar q' T' S' hq' hT' hocc hcells _ + intro q' T' S' hq' hT' hocc hcells have hI := BandTileSimultaneousInduction q' hq' T' hT' exact ⟨hI.1, hI.2.1, hI.2.2.1 S' hocc hcells⟩ -private theorem hsmallT4 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let qbar := BandPackingSymmetryQuadrupleAction g qrot - ∀ (q' : Fin 4 → CircleCoordinates), ∀ (T' : ProtoTile), ∀ (U : ProtoTile), - ProperBandQuadruple q' → BandPrototile (q' 0) T' → Int.toNat (q' 0).1 < Int.toNat - (qbar 0).1 → 1 < (q' 0).1 → ∀ i : Fin 3, BandPrototile (q' i.succ) U → TileCentroid U - - TileCentroid T' = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q' i.succ) - (q' 0)) + GaussianRealPoint (BandVectors.1 (q' 0) (q' i.succ))) → TouchingTriple T' - (TileTranslation T' (BandVectors.1 (q' i.succ) (q' 0))) U ) := by - classical - intro q r g qrot qbar q' T' U hq' hT' _ hlarge i hU hcentU - exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.1 - hlarge i U hU hcentU - -private theorem hsmallT5 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let qbar := BandPackingSymmetryQuadrupleAction g qrot - ∀ (q' : Fin 4 → CircleCoordinates), ∀ (T' : ProtoTile), ∀ (U : ProtoTile), ∀ (V : - ProtoTile), ProperBandQuadruple q' → BandPrototile (q' 0) T' → Int.toNat (q' 0).1 < - Int.toNat (qbar 0).1 → ∀ i : Fin 3, BandPrototile (q' i.succ) U → BandPrototile (q' - ((i + 1).succ)) V → TileCentroid U - TileCentroid T' = (1 / 2 : Real) • - (GaussianRealPoint (BandVectors.1 (q' i.succ) (q' 0)) + GaussianRealPoint - (BandVectors.1 (q' 0) (q' i.succ))) → TileCentroid V - TileCentroid T' = (1 / 2 : - Real) • (GaussianRealPoint (BandVectors.1 (q' ((i + 1).succ)) (q' 0)) - - GaussianRealPoint (BandVectors.1 (q' 0) (q' ((i + 1).succ)))) → TouchingTriple T' U V - ) := by - classical - intro q r g qrot qbar q' T' U V hq' hT' _ i hU hV hcentU hcentV - exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.2.1 - i U V hU hV hcentU hcentV - private theorem hstarFootprint : (by classical @@ -899,14 +857,8 @@ private theorem subtileNormalizationCertificate : layout.v exteriorIndex) - TileCentroid T₀bar = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ sbar.val * - (incoming ibar + outgoing ibar)) := (show - TileCentroid (SubtileOccurrenceInterpretation layout.P layout.u - layout.v exteriorIndex) - TileCentroid T₀bar = (1 / 2 : ℝ) • - GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ sbar.val * (incoming - ibar + outgoing ibar)) - from by - classical - simpa [exteriorIndex] using hrows.1) + (incoming ibar + outgoing ibar)) := by + simpa [exteriorIndex] using hrows.1 have hexteriorBand : BandPrototile (qbar ibar.succ) (SubtileOccurrenceInterpretation layout.P layout.u layout.v exteriorIndex) := SubtileNormalizationGeometry.hexteriorBand q i T₀ r g hqbar cfg sbar @@ -1087,8 +1039,8 @@ theorem BandOrderedGeneralSubtileNormalizationCertificateExists r g hrotParent have hqbar₀Pos : 0 < (qbar 0).1 := (ProperBandCurvatureStructure qbar hqbar).1 - have hqbarᵢPos : 0 < (qbar ibar.succ).1 := SubtileNormalizationGeometry.hqbarᵢPos Cᵢ q i s r g - hqbar cfg negative sbar + have hqbarᵢPos : 0 < (qbar ibar.succ).1 := SubtileNormalizationGeometry.hqbarᵢPos q i r g + hqbar cfg let C₀bar : BandCircle := ⟨⟨qbar 0, ⟨Or.inl hqbar₀Pos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbar₀Pos⟩ let Cᵢbar : BandCircle := @@ -1114,8 +1066,9 @@ theorem BandOrderedGeneralSubtileNormalizationCertificateExists Int.toNat (q' 0).1 < Int.toNat (qbar 0).1 → LatticeTile T' ∧ TileArea T' = Int.toNat (q' 0).1 ∧ ∀ i s, LatticeTile (TileCellComplement T' (S' i s)) ∧ - TileTouching (TileCellComplement T' (S' i s)) (S' i s) := - SubtileNormalizationGeometry.hsmallT1 q r g + TileTouching (TileCellComplement T' (S' i s)) (S' i s) := by + intro q' T' S' hq' hT' hocc hcells retainedInput7 + exact SubtileNormalizationGeometry.hsmallT1 q' T' S' hq' hT' hocc hcells have hsmallT2 : ∀ (D : CircleCoordinates) (U : ProtoTile), BandPrototile D U → Int.toNat D.1 < Int.toNat (qbar 0).1 → QuarterTurnSymmetric U := fun D U hU _ => BandPrototileQuarterTurn.symmetry D U hU @@ -1128,8 +1081,10 @@ theorem BandOrderedGeneralSubtileNormalizationCertificateExists (GaussianRealPoint (BandVectors.1 (q' i.succ) (q' 0)) + GaussianRealPoint (BandVectors.1 (q' 0) (q' i.succ))) → TouchingTriple T' - (TileTranslation T' (BandVectors.1 (q' i.succ) (q' 0))) U := - SubtileNormalizationGeometry.hsmallT4 q r g + (TileTranslation T' (BandVectors.1 (q' i.succ) (q' 0))) U := by + intro q' T' U hq' hT' _ hlarge i hU hcentU + exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.1 + hlarge i U hU hcentU have hsmallT5 : ∀ (q' : Fin 4 → CircleCoordinates) (T' U V : ProtoTile), ProperBandQuadruple q' → BandPrototile (q' 0) T' → @@ -1142,7 +1097,10 @@ theorem BandOrderedGeneralSubtileNormalizationCertificateExists TileCentroid V - TileCentroid T' = (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q' ((i + 1).succ)) (q' 0)) - GaussianRealPoint (BandVectors.1 (q' 0) (q' ((i + 1).succ)))) → - TouchingTriple T' U V := SubtileNormalizationGeometry.hsmallT5 q r g + TouchingTriple T' U V := by + intro q' T' U V hq' hT' _ i hU hV hcentU hcentV + exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.2.1 + i U V hU hV hcentU hcentV obtain ⟨layout⟩ := BandOrderedGeneralLayout qbar cfg C₀bar rfl T₀bar hT₀barBand hsmallT1 hsmallT2 hsmallT4 hsmallT5 obtain ⟨pieces, functions, hrootBand, hpieceOdometer, hpieceCells, diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean index 942ee001da..cce1ecb9e8 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean @@ -429,66 +429,6 @@ private theorem unitCancel : _ = d * (c * b) := by ring _ = d * A := by rw [hh'] -private theorem hjkAt434 : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), ∀ (i - : Fin (3 : ℕ)), - let epsilon : GaussianInt := if negative then -1 else 1 - (BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) ^ (2 : ℕ) = - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).1 • - (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g - = true then -i else i).succ).2 - (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ).1 • - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2 ∧ (2 : GaussianInt) * - BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) * BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g - = true then -i else i).succ) (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : - ℕ))) = (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ).2 + - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2) → - (((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : - ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = - BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) ∧ - Zsqrtd.norm (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 - : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = (q i.succ).1 + - (q (0 : Fin (4 : ℕ))).1 ∧ (2 : GaussianInt) * (BandPackingSymmetryAffineVectorAction - g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : - Fin (4 : ℕ))))).1 * (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q - i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2 = - (BandPackingSymmetryCircleAction g (q i.succ)).2 + (BandPackingSymmetryCircleAction g - (q (0 : Fin (4 : ℕ)))).2) → ((BandVectors.2 (BandPackingSymmetryQuadrupleAction g q - (if BandPackingSymmetryReversesOrientation g = true then -i else i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = epsilon * - (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : - ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2) → (((BandVectors.1 - (BandPackingSymmetryQuadrupleAction g q (-i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = if negative = true then - -BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) - else BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : - ℕ))))) ∧ (BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g q (-i).succ) = -if negative = true then - -BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) - else BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q - i.succ))) ∧ BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 : - ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ) = - if negative = true then -GaussianQuarterTurn (BandPackingSymmetryVectorAction g - (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))) - else GaussianQuarterTurn (BandPackingSymmetryVectorAction g (BandVectors.1 (q (i + (2 - : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)))) → ( - let j : Fin 4 := (i + 2).succ - let k : Fin 4 := (i + 1).succ - j ≠ k)))) ) := by - classical - intro g q negative i epsilon incomingProduct incomingAffine incomingSlope hspatial j k - dsimp [j, k] - fin_cases i <;> simp - private theorem hprodAt446 : (by classical @@ -655,66 +595,6 @@ private theorem slopeIndex : intro g q i j k A rfl -private theorem hjkAt531 : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), ∀ (i - : Fin (3 : ℕ)), - let epsilon : GaussianInt := if negative then -1 else 1 - (BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) ^ (2 : ℕ) = - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).1 • - (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g - = true then -i else i).succ).2 - (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ).1 • - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2 ∧ (2 : GaussianInt) * - BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) * BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g - = true then -i else i).succ) (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : - ℕ))) = (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ).2 + - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2) → - (((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : - ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = - BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) ∧ - Zsqrtd.norm (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 - : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = (q i.succ).1 + - (q (0 : Fin (4 : ℕ))).1 ∧ (2 : GaussianInt) * (BandPackingSymmetryAffineVectorAction - g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : - Fin (4 : ℕ))))).1 * (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q - i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2 = - (BandPackingSymmetryCircleAction g (q i.succ)).2 + (BandPackingSymmetryCircleAction g - (q (0 : Fin (4 : ℕ)))).2) → ((BandVectors.2 (BandPackingSymmetryQuadrupleAction g q - (if BandPackingSymmetryReversesOrientation g = true then -i else i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = epsilon * - (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : - ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2) → (((BandVectors.1 - (BandPackingSymmetryQuadrupleAction g q i.succ) (BandPackingSymmetryQuadrupleAction g - q (0 : Fin (4 : ℕ))) = if negative = true then -BandPackingSymmetryVectorAction g - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) else BandPackingSymmetryVectorAction - g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) ∧ (BandVectors.1 - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g q i.succ) = if negative = true then - -BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) - else BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q - i.succ))) ∧ BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (i + (2 : Fin (3 : - ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (i + (1 : Fin (3 : ℕ))).succ) = if - negative = true then -BandPackingSymmetryVectorAction g (BandVectors.1 (q (i + (2 : - Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) else - BandPackingSymmetryVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q - (i + (1 : Fin (3 : ℕ))).succ))) → ( - let j : Fin 4 := (i + 2).succ - let k : Fin 4 := (i + 1).succ - j ≠ k)))) ) := by - classical - intro g q negative i epsilon incomingProduct incomingAffine incomingSlope hspatial j k - dsimp [j, k] - fin_cases i <;> simp - private theorem hprodAt542 : (by classical @@ -930,8 +810,9 @@ theorem BandPackingSymmetryAffineVectorCovariance (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).1 let A := (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).2 - have hjk : j ≠ k := AffineSymmetryCoordinates.hjkAt434 g q negative i incomingProduct - incomingAffine incomingSlope hspatial + have hjk : j ≠ k := by + dsimp [j, k] + fin_cases i <;> simp have aff := affineFacts g (q j) (q k) (BandVectors.1 (q j) (q k)) (BandVectors.2 (q j) (q k)) (sourceNorm j k hjk (by @@ -987,8 +868,9 @@ theorem BandPackingSymmetryAffineVectorCovariance (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).1 let A := (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).2 - have hjk : j ≠ k := AffineSymmetryCoordinates.hjkAt531 g q negative i incomingProduct - incomingAffine incomingSlope hspatial + have hjk : j ≠ k := by + dsimp [j, k] + fin_cases i <;> simp have aff := affineFacts g (q j) (q k) (BandVectors.1 (q j) (q k)) (BandVectors.2 (q j) (q k)) (sourceNorm j k hjk (by diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean index 725b655564..555554b9d0 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean @@ -1592,21 +1592,6 @@ end TileOdometerSymmetryProof namespace TileOdometerAssembly -private theorem actionDiff : - (by - classical - exact - (∀ (a : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ x ∈ k.domain, - BandPackingSymmetryVectorAction a x ∈ (BandPackingSymmetryPartialOdometerAction a - k).domain) → (∀ (a : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ (l : - PartialOdometer), ∀ x ∈ k.domain, x ∈ l.domain → - (BandPackingSymmetryPartialOdometerAction a l).value (BandPackingSymmetryVectorAction - a x) - (BandPackingSymmetryPartialOdometerAction a k).value - (BandPackingSymmetryVectorAction a x) = l.value x - k.value x) ) := by - classical - intro actionForward a k l x hk hl - exact TileOdometerSymmetryProof.actionDiff actionForward a k l x hk hl - private theorem hpsi : (by classical @@ -1647,70 +1632,6 @@ private theorem hpsi : exact TileOdometerSymmetryProof.hpsi z wr wi v hcorner r hr -private theorem hcurvAt1757 : - (by - classical - exact - ∀ (z : GaussianInt), ∀ (wr : ℤ), ∀ (wi : ℤ), ∀ (r : GaussianInt), (r ∈ - (CurvatureOneOdometer z).domain) → ((CurvatureOneOdometer (z + ⟨wr, wi⟩)).value r = - (CurvatureOneOdometer z).value r + wi * r.re * r.im) ) := by - classical - intro z wr wi r hr - exact TileOdometerSymmetryProof.hcurvAt595 z wr wi r hr - -private theorem hCAt1762 : - (by - classical - exact - ∀ (z : GaussianInt), ∀ (wr : ℤ), ∀ (wi : ℤ), BandPackingSymmetryCircleAction (.shift ⟨wr, - wi⟩) (1, 1 + 2 * z) = (1, 1 + 2 * (z + ⟨wr, wi⟩)) ) := by - classical - intro z wr wi - exact TileOdometerSymmetryProof.hCAt611 - z wr wi - -private theorem hunitValueAt1803 : - (by - classical - exact - ∀ (z : GaussianInt), ∀ r ∈ (CurvatureOneOdometer z).domain, (CurvatureOneOdometer - z).value ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - GaussianQuarterTurn r) = - (CurvatureOneOdometer (-z - (1 : GaussianInt))).value r + z.im * r.im ) := by - classical - intro z r hr - exact TileOdometerSymmetryProof.hunitValueAt682 z r hr - -private theorem hcellAt1824 : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells = {x}) → ((BandPackingSymmetryTileAction - .conjugate U).cells = {-GaussianReflection x - 1}) ) := by - classical - intro U x hU - exact TileOdometerSymmetryProof.hcellAt753 U x hU - -private theorem hunitValueAt1829 : - (by - classical - exact - ∀ (z : GaussianInt), ∀ r ∈ (CurvatureOneOdometer z).domain, (CurvatureOneOdometer - z).value ((1 : GaussianInt) - GaussianReflection r) = (CurvatureOneOdometer - (GaussianReflection z)).value r + z.im * r.im ) := by - classical - intro z r hr - exact TileOdometerSymmetryProof.hunitValueAt805 z r hr - -private theorem hCAt1836 : - (by - classical - exact - ∀ (z : GaussianInt), BandPackingSymmetryCircleAction .conjugate (1, 1 + 2 * z) = (1, 1 + - 2 * GaussianReflection z) ) := by - classical - intro z - exact TileOdometerSymmetryProof.hCAt864 z - private theorem hcentroid' : (by classical @@ -1777,104 +1698,10 @@ private theorem hOorig : exact TileOdometer.decompose hq hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope -private theorem hout : - (by - classical - exact - ∀ (h : PartialOdometer), ∀ (U : ProtoTile), ∀ (a : BandPackingSymmetry), - let P := BandPackingSymmetryPartialOdometerAction - (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction a h) = Option.map - (BandPackingSymmetrySlopeAction a U) (PartialOdometerSlope h)) → (∀ (p₀ : ℝ × ℝ), - (PartialOdometerSlope h = some p₀) → (PartialOdometerSlope (P a h) = some - (BandPackingSymmetrySlopeAction a U p₀))) ) := by - classical - intro h U a P houterSlope p₀ hp₀ - exact TileOdometerSymmetryProof.hout h - U a houterSlope p₀ hp₀ - -private theorem hchild : - (by - classical - exact - ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ - (a : BandPackingSymmetry), - let P := BandPackingSymmetryPartialOdometerAction - ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), - let p := e.symm (i, s) - (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction a (hs p.1 p.2)) = - Option.map (BandPackingSymmetrySlopeAction a (S p.1 p.2)) (PartialOdometerSlope (hs - p.1 p.2))) → (∀ (pᵢ : ℝ × ℝ), (PartialOdometerSlope (hs p.1 p.2) = some pᵢ) → - (PartialOdometerSlope (P a (hs p.1 p.2)) = some (BandPackingSymmetrySlopeAction a (S - p.1 p.2) pᵢ))) ) := by - classical - intro S hs a P e i s p hchildSlope pᵢ hpᵢ - exact TileOdometerSymmetryProof.hchild S hs a e i s hchildSlope pᵢ hpᵢ - -private theorem hslopeCov : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → - ProtoTile), ∀ (a : BandPackingSymmetry), - let Q := BandPackingSymmetryQuadrupleAction - let q' := Q a q - ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (negative : Bool), ∀ (i : Fin (3 : - ℕ)), ∀ (s : Bool), - let p := e.symm (i, s) - ∀ (p₀ : ℝ × ℝ), ∀ (pᵢ : ℝ × ℝ), ((if s = true then (1 : ℝ) else (-1 : ℝ)) = (if ((e.symm - : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).2 = true then (1 : ℝ) else (-1 : - ℝ)) * if negative = true then (-1 : ℝ) else (1 : ℝ)) → ( - let v0 := BandVectors.1 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) - let u0 := BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) - let vmix := v0 - GaussianQuarterTurn v0 - let umix := u0 + GaussianQuarterTurn u0 - let scale : ℝ := (if p.2 = true then (1 : ℝ) else -1) * (1 / 2) - (TileCentroid (BandPackingSymmetryTileAction a (S p.1 p.2)) - TileCentroid - (BandPackingSymmetryTileAction a U) = scale • GaussianRealPoint - (BandPackingSymmetryAffineVectorAction a (vmix, umix)).1 ∧ - BandPackingSymmetrySlopeAction a (S p.1 p.2) pᵢ - BandPackingSymmetrySlopeAction a U - p₀ = scale • GaussianRealPoint (BandPackingSymmetryAffineVectorAction a (vmix, - umix)).2) → ((BandVectors.2 (BandPackingSymmetryQuadrupleAction a q (i + (2 : Fin (3 - : ℕ))).succ) (BandPackingSymmetryQuadrupleAction a q (i + (1 : Fin (3 : ℕ))).succ) + - GaussianQuarterTurn (BandVectors.2 (BandPackingSymmetryQuadrupleAction a q (i + (2 : - Fin (3 : ℕ))).succ) (BandPackingSymmetryQuadrupleAction a q (i + (1 : Fin (3 : - ℕ))).succ)) = (if negative = true then (-1 : GaussianInt) else (1 : GaussianInt)) * - (BandPackingSymmetryAffineVectorAction a ((fun (r : Bool) (z : GaussianInt × - GaussianInt) => if r = true then (z.1 + GaussianQuarterTurn z.1, z.2 - - GaussianQuarterTurn z.2) else (z.1 - GaussianQuarterTurn z.1, z.2 + - GaussianQuarterTurn z.2)) false (BandVectors.1 (q (((e.symm : Fin (3 : ℕ) × Bool → - Fin (3 : ℕ) × Bool) (i, s)).1 + (2 : Fin (3 : ℕ))).succ) (q (((e.symm : Fin (3 : ℕ) × - Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q - (((e.symm : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + (2 : Fin (3 : - ℕ))).succ) (q (((e.symm : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + (1 : - Fin (3 : ℕ))).succ)))).2) → (BandPackingSymmetrySlopeAction a (S p.1 p.2) pᵢ - - BandPackingSymmetrySlopeAction a U p₀ = ((if s = true then (1 : ℝ) else -1) * (1 / - 2)) • GaussianRealPoint (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ)) + - GaussianQuarterTurn (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ))))))) ) := by - classical - intro U q S a Q q' e negative i s p p₀ pᵢ hsign v0 u0 vmix umix scale hdiffTransport hsum - exact TileOdometerSymmetryProof.hslopeCov U q S a - e negative i s p₀ pᵢ hsign hdiffTransport hsum - end TileOdometerAssembly namespace TileOdometerConclusion -private theorem actionDiff : - (by - classical - exact - (∀ (a : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ x ∈ k.domain, - BandPackingSymmetryVectorAction a x ∈ (BandPackingSymmetryPartialOdometerAction a - k).domain) → (∀ (a : BandPackingSymmetry), ∀ (k : PartialOdometer), ∀ (l : - PartialOdometer), ∀ x ∈ k.domain, x ∈ l.domain → - (BandPackingSymmetryPartialOdometerAction a l).value (BandPackingSymmetryVectorAction - a x) - (BandPackingSymmetryPartialOdometerAction a k).value - (BandPackingSymmetryVectorAction a x) = l.value x - k.value x) ) := by - classical - intro actionForward a k l x hk hl - exact TileOdometerAssembly.actionDiff actionForward a k l x hk hl - private theorem hpsi : (by classical @@ -1915,149 +1742,6 @@ private theorem hpsi : exact TileOdometerAssembly.hpsi z wr wi v hcorner r hr -private theorem hcurvAt2025 : - (by - classical - exact - ∀ (z : GaussianInt), ∀ (wr : ℤ), ∀ (wi : ℤ), ∀ (r : GaussianInt), (r ∈ - (CurvatureOneOdometer z).domain) → ((CurvatureOneOdometer (z + ⟨wr, wi⟩)).value r = - (CurvatureOneOdometer z).value r + wi * r.re * r.im) ) := by - classical - intro z wr wi r hr - exact TileOdometerAssembly.hcurvAt1757 z wr wi r hr - -private theorem hCAt2030 : - (by - classical - exact - ∀ (z : GaussianInt), ∀ (wr : ℤ), ∀ (wi : ℤ), BandPackingSymmetryCircleAction (.shift ⟨wr, - wi⟩) (1, 1 + 2 * z) = (1, 1 + 2 * (z + ⟨wr, wi⟩)) ) := by - classical - intro z wr wi - exact TileOdometerAssembly.hCAt1762 z - wr wi - -private theorem hunitValueAt2071 : - (by - classical - exact - ∀ (z : GaussianInt), ∀ r ∈ (CurvatureOneOdometer z).domain, (CurvatureOneOdometer - z).value ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - GaussianQuarterTurn r) = - (CurvatureOneOdometer (-z - (1 : GaussianInt))).value r + z.im * r.im ) := by - classical - intro z r hr - exact TileOdometerAssembly.hunitValueAt1803 z r hr - -private theorem hcellAt2092 : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells = {x}) → ((BandPackingSymmetryTileAction - .conjugate U).cells = {-GaussianReflection x - 1}) ) := by - classical - intro U x hU - exact TileOdometerAssembly.hcellAt1824 U x hU - -private theorem hunitValueAt2097 : - (by - classical - exact - ∀ (z : GaussianInt), ∀ r ∈ (CurvatureOneOdometer z).domain, (CurvatureOneOdometer - z).value ((1 : GaussianInt) - GaussianReflection r) = (CurvatureOneOdometer - (GaussianReflection z)).value r + z.im * r.im ) := by - classical - intro z r hr - exact TileOdometerAssembly.hunitValueAt1829 z r hr - -private theorem hCAt2104 : - (by - classical - exact - ∀ (z : GaussianInt), BandPackingSymmetryCircleAction .conjugate (1, 1 + 2 * z) = (1, 1 + - 2 * GaussianReflection z) ) := by - classical - intro z - exact TileOdometerAssembly.hCAt1836 z - -private theorem hout : - (by - classical - exact - ∀ (h : PartialOdometer), ∀ (U : ProtoTile), ∀ (a : BandPackingSymmetry), - let P := BandPackingSymmetryPartialOdometerAction - (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction a h) = Option.map - (BandPackingSymmetrySlopeAction a U) (PartialOdometerSlope h)) → (∀ (p₀ : ℝ × ℝ), - (PartialOdometerSlope h = some p₀) → (PartialOdometerSlope (P a h) = some - (BandPackingSymmetrySlopeAction a U p₀))) ) := by - classical - intro h U a P houterSlope p₀ hp₀ - exact TileOdometerAssembly.hout h U a - houterSlope p₀ hp₀ - -private theorem hchild : - (by - classical - exact - ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ - (a : BandPackingSymmetry), - let P := BandPackingSymmetryPartialOdometerAction - ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), - let p := e.symm (i, s) - (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction a (hs p.1 p.2)) = - Option.map (BandPackingSymmetrySlopeAction a (S p.1 p.2)) (PartialOdometerSlope (hs - p.1 p.2))) → (∀ (pᵢ : ℝ × ℝ), (PartialOdometerSlope (hs p.1 p.2) = some pᵢ) → - (PartialOdometerSlope (P a (hs p.1 p.2)) = some (BandPackingSymmetrySlopeAction a (S - p.1 p.2) pᵢ))) ) := by - classical - intro S hs a P e i s p hchildSlope pᵢ hpᵢ - exact TileOdometerAssembly.hchild S hs a e i s hchildSlope pᵢ hpᵢ - -private theorem hslopeCov : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → - ProtoTile), ∀ (a : BandPackingSymmetry), - let Q := BandPackingSymmetryQuadrupleAction - let q' := Q a q - ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (negative : Bool), ∀ (i : Fin (3 : - ℕ)), ∀ (s : Bool), - let p := e.symm (i, s) - ∀ (p₀ : ℝ × ℝ), ∀ (pᵢ : ℝ × ℝ), ((if s = true then (1 : ℝ) else (-1 : ℝ)) = (if ((e.symm - : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).2 = true then (1 : ℝ) else (-1 : - ℝ)) * if negative = true then (-1 : ℝ) else (1 : ℝ)) → ( - let v0 := BandVectors.1 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) - let u0 := BandVectors.2 (q ((p.1 + 2).succ)) (q ((p.1 + 1).succ)) - let vmix := v0 - GaussianQuarterTurn v0 - let umix := u0 + GaussianQuarterTurn u0 - let scale : ℝ := (if p.2 = true then (1 : ℝ) else -1) * (1 / 2) - (TileCentroid (BandPackingSymmetryTileAction a (S p.1 p.2)) - TileCentroid - (BandPackingSymmetryTileAction a U) = scale • GaussianRealPoint - (BandPackingSymmetryAffineVectorAction a (vmix, umix)).1 ∧ - BandPackingSymmetrySlopeAction a (S p.1 p.2) pᵢ - BandPackingSymmetrySlopeAction a U - p₀ = scale • GaussianRealPoint (BandPackingSymmetryAffineVectorAction a (vmix, - umix)).2) → ((BandVectors.2 (BandPackingSymmetryQuadrupleAction a q (i + (2 : Fin (3 - : ℕ))).succ) (BandPackingSymmetryQuadrupleAction a q (i + (1 : Fin (3 : ℕ))).succ) + - GaussianQuarterTurn (BandVectors.2 (BandPackingSymmetryQuadrupleAction a q (i + (2 : - Fin (3 : ℕ))).succ) (BandPackingSymmetryQuadrupleAction a q (i + (1 : Fin (3 : - ℕ))).succ)) = (if negative = true then (-1 : GaussianInt) else (1 : GaussianInt)) * - (BandPackingSymmetryAffineVectorAction a ((fun (r : Bool) (z : GaussianInt × - GaussianInt) => if r = true then (z.1 + GaussianQuarterTurn z.1, z.2 - - GaussianQuarterTurn z.2) else (z.1 - GaussianQuarterTurn z.1, z.2 + - GaussianQuarterTurn z.2)) false (BandVectors.1 (q (((e.symm : Fin (3 : ℕ) × Bool → - Fin (3 : ℕ) × Bool) (i, s)).1 + (2 : Fin (3 : ℕ))).succ) (q (((e.symm : Fin (3 : ℕ) × - Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q - (((e.symm : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + (2 : Fin (3 : - ℕ))).succ) (q (((e.symm : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + (1 : - Fin (3 : ℕ))).succ)))).2) → (BandPackingSymmetrySlopeAction a (S p.1 p.2) pᵢ - - BandPackingSymmetrySlopeAction a U p₀ = ((if s = true then (1 : ℝ) else -1) * (1 / - 2)) • GaussianRealPoint (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ)) + - GaussianQuarterTurn (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ))))))) ) := by - classical - intro U q S a Q q' e negative i s p p₀ pᵢ hsign v0 u0 vmix umix scale hdiffTransport hsum - exact TileOdometerAssembly.hslopeCov U q S a e - negative i s p₀ pᵢ hsign hdiffTransport hsum - end TileOdometerConclusion namespace UnitOdometerSymmetry @@ -2104,9 +1788,9 @@ private theorem unitSymmetry : r ∈ (CurvatureOneOdometer z).domain) : (CurvatureOneOdometer (z + ⟨wr, wi⟩)).value r = (CurvatureOneOdometer z).value r + wi * r.re * r.im := - TileOdometerConclusion.hcurvAt2025 z wr wi r hr + TileOdometerSymmetryProof.hcurvAt595 z wr wi r hr have hC : BandPackingSymmetryCircleAction (.shift ⟨wr, wi⟩) - (1, 1 + 2 * z) = (1, 1 + 2 * (z + ⟨wr, wi⟩)) := TileOdometerConclusion.hCAt2030 z + (1, 1 + 2 * z) = (1, 1 + 2 * (z + ⟨wr, wi⟩)) := TileOdometerSymmetryProof.hCAt611 z wr wi rw [hC] simp only [BandPackingSymmetryTileAction] @@ -2146,7 +1830,7 @@ private theorem unitSymmetry : {GaussianQuarterTurn x - 1} := TileOdometerSymmetryProof.hcellAt653 U x hU have hdomain := TileOdometerSymmetryProof.hdomainAt657 U k hdom have hdomainUnit := TileOdometerSymmetryProof.hdomainUnitAt664 z - have hunitValue := TileOdometerConclusion.hunitValueAt2071 z + have hunitValue := TileOdometerSymmetryProof.hunitValueAt682 z have hinverse := TileOdometerSymmetryProof.hinverseAt694 v have himage := TileOdometerSymmetryProof.himageAt698 k have htrans' := TileOdometerSymmetryProof.htrans'At711 k z v a0 b0 hvdom hvval @@ -2167,17 +1851,17 @@ private theorem unitSymmetry : let bk := b0 - z.im * vk.im have hcell : (BandPackingSymmetryTileAction .conjugate U).cells = - {-GaussianReflection x - 1} := TileOdometerConclusion.hcellAt2092 U x hU + {-GaussianReflection x - 1} := TileOdometerSymmetryProof.hcellAt753 U x hU have hdomain := TileOdometerSymmetryProof.hdomainAt763 U k hdom have hdomainUnit := TileOdometerSymmetryProof.hdomainUnitAt787 z - have hunitValue := TileOdometerConclusion.hunitValueAt2097 z + have hunitValue := TileOdometerSymmetryProof.hunitValueAt805 z have hinverse := TileOdometerSymmetryProof.hinverseAt818 v have himage := TileOdometerSymmetryProof.himageAt823 k have htrans' := TileOdometerSymmetryProof.htrans'At836 k z v a0 b0 hvdom hvval hdomainUnit hunitValue hinverse himage have hC : BandPackingSymmetryCircleAction .conjugate (1, 1 + 2 * z) = - (1, 1 + 2 * GaussianReflection z) := TileOdometerConclusion.hCAt2104 z + (1, 1 + 2 * GaussianReflection z) := TileOdometerSymmetryProof.hCAt864 z rw [hC] refine TileOdometer.unit (GaussianReflection z) (-GaussianReflection x - 1) @@ -2226,7 +1910,7 @@ theorem BandPackingSymmetryTileOdometerCovariance have tileEmpty := TileOdometerSymmetryProof.tileEmpty have zeroLine := TileOdometerSymmetryProof.zeroLine have actionForward := TileOdometerSymmetryProof.actionForward - have actionDiff := TileOdometerConclusion.actionDiff actionForward + have actionDiff := TileOdometerSymmetryProof.actionDiff actionForward have lineCov := TileOdometerSymmetryProof.lineCov lineCircle tileEmpty zeroLine have circleCurvature := TileOdometerSymmetryProof.circleCurvature have extractUnit := TileOdometerSymmetryProof.extractUnit @@ -2315,11 +1999,11 @@ theorem BandPackingSymmetryTileOdometerCovariance rcases hslope p.1 p.2 with hzero | ⟨p₀, pᵢ, hp₀, hpᵢ, hdx, hdy⟩ · omega · have hout : PartialOdometerSlope (P a h) = - some (BandPackingSymmetrySlopeAction a U p₀) := TileOdometerConclusion.hout h U a + some (BandPackingSymmetrySlopeAction a U p₀) := TileOdometerSymmetryProof.hout h U a houterSlope p₀ hp₀ have hchild : PartialOdometerSlope (P a (hs p.1 p.2)) = some (BandPackingSymmetrySlopeAction a (S p.1 p.2) pᵢ) := - TileOdometerConclusion.hchild S hs a e i s hchildSlope pᵢ hpᵢ + TileOdometerSymmetryProof.hchild S hs a e i s hchildSlope pᵢ hpᵢ have hidx2 : sigma p.1 + 2 = i + 2 := congrArg (fun j : Fin 3 => j + 2) hidx have hidx1 : sigma p.1 + 1 = i + 1 := congrArg (fun j : Fin 3 => j + 1) hidx have hvecTarget := TileOdometerSymmetryProof.hvecTarget q a e negative hvecAffine i s @@ -2348,7 +2032,7 @@ theorem BandPackingSymmetryTileOdometerCovariance (BandVectors.2 (q' ((i + 2).succ)) (q' ((i + 1).succ)) + GaussianQuarterTurn (BandVectors.2 (q' ((i + 2).succ)) - (q' ((i + 1).succ)))) := TileOdometerConclusion.hslopeCov U q S a e + (q' ((i + 1).succ)))) := TileOdometerSymmetryProof.hslopeCov U q S a e negative i s p₀ pᵢ hsign hdiffTransport hsum refine Or.inr ⟨BandPackingSymmetrySlopeAction a U p₀, BandPackingSymmetrySlopeAction a (S p.1 p.2) pᵢ, ?_, ?_, ?_, ?_⟩ diff --git a/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean index 9b09b10f0d..93946baef0 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification @@ -71,28 +72,6 @@ private theorem centroid_difference : (TileTranslationFormulas T x).2.2.2.2.1] ext <;> simp [GaussianRealPoint] -private theorem translate_zero : - (by - classical - exact - ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), (BandPrototile - (q (0 : Fin (4 : ℕ))) T) → (∀ (P : PeriodicTileComplex ↥(TilingLattice C)), (∀ (u : - ↥(TilingLattice C)), P.tile u = TileTranslation T (↑u : GaussianInt)) → (∀ [ - Nonempty (AffineTriangularComplexChart P fun (mn : ℤ × ℤ) => TileTranslation T - ((↑mn.1 : GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + - (↑mn.2 : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))))], - (RegularTileFamily T (TilingLattice C) = Set.range P.tile) → ((∀ (x : GaussianInt), ∀ - (y : GaussianInt), TileCentroid (TileTranslation T y) - TileCentroid (TileTranslation - T x) = GaussianRealPoint (y - x)) → (TileTranslation T 0 = T)))) ) := by - classical - intro C q T hT P htile hchart family_eq centroid_difference - cases T with - | mk cells anchor => - apply congrArg₂ ProtoTile.mk - · ext z - simp [GaussianTranslation] - · simp [GaussianTranslation] - private theorem hnonempty : (by classical @@ -647,8 +626,7 @@ theorem BandTileTopologyApplication (C : BandCircle) have centroid_difference (x y : GaussianInt) : TileCentroid (TileTranslation T y) - TileCentroid (TileTranslation T x) = GaussianRealPoint (y - x) := TileTopologyGeometry.centroid_difference T x y - have translate_zero : TileTranslation T 0 = T := @TileTopologyGeometry.translate_zero C q T hT - P htile hchart family_eq centroid_difference + have translate_zero : TileTranslation T 0 = T := TileTranslationProperties.zero T have realPoint_injective : Function.Injective GaussianRealPoint := GaussianRealPointProperties.injective have hpositive : 0 < (q 0).1 := (ProperBandCurvatureStructure q hq).1 diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean b/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean index 76acc83a1f..c6b8cbccae 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean @@ -152,11 +152,11 @@ private theorem root : (by classical exact - (ℕ) → (∀ (C : BandCircle), ∀ (ε : Bool), ∀ (B : ProtoTile), ∀ (R : ProtoTile), ∀ (S : + (∀ (C : BandCircle), ∀ (ε : Bool), ∀ (B : ProtoTile), ∀ (R : ProtoTile), ∀ (S : ProtoTile), ∀ (g : PartialOdometer), ∀ (h : PartialOdometer), ∀ (F : P4458T1BoundaryFrame C ε B R S g h), 1 < (F.q 0).1) ) := by classical - intro n C ε B R S g h F + intro C ε B R S g h F have positive := C.property have smaller := F.proper.2 F.slot rw [F.parent] at smaller @@ -565,7 +565,7 @@ theorem BoundaryStringOdometerRespect : induction n using Nat.strong_induction_on with | h n ih => intro C ε B R S g h F hn - have root := BoundaryOdometerGeometry.root n C ε B R S g h F + have root := BoundaryOdometerGeometry.root C ε B R S g h F obtain ⟨T, H, hband, hsub, hcells, hfoot, hcent, hdom, hvalue, hcompat, hslope⟩ := TileOdometerReindexedDecomposition F.q F.proper F.tile F.odometer root (by simpa only [F.child] using F.outer_odo) diff --git a/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean b/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean index ee6bbd076d..e07c169b21 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean @@ -723,23 +723,16 @@ private theorem hqfar : simpa [reachRel, heq, heqLast] using h private theorem far_step_zero : - ∀ (S : Finset GaussianInt), - let I : GaussianInt := ⟨0, 1⟩ - let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S - let JF : Finset GaussianInt := VF.filter fun z => - ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) - let X := {z : GaussianInt // z ∈ S} - let rel : X → X → Prop := fun a b => - b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) - let G : SimpleGraph X := SimpleGraph.fromRel rel - ∀ (leftmost : GaussianInt), ∀ (u : X), (G.Walk u u) → ((X) → ( - let far : GaussianInt := leftmost - 1 + ∀ (leftmost : GaussianInt), + ( + ( + let far : GaussianInt := leftmost - 1; ∀ (a : GaussianInt), ∀ (b : GaussianInt), (leftmost.re ≤ a.re) → ((if b = a + ⟨0, 1⟩ ∧ a.im = far.im ∧ a.re ≤ far.re then 1 else if b = a - ⟨0, 1⟩ ∧ b.im = far.im ∧ a.re ≤ far.re then -1 else 0) = 0))) := by classical - intro S I VF JF X rel G leftmost u c v far a b ha + intro leftmost far a b ha split_ifs with hup hdown · simp [far] at hup omega @@ -1482,7 +1475,7 @@ theorem FiniteBiconnectedHorizontalRunTree (S : Finset GaussianInt) have far_step_zero (a b : GaussianInt) (ha : leftmost.re ≤ a.re) : (if b = a + ⟨0, 1⟩ ∧ a.im = far.im ∧ a.re ≤ far.re then 1 else if b = a - ⟨0, 1⟩ ∧ b.im = far.im ∧ a.re ≤ far.re - then -1 else 0) = 0 := HorizontalRunTreeProof.far_step_zero S leftmost u c v a b ha + then -1 else 0) = 0 := HorizontalRunTreeProof.far_step_zero leftmost a b ha have hfarzero : GridRayCrossingIndex far path = 0 := HorizontalRunTreeProof.hfarzero S leftmost hmin u c path_head path_last path_vertex_re_min far_step_zero exact hqnonzero (hqfar.trans hfarzero) diff --git a/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean b/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean index 3be0d70457..8b665c8ae8 100644 --- a/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean +++ b/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean @@ -809,9 +809,9 @@ private theorem hq1ltN : omega private theorem hv32At908 : - (ℕ) → (∀ (Q : FordFareyParameter), ∀ (q1pos : 0 < Q.q₁), ∀ (hgtq : Q.q₁ > Q.q₂), let pd : Int - := Q.p₁ - Q.p₂ - let qd : Nat := Q.q₁ - Q.q₂ + (∀ (Q : FordFareyParameter), ∀ (q1pos : 0 < Q.q₁), ∀ (hgtq : Q.q₁ > Q.q₂), let pd : Int + := Q.p₁ - Q.p₂; + let qd : Nat := Q.q₁ - Q.q₂; ∀ (hqdlt : qd < Q.q₁), ∀ (hd1 : pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = 1), ∀ (hd2 : Q.p₂ * (Q.q₁ : Int) - (Q.q₂ : Int) * Q.p₁ = -1), ∀ (hred : Nat.Coprime Q.q₁ Q.p₁.natAbs), ∀ (hq1gt : 1 < Q.q₁), let R : FordFareyParameter := { @@ -821,20 +821,20 @@ private theorem hv32At908 : sum_q := by dsimp [qd]; omega, det₁ := hd1, det₂ := hd2, q₁_lt := hqdlt, q₂_pos := Q.q₂_pos, - unit_case := by intro hu; omega } + unit_case := by intro hu; omega }; (BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.q₂ : GaussianInt))) → (BandVectors.1 ((FordRecursiveQuadruple Q) 3) ((FordRecursiveQuadruple Q) 2) = -((⟨0, 1⟩ : GaussianInt) * (Q.q₂ : GaussianInt)))) := by classical - intro n Q q1pos hgtq pd qd hqdlt hd1 hd2 hred hq1gt R rv32 + intro Q q1pos hgtq pd qd hqdlt hd1 hd2 hred hq1gt R rv32 simpa [FordRecursiveQuadruple, R] using rv32 private theorem ha32At914 : - (ℕ) → (∀ (Q : FordFareyParameter), ∀ (q1pos : 0 < Q.q₁), ∀ (hgtq : Q.q₁ > Q.q₂), let pd : Int - := Q.p₁ - Q.p₂ - let qd : Nat := Q.q₁ - Q.q₂ + (∀ (Q : FordFareyParameter), ∀ (q1pos : 0 < Q.q₁), ∀ (hgtq : Q.q₁ > Q.q₂), let pd : Int + := Q.p₁ - Q.p₂; + let qd : Nat := Q.q₁ - Q.q₂; ∀ (hqdlt : qd < Q.q₁), ∀ (hd1 : pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = 1), ∀ (hd2 : Q.p₂ * (Q.q₁ : Int) - (Q.q₂ : Int) * Q.p₁ = -1), ∀ (hred : Nat.Coprime Q.q₁ Q.p₁.natAbs), ∀ (hq1gt : 1 < Q.q₁), let R : FordFareyParameter := { @@ -844,12 +844,12 @@ private theorem ha32At914 : sum_q := by dsimp [qd]; omega, det₁ := hd1, det₂ := hd2, q₁_lt := hqdlt, q₂_pos := Q.q₂_pos, - unit_case := by intro hu; omega } + unit_case := by intro hu; omega }; (BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) = -(↑R.p₂ : GaussianInt)) → (BandVectors.2 ((FordRecursiveQuadruple Q) 3) ((FordRecursiveQuadruple Q) 2) = -(Q.p₂ : GaussianInt))) := by classical - intro n Q q1pos hgtq pd qd hqdlt hd1 hd2 hred hq1gt R ra32 + intro Q q1pos hgtq pd qd hqdlt hd1 hd2 hred hq1gt R ra32 simpa [FordRecursiveQuadruple, R] using ra32 private theorem hd2At925 : @@ -888,8 +888,8 @@ private theorem hq2ltN : omega private theorem hv13At961 : - (ℕ) → (∀ (Q : FordFareyParameter), ∀ (hgtq : ¬Q.q₁ > Q.q₂), let pd : Int := Q.p₂ - Q.p₁ - let qd : Nat := Q.q₂ - Q.q₁ + (∀ (Q : FordFareyParameter), ∀ (hgtq : ¬Q.q₁ > Q.q₂), let pd : Int := Q.p₂ - Q.p₁; + let qd : Nat := Q.q₂ - Q.q₁; ∀ (hqdpos : 0 < qd), ∀ (hd1 : Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1), ∀ (hd2 : pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1), ∀ (hred : Nat.Coprime Q.q₂ Q.p₂.natAbs), ∀ (hq2gt : 1 < Q.q₂), let R : FordFareyParameter := { @@ -899,17 +899,17 @@ private theorem hv13At961 : sum_q := by dsimp [qd]; omega, det₁ := hd1, det₂ := hd2, q₁_lt := by omega, q₂_pos := hqdpos, - unit_case := by intro hu; omega } + unit_case := by intro hu; omega }; (BandVectors.1 (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = (↑R.q₁ : GaussianInt)) → (BandVectors.1 ((FordRecursiveQuadruple Q) 1) ((FordRecursiveQuadruple Q) 3) = (Q.q₁ : GaussianInt))) := by classical - intro n Q hgtq pd qd hqdpos hd1 hd2 hred hq2gt R rv13 + intro Q hgtq pd qd hqdpos hd1 hd2 hred hq2gt R rv13 simpa [FordRecursiveQuadruple, R] using rv13 private theorem ha13At966 : - (ℕ) → (∀ (Q : FordFareyParameter), ∀ (hgtq : ¬Q.q₁ > Q.q₂), let pd : Int := Q.p₂ - Q.p₁ - let qd : Nat := Q.q₂ - Q.q₁ + (∀ (Q : FordFareyParameter), ∀ (hgtq : ¬Q.q₁ > Q.q₂), let pd : Int := Q.p₂ - Q.p₁; + let qd : Nat := Q.q₂ - Q.q₁; ∀ (hqdpos : 0 < qd), ∀ (hd1 : Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1), ∀ (hd2 : pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1), ∀ (hred : Nat.Coprime Q.q₂ Q.p₂.natAbs), ∀ (hq2gt : 1 < Q.q₂), let R : FordFareyParameter := { @@ -919,14 +919,14 @@ private theorem ha13At966 : sum_q := by dsimp [qd]; omega, det₁ := hd1, det₂ := hd2, q₁_lt := by omega, q₂_pos := hqdpos, - unit_case := by intro hu; omega } + unit_case := by intro hu; omega }; (BandVectors.2 (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.p₁ : GaussianInt)) → (BandVectors.2 ((FordRecursiveQuadruple Q) 1) ((FordRecursiveQuadruple Q) 3) = (⟨0, 1⟩ : GaussianInt) * (Q.p₁ : GaussianInt))) := by classical - intro n Q hgtq pd qd hqdpos hd1 hd2 hred hq2gt R ra13 + intro Q hgtq pd qd hqdpos hd1 hd2 hred hq2gt R ra13 simpa [FordRecursiveQuadruple, R] using ra13 private theorem hq1pos : @@ -1258,11 +1258,11 @@ theorem FordCoordinateConfiguration (P : FordFareyParameter) : have hsemi := FordConfigurationProof.hsemiAt342 n Q q1pos hgtq hqdpos hqdlt hd1 hd2 hred hq1gt hsucc have direct := stepLaw (FordRecursiveQuadruple R) rsemi - have hv32 := FordConfigurationDetails.hv32At908 n Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt + have hv32 := FordConfigurationDetails.hv32At908 Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt rv32 have hv13 := FordConfigurationProof.hv13At359 n Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt rv32 rv13 direct - have ha32 := FordConfigurationDetails.ha32At914 n Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt + have ha32 := FordConfigurationDetails.ha32At914 Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt ra32 have ha13 := FordConfigurationProof.ha13At390 n Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt ra32 ra13 direct @@ -1298,10 +1298,10 @@ theorem FordCoordinateConfiguration (P : FordFareyParameter) : have hsemi := FordConfigurationProof.hsemiAt448 n Q hgtq q1pos' hqdpos hd1 hd2 hred hq2gt hfinal have direct := stepLaw _ trot - have hv13 := FordConfigurationDetails.hv13At961 n Q hgtq hqdpos hd1 hd2 hred hq2gt rv13 + have hv13 := FordConfigurationDetails.hv13At961 Q hgtq hqdpos hd1 hd2 hred hq2gt rv13 have hv32 := FordConfigurationProof.hv32At473 n Q hgtq q1pos' hqdpos hd1 hd2 hred hq2gt rv32 rv13 direct - have ha13 := FordConfigurationDetails.ha13At966 n Q hgtq hqdpos hd1 hd2 hred hq2gt ra13 + have ha13 := FordConfigurationDetails.ha13At966 Q hgtq hqdpos hd1 hd2 hred hq2gt ra13 have ha32 := FordConfigurationProof.ha32At503 n Q hgtq q1pos' hqdpos hd1 hd2 hred hq2gt ra32 ra13 direct exact ⟨hsemi, hv32, hv13, ha32, ha13⟩ diff --git a/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean index 84fa37ad72..6a8898f779 100644 --- a/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean +++ b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean @@ -287,16 +287,18 @@ private theorem ha0 : omega private theorem parentValue : - (FordFareyParameter) → ((∀ (P : FordFareyParameter), ∀ x ∈ FordDoubledBoundary P.q, + ((∀ (P : FordFareyParameter), ∀ x ∈ FordDoubledBoundary P.q, Classical.choose FordOdometerFamilyExistsUnique P x = IntegerCeilDiv (P.p * x.re * x.im) - (↑P.q : ℤ) (by exact_mod_cast P.q_pos.ne')) → ((GaussianInt) → ( - let cdiv (n d : Int) := -((-n) / d) - (FordFareyParameter) → ((FordFareyParameter) → (∀ (R : FordFareyParameter), ∀ (r : ℤ), ∀ (s : + (↑P.q : ℤ) (by exact_mod_cast P.q_pos.ne')) → ( + ( + let cdiv (n d : Int) := -((-n) / d); + ( + (∀ (R : FordFareyParameter), ∀ (r : ℤ), ∀ (s : ℤ), (0 : ℤ) ≤ r ∧ r ≤ (↑R.q : ℤ) ∧ (0 : ℤ) ≤ s ∧ s ≤ (↑R.q : ℤ) → r ≤ (1 : ℤ) ∨ (↑R.q : ℤ) - (1 : ℤ) ≤ r ∨ s ≤ (1 : ℤ) ∨ (↑R.q : ℤ) - (1 : ℤ) ≤ s → Classical.choose FordOdometerFamilyExistsUnique R ⟨r, s⟩ = cdiv (R.p * r * s) (↑R.q : ℤ)))))) := by classical - intro P hbdy x cdiv P₁ P₂ R r s hrect hedge + intro hbdy cdiv R r s hrect hedge apply hbdy R change (0 ≤ r ∧ r ≤ R.q ∧ 0 ≤ s ∧ s ≤ R.q) ∧ ¬(2 ≤ r ∧ r ≤ (R.q : Int) - 2 ∧ @@ -396,18 +398,19 @@ private theorem v3 : private theorem near0 : ∀ (P : FordFareyParameter), - let g := FordOdometer P - (GaussianInt) → ( - let a : Int := P.q₁ - let A := P.p₁ - let cdiv (n d : Int) := -((-n) / d) - (0 < a) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → ((FordFareyParameter) → ((∀ (r : + let g := FordOdometer P; + ( + let a : Int := P.q₁; + let A := P.p₁; + let cdiv (n d : Int) := -((-n) / d); + (0 < a) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → ( + ((∀ (r : Int), ∀ (s : Int), (0 ≤ r ∧ r ≤ a ∧ 0 ≤ s ∧ s ≤ a) → ((r ≤ 1 ∨ a - 1 ≤ r ∨ s ≤ 1 ∨ a - 1 ≤ s) → (g ⟨r, s⟩ = cdiv (A * r * s) a))) → ((∀ (d : Int), ∀ (n : Int), ∀ (k : Int), (d ≠ 0) → (cdiv (k * d - n) d = k - n / d)) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t ≤ a → g ⟨a - (1 : ℤ), t⟩ = A * t - A * t / a ∧ g ⟨t, a - (1 : ℤ)⟩ = A * t - A * t / a)))))) := by classical - intro P g x a A cdiv ha0 P₁ hq₁ P₂ v0 cminus t ht ht' + intro P g a A cdiv ha0 P₁ hq₁ v0 cminus t ht ht' have hl := v0 (a - 1) t (by omega) (by omega) have hv := v0 t (a - 1) (by omega) (by omega) rw [show A * (a - 1) * t = (A * t) * a - A * t by ring, @@ -418,13 +421,14 @@ private theorem near0 : private theorem edge2 : ∀ (P : FordFareyParameter), - let g := FordOdometer P - ((P.q₁ : Int) < P.q) → ((GaussianInt) → ( - let a : Int := P.q₁ - let b : Int := P.q₂ - let A := P.p₁ - let B := P.p₂ - let cdiv (n d : Int) := -((-n) / d) + let g := FordOdometer P; + ((P.q₁ : Int) < P.q) → ( + ( + let a : Int := P.q₁; + let b : Int := P.q₂; + let A := P.p₁; + let B := P.p₂; + let cdiv (n d : Int) := -((-n) / d); ((P.q : Int) = a + b) → ((A * b - B * a = 1) → ((0 < b) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) → ((∀ (r : Int), ∀ (s : Int), (a ≤ r ∧ r ≤ P.q ∧ 0 ≤ s ∧ s ≤ b) → ((r - a ≤ 1 ∨ b - 1 ≤ r - a ∨ s ≤ 1 ∨ b - 1 ≤ s) → (g ⟨r, @@ -434,7 +438,7 @@ private theorem edge2 : (∀ (r : ℤ), a ≤ r → r ≤ (↑P.q : ℤ) → g ⟨r, b⟩ = B * r + (1 : ℤ) ∧ g ⟨b, r⟩ = B * r + (1 : ℤ))))))))))) := by classical - intro P g ha x a b A B cdiv hsum hdet hb P₁ hq₁ P₂ hq₂ v2 v3 cmul r ht ht' + intro P g ha a b A B cdiv hsum hdet hb P₁ hq₁ P₂ hq₂ v2 v3 cmul r ht ht' have hl := v2 r b (by omega) (by omega) have hv := v3 b r (by omega) (by omega) rw [cmul _ _ (ne_of_gt hb)] at hl @@ -813,18 +817,19 @@ private theorem cplus : private theorem edge0 : ∀ (P : FordFareyParameter), - let g := FordOdometer P - (GaussianInt) → ( - let a : Int := P.q₁ - let A := P.p₁ - let cdiv (n d : Int) := -((-n) / d) - (0 < a) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → ((FordFareyParameter) → ((∀ (r : + let g := FordOdometer P; + ( + let a : Int := P.q₁; + let A := P.p₁; + let cdiv (n d : Int) := -((-n) / d); + (0 < a) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → ( + ((∀ (r : Int), ∀ (s : Int), (0 ≤ r ∧ r ≤ a ∧ 0 ≤ s ∧ s ≤ a) → ((r ≤ 1 ∨ a - 1 ≤ r ∨ s ≤ 1 ∨ a - 1 ≤ s) → (g ⟨r, s⟩ = cdiv (A * r * s) a))) → ((∀ (d : Int), ∀ (k : Int), (d ≠ 0) → (cdiv (k * d) d = k)) → (∀ (t : ℤ), (0 : ℤ) ≤ t → t ≤ a → g ⟨a, t⟩ = A * t ∧ g ⟨t, a⟩ = A * t)))))) := by classical - intro P g x a A cdiv ha0 P₁ hq₁ P₂ v0 cmul t ht ht' + intro P g a A cdiv ha0 P₁ hq₁ v0 cmul t ht ht' have hl := v0 a t (by omega) (by omega) have hv := v0 t a (by omega) (by omega) rw [show A * a * t = (A * t) * a by ring, cmul _ _ (ne_of_gt ha0)] at hl @@ -833,14 +838,16 @@ private theorem edge0 : private theorem outward : ∀ (P : FordFareyParameter), - let g := FordOdometer P - ((P.q₁ : Int) < P.q) → ((GaussianInt) → ( - let a : Int := P.q₁ - let b : Int := P.q₂ - let A := P.p₁ - let B := P.p₂ - let cdiv (n d : Int) := -((-n) / d) - ((P.q : Int) = a + b) → ((FordFareyParameter) → (∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) → + let g := FordOdometer P; + ((P.q₁ : Int) < P.q) → ( + ( + let a : Int := P.q₁; + let b : Int := P.q₂; + let A := P.p₁; + let B := P.p₂; + let cdiv (n d : Int) := -((-n) / d); + ((P.q : Int) = a + b) → ( + (∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) → ((∀ (r : Int), ∀ (s : Int), (a ≤ r ∧ r ≤ P.q ∧ 0 ≤ s ∧ s ≤ b) → ((r - a ≤ 1 ∨ b - 1 ≤ r - a ∨ s ≤ 1 ∨ b - 1 ≤ s) → (g ⟨r, s⟩ = cdiv (B * (r - a) * s) b + A * s))) → ((∀ (r : Int), ∀ (s : Int), (0 ≤ r ∧ r ≤ b ∧ a ≤ s ∧ s ≤ P.q) → ((r ≤ 1 ∨ b - 1 ≤ r ∨ s - a ≤ 1 ∨ b - 1 @@ -848,20 +855,21 @@ private theorem outward : ≤ b → g ⟨a + (1 : ℤ), t⟩ = cdiv (B * t) b + A * t ∧ g ⟨t, a + (1 : ℤ)⟩ = cdiv (B * t) b + A * t))))))) := by classical - intro P g ha x a b A B cdiv hsum P₁ P₂ hq₂ v2 v3 t ht ht' + intro P g ha a b A B cdiv hsum P₂ hq₂ v2 v3 t ht ht' have hl := v2 (a + 1) t (by omega) (by omega) have hv := v3 t (a + 1) (by omega) (by omega) simpa only [add_sub_cancel_left, mul_one] using And.intro hl hv private theorem near2 : ∀ (P : FordFareyParameter), - let g := FordOdometer P - ((P.q₁ : Int) < P.q) → ((GaussianInt) → ( - let a : Int := P.q₁ - let b : Int := P.q₂ - let A := P.p₁ - let B := P.p₂ - let cdiv (n d : Int) := -((-n) / d) + let g := FordOdometer P; + ((P.q₁ : Int) < P.q) → ( + ( + let a : Int := P.q₁; + let b : Int := P.q₂; + let A := P.p₁; + let B := P.p₂; + let cdiv (n d : Int) := -((-n) / d); ((P.q : Int) = a + b) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) → ((∀ (r : Int), ∀ (s : Int), (a ≤ r ∧ r ≤ P.q ∧ 0 ≤ s ∧ s ≤ b) → ((r - a ≤ 1 ∨ b - 1 ≤ r - a ∨ s ≤ 1 ∨ b - 1 ≤ s) → (g ⟨r, s⟩ = cdiv (B * (r - @@ -871,7 +879,7 @@ private theorem near2 : (b - (1 : ℤ))) b + A * (b - (1 : ℤ)) ∧ g ⟨b - (1 : ℤ), r⟩ = cdiv (B * (r - a) * (b - (1 : ℤ))) b + A * (b - (1 : ℤ))))))))) := by classical - intro P g ha x a b A B cdiv hsum P₁ hq₁ P₂ hq₂ v2 v3 r ht ht' + intro P g ha a b A B cdiv hsum P₁ hq₁ P₂ hq₂ v2 v3 r ht ht' have hl := v2 r (b - 1) (by omega) (by omega) have hv := v3 (b - 1) r (by omega) (by omega) rw [show B * (b - 1) * (r - a) = B * (r - a) * (b - 1) by ring] at hv @@ -879,15 +887,16 @@ private theorem near2 : private theorem b0 : ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), ((1 : ℤ) ≤ x.re) → (((1 : ℤ) ≤ x.im) → ( - let a : Int := P.q₁ - (0 < a) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → ((FordFareyParameter) → ((∀ (l : + let a : Int := P.q₁; + (0 < a) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → ( + ((∀ (l : Int), ∀ (r : Int), ∀ (d : Int), ∀ (u : Int), ∀ (z : GaussianInt), z ∈ LatticeVertexBoundary {w : GaussianInt | l ≤ w.re ∧ w.re ≤ r ∧ d ≤ w.im ∧ w.im ≤ u} ↔ (l ≤ z.re ∧ z.re ≤ r ∧ d ≤ z.im ∧ z.im ≤ u) ∧ (z.re = l ∨ z.re = r ∨ z.im = d ∨ z.im = u)) → (x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) ↔ x.re ≤ a ∧ x.im ≤ a ∧ (x.re = a ∨ x.im = a))))))) := by classical - intro P x hr hs a ha0 P₁ hq₁ P₂ rectBoundary + intro P x hr hs a ha0 P₁ hq₁ rectBoundary change x ∈ LatticeVertexBoundary {z : GaussianInt | 0 ≤ z.re ∧ z.re ≤ a ∧ 0 ≤ z.im ∧ z.im ≤ a} ↔ _ rw [rectBoundary] @@ -912,10 +921,11 @@ private theorem b1 : omega private theorem b2 : - ∀ (P : FordFareyParameter), ((P.q₁ : Int) < P.q) → (∀ (x : GaussianInt), (x.re ≤ (↑P.q : ℤ) - + ∀ (P : FordFareyParameter), + (∀ (x : GaussianInt), (x.re ≤ (↑P.q : ℤ) - (1 : ℤ)) → (((1 : ℤ) ≤ x.im) → ( - let a : Int := P.q₁ - let b : Int := P.q₂ + let a : Int := P.q₁; + let b : Int := P.q₂; ((P.q : Int) = a + b) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) → ((∀ (l : Int), ∀ (r : Int), ∀ (d : Int), ∀ (u : Int), ∀ (z : GaussianInt), z ∈ LatticeVertexBoundary {w : GaussianInt | l ≤ w.re ∧ w.re ≤ @@ -923,7 +933,7 @@ private theorem b2 : = r ∨ z.im = d ∨ z.im = u)) → (x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) ↔ a ≤ x.re ∧ x.im ≤ b ∧ (x.re = a ∨ x.im = b)))))))) := by classical - intro P ha x hr' hs a b hsum P₁ hq₁ P₂ hq₂ rectBoundary + intro P x hr' hs a b hsum P₁ hq₁ P₂ hq₂ rectBoundary change x ∈ LatticeVertexBoundary {z : GaussianInt | a ≤ z.re ∧ z.re ≤ P.q ∧ 0 ≤ z.im ∧ z.im ≤ b} ↔ _ rw [rectBoundary] @@ -976,34 +986,36 @@ private theorem hcaseAt988 : split_ifs at count <;> omega private theorem hfAt993 : - ∀ (P : FordFareyParameter), ((P.q₁ : Int) < P.q) → ((GaussianInt) → ( - let a : Int := P.q₁ - let b : Int := P.q₂ - let A := P.p₁ - let B := P.p₂ + ∀ (P : FordFareyParameter), ((P.q₁ : Int) < P.q) → ( + ( + let a : Int := P.q₁; + let b : Int := P.q₂; + let A := P.p₁; + let B := P.p₂; ((P.q : Int) = a + b) → ((A * b - B * a = 1) → ((0 < a) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) → ((b < a) → (A * b / a = B)))))))) := by classical - intro P ha x a b A B hsum hdet ha0 P₁ hq₁ P₂ hq₂ hab + intro P ha a b A B hsum hdet ha0 P₁ hq₁ P₂ hq₂ hab rw [show A * b = 1 + B * a by nlinarith only [hdet], Int.add_mul_ediv_right _ _ (ne_of_gt ha0)] rw [Int.ediv_eq_zero_of_lt (by norm_num) (by omega)] ring private theorem hcAt1006 : - ∀ (P : FordFareyParameter), ((P.q₁ : Int) < P.q) → (((1 : ℕ) < P.q) → ((GaussianInt) → ( - let a : Int := P.q₁ - let b : Int := P.q₂ - let A := P.p₁ - let B := P.p₂ - let cdiv (n d : Int) := -((-n) / d) + ∀ (P : FordFareyParameter), ((P.q₁ : Int) < P.q) → (((1 : ℕ) < P.q) → ( + ( + let a : Int := P.q₁; + let b : Int := P.q₂; + let A := P.p₁; + let B := P.p₂; + let cdiv (n d : Int) := -((-n) / d); ((P.q : Int) = a + b) → ((A * b - B * a = 1) → ((0 < b) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) → ((∀ (d : Int), ∀ (n : Int), ∀ (k : Int), (d ≠ 0) → (cdiv (k * d - n) d = k - n / d)) → ((a < b) → (cdiv (B * a) b = A)))))))))) := by classical - intro P ha hbig x a b A B cdiv hsum hdet hb P₁ hq₁ P₂ hq₂ cminus hab + intro P ha hbig a b A B cdiv hsum hdet hb P₁ hq₁ P₂ hq₂ cminus hab rw [show B * a = A * b - 1 by nlinarith only [hdet], cminus _ _ _ (ne_of_gt hb), Int.ediv_eq_zero_of_lt (by norm_num) (by omega)] ring @@ -1121,7 +1133,7 @@ private theorem interiorLaplacian : (hedge : r ≤ 1 ∨ (R.q : Int) - 1 ≤ r ∨ s ≤ 1 ∨ (R.q : Int) - 1 ≤ s) : Classical.choose FordOdometerFamilyExistsUnique R ⟨r, s⟩ = - cdiv (R.p * r * s) R.q := FordLaplacianProof.parentValue P hbdy x P₁ P₂ R r s hrect hedge + cdiv (R.p * r * s) R.q := FordLaplacianProof.parentValue hbdy R r s hrect hedge -- Use the literal restrictions on the four parent doubled boundaries. have v0 (r s : Int) (hrect : 0 ≤ r ∧ r ≤ a ∧ 0 ≤ s ∧ s ≤ a) (hedge : r ≤ 1 ∨ a - 1 ≤ r ∨ s ≤ 1 ∨ a - 1 ≤ s) : @@ -1140,15 +1152,15 @@ private theorem interiorLaplacian : have cmul (d k : Int) (hd : d ≠ 0) : cdiv (k * d) d = k := by simpa using cminus d 0 k hd have edge0 (t : Int) (ht : 0 ≤ t) (ht' : t ≤ a) : - g ⟨a, t⟩ = A * t ∧ g ⟨t, a⟩ = A * t := FordLaplacianDetails.edge0 P x ha0 P₁ hq₁ P₂ v0 + g ⟨a, t⟩ = A * t ∧ g ⟨t, a⟩ = A * t := FordLaplacianDetails.edge0 P ha0 P₁ hq₁ v0 cmul t ht ht' have near0 (t : Int) (ht : 0 ≤ t) (ht' : t ≤ a) : g ⟨a - 1, t⟩ = A * t - A * t / a ∧ - g ⟨t, a - 1⟩ = A * t - A * t / a := FordLaplacianProof.near0 P x ha0 P₁ hq₁ P₂ v0 cminus + g ⟨t, a - 1⟩ = A * t - A * t / a := FordLaplacianProof.near0 P ha0 P₁ hq₁ v0 cminus t ht ht' have outward (t : Int) (ht : 0 ≤ t) (ht' : t ≤ b) : g ⟨a + 1, t⟩ = cdiv (B * t) b + A * t ∧ - g ⟨t, a + 1⟩ = cdiv (B * t) b + A * t := FordLaplacianDetails.outward P ha x hsum P₁ P₂ + g ⟨t, a + 1⟩ = cdiv (B * t) b + A * t := FordLaplacianDetails.outward P ha hsum P₂ hq₂ v2 v3 t ht ht' have lowFormula (t : Int) (ht : 0 < t) (hta : t < a) (htb : t ≤ b) : FourNeighborLaplacian g ⟨a, t⟩ = cdiv (B * t) b - A * t / a ∧ @@ -1158,7 +1170,7 @@ private theorem interiorLaplacian : FourNeighborLaplacian g ⟨(P.q : Int) - t, b⟩ = cdiv (B * t) b - A * t / a ∧ FourNeighborLaplacian g ⟨b, (P.q : Int) - t⟩ = cdiv (B * t) b - A * t / a := FordLaplacianProof.highFormula P lapCoord hsum hdet hb ha0 P₁ hq₁ P₂ hq₂ cminus - (FordLaplacianDetails.cplus) (FordLaplacianProof.edge2 P ha x hsum hdet hb P₁ hq₁ P₂ + (FordLaplacianDetails.cplus) (FordLaplacianProof.edge2 P ha hsum hdet hb P₁ hq₁ P₂ hq₂ v2 v3 cmul) ((show ∀ (r : ℤ), b ≤ r → r ≤ (↑P.q : ℤ) → g ⟨r, b + (1 : ℤ)⟩ = cdiv (A * (r - b)) a + B * r + B + (1 : ℤ) ∧ g ⟨b + (1 : ℤ), @@ -1178,7 +1190,7 @@ private theorem interiorLaplacian : constructor · nlinarith only [hl] · nlinarith only [hv])) - (FordLaplacianDetails.near2 P ha x hsum P₁ hq₁ P₂ hq₂ v2 v3) t ht hta htb + (FordLaplacianDetails.near2 P ha hsum P₁ hq₁ P₂ hq₂ v2 v3) t ht hta htb have roundArm (t : Int) (ht : 0 < t) (hta : t < a) (htb : t < b) : cdiv (B * t) b - A * t / a = 1 := FordLaplacianProof.roundArm P hdet hb ha0 t ht hta htb have rectBoundary (l r d u : Int) (z : GaussianInt) : @@ -1191,9 +1203,9 @@ private theorem interiorLaplacian : (if b ≤ x.re ∧ b ≤ x.im ∧ (x.re = b ∨ x.im = b) then 1 else 0) + (if a ≤ x.re ∧ x.im ≤ b ∧ (x.re = a ∨ x.im = b) then 1 else 0) + (if x.re ≤ b ∧ a ≤ x.im ∧ (x.re = b ∨ x.im = a) then 1 else 0) := - FordLaplacianProof.count P x P₁ P₂ (FordLaplacianDetails.b0 P x hr hs ha0 P₁ hq₁ P₂ + FordLaplacianProof.count P x P₁ P₂ (FordLaplacianDetails.b0 P x hr hs ha0 P₁ hq₁ rectBoundary) (FordLaplacianDetails.b1 P x hr' hs' hsum P₁ hq₁ P₂ hq₂ rectBoundary) - (FordLaplacianDetails.b2 P ha x hr' hs hsum P₁ hq₁ P₂ hq₂ rectBoundary) + (FordLaplacianDetails.b2 P x hr' hs hsum P₁ hq₁ P₂ hq₂ rectBoundary) (FordLaplacianDetails.b3 P ha x hr hs' hsum P₁ hq₁ P₂ hq₂ rectBoundary) refine ⟨?_, ?_, ?_⟩ · intro hn @@ -1223,7 +1235,7 @@ private theorem interiorLaplacian : (a < b ∧ ((x.re = a ∧ x.im = a) ∨ (x.re = b ∧ x.im = b))) := FordLaplacianDetails.hcaseAt988 P x count hn rcases hcase with ⟨hab, hcase⟩ | ⟨hab, hcase⟩ - · have hf : A * b / a = B := FordLaplacianDetails.hfAt993 P ha x hsum hdet ha0 P₁ hq₁ P₂ + · have hf : A * b / a = B := FordLaplacianDetails.hfAt993 P ha hsum hdet ha0 P₁ hq₁ P₂ hq₂ hab have hc : cdiv (B * b) b = B := cmul b B (ne_of_gt hb) rcases hcase with h | h @@ -1233,7 +1245,7 @@ private theorem interiorLaplacian : · have hx : x = ⟨b, a⟩ := by ext <;> simp [h.1, h.2] rw [hx, (lowFormula b hb hab le_rfl).2, hc, hf] ring - · have hc : cdiv (B * a) b = A := FordLaplacianDetails.hcAt1006 P ha hbig x hsum hdet hb P₁ + · have hc : cdiv (B * a) b = A := FordLaplacianDetails.hcAt1006 P ha hbig hsum hdet hb P₁ hq₁ P₂ hq₂ cminus hab have hf : A * a / a = A := Int.mul_ediv_cancel _ (ne_of_gt ha0) rcases hcase with h | h diff --git a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean index dc04018062..25304989d6 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import LeanPool.ApollonianSuperharmonic.FordParentVectors public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTripleSwapLast @@ -249,39 +250,7 @@ private theorem vertical : (by intro j k ha; simp [adj, f, Zsqrtd.ext_iff] at ha; omega) simpa [hV, f, hn] using hp -private theorem reverse_path : - (by - classical - exact - ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ - {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween V E y x) - ) := by - classical - intro V E x y hp - let adj := fun x y : GaussianInt => - y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ - rcases hp with ⟨p,hn,hl,hh,ht,hV,hs,he⟩ - have revstep : ∀ a b l₁ l₂, p.reverse = l₁ ++ a :: b :: l₂ → adj a b := by - intro a b l₁ l₂ h - have h' : p = l₂.reverse ++ b :: a :: l₁.reverse := by - have := congrArg List.reverse h - simpa [List.reverse_append, List.append_assoc] using this - rcases hs b a _ _ h' with h | h | h | h - · exact Or.inr (Or.inl (by rw [h]; simp)) - · exact Or.inl (by rw [h]; simp) - · exact Or.inr (Or.inr (Or.inr (by rw [h]; simp))) - · exact Or.inr (Or.inr (Or.inl (by rw [h]; simp))) - have revocc (p : List GaussianInt) (e : Finset GaussianInt) : - (∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = {a,b}) → - ∃ a b l₁ l₂, p.reverse = l₁ ++ a :: b :: l₂ ∧ e = {a,b} := by - rintro ⟨a,b,l₁,l₂,rfl,rfl⟩ - exact ⟨b,a,l₂.reverse,l₁.reverse,by simp [List.reverse_append,List.append_assoc], - Finset.pair_comm _ _⟩ - refine ⟨p.reverse, List.nodup_reverse.mpr hn, by simpa using hl, - by simpa using ht, by simpa using hh, by simpa using hV, revstep, ?_⟩ - intro e - exact ⟨fun h => revocc p e ((he e).mp h), - fun h => (he e).mpr (by simpa using revocc p.reverse e h)⟩ +private abbrev reverse_path := @SimpleGridPathBetween.reverse private theorem fordcell : (by @@ -1225,78 +1194,17 @@ end FordEndpointProof namespace FordEndpointAssembly -private theorem obs : - (by - classical - exact - (FordFareyParameter) → (∀ (T : ProtoTile), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (n : ℤ), (0 : ℤ) < n → - (∀ (z : GaussianInt), z ∈ T.cells ↔ a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + - n) → FootprintVertices T = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a - + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b n ∧ FootprintEdges T = (fun (V : Set GaussianInt) - => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 - : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) ((fun - (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) - a b n)) ) := by - classical - intro P T a b n hn hc - exact FordEndpointProof.obs P T a b n hn hc - -private theorem linepath : - (by - classical - exact - (FordFareyParameter) → ( - let adj := fun x y : GaussianInt => - y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ - ∀ (f : ℕ → GaussianInt), ∀ (n : ℕ), (0 : ℕ) < n → Function.Injective f → (∀ (k : ℕ), adj - (f k) (f (k + (1 : ℕ)))) → (∀ (j : ℕ), ∀ (k : ℕ), adj (f j) (f k) → k = j + (1 : ℕ) ∨ - j = k + (1 : ℕ)) → SimpleGridPathBetween (f '' Set.Icc (0 : ℕ) n) ((fun (V : Set - GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) - => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) - (f '' Set.Icc (0 : ℕ) n)) (f (0 : ℕ)) (f n)) ) := by - classical - intro P adj f n hn hf hs ha - exact FordEndpointProof.linepath P f n hn hf - hs ha - -private theorem reverse_path : - (by - classical - exact - ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ - {y : GaussianInt}, SimpleGridPathBetween V E x y → SimpleGridPathBetween V E y x ) := by - classical - intro V E x y hp - exact FordEndpointProof.reverse_path (V := V) (E := E) (x - := x) (y := y) hp - -private theorem sqcell : - (by - classical - exact - (FordFareyParameter) → ((∀ (n : ℕ), ∀ (z : GaussianInt), z ∈ (FordTile n).cells ↔ (0 : ℤ) - ≤ z.re ∧ z.re < (↑n : ℤ) ∧ (0 : ℤ) ≤ z.im ∧ z.im < (↑n : ℤ)) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - ∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (z : GaussianInt), z ∈ (sq n a b).cells ↔ a ≤ - z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n)) ) := by - classical - intro P fordcell sq n a b z - exact FordEndpointProof.sqcell P fordcell n a b z - private theorem sqobs : (by classical exact - (FordFareyParameter) → ( + ( let rect : Int → Int → Int → Set GaussianInt := fun a b n => - {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} + {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n}; let adj := fun x y : GaussianInt => - y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩; let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => - {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}}; (∀ (T : ProtoTile), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (n : ℤ), (0 : ℤ) < n → (∀ (z : GaussianInt), z ∈ T.cells ↔ a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + n) → FootprintVertices T = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im @@ -1306,609 +1214,17 @@ private theorem sqobs : (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) ((fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b n)) → ( let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ + TileTranslation (FordTile n) ⟨a,b⟩; (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (z : GaussianInt), z ∈ (sq n a b).cells ↔ a ≤ z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n) → (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), (0 < n) → (FootprintVertices (sq n a b) = rect a b n ∧ FootprintEdges (sq n a b) = edges (rect a b n))))) ) := by classical - intro P rect adj edges obs sq sqcell n a b hn + intro rect adj edges obs sq sqcell n a b hn exact obs _ a b n (by omega) (sqcell n a b) -private theorem hpH : - (by - classical - exact - let rect : Int → Int → Int → Set GaussianInt := fun a b n => - {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} - let adj := fun x y : GaussianInt => - y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ - let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => - {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} - (∀ (V : Set GaussianInt), ∀ (W : Set GaussianInt), (fun (V : Set GaussianInt) => {e : - Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 : - GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) V ∩ (fun (V : Set - GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) - => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) W - = (fun (V : Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y - : GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y - ∧ e = {x, y}}) (V ∩ W)) → ((∀ (l : ℤ), ∀ (h : ℤ), ∀ (b : ℤ), l < h → - SimpleGridPathBetween {z : GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = b} ((fun (V : - Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : - GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 - : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = - {x, y}}) {z : GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = b}) (⟨l, b⟩ : GaussianInt) - (⟨h, b⟩ : GaussianInt)) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), (0 < n) → (FootprintVertices (sq n a b) = rect a - b n ∧ FootprintEdges (sq n a b) = edges (rect a b n))) → (∀ (n : ℕ), ∀ (m : ℕ), ∀ (a - : ℤ), ∀ (b : ℤ), ∀ (c : ℤ), ∀ (d : ℤ), ∀ (l : ℤ), ∀ (h : ℤ), ∀ (y : ℤ), (0 : ℕ) < n → - (0 : ℕ) < m → l < h → rect a b (↑n : ℤ) ∩ rect c d (↑m : ℤ) = {z : GaussianInt | l ≤ - z.re ∧ z.re ≤ h ∧ z.im = y} → SimpleGridPathBetween (FootprintVertices ((fun (n : ℕ) - (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) ∩ - FootprintVertices ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : - GaussianInt)) m c d)) (FootprintEdges ((fun (n : ℕ) (a b : ℤ) => TileTranslation - (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) ∩ FootprintEdges ((fun (n : ℕ) (a b : ℤ) - => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) m c d)) (⟨l, y⟩ : - GaussianInt) (⟨h, y⟩ : GaussianInt)))) ) := by - classical - intro rect adj edges edge_inter horizontal sq sqobs n m a b c d l h y hn hm hlh hv - exact FordEndpointProof.hpH edge_inter horizontal sqobs n m a b c d l h y hn hm hlh hv - -private theorem hpV : - (by - classical - exact - let rect : Int → Int → Int → Set GaussianInt := fun a b n => - {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} - let adj := fun x y : GaussianInt => - y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ - let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => - {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} - (∀ (V : Set GaussianInt), ∀ (W : Set GaussianInt), (fun (V : Set GaussianInt) => {e : - Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 : - GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) V ∩ (fun (V : Set - GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) - => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) W - = (fun (V : Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y - : GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y - ∧ e = {x, y}}) (V ∩ W)) → ((∀ (l : ℤ), ∀ (h : ℤ), ∀ (a : ℤ), l < h → - SimpleGridPathBetween {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = a} ((fun (V : - Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : - GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 - : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = - {x, y}}) {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = a}) (⟨a, l⟩ : GaussianInt) - (⟨a, h⟩ : GaussianInt)) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), (0 < n) → (FootprintVertices (sq n a b) = rect a - b n ∧ FootprintEdges (sq n a b) = edges (rect a b n))) → (∀ (n : ℕ), ∀ (m : ℕ), ∀ (a - : ℤ), ∀ (b : ℤ), ∀ (c : ℤ), ∀ (d : ℤ), ∀ (l : ℤ), ∀ (h : ℤ), ∀ (x : ℤ), (0 : ℕ) < n → - (0 : ℕ) < m → l < h → rect a b (↑n : ℤ) ∩ rect c d (↑m : ℤ) = {z : GaussianInt | l ≤ - z.im ∧ z.im ≤ h ∧ z.re = x} → SimpleGridPathBetween (FootprintVertices ((fun (n : ℕ) - (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) ∩ - FootprintVertices ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : - GaussianInt)) m c d)) (FootprintEdges ((fun (n : ℕ) (a b : ℤ) => TileTranslation - (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) ∩ FootprintEdges ((fun (n : ℕ) (a b : ℤ) - => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) m c d)) (⟨x, l⟩ : - GaussianInt) (⟨x, h⟩ : GaussianInt)))) ) := by - classical - intro rect adj edges edge_inter vertical sq sqobs n m a b c d l h x hn hm hlh hv - exact FordEndpointProof.hpV edge_inter vertical sqobs n m a b c d l h x hn hm hlh hv - -private theorem sameobs : - (by - classical - exact - (FordFareyParameter) → ((∀ (T : ProtoTile), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (n : ℤ), (0 : ℤ) < n - → (∀ (z : GaussianInt), z ∈ T.cells ↔ a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + - n) → FootprintVertices T = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a - + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b n ∧ FootprintEdges T = (fun (V : Set GaussianInt) - => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 - : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) ((fun - (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) - a b n)) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (z : GaussianInt), z ∈ (sq n a b).cells ↔ a ≤ - z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n) → ((∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), - (0 < n) → ((sq n a b).cells.Nonempty)) → ((∀ (n : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℕ) < - n → TileCentroid ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : - GaussianInt)) n a b) = ((↑a : ℝ) + (↑n : ℝ) / (2 : ℝ), (↑b : ℝ) + (↑n : ℝ) / (2 : - ℝ))) → (∀ (T : ProtoTile), ∀ (n : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℕ) < n → T.cells = - (sq n a b).cells → FootprintVertices T = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ - z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b (↑n : ℤ) ∧ FootprintEdges T = - (fun (V : Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : - GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 - : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = - {x, y}}) ((fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ - z.im ≤ b + n}) a b (↑n : ℤ)) ∧ TileCentroid T = ((↑a : ℝ) + (↑n : ℝ) / (2 : ℝ), (↑b : - ℝ) + (↑n : ℝ) / (2 : ℝ))))))) ) := by - classical - intro P obs sq sqcell sqne sqcent T n a b hn hc - exact FordEndpointProof.sameobs P obs sqcell sqne sqcent T n - a b hn hc - -private theorem carry_squares : - (by - classical - exact - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - let package := fun U UR UL W Z : ProtoTile => - ∃ R : ExactTileInterfaceTriple U UR W, - ∃ I : ExactTileInterfaceTriple U UL W, - ∃ A : ExactTileInterfaceTriple U W Z, - R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ - I.otherCA = R.point ∧ A.otherAB = R.point - let ax := fun (q : Int) (flip : Bool) (t a n : Int) => - (if flip then q-a-n else a)+t - ∀ (q : ℤ), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin (5 : ℕ) → ℕ), ∀ (X : Fin (5 : - ℕ) → ℤ), ∀ (Y : Fin (5 : ℕ) → ℤ), (∀ (k : Fin (5 : ℕ)), (0 : ℕ) < N k) → ∀ (T : Fin - (5 : ℕ) → ProtoTile), (∀ (k : Fin (5 : ℕ)), (T k).cells = (sq (N k) (ax q flip t.re - (X k) (↑(N k) : ℤ)) (ax q flip t.im (Y k) (↑(N k) : ℤ))).cells) → package (sq (N (0 : - Fin (5 : ℕ))) (X (0 : Fin (5 : ℕ))) (Y (0 : Fin (5 : ℕ)))) (sq (N (1 : Fin (5 : ℕ))) - (X (1 : Fin (5 : ℕ))) (Y (1 : Fin (5 : ℕ)))) (sq (N (2 : Fin (5 : ℕ))) (X (2 : Fin (5 - : ℕ))) (Y (2 : Fin (5 : ℕ)))) (sq (N (3 : Fin (5 : ℕ))) (X (3 : Fin (5 : ℕ))) (Y (3 : - Fin (5 : ℕ)))) (sq (N (4 : Fin (5 : ℕ))) (X (4 : Fin (5 : ℕ))) (Y (4 : Fin (5 : ℕ)))) - → (fun (U UR UL W Z : ProtoTile) => ∃ (R : ExactTileInterfaceTriple U UR W) (I : - ExactTileInterfaceTriple U UL W) (A : ExactTileInterfaceTriple U W Z), R.point ≠ - I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = - R.point) (T (0 : Fin (5 : ℕ))) (T (1 : Fin (5 : ℕ))) (T (2 : Fin (5 : ℕ))) (T (3 : - Fin (5 : ℕ))) (T (4 : Fin (5 : ℕ))) ) := by - classical - intro sq package ax q flip t N X Y hN T hc hp - exact FordEndpointProof.carry_squares q flip t N X Y hN T hc hp - -private theorem finish0 : - (by - classical - exact - (FordFareyParameter) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - let package := fun U UR UL W Z : ProtoTile => - ∃ R : ExactTileInterfaceTriple U UR W, - ∃ I : ExactTileInterfaceTriple U UL W, - ∃ A : ExactTileInterfaceTriple U W Z, - R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ - I.otherCA = R.point ∧ A.otherAB = R.point - (∀ (r : ℕ), ∀ (s : ℕ), (0 : ℕ) < r → (0 : ℕ) < s → (fun (U UR UL W Z : ProtoTile) => ∃ (R - : ExactTileInterfaceTriple U UR W) (I : ExactTileInterfaceTriple U UL W) (A : - ExactTileInterfaceTriple U W Z), R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = - I.point ∧ I.otherCA = R.point ∧ A.otherAB = R.point) ((fun (n : ℕ) (a b : ℤ) => - TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (0 : ℤ) (0 : ℤ)) ((fun - (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) - (-(↑s : ℤ)) (-((↑r : ℤ) + (↑s : ℤ)))) ((fun (n : ℕ) (a b : ℤ) => TileTranslation - (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (-((↑r : ℤ) + (↑s : ℤ))) (↑s : ℤ)) ((fun - (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) s (-(↑s : - ℤ)) (0 : ℤ)) ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : - GaussianInt)) r (-(↑r : ℤ)) (↑s : ℤ))) → ( - let ax := fun (q : Int) (flip : Bool) (t a n : Int) => - (if flip then q-a-n else a)+t - (∀ (q : ℤ), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin (5 : ℕ) → ℕ), ∀ (X : Fin (5 - : ℕ) → ℤ), ∀ (Y : Fin (5 : ℕ) → ℤ), (∀ (k : Fin (5 : ℕ)), (0 : ℕ) < N k) → ∀ (T : Fin - (5 : ℕ) → ProtoTile), (∀ (k : Fin (5 : ℕ)), (T k).cells = (sq (N k) (ax q flip t.re - (X k) (↑(N k) : ℤ)) (ax q flip t.im (Y k) (↑(N k) : ℤ))).cells) → package (sq (N (0 : - Fin (5 : ℕ))) (X (0 : Fin (5 : ℕ))) (Y (0 : Fin (5 : ℕ)))) (sq (N (1 : Fin (5 : ℕ))) - (X (1 : Fin (5 : ℕ))) (Y (1 : Fin (5 : ℕ)))) (sq (N (2 : Fin (5 : ℕ))) (X (2 : Fin (5 - : ℕ))) (Y (2 : Fin (5 : ℕ)))) (sq (N (3 : Fin (5 : ℕ))) (X (3 : Fin (5 : ℕ))) (Y (3 : - Fin (5 : ℕ)))) (sq (N (4 : Fin (5 : ℕ))) (X (4 : Fin (5 : ℕ))) (Y (4 : Fin (5 : ℕ)))) - → (fun (U UR UL W Z : ProtoTile) => ∃ (R : ExactTileInterfaceTriple U UR W) (I : - ExactTileInterfaceTriple U UL W) (A : ExactTileInterfaceTriple U W Z), R.point ≠ - I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = - R.point) (T (0 : Fin (5 : ℕ))) (T (1 : Fin (5 : ℕ))) (T (2 : Fin (5 : ℕ))) (T (3 : - Fin (5 : ℕ))) (T (4 : Fin (5 : ℕ)))) → ((∀ (T : ProtoTile), ∀ (n : ℕ), ∀ (a : ℤ), ∀ - (b : ℤ), ∀ (u : GaussianInt), T.cells = (sq n a b).cells → (TileTranslation T - u).cells = ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : - GaussianInt)) n (a + u.re) (b + u.im)).cells) → (∀ (r : Nat), ∀ (s : Nat), (0 < r) → - ((0 < s) → (∀ (a : Int), ∀ (b : Int), ∀ (flip : Bool), ∀ (U : ProtoTile), ∀ (W : - ProtoTile), ∀ (Z : ProtoTile), (U.cells = (sq (r+s) a b).cells) → ((W.cells = (sq s - (if flip then a+(r+s:Int) else a-s) - (if flip then b+r else b)).cells) → ((Z.cells = (sq r (if flip then a+(r+s:Int) else - a-r) - (if flip then b else b+s)).cells) → (package U (TileTranslation U (if flip then - ⟨s,r+s⟩ else ⟨-(s:Int),-(r+s:Int)⟩)) (TileTranslation U (if flip then - ⟨r+s,-(s:Int)⟩ else ⟨-(r+s:Int),s⟩)) W Z))))))))) ) := by - classical - intro P sq package base0 ax carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ - exact FordEndpointProof.finish0 P base0 carry_squares translate_cells r s hr hs a b flip U - W Z hU hW hZ - -private theorem finish1 : - (by - classical - exact - (FordFareyParameter) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - let package := fun U UR UL W Z : ProtoTile => - ∃ R : ExactTileInterfaceTriple U UR W, - ∃ I : ExactTileInterfaceTriple U UL W, - ∃ A : ExactTileInterfaceTriple U W Z, - R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ - I.otherCA = R.point ∧ A.otherAB = R.point - (∀ (r : ℕ), ∀ (s : ℕ), (0 : ℕ) < r → (0 : ℕ) < s → (fun (U UR UL W Z : ProtoTile) => ∃ (R - : ExactTileInterfaceTriple U UR W) (I : ExactTileInterfaceTriple U UL W) (A : - ExactTileInterfaceTriple U W Z), R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = - I.point ∧ I.otherCA = R.point ∧ A.otherAB = R.point) ((fun (n : ℕ) (a b : ℤ) => - TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (0 : ℤ) (0 : ℤ)) ((fun - (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) - (-(↑r : ℤ)) ((↑r : ℤ) + (↑s : ℤ))) ((fun (n : ℕ) (a b : ℤ) => TileTranslation - (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (-((↑r : ℤ) + (↑s : ℤ))) (-(↑r : ℤ))) - ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) r - (-(↑r : ℤ)) (↑s : ℤ)) ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ - : GaussianInt)) s (-(↑s : ℤ)) (0 : ℤ))) → ( - let ax := fun (q : Int) (flip : Bool) (t a n : Int) => - (if flip then q-a-n else a)+t - (∀ (q : ℤ), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin (5 : ℕ) → ℕ), ∀ (X : Fin (5 - : ℕ) → ℤ), ∀ (Y : Fin (5 : ℕ) → ℤ), (∀ (k : Fin (5 : ℕ)), (0 : ℕ) < N k) → ∀ (T : Fin - (5 : ℕ) → ProtoTile), (∀ (k : Fin (5 : ℕ)), (T k).cells = (sq (N k) (ax q flip t.re - (X k) (↑(N k) : ℤ)) (ax q flip t.im (Y k) (↑(N k) : ℤ))).cells) → package (sq (N (0 : - Fin (5 : ℕ))) (X (0 : Fin (5 : ℕ))) (Y (0 : Fin (5 : ℕ)))) (sq (N (1 : Fin (5 : ℕ))) - (X (1 : Fin (5 : ℕ))) (Y (1 : Fin (5 : ℕ)))) (sq (N (2 : Fin (5 : ℕ))) (X (2 : Fin (5 - : ℕ))) (Y (2 : Fin (5 : ℕ)))) (sq (N (3 : Fin (5 : ℕ))) (X (3 : Fin (5 : ℕ))) (Y (3 : - Fin (5 : ℕ)))) (sq (N (4 : Fin (5 : ℕ))) (X (4 : Fin (5 : ℕ))) (Y (4 : Fin (5 : ℕ)))) - → (fun (U UR UL W Z : ProtoTile) => ∃ (R : ExactTileInterfaceTriple U UR W) (I : - ExactTileInterfaceTriple U UL W) (A : ExactTileInterfaceTriple U W Z), R.point ≠ - I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = - R.point) (T (0 : Fin (5 : ℕ))) (T (1 : Fin (5 : ℕ))) (T (2 : Fin (5 : ℕ))) (T (3 : - Fin (5 : ℕ))) (T (4 : Fin (5 : ℕ)))) → ((∀ (T : ProtoTile), ∀ (n : ℕ), ∀ (a : ℤ), ∀ - (b : ℤ), ∀ (u : GaussianInt), T.cells = (sq n a b).cells → (TileTranslation T - u).cells = ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : - GaussianInt)) n (a + u.re) (b + u.im)).cells) → (∀ (r : Nat), ∀ (s : Nat), (0 < r) → - ((0 < s) → (∀ (a : Int), ∀ (b : Int), ∀ (flip : Bool), ∀ (U : ProtoTile), ∀ (W : - ProtoTile), ∀ (Z : ProtoTile), (U.cells = (sq (r+s) a b).cells) → ((W.cells = (sq r - (if flip then a+(r+s:Int) else a-r) - (if flip then b else b+s)).cells) → ((Z.cells = (sq s (if flip then a+(r+s:Int) else - a-s) - (if flip then b+r else b)).cells) → (package U (TileTranslation U (if flip then - ⟨r,-(r+s:Int)⟩ else ⟨-(r:Int),r+s⟩)) (TileTranslation U (if flip then ⟨r+s,r⟩ - else ⟨-(r+s:Int),-(r:Int)⟩)) W Z))))))))) ) := by - classical - intro P sq package base1 ax carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ - exact FordEndpointProof.finish1 P base1 carry_squares translate_cells r s hr hs a b flip U - W Z hU hW hZ - end FordEndpointAssembly -namespace FordEndpointConclusion - -private theorem obs : - (by - classical - exact - (FordFareyParameter) → (∀ (T : ProtoTile), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (n : ℤ), (0 : ℤ) < n → - (∀ (z : GaussianInt), z ∈ T.cells ↔ a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + - n) → FootprintVertices T = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a - + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b n ∧ FootprintEdges T = (fun (V : Set GaussianInt) - => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 - : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) ((fun - (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) - a b n)) ) := by - classical - intro P T a b n hn hc - exact FordEndpointAssembly.obs P T a b n - hn hc - -private theorem linepath : - (by - classical - exact - (FordFareyParameter) → ( - let adj := fun x y : GaussianInt => - y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ - ∀ (f : ℕ → GaussianInt), ∀ (n : ℕ), (0 : ℕ) < n → Function.Injective f → (∀ (k : ℕ), adj - (f k) (f (k + (1 : ℕ)))) → (∀ (j : ℕ), ∀ (k : ℕ), adj (f j) (f k) → k = j + (1 : ℕ) ∨ - j = k + (1 : ℕ)) → SimpleGridPathBetween (f '' Set.Icc (0 : ℕ) n) ((fun (V : Set - GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) - => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) - (f '' Set.Icc (0 : ℕ) n)) (f (0 : ℕ)) (f n)) ) := by - classical - intro P adj f n hn hf hs ha - exact FordEndpointAssembly.linepath P f n hn - hf hs ha - -private theorem reverse_path : - (by - classical - exact - ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ - {y : GaussianInt}, SimpleGridPathBetween V E x y → SimpleGridPathBetween V E y x ) := by - classical - intro V E x y hp - exact FordEndpointAssembly.reverse_path (V := V) (E := E) - (x := x) (y := y) hp - -private theorem sqcell : - (by - classical - exact - (FordFareyParameter) → ((∀ (n : ℕ), ∀ (z : GaussianInt), z ∈ (FordTile n).cells ↔ (0 : ℤ) - ≤ z.re ∧ z.re < (↑n : ℤ) ∧ (0 : ℤ) ≤ z.im ∧ z.im < (↑n : ℤ)) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - ∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (z : GaussianInt), z ∈ (sq n a b).cells ↔ a ≤ - z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n)) ) := by - classical - intro P fordcell sq n a b z - exact FordEndpointAssembly.sqcell P fordcell n - a b z - -private theorem hpH : - (by - classical - exact - let rect : Int → Int → Int → Set GaussianInt := fun a b n => - {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} - (∀ (V : Set GaussianInt), ∀ (W : Set GaussianInt), (fun (V : Set GaussianInt) => {e : - Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 : - GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) V ∩ (fun (V : Set - GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) - => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) W - = (fun (V : Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y - : GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y - ∧ e = {x, y}}) (V ∩ W)) → ((∀ (l : ℤ), ∀ (h : ℤ), ∀ (b : ℤ), l < h → - SimpleGridPathBetween {z : GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = b} ((fun (V : - Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : - GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 - : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = - {x, y}}) {z : GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = b}) (⟨l, b⟩ : GaussianInt) - (⟨h, b⟩ : GaussianInt)) → ((∀ (n : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℕ) < n → - FootprintVertices ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : - GaussianInt)) n a b) = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n - ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b (↑n : ℤ) ∧ FootprintEdges ((fun (n : ℕ) (a b : ℤ) => - TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) = (fun (V : Set - GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) - => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) - ((fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b - + n}) a b (↑n : ℤ))) → (∀ (n : ℕ), ∀ (m : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (c : ℤ), ∀ (d : - ℤ), ∀ (l : ℤ), ∀ (h : ℤ), ∀ (y : ℤ), (0 : ℕ) < n → (0 : ℕ) < m → l < h → rect a b (↑n - : ℤ) ∩ rect c d (↑m : ℤ) = {z : GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = y} → - SimpleGridPathBetween (FootprintVertices ((fun (n : ℕ) (a b : ℤ) => TileTranslation - (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) ∩ FootprintVertices ((fun (n : ℕ) (a b : - ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) m c d)) (FootprintEdges - ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) n a - b) ∩ FootprintEdges ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : - GaussianInt)) m c d)) (⟨l, y⟩ : GaussianInt) (⟨h, y⟩ : GaussianInt)))) ) := by - classical - intro rect edge_inter horizontal sqobs n m a b c d l h y hn hm hlh hv - exact FordEndpointAssembly.hpH edge_inter horizontal sqobs n m a b c d l h y hn hm hlh hv - -private theorem hpV : - (by - classical - exact - let rect : Int → Int → Int → Set GaussianInt := fun a b n => - {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} - (∀ (V : Set GaussianInt), ∀ (W : Set GaussianInt), (fun (V : Set GaussianInt) => {e : - Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 : - GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) V ∩ (fun (V : Set - GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) - => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) W - = (fun (V : Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y - : GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y - ∧ e = {x, y}}) (V ∩ W)) → ((∀ (l : ℤ), ∀ (h : ℤ), ∀ (a : ℤ), l < h → - SimpleGridPathBetween {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = a} ((fun (V : - Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : - GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 - : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = - {x, y}}) {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = a}) (⟨a, l⟩ : GaussianInt) - (⟨a, h⟩ : GaussianInt)) → ((∀ (n : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℕ) < n → - FootprintVertices ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : - GaussianInt)) n a b) = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n - ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b (↑n : ℤ) ∧ FootprintEdges ((fun (n : ℕ) (a b : ℤ) => - TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) = (fun (V : Set - GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) - => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) - ((fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b - + n}) a b (↑n : ℤ))) → (∀ (n : ℕ), ∀ (m : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (c : ℤ), ∀ (d : - ℤ), ∀ (l : ℤ), ∀ (h : ℤ), ∀ (x : ℤ), (0 : ℕ) < n → (0 : ℕ) < m → l < h → rect a b (↑n - : ℤ) ∩ rect c d (↑m : ℤ) = {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = x} → - SimpleGridPathBetween (FootprintVertices ((fun (n : ℕ) (a b : ℤ) => TileTranslation - (FordTile n) (⟨a, b⟩ : GaussianInt)) n a b) ∩ FootprintVertices ((fun (n : ℕ) (a b : - ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) m c d)) (FootprintEdges - ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) n a - b) ∩ FootprintEdges ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : - GaussianInt)) m c d)) (⟨x, l⟩ : GaussianInt) (⟨x, h⟩ : GaussianInt)))) ) := by - classical - intro rect edge_inter vertical sqobs n m a b c d l h x hn hm hlh hv - exact FordEndpointAssembly.hpV edge_inter vertical sqobs n m a b c d l h x hn hm hlh hv - -private theorem sameobs : - (by - classical - exact - (FordFareyParameter) → ((∀ (T : ProtoTile), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (n : ℤ), (0 : ℤ) < n - → (∀ (z : GaussianInt), z ∈ T.cells ↔ a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + - n) → FootprintVertices T = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a - + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b n ∧ FootprintEdges T = (fun (V : Set GaussianInt) - => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : GaussianInt) => y = x + (1 - : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = {x, y}}) ((fun - (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) - a b n)) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (z : GaussianInt), z ∈ (sq n a b).cells ↔ a ≤ - z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n) → ((∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), - (0 < n) → ((sq n a b).cells.Nonempty)) → ((∀ (n : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℕ) < - n → TileCentroid ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : - GaussianInt)) n a b) = ((↑a : ℝ) + (↑n : ℝ) / (2 : ℝ), (↑b : ℝ) + (↑n : ℝ) / (2 : - ℝ))) → (∀ (T : ProtoTile), ∀ (n : ℕ), ∀ (a : ℤ), ∀ (b : ℤ), (0 : ℕ) < n → T.cells = - (sq n a b).cells → FootprintVertices T = (fun (a b n : ℤ) => {z : GaussianInt | a ≤ - z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n}) a b (↑n : ℤ) ∧ FootprintEdges T = - (fun (V : Set GaussianInt) => {e : Finset GaussianInt | ∃ x ∈ V, ∃ y ∈ V, (fun (x y : - GaussianInt) => y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 - : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) x y ∧ e = - {x, y}}) ((fun (a b n : ℤ) => {z : GaussianInt | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ - z.im ≤ b + n}) a b (↑n : ℤ)) ∧ TileCentroid T = ((↑a : ℝ) + (↑n : ℝ) / (2 : ℝ), (↑b : - ℝ) + (↑n : ℝ) / (2 : ℝ))))))) ) := by - classical - intro P obs sq sqcell sqne sqcent T n a b hn hc - exact FordEndpointAssembly.sameobs P obs sqcell sqne sqcent - T n a b hn hc - -private theorem carry_squares : - (by - classical - exact - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - let package := fun U UR UL W Z : ProtoTile => - ∃ R : ExactTileInterfaceTriple U UR W, - ∃ I : ExactTileInterfaceTriple U UL W, - ∃ A : ExactTileInterfaceTriple U W Z, - R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ - I.otherCA = R.point ∧ A.otherAB = R.point - let ax := fun (q : Int) (flip : Bool) (t a n : Int) => - (if flip then q-a-n else a)+t - ∀ (q : ℤ), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin (5 : ℕ) → ℕ), ∀ (X : Fin (5 : - ℕ) → ℤ), ∀ (Y : Fin (5 : ℕ) → ℤ), (∀ (k : Fin (5 : ℕ)), (0 : ℕ) < N k) → ∀ (T : Fin - (5 : ℕ) → ProtoTile), (∀ (k : Fin (5 : ℕ)), (T k).cells = (sq (N k) (ax q flip t.re - (X k) (↑(N k) : ℤ)) (ax q flip t.im (Y k) (↑(N k) : ℤ))).cells) → package (sq (N (0 : - Fin (5 : ℕ))) (X (0 : Fin (5 : ℕ))) (Y (0 : Fin (5 : ℕ)))) (sq (N (1 : Fin (5 : ℕ))) - (X (1 : Fin (5 : ℕ))) (Y (1 : Fin (5 : ℕ)))) (sq (N (2 : Fin (5 : ℕ))) (X (2 : Fin (5 - : ℕ))) (Y (2 : Fin (5 : ℕ)))) (sq (N (3 : Fin (5 : ℕ))) (X (3 : Fin (5 : ℕ))) (Y (3 : - Fin (5 : ℕ)))) (sq (N (4 : Fin (5 : ℕ))) (X (4 : Fin (5 : ℕ))) (Y (4 : Fin (5 : ℕ)))) - → (fun (U UR UL W Z : ProtoTile) => ∃ (R : ExactTileInterfaceTriple U UR W) (I : - ExactTileInterfaceTriple U UL W) (A : ExactTileInterfaceTriple U W Z), R.point ≠ - I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = - R.point) (T (0 : Fin (5 : ℕ))) (T (1 : Fin (5 : ℕ))) (T (2 : Fin (5 : ℕ))) (T (3 : - Fin (5 : ℕ))) (T (4 : Fin (5 : ℕ))) ) := by - classical - intro sq package ax q flip t N X Y hN T hc hp - exact FordEndpointAssembly.carry_squares q flip t N X Y hN T hc hp - -private theorem finish0 : - (by - classical - exact - (FordFareyParameter) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - let package := fun U UR UL W Z : ProtoTile => - ∃ R : ExactTileInterfaceTriple U UR W, - ∃ I : ExactTileInterfaceTriple U UL W, - ∃ A : ExactTileInterfaceTriple U W Z, - R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ - I.otherCA = R.point ∧ A.otherAB = R.point - (∀ (r : ℕ), ∀ (s : ℕ), (0 : ℕ) < r → (0 : ℕ) < s → (fun (U UR UL W Z : ProtoTile) => ∃ (R - : ExactTileInterfaceTriple U UR W) (I : ExactTileInterfaceTriple U UL W) (A : - ExactTileInterfaceTriple U W Z), R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = - I.point ∧ I.otherCA = R.point ∧ A.otherAB = R.point) ((fun (n : ℕ) (a b : ℤ) => - TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (0 : ℤ) (0 : ℤ)) ((fun - (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) - (-(↑s : ℤ)) (-((↑r : ℤ) + (↑s : ℤ)))) ((fun (n : ℕ) (a b : ℤ) => TileTranslation - (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (-((↑r : ℤ) + (↑s : ℤ))) (↑s : ℤ)) ((fun - (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) s (-(↑s : - ℤ)) (0 : ℤ)) ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : - GaussianInt)) r (-(↑r : ℤ)) (↑s : ℤ))) → ( - let ax := fun (q : Int) (flip : Bool) (t a n : Int) => - (if flip then q-a-n else a)+t - (∀ (q : ℤ), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin (5 : ℕ) → ℕ), ∀ (X : Fin (5 - : ℕ) → ℤ), ∀ (Y : Fin (5 : ℕ) → ℤ), (∀ (k : Fin (5 : ℕ)), (0 : ℕ) < N k) → ∀ (T : Fin - (5 : ℕ) → ProtoTile), (∀ (k : Fin (5 : ℕ)), (T k).cells = (sq (N k) (ax q flip t.re - (X k) (↑(N k) : ℤ)) (ax q flip t.im (Y k) (↑(N k) : ℤ))).cells) → package (sq (N (0 : - Fin (5 : ℕ))) (X (0 : Fin (5 : ℕ))) (Y (0 : Fin (5 : ℕ)))) (sq (N (1 : Fin (5 : ℕ))) - (X (1 : Fin (5 : ℕ))) (Y (1 : Fin (5 : ℕ)))) (sq (N (2 : Fin (5 : ℕ))) (X (2 : Fin (5 - : ℕ))) (Y (2 : Fin (5 : ℕ)))) (sq (N (3 : Fin (5 : ℕ))) (X (3 : Fin (5 : ℕ))) (Y (3 : - Fin (5 : ℕ)))) (sq (N (4 : Fin (5 : ℕ))) (X (4 : Fin (5 : ℕ))) (Y (4 : Fin (5 : ℕ)))) - → (fun (U UR UL W Z : ProtoTile) => ∃ (R : ExactTileInterfaceTriple U UR W) (I : - ExactTileInterfaceTriple U UL W) (A : ExactTileInterfaceTriple U W Z), R.point ≠ - I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = - R.point) (T (0 : Fin (5 : ℕ))) (T (1 : Fin (5 : ℕ))) (T (2 : Fin (5 : ℕ))) (T (3 : - Fin (5 : ℕ))) (T (4 : Fin (5 : ℕ)))) → ((∀ (T : ProtoTile), ∀ (n : ℕ), ∀ (a : ℤ), ∀ - (b : ℤ), ∀ (u : GaussianInt), T.cells = (sq n a b).cells → (TileTranslation T - u).cells = ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : - GaussianInt)) n (a + u.re) (b + u.im)).cells) → (∀ (r : Nat), ∀ (s : Nat), (0 < r) → - ((0 < s) → (∀ (a : Int), ∀ (b : Int), ∀ (flip : Bool), ∀ (U : ProtoTile), ∀ (W : - ProtoTile), ∀ (Z : ProtoTile), (U.cells = (sq (r+s) a b).cells) → ((W.cells = (sq s - (if flip then a+(r+s:Int) else a-s) - (if flip then b+r else b)).cells) → ((Z.cells = (sq r (if flip then a+(r+s:Int) else - a-r) - (if flip then b else b+s)).cells) → (package U (TileTranslation U (if flip then - ⟨s,r+s⟩ else ⟨-(s:Int),-(r+s:Int)⟩)) (TileTranslation U (if flip then - ⟨r+s,-(s:Int)⟩ else ⟨-(r+s:Int),s⟩)) W Z))))))))) ) := by - classical - intro P sq package base0 ax carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ - exact FordEndpointAssembly.finish0 P base0 carry_squares translate_cells r s hr hs a b flip - U W Z hU hW hZ - -private theorem finish1 : - (by - classical - exact - (FordFareyParameter) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - let package := fun U UR UL W Z : ProtoTile => - ∃ R : ExactTileInterfaceTriple U UR W, - ∃ I : ExactTileInterfaceTriple U UL W, - ∃ A : ExactTileInterfaceTriple U W Z, - R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ - I.otherCA = R.point ∧ A.otherAB = R.point - (∀ (r : ℕ), ∀ (s : ℕ), (0 : ℕ) < r → (0 : ℕ) < s → (fun (U UR UL W Z : ProtoTile) => ∃ (R - : ExactTileInterfaceTriple U UR W) (I : ExactTileInterfaceTriple U UL W) (A : - ExactTileInterfaceTriple U W Z), R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = - I.point ∧ I.otherCA = R.point ∧ A.otherAB = R.point) ((fun (n : ℕ) (a b : ℤ) => - TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (0 : ℤ) (0 : ℤ)) ((fun - (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) - (-(↑r : ℤ)) ((↑r : ℤ) + (↑s : ℤ))) ((fun (n : ℕ) (a b : ℤ) => TileTranslation - (FordTile n) (⟨a, b⟩ : GaussianInt)) (r + s) (-((↑r : ℤ) + (↑s : ℤ))) (-(↑r : ℤ))) - ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : GaussianInt)) r - (-(↑r : ℤ)) (↑s : ℤ)) ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ - : GaussianInt)) s (-(↑s : ℤ)) (0 : ℤ))) → ( - let ax := fun (q : Int) (flip : Bool) (t a n : Int) => - (if flip then q-a-n else a)+t - (∀ (q : ℤ), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin (5 : ℕ) → ℕ), ∀ (X : Fin (5 - : ℕ) → ℤ), ∀ (Y : Fin (5 : ℕ) → ℤ), (∀ (k : Fin (5 : ℕ)), (0 : ℕ) < N k) → ∀ (T : Fin - (5 : ℕ) → ProtoTile), (∀ (k : Fin (5 : ℕ)), (T k).cells = (sq (N k) (ax q flip t.re - (X k) (↑(N k) : ℤ)) (ax q flip t.im (Y k) (↑(N k) : ℤ))).cells) → package (sq (N (0 : - Fin (5 : ℕ))) (X (0 : Fin (5 : ℕ))) (Y (0 : Fin (5 : ℕ)))) (sq (N (1 : Fin (5 : ℕ))) - (X (1 : Fin (5 : ℕ))) (Y (1 : Fin (5 : ℕ)))) (sq (N (2 : Fin (5 : ℕ))) (X (2 : Fin (5 - : ℕ))) (Y (2 : Fin (5 : ℕ)))) (sq (N (3 : Fin (5 : ℕ))) (X (3 : Fin (5 : ℕ))) (Y (3 : - Fin (5 : ℕ)))) (sq (N (4 : Fin (5 : ℕ))) (X (4 : Fin (5 : ℕ))) (Y (4 : Fin (5 : ℕ)))) - → (fun (U UR UL W Z : ProtoTile) => ∃ (R : ExactTileInterfaceTriple U UR W) (I : - ExactTileInterfaceTriple U UL W) (A : ExactTileInterfaceTriple U W Z), R.point ≠ - I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = - R.point) (T (0 : Fin (5 : ℕ))) (T (1 : Fin (5 : ℕ))) (T (2 : Fin (5 : ℕ))) (T (3 : - Fin (5 : ℕ))) (T (4 : Fin (5 : ℕ)))) → ((∀ (T : ProtoTile), ∀ (n : ℕ), ∀ (a : ℤ), ∀ - (b : ℤ), ∀ (u : GaussianInt), T.cells = (sq n a b).cells → (TileTranslation T - u).cells = ((fun (n : ℕ) (a b : ℤ) => TileTranslation (FordTile n) (⟨a, b⟩ : - GaussianInt)) n (a + u.re) (b + u.im)).cells) → (∀ (r : Nat), ∀ (s : Nat), (0 < r) → - ((0 < s) → (∀ (a : Int), ∀ (b : Int), ∀ (flip : Bool), ∀ (U : ProtoTile), ∀ (W : - ProtoTile), ∀ (Z : ProtoTile), (U.cells = (sq (r+s) a b).cells) → ((W.cells = (sq r - (if flip then a+(r+s:Int) else a-r) - (if flip then b else b+s)).cells) → ((Z.cells = (sq s (if flip then a+(r+s:Int) else - a-s) - (if flip then b+r else b)).cells) → (package U (TileTranslation U (if flip then - ⟨r,-(r+s:Int)⟩ else ⟨-(r:Int),r+s⟩)) (TileTranslation U (if flip then ⟨r+s,r⟩ - else ⟨-(r+s:Int),-(r:Int)⟩)) W Z))))))))) ) := by - classical - intro P sq package base1 ax carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ - exact FordEndpointAssembly.finish1 P base1 carry_squares translate_cells r s hr hs a b flip - U W Z hU hW hZ - -end FordEndpointConclusion theorem FordOrientedChildParentEndpoints (P : FordFareyParameter) (hq : 1 < P.q) : @@ -1957,26 +1273,26 @@ theorem FordOrientedChildParentEndpoints y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} - have obs := FordEndpointConclusion.obs P + have obs := FordEndpointProof.obs P have edge_inter := FordEndpointProof.edge_inter -- Enumerate every vertex and every edge of a straight segment. - have linepath := FordEndpointConclusion.linepath P + have linepath := FordEndpointProof.linepath P have reverse_path {V : Set GaussianInt} {E : Set (Finset GaussianInt)} {x y : GaussianInt} - (hp : SimpleGridPathBetween V E x y) := FordEndpointConclusion.reverse_path (V := V) (E := + (hp : SimpleGridPathBetween V E x y) := FordEndpointProof.reverse_path (V := V) (E := E) (x := x) (y := y) hp have fordcell := FordEndpointProof.fordcell P let sq := fun n : Nat => fun a b : Int => TileTranslation (FordTile n) ⟨a,b⟩ have sqcell (n : Nat) (a b : Int) (z : GaussianInt) : z ∈ (sq n a b).cells ↔ - a ≤ z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n := FordEndpointConclusion.sqcell P fordcell + a ≤ z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n := FordEndpointProof.sqcell P fordcell n a b z - have sqobs := FordEndpointAssembly.sqobs P obs sqcell + have sqobs := FordEndpointAssembly.sqobs obs sqcell have sqne (n : Nat) (a b : Int) (hn : 0 < n) : (sq n a b).cells.Nonempty := ⟨⟨a,b⟩, (sqcell n a b _).mpr (by dsimp; omega)⟩ -- A centered quarter-turn determines the square's centroid without sums. - have hpH := FordEndpointConclusion.hpH edge_inter (FordEndpointProof.horizontal P linepath) sqobs - have hpV := FordEndpointConclusion.hpV edge_inter (FordEndpointProof.vertical P linepath) sqobs + have hpH := FordEndpointProof.hpH edge_inter (FordEndpointProof.horizontal P linepath) sqobs + have hpV := FordEndpointProof.hpV edge_inter (FordEndpointProof.vertical P linepath) sqobs -- The complete path ledger for rotation zero. have ledger0 := FordEndpointProof.ledger0 P reverse_path sqobs hpH hpV -- The second ledger uses the same child-parent junction with parents swapped. @@ -1990,9 +1306,9 @@ theorem FordOrientedChildParentEndpoints (if flip then (⟨q,q⟩ : GaussianInt) - z else z) + t let ax := fun (q : Int) (flip : Bool) (t a n : Int) => (if flip then q-a-n else a)+t - have sameobs := FordEndpointConclusion.sameobs P obs sqcell sqne (FordEndpointProof.sqcent + have sameobs := FordEndpointProof.sameobs P obs sqcell sqne (FordEndpointProof.sqcent (FordEndpointProof.fordcent P fordcell)) - have carry_squares := FordEndpointConclusion.carry_squares + have carry_squares := FordEndpointProof.carry_squares have translate_cells := FordEndpointProof.translate_cells have finish0 (r s : Nat) (hr : 0 < r) (hs : 0 < s) (a b : Int) (flip : Bool) (U W Z : ProtoTile) @@ -2004,7 +1320,7 @@ theorem FordOrientedChildParentEndpoints package U (TileTranslation U (if flip then ⟨s,r+s⟩ else ⟨-(s:Int),-(r+s:Int)⟩)) (TileTranslation U (if flip then ⟨r+s,-(s:Int)⟩ else ⟨-(r+s:Int),s⟩)) W Z := - FordEndpointConclusion.finish0 P (FordEndpointProof.base0 P ledger0) carry_squares + FordEndpointProof.finish0 P (FordEndpointProof.base0 P ledger0) carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ have finish1 (r s : Nat) (hr : 0 < r) (hs : 0 < s) (a b : Int) @@ -2017,7 +1333,7 @@ theorem FordOrientedChildParentEndpoints package U (TileTranslation U (if flip then ⟨r,-(r+s:Int)⟩ else ⟨-(r:Int),r+s⟩)) (TileTranslation U (if flip then ⟨r+s,r⟩ else ⟨-(r+s:Int),-(r:Int)⟩)) W Z := - FordEndpointConclusion.finish1 P (FordEndpointProof.base1 P + FordEndpointProof.finish1 P (FordEndpointProof.base1 P (FordEndpointProof.ledger1 P reverse_path sqobs hpH hpV ledger0)) carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean index 67857ff234..49d0e35a76 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean @@ -50,36 +50,6 @@ private theorem closed_grid_index_zero : exact TopologicalDiskGridRayCrossingIndexZero (TileRealization T) hT q hq p x y hhead hlast hadj hclose hedge -private theorem adjacent_grid_index_control : - (by - classical - exact - ∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), p.head? = some x → - p.getLast? = some y → p.Nodup → 3 ≤ p.length → - (∀ a, ∀ b, (a, b) ∈ p.zip p.tail → FourNeighborAdjacent a b) → - FourNeighborAdjacent y x → - let cyclicEdges := (p.zip p.tail) ++ [(y, x)] - ∀ q : LatticeCell, - (((q + 1, q + 1 + ⟨0, 1⟩) ∉ cyclicEdges ∧ - (q + 1 + ⟨0, 1⟩, q + 1) ∉ cyclicEdges) → - GridRayCrossingIndex (q + 1) p = GridRayCrossingIndex q p) ∧ - (((q + 1, q + 1 + ⟨0, 1⟩) ∈ cyclicEdges ∨ - (q + 1 + ⟨0, 1⟩, q + 1) ∈ cyclicEdges) → - Int.natAbs (GridRayCrossingIndex (q + 1) p - - GridRayCrossingIndex q p) = 1) ∧ - (((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∉ cyclicEdges ∧ - (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) ∉ cyclicEdges) → - GridRayCrossingIndex (q + ⟨0, 1⟩) p = - GridRayCrossingIndex q p) ∧ - (((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∈ cyclicEdges ∨ - (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) ∈ cyclicEdges) → - Int.natAbs (GridRayCrossingIndex (q + ⟨0, 1⟩) p - - GridRayCrossingIndex q p) = 1) - ) := by - classical - intro p x y hhead hlast hnodup hlen hadj hclose - exact GridRayCrossingIndexAdjacentCell p x y hhead hlast hnodup hlen hadj hclose - private theorem boundary_edge_segment : (by classical @@ -728,7 +698,7 @@ theorem LatticeTileBoundarySimpleGridCycle (T : ProtoTile) (hT : LatticeTile T) (((q + 1 + ⟨0, 1⟩, q + ⟨0, 1⟩) ∈ cyclicEdges ∨ (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) ∈ cyclicEdges) → Int.natAbs (GridRayCrossingIndex (q + ⟨0, 1⟩) p - - GridRayCrossingIndex q p) = 1) := BoundaryCycleProof.adjacent_grid_index_control + GridRayCrossingIndex q p) = 1) := GridRayCrossingIndexAdjacentCell obtain ⟨gridPath, x, y, z, gridPath_nodup, gridPath_length_four, gridPath_head, gridPath_last, gridPath_chain, gridPath_close, gridPath_fourNeighbor, gridPath_close_fourNeighbor, gridPath_zip_fourNeighbor, diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean index 81a939db26..14a4214526 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple public import LeanPool.ApollonianSuperharmonic.LatticeTileDiskUnionInterface @@ -601,55 +602,7 @@ private theorem hendCA : exact endpoint_of_third C A B hC hA hBne hdisjointCA hdisjointBC.symm hdisjointAB hVrawCA ⟨hrho.2, hrho.1.1⟩ hrho.1.2 xCA yCA hpathCA -private theorem reverse_path : - (by - classical - exact - ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {a : GaussianInt}, ∀ - {b : GaussianInt}, (SimpleGridPathBetween V E a b) → (SimpleGridPathBetween V E b a) - ) := by - classical - intro V E a b hpath - rcases hpath with ⟨p, hnodup, hlen, hhead, hlast, hvertices, - hstep, hedges⟩ - refine ⟨p.reverse, List.nodup_reverse.mpr hnodup, ?_, ?_, ?_, ?_, ?_, ?_⟩ - · simpa using hlen - · simpa using hlast - · simpa using hhead - · rw [hvertices] - ext z - simp - · intro x y l₁ l₂ hrev - have hforward : p = l₂.reverse ++ y :: x :: l₁.reverse := by - have := congrArg List.reverse hrev - simpa [List.reverse_append, List.append_assoc] using this - rcases hstep y x l₂.reverse l₁.reverse hforward with h | h | h | h - · right; left - rw [h] - ring - · left - rw [h] - ring - · right; right; right - rw [h] - ring - · right; right; left - rw [h] - ring - · intro e - constructor - · intro he - rcases (hedges e).1 he with ⟨x, y, l₁, l₂, hp, rfl⟩ - refine ⟨y, x, l₂.reverse, l₁.reverse, ?_, ?_⟩ - · rw [hp] - simp [List.reverse_append, List.append_assoc] - · simp [Finset.pair_comm] - · rintro ⟨x, y, l₁, l₂, hrev, rfl⟩ - apply (hedges {x, y}).2 - refine ⟨y, x, l₂.reverse, l₁.reverse, ?_, ?_⟩ - · have := congrArg List.reverse hrev - simpa [List.reverse_append, List.append_assoc] using this - · simp [Finset.pair_comm] +private abbrev reverse_path := @SimpleGridPathBetween.reverse private theorem orient_path : (by @@ -855,7 +808,7 @@ theorem LatticeTileThreeDiskJunction hBne hVrawCA xCA yCA hpathCA rho hrho endpoint_of_third have reverse_path {V : Set GaussianInt} {E : Set (Finset GaussianInt)} {a b : GaussianInt} (hpath : SimpleGridPathBetween V E a b) := - ThreeDiskJunctionGeometry.reverse_path (V := V) (E := E) (a := a) (b := b) hpath + ThreeDiskJunctionGeometry.reverse_path (V := V) (E := E) (x := a) (y := b) hpath have orient_path {V : Set GaussianInt} {E : Set (Finset GaussianInt)} {a b : GaussianInt} (hpath : SimpleGridPathBetween V E a b) (hend : rho = a ∨ rho = b) := ThreeDiskJunctionGeometry.orient_path rho reverse_path (V := diff --git a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean index d9d8da6178..8c741a1d97 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean @@ -917,8 +917,8 @@ private theorem htileXi : exact ∀ (C : BandCircle), ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), let tileAt : Int × Int → ProtoTile := fun z => - TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) - (List (ℤ × ℤ)) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (P : PeriodicTileComplex + TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b); + (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (chart : AffineTriangularComplexChart P fun (mn : ℤ × ℤ) => TileTranslation base ((↑mn.1 : GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑mn.2 : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q @@ -939,10 +939,10 @@ private theorem htileXi : (AffineTriangularFaceVertices f) = {P.plane.faceVertex F (0 : Fin (3 : ℕ)), P.plane.faceVertex F (1 : Fin (3 : ℕ)), P.plane.faceVertex F (2 : Fin (3 : ℕ))}) → ( let xi := fun z : Int × Int => - chart.vertexEquiv (Prod.swap z) + chart.vertexEquiv (Prod.swap z); ∀ (z : Int × Int), P.tile (xi z) = tileAt z))))) := by classical - intro C base a b tileAt F q P chart haV hbV halign xi z + intro C base a b tileAt q P chart haV hbV halign xi z change P.tile (chart.vertexEquiv (Prod.swap z)) = tileAt z simpa [tileAt, haV, hbV, add_comm] using (halign.2.2.1 z).symm @@ -986,7 +986,8 @@ private theorem hincAt826 : (by classical exact - ∀ (C : BandCircle), ∀ (base : ProtoTile), (List (ℤ × ℤ)) → (∀ (q : Fin (4 : ℕ) → + ∀ (C : BandCircle), ∀ (base : ProtoTile), + (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (chart : AffineTriangularComplexChart P fun (mn : ℤ × ℤ) => TileTranslation base ((↑mn.1 : GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑mn.2 : @@ -1006,16 +1007,16 @@ private theorem hincAt826 : (AffineTriangularFaceVertices f) = {P.plane.faceVertex F (0 : Fin (3 : ℕ)), P.plane.faceVertex F (1 : Fin (3 : ℕ)), P.plane.faceVertex F (2 : Fin (3 : ℕ))}) → ( let xi := fun z : Int × Int => - chart.vertexEquiv (Prod.swap z) + chart.vertexEquiv (Prod.swap z); let faceAt : AffineTriangularFace → P.plane.Face := fun f => match AffineTriangularFaceCoordinateSwap f with | .up z => chart.up z - | .down z => chart.down z + | .down z => chart.down z; ∀ (f : AffineTriangularFace), (AffineTriangularFaceVertices f).image xi = {P.plane.faceVertex (faceAt f) 0, P.plane.faceVertex (faceAt f) 1, P.plane.faceVertex (faceAt f) 2}))) := by classical - intro C base F q P chart halign xi faceAt f + intro C base q P chart halign xi faceAt f change (AffineTriangularFaceVertices f).image (fun z => chart.vertexEquiv (Prod.swap z)) = _ exact halign.2.2.2 f @@ -1480,9 +1481,9 @@ theorem OpposingStringInterfacePath | .up z => chart.up z | .down z => chart.down z have hadjXi := OpposingInterfaceGeometry.hadjXiAt795 C base F q P chart halign - have htileXi := OpposingInterfaceGeometry.htileXi C base a b F q P chart haV hbV halign + have htileXi := OpposingInterfaceGeometry.htileXi C base a b q P chart haV hbV halign have hinjFace := OpposingInterfaceGeometry.hinjFaceAt805 C base q P chart - have hinc := OpposingInterfaceGeometry.hincAt826 C base F q P chart halign + have hinc := OpposingInterfaceGeometry.hincAt826 C base q P chart halign exact finish P xi faceAt hadjXi htileXi hinjFace hinc end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean b/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean index 1d43e883b0..0890934b01 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean @@ -107,18 +107,18 @@ private theorem hstepAt162 : private theorem hstrict : ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary - n), ∀ (s : P3475T1BoundarySubdivision q p), (∀ (j : Fin (n + (3 : ℕ))), ∃ k < n + (3 : - ℕ), s.edge (j + (↑(k + (1 : ℕ)) : Fin (n + (3 : ℕ)))) ≠ s.edge j) → (∀ (i : Fin (r + (3 : + n), ∀ (s : P3475T1BoundarySubdivision q p), + (∀ (i : Fin (r + (3 : ℕ))), ∀ (ex : ∃ k < n + (3 : ℕ), s.edge (s.start i + (↑(k + (1 : ℕ)) : Fin (n + (3 : ℕ)))) ≠ s.edge (s.start i)), - let k₀ := Nat.find ex - let m := k₀ + 1 + let k₀ := Nat.find ex; + let m := k₀ + 1; (∀ (k : Nat), (k + 1 < m) → (s.parameter (s.start i + (k : Fin (n + 3))) < s.parameter (s.start i + ((k + 1 : Nat) : Fin (n + 3))))) → (∀ (l : Nat), l < m → ∀ k : Nat, k < l → s.parameter (s.start i + (k : Fin (n + 3))) < s.parameter (s.start i + (l : Fin (n + 3))))) := by classical - intro r n q p s hexit i ex k₀ m hstep l + intro r n q p s i ex k₀ m hstep l induction l with | zero => intro _ k hk; omega | succ l ih => @@ -1503,7 +1503,7 @@ theorem P3523T1OrderedInsertion {r n : Nat} have hstep (k : Nat) (hk : k + 1 < m) := OrderedInsertionGeometry.hstepAt162 r n q p s hexit i ex hsame k hk exact ⟨m, by dsimp [m]; omega, hm, hstart, hsame, - fun k l hkl hl => OrderedInsertionGeometry.hstrict r n q p s hexit i ex hstep l hl k hkl⟩ + fun k l hkl hl => OrderedInsertionGeometry.hstrict r n q p s i ex hstep l hl k hkl⟩ · have hvalid : (∀ h : Nat, ∀ hh : h < (P3523T1InsertionConstruction s t).steps.length, let e := (P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩ e.1 ≠ e.2.2 ∧ e.1 ∈ (P3523T1InsertionConstruction s t).vertices h ∧ diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean index 72d091e13b..43fe19e498 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean @@ -53,18 +53,6 @@ private theorem htailNodup : intro n a b u v L hL exact (List.nodup_cons.mp hL).2 -private theorem hne : - ∀ (n : Nat), (Fin (n + 3) → Real × Real) → (∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : - List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), ((a :: (u ++ b :: v)).Nodup) → ((∃ k : - Nat, (a :: (u ++ b :: v)).Sublist ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) → ( - let L := a :: (u ++ b :: v) - (L.Nodup) → ((a ∉ u ++ b :: v) → (((u ++ b :: v).Nodup) → (a ≠ b)))))) := by - classical - intro n q a b u v hboundary hcyclic L hL haNotTail htailNodup hab - subst b - apply haNotTail - simp - private theorem hparts : ∀ (n : Nat), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), ((u ++ b :: v).Nodup) → (u.Nodup ∧ (b :: v).Nodup ∧ ∀ a ∈ u, ∀ b_1 ∈ b :: v, a ≠ b_1) := by @@ -688,19 +676,20 @@ private theorem hrankV : private theorem hrankFormula : ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : List (Fin (n + 3))), - let L := a :: (u ++ b :: v) + let L := a :: (u ++ b :: v); ∀ (k : ℕ), - let root := List.ofFn (fun i : Fin (n + 3) => i) - let R := root.rotate k + let root := List.ofFn (fun i : Fin (n + 3) => i); + let R := root.rotate k; ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => - i).rotate k).length), (u.length+1 < L.length) → ( - let ia : Fin L.length := ⟨0, by simp [L]⟩ + i).rotate k).length), + ( + let ia : Fin L.length := ⟨0, by simp [L]⟩; (R.get (emb ia) = a) → ((a.val = ((emb ia).val + k) % (n + 3)) → ( - let rank := fun i : Fin (n+3) => (i.val + (n+3) - a.val) % (n+3) + let rank := fun i : Fin (n+3) => (i.val + (n+3) - a.val) % (n+3); ∀ (i : Fin (n+3)), rank i = if a.val ≤ i.val then i.val-a.val else n+3-a.val+i.val))) := by classical - intro n a b u v L k root R emb hsourceB ia haAtRoot hvalA rank i + intro n a b u v L k root R emb ia haAtRoot hvalA rank i by_cases h : a.val ≤ i.val · have heq : i.val+(n+3)-a.val = (n+3)+(i.val-a.val) := by omega simp [rank, h, heq, Nat.mod_eq_of_lt (by omega : i.val-a.val < n+3)] @@ -1718,7 +1707,9 @@ theorem P3555T2ParabolaChordCuts {n : Nat} have hL : L.Nodup := ParabolaChordLemmas.hL n a b u v hboundary have haNotTail : a ∉ u ++ b :: v := ParabolaChordLemmas.haNotTail n a b u v hL have htailNodup : (u ++ b :: v).Nodup := ParabolaChordLemmas.htailNodup n a b u v hL - have hne : a ≠ b := ParabolaChordLemmas.hne n q a b u v hboundary hcyclic hL haNotTail htailNodup + have hne : a ≠ b := by + rintro rfl + exact haNotTail (by simp) have hparts := ParabolaChordLemmas.hparts n b u v htailNodup have huNodup : u.Nodup := ParabolaChordLemmas.huNodup n b u v hparts have hbNotU : b ∉ u := ParabolaChordLemmas.hbNotU n b u v hparts @@ -1729,12 +1720,9 @@ theorem P3555T2ParabolaChordCuts {n : Nat} have huvDisjoint : ∀ i, i ∈ u → i ∈ v → False := ParabolaChordLemmas.huvDisjoint n b u v hparts have hANodup : A.Nodup := ParabolaChordLemmas.hANodup n a b u hne huNodup hbNotU haNotU have hBNodup : B.Nodup := ParabolaChordLemmas.hBNodup n a b v hne hvNodup hbNotV haNotV - have hsets : {i | i ∈ A} ∩ {i | i ∈ B} = {a, b} := (show - {i | i ∈ A} ∩ {i | i ∈ B} = {a, b} - from by - classical - ext i - simp [A, B, List.mem_cons, List.mem_append]; aesop) + have hsets : {i | i ∈ A} ∩ {i | i ∈ B} = {a, b} := by + ext i + simp [A, B, List.mem_cons, List.mem_append]; aesop have hnil (xs : List (Fin (n + 3))) : ([] : List (Fin (n + 3))).Sublist xs := ParabolaChordLemmas.hnil n xs have hnilv := ParabolaChordLemmas.hnilv n v hnil @@ -1791,7 +1779,7 @@ theorem P3555T2ParabolaChordCuts {n : Nat} u v k emb hsourceB hrootOrder hrankB' hrankAt i hi have hrankFormula (i : Fin (n+3)) : rank i = if a.val ≤ i.val then i.val-a.val else n+3-a.val+i.val := ParabolaChordLemmas.hrankFormula - n a b u v k emb hsourceB haAtRoot hvalA i + n a b u v k emb haAtRoot hvalA i have hrankHi (i : Fin (n+3)) (h : a.val ≤ i.val) : rank i = i.val-a.val := ParabolaChordLemmas.hrankHi n a hrankFormula i h have hrankLo (i : Fin (n+3)) (h : ¬ a.val ≤ i.val) : diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean index 203ba97978..42a3782821 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean @@ -674,16 +674,16 @@ private theorem hchildNextAt805 : u.length), let iA : Fin (a :: (u ++ [b])).length := ⟨k.val, by have hlen : (a :: (u ++ [b])).length = u.length + 2 := by simp - rw [hlen]; omega⟩ + rw [hlen]; omega⟩; let iA1 : Fin (a :: (u ++ [b])).length := ⟨k.val + 1, by have hlen : (a :: (u ++ [b])).length = u.length + 2 := by simp - rw [hlen]; omega⟩ - (k.val + 1 < (a :: (u ++ b :: v)).length) → ((a :: (u ++ [b])).get + rw [hlen]; omega⟩; + ((a :: (u ++ [b])).get ⟨(iA.val + 1) % (a :: (u ++ [b])).length, Nat.mod_lt _ (Nat.zero_lt_of_lt iA.isLt)⟩ = (a :: (u ++ [b])).get iA1) := by classical - intro n a b u v k hkA iA iA1 hk1Lt + intro n a b u v k hkA iA iA1 apply congrArg apply Fin.ext have hlen : (a :: (u ++ [b])).length = u.length + 2 := by simp @@ -979,7 +979,7 @@ private theorem leftBoundaryCase : rw [hnextIndex] _ = (a :: (u ++ [b])).get iA1 := by exact hAget k1 (by dsimp [k1]; omega) - have hchildNext := SavedDissectionProof.hchildNextAt805 n a b u v k hkA hk1Lt + have hchildNext := SavedDissectionProof.hchildNextAt805 n a b u v k hkA have hincA := (hgoodA hndA hcycA).2.2.2.2 iA rcases hincA with ⟨f, hfA, huniqA⟩ have hfAfirst : (a :: (u ++ [b])).get iA ∈ Set.range f := hfA.2.1 diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean b/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean index 0a77fd9a62..dc867ab9a4 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean @@ -316,27 +316,6 @@ private theorem hqinterior : dsimp [P] nlinarith [mul_pos ht0 hcoord2] -private theorem hqmargin : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : - Fin (n + (3 : ℕ))), ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (A.coord 0 (p.vertex - d) + A.coord 1 (p.vertex d) + A.coord 2 (p.vertex d) = 1) → ((E.height (p.vertex d) = - A.coord 1 (p.vertex d)) → ((0 < A.coord 0 (p.vertex d)) → ((0 < A.coord 2 (p.vertex - d)) → ( - let B := p.vertex E.b - let P := p.vertex d - let q : Real → Real × Real := AffineMap.lineMap B P - (∀ t, E.height (q t) = (1 - t) + t * E.height P) → (∀ t, 0 < t → t < 1 → E.height P < - E.height (q t)))))) ) := by - classical - intro n p E d A hsum hheightd hcoord0 hcoord2 B P q hqheight t ht0 ht1 - rw [hqheight] - have hprod : 0 < (1 - t) * (1 - E.height P) := - mul_pos (by linarith) (by linarith [hheightlt]) - nlinarith - private theorem hqleft : (by classical @@ -814,7 +793,15 @@ theorem P3650T1MaximalHeightDiagonal {n : Nat} (p : P3381T1PolygonBoundary n) have hqheight := MaximalHeightGeometry.hqheight n p E d A hheight hcoordB1 hqcoord have hqinterior := MaximalHeightGeometry.hqinterior n p E d A hint hcoord_nonneg hsum hcoord0 hcoord2 hcoordB0 hcoordB1 hcoordB2 hqcoord - have hqmargin := MaximalHeightGeometry.hqmargin n p E d A hsum hheightd hcoord0 hcoord2 hqheight + have hqmargin := (show + ∀ t, 0 < t → t < 1 → E.height P < E.height (q t) + from by + classical + intro t ht0 ht1 + rw [hqheight] + have hprod : 0 < (1 - t) * (1 - E.height P) := + mul_pos (by linarith) (by linarith [hheightlt]) + nlinarith) have hqleft := MaximalHeightGeometry.hqleft n p E d A hA0 hcoord2 hcoordB2 hqcoord have hqright := MaximalHeightGeometry.hqright n p E d A hA2 hcoord0 hcoordB0 hqcoord have hqclear := MaximalHeightGeometry.hqclear n p E hentry d hdmax A hcoord_nonneg hheightd diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean index 8d2fe3ce58..3be5a43287 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean @@ -2619,80 +2619,6 @@ end OldArcParityProof namespace OldArcAssembly -private theorem oldArcEvenOnPreconnected : - (by - classical - exact - ∀ {X : Type}, ∀ [inst : TopologicalSpace X], ∀ (O : Set X), ∀ (K : Set X), ∀ (S : Set X), - IsOpen O → closure O = O ∪ K → IsPreconnected S → Disjoint S K → ∀ x ∈ S, x ∉ O → - Disjoint S O ) := by - classical - intro X typeclassInstance0 O K S hO hclosure hS hSK x hx hxO - exact OldArcParityProof.oldArcEvenOnPreconnected (X := X) O - K S hO hclosure hS hSK x hx hxO - -private theorem oldArcOddOnPreconnected : - (by - classical - exact - (∀ {X : Type}, ∀ [inst : TopologicalSpace X], ∀ (O : Set X), ∀ (K : Set X), ∀ (S : Set - X), IsOpen O → closure O = O ∪ K → IsPreconnected S → Disjoint S K → ∀ x ∈ S, x ∉ O → - Disjoint S O) → (∀ {X : Type}, ∀ [inst : TopologicalSpace X], ∀ (O : Set X), ∀ (K : - Set X), ∀ (S : Set X), IsOpen O → closure O = O ∪ K → IsPreconnected S → Disjoint S K - → ∀ x ∈ S, x ∈ O → S ⊆ O) ) := by - classical - intro oldArcEvenOnPreconnected X typeclassInstance0 O K S hO hclosure hS hSK x hx hxO - exact OldArcParityProof.oldArcOddOnPreconnected - oldArcEvenOnPreconnected (X := X) O K S hO hclosure hS hSK x hx hxO - -private theorem oldArcEvenClosure : - (by - classical - exact - ∀ {X : Type}, ∀ [inst : TopologicalSpace X], ∀ (O : Set X), ∀ (S : Set X), IsOpen O → - Disjoint S O → Disjoint (closure S) O ) := by - classical - intro X typeclassInstance0 O S hO hSO - exact OldArcParityProof.oldArcEvenClosure - (X := X) O S hO hSO - -private theorem parityEvenAlongPath : - (by - classical - exact - (∀ {X : Type}, ∀ [inst : TopologicalSpace X], ∀ (O : Set X), ∀ (K : Set X), ∀ (S : Set - X), IsOpen O → closure O = O ∪ K → IsPreconnected S → Disjoint S K → ∀ x ∈ S, x ∉ O → - Disjoint S O) → (∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), ∀ (γ : Real → Real - × Real), (ContinuousOn γ (Set.Icc (0 : Real) 1)) → ((∀ t ∈ Set.Icc (0 : Real) 1, - γ t ∉ P3544T1BoundaryCarrier q) → ((γ 0 ∉ P3544T1RayParity q) → (∀ t ∈ Set.Icc (0 - : Real) 1, γ t ∉ P3544T1RayParity q)))) ) := by - classical - intro oldArcEvenOnPreconnected m q γ hcont havoid hstart - exact OldArcParityProof.parityEvenAlongPath oldArcEvenOnPreconnected (m := m) q γ hcont - havoid hstart - -private theorem upperHalfplaneEven : - (by - classical - exact - ∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), ∀ (ell : (Real × Real) →ₗ[Real] Real), ∀ - (H : Real), (∀ i, ell (q.vertex i) ≤ H) → (∀ (x : Real × Real), (H < ell x) → (x ∉ - P3544T1RayParity q)) ) := by - classical - intro m q ell H hbound x hx - exact OldArcParityProof.upperHalfplaneEven (m := m) q ell H hbound x hx - -private theorem middleNotSegment : - (by - classical - exact - ∀ {a : ℝ × ℝ}, ∀ {b : ℝ × ℝ}, ∀ {c : ℝ × ℝ}, P3381T1TriangleDeterminant ![a, b, c] ≠ (0 - : ℝ) → b ∉ segment ℝ a c ) := by - classical - intro a b c hdet - exact OldArcParityProof.middleNotSegment - (a := a) (b := b) (c := c) hdet - private theorem strictUpperHalfplaneEven : (by classical @@ -2706,20 +2632,6 @@ private theorem strictUpperHalfplaneEven : intro upperHalfplaneEven m q ell H hbound x hx exact upperHalfplaneEven q ell H (fun i => le_of_lt (hbound i)) x hx -private theorem rightPreviousParent : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : - P3650T1VisibleDiagonal p E), (P3650T1CyclicChildren p D.a D.b) → (∀ {m : Nat}, ∀ - (q : P3381T1PolygonBoundary m), ∀ (a : Fin (m + 3)), ∀ (b : Fin (m + - 3)), ∀ (K : P3650T1CyclicChildren q a b), (K.rotation % (m + 3) = a.val) → (K.ir - ⟨K.rightParameter + 1, by omega⟩ = a - 1))) := by - classical - intro n p E D C m q a b K hrot - exact OldArcParityProof.rightPreviousParent n p E D C - (m := m) q a b K hrot - private theorem hseedRAt3047 : (by classical @@ -2995,15 +2907,15 @@ theorem P3650T1OldArcEven {n : Nat} (p : P3381T1PolygonBoundary n) have oldArcEvenOnPreconnected {X : Type} [TopologicalSpace X] (O K S : Set X) (hO : IsOpen O) (hclosure : closure O = O ∪ K) (hS : IsPreconnected S) (hSK : Disjoint S K) - (x : X) (hx : x ∈ S) (hxO : x ∉ O) := OldArcAssembly.oldArcEvenOnPreconnected (X := X) O K + (x : X) (hx : x ∈ S) (hxO : x ∉ O) := OldArcParityProof.oldArcEvenOnPreconnected (X := X) O K S hO hclosure hS hSK x hx hxO have oldArcOddOnPreconnected {X : Type} [TopologicalSpace X] (O K S : Set X) (hO : IsOpen O) (hclosure : closure O = O ∪ K) (hS : IsPreconnected S) (hSK : Disjoint S K) - (x : X) (hx : x ∈ S) (hxO : x ∈ O) := OldArcAssembly.oldArcOddOnPreconnected + (x : X) (hx : x ∈ S) (hxO : x ∈ O) := OldArcParityProof.oldArcOddOnPreconnected oldArcEvenOnPreconnected (X := X) O K S hO hclosure hS hSK x hx hxO have oldArcEvenClosure {X : Type} [TopologicalSpace X] - (O S : Set X) (hO : IsOpen O) (hSO : Disjoint S O) := OldArcAssembly.oldArcEvenClosure (X + (O S : Set X) (hO : IsOpen O) (hSO : Disjoint S O) := OldArcParityProof.oldArcEvenClosure (X := X) O S hO hSO obtain ⟨leftArcPreconnected, rightArcPreconnected⟩ := P5667T1CyclicChildrenOldArcsPreconnected p D.a D.b C @@ -3021,17 +2933,17 @@ theorem P3650T1OldArcEven {n : Nat} (p : P3381T1PolygonBoundary n) (γ : Real → Real × Real) (hcont : ContinuousOn γ (Set.Icc (0 : Real) 1)) (havoid : ∀ t ∈ Set.Icc (0 : Real) 1, γ t ∉ P3544T1BoundaryCarrier q) - (hstart : γ 0 ∉ P3544T1RayParity q) := OldArcAssembly.parityEvenAlongPath + (hstart : γ 0 ∉ P3544T1RayParity q) := OldArcParityProof.parityEvenAlongPath oldArcEvenOnPreconnected (m := m) q γ hcont havoid hstart have upperHalfplaneEven {m : Nat} (q : P3381T1PolygonBoundary m) (ell : (Real × Real) →ₗ[Real] Real) (H : Real) (hbound : ∀ i, ell (q.vertex i) ≤ H) - (x : Real × Real) (hx : H < ell x) := OldArcAssembly.upperHalfplaneEven (m := m) q ell H + (x : Real × Real) (hx : H < ell x) := OldArcParityProof.upperHalfplaneEven (m := m) q ell H hbound x hx have triangleHull {m : Nat} (q : P3381T1PolygonBoundary m) (hm : m = 0) := OldArcParityProof.triangleHull (m := m) q hm have middleNotSegment {a b c : Real × Real} - (hdet : P3381T1TriangleDeterminant ![a, b, c] ≠ 0) := OldArcAssembly.middleNotSegment (a + (hdet : P3381T1TriangleDeterminant ![a, b, c] ≠ 0) := OldArcParityProof.middleNotSegment (a := a) (b := b) (c := c) hdet have prevIndexNe {m : Nat} (i : Fin (m + 3)) := OldArcParityProof.prevIndexNe n p E D C (m := m) i have nextIndexNe {m : Nat} (i : Fin (m + 3)) := OldArcParityProof.nextIndexNe n p E D C (m := m) i @@ -3045,7 +2957,7 @@ theorem P3650T1OldArcEven {n : Nat} (p : P3381T1PolygonBoundary n) have rightPreviousParent {m : Nat} (q : P3381T1PolygonBoundary m) (a b : Fin (m + 3)) (K : P3650T1CyclicChildren q a b) (hrot : K.rotation % (m + 3) = a.val) : - K.ir ⟨K.rightParameter + 1, by omega⟩ = a - 1 := OldArcAssembly.rightPreviousParent n p E D + K.ir ⟨K.rightParameter + 1, by omega⟩ = a - 1 := OldArcParityProof.rightPreviousParent n p E D C (m := m) q a b K hrot rcases D.route with hbase | htop diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean index c1da3bcd12..90912bba05 100644 --- a/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean @@ -2031,40 +2031,6 @@ end IndexedFaceLedgerProof namespace IndexedLedgerAssembly -private theorem hcross : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL - : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection - S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), ∀ (i : Fin L.count), ∀ (j : - Fin R.count), Set.range (S.il ∘ L.face i) ≠ Set.range (S.ir ∘ R.face j) ) := by - classical - intro n p S XL XR L R i j - exact IndexedFaceLedgerProof.hcrossAt176 n p S XL XR L R i j - -private theorem hblock : - (by - classical - exact - ∀ {l : ℕ}, ∀ {r : ℕ}, ∀ (P : Fin l → Prop), ∀ (Q : Fin r → Prop), {k : Fin (l + r) | - Fin.addCases P Q k}.ncard = {i : Fin l | P i}.ncard + {j : Fin r | Q j}.ncard ) := by - classical - intro l r P Q - exact IndexedFaceLedgerProof.hblock (l := l) (r := r) P Q - -private theorem hmodShift : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), (P3544T1DiagonalSplit p) → (∀ {m : ℕ}, - ∀ {r : ℕ}, ∀ {x : ℕ}, ∀ {y : ℕ}, (0 : ℕ) < m → x < m → y < m → (r + x) % m = (r + y) - % m → x = y) ) := by - classical - intro n p S m r x y hm hx hy he - exact IndexedFaceLedgerProof.hmodShift n p S (m := m) (r := - r) (x := x) (y := y) hm hx hy he - private theorem hleftOrd : (by classical @@ -2156,49 +2122,6 @@ private theorem hrightCountMapped : (IndexedFaceLedgerProof.hrightUsedMap n p S XR R (IndexedFaceLedgerProof.hrightFaceMem n p S XR R)) i j hi hj hij -private theorem hleftZeroPair : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL - : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), ∀ (i : Fin (n + (3 - : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ¬(i ∈ Set.range S.il ∧ j ∈ Set.range S.il) → {k : - Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face - k)}.ncard = (0 : ℕ) ) := by - classical - intro n p S XL L i j hno - exact IndexedFaceLedgerProof.hleftZeroPair n p S XL L i j hno - -private theorem hrightZeroPair : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR - : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), ∀ (i : Fin (n + - (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ¬(i ∈ Set.range S.ir ∧ j ∈ Set.range S.ir) → {k - : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face - k)}.ncard = (0 : ℕ) ) := by - classical - intro n p S XR R i j hno - exact IndexedFaceLedgerProof.hrightZeroPair n p S XR R i j hno - -private theorem hnotDiagBoundary : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), (S.il - (0 : Fin (S.leftParameter + (3 : ℕ))) = S.a) → ((S.il (Fin.last (S.leftParameter + (2 - : ℕ))) = S.b) - → ((∀ (x : Fin (S.leftParameter + (3 : ℕ))), ∀ (y : Fin (S.leftParameter + (3 : ℕ))), - S.il y = S.il - x + (1 : Fin (n + (3 : ℕ))) ∨ S.il x = S.il y + (1 : Fin (n + (3 : ℕ))) ↔ (↑y : ℕ) = - (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : ℕ) + (1 : ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ - (j : Fin (n + (3 : ℕ))), i = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b → ¬(j = i + (1 : Fin - (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))))))) ) := by - classical - intro n p S hleftA hleftB hleftOrd i j hdiag - exact IndexedFaceLedgerProof.hnotDiagBoundary n p S hleftA hleftB hleftOrd i j hdiag - private theorem hcoverPair : (by classical @@ -2229,233 +2152,6 @@ private theorem hcoverPair : hlenL hlenR hleftcoord hrightcoord hmodShift hmodSucc hleftA hleftB hrightB hrightA hparentSuccVal)) i j hboundary -private theorem hcountLAt2222 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL - : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (i : Fin (n + - (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.il → j ∈ Set.range S.il → i ≠ j - → {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face - k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i - = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin L.count), i ∈ - Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k) then (2 : ℕ) else (0 : - ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((j = i + (1 : - Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ)))) → ((i ∈ Set.range S.il) → ((j ∈ - Set.range S.il) → (Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ - Set.range (S.il ∘ L.face k)} = 1))))) ) := by - classical - intro n p S XL L hleftCountMapped i j hij hboundary hiL hjL - exact IndexedFaceLedgerProof.hcountLAt1167 n p S XL L hleftCountMapped i j hij - hboundary hiL hjL - -private theorem hcountRAt2231 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR - : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (∀ (i : Fin (n + - (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.ir → j ∈ Set.range S.ir → i ≠ j - → {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face - k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i - = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin R.count), i ∈ - Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k) then (2 : ℕ) else (0 : - ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((j = i + (1 : - Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ)))) → ((i ∈ Set.range S.ir) → ((j ∈ - Set.range S.ir) → (Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ - Set.range (S.ir ∘ R.face k)} = 1))))) ) := by - classical - intro n p S XR R hrightCountMapped i j hij hboundary hiR hjR - exact IndexedFaceLedgerProof.hcountRAt1188 n p S XR R hrightCountMapped i j hij - hboundary hiR hjR - -private theorem hcountLAt2242 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL - : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (i : Fin (n + - (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.il → j ∈ Set.range S.il → i ≠ j - → {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face - k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i - = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin L.count), i ∈ - Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k) then (2 : ℕ) else (0 : - ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((i = S.a ∧ j - = S.b ∨ j = S.a ∧ i = S.b) → ((i ∈ Set.range S.il) → ((j ∈ Set.range S.il) → - (Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ - L.face k)} = 1))))) ) := by - classical - intro n p S XL L hleftCountMapped i j hij hdiag hiL hjL - exact IndexedFaceLedgerProof.hcountLAt1209 n p S XL L hleftCountMapped i j hij hdiag - hiL hjL - -private theorem hcountRAt2246 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR - : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (∀ (i : Fin (n + - (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.ir → j ∈ Set.range S.ir → i ≠ j - → {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face - k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i - = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin R.count), i ∈ - Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k) then (2 : ℕ) else (0 : - ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((i = S.a ∧ j - = S.b ∨ j = S.a ∧ i = S.b) → ((i ∈ Set.range S.ir) → ((j ∈ Set.range S.ir) → - (Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ - R.face k)} = 1))))) ) := by - classical - intro n p S XR R hrightCountMapped i j hij hdiag hiR hjR - exact IndexedFaceLedgerProof.hcountRAt1219 n p S XR R hrightCountMapped i j hij hdiag - hiR hjR - -private theorem hcount : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL - : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection - S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), - let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := - Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) - ∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ({k : Fin (L.count + R.count) | i ∈ - Set.range ((fun (i : Fin (L.count + R.count)) => Fin.addCases (motive := fun (_ : Fin - (L.count + R.count)) => Fin (3 : ℕ) → Fin (n + (3 : ℕ))) (fun (k : Fin L.count) => - S.il ∘ L.face k) (fun (k : Fin R.count) => S.ir ∘ R.face k) i) k) ∧ j ∈ Set.range - ((fun (i : Fin (L.count + R.count)) => Fin.addCases (motive := fun (_ : Fin (L.count - + R.count)) => Fin (3 : ℕ) → Fin (n + (3 : ℕ))) (fun (k : Fin L.count) => S.il ∘ - L.face k) (fun (k : Fin R.count) => S.ir ∘ R.face k) i) k)}.ncard = {k : Fin L.count - | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)}.ncard + {k : Fin - R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)}.ncard) → - ((Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il - ∘ L.face k)} = 1) → ((Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ - j ∈ Set.range (S.ir ∘ R.face k)} = 1) → (Set.ncard {k : Fin (L.count + R.count) | i ∈ - Set.range (f k) ∧ j ∈ Set.range (f k)} = 2)))) := by - classical - intro n p S XL XR L R f i j htotal hcountL hcountR - exact IndexedFaceLedgerProof.hcountAt1229 - n p S XL XR L R i j htotal hcountL hcountR - -private theorem hused : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL - : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection - S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), - let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := - Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) - ∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (Set.ncard {k : Fin (L.count + - R.count) | i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)} = 2) → (∃ k : Fin (L.count + - R.count), i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)) ) := by - classical - intro n p S XL XR L R f i j hcount - exact IndexedFaceLedgerProof.hused n p S XL XR - L R i j hcount - -private theorem hNoSpecial : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (i : - Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (¬(j = i + (1 : Fin (n + (3 : ℕ))) ∨ i - = j + (1 : Fin (n + (3 : ℕ))))) → ((¬(i = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b)) → (¬ (j - = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b)))) ) := by - classical - intro n p S i j hboundary hdiag - exact IndexedFaceLedgerProof.hNoSpecial n p S i j hboundary hdiag - -private theorem hcountLAt2267 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL - : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (i : Fin (n + - (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.il → j ∈ Set.range S.il → i ≠ j - → {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face - k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i - = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin L.count), i ∈ - Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k) then (2 : ℕ) else (0 : - ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((¬ (j = i + 1 - ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b))) → (∀ (k : Fin L.count), (i - ∈ Set.range (S.il ∘ L.face k)) → ((j ∈ Set.range (S.il ∘ L.face k)) → ((i ∈ Set.range - S.il) → ((j ∈ Set.range S.il) → (Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ - L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = 2))))))) ) := by - classical - intro n p S XL L hleftCountMapped i j hij hNoSpecial k hik hjk hiL hjL - exact IndexedFaceLedgerProof.hcountLAt1267 n p S XL L hleftCountMapped i j hij - hNoSpecial k hik hjk hiL hjL - -private theorem hcountRAt2278 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR - : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), (∀ (i : Fin (n + - (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.ir → j ∈ Set.range S.ir → i ≠ j - → {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face - k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i - = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin R.count), i ∈ - Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k) then (2 : ℕ) else (0 : - ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ((¬ (j = i + 1 - ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b))) → (∀ (k : Fin R.count), (i - ∈ Set.range (S.ir ∘ R.face k)) → ((j ∈ Set.range (S.ir ∘ R.face k)) → ((i ∈ Set.range - S.ir) → ((j ∈ Set.range S.ir) → (Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ - R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = 2))))))) ) := by - classical - intro n p S XR R hrightCountMapped i j hij hNoSpecial k hik hjk hiR hjR - exact IndexedFaceLedgerProof.hcountRAt1293 n p S XR R hrightCountMapped i j hij - hNoSpecial k hik hjk hiR hjR - -private theorem hnoUsedL : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL - : Set (Real × Real)), ∀ (XR : Set (Real × Real)), ∀ (L : P3511T1SourceDissection - S.left XL), ∀ (R : P3511T1SourceDissection S.right XR), - let f : Fin (L.count + R.count) → Fin 3 → Fin (n + 3) := - Fin.addCases (fun k => S.il ∘ L.face k) (fun k => S.ir ∘ R.face k) - (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (∃ (k : Fin (L.count + R.count)), - i ∈ Set.range ((fun (i : Fin (L.count + R.count)) => Fin.addCases (motive := fun (_ : - Fin (L.count + R.count)) => Fin (3 : ℕ) → Fin (n + (3 : ℕ))) (fun (k : Fin L.count) - => S.il ∘ L.face k) (fun (k : Fin R.count) => S.ir ∘ R.face k) i) k) ∧ j ∈ Set.range - ((fun (i : Fin (L.count + R.count)) => Fin.addCases (motive := fun (_ : Fin (L.count - + R.count)) => Fin (3 : ℕ) → Fin (n + (3 : ℕ))) (fun (k : Fin L.count) => S.il ∘ - L.face k) (fun (k : Fin R.count) => S.ir ∘ R.face k) i) k)) ↔ (∃ (k : Fin L.count), i - ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)) ∨ ∃ (k : Fin - R.count), i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)) → (∀ (i - : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (¬∃ (k : Fin (L.count + - R.count)), i - ∈ Set.range (f k) ∧ j ∈ Set.range (f k)) → (¬ ∃ k : Fin L.count, i ∈ Set.range (S.il - ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)))) := by - classical - intro n p S XL XR L R f husedSplit i j hused - exact IndexedFaceLedgerProof.hnoUsedL n p S XL XR L R husedSplit i j hused - -private theorem hcountLAt2288 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL - : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), (∀ (i : Fin (n + - (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∈ Set.range S.il → j ∈ Set.range S.il → i ≠ j - → {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face - k)}.ncard = if j = i + (1 : Fin (n + (3 : ℕ))) ∨ i = j + (1 : Fin (n + (3 : ℕ))) ∨ i - = S.a ∧ j = S.b ∨ j = S.a ∧ i = S.b then (1 : ℕ) else if ∃ (k : Fin L.count), i ∈ - Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k) then (2 : ℕ) else (0 : - ℕ)) → ((∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ¬(i ∈ Set.range S.il ∧ - j ∈ Set.range S.il) → {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ - Set.range (S.il ∘ L.face k)}.ncard = (0 : ℕ)) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : - Fin (n + (3 : ℕ))), (i ≠ j) → ((¬ (j = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = - S.a ∧ i = S.b))) → ((¬ ∃ k : Fin L.count, i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ - Set.range (S.il ∘ L.face k)) → (Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ - L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = 0))))) ) := by - classical - intro n p S XL L hleftCountMapped hleftZeroPair i j hij hNoSpecial hnoUsedL - exact IndexedFaceLedgerProof.hcountLAt1312 n p S XL L hleftCountMapped hleftZeroPair - i j hij hNoSpecial hnoUsedL - private theorem hcountRAt2292 : (by classical @@ -2492,20 +2188,6 @@ private theorem hcountRAt2292 : hrightZeroPair i j hij hNoSpecial (IndexedFaceLedgerProof.hnoUsedR n p S XL XR L R husedSplit i j hused) -private theorem hdiag : - (by - classical - exact - ∀ (n : Nat), ∀ {m : ℕ}, ∀ {q : P3381T1PolygonBoundary m}, ∀ {X : Set (ℝ × ℝ)}, ∀ (D : - P3511T1SourceDissection q X), ∀ (e : Fin (m + (3 : ℕ)) → Fin (n + (3 : ℕ))), ∀ (a : - Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : ℕ)))), - List.ofFn e = a :: (u ++ [b]) → ∃ (k : Fin D.count), a ∈ Set.range (e ∘ D.face k) ∧ b - ∈ Set.range (e ∘ D.face k) ) := by - classical - intro n m q X D e a b u horder - exact IndexedFaceLedgerProof.hdiag n (m := m) (q := - q) (X := X) D e a b u horder - end IndexedLedgerAssembly theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} @@ -2539,7 +2221,8 @@ theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} (IndexedFaceLedgerProof.hmap)), (IndexedFaceLedgerProof.hinjective n p S XL XR L R), ?_, ?_, (IndexedFaceLedgerProof.hnondegenerate n p S XL XR L R), ?_, ?_, ?_⟩ · have hcross (i : Fin L.count) (j : Fin R.count) : - Set.range (S.il ∘ L.face i) ≠ Set.range (S.ir ∘ R.face j) := IndexedLedgerAssembly.hcross + Set.range (S.il ∘ L.face i) ≠ Set.range (S.ir ∘ R.face j) := + IndexedFaceLedgerProof.hcrossAt176 n p S XL XR L R i j intro k l refine Fin.addCases (fun i => ?_) (fun j => ?_) k @@ -2578,7 +2261,7 @@ theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} · have hblock {l r : Nat} (P : Fin l → Prop) (Q : Fin r → Prop) : Set.ncard {k : Fin (l + r) | Fin.addCases P Q k} = Set.ncard {i : Fin l | P i} + Set.ncard {j : Fin r | Q j} := - IndexedLedgerAssembly.hblock (l := l) (r := r) P Q + IndexedFaceLedgerProof.hblock (l := l) (r := r) P Q have hlenP := IndexedFaceLedgerProof.hlenP n p S have hlenL := IndexedFaceLedgerProof.hlenL n p S have hlenR := IndexedFaceLedgerProof.hlenR n p S @@ -2589,7 +2272,7 @@ theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} hlenP hlenL hlenR haCoord y have hmodShift {m r x y : Nat} (hm : 0 < m) (hx : x < m) (hy : y < m) - (he : (r + x) % m = (r + y) % m) := IndexedLedgerAssembly.hmodShift n p S (m := m) (r := + (he : (r + x) % m = (r + y) % m) := IndexedFaceLedgerProof.hmodShift n p S (m := m) (r := r) (x := x) (y := y) hm hx hy he have hmodSucc {m r x : Nat} (hm : 1 < m) := IndexedFaceLedgerProof.hmodSucc (m := m) (r := r) (x := x) hm @@ -2620,13 +2303,13 @@ theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} hmodShift hmodSucc hfinAdj hrightB hrightA hparentSuccVal i j hi hj hij have hleftZeroPair (i j : Fin (n + 3)) (hno : ¬ (i ∈ Set.range S.il ∧ j ∈ Set.range S.il)) := - IndexedLedgerAssembly.hleftZeroPair n p S XL L i j hno + IndexedFaceLedgerProof.hleftZeroPair n p S XL L i j hno have hrightZeroPair (i j : Fin (n + 3)) (hno : ¬ (i ∈ Set.range S.ir ∧ j ∈ Set.range S.ir)) := - IndexedLedgerAssembly.hrightZeroPair n p S XR R i j hno + IndexedFaceLedgerProof.hrightZeroPair n p S XR R i j hno have hnotDiagBoundary (i j : Fin (n + 3)) (hdiag : (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b)) := - IndexedLedgerAssembly.hnotDiagBoundary n p S hleftA hleftB hleftOrd i j hdiag + IndexedFaceLedgerProof.hnotDiagBoundary n p S hleftA hleftB hleftOrd i j hdiag intro i j hij have htotal := (IndexedFaceLedgerProof.hblockCount n p S XL XR L R hblock) i j by_cases hboundary : j = i + 1 ∨ i = j + 1 @@ -2638,7 +2321,7 @@ theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} IndexedFaceLedgerProof.hnoRAt1159 n p S hdiagPair i j hij hnotDiag hiL hjL have hcountL : Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = 1 := - IndexedLedgerAssembly.hcountLAt2222 n p S XL L hleftCountMapped i j hij hboundary + IndexedFaceLedgerProof.hcountLAt1167 n p S XL L hleftCountMapped i j hij hboundary hiL hjL have hcountR := hrightZeroPair i j hnoR rw [htotal, hcountL, hcountR] @@ -2647,7 +2330,7 @@ theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} IndexedFaceLedgerProof.hnoLAt1180 n p S hdiagPair i j hij hnotDiag hiR hjR have hcountR : Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = 1 := - IndexedLedgerAssembly.hcountRAt2231 n p S XR R hrightCountMapped i j hij + IndexedFaceLedgerProof.hcountRAt1188 n p S XR R hrightCountMapped i j hij hboundary hiR hjR have hcountL := hleftZeroPair i j hnoL rw [htotal, hcountL, hcountR] @@ -2658,22 +2341,23 @@ theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} rcases hcommon with ⟨hiL, hiR, hjL, hjR⟩ have hcountL : Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = 1 := - IndexedLedgerAssembly.hcountLAt2242 n p S XL L hleftCountMapped i j hij hdiag hiL + IndexedFaceLedgerProof.hcountLAt1209 n p S XL L hleftCountMapped i j hij hdiag hiL hjL have hcountR : Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = 1 := - IndexedLedgerAssembly.hcountRAt2246 n p S XR R hrightCountMapped i j hij hdiag + IndexedFaceLedgerProof.hcountRAt1219 n p S XR R hrightCountMapped i j hij hdiag hiR hjR have hcount : Set.ncard {k : Fin (L.count + R.count) | - i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)} = 2 := IndexedLedgerAssembly.hcount n p S + i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)} = 2 := + IndexedFaceLedgerProof.hcountAt1229 n p S XL XR L R i j htotal hcountL hcountR have hused : ∃ k : Fin (L.count + R.count), - i ∈ Set.range (f k) ∧ j ∈ Set.range (f k) := IndexedLedgerAssembly.hused n p S XL XR + i ∈ Set.range (f k) ∧ j ∈ Set.range (f k) := IndexedFaceLedgerProof.hused n p S XL XR L R i j hcount rw [hcount, ite_eq_right hnotBoundary, ite_eq_left hused] · have hNoSpecial : ¬ (j = i + 1 ∨ i = j + 1 ∨ (i = S.a ∧ j = S.b) ∨ (j = S.a ∧ i = S.b)) := - IndexedLedgerAssembly.hNoSpecial n p S i j hboundary hdiag + IndexedFaceLedgerProof.hNoSpecial n p S i j hboundary hdiag by_cases hused : ∃ k : Fin (L.count + R.count), i ∈ Set.range (f k) ∧ j ∈ Set.range (f k) · rcases (husedSplit i j).1 hused with husedL | husedR @@ -2683,7 +2367,7 @@ theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} have hnoR := IndexedFaceLedgerProof.hnoRAt1259 n p S hdiagPair i j hij hdiag hiL hjL have hcountL : Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = 2 := - IndexedLedgerAssembly.hcountLAt2267 n p S XL L hleftCountMapped i j hij + IndexedFaceLedgerProof.hcountLAt1267 n p S XL L hleftCountMapped i j hij hNoSpecial k hik hjk hiL hjL have hcountR := hrightZeroPair i j hnoR rw [htotal, hcountL, hcountR] @@ -2694,17 +2378,17 @@ theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} have hnoL := IndexedFaceLedgerProof.hnoLAt1285 n p S hdiagPair i j hij hdiag hiR hjR have hcountR : Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = 2 := - IndexedLedgerAssembly.hcountRAt2278 n p S XR R hrightCountMapped i j hij + IndexedFaceLedgerProof.hcountRAt1293 n p S XR R hrightCountMapped i j hij hNoSpecial k hik hjk hiR hjR have hcountL := hleftZeroPair i j hnoL rw [htotal, hcountL, hcountR] rw [ite_eq_right hboundary, ite_eq_left hused] · have hnoUsedL : ¬ ∃ k : Fin L.count, i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k) := - IndexedLedgerAssembly.hnoUsedL n p S XL XR L R husedSplit i j hused + IndexedFaceLedgerProof.hnoUsedL n p S XL XR L R husedSplit i j hused have hcountL : Set.ncard {k : Fin L.count | i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = 0 := - IndexedLedgerAssembly.hcountLAt2288 n p S XL L hleftCountMapped hleftZeroPair i + IndexedFaceLedgerProof.hcountLAt1312 n p S XL L hleftCountMapped hleftZeroPair i j hij hNoSpecial hnoUsedL have hcountR : Set.ncard {k : Fin R.count | i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = 0 := @@ -2716,7 +2400,7 @@ theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} have hdiag {m : Nat} {q : P3381T1PolygonBoundary m} {X : Set (Real × Real)} (D : P3511T1SourceDissection q X) (e : Fin (m + 3) → Fin (n + 3)) (a b : Fin (n + 3)) (u : List (Fin (n + 3))) - (horder : List.ofFn e = a :: (u ++ [b])) := IndexedLedgerAssembly.hdiag n (m := m) (q := + (horder : List.ofFn e = a :: (u ++ [b])) := IndexedFaceLedgerProof.hdiag n (m := m) (q := q) (X := X) D e a b u horder · exact hdiag L S.il S.a S.b S.u S.left_order · obtain ⟨k, hb, ha⟩ := hdiag R S.ir S.b S.a S.v S.right_order diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean index a4c03f7b8b..3eb8547750 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean @@ -645,18 +645,18 @@ private theorem hendba : ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists; ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), + ( let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := if hab : P3723T1EdgeContact P a b then localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + GaussianRealPoint (period a) - else D.position a + else D.position a; (∀ a, ∀ b, P3723T1EdgeContact P a b → Continuous (g a b) ∧ Function.Injective (g a b) ∧ g a b ⟨0, by norm_num⟩ = D.position a ∧ @@ -666,7 +666,7 @@ private theorem hendba : {g a b ⟨1, by norm_num⟩}) → ((P3723T1EdgeContact P b a) → (∀ (p : ℝ × ℝ), (D.port b a = some p) → (g b a ⟨1, by norm_num⟩ = p))))) := by classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g gproperties hba p hpba + intro ι P D a b localStar rep rep_spec period pulled_contact g gproperties hba p hpba have h₁ := (gproperties b a hba).2.2.2.1 exact Option.some.inj (h₁.symm.trans hpba) @@ -921,31 +921,30 @@ private theorem right_eval : ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists; ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := if hab : P3723T1EdgeContact P a b then localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + GaussianRealPoint (period a) - else D.position a + else D.position a; ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count + let m := polyab.count; + let n := polyba.count; let tm : Fin (m + n + 1) → Real := fun i => if hi : i.val ≤ m then polyab.time ⟨i.val, by omega⟩ / 2 else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; ∀ (j : Fin n), tm ⟨m + 1 + j.val, by omega⟩ = 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2 ) := by classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n tm j + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n tm j have hnot : ¬ m + 1 + j.val ≤ m := by omega simp only [tm, dite_eq_right hnot] have hj : (⟨n + m - (m + 1 + j.val), by omega⟩ : Fin (n + 1)) = @@ -1726,20 +1725,21 @@ private theorem hstartAt1216 : exact ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), (∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P a b ↔ P3723T1EdgeContact - P b a) → (∀ (a : ι), ∀ (b : ι), ∀ (localStar : (a : ι) → + P b a) → ( + ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists; ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), + ( let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := if hab : P3723T1EdgeContact P a b then localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + GaussianRealPoint (period a) - else D.position a + else D.position a; (∀ a, ∀ b, P3723T1EdgeContact P a b → Continuous (g a b) ∧ Function.Injective (g a b) ∧ g a b ⟨0, by norm_num⟩ = D.position a ∧ @@ -1748,12 +1748,12 @@ private theorem hstartAt1216 : Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ {g a b ⟨1, by norm_num⟩}) → ( let halfArc (a b : ι) : Set (Real × Real) := - if P3723T1EdgeContact P a b then Set.range (g a b) else ∅ - let edgeArc (a b : ι) : Set (Real × Real) := halfArc a b ∪ halfArc b a + if P3723T1EdgeContact P a b then Set.range (g a b) else ∅; + let edgeArc (a b : ι) : Set (Real × Real) := halfArc a b ∪ halfArc b a; ∀ (x : ι), ∀ (y : ι), (P3723T1EdgeContact P x y) → (D.position x ∈ edgeArc x y))))) := by classical - intro ι P D symmetric a b localStar rep rep_spec period pulled_contact hab g gproperties - halfArc edgeArc x y hxy + intro ι P D symmetric localStar rep rep_spec period pulled_contact g gproperties halfArc + edgeArc x y hxy have hrev := (symmetric x y).mp hxy simp only [edgeArc, halfArc, ite_eq_left hxy, ite_eq_left hrev] left @@ -1765,20 +1765,21 @@ private theorem hendAt1222 : exact ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), (∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P a b ↔ P3723T1EdgeContact - P b a) → (∀ (a : ι), ∀ (b : ι), ∀ (localStar : (a : ι) → + P b a) → ( + ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists + let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists; ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( + (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), + ( let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := if hab : P3723T1EdgeContact P a b then localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + GaussianRealPoint (period a) - else D.position a + else D.position a; (∀ a, ∀ b, P3723T1EdgeContact P a b → Continuous (g a b) ∧ Function.Injective (g a b) ∧ g a b ⟨0, by norm_num⟩ = D.position a ∧ @@ -1787,12 +1788,12 @@ private theorem hendAt1222 : Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ {g a b ⟨1, by norm_num⟩}) → ( let halfArc (a b : ι) : Set (Real × Real) := - if P3723T1EdgeContact P a b then Set.range (g a b) else ∅ - let edgeArc (a b : ι) : Set (Real × Real) := halfArc a b ∪ halfArc b a + if P3723T1EdgeContact P a b then Set.range (g a b) else ∅; + let edgeArc (a b : ι) : Set (Real × Real) := halfArc a b ∪ halfArc b a; ∀ (x : ι), ∀ (y : ι), (P3723T1EdgeContact P x y) → (D.position y ∈ edgeArc x y))))) := by classical - intro ι P D symmetric a b localStar rep rep_spec period pulled_contact hab g gproperties - halfArc edgeArc x y hxy + intro ι P D symmetric localStar rep rep_spec period pulled_contact g gproperties halfArc + edgeArc x y hxy have hrev := (symmetric x y).mp hxy simp only [edgeArc, halfArc, ite_eq_left hxy, ite_eq_left hrev] right @@ -2184,7 +2185,7 @@ private theorem hpoly : have hj : (⟨j.val, by omega⟩ : Fin (m + 1)) = j := Fin.ext rfl exact congrArg (fun k : Fin (m + 1) => polyab.time k / 2) hj) have right_eval (j : Fin n) := ContactDrawingGeometry.right_eval ι P D a b localStar - rep_spec pulled_contact hab polyab polyba j + rep_spec pulled_contact polyab polyba j have htm_strict := ContactDrawingGeometry.htm_strict ι P D a b localStar rep_spec pulled_contact hab polyab polyba hnpos left_eval right_eval have htm_start : tm 0 = 0 := by @@ -2430,7 +2431,7 @@ private theorem full_parameters : have hpba : D.port b a = some p := by rw [D.port_symmetric, hp] have hendab := ContactDrawingGeometry.hendab ι P D a b localStar rep_spec pulled_contact hab gproperties p hp - have hendba := ContactDrawingGeometry.hendba ι P D a b localStar rep_spec pulled_contact hab + have hendba := ContactDrawingGeometry.hendba ι P D a b localStar rep_spec pulled_contact gproperties hba p hpba have hcross := ContactDrawingGeometry.hcross ι P D a b localStar rep_spec pulled_contact hab hsab hsba p hendab hendba @@ -2558,11 +2559,11 @@ private theorem drawingCertificate : b localStar rep_spec pulled_contact hab gintersections half_disjoint x y u v hxy huv hxyuv have hstart (x y : ι) (hxy : P3723T1EdgeContact P x y) : - D.position x ∈ edgeArc x y := ContactDrawingGeometry.hstartAt1216 ι P D symmetric a b - localStar rep_spec pulled_contact hab gproperties x y hxy + D.position x ∈ edgeArc x y := ContactDrawingGeometry.hstartAt1216 ι P D symmetric + localStar rep_spec pulled_contact gproperties x y hxy have hend (x y : ι) (hxy : P3723T1EdgeContact P x y) : - D.position y ∈ edgeArc x y := ContactDrawingGeometry.hendAt1222 ι P D symmetric a b - localStar rep_spec pulled_contact hab gproperties x y hxy + D.position y ∈ edgeArc x y := ContactDrawingGeometry.hendAt1222 ι P D symmetric + localStar rep_spec pulled_contact gproperties x y hxy have vertex_mem (x y i : ι) (hxy : P3723T1EdgeContact P x y) (hi : i = x ∨ i = y) := ContactDrawingGeometry.vertex_mem ι P D localStar rep_spec pulled_contact hstart hend x y i hxy hi diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean index cdf135978d..7f0bcb1a94 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean @@ -1058,553 +1058,6 @@ private theorem hac : end ContactPortGeometry -namespace ContactPortClosure - -private theorem owner_unique : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), ∀ z ∈ (P.tile - a).cells, z ∈ (P.tile b).cells → a = b ) := by - classical - intro ι P a b z ha hb - exact ContactPortGeometry.owner_unique - ι P a b z ha hb - -private theorem coord_unique : - (by - classical - exact - ∀ (m : ℤ), ∀ (n : ℤ), ∀ (t : ℝ), (↑m : ℝ) < t ∧ t < (↑m : ℝ) + (1 : ℝ) → (↑n : ℝ) ≤ t ∧ t - ≤ (↑n : ℝ) + (1 : ℝ) → m = n ) := by - classical - intro m n t hm hn - exact ContactPortGeometry.coord_unique m n t hm hn - -private theorem square_unique : - (by - classical - exact - let openSquare (z : GaussianInt) : Set (Real × Real) := - Set.Ioo (z.re : Real) ((z.re : Real) + 1) ×ˢ - Set.Ioo (z.im : Real) ((z.im : Real) + 1) - (∀ (m : ℤ), ∀ (n : ℤ), ∀ (t : ℝ), (↑m : ℝ) < t ∧ t < (↑m : ℝ) + (1 : ℝ) → (↑n : ℝ) ≤ t ∧ - t ≤ (↑n : ℝ) + (1 : ℝ) → m = n) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ p ∈ - openSquare x, p ∈ ClosedSquareRealization y → x = y) ) := by - classical - intro openSquare coord_unique x y p hx hy - exact ContactPortGeometry.square_unique coord_unique x y p hx hy - -private theorem midpoint_cell : - (by - classical - exact - (∀ (z : GaussianInt), (fun (e : Finset GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), - (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) {z, z + (1 : GaussianInt)} = ((↑z.re : ℝ) + (1 / 2 - : ℝ), (↑z.im : ℝ))) → ((∀ (z : GaussianInt), (fun (e : Finset GaussianInt) => ((∑ z ∈ - e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) {z, z + (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt)} = ((↑z.re : ℝ), (↑z.im : ℝ) + (1 / 2 : ℝ))) → (∀ (T : - ProtoTile), ∀ e ∈ FootprintEdges T, ∃ z ∈ T.cells, (fun (e : Finset GaussianInt) => - ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) e ∈ - ClosedSquareRealization z)) ) := by - classical - intro horizontal_midpoint vertical_midpoint T e he - exact ContactPortGeometry.midpoint_cell horizontal_midpoint - vertical_midpoint T e he - -private theorem midpoint_two_cells : - (by - classical - exact - (∀ (m : ℤ), ∀ (n : ℤ), ∀ (t : ℝ), (↑m : ℝ) < t ∧ t < (↑m : ℝ) + (1 : ℝ) → (↑n : ℝ) ≤ t ∧ - t ≤ (↑n : ℝ) + (1 : ℝ) → m = n) → ((∀ (z : GaussianInt), (fun (e : Finset - GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) - {z, z + (1 : GaussianInt)} = ((↑z.re : ℝ) + (1 / 2 : ℝ), (↑z.im : ℝ))) → ((∀ (z : - GaussianInt), (fun (e : Finset GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ - z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) {z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} = ((↑z.re - : ℝ), (↑z.im : ℝ) + (1 / 2 : ℝ))) → ((∀ (T : ProtoTile), ∀ e ∈ FootprintEdges T, ∃ (z - : GaussianInt), e = {z, z + (1 : GaussianInt)} ∨ e = {z, z + (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt)}) → (∀ (T : ProtoTile), ∀ e ∈ FootprintEdges T, ∃ (x : - GaussianInt) (y : GaussianInt), x ≠ y ∧ ∀ (z : LatticeCell), (fun (e : Finset - GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) - e ∈ ClosedSquareRealization z → z = x ∨ z = y)))) ) := by - classical - intro coord_unique horizontal_midpoint vertical_midpoint edge_normal T e he - exact ContactPortGeometry.midpoint_two_cells coord_unique - horizontal_midpoint vertical_midpoint edge_normal T e he - -private theorem common_midpoint : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (a : ι), ∀ (b : ι), ∀ z ∈ (P.tile - a).cells, z ∈ (P.tile b).cells → a = b) → ((∀ (T : ProtoTile), ∀ e ∈ FootprintEdges - T, ∃ z ∈ T.cells, (fun (e : Finset GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), - (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) e ∈ ClosedSquareRealization z) → ((∀ (T : - ProtoTile), ∀ e ∈ FootprintEdges T, ∃ (x : GaussianInt) (y : GaussianInt), x ≠ y ∧ ∀ - (z : LatticeCell), (fun (e : Finset GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : - ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) e ∈ ClosedSquareRealization z → z = x ∨ z = y) - → (∀ (a : ι), ∀ (b : ι), a ≠ b → ∀ e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges - (P.tile b), (fun (e : Finset GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z - ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) e ∈ TileRealization (P.tile a) ∩ TileRealization - (P.tile b) ∧ ∀ (c : ι), (fun (e : Finset GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 - : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) e ∈ TileRealization (P.tile c) → c = a ∨ c = - b))) ) := by - classical - intro ι P owner_unique midpoint_cell midpoint_two_cells a b hab e he - exact ContactPortGeometry.common_midpoint ι P owner_unique midpoint_cell midpoint_two_cells a - b hab e he - -private theorem common_frontier : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (T : ProtoTile), IsClosed - (TileRealization T)) → ((∀ (a : ι), ∀ (b : ι), a ≠ b → Disjoint (interior - (TileRealization (P.tile a))) (TileRealization (P.tile b))) → ((∀ (a : ι), ∀ (b : ι), - a ≠ b → ∀ e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b), (fun (e : Finset - GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) - e ∈ TileRealization (P.tile a) ∩ TileRealization (P.tile b) ∧ ∀ (c : ι), (fun (e : - Finset GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 - : ℝ))) e ∈ TileRealization (P.tile c) → c = a ∨ c = b) → (∀ (a : ι), ∀ (b : ι), a ≠ b - → ∀ e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b), (fun (e : Finset - GaussianInt) => ((∑ z ∈ e, (↑z.re : ℝ)) / (2 : ℝ), (∑ z ∈ e, (↑z.im : ℝ)) / (2 : ℝ))) - e ∈ frontier (TileRealization (P.tile a)) ∩ frontier (TileRealization (P.tile b))))) - ) := by - classical - intro ι P realization_closed interior_disjoint common_midpoint a b hab e he - exact ContactPortGeometry.common_frontier ι P realization_closed interior_disjoint - common_midpoint a b hab e he - -private theorem contact_symmetric : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P - a b ↔ P3723T1EdgeContact P b a ) := by - classical - intro ι P a b - exact PeriodicEdgeContactSymmetry.symmetric ι P a b - -private theorem common_edge_transport : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (u : ↥P.lattice), ∀ (a : ι), - FootprintEdges (P.tile (P.shift u a)) = (fun (e : Finset GaussianInt) => Finset.image - (fun (z : GaussianInt) => z + (↑u : GaussianInt)) e) '' FootprintEdges (P.tile a)) → - (∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), ∀ (e : Finset GaussianInt), (e ∈ - FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) → (e.image (fun z => z + (u : - GaussianInt)) ∈ FootprintEdges (P.tile (P.shift u a)) ∩ FootprintEdges (P.tile - (P.shift u b)))) ) := by - classical - intro ι P edges_periodic u a b e he - exact ContactPortGeometry.common_edge_transport ι P edges_periodic u a b e he - -private theorem contact_forward : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (u : ↥P.lattice), Function.Injective - (P.shift u)) → ((∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), ∀ (e : Finset GaussianInt), - (e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) → (e.image (fun z => z + - (u : GaussianInt)) ∈ FootprintEdges (P.tile (P.shift u a)) ∩ FootprintEdges (P.tile - (P.shift u b)))) → (∀ (u : ↥P.lattice), ∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P - a b → P3723T1EdgeContact P (P.shift u a) (P.shift u b))) ) := by - classical - intro ι P shift_injective common_edge_transport u a b hab - exact ContactPortGeometry.contact_forward ι P - shift_injective common_edge_transport u a b hab - -private theorem contact_periodic : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (u : P.lattice), ∀ (a : ι), P.shift (-u) - (P.shift u a) = a) → ((∀ (u : ↥P.lattice), ∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact - P a b → P3723T1EdgeContact P (P.shift u a) (P.shift u b)) → (∀ (u : P.lattice), ∀ - (a : ι), ∀ (b : ι), P3723T1EdgeContact P (P.shift u a) (P.shift u b) ↔ - P3723T1EdgeContact P a b)) ) := by - classical - intro ι P shift_cancel contact_forward u a b - exact ContactPortGeometry.contact_periodic ι P shift_cancel - contact_forward u a b - -private theorem position_cell : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (cells_nonempty : ∀ (a : ι), (P.tile - a).cells.Nonempty), - let cell (a : ι) : GaussianInt := Classical.choose (cells_nonempty a) - (∀ (a : ι), cell a ∈ (P.tile a).cells) → ( - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - (∀ (a : ι), a = P.shift (period a) (rep a)) → ( - let position (a : ι) : Real × Real := - GaussianRealPoint (cell (rep a) + (period a : GaussianInt)) + (1 / 2, 1 / 2) - ∀ (a : ι), ∃ z ∈ (P.tile a).cells, position a = GaussianRealPoint z + ((1 / 2 : Real), (1 - / 2 : Real)))) ) := by - classical - intro ι P cells_nonempty cell cell_mem rep rep_spec period period_spec position a - exact ContactPortGeometry.position_cell ι P cells_nonempty cell_mem - rep_spec period_spec a - -private theorem position_interior : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (a : ι), ∀ z ∈ (P.tile a).cells, - GaussianRealPoint z + ((1 / 2 : ℝ), (1 / 2 : ℝ)) ∈ interior (TileRealization (P.tile - a))) → (∀ (cells_nonempty : ∀ (a : ι), (P.tile a).cells.Nonempty), - let cell (a : ι) : GaussianInt := Classical.choose (cells_nonempty a) - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - let position (a : ι) : Real × Real := - GaussianRealPoint (cell (rep a) + (period a : GaussianInt)) + (1 / 2, 1 / 2) - (∀ (a : ι), ∃ z ∈ (P.tile a).cells, position a = GaussianRealPoint z + ((1 / 2 : Real), - (1 / 2 : Real))) → (∀ (a : ι), position a ∈ interior (TileRealization (P.tile a)))) ) - := by - classical - intro ι P center_interior cells_nonempty cell rep rep_spec period position position_cell a - exact ContactPortGeometry.position_interior ι P center_interior cells_nonempty rep_spec - position_cell a - -private theorem representative_eq : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : - ι), P.shift (-u) (P.shift u a) = a), - let S : Setoid (ι × ι) := { - r := fun p q => ∃ u : P.lattice, - ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} - iseqv := { - refl := by - intro p - exact ⟨0, by simp only [P.shift_zero]⟩ - symm := by - intro p q h - obtain ⟨u, hu⟩ := h - refine ⟨-u, ?_⟩ - have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu - simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm - trans := by - intro p q r hpq hqr - obtain ⟨u, hu⟩ := hpq - obtain ⟨v, hv⟩ := hqr - refine ⟨v + u, ?_⟩ - have hh := congrArg (fun s : Set ι => P.shift v '' s) hu - simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh - exact hh.trans hv - } - } - let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out - ∀ (p : ι × ι), ∀ (q : ι × ι), (S.r p q) → (representative p = representative q) ) := by - classical - intro ι P shift_cancel S representative p q h - exact ContactPortGeometry.representative_eq ι P - shift_cancel p q h - -private theorem transport_spec : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : - ι), P.shift (-u) (P.shift u a) = a), - let S : Setoid (ι × ι) := { - r := fun p q => ∃ u : P.lattice, - ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} - iseqv := { - refl := by - intro p - exact ⟨0, by simp only [P.shift_zero]⟩ - symm := by - intro p q h - obtain ⟨u, hu⟩ := h - refine ⟨-u, ?_⟩ - have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu - simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm - trans := by - intro p q r hpq hqr - obtain ⟨u, hu⟩ := hpq - obtain ⟨v, hv⟩ := hqr - refine ⟨v + u, ?_⟩ - have hh := congrArg (fun s : Set ι => P.shift v '' s) hu - simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh - exact hh.trans hv - } - } - let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out - ∀ (representative_spec : ∀ (p : ι × ι), S.r (representative p) p), - let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) - ∀ (p : ι × ι), ({P.shift (transport p) (representative p).1, - P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2} ) := by - classical - intro ι P shift_cancel S representative representative_spec transport p - exact ContactPortGeometry.transport_spec ι P shift_cancel - representative_spec p - -private theorem transport_unique : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), (∀ (u : P.lattice), ∀ (a : ι), P.shift (-u) - (P.shift u a) = a) → (∀ (r : ι × ι), ∀ (p : ι × ι), ∀ (u : ↥P.lattice), ∀ (v : - ↥P.lattice), ({P.shift u r.1, P.shift u r.2} : Set ι) = {p.1, p.2} → ({P.shift v r.1, - P.shift v r.2} : Set ι) = {p.1, p.2} → u = v) ) := by - classical - intro ι P shift_cancel r p u v hu hv - exact ContactPortGeometry.transport_unique ι P shift_cancel r p u v hu hv - -private theorem transport_swap : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : - ι), P.shift (-u) (P.shift u a) = a), - let S : Setoid (ι × ι) := { - r := fun p q => ∃ u : P.lattice, - ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} - iseqv := { - refl := by - intro p - exact ⟨0, by simp only [P.shift_zero]⟩ - symm := by - intro p q h - obtain ⟨u, hu⟩ := h - refine ⟨-u, ?_⟩ - have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu - simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm - trans := by - intro p q r hpq hqr - obtain ⟨u, hu⟩ := hpq - obtain ⟨v, hv⟩ := hqr - refine ⟨v + u, ?_⟩ - have hh := congrArg (fun s : Set ι => P.shift v '' s) hu - simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh - exact hh.trans hv - } - } - let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out - ∀ (representative_spec : ∀ (p : ι × ι), S.r (representative p) p), - let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) - (∀ (p : ι × ι), ({P.shift (transport p) (representative p).1, - P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2}) → ((∀ (r : ι × ι), - ∀ (p : ι × ι), ∀ (u : ↥P.lattice), ∀ (v : ↥P.lattice), ({P.shift u r.1, - P.shift u r.2} : Set ι) - = {p.1, p.2} → ({P.shift v r.1, P.shift v r.2} : Set ι) = {p.1, p.2} → u = v) → ((∀ - (a : ι), ∀ - (b : ι), representative (a, b) = representative (b, a)) → (∀ (a : ι), ∀ (b : ι), - transport (a, b) = transport (b, a)))) ) := by - classical - intro ι P shift_cancel S representative representative_spec transport transport_spec - transport_unique representative_swap a b - exact ContactPortGeometry.transport_swap ι P shift_cancel representative_spec transport_spec - transport_unique representative_swap a b - -private theorem representative_shift : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : - ι), P.shift (-u) (P.shift u a) = a), - let S : Setoid (ι × ι) := { - r := fun p q => ∃ u : P.lattice, - ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} - iseqv := { - refl := by - intro p - exact ⟨0, by simp only [P.shift_zero]⟩ - symm := by - intro p q h - obtain ⟨u, hu⟩ := h - refine ⟨-u, ?_⟩ - have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu - simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm - trans := by - intro p q r hpq hqr - obtain ⟨u, hu⟩ := hpq - obtain ⟨v, hv⟩ := hqr - refine ⟨v + u, ?_⟩ - have hh := congrArg (fun s : Set ι => P.shift v '' s) hu - simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh - exact hh.trans hv - } - } - let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out - (∀ (p : ι × ι), ∀ (q : ι × ι), (S.r p q) → (representative p = representative q)) → (∀ (u - : P.lattice), ∀ (a : ι), ∀ (b : ι), representative (P.shift u a, P.shift u b) = - representative (a, b)) ) := by - classical - intro ι P shift_cancel S representative representative_eq u a b - exact ContactPortGeometry.representative_shift ι P shift_cancel representative_eq u a b - -private theorem transport_shift : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : - ι), P.shift (-u) (P.shift u a) = a), - let S : Setoid (ι × ι) := { - r := fun p q => ∃ u : P.lattice, - ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} - iseqv := { - refl := by - intro p - exact ⟨0, by simp only [P.shift_zero]⟩ - symm := by - intro p q h - obtain ⟨u, hu⟩ := h - refine ⟨-u, ?_⟩ - have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu - simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm - trans := by - intro p q r hpq hqr - obtain ⟨u, hu⟩ := hpq - obtain ⟨v, hv⟩ := hqr - refine ⟨v + u, ?_⟩ - have hh := congrArg (fun s : Set ι => P.shift v '' s) hu - simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh - exact hh.trans hv - } - } - let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out - ∀ (representative_spec : ∀ (p : ι × ι), S.r (representative p) p), - let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) - (∀ (p : ι × ι), ({P.shift (transport p) (representative p).1, - P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2}) → ((∀ (r : ι × ι), - ∀ (p : ι × ι), ∀ (u : ↥P.lattice), ∀ (v : ↥P.lattice), ({P.shift u r.1, - P.shift u r.2} : Set ι) - = {p.1, p.2} → ({P.shift v r.1, P.shift v r.2} : Set ι) = {p.1, p.2} → u = v) → ((∀ (u : - P.lattice), ∀ (a : ι), ∀ (b : ι), representative (P.shift u a, P.shift u b) = - representative (a, b)) → (∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), transport (P.shift - u a, P.shift u b) = u + transport (a, b)))) ) := by - classical - intro ι P shift_cancel S representative representative_spec transport transport_spec - transport_unique representative_shift u a b - exact ContactPortGeometry.transport_shift ι P shift_cancel representative_spec - transport_spec transport_unique representative_shift u a b - -private theorem representative_contact : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : - ι), P.shift (-u) (P.shift u a) = a), (∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), - P3723T1EdgeContact P (P.shift u a) (P.shift u b) ↔ - P3723T1EdgeContact P a b) → ( - let S : Setoid (ι × ι) := { - r := fun p q => ∃ u : P.lattice, - ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} - iseqv := { - refl := by - intro p - exact ⟨0, by simp only [P.shift_zero]⟩ - symm := by - intro p q h - obtain ⟨u, hu⟩ := h - refine ⟨-u, ?_⟩ - have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu - simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm - trans := by - intro p q r hpq hqr - obtain ⟨u, hu⟩ := hpq - obtain ⟨v, hv⟩ := hqr - refine ⟨v + u, ?_⟩ - have hh := congrArg (fun s : Set ι => P.shift v '' s) hu - simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh - exact hh.trans hv - } - } - let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out - ∀ (representative_spec : ∀ (p : ι × ι), S.r (representative p) p), - let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) - (∀ (p : ι × ι), ({P.shift (transport p) (representative p).1, - P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2}) → ((∀ (a : ι), ∀ - (b : ι), ∀ (c : ι), ∀ (d : ι), ({a, b} : Set ι) = {c, d} → (P3723T1EdgeContact - P a b ↔ - P3723T1EdgeContact P c d)) → (∀ (p : ι × ι), (P3723T1EdgeContact P p.1 p.2) → - (P3723T1EdgeContact P (representative p).1 (representative p).2))))) := by - classical - intro ι P shift_cancel contact_periodic S representative representative_spec transport - transport_spec pair_contact p hp - exact ContactPortGeometry.representative_contact ι P shift_cancel contact_periodic - representative_spec transport_spec pair_contact p hp - -private theorem edge_common : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (shift_cancel : ∀ (u : P.lattice), ∀ (a : - ι), P.shift (-u) (P.shift u a) = a), (∀ (u : P.lattice), ∀ (a : ι), ∀ (b : ι), ∀ (e : - Finset GaussianInt), (e ∈ FootprintEdges (P.tile a) ∩ - FootprintEdges (P.tile b)) → (e.image (fun z => z + (u : GaussianInt)) ∈ - FootprintEdges (P.tile (P.shift u a)) ∩ FootprintEdges (P.tile (P.shift u b)))) → ( - let S : Setoid (ι × ι) := { - r := fun p q => ∃ u : P.lattice, - ({P.shift u p.1, P.shift u p.2} : Set ι) = {q.1, q.2} - iseqv := { - refl := by - intro p - exact ⟨0, by simp only [P.shift_zero]⟩ - symm := by - intro p q h - obtain ⟨u, hu⟩ := h - refine ⟨-u, ?_⟩ - have hh := congrArg (fun s : Set ι => P.shift (-u) '' s) hu - simpa only [Set.image_insert_eq, Set.image_singleton, shift_cancel] using hh.symm - trans := by - intro p q r hpq hqr - obtain ⟨u, hu⟩ := hpq - obtain ⟨v, hv⟩ := hqr - refine ⟨v + u, ?_⟩ - have hh := congrArg (fun s : Set ι => P.shift v '' s) hu - simp only [Set.image_insert_eq, Set.image_singleton, ← P.shift_add] at hh - exact hh.trans hv - } - } - let representative (p : ι × ι) : ι × ι := (Quotient.mk S p).out - ∀ (representative_spec : ∀ (p : ι × ι), S.r (representative p) p), - let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) - (∀ (p : ι × ι), ({P.shift (transport p) (representative p).1, - P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2}) → ((∀ (p : ι × ι), - (P3723T1EdgeContact P p.1 p.2) → (P3723T1EdgeContact P (representative p).1 - (representative p).2)) → ( - let baseEdge (p : ι × ι) : Finset GaussianInt := - if hp : P3723T1EdgeContact P p.1 p.2 then Classical.choose hp.2 else ∅ - (∀ (p : ι × ι), (P3723T1EdgeContact P p.1 p.2) → (baseEdge p ∈ FootprintEdges (P.tile - p.1) ∩ FootprintEdges (P.tile p.2))) → ( - let edge (a b : ι) : Finset GaussianInt := - if P3723T1EdgeContact P a b then - (baseEdge (representative (a, b))).image - (fun z => z + (transport (a, b) : GaussianInt)) - else ∅ - ∀ (a : ι), ∀ (b : ι), P3723T1EdgeContact P a b → - edge a b ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)))))) := by - classical - intro ι P shift_cancel common_edge_transport S representative representative_spec transport - transport_spec representative_contact baseEdge baseEdge_common edge a b hab - exact ContactPortGeometry.edge_common ι P shift_cancel common_edge_transport - representative_spec transport_spec representative_contact baseEdge_common a b hab - -private theorem midpoint_periodic : - (by - classical - exact - let midpoint (e : Finset GaussianInt) : Real × Real := - ((∑ z ∈ e, (z.re : Real)) / 2, (∑ z ∈ e, (z.im : Real)) / 2) - ∀ (e : Finset GaussianInt), ∀ (u : GaussianInt), (e.card = 2) → (midpoint (e.image (fun z - => z + u)) = midpoint e + GaussianRealPoint u) ) := by - classical - intro midpoint e u he - exact ContactPortGeometry.midpoint_periodic e u he - -end ContactPortClosure namespace ContactPortConstruction @@ -1774,15 +1227,15 @@ theorem P3723T1ContactPortsExist {ι : Type} (P : PeriodicTileComplex ι) : -- BODY classical -- Unique cell ownership controls the square and midpoint geometry. - have owner_unique := ContactPortClosure.owner_unique ι P + have owner_unique := ContactPortGeometry.owner_unique ι P let openSquare (z : GaussianInt) : Set (Real × Real) := Set.Ioo (z.re : Real) ((z.re : Real) + 1) ×ˢ Set.Ioo (z.im : Real) ((z.im : Real) + 1) have openSquare_open (z : GaussianInt) : IsOpen (openSquare z) := isOpen_Ioo.prod isOpen_Ioo have openSquare_closure := ContactPortGeometry.openSquare_closure - have coord_unique := ContactPortClosure.coord_unique - have square_unique := ContactPortClosure.square_unique coord_unique + have coord_unique := ContactPortGeometry.coord_unique + have square_unique := ContactPortGeometry.square_unique coord_unique have realization_closed (T : ProtoTile) : IsClosed (TileRealization T) := isClosed_biUnion_finset (fun _ _ => isClosed_Icc) have interior_disjoint := ContactPortGeometry.interior_disjoint ι P owner_unique @@ -1793,12 +1246,12 @@ theorem P3723T1ContactPortsExist {ι : Type} (P : PeriodicTileComplex ι) : have horizontal_midpoint := ContactPortGeometry.horizontal_midpoint have vertical_midpoint := ContactPortGeometry.vertical_midpoint have edge_normal := ContactPortGeometry.edge_normal - have midpoint_cell := ContactPortClosure.midpoint_cell horizontal_midpoint vertical_midpoint - have midpoint_two_cells := ContactPortClosure.midpoint_two_cells coord_unique + have midpoint_cell := ContactPortGeometry.midpoint_cell horizontal_midpoint vertical_midpoint + have midpoint_two_cells := ContactPortGeometry.midpoint_two_cells coord_unique horizontal_midpoint vertical_midpoint edge_normal - have common_midpoint := ContactPortClosure.common_midpoint ι P owner_unique midpoint_cell + have common_midpoint := ContactPortGeometry.common_midpoint ι P owner_unique midpoint_cell midpoint_two_cells - have common_frontier := ContactPortClosure.common_frontier ι P realization_closed + have common_frontier := ContactPortGeometry.common_frontier ι P realization_closed interior_disjoint common_midpoint have footprint_finite := ContactPortGeometry.footprint_finite have finite_degree := ContactPortGeometry.finite_degree ι P midpoint_cell common_midpoint @@ -1818,7 +1271,7 @@ theorem P3723T1ContactPortsExist {ι : Type} (P : PeriodicTileComplex ι) : GaussianRealPoint (cell (rep a) + (period a : GaussianInt)) + (1 / 2, 1 / 2) have contact_symmetric (a b : ι) : P3723T1EdgeContact P a b ↔ P3723T1EdgeContact P b a := - ContactPortClosure.contact_symmetric ι P a b + PeriodicEdgeContactSymmetry.symmetric ι P a b have shift_cancel (u : P.lattice) (a : ι) : P.shift (-u) (P.shift u a) = a := by rw [← P.shift_add, neg_add_cancel, P.shift_zero] have shift_injective := ContactPortGeometry.shift_injective ι P shift_cancel @@ -1827,12 +1280,12 @@ theorem P3723T1ContactPortsExist {ι : Type} (P : PeriodicTileComplex ι) : (he : e ∈ FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)) : e.image (fun z => z + (u : GaussianInt)) ∈ FootprintEdges (P.tile (P.shift u a)) ∩ FootprintEdges (P.tile (P.shift u b)) := - ContactPortClosure.common_edge_transport ι P edges_periodic u a b e he - have contact_forward := ContactPortClosure.contact_forward ι P shift_injective + ContactPortGeometry.common_edge_transport ι P edges_periodic u a b e he + have contact_forward := ContactPortGeometry.contact_forward ι P shift_injective common_edge_transport have contact_periodic (u : P.lattice) (a b : ι) : P3723T1EdgeContact P (P.shift u a) (P.shift u b) ↔ - P3723T1EdgeContact P a b := ContactPortClosure.contact_periodic ι P shift_cancel + P3723T1EdgeContact P a b := ContactPortGeometry.contact_periodic ι P shift_cancel contact_forward u a b have period_unique := ContactPortGeometry.period_unique ι P shift_cancel have rep_shift := ContactPortGeometry.rep_shift ι P rep_spec period_spec @@ -1841,9 +1294,9 @@ theorem P3723T1ContactPortsExist {ι : Type} (P : PeriodicTileComplex ι) : have real_add := ContactPortGeometry.real_add have position_cell (a : ι) : ∃ z ∈ (P.tile a).cells, position a = GaussianRealPoint z + ((1 / 2 : Real), (1 / 2 : Real)) := - ContactPortClosure.position_cell ι P cells_nonempty cell_mem rep_spec period_spec a + ContactPortGeometry.position_cell ι P cells_nonempty cell_mem rep_spec period_spec a have position_interior (a : ι) : position a ∈ interior (TileRealization (P.tile a)) := - ContactPortClosure.position_interior ι P center_interior cells_nonempty rep_spec + ContactPortGeometry.position_interior ι P center_interior cells_nonempty rep_spec position_cell a have position_periodic := ContactPortGeometry.position_periodic ι P cells_nonempty rep_spec rep_shift period_shift real_add @@ -1885,30 +1338,30 @@ theorem P3723T1ContactPortsExist {ι : Type} (P : PeriodicTileComplex ι) : have representative_spec (p : ι × ι) : S.r (representative p) p := @Quotient.mk_out _ S p have representative_eq (p q : ι × ι) (h : S.r p q) : - representative p = representative q := ContactPortClosure.representative_eq ι P + representative p = representative q := ContactPortGeometry.representative_eq ι P shift_cancel p q h let transport (p : ι × ι) : P.lattice := Classical.choose (representative_spec p) have transport_spec (p : ι × ι) : ({P.shift (transport p) (representative p).1, P.shift (transport p) (representative p).2} : Set ι) = {p.1, p.2} := - ContactPortClosure.transport_spec ι P shift_cancel representative_spec p - have transport_unique := ContactPortClosure.transport_unique ι P shift_cancel + ContactPortGeometry.transport_spec ι P shift_cancel representative_spec p + have transport_unique := ContactPortGeometry.transport_unique ι P shift_cancel have representative_swap (a b : ι) : representative (a, b) = representative (b, a) := representative_eq _ _ ⟨0, by simp only [P.shift_zero]; exact Set.pair_comm _ _⟩ have transport_swap (a b : ι) : transport (a, b) = transport (b, a) := - ContactPortClosure.transport_swap ι P shift_cancel representative_spec transport_spec + ContactPortGeometry.transport_swap ι P shift_cancel representative_spec transport_spec transport_unique representative_swap a b have representative_shift (u : P.lattice) (a b : ι) : representative (P.shift u a, P.shift u b) = representative (a, b) := - ContactPortClosure.representative_shift ι P shift_cancel representative_eq u a b + ContactPortGeometry.representative_shift ι P shift_cancel representative_eq u a b have transport_shift (u : P.lattice) (a b : ι) : transport (P.shift u a, P.shift u b) = u + transport (a, b) := - ContactPortClosure.transport_shift ι P shift_cancel representative_spec + ContactPortGeometry.transport_shift ι P shift_cancel representative_spec transport_spec transport_unique representative_shift u a b have pair_contact := ContactPortGeometry.pair_contact ι P contact_symmetric have representative_contact (p : ι × ι) (hp : P3723T1EdgeContact P p.1 p.2) : P3723T1EdgeContact P (representative p).1 (representative p).2 := - ContactPortClosure.representative_contact ι P shift_cancel contact_periodic + ContactPortGeometry.representative_contact ι P shift_cancel contact_periodic representative_spec transport_spec pair_contact p hp let baseEdge (p : ι × ι) : Finset GaussianInt := if hp : P3723T1EdgeContact P p.1 p.2 then Classical.choose hp.2 else ∅ @@ -1920,7 +1373,7 @@ theorem P3723T1ContactPortsExist {ι : Type} (P : PeriodicTileComplex ι) : (baseEdge (representative (a, b))).image (fun z => z + (transport (a, b) : GaussianInt)) else ∅ - have edge_common := ContactPortClosure.edge_common ι P shift_cancel common_edge_transport + have edge_common := ContactPortGeometry.edge_common ι P shift_cancel common_edge_transport representative_spec transport_spec representative_contact baseEdge_common have footprint_card := ContactPortGeometry.footprint_card refine ⟨edge, edge_common, ?_, ?_, ?_, ?_⟩ @@ -1951,7 +1404,7 @@ theorem P3723T1ContactPortsExist {ι : Type} (P : PeriodicTileComplex ι) : have port_present := ContactPortGeometry.port_present ι P edge have midpoint_periodic (e : Finset GaussianInt) (u : GaussianInt) (he : e.card = 2) : midpoint (e.image (fun z => z + u)) = midpoint e + GaussianRealPoint u := - ContactPortClosure.midpoint_periodic e u he + ContactPortGeometry.midpoint_periodic e u he have finiteOrbitRepresentatives : ∃ reps : Finset (ι × ι), (∀ e ∈ reps, P3723T1EdgeContact P e.1 e.2) ∧ (∀ a b, P3723T1EdgeContact P a b → diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean b/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean index d3aa5e42d6..302f5f1b60 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean @@ -152,17 +152,17 @@ private theorem sectorOrderedSum : | simpa [Fin.sum_univ_succ, add_assoc, add_comm, add_left_comm] using hs private theorem sectorParam_values : - let SectorInterval := Set.Icc (0 : ℝ) 1 - let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} - let SectorSimplex := StandardSimplex (Fin 3) + let SectorInterval := Set.Icc (0 : ℝ) 1; + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1}; + let SectorSimplex := StandardSimplex (Fin 3); let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => - {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j}; let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // - t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} - let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 - let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 - let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 - let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2}; + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1; + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1; + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2; + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o); ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => @@ -183,13 +183,14 @@ private theorem sectorParam_values : have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by nlinarith [hc.1 k] (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone); ∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), (sectorParam o s hs).1.1 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o) ∧ (sectorParam o s hs).1.2 = 2*(s.1 (sectorJ o)-s.1 (sectorK o)) := by classical intro SectorInterval SectorCone SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK - sectorCh sectorOrderedSum sectorParam o s hs + sectorCh + sectorOrderedSum sectorParam o s hs constructor <;> rfl private theorem sectorParam_continuous : @@ -362,17 +363,17 @@ private theorem sectorTopTieParams : exact sectorOrderedBetaTop s o o' ho ho' ht private theorem sectorBottomTieParams : - let SectorInterval := Set.Icc (0 : ℝ) 1 - let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} - let SectorSimplex := StandardSimplex (Fin 3) + let SectorInterval := Set.Icc (0 : ℝ) 1; + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1}; + let SectorSimplex := StandardSimplex (Fin 3); let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => - {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j}; let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // - t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} - let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 - let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 - let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 - let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2}; + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1; + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1; + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2; + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o); ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => @@ -393,7 +394,7 @@ private theorem sectorBottomTieParams : have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by nlinarith [hc.1 k] (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone); (∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ sectorCh o') → ((s.1 (sectorJ o)=s.1 (sectorK o)) → (2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o)= 2*(s.1 (sectorJ o')-s.1 (sectorK o'))+3*s.1 (sectorK o'))))) → (∀ @@ -402,7 +403,8 @@ private theorem sectorBottomTieParams : (sectorParam o s ho).1.1=(sectorParam o' s ho').1.1)) := by classical intro SectorInterval SectorCone SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK - sectorCh sectorOrderedSum sectorParam sectorOrderedRBottom s o o' ho ho' ht + sectorCh + sectorOrderedSum sectorParam sectorOrderedRBottom s o o' ho ho' ht constructor · apply Subtype.ext change 2 * (s.1 (sectorJ o) - s.1 (sectorK o)) = 0 @@ -464,23 +466,23 @@ private theorem sectorBottomTieOther : exact ((P3832T1ChamberOverlap s.1 o o' ho ho').2.2 ht).1 private theorem sectorTopPairClassify : - let SectorSimplex := StandardSimplex (Fin 3) + let SectorSimplex := StandardSimplex (Fin 3); let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => - {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j}; let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // - t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} - let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 - let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 - let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 - let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2}; + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1; + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1; + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2; + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o); ∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ - sectorCh o') → ((s.1 (sectorI o)=s.1 (sectorJ o)) → ((s.1 (sectorI o')=s.1 (sectorJ o')) - → ((sectorI o=sectorI o' ∧ sectorJ o=sectorJ o' ∧ sectorK o=sectorK o') ∨ + sectorCh o') → ((s.1 (sectorI o)=s.1 (sectorJ o)) → ( + ((sectorI o=sectorI o' ∧ sectorJ o=sectorJ o' ∧ sectorK o=sectorK o') ∨ (sectorI o=sectorJ o' ∧ sectorJ o=sectorI o' ∧ sectorK o=sectorK o') ∨ (s.1 (sectorI o)=s.1 (sectorJ o) ∧ s.1 (sectorJ o)=s.1 (sectorK o)))))) := by classical - intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' ht - ht' + intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' + ht exact ((P3832T1ChamberOverlap s.1 o o' ho ho').2.1 ht).2.2 private theorem sectorChosenCone_spec : @@ -697,17 +699,17 @@ private theorem sectorChosenPiece_bottom : rw [hp.2.1] private theorem sectorParam_beta_zero : - let SectorInterval := Set.Icc (0 : ℝ) 1 - let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} - let SectorSimplex := StandardSimplex (Fin 3) + let SectorInterval := Set.Icc (0 : ℝ) 1; + let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1}; + let SectorSimplex := StandardSimplex (Fin 3); let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => - {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j}; let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // - t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} - let sectorI : SectorOrder → Fin 3 := fun o => o.1.1 - let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1 - let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 - let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2}; + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1; + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1; + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2; + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o); ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => @@ -728,7 +730,7 @@ private theorem sectorParam_beta_zero : have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by nlinarith [hc.1 k] (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone); (∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), (sectorParam o s hs).1.1 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o) ∧ (sectorParam o s hs).1.2 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))) → (∀ (o : SectorOrder), ∀ (s : @@ -736,7 +738,8 @@ private theorem sectorParam_beta_zero : ((sectorParam o s hs).1.2=⟨0,by norm_num [SectorInterval]⟩)) := by classical intro SectorInterval SectorCone SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK - sectorCh sectorOrderedSum sectorParam sectorParam_values o s hs ht + sectorCh + sectorOrderedSum sectorParam sectorParam_values o s hs ht apply Subtype.ext rcases sectorParam_values o s hs with ⟨_,hb⟩ rw [hb,ht] @@ -1730,7 +1733,7 @@ theorem P3776T1SectorMapsExist {ι : Type} (P : PeriodicTileCore ι) (ho : s ∈ sectorCh o) (ho' : s ∈ sectorCh o') (ht : s.1 (sectorI o)=s.1 (sectorJ o)) (ht' : s.1 (sectorI o')=s.1 (sectorJ o')) := SectorMapsProof.sectorTopPairClassify s o o' - ho ho' ht ht' + ho ho' ht let sectorPiece (o : SectorOrder) (G : C(SectorCone,ℝ×ℝ)) : C({s : SectorSimplex // s ∈ sectorCh o},ℝ×ℝ) := ⟨fun s => G (sectorParam o s.1 s.2), diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean index 173cba9f07..49236160cc 100644 --- a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean @@ -999,22 +999,23 @@ private theorem hfg : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), (ι) → ( - let Nsub := {c : ι // P.plane.adjacent a c} + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), + ( + let Nsub := {c : ι // P.plane.adjacent a c}; let first (c : Nsub) : P.plane.Face := - Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) + Classical.choose (P.plane.every_edge_two_faces a c.1 c.2); let second (c : Nsub) : P.plane.Face := Classical.choose (Classical.choose_spec - (P.plane.every_edge_two_faces a c.1 c.2)) + (P.plane.every_edge_two_faces a c.1 c.2)); ∀ (f : P.plane.Face), ∀ (e : ι), ∀ (hae : P.plane.adjacent a e), - let en : Nsub := ⟨e, hae⟩ - let f0 := first en - let f1 := second en + let en : Nsub := ⟨e, hae⟩; + let f0 := first en; + let f1 := second en; (f0 ≠ f1) → ( - let g := if f = f0 then f1 else f0 + let g := if f = f0 then f1 else f0; f ≠ g))) := by classical - intro ι P a c Nsub first second f e hae en f0 f1 hne g + intro ι P a Nsub first second f e hae en f0 f1 hne g dsimp [g] split_ifs with h · intro hEq @@ -1025,23 +1026,24 @@ private theorem hgI : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), (ι) → ( - let Nsub := {c : ι // P.plane.adjacent a c} + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), + ( + let Nsub := {c : ι // P.plane.adjacent a c}; let first (c : Nsub) : P.plane.Face := - Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) + Classical.choose (P.plane.every_edge_two_faces a c.1 c.2); let second (c : Nsub) : P.plane.Face := Classical.choose (Classical.choose_spec - (P.plane.every_edge_two_faces a c.1 c.2)) + (P.plane.every_edge_two_faces a c.1 c.2)); ∀ (f : P.plane.Face), ∀ (e : ι), ∀ (hae : P.plane.adjacent a e), - let en : Nsub := ⟨e, hae⟩ - let f0 := first en - let f1 := second en + let en : Nsub := ⟨e, hae⟩; + let f0 := first en; + let f1 := second en; (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (f0) i = a) → ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (f1) i = a) → ( - let g := if f = f0 then f1 else f0 + let g := if f = f0 then f1 else f0; ∃ j, P.plane.faceVertex g j = a)))) := by classical - intro ι P a c Nsub first second f e hae en f0 f1 hf0a hf1a g + intro ι P a Nsub first second f e hae en f0 f1 hf0a hf1a g dsimp [g] split_ifs with h · exact hf1a @@ -1051,23 +1053,24 @@ private theorem hgE : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), (ι) → ( - let Nsub := {c : ι // P.plane.adjacent a c} + ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), + ( + let Nsub := {c : ι // P.plane.adjacent a c}; let first (c : Nsub) : P.plane.Face := - Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) + Classical.choose (P.plane.every_edge_two_faces a c.1 c.2); let second (c : Nsub) : P.plane.Face := Classical.choose (Classical.choose_spec - (P.plane.every_edge_two_faces a c.1 c.2)) + (P.plane.every_edge_two_faces a c.1 c.2)); ∀ (f : P.plane.Face), ∀ (e : ι), ∀ (hae : P.plane.adjacent a e), - let en : Nsub := ⟨e, hae⟩ - let f0 := first en - let f1 := second en + let en : Nsub := ⟨e, hae⟩; + let f0 := first en; + let f1 := second en; (∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (f0) i = e) → ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex (f1) i = e) → ( - let g := if f = f0 then f1 else f0 + let g := if f = f0 then f1 else f0; ∃ j, P.plane.faceVertex g j = e)))) := by classical - intro ι P a c Nsub first second f e hae en f0 f1 hf0e hf1e g + intro ι P a Nsub first second f e hae en f0 f1 hf0e hf1e g dsimp [g] split_ifs with h · exact hf1e @@ -1270,62 +1273,6 @@ private theorem hzeroK : exact hmem.1 exact Set.mem_iUnion₂.mpr ⟨f, ⟨i, hi⟩, frontier_subset_closure hqfrontF⟩ -private theorem memK : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : - P3861T1FacialDomains P D), ∀ (a : ι), - let I : Set P.plane.Face := {f | ∃ i, P.plane.faceVertex f i = a} - (P.plane.Face) → ( - let K : Set (Real × Real) := ⋃ f ∈ I, closure (F.region f) - ∀ (g : P.plane.Face), ∀ (j : Fin (3 : ℕ)), P.plane.faceVertex g j = a → ∀ q ∈ F.region g, - q ∈ K)) := by - classical - intro ι P D F a I f K g j hj q hq - exact Set.mem_iUnion₂.mpr ⟨g, ⟨j, hj⟩, subset_closure hq⟩ - -private theorem build : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : - P3861T1FacialDomains P D), ∀ (a : ι), ∀ (u : ι → ℝ × ℝ), - let I : Set P.plane.Face := {f | ∃ i, P.plane.faceVertex f i = a} - ∀ (c : ι), - let Nsub := {c : ι // P.plane.adjacent a c} - let first (c : Nsub) : P.plane.Face := - Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) - let second (c : Nsub) : P.plane.Face := - Classical.choose (Classical.choose_spec - (P.plane.every_edge_two_faces a c.1 c.2)) - ∀ (f : P.plane.Face), - let K : Set (Real × Real) := ⋃ f ∈ I, closure (F.region f) - ∀ (z : ℝ × ℝ), ∀ (i : Fin (3 : ℕ)), (P.plane.faceVertex f i = a) → (∀ (e : ι), ∀ (hae : - P.plane.adjacent a e), ∀ (t : ℝ), - let en : Nsub := ⟨e, hae⟩ - let f0 := first en - let f1 := second en - let g := if f = f0 then f1 else f0 - ∀ (j : Fin (3 : ℕ)), (P.plane.faceVertex g j = a) → (∀ (δ₁ : ℝ), ∀ (δ₂ : ℝ), - let eps := min δ₁ (min δ₂ t) / 2 - (∀ q ∈ Metric.ball z eps, (u e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) = 0 → q ∈ K) → - ((∀ (g : P.plane.Face), ∀ (j : Fin 3), (P.plane.faceVertex g j = a) → (∀ (q : Real × - Real), (q ∈ F.region g) → (q ∈ K))) → ((∀ q ∈ Metric.ball z eps, (0 : ℝ) < (u e).1 * - (q.2 - z.2) - (u e).2 * (q.1 - z.1) → q ∈ F.region f) → (∀ q ∈ Metric.ball z eps, (u - e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) < (0 : ℝ) → q ∈ F.region g) → Metric.ball - z eps ⊆ K)))) ) := by - classical - intro ι P D F a u I c Nsub first second f K z i hi e hae t en f0 f1 g j hj δ₁ δ₂ eps hzeroK - memK hpos hneg q hq - by_cases hqpos : 0 < (u e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) - · exact memK f i hi q (hpos q hq hqpos) - · by_cases hqneg : (u e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) < 0 - · exact memK g j hj q (hneg q hq hqneg) - · have hqzero : (u e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) = 0 := by - linarith - exact hzeroK q hq hqzero - private theorem huAt878 : (by classical @@ -1859,9 +1806,9 @@ private theorem hKlocal : obtain ⟨hf1a, hf1e⟩ := hf1 have hcase := hexhaust f ⟨⟨i, hi⟩, he⟩ let g := if f = f0 then f1 else f0 - have hfg := FaceGapProof.hfg ι P a c f e hae hne - have hgE := FaceGapProof.hgE ι P a c f e hae hf0e hf1e - obtain ⟨j, hj⟩ := (FaceGapProof.hgI ι P a c f e hae hf0a hf1a) + have hfg := FaceGapProof.hfg ι P a f e hae hne + have hgE := FaceGapProof.hgE ι P a f e hae hf0e hf1e + obtain ⟨j, hj⟩ := (FaceGapProof.hgI ι P a f e hae hf0a hf1a) obtain ⟨δ₁, hδ₁, hball₁, hside₁⟩ := localSide f i hi e he hea t ht htr hzeq obtain ⟨δ₂, hδ₂, hball₂, hside₂⟩ := @@ -1878,7 +1825,12 @@ private theorem hKlocal : t δ₁ hball₁ δ₂ heps₁) have memK (g : P.plane.Face) (j : Fin 3) (hj : P.plane.faceVertex g j = a) (q : Real × Real) - (hq : q ∈ F.region g) := FaceGapProof.memK ι P D F a f g j hj q hq + (hq : q ∈ F.region g) := (show + ∀ q ∈ F.region g, q ∈ K + from by + classical + intro q hq + exact Set.mem_iUnion₂.mpr ⟨g, ⟨j, hj⟩, subset_closure hq⟩) q hq rcases hside₁ with hpos₁ | hneg₁ <;> rcases hside₂ with hpos₂ | hneg₂ · exfalso let v : Real × Real := (-(u e).2, (u e).1) @@ -1892,8 +1844,20 @@ private theorem hKlocal : exact (Set.disjoint_left.mp (hd hfg) (hpos₁ qplus (FaceGapProof.hqplus1 ι u z e t δ₁ δ₂ heps heps₁ hvnorm) hdetplus) (hpos₂ qplus (FaceGapProof.hqplus2 ι u z e t δ₁ δ₂ heps heps₂ hvnorm) hdetplus)) - · refine ⟨eps, heps, (FaceGapProof.build ι P D F a u c f z i hi e hae t j hj δ₁ δ₂ hzeroK - memK) ?_ ?_⟩ + · refine ⟨eps, heps, ((show + (∀ q ∈ Metric.ball z eps, (0 : ℝ) < (u e).1 * (q.2 - z.2) - (u e).2 * (q.1 - + z.1) → q ∈ F.region f) → (∀ q ∈ Metric.ball z eps, (u e).1 * (q.2 - z.2) - + (u e).2 * (q.1 - z.1) < (0 : ℝ) → q ∈ F.region g) → Metric.ball z eps ⊆ K + from by + classical + intro hpos hneg q hq + by_cases hqpos : 0 < (u e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) + · exact memK f i hi q (hpos q hq hqpos) + · by_cases hqneg : (u e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) < 0 + · exact memK g j hj q (hneg q hq hqneg) + · have hqzero : (u e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) = 0 := by + linarith + exact hzeroK q hq hqzero)) ?_ ?_⟩ · intro q hq hqpos exact hpos₁ q (Metric.ball_subset_ball (le_of_lt heps₁) hq) hqpos · intro q hq hqneg diff --git a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean index 18a8976cd0..c8c464a507 100644 --- a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean +++ b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean @@ -119,7 +119,7 @@ private theorem join : exact ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - (∀ (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((∀ (k : Fin (3 : ℕ)), g k ⟨(0 : + ((∀ (k : Fin (3 : ℕ)), g k ⟨(0 : ℝ), (by norm_num)⟩ = D.position (P.plane.faceVertex f k)) → ((∀ (k : Fin (3 : ℕ)), g k ⟨(1 : ℝ), (by norm_num)⟩ = D.position (P.plane.faceVertex f (k + (1 : Fin (3 : ℕ))))) → (∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization @@ -132,12 +132,12 @@ private theorem join : exact hi · let hi := (s k).strict.monotone (Fin.le_last i) rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + exact hi⟩; + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i); ∀ (k : Fin (3 : ℕ)), w k (Fin.last (s k).count) = w (k + (1 : Fin (3 : ℕ))) (0 : Fin ((s (k + (1 : Fin (3 : ℕ)))).count + (1 : ℕ))))))) := by classical - intro ι P D f g hi h0 h1 s τ w k + intro ι P D f g h0 h1 s τ w k have hlast : τ k (Fin.last (s k).count) = ⟨1, by norm_num⟩ := by apply Subtype.ext simp [τ, (s k).finish] @@ -1237,103 +1237,6 @@ private theorem hM : omega omega -private theorem q0 : - (by - classical - exact - ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 - : ℕ)), Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → - P3723T1PolygonalParameterization (g k)), - let m0 := (s 0).count - let m1 := (s 1).count - let m2 := (s 2).count - let M := m0 + (m1 + m2) - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · have hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · have hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let q : Fin M → Real × Real := - Fin.addCases - (fun i : Fin m0 => w 0 i.castSucc) - (Fin.addCases - (fun i : Fin m1 => w 1 i.castSucc) - (fun i : Fin m2 => w 2 i.castSucc)) - ∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w (0 : Fin (3 : ℕ)) i.castSucc)) := by - classical - intro g hi s m0 m1 m2 M τ w q i - simp [q] - -private theorem q1 : - (by - classical - exact - ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 - : ℕ)), Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → - P3723T1PolygonalParameterization (g k)), - let m0 := (s 0).count - let m1 := (s 1).count - let m2 := (s 2).count - let M := m0 + (m1 + m2) - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · have hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · have hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let q : Fin M → Real × Real := - Fin.addCases - (fun i : Fin m0 => w 0 i.castSucc) - (Fin.addCases - (fun i : Fin m1 => w 1 i.castSucc) - (fun i : Fin m2 => w 2 i.castSucc)) - ∀ (i : Fin m1), q (Fin.natAdd m0 (Fin.castAdd m2 i)) = w (1 : Fin (3 : ℕ)) i.castSucc)) - := by - classical - intro g hi s m0 m1 m2 M τ w q i - simp [q] - -private theorem q2 : - (by - classical - exact - ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 - : ℕ)), Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → - P3723T1PolygonalParameterization (g k)), - let m0 := (s 0).count - let m1 := (s 1).count - let m2 := (s 2).count - let M := m0 + (m1 + m2) - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · have hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · have hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let q : Fin M → Real × Real := - Fin.addCases - (fun i : Fin m0 => w 0 i.castSucc) - (Fin.addCases - (fun i : Fin m1 => w 1 i.castSucc) - (fun i : Fin m2 => w 2 i.castSucc)) - ∀ (i : Fin m2), q (Fin.natAdd m0 (Fin.natAdd m1 i)) = w (2 : Fin (3 : ℕ)) i.castSucc)) := by - classical - intro g hi s m0 m1 m2 M τ w q i - simp [q] - private theorem cyc_ne : (by classical @@ -1427,8 +1330,8 @@ private theorem w_arc : classical exact ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : - P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ - (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((∀ (k : Fin (3 : ℕ)), Set.range (g k) + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ((∀ (k : Fin (3 : ℕ)), Set.range (g k) = D.edgeArc (P.plane.faceVertex f k) (P.plane.faceVertex f (k + (1 : Fin (3 : ℕ))))) → (∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := @@ -1439,13 +1342,13 @@ private theorem w_arc : exact hi · have hi := (s k).strict.monotone (Fin.le_last i) rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let v : Fin 3 → ι := P.plane.faceVertex f + exact hi⟩; + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i); + let v : Fin 3 → ι := P.plane.faceVertex f; ∀ (k : Fin (3 : ℕ)), ∀ (i : Fin ((s k).count + (1 : ℕ))), w k i ∈ D.edgeArc (v k) (v (k + (1 : Fin (3 : ℕ))))))) := by classical - intro ι P D f g hi hr s τ w v k i + intro ι P D f g hr s τ w v k i rw [← hr k] exact ⟨τ k i, rfl⟩ @@ -1480,8 +1383,8 @@ private theorem w_finish : classical exact ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : - P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ - (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((∀ (k : Fin (3 : ℕ)), g + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ((∀ (k : Fin (3 : ℕ)), g k ⟨(1 : ℝ), (by norm_num)⟩ = D.position (P.plane.faceVertex f (k + (1 : Fin (3 : ℕ))))) → (∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), @@ -1493,13 +1396,13 @@ private theorem w_finish : exact hi · have hi := (s k).strict.monotone (Fin.le_last i) rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let v : Fin 3 → ι := P.plane.faceVertex f + exact hi⟩; + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i); + let v : Fin 3 → ι := P.plane.faceVertex f; ∀ (k : Fin (3 : ℕ)), w k (Fin.last (s k).count) = D.position (v (k + (1 : Fin (3 : ℕ))))))) := by classical - intro ι P D f g hi h1 s τ w v k + intro ι P D f g h1 s τ w v k have he : τ k (Fin.last (s k).count) = ⟨1, by norm_num⟩ := by apply Subtype.ext simp [τ, (s k).finish] @@ -1510,8 +1413,8 @@ private theorem w_start : classical exact ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : - P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ - (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((∀ (k : Fin (3 : ℕ)), g + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ((∀ (k : Fin (3 : ℕ)), g k ⟨(0 : ℝ), (by norm_num)⟩ = D.position (P.plane.faceVertex f k)) → (∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := @@ -1522,12 +1425,12 @@ private theorem w_start : exact hi · have hi := (s k).strict.monotone (Fin.le_last i) rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let v : Fin 3 → ι := P.plane.faceVertex f + exact hi⟩; + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i); + let v : Fin 3 → ι := P.plane.faceVertex f; ∀ (k : Fin (3 : ℕ)), w k (0 : Fin ((s k).count + (1 : ℕ))) = D.position (v k)))) := by classical - intro ι P D f g hi h0 s τ w v k + intro ι P D f g h0 s τ w v k have he : τ k 0 = ⟨0, by norm_num⟩ := by apply Subtype.ext simp [τ, (s k).start] @@ -1719,81 +1622,6 @@ private theorem fin_succ_val : intro g s m0 m1 m2 M n i h simp [Fin.val_add, Nat.mod_eq_of_lt h] -private theorem piece_subset_arc : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : - P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ - (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((∀ (k : Fin (3 : ℕ)), Set.range (g k) - = D.edgeArc (P.plane.faceVertex f k) (P.plane.faceVertex f (k + (1 : - Fin (3 : ℕ))))) → (∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · have hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · have hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - (∀ (k : Fin 3), ∀ (r : Fin ((s k).count)), Set.range (fun t : Set.Icc ((s k).time - r.castSucc) ((s k).time r.succ) => - g k ⟨t.1, by - constructor - · exact (τ k r.castSucc).property.1.trans t.property.1 - · exact t.property.2.trans (τ k r.succ).property.2⟩) = - segment Real (w k r.castSucc) (w k r.succ)) → ( - let v : Fin 3 → ι := P.plane.faceVertex f - ∀ (k : Fin (3 : ℕ)), ∀ (r : Fin (s k).count), segment ℝ (w k r.castSucc) (w k r.succ) ⊆ - D.edgeArc (v k) (v (k + (1 : Fin (3 : ℕ)))))))) := by - classical - intro ι P D f g hi hr s τ w piece_range v k r x hx - rw [← piece_range k r] at hx - obtain ⟨t, ht⟩ := Set.mem_range.mp hx - rw [← hr k] - refine ⟨⟨t.1, ⟨(τ k r.castSucc).property.1.trans t.property.1, - t.property.2.trans (τ k r.succ).property.2⟩⟩, ?_⟩ - simpa using ht - -private theorem p_injective : - (by - classical - exact - ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 - : ℕ)), Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → - P3723T1PolygonalParameterization (g k)), - let m0 := (s 0).count - let m1 := (s 1).count - let m2 := (s 2).count - let M := m0 + (m1 + m2) - let n := M - 3 - ∀ (hM : n + 3 = M), - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · have hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · have hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let q : Fin M → Real × Real := - Fin.addCases - (fun i : Fin m0 => w 0 i.castSucc) - (Fin.addCases - (fun i : Fin m1 => w 1 i.castSucc) - (fun i : Fin m2 => w 2 i.castSucc)) - let p : Fin (n + 3) → Real × Real := fun i => q (Fin.cast hM i) - (Function.Injective q) → (Function.Injective p))) := by - classical - intro g hi s m0 m1 m2 M n hM τ w q p q_injective i j hij - apply Fin.cast_injective hM - apply q_injective - simpa [p] using hij - private theorem endpoint_mem : (by classical @@ -1829,8 +1657,8 @@ private theorem hxi : classical exact ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : - P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ - (k : Fin (3 : ℕ)), Function.Injective (g k)) → (∀ (k : Fin (3 : ℕ)), ∀ (s : (k + P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + (∀ (k : Fin (3 : ℕ)), ∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := ⟨(s k).time i, by @@ -1840,9 +1668,9 @@ private theorem hxi : exact hi · have hi := (s k).strict.monotone (Fin.le_last i) rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let v : Fin 3 → ι := P.plane.faceVertex f + exact hi⟩; + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i); + let v : Fin 3 → ι := P.plane.faceVertex f; (∀ (k : Fin 3), ∀ (r : Fin (s k).count), ∀ (x : Real × Real), (x ∈ segment Real (w k r.castSucc) (w k r.succ)) → ((x = D.position (v k)) → (x = w k r.castSucc ∨ x = w k r.succ))) → ((∀ (k : Fin 3), ∀ (r : Fin (s k).count), ∀ (x : Real × Real), (x ∈ @@ -1851,7 +1679,7 @@ private theorem hxi : segment ℝ (w k r.castSucc) (w k r.succ)) → (∀ (u : ι), (D.position u = x) → ((u = v k ∨ u = v (k + (1 : Fin (3 : ℕ)))) → (x = w k r.castSucc ∨ x = w k r.succ))))))) := by classical - intro ι P D f g hi k s τ w v piece_start_corner piece_finish_corner x r hx1 u hux huk + intro ι P D f g k s τ w v piece_start_corner piece_finish_corner x r hx1 u hux huk rcases huk with huk | huk · apply piece_start_corner k r x hx1 exact hux.symm.trans (congrArg D.position huk) @@ -1968,13 +1796,16 @@ theorem P3913T1RoutedFaceSubdivision : · exact (τ k r.castSucc).property.1.trans t.property.1 · exact t.property.2.trans (τ k r.succ).property.2⟩) = segment Real (w k r.castSucc) (w k r.succ) := RoutedSubdivisionProof.piece_range g hi s k r - have q0 (i : Fin m0) := RoutedFaceDetails.q0 g hi s i - have q1 (i : Fin m1) := RoutedFaceDetails.q1 g hi s i - have q2 (i : Fin m2) := RoutedFaceDetails.q2 g hi s i + have q0 (i : Fin m0) : q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc := by + simp [q] + have q1 (i : Fin m1) : q (Fin.natAdd m0 (Fin.castAdd m2 i)) = w 1 i.castSucc := by + simp [q] + have q2 (i : Fin m2) : q (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc := by + simp [q] have p_at (i : Fin M) : p (Fin.cast hM.symm i) = q i := by simp [p] have join (k : Fin 3) : - w k (Fin.last (s k).count) = w (k + 1) 0 := RoutedSubdivisionProof.join ι P D f g hi h0 h1 s k + w k (Fin.last (s k).count) = w (k + 1) 0 := RoutedSubdivisionProof.join ι P D f g h0 h1 s k let v : Fin 3 → ι := P.plane.faceVertex f have arc_inter (i j : Fin 3) (hij : i ≠ j) := RoutedFaceDetails.arc_inter ι P D f (RoutedSubdivisionProof.pair_ne ι P f g s) @@ -1986,14 +1817,14 @@ theorem P3913T1RoutedFaceSubdivision : have v12 : v 1 ≠ v 2 := v_distinct 1 2 (by decide) have arc_inter_singleton (i j : Fin 3) (hij : i ≠ j) := RoutedFaceDetails.arc_inter_singleton ι P D f arc_inter (RoutedFaceDetails.pair_inter ι P f v_distinct) i j hij - have w_arc (k : Fin 3) (i : Fin ((s k).count + 1)) := RoutedFaceDetails.w_arc ι P D f g hi hr s + have w_arc (k : Fin 3) (i : Fin ((s k).count + 1)) := RoutedFaceDetails.w_arc ι P D f g hr s k i have w_before_end (k : Fin 3) (i : Fin (s k).count) := RoutedFaceDetails.w_before_end g hi s k i - have w_start (k : Fin 3) := RoutedFaceDetails.w_start ι P D f g hi + have w_start (k : Fin 3) := RoutedFaceDetails.w_start ι P D f g h0 s k have w_ne_finish (k : Fin 3) (i : Fin (s k).count) : w k i.castSucc ≠ D.position (v (k + 1)) := RoutedSubdivisionProof.w_ne_finish ι P D f g hi - s (RoutedFaceDetails.w_finish ι P D f g hi h1 s) k i + s (RoutedFaceDetails.w_finish ι P D f g h1 s) k i have q_injective : Function.Injective q := RoutedSubdivisionProof.q_injective g hi s q0 q1 q2 (RoutedFaceDetails.no_cross01 ι P D f g s w_arc w_ne_finish (RoutedFaceDetails.arc01 ι P D f arc_inter_singleton)) (RoutedFaceDetails.no_cross12 ι P D f g s w_arc @@ -2008,8 +1839,18 @@ theorem P3913T1RoutedFaceSubdivision : ∃ k : Fin 3, ∃ r : Fin (s k).count, p i = w k r.castSucc ∧ p (i + 1) = w k r.succ := RoutedSubdivisionProof.p_edge_piece g hi s hM q0 q2 join (RoutedSubdivisionProof.q_step g hi s hM q0 q1 q2 join) i - have piece_subset_arc (k : Fin 3) (r : Fin (s k).count) := RoutedFaceDetails.piece_subset_arc ι - P D f g hi hr s piece_range k r + have piece_subset_arc (k : Fin 3) (r : Fin (s k).count) := (show + segment ℝ (w k r.castSucc) (w k r.succ) ⊆ D.edgeArc (v k) (v (k + (1 : Fin (3 : + ℕ)))) + from by + classical + intro x hx + rw [← piece_range k r] at hx + obtain ⟨t, ht⟩ := Set.mem_range.mp hx + rw [← hr k] + refine ⟨⟨t.1, ⟨(τ k r.castSucc).property.1.trans t.property.1, + t.property.2.trans (τ k r.succ).property.2⟩⟩, ?_⟩ + simpa using ht) have piece_start_corner (k : Fin 3) (r : Fin (s k).count) (x : Real × Real) (hx : x ∈ segment Real (w k r.castSucc) (w k r.succ)) (hc : x = D.position (v k)) : @@ -2042,7 +1883,14 @@ theorem P3913T1RoutedFaceSubdivision : by_cases hrr : r = r' · subst r' have hpi : p i = p j := hli.trans hlj.symm - exact (hij ((RoutedFaceDetails.p_injective g hi s hM q_injective) hpi)).elim + exact (hij (((show + Function.Injective p + from by + classical + intro i j hij + apply Fin.cast_injective hM + apply q_injective + simpa [p] using hij)) hpi)).elim · have hend := (RoutedSubdivisionProof.piece_overlap g hi s (RoutedSubdivisionProof.piece_overlap_forward g hi s piece_range)) k r r' hrr x hx1 hx2 simpa [hli, hri, hlj, hrj] using hend @@ -2052,7 +1900,7 @@ theorem P3913T1RoutedFaceSubdivision : obtain ⟨u, hu, hux⟩ := (RoutedFaceDetails.hxpos ι P D f arc_inter x k l hkl hxarc) rcases hu with ⟨huk, hul⟩ simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at huk hul - have hxi := RoutedFaceDetails.hxi ι P D f g hi k s + have hxi := RoutedFaceDetails.hxi ι P D f g k s piece_start_corner piece_finish_corner x r hx1 u hux huk have hxj := RoutedFaceDetails.hxj ι P D f g s piece_start_corner piece_finish_corner x l r' hx2 u hux hul diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean index 2d75095101..199c296f6d 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean @@ -490,14 +490,6 @@ private theorem negSign : intro k x cases k <;> simp [Bool.not] -private theorem reverseLocal : - (∀ (k : Bool), ∀ (x : Real), (if k then 0 < x else x < 0) ↔ (if !k then 0 < -x else -x < 0)) - → (∀ (W : Set (ℝ × ℝ)), ∀ (z : ℝ × ℝ), ∀ (B : ℝ × ℝ), ∀ (k : Bool), P3934T1LocalSide W - z B k → P3934T1LocalSide W z (-B) !k) := by - classical - intro negSign - exact ArcComparisonGeometry.reverseLocal negSign - namespace ArcComparisonCoreFacts private theorem hgfun_surj : @@ -1325,7 +1317,7 @@ theorem P3934T1ArcSideComparison (U V S : Set (Real × Real)) have negSign (k : Bool) (x : Real) : (if k then 0 < x else x < 0) ↔ (if !k then 0 < -x else -x < 0) := ArcComparisonMainProof.negSign k x - have reverseLocal := ArcComparisonMainProof.reverseLocal negSign + have reverseLocal := ArcComparisonGeometry.reverseLocal negSign have compareCore : ∀ (U₁ U₂ : Set (Real × Real)) (g h : Set.Icc (0 : Real) 1 → Real × Real) (p : P3723T1PolygonalParameterization g) diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean index 8681714ea5..4714d5e5e9 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean @@ -1161,42 +1161,6 @@ end ExteriorMixedCycleProof namespace ExteriorCycleDetails -private theorem hsectorRay : - ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), ∀ (e : Finset GaussianInt), ∀ (f : - Finset GaussianInt), (x ∈ e) → ((x ∈ f) → ((e ∈ FootprintEdges U) → ((f ∈ FootprintEdges - V) → ( - let c0 : GaussianInt := x - let c1 : GaussianInt := x - 1 - let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ - let c3 : GaussianInt := x - ⟨0, 1⟩ - (¬ (c0 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ - c2 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c3 ∈ V.cells)) - → ((¬ (c3 ∈ U.cells ∧ c2 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c0 ∈ - U.cells ∧ c3 ∈ V.cells)) → ((¬ (c0 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ c1 ∈ - V.cells)) → ((¬ (c2 ∈ U.cells ∧ c2 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ c3 ∈ V.cells)) → - (((c0 ∈ U.cells ∧ c2 ∈ V.cells) ∨ (c2 ∈ U.cells ∧ c0 ∈ V.cells) ∨ (c1 ∈ U.cells ∧ c3 ∈ - V.cells) ∨ (c3 ∈ U.cells ∧ c1 ∈ V.cells)) → ((∀ (T : ProtoTile), ∀ (g : Finset - GaussianInt), (x ∈ g) → ((g ∈ FootprintEdges T) → ((c1 ∉ T.cells) → ((c2 ∉ T.cells) → - ((c3 ∉ T.cells) → (g = {x, x + ⟨0, 1⟩} ∨ g = {x, x + 1})))))) → ((∀ (T : ProtoTile), ∀ (g - : Finset GaussianInt), (x ∈ g) → ((g ∈ FootprintEdges T) → ((c0 ∉ T.cells) → ((c2 ∉ - T.cells) → ((c3 ∉ T.cells) → (g = {x, x + ⟨0, 1⟩} ∨ g = {x - 1, x})))))) → ((∀ (T : - ProtoTile), ∀ (g : Finset GaussianInt), (x ∈ g) → ((g ∈ FootprintEdges T) → ((c0 ∉ - T.cells) → ((c1 ∉ T.cells) → ((c3 ∉ T.cells) → (g = {x - 1, x} ∨ g = {x - ⟨0, 1⟩, - x})))))) → ((∀ (T : ProtoTile), ∀ (g : Finset GaussianInt), (x ∈ g) → ((g ∈ - FootprintEdges T) → ((c0 ∉ T.cells) → ((c1 ∉ T.cells) → ((c2 ∉ T.cells) → (g = {x - ⟨0, - 1⟩, x} ∨ g = {x, x + 1})))))) → ((c0 ∈ U.cells ∧ c2 ∈ V.cells ∧ (e = {x, x + ⟨0, 1⟩} ∨ e - = {x, x + 1}) ∧ (f = {x - ⟨0, 1⟩, x} ∨ f = {x - 1, x})) ∨ (c2 ∈ U.cells ∧ c0 ∈ V.cells ∧ - (e = {x - 1, x} ∨ e = {x - ⟨0, 1⟩, x}) ∧ (f = {x, x + ⟨0, 1⟩} ∨ f = {x, x + 1})) ∨ (c1 ∈ - U.cells ∧ c3 ∈ V.cells ∧ (e = {x, x + ⟨0, 1⟩} ∨ e = {x - 1, x}) ∧ (f = {x - ⟨0, 1⟩, x} ∨ - f = {x, x + 1})) ∨ (c3 ∈ U.cells ∧ c1 ∈ V.cells ∧ (e = {x - ⟨0, 1⟩, x} ∨ e = {x, x + 1}) - ∧ (f = {x, x + ⟨0, 1⟩} ∨ f = {x - 1, x}))))))))))))))))))))))) := by - classical - intro U V x e f hxe hxf hUedge hVedge c0 c1 c2 c3 no01 no10 no12 no21 no23 no32 no30 no03 - noSame0 noSame1 noSame2 noSame3 hpattern rayAt0 rayAt1 rayAt2 rayAt3 - exact ExteriorMixedCycleProof.hsectorRay U V x e f - hxe hxf hUedge hVedge no01 no10 no12 no21 no23 no32 no30 no03 noSame0 noSame1 noSame2 - noSame3 hpattern rayAt0 rayAt1 rayAt2 rayAt3 - private theorem indexAdjacentExterior : ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (F : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (u : GaussianInt), ∀ (v : GaussianInt), (∀ (a : GaussianInt), ∀ (b : @@ -1743,7 +1707,7 @@ private theorem hindexDiff : let sDir : Fin 4 := 2 let wDir : Fin 4 := 3 have c1addi : c1 + 1 + ⟨0, 1⟩ = x + ⟨0, 1⟩ := by dsimp [c1]; ring - rcases (ExteriorCycleDetails.hsectorRay U V x e f hxe hxf hUedge hVedge no01 no10 no12 no21 + rcases (ExteriorMixedCycleProof.hsectorRay U V x e f hxe hxf hUedge hVedge no01 no10 no12 no21 no23 no32 no30 no03 noSame0 noSame1 noSame2 noSame3 hpattern (ExteriorMixedCycleProof.rayAt0 x supportedRay) (ExteriorMixedCycleProof.rayAt1 x supportedRay) (ExteriorMixedCycleProof.rayAt2 x supportedRay) diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean index 306a955f99..3419e82f85 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean @@ -764,16 +764,16 @@ private theorem hRedgePrefix : private theorem hRedge : ∀ (E₁ : Set (Finset GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) - let prefix₁ := c₁.tail.takeWhile good₁ + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + ( + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]); + let prefix₁ := c₁.tail.takeWhile good₁; ((z :: (c₁.tail ++ [z])).IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁)) → ((R = List.take (prefix₁.length + 2) (z :: (c₁.tail ++ [z]))) → (R.IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁)))) := by classical - intro E₁ p₁ x z c₁ good₁ w R prefix₁ hc₁edgeChain hRedgePrefix + intro E₁ p₁ x z c₁ good₁ R prefix₁ hc₁edgeChain hRedgePrefix rw [hRedgePrefix] exact hc₁edgeChain.take _ @@ -857,15 +857,15 @@ private theorem hRprefix : private theorem hRchain : ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) - let prefix₁ := c₁.tail.takeWhile good₁ + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + ( + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]); + let prefix₁ := c₁.tail.takeWhile good₁; (c₁.IsChain FourNeighborAdjacent) → ((R = c₁.take (prefix₁.length + 2)) → (R.IsChain FourNeighborAdjacent))) := by classical - intro p₁ x z c₁ good₁ w R prefix₁ hc₁chain hRprefix + intro p₁ x z c₁ good₁ R prefix₁ hc₁chain hRprefix rw [hRprefix] exact hc₁chain.take _ @@ -883,18 +883,6 @@ private theorem hQnodup : rw [hQprefix] exact (List.take_sublist _ c₂).nodup hc₂nodup -private theorem hxnotprefix₁ : - ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₁ := c₁.tail.takeWhile good₁ - x ∉ prefix₁) := by - classical - intro p₁ x z c₁ good₁ w prefix₁ hxpre - have hxgood := List.mem_takeWhile_imp hxpre - simp [good₁] at hxgood - private theorem hznotprefix₁ : ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), let c₁ := p₁.rotate (p₁.idxOf z) @@ -916,71 +904,51 @@ private theorem hznotprefix₁ : private theorem hpNodup : ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + let c₂ := p₂.rotate (p₂.idxOf x); + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _); ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₂ := c₂.tail.takeWhile good - let prefix₁ := c₁.tail.takeWhile good₁ - let Q := x :: (prefix₂ ++ [z]) + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + ( + let prefix₂ := c₂.tail.takeWhile good; + let prefix₁ := c₁.tail.takeWhile good₁; + let Q := x :: (prefix₂ ++ [z]); (Q.Nodup) → ((prefix₁.Nodup) → ((∀ v ∈ Q, ∀ w ∈ prefix₁, v ≠ w) → ((Q ++ prefix₁).Nodup)))) := by classical - intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q hQnodup hprefix₁nodup hcross + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ prefix₂ prefix₁ Q hQnodup hprefix₁nodup hcross apply List.nodup_append.mpr exact ⟨hQnodup, hprefix₁nodup, hcross⟩ -private theorem hpne : - ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : - GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) - ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₂ := c₂.tail.takeWhile good - let prefix₁ := c₁.tail.takeWhile good₁ - let Q := x :: (prefix₂ ++ [z]) - let p := Q ++ prefix₁ - p ≠ []) := by - classical - intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p he - have hxmem : x ∈ p := by simp [p, Q] - rw [he] at hxmem - simp at hxmem - private theorem hRstep : ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + ( + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]); (R.IsChain FourNeighborAdjacent) → (∀ v ∈ R.tail.head?, FourNeighborAdjacent z v)) := by classical - intro p₁ x z c₁ good₁ w R hRchain + intro p₁ x z c₁ good₁ R hRchain have h := (List.isChain_cons.mp hRchain).1 simpa [R] using h private theorem hPplus : ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + let c₂ := p₂.rotate (p₂.idxOf x); + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _); ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) - let prefix₂ := c₂.tail.takeWhile good - let Q := x :: (prefix₂ ++ [z]) + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + ( + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]); + let prefix₂ := c₂.tail.takeWhile good; + let Q := x :: (prefix₂ ++ [z]); (Q.getLast? = some z) → ((Q.IsChain FourNeighborAdjacent) → ((R.IsChain FourNeighborAdjacent) → ((∀ v ∈ R.tail.head?, FourNeighborAdjacent z v) → ((Q ++ R.tail).IsChain FourNeighborAdjacent))))) := by classical - intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w R prefix₂ Q hQlast hQchain hRchain hRstep + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ R prefix₂ Q hQlast hQchain hRchain hRstep apply List.IsChain.append hQchain (List.isChain_cons.mp hRchain).2 intro u hu v hv have hu' : u = z := by simpa [hQlast] using hu.symm @@ -990,78 +958,79 @@ private theorem hPplus : private theorem hpChain : ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + let c₂ := p₂.rotate (p₂.idxOf x); + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _); ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₂ := c₂.tail.takeWhile good - let prefix₁ := c₁.tail.takeWhile good₁ - let Q := x :: (prefix₂ ++ [z]) - let p := Q ++ prefix₁ + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + ( + let prefix₂ := c₂.tail.takeWhile good; + let prefix₁ := c₁.tail.takeWhile good₁; + let Q := x :: (prefix₂ ++ [z]); + let p := Q ++ prefix₁; ((p ++ [x]).IsChain FourNeighborAdjacent) → (p.IsChain FourNeighborAdjacent)) := by classical - intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p hPplusX + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ prefix₂ prefix₁ Q p hPplusX have h := hPplusX.left_of_append simpa using h private theorem hcloseP : ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + let c₂ := p₂.rotate (p₂.idxOf x); + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _); ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₂ := c₂.tail.takeWhile good - let prefix₁ := c₁.tail.takeWhile good₁ - let Q := x :: (prefix₂ ++ [z]) - let p := Q ++ prefix₁ + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + ( + let prefix₂ := c₂.tail.takeWhile good; + let prefix₁ := c₁.tail.takeWhile good₁; + let Q := x :: (prefix₂ ++ [z]); + let p := Q ++ prefix₁; ∀ (hpne : p ≠ []), ((p ++ [x]).IsChain FourNeighborAdjacent) → (FourNeighborAdjacent (p.getLast hpne) x)) := by classical - intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p hpne hPplusX + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ prefix₂ prefix₁ Q p hpne hPplusX have h := hPplusX.rel_getLast_head_of_append hpne (by simp) simpa using h private theorem hadjP : ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + let c₂ := p₂.rotate (p₂.idxOf x); + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _); ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₂ := c₂.tail.takeWhile good - let prefix₁ := c₁.tail.takeWhile good₁ - let Q := x :: (prefix₂ ++ [z]) - let p := Q ++ prefix₁ + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + ( + let prefix₂ := c₂.tail.takeWhile good; + let prefix₁ := c₁.tail.takeWhile good₁; + let Q := x :: (prefix₂ ++ [z]); + let p := Q ++ prefix₁; (p.IsChain FourNeighborAdjacent) → (∀ a, ∀ b, ∀ l₁, ∀ l₂, p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b)) := by classical - intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p hpChain + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ prefix₂ prefix₁ Q p hpChain rw [List.isChain_iff_forall_rel_of_append_cons_cons] at hpChain exact hpChain private theorem hpLenTwo : ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : - GaussianInt), (GaussianInt) → ( - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + GaussianInt), + ( + let c₂ := p₂.rotate (p₂.idxOf x); + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _); ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₂ := c₂.tail.takeWhile good - let prefix₁ := c₁.tail.takeWhile good₁ - let Q := x :: (prefix₂ ++ [z]) - let p := Q ++ prefix₁ + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + ( + let prefix₂ := c₂.tail.takeWhile good; + let prefix₁ := c₁.tail.takeWhile good₁; + let Q := x :: (prefix₂ ++ [z]); + let p := Q ++ prefix₁; 2 ≤ p.length)) := by classical - intro V₁ p₁ p₂ x y c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ prefix₂ prefix₁ Q p have hQlen : 2 ≤ Q.length := by simp [Q] simp [p, List.length_append] omega @@ -1111,37 +1080,6 @@ private theorem hsimple : · intro e simp [F, v, Set.mem_ofPred_eq] -private theorem hFsubset : - ∀ (V₁ : Set GaussianInt), ∀ (E₁ : Set (Finset GaussianInt)), ∀ (E₂ : Set (Finset - GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) - ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₂ := c₂.tail.takeWhile good - let prefix₁ := c₁.tail.takeWhile good₁ - let Q := x :: (prefix₂ ++ [z]) - let edgeRel (u v : GaussianInt) : Prop := - ({u, v} : Finset GaussianInt) ∈ E₁ ∪ E₂ - let p := Q ++ prefix₁ - ∀ (hpne : p ≠ []), (edgeRel (p.getLast hpne) x) → ((∀ a, ∀ b, ∀ l₁, ∀ l₂, p = l₁ ++ a :: b :: - l₂ → - edgeRel a b) → ( - let v := p.getLast hpne - let F : Set (Finset GaussianInt) := {e | e = {v, x} ∨ - ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}} - F ⊆ E₁ ∪ E₂))) := by - classical - intro V₁ E₁ E₂ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q edgeRel p hpne hcloseUnion - hadjUnion v F e he - simp only [F, Set.mem_ofPred_eq] at he - rcases he with he | ⟨a, b, l₁, l₂, hp, rfl⟩ - · subst e - simpa [v, edgeRel] using hcloseUnion - · exact hadjUnion a b l₁ l₂ hp - private theorem hE₂At769 : ∀ (V₁ : Set GaussianInt), ∀ (E₂ : Set (Finset GaussianInt)), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), @@ -1162,23 +1100,23 @@ private theorem hE₂At769 : private theorem hFfAt774 : ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) + let c₂ := p₂.rotate (p₂.idxOf x); + let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _); ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₂ := c₂.tail.takeWhile good - let prefix₁ := c₁.tail.takeWhile good₁ - let Q := x :: (prefix₂ ++ [z]) - let p := Q ++ prefix₁ + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + ( + let prefix₂ := c₂.tail.takeWhile good; + let prefix₁ := c₁.tail.takeWhile good₁; + let Q := x :: (prefix₂ ++ [z]); + let p := Q ++ prefix₁; ∀ (hpne : p ≠ []), - let v := p.getLast hpne + let v := p.getLast hpne; let F : Set (Finset GaussianInt) := {e | e = {v, x} ∨ - ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}} + ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}}; (prefix₂ = []) → (({x, z} : Finset GaussianInt) ∈ F)) := by classical - intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p hpne v F hpref₂ + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ prefix₂ prefix₁ Q p hpne v F hpref₂ simp only [F, Set.mem_ofPred_eq] right refine ⟨x, z, [], prefix₁, ?_, rfl⟩ @@ -1280,7 +1218,7 @@ private theorem hFf : cases hpref₂ : prefix₂ with | nil => simpa only [List.headD] using - MixedCycleDetails.hFfAt774 V₁ p₁ p₂ x z w hpne hpref₂ + MixedCycleDetails.hFfAt774 V₁ p₁ p₂ x z hpne hpref₂ | cons c cs => simpa only [List.headD] using MixedCycleDetails.hFfAt790 V₁ p₁ p₂ x z hpne c cs hpref₂ @@ -1407,19 +1345,15 @@ theorem P3963T1MixedBoundaryCycle hwx hdecomp₁ have hRedgePrefix := MixedCycleDetails.hRedgePrefix p₁ x takeArc z w ws hdecomp₁' have hRedge : R.IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁) := - MixedCycleDetails.hRedge E₁ p₁ x z w hc₁edgeChain hRedgePrefix + MixedCycleDetails.hRedge E₁ p₁ x z hc₁edgeChain hRedgePrefix have hRtailE₁ : R.tail.IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁) := by simpa [R, prefix₁] using (List.isChain_cons.mp hRedge).2 have hRstepE₁ : ∀ v ∈ R.tail.head?, ({z, v} : Finset GaussianInt) ∈ E₁ := by simpa [R, prefix₁] using (List.isChain_cons.mp hRedge).1 let edgeRel (u v : GaussianInt) : Prop := ({u, v} : Finset GaussianInt) ∈ E₁ ∪ E₂ - have hQunion : Q.IsChain edgeRel := hQedge.imp (by - intro u v huv - exact Or.inr huv) - have hRtailUnion : R.tail.IsChain edgeRel := hRtailE₁.imp (by - intro u v huv - exact Or.inl huv) + have hQunion : Q.IsChain edgeRel := hQedge.imp (fun _ _ huv => Or.inr huv) + have hRtailUnion : R.tail.IsChain edgeRel := hRtailE₁.imp (fun _ _ huv => Or.inl huv) have hPplusUnion : (Q ++ R.tail).IsChain edgeRel := MixedCycleDetails.hPplusUnion V₁ E₁ E₂ p₁ p₂ x z hQlast hRstepE₁ hQunion hRtailUnion have hQprefix := MixedCycleDetails.hQprefix V₁ p₂ x takeArc @@ -1428,12 +1362,14 @@ theorem P3963T1MixedBoundaryCycle hQprefix have hRprefix := MixedCycleDetails.hRprefix p₁ x takeArc z hc₁shape w ws hdecomp₁' - have hRchain := MixedCycleDetails.hRchain p₁ x z w hc₁chain + have hRchain := MixedCycleDetails.hRchain p₁ x z hc₁chain hRprefix have hQnodup := MixedCycleDetails.hQnodup V₁ p₂ x hc₂nodup z hQprefix have hprefix₁nodup : prefix₁.Nodup := (List.takeWhile_sublist good₁).nodup hc₁nodup.tail - have hxnotprefix₁ := MixedCycleDetails.hxnotprefix₁ p₁ x z w + have hxnotprefix₁ : x ∉ prefix₁ := by + intro hxpre + simpa [good₁] using List.mem_takeWhile_imp hxpre have hznotprefix₁ := MixedCycleDetails.hznotprefix₁ p₁ x z hrot₁z hc₁nodup w have hcross : ∀ v ∈ Q, ∀ w ∈ prefix₁, v ≠ w := MixedBoundaryCycleProof.hcross V₁ V₂ E₁ E₂ p₁ hV₁ p₂ x y hx hxy hx₁ hx₂ hidx₁x hidx₂x hrot₁x hrot₂x hc₂chain hc₂y hc₂nodup hc₂tail @@ -1442,20 +1378,20 @@ theorem P3963T1MixedBoundaryCycle hp₂cycleeq hc₂edgeCycle hc₂edgeChain hp₁cycleeq hc₁edgeCycle hc₁edgeChain hQlast hQedgePrefix hQedge hdecomp₁' hRedgePrefix hRedge hRtailE₁ hRstepE₁ hQunion hRtailUnion hPplusUnion hQprefix hQchain hRprefix hRchain hQnodup hprefix₁nodup hxnotprefix₁ hznotprefix₁ - have hpNodup := MixedCycleDetails.hpNodup V₁ p₁ p₂ x z w hQnodup + have hpNodup := MixedCycleDetails.hpNodup V₁ p₁ p₂ x z hQnodup hprefix₁nodup hcross let p := Q ++ prefix₁ - have hpne := MixedCycleDetails.hpne V₁ p₁ p₂ x z w + have hpne : p ≠ [] := by simp [p, Q] have hRtail : R.tail = prefix₁ ++ [x] := by simp [R, prefix₁] - have hRstep := MixedCycleDetails.hRstep p₁ x z w + have hRstep := MixedCycleDetails.hRstep p₁ x z hRchain have hPplus : (Q ++ R.tail).IsChain FourNeighborAdjacent := MixedCycleDetails.hPplus V₁ p₁ p₂ x - z w hQlast hQchain hRchain hRstep + z hQlast hQchain hRchain hRstep have hPplusX : (p ++ [x]).IsChain FourNeighborAdjacent := by simpa [p, hRtail, List.append_assoc] using hPplus - have hpChain := MixedCycleDetails.hpChain V₁ p₁ p₂ x z w hPplusX + have hpChain := MixedCycleDetails.hpChain V₁ p₁ p₂ x z hPplusX have hcloseP := MixedCycleDetails.hcloseP V₁ p₁ p₂ x - z w hpne hPplusX + z hpne hPplusX have hpPlusUnion : (p ++ [x]).IsChain edgeRel := by simpa [p, R, prefix₁, List.append_assoc] using hPplusUnion have hpUnionChain : p.IsChain edgeRel := by @@ -1470,8 +1406,8 @@ theorem P3963T1MixedBoundaryCycle let parity (u : GaussianInt) : ZMod 2 := (u.re : ZMod 2) + (u.im : ZMod 2) have parityStep {u w : GaussianInt} (h : FourNeighborAdjacent u w) : parity w = parity u + 1 := MixedBoundaryCycleProof.parityStep (u := u) (w := w) h - have hadjP := MixedCycleDetails.hadjP V₁ p₁ p₂ x z w hpChain - have hpLenTwo : 2 ≤ p.length := MixedCycleDetails.hpLenTwo V₁ p₁ p₂ x y z w + have hadjP := MixedCycleDetails.hadjP V₁ p₁ p₂ x z hpChain + have hpLenTwo : 2 ≤ p.length := MixedCycleDetails.hpLenTwo V₁ p₁ p₂ x z have hpNotTwo : p.length ≠ 2 := MixedBoundaryCycleProof.hpNotTwo V₁ E₁ E₂ hdisjoint p₁ p₂ x y z w hQedge hRedge have hpNotThree : p.length ≠ 3 := MixedBoundaryCycleProof.hpNotThree V₁ p₁ p₂ x z w hpne @@ -1485,8 +1421,10 @@ theorem P3963T1MixedBoundaryCycle have hlastE₁ : ({v, x} : Finset GaussianInt) ∈ E₁ := MixedBoundaryCycleProof.hlastE₁ V₁ E₁ p₁ p₂ x z w hQlast hRtailE₁ hRstepE₁ hpne hRtail have hwrapF : ({v, x} : Finset GaussianInt) ∈ F := by simp [F] - have hFsubset := MixedCycleDetails.hFsubset V₁ E₁ E₂ p₁ p₂ x z w hpne hcloseUnion - hadjUnion + have hFsubset : F ⊆ E₁ ∪ E₂ := by + rintro e (rfl | ⟨a, b, l₁, l₂, hp, rfl⟩) + · simpa [v, edgeRel] using hcloseUnion + · exact hadjUnion a b l₁ l₂ hp have hE₂ : ({x, prefix₂.headD z} : Finset GaussianInt) ∈ E₂ := MixedClosingEdges.hE₂ V₁ E₂ p₂ x z hQedge have hFf : ({x, prefix₂.headD z} : Finset GaussianInt) ∈ F := MixedClosingEdges.hFf V₁ p₁ p₂ x diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean b/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean index d85ccd3b5e..4ad61ed6ca 100644 --- a/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean +++ b/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean @@ -167,14 +167,10 @@ private theorem positive_parent : ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), - (BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration - bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed - bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint - bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign - bundle.routedDirection) → (∀ (i : Fin 3), 0 < (bundle.normalizedPresentation + (∀ (i : Fin 3), 0 < (bundle.normalizedPresentation i.succ).1) ) := by classical - intro C D T N h k x bundle placement i + intro C D T N h k x bundle i have hn := (ProperBandCurvatureStructure bundle.normalizedPresentation bundle.configuration.proper).2.1 i have hne := bundle.configuration.noLine i.succ @@ -201,18 +197,15 @@ private theorem slot_of_count : ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), - (BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration - bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed - bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint - bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign - bundle.routedDirection) → ((PeriodicSubtileIndex) → ((∀ (i : Fin 3), 0 < + ( + ((∀ (i : Fin 3), 0 < (bundle.normalizedPresentation i.succ).1) → (((bundle.normalizedPresentation 2).1 < (bundle.normalizedPresentation 1).1) → (((bundle.normalizedPresentation 3).1 < (bundle.normalizedPresentation 2).1) → (∀ (s : Fin 3), ∀ (i : Fin 3), (Int.toNat (bundle.normalizedPresentation s.succ).1 = Int.toNat (bundle.normalizedPresentation i.succ).1) → (s = i)))))) ) := by classical - intro C D T N h k x bundle placement a positive_parent strict_parent12 strict_parent23 s i hcount + intro C D T N h k x bundle positive_parent strict_parent12 strict_parent23 s i hcount have hn12 : Int.toNat (bundle.normalizedPresentation 2).1 < Int.toNat (bundle.normalizedPresentation 1).1 := (Int.toNat_lt_toNat (positive_parent 0)).2 strict_parent12 @@ -1108,7 +1101,7 @@ theorem P3996T1PlacementCompanionBlocks have area_translation (V : ProtoTile) (d : GaussianInt) : TileArea (TileTranslation V d) = TileArea V := (TileDiskAreaCovariance V d).2.2.2.1 - have positive_parent := PlacementCompanionGeometry.positive_parent C D T N h k x bundle placement + have positive_parent := PlacementCompanionGeometry.positive_parent C D T N h k x bundle have strict_parent12 : (bundle.normalizedPresentation 2).1 < (bundle.normalizedPresentation 1).1 := bundle.configuration.order12 @@ -1121,7 +1114,7 @@ theorem P3996T1PlacementCompanionBlocks (PlacementCompanionGeometry.slot_of_exterior C D T N h k x bundle placement area_of_band (PlacementCompanionGeometry.selected_area C D T N h k x bundle placement area_translation (PlacementCompanionGeometry.area_cells)) (PlacementCompanionGeometry.slot_of_count C D T - N h k x bundle placement a positive_parent strict_parent12 + N h k x bundle positive_parent strict_parent12 (PlacementCompanionGeometry.strict_parent23 C D T N h k x bundle))) exteriorSlot (PlacementCompanionGeometry.exterior_area C D T N h k x bundle placement (PlacementCompanionGeometry.occurrence_area C D T N h k x bundle placement area_of_band diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean index 18eba90257..51bcdf5b59 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean @@ -217,7 +217,9 @@ private theorem hparAt293 : (by classical exact - ∀ (P : FordFareyParameter), (FordFareyParameter) → ((FordFareyParameter) → (∀ (hP : (2 : + ∀ (P : FordFareyParameter), + ( + (∀ (hP : (2 : ℕ) < P.q), ∀ (hsum : P.q = P.q₁ + P.q₂), ∀ (hcrossdet : P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1), ∀ (hpos₁ : 0 < P.q₁), ∀ (hpos₂ : 0 < P.q₂), ∀ (horder : P.q₂ < P.q₁), ∀ (hdlt : P.q₁ - P.q₂ < P.q), ∀ (hdetdiff : (P.p₁-P.p₂) * @@ -236,10 +238,10 @@ private theorem hparAt293 : · exact hpos₂ · intro hu have : P.q₁ = 1 := by simpa using hu - omega + omega; Q.p₁ = P.p₁-P.p₂ ∧ Q.q₁ = P.q₁-P.q₂ ∧ Q.p₂ = P.p₂ ∧ Q.q₂ = P.q₂))) := by classical - intro P P₁ P₂ hP hsum hcrossdet hpos₁ hpos₂ horder hdlt hdetdiff H hHq hredParent Q + intro P hP hsum hcrossdet hpos₁ hpos₂ horder hdlt hdetdiff H hHq hredParent Q exact ⟨rfl, rfl, rfl, rfl⟩ private theorem hch₀' : @@ -484,7 +486,8 @@ private theorem hparAt498 : (by classical exact - ∀ (P : FordFareyParameter), (FordFareyParameter) → (∀ (P₂ : FordFareyParameter), ∀ (hP : + ∀ (P : FordFareyParameter), + (∀ (P₂ : FordFareyParameter), ∀ (hP : (2 : ℕ) < P.q), ∀ (hsum : P.q = P.q₁ + P.q₂), ∀ (hcrossdet : P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1), ∀ (hpos₂ : 0 < P.q₂), ∀ (horder : P.q₁ < P.q₂), ∀ (hdiff : 0 < P.q₂ - P.q₁), ∀ (hdetdiff : (P.p₂-P.p₁) * (P.q₂ : Int) - ((P.q₂-P.q₁ : @@ -503,10 +506,10 @@ private theorem hparAt498 : · omega · intro hu have : P.q₂ = 1 := by simpa using hu - omega + omega; (Q = P₂) → (P₂.p₁ = P.p₁ ∧ P₂.q₁ = P.q₁ ∧ P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁))) := by classical - intro P P₁ P₂ hP hsum hcrossdet hpos₂ horder hdiff hdetdiff H hHq hredParent Q hQeq + intro P P₂ hP hsum hcrossdet hpos₂ horder hdiff hdetdiff H hHq hredParent Q hQeq simpa [hQeq] using (show Q.p₁ = P.p₁ ∧ Q.q₁ = P.q₁ ∧ Q.p₂ = P.p₂-P.p₁ ∧ Q.q₂ = P.q₂-P.q₁ from ⟨rfl,rfl,rfl,rfl⟩) @@ -691,17 +694,18 @@ private theorem hyAt644 : (by classical exact - ∀ (P : FordFareyParameter), (FordFareyParameter) → (∀ (P₂ : FordFareyParameter), (∀ (q : + ∀ (P : FordFareyParameter), + (∀ (P₂ : FordFareyParameter), (∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : - Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → ((P.q₁ < P.q₂) → ((FordFareyParameter) - → (∀ (R : FordFareyParameter), (R.p = P.p₂ ∧ R.q = P.q₂) → ((P₂.p₁ = P.p₁ ∧ P₂.q₁ = + Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → ((P.q₁ < P.q₂) → ( + (∀ (R : FordFareyParameter), (R.p = P.p₂ ∧ R.q = P.q₂) → ((P₂.p₁ = P.p₁ ∧ P₂.q₁ = P.q₁ ∧ P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁) → (∀ (x : GaussianInt), ((↑P.q₁ : ℤ) + (1 : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q₂ : ℤ) - (1 : ℤ) ∧ (↑P.q₁ : ℤ) + (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₂ : ℤ) - (1 : ℤ)) → ( - let y : GaussianInt := x-⟨(P.q₁ : Int),(P.q₁ : Int)⟩ + let y : GaussianInt := x-⟨(P.q₁ : Int),(P.q₁ : Int)⟩; y ∈ P4062T1InteriorSquare (P.q₂-P.q₁)))))))) ) := by classical - intro P P₁ P₂ squareCoordinates horder H R hR hpar x hc y + intro P P₂ squareCoordinates horder R hR hpar x hc y apply (squareCoordinates (P.q₂-P.q₁) y).mpr dsimp [y] rw [Nat.cast_sub (by omega : P.q₁ ≤ P.q₂)] @@ -711,13 +715,15 @@ private theorem hcastAt656 : (by classical exact - ∀ (P : FordFareyParameter), (FordFareyParameter) → (∀ (P₂ : FordFareyParameter), (P.q₁ < + ∀ (P : FordFareyParameter), + (∀ (P₂ : FordFareyParameter), (P.q₁ < P.q₂) → (∀ (H : FordFareyParameter), (H.q = P.q₂ - P.q₁) → (∀ (R : FordFareyParameter), (R.p = P.p₂ ∧ R.q = P.q₂) → ((P₂.p₁ = P.p₁ ∧ P₂.q₁ = P.q₁ ∧ - P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁) → ((GaussianInt) → ((H.q : Int) = (P.q₂ : + P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁) → ( + ((H.q : Int) = (P.q₂ : Int)-P.q₁)))))) ) := by classical - intro P P₁ P₂ horder H hHq R hR hpar y + intro P P₂ horder H hHq R hR hpar calc (H.q : Int) = ((P.q₂-P.q₁ : Nat) : Int) := by exact_mod_cast hHq _ = (P.q₂ : Int)-P.q₁ := by @@ -727,7 +733,8 @@ private theorem hu : (by classical exact - ∀ (P : FordFareyParameter), (FordFareyParameter) → (∀ (P₂ : FordFareyParameter), (∀ (q : + ∀ (P : FordFareyParameter), + (∀ (P₂ : FordFareyParameter), (∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → ((P.q = P.q₁ + P.q₂) → ((P.q₂ - P.q₁ < P.q) → (∀ (H : FordFareyParameter), (H.q = P.q₂ - P.q₁) → (∀ (R : @@ -737,7 +744,7 @@ private theorem hu : Int) = (P.q₂ : Int)-P.q₁) → (y+⟨0,(P.q₁ : Int)⟩ ∈ P4062T1InteriorSquare P.q₂))))))))) ) := by classical - intro P P₁ P₂ squareCoordinates hsum hdlt H hHq R hR hpar y hyc hcast + intro P P₂ squareCoordinates hsum hdlt H hHq R hR hpar y hyc hcast apply (squareCoordinates P.q₂ _).mpr simp only [Zsqrtd.re_add, Zsqrtd.im_add, ] @@ -747,7 +754,8 @@ private theorem hv : (by classical exact - ∀ (P : FordFareyParameter), (FordFareyParameter) → (∀ (P₂ : FordFareyParameter), (∀ (q : + ∀ (P : FordFareyParameter), + (∀ (P₂ : FordFareyParameter), (∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → ((P.q = P.q₁ + P.q₂) → ((P.q₂ - P.q₁ < P.q) → (∀ (H : FordFareyParameter), (H.q = P.q₂ - P.q₁) → (∀ (R : @@ -757,7 +765,7 @@ private theorem hv : Int) = (P.q₂ : Int)-P.q₁) → (y+⟨(P.q₁ : Int),0⟩ ∈ P4062T1InteriorSquare P.q₂))))))))) ) := by classical - intro P P₁ P₂ squareCoordinates hsum hdlt H hHq R hR hpar y hyc hcast + intro P P₂ squareCoordinates hsum hdlt H hHq R hR hpar y hyc hcast apply (squareCoordinates P.q₂ _).mpr simp only [Zsqrtd.re_add, Zsqrtd.im_add, ] @@ -905,7 +913,7 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) have hQeq : Q = P₁ := by exact (hRuniq Q ⟨rfl, rfl⟩).trans (hRuniq P₁ ⟨hp₁, hq₁⟩).symm have hpar : Q.p₁ = P.p₁-P.p₂ ∧ Q.q₁ = P.q₁-P.q₂ ∧ - Q.p₂ = P.p₂ ∧ Q.q₂ = P.q₂ := OverlapDescentDetails.hparAt293 P P₁ P₂ hP hsum hcrossdet + Q.p₂ = P.p₂ ∧ Q.q₂ = P.q₂ := OverlapDescentDetails.hparAt293 P hP hsum hcrossdet hpos₁ hpos₂ horder hdlt hdetdiff H hHq hredParent have hparP : P₁.p₁ = P.p₁-P.p₂ ∧ P₁.q₁ = P.q₁-P.q₂ ∧ P₁.p₂ = P.p₂ ∧ P₁.q₂ = P.q₂ := by simpa [hQeq] using hpar @@ -983,7 +991,7 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) have hQeq : Q = P₂ := by exact (hRuniq Q ⟨rfl, rfl⟩).trans (hRuniq P₂ ⟨hp₂, hq₂⟩).symm have hpar : P₂.p₁ = P.p₁ ∧ P₂.q₁ = P.q₁ ∧ - P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁ := OverlapDescentDetails.hparAt498 P P₁ P₂ hP hsum + P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁ := OverlapDescentDetails.hparAt498 P P₂ hP hsum hcrossdet hpos₂ horder hdiff hdetdiff H hHq hredParent hQeq have hchildRec := hfamilyRec P₂ P₁ H (by rw [hq₂]; omega) (hp₁.trans hpar.1.symm) (hq₁.trans hpar.2.1.symm) @@ -1001,8 +1009,8 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) · intro hx have hc := hcoords x hx let y : GaussianInt := x-⟨(P.q₁ : Int),(P.q₁ : Int)⟩ - have hy := OverlapDescentDetails.hyAt644 P P₁ P₂ - squareCoordinates horder H R hR hpar x hc + have hy := OverlapDescentDetails.hyAt644 P P₂ + squareCoordinates horder R hR hpar x hc refine Finset.mem_image.mpr ⟨y, ?_, ?_⟩ · simpa [hHq] using hy · dsimp [y] @@ -1010,14 +1018,14 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) · intro hx obtain ⟨y, hy, hxy⟩ := Finset.mem_image.mp hx have hyc := (squareCoordinates H.q y).mp hy - have hcast := OverlapDescentDetails.hcastAt656 P P₁ P₂ - horder H hHq R hR hpar y + have hcast := OverlapDescentDetails.hcastAt656 P P₂ + horder H hHq R hR hpar have hsmall := hyc rw [hcast] at hsmall - have hu := OverlapDescentDetails.hu P - P₁ P₂ squareCoordinates hsum hdlt H hHq R hR hpar y hyc hcast - have hv := OverlapDescentDetails.hv P - P₁ P₂ squareCoordinates hsum hdlt H hHq R hR hpar y hyc hcast + have hu := + OverlapDescentDetails.hu P P₂ squareCoordinates hsum hdlt H hHq R hR hpar y hyc hcast + have hv := + OverlapDescentDetails.hv P P₂ squareCoordinates hsum hdlt H hHq R hR hpar y hyc hcast have hmem2 := OverlapDescentDetails.hmem2 P hr hA2 y hu have hmem3 := OverlapDescentDetails.hmem3 P hr hA3 y hv exact Finset.mem_inter.mpr diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean index b4e8378f7b..c966749035 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean @@ -1389,28 +1389,28 @@ private theorem hupper : PeriodicSubtileIndex, a.first = 0 ∧ a.second = 0 ∧ c ∈ (cert.modified.tile a).cells)), let owner : Fin 4 → PeriodicSubtileIndex := fun j => - Classical.choose (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) + Classical.choose (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)); ∀ (parent_boundary_incident_cell : ∀ (i : Fin 3), ∀ (s : Bool), (x ∈ BoundaryFootprintVertices (cert.P i s)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P i s).cells)), let modifiedOwners : Finset PeriodicSubtileIndex := - Finset.univ.image owner - (Fin (4 : ℕ)) → ( + Finset.univ.image owner; + ( let BoundaryParents := {a : Fin 3 × Bool // - x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} + x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)}; let parentCellIndex : BoundaryParents → Fin 4 := fun p => - Classical.choose (parent_boundary_incident_cell p.1.1 p.1.2 p.2) - let ModOwner := {m : PeriodicSubtileIndex // m ∈ modifiedOwners} + Classical.choose (parent_boundary_incident_cell p.1.1 p.1.2 p.2); + let ModOwner := {m : PeriodicSubtileIndex // m ∈ modifiedOwners}; let parentMap : BoundaryParents → Sum ModOwner Unit := fun p => if p.1 = (0, true) then Sum.inr Unit.unit else let j := parentCellIndex p - Sum.inl ⟨owner j, Finset.mem_image.mpr ⟨j, Finset.mem_univ _, rfl⟩⟩ + Sum.inl ⟨owner j, Finset.mem_image.mpr ⟨j, Finset.mem_univ _, rfl⟩⟩; (Function.Injective parentMap) → (Nat.card BoundaryParents ≤ modifiedOwners.card + 1))) := by classical intro q cfg C T cert x cells modified_cell_owner owner parent_boundary_incident_cell - modifiedOwners j BoundaryParents parentCellIndex ModOwner parentMap parentMap_injective + modifiedOwners BoundaryParents parentCellIndex ModOwner parentMap parentMap_injective have hcard := Fintype.card_le_of_injective parentMap parentMap_injective simpa [BoundaryParents, ModOwner, Nat.card_eq_fintype_card, Fintype.card_sum] using hcard @@ -1589,7 +1589,7 @@ theorem P4120T1GeneralDescent adjacent_of_edge) (GeneralDescentGeometry.adj30 q cfg C T cert x cells modified_cell_owner owner_spec cell_edge_hbottom cell_edge_htop adjacent_of_edge)))) (GeneralDescentGeometry.hupper q cfg C T cert x cells modified_cell_owner - parent_boundary_incident_cell j (GeneralDescentGeometry.parentMap_injective q cfg C T + parent_boundary_incident_cell (GeneralDescentGeometry.parentMap_injective q cfg C T cert x cells modified_cell_owner parent_boundary_incident_cell j (GeneralDescentGeometry.parent_matches_owner q cfg C T cert x cells modified_cell_owner owner_spec parent_boundary_incident_cell diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean index 254048174e..66367711fd 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean @@ -237,14 +237,17 @@ private theorem ford_disjoint_re : (by classical exact - (FordFareyParameter) → ((BandCircle) → ((Fin (3 : ℕ)) → ((GaussianInt) → ((GaussianInt) → - ((∀ (n : Nat), ∀ (w : GaussianInt), ∀ (c : GaussianInt), (c ∈ (TileTranslation + ( + ( + ( + ( + ((∀ (n : Nat), ∀ (w : GaussianInt), ∀ (c : GaussianInt), (c ∈ (TileTranslation (FordTile n) w).cells) → (0 ≤ (c-w).re ∧ (c-w).re < n ∧ 0 ≤ (c-w).im ∧ (c-w).im < n)) → (∀ (n : Nat), ∀ (m : Nat), ∀ (w : GaussianInt), ∀ (v : GaussianInt), (w.re + n ≤ v.re) → (Disjoint (TileTranslation (FordTile n) w).cells (TileTranslation (FordTile m) v).cells))))))) ) := by classical - intro P Ci i u x translated_ford_bounds n m w v hgap + intro translated_ford_bounds n m w v hgap apply Finset.disjoint_left.mpr intro c hcW hcV have hW := translated_ford_bounds n w c hcW @@ -256,14 +259,17 @@ private theorem ford_disjoint_im : (by classical exact - (FordFareyParameter) → ((BandCircle) → ((Fin (3 : ℕ)) → ((GaussianInt) → ((GaussianInt) → - ((∀ (n : Nat), ∀ (w : GaussianInt), ∀ (c : GaussianInt), (c ∈ (TileTranslation + ( + ( + ( + ( + ((∀ (n : Nat), ∀ (w : GaussianInt), ∀ (c : GaussianInt), (c ∈ (TileTranslation (FordTile n) w).cells) → (0 ≤ (c-w).re ∧ (c-w).re < n ∧ 0 ≤ (c-w).im ∧ (c-w).im < n)) → (∀ (n : Nat), ∀ (m : Nat), ∀ (w : GaussianInt), ∀ (v : GaussianInt), (w.im + n ≤ v.im) → (Disjoint (TileTranslation (FordTile n) w).cells (TileTranslation (FordTile m) v).cells))))))) ) := by classical - intro P Ci i u x translated_ford_bounds n m w v hgap + intro translated_ford_bounds n m w v hgap apply Finset.disjoint_left.mpr intro c hcW hcV have hW := translated_ford_bounds n w c hcW @@ -1677,12 +1683,14 @@ private theorem hq1castAt1045 : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (((0 : ℕ) < P.q₁) → (∀ (u : GaussianInt), ∀ (x - : GaussianInt), ((x - u).im = (↑P.q : ℤ)) → ((x.im - u.im = P.q) → (((P.q₁ : Int) + + ∀ (P : FordFareyParameter), + (((0 : ℕ) < P.q₁) → (∀ (u : GaussianInt), ∀ (x + : GaussianInt), + ((x.im - u.im = P.q) → (((P.q₁ : Int) + P.q₂ = P.q) → ((((P.q - 1 : Nat) : Int) = (P.q : Int) - 1) → (((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1)))))) ) := by classical - intro P Ci hrpos u x htop hxim' hqsum hqcast + intro P hrpos u x hxim' hqsum hqcast exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q₁) private theorem hmcAt1049 : @@ -2243,8 +2251,8 @@ theorem P4158T1EdgeSectorSelection : (EdgeSectorGeometry.pair_eq_iff) have translated_ford_bounds := EdgeSectorGeometry.translated_ford_bounds P Ci i u x have translated_ford_cell := EdgeSectorGeometry.translated_ford_cell - have ford_disjoint_re := EdgeSectorGeometry.ford_disjoint_re P Ci i u x translated_ford_bounds - have ford_disjoint_im := EdgeSectorGeometry.ford_disjoint_im P Ci i u x translated_ford_bounds + have ford_disjoint_re := EdgeSectorGeometry.ford_disjoint_re translated_ford_bounds + have ford_disjoint_im := EdgeSectorGeometry.ford_disjoint_im translated_ford_bounds have q₁pos := hrpos have lower_lt_q := EdgeSectorGeometry.lower_lt_q P i hsmall let z : GaussianInt := @@ -2376,7 +2384,7 @@ theorem P4158T1EdgeSectorSelection : exact_mod_cast P.sum_q.symm have hqcast : ((P.q - 1 : Nat) : Int) = (P.q : Int) - 1 := by exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q) - have hq1cast := EdgeSectorGeometry.hq1castAt1045 P Ci hrpos u x htop hxim' hqsum hqcast + have hq1cast := EdgeSectorGeometry.hq1castAt1045 P hrpos u x hxim' hqsum hqcast let m : GaussianInt := x - 1 have hmc := EdgeSectorGeometry.hmcAt1049 P Ci u x hxre'' hxim'' hqsum hqcast have hRmem : Rminus ∈ tiles := List.mem_of_head? hf.2.1 diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean index e1e68f705e..07a21fd173 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean @@ -652,19 +652,22 @@ private theorem hcentUV : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((P.q₂ < P.q₁) → (∀ (u : GaussianInt), (1 < + ∀ (P : FordFareyParameter), + ( + (∀ (u : GaussianInt), (1 < P.q₁) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), - let U := S 0 false - let V := S' 0 true - (P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1) → ((Nat.Coprime P.q₁ P.p₁.natAbs) → ((∀ + let U := S 0 false; + let V := S' 0 true; + ( + ((∀ (n : Nat), (0 < n) → (TileCentroid (FordTile n) = ((n : Real) / 2, (n : Real) / 2))) → ( - let Uc := TileTranslation (FordTile P.q₁) (u + ⟨P.q₂, P.q₂⟩) - let Vc := TileTranslation (FordTile P.q₁) (u + ⟨P.q, P.q₁⟩) + let Uc := TileTranslation (FordTile P.q₁) (u + ⟨P.q₂, P.q₂⟩); + let Vc := TileTranslation (FordTile P.q₁) (u + ⟨P.q, P.q₁⟩); (TileCentroid U = TileCentroid Uc) → ((TileCentroid V = TileCentroid Vc) → (TileCentroid V - TileCentroid U = GaussianRealPoint ⟨P.q₁, (P.q₁ : Int) - P.q₂⟩)))))))) ) := by classical - intro P Ci horder u hq1 S S' U V hcross hcop fordCentroid Uc Vc hUCcent hVCcent + intro P u hq1 S S' U V fordCentroid Uc Vc hUCcent hVCcent rw [hVCcent, hUCcent, (TileTranslationFormulas (FordTile P.q₁) (u + ⟨P.q, P.q₁⟩)).2.2.2.2.1, (TileTranslationFormulas (FordTile P.q₁) (u + ⟨P.q₂, P.q₂⟩)).2.2.2.2.1, @@ -1006,7 +1009,7 @@ theorem P4158T1LargeFirstRestrictions have hVcells : V.cells = Vc.cells := (BandPrototileCentroidUnique Ci.1.1 V Vc (TileOdometerBandPrototile Ci.1.1 V k hVk) hVcBand hVCcent).1 - have hcentUV := LargeFirstRestrictions.hcentUV P Ci horder u hq1 S S' hcross hcop fordCentroid + have hcentUV := LargeFirstRestrictions.hcentUV P u hq1 S S' fordCentroid hUCcent hVCcent have hnonzero := LargeFirstRestrictions.hnonzero P Ci horder hq1 hcross hcop have hslopeUdata := LargeFirstRestrictions.hslopeUdata P h gS hslope hnonzero diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean index 75dade4e2c..35191c1538 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean @@ -510,16 +510,17 @@ private theorem hUcCentroid : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), (1 < P.q₂) → (∀ (S : Fin + ∀ (P : FordFareyParameter), + (∀ (u : GaussianInt), (1 < P.q₂) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), - let U := S 1 false + let U := S 1 false; ((P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int)) → ((∀ (n : Nat), (0 < n) → (TileCentroid (FordTile n) = ((n : Real) / 2, (n : Real) / 2))) → ((TileCentroid U = ((u.re : Real) + (P.q₂ : Real) / 2, (u.im : Real) + (P.q₁ : Real) + (P.q₂ : Real) / 2)) → ( - let Uc := TileTranslation (FordTile P.q₂) (u + ⟨0, P.q₁⟩) + let Uc := TileTranslation (FordTile P.q₂) (u + ⟨0, P.q₁⟩); TileCentroid Uc = TileCentroid U))))) ) := by classical - intro P Ci u hcurv S U hqsum fordCentroid hUcenter Uc + intro P u hcurv S U hqsum fordCentroid hUcenter Uc rw [hUcenter] rw [(TileTranslationFormulas _ _).2.2.2.2.1, fordCentroid P.q₂ (by omega)] simp [GaussianInt.intCast_re, GaussianInt.intCast_im] @@ -529,16 +530,17 @@ private theorem hVcCentroid : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), (1 < P.q₂) → (∀ (S₂ : + ∀ (P : FordFareyParameter), + (∀ (u : GaussianInt), (1 < P.q₂) → (∀ (S₂ : Fin (3 : ℕ) → Bool → ProtoTile), - let V := S₂ 1 true + let V := S₂ 1 true; ((P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int)) → ((∀ (n : Nat), (0 < n) → (TileCentroid (FordTile n) = ((n : Real) / 2, (n : Real) / 2))) → ((TileCentroid V = ((u.re : Real) - (P.q₂ : Real) / 2, (u.im : Real) + 3 * (P.q₂ : Real) / 2)) → ( - let Vc := TileTranslation (FordTile P.q₂) (u + ⟨-(P.q₂ : Int), P.q₂⟩) + let Vc := TileTranslation (FordTile P.q₂) (u + ⟨-(P.q₂ : Int), P.q₂⟩); TileCentroid Vc = TileCentroid V))))) ) := by classical - intro P Ci u hcurv S₂ V hqsum fordCentroid hVcenter Vc + intro P u hcurv S₂ V hqsum fordCentroid hVcenter Vc rw [hVcenter] rw [(TileTranslationFormulas _ _).2.2.2.2.1, fordCentroid P.q₂ (by omega)] simp [GaussianInt.intCast_re, GaussianInt.intCast_im] @@ -972,8 +974,8 @@ theorem P4158T1LargeSecondRestrictions have hVcenter := LargeSecondRestrictions.hVcenter P T' u S₂ hoffV rootCentroid' hqreal let Uc := TileTranslation (FordTile P.q₂) (u + ⟨0, P.q₁⟩) let Vc := TileTranslation (FordTile P.q₂) (u + ⟨-(P.q₂ : Int), P.q₂⟩) - have hUcCentroid := LargeSecondRestrictions.hUcCentroid P Ci u hcurv S hqsum fordCentroid hUcenter - have hVcCentroid := LargeSecondRestrictions.hVcCentroid P Ci u hcurv S₂ hqsum fordCentroid + have hUcCentroid := LargeSecondRestrictions.hUcCentroid P u hcurv S hqsum fordCentroid hUcenter + have hVcCentroid := LargeSecondRestrictions.hVcCentroid P u hcurv S₂ hqsum fordCentroid hVcenter have hQrec := FordTileRecursiveIdentification Q have hQcircle : FordCircleCoordinate Q.p Q.q = Ci.1.1 := by diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean index d900a08de7..5c8632d8fc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean @@ -763,7 +763,8 @@ private theorem hminusheight : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (Ci : BandCircle), ∀ (i : Fin 3), + ∀ (P : FordFareyParameter), + (∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : @@ -780,14 +781,14 @@ private theorem hminusheight : (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → (((P.q : Int) = P.q₁ + P.q₂) → ( - let n := if i = 0 then P.q₁ else P.q₂ + let n := if i = 0 then P.q₁ else P.q₂; (0 < n) → ((n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ((BandPrototile Ci.1.1 (FordTile n)) → ((∀ (A : ProtoTile), ∀ (m : Nat), (0 < m) → (∀ (v : GaussianInt), (A.cells = (TileTranslation (FordTile m) v).cells) → (FootprintVertices A = FootprintVertices (TileTranslation (FordTile m) v) ∧ TileCentroid A = TileCentroid (TileTranslation (FordTile m) v)))) → ( - let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ - let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩ + let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩; + let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩; (BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) → ((TileCentroid Rminus = @@ -803,7 +804,7 @@ private theorem hminusheight : → (∀ (x : GaussianInt), (x ∈ walk) → ((x ∈ FootprintVertices Rminus) → ((x - u).im = if i = 0 then (n : Int) else P.q))))))))))))))))))))))))) ) := by classical - intro P C0 Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hsum n hnpos hnq hCicurv + intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hsum n hnpos hnq hCicurv hnlarge hFord cellobs vm vp hflip hcmcand hcpcand heqm heqp hdelta hnormdelta walk hwsegment squarefoot x hx hxm rw [(cellobs Rminus n hnpos vm heqm).1] at hxm @@ -816,7 +817,8 @@ private theorem hplusheight : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (Ci : BandCircle), ∀ (i : Fin 3), + ∀ (P : FordFareyParameter), + (∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : @@ -833,14 +835,14 @@ private theorem hplusheight : (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → (((P.q : Int) = P.q₁ + P.q₂) → ( - let n := if i = 0 then P.q₁ else P.q₂ + let n := if i = 0 then P.q₁ else P.q₂; (0 < n) → ((n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ((BandPrototile Ci.1.1 (FordTile n)) → ((∀ (A : ProtoTile), ∀ (m : Nat), (0 < m) → (∀ (v : GaussianInt), (A.cells = (TileTranslation (FordTile m) v).cells) → (FootprintVertices A = FootprintVertices (TileTranslation (FordTile m) v) ∧ TileCentroid A = TileCentroid (TileTranslation (FordTile m) v)))) → ( - let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ - let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩ + let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩; + let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩; (BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) → ((TileCentroid Rminus = @@ -858,7 +860,7 @@ private theorem hplusheight : FootprintVertices Rplus) → ((x - u).im = if i = 0 then (P.q : Int) else n)))))))))))))))))))))))))) ) := by classical - intro P C0 Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hsum n hnpos hnq hCicurv + intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hsum n hnpos hnq hCicurv hnlarge hFord cellobs vm vp hflip hcmcand hcpcand heqm heqp hdelta hnormdelta walk hwsegment squarefoot hminusheight x hx hxp rw [(cellobs Rplus n hnpos vp heqp).1] at hxp @@ -938,17 +940,20 @@ private theorem hta : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((BandCircle) → (∀ (i : Fin 3), ∀ (u : + ∀ (P : FordFareyParameter), + ( + (∀ (i : Fin 3), ∀ (u : GaussianInt), ((P.q : Int) = P.q₁ + P.q₂) → ( - let n := if i = 0 then P.q₁ else P.q₂ + let n := if i = 0 then P.q₁ else P.q₂; ∀ (z : GaussianInt), ((z - u).im < (↑P.q : ℤ)) → (((n : Int) ≤ (z - u).im) → (∀ (a : - GaussianInt), (GaussianInt) → (((a - u).im = if i = (0 : Fin (3 : ℕ)) then (↑n : ℤ) + GaussianInt), + (((a - u).im = if i = (0 : Fin (3 : ℕ)) then (↑n : ℤ) else (↑P.q : ℤ)) → ( let test := fun x : GaussianInt => - if i = 0 then (x - u).im ≤ (z - u).im else (z - u).im < (x - u).im + if i = 0 then (x - u).im ≤ (z - u).im else (z - u).im < (x - u).im; test a))))))) ) := by classical - intro P C0 Ci i u hsum n z hzhi hzlo' a b haheight test + intro P i u hsum n z hzhi hzlo' a haheight test by_cases hi : i = 0 · simp only [test, ite_eq_left hi] at * omega @@ -959,17 +964,20 @@ private theorem htb : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((BandCircle) → (∀ (i : Fin 3), ∀ (u : + ∀ (P : FordFareyParameter), + ( + (∀ (i : Fin 3), ∀ (u : GaussianInt), ((P.q : Int) = P.q₁ + P.q₂) → ( - let n := if i = 0 then P.q₁ else P.q₂ + let n := if i = 0 then P.q₁ else P.q₂; ∀ (z : GaussianInt), ((z - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) - → (((z - u).im < (↑P.q : ℤ)) → (((n : Int) ≤ (z - u).im) → ((GaussianInt) → (∀ (b : + → (((z - u).im < (↑P.q : ℤ)) → (((n : Int) ≤ (z - u).im) → ( + (∀ (b : GaussianInt), ((b - u).im = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (↑n : ℤ)) → ( let test := fun x : GaussianInt => - if i = 0 then (x - u).im ≤ (z - u).im else (z - u).im < (x - u).im + if i = 0 then (x - u).im ≤ (z - u).im else (z - u).im < (x - u).im; ¬ test b)))))))) ) := by classical - intro P C0 Ci i u hsum n z hzre hzhi hzlo' a b hbheight test + intro P i u hsum n z hzre hzhi hzlo' b hbheight test by_cases hi : i = 0 · simp only [test, ite_eq_left hi] at * omega @@ -1115,10 +1123,10 @@ theorem P4158T1SmallerStringEdges (SmallerStringGeometry.hwroot C0 Ci T T' h h' tiles reverseTiles hs reverseHs hanc hanc' walk hwvertices (SmallerStringGeometry.ancestorFoot C0 Ci hC0pos)) have squarefoot := SmallerStringGeometry.squarefoot - have hminusheight := SmallerStringGeometry.hminusheight P C0 Ci i hCi hsmall T T' u hc' + have hminusheight := SmallerStringGeometry.hminusheight P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hsum hnpos hnq hCicurv hnlarge hFord cellobs hflip hcmcand hcpcand heqm heqp hdelta hnormdelta walk hwsegment squarefoot - have hplusheight := SmallerStringGeometry.hplusheight P C0 Ci i hCi hsmall T T' u hc' hsegment + have hplusheight := SmallerStringGeometry.hplusheight P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hsum hnpos hnq hCicurv hnlarge hFord cellobs hflip hcmcand hcpcand heqm heqp hdelta hnormdelta walk hwsegment squarefoot hminusheight have crossing := SmallerStringGeometry.crossing @@ -1133,8 +1141,8 @@ theorem P4158T1SmallerStringEdges have hbheight := hplusheight b (List.mem_of_mem_getLast? (by simp [hb])) hbp let test := fun x : GaussianInt => if i = 0 then (x - u).im ≤ (z - u).im else (z - u).im < (x - u).im - have hta := SmallerStringGeometry.hta P C0 Ci i u hsum z hzhi hzlo' a b haheight - have htb := SmallerStringGeometry.htb P C0 Ci i u hsum z hzre hzhi hzlo' a b hbheight + have hta := SmallerStringGeometry.hta P i u hsum z hzhi hzlo' a haheight + have htb := SmallerStringGeometry.htb P i u hsum z hzre hzhi hzlo' b hbheight obtain ⟨x, y, l₁, l₂, he, htx, hty⟩ := crossing test walk ⟨a, ha, hta⟩ ⟨b, hb, htb⟩ have hxmem : x ∈ walk := by rw [he]; simp diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean b/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean index c3da94355b..76340889ee 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean @@ -942,11 +942,10 @@ private theorem hpEq : classical exact ∀ (q : Fin 4 → CircleCoordinates), ∀ (s0 : Real × Real), ∀ (g : PartialOdometer), - let i : Fin 3 := 0 - let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + let i : Fin 3 := 0; + let v := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)); ∀ (ai : GaussianInt), - let a := ai - (v + GaussianQuarterTurn v) - ∀ (x : GaussianInt), + let a := ai - (v + GaussianQuarterTurn v); let p : Real × Real := ((∑ x ∈ PartialOdometerSquares g, ((g.value (x + 1) - g.value x + g.value (x + 1 + ⟨0, 1⟩) - @@ -955,11 +954,11 @@ private theorem hpEq : (∑ x ∈ PartialOdometerSquares g, ((g.value (x + ⟨0, 1⟩) - g.value x + g.value (x + 1 + ⟨0, 1⟩) - g.value (x + 1) : Int) : Real)) / - (2 * ((PartialOdometerSquares g).card : Real))) + (2 * ((PartialOdometerSquares g).card : Real))); (some p = some (-p.1 + (↑a.re : ℝ), -p.2 + (↑a.im : ℝ))) → (((a.re : Real) = 2 * s0.1) → (((a.im : Real) = 2 * s0.2) → (p = s0))) ) := by classical - intro q s0 g i v ai a x p hcov haRe haIm + intro q s0 g i v ai a p hcov haRe haIm have hpair := Option.some.inj hcov apply Prod.ext · have hh := congrArg Prod.fst hpair @@ -1056,7 +1055,7 @@ theorem P4250T1ReflectedGluingSlope (-p.1 + (a.re : Real), -p.2 + (a.im : Real))) := ReflectedGluingGeometry.hcov q g ai u rw [hsharpSlope, hgslope] at hcov simp only [Option.map_some] at hcov - have hpEq : p = s0 := ReflectedGluingGeometry.hpEq q s0 g ai x hcov + have hpEq : p = s0 := ReflectedGluingGeometry.hpEq q s0 g ai hcov (ReflectedGluingGeometry.haRe q s0 ai ha) (ReflectedGluingGeometry.haIm q s0 ai ha) refine ⟨u, a, hu, ha.symm, ?_⟩ rw [hgslope, hpEq] diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean b/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean index 658302d01b..05599485de 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean @@ -145,77 +145,6 @@ private theorem hHacyclic : rfl) hverts -private theorem finj : - ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ - {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), - let H : SimpleGraph GaussianInt := { - Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W - symm := ⟨by - intro x y h - exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ - loopless := ⟨by - intro x h - rcases h.1 with h | h | h | h <;> - simp [Zsqrtd.ext_iff] at h <;> omega⟩ - } - let X := {x : GaussianInt // x ∈ W} - let G : SimpleGraph X := { - Adj := fun x y => FourNeighborAdjacent x.1 y.1 - symm := ⟨by - intro x y h - exact adjacentSymm h⟩ - loopless := ⟨by - intro x h - rcases h with h | h | h | h <;> - simp [Zsqrtd.ext_iff] at h <;> omega⟩ - } - let f : G →g H := { - toFun := Subtype.val - map_rel' := by - intro x y h - exact ⟨h, x.2, y.2⟩ - } - Function.Injective f := by - classical - intro W R adjacentSymm H X G f x y h - exact Subtype.ext h - -private theorem hGacyclic : - ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ - {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), - let H : SimpleGraph GaussianInt := { - Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W - symm := ⟨by - intro x y h - exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ - loopless := ⟨by - intro x h - rcases h.1 with h | h | h | h <;> - simp [Zsqrtd.ext_iff] at h <;> omega⟩ - } - (H.IsAcyclic) → - let X := {x : GaussianInt // x ∈ W} - let G : SimpleGraph X := { - Adj := fun x y => FourNeighborAdjacent x.1 y.1 - symm := ⟨by - intro x y h - exact adjacentSymm h⟩ - loopless := ⟨by - intro x h - rcases h with h | h | h | h <;> - simp [Zsqrtd.ext_iff] at h <;> omega⟩ - } - let f : G →g H := { - toFun := Subtype.val - map_rel' := by - intro x y h - exact ⟨h, x.2, y.2⟩ - } - (Function.Injective f) → G.IsAcyclic := by - classical - intro W R adjacentSymm H hHacyclic X G f finj x c hc - exact hHacyclic (c.map f) (hc.map finj) - private theorem hPQ : ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), @@ -817,8 +746,18 @@ theorem P4250T2FiniteForestCompletion intro x y h exact ⟨h, x.2, y.2⟩ } - have finj : Function.Injective f := ForestCompletionLemmas.finj W R adjacentSymm - have hGacyclic : G.IsAcyclic := ForestCompletionLemmas.hGacyclic W R adjacentSymm hHacyclic finj + have finj : Function.Injective f := (show + Function.Injective f + from by + classical + intro x y h + exact Subtype.ext h) + have hGacyclic : G.IsAcyclic := (show + G.IsAcyclic + from by + classical + intro x c hc + exact hHacyclic (c.map f) (hc.map finj)) let P := (W.product W).filter fun e => FourNeighborAdjacent e.1 e.2 let Q := Finset.univ.filter fun e : X × X => G.Adj e.1 e.2 have hPQ : P.card = Q.card := ForestCompletionLemmas.hPQ W R adjacentSymm diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean index 8e5768b062..af03b58890 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean @@ -735,34 +735,16 @@ private theorem kval : rw [hkeq] at hy ⊢ exact (PartialOdometerAffineTranslateFormulas _ v a' b').2.2.1 y hy -private theorem overlapBounds : - (by - classical - exact - (BandCircle) → (∀ (h : PartialOdometer), ∀ (k : PartialOdometer), (GaussianInt) → (∀ (u : - LatticeCell), ∀ (v : LatticeCell), (GaussianInt) → ((GaussianInt) → ((∀ (y : - GaussianInt), (y ∈ h.domain) → (y.re = u.re ∨ y.re = u.re + 1)) → ((∀ (y : - GaussianInt), (y ∈ h.domain) → (y.im = u.im ∨ y.im = u.im + 1)) → ((∀ (y : - GaussianInt), (y ∈ k.domain) → (y.re = v.re ∨ y.re = v.re + 1)) → ((∀ (y : - GaussianInt), (y ∈ k.domain) → (y.im = v.im ∨ y.im = v.im + 1)) → (∀ y ∈ h.domain, y - ∈ k.domain → (-1 : ℤ) ≤ v.re - u.re ∧ v.re - u.re ≤ (1 : ℤ) ∧ (-1 : ℤ) ≤ v.im - u.im - ∧ v.im - u.im ≤ (1 : ℤ))))))))) ) := by - classical - intro C h k z u v a a' hReMem hImMem kReMem kImMem y hy ky - rcases hReMem y hy with h0 | h1 <;> rcases kReMem y ky with k0 | k1 <;> - rcases hImMem y hy with hi0 | hi1 <;> rcases kImMem y ky with ki0 | ki1 <;> - omega - private theorem hcoefAt798 : (by classical exact - (BandCircle) → (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : + (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : GaussianInt), ∀ (a' : GaussianInt), (a'.im - a.im = z.im * (v.re - u.re) - z.re * (v.im - u.im)) → ((v.re - u.re = (-1 : ℤ)) → ((v.im - u.im = (0 : ℤ)) → (a.im - a'.im = z.im)))) ) := by classical - intro C z u v a a' h1Int hx hy + intro z u v a a' h1Int hx hy rw [hx, hy] at h1Int omega @@ -770,12 +752,12 @@ private theorem hcoefAt810 : (by classical exact - (BandCircle) → (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : + (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : GaussianInt), ∀ (a' : GaussianInt), (a'.re - a.re = (1 + z.re) * (v.re - u.re) + z.im * (v.im - u.im)) → ((v.re - u.re = (0 : ℤ)) → ((v.im - u.im = (-1 : ℤ)) → (a.re - a'.re = z.im)))) ) := by classical - intro C z u v a a' h0Int hx hy + intro z u v a a' h0Int hx hy rw [hx, hy] at h0Int omega @@ -783,12 +765,12 @@ private theorem hAre : (by classical exact - (BandCircle) → (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : + (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : GaussianInt), ∀ (a' : GaussianInt), (a'.re - a.re = (1 + z.re) * (v.re - u.re) + z.im * (v.im - u.im)) → ((v.re - u.re = (0 : ℤ)) → ((v.im - u.im = (0 : ℤ)) → (a'.re = a.re)))) ) := by classical - intro C z u v a a' h0Int hx hy + intro z u v a a' h0Int hx hy rw [hx, hy] at h0Int omega @@ -796,12 +778,12 @@ private theorem hAim : (by classical exact - (BandCircle) → (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : + (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : GaussianInt), ∀ (a' : GaussianInt), (a'.im - a.im = z.im * (v.re - u.re) - z.re * (v.im - u.im)) → ((v.re - u.re = (0 : ℤ)) → ((v.im - u.im = (0 : ℤ)) → (a'.im = a.im)))) ) := by classical - intro C z u v a a' h1Int hx hy + intro z u v a a' h1Int hx hy rw [hx, hy] at h1Int omega @@ -809,12 +791,12 @@ private theorem hcoefAt830 : (by classical exact - (BandCircle) → (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : + (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : GaussianInt), ∀ (a' : GaussianInt), (a'.re - a.re = (1 + z.re) * (v.re - u.re) + z.im * (v.im - u.im)) → ((v.re - u.re = (0 : ℤ)) → ((v.im - u.im = (1 : ℤ)) → (a'.re - a.re = z.im)))) ) := by classical - intro C z u v a a' h0Int hx hy + intro z u v a a' h0Int hx hy rw [hx, hy] at h0Int omega @@ -822,12 +804,12 @@ private theorem hcoefAt842 : (by classical exact - (BandCircle) → (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : + (∀ (z : GaussianInt), ∀ (u : LatticeCell), ∀ (v : LatticeCell), ∀ (a : GaussianInt), ∀ (a' : GaussianInt), (a'.im - a.im = z.im * (v.re - u.re) - z.re * (v.im - u.im)) → ((v.re - u.re = (1 : ℤ)) → ((v.im - u.im = (0 : ℤ)) → (a'.im - a.im = z.im)))) ) := by classical - intro C z u v a a' h1Int hx hy + intro z u v a a' h1Int hx hy rw [hx, hy] at h1Int omega @@ -930,8 +912,15 @@ theorem P4261T2UnitBoundary y.im = v.im ∨ y.im = v.im + 1 := UnitBoundaryProof.kImMem k v kdomSq y hy have overlapBounds (y : GaussianInt) (hy : y ∈ h.domain) (ky : y ∈ k.domain) : -1 ≤ v.re - u.re ∧ v.re - u.re ≤ 1 ∧ - -1 ≤ v.im - u.im ∧ v.im - u.im ≤ 1 := UnitBoundaryDetails.overlapBounds C h k z u v a a' - hReMem hImMem kReMem kImMem y hy ky + -1 ≤ v.im - u.im ∧ v.im - u.im ≤ 1 := (show + ∀ y ∈ h.domain, y ∈ k.domain → (-1 : ℤ) ≤ v.re - u.re ∧ v.re - u.re ≤ (1 : + ℤ) ∧ (-1 : ℤ) ≤ v.im - u.im ∧ v.im - u.im ≤ (1 : ℤ) + from by + classical + intro y hy ky + rcases hReMem y hy with h0 | h1 <;> rcases kReMem y ky with k0 | k1 <;> + rcases hImMem y hy with hi0 | hi1 <;> rcases kImMem y ky with ki0 | ki1 <;> + omega) y hy ky have horizontalPositive (f g : PartialOdometer) (x y α β : GaussianInt) (B D : ℤ) (df : (f.domain : Set GaussianInt) = @@ -985,7 +974,7 @@ theorem P4261T2UnitBoundary rw [hEq] · have vu : u = v + 1 := by apply Zsqrtd.ext <;> simp [] <;> omega - have hcoef : a.im - a'.im = z.im := UnitBoundaryDetails.hcoefAt798 C z u v a a' h1Int hx hy + have hcoef : a.im - a'.im = z.im := UnitBoundaryDetails.hcoefAt798 z u v a a' h1Int hx hy exact compatibilitySymm k h (horizontalPositive k h v u a' a b' b kdomSq hdomSq kval hval vu hcoef) · right @@ -995,13 +984,13 @@ theorem P4261T2UnitBoundary rw [hEq] · have vu : u = v + ⟨0, 1⟩ := by apply Zsqrtd.ext <;> simp [] <;> omega - have hcoef : a.re - a'.re = z.im := UnitBoundaryDetails.hcoefAt810 C z u v a a' h0Int hx hy + have hcoef : a.re - a'.re = z.im := UnitBoundaryDetails.hcoefAt810 z u v a a' h0Int hx hy exact compatibilitySymm k h (verticalPositive k h v u a' a b' b kdomSq hdomSq kval hval vu hcoef) · have vu : v = u := by apply Zsqrtd.ext <;> omega - have hAre : a'.re = a.re := UnitBoundaryDetails.hAre C z u v a a' h0Int hx hy - have hAim : a'.im = a.im := UnitBoundaryDetails.hAim C z u v a a' h1Int hx hy + have hAre : a'.re = a.re := UnitBoundaryDetails.hAre z u v a a' h0Int hx hy + have hAim : a'.im = a.im := UnitBoundaryDetails.hAim z u v a a' h1Int hx hy right refine ⟨b' - b, ?_⟩ intro y yh yk @@ -1009,7 +998,7 @@ theorem P4261T2UnitBoundary ring · have vu : v = u + ⟨0, 1⟩ := by apply Zsqrtd.ext <;> simp [] <;> omega - have hcoef : a'.re - a.re = z.im := UnitBoundaryDetails.hcoefAt830 C z u v a a' h0Int hx hy + have hcoef : a'.re - a.re = z.im := UnitBoundaryDetails.hcoefAt830 z u v a a' h0Int hx hy exact verticalPositive h k u v a a' b b' hdomSq kdomSq hval kval vu hcoef · right @@ -1019,7 +1008,7 @@ theorem P4261T2UnitBoundary rw [hEq] · have vu : v = u + 1 := by apply Zsqrtd.ext <;> simp [] <;> omega - have hcoef : a'.im - a.im = z.im := UnitBoundaryDetails.hcoefAt842 C z u v a a' h1Int hx hy + have hcoef : a'.im - a.im = z.im := UnitBoundaryDetails.hcoefAt842 z u v a a' h1Int hx hy exact horizontalPositive h k u v a a' b b' hdomSq kdomSq hval kval vu hcoef · right diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean index ae85fb7a01..bc197b9b06 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification public import LeanPool.ApollonianSuperharmonic.BoundaryString @@ -956,60 +957,7 @@ private theorem houterEnds : exact (hpt heq).elim · exact ⟨hswap.2.symm, hswap.1.symm⟩ -private theorem reversePath : - (by - classical - exact - ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ - {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween V E y x) - ) := by - classical - intro V E x y P - rcases P with ⟨p, hnodup, hlength, hhead, hlast, hvertices, hsteps, hedges⟩ - have reverse_decomp (a b : GaussianInt) (l1 l2 : List GaussianInt) - (hr : p.reverse = l1 ++ a :: b :: l2) : - p = l2.reverse ++ b :: a :: l1.reverse := by - have h := congrArg List.reverse hr - simpa [List.reverse_append] using h - have forward_decomp (a b : GaussianInt) (l1 l2 : List GaussianInt) - (hp : p = l1 ++ a :: b :: l2) : - p.reverse = l2.reverse ++ b :: a :: l1.reverse := by - have h := congrArg List.reverse hp - simpa [List.reverse_append] using h - refine ⟨p.reverse, List.nodup_reverse.mpr hnodup, ?_, ?_, ?_, ?_, ?_, ?_⟩ - · simpa using hlength - · simpa [hhead] - · simpa [hlast] - · rw [hvertices] - simp - · intro a b l1 l2 hr - have hp := reverse_decomp a b l1 l2 hr - have hstep := hsteps b a l2.reverse l1.reverse hp - rcases hstep with h | h | h | h - · right; left - rw [h] - abel - · left - rw [h] - abel - · right; right; right - rw [h] - abel - · right; right; left - rw [h] - abel - · intro e - constructor - · intro he - rcases (hedges e).1 he with ⟨a, b, l1, l2, hr, heq⟩ - have hp := forward_decomp a b l1 l2 hr - refine ⟨b, a, l2.reverse, l1.reverse, hp, ?_⟩ - simpa [Finset.pair_comm] using heq - · intro he - rcases he with ⟨a, b, l1, l2, hp, heq⟩ - have hporig := reverse_decomp a b l1 l2 hp - exact (hedges e).2 ⟨b, a, l2.reverse, l1.reverse, hporig, by - simpa [Finset.pair_comm] using heq⟩ +private abbrev reversePath := @SimpleGridPathBetween.reverse private theorem hOuterPath : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean b/LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean index 0e35abf9f4..d475044924 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean @@ -147,16 +147,12 @@ private theorem parent_area_injective : ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (fixedFunction : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C D T N h fixedFunction x), - (BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation - bundle.configuration bundle.normalizedCircle bundle.normalizedFixedCircle - bundle.normalizedRoot bundle.normalizedFixed bundle.normalizedRootFunction - bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces bundle.functions - bundle.selectedSlot bundle.selectedSign bundle.routedDirection) → ( - let q := bundle.normalizedPresentation + ( + let q := bundle.normalizedPresentation; (∀ (j : Fin 3), 0 < (q j.succ).1) → (((q 3).1 < (q 2).1) → (∀ (j : Fin 3), ∀ (k : Fin 3), (Int.toNat (q j.succ).1 = Int.toNat (q k.succ).1) → (j = k)))) ) := by classical - intro C D T N h fixedFunction x bundle placement q positive_parent strict23 j k heq + intro C D T N h fixedFunction x bundle q positive_parent strict23 j k heq let cfg := bundle.configuration have hj := positive_parent j have hk := positive_parent k @@ -589,7 +585,7 @@ theorem P4418T3OuterCompanionAlignment : have strict23 : (q 3).1 < (q 2).1 := CompanionAlignmentGeometry.strict23 C D T N h k x bundle have parent_area_injective (j otherSlot : Fin 3) (heq : Int.toNat (q j.succ).1 = Int.toNat (q otherSlot.succ).1) : j = otherSlot := - CompanionAlignmentGeometry.parent_area_injective C D T N h k x bundle placement + CompanionAlignmentGeometry.parent_area_injective C D T N h k x bundle positive_parent strict23 j otherSlot heq obtain ⟨rotation, hrotation, _⟩ := BandPredecessorNoCollision q r cfg.proper hr diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean b/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean index 8aea239598..7424a9d1e8 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean @@ -122,15 +122,12 @@ private theorem positive_parent : ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), - (BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation - bundle.configuration bundle.normalizedCircle bundle.normalizedFixedCircle - bundle.normalizedRoot bundle.normalizedFixed bundle.normalizedRootFunction - bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces bundle.functions - bundle.selectedSlot bundle.selectedSign bundle.routedDirection) → ((Fin 4) → ( - let q := bundle.normalizedPresentation + ( + ( + let q := bundle.normalizedPresentation; ∀ (j : Fin 3), 0 < (q j.succ).1)) ) := by classical - intro C D T N h k x bundle placement s q j + intro C D T N h k x bundle q j let cfg := bundle.configuration have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 j have hne := cfg.noLine j.succ @@ -1174,7 +1171,6 @@ theorem P4418T3PresentedRowAdjacency : (sign placement.centralIndex.label)) := PresentedRowAdjacencyGeometry.central_centroid C D T N h k x bundle placement (PresentedRowAdjacencyGeometry.translate_zero_centroid) have positive_parent := PresentedRowAdjacencyGeometry.positive_parent C D T N h k x bundle - placement s have area_of_band := PresentedRowAdjacencyGeometry.area_of_band have selected_area : TileArea (bundle.pieces bundle.selectedSlot bundle.selectedSign) = diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean index 1214b5a00f..431331b909 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.BandOriginalParentContainment @@ -651,45 +652,7 @@ private theorem faceTable : neg_add_cancel, P4418T3EndpointOwnerIndices, exists_and_left, exists_and_right, selectedSecondFace, F0, face0, owners, F1, face1, zero_add, zero_sub, sub_self] <;> decide -private theorem reversePath : - (by - classical - exact - ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ - {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween V E y x) - ) := by - classical - intro V E x y h - rcases h with ⟨p, hnd, hlen, hh, hl, hV, hstep, hE⟩ - have reverseRaw (r : List GaussianInt) (e : Finset GaussianInt) : - (∃ a b l₁ l₂, r = l₁ ++ a :: b :: l₂ ∧ e = {a,b}) → - ∃ a b l₁ l₂, r.reverse = l₁ ++ a :: b :: l₂ ∧ e = {a,b} := by - rintro ⟨a, b, l₁, l₂, hr, he⟩ - refine ⟨b, a, l₂.reverse, l₁.reverse, ?_, ?_⟩ - · rw [hr] - simp [List.reverse_append, List.append_assoc] - · simpa [Finset.pair_comm] using he - refine ⟨p.reverse, List.nodup_reverse.mpr hnd, ?_, ?_, ?_, ?_, ?_, ?_⟩ - · simpa using hlen - · simpa using hl - · simpa using hh - · simpa using hV - · intro a b l₁ l₂ hr - have hp : p = l₂.reverse ++ b :: a :: l₁.reverse := by - have hh := congrArg List.reverse hr - simpa [List.reverse_append, List.append_assoc] using hh - rcases hstep b a l₂.reverse l₁.reverse hp with h | h | h | h - · exact Or.inr (Or.inl (by rw [h]; simp)) - · exact Or.inl (by rw [h]; simp) - · exact Or.inr (Or.inr (Or.inr (by rw [h]; simp))) - · exact Or.inr (Or.inr (Or.inl (by rw [h]; simp))) - · intro e - constructor - · intro he - exact reverseRaw p e ((hE e).mp he) - · intro he - apply (hE e).mpr - simpa using reverseRaw p.reverse e he +private abbrev reversePath := @SimpleGridPathBetween.reverse private theorem allowed : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean b/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean index 23862ca544..7eca13555d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean @@ -654,13 +654,13 @@ private theorem hsetAt539 : (by classical exact - (Nat) → (∀ (w : GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : ℕ), ∀ (b : + (∀ (w : GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), (x = w + ⟨(↑a : ℤ), (↑b : ℤ)⟩) → (∀ (c : ℕ), ∀ (d : ℕ), (y = w + ⟨(↑c : ℤ), (↑d : ℤ)⟩) → ((a = c + 1 ∧ b = d) → (({x,y} : Finset GaussianInt) = {w + (⟨(c : Int), (d : Int)⟩ : GaussianInt), w + (⟨((c+1 : Nat) : Int), (d : Int)⟩ : GaussianInt)})))) ) := by classical - intro n w x y a b hxcoord c d hycoord hcd + intro w x y a b hxcoord c d hycoord hcd rw [hxcoord, hycoord, hcd.1, hcd.2] apply Finset.ext intro q @@ -745,13 +745,13 @@ private theorem hsetAt580 : (by classical exact - (Nat) → (∀ (w : GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : ℕ), ∀ (b : + (∀ (w : GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), (x = w + ⟨(↑a : ℤ), (↑b : ℤ)⟩) → (∀ (c : ℕ), ∀ (d : ℕ), (y = w + ⟨(↑c : ℤ), (↑d : ℤ)⟩) → ((a = c ∧ b = d + 1) → (({x,y} : Finset GaussianInt) = {w + (⟨(c : Int), (d : Int)⟩ : GaussianInt), w + (⟨(c : Int), ((d+1 : Nat) : Int)⟩ : GaussianInt)})))) ) := by classical - intro n w x y a b hxcoord c d hycoord hcd + intro w x y a b hxcoord c d hycoord hcd rw [hxcoord, hycoord, hcd.1, hcd.2] apply Finset.ext intro q @@ -881,8 +881,8 @@ theorem P4456T2SquareEdges (n : Nat) (hn : 0 < n) have hcd : a = c + 1 ∧ b = d := SquareEdgeDetails.hcdAt532 n w a b c d heq have hset : ({x,y} : Finset GaussianInt) = {w + (⟨(c : Int), (d : Int)⟩ : GaussianInt), - w + (⟨((c+1 : Nat) : Int), (d : Int)⟩ : GaussianInt)} := SquareEdgeDetails.hsetAt539 - n w x y a b hxcoord c d hycoord hcd + w + (⟨((c+1 : Nat) : Int), (d : Int)⟩ : GaussianInt)} := + SquareEdgeDetails.hsetAt539 w x y a b hxcoord c d hycoord hcd rw [hset, Finset.pair_comm] simpa [Finset.pair_comm] using hEdgeH c d (by omega) (by omega) · have heq : w + (⟨(c : Int), (d : Int)⟩ : GaussianInt) = @@ -901,8 +901,8 @@ theorem P4456T2SquareEdges (n : Nat) (hn : 0 < n) have hcd : a = c ∧ b = d + 1 := SquareEdgeDetails.hcdAt573 n w a b c d heq have hset : ({x,y} : Finset GaussianInt) = {w + (⟨(c : Int), (d : Int)⟩ : GaussianInt), - w + (⟨(c : Int), ((d+1 : Nat) : Int)⟩ : GaussianInt)} := SquareEdgeDetails.hsetAt580 - n w x y a b hxcoord c d hycoord hcd + w + (⟨(c : Int), ((d+1 : Nat) : Int)⟩ : GaussianInt)} := + SquareEdgeDetails.hsetAt580 w x y a b hxcoord c d hycoord hcd rw [hset, Finset.pair_comm] simpa [Finset.pair_comm] using hEdgeV c d (by omega) (by omega) diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean index a97909a6ae..6079b8dd4f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean @@ -37,11 +37,12 @@ private theorem hnegativeSlope : ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), (Fin (4 : ℕ) → CircleCoordinates) → ((0 < (F.q + P4458T1RestrictionFamily F), + ((0 < (F.q F.slot.succ).1) → (∃ s, PartialOdometerSlope (D.functions F.slot false) = some s)) ) := by classical - intro C orientation base Rminus Rplus hminus hplus F D p hCpositive + intro C orientation base Rminus Rplus hminus hplus F D hCpositive rcases D.slopes F.slot false with hz | ⟨root, child, hroot, hchild, _, _⟩ · omega · exact ⟨child, hchild⟩ @@ -270,18 +271,19 @@ private theorem hSlopeInfo : ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), (Fin (4 : ℕ) → CircleCoordinates) → ((0 < (F.q + P4458T1RestrictionFamily F), + ((0 < (F.q F.slot.succ).1) → ( let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let wa : GaussianInt := BandVectors.2 (r 3) (r 2) + F.q ((F.slot + 2).succ)]; + let wa : GaussianInt := BandVectors.2 (r 3) (r 2); ∃ root child : ℝ × ℝ, PartialOdometerSlope F.odometer = some root ∧ PartialOdometerSlope (D.functions F.slot false) = some child ∧ child.1 - root.1 = -(1 / 2 : ℝ) * (((wa.re : ℤ) : ℝ) - ((wa.im : ℤ) : ℝ)) ∧ child.2 - root.2 = -(1 / 2 : ℝ) * (((wa.im : ℤ) : ℝ) + ((wa.re : ℤ) : ℝ)))) ) := by classical - intro C orientation base Rminus Rplus hminus hplus F D p hCpositive r wa + intro C orientation base Rminus Rplus hminus hplus F D hCpositive r wa rcases D.slopes F.slot false with hz | ⟨root, child, hroot, hchild, hre, him⟩ · have hz' : (F.q F.slot.succ).1 = 0 := hz omega @@ -595,18 +597,19 @@ private theorem ha10ReAt509 : exact ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), (Fin (3 : - ℕ)) → ((Fin (4 : ℕ) → CircleCoordinates) → ( + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + ( + ( let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let I : GaussianInt := ⟨0, 1⟩ - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + F.q ((F.slot + 2).succ)]; + let I : GaussianInt := ⟨0, 1⟩; + let xa : GaussianInt := BandVectors.2 (r 1) (r 3); + let ya : GaussianInt := BandVectors.2 (r 2) (r 1); (BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.2 (r 1) (r 0)).re = xa.re - ya.im))) ) := by classical - intro C orientation base Rminus Rplus hminus hplus F a p r I xa ya harec + intro C orientation base Rminus Rplus hminus hplus F r I xa ya harec have h := congrArg (fun z : GaussianInt => z.re) harec norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ omega @@ -661,18 +664,19 @@ private theorem ha01ImAt522 : exact ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), (Fin (3 : - ℕ)) → ((Fin (4 : ℕ) → CircleCoordinates) → ( + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + ( + ( let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let I : GaussianInt := ⟨0, 1⟩ - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + F.q ((F.slot + 2).succ)]; + let I : GaussianInt := ⟨0, 1⟩; + let xa : GaussianInt := BandVectors.2 (r 1) (r 3); + let ya : GaussianInt := BandVectors.2 (r 2) (r 1); (BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → (((BandVectors.2 (r 1) (r 0)).re = xa.re - ya.im) → ((BandVectors.2 (r 0) (r 1)).im = -xa.re + ya.im)))) ) := by classical - intro C orientation base Rminus Rplus hminus hplus F a p r I xa ya haflip ha10Re + intro C orientation base Rminus Rplus hminus hplus F r I xa ya haflip ha10Re have h := congrArg (fun z : GaussianInt => z.im) haflip simp only [Int.reduceNeg, Fin.isValue, neg_mul, Zsqrtd.im_neg, Zsqrtd.im_mul, zero_mul, one_mul, zero_add, I] at h @@ -705,17 +709,17 @@ private theorem hplusImVec : exact ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), (Fin (3 : - ℕ)) → (∀ (p : Fin (4 : ℕ) → CircleCoordinates), + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + (∀ (p : Fin (4 : ℕ) → CircleCoordinates), let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let I : GaussianInt := ⟨0, 1⟩ - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) + F.q ((F.slot + 2).succ)]; + let I : GaussianInt := ⟨0, 1⟩; + let xa : GaussianInt := BandVectors.2 (r 1) (r 3); (BandVectors.2 (p 2) (p 0) = xa) → ((BandVectors.2 (p 0) (p 2) = -I * xa) → ((BandVectors.2 (p 2) (p 0) + BandVectors.2 (p 0) (p 2)).im = xa.im - xa.re))) ) := by classical - intro C orientation base Rminus Rplus hminus hplus F a p r I xa haBA haAB + intro C orientation base Rminus Rplus hminus hplus F p r I xa haBA haAB rw [haBA, haAB] norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] omega @@ -1851,18 +1855,19 @@ private theorem ha01ReAt959 : exact ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), (Fin (3 : - ℕ)) → ((Fin (4 : ℕ) → CircleCoordinates) → ( + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + ( + ( let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let I : GaussianInt := ⟨0, 1⟩ - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + F.q ((F.slot + 2).succ)]; + let I : GaussianInt := ⟨0, 1⟩; + let xa : GaussianInt := BandVectors.2 (r 1) (r 3); + let ya : GaussianInt := BandVectors.2 (r 2) (r 1); (BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → (((BandVectors.2 (r 1) (r 0)).im = xa.im + ya.re) → ((BandVectors.2 (r 0) (r 1)).re = xa.im + ya.re)))) ) := by classical - intro C orientation base Rminus Rplus hminus hplus F a p r I xa ya haflip ha10Im + intro C orientation base Rminus Rplus hminus hplus F r I xa ya haflip ha10Im have h := congrArg (fun z : GaussianInt => z.re) haflip norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ omega @@ -1873,18 +1878,19 @@ private theorem ha01ImAt963 : exact ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), (Fin (3 : - ℕ)) → ((Fin (4 : ℕ) → CircleCoordinates) → ( + (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + ( + ( let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let I : GaussianInt := ⟨0, 1⟩ - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - let ya : GaussianInt := BandVectors.2 (r 2) (r 1) + F.q ((F.slot + 2).succ)]; + let I : GaussianInt := ⟨0, 1⟩; + let xa : GaussianInt := BandVectors.2 (r 1) (r 3); + let ya : GaussianInt := BandVectors.2 (r 2) (r 1); (BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → (((BandVectors.2 (r 1) (r 0)).re = xa.re - ya.im) → ((BandVectors.2 (r 0) (r 1)).im = -xa.re + ya.im)))) ) := by classical - intro C orientation base Rminus Rplus hminus hplus F a p r I xa ya haflip ha10Re + intro C orientation base Rminus Rplus hminus hplus F r I xa ya haflip ha10Re have h := congrArg (fun z : GaussianInt => z.im) haflip norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ omega @@ -2166,12 +2172,11 @@ private theorem hidxB2 : (by classical exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), - (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → (∀ (a : Fin - (3 : ℕ)), (Fin (4 : ℕ) → CircleCoordinates) → ((a + 1) + 2 = a)) ) := by + (∀ (a : Fin + (3 : ℕ)), + ((a + 1) + 2 = a)) ) := by classical - intro C orientation base Rminus Rplus hminus hplus F a p + intro a apply Fin.ext simp [Fin.val_add]; omega @@ -3343,8 +3348,7 @@ private theorem secondParentPlacement : TileOdometerBandPrototile (p 2) (D.tiles (a + 1) true) (D.functions (a + 1) true) houterBOdo have ht1C : t 1 = C.1.1 := ht1.trans hparentD - have hidxB2 := SecondNewerRowsGeometry.hidxB2 C orientation base Rminus Rplus hminus hplus - F a p + have hidxB2 := SecondNewerRowsGeometry.hidxB2 a have hidxB1 := SecondNewerRowsGeometry.hidxB1 a have hBocc := SecondNewerRowsGeometry.hBocc C orientation base Rminus Rplus hminus hplus F D a p hqA hqD hr1 hr2 hidxB2 hidxB1 @@ -3732,17 +3736,17 @@ private theorem directParentCase : have hFplusIm := SecondNewerRowsGeometry.hFplusIm C orientation base Rminus Rplus hminus hplus F rootSlope hFplusSlope have ha10Re := SecondNewerRowsGeometry.ha10ReAt509 C orientation base Rminus Rplus hminus - hplus F a p harec + hplus F harec have ha10Im := SecondNewerRowsGeometry.ha10ImAt513 C orientation base Rminus Rplus hminus hplus F harec have ha01Re := SecondNewerRowsGeometry.ha01ReAt517 C orientation base Rminus Rplus hminus hplus F haflip ha10Im have ha01Im := SecondNewerRowsGeometry.ha01ImAt522 C orientation base Rminus Rplus hminus - hplus F a p haflip ha10Re + hplus F haflip ha10Re have hplusReVec := SecondNewerRowsGeometry.hplusReVec C orientation base Rminus Rplus hminus hplus F p haBA haAB have hplusImVec := SecondNewerRowsGeometry.hplusImVec C orientation base Rminus Rplus - hminus hplus F a p haBA haAB + hminus hplus F p haBA haAB have hFplusRe' := SecondNewerRowsGeometry.hFplusRe' C orientation base Rminus Rplus hminus hplus F rootSlope toRealRe hFplusRe have hFplusIm' := SecondNewerRowsGeometry.hFplusIm' C orientation base Rminus Rplus hminus @@ -3927,13 +3931,13 @@ private theorem recursiveParentCase : have hAIm' := SecondNewerRowsGeometry.hAIm'At948 C orientation base Rminus Rplus hminus hplus F a p hqB hqD hr1 hr3 rootA slopeA hAIm have ha10Re := SecondNewerRowsGeometry.ha10ReAt509 C orientation base Rminus Rplus hminus - hplus F a p harec + hplus F harec have ha10Im := SecondNewerRowsGeometry.ha10ImAt955 C orientation base Rminus Rplus hminus hplus F harec have ha01Re := SecondNewerRowsGeometry.ha01ReAt959 C orientation base Rminus Rplus hminus - hplus F a p haflip ha10Im + hplus F haflip ha10Im have ha01Im := SecondNewerRowsGeometry.ha01ImAt963 C orientation base Rminus Rplus hminus - hplus F a p haflip ha10Re + hplus F haflip ha10Re have hyaA : ya = BandVectors.2 (p 0) (p 3) := by simp [ya, hr1, hr2] have ha10ReR : ((BandVectors.2 (r 1) (r 0)).re : ℝ) = @@ -4004,7 +4008,7 @@ theorem P4458T1SecondNewerRows : have hselectedOdo := D.odometers F.slot false have hselectedOcc := D.occurrences F.slot false have hnegativeSlope := SecondNewerRowsGeometry.hnegativeSlope C orientation base Rminus Rplus - hminus hplus F D p hCpositive + hminus hplus F D hCpositive let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), F.q ((F.slot + 2).succ)] @@ -4110,7 +4114,7 @@ theorem P4458T1SecondNewerRows : have hslot := SecondNewerRowsGeometry.hslot C orientation base Rminus Rplus hminus hplus F a p selected have hSlopeInfo := SecondNewerRowsGeometry.hSlopeInfo C orientation base Rminus Rplus hminus - hplus F D p hCpositive + hplus F D hCpositive obtain ⟨rootNeg, joinSlope, hrootNeg, hjoinSlope, hjoinSlopeRe, hjoinSlopeIm⟩ := hSlopeInfo have hrootNegEq : rootNeg = F.outerSlope := diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean b/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean index 6da23594a1..2b188d608e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean @@ -87,7 +87,8 @@ private theorem hb : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (FordFareyParameter) → (((q (2 : Fin (4 : ℕ))).1 ≤ (q + ∀ (q : Fin 4 → CircleCoordinates), + (((q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1) → (((1 : ℤ) < (q (2 : Fin (4 : ℕ))).1) → (((0 : ℤ) < (q (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) → @@ -97,7 +98,7 @@ private theorem hb : Fin (3 : ℕ))).succ, q (b + (2 : Fin (3 : ℕ))).succ] = FordRecursiveQuadruple F') → (b = 0))))))) ) := by classical - intro q F h12 hlarge qcur hlineq b h F' hzero hnorm + intro q h12 hlarge qcur hlineq b h F' hzero hnorm fin_cases b · rfl · have := qcur.2.1 0 @@ -1074,7 +1075,7 @@ theorem P4564T2FordT6Transport : have hlineq := FordT6Geometry.hlineq q hq a g F hnormal h12 hlarge qcur obtain ⟨b, h, F', hF', hrev, hword, hzero, hnorm⟩ := FordRegimeConverse q hq hlineq - have hb := FordT6Geometry.hb q F h12 hlarge qcur hlineq b h F' hzero hnorm + have hb := FordT6Geometry.hb q h12 hlarge qcur hlineq b h F' hzero hnorm subst b have hnormq := FordT6Geometry.hnormq q h F' hnorm obtain ⟨negative, hphase, hphaseR, hphaseT, hcircle, horientation, diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean index 2915311956..f6bc14c64b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean +++ b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean @@ -1623,25 +1623,26 @@ private theorem hwAt1679 : exact ∀ (L : AddSubgroup GaussianInt), ∀ (k : (Int × Int) ≃+ L), ∀ (D : P4812T1AffineDrawing L k), ∀ (T : ProtoTile), - let a : L := k (1, 0) - let b : L := k (0, 1) - ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), (↥L) → ( + let a : L := k (1, 0); + let b : L := k (0, 1); + ∀ (ru : GaussianInt), ∀ (rd : GaussianInt), + ( let rho : D.plane.Face → GaussianInt := fun f => match D.faces.symm f with | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) - | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt) + | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt); ∀ (p2 : List GaussianInt), (∀ (w : L), P4733T1ContainedWalk (TileTranslation T ((w + a : L) : GaussianInt)) (TileTranslation T ((w - b : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho (D.faces (.inr (w + a - b)))) (p2.map (fun z => z + (w : GaussianInt)))) → (∀ (y : ↥L), - let w := y + b - let fc := D.faces (.inl w) - let gc := D.faces (.inr (w + a - b)) + let w := y + b; + let fc := D.faces (.inl w); + let gc := D.faces (.inr (w + a - b)); P4733T1ContainedWalk (TileTranslation T ((w + a : L) : GaussianInt)) (TileTranslation T ((w - b : L) : GaussianInt)) (rho fc) (rho gc) (p2.map (fun z => z + (w : GaussianInt)))))) := by classical - intro L k D T a b ru rd x rho p2 rowWalk2 y w fc gc + intro L k D T a b ru rd rho p2 rowWalk2 y w fc gc exact rowWalk2 w end RegularFaceDetails @@ -2368,7 +2369,7 @@ private theorem thirdBackward : (TileTranslation T ((w + a : L) : GaussianInt)) (TileTranslation T ((w - b : L) : GaussianInt)) (rho fc) (rho gc) (p2.map (fun z => z + (w : GaussianInt))) := RegularFaceDetails.hwAt1679 L k D T - ru rd x p2 rowWalk2 y + ru rd p2 rowWalk2 y have hwxG : ((w + a : L) : GaussianInt) = (x : GaussianInt) := congrArg (fun z : L => z.1) hwx have hwyG : ((w - b : L) : GaussianInt) = (y : GaussianInt) := diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean b/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean index 8e3f7544f8..8732608d98 100644 --- a/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean +++ b/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean @@ -309,21 +309,6 @@ private theorem hCcomponent : change reach x z exact Relation.ReflTransGen.tail hy he -private theorem hz₀not : - ∀ (q : IntegerLatticeFunction), (ℤ) → (ℕ) → - let S : Set GaussianInt := {x | 0 < q x} - let edge (x y : GaussianInt) : Prop := - FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S - let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y - ∀ (x : GaussianInt), ∀ (z₀ : GaussianInt), (q z₀ = 0) → - let C : Set GaussianInt := {y | reach x y} - (C ⊆ S) → z₀ ∉ C := by - classical - intro q M N S edge reach x z₀ hz₀ C hCpos hz - have hpos := hCpos hz - change 0 < q z₀ at hpos - omega - private theorem firstExit : ∀ (q : IntegerLatticeFunction), let S : Set GaussianInt := {x | 0 < q x} @@ -344,17 +329,18 @@ private theorem firstExit : · exact ih hbC private theorem hzEq : - ∀ (q : IntegerLatticeFunction), (ℤ) → (∀ x, 0 ≤ q x) → (ℕ) → - let S : Set GaussianInt := {x | 0 < q x} + ∀ (q : IntegerLatticeFunction), + (∀ x, 0 ≤ q x) → + let S : Set GaussianInt := {x | 0 < q x}; let edge (x y : GaussianInt) : Prop := - FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S - let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y - ∀ (x : GaussianInt), (GaussianInt) → - let C : Set GaussianInt := {y | reach x y} + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S; + let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y; + ∀ (x : GaussianInt), + let C : Set GaussianInt := {y | reach x y}; (P4849T1Component S C) → ∀ (a : GaussianInt), ∀ (z : GaussianInt), (a ∈ C) → (z ∉ C) → (FourNeighborAdjacent a z) → q z = 0 := by classical - intro q M hq N S edge reach x z₀ C hCcomponent a z haC hzC haz + intro q hq S edge reach x C hCcomponent a z haC hzC haz by_contra hn have hqn := hq z have hpos : 0 < q z := by omega @@ -363,22 +349,23 @@ private theorem hzEq : exact hzC hzIn private theorem hNoBig : - ∀ (q : IntegerLatticeFunction), (ℤ) → ∀ (N : ℕ), (¬∃ (C : Set GaussianInt), + ∀ (q : IntegerLatticeFunction), + ∀ (N : ℕ), (¬∃ (C : Set GaussianInt), P4849T1Component {x : GaussianInt | 0 < q x} C ∧ ∃ (z : GaussianInt) (a : GaussianInt), q z = 0 ∧ a ∈ C ∧ FourNeighborAdjacent z a ∧ ∃ (F : Finset GaussianInt), (↑F : Set GaussianInt) ⊆ C ∧ N < F.card) → - let S : Set GaussianInt := {x | 0 < q x} + let S : Set GaussianInt := {x | 0 < q x}; let edge (x y : GaussianInt) : Prop := - FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S - let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y + FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S; + let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y; (∀ {x : GaussianInt}, ∀ {y : GaussianInt}, (FourNeighborAdjacent x y) → FourNeighborAdjacent - y x) → ∀ (x : GaussianInt), (GaussianInt) → - let C : Set GaussianInt := {y | reach x y} + y x) → ∀ (x : GaussianInt), + let C : Set GaussianInt := {y | reach x y}; (P4849T1Component S C) → ∀ (a : GaussianInt), ∀ (z : GaussianInt), (a ∈ C) → (FourNeighborAdjacent a z) → (q z = 0) → ∀ (F : Finset GaussianInt), ((↑F : Set GaussianInt) ⊆ C) → F.card ≤ N := by classical - intro q M N hbad S edge reach adjSymm x z₀ C hCcomponent a z haC haz hzEq F hF + intro q N hbad S edge reach adjSymm x C hCcomponent a z haC haz hzEq F hF by_contra hcard have hgt : N < F.card := by omega apply hbad @@ -438,17 +425,24 @@ theorem P4849T1LargePositiveComponents (q : IntegerLatticeFunction) (M : ℤ) have hCconn : FourNeighborConnected C := PositiveComponentLemmas.hCconn q reachSymm chainReach reachWalk x hxC hCpos have hCcomponent : P4849T1Component S C := PositiveComponentLemmas.hCcomponent q x hCpos hCconn - have hz₀not : z₀ ∉ C := PositiveComponentLemmas.hz₀not q M N x z₀ hz₀ hCpos + have hz₀not : z₀ ∉ C := (show + z₀ ∉ C + from by + classical + intro hz + have hpos := hCpos hz + change 0 < q z₀ at hpos + omega) have firstExit {a b : GaussianInt} (h : Relation.ReflTransGen FourNeighborAdjacent a b) (ha : a ∈ C) (hb : b ∉ C) : ∃ y z, y ∈ C ∧ z ∉ C ∧ FourNeighborAdjacent y z := PositiveComponentLemmas.firstExit q x (a := a) (b := b) h ha hb obtain ⟨a, z, haC, hzC, haz⟩ := firstExit (gridReach x z₀) hxC hz₀not - have hzEq : q z = 0 := PositiveComponentLemmas.hzEq q M hq N x z₀ hCcomponent a z haC hzC haz + have hzEq : q z = 0 := PositiveComponentLemmas.hzEq q hq x hCcomponent a z haC hzC haz have hNoBig (F : Finset GaussianInt) - (hF : (↑F : Set GaussianInt) ⊆ C) : F.card ≤ N := PositiveComponentLemmas.hNoBig q M N hbad - adjSymm x z₀ hCcomponent a z haC haz hzEq F hF + (hF : (↑F : Set GaussianInt) ⊆ C) : F.card ≤ N := PositiveComponentLemmas.hNoBig q N hbad + adjSymm x hCcomponent a z haC haz hzEq F hF by_cases hN : N = 0 · have hsingle : (↑({x} : Finset GaussianInt) : Set GaussianInt) ⊆ C := by intro y hy diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean b/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean index c8e8db85c9..3f1eda0620 100644 --- a/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean +++ b/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean @@ -454,23 +454,24 @@ private theorem hunitEq : exact ∀ (L : ℝ), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : ℕ)), - let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) - let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ); + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ); (0 < (q i.succ).1) → ( - let A : ℂ := p i.succ - ((q i.succ).1 ≠ 0) → ( + let A : ℂ := p i.succ; + ( let V (a : Fin 3) : ℂ := if (q a.succ).1 = 0 then ⟨if (q a.succ).2 = -1 then L else L + 2, A.im⟩ else ((q i.succ).2 + (q a.succ).2 : ℂ) / - (((q i.succ).1 : ℝ) + ((q a.succ).1 : ℝ)) - ((0 : ℤ) < (q a.succ).1) → ((0 < (q a.succ).1) → ((V a - A = ((q a.succ).1 : ℂ) / ((((q + (((q i.succ).1 : ℝ) + ((q a.succ).1 : ℝ)); + ((0 : ℤ) < (q a.succ).1) → ( + ((V a - A = ((q a.succ).1 : ℂ) / ((((q i.succ).1 + (q a.succ).1 : ℤ) : ℂ)) * (p a.succ - A)) → ((rad i.succ + rad a.succ = (((q i.succ).1 + (q a.succ).1 : ℤ) : ℝ) / (((q i.succ).1 * (q a.succ).1 : ℤ) : ℝ)) → ((V a - A) / (rad i.succ : ℂ) = (p a.succ - A) / ((rad i.succ + rad a.succ : ℝ) : ℂ))))))) ) := by classical - intro L q i a p rad hparent A hparne V hapos haposZ hrel hsumRad + intro L q i a p rad hparent A V hapos hrel hsumRad rw [hrel] rw [hsumRad] dsimp [rad] @@ -642,13 +643,12 @@ private theorem hextra : classical exact ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : ℕ)), - let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) - let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) - (dist (p a.succ) (p 0) = rad a.succ + rad 0) → ((0 < (q i.succ).1) → ((0 < rad 0) → ((0 < + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ); + ((0 < (q i.succ).1) → ((0 < rad 0) → ((0 < (rad i.succ + rad a.succ) * (rad i.succ + rad 0)) → (0 < (2 * rad i.succ * rad 0) / ((rad i.succ + rad a.succ) * (rad i.succ + rad 0)))))) ) := by classical - intro q i a p rad hchild hparent hR hposden + intro q i a rad hparent hR hposden exact div_pos (by positivity) hposden private theorem hid : @@ -1159,7 +1159,7 @@ theorem P5023T1CircularSide : hapos have hunitEq : (V a - A) / (rad i.succ : ℂ) = (p a.succ - A) / ((rad i.succ + rad a.succ : ℝ) : ℂ) := CircularSideProof.hunitEq L q - i a hparent hparne hapos haposZ hrel hsumRad + i a hparent hapos hrel hsumRad have hdistParent : ‖p a.succ - A‖ = rad i.succ + rad a.succ := CircularSideProof.hdistParent q i a hcenter have hunitNorm : ‖(V a - A) / (rad i.succ : ℂ)‖ = 1 := CircularSideProof.hunitNorm L q i @@ -1187,7 +1187,7 @@ theorem P5023T1CircularSide : have hposden : 0 < (rad i.succ + rad a.succ) * (rad i.succ + rad 0) := by positivity have hextra : 0 < (2 * rad i.succ * rad 0) / ((rad i.succ + rad a.succ) * (rad i.succ + rad 0)) := CircularSideProof.hextra q i - a hchild hparent hR hposden + a hparent hR hposden have hid : (((rad i.succ + rad a.succ) ^ 2 + (rad i.succ + rad 0) ^ 2 - (rad a.succ + rad 0) ^ 2) / 2) / ((rad i.succ + rad a.succ) * (rad i.succ + rad 0)) = diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1ContactHull.lean b/LeanPool/ApollonianSuperharmonic/P5023T1ContactHull.lean index c7a82ae3f3..33d8b1231a 100644 --- a/LeanPool/ApollonianSuperharmonic/P5023T1ContactHull.lean +++ b/LeanPool/ApollonianSuperharmonic/P5023T1ContactHull.lean @@ -32,14 +32,6 @@ namespace ApollonianSuperharmonic namespace ContactHullLemmas -private theorem curv : - ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → 0 < (q 0).1 ∧ (∀ (i : Fin 3), 0 - ≤ (q i.succ).1) ∧ ∀ (i : Fin 3), ∀ (j : Fin 3), (q i.succ).1 = 0 → (q j.succ).1 = 0 → i = - j := by - classical - intro q hq - exact ProperBandCurvatureStructure q hq - private theorem pair : ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) @@ -138,7 +130,7 @@ theorem P5023T1ContactHull (L : ℝ) (q : Fin 4 → CircleCoordinates) classical let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) - have curv := ContactHullLemmas.curv q hq + have curv := ProperBandCurvatureStructure q hq have pair (i j : Fin 4) (hij : i ≠ j) (hi : 0 < (q i).1) (hj : 0 < (q j).1) : dist (p i) (p j) = r i + r j ∧ diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean b/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean index aa2fb25c87..218c16e3e1 100644 --- a/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean +++ b/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean @@ -30,16 +30,6 @@ namespace ApollonianSuperharmonic namespace SameParentOverlapLemmas -private theorem harith : - ∀ (P : FordFareyParameter), (1 < P.q) → 0 < P.q₁ ∧ - P.q₁ < P.q ∧ - 0 < P.q₂ ∧ - P.q₂ < P.q ∧ P.q₁.Coprime P.p₁.natAbs ∧ P.q₂.Coprime P.p₂.natAbs ∧ P.p₁ * (↑P.q₂ : ℤ) - - P.p₂ * (↑P.q₁ : ℤ) = 1 := by - classical - intro P hq - exact P5130T5ParentArithmetic P hq - private theorem hq1 : ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → P₁.q = P.q₁ := by classical @@ -284,7 +274,7 @@ theorem P5130T5SameParentOverlaps (P P₁ P₂ : FordFareyParameter) x) := by -- BODY dsimp - have harith := SameParentOverlapLemmas.harith P hq + have harith := P5130T5ParentArithmetic P hq rcases harith with ⟨hq1pos, hq1lt, hq2pos, hq2lt, hred1, hred2, hcross⟩ have hq1 : P₁.q = P.q₁ := SameParentOverlapLemmas.hq1 P P₁ hq₁ have hq2 : P₂.q = P.q₂ := SameParentOverlapLemmas.hq2 P P₂ hq₂ diff --git a/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean b/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean index b0f9051b88..e9ec79f464 100644 --- a/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple @@ -108,16 +109,6 @@ private theorem rawBoundaryVertices : simp [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] exact ⟨boundaryRaw X hX hz.1, boundaryRaw Y hY hz.2⟩ -private theorem rawBoundaryEdges : - (by - classical - exact - ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (Disjoint X.cells Y.cells) → (FootprintEdges X ∩ - FootprintEdges Y = BoundaryFootprintEdges X ∩ BoundaryFootprintEdges Y) ) := by - classical - intro X Y hdisj - exact CellDisjointCommonEdgesBoundary X Y hdisj - private theorem staircaseBetween : (by classical @@ -417,38 +408,7 @@ private theorem diamondCellsNonempty : norm_num omega -private theorem reversePath : - (by - classical - exact - ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ - {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween V E y x) - ) := by - classical - intro V E x y hp - rcases hp with ⟨p, hn, hl, hh, ht, hV, hs, he⟩ - have revstep : ∀ a b l₁ l₂, p.reverse = l₁ ++ a :: b :: l₂ → - b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ := by - intro a b l₁ l₂ h - have h' : p = l₂.reverse ++ b :: a :: l₁.reverse := by - have := congrArg List.reverse h - simpa [List.reverse_append, List.append_assoc] using this - rcases hs b a _ _ h' with h | h | h | h - · exact Or.inr (Or.inl (by rw [h]; simp)) - · exact Or.inl (by rw [h]; simp) - · exact Or.inr (Or.inr (Or.inr (by rw [h]; simp))) - · exact Or.inr (Or.inr (Or.inl (by rw [h]; simp))) - have revocc (q : List GaussianInt) (e : Finset GaussianInt) - (ho : ∃ a b l₁ l₂, q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) : - ∃ a b l₁ l₂, q.reverse = l₁ ++ a :: b :: l₂ ∧ e = {a, b} := by - rcases ho with ⟨a, b, l₁, l₂, rfl, rfl⟩ - exact ⟨b, a, l₂.reverse, l₁.reverse, - by simp [List.reverse_append, List.append_assoc], Finset.pair_comm _ _⟩ - refine ⟨p.reverse, List.nodup_reverse.mpr hn, by simpa using hl, - by simpa using ht, by simpa using hh, by simpa using hV, revstep, ?_⟩ - intro e - exact ⟨fun h => revocc p e ((he e).mp h), fun h => - (he e).mpr (by simpa using revocc p.reverse e h)⟩ +private abbrev reversePath := @SimpleGridPathBetween.reverse private theorem translatedDiamondCellsNonempty : (by @@ -3089,7 +3049,7 @@ theorem P5260T1PredecessorInterfaces (k : Nat) (hk : 1 < k) (b : Bool) : -- BODY classical have rawBoundaryVertices := PredecessorInterfaceGeometry.rawBoundaryVertices - have rawBoundaryEdges := PredecessorInterfaceGeometry.rawBoundaryEdges + have rawBoundaryEdges := CellDisjointCommonEdgesBoundary have rawStaircase := PredecessorInterfaceGeometry.rawStaircase rawBoundaryVertices rawBoundaryEdges (PredecessorInterfaceGeometry.staircaseBetween k) have twoVertexPath := PredecessorInterfaceGeometry.twoVertexPath k diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean b/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean index e3aa948969..fd35046142 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean @@ -97,37 +97,7 @@ private theorem staircaseBetween : obtain ⟨j, hj, rfl, rfl⟩ := consecutive a b l₁ l₂ heq exact ⟨j, hj, rfl⟩ -private theorem reversePath : - (by - classical - exact - ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ - {y : GaussianInt}, SimpleGridPathBetween V E x y → SimpleGridPathBetween V E y x ) := by - classical - intro V E x y hp - rcases hp with ⟨p, hn, hl, hh, ht, hV, hs, he⟩ - have revstep : ∀ a b l₁ l₂, p.reverse = l₁ ++ a :: b :: l₂ → - b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ := by - intro a b l₁ l₂ h - have h' : p = l₂.reverse ++ b :: a :: l₁.reverse := by - have := congrArg List.reverse h - simpa [List.reverse_append, List.append_assoc] using this - rcases hs b a _ _ h' with hh | hh | hh | hh - · exact Or.inr (Or.inl (by rw [hh]; simp)) - · exact Or.inl (by rw [hh]; simp) - · exact Or.inr (Or.inr (Or.inr (by rw [hh]; simp))) - · exact Or.inr (Or.inr (Or.inl (by rw [hh]; simp))) - have revocc (q : List GaussianInt) (e : Finset GaussianInt) - (ho : ∃ a b l₁ l₂, q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) : - ∃ a b l₁ l₂, q.reverse = l₁ ++ a :: b :: l₂ ∧ e = {a, b} := by - rcases ho with ⟨a, b, l₁, l₂, rfl, rfl⟩ - exact ⟨b, a, l₂.reverse, l₁.reverse, - by simp [List.reverse_append, List.append_assoc], Finset.pair_comm _ _⟩ - refine ⟨p.reverse, List.nodup_reverse.mpr hn, by simpa using hl, - by simpa using ht, by simpa using hh, by simpa using hV, revstep, ?_⟩ - intro e - exact ⟨fun h => revocc p e ((he e).mp h), fun h => - (he e).mpr (by simpa using revocc p.reverse e h)⟩ +private abbrev reversePath := @SimpleGridPathBetween.reverse private theorem qstep : (by diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean b/LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean index f017d1ed67..321d27a2a0 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean @@ -146,10 +146,11 @@ private theorem hSouth : simpa [IntegerCeilDiv] using hs private theorem westUnion : - ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((IntegerLatticeFunction) → (((P.q : Int) ≠ 0) - → (∀ (X : ℤ), ((P.q : Int) = (P.q₁ : Int) + P.q₂) → (((0 : ℤ) ≤ X ∧ X ≤ (↑P.q : ℤ) ∧ (0 : + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ( + ( + (∀ (X : ℤ), ((P.q : Int) = (P.q₁ : Int) + P.q₂) → (((0 : ℤ) ≤ X ∧ X ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ (0 : ℤ) ∧ (0 : ℤ) ≤ (↑P.q : ℤ)) → ( - let t : Int := X + let t : Int := X; (∀ (u : Int), ∀ (v : Int), (⟨u,v⟩ : GaussianInt) ∈ (FordTile P.q).cells ↔ 0 ≤ u ∧ u < P.q ∧ 0 ≤ v ∧ v < P.q) → ((∀ (u : Int), ∀ (v : Int), ((⟨u,v⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement) ∈ (FordTile P.q).cells ↔ 0 ≤ u + P.q₂ ∧ u + P.q₂ < P.q ∧ 0 ≤ v + P.q @@ -157,7 +158,7 @@ private theorem westUnion : (⟨t-1,0⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement ∈ (FordTile P.q).cells ↔ 0 < t))))))) := by classical - intro P hq f hqn X hsum hx t rect transRect + intro P hq X hsum hx t rect transRect rw [rect, transRect] constructor · rintro (⟨hlo,_,_,_⟩ | ⟨_,hhi,_,_⟩) <;> omega @@ -166,11 +167,12 @@ private theorem westUnion : exact ⟨by omega, by omega, by omega, by omega⟩ private theorem lowerUnion : - ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((IntegerLatticeFunction) → (((P.q : Int) ≠ 0) - → (∀ (X : ℤ), ((P.q : Int) = (P.q₁ : Int) + P.q₂) → (((0 : ℤ) ≤ X - -(↑P.q₂ : ℤ) ∧ X - + ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ( + ( + (∀ (X : ℤ), ((P.q : Int) = (P.q₁ : Int) + P.q₂) → (((0 : ℤ) ≤ X - -(↑P.q₂ : ℤ) ∧ X - -(↑P.q₂ : ℤ) ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ (0 : ℤ) - -(↑P.q : ℤ) ∧ (0 : ℤ) - -(↑P.q : ℤ) ≤ (↑P.q : ℤ)) → ( - let t : Int := X + let t : Int := X; (∀ (u : Int), ∀ (v : Int), (⟨u,v⟩ : GaussianInt) ∈ (FordTile P.q).cells ↔ 0 ≤ u ∧ u < P.q ∧ 0 ≤ v ∧ v < P.q) → ((∀ (u : Int), ∀ (v : Int), ((⟨u,v⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement) ∈ (FordTile P.q).cells ↔ 0 ≤ u + P.q₂ ∧ u + P.q₂ < P.q ∧ 0 ≤ v + P.q @@ -178,7 +180,7 @@ private theorem lowerUnion : (⟨t,-1⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement ∈ (FordTile P.q).cells ↔ t < P.q₁))))))) := by classical - intro P hq f hqn X hsum hx' t rect transRect + intro P hq X hsum hx' t rect transRect rw [rect, transRect] constructor · rintro (⟨_,_,hlo,_⟩ | ⟨hlo,hhi,_,_⟩) <;> omega @@ -346,12 +348,12 @@ theorem P5332T1RightSecondValues (P : FordFareyParameter) (hq : 1 < P.q) have westUnion : (⟨t-1,0⟩ : GaussianInt) ∈ (FordTile P.q).cells ∨ (⟨t-1,0⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement ∈ - (FordTile P.q).cells ↔ 0 < t := RightSecondValuesProof.westUnion P hq f hqn X hsum hx + (FordTile P.q).cells ↔ 0 < t := RightSecondValuesProof.westUnion P hq X hsum hx rect transRect have lowerUnion : (⟨t,-1⟩ : GaussianInt) ∈ (FordTile P.q).cells ∨ (⟨t,-1⟩ : GaussianInt) - (P5332T1RightRows P 1 0).displacement ∈ - (FordTile P.q).cells ↔ t < P.q₁ := RightSecondValuesProof.lowerUnion P hq f hqn X + (FordTile P.q).cells ↔ t < P.q₁ := RightSecondValuesProof.lowerUnion P hq X hsum hx' rect transRect have centerCell : (⟨t,0⟩ : GaussianInt) ∈ (FordTile P.q).cells := by rw [rect] diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean b/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean index 9956d9d933..f1637a2bbb 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean @@ -259,17 +259,19 @@ private theorem haAt253 : (by classical exact - ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ((IntegerLatticeFunction) → ((Int) → ( - let k : Int := K.1 + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + ( + ( + let k : Int := K.1; let C (p q : Int) : Prop := 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ - -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 - let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1; + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1; (C (⟨-k, k⟩ : GaussianInt).re (⟨-k, k⟩ : GaussianInt).im) → ((U ((⟨-k, k⟩ : GaussianInt).re - (-k - (1 : ℤ))) ((⟨-k, k⟩ : GaussianInt).im - k)) → ((Int.natAbs (1-k) : Int) = k-1))))) ) := by classical - intro K hk f B k C U center unitCenter + intro K hk k C U center unitCenter rw [Int.natCast_natAbs, abs_of_nonpos (by omega : 1-k ≤ 0)] omega @@ -277,17 +279,19 @@ private theorem hbAt256 : (by classical exact - ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ((IntegerLatticeFunction) → ((Int) → ( - let k : Int := K.1 + ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( + ( + ( + let k : Int := K.1; let C (p q : Int) : Prop := 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ - -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 - let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1 + -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1; + let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1; (C (⟨-k, k⟩ : GaussianInt).re (⟨-k, k⟩ : GaussianInt).im) → ((U ((⟨-k, k⟩ : GaussianInt).re - (-k - (1 : ℤ))) ((⟨-k, k⟩ : GaussianInt).im - k)) → (((Int.natAbs (1-k) : Int) = k-1) → ((Int.natAbs (-k) : Int) = k)))))) ) := by classical - intro K hk f B k C U center unitCenter ha + intro K hk k C U center unitCenter ha rw [Int.natCast_natAbs, abs_of_nonpos (by omega : -k ≤ 0)] omega @@ -331,14 +335,14 @@ private theorem hlAt294 : (by classical exact - (DiamondParameter) → (∀ (f : IntegerLatticeFunction), ∀ (B : Int), (∀ (p : Int), ∀ (q : + (∀ (f : IntegerLatticeFunction), ∀ (B : Int), (∀ (p : Int), ∀ (q : Int), FourNeighborLaplacian f ⟨p,q⟩ = (f ⟨p+1,q⟩ - f ⟨p,q⟩) + (f ⟨p-1,q⟩ - f ⟨p,q⟩) + (f ⟨p,q+1⟩ - f ⟨p,q⟩) + (f ⟨p,q-1⟩ - f ⟨p,q⟩)) → ((f ⟨(-1 : ℤ), (0 : ℤ)⟩ = (0 : ℤ)) → ((f ⟨(0 : ℤ), (-1 : ℤ)⟩ = (1 : ℤ) + B) → ((f ⟨(0 : ℤ), (0 : ℤ)⟩ = (1 : ℤ) + B) → ((f ⟨(1 : ℤ), (0 : ℤ)⟩ = (0 : ℤ)) → ((f ⟨(0 : ℤ), (1 : ℤ)⟩ = (0 : ℤ)) → ((f ⟨(0 : ℤ), (0 : ℤ)⟩ = (0 : ℤ)) → (FourNeighborLaplacian f ⟨0,0⟩ = 0)))))))) ) := by classical - intro K f B lap hw hdiffS hdiffZ he hn hc + intro f B lap hw hdiffS hdiffZ he hn hc rw [lap] norm_num only [zero_add, zero_sub] omega @@ -482,8 +486,8 @@ theorem P5352T2FirstUnit (K : DiamondParameter) (hk : 1 < K.1) have hn := child (-k) (k+1) (by dsimp [C]; omega) have hs := child (-k) (k-1) (by dsimp [C]; omega) have hc := child (-k) k (by dsimp [C]; omega) - have ha : (Int.natAbs (1-k) : Int) = k-1 := FirstUnitProof.haAt253 K hk f B center unitCenter - have hb : (Int.natAbs (-k) : Int) = k := FirstUnitProof.hbAt256 K hk f B center unitCenter ha + have ha : (Int.natAbs (1-k) : Int) = k-1 := FirstUnitProof.haAt253 K hk center unitCenter + have hb : (Int.natAbs (-k) : Int) = k := FirstUnitProof.hbAt256 K hk center unitCenter ha simp only [P4207T1DiamondFormula, ha, hb] at he hn hs hc rw [show 1-k-k = 1-2*k by ring, show k-1-1 = k-2 by ring, sqp] at he rw [show -k-(k+1) = -1-2*k by ring, sqm] at hn @@ -516,7 +520,7 @@ theorem P5352T2FirstUnit (K : DiamondParameter) (hk : 1 < K.1) have hn := child 0 1 (by dsimp [C]; omega) have hc := child 0 0 (by dsimp [C]; omega) norm_num [P4207T1DiamondFormula] at he hw hn hc - have hl : FourNeighborLaplacian f ⟨0,0⟩ = 0 := FirstUnitProof.hlAt294 K f B lap hw hdiffS + have hl : FourNeighborLaplacian f ⟨0,0⟩ = 0 := FirstUnitProof.hlAt294 f B lap hw hdiffS hdiffZ he hn hc exact ⟨fun _ => hl, fun h => False.elim (h hmark)⟩ · have hs := covered z.re (z.im-1) diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean index 349bd780a0..db62ee82c7 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean @@ -421,15 +421,17 @@ private theorem qCW : (by classical exact - (DiamondParameter) → ((IntegerLatticeFunction) → ((Int) → (∀ (p : ℤ), ∀ (q : ℤ), ((1 : ℤ) + ( + ( + (∀ (p : ℤ), ∀ (q : ℤ), ((1 : ℤ) ≤ p) → ( let Q : Int → Int → Int := fun a b => - (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4; (q = p - (1 : ℤ)) → ( - let valW : Int := Q (p-1) (p-1) + let valW : Int := Q (p-1) (p-1); valW = (p-1)*(p-2)/2))))) ) := by classical - intro K f B p q hp1 Q hq valW + intro p q hp1 Q hq valW simp [valW, Q, abs_of_nonneg (show 0 ≤ p-1 by omega)] ring @@ -461,16 +463,18 @@ private theorem qP0 : (by classical exact - ∀ (K : DiamondParameter), (IntegerLatticeFunction) → ((Int) → ( - let k : Int := K.1 + ∀ (K : DiamondParameter), + ( + ( + let k : Int := K.1; ∀ (p : ℤ), ∀ (q : ℤ), (p ≤ k) → ( let Q : Int → Int → Int := fun a b => - (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4; (q = p - (1 : ℤ)) → ( - let valC : Int := Q (p-k) (p-1-(1-k)) + let valC : Int := Q (p-k) (p-1-(1-k)); (∀ (m : Int), (-2*m)^2/4 = m^2) → (valC = (k-p)*(k-p-1)/2-(k-1)^2))))) ) := by classical - intro K f B k p q hpk Q hq valC floorEven + intro K k p q hpk Q hq valC floorEven simp only [valC, Q, Int.natCast_natAbs] rw [abs_of_nonpos (show p-k ≤ 0 by omega)] rw [show (p-k)-(p-1-(1-k)) = -2*(k-1) by ring, floorEven] @@ -480,16 +484,18 @@ private theorem qPeLt : (by classical exact - ∀ (K : DiamondParameter), (IntegerLatticeFunction) → ((Int) → ( - let k : Int := K.1 - ∀ (p : ℤ), ∀ (q : ℤ), + ∀ (K : DiamondParameter), + ( + ( + let k : Int := K.1; + ∀ (p : ℤ), (ℤ) → let Q : Int → Int → Int := fun a b => - (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 - (q = p - (1 : ℤ)) → ((∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (p < k → Q (p + (1 : ℤ) - k) (p + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4; + ((∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (p < k → Q (p + (1 : ℤ) - k) (p - (1 : ℤ) - ((1 : ℤ) - k)) = (k - p - (1 : ℤ)) * (k - p - (2 : ℤ)) / (2 : ℤ) - ((k - (1 : ℤ)) ^ (2 : ℕ) - (k - (1 : ℤ))))))) ) := by classical - intro K f B k p q Q hq floorOdd hpk' + intro K k p q Q floorOdd hpk' simp only [Q, Int.natCast_natAbs] rw [abs_of_nonpos (show p+1-k ≤ 0 by omega)] rw [show (p+1-k)-(p-1-(1-k)) = 1-2*(k-1) by ring, floorOdd] @@ -523,16 +529,18 @@ private theorem qPs : (by classical exact - ∀ (K : DiamondParameter), (IntegerLatticeFunction) → ((Int) → ( - let k : Int := K.1 + ∀ (K : DiamondParameter), + ( + ( + let k : Int := K.1; ∀ (p : ℤ), ∀ (q : ℤ), (p ≤ k) → ( let Q : Int → Int → Int := fun a b => - (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4; (q = p - (1 : ℤ)) → ( - let valS : Int := Q (p-k) (p-1-1-(1-k)) + let valS : Int := Q (p-k) (p-1-1-(1-k)); (∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (valS = (k-p)*(k-p-1)/2-((k-1)^2-(k-1))))))) ) := by classical - intro K f B k p q hpk Q hq valS floorOdd + intro K k p q hpk Q hq valS floorOdd simp only [valS, Q, Int.natCast_natAbs] rw [abs_of_nonpos (show p-k ≤ 0 by omega)] rw [show (p-k)-(p-1-1-(1-k)) = 1-2*(k-1) by ring, floorOdd] @@ -932,17 +940,17 @@ theorem P5352T2Predecessor0 (K : DiamondParameter) (hk : 1 < K.1) hzA hW hN hz hchild childMem childValue have qC0 : val0 = p*(p-1)/2 := by simp [val0, Q, abs_of_nonneg (show 0 ≤ p by omega)] - have qCW := FirstPredecessorCases.qCW K f B p q hp1 hq + have qCW := FirstPredecessorCases.qCW p q hp1 hq have qCN : valN = p*(p-1)/2 := by simp [valN, Q, abs_of_nonneg (show 0 ≤ p by omega)] have qCS : Q p (p-2) = p*(p-1)/2-1 := by simp [Q, abs_of_nonneg (show 0 ≤ p by omega)] have floorEven (m : Int) := FirstPredecessorCases.floorEven m have floorOdd (m : Int) := FirstPredecessorCases.floorOdd K f B p q m - have qP0 := FirstPredecessorCases.qP0 K f B p q hpk hq floorEven - have qPeLt (hpk' : p < k) := FirstPredecessorCases.qPeLt K f B p q hq floorOdd hpk' + have qP0 := FirstPredecessorCases.qP0 K p q hpk hq floorEven + have qPeLt (hpk' : p < k) := FirstPredecessorCases.qPeLt K p q floorOdd hpk' have qPeEq (hpk' : p = k) := FirstPredecessorCases.qPeEq K p floorOdd hpk' - have qPs := FirstPredecessorCases.qPs K f B p q hpk hq floorOdd + have qPs := FirstPredecessorCases.qPs K p q hpk hq floorOdd have hQdelta : valS - valC = k-1 := by linear_combination qPs-qP0 have tri (a : Int) := FirstPredecessorCases.tri K f B p q a diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean index 28a16bc9ca..87b34b02eb 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean @@ -252,17 +252,18 @@ private theorem hPval : exact ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), - let k : Int := K.1 - let d : GaussianInt := ⟨k,k+1⟩ - let pred := P5352T2Sources K hk 3 + let k : Int := K.1; + let d : GaussianInt := ⟨k,k+1⟩; + let pred := P5352T2Sources K hk 3; (∀ (y : GaussianInt), y - d ∈ FootprintVertices pred.1 → f y = pred.2.1 (y - d) + (⟨k, (0 : ℤ)⟩ : GaussianInt).re * y.re + (⟨k, (0 : ℤ)⟩ : GaussianInt).im * y.im + - B) → ((ℤ) → (∀ (hcast : (↑(K.1 + B) → ( + (∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), ∀ (y : GaussianInt), ∀ (w : GaussianInt), (y-d ∈ FootprintVertices pred.1) → ((y-d=w) → (f y = DiamondOdometer (⟨K.1-1,by omega⟩) w + k*y.re+B))))) := by classical - intro K hk f B k d pred hpred p hcast y w hy heq + intro K hk f B k d pred hpred hcast y w hy heq have hh := hpred y (by simpa [pred,P5352T2Sources] using hy) rw [heq] at hh simpa [pred,P5352T2Sources] using hh @@ -332,12 +333,15 @@ private theorem sqOdd : (by classical exact - ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ((IntegerLatticeFunction) → ((Int) → ( - let k : Int := K.1 - (ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (∀ (m : ℤ), ((2 : ℤ) * m + (1 : ℤ)) ^ (2 + (DiamondParameter) → + ( + ( + ( + ( + (∀ (m : ℤ), ((2 : ℤ) * m + (1 : ℤ)) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) + m))))) ) := by classical - intro K hk f B k p hcast m + intro K m have h := P4207T1FloorArithmetic.1 1 m have he : 1+2*m=2*m+1 := by ring rw [he] at h @@ -390,13 +394,16 @@ private theorem tdiffRev : (by classical exact - ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ((IntegerLatticeFunction) → ((Int) → ( - let k : Int := K.1 - (ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → ((∀ (a : Int), + (DiamondParameter) → + ( + ( + ( + ( + ((∀ (a : Int), a*(a-1)/2-(a-1)*(a-2)/2=a-1) → (∀ (a : ℤ), (a - (1 : ℤ)) * (a - (2 : ℤ)) / (2 : ℤ) - a * (a - (1 : ℤ)) / (2 : ℤ) = (1 : ℤ) - a)))))) ) := by classical - intro K hk f B k p hcast tdiff a + intro K tdiff a have hh := tdiff a omega @@ -780,7 +787,7 @@ theorem P5352T2Predecessor1 (K : DiamondParameter) (hk : 1 < K.1) have hSval := FirstPredecessorProof.hSval K hk f hchildTile hchild p hS have hPval (y : GaussianInt) (w : GaussianInt) (hy : y-d ∈ FootprintVertices pred.1) (heq : y-d=w) := FirstPredecessorProof.hPval K - hk f B hpred p hcast y w hy heq + hk f B hpred hcast y w hy heq have hPcenter : f ⟨p,2*k+1-p⟩ = DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩ + k*p+B := FirstPredecessorProof.hPcenter K hk f B p hcast hpz hPval @@ -805,12 +812,11 @@ theorem P5352T2Predecessor1 (K : DiamondParameter) (hk : 1 < K.1) simpa [Q] using (P5352T2DomainRows ⟨K.1-1,by omega⟩ ⟨p-k,k+1-p⟩).2 hPn -- The exact four increments follow by reducing the even and odd squares. have sqEven (m : Int) := EvenSquareQuotient.square m - have sqOdd (m : Int) := FirstPredecessorProof.sqOdd K hk f B p hcast m + have sqOdd (m : Int) := FirstPredecessorProof.sqOdd K m have tri (a : Int) := FirstPredecessorProof.tri K hk f B p hcast a have tdiff (a : Int) := FirstPredecessorProof.tdiff K hk f B p hcast tri a - have tdiffRev (a : Int) := FirstPredecessorProof.tdiffRev K - hk f B p hcast tdiff a + have tdiffRev (a : Int) := FirstPredecessorProof.tdiffRev K tdiff a have absP : (Int.natAbs p : Int)=p := by rw [Int.natCast_natAbs,abs_of_nonneg (by omega)] have absPm : (Int.natAbs (p-1) : Int)=p-1 := by rw [Int.natCast_natAbs,abs_of_nonneg (by omega)] diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean index 1fc2790f0b..8d0c2ebe29 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean @@ -842,28 +842,6 @@ private theorem htable' : rw [FourNeighborLaplacian] at htable linarith -private theorem hcompAt447 : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), (IntegerLatticeFunction) → ( - let k : Int := K.1 - let r : GaussianInt := ⟨-2*k,0⟩ - let child := P5352T2Sources K hk 0 - (child.1=DiamondTile K.1) → (∀ (a : ℤ), ∀ (b : ℤ), (k < b ∧ b ≤ (2 : ℤ) * (k - (1 : ℤ)) + - (k + (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ a + k ∧ a + k ≤ k - (1 : ℤ) ∧ k < a + k + (1 : ℤ) + - b ∧ a + k ≤ b - (k + (1 : ℤ)) + (1 : ℤ) ∧ b ≤ (1 : ℤ) + (a + k) + (2 : ℤ) * (k - (1 : - ℤ)) + (k + (1 : ℤ)) ∧ a + k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - (k + (1 : ℤ))) + (1 : - ℤ)) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → ((b = (2 : ℤ) * k + a) → ( - let t : Int := -a - let zB : GaussianInt := ⟨-t,2*k-t⟩ - zB-r∉FootprintVertices child.1))))) ) := by - classical - intro K hk f k r child hchildTile a b hdpred hcast hb t zB hmem - have hd := (P5352T2DomainRows K (zB-r)).1.mp (hchildTile ▸ hmem) - simp [zB,r] at hd - omega - end SecondPredecessorProof theorem P5352T2Predecessor2 (K : DiamondParameter) (hk : 1 < K.1) @@ -1063,8 +1041,14 @@ theorem P5352T2Predecessor2 (K : DiamondParameter) (hk : 1 < K.1) exact childOdometer _ (by simpa [hchildTile] using hc) have htable' := SecondPredecessorProof.htable' K a htable - have hcomp : zB-r∉FootprintVertices child.1 := SecondPredecessorProof.hcompAt447 K hk f - hchildTile a b hdpred hcast hb + have hcomp : zB-r∉FootprintVertices child.1 := (show + zB-r∉FootprintVertices child.1 + from by + classical + intro hmem + have hd := (P5352T2DomainRows K (zB-r)).1.mp (hchildTile ▸ hmem) + simp [zB,r] at hd + omega) rw [hzB] at ⊢ refine ⟨?_,?_⟩ · intro hm diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean index d7233b04e6..ad0d60dcb2 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean @@ -478,16 +478,16 @@ private theorem qPredC : classical exact ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), - let k : Int := K.1 + let k : Int := K.1; let Q : Int → Int → Int := fun a b => - (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 - (((K.1-1 : Nat) : Int) = k-1) → ((∀ (m : Int), (-2*m)^2/4 = m^2) → (∀ (t : ℤ), (t ≤ k) → ( - let x : GaussianInt := ⟨-t,t-1⟩ + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4; + ((∀ (m : Int), (-2*m)^2/4 = m^2) → (∀ (t : ℤ), (t ≤ k) → ( + let x : GaussianInt := ⟨-t,t-1⟩; (f x = Q (-t) (t-1)) → ((f x = Q (k-t) (k+t-2) + (1-k)*(-t) - (t-1)+B) → ((f (⟨-t-1,t-1⟩ : GaussianInt) = Q (k-t-1) (k+t-2) + (1-k)*(-t-1) - (t-1)+B) → (Q (k-t) (k+t-2) = (k-t)*(k-t-1)/2-(t-1)^2)))))) ) := by classical - intro K f B k Q hkm floorEven t htk x hChildC hPredC hPredW + intro K f B k Q floorEven t htk x hChildC hPredC hPredW simp only [Q, Int.natCast_natAbs] rw [abs_of_nonneg (by omega : 0 ≤ k-t)] rw [show (k-t)-(k+t-2)=-2*(t-1) by ring, floorEven] @@ -497,17 +497,17 @@ private theorem qPredWlt : classical exact ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), - let k : Int := K.1 + let k : Int := K.1; let Q : Int → Int → Int := fun a b => - (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 - (((K.1-1 : Nat) : Int) = k-1) → ((∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (∀ (t : ℤ), - let x : GaussianInt := ⟨-t,t-1⟩ - (f x = Q (-t) (t-1)) → ((f x = Q (k-t) (k+t-2) + (1-k)*(-t) - (t-1)+B) → ((f (⟨-t-1,t-1⟩ + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4; + ((∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (∀ (t : ℤ), + ( + ((f (⟨-t-1,t-1⟩ : GaussianInt) = Q (k-t-1) (k+t-2) + (1-k)*(-t-1) - (t-1)+B) → (t < k → Q (k - t - (1 : ℤ)) (k + t - (2 : ℤ)) = (k - t - (1 : ℤ)) * (k - t - (2 : ℤ)) / (2 : ℤ) - (t * t - t)))))) ) := by classical - intro K f B k Q hkm floorOdd t x hChildC hPredC hPredW ht + intro K f B k Q floorOdd t hPredW ht simp only [Q, Int.natCast_natAbs] rw [abs_of_nonneg (by omega : 0 ≤ k-t-1)] rw [show (k-t-1)-(k+t-2)=1-2*t by ring, floorOdd] @@ -541,17 +541,17 @@ private theorem qPredS : classical exact ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), - let k : Int := K.1 + let k : Int := K.1; let Q : Int → Int → Int := fun a b => - (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 - (((K.1-1 : Nat) : Int) = k-1) → ((∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (∀ (t : ℤ), (t ≤ k) + (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4; + ((∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (∀ (t : ℤ), (t ≤ k) → ( - let x : GaussianInt := ⟨-t,t-1⟩ + let x : GaussianInt := ⟨-t,t-1⟩; (f x = Q (-t) (t-1)) → ((f x = Q (k-t) (k+t-2) + (1-k)*(-t) - (t-1)+B) → ((f (⟨-t-1,t-1⟩ : GaussianInt) = Q (k-t-1) (k+t-2) + (1-k)*(-t-1) - (t-1)+B) → (Q (k-t) (k+t-3) = (k-t)*(k-t-1)/2-((t-1)^2-(t-1)))))))) ) := by classical - intro K f B k Q hkm floorOdd t htk x hChildC hPredC hPredW + intro K f B k Q floorOdd t htk x hChildC hPredC hPredW simp only [Q, Int.natCast_natAbs] rw [abs_of_nonneg (by omega : 0 ≤ k-t)] rw [show (k-t)-(k+t-3)=1-2*(t-1) by ring, floorOdd] @@ -807,23 +807,6 @@ private theorem hNotTrue : clear * - hiI omega -private theorem hCompFalse : - (by - classical - exact - ∀ (K : DiamondParameter), (IntegerLatticeFunction) → ( - let k : Int := K.1 - let r : GaussianInt := ⟨-2*k, 0⟩ - (((K.1-1 : Nat) : Int) = k-1) → (∀ (u : ℤ), (u < k) → ( - let x : GaussianInt := ⟨-u,u⟩ - ((Int.natAbs (-u) : Int) = u) → (((Int.natAbs (u-(K.1:Int)) : Int) = k-u) → (x-r ∉ - FootprintVertices (DiamondTile K.1)))))) ) := by - classical - intro K f k r hkm u huk x habsA habsB hh - have h := (P5352T2DomainRows K (x-r)).1.mp hh - simp only [x, r, Zsqrtd.re_sub, Zsqrtd.im_sub] at h - omega - end FourthPredecessorCases theorem P5352T2Predecessor3 (K : DiamondParameter) (hk : 1 < K.1) @@ -940,11 +923,10 @@ theorem P5352T2Predecessor3 (K : DiamondParameter) (hk : 1 < K.1) tri tdiff have qChildN := FourthPredecessorCases.qChildN K f B floorEven t ht1 hChildC hPredC hPredW tri tdiff - have qPredC := FourthPredecessorCases.qPredC K f B hkm floorEven t htk hChildC hPredC hPredW - have qPredWlt (ht : t simp [M]; ring have hChildEast : (z+1)-M = ⟨1-n,n⟩ := by rw [hzc]; ext <;> simp [M]; ring have hLap := DiamondRightHorizontal.hLap K f B z hzr hzc hWc hNc hSc hEc hfCenter hfWest diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean b/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean index d7f4874c7f..3f6eefb81b 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean @@ -519,21 +519,21 @@ private theorem southAt385 : classical exact ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), - let k : Int := K.1 - let rho : GaussianInt := ⟨-k, -k-1⟩ + let k : Int := K.1; + let rho : GaussianInt := ⟨-k, -k-1⟩; (∀ (t : Int), (0 ≤ t) → ((t < k) → ((⟨-t,t⟩ : GaussianInt)-⟨0,1⟩-rho ∈ FootprintVertices (DiamondTile K.1)))) → ( - let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 + let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2; (∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m) → (S a b = 2*a^2-2*|a|-4*m^2)) → ((∀ (a : Int), ∀ (b : Int), ∀ (m : Int), (a-b = 2*m+1) → (S a b = 2*a^2-2*|a|-4*m^2-4*m)) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x-rho ∈ FootprintVertices (DiamondTile K.1)) → ((y-rho ∈ FootprintVertices (DiamondTile K.1)) → (4*(f y-f x) = S (y-rho).re (y-rho).im-S (x-rho).re (x-rho).im - 4*k*(y-x).re))) → (∀ (t : ℤ), ((0 : ℤ) ≤ t) → - ((t < k) → ((⟨-t, t⟩ - rho ∈ FootprintVertices (DiamondTile K.1)) → ((f ((⟨-t,t⟩ : - GaussianInt)-1)-f ⟨-t,t⟩ = 0) → ((f ((⟨-t,t⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-t,t⟩ = -t) → + ((t < k) → ((⟨-t, t⟩ - rho ∈ FootprintVertices (DiamondTile K.1)) → ( + ((f ((⟨-t,t⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-t,t⟩ = -t) → (f ((⟨-t,t⟩ : GaussianInt)-⟨0,1⟩)-f ⟨-t,t⟩ = t))))))))) ) := by classical - intro K f k rho footBS S sEven sOdd diffR t ht0 htk hzR west north + intro K f k rho footBS S sEven sOdd diffR t ht0 htk hzR north have h := diffR _ _ hzR (footBS t ht0 htk) rw [sEven _ _ (-t) (by dsimp [rho]; ring), sOdd _ _ (-t-1) (by dsimp [rho]; ring)] at h @@ -546,17 +546,17 @@ private theorem htAt399 : classical exact ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), - let k : Int := K.1 - let rho : GaussianInt := ⟨-k, -k-1⟩ + let k : Int := K.1; + let rho : GaussianInt := ⟨-k, -k-1⟩; let covered (x : GaussianInt) : Prop := ∀ y, y=x ∨ y=x-1 ∨ y=x-⟨0,1⟩ ∨ y=x-1-⟨0,1⟩ → - y ∈ DiamondCellDomain K.1 ∨ y-rho ∈ DiamondCellDomain K.1 - ∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((covered ⟨-t, t⟩ ↔ (0 : ℤ) < t) → ((f ((⟨-t,t⟩ : - GaussianInt)-1)-f ⟨-t,t⟩ = 0) → ((f ((⟨-t,t⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-t,t⟩ = -t) → + y ∈ DiamondCellDomain K.1 ∨ y-rho ∈ DiamondCellDomain K.1; + ∀ (t : ℤ), ((0 : ℤ) ≤ t) → ((covered ⟨-t, t⟩ ↔ (0 : ℤ) < t) → ( + ((f ((⟨-t,t⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-t,t⟩ = -t) → ((f ((⟨-t,t⟩ : GaussianInt)-⟨0,1⟩)-f ⟨-t,t⟩ = t) → ((¬covered ⟨-t, t⟩) → (t=0)))))) ) := by classical - intro K f k rho covered t ht0 cells west north south hc + intro K f k rho covered t ht0 cells north south hc have : ¬ 0 < t := fun ht => hc (cells.mpr ht) omega @@ -689,7 +689,7 @@ theorem P5352T2RightSecond (K : DiamondParameter) (hk : 1 < K.1) have north : f ((⟨-t,t⟩ : GaussianInt)+⟨0,1⟩)-f ⟨-t,t⟩ = -t := DiamondRightSecond.northAt379 K f footBN sEven sOdd diffC t ht0 htk hz have south : f ((⟨-t,t⟩ : GaussianInt)-⟨0,1⟩)-f ⟨-t,t⟩ = t := DiamondRightSecond.southAt385 - K f footBS sEven sOdd diffR t ht0 htk hzR west north + K f footBS sEven sOdd diffR t ht0 htk hzR north rw [lap, east, west, north, south] constructor · intro hc @@ -697,7 +697,7 @@ theorem P5352T2RightSecond (K : DiamondParameter) (hk : 1 < K.1) rw [ite_eq_right ht] ring · intro hc - have ht : t=0 := DiamondRightSecond.htAt399 K f t ht0 cells west north south hc + have ht : t=0 := DiamondRightSecond.htAt399 K f t ht0 cells north south hc rw [ite_eq_left ht] ring ) diff --git a/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean b/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean index 5d61a2e540..5c24fc0907 100644 --- a/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean +++ b/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean @@ -129,16 +129,17 @@ private theorem hbAt227 : (by classical exact - (BandCircle) → (∀ (h₁ : PartialOdometer), ∀ (h₂ : PartialOdometer), ∀ (g : + (∀ (h₁ : PartialOdometer), ∀ (h₂ : PartialOdometer), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), ∀ (c₁ : ℤ), (∀ x ∈ h₁.domain, g x = h₁.value x + c₁) → (∀ (c₂ : ℤ), (∀ x ∈ h₂.domain, g x = h₂.value x + c₂) → ((x ∈ - h₁.domain) → ((x ∈ h₂.domain) → ((ℕ) → (∀ (z : GaussianInt), ∀ (a₁ : GaussianInt), ∀ + h₁.domain) → ((x ∈ h₂.domain) → ( + (∀ (z : GaussianInt), ∀ (a₁ : GaussianInt), ∀ (b₁ : ℤ), (∀ x ∈ h₁.domain, h₁.value x = P5570T1UnitQuadratic z x + a₁.re * x.re + a₁.im * x.im + b₁) → (∀ (b₂ : ℤ), (∀ x ∈ h₂.domain, h₂.value x = P5570T1UnitQuadratic z x + a₁.re * x.re + a₁.im * x.im + b₂) → (b₁+c₁ = b₂+c₂)))))))) ) := by classical - intro C h₁ h₂ g x c₁ hg₁ c₂ hg₂ hx₁ hx₂ n z a₁ b₁ hval₁ b₂ hval₂ + intro h₁ h₂ g x c₁ hg₁ c₂ hg₂ hx₁ hx₂ z a₁ b₁ hval₁ b₂ hval₂ have he₁ := hg₁ x hx₁ have he₂ := hg₂ x hx₂ rw [hval₁ x hx₁] at he₁ @@ -591,8 +592,9 @@ private theorem hUn : (by classical exact - (BandCircle) → ((ℕ) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), (Fin (3 : ℕ)) → - ((ProperBandQuadruple q) → (∀ (U : ProtoTile), ∀ (V : ProtoTile), (LatticeTile U ∧ + ( + (∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ((ProperBandQuadruple q) → (∀ (U : ProtoTile), ∀ (V : ProtoTile), (LatticeTile U ∧ TileArea U = (q (0 : Fin (4 : ℕ))).1.toNat ∧ (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q U i s (S i s)) → (∀ (x : LatticeCell), x ∈ U.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i @@ -693,7 +695,7 @@ private theorem hUn : (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → (U.cells.Nonempty)))))) ) := by classical - intro C n q i hq U V hgeomU hgeomV + intro q hq U V hgeomU hgeomV have ha := hgeomU.2.1 have hp := (ProperBandCurvatureStructure q hq).1 by_contra he @@ -970,7 +972,7 @@ private theorem positiveStep : LeftWebGeometry.hnadj C n q i hq hunit hpos U V orientation base Rminus Rplus tiles reverseTiles hs reverseHs hreverse hrespect hreverseRespect r horientation hstring hcminus hcplus hnorm - have hUn : U.cells.Nonempty := LeftWebGeometry.hUn C n q i hq U V hgeomU hgeomV + have hUn : U.cells.Nonempty := LeftWebGeometry.hUn q hq U V hgeomU hgeomV have hVn : V.cells.Nonempty := Finset.nonempty_iff_ne_empty.mpr hnV have hselection := P5589T1UnitInterfaceSelection C Ci hunit orientation base Rminus Rplus U V tiles reverseTiles hs reverseHs hminus hplus f k @@ -1063,7 +1065,7 @@ theorem P5596T1LeftWeb subst a₂ obtain ⟨c₁, hg₁⟩ := hg₁ obtain ⟨c₂, hg₂⟩ := hg₂ - have hb := LeftWebGeometry.hbAt227 C h₁ h₂ g x c₁ hg₁ c₂ hg₂ hx₁ hx₂ n z a₁ b₁ hval₁ b₂ + have hb := LeftWebGeometry.hbAt227 h₁ h₂ g x c₁ hg₁ c₂ hg₂ hx₁ hx₂ z a₁ b₁ hval₁ b₂ hval₂ have hvalues (y : GaussianInt) (hy : y = x ∨ y = x + 1 ∨ y = x - 1 ∨ diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean index 043a574426..1d56d4b529 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean @@ -848,18 +848,19 @@ private theorem hcurvature : (by classical exact - ∀ (C : BandCircle), (¬C.1.1.1 = (1 : ℤ)) → ((PeriodicTileComplex ↥(TilingLattice C)) → (∀ + ∀ (C : BandCircle), (¬C.1.1.1 = (1 : ℤ)) → ( + (∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), - let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3]; ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), - let next : Fin 4 → Fin 4 := ![1, 2, 3, 0] + let next : Fin 4 → Fin 4 := ![1, 2, 3, 0]; let col : Fin 4 → Fin 3 := fun i => - if owner i = owner m then 0 else if owner i = owner w then 1 else 2 + if owner i = owner m then 0 else if owner i = owner w then 1 else 2; ∀ (e : Fin (4 : ℕ)), (col e = (0 : Fin (3 : ℕ)) ∧ col (next e) = (1 : Fin (3 : ℕ)) ∨ col e = (1 : Fin (3 : ℕ)) ∧ col (next e) = (0 : Fin (3 : ℕ))) → (1 < C.1.1.1))) ) := by classical - intro C hc P a0 a1 a2 a3 owner m w next col e hecolor + intro C hc a0 a1 a2 a3 owner m w next col e hecolor have hpos : 0 < C.1.1.1 := C.2 omega @@ -1681,7 +1682,7 @@ theorem PeriodicBoundaryWebLaplacian (C : BandCircle) edge_mem_e edge_mem_next)) obtain ⟨j, hsign⟩ := hdisplacement have slope_for := WebLaplacianGeometry.slope_for C P a0 a1 a2 a3 m w - have hcurvature := WebLaplacianGeometry.hcurvature C hc P a0 a1 a2 a3 m w e hecolor + have hcurvature := WebLaplacianGeometry.hcurvature C hc a0 a1 a2 a3 m w e hecolor obtain ⟨p, hp⟩ := slope_for C.1.1 T h hodo hcurvature let u : GaussianInt := owner m let u' : GaussianInt := owner w diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathBetween.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathBetween.lean index 1176656efa..22b6f2d22e 100644 --- a/LeanPool/ApollonianSuperharmonic/SimpleGridPathBetween.lean +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathBetween.lean @@ -5,8 +5,6 @@ Authors: Wesley Pegden -/ module -public import Mathlib.Init - public import Mathlib.NumberTheory.Zsqrtd.GaussianInt -- [TABLET NODE: SimpleGridPathBetween] @@ -42,6 +40,34 @@ def SimpleGridPathBetween (V : Set GaussianInt) ∀ e, e ∈ E ↔ ∃ a b : GaussianInt, ∃ l₁ l₂ : List GaussianInt, p = l₁ ++ a :: b :: l₂ ∧ e = {a, b} +/-- Reversing a simple grid path preserves its vertices and undirected edges. -/ +theorem SimpleGridPathBetween.reverse {V : Set GaussianInt} {E : Set (Finset GaussianInt)} + {x y : GaussianInt} (hp : SimpleGridPathBetween V E x y) : SimpleGridPathBetween V E y x := by + classical + rcases hp with ⟨p, hn, hl, hh, ht, hV, hs, he⟩ + have revstep : ∀ a b l₁ l₂, p.reverse = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ := by + intro a b l₁ l₂ h + have h' : p = l₂.reverse ++ b :: a :: l₁.reverse := by + have := congrArg List.reverse h + simpa [List.reverse_append, List.append_assoc] using this + rcases hs b a _ _ h' with h | h | h | h + · exact Or.inr (Or.inl (by rw [h]; simp)) + · exact Or.inl (by rw [h]; simp) + · exact Or.inr (Or.inr (Or.inr (by rw [h]; simp))) + · exact Or.inr (Or.inr (Or.inl (by rw [h]; simp))) + have revocc (q : List GaussianInt) (e : Finset GaussianInt) + (ho : ∃ a b l₁ l₂, q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) : + ∃ a b l₁ l₂, q.reverse = l₁ ++ a :: b :: l₂ ∧ e = {a, b} := by + rcases ho with ⟨a, b, l₁, l₂, rfl, rfl⟩ + exact ⟨b, a, l₂.reverse, l₁.reverse, + by simp [List.reverse_append, List.append_assoc], Finset.pair_comm _ _⟩ + refine ⟨p.reverse, List.nodup_reverse.mpr hn, by simpa using hl, + by simpa using ht, by simpa using hh, by simpa using hV, revstep, ?_⟩ + intro e + exact ⟨fun h => revocc p e ((he e).mp h), fun h => + (he e).mpr (by simpa using revocc p.reverse e h)⟩ + end ApollonianSuperharmonic end diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean index 5883b18ebb..1f958dc951 100644 --- a/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean @@ -188,11 +188,14 @@ private theorem compat_symm : (by classical exact - (BandCircle) → ((ℕ) → ((Fin (4 : ℕ) → CircleCoordinates) → ((Fin (3 : ℕ)) → - ((BandPackingSymmetry) → (∀ (h : PartialOdometer), ∀ (k : PartialOdometer), + ( + ( + ( + ( + (∀ (h : PartialOdometer), ∀ (k : PartialOdometer), (OdometerCompatibility h k) → (OdometerCompatibility k h)))))) ) := by classical - intro C n q r g h k hc + intro h k hc rcases hc with hd | ⟨c, hc⟩ · exact Or.inl hd.symm · refine Or.inr ⟨-c, ?_⟩ @@ -350,17 +353,20 @@ private theorem hnvalue : (by classical exact - (BandCircle) → ((ℕ) → (∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (c : Fin (3 : ℕ) + ( + (∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), ∀ (c : Fin (3 : ℕ) → Bool → ℤ), let hn : Fin 3 → Bool → PartialOdometer := fun i s => - PartialOdometerAffineTranslate (hs i s) 0 0 (-c i s) + PartialOdometerAffineTranslate (hs i s) 0 0 (-c i s); ∀ (h0 : PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (hs i s).domain, (hs - i s).value x - h0.value x = c i s) → ((Fin (4 : ℕ) → CircleCoordinates) → ((Fin (3 : - ℕ)) → ((BandPackingSymmetry) → ((∀ (i : Fin 3), ∀ (s : Bool), ∀ (x : GaussianInt), x + i s).value x - h0.value x = c i s) → ( + ( + ( + ((∀ (i : Fin 3), ∀ (s : Bool), ∀ (x : GaussianInt), x ∈ (hn i s).domain ↔ x ∈ (hs i s).domain) → (∀ (i : Fin 3), ∀ (s : Bool), ∀ (x : GaussianInt), (x ∈ (hn i s).domain) → (h0.value x = (hn i s).value x)))))))) ) := by classical - intro C n hs c hn h0 hc q r g hndom i s x hx + intro hs c hn h0 hc hndom i s x hx have hv := (PartialOdometerAffineTranslateFormulas (hs i s) 0 0 (-c i s)).2.2.1 x hx have he := hc i s x ((hndom i s x).1 hx) @@ -523,7 +529,7 @@ theorem TileOdometerExists (C : BandCircle) : have hnest := P4250T1NestedCompatibility q' cfg C' T cert hs s0 hsub hslope have hcompat := TileOdometerExistenceGeometry.hcompat hs hord hnest - (TileOdometerExistenceGeometry.compat_symm C n q r g) + (TileOdometerExistenceGeometry.compat_symm) have hdomain (i : Fin 3) (s : Bool) : ((hs i s).domain : Set GaussianInt) = FootprintVertices (cert.P i s) := PositiveCurvatureTileOdometerDomain _ _ _ (hpositive i) (hsub i s) @@ -572,7 +578,7 @@ theorem TileOdometerExists (C : BandCircle) : have hndom := TileOdometerExistenceGeometry.hndom hs c have hnvalue (i : Fin 3) (s : Bool) (x : GaussianInt) (hx : x ∈ (hn i s).domain) : h0.value x = (hn i s).value x := - TileOdometerExistenceGeometry.hnvalue C n hs c h0 hc q r g hndom i s x hx + TileOdometerExistenceGeometry.hnvalue hs c h0 hc hndom i s x hx refine ⟨T, h0, ?_⟩ apply TileOdometer.decompose cfg.proper hT (TileOdometerExistenceGeometry.hnsub C hs c q r g hcurv cfg hpositive T cert hsub) cert.outer_union From 07f2252cbd09597695ee9b2e0c3b5e18c45be522 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 13 Nov 2026 02:54:53 +0000 Subject: [PATCH 12/23] Share prototile invariants and document vector initialization --- LeanPool/ApollonianSuperharmonic.lean | 3 + ...storOdometerInnerSupportNormalization.lean | 25 +--- ...storOdometerOuterSupportNormalization.lean | 25 +--- .../AncestorOdometerRestriction.lean | 57 +------ .../BandOdometerInteriorTable.lean | 26 +--- ...deredGeneralLargestParentOdometerRows.lean | 22 +-- ...dGeneralRightRoutingCertificateExists.lean | 56 +------ ...eralSubtileInterfaceCertificateExists.lean | 139 +----------------- ...PackingSymmetryTileOdometerCovariance.lean | 33 +---- .../BandPeriodicSuperharmonicity.lean | 21 +-- .../BandPrototileNonempty.lean | 46 ++++++ .../BandPrototileTranslationNormalForm.lean | 59 ++------ .../ForwardBoundaryStringData.lean | 58 +------- LeanPool/ApollonianSuperharmonic/Imports.lean | 1 + .../LatticeAdjacentInterfacePath.lean | 57 +------ .../LeftAdjacentOdometerCompatibility.lean | 25 +--- ...RespectRegularFamilyCentralCovariance.lean | 25 +--- .../OpposingBoundaryOdometerStrings.lean | 32 +--- .../P4055T1BandQuarterTurn.lean | 27 +--- .../P4250T1NestedCompatibility.lean | 34 +---- .../P4366T2OuterGeometry.lean | 34 +---- .../P4458T1LargestParentRows.lean | 37 +---- .../P4458T1SecondNewerRows.lean | 37 +---- .../P5472T1FordSlopeDifference.lean | 23 +-- ...CurvatureTileOdometerSupportTransport.lean | 25 +--- .../PrimitiveVectorOrientation.lean | 7 +- .../RecursiveVectorSystem.lean | 8 + .../TileOdometerTranslationUniqueness.lean | 84 +---------- ...eSubodometerLiteralDecompositionPiece.lean | 38 +---- .../VectorRecursionLaws.lean | 26 ++++ 30 files changed, 166 insertions(+), 924 deletions(-) create mode 100644 LeanPool/ApollonianSuperharmonic/BandPrototileNonempty.lean diff --git a/LeanPool/ApollonianSuperharmonic.lean b/LeanPool/ApollonianSuperharmonic.lean index d1cbaf625a..82e1bdf83b 100644 --- a/LeanPool/ApollonianSuperharmonic.lean +++ b/LeanPool/ApollonianSuperharmonic.lean @@ -38,4 +38,7 @@ cocycles, and supporting geometric lemmas from upstream. The upstream paper, process tooling and development history are not imported. The upstream reference notes explain two local repairs to the printed proof: edge-supported interfaces with isolated corners, and occurrence-oriented unit strings. +The recursive-vector API also retains upstream’s product-compatible initialization, +whose signs and affine offsets differ from the printed Section 5.3 display. +`RecursiveVectorSystem` records both triples and the base product-identity discrepancy. -/ diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerInnerSupportNormalization.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerInnerSupportNormalization.lean index 0a7733f683..6b0d914b24 100644 --- a/LeanPool/ApollonianSuperharmonic/AncestorOdometerInnerSupportNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerInnerSupportNormalization.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.AncestorOdometer @@ -32,29 +33,7 @@ theorem AncestorOdometerInnerSupportNormalization -- BODY classical rcases hancestor with ⟨hO, hAT, hfoot, hsub, hval⟩ - have positive_cells : ∀ (D : CircleCoordinates) (W : ProtoTile), - 0 < D.1 → BandPrototile D W → W.cells.Nonempty := by - intro D W hD hW - induction hW with - | line w x hw => simp at hD - | unit z x => simp - | @decompose q hq S W hS hcells hfoot hcentroid ih => - have facts := ProperBandCurvatureStructure q hq - have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by - by_cases h0 : 0 < (q (0 : Fin 3).succ).1 - · exact ⟨0, h0⟩ - by_cases h1 : 0 < (q (1 : Fin 3).succ).1 - · exact ⟨1, h1⟩ - by_cases h2 : 0 < (q (2 : Fin 3).succ).1 - · exact ⟨2, h2⟩ - have n0 := facts.2.1 (0 : Fin 3) - have n1 := facts.2.1 (1 : Fin 3) - have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega - have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega - exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim - rcases hp with ⟨i, hi⟩ - rcases ih i false hi with ⟨x, hx⟩ - exact ⟨x, (hcells x).mpr ⟨i, false, hx⟩⟩ + have positive_cells := BandPrototileNonempty.positive have hUne : U.cells.Nonempty := positive_cells C U hpositive hU have hVne : V.cells.Nonempty := by rw [hcells]; exact hUne have hfoot_eq : FootprintVertices V = FootprintVertices U := by diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerOuterSupportNormalization.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerOuterSupportNormalization.lean index 618586b145..a8591b3600 100644 --- a/LeanPool/ApollonianSuperharmonic/AncestorOdometerOuterSupportNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerOuterSupportNormalization.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.AncestorOdometer public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport @@ -35,29 +36,7 @@ theorem AncestorOdometerOuterSupportNormalization rcases hancestor with ⟨hodo, hAT, hdom, hsub, hval⟩ have hnewodo := PositiveCurvatureTileOdometerSupportTransport C' V U g hpositive hodo hU hcells - have positive_cells : ∀ (D : CircleCoordinates) (W : ProtoTile), - 0 < D.1 → BandPrototile D W → W.cells.Nonempty := by - intro D W hD hW - induction hW with - | line w x hw => simp at hD - | unit z x => simp - | @decompose q hq S W hS hcells' hfoot hcentroid ih => - have facts := ProperBandCurvatureStructure q hq - have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by - by_cases h0 : 0 < (q (0 : Fin 3).succ).1 - · exact ⟨0, h0⟩ - by_cases h1 : 0 < (q (1 : Fin 3).succ).1 - · exact ⟨1, h1⟩ - by_cases h2 : 0 < (q (2 : Fin 3).succ).1 - · exact ⟨2, h2⟩ - have n0 := facts.2.1 (0 : Fin 3) - have n1 := facts.2.1 (1 : Fin 3) - have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega - have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega - exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim - rcases hp with ⟨i, hi⟩ - rcases ih i false hi with ⟨x, hx⟩ - exact ⟨x, (hcells' x).mpr ⟨i, false, hx⟩⟩ + have positive_cells := BandPrototileNonempty.positive have hVne : V.cells.Nonempty := by have hu : U.cells.Nonempty := positive_cells C' U hpositive hU rw [hcells] diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean index b1cceb12ec..c045d8b783 100644 --- a/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.AncestorOdometer public import LeanPool.ApollonianSuperharmonic.TileOdometerDomain @@ -26,37 +28,6 @@ namespace ApollonianSuperharmonic namespace AncestorRestrictionProof -private theorem positive_cells : - (by - classical - exact - ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), 0 < c.1 → BandPrototile c U → - U.cells.Nonempty ) := by - classical - intro c U hc hu - induction hu with - | line w x hw => simp at hc - | unit z x => simp - | @decompose q hq S U hs hcells hfoot hcentroid ih => - have facts := ProperBandCurvatureStructure q hq - have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by - by_cases h0 : 0 < (q (0 : Fin 3).succ).1 - · exact ⟨0, h0⟩ - by_cases h1 : 0 < (q (1 : Fin 3).succ).1 - · exact ⟨1, h1⟩ - by_cases h2 : 0 < (q (2 : Fin 3).succ).1 - · exact ⟨2, h2⟩ - have n0 := facts.2.1 (0 : Fin 3) - have n1 := facts.2.1 (1 : Fin 3) - have n2 := facts.2.1 (2 : Fin 3) - have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega - have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega - have bad := facts.2.2 0 1 z0 z1 - exact ((by decide : (0 : Fin 3) ≠ 1) bad).elim - rcases hp with ⟨i, hi⟩ - rcases ih i false hi with ⟨x, hx⟩ - exact ⟨x, (hcells x).mpr ⟨i, false, hx⟩⟩ - private theorem odo_eq : (by classical @@ -81,26 +52,6 @@ private theorem odo_eq : subst bv rfl -private theorem band_from_odo : - (by - classical - exact - ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), TileOdometer c U k → - BandPrototile c U ) := by - classical - intro c U k ho - induction ho with - | line w x hw hdom => exact BandPrototile.line w x hw - | unit z x U k hU hdom htrans => - cases U with - | mk cells anchor => - dsimp at hU ⊢ - subst cells - exact BandPrototile.unit z x anchor - | decompose hq hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => - exact BandPrototile.decompose hq (fun i s => ih i s) - hcells hfoot hcentroid - private theorem band_one : (by classical @@ -456,7 +407,7 @@ theorem AncestorOdometerRestriction (k.domain : Set GaussianInt) = FootprintVertices U := TileOdometerDomain have positive_cells : ∀ (c : CircleCoordinates) (U : ProtoTile), - 0 < c.1 → BandPrototile c U → U.cells.Nonempty := AncestorRestrictionProof.positive_cells + 0 < c.1 → BandPrototile c U → U.cells.Nonempty := BandPrototileNonempty.positive let vertices : ProtoTile → Finset GaussianInt := fun U => if U.cells.Nonempty then U.cells.biUnion (fun x => {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) @@ -500,7 +451,7 @@ theorem AncestorOdometerRestriction (∀ x, x ∈ a.domain → a.value x = b.value x) → a = b := AncestorRestrictionProof.odo_eq have band_from_odo : ∀ (c : CircleCoordinates) (U : ProtoTile) (k : PartialOdometer), TileOdometer c U k → BandPrototile c U := - AncestorRestrictionProof.band_from_odo + TileOdometerBandPrototile have one_step : ∀ (X Y : CircleCoordinates × ProtoTile), (∃ r : Fin 4 → CircleCoordinates, ∃ i : Fin 3, ∃ s : Bool, ProperBandQuadruple r ∧ r 0 = Y.1 ∧ r i.succ = X.1 ∧ diff --git a/LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean b/LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean index 171ab00853..007f3bd375 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOdometerInteriorTable.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileQuarterTurn public import LeanPool.ApollonianSuperharmonic.P4120T1RootNormalization public import LeanPool.ApollonianSuperharmonic.P4120T1AffineComparison @@ -143,30 +144,7 @@ private theorem layout : have hI := BandTileSimultaneousInduction q' hq' T' hT' exact ⟨hI.1, hI.2.1, hI.2.2.1 S' hocc hcells⟩ · intro D U hU _ - cases hU with - | line w z hw => - intro p - simp [TileRealization, TileCentroid] - | unit z a anchor => - intro p - have hc : TileCentroid (⟨{a}, anchor⟩ : ProtoTile) = - (((a.re : Int) : Real) + (1 / 2 : Real), - ((a.im : Int) : Real) + (1 / 2 : Real)) := by - simp [TileCentroid] - rw [hc] - rcases p with ⟨px, py⟩ - simp only [TileRealization, Finset.mem_singleton, Set.mem_iUnion] - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - constructor - · rintro ⟨b, rfl, hlo, hhi⟩ - refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> - linarith [hlo.1, hlo.2, hhi.1, hhi.2] - · rintro ⟨b, rfl, hlo, hhi⟩ - refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> - linarith [hlo.1, hlo.2, hhi.1, hhi.2] - | @decompose q' hq' S' U' hS hcells hfoot hcent => - exact (BandTileSimultaneousInduction q' hq' U - (.decompose hq' hS hcells hfoot hcent)).2.2.2.1 + exact BandPrototileQuarterTurn.symmetry D U hU · intro q' T' U hq' hT' _ hlarge i hU hcentU exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.1 hlarge i U hU hcentU diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean index 735270c05e..0d416b21ec 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile public import LeanPool.ApollonianSuperharmonic.BandOdometerParentCentroids public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorWebRow @@ -26,25 +27,6 @@ namespace ApollonianSuperharmonic namespace LargestParentOdometerGeometry -private theorem band_of_odo : - (by - classical - exact - ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), TileOdometer c U k - → BandPrototile c U ) := by - classical - intro c U k hk - induction hk with - | line w x hw k hdom => exact BandPrototile.line w x hw - | unit z x U k hU hdom htrans => - cases U with - | mk cells anchor => - change cells = {x} at hU - rw [hU] - exact BandPrototile.unit z x anchor - | @decompose q hq S U hs k hU hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => - exact hU - private theorem firstRotateV : (by classical @@ -2035,7 +2017,7 @@ theorem BandOrderedGeneralLargestParentOdometerRows (marked = false -> FourNeighborLaplacian g x = 1) := by -- BODY classical - have band_of_odo := LargestParentOdometerGeometry.band_of_odo + have band_of_odo := TileOdometerBandPrototile let cOff (z : GaussianInt) : Real × Real := (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean index ec687256ef..546f3c22c9 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean @@ -411,54 +411,6 @@ private theorem hselectedAnchor : rw [hexteriorOccurrence] exact hselectedUnique.2 -private theorem hselectedFootprint : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (selectedSlot : Fin - (3 : ℕ)), ∀ (selectedSign : Bool), - let m : Int := if normalization.rightDirectionSlot = 0 then - (if normalization.rightNeighborPositive = true then 1 else -1) - else if normalization.rightDirectionSlot = 1 then 0 - else if normalization.rightNeighborPositive = true then -1 else 1 - let n : Int := if normalization.rightDirectionSlot = 0 then 0 - else if normalization.rightDirectionSlot = 1 then - (if normalization.rightNeighborPositive = true then 1 else -1) - else if normalization.rightNeighborPositive = true then -1 else 1 - let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => - if i = 0 then (if s = true then .A else .B) - else if i = 1 then (if s = true then .C else .D) - else (if s = true then .E else .F) - let exteriorIndex : PeriodicSubtileIndex := - ⟨labelOf selectedSlot selectedSign, m, n⟩ - (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u - normalization.layout.v exteriorIndex = TileTranslation (normalization.layout.P - selectedSlot selectedSign) normalization.rightNeighborDisplacement) → - ((FootprintVertices (normalization.pieces selectedSlot selectedSign) = - FootprintVertices (TileTranslation (normalization.layout.P selectedSlot selectedSign) - normalization.rightNeighborDisplacement) ∧ BoundaryFootprintVertices - (normalization.pieces selectedSlot selectedSign) = BoundaryFootprintVertices - (TileTranslation (normalization.layout.P selectedSlot selectedSign) - normalization.rightNeighborDisplacement) ∧ BoundaryFootprintEdges - (normalization.pieces selectedSlot selectedSign) = BoundaryFootprintEdges - (TileTranslation (normalization.layout.P selectedSlot selectedSign) - normalization.rightNeighborDisplacement) ∧ TileRealization (normalization.pieces - selectedSlot selectedSign) = TileRealization (TileTranslation (normalization.layout.P - selectedSlot selectedSign) normalization.rightNeighborDisplacement) ∧ TileCentroid - (normalization.pieces selectedSlot selectedSign) = TileCentroid (TileTranslation - (normalization.layout.P selectedSlot selectedSign) - normalization.rightNeighborDisplacement)) → (FootprintVertices (normalization.pieces - selectedSlot selectedSign) = FootprintVertices (SubtileOccurrenceInterpretation - normalization.layout.P normalization.layout.u normalization.layout.v exteriorIndex))) - ) := by - classical - intro C T N h k x normalization selectedSlot selectedSign m n labelOf exteriorIndex - hexteriorOccurrence hselectedObservables - rw [hexteriorOccurrence] - exact hselectedObservables.1 - private theorem hparentPositive : (by classical @@ -1030,8 +982,12 @@ theorem BandOrderedGeneralRightRoutingCertificateExists selectedSlot selectedSign hexteriorOccurrence hselectedUnique have hselectedAnchor := RightRoutingGeometry.hselectedAnchor C T N h k x normalization selectedSlot selectedSign hexteriorOccurrence hselectedUnique - have hselectedFootprint := RightRoutingGeometry.hselectedFootprint C T N h k x normalization - selectedSlot selectedSign hexteriorOccurrence hselectedObservables + have hselectedFootprint : + FootprintVertices (normalization.pieces selectedSlot selectedSign) = + FootprintVertices (SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v exteriorIndex) := by + rw [hexteriorOccurrence] + exact hselectedObservables.1 have hparentNonnegative : 0 ≤ (q selectedSlot.succ).1 := (ProperBandCurvatureStructure q normalization.configuration.proper).2.1 selectedSlot diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean index 0cff6a2fa2..ed8ff2a0d0 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean @@ -572,68 +572,6 @@ private theorem hFixedBand : simpa [Q] using normalization.normalized_parent_coordinate] exact TileOdometerBandPrototile _ _ _ normalization.normalized_fixed_odometer -private theorem hUcent : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), - let Q := normalization.normalizedPresentation - let incoming : Fin 3 → GaussianInt := fun j => - BandVectors.1 (Q j.succ) (Q 0) - let outgoing : Fin 3 → GaussianInt := fun j => - BandVectors.1 (Q 0) (Q j.succ) - (TileCentroid (SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v (if normalization.normalizedParentSlot - = (0 : Fin (3 : ℕ)) then if normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) - then (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if - normalization.normalizedQuarterTurn = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 - : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = - (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) - else (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if - normalization.normalizedParentSlot = (1 : Fin (3 : ℕ)) then if - normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.C, (1 - : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = - (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = (2 : Fin (4 : ℕ)) - then (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else - (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if - normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.E, (-1 - : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = - (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : - PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = (2 : Fin (4 : ℕ)) - then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else - (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex))) - TileCentroid - normalization.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ^ (↑normalization.normalizedQuarterTurn : ℕ) * (incoming - normalization.normalizedParentSlot + outgoing normalization.normalizedParentSlot))) → ( - let uIndex : PeriodicSubtileIndex := - if normalization.normalizedParentSlot = 0 then - if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 1, 1⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ - else ⟨.A, -1, -1⟩ - else if normalization.normalizedParentSlot = 1 then - if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, 0⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ - else ⟨.C, 1, 0⟩ - else if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 0, -1⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ - else ⟨.E, 0, 1⟩ - let U := SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v uIndex - TileCentroid U - TileCentroid normalization.normalizedRoot = (1 / 2 : Real) • - GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ normalization.normalizedQuarterTurn.val * - (incoming normalization.normalizedParentSlot + outgoing - normalization.normalizedParentSlot))) ) := by - classical - intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing hUcentroid uIndex U - simpa [U, uIndex] using hUcentroid - private theorem hfixedCent : (by classical @@ -1173,75 +1111,6 @@ private theorem hVSym : | exact normalization.layout.parent_quarter_turn 2 true | exact normalization.layout.parent_quarter_turn 2 false -private theorem hVcent : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), - let Q := normalization.normalizedPresentation - let incoming : Fin 3 → GaussianInt := fun j => - BandVectors.1 (Q j.succ) (Q 0) - let outgoing : Fin 3 → GaussianInt := fun j => - BandVectors.1 (Q 0) (Q j.succ) - (TileCentroid (SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v (if normalization.normalizedParentSlot - = (0 : Fin (3 : ℕ)) then if normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) - then (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if - normalization.normalizedQuarterTurn = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 - : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = - (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex) else (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex) else if normalization.normalizedParentSlot = (1 : Fin (3 : ℕ)) - then if normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) then - (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if - normalization.normalizedQuarterTurn = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 - : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = - (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : - PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : - PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = (0 : Fin (4 : ℕ)) - then (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if - normalization.normalizedQuarterTurn = (1 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 - : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if normalization.normalizedQuarterTurn = - (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) - else (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex))) - TileCentroid - normalization.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ^ (↑normalization.normalizedQuarterTurn : ℕ) * if Even - (↑normalization.normalizedQuarterTurn : ℕ) then incoming - (normalization.normalizedParentSlot + (1 : Fin (3 : ℕ))) - outgoing - (normalization.normalizedParentSlot + (1 : Fin (3 : ℕ))) else outgoing - (normalization.normalizedParentSlot - (1 : Fin (3 : ℕ))) - incoming - (normalization.normalizedParentSlot - (1 : Fin (3 : ℕ))))) → ( - let vIndex : PeriodicSubtileIndex := - if normalization.normalizedParentSlot = 0 then - if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 0⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, 0⟩ - else ⟨.E, -1, 0⟩ - else if normalization.normalizedParentSlot = 1 then - if normalization.normalizedQuarterTurn = 0 then ⟨.E, 0, 1⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 0, -1⟩ - else ⟨.A, 0, -1⟩ - else if normalization.normalizedQuarterTurn = 0 then ⟨.A, -1, -1⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 1, 1⟩ - else ⟨.C, 1, 1⟩ - let V := SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v vIndex - TileCentroid V - TileCentroid normalization.normalizedRoot = (1 / 2 : Real) • - GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ normalization.normalizedQuarterTurn.val * - (if Even normalization.normalizedQuarterTurn.val then incoming - (normalization.normalizedParentSlot + 1) - outgoing - (normalization.normalizedParentSlot + 1) else outgoing - (normalization.normalizedParentSlot - 1) - incoming - (normalization.normalizedParentSlot - 1)))) ) := by - classical - intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing hVcentroid vIndex V - simpa [V, vIndex] using hVcentroid - private theorem hVbarCent : (by classical @@ -1918,8 +1787,7 @@ private theorem rowPackage : have hUBand := SubtileInterfaceAssembly.hUBand C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization have hVBand := SubtileInterfaceAssembly.hVBand C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization - have hUcent := SubtileInterfaceAssembly.hUcent C₀ - Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization hUcentroid + have hUcent := hUcentroid have hfixedEq := BandPrototileCentroidUnique (Q normalization.normalizedParentSlot.succ) U normalization.normalizedFixed hUBand (SubtileInterfaceAssembly.hFixedBand C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization) @@ -1950,9 +1818,8 @@ private theorem rowPackage : (TileTranslationFormulas normalization.normalizedRoot _).1, hrootBar] · let Vbar := SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u normalization.layout.v vBar - have hrot := rotatedCentroid V Vbar _ (SubtileInterfaceAssembly.hVcent C₀ Cᵢ q i T₀ Tᵢ h₀ - hᵢ x normalization hVcentroid) (SubtileInterfaceAssembly.hVbarCent C₀ Cᵢ q i T₀ Tᵢ h₀ - hᵢ x normalization hflips rowsAt) + have hrot := rotatedCentroid V Vbar _ (by simpa [V, vIndex] using hVcentroid) + (SubtileInterfaceAssembly.hVbarCent C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization hflips rowsAt) exact (centeredCompare _ V Vbar hVBand (SubtileInterfaceAssembly.hVbarBand C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization occurrenceBand) (SubtileInterfaceAssembly.hVSym C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization quarterSymmetricTranslation) hrot).1 diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean index 555554b9d0..85347db21a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryDomainTransport public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorCovariance @@ -32,36 +33,6 @@ namespace ApollonianSuperharmonic namespace TileOdometerSymmetryProof -private theorem positiveCells : - (by - classical - exact - ∀ (D : CircleCoordinates), ∀ (V : ProtoTile), 0 < D.1 → BandPrototile D V → - V.cells.Nonempty ) := by - classical - intro D V hD hV - induction hV with - | line w x hw => simp at hD - | unit z x anchor => simp - | @decompose q hq S V hS hcells hfoot hcentroid ih => - have facts := ProperBandCurvatureStructure q hq - have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by - by_cases h0 : 0 < (q (0 : Fin 3).succ).1 - · exact ⟨0, h0⟩ - by_cases h1 : 0 < (q (1 : Fin 3).succ).1 - · exact ⟨1, h1⟩ - by_cases h2 : 0 < (q (2 : Fin 3).succ).1 - · exact ⟨2, h2⟩ - have n0 := facts.2.1 (0 : Fin 3) - have n1 := facts.2.1 (1 : Fin 3) - have n2 := facts.2.1 (2 : Fin 3) - have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega - have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega - exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim - rcases hp with ⟨i, hi⟩ - rcases ih i false hi with ⟨x, hx⟩ - exact ⟨x, (hcells x).mpr ⟨i, false, hx⟩⟩ - private theorem odoPositiveCurvature : (by classical @@ -1902,7 +1873,7 @@ theorem BandPackingSymmetryTileOdometerCovariance -- BODY classical have domain := (BandPackingSymmetryPartialOdometerActionFormulas g h h).1 - have positiveCells := TileOdometerSymmetryProof.positiveCells + have positiveCells := BandPrototileNonempty.positive have odoPositiveCurvature := TileOdometerSymmetryProof.odoPositiveCurvature have slopeCov := TileOdometerSymmetryProof.slopeCov g odoPositiveCurvature have slope := slopeCov C T h hO diff --git a/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean b/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean index b3d7cc25ff..cbb58b91c5 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile public import LeanPool.ApollonianSuperharmonic.CircleMatrixSymmetry public import LeanPool.ApollonianSuperharmonic.BandOdometerInteriorTable @@ -182,24 +183,6 @@ private theorem hK : dsimp [K] nlinarith -private theorem tile_band : - (by - classical - exact - ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), TileOdometer c U k - → BandPrototile c U ) := by - classical - intro c U k ho - induction ho with - | line w z hw k hd => exact BandPrototile.line w z hw - | unit z x U k hU hd ht => - cases U with - | mk cells anchor => - simp_all only - exact BandPrototile.unit z x anchor - | @decompose q hq S U hs k hU hsub hc hf hcent hd hv hcomp hsl ih => - exact BandPrototile.decompose hq (fun i s => ih i s) hc hf hcent - private theorem local_bound : (by classical @@ -452,7 +435,7 @@ theorem BandPeriodicSuperharmonicity (C : BandCircle) nlinarith · intro x have hlocal := (PeriodicSuperharmonicGeometry.local_bound g - (PeriodicSuperharmonicGeometry.tile_band)) _ _ _ hodo hext + (TileOdometerBandPrototile)) _ _ _ hodo hext have lap_periodic := PeriodicSuperharmonicGeometry.lap_periodic C g hcocycle by_cases hr : C.1.1.1 = 1 · generalize hc : C.1.1 = c at hT hodo diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileNonempty.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileNonempty.lean new file mode 100644 index 0000000000..52f6d73584 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileNonempty.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototile + +/-! +# Nonempty positive-curvature band prototiles + +Shared from the nonemptiness arguments in Wesley Pegden’s Apache-2.0 formalization. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic.BandPrototileNonempty + +/-- A band prototile of positive curvature contains a lattice cell. -/ +theorem positive (D : CircleCoordinates) (V : ProtoTile) + (hD : 0 < D.1) (hV : BandPrototile D V) : V.cells.Nonempty := by + classical + induction hV with + | line w x hw => simp at hD + | unit z x anchor => simp + | @decompose q hq S V hS hcells hfoot hcentroid ih => + have facts := ProperBandCurvatureStructure q hq + have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by + by_cases h0 : 0 < (q (0 : Fin 3).succ).1 + · exact ⟨0, h0⟩ + by_cases h1 : 0 < (q (1 : Fin 3).succ).1 + · exact ⟨1, h1⟩ + have n0 := facts.2.1 (0 : Fin 3) + have n1 := facts.2.1 (1 : Fin 3) + have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega + have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega + exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim + rcases hp with ⟨i, hi⟩ + rcases ih i false hi with ⟨x, hx⟩ + exact ⟨x, (hcells x).mpr ⟨i, false, hx⟩⟩ + +end ApollonianSuperharmonic.BandPrototileNonempty + +end diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean index cc2413924a..4da9aaa2d0 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation @@ -109,48 +110,16 @@ private theorem positiveChild : dsimp at h e f g omega -private theorem positiveCells : - (∀ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → 0 < (r 0).1 → ∃ j : Fin 3, 0 < (r - j.succ).1) → (∀ (C : CircleCoordinates), ∀ (P : ProtoTile), 0 < C.1 → BandPrototile C P → - P.cells.Nonempty) := by - classical - intro positiveChild C P hC hP - induction hP with - | line w x hw => - simp at hC - | unit z x anchor => - simp - | @decompose q hq S V hS hcells hfoot hcentroid ih => - rcases positiveChild q hq.1 (by simpa using hC) with ⟨j, hj⟩ - have hp := ih j false hj - rcases hp with ⟨a, ha⟩ - exact ⟨a, (hcells a).mpr ⟨j, false, ha⟩⟩ - -private theorem vectorMatch : - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (q' : Fin - (4 : ℕ) → CircleCoordinates), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (r : Fin (3 : - ℕ)), (∀ (j : Fin (3 : ℕ)), q' j.succ = q (j + r).succ) → ((∀ (y : Fin (3 : ℕ)), (fun (r : - Fin (3 : ℕ)) => ∀ (j : Fin (3 : ℕ)), q' j.succ = q (j + r).succ) y → y = r) → (∀ (k : Fin - (3 : ℕ)), ((0 : ℤ) < (q k.succ).1) → ( - let i : Fin 3 := k - r - (q' i.succ = q k.succ) → (∀ (u : GaussianInt), ((S k true).cells = (TileTranslation (S' i - true) u).cells) → (((S k true).cells = ∅ → (S k true).anchor = (TileTranslation (S' i - true) u).anchor) → (((S k true).cells.Nonempty) → (((TileTranslation (S' i true) - u).cells.Nonempty) → ((TileCentroid (S k true) = TileCentroid (TileTranslation (S' i - true) u)) → (BandVectors.1 (q' ((i + 2).succ)) (q' ((i + 1).succ)) = BandVectors.1 (q ((k - + 2).succ)) (q ((k + 1).succ))))))))))) := by - classical - intro q S q' S' r hrotation hunique k hk i hi u hcellsParent hemptyParent nonemptyParent - translatedNonempty parentCentroid - have idxA : (i + 2 + r : Fin 3) = k + 2 := by - fin_cases k <;> fin_cases r <;> simp [i] - have idxB : (i + 1 + r : Fin 3) = k + 1 := by - fin_cases k <;> fin_cases r <;> simp [i] - have ha := hrotation (i + 2) - have hb := hrotation (i + 1) - rw [idxA] at ha - rw [idxB] at hb - rw [ha, hb] +private theorem vectorMatch {α β : Type*} (f : α → α → β) + (q q' : Fin 4 → α) (r k : Fin 3) + (hrotation : ∀ j : Fin 3, q' j.succ = q (j + r).succ) : + f (q' ((k - r + 2).succ)) (q' ((k - r + 1).succ)) = + f (q ((k + 2).succ)) (q ((k + 1).succ)) := by + have idxA : (k - r + 2 + r : Fin 3) = k + 2 := by + fin_cases k <;> fin_cases r <;> decide + have idxB : (k - r + 1 + r : Fin 3) = k + 1 := by + fin_cases k <;> fin_cases r <;> decide + rw [hrotation, hrotation, idxA, idxB] private theorem childCentroid : ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (V : ProtoTile), ∀ (S' : Fin (3 : ℕ) → Bool → @@ -191,8 +160,7 @@ theorem BandPrototileTranslationNormalForm (C : CircleCoordinates) SemiProperQuadruple r → 0 < (r 0).1 → ∃ j : Fin 3, 0 < (r j.succ).1 := TranslationNormalFormProof.positiveChild nonnegative have positiveCells : ∀ (C : CircleCoordinates) (P : ProtoTile), - 0 < C.1 → BandPrototile C P → P.cells.Nonempty := TranslationNormalFormProof.positiveCells - positiveChild + 0 < C.1 → BandPrototile C P → P.cells.Nonempty := BandPrototileNonempty.positive refine BandPrototile.rec (motive := fun C T _ => ∀ U, BandPrototile C U → ∃ u : GaussianInt, T.cells = (TileTranslation U u).cells ∧ @@ -269,8 +237,7 @@ theorem BandPrototileTranslationNormalForm (C : CircleCoordinates) have vectorMatch : BandVectors.1 (q' ((i + 2).succ)) (q' ((i + 1).succ)) = BandVectors.1 (q ((k + 2).succ)) (q ((k + 1).succ)) := - TranslationNormalFormProof.vectorMatch q S q' S' r hrotation hunique k hk hi u - hcellsParent hemptyParent nonemptyParent translatedNonempty parentCentroid + TranslationNormalFormProof.vectorMatch BandVectors.1 q q' r k hrotation have differenceMatch : TileCentroid (S k true) - TileCentroid V = TileCentroid (S' i true) - TileCentroid W := by diff --git a/LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean b/LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean index 6db3d648cb..5ce8ccf7c4 100644 --- a/LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean +++ b/LeanPool/ApollonianSuperharmonic/ForwardBoundaryStringData.lean @@ -30,57 +30,6 @@ namespace ApollonianSuperharmonic namespace ForwardBoundaryGeometry -private theorem hroot : - (by - classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), (ProperBandQuadruple q) → ((BandCircle) → (∀ (i : Fin - 3), (0 < (q i.succ).1) → (1 < (q 0).1))) ) := by - classical - intro q hq Cᵢ i hparent - have hlt := hq.2 i - omega - -private theorem hcyclic : - (by - classical - exact - ∀ (q : Fin 4 -> CircleCoordinates), (ProperBandQuadruple q) → (∀ (Cᵢ : BandCircle), ∀ (i - : Fin 3), (q i.succ = Cᵢ.1.1) → (∀ (orientation : Bool), (Cᵢ.1.1.1 = (1 : ℤ) → - UnitOccurrenceOrientation q i orientation) → ((0 < (q i.succ).1) → (∀ (S : Fin (3 : - ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), - let B := S i false - let g := hs i false - (TileOdometer Cᵢ.1.1 B g) → ((BandPrototile Cᵢ.1.1 B) → (∀ (pouter : ℝ × ℝ), ∀ (pseed : ℝ - × ℝ), (PartialOdometerSlope (hs i false) = some pseed) → ((pseed.1 - pouter.1 = (if - false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 - : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q - (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((pseed.2 - - pouter.2 = (if false = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * - ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : - ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : - Fin (3 : ℕ))).succ)).re : ℝ))) → (BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) - + BandVectors.1 (q i.succ) (q ((i + 2).succ)) + BandVectors.1 (q ((i + 1).succ)) (q - i.succ) = 0 ∧ BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + BandVectors.2 (q - i.succ) (q ((i + 2).succ)) + BandVectors.2 (q ((i + 1).succ)) (q i.succ) = 0 ∧ - BandVectors.1 (q i.succ) (q 0) = BandVectors.1 (q i.succ) (q ((i + 2).succ)) - (⟨0, - 1⟩ : GaussianInt) * BandVectors.1 (q ((i + 1).succ)) (q i.succ) ∧ BandVectors.2 (q - i.succ) (q 0) = BandVectors.2 (q i.succ) (q ((i + 2).succ)) + (⟨0, 1⟩ : GaussianInt) - * BandVectors.2 (q ((i + 1).succ)) (q i.succ)))))))))) ) := by - classical - intro q hq Cᵢ i hCᵢ orientation horientation hparent S hs B g hBodometer hB pouter pseed hpseed - hpre hpim - fin_cases i - · have h := VectorRecursionLaws q hq.1 - simpa using And.intro h.1 (And.intro h.2.1 (And.intro h.2.2.1 h.2.2.2.1)) - · have h := VectorRecursionLaws ![q 0, q 2, q 3, q 1] - (SemiProperQuadruple.rotate hq.1) - simpa using And.intro h.1 (And.intro h.2.1 (And.intro h.2.2.1 h.2.2.2.1)) - · have hr : SemiProperQuadruple ![q 0, q 3, q 1, q 2] := by - simpa using SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1) - have h := VectorRecursionLaws ![q 0, q 3, q 1, q 2] hr - simpa using And.intro h.1 (And.intro h.2.1 (And.intro h.2.2.1 h.2.2.2.1)) - private theorem hseedIdentity : (by classical @@ -249,7 +198,9 @@ theorem ForwardBoundaryStringData -- BODY have hparent : 0 < (q i.succ).1 := by simpa only [hCᵢ] using hpositive - have hroot : 1 < (q 0).1 := ForwardBoundaryGeometry.hroot q hq Cᵢ i hparent + have hroot : 1 < (q 0).1 := by + have hlt := hq.2 i + omega have houter : TileOdometer (q 0) T₀ h₀ := by simpa only [hC₀] using hO₀ obtain ⟨S, hs, hT₀, hsub, _, _, hcentroid, _, _, _, hslope⟩ := @@ -276,8 +227,7 @@ theorem ForwardBoundaryStringData BandVectors.2 (q i.succ) (q 0) = BandVectors.2 (q i.succ) (q ((i + 2).succ)) + (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q ((i + 1).succ)) (q i.succ) := - ForwardBoundaryGeometry.hcyclic q hq Cᵢ i hCᵢ orientation horientation hparent S - hs hBodometer hB pouter pseed hpseed hpre hpim + VectorRecursionLaws.cyclic q hq.1 i obtain ⟨hvsum, hasum, hvchild, hachild⟩ := hcyclic obtain ⟨hvflip, haflip⟩ := (VectorRecursionLaws q hq.1).2.2.2.2 hq i have hseedIdentity : diff --git a/LeanPool/ApollonianSuperharmonic/Imports.lean b/LeanPool/ApollonianSuperharmonic/Imports.lean index 48bcbedb1d..ccd1499efc 100644 --- a/LeanPool/ApollonianSuperharmonic/Imports.lean +++ b/LeanPool/ApollonianSuperharmonic/Imports.lean @@ -151,6 +151,7 @@ public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.BandPrototileCompleteSquareCentroid public import LeanPool.ApollonianSuperharmonic.BandPrototileExists public import LeanPool.ApollonianSuperharmonic.BandPrototileFootprintSlopeCovariance +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.BandPrototileQuarterTurn public import LeanPool.ApollonianSuperharmonic.BandPrototileReindexedDecomposition public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslation diff --git a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean index 21d0510470..9f28d70f04 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction public import LeanPool.ApollonianSuperharmonic.RightLatticeAdjacent @@ -26,57 +28,6 @@ namespace ApollonianSuperharmonic namespace LatticeInterfacePathGeometry -private theorem band_of_odometer : - (by - classical - exact - ∀ (C : CircleCoordinates), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), (TileOdometer C T - h) → (BandPrototile C T) ) := by - classical - intro C T h ho - induction ho with - | line w x hw => exact BandPrototile.line w x hw - | unit z x T h hT hdom htrans => - cases T with - | mk cells anchor => - simp only [] at hT - subst cells - exact BandPrototile.unit z x anchor - | decompose hq hT hsub hcells hfoot hcent hdom hvalue hcompat hslope => exact hT - -private theorem positive_nonempty : - (by - classical - exact - ∀ (C : CircleCoordinates), ∀ (T : ProtoTile), (BandPrototile C T) → (0 < C.1 → - T.cells.Nonempty) ) := by - classical - intro C T hT - induction hT with - | line w x hw => - intro hpos - simp at hpos - | unit z x a => - intro hpos - exact ⟨x, by simp⟩ - | @decompose q hq S T hS hcells hfoot hcent ih => - intro hpos - have hs := ProperBandCurvatureStructure q hq - have hsome : ∃ i : Fin 3, 0 < (q i.succ).1 := by - by_contra hn - have hz : ∀ i : Fin 3, (q i.succ).1 = 0 := by - intro i - have hn' : ¬ 0 < (q i.succ).1 := by - intro hp - exact hn ⟨i, hp⟩ - exact le_antisymm (by linarith [hs.2.1 i]) (hs.2.1 i) - have h01 := hs.2.2 0 1 (hz 0) (hz 1) - exact (by decide : (0 : Fin 3) ≠ 1) h01 - obtain ⟨i, hi⟩ := hsome - have hchild := ih i true hi - obtain ⟨x, hx⟩ := hchild - exact ⟨x, (hcells x).2 ⟨i, true, hx⟩⟩ - private theorem incident_boundary : (by classical @@ -849,10 +800,10 @@ theorem LatticeAdjacentInterfacePath : classical have band_of_odometer (C : CircleCoordinates) (T : ProtoTile) (h : PartialOdometer) (ho : TileOdometer C T h) : BandPrototile C T := - LatticeInterfacePathGeometry.band_of_odometer C T h ho + TileOdometerBandPrototile C T h ho have positive_nonempty : ∀ (C : CircleCoordinates) (T : ProtoTile) (hT : BandPrototile C T), 0 < C.1 → T.cells.Nonempty := - LatticeInterfacePathGeometry.positive_nonempty + (fun D V hV hD => BandPrototileNonempty.positive D V hD hV) have incident_boundary (U V : ProtoTile) (x : GaussianInt) (hd : Disjoint U.cells V.cells) (hu : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells) diff --git a/LeanPool/ApollonianSuperharmonic/LeftAdjacentOdometerCompatibility.lean b/LeanPool/ApollonianSuperharmonic/LeftAdjacentOdometerCompatibility.lean index 1c54712715..ddff03540e 100644 --- a/LeanPool/ApollonianSuperharmonic/LeftAdjacentOdometerCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/LeftAdjacentOdometerCompatibility.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileQuarterTurn public import LeanPool.ApollonianSuperharmonic.P4261T2UnitStringTelescoping public import LeanPool.ApollonianSuperharmonic.P4261T2DiamondBoundary @@ -163,29 +164,7 @@ private theorem layout : have hI := BandTileSimultaneousInduction q' hq' T' hT' exact ⟨hI.1, hI.2.1, hI.2.2.1 S' hocc hcells⟩ · intro E U hU _ - cases hU with - | line w z hw => - intro p - simp [TileRealization, TileCentroid] - | unit z a anchor => - intro p - have hc : TileCentroid (⟨{a}, anchor⟩ : ProtoTile) = - (((a.re : Int) : Real) + (1 / 2 : Real), - ((a.im : Int) : Real) + (1 / 2 : Real)) := by simp [TileCentroid] - rw [hc] - rcases p with ⟨px, py⟩ - simp only [TileRealization, Finset.mem_singleton, Set.mem_iUnion] - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - constructor - · rintro ⟨b, rfl, hlo, hhi⟩ - refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> - linarith [hlo.1, hlo.2, hhi.1, hhi.2] - · rintro ⟨b, rfl, hlo, hhi⟩ - refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> - linarith [hlo.1, hlo.2, hhi.1, hhi.2] - | @decompose q' hq' S' U' hS hcells hfoot hcent => - exact (BandTileSimultaneousInduction q' hq' U - (.decompose hq' hS hcells hfoot hcent)).2.2.2.1 + exact BandPrototileQuarterTurn.symmetry E U hU · intro q' T' U hq' hT' _ hlarge i hU hcentU exact (BandTileSimultaneousInduction q' hq' T' hT').2.2.2.2.2.1 hlarge i U hU hcentU diff --git a/LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean index 2120499daa..f1bee5ee48 100644 --- a/LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.OdometerStringRespectCentralCovariance public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerSupportTransport @@ -40,29 +41,7 @@ theorem OdometerStringRespectRegularFamilyCentralCovariance classical have desiredString := hreverse rcases hreverse with ⟨hbase, hhead, hlast, hpair, hmem, hchain, hheight⟩ - have positive_cells : ∀ (D : CircleCoordinates) (W : ProtoTile), - 0 < D.1 → BandPrototile D W → W.cells.Nonempty := by - intro D W hD hW - induction hW with - | line w x hw => simp at hD - | unit z x => simp - | @decompose q hq S W hS hcells' hfoot hcentroid ih => - have facts := ProperBandCurvatureStructure q hq - have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by - by_cases h0 : 0 < (q (0 : Fin 3).succ).1 - · exact ⟨0, h0⟩ - by_cases h1 : 0 < (q (1 : Fin 3).succ).1 - · exact ⟨1, h1⟩ - by_cases h2 : 0 < (q (2 : Fin 3).succ).1 - · exact ⟨2, h2⟩ - have n0 := facts.2.1 (0 : Fin 3) - have n1 := facts.2.1 (1 : Fin 3) - have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega - have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega - exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim - rcases hp with ⟨i, hi⟩ - rcases ih i false hi with ⟨x, hx⟩ - exact ⟨x, (hcells' x).mpr ⟨i, false, hx⟩⟩ + have positive_cells := BandPrototileNonempty.positive have band_of_member : ∀ {W : ProtoTile}, W ∈ RegularTileFamily base (TilingLattice C) → BandPrototile C.1.1 W := by intro W hW diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean index bf3a404aa6..2fa535e18c 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.AncestorOdometerCentralCovariance public import LeanPool.ApollonianSuperharmonic.AncestorOdometerOuterSupportNormalization @@ -120,35 +121,6 @@ private theorem hC₀positive : rw [hC₀] at hlt omega -private theorem positive_cells : - (by - classical - exact - (BandCircle) → ((BandCircle) → (∀ (D : CircleCoordinates), ∀ (V : ProtoTile), 0 < D.1 → - BandPrototile D V → V.cells.Nonempty)) ) := by - classical - intro C₀ Cᵢ D V hD hV - induction hV with - | line w x hw => simp at hD - | unit z x anchor => simp - | @decompose qd hqd S V hS hcells hfoot hcentroid ih => - have facts := ProperBandCurvatureStructure qd hqd - have hp : ∃ j : Fin 3, 0 < (qd j.succ).1 := by - by_cases h0 : 0 < (qd (0 : Fin 3).succ).1 - · exact ⟨0, h0⟩ - by_cases h1 : 0 < (qd (1 : Fin 3).succ).1 - · exact ⟨1, h1⟩ - by_cases h2 : 0 < (qd (2 : Fin 3).succ).1 - · exact ⟨2, h2⟩ - have n0 := facts.2.1 (0 : Fin 3) - have n1 := facts.2.1 (1 : Fin 3) - have z0 : (qd (0 : Fin 3).succ).1 = 0 := by omega - have z1 : (qd (1 : Fin 3).succ).1 = 0 := by omega - exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim - rcases hp with ⟨j, hj⟩ - rcases ih j false hj with ⟨x, hx⟩ - exact ⟨x, (hcells x).mpr ⟨j, false, hx⟩⟩ - private theorem hbarO : (by classical @@ -2145,7 +2117,7 @@ theorem OpposingBoundaryOdometerStrings simpa [pminus, d, hpouter_eq] using hseedSlopeData have hsminus := OpposingBoundaryGeometry.hsminus q i p₀ hseed pseed hseedSlope hminusSlopeCalc have hC₀positive := OpposingBoundaryGeometry.hC₀positive q hq C₀ Cᵢ i hC₀ hCᵢ hpositive - have positive_cells := OpposingBoundaryGeometry.positive_cells C₀ Cᵢ + have positive_cells := BandPrototileNonempty.positive let hbar := PartialOdometerAffineTranslate (PartialOdometerHalfTurn h₀) centerShift 0 0 let Tbar := TileTranslation (TileHalfTurn T₀) centerShift diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1BandQuarterTurn.lean b/LeanPool/ApollonianSuperharmonic/P4055T1BandQuarterTurn.lean index ef8a619e75..eb9b7f1fb3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1BandQuarterTurn.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1BandQuarterTurn.lean @@ -6,8 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileQuarterTurn -public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction -- [TABLET NODE: P4055T1BandQuarterTurn] @@ -25,30 +25,7 @@ namespace ApollonianSuperharmonic theorem P4055T1BandQuarterTurn (D : CircleCoordinates) (V : ProtoTile) (hV : BandPrototile D V) : QuarterTurnSymmetric V := by -- BODY - cases hV with - | line w z hw => - intro p - simp [TileRealization, TileCentroid] - | unit z a anchor => - intro p - have hc : TileCentroid (⟨{a}, anchor⟩ : ProtoTile) = - (((a.re : Int) : Real) + (1 / 2 : Real), - ((a.im : Int) : Real) + (1 / 2 : Real)) := by - simp [TileCentroid] - rw [hc] - rcases p with ⟨px, py⟩ - simp only [TileRealization, Finset.mem_singleton, Set.mem_iUnion] - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - constructor - · rintro ⟨b, rfl, hlo, hhi⟩ - refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> - linarith [hlo.1, hlo.2, hhi.1, hhi.2] - · rintro ⟨b, rfl, hlo, hhi⟩ - refine ⟨b, rfl, ?_, ?_⟩ <;> constructor <;> - linarith [hlo.1, hlo.2, hhi.1, hhi.2] - | @decompose q hq S V hS hcells hfoot hcent => - exact (BandTileSimultaneousInduction q hq V - (.decompose hq hS hcells hfoot hcent)).2.2.2.1 + exact BandPrototileQuarterTurn.symmetry D V hV end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean b/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean index 893a0cd8d4..7b501e9485 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.P4250T1SlopeOffset public import LeanPool.ApollonianSuperharmonic.RightSubtileOdometerCompatibility @@ -1650,37 +1651,6 @@ private theorem properLarge : have hlt := hr.2 i omega -private theorem bandPositiveNonempty : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (D : - CircleCoordinates), ∀ (X : ProtoTile), BandPrototile D X → 0 < D.1 → - X.cells.Nonempty) ) := by - classical - intro q cfg D X hX - induction hX with - | line w x hw => intro hp; simp at hp - | unit z x a => intro hp; exact ⟨x, by simp⟩ - | @decompose r hr S X hS hc hf hcent ih => - intro hp - have facts := ProperBandCurvatureStructure r hr - have hsome : ∃ i : Fin 3, 0 < (r i.succ).1 := by - by_cases h0 : 0 < (r (0 : Fin 3).succ).1 - · exact ⟨0, h0⟩ - by_cases h1 : 0 < (r (1 : Fin 3).succ).1 - · exact ⟨1, h1⟩ - by_cases h2 : 0 < (r (2 : Fin 3).succ).1 - · exact ⟨2, h2⟩ - have z0 : (r (0 : Fin 3).succ).1 = 0 := by - have hn := facts.2.1 0; omega - have z1 : (r (1 : Fin 3).succ).1 = 0 := by - have hn := facts.2.1 1; omega - exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim - obtain ⟨i, hi⟩ := hsome - obtain ⟨x, hx⟩ := ih i true hi - exact ⟨x, (hc x).mpr ⟨i, true, hx⟩⟩ - private theorem qSCells : (by classical @@ -3374,7 +3344,7 @@ theorem P4250T1NestedCompatibility (NestedCompatibilityGeometry.hcenterQ3 q cfg C T cert U hcentA alignA hcenterA)) (NestedCompatibilityGeometry.crossSlope2 q cfg s0 hpredA secondFlip (NestedCompatibilityGeometry.hIneg hI2) (NestedCompatibilityGeometry.hI3neg hI2) hIprod)) - have bandPositiveNonempty := NestedCompatibilityGeometry.bandPositiveNonempty q cfg + have bandPositiveNonempty := (fun D V hV hD => BandPrototileNonempty.positive D V hD hV) have qSCells := NestedCompatibilityGeometry.qSCells q cfg C T cert have qSAnchor := NestedCompatibilityGeometry.qSAnchor q cfg C T cert have uvCells := NestedCompatibilityGeometry.uvCells q cfg C T cert U V alignA alignB qSCells diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean index bc197b9b06..30a647088e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification @@ -52,36 +53,6 @@ private theorem hcurvi : rw [hCi] omega -private theorem positive_nonempty : - (by - classical - exact - (Fin 4 -> CircleCoordinates) → ((BandCircle) → ((Fin 3) → (∀ (D : CircleCoordinates), ∀ - (U : ProtoTile), BandPrototile D U → 0 < D.1 → U.cells.Nonempty))) ) := by - classical - intro q Ci i D U hU - induction hU with - | line w x hw => intro hp; simp at hp - | unit z x a => intro hp; exact ⟨x, by simp⟩ - | @decompose r hr S U hs hc hf' hcent ih => - intro hp - have str := ProperBandCurvatureStructure r hr - have pos : ∃ j : Fin 3, 0 < (r j.succ).1 := by - by_contra hn - push Not at hn - have z0 : (r (0 : Fin 3).succ).1 = 0 := by - have := str.2.1 0 - have h := hn 0 - omega - have z1 : (r (1 : Fin 3).succ).1 = 0 := by - have := str.2.1 1 - have h := hn 1 - omega - exact (by decide : (0 : Fin 3) ≠ 1) (str.2.2 0 1 z0 z1) - obtain ⟨j, hj⟩ := pos - obtain ⟨x, hx⟩ := ih j true hj - exact ⟨x, (hc x).mpr ⟨j, true, hx⟩⟩ - private theorem hcplus : (by classical @@ -1368,7 +1339,8 @@ theorem P4366T2OuterGeometry have hcurv0 : 0 < (q 0).1 := OuterGeometry.hcurv0 q C0 hC0 have hcurvi : 0 < (q i.succ).1 := OuterGeometry.hcurvi q Ci i hCi hlarge have positive_nonempty : ∀ (D : CircleCoordinates) (U : ProtoTile), - BandPrototile D U → 0 < D.1 → U.cells.Nonempty := OuterGeometry.positive_nonempty q Ci i + BandPrototile D U → 0 < D.1 → U.cells.Nonempty := + fun D V hV hD => BandPrototileNonempty.positive D V hD hV have hT0 : BandPrototile C0.1.1 T0 := TileOdometerBandPrototile _ _ _ hO0 have hT0' : BandPrototile C0.1.1 T0' := TileOdometerBandPrototile _ _ _ hO0' have hRm : BandPrototile Ci.1.1 Rminus := TileOdometerBandPrototile _ _ _ hOm diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean index c7c5c5abad..c0d9daa273 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.BoundaryFrameJoinGeometry public import LeanPool.ApollonianSuperharmonic.BoundaryFrameRowGeometry @@ -293,39 +294,6 @@ private theorem hjoinOdo : (by rw [← F.parent]; exact hselectedOdo) hjoinBand hjoinCells.1 -private theorem positiveCells : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), - (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → (∀ (c : - CircleCoordinates), ∀ (T : ProtoTile), 0 < c.1 → BandPrototile c T → - T.cells.Nonempty) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F c T hc hT - induction hT with - | line w z hw => simp at hc - | unit z x anchor => simp - | @decompose q hq S T hs hcells hfoot hcentroid ih => - have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by - by_cases h0 : 0 < (q (0 : Fin 3).succ).1 - · exact ⟨0, h0⟩ - by_cases h1 : 0 < (q (1 : Fin 3).succ).1 - · exact ⟨1, h1⟩ - by_cases h2 : 0 < (q (2 : Fin 3).succ).1 - · exact ⟨2, h2⟩ - have facts := ProperBandCurvatureStructure q hq - have n0 := facts.2.1 (0 : Fin 3) - have n1 := facts.2.1 (1 : Fin 3) - have hzero0 : (q (0 : Fin 3).succ).1 = 0 := by omega - have hzero1 : (q (1 : Fin 3).succ).1 = 0 := by omega - exact False.elim ((by decide : (0 : Fin 3) ≠ 1) - (facts.2.2 0 1 hzero0 hzero1)) - rcases hp with ⟨i, hi⟩ - rcases ih i false hi with ⟨x, hx⟩ - exact ⟨x, (hcells x).mpr ⟨i, false, hx⟩⟩ - private theorem hjoinFootEq : (by classical @@ -2505,8 +2473,7 @@ theorem P4458T1LargestParentRows D hCpositive hselectedOdo u hjoinBand hjoinCells have hjoinAncestor := BoundaryFrameJoinGeometry.joinAncestor C orientation base Rminus Rplus hminus hplus F D hCpositive hstrict hselectedAnc u hjoinBand hjoinCells - have positiveCells := LargestParentGeometry.positiveCells C orientation base Rminus Rplus - hminus hplus F + have positiveCells := BandPrototileNonempty.positive have hUnonempty : (D.tiles F.slot false).cells.Nonempty := positiveCells _ _ hCpositive hUband have hJnonempty : join.cells.Nonempty := by rw [← hjoinCells.1]; exact hUnonempty diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean index 6079b8dd4f..c3f21d95eb 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.BoundaryFrameJoinGeometry public import LeanPool.ApollonianSuperharmonic.BoundaryFrameRowGeometry @@ -102,39 +103,6 @@ private theorem hjoinOdo : hselectedOdo' hjoinBand hjoinCells.1 -private theorem positiveCells : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), - (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → ((Fin (4 : ℕ) - → CircleCoordinates) → (∀ (c : CircleCoordinates), ∀ (T : ProtoTile), 0 < c.1 → - BandPrototile c T → T.cells.Nonempty)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F p c T hc hT - induction hT with - | line w z hw => simp at hc - | unit z x anchor => simp - | @decompose q hq S T hs hcells hfoot hcentroid ih => - have hp' : ∃ i : Fin 3, 0 < (q i.succ).1 := by - by_cases h0 : 0 < (q (0 : Fin 3).succ).1 - · exact ⟨0, h0⟩ - by_cases h1 : 0 < (q (1 : Fin 3).succ).1 - · exact ⟨1, h1⟩ - by_cases h2 : 0 < (q (2 : Fin 3).succ).1 - · exact ⟨2, h2⟩ - have facts := ProperBandCurvatureStructure q hq - have n0 := facts.2.1 (0 : Fin 3) - have n1 := facts.2.1 (1 : Fin 3) - have hzero0 : (q (0 : Fin 3).succ).1 = 0 := by omega - have hzero1 : (q (1 : Fin 3).succ).1 = 0 := by omega - exact False.elim ((by decide : (0 : Fin 3) ≠ 1) - (facts.2.2 0 1 hzero0 hzero1)) - rcases hp' with ⟨i, hi⟩ - rcases ih i false hi with ⟨x, hx⟩ - exact ⟨x, (hcells x).mpr ⟨i, false, hx⟩⟩ - private theorem hjoinFootEq : (by classical @@ -4093,8 +4061,7 @@ theorem P4458T1SecondNewerRows : hplus F D hselectedOdo u hjoinBand hjoinCells have hjoinAncestor := BoundaryFrameJoinGeometry.joinAncestor C orientation base Rminus Rplus hminus hplus F D hCpositive hstrict hselectedAnc u hjoinBand hjoinCells - have positiveCells := SecondNewerRowsGeometry.positiveCells C orientation base Rminus Rplus - hminus hplus F p + have positiveCells := BandPrototileNonempty.positive have hUnonempty : (D.tiles F.slot false).cells.Nonempty := positiveCells _ _ hCpositive hUband have hJoinNonemptyBase : join.cells.Nonempty := by rw [← hjoinCells.1]; exact hUnonempty diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean b/LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean index ceaf255e92..fb49155d7f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean +++ b/LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralOdometerRowData public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryTileOdometerCovariance @@ -124,27 +125,7 @@ theorem P5472T1FordSlopeDifference apply Prod.ext · cases b <;> simpa [hAreal, smul_eq_mul] using hdx · cases b <;> simpa [hAreal, smul_eq_mul] using hdy - have positiveCells : ∀ (D : CircleCoordinates) (V : ProtoTile), - 0 < D.1 → BandPrototile D V → V.cells.Nonempty := by - intro D V hD hV - induction hV with - | line w x hw => simp at hD - | unit z x anchor => simp - | @decompose q hq S V hS hcells hfoot hcentroid ih => - have facts := ProperBandCurvatureStructure q hq - have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by - by_cases h0 : 0 < (q (0 : Fin 3).succ).1 - · exact ⟨0, h0⟩ - by_cases h1 : 0 < (q (1 : Fin 3).succ).1 - · exact ⟨1, h1⟩ - have n0 := facts.2.1 (0 : Fin 3) - have n1 := facts.2.1 (1 : Fin 3) - have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega - have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega - exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim - rcases hp with ⟨i, hi⟩ - rcases ih i false hi with ⟨z, hz⟩ - exact ⟨z, (hcells z).mpr ⟨i, false, hz⟩⟩ + have positiveCells := BandPrototileNonempty.positive have hTne := positiveCells (q 0) T (ProperBandCurvatureStructure q cfg.proper).1 data.hPband have hsigned (b : Bool) : diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerSupportTransport.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerSupportTransport.lean index 531521e64c..3877e78ac7 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerSupportTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTileOdometerSupportTransport.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.TileOdometer @@ -29,29 +30,7 @@ theorem PositiveCurvatureTileOdometerSupportTransport TileOdometer C U h := by -- BODY classical - have positive_cells : ∀ (D : CircleCoordinates) (V : ProtoTile), - 0 < D.1 → BandPrototile D V → V.cells.Nonempty := by - intro D V hD hV - induction hV with - | line w x hw => simp at hD - | unit z x anchor => simp - | @decompose q hq S V hS hcells hfoot hcentroid ih => - have facts := ProperBandCurvatureStructure q hq - have hp : ∃ i : Fin 3, 0 < (q i.succ).1 := by - by_cases h0 : 0 < (q (0 : Fin 3).succ).1 - · exact ⟨0, h0⟩ - by_cases h1 : 0 < (q (1 : Fin 3).succ).1 - · exact ⟨1, h1⟩ - by_cases h2 : 0 < (q (2 : Fin 3).succ).1 - · exact ⟨2, h2⟩ - have n0 := facts.2.1 (0 : Fin 3) - have n1 := facts.2.1 (1 : Fin 3) - have z0 : (q (0 : Fin 3).succ).1 = 0 := by omega - have z1 : (q (1 : Fin 3).succ).1 = 0 := by omega - exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 z0 z1)).elim - rcases hp with ⟨i, hi⟩ - rcases ih i false hi with ⟨x, hx⟩ - exact ⟨x, (hcells x).mpr ⟨i, false, hx⟩⟩ + have positive_cells := BandPrototileNonempty.positive induction hT with | line w x hw h hdom => simp at hC diff --git a/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientation.lean b/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientation.lean index 7dcc58b7e5..89d13bb64d 100644 --- a/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientation.lean +++ b/LeanPool/ApollonianSuperharmonic/PrimitiveVectorOrientation.lean @@ -36,9 +36,10 @@ $$ C_3\longrightarrow C_2,\qquad C_2\longrightarrow C_1,\qquad C_3\longrightarrow C_1,\qquad C_1\longrightarrow C_0. $$ -For the first two, the manuscript gives the primitive base value directly. -For $C_3\to C_1$ it gives the opposite value $v_{13},a_{13}$, from which the -primitive value is recovered by the single quarter-turn rule. The fourth is +For the first two, our product-compatible initialization in `RecursiveVectorSystem` +specifies the primitive base values directly. For $C_3\to C_1$ our system specifies +the opposite value $v_{13},a_{13}$, from which the primitive value is recovered by +the single quarter-turn rule. The fourth is the remaining edge between adjacent unit circles; its values are obtained by applying the successor formulas to a parent rotation of the root. Parameter shifts identify the other two child--line edges with the displayed root diff --git a/LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean b/LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean index dc369959da..8c123d9cd7 100644 --- a/LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean +++ b/LeanPool/ApollonianSuperharmonic/RecursiveVectorSystem.lean @@ -33,6 +33,14 @@ $$ (v_{32},v_{21},v_{13})=(0,-1,1),\qquad (a_{32},a_{21},a_{13})=(1,-1-z-i,z+i). $$ +This formalization retains upstream’s product-compatible initialization, rather than +the printed initialization in [Section 5.3, page 19](https://arxiv.org/pdf/1309.3267#page=19). +For the same ordered quadruple that display gives $(0,1,-1)$ and $(1,z,-1-z)$. +The difference includes affine offsets, not only signs. Our values satisfy +$2v_{21}a_{21}=w_2+w_1$ with $w_j=(q_j).2$; at $z=0$ the printed values give +$0$ instead of $2+2i$. Auxiliary vector statements below use our explicitly +specified initialization; the five headline results are proved from this system. + For every semi-proper quadruple the successor values are prescribed by $$ \begin{aligned} diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean index 1426055a79..28f281f89e 100644 --- a/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction public import LeanPool.ApollonianSuperharmonic.OdometerGluing @@ -29,63 +31,6 @@ namespace ApollonianSuperharmonic namespace OdometerTranslationGeometry -private theorem hTproto : - (by - classical - exact - ∀ (C : CircleCoordinates), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), (TileOdometer C T - h) → (BandPrototile C T) ) := by - classical - intro C T h hT - induction hT with - | line w x hw h hdom => - exact BandPrototile.line w x hw - | unit z x T h hT hdom htrans => - cases T with - | mk cells anchor => - dsimp at hT ⊢ - subst cells - exact BandPrototile.unit z x anchor - | decompose hq hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => - exact BandPrototile.decompose hq ih hcells hfoot hcentroid - -private theorem hUproto : - (by - classical - exact - ∀ (C : CircleCoordinates), ∀ (U : ProtoTile), ∀ (g : PartialOdometer), (TileOdometer C U - g) → (BandPrototile C U) ) := by - classical - intro C U g hU - induction hU with - | line w x hw h hdom => - exact BandPrototile.line w x hw - | unit z x T h hT hdom htrans => - cases T with - | mk cells anchor => - dsimp at hT ⊢ - subst cells - exact BandPrototile.unit z x anchor - | decompose hq hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => - exact BandPrototile.decompose hq ih hcells hfoot hcentroid - -private theorem proto : - (by - classical - exact - ∀ D, ∀ V, ∀ k, TileOdometer D V k → BandPrototile D V ) := by - classical - intro D V k hk - induction hk with - | line w x hw k hd => exact BandPrototile.line w x hw - | unit z x V k hc hd ht => - cases V with - | mk cells anchor => - dsimp at hc ⊢ - subst cells - exact BandPrototile.unit z x anchor - | decompose hq hV hsub hc hf hcent hd hv hcompat hslope ih => exact hV - private theorem positive_parent : (by classical @@ -116,23 +61,6 @@ private theorem proper_large : have hb := hq.2 i omega -private theorem positive_cells : - (by - classical - exact - (∀ q, ProperBandQuadruple q → ∃ i : Fin 3, 0 < (q i.succ).1) → (∀ D, ∀ V, BandPrototile D - V → 0 < D.1 → V.cells.Nonempty) ) := by - classical - intro positive_parent D V hV - induction hV with - | line w x hw => simp - | unit z x anchor => simp - | @decompose q hq S V hS hc hf hcent ih => - intro hp - obtain ⟨i, hi⟩ := positive_parent q hq - obtain ⟨x, hx⟩ := ih i false hi - exact ⟨x, (hc x).mpr ⟨i, false, hx⟩⟩ - private theorem zero_cells : (by classical @@ -696,15 +624,15 @@ theorem TileOdometerTranslationUniqueness a.re * x.re + a.im * x.im + b := by -- BODY classical - have hTproto : BandPrototile C T := OdometerTranslationGeometry.hTproto C T h hT - have hUproto : BandPrototile C U := OdometerTranslationGeometry.hUproto C U g hU - have proto : ∀ D V k, TileOdometer D V k → BandPrototile D V := OdometerTranslationGeometry.proto + have hTproto : BandPrototile C T := TileOdometerBandPrototile C T h hT + have hUproto : BandPrototile C U := TileOdometerBandPrototile C U g hU + have proto : ∀ D V k, TileOdometer D V k → BandPrototile D V := TileOdometerBandPrototile have positive_parent : ∀ q, ProperBandQuadruple q → ∃ i : Fin 3, 0 < (q i.succ).1 := OdometerTranslationGeometry.positive_parent C have proper_large : ∀ q, ProperBandQuadruple q → 1 < (q 0).1 := OdometerTranslationGeometry.proper_large C positive_parent have positive_cells : ∀ D V, BandPrototile D V → 0 < D.1 → - V.cells.Nonempty := OdometerTranslationGeometry.positive_cells positive_parent + V.cells.Nonempty := (fun D V hV hD => BandPrototileNonempty.positive D V hD hV) have zero_cells : ∀ D V, BandPrototile D V → D.1 = 0 → V.cells = ∅ := OdometerTranslationGeometry.zero_cells have cent_eq : ∀ V W : ProtoTile, V.cells = W.cells → diff --git a/LeanPool/ApollonianSuperharmonic/TileSubodometerLiteralDecompositionPiece.lean b/LeanPool/ApollonianSuperharmonic/TileSubodometerLiteralDecompositionPiece.lean index 221c72f9a4..eaff9f95b0 100644 --- a/LeanPool/ApollonianSuperharmonic/TileSubodometerLiteralDecompositionPiece.lean +++ b/LeanPool/ApollonianSuperharmonic/TileSubodometerLiteralDecompositionPiece.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty +public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique public import LeanPool.ApollonianSuperharmonic.PositiveCurvatureTileOdometerDomain @@ -80,39 +82,9 @@ theorem TileSubodometerLiteralDecompositionPiece obtain ⟨S, hs, hT, hOchild, hcells, hfoot, hcent, hdom, hvalue, hcompat, hslope⟩ := TileOdometerReindexedDecomposition q hq T h root hOq - have band_of_odo : ∀ (d : CircleCoordinates) (u : ProtoTile) - k, TileOdometer d u k → BandPrototile d u := by - intro d u k ho - induction ho with - | line w x hw k hdom => exact BandPrototile.line w x hw - | unit z x u k hu hdom htrans => - cases u with - | mk cells anchor => - simp_all only [] - exact BandPrototile.unit z x anchor - | decompose hq hT hsub hcells hfoot hcent hdom hvalue hcompat hslope ih => - exact hT - have nonempty_of_odo : ∀ (d : CircleCoordinates) (u : ProtoTile) - k, 0 < d.1 → TileOdometer d u k → u.cells.Nonempty := by - intro d u k hd ho - induction ho with - | line w x hw k hdom => simp at hd - | unit z x u k hu hdom htrans => simp [hu] - | @decompose r hr V U hV hsub hT hsubTiles hcells hfoot hcent hdom hvalue hcompat hslope ih => - have curvature_data := ProperBandCurvatureStructure r hr - rcases curvature_data with ⟨hrootpos, hnonneg, hunique⟩ - have some_positive : ∃ j : Fin 3, 0 < (r j.succ).1 := by - by_contra none - have zeros : ∀ j : Fin 3, (r j.succ).1 = 0 := by - intro j - have non := hnonneg j - have notpos : ¬ 0 < (r j.succ).1 := fun hp => none ⟨j, hp⟩ - omega - have bad := hunique 0 1 (zeros 0) (zeros 1) - omega - rcases some_positive with ⟨j, hj⟩ - obtain ⟨x, hx⟩ := ih j false hj - exact ⟨x, (hcells x).mpr ⟨j, false, hx⟩⟩ + have band_of_odo := TileOdometerBandPrototile + have nonempty_of_odo := fun d u k hd ho => + BandPrototileNonempty.positive d u hd (TileOdometerBandPrototile d u k ho) have hbandT' : BandPrototile C'.1.1 T' := band_of_odo _ _ _ hO' have hbandS : BandPrototile C'.1.1 (S i s) := by rw [← hqi] diff --git a/LeanPool/ApollonianSuperharmonic/VectorRecursionLaws.lean b/LeanPool/ApollonianSuperharmonic/VectorRecursionLaws.lean index 871f47176f..2d6627edf5 100644 --- a/LeanPool/ApollonianSuperharmonic/VectorRecursionLaws.lean +++ b/LeanPool/ApollonianSuperharmonic/VectorRecursionLaws.lean @@ -108,6 +108,32 @@ theorem VectorRecursionLaws (q : Fin 4 → CircleCoordinates) exact ⟨flipLaw _ _ (PrimitiveVectorOrientation.parentChild proper j) |>.1, flipLaw _ _ (PrimitiveVectorOrientation.parentChild proper j) |>.2⟩ +/-- The four vector recursion laws at any cyclic parent occurrence. -/ +theorem VectorRecursionLaws.cyclic (q : Fin 4 → CircleCoordinates) + (hq : SemiProperQuadruple q) (i : Fin 3) : + BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) + + BandVectors.1 (q i.succ) (q ((i + 2).succ)) + + BandVectors.1 (q ((i + 1).succ)) (q i.succ) = 0 ∧ + BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) + + BandVectors.2 (q i.succ) (q ((i + 2).succ)) + + BandVectors.2 (q ((i + 1).succ)) (q i.succ) = 0 ∧ + BandVectors.1 (q i.succ) (q 0) = + BandVectors.1 (q i.succ) (q ((i + 2).succ)) - + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q ((i + 1).succ)) (q i.succ) ∧ + BandVectors.2 (q i.succ) (q 0) = + BandVectors.2 (q i.succ) (q ((i + 2).succ)) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q ((i + 1).succ)) (q i.succ) := by + fin_cases i + · have h := VectorRecursionLaws q hq + simpa using And.intro h.1 (And.intro h.2.1 (And.intro h.2.2.1 h.2.2.2.1)) + · have h := VectorRecursionLaws ![q 0, q 2, q 3, q 1] + (SemiProperQuadruple.rotate hq) + simpa using And.intro h.1 (And.intro h.2.1 (And.intro h.2.2.1 h.2.2.2.1)) + · have hr : SemiProperQuadruple ![q 0, q 3, q 1, q 2] := by + simpa using SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq) + have h := VectorRecursionLaws ![q 0, q 3, q 1, q 2] hr + simpa using And.intro h.1 (And.intro h.2.1 (And.intro h.2.2.1 h.2.2.2.1)) + end ApollonianSuperharmonic end From c311c3b2500f8722f4949ad7c15e82c0b724cc01 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 13 Nov 2026 05:24:56 +0000 Subject: [PATCH 13/23] Reduce private proof context and reuse repeated facts --- .../AffineOpposingStripCorridor.lean | 74 +- .../BandDoubleDecomposition.lean | 336 +++++--- .../BandOrderedGeneralLayout.lean | 105 ++- ...BandOrderedGeneralPositiveCutGeometry.lean | 98 +-- ...rderedGeneralRightSelectedRowGeometry.lean | 71 +- ...eredGeneralSubtileCanonicalSeparation.lean | 247 +----- ...SubtileNormalizationCertificateExists.lean | 112 ++- ...ndPackingSymmetryMarkedDataCovariance.lean | 290 +++---- ...PackingSymmetryTileOdometerCovariance.lean | 81 +- .../BandPrototileExists.lean | 96 ++- .../BandRetainedBoundaryGenealogy.lean | 73 +- .../BandTileTopologyApplication.lean | 14 +- .../BoundaryStringOdometerRespect.lean | 23 +- .../DiamondLaplacianTable.lean | 24 +- ...amondOpposingBoundaryStarLocalization.lean | 113 +-- .../FiniteBiconnectedHorizontalRunTree.lean | 62 +- ...niteConnectedAcyclicDegreeTwoGridPath.lean | 33 +- .../FiniteSquareIncidenceIdentities.lean | 14 +- .../FordCoordinateConfiguration.lean | 790 +++++++++++------- .../FordLaplacianTable.lean | 251 +++--- .../FordLeftBoundaryCompatibility.lean | 11 +- .../FordOpposingBoundaryStarLocalization.lean | 15 +- .../FordOrientedChildParentEndpoints.lean | 731 +++++++++++----- ...rdOrientedChildParentIncomingEndpoint.lean | 114 ++- .../FordRegimeConverse.lean | 186 +++-- .../FordTileOdometerRestriction.lean | 11 +- .../LatticeAdjacentInterfacePath.lean | 97 ++- .../LatticeTileBoundarySimpleGridCycle.lean | 43 +- .../LatticeTileComplementGridConnected.lean | 74 +- .../LocalLatticeInterfaceSectors.lean | 13 +- .../OdometerGluing.lean | 115 +-- .../OpposingBoundaryOdometerStrings.lean | 123 +-- .../OpposingBoundaryStarLocalization.lean | 43 +- .../OpposingStringInterfacePath.lean | 239 ++++-- .../P3381T1TriangulationBoundary.lean | 168 ++-- .../P3523T1InsertionGeometry.lean | 375 ++++++--- .../P3523T1OrderedInsertion.lean | 221 +++-- .../P3555T2ParabolaChordCuts.lean | 104 ++- .../P3555T2SavedDissectionGeometry.lean | 103 ++- .../P3597T1DirectionParity.lean | 11 +- .../P3597T1VertexSectors.lean | 14 +- .../P3650T1MaximalHeightDiagonal.lean | 90 +- .../P3650T1OldArcEven.lean | 77 +- .../P3652T1IndexedFaceLedger.lean | 30 +- .../P3723T1AllContactDrawingExists.lean | 638 ++++++++------ .../P3821T1CircleComponentBound.lean | 33 +- .../P3821T1ControlledNeighborhood.lean | 6 +- .../P3889T1ExactRadialStar.lean | 57 +- .../P3889T1FaceGapCoverage.lean | 115 ++- .../P3913T1RoutedFaceSubdivision.lean | 653 ++++++++------- .../P3934T1ArcSideComparison.lean | 121 +-- .../P3934T1SectorContinuation.lean | 48 +- .../P3963T1ExteriorMixedCycleObstruction.lean | 83 +- .../P3963T1MixedBoundaryCycle.lean | 197 +++-- ...4055T1OrderedGeneralOppositeEndpoints.lean | 14 +- .../P4055T1PlacementNormalization.lean | 14 +- .../P4062T1OverlapDescent.lean | 224 +++-- .../P4062T1ParentalRestriction.lean | 28 +- .../P4112T1LowerNeighbors.lean | 222 ++--- .../P4112T1ParentalNeighbors.lean | 9 +- .../P4112T1PathGeometry.lean | 276 +++--- .../P4120T1FordGeometry.lean | 178 ++-- .../P4120T1GeneralDescent.lean | 23 +- .../P4158T1EdgeSectorSelection.lean | 304 ++++--- .../P4158T1LargeFirstRestrictions.lean | 117 +-- .../P4158T1LargeSecondRestrictions.lean | 44 +- .../P4158T1MatchedFordPair.lean | 132 ++- .../P4158T1SmallerStringEdges.lean | 137 +-- .../P4194T1DiamondBoundaryLedger.lean | 17 +- .../P4250T1NestedCompatibility.lean | 243 +----- .../P4250T2FiniteForestCompletion.lean | 409 ++++----- .../P4250T2InterfaceCycleExclusion.lean | 25 +- .../P4261T1CentralCoordinates.lean | 15 +- .../P4261T1RightCoordinates.lean | 15 +- .../P4261T2AncestorSymmetry.lean | 61 +- .../P4261T2UnitBoundary.lean | 160 ++-- .../P4261T2UnitInterface.lean | 153 ++-- .../P4366T2LocalSectors.lean | 39 +- .../P4366T2OuterGeometry.lean | 88 +- .../P4418T3PresentedRowAdjacency.lean | 65 +- .../P4418T3RoutedBlockCriterion.lean | 480 +++++++---- .../P4456T2BandGraphTriangle.lean | 51 +- .../P4456T2CrosscutIndex.lean | 60 +- .../P4456T2MissingEdge.lean | 99 ++- .../P4456T2SquareEdges.lean | 112 ++- .../P4458T1FirstProperRows.lean | 130 +-- .../P4458T1LargestParentRows.lean | 12 +- .../P4458T1SecondNewerRows.lean | 37 +- .../P4536T1AFrameB.lean | 64 +- .../P4536T1AFrameD.lean | 32 +- .../P4564T2FordGeometry.lean | 15 +- .../P4590T1JunctionRefinement.lean | 17 +- .../P4590T1MixedInteriorGeometry.lean | 61 +- .../P4590T1RightInteriorGeometry.lean | 369 +++++--- .../P4638T1EmptyFordLocalization.lean | 24 +- .../P4651T1CycleComplementaryArcs.lean | 128 ++- .../P4677T2PrecursorWalk.lean | 10 +- .../P4677T2ThreeConnected.lean | 62 +- .../P4715T1CoefficientFaces.lean | 86 +- .../P4818T1Representatives.lean | 16 +- .../P5023T1CircularSide.lean | 29 +- .../P5050T1OmittedHullSeparation.lean | 26 +- .../P5130T5SameParentOverlaps.lean | 32 +- .../P5260T1PredecessorInterfaces.lean | 115 ++- .../P5290T1EqualDiamondPaths.lean | 56 +- .../P5290T1PredecessorPath.lean | 19 +- .../P5290T1UnitContactPaths.lean | 33 +- .../P5332T1Parent2Rotation0Values.lean | 26 +- .../P5332T1Parent2Rotation1Values.lean | 111 ++- .../P5332T1Parent2Rotation2Values.lean | 153 ++-- .../P5352T2FirstUnit.lean | 10 +- .../P5352T2Predecessor0.lean | 213 +++-- .../P5352T2Predecessor1.lean | 197 ++--- .../P5352T2Predecessor2.lean | 144 ++-- .../P5352T2Predecessor3.lean | 115 +-- .../P5352T2RightHorizontal.lean | 88 +- .../P5455T2OccurrenceDeterministic.lean | 10 +- .../P5491T1DiamondRightBoundary.lean | 18 +- .../P5596T1LeftWeb.lean | 392 +++++---- .../PeriodicBoundaryWebLaplacian.lean | 16 +- .../PeriodicTileTotalIndegree.lean | 53 +- .../PositiveCurvatureTranslatedOdometers.lean | 11 +- .../RightSubtileOdometerCompatibility.lean | 21 +- .../SimpleGridPathEquivariance.lean | 130 +-- ...tticeAdjacentPackingSymmetryTransport.lean | 15 +- .../TileOdometerCentralSymmetry.lean | 8 +- .../TileOdometerExists.lean | 49 +- .../TileOdometerTranslationUniqueness.lean | 180 ++-- .../TileStringCoordinateTransport.lean | 29 +- ...eStringRegularFamilyCentralCovariance.lean | 64 +- .../TileT1DiskArea.lean | 11 +- .../TriangularStripSegmentOrderInterval.lean | 40 +- 132 files changed, 8854 insertions(+), 6303 deletions(-) diff --git a/LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean b/LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean index 016a56b8df..f9f854b594 100644 --- a/LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean +++ b/LeanPool/ApollonianSuperharmonic/AffineOpposingStripCorridor.lean @@ -627,20 +627,29 @@ private theorem pmem : (by classical exact - ∀ (P : List (ℤ × ℤ)), ∀ (A : ℤ), ∀ (B : ℤ), - let h : Int → Int := fun k => (B*k+A-1)/A; - ((TriangularMaxIncrement (A,B) (0,0) = A) → ( - let N := A.toNat; - ((N : Int) = A) → ( - let p : Nat → Int × Int := fun k => (k, h k); - let PP := (List.range (N+1)).map p; - (PP.head? = some (0,0)) → ((PP.getLast? = some (A,B)) → ((P = PP) → ((∀ (path : List (Int - × Int)), ∀ (a : Int × Int), ∀ (b : Int × Int), ∀ (z : Int × Int), (path.head? = some - a) → ((path.getLast? = some b) → ((z ∈ path) → ((z ≠ a) → ((z ≠ b) → (z ∈ (path.drop - 1).dropLast)))))) → (∀ (k : ℕ), (0 : ℕ) < k ∧ k < N → p k ∈ (List.drop (1 : ℕ) - P).dropLast))))))) ) := by + ∀ (P : List (ℤ × ℤ)), + ∀ (A : ℤ), + ∀ (B : ℤ), + let h : Int → Int := fun k => (B * k + A - 1) / A; + let N := A.toNat; + (N : Int) = A → + let p : Nat → Int × Int := fun k => (k, h k); + let PP := (List.range (N + 1)).map p; + PP.head? = some (0, 0) → + PP.getLast? = some (A, B) → + P = PP → + (∀ (path : List (Int × Int)), + ∀ (a : Int × Int), + ∀ (b : Int × Int), + ∀ (z : Int × Int), + path.head? = some a → + path.getLast? = some b → + z ∈ path → z ≠ a → z ≠ b → z ∈ (path.drop 1).dropLast) → + ∀ (k : ℕ), + (0 : ℕ) < k ∧ k < N → p k ∈ (List.drop (1 : ℕ) P).dropLast + ) := by classical - intro P A B h hrmax N hN p PP phead plast Peq interior k hk + intro P A B h N hN p PP phead plast Peq interior k hk rw [Peq] apply interior PP (0,0) (A,B) (p k) phead plast · apply List.mem_map.mpr @@ -652,20 +661,29 @@ private theorem qmem : (by classical exact - ∀ (Q : List (ℤ × ℤ)), ∀ (A : ℤ), ∀ (B : ℤ), - let l : Int → Int := fun k => (B*k)/A; - ((TriangularMaxIncrement (A,B) (0,0) = A) → ( - let N := A.toNat; - ((N : Int) = A) → ( - let q : Nat → Int × Int := fun k => (k, l k); - let QQ := ((List.range (N+1)).map q).reverse; - (((List.range (N+1)).map q).head? = some (0,0)) → ((((List.range (N+1)).map q).getLast? = - some (A,B)) → ((Q = QQ) → ((∀ (path : List (Int × Int)), ∀ (a : Int × Int), ∀ (b : - Int × Int), ∀ (z : Int × Int), (path.head? = some a) → ((path.getLast? = some b) → - ((z ∈ path) → ((z ≠ a) → ((z ≠ b) → (z ∈ (path.drop 1).dropLast)))))) → (∀ (k : ℕ), - (0 : ℕ) < k ∧ k < N → q k ∈ (List.drop (1 : ℕ) Q).dropLast))))))) ) := by + ∀ (Q : List (ℤ × ℤ)), + ∀ (A : ℤ), + ∀ (B : ℤ), + let l : Int → Int := fun k => B * k / A; + let N := A.toNat; + (N : Int) = A → + let q : Nat → Int × Int := fun k => (k, l k); + let QQ := ((List.range (N + 1)).map q).reverse; + ((List.range (N + 1)).map q).head? = some (0, 0) → + ((List.range (N + 1)).map q).getLast? = some (A, B) → + Q = QQ → + (∀ (path : List (Int × Int)), + ∀ (a : Int × Int), + ∀ (b : Int × Int), + ∀ (z : Int × Int), + path.head? = some a → + path.getLast? = some b → + z ∈ path → z ≠ a → z ≠ b → z ∈ (path.drop 1).dropLast) → + ∀ (k : ℕ), + (0 : ℕ) < k ∧ k < N → q k ∈ (List.drop (1 : ℕ) Q).dropLast + ) := by classical - intro Q A B l hrmax N hN q QQ qhead qlast Qeq interior k hk + intro Q A B l N hN q QQ qhead qlast Qeq interior k hk rw [Qeq] apply interior QQ (A,B) (0,0) (q k) · simpa [QQ] using qlast @@ -1158,9 +1176,9 @@ theorem AffineOpposingStripCorridor (ha : path.head? = some a) (hb : path.getLast? = some b) (hz : z ∈ path) (hza : z ≠ a) (hzb : z ≠ b) := OpposingStripProof.interior path a b z ha hb hz hza hzb - have pmem (k : Nat) (hk : 0 < k ∧ k < N) := OpposingStripDetails.pmem P A B hrmax hN + have pmem (k : Nat) (hk : 0 < k ∧ k < N) := OpposingStripDetails.pmem P A B hN phead plast Peq interior k hk - have qmem (k : Nat) (hk : 0 < k ∧ k < N) := OpposingStripDetails.qmem Q A B hrmax hN + have qmem (k : Nat) (hk : 0 < k ∧ k < N) := OpposingStripDetails.qmem Q A B hN qhead qlast Qeq interior k hk have gap (k : Int) := OpposingStripDetails.gap A B hA hl hh k have between (k : Int) := OpposingStripDetails.between A B diff --git a/LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean b/LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean index f947077587..d7cb196d9a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean +++ b/LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean @@ -88,39 +88,87 @@ private theorem rotatedT5 : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (Fin (4 : ℕ) → CircleCoordinates) → ((∀ (D : - CircleCoordinates), ∀ (U : ProtoTile), BandPrototile D U → D.1.toNat < (q (0 : Fin (4 - : ℕ))).1.toNat → QuarterTurnSymmetric U) → ((∀ (q' : Fin (4 : ℕ) → - CircleCoordinates), ∀ (T' : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), - ProperBandQuadruple q' → BandPrototile (q' (0 : Fin (4 : ℕ))) T' → (q' (0 : Fin (4 : - ℕ))).1.toNat < (q (0 : Fin (4 : ℕ))).1.toNat → ∀ (i : Fin (3 : ℕ)), BandPrototile (q' - i.succ) U → BandPrototile (q' (i + (1 : Fin (3 : ℕ))).succ) V → TileCentroid U - - TileCentroid T' = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q' i.succ) (q' (0 - : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' - i.succ))) → TileCentroid V - TileCentroid T' = (1 / 2 : ℝ) • (GaussianRealPoint - (BandVectors.1 (q' (i + (1 : Fin (3 : ℕ))).succ) (q' (0 : Fin (4 : ℕ)))) - - GaussianRealPoint (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' (i + (1 : Fin (3 : - ℕ))).succ))) → TouchingTriple T' U V) → ((∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (X - : ProtoTile), ∀ (Y : ProtoTile), (T.cells = U.cells) → ((T.cells = ∅ → T.anchor = - U.anchor) → (TouchingTriple X T Y ↔ TouchingTriple X U Y))) → ((∀ (C : - CircleCoordinates), ∀ (W : ProtoTile), (BandPrototile C W) → ((QuarterTurnSymmetric - W) → (∃ W' : ProtoTile, BandPrototile C W' ∧ (TileQuarterTurn W').cells = W.cells ∧ - ((TileQuarterTurn W').cells = ∅ → (TileQuarterTurn W').anchor = W.anchor) ∧ - TileCentroid (TileQuarterTurn W') = TileCentroid W))) → (∀ (p : Fin (4 : ℕ) → - CircleCoordinates), ProperBandQuadruple p → (p (0 : Fin (4 : ℕ))).1.toNat < (q (0 : - Fin (4 : ℕ))).1.toNat → ∀ (n : ℕ), ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (V : - ProtoTile), BandPrototile (p (0 : Fin (4 : ℕ))) T → BandPrototile (p (2 : Fin (4 : - ℕ))) U → BandPrototile (p (3 : Fin (4 : ℕ))) V → TileCentroid U - TileCentroid T = (1 - / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[n] (BandVectors.1 (p (2 : Fin (4 - : ℕ))) (p (0 : Fin (4 : ℕ))))) + GaussianRealPoint (GaussianQuarterTurn^[n] - (BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ)))))) → TileCentroid V - - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (GaussianQuarterTurn^[n] - (BandVectors.1 (p (3 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))))) - GaussianRealPoint - (GaussianQuarterTurn^[n] (BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (3 : Fin (4 : - ℕ)))))) → TouchingTriple T U V))))) + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + (∀ (D : CircleCoordinates), + ∀ (U : ProtoTile), + BandPrototile D U → + D.1.toNat < (q (0 : Fin (4 : ℕ))).1.toNat → QuarterTurnSymmetric U) → + (∀ (q' : Fin (4 : ℕ) → CircleCoordinates), + ∀ (T' : ProtoTile), + ∀ (U : ProtoTile), + ∀ (V : ProtoTile), + ProperBandQuadruple q' → + BandPrototile (q' (0 : Fin (4 : ℕ))) T' → + (q' (0 : Fin (4 : ℕ))).1.toNat < (q (0 : Fin (4 : ℕ))).1.toNat → + ∀ (i : Fin (3 : ℕ)), + BandPrototile (q' i.succ) U → + BandPrototile (q' (i + (1 : Fin (3 : ℕ))).succ) V → + TileCentroid U - TileCentroid T' = + (1 / 2 : ℝ) • + (GaussianRealPoint + (BandVectors.1 (q' i.succ) (q' (0 : Fin (4 : ℕ)))) + + GaussianRealPoint + (BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' i.succ))) → + TileCentroid V - TileCentroid T' = + (1 / 2 : ℝ) • + (GaussianRealPoint + (BandVectors.1 (q' (i + (1 : Fin (3 : ℕ))).succ) + (q' (0 : Fin (4 : ℕ)))) - + GaussianRealPoint + (BandVectors.1 (q' (0 : Fin (4 : ℕ))) + (q' (i + (1 : Fin (3 : ℕ))).succ))) → + TouchingTriple T' U V) → + (∀ (T : ProtoTile), + ∀ (U : ProtoTile), + ∀ (X : ProtoTile), + ∀ (Y : ProtoTile), + T.cells = U.cells → + (T.cells = ∅ → T.anchor = U.anchor) → + (TouchingTriple X T Y ↔ TouchingTriple X U Y)) → + (∀ (C : CircleCoordinates), + ∀ (W : ProtoTile), + BandPrototile C W → + QuarterTurnSymmetric W → + ∃ W' : ProtoTile, + BandPrototile C W' ∧ + (TileQuarterTurn W').cells = W.cells ∧ + ((TileQuarterTurn W').cells = ∅ → + (TileQuarterTurn W').anchor = W.anchor) ∧ + TileCentroid (TileQuarterTurn W') = TileCentroid W) → + ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple p → + (p (0 : Fin (4 : ℕ))).1.toNat < (q (0 : Fin (4 : ℕ))).1.toNat → + ∀ (n : ℕ), + ∀ (T : ProtoTile), + ∀ (U : ProtoTile), + ∀ (V : ProtoTile), + BandPrototile (p (0 : Fin (4 : ℕ))) T → + BandPrototile (p (2 : Fin (4 : ℕ))) U → + BandPrototile (p (3 : Fin (4 : ℕ))) V → + TileCentroid U - TileCentroid T = + (1 / 2 : ℝ) • + (GaussianRealPoint + (GaussianQuarterTurn^[n] + (BandVectors.1 (p (2 : Fin (4 : ℕ))) + (p (0 : Fin (4 : ℕ))))) + + GaussianRealPoint + (GaussianQuarterTurn^[n] + (BandVectors.1 (p (0 : Fin (4 : ℕ))) + (p (2 : Fin (4 : ℕ)))))) → + TileCentroid V - TileCentroid T = + (1 / 2 : ℝ) • + (GaussianRealPoint + (GaussianQuarterTurn^[n] + (BandVectors.1 (p (3 : Fin (4 : ℕ))) + (p (0 : Fin (4 : ℕ))))) - + GaussianRealPoint + (GaussianQuarterTurn^[n] + (BandVectors.1 (p (0 : Fin (4 : ℕ))) + (p (3 : Fin (4 : ℕ)))))) → + TouchingTriple T U V ) := by classical - intro q t hT2 hT5 observable preimage p hp hsmall + intro q hT2 hT5 observable preimage p hp hsmall have hsmall2 : Int.toNat (p 2).1 < Int.toNat (q 0).1 := by have hn := (SemiProperForestClassification p hp.1).1 2 have hl := hp.2 1 @@ -506,86 +554,152 @@ private theorem precursors : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), (Fin (4 - : ℕ) → CircleCoordinates) → ((ProperBandQuadruple q) → ((ProperBandQuadruple r) → ((r - (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ))) → ((r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : - ℕ))) → (((q (2 : Fin (4 : ℕ))).1 < (q (1 : Fin (4 : ℕ))).1) → (((4 : ℤ) ≤ (q (2 : Fin - (4 : ℕ))).1) → (∀ (x : ℝ × ℝ), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 - : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : - ℕ)), ∀ (s : Bool), BandPrototile (r i.succ) (Q i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : - Bool), BandPrototile (r i.succ) (S i s)) → ((∀ (p : Fin 4 → CircleCoordinates), - (ProperBandQuadruple p) → ((Int.toNat (p 0).1 < Int.toNat (q 0).1) → (∀ (n : Nat), ∀ - (T : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (p 0) T → - BandPrototile (p 2) U → BandPrototile (p 3) V → TileCentroid U - TileCentroid T = (1 - / 2 : Real) • (GaussianRealPoint ((GaussianQuarterTurn^[n]) (BandVectors.1 (p 2) (p - 0))) + GaussianRealPoint ((GaussianQuarterTurn^[n]) (BandVectors.1 (p 0) (p 2)))) → - TileCentroid V - TileCentroid T = (1 / 2 : Real) • (GaussianRealPoint - ((GaussianQuarterTurn^[n]) (BandVectors.1 (p 3) (p 0))) - GaussianRealPoint - ((GaussianQuarterTurn^[n]) (BandVectors.1 (p 0) (p 3)))) → TouchingTriple T U V))) → ( - let I : GaussianInt := ⟨0, 1⟩ - let a := BandVectors.1 (q 3) (q 2) - let b := BandVectors.1 (q 1) (q 3) - let c := BandVectors.1 (q 2) (q 1) - let d := BandVectors.1 (r 1) (r 3) - let e := BandVectors.1 (r 2) (r 1) - (c = -a - b) → ((BandVectors.1 (r 3) (r 2) = a) → ((e = c + I * a) → ((d = b - I * a) → - ((∀ (z : GaussianInt), ∀ (w : GaussianInt), (z = I * w) → (w = -I * z)) → - (((TileCentroid (P (0 : Fin (3 : ℕ)) true)).1 - x.1 = (2 : ℝ)⁻¹ * - (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + ((GaussianInt.toComplex : - GaussianInt → ℂ) a).im)) → (((TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 - x.2 = (2 : - ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex : - GaussianInt → ℂ) a).re)) → (((TileCentroid (P (0 : Fin (3 : ℕ)) false)).1 - x.1 = - -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + - ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → (((TileCentroid (P (0 : Fin (3 - : ℕ)) false)).2 - x.2 = -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) - a).im - ((GaussianInt.toComplex : GaussianInt → ℂ) a).re))) → (((TileCentroid (Q (0 : - Fin (3 : ℕ)) false)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) true)).1 = -((2 : ℝ)⁻¹ * - (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + ((GaussianInt.toComplex : - GaussianInt → ℂ) a).im))) → (((TileCentroid (Q (0 : Fin (3 : ℕ)) false)).2 - - (TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 = -((2 : ℝ)⁻¹ * (((GaussianInt.toComplex - : GaussianInt → ℂ) a).im - ((GaussianInt.toComplex : GaussianInt → ℂ) a).re))) → - (((TileCentroid (Q (1 : Fin (3 : ℕ)) true)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) - true)).1 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + - ((GaussianInt.toComplex : GaussianInt → ℂ) a).im - (((GaussianInt.toComplex : - GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : GaussianInt → ℂ) b).im))) → - (((TileCentroid (Q (1 : Fin (3 : ℕ)) true)).2 - (TileCentroid (P (0 : Fin (3 : ℕ)) - true)).2 = (2 : ℝ)⁻¹ * (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - - ((GaussianInt.toComplex : GaussianInt → ℂ) a).re - (((GaussianInt.toComplex : - GaussianInt → ℂ) b).re + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → - (((TileCentroid (Q (2 : Fin (3 : ℕ)) true)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) - true)).1 = (2 : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - - ((GaussianInt.toComplex : GaussianInt → ℂ) b).re + -((GaussianInt.toComplex : - GaussianInt → ℂ) a).im - (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re + - (((GaussianInt.toComplex : GaussianInt → ℂ) b).im + ((GaussianInt.toComplex : - GaussianInt → ℂ) a).im)))) → (((TileCentroid (Q (2 : Fin (3 : ℕ)) true)).2 - - (TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 = (2 : ℝ)⁻¹ * (-((GaussianInt.toComplex : - GaussianInt → ℂ) a).im - ((GaussianInt.toComplex : GaussianInt → ℂ) b).im + - ((GaussianInt.toComplex : GaussianInt → ℂ) a).re - (-((GaussianInt.toComplex : - GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : GaussianInt → ℂ) b).re + - -((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → (((TileCentroid (S (1 : Fin (3 - : ℕ)) false)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) false)).1 = -((2 : ℝ)⁻¹ * - (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + ((GaussianInt.toComplex : - GaussianInt → ℂ) a).im - (((GaussianInt.toComplex : GaussianInt → ℂ) a).re - - ((GaussianInt.toComplex : GaussianInt → ℂ) b).im)))) → (((TileCentroid (S (1 : Fin (3 - : ℕ)) false)).2 - (TileCentroid (P (0 : Fin (3 : ℕ)) false)).2 = -((2 : ℝ)⁻¹ * - (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - ((GaussianInt.toComplex : - GaussianInt → ℂ) a).re - (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + - ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)))) → (((TileCentroid (S (2 : Fin (3 - : ℕ)) false)).1 - (TileCentroid (P (0 : Fin (3 : ℕ)) false)).1 = -((2 : ℝ)⁻¹ * - (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - ((GaussianInt.toComplex : - GaussianInt → ℂ) b).re + -((GaussianInt.toComplex : GaussianInt → ℂ) a).im - - (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re + (((GaussianInt.toComplex : - GaussianInt → ℂ) b).im + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))))) → - (((TileCentroid (S (2 : Fin (3 : ℕ)) false)).2 - (TileCentroid (P (0 : Fin (3 : ℕ)) - false)).2 = -((2 : ℝ)⁻¹ * (-((GaussianInt.toComplex : GaussianInt → ℂ) a).im - - ((GaussianInt.toComplex : GaussianInt → ℂ) b).im + ((GaussianInt.toComplex : - GaussianInt → ℂ) a).re - (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - - ((GaussianInt.toComplex : GaussianInt → ℂ) b).re + -((GaussianInt.toComplex : - GaussianInt → ℂ) a).im)))) → (TouchingTriple (Q 1 true) (S 2 false) (Q 0 false) ∧ - TouchingTriple (Q 2 true) (S 1 false) (Q 0 false)))))))))))))))))))))))))))))) + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q → + ProperBandQuadruple r → + r (0 : Fin (4 : ℕ)) = q (1 : Fin (4 : ℕ)) → + r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → + (q (2 : Fin (4 : ℕ))).1 < (q (1 : Fin (4 : ℕ))).1 → + (4 : ℤ) ≤ (q (2 : Fin (4 : ℕ))).1 → + ∀ (x : ℝ × ℝ), + ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), + ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), BandPrototile (r i.succ) (Q i s)) → + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), BandPrototile (r i.succ) (S i s)) → + (∀ (p : Fin 4 → CircleCoordinates), + ProperBandQuadruple p → + Int.toNat (p 0).1 < Int.toNat (q 0).1 → + ∀ (n : Nat), + ∀ (T : ProtoTile), + ∀ (U : ProtoTile), + ∀ (V : ProtoTile), + BandPrototile (p 0) T → + BandPrototile (p 2) U → + BandPrototile (p 3) V → + TileCentroid U - TileCentroid T = + (1 / 2 : Real) • + (GaussianRealPoint + (GaussianQuarterTurn^[n] (BandVectors.1 (p 2) (p 0))) + + GaussianRealPoint + (GaussianQuarterTurn^[n] (BandVectors.1 (p 0) (p 2)))) → + TileCentroid V - TileCentroid T = + (1 / 2 : Real) • + (GaussianRealPoint + (GaussianQuarterTurn^[n] (BandVectors.1 (p 3) (p 0))) - + GaussianRealPoint + (GaussianQuarterTurn^[n] (BandVectors.1 (p 0) (p 3)))) → + TouchingTriple T U V) → + let I : GaussianInt := ⟨0, 1⟩ + let a := BandVectors.1 (q 3) (q 2) + let b := BandVectors.1 (q 1) (q 3) + let c := BandVectors.1 (q 2) (q 1) + let d := BandVectors.1 (r 1) (r 3) + let e := BandVectors.1 (r 2) (r 1) + c = -a - b → + BandVectors.1 (r 3) (r 2) = a → + e = c + I * a → + d = b - I * a → + (∀ (z : GaussianInt), + ∀ (w : GaussianInt), z = I * w → w = -I * z) → + (TileCentroid (P (0 : Fin (3 : ℕ)) true)).1 - x.1 = + (2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im) → + (TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 - x.2 = + (2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re) → + (TileCentroid (P (0 : Fin (3 : ℕ)) false)).1 - x.1 = + -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)) → + (TileCentroid (P (0 : Fin (3 : ℕ)) false)).2 - x.2 = + -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re)) → + (TileCentroid (Q (0 : Fin (3 : ℕ)) false)).1 - + (TileCentroid (P (0 : Fin (3 : ℕ)) true)).1 = + -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)) → + (TileCentroid (Q (0 : Fin (3 : ℕ)) false)).2 - + (TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 = + -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re)) → + (TileCentroid (Q (1 : Fin (3 : ℕ)) true)).1 - + (TileCentroid (P (0 : Fin (3 : ℕ)) true)).1 = + (2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + (((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im)) → + (TileCentroid (Q (1 : Fin (3 : ℕ)) true)).2 - + (TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 = + (2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)) → + (TileCentroid (Q (2 : Fin (3 : ℕ)) true)).1 - + (TileCentroid (P (0 : Fin (3 : ℕ)) true)).1 = + (2 : ℝ)⁻¹ * + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + -((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re + + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → + (TileCentroid (Q (2 : Fin (3 : ℕ)) true)).2 - + (TileCentroid (P (0 : Fin (3 : ℕ)) true)).2 = + (2 : ℝ)⁻¹ * + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + -((GaussianInt.toComplex : GaussianInt → ℂ) a).im)) → + (TileCentroid (S (1 : Fin (3 : ℕ)) false)).1 - + (TileCentroid (P (0 : Fin (3 : ℕ)) false)).1 = + -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + (((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im))) → + (TileCentroid (S (1 : Fin (3 : ℕ)) false)).2 - + (TileCentroid (P (0 : Fin (3 : ℕ)) false)).2 = + -((2 : ℝ)⁻¹ * + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + (((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → + (TileCentroid (S (2 : Fin (3 : ℕ)) false)).1 - + (TileCentroid (P (0 : Fin (3 : ℕ)) false)).1 = + -((2 : ℝ)⁻¹ * + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + -((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re + + (((GaussianInt.toComplex : GaussianInt → ℂ) b).im + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).im)))) → + (TileCentroid (S (2 : Fin (3 : ℕ)) false)).2 - + (TileCentroid (P (0 : Fin (3 : ℕ)) false)).2 = + -((2 : ℝ)⁻¹ * + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).im - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).im + + ((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + (-((GaussianInt.toComplex : GaussianInt → ℂ) a).re - + ((GaussianInt.toComplex : GaussianInt → ℂ) b).re + + -((GaussianInt.toComplex : GaussianInt → ℂ) a).im))) → + TouchingTriple (Q 1 true) (S 2 false) (Q 0 false) ∧ + TouchingTriple (Q 2 true) (S 1 false) (Q 0 false) ) := by classical - intro q r t hq hr hr0 hr2 h12 h2four x P Q S hQ hS rotatedT5 I a b c d e hc hr32 he hd inverse + intro q r hq hr hr0 hr2 h12 h2four x P Q S hQ hS rotatedT5 I a b c d e hc hr32 he hd inverse p0x p0y m0x m0y q0x q0y q1x q1y q2x q2y s1x s1y s2x s2y have rsmall (j : Fin 3) : Int.toNat (r j.succ).1 < Int.toNat (q 0).1 := by have hn := (SemiProperForestClassification r hr.1).1 j.succ @@ -852,7 +966,7 @@ theorem BandDoubleDecomposition : (BandVectors.1 (p 3) (p 0))) - GaussianRealPoint ((GaussianQuarterTurn^[n]) (BandVectors.1 (p 0) (p 3)))) → TouchingTriple T U V := - DoubleDecompositionProof.rotatedT5 q t hT2 hT5 observable preimage p hp hsmall + DoubleDecompositionProof.rotatedT5 q hT2 hT5 observable preimage p hp hsmall let I : GaussianInt := ⟨0, 1⟩ let a := BandVectors.1 (q 3) (q 2) let b := BandVectors.1 (q 1) (q 3) @@ -1012,7 +1126,7 @@ theorem BandDoubleDecomposition : hSt hPmt hP2pt literal have precursors : TouchingTriple (Q 1 true) (S 2 false) (Q 0 false) ∧ TouchingTriple (Q 2 true) (S 1 false) (Q 0 false) := DoubleDecompositionProof.precursors q - r t hq hr hr0 hr2 h12 h2four x P Q S hQ hS rotatedT5 hc hr32 he hd inverse p0x p0y m0x + r hq hr hr0 hr2 h12 h2four x P Q S hQ hS rotatedT5 hc hr32 he hd inverse p0x p0y m0x m0y q0x q0y q1x q1y q2x q2y s1x s1y s2x s2y exact ⟨common.1, common.2, precursors.1, precursors.2, cross1, cross2, cross3, cross4⟩ diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean index 996e6a65fa..4fa1b44356 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean @@ -83,12 +83,14 @@ private theorem pne : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((∀ (i : Fin 3), - 0 < (q i.succ).1) → (∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : - Bool), TileArea (P i s) = (q i.succ).1.toNat) → (∀ (i : Fin 3), ∀ (s : Bool), (P i - s).cells.Nonempty))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + (∀ (i : Fin 3), 0 < (q i.succ).1) → + ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin 3), ∀ (s : Bool), TileArea (P i s) = (q i.succ).1.toNat) → + ∀ (i : Fin 3), ∀ (s : Bool), (P i s).cells.Nonempty + ) := by classical - intro q cfg parentPos P parea i s + intro q parentPos P parea i s have ha := parea i s have hp := parentPos i change (P i s).cells.card = _ at ha @@ -275,12 +277,15 @@ private theorem hindex : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (C₀ : - BandCircle), (q (0 : Fin (4 : ℕ)) = C₀.1.1) → ((∀ (k : Fin (4 : ℕ)), (0 : ℤ) ≤ (q - k).1) → (∀ (R : Finset GaussianInt), (R.card = C₀.1.1.1.natAbs) → (R.card = (q - 0).1.toNat)))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (C₀ : BandCircle), + q (0 : Fin (4 : ℕ)) = C₀.1.1 → + (∀ (k : Fin (4 : ℕ)), (0 : ℤ) ≤ (q k).1) → + ∀ (R : Finset GaussianInt), + R.card = C₀.1.1.1.natAbs → R.card = (q 0).1.toNat + ) := by classical - intro q cfg C₀ hC₀ hn R hcount + intro q C₀ hC₀ hn R hcount rw [hC₀] apply hcount.trans have ha := Int.natAbs_of_nonneg (by simpa [hC₀] using hn 0) @@ -517,32 +522,56 @@ private theorem abEdge : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), - (BandCircle) → (∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (s : Bool), BandPrototile - (cfg.firstPredecessor 0) (P 0 s)) → (∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : - Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence cfg.firstPredecessor (P (0 : Fin (3 - : ℕ)) true) i s (Q i s)) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : - ℕ)), ∀ (s : Bool), BandSubtileOccurrence cfg.firstPredecessor (P (0 : Fin (3 : ℕ)) - false) i s (S i s)) → ((LatticeTile (TileCellComplement (P (0 : Fin (3 : ℕ)) true) (Q - (0 : Fin (3 : ℕ)) false)) ∧ TileTouching (TileCellComplement (P (0 : Fin (3 : ℕ)) - true) (Q (0 : Fin (3 : ℕ)) false)) (Q (0 : Fin (3 : ℕ)) false)) → ( - let O := Q 0 false - (O.cells ⊆ (P 0 false).cells) → ((Finset GaussianInt) → ((FootprintVertices (Q (0 : Fin - (3 : ℕ)) false) = FootprintVertices (S (0 : Fin (3 : ℕ)) true) ∧ - BoundaryFootprintVertices (Q (0 : Fin (3 : ℕ)) false) = BoundaryFootprintVertices (S - (0 : Fin (3 : ℕ)) true) ∧ BoundaryFootprintEdges (Q (0 : Fin (3 : ℕ)) false) = - BoundaryFootprintEdges (S (0 : Fin (3 : ℕ)) true) ∧ TileRealization (Q (0 : Fin (3 : - ℕ)) false) = TileRealization (S (0 : Fin (3 : ℕ)) true) ∧ TileCentroid (Q (0 : Fin (3 - : ℕ)) false) = TileCentroid (S (0 : Fin (3 : ℕ)) true)) → (((Q (0 : Fin (3 : ℕ)) - false).cells = ∅ → (cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → ((∀ (U : - ProtoTile), (LatticeTile U) → (U.cells.Nonempty)) → ((∀ (U : ProtoTile), ∀ (V : - ProtoTile), (U.cells.Nonempty) → ((V.cells.Nonempty) → ((TileTouching U V) → - ((FootprintEdges U ∩ FootprintEdges V).Nonempty)))) → ((∀ (U : ProtoTile), ∀ (V : - ProtoTile), (U.cells ⊆ V.cells) → (FootprintEdges U ⊆ FootprintEdges V)) → - ((FootprintEdges (TileCellComplement (P 0 true) O) ∩ FootprintEdges (P 0 - false)).Nonempty)))))))))))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (s : Bool), BandPrototile (cfg.firstPredecessor 0) (P 0 s)) → + ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + BandSubtileOccurrence cfg.firstPredecessor + (P (0 : Fin (3 : ℕ)) true) i s (Q i s)) → + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + BandSubtileOccurrence cfg.firstPredecessor + (P (0 : Fin (3 : ℕ)) false) i s (S i s)) → + LatticeTile + (TileCellComplement (P (0 : Fin (3 : ℕ)) true) + (Q (0 : Fin (3 : ℕ)) false)) ∧ + TileTouching + (TileCellComplement (P (0 : Fin (3 : ℕ)) true) + (Q (0 : Fin (3 : ℕ)) false)) + (Q (0 : Fin (3 : ℕ)) false) → + let O := Q 0 false; + O.cells ⊆ (P 0 false).cells → + FootprintVertices (Q (0 : Fin (3 : ℕ)) false) = + FootprintVertices (S (0 : Fin (3 : ℕ)) true) ∧ + BoundaryFootprintVertices (Q (0 : Fin (3 : ℕ)) false) = + BoundaryFootprintVertices (S (0 : Fin (3 : ℕ)) true) ∧ + BoundaryFootprintEdges (Q (0 : Fin (3 : ℕ)) false) = + BoundaryFootprintEdges (S (0 : Fin (3 : ℕ)) true) ∧ + TileRealization (Q (0 : Fin (3 : ℕ)) false) = + TileRealization (S (0 : Fin (3 : ℕ)) true) ∧ + TileCentroid (Q (0 : Fin (3 : ℕ)) false) = + TileCentroid (S (0 : Fin (3 : ℕ)) true) → + ((Q (0 : Fin (3 : ℕ)) false).cells = ∅ → + (cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → + (∀ (U : ProtoTile), LatticeTile U → U.cells.Nonempty) → + (∀ (U : ProtoTile), + ∀ (V : ProtoTile), + U.cells.Nonempty → + V.cells.Nonempty → + TileTouching U V → + (FootprintEdges U ∩ FootprintEdges V).Nonempty) → + (∀ (U : ProtoTile), + ∀ (V : ProtoTile), + U.cells ⊆ V.cells → FootprintEdges U ⊆ FootprintEdges V) → + (FootprintEdges (TileCellComplement (P 0 true) O) ∩ + FootprintEdges (P 0 false)).Nonempty + ) := by classical - intro q cfg C₀ P hPr Q hQ S hS compQ O hOB R sameObs zero diskNonempty touchEdge edgeMono + intro q cfg P hPr Q hQ S hS compQ O hOB sameObs zero diskNonempty touchEdge edgeMono by_cases he : O.cells = ∅ · have hac := (hQ 0 false).2.2 have hbc := (hS 0 true).2.2 @@ -997,7 +1026,7 @@ theorem BandOrderedGeneralLayout (pg i s).2.2 (parentPos i) have parea (i : Fin 3) (s : Bool) : TileArea (P i s) = (q i.succ).1.toNat := (pg i s).2.1 - have pne (i : Fin 3) (s : Bool) := OrderedLayoutGeometry.pne q cfg parentPos P parea i s + have pne (i : Fin 3) (s : Bool) := OrderedLayoutGeometry.pne q parentPos P parea i s have compQ := (hsmallT1 cfg.firstPredecessor (P 0 true) Q cfg.firstProper (hPr true) hQ hQunion rsmall).2.2 0 false have compS := (hsmallT1 cfg.firstPredecessor (P 0 false) S cfg.firstProper @@ -1061,7 +1090,7 @@ theorem BandOrderedGeneralLayout (q 2).1.toNat (q 3).1.toNat (cfg.firstPredecessor 1).1.toNat hOA (parea 0 true) (parea 0 false) (parea 1 true) (parea 1 false) (parea 2 true) (parea 2 false) (qg 0 false).2.1 cfg.soddyNat (OrderedLayoutGeometry.hindex q - cfg C₀ hC₀ hn R hcount) + C₀ hC₀ hn R hcount) have hpartition := BandModifiedCellPartition P O u v L R hu hv hfund hcoords hcover harea have hsep := BandOriginalPairSeparation P O u v hOA hOB hpartition have compEq : TileCellComplement (P 0 false) (S 0 true) = @@ -1091,7 +1120,7 @@ theorem BandOrderedGeneralLayout have ordinary := P4670T1OrdinaryEdges P u v pne (Q 1 true) (S 1 false) (qne 1 true (Or.inl rfl)) (sne 1 false (Or.inl rfl)) (hQcells 1 true) (hScells 1 false) cross3.1 cross4.1 houter - have abEdge := OrderedLayoutGeometry.abEdge q cfg C₀ P hPr Q hQ S hS compQ hOB R sameObs zero + have abEdge := OrderedLayoutGeometry.abEdge q cfg P hPr Q hQ S hS compQ hOB sameObs zero (OrderedLayoutGeometry.diskNonempty) (OrderedLayoutGeometry.touchEdge (OrderedLayoutGeometry.boundaryEdge)) (OrderedLayoutGeometry.edgeMono) obtain ⟨segments⟩ := ExceptionalModifiedABPath (P 0 true) (P 0 false) O (S 0 true) diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean index 65b3ed4049..51ef86968c 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean @@ -359,37 +359,6 @@ private theorem hQ1S1 : exact Finset.mem_inter.mpr ⟨hxP, hxM⟩ exact Finset.disjoint_left.mp hOQ1.symm hxQ hxO -private theorem normalize_pair : - (by - classical - exact - ∀ (D : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), (ProtoTile) → (∀ (x : - GaussianInt), (D = U ∨ D = V) → ((∃ j : Fin 4, - LatticeVertexIncidentCell x j ∈ U.cells ∧ - LatticeVertexIncidentCell x (j + 2) ∈ V.cells) → ((x ∈ FootprintVertices U) → ((x ∈ - FootprintVertices V) → ((∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ - y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → - y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V) → (∃ W : ProtoTile, ∃ j : Fin 4, - LatticeVertexIncidentCell x j ∈ D.cells ∧ LatticeVertexIncidentCell x (j + 2) ∈ - W.cells ∧ x ∈ FootprintVertices D ∧ x ∈ FootprintVertices W ∧ (∀ y, y = x ∨ y = - x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ FootprintVertices D ∨ - y ∈ FootprintVertices W))))))) ) := by - classical - intro D U V R x hD hopp hU hV hstar - rcases hopp with ⟨j, hjU, hjV⟩ - rcases hD with hDU | hDV - · subst U - exact ⟨V, j, hjU, hjV, hU, hV, hstar⟩ - · subst V - have hindex : (j + 2) + 2 = j := by fin_cases j <;> decide - refine ⟨U, j + 2, ?_, ?_, hV, hU, ?_⟩ - · exact hjV - · simpa [hindex] using hjU - · intro y hy - rcases hstar y hy with hyU | hyV - · exact Or.inr hyU - · exact Or.inl hyV - private theorem selectA_Q : (by classical @@ -474,24 +443,42 @@ private theorem normalize_selected : (by classical exact - ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), (X ≠ Y) → - ((X ≠ Z) → ((Y ≠ Z) → ((∃ U V R : ProtoTile, - (X = U ∨ X = V) ∧ - ((U = X ∧ V = Y ∧ R = Z) ∨ (U = Y ∧ V = X ∧ R = Z) ∨ - (U = X ∧ V = Z ∧ R = Y) ∨ (U = Z ∧ V = X ∧ R = Y) ∨ - (U = Y ∧ V = Z ∧ R = X) ∨ (U = Z ∧ V = Y ∧ R = X)) ∧ - (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells ∧ - LatticeVertexIncidentCell x (j + 2) ∈ V.cells) ∧ - x ∈ FootprintVertices U ∧ x ∈ FootprintVertices V ∧ - (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ - y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → - y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V)) → (∃ W : ProtoTile, (W = Y ∨ W - = Z) ∧ ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ X.cells ∧ - LatticeVertexIncidentCell x (j + 2) ∈ W.cells ∧ x ∈ FootprintVertices X ∧ x ∈ - FootprintVertices W ∧ (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y - = x - ⟨0, 1⟩ → y ∈ FootprintVertices X ∨ y ∈ FootprintVertices W))))) ) := by + ∀ (X : ProtoTile), + ∀ (Y : ProtoTile), + ∀ (Z : ProtoTile), + ∀ (x : GaussianInt), + X ≠ Y → + X ≠ Z → + (∃ U V R : ProtoTile, + (X = U ∨ X = V) ∧ + (U = X ∧ V = Y ∧ R = Z ∨ + U = Y ∧ V = X ∧ R = Z ∨ + U = X ∧ V = Z ∧ R = Y ∨ + U = Z ∧ V = X ∧ R = Y ∨ + U = Y ∧ V = Z ∧ R = X ∨ U = Z ∧ V = Y ∧ R = X) ∧ + (∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ U.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ V.cells) ∧ + x ∈ FootprintVertices U ∧ + x ∈ FootprintVertices V ∧ + ∀ y, + y = x ∨ + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V) → + ∃ W : ProtoTile, + (W = Y ∨ W = Z) ∧ + ∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ X.cells ∧ + LatticeVertexIncidentCell x (j + 2) ∈ W.cells ∧ + x ∈ FootprintVertices X ∧ + x ∈ FootprintVertices W ∧ + ∀ y, + y = x ∨ + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices X ∨ y ∈ FootprintVertices W + ) := by classical - intro X Y Z x hXY hXZ hYZ hsel + intro X Y Z x hXY hXZ hsel rcases hsel with ⟨U, V, R, hD, hperm, hopp, hU, hV, hstar⟩ have reverse (A B : ProtoTile) (hopp : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ A.cells ∧ @@ -727,9 +714,9 @@ private theorem hnotEven3 : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (¬ Even 3) ) := by + ¬Even 3 + ) := by classical - intro q cfg rintro ⟨n, hn⟩ omega @@ -1846,7 +1833,6 @@ theorem BandOrderedGeneralPositiveCutGeometry have hQ2S2 := touching_disjoint _ _ cert.double_first.1 hQ2ne hS3ne have hOQ1 := touching_disjoint _ _ cert.precursor_first.2.2.1 hOne hQ2ne have hS1O := touching_disjoint _ _ cert.precursor_second.2.1 hS2ne hOne - have normalize_pair := PositiveCutGeometry.normalize_pair have selectB_Q := PositiveCutGeometry.selectB_Q q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck hQ3occ hS2occ hBowners hOoccB hQ3S2 hS2O hOQ3 have normalize_selected := PositiveCutGeometry.normalize_selected @@ -1868,25 +1854,25 @@ theorem BandOrderedGeneralPositiveCutGeometry have hneB_OS := ne_of_disjoint _ _ hS2O.symm hOne have hneB_OQ := ne_of_disjoint _ _ hOQ3 hOne have selected_p2_a := normalize_selected (cert.Q 1 true) (cert.S 2 false) cert.O - cert.exceptionalSegments.a hneA_QS hneA_QO hneA_SO + cert.exceptionalSegments.a hneA_QS hneA_QO ((PositiveCutGeometry.selectA_Q q cfg C₀ T cert hQ2lat hS3lat hOlat hQ2check hS3check hOcheck hQ2occ hS3occ hAowners hOoccA hQS hSO hOQ) (cert.Q 1 true) (Or.inl rfl)) have selected_p2_b := normalize_selected (cert.S 1 false) (cert.Q 2 true) cert.O - cert.exceptionalSegments.b hneB_SQ hneB_SO' hneB_QO' + cert.exceptionalSegments.b hneB_SQ hneB_SO' ((PositiveCutGeometry.selectB_S q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck hQ3occ hS2occ hBowners hOoccB hQ3S2 hS2O hOQ3) (cert.S 1 false) (Or.inl rfl)) have selected_p4_a := normalize_selected cert.O (cert.Q 1 true) (cert.S 2 false) - cert.exceptionalSegments.a hneA_OQ hneA_OS hneA_QS + cert.exceptionalSegments.a hneA_OQ hneA_OS ((PositiveCutGeometry.selectA_O q cfg C₀ T cert hQ2lat hS3lat hOlat hQ2check hS3check hOcheck hQ2occ hS3occ hAowners hOoccA hQS hSO hOQ) cert.O (Or.inl rfl)) have selected_p4_b := normalize_selected cert.O (cert.S 1 false) (cert.Q 2 true) - cert.exceptionalSegments.b hneB_OS hneB_OQ hneB_SQ + cert.exceptionalSegments.b hneB_OS hneB_OQ ((PositiveCutGeometry.selectB_O q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck hQ3occ hS2occ hBowners hOoccB hQ3S2 hS2O hOQ3) cert.O (Or.inl rfl)) let I : GaussianInt := ⟨0, 1⟩ have hI2 : I ^ 2 = -1 := by dsimp [I]; decide have hI3 : I ^ 3 = -I := by dsimp [I]; decide - have hnotEven3 := PositiveCutGeometry.hnotEven3 q cfg + have hnotEven3 := PositiveCutGeometry.hnotEven3 have hodd3 : ¬ (∃ r : ℕ, 3 = r + r) := by omega have occurrence_centroid := PositiveCutGeometry.occurrence_centroid have vectorSystem : RecursiveVectorSystem BandVectors := by diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean index 9456bc959f..03685a7557 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean @@ -1698,13 +1698,14 @@ private theorem geomAt1214 : bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), - let q := bundle.normalizedPresentation - let cfg := bundle.configuration - let F := bundle.normalizedFixed - let root := bundle.normalizedRoot + let q := bundle.normalizedPresentation; + let cfg := bundle.configuration; + let F := bundle.normalizedFixed; + let root := bundle.normalizedRoot; ∀ (edgeVertex : ∀ (tile : ProtoTile), (tile.cells.Nonempty) → (∀ (edge : Finset GaussianInt), (edge ∈ FootprintEdges tile) → (∀ (point : GaussianInt), (point ∈ edge) - → (point ∈ FootprintVertices tile)))), (placement.rightNeighborPositive = false) → ( + → (point ∈ FootprintVertices tile)))), + ( let norm : BandOrderedGeneralRightNormalizationCertificate C T N h k x := { presentation := bundle.presentation presentation_proper := bundle.presentation_proper @@ -1900,7 +1901,7 @@ private theorem geomAt1214 : ((placement.secondBoundarySign = true) → (rightGeometry 0 1 1 false true)))))))))))))) := by classical - intro C D T N h k x bundle placement selectedEdge q cfg F root edgeVertex hp norm P u v + intro C D T N h k x bundle placement selectedEdge q cfg F root edgeVertex norm P u v selectedPath rightGeometry packageGeometry firstBoundarySubset secondBoundarySubset hi hj R1 R2 g hgs hge hneq hfirst hsecond have R1g : ExactTileInterfaceTriple F g.startCompanion @@ -1999,13 +2000,13 @@ private theorem geomAt1286 : bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), - let q := bundle.normalizedPresentation - let cfg := bundle.configuration - let F := bundle.normalizedFixed - let root := bundle.normalizedRoot + let q := bundle.normalizedPresentation; + let cfg := bundle.configuration; + let F := bundle.normalizedFixed; + let root := bundle.normalizedRoot; ∀ (edgeVertex : ∀ (tile : ProtoTile), (tile.cells.Nonempty) → (∀ (edge : Finset GaussianInt), (edge ∈ FootprintEdges tile) → (∀ (point : GaussianInt), (point ∈ edge) - → (point ∈ FootprintVertices tile)))), ∀ (hp : placement.rightNeighborPositive = true), + → (point ∈ FootprintVertices tile)))), let norm : BandOrderedGeneralRightNormalizationCertificate C T N h k x := { presentation := bundle.presentation presentation_proper := bundle.presentation_proper @@ -2201,7 +2202,7 @@ private theorem geomAt1286 : ((placement.secondBoundarySign = false) → (rightGeometry 0 1 (-1) true false)))))))))))) ) := by classical - intro C D T N h k x bundle placement selectedEdge q cfg F root edgeVertex hp norm P u v + intro C D T N h k x bundle placement selectedEdge q cfg F root edgeVertex norm P u v selectedPath rightGeometry packageGeometry firstBoundarySubset secondBoundarySubset hi hj R1 R2 g hgs hge hneq hfirst hsecond have R1g : ExactTileInterfaceTriple F g.startCompanion @@ -3135,7 +3136,7 @@ private theorem firstCyclicCase : · rw [hpos] at hp cases hp · have geom := SelectedRowGeometry.geomAt1214 C D T N h k x bundle placement selectedEdge - edgeVertex hp packageGeometry firstBoundarySubset secondBoundarySubset hi hj R1 R2 g + edgeVertex packageGeometry firstBoundarySubset secondBoundarySubset hi hj R1 R2 g hgs hge hneq hfirst hsecond have hgeom := (show rightGeometry placement.rightFirstSlot placement.rightSecondSlot 1 false @@ -3189,7 +3190,7 @@ private theorem firstCyclicCase : have hsigns := placement.boundary_signs rcases hsigns with ⟨hp, hfirst, hsecond⟩ | ⟨hp, hfirst, hsecond⟩ · have geom := SelectedRowGeometry.geomAt1286 C D T N h k x bundle placement selectedEdge - edgeVertex hp packageGeometry firstBoundarySubset secondBoundarySubset hi hj R1 R2 g + edgeVertex packageGeometry firstBoundarySubset secondBoundarySubset hi hj R1 R2 g hgs hge hneq hfirst hsecond have hgeom := (show rightGeometry placement.rightFirstSlot placement.rightSecondSlot (-1) true @@ -3220,16 +3221,13 @@ private theorem secondCyclicCase : bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign - bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), ∀ (chosenBoundary : - bundle.selectedSlot = placement.rightFirstSlot ∧ bundle.selectedSign = + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), (bundle.selectedSlot + = placement.rightFirstSlot ∧ bundle.selectedSign = placement.firstBoundarySign ∨ bundle.selectedSlot = placement.rightSecondSlot ∧ - bundle.selectedSign = placement.secondBoundarySign), - let q := bundle.normalizedPresentation - let F := bundle.normalizedFixed - let root := bundle.normalizedRoot - ∀ (edgeVertex : ∀ (tile : ProtoTile), (tile.cells.Nonempty) → (∀ (edge : Finset - GaussianInt), (edge ∈ FootprintEdges tile) → (∀ (point : GaussianInt), (point ∈ edge) - → (point ∈ FootprintVertices tile)))), + bundle.selectedSign = placement.secondBoundarySign) → + let q := bundle.normalizedPresentation; + let F := bundle.normalizedFixed; + let root := bundle.normalizedRoot; let norm := SelectedRowNormalization.certificate C D T N h k x bundle placement ∀ (childInterfaces : (∀ (i : Fin (3 : ℕ)), Nonempty (ExactTileInterfaceTriple F (TileTranslation F (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation @@ -3468,8 +3466,8 @@ private theorem secondCyclicCase : rightGeometry placement.rightFirstSlot placement.rightSecondSlot 1 false true))))))))))))) ) := by classical - intro C D T N h k x bundle placement selectedEdge chosenBoundary q F root edgeVertex norm - childInterfaces turnOutgoing turnNeg boundaryRecords centeredExactTurn tripleTurnOutgoing + intro C D T N h k x bundle placement selectedEdge chosenBoundary q F root norm childInterfaces + turnOutgoing turnNeg boundaryRecords centeredExactTurn tripleTurnOutgoing tripleTurnNegativeNext touchingPlus touchingMinus P u v selectedPath rightGeometry canonicalFinish coordinateFactsBpos coordinateFactsBneg period0 period1 period2 packageGeometry firstBoundarySubset secondBoundarySubset hcycle @@ -3622,16 +3620,13 @@ private theorem thirdCyclicCase : bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign - bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), ∀ (chosenBoundary : - bundle.selectedSlot = placement.rightFirstSlot ∧ bundle.selectedSign = + bundle.routedDirection), ∀ (selectedEdge : Finset GaussianInt), (bundle.selectedSlot + = placement.rightFirstSlot ∧ bundle.selectedSign = placement.firstBoundarySign ∨ bundle.selectedSlot = placement.rightSecondSlot ∧ - bundle.selectedSign = placement.secondBoundarySign), - let q := bundle.normalizedPresentation - let F := bundle.normalizedFixed - let root := bundle.normalizedRoot - ∀ (edgeVertex : ∀ (tile : ProtoTile), (tile.cells.Nonempty) → (∀ (edge : Finset - GaussianInt), (edge ∈ FootprintEdges tile) → (∀ (point : GaussianInt), (point ∈ edge) - → (point ∈ FootprintVertices tile)))), + bundle.selectedSign = placement.secondBoundarySign) → + let q := bundle.normalizedPresentation; + let F := bundle.normalizedFixed; + let root := bundle.normalizedRoot; let norm := SelectedRowNormalization.certificate C D T N h k x bundle placement ∀ (childInterfaces : (∀ (i : Fin (3 : ℕ)), Nonempty (ExactTileInterfaceTriple F (TileTranslation F (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation @@ -3870,8 +3865,8 @@ private theorem thirdCyclicCase : rightGeometry placement.rightFirstSlot placement.rightSecondSlot 1 false true))))))))))))) ) := by classical - intro C D T N h k x bundle placement selectedEdge chosenBoundary q F root edgeVertex norm - childInterfaces turnOutgoing turnNeg boundaryRecords centeredExactTurn tripleTurnOutgoing + intro C D T N h k x bundle placement selectedEdge chosenBoundary q F root norm childInterfaces + turnOutgoing turnNeg boundaryRecords centeredExactTurn tripleTurnOutgoing tripleTurnNegativeNext touchingPlus touchingMinus P u v selectedPath rightGeometry canonicalFinish coordinateFactsCpos coordinateFactsCneg period0 period1 period2 packageGeometry firstBoundarySubset secondBoundarySubset hcycle @@ -4331,13 +4326,13 @@ theorem BandOrderedGeneralRightSelectedRowGeometry packageGeometry firstBoundarySubset secondBoundarySubset hcycle exact firstCyclicCase · have secondCyclicCase := SelectedRowConclusions.secondCyclicCase C D T N h k x bundle - placement selectedEdge chosenBoundary edgeVertex childInterfaces turnOutgoing turnNeg + placement selectedEdge chosenBoundary childInterfaces turnOutgoing turnNeg boundaryRecords centeredExactTurn tripleTurnOutgoing tripleTurnNegativeNext touchingPlus touchingMinus canonicalFinish coordinateFactsBpos coordinateFactsBneg period0 period1 period2 packageGeometry firstBoundarySubset secondBoundarySubset hcycle exact secondCyclicCase · have thirdCyclicCase := SelectedRowConclusions.thirdCyclicCase C D T N h k x bundle placement - selectedEdge chosenBoundary edgeVertex childInterfaces turnOutgoing turnNeg boundaryRecords + selectedEdge chosenBoundary childInterfaces turnOutgoing turnNeg boundaryRecords centeredExactTurn tripleTurnOutgoing tripleTurnNegativeNext touchingPlus touchingMinus canonicalFinish coordinateFactsCpos coordinateFactsCneg period0 period1 period2 packageGeometry firstBoundarySubset secondBoundarySubset hcycle diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean index 64458f4130..e613c35b18 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean @@ -185,243 +185,6 @@ private theorem turn_map_injective : simp [GaussianTranslation, GaussianQuarterTurn] at hre omega -private theorem hrootW : - ∀ (T : ProtoTile), - ∀ (W : ProtoTile), - ∀ (u : GaussianInt), - ∀ (v : GaussianInt), - ∀ (g : GaussianInt), - ∀ (parentSlot : Fin 3), - ∀ (turn : Fin 4), - ∀ (uIndex : PeriodicSubtileIndex), - ∀ (uBar : PeriodicSubtileIndex), - ∀ (vIndex : PeriodicSubtileIndex), - ∀ (vBar : PeriodicSubtileIndex), - ∀ (wBlock : Int × Int), - (parentSlot = (0 : Fin (3 : ℕ)) ∧ - turn = (0 : Fin (4 : ℕ)) ∧ - uIndex = - ⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ ∧ - uBar = ⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ ∧ - wBlock = ((1 : ℤ), (0 : ℤ)) ∧ - vIndex = - ⟨SixSubtileLabel.C, (1 : ℤ), - (0 : ℤ)⟩ ∧ - vBar = - ⟨SixSubtileLabel.C, (1 : ℤ), - (1 : ℤ)⟩ ∨ - parentSlot = (0 : Fin (3 : ℕ)) ∧ - turn = (1 : Fin (4 : ℕ)) ∧ - uIndex = - ⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ ∧ - uBar = - ⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ ∧ - wBlock = ((-1 : ℤ), (0 : ℤ)) ∧ - vIndex = - ⟨SixSubtileLabel.F, (1 : ℤ), - (0 : ℤ)⟩ ∧ - vBar = - ⟨SixSubtileLabel.E, (0 : ℤ), - (1 : ℤ)⟩ ∨ - parentSlot = (0 : Fin (3 : ℕ)) ∧ - turn = (2 : Fin (4 : ℕ)) ∧ - uIndex = - ⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ ∧ - uBar = - ⟨SixSubtileLabel.A, (-1 : ℤ), - (-1 : ℤ)⟩ ∧ - wBlock = ((-1 : ℤ), (0 : ℤ)) ∧ - vIndex = - ⟨SixSubtileLabel.D, (-1 : ℤ), - (0 : ℤ)⟩ ∧ - vBar = - ⟨SixSubtileLabel.D, (-1 : ℤ), - (-1 : ℤ)⟩ ∨ - parentSlot = (0 : Fin (3 : ℕ)) ∧ - turn = (3 : Fin (4 : ℕ)) ∧ - uIndex = - ⟨SixSubtileLabel.A, (-1 : ℤ), - (-1 : ℤ)⟩ ∧ - uBar = - ⟨SixSubtileLabel.A, (0 : ℤ), - (-1 : ℤ)⟩ ∧ - wBlock = ((1 : ℤ), (0 : ℤ)) ∧ - vIndex = - ⟨SixSubtileLabel.E, (-1 : ℤ), - (0 : ℤ)⟩ ∧ - vBar = - ⟨SixSubtileLabel.F, (0 : ℤ), - (-1 : ℤ)⟩ ∨ - parentSlot = (1 : Fin (3 : ℕ)) ∧ - turn = (0 : Fin (4 : ℕ)) ∧ - uIndex = - ⟨SixSubtileLabel.C, (1 : ℤ), - (1 : ℤ)⟩ ∧ - uBar = - ⟨SixSubtileLabel.D, (-1 : ℤ), - (0 : ℤ)⟩ ∧ - wBlock = ((0 : ℤ), (1 : ℤ)) ∧ - vIndex = - ⟨SixSubtileLabel.E, (0 : ℤ), - (1 : ℤ)⟩ ∧ - vBar = - ⟨SixSubtileLabel.E, (-1 : ℤ), - (0 : ℤ)⟩ ∨ - parentSlot = (1 : Fin (3 : ℕ)) ∧ - turn = (1 : Fin (4 : ℕ)) ∧ - uIndex = - ⟨SixSubtileLabel.D, (-1 : ℤ), - (0 : ℤ)⟩ ∧ - uBar = - ⟨SixSubtileLabel.D, (-1 : ℤ), - (-1 : ℤ)⟩ ∧ - wBlock = ((0 : ℤ), (-1 : ℤ)) ∧ - vIndex = - ⟨SixSubtileLabel.B, (0 : ℤ), - (1 : ℤ)⟩ ∧ - vBar = - ⟨SixSubtileLabel.A, - (-1 : ℤ), (-1 : ℤ)⟩ ∨ - parentSlot = (1 : Fin (3 : ℕ)) ∧ - turn = (2 : Fin (4 : ℕ)) ∧ - uIndex = - ⟨SixSubtileLabel.D, (-1 : ℤ), - (-1 : ℤ)⟩ ∧ - uBar = - ⟨SixSubtileLabel.C, (1 : ℤ), - (0 : ℤ)⟩ ∧ - wBlock = ((0 : ℤ), (-1 : ℤ)) ∧ - vIndex = - ⟨SixSubtileLabel.F, - (0 : ℤ), (-1 : ℤ)⟩ ∧ - vBar = - ⟨SixSubtileLabel.F, - (1 : ℤ), (0 : ℤ)⟩ ∨ - parentSlot = (1 : Fin (3 : ℕ)) ∧ - turn = (3 : Fin (4 : ℕ)) ∧ - uIndex = - ⟨SixSubtileLabel.C, (1 : ℤ), - (0 : ℤ)⟩ ∧ - uBar = - ⟨SixSubtileLabel.C, (1 : ℤ), - (1 : ℤ)⟩ ∧ - wBlock = ((0 : ℤ), (1 : ℤ)) ∧ - vIndex = - ⟨SixSubtileLabel.A, - (0 : ℤ), (-1 : ℤ)⟩ ∧ - vBar = - ⟨SixSubtileLabel.B, - (1 : ℤ), (1 : ℤ)⟩ ∨ - parentSlot = (2 : Fin (3 : ℕ)) ∧ - turn = (0 : Fin (4 : ℕ)) ∧ - uIndex = - ⟨SixSubtileLabel.E, - (-1 : ℤ), (0 : ℤ)⟩ ∧ - uBar = - ⟨SixSubtileLabel.F, - (0 : ℤ), (-1 : ℤ)⟩ ∧ - wBlock = - ((-1 : ℤ), (-1 : ℤ)) ∧ - vIndex = - ⟨SixSubtileLabel.A, - (-1 : ℤ), - (-1 : ℤ)⟩ ∧ - vBar = - ⟨SixSubtileLabel.A, - (0 : ℤ), (-1 : ℤ)⟩ ∨ - parentSlot = (2 : Fin (3 : ℕ)) ∧ - turn = (1 : Fin (4 : ℕ)) ∧ - uIndex = - ⟨SixSubtileLabel.F, - (0 : ℤ), (-1 : ℤ)⟩ ∧ - uBar = - ⟨SixSubtileLabel.F, - (1 : ℤ), (0 : ℤ)⟩ ∧ - wBlock = - ((1 : ℤ), (1 : ℤ)) ∧ - vIndex = - ⟨SixSubtileLabel.D, - (-1 : ℤ), - (-1 : ℤ)⟩ ∧ - vBar = - ⟨SixSubtileLabel.C, - (1 : ℤ), - (0 : ℤ)⟩ ∨ - parentSlot = (2 : Fin (3 : ℕ)) ∧ - turn = (2 : Fin (4 : ℕ)) ∧ - uIndex = - ⟨SixSubtileLabel.F, - (1 : ℤ), (0 : ℤ)⟩ ∧ - uBar = - ⟨SixSubtileLabel.E, - (0 : ℤ), (1 : ℤ)⟩ ∧ - wBlock = - ((1 : ℤ), (1 : ℤ)) ∧ - vIndex = - ⟨SixSubtileLabel.B, - (1 : ℤ), - (1 : ℤ)⟩ ∧ - vBar = - ⟨SixSubtileLabel.B, - (0 : ℤ), - (1 : ℤ)⟩ ∨ - parentSlot = (2 : Fin (3 : ℕ)) ∧ - turn = (3 : Fin (4 : ℕ)) ∧ - uIndex = - ⟨SixSubtileLabel.E, - (0 : ℤ), (1 : ℤ)⟩ ∧ - uBar = - ⟨SixSubtileLabel.E, - (-1 : ℤ), (0 : ℤ)⟩ ∧ - wBlock = - ((-1 : ℤ), - (-1 : ℤ)) ∧ - vIndex = - ⟨SixSubtileLabel.C, - (1 : ℤ), - (1 : ℤ)⟩ ∧ - vBar = - ⟨SixSubtileLabel.D, - (-1 : ℤ), - (0 : ℤ)⟩) → - (((TileTranslation (TileQuarterTurn T) g).cells = - T.cells) → - (((TileTranslation (TileQuarterTurn W) g).cells = - (TileTranslation T - ((↑wBlock.1 : GaussianInt) * u + - (↑wBlock.2 : GaussianInt) * v)).cells) → - ((∀ (m : ℤ), - ∀ (n : ℤ), - ∀ (r : ℤ), - ∀ (s : ℤ), - (m, n) ≠ (r, s) → - Disjoint - (TileTranslation T - ((↑m : GaussianInt) * u + - (↑n : GaussianInt) * v)).cells - (TileTranslation T - ((↑r : GaussianInt) * u + - (↑s : GaussianInt) * - v)).cells) → - ((∀ (A : ProtoTile), - ∀ (B : ProtoTile), - (Disjoint - (TileTranslation (TileQuarterTurn A) - g).cells - (TileTranslation (TileQuarterTurn B) - g).cells) → - (Disjoint A.cells B.cells)) → - (Disjoint T.cells W.cells))))) := by - classical - intro T W u v g parentSlot turn uIndex uBar vIndex vBar wBlock hrow hrootBar hWBar hblocks - pull_disjoint - apply pull_disjoint - rw [hrootBar, hWBar] - have h := hblocks 0 0 wBlock.1 wBlock.2 (by - exact (rowSeparation parentSlot turn uIndex uBar vIndex vBar wBlock hrow).1) - have hzero := congrArg ProtoTile.cells (TileTranslationProperties.zero T) - simpa [hzero] using h - end GeneralSeparationProof theorem BandOrderedGeneralSubtileCanonicalSeparation @@ -568,9 +331,13 @@ theorem BandOrderedGeneralSubtileCanonicalSeparation rw [hfixedSource] simpa using root_occurrence_disjoint uIndex (by exact (rowSeparation parentSlot turn uIndex uBar vIndex vBar wBlock hrow).2.1) - have hrootW : Disjoint T.cells W.cells := GeneralSeparationProof.hrootW T W u v g - parentSlot turn uIndex uBar vIndex vBar wBlock hrow hrootBar hWBar hblocks - pull_disjoint + have hrootW : Disjoint T.cells W.cells := by + apply pull_disjoint + rw [hrootBar, hWBar] + have h := hblocks 0 0 wBlock.1 wBlock.2 + (rowSeparation parentSlot turn uIndex uBar vIndex vBar wBlock hrow).1 + have hzero := congrArg ProtoTile.cells (TileTranslationProperties.zero T) + simpa [hzero] using h have hfixedW : Disjoint U.cells W.cells := by apply pull_disjoint rw [hfixedBar, hWBar] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean index 7d05a477b1..fa7d7b4286 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean @@ -401,45 +401,79 @@ private theorem centralData : (by classical exact - (BandCircle) → (∀ (q : Fin 4 → CircleCoordinates), (Fin 3) → ((Fin 4) → (∀ (T₀ : - ProtoTile), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let qbar := BandPackingSymmetryQuadrupleAction g qrot - ∀ (hqbar : ProperBandQuadruple qbar), ∀ (cfg : BandOrderedGeneralConfiguration qbar), - (Bool) → ((Fin (4 : ℕ)) → ( - let T₀bar := BandPackingSymmetryTileAction g T₀ - ∀ (hqbar₀Pos : 0 < (qbar 0).1), - let C₀bar : BandCircle := - ⟨⟨qbar 0, ⟨Or.inl hqbar₀Pos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbar₀Pos⟩ - ∀ (layout : BandOrderedGeneralLayoutCertificate qbar cfg C₀bar T₀bar), ∀ (pieces : Fin (3 - : ℕ) → Bool → ProtoTile), ∀ (functions : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i - : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (qbar i.succ) (pieces i s) (functions i - s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (pieces i s) - TileCentroid - T₀bar = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint - (BandVectors.1 (qbar (i + (2 : Fin (3 : ℕ))).succ) (qbar (i + (1 : Fin (3 : - ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (qbar (i + (2 : Fin (3 : ℕ))).succ) - (qbar (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (qbar (i + - (2 : Fin (3 : ℕ))).succ) (qbar (i + (1 : Fin (3 : ℕ))).succ))).1))) → ( - let labelOf : Fin 3 → Bool → SixSubtileLabel := fun j e => - match j, e with - | 0, true => .A | 0, false => .B - | 1, true => .C | 1, false => .D - | 2, true => .E | 2, false => .F - let pieceIndex : Fin 3 → Bool → PeriodicSubtileIndex := fun j e => - ⟨labelOf j e, 0, 0⟩ - (∀ (j : Fin 3), ∀ (e : Bool), SubtileOccurrenceInterpretation layout.P layout.u layout.v - (pieceIndex j e) = layout.P j e) → (∀ (j : Fin 3), ∀ (e : Bool), (pieces j e).cells = - (SubtileOccurrenceInterpretation layout.P layout.u layout.v (pieceIndex j e)).cells ∧ - ((pieces j e).cells = ∅ → (pieces j e).anchor = (SubtileOccurrenceInterpretation - layout.P layout.u layout.v (pieceIndex j e)).anchor) ∧ FootprintVertices (pieces j e) - = FootprintVertices (SubtileOccurrenceInterpretation layout.P layout.u layout.v - (pieceIndex j e)) ∧ ((functions j e).domain : Set GaussianInt) = FootprintVertices - (SubtileOccurrenceInterpretation layout.P layout.u layout.v (pieceIndex j e)))))))))) ) + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (T₀ : ProtoTile), + ∀ (r : Fin (3 : ℕ)), + ∀ (g : BandPackingSymmetry), + let qrot : Fin 4 → CircleCoordinates := + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ]; + let qbar := BandPackingSymmetryQuadrupleAction g qrot; + ∀ (hqbar : ProperBandQuadruple qbar), + ∀ (cfg : BandOrderedGeneralConfiguration qbar), + let T₀bar := BandPackingSymmetryTileAction g T₀ + ∀ (hqbar₀Pos : 0 < (qbar 0).1), + let C₀bar : BandCircle := + ⟨⟨qbar 0, ⟨Or.inl hqbar₀Pos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, + hqbar₀Pos⟩ + ∀ + (layout : + BandOrderedGeneralLayoutCertificate qbar cfg C₀bar T₀bar), + ∀ (pieces : Fin (3 : ℕ) → Bool → ProtoTile), + ∀ (functions : Fin (3 : ℕ) → Bool → PartialOdometer), + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + TileOdometer (qbar i.succ) (pieces i s) (functions i s)) → + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + TileCentroid (pieces i s) - TileCentroid T₀bar = + (if s = true then (1 : ℝ) else (-1 : ℝ)) • + (1 / 2 : ℝ) • + (GaussianRealPoint + (BandVectors.1 (qbar (i + (2 : Fin (3 : ℕ))).succ) + (qbar (i + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint + (BandVectors.1 (qbar (i + (2 : Fin (3 : ℕ))).succ) + (qbar (i + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint + (BandVectors.1 (qbar (i + (2 : Fin (3 : ℕ))).succ) + (qbar (i + (1 : Fin (3 : ℕ))).succ))).1))) → + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun j e => + match j, e with + | 0, true => .A + | 0, false => .B + | 1, true => .C + | 1, false => .D + | 2, true => .E + | 2, false => .F + let pieceIndex : Fin 3 → Bool → PeriodicSubtileIndex := + fun j e => ⟨labelOf j e, 0, 0⟩ + (∀ (j : Fin 3), + ∀ (e : Bool), + SubtileOccurrenceInterpretation layout.P layout.u layout.v + (pieceIndex j e) = + layout.P j e) → + ∀ (j : Fin 3), + ∀ (e : Bool), + (pieces j e).cells = + (SubtileOccurrenceInterpretation layout.P layout.u + layout.v (pieceIndex j e)).cells ∧ + ((pieces j e).cells = ∅ → + (pieces j e).anchor = + (SubtileOccurrenceInterpretation layout.P layout.u + layout.v (pieceIndex j e)).anchor) ∧ + FootprintVertices (pieces j e) = + FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u + layout.v (pieceIndex j e)) ∧ + ((functions j e).domain : Set GaussianInt) = + FootprintVertices + (SubtileOccurrenceInterpretation layout.P layout.u + layout.v (pieceIndex j e)) + ) := by classical - intro Cᵢ q i s T₀ r g qrot qbar hqbar cfg negative sbar T₀bar hqbar₀Pos C₀bar layout pieces - functions hpieceOdometer hpieceCentroid labelOf pieceIndex centralOccurrence j e + intro q T₀ r g qrot qbar hqbar cfg T₀bar hqbar₀Pos C₀bar layout pieces functions + hpieceOdometer hpieceCentroid labelOf pieceIndex centralOccurrence j e have hpieceBand : BandPrototile (qbar j.succ) (pieces j e) := TileOdometerBandPrototile _ _ _ (hpieceOdometer j e) have hlayoutBand : BandPrototile (qbar j.succ) @@ -1150,8 +1184,8 @@ theorem BandOrderedGeneralSubtileNormalizationCertificateExists (pieceIndex j e)) ∧ ((functions j e).domain : Set GaussianInt) = FootprintVertices (SubtileOccurrenceInterpretation layout.P layout.u layout.v - (pieceIndex j e)) := SubtileNormalizationGeometry.centralData Cᵢ q i s T₀ r g hqbar - cfg negative sbar hqbar₀Pos layout pieces functions hpieceOdometer hpieceCentroid + (pieceIndex j e)) := SubtileNormalizationGeometry.centralData q T₀ r g hqbar + cfg hqbar₀Pos layout pieces functions hpieceOdometer hpieceCentroid centralOccurrence j e have hrootSym : QuarterTurnSymmetric T₀bar := hT₀ind.2.2.2.1 have subtileNormalizationCertificate : diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean index de8b2098a9..a4ccb6a65a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean @@ -413,9 +413,13 @@ private theorem positiveSupport : (by classical exact - ∀ (C : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (p : ℝ × ℝ), 0 < - C.1 → TileOdometer C U k → PartialOdometerSlope k = some p → U.cells.Nonempty ) := by - intro C U k p _ hO hp + ∀ (C : CircleCoordinates), + ∀ (U : ProtoTile), + ∀ (k : PartialOdometer), + ∀ (p : ℝ × ℝ), + TileOdometer C U k → PartialOdometerSlope k = some p → U.cells.Nonempty + ) := by + intro C U k p hO hp exact TileOdometerSlopeNonempty.cells C U k p hO hp private theorem hq0 : @@ -827,30 +831,53 @@ private theorem hsourceSlope : (by classical exact - ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : - Fin (3 : ℕ)), ∀ (e : Bool), (TileCentroid T' - TileCentroid T = (if e = true then (1 - : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (2 : - Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint - (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, - (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin - (3 : ℕ))).succ))).1))) → ((Bool) → ( - let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) - let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) - let M : GaussianInt × GaussianInt := - (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) - let eReal : ℝ := if e then 1 else -1 - let k : ℝ := eReal / 2 - (TileCentroid T' - TileCentroid T = k • GaussianRealPoint M.1) → (∀ (p : ℝ × ℝ), ∀ (p' : - ℝ × ℝ), (p'.1 - p.1 = (if e = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * - ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : - ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : - Fin (3 : ℕ))).succ)).im : ℝ))) → ((p'.2 - p.2 = (if e = true then (1 : ℝ) else (-1 : - ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : - Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q - (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (p' - p = k • GaussianRealPoint M.2))))) ) + ∀ (T : ProtoTile), + ∀ (T' : ProtoTile), + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), + ∀ (e : Bool), + TileCentroid T' - TileCentroid T = + (if e = true then (1 : ℝ) else (-1 : ℝ)) • + (1 / 2 : ℝ) • + (GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ))).1)) → + let W := BandVectors.1 (q (i + 2).succ) (q (i + 1).succ) + let A := BandVectors.2 (q (i + 2).succ) (q (i + 1).succ) + let M : GaussianInt × GaussianInt := + (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) + let eReal : ℝ := if e then 1 else -1 + let k : ℝ := eReal / 2 + TileCentroid T' - TileCentroid T = k • GaussianRealPoint M.1 → + ∀ (p : ℝ × ℝ), + ∀ (p' : ℝ × ℝ), + p'.1 - p.1 = + (if e = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).re : + ℝ) - + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).im : + ℝ)) → + p'.2 - p.2 = + (if e = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).im : + ℝ) + + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).re : + ℝ)) → + p' - p = k • GaussianRealPoint M.2 + ) := by classical - intro T T' q i e hcent delta W A M eReal k hcentM p p' hRe hIm + intro T T' q i e hcent W A M eReal k hcentM p p' hRe hIm have hRe' : p'.1 - p.1 = (if e then (1 : ℝ) else -1) * (1 / 2) * (((GaussianInt.toComplex A).re) - (GaussianInt.toComplex A).im) := by simpa [A] using hRe @@ -895,64 +922,6 @@ private theorem hdiff : intro g T T' q i e W A M eReal k p p' htrSlope r r' simpa [r, r'] using htrSlope.2 -private theorem hWphase2 : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : - ℕ)), ∀ (delta : Bool), (BandPackingSymmetryScopedPhase g q delta) → ( - let q' := BandPackingSymmetryQuadrupleAction g q - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j - let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) - let W' := BandVectors.1 (q' ((sigma i + 2).succ)) - (q' ((sigma i + 1).succ)) - W' = (if delta then (-1 : GaussianInt) else 1) * (if - BandPackingSymmetryReversesOrientation g then GaussianQuarterTurn - (BandPackingSymmetryVectorAction g W) else BandPackingSymmetryVectorAction g W)) ) := by - classical - intro g q i delta hphase q' sigma W W' - simpa [W', W, q', sigma, BandPackingSymmetryReversesOrientation] using - (hphase i).2.2 - -private theorem hAphase2 : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : - ℕ)), ∀ (delta : Bool), (∀ (i : Fin (3 : ℕ)), - let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); - let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : - Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); - let cyclic := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 - : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ - BandVectors.2 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : - ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : - ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation g = true then - -GaussianQuarterTurn cyclic.2 else cyclic.2) → ( - let q' := BandPackingSymmetryQuadrupleAction g q - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j - let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) - let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) - let Z : GaussianInt × GaussianInt := (W, A) - let A' := BandVectors.2 (q' ((sigma i + 2).succ)) - (q' ((sigma i + 1).succ)) - A' = (if delta then (-1 : GaussianInt) else 1) * (if - BandPackingSymmetryReversesOrientation g then -GaussianQuarterTurn - (BandPackingSymmetryAffineVectorAction g Z).2 else - (BandPackingSymmetryAffineVectorAction g Z).2)) ) := by - classical - intro g q i delta hcyc q' sigma W A Z A' - simpa [A', Z, q', sigma, BandPackingSymmetryReversesOrientation] using - (hcyc i).2 - private abbrev hactM2 := ApollonianSuperharmonic.MarkedCovarianceGeometry.hactM @@ -1271,18 +1240,22 @@ private theorem hphase : (by classical exact - ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : - ℕ)), (Fin (4 : ℕ)) → (∀ (delta : Bool), (BandPackingSymmetryScopedPhase g q delta) → - ((ProtoTile) → ( - let q' := BandPackingSymmetryQuadrupleAction g q - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j - let a := BandVectors.1 (q i.succ) (q 0) - let a' := BandVectors.1 (q' (sigma i).succ) (q' 0) - a' = if delta then -BandPackingSymmetryVectorAction g a else - BandPackingSymmetryVectorAction g a))) ) := by + ∀ (g : BandPackingSymmetry), + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), + ∀ (delta : Bool), + BandPackingSymmetryScopedPhase g q delta → + let q' := BandPackingSymmetryQuadrupleAction g q + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j else j + let a := BandVectors.1 (q i.succ) (q 0) + let a' := BandVectors.1 (q' (sigma i).succ) (q' 0) + a' = + if delta then -BandPackingSymmetryVectorAction g a + else BandPackingSymmetryVectorAction g a + ) := by classical - intro g q i s delta hdelta T q' sigma a a' + intro g q i delta hdelta q' sigma a a' let b' := BandVectors.1 (q' 0) (q' (sigma i).succ) have hh := hdelta i dsimp [BandPackingSymmetryScopedPhase, sigma, a', a] at hh @@ -1449,42 +1422,80 @@ private theorem forwardSub : (by classical exact - (∀ (g : BandPackingSymmetry), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), ∀ x ∈ - h.domain, x ∈ k.domain → h.value x = k.value x → - (BandPackingSymmetryPartialOdometerAction g h).value (BandPackingSymmetryVectorAction - g x) = (BandPackingSymmetryPartialOdometerAction g k).value - (BandPackingSymmetryVectorAction g x)) → ((∀ (g : BandPackingSymmetry), ∀ (U : - ProtoTile), ∀ (V : ProtoTile), ∀ (x : ℝ × ℝ), ∀ (y : ℝ × ℝ), ∀ (v : GaussianInt), ∀ - (a : GaussianInt), ∀ (k : ℝ), TileCentroid V - TileCentroid U = k • GaussianRealPoint - v → x - y = k • GaussianRealPoint a → TileCentroid (BandPackingSymmetryTileAction g - V) - TileCentroid (BandPackingSymmetryTileAction g U) = k • GaussianRealPoint - (BandPackingSymmetryAffineVectorAction g (v, a)).1 ∧ BandPackingSymmetrySlopeAction g - V x - BandPackingSymmetrySlopeAction g U y = k • GaussianRealPoint - (BandPackingSymmetryAffineVectorAction g (v, a)).2) → ( - ( - let affineQuarter := fun (z : GaussianInt × GaussianInt) => (GaussianQuarterTurn z.1, - -GaussianQuarterTurn z.2); ∀ (k : BandPackingSymmetry), (∀ (y : GaussianInt × - GaussianInt), ∀ (z : GaussianInt × GaussianInt), - BandPackingSymmetryAffineVectorAction k (y + z) = - BandPackingSymmetryAffineVectorAction k y + BandPackingSymmetryAffineVectorAction k - z) ∧ (∀ (y : GaussianInt × GaussianInt), BandPackingSymmetryAffineVectorAction k (-y) - = -BandPackingSymmetryAffineVectorAction k y) ∧ ∀ (y : GaussianInt × GaussianInt), - BandPackingSymmetryAffineVectorAction k (affineQuarter y) = if - BandPackingSymmetryReversesOrientation k = true then -affineQuarter - (BandPackingSymmetryAffineVectorAction k y) else affineQuarter - (BandPackingSymmetryAffineVectorAction k y)) → ((∀ (k : BandPackingSymmetry), ∀ (z : - GaussianInt × GaussianInt), (BandPackingSymmetryAffineVectorAction k z).1 = - BandPackingSymmetryVectorAction k z.1) → ((∀ (k : BandPackingSymmetry), ∀ (C : - CircleCoordinates), (BandPackingSymmetryCircleAction k C).1 = C.1) → ((∀ (C : - CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (p : ℝ × ℝ), (0 : - ℤ) < C.1 → TileOdometer C U k → PartialOdometerSlope k = some p → Finset.Nonempty - U.cells) → (∀ (g : BandPackingSymmetry), ∀ (C : CircleCoordinates), ∀ (C' : - CircleCoordinates), ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ - (h' : PartialOdometer), TileSubodometer C C' T T' h h' → TileSubodometer - (BandPackingSymmetryCircleAction g C) (BandPackingSymmetryCircleAction g C') - (BandPackingSymmetryTileAction g T) (BandPackingSymmetryTileAction g T') - (BandPackingSymmetryPartialOdometerAction g h) - (BandPackingSymmetryPartialOdometerAction g h'))))))) ) := by + (∀ (g : BandPackingSymmetry), + ∀ (h : PartialOdometer), + ∀ (k : PartialOdometer), + ∀ x ∈ h.domain, + x ∈ k.domain → + h.value x = k.value x → + (BandPackingSymmetryPartialOdometerAction g h).value + (BandPackingSymmetryVectorAction g x) = + (BandPackingSymmetryPartialOdometerAction g k).value + (BandPackingSymmetryVectorAction g x)) → + (∀ (g : BandPackingSymmetry), + ∀ (U : ProtoTile), + ∀ (V : ProtoTile), + ∀ (x : ℝ × ℝ), + ∀ (y : ℝ × ℝ), + ∀ (v : GaussianInt), + ∀ (a : GaussianInt), + ∀ (k : ℝ), + TileCentroid V - TileCentroid U = k • GaussianRealPoint v → + x - y = k • GaussianRealPoint a → + TileCentroid (BandPackingSymmetryTileAction g V) - + TileCentroid (BandPackingSymmetryTileAction g U) = + k • + GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g (v, a)).1 ∧ + BandPackingSymmetrySlopeAction g V x - + BandPackingSymmetrySlopeAction g U y = + k • + GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g (v, a)).2) → + (let affineQuarter := fun (z : GaussianInt × GaussianInt) => + (GaussianQuarterTurn z.1, -GaussianQuarterTurn z.2); + ∀ (k : BandPackingSymmetry), + (∀ (y : GaussianInt × GaussianInt), + ∀ (z : GaussianInt × GaussianInt), + BandPackingSymmetryAffineVectorAction k (y + z) = + BandPackingSymmetryAffineVectorAction k y + + BandPackingSymmetryAffineVectorAction k z) ∧ + (∀ (y : GaussianInt × GaussianInt), + BandPackingSymmetryAffineVectorAction k (-y) = + -BandPackingSymmetryAffineVectorAction k y) ∧ + ∀ (y : GaussianInt × GaussianInt), + BandPackingSymmetryAffineVectorAction k (affineQuarter y) = + if BandPackingSymmetryReversesOrientation k = true then + -affineQuarter (BandPackingSymmetryAffineVectorAction k y) + else affineQuarter (BandPackingSymmetryAffineVectorAction k y)) → + (∀ (k : BandPackingSymmetry), + ∀ (z : GaussianInt × GaussianInt), + (BandPackingSymmetryAffineVectorAction k z).1 = + BandPackingSymmetryVectorAction k z.1) → + (∀ (k : BandPackingSymmetry), + ∀ (C : CircleCoordinates), + (BandPackingSymmetryCircleAction k C).1 = C.1) → + (∀ (C : CircleCoordinates), + ∀ (U : ProtoTile), + ∀ (k : PartialOdometer), + ∀ (p : ℝ × ℝ), + TileOdometer C U k → + PartialOdometerSlope k = some p → Finset.Nonempty U.cells) → + ∀ (g : BandPackingSymmetry), + ∀ (C : CircleCoordinates), + ∀ (C' : CircleCoordinates), + ∀ (T : ProtoTile), + ∀ (T' : ProtoTile), + ∀ (h : PartialOdometer), + ∀ (h' : PartialOdometer), + TileSubodometer C C' T T' h h' → + TileSubodometer (BandPackingSymmetryCircleAction g C) + (BandPackingSymmetryCircleAction g C') + (BandPackingSymmetryTileAction g T) + (BandPackingSymmetryTileAction g T') + (BandPackingSymmetryPartialOdometerAction g h) + (BandPackingSymmetryPartialOdometerAction g h') + ) := by classical intro partialValueCov differenceTransport affineFacts affineFirst circleCurvature positiveSupport g C C' T T' h h' hsub @@ -1540,15 +1551,15 @@ private theorem forwardSub : let deltaReal : ℝ := if delta then -1 else 1 let k : ℝ := eReal / 2 have hcentM := MarkedCovarianceGeometry.hcentM T T' q i e hcent + have hWphase := MarkedCovarianceGeometry.hWphase g q i delta hphase + have hAphase := MarkedCovarianceGeometry.hAphase g q i delta hcyc refine ⟨q', sigma i, hq', hq0, hqi, e', ?_, ?_⟩ · have htr := differenceTransport g T T' (0, 0) (0, 0) M.1 0 k hcentM (by ext <;> norm_num [GaussianRealPoint]) - have hWphase := MarkedCovarianceGeometry.hWphase g q i delta hphase have haffFst := affineFirst g Z have hpat : M = Z + -affineQuarter Z := by ext <;> simp [M, Z, affineQuarter, GaussianQuarterTurn]; ring have hactM := MarkedCovarianceGeometry.hactM affineFacts g q i hpat - have hAphase := MarkedCovarianceGeometry.hAphase g q i delta hcyc have hMphase := MarkedCovarianceGeometry.hMphase g q i delta hWphase haffFst hactM hAphase have hmFst := congrArg Prod.fst hMphase @@ -1566,26 +1577,23 @@ private theorem forwardSub : · have heq := congrArg Prod.fst hqC' exact False.elim (hzero (by simpa [heq] using hz)) have hposC := MarkedCovarianceGeometry.hposC C q hq hqC - have hTne := positiveSupport C T h p hposC hO hsp + have hTne := positiveSupport C T h p hO hsp have heq := congrArg Prod.fst hqC' - have hT'ne := positiveSupport C' T' h' p' - (by simpa [heq] using hpos) hO' hsp' + have hT'ne := positiveSupport C' T' h' p' hO' hsp' have hsr := MarkedCovarianceGeometry.hsr g T h hST p hsp hTne have hsr' := MarkedCovarianceGeometry.hsr' g T' h' hST' p' hsp' hT'ne - have hsourceSlope := MarkedCovarianceGeometry.hsourceSlope T T' q i e hcent delta + have hsourceSlope := MarkedCovarianceGeometry.hsourceSlope T T' q i e hcent hcentM p p' hRe hIm have htrSlope := differenceTransport g T T' p' p M.1 M.2 k hcentM hsourceSlope let r := BandPackingSymmetrySlopeAction g T p let r' := BandPackingSymmetrySlopeAction g T' p' have hdiff := MarkedCovarianceGeometry.hdiff g T T' q i e p p' htrSlope - have hWphase2 := MarkedCovarianceGeometry.hWphase2 g q i delta hphase - have hAphase2 := MarkedCovarianceGeometry.hAphase2 g q i delta hcyc have hpat2 : M = Z + -affineQuarter Z := by ext <;> simp [M, Z, affineQuarter, GaussianQuarterTurn]; ring have hactM2 := MarkedCovarianceGeometry.hactM2 affineFacts g q i hpat2 - have hMphase2 := MarkedCovarianceGeometry.hMphase2 affineFirst g q i delta hWphase2 - hAphase2 hactM2 + have hMphase2 := MarkedCovarianceGeometry.hMphase2 affineFirst g q i delta hWphase + hAphase hactM2 have hpointSign := MarkedCovarianceGeometry.hpointSignAt762 g q i delta hMphase2 have hdiff' := MarkedCovarianceGeometry.hdiff' g T T' q i e delta p p' hdiff hpointSign refine ⟨r, r', hsr, hsr', ?_, ?_⟩ @@ -1712,7 +1720,7 @@ theorem BandPackingSymmetryMarkedDataCovariance : have qmul (z : GaussianInt) := MarkedCovarianceGeometry.qmul z have hflipA := MarkedCovarianceGeometry.hflipA q i hflip qmul have hflipB := MarkedCovarianceGeometry.hflipB g q i hflip' qmul - have hphase := MarkedCovarianceGeometry.hphase g q i s delta hdelta T + have hphase := MarkedCovarianceGeometry.hphase g q i delta hdelta have linNeg := MarkedCovarianceGeometry.linNeg allNeg g have linQuarter := MarkedCovarianceGeometry.linQuarter allQuarter g have hdisp := MarkedCovarianceGeometry.hdisp g s delta finiteCompanion q i hflipA hflipB diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean index 85347db21a..1cde65bd38 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean @@ -1010,31 +1010,46 @@ private theorem hsub' : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs : - Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), - TileOdometer (q i.succ) (S i s) (hs i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (a - : BandPackingSymmetry), TileOdometer (BandPackingSymmetryCircleAction a (q i.succ)) - (BandPackingSymmetryTileAction a (S i s)) (BandPackingSymmetryPartialOdometerAction a - (hs i s))) → (∀ (a : BandPackingSymmetry), - let Q := BandPackingSymmetryQuadrupleAction - let A := BandPackingSymmetryCircleAction - let P := BandPackingSymmetryPartialOdometerAction - let q' := Q a q - let sigma : Fin 3 → Fin 3 := fun i => - if BandPackingSymmetryReversesOrientation a then -i else i - ∀ (delta : Bool), ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (S' : Fin (3 : ℕ) → - Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin - (3 : ℕ) × Bool) (i, s) = ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation a = true then -i else i) i, s ^^ delta)) → ((∀ - (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) - (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).2 = - BandPackingSymmetryTileAction a (S i s)) → ((∀ (i : Fin 3), q' (sigma i).succ = A a - (q i.succ)) → ( - let hs' : Fin 3 → Bool → PartialOdometer := fun j s => - P a (hs (e.symm (j, s)).1 (e.symm (j, s)).2) - ∀ j, ∀ s, TileOdometer (q' j.succ) (S' j s) (hs' j s)))))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + ∀ (a : BandPackingSymmetry), + TileOdometer (BandPackingSymmetryCircleAction a (q i.succ)) + (BandPackingSymmetryTileAction a (S i s)) + (BandPackingSymmetryPartialOdometerAction a (hs i s))) → + ∀ (a : BandPackingSymmetry), + let Q := BandPackingSymmetryQuadrupleAction + let A := BandPackingSymmetryCircleAction + let P := BandPackingSymmetryPartialOdometerAction + let q' := Q a q + let sigma : Fin 3 → Fin 3 := fun i => + if BandPackingSymmetryReversesOrientation a then -i else i + ∀ (delta : Bool), + ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), + ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) = + ((fun (i : Fin (3 : ℕ)) => + if BandPackingSymmetryReversesOrientation a = true then -i + else i) + i, + s ^^ delta)) → + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + S' + ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 + ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).2 = + BandPackingSymmetryTileAction a (S i s)) → + (∀ (i : Fin 3), q' (sigma i).succ = A a (q i.succ)) → + let hs' : Fin 3 → Bool → PartialOdometer := fun j s => + P a (hs (e.symm (j, s)).1 (e.symm (j, s)).2) + ∀ j, ∀ s, TileOdometer (q' j.succ) (S' j s) (hs' j s) + ) := by classical - intro q S hs hsub ih a Q A P q' sigma delta e S' he hS hparent hs' j s + intro q S hs ih a Q A P q' sigma delta e S' he hS hparent hs' j s let B := BandPackingSymmetryTileAction let p := e.symm (j, s) have hep : e p = (j, s) := e.apply_symm_apply (j, s) @@ -1201,12 +1216,16 @@ private theorem hchildCurvPos : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → ((BandPackingSymmetry) - → (∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), - let p := e.symm (i, s) - (¬(q p.1.succ).1 = (0 : ℤ)) → (0 < (q p.1.succ).1))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q → + ∀ (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool), + ∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + let p := e.symm (i, s) + ¬(q p.1.succ).1 = (0 : ℤ) → 0 < (q p.1.succ).1 + ) := by classical - intro q hq a e i s p hz + intro q hq e i s p hz have hn := (ProperBandCurvatureStructure q hq).2.1 p.1 omega @@ -1927,7 +1946,7 @@ theorem BandPackingSymmetryTileOdometerCovariance have hT' := TileOdometerSymmetryProof.hT' U q hT a cov let hs' : Fin 3 → Bool → PartialOdometer := fun j s => P a (hs (e.symm (j, s)).1 (e.symm (j, s)).2) - have hsub' := TileOdometerSymmetryProof.hsub' q S hs hsub ih a delta e S' he hS hparent + have hsub' := TileOdometerSymmetryProof.hsub' q S hs ih a delta e S' he hS hparent have hdom' := TileOdometerSymmetryProof.hdom' h hs hdom a e have hvalue' := TileOdometerSymmetryProof.hvalue' h actionDiff hs hdom hvalue a e have hcompat' := TileOdometerSymmetryProof.hcompat' hs hcompat a e @@ -1960,7 +1979,7 @@ theorem BandPackingSymmetryTileOdometerCovariance by_cases hz : (q p.1.succ).1 = 0 · left rw [hcurv, hz] - · have hchildCurvPos := TileOdometerSymmetryProof.hchildCurvPos q hq a e i s hz + · have hchildCurvPos := TileOdometerSymmetryProof.hchildCurvPos q hq e i s hz have hchildNe : (S p.1 p.2).cells.Nonempty := positiveCells (q p.1.succ) (S p.1 p.2) hchildCurvPos hprotoChild have hchildDom := PositiveCurvatureTileOdometerDomain (q p.1.succ) diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean index 0717c71ae5..8f9140e9b5 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean @@ -1767,47 +1767,61 @@ private theorem hrootCent : (by classical exact - (ℕ) → ((BandCircle) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g - : BandPackingSymmetry), - let q' : Fin 4 → CircleCoordinates := - BandPackingSymmetryQuadrupleAction g - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - ∀ (T1 : ProtoTile), (T1.cells.Nonempty) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), - let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) - let U : Fin 3 → Bool → ProtoTile := fun i s => - if i = 0 then - if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 - else if i = 1 then - if s then TileTranslation (S 1 s) a - else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) - else if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) - else TileTranslation (S 2 s) a - (∀ i, ∀ s, BandPrototile (q' i.succ) (U i s)) → ( - let T0 : ProtoTile := - ⟨Finset.univ.biUnion (fun i : Fin 3 => - Finset.univ.biUnion (fun s : Bool => (U i s).cells)), T1.anchor⟩ - (∀ (x : GaussianInt), x ∈ T0.cells ↔ ∃ i s, x ∈ (U i s).cells) → ( - let d : GaussianInt → Real × Real := fun z => - (1 / 2 : Real) • (GaussianRealPoint z - - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) - let p0 : Real × Real := TileCentroid T1 + d a - (∀ i, ∀ s, TileCentroid (U i s) - p0 = (if s = true then (1 : Real) else -1) • d - (BandVectors.1 (q' ((i + 2).succ)) (q' ((i + 1).succ)))) → ( - let c1 := TileCentroid T1 - let reCells : Finset Int := T1.cells.image (fun x => x.re) - let imCells : Finset Int := T1.cells.image (fun x => x.im) - ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), - let mRe := reCells.min' reNe - let MRe := reCells.max' reNe - (∃ x ∈ T1.cells, x.re = mRe) → ((∃ x ∈ T1.cells, x.re = MRe) → ( - let mIm := imCells.min' imNe - let MIm := imCells.max' imNe - (∃ x ∈ T1.cells, x.im = mIm) → ((∃ x ∈ T1.cells, x.im = MIm) → ( - let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ - (GaussianRealPoint t1 = (2 * c1.1, 2 * c1.2)) → (TileCentroid T0 = p0))))))))))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (r : Fin (3 : ℕ)), + ∀ (g : BandPackingSymmetry), + let q' : Fin 4 → CircleCoordinates := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + ∀ (T1 : ProtoTile), + T1.cells.Nonempty → + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let a : GaussianInt := BandVectors.1 (q' 3) (q' 2) + let U : Fin 3 → Bool → ProtoTile := fun i s => + if i = 0 then if s then TileTranslation T1 (a - ⟨0, 1⟩ * a) else T1 + else + if i = 1 then + if s then TileTranslation (S 1 s) a + else TileTranslation (S 1 s) (-⟨0, 1⟩ * a) + else + if s then TileTranslation (S 2 s) (-⟨0, 1⟩ * a) + else TileTranslation (S 2 s) a + (∀ i, ∀ s, BandPrototile (q' i.succ) (U i s)) → + let T0 : ProtoTile := + ⟨Finset.univ.biUnion fun i : Fin 3 => + Finset.univ.biUnion fun s : Bool => (U i s).cells, + T1.anchor⟩ + (∀ (x : GaussianInt), x ∈ T0.cells ↔ ∃ i s, x ∈ (U i s).cells) → + let d : GaussianInt → Real × Real := fun z => + (1 / 2 : Real) • + (GaussianRealPoint z - + (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) + let p0 : Real × Real := TileCentroid T1 + d a + (∀ i, + ∀ s, + TileCentroid (U i s) - p0 = + (if s = true then (1 : Real) else -1) • + d (BandVectors.1 (q' (i + 2).succ) (q' (i + 1).succ))) → + let c1 := TileCentroid T1 + let reCells : Finset Int := T1.cells.image fun x => x.re + let imCells : Finset Int := T1.cells.image fun x => x.im + ∀ (reNe : reCells.Nonempty), + ∀ (imNe : imCells.Nonempty), + let mRe := reCells.min' reNe + let MRe := reCells.max' reNe + (∃ x ∈ T1.cells, x.re = mRe) → + (∃ x ∈ T1.cells, x.re = MRe) → + let mIm := imCells.min' imNe + let MIm := imCells.max' imNe + (∃ x ∈ T1.cells, x.im = mIm) → + (∃ x ∈ T1.cells, x.im = MIm) → + let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + GaussianRealPoint t1 = (2 * c1.1, 2 * c1.2) → + TileCentroid T0 = p0 + ) := by classical - intro n C q r g q' T1 hT1ne S a U hparents T0 hcells0 d p0 hcent' c1 reCells imCells reNe imNe - mRe MRe minReCell maxReCell mIm MIm minImCell maxImCell t1 ht1 + intro q r g q' T1 hT1ne S a U hparents T0 hcells0 d p0 hcent' c1 reCells imCells reNe imNe mRe + MRe minReCell maxReCell mIm MIm minImCell maxImCell t1 ht1 let I : GaussianInt := ⟨0, 1⟩ let t0 : GaussianInt := t1 + a - I * a have ht0 : GaussianRealPoint t0 = (2 : Real) • p0 := PrototileConstruction.ht0 @@ -2088,7 +2102,7 @@ private theorem existence : let t1 : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ have ht1 : GaussianRealPoint t1 = (2 * c1.1, 2 * c1.2) := PrototileConstruction.ht1 T1 reNe imNe centerRe centerIm - have hrootCent : TileCentroid T0 = p0 := PrototileAssembly.hrootCent n C q r g T1 + have hrootCent : TileCentroid T0 = p0 := PrototileAssembly.hrootCent q r g T1 hT1ne S hparents hcells0 hcent' reNe imNe minReCell maxReCell minImCell maxImCell ht1 have hcent : ∀ i s, diff --git a/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean b/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean index 4ee91fe5da..a88d2d498b 100644 --- a/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean +++ b/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean @@ -86,21 +86,29 @@ private theorem curvatureBound : · simpa using ih 3 private theorem buildConfiguration : - (∀ r : Fin 4 → CircleCoordinates, SemiProperQuadruple r → ∀ i : Fin 4, (r i).1 ≠ 0 → (r i).1 - = 1 ∨ 4 ≤ (r i).1) → (∀ (u : Fin 4 → CircleCoordinates), ∀ (p : Fin 4 → - CircleCoordinates), ∀ (t : Fin 4 → CircleCoordinates), ProperBandQuadruple u → - (∀ i : Fin 4, (u i).1 ≠ 0) → - (∀ i j : Fin 4, (u i).1 = 1 → (u j).1 = 1 → i = j) → - ProperBandQuadruple p → - u = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, - 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3] → - p 0 = u 1 → p 2 = u 2 → p 3 = u 3 → - (u 2).1 < (u 1).1 → (u 3).1 < (u 1).1 → - ProperBandQuadruple t → t 0 = u 2 → t 1 = u 3 → - (u 3).1 < (u 2).1 → - Nonempty (BandOrderedGeneralConfiguration u)) := by + (∀ r : Fin 4 → CircleCoordinates, + SemiProperQuadruple r → ∀ i : Fin 4, (r i).1 ≠ 0 → (r i).1 = 1 ∨ 4 ≤ (r i).1) → + ∀ (u : Fin 4 → CircleCoordinates), + ∀ (p : Fin 4 → CircleCoordinates), + ∀ (t : Fin 4 → CircleCoordinates), + ProperBandQuadruple u → + (∀ i : Fin 4, (u i).1 ≠ 0) → + (∀ i j : Fin 4, (u i).1 = 1 → (u j).1 = 1 → i = j) → + ProperBandQuadruple p → + u = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), + p 0, p 2, p 3] → + p 0 = u 1 → + p 2 = u 2 → + p 3 = u 3 → + (u 2).1 < (u 1).1 → + ProperBandQuadruple t → + t 0 = u 2 → + t 1 = u 3 → + (u 3).1 < (u 2).1 → Nonempty (BandOrderedGeneralConfiguration u) := by classical - intro positiveLarge u p t hu hnl haum hp hs h0 h2 h3 hlt2 hlt3 ht ht0 ht1 horder + intro positiveLarge u p t hu hnl haum hp hs h0 h2 h3 hlt2 ht ht0 ht1 horder have cu := ProperBandCurvatureStructure u hu have cp := ProperBandCurvatureStructure p hp have hp1nonneg : 0 ≤ (p 1).1 := by simpa using cp.2.1 0 @@ -448,12 +456,14 @@ private theorem horder23 : simpa [h2, h3] using hle private theorem hsoddy : - ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (Fin (4 : ℕ) → - CircleCoordinates) → ((p 1 = (2 * (q 1).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 0).1, 2 * (q - 1).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 0).2)) → (2 * (q 1).1 + 2 * (q 2).1 + 2 * (q 3).1 = - (q 0).1 + (p 1).1)) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + p 1 = + (2 * (q 1).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 0).1, + 2 * (q 1).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 0).2) → + 2 * (q 1).1 + 2 * (q 2).1 + 2 * (q 3).1 = (q 0).1 + (p 1).1 := by classical - intro q p t htwin + intro q p htwin have hf := congrArg Prod.fst htwin omega @@ -600,13 +610,6 @@ private theorem hord'At586 : BandPackingSymmetryReversesOrientation, BandPackingSymmetryCircleAction, negOneSucc, negTwoSucc, h2, h3] using hlt -private theorem tupleEq : - ∀ (q : Fin 4 → CircleCoordinates), ![q 0, q 1, q 2, q 3] = q := by - classical - intro q - funext i - fin_cases i <;> rfl - private theorem huAt613 : ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → ( let u : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] @@ -1072,7 +1075,7 @@ private theorem firstParentCase : have hsecondsmall := RetainedBoundaryDetails.hsecondsmall q hq p h2 t hb0 have horder23 := RetainedBoundaryDetails.horder23 q p h2 h3 hlt - have hsoddy := RetainedBoundaryDetails.hsoddy q p t htwin + have hsoddy := RetainedBoundaryDetails.hsoddy q p htwin have config := RetainedBoundaryProof.config q hq hnoLine hatMostOneUnit p hfirst hp h0 h2 h3 t ht hb0 hb1 cq cp hq0large hq2large htwin hfirstsmall hsecondsmall horder23 hsoddy @@ -1119,7 +1122,7 @@ private theorem firstParentCase : negOneSucc negTwoSucc have hord' := RetainedBoundaryDetails.hord'At586 q p h2 h3 hlt negOneSucc negTwoSucc - have tupleEq := RetainedBoundaryDetails.tupleEq q + have tupleEq := RetainedBoundaryDetails.htuple q refine ⟨.conjugate, ?_⟩ simpa [u, tupleEq] using buildConfiguration u pp tt hu hnl' haum' hp' hs' h0' h2' h3' hlt2' hlt3' ht' ht0' ht1' hord' @@ -1328,8 +1331,18 @@ theorem BandRetainedBoundaryGenealogy -- BODY have curvatureBound := RetainedBoundaryProof.curvatureBound have positiveLarge := RetainedBoundaryDetails.positiveLarge curvatureBound - have buildConfiguration := RetainedBoundaryProof.buildConfiguration - positiveLarge + have buildConfiguration := (show + ∀ (u : Fin 4 → CircleCoordinates), ∀ (p : Fin 4 → CircleCoordinates), ∀ (t : Fin 4 → + CircleCoordinates), ProperBandQuadruple u → (∀ i : Fin 4, (u i).1 ≠ 0) → (∀ i j : + Fin 4, (u i).1 = 1 → (u j).1 = 1 → i = j) → ProperBandQuadruple p → u = ![(2 * (p + 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 + - (p 1).2), p 0, p 2, p 3] → p 0 = u 1 → p 2 = u 2 → p 3 = u 3 → (u 2).1 < (u 1).1 → + (u 3).1 < (u 1).1 → ProperBandQuadruple t → t 0 = u 2 → t 1 = u 3 → (u 3).1 < (u + 2).1 → Nonempty (BandOrderedGeneralConfiguration u) + from by + intro u p t hu hnl haum hp hs h0 h2 h3 hlt2 hlt3 ht ht0 ht1 horder + exact RetainedBoundaryProof.buildConfiguration positiveLarge u p t hu hnl haum hp hs h0 h2 + h3 hlt2 ht ht0 ht1 horder) rcases BandParentBoundaryGenealogy q hq with roots | first | second | third · rcases roots with roots | roots | roots · exact (hnoLine 2 roots.2.1).elim diff --git a/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean index 93946baef0..4cb159e576 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean @@ -76,12 +76,14 @@ private theorem hnonempty : (by classical exact - ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), - (PeriodicTileComplex ↥(TilingLattice C)) → ((0 < (q 0).1) → ((TileArea T = (q (0 : - Fin (4 : ℕ))).1.toNat) → (∀ (x : GaussianInt), (TileTranslation T - x).cells.Nonempty))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (T : ProtoTile), + 0 < (q 0).1 → + TileArea T = (q (0 : Fin (4 : ℕ))).1.toNat → + ∀ (x : GaussianInt), (TileTranslation T x).cells.Nonempty + ) := by classical - intro C q T P hpositive harea x + intro q T hpositive harea x rw [Finset.nonempty_iff_ne_empty] intro he have hz : TileArea T = 0 := by @@ -632,7 +634,7 @@ theorem BandTileTopologyApplication (C : BandCircle) have hpositive : 0 < (q 0).1 := (ProperBandCurvatureStructure q hq).1 have harea := (BandTileSimultaneousInduction q hq T hT).2.1 have hnonempty (x : GaussianInt) : - (TileTranslation T x).cells.Nonempty := TileTopologyGeometry.hnonempty C q T P hpositive + (TileTranslation T x).cells.Nonempty := TileTopologyGeometry.hnonempty q T hpositive harea x have border_touch (U : ProtoTile) (hU : U ∈ RegularTileFamily T (TilingLattice C)) (hneq : U ≠ T) : TileTouching T U → TileBordering T U := diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean b/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean index c6b8cbccae..cff4902e3c 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryStringOdometerRespect.lean @@ -227,15 +227,19 @@ private theorem unitPair : (by classical exact - (ℕ) → (∀ (C : BandCircle), ∀ (ε : Bool), ∀ (B : ProtoTile), ∀ (R : ProtoTile), ∀ (S : - ProtoTile), ∀ (g : PartialOdometer), ∀ (h : PartialOdometer), (P4458T1BoundaryFrame - C ε B R S g h) → (∀ (u : Fin 4 → CircleCoordinates), (ProperBandQuadruple u) → (((u - 2).1 = 1) → (((u 3).1 = 1) → ((PrimitiveVectorOrientation (u 2) (u 3) ∧ - UnitOccurrenceOrientation u 1 false ∧ UnitOccurrenceOrientation u 2 true) ∨ - (PrimitiveVectorOrientation (u 3) (u 2) ∧ UnitOccurrenceOrientation u 1 true ∧ - UnitOccurrenceOrientation u 2 false)))))) ) := by + ∀ (u : Fin 4 → CircleCoordinates), + ProperBandQuadruple u → + (u 2).1 = 1 → + (u 3).1 = 1 → + PrimitiveVectorOrientation (u 2) (u 3) ∧ + UnitOccurrenceOrientation u 1 false ∧ + UnitOccurrenceOrientation u 2 true ∨ + PrimitiveVectorOrientation (u 3) (u 2) ∧ + UnitOccurrenceOrientation u 1 true ∧ + UnitOccurrenceOrientation u 2 false + ) := by classical - intro n C ε B R S g h F u hu hu2 hu3 + intro u hu hu2 hu3 obtain ⟨_, _, _, _, inv, cases⟩ := BandOrientedBoundaryOccurrenceGenealogy u hu rcases cases with small | second | third · rcases small.2 with forward | backward @@ -582,8 +586,7 @@ theorem BoundaryStringOdometerRespect : have placement := BoundaryOdometerGeometry.placement C ε B R S g h F T H hsub hfoot hcent hdom hvalue hslope ancestors (BoundaryOdometerGeometry.successorCase C ε B R S g h F T H hsub hfoot hcent hdom hvalue hslope ancestors (BoundaryOdometerGeometry.rotateProper) - (BoundaryOdometerGeometry.asymmetric) (BoundaryOdometerGeometry.unitPair n C ε B R S g - h F)) + (BoundaryOdometerGeometry.asymmetric) (BoundaryOdometerGeometry.unitPair)) obtain ⟨P⟩ := placement have realize {U V : ProtoTile} {k l : PartialOdometer} (side : P4458T1BoundarySide F U V k l) := BoundaryOdometerGeometry.realize n ih C ε B diff --git a/LeanPool/ApollonianSuperharmonic/DiamondLaplacianTable.lean b/LeanPool/ApollonianSuperharmonic/DiamondLaplacianTable.lean index a467c1740e..b36e9b5b8a 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondLaplacianTable.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondLaplacianTable.lean @@ -26,15 +26,21 @@ namespace ApollonianSuperharmonic namespace DiamondLaplacianProof private theorem habAt289 : - ∀ (F : ℤ → ℤ → ℤ), ∀ (p : ℤ), ∀ (q : ℤ), ((4 : ℤ) * F (p - (1 : ℤ)) q = (2 : ℤ) * (p - (1 : - ℤ)) ^ (2 : ℕ) - (2 : ℤ) * |p - (1 : ℤ)| - (p - (1 : ℤ) - q) ^ (2 : ℕ) + (p - (1 : ℤ) - q) - % (2 : ℤ)) → (((4 : ℤ) * F p (q + (1 : ℤ)) = (2 : ℤ) * p ^ (2 : ℕ) - (2 : ℤ) * |p| - (p - - (q + (1 : ℤ))) ^ (2 : ℕ) + (p - (q + (1 : ℤ))) % (2 : ℤ)) → (((4 : ℤ) * F p (q - (1 : ℤ)) - = (2 : ℤ) * p ^ (2 : ℕ) - (2 : ℤ) * |p| - (p - (q - (1 : ℤ))) ^ (2 : ℕ) + (p - (q - (1 : - ℤ))) % (2 : ℤ)) → (((4 : ℤ) * F p q = (2 : ℤ) * p ^ (2 : ℕ) - (2 : ℤ) * |p| - (p - q) ^ - (2 : ℕ) + (p - q) % (2 : ℤ)) → (|p+1| + |p-1| - 2*|p| = (if p=0 then 2 else 0))))) := by + ∀ (F : ℤ → ℤ → ℤ), + ∀ (p : ℤ), + ∀ (q : ℤ), + (4 : ℤ) * F p (q + (1 : ℤ)) = + (2 : ℤ) * p ^ (2 : ℕ) - (2 : ℤ) * |p| - (p - (q + (1 : ℤ))) ^ (2 : ℕ) + + (p - (q + (1 : ℤ))) % (2 : ℤ) → + (4 : ℤ) * F p (q - (1 : ℤ)) = + (2 : ℤ) * p ^ (2 : ℕ) - (2 : ℤ) * |p| - (p - (q - (1 : ℤ))) ^ (2 : ℕ) + + (p - (q - (1 : ℤ))) % (2 : ℤ) → + (4 : ℤ) * F p q = + (2 : ℤ) * p ^ (2 : ℕ) - (2 : ℤ) * |p| - (p - q) ^ (2 : ℕ) + + (p - q) % (2 : ℤ) → + |p + 1| + |p - 1| - 2 * |p| = if p = 0 then 2 else 0 := by classical - intro F p q h2 h3 h4 h0 + intro F p q h3 h4 h0 split_ifs with hp · simp [hp] · rcases lt_or_gt_of_ne hp with hp | hp @@ -351,7 +357,7 @@ where have hm : (p+1-q)%2 + (p-1-q)%2 + (p-(q+1))%2 + (p-(q-1))%2 = 4 - 4*((p-q)%2) := by omega have hab : |p+1| + |p-1| - 2*|p| = (if p=0 then 2 else 0) := DiamondLaplacianProof.habAt289 F - p q h2 h3 h4 h0 + p q h3 h4 h0 split_ifs at hab ⊢ all_goals apply mul_left_cancel₀ (by norm_num : (4 : Int) ≠ 0) diff --git a/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean index 63b322e8cd..850235644d 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean @@ -63,10 +63,12 @@ private theorem hk2 : (by classical exact - ∀ (K : DiamondParameter), (BandCircle) → (((1 : ℤ) < (DiamondRecursiveQuadruple K - (Fin.succ (2 : Fin (3 : ℕ)))).1) → ((0 < K.1) → (2 ≤ K.1))) ) := by + ∀ (K : DiamondParameter), + (1 : ℤ) < (DiamondRecursiveQuadruple K (Fin.succ (2 : Fin (3 : ℕ)))).1 → + 0 < K.1 → 2 ≤ K.1 + ) := by classical - intro K Ci hcurv hKpos + intro K hcurv hKpos by_contra hnot have hone : K.1 = 1 := by omega simp [DiamondRecursiveQuadruple, hone] at hcurv @@ -88,10 +90,11 @@ private theorem hrootCell : (by classical exact - ∀ (K : DiamondParameter), (BandCircle) → ((BandCircle) → ((0 < K.1) → ((2 ≤ K.1) → ((⟨0, - 0⟩ : GaussianInt) ∈ DiamondCellDomain K.1)))) ) := by + ∀ (K : DiamondParameter), + 0 < K.1 → 2 ≤ K.1 → (⟨0, 0⟩ : GaussianInt) ∈ DiamondCellDomain K.1 + ) := by classical - intro K C0 Ci hKpos hk2 + intro K hKpos hk2 simp only [DiamondCellDomain, Finset.mem_biUnion] refine ⟨0, by simp [hKpos], ?_⟩ have hr : Nat.min (0 + 1) (2 * K.1 - 0) = 1 := by @@ -257,13 +260,17 @@ private theorem overlap : (by classical exact - ∀ (K : DiamondParameter), (BandCircle) → ((BandCircle) → (∀ (x : GaussianInt), (2 ≤ K.1) - → (∀ (u : GaussianInt), - let z := x - u - (z ∈ DiamondVertexDomains K false) → ((z + ⟨0, 2 * (K.1 : Int)⟩ ∈ DiamondVertexDomains K - false) → (z.im = 0 ∧ Int.natAbs z.re ≤ 1))))) ) := by - classical - intro K C0 Ci x hk2 u z hzUpper hzLower + ∀ (K : DiamondParameter), + ∀ (x : GaussianInt), + 2 ≤ K.1 → + ∀ (u : GaussianInt), + let z := x - u + z ∈ DiamondVertexDomains K false → + z + ⟨0, 2 * (K.1 : Int)⟩ ∈ DiamondVertexDomains K false → + z.im = 0 ∧ Int.natAbs z.re ≤ 1 + ) := by + classical + intro K x hk2 u z hzUpper hzLower change max (Int.natAbs z.re) (max (Int.natAbs (z.im - (K.1 : Int))) (Int.natAbs z.re + Int.natAbs (z.im - (K.1 : Int)) - 1)) ≤ K.1 at hzUpper @@ -342,15 +349,21 @@ private theorem hzzero : (by classical exact - ∀ (K : DiamondParameter), (BandCircle) → ((BandCircle) → (∀ (x : GaussianInt), (2 ≤ K.1) - → (∀ (u : GaussianInt), - let z := x - u - (z.im = 0 ∧ Int.natAbs z.re ≤ 1) → ((z - 1 ∈ DiamondVertexDomains K false ∨ z - 1 + ⟨0, 2 - * (K.1 : Int)⟩ ∈ DiamondVertexDomains K false) → ((z + 1 ∈ DiamondVertexDomains K - false ∨ z + 1 + ⟨0, 2 * (K.1 : Int)⟩ ∈ DiamondVertexDomains K false) → (z = 0)))))) ) + ∀ (K : DiamondParameter), + ∀ (x : GaussianInt), + 2 ≤ K.1 → + ∀ (u : GaussianInt), + let z := x - u + z.im = 0 ∧ Int.natAbs z.re ≤ 1 → + z - 1 ∈ DiamondVertexDomains K false ∨ + z - 1 + ⟨0, 2 * (K.1 : Int)⟩ ∈ DiamondVertexDomains K false → + z + 1 ∈ DiamondVertexDomains K false ∨ + z + 1 + ⟨0, 2 * (K.1 : Int)⟩ ∈ DiamondVertexDomains K false → + z = 0 + ) := by classical - intro K C0 Ci x hk2 u z overlap hwest heast + intro K x hk2 u z overlap hwest heast obtain ⟨hy, hx⟩ := overlap let bound (w : GaussianInt) : Prop := max (Int.natAbs w.re) (max (Int.natAbs (w.im - (K.1 : Int))) @@ -625,12 +638,13 @@ private theorem hmcast : (by classical exact - ∀ (K : DiamondParameter), (BandCircle) → ((BandCircle) → ((GaussianInt) → ((2 ≤ K.1) → - ((GaussianInt) → ( - let m := K.1 - 1 - (m : Int) = (K.1 : Int) - 1))))) ) := by + ∀ (K : DiamondParameter), + 2 ≤ K.1 → + let m := K.1 - 1 + (m : Int) = (K.1 : Int) - 1 + ) := by classical - intro K C0 Ci x hk2 u m + intro K hk2 m dsimp [m] have hk : 1 ≤ K.1 := by omega simp [hk] @@ -639,11 +653,12 @@ private theorem hcell0 : (by classical exact - ∀ (K : DiamondParameter), (BandCircle) → ((BandCircle) → ((GaussianInt) → ((GaussianInt) → ( - let m := K.1 - 1 - (0 < m) → ((0 : GaussianInt) ∈ DiamondCellDomain m))))) ) := by + ∀ (K : DiamondParameter), + let m := K.1 - 1 + 0 < m → (0 : GaussianInt) ∈ DiamondCellDomain m + ) := by classical - intro K C0 Ci x u m hmpos + intro K m hmpos simp only [DiamondCellDomain, Finset.mem_biUnion] refine ⟨0, by simp [hmpos], ?_⟩ have hr : Nat.min (0 + 1) (2 * m - 0) = 1 := by @@ -657,11 +672,12 @@ private theorem hrow : (by classical exact - ∀ (K : DiamondParameter), (BandCircle) → ((BandCircle) → ((GaussianInt) → ((GaussianInt) → ( - let m := K.1 - 1 - (0 < m) → (((2 * m - 1 : Nat) : Int) = 2 * (m : Int) - 1))))) ) := by + ∀ (K : DiamondParameter), + let m := K.1 - 1 + 0 < m → ((2 * m - 1 : Nat) : Int) = 2 * (m : Int) - 1 + ) := by classical - intro K C0 Ci x u m hmpos + intro K m hmpos rw [Nat.cast_sub (by omega : 1 ≤ 2 * m)] push_cast ring @@ -670,12 +686,14 @@ private theorem htop : (by classical exact - ∀ (K : DiamondParameter), (BandCircle) → ((BandCircle) → ((GaussianInt) → ((GaussianInt) → ( - let m := K.1 - 1 - (0 < m) → ((((2 * m - 1 : Nat) : Int) = 2 * (m : Int) - 1) → ((⟨-1, 2 * (m : Int) - 1⟩ : - GaussianInt) ∈ DiamondCellDomain m)))))) ) := by + ∀ (K : DiamondParameter), + let m := K.1 - 1 + 0 < m → + ((2 * m - 1 : Nat) : Int) = 2 * (m : Int) - 1 → + (⟨-1, 2 * (m : Int) - 1⟩ : GaussianInt) ∈ DiamondCellDomain m + ) := by classical - intro K C0 Ci x u m hmpos hrow + intro K m hmpos hrow simp only [DiamondCellDomain, Finset.mem_biUnion] refine ⟨2 * m - 1, ?_, ?_⟩ · simpa only [Finset.mem_range] using @@ -1487,7 +1505,7 @@ theorem DiamondOpposingBoundaryStarLocalization hcentroid hslope hcurv subst i have hKpos : 0 < K.1 := K.2 - have hk2 := DiamondBoundaryStarGeometry.hk2 K Ci hcurv hKpos + have hk2 := DiamondBoundaryStarGeometry.hk2 K hcurv hKpos obtain ⟨H, hH, hHdom, hHfoot, hHsquares, hHvalue, hHslope⟩ := DiamondTileOdometerRestriction K have hC0pos : 0 < C0.1.1.1 := DiamondBoundaryStarGeometry.hC0pos K hq C0 hC0 @@ -1498,7 +1516,7 @@ theorem DiamondOpposingBoundaryStarLocalization (TileOdometerTranslationUniqueness C0.1.1 T0' (DiamondTile K.1) h0' H hC0pos hO0' (by simpa [hC0] using hH)).exists have hrootNonempty : (DiamondTile K.1).cells.Nonempty := - ⟨⟨0, 0⟩, (DiamondBoundaryStarGeometry.hrootCell K C0 Ci hKpos hk2)⟩ + ⟨⟨0, 0⟩, (DiamondBoundaryStarGeometry.hrootCell K hKpos hk2)⟩ have hT0cent := DiamondBoundaryStarGeometry.hT0cent K T0 u huCell (DiamondBoundaryStarGeometry.hT0ne K T0 u huCell hrootNonempty) have hT0'cent := DiamondBoundaryStarGeometry.hT0'cent K T0' u' hu'Cell @@ -1511,13 +1529,12 @@ theorem DiamondOpposingBoundaryStarLocalization have hzUpper := DiamondBoundaryStarGeometry.hzUpper K h0 x hx0 H u huDom Hmem have hzLower := DiamondBoundaryStarGeometry.hzLower K h0' x hx0' H u u' hu'Dom hshift' Hmem - have overlap := DiamondBoundaryStarGeometry.overlap K C0 - Ci x hk2 u hzUpper hzLower + have overlap := DiamondBoundaryStarGeometry.overlap K x hk2 u hzUpper hzLower have hwest := DiamondBoundaryStarGeometry.hwest K h0 h0' x hstar H u huDom u' hu'Dom hshift' Hmem have heast := DiamondBoundaryStarGeometry.heast K h0 h0' x hstar H u huDom u' hu'Dom hshift' Hmem - have hzzero := DiamondBoundaryStarGeometry.hzzero K C0 Ci x hk2 u overlap hwest heast + have hzzero := DiamondBoundaryStarGeometry.hzzero K x hk2 u overlap hwest heast have hx_eq_u := DiamondBoundaryStarGeometry.hx_eq_u x u hzzero have hroot := DiamondBoundaryStarGeometry.hroot K hk2 obtain ⟨S, gS, hband0, hsub0, hcells0, hfoot0, hcent0, @@ -1548,12 +1565,12 @@ theorem DiamondOpposingBoundaryStarLocalization (DiamondBoundaryStarGeometry.hUcent K T0 u hT0cent S hcent0 Sc hOcc) let m := K.1 - 1 have hmpos : 0 < m := by dsimp [m]; omega - have hmcast := DiamondBoundaryStarGeometry.hmcast K C0 Ci x - hk2 u + have hmcast := DiamondBoundaryStarGeometry.hmcast K + hk2 have hcell0 := DiamondBoundaryStarGeometry.hcell0 - K C0 Ci x u hmpos - have htop := DiamondBoundaryStarGeometry.htop K C0 Ci x u hmpos - (DiamondBoundaryStarGeometry.hrow K C0 Ci x u hmpos) + K hmpos + have htop := DiamondBoundaryStarGeometry.htop K hmpos + (DiamondBoundaryStarGeometry.hrow K hmpos) have hbaseFoot := DiamondBoundaryStarGeometry.hbaseFoot K have hbase0 := hbaseFoot 0 hcell0 have hbaseTop := hbaseFoot ⟨-1, 2 * (m : Int) - 1⟩ htop diff --git a/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean b/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean index e07c169b21..9481982d69 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean @@ -473,22 +473,21 @@ private theorem cycle_edge_oriented : private theorem crossing_step_zero : ∀ (S : Finset GaussianInt), - let I : GaussianInt := ⟨0, 1⟩ - let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S - let JF : Finset GaussianInt := VF.filter fun z => - ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) - let X := {z : GaussianInt // z ∈ S} - let rel : X → X → Prop := fun a b => - b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) - let G : SimpleGraph X := SimpleGraph.fromRel rel - ∀ (u : X), (G.Walk u u) → (∀ (v : X), - let q : GaussianInt := v.1 - 1 - I - ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a.im ≤ v.1.im) → ((b.im ≤ v.1.im) → ((if b = a + - ⟨0, 1⟩ ∧ a.im = (q + I).im ∧ a.re ≤ (q + I).re then 1 - else if b = a - ⟨0, 1⟩ ∧ b.im = (q + I).im ∧ - a.re ≤ (q + I).re then -1 else 0) = 0))) := by + let I : GaussianInt := ⟨0, 1⟩; + let X := { z : GaussianInt // z ∈ S }; + ∀ (v : X), + let q : GaussianInt := v.1 - 1 - I + ∀ (a : GaussianInt), + ∀ (b : GaussianInt), + a.im ≤ v.1.im → + b.im ≤ v.1.im → + (if b = a + ⟨0, 1⟩ ∧ a.im = (q + I).im ∧ a.re ≤ (q + I).re then 1 + else + if b = a - ⟨0, 1⟩ ∧ b.im = (q + I).im ∧ a.re ≤ (q + I).re then -1 + else 0) = + 0 := by classical - intro S I VF JF X rel G u c v q a b ha hb + intro S I X v q a b ha hb split_ifs with hup hdown · have habim := congrArg Zsqrtd.im hup.1 have haeq := hup.2.1 @@ -592,22 +591,21 @@ private theorem htarget : private theorem cyclic_edge_occupied : ∀ (S : Finset GaussianInt), - let I : GaussianInt := ⟨0, 1⟩ - let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S - let JF : Finset GaussianInt := VF.filter fun z => - ¬ (z - 1 ∈ S ∧ z - 1 + I ∈ S) - let X := {z : GaussianInt // z ∈ S} - let rel : X → X → Prop := fun a b => - b.1 = a.1 + 1 ∨ (b.1 = a.1 + I ∧ a.1 ∈ JF) - let G : SimpleGraph X := SimpleGraph.fromRel rel - ∀ (u : X), ∀ (c : G.Walk u u), (X) → ( - let path : List GaussianInt := c.support.tail.map Subtype.val - (3 ≤ path.length) → ( - let cyclicEdges := path.zip path.tail ++ [(u.1, c.snd.1)] - (∀ {z : GaussianInt}, (z ∈ path) → (z ∈ S)) → (∀ {r : GaussianInt}, ∀ {s : GaussianInt}, ((r, - s) ∈ cyclicEdges) → (r ∈ S ∧ s ∈ S)))) := by + let I : GaussianInt := ⟨0, 1⟩; + let VF : Finset GaussianInt := S.filter fun z => z + I ∈ S; + let JF : Finset GaussianInt := VF.filter fun z => ¬(z - 1 ∈ S ∧ z - 1 + I ∈ S); + let X := { z : GaussianInt // z ∈ S }; + let rel : X → X → Prop := fun a b => b.1 = a.1 + 1 ∨ b.1 = a.1 + I ∧ a.1 ∈ JF; + let G : SimpleGraph X := SimpleGraph.fromRel rel; + ∀ (u : X), + ∀ (c : G.Walk u u), + let path : List GaussianInt := c.support.tail.map Subtype.val + 3 ≤ path.length → + let cyclicEdges := path.zip path.tail ++ [(u.1, c.snd.1)] + (∀ {z : GaussianInt}, z ∈ path → z ∈ S) → + ∀ {r : GaussianInt}, ∀ {s : GaussianInt}, (r, s) ∈ cyclicEdges → r ∈ S ∧ s ∈ S := by classical - intro S I VF JF X rel G u c v path path_length cyclicEdges path_vertex_mem r s hrs + intro S I VF JF X rel G u c path path_length cyclicEdges path_vertex_mem r s hrs rcases List.mem_append.mp hrs with hrs | hrs · rw [List.mem_iff_getElem] at hrs rcases hrs with ⟨i, hi, hrs⟩ @@ -1438,7 +1436,7 @@ theorem FiniteBiconnectedHorizontalRunTree (S : Finset GaussianInt) (if b = a + ⟨0, 1⟩ ∧ a.im = (q + I).im ∧ a.re ≤ (q + I).re then 1 else if b = a - ⟨0, 1⟩ ∧ b.im = (q + I).im ∧ a.re ≤ (q + I).re then -1 else 0) = 0 := HorizontalRunTreeProof.crossing_step_zero S - u c v a b ha hb + v a b ha hb have htopzero : GridRayCrossingIndex (q + I) path = 0 := HorizontalRunTreeProof.htopzero S u c hc v hv_im_max path_head path_last path_vertex_im_le crossing_step_zero have htarget : @@ -1452,7 +1450,7 @@ theorem FiniteBiconnectedHorizontalRunTree (S : Finset GaussianInt) HorizontalRunDetails.path_vertex_mem S u c (z := z) hz have cyclic_edge_occupied {r s : GaussianInt} (hrs : (r, s) ∈ cyclicEdges) : r ∈ S ∧ s ∈ S := - HorizontalRunTreeProof.cyclic_edge_occupied S u c v path_length path_vertex_mem (r := + HorizontalRunTreeProof.cyclic_edge_occupied S u c path_length path_vertex_mem (r := r) (s := s) hrs have index_eq_of_outside_adj {r s : GaussianInt} (hr : r ∉ S) (hs : s ∉ S) (hrs : FourNeighborAdjacent r s) : diff --git a/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean b/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean index 9c9a5b9239..1ffa3f0584 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean @@ -155,18 +155,27 @@ private theorem hlong : simpa [Nat.lt_iff_add_one_le] using hm private theorem hboundary : - ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), (∀ v : X, Set.ncard - ((SimpleGraph.fromRel fun a b : X => ({a.1, b.1} : Finset GaussianInt) ∈ E).neighborSet - v) ≤ 2) → ( - let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => - ({a.1, b.1} : Finset GaussianInt) ∈ E - (X.Finite) → ( - (ℕ) → (∀ (u : (↑X : Type)), ∀ (v : (↑X : Type)), ∀ (p : G.Walk u v), (p.IsPath) → ((∀ (u' : - X), ∀ (v' : X), ∀ (p' : G.Walk u' v'), (p'.IsPath) → (p'.length ≤ p.length)) → (∀ z : X, - z ∈ p.support → - ∀ w : X, G.Adj z w → w ∈ p.support))))) := by + ∀ (X : Set GaussianInt), + ∀ (E : Set (Finset GaussianInt)), + (∀ v : X, + Set.ncard + ((SimpleGraph.fromRel fun a b : X => + ({ a.1, b.1 } : Finset GaussianInt) ∈ E).neighborSet + v) ≤ + 2) → + let G : SimpleGraph X := + SimpleGraph.fromRel fun a b : X => ({ a.1, b.1 } : Finset GaussianInt) ∈ E; + X.Finite → + ∀ (u : (↑X : Type)), + ∀ (v : (↑X : Type)), + ∀ (p : G.Walk u v), + p.IsPath → + (∀ (u' : X), + ∀ (v' : X), + ∀ (p' : G.Walk u' v'), p'.IsPath → p'.length ≤ p.length) → + ∀ z : X, z ∈ p.support → ∀ w : X, G.Adj z w → w ∈ p.support := by classical - intro X E hdegree G hXfinite n u v p hp hmax + intro X E hdegree G hXfinite u v p hp hmax let vertexFiniteness : Fintype X := hXfinite.fintype intro z hz w hzw by_contra hwo @@ -491,7 +500,7 @@ theorem FiniteConnectedAcyclicDegreeTwoGridPath p'.length ≤ p.length := GridPathProof.hmax X E n hnl u v p hp_len have hlong : 0 < p.length := GridPathProof.hlong X E hEne hendpoints hgrid u v p hmax have hboundary : ∀ z : X, z ∈ p.support → - ∀ w : X, G.Adj z w → w ∈ p.support := GridPathProof.hboundary X E hdegree hXfinite n u v p + ∀ w : X, G.Adj z w → w ∈ p.support := GridPathProof.hboundary X E hdegree hXfinite u v p hp hmax have hall : ∀ (x : X), x ∈ p.support := GridPathProof.hall X E hGconn u v p hboundary have hsupport : {x : X | x ∈ p.support} = Set.univ := GridPathProof.hsupport X E u v p hall diff --git a/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean b/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean index 0673ade099..22467fc558 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean @@ -395,15 +395,17 @@ private abbrev pair_eq := @PairAssignmentFacts.finsetPair GaussianInt inferInstance private theorem edgeOf_injective : - (ProtoTile) → ( let I : GaussianInt := ⟨0, 1⟩ let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} - (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ {d : GaussianInt}, (({a, b} - : Finset GaussianInt) = {c, d}) → ((a = c ∧ b = d) ∨ (a = d ∧ b = c))) → - (Function.Injective edgeOf)) := by + (∀ {a : GaussianInt}, + ∀ {b : GaussianInt}, + ∀ {c : GaussianInt}, + ∀ {d : GaussianInt}, + ({ a, b } : Finset GaussianInt) = { c, d } → a = c ∧ b = d ∨ a = d ∧ b = c) → + Function.Injective edgeOf := by classical - intro T I edgeOf pair_eq + intro I edgeOf pair_eq rintro ⟨z, b⟩ ⟨w, d⟩ h cases b <;> cases d · change ({z, z + 1} : Finset GaussianInt) = {w, w + 1} at h @@ -938,7 +940,7 @@ theorem FiniteSquareIncidenceIdentities (T : ProtoTile) (hne : T.cells.Nonempty) (h : ({a, b} : Finset GaussianInt) = {c, d}) : (a = c ∧ b = d) ∨ (a = d ∧ b = c) := SquareIncidenceProof.pair_eq (a := a) (b := b) (c := c) (d := d) h - have edgeOf_injective : Function.Injective edgeOf := SquareIncidenceProof.edgeOf_injective T + have edgeOf_injective : Function.Injective edgeOf := SquareIncidenceProof.edgeOf_injective pair_eq have hedgeSet : ((edgeBag.toFinset.image edgeOf : Finset (Finset GaussianInt)) : diff --git a/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean b/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean index 8b665c8ae8..8b3a60d092 100644 --- a/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean +++ b/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean @@ -176,32 +176,41 @@ private theorem ha32At288 : ext <;> simp private theorem hsemiAt342 : - (ℕ) → (∀ (Q : FordFareyParameter), ∀ (q1pos : 0 < Q.q₁), ∀ (hgtq : Q.q₁ > Q.q₂), - let pd : Int - := Q.p₁ - Q.p₂ - let qd : Nat := Q.q₁ - Q.q₂ - (0 < qd) → (∀ (hqdlt : qd < Q.q₁), ∀ (hd1 : pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = - 1), ∀ (hd2 : Q.p₂ * (Q.q₁ : Int) - (Q.q₂ : Int) * Q.p₁ = -1), ∀ (hred : Nat.Coprime Q.q₁ - Q.p₁.natAbs), ∀ (hq1gt : 1 < Q.q₁), - let R : FordFareyParameter := { - p := Q.p₁, q := Q.q₁, q_pos := q1pos, reduced := hred, - p₁ := pd, q₁ := qd, p₂ := Q.p₂, q₂ := Q.q₂, - sum_p := by dsimp [pd]; ring, - sum_q := by dsimp [qd]; omega, - det₁ := hd1, det₂ := hd2, q₁_lt := hqdlt, - q₂_pos := Q.q₂_pos, - unit_case := by intro hu; omega } - (SemiProperQuadruple ![((2 : ℤ) * (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * - (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (FordRecursiveQuadruple R (3 : - Fin (4 : ℕ))).1 - (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * - (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * - (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * - (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))).2 - (FordRecursiveQuadruple R (1 : Fin (4 : - ℕ))).2), FordRecursiveQuadruple R (0 : Fin (4 : ℕ)), FordRecursiveQuadruple R (2 : Fin (4 - : ℕ)), FordRecursiveQuadruple R (3 : Fin (4 : ℕ))]) → (SemiProperQuadruple - (FordRecursiveQuadruple Q)))) := by + ∀ (Q : FordFareyParameter), + ∀ (q1pos : 0 < Q.q₁), + ∀ (hgtq : Q.q₁ > Q.q₂), + let pd : Int := Q.p₁ - Q.p₂ + let qd : Nat := Q.q₁ - Q.q₂ + 0 < qd → + ∀ (hqdlt : qd < Q.q₁), + ∀ (hd1 : pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = 1), + ∀ (hd2 : Q.p₂ * (Q.q₁ : Int) - (Q.q₂ : Int) * Q.p₁ = -1), + ∀ (hred : Nat.Coprime Q.q₁ Q.p₁.natAbs), + ∀ (hq1gt : 1 < Q.q₁), + let R : FordFareyParameter := + { p := Q.p₁, q := Q.q₁, q_pos := q1pos, reduced := hred, p₁ := pd, + q₁ := qd, p₂ := Q.p₂, q₂ := Q.q₂, sum_p := by dsimp [pd]; ring, + sum_q := by dsimp [qd]; omega, det₁ := hd1, det₂ := hd2, + q₁_lt := hqdlt, q₂_pos := Q.q₂_pos, + unit_case := by intro hu; omega } + SemiProperQuadruple + ![((2 : ℤ) * (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))).1 - + (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * + (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * + (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))).2 - + (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))).2), + FordRecursiveQuadruple R (0 : Fin (4 : ℕ)), + FordRecursiveQuadruple R (2 : Fin (4 : ℕ)), + FordRecursiveQuadruple R (3 : Fin (4 : ℕ))] → + SemiProperQuadruple (FordRecursiveQuadruple Q) := by classical - intro n Q q1pos hgtq pd qd hqdpos hqdlt hd1 hd2 hred hq1gt R hsucc + intro Q q1pos hgtq pd qd hqdpos hqdlt hd1 hd2 hred hq1gt R hsucc convert hsucc using 1; simp only [FordRecursiveQuadruple, FordCircleCoordinate, Q.sum_q, Nat.cast_mul, Nat.cast_add, Int.reduceNeg, Q.sum_p, hqdpos.ne', ↓reduceIte, Fin.isValue, @@ -214,44 +223,61 @@ private theorem hsemiAt342 : all_goals try (intro hz; omega) private theorem hv13At359 : - (ℕ) → (∀ (Q : FordFareyParameter), ∀ (q1pos : 0 < Q.q₁), ∀ (hgtq : Q.q₁ > Q.q₂), - let pd : Int - := Q.p₁ - Q.p₂ - let qd : Nat := Q.q₁ - Q.q₂ - ∀ (hqdlt : qd < Q.q₁), ∀ (hd1 : pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = 1), ∀ (hd2 : Q.p₂ * - (Q.q₁ : Int) - (Q.q₂ : Int) * Q.p₁ = -1), ∀ (hred : Nat.Coprime Q.q₁ Q.p₁.natAbs), ∀ - (hq1gt : 1 < Q.q₁), - let R : FordFareyParameter := { - p := Q.p₁, q := Q.q₁, q_pos := q1pos, reduced := hred, - p₁ := pd, q₁ := qd, p₂ := Q.p₂, q₂ := Q.q₂, - sum_p := by dsimp [pd]; ring, - sum_q := by dsimp [qd]; omega, - det₁ := hd1, det₂ := hd2, q₁_lt := hqdlt, - q₂_pos := Q.q₂_pos, - unit_case := by intro hu; omega } - (BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : - Fin (4 : ℕ))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.q₂ : GaussianInt))) → ((BandVectors.1 - (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) - = (↑R.q₁ : GaussianInt)) → ((BandVectors.1 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) - (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) = BandVectors.1 (FordRecursiveQuadruple R (2 - : Fin (4 : ℕ))) (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : - Fin (4 : ℕ))) ∧ BandVectors.1 (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) - (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = BandVectors.1 (FordRecursiveQuadruple R (1 - : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : - Fin (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) - (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) = BandVectors.2 (FordRecursiveQuadruple R (2 - : Fin (4 : ℕ))) (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : - Fin (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) - (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = BandVectors.2 (FordRecursiveQuadruple R (1 - : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : - Fin (4 : ℕ)))) → (BandVectors.1 ((FordRecursiveQuadruple Q) 1) - ((FordRecursiveQuadruple Q) 3) = (Q.q₁ : GaussianInt))))) := by + ∀ (Q : FordFareyParameter), + ∀ (q1pos : 0 < Q.q₁), + ∀ (hgtq : Q.q₁ > Q.q₂), + let pd : Int := Q.p₁ - Q.p₂ + let qd : Nat := Q.q₁ - Q.q₂ + ∀ (hqdlt : qd < Q.q₁), + ∀ (hd1 : pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = 1), + ∀ (hd2 : Q.p₂ * (Q.q₁ : Int) - (Q.q₂ : Int) * Q.p₁ = -1), + ∀ (hred : Nat.Coprime Q.q₁ Q.p₁.natAbs), + ∀ (hq1gt : 1 < Q.q₁), + let R : FordFareyParameter := + { p := Q.p₁, q := Q.q₁, q_pos := q1pos, reduced := hred, p₁ := pd, + q₁ := qd, p₂ := Q.p₂, q₂ := Q.q₂, sum_p := by dsimp [pd]; ring, + sum_q := by dsimp [qd]; omega, det₁ := hd1, det₂ := hd2, + q₁_lt := hqdlt, q₂_pos := Q.q₂_pos, + unit_case := by intro hu; omega } + BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) = + -(⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.q₂ : GaussianInt)) → + BandVectors.1 (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = + (↑R.q₁ : GaussianInt) → + BandVectors.1 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) = + BandVectors.1 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) - + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) ∧ + BandVectors.1 (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = + BandVectors.1 (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) = + BandVectors.2 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) + + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = + BandVectors.2 (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) - + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) → + BandVectors.1 ((FordRecursiveQuadruple Q) 1) + ((FordRecursiveQuadruple Q) 3) = + (Q.q₁ : GaussianInt) := by classical - intro n Q q1pos hgtq pd qd hqdlt hd1 hd2 hred hq1gt R rv32 rv13 direct + intro Q q1pos hgtq pd qd hqdlt hd1 hd2 hred hq1gt R rv32 rv13 direct have hx := direct.2.1 rw [rv13, rv32] at hx simp only [FordRecursiveQuadruple, Fin.isValue, Matrix.cons_val_zero, Matrix.cons_val, @@ -280,45 +306,61 @@ private theorem hv13At359 : simpa [FordRecursiveQuadruple, R, Q.sum_q, q1pos.ne'] using hx private theorem ha13At390 : - (ℕ) → (∀ (Q : FordFareyParameter), ∀ (q1pos : 0 < Q.q₁), ∀ (hgtq : Q.q₁ > Q.q₂), - let pd : Int - := Q.p₁ - Q.p₂ - let qd : Nat := Q.q₁ - Q.q₂ - ∀ (hqdlt : qd < Q.q₁), ∀ (hd1 : pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = 1), ∀ (hd2 : Q.p₂ * - (Q.q₁ : Int) - (Q.q₂ : Int) * Q.p₁ = -1), ∀ (hred : Nat.Coprime Q.q₁ Q.p₁.natAbs), ∀ - (hq1gt : 1 < Q.q₁), - let R : FordFareyParameter := { - p := Q.p₁, q := Q.q₁, q_pos := q1pos, reduced := hred, - p₁ := pd, q₁ := qd, p₂ := Q.p₂, q₂ := Q.q₂, - sum_p := by dsimp [pd]; ring, - sum_q := by dsimp [qd]; omega, - det₁ := hd1, det₂ := hd2, q₁_lt := hqdlt, - q₂_pos := Q.q₂_pos, - unit_case := by intro hu; omega } - (BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : - Fin (4 : ℕ))) = -(↑R.p₂ : GaussianInt)) → ((BandVectors.2 (FordRecursiveQuadruple R (1 : - Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.p₁ - : GaussianInt)) → ((BandVectors.1 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) - (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) = BandVectors.1 (FordRecursiveQuadruple R (2 - : Fin (4 : ℕ))) (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : - Fin (4 : ℕ))) ∧ BandVectors.1 (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) - (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = BandVectors.1 (FordRecursiveQuadruple R (1 - : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : - Fin (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) - (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) = BandVectors.2 (FordRecursiveQuadruple R (2 - : Fin (4 : ℕ))) (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : - Fin (4 : ℕ))) ∧ BandVectors.2 (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) - (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = BandVectors.2 (FordRecursiveQuadruple R (1 - : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : - Fin (4 : ℕ)))) → (BandVectors.2 ((FordRecursiveQuadruple Q) 1) - ((FordRecursiveQuadruple Q) 3) = - (⟨0, 1⟩ : GaussianInt) * (Q.p₁ : GaussianInt))))) := by + ∀ (Q : FordFareyParameter), + ∀ (q1pos : 0 < Q.q₁), + ∀ (hgtq : Q.q₁ > Q.q₂), + let pd : Int := Q.p₁ - Q.p₂ + let qd : Nat := Q.q₁ - Q.q₂ + ∀ (hqdlt : qd < Q.q₁), + ∀ (hd1 : pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = 1), + ∀ (hd2 : Q.p₂ * (Q.q₁ : Int) - (Q.q₂ : Int) * Q.p₁ = -1), + ∀ (hred : Nat.Coprime Q.q₁ Q.p₁.natAbs), + ∀ (hq1gt : 1 < Q.q₁), + let R : FordFareyParameter := + { p := Q.p₁, q := Q.q₁, q_pos := q1pos, reduced := hred, p₁ := pd, + q₁ := qd, p₂ := Q.p₂, q₂ := Q.q₂, sum_p := by dsimp [pd]; ring, + sum_q := by dsimp [qd]; omega, det₁ := hd1, det₂ := hd2, + q₁_lt := hqdlt, q₂_pos := Q.q₂_pos, + unit_case := by intro hu; omega } + BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) = + -(↑R.p₂ : GaussianInt) → + BandVectors.2 (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = + ⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.p₁ : GaussianInt) → + BandVectors.1 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) = + BandVectors.1 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) - + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) ∧ + BandVectors.1 (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = + BandVectors.1 (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) = + BandVectors.2 (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) + + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (FordRecursiveQuadruple R (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = + BandVectors.2 (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) - + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) → + BandVectors.2 ((FordRecursiveQuadruple Q) 1) + ((FordRecursiveQuadruple Q) 3) = + (⟨0, 1⟩ : GaussianInt) * (Q.p₁ : GaussianInt) := by classical - intro n Q q1pos hgtq pd qd hqdlt hd1 hd2 hred hq1gt R ra32 ra13 direct + intro Q q1pos hgtq pd qd hqdlt hd1 hd2 hred hq1gt R ra32 ra13 direct have hx := direct.2.2.2 rw [ra13, ra32] at hx have hx' : BandVectors.2 ((FordRecursiveQuadruple Q) 1) @@ -336,122 +378,209 @@ private theorem ha13At390 : ext <;> simp private theorem hsemiAt448 : - (ℕ) → (∀ (Q : FordFareyParameter), ∀ (hgtq : ¬Q.q₁ > Q.q₂), - let pd : Int := Q.p₂ - Q.p₁ - let qd : Nat := Q.q₂ - Q.q₁ - (0 < Q.q₁) → (∀ (hqdpos : 0 < qd), ∀ (hd1 : Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * - Q.p₂ = 1), ∀ (hd2 : pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1), ∀ (hred : Nat.Coprime - Q.q₂ Q.p₂.natAbs), ∀ (hq2gt : 1 < Q.q₂), - let R : FordFareyParameter := { - p := Q.p₂, q := Q.q₂, q_pos := Q.q₂_pos, reduced := hred, - p₁ := Q.p₁, q₁ := Q.q₁, p₂ := pd, q₂ := qd, - sum_p := by dsimp [pd]; ring, - sum_q := by dsimp [qd]; omega, - det₁ := hd1, det₂ := hd2, q₁_lt := by omega, - q₂_pos := hqdpos, - unit_case := by intro hu; omega } - let rotatedTuple : Fin 4 → CircleCoordinates := - ![FordRecursiveQuadruple R 0, FordRecursiveQuadruple R 2, - FordRecursiveQuadruple R 3, FordRecursiveQuadruple R 1] - (SemiProperQuadruple ![![![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * - (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : - ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * - (rotatedTuple (3 : Fin (4 : ℕ))).2 - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 - : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (0 : Fin - (4 : ℕ)), ![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : - Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin - (4 : ℕ))).1, (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * - (rotatedTuple (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : - ℕ))).2 - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), - rotatedTuple (2 : Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![((2 - : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 - + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : - GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 - : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : - Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![((2 : ℤ) * - (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : - ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : - GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 - : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : - Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), - ![![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : - ℕ))).1 + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : - ℕ))).1, (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * - (rotatedTuple (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : - ℕ))).2 - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), - rotatedTuple (2 : Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![((2 - : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 - + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : - GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 - : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : - Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![((2 : ℤ) * - (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : - ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : - GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 - : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : - Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![((2 : ℤ) * - (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : - ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : - GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 - : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : - Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), - ![![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : - ℕ))).1 + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : - ℕ))).1, (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * - (rotatedTuple (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : - ℕ))).2 - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), - rotatedTuple (2 : Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![((2 - : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 - + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : - GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 - : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : - Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![((2 : ℤ) * - (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : - ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : - GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 - : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : - Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![((2 : ℤ) * - (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : - ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : - GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 - : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : - Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), - ![![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : - ℕ))).1 + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : - ℕ))).1, (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * - (rotatedTuple (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : - ℕ))).2 - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), - rotatedTuple (2 : Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![((2 - : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 - + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : - GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 - : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : - Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![((2 : ℤ) * - (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : - ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : - GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 - : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : - Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![((2 : ℤ) * - (rotatedTuple (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + (2 : - ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - (rotatedTuple (1 : Fin (4 : ℕ))).1, (2 : - GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (2 - : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - - (rotatedTuple (1 : Fin (4 : ℕ))).2), rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : - Fin (4 : ℕ)), rotatedTuple (3 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))]) → - (SemiProperQuadruple (FordRecursiveQuadruple Q)))) := by + ∀ (Q : FordFareyParameter), + ∀ (hgtq : ¬Q.q₁ > Q.q₂), + let pd : Int := Q.p₂ - Q.p₁ + let qd : Nat := Q.q₂ - Q.q₁ + 0 < Q.q₁ → + ∀ (hqdpos : 0 < qd), + ∀ (hd1 : Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1), + ∀ (hd2 : pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1), + ∀ (hred : Nat.Coprime Q.q₂ Q.p₂.natAbs), + ∀ (hq2gt : 1 < Q.q₂), + let R : FordFareyParameter := + { p := Q.p₂, q := Q.q₂, q_pos := Q.q₂_pos, reduced := hred, + p₁ := Q.p₁, q₁ := Q.q₁, p₂ := pd, q₂ := qd, + sum_p := by dsimp [pd]; ring, sum_q := by dsimp [qd]; omega, + det₁ := hd1, det₂ := hd2, q₁_lt := by omega, q₂_pos := hqdpos, + unit_case := by intro hu; omega } + let rotatedTuple : Fin 4 → CircleCoordinates := + ![FordRecursiveQuadruple R 0, FordRecursiveQuadruple R 2, + FordRecursiveQuadruple R 3, FordRecursiveQuadruple R 1] + SemiProperQuadruple + ![![![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (0 : Fin (4 : ℕ)), + ![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (2 : Fin (4 : ℕ)), + ![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (3 : Fin (4 : ℕ)), + ![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (1 : Fin (4 : ℕ))] + (0 : Fin (4 : ℕ)), + ![![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (0 : Fin (4 : ℕ)), + ![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (2 : Fin (4 : ℕ)), + ![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (3 : Fin (4 : ℕ)), + ![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (1 : Fin (4 : ℕ))] + (2 : Fin (4 : ℕ)), + ![![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (0 : Fin (4 : ℕ)), + ![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (2 : Fin (4 : ℕ)), + ![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (3 : Fin (4 : ℕ)), + ![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (1 : Fin (4 : ℕ))] + (3 : Fin (4 : ℕ)), + ![![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (0 : Fin (4 : ℕ)), + ![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (2 : Fin (4 : ℕ)), + ![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (3 : Fin (4 : ℕ)), + ![((2 : ℤ) * (rotatedTuple (0 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (2 : Fin (4 : ℕ))).1 + + (2 : ℤ) * (rotatedTuple (3 : Fin (4 : ℕ))).1 - + (rotatedTuple (1 : Fin (4 : ℕ))).1, + (2 : GaussianInt) * (rotatedTuple (0 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (2 : Fin (4 : ℕ))).2 + + (2 : GaussianInt) * (rotatedTuple (3 : Fin (4 : ℕ))).2 - + (rotatedTuple (1 : Fin (4 : ℕ))).2), + rotatedTuple (0 : Fin (4 : ℕ)), rotatedTuple (2 : Fin (4 : ℕ)), + rotatedTuple (3 : Fin (4 : ℕ))] + (1 : Fin (4 : ℕ))] + (1 : Fin (4 : ℕ))] → + SemiProperQuadruple (FordRecursiveQuadruple Q) := by classical - intro n Q hgtq pd qd q1pos' hqdpos hd1 hd2 hred hq2gt R rotatedTuple hfinal + intro Q hgtq pd qd q1pos' hqdpos hd1 hd2 hred hq2gt R rotatedTuple hfinal have rcond : R.q₁ ≠ 0 := by simp [R, q1pos'.ne'] have rentry : FordRecursiveQuadruple R 1 = FordCircleCoordinate Q.p₁ Q.q₁ := by @@ -481,44 +610,64 @@ private theorem hsemiAt448 : private theorem hv32At473 : - (ℕ) → (∀ (Q : FordFareyParameter), ∀ (hgtq : ¬Q.q₁ > Q.q₂), - let pd : Int := Q.p₂ - Q.p₁ - let qd : Nat := Q.q₂ - Q.q₁ - (0 < Q.q₁) → (∀ (hqdpos : 0 < qd), ∀ (hd1 : Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * - Q.p₂ = 1), ∀ (hd2 : pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1), ∀ (hred : Nat.Coprime - Q.q₂ Q.p₂.natAbs), ∀ (hq2gt : 1 < Q.q₂), - let R : FordFareyParameter := { - p := Q.p₂, q := Q.q₂, q_pos := Q.q₂_pos, reduced := hred, - p₁ := Q.p₁, q₁ := Q.q₁, p₂ := pd, q₂ := qd, - sum_p := by dsimp [pd]; ring, - sum_q := by dsimp [qd]; omega, - det₁ := hd1, det₂ := hd2, q₁_lt := by omega, - q₂_pos := hqdpos, - unit_case := by intro hu; omega } - (BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : - Fin (4 : ℕ))) = -(⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.q₂ : GaussianInt))) → ((BandVectors.1 - (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) - = (↑R.q₁ : GaussianInt)) → ( - let rotatedTuple : Fin 4 → CircleCoordinates := - ![FordRecursiveQuadruple R 0, FordRecursiveQuadruple R 2, - FordRecursiveQuadruple R 3, FordRecursiveQuadruple R 1] - (BandVectors.1 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (0 : Fin (4 : ℕ))) = - BandVectors.1 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (1 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : - ℕ))) ∧ BandVectors.1 (rotatedTuple (0 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) = - BandVectors.1 (rotatedTuple (1 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) + ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : - ℕ))) ∧ BandVectors.2 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (0 : Fin (4 : ℕ))) = - BandVectors.2 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (1 : Fin (4 : ℕ))) + ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.2 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : - ℕ))) ∧ BandVectors.2 (rotatedTuple (0 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) = - BandVectors.2 (rotatedTuple (1 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.2 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : - ℕ)))) → (BandVectors.1 ((FordRecursiveQuadruple Q) 3) - ((FordRecursiveQuadruple Q) 2) = - -((⟨0, 1⟩ : GaussianInt) * (Q.q₂ : GaussianInt))))))) := by + ∀ (Q : FordFareyParameter), + ∀ (hgtq : ¬Q.q₁ > Q.q₂), + let pd : Int := Q.p₂ - Q.p₁ + let qd : Nat := Q.q₂ - Q.q₁ + 0 < Q.q₁ → + ∀ (hqdpos : 0 < qd), + ∀ (hd1 : Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1), + ∀ (hd2 : pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1), + ∀ (hred : Nat.Coprime Q.q₂ Q.p₂.natAbs), + ∀ (hq2gt : 1 < Q.q₂), + let R : FordFareyParameter := + { p := Q.p₂, q := Q.q₂, q_pos := Q.q₂_pos, reduced := hred, + p₁ := Q.p₁, q₁ := Q.q₁, p₂ := pd, q₂ := qd, + sum_p := by dsimp [pd]; ring, sum_q := by dsimp [qd]; omega, + det₁ := hd1, det₂ := hd2, q₁_lt := by omega, q₂_pos := hqdpos, + unit_case := by intro hu; omega } + BandVectors.1 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) = + -(⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.q₂ : GaussianInt)) → + BandVectors.1 (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = + (↑R.q₁ : GaussianInt) → + let rotatedTuple : Fin 4 → CircleCoordinates := + ![FordRecursiveQuadruple R 0, FordRecursiveQuadruple R 2, + FordRecursiveQuadruple R 3, FordRecursiveQuadruple R 1] + BandVectors.1 (rotatedTuple (2 : Fin (4 : ℕ))) + (rotatedTuple (0 : Fin (4 : ℕ))) = + BandVectors.1 (rotatedTuple (2 : Fin (4 : ℕ))) + (rotatedTuple (1 : Fin (4 : ℕ))) - + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (rotatedTuple (3 : Fin (4 : ℕ))) + (rotatedTuple (2 : Fin (4 : ℕ))) ∧ + BandVectors.1 (rotatedTuple (0 : Fin (4 : ℕ))) + (rotatedTuple (3 : Fin (4 : ℕ))) = + BandVectors.1 (rotatedTuple (1 : Fin (4 : ℕ))) + (rotatedTuple (3 : Fin (4 : ℕ))) + + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (rotatedTuple (3 : Fin (4 : ℕ))) + (rotatedTuple (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (rotatedTuple (2 : Fin (4 : ℕ))) + (rotatedTuple (0 : Fin (4 : ℕ))) = + BandVectors.2 (rotatedTuple (2 : Fin (4 : ℕ))) + (rotatedTuple (1 : Fin (4 : ℕ))) + + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (rotatedTuple (3 : Fin (4 : ℕ))) + (rotatedTuple (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (rotatedTuple (0 : Fin (4 : ℕ))) + (rotatedTuple (3 : Fin (4 : ℕ))) = + BandVectors.2 (rotatedTuple (1 : Fin (4 : ℕ))) + (rotatedTuple (3 : Fin (4 : ℕ))) - + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (rotatedTuple (3 : Fin (4 : ℕ))) + (rotatedTuple (2 : Fin (4 : ℕ))) → + BandVectors.1 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2) = + -((⟨0, 1⟩ : GaussianInt) * (Q.q₂ : GaussianInt)) := by classical - intro n Q hgtq pd qd q1pos' hqdpos hd1 hd2 hred hq2gt R rv32 rv13 rotatedTuple direct + intro Q hgtq pd qd q1pos' hqdpos hd1 hd2 hred hq2gt R rv32 rv13 rotatedTuple direct have hx := direct.1 have rv32' : BandVectors.1 (rotatedTuple 2) (rotatedTuple 1) = -((⟨0, 1⟩ : GaussianInt) * (qd : GaussianInt)) := by @@ -543,43 +692,64 @@ private theorem hv32At473 : simpa [rotatedTuple, FordRecursiveQuadruple, R, q1pos'.ne'] using hx private theorem ha32At503 : - (ℕ) → (∀ (Q : FordFareyParameter), ∀ (hgtq : ¬Q.q₁ > Q.q₂), - let pd : Int := Q.p₂ - Q.p₁ - let qd : Nat := Q.q₂ - Q.q₁ - (0 < Q.q₁) → (∀ (hqdpos : 0 < qd), ∀ (hd1 : Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * - Q.p₂ = 1), ∀ (hd2 : pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1), ∀ (hred : Nat.Coprime - Q.q₂ Q.p₂.natAbs), ∀ (hq2gt : 1 < Q.q₂), - let R : FordFareyParameter := { - p := Q.p₂, q := Q.q₂, q_pos := Q.q₂_pos, reduced := hred, - p₁ := Q.p₁, q₁ := Q.q₁, p₂ := pd, q₂ := qd, - sum_p := by dsimp [pd]; ring, - sum_q := by dsimp [qd]; omega, - det₁ := hd1, det₂ := hd2, q₁_lt := by omega, - q₂_pos := hqdpos, - unit_case := by intro hu; omega } - (BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple R (2 : - Fin (4 : ℕ))) = -(↑R.p₂ : GaussianInt)) → ((BandVectors.2 (FordRecursiveQuadruple R (1 : - Fin (4 : ℕ))) (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.p₁ - : GaussianInt)) → ( - let rotatedTuple : Fin 4 → CircleCoordinates := - ![FordRecursiveQuadruple R 0, FordRecursiveQuadruple R 2, - FordRecursiveQuadruple R 3, FordRecursiveQuadruple R 1] - (BandVectors.1 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (0 : Fin (4 : ℕ))) = - BandVectors.1 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (1 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : - ℕ))) ∧ BandVectors.1 (rotatedTuple (0 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) = - BandVectors.1 (rotatedTuple (1 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) + ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : - ℕ))) ∧ BandVectors.2 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (0 : Fin (4 : ℕ))) = - BandVectors.2 (rotatedTuple (2 : Fin (4 : ℕ))) (rotatedTuple (1 : Fin (4 : ℕ))) + ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.2 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : - ℕ))) ∧ BandVectors.2 (rotatedTuple (0 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) = - BandVectors.2 (rotatedTuple (1 : Fin (4 : ℕ))) (rotatedTuple (3 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.2 (rotatedTuple (3 : Fin (4 : ℕ))) (rotatedTuple (2 : Fin (4 : - ℕ)))) → (BandVectors.2 ((FordRecursiveQuadruple Q) 3) - ((FordRecursiveQuadruple Q) 2) = -(Q.p₂ : GaussianInt)))))) := by + ∀ (Q : FordFareyParameter), + ∀ (hgtq : ¬Q.q₁ > Q.q₂), + let pd : Int := Q.p₂ - Q.p₁ + let qd : Nat := Q.q₂ - Q.q₁ + 0 < Q.q₁ → + ∀ (hqdpos : 0 < qd), + ∀ (hd1 : Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1), + ∀ (hd2 : pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1), + ∀ (hred : Nat.Coprime Q.q₂ Q.p₂.natAbs), + ∀ (hq2gt : 1 < Q.q₂), + let R : FordFareyParameter := + { p := Q.p₂, q := Q.q₂, q_pos := Q.q₂_pos, reduced := hred, + p₁ := Q.p₁, q₁ := Q.q₁, p₂ := pd, q₂ := qd, + sum_p := by dsimp [pd]; ring, sum_q := by dsimp [qd]; omega, + det₁ := hd1, det₂ := hd2, q₁_lt := by omega, q₂_pos := hqdpos, + unit_case := by intro hu; omega } + BandVectors.2 (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (2 : Fin (4 : ℕ))) = + -(↑R.p₂ : GaussianInt) → + BandVectors.2 (FordRecursiveQuadruple R (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple R (3 : Fin (4 : ℕ))) = + ⟨(0 : ℤ), (1 : ℤ)⟩ * (↑R.p₁ : GaussianInt) → + let rotatedTuple : Fin 4 → CircleCoordinates := + ![FordRecursiveQuadruple R 0, FordRecursiveQuadruple R 2, + FordRecursiveQuadruple R 3, FordRecursiveQuadruple R 1] + BandVectors.1 (rotatedTuple (2 : Fin (4 : ℕ))) + (rotatedTuple (0 : Fin (4 : ℕ))) = + BandVectors.1 (rotatedTuple (2 : Fin (4 : ℕ))) + (rotatedTuple (1 : Fin (4 : ℕ))) - + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (rotatedTuple (3 : Fin (4 : ℕ))) + (rotatedTuple (2 : Fin (4 : ℕ))) ∧ + BandVectors.1 (rotatedTuple (0 : Fin (4 : ℕ))) + (rotatedTuple (3 : Fin (4 : ℕ))) = + BandVectors.1 (rotatedTuple (1 : Fin (4 : ℕ))) + (rotatedTuple (3 : Fin (4 : ℕ))) + + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (rotatedTuple (3 : Fin (4 : ℕ))) + (rotatedTuple (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (rotatedTuple (2 : Fin (4 : ℕ))) + (rotatedTuple (0 : Fin (4 : ℕ))) = + BandVectors.2 (rotatedTuple (2 : Fin (4 : ℕ))) + (rotatedTuple (1 : Fin (4 : ℕ))) + + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (rotatedTuple (3 : Fin (4 : ℕ))) + (rotatedTuple (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (rotatedTuple (0 : Fin (4 : ℕ))) + (rotatedTuple (3 : Fin (4 : ℕ))) = + BandVectors.2 (rotatedTuple (1 : Fin (4 : ℕ))) + (rotatedTuple (3 : Fin (4 : ℕ))) - + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (rotatedTuple (3 : Fin (4 : ℕ))) + (rotatedTuple (2 : Fin (4 : ℕ))) → + BandVectors.2 ((FordRecursiveQuadruple Q) 3) + ((FordRecursiveQuadruple Q) 2) = + -(Q.p₂ : GaussianInt) := by classical - intro n Q hgtq pd qd q1pos' hqdpos hd1 hd2 hred hq2gt R ra32 ra13 rotatedTuple direct + intro Q hgtq pd qd q1pos' hqdpos hd1 hd2 hred hq2gt R ra32 ra13 rotatedTuple direct have hx := direct.2.2.1 have ra32' : BandVectors.2 (rotatedTuple 2) (rotatedTuple 1) = -(pd : GaussianInt) := by @@ -790,13 +960,14 @@ private theorem hv13At868 : Q.sum_q, z, coord1] using b1.2.2.1 private theorem hd1At883 : - (ℕ) → (∀ (Q : FordFareyParameter), (Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1) → ((Q.q₁ > - Q.q₂) → ( - let pd : Int := Q.p₁ - Q.p₂ - let qd : Nat := Q.q₁ - Q.q₂ - pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = 1))) := by + ∀ (Q : FordFareyParameter), + Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1 → + Q.q₁ > Q.q₂ → + let pd : Int := Q.p₁ - Q.p₂ + let qd : Nat := Q.q₁ - Q.q₂ + pd * (Q.q₁ : Int) - (qd : Int) * Q.p₁ = 1 := by classical - intro n Q cross hgtq pd qd + intro Q cross hgtq pd qd dsimp [pd, qd] rw [Nat.cast_sub (by omega)] nlinarith [cross] @@ -853,13 +1024,14 @@ private theorem ha32At914 : simpa [FordRecursiveQuadruple, R] using ra32 private theorem hd2At925 : - (ℕ) → (∀ (Q : FordFareyParameter), (Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1) → ((¬Q.q₁ - > Q.q₂) → ( - let pd : Int := Q.p₂ - Q.p₁ - let qd : Nat := Q.q₂ - Q.q₁ - pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1))) := by + ∀ (Q : FordFareyParameter), + Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1 → + ¬Q.q₁ > Q.q₂ → + let pd : Int := Q.p₂ - Q.p₁ + let qd : Nat := Q.q₂ - Q.q₁ + pd * (Q.q₂ : Int) - (qd : Int) * Q.p₂ = -1 := by classical - intro n Q cross hgtq pd qd + intro Q cross hgtq pd qd dsimp [pd, qd] rw [Nat.cast_sub (by omega)] nlinarith [cross] @@ -1237,7 +1409,7 @@ theorem FordCoordinateConfiguration (P : FordFareyParameter) : have q2pos : 0 < Q.q₂ := Q.q₂_pos have hqdpos : 0 < qd := by dsimp [qd]; omega have hqdlt : qd < Q.q₁ := by dsimp [qd]; omega - have hd1 := FordConfigurationDetails.hd1At883 n Q cross hgtq + have hd1 := FordConfigurationDetails.hd1At883 Q cross hgtq have hd2 : Q.p₂ * (Q.q₁ : Int) - (Q.q₂ : Int) * Q.p₁ = -1 := by nlinarith [cross] have hred : Nat.Coprime Q.q₁ Q.p₁.natAbs := @@ -1255,24 +1427,24 @@ theorem FordCoordinateConfiguration (P : FordFareyParameter) : have hrec := ih Q.q₁ hq1ltN R (by simp [R]) (by simpa [R] using hq1gt) rcases hrec with ⟨rsemi, rv32, rv13, ra32, ra13⟩ have hsucc := SemiProperQuadruple.successor rsemi - have hsemi := FordConfigurationProof.hsemiAt342 n Q q1pos hgtq hqdpos hqdlt hd1 hd2 + have hsemi := FordConfigurationProof.hsemiAt342 Q q1pos hgtq hqdpos hqdlt hd1 hd2 hred hq1gt hsucc have direct := stepLaw (FordRecursiveQuadruple R) rsemi have hv32 := FordConfigurationDetails.hv32At908 Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt rv32 - have hv13 := FordConfigurationProof.hv13At359 n Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt rv32 + have hv13 := FordConfigurationProof.hv13At359 Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt rv32 rv13 direct have ha32 := FordConfigurationDetails.ha32At914 Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt ra32 - have ha13 := FordConfigurationProof.ha13At390 - n Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt ra32 ra13 direct + have ha13 := FordConfigurationProof.ha13At390 Q q1pos hgtq hqdlt hd1 hd2 hred hq1gt + ra32 ra13 direct exact ⟨hsemi, hv32, hv13, ha32, ha13⟩ · let pd : Int := Q.p₂ - Q.p₁ let qd : Nat := Q.q₂ - Q.q₁ have q1pos' : 0 < Q.q₁ := q1pos have hqdpos : 0 < qd := by dsimp [qd]; omega have hd1 : Q.p₁ * (Q.q₂ : Int) - (Q.q₁ : Int) * Q.p₂ = 1 := cross - have hd2 := FordConfigurationDetails.hd2At925 n Q cross hgtq + have hd2 := FordConfigurationDetails.hd2At925 Q cross hgtq have hred := FordConfigurationDetails.hredAt929 Q determinantCoprime hd2 have hq2gt : 1 < Q.q₂ := by omega @@ -1295,14 +1467,14 @@ theorem FordCoordinateConfiguration (P : FordFareyParameter) : simpa [rotatedTuple] using SemiProperQuadruple.rotate rsemi have hsucc := SemiProperQuadruple.successor trot have hfinal := SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hsucc) - have hsemi := FordConfigurationProof.hsemiAt448 n Q hgtq q1pos' hqdpos hd1 hd2 hred + have hsemi := FordConfigurationProof.hsemiAt448 Q hgtq q1pos' hqdpos hd1 hd2 hred hq2gt hfinal have direct := stepLaw _ trot have hv13 := FordConfigurationDetails.hv13At961 Q hgtq hqdpos hd1 hd2 hred hq2gt rv13 - have hv32 := FordConfigurationProof.hv32At473 n Q hgtq q1pos' hqdpos hd1 hd2 hred hq2gt + have hv32 := FordConfigurationProof.hv32At473 Q hgtq q1pos' hqdpos hd1 hd2 hred hq2gt rv32 rv13 direct have ha13 := FordConfigurationDetails.ha13At966 Q hgtq hqdpos hd1 hd2 hred hq2gt ra13 - have ha32 := FordConfigurationProof.ha32At503 n Q hgtq q1pos' hqdpos hd1 hd2 hred hq2gt + have ha32 := FordConfigurationProof.ha32At503 Q hgtq q1pos' hqdpos hd1 hd2 hred hq2gt ra32 ra13 direct exact ⟨hsemi, hv32, hv13, ha32, ha13⟩ have circleExists := FordConfigurationProof.circleExists P claim diff --git a/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean index 6a8898f779..61bc622207 100644 --- a/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean +++ b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean @@ -267,12 +267,13 @@ private theorem rightLap : exact leftLap (t - P.q₁ + P.q) (by omega) (by omega) private theorem ha0 : - ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((GaussianInt) → ( - let a : Int := P.q₁ - let b : Int := P.q₂ - ((P.q : Int) = a + b) → (0 < a))) := by + ∀ (P : FordFareyParameter), + (1 : ℕ) < P.q → + let a : Int := P.q₁ + let b : Int := P.q₂ + (P.q : Int) = a + b → 0 < a := by classical - intro P hbig x a b hsum + intro P hbig a b hsum let A := P.p₁ by_contra h have hanon : 0 ≤ a := by dsimp [a]; omega @@ -307,25 +308,42 @@ private theorem parentValue : private theorem v1 : ∀ (P : FordFareyParameter), - let g := FordOdometer P - (GaussianInt) → ( - let a : Int := P.q₁ - let b : Int := P.q₂ - let A := P.p₁ - let B := P.p₂ - let cdiv (n d : Int) := -((-n) / d) - ((P.q : Int) = a + b) → (∀ (P₁ : FordFareyParameter), (P₁.p = A) → ((P₁.q = P.q₁) → (∀ (P₂ : - FordFareyParameter), (P₂.q = P.q₂) → ((∀ x ∈ FordRecursiveVertexDomains P (1 : Fin (4 : - ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = Classical.choose - FordOdometerFamilyExistsUnique P₁ (x - ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) + P.p₂ * x.re + P.p₂ * - x.im - P.p₂ * (↑P.q₂ : ℤ) + (1 : ℤ)) → ((∀ (R : FordFareyParameter), ∀ (r : Int), ∀ (s : - Int), (0 ≤ r ∧ r ≤ R.q ∧ 0 ≤ s ∧ s ≤ R.q) → ((r ≤ 1 ∨ (R.q : Int) - 1 ≤ r ∨ s ≤ 1 ∨ (R.q - : Int) - 1 ≤ s) → (Classical.choose FordOdometerFamilyExistsUnique R ⟨r, s⟩ = cdiv (R.p * - r * s) R.q))) → (∀ (r : ℤ), ∀ (s : ℤ), b ≤ r ∧ r ≤ (↑P.q : ℤ) ∧ b ≤ s ∧ s ≤ (↑P.q : ℤ) → - r - b ≤ (1 : ℤ) ∨ a - (1 : ℤ) ≤ r - b ∨ s - b ≤ (1 : ℤ) ∨ a - (1 : ℤ) ≤ s - b → g ⟨r, s⟩ - = cdiv (A * (r - b) * (s - b)) a + B * r + B * s - B * b + (1 : ℤ)))))))) := by + let g := FordOdometer P; + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + let cdiv (n d : Int) := -(-n / d) + (P.q : Int) = a + b → + ∀ (P₁ : FordFareyParameter), + P₁.p = A → + P₁.q = P.q₁ → + ∀ (P₂ : FordFareyParameter), + P₂.q = P.q₂ → + (∀ x ∈ FordRecursiveVertexDomains P (1 : Fin (4 : ℕ)), + Classical.choose FordOdometerFamilyExistsUnique P x = + Classical.choose FordOdometerFamilyExistsUnique P₁ + (x - ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) + + P.p₂ * x.re + + P.p₂ * x.im - + P.p₂ * (↑P.q₂ : ℤ) + + (1 : ℤ)) → + (∀ (R : FordFareyParameter), + ∀ (r : Int), + ∀ (s : Int), + 0 ≤ r ∧ r ≤ R.q ∧ 0 ≤ s ∧ s ≤ R.q → + r ≤ 1 ∨ (R.q : Int) - 1 ≤ r ∨ s ≤ 1 ∨ (R.q : Int) - 1 ≤ s → + Classical.choose FordOdometerFamilyExistsUnique R ⟨r, s⟩ = + cdiv (R.p * r * s) R.q) → + ∀ (r : ℤ), + ∀ (s : ℤ), + b ≤ r ∧ r ≤ (↑P.q : ℤ) ∧ b ≤ s ∧ s ≤ (↑P.q : ℤ) → + r - b ≤ (1 : ℤ) ∨ + a - (1 : ℤ) ≤ r - b ∨ s - b ≤ (1 : ℤ) ∨ a - (1 : ℤ) ≤ s - b → + g ⟨r, s⟩ = + cdiv (A * (r - b) * (s - b)) a + B * r + B * s - B * b + (1 : ℤ) := by classical - intro P g x a b A B cdiv hsum P₁ hp₁ hq₁ P₂ hq₂ rec1 parentValue r s hrect hedge + intro P g a b A B cdiv hsum P₁ hp₁ hq₁ P₂ hq₂ rec1 parentValue r s hrect hedge have hd := rec1 ⟨r, s⟩ (by change b ≤ r ∧ r ≤ P.q ∧ b ≤ s ∧ s ≤ P.q; exact hrect) have he : (⟨r, s⟩ : GaussianInt) - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩ = ⟨r - b, s - b⟩ := rfl rw [he] at hd @@ -338,24 +356,38 @@ private theorem v1 : private theorem v2 : ∀ (P : FordFareyParameter), - let g := FordOdometer P - (GaussianInt) → ( - let a : Int := P.q₁ - let b : Int := P.q₂ - let A := P.p₁ - let B := P.p₂ - let cdiv (n d : Int) := -((-n) / d) - ((P.q : Int) = a + b) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : - FordFareyParameter), (P₂.p = B) → ((P₂.q = P.q₂) → ((∀ x ∈ FordRecursiveVertexDomains P - (2 : Fin (4 : ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = Classical.choose - FordOdometerFamilyExistsUnique P₂ (x - ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩) + P.p₁ * x.im) → ((∀ (R : - FordFareyParameter), ∀ (r : Int), ∀ (s : Int), (0 ≤ r ∧ r ≤ R.q ∧ 0 ≤ s ∧ s ≤ R.q) → ((r - ≤ 1 ∨ (R.q : Int) - 1 ≤ r ∨ s ≤ 1 ∨ (R.q : Int) - 1 ≤ s) → (Classical.choose - FordOdometerFamilyExistsUnique R ⟨r, s⟩ = cdiv (R.p * r * s) R.q))) → (∀ (r : ℤ), ∀ (s : - ℤ), a ≤ r ∧ r ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ s ∧ s ≤ b → r - a ≤ (1 : ℤ) ∨ b - (1 : ℤ) ≤ r - a - ∨ s ≤ (1 : ℤ) ∨ b - (1 : ℤ) ≤ s → g ⟨r, s⟩ = cdiv (B * (r - a) * s) b + A * s))))))) := by + let g := FordOdometer P; + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + let cdiv (n d : Int) := -(-n / d) + (P.q : Int) = a + b → + ∀ (P₁ : FordFareyParameter), + P₁.q = P.q₁ → + ∀ (P₂ : FordFareyParameter), + P₂.p = B → + P₂.q = P.q₂ → + (∀ x ∈ FordRecursiveVertexDomains P (2 : Fin (4 : ℕ)), + Classical.choose FordOdometerFamilyExistsUnique P x = + Classical.choose FordOdometerFamilyExistsUnique P₂ + (x - ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩) + + P.p₁ * x.im) → + (∀ (R : FordFareyParameter), + ∀ (r : Int), + ∀ (s : Int), + 0 ≤ r ∧ r ≤ R.q ∧ 0 ≤ s ∧ s ≤ R.q → + r ≤ 1 ∨ (R.q : Int) - 1 ≤ r ∨ s ≤ 1 ∨ (R.q : Int) - 1 ≤ s → + Classical.choose FordOdometerFamilyExistsUnique R ⟨r, s⟩ = + cdiv (R.p * r * s) R.q) → + ∀ (r : ℤ), + ∀ (s : ℤ), + a ≤ r ∧ r ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ s ∧ s ≤ b → + r - a ≤ (1 : ℤ) ∨ + b - (1 : ℤ) ≤ r - a ∨ s ≤ (1 : ℤ) ∨ b - (1 : ℤ) ≤ s → + g ⟨r, s⟩ = cdiv (B * (r - a) * s) b + A * s := by classical - intro P g x a b A B cdiv hsum P₁ hq₁ P₂ hp₂ hq₂ rec2 parentValue r s hrect hedge + intro P g a b A B cdiv hsum P₁ hq₁ P₂ hp₂ hq₂ rec2 parentValue r s hrect hedge have hd := rec2 ⟨r, s⟩ (by change a ≤ r ∧ r ≤ P.q ∧ 0 ≤ s ∧ s ≤ b; exact hrect) have he : (⟨r, s⟩ : GaussianInt) - ⟨(P.q₁ : Int), 0⟩ = ⟨r - a, s⟩ := by ext <;> simp [a] rw [he] at hd @@ -368,24 +400,38 @@ private theorem v2 : private theorem v3 : ∀ (P : FordFareyParameter), - let g := FordOdometer P - (GaussianInt) → ( - let a : Int := P.q₁ - let b : Int := P.q₂ - let A := P.p₁ - let B := P.p₂ - let cdiv (n d : Int) := -((-n) / d) - ((P.q : Int) = a + b) → (∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → (∀ (P₂ : - FordFareyParameter), (P₂.p = B) → ((P₂.q = P.q₂) → ((∀ x ∈ FordRecursiveVertexDomains P - (3 : Fin (4 : ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = Classical.choose - FordOdometerFamilyExistsUnique P₂ (x - ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩) + P.p₁ * x.re) → ((∀ (R : - FordFareyParameter), ∀ (r : Int), ∀ (s : Int), (0 ≤ r ∧ r ≤ R.q ∧ 0 ≤ s ∧ s ≤ R.q) → ((r - ≤ 1 ∨ (R.q : Int) - 1 ≤ r ∨ s ≤ 1 ∨ (R.q : Int) - 1 ≤ s) → (Classical.choose - FordOdometerFamilyExistsUnique R ⟨r, s⟩ = cdiv (R.p * r * s) R.q))) → (∀ (r : ℤ), ∀ (s : - ℤ), (0 : ℤ) ≤ r ∧ r ≤ b ∧ a ≤ s ∧ s ≤ (↑P.q : ℤ) → r ≤ (1 : ℤ) ∨ b - (1 : ℤ) ≤ r ∨ s - a - ≤ (1 : ℤ) ∨ b - (1 : ℤ) ≤ s - a → g ⟨r, s⟩ = cdiv (B * r * (s - a)) b + A * r))))))) := by + let g := FordOdometer P; + let a : Int := P.q₁ + let b : Int := P.q₂ + let A := P.p₁ + let B := P.p₂ + let cdiv (n d : Int) := -(-n / d) + (P.q : Int) = a + b → + ∀ (P₁ : FordFareyParameter), + P₁.q = P.q₁ → + ∀ (P₂ : FordFareyParameter), + P₂.p = B → + P₂.q = P.q₂ → + (∀ x ∈ FordRecursiveVertexDomains P (3 : Fin (4 : ℕ)), + Classical.choose FordOdometerFamilyExistsUnique P x = + Classical.choose FordOdometerFamilyExistsUnique P₂ + (x - ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩) + + P.p₁ * x.re) → + (∀ (R : FordFareyParameter), + ∀ (r : Int), + ∀ (s : Int), + 0 ≤ r ∧ r ≤ R.q ∧ 0 ≤ s ∧ s ≤ R.q → + r ≤ 1 ∨ (R.q : Int) - 1 ≤ r ∨ s ≤ 1 ∨ (R.q : Int) - 1 ≤ s → + Classical.choose FordOdometerFamilyExistsUnique R ⟨r, s⟩ = + cdiv (R.p * r * s) R.q) → + ∀ (r : ℤ), + ∀ (s : ℤ), + (0 : ℤ) ≤ r ∧ r ≤ b ∧ a ≤ s ∧ s ≤ (↑P.q : ℤ) → + r ≤ (1 : ℤ) ∨ + b - (1 : ℤ) ≤ r ∨ s - a ≤ (1 : ℤ) ∨ b - (1 : ℤ) ≤ s - a → + g ⟨r, s⟩ = cdiv (B * r * (s - a)) b + A * r := by classical - intro P g x a b A B cdiv hsum P₁ hq₁ P₂ hp₂ hq₂ rec3 parentValue r s hrect hedge + intro P g a b A B cdiv hsum P₁ hq₁ P₂ hp₂ hq₂ rec3 parentValue r s hrect hedge have hd := rec3 ⟨r, s⟩ (by change 0 ≤ r ∧ r ≤ b ∧ a ≤ s ∧ s ≤ P.q; exact hrect) have he : (⟨r, s⟩ : GaussianInt) - ⟨0, (P.q₁ : Int)⟩ = ⟨r, s - a⟩ := by ext <;> simp [a] rw [he] at hd @@ -450,24 +496,35 @@ private theorem edge2 : private theorem lowFormula : ∀ (P : FordFareyParameter), - let g := FordOdometer P - (∀ (r : Int), ∀ (s : Int), FourNeighborLaplacian g ⟨r, s⟩ = g ⟨r + 1, s⟩ + g ⟨r - 1, s⟩ + g - ⟨r, s + 1⟩ + g ⟨r, s - 1⟩ - 4 * g ⟨r, s⟩) → ((GaussianInt) → ( - let a : Int := P.q₁ - let b : Int := P.q₂ - let A := P.p₁ - let B := P.p₂ - let cdiv (n d : Int) := -((-n) / d) - ∀ (P₁ : FordFareyParameter), (P₁.q = P.q₁) → ((FordFareyParameter) → ((∀ (t : Int), (0 ≤ t) → - ((t ≤ a) → (g ⟨a, t⟩ = A * t ∧ g ⟨t, a⟩ = A * t))) → ((∀ (t : Int), (0 ≤ t) → ((t ≤ a) → - (g ⟨a - 1, t⟩ = A * t - A * t / a ∧ g ⟨t, a - 1⟩ = A * t - A * t / a))) → ((∀ (t : Int), - (0 ≤ t) → ((t ≤ b) → (g ⟨a + 1, t⟩ = cdiv (B * t) b + A * t ∧ g ⟨t, a + 1⟩ = cdiv (B - * t) - b + A * t))) → (∀ (t : ℤ), (0 : ℤ) < t → t < a → t ≤ b → FourNeighborLaplacian g ⟨a, t⟩ = - cdiv (B * t) b - A * t / a ∧ FourNeighborLaplacian g ⟨t, a⟩ = cdiv (B * t) b - A * t / - a))))))) := by + let g := FordOdometer P; + (∀ (r : Int), + ∀ (s : Int), + FourNeighborLaplacian g ⟨r, s⟩ = + g ⟨r + 1, s⟩ + g ⟨r - 1, s⟩ + g ⟨r, s + 1⟩ + g ⟨r, s - 1⟩ - 4 * g ⟨r, s⟩) → + let a : Int := P.q₁; + let b : Int := P.q₂; + let A := P.p₁; + let B := P.p₂; + let cdiv (n d : Int) := -(-n / d); + FordFareyParameter → + (∀ (t : Int), 0 ≤ t → t ≤ a → g ⟨a, t⟩ = A * t ∧ g ⟨t, a⟩ = A * t) → + (∀ (t : Int), + 0 ≤ t → + t ≤ a → + g ⟨a - 1, t⟩ = A * t - A * t / a ∧ g ⟨t, a - 1⟩ = A * t - A * t / a) → + (∀ (t : Int), + 0 ≤ t → + t ≤ b → + g ⟨a + 1, t⟩ = cdiv (B * t) b + A * t ∧ + g ⟨t, a + 1⟩ = cdiv (B * t) b + A * t) → + ∀ (t : ℤ), + (0 : ℤ) < t → + t < a → + t ≤ b → + FourNeighborLaplacian g ⟨a, t⟩ = cdiv (B * t) b - A * t / a ∧ + FourNeighborLaplacian g ⟨t, a⟩ = cdiv (B * t) b - A * t / a := by classical - intro P g lapCoord x a b A B cdiv P₁ hq₁ P₂ edge0 near0 outward t ht hta htb + intro P g lapCoord a b A B cdiv P₁ edge0 near0 outward t ht hta htb have hc := edge0 t (by omega) (by omega) have hm := edge0 (t - 1) (by omega) (by omega) have hp' := edge0 (t + 1) (by omega) (by omega) @@ -633,21 +690,25 @@ private theorem rectBoundary : simp only [Set.mem_ofPred_eq] <;> omega private theorem count : - ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), - let a : Int := P.q₁ - let b : Int := P.q₂ - (FordFareyParameter) → ((FordFareyParameter) → ((x ∈ LatticeVertexBoundary - (FordRecursiveVertexDomains P 0) ↔ x.re ≤ a ∧ x.im ≤ a ∧ (x.re = a ∨ x.im = a)) → ((x ∈ - LatticeVertexBoundary (FordRecursiveVertexDomains P 1) ↔ b ≤ x.re ∧ b ≤ x.im ∧ (x.re = b - ∨ x.im = b)) → ((x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) ↔ a ≤ x.re ∧ - x.im ≤ b ∧ (x.re = a ∨ x.im = b)) → ((x ∈ LatticeVertexBoundary - (FordRecursiveVertexDomains P 3) ↔ x.re ≤ b ∧ a ≤ x.im ∧ (x.re = b ∨ x.im = a)) → - (FordBoundaryMultiplicity P x = (if x.re ≤ a ∧ x.im ≤ a ∧ (x.re = a ∨ x.im = a) then 1 - else 0) + (if b ≤ x.re ∧ b ≤ x.im ∧ (x.re = b ∨ x.im = b) then 1 else 0) + (if a ≤ x.re ∧ - x.im ≤ b ∧ (x.re = a ∨ x.im = b) then 1 else 0) + (if x.re ≤ b ∧ a ≤ x.im ∧ (x.re = b ∨ - x.im = a) then 1 else 0))))))) := by + ∀ (P : FordFareyParameter), + ∀ (x : GaussianInt), + let a : Int := P.q₁; + let b : Int := P.q₂; + (x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) ↔ + x.re ≤ a ∧ x.im ≤ a ∧ (x.re = a ∨ x.im = a)) → + (x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) ↔ + b ≤ x.re ∧ b ≤ x.im ∧ (x.re = b ∨ x.im = b)) → + (x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) ↔ + a ≤ x.re ∧ x.im ≤ b ∧ (x.re = a ∨ x.im = b)) → + (x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) ↔ + x.re ≤ b ∧ a ≤ x.im ∧ (x.re = b ∨ x.im = a)) → + FordBoundaryMultiplicity P x = + (((if x.re ≤ a ∧ x.im ≤ a ∧ (x.re = a ∨ x.im = a) then 1 else 0) + + if b ≤ x.re ∧ b ≤ x.im ∧ (x.re = b ∨ x.im = b) then 1 else 0) + + if a ≤ x.re ∧ x.im ≤ b ∧ (x.re = a ∨ x.im = b) then 1 else 0) + + if x.re ≤ b ∧ a ≤ x.im ∧ (x.re = b ∨ x.im = a) then 1 else 0 := by classical - intro P x a b P₁ P₂ b0 b1 b2 b3 + intro P x a b b0 b1 b2 b3 simp only [FordBoundaryMultiplicity, Finset.card_filter, Fin.sum_univ_succ, Fin.sum_univ_zero, add_zero] change (if x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) then 1 else 0) + @@ -1122,7 +1183,7 @@ private theorem interiorLaplacian : have hp : P.p = A + B := P.sum_p have hdet : A * b - B * a = 1 := FordLaplacianDetails.hdetAt828 P hsum hp have hb : 0 < b := by dsimp [b]; exact_mod_cast P.q₂_pos - have ha0 : 0 < a := FordLaplacianProof.ha0 P hbig x hsum + have ha0 : 0 < a := FordLaplacianProof.ha0 P hbig hsum have hcop : Nat.Coprime P.q₁ A.natAbs ∧ Nat.Coprime P.q₂ B.natAbs := FordLaplacianDetails.hcop P hdet obtain ⟨P₁, ⟨hp₁, hq₁⟩, _⟩ := FordFareyParentsExist A P.q₁ (by omega) hcop.1 @@ -1141,11 +1202,11 @@ private theorem interiorLaplacian : s hrect hedge have v2 (r s : Int) (hrect : a ≤ r ∧ r ≤ P.q ∧ 0 ≤ s ∧ s ≤ b) (hedge : r - a ≤ 1 ∨ b - 1 ≤ r - a ∨ s ≤ 1 ∨ b - 1 ≤ s) : - g ⟨r, s⟩ = cdiv (B * (r - a) * s) b + A * s := FordLaplacianProof.v2 P x hsum P₁ hq₁ P₂ + g ⟨r, s⟩ = cdiv (B * (r - a) * s) b + A * s := FordLaplacianProof.v2 P hsum P₁ hq₁ P₂ hp₂ hq₂ rec2 parentValue r s hrect hedge have v3 (r s : Int) (hrect : 0 ≤ r ∧ r ≤ b ∧ a ≤ s ∧ s ≤ P.q) (hedge : r ≤ 1 ∨ b - 1 ≤ r ∨ s - a ≤ 1 ∨ b - 1 ≤ s - a) : - g ⟨r, s⟩ = cdiv (B * r * (s - a)) b + A * r := FordLaplacianProof.v3 P x hsum P₁ hq₁ P₂ + g ⟨r, s⟩ = cdiv (B * r * (s - a)) b + A * r := FordLaplacianProof.v3 P hsum P₁ hq₁ P₂ hp₂ hq₂ rec3 parentValue r s hrect hedge have cminus (d n k : Int) (hd : d ≠ 0) : cdiv (k * d - n) d = k - n / d := FordLaplacianDetails.cminus d n k hd @@ -1165,7 +1226,7 @@ private theorem interiorLaplacian : have lowFormula (t : Int) (ht : 0 < t) (hta : t < a) (htb : t ≤ b) : FourNeighborLaplacian g ⟨a, t⟩ = cdiv (B * t) b - A * t / a ∧ FourNeighborLaplacian g ⟨t, a⟩ = cdiv (B * t) b - A * t / a := - FordLaplacianProof.lowFormula P lapCoord x P₁ hq₁ P₂ edge0 near0 outward t ht hta htb + FordLaplacianProof.lowFormula P lapCoord P₁ edge0 near0 outward t ht hta htb have highFormula (t : Int) (ht : 0 < t) (hta : t ≤ a) (htb : t < b) : FourNeighborLaplacian g ⟨(P.q : Int) - t, b⟩ = cdiv (B * t) b - A * t / a ∧ FourNeighborLaplacian g ⟨b, (P.q : Int) - t⟩ = cdiv (B * t) b - A * t / a := @@ -1178,9 +1239,9 @@ private theorem interiorLaplacian : from by classical intro r ht ht' - have hl := ((FordLaplacianProof.v1 P x hsum P₁ hp₁ hq₁ P₂ hq₂ rec1 + have hl := ((FordLaplacianProof.v1 P hsum P₁ hp₁ hq₁ P₂ hq₂ rec1 parentValue)) r (b + 1) (by omega) (by omega) - have hv := ((FordLaplacianProof.v1 P x hsum P₁ hp₁ hq₁ P₂ hq₂ rec1 + have hv := ((FordLaplacianProof.v1 P hsum P₁ hp₁ hq₁ P₂ hq₂ rec1 parentValue)) (b + 1) r (by omega) (by omega) change g ⟨r, b + 1⟩ = cdiv (A * (r - b) * (b + 1 - b)) a + B * r + B * (b + 1) - B * b + 1 at hl @@ -1203,7 +1264,7 @@ private theorem interiorLaplacian : (if b ≤ x.re ∧ b ≤ x.im ∧ (x.re = b ∨ x.im = b) then 1 else 0) + (if a ≤ x.re ∧ x.im ≤ b ∧ (x.re = a ∨ x.im = b) then 1 else 0) + (if x.re ≤ b ∧ a ≤ x.im ∧ (x.re = b ∨ x.im = a) then 1 else 0) := - FordLaplacianProof.count P x P₁ P₂ (FordLaplacianDetails.b0 P x hr hs ha0 P₁ hq₁ + FordLaplacianProof.count P x (FordLaplacianDetails.b0 P x hr hs ha0 P₁ hq₁ rectBoundary) (FordLaplacianDetails.b1 P x hr' hs' hsum P₁ hq₁ P₂ hq₂ rectBoundary) (FordLaplacianDetails.b2 P x hr' hs hsum P₁ hq₁ P₂ hq₂ rectBoundary) (FordLaplacianDetails.b3 P ha x hr hs' hsum P₁ hq₁ P₂ hq₂ rectBoundary) diff --git a/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean index 9e7beca517..a1f3fb3678 100644 --- a/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean @@ -63,12 +63,11 @@ private theorem wline : classical exact ∀ (q : Fin 4 -> CircleCoordinates), ∀ (w : Fin (4 : ℕ) → CircleCoordinates), ∀ (r1 : Fin - (3 : ℕ)), (∀ (j : Fin (3 : ℕ)), w j.succ = q (j + r1).succ) → ((∀ (y : Fin (3 : ℕ)), - (fun (r : Fin (3 : ℕ)) => ∀ (j : Fin (3 : ℕ)), w j.succ = q (j + r).succ) y → y = r1) - → (∀ (iline : Fin (4 : ℕ)), ((q iline).1 = (0 : ℤ)) → ((iline ≠ 0) → (∃ j : Fin 4, (w + (3 : ℕ)), (∀ (j : Fin (3 : ℕ)), w j.succ = q (j + r1).succ) → ( + (∀ (iline : Fin (4 : ℕ)), ((q iline).1 = (0 : ℤ)) → ((iline ≠ 0) → (∃ j : Fin 4, (w j).1 = 0)))) ) := by classical - intro q w r1 hr1 hruniq iline hiline iline0 + intro q w r1 hr1 iline hiline iline0 refine ⟨(iline.pred iline0 - r1).succ, ?_⟩ simpa only [hr1, sub_add_cancel, Fin.succ_pred] using hiline @@ -687,8 +686,8 @@ theorem FordLeftBoundaryCompatibility obtain ⟨r1, hr1, hruniq⟩ := BandPredecessorNoCollision q w hq hwproper (hC.trans hwchild.symm) obtain ⟨iline, hiline⟩ := hline - have wline := FordBoundaryCompatibilityGeometry.wline q w r1 hr1 - hruniq iline hiline (FordBoundaryCompatibilityGeometry.iline0 q hcurv iline hiline) + have wline := FordBoundaryCompatibilityGeometry.wline q w r1 hr1 iline hiline + (FordBoundaryCompatibilityGeometry.iline0 q hcurv iline hiline) obtain ⟨r2, g2, P2, hP2, hg2, hw2, hz2, heq2⟩ := FordRegimeConverse w hwproper wline let barq : Fin 4 → CircleCoordinates := diff --git a/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean index 88b7736c50..cd1ac5209a 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean @@ -50,12 +50,15 @@ private theorem squareCell : (by classical exact - (FordFareyParameter) → ((BandCircle) → ((Fin 3) → ((GaussianInt) → ((GaussianInt) → (∀ (n - : Nat), ∀ (v : GaussianInt), ∀ (z : GaussianInt), z ∈ (TileTranslation (FordTile n) - v).cells ↔ 0 ≤ (z - v).re ∧ (z - v).re < (n : Int) ∧ 0 ≤ (z - v).im ∧ (z - v).im < (n - : Int)))))) ) := by + ∀ (n : Nat), + ∀ (v : GaussianInt), + ∀ (z : GaussianInt), + z ∈ (TileTranslation (FordTile n) v).cells ↔ + 0 ≤ (z - v).re ∧ + (z - v).re < (n : Int) ∧ 0 ≤ (z - v).im ∧ (z - v).im < (n : Int) + ) := by classical - intro P Ci i x u n v z + intro n v z change z ∈ (FordCellDomain n).image (GaussianTranslation v) ↔ _ constructor · rintro hz @@ -418,7 +421,7 @@ theorem FordOpposingBoundaryStarLocalization have squareCell (n : Nat) (v z : GaussianInt) : z ∈ (TileTranslation (FordTile n) v).cells ↔ 0 ≤ (z - v).re ∧ (z - v).re < (n : Int) ∧ - 0 ≤ (z - v).im ∧ (z - v).im < (n : Int) := FordStarGeometry.squareCell P Ci i x u n v z + 0 ≤ (z - v).im ∧ (z - v).im < (n : Int) := FordStarGeometry.squareCell n v z have hsum : (P.q : Int) = (P.q₁ : Int) + P.q₂ := by exact_mod_cast P.sum_q have hchosen : ∃ (U V : ProtoTile) (g k : PartialOdometer), AncestorOdometer Ci.1.1 C0.1.1 U T0 g h0 ∧ diff --git a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean index 25304989d6..c0e6c141c0 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean @@ -32,19 +32,24 @@ private theorem obs : (by classical exact - (FordFareyParameter) → ( let rect : Int → Int → Int → Set GaussianInt := fun a b n => {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => - {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} - ∀ (T : ProtoTile), ∀ (a : Int), ∀ (b : Int), ∀ (n : Int), (0 < n) → ((∀ z : GaussianInt, - z ∈ T.cells ↔ - a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + n) → (FootprintVertices T = rect a b - n ∧ FootprintEdges T = edges (rect a b n)))) ) := by + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = { x, y }} + ∀ (T : ProtoTile), + ∀ (a : Int), + ∀ (b : Int), + ∀ (n : Int), + 0 < n → + (∀ z : GaussianInt, + z ∈ T.cells ↔ a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + n) → + FootprintVertices T = rect a b n ∧ + FootprintEdges T = edges (rect a b n) + ) := by classical - intro P rect adj edges T a b n hn hc + intro rect adj edges T a b n hn hc have hne : T.cells.Nonempty := ⟨⟨a,b⟩, (hc _).mpr (by dsimp; omega)⟩ have hv (z : GaussianInt) : z ∈ FootprintVertices T ↔ z ∈ rect a b n := by simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] @@ -134,17 +139,21 @@ private theorem linepath : (by classical exact - (FordFareyParameter) → ( let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => - {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} - ∀ (f : Nat → GaussianInt), ∀ (n : Nat), (0 < n) → ((Function.Injective f) → ((∀ k, adj (f - k) (f (k+1))) → ((∀ j, ∀ k, adj (f j) (f k) → k = j+1 ∨ j = k+1) → - (SimpleGridPathBetween (f '' Set.Icc 0 n) (edges (f '' Set.Icc 0 n)) (f 0) (f n)))))) - ) := by + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = { x, y }} + ∀ (f : Nat → GaussianInt), + ∀ (n : Nat), + 0 < n → + Function.Injective f → + (∀ k, adj (f k) (f (k + 1))) → + (∀ j, ∀ k, adj (f j) (f k) → k = j + 1 ∨ j = k + 1) → + SimpleGridPathBetween (f '' Set.Icc 0 n) (edges (f '' Set.Icc 0 n)) + (f 0) (f n) + ) := by classical - intro P adj edges f n hn hf hs ha + intro adj edges f n hn hf hs ha let p := (List.range (n+1)).map f have hm (z : GaussianInt) : z ∈ p ↔ z ∈ f '' Set.Icc 0 n := by simp [p] @@ -184,19 +193,28 @@ private theorem horizontal : (by classical exact - (FordFareyParameter) → ( let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => - {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} - (∀ (f : Nat → GaussianInt), ∀ (n : Nat), (0 < n) → ((Function.Injective f) → ((∀ k, adj - (f k) (f (k+1))) → ((∀ j, ∀ k, adj (f j) (f k) → k = j+1 ∨ j = k+1) → - (SimpleGridPathBetween (f '' Set.Icc 0 n) (edges (f '' Set.Icc 0 n)) (f 0) (f n)))))) - → (∀ (l : Int), ∀ (h : Int), ∀ (b : Int), (l < h) → (SimpleGridPathBetween {z : - GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = b} (edges {z : GaussianInt | l ≤ z.re ∧ - z.re ≤ h ∧ z.im = b}) ⟨l,b⟩ ⟨h,b⟩))) ) := by + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = { x, y }} + (∀ (f : Nat → GaussianInt), + ∀ (n : Nat), + 0 < n → + Function.Injective f → + (∀ k, adj (f k) (f (k + 1))) → + (∀ j, ∀ k, adj (f j) (f k) → k = j + 1 ∨ j = k + 1) → + SimpleGridPathBetween (f '' Set.Icc 0 n) (edges (f '' Set.Icc 0 n)) + (f 0) (f n)) → + ∀ (l : Int), + ∀ (h : Int), + ∀ (b : Int), + l < h → + SimpleGridPathBetween {z : GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = b} + (edges {z : GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = b}) ⟨l, b⟩ + ⟨h, b⟩ + ) := by classical - intro P adj edges linepath l h b hlh + intro adj edges linepath l h b hlh let f := fun k : Nat => (⟨l+k,b⟩ : GaussianInt) let n := (h-l).toNat have hn : (n : Int) = h-l := by dsimp [n]; omega @@ -219,19 +237,28 @@ private theorem vertical : (by classical exact - (FordFareyParameter) → ( let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => - {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} - (∀ (f : Nat → GaussianInt), ∀ (n : Nat), (0 < n) → ((Function.Injective f) → ((∀ k, adj - (f k) (f (k+1))) → ((∀ j, ∀ k, adj (f j) (f k) → k = j+1 ∨ j = k+1) → - (SimpleGridPathBetween (f '' Set.Icc 0 n) (edges (f '' Set.Icc 0 n)) (f 0) (f n)))))) - → (∀ (l : Int), ∀ (h : Int), ∀ (a : Int), (l < h) → (SimpleGridPathBetween {z : - GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = a} (edges {z : GaussianInt | l ≤ z.im ∧ - z.im ≤ h ∧ z.re = a}) ⟨a,l⟩ ⟨a,h⟩))) ) := by + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = { x, y }} + (∀ (f : Nat → GaussianInt), + ∀ (n : Nat), + 0 < n → + Function.Injective f → + (∀ k, adj (f k) (f (k + 1))) → + (∀ j, ∀ k, adj (f j) (f k) → k = j + 1 ∨ j = k + 1) → + SimpleGridPathBetween (f '' Set.Icc 0 n) (edges (f '' Set.Icc 0 n)) + (f 0) (f n)) → + ∀ (l : Int), + ∀ (h : Int), + ∀ (a : Int), + l < h → + SimpleGridPathBetween {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = a} + (edges {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = a}) ⟨a, l⟩ + ⟨a, h⟩ + ) := by classical - intro P adj edges linepath l h a hlh + intro adj edges linepath l h a hlh let f := fun k : Nat => (⟨a,l+k⟩ : GaussianInt) let n := (h-l).toNat have hn : (n : Int) = h-l := by dsimp [n]; omega @@ -256,10 +283,12 @@ private theorem fordcell : (by classical exact - (FordFareyParameter) → (∀ (n : Nat), ∀ (z : GaussianInt), z ∈ (FordTile n).cells ↔ 0 ≤ - z.re ∧ z.re < n ∧ 0 ≤ z.im ∧ z.im < n) ) := by + ∀ (n : Nat), + ∀ (z : GaussianInt), + z ∈ (FordTile n).cells ↔ 0 ≤ z.re ∧ z.re < n ∧ 0 ≤ z.im ∧ z.im < n + ) := by classical - intro P n z + intro n z change z ∈ ((Finset.range n).product (Finset.range n)).image (fun a => (⟨(a.1:Int),(a.2:Int)⟩ : GaussianInt)) ↔ _ rw [Finset.mem_image] @@ -278,14 +307,18 @@ private theorem sqcell : (by classical exact - (FordFareyParameter) → ((∀ (n : Nat), ∀ (z : GaussianInt), z ∈ (FordTile n).cells ↔ 0 ≤ - z.re ∧ z.re < n ∧ 0 ≤ z.im ∧ z.im < n) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - ∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (z : GaussianInt), z ∈ (sq n a b).cells ↔ a ≤ - z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n)) ) := by + (∀ (n : Nat), + ∀ (z : GaussianInt), + z ∈ (FordTile n).cells ↔ 0 ≤ z.re ∧ z.re < n ∧ 0 ≤ z.im ∧ z.im < n) → + let sq := fun n : Nat => fun a b : Int => TileTranslation (FordTile n) ⟨a, b⟩ + ∀ (n : Nat), + ∀ (a : Int), + ∀ (b : Int), + ∀ (z : GaussianInt), + z ∈ (sq n a b).cells ↔ a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + n + ) := by classical - intro P fordcell sq n a b z + intro fordcell sq n a b z change z ∈ (FordTile n).cells.image (GaussianTranslation ⟨a,b⟩) ↔ _ constructor · rintro hz @@ -300,11 +333,14 @@ private theorem fordcent : (by classical exact - (FordFareyParameter) → ((∀ (n : Nat), ∀ (z : GaussianInt), z ∈ (FordTile n).cells ↔ 0 ≤ - z.re ∧ z.re < n ∧ 0 ≤ z.im ∧ z.im < n) → (∀ (n : Nat), (0 < n) → (TileCentroid - (FordTile n) = ((n:Real)/2,(n:Real)/2)))) ) := by + (∀ (n : Nat), + ∀ (z : GaussianInt), + z ∈ (FordTile n).cells ↔ 0 ≤ z.re ∧ z.re < n ∧ 0 ≤ z.im ∧ z.im < n) → + ∀ (n : Nat), + 0 < n → TileCentroid (FordTile n) = ((n : Real) / 2, (n : Real) / 2) + ) := by classical - intro P fordcell n hn + intro fordcell n hn let R := TileTranslation (TileQuarterTurn (FordTile n)) ⟨n,0⟩ have hc : R.cells = (FordTile n).cells := by ext z @@ -415,37 +451,85 @@ private theorem ledger0 : (by classical exact - (FordFareyParameter) → ( let rect : Int → Int → Int → Set GaussianInt := fun a b n => {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => - {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} - (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ - {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween V E y x)) - → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), (0 < n) → (FootprintVertices (sq n a b) = rect a - b n ∧ FootprintEdges (sq n a b) = edges (rect a b n))) → ((∀ (n : Nat), ∀ (m : Nat), - ∀ (a : Int), ∀ (b : Int), ∀ (c : Int), ∀ (d : Int), ∀ (l : Int), ∀ (h : Int), ∀ (y : - Int), (0 < n) → ((0 < m) → ((l < h) → ((rect a b n ∩ rect c d m = {z : GaussianInt | - l ≤ z.re ∧ z.re ≤ h ∧ z.im = y}) → (SimpleGridPathBetween (FootprintVertices (sq n a - b) ∩ FootprintVertices (sq m c d)) (FootprintEdges (sq n a b) ∩ FootprintEdges (sq m - c d)) ⟨l,y⟩ ⟨h,y⟩))))) → ((∀ (n : Nat), ∀ (m : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (c : - Int), ∀ (d : Int), ∀ (l : Int), ∀ (h : Int), ∀ (x : Int), (0 < n) → ((0 < m) → ((l < - h) → ((rect a b n ∩ rect c d m = {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = x}) - → (SimpleGridPathBetween (FootprintVertices (sq n a b) ∩ FootprintVertices (sq m c - d)) (FootprintEdges (sq n a b) ∩ FootprintEdges (sq m c d)) ⟨x,l⟩ ⟨x,h⟩))))) → (∀ (r - : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∃ R : ExactTileInterfaceTriple (sq (r+s) 0 - 0) (sq (r+s) (-(s:Int)) (-(r+s:Int))) (sq s (-(s:Int)) 0), ∃ I : - ExactTileInterfaceTriple (sq (r+s) 0 0) (sq (r+s) (-(r+s:Int)) s) (sq s (-(s:Int)) - 0), ∃ A : ExactTileInterfaceTriple (sq (r+s) 0 0) (sq s (-(s:Int)) 0) (sq r - (-(r:Int)) s), R.point = ⟨0,0⟩ ∧ I.point = ⟨0,s⟩ ∧ A.point = ⟨0,s⟩ ∧ R.otherCA = - ⟨0,s⟩ ∧ I.otherCA = ⟨0,0⟩ ∧ A.otherAB = ⟨0,0⟩ ∧ A.otherCA = ⟨0,r+s⟩))))))) ) := by + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = { x, y }} + (∀ {V : Set GaussianInt}, + ∀ {E : Set (Finset GaussianInt)}, + ∀ {x : GaussianInt}, + ∀ {y : GaussianInt}, + SimpleGridPathBetween V E x y → SimpleGridPathBetween V E y x) → + let sq := fun n : Nat => fun a b : Int => TileTranslation (FordTile n) ⟨a, b⟩ + (∀ (n : Nat), + ∀ (a : Int), + ∀ (b : Int), + 0 < n → + FootprintVertices (sq n a b) = rect a b n ∧ + FootprintEdges (sq n a b) = edges (rect a b n)) → + (∀ (n : Nat), + ∀ (m : Nat), + ∀ (a : Int), + ∀ (b : Int), + ∀ (c : Int), + ∀ (d : Int), + ∀ (l : Int), + ∀ (h : Int), + ∀ (y : Int), + 0 < n → + 0 < m → + l < h → + rect a b n ∩ rect c d m = + {z : GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = y} → + SimpleGridPathBetween + (FootprintVertices (sq n a b) ∩ + FootprintVertices (sq m c d)) + (FootprintEdges (sq n a b) ∩ FootprintEdges (sq m c d)) + ⟨l, y⟩ ⟨h, y⟩) → + (∀ (n : Nat), + ∀ (m : Nat), + ∀ (a : Int), + ∀ (b : Int), + ∀ (c : Int), + ∀ (d : Int), + ∀ (l : Int), + ∀ (h : Int), + ∀ (x : Int), + 0 < n → + 0 < m → + l < h → + rect a b n ∩ rect c d m = + {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = x} → + SimpleGridPathBetween + (FootprintVertices (sq n a b) ∩ + FootprintVertices (sq m c d)) + (FootprintEdges (sq n a b) ∩ FootprintEdges (sq m c d)) + ⟨x, l⟩ ⟨x, h⟩) → + ∀ (r : Nat), + ∀ (s : Nat), + 0 < r → + 0 < s → + ∃ R : + ExactTileInterfaceTriple (sq (r + s) 0 0) + (sq (r + s) (-(s : Int)) (-(r + s : Int))) + (sq s (-(s : Int)) 0), + ∃ I : + ExactTileInterfaceTriple (sq (r + s) 0 0) + (sq (r + s) (-(r + s : Int)) s) (sq s (-(s : Int)) 0), + ∃ A : + ExactTileInterfaceTriple (sq (r + s) 0 0) + (sq s (-(s : Int)) 0) (sq r (-(r : Int)) s), + R.point = ⟨0, 0⟩ ∧ + I.point = ⟨0, s⟩ ∧ + A.point = ⟨0, s⟩ ∧ + R.otherCA = ⟨0, s⟩ ∧ + I.otherCA = ⟨0, 0⟩ ∧ + A.otherAB = ⟨0, 0⟩ ∧ A.otherCA = ⟨0, r + s⟩ + ) := by classical - intro P rect adj edges reverse_path sq sqobs hpH hpV r s hr hs + intro rect adj edges reverse_path sq sqobs hpH hpV r s hr hs have hq : 0 < r+s := by omega have ca := hpV s (r+s) (-(s:Int)) 0 0 0 0 s 0 hs hq (by omega) (by ext z; simp only [rect, Set.mem_inter_iff, Set.mem_ofPred_eq, Nat.cast_add]; omega) @@ -507,43 +591,104 @@ private theorem ledger1 : (by classical exact - (FordFareyParameter) → ( let rect : Int → Int → Int → Set GaussianInt := fun a b n => {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => - {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} - (∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ - {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween V E y x)) - → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), (0 < n) → (FootprintVertices (sq n a b) = rect a - b n ∧ FootprintEdges (sq n a b) = edges (rect a b n))) → ((∀ (n : Nat), ∀ (m : Nat), - ∀ (a : Int), ∀ (b : Int), ∀ (c : Int), ∀ (d : Int), ∀ (l : Int), ∀ (h : Int), ∀ (y : - Int), (0 < n) → ((0 < m) → ((l < h) → ((rect a b n ∩ rect c d m = {z : GaussianInt | - l ≤ z.re ∧ z.re ≤ h ∧ z.im = y}) → (SimpleGridPathBetween (FootprintVertices (sq n a - b) ∩ FootprintVertices (sq m c d)) (FootprintEdges (sq n a b) ∩ FootprintEdges (sq m - c d)) ⟨l,y⟩ ⟨h,y⟩))))) → ((∀ (n : Nat), ∀ (m : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (c : - Int), ∀ (d : Int), ∀ (l : Int), ∀ (h : Int), ∀ (x : Int), (0 < n) → ((0 < m) → ((l < - h) → ((rect a b n ∩ rect c d m = {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = x}) - → (SimpleGridPathBetween (FootprintVertices (sq n a b) ∩ FootprintVertices (sq m c - d)) (FootprintEdges (sq n a b) ∩ FootprintEdges (sq m c d)) ⟨x,l⟩ ⟨x,h⟩))))) → ((∀ (r - : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∃ R : ExactTileInterfaceTriple (sq (r+s) 0 - 0) (sq (r+s) (-(s:Int)) (-(r+s:Int))) (sq s (-(s:Int)) 0), ∃ I : - ExactTileInterfaceTriple (sq (r+s) 0 0) (sq (r+s) (-(r+s:Int)) s) (sq s (-(s:Int)) - 0), ∃ A : ExactTileInterfaceTriple (sq (r+s) 0 0) (sq s (-(s:Int)) 0) (sq r - (-(r:Int)) s), R.point = ⟨0,0⟩ ∧ I.point = ⟨0,s⟩ ∧ A.point = ⟨0,s⟩ ∧ R.otherCA = - ⟨0,s⟩ ∧ I.otherCA = ⟨0,0⟩ ∧ A.otherAB = ⟨0,0⟩ ∧ A.otherCA = ⟨0,r+s⟩))) → (∀ (r : - Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∃ R : ExactTileInterfaceTriple (sq (r+s) 0 - 0) (sq (r+s) (-(r:Int)) (r+s)) (sq r (-(r:Int)) s), ∃ I : ExactTileInterfaceTriple - (sq (r+s) 0 0) (sq (r+s) (-(r+s:Int)) (-(r:Int))) (sq r (-(r:Int)) s), ∃ A : - ExactTileInterfaceTriple (sq (r+s) 0 0) (sq r (-(r:Int)) s) (sq s (-(s:Int)) 0), - R.point = ⟨0,r+s⟩ ∧ I.point = ⟨0,s⟩ ∧ A.point = ⟨0,s⟩ ∧ R.otherCA = ⟨0,s⟩ ∧ I.otherCA - = ⟨0,r+s⟩ ∧ A.otherAB = ⟨0,r+s⟩)))))))) ) := by + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = { x, y }} + (∀ {V : Set GaussianInt}, + ∀ {E : Set (Finset GaussianInt)}, + ∀ {x : GaussianInt}, + ∀ {y : GaussianInt}, + SimpleGridPathBetween V E x y → SimpleGridPathBetween V E y x) → + let sq := fun n : Nat => fun a b : Int => TileTranslation (FordTile n) ⟨a, b⟩ + (∀ (n : Nat), + ∀ (a : Int), + ∀ (b : Int), + 0 < n → + FootprintVertices (sq n a b) = rect a b n ∧ + FootprintEdges (sq n a b) = edges (rect a b n)) → + (∀ (n : Nat), + ∀ (m : Nat), + ∀ (a : Int), + ∀ (b : Int), + ∀ (c : Int), + ∀ (d : Int), + ∀ (l : Int), + ∀ (h : Int), + ∀ (y : Int), + 0 < n → + 0 < m → + l < h → + rect a b n ∩ rect c d m = + {z : GaussianInt | l ≤ z.re ∧ z.re ≤ h ∧ z.im = y} → + SimpleGridPathBetween + (FootprintVertices (sq n a b) ∩ + FootprintVertices (sq m c d)) + (FootprintEdges (sq n a b) ∩ FootprintEdges (sq m c d)) + ⟨l, y⟩ ⟨h, y⟩) → + (∀ (n : Nat), + ∀ (m : Nat), + ∀ (a : Int), + ∀ (b : Int), + ∀ (c : Int), + ∀ (d : Int), + ∀ (l : Int), + ∀ (h : Int), + ∀ (x : Int), + 0 < n → + 0 < m → + l < h → + rect a b n ∩ rect c d m = + {z : GaussianInt | l ≤ z.im ∧ z.im ≤ h ∧ z.re = x} → + SimpleGridPathBetween + (FootprintVertices (sq n a b) ∩ + FootprintVertices (sq m c d)) + (FootprintEdges (sq n a b) ∩ FootprintEdges (sq m c d)) + ⟨x, l⟩ ⟨x, h⟩) → + (∀ (r : Nat), + ∀ (s : Nat), + 0 < r → + 0 < s → + ∃ R : + ExactTileInterfaceTriple (sq (r + s) 0 0) + (sq (r + s) (-(s : Int)) (-(r + s : Int))) + (sq s (-(s : Int)) 0), + ∃ I : + ExactTileInterfaceTriple (sq (r + s) 0 0) + (sq (r + s) (-(r + s : Int)) s) (sq s (-(s : Int)) 0), + ∃ A : + ExactTileInterfaceTriple (sq (r + s) 0 0) + (sq s (-(s : Int)) 0) (sq r (-(r : Int)) s), + R.point = ⟨0, 0⟩ ∧ + I.point = ⟨0, s⟩ ∧ + A.point = ⟨0, s⟩ ∧ + R.otherCA = ⟨0, s⟩ ∧ + I.otherCA = ⟨0, 0⟩ ∧ + A.otherAB = ⟨0, 0⟩ ∧ A.otherCA = ⟨0, r + s⟩) → + ∀ (r : Nat), + ∀ (s : Nat), + 0 < r → + 0 < s → + ∃ R : + ExactTileInterfaceTriple (sq (r + s) 0 0) + (sq (r + s) (-(r : Int)) (r + s)) (sq r (-(r : Int)) s), + ∃ I : + ExactTileInterfaceTriple (sq (r + s) 0 0) + (sq (r + s) (-(r + s : Int)) (-(r : Int))) + (sq r (-(r : Int)) s), + ∃ A : + ExactTileInterfaceTriple (sq (r + s) 0 0) + (sq r (-(r : Int)) s) (sq s (-(s : Int)) 0), + R.point = ⟨0, r + s⟩ ∧ + I.point = ⟨0, s⟩ ∧ + A.point = ⟨0, s⟩ ∧ + R.otherCA = ⟨0, s⟩ ∧ + I.otherCA = ⟨0, r + s⟩ ∧ A.otherAB = ⟨0, r + s⟩ + ) := by classical - intro P rect adj edges reverse_path sq sqobs hpH hpV ledger0 r s hr hs + intro rect adj edges reverse_path sq sqobs hpH hpV ledger0 r s hr hs have hq : 0 < r+s := by omega have ca := hpV r (r+s) (-(r:Int)) s 0 0 s (r+s) 0 hr hq (by omega) (by ext z; simp only [rect, Set.mem_inter_iff, Set.mem_ofPred_eq, Nat.cast_add]; omega) @@ -590,26 +735,43 @@ private theorem base0 : (by classical exact - (FordFareyParameter) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - (∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∃ R : ExactTileInterfaceTriple (sq (r+s) - 0 0) (sq (r+s) (-(s:Int)) (-(r+s:Int))) (sq s (-(s:Int)) 0), ∃ I : - ExactTileInterfaceTriple (sq (r+s) 0 0) (sq (r+s) (-(r+s:Int)) s) (sq s (-(s:Int)) - 0), ∃ A : ExactTileInterfaceTriple (sq (r+s) 0 0) (sq s (-(s:Int)) 0) (sq r - (-(r:Int)) s), R.point = ⟨0,0⟩ ∧ I.point = ⟨0,s⟩ ∧ A.point = ⟨0,s⟩ ∧ R.otherCA = - ⟨0,s⟩ ∧ I.otherCA = ⟨0,0⟩ ∧ A.otherAB = ⟨0,0⟩ ∧ A.otherCA = ⟨0,r+s⟩))) → ( - let package := fun U UR UL W Z : ProtoTile => - ∃ R : ExactTileInterfaceTriple U UR W, - ∃ I : ExactTileInterfaceTriple U UL W, - ∃ A : ExactTileInterfaceTriple U W Z, - R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ - I.otherCA = R.point ∧ A.otherAB = R.point - ∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (package (sq (r+s) 0 0) (sq (r+s) - (-(s:Int)) (-(r+s:Int))) (sq (r+s) (-(r+s:Int)) s) (sq s (-(s:Int)) 0) (sq r - (-(r:Int)) s))))) ) := by + let sq := fun n : Nat => fun a b : Int => TileTranslation (FordTile n) ⟨a, b⟩ + (∀ (r : Nat), + ∀ (s : Nat), + 0 < r → + 0 < s → + ∃ R : + ExactTileInterfaceTriple (sq (r + s) 0 0) + (sq (r + s) (-(s : Int)) (-(r + s : Int))) (sq s (-(s : Int)) 0), + ∃ I : + ExactTileInterfaceTriple (sq (r + s) 0 0) + (sq (r + s) (-(r + s : Int)) s) (sq s (-(s : Int)) 0), + ∃ A : + ExactTileInterfaceTriple (sq (r + s) 0 0) (sq s (-(s : Int)) 0) + (sq r (-(r : Int)) s), + R.point = ⟨0, 0⟩ ∧ + I.point = ⟨0, s⟩ ∧ + A.point = ⟨0, s⟩ ∧ + R.otherCA = ⟨0, s⟩ ∧ + I.otherCA = ⟨0, 0⟩ ∧ + A.otherAB = ⟨0, 0⟩ ∧ A.otherCA = ⟨0, r + s⟩) → + let package := fun U UR UL W Z : ProtoTile => + ∃ R : ExactTileInterfaceTriple U UR W, + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ + A.point = I.point ∧ + R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = R.point + ∀ (r : Nat), + ∀ (s : Nat), + 0 < r → + 0 < s → + package (sq (r + s) 0 0) (sq (r + s) (-(s : Int)) (-(r + s : Int))) + (sq (r + s) (-(r + s : Int)) s) (sq s (-(s : Int)) 0) + (sq r (-(r : Int)) s) + ) := by classical - intro P sq ledger0 package r s hr hs + intro sq ledger0 package r s hr hs obtain ⟨R,I,A,hR,hI,hA,hRC,hIC,hAB,_⟩ := ledger0 r s hr hs refine ⟨R,I,A,?_,hA.trans hI.symm,hRC.trans hI.symm, hIC.trans hR.symm,hAB.trans hR.symm⟩ @@ -623,26 +785,42 @@ private theorem base1 : (by classical exact - (FordFareyParameter) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - (∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∃ R : ExactTileInterfaceTriple (sq (r+s) - 0 0) (sq (r+s) (-(r:Int)) (r+s)) (sq r (-(r:Int)) s), ∃ I : ExactTileInterfaceTriple - (sq (r+s) 0 0) (sq (r+s) (-(r+s:Int)) (-(r:Int))) (sq r (-(r:Int)) s), ∃ A : - ExactTileInterfaceTriple (sq (r+s) 0 0) (sq r (-(r:Int)) s) (sq s (-(s:Int)) 0), - R.point = ⟨0,r+s⟩ ∧ I.point = ⟨0,s⟩ ∧ A.point = ⟨0,s⟩ ∧ R.otherCA = ⟨0,s⟩ ∧ I.otherCA - = ⟨0,r+s⟩ ∧ A.otherAB = ⟨0,r+s⟩))) → ( - let package := fun U UR UL W Z : ProtoTile => - ∃ R : ExactTileInterfaceTriple U UR W, - ∃ I : ExactTileInterfaceTriple U UL W, - ∃ A : ExactTileInterfaceTriple U W Z, - R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ - I.otherCA = R.point ∧ A.otherAB = R.point - ∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (package (sq (r+s) 0 0) (sq (r+s) - (-(r:Int)) (r+s)) (sq (r+s) (-(r+s:Int)) (-(r:Int))) (sq r (-(r:Int)) s) (sq s - (-(s:Int)) 0))))) ) := by + let sq := fun n : Nat => fun a b : Int => TileTranslation (FordTile n) ⟨a, b⟩ + (∀ (r : Nat), + ∀ (s : Nat), + 0 < r → + 0 < s → + ∃ R : + ExactTileInterfaceTriple (sq (r + s) 0 0) + (sq (r + s) (-(r : Int)) (r + s)) (sq r (-(r : Int)) s), + ∃ I : + ExactTileInterfaceTriple (sq (r + s) 0 0) + (sq (r + s) (-(r + s : Int)) (-(r : Int))) (sq r (-(r : Int)) s), + ∃ A : + ExactTileInterfaceTriple (sq (r + s) 0 0) (sq r (-(r : Int)) s) + (sq s (-(s : Int)) 0), + R.point = ⟨0, r + s⟩ ∧ + I.point = ⟨0, s⟩ ∧ + A.point = ⟨0, s⟩ ∧ + R.otherCA = ⟨0, s⟩ ∧ + I.otherCA = ⟨0, r + s⟩ ∧ A.otherAB = ⟨0, r + s⟩) → + let package := fun U UR UL W Z : ProtoTile => + ∃ R : ExactTileInterfaceTriple U UR W, + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ + A.point = I.point ∧ + R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = R.point + ∀ (r : Nat), + ∀ (s : Nat), + 0 < r → + 0 < s → + package (sq (r + s) 0 0) (sq (r + s) (-(r : Int)) (r + s)) + (sq (r + s) (-(r + s : Int)) (-(r : Int))) (sq r (-(r : Int)) s) + (sq s (-(s : Int)) 0) + ) := by classical - intro P sq ledger1 package r s hr hs + intro sq ledger1 package r s hr hs obtain ⟨R,I,A,hR,hI,hA,hRC,hIC,hAB⟩ := ledger1 r s hr hs refine ⟨R,I,A,?_,hA.trans hI.symm,hRC.trans hI.symm, hIC.trans hR.symm,hAB.trans hR.symm⟩ @@ -656,27 +834,48 @@ private theorem sameobs : (by classical exact - (FordFareyParameter) → ( let rect : Int → Int → Int → Set GaussianInt := fun a b n => {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => - {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} - (∀ (T : ProtoTile), ∀ (a : Int), ∀ (b : Int), ∀ (n : Int), (0 < n) → ((∀ z : GaussianInt, - z ∈ T.cells ↔ a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + n) → (FootprintVertices - T = rect a b n ∧ FootprintEdges T = edges (rect a b n)))) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ - (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (z : GaussianInt), z ∈ (sq n a b).cells ↔ a ≤ - z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n) → ((∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), - (0 < n) → ((sq n a b).cells.Nonempty)) → ((∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), (0 - < n) → (TileCentroid (sq n a b) = ((a:Real)+(n:Real)/2,(b:Real)+(n:Real)/2))) → (∀ (T - : ProtoTile), ∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), (0 < n) → ((T.cells = (sq n a - b).cells) → (FootprintVertices T = rect a b n ∧ FootprintEdges T = edges (rect a b n) - ∧ TileCentroid T = ((a:Real)+(n:Real)/2,(b:Real)+(n:Real)/2)))))))) ) := by + {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = { x, y }} + (∀ (T : ProtoTile), + ∀ (a : Int), + ∀ (b : Int), + ∀ (n : Int), + 0 < n → + (∀ z : GaussianInt, + z ∈ T.cells ↔ a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + n) → + FootprintVertices T = rect a b n ∧ + FootprintEdges T = edges (rect a b n)) → + let sq := fun n : Nat => fun a b : Int => TileTranslation (FordTile n) ⟨a, b⟩ + (∀ (n : Nat), + ∀ (a : Int), + ∀ (b : Int), + ∀ (z : GaussianInt), + z ∈ (sq n a b).cells ↔ + a ≤ z.re ∧ z.re < a + n ∧ b ≤ z.im ∧ z.im < b + n) → + (∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), 0 < n → (sq n a b).cells.Nonempty) → + (∀ (n : Nat), + ∀ (a : Int), + ∀ (b : Int), + 0 < n → + TileCentroid (sq n a b) = + ((a : Real) + (n : Real) / 2, (b : Real) + (n : Real) / 2)) → + ∀ (T : ProtoTile), + ∀ (n : Nat), + ∀ (a : Int), + ∀ (b : Int), + 0 < n → + T.cells = (sq n a b).cells → + FootprintVertices T = rect a b n ∧ + FootprintEdges T = edges (rect a b n) ∧ + TileCentroid T = + ((a : Real) + (n : Real) / 2, (b : Real) + (n : Real) / 2) + ) := by classical - intro P rect adj edges obs sq sqcell sqne sqcent T n a b hn hc + intro rect adj edges obs sq sqcell sqne sqcent T n a b hn hc have h := obs T a b n (by omega) (by intro z; rw [hc]; exact sqcell n a b z) have ht : T.cells.Nonempty := hc ▸ sqne n a b hn refine ⟨h.1,h.2,?_⟩ @@ -763,38 +962,75 @@ private theorem finish0 : (by classical exact - (FordFareyParameter) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ + let sq := fun n : Nat => fun a b : Int => TileTranslation (FordTile n) ⟨a, b⟩ let package := fun U UR UL W Z : ProtoTile => ∃ R : ExactTileInterfaceTriple U UR W, - ∃ I : ExactTileInterfaceTriple U UL W, - ∃ A : ExactTileInterfaceTriple U W Z, - R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ - I.otherCA = R.point ∧ A.otherAB = R.point - (∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (package (sq (r+s) 0 0) (sq (r+s) - (-(s:Int)) (-(r+s:Int))) (sq (r+s) (-(r+s:Int)) s) (sq s (-(s:Int)) 0) (sq r - (-(r:Int)) s)))) → ( - let ax := fun (q : Int) (flip : Bool) (t a n : Int) => - (if flip then q-a-n else a)+t - (∀ (q : Int), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin 5 → Nat), ∀ (X : Fin 5 → - Int), ∀ (Y : Fin 5 → Int), (∀ k, 0 < N k) → (∀ (T : Fin 5 → ProtoTile), (∀ k, (T - k).cells = (sq (N k) (ax q flip t.re (X k) (N k)) (ax q flip t.im (Y k) (N - k))).cells) → ((package (sq (N 0) (X 0) (Y 0)) (sq (N 1) (X 1) (Y 1)) (sq (N 2) (X 2) - (Y 2)) (sq (N 3) (X 3) (Y 3)) (sq (N 4) (X 4) (Y 4))) → (package (T 0) (T 1) (T 2) (T - 3) (T 4))))) → ((∀ (T : ProtoTile), ∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (u : - GaussianInt), (T.cells = (sq n a b).cells) → ((TileTranslation T u).cells = (sq n - (a+u.re) (b+u.im)).cells)) → (∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∀ (a : - Int), ∀ (b : Int), ∀ (flip : Bool), ∀ (U : ProtoTile), ∀ (W : ProtoTile), ∀ (Z : - ProtoTile), (U.cells = (sq (r+s) a b).cells) → ((W.cells = (sq s (if flip then - a+(r+s:Int) else a-s) - (if flip then b+r else b)).cells) → ((Z.cells = (sq r (if flip then a+(r+s:Int) else - a-r) - (if flip then b else b+s)).cells) → (package U (TileTranslation U (if flip then - ⟨s,r+s⟩ else ⟨-(s:Int),-(r+s:Int)⟩)) (TileTranslation U (if flip then - ⟨r+s,-(s:Int)⟩ else ⟨-(r+s:Int),s⟩)) W Z))))))))) ) := by + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ + A.point = I.point ∧ + R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = R.point + (∀ (r : Nat), + ∀ (s : Nat), + 0 < r → + 0 < s → + package (sq (r + s) 0 0) (sq (r + s) (-(s : Int)) (-(r + s : Int))) + (sq (r + s) (-(r + s : Int)) s) (sq s (-(s : Int)) 0) + (sq r (-(r : Int)) s)) → + let ax := fun (q : Int) (flip : Bool) (t a n : Int) => + (if flip then q - a - n else a) + t + (∀ (q : Int), + ∀ (flip : Bool), + ∀ (t : GaussianInt), + ∀ (N : Fin 5 → Nat), + ∀ (X : Fin 5 → Int), + ∀ (Y : Fin 5 → Int), + (∀ k, 0 < N k) → + ∀ (T : Fin 5 → ProtoTile), + (∀ k, + (T k).cells = + (sq (N k) (ax q flip t.re (X k) (N k)) + (ax q flip t.im (Y k) (N k))).cells) → + package (sq (N 0) (X 0) (Y 0)) (sq (N 1) (X 1) (Y 1)) + (sq (N 2) (X 2) (Y 2)) (sq (N 3) (X 3) (Y 3)) + (sq (N 4) (X 4) (Y 4)) → + package (T 0) (T 1) (T 2) (T 3) (T 4)) → + (∀ (T : ProtoTile), + ∀ (n : Nat), + ∀ (a : Int), + ∀ (b : Int), + ∀ (u : GaussianInt), + T.cells = (sq n a b).cells → + (TileTranslation T u).cells = + (sq n (a + u.re) (b + u.im)).cells) → + ∀ (r : Nat), + ∀ (s : Nat), + 0 < r → + 0 < s → + ∀ (a : Int), + ∀ (b : Int), + ∀ (flip : Bool), + ∀ (U : ProtoTile), + ∀ (W : ProtoTile), + ∀ (Z : ProtoTile), + U.cells = (sq (r + s) a b).cells → + W.cells = + (sq s (if flip then a + (r + s : Int) else a - s) + (if flip then b + r else b)).cells → + Z.cells = + (sq r (if flip then a + (r + s : Int) else a - r) + (if flip then b else b + s)).cells → + package U + (TileTranslation U + (if flip then ⟨s, r + s⟩ + else ⟨-(s : Int), -(r + s : Int)⟩)) + (TileTranslation U + (if flip then ⟨r + s, -(s : Int)⟩ + else ⟨-(r + s : Int), s⟩)) + W Z + ) := by classical - intro P sq package base0 ax carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ + intro sq package base0 ax carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ refine carry_squares (r+s) flip ⟨a,b⟩ ![r+s,r+s,r+s,s,r] ![0,-(s:Int),-(r+s:Int),-(s:Int),-(r:Int)] ![0,-(r+s:Int),s,0,s] ?_ @@ -818,38 +1054,75 @@ private theorem finish1 : (by classical exact - (FordFareyParameter) → ( - let sq := fun n : Nat => fun a b : Int => - TileTranslation (FordTile n) ⟨a,b⟩ + let sq := fun n : Nat => fun a b : Int => TileTranslation (FordTile n) ⟨a, b⟩ let package := fun U UR UL W Z : ProtoTile => ∃ R : ExactTileInterfaceTriple U UR W, - ∃ I : ExactTileInterfaceTriple U UL W, - ∃ A : ExactTileInterfaceTriple U W Z, - R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ - I.otherCA = R.point ∧ A.otherAB = R.point - (∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (package (sq (r+s) 0 0) (sq (r+s) - (-(r:Int)) (r+s)) (sq (r+s) (-(r+s:Int)) (-(r:Int))) (sq r (-(r:Int)) s) (sq s - (-(s:Int)) 0)))) → ( - let ax := fun (q : Int) (flip : Bool) (t a n : Int) => - (if flip then q-a-n else a)+t - (∀ (q : Int), ∀ (flip : Bool), ∀ (t : GaussianInt), ∀ (N : Fin 5 → Nat), ∀ (X : Fin 5 → - Int), ∀ (Y : Fin 5 → Int), (∀ k, 0 < N k) → (∀ (T : Fin 5 → ProtoTile), (∀ k, (T - k).cells = (sq (N k) (ax q flip t.re (X k) (N k)) (ax q flip t.im (Y k) (N - k))).cells) → ((package (sq (N 0) (X 0) (Y 0)) (sq (N 1) (X 1) (Y 1)) (sq (N 2) (X 2) - (Y 2)) (sq (N 3) (X 3) (Y 3)) (sq (N 4) (X 4) (Y 4))) → (package (T 0) (T 1) (T 2) (T - 3) (T 4))))) → ((∀ (T : ProtoTile), ∀ (n : Nat), ∀ (a : Int), ∀ (b : Int), ∀ (u : - GaussianInt), (T.cells = (sq n a b).cells) → ((TileTranslation T u).cells = (sq n - (a+u.re) (b+u.im)).cells)) → (∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∀ (a : - Int), ∀ (b : Int), ∀ (flip : Bool), ∀ (U : ProtoTile), ∀ (W : ProtoTile), ∀ (Z : - ProtoTile), (U.cells = (sq (r+s) a b).cells) → ((W.cells = (sq r (if flip then - a+(r+s:Int) else a-r) - (if flip then b else b+s)).cells) → ((Z.cells = (sq s (if flip then a+(r+s:Int) else - a-s) - (if flip then b+r else b)).cells) → (package U (TileTranslation U (if flip then - ⟨r,-(r+s:Int)⟩ else ⟨-(r:Int),r+s⟩)) (TileTranslation U (if flip then ⟨r+s,r⟩ - else ⟨-(r+s:Int),-(r:Int)⟩)) W Z))))))))) ) := by + ∃ I : ExactTileInterfaceTriple U UL W, + ∃ A : ExactTileInterfaceTriple U W Z, + R.point ≠ I.point ∧ + A.point = I.point ∧ + R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = R.point + (∀ (r : Nat), + ∀ (s : Nat), + 0 < r → + 0 < s → + package (sq (r + s) 0 0) (sq (r + s) (-(r : Int)) (r + s)) + (sq (r + s) (-(r + s : Int)) (-(r : Int))) (sq r (-(r : Int)) s) + (sq s (-(s : Int)) 0)) → + let ax := fun (q : Int) (flip : Bool) (t a n : Int) => + (if flip then q - a - n else a) + t + (∀ (q : Int), + ∀ (flip : Bool), + ∀ (t : GaussianInt), + ∀ (N : Fin 5 → Nat), + ∀ (X : Fin 5 → Int), + ∀ (Y : Fin 5 → Int), + (∀ k, 0 < N k) → + ∀ (T : Fin 5 → ProtoTile), + (∀ k, + (T k).cells = + (sq (N k) (ax q flip t.re (X k) (N k)) + (ax q flip t.im (Y k) (N k))).cells) → + package (sq (N 0) (X 0) (Y 0)) (sq (N 1) (X 1) (Y 1)) + (sq (N 2) (X 2) (Y 2)) (sq (N 3) (X 3) (Y 3)) + (sq (N 4) (X 4) (Y 4)) → + package (T 0) (T 1) (T 2) (T 3) (T 4)) → + (∀ (T : ProtoTile), + ∀ (n : Nat), + ∀ (a : Int), + ∀ (b : Int), + ∀ (u : GaussianInt), + T.cells = (sq n a b).cells → + (TileTranslation T u).cells = + (sq n (a + u.re) (b + u.im)).cells) → + ∀ (r : Nat), + ∀ (s : Nat), + 0 < r → + 0 < s → + ∀ (a : Int), + ∀ (b : Int), + ∀ (flip : Bool), + ∀ (U : ProtoTile), + ∀ (W : ProtoTile), + ∀ (Z : ProtoTile), + U.cells = (sq (r + s) a b).cells → + W.cells = + (sq r (if flip then a + (r + s : Int) else a - r) + (if flip then b else b + s)).cells → + Z.cells = + (sq s (if flip then a + (r + s : Int) else a - s) + (if flip then b + r else b)).cells → + package U + (TileTranslation U + (if flip then ⟨r, -(r + s : Int)⟩ + else ⟨-(r : Int), r + s⟩)) + (TileTranslation U + (if flip then ⟨r + s, r⟩ + else ⟨-(r + s : Int), -(r : Int)⟩)) + W Z + ) := by classical - intro P sq package base1 ax carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ + intro sq package base1 ax carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ refine carry_squares (r+s) flip ⟨a,b⟩ ![r+s,r+s,r+s,r,s] ![0,-(r:Int),-(r+s:Int),-(r:Int),-(s:Int)] ![0,r+s,-(r:Int),s,0] ?_ @@ -873,10 +1146,10 @@ private theorem hrAt727 : (by classical exact - ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((Fin (3 : ℕ)) → ((Fin (4 : ℕ)) → (0 < - P.q₁))) ) := by + ∀ (P : FordFareyParameter), (1 : ℕ) < P.q → 0 < P.q₁ + ) := by classical - intro P hq i s + intro P hq by_contra h have hz : P.q₁ = 0 := by omega have hd := P.det₁ @@ -1273,28 +1546,28 @@ theorem FordOrientedChildParentEndpoints y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} - have obs := FordEndpointProof.obs P + have obs := FordEndpointProof.obs have edge_inter := FordEndpointProof.edge_inter -- Enumerate every vertex and every edge of a straight segment. - have linepath := FordEndpointProof.linepath P + have linepath := FordEndpointProof.linepath have reverse_path {V : Set GaussianInt} {E : Set (Finset GaussianInt)} {x y : GaussianInt} (hp : SimpleGridPathBetween V E x y) := FordEndpointProof.reverse_path (V := V) (E := E) (x := x) (y := y) hp - have fordcell := FordEndpointProof.fordcell P + have fordcell := FordEndpointProof.fordcell let sq := fun n : Nat => fun a b : Int => TileTranslation (FordTile n) ⟨a,b⟩ have sqcell (n : Nat) (a b : Int) (z : GaussianInt) : z ∈ (sq n a b).cells ↔ - a ≤ z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n := FordEndpointProof.sqcell P fordcell + a ≤ z.re ∧ z.re < a+n ∧ b ≤ z.im ∧ z.im < b+n := FordEndpointProof.sqcell fordcell n a b z have sqobs := FordEndpointAssembly.sqobs obs sqcell have sqne (n : Nat) (a b : Int) (hn : 0 < n) : (sq n a b).cells.Nonempty := ⟨⟨a,b⟩, (sqcell n a b _).mpr (by dsimp; omega)⟩ -- A centered quarter-turn determines the square's centroid without sums. - have hpH := FordEndpointProof.hpH edge_inter (FordEndpointProof.horizontal P linepath) sqobs - have hpV := FordEndpointProof.hpV edge_inter (FordEndpointProof.vertical P linepath) sqobs + have hpH := FordEndpointProof.hpH edge_inter (FordEndpointProof.horizontal linepath) sqobs + have hpV := FordEndpointProof.hpV edge_inter (FordEndpointProof.vertical linepath) sqobs -- The complete path ledger for rotation zero. - have ledger0 := FordEndpointProof.ledger0 P reverse_path sqobs hpH hpV + have ledger0 := FordEndpointProof.ledger0 reverse_path sqobs hpH hpV -- The second ledger uses the same child-parent junction with parents swapped. let package := fun U UR UL W Z : ProtoTile => ∃ R : ExactTileInterfaceTriple U UR W, @@ -1306,8 +1579,8 @@ theorem FordOrientedChildParentEndpoints (if flip then (⟨q,q⟩ : GaussianInt) - z else z) + t let ax := fun (q : Int) (flip : Bool) (t a n : Int) => (if flip then q-a-n else a)+t - have sameobs := FordEndpointProof.sameobs P obs sqcell sqne (FordEndpointProof.sqcent - (FordEndpointProof.fordcent P fordcell)) + have sameobs := FordEndpointProof.sameobs obs sqcell sqne (FordEndpointProof.sqcent + (FordEndpointProof.fordcent fordcell)) have carry_squares := FordEndpointProof.carry_squares have translate_cells := FordEndpointProof.translate_cells have finish0 (r s : Nat) (hr : 0 < r) (hs : 0 < s) (a b : Int) @@ -1320,7 +1593,7 @@ theorem FordOrientedChildParentEndpoints package U (TileTranslation U (if flip then ⟨s,r+s⟩ else ⟨-(s:Int),-(r+s:Int)⟩)) (TileTranslation U (if flip then ⟨r+s,-(s:Int)⟩ else ⟨-(r+s:Int),s⟩)) W Z := - FordEndpointProof.finish0 P (FordEndpointProof.base0 P ledger0) carry_squares + FordEndpointProof.finish0 (FordEndpointProof.base0 ledger0) carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ have finish1 (r s : Nat) (hr : 0 < r) (hs : 0 < s) (a b : Int) @@ -1333,13 +1606,13 @@ theorem FordOrientedChildParentEndpoints package U (TileTranslation U (if flip then ⟨r,-(r+s:Int)⟩ else ⟨-(r:Int),r+s⟩)) (TileTranslation U (if flip then ⟨r+s,r⟩ else ⟨-(r+s:Int),-(r:Int)⟩)) W Z := - FordEndpointProof.finish1 P (FordEndpointProof.base1 P - (FordEndpointProof.ledger1 P reverse_path sqobs hpH hpV ledger0)) carry_squares + FordEndpointProof.finish1 (FordEndpointProof.base1 + (FordEndpointProof.ledger1 reverse_path sqobs hpH hpV ledger0)) carry_squares translate_cells r s hr hs a b flip U W Z hU hW hZ dsimp only intro i s U W Z hU hW hZ hUpos hWpos hZpos hcw hcz - have hr : 0 < P.q₁ := FordEndpointProof.hrAt727 P hq i s + have hr : 0 < P.q₁ := FordEndpointProof.hrAt727 P hq have hs : 0 < P.q₂ := P.q₂_pos have hr0 : P.q₁ ≠ 0 := by omega have hqs : P.q = P.q₁ + P.q₂ := P.sum_q diff --git a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean index 2172a3a265..4dcc74a07f 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentIncomingEndpoint.lean @@ -31,12 +31,15 @@ private theorem cell : (by classical exact - (FordFareyParameter) → ( let sq := fun (n : Nat) (a : GaussianInt) => TileTranslation (FordTile n) a - ∀ (n : Nat), ∀ (a : GaussianInt), ∀ (z : GaussianInt), z ∈ (sq n a).cells ↔ a.re ≤ z.re ∧ - z.re < a.re+n ∧ a.im ≤ z.im ∧ z.im < a.im+n) ) := by + ∀ (n : Nat), + ∀ (a : GaussianInt), + ∀ (z : GaussianInt), + z ∈ (sq n a).cells ↔ + a.re ≤ z.re ∧ z.re < a.re + n ∧ a.im ≤ z.im ∧ z.im < a.im + n + ) := by classical - intro P sq n a z + intro sq n a z change z ∈ (FordTile n).cells.image (GaussianTranslation a) ↔ _ constructor · rintro hz @@ -53,14 +56,22 @@ private theorem cent : (by classical exact - (FordFareyParameter) → ( let sq := fun (n : Nat) (a : GaussianInt) => TileTranslation (FordTile n) a - (∀ (n : Nat), ∀ (a : GaussianInt), ∀ (z : GaussianInt), z ∈ (sq n a).cells ↔ a.re ≤ z.re - ∧ z.re < a.re+n ∧ a.im ≤ z.im ∧ z.im < a.im+n) → (∀ (T : ProtoTile), ∀ (n : Nat), (0 - < n) → (∀ (a : GaussianInt), (T.cells = (sq n a).cells) → (TileCentroid T = - ((a.re:Real)+(n:Real)/2,(a.im:Real)+(n:Real)/2))))) ) := by + (∀ (n : Nat), + ∀ (a : GaussianInt), + ∀ (z : GaussianInt), + z ∈ (sq n a).cells ↔ + a.re ≤ z.re ∧ z.re < a.re + n ∧ a.im ≤ z.im ∧ z.im < a.im + n) → + ∀ (T : ProtoTile), + ∀ (n : Nat), + 0 < n → + ∀ (a : GaussianInt), + T.cells = (sq n a).cells → + TileCentroid T = + ((a.re : Real) + (n : Real) / 2, (a.im : Real) + (n : Real) / 2) + ) := by classical - intro P sq cell T n hn a hc + intro sq cell T n hn a hc have hne : (sq n a).cells.Nonempty := ⟨a,(cell n a a).mpr (by omega)⟩ have ho := ProtoTileObservableExtensionality T (sq n a) hc (by intro h; rw [h] at hc; exact (hne.ne_empty hc.symm).elim) @@ -101,27 +112,59 @@ private theorem finish : (by classical exact - (FordFareyParameter) → ( let sq := fun (n : Nat) (a : GaussianInt) => TileTranslation (FordTile n) a - (∀ (n : Nat), ∀ (a : GaussianInt), ∀ (z : GaussianInt), z ∈ (sq n a).cells ↔ a.re ≤ z.re - ∧ z.re < a.re+n ∧ a.im ≤ z.im ∧ z.im < a.im+n) → ((∀ (T : ProtoTile), ∀ (n : Nat), ∀ - (a : GaussianInt), ∀ (u : GaussianInt), (T.cells = (sq n a).cells) → - ((TileTranslation T u).cells = (sq n (a+u)).cells)) → ((∀ (T : ProtoTile), ∀ (n : - Nat), (0 < n) → (∀ (a : GaussianInt), (T.cells = (sq n a).cells) → (LatticeTile T))) - → (∀ (r : Nat), ∀ (s : Nat), (0 < r) → ((0 < s) → (∀ (j : Fin 4), ∀ (flip : Bool), ∀ - (t : GaussianInt), ∀ (U : ProtoTile), ∀ (W : ProtoTile), (U.cells = (sq (r+s) - t).cells) → ((W.cells = (sq (![r,s,r,s] j) - ((if flip then (⟨r+s,r+s⟩ : GaussianInt) - - (![⟨s,r+s⟩,⟨-(s:Int),0⟩,⟨-(r:Int),s⟩,⟨r,-(s:Int)⟩] j) - - ⟨![r,s,r,s] j,![r,s,r,s] j⟩ - else (![⟨s,r+s⟩,⟨-(s:Int),0⟩,⟨-(r:Int),s⟩,⟨r,-(s:Int)⟩] j))+t)).cells) → (∀ (D : - GaussianInt), (D = if flip then - -(![⟨r+s,r⟩,⟨-(r+s:Int),s⟩,⟨-(r+s:Int),-(r:Int)⟩,⟨r+s,-(s:Int)⟩] j) - else (![⟨r+s,r⟩,⟨-(r+s:Int),s⟩,⟨-(r+s:Int),-(r:Int)⟩,⟨r+s,-(s:Int)⟩] j)) → (∃ _ : - ExactTileInterfaceTriple U (TileTranslation U D) W, TouchingTriple U - (TileTranslation U D) W))))))))) ) := by + (∀ (n : Nat), + ∀ (a : GaussianInt), + ∀ (z : GaussianInt), + z ∈ (sq n a).cells ↔ + a.re ≤ z.re ∧ z.re < a.re + n ∧ a.im ≤ z.im ∧ z.im < a.im + n) → + (∀ (T : ProtoTile), + ∀ (n : Nat), + ∀ (a : GaussianInt), + ∀ (u : GaussianInt), + T.cells = (sq n a).cells → + (TileTranslation T u).cells = (sq n (a + u)).cells) → + (∀ (T : ProtoTile), + ∀ (n : Nat), + 0 < n → ∀ (a : GaussianInt), T.cells = (sq n a).cells → LatticeTile T) → + ∀ (r : Nat), + ∀ (s : Nat), + 0 < r → + 0 < s → + ∀ (j : Fin 4), + ∀ (flip : Bool), + ∀ (t : GaussianInt), + ∀ (U : ProtoTile), + ∀ (W : ProtoTile), + U.cells = (sq (r + s) t).cells → + W.cells = + (sq (![r, s, r, s] j) + ((if flip then + (⟨r + s, r + s⟩ : GaussianInt) - + ![⟨s, r + s⟩, ⟨-(s : Int), 0⟩, ⟨-(r : Int), s⟩, + ⟨r, -(s : Int)⟩] + j - + ⟨![r, s, r, s] j, ![r, s, r, s] j⟩ + else + ![⟨s, r + s⟩, ⟨-(s : Int), 0⟩, ⟨-(r : Int), s⟩, + ⟨r, -(s : Int)⟩] + j) + + t)).cells → + ∀ (D : GaussianInt), + (D = + if flip then + -![⟨r + s, r⟩, ⟨-(r + s : Int), s⟩, + ⟨-(r + s : Int), -(r : Int)⟩, ⟨r + s, -(s : Int)⟩] + j + else + ![⟨r + s, r⟩, ⟨-(r + s : Int), s⟩, + ⟨-(r + s : Int), -(r : Int)⟩, ⟨r + s, -(s : Int)⟩] + j) → + ∃ _ : ExactTileInterfaceTriple U (TileTranslation U D) W, + TouchingTriple U (TileTranslation U D) W + ) := by classical - intro P sq cell translate disk r s hr hs j flip t U W hU hW D hD + intro sq cell translate disk r s hr hs j flip t U W hU hW D hD let b : GaussianInt := ![⟨r+s,r⟩,⟨-(r+s:Int),s⟩,⟨-(r+s:Int),-(r:Int)⟩,⟨r+s,-(s:Int)⟩] j let c : GaussianInt := ![⟨s,r+s⟩,⟨-(s:Int),0⟩,⟨-(r:Int),s⟩,⟨r,-(s:Int)⟩] j let n : Nat := ![r,s,r,s] j @@ -172,9 +215,10 @@ private theorem hr : (by classical exact - ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((Fin (3 : ℕ)) → (0 < P.q₁)) ) := by + ∀ (P : FordFareyParameter), (1 : ℕ) < P.q → 0 < P.q₁ + ) := by classical - intro P hq i + intro P hq by_contra h have hz : P.q₁ = 0 := by omega have hd := P.det₁ @@ -205,9 +249,9 @@ theorem FordOrientedChildParentIncomingEndpoint -- BODY classical let sq := fun (n : Nat) (a : GaussianInt) => TileTranslation (FordTile n) a - have cell (n : Nat) (a z : GaussianInt) := IncomingEndpointGeometry.cell P n a z + have cell (n : Nat) (a z : GaussianInt) := IncomingEndpointGeometry.cell n a z have cent (T : ProtoTile) (n : Nat) (hn : 0 < n) (a : GaussianInt) - (hc : T.cells = (sq n a).cells) := IncomingEndpointGeometry.cent P cell T n hn a hc + (hc : T.cells = (sq n a).cells) := IncomingEndpointGeometry.cent cell T n hn a hc have translate (T : ProtoTile) (n : Nat) (a u : GaussianInt) (hc : T.cells = (sq n a).cells) := IncomingEndpointGeometry.translate T n a u hc have disk (T : ProtoTile) (n : Nat) (hn : 0 < n) (a : GaussianInt) @@ -224,10 +268,10 @@ theorem FordOrientedChildParentIncomingEndpoint (hD : D = if flip then -(![⟨r+s,r⟩,⟨-(r+s:Int),s⟩,⟨-(r+s:Int),-(r:Int)⟩,⟨r+s,-(s:Int)⟩] j) else (![⟨r+s,r⟩,⟨-(r+s:Int),s⟩,⟨-(r+s:Int),-(r:Int)⟩,⟨r+s,-(s:Int)⟩] j)) := - IncomingEndpointGeometry.finish P cell translate disk r s hr hs j flip t U W hU hW D hD + IncomingEndpointGeometry.finish cell translate disk r s hr hs j flip t U W hU hW D hD dsimp only intro i s U W hU hW hUpos hWpos hcw - have hr := IncomingEndpointGeometry.hr P hq i + have hr := IncomingEndpointGeometry.hr P hq have hs := P.q₂_pos have hqs := P.sum_q obtain ⟨hp,h10,h20,_,_⟩ := (FordCoordinateConfiguration P).2 hq diff --git a/LeanPool/ApollonianSuperharmonic/FordRegimeConverse.lean b/LeanPool/ApollonianSuperharmonic/FordRegimeConverse.lean index ddb666c1ac..9d6565fe7d 100644 --- a/LeanPool/ApollonianSuperharmonic/FordRegimeConverse.lean +++ b/LeanPool/ApollonianSuperharmonic/FordRegimeConverse.lean @@ -158,43 +158,60 @@ private theorem determinantCoprime : exact (Int.natCast_dvd_natCast).mp relationDivides private theorem desiredAt325 : - ∀ (predecessor : Fin (4 : ℕ) → CircleCoordinates), (Fin (4 : ℕ)) → (∀ (predecessorLine : ∃ i - : Fin 4, (predecessor i).1 = 0), ∀ (g : BandPackingSymmetry), ∀ (P : FordFareyParameter), - ∀ (hP : (1 : ℕ) < P.q), (∀ (x : Fin 4 → - CircleCoordinates), BandPackingSymmetryQuadrupleAction g ![(2 * (x 0).1 + 2 * (x 2).1 + 2 - * (x 3).1 - (x 1).1, 2 * (x 0).2 + 2 * (x 2).2 + 2 * (x 3).2 - (x 1).2), x 0, x 2, x 3] = - ![(2 * ((BandPackingSymmetryQuadrupleAction g x) 0).1 + 2 * - ((BandPackingSymmetryQuadrupleAction g x) 2).1 + 2 * ((BandPackingSymmetryQuadrupleAction - g x) 3).1 - ((BandPackingSymmetryQuadrupleAction g x) 1).1, 2 * - ((BandPackingSymmetryQuadrupleAction g x) 0).2 + 2 * ((BandPackingSymmetryQuadrupleAction - g x) 2).2 + 2 * ((BandPackingSymmetryQuadrupleAction g x) 3).2 - - ((BandPackingSymmetryQuadrupleAction g x) 1).2), (BandPackingSymmetryQuadrupleAction g x) - 0, (BandPackingSymmetryQuadrupleAction g x) 2, (BandPackingSymmetryQuadrupleAction g x) - 3]) → (∀ (determinantCoprime : ∀ (a : Int), ∀ (b : Nat), ∀ (d : Nat), ∀ (c : Int), a * (d : - Int) - (b : Int) * c = 1 → Nat.Coprime b a.natAbs), let next0 : FordFareyParameter := - { p := P.p + P.p₂, q := P.q + P.q₂, - q_pos := by omega, - reduced := by - apply determinantCoprime (P.p + P.p₂) (P.q + P.q₂) P.q₂ P.p₂ - norm_num [Nat.cast_add] - nlinarith [P.det₂], - p₁ := P.p, q₁ := P.q, p₂ := P.p₂, q₂ := P.q₂, - sum_p := by ring, - sum_q := by ring, - det₁ := by norm_num [Nat.cast_add]; nlinarith [P.det₂], - det₂ := by norm_num [Nat.cast_add]; nlinarith [P.det₂], - q₁_lt := by have := P.q₂_pos; omega, q₂_pos := P.q₂_pos, - unit_case := by intro h; omega } - (BandPackingSymmetryQuadrupleAction g predecessor = FordRecursiveQuadruple P) → - (BandPackingSymmetryQuadrupleAction g - ![(2 * (predecessor 0).1 + 2 * (predecessor 2).1 + - 2 * (predecessor 3).1 - (predecessor 1).1, - 2 * (predecessor 0).2 + 2 * (predecessor 2).2 + - 2 * (predecessor 3).2 - (predecessor 1).2), - predecessor 0, predecessor 2, predecessor 3] = - FordRecursiveQuadruple next0))) := by + ∀ (predecessor : Fin (4 : ℕ) → CircleCoordinates), + ∀ (predecessorLine : ∃ i : Fin 4, (predecessor i).1 = 0), + ∀ (g : BandPackingSymmetry), + ∀ (P : FordFareyParameter), + ∀ (hP : (1 : ℕ) < P.q), + (∀ (x : Fin 4 → CircleCoordinates), + BandPackingSymmetryQuadrupleAction g + ![(2 * (x 0).1 + 2 * (x 2).1 + 2 * (x 3).1 - (x 1).1, + 2 * (x 0).2 + 2 * (x 2).2 + 2 * (x 3).2 - (x 1).2), + x 0, x 2, x 3] = + ![(2 * ((BandPackingSymmetryQuadrupleAction g x) 0).1 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 2).1 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 3).1 - + ((BandPackingSymmetryQuadrupleAction g x) 1).1, + 2 * ((BandPackingSymmetryQuadrupleAction g x) 0).2 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 2).2 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 3).2 - + ((BandPackingSymmetryQuadrupleAction g x) 1).2), + (BandPackingSymmetryQuadrupleAction g x) 0, + (BandPackingSymmetryQuadrupleAction g x) 2, + (BandPackingSymmetryQuadrupleAction g x) 3]) → + ∀ + (determinantCoprime : + ∀ (a : Int), + ∀ (b : Nat), + ∀ (d : Nat), + ∀ (c : Int), + a * (d : Int) - (b : Int) * c = 1 → Nat.Coprime b a.natAbs), + let next0 : FordFareyParameter := + { p := P.p + P.p₂, q := P.q + P.q₂, q_pos := by omega, + reduced := + by + apply determinantCoprime (P.p + P.p₂) (P.q + P.q₂) P.q₂ P.p₂ + norm_num [Nat.cast_add] + nlinarith [P.det₂], + p₁ := P.p, q₁ := P.q, p₂ := P.p₂, q₂ := P.q₂, sum_p := by ring, + sum_q := by ring, + det₁ := by norm_num [Nat.cast_add]; nlinarith [P.det₂], + det₂ := by norm_num [Nat.cast_add]; nlinarith [P.det₂], + q₁_lt := by have := P.q₂_pos; omega, q₂_pos := P.q₂_pos, + unit_case := by intro h; omega } + BandPackingSymmetryQuadrupleAction g predecessor = + FordRecursiveQuadruple P → + BandPackingSymmetryQuadrupleAction g + ![(2 * (predecessor 0).1 + 2 * (predecessor 2).1 + + 2 * (predecessor 3).1 - + (predecessor 1).1, + 2 * (predecessor 0).2 + 2 * (predecessor 2).2 + + 2 * (predecessor 3).2 - + (predecessor 1).2), + predecessor 0, predecessor 2, predecessor 3] = + FordRecursiveQuadruple next0 := by classical - intro predecessor i predecessorLine g P hP successorAction determinantCoprime next0 + intro predecessor predecessorLine g P hP successorAction determinantCoprime next0 actionPredecessor rw [successorAction predecessor, actionPredecessor] simp only [Nat.succ_eq_add_one, Nat.reduceAdd, FordRecursiveQuadruple, FordCircleCoordinate, @@ -249,45 +266,62 @@ private theorem actionPredecessorAt357 : (congrFun ordered (1 : Fin 4)).symm private theorem desiredAt381 : - ∀ (predecessor : Fin (4 : ℕ) → CircleCoordinates), (Fin (4 : ℕ)) → (∀ (predecessorLine : ∃ i - : Fin 4, (predecessor i).1 = 0), ∀ (g : BandPackingSymmetry), ∀ (P : FordFareyParameter), - ∀ (hP : (1 : ℕ) < P.q), (BandPackingSymmetryReversesOrientation g = false) → ((∀ (x : Fin - 4 → - CircleCoordinates), BandPackingSymmetryQuadrupleAction g ![(2 * (x 0).1 + 2 * (x 2).1 + 2 - * (x 3).1 - (x 1).1, 2 * (x 0).2 + 2 * (x 2).2 + 2 * (x 3).2 - (x 1).2), x 0, x 2, x 3] = - ![(2 * ((BandPackingSymmetryQuadrupleAction g x) 0).1 + 2 * - ((BandPackingSymmetryQuadrupleAction g x) 2).1 + 2 * ((BandPackingSymmetryQuadrupleAction - g x) 3).1 - ((BandPackingSymmetryQuadrupleAction g x) 1).1, 2 * - ((BandPackingSymmetryQuadrupleAction g x) 0).2 + 2 * ((BandPackingSymmetryQuadrupleAction - g x) 2).2 + 2 * ((BandPackingSymmetryQuadrupleAction g x) 3).2 - - ((BandPackingSymmetryQuadrupleAction g x) 1).2), (BandPackingSymmetryQuadrupleAction g x) - 0, (BandPackingSymmetryQuadrupleAction g x) 2, (BandPackingSymmetryQuadrupleAction g x) - 3]) → (∀ (determinantCoprime : ∀ (a : Int), ∀ (b : Nat), ∀ (d : Nat), ∀ (c : Int), a * (d : - Int) - (b : Int) * c = 1 → Nat.Coprime b a.natAbs), let next2 : FordFareyParameter := - { p := P.p + P.p₁, q := P.q + P.q₁, - q_pos := by omega, - reduced := by - apply determinantCoprime (P.p + P.p₁) (P.q + P.q₁) P.q P.p - norm_num [Nat.cast_add] - nlinarith [P.det₁], - p₁ := P.p₁, q₁ := P.q₁, p₂ := P.p, q₂ := P.q, - sum_p := by ring, - sum_q := by ring, - det₁ := by norm_num [Nat.cast_add]; nlinarith [P.det₁], - det₂ := by norm_num [Nat.cast_add]; nlinarith [P.det₁], - q₁_lt := by have := P.q_pos; omega, q₂_pos := P.q_pos, - unit_case := by intro h; omega } - (BandPackingSymmetryQuadrupleAction g predecessor = ![(FordRecursiveQuadruple P) 0, - (FordRecursiveQuadruple P) 2, (FordRecursiveQuadruple P) 3, (FordRecursiveQuadruple P) - 1]) → (BandPackingSymmetryQuadrupleAction g - ![(2 * (predecessor 0).1 + 2 * (predecessor 2).1 + - 2 * (predecessor 3).1 - (predecessor 1).1, - 2 * (predecessor 0).2 + 2 * (predecessor 2).2 + - 2 * (predecessor 3).2 - (predecessor 1).2), - predecessor 3, predecessor 0, predecessor 2] = - FordRecursiveQuadruple next2)))) := by + ∀ (predecessor : Fin (4 : ℕ) → CircleCoordinates), + ∀ (predecessorLine : ∃ i : Fin 4, (predecessor i).1 = 0), + ∀ (g : BandPackingSymmetry), + ∀ (P : FordFareyParameter), + ∀ (hP : (1 : ℕ) < P.q), + BandPackingSymmetryReversesOrientation g = false → + (∀ (x : Fin 4 → CircleCoordinates), + BandPackingSymmetryQuadrupleAction g + ![(2 * (x 0).1 + 2 * (x 2).1 + 2 * (x 3).1 - (x 1).1, + 2 * (x 0).2 + 2 * (x 2).2 + 2 * (x 3).2 - (x 1).2), + x 0, x 2, x 3] = + ![(2 * ((BandPackingSymmetryQuadrupleAction g x) 0).1 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 2).1 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 3).1 - + ((BandPackingSymmetryQuadrupleAction g x) 1).1, + 2 * ((BandPackingSymmetryQuadrupleAction g x) 0).2 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 2).2 + + 2 * ((BandPackingSymmetryQuadrupleAction g x) 3).2 - + ((BandPackingSymmetryQuadrupleAction g x) 1).2), + (BandPackingSymmetryQuadrupleAction g x) 0, + (BandPackingSymmetryQuadrupleAction g x) 2, + (BandPackingSymmetryQuadrupleAction g x) 3]) → + ∀ + (determinantCoprime : + ∀ (a : Int), + ∀ (b : Nat), + ∀ (d : Nat), + ∀ (c : Int), + a * (d : Int) - (b : Int) * c = 1 → Nat.Coprime b a.natAbs), + let next2 : FordFareyParameter := + { p := P.p + P.p₁, q := P.q + P.q₁, q_pos := by omega, + reduced := + by + apply determinantCoprime (P.p + P.p₁) (P.q + P.q₁) P.q P.p + norm_num [Nat.cast_add] + nlinarith [P.det₁], + p₁ := P.p₁, q₁ := P.q₁, p₂ := P.p, q₂ := P.q, sum_p := by ring, + sum_q := by ring, + det₁ := by norm_num [Nat.cast_add]; nlinarith [P.det₁], + det₂ := by norm_num [Nat.cast_add]; nlinarith [P.det₁], + q₁_lt := by have := P.q_pos; omega, q₂_pos := P.q_pos, + unit_case := by intro h; omega } + BandPackingSymmetryQuadrupleAction g predecessor = + ![(FordRecursiveQuadruple P) 0, (FordRecursiveQuadruple P) 2, + (FordRecursiveQuadruple P) 3, (FordRecursiveQuadruple P) 1] → + BandPackingSymmetryQuadrupleAction g + ![(2 * (predecessor 0).1 + 2 * (predecessor 2).1 + + 2 * (predecessor 3).1 - + (predecessor 1).1, + 2 * (predecessor 0).2 + 2 * (predecessor 2).2 + + 2 * (predecessor 3).2 - + (predecessor 1).2), + predecessor 3, predecessor 0, predecessor 2] = + FordRecursiveQuadruple next2 := by classical - intro predecessor i predecessorLine g P hP hg successorAction determinantCoprime next2 + intro predecessor predecessorLine g P hP hg successorAction determinantCoprime next2 actionPredecessor let y : Fin 4 → CircleCoordinates := ![predecessor 3, predecessor 1, predecessor 0, predecessor 2] @@ -499,7 +533,7 @@ theorem FordRegimeConverse (q : Fin 4 → CircleCoordinates) 2 * (predecessor 0).2 + 2 * (predecessor 2).2 + 2 * (predecessor 3).2 - (predecessor 1).2), predecessor 0, predecessor 2, predecessor 3] = - FordRecursiveQuadruple next0 := FordRegimeProof.desiredAt325 predecessor i + FordRecursiveQuadruple next0 := FordRegimeProof.desiredAt325 predecessor predecessorLine g P hP successorAction determinantCoprime actionPredecessor simpa using desired · exfalso @@ -533,7 +567,7 @@ theorem FordRegimeConverse (q : Fin 4 → CircleCoordinates) 2 * (predecessor 0).2 + 2 * (predecessor 2).2 + 2 * (predecessor 3).2 - (predecessor 1).2), predecessor 3, predecessor 0, predecessor 2] = - FordRecursiveQuadruple next2 := FordRegimeProof.desiredAt381 predecessor i + FordRecursiveQuadruple next2 := FordRegimeProof.desiredAt381 predecessor predecessorLine g P hP hg successorAction determinantCoprime actionPredecessor simpa using desired diff --git a/LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean b/LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean index f7db63fae8..eb3efd86ee 100644 --- a/LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean @@ -218,10 +218,13 @@ private theorem red : (by classical exact - (FordFareyParameter) → (∀ (a : ℤ), ∀ (b : ℕ), ∀ (d : ℕ), ∀ (c : ℤ), a * (↑d : ℤ) - (↑b : - ℤ) * c = (1 : ℤ) → b.Coprime a.natAbs) ) := by + ∀ (a : ℤ), + ∀ (b : ℕ), + ∀ (d : ℕ), + ∀ (c : ℤ), a * (↑d : ℤ) - (↑b : ℤ) * c = (1 : ℤ) → b.Coprime a.natAbs + ) := by classical - intro R a b d c hd + intro a b d c hd rw [Nat.coprime_iff_gcd_eq_one] apply Nat.dvd_one.mp let g := Nat.gcd b a.natAbs @@ -630,7 +633,7 @@ theorem FordTileOdometerRestriction (P : FordFareyParameter) : have cross : R.p₁ * (R.q₂ : Int) - (R.q₁ : Int) * R.p₂ = 1 := FordOdometerRestriction.cross R have red (a : Int) (b d : Nat) (c : Int) (hd : a * (d : Int) - (b : Int) * c = 1) : Nat.Coprime b a.natAbs := - FordOdometerRestriction.red R a b d c hd + FordOdometerRestriction.red a b d c hd obtain ⟨R1, ⟨hp1, hq1⟩, _⟩ := FordFareyParentsExist R.p₁ R.q₁ q1pos (red R.p₁ R.q₁ R.q₂ R.p₂ cross) obtain ⟨R2, ⟨hp2, hq2⟩, _⟩ := FordFareyParentsExist R.p₂ R.q₂ R.q₂_pos diff --git a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean index 9f28d70f04..aaf7daf69b 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean @@ -546,17 +546,24 @@ private theorem hcentU : (by classical exact - ∀ (T : ProtoTile), ∀ (T' : ProtoTile), (ℝ × ℝ) → ((ℝ × ℝ) → (∀ (q : Fin (4 : ℕ) → - CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (e : Bool), (TileCentroid T' - - TileCentroid T = (if e = true then (1 : ℝ) else (-1 : ℝ)) • GaussianRealPoint - (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ( - let v := (if e = true then (BandVectors.1 (q 0) (q i.succ)) - else -BandVectors.1 (q 0) (q i.succ)) - (TileTouching T (TileTranslation T v)) → ( - let U := TileTranslation T v - (BandPrototile (q 0) U) → (TileCentroid U = TileCentroid T'))))) ) := by + ∀ (T : ProtoTile), + ∀ (T' : ProtoTile), + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), + ∀ (e : Bool), + TileCentroid T' - TileCentroid T = + (if e = true then (1 : ℝ) else (-1 : ℝ)) • + GaussianRealPoint + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) → + let v := + if e = true then BandVectors.1 (q 0) (q i.succ) + else -BandVectors.1 (q 0) (q i.succ) + TileTouching T (TileTranslation T v) → + let U := TileTranslation T v + BandPrototile (q 0) U → TileCentroid U = TileCentroid T' + ) := by classical - intro T T' p p' q i e hcent v htouch U hU + intro T T' q i e hcent v htouch U hU have hc1 := congrArg Prod.fst hcent have hc2 := congrArg Prod.snd hcent change (TileCentroid T').1 - (TileCentroid T).1 = @@ -657,16 +664,27 @@ private theorem hT4 : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (Fin (3 : ℕ)) → ((ProperBandQuadruple q) → - (((0 : ℤ) < (q (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ - ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 - : ℤ) → i = j) → (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (j : Fin 3), BandPrototile - (q 0) A → BandPrototile (q j.succ) B → TileCentroid B - TileCentroid A = (1 / 2 : - Real) • (GaussianRealPoint (BandVectors.1 (q j.succ) (q 0)) + GaussianRealPoint - (BandVectors.1 (q 0) (q j.succ))) → TouchingTriple A (TileTranslation A - (BandVectors.1 (q j.succ) (q 0))) B)))) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q → + ((0 : ℤ) < (q (0 : Fin (4 : ℕ))).1 ∧ + (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ + ∀ (i : Fin (3 : ℕ)), + ∀ (j : Fin (3 : ℕ)), + (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) → + ∀ (A : ProtoTile), + ∀ (B : ProtoTile), + ∀ (j : Fin 3), + BandPrototile (q 0) A → + BandPrototile (q j.succ) B → + TileCentroid B - TileCentroid A = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q j.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q j.succ))) → + TouchingTriple A + (TileTranslation A (BandVectors.1 (q j.succ) (q 0))) B + ) := by classical - intro q i hq hrootPos A B j hA hB hcentAB + intro q hq hrootPos A B j hA hB hcentAB have hgt : 1 < (q 0).1 := by by_contra hn have hzero : ∀ k : Fin 3, (q k.succ).1 = 0 := by @@ -683,18 +701,29 @@ private theorem hT5 : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → - (((0 : ℤ) < (q (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ - ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 - : ℤ) → i = j) → (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (D : ProtoTile), ∀ (j : Fin - 3), BandPrototile (q 0) A → BandPrototile (q j.succ) B → BandPrototile (q ((j + - 1).succ)) D → TileCentroid B - TileCentroid A = (1 / 2 : Real) • (GaussianRealPoint - (BandVectors.1 (q j.succ) (q 0)) + GaussianRealPoint (BandVectors.1 (q 0) (q - j.succ))) → TileCentroid D - TileCentroid A = (1 / 2 : Real) • (GaussianRealPoint - (BandVectors.1 (q ((j + 1).succ)) (q 0)) - GaussianRealPoint (BandVectors.1 (q 0) (q - ((j + 1).succ)))) → TouchingTriple A B D)) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q → + ∀ (A : ProtoTile), + ∀ (B : ProtoTile), + ∀ (D : ProtoTile), + ∀ (j : Fin 3), + BandPrototile (q 0) A → + BandPrototile (q j.succ) B → + BandPrototile (q (j + 1).succ) D → + TileCentroid B - TileCentroid A = + (1 / 2 : Real) • + (GaussianRealPoint (BandVectors.1 (q j.succ) (q 0)) + + GaussianRealPoint (BandVectors.1 (q 0) (q j.succ))) → + TileCentroid D - TileCentroid A = + (1 / 2 : Real) • + (GaussianRealPoint + (BandVectors.1 (q (j + 1).succ) (q 0)) - + GaussianRealPoint + (BandVectors.1 (q 0) (q (j + 1).succ))) → + TouchingTriple A B D + ) := by classical - intro q hq hrootPos A B D j hA hB hD hcentB hcentD + intro q hq A B D j hA hB hD hcentB hcentD have hgt : 1 < (q 0).1 := by by_contra hn have hzero : ∀ k : Fin 3, (q k.succ).1 = 0 := by @@ -877,8 +906,8 @@ theorem LatticeAdjacentInterfacePath : i e hrotplus hrotminus let U := TileTranslation T v have hU : BandPrototile (q 0) U := BandPrototileTranslation _ T v hTq - have hcentU : TileCentroid U = TileCentroid T' := LatticeInterfacePathGeometry.hcentU T T' p - p' q i e hcent htouch hU + have hcentU : TileCentroid U = TileCentroid T' := LatticeInterfacePathGeometry.hcentU T T' q + i e hcent htouch hU have hcells := (BandPrototileCentroidUnique (q 0) U T' hU hT'q hcentU).1 have hUn : U.cells.Nonempty := LatticeInterfacePathGeometry.hUn T q i e hnonempty have hT'nonempty : T'.cells.Nonempty := by rw [← hcells]; exact hUn @@ -905,7 +934,7 @@ theorem LatticeAdjacentInterfacePath : (GaussianRealPoint (BandVectors.1 (q j.succ) (q 0)) + GaussianRealPoint (BandVectors.1 (q 0) (q j.succ))) → TouchingTriple A (TileTranslation A (BandVectors.1 (q j.succ) (q 0))) B := - LatticeInterfacePathGeometry.hT4 q i hq hrootPos + LatticeInterfacePathGeometry.hT4 q hq hrootPos have hT5 : ∀ (A B D : ProtoTile) (j : Fin 3), BandPrototile (q 0) A → BandPrototile (q j.succ) B → BandPrototile (q ((j + 1).succ)) D → @@ -917,7 +946,7 @@ theorem LatticeAdjacentInterfacePath : (1 / 2 : Real) • (GaussianRealPoint (BandVectors.1 (q ((j + 1).succ)) (q 0)) - GaussianRealPoint (BandVectors.1 (q 0) (q ((j + 1).succ)))) → - TouchingTriple A B D := LatticeInterfacePathGeometry.hT5 q hq hrootPos + TouchingTriple A B D := LatticeInterfacePathGeometry.hT5 q hq let unitI : GaussianInt := ⟨0, 1⟩ have qturn_mul (z : GaussianInt) : GaussianQuarterTurn z = unitI * z := by ext <;> simp [GaussianQuarterTurn, unitI] diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean index 49d0e35a76..836bd5a475 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean @@ -132,11 +132,12 @@ private theorem unoccupied_center_outside : (by classical exact - ∀ (T : ProtoTile), (List GaussianInt) → (∀ q ∉ T.cells, ((↑q.re : ℝ) + (1 / 2 : ℝ), - (↑q.im : ℝ) + (1 / 2 : ℝ)) ∉ TileRealization T) + ∀ (T : ProtoTile), + ∀ q ∉ T.cells, + ((↑q.re : ℝ) + (1 / 2 : ℝ), (↑q.im : ℝ) + (1 / 2 : ℝ)) ∉ TileRealization T ) := by classical - intro T gridPath q hq hcenter + intro T q hq hcenter rw [TileRealization] at hcenter simp only [Set.mem_iUnion] at hcenter rcases hcenter with ⟨w, hw, hqw⟩ @@ -240,11 +241,13 @@ private theorem occupied_vertical_not_boundary : (by classical exact - ∀ (T : ProtoTile), (List GaussianInt) → ((GaussianInt) → (∀ q ∈ T.cells, q - (1 : - LatticeCell) ∈ T.cells → {q, q + ⟨(0 : ℤ), (1 : ℤ)⟩} ∉ BoundaryFootprintEdges T)) + ∀ (T : ProtoTile), + ∀ q ∈ T.cells, + q - (1 : LatticeCell) ∈ T.cells → + {q, q + ⟨(0 : ℤ), (1 : ℤ)⟩} ∉ BoundaryFootprintEdges T ) := by classical - intro T gridPath z q hq hleft + intro T q hq hleft rintro ⟨w, (⟨heq, hxor⟩ | ⟨heq, hxor⟩)⟩ · have hw : w = q ∨ w = q + ⟨0, 1⟩ := by have : w ∈ ({q, q + ⟨0, 1⟩} : Finset GaussianInt) := by rw [heq]; simp @@ -271,11 +274,13 @@ private theorem occupied_horizontal_not_boundary : (by classical exact - ∀ (T : ProtoTile), (List GaussianInt) → ((GaussianInt) → (∀ q ∈ T.cells, q - ⟨(0 : ℤ), (1 - : ℤ)⟩ ∈ T.cells → {q, q + (1 : LatticeCell)} ∉ BoundaryFootprintEdges T)) + ∀ (T : ProtoTile), + ∀ q ∈ T.cells, + q - ⟨(0 : ℤ), (1 : ℤ)⟩ ∈ T.cells → + {q, q + (1 : LatticeCell)} ∉ BoundaryFootprintEdges T ) := by classical - intro T gridPath z q hq hbelow + intro T q hq hbelow rintro ⟨w, (⟨heq, hxor⟩ | ⟨heq, hxor⟩)⟩ · have hw : w = q ∨ w = q + 1 := by have : w ∈ ({q, q + 1} : Finset GaussianInt) := by rw [heq]; simp @@ -502,12 +507,16 @@ private theorem zip_mem_decompose : (by classical exact - ∀ (gridPath : List GaussianInt), (GaussianInt) → (((4 : ℕ) ≤ gridPath.length) → (∀ (a : - GaussianInt), ∀ (b : GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail → ∃ (l₁ : List - GaussianInt) (l₂ : List GaussianInt), gridPath = l₁ ++ a :: b :: l₂)) + ∀ (gridPath : List GaussianInt), + (4 : ℕ) ≤ gridPath.length → + ∀ (a : GaussianInt), + ∀ (b : GaussianInt), + (a, b) ∈ gridPath.zip gridPath.tail → + ∃ (l₁ : List GaussianInt) (l₂ : List GaussianInt), + gridPath = l₁ ++ a :: b :: l₂ ) := by classical - intro gridPath z gridPath_length_four a b hab + intro gridPath gridPath_length_four a b hab rw [List.mem_iff_getElem] at hab rcases hab with ⟨i, hi, hab⟩ have hi' : i < gridPath.tail.length := by @@ -735,7 +744,7 @@ theorem LatticeTileBoundarySimpleGridCycle (T : ProtoTile) (hT : LatticeTile T) have unoccupied_center_outside (q : LatticeCell) (hq : q ∉ T.cells) : ((((q.re : Int) : Real) + (1 / 2 : Real)), (((q.im : Int) : Real) + (1 / 2 : Real))) ∉ TileRealization T := - BoundaryCycleProof.unoccupied_center_outside T gridPath q hq + BoundaryCycleProof.unoccupied_center_outside T q hq have unoccupied_index_zero (q : LatticeCell) (hq : q ∉ T.cells) : GridRayCrossingIndex q gridPath = 0 := BoundaryCycleProof.unoccupied_index_zero T closed_grid_index_zero gridPath x y z gridPath_head gridPath_last gridPath_chain @@ -753,11 +762,11 @@ theorem LatticeTileBoundarySimpleGridCycle (T : ProtoTile) (hT : LatticeTile T) have occupied_vertical_not_boundary (q : LatticeCell) (hq : q ∈ T.cells) (hleft : q - 1 ∈ T.cells) : ({q, q + ⟨0, 1⟩} : Finset GaussianInt) ∉ BoundaryFootprintEdges T := - BoundaryCycleProof.occupied_vertical_not_boundary T gridPath z q hq hleft + BoundaryCycleProof.occupied_vertical_not_boundary T q hq hleft have occupied_horizontal_not_boundary (q : LatticeCell) (hq : q ∈ T.cells) (hbelow : q - ⟨0, 1⟩ ∈ T.cells) : ({q, q + 1} : Finset GaussianInt) ∉ BoundaryFootprintEdges T := - BoundaryCycleProof.occupied_horizontal_not_boundary T gridPath z q hq hbelow + BoundaryCycleProof.occupied_horizontal_not_boundary T q hq hbelow have occupied_adjacent_index_eq (a b : LatticeCell) (ha : a ∈ T.cells) (hb : b ∈ T.cells) (hab : FourNeighborAdjacent a b) : @@ -780,7 +789,7 @@ theorem LatticeTileBoundarySimpleGridCycle (T : ProtoTile) (hT : LatticeTile T) have zip_mem_decompose (a b : GaussianInt) (hab : (a, b) ∈ gridPath.zip gridPath.tail) : ∃ l₁ l₂ : List GaussianInt, gridPath = l₁ ++ a :: b :: l₂ := - BoundaryCycleProof.zip_mem_decompose gridPath z gridPath_length_four a b hab + BoundaryCycleProof.zip_mem_decompose gridPath gridPath_length_four a b hab have cyclic_endpoints_mem (a b : GaussianInt) (hab : (a, b) ∈ cyclicEdges) : a ∈ gridPath ∧ b ∈ gridPath := BoundaryCycleProof.cyclic_endpoints_mem gridPath x y gridPath_head gridPath_last zip_mem_decompose a b hab diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean index 5540f8c8f5..c00adb40af 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean @@ -378,12 +378,14 @@ private theorem hexteriorOut : classical exact ∀ (T : ProtoTile), - let S : Set LatticeCell := T.cells - (List GaussianInt) → (∀ (z : LatticeCell), (∀ x' ∈ T.cells, x'.re ≤ z.re) → ( - let exterior : LatticeCell := z + 1 - exterior ∉ S)) ) := by + let S : Set LatticeCell := T.cells; + ∀ (z : LatticeCell), + (∀ x' ∈ T.cells, x'.re ≤ z.re) → + let exterior : LatticeCell := z + 1 + exterior ∉ S + ) := by classical - intro T S p z hzmax exterior he + intro T S z hzmax exterior he have hle := hzmax exterior he dsimp [exterior] at hle omega @@ -437,17 +439,19 @@ private theorem right_halfplane : classical exact ∀ (T : ProtoTile), - let S : Set LatticeCell := T.cells - let step : LatticeCell → LatticeCell → Prop := fun a b => - FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S - let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step - (∀ {a : LatticeCell}, ∀ {b : LatticeCell}, (a ∉ S) → ((b ∉ S) → ((FourNeighborAdjacent a - b) → (reach a b)))) → ((List GaussianInt) → (∀ (z : LatticeCell), (∀ x' ∈ T.cells, - x'.re ≤ z.re) → ( - let exterior : LatticeCell := z + 1 - ∀ (q : LatticeCell), z.re < q.re → reach q exterior))) ) := by + let S : Set LatticeCell := T.cells; + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S; + let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step; + (∀ {a : LatticeCell}, + ∀ {b : LatticeCell}, a ∉ S → b ∉ S → FourNeighborAdjacent a b → reach a b) → + ∀ (z : LatticeCell), + (∀ x' ∈ T.cells, x'.re ≤ z.re) → + let exterior : LatticeCell := z + 1 + ∀ (q : LatticeCell), z.re < q.re → reach q exterior + ) := by classical - intro T S step reach one_step p z hzmax exterior q hq + intro T S step reach one_step z hzmax exterior q hq let column (k : Int) : LatticeCell := ⟨q.re, k⟩ have column_out (k : Int) : column k ∉ S := by intro hkS @@ -499,21 +503,27 @@ private theorem every_outside_reaches : classical exact ∀ (T : ProtoTile), - let S : Set LatticeCell := T.cells - let step : LatticeCell → LatticeCell → Prop := fun a b => - FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S - let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step - (∀ {a : LatticeCell}, ∀ {b : LatticeCell}, (a ∉ S) → ((reach a b) → (b ∉ S))) → ( - let around (v q : LatticeCell) : Prop := - q = v ∨ q = v - 1 ∨ q = v - ⟨0, 1⟩ ∨ q = v - 1 - ⟨0, 1⟩ - (List GaussianInt) → (∀ (base : LatticeCell), (∀ {e : Finset GaussianInt}, ∀ - {v : LatticeCell}, ∀ {q : LatticeCell}, (e ∈ BoundaryFootprintEdges T) → ((v ∈ e) → - ((q ∉ S) → ((around v q) → (reach q base))))) → (∀ (z : LatticeCell), - let exterior : LatticeCell := z + 1 - (reach exterior base) → ((∀ (q : LatticeCell), (z.re < q.re) → (reach q exterior)) → (∀ q - ∉ S, reach q base))))) ) := by + let S : Set LatticeCell := T.cells; + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ a ∉ S ∧ b ∉ S; + let reach : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step; + (∀ {a : LatticeCell}, ∀ {b : LatticeCell}, a ∉ S → reach a b → b ∉ S) → + let around (v q : LatticeCell) : Prop := + q = v ∨ q = v - 1 ∨ q = v - ⟨0, 1⟩ ∨ q = v - 1 - ⟨0, 1⟩; + ∀ (base : LatticeCell), + (∀ {e : Finset GaussianInt}, + ∀ {v : LatticeCell}, + ∀ {q : LatticeCell}, + e ∈ BoundaryFootprintEdges T → + v ∈ e → q ∉ S → around v q → reach q base) → + ∀ (z : LatticeCell), + let exterior : LatticeCell := z + 1 + reach exterior base → + (∀ (q : LatticeCell), z.re < q.re → reach q exterior) → + ∀ q ∉ S, reach q base + ) := by classical - intro T S step reach reach_target_out around p base boundary_outside_reaches z exterior + intro T S step reach reach_target_out around base boundary_outside_reaches z exterior hexteriorBase right_halfplane q hqOut by_contra hqbase have hqle : q.re ≤ z.re := by @@ -684,15 +694,15 @@ theorem LatticeTileComplementGridConnected (T : ProtoTile) ⟨z₀, hz₀⟩ with ⟨z, hz, hzmax⟩ have hzS : z ∈ S := hz let exterior : LatticeCell := z + 1 - have hexteriorOut : exterior ∉ S := ComplementGridPaths.hexteriorOut T p z hzmax + have hexteriorOut : exterior ∉ S := ComplementGridPaths.hexteriorOut T z hzmax let rightEdge : Finset GaussianInt := {z + 1, z + 1 + ⟨0, 1⟩} have hrightEdge := ComplementGridPaths.hrightEdge T z hzS hexteriorOut have hexteriorBase := ComplementGridPaths.hexteriorBase T base boundary_outside_reaches z hexteriorOut hrightEdge have right_halfplane (q : LatticeCell) (hq : z.re < q.re) := - ComplementGridPaths.right_halfplane T one_step p z hzmax q hq + ComplementGridPaths.right_halfplane T one_step z hzmax q hq have every_outside_reaches (q : LatticeCell) (hqOut : q ∉ S) := - ComplementGridPaths.every_outside_reaches T reach_target_out p base + ComplementGridPaths.every_outside_reaches T reach_target_out base boundary_outside_reaches z hexteriorBase right_halfplane q hqOut constructor · exact ⟨exterior, by simpa [S] using hexteriorOut⟩ diff --git a/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean b/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean index 3a0bff651f..43fcddc4e2 100644 --- a/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean @@ -77,11 +77,14 @@ private theorem incident_boundary : (by classical exact - ∀ (T : ProtoTile), ∀ (x : GaussianInt), Finset.Nonempty T.cells → (∃ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell x j ∈ T.cells) → (∃ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell x j ∉ T.cells) → x ∈ BoundaryFootprintVertices T ) := by + ∀ (T : ProtoTile), + ∀ (x : GaussianInt), + (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ T.cells) → + (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∉ T.cells) → + x ∈ BoundaryFootprintVertices T + ) := by classical - intro T x hne hsome hmissing + intro T x hsome hmissing exact P3161T2IncidentBoundary T x hsome hmissing private theorem common_edge_transition : @@ -555,7 +558,7 @@ theorem LocalLatticeInterfaceSectors : (hne : T.cells.Nonempty) (hsome : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) (hmissing : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ T.cells) := - InterfaceSectorGeometry.incident_boundary T x hne hsome hmissing + InterfaceSectorGeometry.incident_boundary T x hsome hmissing let I : GaussianInt := ⟨0, 1⟩ let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] diff --git a/LeanPool/ApollonianSuperharmonic/OdometerGluing.lean b/LeanPool/ApollonianSuperharmonic/OdometerGluing.lean index 9b25b3a0ff..e4b5855235 100644 --- a/LeanPool/ApollonianSuperharmonic/OdometerGluing.lean +++ b/LeanPool/ApollonianSuperharmonic/OdometerGluing.lean @@ -464,34 +464,39 @@ private theorem hgcompat : exact ∀ (adjacent_symm : ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → (FourNeighborAdjacent b a)), ∀ (adjacent_irrefl : ∀ (a : GaussianInt), ¬ - FourNeighborAdjacent a a), ∀ (edge_vertices : ∀ (T : ProtoTile), ∀ (a : + FourNeighborAdjacent a a), (∀ (T : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, b} : Finset GaussianInt) ∈ FootprintEdges T) - → (a ∈ FootprintVertices T ∧ b ∈ FootprintVertices T)), ∀ (footprint_constant : ∀ (W + → (a ∈ FootprintVertices T ∧ b ∈ FootprintVertices T)) → + (∀ (W : ProtoTile), (LatticeTile W) → (∀ (F : GaussianInt → ℤ), (∀ a, ∀ b, FourNeighborAdjacent a b → ({a, b} : Finset GaussianInt) ∈ FootprintEdges W → F a = F - b) → (∃ c : ℤ, ∀ x, x ∈ FootprintVertices W → F x = c))), ∀ (n : ℕ), ∀ (T : - ProtoTile), ∀ (U : Fin n → ProtoTile), ∀ (h : Fin n → PartialOdometer), ∀ (hU : ∀ (i - : Fin n), LatticeTile (U i)), ∀ (hdom : ∀ (i : Fin n), (↑(h i).domain : Set - GaussianInt) = FootprintVertices (U i)), ∀ (hcells : ∀ (x : LatticeCell), x ∈ T.cells - ↔ ∃ (i : Fin n), x ∈ (U i).cells), ∀ (hverts : ∀ (x : GaussianInt), x ∈ - FootprintVertices T ↔ ∃ (i : Fin n), x ∈ (h i).domain), + b) → (∃ c : ℤ, ∀ x, x ∈ FootprintVertices W → F x = c))) → + ∀ (n : ℕ), ∀ (T : + ProtoTile), ∀ (U : Fin n → ProtoTile), ∀ (h : Fin n → PartialOdometer), (∀ (i + : Fin n), LatticeTile (U i)) → + (∀ (i : Fin n), (↑(h i).domain : Set + GaussianInt) = FootprintVertices (U i)) → + (∀ (x : LatticeCell), x ∈ T.cells + ↔ ∃ (i : Fin n), x ∈ (U i).cells) → + (∀ (x : GaussianInt), x ∈ + FootprintVertices T ↔ ∃ (i : Fin n), x ∈ (h i).domain) → let E (a b : GaussianInt) : Prop := FourNeighborAdjacent a b ∧ - ({a, b} : Finset GaussianInt) ∈ FootprintEdges T + ({a, b} : Finset GaussianInt) ∈ FootprintEdges T; let covered (a b : GaussianInt) : Prop := - ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain; let D (a b : GaussianInt) : ℤ := if hc : covered a b then (h (Classical.choose hc)).value b - (h (Classical.choose hc)).value a - else 0 - ∀ (dmember : ∀ (i : Fin n), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (h i).domain) - → ((b ∈ (h i).domain) → (D a b = (h i).value b - (h i).value a))), + else 0; + (∀ (i : Fin n), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (h i).domain) + → ((b ∈ (h i).domain) → (D a b = (h i).value b - (h i).value a))) → let G : SimpleGraph {x // x ∈ FootprintVertices T} := { Adj := fun a b => E a.val b.val symm := ⟨by intro a b hab exact ⟨adjacent_symm a b hab.1, by simpa [Finset.pair_comm] using hab.2⟩⟩ - loopless := ⟨by intro a ha; exact adjacent_irrefl a ha.1⟩ } - ∀ (z : LatticeCell), ∀ (hz : z ∈ (↑T.cells : Set LatticeCell)), ∀ (f : + loopless := ⟨by intro a ha; exact adjacent_irrefl a ha.1⟩ }; + ∀ (f : { x : GaussianInt // x ∈ FootprintVertices T } → ℤ), ∀ (hfedge : ∀ (a : { x : GaussianInt // x ∈ FootprintVertices T }), ∀ (b : { x : GaussianInt // x ∈ FootprintVertices T }), G.Adj a b → f b - f a = D (↑a : @@ -511,8 +516,8 @@ private theorem hgcompat : (∀ (x : {x // x ∈ FootprintVertices T}), g.value x = f x) → (∀ i, OdometerCompatibility g (h i)) ) := by classical - intro adjacent_symm adjacent_irrefl edge_vertices footprint_constant n T U h hU hdom - hcells hverts E covered D dmember G z hz f hfedge dom hdomain g hgvalue i + intro adjacent_symm adjacent_irrefl edge_vertices footprint_constant n T U h hU hdom hcells + hverts E covered D dmember G f hfedge dom hdomain g hgvalue i obtain ⟨c, hc⟩ := footprint_constant (U i) (hU i) (fun x => g.value x - (h i).value x) (by intro a b hadj he @@ -550,37 +555,47 @@ private theorem hg'edge : (by classical exact - ∀ (adjacent_symm : ∀ (a : GaussianInt), ∀ (b : GaussianInt), (FourNeighborAdjacent a b) → - (FourNeighborAdjacent b a)), ∀ (adjacent_irrefl : ∀ (a : GaussianInt), ¬ - FourNeighborAdjacent a a), (∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ - T.cells) → (∀ (a : GaussianInt), (a = x ∨ a = x + 1 ∨ a = x + ⟨0, 1⟩ ∨ a = x + 1 + - ⟨0, 1⟩) → (a ∈ FootprintVertices T))) → (∀ (n : ℕ), ∀ (T : ProtoTile), ∀ (h : Fin n → - PartialOdometer), - let E (a b : GaussianInt) : Prop := FourNeighborAdjacent a b ∧ - ({a, b} : Finset GaussianInt) ∈ FootprintEdges T - let covered (a b : GaussianInt) : Prop := - ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain - let D (a b : GaussianInt) : ℤ := - if hc : covered a b then - (h (Classical.choose hc)).value b - (h (Classical.choose hc)).value a - else 0 - (∀ (i : Fin n), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (a ∈ (h i).domain) - → ((b ∈ (h i).domain) → (D a b = (h i).value b - (h i).value a))) → ((∀ (a : - GaussianInt), ∀ (b : GaussianInt), (E a b) → (covered a b)) → ( - let G : SimpleGraph {x // x ∈ FootprintVertices T} := { - Adj := fun a b => E a.val b.val - symm := ⟨by - intro a b hab - exact ⟨adjacent_symm a b hab.1, by simpa [Finset.pair_comm] using hab.2⟩⟩ - loopless := ⟨by intro a ha; exact adjacent_irrefl a ha.1⟩ } - ∀ (z : LatticeCell), (z ∈ (↑T.cells : Set LatticeCell)) → - (({ x : GaussianInt // x ∈ FootprintVertices T } → ℤ) → (∀ (g' : PartialOdometer), - ((↑g'.domain : Set GaussianInt) = FootprintVertices T) → ((∀ (i : Fin n), - OdometerCompatibility g' (h i)) → (∀ a, ∀ b, G.Adj a b → g'.value b - g'.value a = D - a b)))))))) := by + ∀ + (adjacent_symm : + ∀ (a : GaussianInt), + ∀ (b : GaussianInt), FourNeighborAdjacent a b → FourNeighborAdjacent b a), + ∀ (adjacent_irrefl : ∀ (a : GaussianInt), ¬FourNeighborAdjacent a a), + ∀ (n : ℕ), + ∀ (T : ProtoTile), + ∀ (h : Fin n → PartialOdometer), + let E (a b : GaussianInt) : Prop := + FourNeighborAdjacent a b ∧ + ({ a, b } : Finset GaussianInt) ∈ FootprintEdges T; + let covered (a b : GaussianInt) : Prop := + ∃ i, a ∈ (h i).domain ∧ b ∈ (h i).domain; + let D (a b : GaussianInt) : ℤ := + if hc : covered a b then + (h (Classical.choose hc)).value b - + (h (Classical.choose hc)).value a + else 0; + (∀ (i : Fin n), + ∀ (a : GaussianInt), + ∀ (b : GaussianInt), + a ∈ (h i).domain → + b ∈ (h i).domain → D a b = (h i).value b - (h i).value a) → + (∀ (a : GaussianInt), ∀ (b : GaussianInt), E a b → covered a b) → + let G : SimpleGraph { x // x ∈ FootprintVertices T } := + { Adj := fun a b => E a.val b.val + symm := + ⟨by + intro a b hab + exact + ⟨adjacent_symm a b hab.1, by + simpa [Finset.pair_comm] using hab.2⟩⟩ + loopless := ⟨by intro a ha; exact adjacent_irrefl a ha.1⟩ }; + ∀ (g' : PartialOdometer), + (↑g'.domain : Set GaussianInt) = FootprintVertices T → + (∀ (i : Fin n), OdometerCompatibility g' (h i)) → + ∀ a, ∀ b, G.Adj a b → g'.value b - g'.value a = D a b + ) := by classical - intro adjacent_symm adjacent_irrefl corner n T h E covered D dmember edge_cover G z hz f g' - hg'dom hg'compat a b hab + intro adjacent_symm adjacent_irrefl n T h E covered D dmember edge_cover G g' hg'dom hg'compat + a b hab obtain ⟨i, hai, hbi⟩ := edge_cover a b hab have hga : a.val ∈ g'.domain := by change a.val ∈ (g'.domain : Set GaussianInt) @@ -927,12 +942,12 @@ theorem OdometerGluing : have hgvalue (x : {x // x ∈ FootprintVertices T}) : g.value x = f x := by simp [g, x.property] have hgcompat := OdometerGluingProof.hgcompat adjacent_symm adjacent_irrefl - edge_vertices footprint_constant n T U h hU hdom hcells hverts dmember z hz f hfedge + edge_vertices footprint_constant n T U h hU hdom hcells hverts dmember f hfedge hdomain hgvalue refine ⟨g, hdomain, hgcompat, ?_⟩ intro g' hg'dom hg'compat - have hg'edge := OdometerGluingProof.hg'edge adjacent_symm adjacent_irrefl corner n T h - dmember edge_cover z hz f g' hg'dom hg'compat + have hg'edge := OdometerGluingProof.hg'edge adjacent_symm adjacent_irrefl n T h + dmember edge_cover g' hg'dom hg'compat obtain ⟨c, hc⟩ := hfunique (fun x => g'.value x) hg'edge refine ⟨c, ?_⟩ intro x hx diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean index 2fa535e18c..9b9004a445 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean @@ -1196,24 +1196,33 @@ private theorem interiorTransforms : (by classical exact - (BandCircle) → ((BandCircle) → ((Fin 3) → ((ProtoTile) → ((List ProtoTile) → ((Fin (4 : - ℕ) → CircleCoordinates) → (∀ (centerShift : GaussianInt), (GaussianInt) → (∀ (couter - : GaussianInt), ∀ (eouter : ℤ), - let a : GaussianInt := -couter - let b : Int := -eouter - ∀ (eback : ℤ), - let bplus : Int := -eback - ∀ (hs : List PartialOdometer), - let constAt : Nat → Int := fun n => - if n = 0 then 0 else if n + 1 = hs.length then bplus else b - let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => - PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) - ∀ n, ∀ (l : List PartialOdometer), 0 < n → hs.length = n + l.length → List.Forall₂ (fun h - g => g = PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a b) - l.dropLast ((l.mapIdx (fun j h => transformAt (n + j) h)).dropLast)))))))) ) := by + ∀ (centerShift : GaussianInt), + ∀ (couter : GaussianInt), + ∀ (eouter : ℤ), + let a : GaussianInt := -couter + let b : Int := -eouter + ∀ (eback : ℤ), + let bplus : Int := -eback + ∀ (hs : List PartialOdometer), + let constAt : Nat → Int := fun n => + if n = 0 then 0 else if n + 1 = hs.length then bplus else b + let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift + a (constAt n) + ∀ n, + ∀ (l : List PartialOdometer), + 0 < n → + hs.length = n + l.length → + List.Forall₂ + (fun h g => + g = + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) + centerShift a b) + l.dropLast + (l.mapIdx fun j h => transformAt (n + j) h).dropLast + ) := by classical - intro C₀ Cᵢ i T₀' tiles q' centerShift touter couter eouter a b eback bplus hs constAt - transformAt n l + intro centerShift couter eouter a b eback bplus hs constAt transformAt n l induction l generalizing n with | nil => intro hn hlen; simp | cons x xs ih => @@ -1356,12 +1365,14 @@ private theorem zip_dropLast_eq : (by classical exact - (BandCircle) → ((BandCircle) → ((Fin 3) → ((ProtoTile) → ((List ProtoTile) → ((Fin (4 : - ℕ) → CircleCoordinates) → ((GaussianInt) → ((List PartialOdometer) → (∀ {α : Type}, ∀ - {β : Type}, ∀ (xs : List α), ∀ (ys : List β), xs.length = ys.length → xs.dropLast.zip - ys.dropLast = (xs.zip ys).dropLast)))))))) ) := by + ∀ {α : Type}, + ∀ {β : Type}, + ∀ (xs : List α), + ∀ (ys : List β), + xs.length = ys.length → xs.dropLast.zip ys.dropLast = (xs.zip ys).dropLast + ) := by classical - intro C₀ Cᵢ i T₀' tiles q' touter hs α β xs + intro α β xs induction xs with | nil => intro ys h; cases ys <;> simp at h ⊢ | cons x xs ih => @@ -1454,12 +1465,14 @@ private theorem zip_mem_left : (by classical exact - (BandCircle) → ((BandCircle) → ((Fin 3) → ((ProtoTile) → ((List ProtoTile) → ((Fin (4 : - ℕ) → CircleCoordinates) → ((GaussianInt) → ((List PartialOdometer) → (∀ {α : Type}, ∀ - {β : Type}, ∀ (xs : List α), ∀ (ys : List β), xs.length = ys.length → ∀ x, x ∈ xs → ∃ - y, (x, y) ∈ xs.zip ys)))))))) ) := by + ∀ {α : Type}, + ∀ {β : Type}, + ∀ (xs : List α), + ∀ (ys : List β), + xs.length = ys.length → ∀ x, x ∈ xs → ∃ y, (x, y) ∈ xs.zip ys + ) := by classical - intro C₀ Cᵢ i T₀' tiles q' touter hs α β xs + intro α β xs induction xs with | nil => intro ys h x hx; simp at hx | cons a xs ih => @@ -1814,7 +1827,7 @@ private theorem opposingBoundaryConclusion : (∀ (T₀ : ProtoTile), ∀ (T₀' : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (h₀' : PartialOdometer), ((0 : ℤ) < Cᵢ.1.1.1) → (∀ (p₀ : Real × Real), ∀ (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → UnitOccurrenceOrientation q i o), - let orientation := Classical.choose horientationExists + let orientation := Classical.choose horientationExists; ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (hseed : PartialOdometer), (BoundaryString C₀ Cᵢ i orientation T₀ base Rminus Rplus tiles) → ((Fin (4 : ℕ) → CircleCoordinates) → ((TileString Cᵢ @@ -1825,42 +1838,41 @@ private theorem opposingBoundaryConclusion : Rminus.cells) → ((List.Forall₂ (fun (T U : ProtoTile) => (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells) tiles reverseTiles) → ( let pminus := p₀ + (1 / 2 : Real) • GaussianRealPoint - (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ)) + (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ)); let pplus := p₀ + (1 / 2 : Real) • GaussianRealPoint - (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)) - let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ) - let hminus := PartialOdometerAffineTranslate hseed 0 d 0 + (BandVectors.2 (q i.succ) (q 0) + BandVectors.2 (q 0) (q i.succ)); + let d : GaussianInt := -BandVectors.2 (q ((i + 1).succ)) (q i.succ); + let hminus := PartialOdometerAffineTranslate hseed 0 d 0; (TileOdometer Cᵢ.1.1 Rminus hminus) → ((PartialOdometerSlope hminus = some pminus) → ((0 < C₀.1.1.1) → ( - let Tbar := TileTranslation (TileHalfTurn T₀) centerShift + let Tbar := TileTranslation (TileHalfTurn T₀) centerShift; (BandPrototile C₀.1.1 T₀') → ((Tbar.cells = T₀'.cells) → ((GaussianInt) → (∀ (couter : GaussianInt), ∀ (eouter : ℤ), - let a : GaussianInt := -couter - let b : Int := -eouter + let a : GaussianInt := -couter; + let b : Int := -eouter; let houterAffine := PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h₀) centerShift a b + (PartialOdometerHalfTurn h₀) centerShift a b; (h₀' = houterAffine) → ( let hplus := PartialOdometerAffineTranslate - (PartialOdometerHalfTurn hminus) centerShift a 0 + (PartialOdometerHalfTurn hminus) centerShift a 0; (TileOdometer Cᵢ.1.1 Rplus hplus) → ((PartialOdometerSlope hplus = some pplus) → (∀ (eback : ℤ), - let bplus : Int := -eback + let bplus : Int := -eback; let hminusBack := PartialOdometerAffineTranslate - (PartialOdometerHalfTurn hplus) centerShift a bplus - (hminus = hminusBack) → ((tiles.head? = some Rminus) → ((tiles.getLast? = some Rplus) → + (PartialOdometerHalfTurn hplus) centerShift a bplus; + (hminus = hminusBack) → ((tiles.head? = some Rminus) → ( ((2 ≤ tiles.length) → (∀ (hs : List PartialOdometer), (hs.head? = some hminus) → ((hs.getLast? = some hplus) → ((OdometerStringRespect Cᵢ orientation base Rminus Rplus tiles hs) → ((∀ T ∈ (List.drop (1 : ℕ) tiles).dropLast, ∃ (h : PartialOdometer), (T, h) ∈ tiles.zip hs ∧ AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀ h h₀) → - ((hs.length = tiles.length) → ((2 ≤ hs.length) → ( + ((hs.length = tiles.length) → ( + ( let constAt : Nat → Int := fun n => - if n = 0 then 0 else if n + 1 = hs.length then bplus else b + if n = 0 then 0 else if n + 1 = hs.length then bplus else b; let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => - PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) - let gs := hs.mapIdx transformAt - (∀ n, ∀ l, List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a c) l (l.mapIdx (fun j h => transformAt (n + - j) h))) → ((List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n); + let gs := hs.mapIdx transformAt; + ((List.Forall₂ (fun h g => ∃ c : Int, g = PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a c) hs gs) → (exists orientation : Bool, exists centerShift : GaussianInt, exists base Rminus Rplus : ProtoTile, exists tiles reverseTiles : List ProtoTile, exists hs reverseHs : List PartialOdometer, exists @@ -1891,9 +1903,8 @@ private theorem opposingBoundaryConclusion : Rminus Rplus tiles hseed hboundaryOriginal q' hstring centerShift reverseTiles hreverse hminusCells hplusCells hcellPairs pminus pplus d hminus hOminus hsminus hC₀positive Tbar hT₀'band houterCells touter couter eouter a b houterAffine houterAffineEq hplus hOplus - hsplus eback bplus hminusBack hminusBackEq htilesHead htilesLast htilesLength hs hhsHead - hhsLast hrespect hancestorForward hlengthEq hlengthHs constAt transformAt gs - transformForall htransform + hsplus eback bplus hminusBack hminusBackEq htilesHead htilesLength hs hhsHead hhsLast + hrespect hancestorForward hlengthEq constAt transformAt gs htransform have hgsHead := OpposingBoundaryGeometry.hgsHead q i hseed centerShift couter eouter eback hs hhsHead have hgsLast := (show @@ -1912,8 +1923,8 @@ private theorem opposingBoundaryConclusion : (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells have hinteriorCells := OpposingBoundaryGeometry.hinteriorCells tiles centerShift reverseTiles hcellPairs htilesLength (OpposingBoundaryGeometry.forall2_dropLast) - have interiorTransforms := OpposingBoundaryGeometry.interiorTransforms C₀ Cᵢ i T₀' tiles q' - centerShift touter couter eouter eback hs + have interiorTransforms := OpposingBoundaryGeometry.interiorTransforms + centerShift couter eouter eback hs have hgsTail := OpposingBoundaryGeometry.hgsTail q i hseed centerShift couter eouter eback hs hhsHead have htailLength := OpposingBoundaryGeometry.htailLength q i hseed hs hhsHead @@ -1930,7 +1941,7 @@ private theorem opposingBoundaryConclusion : ∀ {α β : Type} (xs : List α) (ys : List β), xs.length = ys.length → xs.dropLast.zip ys.dropLast = (xs.zip ys).dropLast := - @OpposingBoundaryGeometry.zip_dropLast_eq C₀ Cᵢ i T₀' tiles q' touter hs + @OpposingBoundaryGeometry.zip_dropLast_eq have hzipDropOne := OpposingBoundaryGeometry.hzipDropOne q i Rminus tiles hseed htilesHead hs hhsHead have hzipInteriorEq := OpposingBoundaryGeometry.hzipInteriorEq tiles hs zip_dropLast_eq @@ -1939,7 +1950,7 @@ private theorem opposingBoundaryConclusion : have zip_mem_left : ∀ {α β : Type} (xs : List α) (ys : List β), xs.length = ys.length → ∀ x, x ∈ xs → ∃ y, (x, y) ∈ xs.zip ys := - @OpposingBoundaryGeometry.zip_mem_left C₀ Cᵢ i T₀' tiles q' touter hs + @OpposingBoundaryGeometry.zip_mem_left have zip_fst_mem : ∀ {α β : Type} {xs : List α} {ys : List β} {x : α} {y : β}, (x, y) ∈ xs.zip ys → x ∈ xs := @OpposingBoundaryGeometry.zip_fst_mem @@ -2270,8 +2281,8 @@ theorem OpposingBoundaryOdometerStrings hpositive p₀ horientationExists base Rminus Rplus tiles hseed hboundaryOriginal q' hstring centerShift reverseTiles hreverse hminusCells hplusCells hcellPairs hOminus hsminus hC₀positive hT₀'band houterCells touter couter eouter houterAffineEq hOplus hsplus eback - hminusBackEq htilesHead htilesLast htilesLength hs hhsHead hhsLast hrespect - hancestorForward hlengthEq hlengthHs transformForall (OpposingBoundaryGeometry.htransform + hminusBackEq htilesHead htilesLength hs hhsHead hhsLast hrespect + hancestorForward hlengthEq (OpposingBoundaryGeometry.htransform centerShift couter eouter eback hs transformForall)) diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean index de0d51c712..962dac562b 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean @@ -290,12 +290,13 @@ private theorem slope_defined : (by classical exact - (BandCircle) → (∀ (Ci : BandCircle), (GaussianInt) → ((GaussianInt) → ((List GaussianInt) - → ((PeriodicTileComplex ↥(TilingLattice Ci)) → (∀ (c : CircleCoordinates), ∀ (T : - ProtoTile), ∀ (f : PartialOdometer), TileOdometer c T f → 1 < c.1 → ∃ p : ℝ × ℝ, - PartialOdometerSlope f = some p))))) ) := by + ∀ (c : CircleCoordinates), + ∀ (T : ProtoTile), + ∀ (f : PartialOdometer), + TileOdometer c T f → 1 < c.1 → ∃ p : ℝ × ℝ, PartialOdometerSlope f = some p + ) := by classical - intro C0 Ci a b rest P c T f ho hc + intro c T f ho hc induction ho with | line w z hw hdom => omega | unit z w T f hT hdom htrans => omega @@ -323,20 +324,22 @@ private theorem invStep : (by classical exact - (BandCircle) → (∀ (Ci : BandCircle), ((1 : ℤ) < Ci.1.1.1) → ((GaussianInt) → - ((GaussianInt) → ((List GaussianInt) → ((PeriodicTileComplex ↥(TilingLattice Ci)) → ( - let slopeVec := fun f : PartialOdometer => - let p := (PartialOdometerSlope f).getD (0, 0) - ![p.1, p.2] - let centroidVec := fun T : ProtoTile => - ![(TileCentroid T).1, (TileCentroid T).2] - let invariant := fun X : ProtoTile × PartialOdometer => - slopeVec X.2 - Matrix.mulVec (CircleMatrix Ci) (centroidVec X.1) - let invRel := fun X Y : ProtoTile × PartialOdometer => invariant X = invariant Y - ∀ A B : ProtoTile × PartialOdometer, LeftLatticeAdjacent Ci A.1 B.1 A.2 B.2 → invRel A - B)))))) ) := by + ∀ (Ci : BandCircle), + (1 : ℤ) < Ci.1.1.1 → + let slopeVec := fun f : PartialOdometer => + let p := (PartialOdometerSlope f).getD (0, 0) + ![p.1, p.2] + let centroidVec := fun T : ProtoTile => + ![(TileCentroid T).1, (TileCentroid T).2] + let invariant := fun X : ProtoTile × PartialOdometer => + slopeVec X.2 - Matrix.mulVec (CircleMatrix Ci) (centroidVec X.1) + let invRel := fun X Y : ProtoTile × PartialOdometer => + invariant X = invariant Y + ∀ A B : ProtoTile × PartialOdometer, + LeftLatticeAdjacent Ci A.1 B.1 A.2 B.2 → invRel A B + ) := by classical - intro C0 Ci hlarge a b rest P slopeVec centroidVec invariant invRel A B hadj + intro Ci hlarge slopeVec centroidVec invariant invRel A B hadj rcases hadj with ⟨_, _, p, p', hp, hp', hcase⟩ rcases hcase with hunit | ⟨q, j, e, hq, hq0, hcent, hpRe, hpIm⟩ · omega @@ -858,7 +861,7 @@ theorem OpposingBoundaryStarLocalization have hadjIndex : P.plane.adjacent uIdx vIdx := hadjP.1.mp (OpposingStarGeometry.hedgeP Ci x y U V hedge u huL v hvL P hPU hPV) obtain ⟨j, hdisp⟩ := (hPadj uIdx vIdx).mp hadjIndex - have slope_defined := OpposingStarGeometry.slope_defined C0 Ci a b rest P + have slope_defined := OpposingStarGeometry.slope_defined obtain ⟨pU, hpU⟩ := slope_defined Ci.1.1 U g hUchildOdo (by omega) obtain ⟨pV, hpV⟩ := slope_defined Ci.1.1 V k hVchildOdo (by omega) let slopeVec := fun f : PartialOdometer => @@ -869,7 +872,7 @@ theorem OpposingBoundaryStarLocalization let invariant := fun X : ProtoTile × PartialOdometer => slopeVec X.2 - Matrix.mulVec (CircleMatrix Ci) (centroidVec X.1) let invRel := fun X Y : ProtoTile × PartialOdometer => invariant X = invariant Y - have invStep := OpposingStarGeometry.invStep C0 Ci hlarge a b rest P + have invStep := OpposingStarGeometry.invStep Ci hlarge have hfirstInvChain : List.IsChain invRel (tiles.zip hs) := hRespect.2.2.imp (fun A B hadj => invStep A B hadj) have hreverseInvChain : List.IsChain invRel (reverseTiles.zip reverseHs) := diff --git a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean index 8c741a1d97..1d137f2a10 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean @@ -237,18 +237,21 @@ private theorem hcellCalc : (by classical exact - (BandCircle) → (∀ (base : ProtoTile), ∀ (x : GaussianInt), (base.cells = {x}) → ( - let tileAt : Int × Int → ProtoTile := fun z => - TileTranslation base ((z.1 : GaussianInt) * (⟨0, 1⟩ : GaussianInt) + (z.2 : - GaussianInt) * (-1)) - let x0 : GaussianInt := ⟨x.im, -x.re - 1⟩ - let unitAt : Int × Int → ProtoTile := fun z => - TileTranslation (⟨{x0}, x0⟩ : ProtoTile) - (⟨z.1, z.2⟩ : GaussianInt) - let turnedAt : Int × Int → ProtoTile := fun z => TileQuarterTurn (unitAt z) - ∀ (z : Int × Int), (tileAt z).cells = (turnedAt z).cells)) ) := by + ∀ (base : ProtoTile), + ∀ (x : GaussianInt), + base.cells = { x } → + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base + ((z.1 : GaussianInt) * (⟨0, 1⟩ : GaussianInt) + + (z.2 : GaussianInt) * -1) + let x0 : GaussianInt := ⟨x.im, -x.re - 1⟩ + let unitAt : Int × Int → ProtoTile := fun z => + TileTranslation (⟨{ x0 }, x0⟩ : ProtoTile) (⟨z.1, z.2⟩ : GaussianInt) + let turnedAt : Int × Int → ProtoTile := fun z => TileQuarterTurn (unitAt z) + ∀ (z : Int × Int), (tileAt z).cells = (turnedAt z).cells + ) := by classical - intro C base x hcells tileAt x0 unitAt turnedAt z + intro base x hcells tileAt x0 unitAt turnedAt z simp only [TileTranslation, Int.reduceNeg, Zsqrtd.smul_val, mul_zero, mul_one, mul_neg, hcells, Finset.image_singleton, GaussianTranslation, TileQuarterTurn, GaussianQuarterTurn, Zsqrtd.add_def, neg_add_rev, neg_sub, sub_neg_eq_add, @@ -302,13 +305,14 @@ private theorem qstep : (by classical exact - (BandCircle) → ( let q := GaussianQuarterTurn - ∀ (u : GaussianInt), ∀ (v : GaussianInt), (v = u + 1 ∨ v = u - 1 ∨ - v = u + ⟨0, 1⟩ ∨ v = u - ⟨0, 1⟩) → (q v = q u + 1 ∨ q v = q u - 1 ∨ q v = q u + ⟨0, - 1⟩ ∨ q v = q u - ⟨0, 1⟩)) ) := by + ∀ (u : GaussianInt), + ∀ (v : GaussianInt), + v = u + 1 ∨ v = u - 1 ∨ v = u + ⟨0, 1⟩ ∨ v = u - ⟨0, 1⟩ → + q v = q u + 1 ∨ q v = q u - 1 ∨ q v = q u + ⟨0, 1⟩ ∨ q v = q u - ⟨0, 1⟩ + ) := by classical - intro C q u v huv + intro q u v huv rcases huv with h | h | h | h · subst v right; right; left @@ -880,31 +884,56 @@ private theorem hadjXiAt795 : (by classical exact - ∀ (C : BandCircle), ∀ (base : ProtoTile), (List (ℤ × ℤ)) → (∀ (q : Fin (4 : ℕ) → - CircleCoordinates), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (chart : - AffineTriangularComplexChart P fun (mn : ℤ × ℤ) => TileTranslation base ((↑mn.1 : - GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑mn.2 : - GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))))), ((∀ (x : - ℤ × ℤ), ∀ (y : ℤ × ℤ), TriangularLatticeAdjacent x.swap y.swap ↔ - TriangularLatticeAdjacent x y) ∧ (∀ (f : AffineTriangularFace), Finset.image - Prod.swap (AffineTriangularFaceVertices f) = AffineTriangularFaceVertices - (AffineTriangularFaceCoordinateSwap f)) ∧ (∀ (z : ℤ × ℤ), TileTranslation base ((↑z.1 - : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + (↑z.2 : - GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))) = P.tile - ((chart.vertexEquiv : ℤ × ℤ → ↥(TilingLattice C)) z.swap)) ∧ ∀ (f : - AffineTriangularFace), - let F := (match AffineTriangularFaceCoordinateSwap f with - | AffineTriangularFace.up z => chart.up z - | AffineTriangularFace.down z => chart.down z); Finset.image (fun (z : ℤ × - ℤ) => (chart.vertexEquiv : ℤ × ℤ → ↥(TilingLattice C)) z.swap) - (AffineTriangularFaceVertices f) = {P.plane.faceVertex F (0 : Fin (3 : ℕ)), - P.plane.faceVertex F (1 : Fin (3 : ℕ)), P.plane.faceVertex F (2 : Fin (3 : ℕ))}) → ( - let xi := fun z : Int × Int => - chart.vertexEquiv (Prod.swap z) - ∀ (u : Int × Int), ∀ (v : Int × Int), TriangularLatticeAdjacent u v ↔ P.plane.adjacent - (xi u) (xi v)))) := by + ∀ (C : BandCircle), + ∀ (base : ProtoTile), + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + ∀ + (chart : + AffineTriangularComplexChart P fun (mn : ℤ × ℤ) => + TileTranslation base + ((↑mn.1 : GaussianInt) * + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + + (↑mn.2 : GaussianInt) * + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))))), + ((∀ (x : ℤ × ℤ), + ∀ (y : ℤ × ℤ), + TriangularLatticeAdjacent x.swap y.swap ↔ + TriangularLatticeAdjacent x y) ∧ + (∀ (f : AffineTriangularFace), + Finset.image Prod.swap (AffineTriangularFaceVertices f) = + AffineTriangularFaceVertices + (AffineTriangularFaceCoordinateSwap f)) ∧ + (∀ (z : ℤ × ℤ), + TileTranslation base + ((↑z.1 : GaussianInt) * + BandVectors.1 (q (2 : Fin (4 : ℕ))) + (q (0 : Fin (4 : ℕ))) + + (↑z.2 : GaussianInt) * + BandVectors.1 (q (1 : Fin (4 : ℕ))) + (q (0 : Fin (4 : ℕ)))) = + P.tile + ((chart.vertexEquiv : ℤ × ℤ → ↥(TilingLattice C)) + z.swap)) ∧ + ∀ (f : AffineTriangularFace), + let F := + match AffineTriangularFaceCoordinateSwap f with + | AffineTriangularFace.up z => chart.up z + | AffineTriangularFace.down z => chart.down z; + Finset.image + (fun (z : ℤ × ℤ) => + (chart.vertexEquiv : ℤ × ℤ → ↥(TilingLattice C)) z.swap) + (AffineTriangularFaceVertices f) = + {P.plane.faceVertex F (0 : Fin (3 : ℕ)), + P.plane.faceVertex F (1 : Fin (3 : ℕ)), + P.plane.faceVertex F (2 : Fin (3 : ℕ))}) → + let xi := fun z : Int × Int => chart.vertexEquiv (Prod.swap z) + ∀ (u : Int × Int), + ∀ (v : Int × Int), + TriangularLatticeAdjacent u v ↔ P.plane.adjacent (xi u) (xi v) + ) := by classical - intro C base F q P chart halign xi u v + intro C base q P chart halign xi u v change TriangularLatticeAdjacent u v ↔ P.plane.adjacent (chart.vertexEquiv (Prod.swap u)) (chart.vertexEquiv (Prod.swap v)) @@ -1029,48 +1058,86 @@ private theorem finish : (by classical exact - ∀ (base : ProtoTile), ∀ (R : ProtoTile), ∀ (S : ProtoTile), ∀ (forward : List ProtoTile), - ∀ (reverse : List ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), - let tileAt : Int × Int → ProtoTile := fun z => - TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) - ∀ (r : ℤ × ℤ), (R = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + - (↑z.2 : GaussianInt) * b)) r) → ((∀ (y : ℤ × ℤ), (fun (z : ℤ × ℤ) => R = (fun (z : ℤ - × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) - z) y → y = r) → (∀ (s : ℤ × ℤ), (S = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 - : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) s) → ((∀ (y : ℤ × ℤ), (fun (z : ℤ × - ℤ) => S = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 - : GaussianInt) * b)) z) y → y = s) → ((R = tileAt r) → ((S = tileAt s) → (∀ (F : List - (ℤ × ℤ)), ∀ (G : List (ℤ × ℤ)), (TriangularStripSegment r s F) → - ((TriangularStripSegment s r G) → ((r ≠ s) → ((¬TriangularLatticeAdjacent r s) → ((∀ - z ∈ (List.drop (1 : ℕ) F).dropLast, ∃ T ∈ (List.drop (1 : ℕ) forward).dropLast, T = - (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : - GaussianInt) * b)) z) → ((∀ z ∈ (List.drop (1 : ℕ) G).dropLast, ∃ T ∈ (List.drop (1 : - ℕ) reverse).dropLast, T = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : - GaussianInt) * a + (↑z.2 : GaussianInt) * b)) z) → (∀ (faces : List - AffineTriangularFace), (faces ≠ []) → ((∃ (f : AffineTriangularFace), faces.head? = - some f ∧ r ∈ AffineTriangularFaceVertices f) → ((∃ (f : AffineTriangularFace), - faces.getLast? = some f ∧ s ∈ AffineTriangularFaceVertices f) → ((∀ f ∈ faces, (∃ a ∈ - (List.drop (1 : ℕ) F).dropLast, a ∈ AffineTriangularFaceVertices f) ∧ ∃ b ∈ - (List.drop (1 : ℕ) G).dropLast, b ∈ AffineTriangularFaceVertices f) → ((List.IsChain - (AffineTriangularCorridorStep F G) faces) → (∀ {ι : Type}, ∀ [DecidableEq ι], ∀ (PP : - PeriodicTileComplex ι), ∀ (xi : Int × Int → ι), ∀ (faceAt : AffineTriangularFace → - PP.plane.Face), (∀ u, ∀ v, TriangularLatticeAdjacent u v ↔ - PP.plane.adjacent (xi u) (xi v)) → ((∀ z, PP.tile (xi z) = tileAt z) → - ((Function.Injective faceAt) → ((∀ f, (AffineTriangularFaceVertices f).image xi = - {PP.plane.faceVertex (faceAt f) 0, - PP.plane.faceVertex (faceAt f) 1, - PP.plane.faceVertex (faceAt f) 2}) → (∃ p : List GaussianInt, (∃ x, p.head? = some - x ∧ x ∈ FootprintVertices R) ∧ (∃ y, p.getLast? = some y ∧ y ∈ - FootprintVertices S) ∧ p.IsChain (fun x y => y = x + 1 ∨ y = x - 1 ∨ y = x + - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) ∧ (∀ x, x ∈ p → (∃ a ∈ (forward.drop 1).dropLast, x ∈ - FootprintVertices a) ∧ (∃ b ∈ (reverse.drop 1).dropLast, x ∈ FootprintVertices - b)) ∧ ∀ x y : GaussianInt, ∀ l₁ l₂ : List GaussianInt, p = l₁ ++ x :: y :: l₂ → - (∃ a ∈ (forward.drop 1).dropLast, {x, y} ∈ FootprintEdges a) ∧ (∃ b ∈ - (reverse.drop 1).dropLast, {x, y} ∈ FootprintEdges b)))))))))))))))))))))) ) := by + ∀ (base : ProtoTile), + ∀ (R : ProtoTile), + ∀ (S : ProtoTile), + ∀ (forward : List ProtoTile), + ∀ (reverse : List ProtoTile), + ∀ (a : GaussianInt), + ∀ (b : GaussianInt), + let tileAt : Int × Int → ProtoTile := fun z => + TileTranslation base + ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b); + ∀ (r : ℤ × ℤ), + ∀ (s : ℤ × ℤ), + R = tileAt r → + S = tileAt s → + ∀ (F : List (ℤ × ℤ)), + ∀ (G : List (ℤ × ℤ)), + r ≠ s → + ¬TriangularLatticeAdjacent r s → + (∀ z ∈ (List.drop (1 : ℕ) F).dropLast, + ∃ T ∈ (List.drop (1 : ℕ) forward).dropLast, + T = + (fun (z : ℤ × ℤ) => + TileTranslation base + ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) + z) → + (∀ z ∈ (List.drop (1 : ℕ) G).dropLast, + ∃ T ∈ (List.drop (1 : ℕ) reverse).dropLast, + T = + (fun (z : ℤ × ℤ) => + TileTranslation base + ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) + z) → + ∀ (faces : List AffineTriangularFace), + faces ≠ [] → + (∃ (f : AffineTriangularFace), + faces.head? = some f ∧ + r ∈ AffineTriangularFaceVertices f) → + (∃ (f : AffineTriangularFace), + faces.getLast? = some f ∧ + s ∈ AffineTriangularFaceVertices f) → + List.IsChain (AffineTriangularCorridorStep F G) faces → + ∀ {ι : Type}, + ∀ [DecidableEq ι], + ∀ (PP : PeriodicTileComplex ι), + ∀ (xi : Int × Int → ι), + ∀ (faceAt : AffineTriangularFace → PP.plane.Face), + (∀ u, + ∀ v, + TriangularLatticeAdjacent u v ↔ + PP.plane.adjacent (xi u) (xi v)) → + (∀ z, PP.tile (xi z) = tileAt z) → + Function.Injective faceAt → + (∀ f, + (AffineTriangularFaceVertices f).image xi = + {PP.plane.faceVertex (faceAt f) 0, + PP.plane.faceVertex (faceAt f) 1, + PP.plane.faceVertex (faceAt f) 2}) → + ∃ p : List GaussianInt, + (∃ x, p.head? = some x ∧ x ∈ FootprintVertices R) ∧ + (∃ y, p.getLast? = some y ∧ y ∈ FootprintVertices S) ∧ + (p.IsChain fun x y => + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) ∧ + (∀ x, + x ∈ p → + (∃ a ∈ (forward.drop 1).dropLast, + x ∈ FootprintVertices a) ∧ + ∃ b ∈ (reverse.drop 1).dropLast, + x ∈ FootprintVertices b) ∧ + ∀ x y : GaussianInt, + ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ x :: y :: l₂ → + (∃ a ∈ (forward.drop 1).dropLast, + { x, y } ∈ FootprintEdges a) ∧ + ∃ b ∈ (reverse.drop 1).dropLast, + { x, y } ∈ FootprintEdges b + ) := by classical - intro base R S forward reverse a b tileAt r hrcoord hruniq s hscoord hsuniq hR hS F G hFstrip - hGstrip hrs hnadjCoord forwardInterior reverseInterior faces hfacesNe hfirst hlast - hfaceVertices hfaceChain ι typeclassInstance0 PP xi faceAt hadjXi htileXi hinjFace hinc + intro base R S forward reverse a b tileAt r s hR hS F G hrs hnadjCoord forwardInterior + reverseInterior faces hfacesNe hfirst hlast hfaceChain ι typeclassInstance0 PP xi faceAt + hadjXi htileXi hinjFace hinc let goodV : GaussianInt → Prop := fun x => (∃ a ∈ (F.drop 1).dropLast, x ∈ FootprintVertices (tileAt a)) ∧ (∃ b ∈ (G.drop 1).dropLast, x ∈ FootprintVertices (tileAt b)) @@ -1368,7 +1435,7 @@ theorem OpposingStringInterfacePath TileTranslation (⟨{x0}, x0⟩ : ProtoTile) (⟨z.1, z.2⟩ : GaussianInt) let turnedAt : Int × Int → ProtoTile := fun z => TileQuarterTurn (unitAt z) - have hcellCalc := OpposingInterfaceGeometry.hcellCalc C base x hcells + have hcellCalc := OpposingInterfaceGeometry.hcellCalc base x hcells have hvertsEq (z : Int × Int) : FootprintVertices (tileAt z) = FootprintVertices (turnedAt z) := OpposingInterfaceGeometry.hvertsEqAt314 base x hcellCalc z @@ -1389,7 +1456,7 @@ theorem OpposingStringInterfacePath OpposingInterfaceGeometry.hqverts x z have hqedges := OpposingInterfaceGeometry.hqedges x refine ⟨p.map q, ?_, ?_, (OpposingInterfaceGeometry.hqchain p hpchain - (OpposingInterfaceGeometry.qstep C)), ?_, ?_⟩ + (OpposingInterfaceGeometry.qstep)), ?_, ?_⟩ · rcases hphead with ⟨v, hv, hvU⟩ have hvU' : v ∈ FootprintVertices (unitAt r) := by simpa [unitAt] using hvU @@ -1455,9 +1522,9 @@ theorem OpposingStringInterfacePath {PP.plane.faceVertex (faceAt f) 0, PP.plane.faceVertex (faceAt f) 1, PP.plane.faceVertex (faceAt f) 2}) := OpposingInterfaceConclusion.finish base R S - forward reverse a b r hrcoord hruniq s hscoord hsuniq hR hS F G hFstrip hGstrip + forward reverse a b r s hR hS F G hrs hnadjCoord forwardInterior reverseInterior faces hfacesNe hfirst hlast - hfaceVertices hfaceChain (ι := ι) PP xi faceAt hadjXi htileXi hinjFace hinc + hfaceChain (ι := ι) PP xi faceAt hadjXi htileXi hinjFace hinc rcases hbasis with hordered | hswapped · rcases hordered with ⟨haV, hbV⟩ let faceAt : AffineTriangularFace → P.plane.Face := fun f => @@ -1480,7 +1547,7 @@ theorem OpposingStringInterfacePath match AffineTriangularFaceCoordinateSwap f with | .up z => chart.up z | .down z => chart.down z - have hadjXi := OpposingInterfaceGeometry.hadjXiAt795 C base F q P chart halign + have hadjXi := OpposingInterfaceGeometry.hadjXiAt795 C base q P chart halign have htileXi := OpposingInterfaceGeometry.htileXi C base a b q P chart haV hbV halign have hinjFace := OpposingInterfaceGeometry.hinjFaceAt805 C base q P chart have hinc := OpposingInterfaceGeometry.hincAt826 C base q P chart halign diff --git a/LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean index 2e04392892..102ac62b3b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean @@ -297,47 +297,74 @@ private theorem containing : linarith [hu.1] private theorem opposite : - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real - × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (b : Fin t.count → ℝ × ℝ → Fin (3 - : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (j : Fin (3 : ℕ)), Continuous fun (z : ℝ × ℝ) => b k z - j) → ((∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), z ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) - (Set.range (p.vertex ∘ t.face k)) ↔ ∀ (j : Fin (3 : ℕ)), (0 : ℝ) ≤ b k z j) → ((∀ (k : - Fin t.count), ∀ (i : Fin (3 : ℕ)), b k (p.vertex (t.face k i)) = Pi.single i (1 : ℝ)) - → ( - let D k := convexHull Real (Set.range (p.vertex ∘ t.face k)) - (∀ (a : Fin 3), ∀ (b : Fin 3), ∀ (c : Fin 3), (a ≠ b) → ((a ≠ c) → ((b ≠ c) → (∀ j, j = a ∨ j - = b ∨ j = c)))) → ((∀ k, ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (a : Real), ∀ (c : - Real), (a + c = 1) → (∀ j, b k (a • x + c • y) j = a * b k x - j + c * b k y j)) → ((∀ k, ∀ l, (k ≠ l) → (∀ z, (∀ j, 0 < b k z j) → ((z ∈ D l) → - (False)))) → ((∀ (O : Set (Real × Real)), (IsOpen O) → (∀ z, (z ∈ O) → (∀ v, ∃ u : - Real, 0 < u - ∧ u < 1 ∧ (1 - u) • z + u • v ∈ O))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : - ℕ))), ∀ (u : ℝ), (u ∈ Set.Ioo (0 : ℝ) (1 : ℝ)) → ( - let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex j - let I : Set (Fin t.count) := {k | i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k)} - ∀ (k : Fin t.count), ∀ (l : Fin t.count), k ≠ l → - k ∈ I → - l ∈ I → - ∀ (a : Fin (3 : ℕ)), ∀ (d : Fin (3 : ℕ)), ∀ (c : Fin (3 : ℕ)), ∀ (e : Fin (3 : ℕ)), ∀ (f - : Fin (3 : ℕ)), ∀ (g : Fin (3 : ℕ)), t.face k a = i → - t.face k d = j → - a ≠ d → - a ≠ c → - d ≠ c → - t.face l e = i → - t.face l f = j → - e ≠ f → - e ≠ g → + ∀ (n : Nat), + ∀ (p : P3381T1PolygonBoundary n), + ∀ (X : Set (Real × Real)), + ∀ (K : Set (Real × Real)), + ∀ (t : P3381T1PairedTriangulation p X K), + ∀ (b : Fin t.count → ℝ × ℝ → Fin (3 : ℕ) → ℝ), + (∀ (k : Fin t.count), + ∀ (j : Fin (3 : ℕ)), Continuous fun (z : ℝ × ℝ) => b k z j) → + (∀ (k : Fin t.count), + ∀ (z : ℝ × ℝ), + z ∈ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (Set.range (p.vertex ∘ t.face k)) ↔ + ∀ (j : Fin (3 : ℕ)), (0 : ℝ) ≤ b k z j) → + (∀ (k : Fin t.count), + ∀ (i : Fin (3 : ℕ)), + b k (p.vertex (t.face k i)) = Pi.single i (1 : ℝ)) → + let D k := convexHull Real (Set.range (p.vertex ∘ t.face k)); + (∀ (a : Fin 3), + ∀ (b : Fin 3), + ∀ (c : Fin 3), + a ≠ b → a ≠ c → b ≠ c → ∀ j, j = a ∨ j = b ∨ j = c) → + (∀ k, + ∀ (x : Real × Real), + ∀ (y : Real × Real), + ∀ (a : Real), + ∀ (c : Real), + a + c = 1 → + ∀ j, b k (a • x + c • y) j = a * b k x j + c * b k y j) → + (∀ k, ∀ l, k ≠ l → ∀ z, (∀ j, 0 < b k z j) → z ∈ D l → False) → + (∀ (O : Set (Real × Real)), + IsOpen O → + ∀ z, + z ∈ O → + ∀ v, ∃ u : Real, 0 < u ∧ u < 1 ∧ (1 - u) • z + u • v ∈ O) → + ∀ (i : Fin (n + (3 : ℕ))), + ∀ (j : Fin (n + (3 : ℕ))), + ∀ (u : ℝ), + u ∈ Set.Ioo (0 : ℝ) (1 : ℝ) → + let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex j; + ∀ (k : Fin t.count), + ∀ (l : Fin t.count), + k ≠ l → + ∀ (a : Fin (3 : ℕ)), + ∀ (d : Fin (3 : ℕ)), + ∀ (c : Fin (3 : ℕ)), + ∀ (e : Fin (3 : ℕ)), + ∀ (f : Fin (3 : ℕ)), + ∀ (g : Fin (3 : ℕ)), + t.face k a = i → + t.face k d = j → + a ≠ d → + a ≠ c → + d ≠ c → + t.face l e = i → + t.face l f = j → + e ≠ f → + e ≠ g → f ≠ g → - b k z a = (1 : ℝ) - u → - b k z d = u → - b k z c = (0 : ℝ) → - b l z e = (1 : ℝ) - u → - b l z f = u → b l z g = (0 : ℝ) → b k (p.vertex (t.face l - g)) c < (0 : ℝ))))))))) := by + b k z a = (1 : ℝ) - u → + b k z d = u → + b k z c = (0 : ℝ) → + b l z e = (1 : ℝ) - u → + b l z f = u → + b l z g = (0 : ℝ) → b k (p.vertex (t.face l g)) c < (0 : ℝ) := by classical - intro n p X K t b bcontinuous bhull bvertex D indices blinear hdisjoint perturb i j u hu z I k - l hkl hk hl a d c e f g hka hkd had hac hdc hle hlf hef heg hfg hza hzd hzc hze hzf hzg + intro n p X K t b bcontinuous bhull bvertex D indices blinear hdisjoint perturb i j u hu z k + l hkl a d c e f g hka hkd had hac hdc hle hlf hef heg hfg hza hzd hzc hze hzf hzg by_contra hnot have hnonneg := le_of_not_gt hnot let O : Set (Real × Real) := {y | 0 < b k y a ∧ 0 < b k y d} @@ -372,25 +399,48 @@ private theorem opposite : exact hs0 private theorem hnotAt427 : - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real - × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (k : Fin t.count), ∀ (b : Fin - t.count → ℝ × ℝ → Fin (3 : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), z ∈ (convexHull - ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (Set.range (p.vertex ∘ t.face k)) ↔ ∀ (j : Fin (3 : ℕ)), - (0 : ℝ) ≤ b k z j) → ((∀ (k : Fin t.count), ∀ (i : Fin (3 : ℕ)), b k (p.vertex (t.face k - i)) = Pi.single i (1 : ℝ)) → ( - let D k := convexHull Real (Set.range (p.vertex ∘ t.face k)) - (∀ k, IsClosed (D k)) → (∀ k, ∀ (x : Real × Real), ∀ (y : Real × Real), ∀ (a : Real), ∀ (c : - Real), (a + c = 1) → (∀ j, b k (a • x + c • y) j = a * b k x j + c * b k y - j)) → ((∀ (O : Set (Real × Real)), (IsOpen O) → (∀ z, (z ∈ O) → (∀ v, ∃ u : Real, 0 < u ∧ - u < 1 ∧ (1 - u) • z + u • v ∈ O))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : - ℕ))), ∀ (u : ℝ), - let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex j - let I : Set (Fin t.count) := {k | i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k)} - (∀ k, (z ∈ D k) → (k ∈ I)) → ((I = {k}) → ((k ∈ I) → (∀ (a : Fin (3 : ℕ)), ∀ (c : Fin (3 : - ℕ)), (a ≠ c) → ((b k z c = (0 : ℝ)) → (z ∉ interior X))))))))) := by + ∀ (n : Nat), + ∀ (p : P3381T1PolygonBoundary n), + ∀ (X : Set (Real × Real)), + ∀ (K : Set (Real × Real)), + ∀ (t : P3381T1PairedTriangulation p X K), + ∀ (k : Fin t.count), + ∀ (b : Fin t.count → ℝ × ℝ → Fin (3 : ℕ) → ℝ), + (∀ (k : Fin t.count), + ∀ (z : ℝ × ℝ), + z ∈ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (Set.range (p.vertex ∘ t.face k)) ↔ + ∀ (j : Fin (3 : ℕ)), (0 : ℝ) ≤ b k z j) → + (∀ (k : Fin t.count), + ∀ (i : Fin (3 : ℕ)), + b k (p.vertex (t.face k i)) = Pi.single i (1 : ℝ)) → + let D k := convexHull Real (Set.range (p.vertex ∘ t.face k)); + (∀ k, IsClosed (D k)) → + (∀ k, + ∀ (x : Real × Real), + ∀ (y : Real × Real), + ∀ (a : Real), + ∀ (c : Real), + a + c = 1 → + ∀ j, b k (a • x + c • y) j = a * b k x j + c * b k y j) → + (∀ (O : Set (Real × Real)), + IsOpen O → + ∀ z, + z ∈ O → + ∀ v, ∃ u : Real, 0 < u ∧ u < 1 ∧ (1 - u) • z + u • v ∈ O) → + ∀ (i : Fin (n + (3 : ℕ))), + ∀ (j : Fin (n + (3 : ℕ))), + ∀ (u : ℝ), + let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex j; + let I : Set (Fin t.count) := + {k | i ∈ Set.range (t.face k) ∧ j ∈ Set.range (t.face k)}; + (∀ k, z ∈ D k → k ∈ I) → + I = { k } → + ∀ (c : Fin (3 : ℕ)), b k z c = (0 : ℝ) → z ∉ interior X := by classical - intro n p X K t k b bhull bvertex D closed_D blinear perturb i j u z I containing hI hk a c hac - hzc hzint + intro n p X K t k b bhull bvertex D closed_D blinear perturb i j u z I containing hI c hzc + hzint let N : Set (Real × Real) := ⋂ l, if l = k then Set.univ else (D l)ᶜ have hN : IsOpen N := by apply isOpen_iInter_of_finite @@ -1354,7 +1404,7 @@ theorem P3381T1TriangulationBoundary {n : Nat} (hza : b k z a = 1 - u) (hzd : b k z d = u) (hzc : b k z c = 0) (hze : b l z e = 1 - u) (hzf : b l z f = u) (hzg : b l z g = 0) := TriangulationBoundaryProof.opposite n p X K t b - bcontinuous bhull bvertex indices blinear hdisjoint perturb i j u hu k l hkl hk hl a + bcontinuous bhull bvertex indices blinear hdisjoint perturb i j u hu k l hkl a d c e f g hka hkd had hac hdc hle hlf hef heg hfg hza hzd hzc hze hzf hzg have hcard := t.edge_count i j hij change I.ncard = _ at hcard @@ -1364,7 +1414,7 @@ theorem P3381T1TriangulationBoundary {n : Nat} have hk : k ∈ I := by rw [hI]; simp obtain ⟨a, d, c, hka, hkd, had, hac, hdc, hza, hzd, hzc⟩ := edge_coords k hk have hnot := TriangulationBoundaryProof.hnotAt427 n p X K t k b bhull - bvertex closed_D blinear perturb i j u containing hI hk a c hac hzc + bvertex closed_D blinear perturb i j u containing hI c hzc simp only [hneighbor, not_true_eq_false, iff_false] exact hnot · simp only [hneighbor, ite_false, hused, ite_true] at hcard diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean index 1d09c5d996..7e996303fa 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean @@ -102,16 +102,21 @@ private theorem det_range_transport : (by classical exact - let triangleMatrix (v : Fin 3 → Real × Real) : - Matrix (Fin 3) (Fin 3) Real := - fun i j => if j = 0 then (v i).1 else if j = 1 then (v i).2 else 1 - (∀ (v : Fin 3 → Real × Real), P3381T1TriangleDeterminant v = (triangleMatrix v).det) → - (∀ {I : Type}, ∀ (f : Fin (3 : ℕ) → I), ∀ (g : Fin (3 : ℕ) → I), Function.Injective f - → Function.Injective g → Set.range f = Set.range g → ∀ (v : I → ℝ × ℝ), - P3381T1TriangleDeterminant (v ∘ f) ≠ (0 : ℝ) ↔ P3381T1TriangleDeterminant (v ∘ g) - ≠ (0 : ℝ)) ) := by - classical - intro triangleMatrix triangleMatrix_det I f g hf hg hr v + let triangleMatrix (v : Fin 3 → Real × Real) : Matrix (Fin 3) (Fin 3) Real := + fun i j => if j = 0 then (v i).1 else if j = 1 then (v i).2 else 1; + (∀ (v : Fin 3 → Real × Real), + P3381T1TriangleDeterminant v = (triangleMatrix v).det) → + ∀ {I : Type}, + ∀ (f : Fin (3 : ℕ) → I), + ∀ (g : Fin (3 : ℕ) → I), + Function.Injective f → + Set.range f = Set.range g → + ∀ (v : I → ℝ × ℝ), + P3381T1TriangleDeterminant (v ∘ f) ≠ (0 : ℝ) ↔ + P3381T1TriangleDeterminant (v ∘ g) ≠ (0 : ℝ) + ) := by + classical + intro triangleMatrix triangleMatrix_det I f g hf hr v have hmem (i : Fin 3) : f i ∈ Set.range g := by rw [← hr] exact Set.mem_range_self i @@ -695,21 +700,34 @@ private theorem splitHull : (by classical exact - ∀ (n : Nat), (∀ (v : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + - 3)), ∀ (z : Fin (n + 3)), v '' (({a, b, z} : Finset (Fin (n + 3))) : Set (Fin (n + - 3))) = {v a, v b, v z}) → (∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (a : Fin (n + (3 : - ℕ))), ∀ (d : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (z : Fin (n + (3 : - ℕ))), a ≠ b → a ≠ z → b ≠ z → ∀ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : ℝ) → v d = ((1 : ℝ) - - u) • v a + u • v b → P3381T1TriangleDeterminant ![v a, v b, v z] ≠ (0 : ℝ) → - (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, b, z} : Finset _) : Set (Fin - (n + (3 : - ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : - Set (Fin (n + - (3 : ℕ))))) ∪ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset - _) : Set (Fin - (n + (3 : ℕ)))))) ) := by - classical - intro n imageTriple v a d b z hab haz hbz u hu hvalue hdet + ∀ (n : Nat), + (∀ (v : Fin (n + 3) → Real × Real), + ∀ (a : Fin (n + 3)), + ∀ (b : Fin (n + 3)), + ∀ (z : Fin (n + 3)), + v '' (({ a, b, z } : Finset (Fin (n + 3))) : Set (Fin (n + 3))) = + {v a, v b, v z}) → + ∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), + ∀ (a : Fin (n + (3 : ℕ))), + ∀ (d : Fin (n + (3 : ℕ))), + ∀ (b : Fin (n + (3 : ℕ))), + ∀ (z : Fin (n + (3 : ℕ))), + ∀ (u : ℝ), + (0 : ℝ) < u ∧ u < (1 : ℝ) → + v d = ((1 : ℝ) - u) • v a + u • v b → + P3381T1TriangleDeterminant ![v a, v b, v z] ≠ (0 : ℝ) → + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ a, b, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ a, d, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∪ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ d, b, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) + ) := by + classical + intro n imageTriple v a d b z u hu hvalue hdet have hgeo := P3523T1TwoTriangleSplit (v a) (v b) (v z) u hu hdet have hleft := imageTriple v a d z have hright := imageTriple v d b z @@ -721,32 +739,55 @@ private theorem splitGeometry : (by classical exact - ∀ (n : Nat), (∀ (v : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + - 3)), ∀ (z : Fin (n + 3)), v '' (({a, b, z} : Finset (Fin (n + 3))) : Set (Fin (n + - 3))) = {v a, v b, v z}) → (∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (a : Fin (n + (3 : - ℕ))), ∀ (d : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (z : Fin (n + (3 : - ℕ))), a ≠ b → a ≠ z → b ≠ z → ∀ (u : ℝ), (0 : ℝ) < u ∧ u < (1 : ℝ) → v d = ((1 : ℝ) - - u) • v a + u • v b → P3381T1TriangleDeterminant ![v a, v b, v z] ≠ (0 : ℝ) → - (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, b, z} : Finset _) : Set (Fin - (n + (3 : - ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : - Set (Fin (n + - (3 : ℕ))))) ∪ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset - _) : Set (Fin - (n + (3 : ℕ))))) ∧ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, d, z} : - Finset _) : Set - (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} - : Finset _) - : Set (Fin (n + (3 : ℕ))))) = segment ℝ (v d) (v z) ∧ ∀ J ⊆ {v a, v b, v z}, ¬(v a ∈ - J ∧ v b ∈ J) → (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset - _) : Set - (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = (convexHull ℝ - : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (J ∩ {v a, v z}) ∧ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ - × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : - Set (ℝ × ℝ) → - Set (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (J ∩ {v b, v z})) ) := by - classical - intro n imageTriple v a d b z hab haz hbz u hu hvalue hdet + ∀ (n : Nat), + (∀ (v : Fin (n + 3) → Real × Real), + ∀ (a : Fin (n + 3)), + ∀ (b : Fin (n + 3)), + ∀ (z : Fin (n + 3)), + v '' (({ a, b, z } : Finset (Fin (n + 3))) : Set (Fin (n + 3))) = + {v a, v b, v z}) → + ∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), + ∀ (a : Fin (n + (3 : ℕ))), + ∀ (d : Fin (n + (3 : ℕ))), + ∀ (b : Fin (n + (3 : ℕ))), + ∀ (z : Fin (n + (3 : ℕ))), + ∀ (u : ℝ), + (0 : ℝ) < u ∧ u < (1 : ℝ) → + v d = ((1 : ℝ) - u) • v a + u • v b → + P3381T1TriangleDeterminant ![v a, v b, v z] ≠ (0 : ℝ) → + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ a, b, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ a, d, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∪ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ d, b, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∧ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ a, d, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ d, b, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) = + segment ℝ (v d) (v z) ∧ + ∀ J ⊆ {v a, v b, v z}, + ¬(v a ∈ J ∧ v b ∈ J) → + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ a, d, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (J ∩ {v a, v z}) ∧ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ d, b, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (J ∩ {v b, v z}) + ) := by + classical + intro n imageTriple v a d b z u hu hvalue hdet have hgeo := P3523T1TwoTriangleSplit (v a) (v b) (v z) u hu hdet have hleft := imageTriple v a d z have hright := imageTriple v d b z @@ -1219,40 +1260,74 @@ private theorem retainedLeft : (by classical exact - ∀ (n : Nat), (∀ (v : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (z : Fin (n + - 3)), v '' (({a, z} : Finset (Fin (n + 3))) : Set (Fin (n + 3))) = {v a, v z}) → (∀ (v - : Fin (n + (3 : ℕ)) → ℝ × ℝ), Function.Injective v → ∀ (a : Fin (n + (3 : ℕ))), ∀ (d - : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (z : Fin (n + (3 : ℕ))), a ≠ b → a - ≠ z → b ≠ z → ∀ (F : Finset (Fin (n + (3 : ℕ)))), ∀ (H : Finset (Fin (n + (3 : ℕ)))), - F = {a, b, z} → insert d (F.erase b) = {a, d, z} → d ∉ H → ¬(a ∈ H ∧ b ∈ H) → - (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑F : Set (Fin (n + (3 : ℕ))))) ∩ - (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = - (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' ((↑F : Set (Fin (n + (3 : ℕ)))) ∩ - (↑H : Set (Fin (n + (3 : ℕ)))))) → ((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' - (↑({a, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → - Set (ℝ × ℝ)) - (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∪ (convexHull ℝ : Set (ℝ × - ℝ) → Set (ℝ - × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∧ (convexHull ℝ : - Set (ℝ × ℝ) → - Set (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull - ℝ : Set (ℝ × - ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = - segment ℝ (v d) (v - z) ∧ ∀ J ⊆ {v a, v b, v z}, ¬(v a ∈ J ∧ v b ∈ J) → (convexHull ℝ : Set (ℝ × ℝ) → Set - (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : - Set (ℝ × ℝ) - → Set (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (J ∩ {v a, v z}) ∧ - (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin - (n + (3 : - ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → - Set (ℝ × ℝ)) (J ∩ {v b, v z})) → (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' - (↑(insert d (F.erase b)) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → - Set (ℝ × ℝ)) (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → - Set (ℝ × ℝ)) (v '' ((↑(insert d (F.erase b)) : Set (Fin (n + (3 : ℕ)))) ∩ (↑H : Set - (Fin (n + (3 : ℕ))))))) ) := by - classical - intro n imagePair v vinj a d b z hab haz hbz F H hF hleftFace hdH hnot hpair hgeo + ∀ (n : Nat), + (∀ (v : Fin (n + 3) → Real × Real), + ∀ (a : Fin (n + 3)), + ∀ (z : Fin (n + 3)), + v '' (({ a, z } : Finset (Fin (n + 3))) : Set (Fin (n + 3))) = + {v a, v z}) → + ∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), + Function.Injective v → + ∀ (a : Fin (n + (3 : ℕ))), + ∀ (d : Fin (n + (3 : ℕ))), + ∀ (b : Fin (n + (3 : ℕ))), + ∀ (z : Fin (n + (3 : ℕ))), + ∀ (F : Finset (Fin (n + (3 : ℕ)))), + ∀ (H : Finset (Fin (n + (3 : ℕ)))), + F = { a, b, z } → + insert d (F.erase b) = { a, d, z } → + d ∉ H → + ¬(a ∈ H ∧ b ∈ H) → + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' (↑F : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + ((↑F : Set (Fin (n + (3 : ℕ)))) ∩ + (↑H : Set (Fin (n + (3 : ℕ)))))) → + ((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ a, b, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ a, d, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∪ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ d, b, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∧ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ a, d, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ d, b, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) = + segment ℝ (v d) (v z) ∧ + ∀ J ⊆ {v a, v b, v z}, + ¬(v a ∈ J ∧ v b ∈ J) → + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ a, d, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (J ∩ {v a, v z}) ∧ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ d, b, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (J ∩ {v b, v z})) → + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑(insert d (F.erase b)) : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + ((↑(insert d (F.erase b)) : Set (Fin (n + (3 : ℕ)))) ∩ + (↑H : Set (Fin (n + (3 : ℕ)))))) + ) := by + classical + intro n imagePair v vinj a d b z F H hF hleftFace hdH hnot hpair hgeo let J := v '' ((F : Set _) ∩ (H : Set _)) have hJsub : J ⊆ {v a, v b, v z} := by intro y hy @@ -1335,40 +1410,74 @@ private theorem retainedRight : (by classical exact - ∀ (n : Nat), (∀ (v : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (z : Fin (n + - 3)), v '' (({a, z} : Finset (Fin (n + 3))) : Set (Fin (n + 3))) = {v a, v z}) → (∀ (v - : Fin (n + (3 : ℕ)) → ℝ × ℝ), Function.Injective v → ∀ (a : Fin (n + (3 : ℕ))), ∀ (d - : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (z : Fin (n + (3 : ℕ))), a ≠ b → a - ≠ z → b ≠ z → ∀ (F : Finset (Fin (n + (3 : ℕ)))), ∀ (H : Finset (Fin (n + (3 : ℕ)))), - F = {a, b, z} → insert d (F.erase a) = {d, b, z} → d ∉ H → ¬(a ∈ H ∧ b ∈ H) → - (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑F : Set (Fin (n + (3 : ℕ))))) ∩ - (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = - (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' ((↑F : Set (Fin (n + (3 : ℕ)))) ∩ - (↑H : Set (Fin (n + (3 : ℕ)))))) → ((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' - (↑({a, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → - Set (ℝ × ℝ)) - (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∪ (convexHull ℝ : Set (ℝ × - ℝ) → Set (ℝ - × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∧ (convexHull ℝ : - Set (ℝ × ℝ) → - Set (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull - ℝ : Set (ℝ × - ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) = - segment ℝ (v d) (v - z) ∧ ∀ J ⊆ {v a, v b, v z}, ¬(v a ∈ J ∧ v b ∈ J) → (convexHull ℝ : Set (ℝ × ℝ) → Set - (ℝ × ℝ)) (v '' (↑({a, d, z} : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : - Set (ℝ × ℝ) - → Set (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (J ∩ {v a, v z}) ∧ - (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑({d, b, z} : Finset _) : Set (Fin - (n + (3 : - ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = (convexHull ℝ : Set (ℝ × ℝ) → - Set (ℝ × ℝ)) (J ∩ {v b, v z})) → (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' - (↑(insert d (F.erase a)) : Set (Fin (n + (3 : ℕ))))) ∩ (convexHull ℝ : Set (ℝ × ℝ) → - Set (ℝ × ℝ)) (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = (convexHull ℝ : Set (ℝ × ℝ) → - Set (ℝ × ℝ)) (v '' ((↑(insert d (F.erase a)) : Set (Fin (n + (3 : ℕ)))) ∩ (↑H : Set - (Fin (n + (3 : ℕ))))))) ) := by - classical - intro n imagePair v vinj a d b z hab haz hbz F H hF hrightFace hdH hnot hpair hgeo + ∀ (n : Nat), + (∀ (v : Fin (n + 3) → Real × Real), + ∀ (a : Fin (n + 3)), + ∀ (z : Fin (n + 3)), + v '' (({ a, z } : Finset (Fin (n + 3))) : Set (Fin (n + 3))) = + {v a, v z}) → + ∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), + Function.Injective v → + ∀ (a : Fin (n + (3 : ℕ))), + ∀ (d : Fin (n + (3 : ℕ))), + ∀ (b : Fin (n + (3 : ℕ))), + ∀ (z : Fin (n + (3 : ℕ))), + ∀ (F : Finset (Fin (n + (3 : ℕ)))), + ∀ (H : Finset (Fin (n + (3 : ℕ)))), + F = { a, b, z } → + insert d (F.erase a) = { d, b, z } → + d ∉ H → + ¬(a ∈ H ∧ b ∈ H) → + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' (↑F : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + ((↑F : Set (Fin (n + (3 : ℕ)))) ∩ + (↑H : Set (Fin (n + (3 : ℕ)))))) → + ((convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ a, b, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ a, d, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∪ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ d, b, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∧ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ a, d, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ d, b, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) = + segment ℝ (v d) (v z) ∧ + ∀ J ⊆ {v a, v b, v z}, + ¬(v a ∈ J ∧ v b ∈ J) → + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ a, d, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (J ∩ {v a, v z}) ∧ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑({ d, b, z } : Finset _) : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) J = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (J ∩ {v b, v z})) → + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + (↑(insert d (F.erase a)) : Set (Fin (n + (3 : ℕ))))) ∩ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' (↑H : Set (Fin (n + (3 : ℕ))))) = + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (v '' + ((↑(insert d (F.erase a)) : Set (Fin (n + (3 : ℕ)))) ∩ + (↑H : Set (Fin (n + (3 : ℕ)))))) + ) := by + classical + intro n imagePair v vinj a d b z F H hF hrightFace hdH hnot hpair hgeo let J := v '' ((F : Set _) ∩ (H : Set _)) have hJsub : J ⊆ {v a, v b, v z} := by intro y hy @@ -2384,7 +2493,10 @@ private theorem pairState : (hhit : e.1 ∈ P ∧ e.2.2 ∈ P) := FacialInsertionGeometry.splitFacts r n q p s X K t hfaceShape existsThird tripleInj tripleRange (FacialInsertionGeometry.splitFinsets n) mapTriple - (FacialInsertionGeometry.splitGeometry n imageTriple) + (by + intro v a d b z hab haz hbz u hu hvalue hdet + exact FacialInsertionGeometry.splitGeometry n imageTriple v a d b z + u hu hvalue hdet) v h hh hinterp hnondeg hab hleFace P hP hhit rcases hbranchF with ⟨haF, hbF, hchildrenF⟩ | ⟨hnotF, hFsame⟩ · have hhitF : e.1 ∈ F₀ ∧ e.2.2 ∈ F₀ := ⟨haF, hbF⟩ @@ -2507,8 +2619,16 @@ theorem P3523T1InsertionGeometry {r n : Nat} have det_range_transport {I : Type} (f g : Fin 3 → I) (hf : Function.Injective f) (hg : Function.Injective g) (hr : Set.range f = Set.range g) (v : I → Real × Real) := - FacialInsertionGeometry.det_range_transport - (FacialInsertionGeometry.triangleMatrix_det) (I := I) f g hf hg hr v + (show + ∀ {I : Type}, ∀ (f : Fin (3 : ℕ) → I), ∀ (g : Fin (3 : ℕ) → I), + Function.Injective f → Function.Injective g → Set.range f = + Set.range g → ∀ (v : I → ℝ × ℝ), P3381T1TriangleDeterminant (v ∘ f) + ≠ (0 : ℝ) ↔ P3381T1TriangleDeterminant (v ∘ g) ≠ (0 : ℝ) + from by + intro I f g hf hg hr v + exact FacialInsertionGeometry.det_range_transport + ((FacialInsertionGeometry.triangleMatrix_det)) f g hf hr v) f g hf hg + hr v have hInc := P3523T1InsertionIncidence q p s X K t have hOrd := P3523T1OrderedInsertion q p s X K t have hHull := P3523T1TargetHull s t @@ -2578,7 +2698,7 @@ theorem P3523T1InsertionGeometry {r n : Nat} (hbz : b ≠ z) (u : Real) (hu : 0 < u ∧ u < 1) (hvalue : v d = (1-u) • v a + u • v b) (hdet : P3381T1TriangleDeterminant ![v a, v b, v z] ≠ 0) := - FacialInsertionGeometry.splitHull n imageTriple v a d b z hab haz hbz u hu hvalue hdet + FacialInsertionGeometry.splitHull n imageTriple v a d b z u hu hvalue hdet have sourceStartImage (k : Fin t.count) := FacialInsertionGeometry.sourceStartImage r n q p s X K t hstartSource k have targetStartImage (k : Fin t.count) := FacialInsertionGeometry.targetStartImage r n q p s X @@ -2618,8 +2738,13 @@ theorem P3523T1InsertionGeometry {r n : Nat} convexHull Real J = convexHull Real (J ∩ {v a, v z}) ∧ convexHull Real (v '' (({d, b, z} : Finset (Fin (n + 3))) : Set _)) ∩ convexHull Real J = convexHull Real (J ∩ {v b, v z}))) := - FacialInsertionGeometry.mixedPair n (FacialInsertionGeometry.retainedLeft n - imagePair) (FacialInsertionGeometry.retainedRight n imagePair) v vinj a d b z + FacialInsertionGeometry.mixedPair n (by + intro v vinj a d b z hab haz hbz F H hF hface hdH hnot hpair hgeo + exact FacialInsertionGeometry.retainedLeft n imagePair v vinj a d b z + F H hF hface hdH hnot hpair hgeo) (by + intro v vinj a d b z hab haz hbz F H hF hface hdH hnot hpair hgeo + exact FacialInsertionGeometry.retainedRight n imagePair v vinj a d b z + F H hF hface hdH hnot hpair hgeo) v vinj a d b z hab haz hbz F H hF hleftFace hrightFace hdH hnot hpair hgeo have pairState (v : Fin (n + 3) → Real × Real) (vinj : Function.Injective v) diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean b/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean index 0890934b01..3432f39cc0 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean @@ -29,16 +29,23 @@ open Fin.NatCast namespace OrderedInsertionGeometry private theorem hsameAt138 : - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary - n), ∀ (s : P3475T1BoundarySubdivision q p), (∀ (j : Fin (n + (3 : ℕ))), ∃ k < n + (3 : - ℕ), s.edge (j + (↑(k + (1 : ℕ)) : Fin (n + (3 : ℕ)))) ≠ s.edge j) → (∀ (i : Fin (r + (3 : - ℕ))), ∀ (ex : ∃ k < n + (3 : ℕ), s.edge (s.start i + (↑(k + (1 : ℕ)) : Fin (n + (3 : - ℕ)))) ≠ s.edge (s.start i)), - let k₀ := Nat.find ex - let m := k₀ + 1 - (k₀ < n + 3) → (∀ (k : Nat), (k < m) → (s.edge (s.start i + (k : Fin (n + 3))) = i))) := by + ∀ (r : Nat), + ∀ (n : Nat), + ∀ (q : P3381T1PolygonBoundary r), + ∀ (p : P3381T1PolygonBoundary n), + ∀ (s : P3475T1BoundarySubdivision q p), + ∀ (i : Fin (r + (3 : ℕ))), + ∀ + (ex : + ∃ k < n + (3 : ℕ), + s.edge (s.start i + (↑(k + (1 : ℕ)) : Fin (n + (3 : ℕ)))) ≠ + s.edge (s.start i)), + let k₀ := Nat.find ex + let m := k₀ + 1 + k₀ < n + 3 → + ∀ (k : Nat), k < m → s.edge (s.start i + (k : Fin (n + 3))) = i := by classical - intro r n q p s hexit i ex k₀ m hk₀ k hk + intro r n q p s i ex k₀ m hk₀ k hk cases k with | zero => simpa using s.edge_start i | succ k => @@ -51,18 +58,26 @@ private theorem hsameAt138 : simpa only [s.edge_start] using heq private theorem hstartAt150 : - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary - n), ∀ (s : P3475T1BoundarySubdivision q p), (∀ (j : Fin (n + (3 : ℕ))), s.parameter j = - (0 : ℝ) → j = s.start (s.edge j)) → ((∀ (j : Fin (n + (3 : ℕ))), ∃ k < n + (3 : ℕ), - s.edge (j + (↑(k + (1 : ℕ)) : Fin (n + (3 : ℕ)))) ≠ s.edge j) → (∀ (i : Fin (r + (3 : - ℕ))), ∀ (ex : ∃ k < n + (3 : ℕ), s.edge (s.start i + (↑(k + (1 : ℕ)) : Fin (n + (3 : - ℕ)))) ≠ s.edge (s.start i)), - let k₀ := Nat.find ex - let m := k₀ + 1 - (s.edge (s.start i + (m : Fin (n + 3))) ≠ i) → ((∀ (k : Nat), (k < m) → (s.edge (s.start i + - (k : Fin (n + 3))) = i)) → (s.start i + (m : Fin (n + 3)) = s.start (i + 1))))) := by + ∀ (r : Nat), + ∀ (n : Nat), + ∀ (q : P3381T1PolygonBoundary r), + ∀ (p : P3381T1PolygonBoundary n), + ∀ (s : P3475T1BoundarySubdivision q p), + (∀ (j : Fin (n + (3 : ℕ))), + s.parameter j = (0 : ℝ) → j = s.start (s.edge j)) → + ∀ (i : Fin (r + (3 : ℕ))), + ∀ + (ex : + ∃ k < n + (3 : ℕ), + s.edge (s.start i + (↑(k + (1 : ℕ)) : Fin (n + (3 : ℕ)))) ≠ + s.edge (s.start i)), + let k₀ := Nat.find ex + let m := k₀ + 1 + s.edge (s.start i + (m : Fin (n + 3))) ≠ i → + (∀ (k : Nat), k < m → s.edge (s.start i + (k : Fin (n + 3))) = i) → + s.start i + (m : Fin (n + 3)) = s.start (i + 1) := by classical - intro r n q p s hzero hexit i ex k₀ m hlast hsame + intro r n q p s hzero i ex k₀ m hlast hsame rcases s.successor (s.start i + (k₀ : Fin (n + 3))) with hs | hs · have heq : s.edge (s.start i + (m : Fin (n + 3))) = i := by simpa [m, Nat.cast_add, add_assoc, hsame k₀ (by dsimp [m]; omega)] @@ -76,18 +91,26 @@ private theorem hstartAt150 : simpa only [heq] using hzero _ hz private theorem hstepAt162 : - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary - n), ∀ (s : P3475T1BoundarySubdivision q p), (∀ (j : Fin (n + (3 : ℕ))), ∃ k < n + (3 : - ℕ), s.edge (j + (↑(k + (1 : ℕ)) : Fin (n + (3 : ℕ)))) ≠ s.edge j) → (∀ (i : Fin (r + (3 : - ℕ))), ∀ (ex : ∃ k < n + (3 : ℕ), s.edge (s.start i + (↑(k + (1 : ℕ)) : Fin (n + (3 : - ℕ)))) ≠ s.edge (s.start i)), - let k₀ := Nat.find ex - let m := k₀ + 1 - (∀ (k : Nat), (k < m) → (s.edge (s.start i + (k : Fin (n + 3))) = i)) → (∀ (k : Nat), (k + 1 - < m) → (s.parameter (s.start i + (k : Fin (n + 3))) < - s.parameter (s.start i + ((k + 1 : Nat) : Fin (n + 3)))))) := by + ∀ (r : Nat), + ∀ (n : Nat), + ∀ (q : P3381T1PolygonBoundary r), + ∀ (p : P3381T1PolygonBoundary n), + ∀ (s : P3475T1BoundarySubdivision q p), + ∀ (i : Fin (r + (3 : ℕ))), + ∀ + (ex : + ∃ k < n + (3 : ℕ), + s.edge (s.start i + (↑(k + (1 : ℕ)) : Fin (n + (3 : ℕ)))) ≠ + s.edge (s.start i)), + let k₀ := Nat.find ex + let m := k₀ + 1 + (∀ (k : Nat), k < m → s.edge (s.start i + (k : Fin (n + 3))) = i) → + ∀ (k : Nat), + k + 1 < m → + s.parameter (s.start i + (k : Fin (n + 3))) < + s.parameter (s.start i + ((k + 1 : Nat) : Fin (n + 3))) := by classical - intro r n q p s hexit i ex k₀ m hsame k hk + intro r n q p s i ex k₀ m hsame k hk rcases s.successor (s.start i + (k : Fin (n + 3))) with hs | hs · simpa [Nat.cast_add, add_assoc] using hs.2 · have heq : i = i + 1 := by @@ -149,14 +172,20 @@ private theorem affine : simp [add_assoc] private theorem filterPrev : - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), (P3475T1BoundarySubdivision q - p) → (∀ (X : Set (Real × Real)), ∀ (K : Set (Real × Real)), (P3475T1TriangleTree q X K) - → ((Fin (n + (3 : ℕ))) → (∀ {α : Type}, ∀ (l : List α), ∀ (p : α → Bool), ∀ (k : Nat), ∀ - (h : Nat), (l.Nodup) → (∀ (hk : k < l.length), (0 < k) → (∀ (hlen : h < (l.filter - p).length), (p (l.get ⟨k - 1, by omega⟩) = true) → (((l.filter p).get ⟨h, hlen⟩ = l.get - ⟨k, hk⟩) → (l.get ⟨k - 1, by omega⟩ ∈ (l.filter p).take h))))))) := by + ∀ {α : Type}, + ∀ (l : List α), + ∀ (p : α → Bool), + ∀ (k : Nat), + ∀ (h : Nat), + l.Nodup → + ∀ (hk : k < l.length), + 0 < k → + ∀ (hlen : h < (l.filter p).length), + p (l.get ⟨k - 1, by omega⟩) = true → + (l.filter p).get ⟨h, hlen⟩ = l.get ⟨k, hk⟩ → + l.get ⟨k - 1, by omega⟩ ∈ (l.filter p).take h := by classical - intro r n q s X K t j α l p k h hn hk hpos hlen hp hcur + intro α l p k h hn hk hpos hlen hp hcur induction l generalizing k h with | nil => simp at hk | cons a l ih => @@ -399,17 +428,25 @@ private theorem pairCasesAt487 : · exact False.elim (hab (had.trans hbd.symm)) private theorem hrawPrevAt546 : - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary - n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real - × Real)), (P3475T1TriangleTree q X K) → ((ℕ) → (∀ [NeZero (n + (3 : ℕ))], - ∀ (j : Fin (n + (3 : ℕ))), ∀ (k : Fin (n + (3 : ℕ))), ((j - 1) + 1 = j) → ( - let raw := List.ofFn (fun k : Fin (n + 3) => s.start 0 + k) - let kp : Fin (n + 3) := ⟨k.val - 1, by omega⟩ - ∀ (hrawLen : raw.length = n + 3), (s.start 0 + kp = j - 1) → (raw.get ⟨k.val - 1, by - rw [hrawLen] - exact lt_of_le_of_lt (Nat.sub_le _ _) k.isLt⟩ = j - 1)))) := by + ∀ (r : Nat), + ∀ (n : Nat), + ∀ (q : P3381T1PolygonBoundary r), + ∀ (p : P3381T1PolygonBoundary n), + ∀ (s : P3475T1BoundarySubdivision q p), + ∀ [NeZero (n + (3 : ℕ))], + ∀ (j : Fin (n + (3 : ℕ))), + ∀ (k : Fin (n + (3 : ℕ))), + let raw := List.ofFn fun k : Fin (n + 3) => s.start 0 + k + let kp : Fin (n + 3) := ⟨k.val - 1, by omega⟩ + ∀ (hrawLen : raw.length = n + 3), + s.start 0 + kp = j - 1 → + raw.get + ⟨k.val - 1, by + rw [hrawLen] + exact lt_of_le_of_lt (Nat.sub_le _ _) k.isLt⟩ = + j - 1 := by classical - intro r n q p s X K t h this j k hp raw kp hrawLen hprevLabel + intro r n q p s this j k raw kp hrawLen hprevLabel have hcast : Fin.cast hrawLen ⟨k.val - 1, by rw [hrawLen] exact lt_of_le_of_lt (Nat.sub_le _ _) k.isLt⟩ = kp := by @@ -441,17 +478,26 @@ private theorem hrawCurAt556 : exact hk private theorem hprefix : - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary - n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real - × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (h : ℕ), ∀ (hh : h < - (P3523T1InsertionConstruction s t).steps.length), ∀ [NeZero (n + (3 : ℕ))], - let c := P3523T1InsertionConstruction s t - let e := c.steps.get ⟨h, hh⟩ - ∀ (j : Fin (n + (3 : ℕ))), ((j - (1 : Fin (n + (3 : ℕ))), j, s.start (s.edge j + (1 : Fin (r - + (3 : ℕ))))) = e) → ((Fin (n + (3 : ℕ))) → ((c.steps.Nodup) → (∀ a ∈ c.steps.take h, - a.2.1 ≠ j))) := by + ∀ (r : Nat), + ∀ (n : Nat), + ∀ (q : P3381T1PolygonBoundary r), + ∀ (p : P3381T1PolygonBoundary n), + ∀ (s : P3475T1BoundarySubdivision q p), + ∀ (X : Set (Real × Real)), + ∀ (K : Set (Real × Real)), + ∀ (t : P3475T1TriangleTree q X K), + ∀ (h : ℕ), + ∀ (hh : h < (P3523T1InsertionConstruction s t).steps.length), + ∀ [NeZero (n + (3 : ℕ))], + let c := P3523T1InsertionConstruction s t; + let e := c.steps.get ⟨h, hh⟩; + ∀ (j : Fin (n + (3 : ℕ))), + (j - (1 : Fin (n + (3 : ℕ))), j, + s.start (s.edge j + (1 : Fin (r + (3 : ℕ))))) = + e → + c.steps.Nodup → ∀ a ∈ c.steps.take h, a.2.1 ≠ j := by classical - intro r n q p s X K t h hh this c e j heq k hstepsNodup a ha haj + intro r n q p s X K t h hh this c e j heq hstepsNodup a ha haj rcases List.mem_take_iff_getElem.mp ha with ⟨i, hi, haeq⟩ have hi' : i < h := by omega have hiSteps : i < c.steps.length := lt_trans hi' hh @@ -476,10 +522,11 @@ private theorem hno : n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), ∀ (h : ℕ), ∀ (hh : h < (P3523T1InsertionConstruction s t).steps.length), ∀ [NeZero (n + (3 : ℕ))], - let c := P3523T1InsertionConstruction s t - let e := c.steps.get ⟨h, hh⟩ + let c := P3523T1InsertionConstruction s t; + let e := c.steps.get ⟨h, hh⟩; ∀ (j : Fin (n + (3 : ℕ))), ((j - (1 : Fin (n + (3 : ℕ))), j, s.start (s.edge j + (1 : Fin (r - + (3 : ℕ))))) = e) → ((Fin (n + (3 : ℕ))) → (((j - 1) + 1 = j) → ((s.edge (j - 1) = + + (3 : ℕ))))) = e) → ( + (((j - 1) + 1 = j) → ((s.edge (j - 1) = s.edge j) → ((j - 1 ≠ s.start (s.edge j + 1)) → ((c.steps.Nodup) → ((∀ {α : Type}, ∀ (l : List α), (l.Nodup) → (∀ (m : Nat), ∀ (hm : m < l.length), l.get ⟨m, hm⟩ ∉ l.take m)) → ((∀ {a : Fin (n + 3)}, ∀ {b : Fin (n + 3)}, ∀ {c : Fin (n + 3)}, ∀ {d : Fin (n + 3)}, (a @@ -488,8 +535,8 @@ private theorem hno : let P : Finset (Fin (n + 3)) := {j - 1, s.start (s.edge j + 1)} ∀ z ∈ c.steps.take h, P ≠ {z.1, z.2.2})))))))) := by classical - intro r n q p s X K t h hh this c e j heq k hp hsame hne hstepsNodup getNotTake pairCases P z - hz hpair + intro r n q p s X K t h hh this c e j heq hp hsame hne hstepsNodup getNotTake pairCases P z hz + hpair have hzsteps : z ∈ c.steps := List.mem_of_mem_take hz rcases List.mem_map.mp hzsteps with ⟨w, hw, hztuple⟩ have hwfilter := List.mem_filter.mp hw @@ -695,13 +742,22 @@ private theorem boundaryEdgeInj : omega private theorem boundaryCardUpdate : - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary - n), (P3475T1BoundarySubdivision q p) → (∀ (B : Finset (Finset (Fin (n + 3)))), ∀ (V : - Finset (Fin (n + 3))), ∀ (a : Fin (n + 3)), ∀ (d : Fin (n + 3)), ∀ (b : Fin (n + 3)), (a - ≠ b) → ((a ∈ V) → ((b ∈ V) → ((d ∉ V) → ((∀ P ∈ B, ∀ x ∈ P, x ∈ V) → (({a, b} ∈ B) → - ((insert {a, d} (insert {d, b} (B.erase {a, b}))).card = B.card + 1))))))) := by + ∀ (n : Nat), + ∀ (B : Finset (Finset (Fin (n + 3)))), + ∀ (V : Finset (Fin (n + 3))), + ∀ (a : Fin (n + 3)), + ∀ (d : Fin (n + 3)), + ∀ (b : Fin (n + 3)), + a ≠ b → + a ∈ V → + b ∈ V → + d ∉ V → + (∀ P ∈ B, ∀ x ∈ P, x ∈ V) → + { a, b } ∈ B → + (insert { a, d } (insert { d, b } (B.erase { a, b }))).card = + B.card + 1 := by classical - intro r n q p s B V a d b hab ha hb hd hend herase + intro n B V a d b hab ha hb hd hend herase have had : a ≠ d := by intro h exact hd (h ▸ ha) @@ -840,16 +896,16 @@ private theorem hstate : · rw [hupdateCard, hupdateVertices, hprev.2] private theorem targetPairInj : - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : P3381T1PolygonBoundary - n), (P3475T1BoundarySubdivision q p) → (∀ (X : Set (Real × Real)), ∀ (K : Set (Real × - Real)), (P3475T1TriangleTree q X K) → ((∀ {a : Fin (n + 3)}, ∀ {b : Fin (n + 3)}, ∀ + ∀ (n : Nat), + ( + ((∀ {a : Fin (n + 3)}, ∀ {b : Fin (n + 3)}, ∀ {c : Fin (n + 3)}, ∀ {d : Fin (n + 3)}, (a ≠ b) → ((({a, b} : Finset (Fin (n + 3))) = {c, d}) → ((a = c ∧ b = d) ∨ (a = d ∧ b = c)))) → ((∀ (i : Fin (n + 3)), i ≠ i + 1) → (Function.Injective (fun i : Fin (n + 3) => ({i, i + 1} : Finset (Fin (n + 3)))))))) := by classical - intro r n q p s X K t pairCases targetAdjNe i j hij + intro n pairCases targetAdjNe i j hij have hcases := pairCases (targetAdjNe i) hij rcases hcases with ⟨hij, _⟩ | ⟨hij, hji⟩ · exact hij @@ -1394,7 +1450,7 @@ private theorem hboundary : (hend : ∀ P ∈ B, ∀ x ∈ P, x ∈ V) (herase : {a, b} ∈ B) : (insert {a, d} (insert {d, b} (B.erase {a, b}))).card = B.card + 1 := - OrderedInsertionGeometry.boundaryCardUpdate r n q p s B V a d b hab ha hb hd hend + OrderedInsertionGeometry.boundaryCardUpdate n B V a d b hab ha hb hd hend herase have hstate : ∀ h : Nat, h ≤ c.steps.length → (∀ P ∈ c.boundary h, ∀ x ∈ P, x ∈ c.vertices h) ∧ @@ -1412,7 +1468,7 @@ private theorem hboundary : norm_num at hv have targetPairInj : Function.Injective (fun i : Fin (n + 3) => ({i, i + 1} : Finset (Fin (n + 3)))) := - OrderedInsertionGeometry.targetPairInj r n q p s X K t pairCases targetAdjNe + OrderedInsertionGeometry.targetPairInj n pairCases targetAdjNe have htargetCard : targetBoundary.card = n + 3 := by dsimp [targetBoundary] rw [Finset.card_image_of_injective _ targetPairInj] @@ -1498,9 +1554,9 @@ theorem P3523T1OrderedInsertion {r n : Nat} have hlast : s.edge (s.start i + (m : Fin (n + 3))) ≠ i := by simpa only [m, k₀, s.edge_start] using (Nat.find_spec ex).2 have hsame (k : Nat) (hk : k < m) := OrderedInsertionGeometry.hsameAt138 r n q p - s hexit i ex hk₀ k hk - have hstart := OrderedInsertionGeometry.hstartAt150 r n q p s hzero hexit i ex hlast hsame - have hstep (k : Nat) (hk : k + 1 < m) := OrderedInsertionGeometry.hstepAt162 r n q p s hexit + s i ex hk₀ k hk + have hstart := OrderedInsertionGeometry.hstartAt150 r n q p s hzero i ex hlast hsame + have hstep (k : Nat) (hk : k + 1 < m) := OrderedInsertionGeometry.hstepAt162 r n q p s i ex hsame k hk exact ⟨m, by dsimp [m]; omega, hm, hstart, hsame, fun k l hkl hl => OrderedInsertionGeometry.hstrict r n q p s i ex hstep l hl k hkl⟩ @@ -1562,8 +1618,7 @@ theorem P3523T1OrderedInsertion {r n : Nat} (hlen : h < (l.filter p).length) (hp : p (l.get ⟨k - 1, by omega⟩) = true) (hcur : (l.filter p).get ⟨h, hlen⟩ = l.get ⟨k, hk⟩) := - OrderedInsertionGeometry.filterPrev r - n q s X K t j (α := α) l p k h hn hk hpos hlen hp hcur + OrderedInsertionGeometry.filterPrev (α := α) l p k h hn hk hpos hlen hp hcur have getNotTake {α : Type} (l : List α) (hn : l.Nodup) (m : Nat) (hm : m < l.length) := ListEndpointFacts.getNotTake l hn m hm have fold_not_mem (l : List (Fin (n + 3) × Fin (n + 3) × Fin (n + 3))) @@ -1612,7 +1667,7 @@ theorem P3523T1OrderedInsertion {r n : Nat} have hkpos := OrderedInsertionDetails.hkpos r n q p s j k hk hparam have hkprev := OrderedInsertionDetails.hkprev n k hkpos have hprevLabel := OrderedInsertionDetails.hprevLabel (s.start 0) kp k j hkprev hk - have hrawPrev := OrderedInsertionGeometry.hrawPrevAt546 r n q p s X K t h j k hp + have hrawPrev := OrderedInsertionGeometry.hrawPrevAt546 r n q p s j k hrawLen hprevLabel have hrawCur := OrderedInsertionGeometry.hrawCurAt556 r n q p s j k hk hrawLen have hfilterLen : h < (List.filter pred raw).length := by @@ -1641,7 +1696,7 @@ theorem P3523T1OrderedInsertion {r n : Nat} · have hxinit := OrderedInsertionDetails.hxinit r n q p s j hparam have hprefix := OrderedInsertionGeometry.hprefix r n q - p s X K t h hh j heq k hstepsNodup + p s X K t h hh j heq hstepsNodup change e.2.1 ∉ (c.steps.take h).foldl (fun vs e => insert e.2.1 vs) (Finset.univ.image s.start) rw [← heq] @@ -1652,7 +1707,7 @@ theorem P3523T1OrderedInsertion {r n : Nat} rw [← heq] let P : Finset (Fin (n + 3)) := {j - 1, s.start (s.edge j + 1)} have hno := OrderedInsertionGeometry.hno r n q p - s X K t h hh j heq k hp hsame hne hstepsNodup getNotTake pairCases + s X K t h hh j heq hp hsame hne hstepsNodup getNotTake pairCases have hseed := OrderedInsertionGeometry.hseed r n q p s X K t hzero h j hsame prevTupleMem have hmem := keepBoundary (c.steps.take h) diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean index 43fe19e498..6356957b79 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean @@ -211,10 +211,12 @@ private theorem hRval : simp only [Fin.val_cast, hrootlen] private theorem hrankDiff : - ∀ (n : Nat), (List (Fin (n + 3))) → (∀ (m : Nat), ∀ (k : Nat), ∀ (p : Nat), ∀ (s : Nat), (0 < - m) → ((p < m) → ((s < m) → ((p ≤ s) → ((((s+k)%m+m-((p+k)%m))%m) = s-p))))) := by + ∀ (m : Nat), + ∀ (k : Nat), + ∀ (p : Nat), + ∀ (s : Nat), 0 < m → s < m → p ≤ s → ((s + k) % m + m - (p + k) % m) % m = s - p := by classical - intro n v m k p s hm hp hs hps + intro m k p s hm hs hps let x := (p + k) % m let d := s-p have hx : x < m := Nat.mod_lt _ hm @@ -557,26 +559,45 @@ private theorem hrankB' : simpa [rank] using hrankB private theorem hrankAt : - ∀ (n : Nat), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ (u : List (Fin (n + 3))), ∀ (v : - List (Fin (n + 3))), - let L := a :: (u ++ b :: v) - ∀ (k : ℕ), - let root := List.ofFn (fun i : Fin (n + 3) => i) - let R := root.rotate k - ∀ (emb : Fin (a :: (u ++ b :: v)).length ↪o Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => - i).rotate k).length), (∀ (ix : Fin (a :: (u ++ b :: v)).length), (a :: (u ++ b :: v)).get - ix = ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k).get ((emb : Fin (a :: (u ++ - b :: v)).length → Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k).length) - ix)) → ((∀ (j : Fin R.length), (R.get j).val = (j.val + k) % (n + 3)) → ((∀ (m : Nat), ∀ - (k : Nat), ∀ (p : Nat), ∀ (s : Nat), (0 < m) → ((p < m) → ((s < m) → ((p ≤ s) → - ((((s+k)%m+m-((p+k)%m))%m) = s-p))))) → ((u.length+1 < L.length) → ( - let ia : Fin L.length := ⟨0, by simp [L]⟩ - (a.val = ((emb ia).val + k) % (n + 3)) → ( - let rank := fun i : Fin (n+3) => (i.val + (n+3) - a.val) % (n+3) - ∀ (p : Fin L.length), (ia ≤ p) → (∀ (i : Fin (n+3)), (L.get p = i) → (rank i = (emb p).val - - (emb ia).val))))))) := by - classical - intro n a b u v L k root R emb hemb hRval hrankDiff hsourceB ia hvalA rank p hp i hpi + ∀ (n : Nat), + ∀ (a : Fin (n + 3)), + ∀ (b : Fin (n + 3)), + ∀ (u : List (Fin (n + 3))), + ∀ (v : List (Fin (n + 3))), + let L := a :: (u ++ b :: v); + ∀ (k : ℕ), + let root := List.ofFn fun i : Fin (n + 3) => i; + let R := root.rotate k; + ∀ + (emb : + Fin (a :: (u ++ b :: v)).length ↪o + Fin ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k).length), + (∀ (ix : Fin (a :: (u ++ b :: v)).length), + (a :: (u ++ b :: v)).get ix = + ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k).get + ((emb : + Fin (a :: (u ++ b :: v)).length → + Fin + ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k).length) + ix)) → + (∀ (j : Fin R.length), (R.get j).val = (j.val + k) % (n + 3)) → + (∀ (m : Nat), + ∀ (k : Nat), + ∀ (p : Nat), + ∀ (s : Nat), + 0 < m → + p < m → + s < m → p ≤ s → ((s + k) % m + m - (p + k) % m) % m = s - p) → + let ia : Fin L.length := ⟨0, by simp [L]⟩ + a.val = ((emb ia).val + k) % (n + 3) → + let rank := fun i : Fin (n + 3) => + (i.val + (n + 3) - a.val) % (n + 3) + ∀ (p : Fin L.length), + ia ≤ p → + ∀ (i : Fin (n + 3)), + L.get p = i → rank i = (emb p).val - (emb ia).val := by + classical + intro n a b u v L k root R emb hemb hRval hrankDiff ia hvalA rank p hp i hpi have hvalI : i.val = ((emb p).val + k) % (n+3) := by calc i.val = (R.get (emb p)).val := (congrArg Fin.val ((hemb p).symm.trans hpi)).symm @@ -1098,17 +1119,24 @@ private theorem hDgeConv : (mul_nonneg (div_nonneg hs hrs.le) hy) private theorem hUneg : - ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + 3)), ∀ - (u : List (Fin (n + 3))), (List (Fin (n + 3))) → ((a ≠ b) → ( - let rank := fun i : Fin (n+3) => (i.val + (n+3) - a.val) % (n+3) - (∀ (i : Fin (n+3)), (i ∈ u) → (0 < rank i ∧ rank i < rank b)) → ((∀ (i : Fin (n+3)), (a.val ≤ - i.val) → (rank i = i.val-a.val)) → ((∀ (i : Fin (n+3)), (¬ a.val ≤ i.val) → (rank i = - n+3-a.val+i.val)) → ( - let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] - (∀ (c : Fin (n + 3)), D (q c) = ((b.val : Real) - a.val) * ((c.val : Real) - a.val) * ((c.val - : Real) - b.val)) → (∀ i ∈ u, D (q i) < 0)))))) := by - classical - intro n q a b u v hne rank hrankU hrankHi hrankLo D hdet i hi + ∀ (n : Nat), + ∀ (q : Fin (n + 3) → Real × Real), + ∀ (a : Fin (n + 3)), + ∀ (b : Fin (n + 3)), + ∀ (u : List (Fin (n + 3))), + a ≠ b → + let rank := fun i : Fin (n + 3) => (i.val + (n + 3) - a.val) % (n + 3) + (∀ (i : Fin (n + 3)), i ∈ u → 0 < rank i ∧ rank i < rank b) → + (∀ (i : Fin (n + 3)), a.val ≤ i.val → rank i = i.val - a.val) → + (∀ (i : Fin (n + 3)), ¬a.val ≤ i.val → rank i = n + 3 - a.val + i.val) → + let D := fun z => P3381T1TriangleDeterminant ![q a, q b, z] + (∀ (c : Fin (n + 3)), + D (q c) = + ((b.val : Real) - a.val) * ((c.val : Real) - a.val) * + ((c.val : Real) - b.val)) → + ∀ i ∈ u, D (q i) < 0 := by + classical + intro n q a b u hne rank hrankU hrankHi hrankLo D hdet i hi have hru := hrankU i hi by_cases hab : a.val < b.val · have hrb := hrankHi b hab.le @@ -1737,8 +1765,8 @@ theorem P3555T2ParabolaChordCuts {n : Nat} have hRval (j : Fin R.length) : (R.get j).val = (j.val + k) % (n + 3) := ParabolaChordLemmas.hRval n k hrootlen j have hrankDiff (m k p s : Nat) (hm : 0 < m) (hp : p < m) (hs : s < m) - (hps : p ≤ s) : (((s+k)%m+m-((p+k)%m))%m) = s-p := ParabolaChordLemmas.hrankDiff n v m k p - s hm hp hs hps + (hps : p ≤ s) : (((s+k)%m+m-((p+k)%m))%m) = s-p := ParabolaChordLemmas.hrankDiff m k p + s hm hs hps have hsourceA : (⟨0, by simp [L]⟩ : Fin L.length).val < (⟨u.length+1, by simp [L]⟩ : Fin L.length).val := ParabolaChordLemmas.hsourceA n a b u v have hsourceB : u.length+1 < L.length := ParabolaChordLemmas.hsourceB n a b u v hv @@ -1772,7 +1800,7 @@ theorem P3555T2ParabolaChordCuts {n : Nat} emb hsourceB hrankB have hrankAt (p : Fin L.length) (hp : ia ≤ p) (i : Fin (n+3)) (hpi : L.get p = i) : rank i = (emb p).val - (emb ia).val := ParabolaChordLemmas.hrankAt n - a b u v k emb hemb hRval hrankDiff hsourceB hvalA p hp i hpi + a b u v k emb hemb hRval hrankDiff hvalA p hp i hpi have hrankU (i : Fin (n+3)) (hi : i ∈ u) : 0 < rank i ∧ rank i < rank b := ParabolaChordLemmas.hrankU n a b u v hv k emb hsourceB hrootOrder hrankB' hrankAt i hi have hrankV (i : Fin (n+3)) (hi : i ∈ v) : rank b < rank i := ParabolaChordLemmas.hrankV n a b @@ -1848,7 +1876,7 @@ theorem P3555T2ParabolaChordCuts {n : Nat} clear hrankB' clear hBsubRoot k hLrot root R hrootlen emb hemb hRval hrankDiff hsourceA hsourceB ia ib haAtRoot hbAtRoot hvalA hvalB hrankB hrankAt - have hUneg : ∀ i ∈ u, D (q i) < 0 := ParabolaChordLemmas.hUneg n q a b u v hne hrankU hrankHi + have hUneg : ∀ i ∈ u, D (q i) < 0 := ParabolaChordLemmas.hUneg n q a b u hne hrankU hrankHi hrankLo hdet have hVpos : ∀ i ∈ v, 0 < D (q i) := ParabolaChordLemmas.hVpos n q a b v hne hrankV hrankHi hrankLo hdet diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean index 42a3782821..b51fee2052 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean @@ -563,13 +563,19 @@ private theorem hBget : simpa [jB] using hresult private theorem hNoAEndpoints : - ∀ (n : Nat), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), ∀ (u : List (Fin (n + (3 : - ℕ)))), (List (Fin (n + (3 : ℕ)))) → (((0 : ℕ) < u.length) → (((a :: (u ++ [b])).Nodup) → - (∀ (i : Fin (a :: (u ++ [b])).length), ∀ (j : Fin (a :: (u ++ [b])).length), (i.val + 1 = - j.val) → (((a :: (u ++ [b])).get i ∈ ({a, b} : Set (Fin (n + 3)))) → (((a :: (u ++ - [b])).get j ∈ ({a, b} : Set (Fin (n + 3)))) → (False)))))) := by + ∀ (n : Nat), + ∀ (a : Fin (n + (3 : ℕ))), + ∀ (b : Fin (n + (3 : ℕ))), + ∀ (u : List (Fin (n + (3 : ℕ)))), + (0 : ℕ) < u.length → + (a :: (u ++ [b])).Nodup → + ∀ (i : Fin (a :: (u ++ [b])).length), + ∀ (j : Fin (a :: (u ++ [b])).length), + i.val + 1 = j.val → + (a :: (u ++ [b])).get i ∈ ({ a, b } : Set (Fin (n + 3))) → + (a :: (u ++ [b])).get j ∈ ({ a, b } : Set (Fin (n + 3))) → False := by classical - intro n a b u v hu hndA i j hij hia hja + intro n a b u hu hndA i j hij hia hja have hzero : (a :: (u ++ [b])).get ⟨0, by simp⟩ = a := by simp have hend : (a :: (u ++ [b])).get ⟨u.length + 1, by simp⟩ = b := by simp [List.get_eq_getElem] @@ -605,13 +611,19 @@ private theorem hNoAEndpoints : exact hne (by rw [hiend, hjend]) private theorem hNoBEndpoints : - ∀ (n : Nat), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 : ℕ))), (List (Fin (n + (3 : ℕ)))) - → (∀ (v : List (Fin (n + (3 : ℕ)))), ((0 : ℕ) < v.length) → (((b :: (v ++ [a])).Nodup) → - (∀ (i : Fin (b :: (v ++ [a])).length), ∀ (j : Fin (b :: (v ++ [a])).length), (i.val + 1 = - j.val) → (((b :: (v ++ [a])).get i ∈ ({a, b} : Set (Fin (n + 3)))) → (((b :: (v ++ - [a])).get j ∈ ({a, b} : Set (Fin (n + 3)))) → (False)))))) := by + ∀ (n : Nat), + ∀ (a : Fin (n + (3 : ℕ))), + ∀ (b : Fin (n + (3 : ℕ))), + ∀ (v : List (Fin (n + (3 : ℕ)))), + (0 : ℕ) < v.length → + (b :: (v ++ [a])).Nodup → + ∀ (i : Fin (b :: (v ++ [a])).length), + ∀ (j : Fin (b :: (v ++ [a])).length), + i.val + 1 = j.val → + (b :: (v ++ [a])).get i ∈ ({ a, b } : Set (Fin (n + 3))) → + (b :: (v ++ [a])).get j ∈ ({ a, b } : Set (Fin (n + 3))) → False := by classical - intro n a b u v hv hndB i j hij hia hja + intro n a b v hv hndB i j hij hia hja have hzero : (b :: (v ++ [a])).get ⟨0, by simp⟩ = b := by simp have hend : (b :: (v ++ [a])).get ⟨v.length + 1, by simp⟩ = a := by simp [List.get_eq_getElem] @@ -1195,33 +1207,42 @@ private theorem rightBoundaryCase : exact hgSecond private theorem rotationCase : - ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), - let Good : List (Fin (n + 3)) → List (Fin 3 → Fin (n + 3)) → Prop := fun L F => - L.Nodup → - (∃ k : Nat, L.Sublist - ((List.ofFn (fun i : Fin (n + 3) => i)).rotate k)) → - (∀ f ∈ F, Function.Injective f ∧ - Set.range f ⊆ {i | i ∈ L} ∧ - P3381T1TriangleDeterminant (q ∘ f) ≠ 0) ∧ - F.Pairwise (fun f g => Set.range f ≠ Set.range g) ∧ - convexHull Real (q '' {i | i ∈ L}) = - ⋃ (f : Fin 3 → Fin (n + 3)) (_ : f ∈ F), - convexHull Real (Set.range (q ∘ f)) ∧ - (∀ f ∈ F, ∀ g ∈ F, - convexHull Real (Set.range (q ∘ f)) ∩ - convexHull Real (Set.range (q ∘ g)) = - convexHull Real (q '' (Set.range f ∩ Set.range g))) ∧ - (∀ k : Fin L.length, - ∃! f : Fin 3 → Fin (n + 3), f ∈ F ∧ - L.get k ∈ Set.range f ∧ - L.get ⟨(k.val + 1) % L.length, - Nat.mod_lt _ (Nat.zero_lt_of_lt k.isLt)⟩ ∈ Set.range f) - ∀ (L : List (Fin (n + (3 : ℕ)))), ∀ (F : List (Fin (3 : ℕ) → Fin (n + (3 : ℕ)))), ∀ (k : ℕ), - (P3511T1CyclicDissection (Fin (n + (3 : ℕ))) (L.rotate k) F) → (((L.rotate k).Nodup → - (∃ (k_1 : ℕ), (L.rotate k).Sublist ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate - k_1)) → Good (L.rotate k) F) → (Good L F)) := by + ∀ (n : Nat), + ∀ (q : Fin (n + 3) → Real × Real), + let Good : List (Fin (n + 3)) → List (Fin 3 → Fin (n + 3)) → Prop := fun L F => + L.Nodup → + (∃ k : Nat, L.Sublist ((List.ofFn fun i : Fin (n + 3) => i).rotate k)) → + (∀ f ∈ F, + Function.Injective f ∧ + Set.range f ⊆ {i | i ∈ L} ∧ P3381T1TriangleDeterminant (q ∘ f) ≠ 0) ∧ + (F.Pairwise fun f g => Set.range f ≠ Set.range g) ∧ + convexHull Real (q '' {i | i ∈ L}) = + ⋃ (f : Fin 3 → Fin (n + 3)) (_ : f ∈ F), + convexHull Real (Set.range (q ∘ f)) ∧ + (∀ f ∈ F, + ∀ g ∈ F, + convexHull Real (Set.range (q ∘ f)) ∩ + convexHull Real (Set.range (q ∘ g)) = + convexHull Real (q '' (Set.range f ∩ Set.range g))) ∧ + ∀ k : Fin L.length, + ∃! f : Fin 3 → Fin (n + 3), + f ∈ F ∧ + L.get k ∈ Set.range f ∧ + L.get + ⟨(k.val + 1) % L.length, + Nat.mod_lt _ (Nat.zero_lt_of_lt k.isLt)⟩ ∈ + Set.range f; + ∀ (L : List (Fin (n + (3 : ℕ)))), + ∀ (F : List (Fin (3 : ℕ) → Fin (n + (3 : ℕ)))), + ∀ (k : ℕ), + ((L.rotate k).Nodup → + (∃ (k_1 : ℕ), + (L.rotate k).Sublist + ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k_1)) → + Good (L.rotate k) F) → + Good L F := by classical - intro n q Good L F k d ih hnd hcyc + intro n q Good L F k ih hnd hcyc have hndR : (L.rotate k).Nodup := by simpa using hnd have hcycR := SavedDissectionProof.hcycR n L k hcyc have hR : Good (L.rotate k) F := ih hndR hcycR @@ -1429,12 +1450,12 @@ theorem P3555T2SavedDissectionGeometry {n : Nat} (hij : i.val + 1 = j.val) (hia : (a :: (u ++ [b])).get i ∈ ({a, b} : Set (Fin (n + 3)))) (hja : (a :: (u ++ [b])).get j ∈ ({a, b} : Set (Fin (n + 3)))) : False := - SavedDissectionProof.hNoAEndpoints n a b u v hu hndA i j hij hia hja + SavedDissectionProof.hNoAEndpoints n a b u hu hndA i j hij hia hja have hNoBEndpoints (i j : Fin (b :: (v ++ [a])).length) (hij : i.val + 1 = j.val) (hia : (b :: (v ++ [a])).get i ∈ ({a, b} : Set (Fin (n + 3)))) (hja : (b :: (v ++ [a])).get j ∈ ({a, b} : Set (Fin (n + 3)))) : False := - SavedDissectionProof.hNoBEndpoints n a b u v hv hndB i j hij hia hja + SavedDissectionProof.hNoBEndpoints n a b v hv hndB i j hij hia hja refine ⟨?_, ?_, ?_, ?_, ?_⟩ · intro f hf rcases List.mem_append.mp hf with hf | hf @@ -1498,7 +1519,7 @@ theorem P3555T2SavedDissectionGeometry {n : Nat} hgoodB hfaceA hlenL hBget hNoBEndpoints k hABpoint hkA exact rightBoundaryCase | rotate L F k d ih => - have rotationCase : Good L F := SavedDissectionCases.rotationCase n q L F k d ih + have rotationCase : Good L F := SavedDissectionCases.rotationCase n q L F k ih exact rotationCase exact hgood hboundary hcyclic diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean b/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean index 7f5a6aead1..df0970acdf 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean @@ -109,12 +109,11 @@ private theorem coordA_scale : private theorem coordB_scale : - let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 - let coordB (d e : Real × Real) (v : Real × Real) : Real := det2 d v / det2 d e - ∀ (d : Real × Real), ∀ (e : Real × Real), (det2 d e ≠ 0) → (∀ (t : Real), coordB d e (t • d) - = 0) := by + let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1; + let coordB (d e : Real × Real) (v : Real × Real) : Real := det2 d v / det2 d e; + ∀ (d : Real × Real), ∀ (e : Real × Real), ∀ (t : Real), coordB d e (t • d) = 0 := by classical - intro det2 coordB d e hD t + intro det2 coordB d e t dsimp [coordB, det2, smul_eq_mul] rw [show d.1 * (t * d.2) - d.2 * (t * d.1) = 0 by ring] simp @@ -1242,7 +1241,7 @@ theorem P3597T1DirectionParity {n : Nat} (p : P3381T1PolygonBoundary n) let coordA_scale (d e : Real × Real) (hD : det2 d e ≠ 0) (t : Real) : coordA d e (t • d) = t := DirectionParityLemmas.coordA_scale d e hD t let coordB_scale (d e : Real × Real) (hD : det2 d e ≠ 0) (t : Real) : - coordB d e (t • d) = 0 := DirectionParityLemmas.coordB_scale d e hD t + coordB d e (t • d) = 0 := DirectionParityLemmas.coordB_scale d e t let ray_segment_axes (x d e v w : Real × Real) (hD : det2 d e ≠ 0) : (∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real v w) ↔ (∃ u : Real, 0 ≤ u ∧ u ≤ 1 ∧ diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean b/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean index 6386776b5c..4529bdd3d8 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean @@ -131,9 +131,10 @@ private theorem haddne : (by classical exact - ∀ (n : Nat), (Fin (n + 3)) → (∀ j : Fin (n + 3), j + 1 ≠ j) ) := by + ∀ (n : Nat), ∀ j : Fin (n + 3), j + 1 ≠ j + ) := by classical - intro n i j hj + intro n j hj have hv' := congrArg Fin.val hj simp only [Fin.val_add] at hv' have hv'' : (j.val + 1) % (n + 3) = j.val := by simpa using hv' @@ -148,9 +149,10 @@ private theorem haddinj : (by classical exact - ∀ (n : Nat), (Fin (n + 3)) → (∀ x y : Fin (n + 3), x + 1 = y + 1 → x = y) ) := by + ∀ (n : Nat), ∀ x y : Fin (n + 3), x + 1 = y + 1 → x = y + ) := by classical - intro n i x y hxy + intro n x y hxy apply Fin.ext have hv := congrArg Fin.val hxy simp only [Fin.val_add] at hv @@ -3158,7 +3160,7 @@ theorem P3597T1VertexSectors {n : Nat} (p : P3381T1PolygonBoundary n) let prev : Fin (n + 3) := if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ have hprev := VertexSectorDetails.hprev n i - have haddne : ∀ j : Fin (n + 3), j + 1 ≠ j := VertexSectorProof.haddne n i + have haddne : ∀ j : Fin (n + 3), j + 1 ≠ j := VertexSectorProof.haddne n have hprevne := VertexSectorDetails.hprevne n i hprev haddne have hnextne : i + 1 ≠ i := haddne i have hnextVertex := VertexSectorDetails.hnextVertex n p i hnextne @@ -3194,7 +3196,7 @@ theorem P3597T1VertexSectors {n : Nat} (p : P3381T1PolygonBoundary n) have hdetuw := VertexSectorProof.hdetuw n p i have hcarrierUW := VertexSectorProof.hcarrierUW n p i rK (VertexSectorProof.hcarrierRays n p i rK (VertexSectorProof.hcarrierLocal n p i rK - hballK hprev (VertexSectorProof.haddinj n i) hrKle) hsegA (VertexSectorProof.hsegB n + hballK hprev (VertexSectorProof.haddinj n) hrKle) hsegA (VertexSectorProof.hsegB n p i hlineMap) (VertexSectorProof.hRayA n p i rK hdistA hrAle hlineMap hdistRadial) (VertexSectorProof.hRayB n p i rK hdistB hrBle hlineMap hdistRadial)) have hconstOn := VertexSectorProof.hconstOn n p diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean b/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean index dc867ab9a4..445db11234 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean @@ -320,16 +320,24 @@ private theorem hqleft : (by classical exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : - Fin (n + (3 : ℕ))), ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (A 0 = p.vertex (E.b - - 1)) → ((0 < A.coord 2 (p.vertex d)) → ( - let B := p.vertex E.b - let P := p.vertex d - let q : Real → Real × Real := AffineMap.lineMap B P - (A.coord 2 B = 0) → ((∀ t, ∀ i, A.coord i (q t) = (1 - t) * A.coord i B + t * A.coord i - P) → (∀ t, 0 < t → t < 1 → q t ∉ segment Real (p.vertex (E.b - 1)) B)))) ) := by + ∀ (n : Nat), + ∀ (p : P3381T1PolygonBoundary n), + ∀ (E : P3650T1ExposedCorner p), + ∀ (d : Fin (n + (3 : ℕ))), + ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), + A 0 = p.vertex (E.b - 1) → + 0 < A.coord 2 (p.vertex d) → + let B := p.vertex E.b; + let P := p.vertex d; + let q : Real → Real × Real := AffineMap.lineMap B P; + A.coord 2 B = 0 → + (∀ t, + ∀ i, + A.coord i (q t) = (1 - t) * A.coord i B + t * A.coord i P) → + ∀ t, 0 < t → q t ∉ segment Real (p.vertex (E.b - 1)) B + ) := by classical - intro n p E d A hA0 hcoord2 B P q hcoordB2 hqcoord t ht0 ht1 hs + intro n p E d A hA0 hcoord2 B P q hcoordB2 hqcoord t ht0 hs have hcoordprev : A.coord 2 (p.vertex (E.b - 1)) = 0 := by rw [← hA0] simp [] @@ -348,16 +356,24 @@ private theorem hqright : (by classical exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : - Fin (n + (3 : ℕ))), ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (A 2 = p.vertex (E.b - + 1)) → ((0 < A.coord 0 (p.vertex d)) → ( - let B := p.vertex E.b - let P := p.vertex d - let q : Real → Real × Real := AffineMap.lineMap B P - (A.coord 0 B = 0) → ((∀ t, ∀ i, A.coord i (q t) = (1 - t) * A.coord i B + t * A.coord i - P) → (∀ t, 0 < t → t < 1 → q t ∉ segment Real B (p.vertex (E.b + 1)))))) ) := by + ∀ (n : Nat), + ∀ (p : P3381T1PolygonBoundary n), + ∀ (E : P3650T1ExposedCorner p), + ∀ (d : Fin (n + (3 : ℕ))), + ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), + A 2 = p.vertex (E.b + 1) → + 0 < A.coord 0 (p.vertex d) → + let B := p.vertex E.b; + let P := p.vertex d; + let q : Real → Real × Real := AffineMap.lineMap B P; + A.coord 0 B = 0 → + (∀ t, + ∀ i, + A.coord i (q t) = (1 - t) * A.coord i B + t * A.coord i P) → + ∀ t, 0 < t → q t ∉ segment Real B (p.vertex (E.b + 1)) + ) := by classical - intro n p E d A hA2 hcoord0 B P q hcoordB0 hqcoord t ht0 ht1 hs + intro n p E d A hA2 hcoord0 B P q hcoordB0 hqcoord t ht0 hs have hcoordnext : A.coord 0 (p.vertex (E.b + 1)) = 0 := by rw [← hA2] simp [] @@ -451,16 +467,22 @@ private theorem hPdecomp : (by classical exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (d : - Fin (n + (3 : ℕ))), ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), (A 0 = p.vertex (E.b - - 1)) → ((A 1 = p.vertex E.b) → ((A 2 = p.vertex (E.b + 1)) → ((A.coord 0 (p.vertex - d) + A.coord 1 (p.vertex d) + A.coord 2 (p.vertex d) = 1) → ( - let B := p.vertex E.b - let P := p.vertex d - P = B + A.coord 0 P • (p.vertex (E.b - 1) - B) + A.coord 2 P • (p.vertex (E.b + 1) - - B))))) ) := by + ∀ (n : Nat), + ∀ (p : P3381T1PolygonBoundary n), + ∀ (E : P3650T1ExposedCorner p), + ∀ (d : Fin (n + (3 : ℕ))), + ∀ (A : AffineBasis (Fin (3 : ℕ)) ℝ (ℝ × ℝ)), + A 0 = p.vertex (E.b - 1) → + A 1 = p.vertex E.b → + A 2 = p.vertex (E.b + 1) → + let B := p.vertex E.b + let P := p.vertex d + P = + B + A.coord 0 P • (p.vertex (E.b - 1) - B) + + A.coord 2 P • (p.vertex (E.b + 1) - B) + ) := by classical - intro n p E d A hA0 hA1 hA2 hsum B P + intro n p E d A hA0 hA1 hA2 B P have hcomb := A.linear_combination_coord_eq_self P rw [Fin.sum_univ_three, hA0, hA1, hA2] at hcomb have hsumP : A.coord 0 P + A.coord 1 P + A.coord 2 P = 1 := by @@ -802,11 +824,19 @@ theorem P3650T1MaximalHeightDiagonal {n : Nat} (p : P3381T1PolygonBoundary n) have hprod : 0 < (1 - t) * (1 - E.height P) := mul_pos (by linarith) (by linarith [hheightlt]) nlinarith) - have hqleft := MaximalHeightGeometry.hqleft n p E d A hA0 hcoord2 hcoordB2 hqcoord - have hqright := MaximalHeightGeometry.hqright n p E d A hA2 hcoord0 hcoordB0 hqcoord + have hqleft := (show + ∀ t, 0 < t → t < 1 → q t ∉ segment Real (p.vertex (E.b - 1)) B + from by + intro t ht0 ht1 hs + exact MaximalHeightGeometry.hqleft n p E d A hA0 hcoord2 hcoordB2 hqcoord t ht0 hs) + have hqright := (show + ∀ t, 0 < t → t < 1 → q t ∉ segment Real B (p.vertex (E.b + 1)) + from by + intro t ht0 ht1 hs + exact MaximalHeightGeometry.hqright n p E d A hA2 hcoord0 hcoordB0 hqcoord t ht0 hs) have hqclear := MaximalHeightGeometry.hqclear n p E hentry d hdmax A hcoord_nonneg hheightd hqinterior hqmargin hqleft hqright - have hPdecomp := MaximalHeightGeometry.hPdecomp n p E d A hA0 hA1 hA2 hsum + have hPdecomp := MaximalHeightGeometry.hPdecomp n p E d A hA0 hA1 hA2 obtain ⟨r, hr, hcone⟩ := E.cone_odd have hqcont : Continuous q := (AffineMap.lineMap (k := Real) B P).continuous_of_finiteDimensional diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean index 3be5a43287..4b6c092e9c 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean @@ -280,11 +280,10 @@ private theorem cyclicStep : (by classical exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : - P3650T1VisibleDiagonal p E), (P3650T1CyclicChildren p D.a D.b) → (∀ {m : Nat}, ∀ - (i : Fin (m + 3)), (i - 1) + 2 = i + 1) ) := by + ∀ {m : Nat}, ∀ (i : Fin (m + 3)), i - 1 + 2 = i + 1 + ) := by classical - intro n p E D C m i + intro m i have hsub : (i - 1).val = if i.val = 0 then m + 2 else i.val - 1 := by by_cases hz : i.val = 0 · have hi : i = 0 := Fin.ext hz @@ -451,11 +450,10 @@ private theorem prevIndexNe : (by classical exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : - P3650T1VisibleDiagonal p E), (P3650T1CyclicChildren p D.a D.b) → (∀ {m : Nat}, ∀ - (i : Fin (m + 3)), i - 1 ≠ i) ) := by + ∀ {m : Nat}, ∀ (i : Fin (m + 3)), i - 1 ≠ i + ) := by classical - intro n p E D C m i h + intro m i h have hv := congrArg Fin.val h by_cases hi : i = 0 · subst i @@ -472,11 +470,10 @@ private theorem nextIndexNe : (by classical exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : - P3650T1VisibleDiagonal p E), (P3650T1CyclicChildren p D.a D.b) → (∀ {m : Nat}, ∀ - (i : Fin (m + 3)), i + 1 ≠ i) ) := by + ∀ {m : Nat}, ∀ (i : Fin (m + 3)), i + 1 ≠ i + ) := by classical - intro n p E D C m i h + intro m i h have hv := congrArg Fin.val h have hval : (i + 1).val = if i = Fin.last (m + 2) then 0 else i.val + 1 := Fin.val_add_one i @@ -540,13 +537,17 @@ private theorem rightPreviousParent : (by classical exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : - P3650T1VisibleDiagonal p E), (P3650T1CyclicChildren p D.a D.b) → (∀ {m : Nat}, ∀ - (q : P3381T1PolygonBoundary m), ∀ (a : Fin (m + 3)), ∀ (b : Fin (m + - 3)), ∀ (K : P3650T1CyclicChildren q a b), (K.rotation % (m + 3) = a.val) → (K.ir - ⟨K.rightParameter + 1, by omega⟩ = a - 1))) := by + Nat → + ∀ {m : Nat}, + ∀ (q : P3381T1PolygonBoundary m), + ∀ (a : Fin (m + 3)), + ∀ (b : Fin (m + 3)), + ∀ (K : P3650T1CyclicChildren q a b), + K.rotation % (m + 3) = a.val → + K.ir ⟨K.rightParameter + 1, by omega⟩ = a - 1 + ) := by classical - intro n p E D C m q a b K hrot + intro n m q a b K hrot have hidx : (m + 2 + K.rotation) % (m + 3) = (a - 1).val := by by_cases ha0 : a.val = 0 · have ha : a = 0 := Fin.ext ha0 @@ -2305,33 +2306,6 @@ private theorem hX2At1391 : rw [hcoordLine 2 vb va δ, hcoordB2, hcoordA2] ring -private theorem hleftCenter : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : - P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), (D.a = E.b) - → ( - let vb := p.vertex E.b - (C.il 0 = D.a) → (C.left.vertex 0 = vb)) ) := by - classical - intro n p E D C ha vb hleftFirst - rw [C.left_vertex] - simp [hleftFirst, ha, vb] - -private theorem hleftOne : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : - P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), - let vc := p.vertex (E.b + 1) - (C.il 1 = E.b + 1) → (C.left.vertex 1 = vc) ) := by - classical - intro n p E D C vc hleftNext - rw [C.left_vertex] - simp [hleftNext, vc] - private theorem hleftWrap : (by classical @@ -2860,8 +2834,8 @@ private theorem hseedLAt3101 : classical rw [hcoordLine 2 U X t, hU2, hX2] ring) - have hleftCenter := OldArcParityProof.hleftCenter n p E D C ha hleftFirst - have hleftOne := OldArcParityProof.hleftOne n p E D C hleftNext + have hleftCenter := OldArcParityProof.hleftStart n p E D C ha hleftFirst + have hleftOne := OldArcParityProof.hleftStartNext n p E D C hleftNext have hleftWrap := OldArcParityProof.hleftWrap n p E D C have hleftEnd := OldArcParityProof.hleftEnd n p E D C hleftLast have hballPath (t : Real) (ht : t ∈ Set.Icc (0 : Real) 1) := @@ -2928,7 +2902,7 @@ theorem P3650T1OldArcEven {n : Nat} (p : P3381T1PolygonBoundary n) oldArcEvenOnPreconnected leftArcPreconnected hRopen hRclosure have propagateLeft := OldArcParityProof.propagateLeft n p E D C hRoff oldArcEvenOnPreconnected rightArcPreconnected hLopen hLclosure - have cyclicStep {m : Nat} (i : Fin (m + 3)) := OldArcParityProof.cyclicStep n p E D C (m := m) i + have cyclicStep {m : Nat} (i : Fin (m + 3)) := OldArcParityProof.cyclicStep (m := m) i have parityEvenAlongPath {m : Nat} (q : P3381T1PolygonBoundary m) (γ : Real → Real × Real) (hcont : ContinuousOn γ (Set.Icc (0 : Real) 1)) (havoid : ∀ t ∈ Set.Icc (0 : Real) 1, @@ -2945,8 +2919,8 @@ theorem P3650T1OldArcEven {n : Nat} (p : P3381T1PolygonBoundary n) have middleNotSegment {a b c : Real × Real} (hdet : P3381T1TriangleDeterminant ![a, b, c] ≠ 0) := OldArcParityProof.middleNotSegment (a := a) (b := b) (c := c) hdet - have prevIndexNe {m : Nat} (i : Fin (m + 3)) := OldArcParityProof.prevIndexNe n p E D C (m := m) i - have nextIndexNe {m : Nat} (i : Fin (m + 3)) := OldArcParityProof.nextIndexNe n p E D C (m := m) i + have prevIndexNe {m : Nat} (i : Fin (m + 3)) := OldArcParityProof.prevIndexNe (m := m) i + have nextIndexNe {m : Nat} (i : Fin (m + 3)) := OldArcParityProof.nextIndexNe (m := m) i have strictUpperHalfplaneEven {m : Nat} (q : P3381T1PolygonBoundary m) (ell : (Real × Real) →ₗ[Real] Real) (H : Real) (hbound : ∀ i, ell (q.vertex i) < H) @@ -2957,8 +2931,7 @@ theorem P3650T1OldArcEven {n : Nat} (p : P3381T1PolygonBoundary n) have rightPreviousParent {m : Nat} (q : P3381T1PolygonBoundary m) (a b : Fin (m + 3)) (K : P3650T1CyclicChildren q a b) (hrot : K.rotation % (m + 3) = a.val) : - K.ir ⟨K.rightParameter + 1, by omega⟩ = a - 1 := OldArcParityProof.rightPreviousParent n p E D - C (m + K.ir ⟨K.rightParameter + 1, by omega⟩ = a - 1 := OldArcParityProof.rightPreviousParent n (m := m) q a b K hrot rcases D.route with hbase | htop · rcases hbase with ⟨ha, hb, hempty⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean index 90912bba05..5dcbfc6add 100644 --- a/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean @@ -439,11 +439,13 @@ private theorem hmodShift : (by classical exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), (P3544T1DiagonalSplit p) → (∀ {m : ℕ}, - ∀ {r : ℕ}, ∀ {x : ℕ}, ∀ {y : ℕ}, (0 : ℕ) < m → x < m → y < m → (r + x) % m = (r + y) - % m → x = y) ) := by + ∀ {m : ℕ}, + ∀ {r : ℕ}, + ∀ {x : ℕ}, + ∀ {y : ℕ}, (0 : ℕ) < m → x < m → y < m → (r + x) % m = (r + y) % m → x = y + ) := by classical - intro n p S m r x y hm hx hy he + intro m r x y hm hx hy he have hrx : (r + x) % m = (r % m + x) % m := by rw [Nat.add_mod, Nat.mod_eq_of_lt hx] have hry : (r + y) % m = (r % m + y) % m := by @@ -488,13 +490,17 @@ private theorem hfinAdj : (by classical exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), (P3544T1DiagonalSplit p) → (∀ {m : ℕ}, - ∀ (x : Fin (m + (3 : ℕ))), ∀ (y : Fin (m + (3 : ℕ))), y = x + (1 : Fin (m + (3 : ℕ))) - ∨ x = y + (1 : Fin (m + (3 : ℕ))) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ) ∨ (↑x : ℕ) = (↑y : - ℕ) + (1 : ℕ) ∨ (↑x : ℕ) + (1 : ℕ) = m + (3 : ℕ) ∧ (↑y : ℕ) = (0 : ℕ) ∨ (↑y : ℕ) + (1 - : ℕ) = m + (3 : ℕ) ∧ (↑x : ℕ) = (0 : ℕ)) ) := by + ∀ {m : ℕ}, + ∀ (x : Fin (m + (3 : ℕ))), + ∀ (y : Fin (m + (3 : ℕ))), + y = x + (1 : Fin (m + (3 : ℕ))) ∨ x = y + (1 : Fin (m + (3 : ℕ))) ↔ + (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ) ∨ + (↑x : ℕ) = (↑y : ℕ) + (1 : ℕ) ∨ + (↑x : ℕ) + (1 : ℕ) = m + (3 : ℕ) ∧ (↑y : ℕ) = (0 : ℕ) ∨ + (↑y : ℕ) + (1 : ℕ) = m + (3 : ℕ) ∧ (↑x : ℕ) = (0 : ℕ) + ) := by classical - intro n p S m x y + intro m x y have hv (z : Fin (m + 3)) : (z + 1).val = (z.val + 1) % (m + 3) := by rw [Fin.val_add, Fin.val_one] constructor @@ -2272,11 +2278,11 @@ theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} hlenP hlenL hlenR haCoord y have hmodShift {m r x y : Nat} (hm : 0 < m) (hx : x < m) (hy : y < m) - (he : (r + x) % m = (r + y) % m) := IndexedFaceLedgerProof.hmodShift n p S (m := m) (r := + (he : (r + x) % m = (r + y) % m) := IndexedFaceLedgerProof.hmodShift (m := m) (r := r) (x := x) (y := y) hm hx hy he have hmodSucc {m r x : Nat} (hm : 1 < m) := IndexedFaceLedgerProof.hmodSucc (m := m) (r := r) (x := x) hm - have hfinAdj {m : Nat} (x y : Fin (m + 3)) := IndexedFaceLedgerProof.hfinAdj n p S (m := m) x y + have hfinAdj {m : Nat} (x y : Fin (m + 3)) := IndexedFaceLedgerProof.hfinAdj (m := m) x y have hleftA := IndexedFaceLedgerProof.hleftA n p S hleftcoord haCoord have hleftB := IndexedFaceLedgerProof.hleftB n p S have hrightB := IndexedFaceLedgerProof.hrightB n p S diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean index 3eb8547750..4cdfe8ce2c 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean @@ -432,34 +432,53 @@ private theorem hmeet : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (hg1ab : D.port a b = some (g a b ⟨(1 : ℝ), by norm_num⟩)), ∀ (hg1ba : D.port b a = - some (g b a - ⟨(1 : ℝ), by norm_num⟩)), - let clip (x : Real) : Icc (0 : Real) 1 := - ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ - let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) - let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) - let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} - ∀ (s : Icc (0 : Real) 1), (s ∈ (Set.univ : Set (Icc (0 : Real) 1)) ∩ frontier A) → (left - s = right s) ) := by + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + P3723T1EdgeContact P a b → + P3723T1EdgeContact P (rep a) (P.shift (-period a) b)), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (hg1ab : D.port a b = some (g a b ⟨(1 : ℝ), by norm_num⟩)), + ∀ (hg1ba : D.port b a = some (g b a ⟨(1 : ℝ), by norm_num⟩)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, + max_le (by norm_num) (min_le_left _ _)⟩ + let left : Icc (0 : Real) 1 → Real × Real := fun s => + g a b (clip (2 * s)) + let right : Icc (0 : Real) 1 → Real × Real := fun s => + g b a (clip (2 - 2 * s)) + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + ∀ (s : Icc (0 : Real) 1), + s ∈ (Set.univ : Set (Icc (0 : Real) 1)) ∩ frontier A → + left s = right s + ) := by classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g hg1ab hg1ba clip left right - A s hs + intro ι P D a b localStar rep rep_spec period pulled_contact g hg1ab hg1ba clip left right A s + hs have hend : g a b ⟨1, by norm_num⟩ = g b a ⟨1, by norm_num⟩ := by apply Option.some.inj calc @@ -569,32 +588,52 @@ private theorem hf1 : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (hba : P3723T1EdgeContact P b a), ∀ (hg0ba : g b a ⟨(0 : ℝ), by norm_num⟩ = - D.position b), - let clip (x : Real) : Icc (0 : Real) 1 := - ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ - let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) - let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) - let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} - let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right - f ⟨1, by norm_num⟩ = D.position b ) := by + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + P3723T1EdgeContact P a b → + P3723T1EdgeContact P (rep a) (P.shift (-period a) b)), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (hba : P3723T1EdgeContact P b a), + ∀ (hg0ba : g b a ⟨(0 : ℝ), by norm_num⟩ = D.position b), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, + max_le (by norm_num) (min_le_left _ _)⟩ + let left : Icc (0 : Real) 1 → Real × Real := fun s => + g a b (clip (2 * s)) + let right : Icc (0 : Real) 1 → Real × Real := fun s => + g b a (clip (2 - 2 * s)) + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let f : Icc (0 : Real) 1 → Real × Real := + A.piecewise left right + f ⟨1, by norm_num⟩ = D.position b + ) := by classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g hba hg0ba clip left right A f + intro ι P D a b localStar rep rep_spec period pulled_contact g hba hg0ba clip left right A f have hz : (⟨1, by norm_num⟩ : Icc (0 : Real) 1) ∉ A := by norm_num [A] have hc : clip (0 : Real) = ⟨0, by norm_num⟩ := by apply Subtype.ext @@ -724,36 +763,61 @@ private theorem hfinj : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (higab : Function.Injective (g a b)), ∀ (higba : Function.Injective (g b a)), - let clip (x : Real) : Icc (0 : Real) 1 := - ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ - let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) - let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) - let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} - let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right - (∀ (s : Icc (0 : Real) 1), (s ∈ A) → ((clip (2 * s) : Real) = 2 * s)) → ((∀ (s : Icc (0 : - Real) 1), (s ∉ A) → ((clip (2 - 2 * s) : Real) = 2 - - 2 * s)) → (∀ (p : ℝ × ℝ), (g a b ⟨1, by norm_num⟩ = p) → ((g b a ⟨1, - by norm_num⟩ = p) → ((Set.range (g a b) ∩ Set.range (g b a) = {p}) → - (Function.Injective f)))))) := by + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + P3723T1EdgeContact P a b → + P3723T1EdgeContact P (rep a) (P.shift (-period a) b)), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (higab : Function.Injective (g a b)), + ∀ (higba : Function.Injective (g b a)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, + max_le (by norm_num) (min_le_left _ _)⟩ + let left : Icc (0 : Real) 1 → Real × Real := fun s => + g a b (clip (2 * s)) + let right : Icc (0 : Real) 1 → Real × Real := fun s => + g b a (clip (2 - 2 * s)) + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let f : Icc (0 : Real) 1 → Real × Real := + A.piecewise left right + (∀ (s : Icc (0 : Real) 1), + s ∈ A → (clip (2 * s) : Real) = 2 * s) → + (∀ (s : Icc (0 : Real) 1), + s ∉ A → (clip (2 - 2 * s) : Real) = 2 - 2 * s) → + ∀ (p : ℝ × ℝ), + g a b ⟨1, by norm_num⟩ = p → + g b a ⟨1, by norm_num⟩ = p → + Set.range (g a b) ∩ Set.range (g b a) = { p } → + Function.Injective f + ) := by classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g higab higba clip left right - A f hscale_left hscale_right p hendab hendba hcross s t hst + intro ι P D a b localStar rep rep_spec period pulled_contact g higab higba clip left right A f + hscale_left hscale_right p hendab hendba hcross s t hst by_cases hs : s ∈ A · by_cases ht : t ∈ A · have hval : g a b (clip (2 * s)) = g a b (clip (2 * t)) := by @@ -958,36 +1022,53 @@ private theorem htm_strict : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (hnpos : 0 < n), - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - (∀ (j : Fin (m + 1)), tm ⟨j.val, by omega⟩ = polyab.time j / 2) → ((∀ (j : Fin n), tm ⟨m - + 1 + j.val, by omega⟩ = - 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2) → (StrictMono tm)))) := by + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + P3723T1EdgeContact P a b → + P3723T1EdgeContact P (rep a) (P.shift (-period a) b)), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + (∀ (j : Fin (m + 1)), + tm ⟨j.val, by omega⟩ = polyab.time j / 2) → + (∀ (j : Fin n), + tm ⟨m + 1 + j.val, by omega⟩ = + 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2) → + StrictMono tm + ) := by classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n hnpos tm left_eval right_eval apply Fin.strictMono_iff_lt_succ.mpr intro i @@ -1072,35 +1153,51 @@ private theorem htm_finish : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (hnpos : 0 < n), - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - (∀ (j : Fin n), tm ⟨m + 1 + j.val, by omega⟩ = - 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2) → (tm (Fin.last (m + n)) = 1) ) := by + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + P3723T1EdgeContact P a b → + P3723T1EdgeContact P (rep a) (P.shift (-period a) b)), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + (∀ (j : Fin n), + tm ⟨m + 1 + j.val, by omega⟩ = + 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2) → + tm (Fin.last (m + n)) = 1 + ) := by classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n hnpos tm right_eval have hnlast : n - 1 < n := by omega have hindex : (Fin.last (m + n) : Fin (m + n + 1)) = @@ -1121,41 +1218,59 @@ private theorem hstartAt848 : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let m := polyab.count - let n := polyba.count - ∀ (hnpos : 0 < n), - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - ∀ (right_eval : ∀ (j : Fin n), tm ⟨m + 1 + j.val, by omega⟩ = - 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2), ∀ (htm_mid : tm ⟨m, by omega⟩ = 1 / - 2), ∀ (i : Fin (m + n)), ∀ (hleftidx : ¬(↑i : ℕ) < m), - let r : Nat := i.val - m - ∀ (hr : r < n), - let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ - tm ⟨i.val, by omega⟩ = - 1 - polyba.time k.succ / 2 ) := by + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + P3723T1EdgeContact P a b → + P3723T1EdgeContact P (rep a) (P.shift (-period a) b)), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let m := polyab.count + let n := polyba.count + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 + ∀ + (right_eval : + ∀ (j : Fin n), + tm ⟨m + 1 + j.val, by omega⟩ = + 1 - polyba.time ⟨n - 1 - j.val, by omega⟩ / 2), + ∀ (htm_mid : tm ⟨m, by omega⟩ = 1 / 2), + ∀ (i : Fin (m + n)), + ∀ (hleftidx : ¬(↑i : ℕ) < m), + let r : Nat := i.val - m + ∀ (hr : r < n), + let k : Fin n := ⟨n - r - 1, by dsimp [r]; omega⟩ + tm ⟨i.val, by omega⟩ = 1 - polyba.time k.succ / 2 + ) := by classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba m n hnpos tm + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba m n hnpos tm right_eval htm_mid i hleftidx r hr k by_cases hrzero : r = 0 · have hiv : i.val = m := by dsimp [r] at hrzero ⊢; omega @@ -1263,40 +1378,56 @@ private theorem hA_imp_mid : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} - let m := polyab.count - let n := polyba.count - ∀ (hnpos : 0 < n), - let tm : Fin (m + n + 1) → Real := fun i => - if hi : i.val ≤ m then - polyab.time ⟨i.val, by omega⟩ / 2 - else - 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2 - (StrictMono tm) → ((tm ⟨m, by omega⟩ = 1 / 2) → (∀ (i : Fin (m + - n)), (¬(↑i : ℕ) < m) → ( - let r : Nat := i.val - m - (r < n) → (∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), (tm ⟨i.val, by omega⟩ ≤ (s : - Real)) → (s ∈ A → i.val = m ∧ (s : Real) = 1 / 2))))))) := by + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + P3723T1EdgeContact P a b → + P3723T1EdgeContact P (rep a) (P.shift (-period a) b)), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a; + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2}; + let m := polyab.count; + let n := polyba.count; + ∀ (hnpos : 0 < n), + let tm : Fin (m + n + 1) → Real := fun i => + if hi : i.val ≤ m then polyab.time ⟨i.val, by omega⟩ / 2 + else 1 - polyba.time ⟨n + m - i.val, by omega⟩ / 2; + StrictMono tm → + tm ⟨m, by omega⟩ = 1 / 2 → + ∀ (i : Fin (m + n)), + ¬(↑i : ℕ) < m → + ∀ (s : (↑(Icc (0 : ℝ) (1 : ℝ)) : Type)), + tm ⟨i.val, by omega⟩ ≤ (s : Real) → + s ∈ A → i.val = m ∧ (s : Real) = 1 / 2 + ) := by classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba A m n hnpos tm - htm_strict htm_mid i hleftidx r hr s hlo' hsA + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba A m n hnpos tm + htm_strict htm_mid i hleftidx s hlo' hsA by_cases heq : i.val = m · have hi : (⟨i.val, by omega⟩ : Fin (m + n + 1)) = ⟨m, by omega⟩ := by apply Fin.ext @@ -1678,31 +1809,62 @@ private theorem half_subset : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), (P3723T1EdgeContact P a - b) → ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - (∀ a, ∀ b, ∀ c, P3723T1EdgeContact P a b → P3723T1EdgeContact P a c → b ≠ c → - Set.range (g a b) ∩ Set.range (g a c) = {D.position a}) → ((∀ (x : ι), ∀ (y : ι), ∀ - (u : ι), ∀ (v : ι), (P3723T1EdgeContact P x y) → ((P3723T1EdgeContact P u v) → - ((({x, y} : Set ι) ≠ {u, v}) → ((x ≠ u) → (Disjoint (Set.range (g x y)) (Set.range (g - u v))))))) → (∀ (x : ι), ∀ (y : ι), ∀ (u : ι), ∀ (v : ι), (P3723T1EdgeContact P x - y) → ((P3723T1EdgeContact P u v) → ((({x, y} : Set ι) ≠ {u, v}) → (Set.range (g x - y) ∩ Set.range (g u v) ⊆ D.position '' (({x, y} : Set ι) ∩ {u, v})))))))) := by + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + P3723T1EdgeContact P a b → + P3723T1EdgeContact P (rep a) (P.shift (-period a) b)), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ + s + + GaussianRealPoint (period a) + else D.position a + (∀ a, + ∀ b, + ∀ c, + P3723T1EdgeContact P a b → + P3723T1EdgeContact P a c → + b ≠ c → + Set.range (g a b) ∩ Set.range (g a c) = {D.position a}) → + (∀ (x : ι), + ∀ (y : ι), + ∀ (u : ι), + ∀ (v : ι), + P3723T1EdgeContact P x y → + P3723T1EdgeContact P u v → + ({ x, y } : Set ι) ≠ { u, v } → + x ≠ u → + Disjoint (Set.range (g x y)) (Set.range (g u v))) → + ∀ (x : ι), + ∀ (y : ι), + ∀ (u : ι), + ∀ (v : ι), + P3723T1EdgeContact P x y → + P3723T1EdgeContact P u v → + ({ x, y } : Set ι) ≠ { u, v } → + Set.range (g x y) ∩ Set.range (g u v) ⊆ + D.position '' (({ x, y } : Set ι) ∩ { u, v }) + ) := by classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g gintersections half_disjoint - x y u v hxy huv hxyuv z hz + intro ι P D localStar rep rep_spec period pulled_contact g gintersections half_disjoint x y u + v hxy huv hxyuv z hz by_cases hxu : x = u · subst u have hyv : y ≠ v := by @@ -2187,7 +2349,7 @@ private theorem hpoly : have right_eval (j : Fin n) := ContactDrawingGeometry.right_eval ι P D a b localStar rep_spec pulled_contact polyab polyba j have htm_strict := ContactDrawingGeometry.htm_strict ι P D a b localStar rep_spec - pulled_contact hab polyab polyba hnpos left_eval right_eval + pulled_contact polyab polyba hnpos left_eval right_eval have htm_start : tm 0 = 0 := by change tm ⟨0, by omega⟩ = 0 rw [left_eval ⟨0, by omega⟩] @@ -2198,7 +2360,7 @@ private theorem hpoly : have hjlast : jm = Fin.last m := by apply Fin.ext; rfl rw [hjlast, polyab.finish] have htm_finish := ContactDrawingGeometry.htm_finish ι P D a b localStar rep_spec - pulled_contact hab polyab polyba hnpos right_eval + pulled_contact polyab polyba hnpos right_eval refine ⟨{ count := m + n positive := by omega @@ -2299,12 +2461,12 @@ private theorem hpoly : omega) have hstart : tm ⟨i.val, by omega⟩ = 1 - polyba.time k.succ / 2 := ContactDrawingGeometry.hstartAt848 ι P D a b localStar - rep_spec pulled_contact hab polyab polyba hnpos right_eval htm_mid i hleftidx hr + rep_spec pulled_contact polyab polyba hnpos right_eval htm_mid i hleftidx hr have hend : tm ⟨i.val + 1, by omega⟩ = 1 - polyba.time k.castSucc / 2 := ContactDrawingGeometry.hendAt880 ι P D a b localStar rep_spec pulled_contact polyab polyba right_eval i hr hendIndex have hA_imp_mid := ContactDrawingGeometry.hA_imp_mid ι P D a b localStar rep_spec - pulled_contact hab polyab polyba hnpos htm_strict htm_mid i hleftidx hr s hlo' + pulled_contact polyab polyba hnpos htm_strict htm_mid i hleftidx s hlo' have hsRight := ContactDrawingGeometry.hsRight ι P D a b localStar rep_spec pulled_contact polyab polyba p hendab hendba i s hA_imp_mid have hkbound : polyba.time k.succ ≤ 1 := by @@ -2410,7 +2572,7 @@ private theorem full_parameters : have hrightc : Continuous right := hgba.comp (hclip_cont.comp (continuous_const.sub (continuous_const.mul continuous_subtype_val))) have hmeet (s : Icc (0 : Real) 1) (hs : s ∈ (Set.univ : Set (Icc (0 : Real) 1)) ∩ frontier A) - := ContactDrawingGeometry.hmeet ι P D a b localStar rep_spec pulled_contact hab hg1ab + := ContactDrawingGeometry.hmeet ι P D a b localStar rep_spec pulled_contact hg1ab hg1ba s hs have hfcont := (show Continuous f @@ -2426,7 +2588,7 @@ private theorem full_parameters : have hscale_right (s : Icc (0 : Real) 1) (hs : s ∉ A) := ContactDrawingGeometry.hscale_right s hs have hf0 := ContactDrawingGeometry.hf0 ι P D a b localStar rep_spec pulled_contact hab hg0ab - have hf1 := ContactDrawingGeometry.hf1 ι P D a b localStar rep_spec pulled_contact hab hba hg0ba + have hf1 := ContactDrawingGeometry.hf1 ι P D a b localStar rep_spec pulled_contact hba hg0ba obtain ⟨p, hp⟩ := port_exists a b hab have hpba : D.port b a = some p := by rw [D.port_symmetric, hp] have hendab := ContactDrawingGeometry.hendab ι P D a b localStar rep_spec pulled_contact hab @@ -2435,7 +2597,7 @@ private theorem full_parameters : gproperties hba p hpba have hcross := ContactDrawingGeometry.hcross ι P D a b localStar rep_spec pulled_contact hab hsab hsba p hendab hendba - have hfinj := ContactDrawingGeometry.hfinj ι P D a b localStar rep_spec pulled_contact hab + have hfinj := ContactDrawingGeometry.hfinj ι P D a b localStar rep_spec pulled_contact higab higba hscale_left hscale_right p hendab hendba hcross have hrange := ContactDrawingGeometry.hrange ι P D a b localStar rep_spec pulled_contact hab hba p hendab hendba @@ -2555,8 +2717,8 @@ private theorem drawingCertificate : (huv : P3723T1EdgeContact P u v) (hxyuv : ({x, y} : Set ι) ≠ {u, v}) : Set.range (g x y) ∩ Set.range (g u v) ⊆ - D.position '' (({x, y} : Set ι) ∩ {u, v}) := ContactDrawingGeometry.half_subset ι P D a - b localStar rep_spec pulled_contact hab gintersections half_disjoint x y u v hxy + D.position '' (({x, y} : Set ι) ∩ {u, v}) := ContactDrawingGeometry.half_subset ι P D + localStar rep_spec pulled_contact gintersections half_disjoint x y u v hxy huv hxyuv have hstart (x y : ι) (hxy : P3723T1EdgeContact P x y) : D.position x ∈ edgeArc x y := ContactDrawingGeometry.hstartAt1216 ι P D symmetric diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean b/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean index df23c4ab6a..4564caa861 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean @@ -60,22 +60,23 @@ private theorem hRadialImage : private theorem boundedComponent : ∀ (e : C(Circle, Real × Real)), - let h₀ : ℂ ≃ₜ (Real × Real) := - Complex.equivRealProd.toHomeomorphOfIsInducing - Complex.isUniformEmbedding_equivRealProd.isInducing - let h : (Real × Real) ≃ₜ ℂ := h₀.symm - let ec : C(Circle, ℂ) := ⟨fun t => h (e t), h.continuous.comp e.continuous⟩ - let K : Set ℂ := Set.range ec - let T : Set ℂ := Kᶜ - ∀ (r : ℝ), - let R : ℝ := max r 0 + 1 - let U : Set ℂ := {w | R < ‖w‖} - let aInf : ℂ := (R + 1 : ℝ) - let CInf : Set ℂ := connectedComponentIn T aInf - (U ⊆ CInf) → (∀ w ∈ T, connectedComponentIn T w ≠ CInf → Bornology.IsBounded - (connectedComponentIn T w)) := by + let h₀ : ℂ ≃ₜ Real × Real := + Complex.equivRealProd.toHomeomorphOfIsInducing + Complex.isUniformEmbedding_equivRealProd.isInducing + let h : Real × Real ≃ₜ ℂ := h₀.symm + let ec : C(Circle, ℂ) := ⟨fun t => h (e t), h.continuous.comp e.continuous⟩ + let K : Set ℂ := Set.range ec + let T : Set ℂ := Kᶜ + ∀ (r : ℝ), + let R : ℝ := max r 0 + 1 + let U : Set ℂ := {w | R < ‖w‖} + let aInf : ℂ := (R + 1 : ℝ) + let CInf : Set ℂ := connectedComponentIn T aInf + U ⊆ CInf → + ∀ w, + connectedComponentIn T w ≠ CInf → Bornology.IsBounded (connectedComponentIn T w) := by classical - intro e h₀ h ec K T r R U aInf CInf hUcomponent w hw hneq + intro e h₀ h ec K T r R U aInf CInf hUcomponent w hneq rw [Metric.isBounded_iff_subset_closedBall (0 : ℂ)] refine ⟨R, ?_⟩ intro v hv @@ -398,7 +399,7 @@ theorem P3821T1CircleComponentBound (e : C(Circle, Real × Real)) have boundedComponent (w : ℂ) (hw : w ∈ T) (hneq : connectedComponentIn T w ≠ CInf) : Bornology.IsBounded (connectedComponentIn T w) := CircleComponentProof.boundedComponent e r - hUcomponent w hw hneq + hUcomponent w hneq have hKimage : K = h '' Set.range e := by ext w constructor diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean index 6e0c103fe1..14805d8f51 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean @@ -233,10 +233,6 @@ private theorem hψclose (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : have hle : r ≤ η / 8 := by dsimp [r]; exact min_le_left _ _ linarith -private theorem hKcompact' (e : C(Circle, ℂ)) : IsCompact (Set.range e) := by - classical - exact isCompact_range e.continuous - private noncomputable abbrev F (e : C(Circle, ℂ)) (S : Set ↑(Set.range ⇑e)) (hSf : S.Finite) : Finset (Set.range e) := by classical @@ -1146,7 +1142,7 @@ theorem P3821T1ControlledNeighborhood (e : C(Circle, ℂ)) have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := ControlledNeighborhoodConstruction.hψclose e he eps heps δ₀ η hη hηψ - have hKcompact' : IsCompact (Set.range e) := ControlledNeighborhoodConstruction.hKcompact' e + have hKcompact' : IsCompact (Set.range e) := ControlledNeighborhoodConstruction.hKcompact e let : CompactSpace (Set.range e) := isCompact_iff_compactSpace.mp hKcompact' obtain ⟨S, hSsub, hSf, hcover⟩ := (isCompact_univ : IsCompact (Set.univ : Set (Set.range e))).finite_cover_balls diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean b/LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean index 7276a1a2a2..2bf05ef1a2 100644 --- a/LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean +++ b/LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean @@ -238,25 +238,44 @@ private theorem finiteLower : linarith private theorem localRay : - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : ι), - ∀ (hlocal : ∀ (c : ι), (P.plane.adjacent a c) → (∃ u : Real × Real, ‖u‖ = 1 ∧ ∃ ε > 0, - D.edgeArc a c ∩ Metric.ball (D.position a) ε = Metric.ball (D.position a) ε ∩ {p | ∃ t : - Real, 0 ≤ t ∧ p = D.position a + t • u})), - let localU (c : ι) (hc : P.plane.adjacent a c) : Real × Real := - Classical.choose (hlocal c hc) - let localEps (c : ι) (hc : P.plane.adjacent a c) : Real := - Classical.choose (Classical.choose_spec (hlocal c hc)).2 - (∀ (c : ι), ∀ (hc : P.plane.adjacent a c), ‖localU c hc‖ = 1 ∧ 0 < localEps c hc ∧ D.edgeArc - a c ∩ Metric.ball (D.position a) (localEps c hc) = Metric.ball (D.position a) (localEps c - hc) ∩ {p | ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • localU c hc}) → ( - let u : ι → Real × Real := fun c => - @dite (Real × Real) (P.plane.adjacent a c) (Classical.propDecidable _) - (fun hc => localU c hc) (fun _ => 0) - ∀ (c : ι), ∀ (hc : P.plane.adjacent a c), ∀ (q : ℝ), (0 : ℝ) < q → q < localEps c hc → - D.edgeArc a c ∩ Metric.ball (D.position a) q = Metric.ball (D.position a) q ∩ {p : ℝ × ℝ - | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ p = D.position a + t • u c}) := by + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1AllContactRouting P), + ∀ (a : ι), + ∀ + (hlocal : + ∀ (c : ι), + P.plane.adjacent a c → + ∃ u : Real × Real, + ‖u‖ = 1 ∧ + ∃ ε > 0, + D.edgeArc a c ∩ Metric.ball (D.position a) ε = + Metric.ball (D.position a) ε ∩ + {p | ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • u}), + let localU (c : ι) (hc : P.plane.adjacent a c) : Real × Real := + Classical.choose (hlocal c hc); + let localEps (c : ι) (hc : P.plane.adjacent a c) : Real := + Classical.choose (Classical.choose_spec (hlocal c hc)).2; + (∀ (c : ι), + ∀ (hc : P.plane.adjacent a c), + ‖localU c hc‖ = 1 ∧ + 0 < localEps c hc ∧ + D.edgeArc a c ∩ Metric.ball (D.position a) (localEps c hc) = + Metric.ball (D.position a) (localEps c hc) ∩ + {p | ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • localU c hc}) → + let u : ι → Real × Real := fun c => + @dite (Real × Real) (P.plane.adjacent a c) (Classical.propDecidable _) + (fun hc => localU c hc) fun _ => 0; + ∀ (c : ι), + ∀ (hc : P.plane.adjacent a c), + ∀ (q : ℝ), + q < localEps c hc → + D.edgeArc a c ∩ Metric.ball (D.position a) q = + Metric.ball (D.position a) q ∩ + {p : ℝ × ℝ | + ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ p = D.position a + t • u c} := by classical - intro ι P D a hlocal localU localEps localSpec u c hc q hq0 hq + intro ι P D a hlocal localU localEps localSpec u c hc q hq have heq := (localSpec c hc).2.2 have hball : Metric.ball (D.position a) q ⊆ Metric.ball (D.position a) (localEps c hc) := @@ -523,7 +542,7 @@ theorem P3889T1ExactRadialStar {ι : Type} (P : PeriodicTileComplex ι) D.edgeArc a c ∩ Metric.ball (D.position a) q = Metric.ball (D.position a) q ∩ {p | ∃ t : Real, 0 ≤ t ∧ p = D.position a + t • u c} := RadialStarProof.localRay ι P D - a hlocal localSpec c hc q hq0 hq + a hlocal localSpec c hc q hq have edgeCompact (c d : ι) (hcd : P3723T1EdgeContact P c d) : IsCompact (D.edgeArc c d) := by obtain ⟨g, hg, _, hrange, _, _, _⟩ := D.edgeArc_parameterization c d hcd diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean index 49236160cc..e997e8f3fc 100644 --- a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean @@ -1149,43 +1149,82 @@ private theorem hzeroK : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (F : - P3861T1FacialDomains P D), ∀ (a : ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), (∀ (c : ι), - P.plane.adjacent a c → ‖u c‖ = (1 : ℝ)) → ( - let x := D.position a - let B := Metric.ball x r - (∀ (f : P.plane.Face), ∀ (i : Fin 3), (P.plane.faceVertex f i = a) → (∃ c d, c ≠ a ∧ d ≠ - a ∧ c ≠ d ∧ P.plane.adjacent a c ∧ P.plane.adjacent a d ∧ (∃ j, P.plane.faceVertex f - j = c) ∧ (∃ j, P.plane.faceVertex f j = d) ∧ frontier (F.region f) ∩ B = (B ∩ {q | ∃ - t : Real, 0 ≤ t ∧ q = x + t • u c}) ∪ (B ∩ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u d}) - ∧ Nonempty (P3889T1TwoRaySectorDecomposition x r (u c) (u d)))) → ( - let I : Set P.plane.Face := {f | ∃ i, P.plane.faceVertex f i = a} - ∀ (c : ι), - let Nsub := {c : ι // P.plane.adjacent a c} - let first (c : Nsub) : P.plane.Face := - Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) - let second (c : Nsub) : P.plane.Face := - Classical.choose (Classical.choose_spec - (P.plane.every_edge_two_faces a c.1 c.2)) - (∀ (g : P.plane.Face), ∀ (j : Fin 3), (P.plane.faceVertex g j = a) → (∀ (e : ι), (∃ k, - P.plane.faceVertex g k = e) → ((e ≠ a) → (∀ (c : ι), ∀ (d : ι), (c ≠ a) → ((d ≠ a) → - ((c ≠ d) → ((∃ k, P.plane.faceVertex g k = c) → ((∃ k, P.plane.faceVertex g k = d) → - (e = c ∨ e = d))))))))) → (∀ (f : P.plane.Face), - let K : Set (Real × Real) := ⋃ f ∈ I, closure (F.region f) - ∀ (z : ℝ × ℝ), ∀ (i : Fin (3 : ℕ)), (P.plane.faceVertex f i = a) → (∀ (e : ι), (∃ (k : - Fin (3 : ℕ)), P.plane.faceVertex f k = e) → ((e ≠ a) → (∀ (hae : P.plane.adjacent a - e), ∀ (t : ℝ), (z = x + t • u e) → ( - let en : Nsub := ⟨e, hae⟩ - let f0 := first en - let f1 := second en - let g := if f = f0 then f1 else f0 - (∃ j, P.plane.faceVertex g j = e) → (∀ (j : Fin (3 : ℕ)), (P.plane.faceVertex g j = a) → - (∀ (δ₁ : ℝ), ∀ (δ₂ : ℝ), - let eps := min δ₁ (min δ₂ t) / 2 - (eps < t) → ((Metric.ball z eps ⊆ B) → (∀ q ∈ Metric.ball z eps, (u e).1 * (q.2 - z.2) - - (u e).2 * (q.1 - z.1) = 0 → q ∈ K))))))))))) ) := by - classical - intro ι P D F a r u hunit x B hincidentSectorData I c Nsub first second faceOtherMatch f K z i + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1AllContactRouting P), + ∀ (F : P3861T1FacialDomains P D), + ∀ (a : ι), + ∀ (r : ℝ), + ∀ (u : ι → ℝ × ℝ), + (∀ (c : ι), P.plane.adjacent a c → ‖u c‖ = (1 : ℝ)) → + let x := D.position a; + let B := Metric.ball x r; + (∀ (f : P.plane.Face), + ∀ (i : Fin 3), + P.plane.faceVertex f i = a → + ∃ c d, + c ≠ a ∧ + d ≠ a ∧ + c ≠ d ∧ + P.plane.adjacent a c ∧ + P.plane.adjacent a d ∧ + (∃ j, P.plane.faceVertex f j = c) ∧ + (∃ j, P.plane.faceVertex f j = d) ∧ + frontier (F.region f) ∩ B = + B ∩ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u c} ∪ + B ∩ {q | ∃ t : Real, 0 ≤ t ∧ q = x + t • u d} ∧ + Nonempty + (P3889T1TwoRaySectorDecomposition x r (u c) (u d))) → + let I : Set P.plane.Face := + {f | ∃ i, P.plane.faceVertex f i = a}; + let Nsub := { c : ι // P.plane.adjacent a c } + let first (c : Nsub) : P.plane.Face := + Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) + let second (c : Nsub) : P.plane.Face := + Classical.choose + (Classical.choose_spec + (P.plane.every_edge_two_faces a c.1 c.2)) + (∀ (g : P.plane.Face), + ∀ (j : Fin 3), + P.plane.faceVertex g j = a → + ∀ (e : ι), + (∃ k, P.plane.faceVertex g k = e) → + e ≠ a → + ∀ (c : ι), + ∀ (d : ι), + c ≠ a → + d ≠ a → + c ≠ d → + (∃ k, P.plane.faceVertex g k = c) → + (∃ k, P.plane.faceVertex g k = d) → e = c ∨ e = d) → + ∀ (f : P.plane.Face), + let K : Set (Real × Real) := ⋃ f ∈ I, closure (F.region f) + ∀ (z : ℝ × ℝ), + ∀ (i : Fin (3 : ℕ)), + P.plane.faceVertex f i = a → + ∀ (e : ι), + (∃ (k : Fin (3 : ℕ)), P.plane.faceVertex f k = e) → + e ≠ a → + ∀ (hae : P.plane.adjacent a e), + ∀ (t : ℝ), + z = x + t • u e → + let en : Nsub := ⟨e, hae⟩ + let f0 := first en + let f1 := second en + let g := if f = f0 then f1 else f0 + (∃ j, P.plane.faceVertex g j = e) → + ∀ (j : Fin (3 : ℕ)), + P.plane.faceVertex g j = a → + ∀ (δ₁ : ℝ), + ∀ (δ₂ : ℝ), + let eps := min δ₁ (min δ₂ t) / 2 + eps < t → + Metric.ball z eps ⊆ B → + ∀ q ∈ Metric.ball z eps, + (u e).1 * (q.2 - z.2) - (u e).2 * (q.1 - z.1) = 0 → q ∈ K + ) := by + classical + intro ι P D F a r u hunit x B hincidentSectorData I Nsub first second faceOtherMatch f K z i hi e he hea hae t hzeq en f0 f1 g hgE j hj δ₁ δ₂ eps hepst hball₁' q hq hdet have hu : u e ≠ 0 := by intro heq @@ -1820,7 +1859,7 @@ private theorem hKlocal : have hball₂' := FaceGapProof.hball₂' ι P D a r z t δ₁ δ₂ hball₂ heps₂ have hzeroK := FaceGapProof.hzeroK ι P - D F a r u hunit hincidentSectorData c faceOtherMatch f z i hi e he hea hae t hzeq + D F a r u hunit hincidentSectorData faceOtherMatch f z i hi e he hea hae t hzeq hgE j hj δ₁ δ₂ (FaceGapProof.hepst t ht δ₁ δ₂) (FaceGapProof.hball₁' ι P D a r z t δ₁ hball₁ δ₂ heps₁) have memK (g : P.plane.Face) (j : Fin 3) diff --git a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean index c8c464a507..242aab8219 100644 --- a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean +++ b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean @@ -151,39 +151,39 @@ private theorem retained : (by classical exact - ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), - Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → - P3723T1PolygonalParameterization (g k)), - let m0 := (s 0).count - let m1 := (s 1).count - let m2 := (s 2).count - let M := m0 + (m1 + m2) - let n := M - 3 - ∀ (hM : n + 3 = M), - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · let hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · let hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let q : Fin M → Real × Real := - Fin.addCases - (fun i : Fin m0 => w 0 i.castSucc) - (Fin.addCases - (fun i : Fin m1 => w 1 i.castSucc) - (fun i : Fin m2 => w 2 i.castSucc)) - let p : Fin (n + 3) → Real × Real := fun i => q (Fin.cast hM i) - (∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc) → ((∀ (i : Fin m1), q - (Fin.natAdd m0 (Fin.castAdd m2 i)) = w 1 i.castSucc) → ((∀ (i : Fin m2), q - (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc) → ((∀ (i : Fin M), p (Fin.cast - hM.symm i) = q i) → ((∀ (k : Fin 3), w k (Fin.last (s k).count) = w (k + 1) 0) → (∀ - (k : Fin (3 : ℕ)), ∀ (i : Fin ((s k).count + (1 : ℕ))), w k i ∈ Set.range p))))))) := by + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let n := M - 3 + ∀ (hM : n + 3 = M), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases (fun i : Fin m1 => w 1 i.castSucc) fun i : Fin m2 => + w 2 i.castSucc) + let p : Fin (n + 3) → Real × Real := fun i => q (Fin.cast hM i) + (∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc) → + (∀ (i : Fin m1), q (Fin.natAdd m0 (Fin.castAdd m2 i)) = w 1 i.castSucc) → + (∀ (i : Fin m2), q (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc) → + (∀ (i : Fin M), p (Fin.cast hM.symm i) = q i) → + (∀ (k : Fin 3), w k (Fin.last (s k).count) = w (k + 1) 0) → + ∀ (k : Fin (3 : ℕ)), + ∀ (i : Fin ((s k).count + (1 : ℕ))), w k i ∈ Set.range p + ) := by classical - intro g hi s m0 m1 m2 M n hM τ w q p q0 q1 q2 p_at join k i + intro g s m0 m1 m2 M n hM τ w q p q0 q1 q2 p_at join k i fin_cases k · refine Fin.lastCases ?_ ?_ i · let j : Fin m1 := ⟨0, (s 1).positive⟩ @@ -229,15 +229,18 @@ private theorem pair_ne : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (f : P.plane.Face), ∀ (g : Fin (3 : ℕ) → - (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ((k : Fin (3 : ℕ)) → - P3723T1PolygonalParameterization (g k)) → ( - let v : Fin 3 → ι := P.plane.faceVertex f - ∀ (i : Fin (3 : ℕ)), ∀ (j : Fin (3 : ℕ)), i ≠ j → ({v i, v (i + (1 : Fin (3 : ℕ)))} : Set - ι) ≠ {v j, v (j + (1 : Fin (3 : ℕ)))}) + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (f : P.plane.Face), + let v : Fin 3 → ι := P.plane.faceVertex f + ∀ (i : Fin (3 : ℕ)), + ∀ (j : Fin (3 : ℕ)), + i ≠ j → + ({v i, v (i + (1 : Fin (3 : ℕ)))} : Set ι) ≠ + {v j, v (j + (1 : Fin (3 : ℕ)))} ) := by classical - intro ι P f g s v i j hij he + intro ι P f v i j hij he rw [Set.pair_eq_pair_iff] at he rcases he with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩ · exact hij (P.plane.face_vertices_distinct f h₁) @@ -283,38 +286,42 @@ private theorem q_injective : (by classical exact - ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), - Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → - P3723T1PolygonalParameterization (g k)), - let m0 := (s 0).count - let m1 := (s 1).count - let m2 := (s 2).count - let M := m0 + (m1 + m2) - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · let hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · let hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let q : Fin M → Real × Real := - Fin.addCases - (fun i : Fin m0 => w 0 i.castSucc) - (Fin.addCases - (fun i : Fin m1 => w 1 i.castSucc) - (fun i : Fin m2 => w 2 i.castSucc)) - (∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc) → ((∀ (i : Fin m1), q - (Fin.natAdd m0 (Fin.castAdd m2 i)) = w 1 i.castSucc) → ((∀ (i : Fin m2), q - (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc) → ((∀ (i : Fin m0), ∀ (j : Fin - m1), (w 0 i.castSucc = w 1 j.castSucc) → (False)) → ((∀ (i : Fin m1), ∀ (j : Fin m2), - (w 1 i.castSucc = w 2 j.castSucc) → (False)) → ((∀ (i : Fin m0), ∀ (j : Fin m2), (w 0 - i.castSucc = w 2 j.castSucc) → (False)) → ((∀ (k : Fin 3), Function.Injective (fun i - : Fin (s k).count => w k i.castSucc)) → (Function.Injective q))))))))) := by + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases (fun i : Fin m1 => w 1 i.castSucc) fun i : Fin m2 => + w 2 i.castSucc) + (∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc) → + (∀ (i : Fin m1), q (Fin.natAdd m0 (Fin.castAdd m2 i)) = w 1 i.castSucc) → + (∀ (i : Fin m2), q (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc) → + (∀ (i : Fin m0), + ∀ (j : Fin m1), w 0 i.castSucc = w 1 j.castSucc → False) → + (∀ (i : Fin m1), + ∀ (j : Fin m2), w 1 i.castSucc = w 2 j.castSucc → False) → + (∀ (i : Fin m0), + ∀ (j : Fin m2), w 0 i.castSucc = w 2 j.castSucc → False) → + (∀ (k : Fin 3), + Function.Injective fun i : Fin (s k).count => + w k i.castSucc) → + Function.Injective q + ) := by classical - intro g hi s m0 m1 m2 M τ w q q0 q1 q2 no_cross01 no_cross12 no_cross02 w_block_injective a b hab + intro g s m0 m1 m2 M τ w q q0 q1 q2 no_cross01 no_cross12 no_cross02 w_block_injective a b hab revert b refine Fin.addCases ?_ ?_ a · intro i b @@ -375,13 +382,16 @@ private theorem finite_interval_cover : (by classical exact - ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ((k : Fin (3 : ℕ)) → - P3723T1PolygonalParameterization (g k)) → (∀ N, ∀ (a : Fin (N + 1) → Real), - StrictMono a → ∀ x, a 0 ≤ x → x ≤ a (Fin.last N) → 0 < N → ∃ r : Fin N, a r.castSucc - ≤ x ∧ x ≤ a r.succ) + ∀ N, + ∀ (a : Fin (N + 1) → Real), + StrictMono a → + ∀ x, + a 0 ≤ x → + x ≤ a (Fin.last N) → + 0 < N → ∃ r : Fin N, a r.castSucc ≤ x ∧ x ≤ a r.succ ) := by classical - intro g s N + intro N induction N with | zero => intro a ha x hlo hhi hpos @@ -416,35 +426,53 @@ private theorem arc_covered : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : - P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ - (k : Fin (3 : ℕ)), Function.Injective (g k)) → ((∀ (k : Fin (3 : ℕ)), Set.range (g k) - = D.edgeArc (P.plane.faceVertex f k) (P.plane.faceVertex f (k + (1 : Fin (3 : ℕ))))) - → (∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · let hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · let hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - (∀ (k : Fin 3), ∀ (r : Fin ((s k).count)), Set.range (fun t : Set.Icc ((s k).time - r.castSucc) ((s k).time r.succ) => - g k ⟨t.1, by - constructor - · exact (τ k r.castSucc).property.1.trans t.property.1 - · exact t.property.2.trans (τ k r.succ).property.2⟩) = - segment Real (w k r.castSucc) (w k r.succ)) → ( - let v : Fin 3 → ι := P.plane.faceVertex f - (∀ N, ∀ (a : Fin (N + 1) → Real), StrictMono a → ∀ x, a 0 ≤ x → x ≤ a (Fin.last N) → 0 < - N → ∃ r : Fin N, a r.castSucc ≤ x ∧ x ≤ a r.succ) → (∀ (k : Fin (3 : ℕ)), D.edgeArc - (v k) (v (k + (1 : Fin (3 : ℕ)))) = ⋃ (r : Fin (s k).count), segment ℝ (w k - r.castSucc) (w k r.succ)))))) := by + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1AllContactRouting P), + ∀ (f : P.plane.Face), + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + (∀ (k : Fin (3 : ℕ)), + Set.range (g k) = + D.edgeArc (P.plane.faceVertex f k) + (P.plane.faceVertex f (k + (1 : Fin (3 : ℕ))))) → + ∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : + Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + (∀ (k : Fin 3), + ∀ (r : Fin (s k).count), + (Set.range + fun t : + Set.Icc ((s k).time r.castSucc) ((s k).time r.succ) => + g k + ⟨t.1, by + constructor + · exact (τ k r.castSucc).property.1.trans t.property.1 + · exact t.property.2.trans (τ k r.succ).property.2⟩) = + segment Real (w k r.castSucc) (w k r.succ)) → + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ N, + ∀ (a : Fin (N + 1) → Real), + StrictMono a → + ∀ x, + a 0 ≤ x → + x ≤ a (Fin.last N) → + 0 < N → ∃ r : Fin N, a r.castSucc ≤ x ∧ x ≤ a r.succ) → + ∀ (k : Fin (3 : ℕ)), + D.edgeArc (v k) (v (k + (1 : Fin (3 : ℕ)))) = + ⋃ (r : Fin (s k).count), + segment ℝ (w k r.castSucc) (w k r.succ) + ) := by classical - intro ι P D f g hi hr s τ w piece_range v finite_interval_cover k + intro ι P D f g hr s τ w piece_range v finite_interval_cover k rw [← hr k] ext x constructor @@ -474,39 +502,37 @@ private theorem q_step : (by classical exact - ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), - Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → - P3723T1PolygonalParameterization (g k)), - let m0 := (s 0).count - let m1 := (s 1).count - let m2 := (s 2).count - let M := m0 + (m1 + m2) - let n := M - 3 - (n + 3 = M) → ( - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · let hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · let hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let q : Fin M → Real × Real := - Fin.addCases - (fun i : Fin m0 => w 0 i.castSucc) - (Fin.addCases - (fun i : Fin m1 => w 1 i.castSucc) - (fun i : Fin m2 => w 2 i.castSucc)) - (∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc) → ((∀ (i : Fin m1), q - (Fin.natAdd m0 (Fin.castAdd m2 i)) = w 1 i.castSucc) → ((∀ (i : Fin m2), q - (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc) → ((∀ (k : Fin 3), w k (Fin.last - (s k).count) = w (k + 1) 0) → ( - ∀ (a : Fin M), ∀ (ha : (↑a : ℕ) + (1 : ℕ) < M), ∃ (k : Fin (3 : ℕ)) (r : Fin (s - k).count), q a = w k r.castSucc ∧ q ⟨(↑a : ℕ) + (1 : ℕ), ha⟩ = w k r.succ))))))) := by + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count; + let m1 := (s 1).count; + let m2 := (s 2).count; + let M := m0 + (m1 + m2); + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases (fun i : Fin m1 => w 1 i.castSucc) fun i : Fin m2 => + w 2 i.castSucc) + (∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc) → + (∀ (i : Fin m1), q (Fin.natAdd m0 (Fin.castAdd m2 i)) = w 1 i.castSucc) → + (∀ (i : Fin m2), q (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc) → + (∀ (k : Fin 3), w k (Fin.last (s k).count) = w (k + 1) 0) → + ∀ (a : Fin M), + ∀ (ha : (↑a : ℕ) + (1 : ℕ) < M), + ∃ (k : Fin (3 : ℕ)) (r : Fin (s k).count), + q a = w k r.castSucc ∧ q ⟨(↑a : ℕ) + (1 : ℕ), ha⟩ = w k r.succ + ) := by classical - intro g hi s m0 m1 m2 M n hM τ w q q0 q1 q2 join a ha + intro g s m0 m1 m2 M τ w q q0 q1 q2 join a ha let b0 (i : Fin m0) : Fin M := Fin.castAdd (m1 + m2) i let b1 (i : Fin m1) : Fin M := Fin.natAdd m0 (Fin.castAdd m2 i) let b2 (i : Fin m2) : Fin M := Fin.natAdd m0 (Fin.natAdd m1 i) @@ -595,41 +621,44 @@ private theorem p_edge_piece : (by classical exact - ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), - Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → - P3723T1PolygonalParameterization (g k)), - let m0 := (s 0).count - let m1 := (s 1).count - let m2 := (s 2).count - let M := m0 + (m1 + m2) - let n := M - 3 - ∀ (hM : n + 3 = M), - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · let hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · let hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let q : Fin M → Real × Real := - Fin.addCases - (fun i : Fin m0 => w 0 i.castSucc) - (Fin.addCases - (fun i : Fin m1 => w 1 i.castSucc) - (fun i : Fin m2 => w 2 i.castSucc)) - let p : Fin (n + 3) → Real × Real := fun i => q (Fin.cast hM i) - (∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc) → ((∀ (i : Fin m2), q - (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc) → ((∀ (k : Fin 3), w k (Fin.last - (s k).count) = w (k + 1) 0) → ( - (∀ (a : Fin M), ∀ (ha : a.val + 1 < M), ∃ k : Fin 3, ∃ r : Fin (s k).count, q a = w k - r.castSucc ∧ q ⟨a.val + 1, ha⟩ = w k r.succ) → (∀ (i : Fin (n + (3 : ℕ))), ∃ (k : Fin - (3 : ℕ)) (r : Fin (s k).count), p i = w k r.castSucc ∧ p (i + (1 : Fin (n + (3 : - ℕ)))) = w k r.succ)))))) := by + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let n := M - 3 + ∀ (hM : n + 3 = M), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases (fun i : Fin m1 => w 1 i.castSucc) fun i : Fin m2 => + w 2 i.castSucc) + let p : Fin (n + 3) → Real × Real := fun i => q (Fin.cast hM i) + (∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc) → + (∀ (i : Fin m2), q (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc) → + (∀ (k : Fin 3), w k (Fin.last (s k).count) = w (k + 1) 0) → + (∀ (a : Fin M), + ∀ (ha : a.val + 1 < M), + ∃ k : Fin 3, + ∃ r : Fin (s k).count, + q a = w k r.castSucc ∧ q ⟨a.val + 1, ha⟩ = w k r.succ) → + ∀ (i : Fin (n + (3 : ℕ))), + ∃ (k : Fin (3 : ℕ)) (r : Fin (s k).count), + p i = w k r.castSucc ∧ + p (i + (1 : Fin (n + (3 : ℕ)))) = w k r.succ + ) := by classical - intro g hi s m0 m1 m2 M n hM τ w q p q0 q2 join q_step i + intro g s m0 m1 m2 M n hM τ w q p q0 q2 join q_step i let b0 (i : Fin m0) : Fin M := Fin.castAdd (m1 + m2) i let b2 (i : Fin m2) : Fin M := Fin.natAdd m0 (Fin.natAdd m1 i) refine Fin.lastCases ?_ ?_ i @@ -689,41 +718,42 @@ private theorem block_edge : (by classical exact - ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), - Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → - P3723T1PolygonalParameterization (g k)), - let m0 := (s 0).count - let m1 := (s 1).count - let m2 := (s 2).count - let M := m0 + (m1 + m2) - let n := M - 3 - ∀ (hM : n + 3 = M), - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · let hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · let hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let q : Fin M → Real × Real := - Fin.addCases - (fun i : Fin m0 => w 0 i.castSucc) - (Fin.addCases - (fun i : Fin m1 => w 1 i.castSucc) - (fun i : Fin m2 => w 2 i.castSucc)) - let p : Fin (n + 3) → Real × Real := fun i => q (Fin.cast hM i) - (∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc) → ((∀ (i : Fin m1), q - (Fin.natAdd m0 (Fin.castAdd m2 i)) = w 1 i.castSucc) → ((∀ (i : Fin m2), q - (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc) → ((∀ (k : Fin 3), w k (Fin.last - (s k).count) = w (k + 1) 0) → ( - (∀ (i : Fin (n + 3)), (i.val + 1 < n + 3) → ((i + 1).val = i.val + 1)) → (∀ (k : Fin (3 : - ℕ)), ∀ (r : Fin (s k).count), ∃ (i : Fin (n + (3 : ℕ))), p i = w k r.castSucc ∧ p (i - + (1 : Fin (n + (3 : ℕ)))) = w k r.succ))))))) := by + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let n := M - 3 + ∀ (hM : n + 3 = M), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases (fun i : Fin m1 => w 1 i.castSucc) fun i : Fin m2 => + w 2 i.castSucc) + let p : Fin (n + 3) → Real × Real := fun i => q (Fin.cast hM i) + (∀ (i : Fin m0), q (Fin.castAdd (m1 + m2) i) = w 0 i.castSucc) → + (∀ (i : Fin m1), q (Fin.natAdd m0 (Fin.castAdd m2 i)) = w 1 i.castSucc) → + (∀ (i : Fin m2), q (Fin.natAdd m0 (Fin.natAdd m1 i)) = w 2 i.castSucc) → + (∀ (k : Fin 3), w k (Fin.last (s k).count) = w (k + 1) 0) → + (∀ (i : Fin (n + 3)), i.val + 1 < n + 3 → (i + 1).val = i.val + 1) → + ∀ (k : Fin (3 : ℕ)), + ∀ (r : Fin (s k).count), + ∃ (i : Fin (n + (3 : ℕ))), + p i = w k r.castSucc ∧ + p (i + (1 : Fin (n + (3 : ℕ)))) = w k r.succ + ) := by classical - intro g hi s m0 m1 m2 M n hM τ w q p q0 q1 q2 join fin_succ_val k r + intro g s m0 m1 m2 M n hM τ w q p q0 q1 q2 join fin_succ_val k r let b0 (i : Fin m0) : Fin M := Fin.castAdd (m1 + m2) i let b1 (i : Fin m1) : Fin M := Fin.natAdd m0 (Fin.castAdd m2 i) let b2 (i : Fin m2) : Fin M := Fin.natAdd m0 (Fin.natAdd m1 i) @@ -878,39 +908,42 @@ private theorem edge_union : (by classical exact - ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), - Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → - P3723T1PolygonalParameterization (g k)), - let m0 := (s 0).count - let m1 := (s 1).count - let m2 := (s 2).count - let M := m0 + (m1 + m2) - let n := M - 3 - ∀ (hM : n + 3 = M), - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · let hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · let hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let q : Fin M → Real × Real := - Fin.addCases - (fun i : Fin m0 => w 0 i.castSucc) - (Fin.addCases - (fun i : Fin m1 => w 1 i.castSucc) - (fun i : Fin m2 => w 2 i.castSucc)) - let p : Fin (n + 3) → Real × Real := fun i => q (Fin.cast hM i) - (∀ (i : Fin (n + 3)), ∃ k : Fin 3, ∃ r : Fin (s k).count, p i = w k r.castSucc ∧ p (i + - 1) = w k r.succ) → ((∀ (k : Fin 3), ∀ (r : Fin (s k).count), ∃ i : Fin (n + 3), p i = - w k r.castSucc ∧ p (i + 1) = w k r.succ) → ((⋃ i : Fin (n + 3), segment Real (p i) (p - (i + 1))) = ⋃ k : Fin 3, ⋃ r : Fin (s k).count, segment Real (w k r.castSucc) (w k - r.succ))))) := by + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let m0 := (s 0).count + let m1 := (s 1).count + let m2 := (s 2).count + let M := m0 + (m1 + m2) + let n := M - 3 + ∀ (hM : n + 3 = M), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let q : Fin M → Real × Real := + Fin.addCases (fun i : Fin m0 => w 0 i.castSucc) + (Fin.addCases (fun i : Fin m1 => w 1 i.castSucc) fun i : Fin m2 => + w 2 i.castSucc) + let p : Fin (n + 3) → Real × Real := fun i => q (Fin.cast hM i) + (∀ (i : Fin (n + 3)), + ∃ k : Fin 3, + ∃ r : Fin (s k).count, + p i = w k r.castSucc ∧ p (i + 1) = w k r.succ) → + (∀ (k : Fin 3), + ∀ (r : Fin (s k).count), + ∃ i : Fin (n + 3), p i = w k r.castSucc ∧ p (i + 1) = w k r.succ) → + ⋃ i : Fin (n + 3), segment Real (p i) (p (i + 1)) = + ⋃ k : Fin 3, + ⋃ r : Fin (s k).count, segment Real (w k r.castSucc) (w k r.succ) + ) := by classical - intro g hi s m0 m1 m2 M n hM τ w q p p_edge_piece block_edge + intro g s m0 m1 m2 M n hM τ w q p p_edge_piece block_edge ext x simp only [Set.mem_iUnion] constructor @@ -925,26 +958,35 @@ private theorem piece_arc_union : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : - P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ - (k : Fin (3 : ℕ)), Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → - P3723T1PolygonalParameterization (g k)), - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · let hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · let hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - let v : Fin 3 → ι := P.plane.faceVertex f - (∀ (k : Fin 3), D.edgeArc (v k) (v (k + 1)) = ⋃ r : Fin (s k).count, segment Real (w k - r.castSucc) (w k r.succ)) → ((⋃ k : Fin 3, ⋃ r : Fin (s k).count, segment Real (w k - r.castSucc) (w k r.succ)) = ⋃ k : Fin 3, D.edgeArc (v k) (v (k + 1))))) := by + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1AllContactRouting P), + ∀ (f : P.plane.Face), + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : + Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + let v : Fin 3 → ι := P.plane.faceVertex f + (∀ (k : Fin 3), + D.edgeArc (v k) (v (k + 1)) = + ⋃ r : Fin (s k).count, + segment Real (w k r.castSucc) (w k r.succ)) → + ⋃ k : Fin 3, + ⋃ r : Fin (s k).count, + segment Real (w k r.castSucc) (w k r.succ) = + ⋃ k : Fin 3, D.edgeArc (v k) (v (k + 1)) + ) := by classical - intro ι P D f g hi s τ w v arc_covered + intro ι P D f g s τ w v arc_covered ext x simp only [Set.mem_iUnion] constructor @@ -1178,28 +1220,38 @@ private theorem piece_overlap : (by classical exact - ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 : ℕ)), - Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → - P3723T1PolygonalParameterization (g k)), - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · let hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · let hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) - (∀ (k : Fin 3), ∀ (r : Fin (s k).count), ∀ (r' : Fin (s k).count), (r.val < r'.val) → (∀ - (x : Real × Real), (x ∈ segment Real (w k r.castSucc) (w k r.succ)) → ((x ∈ segment - Real (w k r'.castSucc) (w k r'.succ)) → ((x = w k r.castSucc ∨ x = w k r.succ) ∧ (x = - w k r'.castSucc ∨ x = w k r'.succ))))) → (∀ (k : Fin (3 : ℕ)), ∀ (r : Fin (s - k).count), ∀ (r' : Fin (s k).count), r ≠ r' → ∀ x ∈ segment ℝ (w k r.castSucc) (w k - r.succ), x ∈ segment ℝ (w k r'.castSucc) (w k r'.succ) → (x = w k r.castSucc ∨ x = w - k r.succ) ∧ (x = w k r'.castSucc ∨ x = w k r'.succ)))) := by + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · let hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · let hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i) + (∀ (k : Fin 3), + ∀ (r : Fin (s k).count), + ∀ (r' : Fin (s k).count), + r.val < r'.val → + ∀ (x : Real × Real), + x ∈ segment Real (w k r.castSucc) (w k r.succ) → + x ∈ segment Real (w k r'.castSucc) (w k r'.succ) → + (x = w k r.castSucc ∨ x = w k r.succ) ∧ + (x = w k r'.castSucc ∨ x = w k r'.succ)) → + ∀ (k : Fin (3 : ℕ)), + ∀ (r : Fin (s k).count), + ∀ (r' : Fin (s k).count), + r ≠ r' → + ∀ x ∈ segment ℝ (w k r.castSucc) (w k r.succ), + x ∈ segment ℝ (w k r'.castSucc) (w k r'.succ) → + (x = w k r.castSucc ∨ x = w k r.succ) ∧ + (x = w k r'.castSucc ∨ x = w k r'.succ) + ) := by classical - intro g hi s τ w piece_overlap_forward k r r' hne x hx hx' + intro g s τ w piece_overlap_forward k r r' hne x hx hx' have hvne : r.val ≠ r'.val := by intro hv apply hne @@ -1356,21 +1408,22 @@ private theorem w_before_end : (by classical exact - ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), (∀ (k : Fin (3 - : ℕ)), Function.Injective (g k)) → (∀ (s : (k : Fin (3 : ℕ)) → - P3723T1PolygonalParameterization (g k)), - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · have hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · have hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - ∀ (k : Fin (3 : ℕ)), ∀ (i : Fin (s k).count), (↑(τ k i.castSucc) : ℝ) < (1 : ℝ))) := by + ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), + let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := + ⟨(s k).time i, by + constructor + · have hi := (s k).strict.monotone (Fin.zero_le i) + rw [(s k).start] at hi + exact hi + · have hi := (s k).strict.monotone (Fin.le_last i) + rw [(s k).finish] at hi + exact hi⟩ + ∀ (k : Fin (3 : ℕ)), + ∀ (i : Fin (s k).count), (↑(τ k i.castSucc) : ℝ) < (1 : ℝ) + ) := by classical - intro g hi s τ k i + intro g s τ k i have hidx : i.castSucc < Fin.last (s k).count := by apply Fin.mk_lt_mk.mpr simp @@ -1808,7 +1861,7 @@ theorem P3913T1RoutedFaceSubdivision : w k (Fin.last (s k).count) = w (k + 1) 0 := RoutedSubdivisionProof.join ι P D f g h0 h1 s k let v : Fin 3 → ι := P.plane.faceVertex f have arc_inter (i j : Fin 3) (hij : i ≠ j) := RoutedFaceDetails.arc_inter ι P D f - (RoutedSubdivisionProof.pair_ne ι P f g s) + (RoutedSubdivisionProof.pair_ne ι P f) (RoutedFaceDetails.faceContact ι P f (RoutedFaceDetails.cyc_ne)) i j hij have v_distinct (i j : Fin 3) (hij : i ≠ j) := RoutedFaceDetails.v_distinct ι P f i j hij @@ -1819,13 +1872,13 @@ theorem P3913T1RoutedFaceSubdivision : P D f arc_inter (RoutedFaceDetails.pair_inter ι P f v_distinct) i j hij have w_arc (k : Fin 3) (i : Fin ((s k).count + 1)) := RoutedFaceDetails.w_arc ι P D f g hr s k i - have w_before_end (k : Fin 3) (i : Fin (s k).count) := RoutedFaceDetails.w_before_end g hi s k i + have w_before_end (k : Fin 3) (i : Fin (s k).count) := RoutedFaceDetails.w_before_end g s k i have w_start (k : Fin 3) := RoutedFaceDetails.w_start ι P D f g h0 s k have w_ne_finish (k : Fin 3) (i : Fin (s k).count) : w k i.castSucc ≠ D.position (v (k + 1)) := RoutedSubdivisionProof.w_ne_finish ι P D f g hi s (RoutedFaceDetails.w_finish ι P D f g h1 s) k i - have q_injective : Function.Injective q := RoutedSubdivisionProof.q_injective g hi s q0 q1 q2 + have q_injective : Function.Injective q := RoutedSubdivisionProof.q_injective g s q0 q1 q2 (RoutedFaceDetails.no_cross01 ι P D f g s w_arc w_ne_finish (RoutedFaceDetails.arc01 ι P D f arc_inter_singleton)) (RoutedFaceDetails.no_cross12 ι P D f g s w_arc w_ne_finish (RoutedFaceDetails.arc12 ι P D f arc_inter_singleton)) @@ -1837,8 +1890,8 @@ theorem P3913T1RoutedFaceSubdivision : have hM' : n + 3 = m0 + (m1 + m2) := by simpa [M] using hM have p_edge_piece (i : Fin (n + 3)) : ∃ k : Fin 3, ∃ r : Fin (s k).count, - p i = w k r.castSucc ∧ p (i + 1) = w k r.succ := RoutedSubdivisionProof.p_edge_piece g hi - s hM q0 q2 join (RoutedSubdivisionProof.q_step g hi s hM q0 q1 q2 join) i + p i = w k r.castSucc ∧ p (i + 1) = w k r.succ := RoutedSubdivisionProof.p_edge_piece g + s hM q0 q2 join (RoutedSubdivisionProof.q_step g s q0 q1 q2 join) i have piece_subset_arc (k : Fin 3) (r : Fin (s k).count) := (show segment ℝ (w k r.castSucc) (w k r.succ) ⊆ D.edgeArc (v k) (v (k + (1 : Fin (3 : ℕ)))) @@ -1891,7 +1944,7 @@ theorem P3913T1RoutedFaceSubdivision : apply Fin.cast_injective hM apply q_injective simpa [p] using hij)) hpi)).elim - · have hend := (RoutedSubdivisionProof.piece_overlap g hi s + · have hend := (RoutedSubdivisionProof.piece_overlap g s (RoutedSubdivisionProof.piece_overlap_forward g hi s piece_range)) k r r' hrr x hx1 hx2 simpa [hli, hri, hlj, hrj] using hend · have hxarc : @@ -1912,17 +1965,17 @@ theorem P3913T1RoutedFaceSubdivision : · calc (⋃ i : Fin (n + 3), segment Real (p i) (p (i + 1))) = ⋃ k : Fin 3, ⋃ r : Fin (s k).count, - segment Real (w k r.castSucc) (w k r.succ) := (RoutedSubdivisionProof.edge_union g hi - s hM p_edge_piece (RoutedSubdivisionProof.block_edge g hi s hM q0 q1 q2 join + segment Real (w k r.castSucc) (w k r.succ) := (RoutedSubdivisionProof.edge_union g + s hM p_edge_piece (RoutedSubdivisionProof.block_edge g s hM q0 q1 q2 join (RoutedFaceDetails.fin_succ_val g s))) _ = ⋃ k : Fin 3, D.edgeArc (v k) (v (k + 1)) := (RoutedSubdivisionProof.piece_arc_union ι P - D f g hi s (RoutedSubdivisionProof.arc_covered ι P D f g hi hr s piece_range - (RoutedSubdivisionProof.finite_interval_cover g s))) + D f g s (RoutedSubdivisionProof.arc_covered ι P D f g hr s piece_range + (RoutedSubdivisionProof.finite_interval_cover))) _ = D.edgeArc (v 0) (v 1) ∪ D.edgeArc (v 1) (v 2) ∪ D.edgeArc (v 2) (v 0) := (RoutedSubdivisionProof.arc_union ι P D f) · intro k i refine ⟨τ k i, rfl, ?_⟩ - exact (RoutedSubdivisionProof.retained g hi s hM q0 q1 q2 p_at join) k i + exact (RoutedSubdivisionProof.retained g s hM q0 q1 q2 p_at join) k i end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean index 199c296f6d..04a26fe535 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean @@ -145,56 +145,81 @@ private theorem hscale : _ = (((xR : Real) - (xL : Real)) / ((r2 : Real) - (r1 : Real))) * Bg.2 := by ring private theorem localResult : - ∀ (S : Set (Real × Real)), ∀ (e : Bool), ∀ (d : Bool), ∀ (U₁ : Set (ℝ × ℝ)), ∀ (U₂ : Set (ℝ × - ℝ)), ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : - ℝ)) : Type) → ℝ × ℝ), ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : - P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), - (P3934T1PolygonalSide U₁ g p e) → (∀ (hhrange : Set.range h = S), - (P3934T1PolygonalSide U₂ h q d) → ( - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩ - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩ - ∀ (hgfun_inj : Function.Injective gfun), ∀ (hhfun_inj : Function.Injective hfun), ∀ - (hgfun_surj : Function.Surjective gfun), ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩ - let he : Set.Icc (0 : Real) 1 ≃ S := Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩ - ∀ (hgfun_cont : Continuous gfun), ∀ (hhfun_cont : Continuous hfun), - let GH := - Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont - let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont - let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm - let i0 : Fin p.count := ⟨0, p.positive⟩ - let j0 : Fin q.count := ⟨0, q.positive⟩ - let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩ - let j1 : Fin (q.count + 1) := ⟨1, by have hq := q.positive; omega⟩ - ∀ (hpi : 0 < p.time i1), ∀ (hqj : 0 < q.time j1), ∀ (hpi1 : p.time i1 ≤ 1), ∀ (hqj1 : q.time - j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩ - let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩ - let c : Real := min (phi α : Real) (β : Real) - ∀ (hcpos : 0 < c), ((c ≤ (β : Real)) → (∀ (hc_le_one : c ≤ 1), - let r1 : Set.Icc (0 : Real) 1 - := ⟨c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - let xL : Set.Icc (0 : Real) 1 := phi.symm r1 - let xR : Set.Icc (0 : Real) 1 := phi.symm r2 - ∀ (Bg : ℝ × ℝ), (Bg ≠ (0 : ℝ × ℝ)) → ((∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), p.time - i0.castSucc < (↑t : ℝ) → (↑t : ℝ) < p.time i0.succ → P3934T1LocalSide U₁ (g t) Bg e) → - (∀ (Bh : ℝ × ℝ), (∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), q.time j0.castSucc < (↑t : - ℝ) → (↑t : ℝ) < q.time j0.succ → P3934T1LocalSide U₂ (h t) Bh d) → ( - let scale : Real := - ((xR : Real) - (xL : Real)) / ((r2 : Real) - (r1 : Real)) - (0 < scale) → ((Bh = scale • Bg) → ( - let z : Real × Real := g xL - (P3934T1LocalSide U₁ z Bg e) → ((P3934T1LocalSide U₂ z Bh d) → ((U₁ = U₂ → e = d) ∧ - (Disjoint U₁ U₂ → e ≠ d)))))))))))) := by + ∀ (S : Set (Real × Real)), + ∀ (e : Bool), + ∀ (d : Bool), + ∀ (U₁ : Set (ℝ × ℝ)), + ∀ (U₂ : Set (ℝ × ℝ)), + ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + ∀ (p : P3723T1PolygonalParameterization g), + ∀ (q : P3723T1PolygonalParameterization h), + ∀ (hgrange : Set.range g = S), + P3934T1PolygonalSide U₁ g p e → + ∀ (hhrange : Set.range h = S), + P3934T1PolygonalSide U₂ h q d → + let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; + let hfun : Set.Icc (0 : Real) 1 → S := fun x => + ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; + ∀ (hgfun_inj : Function.Injective gfun), + ∀ (hhfun_inj : Function.Injective hfun), + ∀ (hgfun_surj : Function.Surjective gfun), + ∀ (hhfun_surj : Function.Surjective hfun), + let ge : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; + let he : Set.Icc (0 : Real) 1 ≃ S := + Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; + ∀ (hgfun_cont : Continuous gfun), + ∀ (hhfun_cont : Continuous hfun), + let GH := + Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont; + let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont; + let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := + GH.trans HH.symm; + let i0 : Fin p.count := ⟨0, p.positive⟩; + let j0 : Fin q.count := ⟨0, q.positive⟩; + let i1 : Fin (p.count + 1) := + ⟨1, by have hp := p.positive; omega⟩; + let j1 : Fin (q.count + 1) := + ⟨1, by have hq := q.positive; omega⟩; + ∀ (hpi : 0 < p.time i1), + ∀ (hqj : 0 < q.time j1), + ∀ (hpi1 : p.time i1 ≤ 1), + ∀ (hqj1 : q.time j1 ≤ 1), + let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩; + let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩; + let c : Real := min (phi α : Real) (β : Real); + ∀ (hcpos : 0 < c), + ∀ (hc_le_one : c ≤ 1), + let r1 : Set.Icc (0 : Real) 1 := + ⟨c / 3, ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + let r2 : Set.Icc (0 : Real) 1 := + ⟨2 * c / 3, + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + let xL : Set.Icc (0 : Real) 1 := phi.symm r1 + let xR : Set.Icc (0 : Real) 1 := phi.symm r2 + ∀ (Bg : ℝ × ℝ), + Bg ≠ (0 : ℝ × ℝ) → + (∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), + p.time i0.castSucc < (↑t : ℝ) → + (↑t : ℝ) < p.time i0.succ → P3934T1LocalSide U₁ (g t) Bg e) → + ∀ (Bh : ℝ × ℝ), + (∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), + q.time j0.castSucc < (↑t : ℝ) → + (↑t : ℝ) < q.time j0.succ → P3934T1LocalSide U₂ (h t) Bh d) → + let scale : Real := + ((xR : Real) - (xL : Real)) / ((r2 : Real) - (r1 : Real)) + 0 < scale → + Bh = scale • Bg → + let z : Real × Real := g xL + P3934T1LocalSide U₁ z Bg e → + P3934T1LocalSide U₂ z Bh d → + (U₁ = U₂ → e = d) ∧ (Disjoint U₁ U₂ → e ≠ d) := by classical intro S e d U₁ U₂ g h p q hgrange hps hhrange hqs gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he hgfun_cont hhfun_cont GH HH phi i0 j0 i1 j1 hpi hqj hpi1 hqj1 α β c hcpos - hc_le_b hc_le_one r1 r2 xL xR Bg hBg hgside Bh hhside scale hscale_pos hscale z hlocG hlocH + hc_le_one r1 r2 xL xR Bg hBg hgside Bh hhside scale hscale_pos hscale z hlocG hlocH rcases hlocG with ⟨r, hr, hEqU⟩ rcases hlocH with ⟨s, hs, hEqV⟩ let v : Real × Real := (-Bg.2, Bg.1) @@ -1301,7 +1326,7 @@ private theorem compareCore : exact hh have localResult := ArcComparisonGeometry.localResult S e d U₁ U₂ g h p q hgrange hps hhrange hqs hgfun_inj - hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hpi hqj hpi1 hqj1 hcpos hc_le_b + hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hpi hqj hpi1 hqj1 hcpos hc_le_one Bg hBg hgside Bh hhside hscale_pos hscale hlocG hlocH exact localResult diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean b/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean index 7bfadd8eb3..891f7ad7b5 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean @@ -1758,11 +1758,14 @@ private theorem hdist : ring private theorem hball : - ∀ (x : Real × Real), ∀ (r : Real), (∀ (w : Real × Real), (‖w‖ = 1) → (∀ (t : Real), (0 < t) → - (dist (x + t • w) x = t))) → (∀ (w : Real × Real), (‖w‖ = 1) → (∀ (t : Real), (0 < t) → - ((t < r) → (Metric.ball (x + t • w) (r - t) ⊆ Metric.ball x r)))) := by - classical - intro x r hdist w hw t ht htr + ∀ (x : Real × Real), + ∀ (r : Real), + (∀ (w : Real × Real), ‖w‖ = 1 → ∀ (t : Real), 0 < t → dist (x + t • w) x = t) → + ∀ (w : Real × Real), + ‖w‖ = 1 → + ∀ (t : Real), 0 < t → Metric.ball (x + t • w) (r - t) ⊆ Metric.ball x r := by + classical + intro x r hdist w hw t ht apply Metric.ball_subset_ball' rw [hdist w hw t ht] exact le_of_eq (sub_add_cancel r t) @@ -2260,16 +2263,27 @@ private theorem nondegenerateContinuation : · simpa [haEq] using hRa private theorem oppositeContinuation : - ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), (0 < r) → ((‖u‖ - = 1) → ((‖v‖ = 1) → ((u ≠ v) → (∀ (E : P3889T1TwoRaySectorDecomposition x r u v), - (u ≠ ((0 : ℝ), (0 : ℝ))) → ((u.1 ≠ (0 : ℝ) ∨ u.2 ≠ (0 : ℝ)) → ((v = -u) → (∃ e : Bool, ∀ t : - Real, 0 < t → t < r → - P3934T1LocalSide E.left (x + t • u) (-u) e ∧ - P3934T1LocalSide E.left (x + t • v) v e ∧ - P3934T1LocalSide E.right (x + t • u) (-u) (!e) ∧ - P3934T1LocalSide E.right (x + t • v) v (!e)))))))) := by - classical - intro x r u v hr hu hv huv E hu_ne hcoord hvneg + ∀ (x : Real × Real), + ∀ (r : Real), + ∀ (u : Real × Real), + ∀ (v : Real × Real), + 0 < r → + ‖u‖ = 1 → + ‖v‖ = 1 → + ∀ (E : P3889T1TwoRaySectorDecomposition x r u v), + u ≠ ((0 : ℝ), (0 : ℝ)) → + u.1 ≠ (0 : ℝ) ∨ u.2 ≠ (0 : ℝ) → + v = -u → + ∃ e : Bool, + ∀ t : Real, + 0 < t → + t < r → + P3934T1LocalSide E.left (x + t • u) (-u) e ∧ + P3934T1LocalSide E.left (x + t • v) v e ∧ + P3934T1LocalSide E.right (x + t • u) (-u) !e ∧ + P3934T1LocalSide E.right (x + t • v) v !e := by + classical + intro x r u v hr hu hv E hu_ne hcoord hvneg let det : (Real × Real) → (Real × Real) → Real := fun a b => a.1 * b.2 - a.2 * b.1 let A : (Real × Real) → Real := fun p => det u (p - x) @@ -2285,7 +2299,7 @@ private theorem oppositeContinuation : exact sub_pos.mpr htr have hball (w : Real × Real) (hw : ‖w‖ = 1) (t : Real) (ht : 0 < t) (htr : t < r) := SectorContinuationFacts.hball x r - hdist w hw t ht htr + hdist w hw t ht have hlocalP (w : Real × Real) (hw : w = u ∨ w = v) (hwNorm : ‖w‖ = 1) (t : Real) (ht : 0 < t) (htr : t < r) : P3934T1LocalSide P (x + t • w) (-u) false := SectorContinuationGeometry.hlocalP x r u v @@ -2436,7 +2450,7 @@ theorem P3934T1SectorContinuation (x : Real × Real) (r : Real) P3934T1LocalSide E.left (x + t • v) v e ∧ P3934T1LocalSide E.right (x + t • u) (-u) (!e) ∧ P3934T1LocalSide E.right (x + t • v) v (!e) := - SectorContinuationCases.oppositeContinuation x r u v hr hu hv huv E hu_ne hcoord hvneg + SectorContinuationCases.oppositeContinuation x r u v hr hu hv E hu_ne hcoord hvneg exact hdet_cases.elim nondegenerateContinuation oppositeContinuation end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean index 4714d5e5e9..db5e1b3afa 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean @@ -209,10 +209,9 @@ private theorem hExteriorPair : · intro h; exact no32 ⟨hu3, h⟩ private theorem adjNe : - (List GaussianInt) → (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, FourNeighborAdjacent a b → a - ≠ b) := by + ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, FourNeighborAdjacent a b → a ≠ b := by classical - intro p a b hab heq + intro a b hab heq subst b rcases hab with h | h | h | h · have hr := congrArg Zsqrtd.re h @@ -1027,12 +1026,18 @@ private theorem hNeqAt1093 : simpa [I, c0, c1, c1add] using h private theorem verticalSupport : - (List GaussianInt) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : - GaussianInt), (({a, b} : Finset GaussianInt) = {c, d}) → ((c ≠ d) → ((a = c ∧ b = d) ∨ (a - = d ∧ b = c)))) → (∀ (T : ProtoTile), ∀ (q : GaussianInt), {q, q + ⟨(0 : ℤ), (1 : ℤ)⟩} ∈ - FootprintEdges T → q ∈ T.cells ∨ q - (1 : GaussianInt) ∈ T.cells)) := by + (∀ (a : GaussianInt), + ∀ (b : GaussianInt), + ∀ (c : GaussianInt), + ∀ (d : GaussianInt), + ({ a, b } : Finset GaussianInt) = { c, d } → + c ≠ d → a = c ∧ b = d ∨ a = d ∧ b = c) → + ∀ (T : ProtoTile), + ∀ (q : GaussianInt), + {q, q + ⟨(0 : ℤ), (1 : ℤ)⟩} ∈ FootprintEdges T → + q ∈ T.cells ∨ q - (1 : GaussianInt) ∈ T.cells := by classical - intro p pairCases T q h + intro pairCases T q h rw [FootprintEdges] at h simp only [Set.mem_ofPred_eq] at h rcases h with ⟨z, hz, hshape⟩ @@ -1076,12 +1081,18 @@ private theorem verticalSupport : simp at hr₁ hr₂; omega private theorem horizontalSupport : - (List GaussianInt) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : - GaussianInt), (({a, b} : Finset GaussianInt) = {c, d}) → ((c ≠ d) → ((a = c ∧ b = d) ∨ (a - = d ∧ b = c)))) → (∀ (T : ProtoTile), ∀ (q : GaussianInt), {q, q + (1 : GaussianInt)} ∈ - FootprintEdges T → q ∈ T.cells ∨ q - ⟨(0 : ℤ), (1 : ℤ)⟩ ∈ T.cells)) := by + (∀ (a : GaussianInt), + ∀ (b : GaussianInt), + ∀ (c : GaussianInt), + ∀ (d : GaussianInt), + ({ a, b } : Finset GaussianInt) = { c, d } → + c ≠ d → a = c ∧ b = d ∨ a = d ∧ b = c) → + ∀ (T : ProtoTile), + ∀ (q : GaussianInt), + {q, q + (1 : GaussianInt)} ∈ FootprintEdges T → + q ∈ T.cells ∨ q - ⟨(0 : ℤ), (1 : ℤ)⟩ ∈ T.cells := by classical - intro p pairCases T q h + intro pairCases T q h rw [FootprintEdges] at h simp only [Set.mem_ofPred_eq] at h rcases h with ⟨z, hz, hshape⟩ @@ -1565,16 +1576,16 @@ private def directionOffset : Fin 4 → GaussianInt := ![⟨0, 1⟩, 1, -⟨0, 1⟩, -1] private theorem dirInj : - ∀ (x : GaussianInt), (List GaussianInt) → ( - let dir : Fin 4 → GaussianInt := fun i => - match i.val with - | 0 => x + ⟨0, 1⟩ - | 1 => x + 1 - | 2 => x - ⟨0, 1⟩ - | _ => x - 1 - Function.Injective dir) := by + ∀ (x : GaussianInt), + let dir : Fin 4 → GaussianInt := fun i => + match i.val with + | 0 => x + ⟨0, 1⟩ + | 1 => x + 1 + | 2 => x - ⟨0, 1⟩ + | _ => x - 1 + Function.Injective dir := by classical - intro x p dir + intro x dir have hdir : dir = fun j => x + directionOffset j := by funext j fin_cases j @@ -1593,16 +1604,16 @@ private theorem dirInj : exact hinjective (add_left_cancel hij) private theorem dirNeX : - ∀ (x : GaussianInt), (List GaussianInt) → ( - let dir : Fin 4 → GaussianInt := fun i => - match i.val with - | 0 => x + ⟨0, 1⟩ - | 1 => x + 1 - | 2 => x - ⟨0, 1⟩ - | _ => x - 1 - ∀ (i : Fin (4 : ℕ)), x ≠ dir i) := by + ∀ (x : GaussianInt), + let dir : Fin 4 → GaussianInt := fun i => + match i.val with + | 0 => x + ⟨0, 1⟩ + | 1 => x + 1 + | 2 => x - ⟨0, 1⟩ + | _ => x - 1 + ∀ (i : Fin (4 : ℕ)), x ≠ dir i := by classical - intro x p dir + intro x dir have hdir : dir = fun j => x + directionOffset j := by funext j fin_cases j @@ -1985,7 +1996,7 @@ theorem P3963T1ExteriorMixedCycleObstruction have cyclicPair (a b : GaussianInt) (hab : ({a, b} : Finset GaussianInt) ∈ F) : (a, b) ∈ (p.zip p.tail) ++ [(v, u)] ∨ (b, a) ∈ (p.zip p.tail) ++ [(v, u)] := ExteriorMixedCycleProof.cyclicPair F p u v hhead - hlast hclose hsteps hedges hcross hcycleEdge (ExteriorMixedCycleProof.adjNe p) + hlast hclose hsteps hedges hcross hcycleEdge (ExteriorMixedCycleProof.adjNe) pairCases (ExteriorMixedCycleProof.adjacentMemZip) a b hab have hpne : p ≠ [] := ExteriorIndexCases.hpne p hlen have huMem : u ∈ p := ExteriorIndexCases.huMem p u hhead @@ -2006,8 +2017,8 @@ theorem P3963T1ExteriorMixedCycleObstruction let eDir : Fin 4 := 1 let sDir : Fin 4 := 2 let wDir : Fin 4 := 3 - have dirInj : Function.Injective dir := ExteriorIndexCases.dirInj x p - have dirNeX (i : Fin 4) : x ≠ dir i := ExteriorIndexCases.dirNeX x p i + have dirInj : Function.Injective dir := ExteriorIndexCases.dirInj x + have dirNeX (i : Fin 4) : x ≠ dir i := ExteriorIndexCases.dirNeX x i have noThreeDir (i j k : Fin 4) (hij : i ≠ j) (hik : i ≠ k) (hjk : j ≠ k) (ha : ({x, dir i} : Finset GaussianInt) ∈ F) @@ -2067,9 +2078,9 @@ theorem P3963T1ExteriorMixedCycleObstruction have walkConstExterior := (ExteriorCycleDetails.walkConst) ((↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ) I (ExteriorCycleDetails.indexAdjacentExterior U V F p u v cyclicToEdge crossEastEq crossNorthEq (ExteriorMixedCycleProof.verticalNoF U V F - hsubset exteriorNoTile (ExteriorMixedCycleProof.verticalSupport p pairCases)) + hsubset exteriorNoTile (ExteriorMixedCycleProof.verticalSupport pairCases)) (ExteriorMixedCycleProof.horizontalNoF U V F hsubset exteriorNoTile - (ExteriorMixedCycleProof.horizontalSupport p pairCases))) + (ExteriorMixedCycleProof.horizontalSupport pairCases))) rcases hindexDiff with ⟨⟨ha, hb⟩, hd⟩ | ⟨⟨ha, hb⟩, hd⟩ · rcases houtside.2 c1 ha c3 hb with ⟨walk, hh, hl, hv, hs⟩ have hsame := walkConstExterior walk c1 c3 hh hl hv hs diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean index 3419e82f85..88add13604 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean @@ -187,25 +187,30 @@ private theorem parityStep : rw [hneg] private theorem hpNotTwo : - ∀ (V₁ : Set GaussianInt), ∀ (E₁ : Set (Finset GaussianInt)), ∀ (E₂ : Set (Finset - GaussianInt)), (Disjoint E₁ E₂) → (∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), - ∀ (x : GaussianInt), (GaussianInt) → ( - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) - ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) - let prefix₂ := c₂.tail.takeWhile good - let prefix₁ := c₁.tail.takeWhile good₁ - let Q := x :: (prefix₂ ++ [z]) - (Q.IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₂)) → ((R.IsChain (fun u v => ({u, v} - : Finset GaussianInt) ∈ E₁)) → ( - let p := Q ++ prefix₁ - p.length ≠ 2))))) := by - classical - intro V₁ E₁ E₂ hdisjoint p₁ p₂ x y c₂ good z c₁ good₁ w R prefix₂ prefix₁ Q hQedge hRedge p hlen + ∀ (V₁ : Set GaussianInt), + ∀ (E₁ : Set (Finset GaussianInt)), + ∀ (E₂ : Set (Finset GaussianInt)), + Disjoint E₁ E₂ → + ∀ (p₁ : List GaussianInt), + ∀ (p₂ : List GaussianInt), + ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x) + let good (z : GaussianInt) : Bool := + @decide (z ∉ V₁) (Classical.propDecidable _) + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z) + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) + GaussianInt → + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + (Q.IsChain fun u v => ({ u, v } : Finset GaussianInt) ∈ E₂) → + (R.IsChain fun u v => ({ u, v } : Finset GaussianInt) ∈ E₁) → + let p := Q ++ prefix₁ + p.length ≠ 2 := by + classical + intro V₁ E₁ E₂ hdisjoint p₁ p₂ x c₂ good z c₁ good₁ w R prefix₂ prefix₁ Q hQedge hRedge p hlen have hlenparts : Q.length + prefix₁.length = 2 := by simpa [p, List.length_append] using hlen have hQlen : Q.length = prefix₂.length + 2 := by simp [Q] have hpref₂ : prefix₂ = [] := by @@ -389,12 +394,11 @@ private theorem hrot₂x : exact List.getElem?_idxOf hx₂ private theorem cycle_chain : - ∀ (p : List GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (p.head? = some a) → - ((p.getLast? = some b) → ((FourNeighborAdjacent b a) → ((∀ u, ∀ v, ∀ l₁, ∀ l₂, p = l₁ ++ - u :: v :: - l₂ → FourNeighborAdjacent u v) → (p.IsChain FourNeighborAdjacent)))) := by + ∀ (p : List GaussianInt), + (∀ u, ∀ v, ∀ l₁, ∀ l₂, p = l₁ ++ u :: v :: l₂ → FourNeighborAdjacent u v) → + p.IsChain FourNeighborAdjacent := by classical - intro p a b hh ht hc hadj + intro p hadj rw [List.isChain_iff_forall_rel_of_append_cons_cons] intro u v l₁ l₂ heq exact hadj u v l₁ l₂ heq @@ -550,14 +554,15 @@ private theorem hwx : simpa [good₁] using hwgood private theorem hRlast : - ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) - R.getLast? = some x) := by - classical - intro p₁ x z c₁ good₁ w R + ∀ (p₁ : List GaussianInt), + ∀ (x : GaussianInt), + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + R.getLast? = some x := by + classical + intro p₁ x z c₁ good₁ R apply List.getLast?_eq_some_iff.mpr refine ⟨z :: c₁.tail.takeWhile good₁, ?_⟩ simp [R] @@ -741,18 +746,24 @@ private theorem hdecomp₁' : _ = prefix₁ ++ x :: ws := by simp [prefix₁, hrest₁, hwx] private theorem hRedgePrefix : - ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), (∀ {α : Type}, ∀ (a : α), ∀ (b : α), ∀ (u : - List α), ∀ (v : List α), a :: (u ++ [b]) = List.take (u.length + 2) (a :: (u ++ b :: v))) - → (∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → (∀ (ws : List GaussianInt), - let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) - let prefix₁ := c₁.tail.takeWhile good₁ - (c₁.tail = prefix₁ ++ x :: ws) → (R = List.take (prefix₁.length + 2) (z :: (c₁.tail ++ - [z]))))) := by - classical - intro p₁ x takeArc z c₁ good₁ w ws R prefix₁ hdecomp₁' + ∀ (p₁ : List GaussianInt), + ∀ (x : GaussianInt), + (∀ {α : Type}, + ∀ (a : α), + ∀ (b : α), + ∀ (u : List α), + ∀ (v : List α), + a :: (u ++ [b]) = List.take (u.length + 2) (a :: (u ++ b :: v))) → + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + ∀ (ws : List GaussianInt), + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + let prefix₁ := c₁.tail.takeWhile good₁ + c₁.tail = prefix₁ ++ x :: ws → + R = List.take (prefix₁.length + 2) (z :: (c₁.tail ++ [z])) := by + classical + intro p₁ x takeArc z c₁ good₁ ws R prefix₁ hdecomp₁' calc R = z :: (prefix₁ ++ [x]) := rfl _ = List.take (prefix₁.length + 2) @@ -840,18 +851,24 @@ private theorem hQchain : exact hc₂chain.take _ private theorem hRprefix : - ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), (∀ {α : Type}, ∀ (a : α), ∀ (b : α), ∀ (u : - List α), ∀ (v : List α), a :: (u ++ [b]) = List.take (u.length + 2) (a :: (u ++ b :: v))) - → (∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - (c₁ = z :: c₁.tail) → ( - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → (∀ (ws : List GaussianInt), - let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) - let prefix₁ := c₁.tail.takeWhile good₁ - (c₁.tail = prefix₁ ++ x :: ws) → (R = c₁.take (prefix₁.length + 2))))) := by + ∀ (p₁ : List GaussianInt), + ∀ (x : GaussianInt), + (∀ {α : Type}, + ∀ (a : α), + ∀ (b : α), + ∀ (u : List α), + ∀ (v : List α), + a :: (u ++ [b]) = List.take (u.length + 2) (a :: (u ++ b :: v))) → + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z); + c₁ = z :: c₁.tail → + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + ∀ (ws : List GaussianInt), + let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) + let prefix₁ := c₁.tail.takeWhile good₁ + c₁.tail = prefix₁ ++ x :: ws → R = c₁.take (prefix₁.length + 2) := by classical - intro p₁ x takeArc z c₁ hc₁shape good₁ w ws R prefix₁ hdecomp₁' + intro p₁ x takeArc z c₁ hc₁shape good₁ ws R prefix₁ hdecomp₁' rw [show R = z :: (prefix₁ ++ [x]) by rfl, hc₁shape, hdecomp₁'] exact takeArc z x prefix₁ ws @@ -884,15 +901,17 @@ private theorem hQnodup : exact (List.take_sublist _ c₂).nodup hc₂nodup private theorem hznotprefix₁ : - ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - (c₁.head? = some z) → ((c₁.Nodup) → ( - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₁ := c₁.tail.takeWhile good₁ - z ∉ prefix₁))) := by + ∀ (p₁ : List GaussianInt), + ∀ (x : GaussianInt), + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z); + c₁.head? = some z → + c₁.Nodup → + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + let prefix₁ := c₁.tail.takeWhile good₁ + z ∉ prefix₁ := by classical - intro p₁ x z c₁ hrot₁z hc₁nodup good₁ w prefix₁ hzpre + intro p₁ x z c₁ hrot₁z hc₁nodup good₁ prefix₁ hzpre have hztail : z ∈ c₁.tail := List.takeWhile_subset good₁ hzpre have hhead : c₁.head? = some z := by simpa [c₁] using hrot₁z obtain ⟨tl, hshape⟩ := (List.head?_eq_some_iff).mp hhead @@ -1196,25 +1215,27 @@ private theorem hE₂ : MixedCycleDetails.hE₂At785 V₁ E₂ p₂ x z hQedge c cs hpref₂ private theorem hFf : - ∀ (V₁ : Set GaussianInt), ∀ (p₁ : List GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : - GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) - ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - let good₁ (w : GaussianInt) : Bool := decide (w ≠ x) - (GaussianInt) → ( - let prefix₂ := c₂.tail.takeWhile good - let prefix₁ := c₁.tail.takeWhile good₁ - let Q := x :: (prefix₂ ++ [z]) - let p := Q ++ prefix₁ - ∀ (hpne : p ≠ []), - let v := p.getLast hpne - let F : Set (Finset GaussianInt) := {e | e = {v, x} ∨ - ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}} - ({x, prefix₂.headD z} : Finset GaussianInt) ∈ F) := by + ∀ (V₁ : Set GaussianInt), + ∀ (p₁ : List GaussianInt), + ∀ (p₂ : List GaussianInt), + ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x); + let good (z : GaussianInt) : Bool := + @decide (z ∉ V₁) (Classical.propDecidable _); + ∀ (z : GaussianInt), + let c₁ := p₁.rotate (p₁.idxOf z); + let good₁ (w : GaussianInt) : Bool := decide (w ≠ x); + let prefix₂ := c₂.tail.takeWhile good + let prefix₁ := c₁.tail.takeWhile good₁ + let Q := x :: (prefix₂ ++ [z]) + let p := Q ++ prefix₁ + ∀ (hpne : p ≠ []), + let v := p.getLast hpne + let F : Set (Finset GaussianInt) := + {e | e = { v, x } ∨ ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ e = { a, b }} + ({x, prefix₂.headD z} : Finset GaussianInt) ∈ F := by classical - intro V₁ p₁ p₂ x c₂ good z c₁ good₁ w prefix₂ prefix₁ Q p hpne v F + intro V₁ p₁ p₂ x c₂ good z c₁ good₁ prefix₂ prefix₁ Q p hpne v F cases hpref₂ : prefix₂ with | nil => simpa only [List.headD] using @@ -1258,7 +1279,7 @@ theorem P3963T1MixedBoundaryCycle (hh : p.head? = some a) (ht : p.getLast? = some b) (hc : FourNeighborAdjacent b a) (hadj : ∀ u v l₁ l₂, p = l₁ ++ u :: v :: l₂ → FourNeighborAdjacent u v) := - MixedCycleDetails.cycle_chain p a b hh ht hc hadj + MixedCycleDetails.cycle_chain p hadj have rotate_chain (p : List GaussianInt) (k : Nat) (a b : GaussianInt) (hh : p.head? = some a) (ht : p.getLast? = some b) (hc : FourNeighborAdjacent b a) @@ -1317,7 +1338,7 @@ theorem P3963T1MixedBoundaryCycle have hxR : x ∈ (z :: (c₁.tail.takeWhile good₁ ++ [x])).toFinset := by simp let R := z :: (c₁.tail.takeWhile good₁ ++ [x]) have hRhead : R.head? = some z := by simp [R] - have hRlast := MixedCycleDetails.hRlast p₁ x z w + have hRlast := MixedCycleDetails.hRlast p₁ x z let prefix₂ := c₂.tail.takeWhile good have hc₂shape := MixedCycleDetails.hc₂shape p₂ x hrot₂x have hdecomp₂' := MixedCycleDetails.hdecomp₂' V₁ p₂ x z zs @@ -1343,7 +1364,7 @@ theorem P3963T1MixedBoundaryCycle have hQedge := MixedCycleDetails.hQedge V₁ E₂ p₂ x z hc₂edgeChain hQedgePrefix have hdecomp₁' := MixedCycleDetails.hdecomp₁' p₁ x z w ws hrest₁ hwx hdecomp₁ - have hRedgePrefix := MixedCycleDetails.hRedgePrefix p₁ x takeArc z w ws hdecomp₁' + have hRedgePrefix := MixedCycleDetails.hRedgePrefix p₁ x takeArc z ws hdecomp₁' have hRedge : R.IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁) := MixedCycleDetails.hRedge E₁ p₁ x z hc₁edgeChain hRedgePrefix have hRtailE₁ : R.tail.IsChain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁) := by @@ -1361,7 +1382,7 @@ theorem P3963T1MixedBoundaryCycle have hQchain := MixedCycleDetails.hQchain V₁ p₂ x hc₂chain z hQprefix have hRprefix := MixedCycleDetails.hRprefix p₁ x takeArc z - hc₁shape w ws hdecomp₁' + hc₁shape ws hdecomp₁' have hRchain := MixedCycleDetails.hRchain p₁ x z hc₁chain hRprefix have hQnodup := MixedCycleDetails.hQnodup V₁ p₂ x hc₂nodup z hQprefix @@ -1370,7 +1391,7 @@ theorem P3963T1MixedBoundaryCycle have hxnotprefix₁ : x ∉ prefix₁ := by intro hxpre simpa [good₁] using List.mem_takeWhile_imp hxpre - have hznotprefix₁ := MixedCycleDetails.hznotprefix₁ p₁ x z hrot₁z hc₁nodup w + have hznotprefix₁ := MixedCycleDetails.hznotprefix₁ p₁ x z hrot₁z hc₁nodup have hcross : ∀ v ∈ Q, ∀ w ∈ prefix₁, v ≠ w := MixedBoundaryCycleProof.hcross V₁ V₂ E₁ E₂ p₁ hV₁ p₂ x y hx hxy hx₁ hx₂ hidx₁x hidx₂x hrot₁x hrot₂x hc₂chain hc₂y hc₂nodup hc₂tail hrest₂ne z zs hrest₂ hzV₁ hdecomp₂ hzTail hxNotTail hzx hq2head hidx₁z hrot₁z hc₁shape hc₁x @@ -1408,7 +1429,7 @@ theorem P3963T1MixedBoundaryCycle parity w = parity u + 1 := MixedBoundaryCycleProof.parityStep (u := u) (w := w) h have hadjP := MixedCycleDetails.hadjP V₁ p₁ p₂ x z hpChain have hpLenTwo : 2 ≤ p.length := MixedCycleDetails.hpLenTwo V₁ p₁ p₂ x z - have hpNotTwo : p.length ≠ 2 := MixedBoundaryCycleProof.hpNotTwo V₁ E₁ E₂ hdisjoint p₁ p₂ x y z + have hpNotTwo : p.length ≠ 2 := MixedBoundaryCycleProof.hpNotTwo V₁ E₁ E₂ hdisjoint p₁ p₂ x z w hQedge hRedge have hpNotThree : p.length ≠ 3 := MixedBoundaryCycleProof.hpNotThree V₁ p₁ p₂ x z w hpne hcloseP hphead parityStep hadjP @@ -1428,7 +1449,7 @@ theorem P3963T1MixedBoundaryCycle have hE₂ : ({x, prefix₂.headD z} : Finset GaussianInt) ∈ E₂ := MixedClosingEdges.hE₂ V₁ E₂ p₂ x z hQedge have hFf : ({x, prefix₂.headD z} : Finset GaussianInt) ∈ F := MixedClosingEdges.hFf V₁ p₁ p₂ x - z w hpne + z hpne exact ⟨W, F, x, {v, x}, {x, prefix₂.headD z}, hsimple, hFsubset, by simp, by simp, ⟨hwrapF, hlastE₁⟩, ⟨hFf, hE₂⟩⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean index 64b7146b0e..9192217ea3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean @@ -810,10 +810,9 @@ private theorem notEven1 : (by classical exact - (Fin (4 : ℕ) → CircleCoordinates) → ((Fin (3 : ℕ)) → ((Fin (4 : ℕ)) → (¬ Even (1 : - Nat)))) ) := by + ¬Even (1 : Nat) + ) := by classical - intro r i s rintro ⟨n, hn⟩ omega @@ -821,10 +820,9 @@ private theorem notEven3 : (by classical exact - (Fin (4 : ℕ) → CircleCoordinates) → ((Fin (3 : ℕ)) → ((Fin (4 : ℕ)) → (¬ Even (3 : - Nat)))) ) := by + ¬Even (3 : Nat) + ) := by classical - intro r i s rintro ⟨n, hn⟩ omega @@ -1295,8 +1293,8 @@ theorem P4055T1OrderedGeneralOppositeEndpoints : else BandVectors.1 (r 0) (r i.succ)) have even0 : Even (0 : Nat) := ⟨0, rfl⟩ have even2 : Even (2 : Nat) := ⟨1, by omega⟩ - have notEven1 := OppositeEndpointGeometry.notEven1 r i s - have notEven3 := OppositeEndpointGeometry.notEven3 r i s + have notEven1 := OppositeEndpointGeometry.notEven1 + have notEven3 := OppositeEndpointGeometry.notEven3 have hq3mul := OppositeEndpointGeometry.hq3mul hq3 have hdispR := OppositeEndpointGeometry.hdispR r i s hq2 hq3 hq2act even0 even2 notEven1 notEven3 hq3mul diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean index b39e749898..494af7aa7c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean @@ -351,10 +351,9 @@ private theorem notEvenOne : (by classical exact - (Fin 4 → CircleCoordinates) → ((Fin 3) → ((Fin 4) → ((Fin 3) → ((BandPackingSymmetry) → - (¬ Even 1))))) ) := by + ¬Even 1 + ) := by classical - intro r i s a g' rintro ⟨n, hn⟩ omega @@ -362,10 +361,9 @@ private theorem notEvenThree : (by classical exact - (Fin 4 → CircleCoordinates) → ((Fin 3) → ((Fin 4) → ((Fin 3) → ((BandPackingSymmetry) → - (¬ Even 3))))) ) := by + ¬Even 3 + ) := by classical - intro r i s a g' rintro ⟨n, hn⟩ omega @@ -2026,8 +2024,8 @@ theorem P4055T1PlacementNormalization hphaseBackward hk have evenZero : Even 0 := ⟨0, by decide⟩ have evenTwo : Even 2 := ⟨1, by decide⟩ - have notEvenOne := PlacementNormalizationProof.notEvenOne r i s a g' - have notEvenThree := PlacementNormalizationProof.notEvenThree r i s a g' + have notEvenOne := PlacementNormalizationProof.notEvenOne + have notEvenThree := PlacementNormalizationProof.notEvenThree have hnegVal (s₀ : Fin 4) := PlacementNormalizationProof.hnegVal s₀ let ii : GaussianInt := ⟨0, 1⟩ have iiSq : ii ^ 2 = -1 := by decide +kernel diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean index 51bcdf5b59..5de6eed47a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean @@ -46,10 +46,12 @@ private theorem hpos₁ : (by classical exact - ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (FordFareyParameter) → (((2 : ℕ) - < P.q) → ((P₁.q = P.q₁) → ((P.q = P.q₁ + P.q₂) → (0 < P.q₁)))) ) := by + ∀ (P : FordFareyParameter), + ∀ (P₁ : FordFareyParameter), + (2 : ℕ) < P.q → P₁.q = P.q₁ → P.q = P.q₁ + P.q₂ → 0 < P.q₁ + ) := by classical - intro P P₁ P₂ hP hq₁ hsum + intro P P₁ hP hq₁ hsum by_contra hn have hz : P.q₁ = 0 := by omega have hd : (P.q : Int) ∣ (1 : Int) := by @@ -188,11 +190,13 @@ private theorem hdetdiffAt260 : (by classical exact - ∀ (P : FordFareyParameter), (FordFareyParameter) → ((FordFareyParameter) → ((P.p₁ * (P.q₂ - : Int) - P.p₂ * (P.q₁ : Int) = 1) → ((P.q₂ < P.q₁) → ((P.p₁-P.p₂) * (P.q₁ : Int) - - ((P.q₁-P.q₂ : Nat) : Int) * P.p₁ = 1)))) ) := by + ∀ (P : FordFareyParameter), + P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1 → + P.q₂ < P.q₁ → + (P.p₁ - P.p₂) * (P.q₁ : Int) - ((P.q₁ - P.q₂ : Nat) : Int) * P.p₁ = 1 + ) := by classical - intro P P₁ P₂ hcrossdet horder + intro P hcrossdet horder rw [Nat.cast_sub (by omega : P.q₂ ≤ P.q₁)] nlinarith only [hcrossdet] @@ -200,11 +204,12 @@ private theorem hcopAt264 : (by classical exact - ∀ (P : FordFareyParameter), (FordFareyParameter) → ((FordFareyParameter) → ((P.p₁ * (P.q₂ - : Int) - P.p₂ * (P.q₁ : Int) = 1) → ((P.q₂ < P.q₁) → (Nat.Coprime (P.q₁-P.q₂) - (P.p₁-P.p₂).natAbs)))) ) := by + ∀ (P : FordFareyParameter), + P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1 → + P.q₂ < P.q₁ → Nat.Coprime (P.q₁ - P.q₂) (P.p₁ - P.p₂).natAbs + ) := by classical - intro P P₁ P₂ hcrossdet horder + intro P hcrossdet horder have hc : IsCoprime ((P.q₁-P.q₂ : Nat) : Int) (P.p₁-P.p₂) := by have hx : (P.p₁-P.p₂) * (P.q₂ : Int) - P.p₂ * ((P.q₁-P.q₂ : Nat) : Int) = 1 := by @@ -276,20 +281,24 @@ private theorem hcoordsAt312 : (by classical exact - ∀ (P : FordFareyParameter), (FordFareyParameter) → ((FordFareyParameter) → (((2 : ℕ) < - P.q) → ((∀ (q : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ - x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → ((P.q = P.q₁ + P.q₂) → - ((P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1) → ((0 < P.q₁) → ((0 < P.q₂) → (∀ (hr - : Fin (4 : ℕ) → Finset GaussianInt), (hr 0 = P4062T1InteriorSquare P.q₁) → ((hr 1 = - (P4062T1InteriorSquare P.q₁).image (fun y => y+⟨(P.q₂ : Int),(P.q₂ : Int)⟩)) → - ((P.q₂ < P.q₁) → ((P.q₁ - P.q₂ < P.q) → (((P.p₁-P.p₂) * (P.q₁ : Int) - ((P.q₁-P.q₂ : - Nat) : Int) * P.p₁ = 1) → (∀ (H : FordFareyParameter), (H.q = P.q₁ - P.q₂) → - ((Nat.Coprime P.q₁ P.p₁.natAbs) → ((FordFareyParameter) → (∀ x ∈ hr (0 : Fin (4 : ℕ)) - ∩ hr (1 : Fin (4 : ℕ)), (↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q₁ : ℤ) - (1 : ℤ) ∧ - (↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₁ : ℤ) - (1 : ℤ))))))))))))))))) ) := by + ∀ (P : FordFareyParameter), + (∀ (q : Nat), + ∀ (x : GaussianInt), + x ∈ P4062T1InteriorSquare q ↔ + 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → + ∀ (hr : Fin (4 : ℕ) → Finset GaussianInt), + hr 0 = P4062T1InteriorSquare P.q₁ → + (hr 1 = + (P4062T1InteriorSquare P.q₁).image fun y => + y + ⟨(P.q₂ : Int), (P.q₂ : Int)⟩) → + FordFareyParameter → + ∀ x ∈ hr (0 : Fin (4 : ℕ)) ∩ hr (1 : Fin (4 : ℕ)), + (↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.re ∧ + x.re ≤ (↑P.q₁ : ℤ) - (1 : ℤ) ∧ + (↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₁ : ℤ) - (1 : ℤ) + ) := by classical - intro P P₁ P₂ hP squareCoordinates hsum hcrossdet hpos₁ hpos₂ hr hA0 hA1 horder hdlt hdetdiff H - hHq hredParent R x hx + intro P squareCoordinates hr hA0 hA1 H x hx rcases Finset.mem_inter.mp hx with ⟨h0,h1⟩ rw [hA0] at h0 have b0 := (squareCoordinates P.q₁ x).mp h0 @@ -307,8 +316,9 @@ private theorem htargetAt327 : (by classical exact - ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (FordFareyParameter) → (((2 : ℕ) - < P.q) → ((P₁.q = P.q₁) → (∀ (hsum : P.q = P.q₁ + P.q₂), ∀ (hcrossdet : P.p₁ * (P.q₂ + ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), + ( + ((P₁.q = P.q₁) → (∀ (hsum : P.q = P.q₁ + P.q₂), ∀ (hcrossdet : P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1), ∀ (hpos₁ : 0 < P.q₁), ∀ (hpos₂ : 0 < P.q₂), (∀ x, x ∈ FordRecursiveVertexDomains P 0 → FordOdometer P x = FordOdometer P₁ x) → ((∀ x, x ∈ @@ -355,9 +365,8 @@ private theorem htargetAt327 : FourNeighborLaplacian (FordOdometer H) (x-⟨(P.q₂ : Int), (P.q₂ : Int)⟩)))))))))))))))) := by classical - intro P P₁ P₂ hP hq₁ hsum hcrossdet hpos₁ hpos₂ hrec₀' hrec₁' hlapAffine hrec0Member - hrec1Member hr horder hdlt hdetdiff H hHq hredParent Q R hR hpar hparP hch₀' hch₁' hcoords - x hx + intro P P₁ hq₁ hsum hcrossdet hpos₁ hpos₂ hrec₀' hrec₁' hlapAffine hrec0Member hrec1Member hr + horder hdlt hdetdiff H hHq hredParent Q R hR hpar hparP hch₀' hch₁' hcoords x hx have hb := hcoords x hx have hpt (z : GaussianInt) (hzr : (P.q₂ : Int) ≤ z.re) (hzr' : z.re ≤ (P.q₁ : Int)) (hzi : (P.q₂ : Int) ≤ z.im) @@ -457,11 +466,13 @@ private theorem hdetdiffAt465 : (by classical exact - ∀ (P : FordFareyParameter), (FordFareyParameter) → ((FordFareyParameter) → ((P.p₁ * (P.q₂ - : Int) - P.p₂ * (P.q₁ : Int) = 1) → ((P.q₁ < P.q₂) → ((P.p₂-P.p₁) * (P.q₂ : Int) - - ((P.q₂-P.q₁ : Nat) : Int) * P.p₂ = -1)))) ) := by + ∀ (P : FordFareyParameter), + P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1 → + P.q₁ < P.q₂ → + (P.p₂ - P.p₁) * (P.q₂ : Int) - ((P.q₂ - P.q₁ : Nat) : Int) * P.p₂ = -1 + ) := by classical - intro P P₁ P₂ hcrossdet horder + intro P hcrossdet horder rw [Nat.cast_sub (by omega : P.q₁ ≤ P.q₂)] nlinarith only [hcrossdet] @@ -469,11 +480,12 @@ private theorem hcopAt469 : (by classical exact - ∀ (P : FordFareyParameter), (FordFareyParameter) → ((FordFareyParameter) → ((P.p₁ * (P.q₂ - : Int) - P.p₂ * (P.q₁ : Int) = 1) → ((P.q₁ < P.q₂) → (Nat.Coprime (P.q₂-P.q₁) - (P.p₂-P.p₁).natAbs)))) ) := by + ∀ (P : FordFareyParameter), + P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1 → + P.q₁ < P.q₂ → Nat.Coprime (P.q₂ - P.q₁) (P.p₂ - P.p₁).natAbs + ) := by classical - intro P P₁ P₂ hcrossdet horder + intro P hcrossdet horder have hc : IsCoprime ((P.q₂-P.q₁ : Nat) : Int) (P.p₂-P.p₁) := by have hx : P.p₁ * ((P.q₂-P.q₁ : Nat) : Int) - (P.q₁ : Int) * (P.p₂-P.p₁) = 1 := by @@ -531,18 +543,25 @@ private theorem hcoordsAt511 : (by classical exact - ∀ (P : FordFareyParameter), (FordFareyParameter) → (∀ (P₂ : FordFareyParameter), (∀ (q : - Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : - Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → (∀ (hr : Fin (4 : ℕ) → Finset - GaussianInt), (hr 2 = (P4062T1InteriorSquare P.q₂).image (fun y => y+⟨(P.q₁ : - Int),0⟩)) → ((hr 3 = (P4062T1InteriorSquare P.q₂).image (fun y => y+⟨0,(P.q₁ : - Int)⟩)) → ((FordFareyParameter) → (∀ (R : FordFareyParameter), (R.p = P.p₂ ∧ R.q = - P.q₂) → ((P₂.p₁ = P.p₁ ∧ P₂.q₁ = P.q₁ ∧ P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁) → (∀ x - ∈ hr (2 : Fin (4 : ℕ)) ∩ hr (3 : Fin (4 : ℕ)), (↑P.q₁ : ℤ) + (1 : ℤ) ≤ x.re ∧ x.re ≤ - (↑P.q₂ : ℤ) - (1 : ℤ) ∧ (↑P.q₁ : ℤ) + (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₂ : ℤ) - (1 : - ℤ)))))))) ) := by + ∀ (P : FordFareyParameter), + FordFareyParameter → + (∀ (q : Nat), + ∀ (x : GaussianInt), + x ∈ P4062T1InteriorSquare q ↔ + 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → + ∀ (hr : Fin (4 : ℕ) → Finset GaussianInt), + (hr 2 = + (P4062T1InteriorSquare P.q₂).image fun y => y + ⟨(P.q₁ : Int), 0⟩) → + (hr 3 = + (P4062T1InteriorSquare P.q₂).image fun y => y + ⟨0, (P.q₁ : Int)⟩) → + FordFareyParameter → + ∀ x ∈ hr (2 : Fin (4 : ℕ)) ∩ hr (3 : Fin (4 : ℕ)), + (↑P.q₁ : ℤ) + (1 : ℤ) ≤ x.re ∧ + x.re ≤ (↑P.q₂ : ℤ) - (1 : ℤ) ∧ + (↑P.q₁ : ℤ) + (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₂ : ℤ) - (1 : ℤ) + ) := by classical - intro P P₁ P₂ squareCoordinates hr hA2 hA3 H R hR hpar x hx + intro P P₂ squareCoordinates hr hA2 hA3 R x hx rcases Finset.mem_inter.mp hx with ⟨h2,h3⟩ rw [hA2] at h2 rw [hA3] at h3 @@ -576,29 +595,67 @@ private theorem htargetAt542 : (by classical exact - ∀ (P : FordFareyParameter), (FordFareyParameter) → (∀ (P₂ : FordFareyParameter), (P₂.q = - P.q₂) → ((P.q = P.q₁ + P.q₂) → ((P.q₂ < P.q) → ((∀ x, x ∈ FordRecursiveVertexDomains - P 2 → FordOdometer P x = FordOdometer P₂ (x - ⟨(P.q₁ : Int), 0⟩) + P.p₁ * x.im) → ((∀ - (f : GaussianInt → Int), ∀ (f' : GaussianInt → Int), ∀ (x : GaussianInt), ∀ (t : - GaussianInt), ∀ (A : Int), ∀ (B : Int), ∀ (C : Int), (f x = f' (x - t) + A * x.re + B - * x.im + C) → ((f (x - 1) = f' ((x - t) - 1) + A * (x - 1).re + B * (x - 1).im + C) → - ((f (x + 1) = f' ((x - t) + 1) + A * (x + 1).re + B * (x + 1).im + C) → ((f (x - ⟨0, - 1⟩) = f' ((x - t) - ⟨0, 1⟩) + A * (x - ⟨0, 1⟩).re + B * (x - ⟨0, 1⟩).im + C) → ((f (x - + ⟨0, 1⟩) = f' ((x - t) + ⟨0, 1⟩) + A * (x + ⟨0, 1⟩).re + B * (x + ⟨0, 1⟩).im + C) → - (FourNeighborLaplacian f x = FourNeighborLaplacian f' (x - t))))))) → ((∀ (z : - GaussianInt), ((P.q₁ : Int) ≤ z.re) → ((z.re ≤ (P.q : Int)) → ((0 ≤ z.im) → ((z.im ≤ - (P.q₂ : Int)) → (z ∈ FordRecursiveVertexDomains P 2))))) → (∀ (hr : Fin (4 : ℕ) → - Finset GaussianInt), (P.q₁ < P.q₂) → (∀ (H : FordFareyParameter), (H.q = P.q₂ - P.q₁) - → (∀ (R : FordFareyParameter), (R.p = P.p₂ ∧ R.q = P.q₂) → ((P₂.p₁ = P.p₁ ∧ P₂.q₁ = - P.q₁ ∧ P₂.p₂ = P.p₂-P.p₁ ∧ P₂.q₂ = P.q₂-P.q₁) → ((∀ z, z ∈ FordRecursiveVertexDomains - P₂ 3 → FordOdometer P₂ z = FordOdometer H (z-⟨0,(P₂.q₁ : Int)⟩) + P₂.p₁*z.re) → ((∀ - (x : GaussianInt), (x ∈ hr 2 ∩ hr 3) → ((P.q₁ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 - ∧ (P.q₁ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q₂ : Int)-1)) → (∀ x ∈ hr 2 ∩ hr 3, - FourNeighborLaplacian (FordOdometer P) x = FourNeighborLaplacian (FordOdometer H) - (x-⟨(P.q₁ : Int),(P.q₁ : Int)⟩)))))))))))))) ) := by + ∀ (P : FordFareyParameter), + ∀ (P₂ : FordFareyParameter), + P₂.q = P.q₂ → + P.q = P.q₁ + P.q₂ → + P.q₂ < P.q → + (∀ x, + x ∈ FordRecursiveVertexDomains P 2 → + FordOdometer P x = + FordOdometer P₂ (x - ⟨(P.q₁ : Int), 0⟩) + P.p₁ * x.im) → + (∀ (f : GaussianInt → Int), + ∀ (f' : GaussianInt → Int), + ∀ (x : GaussianInt), + ∀ (t : GaussianInt), + ∀ (A : Int), + ∀ (B : Int), + ∀ (C : Int), + f x = f' (x - t) + A * x.re + B * x.im + C → + f (x - 1) = + f' (x - t - 1) + A * (x - 1).re + B * (x - 1).im + C → + f (x + 1) = + f' (x - t + 1) + A * (x + 1).re + B * (x + 1).im + C → + f (x - ⟨0, 1⟩) = + f' (x - t - ⟨0, 1⟩) + A * (x - ⟨0, 1⟩).re + + B * (x - ⟨0, 1⟩).im + + C → + f (x + ⟨0, 1⟩) = + f' (x - t + ⟨0, 1⟩) + A * (x + ⟨0, 1⟩).re + + B * (x + ⟨0, 1⟩).im + + C → + FourNeighborLaplacian f x = + FourNeighborLaplacian f' (x - t)) → + (∀ (z : GaussianInt), + (P.q₁ : Int) ≤ z.re → + z.re ≤ (P.q : Int) → + 0 ≤ z.im → + z.im ≤ (P.q₂ : Int) → + z ∈ FordRecursiveVertexDomains P 2) → + ∀ (hr : Fin (4 : ℕ) → Finset GaussianInt), + P.q₁ < P.q₂ → + ∀ (H : FordFareyParameter), + ∀ (R : FordFareyParameter), + R.p = P.p₂ ∧ R.q = P.q₂ → + P₂.p₁ = P.p₁ ∧ + P₂.q₁ = P.q₁ ∧ P₂.p₂ = P.p₂ - P.p₁ ∧ P₂.q₂ = P.q₂ - P.q₁ → + (∀ z, + z ∈ FordRecursiveVertexDomains P₂ 3 → + FordOdometer P₂ z = + FordOdometer H (z - ⟨0, (P₂.q₁ : Int)⟩) + P₂.p₁ * z.re) → + (∀ (x : GaussianInt), + x ∈ hr 2 ∩ hr 3 → + (P.q₁ : Int) + 1 ≤ x.re ∧ + x.re ≤ (P.q₂ : Int) - 1 ∧ + (P.q₁ : Int) + 1 ≤ x.im ∧ x.im ≤ (P.q₂ : Int) - 1) → + ∀ x ∈ hr 2 ∩ hr 3, + FourNeighborLaplacian (FordOdometer P) x = + FourNeighborLaplacian (FordOdometer H) + (x - ⟨(P.q₁ : Int), (P.q₁ : Int)⟩) + ) := by classical - intro P P₁ P₂ hq₂ hsum hlt₂ hrec₂' hlapAffine hrec2Member hr horder H hHq R hR hpar hch₃' - hcoords x hx + intro P P₂ hq₂ hsum hlt₂ hrec₂' hlapAffine hrec2Member hr horder H R hR hpar hch₃' hcoords x + hx have hb := hcoords x hx have hpt (z : GaussianInt) (hzr : (P.q₁ : Int) ≤ z.re) (hzr' : z.re ≤ (P.q₂ : Int)) (hzi : (P.q₁ : Int) ≤ z.im) @@ -835,7 +892,7 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) have squareCoordinates (q : Nat) (x : GaussianInt) := FordInteriorSquareCoordinates.membership q x have hsum : P.q = P.q₁ + P.q₂ := P.sum_q have hcrossdet := OverlapDescentDetails.hcrossdet P - have hpos₁ := OverlapDescentDetails.hpos₁ P P₁ P₂ hP hq₁ hsum + have hpos₁ := OverlapDescentDetails.hpos₁ P P₁ hP hq₁ hsum have hpos₂ : 0 < P.q₂ := P.q₂_pos have hlt₁ : P.q₁ < P.q := P.q₁_lt have hlt₂ : P.q₂ < P.q := by omega @@ -887,10 +944,9 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) · intro horder have hdiff : 0 < P.q₁ - P.q₂ := by omega have hdlt : P.q₁ - P.q₂ < P.q := by omega - have hdetdiff := OverlapDescentDetails.hdetdiffAt260 P P₁ P₂ + have hdetdiff := OverlapDescentDetails.hdetdiffAt260 P hcrossdet horder - have hcop := OverlapDescentDetails.hcopAt264 P - P₁ P₂ hcrossdet horder + have hcop := OverlapDescentDetails.hcopAt264 P hcrossdet horder obtain ⟨H, ⟨hHp,hHq⟩, _⟩ := FordFareyParentsExist (P.p₁-P.p₂) (P.q₁-P.q₂) hdiff hcop have hredParent : Nat.Coprime P.q₁ P.p₁.natAbs := hred₁.1 @@ -923,10 +979,9 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) rcases hchildRec with ⟨hch₀, hch₁, _, _⟩ have hch₀' := OverlapDescentDetails.hch₀' P₁ H hch₀ have hch₁' := OverlapDescentDetails.hch₁' P₁ H hch₁ - have hcoords (x : GaussianInt) (hx : x ∈ hr 0 ∩ hr 1) := OverlapDescentDetails.hcoordsAt312 P P₁ - P₂ hP squareCoordinates hsum hcrossdet hpos₁ hpos₂ hr hA0 hA1 horder hdlt hdetdiff H - hHq hredParent R x hx - have htarget := OverlapDescentDetails.htargetAt327 P P₁ P₂ hP hq₁ + have hcoords (x : GaussianInt) (hx : x ∈ hr 0 ∩ hr 1) := OverlapDescentDetails.hcoordsAt312 + P squareCoordinates hr hA0 hA1 H x hx + have htarget := OverlapDescentDetails.htargetAt327 P P₁ hq₁ hsum hcrossdet hpos₁ hpos₂ hrec₀' hrec₁' hlapAffine hrec0Member hrec1Member hr horder hdlt hdetdiff H hHq hredParent R hR hpar hparP hch₀' hch₁' hcoords refine ⟨H, hHp, hHq, by simpa [hHq] using hdlt, hparP.1, hparP.2.1, @@ -965,10 +1020,9 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) · intro horder have hdiff : 0 < P.q₂ - P.q₁ := by omega have hdlt : P.q₂ - P.q₁ < P.q := by omega - have hdetdiff := OverlapDescentDetails.hdetdiffAt465 P P₁ P₂ + have hdetdiff := OverlapDescentDetails.hdetdiffAt465 P hcrossdet horder - have hcop := OverlapDescentDetails.hcopAt469 P - P₁ P₂ hcrossdet horder + have hcop := OverlapDescentDetails.hcopAt469 P hcrossdet horder obtain ⟨H, ⟨hHp,hHq⟩, _⟩ := FordFareyParentsExist (P.p₂-P.p₁) (P.q₂-P.q₁) hdiff hcop have hredParent : Nat.Coprime P.q₂ P.p₂.natAbs := hred₁.2 @@ -998,10 +1052,10 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) (hHp.trans hpar.2.2.1.symm) (hHq.trans hpar.2.2.2.symm) rcases hchildRec with ⟨_, _, hch₂, hch₃⟩ have hch₃' := OverlapDescentDetails.hch₃' P₂ H hch₃ - have hcoords (x : GaussianInt) (hx : x ∈ hr 2 ∩ hr 3) := OverlapDescentDetails.hcoordsAt511 P P₁ - P₂ squareCoordinates hr hA2 hA3 H R hR hpar x hx - have htarget := OverlapDescentDetails.htargetAt542 P P₁ P₂ hq₂ - hsum hlt₂ hrec₂' hlapAffine hrec2Member hr horder H hHq R hR hpar hch₃' hcoords + have hcoords (x : GaussianInt) (hx : x ∈ hr 2 ∩ hr 3) := OverlapDescentDetails.hcoordsAt511 P + P₂ squareCoordinates hr hA2 hA3 R x hx + have htarget := OverlapDescentDetails.htargetAt542 P P₂ hq₂ + hsum hlt₂ hrec₂' hlapAffine hrec2Member hr horder H R hR hpar hch₃' hcoords refine ⟨H, hHp, hHq, by simpa [hHq] using hdlt, hpar.1, hpar.2.1, hpar.2.2.1, hpar.2.2.2, ?_, htarget⟩ ext x diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean index fe879d5f96..ab8de80aab 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean @@ -97,15 +97,23 @@ private theorem hrecursive : simpa [FordOdometer] using rec₃ x hx private theorem hchild0Lap : - ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (FordFareyParameter) → ((P₁.q = - P.q₁) → ((∀ x ∈ FordRecursiveVertexDomains P (0 : Fin (4 : ℕ)), FordOdometer P x = - FordOdometer P₁ x) → ((∀ (z : GaussianInt), (0 ≤ z.re) → ((z.re ≤ (P.q₁ : Int)) → ((0 ≤ - z.im) → ((z.im ≤ (P.q₁ : Int)) → (z ∈ FordRecursiveVertexDomains P 0))))) → (∀ (x : - GaussianInt), (1 : ℤ) ≤ x.re → x.re ≤ (↑P.q₁ : ℤ) - (1 : ℤ) → (1 : ℤ) ≤ x.im → x.im ≤ - (↑P.q₁ : ℤ) - (1 : ℤ) → FourNeighborLaplacian (FordOdometer P) x = FourNeighborLaplacian - (FordOdometer P₁) x)))) := by + ∀ (P : FordFareyParameter), + ∀ (P₁ : FordFareyParameter), + (∀ x ∈ FordRecursiveVertexDomains P (0 : Fin (4 : ℕ)), + FordOdometer P x = FordOdometer P₁ x) → + (∀ (z : GaussianInt), + 0 ≤ z.re → + z.re ≤ (P.q₁ : Int) → + 0 ≤ z.im → z.im ≤ (P.q₁ : Int) → z ∈ FordRecursiveVertexDomains P 0) → + ∀ (x : GaussianInt), + (1 : ℤ) ≤ x.re → + x.re ≤ (↑P.q₁ : ℤ) - (1 : ℤ) → + (1 : ℤ) ≤ x.im → + x.im ≤ (↑P.q₁ : ℤ) - (1 : ℤ) → + FourNeighborLaplacian (FordOdometer P) x = + FourNeighborLaplacian (FordOdometer P₁) x := by classical - intro P P₁ P₂ hq₁ hrec₀ hrec0Member x hxr hxr' hxi hxi' + intro P P₁ hrec₀ hrec0Member x hxr hxr' hxi hxi' have hmem : x ∈ FordRecursiveVertexDomains P 0 ∧ x - 1 ∈ FordRecursiveVertexDomains P 0 ∧ @@ -367,8 +375,8 @@ theorem P4062T1ParentalRestriction (P : FordFareyParameter) (hxr : 1 ≤ x.re) (hxr' : x.re ≤ (P.q₁ : Int) - 1) (hxi : 1 ≤ x.im) (hxi' : x.im ≤ (P.q₁ : Int) - 1) : FourNeighborLaplacian (FordOdometer P) x = - FourNeighborLaplacian (FordOdometer P₁) x := ParentalRestrictionProof.hchild0Lap P P₁ P₂ - hq₁ hrec₀ hrec0Member x hxr hxr' hxi hxi' + FourNeighborLaplacian (FordOdometer P₁) x := ParentalRestrictionProof.hchild0Lap P P₁ + hrec₀ hrec0Member x hxr hxr' hxi hxi' have hrec1Member (z : GaussianInt) (hzr : (P.q₂ : Int) ≤ z.re) (hzr' : z.re ≤ (P.q : Int)) (hzi : (P.q₂ : Int) ≤ z.im) (hzi' : z.im ≤ (P.q : Int)) : diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean index 398d501ae4..2764eda39b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean @@ -88,10 +88,10 @@ private theorem natAbs_form : (by classical exact - (FordFareyParameter) → (∀ (z : ℤ), z.natAbs = if z ≤ (0 : ℤ) then (-z).toNat else z.toNat) + ∀ (z : ℤ), z.natAbs = if z ≤ (0 : ℤ) then (-z).toNat else z.toNat ) := by classical - intro P z + intro z by_cases hz : z ≤ 0 · rw [ite_eq_left hz] have hc : (z.natAbs : Int) = -z := Int.ofNat_natAbs_of_nonpos hz @@ -199,13 +199,19 @@ private theorem root_candidate_empty : (by classical exact - (FordFareyParameter) → (∀ (S : Finset GaussianInt), ∀ (ρ : GaussianInt → ℕ), ∀ (x : - GaussianInt), ρ x = (0 : ℕ) → ({y ∈ {x + (1 : GaussianInt), x - (1 : GaussianInt), - x + ⟨(0 : ℤ), (1 : ℤ)⟩, x - ⟨(0 : ℤ), (1 : ℤ)⟩} | y ∈ S ∧ ρ y < ρ x} : Finset - GaussianInt) = ∅) + ∀ (S : Finset GaussianInt), + ∀ (ρ : GaussianInt → ℕ), + ∀ (x : GaussianInt), + ρ x = (0 : ℕ) → + ({y ∈ + {x + (1 : GaussianInt), x - (1 : GaussianInt), + x + ⟨(0 : ℤ), (1 : ℤ)⟩, x - ⟨(0 : ℤ), (1 : ℤ)⟩} | + y ∈ S ∧ ρ y < ρ x} : + Finset GaussianInt) = + ∅ ) := by classical - intro P S ρ x hz + intro S ρ x hz ext y simp only [Finset.mem_filter, Finset.notMem_empty] constructor @@ -504,15 +510,16 @@ private theorem hpredDistAt490 : classical exact ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - ∀ (x : GaussianInt), ((B (0 : Fin (2 : ℕ))).2 = ⟨(↑P.q₁ : ℤ), (↑P.q₁ : ℤ)⟩) → ((x.re = - (↑P.q₁ : ℤ) ∧ x.im ≤ (↑P.q₁ : ℤ)) → ((x.re = (P.q₁ : Int)) → ((x.im < (P.q₁ : Int)) → - (rootDist 0 (x + ⟨0, 1⟩) < rootDist 0 x)))) + let B := P4062T1RemainderPaths P; + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re - (B j).2.re).natAbs + (z.im - (B j).2.im).natAbs; + ∀ (x : GaussianInt), + (B (0 : Fin (2 : ℕ))).2 = ⟨(↑P.q₁ : ℤ), (↑P.q₁ : ℤ)⟩ → + x.re = (P.q₁ : Int) → + x.im < (P.q₁ : Int) → rootDist 0 (x + ⟨0, 1⟩) < rootDist 0 x ) := by classical - intro P B rootDist x hb0root harm hr hhi + intro P B rootDist x hb0root hr hhi have ha : 0 ≤ (P.q₁ : Int) - (x.im + 1) := by omega have hab : (P.q₁ : Int) - (x.im + 1) < (P.q₁ : Int) - x.im := by omega have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab @@ -528,13 +535,17 @@ private theorem hnotRightAt501 : (by classical exact - ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.re = (↑P.q₁ : ℤ) ∧ x.im ≤ (↑P.q₁ : - ℤ)) → ((x.re = (P.q₁ : Int)) → ((x.im < (P.q₁ : Int)) → (x + 1 ∉ - (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : - Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))))) + ∀ (P : FordFareyParameter), + ∀ (x : GaussianInt), + x.re = (P.q₁ : Int) → + x.im < (P.q₁ : Int) → + x + 1 ∉ + (P4062T1InteriorSquare P.q).filter fun z => + z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int) ∨ + z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int) ) := by classical - intro P x harm hr hhi hz + intro P x hr hhi hz simp only [Finset.mem_filter] at hz rcases hz with ⟨_, hz | hz⟩ · simp [Zsqrtd.re_add, hr] at hz @@ -545,13 +556,17 @@ private theorem hnotLeftAt511 : (by classical exact - ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.re = (↑P.q₁ : ℤ) ∧ x.im ≤ (↑P.q₁ : - ℤ)) → ((x.re = (P.q₁ : Int)) → ((x.im < (P.q₁ : Int)) → (x - 1 ∉ - (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : - Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))))) + ∀ (P : FordFareyParameter), + ∀ (x : GaussianInt), + x.re = (P.q₁ : Int) → + x.im < (P.q₁ : Int) → + x - 1 ∉ + (P4062T1InteriorSquare P.q).filter fun z => + z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int) ∨ + z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int) ) := by classical - intro P x harm hr hhi hz + intro P x hr hhi hz simp only [Finset.mem_filter] at hz rcases hz with ⟨_, hz | hz⟩ · simp [Zsqrtd.re_sub, hr] at hz @@ -563,15 +578,16 @@ private theorem hnotPredAt521 : classical exact ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - ∀ (x : GaussianInt), ((B (0 : Fin (2 : ℕ))).2 = ⟨(↑P.q₁ : ℤ), (↑P.q₁ : ℤ)⟩) → ((x.re = - (↑P.q₁ : ℤ) ∧ x.im ≤ (↑P.q₁ : ℤ)) → ((x.re = (P.q₁ : Int)) → ((x.im < (P.q₁ : Int)) → - (¬ rootDist 0 (x - ⟨0, 1⟩) < rootDist 0 x)))) + let B := P4062T1RemainderPaths P; + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re - (B j).2.re).natAbs + (z.im - (B j).2.im).natAbs; + ∀ (x : GaussianInt), + (B (0 : Fin (2 : ℕ))).2 = ⟨(↑P.q₁ : ℤ), (↑P.q₁ : ℤ)⟩ → + x.re = (P.q₁ : Int) → + x.im < (P.q₁ : Int) → ¬rootDist 0 (x - ⟨0, 1⟩) < rootDist 0 x ) := by classical - intro P B rootDist x hb0root harm hr hhi + intro P B rootDist x hb0root hr hhi have ha : 0 ≤ (P.q₁ : Int) - x.im := by omega have hab : (P.q₁ : Int) - x.im < (P.q₁ : Int) - (x.im - 1) := by omega have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab @@ -651,15 +667,16 @@ private theorem hpredDistAt583 : classical exact ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - ∀ (x : GaussianInt), ((B (0 : Fin (2 : ℕ))).2 = ⟨(↑P.q₁ : ℤ), (↑P.q₁ : ℤ)⟩) → ((x.im = - (↑P.q₁ : ℤ) ∧ x.re ≤ (↑P.q₁ : ℤ)) → ((x.im = (P.q₁ : Int)) → ((x.re < (P.q₁ : Int)) → - (rootDist 0 (x + 1) < rootDist 0 x)))) + let B := P4062T1RemainderPaths P; + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re - (B j).2.re).natAbs + (z.im - (B j).2.im).natAbs; + ∀ (x : GaussianInt), + (B (0 : Fin (2 : ℕ))).2 = ⟨(↑P.q₁ : ℤ), (↑P.q₁ : ℤ)⟩ → + x.im = (P.q₁ : Int) → + x.re < (P.q₁ : Int) → rootDist 0 (x + 1) < rootDist 0 x ) := by classical - intro P B rootDist x hb0root harm hr hhi + intro P B rootDist x hb0root hr hhi have ha : 0 ≤ (P.q₁ : Int) - (x.re + 1) := by omega have hab : (P.q₁ : Int) - (x.re + 1) < (P.q₁ : Int) - x.re := by omega have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab @@ -676,15 +693,16 @@ private theorem hnotLeftAt594 : classical exact ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - ∀ (x : GaussianInt), ((B (0 : Fin (2 : ℕ))).2 = ⟨(↑P.q₁ : ℤ), (↑P.q₁ : ℤ)⟩) → ((x.im = - (↑P.q₁ : ℤ) ∧ x.re ≤ (↑P.q₁ : ℤ)) → ((x.im = (P.q₁ : Int)) → ((x.re < (P.q₁ : Int)) → - (¬ rootDist 0 (x - 1) < rootDist 0 x)))) + let B := P4062T1RemainderPaths P; + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re - (B j).2.re).natAbs + (z.im - (B j).2.im).natAbs; + ∀ (x : GaussianInt), + (B (0 : Fin (2 : ℕ))).2 = ⟨(↑P.q₁ : ℤ), (↑P.q₁ : ℤ)⟩ → + x.im = (P.q₁ : Int) → + x.re < (P.q₁ : Int) → ¬rootDist 0 (x - 1) < rootDist 0 x ) := by classical - intro P B rootDist x hb0root harm hr hhi + intro P B rootDist x hb0root hr hhi have ha : 0 ≤ (P.q₁ : Int) - x.re := by omega have hab : (P.q₁ : Int) - x.re < (P.q₁ : Int) - (x.re - 1) := by omega have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab @@ -703,13 +721,17 @@ private theorem hnotUpAt608 : (by classical exact - ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.im = (↑P.q₁ : ℤ) ∧ x.re ≤ (↑P.q₁ : - ℤ)) → ((x.im = (P.q₁ : Int)) → ((x.re < (P.q₁ : Int)) → (x + ⟨0, 1⟩ ∉ - (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : - Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))))) + ∀ (P : FordFareyParameter), + ∀ (x : GaussianInt), + x.im = (P.q₁ : Int) → + x.re < (P.q₁ : Int) → + x + ⟨0, 1⟩ ∉ + (P4062T1InteriorSquare P.q).filter fun z => + z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int) ∨ + z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int) ) := by classical - intro P x harm hr hhi hz + intro P x hr hhi hz simp only [Finset.mem_filter] at hz rcases hz with ⟨_, hz | hz⟩ · simp [Zsqrtd.re_add] at hz @@ -720,13 +742,17 @@ private theorem hnotDownAt618 : (by classical exact - ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.im = (↑P.q₁ : ℤ) ∧ x.re ≤ (↑P.q₁ : - ℤ)) → ((x.im = (P.q₁ : Int)) → ((x.re < (P.q₁ : Int)) → (x - ⟨0, 1⟩ ∉ - (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : - Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))))) + ∀ (P : FordFareyParameter), + ∀ (x : GaussianInt), + x.im = (P.q₁ : Int) → + x.re < (P.q₁ : Int) → + x - ⟨0, 1⟩ ∉ + (P4062T1InteriorSquare P.q).filter fun z => + z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int) ∨ + z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int) ) := by classical - intro P x harm hr hhi hz + intro P x hr hhi hz simp only [Finset.mem_filter] at hz rcases hz with ⟨_, hz | hz⟩ · simp [Zsqrtd.re_sub] at hz @@ -1062,15 +1088,16 @@ private theorem hnotUpAt899 : classical exact ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - ∀ (x : GaussianInt), ((B (1 : Fin (2 : ℕ))).2 = ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) → ((x.re = - (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ x.im) → ((x.re = (P.q₂ : Int)) → (((P.q₂ : Int) < x.im) → - (¬ rootDist 1 (x + ⟨0, 1⟩) < rootDist 1 x)))) + let B := P4062T1RemainderPaths P; + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re - (B j).2.re).natAbs + (z.im - (B j).2.im).natAbs; + ∀ (x : GaussianInt), + (B (1 : Fin (2 : ℕ))).2 = ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩ → + x.re = (P.q₂ : Int) → + (P.q₂ : Int) < x.im → ¬rootDist 1 (x + ⟨0, 1⟩) < rootDist 1 x ) := by classical - intro P B rootDist x hb1root harm hr hlo + intro P B rootDist x hb1root hr hlo have ha : 0 ≤ x.im - (P.q₂ : Int) := by omega have hab : x.im - (P.q₂ : Int) < x.im + 1 - (P.q₂ : Int) := by omega have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab @@ -1085,13 +1112,17 @@ private theorem hnotRightAt909 : (by classical exact - ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.re = (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ - x.im) → ((x.re = (P.q₂ : Int)) → (((P.q₂ : Int) < x.im) → (x + 1 ∉ - (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ - z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))))) + ∀ (P : FordFareyParameter), + ∀ (x : GaussianInt), + x.re = (P.q₂ : Int) → + (P.q₂ : Int) < x.im → + x + 1 ∉ + (P4062T1InteriorSquare P.q).filter fun z => + z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.im ∨ + z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re ) := by classical - intro P x harm hr hlo hz + intro P x hr hlo hz simp only [Finset.mem_filter] at hz rcases hz with ⟨_, hz | hz⟩ · simp [Zsqrtd.re_add, hr] at hz @@ -1102,13 +1133,17 @@ private theorem hnotLeftAt919 : (by classical exact - ∀ (P : FordFareyParameter), ∀ (x : GaussianInt), (x.re = (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ - x.im) → ((x.re = (P.q₂ : Int)) → (((P.q₂ : Int) < x.im) → (x - 1 ∉ - (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ - z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))))) + ∀ (P : FordFareyParameter), + ∀ (x : GaussianInt), + x.re = (P.q₂ : Int) → + (P.q₂ : Int) < x.im → + x - 1 ∉ + (P4062T1InteriorSquare P.q).filter fun z => + z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.im ∨ + z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re ) := by classical - intro P x harm hr hlo hz + intro P x hr hlo hz simp only [Finset.mem_filter] at hz rcases hz with ⟨_, hz | hz⟩ · simp [Zsqrtd.re_sub, hr] at hz @@ -1181,15 +1216,16 @@ private theorem hnotRightAt987 : classical exact ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - ∀ (x : GaussianInt), ((B (1 : Fin (2 : ℕ))).2 = ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) → ((x.im = - (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ x.re) → ((x.im = (P.q₂ : Int)) → (((P.q₂ : Int) < x.re) → - (¬ rootDist 1 (x + 1) < rootDist 1 x)))) + let B := P4062T1RemainderPaths P; + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re - (B j).2.re).natAbs + (z.im - (B j).2.im).natAbs; + ∀ (x : GaussianInt), + (B (1 : Fin (2 : ℕ))).2 = ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩ → + x.im = (P.q₂ : Int) → + (P.q₂ : Int) < x.re → ¬rootDist 1 (x + 1) < rootDist 1 x ) := by classical - intro P B rootDist x hb1root harm hr hlo + intro P B rootDist x hb1root hr hlo have ha : 0 ≤ x.re - (P.q₂ : Int) := by omega have hab : x.re - (P.q₂ : Int) < x.re + 1 - (P.q₂ : Int) := by omega have hn := Int.natAbs_lt_natAbs_of_nonneg_of_lt ha hab @@ -1424,10 +1460,10 @@ private theorem firstPathDescendingCount : exact hroot this.symm have hpred := LowerNeighborGeometry.hpredAt476 P hq1pos hsum squareCoordinates x horder' harm hr hlo hhi - have hpredDist := LowerNeighborGeometry.hpredDistAt490 P x hb0root harm hr hhi - have hnotRight := LowerNeighborGeometry.hnotRightAt501 P x harm hr hhi - have hnotLeft := LowerNeighborGeometry.hnotLeftAt511 P x harm hr hhi - have hnotPred := LowerNeighborGeometry.hnotPredAt521 P x hb0root harm hr hhi + have hpredDist := LowerNeighborGeometry.hpredDistAt490 P x hb0root hr hhi + have hnotRight := LowerNeighborGeometry.hnotRightAt501 P x hr hhi + have hnotLeft := LowerNeighborGeometry.hnotLeftAt511 P x hr hhi + have hnotPred := LowerNeighborGeometry.hnotPredAt521 P x hb0root hr hhi have hset := LowerNeighborGeometry.hsetAt535 P x hpred hpredDist hnotRight hnotLeft hnotPred rw [hset] @@ -1447,10 +1483,10 @@ private theorem firstPathDescendingCount : exact hroot this have hpred := LowerNeighborGeometry.hpredAt570 P hq1pos hsum squareCoordinates x horder' harm hr hlo hhi - have hpredDist := LowerNeighborGeometry.hpredDistAt583 P x hb0root harm hr hhi - have hnotLeft := LowerNeighborGeometry.hnotLeftAt594 P x hb0root harm hr hhi - have hnotUp := LowerNeighborGeometry.hnotUpAt608 P x harm hr hhi - have hnotDown := LowerNeighborGeometry.hnotDownAt618 P x harm hr hhi + have hpredDist := LowerNeighborGeometry.hpredDistAt583 P x hb0root hr hhi + have hnotLeft := LowerNeighborGeometry.hnotLeftAt594 P x hb0root hr hhi + have hnotUp := LowerNeighborGeometry.hnotUpAt608 P x hr hhi + have hnotDown := LowerNeighborGeometry.hnotDownAt618 P x hr hhi have hset := LowerNeighborGeometry.hsetAt628 P x hpred hpredDist hnotLeft hnotUp hnotDown rw [hset] @@ -1614,9 +1650,9 @@ private theorem secondPathDescendingCount : hr] simp only [Int.sub_zero, sub_self, Int.natAbs_zero, zero_add] exact hn - have hnotUp := LowerNeighborGeometry.hnotUpAt899 P x hb1root harm hr hlo - have hnotRight := LowerNeighborGeometry.hnotRightAt909 P x harm hr hlo - have hnotLeft := LowerNeighborGeometry.hnotLeftAt919 P x harm hr hlo + have hnotUp := LowerNeighborGeometry.hnotUpAt899 P x hb1root hr hlo + have hnotRight := LowerNeighborGeometry.hnotRightAt909 P x hr hlo + have hnotLeft := LowerNeighborGeometry.hnotLeftAt919 P x hr hlo have hset := LowerNeighborGeometry.hsetAt929 P x hpred hpredDist hnotUp hnotRight hnotLeft rw [hset] @@ -1646,7 +1682,7 @@ private theorem secondPathDescendingCount : Zsqrtd.re_one, Zsqrtd.im_one, hr] simp only [Int.sub_zero, sub_self, Int.natAbs_zero] exact hn - have hnotRight := LowerNeighborGeometry.hnotRightAt987 P x hb1root harm hr hlo + have hnotRight := LowerNeighborGeometry.hnotRightAt987 P x hb1root hr hlo have hnotUp := LowerNeighborGeometry.hnotUpAt997 P x harm hr hlo have hnotDown := LowerNeighborGeometry.hnotDownAt1008 P x harm hr have hset := LowerNeighborGeometry.hsetAt1018 P @@ -1690,7 +1726,7 @@ theorem P4112T1LowerNeighbors (P : FordFareyParameter) (hP : 2 < P.q) : ((B j).1.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = (if x = (B j).2 then 0 else 1) have squareCoordinates (q : Nat) (z : GaussianInt) := LowerNeighborGeometry.squareCoordinates q z - have natAbs_form (z : Int) := LowerNeighborGeometry.natAbs_form P z + have natAbs_form (z : Int) := LowerNeighborGeometry.natAbs_form z have d_on_path (j : Fin 2) (z : GaussianInt) (hz : z ∈ (B j).1) := LowerNeighborGeometry.d_on_path P hP j z hz have neighbor_filter (S : Finset GaussianInt) (x : GaussianInt) @@ -1700,7 +1736,7 @@ theorem P4112T1LowerNeighbors (P : FordFareyParameter) (hP : 2 < P.q) : have count_eq (j : Fin 2) (x : GaussianInt) (hx : x ∈ (B j).1) := LowerNeighborGeometry.count_eq P d_on_path neighbor_filter j x hx have root_candidate_empty (S : Finset GaussianInt) (ρ : GaussianInt → Nat) - (x : GaussianInt) (hz : ρ x = 0) := LowerNeighborGeometry.root_candidate_empty P S ρ x hz + (x : GaussianInt) (hz : ρ x = 0) := LowerNeighborGeometry.root_candidate_empty S ρ x hz intro j fin_cases j · intro x hx diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean index 3a0e2dc6df..be974c79a1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean @@ -264,14 +264,13 @@ private theorem transpose_mem : constructor <;> intro hz <;> omega private theorem transpose_candidate : - (FordFareyParameter) → ( let candidate (z : GaussianInt) : Finset GaussianInt := {z + 1, z - 1, z + ⟨0, 1⟩, z - ⟨0, 1⟩} let transpose (z : GaussianInt) : GaussianInt := ⟨z.im, z.re⟩ - ∀ (x : GaussianInt), ∀ (z : GaussianInt), z ∈ candidate x ↔ transpose z ∈ candidate - (transpose x)) := by + ∀ (x : GaussianInt), + ∀ (z : GaussianInt), z ∈ candidate x ↔ transpose z ∈ candidate (transpose x) := by classical - intro P candidate transpose x z + intro candidate transpose x z cases x with | mk a b => cases z with @@ -885,7 +884,7 @@ theorem P4112T1ParentalNeighbors (P : FordFareyParameter) (hP : 2 < P.q) : ParentalNeighborLemmas.transpose_mem P hP q1pos q2posI hsumN hmem z have transpose_candidate (x z : GaussianInt) : z ∈ candidate x ↔ transpose z ∈ candidate (transpose x) := - ParentalNeighborLemmas.transpose_candidate P x z + ParentalNeighborLemmas.transpose_candidate x z have transpose_filter_card (x : GaussianInt) : (Finset.filter (fun z => z ∈ E) (candidate x)).card = (Finset.filter (fun z => z ∈ E) (candidate (transpose x))).card := diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean index b35a856f03..29208c4271 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean @@ -415,10 +415,10 @@ private theorem natAbsToNat : exact_mod_cast hn private theorem natAbsDist : - (FordFareyParameter) → ((∀ (z : Int), (0 ≤ z) → (z.natAbs = z.toNat)) → (∀ (a : Int), ∀ (b : - Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat)))) := by + (∀ (z : Int), 0 ≤ z → z.natAbs = z.toNat) → + ∀ (a : Int), ∀ (b : Int), 0 ≤ a → 0 ≤ b → (a - b).natAbs = Nat.dist a.toNat b.toNat := by classical - intro P natAbsToNat a b ha hb + intro natAbsToNat a b ha hb by_cases hab : a ≤ b · have habs : (a-b).natAbs = (b-a).toNat := by have h₁ := Int.natAbs_of_nonneg (a := b-a) (by omega) @@ -441,43 +441,47 @@ private theorem natAbsDist : omega private theorem distDistDown : - (FordFareyParameter) → (∀ (a : Nat), ∀ (b : Nat), ∀ (c : Nat), (a ≤ c) → ((b ≤ c) → (Nat.dist - (Nat.dist a c) (Nat.dist b c) = Nat.dist a b))) := by + ∀ (a : Nat), + ∀ (b : Nat), + ∀ (c : Nat), a ≤ c → b ≤ c → Nat.dist (Nat.dist a c) (Nat.dist b c) = Nat.dist a b := by classical - intro P a b c ha hb + intro a b c ha hb simp [Nat.dist] omega private theorem distDistUp : - (FordFareyParameter) → (∀ (a : Nat), ∀ (b : Nat), ∀ (c : Nat), (c ≤ a) → ((c ≤ b) → (Nat.dist - (Nat.dist a c) (Nat.dist b c) = Nat.dist a b))) := by + ∀ (a : Nat), + ∀ (b : Nat), + ∀ (c : Nat), c ≤ a → c ≤ b → Nat.dist (Nat.dist a c) (Nat.dist b c) = Nat.dist a b := by classical - intro P a b c ha hb + intro a b c ha hb simp [Nat.dist] omega private theorem natDistOneInt : - (FordFareyParameter) → (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → (Nat.dist a.toNat - b.toNat = 1 ↔ a = b+1 ∨ b = a+1))) := by + ∀ (a : Int), + ∀ (b : Int), 0 ≤ a → 0 ≤ b → (Nat.dist a.toNat b.toNat = 1 ↔ a = b + 1 ∨ b = a + 1) := by classical - intro P a b ha hb + intro a b ha hb have hac : (a.toNat : Int) = a := Int.toNat_of_nonneg ha have hbc : (b.toNat : Int) = b := Int.toNat_of_nonneg hb simp [Nat.dist] omega private theorem adjacentVertical : - (FordFareyParameter) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.re = y.re) → - (FourNeighborAdjacent x y ↔ x.im = y.im+1 ∨ y.im = x.im+1)) := by + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + x.re = y.re → (FourNeighborAdjacent x y ↔ x.im = y.im + 1 ∨ y.im = x.im + 1) := by classical - intro P x y hfix + intro x y hfix simp [FourNeighborAdjacent, Zsqrtd.ext_iff, hfix]; omega private theorem adjacentHorizontal : - (FordFareyParameter) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im = y.im) → - (FourNeighborAdjacent x y ↔ x.re = y.re+1 ∨ y.re = x.re+1)) := by + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + x.im = y.im → (FourNeighborAdjacent x y ↔ x.re = y.re + 1 ∨ y.re = x.re + 1) := by classical - intro P x y hfix + intro x y hfix simp [FourNeighborAdjacent, Zsqrtd.ext_iff, hfix]; omega private theorem lineVertical : @@ -606,144 +610,176 @@ private theorem dSmall1Root : private theorem dLarge0V : ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - let r := P.q₁ - let s := P.q₂ - (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → - (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (d x = (x.re-(r:Int)).natAbs + - (x.im-(s:Int)).natAbs))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → ((x.re = - (r:Int)) → ((0 ≤ x.im) → ((x.im ≤ (s:Int)) → (d x = Nat.dist x.im.toNat s))))))) := by + let B := P4062T1RemainderPaths P; + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs; + let r := P.q₁; + let s := P.q₂; + (∀ (a : Int), + ∀ (b : Int), 0 ≤ a → 0 ≤ b → (a - b).natAbs = Nat.dist a.toNat b.toNat) → + (s < r → + ∀ (x : GaussianInt), + x ∈ (B 0).1 → d x = (x.re - (r : Int)).natAbs + (x.im - (s : Int)).natAbs) → + s < r → + ∀ (x : GaussianInt), + x ∈ (B 0).1 → x.re = (r : Int) → 0 ≤ x.im → d x = Nat.dist x.im.toNat s := by classical - intro P B d r s natAbsDist dLarge0Root hlarge x hx hcoord hpos hbound + intro P B d r s natAbsDist dLarge0Root hlarge x hx hcoord hpos rw [dLarge0Root hlarge x hx, hcoord] simp only [sub_self, Int.natAbs_zero, zero_add] simpa using (natAbsDist x.im (s:Int) hpos (by exact_mod_cast (Nat.zero_le s))) private theorem dLarge0H : ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - let r := P.q₁ - let s := P.q₂ - (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → - (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (d x = (x.re-(r:Int)).natAbs + - (x.im-(s:Int)).natAbs))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → ((x.im = - (s:Int)) → ((0 ≤ x.re) → (((r:Int) ≤ x.re) → (d x = Nat.dist x.re.toNat r))))))) := by + let B := P4062T1RemainderPaths P; + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs; + let r := P.q₁; + let s := P.q₂; + (∀ (a : Int), + ∀ (b : Int), 0 ≤ a → 0 ≤ b → (a - b).natAbs = Nat.dist a.toNat b.toNat) → + (s < r → + ∀ (x : GaussianInt), + x ∈ (B 0).1 → d x = (x.re - (r : Int)).natAbs + (x.im - (s : Int)).natAbs) → + s < r → + ∀ (x : GaussianInt), + x ∈ (B 0).1 → x.im = (s : Int) → 0 ≤ x.re → d x = Nat.dist x.re.toNat r := by classical - intro P B d r s natAbsDist dLarge0Root hlarge x hx hcoord hpos hbound + intro P B d r s natAbsDist dLarge0Root hlarge x hx hcoord hpos rw [dLarge0Root hlarge x hx, hcoord] simp only [sub_self, Int.natAbs_zero, add_zero] simpa using (natAbsDist x.re (r:Int) hpos (by exact_mod_cast (Nat.zero_le r))) private theorem dLarge1V : ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - let r := P.q₁ - let s := P.q₂ - (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → - (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = (x.re-(s:Int)).natAbs + - (x.im-(r:Int)).natAbs))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → ((x.im = - (r:Int)) → ((0 ≤ x.re) → ((x.re ≤ (s:Int)) → (d x = Nat.dist x.re.toNat s))))))) := by + let B := P4062T1RemainderPaths P; + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs; + let r := P.q₁; + let s := P.q₂; + (∀ (a : Int), + ∀ (b : Int), 0 ≤ a → 0 ≤ b → (a - b).natAbs = Nat.dist a.toNat b.toNat) → + (s < r → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → d x = (x.re - (s : Int)).natAbs + (x.im - (r : Int)).natAbs) → + s < r → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → x.im = (r : Int) → 0 ≤ x.re → d x = Nat.dist x.re.toNat s := by classical - intro P B d r s natAbsDist dLarge1Root hlarge x hx hcoord hpos hbound + intro P B d r s natAbsDist dLarge1Root hlarge x hx hcoord hpos rw [dLarge1Root hlarge x hx, hcoord] simp only [sub_self, Int.natAbs_zero] simpa using (natAbsDist x.re (s:Int) hpos (by exact_mod_cast (Nat.zero_le s))) private theorem dLarge1H : ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - let r := P.q₁ - let s := P.q₂ - (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → - (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = (x.re-(s:Int)).natAbs + - (x.im-(r:Int)).natAbs))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → ((x.re = - (s:Int)) → ((0 ≤ x.im) → (((r:Int) ≤ x.im) → (d x = Nat.dist x.im.toNat r))))))) := by + let B := P4062T1RemainderPaths P; + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs; + let r := P.q₁; + let s := P.q₂; + (∀ (a : Int), + ∀ (b : Int), 0 ≤ a → 0 ≤ b → (a - b).natAbs = Nat.dist a.toNat b.toNat) → + (s < r → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → d x = (x.re - (s : Int)).natAbs + (x.im - (r : Int)).natAbs) → + s < r → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → x.re = (s : Int) → 0 ≤ x.im → d x = Nat.dist x.im.toNat r := by classical - intro P B d r s natAbsDist dLarge1Root hlarge x hx hcoord hpos hbound + intro P B d r s natAbsDist dLarge1Root hlarge x hx hcoord hpos rw [dLarge1Root hlarge x hx, hcoord] simp only [sub_self, Int.natAbs_zero] simpa using (natAbsDist x.im (r:Int) hpos (by exact_mod_cast (Nat.zero_le r))) private theorem dSmall0V : ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - let r := P.q₁ - let s := P.q₂ - (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → - (((r < s) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (d x = (x.re-(r:Int)).natAbs + - (x.im-(r:Int)).natAbs))) → ((r < s) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → ((x.re = - (r:Int)) → ((0 ≤ x.im) → ((x.im ≤ (r:Int)) → (d x = Nat.dist x.im.toNat r))))))) := by + let B := P4062T1RemainderPaths P; + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs; + let r := P.q₁; + let s := P.q₂; + (∀ (a : Int), + ∀ (b : Int), 0 ≤ a → 0 ≤ b → (a - b).natAbs = Nat.dist a.toNat b.toNat) → + (r < s → + ∀ (x : GaussianInt), + x ∈ (B 0).1 → d x = (x.re - (r : Int)).natAbs + (x.im - (r : Int)).natAbs) → + r < s → + ∀ (x : GaussianInt), + x ∈ (B 0).1 → x.re = (r : Int) → 0 ≤ x.im → d x = Nat.dist x.im.toNat r := by classical - intro P B d r s natAbsDist dSmall0Root hsmall x hx hcoord hpos hbound + intro P B d r s natAbsDist dSmall0Root hsmall x hx hcoord hpos rw [dSmall0Root hsmall x hx, hcoord] simp only [sub_self, Int.natAbs_zero, zero_add] simpa using (natAbsDist x.im (r:Int) hpos (by exact_mod_cast (Nat.zero_le r))) private theorem dSmall0H : ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - let r := P.q₁ - let s := P.q₂ - (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → - (((r < s) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (d x = (x.re-(r:Int)).natAbs + - (x.im-(r:Int)).natAbs))) → ((r < s) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → ((x.im = - (r:Int)) → ((0 ≤ x.re) → ((x.re ≤ (r:Int)) → (d x = Nat.dist x.re.toNat r))))))) := by + let B := P4062T1RemainderPaths P; + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs; + let r := P.q₁; + let s := P.q₂; + (∀ (a : Int), + ∀ (b : Int), 0 ≤ a → 0 ≤ b → (a - b).natAbs = Nat.dist a.toNat b.toNat) → + (r < s → + ∀ (x : GaussianInt), + x ∈ (B 0).1 → d x = (x.re - (r : Int)).natAbs + (x.im - (r : Int)).natAbs) → + r < s → + ∀ (x : GaussianInt), + x ∈ (B 0).1 → x.im = (r : Int) → 0 ≤ x.re → d x = Nat.dist x.re.toNat r := by classical - intro P B d r s natAbsDist dSmall0Root hsmall x hx hcoord hpos hbound + intro P B d r s natAbsDist dSmall0Root hsmall x hx hcoord hpos rw [dSmall0Root hsmall x hx, hcoord] simp only [sub_self, Int.natAbs_zero, add_zero] simpa using (natAbsDist x.re (r:Int) hpos (by exact_mod_cast (Nat.zero_le r))) private theorem dSmall1V : ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - let r := P.q₁ - let s := P.q₂ - (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → - (((r < s) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = (x.re-(s:Int)).natAbs + - (x.im-(s:Int)).natAbs))) → ((r < s) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → ((x.re = - (s:Int)) → ((0 ≤ x.im) → (((s:Int) ≤ x.im) → (d x = Nat.dist x.im.toNat s))))))) := by + let B := P4062T1RemainderPaths P; + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs; + let r := P.q₁; + let s := P.q₂; + (∀ (a : Int), + ∀ (b : Int), 0 ≤ a → 0 ≤ b → (a - b).natAbs = Nat.dist a.toNat b.toNat) → + (r < s → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → d x = (x.re - (s : Int)).natAbs + (x.im - (s : Int)).natAbs) → + r < s → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → x.re = (s : Int) → 0 ≤ x.im → d x = Nat.dist x.im.toNat s := by classical - intro P B d r s natAbsDist dSmall1Root hsmall x hx hcoord hpos hbound + intro P B d r s natAbsDist dSmall1Root hsmall x hx hcoord hpos rw [dSmall1Root hsmall x hx, hcoord] simp only [sub_self, Int.natAbs_zero, zero_add] simpa using (natAbsDist x.im (s:Int) hpos (by exact_mod_cast (Nat.zero_le s))) private theorem dSmall1H : ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - let r := P.q₁ - let s := P.q₂ - (∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → - (((r < s) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = (x.re-(s:Int)).natAbs + - (x.im-(s:Int)).natAbs))) → ((r < s) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → ((x.im = - (s:Int)) → ((0 ≤ x.re) → (((s:Int) ≤ x.re) → (d x = Nat.dist x.re.toNat s))))))) := by + let B := P4062T1RemainderPaths P; + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs; + let r := P.q₁; + let s := P.q₂; + (∀ (a : Int), + ∀ (b : Int), 0 ≤ a → 0 ≤ b → (a - b).natAbs = Nat.dist a.toNat b.toNat) → + (r < s → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → d x = (x.re - (s : Int)).natAbs + (x.im - (s : Int)).natAbs) → + r < s → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → x.im = (s : Int) → 0 ≤ x.re → d x = Nat.dist x.re.toNat s := by classical - intro P B d r s natAbsDist dSmall1Root hsmall x hx hcoord hpos hbound + intro P B d r s natAbsDist dSmall1Root hsmall x hx hcoord hpos rw [dSmall1Root hsmall x hx, hcoord] simp only [sub_self, Int.natAbs_zero, add_zero] simpa using (natAbsDist x.re (s:Int) hpos (by exact_mod_cast (Nat.zero_le s))) @@ -1355,19 +1391,19 @@ theorem P4112T1PathGeometry (P : FordFareyParameter) (hP : 2 < P.q) : memB0Small memB1Small have hcross := PathGeometryProof.hcross P horder memB0Large memB1Large memB0Small memB1Small have natAbsToNat (z : Int) (hz : 0 ≤ z) := PathGeometryProof.natAbsToNat z hz - have natAbsDist (a b : Int) (ha : 0 ≤ a) (hb : 0 ≤ b) := PathGeometryProof.natAbsDist P + have natAbsDist (a b : Int) (ha : 0 ≤ a) (hb : 0 ≤ b) := PathGeometryProof.natAbsDist natAbsToNat a b ha hb - have distDistDown (a b c : Nat) (ha : a ≤ c) (hb : b ≤ c) := PathGeometryProof.distDistDown P a + have distDistDown (a b c : Nat) (ha : a ≤ c) (hb : b ≤ c) := PathGeometryProof.distDistDown a b c ha hb - have distDistUp (a b c : Nat) (ha : c ≤ a) (hb : c ≤ b) := PathGeometryProof.distDistUp P a b + have distDistUp (a b c : Nat) (ha : c ≤ a) (hb : c ≤ b) := PathGeometryProof.distDistUp a b c ha hb - have natDistOneInt (a b : Int) (ha : 0 ≤ a) (hb : 0 ≤ b) := PathGeometryProof.natDistOneInt P a b + have natDistOneInt (a b : Int) (ha : 0 ≤ a) (hb : 0 ≤ b) := PathGeometryProof.natDistOneInt a b ha hb have adjacentVertical (x y : GaussianInt) (hfix : x.re = y.re) := - PathGeometryProof.adjacentVertical P x y hfix + PathGeometryProof.adjacentVertical x y hfix have adjacentHorizontal (x y : GaussianInt) (hfix : x.im = y.im) := - PathGeometryProof.adjacentHorizontal P x y hfix + PathGeometryProof.adjacentHorizontal x y hfix have lineVertical (x y : GaussianInt) (hfix : x.re = y.re) (hnx : 0 ≤ x.im) (hny : 0 ≤ y.im) (hlevel : Nat.dist (d x) (d y) = Nat.dist x.im.toNat y.im.toNat) : @@ -1400,35 +1436,35 @@ theorem P4112T1PathGeometry (P : FordFareyParameter) (hP : 2 < P.q) : have dLarge0V (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 0).1) (hcoord : x.re = (r:Int)) (hpos : 0 ≤ x.im) (hbound : x.im ≤ (s:Int)) : d x = Nat.dist x.im.toNat s := PathGeometryProof.dLarge0V P natAbsDist dLarge0Root hlarge x - hx hcoord hpos hbound + hx hcoord hpos have dLarge0H (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 0).1) (hcoord : x.im = (s:Int)) (hpos : 0 ≤ x.re) (hbound : (r:Int) ≤ x.re) : d x = Nat.dist x.re.toNat r := PathGeometryProof.dLarge0H P natAbsDist dLarge0Root hlarge x - hx hcoord hpos hbound + hx hcoord hpos have dLarge1V (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 1).1) (hcoord : x.im = (r:Int)) (hpos : 0 ≤ x.re) (hbound : x.re ≤ (s:Int)) : d x = Nat.dist x.re.toNat s := PathGeometryProof.dLarge1V P natAbsDist dLarge1Root hlarge x - hx hcoord hpos hbound + hx hcoord hpos have dLarge1H (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 1).1) (hcoord : x.re = (s:Int)) (hpos : 0 ≤ x.im) (hbound : (r:Int) ≤ x.im) : d x = Nat.dist x.im.toNat r := PathGeometryProof.dLarge1H P natAbsDist dLarge1Root hlarge x - hx hcoord hpos hbound + hx hcoord hpos have dSmall0V (hsmall : r < s) (x : GaussianInt) (hx : x ∈ (B 0).1) (hcoord : x.re = (r:Int)) (hpos : 0 ≤ x.im) (hbound : x.im ≤ (r:Int)) : d x = Nat.dist x.im.toNat r := PathGeometryProof.dSmall0V P natAbsDist dSmall0Root hsmall x - hx hcoord hpos hbound + hx hcoord hpos have dSmall0H (hsmall : r < s) (x : GaussianInt) (hx : x ∈ (B 0).1) (hcoord : x.im = (r:Int)) (hpos : 0 ≤ x.re) (hbound : x.re ≤ (r:Int)) : d x = Nat.dist x.re.toNat r := PathGeometryProof.dSmall0H P natAbsDist dSmall0Root hsmall x - hx hcoord hpos hbound + hx hcoord hpos have dSmall1V (hsmall : r < s) (x : GaussianInt) (hx : x ∈ (B 1).1) (hcoord : x.re = (s:Int)) (hpos : 0 ≤ x.im) (hbound : (s:Int) ≤ x.im) : d x = Nat.dist x.im.toNat s := PathGeometryProof.dSmall1V P natAbsDist dSmall1Root hsmall x - hx hcoord hpos hbound + hx hcoord hpos have dSmall1H (hsmall : r < s) (x : GaussianInt) (hx : x ∈ (B 1).1) (hcoord : x.im = (s:Int)) (hpos : 0 ≤ x.re) (hbound : (s:Int) ≤ x.re) : d x = Nat.dist x.re.toNat s := PathGeometryProof.dSmall1H P natAbsDist dSmall1Root hsmall x - hx hcoord hpos hbound + hx hcoord hpos have dLarge0Nat (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 0).1) : d x = Nat.dist x.re.toNat r + Nat.dist x.im.toNat s := PathGeometryProof.dLarge0Nat P hsum hs hr memB0Large natAbsDist dLarge0Root hlarge x hx diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean index fcf1c005b5..5aeda9edb7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean @@ -121,10 +121,12 @@ private theorem fordCentroid : (by classical exact - ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((GaussianInt) → ((GaussianInt) → - (TileCentroid (FordTile P.q) = ((P.q : Real) / 2, (P.q : Real) / 2)))) ) := by + ∀ (P : FordFareyParameter), + (1 : ℕ) < P.q → + TileCentroid (FordTile P.q) = ((P.q : Real) / 2, (P.q : Real) / 2) + ) := by classical - intro P hP u x + intro P hP let domain : Finset GaussianInt := (Finset.range P.q).product (Finset.range P.q) |>.image (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) @@ -289,10 +291,10 @@ private theorem hrpos : (by classical exact - ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((GaussianInt) → ((GaussianInt) → (0 < - P.q₁))) ) := by + ∀ (P : FordFareyParameter), (1 : ℕ) < P.q → 0 < P.q₁ + ) := by classical - intro P hP u x + intro P hP by_contra hn have hz : P.q₁ = 0 := by omega have hqint : 1 < (P.q : Int) := by exact_mod_cast hP @@ -309,12 +311,19 @@ private theorem rectBoundary : (by classical exact - (FordFareyParameter) → ((GaussianInt) → ((GaussianInt) → (∀ (l : ℤ), ∀ (r : ℤ), ∀ (b : - ℤ), ∀ (t : ℤ), ∀ (z : GaussianInt), z ∈ LatticeVertexBoundary {w : GaussianInt | l ≤ - w.re ∧ w.re ≤ r ∧ b ≤ w.im ∧ w.im ≤ t} ↔ (l ≤ z.re ∧ z.re ≤ r ∧ b ≤ z.im ∧ z.im ≤ t) - ∧ (z.re = l ∨ z.re = r ∨ z.im = b ∨ z.im = t)))) ) := by + ∀ (l : ℤ), + ∀ (r : ℤ), + ∀ (b : ℤ), + ∀ (t : ℤ), + ∀ (z : GaussianInt), + z ∈ + LatticeVertexBoundary + {w : GaussianInt | l ≤ w.re ∧ w.re ≤ r ∧ b ≤ w.im ∧ w.im ≤ t} ↔ + (l ≤ z.re ∧ z.re ≤ r ∧ b ≤ z.im ∧ z.im ≤ t) ∧ + (z.re = l ∨ z.re = r ∨ z.im = b ∨ z.im = t) + ) := by classical - intro P u x l r b t z + intro l r b t z constructor · rintro ⟨hz, w, hw, hre, him⟩ refine ⟨hz, ?_⟩ @@ -956,16 +965,22 @@ private theorem hcardFourFormula : (by classical exact - ∀ (P : FordFareyParameter), (Fin 3 → Bool → ProtoTile) → (∀ (u : GaussianInt), ∀ (x : - GaussianInt), - let y : GaussianInt := x - u - FordBoundaryMultiplicity P y = (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains - P 0) then 1 else 0) + (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) - then 1 else 0) + (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) then - 1 else 0) + (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) then 1 - else 0)) ) := by + ∀ (P : FordFareyParameter), + ∀ (u : GaussianInt), + ∀ (x : GaussianInt), + let y : GaussianInt := x - u + FordBoundaryMultiplicity P y = + (((if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) then 1 + else 0) + + if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) then 1 + else 0) + + if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) then 1 + else 0) + + if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) then 1 + else 0 + ) := by classical - intro P S u x y + intro P u x y classical unfold FordBoundaryMultiplicity simp only [Finset.card_filter, Fin.sum_univ_succ, Fin.sum_univ_zero, add_zero] @@ -1076,29 +1091,70 @@ private theorem noCenteredCountTwo : (by classical exact - ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → (∀ (T : ProtoTile), (Fin 3 → Bool → - ProtoTile) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), - let y : GaussianInt := x - u - (1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ 1 ≤ y.im ∧ y.im ≤ (P.q : Int) - 1) → ((0 < P.q₁) → - (((P.q : Int) = P.q₁ + P.q₂) → ((y ∈ LatticeVertexBoundary - (FordRecursiveVertexDomains P 0) ↔ (0 : Int) ≤ y.re ∧ y.re ≤ P.q₁ ∧ 0 ≤ y.im ∧ y.im ≤ - P.q₁ ∧ (y.re = 0 ∨ y.re = P.q₁ ∨ y.im = 0 ∨ y.im = P.q₁)) → ((y ∈ - LatticeVertexBoundary (FordRecursiveVertexDomains P 1) ↔ (P.q₂ : Int) ≤ y.re ∧ y.re ≤ - P.q ∧ P.q₂ ≤ y.im ∧ y.im ≤ P.q ∧ (y.re = P.q₂ ∨ y.re = P.q ∨ y.im = P.q₂ ∨ y.im = - P.q)) → ((y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) ↔ P.q₁ ≤ y.re ∧ - y.re ≤ P.q ∧ (0 : Int) ≤ y.im ∧ y.im ≤ P.q₂ ∧ (y.re = P.q₁ ∨ y.re = P.q ∨ y.im = 0 ∨ - y.im = P.q₂)) → ((y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) ↔ (0 : - Int) ≤ y.re ∧ y.re ≤ P.q₂ ∧ P.q₁ ≤ y.im ∧ y.im ≤ P.q ∧ (y.re = 0 ∨ y.re = P.q₂ ∨ y.im - = P.q₁ ∨ y.im = P.q)) → ((FordBoundaryMultiplicity P y = (if y ∈ - LatticeVertexBoundary (FordRecursiveVertexDomains P 0) then 1 else 0) + (if y ∈ - LatticeVertexBoundary (FordRecursiveVertexDomains P 1) then 1 else 0) + (if y ∈ - LatticeVertexBoundary (FordRecursiveVertexDomains P 2) then 1 else 0) + (if y ∈ - LatticeVertexBoundary (FordRecursiveVertexDomains P 3) then 1 else 0)) → - (((GaussianRealPoint x = TileCentroid T) → (2 * y.re = (P.q : Int) ∧ 2 * y.im = (P.q - : Int))) → (GaussianRealPoint x = TileCentroid T → FordBoundaryMultiplicity P y ≠ (2 - : ℕ)))))))))))) ) := by + ∀ (P : FordFareyParameter), + ∀ (T : ProtoTile), + ∀ (u : GaussianInt), + ∀ (x : GaussianInt), + let y : GaussianInt := x - u + 1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ 1 ≤ y.im ∧ y.im ≤ (P.q : Int) - 1 → + 0 < P.q₁ → + (P.q : Int) = P.q₁ + P.q₂ → + (y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) ↔ + (0 : Int) ≤ y.re ∧ + y.re ≤ P.q₁ ∧ + 0 ≤ y.im ∧ + y.im ≤ P.q₁ ∧ + (y.re = 0 ∨ y.re = P.q₁ ∨ y.im = 0 ∨ y.im = P.q₁)) → + (y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) ↔ + (P.q₂ : Int) ≤ y.re ∧ + y.re ≤ P.q ∧ + P.q₂ ≤ y.im ∧ + y.im ≤ P.q ∧ + (y.re = P.q₂ ∨ y.re = P.q ∨ y.im = P.q₂ ∨ y.im = P.q)) → + (y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) ↔ + P.q₁ ≤ y.re ∧ + y.re ≤ P.q ∧ + (0 : Int) ≤ y.im ∧ + y.im ≤ P.q₂ ∧ + (y.re = P.q₁ ∨ y.re = P.q ∨ y.im = 0 ∨ y.im = P.q₂)) → + (y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) ↔ + (0 : Int) ≤ y.re ∧ + y.re ≤ P.q₂ ∧ + P.q₁ ≤ y.im ∧ + y.im ≤ P.q ∧ + (y.re = 0 ∨ y.re = P.q₂ ∨ y.im = P.q₁ ∨ y.im = P.q)) → + (FordBoundaryMultiplicity P y = + (((if + y ∈ + LatticeVertexBoundary + (FordRecursiveVertexDomains P 0) then + 1 + else 0) + + if + y ∈ + LatticeVertexBoundary + (FordRecursiveVertexDomains P 1) then + 1 + else 0) + + if + y ∈ + LatticeVertexBoundary + (FordRecursiveVertexDomains P 2) then + 1 + else 0) + + if + y ∈ + LatticeVertexBoundary + (FordRecursiveVertexDomains P 3) then + 1 + else 0) → + (GaussianRealPoint x = TileCentroid T → + 2 * y.re = (P.q : Int) ∧ 2 * y.im = (P.q : Int)) → + GaussianRealPoint x = TileCentroid T → + FordBoundaryMultiplicity P y ≠ (2 : ℕ) + ) := by classical - intro P hP T S u x y hbounds hrpos hqsum domain0 domain1 domain2 domain3 hcardFourFormula + intro P T u x y hbounds hrpos hqsum domain0 domain1 domain2 domain3 hcardFourFormula centerTwice hc obtain ⟨h2re, h2im⟩ := centerTwice hc by_cases heq : P.q₁ = P.q₂ @@ -1431,16 +1487,24 @@ private theorem multiplicityBound : (by classical exact - ∀ (P : FordFareyParameter), (Fin 3 → Bool → ProtoTile) → (∀ (u : GaussianInt), ∀ (x : - GaussianInt), - let y : GaussianInt := x - u - (FordBoundaryMultiplicity P y = (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains - P 0) then 1 else 0) + (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) - then 1 else 0) + (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) then - 1 else 0) + (if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) then 1 - else 0)) → (FordBoundaryMultiplicity P y ≤ 4)) ) := by + ∀ (P : FordFareyParameter), + ∀ (u : GaussianInt), + ∀ (x : GaussianInt), + let y : GaussianInt := x - u + (FordBoundaryMultiplicity P y = + (((if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) then 1 + else 0) + + if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 1) then + 1 + else 0) + + if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 2) then 1 + else 0) + + if y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 3) then 1 + else 0) → + FordBoundaryMultiplicity P y ≤ 4 + ) := by classical - intro P S u x y hcardFourFormula + intro P u x y hcardFourFormula rw [hcardFourFormula] split_ifs <;> omega @@ -1566,7 +1630,7 @@ theorem P4120T1FordGeometry have cellCanonical (z : GaussianInt) := FordTileGeometry.cellCanonical P T u hcells z have squareCell (z : GaussianInt) := FordTileGeometry.squareCell P z have hbounds := FordTileGeometry.hbounds P T u x cells cellCanonical squareCell - have fordCentroid := FordTileGeometry.fordCentroid P hP u x + have fordCentroid := FordTileGeometry.fordCentroid P hP obtain ⟨_, _, hrec⟩ := FordTileRecursiveIdentification P obtain ⟨_, ⟨Sc, hSc, hcover, h00, h01, h10, h11, h20, h20a, h21, h21a⟩⟩ := hrec hP @@ -1584,11 +1648,11 @@ theorem P4120T1FordGeometry hScTranslated hparentCentroid i s have hparentCells (i : Fin 3) (s : Bool) := FordTileGeometry.hparentCells P T S u hS Sc hScTranslated hparentCentroid i s - have hrpos := FordTileGeometry.hrpos P hP u x + have hrpos := FordTileGeometry.hrpos P hP have hr : (P.q₁ : Int) > 0 := by exact_mod_cast hrpos have ht : (P.q₂ : Int) > 0 := by exact_mod_cast P.q₂_pos have hqsum : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q - have rectBoundary (l r b t : Int) (z : GaussianInt) := FordTileGeometry.rectBoundary P u x l r + have rectBoundary (l r b t : Int) (z : GaussianInt) := FordTileGeometry.rectBoundary l r b t z have boundaryTranslation (A : ProtoTile) (v z : GaussianInt) := FordTileGeometry.boundaryTranslation A v z @@ -1627,7 +1691,7 @@ theorem P4120T1FordGeometry boundaryTranslation have hcardSix := FordTileGeometry.hcardSix S x have hcardFour := FordTileGeometry.hcardFour P u x - have hcardFourFormula := FordTileGeometry.hcardFourFormula P S u x + have hcardFourFormula := FordTileGeometry.hcardFourFormula P u x have hcount := FordTileGeometry.hcount P S u x label0 label1 label2 label3 lineTrue lineFalse hcardSix hcardFourFormula have rootCentroid := FordTileGeometry.rootCentroid P T u fordCentroid hrootObs @@ -1636,7 +1700,7 @@ theorem P4120T1FordGeometry have centerTwice (hc : GaussianRealPoint x = TileCentroid T) := FordTileGeometry.centerTwice P T u x centerCoords hc have noCenteredCountTwo (hc : GaussianRealPoint x = TileCentroid T) := - FordTileGeometry.noCenteredCountTwo P hP T S u x hbounds hrpos hqsum domain0 domain1 + FordTileGeometry.noCenteredCountTwo P T u x hbounds hrpos hqsum domain0 domain1 domain2 domain3 hcardFourFormula centerTwice hc have countFourConclusion (hk : Nat.card {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} = 4) := FordTileGeometry.countFourConclusion P @@ -1655,7 +1719,7 @@ theorem P4120T1FordGeometry (ha : x ∈ BoundaryFootprintVertices (S a.1 a.2)) (hb : x ∈ BoundaryFootprintVertices (S b.1 b.2)) := FordTileGeometry.twoBoundaryCount S x a b hab ha hb - have multiplicityBound := FordTileGeometry.multiplicityBound P S u x hcardFourFormula + have multiplicityBound := FordTileGeometry.multiplicityBound P u x hcardFourFormula have descent (hno : ¬ (Nat.card {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} = 2 ∨ Nat.card {a : Fin 3 × Bool // diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean index c966749035..9a43499381 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean @@ -34,12 +34,17 @@ private theorem hpos : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (((0 : ℤ) < (q - (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin (3 - : ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) - → (∀ i : Fin 3, Bool → 0 < (q i.succ).1)) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + BandOrderedGeneralConfiguration q → + ((0 : ℤ) < (q (0 : Fin (4 : ℕ))).1 ∧ + (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ + ∀ (i : Fin (3 : ℕ)), + ∀ (j : Fin (3 : ℕ)), + (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) → + ∀ i : Fin 3, 0 < (q i.succ).1 + ) := by classical - intro q cfg hcurv i s + intro q cfg hcurv i have hn := hcurv.2.1 i have hne0 := cfg.noLine i.succ by_contra h @@ -1523,8 +1528,12 @@ theorem P4120T1GeneralDescent have parentOwner_boundary (j : Fin 4) : x ∈ BoundaryFootprintVertices (cert.P (parentOwner j).1 (parentOwner j).2) := - (GeneralDescentGeometry.hnoInterior q cfg C T cert x (GeneralDescentGeometry.hpos q cfg - hcurv) hnoWitness) _ _ (incident_footprint j _ (parentOwner_spec j)) + (GeneralDescentGeometry.hnoInterior q cfg C T cert x ((show + ∀ i : Fin 3, Bool → 0 < (q i.succ).1 + from by + intro i s + exact GeneralDescentGeometry.hpos q cfg hcurv i)) hnoWitness) _ _ (incident_footprint + j _ (parentOwner_spec j)) have another_parent := GeneralDescentGeometry.another_parent q cfg C T cert x (GeneralDescentGeometry.all_incident_not_boundary x) sourceParent parentOwner_spec parentOwner_boundary diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean index 66367711fd..aa678b7c77 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean @@ -189,12 +189,14 @@ private theorem translated_ford_bounds : (by classical exact - (FordFareyParameter) → ((BandCircle) → ((Fin (3 : ℕ)) → ((GaussianInt) → ((GaussianInt) → - (∀ (n : Nat), ∀ (w : GaussianInt), ∀ (c : GaussianInt), (c ∈ (TileTranslation - (FordTile n) w).cells) → (0 ≤ (c-w).re ∧ (c-w).re < n ∧ 0 ≤ (c-w).im ∧ (c-w).im < - n)))))) ) := by - classical - intro P Ci i u x n w c hc + ∀ (n : Nat), + ∀ (w : GaussianInt), + ∀ (c : GaussianInt), + c ∈ (TileTranslation (FordTile n) w).cells → + 0 ≤ (c - w).re ∧ (c - w).re < n ∧ 0 ≤ (c - w).im ∧ (c - w).im < n + ) := by + classical + intro n w c hc change c ∈ (FordCellDomain n).image (GaussianTranslation w) at hc obtain ⟨t, ht, htc⟩ := Finset.mem_image.mp hc change t ∈ FordCellDomain n at ht @@ -369,17 +371,22 @@ private theorem hz_low : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (i : Fin (3 : ℕ)), ∀ (u : GaussianInt), ∀ - (x : GaussianInt), ((if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - - u).im) → ( - let z : GaussianInt := - if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) - then x else x - ⟨0, 1⟩ - (((x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x)) → (((¬(x - u).im = (if - i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x - ⟨0, 1⟩)) → ((if i = 0 then (P.q₁ : - Int) else P.q₂) ≤ (z-u).im)))) ) := by - classical - intro P Ci i u x hxl z z_low z_other + ∀ (P : FordFareyParameter), + ∀ (i : Fin (3 : ℕ)), + ∀ (u : GaussianInt), + ∀ (x : GaussianInt), + (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ + (x - u).im → + let z : GaussianInt := + if (x - u).im = if i = 0 then (P.q₁ : Int) else P.q₂ then x + else x - ⟨0, 1⟩ + (((x - u).im = if i = 0 then (P.q₁ : Int) else P.q₂) → z = x) → + ((¬(x - u).im = if i = 0 then (P.q₁ : Int) else P.q₂) → + z = x - ⟨0, 1⟩) → + (if i = 0 then (P.q₁ : Int) else P.q₂) ≤ (z - u).im + ) := by + classical + intro P i u x hxl z z_low z_other by_cases hlow : (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) · rw [z_low hlow] exact hxl @@ -395,16 +402,22 @@ private theorem hz_high : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (i : Fin (3 : ℕ)), ∀ (u : GaussianInt), ∀ - (x : GaussianInt), ((x - u).im ≤ (↑P.q : ℤ)) → (((if i = 0 then (P.q₁ : Int) else - P.q₂) < P.q) → ( - let z : GaussianInt := - if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) - then x else x - ⟨0, 1⟩ - (((x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x)) → (((¬(x - u).im = (if - i = 0 then (P.q₁ : Int) else P.q₂)) → (z = x - ⟨0, 1⟩)) → ((z-u).im < P.q))))) ) := by - classical - intro P Ci i u x hxu lower_lt_q z z_low z_other + ∀ (P : FordFareyParameter), + ∀ (i : Fin (3 : ℕ)), + ∀ (u : GaussianInt), + ∀ (x : GaussianInt), + (x - u).im ≤ (↑P.q : ℤ) → + (if i = 0 then (P.q₁ : Int) else P.q₂) < P.q → + let z : GaussianInt := + if (x - u).im = if i = 0 then (P.q₁ : Int) else P.q₂ then x + else x - ⟨0, 1⟩ + (((x - u).im = if i = 0 then (P.q₁ : Int) else P.q₂) → z = x) → + ((¬(x - u).im = if i = 0 then (P.q₁ : Int) else P.q₂) → + z = x - ⟨0, 1⟩) → + (z - u).im < P.q + ) := by + classical + intro P i u x hxu lower_lt_q z z_low z_other by_cases hlow : (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) · rw [z_low hlow] simpa [hlow] using lower_lt_q @@ -978,10 +991,13 @@ private theorem hxAt721 : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), - ((x-u).re = P.q) → (((x-u).im = P.q₁) → (x = u + ⟨(P.q : Int), (P.q₁ : Int)⟩))) ) := by + ∀ (P : FordFareyParameter), + ∀ (u : GaussianInt), + ∀ (x : GaussianInt), + (x - u).re = P.q → (x - u).im = P.q₁ → x = u + ⟨(P.q : Int), (P.q₁ : Int)⟩ + ) := by classical - intro P Ci u x hxre hxim + intro P u x hxre hxim ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] at * <;> omega @@ -989,11 +1005,15 @@ private theorem hce : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), (x - = u + ⟨(P.q : Int), (P.q₁ : Int)⟩) → ((((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1) → - (x - ⟨0,1⟩ = (u + ⟨(P.q : Int),0⟩) + ⟨0, ((P.q₁ - 1 : Nat) : Int)⟩))) ) := by - classical - intro P Ci u x hx hnatcast + ∀ (P : FordFareyParameter), + ∀ (u : GaussianInt), + ∀ (x : GaussianInt), + x = u + ⟨(P.q : Int), (P.q₁ : Int)⟩ → + ((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1 → + x - ⟨0, 1⟩ = u + ⟨(P.q : Int), 0⟩ + ⟨0, ((P.q₁ - 1 : Nat) : Int)⟩ + ) := by + classical + intro P u x hx hnatcast rw [hx] ext <;> simp [hnatcast, Zsqrtd.re_add, Zsqrtd.im_add, Zsqrtd.re_sub, Zsqrtd.im_sub]; omega @@ -1091,13 +1111,17 @@ private theorem hmcAt766 : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), (x - = u + ⟨(P.q : Int), (P.q₁ : Int)⟩) → ((((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1) → ( - let m : GaussianInt := x - 1 - ⟨0,1⟩ - (((P.q - 1 : Nat) : Int) = (P.q : Int) - 1) → (m = u + ⟨((P.q - 1 : Nat) : Int), ((P.q₁ - - 1 : Nat) : Int)⟩)))) ) := by - classical - intro P Ci u x hx hnatcast m hqcast + ∀ (P : FordFareyParameter), + ∀ (u : GaussianInt), + ∀ (x : GaussianInt), + x = u + ⟨(P.q : Int), (P.q₁ : Int)⟩ → + ((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1 → + let m : GaussianInt := x - 1 - ⟨0, 1⟩ + ((P.q - 1 : Nat) : Int) = (P.q : Int) - 1 → + m = u + ⟨((P.q - 1 : Nat) : Int), ((P.q₁ - 1 : Nat) : Int)⟩ + ) := by + classical + intro P u x hx hnatcast m hqcast ext <;> simp [m, hx, hqcast, hnatcast, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] <;> omega @@ -1219,10 +1243,13 @@ private theorem hxAt816 : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), - ((x-u).re = 0) → (((x-u).im = P.q₂) → (x = u + ⟨0, (P.q₂ : Int)⟩))) ) := by + ∀ (P : FordFareyParameter), + ∀ (u : GaussianInt), + ∀ (x : GaussianInt), + (x - u).re = 0 → (x - u).im = P.q₂ → x = u + ⟨0, (P.q₂ : Int)⟩ + ) := by classical - intro P Ci u x hxre hxim + intro P u x hxre hxim ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] at * <;> omega @@ -1230,12 +1257,16 @@ private theorem hmcAt823 : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), (x - = u + ⟨0, (P.q₂ : Int)⟩) → ((((P.q₂ - 1 : Nat) : Int) = (P.q₂ : Int) - 1) → ( - let m : GaussianInt := x - ⟨0,1⟩ - m = u + ⟨0, ((P.q₂ - 1 : Nat) : Int)⟩))) ) := by - classical - intro P Ci u x hx hncast m + ∀ (P : FordFareyParameter), + ∀ (u : GaussianInt), + ∀ (x : GaussianInt), + x = u + ⟨0, (P.q₂ : Int)⟩ → + ((P.q₂ - 1 : Nat) : Int) = (P.q₂ : Int) - 1 → + let m : GaussianInt := x - ⟨0, 1⟩ + m = u + ⟨0, ((P.q₂ - 1 : Nat) : Int)⟩ + ) := by + classical + intro P u x hx hncast m ext <;> simp [m, hx, hncast, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add]; omega @@ -1243,13 +1274,19 @@ private theorem hncAt832 : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), (x - = u + ⟨0, (P.q₂ : Int)⟩) → ((((P.q₂ - 1 : Nat) : Int) = (P.q₂ : Int) - 1) → ( - let n : GaussianInt := x - 1 - ⟨0,1⟩ - n = (u + ⟨-(P.q₂ : Int),0⟩) + ⟨((P.q₂ - 1 : Nat) : Int), ((P.q₂ - 1 : Nat) : Int)⟩))) ) + ∀ (P : FordFareyParameter), + ∀ (u : GaussianInt), + ∀ (x : GaussianInt), + x = u + ⟨0, (P.q₂ : Int)⟩ → + ((P.q₂ - 1 : Nat) : Int) = (P.q₂ : Int) - 1 → + let n : GaussianInt := x - 1 - ⟨0, 1⟩ + n = + u + ⟨-(P.q₂ : Int), 0⟩ + + ⟨((P.q₂ - 1 : Nat) : Int), ((P.q₂ - 1 : Nat) : Int)⟩ + ) := by classical - intro P Ci u x hx hncast' n + intro P u x hx hncast' n ext <;> simp [n, hx, hncast', Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add] <;> omega @@ -1458,19 +1495,36 @@ private theorem hdisET'At944 : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (T' : ProtoTile), ∀ (u : GaussianInt), ∀ - (Rplus : ProtoTile), (GaussianInt) → ((∀ (n : Nat), ∀ (m : Nat), ∀ (w : GaussianInt), - ∀ (v : GaussianInt), (w.re + n ≤ v.re) → (Disjoint (TileTranslation (FordTile n) - w).cells (TileTranslation (FordTile m) v).cells)) → ((T'.cells = (TileTranslation - (FordTile P.q) (u + if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (⟨(↑P.q : ℤ), - (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells) - → ((Rplus.cells = (TileTranslation (FordTile (if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : - ℕ)) then P.q₁ else P.q₂)) (u + if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then (⟨(↑P.q₂ - : ℤ), (↑P.q : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : - GaussianInt))).cells) → (((P.q₁ : Int) + P.q₂ = P.q) → (Disjoint Rplus.cells - T'.cells)))))) ) := by - classical - intro P Ci T' u Rplus x ford_disjoint_re hc' hRp hqsum + ∀ (P : FordFareyParameter), + ∀ (T' : ProtoTile), + ∀ (u : GaussianInt), + ∀ (Rplus : ProtoTile), + (∀ (n : Nat), + ∀ (m : Nat), + ∀ (w : GaussianInt), + ∀ (v : GaussianInt), + w.re + n ≤ v.re → + Disjoint (TileTranslation (FordTile n) w).cells + (TileTranslation (FordTile m) v).cells) → + T'.cells = + (TileTranslation (FordTile P.q) + (u + + if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then + (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) + else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells → + Rplus.cells = + (TileTranslation + (FordTile + (if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then P.q₁ + else P.q₂)) + (u + + if (0 : Fin (3 : ℕ)) = (0 : Fin (3 : ℕ)) then + (⟨(↑P.q₂ : ℤ), (↑P.q : ℤ)⟩ : GaussianInt) + else (⟨-(↑P.q₂ : ℤ), (0 : ℤ)⟩ : GaussianInt))).cells → + (P.q₁ : Int) + P.q₂ = P.q → Disjoint Rplus.cells T'.cells + ) := by + classical + intro P T' u Rplus ford_disjoint_re hc' hRp hqsum have hgap : (u + ⟨(P.q₂ : Int), (P.q : Int)⟩).re + P.q₁ ≤ (u + ⟨(P.q : Int), (P.q₁ : Int)⟩).re := by @@ -1486,11 +1540,12 @@ private theorem hq2lt : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (((0 : ℕ) < P.q₁) → ((GaussianInt) → - ((GaussianInt) → ((((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1) → (P.q₂ < P.q))))) ) + ∀ (P : FordFareyParameter), + (0 : ℕ) < P.q₁ → ((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1 → P.q₂ < P.q + ) := by classical - intro P Ci hrpos u x hq1cast + intro P hrpos hq1cast rw [P.sum_q] omega @@ -1669,10 +1724,13 @@ private theorem hxAt1035 : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), - (x.re - u.re = 0) → ((x.im = u.im + P.q) → (x = u + ⟨0, (P.q : Int)⟩))) ) := by + ∀ (P : FordFareyParameter), + ∀ (u : GaussianInt), + ∀ (x : GaussianInt), + x.re - u.re = 0 → x.im = u.im + P.q → x = u + ⟨0, (P.q : Int)⟩ + ) := by classical - intro P Ci u x hxre' hxim'' + intro P u x hxre' hxim'' ext · simp only [Zsqrtd.re_add] omega @@ -1684,27 +1742,36 @@ private theorem hq1castAt1045 : classical exact ∀ (P : FordFareyParameter), - (((0 : ℕ) < P.q₁) → (∀ (u : GaussianInt), ∀ (x - : GaussianInt), - ((x.im - u.im = P.q) → (((P.q₁ : Int) + - P.q₂ = P.q) → ((((P.q - 1 : Nat) : Int) = (P.q : Int) - 1) → (((P.q₁ - 1 : Nat) : - Int) = (P.q₁ : Int) - 1)))))) ) := by - classical - intro P hrpos u x hxim' hqsum hqcast + (0 : ℕ) < P.q₁ → + GaussianInt → + GaussianInt → + (P.q₁ : Int) + P.q₂ = P.q → + ((P.q - 1 : Nat) : Int) = (P.q : Int) - 1 → + ((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1 + ) := by + classical + intro P hrpos u x hqsum hqcast exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q₁) private theorem hmcAt1049 : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (u : GaussianInt), ∀ (x : GaussianInt), - (x.re = u.re) → ((x.im = u.im + P.q) → (((P.q₁ : Int) + P.q₂ = P.q) → ((((P.q - 1 : - Nat) : Int) = (P.q : Int) - 1) → ( - let m : GaussianInt := x - 1 - m = (u + ⟨-(P.q : Int), (P.q₂ : Int)⟩) + ⟨((P.q - 1 : Nat) : Int), (P.q₁ : Int)⟩))))) ) + ∀ (P : FordFareyParameter), + ∀ (u : GaussianInt), + ∀ (x : GaussianInt), + x.re = u.re → + x.im = u.im + P.q → + (P.q₁ : Int) + P.q₂ = P.q → + ((P.q - 1 : Nat) : Int) = (P.q : Int) - 1 → + let m : GaussianInt := x - 1 + m = + u + ⟨-(P.q : Int), (P.q₂ : Int)⟩ + + ⟨((P.q - 1 : Nat) : Int), (P.q₁ : Int)⟩ + ) := by classical - intro P Ci u x hxre'' hxim'' hqsum hqcast m + intro P u x hxre'' hxim'' hqsum hqcast m ext · simp only [m, Zsqrtd.re_sub, Zsqrtd.re_one, Zsqrtd.re_add] @@ -1780,15 +1847,26 @@ private theorem hdisET'At1085 : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (T' : ProtoTile), ∀ (u : GaussianInt), ∀ - (Rminus : ProtoTile), (GaussianInt) → ((∀ (n : Nat), ∀ (m : Nat), ∀ (w : - GaussianInt), ∀ (v : GaussianInt), (w.re + n ≤ v.re) → (Disjoint (TileTranslation - (FordTile n) w).cells (TileTranslation (FordTile m) v).cells)) → ((Rminus.cells = - (TileTranslation (FordTile P.q₂) (u + ⟨0, (P.q : Int)⟩)).cells) → ((T'.cells = - (TileTranslation (FordTile P.q) (u + ⟨-(P.q : Int), (P.q₂ : Int)⟩)).cells) → - (Disjoint Rminus.cells T'.cells))))) ) := by - classical - intro P Ci T' u Rminus x ford_disjoint_re hRm1 hc'1 + ∀ (P : FordFareyParameter), + ∀ (T' : ProtoTile), + ∀ (u : GaussianInt), + ∀ (Rminus : ProtoTile), + (∀ (n : Nat), + ∀ (m : Nat), + ∀ (w : GaussianInt), + ∀ (v : GaussianInt), + w.re + n ≤ v.re → + Disjoint (TileTranslation (FordTile n) w).cells + (TileTranslation (FordTile m) v).cells) → + Rminus.cells = + (TileTranslation (FordTile P.q₂) (u + ⟨0, (P.q : Int)⟩)).cells → + T'.cells = + (TileTranslation (FordTile P.q) + (u + ⟨-(P.q : Int), (P.q₂ : Int)⟩)).cells → + Disjoint Rminus.cells T'.cells + ) := by + classical + intro P T' u Rminus ford_disjoint_re hRm1 hc'1 have hgap : (u + ⟨-(P.q : Int), (P.q₂ : Int)⟩).re + P.q ≤ (u + ⟨0, (P.q : Int)⟩).re := by @@ -2099,7 +2177,7 @@ private theorem lowerBoundary : · subst i have hxre : (x-u).re = P.q := by simpa using hxr have hxim : (x-u).im = P.q₁ := hlow - have hx := EdgeSectorGeometry.hxAt721 P Ci u x hxre hxim + have hx := EdgeSectorGeometry.hxAt721 P u x hxre hxim have hnatcast : ((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1 := by exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q₁) have hRmem : Rminus ∈ tiles := List.mem_of_head? hf.2.1 @@ -2107,7 +2185,7 @@ private theorem lowerBoundary : have hEtrans := translated_ford_cell P.q₁ 0 (P.q₁-1) (u + ⟨(P.q : Int),0⟩) (by omega) (by omega) have hEcell : x - ⟨0,1⟩ ∈ Rminus.cells := EdgeSectorGeometry.hEcellAt735 P u Rminus x hRm - (EdgeSectorGeometry.hce P Ci u x hx hnatcast) hEtrans + (EdgeSectorGeometry.hce P u x hx hnatcast) hEtrans have hEidx : x - ⟨0,1⟩ ∈ (PP.tile e).cells := by simpa [he] using hEcell have hdisET := EdgeSectorGeometry.hdisETAt740 P T u hc Rminus ford_disjoint_re hRm @@ -2120,7 +2198,7 @@ private theorem lowerBoundary : have hqcast : ((P.q - 1 : Nat) : Int) = (P.q : Int) - 1 := by exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q) have hq1leq : P.q₁ ≤ P.q := by omega - have hmc := EdgeSectorGeometry.hmcAt766 P Ci u x hx hnatcast hqcast + have hmc := EdgeSectorGeometry.hmcAt766 P u x hx hnatcast hqcast have hmTtrans := translated_ford_cell P.q (P.q - 1) (P.q₁ - 1) u (by omega) (by omega) have hmT : m ∈ T.cells := EdgeSectorGeometry.hmTAt772 P T u hc x hmc hmTtrans @@ -2144,12 +2222,12 @@ private theorem lowerBoundary : · subst i have hxre : (x-u).re = 0 := by simpa using hxr have hxim : (x-u).im = P.q₂ := hlow - have hx := EdgeSectorGeometry.hxAt816 P Ci u x hxre hxim + have hx := EdgeSectorGeometry.hxAt816 P u x hxre hxim have hq2pos : 0 < P.q₂ := P.q₂_pos have hncast : ((P.q₂ - 1 : Nat) : Int) = (P.q₂ : Int) - 1 := by exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q₂) let m : GaussianInt := x - ⟨0,1⟩ - have hmc := EdgeSectorGeometry.hmcAt823 P Ci u x hx hncast + have hmc := EdgeSectorGeometry.hmcAt823 P u x hx hncast have htc : m = u + ⟨0, ((P.q₂ - 1 : Nat) : Int)⟩ := hmc have hmTtrans := translated_ford_cell P.q 0 (P.q₂ - 1) u (by omega) (by omega) @@ -2157,8 +2235,8 @@ private theorem lowerBoundary : have hncast' : ((P.q₂ - 1 : Nat) : Int) = (P.q₂ : Int) - 1 := hncast let n : GaussianInt := x - 1 - ⟨0,1⟩ have hnc : n = (u + ⟨-(P.q₂ : Int),0⟩) + - ⟨((P.q₂ - 1 : Nat) : Int), ((P.q₂ - 1 : Nat) : Int)⟩ := EdgeSectorGeometry.hncAt832 P - Ci u x hx hncast' + ⟨((P.q₂ - 1 : Nat) : Int), ((P.q₂ - 1 : Nat) : Int)⟩ := EdgeSectorGeometry.hncAt832 P u + x hx hncast' have hRmem : Rplus ∈ reverseTiles := List.mem_of_head? hr.2.1 obtain ⟨e, he⟩ := regular_index Rplus (hr.2.2.2.2.1 Rplus hRmem) @@ -2249,7 +2327,7 @@ theorem P4158T1EdgeSectorSelection : (PeriodicTileIndexedMultiplicityOne PP c).unique ha hb have vertical_edge_cells := EdgeSectorGeometry.vertical_edge_cells (EdgeSectorGeometry.pair_eq_iff) - have translated_ford_bounds := EdgeSectorGeometry.translated_ford_bounds P Ci i u x + have translated_ford_bounds := EdgeSectorGeometry.translated_ford_bounds have translated_ford_cell := EdgeSectorGeometry.translated_ford_cell have ford_disjoint_re := EdgeSectorGeometry.ford_disjoint_re translated_ford_bounds have ford_disjoint_im := EdgeSectorGeometry.ford_disjoint_im translated_ford_bounds @@ -2263,8 +2341,8 @@ theorem P4158T1EdgeSectorSelection : have z_other := EdgeSectorGeometry.z_other P i u x have z_incident := EdgeSectorGeometry.z_incident P i u x z_low z_other have hz_re := EdgeSectorGeometry.hz_re P i u x hxr z_low z_other - have hz_low := EdgeSectorGeometry.hz_low P Ci i u x hxl z_low z_other - have hz_high := EdgeSectorGeometry.hz_high P Ci i u x hxu lower_lt_q z_low z_other + have hz_low := EdgeSectorGeometry.hz_low P i u x hxl z_low z_other + have hz_high := EdgeSectorGeometry.hz_high P i u x hxu lower_lt_q z_low z_other obtain ⟨U, V, g, k, hUint, hVint, hUz, hVk, hAg, hAk, hEdgeU, hEdgeV⟩ := hedges z hz_re hz_low hz_high have hUmem : U ∈ tiles := (List.of_mem_zip hUz).1 @@ -2346,10 +2424,10 @@ theorem P4158T1EdgeSectorSelection : have hEcell : n ∈ Rplus.cells := by rw [hRp, hnc]; exact hEtrans have hEidx : n ∈ (PP.tile e).cells := by simpa [he] using hEcell have hdisET := EdgeSectorGeometry.hdisETAt940 P T u hc Rplus ford_disjoint_im hRp - have hdisET' := EdgeSectorGeometry.hdisET'At944 P Ci T' u Rplus x ford_disjoint_re hc' + have hdisET' := EdgeSectorGeometry.hdisET'At944 P T' u Rplus ford_disjoint_re hc' hRp hqsum have hrootCell := translated_ford_cell P.q 0 P.q₂ - (u + ⟨(P.q : Int), (P.q₁ : Int)⟩) (by omega) (EdgeSectorGeometry.hq2lt P Ci hrpos u x + (u + ⟨(P.q : Int), (P.q₁ : Int)⟩) (by omega) (EdgeSectorGeometry.hq2lt P hrpos hq1cast) have hxT' := EdgeSectorGeometry.hxT' P T' u x hc' (EdgeSectorGeometry.hxroot P u x hx hqsum) hrootCell @@ -2379,14 +2457,14 @@ theorem P4158T1EdgeSectorSelection : simpa [Zsqrtd.im_sub] using htop have hxre'' : x.re = u.re := by omega have hxim'' : x.im = u.im + P.q := by omega - have hx := EdgeSectorGeometry.hxAt1035 P Ci u x hxre' hxim'' + have hx := EdgeSectorGeometry.hxAt1035 P u x hxre' hxim'' have hqsum : (P.q₁ : Int) + P.q₂ = P.q := by exact_mod_cast P.sum_q.symm have hqcast : ((P.q - 1 : Nat) : Int) = (P.q : Int) - 1 := by exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q) - have hq1cast := EdgeSectorGeometry.hq1castAt1045 P hrpos u x hxim' hqsum hqcast + have hq1cast := EdgeSectorGeometry.hq1castAt1045 P hrpos u x hqsum hqcast let m : GaussianInt := x - 1 - have hmc := EdgeSectorGeometry.hmcAt1049 P Ci u x hxre'' hxim'' hqsum hqcast + have hmc := EdgeSectorGeometry.hmcAt1049 P u x hxre'' hxim'' hqsum hqcast have hRmem : Rminus ∈ tiles := List.mem_of_head? hf.2.1 obtain ⟨e, he⟩ := regular_index Rminus (hf.2.2.2.2.1 Rminus hRmem) @@ -2398,7 +2476,7 @@ theorem P4158T1EdgeSectorSelection : hEtrans have hEidx : x ∈ (PP.tile e).cells := by simpa [he] using hEcell have hdisET := EdgeSectorGeometry.hdisETAt1079 P T u hc Rminus ford_disjoint_im hRm1 - have hdisET' := EdgeSectorGeometry.hdisET'At1085 P Ci T' u Rminus x ford_disjoint_re + have hdisET' := EdgeSectorGeometry.hdisET'At1085 P T' u Rminus ford_disjoint_re hRm1 hc'1 have httrans := translated_ford_cell P.q (P.q - 1) P.q₁ (u + ⟨-(P.q : Int), (P.q₂ : Int)⟩) (by omega) (P.q₁_lt) diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean index 07a21fd173..cf2cb61bd9 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean @@ -34,9 +34,10 @@ private theorem hq1 : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((P.q₂ < P.q₁) → (1 < P.q₁)) ) := by + ∀ (P : FordFareyParameter), P.q₂ < P.q₁ → 1 < P.q₁ + ) := by classical - intro P Ci horder + intro P horder have hq2 := P.q₂_pos omega @@ -44,9 +45,10 @@ private theorem hqgt : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((1 < P.q₁) → (1 < P.q)) ) := by + ∀ (P : FordFareyParameter), 1 < P.q₁ → 1 < P.q + ) := by classical - intro P Ci hq1 + intro P hq1 have hsum := P.sum_q have hq2 := P.q₂_pos omega @@ -329,18 +331,17 @@ private theorem hvsol : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((P.q₂ < P.q₁) → ((1 < P.q₁) → ((P.p₁ * (P.q₂ - : Int) - (P.q₁ : Int) * P.p₂ = 1) → ((Nat.Coprime P.q₁ P.p₁.natAbs) → ( - let w := BandVectors.1 (FordRecursiveQuadruple P 3) - (FordRecursiveQuadruple P 2) - let x := BandVectors.1 (FordRecursiveQuadruple P 1) - (FordRecursiveQuadruple P 3) - let y := BandVectors.1 (FordRecursiveQuadruple P 2) - (FordRecursiveQuadruple P 1) - (w + x + y = 0) → ((x - (⟨0, 1⟩ : GaussianInt) * y = ⟨P.q, P.q₁⟩) → ((y - (⟨0, 1⟩ : - GaussianInt) * w = ⟨-(P.q : Int), P.q₂⟩) → (w = ⟨0, -(P.q₂ : Int)⟩)))))))) ) := by + ∀ (P : FordFareyParameter), + let w := BandVectors.1 (FordRecursiveQuadruple P 3) (FordRecursiveQuadruple P 2) + let x := BandVectors.1 (FordRecursiveQuadruple P 1) (FordRecursiveQuadruple P 3) + let y := BandVectors.1 (FordRecursiveQuadruple P 2) (FordRecursiveQuadruple P 1) + w + x + y = 0 → + x - (⟨0, 1⟩ : GaussianInt) * y = ⟨P.q, P.q₁⟩ → + y - (⟨0, 1⟩ : GaussianInt) * w = ⟨-(P.q : Int), P.q₂⟩ → + w = ⟨0, -(P.q₂ : Int)⟩ + ) := by classical - intro P Ci horder hq1 hcross hcop w x y hvsum hvfirst hvsecond + intro P w x y hvsum hvfirst hvsecond have solve : ∀ (r s : Int) (w a b : GaussianInt), w + a + b = 0 → a - (⟨0, 1⟩ : GaussianInt) * b = ⟨r + s, r⟩ → @@ -375,12 +376,13 @@ private theorem fordCentroid : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((P.q₂ < P.q₁) → ((1 < P.q₁) → ((P.p₁ * (P.q₂ - : Int) - (P.q₁ : Int) * P.p₂ = 1) → ((Nat.Coprime P.q₁ P.p₁.natAbs) → (∀ (n : ℕ), (0 - : ℕ) < n → TileCentroid (FordTile n) = ((↑n : ℝ) / (2 : ℝ), (↑n : ℝ) / (2 : ℝ))))))) - ) := by + FordFareyParameter → + ∀ (n : ℕ), + (0 : ℕ) < n → + TileCentroid (FordTile n) = ((↑n : ℝ) / (2 : ℝ), (↑n : ℝ) / (2 : ℝ)) + ) := by classical - intro P Ci horder hq1 hcross hcop n hn + intro P n hn let D : Finset GaussianInt := (Finset.range n).product (Finset.range n) |>.image (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) @@ -601,17 +603,23 @@ private theorem hUCcent : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (u : - GaussianInt), (1 < P.q₁) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), - let U := S 0 false - (P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1) → ((Nat.Coprime P.q₁ P.p₁.natAbs) → ((∀ - (n : Nat), (0 < n) → (TileCentroid (FordTile n) = ((n : Real) / 2, (n : Real) / 2))) → ( - let Uc := TileTranslation (FordTile P.q₁) (u + ⟨P.q₂, P.q₂⟩) - (TileCentroid T = TileCentroid (TileTranslation (FordTile P.q) u)) → ((TileCentroid U - - TileCentroid T = ((P.q₂ : Real) / 2, (P.q₂ : Real) / 2)) → (TileCentroid U = - TileCentroid Uc)))))))) ) := by + ∀ (P : FordFareyParameter), + ∀ (T : ProtoTile), + ∀ (u : GaussianInt), + 1 < P.q₁ → + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + let U := S 0 false; + (∀ (n : Nat), + 0 < n → + TileCentroid (FordTile n) = ((n : Real) / 2, (n : Real) / 2)) → + let Uc := TileTranslation (FordTile P.q₁) (u + ⟨P.q₂, P.q₂⟩) + TileCentroid T = TileCentroid (TileTranslation (FordTile P.q) u) → + TileCentroid U - TileCentroid T = + ((P.q₂ : Real) / 2, (P.q₂ : Real) / 2) → + TileCentroid U = TileCentroid Uc + ) := by classical - intro P Ci horder T u hq1 S U hcross hcop fordCentroid Uc hrootCent hUoffset + intro P T u hq1 S U fordCentroid Uc hrootCent hUoffset calc TileCentroid U = (TileCentroid U - TileCentroid T) + TileCentroid T := by abel _ = ((P.q₂ : Real) / 2, (P.q₂ : Real) / 2) + @@ -626,17 +634,24 @@ private theorem hVCcent : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((P.q₂ < P.q₁) → (∀ (T' : ProtoTile), ∀ (u : - GaussianInt), (1 < P.q₁) → (∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), - let V := S' 0 true - (P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1) → ((Nat.Coprime P.q₁ P.p₁.natAbs) → ((∀ - (n : Nat), (0 < n) → (TileCentroid (FordTile n) = ((n : Real) / 2, (n : Real) / 2))) → ( - let Vc := TileTranslation (FordTile P.q₁) (u + ⟨P.q, P.q₁⟩) - (TileCentroid T' = TileCentroid (TileTranslation (FordTile P.q) (u + ⟨P.q, P.q₁⟩))) → - ((TileCentroid V - TileCentroid T' = (-((P.q₂ : Real) / 2), -((P.q₂ : Real) / 2))) → - (TileCentroid V = TileCentroid Vc)))))))) ) := by + ∀ (P : FordFareyParameter), + ∀ (T' : ProtoTile), + ∀ (u : GaussianInt), + 1 < P.q₁ → + ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), + let V := S' 0 true; + (∀ (n : Nat), + 0 < n → + TileCentroid (FordTile n) = ((n : Real) / 2, (n : Real) / 2)) → + let Vc := TileTranslation (FordTile P.q₁) (u + ⟨P.q, P.q₁⟩) + TileCentroid T' = + TileCentroid (TileTranslation (FordTile P.q) (u + ⟨P.q, P.q₁⟩)) → + TileCentroid V - TileCentroid T' = + (-((P.q₂ : Real) / 2), -((P.q₂ : Real) / 2)) → + TileCentroid V = TileCentroid Vc + ) := by classical - intro P Ci horder T' u hq1 S' V hcross hcop fordCentroid Vc hrootCent' hVoffset + intro P T' u hq1 S' V fordCentroid Vc hrootCent' hVoffset calc TileCentroid V = (TileCentroid V - TileCentroid T') + TileCentroid T' := by abel _ = (-((P.q₂ : Real) / 2), -((P.q₂ : Real) / 2)) + @@ -678,11 +693,10 @@ private theorem hnonzero : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((P.q₂ < P.q₁) → ((1 < P.q₁) → ((P.p₁ * (P.q₂ - : Int) - (P.q₁ : Int) * P.p₂ = 1) → ((Nat.Coprime P.q₁ P.p₁.natAbs) → - ((FordRecursiveQuadruple P 1).1 ≠ 0))))) ) := by + ∀ (P : FordFareyParameter), 1 < P.q₁ → (FordRecursiveQuadruple P 1).1 ≠ 0 + ) := by classical - intro P Ci horder hq1 hcross hcop + intro P hq1 change (if P.q₁ = 0 then (0, 1) else FordCircleCoordinate P.p₁ P.q₁).1 ≠ 0 rw [ite_eq_right (by omega)] @@ -912,8 +926,8 @@ theorem P4158T1LargeFirstRestrictions FordRecursiveQuadruple Q 0 = Ci.1.1 ∧ 1 < Q.q := by -- BODY classical - have hq1 : 1 < P.q₁ := LargeFirstRestrictions.hq1 P Ci horder - have hqgt := LargeFirstRestrictions.hqgt P Ci hq1 + have hq1 : 1 < P.q₁ := LargeFirstRestrictions.hq1 P horder + have hqgt := LargeFirstRestrictions.hqgt P hq1 have hroot : 1 < (FordRecursiveQuadruple P 0).1 := LargeFirstRestrictions.hroot P hqgt have dec := TileOdometerReindexedDecomposition (FordRecursiveQuadruple P) hq T h hroot (by simpa [hC0] using hO) @@ -980,10 +994,9 @@ theorem P4158T1LargeFirstRestrictions (FordRecursiveQuadruple P) hq.1).1 have hvfirst := LargeFirstRestrictions.hvfirst P hq hv10 have hvsecond := LargeFirstRestrictions.hvsecond P hq hv20 - have hvsol := LargeFirstRestrictions.hvsol P Ci horder hq1 hcross hcop hvsum hvfirst hvsecond + have hvsol := LargeFirstRestrictions.hvsol P hvsum hvfirst hvsecond have haslope32 := LargeFirstRestrictions.haslope32 P ha32 - have fordCentroid (n : Nat) (hn : 0 < n) := LargeFirstRestrictions.fordCentroid P Ci horder hq1 - hcross hcop n hn + have fordCentroid (n : Nat) (hn : 0 < n) := LargeFirstRestrictions.fordCentroid P n hn let Uc := TileTranslation (FordTile P.q₁) (u + ⟨P.q₂, P.q₂⟩) let Vc := TileTranslation (FordTile P.q₁) (u + ⟨P.q, P.q₁⟩) have hUcBand : BandPrototile Ci.1.1 Uc := @@ -999,9 +1012,9 @@ theorem P4158T1LargeFirstRestrictions have hw' := LargeFirstRestrictions.hw' P hvsol have hUoffset := LargeFirstRestrictions.hUoffset P T S hcent hvsol have hVoffset := LargeFirstRestrictions.hVoffset P T' S' hcent' hvsol - have hUCcent := LargeFirstRestrictions.hUCcent P Ci horder T u hq1 S hcross hcop fordCentroid + have hUCcent := LargeFirstRestrictions.hUCcent P T u hq1 S fordCentroid hrootCent hUoffset - have hVCcent := LargeFirstRestrictions.hVCcent P Ci horder T' u hq1 S' hcross hcop fordCentroid + have hVCcent := LargeFirstRestrictions.hVCcent P T' u hq1 S' fordCentroid hrootCent' hVoffset have hUcells : U.cells = Uc.cells := (BandPrototileCentroidUnique Ci.1.1 U Uc @@ -1011,7 +1024,7 @@ theorem P4158T1LargeFirstRestrictions (TileOdometerBandPrototile Ci.1.1 V k hVk) hVcBand hVCcent).1 have hcentUV := LargeFirstRestrictions.hcentUV P u hq1 S S' fordCentroid hUCcent hVCcent - have hnonzero := LargeFirstRestrictions.hnonzero P Ci horder hq1 hcross hcop + have hnonzero := LargeFirstRestrictions.hnonzero P hq1 have hslopeUdata := LargeFirstRestrictions.hslopeUdata P h gS hslope hnonzero obtain ⟨p₀, pU, hsp, hspU, hdu1, hdu2⟩ := hslopeUdata have hp₀ : p₀ = p := Option.some.inj (hsp.symm.trans hs) diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean index 35191c1538..4c39064f5d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean @@ -53,9 +53,10 @@ private theorem hqgt : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((1 < P.q₂) → (1 < P.q)) ) := by + ∀ (P : FordFareyParameter), 1 < P.q₂ → 1 < P.q + ) := by classical - intro P Ci hcurv + intro P hcurv have hsum := P.sum_q omega @@ -208,15 +209,17 @@ private theorem hv13 : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ( - let w := BandVectors.1 (FordRecursiveQuadruple P 3) (FordRecursiveQuadruple P 2) - let a := BandVectors.1 (FordRecursiveQuadruple P 1) (FordRecursiveQuadruple P 3) - let b := BandVectors.1 (FordRecursiveQuadruple P 2) (FordRecursiveQuadruple P 1) - (w + a + b = 0) → ((a - (⟨0, 1⟩ : GaussianInt) * b = ⟨(P.q : Int), (P.q₁ : Int)⟩) → ((b - - (⟨0, 1⟩ : GaussianInt) * w = ⟨-(P.q : Int), (P.q₂ : Int)⟩) → (((P.q : Int) = (P.q₁ : - Int) + (P.q₂ : Int)) → (a = ⟨(P.q₁ : Int), 0⟩))))) ) := by + ∀ (P : FordFareyParameter), + let w := BandVectors.1 (FordRecursiveQuadruple P 3) (FordRecursiveQuadruple P 2) + let a := BandVectors.1 (FordRecursiveQuadruple P 1) (FordRecursiveQuadruple P 3) + let b := BandVectors.1 (FordRecursiveQuadruple P 2) (FordRecursiveQuadruple P 1) + w + a + b = 0 → + a - (⟨0, 1⟩ : GaussianInt) * b = ⟨(P.q : Int), (P.q₁ : Int)⟩ → + b - (⟨0, 1⟩ : GaussianInt) * w = ⟨-(P.q : Int), (P.q₂ : Int)⟩ → + (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) → a = ⟨(P.q₁ : Int), 0⟩ + ) := by classical - intro P Ci w a b hsum' hfirst hsecond hqsum + intro P w a b hsum' hfirst hsecond hqsum have hre := congrArg (fun z : GaussianInt => z.re) hsum' have him := congrArg (fun z : GaussianInt => z.im) hsum' have hfre := congrArg (fun z : GaussianInt => z.re) hfirst @@ -300,10 +303,12 @@ private theorem fordCentroid : (by classical exact - (FordFareyParameter) → ((BandCircle) → (∀ (n : ℕ), (0 : ℕ) < n → TileCentroid (FordTile - n) = ((↑n : ℝ) / (2 : ℝ), (↑n : ℝ) / (2 : ℝ)))) ) := by + ∀ (n : ℕ), + (0 : ℕ) < n → + TileCentroid (FordTile n) = ((↑n : ℝ) / (2 : ℝ), (↑n : ℝ) / (2 : ℝ)) + ) := by classical - intro P Ci n hn + intro n hn let domain : Finset GaussianInt := FordCellDomain n have hne : domain.Nonempty := by refine ⟨⟨0, 0⟩, ?_⟩ @@ -633,9 +638,10 @@ private theorem hcurvNZ : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((FordRecursiveQuadruple P 2).1 ≠ 0) ) := by + ∀ (P : FordFareyParameter), (FordRecursiveQuadruple P 2).1 ≠ 0 + ) := by classical - intro P Ci + intro P have hpNat : 0 < P.q₂ * P.q₂ := Nat.mul_pos P.q₂_pos P.q₂_pos have hpInt : (0 : Int) < (P.q₂ * P.q₂ : Nat) := by exact_mod_cast hpNat have hp : 0 < (FordRecursiveQuadruple P 2).1 := by @@ -908,7 +914,7 @@ theorem P4158T1LargeSecondRestrictions -- BODY classical have hcurv := LargeSecondRestrictions.hcurv P Ci hCi hlarge horder T' u hc' - have hqgt := LargeSecondRestrictions.hqgt P Ci hcurv + have hqgt := LargeSecondRestrictions.hqgt P hcurv have hq0 : 1 < (FordRecursiveQuadruple P 0).1 := LargeSecondRestrictions.hq0 P hqgt have hd := TileOdometerReindexedDecomposition (FordRecursiveQuadruple P) hq T h hq0 (by simpa [hC0] using hO) @@ -960,10 +966,10 @@ theorem P4158T1LargeSecondRestrictions have hsecond := LargeSecondRestrictions.hsecond P h20 hstep have hqsum : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by exact_mod_cast P.sum_q - have hv13 := LargeSecondRestrictions.hv13 P Ci hsum' hfirst hsecond hqsum + have hv13 := LargeSecondRestrictions.hv13 P hsum' hfirst hsecond hqsum have hoffU := LargeSecondRestrictions.hoffU P T S hcent hv13 have hoffV := LargeSecondRestrictions.hoffV P T' S₂ hcent₂ hv13 - have fordCentroid (n : Nat) (hn : 0 < n) := LargeSecondRestrictions.fordCentroid P Ci n hn + have fordCentroid (n : Nat) (hn : 0 < n) := LargeSecondRestrictions.fordCentroid n hn have rootCentroidEq := LargeSecondRestrictions.rootCentroidEq P T u hc have rootCentroid := LargeSecondRestrictions.rootCentroid P T u fordCentroid rootCentroidEq let v : GaussianInt := u + ⟨-(P.q : Int), P.q₂⟩ @@ -993,7 +999,7 @@ theorem P4158T1LargeSecondRestrictions have hveca : BandVectors.2 (FordRecursiveQuadruple P ((1 : Fin 3) + 2).succ) (FordRecursiveQuadruple P ((1 : Fin 3) + 1).succ) = (⟨0, P.p₁⟩ : GaussianInt) := LargeSecondRestrictions.hveca P ha13 - have hcurvNZ := LargeSecondRestrictions.hcurvNZ P Ci + have hcurvNZ := LargeSecondRestrictions.hcurvNZ P obtain hzU | ⟨pRootU, pU, hrootU, hsU, hxU, hyU⟩ := hslope 1 false · exact (hcurvNZ hzU).elim have hpRootU := LargeSecondRestrictions.hpRootU h p hs pRootU hrootU diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean index 4052598104..ac14ffa2f8 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean @@ -78,9 +78,10 @@ private theorem hrpos : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((1 < P.q) → (0 < P.q₁)) ) := by + ∀ (P : FordFareyParameter), 1 < P.q → 0 < P.q₁ + ) := by classical - intro P Ci hqgt + intro P hqgt by_contra hn have hz : P.q₁ = 0 := by omega have hd := P.det₁ @@ -231,10 +232,11 @@ private theorem hfordcent : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((BandCircle) → ((1 < P.q) → ((0 < P.q) → - (TileCentroid (FordTile P.q) = ((P.q : ℝ) / 2, (P.q : ℝ) / 2))))) ) := by + ∀ (P : FordFareyParameter), + 1 < P.q → 0 < P.q → TileCentroid (FordTile P.q) = ((P.q : ℝ) / 2, (P.q : ℝ) / 2) + ) := by classical - intro P C0 Ci hqgt hqpos + intro P hqgt hqpos let domain : Finset GaussianInt := ((Finset.range P.q).product (Finset.range P.q)).image (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) @@ -394,11 +396,13 @@ private theorem squareCell : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((BandCircle) → (∀ (z : GaussianInt), z ∈ - (FordTile P.q).cells ↔ 0 ≤ z.re ∧ z.re < (P.q : Int) ∧ 0 ≤ z.im ∧ z.im < (P.q : - Int))) ) := by + ∀ (P : FordFareyParameter), + ∀ (z : GaussianInt), + z ∈ (FordTile P.q).cells ↔ + 0 ≤ z.re ∧ z.re < (P.q : Int) ∧ 0 ≤ z.im ∧ z.im < (P.q : Int) + ) := by classical - intro P C0 Ci z + intro P z change z ∈ FordCellDomain P.q ↔ _ change z ∈ ((Finset.range P.q).product (Finset.range P.q)).image (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) ↔ _ @@ -455,24 +459,45 @@ private theorem hdisj : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((BandCircle) → (∀ (i : Fin 3), ∀ (T : - ProtoTile), ∀ (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : PartialOdometer), ∀ - (H : PartialOdometer), ∀ (u : GaussianInt), (T.cells = (TileTranslation (FordTile - P.q) u).cells ∧ (T.cells = ∅ → T.anchor = (TileTranslation (FordTile P.q) u).anchor) - ∧ ∃ (a : GaussianInt) (b : ℤ), (∀ (x : GaussianInt), x ∈ h.domain ↔ x - u ∈ H.domain) - ∧ ∀ x ∈ h.domain, h.value x = H.value (x - u) + a.re * x.re + a.im * x.im + b) → (∀ - (v : GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) v).cells ∧ (T'.cells = - ∅ → T'.anchor = (TileTranslation (FordTile P.q) v).anchor) ∧ ∃ (a : GaussianInt) (b : - ℤ), (∀ (x : GaussianInt), x ∈ h'.domain ↔ x - v ∈ H.domain) ∧ ∀ x ∈ h'.domain, - h'.value x = H.value (x - v) + a.re * x.re + a.im * x.im + b) → ( - let d : GaussianInt := - if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ - else ⟨-(P.q : Int), (P.q₂ : Int)⟩ - (v = u + d) → ((∀ (w : GaussianInt), ∀ (z : GaussianInt), z ∈ (TileTranslation (FordTile - P.q) w).cells ↔ 0 ≤ (z-w).re ∧ (z-w).re < (P.q : Int) ∧ 0 ≤ (z-w).im ∧ (z-w).im < - (P.q : Int)) → (Disjoint T.cells T'.cells)))))) ) := by + ∀ (P : FordFareyParameter), + ∀ (i : Fin 3), + ∀ (T : ProtoTile), + ∀ (T' : ProtoTile), + ∀ (h : PartialOdometer), + ∀ (h' : PartialOdometer), + ∀ (H : PartialOdometer), + ∀ (u : GaussianInt), + (T.cells = (TileTranslation (FordTile P.q) u).cells ∧ + (T.cells = ∅ → + T.anchor = (TileTranslation (FordTile P.q) u).anchor) ∧ + ∃ (a : GaussianInt) (b : ℤ), + (∀ (x : GaussianInt), x ∈ h.domain ↔ x - u ∈ H.domain) ∧ + ∀ x ∈ h.domain, + h.value x = + H.value (x - u) + a.re * x.re + a.im * x.im + b) → + ∀ (v : GaussianInt), + (T'.cells = (TileTranslation (FordTile P.q) v).cells ∧ + (T'.cells = ∅ → + T'.anchor = (TileTranslation (FordTile P.q) v).anchor) ∧ + ∃ (a : GaussianInt) (b : ℤ), + (∀ (x : GaussianInt), x ∈ h'.domain ↔ x - v ∈ H.domain) ∧ + ∀ x ∈ h'.domain, + h'.value x = + H.value (x - v) + a.re * x.re + a.im * x.im + b) → + let d : GaussianInt := + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ + else ⟨-(P.q : Int), (P.q₂ : Int)⟩ + v = u + d → + (∀ (w : GaussianInt), + ∀ (z : GaussianInt), + z ∈ (TileTranslation (FordTile P.q) w).cells ↔ + 0 ≤ (z - w).re ∧ + (z - w).re < (P.q : Int) ∧ + 0 ≤ (z - w).im ∧ (z - w).im < (P.q : Int)) → + Disjoint T.cells T'.cells + ) := by classical - intro P C0 Ci i T T' h h' H u hu v hv d hshift' translatedCell + intro P i T T' h h' H u hu v hv d hshift' translatedCell rw [hu.1, hv.1] apply Finset.disjoint_left.mpr intro x hx hx' @@ -579,21 +604,38 @@ private theorem hinter : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → ((BandCircle) → (∀ (i : Fin 3), ∀ (T : - ProtoTile), ∀ (T' : ProtoTile), (1 < P.q) → ((0 < P.q₁) → ((0 < P.q₂) → (∀ (u : - GaussianInt), ∀ (v : GaussianInt), - let d : GaussianInt := - if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ - else ⟨-(P.q : Int), (P.q₂ : Int)⟩ - (v = u + d) → ((∀ (w : GaussianInt), ∀ (z : GaussianInt), z ∈ FootprintVertices - (TileTranslation (FordTile P.q) w) ↔ 0 ≤ (z-w).re ∧ (z-w).re ≤ (P.q : Int) ∧ 0 ≤ - (z-w).im ∧ (z-w).im ≤ (P.q : Int)) → ((FootprintVertices T = FootprintVertices - (TileTranslation (FordTile P.q) u)) → ((FootprintVertices T' = FootprintVertices - (TileTranslation (FordTile P.q) v)) → (∀ x, x ∈ FootprintVertices T ∩ - FootprintVertices T' ↔ (x-u).re = (if i = 0 then (P.q : Int) else 0) ∧ (if i = 0 then - (P.q₁ : Int) else (P.q₂ : Int)) ≤ (x-u).im ∧ (x-u).im ≤ (P.q : Int)))))))))) ) := by + ∀ (P : FordFareyParameter), + ∀ (i : Fin 3), + ∀ (T : ProtoTile), + ∀ (T' : ProtoTile), + 1 < P.q → + 0 < P.q₁ → + 0 < P.q₂ → + ∀ (u : GaussianInt), + ∀ (v : GaussianInt), + let d : GaussianInt := + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ + else ⟨-(P.q : Int), (P.q₂ : Int)⟩ + v = u + d → + (∀ (w : GaussianInt), + ∀ (z : GaussianInt), + z ∈ FootprintVertices (TileTranslation (FordTile P.q) w) ↔ + 0 ≤ (z - w).re ∧ + (z - w).re ≤ (P.q : Int) ∧ + 0 ≤ (z - w).im ∧ (z - w).im ≤ (P.q : Int)) → + FootprintVertices T = + FootprintVertices (TileTranslation (FordTile P.q) u) → + FootprintVertices T' = + FootprintVertices (TileTranslation (FordTile P.q) v) → + ∀ x, + x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ + ((x - u).re = if i = 0 then (P.q : Int) else 0) ∧ + (if i = 0 then (P.q₁ : Int) else (P.q₂ : Int)) ≤ + (x - u).im ∧ + (x - u).im ≤ (P.q : Int) + ) := by classical - intro P C0 Ci i T T' hqgt hrpos hspos u v d hshift' footprintCoord footprintT footprintT' x + intro P i T T' hqgt hrpos hspos u v d hshift' footprintCoord footprintT footprintT' x rw [Set.mem_inter_iff, footprintT, footprintT'] rw [(footprintCoord u x), (footprintCoord v x)] have hrelRe : (x-v).re = (x-u).re-d.re := by rw [hshift']; simp; ring @@ -632,7 +674,7 @@ theorem P4158T1MatchedFordPair have hidx : i ≠ 2 := MatchedFordGeometry.hidx P Ci i hCi T T' hlarge hcent have hqgt : 1 < P.q := MatchedFordGeometry.hqgt P Ci i hCi T T' hlarge hcent hidx have hqpos : 0 < P.q := by omega - have hrpos : 0 < P.q₁ := MatchedFordGeometry.hrpos P Ci hqgt + have hrpos : 0 < P.q₁ := MatchedFordGeometry.hrpos P hqgt have hspos : 0 < P.q₂ := P.q₂_pos have hneq : P.q₁ ≠ P.q₂ := MatchedFordGeometry.hneq P Ci i hCi T T' hlarge hcent hidx hrpos hspos have hcurv : 0 < (FordCircleCoordinate P.p P.q).1 := MatchedFordGeometry.hcurv P hqpos @@ -654,7 +696,7 @@ theorem P4158T1MatchedFordPair have hcentT' : TileCentroid T' = TileCentroid (TileTranslation (FordTile P.q) v) := MatchedFordGeometry.hcentT' P T' h' H v hv hFnon hT'non have hfordcent : TileCentroid (FordTile P.q) = - ((P.q : ℝ) / 2, (P.q : ℝ) / 2) := MatchedFordGeometry.hfordcent P C0 Ci hqgt hqpos + ((P.q : ℝ) / 2, (P.q : ℝ) / 2) := MatchedFordGeometry.hfordcent P hqgt hqpos have hcentdiff : TileCentroid T' - TileCentroid T = GaussianRealPoint (v - u) := MatchedFordGeometry.hcentdiff P T T' u v hcentT hcentT' obtain ⟨_, hconfig⟩ := FordCoordinateConfiguration P @@ -675,13 +717,13 @@ theorem P4158T1MatchedFordPair have squareCell (z : GaussianInt) : z ∈ (FordTile P.q).cells ↔ 0 ≤ z.re ∧ z.re < (P.q : Int) ∧ - 0 ≤ z.im ∧ z.im < (P.q : Int) := MatchedFordGeometry.squareCell P C0 Ci z + 0 ≤ z.im ∧ z.im < (P.q : Int) := MatchedFordGeometry.squareCell P z have translatedCell (w z : GaussianInt) : z ∈ (TileTranslation (FordTile P.q) w).cells ↔ 0 ≤ (z-w).re ∧ (z-w).re < (P.q : Int) ∧ 0 ≤ (z-w).im ∧ (z-w).im < (P.q : Int) := MatchedFordGeometry.translatedCell P squareCell w z - have hdisj : Disjoint T.cells T'.cells := MatchedFordGeometry.hdisj P C0 Ci i T T' h h' H u hu + have hdisj : Disjoint T.cells T'.cells := MatchedFordGeometry.hdisj P i T T' h h' H u hu v hv hshift' translatedCell have hsecond : T'.cells = (TileTranslation (FordTile P.q) (u+d)).cells := MatchedFordGeometry.hsecond P i T' h' H u v hv hshift' @@ -705,7 +747,7 @@ theorem P4158T1MatchedFordPair have hinter : ∀ x, x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ (x-u).re = (if i = 0 then (P.q : Int) else 0) ∧ (if i = 0 then (P.q₁ : Int) else (P.q₂ : Int)) ≤ (x-u).im ∧ - (x-u).im ≤ (P.q : Int) := MatchedFordGeometry.hinter P C0 Ci i T T' hqgt hrpos hspos u v + (x-u).im ≤ (P.q : Int) := MatchedFordGeometry.hinter P i T T' hqgt hrpos hspos u v hshift' footprintCoord footprintT footprintT' refine ⟨hidx, hqgt, hrpos, hneq, u, hu.1, ?_, hdisj, ?_⟩ · simpa [d] using hsecond diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean index 5c8632d8fc..d9c7d3c3f4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean @@ -69,10 +69,10 @@ private theorem hrpos : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (((P.q : Int) = P.q₁ + P.q₂) → ((1 < P.q) → (0 - < P.q₁))) ) := by + ∀ (P : FordFareyParameter), (P.q : Int) = P.q₁ + P.q₂ → 1 < P.q → 0 < P.q₁ + ) := by classical - intro P Ci hsum hqone + intro P hsum hqone by_contra hn have hz : P.q₁ = 0 := by omega have hd := P.det₁ @@ -118,12 +118,15 @@ private theorem hnlarge : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (Ci : BandCircle), ∀ (i : Fin 3), ((1 : ℤ) - < Ci.1.1.1) → ( - let n := if i = 0 then P.q₁ else P.q₂ - (0 < n) → ((Ci.1.1.1 = (n : Int) ^ 2) → (1 < n)))) ) := by + ∀ (P : FordFareyParameter), + ∀ (Ci : BandCircle), + ∀ (i : Fin 3), + (1 : ℤ) < Ci.1.1.1 → + let n := if i = 0 then P.q₁ else P.q₂ + 0 < n → Ci.1.1.1 = (n : Int) ^ 2 → 1 < n + ) := by classical - intro P C0 Ci i hlarge n hnpos hCicurv + intro P Ci i hlarge n hnpos hCicurv rw [hCicurv] at hlarge by_contra hn have : n = 1 := by omega @@ -133,11 +136,13 @@ private theorem determinantCoprime : (by classical exact - (FordFareyParameter) → ((BandCircle) → ((BandCircle) → ((Fin 3) → (∀ (a : Int), ∀ (b : - Nat), ∀ (d : Nat), ∀ (c : Int), (a * (d : Int) - (b : Int) * c = 1) → (Nat.Coprime b - a.natAbs))))) ) := by + ∀ (a : Int), + ∀ (b : Nat), + ∀ (d : Nat), + ∀ (c : Int), a * (d : Int) - (b : Int) * c = 1 → Nat.Coprime b a.natAbs + ) := by classical - intro P C0 Ci i a b d c hd + intro a b d c hd rw [Nat.coprime_iff_gcd_eq_one] apply Nat.dvd_one.mp let g := Nat.gcd b a.natAbs @@ -193,11 +198,12 @@ private theorem fordcell : (by classical exact - (FordFareyParameter) → ((BandCircle) → ((BandCircle) → ((Fin 3) → (∀ (m : Nat), ∀ (z : - GaussianInt), z ∈ (FordTile m).cells ↔ 0 ≤ z.re ∧ z.re < m ∧ 0 ≤ z.im ∧ z.im < m)))) - ) := by + ∀ (m : Nat), + ∀ (z : GaussianInt), + z ∈ (FordTile m).cells ↔ 0 ≤ z.re ∧ z.re < m ∧ 0 ≤ z.im ∧ z.im < m + ) := by classical - intro P C0 Ci i m z + intro m z change z ∈ ((Finset.range m).product (Finset.range m)).image (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) ↔ _ rw [Finset.mem_image] @@ -216,12 +222,15 @@ private theorem fordcent : (by classical exact - (FordFareyParameter) → ((BandCircle) → ((BandCircle) → ((Fin 3) → ((∀ (m : Nat), ∀ (z : - GaussianInt), z ∈ (FordTile m).cells ↔ 0 ≤ z.re ∧ z.re < m ∧ 0 ≤ z.im ∧ z.im < m) → - ((∀ (m : Nat), (0 < m) → ((FordTile m).cells.Nonempty)) → (∀ (m : Nat), (0 < m) → - (TileCentroid (FordTile m) = ((m : Real) / 2, (m : Real) / 2)))))))) ) := by + (∀ (m : Nat), + ∀ (z : GaussianInt), + z ∈ (FordTile m).cells ↔ 0 ≤ z.re ∧ z.re < m ∧ 0 ≤ z.im ∧ z.im < m) → + (∀ (m : Nat), 0 < m → (FordTile m).cells.Nonempty) → + ∀ (m : Nat), + 0 < m → TileCentroid (FordTile m) = ((m : Real) / 2, (m : Real) / 2) + ) := by classical - intro P C0 Ci i fordcell fordne m hm + intro fordcell fordne m hm let R := TileTranslation (TileQuarterTurn (FordTile m)) ⟨m, 0⟩ have hcR : R.cells = (FordTile m).cells := by ext z @@ -635,24 +644,42 @@ private theorem hnotouch : (by classical exact - ∀ (P : FordFareyParameter), (BandCircle) → (∀ (Ci : BandCircle), ∀ (i : Fin 3), ∀ (u : - GaussianInt), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ - (tiles : List ProtoTile), - let n := if i = 0 then P.q₁ else P.q₂ - (n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ( - let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ - let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩ - (TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint (vp - vm)) → ((Zsqrtd.norm - (vp - vm) = (P.q : Int) ^ 2 + (n : Int) ^ 2) → ((Function.Injective - GaussianRealPoint) → (∀ (Q : Fin (4 : ℕ) → CircleCoordinates), (Q (0 : Fin (4 : ℕ)) = - Ci.1.1) → ((∀ (j : Fin (3 : ℕ)), (Q j.succ).1 < Ci.1.1.1) → ((ProperBandQuadruple Q) - → ((∀ (j : Fin 3), Zsqrtd.norm (BandVectors.1 (Q j.succ) (Q 0)) = (Q j.succ).1 + - Ci.1.1.1) → ((BandPrototile Ci.1.1 base) → ((∀ T ∈ tiles, T ∈ RegularTileFamily base - (TilingLattice Ci)) → ((Rminus ∈ tiles) → ((Rplus ∈ tiles) → (¬ TileTouching Rminus - Rplus))))))))))))))) ) := by + ∀ (P : FordFareyParameter), + ∀ (Ci : BandCircle), + ∀ (i : Fin 3), + ∀ (u : GaussianInt), + ∀ (base : ProtoTile), + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + ∀ (tiles : List ProtoTile), + let n := if i = 0 then P.q₁ else P.q₂ + n < P.q → + Ci.1.1.1 = (n : Int) ^ 2 → + 1 < n → + let vm : GaussianInt := + u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ + let vp : GaussianInt := + u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩ + TileCentroid Rplus - TileCentroid Rminus = + GaussianRealPoint (vp - vm) → + Zsqrtd.norm (vp - vm) = (P.q : Int) ^ 2 + (n : Int) ^ 2 → + Function.Injective GaussianRealPoint → + ∀ (Q : Fin (4 : ℕ) → CircleCoordinates), + Q (0 : Fin (4 : ℕ)) = Ci.1.1 → + (∀ (j : Fin (3 : ℕ)), (Q j.succ).1 < Ci.1.1.1) → + ProperBandQuadruple Q → + (∀ (j : Fin 3), + Zsqrtd.norm (BandVectors.1 (Q j.succ) (Q 0)) = + (Q j.succ).1 + Ci.1.1.1) → + BandPrototile Ci.1.1 base → + (∀ T ∈ tiles, + T ∈ RegularTileFamily base (TilingLattice Ci)) → + Rminus ∈ tiles → + Rplus ∈ tiles → ¬TileTouching Rminus Rplus + ) := by classical - intro P C0 Ci i u base Rminus Rplus tiles n hnq hCicurv hnlarge vm vp hdelta hnormdelta - pointinj Q hQ0 hQless hQproper hincoming hbase hfamily hRmem hSmem htouch + intro P Ci i u base Rminus Rplus tiles n hnq hCicurv hnlarge vm vp hdelta hnormdelta pointinj + Q hQ0 hQless hQproper hincoming hbase hfamily hRmem hSmem htouch have hbaseQ : BandPrototile (Q 0) base := by simpa [hQ0] using hbase obtain ⟨j, hj⟩ := (BandRegularTileTouchingClassification Ci Q hQproper hQ0 base hbaseQ Rminus Rplus (hfamily _ hRmem) (hfamily _ hSmem)).mp htouch @@ -901,15 +928,19 @@ private theorem stepPair : (by classical exact - (FordFareyParameter) → ((BandCircle) → ((BandCircle) → ((Fin 3) → (∀ (u : GaussianInt), ∀ - (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), ((x - u).re = (z - - u).re) → (((y - u).re = (z - u).re) → ((y = x + 1 ∨ y = x - 1 ∨ - y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → ((((x - u).im ≤ (z - u).im ∧ (z - u).im < (y - - u).im) ∨ - ((y - u).im ≤ (z - u).im ∧ (z - u).im < (x - u).im)) → (({x, y} : Finset GaussianInt) - = {z, z + ⟨0, 1⟩})))))))) ) := by + ∀ (u : GaussianInt), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + ∀ (z : GaussianInt), + (x - u).re = (z - u).re → + (y - u).re = (z - u).re → + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + (x - u).im ≤ (z - u).im ∧ (z - u).im < (y - u).im ∨ + (y - u).im ≤ (z - u).im ∧ (z - u).im < (x - u).im → + ({ x, y } : Finset GaussianInt) = {z, z + ⟨0, 1⟩} + ) := by classical - intro P C0 Ci i u x y z hx hy hstep hcross + intro u x y z hx hy hstep hcross simp only [Zsqrtd.re_sub] at hx hy have hunit : y.im = x.im + 1 ∨ y.im = x.im - 1 := by rcases hstep with he | he | he | he @@ -1059,7 +1090,7 @@ theorem P4158T1SmallerStringEdges have hsum : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q have hqone := SmallerStringGeometry.hqone P Ci i hCi hlarge hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hsum - have hrpos := SmallerStringGeometry.hrpos P Ci hsum hqone + have hrpos := SmallerStringGeometry.hrpos P hsum hqone have hspos := P.q₂_pos let n := if i = 0 then P.q₁ else P.q₂ have hnpos : 0 < n := by dsimp [n]; split_ifs <;> assumption @@ -1067,15 +1098,15 @@ theorem P4158T1SmallerStringEdges have hCipos : 0 < Ci.1.1.1 := by omega have hC0pos := SmallerStringGeometry.hC0pos P C0 hC0 hqone have hCicurv := SmallerStringGeometry.hCicurv P Ci i hCi hsmall hrpos - have hnlarge := SmallerStringGeometry.hnlarge P C0 Ci i hlarge hnpos hCicurv + have hnlarge := SmallerStringGeometry.hnlarge P Ci i hlarge hnpos hCicurv have hFord := SmallerStringGeometry.hFord P Ci i hCi hsmall hrpos (P.q₂_pos) - (SmallerStringGeometry.determinantCoprime P C0 Ci i) + (SmallerStringGeometry.determinantCoprime) have fordcell (m : Nat) (z : GaussianInt) : z ∈ (FordTile m).cells ↔ - 0 ≤ z.re ∧ z.re < m ∧ 0 ≤ z.im ∧ z.im < m := SmallerStringGeometry.fordcell P C0 Ci i m z + 0 ≤ z.re ∧ z.re < m ∧ 0 ≤ z.im ∧ z.im < m := SmallerStringGeometry.fordcell m z have fordne (m : Nat) (hm : 0 < m) : (FordTile m).cells.Nonempty := ⟨0, (fordcell m 0).mpr (by simp; omega)⟩ - have fordcent := SmallerStringGeometry.fordcent P C0 Ci i fordcell fordne + have fordcent := SmallerStringGeometry.fordcent fordcell fordne have cellobs := SmallerStringGeometry.cellobs (SmallerStringGeometry.transne fordne) have hcentT := SmallerStringGeometry.hcentT P T u hc fordcent cellobs let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩ @@ -1112,7 +1143,7 @@ theorem P4158T1SmallerStringEdges have hft : TileString Ci orientation base Rminus Rplus tiles := hf.1 obtain ⟨hbase, hhead, hlast, _, hfamily, _, _⟩ := hft have hnadj := SmallerStringGeometry.hnadj Ci hlarge orientation Rminus Rplus - (SmallerStringGeometry.hnotouch P C0 Ci i u base Rminus Rplus tiles hnq hCicurv hnlarge + (SmallerStringGeometry.hnotouch P Ci i u base Rminus Rplus tiles hnq hCicurv hnlarge hdelta hnormdelta pointinj Q hQ0 hQless hQproper hincoming hbase hfamily (SmallerStringGeometry.hRmem Rminus tiles hhead) (SmallerStringGeometry.hSmem Rplus tiles hlast)) @@ -1130,7 +1161,7 @@ theorem P4158T1SmallerStringEdges Rminus Rplus hcm hcp hsum hnpos hnq hCicurv hnlarge hFord cellobs hflip hcmcand hcpcand heqm heqp hdelta hnormdelta walk hwsegment squarefoot hminusheight have crossing := SmallerStringGeometry.crossing - have stepPair := SmallerStringGeometry.stepPair P C0 Ci i u + have stepPair := SmallerStringGeometry.stepPair u refine ⟨heqm, heqp, ?_⟩ intro z hzre hzlo hzhi have hzlo' : (n : Int) ≤ (z - u).im := by diff --git a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean index 11c2e3ba1b..b824b188a7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean @@ -50,9 +50,9 @@ private theorem hrow : exact (P4194T1DiamondCellRows m z).2.mp hz private theorem hm2 : - ∀ (m : Nat), (1 < m) → ((GaussianInt) → (2 ≤ m)) := by + ∀ (m : Nat), 1 < m → 2 ≤ m := by classical - intro m hm z + intro m hm omega private theorem hdesclow : @@ -299,11 +299,12 @@ private theorem hpredTrueMid : rw [boundaryIffMissing (m - 1) (by omega) w hsomeW, hmissCore] private theorem unitBoundary : - (Nat) → ((GaussianInt) → (∀ (c : GaussianInt), ∀ (x : GaussianInt), x ∈ - BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) ↔ - x = c ∨ x = c + 1 ∨ x = c + ⟨0, 1⟩ ∨ x = c + 1 + ⟨0, 1⟩)) := by + ∀ (c : GaussianInt), + ∀ (x : GaussianInt), + x ∈ BoundaryFootprintVertices (⟨{ c }, c⟩ : ProtoTile) ↔ + x = c ∨ x = c + 1 ∨ x = c + ⟨0, 1⟩ ∨ x = c + 1 + ⟨0, 1⟩ := by classical - intro m z c x + intro c x classical have ht : ({c} : Finset GaussianInt).Nonempty := ⟨c, by simp⟩ have hmissI : c - ⟨0, 1⟩ ∉ ({c} : Finset GaussianInt) := by @@ -927,7 +928,7 @@ theorem P4194T1DiamondBoundaryLedger let a := z.re let b := z.im have hrow := DiamondBoundaryProof.hrow m z hz - have hm2 : 2 ≤ m := DiamondBoundaryProof.hm2 m hm z + have hm2 : 2 ≤ m := DiamondBoundaryProof.hm2 m hm have hdesclow (hb : b < m) : ∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ DiamondCellDomain (m - 1) := DiamondBoundaryProof.hdesclow m hm z hrow hb @@ -975,7 +976,7 @@ theorem P4194T1DiamondBoundaryLedger have unitBoundary (c x : GaussianInt) : x ∈ BoundaryFootprintVertices (⟨{c}, c⟩ : ProtoTile) ↔ x = c ∨ x = c + 1 ∨ x = c + ⟨0, 1⟩ ∨ x = c + 1 + ⟨0, 1⟩ := - DiamondBoundaryProof.unitBoundary m z c x + DiamondBoundaryProof.unitBoundary c x have hunit00 : z ∈ BoundaryFootprintVertices (C 0 true) ↔ (a = -(m : Int) ∧ b = (m : Int) - 1) ∨ (a = -(m : Int) + 1 ∧ b = (m : Int) - 1) ∨ diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean b/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean index 7b501e9485..5996185dba 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean @@ -195,190 +195,6 @@ private theorem pos3 : have hnon : 0 ≤ (q 3).1 := by simpa using hn omega -private theorem hv21 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), - let I : GaussianInt := ⟨0, 1⟩ - let w : GaussianInt := BandVectors.1 (q 3) (q 2) - let v21 : GaussianInt := BandVectors.1 (q 2) (q 1) - (BandVectors.1 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin - (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : - ℕ))] (3 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), - cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : - Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : - Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin - (4 : ℕ))] (3 : Fin (4 : ℕ))) + BandVectors.1 (![cfg.firstPredecessor (0 : Fin (4 : - ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 - : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin - (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : - GaussianInt) ∧ BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), - cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 - : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin - (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : - Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : - Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin - (4 : ℕ))] (3 : Fin (4 : ℕ))) + BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : - ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 - : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin - (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : - GaussianInt) ∧ BandVectors.1 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), - cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 - : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin - (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : - Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : - Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin - (4 : ℕ))] (3 : Fin (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : - Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : - Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin - (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : - ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 - : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin - (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : - Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : - Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin - (4 : ℕ))] (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : - Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : - Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin - (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple ![cfg.firstPredecessor (0 : Fin - (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : - ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : - Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : - Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin - (4 : ℕ))] j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] - j.succ) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : - ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] - (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), - cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 - : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin - (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), - cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] j.succ) (![cfg.firstPredecessor (0 : Fin (4 : - ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → (v21 = BandVectors.1 - (q 2) (cfg.firstPredecessor 1) - I * w) ) := by - classical - intro q cfg I w v21 hrot - simpa [v21, w, I, cfg.firstChild, cfg.firstParentTwo, - cfg.firstParentThree] using hrot.2.2.1 - -private theorem ha21 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), - let I : GaussianInt := ⟨0, 1⟩ - let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) - let a21 : GaussianInt := BandVectors.2 (q 2) (q 1) - (BandVectors.1 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin - (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : - ℕ))] (3 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), - cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : - Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : - Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin - (4 : ℕ))] (3 : Fin (4 : ℕ))) + BandVectors.1 (![cfg.firstPredecessor (0 : Fin (4 : - ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 - : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin - (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : - GaussianInt) ∧ BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), - cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 - : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin - (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : - Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : - Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin - (4 : ℕ))] (3 : Fin (4 : ℕ))) + BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : - ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 - : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin - (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : - GaussianInt) ∧ BandVectors.1 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), - cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 - : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin - (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : - Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : - Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin - (4 : ℕ))] (3 : Fin (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : - Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : - Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin - (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : - ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 - : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin - (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (1 : - Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : - Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin - (4 : ℕ))] (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (2 : - Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : - Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin - (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple ![cfg.firstPredecessor (0 : Fin - (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : - ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : - Fin (4 : ℕ))) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : - Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin - (4 : ℕ))] j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 - (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), - cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] - j.succ) (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : - ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] - (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), - cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![cfg.firstPredecessor (0 - : Fin (4 : ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin - (4 : ℕ)), cfg.firstPredecessor (1 : Fin (4 : ℕ))] j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (![cfg.firstPredecessor (0 : Fin (4 : ℕ)), - cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] j.succ) (![cfg.firstPredecessor (0 : Fin (4 : - ℕ)), cfg.firstPredecessor (2 : Fin (4 : ℕ)), cfg.firstPredecessor (3 : Fin (4 : ℕ)), - cfg.firstPredecessor (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → (a21 = BandVectors.2 - (q 2) (cfg.firstPredecessor 1) + I * alpha) ) := by - classical - intro q cfg I alpha a21 hrot - simpa [a21, alpha, I, cfg.firstChild, cfg.firstParentTwo, - cfg.firstParentThree] using hrot.2.2.2.1 - private theorem hX : (by classical @@ -1605,13 +1421,26 @@ private theorem propagateConstant : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ {V : Type}, ∀ - (f : V → Int), ∀ (g : V → Int), ∀ (L : Set V), ∀ (O : Set V), ∀ (R : Set V), ∀ (Iset - : Set V), ∀ (c : Int), ∀ (d : Int), ∀ (e : Int), ∀ (xL : V), ∀ (xR : V), (Iset ⊆ L ∪ - O ∪ R) → ((∀ x ∈ L, g x - f x = d) → ((∀ x ∈ O, g x - f x = c) → ((∀ x ∈ R, f x - g x - = e) → ((xL ∈ L ∩ O) → ((xR ∈ R ∩ O) → (∀ x ∈ Iset, g x - f x = c))))))) ) := by - classical - intro q cfg V f g L O R Iset c d e xL xR hcover hL hO hR hxL hxR + ∀ {V : Type}, + ∀ (f : V → Int), + ∀ (g : V → Int), + ∀ (L : Set V), + ∀ (O : Set V), + ∀ (R : Set V), + ∀ (Iset : Set V), + ∀ (c : Int), + ∀ (d : Int), + ∀ (e : Int), + ∀ (xL : V), + ∀ (xR : V), + Iset ⊆ L ∪ O ∪ R → + (∀ x ∈ L, g x - f x = d) → + (∀ x ∈ O, g x - f x = c) → + (∀ x ∈ R, f x - g x = e) → + xL ∈ L ∩ O → xR ∈ R ∩ O → ∀ x ∈ Iset, g x - f x = c + ) := by + classical + intro V f g L O R Iset c d e xL xR hcover hL hO hR hxL hxR have hd : d = c := (hL xL hxL.1).symm.trans (hO xL hxL.2) have he : -e = c := by have h1 := hR xR hxR.1 @@ -1628,10 +1457,10 @@ private theorem properLarge : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (r : Fin 4 → - CircleCoordinates), (ProperBandQuadruple r) → (1 < (r 0).1)) ) := by + ∀ (r : Fin 4 → CircleCoordinates), ProperBandQuadruple r → 1 < (r 0).1 + ) := by classical - intro q cfg r hr + intro r hr have facts := ProperBandCurvatureStructure r hr have hsome : ∃ i : Fin 3, 0 < (r i.succ).1 := by by_cases h0 : 0 < (r (0 : Fin 3).succ).1 @@ -1734,12 +1563,14 @@ private theorem zeroOdometerLine : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((∀ (r : Fin 4 → - CircleCoordinates), (ProperBandQuadruple r) → (1 < (r 0).1)) → (∀ - {D : CircleCoordinates}, ∀ {X : ProtoTile}, ∀ {g : PartialOdometer}, (D.1 = 0) → - ((TileOdometer D X g) → (∃ x, X = ⟨∅, x⟩ ∧ g.domain = {x})))) ) := by + (∀ (r : Fin 4 → CircleCoordinates), ProperBandQuadruple r → 1 < (r 0).1) → + ∀ {D : CircleCoordinates}, + ∀ {X : ProtoTile}, + ∀ {g : PartialOdometer}, + D.1 = 0 → TileOdometer D X g → ∃ x, X = ⟨∅, x⟩ ∧ g.domain = { x } + ) := by classical - intro q cfg properLarge D X g hD hg + intro properLarge D X g hD hg cases hg with | line w x hw g hdom => exact ⟨x, rfl, hdom⟩ | unit z x Z g hZ hdom htrans => norm_num at hD @@ -3252,10 +3083,14 @@ theorem P4250T1NestedCompatibility (SemiProperQuadruple.rotate cfg.firstProper.1) have spatialIdentity := NestedCompatibilityGeometry.spatialIdentity q cfg (NestedCompatibilityGeometry.hV13 q cfg hcycV (NestedCompatibilityGeometry.hX q cfg hcycV - hpredV (NestedCompatibilityGeometry.hv21 q cfg hrot))) + hpredV (by + simpa [v21, w, I, cfg.firstChild, cfg.firstParentTwo, + cfg.firstParentThree] using hrot.2.2.1))) have slopeIdentity := NestedCompatibilityGeometry.slopeIdentity q cfg (NestedCompatibilityGeometry.hA13 q cfg hcycA (NestedCompatibilityGeometry.hXalpha q cfg - hcycA hpredA (NestedCompatibilityGeometry.ha21 q cfg hrot))) + hcycA hpredA (by + simpa [a21, alpha, I, cfg.firstChild, cfg.firstParentTwo, + cfg.firstParentThree] using hrot.2.2.2.1))) have secondFlip := (VectorRecursionLaws cfg.secondPredecessor cfg.secondProper.1).2.2.2.2 cfg.secondProper 0 simp only [show (0 : Fin 3).succ = (1 : Fin 4) from rfl, @@ -3356,11 +3191,11 @@ theorem P4250T1NestedCompatibility k hbandA hdomA hvalueA V l hvalueB alignA alignB pos2 pos3 odoQ2 odoS2 odoS3 odoQ3 hcenterA hcenterP hcenterQT rawCompatLift hq1pos hdomBParent hdomQ hrawAC hrawAB compatAC hcenterB hcenterS hcenterPminus compatBDNested compatCross1 compatCross2 - (NestedCompatibilityGeometry.propagateConstant q cfg) bandPositiveNonempty qSCells qSAnchor + (NestedCompatibilityGeometry.propagateConstant) bandPositiveNonempty qSCells qSAnchor (NestedPrecursorConstant.precursorConstant q cfg h s0 hp U k hchildA hslopeA V l hchildB hslopeB bandPositiveNonempty uvCells uvAnchor uvObservable - (NestedCompatibilityGeometry.zeroOdometerLine q cfg - (NestedCompatibilityGeometry.properLarge q cfg)))) + (NestedCompatibilityGeometry.zeroOdometerLine + (NestedCompatibilityGeometry.properLarge)))) end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean b/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean index 05599485de..bf170a002a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean @@ -28,11 +28,13 @@ namespace ApollonianSuperharmonic namespace ForestCompletionLemmas private theorem noGridTriangle : - (Finset GaussianInt) → (Finset GaussianInt) → ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z - : GaussianInt), (FourNeighborAdjacent x y) → (FourNeighborAdjacent y z) → - (FourNeighborAdjacent z x) → False := by + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + ∀ (z : GaussianInt), + FourNeighborAdjacent x y → + FourNeighborAdjacent y z → FourNeighborAdjacent z x → False := by classical - intro W R x y z hxy hyz hzx + intro x y z hxy hyz hzx simp [FourNeighborAdjacent, Zsqrtd.ext_iff] at hxy hyz hzx omega @@ -45,24 +47,31 @@ private theorem adjacentSymm : all_goals simp [FourNeighborAdjacent, Zsqrtd.ext_iff] private theorem hHacyclic : - ∀ (W : Finset GaussianInt), (Finset GaussianInt) → (∀ V E, SimpleGridCycle V E → ¬ V ⊆ (W : - Set GaussianInt)) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), - (FourNeighborAdjacent x y) → (FourNeighborAdjacent y z) → (FourNeighborAdjacent z x) → - False) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, - (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), - let H : SimpleGraph GaussianInt := { - Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W - symm := ⟨by - intro x y h - exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ - loopless := ⟨by - intro x h - rcases h.1 with h | h | h | h <;> - simp [Zsqrtd.ext_iff] at h <;> omega⟩ - } - H.IsAcyclic := by + ∀ (W : Finset GaussianInt), + (∀ V E, SimpleGridCycle V E → ¬V ⊆ (W : Set GaussianInt)) → + (∀ (x : GaussianInt), + ∀ (y : GaussianInt), + ∀ (z : GaussianInt), + FourNeighborAdjacent x y → + FourNeighborAdjacent y z → FourNeighborAdjacent z x → False) → + ∀ + (adjacentSymm : + ∀ {a : GaussianInt}, + ∀ {b : GaussianInt}, FourNeighborAdjacent a b → FourNeighborAdjacent b a), + let H : SimpleGraph GaussianInt := + { Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W + symm := + ⟨by + intro x y h + exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ + loopless := + ⟨by + intro x h + rcases h.1 with h | h | h | h <;> simp [Zsqrtd.ext_iff] at h <;> + omega⟩ } + H.IsAcyclic := by classical - intro W R hcycle noGridTriangle adjacentSymm H a c hc + intro W hcycle noGridTriangle adjacentSymm H a c hc have walkW {u v : GaussianInt} (p : H.Walk u v) (hu : u ∈ W) : ∀ z ∈ p.support, z ∈ W := by intro z hz @@ -146,26 +155,29 @@ private theorem hHacyclic : hverts private theorem hPQ : - ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ - {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), - let X := {x : GaussianInt // x ∈ W} - let G : SimpleGraph X := { - Adj := fun x y => FourNeighborAdjacent x.1 y.1 - symm := ⟨by - intro x y h - exact adjacentSymm h⟩ - loopless := ⟨by - intro x h - rcases h with h | h | h | h <;> - simp [Zsqrtd.ext_iff] at h <;> omega⟩ - } - letI : DecidableRel FourNeighborAdjacent := fun _ _ => Classical.propDecidable _ - letI : DecidableRel G.Adj := fun _ _ => Classical.propDecidable _ - let P := (W.product W).filter fun e => FourNeighborAdjacent e.1 e.2 - let Q := Finset.univ.filter fun e : X × X => G.Adj e.1 e.2 - P.card = Q.card := by + ∀ (W : Finset GaussianInt), + ∀ + (adjacentSymm : + ∀ {a : GaussianInt}, + ∀ {b : GaussianInt}, FourNeighborAdjacent a b → FourNeighborAdjacent b a), + let X := { x : GaussianInt // x ∈ W } + let G : SimpleGraph X := + { Adj := fun x y => FourNeighborAdjacent x.1 y.1 + symm := + ⟨by + intro x y h + exact adjacentSymm h⟩ + loopless := + ⟨by + intro x h + rcases h with h | h | h | h <;> simp [Zsqrtd.ext_iff] at h <;> omega⟩ } + letI : DecidableRel FourNeighborAdjacent := fun _ _ => Classical.propDecidable _ + letI : DecidableRel G.Adj := fun _ _ => Classical.propDecidable _ + let P := (W.product W).filter fun e => FourNeighborAdjacent e.1 e.2 + let Q := Finset.univ.filter fun e : X × X => G.Adj e.1 e.2 + P.card = Q.card := by classical - intro W R adjacentSymm X G P Q + intro W adjacentSymm X G P Q refine Finset.card_bij' (s := P) (t := Q) (fun e he => (⟨e.1, (Finset.mem_product.mp (Finset.mem_filter.mp he).1).1⟩, ⟨e.2, (Finset.mem_product.mp (Finset.mem_filter.mp he).1).2⟩)) @@ -183,50 +195,56 @@ private theorem hPQ : apply Prod.ext <;> apply Subtype.ext <;> rfl private theorem hordered : - ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ - {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), - let X := {x : GaussianInt // x ∈ W} - let G : SimpleGraph X := { - Adj := fun x y => FourNeighborAdjacent x.1 y.1 - symm := ⟨by - intro x y h - exact adjacentSymm h⟩ - loopless := ⟨by - intro x h - rcases h with h | h | h | h <;> - simp [Zsqrtd.ext_iff] at h <;> omega⟩ - } - letI : DecidableRel FourNeighborAdjacent := fun _ _ => Classical.propDecidable _ - letI : DecidableRel G.Adj := fun _ _ => Classical.propDecidable _ - let P := (W.product W).filter fun e => FourNeighborAdjacent e.1 e.2 - let Q := Finset.univ.filter fun e : X × X => G.Adj e.1 e.2 - (P.card = Q.card) → P.card = 2 * G.edgeFinset.card := by + ∀ (W : Finset GaussianInt), + ∀ + (adjacentSymm : + ∀ {a : GaussianInt}, + ∀ {b : GaussianInt}, FourNeighborAdjacent a b → FourNeighborAdjacent b a), + let X := { x : GaussianInt // x ∈ W } + let G : SimpleGraph X := + { Adj := fun x y => FourNeighborAdjacent x.1 y.1 + symm := + ⟨by + intro x y h + exact adjacentSymm h⟩ + loopless := + ⟨by + intro x h + rcases h with h | h | h | h <;> simp [Zsqrtd.ext_iff] at h <;> omega⟩ } + letI : DecidableRel FourNeighborAdjacent := fun _ _ => Classical.propDecidable _ + letI : DecidableRel G.Adj := fun _ _ => Classical.propDecidable _ + let P := (W.product W).filter fun e => FourNeighborAdjacent e.1 e.2 + let Q := Finset.univ.filter fun e : X × X => G.Adj e.1 e.2 + P.card = Q.card → P.card = 2 * G.edgeFinset.card := by classical - intro W R adjacentSymm X G P Q hPQ + intro W adjacentSymm X G P Q hPQ calc _ = Q.card := hPQ _ = 2 * G.edgeFinset.card := by simpa [Q] using G.two_mul_card_edgeFinset.symm private theorem hdiv : - ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ - {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), - let X := {x : GaussianInt // x ∈ W} - let G : SimpleGraph X := { - Adj := fun x y => FourNeighborAdjacent x.1 y.1 - symm := ⟨by - intro x y h - exact adjacentSymm h⟩ - loopless := ⟨by - intro x h - rcases h with h | h | h | h <;> - simp [Zsqrtd.ext_iff] at h <;> omega⟩ - } - letI : DecidableRel FourNeighborAdjacent := fun _ _ => Classical.propDecidable _ - letI : DecidableRel G.Adj := fun _ _ => Classical.propDecidable _ - let P := (W.product W).filter fun e => FourNeighborAdjacent e.1 e.2 - (P.card = 2 * G.edgeFinset.card) → P.card / 2 = G.edgeFinset.card := by + ∀ (W : Finset GaussianInt), + ∀ + (adjacentSymm : + ∀ {a : GaussianInt}, + ∀ {b : GaussianInt}, FourNeighborAdjacent a b → FourNeighborAdjacent b a), + let X := { x : GaussianInt // x ∈ W } + let G : SimpleGraph X := + { Adj := fun x y => FourNeighborAdjacent x.1 y.1 + symm := + ⟨by + intro x y h + exact adjacentSymm h⟩ + loopless := + ⟨by + intro x h + rcases h with h | h | h | h <;> simp [Zsqrtd.ext_iff] at h <;> omega⟩ } + letI : DecidableRel FourNeighborAdjacent := fun _ _ => Classical.propDecidable _ + letI : DecidableRel G.Adj := fun _ _ => Classical.propDecidable _ + let P := (W.product W).filter fun e => FourNeighborAdjacent e.1 e.2 + P.card = 2 * G.edgeFinset.card → P.card / 2 = G.edgeFinset.card := by classical - intro W R adjacentSymm X G P hordered + intro W adjacentSymm X G P hordered rw [hordered] simp @@ -259,23 +277,30 @@ private theorem hcountGraph : _ = ↑G.edgeFinset.card := by rw [hdiv] private theorem supportAdj : - ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ - {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), - let H : SimpleGraph GaussianInt := { - Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W - symm := ⟨by - intro x y h - exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ - loopless := ⟨by - intro x h - rcases h.1 with h | h | h | h <;> - simp [Zsqrtd.ext_iff] at h <;> omega⟩ - } - ∀ {s : GaussianInt}, ∀ {t : GaussianInt}, ∀ (q : H.Walk s t), ∀ {l₁ : List GaussianInt}, ∀ - {l₂ : List GaussianInt}, ∀ {x : GaussianInt}, ∀ {y : GaussianInt}, q.support = l₁ ++ x :: - y :: l₂ → H.Adj x y := by + ∀ (W : Finset GaussianInt), + ∀ + (adjacentSymm : + ∀ {a : GaussianInt}, + ∀ {b : GaussianInt}, FourNeighborAdjacent a b → FourNeighborAdjacent b a), + let H : SimpleGraph GaussianInt := + { Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W + symm := + ⟨by + intro x y h + exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ + loopless := + ⟨by + intro x h + rcases h.1 with h | h | h | h <;> simp [Zsqrtd.ext_iff] at h <;> omega⟩ } + ∀ {s : GaussianInt}, + ∀ {t : GaussianInt}, + ∀ (q : H.Walk s t), + ∀ {l₁ : List GaussianInt}, + ∀ {l₂ : List GaussianInt}, + ∀ {x : GaussianInt}, + ∀ {y : GaussianInt}, q.support = l₁ ++ x :: y :: l₂ → H.Adj x y := by classical - intro W R adjacentSymm H s t q + intro W adjacentSymm H s t q induction q with | nil => intro l₁ l₂ x y heq @@ -302,22 +327,25 @@ private theorem supportAdj : exact ih htail private theorem allWalkW : - ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ - {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), - let H : SimpleGraph GaussianInt := { - Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W - symm := ⟨by - intro x y h - exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ - loopless := ⟨by - intro x h - rcases h.1 with h | h | h | h <;> - simp [Zsqrtd.ext_iff] at h <;> omega⟩ - } - ∀ {u : GaussianInt}, ∀ {v : GaussianInt}, ∀ (q : H.Walk u v), (u ∈ W) → ∀ z ∈ q.support, z ∈ - W := by + ∀ (W : Finset GaussianInt), + ∀ + (adjacentSymm : + ∀ {a : GaussianInt}, + ∀ {b : GaussianInt}, FourNeighborAdjacent a b → FourNeighborAdjacent b a), + let H : SimpleGraph GaussianInt := + { Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W + symm := + ⟨by + intro x y h + exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ + loopless := + ⟨by + intro x h + rcases h.1 with h | h | h | h <;> simp [Zsqrtd.ext_iff] at h <;> omega⟩ } + ∀ {u : GaussianInt}, + ∀ {v : GaussianInt}, ∀ (q : H.Walk u v), u ∈ W → ∀ z ∈ q.support, z ∈ W := by classical - intro W R adjacentSymm H u v q hu z hz + intro W adjacentSymm H u v q hu z hz induction q with | nil => simp only [SimpleGraph.Walk.support, List.mem_cons, List.not_mem_nil, or_false] at hz @@ -331,26 +359,39 @@ private theorem allWalkW : · exact ih hadj.2.2 hz private theorem pathToGrid : - ∀ (W : Finset GaussianInt), (Finset GaussianInt) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, ∀ - {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), - let H : SimpleGraph GaussianInt := { - Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W - symm := ⟨by - intro x y h - exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ - loopless := ⟨by - intro x h - rcases h.1 with h | h | h | h <;> - simp [Zsqrtd.ext_iff] at h <;> omega⟩ - } - (∀ {s : GaussianInt}, ∀ {t : GaussianInt}, ∀ (q : H.Walk s t), ∀ {l₁ : List GaussianInt}, ∀ - {l₂ : List GaussianInt}, ∀ {x : GaussianInt}, ∀ {y : GaussianInt}, q.support = l₁ ++ x :: - y :: l₂ → H.Adj x y) → (∀ {u : GaussianInt}, ∀ {v : GaussianInt}, ∀ (q : H.Walk u v), (u - ∈ W) → ∀ z ∈ q.support, z ∈ W) → ∀ {s : GaussianInt}, ∀ {t : GaussianInt}, ∀ (p : H.Walk - s t), (p.IsPath) → (s ≠ t) → (s ∈ W) → (t ∈ W) → ∃ V E, SimpleGridPathBetween V E s t ∧ V - ⊆ (W : Set GaussianInt) := by + ∀ (W : Finset GaussianInt), + ∀ + (adjacentSymm : + ∀ {a : GaussianInt}, + ∀ {b : GaussianInt}, FourNeighborAdjacent a b → FourNeighborAdjacent b a), + let H : SimpleGraph GaussianInt := + { Adj := fun x y => FourNeighborAdjacent x y ∧ x ∈ W ∧ y ∈ W + symm := + ⟨by + intro x y h + exact ⟨adjacentSymm h.1, h.2.2, h.2.1⟩⟩ + loopless := + ⟨by + intro x h + rcases h.1 with h | h | h | h <;> simp [Zsqrtd.ext_iff] at h <;> omega⟩ }; + (∀ {s : GaussianInt}, + ∀ {t : GaussianInt}, + ∀ (q : H.Walk s t), + ∀ {l₁ : List GaussianInt}, + ∀ {l₂ : List GaussianInt}, + ∀ {x : GaussianInt}, + ∀ {y : GaussianInt}, q.support = l₁ ++ x :: y :: l₂ → H.Adj x y) → + (∀ {u : GaussianInt}, + ∀ {v : GaussianInt}, ∀ (q : H.Walk u v), u ∈ W → ∀ z ∈ q.support, z ∈ W) → + ∀ {s : GaussianInt}, + ∀ {t : GaussianInt}, + ∀ (p : H.Walk s t), + p.IsPath → + s ≠ t → + s ∈ W → + ∃ V E, SimpleGridPathBetween V E s t ∧ V ⊆ (W : Set GaussianInt) := by classical - intro W R adjacentSymm H supportAdj allWalkW s t p hp hne hs ht + intro W adjacentSymm H supportAdj allWalkW s t p hp hne hs let l : List GaussianInt := p.support let E : Set (Finset GaussianInt) := {e | ∃ x y l₁ l₂, l = l₁ ++ x :: y :: l₂ ∧ e = {x, y}} @@ -427,12 +468,13 @@ private theorem hrootSeparateGraph : exact (heq (hseparate x.1 hx y.1 hy V E hgrid hV)).elim private theorem forestCount : - (Finset GaussianInt) → (Finset GaussianInt) → (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, - (FourNeighborAdjacent a b) → FourNeighborAdjacent b a) → ∀ {V : Type}, ∀ [Fintype V], ∀ - (G : SimpleGraph V), ∀ [DecidableRel G.Adj], (G.IsAcyclic) → G.edgeFinset.card + Nat.card - G.ConnectedComponent = Fintype.card V := by + ∀ {V : Type}, + ∀ [Fintype V], + ∀ (G : SimpleGraph V), + ∀ [DecidableRel G.Adj], + G.IsAcyclic → G.edgeFinset.card + Nat.card G.ConnectedComponent = Fintype.card V := by classical - intro W R adjacentSymm V finiteType G adjacencyDecidability hG + intro V finiteType G adjacencyDecidability hG classical let : Fintype G.ConnectedComponent := Fintype.ofFinite _ have hdegree (c : G.ConnectedComponent) (v : c) : @@ -467,19 +509,28 @@ private theorem forestCount : simpa [Nat.card_eq_fintype_card] using hsum private theorem forestRooted : - (Finset GaussianInt) → (Finset GaussianInt) → (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, - (FourNeighborAdjacent a b) → FourNeighborAdjacent b a) → (∀ {V : Type}, ∀ [Fintype V], ∀ - (G : SimpleGraph V), ∀ [DecidableRel G.Adj], (G.IsAcyclic) → G.edgeFinset.card + Nat.card - G.ConnectedComponent = Fintype.card V) → ∀ {V : Type}, ∀ [Fintype V], ∀ (G : SimpleGraph - V), ∀ [DecidableRel G.Adj], (G.IsAcyclic) → ∀ (S : Set V), (∀ x ∈ S, ∀ y ∈ S, - G.Reachable x y → x = y) → (G.edgeFinset.card + Nat.card S = Fintype.card V) → ∃ - parent : V → V, ∃ rank : V → ℕ, - (∀ r ∈ S, parent r = r) ∧ - (∀ x, x ∉ S → G.Adj (parent x) x ∧ rank (parent x) < rank x) ∧ - (∀ x, x ∈ S ↔ rank x = 0) ∧ - (∀ x y, G.Adj x y → x = parent y ∨ y = parent x) := by + (∀ {V : Type}, + ∀ [Fintype V], + ∀ (G : SimpleGraph V), + ∀ [DecidableRel G.Adj], + G.IsAcyclic → + G.edgeFinset.card + Nat.card G.ConnectedComponent = Fintype.card V) → + ∀ {V : Type}, + ∀ [Fintype V], + ∀ (G : SimpleGraph V), + ∀ [DecidableRel G.Adj], + G.IsAcyclic → + ∀ (S : Set V), + (∀ x ∈ S, ∀ y ∈ S, G.Reachable x y → x = y) → + G.edgeFinset.card + Nat.card S = Fintype.card V → + ∃ parent : V → V, + ∃ rank : V → ℕ, + (∀ r ∈ S, parent r = r) ∧ + (∀ x, x ∉ S → G.Adj (parent x) x ∧ rank (parent x) < rank x) ∧ + (∀ x, x ∈ S ↔ rank x = 0) ∧ + ∀ x y, G.Adj x y → x = parent y ∨ y = parent x := by classical - intro W R adjacentSymm forestCount V finiteType G adjacencyDecidability hG S hsep hnum + intro forestCount V finiteType G adjacencyDecidability hG S hsep hnum classical let : Fintype G.ConnectedComponent := Fintype.ofFinite _ have hcard : Fintype.card S = Fintype.card G.ConnectedComponent := by @@ -643,38 +694,6 @@ private theorem hcardS : _ = Nat.card {x : GaussianInt // x ∈ R} := Nat.card_congr e _ = R.card := by simp [Nat.card_eq_fintype_card] -private theorem hbudget : - ∀ (W : Finset GaussianInt), ∀ (R : Finset GaussianInt), ((∑ x ∈ W, (1 - if x ∈ R then (1 : ℤ) - else 0)) = ((((W.product W).filter fun e => @decide (FourNeighborAdjacent e.1 e.2) - (Classical.propDecidable _)).card / 2 : ℕ) : ℤ)) → ∀ (adjacentSymm : ∀ {a : GaussianInt}, - ∀ {b : GaussianInt}, (FourNeighborAdjacent a b) → FourNeighborAdjacent b a), - let X := {x : GaussianInt // x ∈ W} - let G : SimpleGraph X := { - Adj := fun x y => FourNeighborAdjacent x.1 y.1 - symm := ⟨by - intro x y h - exact adjacentSymm h⟩ - loopless := ⟨by - intro x h - rcases h with h | h | h | h <;> - simp [Zsqrtd.ext_iff] at h <;> omega⟩ - } - letI : DecidableRel FourNeighborAdjacent := fun _ _ => Classical.propDecidable _ - letI : DecidableRel G.Adj := fun _ _ => Classical.propDecidable _ - let P := (W.product W).filter fun e => FourNeighborAdjacent e.1 e.2 - (P.card / 2 = G.edgeFinset.card) → ((∑ x ∈ W, (1 - if x ∈ R then (1 : ℤ) else 0)) = - (G.edgeFinset.card : ℤ)) → ((∑ x ∈ W, (1 - if x ∈ R then (1 : ℤ) else 0)) = (W.card : ℤ) - - (R.card : ℤ)) → - let S : Set X := {x | x.val ∈ R} - (Nat.card S = R.card) → G.edgeFinset.card + Nat.card S = Fintype.card X := by - classical - intro W R hcount adjacentSymm X G P hdiv hcountGraph hsumIndicator S hcardS - have hc : (W.card : ℤ) - (R.card : ℤ) = (G.edgeFinset.card : ℤ) := - hsumIndicator.symm.trans hcountGraph - have hcardX : Fintype.card X = W.card := by simp [X] - rw [hcardS, hcardX] - omega - private theorem hparent : ∀ (W : Finset GaussianInt), let X := {x : GaussianInt // x ∈ W} @@ -713,7 +732,7 @@ theorem P4250T2FiniteForestCompletion have noGridTriangle (x y z : GaussianInt) (hxy : FourNeighborAdjacent x y) (hyz : FourNeighborAdjacent y z) - (hzx : FourNeighborAdjacent z x) : False := ForestCompletionLemmas.noGridTriangle W R x y z + (hzx : FourNeighborAdjacent z x) : False := ForestCompletionLemmas.noGridTriangle x y z hxy hyz hzx have adjacentSymm {a b : GaussianInt} (h : FourNeighborAdjacent a b) : FourNeighborAdjacent b a := ForestCompletionLemmas.adjacentSymm (a := a) (b := b) h @@ -727,7 +746,7 @@ theorem P4250T2FiniteForestCompletion rcases h.1 with h | h | h | h <;> simp [Zsqrtd.ext_iff] at h <;> omega⟩ } - have hHacyclic : H.IsAcyclic := ForestCompletionLemmas.hHacyclic W R hcycle noGridTriangle + have hHacyclic : H.IsAcyclic := ForestCompletionLemmas.hHacyclic W hcycle noGridTriangle adjacentSymm let X := {x : GaussianInt // x ∈ W} let G : SimpleGraph X := { @@ -760,32 +779,38 @@ theorem P4250T2FiniteForestCompletion exact hHacyclic (c.map f) (hc.map finj)) let P := (W.product W).filter fun e => FourNeighborAdjacent e.1 e.2 let Q := Finset.univ.filter fun e : X × X => G.Adj e.1 e.2 - have hPQ : P.card = Q.card := ForestCompletionLemmas.hPQ W R adjacentSymm - have hordered : P.card = 2 * G.edgeFinset.card := ForestCompletionLemmas.hordered W R + have hPQ : P.card = Q.card := ForestCompletionLemmas.hPQ W adjacentSymm + have hordered : P.card = 2 * G.edgeFinset.card := ForestCompletionLemmas.hordered W adjacentSymm hPQ - have hdiv : P.card / 2 = G.edgeFinset.card := ForestCompletionLemmas.hdiv W R adjacentSymm + have hdiv : P.card / 2 = G.edgeFinset.card := ForestCompletionLemmas.hdiv W adjacentSymm hordered have hcountGraph : (∑ x ∈ W, (1 - if x ∈ R then (1 : ℤ) else 0)) = (G.edgeFinset.card : ℤ) := ForestCompletionLemmas.hcountGraph W R hcount adjacentSymm hdiv have supportAdj : ∀ {s t : GaussianInt} (q : H.Walk s t) {l₁ l₂ : List GaussianInt} {x y : GaussianInt}, - q.support = l₁ ++ x :: y :: l₂ → H.Adj x y := ForestCompletionLemmas.supportAdj W R + q.support = l₁ ++ x :: y :: l₂ → H.Adj x y := ForestCompletionLemmas.supportAdj W adjacentSymm have allWalkW {u v : GaussianInt} (q : H.Walk u v) (hu : u ∈ W) : - ∀ z ∈ q.support, z ∈ W := ForestCompletionLemmas.allWalkW W R adjacentSymm (u := u) (v := + ∀ z ∈ q.support, z ∈ W := ForestCompletionLemmas.allWalkW W adjacentSymm (u := u) (v := v) q hu have pathToGrid {s t : GaussianInt} (p : H.Walk s t) (hp : p.IsPath) (hne : s ≠ t) (hs : s ∈ W) (ht : t ∈ W) : ∃ V E, SimpleGridPathBetween V E s t ∧ V ⊆ (W : Set GaussianInt) := - ForestCompletionLemmas.pathToGrid W R adjacentSymm supportAdj allWalkW (s := s) (t := - t) p hp hne hs ht + (show + ∀ {s : GaussianInt}, ∀ {t : GaussianInt}, ∀ (p : H.Walk s t), + (p.IsPath) → (s ≠ t) → (s ∈ W) → (t ∈ W) → ∃ V E, + SimpleGridPathBetween V E s t ∧ V ⊆ (W : Set GaussianInt) + from by + intro s t p hp hne hs ht + exact ForestCompletionLemmas.pathToGrid W adjacentSymm supportAdj allWalkW p hp + hne hs) p hp hne hs ht have hrootSeparateGraph : ∀ x : X, x.1 ∈ R → ∀ y : X, y.1 ∈ R → G.Reachable x y → x.1 = y.1 := ForestCompletionLemmas.hrootSeparateGraph W R hseparate adjacentSymm finj pathToGrid have forestCount {V : Type} [Fintype V] (G : SimpleGraph V) [DecidableRel G.Adj] (hG : G.IsAcyclic) : G.edgeFinset.card + Nat.card G.ConnectedComponent = Fintype.card V := - ForestCompletionLemmas.forestCount W R adjacentSymm (V := V) G hG + ForestCompletionLemmas.forestCount (V := V) G hG have forestRooted {V : Type} [Fintype V] (G : SimpleGraph V) [DecidableRel G.Adj] (hG : G.IsAcyclic) (S : Set V) (hsep : ∀ x ∈ S, ∀ y ∈ S, G.Reachable x y → x = y) @@ -794,14 +819,18 @@ theorem P4250T2FiniteForestCompletion (∀ r ∈ S, parent r = r) ∧ (∀ x, x ∉ S → G.Adj (parent x) x ∧ rank (parent x) < rank x) ∧ (∀ x, x ∈ S ↔ rank x = 0) ∧ - (∀ x y, G.Adj x y → x = parent y ∨ y = parent x) := ForestCompletionLemmas.forestRooted W - R adjacentSymm forestCount (V := V) G hG S hsep hnum + (∀ x y, G.Adj x y → x = parent y ∨ y = parent x) := ForestCompletionLemmas.forestRooted + forestCount (V := V) G hG S hsep hnum have hsumIndicator : (∑ x ∈ W, (1 - if x ∈ R then (1 : ℤ) else 0)) = (W.card : ℤ) - (R.card : ℤ) := ForestCompletionLemmas.hsumIndicator W R hRW let S : Set X := {x | x.val ∈ R} have hcardS : Nat.card S = R.card := ForestCompletionLemmas.hcardS W R hRW - have hbudget : G.edgeFinset.card + Nat.card S = Fintype.card X := - ForestCompletionLemmas.hbudget W R hcount adjacentSymm hdiv hcountGraph hsumIndicator hcardS + have hbudget : G.edgeFinset.card + Nat.card S = Fintype.card X := by + have hc : (W.card : ℤ) - (R.card : ℤ) = (G.edgeFinset.card : ℤ) := + hsumIndicator.symm.trans hcountGraph + have hcardX : Fintype.card X = W.card := by simp [X] + rw [hcardS, hcardX] + omega obtain ⟨p, depth, hp, hpar, hzero, hedge⟩ := forestRooted G hGacyclic S (by diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean index d97ce1291c..47f9fe1889 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean @@ -374,14 +374,23 @@ private theorem parent_regular : (by classical exact - ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : - BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : - BandOrderedGeneralLayoutCertificate q cfg C T), (List GaussianInt) → (∀ i, ∀ s, (∀ a, - ∀ b, FourNeighborAdjacent a b → a ∈ BoundaryFootprintVertices (cert.P i s) → b ∈ - BoundaryFootprintVertices (cert.P i s) → ¬ OpenLatticeEdge a b ⊆ interior - (TileRealization (cert.P i s)))) ) := by + ∀ (C : BandCircle), + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ i, + ∀ s, + ∀ a, + ∀ b, + FourNeighborAdjacent a b → + a ∈ BoundaryFootprintVertices (cert.P i s) → + b ∈ BoundaryFootprintVertices (cert.P i s) → + ¬OpenLatticeEdge a b ⊆ + interior (TileRealization (cert.P i s)) + ) := by classical - intro C q cfg T cert p + intro C q cfg T cert as_aux_lemma => intro i s have hnonneg := (ProperBandCurvatureStructure q cfg.proper).2.1 i @@ -1237,7 +1246,7 @@ theorem P4250T2InterfaceCycleExclusion have hTne : T.cells.Nonempty := (LatticeTileGridStructure T hlat).1.1 -- Absence of a boundary edge forces all four incident cells to be present. have edge_vertices := InterfaceCycleGeometry.edge_vertices E p x y hpHead hpLast hclose hpEdges - have parent_regular := InterfaceCycleGeometry.parent_regular C q cfg T cert p + have parent_regular := InterfaceCycleGeometry.parent_regular C q cfg T cert -- A cycle side cannot lie between two cells of one parent. have zip_decomp := InterfaceCycleGeometry.zip_decomp let es := (p.zip p.tail) ++ [(y, x)] diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean index 4ac6d935cd..506c605308 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1CentralCoordinates.lean @@ -157,12 +157,15 @@ private theorem hchildPositive : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((BandCircle) → - (∀ (i' : Fin (3 : ℕ)), ∀ (r : Fin (3 : ℕ)), - let j : Fin 3 := i' + r - 0 < (q j.succ).1)) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + BandOrderedGeneralConfiguration q → + ∀ (i' : Fin (3 : ℕ)), + ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i' + r + 0 < (q j.succ).1 + ) := by classical - intro q cfg C₀ i' r j + intro q cfg i' r j have hnonneg := (ProperBandCurvatureStructure q cfg.proper).2.1 j have hne := cfg.noLine j.succ omega @@ -473,7 +476,7 @@ theorem P4261T1CentralCoordinates have hfootT : FootprintVertices T = FootprintVertices (cert.P j hs) := CentralCoordinateGeometry.hfootT q cfg C₀ T₀ cert T i' hs r hparentNonempty hselectedNonempty hcellsT - have hchildPositive := CentralCoordinateGeometry.hchildPositive q cfg C₀ i' r + have hchildPositive := CentralCoordinateGeometry.hchildPositive q cfg i' r have hdomainT : (h.domain : Set GaussianInt) = FootprintVertices T := CentralCoordinateGeometry.hdomainT C₀ T₀ h₀ C T h hsub have hdomainFresh := CentralCoordinateGeometry.hdomainFresh q i' hs R rH hrootChildren r diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean index 14f285c0a6..40a3ab47a0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean @@ -394,12 +394,15 @@ private theorem hchildPositive : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((BandCircle) → - (∀ (i'' : Fin (3 : ℕ)), ∀ (r : Fin (3 : ℕ)), - let j : Fin 3 := i'' + r - 0 < (q j.succ).1)) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + BandOrderedGeneralConfiguration q → + ∀ (i'' : Fin (3 : ℕ)), + ∀ (r : Fin (3 : ℕ)), + let j : Fin 3 := i'' + r + 0 < (q j.succ).1 + ) := by classical - intro q cfg C₀ i'' r j + intro q cfg i'' r j have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 j have hne := cfg.noLine j.succ omega @@ -927,7 +930,7 @@ theorem P4261T1RightCoordinates e' i'' s S' hselectedCells R r hselectedCellsFresh ra hlayoutCells have hfootT : FootprintVertices T = FootprintVertices Pshift := RightCoordinateGeometry.hfootT q cfg C₀ T₀ cert T i' e' i'' s r ra hparentNonempty hselectedNonempty hcellsT - have hchildPositive := RightCoordinateGeometry.hchildPositive q cfg C₀ i'' r + have hchildPositive := RightCoordinateGeometry.hchildPositive q cfg i'' r have hdomainT : (h.domain : Set GaussianInt) = FootprintVertices T := PositiveCurvatureTileOdometerDomain C.1.1 T h C.property hsub.2.1 have hdomainFresh := RightCoordinateGeometry.hdomainFresh q i'' s R rH hrootChildren r diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean b/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean index 5d0106f917..3c1053907e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean @@ -27,62 +27,6 @@ namespace ApollonianSuperharmonic namespace AncestorSymmetryGeometry -private theorem hDomain : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (h : - PartialOdometer), ((↑k.domain : Set GaussianInt) = FootprintVertices U) → (((∀ (T : - ProtoTile), LatticeTile T ↔ LatticeTile (BandPackingSymmetryTileAction g T)) ∧ (∀ (T - : ProtoTile), TileArea (BandPackingSymmetryTileAction g T) = TileArea T) ∧ (∀ (T : - ProtoTile), ∀ (U : ProtoTile), BandPackingSymmetryTileAction g (TileCellComplement T - U) = TileCellComplement (BandPackingSymmetryTileAction g T) - (BandPackingSymmetryTileAction g U)) ∧ (∀ (T : ProtoTile), ∀ (U : ProtoTile), - TileTouching T U ↔ TileTouching (BandPackingSymmetryTileAction g T) - (BandPackingSymmetryTileAction g U)) ∧ (∀ (T : ProtoTile), QuarterTurnSymmetric T ↔ - QuarterTurnSymmetric (BandPackingSymmetryTileAction g T)) ∧ (∀ (T : ProtoTile), ∀ (U - : ProtoTile), ∀ (V : ProtoTile), TouchingTriple T U V ↔ TouchingTriple - (BandPackingSymmetryTileAction g T) (BandPackingSymmetryTileAction g U) - (BandPackingSymmetryTileAction g V)) ∧ (∀ (T : ProtoTile), ∀ (v : GaussianInt), - BandPackingSymmetryTileAction g (TileTranslation T v) = TileTranslation - (BandPackingSymmetryTileAction g T) (BandPackingSymmetryVectorAction g v)) ∧ (∀ (T : - ProtoTile), FootprintVertices (BandPackingSymmetryTileAction g T) = - BandPackingSymmetryVectorAction g '' FootprintVertices T) ∧ (∀ (T : ProtoTile), - FootprintEdges (BandPackingSymmetryTileAction g T) = (fun (e : Finset GaussianInt) => - Finset.image (BandPackingSymmetryVectorAction g) e) '' FootprintEdges T) ∧ (∀ (T : - ProtoTile), ∀ (U : ProtoTile), (FootprintVertices T ∩ FootprintVertices - U).Subsingleton ↔ (FootprintVertices (BandPackingSymmetryTileAction g T) ∩ - FootprintVertices (BandPackingSymmetryTileAction g U)).Subsingleton) ∧ ∀ (S : Fin (3 - : ℕ) → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (o : - PeriodicSubtileIndex), BandPackingSymmetryTileAction g - (SubtileOccurrenceInterpretation S u v o) = SubtileOccurrenceInterpretation (fun (i : - Fin (3 : ℕ)) (s : Bool) => BandPackingSymmetryTileAction g (S i s)) - (BandPackingSymmetryVectorAction g u) (BandPackingSymmetryVectorAction g v) o) → - (((↑(BandPackingSymmetryPartialOdometerAction g k).domain : Set GaussianInt) = - BandPackingSymmetryVectorAction g '' (↑k.domain : Set GaussianInt) ∧ - BandPackingSymmetryPartialOdometerAction BandPackingSymmetry.identity k = k ∧ (∀ (w : - GaussianInt), ∀ (x : GaussianInt), x ∈ k.domain → - (BandPackingSymmetryPartialOdometerAction (BandPackingSymmetry.shift w) k).value x = - k.value x + BandPackingShiftPotential w x) ∧ (∀ x ∈ - (BandPackingSymmetryPartialOdometerAction BandPackingSymmetry.negate k).domain, - (BandPackingSymmetryPartialOdometerAction BandPackingSymmetry.negate k).value x = - k.value (-GaussianQuarterTurn x)) ∧ (∀ x ∈ (BandPackingSymmetryPartialOdometerAction - BandPackingSymmetry.conjugate k).domain, (BandPackingSymmetryPartialOdometerAction - BandPackingSymmetry.conjugate k).value x = k.value (-GaussianReflection x)) ∧ (∀ (a : - BandPackingSymmetry), ∀ (b : BandPackingSymmetry), - BandPackingSymmetryPartialOdometerAction (a.comp b) k = - BandPackingSymmetryPartialOdometerAction a (BandPackingSymmetryPartialOdometerAction - b k)) ∧ (OdometerCompatibility (BandPackingSymmetryPartialOdometerAction g k) - (BandPackingSymmetryPartialOdometerAction g h) ↔ OdometerCompatibility k h) ∧ ∀ (T : - ProtoTile), Finset.Nonempty T.cells → PartialOdometerSquares k = T.cells → - PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g k) = Option.map - (BandPackingSymmetrySlopeAction g T) (PartialOdometerSlope k)) → - (((BandPackingSymmetryPartialOdometerAction g k).domain : Set GaussianInt) = - FootprintVertices (BandPackingSymmetryTileAction g U)))) ) := by - classical - intro g U k h hDom hFoot hOdo - rw [hOdo.1, hDom, hFoot.2.2.2.2.2.2.2.1] - private theorem hInclusion : (by classical @@ -529,7 +473,10 @@ theorem P4261T2AncestorSymmetry have hTile' := BandPackingSymmetryTileOdometerCovariance g D T h hTile have hFoot := BandPackingSymmetryTilingTransport g have hOdo := BandPackingSymmetryPartialOdometerActionFormulas g k h - have hDomain := AncestorSymmetryGeometry.hDomain g U k h hDom hFoot hOdo + have hDomain : + ((BandPackingSymmetryPartialOdometerAction g k).domain : Set GaussianInt) = + FootprintVertices (BandPackingSymmetryTileAction g U) := by + rw [hOdo.1, hDom, hFoot.2.2.2.2.2.2.2.1] have hInclusion := AncestorSymmetryGeometry.hInclusion g k h hIncl have actionForward (a : BandPackingSymmetry) (p : PartialOdometer) (x : GaussianInt) (hx : x ∈ p.domain) := AncestorSymmetryGeometry.actionForward a p x hx diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean index af03b58890..8b1449f8bb 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean @@ -30,13 +30,19 @@ private theorem unitForm : (by classical exact - (BandCircle) → (∀ (c : CircleCoordinates), (c.1 = 1) → (∀ (T : ProtoTile), ∀ (h : - PartialOdometer), TileOdometer c T h → ∃ z x, c = (1, 1 + 2 * z) ∧ T.cells = {x} ∧ - (h.domain : Set GaussianInt) = FootprintVertices T ∧ OdometerTranslation h - (CurvatureOneOdometer z))) + ∀ (c : CircleCoordinates), + c.1 = 1 → + ∀ (T : ProtoTile), + ∀ (h : PartialOdometer), + TileOdometer c T h → + ∃ z x, + c = (1, 1 + 2 * z) ∧ + T.cells = { x } ∧ + (h.domain : Set GaussianInt) = FootprintVertices T ∧ + OdometerTranslation h (CurvatureOneOdometer z) ) := by classical - intro C c hc T h ho + intro c hc T h ho induction ho with | line w x hw h hdom => simp at hc | @unit z x T h hT hdom htrans => exact ⟨z, x, rfl, hT, hdom, htrans⟩ @@ -54,13 +60,20 @@ private theorem unitData : (by classical exact - (BandCircle) → (∀ (z : GaussianInt), ∀ (x : GaussianInt), ∀ (T : ProtoTile), ∀ (h : - PartialOdometer), T.cells = {x} → (h.domain : Set GaussianInt) = FootprintVertices T - → OdometerTranslation h (CurvatureOneOdometer z) → ∃ a : GaussianInt, ∃ b : ℤ, h = - PartialOdometerAffineTranslate (CurvatureOneOdometer z) x a b) + ∀ (z : GaussianInt), + ∀ (x : GaussianInt), + ∀ (T : ProtoTile), + ∀ (h : PartialOdometer), + T.cells = { x } → + (h.domain : Set GaussianInt) = FootprintVertices T → + OdometerTranslation h (CurvatureOneOdometer z) → + ∃ a : GaussianInt, + ∃ b : ℤ, + h = + PartialOdometerAffineTranslate (CurvatureOneOdometer z) x a b ) := by classical - intro C z x T h hT hdom htrans + intro z x T h hT hdom htrans obtain ⟨v, a, b, hd, hv⟩ := htrans have hdomSq : (h.domain : Set GaussianInt) = {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩} := by @@ -183,20 +196,36 @@ private theorem horizontalPositive : (by classical exact - (BandCircle) → (∀ (z : GaussianInt), (LatticeCell) → ((LatticeCell) → ((GaussianInt) → - ((GaussianInt) → (∀ (f : PartialOdometer), ∀ (g : PartialOdometer), ∀ (x : - GaussianInt), ∀ (y : GaussianInt), ∀ (α : GaussianInt), ∀ (β : GaussianInt), ∀ (B : - ℤ), ∀ (D : ℤ), (↑f.domain : Set GaussianInt) = {x, x + (1 : GaussianInt), - x + ⟨(0 : ℤ), (1 : ℤ)⟩, x + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} → (↑g.domain : - Set GaussianInt) = {y, y + (1 : GaussianInt), y + ⟨(0 : ℤ), (1 : ℤ)⟩, - y + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} → (∀ t ∈ f.domain, f.value t = - (CurvatureOneOdometer z).value (t - x) + α.re * t.re + α.im * t.im + B) → (∀ t ∈ - g.domain, g.value t = (CurvatureOneOdometer z).value (t - y) + β.re * t.re + β.im * - t.im + D) → y = x + (1 : GaussianInt) → β.im - α.im = z.im → OdometerCompatibility f - g))))) + ∀ (z : GaussianInt), + ∀ (f : PartialOdometer), + ∀ (g : PartialOdometer), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + ∀ (α : GaussianInt), + ∀ (β : GaussianInt), + ∀ (B : ℤ), + ∀ (D : ℤ), + (↑f.domain : Set GaussianInt) = + {x, x + (1 : GaussianInt), x + ⟨(0 : ℤ), (1 : ℤ)⟩, + x + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} → + (↑g.domain : Set GaussianInt) = + {y, y + (1 : GaussianInt), y + ⟨(0 : ℤ), (1 : ℤ)⟩, + y + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} → + (∀ t ∈ f.domain, + f.value t = + (CurvatureOneOdometer z).value (t - x) + α.re * t.re + + α.im * t.im + + B) → + (∀ t ∈ g.domain, + g.value t = + (CurvatureOneOdometer z).value (t - y) + β.re * t.re + + β.im * t.im + + D) → + y = x + (1 : GaussianInt) → + β.im - α.im = z.im → OdometerCompatibility f g ) := by classical - intro C z u v a a' f g x y α β B D df dg vf vg hstep hcoef + intro z f g x y α β B D df dg vf vg hstep hcoef subst y have fRe (t : GaussianInt) (ht : t ∈ f.domain) : t.re = x.re ∨ t.re = x.re + 1 := by @@ -303,20 +332,36 @@ private theorem verticalPositive : (by classical exact - (BandCircle) → (∀ (z : GaussianInt), (LatticeCell) → ((LatticeCell) → ((GaussianInt) → - ((GaussianInt) → (∀ (f : PartialOdometer), ∀ (g : PartialOdometer), ∀ (x : - GaussianInt), ∀ (y : GaussianInt), ∀ (α : GaussianInt), ∀ (β : GaussianInt), ∀ (B : - ℤ), ∀ (D : ℤ), (↑f.domain : Set GaussianInt) = {x, x + (1 : GaussianInt), - x + ⟨(0 : ℤ), (1 : ℤ)⟩, x + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} → (↑g.domain : - Set GaussianInt) = {y, y + (1 : GaussianInt), y + ⟨(0 : ℤ), (1 : ℤ)⟩, - y + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} → (∀ t ∈ f.domain, f.value t = - (CurvatureOneOdometer z).value (t - x) + α.re * t.re + α.im * t.im + B) → (∀ t ∈ - g.domain, g.value t = (CurvatureOneOdometer z).value (t - y) + β.re * t.re + β.im * - t.im + D) → y = x + ⟨(0 : ℤ), (1 : ℤ)⟩ → β.re - α.re = z.im → OdometerCompatibility f - g))))) + ∀ (z : GaussianInt), + ∀ (f : PartialOdometer), + ∀ (g : PartialOdometer), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + ∀ (α : GaussianInt), + ∀ (β : GaussianInt), + ∀ (B : ℤ), + ∀ (D : ℤ), + (↑f.domain : Set GaussianInt) = + {x, x + (1 : GaussianInt), x + ⟨(0 : ℤ), (1 : ℤ)⟩, + x + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} → + (↑g.domain : Set GaussianInt) = + {y, y + (1 : GaussianInt), y + ⟨(0 : ℤ), (1 : ℤ)⟩, + y + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩} → + (∀ t ∈ f.domain, + f.value t = + (CurvatureOneOdometer z).value (t - x) + α.re * t.re + + α.im * t.im + + B) → + (∀ t ∈ g.domain, + g.value t = + (CurvatureOneOdometer z).value (t - y) + β.re * t.re + + β.im * t.im + + D) → + y = x + ⟨(0 : ℤ), (1 : ℤ)⟩ → + β.re - α.re = z.im → OdometerCompatibility f g ) := by classical - intro C z u v a a' f g x y α β B D df dg vf vg hstep hcoef + intro z f g x y α β B D df dg vf vg hstep hcoef subst y have fRe (t : GaussianInt) (ht : t ∈ f.domain) : t.re = x.re ∨ t.re = x.re + 1 := by @@ -428,18 +473,24 @@ private theorem diagonalUnique : (by classical exact - (BandCircle) → (∀ (h : PartialOdometer), ∀ (k : PartialOdometer), (GaussianInt) → (∀ (u : - LatticeCell), ∀ (v : LatticeCell), (GaussianInt) → ((GaussianInt) → ((∀ (y : - GaussianInt), (y ∈ h.domain) → (y.re = u.re ∨ y.re = u.re + 1)) → ((∀ (y : - GaussianInt), (y ∈ h.domain) → (y.im = u.im ∨ y.im = u.im + 1)) → ((∀ (y : - GaussianInt), (y ∈ k.domain) → (y.re = v.re ∨ y.re = v.re + 1)) → ((∀ (y : - GaussianInt), (y ∈ k.domain) → (y.im = v.im ∨ y.im = v.im + 1)) → (v.re - u.re = (-1 - : ℤ) ∨ v.re - u.re = (1 : ℤ) → v.im - u.im = (-1 : ℤ) ∨ v.im - u.im = (1 : ℤ) → ∀ (s - : GaussianInt), ∀ (t : GaussianInt), s ∈ h.domain → s ∈ k.domain → t ∈ h.domain → t ∈ - k.domain → s = t)))))))) + ∀ (h : PartialOdometer), + ∀ (k : PartialOdometer), + ∀ (u : LatticeCell), + ∀ (v : LatticeCell), + (∀ (y : GaussianInt), y ∈ h.domain → y.re = u.re ∨ y.re = u.re + 1) → + (∀ (y : GaussianInt), y ∈ h.domain → y.im = u.im ∨ y.im = u.im + 1) → + (∀ (y : GaussianInt), y ∈ k.domain → y.re = v.re ∨ y.re = v.re + 1) → + (∀ (y : GaussianInt), + y ∈ k.domain → y.im = v.im ∨ y.im = v.im + 1) → + v.re - u.re = (-1 : ℤ) ∨ v.re - u.re = (1 : ℤ) → + v.im - u.im = (-1 : ℤ) ∨ v.im - u.im = (1 : ℤ) → + ∀ (s : GaussianInt), + ∀ (t : GaussianInt), + s ∈ h.domain → + s ∈ k.domain → t ∈ h.domain → t ∈ k.domain → s = t ) := by classical - intro C h k z u v a a' hReMem hImMem kReMem kImMem hx hy s t hs ks ht kt + intro h k u v hReMem hImMem kReMem kImMem hx hy s t hs ks ht kt have hre : s.re = t.re := by rcases hx with hx | hx · rcases hReMem s hs with hs0 | hs1 <;> @@ -466,12 +517,11 @@ private theorem compatibilitySymm : (by classical exact - (BandCircle) → ((GaussianInt) → ((LatticeCell) → ((LatticeCell) → ((GaussianInt) → - ((GaussianInt) → (∀ (f : PartialOdometer), ∀ (g : PartialOdometer), - OdometerCompatibility f g → OdometerCompatibility g f)))))) + ∀ (f : PartialOdometer), + ∀ (g : PartialOdometer), OdometerCompatibility f g → OdometerCompatibility g f ) := by classical - intro C z u v a a' f g hfg + intro f g hfg rcases hfg with hdisj | ⟨c, hc⟩ · apply Or.inl apply Set.disjoint_left.mpr @@ -832,7 +882,7 @@ theorem P4261T2UnitBoundary (T : ProtoTile) (h : PartialOdometer), TileOdometer c T h → ∃ z x, c = (1, 1 + 2 * z) ∧ T.cells = {x} ∧ (h.domain : Set GaussianInt) = FootprintVertices T ∧ - OdometerTranslation h (CurvatureOneOdometer z) := UnitBoundaryProof.unitForm C + OdometerTranslation h (CurvatureOneOdometer z) := UnitBoundaryProof.unitForm obtain ⟨z, u, hCz, hTu, hdu, hth⟩ := unitForm C.1.1 hc T h hh obtain ⟨z', v, hCz', hUv, hdu', hku⟩ := @@ -850,7 +900,7 @@ theorem P4261T2UnitBoundary OdometerTranslation h (CurvatureOneOdometer z) → ∃ a : GaussianInt, ∃ b : ℤ, h = PartialOdometerAffineTranslate (CurvatureOneOdometer z) x a b := - UnitBoundaryProof.unitData C z + UnitBoundaryProof.unitData z exact ⟨unitData u T h hTu hdu hth, unitData v U k hUv hdu' hku⟩ have canonicalSlope (w : GaussianInt) : @@ -934,7 +984,7 @@ theorem P4261T2UnitBoundary (CurvatureOneOdometer z).value (t - y) + β.re * t.re + β.im * t.im + D) (hstep : y = x + 1) (hcoef : β.im - α.im = z.im) : - OdometerCompatibility f g := UnitBoundaryProof.horizontalPositive C z u v a a' f g x y α β + OdometerCompatibility f g := UnitBoundaryProof.horizontalPositive z f g x y α β B D df dg vf vg hstep hcoef have verticalPositive (f g : PartialOdometer) (x y α β : GaussianInt) (B D : ℤ) @@ -949,17 +999,17 @@ theorem P4261T2UnitBoundary (CurvatureOneOdometer z).value (t - y) + β.re * t.re + β.im * t.im + D) (hstep : y = x + ⟨0, 1⟩) (hcoef : β.re - α.re = z.im) : - OdometerCompatibility f g := UnitBoundaryProof.verticalPositive C z u v a a' f g x y α β B + OdometerCompatibility f g := UnitBoundaryProof.verticalPositive z f g x y α β B D df dg vf vg hstep hcoef have diagonalUnique (hx : v.re - u.re = -1 ∨ v.re - u.re = 1) (hy : v.im - u.im = -1 ∨ v.im - u.im = 1) (s t : GaussianInt) (hs : s ∈ h.domain) (ks : s ∈ k.domain) - (ht : t ∈ h.domain) (kt : t ∈ k.domain) : s = t := UnitBoundaryProof.diagonalUnique C h k z - u v a a' hReMem hImMem kReMem kImMem hx hy s t hs ks ht kt + (ht : t ∈ h.domain) (kt : t ∈ k.domain) : s = t := UnitBoundaryProof.diagonalUnique h k + u v hReMem hImMem kReMem kImMem hx hy s t hs ks ht kt have compatibilitySymm (f g : PartialOdometer) : OdometerCompatibility f g → OdometerCompatibility g f := - UnitBoundaryProof.compatibilitySymm C z u v a a' f g + UnitBoundaryProof.compatibilitySymm f g by_cases hoverlap : ∃ y, y ∈ h.domain ∧ y ∈ k.domain · obtain ⟨w, wh, wk⟩ := hoverlap have bounds := overlapBounds w wh wk diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean index fc56474bd0..e5d96616b2 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean @@ -300,11 +300,13 @@ private theorem hFCellsInvolutive : (by classical exact - (Fin 4 → CircleCoordinates) → ((BandCircle) → ((Fin 3) → (∀ (centerShift : GaussianInt), - let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift - ∀ (X : ProtoTile), (F (F X)).cells = X.cells))) ) := by + ∀ (centerShift : GaussianInt), + let F : ProtoTile → ProtoTile := fun X => + TileTranslation (TileHalfTurn X) centerShift + ∀ (X : ProtoTile), (F (F X)).cells = X.cells + ) := by classical - intro q D i centerShift F X + intro centerShift F X have hfun : (GaussianTranslation centerShift ∘ (fun x : GaussianInt => -x - 1 - (⟨0, 1⟩ : GaussianInt)) ∘ GaussianTranslation centerShift ∘ @@ -334,26 +336,49 @@ private theorem hFTCells : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (i : Fin 3), - (q (0 : Fin (4 : ℕ)) = C.1.1) → ((q i.succ = D.1.1) → (∀ (T : ProtoTile), ∀ (U : - ProtoTile), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), (TileOdometer C.1.1 T - h) → ((TileCentroid U - TileCentroid T = GaussianRealPoint (BandVectors.1 (q i.succ) - (q (0 : Fin (4 : ℕ))))) → (∀ (centerShift : GaussianInt), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (a : GaussianInt), ∀ (b : ℤ), ((TileTranslation (TileHalfTurn - Rminus) centerShift).cells = Rplus.cells) → ((k = PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a b) → (∀ (q' : Fin (4 : ℕ) → - CircleCoordinates), (q' (0 : Fin (4 : ℕ)) = C.1.1) → ((q' i.succ = D.1.1) → - ((TileCentroid Rminus - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.1 (q' i.succ) (q' (0 : Fin (4 : ℕ))) - BandVectors.1 (q' (0 : Fin (4 : - ℕ))) (q' i.succ))) → ((TileCentroid Rplus - TileCentroid T = (1 / 2 : ℝ) • - GaussianRealPoint (BandVectors.1 (q' i.succ) (q' (0 : Fin (4 : ℕ))) + BandVectors.1 - (q' (0 : Fin (4 : ℕ))) (q' i.succ))) → ((BandPrototile C.1.1 U) → ((Finset.Nonempty - Rplus.cells) → ( - let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift - (F T).cells = U.cells)))))))))))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (C : BandCircle), + ∀ (D : BandCircle), + ∀ (i : Fin 3), + q (0 : Fin (4 : ℕ)) = C.1.1 → + q i.succ = D.1.1 → + ∀ (T : ProtoTile), + ∀ (U : ProtoTile), + ∀ (h : PartialOdometer), + TileOdometer C.1.1 T h → + TileCentroid U - TileCentroid T = + GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) → + ∀ (centerShift : GaussianInt), + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + GaussianInt → + ℤ → + (TileTranslation (TileHalfTurn Rminus) + centerShift).cells = + Rplus.cells → + ∀ (q' : Fin (4 : ℕ) → CircleCoordinates), + q' (0 : Fin (4 : ℕ)) = C.1.1 → + q' i.succ = D.1.1 → + TileCentroid Rminus - TileCentroid T = + (1 / 2 : ℝ) • + GaussianRealPoint + (BandVectors.1 (q' i.succ) (q' (0 : Fin (4 : ℕ))) - + BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' i.succ)) → + TileCentroid Rplus - TileCentroid T = + (1 / 2 : ℝ) • + GaussianRealPoint + (BandVectors.1 (q' i.succ) (q' (0 : Fin (4 : ℕ))) + + BandVectors.1 (q' (0 : Fin (4 : ℕ))) (q' i.succ)) → + BandPrototile C.1.1 U → + Finset.Nonempty Rplus.cells → + let F : ProtoTile → ProtoTile := fun X => + TileTranslation (TileHalfTurn X) centerShift + (F T).cells = U.cells + ) := by classical - intro q C D i hC hD T U h k hh hc centerShift Rminus Rplus a b hminusCells houterAffine q' hq0 - hqi hcentMinus hcentPlus hUband hRplusNe F + intro q C D i hC hD T U h hh hc centerShift Rminus Rplus a b hminusCells q' hq0 hqi hcentMinus + hcentPlus hUband hRplusNe F let hbar := PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a b have hbarO : TileOdometer C.1.1 (F T) hbar := @@ -471,13 +496,15 @@ private theorem hstep : (by classical exact - (Fin 4 → CircleCoordinates) → ((BandCircle) → ((Fin 3) → (∀ (centerShift : GaussianInt), - let f : GaussianInt → GaussianInt := fun z => - GaussianTranslation centerShift (GaussianQuarterTurn (GaussianQuarterTurn z)) - ∀ x y : GaussianInt, (y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → (f y = f - x + 1 ∨ f y = f x - 1 ∨ f y = f x + ⟨0, 1⟩ ∨ f y = f x - ⟨0, 1⟩)))) ) := by + ∀ (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation centerShift (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ x y : GaussianInt, + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + f y = f x + 1 ∨ f y = f x - 1 ∨ f y = f x + ⟨0, 1⟩ ∨ f y = f x - ⟨0, 1⟩ + ) := by classical - intro q D i centerShift f x y hy + intro centerShift f x y hy rcases hy with hy | hy | hy | hy all_goals subst y; first | left; apply Zsqrtd.ext <;> simp [f, GaussianTranslation, GaussianQuarterTurn] <;> omega @@ -619,12 +646,13 @@ private theorem hfixedUnique : (by classical exact - (Fin 4 → CircleCoordinates) → ((BandCircle) → ((Fin 3) → (∀ (centerShift : GaussianInt), - let f : GaussianInt → GaussianInt := fun z => - GaussianTranslation centerShift (GaussianQuarterTurn (GaussianQuarterTurn z)) - ∀ (x : GaussianInt), ∀ (y : GaussianInt), (f x = x) → ((f y = y) → (x = y))))) ) := by + ∀ (centerShift : GaussianInt), + let f : GaussianInt → GaussianInt := fun z => + GaussianTranslation centerShift (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∀ (x : GaussianInt), ∀ (y : GaussianInt), f x = x → f y = y → x = y + ) := by classical - intro q D i centerShift f x y hx hy + intro centerShift f x y hx hy have hx' := by simpa [f, GaussianTranslation, GaussianQuarterTurn] using hx have hy' := by simpa [f, GaussianTranslation, GaussianQuarterTurn] using hy apply Zsqrtd.ext @@ -732,11 +760,12 @@ private theorem hCpositive : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → (∀ (C : - BandCircle), (BandCircle) → ((Fin 3) → ((q (0 : Fin (4 : ℕ)) = C.1.1) → (0 < - C.1.1.1)))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + BandOrderedGeneralConfiguration q → + ∀ (C : BandCircle), q (0 : Fin (4 : ℕ)) = C.1.1 → 0 < C.1.1.1 + ) := by classical - intro q cfg C D i hC + intro q cfg C hC have hc := cfg.childLarge rw [hC] at hc omega @@ -895,15 +924,20 @@ private theorem hpathIndex : (by classical exact - (Fin 4 → CircleCoordinates) → ((BandCircle) → ((BandCircle) → ((Fin 3) → (∀ (T : - ProtoTile), ∀ (U : ProtoTile), ∀ (path : List GaussianInt), (path.Nodup) → ((∀ (e : - Finset GaussianInt), e ∈ FootprintEdges T ∩ FootprintEdges U ↔ ∃ (a : GaussianInt) (b - : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), path = l₁ ++ a :: b - :: l₂ ∧ e = {a, b}) → (∀ a b : GaussianInt, {a, b} ∈ FootprintEdges T ∩ - FootprintEdges U → path.idxOf a + 1 = path.idxOf b ∨ path.idxOf b + 1 = path.idxOf - a)))))) ) := by + ∀ (T : ProtoTile), + ∀ (U : ProtoTile), + ∀ (path : List GaussianInt), + path.Nodup → + (∀ (e : Finset GaussianInt), + e ∈ FootprintEdges T ∩ FootprintEdges U ↔ + ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : + List GaussianInt), path = l₁ ++ a :: b :: l₂ ∧ e = { a, b }) → + ∀ a b : GaussianInt, + { a, b } ∈ FootprintEdges T ∩ FootprintEdges U → + path.idxOf a + 1 = path.idxOf b ∨ path.idxOf b + 1 = path.idxOf a + ) := by classical - intro q C D i T U path hpathNodup hpathEdges a b hab + intro T U path hpathNodup hpathEdges a b hab rcases (hpathEdges {a, b}).mp hab with ⟨c, d, l, r, heq, hedge⟩ have hnd := hpathNodup rw [heq, List.nodup_append] at hnd @@ -1035,7 +1069,10 @@ private theorem hcovered : (by classical exact - (Fin 4 → CircleCoordinates) → ((BandCircle) → ((BandCircle) → ((Fin 3) → (∀ (T : + ( + ( + ( + (∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (Epositive : ExactTileInterfaceTriple T U Rplus), ∀ (walk : List GaussianInt), (∀ x y : GaussianInt, ∀ pre post : List GaussianInt, walk = pre ++ x :: y :: post → {x, y} ∈ @@ -1052,9 +1089,9 @@ private theorem hcovered : post → ∃ l r : List GaussianInt, ∃ a b : GaussianInt, walk = l ++ a :: b :: r ∧ ({a, b} : Finset GaussianInt) = {x, y})))))))))))))) ) := by classical - intro q C D i T U Rplus Epositive walk hwalkOuterEdges path hpathLength hpathIndex - hpathIndexInjective hstartIndex hfinishIndex hpathIndexEdge hwalkHeadPos hwalkLastPos - hwalkVertexPath u v pre post hsplit + intro T U Rplus Epositive walk hwalkOuterEdges path hpathLength hpathIndex hpathIndexInjective + hstartIndex hfinishIndex hpathIndexEdge hwalkHeadPos hwalkLastPos hwalkVertexPath u v pre + post hsplit have hindices := hpathIndexEdge u v pre post hsplit have humem : u ∈ path := by rw [hsplit]; simp have hvmem : v ∈ path := by rw [hsplit]; simp @@ -1235,11 +1272,11 @@ theorem P4261T2UnitInterface have htriplePositive := UnitInterfaceGeometry.htriplePositive q cfg C D i hC hD T U cert hsym hc Rplus q' hq0 hqi hcentPlus hTband hUband hRplusBand hUNe let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift - have hFTCells : (F T).cells = U.cells := UnitInterfaceGeometry.hFTCells q C D i hC hD T U h k - hh hc centerShift Rminus Rplus a b hminusCells houterAffine q' hq0 hqi hcentMinus hcentPlus + have hFTCells : (F T).cells = U.cells := UnitInterfaceGeometry.hFTCells q C D i hC hD T U h + hh hc centerShift Rminus Rplus a b hminusCells q' hq0 hqi hcentMinus hcentPlus hUband hRplusNe have hFUCells : (F U).cells = T.cells := UnitInterfaceGeometry.hFUCells T U centerShift - (UnitInterfaceGeometry.hFCellsInvolutive q D i centerShift) + (UnitInterfaceGeometry.hFCellsInvolutive centerShift) (UnitInterfaceGeometry.hFCellCongr centerShift) hFTCells have hFRplusCells : (F Rplus).cells = Rminus.cells := hplusCells let f : GaussianInt → GaussianInt := fun z => @@ -1248,7 +1285,7 @@ theorem P4261T2UnitInterface ∃ E' : ExactTileInterfaceTriple (F T) (F U) (F Rplus), E'.point = f E.point ∧ E'.otherAB = f E.otherAB := UnitInterfaceGeometry.hpositiveImage T U centerShift Rplus - (UnitInterfaceGeometry.hf centerShift) (UnitInterfaceGeometry.hstep q D i centerShift) + (UnitInterfaceGeometry.hf centerShift) (UnitInterfaceGeometry.hstep centerShift) (UnitInterfaceGeometry.hvertices centerShift) (UnitInterfaceGeometry.hedges centerShift) obtain ⟨Epositive⟩ := htriplePositive obtain ⟨Eimage, himagePoint, himageAB⟩ := hpositiveImage Epositive @@ -1290,11 +1327,11 @@ theorem P4261T2UnitInterface Epositive Eimage himagePoint hvFT hvFU hvFR heFT heFU heFR hendpointPair (UnitInterfaceGeometry.hpointNotFixed T U centerShift Rminus Rplus Epositive Eimage himageAB hvFT hvFU hvFR heFT heFU heFR hendpointPair (UnitInterfaceGeometry.hposNe T U - Rplus Epositive hposPath) hinvolutive (UnitInterfaceGeometry.hfixedUnique q D i centerShift)) + Rplus Epositive hposPath) hinvolutive (UnitInterfaceGeometry.hfixedUnique centerShift)) obtain ⟨walk, hwalkHead, hwalkLast, hwalkChain, hwalkVertices, hwalkEdges⟩ := OpposingStringInterfacePath D orientation base Rminus Rplus hRminusNeRplus hnonadj tiles reverseTiles hstring hreverse - have hCpositive := UnitInterfaceGeometry.hCpositive q cfg C D i hC + have hCpositive := UnitInterfaceGeometry.hCpositive q cfg C hC have hdomOuterT : (h.domain : Set GaussianInt) = FootprintVertices T := PositiveCurvatureTileOdometerDomain C.1.1 T h hCpositive hh have hdomOuterU : (k.domain : Set GaussianInt) = FootprintVertices U := @@ -1312,7 +1349,7 @@ theorem P4261T2UnitInterface hwalkInOuter obtain ⟨path, hpathNodup, hpathLength, hpathHead, hpathLast, hpathVertices, hpathStep, hpathEdges⟩ := Epositive.pathAB - have hpathIndex := UnitInterfaceGeometry.hpathIndex q C D i T U path hpathNodup hpathEdges + have hpathIndex := UnitInterfaceGeometry.hpathIndex T U path hpathNodup hpathEdges have hpathIndexInjective {a b : GaussianInt} (ha : a ∈ path) (hidx : path.idxOf a = path.idxOf b) : a = b := (List.idxOf_inj ha).mp hidx @@ -1342,7 +1379,7 @@ theorem P4261T2UnitInterface edges := hpathEdges restrictions := (UnitInterfaceGeometry.hrestrictions C D T U h k tiles reverseTiles functions reverseFunctions hrestrictionsForward hrestrictionsBackward walk hwalkEdges path - (UnitInterfaceGeometry.hcovered q C D i T U Rplus Epositive walk hwalkOuterEdges path + (UnitInterfaceGeometry.hcovered T U Rplus Epositive walk hwalkOuterEdges path hpathLength hpathIndex hpathIndexInjective hstartIndex (UnitInterfaceGeometry.hfinishIndex T U Rplus Epositive path hpathLength hpathHead) (UnitInterfaceGeometry.hpathIndexEdge path hpathNodup) diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean index 8f4cbd5ed0..453611649c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean @@ -66,13 +66,13 @@ private theorem neighbor_injective : (by classical exact - ∀ (Ci : BandCircle), (List GaussianInt) → ((PeriodicTileComplex ↥(TilingLattice Ci)) → ( let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] - ∀ (x : GaussianInt), ∀ {j : Fin 4}, ∀ {k : Fin 4}, (neighbor x j = neighbor x k) → (j = - k))) ) := by + ∀ (x : GaussianInt), + ∀ {j : Fin 4}, ∀ {k : Fin 4}, neighbor x j = neighbor x k → j = k + ) := by classical - intro Ci path P neighbor x j k h + intro neighbor x j k h fin_cases j <;> fin_cases k <;> simp [neighbor, Zsqrtd.ext_iff] at h ⊢ <;> omega @@ -680,16 +680,23 @@ private theorem internal_edge_unique : (by classical exact - ∀ (Ci : BandCircle), ∀ (path : List GaussianInt), (PeriodicTileComplex ↥(TilingLattice - Ci)) → (∀ (x : GaussianInt), (path.Nodup) → (∀ (pre : List GaussianInt), ∀ (y : - GaussianInt), ∀ (hpre' : pre ≠ []), - let z := pre.getLast hpre' - let pre' := pre.dropLast - (path.idxOf x = pre'.length + 1) → ((path.idxOf y = pre'.length + 2) → ((path.idxOf z = - pre'.length) → (∀ (e : Finset GaussianInt), (∃ a b l r, path = l ++ a :: b :: r ∧ e = - {a, b}) → ((x ∈ e) → (e = {z, x} ∨ e = {x, y}))))))) ) := by + ∀ (path : List GaussianInt), + ∀ (x : GaussianInt), + path.Nodup → + ∀ (pre : List GaussianInt), + ∀ (y : GaussianInt), + ∀ (hpre' : pre ≠ []), + let z := pre.getLast hpre' + let pre' := pre.dropLast + path.idxOf x = pre'.length + 1 → + path.idxOf y = pre'.length + 2 → + path.idxOf z = pre'.length → + ∀ (e : Finset GaussianInt), + (∃ a b l r, path = l ++ a :: b :: r ∧ e = { a, b }) → + x ∈ e → e = { z, x } ∨ e = { x, y } + ) := by classical - intro Ci path P x hnodup pre y hpre' z pre' hidxX hidxY hidxZ e he hxe + intro path x hnodup pre y hpre' z pre' hidxX hidxY hidxZ e he hxe rcases he with ⟨a, b, l, r, hdecomp, heq⟩ have hcases : x = a ∨ x = b := by have : x ∈ ({a, b} : Finset GaussianInt) := by @@ -1551,7 +1558,7 @@ private theorem interiorSector : owner_unique x UR VR iaR ibR jR hURidx hVRidx hsectorR hURsub hVRsub have transition_is_path_edge := LocalSectorGeometry.transition_is_path_edge T0 T0' path edgeAt_mem edgeAt_injective edge_of_sector_cell x hedgesPath pre y hpre' jL eL jR eR - (LocalSectorGeometry.internal_edge_unique Ci path P x hnodup pre y hpre' + (LocalSectorGeometry.internal_edge_unique path x hnodup pre y hpre' (LocalSectorGeometry.hidxX path x pre y rest hpre' hleft hnodupPath) (LocalSectorGeometry.hidxY path x pre y rest hpre' hleft hnodupPath) (LocalSectorGeometry.hidxZ path x pre y rest hpre' hleft hnodupPath)) @@ -1690,8 +1697,8 @@ theorem P4366T2LocalSectors have edgeAt_eq_pair := LatticeVertexSectorFacts.edgePair have edgeAt_injective (x : GaussianInt) {j k : Fin 4} (h : edgeAt x j = edgeAt x k) := LatticeVertexSectorFacts.edgeInjective - (LatticeVertexSectorFacts.neighborDistinct) (LocalSectorGeometry.neighbor_injective Ci - path P) edgeAt_mem x (j := j) (k := k) h + (LatticeVertexSectorFacts.neighborDistinct) (LocalSectorGeometry.neighbor_injective) + edgeAt_mem x (j := j) (k := k) h have edge_of_sector_cell := LocalSectorGeometry.edge_of_sector_cell let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => if LatticeVertexIncidentCell x j ∈ T0.cells then 0 diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean index 30a647088e..6573399e23 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean @@ -142,10 +142,12 @@ private theorem centroid_cells_eq : (by classical exact - ∀ (A : ProtoTile), ∀ (B : ProtoTile), (A.cells.Nonempty) → ((B.cells.Nonempty) → - ((A.cells = B.cells) → (TileCentroid A = TileCentroid B))) ) := by + ∀ (A : ProtoTile), + ∀ (B : ProtoTile), + B.cells.Nonempty → A.cells = B.cells → TileCentroid A = TileCentroid B + ) := by classical - intro A B hA hB hc + intro A B hB hc simp [TileCentroid, hB, hc] private theorem hFminusne : @@ -879,32 +881,55 @@ private theorem houterEnds : (by classical exact - (Fin 4 -> CircleCoordinates) → ((BandCircle) → ((Fin 3) → (∀ (T0 : ProtoTile), ∀ (T0' : - ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (centerShift : - GaussianInt), ∀ (Eplus : ExactTileInterfaceTriple T0 T0' Rplus), - let f : GaussianInt → GaussianInt := fun x => -x + centerShift - ∀ (pAB : SimpleGridPathBetween (FootprintVertices T0 ∩ FootprintVertices T0') - (FootprintEdges T0 ∩ FootprintEdges T0') (f Eplus.point) (f Eplus.otherAB)), ∀ (pBC : - SimpleGridPathBetween (FootprintVertices T0' ∩ FootprintVertices Rminus) - (FootprintEdges T0' ∩ FootprintEdges Rminus) (f Eplus.point) (f Eplus.otherCA)), ∀ - (pCA : SimpleGridPathBetween (FootprintVertices Rminus ∩ FootprintVertices T0) - (FootprintEdges Rminus ∩ FootprintEdges T0) (f Eplus.point) (f Eplus.otherBC)), ∀ - (hunique : ∀ x, x ∈ FootprintVertices T0 ∩ FootprintVertices T0' ∩ FootprintVertices - Rminus ↔ x = f Eplus.point), - let EM : ExactTileInterfaceTriple T0 T0' Rminus := - { point := f Eplus.point - otherAB := f Eplus.otherAB - otherBC := f Eplus.otherCA - otherCA := f Eplus.otherBC - pathAB := pAB - pathBC := pBC - pathCA := pCA - unique_common := hunique } - (Eplus.point ≠ Eplus.otherAB) → ((Eplus.point = EM.point ∧ Eplus.otherAB = EM.otherAB ∨ - Eplus.point = EM.otherAB ∧ Eplus.otherAB = EM.point) → (f Eplus.point = Eplus.otherAB - ∧ f Eplus.otherAB = Eplus.point))))) ) := by + ∀ (T0 : ProtoTile), + ∀ (T0' : ProtoTile), + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + ∀ (centerShift : GaussianInt), + ∀ (Eplus : ExactTileInterfaceTriple T0 T0' Rplus), + let f : GaussianInt → GaussianInt := fun x => -x + centerShift + ∀ + (pAB : + SimpleGridPathBetween + (FootprintVertices T0 ∩ FootprintVertices T0') + (FootprintEdges T0 ∩ FootprintEdges T0') (f Eplus.point) + (f Eplus.otherAB)), + ∀ + (pBC : + SimpleGridPathBetween + (FootprintVertices T0' ∩ FootprintVertices Rminus) + (FootprintEdges T0' ∩ FootprintEdges Rminus) (f Eplus.point) + (f Eplus.otherCA)), + ∀ + (pCA : + SimpleGridPathBetween + (FootprintVertices Rminus ∩ FootprintVertices T0) + (FootprintEdges Rminus ∩ FootprintEdges T0) (f Eplus.point) + (f Eplus.otherBC)), + ∀ + (hunique : + ∀ x, + x ∈ + FootprintVertices T0 ∩ FootprintVertices T0' ∩ + FootprintVertices Rminus ↔ + x = f Eplus.point), + let EM : ExactTileInterfaceTriple T0 T0' Rminus := + { point := f Eplus.point + otherAB := f Eplus.otherAB + otherBC := f Eplus.otherCA + otherCA := f Eplus.otherBC + pathAB := pAB + pathBC := pBC + pathCA := pCA + unique_common := hunique } + Eplus.point ≠ Eplus.otherAB → + Eplus.point = EM.point ∧ Eplus.otherAB = EM.otherAB ∨ + Eplus.point = EM.otherAB ∧ Eplus.otherAB = EM.point → + f Eplus.point = Eplus.otherAB ∧ + f Eplus.otherAB = Eplus.point + ) := by classical - intro q Ci i T0 T0' Rminus Rplus centerShift Eplus f pAB pBC pCA hunique EM hpt hpairCases + intro T0 T0' Rminus Rplus centerShift Eplus f pAB pBC pCA hunique EM hpt hpairCases rcases hpairCases with hfix | hswap · rcases hfix with ⟨hfp, hft⟩ have hu1 : centerShift = Eplus.point + Eplus.point := by @@ -1391,10 +1416,9 @@ theorem P4366T2OuterGeometry have centroid_cells_eq := OuterGeometry.centroid_cells_eq have hFplusne := OuterGeometry.hFplusne Rminus Rplus centerShift hpc hRmne have hcentFminus : TileCentroid (TileTranslation (TileHalfTurn Rminus) centerShift) = - TileCentroid Rplus := centroid_cells_eq _ _ (OuterGeometry.hFminusne Rminus Rplus - centerShift hmc hRpne) hRpne hmc + TileCentroid Rplus := centroid_cells_eq _ _ hRpne hmc have hcentFplus : TileCentroid (TileTranslation (TileHalfTurn Rplus) centerShift) = - TileCentroid Rminus := centroid_cells_eq _ _ hFplusne hRmne hpc + TileCentroid Rminus := centroid_cells_eq _ _ hRmne hpc have hcentHalfMinus : TileCentroid (TileHalfTurn Rminus) = (-(TileCentroid Rminus).1, -(TileCentroid Rminus).2) := (TileHalfTurnFormulas Rminus).2.2.2.2.2.2.2.1 @@ -1483,7 +1507,7 @@ theorem P4366T2OuterGeometry {EM.point, EM.otherAB} := SimpleGridPathEndpointPairUnique Eplus.pathAB EM.pathAB have hOuterPath := OuterGeometry.hOuterPath T0 T0' Rminus Rplus centerShift Eplus pAB pBC pCA - hunique (OuterGeometry.houterEnds q Ci i T0 T0' Rminus Rplus centerShift Eplus pAB pBC pCA + hunique (OuterGeometry.houterEnds T0 T0' Rminus Rplus centerShift Eplus pAB pBC pCA hunique hpt (OuterGeometry.hpairCases T0 T0' Rminus Rplus centerShift Eplus pAB pBC pCA hunique hpt hpair)) (OuterGeometry.reversePath) have hlatMinus := OuterGeometry.hlatMinus Rminus Rplus centerShift hpc hlatPlus diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean b/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean index 7424a9d1e8..6e6c3f5a6e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean @@ -186,29 +186,48 @@ private theorem selected_slot : (by classical exact - ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : - PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : - BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration - bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot - bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction - bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot - bundle.selectedSign bundle.routedDirection), (Fin 4) → ( - let q := bundle.normalizedPresentation - let cert := placement.layout - let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v - let slot : SixSubtileLabel → Fin 3 := fun l => match l with - | .A | .B => 0 - | .C | .D => 1 - | .E | .F => 2 - ((bundle.pieces bundle.selectedSlot bundle.selectedSign).cells = (occurrence - placement.centralIndex).cells) → ((∀ (j : Fin 3), 0 < (q j.succ).1) → ((∀ (a : - PeriodicSubtileIndex), TileArea (occurrence a) = Int.toNat (q (slot a.label).succ).1) - → ((TileArea (bundle.pieces bundle.selectedSlot bundle.selectedSign) = Int.toNat (q - bundle.selectedSlot.succ).1) → (bundle.selectedSlot = slot - placement.centralIndex.label))))) ) := by + ∀ (C : BandCircle), + ∀ (D : BandCircle), + ∀ (T : ProtoTile), + ∀ (N : ProtoTile), + ∀ (h : PartialOdometer), + ∀ (k : PartialOdometer), + ∀ (x : GaussianInt), + ∀ + (bundle : + BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), + ∀ + (placement : + BandOrderedGeneralSubtilePlacement + bundle.normalizedPresentation bundle.configuration + bundle.normalizedCircle bundle.normalizedFixedCircle + bundle.normalizedRoot bundle.normalizedFixed + bundle.normalizedRootFunction bundle.normalizedFixedFunction + bundle.normalizedPoint bundle.pieces bundle.functions + bundle.selectedSlot bundle.selectedSign + bundle.routedDirection), + let q := bundle.normalizedPresentation + let cert := placement.layout + let occurrence := + SubtileOccurrenceInterpretation cert.P cert.u cert.v + let slot : SixSubtileLabel → Fin 3 := fun l => + match l with + | .A | .B => 0 + | .C | .D => 1 + | .E | .F => 2 + (bundle.pieces bundle.selectedSlot bundle.selectedSign).cells = + (occurrence placement.centralIndex).cells → + (∀ (j : Fin 3), 0 < (q j.succ).1) → + (∀ (a : PeriodicSubtileIndex), + TileArea (occurrence a) = + Int.toNat (q (slot a.label).succ).1) → + TileArea + (bundle.pieces bundle.selectedSlot bundle.selectedSign) = + Int.toNat (q bundle.selectedSlot.succ).1 → + bundle.selectedSlot = slot placement.centralIndex.label + ) := by classical - intro C D T N h k x bundle placement s q cert occurrence slot selected_cells positive_parent + intro C D T N h k x bundle placement q cert occurrence slot selected_cells positive_parent occurrence_area selected_area let cfg := bundle.configuration have heq : Int.toNat (q bundle.selectedSlot.succ).1 = @@ -1178,7 +1197,7 @@ theorem P4418T3PresentedRowAdjacency : area_of_band _ _ (positive_parent _) (TileOdometerBandPrototile _ _ _ (bundle.piece_odometer _ _)) have selected_slot := PresentedRowAdjacencyGeometry.selected_slot C D T N h k x bundle - placement s selected_cells + placement selected_cells positive_parent (PresentedRowAdjacencyGeometry.occurrence_area C D T N h k x bundle placement positive_parent area_of_band) selected_area have selected_circle : C'.1.1 = q (slot placement.centralIndex.label).succ := by diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean b/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean index 84e9f141fa..1b0fd601b5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean @@ -454,62 +454,126 @@ private theorem hfirst_criterion : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : - P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v - a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) - (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices - q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (x : GaussianInt), ∀ (j - : Fin 4), ∀ (edge : Finset GaussianInt), (x ∈ edge) → ((edge ∈ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → - ((LatticeVertexIncidentCell x j ∈ (SubtileOccurrenceInterpretation cert.P cert.u - cert.v a).cells) → ((LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( - let shift : GaussianInt := match P3996T1SRowTable q cfg C T cert row with - | some z => z.oldShift - | none => match a.label with - | .A => if a.first = -1 then -cert.u else cert.u - | .B => if a.first = 1 then cert.u else -cert.u - | .C => -cert.v - | .D => cert.v - | .E | .F => 0 - let oldCoord : Int × Int := routedOldCoordinates row - (shift = (oldCoord.1 : GaussianInt) * cert.u + (oldCoord.2 : GaussianInt) * cert.v) → - (((a.first, a.second) ≠ oldCoord) → (((b.first, b.second) ≠ oldCoord) → ((∀ (m : - Int), ∀ (n : Int), ∀ (r : Int), ∀ (s : Int), ((m, n) ≠ (r, s)) → (Disjoint - (TileTranslation T ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells - (TileTranslation T ((r : GaussianInt) * cert.u + (s : GaussianInt) * cert.v)).cells)) - → (((TileTranslation T shift).cells.Nonempty) → ((∀ (U : ProtoTile), - (U.cells.Nonempty) → (∀ (z : GaussianInt), (z ∈ FootprintVertices U) → (∃ k : Fin 4, - LatticeVertexIncidentCell z k ∈ U.cells))) → ((∀ (U : ProtoTile), (U.cells.Nonempty) - → (∀ (z : GaussianInt), ∀ (k : Fin 4), (LatticeVertexIncidentCell z k ∈ U.cells) → (z - ∈ FootprintVertices U))) → ( - let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v a - let W := SubtileOccurrenceInterpretation cert.P cert.u cert.v b - let G₀ := SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 - (∀ c : LatticeCell, c ∈ G₀.cells → c ∈ (TileTranslation T - (((P4418T3EndpointOwnerIndices q cfg C T cert a b row).1.first : GaussianInt) * - cert.u + ((P4418T3EndpointOwnerIndices q cfg C T cert a b row).1.second : - GaussianInt) * cert.v)).cells) → ((Disjoint V.cells (TileTranslation T shift).cells) - → ((Disjoint W.cells (TileTranslation T shift).cells) → ((∃ e : Finset GaussianInt, x - ∈ e ∧ e ∈ FootprintEdges V ∩ FootprintEdges W) → ((x = data.first ∨ x = data.last ∨ ∃ - (e : Finset GaussianInt) (f : Finset GaussianInt), e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ e ∈ - FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ - FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) ∧ f ∈ - FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ - FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → ( - let o₀ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 - x = data.first → (x ∈ FootprintVertices (TileTranslation T shift) ↔ oldCoord = (o₀.first, - o₀.second)))))))))))))))))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (a : PeriodicSubtileIndex), + ∀ (b : PeriodicSubtileIndex), + ∀ (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + ∀ + (data : + P4418T3SelectedInterfaceData + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), + ∀ (x : GaussianInt), + ∀ (j : Fin 4), + ∀ (edge : Finset GaussianInt), + x ∈ edge → + edge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) → + LatticeVertexIncidentCell x j ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a).cells → + LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b).cells → + let shift : GaussianInt := + match P3996T1SRowTable q cfg C T cert row with + | some z => z.oldShift + | none => + match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => -cert.v + | .D => cert.v + | .E | .F => 0; + let oldCoord : Int × Int := routedOldCoordinates row; + shift = + (oldCoord.1 : GaussianInt) * cert.u + + (oldCoord.2 : GaussianInt) * cert.v → + (∀ (m : Int), + ∀ (n : Int), + ∀ (r : Int), + ∀ (s : Int), + (m, n) ≠ (r, s) → + Disjoint + (TileTranslation T + ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v)).cells + (TileTranslation T + ((r : GaussianInt) * cert.u + + (s : GaussianInt) * cert.v)).cells) → + (TileTranslation T shift).cells.Nonempty → + (∀ (U : ProtoTile), + U.cells.Nonempty → + ∀ (z : GaussianInt), + z ∈ FootprintVertices U → + ∃ k : Fin 4, LatticeVertexIncidentCell z k ∈ U.cells) → + (∀ (U : ProtoTile), + U.cells.Nonempty → + ∀ (z : GaussianInt), + ∀ (k : Fin 4), + LatticeVertexIncidentCell z k ∈ U.cells → + z ∈ FootprintVertices U) → + let V := + SubtileOccurrenceInterpretation cert.P cert.u cert.v a + let W := + SubtileOccurrenceInterpretation cert.P cert.u cert.v b + let G₀ := + SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + (∀ c : LatticeCell, + c ∈ G₀.cells → + c ∈ + (TileTranslation T + (((P4418T3EndpointOwnerIndices q cfg C T cert a b + row).1.first : + GaussianInt) * + cert.u + + ((P4418T3EndpointOwnerIndices q cfg C T cert a b + row).1.second : + GaussianInt) * + cert.v)).cells) → + Disjoint V.cells (TileTranslation T shift).cells → + Disjoint W.cells (TileTranslation T shift).cells → + (∃ e : Finset GaussianInt, + x ∈ e ∧ e ∈ FootprintEdges V ∩ FootprintEdges W) → + (x = data.first ∨ + x = data.last ∨ + ∃ (e : Finset GaussianInt) (f : Finset GaussianInt), + e ≠ f ∧ + x ∈ e ∧ + x ∈ f ∧ + e ∈ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) ∧ + f ∈ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b)) → + let o₀ := + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + x = data.first → + (x ∈ FootprintVertices (TileTranslation T shift) ↔ + oldCoord = (o₀.first, o₀.second)) + ) := by classical - intro q cfg C T cert a b row data x j edge hx hedge ha hb shift oldCoord hshift a_coord_ne - b_coord_ne root_disjoint old_nonempty footprint_incident incident_footprint V W G₀ hG₀root - hVold hWold hxedge htri o₀ hfirst + intro q cfg C T cert a b row data x j edge hx hedge ha hb shift oldCoord hshift root_disjoint + old_nonempty footprint_incident incident_footprint V W G₀ hG₀root hVold hWold hxedge htri + o₀ hfirst subst x obtain ⟨k, hk⟩ := ((LocalLatticeInterfaceSectors.1 V W G₀ data.first data.latticeV @@ -564,64 +628,131 @@ private theorem hlast_criterion : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : - P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v - a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) - (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices - q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (x : GaussianInt), ∀ (j - : Fin 4), ∀ (edge : Finset GaussianInt), (x ∈ edge) → ((edge ∈ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → - ((LatticeVertexIncidentCell x j ∈ (SubtileOccurrenceInterpretation cert.P cert.u - cert.v a).cells) → ((LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( - let shift : GaussianInt := match P3996T1SRowTable q cfg C T cert row with - | some z => z.oldShift - | none => match a.label with - | .A => if a.first = -1 then -cert.u else cert.u - | .B => if a.first = 1 then cert.u else -cert.u - | .C => -cert.v - | .D => cert.v - | .E | .F => 0 - let oldCoord : Int × Int := routedOldCoordinates row - (shift = (oldCoord.1 : GaussianInt) * cert.u + (oldCoord.2 : GaussianInt) * cert.v) → - (((a.first, a.second) ≠ oldCoord) → (((b.first, b.second) ≠ oldCoord) → ((∀ (m : - Int), ∀ (n : Int), ∀ (r : Int), ∀ (s : Int), ((m, n) ≠ (r, s)) → (Disjoint - (TileTranslation T ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells - (TileTranslation T ((r : GaussianInt) * cert.u + (s : GaussianInt) * cert.v)).cells)) - → (((TileTranslation T shift).cells.Nonempty) → ((∀ (U : ProtoTile), - (U.cells.Nonempty) → (∀ (z : GaussianInt), (z ∈ FootprintVertices U) → (∃ k : Fin 4, - LatticeVertexIncidentCell z k ∈ U.cells))) → ((∀ (U : ProtoTile), (U.cells.Nonempty) - → (∀ (z : GaussianInt), ∀ (k : Fin 4), (LatticeVertexIncidentCell z k ∈ U.cells) → (z - ∈ FootprintVertices U))) → ( - let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v a - let W := SubtileOccurrenceInterpretation cert.P cert.u cert.v b - let G₁ := SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 - (∀ c : LatticeCell, c ∈ G₁.cells → c ∈ (TileTranslation T - (((P4418T3EndpointOwnerIndices q cfg C T cert a b row).2.first : GaussianInt) * - cert.u + ((P4418T3EndpointOwnerIndices q cfg C T cert a b row).2.second : - GaussianInt) * cert.v)).cells) → ((Disjoint V.cells (TileTranslation T shift).cells) - → ((Disjoint W.cells (TileTranslation T shift).cells) → ((∃ e : Finset GaussianInt, x - ∈ e ∧ e ∈ FootprintEdges V ∩ FootprintEdges W) → ((x = data.first ∨ x = data.last ∨ ∃ - (e : Finset GaussianInt) (f : Finset GaussianInt), e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ e ∈ - FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ - FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) ∧ f ∈ - FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ - FootprintEdges (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → ( - let o₀ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 - let o₁ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 - (x = data.first → (x ∈ FootprintVertices (TileTranslation T shift) ↔ oldCoord = - (o₀.first, o₀.second))) → (x = data.last → (x ∈ FootprintVertices (TileTranslation T - shift) ↔ oldCoord = (o₁.first, o₁.second))))))))))))))))))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (a : PeriodicSubtileIndex), + ∀ (b : PeriodicSubtileIndex), + ∀ (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + ∀ + (data : + P4418T3SelectedInterfaceData + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), + ∀ (x : GaussianInt), + ∀ (j : Fin 4), + ∀ (edge : Finset GaussianInt), + x ∈ edge → + edge ∈ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) → + LatticeVertexIncidentCell x j ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + a).cells → + LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b).cells → + let shift : GaussianInt := + match P3996T1SRowTable q cfg C T cert row with + | some z => z.oldShift + | none => + match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => -cert.v + | .D => cert.v + | .E | .F => 0; + let oldCoord : Int × Int := routedOldCoordinates row; + shift = + (oldCoord.1 : GaussianInt) * cert.u + + (oldCoord.2 : GaussianInt) * cert.v → + (∀ (m : Int), + ∀ (n : Int), + ∀ (r : Int), + ∀ (s : Int), + (m, n) ≠ (r, s) → + Disjoint + (TileTranslation T + ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v)).cells + (TileTranslation T + ((r : GaussianInt) * cert.u + + (s : GaussianInt) * cert.v)).cells) → + (TileTranslation T shift).cells.Nonempty → + (∀ (U : ProtoTile), + U.cells.Nonempty → + ∀ (z : GaussianInt), + z ∈ FootprintVertices U → + ∃ k : Fin 4, LatticeVertexIncidentCell z k ∈ U.cells) → + (∀ (U : ProtoTile), + U.cells.Nonempty → + ∀ (z : GaussianInt), + ∀ (k : Fin 4), + LatticeVertexIncidentCell z k ∈ U.cells → + z ∈ FootprintVertices U) → + let V := + SubtileOccurrenceInterpretation cert.P cert.u cert.v a + let W := + SubtileOccurrenceInterpretation cert.P cert.u cert.v b + let G₁ := + SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 + (∀ c : LatticeCell, + c ∈ G₁.cells → + c ∈ + (TileTranslation T + (((P4418T3EndpointOwnerIndices q cfg C T cert a b + row).2.first : + GaussianInt) * + cert.u + + ((P4418T3EndpointOwnerIndices q cfg C T cert a b + row).2.second : + GaussianInt) * + cert.v)).cells) → + Disjoint V.cells (TileTranslation T shift).cells → + Disjoint W.cells (TileTranslation T shift).cells → + (∃ e : Finset GaussianInt, + x ∈ e ∧ e ∈ FootprintEdges V ∩ FootprintEdges W) → + (x = data.first ∨ + x = data.last ∨ + ∃ (e : Finset GaussianInt) (f : Finset GaussianInt), + e ≠ f ∧ + x ∈ e ∧ + x ∈ f ∧ + e ∈ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) ∧ + f ∈ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b)) → + let o₀ := + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + let o₁ := + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 + (x = data.first → + (x ∈ FootprintVertices (TileTranslation T shift) ↔ + oldCoord = (o₀.first, o₀.second))) → + x = data.last → + (x ∈ FootprintVertices (TileTranslation T shift) ↔ + oldCoord = (o₁.first, o₁.second)) + ) := by classical - intro q cfg C T cert a b row data x j edge hx hedge ha hb shift oldCoord hshift a_coord_ne - b_coord_ne root_disjoint old_nonempty footprint_incident incident_footprint V W G₁ hG₁root - hVold hWold hxedge htri o₀ o₁ hfirst_criterion hlast + intro q cfg C T cert a b row data x j edge hx hedge ha hb shift oldCoord hshift root_disjoint + old_nonempty footprint_incident incident_footprint V W G₁ hG₁root hVold hWold hxedge htri + o₀ o₁ hfirst_criterion hlast subst x obtain ⟨k, hk⟩ := ((LocalLatticeInterfaceSectors.1 V W G₁ data.last data.latticeV @@ -676,52 +807,81 @@ private theorem hcriterion : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), ∀ (data : - P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v - a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) - (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices - q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), ∀ (x : GaussianInt), ∀ (j - : Fin 4), ∀ (edge : Finset GaussianInt), (edge ∈ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → - ((LatticeVertexIncidentCell x j ∈ (SubtileOccurrenceInterpretation cert.P cert.u - cert.v a).cells) → ((LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( - let shift : GaussianInt := match P3996T1SRowTable q cfg C T cert row with - | some z => z.oldShift - | none => match a.label with - | .A => if a.first = -1 then -cert.u else cert.u - | .B => if a.first = 1 then cert.u else -cert.u - | .C => -cert.v - | .D => cert.v - | .E | .F => 0 - let oldCoord : Int × Int := routedOldCoordinates row - ((TileTranslation T shift).cells.Nonempty) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ - (z : GaussianInt), (z ∈ FootprintVertices U) → (∃ k : Fin 4, - LatticeVertexIncidentCell z k ∈ U.cells))) → ( - let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v a - let W := SubtileOccurrenceInterpretation cert.P cert.u cert.v b - (Disjoint V.cells (TileTranslation T shift).cells) → ((Disjoint W.cells (TileTranslation - T shift).cells) → ((x = data.first ∨ x = data.last ∨ ∃ (e : Finset GaussianInt) (f : - Finset GaussianInt), e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ e ∈ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) ∧ f ∈ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → ( - let o₀ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 - let o₁ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 - (x = data.first → (x ∈ FootprintVertices (TileTranslation T shift) ↔ oldCoord = - (o₀.first, o₀.second))) → ((x = data.last → (x ∈ FootprintVertices (TileTranslation T - shift) ↔ oldCoord = (o₁.first, o₁.second))) → (x ∈ FootprintVertices (TileTranslation - T shift) ↔ (x = data.first ∧ oldCoord = (o₀.first, o₀.second)) ∨ (x = data.last ∧ - oldCoord = (o₁.first, o₁.second)))))))))))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (a : PeriodicSubtileIndex), + ∀ (b : PeriodicSubtileIndex), + ∀ (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + ∀ + (data : + P4418T3SelectedInterfaceData + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1) + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)), + ∀ (x : GaussianInt), + let shift : GaussianInt := + match P3996T1SRowTable q cfg C T cert row with + | some z => z.oldShift + | none => + match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => -cert.v + | .D => cert.v + | .E | .F => 0 + let oldCoord : Int × Int := routedOldCoordinates row + (TileTranslation T shift).cells.Nonempty → + (∀ (U : ProtoTile), + U.cells.Nonempty → + ∀ (z : GaussianInt), + z ∈ FootprintVertices U → + ∃ k : Fin 4, LatticeVertexIncidentCell z k ∈ U.cells) → + let V := + SubtileOccurrenceInterpretation cert.P cert.u cert.v a + let W := + SubtileOccurrenceInterpretation cert.P cert.u cert.v b + Disjoint V.cells (TileTranslation T shift).cells → + Disjoint W.cells (TileTranslation T shift).cells → + (x = data.first ∨ + x = data.last ∨ + ∃ (e : Finset GaussianInt) (f : Finset GaussianInt), + e ≠ f ∧ + x ∈ e ∧ + x ∈ f ∧ + e ∈ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) ∧ + f ∈ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ + FootprintEdges + (SubtileOccurrenceInterpretation cert.P cert.u cert.v + b)) → + let o₀ := + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + let o₁ := + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 + (x = data.first → + (x ∈ FootprintVertices (TileTranslation T shift) ↔ + oldCoord = (o₀.first, o₀.second))) → + (x = data.last → + (x ∈ FootprintVertices (TileTranslation T shift) ↔ + oldCoord = (o₁.first, o₁.second))) → + (x ∈ FootprintVertices (TileTranslation T shift) ↔ + x = data.first ∧ oldCoord = (o₀.first, o₀.second) ∨ + x = data.last ∧ oldCoord = (o₁.first, o₁.second)) + ) := by classical - intro q cfg C T cert a b row data x j edge hedge ha hb shift oldCoord old_nonempty - footprint_incident V W hVold hWold htri o₀ o₁ hfirst_criterion hlast_criterion + intro q cfg C T cert a b row data x shift oldCoord old_nonempty footprint_incident V W hVold + hWold htri o₀ o₁ hfirst_criterion hlast_criterion rcases htri with hfirst | hlast | hinside · have hnotlast : x ≠ data.last := by intro h @@ -849,15 +1009,15 @@ theorem P4418T3RoutedBlockCriterion let o₀ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 let o₁ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 have hfirst_criterion := RoutedBlockGeometry.hfirst_criterion q cfg C T cert a b row data x j - edge hx hedge ha hb hshift a_coord_ne b_coord_ne root_disjoint old_nonempty + edge hx hedge ha hb hshift root_disjoint old_nonempty footprint_incident incident_footprint hG₀root hVold hWold hxedge htri have hlast_criterion := RoutedBlockGeometry.hlast_criterion q cfg C T cert a b row data x j - edge hx hedge ha hb hshift a_coord_ne b_coord_ne root_disjoint old_nonempty + edge hx hedge ha hb hshift root_disjoint old_nonempty footprint_incident incident_footprint hG₁root hVold hWold hxedge htri hfirst_criterion have hcriterion : x ∈ FootprintVertices (TileTranslation T shift) ↔ (x = data.first ∧ oldCoord = (o₀.first, o₀.second)) ∨ (x = data.last ∧ oldCoord = (o₁.first, o₁.second)) := RoutedBlockGeometry.hcriterion q cfg - C T cert a b row data x j edge hedge ha hb old_nonempty footprint_incident hVold hWold + C T cert a b row data x old_nonempty footprint_incident hVold hWold htri hfirst_criterion hlast_criterion change (x ∈ FootprintVertices (TileTranslation T shift) ↔ _) rw [hcriterion] diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean b/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean index 911bb6bfc5..a531ed456d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean @@ -63,16 +63,22 @@ private theorem hturnedCells : (by classical exact - (Fin 4 → CircleCoordinates) → (∀ (T : ProtoTile), ∀ (g : GaussianInt), (GaussianRealPoint - g = ((TileCentroid T).1 + (TileCentroid T).2, (TileCentroid T).2 - (TileCentroid - T).1)) → (((TileTranslation (TileQuarterTurn T) g).cells = T.cells) → ( - let rot : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x - 1 - let cent : GaussianInt → GaussianInt := fun x => GaussianTranslation g (rot x) - (T.cells.image cent = T.cells) → (∀ (d : GaussianInt), (TileTranslation (TileQuarterTurn - (TileTranslation T d)) g).cells = (TileTranslation T (GaussianQuarterTurn - d)).cells)))) ) := by + ∀ (T : ProtoTile), + ∀ (g : GaussianInt), + GaussianRealPoint g = + ((TileCentroid T).1 + (TileCentroid T).2, + (TileCentroid T).2 - (TileCentroid T).1) → + (TileTranslation (TileQuarterTurn T) g).cells = T.cells → + let rot : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x - 1 + let cent : GaussianInt → GaussianInt := fun x => + GaussianTranslation g (rot x) + T.cells.image cent = T.cells → + ∀ (d : GaussianInt), + (TileTranslation (TileQuarterTurn (TileTranslation T d)) g).cells = + (TileTranslation T (GaussianQuarterTurn d)).cells + ) := by classical - intro q T g hg hcenter rot cent hcentCells d + intro T g hg hcenter rot cent hcentCells d rw [(TileTranslationFormulas (TileQuarterTurn (TileTranslation T d)) g).1, (TileQuarterTurnFormulas (TileTranslation T d)).1, (TileTranslationFormulas T d).1, @@ -205,10 +211,11 @@ private theorem adjSymm : (by classical exact - (Fin 4 → CircleCoordinates) → ((ProtoTile) → (∀ (x : Int × Int), ∀ (y : Int × Int), - (TriangularLatticeAdjacent x y) → (TriangularLatticeAdjacent y x))) ) := by + ∀ (x : Int × Int), + ∀ (y : Int × Int), TriangularLatticeAdjacent x y → TriangularLatticeAdjacent y x + ) := by classical - intro q T x y h + intro x y h simp only [TriangularLatticeAdjacent, Prod.ext_iff] at h ⊢ rcases h with h | h | h | h | h | h <;> simp only [Prod.fst_sub, Prod.snd_sub] at h ⊢ <;> omega @@ -563,10 +570,10 @@ private theorem coord_m01_m10 : (by classical exact - (Fin 4 → CircleCoordinates) → ((ProtoTile) → (∀ (w : Int × Int), (w + (0, -1)) - (1, 0) = - w + (-1, -1))) ) := by + ∀ (w : Int × Int), w + (0, -1) - (1, 0) = w + (-1, -1) + ) := by classical - intro q T w + intro w ext <;> simp [Prod.add_def, Prod.sub_def]; omega private theorem hdown01 : @@ -728,10 +735,10 @@ private theorem offsetEq : (by classical exact - (Fin 4 → CircleCoordinates) → ((ProtoTile) → (∀ (w : Int × Int), ∀ (w' : Int × Int), ∀ (d - : Int × Int), (w - w' = d) → (w = w' + d))) ) := by + ∀ (w : Int × Int), ∀ (w' : Int × Int), ∀ (d : Int × Int), w - w' = d → w = w' + d + ) := by classical - intro q T w w' d h + intro w w' d h rcases w with ⟨a₁, a₂⟩ rcases w' with ⟨b₁, b₂⟩ rcases d with ⟨c₁, c₂⟩ @@ -902,12 +909,12 @@ theorem P4456T2BandGraphTriangle (q : Fin 4 → CircleCoordinates) have hturnedCells (d : GaussianInt) : (TileTranslation (TileQuarterTurn (TileTranslation T d)) g).cells = (TileTranslation T (GaussianQuarterTurn d)).cells := - BandGraphTriangleGeometry.hturnedCells q T g hg hcenter hcentCells d + BandGraphTriangleGeometry.hturnedCells T g hg hcenter hcentCells d have hOpp : TouchingTriple T (TileTranslation T (-u)) (TileTranslation T v) := BandGraphTriangleGeometry.hOpp q T hT3 hTne g hcenter hturnedCells intro a b c habc hbcc hca hab hbc hca' have adjSymm (x y : Int × Int) (h : TriangularLatticeAdjacent x y) : - TriangularLatticeAdjacent y x := BandGraphTriangleGeometry.adjSymm q T x y h + TriangularLatticeAdjacent y x := BandGraphTriangleGeometry.adjSymm x y h let x : Int × Int := chart.vertexEquiv.symm a let y : Int × Int := chart.vertexEquiv.symm b let z : Int × Int := chart.vertexEquiv.symm c @@ -977,7 +984,7 @@ theorem P4456T2BandGraphTriangle (q : Fin 4 → CircleCoordinates) have coord_m10_m01 (w : Int × Int) : (w + (-1, 0)) + (0, -1) = w + (-1, -1) := BandGraphTriangleGeometry.coord_m10_m01 w have coord_m01_m10 (w : Int × Int) : - (w + (0, -1)) - (1, 0) = w + (-1, -1) := BandGraphTriangleGeometry.coord_m01_m10 q T w + (w + (0, -1)) - (1, 0) = w + (-1, -1) := BandGraphTriangleGeometry.coord_m01_m10 w have coord_m01_p01 (w : Int × Int) : (w + (0, -1)) + (0, 1) = w := by ext <;> simp [Prod.add_def] have coord_sub10 (w : Int × Int) : w - (1, 0) = w + (-1, 0) := by @@ -1005,7 +1012,7 @@ theorem P4456T2BandGraphTriangle (q : Fin 4 → CircleCoordinates) (tileAt (x + (0, -1))) := BandGraphTriangleGeometry.hup50 q T ι P chart a upFace coord_sub01 tileCongr have offsetEq (w w' d : Int × Int) (h : w - w' = d) : w = w' + d := - BandGraphTriangleGeometry.offsetEq q T w w' d h + BandGraphTriangleGeometry.offsetEq w w' d h have hlocal : TouchingTriple (tileAt x) (tileAt y) (tileAt z) := BandGraphTriangleGeometry.hlocal q T ι P chart a b c hdir tileCongr hdown01 hup12 hdown23 hup34 hdown45 hup50 offsetEq diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean b/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean index 4008ba99b8..34a799d4a6 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean @@ -109,10 +109,10 @@ private theorem hxne : (by classical exact - ∀ (x : GaussianInt), ∀ (y : GaussianInt), (FourNeighborAdjacent x y) → ((List - GaussianInt) → (x ≠ y)) ) := by + ∀ (x : GaussianInt), ∀ (y : GaussianInt), FourNeighborAdjacent x y → x ≠ y + ) := by classical - intro x y hxy p h + intro x y hxy h rw [h] at hxy simp [FourNeighborAdjacent, Zsqrtd.ext_iff] at hxy omega @@ -142,18 +142,31 @@ private theorem hqBoundaryChain : (by classical exact - ∀ (T : ProtoTile), ∀ (x : GaussianInt), (GaussianInt) → (∀ (p : List GaussianInt), ∀ (u : - GaussianInt), ∀ (v : GaussianInt), (p.head? = some u) → ((p.getLast? = some v) → ((∀ - (e : Finset GaussianInt), e ∈ BoundaryFootprintEdges T ↔ e = {v, u} ∨ ∃ (a : - GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = - l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ( - let k := p.idxOf x - (k < p.length) → ( - let q := p.rotate k - (q.length = p.length) → (List.IsChain (fun s t => ({s, t} : Finset GaussianInt) ∈ - BoundaryFootprintEdges T) q)))))) ) := by + ∀ (T : ProtoTile), + ∀ (x : GaussianInt), + ∀ (p : List GaussianInt), + ∀ (u : GaussianInt), + ∀ (v : GaussianInt), + p.head? = some u → + p.getLast? = some v → + (∀ (e : Finset GaussianInt), + e ∈ BoundaryFootprintEdges T ↔ + e = { v, u } ∨ + ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : + List GaussianInt) (l₂ : List GaussianInt), + p = l₁ ++ a :: b :: l₂ ∧ e = { a, b }) → + let k := p.idxOf x + k < p.length → + let q := p.rotate k + q.length = p.length → + List.IsChain + (fun s t => + ({ s, t } : Finset GaussianInt) ∈ + BoundaryFootprintEdges T) + q + ) := by classical - intro T x y p u v hpHead hpLast hpEdges k hk q hqLen + intro T x p u v hpHead hpLast hpEdges k hk q hqLen have hchain : List.IsChain (fun s t => ({s, t} : Finset GaussianInt) ∈ BoundaryFootprintEdges T) p := by apply (List.isChain_iff_getElem).2 @@ -389,12 +402,15 @@ private theorem hcdAdj : (by classical exact - (GaussianInt) → ((GaussianInt) → ((List GaussianInt) → (∀ (c : LatticeCell), ∀ (d : - LatticeCell), (c ≠ d) → (∀ (f : Finset GaussianInt), (f ∈ FootprintEdges (⟨{c}, c⟩ : - ProtoTile)) → ((f ∈ FootprintEdges (⟨{d}, d⟩ : ProtoTile)) → - (FourNeighborAdjacent c d)))))) ) := by + ∀ (c : LatticeCell), + ∀ (d : LatticeCell), + c ≠ d → + ∀ (f : Finset GaussianInt), + f ∈ FootprintEdges (⟨{ c }, c⟩ : ProtoTile) → + f ∈ FootprintEdges (⟨{ d }, d⟩ : ProtoTile) → FourNeighborAdjacent c d + ) := by classical - intro x y p c d hcd f hfc hfd + intro c d hcd f hfc hfd have pairMatch (u v w z : GaussianInt) (heq : ({u, v} : Finset GaussianInt) = {w, z}) (huv : u ≠ v) : (u = w ∧ v = z) ∨ (u = z ∧ v = w) := by @@ -750,8 +766,8 @@ theorem P4456T2CrosscutIndex (T : ProtoTile) (hT : LatticeTile T) have hj : j < q.length := List.idxOf_lt_length_of_mem hyq have hyidx : q[j] = y := by simp [j] have hjpos : 0 < j := CrosscutIndexProof.hjpos x y p hpLen hqHead hqLen hyq hj hyidx - (CrosscutIndexProof.hxne x y hxy p) - have hqBoundaryChain := CrosscutIndexProof.hqBoundaryChain T x y p u v hpHead hpLast hpEdges hk + (CrosscutIndexProof.hxne x y hxy) + have hqBoundaryChain := CrosscutIndexProof.hqBoundaryChain T x p u v hpHead hpLast hpEdges hk hqLen let r := q.take (j + 1) have hrHead : r.head? = some x := by @@ -793,7 +809,7 @@ theorem P4456T2CrosscutIndex (T : ProtoTile) (hT : LatticeTile T) rcases hf with ⟨hfc, hfd⟩ have hfcOrig := hfc have hfdOrig := hfd - have hcdAdj := CrosscutIndexProof.hcdAdj x y p c d hcd f hfc hfd + have hcdAdj := CrosscutIndexProof.hcdAdj c d hcd f hfc hfd change (∃ z ∈ ({c} : Finset GaussianInt), f = {z, z + 1} ∨ f = {z, z + ⟨0, 1⟩} ∨ f = {z + 1, z + 1 + ⟨0, 1⟩} ∨ diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean b/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean index 9e17caf7e7..e8103b8d5a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean @@ -127,11 +127,14 @@ private theorem hTne : (by classical exact - ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (T : - ProtoTile), (BandPrototile (q (0 : Fin (4 : ℕ))) T) → (((1 : ℤ) < (q (0 : Fin (4 : - ℕ))).1) → ((PeriodicTileComplex ↥(TilingLattice C)) → (T.cells.Nonempty)))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ProperBandQuadruple q → + ∀ (T : ProtoTile), + BandPrototile (q (0 : Fin (4 : ℕ))) T → + (1 : ℤ) < (q (0 : Fin (4 : ℕ))).1 → T.cells.Nonempty + ) := by classical - intro C q hq T hT hlarge P + intro q hq T hT hlarge have harea := (BandTileSimultaneousInduction q hq T hT).2.1 rw [Finset.nonempty_iff_ne_empty] intro he @@ -242,31 +245,67 @@ private theorem hneqxy : (by classical exact - ∀ (C : BandCircle), (Fin 4 → CircleCoordinates) → (∀ (T : ProtoTile), ∀ (P : - PeriodicTileComplex ↥(TilingLattice C)), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (y - ∈ FootprintVertices T) → ((FourNeighborAdjacent x y) → (({x, y} ∉ FootprintEdges T) → - (∀ (z : GaussianInt), ∀ (w : GaussianInt), ((x = z + (1 : GaussianInt) ∧ y = z + (1 : - GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = z + (1 : GaussianInt) ∧ x = z - + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∧ w = z + (1 : GaussianInt) - ∨ (x = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∧ y = z + (⟨(0 : - ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ∧ x = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∧ w = z + (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt)) → ((∀ (U : ProtoTile), ({x, y} ∈ FootprintEdges U ↔ z ∈ U.cells ∨ - w ∈ U.cells) ∧ ({x, y} ∈ BoundaryFootprintEdges U ↔ z ∈ U.cells ∧ w ∉ U.cells ∨ z ∉ - U.cells ∧ w ∈ U.cells) ∧ (z ∈ U.cells ∨ w ∈ U.cells → x ∈ FootprintVertices U ∧ y ∈ - FootprintVertices U ∧ ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (((1 : ℝ) - (↑t : - ℝ)) * (↑x.re : ℝ) + (↑t : ℝ) * (↑y.re : ℝ), ((1 : ℝ) - (↑t : ℝ)) * (↑x.im : ℝ) + (↑t - : ℝ) * (↑y.im : ℝ)) ∈ TileRealization U) ∧ (z ∈ U.cells ∧ w ∈ U.cells → - OpenLatticeEdge x y ⊆ interior (TileRealization U)) ∧ ((∀ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell x j ∈ U.cells) → z ∈ U.cells ∧ w ∈ U.cells)) → ((({x, y} : - Finset GaussianInt) ∉ FootprintEdges T) → (∀ (a : ↥(TilingLattice C)), ∀ (b : - ↥(TilingLattice C)), (y ∈ FootprintVertices (P.tile a)) → ((y ∈ FootprintVertices - (P.tile b)) → ((∀ (v : GaussianInt), (v = x ∨ v = y) → (∃ j : Fin 4, - LatticeVertexIncidentCell v j ∉ T.cells)) → ((y ∈ BoundaryFootprintVertices (P.tile - a)) → ((y ∈ BoundaryFootprintVertices (P.tile b)) → (x ≠ y)))))))))))) ) := by + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + y ∈ FootprintVertices T → + FourNeighborAdjacent x y → + { x, y } ∉ FootprintEdges T → + ∀ (z : GaussianInt), + ∀ (w : GaussianInt), + (x = z + (1 : GaussianInt) ∧ + y = + z + (1 : GaussianInt) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ + y = z + (1 : GaussianInt) ∧ + x = + z + (1 : GaussianInt) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∧ + w = z + (1 : GaussianInt) ∨ + (x = + z + (1 : GaussianInt) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∧ + y = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ + y = + z + (1 : GaussianInt) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∧ + x = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∧ + w = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → + (∀ (U : ProtoTile), + ({ x, y } ∈ FootprintEdges U ↔ + z ∈ U.cells ∨ w ∈ U.cells) ∧ + ({ x, y } ∈ BoundaryFootprintEdges U ↔ + z ∈ U.cells ∧ w ∉ U.cells ∨ z ∉ U.cells ∧ w ∈ U.cells) ∧ + (z ∈ U.cells ∨ w ∈ U.cells → + x ∈ FootprintVertices U ∧ + y ∈ FootprintVertices U ∧ + ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), + (((1 : ℝ) - (↑t : ℝ)) * (↑x.re : ℝ) + + (↑t : ℝ) * (↑y.re : ℝ), + ((1 : ℝ) - (↑t : ℝ)) * (↑x.im : ℝ) + + (↑t : ℝ) * (↑y.im : ℝ)) ∈ + TileRealization U) ∧ + (z ∈ U.cells ∧ w ∈ U.cells → + OpenLatticeEdge x y ⊆ interior (TileRealization U)) ∧ + ((∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell x j ∈ U.cells) → + z ∈ U.cells ∧ w ∈ U.cells)) → + ({ x, y } : Finset GaussianInt) ∉ FootprintEdges T → + ∀ (a : ↥(TilingLattice C)), + ∀ (b : ↥(TilingLattice C)), + y ∈ FootprintVertices (P.tile a) → + y ∈ FootprintVertices (P.tile b) → + (∀ (v : GaussianInt), + v = x ∨ v = y → + ∃ j : Fin 4, LatticeVertexIncidentCell v j ∉ T.cells) → + y ∈ BoundaryFootprintVertices (P.tile a) → + y ∈ BoundaryFootprintVertices (P.tile b) → x ≠ y + ) := by classical - intro C q T P x y hy hxy hnot z w hform hedgeFacts hedgeT a b hya hyb hmissT hboundA_y - hboundB_y hxy' + intro C T P x y hy hxy hnot z w hform hedgeFacts hedgeT a b hya hyb hmissT hboundA_y hboundB_y + hxy' subst y simp only [FourNeighborAdjacent] at hxy rcases hxy with h | h | h | h @@ -501,7 +540,7 @@ theorem P4456T2MissingEdge (C : BandCircle) MissingEdgeGeometry.incident_of_footprint U v hne hv have hnonemptyA : (P.tile a).cells.Nonempty := ⟨z, ha⟩ have hnonemptyB : (P.tile b).cells.Nonempty := ⟨w, hb⟩ - have hTne : T.cells.Nonempty := MissingEdgeGeometry.hTne C q hq T hT hlarge P + have hTne : T.cells.Nonempty := MissingEdgeGeometry.hTne q hq T hT hlarge have hmissT (v : GaussianInt) (hv : v = x ∨ v = y) : ∃ j : Fin 4, LatticeVertexIncidentCell v j ∉ T.cells := MissingEdgeGeometry.hmissT C T P x hx y hy hxy hnot z w hform hedgeFacts hedgeT hzwT a b hxa hya hxb hyb v hv @@ -523,7 +562,7 @@ theorem P4456T2MissingEdge (C : BandCircle) have hboundB_y : y ∈ BoundaryFootprintVertices (P.tile b) := P3161T2IncidentBoundary (P.tile b) y (incident_of_footprint (P.tile b) y hnonemptyB hyb) (hmissingB y hy) - have hneqxy : x ≠ y := MissingEdgeGeometry.hneqxy C q T P x y hy hxy hnot z w hform hedgeFacts + have hneqxy : x ≠ y := MissingEdgeGeometry.hneqxy C T P x y hy hxy hnot z w hform hedgeFacts hedgeT a b hya hyb hmissT hboundA_y hboundB_y have hclass := (PeriodicTileIntersectionClassification P).1 have habEdge : (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty := diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean b/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean index 7eca13555d..c6c581a1ef 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean @@ -276,12 +276,19 @@ private theorem hcoordsAt320 : (by classical exact - (Nat) → (∀ (w : GaussianInt), ∀ (z : GaussianInt), ∀ (v : GaussianInt), ∀ (a : ℕ), ∀ (b : - ℕ), (z = w + ⟨(↑a : ℤ), (↑b : ℤ)⟩) → (∀ (c : ℕ), ∀ (d : ℕ), (v = w + ⟨(↑c : ℤ), (↑d : - ℤ)⟩) → - ((v = z + (1 : GaussianInt)) → (c = a + 1 ∧ d = b)))) ) := by - classical - intro n w z v a b hza c d hvc hvform + ∀ (w : GaussianInt), + ∀ (z : GaussianInt), + ∀ (v : GaussianInt), + ∀ (a : ℕ), + ∀ (b : ℕ), + z = w + ⟨(↑a : ℤ), (↑b : ℤ)⟩ → + ∀ (c : ℕ), + ∀ (d : ℕ), + v = w + ⟨(↑c : ℤ), (↑d : ℤ)⟩ → + v = z + (1 : GaussianInt) → c = a + 1 ∧ d = b + ) := by + classical + intro w z v a b hza c d hvc hvform have heq' : w + (⟨(c : Int), (d : Int)⟩ : GaussianInt) = z + 1 := by rw [← hvc, hvform] rw [hza] at heq' @@ -296,12 +303,19 @@ private theorem hcoordsAt367 : (by classical exact - (Nat) → (∀ (w : GaussianInt), ∀ (z : GaussianInt), ∀ (v : GaussianInt), ∀ (a : ℕ), ∀ (b : - ℕ), (z = w + ⟨(↑a : ℤ), (↑b : ℤ)⟩) → (∀ (c : ℕ), ∀ (d : ℕ), (v = w + ⟨(↑c : ℤ), (↑d : - ℤ)⟩) → - ((v = z + ⟨(0 : ℤ), (1 : ℤ)⟩) → (c = a ∧ d = b + 1)))) ) := by + ∀ (w : GaussianInt), + ∀ (z : GaussianInt), + ∀ (v : GaussianInt), + ∀ (a : ℕ), + ∀ (b : ℕ), + z = w + ⟨(↑a : ℤ), (↑b : ℤ)⟩ → + ∀ (c : ℕ), + ∀ (d : ℕ), + v = w + ⟨(↑c : ℤ), (↑d : ℤ)⟩ → + v = z + ⟨(0 : ℤ), (1 : ℤ)⟩ → c = a ∧ d = b + 1 + ) := by classical - intro n w z v a b hza c d hvc hvform + intro w z v a b hza c d hvc hvform have heq' : w + (⟨(c : Int), (d : Int)⟩ : GaussianInt) = z + ⟨0,1⟩ := by rw [← hvc, hvform] rw [hza] at heq' @@ -594,11 +608,17 @@ private theorem hcdAt513 : (by classical exact - (Nat) → (∀ (w : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), ∀ (d : ℕ), (w + (⟨(c : - Int), (d : Int)⟩ : GaussianInt) = (w + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) + 1) → - (c = a + 1 ∧ d = b)) ) := by - classical - intro n w a b c d heq + ∀ (w : GaussianInt), + ∀ (a : ℕ), + ∀ (b : ℕ), + ∀ (c : ℕ), + ∀ (d : ℕ), + w + (⟨(c : Int), (d : Int)⟩ : GaussianInt) = + w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) + 1 → + c = a + 1 ∧ d = b + ) := by + classical + intro w a b c d heq have hr := congrArg Zsqrtd.re heq have hi := congrArg Zsqrtd.im heq simp only [Zsqrtd.re_add, Zsqrtd.im_add, @@ -638,11 +658,17 @@ private theorem hcdAt532 : (by classical exact - (Nat) → (∀ (w : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), ∀ (d : ℕ), (w + (⟨(a : - Int), (b : Int)⟩ : GaussianInt) = (w + (⟨(c : Int), (d : Int)⟩ : GaussianInt)) + 1) → - (a = c + 1 ∧ b = d)) ) := by - classical - intro n w a b c d heq + ∀ (w : GaussianInt), + ∀ (a : ℕ), + ∀ (b : ℕ), + ∀ (c : ℕ), + ∀ (d : ℕ), + w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) = + w + (⟨(c : Int), (d : Int)⟩ : GaussianInt) + 1 → + a = c + 1 ∧ b = d + ) := by + classical + intro w a b c d heq have hr := congrArg Zsqrtd.re heq have hi := congrArg Zsqrtd.im heq simp only [Zsqrtd.re_add, Zsqrtd.im_add, @@ -685,11 +711,17 @@ private theorem hcdAt554 : (by classical exact - (Nat) → (∀ (w : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), ∀ (d : ℕ), (w + (⟨(c : - Int), (d : Int)⟩ : GaussianInt) = (w + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) + - ⟨0,1⟩) → (c = a ∧ d = b + 1)) ) := by - classical - intro n w a b c d heq + ∀ (w : GaussianInt), + ∀ (a : ℕ), + ∀ (b : ℕ), + ∀ (c : ℕ), + ∀ (d : ℕ), + w + (⟨(c : Int), (d : Int)⟩ : GaussianInt) = + w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) + ⟨0, 1⟩ → + c = a ∧ d = b + 1 + ) := by + classical + intro w a b c d heq have hr := congrArg Zsqrtd.re heq have hi := congrArg Zsqrtd.im heq simp only [Zsqrtd.re_add, Zsqrtd.im_add, @@ -729,11 +761,17 @@ private theorem hcdAt573 : (by classical exact - (Nat) → (∀ (w : GaussianInt), ∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), ∀ (d : ℕ), (w + (⟨(a : - Int), (b : Int)⟩ : GaussianInt) = (w + (⟨(c : Int), (d : Int)⟩ : GaussianInt)) + - ⟨0,1⟩) → (a = c ∧ b = d + 1)) ) := by - classical - intro n w a b c d heq + ∀ (w : GaussianInt), + ∀ (a : ℕ), + ∀ (b : ℕ), + ∀ (c : ℕ), + ∀ (d : ℕ), + w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) = + w + (⟨(c : Int), (d : Int)⟩ : GaussianInt) + ⟨0, 1⟩ → + a = c ∧ b = d + 1 + ) := by + classical + intro w a b c d heq have hr := congrArg Zsqrtd.re heq have hi := congrArg Zsqrtd.im heq simp only [Zsqrtd.re_add, Zsqrtd.im_add, @@ -816,7 +854,7 @@ theorem P4456T2SquareEdges (n : Nat) (hn : 0 < n) rcases hcell z |>.mp hz with ⟨a,b,ha,hb,hza⟩ rcases hcell v |>.mp hv with ⟨c,d,hc,hd,hvc⟩ rcases hform with ⟨hor, hvform⟩ | ⟨hor, hvform⟩ - · have hcoords : c = a + 1 ∧ d = b := SquareEdgeProof.hcoordsAt320 n w z v a b hza c d hvc + · have hcoords : c = a + 1 ∧ d = b := SquareEdgeProof.hcoordsAt320 w z v a b hza c d hvc hvform let pa : Nat := a + 1 let p : GaussianInt := if 0 < b then z + 1 else z + 1 + ⟨0,1⟩ @@ -838,7 +876,7 @@ theorem P4456T2SquareEdges (n : Nat) (hn : 0 < n) exact hpnot hxB · rw [← h] at hyB exact hpnot hyB - · have hcoords : c = a ∧ d = b + 1 := SquareEdgeProof.hcoordsAt367 n w z v a b hza c d hvc + · have hcoords : c = a ∧ d = b + 1 := SquareEdgeProof.hcoordsAt367 w z v a b hza c d hvc hvform let pa : Nat := if 0 < a then a else a + 1 let pb : Nat := b + 1 @@ -868,7 +906,7 @@ theorem P4456T2SquareEdges (n : Nat) (hn : 0 < n) · have heq : w + (⟨(c : Int), (d : Int)⟩ : GaussianInt) = (w + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) + 1 := SquareEdgeDetails.heqAt507 w x y a b hxcoord c d hycoord h - have hcd : c = a + 1 ∧ d = b := SquareEdgeDetails.hcdAt513 n w a b c d heq + have hcd : c = a + 1 ∧ d = b := SquareEdgeDetails.hcdAt513 w a b c d heq have hset : ({x,y} : Finset GaussianInt) = {w + (⟨(a : Int), (b : Int)⟩ : GaussianInt), w + (⟨((a+1 : Nat) : Int), (b : Int)⟩ : GaussianInt)} := SquareEdgeDetails.hsetAt520 @@ -878,7 +916,7 @@ theorem P4456T2SquareEdges (n : Nat) (hn : 0 < n) · have heq : w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) = (w + (⟨(c : Int), (d : Int)⟩ : GaussianInt)) + 1 := SquareEdgeDetails.heqAt526 w x y a b hxcoord c d hycoord h - have hcd : a = c + 1 ∧ b = d := SquareEdgeDetails.hcdAt532 n w a b c d heq + have hcd : a = c + 1 ∧ b = d := SquareEdgeDetails.hcdAt532 w a b c d heq have hset : ({x,y} : Finset GaussianInt) = {w + (⟨(c : Int), (d : Int)⟩ : GaussianInt), w + (⟨((c+1 : Nat) : Int), (d : Int)⟩ : GaussianInt)} := @@ -888,7 +926,7 @@ theorem P4456T2SquareEdges (n : Nat) (hn : 0 < n) · have heq : w + (⟨(c : Int), (d : Int)⟩ : GaussianInt) = (w + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) + ⟨0,1⟩ := SquareEdgeDetails.heqAt548 w x y a b hxcoord c d hycoord h - have hcd : c = a ∧ d = b + 1 := SquareEdgeDetails.hcdAt554 n w a b c d heq + have hcd : c = a ∧ d = b + 1 := SquareEdgeDetails.hcdAt554 w a b c d heq have hset : ({x,y} : Finset GaussianInt) = {w + (⟨(a : Int), (b : Int)⟩ : GaussianInt), w + (⟨(a : Int), ((b+1 : Nat) : Int)⟩ : GaussianInt)} := SquareEdgeDetails.hsetAt561 @@ -898,7 +936,7 @@ theorem P4456T2SquareEdges (n : Nat) (hn : 0 < n) · have heq : w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) = (w + (⟨(c : Int), (d : Int)⟩ : GaussianInt)) + ⟨0,1⟩ := SquareEdgeDetails.heqAt567 w x y a b hxcoord c d hycoord h - have hcd : a = c ∧ b = d + 1 := SquareEdgeDetails.hcdAt573 n w a b c d heq + have hcd : a = c ∧ b = d + 1 := SquareEdgeDetails.hcdAt573 w a b c d heq have hset : ({x,y} : Finset GaussianInt) = {w + (⟨(c : Int), (d : Int)⟩ : GaussianInt), w + (⟨(c : Int), ((d+1 : Nat) : Int)⟩ : GaussianInt)} := diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean index 7f903cd8c4..d0d57b98b8 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean @@ -50,24 +50,24 @@ private theorem forestRows : (by classical exact - (BandCircle) → ( let I : GaussianInt := ⟨0, 1⟩ let cyc := fun (q : Fin 4 → CircleCoordinates) (i : Fin 3) => - ![q 0, q i.succ, q ((i + 1).succ), q ((i + 2).succ)] + ![q 0, q i.succ, q (i + 1).succ, q (i + 2).succ] let L := fun z : GaussianInt => - ![((4 : ℤ), 1 + 8 * z + 4 * I), - (1, 1 + 2 * z), (0, -1), (1, 1 + 2 * z + 2 * I)] + ![((4 : ℤ), 1 + 8 * z + 4 * I), (1, 1 + 2 * z), (0, -1), (1, 1 + 2 * z + 2 * I)] let R := fun z : GaussianInt => - ![((4 : ℤ), 7 + 8 * z + 4 * I), - (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * I), (0, 1)] - (∀ q : Fin 4 → CircleCoordinates, ProperBandQuadruple q → 1 < (q 0).1) → ((∀ (q : Fin 4 → - CircleCoordinates), ∀ (i : Fin 3), ∀ (j : Fin 3), cyc (cyc q i) j = cyc q (i + j)) → - (∀ q - : Fin 4 → CircleCoordinates, SemiProperQuadruple q → ProperBandQuadruple q → (∀ j : Fin - 3, (q j.succ).1 ≤ 1) → ∃ z : GaussianInt, ∃ k : Fin 3, q = cyc (L z) k ∨ q = cyc (R z) - k))) ) := by + ![((4 : ℤ), 7 + 8 * z + 4 * I), (1, 1 + 2 * z), (1, 1 + 2 * z + 2 * I), (0, 1)] + (∀ q : Fin 4 → CircleCoordinates, ProperBandQuadruple q → 1 < (q 0).1) → + (∀ (q : Fin 4 → CircleCoordinates), + ∀ (i : Fin 3), ∀ (j : Fin 3), cyc (cyc q i) j = cyc q (i + j)) → + ∀ q : Fin 4 → CircleCoordinates, + SemiProperQuadruple q → + ProperBandQuadruple q → + (∀ j : Fin 3, (q j.succ).1 ≤ 1) → + ∃ z : GaussianInt, ∃ k : Fin 3, q = cyc (L z) k ∨ q = cyc (R z) k + ) := by classical - intro C I cyc L R properGt cycCyc q hq + intro I cyc L R properGt cycCyc q hq induction hq with | base z => intro hp hs @@ -169,51 +169,67 @@ private theorem rootValues : (by classical exact - (BandCircle) → ( let I : GaussianInt := ⟨0, 1⟩ (∀ (z : GaussianInt), - let q := ![((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z), ((1 : - ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩), - ((0 : ℤ), (1 : GaussianInt)), ((0 : ℤ), (-1 : GaussianInt))]; BandVectors.1 (q (3 : Fin - (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (2 : Fin (4 : - ℕ))) - (q (1 : Fin (4 : ℕ))) = (-1 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : - Fin (4 : ℕ))) = (1 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : - ℕ))) = (1 : GaussianInt) ∧ BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = - (-1 : GaussianInt) - z - ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q - (3 : - Fin (4 : ℕ))) = z + ⟨(0 : ℤ), (1 : ℤ)⟩) → ((∀ (q : Fin (4 : ℕ) → CircleCoordinates), - SemiProperQuadruple q → BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = - BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ BandVectors.1 (q (0 : Fin (4 - : ℕ))) (q (3 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) - + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ - BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.2 (q (2 : Fin (4 - : ℕ))) (q (1 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (q (3 : Fin (4 : ℕ))) - (q (2 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = - BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → ((∀ (C : - CircleCoordinates), ∀ (D : CircleCoordinates), PrimitiveVectorOrientation C D → - BandVectors.1 D C = ⟨(0 : - ℤ), - (1 : ℤ)⟩ * BandVectors.1 C D ∧ BandVectors.2 D C = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 C - D) → (∀ (z : GaussianInt), - let U : CircleCoordinates := (1, 1 + 2 * z) - let H : CircleCoordinates := (1, 1 + 2 * z + 2 * I) - BandVectors.1 (0, -1) U = -I ∧ - BandVectors.2 (0, -1) U = I * z ∧ - BandVectors.1 U H = -1 + I ∧ - BandVectors.2 U H = -z - I - I * z ∧ - BandVectors.1 H (0, -1) = 1 ∧ - BandVectors.2 H (0, -1) = z + I ∧ - BandVectors.1 H U = 1 + I ∧ - BandVectors.2 H U = 1 + z - I * z ∧ - BandVectors.1 U (0, 1) = -I ∧ - BandVectors.2 U (0, 1) = I + I * z ∧ - BandVectors.1 (0, 1) H = -1 ∧ - BandVectors.2 (0, 1) H = -1 - z - I)))) ) := by + let q := + ![((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z), + ((1 : ℤ), + (1 : GaussianInt) + (2 : GaussianInt) * z + + (2 : GaussianInt) * ⟨(0 : ℤ), (1 : ℤ)⟩), + ((0 : ℤ), (1 : GaussianInt)), ((0 : ℤ), (-1 : GaussianInt))]; + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = + (0 : GaussianInt) ∧ + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = + (-1 : GaussianInt) ∧ + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = + (1 : GaussianInt) ∧ + BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) = + (1 : GaussianInt) ∧ + BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = + (-1 : GaussianInt) - z - ⟨(0 : ℤ), (1 : ℤ)⟩ ∧ + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = + z + ⟨(0 : ℤ), (1 : ℤ)⟩) → + (∀ (q : Fin (4 : ℕ) → CircleCoordinates), + SemiProperQuadruple q → + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) - + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = + BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) + + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) ∧ + BandVectors.2 (q (0 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) = + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) - + ⟨(0 : ℤ), (1 : ℤ)⟩ * + BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ)))) → + (∀ (C : CircleCoordinates), + ∀ (D : CircleCoordinates), + PrimitiveVectorOrientation C D → + BandVectors.1 D C = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 C D ∧ + BandVectors.2 D C = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 C D) → + ∀ (z : GaussianInt), + let U : CircleCoordinates := (1, 1 + 2 * z) + let H : CircleCoordinates := (1, 1 + 2 * z + 2 * I) + BandVectors.1 (0, -1) U = -I ∧ + BandVectors.2 (0, -1) U = I * z ∧ + BandVectors.1 U H = -1 + I ∧ + BandVectors.2 U H = -z - I - I * z ∧ + BandVectors.1 H (0, -1) = 1 ∧ + BandVectors.2 H (0, -1) = z + I ∧ + BandVectors.1 H U = 1 + I ∧ + BandVectors.2 H U = 1 + z - I * z ∧ + BandVectors.1 U (0, 1) = -I ∧ + BandVectors.2 U (0, 1) = I + I * z ∧ + BandVectors.1 (0, 1) H = -1 ∧ + BandVectors.2 (0, 1) H = -1 - z - I + ) := by classical - intro C I baseLaw stepLaw flipLaw z + intro I baseLaw stepLaw flipLaw z let b : Fin 4 → CircleCoordinates := ![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * I), (0, 1), (0, -1)] have hb : SemiProperQuadruple b := SemiProperQuadruple.base z @@ -1053,7 +1069,7 @@ theorem P4458T1FirstProperRows SemiProperQuadruple q → ProperBandQuadruple q → (∀ j : Fin 3, (q j.succ).1 ≤ 1) → ∃ z : GaussianInt, ∃ k : Fin 3, - q = cyc (L z) k ∨ q = cyc (R z) k := FirstProperRowProof.forestRows C + q = cyc (L z) k ∨ q = cyc (R z) k := FirstProperRowProof.forestRows (FirstProperRowProof.properGt) cycCyc let r : Fin 4 → CircleCoordinates := cyc F.q F.slot have hr : ProperBandQuadruple r := FirstProperRowProof.hrAt221 C orientation base Rminus Rplus @@ -1118,7 +1134,7 @@ theorem P4458T1FirstProperRows (da.re : ℝ) = CircleMatrix C 0 0 * d.re + CircleMatrix C 0 1 * d.im ∧ (da.im : ℝ) = CircleMatrix C 1 0 * d.re + CircleMatrix C 1 1 * d.im have htable : Row orientation y (I * x) ya (-I * xa) := FirstProperRowProof.htable C - orientation base Rminus Rplus hminus hplus F hcr z hrows (FirstProperRowProof.rootValues C + orientation base Rminus Rplus hminus hplus F hcr z hrows (FirstProperRowProof.rootValues baseLaw stepLaw flipLaw) rcases htable with ⟨hyStep, hxStep, hyNe, hxNe, hyRe, hyIm, hxRe, hxIm⟩ -- Subtract the actual endpoint offsets from the selected negative piece. diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean index c0d9daa273..601949c014 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean @@ -965,12 +965,12 @@ private theorem hCgt1 : (by classical exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), - (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → (∀ (p : Fin 4 - → CircleCoordinates), (ProperBandQuadruple p) → ((C.1.1 = p 0) → (1 < C.1.1.1))) ) := by + ∀ (C : BandCircle), + ∀ (p : Fin 4 → CircleCoordinates), + ProperBandQuadruple p → C.1.1 = p 0 → 1 < C.1.1.1 + ) := by classical - intro C orientation base Rminus Rplus hminus hplus F p hp hCcoord + intro C p hp hCcoord rw [hCcoord] have hfacts := ProperBandCurvatureStructure p hp have hpositive' : 0 < (p 0).1 := hfacts.1 @@ -2290,7 +2290,7 @@ private theorem largestParentCertificate : ha10Re ha10Im ha01Re ha01Im hminusSlopeVector hplusSlopeVector ha10ReC ha10ImC ha01ReC ha01ImC hsumReC hsumImC hplusVectorRe hplusVectorIm hplusVectorRe' hplusVectorIm' hplusVectorReC hplusVectorImC hminusSlope hplusSlope - have hCgt1 := LargestParentGeometry.hCgt1 C orientation base Rminus Rplus hminus hplus F p hp + have hCgt1 := LargestParentGeometry.hCgt1 C p hp hCcoord have hpTangency : BandTangency (p 0) (p 3) := by exact ⟨p, hp.1, 0, 3, by decide, rfl, rfl⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean index c3f21d95eb..1253a696fa 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean @@ -210,13 +210,21 @@ private theorem hslot : (by classical exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin - (3 : ℕ)), (Fin (4 : ℕ) → CircleCoordinates) → ((F.slot ≠ a) → (F.slot = a + 1 ∨ - F.slot = a + 2)) ) := by + ∀ (C : BandCircle), + ∀ (orientation : Bool), + ∀ (base : ProtoTile), + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + ∀ (hminus : PartialOdometer), + ∀ (hplus : PartialOdometer), + ∀ + (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus + hplus), + ∀ (a : Fin (3 : ℕ)), F.slot ≠ a → F.slot = a + 1 ∨ F.slot = a + 2 + ) := by classical - intro C orientation base Rminus Rplus hminus hplus F a p selected + intro C orientation base Rminus Rplus hminus hplus F a selected have hne : F.slot.val ≠ a.val := by intro heq exact selected (Fin.ext heq) @@ -1054,13 +1062,12 @@ private theorem hnonunit : (by classical exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), - (P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus) → ((Fin (3 : - ℕ)) → ((Fin (4 : ℕ) → CircleCoordinates) → (∀ (t : Fin (4 : ℕ) → CircleCoordinates), - (ProperBandQuadruple t) → ((t 0 = C.1.1) → (C.1.1.1 ≠ 1))))) ) := by + ∀ (C : BandCircle), + ∀ (t : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple t → t 0 = C.1.1 → C.1.1.1 ≠ 1 + ) := by classical - intro C orientation base Rminus Rplus hminus hplus F a p t ht htC + intro C t ht htC have hcurv := ProperBandCurvatureStructure t ht have hrootlarge : 1 < (t 0).1 := by by_contra hn @@ -3118,8 +3125,8 @@ private theorem firstParentPlacement : ha01ReR ha01ImR hdirectSlope hleftCent hleftTouch hleftAdjacent hMnonempty (SecondNewerRowsGeometry.hJnonempty C orientation base Rminus Rplus hminus hplus F D u hjoinCells hUnonempty) (SecondNewerRowsGeometry.hleftNe C orientation base Rminus - Rplus hminus hplus F u hleftTouch hMnonempty) (SecondNewerRowsGeometry.hnonunit C - orientation base Rminus Rplus hminus hplus F a p t ht htC)) hleftAdjacent, hright⟩⟩ + Rplus hminus hplus F u hleftTouch hMnonempty) (SecondNewerRowsGeometry.hnonunit C t ht + htC)) hleftAdjacent, hright⟩⟩ private theorem secondParentPlacement : (by @@ -4079,7 +4086,7 @@ theorem P4458T1SecondNewerRows : have hqD : F.q (a + 2).succ = p 3 := SecondNewerRowsGeometry.hqD C orientation base Rminus Rplus hminus hplus F a p hstep have hslot := SecondNewerRowsGeometry.hslot C orientation base Rminus Rplus hminus hplus F a - p selected + selected have hSlopeInfo := SecondNewerRowsGeometry.hSlopeInfo C orientation base Rminus Rplus hminus hplus F D hCpositive obtain ⟨rootNeg, joinSlope, hrootNeg, hjoinSlope, diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean index 216409cd29..3a614a1f58 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean @@ -724,64 +724,6 @@ private theorem hap : have hf := (h.2.2.2.2 hp 1).2 simpa [I, ya, r, hA, hB] using hf -private theorem vflip : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (ProperBandQuadruple r) → ( - let I : GaussianInt := ⟨0, 1⟩ - let w := BandVectors.1 (r 3) (r 2) - let y := BandVectors.1 (r 2) (r 1) - (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : - ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 - : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r - (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 - (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : - Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : - ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) - (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r - j.succ) (r (0 : Fin (4 : ℕ))))) → ((BandVectors.1 (r 2) (r 0) = y - I * w) → - (BandVectors.1 (r 0) (r 2) = I * (y - I * w)))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r hr I w y laws hv - have h := (laws.2.2.2.2 hr 1).1 - simpa [I, hv] using h - -private theorem aflip : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (ProperBandQuadruple r) → ( - let I : GaussianInt := ⟨0, 1⟩ - let wa := BandVectors.2 (r 3) (r 2) - let ya := BandVectors.2 (r 2) (r 1) - (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : - ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 - : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r - (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 - (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : - Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : - ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) - (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r - j.succ) (r (0 : Fin (4 : ℕ))))) → ((BandVectors.2 (r 2) (r 0) = ya + I * wa) → - (BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r hr I wa ya laws ha - have h := (laws.2.2.2.2 hr 1).2 - simpa [I, ha] using h - private theorem halfPoint_sub : let halfPoint : GaussianInt → ℝ × ℝ := fun z => (1 / 2 : ℝ) • GaussianRealPoint z @@ -1084,10 +1026,8 @@ theorem P4536T1AFrameB have aAlg := P4536T1EndpointAlgebra (-I) wa xa ya (by decide +kernel) laws.2.1 have aThird := aAlg.2.2.1 have aFourth := aAlg.2.2.2.1 - have vflip : BandVectors.1 (r 0) (r 2) = I * (y - I * w) := AFrameBDetails.vflip C - orientation base Rminus Rplus hminus hplus F a hr laws hv - have aflip : BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa) := AFrameBDetails.aflip C - orientation base Rminus Rplus hminus hplus F a hr laws ha + have vflip := hflipv + have aflip := hflipa let halfPoint : GaussianInt → ℝ × ℝ := fun z => (1 / 2 : ℝ) • GaussianRealPoint z have halfPoint_sub (u v : GaussianInt) : diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean index c583940d6b..50abe4c9ab 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean @@ -424,35 +424,6 @@ private theorem vflip : intro C orientation base Rminus Rplus hminus hplus F a r hr laws exact (laws.2.2.2.2 hr) 2 -private theorem aflip : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (ProperBandQuadruple r) → ((BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 - : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r - (2 : Fin (4 : ℕ))) + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + - BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 - : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) - (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple r → ∀ (j - : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (r (0 : Fin (4 : ℕ))) (r - j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r j.succ) (r (0 : Fin (4 : ℕ))))) → - (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = - { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin - (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = - -{ re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : - Fin (4 : ℕ))))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r hr laws - exact (laws.2.2.2.2 hr) 2 - private theorem vflip' : ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : @@ -1285,9 +1256,8 @@ theorem P4536T1AFrameD have hv := FrameDiagonalProof.hv C orientation base Rminus Rplus hminus hplus F a laws have ha := FrameDiagonalProof.ha C orientation base Rminus Rplus hminus hplus F a laws have vflip := FrameDiagonalProof.vflip C orientation base Rminus Rplus hminus hplus F a hr laws - have aflip := FrameDiagonalProof.aflip C orientation base Rminus Rplus hminus hplus F a hr laws have vflip' := FrameDiagonalProof.vflip' C orientation base Rminus Rplus hminus hplus F a vflip - have aflip' := FrameDiagonalProof.aflip' C orientation base Rminus Rplus hminus hplus F a aflip + have aflip' := FrameDiagonalProof.aflip' C orientation base Rminus Rplus hminus hplus F a vflip have centMinus := FrameDiagonalProof.centMinus C orientation base Rminus Rplus hminus hplus F a p r3 hparent hzero win vflip' diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean index 1778ca4292..bc13ba5a74 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean @@ -512,19 +512,6 @@ private theorem hreal : simpa [Tstar, sub_eq_add_neg] using (TileTranslationFormulas T (-w)).2.2.2.1 -private theorem hcent : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (w : GaussianInt), - let Tstar := TileTranslation T (-w) - TileCentroid Tstar = ((TileCentroid T).1 - (w.re : Real), (TileCentroid T).2 - (w.im : - Real)) ) := by - classical - intro T w Tstar - simpa [Tstar, sub_eq_add_neg] using - (TileTranslationFormulas T (-w)).2.2.2.2.1 - private theorem hf_inj : (by classical @@ -854,7 +841,7 @@ theorem P4564T2FordGeometry (P : FordFareyParameter) (hP : 1 < P.q) (fun p : Real × Real => (p.1 - (w.re : Real), p.2 - (w.im : Real))) '' TileRealization T := FordInterfaceGeometry.hreal T w - have hcent := FordInterfaceGeometry.hcent T w + have hcent := FordInterfaceGeometry.hTstarCent T w let f : Real × Real → Real × Real := fun p => (p.1 - (w.re : Real), p.2 - (w.im : Real)) have hf_inj := FordInterfaceGeometry.hf_inj w diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean index 268592134f..97ca576f03 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean @@ -1107,21 +1107,6 @@ private theorem hp3F : simpa [p3, faceI3, fI3, ModifiedSubtileOccurrenceInterpretation, TileTranslation, GaussianTranslation, htransZero, Finset.image_id] using hh -private theorem hDtile0 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), (GaussianTranslation (0 : GaussianInt) = id) → ( - let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ - cert.modified.tile d0 = cert.P 1 false) ) := by - classical - intro q cfg C T cert htransZero d0 - rw [cert.modified_tile] - simp [d0, ModifiedSubtileOccurrenceInterpretation, - TileTranslation, htransZero] - private theorem hEtile0 : (by classical @@ -1949,7 +1934,7 @@ private theorem fourthJunction : let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ let e0 : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ have hDtile0 : cert.modified.tile d0 = cert.P 1 false := - JunctionRefinementGeometry.hDtile0 q cfg C T cert htransZero + JunctionRefinementGeometry.hDtile q cfg C T cert htransZero have hEtile0 : cert.modified.tile e0 = cert.P 2 true := JunctionRefinementGeometry.hEtile0 q cfg C T cert htransZero have hDEseparate : Disjoint (cert.P 1 false).cells diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean index 0dc0353cb8..c319f9002b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean @@ -170,24 +170,47 @@ private theorem pair_cover : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (x : GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) → ((∀ - (U : ProtoTile), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ U.cells) → (x ∈ - FootprintVertices U)) → ((∀ (a : Fin 3 × Bool), ∀ (b : Fin 3 × Bool), ∀ (c : Fin 3 × - Bool), (a ≠ b) → ((a ≠ c) → ((b ≠ c) → ((¬ (a.1 = 0 ∧ b.1 = 0)) → ((Disjoint (cert.P - a.1 a.2).cells (cert.P c.1 c.2).cells ∨ Disjoint (cert.P b.1 b.2).cells (cert.P c.1 - c.2).cells) → ((x ∈ FootprintVertices (cert.P a.1 a.2)) → ((x ∈ FootprintVertices - (cert.P b.1 b.2)) → (x ∉ FootprintVertices (cert.P c.1 c.2))))))))) → (∀ (a : Fin 3 × - Bool), ∀ (b : Fin 3 × Bool), ∀ (c : Fin 3 × Bool), (a ≠ b) → ((a ≠ c) → ((b ≠ c) → - ((¬ (a.1 = 0 ∧ b.1 = 0)) → ((∀ c', c' ≠ a → c' ≠ b → - Disjoint (cert.P a.1 a.2).cells (cert.P c'.1 c'.2).cells ∨ - Disjoint (cert.P b.1 b.2).cells (cert.P c'.1 c'.2).cells) → ((x ∈ FootprintVertices - (cert.P a.1 a.2)) → ((x ∈ FootprintVertices (cert.P b.1 b.2)) → (∀ j : Fin 4, - LatticeVertexIncidentCell x j ∈ (cert.P a.1 a.2).cells ∨ - LatticeVertexIncidentCell x j ∈ (cert.P b.1 b.2).cells)))))))))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (x : GaussianInt), + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) → + (∀ (U : ProtoTile), + ∀ (j : Fin 4), + LatticeVertexIncidentCell x j ∈ U.cells → + x ∈ FootprintVertices U) → + (∀ (a : Fin 3 × Bool), + ∀ (b : Fin 3 × Bool), + ∀ (c : Fin 3 × Bool), + a ≠ b → + a ≠ c → + b ≠ c → + ¬(a.1 = 0 ∧ b.1 = 0) → + Disjoint (cert.P a.1 a.2).cells (cert.P c.1 c.2).cells ∨ + Disjoint (cert.P b.1 b.2).cells (cert.P c.1 c.2).cells → + x ∈ FootprintVertices (cert.P a.1 a.2) → + x ∈ FootprintVertices (cert.P b.1 b.2) → + x ∉ FootprintVertices (cert.P c.1 c.2)) → + ∀ (a : Fin 3 × Bool), + ∀ (b : Fin 3 × Bool), + a ≠ b → + ¬(a.1 = 0 ∧ b.1 = 0) → + (∀ c', + c' ≠ a → + c' ≠ b → + Disjoint (cert.P a.1 a.2).cells (cert.P c'.1 c'.2).cells ∨ + Disjoint (cert.P b.1 b.2).cells + (cert.P c'.1 c'.2).cells) → + x ∈ FootprintVertices (cert.P a.1 a.2) → + x ∈ FootprintVertices (cert.P b.1 b.2) → + ∀ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (cert.P a.1 a.2).cells ∨ + LatticeVertexIncidentCell x j ∈ (cert.P b.1 b.2).cells + ) := by classical - intro q cfg C T cert x hstar incident_foot noOtherFoot a b c hab hac hbc hnot hthird ha hb j + intro q cfg C T cert x hstar incident_foot noOtherFoot a b hab hnot hthird ha hb j have hcell := hstar j obtain ⟨i, s, howner⟩ := (cert.outer_union _).1 hcell have hownerFoot := incident_foot (cert.P i s) j howner @@ -564,8 +587,8 @@ theorem P4590T1MixedInteriorGeometry (hb : x ∈ FootprintVertices (cert.P b.1 b.2)) : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P a.1 a.2).cells ∨ LatticeVertexIncidentCell x j ∈ (cert.P b.1 b.2).cells := - MixedInteriorGeometry.pair_cover q cfg C T cert x hstar incident_foot noOtherFoot a b - c hab hac hbc hnot hthird ha hb + MixedInteriorGeometry.pair_cover q cfg C T cert x hstar incident_foot noOtherFoot a + b hab hnot hthird ha hb have pair_result (a b k : Fin 3 × Bool) (hab : a ≠ b) (hak : a ≠ k) (hbk : b ≠ k) (hnot : ¬ (a.1 = 0 ∧ b.1 = 0)) diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean index ec8a2e9791..4cf3a10904 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean @@ -326,10 +326,12 @@ private theorem edgeEndpoint : (by classical exact - ∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges - U) → (∀ (z : GaussianInt), (z ∈ e) → (z ∈ FootprintVertices U))) ) := by + ∀ (U : ProtoTile), + ∀ (e : Finset GaussianInt), + e ∈ FootprintEdges U → ∀ (z : GaussianInt), z ∈ e → z ∈ FootprintVertices U + ) := by classical - intro U hne e he z hz + intro U e he z hz rcases he with ⟨cell, hc, hshape | hshape | hshape | hshape⟩ all_goals rw [hshape] at hz all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hz @@ -368,16 +370,24 @@ private theorem threeOwnersContradict : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), (GaussianInt) → (∀ (v : GaussianInt), ∀ (z : GaussianInt), (Nat.card {is : - Fin 3 × Bool // - v ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2) → ((z = v) → ((z ∈ - BoundaryFootprintVertices (cert.P 0 true)) → ((z ∈ BoundaryFootprintVertices - (cert.P 0 false)) → ((z ∈ BoundaryFootprintVertices (cert.P 1 true)) → (False)))))) - ) := by - classical - intro q cfg C T cert x v z hcount hzx hA hB hC + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (v : GaussianInt), + ∀ (z : GaussianInt), + Nat.card + { is : Fin 3 × Bool // + v ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = + 2 → + z = v → + z ∈ BoundaryFootprintVertices (cert.P 0 true) → + z ∈ BoundaryFootprintVertices (cert.P 0 false) → + z ∈ BoundaryFootprintVertices (cert.P 1 true) → False + ) := by + classical + intro q cfg C T cert v z hcount hzx hA hB hC subst z let S := {is : Fin 3 × Bool // v ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} @@ -399,16 +409,24 @@ private theorem threeOwnersAFContradict : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), (GaussianInt) → (∀ (v : GaussianInt), ∀ (z : GaussianInt), (Nat.card {is : - Fin 3 × Bool // - v ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2) → ((z = v) → ((z ∈ - BoundaryFootprintVertices (cert.P 0 true)) → ((z ∈ BoundaryFootprintVertices - (cert.P 1 true)) → ((z ∈ BoundaryFootprintVertices (cert.P 2 false)) → (False)))))) - ) := by - classical - intro q cfg C T cert x v z hcount hzx hA hC hF + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (v : GaussianInt), + ∀ (z : GaussianInt), + Nat.card + { is : Fin 3 × Bool // + v ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = + 2 → + z = v → + z ∈ BoundaryFootprintVertices (cert.P 0 true) → + z ∈ BoundaryFootprintVertices (cert.P 1 true) → + z ∈ BoundaryFootprintVertices (cert.P 2 false) → False + ) := by + classical + intro q cfg C T cert v z hcount hzx hA hC hF subst z let S := {is : Fin 3 × Bool // v ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} @@ -430,16 +448,28 @@ private theorem interfaceConclusion : (by classical exact - ∀ (v : GaussianInt), ∀ (U : ProtoTile), ∀ (V : ProtoTile), (ProtoTile) → ((LatticeTile U) - → ((LatticeTile V) → ((Disjoint U.cells V.cells) → ((∃ e f : Finset GaussianInt, - e ≠ f ∧ v ∈ e ∧ v ∈ f ∧ - e ∈ FootprintEdges U ∩ FootprintEdges V ∧ - f ∈ FootprintEdges U ∩ FootprintEdges V) → ((∀ y, y = v ∨ y = v + 1 ∨ y = v - 1 ∨ y - = v + ⟨0, 1⟩ ∨ y = v - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ FootprintVertices - V) ∧ (∀ z, z = v ∨ z = v - 1 ∨ z = v - ⟨0, 1⟩ ∨ z = v - 1 - ⟨0, 1⟩ → z ∈ - U.cells ∨ z ∈ V.cells)))))) ) := by - classical - intro v U V W hU hV hdis hedges + ∀ (v : GaussianInt), + ∀ (U : ProtoTile), + ∀ (V : ProtoTile), + LatticeTile U → + LatticeTile V → + Disjoint U.cells V.cells → + (∃ e f : Finset GaussianInt, + e ≠ f ∧ + v ∈ e ∧ + v ∈ f ∧ + e ∈ FootprintEdges U ∩ FootprintEdges V ∧ + f ∈ FootprintEdges U ∩ FootprintEdges V) → + (∀ y, + y = v ∨ + y = v + 1 ∨ y = v - 1 ∨ y = v + ⟨0, 1⟩ ∨ y = v - ⟨0, 1⟩ → + y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V) ∧ + ∀ z, + z = v ∨ z = v - 1 ∨ z = v - ⟨0, 1⟩ ∨ z = v - 1 - ⟨0, 1⟩ → + z ∈ U.cells ∨ z ∈ V.cells + ) := by + classical + intro v U V hU hV hdis hedges have sec := (LocalLatticeInterfaceSectors.2 U V v hU hV hdis hedges) refine ⟨P4590T1OppositeCellsStar U V v sec.2, ?_⟩ intro z hz @@ -1114,44 +1144,72 @@ private theorem hEdgesQC : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), ∀ (x : GaussianInt), (∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ (e : - Finset GaussianInt), (e ∈ FootprintEdges U) → (∀ (z : GaussianInt), (z ∈ e) → (z ∈ - FootprintVertices U)))) → ((FootprintVertices (cert.P 0 true) ∩ FootprintVertices - (cert.P 1 true) ⊆ FootprintVertices (cert.Q 1 true) ∩ FootprintVertices (cert.P 1 - true)) → (((cert.P 1 true).cells.Nonempty) → ((∃ y z : GaussianInt, ∃ e f : Finset - GaussianInt, e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ e ∈ FootprintEdges (cert.P 0 true) ∩ - FootprintEdges (cert.P 1 true) ∧ f ∈ FootprintEdges (cert.P 0 true) ∩ FootprintEdges - (cert.P 1 true) ∧ e = {y, x} ∧ f = {x, z} ∧ FourNeighborAdjacent y x ∧ - FourNeighborAdjacent x z) → ((∀ x ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) - true), ∀ y ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true), FourNeighborAdjacent - x y → {x, y} ∈ FootprintEdges (cert.Q (1 : Fin (3 : ℕ)) true)) → ((∀ x ∈ - FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true), ∀ y ∈ FootprintVertices (cert.P (1 - : Fin (3 : ℕ)) true), FourNeighborAdjacent x y → {x, y} ∈ FootprintEdges (cert.P (1 : - Fin (3 : ℕ)) true)) → (∃ e f : Finset GaussianInt, e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ e ∈ - FootprintEdges (cert.Q 1 true) ∩ FootprintEdges (cert.P 1 true) ∧ f ∈ FootprintEdges - (cert.Q 1 true) ∩ FootprintEdges (cert.P 1 true))))))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (x : GaussianInt), + (∀ (U : ProtoTile), + ∀ (e : Finset GaussianInt), + e ∈ FootprintEdges U → + ∀ (z : GaussianInt), z ∈ e → z ∈ FootprintVertices U) → + FootprintVertices (cert.P 0 true) ∩ + FootprintVertices (cert.P 1 true) ⊆ + FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.P 1 true) → + (cert.P 1 true).cells.Nonempty → + (∃ y z : GaussianInt, + ∃ e f : Finset GaussianInt, + e ≠ f ∧ + x ∈ e ∧ + x ∈ f ∧ + e ∈ + FootprintEdges (cert.P 0 true) ∩ + FootprintEdges (cert.P 1 true) ∧ + f ∈ + FootprintEdges (cert.P 0 true) ∩ + FootprintEdges (cert.P 1 true) ∧ + e = { y, x } ∧ + f = { x, z } ∧ + FourNeighborAdjacent y x ∧ FourNeighborAdjacent x z) → + (∀ x ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true), + ∀ y ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true), + FourNeighborAdjacent x y → + { x, y } ∈ + FootprintEdges (cert.Q (1 : Fin (3 : ℕ)) true)) → + (∀ x ∈ FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true), + ∀ y ∈ FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true), + FourNeighborAdjacent x y → + { x, y } ∈ + FootprintEdges (cert.P (1 : Fin (3 : ℕ)) true)) → + ∃ e f : Finset GaussianInt, + e ≠ f ∧ + x ∈ e ∧ + x ∈ f ∧ + e ∈ + FootprintEdges (cert.Q 1 true) ∩ + FootprintEdges (cert.P 1 true) ∧ + f ∈ + FootprintEdges (cert.Q 1 true) ∩ + FootprintEdges (cert.P 1 true) + ) := by classical intro q cfg C T cert x edgeEndpoint raw_support hCne hpathEndpoints regQ regC obtain ⟨y, z, e, f, hef, hxe, hxf, he, hf, rfl, rfl, hyx, hxz⟩ := hpathEndpoints have hyA := edgeEndpoint (cert.P 0 true) - (LatticeTileGridStructure _ (cert.parent_lattice 0 true)).1.1 {y, x} he.1 y (by simp) have hxA := edgeEndpoint (cert.P 0 true) - (LatticeTileGridStructure _ (cert.parent_lattice 0 true)).1.1 {y, x} he.1 x (by simp) - have hyC := edgeEndpoint (cert.P 1 true) hCne {y, x} he.2 y (by simp) - have hxC := edgeEndpoint (cert.P 1 true) hCne {y, x} he.2 x (by simp) + have hyC := edgeEndpoint (cert.P 1 true) {y, x} he.2 y (by simp) + have hxC := edgeEndpoint (cert.P 1 true) {y, x} he.2 x (by simp) have hxA' := edgeEndpoint (cert.P 0 true) - (LatticeTileGridStructure _ (cert.parent_lattice 0 true)).1.1 {x, z} hf.1 x (by simp) have hzA := edgeEndpoint (cert.P 0 true) - (LatticeTileGridStructure _ (cert.parent_lattice 0 true)).1.1 {x, z} hf.1 z (by simp) - have hxC' := edgeEndpoint (cert.P 1 true) hCne {x, z} hf.2 x (by simp) - have hzC := edgeEndpoint (cert.P 1 true) hCne {x, z} hf.2 z (by simp) + have hxC' := edgeEndpoint (cert.P 1 true) {x, z} hf.2 x (by simp) + have hzC := edgeEndpoint (cert.P 1 true) {x, z} hf.2 z (by simp) have hyQ := (raw_support ⟨hyA, hyC⟩).1 have hxQ := (raw_support ⟨hxA, hxC⟩).1 have hzQ := (raw_support ⟨hzA, hzC⟩).1 @@ -1791,53 +1849,142 @@ private theorem positiveCase : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), (GaussianInt) → ((∀ (v : GaussianInt), ∀ (V : Set GaussianInt), ∀ (E : Set - (Finset GaussianInt)), ∀ (a : GaussianInt), ∀ (b : GaussianInt), - SimpleGridPathBetween V E a b → v ∈ V → v ≠ a → v ≠ b → ∃ (y : GaussianInt) (z : - GaussianInt) (e : Finset GaussianInt) (f : Finset GaussianInt), e ≠ f ∧ v ∈ e ∧ v ∈ f - ∧ e ∈ E ∧ f ∈ E ∧ e = {y, v} ∧ f = {v, z} ∧ FourNeighborAdjacent y v ∧ - FourNeighborAdjacent v z) → ((∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (W : - ProtoTile), Finset.Nonempty U.cells → Finset.Nonempty V.cells → TouchingTriple U V W - → Disjoint U.cells V.cells) → ((∀ (U : ProtoTile), Finset.Nonempty U.cells → ∀ e ∈ - FootprintEdges U, ∀ z ∈ e, z ∈ FootprintVertices U) → ((∀ (z : GaussianInt), ∀ (U : - ProtoTile), ∀ (V : ProtoTile), ∀ (W : ProtoTile), LatticeTile U → LatticeTile V → - LatticeTile W → Disjoint U.cells W.cells → Disjoint V.cells W.cells → z ∈ - FootprintVertices U → z ∈ FootprintVertices V → z ∈ FootprintVertices W → z ∈ - BoundaryFootprintVertices U ∧ z ∈ BoundaryFootprintVertices V ∧ z ∈ - BoundaryFootprintVertices W) → ((∀ (v : GaussianInt), ∀ (z : GaussianInt), Nat.card - { is : Fin (3 : ℕ) × Bool // v ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 - : ℕ) → z = v → z ∈ BoundaryFootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) → z ∈ - BoundaryFootprintVertices (cert.P (0 : Fin (3 : ℕ)) false) → z ∈ - BoundaryFootprintVertices (cert.P (1 : Fin (3 : ℕ)) true) → False) → ((∀ (v : - GaussianInt), ∀ (z : GaussianInt), Nat.card - { is : Fin (3 : ℕ) × Bool // v ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 - : ℕ) → z = v → z ∈ BoundaryFootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) → z ∈ - BoundaryFootprintVertices (cert.P (1 : Fin (3 : ℕ)) true) → z ∈ - BoundaryFootprintVertices (cert.P (2 : Fin (3 : ℕ)) false) → False) → ((∀ (v : - GaussianInt), ∀ (U : ProtoTile), ∀ (V : ProtoTile), (ProtoTile) → (LatticeTile U → - LatticeTile V → Disjoint U.cells V.cells → (∃ (e : Finset GaussianInt) (f : Finset - GaussianInt), e ≠ f ∧ v ∈ e ∧ v ∈ f ∧ e ∈ FootprintEdges U ∩ FootprintEdges V ∧ f ∈ - FootprintEdges U ∩ FootprintEdges V) → (∀ (y : GaussianInt), y = v ∨ y = v + (1 : - GaussianInt) ∨ y = v - (1 : GaussianInt) ∨ y = v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ∨ y = v - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices U ∨ y ∈ - FootprintVertices V) ∧ ∀ (z : GaussianInt), z = v ∨ z = v - (1 : GaussianInt) ∨ z = v - - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ z = v - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) → z ∈ U.cells ∨ z ∈ V.cells)) → ((FootprintVertices (cert.P 0 - true) ∩ FootprintVertices (cert.P 1 true) ⊆ FootprintVertices (cert.Q 1 true) ∩ - FootprintVertices (cert.P 1 true)) → (∀ (point : GaussianInt), (Nat.card {is : Fin 3 - × Bool // - point ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2) → ((point ∈ - FootprintVertices (cert.P 0 true)) → ((point ∈ FootprintVertices (cert.P 1 true)) - → (point ∈ FootprintVertices (cert.Q 1 true) ∧ (∀ y, y = point ∨ y = point + 1 ∨ - y = point - 1 ∨ y = point + ⟨0, 1⟩ ∨ y = point - ⟨0, 1⟩ → y ∈ FootprintVertices - (cert.Q 1 true) ∨ y ∈ FootprintVertices (cert.P 1 true)) ∧ (∀ z, z = point ∨ z = - point - 1 ∨ z = point - ⟨0, 1⟩ ∨ z = point - 1 - ⟨0, 1⟩ → z ∈ (cert.Q 1 - true).cells ∨ z ∈ (cert.P 1 true).cells))))))))))))) ) := by - classical - intro q cfg C T cert x twoPathEdges touching_disjoint edgeEndpoint threeBoundaries - threeOwnersContradict threeOwnersAFContradict interfaceConclusion raw_support point hk hA hC + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + (∀ (v : GaussianInt), + ∀ (V : Set GaussianInt), + ∀ (E : Set (Finset GaussianInt)), + ∀ (a : GaussianInt), + ∀ (b : GaussianInt), + SimpleGridPathBetween V E a b → + v ∈ V → + v ≠ a → + v ≠ b → + ∃ (y : GaussianInt) (z : GaussianInt) (e : + Finset GaussianInt) (f : Finset GaussianInt), + e ≠ f ∧ + v ∈ e ∧ + v ∈ f ∧ + e ∈ E ∧ + f ∈ E ∧ + e = { y, v } ∧ + f = { v, z } ∧ + FourNeighborAdjacent y v ∧ FourNeighborAdjacent v z) → + (∀ (U : ProtoTile), + ∀ (V : ProtoTile), + ∀ (W : ProtoTile), + Finset.Nonempty U.cells → + Finset.Nonempty V.cells → + TouchingTriple U V W → Disjoint U.cells V.cells) → + (∀ (U : ProtoTile), + ∀ e ∈ FootprintEdges U, ∀ z ∈ e, z ∈ FootprintVertices U) → + (∀ (z : GaussianInt), + ∀ (U : ProtoTile), + ∀ (V : ProtoTile), + ∀ (W : ProtoTile), + LatticeTile U → + LatticeTile V → + LatticeTile W → + Disjoint U.cells W.cells → + Disjoint V.cells W.cells → + z ∈ FootprintVertices U → + z ∈ FootprintVertices V → + z ∈ FootprintVertices W → + z ∈ BoundaryFootprintVertices U ∧ + z ∈ BoundaryFootprintVertices V ∧ + z ∈ BoundaryFootprintVertices W) → + (∀ (v : GaussianInt), + ∀ (z : GaussianInt), + Nat.card + { is : Fin (3 : ℕ) × Bool // + v ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = + (2 : ℕ) → + z = v → + z ∈ + BoundaryFootprintVertices + (cert.P (0 : Fin (3 : ℕ)) true) → + z ∈ + BoundaryFootprintVertices + (cert.P (0 : Fin (3 : ℕ)) false) → + z ∈ + BoundaryFootprintVertices + (cert.P (1 : Fin (3 : ℕ)) true) → + False) → + (∀ (v : GaussianInt), + ∀ (z : GaussianInt), + Nat.card + { is : Fin (3 : ℕ) × Bool // + v ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = + (2 : ℕ) → + z = v → + z ∈ + BoundaryFootprintVertices + (cert.P (0 : Fin (3 : ℕ)) true) → + z ∈ + BoundaryFootprintVertices + (cert.P (1 : Fin (3 : ℕ)) true) → + z ∈ + BoundaryFootprintVertices + (cert.P (2 : Fin (3 : ℕ)) false) → + False) → + (∀ (v : GaussianInt), + ∀ (U : ProtoTile), + ∀ (V : ProtoTile), + LatticeTile U → + LatticeTile V → + Disjoint U.cells V.cells → + (∃ (e : Finset GaussianInt) (f : Finset GaussianInt), + e ≠ f ∧ + v ∈ e ∧ + v ∈ f ∧ + e ∈ FootprintEdges U ∩ FootprintEdges V ∧ + f ∈ FootprintEdges U ∩ FootprintEdges V) → + (∀ (y : GaussianInt), + y = v ∨ + y = v + (1 : GaussianInt) ∨ + y = v - (1 : GaussianInt) ∨ + y = v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ + y = v - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → + y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V) ∧ + ∀ (z : GaussianInt), + z = v ∨ + z = v - (1 : GaussianInt) ∨ + z = v - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ + z = + v - (1 : GaussianInt) - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → + z ∈ U.cells ∨ z ∈ V.cells) → + FootprintVertices (cert.P 0 true) ∩ + FootprintVertices (cert.P 1 true) ⊆ + FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.P 1 true) → + ∀ (point : GaussianInt), + Nat.card + { is : Fin 3 × Bool // + point ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = + 2 → + point ∈ FootprintVertices (cert.P 0 true) → + point ∈ FootprintVertices (cert.P 1 true) → + point ∈ FootprintVertices (cert.Q 1 true) ∧ + (∀ y, + y = point ∨ + y = point + 1 ∨ + y = point - 1 ∨ y = point + ⟨0, 1⟩ ∨ y = point - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.Q 1 true) ∨ + y ∈ FootprintVertices (cert.P 1 true)) ∧ + ∀ z, + z = point ∨ + z = point - 1 ∨ + z = point - ⟨0, 1⟩ ∨ z = point - 1 - ⟨0, 1⟩ → + z ∈ (cert.Q 1 true).cells ∨ z ∈ (cert.P 1 true).cells + ) := by + classical + intro q cfg C T cert twoPathEdges touching_disjoint edgeEndpoint threeBoundaries + threeOwnersContradict threeOwnersAFContradict interfaceConclusion raw_support point hk hA + hC have hQC := raw_support ⟨hA, hC⟩ have hQ : LatticeTile (cert.Q 1 true) := P4590T1PositivePrototileDisk _ _ (cert.plus_occurrence 1 true).1 (by @@ -1944,8 +2091,8 @@ private theorem positiveCase : T cert hprepos) hCtile).2.1 have hdis : Disjoint (cert.Q 1 true).cells (cert.P 1 true).cells := touching_disjoint _ _ _ hQne hCne cert.double_third - have hresult := interfaceConclusion point (cert.Q 1 true) (cert.P 1 true) - (cert.P 2 false) hQ hCtile hdis (RightInteriorGeometry.hEdgesQC q cfg C T cert point + have hresult := interfaceConclusion point (cert.Q 1 true) (cert.P 1 true) hQ hCtile hdis + (RightInteriorGeometry.hEdgesQC q cfg C T cert point edgeEndpoint raw_support hCne (RightInteriorGeometry.hpathEndpoints q cfg C T cert point twoPathEdges hA hC (RightInteriorGeometry.hcompleteOriginal q cfg C T cert hretainEdges hretainVertices (RightInteriorGeometry.hcomplete q cfg C T cert htileA htileC hraw f g @@ -2015,8 +2162,8 @@ theorem P4590T1RightInteriorGeometry : have touching_disjoint := RightInteriorGeometry.touching_disjoint have edgeEndpoint := RightInteriorGeometry.edgeEndpoint have threeBoundaries := RightInteriorGeometry.threeBoundaries (RightInteriorGeometry.rawIncident) - have threeOwnersContradict := RightInteriorGeometry.threeOwnersContradict q cfg C T cert x - have threeOwnersAFContradict := RightInteriorGeometry.threeOwnersAFContradict q cfg C T cert x + have threeOwnersContradict := RightInteriorGeometry.threeOwnersContradict q cfg C T cert + have threeOwnersAFContradict := RightInteriorGeometry.threeOwnersAFContradict q cfg C T cert have interfaceConclusion := RightInteriorGeometry.interfaceConclusion have raw_support : FootprintVertices (cert.P 0 true) ∩ FootprintVertices (cert.P 1 true) ⊆ @@ -2034,7 +2181,7 @@ theorem P4590T1RightInteriorGeometry : (∀ z, z = point ∨ z = point - 1 ∨ z = point - ⟨0, 1⟩ ∨ z = point - 1 - ⟨0, 1⟩ → z ∈ (cert.Q 1 true).cells ∨ z ∈ (cert.P 1 true).cells) := - RightInteriorConclusion.positiveCase q cfg C T cert x twoPathEdges touching_disjoint + RightInteriorConclusion.positiveCase q cfg C T cert twoPathEdges touching_disjoint edgeEndpoint threeBoundaries threeOwnersContradict threeOwnersAFContradict interfaceConclusion raw_support point hk hA hC constructor diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean index 861ca47049..182bf2ab72 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean @@ -70,10 +70,10 @@ private theorem hq1 : (by classical exact - (Fin 4 → CircleCoordinates) → (∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → (0 < P.q₁)) - ) := by + ∀ (P : FordFareyParameter), (1 : ℕ) < P.q → 0 < P.q₁ + ) := by classical - intro r P hP + intro P hP by_contra hn have hzq : P.q₁ = 0 := by omega have hd := P.det₁ @@ -149,12 +149,16 @@ private theorem hvector : (by classical exact - (Fin 4 → CircleCoordinates) → (∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → ((P.q = P.q₁ - + P.q₂) → ((ProperBandQuadruple (FordRecursiveQuadruple P)) → (BandVectors.1 - ((FordRecursiveQuadruple P) 2) ((FordRecursiveQuadruple P) 1) = -((P.q₁ : Int) : - GaussianInt) + ⟨0, (P.q₂ : Int)⟩)))) ) := by + ∀ (P : FordFareyParameter), + (1 : ℕ) < P.q → + P.q = P.q₁ + P.q₂ → + ProperBandQuadruple (FordRecursiveQuadruple P) → + BandVectors.1 ((FordRecursiveQuadruple P) 2) + ((FordRecursiveQuadruple P) 1) = + -((P.q₁ : Int) : GaussianInt) + ⟨0, (P.q₂ : Int)⟩ + ) := by classical - intro r P hP hsum hproperFord + intro P hP hsum hproperFord let F := FordRecursiveQuadruple P have hrot : SemiProperQuadruple ![F 0, F 2, F 3, F 1] := SemiProperQuadruple.rotate hproperFord.1 @@ -856,7 +860,7 @@ theorem P4638T1EmptyFordLocalization (r : Fin 4 → CircleCoordinates) have hp := EmptyFordGeometry.hp r hr have hrec' : BandPackingSymmetryQuadrupleAction g₀ p = FordRecursiveQuadruple P := by simpa [p] using hrec - have hq1 := EmptyFordGeometry.hq1 r P hP + have hq1 := EmptyFordGeometry.hq1 P hP have hq2 : 0 < P.q₂ := P.q₂_pos have hsum : P.q = P.q₁ + P.q₂ := P.sum_q obtain ⟨neg, hphase, _, hcyclic, hcirc, horient, hquad, hvec, g, hg, hcirg, @@ -868,7 +872,7 @@ theorem P4638T1EmptyFordLocalization (r : Fin 4 → CircleCoordinates) have hphase2 : BandPackingSymmetryScopedPhase g p false := hfalse have hcanonical := EmptyFordGeometry.hcanonical r P g hrecg hgfalse hphase2 have hproperFord := EmptyFordGeometry.hproperFord P hP - have hvector := EmptyFordGeometry.hvector r P hP hsum hproperFord + have hvector := EmptyFordGeometry.hvector P hP hsum hproperFord have htargetvec := EmptyFordGeometry.htargetvec r P g hcanonical hvector let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 have cellTurn_bij := EmptyFordGeometry.cellTurn_bij diff --git a/LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean b/LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean index f091f0b94e..630cac3c10 100644 --- a/LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean +++ b/LeanPool/ApollonianSuperharmonic/P4651T1CycleComplementaryArcs.lean @@ -132,21 +132,32 @@ private theorem hSupport : exact Set.mem_union_right _ hx private theorem noThree : - ∀ (Kplus : Set GaussianInt), ∀ (Kminus : Set GaussianInt), ∀ (Fplus : Set (Finset - GaussianInt)), ∀ (Fminus : Set (Finset GaussianInt)), (List GaussianInt) → ((List - GaussianInt) → ((List GaussianInt) → ( - let X : Set GaussianInt := Kplus ∪ Kminus - let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus - ∀ [Finite (↑X : Type)], - let G : SimpleGraph X := SimpleGraph.fromRel fun u v => - ({u.1, v.1} : Finset GaussianInt) ∈ GEdges - (∀ v : X, Set.ncard (G.neighborSet v) ≤ 2) → (∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (w - : GaussianInt), ∀ (z : GaussianInt), ∀ (hu : u ∈ X), ∀ (hv : v ∈ X), ∀ (hw : w ∈ X), ∀ - (hz : z ∈ X), u ≠ v → u ≠ w → u ≠ z → v ≠ w → v ≠ z → w ≠ z → G.Adj ⟨u, hu⟩ ⟨v, hv⟩ → - G.Adj ⟨u, hu⟩ ⟨w, hw⟩ → G.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False)))) := by + ∀ (Kplus : Set GaussianInt), + ∀ (Kminus : Set GaussianInt), + ∀ (Fplus : Set (Finset GaussianInt)), + ∀ (Fminus : Set (Finset GaussianInt)), + let X : Set GaussianInt := Kplus ∪ Kminus; + let GEdges : Set (Finset GaussianInt) := Fplus ∪ Fminus; + ∀ [Finite (↑X : Type)], + let G : SimpleGraph X := + SimpleGraph.fromRel fun u v => ({ u.1, v.1 } : Finset GaussianInt) ∈ GEdges; + (∀ v : X, Set.ncard (G.neighborSet v) ≤ 2) → + ∀ (u : GaussianInt), + ∀ (v : GaussianInt), + ∀ (w : GaussianInt), + ∀ (z : GaussianInt), + ∀ (hu : u ∈ X), + ∀ (hv : v ∈ X), + ∀ (hw : w ∈ X), + ∀ (hz : z ∈ X), + v ≠ w → + v ≠ z → + w ≠ z → + G.Adj ⟨u, hu⟩ ⟨v, hv⟩ → + G.Adj ⟨u, hu⟩ ⟨w, hw⟩ → G.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False := by classical - intro Kplus Kminus Fplus Fminus c p q X GEdges this G hdeg' u v w z hu hv hw hz huv huw huz hvw - hvz hwz hUv hUw hUz + intro Kplus Kminus Fplus Fminus X GEdges this G hdeg' u v w z hu hv hw hz hvw hvz hwz hUv hUw + hUz let A : Set X := {⟨v, hv⟩, ⟨w, hw⟩, ⟨z, hz⟩} have hsub : A ⊆ G.neighborSet ⟨u, hu⟩ := by intro t ht @@ -575,16 +586,25 @@ private theorem hEend : simp private theorem hEne : - ∀ (E : Set (Finset GaussianInt)), ∀ (c : List GaussianInt), ∀ (cx : GaussianInt), ∀ (cy : - GaussianInt), (FourNeighborAdjacent cy cx) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), - ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), c = l₁ ++ a :: b :: l₂ → - FourNeighborAdjacent a b) → ((∀ (e : Finset GaussianInt), e ∈ E ↔ e = {cy, cx} ∨ ∃ (a : - GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), c = l₁ ++ - a :: b :: l₂ ∧ e = {a, b}) → ((List GaussianInt) → ((List GaussianInt) → ((∀ u, ∀ v, - FourNeighborAdjacent u v → u ≠ v) → (∀ x, ∀ y, ({x, y} : Finset GaussianInt) ∈ E → x ≠ - y)))))) := by + ∀ (E : Set (Finset GaussianInt)), + ∀ (c : List GaussianInt), + ∀ (cx : GaussianInt), + ∀ (cy : GaussianInt), + FourNeighborAdjacent cy cx → + (∀ (a : GaussianInt), + ∀ (b : GaussianInt), + ∀ (l₁ : List GaussianInt), + ∀ (l₂ : List GaussianInt), + c = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → + (∀ (e : Finset GaussianInt), + e ∈ E ↔ + e = { cy, cx } ∨ + ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : + List GaussianInt), c = l₁ ++ a :: b :: l₂ ∧ e = { a, b }) → + (∀ u, ∀ v, FourNeighborAdjacent u v → u ≠ v) → + ∀ x, ∀ y, ({ x, y } : Finset GaussianInt) ∈ E → x ≠ y := by classical - intro E c cx cy hclose hcStep hcEdges p q fourNe x y he hxy + intro E c cx cy hclose hcStep hcEdges fourNe x y he hxy have hcard : ({x, y} : Finset GaussianInt).card = 1 := by simp [hxy] rcases (hcEdges {x, y}).mp he with hcloseE | ⟨u, v, l₁, l₂, hdec, hpair⟩ · have hne := fourNe cy cx hclose @@ -629,18 +649,27 @@ private theorem cycleOther : simpa [Finset.pair_comm] using hpair private theorem noThreeE : - ∀ (E : Set (Finset GaussianInt)), (List GaussianInt) → ((List GaussianInt) → ((List - GaussianInt) → ( - let U : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e} - ∀ [Finite (↑U : Type)], - let C : SimpleGraph U := SimpleGraph.fromRel fun u v => - ({u.1, v.1} : Finset GaussianInt) ∈ E - (∀ v : U, Set.ncard (C.neighborSet v) ≤ 2) → (∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (w - : GaussianInt), ∀ (z : GaussianInt), ∀ (hu : u ∈ U), ∀ (hv : v ∈ U), ∀ (hw : w ∈ U), ∀ - (hz : z ∈ U), u ≠ v → u ≠ w → u ≠ z → v ≠ w → v ≠ z → w ≠ z → C.Adj ⟨u, hu⟩ ⟨v, hv⟩ → - C.Adj ⟨u, hu⟩ ⟨w, hw⟩ → C.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False)))) := by + ∀ (E : Set (Finset GaussianInt)), + let U : Set GaussianInt := {x | ∃ e ∈ E, x ∈ e}; + ∀ [Finite (↑U : Type)], + let C : SimpleGraph U := + SimpleGraph.fromRel fun u v => ({ u.1, v.1 } : Finset GaussianInt) ∈ E; + (∀ v : U, Set.ncard (C.neighborSet v) ≤ 2) → + ∀ (u : GaussianInt), + ∀ (v : GaussianInt), + ∀ (w : GaussianInt), + ∀ (z : GaussianInt), + ∀ (hu : u ∈ U), + ∀ (hv : v ∈ U), + ∀ (hw : w ∈ U), + ∀ (hz : z ∈ U), + v ≠ w → + v ≠ z → + w ≠ z → + C.Adj ⟨u, hu⟩ ⟨v, hv⟩ → + C.Adj ⟨u, hu⟩ ⟨w, hw⟩ → C.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False := by classical - intro E c p q U this C hdegE' u v w z hu hv hw hz huv huw huz hvw hvz hwz hUv hUw hUz + intro E U this C hdegE' u v w z hu hv hw hz hvw hvz hwz hUv hUw hUz let A : Set U := {⟨v, hv⟩, ⟨w, hw⟩, ⟨z, hz⟩} have hsub : A ⊆ C.neighborSet ⟨u, hu⟩ := by intro t ht @@ -1057,10 +1086,9 @@ private theorem qEndpoint : pair_ne) x hx₁ hx₂ hh hl) private theorem fourNe : - (List GaussianInt) → ((List GaussianInt) → ((List GaussianInt) → (∀ u, ∀ v, - FourNeighborAdjacent u v → u ≠ v))) := by + ∀ u, ∀ v, FourNeighborAdjacent u v → u ≠ v := by classical - intro c p q u v huv huvEq + intro u v huv huvEq subst v simp [FourNeighborAdjacent, Zsqrtd.ext_iff] at huv omega @@ -1350,8 +1378,15 @@ theorem P4651T1CycleComplementaryArcs : (hu : u ∈ X) (hv : v ∈ X) (hw : w ∈ X) (hz : z ∈ X), u ≠ v → u ≠ w → u ≠ z → v ≠ w → v ≠ z → w ≠ z → G.Adj ⟨u, hu⟩ ⟨v, hv⟩ → G.Adj ⟨u, hu⟩ ⟨w, hw⟩ → - G.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False := CycleArcProof.noThree Kplus Kminus Fplus Fminus c p q - hdeg' + G.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False := (show + ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (w : GaussianInt), ∀ (z : + GaussianInt), ∀ (hu : u ∈ X), ∀ (hv : v ∈ X), ∀ (hw : w ∈ X), ∀ (hz : z ∈ + X), u ≠ v → u ≠ w → u ≠ z → v ≠ w → v ≠ z → w ≠ z → G.Adj ⟨u, hu⟩ ⟨v, hv⟩ → + G.Adj ⟨u, hu⟩ ⟨w, hw⟩ → G.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False + from by + intro u v w z hu hv hw hz huv huw huz hvw hvz hwz hUv hUw hUz + exact CycleArcProof.noThree Kplus Kminus Fplus Fminus hdeg' u v w z hu hv hw hz hvw + hvz hwz hUv hUw hUz) have pair_ne : ∀ (s : List GaussianInt), s.Nodup → ∀ x y l₁ l₂, s = l₁ ++ x :: y :: l₂ → x ≠ y := CycleArcDetails.pair_ne have pEndpoint : ∀ x, x ∈ Kplus → x ∈ Kminus → @@ -1370,7 +1405,7 @@ theorem P4651T1CycleComplementaryArcs : (q.head? = some (r a) ∧ q.getLast? = some a) ∨ (q.head? = some a ∧ q.getLast? = some (r a)) := CycleArcProof.qOrientation Kplus Kminus r a ha q hara harp hdistinct qEndpoint - have fourNe : ∀ u v, FourNeighborAdjacent u v → u ≠ v := CycleArcDetails.fourNe c p q + have fourNe : ∀ u v, FourNeighborAdjacent u v → u ≠ v := CycleArcDetails.fourNe have hcne : c ≠ [] := CycleArcDetails.hcne c hcLen have hcxList : cx ∈ c := CycleArcDetails.hcxList c cx hcHead hcne have hcyList : cy ∈ c := CycleArcDetails.hcyList c cy hcLast hcne @@ -1400,8 +1435,17 @@ theorem P4651T1CycleComplementaryArcs : Fminus hGE hSupport (CycleArcProof.twoNeighbors Kplus Kminus Fplus Fminus r a hdisjoint ha p hpN hpLen hKp hpStep hpEdges q hqN hqLen hKm hqStep hqEdges hara harp splitInterior pair_ne (CycleArcProof.path_other pair_ne) pOrientation - qOrientation) (CycleArcProof.hEne E c cx cy hclose hcStep hcEdges p q fourNe) - edgeAdjE (CycleArcProof.noThreeE E c p q hdegE') hXU + qOrientation) (CycleArcProof.hEne E c cx cy hclose hcStep hcEdges fourNe) + edgeAdjE ((show + ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (w : + GaussianInt), ∀ (z : GaussianInt), ∀ (hu : u ∈ U), ∀ (hv + : v ∈ U), ∀ (hw : w ∈ U), ∀ (hz : z ∈ U), u ≠ v → u ≠ w + → u ≠ z → v ≠ w → v ≠ z → w ≠ z → C.Adj ⟨u, hu⟩ ⟨v, hv⟩ + → C.Adj ⟨u, hu⟩ ⟨w, hw⟩ → C.Adj ⟨u, hu⟩ ⟨z, hz⟩ → False + from by + intro u v w z hu hv hw hz huv huw huz hvw hvz hwz hUv hUw hUz + exact CycleArcProof.noThreeE E hdegE' u v w z hu hv hw hz hvw hvz hwz hUv + hUw hUz)) hXU have edgeClosure : ∀ x, x ∈ X → ∀ y, ({x, y} : Finset GaussianInt) ∈ E → y ∈ X := CycleArcDetails.edgeClosure Kplus Kminus E Fplus Fminus hSupport edgeCovered diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean index b6d96ad1cf..e4e0b9e068 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean @@ -122,10 +122,12 @@ private theorem edge_parent : (by classical exact - ∀ (A : ProtoTile), ∀ (T : ProtoTile), T.cells ⊆ A.cells → FootprintVertices T ⊆ - FootprintVertices A → ∀ e ∈ FootprintEdges T, e ∈ FootprintEdges A ) := by + ∀ (A : ProtoTile), + ∀ (T : ProtoTile), + T.cells ⊆ A.cells → ∀ e ∈ FootprintEdges T, e ∈ FootprintEdges A + ) := by classical - intro A T hTc hTf e he + intro A T hTc e he rcases he with ⟨c, hc, hshape⟩ exact ⟨c, hTc hc, hshape⟩ @@ -451,7 +453,7 @@ theorem P4677T2PrecursorWalk : have edge_parent (T : ProtoTile) (hTc : T.cells ⊆ A.cells) (hTf : FootprintVertices T ⊆ FootprintVertices A) (e : Finset GaussianInt) (he : e ∈ FootprintEdges T) : - e ∈ FootprintEdges A := PrecursorWalkGeometry.edge_parent A T hTc hTf e he + e ∈ FootprintEdges A := PrecursorWalkGeometry.edge_parent A T hTc e he have edge_parentB (T : ProtoTile) (hTc : T.cells ⊆ B.cells) (e : Finset GaussianInt) (he : e ∈ FootprintEdges T) : e ∈ FootprintEdges B := PrecursorWalkGeometry.edge_parentB B T hTc e he diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean b/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean index 19796f2b74..a7267dd6f3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean @@ -288,12 +288,18 @@ private theorem cut_chain : (by classical exact - let Chain := List.IsChain AllowedSubtileIncidence - ∀ {p : List PeriodicSubtileIndex}, ∀ {k : PeriodicSubtileIndex}, Chain p → ∀ (hne : p ≠ - []), AllowedSubtileIncidence (p.getLast hne) (p.head hne) → k ∈ p → Chain (List.drop - (List.idxOf k p + (1 : ℕ)) p ++ List.take (List.idxOf k p) p) ) := by + let Chain := List.IsChain AllowedSubtileIncidence; + ∀ {p : List PeriodicSubtileIndex}, + ∀ {k : PeriodicSubtileIndex}, + Chain p → + ∀ (hne : p ≠ []), + AllowedSubtileIncidence (p.getLast hne) (p.head hne) → + Chain + (List.drop (List.idxOf k p + (1 : ℕ)) p ++ + List.take (List.idxOf k p) p) + ) := by classical - intro Chain p k hp hne hw hk + intro Chain p k hp hne hw let i := p.idxOf k change Chain (p.drop (i + 1) ++ p.take i) have hdchain := hp.drop (i + 1) @@ -346,11 +352,16 @@ private theorem mem_cut : (by classical exact - (Finset PeriodicSubtileIndex) → (∀ {p : List PeriodicSubtileIndex}, ∀ - {k : PeriodicSubtileIndex}, ∀ {u : PeriodicSubtileIndex}, k ∈ p → u ∈ p → u ≠ k → u ∈ - List.drop (List.idxOf k p + (1 : ℕ)) p ++ List.take (List.idxOf k p) p) ) := by + ∀ {p : List PeriodicSubtileIndex}, + ∀ {k : PeriodicSubtileIndex}, + ∀ {u : PeriodicSubtileIndex}, + u ∈ p → + u ≠ k → + u ∈ + List.drop (List.idxOf k p + (1 : ℕ)) p ++ List.take (List.idxOf k p) p + ) := by classical - intro D p k u hk hu huk + intro p k u hu huk let i := p.idxOf k have hidxne : p.idxOf u ≠ i := by intro he @@ -370,11 +381,14 @@ private theorem k_not_mem_cut : (by classical exact - (Finset PeriodicSubtileIndex) → (∀ {p : List PeriodicSubtileIndex}, ∀ - {k : PeriodicSubtileIndex}, p.Nodup → k ∈ p → k ∉ List.drop (List.idxOf k p + (1 : ℕ)) p - ++ List.take (List.idxOf k p) p) ) := by + ∀ {p : List PeriodicSubtileIndex}, + ∀ {k : PeriodicSubtileIndex}, + p.Nodup → + k ∈ p → + k ∉ List.drop (List.idxOf k p + (1 : ℕ)) p ++ List.take (List.idxOf k p) p + ) := by classical - intro D p k hn hk + intro p k hn hk let i := p.idxOf k intro h rcases List.mem_append.mp h with hdrop | htake @@ -598,10 +612,11 @@ private theorem global_reach : (by classical exact - (Finset PeriodicSubtileIndex) → (∀ (x : PeriodicSubtileIndex), ∀ (y : - PeriodicSubtileIndex), Relation.ReflTransGen AllowedSubtileIncidence x y) ) := by + ∀ (x : PeriodicSubtileIndex), + ∀ (y : PeriodicSubtileIndex), Relation.ReflTransGen AllowedSubtileIncidence x y + ) := by classical - intro D x y + intro x y let R := fun s t : PeriodicSubtileIndex => AllowedSubtileIncidence s t let A := fun (z : Int × Int) => (⟨.A, z.1, z.2⟩ : PeriodicSubtileIndex) let g := fun (z : Int × Int) => (z.1, z.2 + z.1) @@ -877,14 +892,19 @@ theorem P4677T2ThreeConnected (hp : Chain p) (hne : p ≠ []) (hw : AllowedSubtileIncidence (p.getLast hne) (p.head hne)) (hk : k ∈ p) : Chain (p.drop (p.idxOf k + 1) ++ p.take (p.idxOf k)) := ThreeConnectivityProof.cut_chain (p - := p) (k := k) hp hne hw hk + := p) (k := k) hp hne hw have mem_cut {p : List PeriodicSubtileIndex} {k u : PeriodicSubtileIndex} (hk : k ∈ p) (hu : u ∈ p) (huk : u ≠ k) : - u ∈ p.drop (p.idxOf k + 1) ++ p.take (p.idxOf k) := ThreeConnectivityProof.mem_cut D (p := - p) (k := k) (u := u) hk hu huk + u ∈ p.drop (p.idxOf k + 1) ++ p.take (p.idxOf k) := (show + ∀ {p : List PeriodicSubtileIndex}, ∀ {k : PeriodicSubtileIndex}, ∀ {u : + PeriodicSubtileIndex}, k ∈ p → u ∈ p → u ≠ k → u ∈ List.drop (List.idxOf k p + + (1 : ℕ)) p ++ List.take (List.idxOf k p) p + from by + intro p k u hk hu huk + exact ThreeConnectivityProof.mem_cut hu huk) hk hu huk have k_not_mem_cut {p : List PeriodicSubtileIndex} {k : PeriodicSubtileIndex} (hn : p.Nodup) (hk : k ∈ p) : - k ∉ p.drop (p.idxOf k + 1) ++ p.take (p.idxOf k) := ThreeConnectivityProof.k_not_mem_cut D + k ∉ p.drop (p.idxOf k + 1) ++ p.take (p.idxOf k) := ThreeConnectivityProof.k_not_mem_cut (p := p) (k := k) hn hk have chain_reach {R : PeriodicSubtileIndex → PeriodicSubtileIndex → Prop} (hsym : ∀ {x y}, R x y → R y x) : @@ -904,7 +924,7 @@ theorem P4677T2ThreeConnected ∃ w, AllowedSubtileIncidence y w ∧ AllowedSubtileIncidence z w ∧ w ≠ y ∧ w ≠ z := ThreeConnectivityProof.common_neighbor (y := y) (z := z) h have global_reach (x y : PeriodicSubtileIndex) : - Relation.ReflTransGen AllowedSubtileIncidence x y := ThreeConnectivityProof.global_reach D x y + Relation.ReflTransGen AllowedSubtileIncidence x y := ThreeConnectivityProof.global_reach x y have reach_avoiding_from_local (x : PeriodicSubtileIndex) (hx : x ∉ D) : ∀ {y}, Relation.ReflTransGen AllowedSubtileIncidence x y → y ∉ D → diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean index 1def4471b0..fd9ffcacd4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean @@ -309,43 +309,55 @@ private theorem region_image : (by classical exact - let faceDet (f : PeriodicSubtileFaceIndex) : ℝ := - let p0 := P4715T1Position (SixSubtileFaceVertices f 0) - let p1 := P4715T1Position (SixSubtileFaceVertices f 1) - let p2 := P4715T1Position (SixSubtileFaceVertices f 2) - p1.1 * p2.2 - p1.1 * p0.2 - p0.1 * p2.2 - p1.2 * p2.1 + - p1.2 * p0.1 + p0.2 * p2.1 - ∀ (delta_nonzero : ∀ (f : PeriodicSubtileFaceIndex), (P4715T1Position - (SixSubtileFaceVertices f 1) - P4715T1Position (SixSubtileFaceVertices f 0)).1 * - (P4715T1Position (SixSubtileFaceVertices f 2) - P4715T1Position - (SixSubtileFaceVertices f 0)).2 - (P4715T1Position (SixSubtileFaceVertices f 1) - - P4715T1Position (SixSubtileFaceVertices f 0)).2 * (P4715T1Position - (SixSubtileFaceVertices f 2) - P4715T1Position (SixSubtileFaceVertices f 0)).1 ≠ 0), - let lin (v w x : ℝ × ℝ) : ℝ × ℝ := - (x.1 * v.1 + x.2 * w.1, x.1 * v.2 + x.2 * w.2) - let invlin (v w x : ℝ × ℝ) : ℝ × ℝ := - let d := v.1 * w.2 - v.2 * w.1 - ((x.1 * w.2 - x.2 * w.1) / d, (v.1 * x.2 - v.2 * x.1) / d) - ∀ (inv_right : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → - (lin v w (invlin v w x) = x)), ∀ (inv_left : ∀ (v : ℝ × ℝ), ∀ (w : ℝ × ℝ), ∀ (x : ℝ × - ℝ), (v.1 * w.2 - v.2 * w.1 ≠ 0) → (invlin v w (lin v w x) = x)), - let affineHomeo (q v w : ℝ × ℝ) (hd : v.1 * w.2 - v.2 * w.1 ≠ 0) : - Homeomorph (ℝ × ℝ) (ℝ × ℝ) := { - toFun := fun x => q + lin v w x - invFun := fun y => invlin v w (y - q) - left_inv := fun x => by simp [inv_left, hd] - right_inv := fun y => by simp [inv_right, hd] - continuous_toFun := by dsimp [lin]; fun_prop - continuous_invFun := by dsimp [invlin]; fun_prop - } - let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1} - ∀ (f : PeriodicSubtileFaceIndex), (faceDet f ≠ 0) → (P4715T1Region f = affineHomeo - (P4715T1Position (SixSubtileFaceVertices f 0)) (P4715T1Position - (SixSubtileFaceVertices f 1) - P4715T1Position (SixSubtileFaceVertices f 0)) - (P4715T1Position (SixSubtileFaceVertices f 2) - P4715T1Position - (SixSubtileFaceVertices f 0)) (delta_nonzero f) '' D) ) := by + ∀ + (delta_nonzero : + ∀ (f : PeriodicSubtileFaceIndex), + (P4715T1Position (SixSubtileFaceVertices f 1) - + P4715T1Position (SixSubtileFaceVertices f 0)).1 * + (P4715T1Position (SixSubtileFaceVertices f 2) - + P4715T1Position (SixSubtileFaceVertices f 0)).2 - + (P4715T1Position (SixSubtileFaceVertices f 1) - + P4715T1Position (SixSubtileFaceVertices f 0)).2 * + (P4715T1Position (SixSubtileFaceVertices f 2) - + P4715T1Position (SixSubtileFaceVertices f 0)).1 ≠ + 0), + let lin (v w x : ℝ × ℝ) : ℝ × ℝ := + (x.1 * v.1 + x.2 * w.1, x.1 * v.2 + x.2 * w.2); + let invlin (v w x : ℝ × ℝ) : ℝ × ℝ := + let d := v.1 * w.2 - v.2 * w.1 + ((x.1 * w.2 - x.2 * w.1) / d, (v.1 * x.2 - v.2 * x.1) / d); + ∀ + (inv_right : + ∀ (v : ℝ × ℝ), + ∀ (w : ℝ × ℝ), + ∀ (x : ℝ × ℝ), v.1 * w.2 - v.2 * w.1 ≠ 0 → lin v w (invlin v w x) = x), + ∀ + (inv_left : + ∀ (v : ℝ × ℝ), + ∀ (w : ℝ × ℝ), + ∀ (x : ℝ × ℝ), + v.1 * w.2 - v.2 * w.1 ≠ 0 → invlin v w (lin v w x) = x), + let affineHomeo (q v w : ℝ × ℝ) (hd : v.1 * w.2 - v.2 * w.1 ≠ 0) : + Homeomorph (ℝ × ℝ) (ℝ × ℝ) := + { toFun := fun x => q + lin v w x + invFun := fun y => invlin v w (y - q) + left_inv := fun x => by simp [inv_left, hd] + right_inv := fun y => by simp [inv_right, hd] + continuous_toFun := by dsimp [lin]; fun_prop + continuous_invFun := by dsimp [invlin]; fun_prop }; + let D : Set (ℝ × ℝ) := {x | 0 < x.1 ∧ 0 < x.2 ∧ x.1 + x.2 < 1}; + ∀ (f : PeriodicSubtileFaceIndex), + P4715T1Region f = + affineHomeo (P4715T1Position (SixSubtileFaceVertices f 0)) + (P4715T1Position (SixSubtileFaceVertices f 1) - + P4715T1Position (SixSubtileFaceVertices f 0)) + (P4715T1Position (SixSubtileFaceVertices f 2) - + P4715T1Position (SixSubtileFaceVertices f 0)) + (delta_nonzero f) '' + D + ) := by classical - intro faceDet delta_nonzero lin invlin inv_right inv_left affineHomeo D f hd + intro delta_nonzero lin invlin inv_right inv_left affineHomeo D f ext z constructor · rintro ⟨s,t,hs,ht,hst,rfl⟩ @@ -1375,7 +1387,7 @@ theorem P4715T1CoefficientFaces : have hull_affine (q v w : ℝ×ℝ) := CoefficientFaceTopology.hull_affine W_eq_stdHull q v w have region_image (f : PeriodicSubtileFaceIndex) (hd : faceDet f ≠ 0) := CoefficientFaceProof.region_image delta_nonzero inv_right - inv_left f hd + inv_left f have W_decomp := CoefficientFaceProof.W_decomp Dopen D_subset_W D_closure have triangle_image (f : PeriodicSubtileFaceIndex) := CoefficientFaceProof.triangle_image delta_nonzero inv_right diff --git a/LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean b/LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean index 2df8f6423c..e0c4908c63 100644 --- a/LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean +++ b/LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean @@ -635,17 +635,17 @@ private theorem hcAt488 : hp.1 hp'.1 hrepr private theorem hm' : - (DiamondParameter) → ((GaussianInt) → (∀ (p : GaussianInt × ℤ × ℤ), ∀ (p' : GaussianInt × ℤ × - ℤ), (p.2.1 - p'.2.1 = (0 : ℤ)) → (p.2.1 = p'.2.1))) := by + ∀ (p : GaussianInt × ℤ × ℤ), + ∀ (p' : GaussianInt × ℤ × ℤ), p.2.1 - p'.2.1 = (0 : ℤ) → p.2.1 = p'.2.1 := by classical - intro K x p p' hm + intro p p' hm omega private theorem hn' : - (DiamondParameter) → ((GaussianInt) → (∀ (p : GaussianInt × ℤ × ℤ), ∀ (p' : GaussianInt × ℤ × - ℤ), (p.2.2 - p'.2.2 = (0 : ℤ)) → (p.2.2 = p'.2.2))) := by + ∀ (p : GaussianInt × ℤ × ℤ), + ∀ (p' : GaussianInt × ℤ × ℤ), p.2.2 - p'.2.2 = (0 : ℤ) → p.2.2 = p'.2.2 := by classical - intro K x p p' hn + intro p p' hn omega private theorem hpoint : @@ -738,8 +738,8 @@ theorem P4818T1Representatives (K : DiamondParameter) : RepresentativesProof.hrepr K p p' hrel have hc := RepresentativesProof.hcAt488 K hinj x p hp p' hp' hrepr rcases hc with ⟨hm, hn⟩ - have hm' : p.2.1 = p'.2.1 := RepresentativesProof.hm' K x p p' hm - have hn' : p.2.2 = p'.2.2 := RepresentativesProof.hn' K x p p' hn + have hm' : p.2.1 = p'.2.1 := RepresentativesProof.hm' p p' hm + have hn' : p.2.2 = p'.2.2 := RepresentativesProof.hn' p p' hn have hpoint : p.1 = p'.1 := RepresentativesProof.hpoint K p p' hrel hm' hn' apply Prod.ext · exact hpoint.symm diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean b/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean index 3f1eda0620..b542720d6d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean +++ b/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean @@ -393,10 +393,10 @@ private theorem hne4 : (by classical exact - (Fin (4 : ℕ) → CircleCoordinates) → (∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : ℕ)), (a ≠ i) → - (a.succ ≠ i.succ)) ) := by + ∀ (i : Fin (3 : ℕ)), ∀ (a : Fin (3 : ℕ)), a ≠ i → a.succ ≠ i.succ + ) := by classical - intro q i a hne h + intro i a hne h have hv := congrArg Fin.val h simp only [Fin.val_succ] at hv have heq : a.val = i.val := by omega @@ -547,16 +547,17 @@ private theorem hX : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (Fin (3 : ℕ)) → ( - let p (a : Fin - 4) : ℂ := (q a).2 / ((q a).1 : ℝ) - let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) - (dist (p 0) (p i.succ) = rad 0 + rad i.succ) → ( - let A : ℂ := p i.succ - let X : ℂ := p 0 - Complex.normSq (X - A) = (rad i.succ + rad 0) ^ 2)) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), + let p (a : Fin 4) : ℂ := (q a).2 / ((q a).1 : ℝ) + let rad (a : Fin 4) : ℝ := 1 / ((q a).1 : ℝ) + dist (p 0) (p i.succ) = rad 0 + rad i.succ → + let A : ℂ := p i.succ + let X : ℂ := p 0 + Complex.normSq (X - A) = (rad i.succ + rad 0) ^ 2 + ) := by classical - intro q i a p rad hchild_parent A X + intro q i p rad hchild_parent A X rw [Complex.normSq_eq_norm_sq, ← dist_eq_norm] have hh := congrArg (fun x : ℝ => x ^ 2) hchild_parent simpa [X, A, add_comm] using hh @@ -1144,7 +1145,7 @@ theorem P5023T1CircularSide : V A X e t dot hparent hchild hr hden hparne hchild_parent rcases ha with hapos | hazero · have haposZ : 0 < (q a.succ).1 := hapos - have hne4 : a.succ ≠ i.succ := CircularSideProof.hne4 q i a hne + have hne4 : a.succ ≠ i.succ := CircularSideProof.hne4 i a hne have hcenter : dist (p a.succ) (p i.succ) = rad a.succ + rad i.succ := by exact centerDistance a.succ i.succ hne4 haposZ hparent have hchild : dist (p a.succ) (p 0) = rad a.succ + rad 0 := by @@ -1168,7 +1169,7 @@ theorem P5023T1CircularSide : CircularSideProof.hunitSqAt360 L q i a hunitNorm have hA : Complex.normSq (p a.succ - A) = (rad i.succ + rad a.succ) ^ 2 := by rw [Complex.normSq_eq_norm_sq, hdistParent] - have hX : Complex.normSq (X - A) = (rad i.succ + rad 0) ^ 2 := CircularSideProof.hX q i a + have hX : Complex.normSq (X - A) = (rad i.succ + rad 0) ^ 2 := CircularSideProof.hX q i hchild_parent have hBX : Complex.normSq (p a.succ - X) = (rad a.succ + rad 0) ^ 2 := CircularSideProof.hBX q a hchild diff --git a/LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean b/LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean index d10436d23f..f0829461db 100644 --- a/LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/P5050T1OmittedHullSeparation.lean @@ -32,10 +32,13 @@ namespace ApollonianSuperharmonic namespace OmittedHullLemmas private theorem projectionAffine : - ∀ (a : Complex), ∀ (x : Complex), ∀ (d : Real), (d ≠ 0) → ∃ D : Complex →ᵃ[Real] Real, - ∀ z, D z = ((x - a) * (starRingEnd Complex) (z - a)).re / d := by + ∀ (a : Complex), + ∀ (x : Complex), + ∀ (d : Real), + ∃ D : Complex →ᵃ[Real] Real, + ∀ z, D z = ((x - a) * (starRingEnd Complex) (z - a)).re / d := by classical - intro a x d hd + intro a x d let L : Complex →ₗ[Real] Real := { toFun := fun z => ((x - a) * (starRingEnd Complex) z).re / d map_add' := by @@ -60,11 +63,16 @@ private theorem projectionAffine : rfl private theorem projectionSphereBound : - ∀ (a : Complex), ∀ (x : Complex), ∀ (z : Complex), ∀ (ρ : Real), ∀ (R : Real), (0 < ρ) → (0 < - ρ + R) → (dist a x = ρ + R) → (dist z a = ρ) → ((x - a) * (starRingEnd Complex) (z - - a)).re / (ρ + R) ≤ ρ := by + ∀ (a : Complex), + ∀ (x : Complex), + ∀ (z : Complex), + ∀ (ρ : Real), + ∀ (R : Real), + 0 < ρ + R → + dist a x = ρ + R → + dist z a = ρ → ((x - a) * (starRingEnd Complex) (z - a)).re / (ρ + R) ≤ ρ := by classical - intro a x z ρ R hρ hden hax hz + intro a x z ρ R hden hax hz have hnormx : ‖x - a‖ = ρ + R := by simpa [dist_eq_norm, norm_sub_rev] using hax have hnormz : ‖z - a‖ = ρ := by @@ -489,12 +497,12 @@ theorem P5050T1OmittedHullSeparation (L : ℝ) have projectionAffine (a x : Complex) (d : Real) (hd : d ≠ 0) : ∃ D : Complex →ᵃ[Real] Real, ∀ z, D z = ((x - a) * (starRingEnd Complex) (z - a)).re / d := - OmittedHullLemmas.projectionAffine a x d hd + OmittedHullLemmas.projectionAffine a x d have projectionSphereBound (a x z : Complex) (ρ R : Real) (hρ : 0 < ρ) (hden : 0 < ρ + R) (hax : dist a x = ρ + R) (hz : dist z a = ρ) : ((x - a) * (starRingEnd Complex) (z - a)).re / (ρ + R) ≤ ρ := - OmittedHullLemmas.projectionSphereBound a x z ρ R hρ hden hax hz + OmittedHullLemmas.projectionSphereBound a x z ρ R hden hax hz have externalProjection (a x z : Complex) (ρ R s : Real) (hpos : 0 < ρ + R) (hax : dist a x = ρ + R) (haz : dist a z = ρ + s) diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean b/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean index 218c16e3e1..13ca866259 100644 --- a/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean +++ b/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean @@ -55,31 +55,31 @@ private theorem hp2 : exact hp₂ private theorem hq1pos' : - ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (FordFareyParameter) → (P₁.q = P.q₁) - → (0 < P.q₁) → 0 < P₁.q := by + ∀ (P : FordFareyParameter), + ∀ (P₁ : FordFareyParameter), P₁.q = P.q₁ → 0 < P.q₁ → 0 < P₁.q := by classical - intro P P₁ P₂ hq₁ hq1pos + intro P P₁ hq₁ hq1pos omega private theorem hq2pos' : - ∀ (P : FordFareyParameter), (FordFareyParameter) → ∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) - → (0 < P.q₂) → 0 < P₂.q := by + ∀ (P : FordFareyParameter), + ∀ (P₂ : FordFareyParameter), P₂.q = P.q₂ → 0 < P.q₂ → 0 < P₂.q := by classical - intro P P₁ P₂ hq₂ hq2pos + intro P P₂ hq₂ hq2pos omega private theorem hq1lt' : - ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), (FordFareyParameter) → (P₁.q = P.q₁) - → (P.q₁ < P.q) → P₁.q < P.q := by + ∀ (P : FordFareyParameter), + ∀ (P₁ : FordFareyParameter), P₁.q = P.q₁ → P.q₁ < P.q → P₁.q < P.q := by classical - intro P P₁ P₂ hq₁ hq1lt + intro P P₁ hq₁ hq1lt omega private theorem hq2lt' : - ∀ (P : FordFareyParameter), (FordFareyParameter) → ∀ (P₂ : FordFareyParameter), (P₂.q = P.q₂) - → (P.q₂ < P.q) → P₂.q < P.q := by + ∀ (P : FordFareyParameter), + ∀ (P₂ : FordFareyParameter), P₂.q = P.q₂ → P.q₂ < P.q → P₂.q < P.q := by classical - intro P P₁ P₂ hq₂ hq2lt + intro P P₂ hq₂ hq2lt omega end SameParentOverlapLemmas @@ -280,10 +280,10 @@ theorem P5130T5SameParentOverlaps (P P₁ P₂ : FordFareyParameter) have hq2 : P₂.q = P.q₂ := SameParentOverlapLemmas.hq2 P P₂ hq₂ have hp1 : P₁.p = P.p₁ := SameParentOverlapLemmas.hp1 P P₁ hp₁ have hp2 : P₂.p = P.p₂ := SameParentOverlapLemmas.hp2 P P₂ hp₂ - have hq1pos' : 0 < P₁.q := SameParentOverlapLemmas.hq1pos' P P₁ P₂ hq₁ hq1pos - have hq2pos' : 0 < P₂.q := SameParentOverlapLemmas.hq2pos' P P₁ P₂ hq₂ hq2pos - have hq1lt' : P₁.q < P.q := SameParentOverlapLemmas.hq1lt' P P₁ P₂ hq₁ hq1lt - have hq2lt' : P₂.q < P.q := SameParentOverlapLemmas.hq2lt' P P₁ P₂ hq₂ hq2lt + have hq1pos' : 0 < P₁.q := SameParentOverlapLemmas.hq1pos' P P₁ hq₁ hq1pos + have hq2pos' : 0 < P₂.q := SameParentOverlapLemmas.hq2pos' P P₂ hq₂ hq2pos + have hq1lt' : P₁.q < P.q := SameParentOverlapLemmas.hq1lt' P P₁ hq₁ hq1lt + have hq2lt' : P₂.q < P.q := SameParentOverlapLemmas.hq2lt' P P₂ hq₂ hq2lt have first_parent_overlap : ∀ x, x ∈ FordRecursiveVertexDomains P 0 → x ∈ FordRecursiveVertexDomains P 1 → P5130T5Prescription P (G P₁) (G P₂) 0 x = diff --git a/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean b/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean index e9ec79f464..d360362433 100644 --- a/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean @@ -113,14 +113,24 @@ private theorem staircaseBetween : (by classical exact - (Nat) → (∀ (z : GaussianInt), ∀ (horizontalFirst : Bool), ∀ (s : Int), (s = 1 ∨ s = -1) → - (∀ (N : Nat), (0 < N) → (SimpleGridPathBetween {v | ∃ j ≤ N, v = - P5157T1StaircasePoint z horizontalFirst s j} {e | ∃ j < N, e = - {P5157T1StaircasePoint z horizontalFirst s j, - P5157T1StaircasePoint z horizontalFirst s (j + 1)}} (P5157T1StaircasePoint z - horizontalFirst s 0) (P5157T1StaircasePoint z horizontalFirst s N)))) ) := by - classical - intro k z horizontalFirst s hs N hN + ∀ (z : GaussianInt), + ∀ (horizontalFirst : Bool), + ∀ (s : Int), + s = 1 ∨ s = -1 → + ∀ (N : Nat), + 0 < N → + SimpleGridPathBetween + {v | ∃ j ≤ N, v = P5157T1StaircasePoint z horizontalFirst s j} + {e | + ∃ j < N, + e = + {P5157T1StaircasePoint z horizontalFirst s j, + P5157T1StaircasePoint z horizontalFirst s (j + 1)}} + (P5157T1StaircasePoint z horizontalFirst s 0) + (P5157T1StaircasePoint z horizontalFirst s N) + ) := by + classical + intro z horizontalFirst s hs N hN let p := P5157T1StaircasePoint z horizontalFirst s let l := List.ofFn (fun j : Fin (N + 1) => p j) have inj : Function.Injective p := @@ -190,14 +200,20 @@ private theorem capBetween : (by classical exact - (Nat) → (∀ (m : Nat), (0 < m) → (∀ (u : GaussianInt), SimpleGridPathBetween - (BoundaryFootprintVertices (TileTranslation (DiamondTile m) u) ∩ - BoundaryFootprintVertices (TileTranslation (DiamondTile m) (u + ⟨0, 2 * (m : Int)⟩))) - (BoundaryFootprintEdges (TileTranslation (DiamondTile m) u) ∩ BoundaryFootprintEdges - (TileTranslation (DiamondTile m) (u + ⟨0, 2 * (m : Int)⟩))) (u + ⟨-1, 2 * (m : Int)⟩) - (u + ⟨1, 2 * (m : Int)⟩))) ) := by + ∀ (m : Nat), + 0 < m → + ∀ (u : GaussianInt), + SimpleGridPathBetween + (BoundaryFootprintVertices (TileTranslation (DiamondTile m) u) ∩ + BoundaryFootprintVertices + (TileTranslation (DiamondTile m) (u + ⟨0, 2 * (m : Int)⟩))) + (BoundaryFootprintEdges (TileTranslation (DiamondTile m) u) ∩ + BoundaryFootprintEdges + (TileTranslation (DiamondTile m) (u + ⟨0, 2 * (m : Int)⟩))) + (u + ⟨-1, 2 * (m : Int)⟩) (u + ⟨1, 2 * (m : Int)⟩) + ) := by classical - intro k m hm u + intro m hm u have hcap := P5203T1CapInterface m hm u dsimp only at hcap obtain ⟨hneT, hneU, hdisj, hV, hE, _⟩ := hcap @@ -352,12 +368,18 @@ private theorem twoVertexPath : (by classical exact - (Nat) → (∀ (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (x : GaussianInt), - ∀ (y : GaussianInt), (x ≠ y) → ((V = {x, y}) → ((E = {{x, y}}) → ((y = x + 1 ∨ y = x - - 1 ∨ y = x + ⟨0, 1⟩ ∨ - y = x - ⟨0, 1⟩) → (SimpleGridPathBetween V E x y))))) ) := by + ∀ (V : Set GaussianInt), + ∀ (E : Set (Finset GaussianInt)), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + x ≠ y → + V = { x, y } → + E = {{ x, y }} → + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + SimpleGridPathBetween V E x y + ) := by classical - intro k V E x y hne hV hE hstep + intro V E x y hne hV hE hstep rw [hV, hE] refine ⟨[x, y], ?_⟩ constructor @@ -845,12 +867,13 @@ private theorem F_inj : (by classical exact - (Nat) → (∀ (u : GaussianInt), - let Q : GaussianInt → GaussianInt := GaussianQuarterTurn - let F : GaussianInt → GaussianInt := fun z => Q z + u - Function.Injective F) ) := by + ∀ (u : GaussianInt), + let Q : GaussianInt → GaussianInt := GaussianQuarterTurn + let F : GaussianInt → GaussianInt := fun z => Q z + u + Function.Injective F + ) := by classical - intro k u Q F a b hab + intro u Q F a b hab have hq : Q a = Q b := add_right_cancel hab apply Zsqrtd.ext · have h := congrArg (fun z : GaussianInt => z.im) hq @@ -863,13 +886,15 @@ private theorem F_step : (by classical exact - (Nat) → (∀ (u : GaussianInt), - let Q : GaussianInt → GaussianInt := GaussianQuarterTurn - let F : GaussianInt → GaussianInt := fun z => Q z + u - ∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → (F b = F - a + 1 ∨ F b = F a - 1 ∨ F b = F a + ⟨0, 1⟩ ∨ F b = F a - ⟨0, 1⟩)) ) := by - classical - intro k u Q F a b hab + ∀ (u : GaussianInt), + let Q : GaussianInt → GaussianInt := GaussianQuarterTurn + let F : GaussianInt → GaussianInt := fun z => Q z + u + ∀ a b : GaussianInt, + b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ → + F b = F a + 1 ∨ F b = F a - 1 ∨ F b = F a + ⟨0, 1⟩ ∨ F b = F a - ⟨0, 1⟩ + ) := by + classical + intro u Q F a b hab rcases hab with h | h | h | h · subst b; right; right; left; apply Zsqrtd.ext <;> simp [F, Q, GaussianQuarterTurn]; omega · subst b; right; right; right; apply Zsqrtd.ext <;> simp [F, Q, GaussianQuarterTurn]; @@ -1110,12 +1135,16 @@ private theorem capBoundaryVerticesEq : (by classical exact - (Nat) → (∀ (m : Nat), (0 < m) → (∀ (v : GaussianInt), BoundaryFootprintVertices - (TileTranslation (DiamondTile m) v) ∩ BoundaryFootprintVertices (TileTranslation - (DiamondTile m) (v + ⟨0, 2 * (m : Int)⟩)) = {v + ⟨-1, 2 * (m : Int)⟩, v + ⟨0, - 2 * (m : Int)⟩, v + ⟨1, 2 * (m : Int)⟩})) ) := by + ∀ (m : Nat), + 0 < m → + ∀ (v : GaussianInt), + BoundaryFootprintVertices (TileTranslation (DiamondTile m) v) ∩ + BoundaryFootprintVertices + (TileTranslation (DiamondTile m) (v + ⟨0, 2 * (m : Int)⟩)) = + {v + ⟨-1, 2 * (m : Int)⟩, v + ⟨0, 2 * (m : Int)⟩, v + ⟨1, 2 * (m : Int)⟩} + ) := by classical - intro k m hm v + intro m hm v exact (by have hcap := P5203T1CapInterface m hm v dsimp only at hcap @@ -3051,8 +3080,8 @@ theorem P5260T1PredecessorInterfaces (k : Nat) (hk : 1 < k) (b : Bool) : have rawBoundaryVertices := PredecessorInterfaceGeometry.rawBoundaryVertices have rawBoundaryEdges := CellDisjointCommonEdgesBoundary have rawStaircase := PredecessorInterfaceGeometry.rawStaircase rawBoundaryVertices - rawBoundaryEdges (PredecessorInterfaceGeometry.staircaseBetween k) - have twoVertexPath := PredecessorInterfaceGeometry.twoVertexPath k + rawBoundaryEdges (PredecessorInterfaceGeometry.staircaseBetween) + have twoVertexPath := PredecessorInterfaceGeometry.twoVertexPath have diamondCellsNonempty := PredecessorInterfaceGeometry.diamondCellsNonempty have reversePath {V : Set GaussianInt} {E : Set (Finset GaussianInt)} {x y : GaussianInt} (hp : SimpleGridPathBetween V E x y) := @@ -3084,7 +3113,7 @@ theorem P5260T1PredecessorInterfaces (k : Nat) (hk : 1 < k) (b : Bool) : have hcapLow := P5203T1CapInterface k hkpos shiftLow dsimp only at hcapLow have pathLow := (PredecessorInterfaceGeometry.rawCapBetween rawBoundaryVertices - rawBoundaryEdges (PredecessorInterfaceGeometry.capBetween k)) k hkpos shiftLow hcapLow.2.2.1 + rawBoundaryEdges (PredecessorInterfaceGeometry.capBetween)) k hkpos shiftLow hcapLow.2.2.1 have hlowZero : shiftLow + ⟨0, 2 * (k : Int)⟩ = 0 := by apply Zsqrtd.ext <;> simp [shiftLow] have hlowTile : TileTranslation D @@ -3100,7 +3129,7 @@ theorem P5260T1PredecessorInterfaces (k : Nat) (hk : 1 < k) (b : Bool) : have huEq := PredecessorInterfaceGeometry.huEq k u hu let Q : GaussianInt → GaussianInt := GaussianQuarterTurn let F : GaussianInt → GaussianInt := fun z => Q z + u - have F_inj := PredecessorInterfaceGeometry.F_inj k u + have F_inj := PredecessorInterfaceGeometry.F_inj u have quarterVertices := PredecessorInterfaceGeometry.quarterVertices k u have quarterBaseVertices := PredecessorInterfaceGeometry.quarterBaseVertices k u hquarterVertices @@ -3111,7 +3140,7 @@ theorem P5260T1PredecessorInterfaces (k : Nat) (hk : 1 < k) (b : Bool) : apply Zsqrtd.ext <;> simp [Q, GaussianQuarterTurn, shiftLow, shiftR] have hxlow := PredecessorInterfaceGeometry.hxlow k u huEq have hxhigh := PredecessorInterfaceGeometry.hxhigh k u huEq - have capBoundaryVerticesEq := PredecessorInterfaceGeometry.capBoundaryVerticesEq k + have capBoundaryVerticesEq := PredecessorInterfaceGeometry.capBoundaryVerticesEq let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ have hleft := P5253T1LeftSquareContacts (k - 1) hsmall ⟨(k : Int), 1 - (k : Int)⟩ ((k : Int) - 2) (Or.inl (by omega)) @@ -3175,7 +3204,7 @@ theorem P5260T1PredecessorInterfaces (k : Nat) (hk : 1 < k) (b : Bool) : (PredecessorInterfaceGeometry.hqStart) (PredecessorInterfaceGeometry.hqEnd k hk) (PredecessorInterfaceGeometry.pathWDrev k reversePath pathDW) (PredecessorInterfaceGeometry.pathRAB k u (PredecessorInterfaceGeometry.pathRAB0 k - translateZero pathLow u F_inj (PredecessorInterfaceGeometry.F_step k u) quarterVertices + translateZero pathLow u F_inj (PredecessorInterfaceGeometry.F_step u) quarterVertices (PredecessorInterfaceGeometry.quarterEdges k u) quarterBaseVertices (PredecessorInterfaceGeometry.quarterBaseEdges k u hquarterCells) quarterVerticesAt (PredecessorInterfaceGeometry.quarterEdgesAt k u quarterCellsAt) shiftQuarter) hxlow diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean b/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean index fd35046142..b1f1fae123 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean @@ -35,13 +35,18 @@ private theorem staircaseBetween : (by classical exact - (Nat) → (∀ (z : GaussianInt), ∀ (h : Bool), ∀ (s : Int), (s = 1 ∨ s = -1) → (∀ (N : Nat), - (0 < N) → ( - let p := P5157T1StaircasePoint z h s; - SimpleGridPathBetween {v | ∃ j ≤ N, v = p j} - {e | ∃ j < N, e = {p j, p (j + 1)}} (p 0) (p N)))) ) := by - classical - intro k z h s hs N hN + ∀ (z : GaussianInt), + ∀ (h : Bool), + ∀ (s : Int), + s = 1 ∨ s = -1 → + ∀ (N : Nat), + 0 < N → + let p := P5157T1StaircasePoint z h s; + SimpleGridPathBetween {v | ∃ j ≤ N, v = p j} + {e | ∃ j < N, e = {p j, p (j + 1)}} (p 0) (p N) + ) := by + classical + intro z h s hs N hN dsimp only let p := P5157T1StaircasePoint z h s; have inj := (P5157T1AlternatingStaircase z h s hs N hN).1 @@ -103,12 +108,15 @@ private theorem qstep : (by classical exact - (Nat) → (∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → - GaussianQuarterTurn b = GaussianQuarterTurn a + 1 ∨ GaussianQuarterTurn b = - GaussianQuarterTurn a - 1 ∨ GaussianQuarterTurn b = GaussianQuarterTurn a + ⟨0, 1⟩ ∨ - GaussianQuarterTurn b = GaussianQuarterTurn a - ⟨0, 1⟩) ) := by + ∀ a b : GaussianInt, + b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ → + GaussianQuarterTurn b = GaussianQuarterTurn a + 1 ∨ + GaussianQuarterTurn b = GaussianQuarterTurn a - 1 ∨ + GaussianQuarterTurn b = GaussianQuarterTurn a + ⟨0, 1⟩ ∨ + GaussianQuarterTurn b = GaussianQuarterTurn a - ⟨0, 1⟩ + ) := by classical - intro k a b hh + intro a b hh rcases hh with h | h | h | h · subst b; right; right; left; apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] @@ -123,9 +131,10 @@ private theorem qinj : (by classical exact - (Nat) → (Function.Injective GaussianQuarterTurn) ) := by + Function.Injective GaussianQuarterTurn + ) := by classical - intro k a b hab + intro a b hab apply Zsqrtd.ext · have h := congrArg (fun z : GaussianInt => z.im) hab simpa [GaussianQuarterTurn] using h @@ -602,14 +611,15 @@ private theorem F_step : (by classical exact - (Nat) → ( let Q := GaussianQuarterTurn ∀ (c : GaussianInt), - let F : GaussianInt → GaussianInt := fun z => Q z + c - ∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → F b = F - a + 1 ∨ F b = F a - 1 ∨ F b = F a + ⟨0, 1⟩ ∨ F b = F a - ⟨0, 1⟩) ) := by + let F : GaussianInt → GaussianInt := fun z => Q z + c + ∀ a b : GaussianInt, + b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ → + F b = F a + 1 ∨ F b = F a - 1 ∨ F b = F a + ⟨0, 1⟩ ∨ F b = F a - ⟨0, 1⟩ + ) := by classical - intro k Q c F a b hh + intro Q c F a b hh rcases hh with h | h | h | h · subst b; right; right; left; apply Zsqrtd.ext <;> simp [F, Q, GaussianQuarterTurn]; omega @@ -2016,7 +2026,7 @@ private theorem rowFirst0 : exact ⟨hDne, (DiamondPathComparison.firstCells₁ k c cellMapRight dneDright), (DiamondPathComparison.firstCellsDisj k c (DiamondPathComparison.F_cell_inj qinj c) cellMapZero cellMapRight ddisjD disjointImage), (DiamondPathComparison.firstTurn k - imagePath decBetween dzeroD c hcEq F_inj (DiamondPathComparison.F_step k c) + imagePath decBetween dzeroD c hcEq F_inj (DiamondPathComparison.F_step c) quarterVerticesAt quarterEdgesAt dShift)⟩ private theorem rowFirst1 : @@ -2316,7 +2326,7 @@ theorem P5290T1EqualDiamondPaths (k : Nat) (hk : 0 < k) -- BODY classical have staircaseBetween (z : GaussianInt) (h : Bool) (s : Int) - (hs : s = 1 ∨ s = -1) (N : Nat) (hN : 0 < N) := DiamondPathComparison.staircaseBetween k z + (hs : s = 1 ∨ s = -1) (N : Nat) (hN : 0 < N) := DiamondPathComparison.staircaseBetween z h s hs N hN have imagePath {V : Set GaussianInt} {E : Set (Finset GaussianInt)} {x y : GaussianInt} (f : GaussianInt → GaussianInt) @@ -2333,8 +2343,8 @@ theorem P5290T1EqualDiamondPaths (k : Nat) (hk : 0 < k) have hN : 0 < N := by dsimp [N]; omega have qbase := staircaseBetween ⟨(k : Int), -(k : Int)⟩ true 1 (Or.inl rfl) N hN - have qinj := DiamondPathComparison.qinj k - have qImagePath := imagePath GaussianQuarterTurn qinj (DiamondPathComparison.qstep k) qbase + have qinj := DiamondPathComparison.qinj + have qImagePath := imagePath GaussianQuarterTurn qinj (DiamondPathComparison.qstep) qbase have qenum (j : Nat) := DiamondPathComparison.qenum k j let dV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1} diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean b/LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean index 2cf901ebe8..19a79bbd6d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean @@ -299,10 +299,12 @@ end PredecessorPathProof namespace PredecessorPathDetails private theorem domain_sym : - (Nat) → (∀ (m : ℕ), ∀ (z : GaussianInt), z ∈ DiamondCellDomain m ↔ { re := z.re, im := (2 : - ℤ) * (↑m : ℤ) - (1 : ℤ) - z.im } ∈ DiamondCellDomain m) := by + ∀ (m : ℕ), + ∀ (z : GaussianInt), + z ∈ DiamondCellDomain m ↔ + { re := z.re, im := (2 : ℤ) * (↑m : ℤ) - (1 : ℤ) - z.im } ∈ DiamondCellDomain m := by classical - intro k m z + intro m z rw [(P4194T1DiamondCellRows m z).1, (P4194T1DiamondCellRows m ⟨z.re, 2 * (m : Int) - 1 - z.im⟩).1] simp only @@ -641,12 +643,11 @@ private theorem qinj : exact hJinj hab private theorem pstep : - (Nat) → ( let p : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 - ∀ (j : ℕ), p (j + (1 : ℕ)) = p j + (1 : GaussianInt) ∨ p (j + (1 : ℕ)) = p j + ⟨(0 : - ℤ), (1 : ℤ)⟩) := by + ∀ (j : ℕ), + p (j + (1 : ℕ)) = p j + (1 : GaussianInt) ∨ p (j + (1 : ℕ)) = p j + ⟨(0 : ℤ), (1 : ℤ)⟩ := by classical - intro k p j + intro p j simp [p, P5157T1StaircasePoint, Zsqrtd.ext_iff]; omega private theorem qstep : @@ -767,7 +768,7 @@ theorem P5290T1PredecessorPath (k : Nat) (hk : 1 < k) : have domain_sym (m : Nat) (z : GaussianInt) : z ∈ DiamondCellDomain m ↔ ⟨z.re, 2 * (m : Int) - 1 - z.im⟩ ∈ DiamondCellDomain m := - PredecessorPathDetails.domain_sym k m z + PredecessorPathDetails.domain_sym m z have dom_sym (z : GaussianInt) : z ∈ DiamondCellDomain (k - 1) ↔ Jc z ∈ DiamondCellDomain (k - 1) := PredecessorPathDetails.dom_sym k hk domain_sym z @@ -848,7 +849,7 @@ theorem P5290T1PredecessorPath (k : Nat) (hk : 1 < k) : let q : Nat → GaussianInt := fun j => J (p j) have qinj : Function.Injective q := PredecessorPathDetails.qinj k hJinj pinj have pstep (j : Nat) : p (j + 1) = p j + 1 ∨ - p (j + 1) = p j + ⟨0, 1⟩ := PredecessorPathDetails.pstep k j + p (j + 1) = p j + ⟨0, 1⟩ := PredecessorPathDetails.pstep j have Jright (z : GaussianInt) : J (z + 1) = J z + 1 := by apply Zsqrtd.ext <;> simp [J] have Jup (z : GaussianInt) : J (z + ⟨0, 1⟩) = J z - ⟨0, 1⟩ := by diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean b/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean index 679fe03a71..893369cd5c 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean @@ -34,16 +34,27 @@ namespace ApollonianSuperharmonic namespace UnitContactProof private theorem makePath : - (Nat) → (∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), - Finset.Nonempty T.cells → Finset.Nonempty U.cells → Disjoint T.cells U.cells → - BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = {a, b} → {a, b} ∈ - BoundaryFootprintEdges T → {a, b} ∈ BoundaryFootprintEdges U → b = a + (1 : GaussianInt) - ∨ b = a - (1 : GaussianInt) ∨ b = a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ b = a - ⟨(0 : ℤ), (1 : ℤ)⟩ → - Finset.Nonempty T.cells ∧ Finset.Nonempty U.cells ∧ Disjoint T.cells U.cells ∧ - SimpleGridPathBetween (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) - (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) a b) := by + ∀ (T : ProtoTile), + ∀ (U : ProtoTile), + ∀ (a : GaussianInt), + ∀ (b : GaussianInt), + Finset.Nonempty T.cells → + Finset.Nonempty U.cells → + Disjoint T.cells U.cells → + BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = { a, b } → + { a, b } ∈ BoundaryFootprintEdges T → + { a, b } ∈ BoundaryFootprintEdges U → + b = a + (1 : GaussianInt) ∨ + b = a - (1 : GaussianInt) ∨ + b = a + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ b = a - ⟨(0 : ℤ), (1 : ℤ)⟩ → + Finset.Nonempty T.cells ∧ + Finset.Nonempty U.cells ∧ + Disjoint T.cells U.cells ∧ + SimpleGridPathBetween + (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) + (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) a b := by classical - intro k T U a b hT hU hd hv heT heU ha + intro T U a b hT hU hd hv heT heU ha have interface := P5253T1OneEdgeInterface T U a b hT hU hd hv heT heU ha have hab : a ≠ b := by rcases ha with h | h | h | h <;> @@ -244,7 +255,7 @@ private def unitContactConclusion (k : Nat) (i : Fin 3) : Prop := private theorem zeroUnitContacts (k : Nat) (hk : 0 < k) (hk1 : 1 < k) : unitContactConclusion k 0 := by classical - have makePath := UnitContactProof.makePath k + have makePath := UnitContactProof.makePath have rightContact := UnitContactProof.rightContact k hk have singletonPath := UnitContactProof.singletonPath makePath let M := P5260T1PlacementLedger k 0 false @@ -381,7 +392,7 @@ private theorem tileTranslationZero (T : ProtoTile) : TileTranslation T 0 = T := private theorem oneUnitContacts (k : Nat) (hk : 0 < k) : unitContactConclusion k 1 := by classical - have makePath := UnitContactProof.makePath k + have makePath := UnitContactProof.makePath have rightContact := UnitContactProof.rightContact k hk have singletonPath := UnitContactProof.singletonPath makePath let M := P5260T1PlacementLedger k 1 false diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean index 28692ade25..a0b5424406 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean @@ -26,10 +26,9 @@ namespace ApollonianSuperharmonic namespace Parent2Rotation0Proof private theorem rpos : - ∀ (P : FordFareyParameter), (FordFareyParameter) → (((1 : ℕ) < P.q) → ((1 < (P.q : Int)) → (0 - < (P.q₁ : Int)))) := by + ∀ (P : FordFareyParameter), (1 : ℕ) < P.q → 1 < (P.q : Int) → 0 < (P.q₁ : Int) := by classical - intro P A hq hq' + intro P hq hq' by_contra hn have hz : (P.q₁ : Int) = 0 := by omega have : P.p₁ * (P.q : Int) = 1 := by rw [← P.det₁]; simp [hz] @@ -183,14 +182,17 @@ private theorem values : simp [P5332T1ParentRows] private theorem companion : - ∀ (P : FordFareyParameter), (FordFareyParameter) → (((P.q : Int) = (P.q₁ : Int) + (P.q₂ : - Int)) → (∀ (Y : ℤ), ((0 : ℤ) ≤ (0 : ℤ) ∧ (0 : ℤ) ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ Y ∧ Y ≤ (↑P.q : - ℤ)) → ((1 ≤ Y) → ( - let t : Int := (P.q₂ : Int) - Y - (⟨0,Y⟩ : GaussianInt) - (P5332T1ParentRows P 1 0 0).companion ∈ FordVertexDomain P.q ↔ t = - 0 ∧ Even (0+1 : Nat))))) := by + ∀ (P : FordFareyParameter), + (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) → + ∀ (Y : ℤ), + (0 : ℤ) ≤ (0 : ℤ) ∧ (0 : ℤ) ≤ (↑P.q : ℤ) ∧ (0 : ℤ) ≤ Y ∧ Y ≤ (↑P.q : ℤ) → + 1 ≤ Y → + let t : Int := (P.q₂ : Int) - Y + (⟨0, Y⟩ : GaussianInt) - (P5332T1ParentRows P 1 0 0).companion ∈ + FordVertexDomain P.q ↔ + t = 0 ∧ Even (0 + 1 : Nat) := by classical - intro P A qsum Y hx0 hlow t + intro P qsum Y hx0 hlow t have hn : ¬ Even (0+1 : Nat) := by norm_num have hcomp : (P5332T1ParentRows P 1 0 0).companion = ⟨-(P.q₂ : Int),-(P.q : Int)⟩ := by rfl @@ -232,7 +234,7 @@ theorem P5332T1Parent2Rotation0Values (P A : FordFareyParameter) (hq : 1 < P.q) classical have hq' : 1 < (P.q : Int) := by exact_mod_cast hq have qsum : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by exact_mod_cast P.sum_q - have rpos : 0 < (P.q₁ : Int) := Parent2Rotation0Proof.rpos P A hq hq' + have rpos : 0 < (P.q₁ : Int) := Parent2Rotation0Proof.rpos P hq hq' have spos : 0 < (P.q₂ : Int) := by exact_mod_cast P.q₂_pos have rlt : (P.q₁ : Int) < P.q := by exact_mod_cast P.q₁_lt have slt : (P.q₂ : Int) < P.q := by omega @@ -316,7 +318,7 @@ theorem P5332T1Parent2Rotation0Values (P A : FordFareyParameter) (hq : 1 < P.q) qsum rpos spos hsn Y hAqInt hdisp hx0 hx'0 hY hlow valLeft valChildEast valA hother have companion : (⟨0,Y⟩ : GaussianInt) - (P5332T1ParentRows P 1 0 0).companion ∈ FordVertexDomain P.q ↔ - t = 0 ∧ Even (0+1 : Nat) := Parent2Rotation0Proof.companion P A qsum Y hx0 hlow + t = 0 ∧ Even (0+1 : Nat) := Parent2Rotation0Proof.companion P qsum Y hx0 hlow refine ⟨t, ht0, hts, hxcenter, rfl, ?_, companion⟩ intro l exact values l diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean index 701bfb9557..8353e559bc 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean @@ -26,9 +26,9 @@ namespace ApollonianSuperharmonic namespace ParentTwoRotationOneProof private theorem hrpos : - ∀ (P : FordFareyParameter), (FordFareyParameter) → (((1 : ℕ) < P.q) → (0 < P.q₁)) := by + ∀ (P : FordFareyParameter), (1 : ℕ) < P.q → 0 < P.q₁ := by classical - intro P A hq + intro P hq by_contra h; have hr0 : P.q₁ = 0 := by omega have := P.det₁ rw [hr0] at this @@ -41,17 +41,27 @@ private theorem hrpos : omega private theorem hcenterA : - ∀ (P : FordFareyParameter), ∀ (A : FordFareyParameter), (A.p = P.p₂) → ((A.q = - P.q₂) → ((IntegerLatticeFunction) → ((Int) → ((0 < P.q₂) → ((∀ (r : Int), ∀ (z : Int), (0 - ≤ r) → ((r ≤ A.q) → ((0 ≤ z) → ((z ≤ A.q) → ((r ≤ 1 ∨ (A.q : Int)-1 ≤ r ∨ z ≤ 1 ∨ - (A.q : Int)-1 ≤ z) → (FordOdometer A ⟨r,z⟩ = - IntegerCeilDiv (A.p*r*z) A.q (by exact_mod_cast A.q_pos.ne'))))))) → (∀ (X : ℤ), (ℤ) → - (((A.q - : Int) = P.q₂) → ( - let t : Int := X-(P.q₁ : Int) - (0 ≤ t) → ((t < P.q₂) → (FordOdometer A ⟨t,P.q₂⟩ = P.p₂*t)))))))))) := by + ∀ (P : FordFareyParameter), + ∀ (A : FordFareyParameter), + A.p = P.p₂ → + A.q = P.q₂ → + 0 < P.q₂ → + (∀ (r : Int), + ∀ (z : Int), + 0 ≤ r → + r ≤ A.q → + 0 ≤ z → + z ≤ A.q → + r ≤ 1 ∨ (A.q : Int) - 1 ≤ r ∨ z ≤ 1 ∨ (A.q : Int) - 1 ≤ z → + FordOdometer A ⟨r, z⟩ = + IntegerCeilDiv (A.p * r * z) A.q + (by exact_mod_cast A.q_pos.ne')) → + ∀ (X : ℤ), + (A.q : Int) = P.q₂ → + let t : Int := X - (P.q₁ : Int) + 0 ≤ t → t < P.q₂ → FordOdometer A ⟨t, P.q₂⟩ = P.p₂ * t := by classical - intro P A hAp hAq f B hspos boundaryA X Y hAqInt t ht0 hstrict + intro P A hAp hAq hspos boundaryA X hAqInt t ht0 hstrict have hbA := boundaryA t P.q₂ ht0 (by omega) (by omega) (by omega) (by omega) have hbA' : FordOdometer A ⟨t,P.q₂⟩ = IntegerCeilDiv (P.p₂*t*P.q₂) P.q₂ (by omega) := by @@ -63,27 +73,58 @@ private theorem hcenterA : ring private theorem southVal : - ∀ (P : FordFareyParameter), ∀ (A : FordFareyParameter), (A.p = P.p₂) → ((A.q = - P.q₂) → (∀ (f : IntegerLatticeFunction), ((P.q : Int) ≠ 0) → ((0 < P.q₂) → ((∀ (r : Int), - ∀ (z : Int), (0 ≤ r) → ((r ≤ A.q) → ((0 ≤ z) → ((z - ≤ A.q) → ((r ≤ 1 ∨ (A.q : Int)-1 ≤ r ∨ z ≤ 1 ∨ (A.q : Int)-1 ≤ z) → (FordOdometer A - ⟨r,z⟩ = IntegerCeilDiv (A.p*r*z) A.q (by exact_mod_cast A.q_pos.ne'))))))) → (∀ (X : ℤ), - ∀ (Y : ℤ), ((0 : ℤ) ≤ X - (↑P.q₁ : ℤ) ∧ X - (↑P.q₁ : ℤ) ≤ (↑A.q : ℤ) ∧ (0 : ℤ) ≤ Y - - -(↑P.q₂ : - ℤ) ∧ Y - -(↑P.q₂ : ℤ) ≤ (↑A.q : ℤ)) → (((P5332T1ParentRows P (1 : Fin (2 : ℕ)) (1 : Fin - (4 : ℕ)) (0 : ℤ)).displacement = ⟨(↑P.q₁ : ℤ), -(↑P.q₂ : ℤ)⟩) → (((A.q : Int) = P.q₂) → - ((Y = 0) → ( - let t : Int := X-(P.q₁ : Int) - (0 ≤ t) → ((X = P.q₁ + t) → ((t < P.q₂) → (((P5332T1ParentRows P 1 1 0).linear = - ⟨-P.p₂,P.p₁⟩) → ((∀ (y : GaussianInt), y - (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (1 : - Fin (4 : ℕ)) (0 : ℤ)).displacement ∈ FordVertexDomain A.q → f y = FordOdometer A (y - - (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (1 : Fin (4 : ℕ)) (0 : ℤ)).displacement) + - (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (1 : Fin (4 : ℕ)) (0 : ℤ)).linear.re * y.re + - (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (1 : Fin (4 : ℕ)) (0 : ℤ)).linear.im * y.im + - P.p₂ * (↑P.q₁ : ℤ)) → (((⟨X,Y⟩ : GaussianInt)-⟨0,1⟩ = ⟨X,Y-1⟩) → (f (⟨X,Y⟩-⟨0,1⟩) = -P.p₁ - - (P.p₂*t / P.q₂)))))))))))))))) := by + ∀ (P : FordFareyParameter), + ∀ (A : FordFareyParameter), + A.p = P.p₂ → + A.q = P.q₂ → + ∀ (f : IntegerLatticeFunction), + 0 < P.q₂ → + (∀ (r : Int), + ∀ (z : Int), + 0 ≤ r → + r ≤ A.q → + 0 ≤ z → + z ≤ A.q → + r ≤ 1 ∨ (A.q : Int) - 1 ≤ r ∨ z ≤ 1 ∨ (A.q : Int) - 1 ≤ z → + FordOdometer A ⟨r, z⟩ = + IntegerCeilDiv (A.p * r * z) A.q + (by exact_mod_cast A.q_pos.ne')) → + ∀ (X : ℤ), + ∀ (Y : ℤ), + (0 : ℤ) ≤ X - (↑P.q₁ : ℤ) ∧ + X - (↑P.q₁ : ℤ) ≤ (↑A.q : ℤ) ∧ + (0 : ℤ) ≤ Y - -(↑P.q₂ : ℤ) ∧ Y - -(↑P.q₂ : ℤ) ≤ (↑A.q : ℤ) → + (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (1 : Fin (4 : ℕ)) + (0 : ℤ)).displacement = + ⟨(↑P.q₁ : ℤ), -(↑P.q₂ : ℤ)⟩ → + (A.q : Int) = P.q₂ → + Y = 0 → + let t : Int := X - (P.q₁ : Int) + 0 ≤ t → + X = P.q₁ + t → + t < P.q₂ → + (P5332T1ParentRows P 1 1 0).linear = ⟨-P.p₂, P.p₁⟩ → + (∀ (y : GaussianInt), + y - + (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (1 : Fin (4 : ℕ)) + (0 : ℤ)).displacement ∈ + FordVertexDomain A.q → + f y = + FordOdometer A + (y - + (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (1 : Fin (4 : ℕ)) + (0 : ℤ)).displacement) + + (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (1 : Fin (4 : ℕ)) + (0 : ℤ)).linear.re * + y.re + + (P5332T1ParentRows P (1 : Fin (2 : ℕ)) (1 : Fin (4 : ℕ)) + (0 : ℤ)).linear.im * + y.im + + P.p₂ * (↑P.q₁ : ℤ)) → + (⟨X, Y⟩ : GaussianInt) - ⟨0, 1⟩ = ⟨X, Y - 1⟩ → + f (⟨X, Y⟩ - ⟨0, 1⟩) = -P.p₁ - P.p₂ * t / P.q₂ := by classical - intro P A hAp hAq f hqn hspos boundaryA X Y hx' hdis hAqInt hy t ht0 hX hstrict hrow0 hother + intro P A hAp hAq f hspos boundaryA X Y hx' hdis hAqInt hy t ht0 hX hstrict hrow0 hother southArg have hsource : (⟨X,Y⟩-⟨0,1⟩ : GaussianInt) = ⟨P.q₁+t,-1⟩ := by rw [southArg, hX, hy] @@ -167,7 +208,7 @@ theorem P5332T1Parent2Rotation1Values (P A : FordFareyParameter) (hq : 1 < P.q) classical have hq' : 1 < (P.q : Int) := by exact_mod_cast hq have hqn : (P.q : Int) ≠ 0 := by omega - have hrpos : 0 < P.q₁ := ParentTwoRotationOneProof.hrpos P A hq + have hrpos : 0 < P.q₁ := ParentTwoRotationOneProof.hrpos P hq have hspos : 0 < P.q₂ := P.q₂_pos have hsumq : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by exact_mod_cast P.sum_q have hpairs : P.p = P.p₁ + P.p₂ := P.sum_p @@ -237,7 +278,7 @@ theorem P5332T1Parent2Rotation1Values (P A : FordFareyParameter) (hq : 1 < P.q) rw [hX, hy, boundaryP (P.q₁+t) 0 (by omega) (by omega) (by omega) (by omega) (by omega)] simp [IntegerCeilDiv] have hcenterA : FordOdometer A ⟨t,P.q₂⟩ = P.p₂*t := ParentTwoRotationOneProof.hcenterA P A hAp - hAq f B hspos boundaryA X Y hAqInt ht0 hstrict + hAq hspos boundaryA X hAqInt ht0 hstrict have hB : B = P.p₂ * (P.q₁ : Int) := by rw [hcenterP] at hxcenter rw [hcenterA] at hxother @@ -277,7 +318,7 @@ theorem P5332T1Parent2Rotation1Values (P A : FordFareyParameter) (hq : 1 < P.q) rw [boundaryP X 1 (by omega) (by omega) (by norm_num) (by omega) (by omega)] simp have southVal : f (⟨X,Y⟩-⟨0,1⟩) = - -P.p₁ - (P.p₂*t / P.q₂) := ParentTwoRotationOneProof.southVal P A hAp hAq f hqn hspos + -P.p₁ - (P.p₂*t / P.q₂) := ParentTwoRotationOneProof.southVal P A hAp hAq f hspos boundaryA X Y hx' hdis hAqInt hy ht0 hX hstrict hrow0 hother southArg have hnorth : f (⟨X,Y⟩+⟨0,1⟩) = P.p₁ + IntegerCeilDiv (P.p*t-1) P.q hqn := ParentTwoRotationOneProof.hnorth P f hqn hdet1 X Y hy hX northArg northVal diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean index cdc2fd8141..198a97b4f6 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean @@ -26,42 +26,83 @@ namespace ApollonianSuperharmonic namespace Parent2Rotation2Proof private theorem baseBd : - ∀ (P : FordFareyParameter), (FordFareyParameter) → ( - let q : Int := P.q - let r : Int := P.q₁ - let s : Int := P.q₂ - let p : Int := P.p - (q = r + s) → (∀ (hqn : q ≠ 0), ((∀ (P : FordFareyParameter), ∀ (x : GaussianInt), P.q = (1 : - ℕ) → FordOdometer P x = x.re * (x.re - (1 : ℤ)) / (2 : ℤ) + P.p * x.re * x.im) ∧ (∀ (P : - FordFareyParameter), ∀ x ∈ FordDoubledBoundary P.q, Classical.choose - FordOdometerFamilyExistsUnique P x = IntegerCeilDiv (P.p * x.re * x.im) (↑P.q : ℤ) (by - exact_mod_cast P.q_pos.ne')) ∧ (∀ (P : FordFareyParameter), ∀ (x : GaussianInt), - Classical.choose FordOdometerFamilyExistsUnique P (x + ⟨(0 : ℤ), -(↑P.q : ℤ)⟩) = - Classical.choose FordOdometerFamilyExistsUnique P x - P.p * x.re) ∧ (∀ (P : - FordFareyParameter), ∀ (x : GaussianInt), Classical.choose - FordOdometerFamilyExistsUnique - P (x + ⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩) = Classical.choose FordOdometerFamilyExistsUnique P x + - P.p₁ * x.re + P.p * x.im + (↑P.q₁ : ℤ) * P.p) ∧ (∀ (P : FordFareyParameter), ∀ (x : - GaussianInt), Classical.choose FordOdometerFamilyExistsUnique P (x + ⟨-(↑P.q : ℤ), - (↑P.q₂ - : ℤ)⟩) = Classical.choose FordOdometerFamilyExistsUnique P x + P.p₂ * x.re - P.p * x.im - - (↑P.q : ℤ) * P.p₂) ∧ ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), ∀ (P₂ : - FordFareyParameter), (1 : ℕ) < P.q → P₁.p = P.p₁ → P₁.q = P.q₁ → P₂.p = P.p₂ → P₂.q = - P.q₂ → (∀ x ∈ FordRecursiveVertexDomains P (0 : Fin (4 : ℕ)), Classical.choose - FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique P₁ - x) ∧ (∀ x ∈ FordRecursiveVertexDomains P (1 : Fin (4 : ℕ)), Classical.choose - FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique P₁ - (x - ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) + P.p₂ * x.re + P.p₂ * x.im - P.p₂ * (↑P.q₂ : ℤ) + (1 : - ℤ)) ∧ (∀ x ∈ FordRecursiveVertexDomains P (2 : Fin (4 : ℕ)), Classical.choose - FordOdometerFamilyExistsUnique P x = Classical.choose FordOdometerFamilyExistsUnique P₂ - (x - ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩) + P.p₁ * x.im) ∧ ∀ x ∈ FordRecursiveVertexDomains P (3 : Fin - (4 : ℕ)), Classical.choose FordOdometerFamilyExistsUnique P x = Classical.choose - FordOdometerFamilyExistsUnique P₂ (x - ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩) + P.p₁ * x.re) → (∀ (u : - ℤ), ∀ (v : ℤ), (0 : ℤ) ≤ u → u ≤ q → (0 : ℤ) ≤ v → v ≤ q → u ≤ (1 : ℤ) ∨ q - (1 : ℤ) ≤ u - ∨ v ≤ (1 : ℤ) ∨ q - (1 : ℤ) ≤ v → FordOdometer P ⟨u, v⟩ = IntegerCeilDiv (p * u * v) q - hqn))) := by + ∀ (P : FordFareyParameter), + let q : Int := P.q + let r : Int := P.q₁ + let s : Int := P.q₂ + let p : Int := P.p + q = r + s → + ∀ (hqn : q ≠ 0), + ((∀ (P : FordFareyParameter), + ∀ (x : GaussianInt), + P.q = (1 : ℕ) → + FordOdometer P x = + x.re * (x.re - (1 : ℤ)) / (2 : ℤ) + P.p * x.re * x.im) ∧ + (∀ (P : FordFareyParameter), + ∀ x ∈ FordDoubledBoundary P.q, + Classical.choose FordOdometerFamilyExistsUnique P x = + IntegerCeilDiv (P.p * x.re * x.im) (↑P.q : ℤ) + (by exact_mod_cast P.q_pos.ne')) ∧ + (∀ (P : FordFareyParameter), + ∀ (x : GaussianInt), + Classical.choose FordOdometerFamilyExistsUnique P + (x + ⟨(0 : ℤ), -(↑P.q : ℤ)⟩) = + Classical.choose FordOdometerFamilyExistsUnique P x - P.p * x.re) ∧ + (∀ (P : FordFareyParameter), + ∀ (x : GaussianInt), + Classical.choose FordOdometerFamilyExistsUnique P + (x + ⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩) = + Classical.choose FordOdometerFamilyExistsUnique P x + + P.p₁ * x.re + + P.p * x.im + + (↑P.q₁ : ℤ) * P.p) ∧ + (∀ (P : FordFareyParameter), + ∀ (x : GaussianInt), + Classical.choose FordOdometerFamilyExistsUnique P + (x + ⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩) = + Classical.choose FordOdometerFamilyExistsUnique P x + + P.p₂ * x.re - + P.p * x.im - + (↑P.q : ℤ) * P.p₂) ∧ + ∀ (P : FordFareyParameter), + ∀ (P₁ : FordFareyParameter), + ∀ (P₂ : FordFareyParameter), + (1 : ℕ) < P.q → + P₁.p = P.p₁ → + P₁.q = P.q₁ → + P₂.p = P.p₂ → + P₂.q = P.q₂ → + (∀ x ∈ FordRecursiveVertexDomains P (0 : Fin (4 : ℕ)), + Classical.choose FordOdometerFamilyExistsUnique P x = + Classical.choose FordOdometerFamilyExistsUnique P₁ x) ∧ + (∀ x ∈ FordRecursiveVertexDomains P (1 : Fin (4 : ℕ)), + Classical.choose FordOdometerFamilyExistsUnique P x = + Classical.choose FordOdometerFamilyExistsUnique P₁ + (x - ⟨(↑P.q₂ : ℤ), (↑P.q₂ : ℤ)⟩) + + P.p₂ * x.re + + P.p₂ * x.im - + P.p₂ * (↑P.q₂ : ℤ) + + (1 : ℤ)) ∧ + (∀ x ∈ FordRecursiveVertexDomains P (2 : Fin (4 : ℕ)), + Classical.choose FordOdometerFamilyExistsUnique P x = + Classical.choose FordOdometerFamilyExistsUnique P₂ + (x - ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩) + + P.p₁ * x.im) ∧ + ∀ x ∈ FordRecursiveVertexDomains P (3 : Fin (4 : ℕ)), + Classical.choose FordOdometerFamilyExistsUnique P x = + Classical.choose FordOdometerFamilyExistsUnique P₂ + (x - ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩) + + P.p₁ * x.re) → + ∀ (u : ℤ), + ∀ (v : ℤ), + (0 : ℤ) ≤ u → + u ≤ q → + (0 : ℤ) ≤ v → + v ≤ q → + u ≤ (1 : ℤ) ∨ q - (1 : ℤ) ≤ u ∨ v ≤ (1 : ℤ) ∨ q - (1 : ℤ) ≤ v → + FordOdometer P ⟨u, v⟩ = IntegerCeilDiv (p * u * v) q hqn := by classical - intro P A q r s p hsum hqn laws u v hu huq hv hvq hedge + intro P q r s p hsum hqn laws u v hu huq hv hvq hedge apply laws.2.1 change (0 ≤ u ∧ u ≤ (P.q : Int) ∧ 0 ≤ v ∧ v ≤ (P.q : Int)) ∧ ¬ (2 ≤ u ∧ u ≤ (P.q : Int)-2 ∧ 2 ≤ v ∧ v ≤ (P.q : Int)-2) @@ -193,20 +234,30 @@ private theorem valueEast : convert hv using 1; ring private theorem valueWest : - ∀ (P : FordFareyParameter), (FordFareyParameter) → (((1 : ℕ) < P.q) → (∀ (f : - IntegerLatticeFunction), (Int) → ((∀ y ∈ FordVertexDomain P.q, f y = FordOdometer P y) → ( - let q : Int := P.q - let r : Int := P.q₁ - let s : Int := P.q₂ - let p : Int := P.p - (q = r + s) → (∀ (hqn : q ≠ 0), (s ≠ 0) → ((∀ (u : Int), ∀ (v : Int), (0 ≤ u) → ((u ≤ q) → - ((0 ≤ v) → ((v ≤ q) → ((u ≤ 1 ∨ q-1 ≤ u ∨ v ≤ 1 ∨ q-1 ≤ v) → (FordOdometer P ⟨u,v⟩ = - IntegerCeilDiv (p*u*v) q hqn)))))) → (∀ (Y : ℤ), - let t : Int := Y-r - ((0 : ℤ) ≤ q ∧ q ≤ q ∧ (0 : ℤ) ≤ Y ∧ Y ≤ q) → ((t < s) → (f ⟨q-1,r+t⟩ = p*(r+t) - - (p*(r+t))/q))))))))) := by + ∀ (P : FordFareyParameter), + (1 : ℕ) < P.q → + ∀ (f : IntegerLatticeFunction), + (∀ y ∈ FordVertexDomain P.q, f y = FordOdometer P y) → + let q : Int := P.q; + let r : Int := P.q₁; + let s : Int := P.q₂; + let p : Int := P.p; + q = r + s → + ∀ (hqn : q ≠ 0), + (∀ (u : Int), + ∀ (v : Int), + 0 ≤ u → + u ≤ q → + 0 ≤ v → + v ≤ q → + u ≤ 1 ∨ q - 1 ≤ u ∨ v ≤ 1 ∨ q - 1 ≤ v → + FordOdometer P ⟨u, v⟩ = IntegerCeilDiv (p * u * v) q hqn) → + ∀ (Y : ℤ), + let t : Int := Y - r + (0 : ℤ) ≤ q ∧ q ≤ q ∧ (0 : ℤ) ≤ Y ∧ Y ≤ q → + t < s → f ⟨q - 1, r + t⟩ = p * (r + t) - p * (r + t) / q := by classical - intro P A hq f B hbase q r s p hsum hqn hsn baseBd Y t hx0 htStrict + intro P hq f hbase q r s p hsum hqn baseBd Y t hx0 htStrict have hv := hbase ⟨q-1,r+t⟩ (by change 0 ≤ q-1 ∧ q-1 ≤ q ∧ 0 ≤ r+t ∧ r+t ≤ q; omega) rw [baseBd (q-1) (r+t) (by omega) (by omega) (by omega) (by omega) (by omega)] at hv have hcdiv : IntegerCeilDiv (p*(q-1)*(r+t)) q hqn = @@ -305,7 +356,7 @@ theorem P5332T1Parent2Rotation2Values (P A : FordFareyParameter) (hq : 1 < P.q) have baseBd (u v : Int) (hu : 0 ≤ u) (huq : u ≤ q) (hv : 0 ≤ v) (hvq : v ≤ q) (hedge : u ≤ 1 ∨ q-1 ≤ u ∨ v ≤ 1 ∨ q-1 ≤ v) : - FordOdometer P ⟨u,v⟩ = IntegerCeilDiv (p*u*v) q hqn := Parent2Rotation2Proof.baseBd P A + FordOdometer P ⟨u,v⟩ = IntegerCeilDiv (p*u*v) q hqn := Parent2Rotation2Proof.baseBd P hsum hqn laws u v hu huq hv hvq hedge have parentBd (u v : Int) (hu : 0 ≤ u) (hus : u ≤ s) (hv : 0 ≤ v) (hvs : v ≤ s) @@ -359,8 +410,8 @@ theorem P5332T1Parent2Rotation2Values (P A : FordFareyParameter) (hq : 1 < P.q) have valueCenter : f ⟨q,r+t⟩ = p*(r+t) := hc have valueEast : f ⟨q+1,r+t⟩ = p*(r+t)+a+IntegerCeilDiv (b*t) s hsn := Parent2Rotation2Proof.valueEast P A f B hother hs hsn parentBd Y hdisp hAn ht0 htS hB - have valueWest : f ⟨q-1,r+t⟩ = p*(r+t) - (p*(r+t))/q := Parent2Rotation2Proof.valueWest P A hq - f B hbase hsum hqn hsn baseBd Y hx0 htStrict + have valueWest : f ⟨q-1,r+t⟩ = p*(r+t) - (p*(r+t))/q := Parent2Rotation2Proof.valueWest P hq + f hbase hsum hqn baseBd Y hx0 htStrict have hdiv : (p*(r+t))/q = (p*t-1)/q + a := by have hnum : p*(r+t) = (p*t-1) + a*q := by nlinarith [hdet₁] rw [hnum, show (p*t-1) + a*q = (p*t-1) + q*a by ring, diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean b/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean index f1637a2bbb..0bc2ab708a 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean @@ -72,10 +72,12 @@ private theorem triDiff : (by classical exact - (DiamondParameter) → (∀ (t : ℤ), t * (t - (1 : ℤ)) / (2 : ℤ) - (t - (1 : ℤ)) * (t - (2 : - ℤ)) / (2 : ℤ) = t - (1 : ℤ)) ) := by + ∀ (t : ℤ), + t * (t - (1 : ℤ)) / (2 : ℤ) - (t - (1 : ℤ)) * (t - (2 : ℤ)) / (2 : ℤ) = + t - (1 : ℤ) + ) := by classical - intro K t + intro t have he : t*(t-1) = (t-1)*(t-2)+(t-1)*2 := by ring omega @@ -417,7 +419,7 @@ theorem P5352T2FirstUnit (K : DiamondParameter) (hk : 1 < K.1) have sqm (t : Int) : (-1-2*t)^2/4 = t^2+t := FirstUnitProof.sqm t have sqp (t : Int) : (1-2*t)^2/4 = t^2-t := FirstUnitProof.sqp t have triDiff (t : Int) : - t*(t-1)/2 - (t-1)*(t-2)/2 = t-1 := FirstUnitProof.triDiff K t + t*(t-1)/2 - (t-1)*(t-2)/2 = t-1 := FirstUnitProof.triDiff t dsimp only intro hA hP hzA hzP hcov change ∀ y, y ∈ FootprintVertices (DiamondTile K.1) → diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean index db62ee82c7..0331a5a93a 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean @@ -5,6 +5,7 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.DiamondQuadraticArithmetic public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacianProperties @@ -68,31 +69,70 @@ private theorem boundaryCase : (by classical exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), - let k : Int := K.1 - let d : GaussianInt := ⟨k, 1-k⟩ - let r : GaussianInt := ⟨2*k, 0⟩ - let child := P5352T2Sources K hk 0 - let pred := P5352T2Sources K hk 3 - (∀ y ∈ FootprintVertices child.1, f y = child.2.1 y) → (((2 : ℤ) ≤ k) → (∀ (p : ℤ), ∀ (q - : ℤ), (⟨p, q⟩ ∈ FootprintVertices child.1) → ((⟨p, q⟩ - d ∈ FootprintVertices pred.1) - → ((∀ (y : GaussianInt), y = ⟨p, q⟩ ∨ y = ⟨p, q⟩ + (1 : GaussianInt) ∨ y = ⟨p, q⟩ - - (1 : GaussianInt) ∨ y = ⟨p, q⟩ + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨p, q⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ - → y ∈ FootprintVertices child.1 ∨ y - d ∈ FootprintVertices pred.1) → (((1 : ℤ) ≤ q + - k ∧ q ≤ (2 : ℤ) * (k - (1 : ℤ)) + ((1 : ℤ) - k) ∧ k ≤ p + (k - (1 : ℤ)) ∧ p ≤ k - (1 - : ℤ) + k ∧ (1 : ℤ) ≤ p - k + (1 : ℤ) + q + k ∧ p ≤ q - ((1 : ℤ) - k) + (1 : ℤ) + k ∧ - q ≤ (1 : ℤ) + (p - k) + (2 : ℤ) * (k - (1 : ℤ)) + ((1 : ℤ) - k) ∧ p ≤ (2 : ℤ) * (k - - (1 : ℤ)) - (q - ((1 : ℤ) - k)) + (1 : ℤ) + k) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : - ℤ)) → (((0 : ℤ) ≤ q ∧ q ≤ (2 : ℤ) * k ∧ -k ≤ p ∧ p ≤ k ∧ -q - (1 : ℤ) ≤ p ∧ p ≤ q + - (1 : ℤ) ∧ -((2 : ℤ) * k - q + (1 : ℤ)) ≤ p ∧ p ≤ (2 : ℤ) * k - q + (1 : ℤ)) → (((1 : - ℤ) ≤ p) → ((q = p - (1 : ℤ) ∨ q = p) → ((∀ (a : Int), ∀ (b : Int), (0 ≤ b) → ((b ≤ - 2*k) → ((-k ≤ a) → ((a ≤ k) → ((-b-1 ≤ a) → ((a ≤ b+1) → ((-(2*k-b+1) ≤ a) → ((a ≤ - 2*k-b+1) → ((⟨a,b⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)))))))))) → (q - = p → (⟨p, p⟩ - r ∈ FootprintVertices child.1 → FourNeighborLaplacian f ⟨p, p⟩ = (0 : - ℤ)) ∧ (⟨p, p⟩ - r ∉ FootprintVertices child.1 → FourNeighborLaplacian f ⟨p, p⟩ = (1 : - ℤ))))))))))))) ) := by - classical - intro K hk f k d r child pred hchild hkI p q hz hpz hcover hdpred hcast hdchild hp1 hq childMem + ∀ (K : DiamondParameter), + ∀ (hk : (1 : ℕ) < K.1), + ∀ (f : IntegerLatticeFunction), + let k : Int := K.1; + let d : GaussianInt := ⟨k, 1 - k⟩; + let r : GaussianInt := ⟨2 * k, 0⟩; + let child := P5352T2Sources K hk 0; + let pred := P5352T2Sources K hk 3; + (∀ y ∈ FootprintVertices child.1, f y = child.2.1 y) → + ∀ (p : ℤ), + ∀ (q : ℤ), + ⟨p, q⟩ ∈ FootprintVertices child.1 → + ⟨p, q⟩ - d ∈ FootprintVertices pred.1 → + (∀ (y : GaussianInt), + y = ⟨p, q⟩ ∨ + y = ⟨p, q⟩ + (1 : GaussianInt) ∨ + y = ⟨p, q⟩ - (1 : GaussianInt) ∨ + y = ⟨p, q⟩ + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ + y = ⟨p, q⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → + y ∈ FootprintVertices child.1 ∨ + y - d ∈ FootprintVertices pred.1) → + (1 : ℤ) ≤ q + k ∧ + q ≤ (2 : ℤ) * (k - (1 : ℤ)) + ((1 : ℤ) - k) ∧ + k ≤ p + (k - (1 : ℤ)) ∧ + p ≤ k - (1 : ℤ) + k ∧ + (1 : ℤ) ≤ p - k + (1 : ℤ) + q + k ∧ + p ≤ q - ((1 : ℤ) - k) + (1 : ℤ) + k ∧ + q ≤ + (1 : ℤ) + (p - k) + (2 : ℤ) * (k - (1 : ℤ)) + + ((1 : ℤ) - k) ∧ + p ≤ + (2 : ℤ) * (k - (1 : ℤ)) - (q - ((1 : ℤ) - k)) + (1 : ℤ) + + k → + (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ) → + (0 : ℤ) ≤ q ∧ + q ≤ (2 : ℤ) * k ∧ + -k ≤ p ∧ + p ≤ k ∧ + -q - (1 : ℤ) ≤ p ∧ + p ≤ q + (1 : ℤ) ∧ + -((2 : ℤ) * k - q + (1 : ℤ)) ≤ p ∧ + p ≤ (2 : ℤ) * k - q + (1 : ℤ) → + (1 : ℤ) ≤ p → + q = p - (1 : ℤ) ∨ q = p → + (∀ (a : Int), + ∀ (b : Int), + 0 ≤ b → + b ≤ 2 * k → + -k ≤ a → + a ≤ k → + -b - 1 ≤ a → + a ≤ b + 1 → + -(2 * k - b + 1) ≤ a → + a ≤ 2 * k - b + 1 → + (⟨a, b⟩ : GaussianInt) ∈ + FootprintVertices (DiamondTile K.1)) → + q = p → + (⟨p, p⟩ - r ∈ FootprintVertices child.1 → + FourNeighborLaplacian f ⟨p, p⟩ = (0 : ℤ)) ∧ + (⟨p, p⟩ - r ∉ FootprintVertices child.1 → + FourNeighborLaplacian f ⟨p, p⟩ = (1 : ℤ)) + ) := by + classical + intro K hk f k d r child pred hchild p q hz hpz hcover hdpred hcast hdchild hp1 hq childMem hqp subst q have hplt : p < k := by omega @@ -193,15 +233,23 @@ private theorem predFoot : (by classical exact - ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( - let k : Int := K.1 - (ℤ) → ((ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (∀ (w : GaussianInt), (0 : - ℤ) ≤ w.im ∧ w.im ≤ (2 : ℤ) * (k - (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ - w.re ∧ w.re ≤ k - (1 : ℤ) ∧ -w.im - (1 : ℤ) ≤ w.re ∧ w.re ≤ w.im + (1 : ℤ) ∧ -((2 : - ℤ) * (k - (1 : ℤ)) - w.im + (1 : ℤ)) ≤ w.re ∧ w.re ≤ (2 : ℤ) * (k - (1 : ℤ)) - w.im + - (1 : ℤ) → w ∈ FootprintVertices (DiamondTile (K.1 - (1 : ℕ)))))))) := by + ∀ (K : DiamondParameter), + (1 : ℕ) < K.1 → + let k : Int := K.1; + (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ) → + ∀ (w : GaussianInt), + (0 : ℤ) ≤ w.im ∧ + w.im ≤ (2 : ℤ) * (k - (1 : ℤ)) ∧ + -(k - (1 : ℤ)) ≤ w.re ∧ + w.re ≤ k - (1 : ℤ) ∧ + -w.im - (1 : ℤ) ≤ w.re ∧ + w.re ≤ w.im + (1 : ℤ) ∧ + -((2 : ℤ) * (k - (1 : ℤ)) - w.im + (1 : ℤ)) ≤ w.re ∧ + w.re ≤ (2 : ℤ) * (k - (1 : ℤ)) - w.im + (1 : ℤ) → + w ∈ FootprintVertices (DiamondTile (K.1 - (1 : ℕ))) + ) := by classical - intro K hk k p q hcast w hw + intro K hk k hcast w hw let Kp : DiamondParameter := ⟨K.1-1, by omega⟩ apply (P5352T2DomainRows Kp w).1.mpr simpa [Kp, hcast] using hw @@ -210,15 +258,18 @@ private theorem predValue : (by classical exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), - let k : Int := K.1 - let pred := P5352T2Sources K hk 3 - ∀ (p : ℤ), ∀ (q : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), - let Q : Int → Int → Int := fun a b => - (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 - ∀ w ∈ FootprintVertices (DiamondTile (K.1 - (1 : ℕ))), pred.2.1 w = Q w.re w.im ) := by + ∀ (K : DiamondParameter), + ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1; + let pred := P5352T2Sources K hk 3; + ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int) - 1) / 2 - (a - b) ^ 2 / 4 + ∀ w ∈ FootprintVertices (DiamondTile (K.1 - (1 : ℕ))), + pred.2.1 w = Q w.re w.im + ) := by classical - intro K hk k pred p q hcast Q w hw + intro K hk k pred hcast Q w hw let Kp : DiamondParameter := ⟨K.1-1, by omega⟩ simpa [Q, pred, Kp, P5352T2Sources] using (P5352T2DomainRows Kp w).2 hw @@ -449,10 +500,10 @@ private theorem floorOdd : (by classical exact - (DiamondParameter) → ((IntegerLatticeFunction) → ((Int) → ((ℤ) → ((ℤ) → (∀ (m : ℤ), ((1 : - ℤ) - (2 : ℤ) * m) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) - m))))) ) := by + ∀ (m : ℤ), ((1 : ℤ) - (2 : ℤ) * m) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) - m + ) := by classical - intro K f B p q m + intro m have h := P4207T1FloorArithmetic.1 1 (-m) have h' : 1 + 2*(-m) = 1-2*m := by ring rw [h'] at h @@ -485,17 +536,18 @@ private theorem qPeLt : classical exact ∀ (K : DiamondParameter), - ( - ( - let k : Int := K.1; - ∀ (p : ℤ), (ℤ) → - let Q : Int → Int → Int := fun a b => - (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4; - ((∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (p < k → Q (p + (1 : ℤ) - k) (p - - (1 : ℤ) - ((1 : ℤ) - k)) = (k - p - (1 : ℤ)) * (k - p - (2 : ℤ)) / (2 : ℤ) - ((k - - (1 : ℤ)) ^ (2 : ℕ) - (k - (1 : ℤ))))))) ) := by + let k : Int := K.1; + ∀ (p : ℤ), + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int) - 1) / 2 - (a - b) ^ 2 / 4; + (∀ (m : Int), (1 - 2 * m) ^ 2 / 4 = m ^ 2 - m) → + p < k → + Q (p + (1 : ℤ) - k) (p - (1 : ℤ) - ((1 : ℤ) - k)) = + (k - p - (1 : ℤ)) * (k - p - (2 : ℤ)) / (2 : ℤ) - + ((k - (1 : ℤ)) ^ (2 : ℕ) - (k - (1 : ℤ))) + ) := by classical - intro K k p q Q floorOdd hpk' + intro K k p Q floorOdd hpk' simp only [Q, Int.natCast_natAbs] rw [abs_of_nonpos (show p+1-k ≤ 0 by omega)] rw [show (p+1-k)-(p-1-(1-k)) = 1-2*(k-1) by ring, floorOdd] @@ -550,30 +602,21 @@ private theorem tri : (by classical exact - (DiamondParameter) → ((IntegerLatticeFunction) → ((Int) → ((ℤ) → ((ℤ) → (∀ (a : ℤ), (2 : - ℤ) * (a * (a - (1 : ℤ)) / (2 : ℤ)) = a * (a - (1 : ℤ))))))) ) := by - classical - intro K f B p q a - rcases Int.emod_two_eq_zero_or_one a with h | h - · have ha : a = 2*(a/2) := by omega - rw [ha] - have he : 2*(a/2)*(2*(a/2)-1) = 2*((a/2)*(2*(a/2)-1)) := by ring - rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] - · have ha : a = 2*(a/2)+1 := by omega - rw [ha] - have he : (2*(a/2)+1)*(2*(a/2)+1-1) = - 2*((2*(a/2)+1)*(a/2)) := by ring - rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + ∀ (a : ℤ), (2 : ℤ) * (a * (a - (1 : ℤ)) / (2 : ℤ)) = a * (a - (1 : ℤ)) + ) := by + exact DiamondQuadraticArithmetic.triangularScale private theorem tdiff : (by classical exact - (DiamondParameter) → ((IntegerLatticeFunction) → ((Int) → ((ℤ) → ((ℤ) → ((∀ (a : Int), - 2*(a*(a-1)/2) = a*(a-1)) → (∀ (a : ℤ), a * (a - (1 : ℤ)) / (2 : ℤ) - (a - (1 : ℤ)) * - (a - (2 : ℤ)) / (2 : ℤ) = a - (1 : ℤ))))))) ) := by + (∀ (a : Int), 2 * (a * (a - 1) / 2) = a * (a - 1)) → + ∀ (a : ℤ), + a * (a - (1 : ℤ)) / (2 : ℤ) - (a - (1 : ℤ)) * (a - (2 : ℤ)) / (2 : ℤ) = + a - (1 : ℤ) + ) := by classical - intro K f B p q tri a + intro tri a have h := tri a have h' : 2*((a-1)*(a-2)/2) = (a-1)*(a-2) := by simpa [show a-1-1 = a-2 by ring] using tri (a-1) @@ -586,11 +629,13 @@ private theorem tdiffRev : (by classical exact - (DiamondParameter) → ((IntegerLatticeFunction) → ((Int) → ((ℤ) → ((ℤ) → ((∀ (a : Int), - a*(a-1)/2-(a-1)*(a-2)/2 = a-1) → (∀ (a : ℤ), (a - (1 : ℤ)) * (a - (2 : ℤ)) / (2 : ℤ) - - a * (a - (1 : ℤ)) / (2 : ℤ) = (1 : ℤ) - a)))))) ) := by + (∀ (a : Int), a * (a - 1) / 2 - (a - 1) * (a - 2) / 2 = a - 1) → + ∀ (a : ℤ), + (a - (1 : ℤ)) * (a - (2 : ℤ)) / (2 : ℤ) - a * (a - (1 : ℤ)) / (2 : ℤ) = + (1 : ℤ) - a + ) := by classical - intro K f B p q tdiff a + intro tdiff a have ht := tdiff a omega @@ -884,7 +929,7 @@ theorem P5352T2Predecessor0 (K : DiamondParameter) (hk : 1 < K.1) FourNeighborLaplacian f ⟨p,p⟩ = 0) ∧ ((⟨p,p⟩ : GaussianInt)-r ∉ FootprintVertices child.1 → FourNeighborLaplacian f ⟨p,p⟩ = 1) := FirstPredecessorCases.boundaryCase K hk f hchild - hkI p q hz hpz hcover hdpred hcast hdchild hp1 hq childMem hqp + p q hz hpz hcover hdpred hcast hdchild hp1 hq childMem hqp let Q : Int → Int → Int := fun a b => (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 have childValue (w : GaussianInt) @@ -895,10 +940,10 @@ theorem P5352T2Predecessor0 (K : DiamondParameter) (hk : 1 < K.1) (hw : 0 ≤ w.im ∧ w.im ≤ 2*(k-1) ∧ -(k-1) ≤ w.re ∧ w.re ≤ k-1 ∧ -w.im-1 ≤ w.re ∧ w.re ≤ w.im+1 ∧ -(2*(k-1)-w.im+1) ≤ w.re ∧ w.re ≤ 2*(k-1)-w.im+1) := FirstPredecessorCases.predFoot K - hk p q hcast w hw + hk hcast w hw have predValue (w : GaussianInt) (hw : w ∈ FootprintVertices (DiamondTile (K.1-1))) := FirstPredecessorCases.predValue K - hk p q hcast w hw + hk hcast w hw have predTranslatedValue (y : GaussianInt) (hy : y-d ∈ FootprintVertices (DiamondTile (K.1-1))) := FirstPredecessorCases.predTranslatedValue K hk f B hpred predValue y hy @@ -946,16 +991,16 @@ theorem P5352T2Predecessor0 (K : DiamondParameter) (hk : 1 < K.1) have qCS : Q p (p-2) = p*(p-1)/2-1 := by simp [Q, abs_of_nonneg (show 0 ≤ p by omega)] have floorEven (m : Int) := FirstPredecessorCases.floorEven m - have floorOdd (m : Int) := FirstPredecessorCases.floorOdd K f B p q m + have floorOdd (m : Int) := FirstPredecessorCases.floorOdd m have qP0 := FirstPredecessorCases.qP0 K p q hpk hq floorEven - have qPeLt (hpk' : p < k) := FirstPredecessorCases.qPeLt K p q floorOdd hpk' + have qPeLt (hpk' : p < k) := FirstPredecessorCases.qPeLt K p floorOdd hpk' have qPeEq (hpk' : p = k) := FirstPredecessorCases.qPeEq K p floorOdd hpk' have qPs := FirstPredecessorCases.qPs K p q hpk hq floorOdd have hQdelta : valS - valC = k-1 := by linear_combination qPs-qP0 - have tri (a : Int) := FirstPredecessorCases.tri K f B p q a - have tdiff (a : Int) := FirstPredecessorCases.tdiff K f B p q tri a - have tdiffRev (a : Int) := FirstPredecessorCases.tdiffRev K f B p q tdiff a + have tri (a : Int) := FirstPredecessorCases.tri a + have tdiff (a : Int) := FirstPredecessorCases.tdiff tri a + have tdiffRev (a : Int) := FirstPredecessorCases.tdiffRev tdiff a have hEastDiff := FirstPredecessorCases.hEastDiff K f B eastAlgebra endAlgebraB p hpk hPcenter hPeast qP0 qPeLt qPeEq tdiffRev have hWestDiff := FirstPredecessorCases.hWestDiff f subDiff p hC0 hCW qC0 qCW tdiffRev diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean index 87b34b02eb..255d07ade1 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean @@ -5,6 +5,7 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.DiamondQuadraticArithmetic public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.EvenSquareQuotient public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacianProperties @@ -34,15 +35,24 @@ private theorem predMem : (by classical exact - ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( - let k : Int := K.1 - (ℤ) → ((ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (∀ (a : ℤ), ∀ (b : ℤ), (0 : ℤ) ≤ b - → b ≤ (2 : ℤ) * (k - (1 : ℤ)) → -(k - (1 : ℤ)) ≤ a → a ≤ k - (1 : ℤ) → -b - (1 : ℤ) ≤ - a → a ≤ b + (1 : ℤ) → -((2 : ℤ) * (k - (1 : ℤ)) - b + (1 : ℤ)) ≤ a → a ≤ (2 : ℤ) * (k - - (1 : ℤ)) - b + (1 : ℤ) → ⟨a, b⟩ ∈ FootprintVertices (DiamondTile (K.1 - (1 : - ℕ))))))) ) := by + ∀ (K : DiamondParameter), + (1 : ℕ) < K.1 → + let k : Int := K.1; + (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ) → + ∀ (a : ℤ), + ∀ (b : ℤ), + (0 : ℤ) ≤ b → + b ≤ (2 : ℤ) * (k - (1 : ℤ)) → + -(k - (1 : ℤ)) ≤ a → + a ≤ k - (1 : ℤ) → + -b - (1 : ℤ) ≤ a → + a ≤ b + (1 : ℤ) → + -((2 : ℤ) * (k - (1 : ℤ)) - b + (1 : ℤ)) ≤ a → + a ≤ (2 : ℤ) * (k - (1 : ℤ)) - b + (1 : ℤ) → + ⟨a, b⟩ ∈ FootprintVertices (DiamondTile (K.1 - (1 : ℕ))) + ) := by classical - intro K hk k p q hcast a b hb0 hb1 ha0 ha1 hs0 hs1 ht0 ht1 + intro K hk k hcast a b hb0 hb1 ha0 ha1 hs0 hs1 ht0 ht1 apply (P5352T2DomainRows ⟨K.1-1,by omega⟩ ⟨a,b⟩).1.mpr simpa [hcast] using And.intro hb0 (And.intro hb1 (And.intro ha0 (And.intro ha1 (And.intro hs0 (And.intro hs1 (And.intro ht0 ht1)))))) @@ -92,17 +102,30 @@ private theorem hnot : (by classical exact - ∀ (K : DiamondParameter), (IntegerLatticeFunction) → ( - let k : Int := K.1 - ∀ (p : ℤ), ((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (((1 : ℤ) ≤ p) → ((k < (2 : ℤ) * k - - p ∧ (2 : ℤ) * k - p ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ k ≤ p + (k - (1 : ℤ)) - ∧ p ≤ k - (1 : ℤ) + k ∧ k < p - k + (1 : ℤ) + ((2 : ℤ) * k - p) ∧ p ≤ (2 : ℤ) * k - p - - (k + (1 : ℤ)) + (1 : ℤ) + k ∧ (2 : ℤ) * k - p ≤ (1 : ℤ) + (p - k) + (2 : ℤ) * (k - - (1 : ℤ)) + (k + (1 : ℤ)) ∧ p ≤ (2 : ℤ) * (k - (1 : ℤ)) - ((2 : ℤ) * k - p - (k + (1 : - ℤ))) + (1 : ℤ) + k) → ((⟨p,2*k-p⟩ : GaussianInt) ∉ DiamondVertexDomains K true)))) ) + ∀ (K : DiamondParameter), + let k : Int := K.1 + ∀ (p : ℤ), + (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ) → + (1 : ℤ) ≤ p → + k < (2 : ℤ) * k - p ∧ + (2 : ℤ) * k - p ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ + k ≤ p + (k - (1 : ℤ)) ∧ + p ≤ k - (1 : ℤ) + k ∧ + k < p - k + (1 : ℤ) + ((2 : ℤ) * k - p) ∧ + p ≤ (2 : ℤ) * k - p - (k + (1 : ℤ)) + (1 : ℤ) + k ∧ + (2 : ℤ) * k - p ≤ + (1 : ℤ) + (p - k) + (2 : ℤ) * (k - (1 : ℤ)) + + (k + (1 : ℤ)) ∧ + p ≤ + (2 : ℤ) * (k - (1 : ℤ)) - + ((2 : ℤ) * k - p - (k + (1 : ℤ))) + + (1 : ℤ) + + k → + (⟨p, 2 * k - p⟩ : GaussianInt) ∉ DiamondVertexDomains K true + ) := by classical - intro K f k p hcast hp1 hdpred + intro K k p hcast hp1 hdpred change ¬ (Int.natAbs p + Int.natAbs (2*k-p-(K.1:Int)) ≤ K.1-1) intro hh have hpabs : (Int.natAbs p : Int)=p := by rw [Int.natCast_natAbs,abs_of_nonneg (by omega)] @@ -180,19 +203,32 @@ private theorem hcompAt229 : (by classical exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), (IntegerLatticeFunction) → ( - let k : Int := K.1 - let r : GaussianInt := ⟨2*k,0⟩ - let child := P5352T2Sources K hk 0 - (child.1 = DiamondTile K.1) → (∀ (p : ℤ), ((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → ((k < - (2 : ℤ) * k - p ∧ (2 : ℤ) * k - p ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ k ≤ p + - (k - (1 : ℤ)) ∧ p ≤ k - (1 : ℤ) + k ∧ k < p - k + (1 : ℤ) + ((2 : ℤ) * k - p) ∧ p ≤ - (2 : ℤ) * k - p - (k + (1 : ℤ)) + (1 : ℤ) + k ∧ (2 : ℤ) * k - p ≤ (1 : ℤ) + (p - k) + - (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ p ≤ (2 : ℤ) * (k - (1 : ℤ)) - ((2 : ℤ) * k - - p - (k + (1 : ℤ))) + (1 : ℤ) + k) → ((⟨p,2*k-p⟩:GaussianInt)-r ∉ FootprintVertices - child.1)))) ) := by + ∀ (K : DiamondParameter), + ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1 + let r : GaussianInt := ⟨2 * k, 0⟩ + let child := P5352T2Sources K hk 0 + child.1 = DiamondTile K.1 → + ∀ (p : ℤ), + (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ) → + k < (2 : ℤ) * k - p ∧ + (2 : ℤ) * k - p ≤ (2 : ℤ) * (k - (1 : ℤ)) + (k + (1 : ℤ)) ∧ + k ≤ p + (k - (1 : ℤ)) ∧ + p ≤ k - (1 : ℤ) + k ∧ + k < p - k + (1 : ℤ) + ((2 : ℤ) * k - p) ∧ + p ≤ (2 : ℤ) * k - p - (k + (1 : ℤ)) + (1 : ℤ) + k ∧ + (2 : ℤ) * k - p ≤ + (1 : ℤ) + (p - k) + (2 : ℤ) * (k - (1 : ℤ)) + + (k + (1 : ℤ)) ∧ + p ≤ + (2 : ℤ) * (k - (1 : ℤ)) - + ((2 : ℤ) * k - p - (k + (1 : ℤ))) + + (1 : ℤ) + + k → + (⟨p, 2 * k - p⟩ : GaussianInt) - r ∉ FootprintVertices child.1 + ) := by classical - intro K hk f k r child hchildTile p hcast hdpred hc + intro K hk k r child hchildTile p hcast hdpred hc have hb := (P5352T2DomainRows K (⟨p,2*k-p⟩-r)).1.mp (hchildTile ▸ hc) simp [r] at hb omega @@ -333,15 +369,10 @@ private theorem sqOdd : (by classical exact - (DiamondParameter) → - ( - ( - ( - ( - (∀ (m : ℤ), ((2 : ℤ) * m + (1 : ℤ)) ^ (2 - : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) + m))))) ) := by + ∀ (m : ℤ), ((2 : ℤ) * m + (1 : ℤ)) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) + m + ) := by classical - intro K m + intro m have h := P4207T1FloorArithmetic.1 1 m have he : 1+2*m=2*m+1 := by ring rw [he] at h @@ -349,36 +380,14 @@ private theorem sqOdd : omega private theorem tri : - (by - classical - exact - ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ((IntegerLatticeFunction) → ((Int) → ( - let k : Int := K.1 - (ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (∀ (a : ℤ), (2 : ℤ) * (a * (a - (1 : ℤ)) - / (2 : ℤ)) = a * (a - (1 : ℤ))))))) ) := by - classical - intro K hk f B k p hcast a - rcases Int.emod_two_eq_zero_or_one a with h | h - · have ha : a=2*(a/2) := by omega - rw [ha] - have he : 2*(a/2)*(2*(a/2)-1)=2*((a/2)*(2*(a/2)-1)) := by ring - rw [he,Int.mul_ediv_cancel_left _ (by norm_num : (2:Int)≠0)] - · have ha : a=2*(a/2)+1 := by omega - rw [ha] - have he : (2*(a/2)+1)*(2*(a/2)+1-1)=2*((2*(a/2)+1)*(a/2)) := by ring - rw [he,Int.mul_ediv_cancel_left _ (by norm_num : (2:Int)≠0)] + ∀ (a : Int), 2 * (a * (a - 1) / 2) = a * (a - 1) := by + exact DiamondQuadraticArithmetic.triangularScale private theorem tdiff : - (by - classical - exact - ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ((IntegerLatticeFunction) → ((Int) → ( - let k : Int := K.1 - (ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → ((∀ (a : Int), 2*(a*(a-1)/2)=a*(a-1)) → - (∀ (a : ℤ), a * (a - (1 : ℤ)) / (2 : ℤ) - (a - (1 : ℤ)) * (a - (2 : ℤ)) / (2 : ℤ) = a - - (1 : ℤ))))))) ) := by + (∀ (a : Int), 2 * (a * (a - 1) / 2) = a * (a - 1)) → + ∀ (a : Int), a * (a - 1) / 2 - (a - 1) * (a - 2) / 2 = a - 1 := by classical - intro K hk f B k p hcast tri a + intro tri a have h1 := tri a have h2 := tri (a-1) have he : 2*(a*(a-1)/2-(a-1)*(a-2)/2)=2*(a-1) := by @@ -394,16 +403,13 @@ private theorem tdiffRev : (by classical exact - (DiamondParameter) → - ( - ( - ( - ( - ((∀ (a : Int), - a*(a-1)/2-(a-1)*(a-2)/2=a-1) → (∀ (a : ℤ), (a - (1 : ℤ)) * (a - (2 : ℤ)) / (2 : ℤ) - - a * (a - (1 : ℤ)) / (2 : ℤ) = (1 : ℤ) - a)))))) ) := by + (∀ (a : Int), a * (a - 1) / 2 - (a - 1) * (a - 2) / 2 = a - 1) → + ∀ (a : ℤ), + (a - (1 : ℤ)) * (a - (2 : ℤ)) / (2 : ℤ) - a * (a - (1 : ℤ)) / (2 : ℤ) = + (1 : ℤ) - a + ) := by classical - intro K tdiff a + intro tdiff a have hh := tdiff a omega @@ -426,18 +432,24 @@ private theorem hPcenterQ : (by classical exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), - let k : Int := K.1 - let d : GaussianInt := ⟨k,k+1⟩ - let pred := P5352T2Sources K hk 3 - ∀ (p : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), ∀ (hpz : ⟨p, (2 : ℤ) * k + - (1 : ℤ) - p⟩ - d ∈ FootprintVertices pred.1), - let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 - ((Int.natAbs p : Int)=p) → (((Int.natAbs (p-1) : Int)=p-1) → (∀ (absKm : (Int.natAbs - (p-k) : Int)=k-p), DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q (p-k) - (k-p)))) := by + ∀ (K : DiamondParameter), + ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1; + let d : GaussianInt := ⟨k, k + 1⟩; + let pred := P5352T2Sources K hk 3; + ∀ (p : ℤ), + ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), + ⟨p, (2 : ℤ) * k + (1 : ℤ) - p⟩ - d ∈ FootprintVertices pred.1 → + let Q (a b : Int) : Int := + (Int.natAbs a : Int) * ((Int.natAbs a : Int) - 1) / 2 - + (a - b) ^ 2 / 4; + (Int.natAbs (p - 1) : Int) = p - 1 → + ∀ (absKm : (Int.natAbs (p - k) : Int) = k - p), + DiamondOdometer ⟨K.1 - 1, by omega⟩ ⟨p - k, k - p⟩ = + Q (p - k) (k - p) + ) := by classical - intro K hk k d pred p hcast hpz Q absP absPm absKm + intro K hk k d pred p hcast hpz Q absPm absKm have he : (⟨p,2*k+1-p⟩:GaussianInt)-d=⟨p-k,k-p⟩ := by ext <;> simp [d]; ring have hm : (⟨p-k,k-p⟩:GaussianInt) ∈ FootprintVertices (DiamondTile (K.1-1)) := by have hh := hpz @@ -736,7 +748,7 @@ theorem P5352T2Predecessor1 (K : DiamondParameter) (hk : 1 < K.1) have predMem (a b : Int) (hb0 : 0≤b) (hb1 : b≤2*(k-1)) (ha0 : -(k-1)≤a) (ha1 : a≤k-1) (hs0 : -b-1≤a) (hs1 : a≤b+1) - (ht0 : -(2*(k-1)-b+1)≤a) (ht1 : a≤2*(k-1)-b+1) := FirstPredecessorProof.predMem K hk p q + (ht0 : -(2*(k-1)-b+1)≤a) (ht1 : a≤2*(k-1)-b+1) := FirstPredecessorProof.predMem K hk hcast a b hb0 hb1 ha0 ha1 hs0 hs1 ht0 ht1 rcases hq with hqB | hqA · subst q @@ -755,7 +767,7 @@ theorem P5352T2Predecessor1 (K : DiamondParameter) (hk : 1 < K.1) have hEval (w : GaussianInt) (hw : w ∈ FootprintVertices (DiamondTile K.1)) := FirstPredecessorProof.hEval K hk f hchildTile hchild w hw have hdom := FirstPredecessorProof.hdom K hk hchildTile p hz - have hnot := FirstPredecessorProof.hnot K f p hcast hp1 hdpred + have hnot := FirstPredecessorProof.hnot K p hcast hp1 hdpred have htable := (DiamondLaplacianTable K).2.1 ⟨p,2*k-p⟩ hdom hnot have hvE : f (⟨p,2*k-p⟩+1)=DiamondOdometer K (⟨p,2*k-p⟩+1) := FirstPredecessorProof.hvE K f p hE hEval @@ -765,7 +777,7 @@ theorem P5352T2Predecessor1 (K : DiamondParameter) (hk : 1 < K.1) FirstPredecessorProof.hvN K f p hN hEval have hvS : f (⟨p,2*k-p⟩-⟨0,1⟩)=DiamondOdometer K (⟨p,2*k-p⟩-⟨0,1⟩) := FirstPredecessorProof.hvS K f p hS hEval - have hcomp := FirstPredecessorProof.hcompAt229 K hk f hchildTile p hcast hdpred + have hcomp := FirstPredecessorProof.hcompAt229 K hk hchildTile p hcast hdpred refine ⟨fun hc => (hcomp hc).elim, ?_⟩ intro _ rw [FourNeighborLaplacian,hvE,hvW,hvN,hvS,hcenter] @@ -812,11 +824,10 @@ theorem P5352T2Predecessor1 (K : DiamondParameter) (hk : 1 < K.1) simpa [Q] using (P5352T2DomainRows ⟨K.1-1,by omega⟩ ⟨p-k,k+1-p⟩).2 hPn -- The exact four increments follow by reducing the even and odd squares. have sqEven (m : Int) := EvenSquareQuotient.square m - have sqOdd (m : Int) := FirstPredecessorProof.sqOdd K m - have tri (a : Int) := FirstPredecessorProof.tri K hk f B p hcast a - have tdiff (a : Int) := FirstPredecessorProof.tdiff K hk f B - p hcast tri a - have tdiffRev (a : Int) := FirstPredecessorProof.tdiffRev K tdiff a + have sqOdd (m : Int) := FirstPredecessorProof.sqOdd m + have tri (a : Int) := FirstPredecessorProof.tri a + have tdiff (a : Int) := FirstPredecessorProof.tdiff tri a + have tdiffRev (a : Int) := FirstPredecessorProof.tdiffRev tdiff a have absP : (Int.natAbs p : Int)=p := by rw [Int.natCast_natAbs,abs_of_nonneg (by omega)] have absPm : (Int.natAbs (p-1) : Int)=p-1 := by rw [Int.natCast_natAbs,abs_of_nonneg (by omega)] @@ -824,7 +835,7 @@ theorem P5352T2Predecessor1 (K : DiamondParameter) (hk : 1 < K.1) rw [Int.natCast_natAbs,abs_of_nonpos (by omega)]; omega have qpc := FirstPredecessorProof.qpc K p sqEven absKm have hPcenterQ : DiamondOdometer (⟨K.1-1,by omega⟩) ⟨p-k,k-p⟩=Q (p-k) (k-p) := - FirstPredecessorProof.hPcenterQ K hk p hcast hpz absP absPm absKm + FirstPredecessorProof.hPcenterQ K hk p hcast hpz absPm absKm have hPcval : f ⟨p,2*k+1-p⟩=Q (p-k) (k-p)+k*p+B := by rw [hPcenter,hPcenterQ] have absKme := FirstPredecessorProof.absKme p k hpk diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean index 8d0c2ebe29..6e680d9c4b 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean @@ -5,6 +5,7 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.DiamondQuadraticArithmetic public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.EvenSquareQuotient public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacianProperties @@ -62,15 +63,23 @@ private theorem predFoot : (by classical exact - ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( - let k : Int := K.1 - (ℤ) → ((ℤ) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (∀ (w : GaussianInt), (0 : ℤ) ≤ - w.im ∧ w.im ≤ (2 : ℤ) * (k - (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ w.re ∧ w.re ≤ k - (1 : ℤ) ∧ - -w.im - (1 : ℤ) ≤ w.re ∧ w.re ≤ w.im + (1 : ℤ) ∧ -((2 : ℤ) * (k - (1 : ℤ)) - w.im + - (1 : ℤ)) ≤ w.re ∧ w.re ≤ (2 : ℤ) * (k - (1 : ℤ)) - w.im + (1 : ℤ) → w ∈ - FootprintVertices (DiamondTile (K.1 - (1 : ℕ))))))) ) := by + ∀ (K : DiamondParameter), + (1 : ℕ) < K.1 → + let k : Int := K.1; + (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ) → + ∀ (w : GaussianInt), + (0 : ℤ) ≤ w.im ∧ + w.im ≤ (2 : ℤ) * (k - (1 : ℤ)) ∧ + -(k - (1 : ℤ)) ≤ w.re ∧ + w.re ≤ k - (1 : ℤ) ∧ + -w.im - (1 : ℤ) ≤ w.re ∧ + w.re ≤ w.im + (1 : ℤ) ∧ + -((2 : ℤ) * (k - (1 : ℤ)) - w.im + (1 : ℤ)) ≤ w.re ∧ + w.re ≤ (2 : ℤ) * (k - (1 : ℤ)) - w.im + (1 : ℤ) → + w ∈ FootprintVertices (DiamondTile (K.1 - (1 : ℕ))) + ) := by classical - intro K hk k a b hcast w hw + intro K hk k hcast w hw apply (P5352T2DomainRows ⟨K.1-1,by omega⟩ w).1.mpr simpa [hcast] using hw @@ -78,37 +87,51 @@ private theorem predValue : (by classical exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), - let k : Int := K.1 - ∀ (a : ℤ), ∀ (b : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), - let Q : Int → Int → Int := fun x y => - (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 - ∀ (w : GaussianInt), (w∈FootprintVertices (DiamondTile (K.1-1))) → (DiamondOdometer - ⟨K.1-1,by omega⟩ w=Q w.re w.im)) := by + ∀ (K : DiamondParameter), + ∀ (hk : (1 : ℕ) < K.1), + let k : Int := K.1; + ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int) - 1) / 2 - (x - y) ^ 2 / 4 + ∀ (w : GaussianInt), + w ∈ FootprintVertices (DiamondTile (K.1 - 1)) → + DiamondOdometer ⟨K.1 - 1, by omega⟩ w = Q w.re w.im + ) := by classical - intro K hk k a b hcast Q w hw + intro K hk k hcast Q w hw simpa [Q] using (P5352T2DomainRows ⟨K.1-1,by omega⟩ w).2 hw private theorem predTranslatedValue : (by classical exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), ∀ (B : - Int), - let k : Int := K.1 - let d : GaussianInt := ⟨-k,k+1⟩ - let pred := P5352T2Sources K hk 3 - ∀ (hpred : ∀ (y : GaussianInt), y - d ∈ FootprintVertices pred.1 → f y = pred.2.1 (y - d) - + (⟨(1 : ℤ), -k⟩ : GaussianInt).re * y.re + (⟨(1 : ℤ), -k⟩ : GaussianInt).im * y.im + - B), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), - let Q : Int → Int → Int := fun x y => - (Int.natAbs x : Int) * ((Int.natAbs x : Int)-1)/2 - (x-y)^2/4 - (∀ (w : GaussianInt), (w∈FootprintVertices (DiamondTile (K.1-1))) → (DiamondOdometer - ⟨K.1-1,by omega⟩ w=Q w.re w.im)) → (∀ (y : GaussianInt), y - d ∈ FootprintVertices - (DiamondTile (K.1 - (1 : ℕ))) → f y = Q (y - d).re (y - d).im + y.re - k * y.im + B)) + ∀ (K : DiamondParameter), + ∀ (hk : (1 : ℕ) < K.1), + ∀ (f : IntegerLatticeFunction), + ∀ (B : Int), + let k : Int := K.1; + let d : GaussianInt := ⟨-k, k + 1⟩; + let pred := P5352T2Sources K hk 3; + (∀ (y : GaussianInt), + y - d ∈ FootprintVertices pred.1 → + f y = + pred.2.1 (y - d) + (⟨(1 : ℤ), -k⟩ : GaussianInt).re * y.re + + (⟨(1 : ℤ), -k⟩ : GaussianInt).im * y.im + + B) → + ∀ (hcast : (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)), + let Q : Int → Int → Int := fun x y => + (Int.natAbs x : Int) * ((Int.natAbs x : Int) - 1) / 2 - + (x - y) ^ 2 / 4 + (∀ (w : GaussianInt), + w ∈ FootprintVertices (DiamondTile (K.1 - 1)) → + DiamondOdometer ⟨K.1 - 1, by omega⟩ w = Q w.re w.im) → + ∀ (y : GaussianInt), + y - d ∈ FootprintVertices (DiamondTile (K.1 - (1 : ℕ))) → + f y = Q (y - d).re (y - d).im + y.re - k * y.im + B + ) := by classical - intro K hk f B k d pred hpred a b hcast Q predValue y hy + intro K hk f B k d pred hpred hcast Q predValue y hy have hp : y-d∈FootprintVertices pred.1 := by simpa [pred,P5352T2Sources] using hy have heq := hpred y hp @@ -122,32 +145,21 @@ private theorem tri : (by classical exact - (DiamondParameter) → ((ℤ) → ((ℤ) → ( - let T : Int → Int := fun n => n*(n-1)/2 - ∀ (n : ℤ), (2 : ℤ) * T n = n * (n - (1 : ℤ))))) ) := by - classical - intro K a b T n - dsimp [T] - rcases Int.emod_two_eq_zero_or_one n with h|h - · have hn : n=2*(n/2) := by omega - rw [hn] - have he : 2*(n/2)*(2*(n/2)-1)=2*((n/2)*(2*(n/2)-1)) := by ring - rw [he,Int.mul_ediv_cancel_left _ (by norm_num : (2:Int)≠0)] - · have hn : n=2*(n/2)+1 := by omega - rw [hn] - have he : (2*(n/2)+1)*(2*(n/2)+1-1)= - 2*((2*(n/2)+1)*(n/2)) := by ring - rw [he,Int.mul_ediv_cancel_left _ (by norm_num : (2:Int)≠0)] + let T : Int → Int := fun n => n * (n - 1) / 2 + ∀ (n : ℤ), (2 : ℤ) * T n = n * (n - (1 : ℤ)) + ) := by + exact DiamondQuadraticArithmetic.triangularScale private theorem tdiff : (by classical exact - (DiamondParameter) → ((ℤ) → ((ℤ) → ( - let T : Int → Int := fun n => n*(n-1)/2 - (∀ (n : Int), 2*T n=n*(n-1)) → (∀ (n : ℤ), T n - T (n - (1 : ℤ)) = n - (1 : ℤ))))) ) := by + let T : Int → Int := fun n => n * (n - 1) / 2 + (∀ (n : Int), 2 * T n = n * (n - 1)) → + ∀ (n : ℤ), T n - T (n - (1 : ℤ)) = n - (1 : ℤ) + ) := by classical - intro K a b T tri n + intro T tri n have h1 := tri n have h2 := tri (n-1) have h : 2 * (T n - T (n - 1)) = 2 * (n - 1) := by @@ -159,12 +171,12 @@ private theorem tdiffRev : (by classical exact - (DiamondParameter) → ((ℤ) → ((ℤ) → ( - let T : Int → Int := fun n => n*(n-1)/2 - (∀ (n : Int), T n - T (n - 1) = n - 1) → (∀ (n : ℤ), T (n - (1 : ℤ)) - T n = (1 : ℤ) - - n)))) ) := by + let T : Int → Int := fun n => n * (n - 1) / 2 + (∀ (n : Int), T n - T (n - 1) = n - 1) → + ∀ (n : ℤ), T (n - (1 : ℤ)) - T n = (1 : ℤ) - n + ) := by classical - intro K a b T tdiff n + intro T tdiff n have h := tdiff n omega @@ -173,10 +185,10 @@ private theorem floorOdd : (by classical exact - (DiamondParameter) → ((ℤ) → ((ℤ) → (∀ (m : ℤ), ((2 : ℤ) * m + (1 : ℤ)) ^ (2 : ℕ) / (4 : - ℤ) = m ^ (2 : ℕ) + m))) ) := by + ∀ (m : ℤ), ((2 : ℤ) * m + (1 : ℤ)) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) + m + ) := by classical - intro K a b m + intro m have h := P4207T1FloorArithmetic.1 1 m have he : 1+2*m=2*m+1 := by ring rw [he] at h @@ -915,21 +927,21 @@ theorem P5352T2Predecessor2 (K : DiamondParameter) (hk : 1 < K.1) have predFoot (w : GaussianInt) (hw : 0≤w.im ∧ w.im≤2*(k-1) ∧ -(k-1)≤w.re ∧ w.re≤k-1 ∧ -w.im-1≤w.re ∧ w.re≤w.im+1 ∧ - -(2*(k-1)-w.im+1)≤w.re ∧ w.re≤2*(k-1)-w.im+1) := SecondPredecessorProof.predFoot K hk a b + -(2*(k-1)-w.im+1)≤w.re ∧ w.re≤2*(k-1)-w.im+1) := SecondPredecessorProof.predFoot K hk hcast w hw have predValue (w : GaussianInt) - (hw : w∈FootprintVertices (DiamondTile (K.1-1))) := SecondPredecessorProof.predValue K hk a - b hcast w hw + (hw : w∈FootprintVertices (DiamondTile (K.1-1))) := SecondPredecessorProof.predValue K + hk hcast w hw have predTranslatedValue (y : GaussianInt) (hy : y-d∈FootprintVertices (DiamondTile (K.1-1))) := SecondPredecessorProof.predTranslatedValue K hk - f B hpred a b hcast predValue y hy + f B hpred hcast predValue y hy let T : Int → Int := fun n => n*(n-1)/2 - have tri (n : Int) := SecondPredecessorProof.tri K a b n - have tdiff (n : Int) := SecondPredecessorProof.tdiff K a b tri n - have tdiffRev (n : Int) := SecondPredecessorProof.tdiffRev K a b tdiff n + have tri (n : Int) := SecondPredecessorProof.tri n + have tdiff (n : Int) := SecondPredecessorProof.tdiff tri n + have tdiffRev (n : Int) := SecondPredecessorProof.tdiffRev tdiff n have floorEven (m : Int) := EvenSquareQuotient.square m - have floorOdd (m : Int) := SecondPredecessorProof.floorOdd K a b m + have floorOdd (m : Int) := SecondPredecessorProof.floorOdd m have ht := SecondPredecessorProof.ht K a b hdpred hcast hdchild rcases ht with ⟨ht1,htk,hb⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean index ad0d60dcb2..77dd19c699 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean @@ -5,6 +5,7 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.DiamondQuadraticArithmetic public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData @@ -157,10 +158,10 @@ private theorem floorOdd : (by classical exact - (DiamondParameter) → (∀ (m : ℤ), ((1 : ℤ) - (2 : ℤ) * m) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : - ℕ) - m) ) := by + ∀ (m : ℤ), ((1 : ℤ) - (2 : ℤ) * m) ^ (2 : ℕ) / (4 : ℤ) = m ^ (2 : ℕ) - m + ) := by classical - intro K m + intro m have h := P4207T1FloorArithmetic.1 1 (-m) have he : 1+2*(-m) = 1-2*m := by ring rw [he] at h @@ -172,18 +173,32 @@ private theorem cases : classical exact ∀ (K : DiamondParameter), - let k : Int := K.1 - (((K.1-1 : Nat) : Int) = k-1) → (∀ (a : ℤ), ∀ (b : ℤ), ((0 : ℤ) ≤ b ∧ b ≤ (2 : ℤ) * (↑K.1 - : ℤ) ∧ -(↑K.1 : ℤ) ≤ a ∧ a ≤ (↑K.1 : ℤ) ∧ -b - (1 : ℤ) ≤ a ∧ a ≤ b + (1 : ℤ) ∧ -((2 : - ℤ) * (↑K.1 : ℤ) - b + (1 : ℤ)) ≤ a ∧ a ≤ (2 : ℤ) * (↑K.1 : ℤ) - b + (1 : ℤ)) → (((0 : - ℤ) ≤ b - ((1 : ℤ) - k) ∧ b - ((1 : ℤ) - k) ≤ (2 : ℤ) * (k - (1 : ℤ)) ∧ -(k - (1 : ℤ)) - ≤ a - -k ∧ a - -k ≤ k - (1 : ℤ) ∧ -(b - ((1 : ℤ) - k)) - (1 : ℤ) ≤ a - -k ∧ a - -k ≤ - b - ((1 : ℤ) - k) + (1 : ℤ) ∧ -((2 : ℤ) * (k - (1 : ℤ)) - (b - ((1 : ℤ) - k)) + (1 : - ℤ)) ≤ a - -k ∧ a - -k ≤ (2 : ℤ) * (k - (1 : ℤ)) - (b - ((1 : ℤ) - k)) + (1 : ℤ)) → - ((∃ t : Int, 1 ≤ t ∧ t ≤ k ∧ a = -t ∧ b = t-1) ∨ (∃ t : Int, 1 ≤ t ∧ t < k ∧ a = -t ∧ - b = t)))) ) := by - classical - intro K k hkm a b hc hp + let k : Int := K.1; + ∀ (a : ℤ), + ∀ (b : ℤ), + (0 : ℤ) ≤ b ∧ + b ≤ (2 : ℤ) * (↑K.1 : ℤ) ∧ + -(↑K.1 : ℤ) ≤ a ∧ + a ≤ (↑K.1 : ℤ) ∧ + -b - (1 : ℤ) ≤ a ∧ + a ≤ b + (1 : ℤ) ∧ + -((2 : ℤ) * (↑K.1 : ℤ) - b + (1 : ℤ)) ≤ a ∧ + a ≤ (2 : ℤ) * (↑K.1 : ℤ) - b + (1 : ℤ) → + (0 : ℤ) ≤ b - ((1 : ℤ) - k) ∧ + b - ((1 : ℤ) - k) ≤ (2 : ℤ) * (k - (1 : ℤ)) ∧ + -(k - (1 : ℤ)) ≤ a - -k ∧ + a - -k ≤ k - (1 : ℤ) ∧ + -(b - ((1 : ℤ) - k)) - (1 : ℤ) ≤ a - -k ∧ + a - -k ≤ b - ((1 : ℤ) - k) + (1 : ℤ) ∧ + -((2 : ℤ) * (k - (1 : ℤ)) - (b - ((1 : ℤ) - k)) + (1 : ℤ)) ≤ + a - -k ∧ + a - -k ≤ + (2 : ℤ) * (k - (1 : ℤ)) - (b - ((1 : ℤ) - k)) + (1 : ℤ) → + (∃ t : Int, 1 ≤ t ∧ t ≤ k ∧ a = -t ∧ b = t - 1) ∨ + ∃ t : Int, 1 ≤ t ∧ t < k ∧ a = -t ∧ b = t + ) := by + classical + intro K k a b hc hp have hs : a+b=-1 ∨ a+b=0 := by omega rcases hs with hs | hs · left @@ -352,20 +367,9 @@ private theorem tri : (by classical exact - (DiamondParameter) → ((IntegerLatticeFunction) → ((Int) → ((ℤ) → (∀ (n : ℤ), (2 : ℤ) * (n - * (n - (1 : ℤ)) / (2 : ℤ)) = n * (n - (1 : ℤ)))))) ) := by - classical - intro K f B t n - rcases Int.emod_two_eq_zero_or_one n with h | h - · have hn : n=2*(n/2) := by omega - rw [hn] - have he : 2*(n/2)*(2*(n/2)-1)=2*((n/2)*(2*(n/2)-1)) := by ring - rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] - · have hn : n=2*(n/2)+1 := by omega - rw [hn] - have he : (2*(n/2)+1)*(2*(n/2)+1-1)= - 2*((2*(n/2)+1)*(n/2)) := by ring - rw [he, Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + ∀ (n : ℤ), (2 : ℤ) * (n * (n - (1 : ℤ)) / (2 : ℤ)) = n * (n - (1 : ℤ)) + ) := by + exact DiamondQuadraticArithmetic.triangularScale private theorem tdiff : (by @@ -496,18 +500,20 @@ private theorem qPredWlt : (by classical exact - ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), - let k : Int := K.1; - let Q : Int → Int → Int := fun a b => - (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4; - ((∀ (m : Int), (1-2*m)^2/4 = m^2-m) → (∀ (t : ℤ), - ( - ((f (⟨-t-1,t-1⟩ - : GaussianInt) = Q (k-t-1) (k+t-2) + (1-k)*(-t-1) - (t-1)+B) → (t < k → Q (k - t - (1 - : ℤ)) (k + t - (2 : ℤ)) = (k - t - (1 : ℤ)) * (k - t - (2 : ℤ)) / (2 : ℤ) - (t * t - - t)))))) ) := by - classical - intro K f B k Q floorOdd t hPredW ht + ∀ (K : DiamondParameter), + IntegerLatticeFunction → + Int → + let k : Int := K.1; + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int) - 1) / 2 - (a - b) ^ 2 / 4; + (∀ (m : Int), (1 - 2 * m) ^ 2 / 4 = m ^ 2 - m) → + ∀ (t : ℤ), + t < k → + Q (k - t - (1 : ℤ)) (k + t - (2 : ℤ)) = + (k - t - (1 : ℤ)) * (k - t - (2 : ℤ)) / (2 : ℤ) - (t * t - t) + ) := by + classical + intro K f B k Q floorOdd t ht simp only [Q, Int.natCast_natAbs] rw [abs_of_nonneg (by omega : 0 ≤ k-t-1)] rw [show (k-t-1)-(k+t-2)=1-2*t by ring, floorOdd] @@ -754,11 +760,12 @@ private theorem huK : (by classical exact - ∀ (K : DiamondParameter), (IntegerLatticeFunction) → ( - let k : Int := K.1 - (((K.1-1 : Nat) : Int) = k-1) → (∀ (u : ℤ), (u < k) → (u ≤ (K.1 : Int)))) ) := by + ∀ (K : DiamondParameter), + let k : Int := K.1; + ∀ (u : ℤ), u < k → u ≤ (K.1 : Int) + ) := by classical - intro K f k hkm u huk + intro K k u huk have huK' : u ≤ k := by omega exact_mod_cast huK' @@ -766,10 +773,10 @@ private theorem habsA : (by classical exact - (DiamondParameter) → ((IntegerLatticeFunction) → (∀ (u : ℤ), ((1 : ℤ) ≤ u) → ((Int.natAbs - (-u) : Int) = u))) ) := by + ∀ (u : ℤ), (1 : ℤ) ≤ u → (Int.natAbs (-u) : Int) = u + ) := by classical - intro K f u hu1 + intro u hu1 rw [Int.natCast_natAbs, abs_of_nonpos (by omega : -u ≤ 0)] ring @@ -882,7 +889,7 @@ theorem P5352T2Predecessor3 (K : DiamondParameter) (hk : 1 < K.1) (hy : y-d ∈ FootprintVertices (DiamondTile (K.1-1))) := FourthPredecessorCases.predTranslatedValue K hk f B hpred hpredTile predValue y hy have floorEven (m : Int) := FourthPredecessorCases.floorEven m - have floorOdd (m : Int) := FourthPredecessorCases.floorOdd K m + have floorOdd (m : Int) := FourthPredecessorCases.floorOdd m rcases z with ⟨a,b⟩ have hc := (P5352T2DomainRows K ⟨a,b⟩).1.mp (by simpa [hchildTile] using hz) have hp := (P5352T2DomainRows ⟨K.1-1, by omega⟩ (⟨a,b⟩-d)).1.mp (by @@ -890,7 +897,7 @@ theorem P5352T2Predecessor3 (K : DiamondParameter) (hk : 1 < K.1) rw [hkm] at hp simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, d] at hp simp only [] at hc - have cases := FourthPredecessorCases.cases K hkm a b hc hp + have cases := FourthPredecessorCases.cases K a b hc hp rcases cases with ⟨t, ht1, htk, ha0, hb0⟩ | ⟨u, hu1, huk, ha0, hb0⟩ · -- A_t = (-t,t-1) subst a @@ -916,7 +923,7 @@ theorem P5352T2Predecessor3 (K : DiamondParameter) (hk : 1 < K.1) K f B predTranslatedValue t hPC have hPredW := FourthPredecessorCases.hPredW K f B predTranslatedValue t hPW have hPredS := FourthPredecessorCases.hPredS K f B predTranslatedValue t hPS - have tri (n : Int) := FourthPredecessorCases.tri K f B t n + have tri (n : Int) := FourthPredecessorCases.tri n have tdiff (n : Int) := FourthPredecessorCases.tdiff tri n have qChildC := FourthPredecessorCases.qChildC K f B floorOdd t ht1 hChildC hPredC hPredW tri have qChildE := FourthPredecessorCases.qChildE K f B floorEven t ht1 hChildC hPredC hPredW @@ -924,7 +931,7 @@ theorem P5352T2Predecessor3 (K : DiamondParameter) (hk : 1 < K.1) have qChildN := FourthPredecessorCases.qChildN K f B floorEven t ht1 hChildC hPredC hPredW tri tdiff have qPredC := FourthPredecessorCases.qPredC K f B floorEven t htk hChildC hPredC hPredW - have qPredWlt (ht : t simp [x] have hs : x-⟨0,1⟩ = (⟨-u,u-1⟩ : GaussianInt) := by ext <;> simp [x] have hLap := FourthPredecessorCases.hLap K f u h0 h1 h2 h3 h4 he hw hn hs - have huK := FourthPredecessorCases.huK K f hkm u huk + have huK := FourthPredecessorCases.huK K u huk have hFalse : x ∈ DiamondVertexDomains K false := by exact hFoot ▸ hX - have habsA := FourthPredecessorCases.habsA K f u hu1 + have habsA := FourthPredecessorCases.habsA u hu1 have hle : u-(K.1:Int) ≤ 0 := by rw [hkc]; omega have habsB := FourthPredecessorCases.habsB K hkc u hle have hNotTrue := FourthPredecessorCases.hNotTrue K hkm u habsA habsB diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean b/LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean index 204275fe27..e7fed50b54 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean @@ -239,16 +239,18 @@ private theorem hparent : (by classical exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), (∀ y ∈ - FootprintVertices (P5352T2Sources K hk (0 : Fin (4 : ℕ))).1, f y = - (P5352T2Sources K hk (0 : Fin (4 : ℕ))).2.1 y) → ( - let Q (x : GaussianInt) : Int := - (Int.natAbs x.re : Int) * ((Int.natAbs x.re : Int)-1)/2 - - (x.re-x.im)^2/4 - ((P5352T2Sources K hk 0).1 = DiamondTile K.1) → (∀ w ∈ FootprintVertices (DiamondTile - K.1), f w = Q w)) ) := by + ∀ (K : DiamondParameter), + ∀ (hk : (1 : ℕ) < K.1), + ∀ (f : IntegerLatticeFunction), + (∀ y ∈ FootprintVertices (P5352T2Sources K hk (0 : Fin (4 : ℕ))).1, + f y = (P5352T2Sources K hk (0 : Fin (4 : ℕ))).2.1 y) → + let Q (x : GaussianInt) : Int := + (Int.natAbs x.re : Int) * ((Int.natAbs x.re : Int) - 1) / 2 - + (x.re - x.im) ^ 2 / 4; + ∀ w ∈ FootprintVertices (DiamondTile K.1), f w = Q w + ) := by classical - intro K hk f hC Q hA w hw + intro K hk f hC Q w hw have hv := hC w hw have hval := (P5352T2DomainRows K w).2 hw simpa [P5352T2Sources, Q] using hv.trans hval @@ -312,11 +314,13 @@ private theorem hsq1 : (by classical exact - ∀ (K : DiamondParameter), (IntegerLatticeFunction) → ((Int) → (∀ (z : GaussianInt), - let n : Int := K.1 - (z.re = n) → ((1-2*n)^2/4 = n^2-n))) ) := by + ∀ (K : DiamondParameter), + GaussianInt → + let n : Int := K.1; + (1 - 2 * n) ^ 2 / 4 = n ^ 2 - n + ) := by classical - intro K f B z n hzr + intro K z n have h := P4207T1FloorArithmetic.1 1 (-n) norm_num at h ⊢ rw [show 1 + -(2*n) = 1-2*n by ring] at h @@ -394,23 +398,43 @@ private theorem hLap : (by classical exact - ∀ (K : DiamondParameter), ∀ (f : IntegerLatticeFunction), ∀ (B : Int), ∀ (z : GaussianInt), - let n : Int := K.1 - let M : GaussianInt := ⟨2*n, 0⟩ - let Q (x : GaussianInt) : Int := - (Int.natAbs x.re : Int) * ((Int.natAbs x.re : Int)-1)/2 - - (x.re-x.im)^2/4 - (z.re = n) → ((z = ⟨n,n⟩) → ((z-1 = ⟨n-1,n⟩) → ((z+⟨0,1⟩ = ⟨n,n+1⟩) → ((z-⟨0,1⟩ = - ⟨n,n-1⟩) → ((z+1 = ⟨n+1,n⟩) → ((f z = Q z) → ((f (z-1) = Q (z-1)) → ((f (z+⟨0,1⟩) = Q - (z+⟨0,1⟩)) → ((f (z-⟨0,1⟩) = Q (z-⟨0,1⟩)) → ((f z = Q (z-M) + (n-1)*z.re + n*z.im + - B) → ((f (z+1) = Q ((z+1)-M) + (n-1)*(z+1).re + n*(z+1).im + B) → ((Q ⟨n,n⟩ = - n*(n-1)/2) → ((Q ⟨n-1,n⟩ = (n-1)*(n-2)/2) → ((Q ⟨n,n+1⟩ = n*(n-1)/2) → ((Q ⟨n,n-1⟩ = - n*(n-1)/2) → (((1-2*n)^2/4 = n^2-n) → (((-n-n)^2/4 = n^2) → (((1-n-n)^2/4 = n^2-n) → - ((Q ⟨-n,n⟩ = n*(n-1)/2-n^2) → ((Q ⟨1-n,n⟩ = (n-1)*(n-2)/2-(n^2-n)) → ((z-M = ⟨-n,n⟩) - → (((z+1)-M = ⟨1-n,n⟩) → (FourNeighborLaplacian f z = 1))))))))))))))))))))))) ) := by + ∀ (K : DiamondParameter), + ∀ (f : IntegerLatticeFunction), + ∀ (B : Int), + ∀ (z : GaussianInt), + let n : Int := K.1; + let M : GaussianInt := ⟨2 * n, 0⟩; + let Q (x : GaussianInt) : Int := + (Int.natAbs x.re : Int) * ((Int.natAbs x.re : Int) - 1) / 2 - + (x.re - x.im) ^ 2 / 4; + z = ⟨n, n⟩ → + z - 1 = ⟨n - 1, n⟩ → + z + ⟨0, 1⟩ = ⟨n, n + 1⟩ → + z - ⟨0, 1⟩ = ⟨n, n - 1⟩ → + z + 1 = ⟨n + 1, n⟩ → + f z = Q z → + f (z - 1) = Q (z - 1) → + f (z + ⟨0, 1⟩) = Q (z + ⟨0, 1⟩) → + f (z - ⟨0, 1⟩) = Q (z - ⟨0, 1⟩) → + f z = Q (z - M) + (n - 1) * z.re + n * z.im + B → + f (z + 1) = + Q (z + 1 - M) + (n - 1) * (z + 1).re + n * (z + 1).im + + B → + Q ⟨n, n⟩ = n * (n - 1) / 2 → + Q ⟨n - 1, n⟩ = (n - 1) * (n - 2) / 2 → + Q ⟨n, n + 1⟩ = n * (n - 1) / 2 → + Q ⟨n, n - 1⟩ = n * (n - 1) / 2 → + (1 - 2 * n) ^ 2 / 4 = n ^ 2 - n → + (-n - n) ^ 2 / 4 = n ^ 2 → + (1 - n - n) ^ 2 / 4 = n ^ 2 - n → + Q ⟨-n, n⟩ = n * (n - 1) / 2 - n ^ 2 → + Q ⟨1 - n, n⟩ = (n - 1) * (n - 2) / 2 - (n ^ 2 - n) → + z - M = ⟨-n, n⟩ → + z + 1 - M = ⟨1 - n, n⟩ → FourNeighborLaplacian f z = 1 + ) := by classical - intro K f B z n M Q hzr hzc hWc hNc hSc hEc hfCenter hfWest hfNorth hfSouth hfChildCenter - hfEast qCenter qWest qNorth qSouth hsq1 hsq0' hsq1' qChildCenter qChildEast hChildCenter + intro K f B z n M Q hzc hWc hNc hSc hEc hfCenter hfWest hfNorth hfSouth hfChildCenter hfEast + qCenter qWest qNorth qSouth hsq1 hsq0' hsq1' qChildCenter qChildEast hChildCenter hChildEast have hB : B = n-n^2 := by rw [hfCenter] at hfChildCenter @@ -518,7 +542,7 @@ theorem P5352T2RightHorizontal (K : DiamondParameter) (hk : 1 < K.1) simpa [hA, hM] using hzM have hchildEast := DiamondRightHorizontal.hchildEast K hk z hzr foot hEc have hparent (w : GaussianInt) (hw : w ∈ FootprintVertices (DiamondTile K.1)) : - f w = Q w := DiamondRightHorizontal.hparent K hk f hC hA w hw + f w = Q w := DiamondRightHorizontal.hparent K hk f hC w hw have hfCenter : f z = Q z := hparent z (by simpa [hA] using hz) have hfWest : f (z-1) = Q (z-1) := hparent (z-1) hw have hfNorth : f (z+⟨0,1⟩) = Q (z+⟨0,1⟩) := hparent _ hnorth @@ -535,14 +559,14 @@ theorem P5352T2RightHorizontal (K : DiamondParameter) (hk : 1 < K.1) simp [Q, abs_of_nonneg (show 0 ≤ n by omega)] have hsq0 : (-2*n)^2/4 = n^2 := by simpa using (P4207T1FloorArithmetic.1 0 (-n)) - have hsq1 := DiamondRightHorizontal.hsq1 K f B z hzr + have hsq1 := DiamondRightHorizontal.hsq1 K z have hsq0' := DiamondRightHorizontal.hsq0' K hsq0 have hsq1' := DiamondRightHorizontal.hsq1' K hsq1 have qChildCenter := DiamondRightHorizontal.qChildCenter K hk z hzr hsq1 hsq0' hsq1' have qChildEast := DiamondRightHorizontal.qChildEast K hk z hzr hsq1 hsq0' hsq1' have hChildCenter : z-M = ⟨-n,n⟩ := by rw [hzc]; ext <;> simp [M]; ring have hChildEast : (z+1)-M = ⟨1-n,n⟩ := by rw [hzc]; ext <;> simp [M]; ring - have hLap := DiamondRightHorizontal.hLap K f B z hzr hzc hWc hNc hSc hEc hfCenter hfWest + have hLap := DiamondRightHorizontal.hLap K f B z hzc hWc hNc hSc hEc hfCenter hfWest hfNorth hfSouth hfChildCenter hfEast qCenter qWest qNorth qSouth hsq1 hsq0' hsq1' qChildCenter qChildEast hChildCenter hChildEast refine ⟨?_, ?_⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean index 839d53df1f..cb20179a5f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean +++ b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean @@ -103,11 +103,11 @@ private theorem Normalize : · funext k; fin_cases k <;> rfl private theorem noMix : - (Fin 4 → CircleCoordinates) → ((Fin 3) → (∀ z s r p, ProperBandQuadruple p → ∀ r', - P4828T1Rotate (P4828T1Root z s) r = - P4828T1Rotate (P4828T1Step p) r' → False)) := by + ∀ z s r p, + ProperBandQuadruple p → + ∀ r', P4828T1Rotate (P4828T1Root z s) r = P4828T1Rotate (P4828T1Step p) r' → False := by classical - intro q i z s r p hp r' heq + intro z s r p hp r' heq have hc := congrArg (fun x : Fin 4 → CircleCoordinates => (x 0).1) heq simp only [P4828T1Rotate, Fin.cases_zero] at hc have hg := P5455T2CurvatureGrowth p hp @@ -336,7 +336,7 @@ theorem P5455T2OccurrenceDeterministic OccurrenceDeterministicProof.Normalize have noMix : ∀ z s r p, ProperBandQuadruple p → ∀ r', P4828T1Rotate (P4828T1Root z s) r = - P4828T1Rotate (P4828T1Step p) r' → False := OccurrenceDeterministicProof.noMix q i + P4828T1Rotate (P4828T1Step p) r' → False := OccurrenceDeterministicProof.noMix have rotUnique : ∀ t, ProperBandQuadruple t → ∀ r r', P4828T1Rotate t r = P4828T1Rotate t r' → r = r' := OccurrenceDeterministicProof.rotUnique have main : ∀ n : Nat, ∀ q : Fin 4 → CircleCoordinates, diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean index fb9f07461b..735413223d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean @@ -31,19 +31,9 @@ private theorem tri : (by classical exact - (DiamondParameter) → (∀ (a : ℤ), (2 : ℤ) * (a * (a - (1 : ℤ)) / (2 : ℤ)) = a * (a - (1 : - ℤ))) ) := by - classical - intro K a - rcases Int.emod_two_eq_zero_or_one a with h | h - · have ha : a = 2*(a/2) := by omega - rw [ha, show 2*(a/2)*(2*(a/2)-1) = - 2*((a/2)*(2*(a/2)-1)) by ring, - Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] - · have ha : a = 2*(a/2)+1 := by omega - rw [ha, show (2*(a/2)+1)*(2*(a/2)+1-1) = - 2*((2*(a/2)+1)*(a/2)) by ring, - Int.mul_ediv_cancel_left _ (by norm_num : (2:Int) ≠ 0)] + ∀ (a : ℤ), (2 : ℤ) * (a * (a - (1 : ℤ)) / (2 : ℤ)) = a * (a - (1 : ℤ)) + ) := by + exact DiamondQuadraticArithmetic.triangularScale private theorem hposResult : (by @@ -660,7 +650,7 @@ theorem P5491T1DiamondRightBoundary (K : DiamondParameter) (hk : 1 < K.1) let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 - have tri (a : Int) : 2*(a*(a-1)/2) = a*(a-1) := DiamondRightBoundaryProof.tri K a + have tri (a : Int) : 2*(a*(a-1)/2) = a*(a-1) := DiamondRightBoundaryProof.tri a have square (a : Int) : 4*(a^2/4) = a^2-a%2 := DiamondQuadraticArithmetic.squareScale a have scale (a b : Int) := DiamondQuadraticArithmetic.quadraticScale tri square a b have foot (z : GaussianInt) := DiamondBoundaryDetails.foot K z diff --git a/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean b/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean index 5c24fc0907..e87384867c 100644 --- a/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean +++ b/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeTileNonempty public import LeanPool.ApollonianSuperharmonic.CurvatureOneBandCircleClassification public import LeanPool.ApollonianSuperharmonic.P3996T1AdjacentParentPlacement @@ -35,24 +36,51 @@ private theorem hdata : (by classical exact - ∀ (C : BandCircle), ∀ (T₁ : ProtoTile), ∀ (T₂ : ProtoTile), (ℕ) → ((C.1.1.1 = (1 : ℤ)) → - (∀ (p₁ : ℝ × ℝ), ∀ (p₂ : ℝ × ℝ), ((C.1.1.1 = (1 : ℤ) ∧ ∃ (orientation : Bool) (v : - GaussianInt), UnitTriangularStep orientation v ∧ TileCentroid T₂ - TileCentroid T₁ = - GaussianRealPoint v ∧ p₂.1 - p₁.1 = CircleMatrix C (0 : Fin (2 : ℕ)) (0 : Fin (2 : - ℕ)) * (↑v.re : ℝ) + CircleMatrix C (0 : Fin (2 : ℕ)) (1 : Fin (2 : ℕ)) * (↑v.im : ℝ) - ∧ p₂.2 - p₁.2 = CircleMatrix C (1 : Fin (2 : ℕ)) (0 : Fin (2 : ℕ)) * (↑v.re : ℝ) + - CircleMatrix C (1 : Fin (2 : ℕ)) (1 : Fin (2 : ℕ)) * (↑v.im : ℝ)) ∨ ∃ (q : Fin (4 : - ℕ) → CircleCoordinates) (i : Fin (3 : ℕ)) (e : Bool), ProperBandQuadruple q ∧ q (0 : - Fin (4 : ℕ)) = C.1.1 ∧ TileCentroid T₂ - TileCentroid T₁ = (if e = true then (1 : ℝ) - else (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) ∧ - p₂.1 - p₁.1 = (if e = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 (q i.succ) - (q (0 : Fin (4 : ℕ)))).re : ℝ) ∧ p₂.2 - p₁.2 = (if e = true then (1 : ℝ) else (-1 : - ℝ)) * (↑(BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))).im : ℝ)) → (∃ v : - GaussianInt, TileCentroid T₂ - TileCentroid T₁ = GaussianRealPoint v ∧ p₂.1-p₁.1 = - CircleMatrix C 0 0*v.re + CircleMatrix C 0 1*v.im ∧ p₂.2-p₁.2 = CircleMatrix C 1 - 0*v.re + CircleMatrix C 1 1*v.im))) ) := by + ∀ (C : BandCircle), + ∀ (T₁ : ProtoTile), + ∀ (T₂ : ProtoTile), + C.1.1.1 = (1 : ℤ) → + ∀ (p₁ : ℝ × ℝ), + ∀ (p₂ : ℝ × ℝ), + ((C.1.1.1 = (1 : ℤ) ∧ + ∃ (orientation : Bool) (v : GaussianInt), + UnitTriangularStep orientation v ∧ + TileCentroid T₂ - TileCentroid T₁ = GaussianRealPoint v ∧ + p₂.1 - p₁.1 = + CircleMatrix C (0 : Fin (2 : ℕ)) (0 : Fin (2 : ℕ)) * + (↑v.re : ℝ) + + CircleMatrix C (0 : Fin (2 : ℕ)) (1 : Fin (2 : ℕ)) * + (↑v.im : ℝ) ∧ + p₂.2 - p₁.2 = + CircleMatrix C (1 : Fin (2 : ℕ)) (0 : Fin (2 : ℕ)) * + (↑v.re : ℝ) + + CircleMatrix C (1 : Fin (2 : ℕ)) (1 : Fin (2 : ℕ)) * + (↑v.im : ℝ)) ∨ + ∃ (q : Fin (4 : ℕ) → CircleCoordinates) (i : Fin (3 : ℕ)) (e : + Bool), + ProperBandQuadruple q ∧ + q (0 : Fin (4 : ℕ)) = C.1.1 ∧ + TileCentroid T₂ - TileCentroid T₁ = + (if e = true then (1 : ℝ) else (-1 : ℝ)) • + GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) ∧ + p₂.1 - p₁.1 = + (if e = true then (1 : ℝ) else (-1 : ℝ)) * + (↑(BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))).re : + ℝ) ∧ + p₂.2 - p₁.2 = + (if e = true then (1 : ℝ) else (-1 : ℝ)) * + (↑(BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))).im : + ℝ)) → + ∃ v : GaussianInt, + TileCentroid T₂ - TileCentroid T₁ = GaussianRealPoint v ∧ + p₂.1 - p₁.1 = + CircleMatrix C 0 0 * v.re + CircleMatrix C 0 1 * v.im ∧ + p₂.2 - p₁.2 = + CircleMatrix C 1 0 * v.re + CircleMatrix C 1 1 * v.im + ) := by classical - intro C T₁ T₂ n hc p₁ p₂ hstep + intro C T₁ T₂ hc p₁ p₂ hstep rcases hstep with ⟨_, orientation, v, _, hv, hr, hi⟩ | ⟨q,i,e,hq,hqC,_⟩ · exact ⟨v,hv,hr,hi⟩ · have hqone : (q 0).1 = 1 := by rw [hqC, hc] @@ -202,26 +230,47 @@ private theorem translationAt244 : (by classical exact - ∀ (C : BandCircle), (IntegerLatticeFunction) → (∀ (x : GaussianInt), (C.1.1.1 = (1 : - ℤ)) → (∀ (z : GaussianInt), (CircleMatrix C = ![![(↑((1 : ℤ) + z.re) : ℝ), (↑z.im : - ℝ)], ![(↑z.im : ℝ), -(↑z.re : ℝ)]]) → (( - let g := fun (x : GaussianInt) => ((1 : ℤ) + z.re) * (x.re * (x.re - (1 : ℤ)) / (2 : ℤ)) - - z.re * (x.im * (x.im - (1 : ℤ)) / (2 : ℤ)) + z.im * x.re * x.im; - let T := (⟨{(0 : LatticeCell)}, (0 : GaussianInt)⟩ : ProtoTile); - let h := CurvatureOneOdometer z; BandPrototile C.1.1 T ∧ TileOdometer C.1.1 T h ∧ - (↑h.domain : Set GaussianInt) = FootprintVertices T ∧ (∀ x ∈ h.domain, g x = h.value - x) ∧ GlobalOdometerExtends g h ∧ IntegerSuperharmonicRepresentative (CircleMatrix C) - g ∧ (∀ v ∈ TilingLattice C, ∃ (a : GaussianInt), (CircleMatrix C).mulVec ![(↑v.re : - ℝ), (↑v.im : ℝ)] = ![(↑a.re : ℝ), (↑a.im : ℝ)] ∧ ∀ (x : GaussianInt), g (x + v) = g x - + x.re * a.re + x.im * a.im + g v) ∧ ∃ (b : ℝ × ℝ), ∀ v ∈ TilingLattice C, ∀ (x : - GaussianInt), (↑(g (x + v)) : ℝ) - LatticeQuadraticForm (CircleMatrix C) (x + v) - - (b.1 * (↑(x + v).re : ℝ) + b.2 * (↑(x + v).im : ℝ)) = (↑(g x) : ℝ) - - LatticeQuadraticForm (CircleMatrix C) x - (b.1 * (↑x.re : ℝ) + b.2 * (↑x.im : ℝ))) → - (∀ (v : GaussianInt), P5570T1UnitQuadratic z (x+v) = P5570T1UnitQuadratic z x + - P5570T1UnitQuadratic z v + ((1+z.re)*v.re+z.im*v.im)*x.re + - (z.im*v.re-z.re*v.im)*x.im))))) := by + ∀ (C : BandCircle), + ∀ (x : GaussianInt), + C.1.1.1 = (1 : ℤ) → + ∀ (z : GaussianInt), + CircleMatrix C = + ![![(↑((1 : ℤ) + z.re) : ℝ), (↑z.im : ℝ)], + ![(↑z.im : ℝ), -(↑z.re : ℝ)]] → + (let g := fun (x : GaussianInt) => + ((1 : ℤ) + z.re) * (x.re * (x.re - (1 : ℤ)) / (2 : ℤ)) - + z.re * (x.im * (x.im - (1 : ℤ)) / (2 : ℤ)) + + z.im * x.re * x.im; + let T := (⟨{(0 : LatticeCell)}, (0 : GaussianInt)⟩ : ProtoTile); + let h := CurvatureOneOdometer z; + BandPrototile C.1.1 T ∧ + TileOdometer C.1.1 T h ∧ + (↑h.domain : Set GaussianInt) = FootprintVertices T ∧ + (∀ x ∈ h.domain, g x = h.value x) ∧ + GlobalOdometerExtends g h ∧ + IntegerSuperharmonicRepresentative (CircleMatrix C) g ∧ + (∀ v ∈ TilingLattice C, + ∃ (a : GaussianInt), + (CircleMatrix C).mulVec ![(↑v.re : ℝ), (↑v.im : ℝ)] = + ![(↑a.re : ℝ), (↑a.im : ℝ)] ∧ + ∀ (x : GaussianInt), + g (x + v) = g x + x.re * a.re + x.im * a.im + g v) ∧ + ∃ (b : ℝ × ℝ), + ∀ v ∈ TilingLattice C, + ∀ (x : GaussianInt), + (↑(g (x + v)) : ℝ) - + LatticeQuadraticForm (CircleMatrix C) (x + v) - + (b.1 * (↑(x + v).re : ℝ) + b.2 * (↑(x + v).im : ℝ)) = + (↑(g x) : ℝ) - LatticeQuadraticForm (CircleMatrix C) x - + (b.1 * (↑x.re : ℝ) + b.2 * (↑x.im : ℝ))) → + ∀ (v : GaussianInt), + P5570T1UnitQuadratic z (x + v) = + P5570T1UnitQuadratic z x + P5570T1UnitQuadratic z v + + ((1 + z.re) * v.re + z.im * v.im) * x.re + + (z.im * v.re - z.re * v.im) * x.im + ) := by classical - intro C g x hc z hmatrix hperiodic v + intro C x hc z hmatrix hperiodic v obtain ⟨w, hw, hshift⟩ := hperiodic.2.2.2.2.2.2.1 v (by simp [TilingLattice, hc]) have hr : (1+z.re)*v.re+z.im*v.im = w.re := by @@ -335,70 +384,6 @@ private theorem haMV : intro q i U V M hcells hanchor hempty exact (hanchor (hcells.trans hempty)).symm -private theorem hnV : - (by - classical - exact - (BandCircle) → ((ℕ) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), (Fin (3 : ℕ)) → - ((ProperBandQuadruple q) → ((ProtoTile) → (∀ (V : ProtoTile), (LatticeTile V ∧ - TileArea V = (q (0 : Fin (4 : ℕ))).1.toNat ∧ (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), - (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q V i s (S i s)) → (∀ - (x : LatticeCell), x ∈ V.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i - s).cells) → ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), LatticeTile (TileCellComplement V - (S i s)) ∧ - TileTouching (TileCellComplement V (S i s)) (S i s)) ∧ QuarterTurnSymmetric V ∧ ((1 : - ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), TouchingTriple V (TileTranslation - V (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation V - (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) ∧ ((1 : ℤ) - < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile (q - i.succ) U → TileCentroid U - TileCentroid V = (1 / 2 : ℝ) • (GaussianRealPoint - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 - (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple V (TileTranslation V - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (U : - ProtoTile), ∀ (V_1 : ProtoTile), BandPrototile (q i.succ) U → BandPrototile (q (i + - (1 : Fin (3 : ℕ))).succ) V_1 → TileCentroid U - TileCentroid V = (1 / 2 : ℝ) • - (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid - V_1 - TileCentroid V = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : - Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : - Fin (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple V U V_1) ∧ ∀ (r : - Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 - : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q - (3 : Fin (4 : ℕ)) → (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → (q (3 : Fin - (4 : ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → ∀ (P : - Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin - (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), - BandSubtileOccurrence q V i s (P i s)) → (∀ (x : LatticeCell), x ∈ V.cells ↔ ∃ (i : - Fin (3 : ℕ)) (s : Bool), x ∈ (P i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), - BandSubtileOccurrence r (P (0 : Fin (3 : ℕ)) true) i s (Q i s)) → (∀ (x : - LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), - x ∈ (Q i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P - (0 : Fin (3 : ℕ)) false) i s (S i s)) → (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : - ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → - let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); - let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); (∀ (a : - PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)).Nonempty → AllowedSubtileIncidence a b) ∧ - (¬AllowedSubtileIncidence a b → FootprintVertices (SubtileOccurrenceInterpretation P - u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ - (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ FootprintVertices (P (0 : - Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ⊆ FootprintVertices - (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ - FootprintVertices (P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (0 : Fin (3 : ℕ)) - false) ⊆ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin - (3 : ℕ)) false) ∪ FootprintVertices (Q (0 : Fin (3 : ℕ)) false) ∪ FootprintVertices - (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → - (V.cells ≠ ∅)))))) ) := by - classical - intro C n q i hq U V hgeomV - have harea := hgeomV.2.1 - have hcpos := (ProperBandCurvatureStructure q hq).1 - intro he - simp only [TileArea, he, Finset.card_empty] at harea - omega - private theorem touchingRetarget : (by classical @@ -537,28 +522,51 @@ private theorem hnadj : (by classical exact - (BandCircle) → ((ℕ) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ - (hq : ProperBandQuadruple q), ((q i.succ).1 = (1 : ℤ)) → (∀ (hpos : 0 < (q i.succ).1), - let Ci : BandCircle := - ⟨⟨q i.succ, Or.inl hpos, q, hq.1, i.succ, rfl⟩, hpos⟩ - ∀ (U : ProtoTile), (ProtoTile) → (∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus - : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (reverseTiles : - List ProtoTile), ∀ (hs : List PartialOdometer), ∀ (reverseHs : List PartialOdometer), - (TileString Ci orientation base Rplus Rminus reverseTiles) → ((OdometerStringRespect - Ci orientation base Rminus Rplus tiles hs) → ((OdometerStringRespect Ci orientation - base Rplus Rminus reverseTiles reverseHs) → (∀ (r : Fin (4 : ℕ) → CircleCoordinates), - (Ci.1.1.1 = (1 : ℤ) → UnitOccurrenceOrientation r i orientation) → ((TileString Ci - orientation base Rminus Rplus tiles) → ((TileCentroid Rminus - TileCentroid U = (1 / - 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) - - BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((TileCentroid Rplus - - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : - Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → ((Zsqrtd.norm - (BandVectors.1 (q 0) (q i.succ)) = (q 0).1+1) → (¬ ∃ v : GaussianInt, - UnitTriangularStep orientation v ∧ TileCentroid Rplus - TileCentroid Rminus = - GaussianRealPoint v)))))))))))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), + ∀ (hq : ProperBandQuadruple q), + (q i.succ).1 = (1 : ℤ) → + ∀ (hpos : 0 < (q i.succ).1), + let Ci : BandCircle := + ⟨⟨q i.succ, Or.inl hpos, q, hq.1, i.succ, rfl⟩, hpos⟩; + ∀ (U : ProtoTile), + ∀ (orientation : Bool), + ∀ (base : ProtoTile), + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + ∀ (tiles : List ProtoTile), + ∀ (reverseTiles : List ProtoTile), + ∀ (hs : List PartialOdometer), + ∀ (reverseHs : List PartialOdometer), + TileString Ci orientation base Rplus Rminus reverseTiles → + OdometerStringRespect Ci orientation base Rminus Rplus + tiles hs → + OdometerStringRespect Ci orientation base Rplus Rminus + reverseTiles reverseHs → + ∀ (r : Fin (4 : ℕ) → CircleCoordinates), + (Ci.1.1.1 = (1 : ℤ) → + UnitOccurrenceOrientation r i orientation) → + TileString Ci orientation base Rminus Rplus tiles → + TileCentroid Rminus - TileCentroid U = + (1 / 2 : ℝ) • + GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) - + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) → + TileCentroid Rplus - TileCentroid U = + (1 / 2 : ℝ) • + GaussianRealPoint + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))) + + BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) → + Zsqrtd.norm (BandVectors.1 (q 0) (q i.succ)) = + (q 0).1 + 1 → + ¬∃ v : GaussianInt, + UnitTriangularStep orientation v ∧ + TileCentroid Rplus - TileCentroid Rminus = + GaussianRealPoint v + ) := by classical - intro C n q i hq hunit hpos Ci U V orientation base Rminus Rplus tiles reverseTiles hs - reverseHs hreverse hrespect hreverseRespect r horientation hstring hcminus hcplus hnorm + intro q i hq hunit hpos Ci U orientation base Rminus Rplus tiles reverseTiles hs reverseHs + hreverse hrespect hreverseRespect r horientation hstring hcminus hcplus hnorm rintro ⟨v,hv,hcv⟩ have hveq : v = BandVectors.1 (q 0) (q i.succ) := by apply Zsqrtd.ext @@ -730,30 +738,52 @@ private theorem translationAt543 : (by classical exact - (IntegerLatticeFunction) → (∀ (x : GaussianInt), ∀ (q : Fin (4 : ℕ) → - CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (hq : ProperBandQuadruple q), ∀ (hpos : 0 - < (q i.succ).1), - let Ci : BandCircle := - ⟨⟨q i.succ, Or.inl hpos, q, hq.1, i.succ, rfl⟩, hpos⟩ - ∀ (z : GaussianInt), (Ci.1.1.1 = 1) → ((CircleMatrix Ci = ![![((1+z.re : ℤ) : ℝ), (z.im : - ℝ)], ![(z.im : ℝ), (-z.re : ℝ)]]) → (( - let g := fun (x : GaussianInt) => ((1 : ℤ) + z.re) * (x.re * (x.re - (1 : ℤ)) / (2 : ℤ)) - - z.re * (x.im * (x.im - (1 : ℤ)) / (2 : ℤ)) + z.im * x.re * x.im; - let T := (⟨{(0 : LatticeCell)}, (0 : GaussianInt)⟩ : ProtoTile); - let h := CurvatureOneOdometer z; BandPrototile Ci.1.1 T ∧ TileOdometer Ci.1.1 T h ∧ - (↑h.domain : Set GaussianInt) = FootprintVertices T ∧ (∀ x ∈ h.domain, g x = h.value - x) ∧ GlobalOdometerExtends g h ∧ IntegerSuperharmonicRepresentative (CircleMatrix Ci) - g ∧ (∀ v ∈ TilingLattice Ci, ∃ (a : GaussianInt), (CircleMatrix Ci).mulVec ![(↑v.re : - ℝ), (↑v.im : ℝ)] = ![(↑a.re : ℝ), (↑a.im : ℝ)] ∧ ∀ (x : GaussianInt), g (x + v) = g x - + x.re * a.re + x.im * a.im + g v) ∧ ∃ (b : ℝ × ℝ), ∀ v ∈ TilingLattice Ci, ∀ (x : - GaussianInt), (↑(g (x + v)) : ℝ) - LatticeQuadraticForm (CircleMatrix Ci) (x + v) - - (b.1 * (↑(x + v).re : ℝ) + b.2 * (↑(x + v).im : ℝ)) = (↑(g x) : ℝ) - - LatticeQuadraticForm (CircleMatrix Ci) x - (b.1 * (↑x.re : ℝ) + b.2 * (↑x.im : ℝ))) → - (∀ (v : GaussianInt), P5570T1UnitQuadratic z (x+v) = P5570T1UnitQuadratic z x + - P5570T1UnitQuadratic z v + ((1+z.re)*v.re+z.im*v.im)*x.re + - (z.im*v.re-z.re*v.im)*x.im))))) := by + ∀ (x : GaussianInt), + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), + ∀ (hq : ProperBandQuadruple q), + ∀ (hpos : 0 < (q i.succ).1), + let Ci : BandCircle := + ⟨⟨q i.succ, Or.inl hpos, q, hq.1, i.succ, rfl⟩, hpos⟩ + ∀ (z : GaussianInt), + Ci.1.1.1 = 1 → + CircleMatrix Ci = + ![![((1 + z.re : ℤ) : ℝ), (z.im : ℝ)], + ![(z.im : ℝ), (-z.re : ℝ)]] → + (let g := fun (x : GaussianInt) => + ((1 : ℤ) + z.re) * (x.re * (x.re - (1 : ℤ)) / (2 : ℤ)) - + z.re * (x.im * (x.im - (1 : ℤ)) / (2 : ℤ)) + + z.im * x.re * x.im; + let T := (⟨{(0 : LatticeCell)}, (0 : GaussianInt)⟩ : ProtoTile); + let h := CurvatureOneOdometer z; + BandPrototile Ci.1.1 T ∧ + TileOdometer Ci.1.1 T h ∧ + (↑h.domain : Set GaussianInt) = FootprintVertices T ∧ + (∀ x ∈ h.domain, g x = h.value x) ∧ + GlobalOdometerExtends g h ∧ + IntegerSuperharmonicRepresentative (CircleMatrix Ci) g ∧ + (∀ v ∈ TilingLattice Ci, + ∃ (a : GaussianInt), + (CircleMatrix Ci).mulVec ![(↑v.re : ℝ), (↑v.im : ℝ)] = + ![(↑a.re : ℝ), (↑a.im : ℝ)] ∧ + ∀ (x : GaussianInt), + g (x + v) = g x + x.re * a.re + x.im * a.im + g v) ∧ + ∃ (b : ℝ × ℝ), + ∀ v ∈ TilingLattice Ci, + ∀ (x : GaussianInt), + (↑(g (x + v)) : ℝ) - + LatticeQuadraticForm (CircleMatrix Ci) (x + v) - + (b.1 * (↑(x + v).re : ℝ) + b.2 * (↑(x + v).im : ℝ)) = + (↑(g x) : ℝ) - LatticeQuadraticForm (CircleMatrix Ci) x - + (b.1 * (↑x.re : ℝ) + b.2 * (↑x.im : ℝ))) → + ∀ (v : GaussianInt), + P5570T1UnitQuadratic z (x + v) = + P5570T1UnitQuadratic z x + P5570T1UnitQuadratic z v + + ((1 + z.re) * v.re + z.im * v.im) * x.re + + (z.im * v.re - z.re * v.im) * x.im + ) := by classical - intro g x q i hq hpos Ci z hCiunit hmatrix hperiodic v + intro x q i hq hpos Ci z hCiunit hmatrix hperiodic v obtain ⟨w,hw,hshift⟩ := hperiodic.2.2.2.2.2.2.1 v (by simp [TilingLattice, hCiunit]) have hr : (1+z.re)*v.re+z.im*v.im = w.re := by @@ -797,10 +827,12 @@ private theorem hposAt619 : (by classical exact - (BandCircle) → ((ℕ) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), - (ProperBandQuadruple q) → ((¬(q i.succ).1 = (0 : ℤ)) → (0 < (q i.succ).1)))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), + ProperBandQuadruple q → ¬(q i.succ).1 = (0 : ℤ) → 0 < (q i.succ).1 + ) := by classical - intro C n q i hq hzero + intro q i hq hzero have hnonneg := (ProperBandCurvatureStructure q hq).2.1 i omega @@ -853,23 +885,43 @@ private theorem positiveStep : (by classical exact - ∀ (C : BandCircle), ∀ (g : IntegerLatticeFunction), ∀ (x : GaussianInt), (ℕ) → (∀ (q : - Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (ProperBandQuadruple - q) → ((q (0 : Fin (4 : ℕ)) = C.1.1) → (((q i.succ).1 = (1 : ℤ)) → ((0 < (q - i.succ).1) → (∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (f : PartialOdometer), ∀ (k : - PartialOdometer), ∀ (p : Real × Real), ∀ (p' : Real × Real), (TileOdometer C.1.1 - U f) → ((TileOdometer - C.1.1 V k) → ((PartialOdometerSlope f = some p) → ((PartialOdometerSlope k = some p') - → ((TileCentroid V - TileCentroid U = - GaussianRealPoint (BandVectors.1 (q i.succ) (q 0))) → ((p' - p = GaussianRealPoint - (BandVectors.2 (q i.succ) (q 0))) → ((OdometerCompatibility f k) → - ((GlobalOdometerExtends g f) → ((GlobalOdometerExtends g k) → ((x ∈ f.domain) → - ((x ∈ k.domain) → ((∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ - y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → - y ∈ f.domain ∨ y ∈ k.domain) → (FourNeighborLaplacian g x = 1)))))))))))))))))) := by + ∀ (C : BandCircle), + ∀ (g : IntegerLatticeFunction), + ∀ (x : GaussianInt), + ℕ → + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), + ProperBandQuadruple q → + q (0 : Fin (4 : ℕ)) = C.1.1 → + (q i.succ).1 = (1 : ℤ) → + 0 < (q i.succ).1 → + ∀ (U : ProtoTile), + ∀ (V : ProtoTile), + ∀ (f : PartialOdometer), + ∀ (k : PartialOdometer), + ∀ (p : Real × Real), + ∀ (p' : Real × Real), + TileOdometer C.1.1 U f → + TileOdometer C.1.1 V k → + PartialOdometerSlope f = some p → + PartialOdometerSlope k = some p' → + TileCentroid V - TileCentroid U = + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) → + p' - p = + GaussianRealPoint (BandVectors.2 (q i.succ) (q 0)) → + GlobalOdometerExtends g f → + GlobalOdometerExtends g k → + x ∈ f.domain → + x ∈ k.domain → + (∀ y, + y = x ∨ + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ f.domain ∨ y ∈ k.domain) → + FourNeighborLaplacian g x = 1 + ) := by classical - intro C g x n q i hq hqC hunit hpos U V f k p p' hOf hOk hpf hpk hcUV hpUV hcomp hgf hgk hxf - hxk hcover + intro C g x n q i hq hqC hunit hpos U V f k p p' hOf hOk hpf hpk hcUV hpUV hgf hgk hxf hxk + hcover let Ci : BandCircle := ⟨⟨q i.succ, Or.inl hpos, q, hq.1, i.succ, rfl⟩, hpos⟩ classical @@ -939,7 +991,7 @@ private theorem positiveStep : ExactTileInterfaceTripleRetargetMiddle U M V Rplus hMV haMV Ep have hgeomU := BandTileSimultaneousInduction q hq U hU have hgeomV := BandTileSimultaneousInduction q hq V hV - have hnV : V.cells ≠ ∅ := LeftWebGeometry.hnV C n q i hq U V hgeomV + have hnV : V.cells ≠ ∅ := (LatticeTileNonempty.cells V hgeomV.1).ne_empty have touchingRetarget (W : ProtoTile) (ht : TouchingTriple U M W) : TouchingTriple U V W := LeftWebGeometry.touchingRetarget q i U V hMV hobsMV hnV W ht @@ -969,7 +1021,7 @@ private theorem positiveStep : (q 0).1+1 := LeftWebGeometry.hnorm q i hq hunit have hnadj : ¬ ∃ v : GaussianInt, UnitTriangularStep orientation v ∧ TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint v := - LeftWebGeometry.hnadj C n q i hq hunit hpos U V orientation base Rminus + LeftWebGeometry.hnadj q i hq hunit hpos U orientation base Rminus Rplus tiles reverseTiles hs reverseHs hreverse hrespect hreverseRespect r horientation hstring hcminus hcplus hnorm have hUn : U.cells.Nonempty := LeftWebGeometry.hUn q hq U V hgeomU hgeomV @@ -994,7 +1046,7 @@ private theorem positiveStep : P5570T1UnitQuadratic z (x+v) = P5570T1UnitQuadratic z x + P5570T1UnitQuadratic z v + ((1+z.re)*v.re+z.im*v.im)*x.re + - (z.im*v.re-z.re*v.im)*x.im := LeftWebGeometry.translationAt543 g x q i hq + (z.im*v.re-z.re*v.im)*x.im := LeftWebGeometry.translationAt543 x q i hq hpos z hCiunit hmatrix hperiodic v have hquad : FourNeighborLaplacian (fun y => P5570T1UnitQuadratic z y + A.re*y.re + A.im*y.im + B) x = 1 := @@ -1038,7 +1090,7 @@ theorem P5596T1LeftWeb by_cases hc : C.1.1.1 = 1 · obtain ⟨z, hz⟩ := CurvatureOneBandCircleClassification C hc obtain ⟨ht₁, ht₂, p₁, p₂, hp₁, hp₂, hstep⟩ := hleft - have hdata := LeftWebGeometry.hdata C T₁ T₂ n hc p₁ p₂ hstep + have hdata := LeftWebGeometry.hdata C T₁ T₂ hc p₁ p₂ hstep obtain ⟨v, hv, hr, hi⟩ := hdata obtain ⟨u₁, a₁, b₁, hu₁, hd₁, hcent₁, hval₁, hs₁⟩ := P5570T1UnitNormalForm C z T₁ h₁ hz ht₁ @@ -1078,7 +1130,7 @@ theorem P5596T1LeftWeb have hq : FourNeighborLaplacian (fun y => P5570T1UnitQuadratic z y + a₁.re * y.re + a₁.im * y.im + (b₁ + c₁)) x = 1 := LeftWebGeometry.hq x z a₁ b₁ c₁ - (LeftWebGeometry.translationAt244 C g x hc z hmatrix hperiodic) + (LeftWebGeometry.translationAt244 C x hc z hmatrix hperiodic) simpa only [FourNeighborLaplacian, hvalues x (Or.inl rfl), hvalues (x + 1) (Or.inr (Or.inl rfl)), @@ -1108,7 +1160,7 @@ theorem P5596T1LeftWeb y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ f.domain ∨ y ∈ k.domain) : FourNeighborLaplacian g x = 1 := LeftWebStep.positiveStep C g x n q i hq hqC - hunit hpos U V f k p p' hOf hOk hpf hpk hcUV hpUV hcomp hgf hgk hxf hxk hcover + hunit hpos U V f k p p' hOf hOk hpf hpk hcUV hpUV hgf hgk hxf hxk hcover cases e · apply positiveStep T₂ T₁ h₂ h₁ p₂ p₁ hO₂ hO₁ hp₂ hp₁ · simp only [Bool.false_eq_true, ite_false, neg_one_smul] at hcent @@ -1146,7 +1198,7 @@ theorem P5596T1LeftWeb · exact P5596T1LineParent q hq i e hzero T₁ T₂ h₁ h₂ p₁ p₂ g x (by simpa only [hqC] using hO₁) (by simpa only [hqC] using hO₂) hp₁ hp₂ hcent hr hi hg₁ hg₂ hx₁ hx₂ hstar - · have hpos : 0 < (q i.succ).1 := LeftWebGeometry.hposAt619 C n q i hq hzero + · have hpos : 0 < (q i.succ).1 := LeftWebGeometry.hposAt619 q i hq hzero let Ci : BandCircle := ⟨⟨q i.succ, Or.inl hpos, q, hq.1, i.succ, rfl⟩, hpos⟩ have hlarge : 1 < Ci.1.1.1 := by change 1 < (q i.succ).1; omega diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean index 1d56d4b529..17461b3753 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean @@ -814,13 +814,15 @@ private theorem slope_for : (by classical exact - ∀ (C : BandCircle), (PeriodicTileComplex ↥(TilingLattice C)) → ((↥(TilingLattice C)) → - ((↥(TilingLattice C)) → ((↥(TilingLattice C)) → ((↥(TilingLattice C)) → ((Fin (4 : - ℕ)) → ((Fin (4 : ℕ)) → (∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : - PartialOdometer), TileOdometer c U k → 1 < c.1 → ∃ p : ℝ × ℝ, PartialOdometerSlope k - = some p))))))) ) := by + Fin (4 : ℕ) → + ∀ (c : CircleCoordinates), + ∀ (U : ProtoTile), + ∀ (k : PartialOdometer), + TileOdometer c U k → + 1 < c.1 → ∃ p : ℝ × ℝ, PartialOdometerSlope k = some p + ) := by classical - intro C P a0 a1 a2 a3 m w c U k ho hcpos + intro w c U k ho hcpos induction ho with | line w y hw hdom => omega | unit z y U hU hdom htrans => omega @@ -1681,7 +1683,7 @@ theorem PeriodicBoundaryWebLaplacian (C : BandCircle) a3 m w hneq (WebLaplacianGeometry.hcommon C x P a0 a1 a2 a3 m w e hepair boundaryEdge edge_mem_e edge_mem_next)) obtain ⟨j, hsign⟩ := hdisplacement - have slope_for := WebLaplacianGeometry.slope_for C P a0 a1 a2 a3 m w + have slope_for := WebLaplacianGeometry.slope_for w have hcurvature := WebLaplacianGeometry.hcurvature C hc a0 a1 a2 a3 m w e hecolor obtain ⟨p, hp⟩ := slope_for C.1.1 T h hodo hcurvature let u : GaussianInt := owner m diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean index 6373099307..e0db7b854d 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean @@ -195,15 +195,19 @@ private theorem edgeOf_injective : (by classical exact - (ProtoTile) → ((Finset GaussianInt) → ( let I : GaussianInt := ⟨0, 1⟩ let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} - (∀ {a : GaussianInt}, ∀ {b : GaussianInt}, ∀ {c : GaussianInt}, ∀ {d : GaussianInt}, - (({a, b} : Finset GaussianInt) = {c, d}) → ((a = c ∧ b = d) ∨ (a = d ∧ b = c))) → - (Function.Injective edgeOf))) ) := by - classical - intro T D I edgeOf pair_eq + (∀ {a : GaussianInt}, + ∀ {b : GaussianInt}, + ∀ {c : GaussianInt}, + ∀ {d : GaussianInt}, + ({ a, b } : Finset GaussianInt) = { c, d } → + a = c ∧ b = d ∨ a = d ∧ b = c) → + Function.Injective edgeOf + ) := by + classical + intro I edgeOf pair_eq rintro ⟨z, b⟩ ⟨w, d⟩ h cases b <;> cases d · change ({z, z + 1} : Finset GaussianInt) = {w, w + 1} at h @@ -1036,10 +1040,12 @@ private theorem htranslation_rigid : (by classical exact - ∀ (T : ProtoTile), (T.cells.Nonempty) → ((List GaussianInt) → (∀ (v : GaussianInt), - (T.cells.image (fun z => z + v) = T.cells) → (v = 0))) ) := by + ∀ (T : ProtoTile), + T.cells.Nonempty → + ∀ (v : GaussianInt), (T.cells.image fun z => z + v) = T.cells → v = 0 + ) := by classical - intro T hcells p v hs + intro T hcells v hs have hinj : Function.Injective (fun z : GaussianInt => z + v) := by intro a b hab exact add_right_cancel hab @@ -1838,15 +1844,20 @@ private theorem hhalf : (by classical exact - (BandCircle) → (∀ (T : ProtoTile), ∀ (h : PartialOdometer), (IntegerLatticeFunction) → ( - let D : Finset GaussianInt := h.domain.filter - (fun x => @decide (x ∉ BoundaryFootprintVertices T) - (Classical.propDecidable _)) - (List GaussianInt) → ((Finset GaussianInt) → ((2 * ((D.filter fun z => z + 1 ∈ D).card + - (D.filter fun z => z + (⟨0, 1⟩ : GaussianInt) ∈ D).card)) / 2 = (D.filter fun z => z - + 1 ∈ D).card + (D.filter fun z => z + (⟨0, 1⟩ : GaussianInt) ∈ D).card)))) ) := by + ∀ (T : ProtoTile), + ∀ (h : PartialOdometer), + let D : Finset GaussianInt := + h.domain.filter fun x => + @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _); + 2 * + ((D.filter fun z => z + 1 ∈ D).card + + (D.filter fun z => z + (⟨0, 1⟩ : GaussianInt) ∈ D).card) / + 2 = + (D.filter fun z => z + 1 ∈ D).card + + (D.filter fun z => z + (⟨0, 1⟩ : GaussianInt) ∈ D).card + ) := by classical - intro C T h g D p R + intro T h D omega end PeriodicIndegreeGeometry @@ -1891,7 +1902,7 @@ private theorem hcountBridge : -- A base point and direction give a unique tag for each footprint edge. let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} - have edgeOf_injective := PeriodicIndegreeGeometry.edgeOf_injective T D + have edgeOf_injective := PeriodicIndegreeGeometry.edgeOf_injective (PeriodicIndegreeGeometry.pair_eq) let V := cornerBag.toFinset have hEV := PeriodicIndegreeGeometry.hEV T hcells @@ -1990,7 +2001,7 @@ theorem PeriodicTileTotalIndegree (C : BandCircle) have hcell_residue_unique := PeriodicIndegreeGeometry.hcell_residue_unique C T h g hdom hT hlat htile hweb hcountBridge htiles heuler hreg hcells p x₀ x₁ hverts hedges (PeriodicIndegreeGeometry.hboundary_card T p hpnd hverts) hDmem - (PeriodicIndegreeGeometry.htranslation_rigid T hcells p) hcell_cover + (PeriodicIndegreeGeometry.htranslation_rigid T hcells) hcell_cover have hfund := PeriodicIndegreeGeometry.hfund C T hcell_cover hcell_residue_unique obtain ⟨R, hR, hRcard⟩ := TilingLatticeIndex C have hcell_curv : T.cells.card = C.1.1.1.natAbs := PeriodicIndegreeGeometry.hcell_curv C T R @@ -2043,8 +2054,8 @@ theorem PeriodicTileTotalIndegree (C : BandCircle) (2 * ((D.filter fun z => z + 1 ∈ D).card + (D.filter fun z => z + (⟨0, 1⟩ : GaussianInt) ∈ D).card)) / 2 = (D.filter fun z => z + 1 ∈ D).card + - (D.filter fun z => z + (⟨0, 1⟩ : GaussianInt) ∈ D).card := PeriodicIndegreeGeometry.hhalf - C T h g p R + (D.filter fun z => z + (⟨0, 1⟩ : GaussianInt) ∈ D).card := + PeriodicIndegreeGeometry.hhalf T h rw [hhalf] omega diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean index 8aabd1e0ab..e43c5bbcf0 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureTranslatedOdometers.lean @@ -30,10 +30,13 @@ private theorem slope_for : (by classical exact - (BandCircle) → (∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : PartialOdometer), - TileOdometer c U k → 1 < c.1 → ∃ p : ℝ × ℝ, PartialOdometerSlope k = some p) ) := by + ∀ (c : CircleCoordinates), + ∀ (U : ProtoTile), + ∀ (k : PartialOdometer), + TileOdometer c U k → 1 < c.1 → ∃ p : ℝ × ℝ, PartialOdometerSlope k = some p + ) := by classical - intro C c U k ho hc + intro c U k ho hc induction ho with | line w x hw hdom => omega | unit z x U hU hdom htrans => omega @@ -627,7 +630,7 @@ theorem PositiveCurvatureTranslatedOdometers (C : BandCircle) PartialOdometerAffineTranslate h (shift kl) (slopeShift kl) 0 have slope_for : ∀ (c : CircleCoordinates) (U : ProtoTile) (k : PartialOdometer), TileOdometer c U k → 1 < c.1 → - ∃ p : ℝ × ℝ, PartialOdometerSlope k = some p := PositiveTranslationGeometry.slope_for C + ∃ p : ℝ × ℝ, PartialOdometerSlope k = some p := PositiveTranslationGeometry.slope_for have slope_exists : ∃ p : ℝ × ℝ, PartialOdometerSlope h = some p := slope_for C.1.1 T h hO (by omega) obtain ⟨P, hPl, htile, hadj, hposition, hvcard, hecard, hfcard, hchart⟩ := diff --git a/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean b/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean index fa4a733c77..52595def13 100644 --- a/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean @@ -200,10 +200,12 @@ private theorem hrootAt310 : (by classical exact - (ℕ) → (∀ (C : BandCircle), (List GaussianInt) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), - (ProperBandQuadruple q) → ((q (0 : Fin (4 : ℕ)) = C.1.1) → (1 < (q 0).1)))) ) := by + ∀ (C : BandCircle), + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q → q (0 : Fin (4 : ℕ)) = C.1.1 → 1 < (q 0).1 + ) := by classical - intro n C p q hq hqC + intro C q hq hqC have hpq := hq.2 (0 : Fin 3) have hpos : 0 < (q 0).1 := by simpa only [hqC] using C.property have hnon := (ProperBandCurvatureStructure q hq).2.1 @@ -394,11 +396,12 @@ private theorem hrootAt463 : (by classical exact - (ℕ) → (∀ (C₀ : BandCircle), (BandCircle) → ((List GaussianInt) → (∀ (q : Fin (4 : ℕ) → - CircleCoordinates), (ProperBandQuadruple q) → ((q (0 : Fin (4 : ℕ)) = C₀.1.1) → (1 < - (q 0).1))))) ) := by + ∀ (C₀ : BandCircle), + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q → q (0 : Fin (4 : ℕ)) = C₀.1.1 → 1 < (q 0).1 + ) := by classical - intro n C₀ Cᵢ p q hq hqC + intro C₀ q hq hqC have hnon := (ProperBandCurvatureStructure q hq).2.1 have hunique := (ProperBandCurvatureStructure q hq).2.2 have hnon0 := hnon 0 @@ -674,7 +677,7 @@ theorem RightSubtileOdometerCompatibility : rcases path with ⟨p, hpnd, hplen, hhead, hlast, hpverts, hstep, hpedges⟩ have qdata := RightCompatibilityGeometry.qdata C T T' h h' hdata rcases qdata with ⟨q, i, e, hq, hqC⟩ - have hroot : 1 < (q 0).1 := RightCompatibilityGeometry.hrootAt310 n C p q hq hqC + have hroot : 1 < (q 0).1 := RightCompatibilityGeometry.hrootAt310 C q hq hqC obtain ⟨S, hsx, hband, hchildren, hcells, hfoot, hcent, hdoms, hvalues, hcomps, hslopes⟩ := TileOdometerReindexedDecomposition q hq T h hroot (by simpa [hqC] using hOT) @@ -720,7 +723,7 @@ theorem RightSubtileOdometerCompatibility : ⟨hOT0, hOTi, hdata⟩) rcases path with ⟨p, hpnd, hplen, hhead, hlast, hpverts, hstep, hpedges⟩ rcases hdata with ⟨p₀, pᵢ, hp₀, hpᵢ, q, i, s, hq, hqC, hqI, rest⟩ - have hroot : 1 < (q 0).1 := RightCompatibilityGeometry.hrootAt463 n C₀ Cᵢ p q hq hqC + have hroot : 1 < (q 0).1 := RightCompatibilityGeometry.hrootAt463 C₀ q hq hqC obtain ⟨S, hsx, hband, hchildren, hcells, hfoot, hcent, hdoms, hvalues, hcomps, hslopes⟩ := TileOdometerReindexedDecomposition q hq T₀ h₀ hroot diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean index 3c2517fecf..02af32a164 100644 --- a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean @@ -27,22 +27,21 @@ namespace ApollonianSuperharmonic namespace PathEquivariance -private theorem transport : ∀ (p : List GaussianInt) (f : GaussianInt → GaussianInt), - Function.Injective f → +private theorem transport : + ∀ (p : List GaussianInt) (f : GaussianInt → GaussianInt), (∀ a b : GaussianInt, - (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → - (f b = f a + 1 ∨ f b = f a - 1 ∨ - f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → - (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, - p = l₁ ++ a :: b :: l₂ → - b = a + 1 ∨ b = a - 1 ∨ - b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → - (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, - p.map f = l₁ ++ a :: b :: l₂ → - b = a + 1 ∨ b = a - 1 ∨ - b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) := by + b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ → + f b = f a + 1 ∨ f b = f a - 1 ∨ f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩) → + (∀ a b : GaussianInt, + ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → + ∀ a b : GaussianInt, + ∀ l₁ l₂ : List GaussianInt, + p.map f = l₁ ++ a :: b :: l₂ → + b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ := by classical - intro p f hf hstep hp + intro p f hstep hp induction p with | nil => intro a b l₁ l₂ h @@ -71,28 +70,17 @@ private theorem transport : ∀ (p : List GaussianInt) (f : GaussianInt → Gaus simp [hm] · exact htail -private theorem forward : ∀ (f : GaussianInt → GaussianInt), Function.Injective f → - (∀ a b : GaussianInt, - (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → - (f b = f a + 1 ∨ f b = f a - 1 ∨ - f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → - ∀ V E, SimpleGridPath V E → - SimpleGridPath (f '' V) ((fun e : Finset GaussianInt => e.image f) '' E) := by - classical - have transport : ∀ (p : List GaussianInt) (f : GaussianInt → GaussianInt), +private theorem forward : + ∀ (f : GaussianInt → GaussianInt), Function.Injective f → - (∀ a b : GaussianInt, - (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → - (f b = f a + 1 ∨ f b = f a - 1 ∨ - f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → - (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, - p = l₁ ++ a :: b :: l₂ → - b = a + 1 ∨ b = a - 1 ∨ - b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → - (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, - p.map f = l₁ ++ a :: b :: l₂ → - b = a + 1 ∨ b = a - 1 ∨ - b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) := transport + (∀ a b : GaussianInt, + b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ → + f b = f a + 1 ∨ f b = f a - 1 ∨ f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩) → + ∀ V E, + SimpleGridPath V E → + SimpleGridPath (f '' V) ((fun e : Finset GaussianInt => e.image f) '' E) := by + classical + have transport := transport intro f hf hstep V E path rcases path with ⟨p, hnd, hlen, hV, hp, hE⟩ refine ⟨p.map f, hnd.map hf, ?_, ?_, ?_, ?_⟩ @@ -100,7 +88,7 @@ private theorem forward : ∀ (f : GaussianInt → GaussianInt), Function.Inject · rw [hV] ext z simp [] - · exact transport p f hf hstep hp + · exact transport p f hstep hp · intro e constructor · rintro ⟨d, hd, rfl⟩ @@ -147,23 +135,19 @@ private theorem forward : ∀ (f : GaussianInt → GaussianInt), Function.Inject refine ⟨{a₀, b₀}, (hE {a₀, b₀}).mpr ⟨a₀, b₀, k, m, hm, rfl⟩, ?_⟩ simp [he] -private theorem backward : ∀ (f g : GaussianInt → GaussianInt), Function.Injective f → - (∀ x, g (f x) = x) → (∀ x, f (g x) = x) → - (∀ a b : GaussianInt, - (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → - (g b = g a + 1 ∨ g b = g a - 1 ∨ - g b = g a + ⟨0, 1⟩ ∨ g b = g a - ⟨0, 1⟩)) → - ∀ V E, SimpleGridPath (f '' V) - ((fun e : Finset GaussianInt => e.image f) '' E) → SimpleGridPath V E := by +private theorem backward : + ∀ (f g : GaussianInt → GaussianInt), + (∀ x, g (f x) = x) → + (∀ x, f (g x) = x) → + (∀ a b : GaussianInt, + b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ → + g b = g a + 1 ∨ g b = g a - 1 ∨ g b = g a + ⟨0, 1⟩ ∨ g b = g a - ⟨0, 1⟩) → + ∀ V E, + SimpleGridPath (f '' V) ((fun e : Finset GaussianInt => e.image f) '' E) → + SimpleGridPath V E := by classical - have forward : ∀ (f : GaussianInt → GaussianInt), Function.Injective f → - (∀ a b : GaussianInt, - (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → - (f b = f a + 1 ∨ f b = f a - 1 ∨ - f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → - ∀ V E, SimpleGridPath V E → - SimpleGridPath (f '' V) ((fun e : Finset GaussianInt => e.image f) '' E) := forward - intro f g hf hgf hfg hstep V E h + have forward := forward + intro f g hgf hfg hstep V E h have result := forward g (by intro a b hab simpa [hfg] using congrArg f hab) hstep (f '' V) @@ -203,38 +187,10 @@ theorem SimpleGridPathEquivariance : apply Zsqrtd.ext · simpa [GaussianReflection] using congrArg (fun z : GaussianInt => z.re) h · simpa [GaussianReflection] using congrArg (fun z : GaussianInt => -z.im) h - have transport : ∀ (p : List GaussianInt) (f : GaussianInt → GaussianInt), - Function.Injective f → - (∀ a b : GaussianInt, - (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → - (f b = f a + 1 ∨ f b = f a - 1 ∨ - f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → - (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, - p = l₁ ++ a :: b :: l₂ → - b = a + 1 ∨ b = a - 1 ∨ - b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → - (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, - p.map f = l₁ ++ a :: b :: l₂ → - b = a + 1 ∨ b = a - 1 ∨ - b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) := PathEquivariance.transport - have forward : ∀ (f : GaussianInt → GaussianInt), Function.Injective f → - (∀ a b : GaussianInt, - (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → - (f b = f a + 1 ∨ f b = f a - 1 ∨ - f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → - ∀ V E, SimpleGridPath V E → - SimpleGridPath (f '' V) ((fun e : Finset GaussianInt => e.image f) '' E) := - PathEquivariance.forward - have backward : ∀ (f g : GaussianInt → GaussianInt), Function.Injective f → - (∀ x, g (f x) = x) → (∀ x, f (g x) = x) → - (∀ a b : GaussianInt, - (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → - (g b = g a + 1 ∨ g b = g a - 1 ∨ - g b = g a + ⟨0, 1⟩ ∨ g b = g a - ⟨0, 1⟩)) → - ∀ V E, SimpleGridPath (f '' V) - ((fun e : Finset GaussianInt => e.image f) '' E) → SimpleGridPath V E := - PathEquivariance.backward - let qb : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ + have forward := PathEquivariance.forward + have backward := PathEquivariance.backward + let qb : GaussianInt → GaussianInt := fun z => + ⟨z.im, -z.re⟩ have hqb : Function.Injective qb := by intro a b h apply Zsqrtd.ext @@ -307,12 +263,12 @@ theorem SimpleGridPathEquivariance : · subst b; left; apply Zsqrtd.ext <;> simp [qb] · subst b; right; left; apply Zsqrtd.ext <;> simp [qb] exact ⟨⟨fun h => forward (GaussianTranslation u) ht transStep V E h, - fun h => backward (GaussianTranslation u) (GaussianTranslation (-u)) ht transInv₁ transInv₂ + fun h => backward (GaussianTranslation u) (GaussianTranslation (-u)) transInv₁ transInv₂ transBack V E h⟩, ⟨fun h => forward GaussianQuarterTurn hq quarterStep V E h, - fun h => backward GaussianQuarterTurn qb hq quarterInv₁ quarterInv₂ quarterBackStep V E h⟩, + fun h => backward GaussianQuarterTurn qb quarterInv₁ quarterInv₂ quarterBackStep V E h⟩, ⟨fun h => forward GaussianReflection hr reflStep V E h, - fun h => backward GaussianReflection GaussianReflection hr reflInv reflInv reflStep V E h⟩⟩ + fun h => backward GaussianReflection GaussianReflection reflInv reflInv reflStep V E h⟩⟩ end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean index 699f5439c0..19648fcfa7 100644 --- a/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean @@ -131,9 +131,13 @@ private theorem support_nonempty : (by classical exact - ∀ (C : CircleCoordinates), ∀ (U : ProtoTile), ∀ (h : PartialOdometer), ∀ (p : ℝ × ℝ), 0 < - C.1 → TileOdometer C U h → PartialOdometerSlope h = some p → U.cells.Nonempty ) := by - intro C U k p _ hO hp + ∀ (C : CircleCoordinates), + ∀ (U : ProtoTile), + ∀ (h : PartialOdometer), + ∀ (p : ℝ × ℝ), + TileOdometer C U h → PartialOdometerSlope h = some p → U.cells.Nonempty + ) := by + intro C U k p hO hp exact TileOdometerSlopeNonempty.cells C U k p hO hp private theorem hsr₀ : @@ -370,9 +374,8 @@ theorem SubtileLatticeAdjacentPackingSymmetryTransport obtain ⟨negative, hphase, hvec⟩ := BandPackingSymmetryAffineVectorCovariance g q hq have support_nonempty := SubtileTransportGeometry.support_nonempty - have hT₀ne := support_nonempty (q 0) T₀ h₀ p₀ - (ProperBandCurvatureStructure q hq).1 hO₀ hp₀ - have hTᵢne := support_nonempty (q i.succ) Tᵢ hᵢ pᵢ hparent hOᵢ hpᵢ + have hT₀ne := support_nonempty (q 0) T₀ h₀ p₀ hO₀ hp₀ + have hTᵢne := support_nonempty (q i.succ) Tᵢ hᵢ pᵢ hOᵢ hpᵢ obtain ⟨hOT₀, _, hST₀⟩ := BandPackingSymmetryTileOdometerCovariance g (q 0) T₀ h₀ hO₀ obtain ⟨hOTᵢ, _, hSTᵢ⟩ := diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean index 7e10c6edfc..a5c90c2a33 100644 --- a/LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean @@ -256,8 +256,8 @@ private theorem reflectedAt278 : exact ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple q) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 : - ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileOdometer (q - i.succ) (S i s) (hs i s)) → ((∀ (x : GaussianInt), x ∈ h.domain ↔ ∃ (i : Fin (3 : ℕ)) + ℕ) → Bool → PartialOdometer), + ((∀ (x : GaussianInt), x ∈ h.domain ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (hs i s).domain) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ x ∈ (hs i s).domain, h.value x = (hs i s).value x) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), OdometerCompatibility (hs i s) (hs j t)) → ((∀ (i : Fin @@ -282,7 +282,7 @@ private theorem reflectedAt278 : = true then (1 : Real) else -1) • d i) → (TileOdometer (q 0) (TileHalfTurn T) (PartialOdometerHalfTurn h))))))))))) ) := by classical - intro T h q hq S hs hsub hdom hvalue hcompat hslope ih reflected_cells reflected_foot d + intro T h q hq S hs hdom hvalue hcompat hslope ih reflected_cells reflected_foot d reflected_centroid apply TileOdometer.decompose (S := fun i s => TileHalfTurn (S i (!s))) (hs := fun i s => PartialOdometerHalfTurn (hs i (!s))) hq @@ -423,7 +423,7 @@ theorem TileOdometerCentralSymmetry CentralSymmetryGeometry.reflected_centroid T q S hcentroid have reflected : TileOdometer (q 0) (TileHalfTurn T) (PartialOdometerHalfTurn h) := CentralSymmetryGeometry.reflectedAt278 - T h q hq S hs hsub hdom hvalue hcompat hslope ih reflected_cells reflected_foot + T h q hq S hs hdom hvalue hcompat hslope ih reflected_cells reflected_foot reflected_centroid refine ⟨reflected, ?_⟩ obtain ⟨v, hv, _⟩ := TileOdometerTranslationUniqueness diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean index 1f958dc951..29e095cfe0 100644 --- a/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean @@ -67,32 +67,33 @@ private theorem hpositive : (by classical exact - (BandCircle) → ((ℕ) → (∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g - : BandPackingSymmetry), - let q' := BandPackingSymmetryQuadrupleAction g - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - (BandOrderedGeneralConfiguration q') → (∀ (i : Fin 3), 0 < (q' i.succ).1))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (r : Fin (3 : ℕ)), + ∀ (g : BandPackingSymmetry), + let q' := + BandPackingSymmetryQuadrupleAction g + ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] + BandOrderedGeneralConfiguration q' → ∀ (i : Fin 3), 0 < (q' i.succ).1 + ) := by classical - intro C n q r g q' cfg i + intro q r g q' cfg i have hnonneg := (ProperBandCurvatureStructure q' cfg.proper).2.1 i have hnonzero := cfg.noLine i.succ omega private theorem smallT1 : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (r : Fin (3 : ℕ)), ∀ (g : BandPackingSymmetry), - let q' := BandPackingSymmetryQuadrupleAction g - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - ∀ (p : Fin 4 → CircleCoordinates), ∀ (V : ProtoTile), ∀ (S : Fin 3 → Bool → ProtoTile), - ProperBandQuadruple p → BandPrototile (p 0) V → (∀ i, ∀ s, BandSubtileOccurrence p V - i s (S i s)) → (∀ x, x ∈ V.cells ↔ ∃ i s, x ∈ (S i s).cells) → Int.toNat (p 0).1 < - Int.toNat (q' 0).1 → LatticeTile V ∧ TileArea V = Int.toNat (p 0).1 ∧ ∀ i, ∀ s, - LatticeTile (TileCellComplement V (S i s)) ∧ TileTouching (TileCellComplement V (S i - s)) (S i s) ) := by + ∀ (p : Fin 4 → CircleCoordinates) (V : ProtoTile) (S : Fin 3 → Bool → ProtoTile), + ProperBandQuadruple p → + BandPrototile (p 0) V → + (∀ i s, BandSubtileOccurrence p V i s (S i s)) → + (∀ x, x ∈ V.cells ↔ ∃ i s, x ∈ (S i s).cells) → + LatticeTile V ∧ + TileArea V = Int.toNat (p 0).1 ∧ + ∀ i s, + LatticeTile (TileCellComplement V (S i s)) ∧ + TileTouching (TileCellComplement V (S i s)) (S i s) := by classical - intro q r g q' p V S hp hV hS hcover _ + intro p V S hp hV hS hcover have facts := BandTileSimultaneousInduction p hp V hV exact ⟨facts.1, facts.2.1, facts.2.2.1 S hS hcover⟩ @@ -490,14 +491,20 @@ theorem TileOdometerExists (C : BandCircle) : · rcases hother with ⟨⟨K, _, hK⟩, _⟩ | ⟨⟨cfg⟩, _⟩ · obtain ⟨h, ho, _⟩ := DiamondTileOdometerRestriction K exact ⟨DiamondTile K.1, h, by simpa [hK] using ho⟩ - · have hpositive (i : Fin 3) := TileOdometerExistenceGeometry.hpositive C n q r g cfg i + · have hpositive (i : Fin 3) := TileOdometerExistenceGeometry.hpositive q r g cfg i let C' : BandCircle := ⟨⟨q' 0, Or.inl (by simpa [hcurv] using C.2), q', cfg.proper.1, 0, rfl⟩, by simpa [hcurv] using C.2⟩ obtain ⟨T, hT⟩ := BandPrototileExists C'.1 change BandPrototile (q' 0) T at hT -- Discharge the smaller layout premises, including line and unit T2. - have smallT1 := TileOdometerExistenceGeometry.smallT1 q r g + have smallT1 (p : Fin 4 → CircleCoordinates) (V : ProtoTile) + (S : Fin 3 → Bool → ProtoTile) (hp : ProperBandQuadruple p) + (hV : BandPrototile (p 0) V) + (hS : ∀ i s, BandSubtileOccurrence p V i s (S i s)) + (hcover : ∀ x, x ∈ V.cells ↔ ∃ i s, x ∈ (S i s).cells) + (_ : Int.toNat (p 0).1 < Int.toNat (q' 0).1) := + TileOdometerExistenceGeometry.smallT1 p V S hp hV hS hcover have smallT2 := TileOdometerExistenceGeometry.smallT2 q r g obtain ⟨cert⟩ := BandOrderedGeneralLayout q' cfg C' rfl T hT smallT1 smallT2 diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean index 28f281f89e..4ee8b370fb 100644 --- a/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean @@ -35,9 +35,10 @@ private theorem positive_parent : (by classical exact - (CircleCoordinates) → (∀ q, ProperBandQuadruple q → ∃ i : Fin 3, 0 < (q i.succ).1) ) := by + ∀ q, ProperBandQuadruple q → ∃ i : Fin 3, 0 < (q i.succ).1 + ) := by classical - intro C q hq + intro q hq have f := ProperBandCurvatureStructure q hq by_cases h0 : 0 < (q (0 : Fin 3).succ).1 · exact ⟨0, h0⟩ @@ -53,10 +54,11 @@ private theorem proper_large : (by classical exact - (CircleCoordinates) → ((∀ q, ProperBandQuadruple q → ∃ i : Fin 3, 0 < (q i.succ).1) → (∀ - q, ProperBandQuadruple q → 1 < (q 0).1)) ) := by + (∀ q, ProperBandQuadruple q → ∃ i : Fin 3, 0 < (q i.succ).1) → + ∀ q, ProperBandQuadruple q → 1 < (q 0).1 + ) := by classical - intro C positive_parent q hq + intro positive_parent q hq obtain ⟨i, hi⟩ := positive_parent q hq have hb := hq.2 i omega @@ -156,11 +158,18 @@ private theorem unit_shift : (by classical exact - (CircleCoordinates) → (∀ (z : GaussianInt), ∀ (x : GaussianInt), ∀ (V : ProtoTile), ∀ (k - : PartialOdometer), V.cells = {x} → (k.domain : Set GaussianInt) = FootprintVertices - V → ∀ v, (∀ y, y ∈ k.domain ↔ y-v ∈ (CurvatureOneOdometer z).domain) → v=x) ) := by + ∀ (z : GaussianInt), + ∀ (x : GaussianInt), + ∀ (V : ProtoTile), + ∀ (k : PartialOdometer), + V.cells = { x } → + (k.domain : Set GaussianInt) = FootprintVertices V → + ∀ v, + (∀ y, y ∈ k.domain ↔ y - v ∈ (CurvatureOneOdometer z).domain) → + v = x + ) := by classical - intro C z x V k hc hd v hv + intro z x V k hc hd v hv have hn : V.cells.Nonempty := by rw [hc]; simp have h0 : v ∈ FootprintVertices V := by rw [← hd] @@ -245,11 +254,14 @@ private theorem hzAt354 : (by classical exact - (CircleCoordinates) → (∀ (z : GaussianInt), ∀ (z' : GaussianInt), (((1 : ℤ), (1 : - GaussianInt) + (2 : GaussianInt) * z') = ((1 : ℤ), (1 : GaussianInt) + (2 : - GaussianInt) * z)) → (z = z')) ) := by + ∀ (z : GaussianInt), + ∀ (z' : GaussianInt), + ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z') = + ((1 : ℤ), (1 : GaussianInt) + (2 : GaussianInt) * z) → + z = z' + ) := by classical - intro C z z' he + intro z z' he have hh := congrArg (fun D : CircleCoordinates => D.2) he apply Zsqrtd.ext · have hr := congrArg (fun w : GaussianInt => w.re) hh @@ -336,37 +348,85 @@ private theorem coefficients : (by classical exact - (CircleCoordinates) → ((∀ (k : PartialOdometer), ∀ (l : PartialOdometer), ∀ (u : - GaussianInt), ∀ (a : GaussianInt), ∀ (b : ℤ), (∀ x, x ∈ k.domain ↔ x-u ∈ l.domain) → - (∀ x, x ∈ k.domain → k.value x = l.value (x-u) + a.re*x.re + a.im*x.im+b) → k = - PartialOdometerAffineTranslate l u a b) → (∀ (k : PartialOdometer), ∀ (q : Fin (4 : - ℕ) → CircleCoordinates), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin - (3 : ℕ)), ∀ (s : Bool), (q i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ × ℝ) (p_i : ℝ × ℝ), - PartialOdometerSlope k = some p ∧ PartialOdometerSlope (hs i s) = some p_i ∧ p_i.1 - - p.1 = (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q - (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - - (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : - ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / - 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : - ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : - Fin (3 : ℕ))).succ)).re : ℝ))) → (∀ (l : PartialOdometer), ∀ (u : GaussianInt), ∀ (rs - : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (q - i.succ).1 = (0 : ℤ) ∨ ∃ (p : ℝ × ℝ) (p_i : ℝ × ℝ), PartialOdometerSlope l = some p ∧ - PartialOdometerSlope (rs i s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) - else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q - (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = true - then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : - Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((Fin (3 : ℕ)) → (∀ - (p : ℝ × ℝ), (PartialOdometerSlope k = some p) → (∀ (p' : ℝ × ℝ), - (PartialOdometerSlope l = some p') → (∀ i, ∀ s, 0 < (q i.succ).1 → ∀ (ai : - GaussianInt), ∀ (bi : ℤ), (∀ x, x ∈ (hs i s).domain ↔ x-u ∈ (rs i s).domain) → (∀ x, - x ∈ (hs i s).domain → (hs i s).value x = (rs i s).value - (x-u)+ai.re*x.re+ai.im*x.im+bi) → (ai.re : ℝ) = p.1-p'.1 ∧ (ai.im : ℝ) = - p.2-p'.2))))))) ) := by + (∀ (k : PartialOdometer), + ∀ (l : PartialOdometer), + ∀ (u : GaussianInt), + ∀ (a : GaussianInt), + ∀ (b : ℤ), + (∀ x, x ∈ k.domain ↔ x - u ∈ l.domain) → + (∀ x, + x ∈ k.domain → + k.value x = l.value (x - u) + a.re * x.re + a.im * x.im + b) → + k = PartialOdometerAffineTranslate l u a b) → + ∀ (k : PartialOdometer), + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + (q i.succ).1 = (0 : ℤ) ∨ + ∃ (p : ℝ × ℝ) (p_i : ℝ × ℝ), + PartialOdometerSlope k = some p ∧ + PartialOdometerSlope (hs i s) = some p_i ∧ + p_i.1 - p.1 = + (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).re : + ℝ) - + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).im : + ℝ)) ∧ + p_i.2 - p.2 = + (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).im : + ℝ) + + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).re : + ℝ))) → + ∀ (l : PartialOdometer), + ∀ (u : GaussianInt), + ∀ (rs : Fin (3 : ℕ) → Bool → PartialOdometer), + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + (q i.succ).1 = (0 : ℤ) ∨ + ∃ (p : ℝ × ℝ) (p_i : ℝ × ℝ), + PartialOdometerSlope l = some p ∧ + PartialOdometerSlope (rs i s) = some p_i ∧ + p_i.1 - p.1 = + (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).re : + ℝ) - + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).im : + ℝ)) ∧ + p_i.2 - p.2 = + (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).im : + ℝ) + + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).re : + ℝ))) → + ∀ (p : ℝ × ℝ), + PartialOdometerSlope k = some p → + ∀ (p' : ℝ × ℝ), + PartialOdometerSlope l = some p' → + ∀ i, + ∀ s, + 0 < (q i.succ).1 → + ∀ (ai : GaussianInt), + ∀ (bi : ℤ), + (∀ x, x ∈ (hs i s).domain ↔ x - u ∈ (rs i s).domain) → + (∀ x, + x ∈ (hs i s).domain → + (hs i s).value x = + (rs i s).value (x - u) + ai.re * x.re + ai.im * x.im + + bi) → + (ai.re : ℝ) = p.1 - p'.1 ∧ (ai.im : ℝ) = p.2 - p'.2 + ) := by classical - intro C affine_eq k q hs hslope l u rs rslope j p hp0 p' hp1 i s hi ai bi hd hv + intro affine_eq k q hs hslope l u rs rslope p hp0 p' hp1 i s hi ai bi hd hv obtain ⟨pp,ii,hpp,hii,dx,dy⟩ := (hslope i s).resolve_left (by omega) obtain ⟨qq,jj,hqq,hjj,ex,ey⟩ := (rslope i s).resolve_left (by omega) have heq := affine_eq (hs i s) (rs i s) u ai bi hd hv @@ -429,15 +489,21 @@ private theorem parent_positive : (by classical exact - (CircleCoordinates) → ((∀ D, ∀ V, ∀ k, TileOdometer D V k → BandPrototile D V) → ((∀ D, ∀ - V, BandPrototile D V → D.1 = 0 → V.cells = ∅) → (∀ (q : Fin (4 : ℕ) → - CircleCoordinates), (ProperBandQuadruple q) → (∀ (S : Fin (3 : ℕ) → Bool → - ProtoTile), ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), (∀ (i : Fin (3 : ℕ)), ∀ (s - : Bool), TileOdometer (q i.succ) (S i s) (hs i s)) → ((Fin (3 : ℕ)) → (∀ (i : Fin 3), - ∀ (s : Bool), ∀ (x : GaussianInt), (x ∈ (S i s).cells) → (0 < (q i.succ).1))))))) ) + (∀ D, ∀ V, ∀ k, TileOdometer D V k → BandPrototile D V) → + (∀ D, ∀ V, BandPrototile D V → D.1 = 0 → V.cells = ∅) → + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q → + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + ∀ (hs : Fin (3 : ℕ) → Bool → PartialOdometer), + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), TileOdometer (q i.succ) (S i s) (hs i s)) → + ∀ (i : Fin 3), + ∀ (s : Bool), + ∀ (x : GaussianInt), x ∈ (S i s).cells → 0 < (q i.succ).1 + ) := by classical - intro C proto zero_cells q hq S hs hsub j i s x hx + intro proto zero_cells q hq S hs hsub i s x hx have hn := (ProperBandCurvatureStructure q hq).2.1 i by_contra hn' have hz : (q i.succ).1 = 0 := by omega @@ -628,9 +694,9 @@ theorem TileOdometerTranslationUniqueness have hUproto : BandPrototile C U := TileOdometerBandPrototile C U g hU have proto : ∀ D V k, TileOdometer D V k → BandPrototile D V := TileOdometerBandPrototile have positive_parent : ∀ q, ProperBandQuadruple q → - ∃ i : Fin 3, 0 < (q i.succ).1 := OdometerTranslationGeometry.positive_parent C + ∃ i : Fin 3, 0 < (q i.succ).1 := OdometerTranslationGeometry.positive_parent have proper_large : ∀ q, ProperBandQuadruple q → 1 < (q 0).1 := - OdometerTranslationGeometry.proper_large C positive_parent + OdometerTranslationGeometry.proper_large positive_parent have positive_cells : ∀ D V, BandPrototile D V → 0 < D.1 → V.cells.Nonempty := (fun D V hV hD => BandPrototileNonempty.positive D V hD hV) have zero_cells : ∀ D V, BandPrototile D V → D.1 = 0 → V.cells = ∅ := @@ -654,7 +720,7 @@ theorem TileOdometerTranslationUniqueness have unit_shift : ∀ (z x : GaussianInt) (V : ProtoTile) (k : PartialOdometer), V.cells = {x} → (k.domain : Set GaussianInt) = FootprintVertices V → ∀ v, (∀ y, y ∈ k.domain ↔ y-v ∈ (CurvatureOneOdometer z).domain) → v=x := - OdometerTranslationGeometry.unit_shift C + OdometerTranslationGeometry.unit_shift have square_disk : ∀ (V : ProtoTile) (x : GaussianInt), V.cells = {x} → LatticeTile V := OdometerTranslationGeometry.square_disk have disk : ∀ D V k, TileOdometer D V k → 0 < D.1 → LatticeTile V := @@ -681,7 +747,7 @@ theorem TileOdometerTranslationUniqueness have hh := congrArg (fun D : CircleCoordinates => D.1) he norm_num at hh · intro z' y W l hcy hdy hty he hcells hempty - have hz : z = z' := OdometerTranslationGeometry.hzAt354 C z z' he + have hz : z = z' := OdometerTranslationGeometry.hzAt354 z z' he subst z' obtain ⟨v,a,b,hv,hval⟩ := ht obtain ⟨w,c,d,hw,hval'⟩ := hty @@ -734,8 +800,8 @@ theorem TileOdometerTranslationUniqueness (∀ x, x ∈ (hs i s).domain → (hs i s).value x = (rs i s).value (x-u)+ai.re*x.re+ai.im*x.im+bi) → (ai.re : ℝ) = p.1-p'.1 ∧ (ai.im : ℝ) = p.2-p'.2 := - OdometerTranslationGeometry.coefficients C affine_eq k q hs hslope l u rs - rslope j p hp0 p' hp1 + OdometerTranslationGeometry.coefficients affine_eq k q hs hslope l u rs + rslope p hp0 p' hp1 have ca := coefficients j false hj a b0 hd0 hv0 have common : ∀ i s, 0 < (q i.succ).1 → ∃ b : ℤ, (∀ x, x ∈ (hs i s).domain ↔ x-u ∈ (rs i s).domain) ∧ @@ -756,7 +822,7 @@ theorem TileOdometerTranslationUniqueness have tilene : V.cells.Nonempty := positive_cells _ V hV hp have parent_positive (i : Fin 3) (s : Bool) (x : GaussianInt) (hx : x ∈ (S i s).cells) : 0 < (q i.succ).1 := - OdometerTranslationGeometry.parent_positive C proto zero_cells q hq S hs hsub j i + OdometerTranslationGeometry.parent_positive proto zero_cells q hq S hs hsub i s x hx have cellcover : ∀ x, x ∈ V.cells ↔ ∃ t, x ∈ (tiles t).cells := OdometerTranslationGeometry.cellcover V q S hcells j selected parent_positive diff --git a/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean b/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean index 5309c23d76..c9f937003c 100644 --- a/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean @@ -375,13 +375,28 @@ private theorem internal_strip : (by classical exact - (GaussianInt) → ((GaussianInt) → (∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), ∀ (xs : List (Int × - Int)), TriangularStripSegment r s xs ↔ xs.head? = some r ∧ xs.getLast? = some s ∧ - xs.Nodup ∧ xs.IsChain TriangularLatticeAdjacent ∧ (∀ pre, ∀ z, ∀ post, xs = pre ++ z - :: post → pre ≠ [] → post ≠ [] → 0 ≤ TriangularSignedHeight r s z ∧ ∃ u, - TriangularLatticeAdjacent z u ∧ TriangularSignedHeight r s u < 0))) ) := by + GaussianInt → + ∀ (r : ℤ × ℤ), + ∀ (s : ℤ × ℤ), + ∀ (xs : List (Int × Int)), + TriangularStripSegment r s xs ↔ + xs.head? = some r ∧ + xs.getLast? = some s ∧ + xs.Nodup ∧ + xs.IsChain TriangularLatticeAdjacent ∧ + ∀ pre, + ∀ z, + ∀ post, + xs = pre ++ z :: post → + pre ≠ [] → + post ≠ [] → + 0 ≤ TriangularSignedHeight r s z ∧ + ∃ u, + TriangularLatticeAdjacent z u ∧ + TriangularSignedHeight r s u < 0 + ) := by classical - intro a b r s xs + intro a r s xs by_cases hrs : r = s · subst s constructor @@ -811,7 +826,7 @@ theorem TileStringCoordinateTransport (C : BandCircle) (orientation : Bool) (∀ pre z post, xs = pre ++ z :: post → pre ≠ [] → post ≠ [] → 0 ≤ TriangularSignedHeight r s z ∧ ∃ u, TriangularLatticeAdjacent z u ∧ TriangularSignedHeight r s u < 0) := - StringCoordinateGeometry.internal_strip a b r s xs + StringCoordinateGeometry.internal_strip a r s xs let physical := fun T : ProtoTile => ((TileCentroid T).2 - (TileCentroid (tileAt r)).2) * ((TileCentroid (tileAt s)).1 - (TileCentroid (tileAt r)).1) - diff --git a/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean index fc09d2c5bf..746b75d388 100644 --- a/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean @@ -43,11 +43,13 @@ private theorem reflect_height : (by classical exact - (GaussianInt) → ((GaussianInt) → (∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), - let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) - ∀ z, TriangularBoundaryStrip r s z → TriangularBoundaryStrip s r (reflect z))) ) := by + ∀ (r : ℤ × ℤ), + ∀ (s : ℤ × ℤ), + let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) + ∀ z, TriangularBoundaryStrip r s z → TriangularBoundaryStrip s r (reflect z) + ) := by classical - intro a b r s reflect z hz + intro r s reflect z hz have hh : TriangularSignedHeight s r (reflect z) = TriangularSignedHeight r s z := by dsimp [TriangularSignedHeight, reflect] @@ -72,11 +74,13 @@ private theorem reflect_sub : (by classical exact - (GaussianInt) → ((GaussianInt) → (∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), - let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) - ∀ x, ∀ y, reflect y - reflect x = -(y - x))) ) := by + ∀ (r : ℤ × ℤ), + ∀ (s : ℤ × ℤ), + let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) + ∀ x, ∀ y, reflect y - reflect x = -(y - x) + ) := by classical - intro a b r s reflect x y + intro r s reflect x y apply Prod.ext <;> dsimp [reflect] <;> omega private theorem reflect_adjacent : @@ -114,14 +118,22 @@ private theorem reflected_segment : (by classical exact - (GaussianInt) → ((GaussianInt) → (∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), ∀ (coordinates : List (ℤ - × ℤ)), (TriangularStripSegment r s coordinates) → ( - let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) - (∀ z, TriangularBoundaryStrip r s z → TriangularBoundaryStrip s r (reflect z)) → ((∀ x, ∀ - y, TriangularLatticeAdjacent x y → TriangularLatticeAdjacent (reflect x) (reflect y)) - → (TriangularStripSegment s r (coordinates.map reflect)))))) ) := by + ∀ (r : ℤ × ℤ), + ∀ (s : ℤ × ℤ), + ∀ (coordinates : List (ℤ × ℤ)), + TriangularStripSegment r s coordinates → + let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) + (∀ z, + TriangularBoundaryStrip r s z → + TriangularBoundaryStrip s r (reflect z)) → + (∀ x, + ∀ y, + TriangularLatticeAdjacent x y → + TriangularLatticeAdjacent (reflect x) (reflect y)) → + TriangularStripSegment s r (coordinates.map reflect) + ) := by classical - intro a b r s coordinates hsegment reflect reflect_height reflect_adjacent + intro r s coordinates hsegment reflect reflect_height reflect_adjacent by_cases hrs : r = s · have heq : coordinates = [r] := by simpa [TriangularStripSegment, hrs] using hsegment simp [TriangularStripSegment, hrs, reflect, heq] @@ -353,10 +365,13 @@ private theorem translated_band : (by classical exact - ∀ (C : BandCircle), ∀ (base : ProtoTile), (BandPrototile C.1.1 base) → (∀ v : - GaussianInt, v ∈ TilingLattice C → BandPrototile C.1.1 (TileTranslation base v)) ) := by + ∀ (C : BandCircle), + ∀ (base : ProtoTile), + BandPrototile C.1.1 base → + ∀ v : GaussianInt, BandPrototile C.1.1 (TileTranslation base v) + ) := by classical - intro C base hbase v hv + intro C base hbase v exact BandPrototileTranslation C.1.1 base v hbase private theorem centroid_transform : @@ -609,10 +624,10 @@ theorem TileStringRegularFamilyCentralCovariance hcorr let reverseTiles := coordinates.map (fun z => tileAt (reflect z)) have reverse_string := RegularStringCentralGeometry.reverse_string C orientation base R S a b - htransport r hr s hs coordinates (RegularStringCentralGeometry.reflected_segment a b r s - coordinates hsegment (RegularStringCentralGeometry.reflect_height a b r s) + htransport r hr s hs coordinates (RegularStringCentralGeometry.reflected_segment r s + coordinates hsegment (RegularStringCentralGeometry.reflect_height r s) (RegularStringCentralGeometry.reflect_adjacent r s - (RegularStringCentralGeometry.reflect_sub a b r s))) + (RegularStringCentralGeometry.reflect_sub r s))) (RegularStringCentralGeometry.reverse_corr base a b r s coordinates) obtain ⟨cbase, hcbase⟩ : ∃ cbase : GaussianInt, GaussianRealPoint cbase = TileCentroid base + TileCentroid base := by @@ -626,7 +641,12 @@ theorem TileStringRegularFamilyCentralCovariance (TileTranslation (TileHalfTurn base) u) := rawString.1 have cell_transport := RegularStringCentralGeometry.cell_transport C base tiles a b ha hb r s cbase hcbase (RegularStringCentralGeometry.transformed_band C orientation base R S tiles a - b r s cbase rawString rawBase) (RegularStringCentralGeometry.translated_band C base hbase) + b r s cbase rawString rawBase) ((show + ∀ v : GaussianInt, v ∈ TilingLattice C → BandPrototile C.1.1 + (TileTranslation base v) + from by + intro v hv + exact RegularStringCentralGeometry.translated_band C base hbase v)) (RegularStringCentralGeometry.centroid_transform a b r s cbase) exact ⟨u, reverseTiles, (RegularStringCentralGeometry.hu base R S a b r hr s hs cbase hcbase), reverse_string, (RegularStringCentralGeometry.endpoint_R base R S tiles hhead a b r hr s hs diff --git a/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean b/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean index 7d0283c1e1..a41b8ce036 100644 --- a/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean +++ b/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean @@ -215,10 +215,13 @@ private theorem hcenter : (by classical exact - (Fin 4 → CircleCoordinates) → ((ProtoTile) → (∀ (U : ProtoTile), ∀ (z : GaussianInt), z ∈ - U.cells ↔ ((z.re : Real) + 1 / 2, (z.im : Real) + 1 / 2) ∈ TileRealization U)) ) := by + ∀ (U : ProtoTile), + ∀ (z : GaussianInt), + z ∈ U.cells ↔ + ((z.re : Real) + 1 / 2, (z.im : Real) + 1 / 2) ∈ TileRealization U + ) := by classical - intro q T U z + intro U z constructor · intro hz simp only [TileRealization, Set.mem_iUnion] @@ -357,7 +360,7 @@ theorem TileT1DiskArea (q : Fin 4 → CircleCoordinates) have htau := TileHalfTurnGeometry.involutive q u have hHcells := TileHalfTurnGeometry.cells q u have hHreal := TileHalfTurnGeometry.realization q T u ht - have hcenter := DiskAreaGeometry.hcenter q T + have hcenter := DiskAreaGeometry.hcenter have hreflectCells := DiskAreaGeometry.hreflectCells q T u hHreal hcenter have hHT : (H T).cells = T.cells := hreflectCells T T (BandPrototileCentralSymmetry (q 0) T hT) diff --git a/LeanPool/ApollonianSuperharmonic/TriangularStripSegmentOrderInterval.lean b/LeanPool/ApollonianSuperharmonic/TriangularStripSegmentOrderInterval.lean index 55b582d4dc..85d0b45c75 100644 --- a/LeanPool/ApollonianSuperharmonic/TriangularStripSegmentOrderInterval.lean +++ b/LeanPool/ApollonianSuperharmonic/TriangularStripSegmentOrderInterval.lean @@ -26,12 +26,16 @@ namespace ApollonianSuperharmonic namespace StripOrderIntervalProof private theorem walk : - (Int × Int) → ((Int × Int) → (∀ (p : List Int), ∀ (a : Int), ∀ (b : Int), p.head? = some a → - p.getLast? = some b → p.Nodup → - p.IsChain (fun u v : Int => v = u + 1 ∨ u = v + 1) → - (∀ z : Int, z ∈ p ↔ min a b ≤ z ∧ z ≤ max a b))) := by + ∀ (p : List Int), + ∀ (a : Int), + ∀ (b : Int), + p.head? = some a → + p.getLast? = some b → + p.Nodup → + (p.IsChain fun u v : Int => v = u + 1 ∨ u = v + 1) → + ∀ z : Int, z ∈ p ↔ min a b ≤ z ∧ z ≤ max a b := by classical - intro x y p + intro p induction p using List.reverseRecOn with | nil => intro a b ha hb hn hc @@ -176,14 +180,22 @@ private theorem hindices_chain : · exact hdata.2.2.2.2 private theorem trim_property : - ∀ (x : Int × Int), ∀ (y : Int × Int), (ℤ ≃ { z : ℤ × ℤ // TriangularBoundaryStrip x y z }) → - ((ℤ) → ((ℤ) → ((∀ (p : List Int), ∀ (a : Int), ∀ (b : Int), p.head? = some a → p.getLast? - = some b → p.Nodup → p.IsChain (fun u v : Int => v = u + 1 ∨ u = v + 1) → (∀ z : Int, z ∈ - p ↔ min a b ≤ z ∧ z ≤ max a b)) → (∀ (l : List Int), ∀ (a : Int), ∀ (b : Int), l.head? = - some a → l.getLast? = some b → l.Nodup → - ∀ q, q ∈ (l.drop 1).dropLast ↔ q ∈ l ∧ q ≠ a ∧ q ≠ b)))) := by + (∀ (p : List Int), + ∀ (a : Int), + ∀ (b : Int), + p.head? = some a → + p.getLast? = some b → + p.Nodup → + (p.IsChain fun u v : Int => v = u + 1 ∨ u = v + 1) → + ∀ z : Int, z ∈ p ↔ min a b ≤ z ∧ z ≤ max a b) → + ∀ (l : List Int), + ∀ (a : Int), + ∀ (b : Int), + l.head? = some a → + l.getLast? = some b → + l.Nodup → ∀ q, q ∈ (l.drop 1).dropLast ↔ q ∈ l ∧ q ≠ a ∧ q ≠ b := by classical - intro x y order m n walk l + intro walk l cases l with | nil => intro a b ha hb hn q @@ -317,7 +329,7 @@ theorem TriangularStripSegmentOrderInterval have walk : ∀ (p : List Int) (a b : Int), p.head? = some a → p.getLast? = some b → p.Nodup → p.IsChain (fun u v : Int => v = u + 1 ∨ u = v + 1) → - (∀ z : Int, z ∈ p ↔ min a b ≤ z ∧ z ≤ max a b) := StripOrderIntervalProof.walk x y + (∀ z : Int, z ∈ p ↔ min a b ≤ z ∧ z ≤ max a b) := StripOrderIntervalProof.walk have hfirst : path.head? = some x := hdata.1 have hlast : path.getLast? = some y := hdata.2.1 classical @@ -353,7 +365,7 @@ theorem TriangularStripSegmentOrderInterval have trim_property : ∀ (l : List Int) (a b : Int), l.head? = some a → l.getLast? = some b → l.Nodup → ∀ q, q ∈ (l.drop 1).dropLast ↔ q ∈ l ∧ q ≠ a ∧ q ≠ b := - StripOrderIntervalProof.trim_property x y order m n walk + StripOrderIntervalProof.trim_property walk have hmaptrim : ∀ z, TriangularBoundaryStrip x y z → (z ∈ (path.drop 1).dropLast ↔ index z ∈ (indices.drop 1).dropLast) := StripOrderIntervalProof.hmaptrim x y path order From 6f193e85f6399dc19f37f9156deb9077c83998c4 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 13 Nov 2026 08:46:34 +0000 Subject: [PATCH 14/23] Refine helper interfaces and share geometric facts --- .../AncestorOdometerRestriction.lean | 81 +- ...BandExceptionalRestorationSectorOrder.lean | 30 +- .../BandModifiedPeriodicComplex.lean | 11 +- .../BandOrderedGeneralChildInterfaces.lean | 20 - .../BandOrderedGeneralGeometricSectors.lean | 306 ++++---- .../BandOrderedGeneralLayout.lean | 40 +- ...BandOrderedGeneralPositiveCutGeometry.lean | 76 +- .../BandOrderedGeneralRawSupport.lean | 24 +- ...dGeneralRightRoutingCertificateExists.lean | 413 ++++++----- .../BandOrientedChildParentRightEndpoint.lean | 72 +- ...lOccurrenceIntersectionClassification.lean | 16 +- ...PackingSymmetryAffineVectorCovariance.lean | 277 ++++--- ...ndPackingSymmetryMarkedDataCovariance.lean | 343 ++++----- .../BandPackingSymmetryT3T5Covariance.lean | 48 +- ...PackingSymmetryTileOdometerCovariance.lean | 56 +- ...ndPositiveCutBranchCompanionExclusion.lean | 10 +- .../BandPrototileCompleteSquareCentroid.lean | 37 +- .../BandPrototileExists.lean | 28 +- .../BandRegularTranslatePeriodicComplex.lean | 23 +- .../BandTileTopologyApplication.lean | 62 +- .../BoundaryStringConcatenation.lean | 16 +- ...CoveredInterfaceOppositeIncidentCells.lean | 12 +- .../DiamondExceptionalMaximality.lean | 32 +- ...amondOpposingBoundaryStarLocalization.lean | 124 ++-- ...isjointBoundaryCommonEdgeGraphAcyclic.lean | 27 +- .../ExceptionalModifiedABPath.lean | 18 +- ...niteConnectedAcyclicDegreeTwoGridPath.lean | 44 +- .../FiniteSquareIncidenceIdentities.lean | 38 +- .../FordLaplacianTable.lean | 31 +- .../FordLeftBoundaryCompatibility.lean | 157 ++-- .../FordOpposingBoundaryStarLocalization.lean | 60 +- .../FordOrientedChildParentEndpoints.lean | 59 +- .../FordTerminalWebStencilLedger.lean | 187 +++-- .../FordTileCellMembership.lean | 42 ++ .../FordTileOdometerRestriction.lean | 12 +- LeanPool/ApollonianSuperharmonic/Imports.lean | 1 + .../LatticeAdjacentInterfacePath.lean | 62 +- .../LatticeTileBoundarySimpleGridCycle.lean | 121 ++- .../LatticeTileFourNeighborConnected.lean | 37 +- .../LatticeTileThreeDiskJunction.lean | 26 +- .../ListEndpointFacts.lean | 12 + .../LocalLatticeInterfaceSectors.lean | 236 +++--- .../MarkedOdometerAdjacencyReduction.lean | 98 +-- .../OpposingBoundaryOdometerStrings.lean | 146 ++-- .../OpposingBoundaryStarLocalization.lean | 48 +- .../OpposingStringInterfacePath.lean | 67 +- ...eneralOdometerAdjacencyClassification.lean | 51 +- ...eredGeneralMixedAggregateJunctionData.lean | 16 +- ...dGeneralMixedAggregatePairedEndpoints.lean | 60 +- .../P3381T1TriangulationBoundary.lean | 77 +- .../P3475T1GridBoundary.lean | 12 +- .../P3523T1InsertionGeometry.lean | 69 +- .../P3523T1InsertionIncidence.lean | 27 +- .../P3523T1TwoTriangleSplit.lean | 11 +- .../P3555T2ParabolaHullFrontier.lean | 63 +- .../P3555T2SavedDissectionGeometry.lean | 21 +- .../P3597T1DirectionParity.lean | 23 +- .../P3650T1CyclicChildrenExists.lean | 41 -- .../P3650T1EmptyTriangleDiagonal.lean | 80 +- .../P3650T1LocalCoherence.lean | 65 +- .../P3652T1IndexedFaceLedger.lean | 26 +- .../P3723T1AllContactDrawingExists.lean | 84 ++- .../P3723T1ContactPortsExist.lean | 11 +- .../P3776T1FixedGeometry.lean | 7 +- .../P3776T1WalkMapProperties.lean | 250 ++++--- .../P3821T1ComponentContours.lean | 47 +- .../P3821T1ThreeArcCircle.lean | 155 +--- .../P3889T1FaceGapCoverage.lean | 12 +- .../P3889T1TwoRaySectors.lean | 8 +- .../P3934T1ArcSideComparison.lean | 34 +- .../P3963T1ExteriorMixedCycleObstruction.lean | 110 +-- .../P3963T1MixedBoundaryCycle.lean | 69 +- .../P3996T1PlacementCompanionBlocks.lean | 46 +- ...4055T1OrderedGeneralOppositeEndpoints.lean | 163 +---- .../P4055T1PlacementNormalization.lean | 145 ++-- .../P4062T1CanonicalSupport.lean | 13 +- .../P4062T1OverlapDescent.lean | 86 +-- .../P4112T1LowerNeighbors.lean | 294 +++++--- .../P4112T1ParentalNeighbors.lean | 19 +- .../P4112T1PathGeometry.lean | 365 ++++++--- .../P4120T1FordGeometry.lean | 70 +- .../P4120T1GeneralDescent.lean | 14 +- .../P4158T1EdgeSectorSelection.lean | 46 +- .../P4158T1LargeFirstRestrictions.lean | 24 +- .../P4158T1LargeSecondRestrictions.lean | 127 +--- .../P4158T1MatchedFordPair.lean | 89 ++- .../P4158T1SmallerStringEdges.lean | 331 +++++---- .../P4250T1NestedCompatibility.lean | 123 +--- .../P4250T1OrdinaryCompatibility.lean | 16 +- .../P4250T2InterfaceCycleExclusion.lean | 185 +++-- .../P4250T2InterfaceNeighborCount.lean | 12 +- .../P4261T1SubtileCoordinates.lean | 510 ++----------- .../P4261T2UnitBoundary.lean | 40 +- .../P4261T2UnitInterface.lean | 52 +- .../P4339T1PositivePrecursorRoots.lean | 42 +- .../P4366T1PrecursorPathLoop.lean | 112 +-- .../P4366T1RemainderOuterAttachments.lean | 14 +- .../P4366T2LocalSectors.lean | 43 +- .../P4366T2OuterGeometry.lean | 42 +- .../P4418T3RoutedBlockCriterion.lean | 97 +-- .../P4418T3SelectedInterfaceExists.lean | 158 ++-- .../P4456T2BandGraphTriangle.lean | 96 +-- .../P4456T2CrosscutIndex.lean | 12 +- .../P4456T2MissingEdge.lean | 474 +++--------- .../P4456T2OrderedNoChord.lean | 47 +- .../P4456T2VertexInterior.lean | 31 +- .../P4458T1FirstProperRows.lean | 16 +- .../P4458T1LargestParentRows.lean | 351 ++------- .../P4458T1RespectAppend.lean | 20 +- .../P4458T1SecondNewerRows.lean | 513 +++---------- .../P4536T1AFrameB.lean | 159 +--- .../P4536T1AFrameD.lean | 35 +- .../P4564T2DiamondGeometry.lean | 18 +- .../P4564T2FordGeometry.lean | 21 +- .../P4564T2FordT6Transport.lean | 120 +-- .../P4564T2GeneralT6Transport.lean | 53 +- .../P4590T1JunctionRefinement.lean | 691 +++++++++--------- .../P4590T1MixedCompanionMarks.lean | 14 +- .../P4590T1MixedInteriorGeometry.lean | 179 +---- .../P4590T1RestoredBoundaryGeometry.lean | 129 ++-- .../P4590T1RightInteriorGeometry.lean | 156 ++-- .../P4638T1ContactStarCoverage.lean | 125 +++- .../P4638T1EmptyFordLocalization.lean | 188 +++-- .../P4677T2FacePoints.lean | 26 +- .../P4677T2PrecursorWalk.lean | 38 +- .../P4812T1RegularFaceWalks.lean | 66 +- .../P4849T1LargePositiveComponents.lean | 14 +- .../P4953T1TriangleSections.lean | 7 +- .../P4984T1IncidentArcs.lean | 62 +- .../P5188T1E2Boundary.lean | 5 +- .../P5260T1PredecessorInterfaces.lean | 34 +- .../P5290T1UnitContactPaths.lean | 9 +- .../P5352T2FirstUnit.lean | 40 +- .../P5352T2Predecessor0.lean | 85 +-- .../P5352T2Predecessor1.lean | 4 +- .../P5352T2Predecessor3.lean | 112 +-- .../P5352T2RightHorizontal.lean | 9 +- .../P5472T1FordNormalization.lean | 26 +- .../P5491T1DiamondRightBoundary.lean | 19 +- .../P5596T1LeftWeb.lean | 60 +- ...640T1NonpairedOccurrenceIntersections.lean | 35 +- .../ParentalOrientationGluing.lean | 7 +- .../PeriodicBoundaryWebLaplacian.lean | 213 +++--- .../PeriodicTileContactRoutingRigidity.lean | 60 +- .../PeriodicTileIntersectionPaths.lean | 37 +- .../PeriodicTileTotalIndegree.lean | 147 ++-- .../PositiveCurvatureGeneratorCocycles.lean | 42 +- .../RightSubtileOdometerCompatibility.lean | 25 +- .../SimpleGridPathEndpointPairUnique.lean | 83 ++- ...tticeAdjacentPackingSymmetryTransport.lean | 46 +- .../TileOdometerCentralSymmetry.lean | 12 +- .../TileQuarterTurnFormulas.lean | 9 +- .../TileStringCoordinateTransport.lean | 97 ++- .../TileT1DiskArea.lean | 36 +- .../TilingLatticeBasis.lean | 30 +- 155 files changed, 5054 insertions(+), 8282 deletions(-) create mode 100644 LeanPool/ApollonianSuperharmonic/FordTileCellMembership.lean diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean index c045d8b783..46cce64196 100644 --- a/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean @@ -105,38 +105,57 @@ private theorem hrestrict : (by classical exact - ∀ (domain_from_odo : ∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : - PartialOdometer), TileOdometer c U k → (k.domain : Set GaussianInt) = - FootprintVertices U), - let vertices : ProtoTile → Finset GaussianInt := fun U => - if U.cells.Nonempty then - U.cells.biUnion (fun x => {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) - else {U.anchor} - let restrict : ProtoTile → PartialOdometer → PartialOdometer := - fun U g => - { domain := vertices U - value := fun x => if x ∈ vertices U then g.value x else 0 - value_outside := by - intro x hx - simp [hx] } - (∀ U, ∀ g, ((restrict U g).domain : Set GaussianInt) = FootprintVertices U) → ((∀ a b : - PartialOdometer, (a.domain : Set GaussianInt) = b.domain → (∀ x, x ∈ a.domain → a.value x - = b.value x) → a = b) → ((∀ (c : CircleCoordinates), ∀ (U : ProtoTile), ∀ (k : - PartialOdometer), TileOdometer c U k → BandPrototile c U) → (∀ (X : CircleCoordinates × - ProtoTile), ∀ (Y : CircleCoordinates × ProtoTile), ∀ (g : PartialOdometer), ((↑g.domain : - Set GaussianInt) = FootprintVertices Y.2) → ((TileOdometer Y.1 Y.2 g) → (∀ (q : Fin (4 : - ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (ProperBandQuadruple q) → ((q - (0 : Fin (4 : ℕ)) = Y.1) → ((q i.succ = X.1) → ((BandPrototile Y.1 Y.2) → ((BandPrototile - X.1 X.2) → ((FootprintVertices X.2 ⊆ FootprintVertices Y.2) → ((TileCentroid X.2 - - TileCentroid Y.2 = (if s = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • - (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : - ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i - + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((1 < (q 0).1) → (TileOdometer X.1 - X.2 (restrict X.2 g)))))))))))))) ) := by + (∀ (c : CircleCoordinates), + ∀ (U : ProtoTile), + ∀ (k : PartialOdometer), + TileOdometer c U k → (k.domain : Set GaussianInt) = FootprintVertices U) → + let vertices : ProtoTile → Finset GaussianInt := fun U => + if U.cells.Nonempty then + U.cells.biUnion fun x => {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩} + else { U.anchor }; + let restrict : ProtoTile → PartialOdometer → PartialOdometer := fun U g => + { domain := vertices U + value := fun x => if x ∈ vertices U then g.value x else 0 + value_outside := by + intro x hx + simp [hx] }; + (∀ U, ∀ g, ((restrict U g).domain : Set GaussianInt) = FootprintVertices U) → + (∀ a b : PartialOdometer, + (a.domain : Set GaussianInt) = b.domain → + (∀ x, x ∈ a.domain → a.value x = b.value x) → a = b) → + (∀ (c : CircleCoordinates), + ∀ (U : ProtoTile), + ∀ (k : PartialOdometer), TileOdometer c U k → BandPrototile c U) → + ∀ (X : CircleCoordinates × ProtoTile), + ∀ (Y : CircleCoordinates × ProtoTile), + ∀ (g : PartialOdometer), + (↑g.domain : Set GaussianInt) = FootprintVertices Y.2 → + TileOdometer Y.1 Y.2 g → + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + ProperBandQuadruple q → + q (0 : Fin (4 : ℕ)) = Y.1 → + q i.succ = X.1 → + BandPrototile X.1 X.2 → + FootprintVertices X.2 ⊆ FootprintVertices Y.2 → + TileCentroid X.2 - TileCentroid Y.2 = + (if s = true then (1 : ℝ) else (-1 : ℝ)) • + (1 / 2 : ℝ) • + (GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ))).1)) → + 1 < (q 0).1 → TileOdometer X.1 X.2 (restrict X.2 g) + ) := by classical intro domain_from_odo vertices restrict restrict_domain odo_eq band_from_odo X Y g hgd hgo q i - s hq hq0 hqi hY hX hfoot hcent parent_gt_one + s hq hq0 hqi hX hfoot hcent parent_gt_one cases Y with | mk yc yt => cases hgo with @@ -480,7 +499,7 @@ theorem AncestorOdometerRestriction have facts := ProperBandCurvatureStructure q hq have parent_gt_one : 1 < (q 0).1 := AncestorRestrictionProof.parent_gt_one q hq facts have hrestrict : TileOdometer X.1 X.2 (restrict X.2 g) := AncestorRestrictionProof.hrestrict - domain_from_odo restrict_domain odo_eq band_from_odo X Y g hgd hgo q i s hq hq0 hqi hY hX + domain_from_odo restrict_domain odo_eq band_from_odo X Y g hgd hgo q i s hq hq0 hqi hX hfoot hcent parent_gt_one exact hrestrict have chain_foot : ∀ (p q : CircleCoordinates × ProtoTile), diff --git a/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean b/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean index bb441c4adc..6ee3538ead 100644 --- a/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean +++ b/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties +public import LeanPool.ApollonianSuperharmonic.LatticeTileNonempty public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion public import LeanPool.ApollonianSuperharmonic.TileTouchingDisjoint @@ -157,34 +159,10 @@ private theorem hO : rw [← cert.precursor_eq] at hocc exact tile_from_band (cfg.firstPredecessor (0 : Fin 3).succ) O hocc.1 (Or.inr hOne) -private theorem nonempty_cells : - (by - classical - exact - ∀ (U : ProtoTile), (LatticeTile U) → (U.cells.Nonempty) ) := by - classical - intro U hU - rcases hU with ⟨hhome⟩ - let z : (Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) := - ⟨0, by simp [Metric.mem_closedBall]⟩ - have hreal : (TileRealization U).Nonempty := ⟨(hhome z).val, (hhome z).property⟩ - by_contra hn - have he : U.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hn - simp [TileRealization, he] at hreal +private abbrev nonempty_cells := ApollonianSuperharmonic.LatticeTileNonempty.cells -private theorem trzero : - (by - classical - exact - ∀ (Y : ProtoTile), TileTranslation Y 0 = Y ) := by - classical - intro Y - have hfun : GaussianTranslation 0 = id := by - funext z - simp [GaussianTranslation] - cases Y - simp [TileTranslation, hfun] +private abbrev trzero := ApollonianSuperharmonic.TileTranslationProperties.zero private theorem htileComp : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandModifiedPeriodicComplex.lean b/LeanPool/ApollonianSuperharmonic/BandModifiedPeriodicComplex.lean index e922cc9e05..9c07e6539d 100644 --- a/LeanPool/ApollonianSuperharmonic/BandModifiedPeriodicComplex.lean +++ b/LeanPool/ApollonianSuperharmonic/BandModifiedPeriodicComplex.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeTileNonempty public import LeanPool.ApollonianSuperharmonic.BandOriginalPairSeparation public import LeanPool.ApollonianSuperharmonic.BandUnmodifiedCoreCertificate @@ -153,15 +154,7 @@ private theorem modified_a : intro P O u v T S t m n exact (TileCellComplementCovariance (P 0 true) O (t m n)).1 -private theorem cells_nonempty : - ∀ (A : ProtoTile), (LatticeTile A) → (A.cells.Nonempty) := by - classical - intro A hA - rcases hA with ⟨e⟩ - have hp := (e ⟨0, by simp⟩).property - simp only [TileRealization, Set.mem_iUnion] at hp - obtain ⟨x, hx, _⟩ := hp - exact ⟨x, hx⟩ +private abbrev cells_nonempty := ApollonianSuperharmonic.LatticeTileNonempty.cells private theorem original_nonempty : ∀ (P : Fin 3 -> Bool -> ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), ∀ (L : diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean index 56b2f5ca15..5aa7d5963e 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean @@ -663,26 +663,6 @@ private theorem ha : intro A A' hAn he exact False.elim ((Finset.not_nonempty_iff_eq_empty.mpr he) hAn) -private theorem hb : - (by - classical - exact - ∀ (B : ProtoTile), ∀ (B' : ProtoTile), (Finset.Nonempty B.cells) → (B.cells = ∅ → - B.anchor = B'.anchor) ) := by - classical - intro B B' hBn he - exact False.elim ((Finset.not_nonempty_iff_eq_empty.mpr he) hBn) - -private theorem hc : - (by - classical - exact - ∀ (C : ProtoTile), ∀ (C' : ProtoTile), (Finset.Nonempty C.cells) → (C.cells = ∅ → - C.anchor = C'.anchor) ) := by - classical - intro C C' hCn he - exact False.elim ((Finset.not_nonempty_iff_eq_empty.mpr he) hCn) - private theorem hzero : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean index 4cddce360a..c98af846bc 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralGeometricSectors.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidenceZeroOppositeChord public import LeanPool.ApollonianSuperharmonic.ExactPatchBoundaryInterface @@ -44,28 +45,7 @@ private theorem hdisjoint : intro x hxa hxb exact hab ((hindexed x).unique hxa hxb) -private theorem raw_incident : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ FootprintVertices U) → - (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells)) ) := by - classical - intro U x hne hx - simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hx - rcases hx with ⟨c, hc, h | h | h | h⟩ - · exact ⟨0, by simpa [LatticeVertexIncidentCell] using h ▸ hc⟩ - · refine ⟨1, ?_⟩ - subst x - convert hc using 1; simp [LatticeVertexIncidentCell] - · refine ⟨3, ?_⟩ - subst x - convert hc using 1; simp [LatticeVertexIncidentCell] - · refine ⟨2, ?_⟩ - change x - 1 - ⟨0, 1⟩ ∈ U.cells - rw [h] - convert hc using 1 - ext <;> simp +private abbrev raw_incident := ApollonianSuperharmonic.LatticeFootprintIncidence.incidentCell private theorem radial : (by @@ -403,26 +383,42 @@ private theorem hlm : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let P := cert.modified - ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), (∀ - (a : PeriodicSubtileIndex), LatticeTile (P.tile a)) → (∀ (a : PeriodicSubtileIndex), - ∀ (b : PeriodicSubtileIndex), ∀ (x : GaussianInt), ∀ (j : Fin (4 : ℕ)), - (LatticeVertexIncidentCell x j ∈ (P.tile a).cells) → (∀ (k : Fin (4 : ℕ)), - let owner : Fin 4 → PeriodicSubtileIndex := fun r => - (hindexed (LatticeVertexIncidentCell x r)).choose - (∀ (r : Fin 4), LatticeVertexIncidentCell x r ∈ (P.tile (owner r)).cells) → ((owner j = - a) → ((owner k = b) → ((j ≠ k) → ((¬ (k = j + 1 ∨ j = k + 1)) → ((k = j + 2) → ( - let l := j + 1 - let m := j + 3 - (j ≠ l ∧ j ≠ k ∧ j ≠ m ∧ l ≠ k ∧ l ≠ m ∧ k ≠ m) → ((l + 1 = k) → ((k + 1 = m) → ((m + 1 = - j) → ((owner l ≠ a) → ((owner l ≠ b) → ((owner m ≠ a) → ((owner m ≠ b) → (owner l ≠ - owner m)))))))))))))))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C₀ : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T), + let P := cert.modified; + ∀ + (hindexed : + ∀ (x : LatticeCell), + ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), + (∀ (a : PeriodicSubtileIndex), LatticeTile (P.tile a)) → + ∀ (a : PeriodicSubtileIndex), + ∀ (b : PeriodicSubtileIndex), + ∀ (x : GaussianInt), + ∀ (j : Fin (4 : ℕ)), + ∀ (k : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose; + (∀ (r : Fin 4), + LatticeVertexIncidentCell x r ∈ + (P.tile (owner r)).cells) → + owner j = a → + owner k = b → + j ≠ k → + ¬(k = j + 1 ∨ j = k + 1) → + k = j + 2 → + let l := j + 1; + let m := j + 3; + j ≠ l ∧ j ≠ k ∧ j ≠ m ∧ l ≠ k ∧ l ≠ m ∧ k ≠ m → + l + 1 = k → + k + 1 = m → + m + 1 = j → owner l ≠ a → owner l ≠ b → owner l ≠ owner m + ) := by classical - intro q cfg C₀ T cert P hindexed htiles a b x j hja k owner ho hja' hkb' hjk hnotconsecutive - hop l m hpos hlk hkm hmj hlA hlB hmA hmB heq + intro q cfg C₀ T cert P hindexed htiles a b x j k owner ho hja' hkb' hjk hnotconsecutive hop l + m hpos hlk hkm hmj hlA hlB heq have hcheck := (LatticeTileGridStructure _ (htiles (owner l))).2.1 x have hnJ : LatticeVertexIncidentCell x j ∉ (P.tile (owner l)).cells := by intro hmem @@ -560,26 +556,47 @@ private theorem hinj : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let P := cert.modified - ∀ (hindexed : ∀ (x : LatticeCell), ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), ∀ - (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (x : GaussianInt), ∀ (j : - Fin (4 : ℕ)), (LatticeVertexIncidentCell x j ∈ (P.tile a).cells) → (∀ (k : Fin (4 : ℕ)), - let owner : Fin 4 → PeriodicSubtileIndex := fun r => - (hindexed (LatticeVertexIncidentCell x r)).choose - (owner j = a) → ((j ≠ k) → ((¬ (k = j + 1 ∨ j = k + 1)) → ((k = j + 2) → ( - let l := j + 1 - let m := j + 3 - (j ≠ l ∧ j ≠ k ∧ j ≠ m ∧ l ≠ k ∧ l ≠ m ∧ k ≠ m) → ((l + 1 = k) → ((k + 1 = m) → ((m + 1 = - j) → ((owner l ≠ a) → ((owner l ≠ b) → ((owner m ≠ a) → ((owner m ≠ b) → ((owner l ≠ - owner m) → ((owner j ≠ owner l) → ((owner j ≠ owner k) → ((owner j ≠ owner m) → - ((owner l ≠ owner k) → ((owner k ≠ owner m) → (Function.Injective - owner))))))))))))))))))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C₀ : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T), + let P := cert.modified; + ∀ + (hindexed : + ∀ (x : LatticeCell), + ∃! a : PeriodicSubtileIndex, x ∈ (P.tile a).cells), + ∀ (a : PeriodicSubtileIndex), + ∀ (b : PeriodicSubtileIndex), + ∀ (x : GaussianInt), + ∀ (j : Fin (4 : ℕ)), + ∀ (k : Fin (4 : ℕ)), + let owner : Fin 4 → PeriodicSubtileIndex := fun r => + (hindexed (LatticeVertexIncidentCell x r)).choose + owner j = a → + j ≠ k → + ¬(k = j + 1 ∨ j = k + 1) → + k = j + 2 → + let l := j + 1 + let m := j + 3 + j ≠ l ∧ j ≠ k ∧ j ≠ m ∧ l ≠ k ∧ l ≠ m ∧ k ≠ m → + l + 1 = k → + k + 1 = m → + m + 1 = j → + owner l ≠ a → + owner l ≠ b → + owner m ≠ a → + owner m ≠ b → + owner l ≠ owner m → + owner j ≠ owner l → + owner j ≠ owner k → + owner j ≠ owner m → + owner l ≠ owner k → + owner k ≠ owner m → Function.Injective owner + ) := by classical - intro q cfg C₀ T cert P hindexed a b x j hja k owner hja' hjk hnotconsecutive hop l m hpos hlk - hkm hmj hlA hlB hmA hmB hlm hjlO hjkO hjmO hlkO hkmO r s hrs + intro q cfg C₀ T cert P hindexed a b x j k owner hja' hjk hnotconsecutive hop l m hpos hlk hkm + hmj hlA hlB hmA hmB hlm hjlO hjkO hjmO hlkO hkmO r s hrs have positions (t : Fin 4) : t = j ∨ t = l ∨ t = k ∨ t = m := by rw [hop] fin_cases j <;> fin_cases t <;> simp [l, m] @@ -745,36 +762,58 @@ private theorem hdn : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let P := cert.modified - (∀ (whole : FiniteInducedTilePatch P.plane P.tile), (whole.indices = ({⟨.A, 0, 0⟩, ⟨.B, - 0, 0⟩, ⟨.C, 0, 0⟩, ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} : Finset - PeriodicSubtileIndex)) → (∀ (a : PeriodicSubtileIndex), (a ∈ whole.indices) → - (a.first = 0 ∧ a.second = 0))) → (∀ (whole : FiniteInducedTilePatch - cert.modified.plane cert.modified.tile), (whole.indices = {(⟨SixSubtileLabel.A, - (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), (⟨SixSubtileLabel.B, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex), (⟨SixSubtileLabel.C, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex), (⟨SixSubtileLabel.D, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex), (⟨SixSubtileLabel.E, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex), (⟨SixSubtileLabel.F, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex)}) → (∀ (d : PeriodicSubtileIndex), (d ∈ whole.indices) → (∀ - (rest : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (rest.indices - = whole.indices.erase d) → ((rest.unionTile = TileCellComplement T - (cert.modified.tile d)) → ((d ∉ rest.indices) → ((Disjoint (rest.unionTile).cells - (P.tile d).cells) → ((∀ z : LatticeCell, z ∈ whole.unionTile.cells ↔ z ∈ (P.tile - d).cells ∨ z ∈ rest.unionTile.cells) → ( - let n : PeriodicSubtileIndex := match d.label with - | .A => ⟨.B, 0, 0⟩ - | .B => ⟨.A, 0, 0⟩ - | .C => ⟨.A, 0, 0⟩ - | .D => ⟨.A, 0, 0⟩ - | .E => ⟨.B, 0, 0⟩ - | .F => ⟨.A, 0, 0⟩ - AllowedSubtileIncidence d n)))))))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C₀ : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T), + let P := cert.modified; + (∀ (whole : FiniteInducedTilePatch P.plane P.tile), + whole.indices = + ({⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, + ⟨.F, 0, 0⟩} : + Finset PeriodicSubtileIndex) → + ∀ (a : PeriodicSubtileIndex), + a ∈ whole.indices → a.first = 0 ∧ a.second = 0) → + ∀ + (whole : + FiniteInducedTilePatch cert.modified.plane cert.modified.tile), + whole.indices = + {(⟨SixSubtileLabel.A, (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), + (⟨SixSubtileLabel.B, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), + (⟨SixSubtileLabel.C, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), + (⟨SixSubtileLabel.D, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), + (⟨SixSubtileLabel.E, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), + (⟨SixSubtileLabel.F, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex)} → + ∀ (d : PeriodicSubtileIndex), + d ∈ whole.indices → + ∀ + (rest : + FiniteInducedTilePatch cert.modified.plane + cert.modified.tile), + rest.indices = whole.indices.erase d → + rest.unionTile = + TileCellComplement T (cert.modified.tile d) → + (∀ z : LatticeCell, + z ∈ whole.unionTile.cells ↔ + z ∈ (P.tile d).cells ∨ z ∈ rest.unionTile.cells) → + let n : PeriodicSubtileIndex := + match d.label with + | .A => ⟨.B, 0, 0⟩ + | .B => ⟨.A, 0, 0⟩ + | .C => ⟨.A, 0, 0⟩ + | .D => ⟨.A, 0, 0⟩ + | .E => ⟨.B, 0, 0⟩ + | .F => ⟨.A, 0, 0⟩ + AllowedSubtileIncidence d n + ) := by classical - intro q cfg C₀ T cert P hzero whole hidx d hd rest hrestIdx hrestUnion hdnot hdisj hunion n + intro q cfg C₀ T cert P hzero whole hidx d hd rest hrestIdx hrestUnion hunion n cases d with | mk lab i j => have hz := hzero whole hidx ⟨lab, i, j⟩ hd @@ -795,36 +834,58 @@ private theorem hnd : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let P := cert.modified - (∀ (whole : FiniteInducedTilePatch P.plane P.tile), (whole.indices = ({⟨.A, 0, 0⟩, ⟨.B, - 0, 0⟩, ⟨.C, 0, 0⟩, ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, ⟨.F, 0, 0⟩} : Finset - PeriodicSubtileIndex)) → (∀ (a : PeriodicSubtileIndex), (a ∈ whole.indices) → - (a.first = 0 ∧ a.second = 0))) → (∀ (whole : FiniteInducedTilePatch - cert.modified.plane cert.modified.tile), (whole.indices = {(⟨SixSubtileLabel.A, - (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), (⟨SixSubtileLabel.B, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex), (⟨SixSubtileLabel.C, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex), (⟨SixSubtileLabel.D, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex), (⟨SixSubtileLabel.E, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex), (⟨SixSubtileLabel.F, (0 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex)}) → (∀ (d : PeriodicSubtileIndex), (d ∈ whole.indices) → (∀ - (rest : FiniteInducedTilePatch cert.modified.plane cert.modified.tile), (rest.indices - = whole.indices.erase d) → ((rest.unionTile = TileCellComplement T - (cert.modified.tile d)) → ((d ∉ rest.indices) → ((Disjoint (rest.unionTile).cells - (P.tile d).cells) → ((∀ z : LatticeCell, z ∈ whole.unionTile.cells ↔ z ∈ (P.tile - d).cells ∨ z ∈ rest.unionTile.cells) → ( - let n : PeriodicSubtileIndex := match d.label with - | .A => ⟨.B, 0, 0⟩ - | .B => ⟨.A, 0, 0⟩ - | .C => ⟨.A, 0, 0⟩ - | .D => ⟨.A, 0, 0⟩ - | .E => ⟨.B, 0, 0⟩ - | .F => ⟨.A, 0, 0⟩ - (AllowedSubtileIncidence d n) → (n ≠ d))))))))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C₀ : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C₀ T), + let P := cert.modified; + (∀ (whole : FiniteInducedTilePatch P.plane P.tile), + whole.indices = + ({⟨.A, 0, 0⟩, ⟨.B, 0, 0⟩, ⟨.C, 0, 0⟩, ⟨.D, 0, 0⟩, ⟨.E, 0, 0⟩, + ⟨.F, 0, 0⟩} : + Finset PeriodicSubtileIndex) → + ∀ (a : PeriodicSubtileIndex), + a ∈ whole.indices → a.first = 0 ∧ a.second = 0) → + ∀ + (whole : + FiniteInducedTilePatch cert.modified.plane cert.modified.tile), + whole.indices = + {(⟨SixSubtileLabel.A, (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex), + (⟨SixSubtileLabel.B, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), + (⟨SixSubtileLabel.C, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), + (⟨SixSubtileLabel.D, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), + (⟨SixSubtileLabel.E, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex), + (⟨SixSubtileLabel.F, (0 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex)} → + ∀ (d : PeriodicSubtileIndex), + d ∈ whole.indices → + ∀ + (rest : + FiniteInducedTilePatch cert.modified.plane + cert.modified.tile), + rest.indices = whole.indices.erase d → + rest.unionTile = + TileCellComplement T (cert.modified.tile d) → + (∀ z : LatticeCell, + z ∈ whole.unionTile.cells ↔ + z ∈ (P.tile d).cells ∨ z ∈ rest.unionTile.cells) → + let n : PeriodicSubtileIndex := + match d.label with + | .A => ⟨.B, 0, 0⟩ + | .B => ⟨.A, 0, 0⟩ + | .C => ⟨.A, 0, 0⟩ + | .D => ⟨.A, 0, 0⟩ + | .E => ⟨.B, 0, 0⟩ + | .F => ⟨.A, 0, 0⟩; + n ≠ d + ) := by classical - intro q cfg C₀ T cert P hzero whole hidx d hd rest hrestIdx hrestUnion hdnot hdisj hunion n hdn + intro q cfg C₀ T cert P hzero whole hidx d hd rest hrestIdx hrestUnion hunion n cases d with | mk lab i j => have hz := hzero whole hidx ⟨lab, i, j⟩ hd @@ -1046,8 +1107,7 @@ private theorem hnoPinch : have hmB : owner m ≠ b := GeometricSectorGeometry.hmB q cfg C₀ T cert hindexed radialMembers a b hnoedge x j ho hja' hmj have hlm : owner l ≠ owner m := GeometricSectorGeometry.hlm q cfg C₀ T cert hindexed - htiles a b x j hja k ho hja' hkb' hjk hnotconsecutive hop hpos hlk hkm hmj hlA hlB - hmA hmB + htiles a b x j k ho hja' hkb' hjk hnotconsecutive hop hpos hlk hkm hmj hlA hlB have hjlO : owner j ≠ owner l := GeometricSectorGeometry.hjlO q cfg C₀ T cert hindexed a x j hja' hlA have hjkO : owner j ≠ owner k := GeometricSectorGeometry.hjkO q cfg C₀ T cert hindexed @@ -1059,7 +1119,7 @@ private theorem hnoPinch : have hkmO : owner k ≠ owner m := GeometricSectorGeometry.hkmO q cfg C₀ T cert hindexed b x j k hkb' hmB have hinj : Function.Injective owner := GeometricSectorGeometry.hinj q cfg C₀ T cert - hindexed a b x j hja k hja' hjk hnotconsecutive hop hpos hlk hkm hmj hlA hlB hmA + hindexed a b x j k hja' hjk hnotconsecutive hop hpos hlk hkm hmj hlA hlB hmA hmB hlm hjlO hjkO hjmO hlkO hkmO have edgeAdjacent (u v : PeriodicSubtileIndex) (huv : u ≠ v) (hedge : (FootprintEdges (P.tile u) ∩ @@ -1222,9 +1282,9 @@ theorem BandOrderedGeneralGeometricSectors | .E => ⟨.B, 0, 0⟩ | .F => ⟨.A, 0, 0⟩ have hdn : AllowedSubtileIncidence d n := GeometricSectorGeometry.hdn q cfg C₀ T cert hzero - whole hidx d hd rest hrestIdx hrestUnion hdnot hdisj hunion + whole hidx d hd rest hrestIdx hrestUnion hunion have hnd : n ≠ d := GeometricSectorGeometry.hnd q cfg C₀ T cert hzero whole hidx d hd rest - hrestIdx hrestUnion hdnot hdisj hunion hdn + hrestIdx hrestUnion hunion have hnWhole : n ∈ whole.indices := GeometricSectorGeometry.hnWhole q cfg C₀ T cert hzero whole hidx d hd have hnrest : n ∈ rest.indices := GeometricSectorGeometry.hnrest q cfg C₀ T cert whole d rest diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean index 4fa1b44356..8140044b31 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeTileNonempty public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion public import LeanPool.ApollonianSuperharmonic.BandDoubleDecomposition @@ -468,18 +469,7 @@ private theorem periodicIsolation : exact Finset.mem_image.mpr ⟨a - w, ha, sub_add_cancel a w⟩ exact (isolated z hz (a - w) hb).imp (ht _) (ht _) -private theorem diskNonempty : - (by - classical - exact - ∀ (U : ProtoTile), (LatticeTile U) → (U.cells.Nonempty) ) := by - classical - intro U hU - obtain ⟨e⟩ := hU - have hp := (e ⟨0, by simp⟩).property - simp only [TileRealization, Set.mem_iUnion] at hp - obtain ⟨x, hx, _⟩ := hp - exact ⟨x, hx⟩ +private abbrev diskNonempty := ApollonianSuperharmonic.LatticeTileNonempty.cells private abbrev boundaryEdge := BoundaryFootprintInclusion.boundaryEdge @@ -637,31 +627,7 @@ private theorem abEdge : (Finset.nonempty_iff_ne_empty.mpr he) compQ.2 exact ⟨e, heA, edgeMono _ _ hOB heO⟩ -private theorem edgeVertex : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ FootprintEdges U) → (∀ (x : - GaussianInt), (x ∈ e) → (x ∈ FootprintVertices U)) ) := by - classical - intro U e he x hx - obtain ⟨z, hz, he⟩ := he - simp only [FootprintVertices, ite_eq_left (show U.cells.Nonempty from ⟨z, hz⟩), - Set.mem_ofPred_eq] - rcases he with h | h | h | h <;> subst e - all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hx - · rcases hx with rfl | rfl - · exact ⟨_, hz, Or.inl rfl⟩ - · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · rcases hx with rfl | rfl - · exact ⟨_, hz, Or.inl rfl⟩ - · exact ⟨z, hz, Or.inr (Or.inr (Or.inl rfl))⟩ - · rcases hx with rfl | rfl - · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · exact ⟨z, hz, Or.inr (Or.inr (Or.inr rfl))⟩ - · rcases hx with rfl | rfl - · exact ⟨z, hz, Or.inr (Or.inr (Or.inl rfl))⟩ - · exact ⟨z, hz, Or.inr (Or.inr (Or.inr rfl))⟩ +private abbrev edgeVertex := ApollonianSuperharmonic.BoundaryFootprintInclusion.edgeVertex private theorem commonVertices : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean index 51ef86968c..e984177c2a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean @@ -6,6 +6,9 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.P4590T1PositivePrototileDisk +public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence +public import LeanPool.ApollonianSuperharmonic.LatticeTileNonempty public import LeanPool.ApollonianSuperharmonic.BandExceptionalRestorationSectorOrder public import LeanPool.ApollonianSuperharmonic.BandPositiveCutBranchCompanionExclusion @@ -88,54 +91,9 @@ private theorem birthData : exact hlt omega -private theorem prototile_lattice : - (by - classical - exact - ∀ (c : CircleCoordinates), ∀ (X : ProtoTile), BandPrototile c X → 0 < c.1 → LatticeTile X - ) := by - classical - intro c X hX - induction hX with - | line w x hw => intro hc; simp at hc - | unit z x anchor => - intro _ - have hford := (FordTileGeometry 1 (by norm_num)).1 - have hcells : ({x} : Finset GaussianInt) = - (TileTranslation (FordTile 1) x).cells := by - ext y - simp [TileTranslation, FordTile, FordCellDomain, GaussianTranslation, - ] - cases x; cases y; simp [Zsqrtd.ext_iff] - have hreal : TileRealization ⟨{x}, anchor⟩ = - TileRealization (TileTranslation (FordTile 1) x) := by - simp [TileRealization, hcells] - change TopologicalDisk (TileRealization (⟨{x}, anchor⟩ : ProtoTile)) - have htrans : LatticeTile (TileTranslation (FordTile 1) x) := - (TileDiskAreaCovariance (FordTile 1) x).1.mp hford - change TopologicalDisk (TileRealization (TileTranslation (FordTile 1) x)) - at htrans - simpa [hreal] using htrans - | @decompose r hr S X hS hcells hfoot hcentroid ih => - intro _ - exact (BandTileSimultaneousInduction r hr X - (BandPrototile.decompose hr hS hcells hfoot hcentroid)).1 +private abbrev prototile_lattice := ApollonianSuperharmonic.P4590T1PositivePrototileDisk -private theorem tile_nonempty : - (by - classical - exact - ∀ (X : ProtoTile), (LatticeTile X) → (X.cells.Nonempty) ) := by - classical - intro X hX - by_contra hne - have hempty : X.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hne - have hreal : TileRealization X = ∅ := by simp [TileRealization, hempty] - rcases hX with ⟨homeo⟩ - let p : (Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) := - ⟨0, by simp⟩ - have hp : ((homeo p).val) ∈ TileRealization X := (homeo p).property - simp [hreal] at hp +private abbrev tile_nonempty := ApollonianSuperharmonic.LatticeTileNonempty.cells private theorem positive_of_nonempty : (by @@ -195,29 +153,7 @@ private theorem boundary_incident : have : x - 1 - ⟨0, 1⟩ = z := by rw [h]; abel simpa [LatticeVertexIncidentCell, this] using hz -private theorem raw_incident : - (by - classical - exact - ∀ (X : ProtoTile), ∀ (x : GaussianInt), (X.cells.Nonempty) → ((x ∈ FootprintVertices X) → - (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ X.cells)) ) := by - classical - intro X x hne hx - unfold FootprintVertices at hx - rw [ite_eq_left hne] at hx - rcases hx with ⟨z, hz, hcorner⟩ - rcases hcorner with h | h | h | h - · refine ⟨0, ?_⟩ - simpa [LatticeVertexIncidentCell, h] using hz - · refine ⟨1, ?_⟩ - have : x - 1 = z := by rw [h]; simp - simpa [LatticeVertexIncidentCell, this] using hz - · refine ⟨3, ?_⟩ - have : x - ⟨0, 1⟩ = z := by rw [h]; abel - simpa [LatticeVertexIncidentCell, this] using hz - · refine ⟨2, ?_⟩ - have : x - 1 - ⟨0, 1⟩ = z := by rw [h]; abel - simpa [LatticeVertexIncidentCell, this] using hz +private abbrev raw_incident := ApollonianSuperharmonic.LatticeFootprintIncidence.incidentCell private theorem getLast_mem_of_eq_some : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean index 995dccf25f..4a8e889b8c 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRawSupport.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence public import LeanPool.ApollonianSuperharmonic.PairAssignmentFacts public import LeanPool.ApollonianSuperharmonic.BandLayoutFaceSupport public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion @@ -229,28 +230,7 @@ private theorem hQC : · rw [h.1] at hCne simp at hCne -private theorem raw_incident : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (z : GaussianInt), (U.cells.Nonempty) → ((z ∈ FootprintVertices U) → - (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ U.cells)) ) := by - classical - intro U z hne hz - simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hz - rcases hz with ⟨cell, hc, h | h | h | h⟩ - · refine ⟨0, ?_⟩ - simpa [LatticeVertexIncidentCell] using h ▸ hc - · refine ⟨1, ?_⟩ - subst z - simpa [LatticeVertexIncidentCell] using hc - · refine ⟨3, ?_⟩ - subst z - simpa [LatticeVertexIncidentCell] using hc - · refine ⟨2, ?_⟩ - change z - 1 - ⟨0, 1⟩ ∈ U.cells - rw [h] - convert hc using 1; ext <;> simp +private abbrev raw_incident := ApollonianSuperharmonic.LatticeFootprintIncidence.incidentCell private theorem raw_boundary : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean index 546f3c22c9..50431d440a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean @@ -177,23 +177,23 @@ private theorem hcentralIndex : (by classical exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (j : Fin (4 : ℕ)), ∀ - (centralSlot : Fin (3 : ℕ)), ∀ (centralSign : Bool), (LatticeVertexIncidentCell - normalization.normalizedPoint (j + (2 : Fin (4 : ℕ))) ∈ (normalization.layout.P - centralSlot centralSign).cells) → ( - let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => - if i = 0 then (if s = true then .A else .B) - else if i = 1 then (if s = true then .C else .D) - else (if s = true then .E else .F) - let centralIndex : PeriodicSubtileIndex := - ⟨labelOf centralSlot centralSign, 0, 0⟩ - centralIndex = ⟨.A, 0, 0⟩ ∨ centralIndex = ⟨.B, 0, 0⟩ ∨ centralIndex = ⟨.C, 0, 0⟩ ∨ - centralIndex = ⟨.D, 0, 0⟩ ∨ centralIndex = ⟨.E, 0, 0⟩ ∨ centralIndex = ⟨.F, 0, 0⟩) ) + ∀ (centralSlot : Fin (3 : ℕ)), + ∀ (centralSign : Bool), + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then if s = true then .A else .B + else + if i = 1 then if s = true then .C else .D else if s = true then .E else .F + let centralIndex : PeriodicSubtileIndex := + ⟨labelOf centralSlot centralSign, 0, 0⟩ + centralIndex = ⟨.A, 0, 0⟩ ∨ + centralIndex = ⟨.B, 0, 0⟩ ∨ + centralIndex = ⟨.C, 0, 0⟩ ∨ + centralIndex = ⟨.D, 0, 0⟩ ∨ + centralIndex = ⟨.E, 0, 0⟩ ∨ centralIndex = ⟨.F, 0, 0⟩ + ) := by classical - intro C T N h k x normalization j centralSlot centralSign hcentral labelOf centralIndex + intro centralSlot centralSign labelOf centralIndex fin_cases centralSlot <;> cases centralSign <;> simp [centralIndex, labelOf] @@ -230,43 +230,67 @@ private theorem hexteriorOccurrence : (by classical exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (j : Fin (4 : ℕ)), ∀ - (selectedSlot : Fin (3 : ℕ)), ∀ (selectedSign : Bool), (LatticeVertexIncidentCell - normalization.normalizedPoint j ∈ (normalization.pieces selectedSlot - selectedSign).cells) → ( - let m : Int := if normalization.rightDirectionSlot = 0 then - (if normalization.rightNeighborPositive = true then 1 else -1) - else if normalization.rightDirectionSlot = 1 then 0 - else if normalization.rightNeighborPositive = true then -1 else 1 - let n : Int := if normalization.rightDirectionSlot = 0 then 0 - else if normalization.rightDirectionSlot = 1 then - (if normalization.rightNeighborPositive = true then 1 else -1) - else if normalization.rightNeighborPositive = true then -1 else 1 - (normalization.rightNeighborDisplacement = (m : GaussianInt) * normalization.layout.u + - (n : GaussianInt) * normalization.layout.v) → ( - let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => - if i = 0 then (if s = true then .A else .B) - else if i = 1 then (if s = true then .C else .D) - else (if s = true then .E else .F) - let exteriorIndex : PeriodicSubtileIndex := - ⟨labelOf selectedSlot selectedSign, m, n⟩ - ((normalization.rightNeighborPositive = true ∧ ((normalization.rightDirectionSlot = 0 ∧ - exteriorIndex.first = 1 ∧ exteriorIndex.second = 0) ∨ - (normalization.rightDirectionSlot = 1 ∧ exteriorIndex.first = 0 ∧ - exteriorIndex.second = 1) ∨ (normalization.rightDirectionSlot = 2 ∧ - exteriorIndex.first = -1 ∧ exteriorIndex.second = -1))) ∨ - (normalization.rightNeighborPositive = false ∧ ((normalization.rightDirectionSlot = 0 - ∧ exteriorIndex.first = -1 ∧ exteriorIndex.second = 0) ∨ - (normalization.rightDirectionSlot = 1 ∧ exteriorIndex.first = 0 ∧ - exteriorIndex.second = -1) ∨ (normalization.rightDirectionSlot = 2 ∧ - exteriorIndex.first = 1 ∧ exteriorIndex.second = 1)))) → - (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u - normalization.layout.v exteriorIndex = TileTranslation (normalization.layout.P - selectedSlot selectedSign) normalization.rightNeighborDisplacement))) ) := by + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (N : ProtoTile), + ∀ (h : PartialOdometer), + ∀ (k : PartialOdometer), + ∀ (x : GaussianInt), + ∀ + (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + ∀ (selectedSlot : Fin (3 : ℕ)), + ∀ (selectedSign : Bool), + let m : Int := + if normalization.rightDirectionSlot = 0 then + if normalization.rightNeighborPositive = true then 1 else -1 + else + if normalization.rightDirectionSlot = 1 then 0 + else + if normalization.rightNeighborPositive = true then -1 + else 1 + let n : Int := + if normalization.rightDirectionSlot = 0 then 0 + else + if normalization.rightDirectionSlot = 1 then + if normalization.rightNeighborPositive = true then 1 + else -1 + else + if normalization.rightNeighborPositive = true then -1 + else 1 + normalization.rightNeighborDisplacement = + (m : GaussianInt) * normalization.layout.u + + (n : GaussianInt) * normalization.layout.v → + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then if s = true then .A else .B + else + if i = 1 then if s = true then .C else .D + else if s = true then .E else .F + let exteriorIndex : PeriodicSubtileIndex := + ⟨labelOf selectedSlot selectedSign, m, n⟩ + normalization.rightNeighborPositive = true ∧ + (normalization.rightDirectionSlot = 0 ∧ + exteriorIndex.first = 1 ∧ exteriorIndex.second = 0 ∨ + normalization.rightDirectionSlot = 1 ∧ + exteriorIndex.first = 0 ∧ exteriorIndex.second = 1 ∨ + normalization.rightDirectionSlot = 2 ∧ + exteriorIndex.first = -1 ∧ exteriorIndex.second = -1) ∨ + normalization.rightNeighborPositive = false ∧ + (normalization.rightDirectionSlot = 0 ∧ + exteriorIndex.first = -1 ∧ exteriorIndex.second = 0 ∨ + normalization.rightDirectionSlot = 1 ∧ + exteriorIndex.first = 0 ∧ exteriorIndex.second = -1 ∨ + normalization.rightDirectionSlot = 2 ∧ + exteriorIndex.first = 1 ∧ exteriorIndex.second = 1) → + SubtileOccurrenceInterpretation normalization.layout.P + normalization.layout.u normalization.layout.v + exteriorIndex = + TileTranslation + (normalization.layout.P selectedSlot selectedSign) + normalization.rightNeighborDisplacement + ) := by classical - intro C T N h k x normalization j selectedSlot selectedSign hselected m n hdisplacement labelOf + intro C T N h k x normalization selectedSlot selectedSign m n hdisplacement labelOf exteriorIndex hshift rw [hdisplacement] fin_cases selectedSlot <;> cases selectedSign <;> @@ -551,14 +575,12 @@ private theorem hstar : ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : BandOrderedGeneralRightNormalizationCertificate C T N h k x), ∀ (j : Fin (4 : ℕ)), - (LatticeVertexIncidentCell normalization.normalizedPoint j ∈ - normalization.normalizedRoot.cells) → ((LatticeVertexIncidentCell - normalization.normalizedPoint (j + (2 : Fin (4 : ℕ))) ∈ - normalization.normalizedFixed.cells) → (∀ (selectedSlot : Fin (3 : ℕ)), ∀ - (selectedSign : Bool), (LatticeVertexIncidentCell normalization.normalizedPoint j ∈ - (normalization.pieces selectedSlot selectedSign).cells) → (∀ (centralSlot : Fin (3 : - ℕ)), ∀ (centralSign : Bool), (LatticeVertexIncidentCell normalization.normalizedPoint - (j + (2 : Fin (4 : ℕ))) ∈ (normalization.layout.P centralSlot centralSign).cells) → ( + ( + (∀ (selectedSlot : Fin (3 : ℕ)), ∀ + (selectedSign : Bool), + (∀ (centralSlot : Fin (3 : + ℕ)), ∀ (centralSign : Bool), + ( let m : Int := if normalization.rightDirectionSlot = 0 then (if normalization.rightNeighborPositive = true then 1 else -1) else if normalization.rightDirectionSlot = 1 then 0 @@ -613,9 +635,9 @@ private theorem hstar : (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u normalization.layout.v centralIndex))))))))) ) := by classical - intro C T N h k x normalization j hjroot hjfixed selectedSlot selectedSign hselected - centralSlot centralSign hcentral m n labelOf exteriorIndex centralIndex hexteriorCell - hcentralCell exteriorCorners centralCorners y hy + intro C T N h k x normalization j selectedSlot selectedSign centralSlot centralSign m n + labelOf exteriorIndex centralIndex hexteriorCell hcentralCell exteriorCorners + centralCorners y hy fin_cases j <;> simp only [LatticeVertexIncidentCell, sub_eq_add_neg, Int.reduceNeg, add_assoc, Fin.mk_one, Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, add_comm, @@ -725,142 +747,122 @@ private theorem hselectedBoundary : (by classical exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralRightNormalizationCertificate C T N h k x), - let q := normalization.normalizedPresentation - ∀ (j : Fin (4 : ℕ)), ∀ (selectedSlot : Fin (3 : ℕ)), ∀ (selectedSign : Bool), - (LatticeVertexIncidentCell normalization.normalizedPoint j ∈ (normalization.pieces - selectedSlot selectedSign).cells) → (∀ (centralSlot : Fin (3 : ℕ)), ∀ (centralSign : - Bool), - let m : Int := if normalization.rightDirectionSlot = 0 then - (if normalization.rightNeighborPositive = true then 1 else -1) - else if normalization.rightDirectionSlot = 1 then 0 - else if normalization.rightNeighborPositive = true then -1 else 1 - let n : Int := if normalization.rightDirectionSlot = 0 then 0 - else if normalization.rightDirectionSlot = 1 then - (if normalization.rightNeighborPositive = true then 1 else -1) - else if normalization.rightNeighborPositive = true then -1 else 1 - let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => - if i = 0 then (if s = true then .A else .B) - else if i = 1 then (if s = true then .C else .D) - else (if s = true then .E else .F) - let exteriorIndex : PeriodicSubtileIndex := - ⟨labelOf selectedSlot selectedSign, m, n⟩ - let centralIndex : PeriodicSubtileIndex := - ⟨labelOf centralSlot centralSign, 0, 0⟩ - ((normalization.rightNeighborPositive = true ∧ ((normalization.rightDirectionSlot = 0 ∧ - exteriorIndex.first = 1 ∧ exteriorIndex.second = 0) ∨ - (normalization.rightDirectionSlot = 1 ∧ exteriorIndex.first = 0 ∧ - exteriorIndex.second = 1) ∨ (normalization.rightDirectionSlot = 2 ∧ - exteriorIndex.first = -1 ∧ exteriorIndex.second = -1))) ∨ - (normalization.rightNeighborPositive = false ∧ ((normalization.rightDirectionSlot = 0 - ∧ exteriorIndex.first = -1 ∧ exteriorIndex.second = 0) ∨ - (normalization.rightDirectionSlot = 1 ∧ exteriorIndex.first = 0 ∧ - exteriorIndex.second = -1) ∨ (normalization.rightDirectionSlot = 2 ∧ - exteriorIndex.first = 1 ∧ exteriorIndex.second = 1)))) → - ((SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u - normalization.layout.v exteriorIndex = TileTranslation (normalization.layout.P - selectedSlot selectedSign) normalization.rightNeighborDisplacement) → ((BandPrototile - (q selectedSlot.succ) (normalization.pieces selectedSlot selectedSign)) → - ((BandPrototile (q selectedSlot.succ) (normalization.layout.P selectedSlot - selectedSign)) → ((BandPrototile (q selectedSlot.succ) (TileTranslation - (normalization.layout.P selectedSlot selectedSign) - normalization.rightNeighborDisplacement)) → ((TileCentroid (normalization.pieces - selectedSlot selectedSign) = TileCentroid (TileTranslation (normalization.layout.P - selectedSlot selectedSign) normalization.rightNeighborDisplacement)) → - (((normalization.pieces selectedSlot selectedSign).cells = (TileTranslation - (normalization.layout.P selectedSlot selectedSign) - normalization.rightNeighborDisplacement).cells ∧ ((normalization.pieces selectedSlot - selectedSign).cells = ∅ → (normalization.pieces selectedSlot selectedSign).anchor = - (TileTranslation (normalization.layout.P selectedSlot selectedSign) - normalization.rightNeighborDisplacement).anchor)) → ((FootprintVertices - (normalization.pieces selectedSlot selectedSign) = FootprintVertices (TileTranslation - (normalization.layout.P selectedSlot selectedSign) - normalization.rightNeighborDisplacement) ∧ BoundaryFootprintVertices - (normalization.pieces selectedSlot selectedSign) = BoundaryFootprintVertices - (TileTranslation (normalization.layout.P selectedSlot selectedSign) - normalization.rightNeighborDisplacement) ∧ BoundaryFootprintEdges - (normalization.pieces selectedSlot selectedSign) = BoundaryFootprintEdges - (TileTranslation (normalization.layout.P selectedSlot selectedSign) - normalization.rightNeighborDisplacement) ∧ TileRealization (normalization.pieces - selectedSlot selectedSign) = TileRealization (TileTranslation (normalization.layout.P - selectedSlot selectedSign) normalization.rightNeighborDisplacement) ∧ TileCentroid - (normalization.pieces selectedSlot selectedSign) = TileCentroid (TileTranslation - (normalization.layout.P selectedSlot selectedSign) - normalization.rightNeighborDisplacement)) → (((normalization.pieces selectedSlot - selectedSign).cells = (SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v exteriorIndex).cells) → - (((normalization.pieces selectedSlot selectedSign).cells = ∅ → (normalization.pieces - selectedSlot selectedSign).anchor = (SubtileOccurrenceInterpretation - normalization.layout.P normalization.layout.u normalization.layout.v - exteriorIndex).anchor) → ((FootprintVertices (normalization.pieces selectedSlot - selectedSign) = FootprintVertices (SubtileOccurrenceInterpretation - normalization.layout.P normalization.layout.u normalization.layout.v exteriorIndex)) - → ((0 ≤ (q selectedSlot.succ).1) → ((0 < (q selectedSlot.succ).1) → - ((((normalization.functions selectedSlot selectedSign).domain : Set GaussianInt) = - FootprintVertices (SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v exteriorIndex)) → - ((LatticeVertexIncidentCell normalization.normalizedPoint j ∈ - (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u - normalization.layout.v exteriorIndex).cells) → ((LatticeVertexIncidentCell - normalization.normalizedPoint j ∈ FootprintVertices (SubtileOccurrenceInterpretation - normalization.layout.P normalization.layout.u normalization.layout.v exteriorIndex) ∧ - LatticeVertexIncidentCell normalization.normalizedPoint j + (1 : GaussianInt) ∈ - FootprintVertices (SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v exteriorIndex) ∧ - LatticeVertexIncidentCell normalization.normalizedPoint j + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ∈ FootprintVertices (SubtileOccurrenceInterpretation - normalization.layout.P normalization.layout.u normalization.layout.v exteriorIndex) ∧ - LatticeVertexIncidentCell normalization.normalizedPoint j + (1 : GaussianInt) + (⟨(0 - : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ FootprintVertices (SubtileOccurrenceInterpretation - normalization.layout.P normalization.layout.u normalization.layout.v exteriorIndex)) - → ((forall y, y = normalization.normalizedPoint ∨ y = normalization.normalizedPoint + - 1 ∨ y = normalization.normalizedPoint - 1 ∨ y = normalization.normalizedPoint + ⟨0, - 1⟩ ∨ y = normalization.normalizedPoint - ⟨0, 1⟩ -> y ∈ FootprintVertices - (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u - normalization.layout.v exteriorIndex) ∨ y ∈ FootprintVertices - (SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u - normalization.layout.v centralIndex)) → (∀ (localizedEdge : Finset GaussianInt), - (localizedEdge ∈ FootprintEdges (SubtileOccurrenceInterpretation - normalization.layout.P normalization.layout.u normalization.layout.v exteriorIndex) ∩ - FootprintEdges (SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v centralIndex)) → - ((normalization.rightNeighborPositive = true ∧ (normalization.rightDirectionSlot = (0 - : Fin (3 : ℕ)) ∧ (exteriorIndex = (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex) ∨ exteriorIndex = (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex)) ∨ normalization.rightDirectionSlot = (1 : Fin (3 : ℕ)) ∧ - (exteriorIndex = (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ - exteriorIndex = (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex)) ∨ - normalization.rightDirectionSlot = (2 : Fin (3 : ℕ)) ∧ (exteriorIndex = - (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ exteriorIndex = - (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex))) ∨ - normalization.rightNeighborPositive = false ∧ (normalization.rightDirectionSlot = (0 - : Fin (3 : ℕ)) ∧ (exteriorIndex = (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex) ∨ exteriorIndex = (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex)) ∨ normalization.rightDirectionSlot = (1 : Fin (3 : ℕ)) ∧ - (exteriorIndex = (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ - exteriorIndex = (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex)) ∨ - normalization.rightDirectionSlot = (2 : Fin (3 : ℕ)) ∧ (exteriorIndex = - (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) ∨ exteriorIndex = - (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex)))) → (∀ [ - Nonempty (BandOrderedGeneralSelectedContactRow q normalization.configuration - normalization.normalizedCircle normalization.normalizedFixed normalization.layout - exteriorIndex centralIndex)], (exteriorIndex = ⟨.A, -1, -1⟩ ∨ exteriorIndex = ⟨.A, 0, - -1⟩ ∨ exteriorIndex = ⟨.C, 1, 0⟩ ∨ exteriorIndex = ⟨.C, 1, 1⟩ ∨ exteriorIndex = ⟨.E, - 0, 1⟩ ∨ exteriorIndex = ⟨.E, -1, 0⟩ ∨ exteriorIndex = ⟨.B, 1, 1⟩ ∨ exteriorIndex = - ⟨.B, 0, 1⟩ ∨ exteriorIndex = ⟨.D, -1, 0⟩ ∨ exteriorIndex = ⟨.D, -1, -1⟩ ∨ - exteriorIndex = ⟨.F, 0, -1⟩ ∨ exteriorIndex = ⟨.F, 1, 0⟩) → ((selectedSlot = - normalization.rightFirstSlot ∧ selectedSign = normalization.firstBoundarySign) ∨ - (selectedSlot = normalization.rightSecondSlot ∧ selectedSign = - normalization.secondBoundarySign)))))))))))))))))))))) ) := by + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (N : ProtoTile), + ∀ (h : PartialOdometer), + ∀ (k : PartialOdometer), + ∀ (x : GaussianInt), + ∀ + (normalization : + BandOrderedGeneralRightNormalizationCertificate C T N h k x), + let q := normalization.normalizedPresentation; + ∀ (selectedSlot : Fin (3 : ℕ)), + ∀ (selectedSign : Bool), + ∀ (centralSlot : Fin (3 : ℕ)), + ∀ (centralSign : Bool), + let m : Int := + if normalization.rightDirectionSlot = 0 then + if normalization.rightNeighborPositive = true then 1 + else -1 + else + if normalization.rightDirectionSlot = 1 then 0 + else + if normalization.rightNeighborPositive = true then -1 + else 1; + let n : Int := + if normalization.rightDirectionSlot = 0 then 0 + else + if normalization.rightDirectionSlot = 1 then + if normalization.rightNeighborPositive = true then 1 + else -1 + else + if normalization.rightNeighborPositive = true then -1 + else 1; + let labelOf : Fin 3 → Bool → SixSubtileLabel := fun i s => + if i = 0 then if s = true then .A else .B + else + if i = 1 then if s = true then .C else .D + else if s = true then .E else .F; + let exteriorIndex : PeriodicSubtileIndex := + ⟨labelOf selectedSlot selectedSign, m, n⟩; + let centralIndex : PeriodicSubtileIndex := + ⟨labelOf centralSlot centralSign, 0, 0⟩; + normalization.rightNeighborPositive = true ∧ + (normalization.rightDirectionSlot = 0 ∧ + exteriorIndex.first = 1 ∧ exteriorIndex.second = 0 ∨ + normalization.rightDirectionSlot = 1 ∧ + exteriorIndex.first = 0 ∧ exteriorIndex.second = 1 ∨ + normalization.rightDirectionSlot = 2 ∧ + exteriorIndex.first = -1 ∧ exteriorIndex.second = -1) ∨ + normalization.rightNeighborPositive = false ∧ + (normalization.rightDirectionSlot = 0 ∧ + exteriorIndex.first = -1 ∧ exteriorIndex.second = 0 ∨ + normalization.rightDirectionSlot = 1 ∧ + exteriorIndex.first = 0 ∧ exteriorIndex.second = -1 ∨ + normalization.rightDirectionSlot = 2 ∧ + exteriorIndex.first = 1 ∧ exteriorIndex.second = 1) → + 0 ≤ (q selectedSlot.succ).1 → + 0 < (q selectedSlot.succ).1 → + normalization.rightNeighborPositive = true ∧ + (normalization.rightDirectionSlot = (0 : Fin (3 : ℕ)) ∧ + (exteriorIndex = + (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) ∨ + exteriorIndex = + (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex)) ∨ + normalization.rightDirectionSlot = (1 : Fin (3 : ℕ)) ∧ + (exteriorIndex = + (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : + PeriodicSubtileIndex) ∨ + exteriorIndex = + (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : + PeriodicSubtileIndex)) ∨ + normalization.rightDirectionSlot = (2 : Fin (3 : ℕ)) ∧ + (exteriorIndex = + (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) ∨ + exteriorIndex = + (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex))) ∨ + normalization.rightNeighborPositive = false ∧ + (normalization.rightDirectionSlot = (0 : Fin (3 : ℕ)) ∧ + (exteriorIndex = + (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex) ∨ + exteriorIndex = + (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : + PeriodicSubtileIndex)) ∨ + normalization.rightDirectionSlot = (1 : Fin (3 : ℕ)) ∧ + (exteriorIndex = + (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex) ∨ + exteriorIndex = + (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : + PeriodicSubtileIndex)) ∨ + normalization.rightDirectionSlot = (2 : Fin (3 : ℕ)) ∧ + (exteriorIndex = + (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : + PeriodicSubtileIndex) ∨ + exteriorIndex = + (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : + PeriodicSubtileIndex))) → + ∀ + [Nonempty + (BandOrderedGeneralSelectedContactRow q + normalization.configuration normalization.normalizedCircle + normalization.normalizedFixed normalization.layout + exteriorIndex centralIndex)], + selectedSlot = normalization.rightFirstSlot ∧ + selectedSign = normalization.firstBoundarySign ∨ + selectedSlot = normalization.rightSecondSlot ∧ + selectedSign = normalization.secondBoundarySign + ) := by classical - intro C T N h k x normalization q j selectedSlot selectedSign hselected centralSlot centralSign - m n labelOf exteriorIndex centralIndex hshift hexteriorOccurrence hpieceBand hlayoutBand - htranslatedLayout hcentroidAlign hselectedUnique hselectedObservables hselectedCells - hselectedAnchor hselectedFootprint hparentNonnegative hparentPositive hselectedDomain - hexteriorCell exteriorCorners hstar localizedEdge hlocalizedCommon hclassification hcontact - hexteriorIndex + intro C T N h k x normalization q selectedSlot selectedSign centralSlot centralSign m n + labelOf exteriorIndex centralIndex hshift hparentNonnegative hparentPositive + hclassification hcontact rcases normalization.right_slots_cyclic with hslots | hslots | hslots <;> rcases hslots with ⟨hfirst, hsecond, hdirection⟩ <;> rcases normalization.boundary_signs with hsigns | hsigns <;> @@ -943,10 +945,10 @@ theorem BandOrderedGeneralRightRoutingCertificateExists let centralIndex : PeriodicSubtileIndex := ⟨labelOf centralSlot centralSign, 0, 0⟩ have hshift := RightRoutingGeometry.hshift C T N h k x normalization selectedSlot selectedSign - have hcentralIndex := RightRoutingGeometry.hcentralIndex C T N h k x normalization j - centralSlot centralSign hcentral + have hcentralIndex := RightRoutingGeometry.hcentralIndex + centralSlot centralSign have hexteriorOccurrence := RightRoutingGeometry.hexteriorOccurrence C T N h k x normalization - j selectedSlot selectedSign hselected (RightRoutingGeometry.hdisplacement C T N h k x + selectedSlot selectedSign (RightRoutingGeometry.hdisplacement C T N h k x normalization period0 period1 (RightRoutingGeometry.period2 C T N h k x normalization (BandVectorOutgoingSum q normalization.configuration.proper) period0 period1)) hshift @@ -1003,8 +1005,8 @@ theorem BandOrderedGeneralRightRoutingCertificateExists have footprint_of_cell := RightRoutingGeometry.footprint_of_cell have exteriorCorners := footprint_of_cell _ _ hexteriorCell have centralCorners := footprint_of_cell _ _ hcentralCell - have hstar := RightRoutingGeometry.hstar C T N h k x normalization j hjroot hjfixed - selectedSlot selectedSign hselected centralSlot centralSign hcentral hexteriorCell + have hstar := RightRoutingGeometry.hstar C T N h k x normalization j + selectedSlot selectedSign centralSlot centralSign hexteriorCell hcentralCell exteriorCorners centralCorners obtain ⟨localizedEdge, hlocalizedPoint, hlocalizedCommon, hclassification, hcontact⟩ := @@ -1027,11 +1029,8 @@ theorem BandOrderedGeneralRightRoutingCertificateExists selectedSign := selectedSign selected_piece_cell := hselected selected_boundary_piece := (@RightRoutingGeometry.hselectedBoundary C T N h k x - normalization j selectedSlot selectedSign hselected centralSlot centralSign hshift - hexteriorOccurrence hpieceBand hlayoutBand htranslatedLayout hcentroidAlign - hselectedUnique hselectedObservables hselectedCells hselectedAnchor hselectedFootprint - hparentNonnegative hparentPositive hselectedDomain hexteriorCell exteriorCorners hstar - localizedEdge hlocalizedCommon hclassification hcontact hexteriorIndex) + normalization selectedSlot selectedSign centralSlot centralSign hshift + hparentNonnegative hparentPositive hclassification hcontact) exteriorIndex := exteriorIndex centralIndex := centralIndex exterior_index := hexteriorIndex diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean index 677cf10bd9..7e80b7d6c6 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentRightEndpoint.lean @@ -30,16 +30,16 @@ private theorem hq : (by classical exact - ∀ (r : Fin 4 → CircleCoordinates), (ProperBandQuadruple r) → (∀ (a : Fin (3 : ℕ)), ∀ (g0 - : BandPackingSymmetry), ∀ (P : FordFareyParameter), ((r (a + (2 : Fin (3 : - ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g0 ![r (0 : Fin (4 : - ℕ)), r a.succ, r (a + (1 : Fin (3 : ℕ))).succ, r (a + (2 : Fin (3 : ℕ))).succ] = - FordRecursiveQuadruple P) → ( - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - ProperBandQuadruple q))) ) := by + ∀ (r : Fin 4 → CircleCoordinates), + ProperBandQuadruple r → + ∀ (a : Fin (3 : ℕ)), + (r (a + (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ) → + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ProperBandQuadruple q + ) := by classical - intro r hproper a g0 P hzero hford q + intro r hproper a hzero q fin_cases a · convert hproper using 1; funext x; fin_cases x <;> rfl · have rotated := SemiProperQuadruple.rotate hproper.1 @@ -289,30 +289,34 @@ private theorem actionCommute : (by classical exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W - : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if Even (↑s : ℕ) then i - (1 : - Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → ((TileCentroid W - TileCentroid U - = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * - (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) - (r i.succ)))) → ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint - ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 - (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - BandVectors.1 (r (i - (1 : - Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) else BandVectors.1 (r (i + (1 : Fin (3 : - ℕ))).succ) (r (0 : Fin (4 : ℕ))) - BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i + (1 : - Fin (3 : ℕ))).succ))) → ((0 ≤ (r ((if Even s.val then i - 1 else i + 1).succ)).1) → - (((0 : ℤ) = (r (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : - ℕ))).succ).1) → (∀ (g0 : BandPackingSymmetry), (∃ (w : GaussianInt), g0 = - BandPackingSymmetry.shift w ∨ g0 = (BandPackingSymmetry.shift w).comp - BandPackingSymmetry.negate) → (∀ (g : BandPackingSymmetry), (g = g0 ∨ g = - (BandPackingSymmetry.negate.comp BandPackingSymmetry.negate).comp g0) → - ((TileCentroid (BandPackingSymmetryTileAction g W) - TileCentroid - (BandPackingSymmetryTileAction g U) = (1 / 2 : Real) • GaussianRealPoint - (BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val * (BandVectors.1 - (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ))))) → (∀ (x : GaussianInt), - BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val * x) = (⟨0, 1⟩ : - GaussianInt) ^ s.val * BandPackingSymmetryVectorAction g x)))))))) ) := by + ∀ (r : Fin 4 → CircleCoordinates), + ∀ (i : Fin 3), + ∀ (s : Fin 4), + 0 ≤ (r (if Even s.val then i - 1 else i + 1).succ).1 → + (0 : ℤ) = + (r + (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) + else i + (1 : Fin (3 : ℕ))).succ).1 → + ∀ (g0 : BandPackingSymmetry), + (∃ (w : GaussianInt), + g0 = BandPackingSymmetry.shift w ∨ + g0 = + (BandPackingSymmetry.shift w).comp + BandPackingSymmetry.negate) → + ∀ (g : BandPackingSymmetry), + g = g0 ∨ + g = + (BandPackingSymmetry.negate.comp + BandPackingSymmetry.negate).comp + g0 → + ∀ (x : GaussianInt), + BandPackingSymmetryVectorAction g + ((⟨0, 1⟩ : GaussianInt) ^ s.val * x) = + (⟨0, 1⟩ : GaussianInt) ^ s.val * + BandPackingSymmetryVectorAction g x + ) := by classical - intro r i s U W Z hZ hWcent hZcent nonnegative zero g0 hword g hglift centroidAction x + intro r i s nonnegative zero g0 hword g hglift x rcases hglift with lift | lift · rw [lift] rcases hword with ⟨w, word | word⟩ <;> rw [word] @@ -626,7 +630,7 @@ theorem BandOrientedChildParentRightEndpoint ⟨(if Even s.val then i - 1 else i + 1).succ, zero.symm⟩ let q : Fin 4 → CircleCoordinates := ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - have hq : ProperBandQuadruple q := OrientedRightEndpointGeometry.hq r hproper a g0 P hzero hford + have hq : ProperBandQuadruple q := OrientedRightEndpointGeometry.hq r hproper a hzero have hprojective := BandPackingSymmetryProjectiveVectorCovariance g0 q hq dsimp at hprojective rcases hprojective with ⟨negative, hphase, hphase1, hphase2, hcircle, @@ -685,7 +689,7 @@ theorem BandOrientedChildParentRightEndpoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * x) = (⟨0, 1⟩ : GaussianInt) ^ s.val * BandPackingSymmetryVectorAction g x := OrientedRightEndpointGeometry.actionCommute r - i s U W Z hZ hWcent hZcent nonnegative zero g0 hword g hglift centroidAction x + i s nonnegative zero g0 hword g hglift x have vectorIdentity : BandPackingSymmetryVectorAction g ((⟨0, 1⟩ : GaussianInt) ^ s.val * diff --git a/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean b/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean index 0d149ae82d..eede1dbe77 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOriginalOccurrenceIntersectionClassification.lean @@ -743,12 +743,16 @@ private theorem hneAt625 : (by classical exact - ∀ (m : ℤ), ∀ (n : ℤ), ∀ (p : ℤ), ∀ (r : ℤ), (¬(⟨SixSubtileLabel.A, m, n⟩ : - PeriodicSubtileIndex) = (⟨SixSubtileLabel.A, p, r⟩ : PeriodicSubtileIndex)) → - ((¬AllowedSubtileIncidence (⟨SixSubtileLabel.A, m, n⟩ : PeriodicSubtileIndex) - (⟨SixSubtileLabel.A, p, r⟩ : PeriodicSubtileIndex)) → ((m, n) ≠ (p, r))) ) := by + ∀ (m : ℤ), + ∀ (n : ℤ), + ∀ (p : ℤ), + ∀ (r : ℤ), + ¬(⟨SixSubtileLabel.A, m, n⟩ : PeriodicSubtileIndex) = + (⟨SixSubtileLabel.A, p, r⟩ : PeriodicSubtileIndex) → + (m, n) ≠ (p, r) + ) := by classical - intro m n p r hab hna heq + intro m n p r hab heq apply hab cases heq rfl @@ -930,7 +934,7 @@ private theorem vertexAlternative : | A => cases lb with | A => - have hne : (m, n) ≠ (p, r) := OriginalIntersectionGeometry.hneAt625 m n p r hab hna + have hne : (m, n) ≠ (p, r) := OriginalIntersectionGeometry.hneAt625 m n p r hab have hv := hmod_vertex_alt ⟨.A, m, n⟩ ⟨.A, p, r⟩ (by intro heq apply hab diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean index cce1ecb9e8..f3f1e97a3c 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryAffineVectorCovariance.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCurvature public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryAffineVectorAction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryProjectiveVectorCovariance @@ -25,22 +26,7 @@ namespace ApollonianSuperharmonic namespace AffineSymmetryCoordinates -private theorem circleCurvature : - (by - classical - exact - ∀ h : BandPackingSymmetry, ∀ C : CircleCoordinates, (BandPackingSymmetryCircleAction h - C).1 = C.1 ) := by - classical - intro h - induction h with - | identity => intro C; rfl - | negate => intro C; rfl - | conjugate => intro C; rfl - | shift w => intro C; rfl - | comp h k ih ih' => - intro C - simp [BandPackingSymmetryCircleAction, ih, ih'] +private abbrev circleCurvature := ApollonianSuperharmonic.BandPackingSymmetryCurvature.preserved private theorem affineFacts : (by @@ -433,88 +419,183 @@ private theorem hprodAt446 : (by classical exact - ∀ (g : BandPackingSymmetry), ∀ (q : Fin 4 → CircleCoordinates), ∀ (negative : Bool), - (BandPackingSymmetryScopedPhase g q negative) → (∀ (i : Fin (3 : ℕ)), - let epsilon : GaussianInt := if negative then -1 else 1 - (epsilon * epsilon = 1) → ((∀ (V : GaussianInt), ∀ (A : GaussianInt), ∀ (b : - GaussianInt), V ≠ 0 → 2 * V * A = 2 * (epsilon * V) * b → b = epsilon * A) → - ((BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) ^ (2 : ℕ) = - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).1 • - (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g - = true then -i else i).succ).2 - (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ).1 • - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2 ∧ (2 : GaussianInt) * - BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) * BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q (if BandPackingSymmetryReversesOrientation g - = true then -i else i).succ) (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : - ℕ))) = (BandPackingSymmetryQuadrupleAction g q (if - BandPackingSymmetryReversesOrientation g = true then -i else i).succ).2 + - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2) → - (((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : - ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = - BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) ∧ - Zsqrtd.norm (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 - : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = (q i.succ).1 + - (q (0 : Fin (4 : ℕ))).1 ∧ (2 : GaussianInt) * (BandPackingSymmetryAffineVectorAction - g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : - Fin (4 : ℕ))))).1 * (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q - i.succ) (q (0 : Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2 = - (BandPackingSymmetryCircleAction g (q i.succ)).2 + (BandPackingSymmetryCircleAction g - (q (0 : Fin (4 : ℕ)))).2) → ((BandVectors.2 (BandPackingSymmetryQuadrupleAction g q - (if BandPackingSymmetryReversesOrientation g = true then -i else i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = epsilon * - (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : - ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2) → - ((BandPackingSymmetryReversesOrientation g = true) → (((BandVectors.1 - (BandPackingSymmetryQuadrupleAction g q (-i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = if negative = true then - -BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) - else BandPackingSymmetryVectorAction g (BandVectors.1 (q i.succ) (q (0 : Fin (4 : - ℕ))))) ∧ (BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g q (-i).succ) = -if negative = true then - -BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) - else BandPackingSymmetryVectorAction g (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q - i.succ))) ∧ BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 : - ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ) = - if negative = true then -GaussianQuarterTurn (BandPackingSymmetryVectorAction g - (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))) - else GaussianQuarterTurn (BandPackingSymmetryVectorAction g (BandVectors.1 (q (i + (2 - : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)))) → ( - let j : Fin 4 := (i + 2).succ - let k : Fin 4 := (i + 1).succ - let V := (BandPackingSymmetryAffineVectorAction g - (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).1 - let A := (BandPackingSymmetryAffineVectorAction g - (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).2 - (j ≠ k) → (((BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) (q k), - BandVectors.2 (q j) (q k))).1 = BandPackingSymmetryVectorAction g (BandVectors.1 (q - j) (q k)) ∧ Zsqrtd.norm (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) - (q k), BandVectors.2 (q j) (q k))).1 = (q j).1 + (q k).1 ∧ (2 : GaussianInt) * - (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) (q k), BandVectors.2 (q - j) (q k))).1 * (BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q j) (q k), - BandVectors.2 (q j) (q k))).2 = (BandPackingSymmetryCircleAction g (q j)).2 + - (BandPackingSymmetryCircleAction g (q k)).2) → ((BandVectors.1 - (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 : ℕ))).succ) - (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ) ^ (2 : ℕ) = - (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ).1 • - (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 : ℕ))).succ).2 - - (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 : ℕ))).succ).1 • - (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ).2 ∧ (2 : - GaussianInt) * BandVectors.1 (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin - (3 : ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : - ℕ))).succ) * BandVectors.2 (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 - : ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ) = - (BandPackingSymmetryQuadrupleAction g q (-i + (2 : Fin (3 : ℕ))).succ).2 + - (BandPackingSymmetryQuadrupleAction g q (-i + (1 : Fin (3 : ℕ))).succ).2) → (2 * V * - A = 2 * (epsilon * GaussianQuarterTurn V) * (BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q (-i + 2).succ) - (BandPackingSymmetryQuadrupleAction g q (-i + 1).succ))))))))))))) ) := by + ∀ (g : BandPackingSymmetry), + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (negative : Bool), + ∀ (i : Fin (3 : ℕ)), + let epsilon : GaussianInt := if negative then -1 else 1 + epsilon * epsilon = 1 → + (∀ (V : GaussianInt), + ∀ (A : GaussianInt), + ∀ (b : GaussianInt), + V ≠ 0 → 2 * V * A = 2 * (epsilon * V) * b → b = epsilon * A) → + BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q + (if BandPackingSymmetryReversesOrientation g = true then + -i + else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) ^ + (2 : ℕ) = + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).1 • + (BandPackingSymmetryQuadrupleAction g q + (if BandPackingSymmetryReversesOrientation g = true then + -i + else i).succ).2 - + (BandPackingSymmetryQuadrupleAction g q + (if BandPackingSymmetryReversesOrientation g = true then + -i + else i).succ).1 • + (BandPackingSymmetryQuadrupleAction g q + (0 : Fin (4 : ℕ))).2 ∧ + (2 : GaussianInt) * + BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q + (if BandPackingSymmetryReversesOrientation g = true then + -i + else i).succ) + (BandPackingSymmetryQuadrupleAction g q + (0 : Fin (4 : ℕ))) * + BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q + (if BandPackingSymmetryReversesOrientation g = true then + -i + else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = + (BandPackingSymmetryQuadrupleAction g q + (if BandPackingSymmetryReversesOrientation g = true then + -i + else i).succ).2 + + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))).2 → + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), + BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = + BandPackingSymmetryVectorAction g + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) ∧ + Zsqrtd.norm + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), + BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 = + (q i.succ).1 + (q (0 : Fin (4 : ℕ))).1 ∧ + (2 : GaussianInt) * + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), + BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).1 * + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), + BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2 = + (BandPackingSymmetryCircleAction g (q i.succ)).2 + + (BandPackingSymmetryCircleAction g + (q (0 : Fin (4 : ℕ)))).2 → + BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q + (if BandPackingSymmetryReversesOrientation g = true then + -i + else i).succ) + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = + epsilon * + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), + BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ))))).2 → + BandPackingSymmetryReversesOrientation g = true → + ((BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (-i).succ) + (BandPackingSymmetryQuadrupleAction g q + (0 : Fin (4 : ℕ))) = + if negative = true then + -BandPackingSymmetryVectorAction g + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + else + BandPackingSymmetryVectorAction g + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) ∧ + (BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) + (BandPackingSymmetryQuadrupleAction g q (-i).succ) = + -if negative = true then + -BandPackingSymmetryVectorAction g + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ)) + else + BandPackingSymmetryVectorAction g + (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) ∧ + BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q + (-i + (2 : Fin (3 : ℕ))).succ) + (BandPackingSymmetryQuadrupleAction g q + (-i + (1 : Fin (3 : ℕ))).succ) = + if negative = true then + -GaussianQuarterTurn + (BandPackingSymmetryVectorAction g + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ))) + else + GaussianQuarterTurn + (BandPackingSymmetryVectorAction g + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)))) → + let j : Fin 4 := (i + 2).succ + let k : Fin 4 := (i + 1).succ + let V := + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).1 + let A := + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), BandVectors.2 (q j) (q k))).2 + j ≠ k → + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), + BandVectors.2 (q j) (q k))).1 = + BandPackingSymmetryVectorAction g + (BandVectors.1 (q j) (q k)) ∧ + Zsqrtd.norm + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), + BandVectors.2 (q j) (q k))).1 = + (q j).1 + (q k).1 ∧ + (2 : GaussianInt) * + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), + BandVectors.2 (q j) (q k))).1 * + (BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q j) (q k), + BandVectors.2 (q j) (q k))).2 = + (BandPackingSymmetryCircleAction g (q j)).2 + + (BandPackingSymmetryCircleAction g (q k)).2 → + BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q + (-i + (2 : Fin (3 : ℕ))).succ) + (BandPackingSymmetryQuadrupleAction g q + (-i + (1 : Fin (3 : ℕ))).succ) ^ + (2 : ℕ) = + (BandPackingSymmetryQuadrupleAction g q + (-i + (1 : Fin (3 : ℕ))).succ).1 • + (BandPackingSymmetryQuadrupleAction g q + (-i + (2 : Fin (3 : ℕ))).succ).2 - + (BandPackingSymmetryQuadrupleAction g q + (-i + (2 : Fin (3 : ℕ))).succ).1 • + (BandPackingSymmetryQuadrupleAction g q + (-i + (1 : Fin (3 : ℕ))).succ).2 ∧ + (2 : GaussianInt) * + BandVectors.1 + (BandPackingSymmetryQuadrupleAction g q + (-i + (2 : Fin (3 : ℕ))).succ) + (BandPackingSymmetryQuadrupleAction g q + (-i + (1 : Fin (3 : ℕ))).succ) * + BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q + (-i + (2 : Fin (3 : ℕ))).succ) + (BandPackingSymmetryQuadrupleAction g q + (-i + (1 : Fin (3 : ℕ))).succ) = + (BandPackingSymmetryQuadrupleAction g q + (-i + (2 : Fin (3 : ℕ))).succ).2 + + (BandPackingSymmetryQuadrupleAction g q + (-i + (1 : Fin (3 : ℕ))).succ).2 → + 2 * V * A = + 2 * (epsilon * GaussianQuarterTurn V) * + BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q (-i + 2).succ) + (BandPackingSymmetryQuadrupleAction g q (-i + 1).succ) + ) := by classical - intro g q negative hphase i epsilon epsilonSquare slopeCancel incomingProduct incomingAffine + intro g q negative i epsilon epsilonSquare slopeCancel incomingProduct incomingAffine incomingSlope hrev hspatial j k V A hjk aff prod calc 2 * V * A = (BandPackingSymmetryCircleAction g (q j)).2 + @@ -826,7 +907,7 @@ theorem BandPackingSymmetryAffineVectorCovariance 2 * (epsilon * GaussianQuarterTurn V) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction g q (-i + 2).succ) (BandPackingSymmetryQuadrupleAction g q - (-i + 1).succ)) := AffineSymmetryCoordinates.hprodAt446 g q negative hphase i + (-i + 1).succ)) := AffineSymmetryCoordinates.hprodAt446 g q negative i epsilonSquare slopeCancel incomingProduct incomingAffine incomingSlope hrev hspatial hjk aff prod have hv : V ≠ 0 := by diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean index a4ccb6a65a..6965743e79 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCurvature +public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts public import LeanPool.ApollonianSuperharmonic.TileOdometerSlopeNonempty public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance @@ -394,33 +396,9 @@ private theorem affineFirst : (BandPackingSymmetryVectorAction b z.1) rw [iha, ihb] -private theorem circleCurvature : - (by - classical - exact - ∀ (k : BandPackingSymmetry), ∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction - k C).1 = C.1 ) := by - classical - intro k - induction k with - | identity => intro C; rfl - | negate => intro C; rfl - | conjugate => intro C; rfl - | shift w => intro C; rfl - | comp a b iha ihb => intro C; simp [BandPackingSymmetryCircleAction, iha, ihb] +private abbrev circleCurvature := ApollonianSuperharmonic.BandPackingSymmetryCurvature.preserved -private theorem positiveSupport : - (by - classical - exact - ∀ (C : CircleCoordinates), - ∀ (U : ProtoTile), - ∀ (k : PartialOdometer), - ∀ (p : ℝ × ℝ), - TileOdometer C U k → PartialOdometerSlope k = some p → U.cells.Nonempty - ) := by - intro C U k p hO hp - exact TileOdometerSlopeNonempty.cells C U k p hO hp +private abbrev positiveSupport := ApollonianSuperharmonic.TileOdometerSlopeNonempty.cells private theorem hq0 : (by @@ -683,78 +661,147 @@ private theorem hcentGoal : (by classical exact - (∀ (k : BandPackingSymmetry), ∀ (z : GaussianInt × GaussianInt), - (BandPackingSymmetryAffineVectorAction k z).1 = BandPackingSymmetryVectorAction k - z.1) → (∀ (g : BandPackingSymmetry), ∀ (C' : CircleCoordinates), ∀ (T : ProtoTile), ∀ - (T' : ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : PartialOdometer), ∀ (q : Fin (4 : - ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (e : Bool), (TileCentroid T' - - TileCentroid T = (if e = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • - (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin - (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q - (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((C'.1 = (0 : - ℤ) ∨ ∃ (p : ℝ × ℝ) (p' : ℝ × ℝ), PartialOdometerSlope h = some p ∧ - PartialOdometerSlope h' = some p' ∧ p'.1 - p.1 = (if e = true then (1 : ℝ) else (-1 : - ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : - Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q - (i + (1 : Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p'.2 - p.2 = (if e = true then (1 : ℝ) else - (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + - (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) - (q (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (∀ (delta : Bool), - (BandPackingSymmetryScopedPhase g q delta) → ((∀ (i : Fin (3 : ℕ)), - let e := if delta = true then (-1 : GaussianInt) else (1 : GaussianInt); - let incoming := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q i.succ) (q (0 : - Fin (4 : ℕ))), BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); - let cyclic := BandPackingSymmetryAffineVectorAction g (BandVectors.1 (q (i + (2 : Fin (3 - : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ), BandVectors.2 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)); BandVectors.2 - (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i).succ) - (BandPackingSymmetryQuadrupleAction g q (0 : Fin (4 : ℕ))) = e * incoming.2 ∧ - BandVectors.2 (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i + (2 : Fin (3 : - ℕ))).succ) (BandPackingSymmetryQuadrupleAction g q ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -i else i) i + (1 : Fin (3 : - ℕ))).succ) = e * if BandPackingSymmetryReversesOrientation g = true then - -GaussianQuarterTurn cyclic.2 else cyclic.2) → ( - let q' := BandPackingSymmetryQuadrupleAction g q - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j - let e' := xor e delta - let W := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) - let A := BandVectors.2 (q ((i + 2).succ)) (q ((i + 1).succ)) - let Z : GaussianInt × GaussianInt := (W, A) - let M : GaussianInt × GaussianInt := - (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) - let W' := BandVectors.1 (q' ((sigma i + 2).succ)) - (q' ((sigma i + 1).succ)) - let A' := BandVectors.2 (q' ((sigma i + 2).succ)) - (q' ((sigma i + 1).succ)) - let eReal : ℝ := if e then 1 else -1 - let k : ℝ := eReal / 2 - (TileCentroid T' - TileCentroid T = k • GaussianRealPoint M.1) → ((TileCentroid - (BandPackingSymmetryTileAction g T') - TileCentroid (BandPackingSymmetryTileAction g - T) = k • GaussianRealPoint (BandPackingSymmetryAffineVectorAction g (M.1, (0 : - GaussianInt))).1 ∧ BandPackingSymmetrySlopeAction g T' ((0 : ℝ), (0 : ℝ)) - - BandPackingSymmetrySlopeAction g T ((0 : ℝ), (0 : ℝ)) = k • GaussianRealPoint - (BandPackingSymmetryAffineVectorAction g (M.1, (0 : GaussianInt))).2) → ((W' = (if - delta then (-1 : GaussianInt) else 1) * (if BandPackingSymmetryReversesOrientation g - then GaussianQuarterTurn (BandPackingSymmetryVectorAction g W) else - BandPackingSymmetryVectorAction g W)) → ((A' = (if delta then (-1 : GaussianInt) else - 1) * (if BandPackingSymmetryReversesOrientation g then -GaussianQuarterTurn - (BandPackingSymmetryAffineVectorAction g Z).2 else - (BandPackingSymmetryAffineVectorAction g Z).2)) → (((W' - GaussianQuarterTurn W', A' - + GaussianQuarterTurn A') = if delta then -(BandPackingSymmetryAffineVectorAction g - M) else BandPackingSymmetryAffineVectorAction g M) → (((W' - GaussianQuarterTurn W', - A' + GaussianQuarterTurn A').1 = (if delta = true then - -BandPackingSymmetryAffineVectorAction g M else BandPackingSymmetryAffineVectorAction - g M).1) → (TileCentroid (BandPackingSymmetryTileAction g T') - TileCentroid - (BandPackingSymmetryTileAction g T) = (if e' then (1 : ℝ) else -1) • ((1 / 2 : ℝ) • - (GaussianRealPoint W' - (-(GaussianRealPoint W').2, (GaussianRealPoint - W').1)))))))))))))) ) := by + (∀ (k : BandPackingSymmetry), + ∀ (z : GaussianInt × GaussianInt), + (BandPackingSymmetryAffineVectorAction k z).1 = + BandPackingSymmetryVectorAction k z.1) → + ∀ (g : BandPackingSymmetry), + ∀ (C' : CircleCoordinates), + ∀ (T : ProtoTile), + ∀ (T' : ProtoTile), + ∀ (h : PartialOdometer), + ∀ (h' : PartialOdometer), + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), + ∀ (e : Bool), + TileCentroid T' - TileCentroid T = + (if e = true then (1 : ℝ) else (-1 : ℝ)) • + (1 / 2 : ℝ) • + (GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)) - + (-(GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ))).2, + (GaussianRealPoint + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ))).1)) → + (C'.1 = (0 : ℤ) ∨ + ∃ (p : ℝ × ℝ) (p' : ℝ × ℝ), + PartialOdometerSlope h = some p ∧ + PartialOdometerSlope h' = some p' ∧ + p'.1 - p.1 = + (if e = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).re : + ℝ) - + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).im : + ℝ)) ∧ + p'.2 - p.2 = + (if e = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).im : + ℝ) + + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)).re : + ℝ))) → + ∀ (delta : Bool), + (∀ (i : Fin (3 : ℕ)), + let e := + if delta = true then (-1 : GaussianInt) + else (1 : GaussianInt); + let incoming := + BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))), + BandVectors.2 (q i.succ) (q (0 : Fin (4 : ℕ)))); + let cyclic := + BandPackingSymmetryAffineVectorAction g + (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ), + BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + (q (i + (1 : Fin (3 : ℕ))).succ)); + BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q + ((fun (i : Fin (3 : ℕ)) => + if BandPackingSymmetryReversesOrientation g = true then -i + else i) + i).succ) + (BandPackingSymmetryQuadrupleAction g q + (0 : Fin (4 : ℕ))) = + e * incoming.2 ∧ + BandVectors.2 + (BandPackingSymmetryQuadrupleAction g q + ((fun (i : Fin (3 : ℕ)) => + if BandPackingSymmetryReversesOrientation g = true then -i + else i) + i + + (2 : Fin (3 : ℕ))).succ) + (BandPackingSymmetryQuadrupleAction g q + ((fun (i : Fin (3 : ℕ)) => + if BandPackingSymmetryReversesOrientation g = true then -i + else i) + i + + (1 : Fin (3 : ℕ))).succ) = + e * + if BandPackingSymmetryReversesOrientation g = true then + -GaussianQuarterTurn cyclic.2 + else cyclic.2) → + let q' := BandPackingSymmetryQuadrupleAction g q; + let sigma : Fin 3 → Fin 3 := fun j => + if BandPackingSymmetryReversesOrientation g then -j + else j; + let e' := xor e delta; + let W := BandVectors.1 (q (i + 2).succ) (q (i + 1).succ); + let A := BandVectors.2 (q (i + 2).succ) (q (i + 1).succ); + let M : GaussianInt × GaussianInt := + (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A); + let W' := + BandVectors.1 (q' (sigma i + 2).succ) + (q' (sigma i + 1).succ); + let A' := + BandVectors.2 (q' (sigma i + 2).succ) + (q' (sigma i + 1).succ); + let eReal : ℝ := if e then 1 else -1; + let k : ℝ := eReal / 2; + TileCentroid T' - TileCentroid T = + k • GaussianRealPoint M.1 → + TileCentroid (BandPackingSymmetryTileAction g T') - + TileCentroid (BandPackingSymmetryTileAction g T) = + k • + GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g + (M.1, (0 : GaussianInt))).1 ∧ + BandPackingSymmetrySlopeAction g T' ((0 : ℝ), (0 : ℝ)) - + BandPackingSymmetrySlopeAction g T ((0 : ℝ), (0 : ℝ)) = + k • + GaussianRealPoint + (BandPackingSymmetryAffineVectorAction g + (M.1, (0 : GaussianInt))).2 → + (W' = + (if delta then (-1 : GaussianInt) else 1) * + if BandPackingSymmetryReversesOrientation g then + GaussianQuarterTurn (BandPackingSymmetryVectorAction g W) + else BandPackingSymmetryVectorAction g W) → + ((W' - GaussianQuarterTurn W', + A' + GaussianQuarterTurn A') = + if delta then -BandPackingSymmetryAffineVectorAction g M + else BandPackingSymmetryAffineVectorAction g M) → + (W' - GaussianQuarterTurn W', + A' + GaussianQuarterTurn A').1 = + (if delta = true then + -BandPackingSymmetryAffineVectorAction g M + else BandPackingSymmetryAffineVectorAction g M).1 → + TileCentroid (BandPackingSymmetryTileAction g T') - + TileCentroid (BandPackingSymmetryTileAction g T) = + (if e' then (1 : ℝ) else -1) • + (1 / 2 : ℝ) • + (GaussianRealPoint W' - + (-(GaussianRealPoint W').2, (GaussianRealPoint W').1)) + ) := by classical - intro affineFirst g C' T T' h h' q i e hcent hslope delta hphase hcyc q' sigma e' W A Z M W' A' - eReal k hcentM htr hWphase hAphase hMphase hmFst + intro affineFirst g C' T T' h h' q i e hcent hslope delta hcyc q' sigma e' W A M W' A' eReal k + hcentM htr hWphase hMphase hmFst have hreal : GaussianRealPoint (W' - GaussianQuarterTurn W') = GaussianRealPoint W' - (-(GaussianRealPoint W').2, (GaussianRealPoint W').1) := by @@ -811,73 +858,44 @@ private theorem hsr : rw [hST hTne, hsp] rfl -private theorem hsr' : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), - (Finset.Nonempty T'.cells → PartialOdometerSlope - (BandPackingSymmetryPartialOdometerAction g h') = Option.map - (BandPackingSymmetrySlopeAction g T') (PartialOdometerSlope h')) → (∀ (p' : ℝ × ℝ), - (PartialOdometerSlope h' = some p') → ((Finset.Nonempty T'.cells) → - (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h') = some - (BandPackingSymmetrySlopeAction g T' p')))) ) := by - classical - intro g T' h' hST' p' hsp' hT'ne - rw [hST' hT'ne, hsp'] - rfl +private abbrev hsr' := ApollonianSuperharmonic.MarkedCovarianceGeometry.hsr private theorem hsourceSlope : (by classical exact - ∀ (T : ProtoTile), - ∀ (T' : ProtoTile), - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), - ∀ (i : Fin (3 : ℕ)), - ∀ (e : Bool), - TileCentroid T' - TileCentroid T = - (if e = true then (1 : ℝ) else (-1 : ℝ)) • - (1 / 2 : ℝ) • - (GaussianRealPoint - (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) - (q (i + (1 : Fin (3 : ℕ))).succ)) - - (-(GaussianRealPoint - (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) - (q (i + (1 : Fin (3 : ℕ))).succ))).2, - (GaussianRealPoint - (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) - (q (i + (1 : Fin (3 : ℕ))).succ))).1)) → - let W := BandVectors.1 (q (i + 2).succ) (q (i + 1).succ) - let A := BandVectors.2 (q (i + 2).succ) (q (i + 1).succ) - let M : GaussianInt × GaussianInt := - (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) - let eReal : ℝ := if e then 1 else -1 - let k : ℝ := eReal / 2 - TileCentroid T' - TileCentroid T = k • GaussianRealPoint M.1 → - ∀ (p : ℝ × ℝ), - ∀ (p' : ℝ × ℝ), - p'.1 - p.1 = - (if e = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * - ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (i : Fin (3 : ℕ)), + ∀ (e : Bool), + let W := BandVectors.1 (q (i + 2).succ) (q (i + 1).succ); + let A := BandVectors.2 (q (i + 2).succ) (q (i + 1).succ); + let M : GaussianInt × GaussianInt := + (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A); + let eReal : ℝ := if e then 1 else -1; + let k : ℝ := eReal / 2; + ∀ (p : ℝ × ℝ), + ∀ (p' : ℝ × ℝ), + p'.1 - p.1 = + (if e = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).re : - ℝ) - - (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + ℝ) - + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).im : - ℝ)) → - p'.2 - p.2 = - (if e = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * - ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + ℝ)) → + p'.2 - p.2 = + (if e = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).im : - ℝ) + - (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) + ℝ) + + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)).re : - ℝ)) → - p' - p = k • GaussianRealPoint M.2 + ℝ)) → + p' - p = k • GaussianRealPoint M.2 ) := by classical - intro T T' q i e hcent W A M eReal k hcentM p p' hRe hIm + intro q i e W A M eReal k p p' hRe hIm have hRe' : p'.1 - p.1 = (if e then (1 : ℝ) else -1) * (1 / 2) * (((GaussianInt.toComplex A).re) - (GaussianInt.toComplex A).im) := by simpa [A] using hRe @@ -1144,21 +1162,7 @@ private theorem finiteCompanion : simp [ev0, ev2, odd3, p2, p3, hphase, hquarter, hneg, hrev, hdel, qneg, ← qm] -private theorem allNeg : - (by - classical - exact - ∀ (k : BandPackingSymmetry), ∀ (z : GaussianInt), BandPackingSymmetryVectorAction k (-z) - = -BandPackingSymmetryVectorAction k z ) := by - classical - intro k z - induction k generalizing z with - | identity => rfl - | negate => ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] - | conjugate => ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] - | shift w => rfl - | comp a b iha ihb => - simp only [BandPackingSymmetryVectorAction, ihb, iha] +private abbrev allNeg := ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts.vectorNegation private theorem allQuarter : (by @@ -1564,7 +1568,7 @@ private theorem forwardSub : haffFst hactM hAphase have hmFst := congrArg Prod.fst hMphase have hcentGoal := MarkedCovarianceGeometry.hcentGoal affineFirst g C' T T' h h' q i e - hcent hslope delta hphase hcyc hcentM htr hWphase hAphase hMphase hmFst + hcent hslope delta hcyc hcentM htr hWphase hMphase hmFst exact hcentGoal · by_cases hzero : (q i.succ).1 = 0 · left @@ -1582,8 +1586,7 @@ private theorem forwardSub : have hT'ne := positiveSupport C' T' h' p' hO' hsp' have hsr := MarkedCovarianceGeometry.hsr g T h hST p hsp hTne have hsr' := MarkedCovarianceGeometry.hsr' g T' h' hST' p' hsp' hT'ne - have hsourceSlope := MarkedCovarianceGeometry.hsourceSlope T T' q i e hcent - hcentM p p' hRe hIm + have hsourceSlope := MarkedCovarianceGeometry.hsourceSlope q i e p p' hRe hIm have htrSlope := differenceTransport g T T' p' p M.1 M.2 k hcentM hsourceSlope let r := BandPackingSymmetrySlopeAction g T p diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean index d4303730c2..3b85c9e2dc 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean @@ -6,6 +6,9 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnTranslation +public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurnProperties +public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryLinearIdentities public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties @@ -104,35 +107,11 @@ private theorem triple_obs : private abbrev translate_add := TileTranslationProperties.add -private theorem translate_zero : - (by - classical - exact - ∀ (A : ProtoTile), TileTranslation A 0 = A ) := by - classical - intro A - cases A - have hz : GaussianTranslation 0 = id := by funext z; simp [GaussianTranslation] - simp [TileTranslation, hz, GaussianTranslation] +private abbrev translate_zero := ApollonianSuperharmonic.TileTranslationProperties.zero -private theorem quarter_translate : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (x : GaussianInt), TileQuarterTurn (TileTranslation A x) = - TileTranslation (TileQuarterTurn A) (GaussianQuarterTurn x) ) := by - classical - intro A x - exact (BandPackingSymmetryTilingTransport .negate).2.2.2.2.2.2.1 A x +private abbrev quarter_translate := ApollonianSuperharmonic.TileQuarterTurnTranslation.commute -private theorem qtwo : - (by - classical - exact - ∀ (x : GaussianInt), GaussianQuarterTurn (GaussianQuarterTurn x) = -x ) := by - classical - intro x - ext <;> simp [GaussianQuarterTurn] +private abbrev qtwo := ApollonianSuperharmonic.GaussianQuarterTurnProperties.twice private theorem half_translate : (by @@ -587,20 +566,7 @@ private theorem rminus : cases hh : BandPackingSymmetryReversesOrientation h <;> simp [GaussianRealPoint, GaussianQuarterTurn, sub_eq_add_neg] -private theorem lneg : - (by - classical - exact - ∀ (h : BandPackingSymmetry), ∀ (x : GaussianInt), BandPackingSymmetryVectorAction h (-x) - = -BandPackingSymmetryVectorAction h x ) := by - classical - intro h x - induction h generalizing x with - | identity => rfl - | negate => ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] - | conjugate => ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] - | shift w => rfl - | comp h k ih ik => simp only [BandPackingSymmetryVectorAction, ih, ik] +private abbrev lneg := ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts.vectorNegation private theorem tile_surj : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean index 1cde65bd38..906f5c45bf 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCurvature public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryDomainTransport @@ -250,20 +251,7 @@ private theorem lineCov : rw [hC, htile] exact iha w' x' hw' _ hk' -private theorem circleCurvature : - (by - classical - exact - ∀ (a : BandPackingSymmetry), ∀ (D : CircleCoordinates), (BandPackingSymmetryCircleAction - a D).1 = D.1 ) := by - classical - intro a D - induction a generalizing D with - | identity => rfl - | negate => rfl - | conjugate => rfl - | shift w => rfl - | comp a b iha ihb => simp [BandPackingSymmetryCircleAction, iha, ihb] +private abbrev circleCurvature := ApollonianSuperharmonic.BandPackingSymmetryCurvature.preserved private theorem extractUnit : (by @@ -1692,45 +1680,7 @@ end TileOdometerAssembly namespace TileOdometerConclusion -private theorem hpsi : - (by - classical - exact - ∀ (z : GaussianInt), ∀ (wr : ℤ), ∀ (wi : ℤ), ∀ (v : GaussianInt), - ( - let d1 := BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt)) - - BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v; - let d2 := BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) (v + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt)) - BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v; - BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt) + (⟨(0 : - ℤ), (1 : ℤ)⟩ : GaussianInt)) = BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v + - d1 + d2 + wi) → (∀ r ∈ (CurvatureOneOdometer z).domain, BandPackingShiftPotential - (⟨wr, wi⟩ : GaussianInt) (v + r) = wi * r.re * r.im + (⟨BandPackingShiftPotential - (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt)) - - BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v, BandPackingShiftPotential - (⟨wr, wi⟩ : GaussianInt) (v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - - BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v⟩ : GaussianInt).re * (v + r).re - + (⟨BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt)) - - BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v, BandPackingShiftPotential - (⟨wr, wi⟩ : GaussianInt) (v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - - BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v⟩ : GaussianInt).im * (v + r).im + - BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v - (⟨BandPackingShiftPotential - (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt)) - - BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v, BandPackingShiftPotential - (⟨wr, wi⟩ : GaussianInt) (v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - - BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v⟩ : GaussianInt).re * v.re - - (⟨BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) (v + (1 : GaussianInt)) - - BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v, BandPackingShiftPotential - (⟨wr, wi⟩ : GaussianInt) (v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - - BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v⟩ : GaussianInt).im * v.im) ) := by - classical - intro z wr wi v hcorner r hr - let d1 := BandPackingShiftPotential ⟨wr, wi⟩ (v + 1) - - BandPackingShiftPotential ⟨wr, wi⟩ v - let d2 := BandPackingShiftPotential ⟨wr, wi⟩ (v + ⟨0, 1⟩) - - BandPackingShiftPotential ⟨wr, wi⟩ v - exact TileOdometerAssembly.hpsi z wr wi v - hcorner r hr +private abbrev hpsi := ApollonianSuperharmonic.TileOdometerAssembly.hpsi end TileOdometerConclusion diff --git a/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean b/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean index 407d8f2f43..45051016d7 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints @@ -252,14 +253,7 @@ private theorem hsum : (VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).1 -private theorem gaussianPoint_neg : - (by - classical - exact - ∀ (x : GaussianInt), GaussianRealPoint (-x) = -GaussianRealPoint x ) := by - classical - intro x - ext <;> simp [GaussianRealPoint] +private abbrev gaussianPoint_neg := ApollonianSuperharmonic.GaussianRealPointProperties.negation private theorem gaussianPoint_Iminus_one : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean index 209bad0137..b13a1881ce 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileCompleteSquareCentroid.lean @@ -122,26 +122,25 @@ private theorem tau_cell : classical exact ∀ (T : ProtoTile), - let c := TileCentroid T - let reCells : Finset Int := T.cells.image (fun x => x.re) - let imCells : Finset Int := T.cells.image (fun x => x.im) - ∀ (reNe : reCells.Nonempty), ∀ (imNe : imCells.Nonempty), (∀ p ∈ TileRealization T, (2 * - c.1 - p.1, 2 * c.2 - p.2) ∈ TileRealization T) → ( - let mRe := reCells.min' reNe - let MRe := reCells.max' reNe - (∃ x ∈ T.cells, x.re = mRe) → ((∃ x ∈ T.cells, x.re = MRe) → ((2 * c.1 = (mRe : Real) + - MRe + 1) → ( - let mIm := imCells.min' imNe - let MIm := imCells.max' imNe - (∃ x ∈ T.cells, x.im = mIm) → ((∃ x ∈ T.cells, x.im = MIm) → ((2 * c.2 = (mIm : Real) + - MIm + 1) → ( - let t : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ - let tau : GaussianInt → GaussianInt := fun x => t - x - 1 - ⟨0, 1⟩ - ∀ x ∈ T.cells, tau x ∈ T.cells))))))) + let c := TileCentroid T; + let reCells : Finset Int := T.cells.image fun x => x.re; + let imCells : Finset Int := T.cells.image fun x => x.im; + ∀ (reNe : reCells.Nonempty), + ∀ (imNe : imCells.Nonempty), + (∀ p ∈ TileRealization T, + (2 * c.1 - p.1, 2 * c.2 - p.2) ∈ TileRealization T) → + let mRe := reCells.min' reNe; + let MRe := reCells.max' reNe; + 2 * c.1 = (mRe : Real) + MRe + 1 → + let mIm := imCells.min' imNe; + let MIm := imCells.max' imNe; + 2 * c.2 = (mIm : Real) + MIm + 1 → + let t : GaussianInt := ⟨mRe + MRe + 1, mIm + MIm + 1⟩ + let tau : GaussianInt → GaussianInt := fun x => t - x - 1 - ⟨0, 1⟩ + ∀ x ∈ T.cells, tau x ∈ T.cells ) := by classical - intro T c reCells imCells reNe imNe reflect_mem mRe MRe minReCell maxReCell centerRe mIm MIm - minImCell maxImCell centerIm t tau x hx + intro T c reCells imCells reNe imNe reflect_mem mRe MRe centerRe mIm MIm centerIm t tau x hx have hp : ((x.re : Real) + 1 / 2, (x.im : Real) + 1 / 2) ∈ TileRealization T := by simp only [TileRealization, Set.mem_iUnion] @@ -672,7 +671,7 @@ theorem BandPrototileCompleteSquareCentroid dsimp [tau] apply Zsqrtd.ext <;> dsimp [t] <;> ring have tau_cell : ∀ x ∈ T.cells, tau x ∈ T.cells := CompleteSquareProof.tau_cell T reNe imNe - reflect_mem minReCell maxReCell centerRe minImCell maxImCell centerIm + reflect_mem centerRe centerIm let rho : GaussianInt → GaussianInt := fun v => t - v have footprint_forward : ∀ v, v ∈ FootprintVertices T → rho v ∈ FootprintVertices T := CompleteSquareProof.footprint_forward T hne reNe imNe tau_cell diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean index 8f9140e9b5..a397f4f03e 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.P4638T1EmptyCurvature public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidBounds public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties @@ -34,32 +35,7 @@ namespace ApollonianSuperharmonic namespace PrototileConstruction -private theorem emptyCurv : - (by - classical - exact - ∀ (C : CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T → T.cells = ∅ → C.1 = 0 ) - := by - classical - intro C T hT - induction hT with - | line w x hw => intro _; rfl - | unit z x anchor => simp - | @decompose q hq S T hS hcells hfoot hcentroid ih => - intro hEmpty - have childEmpty (i : Fin 3) (s : Bool) : (S i s).cells = ∅ := by - ext x - constructor - · intro hx - have hxT : x ∈ T.cells := (hcells x).2 ⟨i, s, hx⟩ - simp [hEmpty] at hxT - · intro hx - simp at hx - have z1 := ih 0 false (childEmpty 0 false) - have z2 := ih 1 false (childEmpty 1 false) - have hp := ProperBandCurvatureStructure q hq - have distinct := hp.2.2 0 1 z1 z2 - norm_num at distinct +private abbrev emptyCurv := ApollonianSuperharmonic.P4638T1EmptyCurvature private theorem positiveNonempty : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean b/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean index 7062976c76..1ae6303ec0 100644 --- a/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean +++ b/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandVectorParentSums public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.AffineTriangularPlaneTriangulation @@ -455,15 +456,7 @@ private theorem edge_reps : rw [← hi, map_sub, k.apply_symm_apply, k.apply_symm_apply] abel -private theorem incoming_sum : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (BandVectors.1 (q 1) (q 0) + - BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) ) := by - classical - intro q hq - simpa [Fin.sum_univ_succ, add_assoc] using (IncomingSuperbasisRelation q hq).1 +private abbrev incoming_sum := ApollonianSuperharmonic.BandVectorIncomingSum private theorem kc : (by @@ -558,17 +551,7 @@ private theorem facescard : private abbrev translate_add := TileTranslationProperties.add -private theorem hzero : - (by - classical - exact - ∀ (T : ProtoTile), TileTranslation T 0 = T ) := by - classical - intro T - have hz : GaussianTranslation 0 = id := funext fun z => add_zero z - unfold TileTranslation - rw [hz, Finset.image_id] - rfl +private abbrev hzero := ApollonianSuperharmonic.TileTranslationProperties.zero end RegularPeriodicGeometry diff --git a/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean index 4cb159e576..f9bedb2e98 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.BandRegularTileTouchingClassification @@ -41,23 +42,7 @@ private theorem family_eq : · rintro ⟨u, rfl⟩ exact ⟨u.1, u.2, htile u⟩ -private theorem edge_in_footprint : - (by - classical - exact - ∀ (S : ProtoTile), ∀ (e : Finset GaussianInt), (e ∈ BoundaryFootprintEdges S) → (e ∈ - FootprintEdges S) ) := by - classical - intro S e he - rcases he with ⟨z, ⟨rfl, hz⟩ | ⟨rfl, hz⟩⟩ - · rcases hz with ⟨hz, _⟩ | ⟨_, hz⟩ - · exact ⟨z, hz, Or.inl rfl⟩ - · exact ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr (by - ext; simp [Zsqrtd.ext_iff])))⟩ - · rcases hz with ⟨hz, _⟩ | ⟨_, hz⟩ - · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · exact ⟨z - 1, hz, Or.inr (Or.inr (Or.inl (by - ext; simp [Zsqrtd.ext_iff])))⟩ +private abbrev edge_in_footprint := ApollonianSuperharmonic.BoundaryFootprintInclusion.boundaryEdge private theorem centroid_difference : (by @@ -97,21 +82,32 @@ private theorem border_touch : (by classical exact - ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), (BandPrototile - (q (0 : Fin (4 : ℕ))) T) → (∀ (P : PeriodicTileComplex ↥(TilingLattice C)), (∀ (u : - ↥(TilingLattice C)), P.tile u = TileTranslation T (↑u : GaussianInt)) → (∀ [ - Nonempty (AffineTriangularComplexChart P fun (mn : ℤ × ℤ) => TileTranslation T - ((↑mn.1 : GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + - (↑mn.2 : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ)))))], - (RegularTileFamily T (TilingLattice C) = Set.range P.tile) → ((∀ (x : GaussianInt), ∀ - (y : GaussianInt), TileCentroid (TileTranslation T y) - TileCentroid (TileTranslation - T x) = GaussianRealPoint (y - x)) → ((TileTranslation T 0 = T) → ((TileArea T = (q (0 - : Fin (4 : ℕ))).1.toNat) → ((∀ (x : GaussianInt), (TileTranslation T - x).cells.Nonempty) → (∀ (U : ProtoTile), (U ∈ RegularTileFamily T (TilingLattice C)) - → ((U ≠ T) → (TileTouching T U → TileBordering T U))))))))) ) := by + ∀ (C : BandCircle), + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (T : ProtoTile), + ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + (∀ (u : ↥(TilingLattice C)), + P.tile u = TileTranslation T (↑u : GaussianInt)) → + ∀ + [Nonempty + (AffineTriangularComplexChart P fun (mn : ℤ × ℤ) => + TileTranslation T + ((↑mn.1 : GaussianInt) * + BandVectors.1 (q (1 : Fin (4 : ℕ))) + (q (0 : Fin (4 : ℕ))) + + (↑mn.2 : GaussianInt) * + BandVectors.1 (q (2 : Fin (4 : ℕ))) + (q (0 : Fin (4 : ℕ)))))], + RegularTileFamily T (TilingLattice C) = Set.range P.tile → + TileTranslation T 0 = T → + TileArea T = (q (0 : Fin (4 : ℕ))).1.toNat → + (∀ (x : GaussianInt), (TileTranslation T x).cells.Nonempty) → + ∀ (U : ProtoTile), + U ∈ RegularTileFamily T (TilingLattice C) → + U ≠ T → TileTouching T U → TileBordering T U + ) := by classical - intro C q T hT P htile hchart family_eq centroid_difference translate_zero harea hnonempty U hU - hneq + intro C q T P htile hchart family_eq translate_zero harea hnonempty U hU hneq obtain ⟨a, ha, hua⟩ := RegularTileFamilyTranslationUnique T (TilingLattice C) U hU have hUform : U = TileTranslation T (a : GaussianInt) := ha @@ -638,8 +634,8 @@ theorem BandTileTopologyApplication (C : BandCircle) harea x have border_touch (U : ProtoTile) (hU : U ∈ RegularTileFamily T (TilingLattice C)) (hneq : U ≠ T) : TileTouching T U → TileBordering T U := - @TileTopologyGeometry.border_touch C q T hT P htile hchart family_eq - centroid_difference translate_zero harea hnonempty U hU hneq + @TileTopologyGeometry.border_touch C q T P htile hchart family_eq translate_zero harea + hnonempty U hU hneq have border_iff_index (a : TilingLattice C) (ha0 : a ≠ 0) : TileBordering T (P.tile a) ↔ ∃ j : Fin 3, (a : GaussianInt) = BandVectors.1 (q j.succ) (q 0) ∨ diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean b/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean index c60ff96718..0c32ad1fe3 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.BoundaryString public import LeanPool.ApollonianSuperharmonic.BoundaryJoinChamberCertificate @@ -288,20 +289,7 @@ private theorem translationDiff : ext <;> simp [GaussianRealPoint, Zsqrtd.re_sub, Zsqrtd.im_sub]; -private theorem hGRinj : - (by - classical - exact - Function.Injective GaussianRealPoint ) := by - classical - intro u v huv - ext - · have h := congrArg Prod.fst huv - dsimp [GaussianRealPoint] at h - exact_mod_cast h - · have h := congrArg Prod.snd huv - dsimp [GaussianRealPoint] at h - exact_mod_cast h +private abbrev hGRinj := ApollonianSuperharmonic.GaussianRealPointProperties.injective private theorem hphysMinus : (by diff --git a/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean b/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean index 7d698f999f..34b54007dc 100644 --- a/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean +++ b/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean @@ -126,17 +126,7 @@ private theorem hcheckP : simpa [P, LatticeVertexIncidentCell] using (LatticeTileGridStructure A hAlat).2.1 c -private theorem hcheckQ : - (by - classical - exact - ∀ (B : ProtoTile), (LatticeTile B) → (∀ (c : GaussianInt), - let Q : Fin 4 → Prop := fun j => LatticeVertexIncidentCell c j ∈ B.cells - ¬ ((Q 0 ∧ Q 2 ∧ ¬ Q 1 ∧ ¬ Q 3) ∨ (Q 1 ∧ Q 3 ∧ ¬ Q 0 ∧ ¬ Q 2))) ) := by - classical - intro B hBlat c Q - simpa [Q, LatticeVertexIncidentCell] using - (LatticeTileGridStructure B hBlat).2.1 c +private abbrev hcheckQ := ApollonianSuperharmonic.OppositeIncidentGeometry.hcheckP private theorem hnoR : (by diff --git a/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean index 593d40d577..752e51b987 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean @@ -410,18 +410,28 @@ private theorem localMem : classical exact ∀ (K : DiamondParameter), - let g := DiamondOdometer K - ∀ (X : Set GaussianInt), ∀ (z : GaussianInt), - let R := fun u t => u ∉ X ∧ t ∉ X ∧ FourNeighborAdjacent u t - let Y : Set GaussianInt := {y | Relation.ReflTransGen R z y} - (∀ y ∈ Y, y ∉ X) → (∀ (v : GaussianInt), ∀ (Yfin : Y.Finite), - let Z := Yfin.toFinset.image (fun y => y-v) - ∀ (p : GaussianInt), (p ∈ Z) → (((2 : ℤ) ≤ FourNeighborLaplacian (fun (z : GaussianInt) - => g z - if z ∈ Z then (1 : ℤ) else (0 : ℤ)) p) → ((∀ (t : GaussianInt), t ∈ Z ↔ t+v - ∈ Y) → ((p+v ∈ Y) → (∀ t, (t=p ∨ FourNeighborAdjacent p t) → (t ∈ Z ↔ t+v ∉ X)))))) ) + let g := DiamondOdometer K; + ∀ (X : Set GaussianInt), + ∀ (z : GaussianInt), + let R := fun u t => u ∉ X ∧ t ∉ X ∧ FourNeighborAdjacent u t; + let Y : Set GaussianInt := {y | Relation.ReflTransGen R z y}; + (∀ y ∈ Y, y ∉ X) → + ∀ (v : GaussianInt), + ∀ (Yfin : Y.Finite), + let Z := Yfin.toFinset.image fun y => y - v; + ∀ (p : GaussianInt), + (2 : ℤ) ≤ + FourNeighborLaplacian + (fun (z : GaussianInt) => + g z - if z ∈ Z then (1 : ℤ) else (0 : ℤ)) + p → + (∀ (t : GaussianInt), t ∈ Z ↔ t + v ∈ Y) → + p + v ∈ Y → + ∀ t, t = p ∨ FourNeighborAdjacent p t → (t ∈ Z ↔ t + v ∉ X) + ) := by classical - intro K g X z R Y Yout v Yfin Z p hp hobs memZ py t ht + intro K g X z R Y Yout v Yfin Z p hobs memZ py t ht constructor · intro htZ exact Yout (t+v) ((memZ t).mp htZ) @@ -556,7 +566,7 @@ theorem DiamondExceptionalMaximality (K : DiamondParameter) : obtain ⟨p, hp, hobs⟩ := FiniteAcyclicOrientationObstruction Df g o Z Zne Zsub have memZ (t : GaussianInt) := ExceptionalMaximalityProof.memZ X z v Yfin t have py : p+v ∈ Y := (memZ p).mp hp - have localMem := ExceptionalMaximalityProof.localMem K X z Yout v Yfin p hp hobs memZ py + have localMem := ExceptionalMaximalityProof.localMem K X z Yout v Yfin p hobs memZ py have value (t : GaussianInt) (ht : t=p ∨ FourNeighborAdjacent p t) := ExceptionalMaximalityProof.value X z v Yfin p localMem t ht diff --git a/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean index 850235644d..5217b4ffc8 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean @@ -45,15 +45,14 @@ private theorem index_two : (by classical exact - ∀ (K : DiamondParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (DiamondRecursiveQuadruple - K i.succ = Ci.1.1) → (∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (p0 : Real × Real), - ∀ (p0' : Real × Real), (TileCentroid T0' - TileCentroid T0 = GaussianRealPoint - (BandVectors.1 (DiamondRecursiveQuadruple K i.succ) (DiamondRecursiveQuadruple K (0 : - Fin (4 : ℕ))))) → ((p0' - p0 = GaussianRealPoint (BandVectors.2 - (DiamondRecursiveQuadruple K i.succ) (DiamondRecursiveQuadruple K (0 : Fin (4 : - ℕ))))) → ((1 < (DiamondRecursiveQuadruple K (i.succ)).1) → (i = 2)))) ) := by - classical - intro K Ci i hCi T0 T0' p0 p0' hcentroid hslope hcurv + ∀ (K : DiamondParameter), + ∀ (Ci : BandCircle), + ∀ (i : Fin 3), + DiamondRecursiveQuadruple K i.succ = Ci.1.1 → + 1 < (DiamondRecursiveQuadruple K i.succ).1 → i = 2 + ) := by + classical + intro K Ci i hCi hcurv fin_cases i · simp [DiamondRecursiveQuadruple] at hcurv · simp [DiamondRecursiveQuadruple] at hcurv @@ -117,17 +116,7 @@ private theorem hT0ne : rw [huCell] exact Finset.image_nonempty.mpr hrootNonempty -private theorem hT0'ne : - (by - classical - exact - ∀ (K : DiamondParameter), ∀ (T0' : ProtoTile), ∀ (u' : GaussianInt), (T0'.cells = - (TileTranslation (DiamondTile K.1) u').cells) → (((DiamondTile K.1).cells.Nonempty) → - (T0'.cells.Nonempty)) ) := by - classical - intro K T0' u' hu'Cell hrootNonempty - rw [hu'Cell] - exact Finset.image_nonempty.mpr hrootNonempty +private abbrev hT0'ne := ApollonianSuperharmonic.DiamondBoundaryStarGeometry.hT0ne private theorem hT0cent : (by @@ -1005,37 +994,61 @@ private theorem hcoverage : (by classical exact - ∀ (K : DiamondParameter), ∀ (h0 : PartialOdometer), ∀ (h0' : PartialOdometer), ∀ (x : - GaussianInt), (x ∈ h0.domain) → ((x ∈ h0'.domain) → ((∀ (y : GaussianInt), y = x ∨ y - = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ h0.domain ∨ y ∈ - h0'.domain) → (∀ (u : GaussianInt), ∀ (u' : GaussianInt), - let z := x - u - (z ∈ DiamondVertexDomains K false) → ((z + ⟨0, 2 * (K.1 : Int)⟩ ∈ DiamondVertexDomains K - false) → ((z.im = 0 ∧ Int.natAbs z.re ≤ 1) → ((z - 1 ∈ DiamondVertexDomains K false ∨ - z - 1 + ⟨0, 2 * (K.1 : Int)⟩ ∈ DiamondVertexDomains K false) → ((z + 1 ∈ - DiamondVertexDomains K false ∨ z + 1 + ⟨0, 2 * (K.1 : Int)⟩ ∈ DiamondVertexDomains K - false) → ((z = 0) → ((x = u) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gS : Fin - (3 : ℕ) → Bool → PartialOdometer), ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gS' : - Fin (3 : ℕ) → Bool → PartialOdometer), - let U := S 2 false - let V := S' 2 true - let g := gS 2 false - let k := gS' 2 true - let m := K.1 - 1 - (FootprintVertices U = FootprintVertices (TileTranslation (DiamondTile m) u)) → - ((FootprintVertices V = FootprintVertices (TileTranslation (TileTranslation - (DiamondTile m) ⟨0, 2⟩) u')) → ((u + 1 ∈ FootprintVertices (TileTranslation - (DiamondTile m) u)) → ((u + ⟨0, 1⟩ ∈ FootprintVertices (TileTranslation (DiamondTile - m) u)) → ((u - 1 ∈ FootprintVertices (TileTranslation (TileTranslation (DiamondTile - m) ⟨0, 2⟩) u')) → ((u - ⟨0, 1⟩ ∈ FootprintVertices (TileTranslation (TileTranslation - (DiamondTile m) ⟨0, 2⟩) u')) → (((g.domain : Set GaussianInt) = FootprintVertices U) - → (((k.domain : Set GaussianInt) = FootprintVertices V) → ((x ∈ g.domain) → ((x ∈ - k.domain) → (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y - ∈ g.domain ∨ y ∈ k.domain)))))))))))))))))))) ) := by - classical - intro K h0 h0' x hx0 hx0' hstar u u' z hzUpper hzLower overlap hwest heast hzzero hx_eq_u S gS - S' gS' U V g k m hUFoot hVFoot hUpperE hUpperN hLowerW hLowerS hgFoot hkFoot hxu hxk y hy + ∀ (K : DiamondParameter), + ∀ (h0 : PartialOdometer), + ∀ (h0' : PartialOdometer), + ∀ (x : GaussianInt), + (∀ (y : GaussianInt), + y = x ∨ + y = x + (1 : GaussianInt) ∨ + y = x - (1 : GaussianInt) ∨ + y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ + y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → + y ∈ h0.domain ∨ y ∈ h0'.domain) → + ∀ (u : GaussianInt), + ∀ (u' : GaussianInt), + let z := x - u; + z.im = 0 ∧ Int.natAbs z.re ≤ 1 → + z = 0 → + x = u → + ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), + ∀ (gS : Fin (3 : ℕ) → Bool → PartialOdometer), + ∀ (S' : Fin (3 : ℕ) → Bool → ProtoTile), + ∀ (gS' : Fin (3 : ℕ) → Bool → PartialOdometer), + let U := S 2 false; + let V := S' 2 true; + let g := gS 2 false; + let k := gS' 2 true; + let m := K.1 - 1; + FootprintVertices U = + FootprintVertices (TileTranslation (DiamondTile m) u) → + FootprintVertices V = + FootprintVertices + (TileTranslation (TileTranslation (DiamondTile m) ⟨0, 2⟩) + u') → + u + 1 ∈ + FootprintVertices (TileTranslation (DiamondTile m) u) → + u + ⟨0, 1⟩ ∈ + FootprintVertices (TileTranslation (DiamondTile m) u) → + u - 1 ∈ + FootprintVertices + (TileTranslation (TileTranslation (DiamondTile m) ⟨0, 2⟩) + u') → + u - ⟨0, 1⟩ ∈ + FootprintVertices + (TileTranslation (TileTranslation (DiamondTile m) ⟨0, 2⟩) + u') → + (g.domain : Set GaussianInt) = FootprintVertices U → + (k.domain : Set GaussianInt) = FootprintVertices V → + x ∈ g.domain → + ∀ y, + y = x ∨ + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ g.domain ∨ y ∈ k.domain + ) := by + classical + intro K h0 h0' x hstar u u' z overlap hzzero hx_eq_u S gS S' gS' U V g k m hUFoot hVFoot + hUpperE hUpperN hLowerW hLowerS hgFoot hkFoot hxu y hy rcases hy with rfl | rfl | rfl | rfl | rfl · exact Or.inl hxu · left @@ -1501,8 +1514,7 @@ theorem DiamondOpposingBoundaryStarLocalization rcases coords with ⟨_, _, _, _, hv30, _, _, hA30, _, _, hA21⟩ have hcurv : 1 < (DiamondRecursiveQuadruple K (i.succ)).1 := DiamondBoundaryStarGeometry.hcurv K Ci i hCi hlarge - have index_two := DiamondBoundaryStarGeometry.index_two K Ci i hCi T0 T0' p0 p0' - hcentroid hslope hcurv + have index_two := DiamondBoundaryStarGeometry.index_two K Ci i hCi hcurv subst i have hKpos : 0 < K.1 := K.2 have hk2 := DiamondBoundaryStarGeometry.hk2 K hcurv hKpos @@ -1593,13 +1605,13 @@ theorem DiamondOpposingBoundaryStarLocalization (DiamondBoundaryStarGeometry.hUpperC K u hbase0) hgFoot have hxk := DiamondBoundaryStarGeometry.hxk K x u u' hx_eq_u S' gS' hVFoot (DiamondBoundaryStarGeometry.hLowerC K u u' hmcast hbaseTop hu') hkFoot - have hcoverage := DiamondBoundaryStarGeometry.hcoverage K h0 h0' x hx0 hx0' hstar u u' hzUpper - hzLower overlap hwest heast hzzero hx_eq_u S gS S' gS' hUFoot hVFoot + have hcoverage := DiamondBoundaryStarGeometry.hcoverage K h0 h0' x hstar u u' overlap hzzero + hx_eq_u S gS S' gS' hUFoot hVFoot (DiamondBoundaryStarGeometry.hUpperE K u hbase0) (DiamondBoundaryStarGeometry.hUpperN K u hbase0) (DiamondBoundaryStarGeometry.hLowerW K u u' hmcast hbaseTop hu') (DiamondBoundaryStarGeometry.hLowerS K u u' hmcast hbaseTop hu') hgFoot hkFoot - hxu hxk + hxu have h21 := DiamondBoundaryStarGeometry.h21 K hqD hA21 let Kprev : DiamondParameter := ⟨m, hmpos⟩ let qprev := DiamondRecursiveQuadruple Kprev diff --git a/LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean b/LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean index 59349115b5..c645fc7c87 100644 --- a/LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean +++ b/LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean @@ -413,12 +413,7 @@ private theorem huOut (U : ProtoTile) (u : ApollonianSuperharmonic.LatticeCell) have := huMax (u + 1) hu1 simp at this -private theorem hvOut (V : ProtoTile) (v' : ApollonianSuperharmonic.LatticeCell) (hvMax : ∀ x' ∈ - V.cells, x'.re ≤ v'.re) : v' + 1 ∉ V.cells := by - classical - intro hv1 - have := hvMax (v' + 1) hv1 - simp at this +private abbrev hvOut := ApollonianSuperharmonic.CommonBoundaryAcyclicityConstruction.huOut private theorem huNotV (U : ProtoTile) (V : ProtoTile) (hdisjoint : Disjoint U.cells V.cells) (u : ApollonianSuperharmonic.LatticeCell) (hu : u ∈ U.cells) : u ∉ V.cells := by @@ -436,11 +431,7 @@ private theorem hUne (u : ApollonianSuperharmonic.LatticeCell) : u + 1 ≠ u + 1 apply_fun Zsqrtd.im at h simp at h -private theorem hVne (v' : ApollonianSuperharmonic.LatticeCell) : v' + 1 ≠ v' + 1 + ⟨0, 1⟩ := by - classical - intro h - apply_fun Zsqrtd.im at h - simp at h +private abbrev hVne := ApollonianSuperharmonic.CommonBoundaryAcyclicityConstruction.hUne private theorem hUright (U : ProtoTile) (u : ApollonianSuperharmonic.LatticeCell) (hu : u ∈ U.cells) (huMax : ∀ x' ∈ U.cells, x'.re ≤ u.re) : ({u + 1, u + 1 + ⟨0, 1⟩} : Finset @@ -456,19 +447,7 @@ private theorem hUright (U : ProtoTile) (u : ApollonianSuperharmonic.LatticeCell right simpa [Zsqrtd.ext_iff] using And.intro huOut hu -private theorem hVright (V : ProtoTile) (v' : ApollonianSuperharmonic.LatticeCell) (hv' : v' ∈ - V.cells) (hvMax : ∀ x' ∈ V.cells, x'.re ≤ v'.re) : ({v' + 1, v' + 1 + ⟨0, 1⟩} : Finset - GaussianInt) ∈ - BoundaryFootprintEdges V := by - classical - have vertical_boundary_iff (T : ProtoTile) (z : GaussianInt) : - ({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ - ((z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ - (z ∉ T.cells ∧ z - 1 ∈ T.cells)) := vertical_boundary_iff T z - have hvOut : v' + 1 ∉ V.cells := hvOut V v' hvMax - apply (vertical_boundary_iff V (v' + 1)).mpr - right - simpa [Zsqrtd.ext_iff] using And.intro hvOut hv' +private abbrev hVright := ApollonianSuperharmonic.CommonBoundaryAcyclicityConstruction.hUright private theorem hUrightV (U : ProtoTile) (V : ProtoTile) (hUcycle : SimpleGridCycle (BoundaryFootprintVertices U) diff --git a/LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean b/LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean index 878ff16b91..cfd6225168 100644 --- a/LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean +++ b/LeanPool/ApollonianSuperharmonic/ExceptionalModifiedABPath.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion public import LeanPool.ApollonianSuperharmonic.CentrallyReflectedAt @@ -34,22 +35,7 @@ private abbrev boundary_edge := BoundaryFootprintInclusion.boundaryEdge private abbrev edge_vertex := BoundaryFootprintInclusion.edgeVertex -private theorem incident : - ∀ (U : ProtoTile), ∀ (x : GaussianInt), Finset.Nonempty U.cells → x ∈ FootprintVertices U → ∃ - (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ U.cells := by - classical - intro U x hne hx - simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hx - rcases hx with ⟨c, hc, h | h | h | h⟩ - · exact ⟨0, by simpa [LatticeVertexIncidentCell] using h ▸ hc⟩ - · subst x - exact ⟨1, by simpa [LatticeVertexIncidentCell] using hc⟩ - · subst x - exact ⟨3, by simpa [LatticeVertexIncidentCell] using hc⟩ - · refine ⟨2, ?_⟩ - change x - 1 - ⟨0, 1⟩ ∈ U.cells - rw [h] - convert hc using 1; ext <;> simp +private abbrev incident := ApollonianSuperharmonic.LatticeFootprintIncidence.incidentCell private theorem nonempty_touching : ∀ (U : ProtoTile), ∀ (V : ProtoTile), Finset.Nonempty U.cells → Finset.Nonempty V.cells → diff --git a/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean b/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean index 1ffa3f0584..50bbbbfcb2 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean @@ -313,29 +313,25 @@ private theorem hLchain : exact hab.2.elim id (by simp [Finset.pair_comm]) private theorem hgridstep : - ∀ (X : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), (X = {x | ∃ e ∈ E, x ∈ e}) → ((∀ e - ∈ E, ∃ a b : GaussianInt, e = {a, b} ∧ FourNeighborAdjacent a b) → (((SimpleGraph.fromRel - fun a b : X => ({a.1, b.1} : Finset GaussianInt) ∈ E).Connected) → (((SimpleGraph.fromRel - fun a b : X => ({a.1, b.1} : Finset GaussianInt) ∈ E).IsAcyclic) → ((∀ v : X, Set.ncard - ((SimpleGraph.fromRel fun a b : X => ({a.1, b.1} : Finset GaussianInt) ∈ E).neighborSet - v) ≤ 2) → ( - let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => - ({a.1, b.1} : Finset GaussianInt) ∈ E - (X.Finite) → ((X.Nonempty) → ((G.Connected) → ((G.IsAcyclic) → ( - let lengths : Set Nat := {n | ∃ (u v : X) (p : G.Walk u v), - p.IsPath ∧ p.length = n} - (lengths.Finite) → (∀ (n : ℕ), (∀ ⦃y : ℕ⦄, (fun (x : ℕ) => x ∈ lengths) y → n ≤ y → y ≤ n) → - (∀ (u : (↑X : Type)), ∀ (v : (↑X : Type)), ∀ (p : G.Walk u v), (p.IsPath) → ((p.length = - n) → ((∀ (u' : X), ∀ (v' : X), ∀ (p' : G.Walk u' v'), (p'.IsPath) → (p'.length ≤ - p.length)) → ((0 < p.length) → ((∀ z : X, z ∈ p.support → ∀ w : X, G.Adj z w → w ∈ - p.support) → ((∀ (x : X), x ∈ p.support) → (({x : X | x ∈ p.support} = Set.univ) → ( - let L : List GaussianInt := p.support.map Subtype.val - (L.Nodup) → ((L.length = p.length + 1) → ((List.IsChain (fun a b : GaussianInt => ({a, b} : - Finset GaussianInt) ∈ E) L) → (∀ a b : GaussianInt, - ({a, b} : Finset GaussianInt) ∈ E → FourNeighborAdjacent a b))))))))))))))))))))) := by + ∀ (X : Set GaussianInt), + ∀ (E : Set (Finset GaussianInt)), + X = {x | ∃ e ∈ E, x ∈ e} → + (∀ e ∈ E, ∃ a b : GaussianInt, e = { a, b } ∧ FourNeighborAdjacent a b) → + let G : SimpleGraph X := + SimpleGraph.fromRel fun a b : X => ({ a.1, b.1 } : Finset GaussianInt) ∈ E; + ∀ (n : ℕ), + ∀ (u : (↑X : Type)), + ∀ (v : (↑X : Type)), + ∀ (p : G.Walk u v), + p.length = n → + 0 < p.length → + {x : X | x ∈ p.support} = Set.univ → + let L : List GaussianInt := p.support.map Subtype.val; + L.length = p.length + 1 → + ∀ a b : GaussianInt, + ({ a, b } : Finset GaussianInt) ∈ E → FourNeighborAdjacent a b := by classical - intro X E hendpoints hgrid hconnected hacyclic hdegree G hXfinite hXne hGconn hGacyc lengths - hlengths n hnl u v p hp hp_len hmax hlong hboundary hall hsupport L hLnodup hLlen hLchain + intro X E hendpoints hgrid G n u v p hp_len hlong hsupport L hLlen have hsymm : ∀ a b : GaussianInt, FourNeighborAdjacent a b → FourNeighborAdjacent b a := by intro a b h @@ -511,8 +507,8 @@ theorem FiniteConnectedAcyclicDegreeTwoGridPath ({a, b} : Finset GaussianInt) ∈ E) L := GridPathProof.hLchain X E u v p have hgridstep : ∀ a b : GaussianInt, ({a, b} : Finset GaussianInt) ∈ E → FourNeighborAdjacent a b := GridPathProof.hgridstep X E - hendpoints hgrid hconnected hacyclic hdegree hXfinite hXne hGconn hGacyc hlengths n hnl - u v p hp hp_len hmax hlong hboundary hall hsupport hLnodup hLlen hLchain + hendpoints hgrid n + u v p hp_len hlong hsupport hLlen have hstep : ∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, L = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b := GridPathProof.hstep X E u v p hLchain hgridstep diff --git a/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean b/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean index 22467fc558..f541bd47a3 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean @@ -127,43 +127,7 @@ private theorem hcountle : omega _ ≤ 4 := by simp -private theorem hcornerCount : - ∀ (T : ProtoTile), - let I : GaussianInt := ⟨0, 1⟩ - let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => - ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) - ∀ (z : GaussianInt), cornerBag.count z = - (if z ∈ T.cells then 1 else 0) + - (if z - 1 ∈ T.cells then 1 else 0) + - (if z - I ∈ T.cells then 1 else 0) + - (if z - 1 - I ∈ T.cells then 1 else 0) := by - classical - intro T I cornerBag z - dsimp only [cornerBag] - rw [Multiset.count_bind] - rw [← Finset.sum_eq_multiset_sum] - simp only [Multiset.coe_count, List.count_cons, beq_iff_eq, - List.count_nil] - have h11 : ∀ c : GaussianInt, (c + 1 + I = z) ↔ (c = z - 1 - I) := by - intro c - constructor <;> intro h - · rw [← h]; ring - · rw [h]; ring - have hI : ∀ c : GaussianInt, (c + I = z) ↔ (c = z - I) := by - intro c - constructor <;> intro h - · rw [← h]; ring - · rw [h]; ring - have h1 : ∀ c : GaussianInt, (c + 1 = z) ↔ (c = z - 1) := by - intro c - constructor <;> intro h - · rw [← h]; ring - · rw [h]; ring - simp_rw [h11, hI, h1] - simp only [Finset.sum_add_distrib, zero_add] - rw [Finset.sum_ite_eq', Finset.sum_ite_eq', Finset.sum_ite_eq', - Finset.sum_ite_eq'] - omega +private abbrev hcornerCount := ApollonianSuperharmonic.TileCornerMultiplicity.cornerCount private theorem hweighted : ∀ (T : ProtoTile), diff --git a/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean index 61bc622207..63f9e2fa6a 100644 --- a/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean +++ b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean @@ -506,25 +506,24 @@ private theorem lowFormula : let A := P.p₁; let B := P.p₂; let cdiv (n d : Int) := -(-n / d); - FordFareyParameter → - (∀ (t : Int), 0 ≤ t → t ≤ a → g ⟨a, t⟩ = A * t ∧ g ⟨t, a⟩ = A * t) → + (∀ (t : Int), 0 ≤ t → t ≤ a → g ⟨a, t⟩ = A * t ∧ g ⟨t, a⟩ = A * t) → + (∀ (t : Int), + 0 ≤ t → + t ≤ a → + g ⟨a - 1, t⟩ = A * t - A * t / a ∧ g ⟨t, a - 1⟩ = A * t - A * t / a) → (∀ (t : Int), 0 ≤ t → - t ≤ a → - g ⟨a - 1, t⟩ = A * t - A * t / a ∧ g ⟨t, a - 1⟩ = A * t - A * t / a) → - (∀ (t : Int), - 0 ≤ t → + t ≤ b → + g ⟨a + 1, t⟩ = cdiv (B * t) b + A * t ∧ + g ⟨t, a + 1⟩ = cdiv (B * t) b + A * t) → + ∀ (t : ℤ), + (0 : ℤ) < t → + t < a → t ≤ b → - g ⟨a + 1, t⟩ = cdiv (B * t) b + A * t ∧ - g ⟨t, a + 1⟩ = cdiv (B * t) b + A * t) → - ∀ (t : ℤ), - (0 : ℤ) < t → - t < a → - t ≤ b → - FourNeighborLaplacian g ⟨a, t⟩ = cdiv (B * t) b - A * t / a ∧ - FourNeighborLaplacian g ⟨t, a⟩ = cdiv (B * t) b - A * t / a := by + FourNeighborLaplacian g ⟨a, t⟩ = cdiv (B * t) b - A * t / a ∧ + FourNeighborLaplacian g ⟨t, a⟩ = cdiv (B * t) b - A * t / a := by classical - intro P g lapCoord a b A B cdiv P₁ edge0 near0 outward t ht hta htb + intro P g lapCoord a b A B cdiv edge0 near0 outward t ht hta htb have hc := edge0 t (by omega) (by omega) have hm := edge0 (t - 1) (by omega) (by omega) have hp' := edge0 (t + 1) (by omega) (by omega) @@ -1226,7 +1225,7 @@ private theorem interiorLaplacian : have lowFormula (t : Int) (ht : 0 < t) (hta : t < a) (htb : t ≤ b) : FourNeighborLaplacian g ⟨a, t⟩ = cdiv (B * t) b - A * t / a ∧ FourNeighborLaplacian g ⟨t, a⟩ = cdiv (B * t) b - A * t / a := - FordLaplacianProof.lowFormula P lapCoord P₁ edge0 near0 outward t ht hta htb + FordLaplacianProof.lowFormula P lapCoord edge0 near0 outward t ht hta htb have highFormula (t : Int) (ht : 0 < t) (hta : t ≤ a) (htb : t < b) : FourNeighborLaplacian g ⟨(P.q : Int) - t, b⟩ = cdiv (B * t) b - A * t / a ∧ FourNeighborLaplacian g ⟨b, (P.q : Int) - t⟩ = cdiv (B * t) b - A * t / a := diff --git a/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean index a1f3fb3678..60d1c8a5af 100644 --- a/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean @@ -75,16 +75,16 @@ private theorem hbar : (by classical exact - ∀ (w : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple w) → (∀ (r2 : Fin (3 : ℕ)), - ∀ (g2 : BandPackingSymmetry), ∀ (P2 : FordFareyParameter), ((w (r2 + (2 : Fin (3 : - ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g2 ![w (0 : Fin (4 : - ℕ)), w r2.succ, w (r2 + (1 : Fin (3 : ℕ))).succ, w (r2 + (2 : Fin (3 : ℕ))).succ] = - FordRecursiveQuadruple P2) → ( - let barq : Fin 4 → CircleCoordinates := - ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] - ProperBandQuadruple barq))) ) := by + ∀ (w : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple w → + ∀ (r2 : Fin (3 : ℕ)), + (w (r2 + (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ) → + let barq : Fin 4 → CircleCoordinates := + ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] + ProperBandQuadruple barq + ) := by classical - intro w hwproper r2 g2 P2 hz2 heq2 barq + intro w hwproper r2 hz2 barq fin_cases r2 · exact ⟨by convert hwproper.1 using 1; funext j; fin_cases j <;> rfl, by @@ -489,69 +489,45 @@ private theorem hcoc : (by classical exact - ∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), ∀ (w : Fin (4 : ℕ) - → CircleCoordinates), ∀ (iw : Fin (3 : ℕ)), ∀ (ew : Bool), ∀ (r2 : Fin (3 : ℕ)), ∀ - (g2 : BandPackingSymmetry), ∀ (P2 : FordFareyParameter), - let barq : Fin 4 → CircleCoordinates := - ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] - ∀ (t : Fin (3 : ℕ)), (t + r2 = iw) → ((barq t.succ = w iw.succ) → ((TileCentroid T' - - TileCentroid T = (if ew = true then (1 : ℝ) else -1) • GaussianRealPoint - (BandVectors.1 (barq t.succ) (barq 0))) → ((p'.1 - p.1 = (if ew = true then (1 : ℝ) - else -1) * (BandVectors.2 (barq t.succ) (barq 0)).re) → ((p'.2 - p.2 = (if ew = true - then (1 : ℝ) else -1) * (BandVectors.2 (barq t.succ) (barq 0)).im) → (∀ (negative : - Bool), ∀ (r : ℝ × ℝ), ∀ (r' : ℝ × ℝ), (TileCentroid (BandPackingSymmetryTileAction g2 - T') - TileCentroid (BandPackingSymmetryTileAction g2 T) = (if (ew ^^ negative) = true - then (1 : ℝ) else (-1 : ℝ)) • GaussianRealPoint (BandVectors.1 - (BandPackingSymmetryQuadrupleAction g2 barq ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g2 = true then -j else j) t).succ) - (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : ℕ))))) → ((r'.1 - r.1 = (if - (ew ^^ negative) = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 - (BandPackingSymmetryQuadrupleAction g2 barq ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g2 = true then -j else j) t).succ) - (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : ℕ)))).re : ℝ)) → ((r'.2 - - r.2 = (if (ew ^^ negative) = true then (1 : ℝ) else (-1 : ℝ)) * (↑(BandVectors.2 - (BandPackingSymmetryQuadrupleAction g2 barq ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g2 = true then -j else j) t).succ) - (BandPackingSymmetryQuadrupleAction g2 barq (0 : Fin (4 : ℕ)))).im : ℝ)) → (∀ (u : - GaussianInt), ∀ (a : GaussianInt), ∀ (u' : GaussianInt), ∀ (a' : GaussianInt), (u' - - u = (if ew ^^ negative then 1 else -1) • BandVectors.1 - (BandPackingSymmetryQuadrupleAction g2 barq t.succ) - (BandPackingSymmetryQuadrupleAction g2 barq 0)) → ((u' - u = (if (ew ^^ negative) = - true then 1 else -1) • BandVectors.1 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 0)) → ((BandVectors.1 (FordRecursiveQuadruple P2 (1 : Fin - (4 : ℕ))) (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) = (⟨(↑P2.q : ℤ), (↑P2.q₁ : - ℤ)⟩ : GaussianInt)) → ((BandVectors.1 (FordRecursiveQuadruple P2 (2 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) = (⟨-(↑P2.q : ℤ), (↑P2.q₂ : ℤ)⟩ : - GaussianInt)) → ((BandVectors.1 (FordRecursiveQuadruple P2 (3 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) = (⟨(0 : ℤ), -(↑P2.q : ℤ)⟩ : - GaussianInt)) → ((BandVectors.2 (FordRecursiveQuadruple P2 (1 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) = (⟨P2.p₁, P2.p⟩ : GaussianInt)) → - ((BandVectors.2 (FordRecursiveQuadruple P2 (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple - P2 (0 : Fin (4 : ℕ))) = (⟨P2.p₂, -P2.p⟩ : GaussianInt)) → ((BandVectors.2 - (FordRecursiveQuadruple P2 (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple P2 (0 : Fin (4 - : ℕ))) = (⟨-P2.p, (0 : ℤ)⟩ : GaussianInt)) → ((r'.1 - r.1 = if ew = negative then - -((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : - Fin (4 : ℕ)))).re : ℝ) + ((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) * (0 : ℝ) - (0 : ℝ))) else - (↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : - Fin (4 : ℕ)))).re : ℝ) + ((↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) * (0 : ℝ) - (0 : ℝ))) → ((r'.2 - - r.2 = if ew = negative then -(↑(BandVectors.2 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im : ℝ) else (↑(BandVectors.2 - (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))).im - : ℝ)) → ((a'.re - a.re = (if (ew ^^ negative) = true then 1 else -1) * (BandVectors.2 - (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 0)).re) → ((a'.im - - a.im = (if (ew ^^ negative) = true then 1 else -1) * (BandVectors.2 - (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 0)).im) → (∀ y : - GaussianInt, FordOdometer P2 (y + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 0)) - FordOdometer P2 y = (BandVectors.2 - (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 0)).re * y.re + - (BandVectors.2 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 0)).im * - y.im + (if t = 0 then P2.q₁ * P2.p else if t = 1 then -(P2.q * P2.p₂) else - 0))))))))))))))))))))) ) := by + (Fin (4 : ℕ) → CircleCoordinates) → + Fin (3 : ℕ) → + ∀ (P2 : FordFareyParameter), + ∀ (t : Fin (3 : ℕ)), + BandVectors.1 (FordRecursiveQuadruple P2 (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) = + (⟨(↑P2.q : ℤ), (↑P2.q₁ : ℤ)⟩ : GaussianInt) → + BandVectors.1 (FordRecursiveQuadruple P2 (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) = + (⟨-(↑P2.q : ℤ), (↑P2.q₂ : ℤ)⟩ : GaussianInt) → + BandVectors.1 (FordRecursiveQuadruple P2 (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) = + (⟨(0 : ℤ), -(↑P2.q : ℤ)⟩ : GaussianInt) → + BandVectors.2 (FordRecursiveQuadruple P2 (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) = + (⟨P2.p₁, P2.p⟩ : GaussianInt) → + BandVectors.2 (FordRecursiveQuadruple P2 (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) = + (⟨P2.p₂, -P2.p⟩ : GaussianInt) → + BandVectors.2 (FordRecursiveQuadruple P2 (3 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ))) = + (⟨-P2.p, (0 : ℤ)⟩ : GaussianInt) → + ∀ y : GaussianInt, + FordOdometer P2 + (y + + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0)) - + FordOdometer P2 y = + (BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0)).re * + y.re + + (BandVectors.2 (FordRecursiveQuadruple P2 t.succ) + (FordRecursiveQuadruple P2 0)).im * + y.im + + if t = 0 then P2.q₁ * P2.p + else if t = 1 then -(P2.q * P2.p₂) else 0 + ) := by classical - intro T T' p p' w iw ew r2 g2 P2 barq t ht hpoint hcentbar hslopebar hslopebar' negative r r' - hcent' hsre' hsim' u a u' a' hshift hvec hv2 hv3 ha1 ha2 ha3 ha4 hsreFord hsimFord haRe haIm y + intro w r2 P2 t hv2 hv3 ha1 ha2 ha3 ha4 y fin_cases t · change FordOdometer P2 (y + BandVectors.1 (FordRecursiveQuadruple P2 1) (FordRecursiveQuadruple P2 0)) - FordOdometer P2 y = _ @@ -617,20 +593,7 @@ private theorem hvxAt524 : x - u = x - u' + (u' - u) := by ring _ = _ := by rw [hvec]; ring -private theorem hvx0At530 : - (by - classical - exact - ∀ (P2 : FordFareyParameter), ∀ (t : Fin (3 : ℕ)), ∀ (u : GaussianInt), ∀ (u' : - GaussianInt), (u' - u = (1 : ℤ) • BandVectors.1 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))) → (∀ (x0 : GaussianInt), x0 - u = (x0 - - u') + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 - 0)) ) := by - classical - intro P2 t u u' hvec x0 - calc - x0 - u = x0 - u' + (u' - u) := by ring - _ = _ := by rw [hvec]; ring +private abbrev hvx0At530 := ApollonianSuperharmonic.FordBoundaryCompatibilityGeometry.hvxAt524 private theorem hvxAt546 : (by @@ -647,20 +610,7 @@ private theorem hvxAt546 : x - u' = x - u - (u' - u) := by ring _ = _ := by rw [hvec]; ring -private theorem hvx0At552 : - (by - classical - exact - ∀ (P2 : FordFareyParameter), ∀ (t : Fin (3 : ℕ)), ∀ (u : GaussianInt), ∀ (u' : - GaussianInt), (u' - u = (-1 : ℤ) • BandVectors.1 (FordRecursiveQuadruple P2 t.succ) - (FordRecursiveQuadruple P2 (0 : Fin (4 : ℕ)))) → (∀ (x0 : GaussianInt), x0 - u' = (x0 - - u) + BandVectors.1 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 - 0)) ) := by - classical - intro P2 t u u' hvec x0 - calc - x0 - u' = x0 - u - (u' - u) := by ring - _ = _ := by rw [hvec]; ring +private abbrev hvx0At552 := ApollonianSuperharmonic.FordBoundaryCompatibilityGeometry.hvxAt546 end FordBoundaryCompatibilityGeometry @@ -692,8 +642,7 @@ theorem FordLeftBoundaryCompatibility FordRegimeConverse w hwproper wline let barq : Fin 4 → CircleCoordinates := ![w 0, w r2.succ, w (r2 + 1).succ, w (r2 + 2).succ] - have hbar := FordBoundaryCompatibilityGeometry.hbar w hwproper r2 - g2 P2 hz2 heq2 + have hbar := FordBoundaryCompatibilityGeometry.hbar w hwproper r2 hz2 have hbar0 : barq 0 = q 0 := by simp [barq, hwchild, hC] have hidx : ∃ t : Fin 3, (t + r2 : Fin 3) = iw := by @@ -799,10 +748,8 @@ theorem FordLeftBoundaryCompatibility (BandVectors.2 (FordRecursiveQuadruple P2 t.succ) (FordRecursiveQuadruple P2 0)).im * y.im + (if t = 0 then P2.q₁ * P2.p else - if t = 1 then -(P2.q * P2.p₂) else 0) := FordBoundaryCompatibilityGeometry.hcoc T - T' p p' w iw ew r2 g2 P2 t ht hpoint hcentbar hslopebar hslopebar' negative r - r' hcent' hsre' hsim' u a u' a' hshift hvec hv2 hv3 ha1 ha2 ha3 ha4 hsreFord - hsimFord haRe haIm + if t = 1 then -(P2.q * P2.p₂) else 0) := FordBoundaryCompatibilityGeometry.hcoc w + r2 P2 t hv2 hv3 ha1 ha2 ha3 ha4 by_cases hdj : Disjoint ((BandPackingSymmetryPartialOdometerAction g2 h).domain : Set GaussianInt) ((BandPackingSymmetryPartialOdometerAction g2 h').domain : Set GaussianInt) diff --git a/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean index cd1ac5209a..ad22ff9445 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean @@ -308,27 +308,43 @@ private theorem diagonalCover : (by classical exact - ∀ (P : FordFareyParameter), ∀ (i : Fin 3), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (h0 - : PartialOdometer), ∀ (h0' : PartialOdometer), ∀ (x : GaussianInt), (x ∈ h0.domain) → - ((x ∈ h0'.domain) → ((∀ (y : GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt) → y ∈ h0.domain ∨ y ∈ h0'.domain) → (∀ (u : GaussianInt), (x - ∈ FootprintVertices T0 ∩ FootprintVertices T0') → (((x - u).re = if i = (0 : Fin (3 : - ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) → (((if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else - (↑P.q₂ : ℤ)) ≤ (x - u).im) → (((x - u).im ≤ (↑P.q : ℤ)) → (∀ (U : ProtoTile), ∀ (V : - ProtoTile), (x ∈ U.cells ∧ x - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ∈ V.cells ∨ x - (1 : GaussianInt) ∈ U.cells ∧ x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ∈ V.cells ∨ x - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ U.cells ∧ x - ∈ V.cells ∨ x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ U.cells ∧ x - (1 : GaussianInt) - ∈ V.cells) → ((∀ (T : ProtoTile), ∀ (z : GaussianInt), (z ∈ T.cells) → (∀ (y : - GaussianInt), (y = z ∨ y = z + 1 ∨ y = z + ⟨0, 1⟩ ∨ y = z + 1 + ⟨0, 1⟩) → (y ∈ - FootprintVertices T))) → (∀ (A : ProtoTile), ∀ (B : ProtoTile), ((x ∈ A.cells ∧ x - 1 - - ⟨0, 1⟩ ∈ B.cells) ∨ (x - 1 ∈ A.cells ∧ x - ⟨0, 1⟩ ∈ B.cells)) → x ∈ - FootprintVertices A ∧ x ∈ FootprintVertices B ∧ ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ - y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ FootprintVertices A ∨ y ∈ FootprintVertices - B))))))))) ) := by + ∀ (P : FordFareyParameter), + ∀ (i : Fin 3), + ∀ (h0 : PartialOdometer), + ∀ (h0' : PartialOdometer), + ∀ (x : GaussianInt), + (∀ (y : GaussianInt), + y = x ∨ + y = x + (1 : GaussianInt) ∨ + y = x - (1 : GaussianInt) ∨ + y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ + y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → + y ∈ h0.domain ∨ y ∈ h0'.domain) → + ∀ (u : GaussianInt), + ((x - u).re = + if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) → + (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ + (x - u).im → + (x - u).im ≤ (↑P.q : ℤ) → + (∀ (T : ProtoTile), + ∀ (z : GaussianInt), + z ∈ T.cells → + ∀ (y : GaussianInt), + y = z ∨ y = z + 1 ∨ y = z + ⟨0, 1⟩ ∨ y = z + 1 + ⟨0, 1⟩ → + y ∈ FootprintVertices T) → + ∀ (A : ProtoTile), + ∀ (B : ProtoTile), + x ∈ A.cells ∧ x - 1 - ⟨0, 1⟩ ∈ B.cells ∨ + x - 1 ∈ A.cells ∧ x - ⟨0, 1⟩ ∈ B.cells → + x ∈ FootprintVertices A ∧ + x ∈ FootprintVertices B ∧ + ∀ y, + y = x ∨ + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices A ∨ y ∈ FootprintVertices B + ) := by classical - intro P i T0 T0' h0 h0' x hx0 hx0' hstar u hxfoot hxr hxl hxu U V hdiag corner A B + intro P i h0 h0' x hstar u hxr hxl hxu corner A B rintro (⟨hA, hB⟩ | ⟨hA, hB⟩) · refine ⟨corner A x hA x (Or.inl rfl), corner B _ hB x (Or.inr (Or.inr (Or.inr (by abel)))), ?_⟩ @@ -480,8 +496,8 @@ theorem FordOpposingBoundaryStarLocalization have hfootcover : x ∈ FootprintVertices U ∧ x ∈ FootprintVertices V ∧ ∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V := - FordStarGeometry.hfootcover x U V hdiag (FordStarGeometry.diagonalCover P i T0 T0' h0 - h0' x hx0 hx0' hstar u hxfoot hxr hxl hxu U V hdiag (FordStarGeometry.corner)) + FordStarGeometry.hfootcover x U V hdiag (FordStarGeometry.diagonalCover P i h0 + h0' x hstar u hxr hxl hxu (FordStarGeometry.corner)) refine ⟨U, V, g, k, hAg, hAk, hleft, ?_, ?_, ?_⟩ · change x ∈ (g.domain : Set GaussianInt) rw [hdomU] diff --git a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean index c0e6c141c0..e1c2f3c875 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordTileCellMembership public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import LeanPool.ApollonianSuperharmonic.FordParentVectors @@ -279,30 +280,6 @@ private theorem vertical : private abbrev reverse_path := @SimpleGridPathBetween.reverse -private theorem fordcell : - (by - classical - exact - ∀ (n : Nat), - ∀ (z : GaussianInt), - z ∈ (FordTile n).cells ↔ 0 ≤ z.re ∧ z.re < n ∧ 0 ≤ z.im ∧ z.im < n - ) := by - classical - intro n z - change z ∈ ((Finset.range n).product (Finset.range n)).image - (fun a => (⟨(a.1:Int),(a.2:Int)⟩ : GaussianInt)) ↔ _ - rw [Finset.mem_image] - constructor - · rintro ⟨⟨j,k⟩,hjk,rfl⟩ - have hjk := Finset.mem_product.mp hjk - simp only [Finset.mem_range] at hjk - dsimp; omega - · rintro ⟨h0,h1,h2,h3⟩ - exact ⟨(z.re.toNat,z.im.toNat), - Finset.mem_product.mpr ⟨Finset.mem_range.mpr (by omega), - Finset.mem_range.mpr (by omega)⟩, - by ext <;> dsimp <;> omega⟩ - private theorem sqcell : (by classical @@ -1193,26 +1170,18 @@ private theorem indices : (by classical exact - ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : ProtoTile), - ∀ (W : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (FordRecursiveQuadruple P - i.succ) W) → ((BandPrototile (FordRecursiveQuadruple P (if Even (↑s : ℕ) then i - (1 - : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < - (FordRecursiveQuadruple P i.succ).1) → (((0 : ℤ) < (FordRecursiveQuadruple P (if Even - (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → - ((TileCentroid W - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ)))) → ((TileCentroid Z - - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ^ (↑s : ℕ) * if Even (↑s : ℕ) then BandVectors.1 (FordRecursiveQuadruple P (0 : Fin - (4 : ℕ))) (FordRecursiveQuadruple P (i - (1 : Fin (3 : ℕ))).succ) - BandVectors.1 - (FordRecursiveQuadruple P (i - (1 : Fin (3 : ℕ))).succ) (FordRecursiveQuadruple P (0 - : Fin (4 : ℕ))) else BandVectors.1 (FordRecursiveQuadruple P (i + (1 : Fin (3 : - ℕ))).succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - BandVectors.1 - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (i + (1 : Fin - (3 : ℕ))).succ))) → ((Even s.val ∧ i = 1) ∨ (¬Even s.val ∧ i = 0))))))) ) := by + ∀ (P : FordFareyParameter), + ∀ (i : Fin (3 : ℕ)), + ∀ (s : Fin (4 : ℕ)), + (0 : ℤ) < (FordRecursiveQuadruple P i.succ).1 → + (0 : ℤ) < + (FordRecursiveQuadruple P + (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) + else i + (1 : Fin (3 : ℕ))).succ).1 → + Even s.val ∧ i = 1 ∨ ¬Even s.val ∧ i = 0 + ) := by classical - intro P i s U W Z hW hZ hWpos hZpos hcw hcz + intro P i s hWpos hZpos by_cases hE : Even s.val · left refine ⟨hE,?_⟩ @@ -1553,7 +1522,7 @@ theorem FordOrientedChildParentEndpoints have reverse_path {V : Set GaussianInt} {E : Set (Finset GaussianInt)} {x y : GaussianInt} (hp : SimpleGridPathBetween V E x y) := FordEndpointProof.reverse_path (V := V) (E := E) (x := x) (y := y) hp - have fordcell := FordEndpointProof.fordcell + have fordcell := FordTileCellMembership let sq := fun n : Nat => fun a b : Int => TileTranslation (FordTile n) ⟨a,b⟩ have sqcell (n : Nat) (a b : Int) (z : GaussianInt) : @@ -1632,7 +1601,7 @@ theorem FordOrientedChildParentEndpoints obtain ⟨a,b,hUc⟩ : ∃ a b : Int, U.cells = (sq P.q a b).cells := ⟨u.re, u.im, hu⟩ have hcu := (sameobs U P.q a b P.q_pos hUc).2.2 - have indices := FordEndpointProof.indices P i s U W Z hW hZ hWpos hZpos hcw hcz + have indices := FordEndpointProof.indices P i s hWpos hZpos rcases indices with ⟨heven,rfl⟩ | ⟨hodd,rfl⟩ · obtain ⟨wa,wb,hWc⟩ := norm2 W hW obtain ⟨za,zb,hZc⟩ := norm1 Z (by simpa [heven] using hZ) diff --git a/LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean b/LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean index 845da8e3bc..2ac3e790cb 100644 --- a/LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean @@ -233,23 +233,32 @@ private theorem hiAt337 : (by classical exact - ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T : ProtoTile), - ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), ((0 : ℤ) < - (FordRecursiveQuadruple P i.succ).1) → ((TileOdometer (FordRecursiveQuadruple P - i.succ) U k) → ((TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint - ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 - (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + - BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P - i.succ)))) → ((p'.1 - p.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.2 (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ)))).1) → ((p'.2 - p.2 = ((1 / 2 - : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * - (BandVectors.2 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin - (4 : ℕ))) + BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P i.succ)))).2) → (i.val < 2))))) ) := by + ∀ (P : FordFareyParameter), + ∀ (i : Fin (3 : ℕ)), + ∀ (s : Fin (4 : ℕ)), + ∀ (p : ℝ × ℝ), + ∀ (p' : ℝ × ℝ), + (0 : ℤ) < (FordRecursiveQuadruple P i.succ).1 → + p'.1 - p.1 = + ((1 / 2 : ℝ) • + GaussianRealPoint + ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * + (BandVectors.2 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + + BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ)))).1 → + p'.2 - p.2 = + ((1 / 2 : ℝ) • + GaussianRealPoint + ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * + (BandVectors.2 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + + BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ)))).2 → + i.val < 2 + ) := by classical - intro P i s T U k p p' hpos hU hc ha hb + intro P i s p p' hpos ha hb by_contra hn have hi : i = 2 := Fin.ext (by omega) subst i @@ -370,64 +379,90 @@ private theorem sourceAt395 : (by classical exact - ∀ (P : FordFareyParameter), ((1 : ℕ) < P.q) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), - ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : - PartialOdometer), ∀ (p : ℝ × ℝ), ∀ (p' : ℝ × ℝ), ∀ (x : GaussianInt), (TileCentroid U - - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ)))) → ((p'.1 - p.1 = ((1 / 2 : - ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * - (BandVectors.2 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin - (4 : ℕ))) + BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P i.succ)))).1) → ((p'.2 - p.2 = ((1 / 2 : ℝ) • - GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 - (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + - BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P - i.succ)))).2) → ((x ∈ h.domain) → ((x ∈ k.domain) → (∀ (j : Fin (2 : ℕ)), ∀ (A : - FordFareyParameter), (A.p = ![P.p₁, P.p₂] j) → ((A.q = ![P.q₁, P.q₂] j) → (∀ (u : - GaussianInt), ∀ (B : ℤ), ∀ (f : IntegerLatticeFunction), (∀ (x : GaussianInt), x ∈ - h.domain ↔ x - u ∈ FordVertexDomain P.q) → ((∀ y ∈ FordVertexDomain P.q, f y = - FordOdometer P y) → (((1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) = (((↑(![P.q₁, P.q₂] j) : ℝ) - - (↑P.q : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : ℤ)).displacement.re : ℝ), - ((↑(![P.q₁, P.q₂] j) : ℝ) - (↑P.q : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : - ℤ)).displacement.im : ℝ)) ∧ (1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.2 (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) = (((↑(![P.p₁, P.p₂] j) : ℝ) - - (↑P.p : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : ℤ)).linear.re : ℝ), - ((↑(![P.p₁, P.p₂] j) : ℝ) - (↑P.p : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : - ℤ)).linear.im : ℝ)) ∧ ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : - ℕ) then BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P i.succ) else BandVectors.1 (FordRecursiveQuadruple P - i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) = (P5332T1ParentRows P j s (0 - : ℤ)).companion) → ((∀ (x : GaussianInt), x ∈ k.domain ↔ x - u - (P5332T1ParentRows - P j s (0 : ℤ)).displacement ∈ FordVertexDomain A.q) → ((∀ (x : LatticeCell), x ∈ - U.cells ↔ x - u - (P5332T1ParentRows P j s (0 : ℤ)).displacement ∈ (FordTile - A.q).cells) → ((TileCentroid U - TileCentroid T = (((↑A.q : ℝ) - (↑P.q : ℝ)) / (2 : - ℝ) + (↑(P5332T1ParentRows P j s (0 : ℤ)).displacement.re : ℝ), ((↑A.q : ℝ) - (↑P.q - : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : ℤ)).displacement.im : ℝ))) → - ((p'.1 - p.1 = ((↑A.p : ℝ) - (↑P.p : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 - : ℤ)).linear.re : ℝ)) → ((p'.2 - p.2 = ((↑A.p : ℝ) - (↑P.p : ℝ)) / (2 : ℝ) + - (↑(P5332T1ParentRows P j s (0 : ℤ)).linear.im : ℝ)) → ((∀ (y : GaussianInt), y - - (P5332T1ParentRows P j s (0 : ℤ)).displacement ∈ FordVertexDomain A.q → f y = - FordOdometer A (y - (P5332T1ParentRows P j s (0 : ℤ)).displacement) + - (P5332T1ParentRows P j s (0 : ℤ)).linear.re * y.re + (P5332T1ParentRows P j s (0 - : ℤ)).linear.im * y.im + B) → ((∀ (l : Fin (5 : ℕ)), x - u + ![(0 : ℤ√(-1 : ℤ)), (1 : - ℤ√(-1 : ℤ)), (-1 : ℤ√(-1 : ℤ)), (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), -(⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt)] l ∈ FordVertexDomain P.q ∨ x - u + ![(0 : ℤ√(-1 : ℤ)), (1 : ℤ√(-1 - : ℤ)), (-1 : ℤ√(-1 : ℤ)), (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), -(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt)] l - (P5332T1ParentRows P j s (0 : ℤ)).displacement ∈ FordVertexDomain - A.q) → (∃ t : Int, 0 ≤ t ∧ t < ((![P.q₁,P.q₂] j : Nat) : Int) ∧ (∀ l : Fin 5, f (x-u - + (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] l)) = (P5332T1ParentRows P j s t).values - l) ∧ (x-u - (P5332T1ParentRows P j s 0).companion ∈ FordVertexDomain P.q ↔ t = 0 ∧ - Even (s.val+j.val)))))))))))))))))))) ) := by + ∀ (P : FordFareyParameter), + (1 : ℕ) < P.q → + ∀ (i : Fin (3 : ℕ)), + ∀ (s : Fin (4 : ℕ)), + ∀ (h : PartialOdometer), + ∀ (k : PartialOdometer), + ∀ (p : ℝ × ℝ), + ∀ (p' : ℝ × ℝ), + ∀ (x : GaussianInt), + p'.1 - p.1 = + ((1 / 2 : ℝ) • + GaussianRealPoint + ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * + (BandVectors.2 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + + BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ)))).1 → + p'.2 - p.2 = + ((1 / 2 : ℝ) • + GaussianRealPoint + ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ^ (↑s : ℕ) * + (BandVectors.2 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + + BandVectors.2 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P i.succ)))).2 → + x ∈ h.domain → + x ∈ k.domain → + ∀ (j : Fin (2 : ℕ)), + ∀ (A : FordFareyParameter), + A.p = ![P.p₁, P.p₂] j → + A.q = ![P.q₁, P.q₂] j → + ∀ (u : GaussianInt), + ∀ (B : ℤ), + ∀ (f : IntegerLatticeFunction), + (∀ (x : GaussianInt), + x ∈ h.domain ↔ x - u ∈ FordVertexDomain P.q) → + (∀ y ∈ FordVertexDomain P.q, f y = FordOdometer P y) → + (∀ (x : GaussianInt), + x ∈ k.domain ↔ + x - u - (P5332T1ParentRows P j s (0 : ℤ)).displacement ∈ + FordVertexDomain A.q) → + p'.1 - p.1 = + ((↑A.p : ℝ) - (↑P.p : ℝ)) / (2 : ℝ) + + (↑(P5332T1ParentRows P j s (0 : ℤ)).linear.re : ℝ) → + p'.2 - p.2 = + ((↑A.p : ℝ) - (↑P.p : ℝ)) / (2 : ℝ) + + (↑(P5332T1ParentRows P j s (0 : ℤ)).linear.im : ℝ) → + (∀ (y : GaussianInt), + y - (P5332T1ParentRows P j s (0 : ℤ)).displacement ∈ + FordVertexDomain A.q → + f y = + FordOdometer A + (y - (P5332T1ParentRows P j s (0 : ℤ)).displacement) + + (P5332T1ParentRows P j s (0 : ℤ)).linear.re * y.re + + (P5332T1ParentRows P j s (0 : ℤ)).linear.im * y.im + + B) → + (∀ (l : Fin (5 : ℕ)), + x - u + + ![(0 : ℤ√(-1 : ℤ)), (1 : ℤ√(-1 : ℤ)), (-1 : ℤ√(-1 : ℤ)), + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), + -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)] + l ∈ + FordVertexDomain P.q ∨ + x - u + + ![(0 : ℤ√(-1 : ℤ)), (1 : ℤ√(-1 : ℤ)), (-1 : ℤ√(-1 : ℤ)), + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), + -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)] + l - + (P5332T1ParentRows P j s (0 : ℤ)).displacement ∈ + FordVertexDomain A.q) → + ∃ t : Int, + 0 ≤ t ∧ + t < ((![P.q₁, P.q₂] j : Nat) : Int) ∧ + (∀ l : Fin 5, + f + (x - u + ![0, 1, -1, (⟨0, 1⟩ : GaussianInt), -⟨0, 1⟩] l) = + (P5332T1ParentRows P j s t).values l) ∧ + (x - u - (P5332T1ParentRows P j s 0).companion ∈ + FordVertexDomain P.q ↔ + t = 0 ∧ Even (s.val + j.val)) + ) := by classical - intro P hq i s T U h k p p' x hc ha hb hx hx' j A hAp hAq u B f hdom hbase vv hdom' hcell' - hcent hslope hslope' hother hstar' + intro P hq i s h k p p' x ha hb hx hx' j A hAp hAq u B f hdom hbase hdom' hslope hslope' + hother hstar' fin_cases j <;> fin_cases s · obtain ⟨t, ht, ht', _, _, hv, hh⟩ := P5332T1Parent1Rotation0Values P A hq hAp hAq f B (x-u) hbase hother ((hdom x).mp hx) ((hdom' x).mp hx') hstar' @@ -640,7 +675,7 @@ theorem FordTerminalWebStencilLedger (P : FordFareyParameter) (hq : 1 < P.q) : · exact positive i T U h k p p' g x hT hU hp hp' (by simpa using hc) (by simpa using ha) (by simpa using hb) he he' hx hx' hstar · intro i s T U h k p p' g x hpos hT hU hp hp' hc ha hb _ he he' hx hx' hstar - have hi : i.val < 2 := FordTerminalStencilGeometry.hiAt337 P i s T U k p p' hpos hU hc ha hb + have hi : i.val < 2 := FordTerminalStencilGeometry.hiAt337 P i s p p' hpos ha hb let j : Fin 2 := ⟨i.val, hi⟩ have hij : (⟨j.val, by omega⟩ : Fin 3) = i := rfl obtain ⟨hqr, _, hqs, _, hredr, hreds, _⟩ := P5130T5ParentArithmetic P hq @@ -678,8 +713,8 @@ theorem FordTerminalWebStencilLedger (P : FordFareyParameter) (hq : 1 < P.q) : (∀ l : Fin 5, f (x-u + (![0,1,-1,(⟨0,1⟩ : GaussianInt),-⟨0,1⟩] l)) = (P5332T1ParentRows P j s t).values l) ∧ (x-u - (P5332T1ParentRows P j s 0).companion ∈ FordVertexDomain P.q ↔ - t = 0 ∧ Even (s.val+j.val)) := FordTerminalStencilGeometry.sourceAt395 P hq i s T U h k - p p' x hc ha hb hx hx' j A hAp hAq u B f hdom hbase vv hdom' hcell' hcent hslope + t = 0 ∧ Even (s.val+j.val)) := FordTerminalStencilGeometry.sourceAt395 P hq i s h k + p p' x ha hb hx hx' j A hAp hAq u B f hdom hbase hdom' hslope hslope' hother hstar' obtain ⟨t, ht, ht', hv, hh⟩ := source have hg : FourNeighborLaplacian g x = diff --git a/LeanPool/ApollonianSuperharmonic/FordTileCellMembership.lean b/LeanPool/ApollonianSuperharmonic/FordTileCellMembership.lean new file mode 100644 index 0000000000..a3d089b137 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/FordTileCellMembership.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.FordTile +public import Mathlib.Init + +/-! +# Ford tile cell membership + +Shared coordinate characterization adapted from Wesley Pegden's Apache-2.0 +Trellis formalization of Levine–Pegden–Smart. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +/-- Ford cells are precisely the integer basepoints in the half-open square. -/ +theorem FordTileCellMembership (m : Nat) (z : GaussianInt) : + z ∈ (FordTile m).cells ↔ 0 ≤ z.re ∧ z.re < m ∧ 0 ≤ z.im ∧ z.im < m := by + classical + change z ∈ ((Finset.range m).product (Finset.range m)).image + (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) ↔ _ + rw [Finset.mem_image] + constructor + · rintro ⟨⟨j, k⟩, hjk, rfl⟩ + have hjk := Finset.mem_product.mp hjk + simp only [Finset.mem_range] at hjk + dsimp; omega + · rintro ⟨h0, h1, h2, h3⟩ + exact ⟨(z.re.toNat, z.im.toNat), + Finset.mem_product.mpr ⟨Finset.mem_range.mpr (by omega), + Finset.mem_range.mpr (by omega)⟩, + by ext <;> dsimp <;> omega⟩ + +end ApollonianSuperharmonic + +end diff --git a/LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean b/LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean index eb3efd86ee..6ab9cc3f25 100644 --- a/LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/FordTileOdometerRestriction.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordFareySum public import LeanPool.ApollonianSuperharmonic.FordOdometer public import LeanPool.ApollonianSuperharmonic.FordCircleCoordinate @@ -203,16 +204,7 @@ private theorem q1pos : have := Int.eq_one_of_dvd_one (by omega : 0 ≤ (R.q : Int)) hdv omega -private theorem cross : - (by - classical - exact - ∀ (R : FordFareyParameter), R.p₁ * (R.q₂ : Int) - (R.q₁ : Int) * R.p₂ = 1 ) := by - classical - intro R - have hd := R.det₁ - rw [R.sum_q, R.sum_p, Nat.cast_add] at hd - nlinarith [hd] +private abbrev cross := ApollonianSuperharmonic.FordFareySum.determinant private theorem red : (by diff --git a/LeanPool/ApollonianSuperharmonic/Imports.lean b/LeanPool/ApollonianSuperharmonic/Imports.lean index ccd1499efc..c4a83526f0 100644 --- a/LeanPool/ApollonianSuperharmonic/Imports.lean +++ b/LeanPool/ApollonianSuperharmonic/Imports.lean @@ -299,6 +299,7 @@ public import LeanPool.ApollonianSuperharmonic.FordRegimeConverse public import LeanPool.ApollonianSuperharmonic.FordTerminalWebStencilLedger public import LeanPool.ApollonianSuperharmonic.FordTile public import LeanPool.ApollonianSuperharmonic.FordTileAcyclicIndegree +public import LeanPool.ApollonianSuperharmonic.FordTileCellMembership public import LeanPool.ApollonianSuperharmonic.FordTileGeometry public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification diff --git a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean index aaf7daf69b..5deba8990c 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnTranslation +public import LeanPool.ApollonianSuperharmonic.BandPrototileQuarterTurn public import LeanPool.ApollonianSuperharmonic.TileOdometerBandPrototile public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty @@ -233,25 +235,7 @@ private theorem touching_cells_congr : · have h' : B.cells = ∅ := by simpa [hb] using h.1 exact (Finset.not_nonempty_iff_eq_empty.mpr h' hB).elim -private theorem quarter_translate : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (x : GaussianInt), TileQuarterTurn (TileTranslation T x) = - TileTranslation (TileQuarterTurn T) (GaussianQuarterTurn x) ) := by - classical - intro T x - cases T with - | mk cells anchor => - apply congrArg₂ (fun c : Finset GaussianInt => fun a : GaussianInt => - (⟨c, a⟩ : ProtoTile)) - · simp only [TileTranslation, GaussianTranslation, Finset.image_image, Function.comp_def, - TileQuarterTurn] - congr 1 - funext z - ext <;> simp [GaussianQuarterTurn]; ring - · simp [TileQuarterTurn, TileTranslation, GaussianTranslation, - GaussianQuarterTurn, add_comm] +private abbrev quarter_translate := ApollonianSuperharmonic.TileQuarterTurnTranslation.commute private theorem translation_comm : (by @@ -620,45 +604,7 @@ private theorem hUn : rw [(TileTranslationFormulas T v).1] exact Finset.image_nonempty.mpr hnonempty -private theorem hT2 : - (by - classical - exact - ∀ (D : CircleCoordinates), ∀ (X : ProtoTile), BandPrototile D X → QuarterTurnSymmetric X - ) := by - classical - intro D X cert - induction cert with - | line w x hw => - intro p - simp [TileRealization, TileCentroid] - | unit z x anchor => - intro p - rcases p with ⟨r, t⟩ - have hcent : TileCentroid ⟨{x}, anchor⟩ = - (((x.re : Int) : Real) + 1 / 2, - ((x.im : Int) : Real) + 1 / 2) := by - simp [TileCentroid] - rw [hcent] - simp only [TileRealization, Finset.mem_singleton, Set.iUnion_iUnion_eq_left, - Int.reduceNeg, GaussianInt.intCast_re, one_div, GaussianInt.intCast_im] - rw [← GaussianInt.intCast_re x, ← GaussianInt.intCast_im x] - change (r, t) ∈ ClosedSquareRealization x ↔ - ((((x.re : Int) : Real) + (2 : Real)⁻¹) - - (t - (((x.im : Int) : Real) + (2 : Real)⁻¹)), - (((x.im : Int) : Real) + (2 : Real)⁻¹) + - (r - (((x.re : Int) : Real) + (2 : Real)⁻¹))) ∈ - ClosedSquareRealization x - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - constructor - · rintro ⟨⟨hrl, htl⟩, ⟨hru, htu⟩⟩ - constructor <;> constructor <;> linarith - · rintro ⟨⟨hrl, htl⟩, ⟨hru, htu⟩⟩ - constructor <;> constructor <;> linarith - | @decompose r hr S X hS hcells hfoot hcent ih => - have hcert : BandPrototile (r 0) X := - BandPrototile.decompose hr hS hcells hfoot hcent - exact (BandTileSimultaneousInduction r hr X hcert).2.2.2.1 +private abbrev hT2 := ApollonianSuperharmonic.BandPrototileQuarterTurn.symmetry private theorem hT4 : (by diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean index 836bd5a475..78357df39c 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean @@ -162,68 +162,62 @@ private theorem unoccupied_index_zero : (by classical exact - ∀ (T : ProtoTile), (∀ (q : LatticeCell), ∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ - (y : GaussianInt), ((((q.re : Int) : Real) + (1 / 2 : Real)), (((q.im : Int) : Real) - + (1 / 2 : Real))) ∉ TileRealization T → p.head? = some x → p.getLast? = some y → (∀ - a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, p = l₁ ++ a :: b :: l₂ → - FourNeighborAdjacent a b) → FourNeighborAdjacent y x → (∀ a b : GaussianInt, ((∃ l₁ - l₂ : List GaussianInt, p = l₁ ++ a :: b :: l₂) ∨ (a = y ∧ b = x)) → ∀ t : Set.Icc (0 - : Real) 1, ((1 - (t : Real)) * ((a.re : Int) : Real) + (t : Real) * ((b.re : Int) : - Real), (1 - (t : Real)) * ((a.im : Int) : Real) + (t : Real) * ((b.im : Int) : Real)) - ∈ TileRealization T) → GridRayCrossingIndex q p = 0) → (∀ (gridPath : List - GaussianInt), ∀ (x : GaussianInt), ∀ (y : GaussianInt), ∀ (z : GaussianInt), - (gridPath.head? = some x) → ((gridPath.getLast? = some y) → ((List.IsChain (fun (a b - : GaussianInt) => {a, b} ∈ BoundaryFootprintEdges T) gridPath) → (({y, x} ∈ - BoundaryFootprintEdges T) → ((List.IsChain FourNeighborAdjacent gridPath) → - ((FourNeighborAdjacent y x) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), (a, b) ∈ - gridPath.zip gridPath.tail ++ [(y, x)] → {a, b} ∈ BoundaryFootprintEdges T) → ((∀ (a - : GaussianInt), ∀ (b : GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail ++ [(y, x)] - → FourNeighborAdjacent a b) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), a ∈ - gridPath → {a, b} ∈ BoundaryFootprintEdges T → (a, b) ∈ gridPath.zip gridPath.tail ++ - [(y, x)] ∨ (b, a) ∈ gridPath.zip gridPath.tail ++ [(y, x)]) → (((z + (1 : - GaussianInt), z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ gridPath.zip - gridPath.tail ++ [(y, x)] ∨ (z + (1 : GaussianInt) + ⟨(0 : ℤ), (1 : ℤ)⟩, z + (1 : - GaussianInt)) ∈ gridPath.zip gridPath.tail ++ [(y, x)]) → ( - let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] - ( - let cyclicEdges := gridPath.zip gridPath.tail ++ [(y, x)]; - ∀ (q : LatticeCell), ((q + (1 : LatticeCell), q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ - cyclicEdges ∧ - (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell)) ∉ cyclicEdges → - GridRayCrossingIndex (q + (1 : LatticeCell)) gridPath = GridRayCrossingIndex q gridPath) ∧ - ((q + (1 : LatticeCell), q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ - (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell)) ∈ cyclicEdges → - (GridRayCrossingIndex (q + (1 : LatticeCell)) gridPath - GridRayCrossingIndex q - gridPath).natAbs = (1 : ℕ)) ∧ - ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges ∧ - (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ - cyclicEdges → - GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) gridPath = GridRayCrossingIndex q - gridPath) ∧ - ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ - cyclicEdges ∨ - (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ - cyclicEdges → - (GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) gridPath - - GridRayCrossingIndex q gridPath).natAbs = - (1 : ℕ))) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, b} : Finset - GaussianInt) ∈ BoundaryFootprintEdges T) → (∀ t : Set.Icc (0 : Real) 1, ((1 - - (t : Real)) * ((a.re : Int) : Real) + (t : Real) * ((b.re : Int) : Real), (1 - - (t : Real)) * ((a.im : Int) : Real) + (t : Real) * ((b.im : Int) : Real)) ∈ - TileRealization T)) → ((∀ a b : GaussianInt, (a, b) ∈ cyclicEdges → ∀ t : - Set.Icc (0 : Real) 1, ((1 - (t : Real)) * ((a.re : Int) : Real) + (t : Real) - * ((b.re : Int) : Real), (1 - (t : Real)) * ((a.im : Int) : Real) + (t : - Real) * ((b.im : Int) : Real)) ∈ TileRealization T) → ((∀ (q : LatticeCell), - (q ∉ T.cells) → (((((q.re : Int) : Real) + (1 / 2 : Real)), (((q.im : Int) : - Real) + (1 / 2 : Real))) ∉ TileRealization T)) → (∀ q ∉ T.cells, - GridRayCrossingIndex q gridPath = (0 : ℤ)))))))))))))))) + ∀ (T : ProtoTile), + (∀ (q : LatticeCell), + ∀ (p : List GaussianInt), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + (((q.re : Int) : Real) + (1 / 2 : Real), + ((q.im : Int) : Real) + (1 / 2 : Real)) ∉ + TileRealization T → + p.head? = some x → + p.getLast? = some y → + (∀ a b : GaussianInt, + ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → + FourNeighborAdjacent y x → + (∀ a b : GaussianInt, + (∃ l₁ l₂ : List GaussianInt, p = l₁ ++ a :: b :: l₂) ∨ + a = y ∧ b = x → + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * ((a.re : Int) : Real) + + (t : Real) * ((b.re : Int) : Real), + (1 - (t : Real)) * ((a.im : Int) : Real) + + (t : Real) * ((b.im : Int) : Real)) ∈ + TileRealization T) → + GridRayCrossingIndex q p = 0) → + ∀ (gridPath : List GaussianInt), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + gridPath.head? = some x → + gridPath.getLast? = some y → + List.IsChain + (fun (a b : GaussianInt) => { a, b } ∈ BoundaryFootprintEdges T) + gridPath → + { y, x } ∈ BoundaryFootprintEdges T → + List.IsChain FourNeighborAdjacent gridPath → + FourNeighborAdjacent y x → + (∀ (a : GaussianInt), + ∀ (b : GaussianInt), + ({ a, b } : Finset GaussianInt) ∈ + BoundaryFootprintEdges T → + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * ((a.re : Int) : Real) + + (t : Real) * ((b.re : Int) : Real), + (1 - (t : Real)) * ((a.im : Int) : Real) + + (t : Real) * ((b.im : Int) : Real)) ∈ + TileRealization T) → + (∀ (q : LatticeCell), + q ∉ T.cells → + (((q.re : Int) : Real) + (1 / 2 : Real), + ((q.im : Int) : Real) + (1 / 2 : Real)) ∉ + TileRealization T) → + ∀ q ∉ T.cells, GridRayCrossingIndex q gridPath = (0 : ℤ) ) := by classical - intro T closed_grid_index_zero gridPath x y z gridPath_head gridPath_last gridPath_chain - gridPath_close gridPath_fourNeighbor gridPath_close_fourNeighbor cyclic_edge_boundary - cyclic_edge_fourNeighbor component_edge_cyclic hrightCyclic cyclicEdges - component_index_control boundary_edge_segment cyclic_edge_segment unoccupied_center_outside - q hq + intro T closed_grid_index_zero gridPath x y gridPath_head gridPath_last gridPath_chain + gridPath_close gridPath_fourNeighbor gridPath_close_fourNeighbor boundary_edge_segment + unoccupied_center_outside q hq apply closed_grid_index_zero q gridPath x y (unoccupied_center_outside q hq) gridPath_head gridPath_last · intro a b l₁ l₂ hab @@ -747,10 +741,9 @@ theorem LatticeTileBoundarySimpleGridCycle (T : ProtoTile) (hT : LatticeTile T) BoundaryCycleProof.unoccupied_center_outside T q hq have unoccupied_index_zero (q : LatticeCell) (hq : q ∉ T.cells) : GridRayCrossingIndex q gridPath = 0 := BoundaryCycleProof.unoccupied_index_zero T - closed_grid_index_zero gridPath x y z gridPath_head gridPath_last gridPath_chain - gridPath_close gridPath_fourNeighbor gridPath_close_fourNeighbor cyclic_edge_boundary - cyclic_edge_fourNeighbor component_edge_cyclic hrightCyclic component_index_control - boundary_edge_segment cyclic_edge_segment unoccupied_center_outside q hq + closed_grid_index_zero gridPath x y gridPath_head gridPath_last gridPath_chain + gridPath_close gridPath_fourNeighbor gridPath_close_fourNeighbor + boundary_edge_segment unoccupied_center_outside q hq have hrightJump : Int.natAbs (GridRayCrossingIndex (z + 1) gridPath - GridRayCrossingIndex z gridPath) = 1 := by diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileFourNeighborConnected.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileFourNeighborConnected.lean index ecc3695762..8159ebcd0c 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileFourNeighborConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileFourNeighborConnected.lean @@ -219,17 +219,23 @@ private theorem reachXY : private theorem walk : ∀ (T : ProtoTile), - let step : LatticeCell → LatticeCell → Prop := fun a b => - FourNeighborAdjacent a b ∧ a ∈ (T.cells : Set LatticeCell) ∧ - b ∈ (T.cells : Set LatticeCell) - let reachable : LatticeCell → LatticeCell → Prop := - Relation.ReflTransGen step - ∀ {a : LatticeCell}, ∀ {b : LatticeCell}, a ∈ (T.cells : Set LatticeCell) → b ∈ (T.cells : - Set LatticeCell) → reachable a b → ∃ p : List LatticeCell, p.head? = some a ∧ p.getLast? - = some b ∧ (∀ z ∈ p, z ∈ (T.cells : Set LatticeCell)) ∧ ∀ u v : LatticeCell, ∀ l₁ l₂ : - List LatticeCell, p = l₁ ++ u :: v :: l₂ → FourNeighborAdjacent u v := by + let step : LatticeCell → LatticeCell → Prop := fun a b => + FourNeighborAdjacent a b ∧ + a ∈ (T.cells : Set LatticeCell) ∧ b ∈ (T.cells : Set LatticeCell); + let reachable : LatticeCell → LatticeCell → Prop := Relation.ReflTransGen step; + ∀ {a : LatticeCell}, + ∀ {b : LatticeCell}, + b ∈ (T.cells : Set LatticeCell) → + reachable a b → + ∃ p : List LatticeCell, + p.head? = some a ∧ + p.getLast? = some b ∧ + (∀ z ∈ p, z ∈ (T.cells : Set LatticeCell)) ∧ + ∀ u v : LatticeCell, + ∀ l₁ l₂ : List LatticeCell, + p = l₁ ++ u :: v :: l₂ → FourNeighborAdjacent u v := by classical - intro T step reachable a b ha hb hab + intro T step reachable a b hb hab induction hab using Relation.ReflTransGen.head_induction_on with | refl => exact ⟨[b], by simp, by simp, by @@ -240,7 +246,7 @@ private theorem walk : (List.isChain_singleton b)⟩ | @head a₀ c hstep hrest ih => rcases hstep with ⟨huv, ha', hc⟩ - rcases ih hc with ⟨p, hphead, hplast, hpinside, hpedge⟩ + rcases ih with ⟨p, hphead, hplast, hpinside, hpedge⟩ have pne : p ≠ [] := by intro hnil simp [hnil] at hphead @@ -386,14 +392,7 @@ theorem LatticeTileFourNeighborConnected (T : ProtoTile) (hT : LatticeTile T) : by simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using hv⟩) have reachXY : reachable x y := FourNeighborProof.reachXY T realizationConnected overlap x hx y hy squareNonempty diagonalBridge - have walk : ∀ {a b : LatticeCell}, a ∈ (T.cells : Set LatticeCell) → - b ∈ (T.cells : Set LatticeCell) → reachable a b → - ∃ p : List LatticeCell, - p.head? = some a ∧ p.getLast? = some b ∧ - (∀ z ∈ p, z ∈ (T.cells : Set LatticeCell)) ∧ - ∀ u v : LatticeCell, ∀ l₁ l₂ : List LatticeCell, - p = l₁ ++ u :: v :: l₂ → FourNeighborAdjacent u v := FourNeighborProof.walk T - rcases walk hx hy reachXY with ⟨p, hphead, hplast, hpinside, hpedge⟩ + rcases FourNeighborProof.walk T hy reachXY with ⟨p, hphead, hplast, hpinside, hpedge⟩ exact ⟨p, hphead, hplast, hpinside, hpedge⟩ end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean index 14a4214526..c40735394c 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileThreeDiskJunction.lean @@ -132,19 +132,7 @@ private theorem hpathAB : rw [hVrawAB] exact hpathAB0 -private theorem hpathBC : - (by - classical - exact - ∀ (B : ProtoTile), ∀ (C : ProtoTile), (FootprintVertices B ∩ FootprintVertices C = - CommonFootprintEdgeVertices B C) → (∀ (xBC : GaussianInt), ∀ (yBC : GaussianInt), - (SimpleGridPathBetween (CommonFootprintEdgeVertices B C) (FootprintEdges B ∩ - FootprintEdges C) xBC yBC) → (SimpleGridPathBetween (FootprintVertices B ∩ - FootprintVertices C) (FootprintEdges B ∩ FootprintEdges C) xBC yBC)) ) := by - classical - intro B C hVrawBC xBC yBC hpathBC0 - rw [hVrawBC] - exact hpathBC0 +private abbrev hpathBC := ApollonianSuperharmonic.ThreeDiskJunctionGeometry.hpathAB private theorem hpathCA : (by @@ -172,17 +160,7 @@ private theorem hcellsAB : have h : AB.cells = A.cells ∪ B.cells := by ext z; simpa using hunionAB z rw [h, Finset.card_union_of_disjoint hdisjointAB] -private theorem hcellsBC : - (by - classical - exact - ∀ (B : ProtoTile), ∀ (C : ProtoTile), ∀ (BC : ProtoTile), (Disjoint B.cells C.cells) → - ((∀ (z : LatticeCell), z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) → (BC.cells.card = - B.cells.card + C.cells.card)) ) := by - classical - intro B C BC hdisjointBC hunionBC - have h : BC.cells = B.cells ∪ C.cells := by ext z; simpa using hunionBC z - rw [h, Finset.card_union_of_disjoint hdisjointBC] +private abbrev hcellsBC := ApollonianSuperharmonic.ThreeDiskJunctionGeometry.hcellsAB private theorem hcellsCA : (by diff --git a/LeanPool/ApollonianSuperharmonic/ListEndpointFacts.lean b/LeanPool/ApollonianSuperharmonic/ListEndpointFacts.lean index 45e764a5d8..63428e1978 100644 --- a/LeanPool/ApollonianSuperharmonic/ListEndpointFacts.lean +++ b/LeanPool/ApollonianSuperharmonic/ListEndpointFacts.lean @@ -138,6 +138,18 @@ theorem splitMembership {α : Type*} (r : List α) (z : α) (hz : z ∈ r) : · rcases ih hz with ⟨l, t, ht⟩ exact ⟨a :: l, t, by simp [ht, List.cons_append]⟩ +/-- Distinct head and last entries require at least two list elements. -/ +theorem twoLeLength {α : Type*} (a b : α) (hab : a ≠ b) (k : List α) + (hhead : k.head? = some b) (hlast : k.getLast? = some a) : 2 ≤ k.length := by + cases k with + | nil => simp at hhead + | cons c l => + cases l with + | nil => + simp only [List.head?_cons, List.getLast?_singleton, Option.some.injEq] at hhead hlast + exact (hab (hlast.symm.trans hhead)).elim + | cons d ds => simp + end ListEndpointFacts end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean b/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean index 43fcddc4e2..b0e6a242f0 100644 --- a/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence public import LeanPool.ApollonianSuperharmonic.FootprintEdges public import LeanPool.ApollonianSuperharmonic.FootprintVertices @@ -32,29 +33,7 @@ namespace ApollonianSuperharmonic namespace InterfaceSectorGeometry -private theorem raw_incident : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (x : GaussianInt), Finset.Nonempty T.cells → x ∈ FootprintVertices T - → ∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ T.cells ) := by - classical - intro T x hne hx - simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hx - rcases hx with ⟨c, hc, h | h | h | h⟩ - · refine ⟨0, ?_⟩ - simpa [LatticeVertexIncidentCell] using h ▸ hc - · refine ⟨1, ?_⟩ - subst x - convert hc using 1; simp [LatticeVertexIncidentCell] - · refine ⟨3, ?_⟩ - subst x - convert hc using 1; simp [LatticeVertexIncidentCell] - · refine ⟨2, ?_⟩ - change x - 1 - ⟨0, 1⟩ ∈ T.cells - rw [h] - convert hc using 1 - ext <;> simp +private abbrev raw_incident := ApollonianSuperharmonic.LatticeFootprintIncidence.incidentCell private theorem nonempty_touching : (by @@ -73,19 +52,7 @@ private theorem nonempty_touching : · rw [ht.1] at hVne simp at hVne -private theorem incident_boundary : - (by - classical - exact - ∀ (T : ProtoTile), - ∀ (x : GaussianInt), - (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ T.cells) → - (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∉ T.cells) → - x ∈ BoundaryFootprintVertices T - ) := by - classical - intro T x hsome hmissing - exact P3161T2IncidentBoundary T x hsome hmissing +private abbrev incident_boundary := ApollonianSuperharmonic.P3161T2IncidentBoundary private theorem common_edge_transition : (by @@ -253,21 +220,30 @@ private theorem hXY_YZ : (by classical exact - let I : GaussianInt := ⟨0, 1⟩ - let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := - ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] - ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), ∀ (eYZ : - Finset GaussianInt), ∀ (jXY : Fin (4 : ℕ)), (LatticeVertexIncidentCell x jXY ∈ - X.cells ∧ LatticeVertexIncidentCell x (jXY + (1 : Fin (4 : ℕ))) ∈ Y.cells ∨ - LatticeVertexIncidentCell x jXY ∈ Y.cells ∧ LatticeVertexIncidentCell x (jXY + (1 : - Fin (4 : ℕ))) ∈ X.cells) → (∀ (jYZ : Fin (4 : ℕ)), (eYZ = edgeAt x jYZ) → - ((LatticeVertexIncidentCell x jYZ ∈ Y.cells ∧ LatticeVertexIncidentCell x (jYZ + (1 : - Fin (4 : ℕ))) ∈ Z.cells ∨ LatticeVertexIncidentCell x jYZ ∈ Z.cells ∧ - LatticeVertexIncidentCell x (jYZ + (1 : Fin (4 : ℕ))) ∈ Y.cells) → ((∀ ⦃a : - LatticeCell⦄, a ∈ Y.cells → a ∉ Z.cells) → ((∀ ⦃a : LatticeCell⦄, a ∈ Z.cells → a ∉ - X.cells) → (jXY ≠ jYZ))))) ) := by + ∀ (X : ProtoTile), + ∀ (Y : ProtoTile), + ∀ (Z : ProtoTile), + ∀ (x : GaussianInt), + Finset GaussianInt → + ∀ (jXY : Fin (4 : ℕ)), + LatticeVertexIncidentCell x jXY ∈ X.cells ∧ + LatticeVertexIncidentCell x (jXY + (1 : Fin (4 : ℕ))) ∈ + Y.cells ∨ + LatticeVertexIncidentCell x jXY ∈ Y.cells ∧ + LatticeVertexIncidentCell x (jXY + (1 : Fin (4 : ℕ))) ∈ + X.cells → + ∀ (jYZ : Fin (4 : ℕ)), + LatticeVertexIncidentCell x jYZ ∈ Y.cells ∧ + LatticeVertexIncidentCell x (jYZ + (1 : Fin (4 : ℕ))) ∈ + Z.cells ∨ + LatticeVertexIncidentCell x jYZ ∈ Z.cells ∧ + LatticeVertexIncidentCell x (jYZ + (1 : Fin (4 : ℕ))) ∈ + Y.cells → + (∀ ⦃a : LatticeCell⦄, a ∈ Y.cells → a ∉ Z.cells) → + (∀ ⦃a : LatticeCell⦄, a ∈ Z.cells → a ∉ X.cells) → jXY ≠ jYZ + ) := by classical - intro I edgeAt X Y Z x eYZ jXY htXY jYZ heYZat htYZ hYZd hZXd h + intro X Y Z x eYZ jXY htXY jYZ htYZ hYZd hZXd h subst jYZ rcases htXY with htXY | htXY <;> rcases htYZ with htYZ | htYZ · exact hYZd htXY.2 htYZ.2 @@ -279,21 +255,31 @@ private theorem hYZ_ZX : (by classical exact - let I : GaussianInt := ⟨0, 1⟩ - let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := - ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] - ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), ∀ (eZX : - Finset GaussianInt), ∀ (jYZ : Fin (4 : ℕ)), (LatticeVertexIncidentCell x jYZ ∈ - Y.cells ∧ LatticeVertexIncidentCell x (jYZ + (1 : Fin (4 : ℕ))) ∈ Z.cells ∨ - LatticeVertexIncidentCell x jYZ ∈ Z.cells ∧ LatticeVertexIncidentCell x (jYZ + (1 : - Fin (4 : ℕ))) ∈ Y.cells) → (∀ (jZX : Fin (4 : ℕ)), (eZX = edgeAt x jZX) → - ((LatticeVertexIncidentCell x jZX ∈ Z.cells ∧ LatticeVertexIncidentCell x (jZX + (1 : - Fin (4 : ℕ))) ∈ X.cells ∨ LatticeVertexIncidentCell x jZX ∈ X.cells ∧ - LatticeVertexIncidentCell x (jZX + (1 : Fin (4 : ℕ))) ∈ Z.cells) → ((∀ ⦃a : - LatticeCell⦄, a ∈ X.cells → a ∉ Y.cells) → ((∀ ⦃a : LatticeCell⦄, a ∈ Y.cells → a ∉ - Z.cells) → ((∀ ⦃a : LatticeCell⦄, a ∈ Z.cells → a ∉ X.cells) → (jYZ ≠ jZX)))))) ) := by + ∀ (X : ProtoTile), + ∀ (Y : ProtoTile), + ∀ (Z : ProtoTile), + ∀ (x : GaussianInt), + Finset GaussianInt → + ∀ (jYZ : Fin (4 : ℕ)), + LatticeVertexIncidentCell x jYZ ∈ Y.cells ∧ + LatticeVertexIncidentCell x (jYZ + (1 : Fin (4 : ℕ))) ∈ + Z.cells ∨ + LatticeVertexIncidentCell x jYZ ∈ Z.cells ∧ + LatticeVertexIncidentCell x (jYZ + (1 : Fin (4 : ℕ))) ∈ + Y.cells → + ∀ (jZX : Fin (4 : ℕ)), + LatticeVertexIncidentCell x jZX ∈ Z.cells ∧ + LatticeVertexIncidentCell x (jZX + (1 : Fin (4 : ℕ))) ∈ + X.cells ∨ + LatticeVertexIncidentCell x jZX ∈ X.cells ∧ + LatticeVertexIncidentCell x (jZX + (1 : Fin (4 : ℕ))) ∈ + Z.cells → + (∀ ⦃a : LatticeCell⦄, a ∈ X.cells → a ∉ Y.cells) → + (∀ ⦃a : LatticeCell⦄, a ∈ Y.cells → a ∉ Z.cells) → + (∀ ⦃a : LatticeCell⦄, a ∈ Z.cells → a ∉ X.cells) → jYZ ≠ jZX + ) := by classical - intro I edgeAt X Y Z x eZX jYZ htYZ jZX heZXat htZX hXYd hYZd hZXd h + intro X Y Z x eZX jYZ htYZ jZX htZX hXYd hYZd hZXd h subst jZX rcases htYZ with htYZ | htYZ <;> rcases htZX with htZX | htZX · exact hYZd htYZ.1 htZX.1 @@ -305,22 +291,33 @@ private theorem hZX_XY : (by classical exact - let I : GaussianInt := ⟨0, 1⟩ - let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := - ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] - ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), ∀ (eXY : - Finset GaussianInt), ∀ (jXY : Fin (4 : ℕ)), (eXY = edgeAt x jXY) → - ((LatticeVertexIncidentCell x jXY ∈ X.cells ∧ LatticeVertexIncidentCell x (jXY + (1 : - Fin (4 : ℕ))) ∈ Y.cells ∨ LatticeVertexIncidentCell x jXY ∈ Y.cells ∧ - LatticeVertexIncidentCell x (jXY + (1 : Fin (4 : ℕ))) ∈ X.cells) → (∀ (jYZ : Fin (4 : - ℕ)), ∀ (jZX : Fin (4 : ℕ)), (LatticeVertexIncidentCell x jZX ∈ Z.cells ∧ - LatticeVertexIncidentCell x (jZX + (1 : Fin (4 : ℕ))) ∈ X.cells ∨ - LatticeVertexIncidentCell x jZX ∈ X.cells ∧ LatticeVertexIncidentCell x (jZX + (1 : - Fin (4 : ℕ))) ∈ Z.cells) → ((∀ ⦃a : LatticeCell⦄, a ∈ X.cells → a ∉ Y.cells) → ((∀ ⦃a - : LatticeCell⦄, a ∈ Y.cells → a ∉ Z.cells) → ((∀ ⦃a : LatticeCell⦄, a ∈ Z.cells → a ∉ - X.cells) → ((jXY ≠ jYZ) → (jZX ≠ jXY))))))) ) := by + ∀ (X : ProtoTile), + ∀ (Y : ProtoTile), + ∀ (Z : ProtoTile), + ∀ (x : GaussianInt), + Finset GaussianInt → + ∀ (jXY : Fin (4 : ℕ)), + LatticeVertexIncidentCell x jXY ∈ X.cells ∧ + LatticeVertexIncidentCell x (jXY + (1 : Fin (4 : ℕ))) ∈ + Y.cells ∨ + LatticeVertexIncidentCell x jXY ∈ Y.cells ∧ + LatticeVertexIncidentCell x (jXY + (1 : Fin (4 : ℕ))) ∈ + X.cells → + ∀ (jYZ : Fin (4 : ℕ)), + ∀ (jZX : Fin (4 : ℕ)), + LatticeVertexIncidentCell x jZX ∈ Z.cells ∧ + LatticeVertexIncidentCell x (jZX + (1 : Fin (4 : ℕ))) ∈ + X.cells ∨ + LatticeVertexIncidentCell x jZX ∈ X.cells ∧ + LatticeVertexIncidentCell x (jZX + (1 : Fin (4 : ℕ))) ∈ + Z.cells → + (∀ ⦃a : LatticeCell⦄, a ∈ X.cells → a ∉ Y.cells) → + (∀ ⦃a : LatticeCell⦄, a ∈ Y.cells → a ∉ Z.cells) → + (∀ ⦃a : LatticeCell⦄, a ∈ Z.cells → a ∉ X.cells) → + jXY ≠ jYZ → jZX ≠ jXY + ) := by classical - intro I edgeAt X Y Z x eXY jXY heXYat htXY jYZ jZX htZX hXYd hYZd hZXd hXY_YZ h + intro X Y Z x eXY jXY htXY jYZ jZX htZX hXYd hYZd hZXd hXY_YZ h subst jXY rcases htZX with htZX | htZX <;> rcases htXY with htXY | htXY · exact hZXd htZX.1 htXY.1 @@ -332,27 +329,28 @@ private theorem hexhaust : (by classical exact - let I : GaussianInt := ⟨0, 1⟩ - let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := - ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] - ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), ∀ (eXY : - Finset GaussianInt), ∀ (eYZ : Finset GaussianInt), ∀ (eZX : Finset GaussianInt), ∀ - (jXY : Fin (4 : ℕ)), (eXY = edgeAt x jXY) → ((LatticeVertexIncidentCell x jXY ∈ + ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (x : GaussianInt), (Finset + GaussianInt) → + (Finset GaussianInt) → + (Finset GaussianInt) → + ∀ + (jXY : Fin (4 : ℕ)), + ((LatticeVertexIncidentCell x jXY ∈ X.cells ∧ LatticeVertexIncidentCell x (jXY + (1 : Fin (4 : ℕ))) ∈ Y.cells ∨ LatticeVertexIncidentCell x jXY ∈ Y.cells ∧ LatticeVertexIncidentCell x (jXY + (1 : - Fin (4 : ℕ))) ∈ X.cells) → (∀ (jYZ : Fin (4 : ℕ)), (eYZ = edgeAt x jYZ) → + Fin (4 : ℕ))) ∈ X.cells) → (∀ (jYZ : Fin (4 : ℕ)), ((LatticeVertexIncidentCell x jYZ ∈ Y.cells ∧ LatticeVertexIncidentCell x (jYZ + (1 : Fin (4 : ℕ))) ∈ Z.cells ∨ LatticeVertexIncidentCell x jYZ ∈ Z.cells ∧ LatticeVertexIncidentCell x (jYZ + (1 : Fin (4 : ℕ))) ∈ Y.cells) → (∀ (jZX : Fin (4 : - ℕ)), (eZX = edgeAt x jZX) → ((LatticeVertexIncidentCell x jZX ∈ Z.cells ∧ + ℕ)), + ((LatticeVertexIncidentCell x jZX ∈ Z.cells ∧ LatticeVertexIncidentCell x (jZX + (1 : Fin (4 : ℕ))) ∈ X.cells ∨ LatticeVertexIncidentCell x jZX ∈ X.cells ∧ LatticeVertexIncidentCell x (jZX + (1 : Fin (4 : ℕ))) ∈ Z.cells) → ((jXY ≠ jYZ) → ((jYZ ≠ jZX) → ((jZX ≠ jXY) → (forall j : Fin 4, LatticeVertexIncidentCell x j ∈ X.cells ∨ LatticeVertexIncidentCell x j ∈ Y.cells ∨ LatticeVertexIncidentCell x j ∈ Z.cells))))))))) ) := by classical - intro I edgeAt X Y Z x eXY eYZ eZX jXY heXYat htXY jYZ heYZat htYZ jZX heZXat htZX hXY_YZ - hYZ_ZX hZX_XY j + intro X Y Z x eXY eYZ eZX jXY htXY jYZ htYZ jZX htZX hXY_YZ hYZ_ZX hZX_XY j have hendpoint : (j = jXY ∨ j = jXY + 1) ∨ (j = jYZ ∨ j = jYZ + 1) ∨ @@ -439,34 +437,24 @@ private theorem he' : rw [← hboundary] exact he -private theorem hf' : - (by - classical - exact - ∀ (X : ProtoTile), ∀ (Y : ProtoTile), (FootprintEdges X ∩ FootprintEdges Y = - BoundaryFootprintEdges X ∩ BoundaryFootprintEdges Y) → (∀ (f : Finset GaussianInt), - (f ∈ FootprintEdges X ∩ FootprintEdges Y) → (f ∈ BoundaryFootprintEdges X ∩ - BoundaryFootprintEdges Y)) ) := by - classical - intro X Y hboundary f hf - rw [← hboundary] - exact hf +private abbrev hf' := ApollonianSuperharmonic.InterfaceSectorGeometry.he' private theorem hjne : (by classical exact - let I : GaussianInt := ⟨0, 1⟩ + let I : GaussianInt := ⟨0, 1⟩; let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := - ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] - ∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (x : GaussianInt), ∀ (e : Finset GaussianInt), ∀ - (f : Finset GaussianInt), (e ≠ f) → (∀ (je : Fin (4 : ℕ)), (e = edgeAt x je) → (∀ (jf - : Fin (4 : ℕ)), (f = edgeAt x jf) → ((LatticeVertexIncidentCell x jf ∈ X.cells ∧ - LatticeVertexIncidentCell x (jf + (1 : Fin (4 : ℕ))) ∈ Y.cells ∨ - LatticeVertexIncidentCell x jf ∈ Y.cells ∧ LatticeVertexIncidentCell x (jf + (1 : Fin - (4 : ℕ))) ∈ X.cells) → (je ≠ jf)))) ) := by + ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}]; + ∀ (x : GaussianInt), + ∀ (e : Finset GaussianInt), + ∀ (f : Finset GaussianInt), + e ≠ f → + ∀ (je : Fin (4 : ℕ)), + e = edgeAt x je → ∀ (jf : Fin (4 : ℕ)), f = edgeAt x jf → je ≠ jf + ) := by classical - intro I edgeAt X Y x e f hef je heAt jf hfAt htf h + intro I edgeAt x e f hef je heAt jf hfAt h subst jf exact hef (heAt.trans hfAt.symm) @@ -499,21 +487,7 @@ private theorem hcheckP : intro X x hcheckX P simpa [P, LatticeVertexIncidentCell] using hcheckX -private theorem hcheckQ : - (by - classical - exact - ∀ (Y : ProtoTile), ∀ (x : GaussianInt), (¬(x ∈ (↑Y.cells : Set LatticeCell) ∧ x - (1 : - GaussianInt) - ⟨(0 : ℤ), (1 : ℤ)⟩ ∈ (↑Y.cells : Set LatticeCell) ∧ x - (1 : - GaussianInt) ∉ (↑Y.cells : Set LatticeCell) ∧ x - ⟨(0 : ℤ), (1 : ℤ)⟩ ∉ (↑Y.cells : - Set LatticeCell) ∨ x - (1 : GaussianInt) ∈ (↑Y.cells : Set LatticeCell) ∧ x - ⟨(0 : - ℤ), (1 : ℤ)⟩ ∈ (↑Y.cells : Set LatticeCell) ∧ x ∉ (↑Y.cells : Set LatticeCell) ∧ x - - (1 : GaussianInt) - ⟨(0 : ℤ), (1 : ℤ)⟩ ∉ (↑Y.cells : Set LatticeCell))) → ( - let Q : Fin 4 → Prop := fun j => LatticeVertexIncidentCell x j ∈ Y.cells - ¬ ((Q 0 ∧ Q 2 ∧ ¬ Q 1 ∧ ¬ Q 3) ∨ (Q 1 ∧ Q 3 ∧ ¬ Q 0 ∧ ¬ Q 2))) ) := by - classical - intro Y x hcheckY Q - simpa [Q, LatticeVertexIncidentCell] using hcheckY +private abbrev hcheckQ := ApollonianSuperharmonic.InterfaceSectorGeometry.hcheckP end InterfaceSectorGeometry @@ -613,13 +587,13 @@ theorem LocalLatticeInterfaceSectors : have hXYd := Finset.disjoint_left.mp hXYdisjoint have hYZd := Finset.disjoint_left.mp hYZdisjoint have hZXd := Finset.disjoint_left.mp hZXdisjoint - have hXY_YZ := InterfaceSectorGeometry.hXY_YZ X Y Z x eYZ jXY htXY jYZ heYZat htYZ hYZd hZXd - have hYZ_ZX := InterfaceSectorGeometry.hYZ_ZX X Y Z x eZX jYZ htYZ jZX heZXat htZX hXYd hYZd + have hXY_YZ := InterfaceSectorGeometry.hXY_YZ X Y Z x eYZ jXY htXY jYZ htYZ hYZd hZXd + have hYZ_ZX := InterfaceSectorGeometry.hYZ_ZX X Y Z x eZX jYZ htYZ jZX htZX hXYd hYZd hZXd - have hZX_XY := InterfaceSectorGeometry.hZX_XY X Y Z x eXY jXY heXYat htXY jYZ jZX htZX hXYd + have hZX_XY := InterfaceSectorGeometry.hZX_XY X Y Z x eXY jXY htXY jYZ jZX htZX hXYd hYZd hZXd hXY_YZ - have hexhaust := InterfaceSectorGeometry.hexhaust X Y Z x eXY eYZ eZX jXY heXYat htXY jYZ - heYZat htYZ jZX heZXat htZX hXY_YZ hYZ_ZX hZX_XY + have hexhaust := InterfaceSectorGeometry.hexhaust X Y Z x eXY eYZ eZX jXY htXY jYZ htYZ jZX + htZX hXY_YZ hYZ_ZX hZX_XY have hopposite := InterfaceSectorGeometry.hopposite X Y Z x jX hjX jY hjY jZ hjZ hXYd hYZd hZXd exact ⟨hexhaust, ⟨jX, hjX⟩, ⟨jY, hjY⟩, ⟨jZ, hjZ⟩, hopposite⟩ · intro X Y x hX hY hdisjoint hedges @@ -631,7 +605,7 @@ theorem LocalLatticeInterfaceSectors : common_edge_transition X Y x e hdisjoint hxe he' obtain ⟨jf, hfAt, htf⟩ := common_edge_transition X Y x f hdisjoint hxf hf' - have hjne : je ≠ jf := InterfaceSectorGeometry.hjne X Y x e f hef je heAt jf hfAt htf + have hjne : je ≠ jf := InterfaceSectorGeometry.hjne x e f hef je heAt jf hfAt have hd := Finset.disjoint_left.mp hdisjoint have hcheckX := (LatticeTileGridStructure X hX).2.1 x have hcheckY := (LatticeTileGridStructure Y hY).2.1 x diff --git a/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean index 0e49a0947d..0367bfd353 100644 --- a/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts public import LeanPool.ApollonianSuperharmonic.P5630T1MarkedRightOdometerAdjacencyReduction public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralSubtileSelectedRowGeometry @@ -769,64 +770,8 @@ private theorem hpSelectedEq : apply Option.some.inj rw [← hslopeSelected, ← hslope'] -private theorem centroidCov : - (by - classical - exact - ∀ (a : BandPackingSymmetry), ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (w : GaussianInt), - TileCentroid V - TileCentroid U = GaussianRealPoint w → TileCentroid - (BandPackingSymmetryTileAction a V) - TileCentroid (BandPackingSymmetryTileAction a - U) = GaussianRealPoint (BandPackingSymmetryVectorAction a w) ) := by - classical - intro a - induction a with - | identity => intro U V w hc; exact hc - | shift z => intro U V w hc; exact hc - | negate => - intro U V w hc - change TileCentroid (TileQuarterTurn V) - - TileCentroid (TileQuarterTurn U) = _ - rw [(TileQuarterTurnFormulas V).2.2.2.2.1, - (TileQuarterTurnFormulas U).2.2.2.2.1] - rcases w with ⟨wr, wi⟩ - have hc1 : (TileCentroid V).1 - (TileCentroid U).1 = wr := by - simpa [GaussianRealPoint] using congrArg Prod.fst hc - have hc2 : (TileCentroid V).2 - (TileCentroid U).2 = wi := by - simpa [GaussianRealPoint] using congrArg Prod.snd hc - apply Prod.ext - · simp [GaussianRealPoint, BandPackingSymmetryVectorAction, - GaussianQuarterTurn] at hc2 ⊢ - linarith - · simp [GaussianRealPoint, BandPackingSymmetryVectorAction, - GaussianQuarterTurn] at hc1 ⊢ - linarith - | conjugate => - intro U V w hc - change TileCentroid - (TileQuarterTurn (TileQuarterTurn (TileReflection V))) - - TileCentroid - (TileQuarterTurn (TileQuarterTurn (TileReflection U))) = _ - rw [(TileQuarterTurnFormulas (TileQuarterTurn (TileReflection V))).2.2.2.2.1, - (TileQuarterTurnFormulas (TileQuarterTurn (TileReflection U))).2.2.2.2.1, - (TileQuarterTurnFormulas (TileReflection V)).2.2.2.2.1, - (TileQuarterTurnFormulas (TileReflection U)).2.2.2.2.1, - (TileReflectionFormulas V).2.2.2.2.1, - (TileReflectionFormulas U).2.2.2.2.1] - rcases w with ⟨wr, wi⟩ - have hc1 : (TileCentroid V).1 - (TileCentroid U).1 = wr := by - simpa [GaussianRealPoint] using congrArg Prod.fst hc - have hc2 : (TileCentroid V).2 - (TileCentroid U).2 = wi := by - simpa [GaussianRealPoint] using congrArg Prod.snd hc - apply Prod.ext - · simp [GaussianRealPoint, BandPackingSymmetryVectorAction, - GaussianReflection] at hc2 ⊢ - linarith - · simp [GaussianRealPoint, BandPackingSymmetryVectorAction, - GaussianReflection] at hc1 ⊢ - linarith - | comp a b iha ihb => - intro U V w hc - exact iha _ _ _ (ihb U V w hc) +private abbrev centroidCov := + ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts.centroidTransport private theorem hinverseUnitCurv : (by @@ -1747,16 +1692,8 @@ private theorem hleftInvAt1283 : (by simpa [T', bundle.normalized_fixed_eq, htileL] using hcentLeftInv), hslopeLeftReInv, hslopeLeftImInv⟩ -private theorem hparentPositiveAt1298 : - (by - classical - exact - ∀ (C' : BandCircle), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (j : Fin (3 : ℕ)), (r - j.succ = C'.1.1) → (0 < (r j.succ).1) ) := by - classical - intro C' r j hrj - rw [hrj] - exact C'.property +private abbrev hparentPositiveAt1298 := + ApollonianSuperharmonic.MarkedAdjacencyGeometry.hparentPositiveAt344 private theorem hOfixedAt1301 : (by @@ -1914,30 +1851,7 @@ private theorem hcentOriginalAt1348 : intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv htileL selectedSupport T' r j t' hcentInv simpa [T', bundle.normalized_fixed_eq, htileL] using hcentInv -private theorem hrootCoord : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : - PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (ginv : - BandPackingSymmetry), (∀ (C : CircleCoordinates), BandPackingSymmetryCircleAction - ginv (BandPackingSymmetryCircleAction bundle.symmetry C) = C) → (∀ (r : Fin (4 : ℕ) → - CircleCoordinates), (r (0 : Fin (4 : ℕ)) = bundle.normalizedFixedCircle.1.1) → - ((BandPackingSymmetryQuadrupleAction ginv - r) 0 = Cᵢ.1.1)) ) := by - classical - intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv hcircleL r hr0 - calc - (BandPackingSymmetryQuadrupleAction ginv r) 0 = - BandPackingSymmetryCircleAction ginv (r 0) := by - simp [BandPackingSymmetryQuadrupleAction] - _ = BandPackingSymmetryCircleAction ginv - bundle.normalizedFixedCircle.1.1 := - congrArg (BandPackingSymmetryCircleAction ginv) hr0 - _ = Cᵢ.1.1 := by - rw [bundle.normalized_fixed_circle_eq] - exact hcircleL Cᵢ.1.1 +private abbrev hrootCoord := ApollonianSuperharmonic.MarkedAdjacencyGeometry.hleftRootCoord private theorem hnewAdjAt1371 : (by diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean index 9b9004a445..86abecb8c0 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.AncestorOdometerCentralCovariance @@ -56,20 +57,7 @@ private theorem hpouter_eq : have heq := hpouter.symm.trans hs₀ exact Option.some.inj heq -private theorem htranslateZero : - (by - classical - exact - ∀ (Rminus : ProtoTile), - TileTranslation Rminus (0 : GaussianInt) = Rminus) := by - classical - intro Rminus - cases Rminus with - | mk cs anchor => - have hfun : GaussianTranslation (0 : GaussianInt) = id := by - funext z - simp [GaussianTranslation] - simp [TileTranslation, hfun] +private abbrev htranslateZero := ApollonianSuperharmonic.TileTranslationProperties.zero private theorem hOminus : (by @@ -299,29 +287,44 @@ private theorem houterAffineEq : (by classical exact - ∀ (C₀ : BandCircle), ∀ (T₀' : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (h₀' : - PartialOdometer), (TileOdometer C₀.1.1 T₀' h₀') → (∀ (p₀' : Real × Real), - (PartialOdometerSlope h₀' = some p₀') → (∀ (centerShift : GaussianInt), - let hbar := PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h₀) centerShift 0 0 - (∃! u : GaussianInt, T₀'.cells = (TileTranslation T₀' u).cells ∧ (T₀'.cells = ∅ → - T₀'.anchor = (TileTranslation T₀' u).anchor) ∧ ∃ (a : GaussianInt) (b : ℤ), (∀ (x : - GaussianInt), x ∈ hbar.domain ↔ x - u ∈ h₀'.domain) ∧ ∀ x ∈ hbar.domain, hbar.value x - = h₀'.value (x - u) + a.re * x.re + a.im * x.im + b) → (∀ (touter : GaussianInt), ∀ - (couter : GaussianInt), ∀ (eouter : ℤ), (∀ (x : GaussianInt), x ∈ hbar.domain ↔ x - - touter ∈ h₀'.domain) → ((∀ x ∈ hbar.domain, hbar.value x = h₀'.value (x - touter) + - couter.re * x.re + couter.im * x.im + eouter) → ((touter = 0) → ((∀ x, x ∈ - hbar.domain ↔ x ∈ h₀'.domain) → ( - let a : GaussianInt := -couter - let b : Int := -eouter - let houterAffine := PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h₀) centerShift a b - (hbar.domain = houterAffine.domain) → ((h₀'.domain = houterAffine.domain) → (h₀' = - houterAffine))))))))) ) := by + ∀ (T₀' : ProtoTile), + ∀ (h₀ : PartialOdometer), + ∀ (h₀' : PartialOdometer), + ∀ (p₀' : Real × Real), + PartialOdometerSlope h₀' = some p₀' → + ∀ (centerShift : GaussianInt), + let hbar := + PartialOdometerAffineTranslate (PartialOdometerHalfTurn h₀) + centerShift 0 0; + (∃! u : GaussianInt, + T₀'.cells = (TileTranslation T₀' u).cells ∧ + (T₀'.cells = ∅ → T₀'.anchor = (TileTranslation T₀' u).anchor) ∧ + ∃ (a : GaussianInt) (b : ℤ), + (∀ (x : GaussianInt), + x ∈ hbar.domain ↔ x - u ∈ h₀'.domain) ∧ + ∀ x ∈ hbar.domain, + hbar.value x = + h₀'.value (x - u) + a.re * x.re + a.im * x.im + b) → + ∀ (touter : GaussianInt), + ∀ (couter : GaussianInt), + ∀ (eouter : ℤ), + (∀ x ∈ hbar.domain, + hbar.value x = + h₀'.value (x - touter) + couter.re * x.re + + couter.im * x.im + + eouter) → + touter = 0 → + let a : GaussianInt := -couter + let b : Int := -eouter + let houterAffine := + PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h₀) centerShift a b + hbar.domain = houterAffine.domain → + h₀'.domain = houterAffine.domain → h₀' = houterAffine + ) := by classical - intro C₀ T₀' h₀ h₀' hO₀' p₀' hs₀' centerShift hbar houterUnique touter couter eouter - hdomainShift hvalueShift htouterZero hbarDomains a b houterAffine hbarOuterDomain - houterAffineDomain + intro T₀' h₀ h₀' p₀' hs₀' centerShift hbar houterUnique touter couter eouter hvalueShift + htouterZero a b houterAffine hbarOuterDomain houterAffineDomain cases h₀' with | mk dom val hout => have hdom : dom = houterAffine.domain := houterAffineDomain @@ -550,25 +553,7 @@ private theorem finiteTranslationFix : have huIm : u.im = 0 := (mul_eq_zero.mp hmulIm).resolve_left hcardNe apply Zsqrtd.ext <;> assumption -private theorem hRminusBand : - (by - classical - exact - ∀ (Cᵢ : BandCircle) - (base Rminus : ProtoTile), - BandPrototile - Cᵢ.1.1 - base → - Rminus ∈ - RegularTileFamily base - (TilingLattice Cᵢ) → - BandPrototile - Cᵢ.1.1 - Rminus) := by - classical - intro Cᵢ base Rminus hbase hRminus - rcases hRminus with ⟨w, hw, rfl⟩ - exact BandPrototileTranslation Cᵢ.1.1 base w hbase +private abbrev hRminusBand := ApollonianSuperharmonic.OpposingBoundaryGeometry.hRplusBand private theorem hbackRawO : (by @@ -1040,20 +1025,19 @@ private theorem htilesLength : (by classical exact - ∀ (q : Fin 4 -> CircleCoordinates), ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), ∀ (horientationExists : ∃ o : Bool, Cᵢ.1.1.1 = 1 → - UnitOccurrenceOrientation q i o), - let orientation := Classical.choose horientationExists - ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List - ProtoTile), (BoundaryString C₀ Cᵢ i orientation T₀ base Rminus Rplus tiles) → - ((TileString Cᵢ orientation base Rminus Rplus tiles) → (∀ (centerShift : - GaussianInt), ∀ (reverseTiles : List ProtoTile), (List.Forall₂ (fun (T U : ProtoTile) - => (TileTranslation (TileHalfTurn T) centerShift).cells = U.cells) tiles - reverseTiles) → ((Rminus ≠ Rplus) → ((tiles.head? = some Rminus) → ((tiles.getLast? = + ∀ (q : Fin 4 -> CircleCoordinates), + ∀ (Cᵢ : BandCircle), ∀ (i : Fin + 3), + (∃ o : Bool, Cᵢ.1.1.1 = 1 → + UnitOccurrenceOrientation q i o) → + ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List + ProtoTile), + ( + ( + ((Rminus ≠ Rplus) → ((tiles.head? = some Rminus) → ((tiles.getLast? = some Rplus) → (2 ≤ tiles.length)))))) ) := by classical - intro q C₀ Cᵢ i T₀ horientationExists orientation base Rminus Rplus tiles hboundaryOriginal - hstring centerShift reverseTiles hcellPairs hRminusNeRplus htilesHead htilesLast + intro q Cᵢ i horientationExists Rminus Rplus tiles hRminusNeRplus htilesHead htilesLast cases tiles with | nil => simp at htilesHead | cons first rest => @@ -1830,7 +1814,8 @@ private theorem opposingBoundaryConclusion : let orientation := Classical.choose horientationExists; ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (hseed : PartialOdometer), (BoundaryString C₀ Cᵢ i orientation T₀ base - Rminus Rplus tiles) → ((Fin (4 : ℕ) → CircleCoordinates) → ((TileString Cᵢ + Rminus Rplus tiles) → ( + ((TileString Cᵢ orientation base Rminus Rplus tiles) → (∀ (centerShift : GaussianInt), ∀ (reverseTiles : List ProtoTile), (TileString Cᵢ orientation base Rplus Rminus reverseTiles) → (((TileTranslation (TileHalfTurn Rminus) centerShift).cells = @@ -1846,7 +1831,8 @@ private theorem opposingBoundaryConclusion : (TileOdometer Cᵢ.1.1 Rminus hminus) → ((PartialOdometerSlope hminus = some pminus) → ((0 < C₀.1.1.1) → ( let Tbar := TileTranslation (TileHalfTurn T₀) centerShift; - (BandPrototile C₀.1.1 T₀') → ((Tbar.cells = T₀'.cells) → ((GaussianInt) → (∀ (couter : + (BandPrototile C₀.1.1 T₀') → ((Tbar.cells = T₀'.cells) → ( + (∀ (couter : GaussianInt), ∀ (eouter : ℤ), let a : GaussianInt := -couter; let b : Int := -eouter; @@ -1900,11 +1886,11 @@ private theorem opposingBoundaryConclusion : AncestorOdometer Cᵢ.1.1 C₀.1.1 T T₀' h h₀')))))))))))))))))))))))))))))))) ) := by classical intro q hq C₀ Cᵢ i hC₀ hCᵢ T₀ T₀' h₀ h₀' hpositive p₀ horientationExists orientation base - Rminus Rplus tiles hseed hboundaryOriginal q' hstring centerShift reverseTiles hreverse + Rminus Rplus tiles hseed hboundaryOriginal hstring centerShift reverseTiles hreverse hminusCells hplusCells hcellPairs pminus pplus d hminus hOminus hsminus hC₀positive Tbar - hT₀'band houterCells touter couter eouter a b houterAffine houterAffineEq hplus hOplus - hsplus eback bplus hminusBack hminusBackEq htilesHead htilesLength hs hhsHead hhsLast - hrespect hancestorForward hlengthEq constAt transformAt gs htransform + hT₀'band houterCells couter eouter a b houterAffine houterAffineEq hplus hOplus hsplus + eback bplus hminusBack hminusBackEq htilesHead htilesLength hs hhsHead hhsLast hrespect + hancestorForward hlengthEq constAt transformAt gs htransform have hgsHead := OpposingBoundaryGeometry.hgsHead q i hseed centerShift couter eouter eback hs hhsHead have hgsLast := (show @@ -2183,9 +2169,9 @@ theorem OpposingBoundaryOdometerStrings let houterAffine := PartialOdometerAffineTranslate (PartialOdometerHalfTurn h₀) centerShift a b have hbarOuterDomain := OpposingBoundaryGeometry.hbarOuterDomain h₀ centerShift couter eouter - have houterAffineEq : h₀' = houterAffine := OpposingBoundaryGeometry.houterAffineEq C₀ T₀' h₀ - h₀' hO₀' p₀' hs₀' centerShift houterUnique touter couter eouter hdomainShift hvalueShift - htouterZero hbarDomains hbarOuterDomain (OpposingBoundaryGeometry.houterAffineDomain h₀ h₀' + have houterAffineEq : h₀' = houterAffine := OpposingBoundaryGeometry.houterAffineEq T₀' h₀ + h₀' p₀' hs₀' centerShift houterUnique touter couter eouter hvalueShift + htouterZero hbarOuterDomain (OpposingBoundaryGeometry.houterAffineDomain h₀ h₀' centerShift couter eouter hbarDomains hbarOuterDomain) have haSlope : p₀ + p₀' = GaussianRealPoint a := OpposingBoundaryGeometry.haSlope p₀ p₀' couter (Option.some.inj ((OpposingBoundaryGeometry.houterSlope h₀ p₀ centerShift couter eouter @@ -2258,8 +2244,8 @@ theorem OpposingBoundaryOdometerStrings Rplus tiles hstring have htilesLast := OpposingBoundaryGeometry.htilesLast q Cᵢ i horientationExists base Rminus Rplus tiles hstring - have htilesLength := OpposingBoundaryGeometry.htilesLength q C₀ Cᵢ i T₀ horientationExists base - Rminus Rplus tiles hboundaryOriginal hstring centerShift reverseTiles hcellPairs + have htilesLength := OpposingBoundaryGeometry.htilesLength q Cᵢ i horientationExists + Rminus Rplus tiles (OpposingBoundaryGeometry.hRminusNeRplus i Rminus Rplus q' (OpposingBoundaryGeometry.hcentroidEndpoints i T₀ Rminus Rplus q' hcentroidMinus hcentroidPlus) hvectorNe (OpposingBoundaryGeometry.hgaussianPointZero)) htilesHead htilesLast @@ -2278,9 +2264,9 @@ theorem OpposingBoundaryOdometerStrings have transformForall := OpposingBoundaryGeometry.transformForall centerShift couter eouter eback hs exact (OpposingBoundaryConclusion.opposingBoundaryConclusion q hq C₀ Cᵢ i hC₀ hCᵢ T₀ T₀' h₀ h₀' - hpositive p₀ horientationExists base Rminus Rplus tiles hseed hboundaryOriginal q' hstring + hpositive p₀ horientationExists base Rminus Rplus tiles hseed hboundaryOriginal hstring centerShift reverseTiles hreverse hminusCells hplusCells hcellPairs hOminus hsminus - hC₀positive hT₀'band houterCells touter couter eouter houterAffineEq hOplus hsplus eback + hC₀positive hT₀'band houterCells couter eouter houterAffineEq hOplus hsplus eback hminusBackEq htilesHead htilesLength hs hhsHead hhsLast hrespect hancestorForward hlengthEq (OpposingBoundaryGeometry.htransform centerShift couter eouter eback hs transformForall)) diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean index 962dac562b..355b8684eb 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryStarLocalization.lean @@ -38,17 +38,7 @@ private theorem hxT0 : rw [← hdomain0] exact hx0 -private theorem hxT0' : - (by - classical - exact - ∀ (T0' : ProtoTile), ∀ (h0' : PartialOdometer), ∀ (x : GaussianInt), (x ∈ h0'.domain) → - (((↑h0'.domain : Set GaussianInt) = FootprintVertices T0') → (x ∈ FootprintVertices - T0')) ) := by - classical - intro T0' h0' x hx0' hdomain0' - rw [← hdomain0'] - exact hx0' +private abbrev hxT0' := ApollonianSuperharmonic.OpposingStarGeometry.hxT0 private theorem hxPath : (by @@ -133,16 +123,7 @@ private theorem vertexToG : have hs : z ∈ (g.domain : Set GaussianInt) := by rw [hdomU]; exact hz simpa using hs -private theorem vertexToK : - (by - classical - exact - ∀ (V : ProtoTile), ∀ (k : PartialOdometer), ((↑k.domain : Set GaussianInt) = - FootprintVertices V) → (∀ z, z ∈ FootprintVertices V → z ∈ k.domain) ) := by - classical - intro V k hdomV z hz - have hs : z ∈ (k.domain : Set GaussianInt) := by rw [hdomV]; exact hz - simpa using hs +private abbrev vertexToK := ApollonianSuperharmonic.OpposingStarGeometry.vertexToG private theorem hcover : (by @@ -236,19 +217,7 @@ private theorem hPU : rw [hPtile] simpa [uIdx] using hUeq.symm -private theorem hPV : - (by - classical - exact - ∀ (Ci : BandCircle), ∀ (base : ProtoTile), ∀ (V : ProtoTile), ∀ (v : GaussianInt), ∀ (hvL - : v ∈ TilingLattice Ci), (V = TileTranslation base v) → ( - let vIdx : TilingLattice Ci := ⟨v, hvL⟩ - ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (u : ↥(TilingLattice Ci)), P.tile u = - TileTranslation base (↑u : GaussianInt)) → (P.tile vIdx = V)) ) := by - classical - intro Ci base V v hvL hVeq vIdx P hPtile - rw [hPtile] - simpa [vIdx] using hVeq.symm +private abbrev hPV := ApollonianSuperharmonic.OpposingStarGeometry.hPU private theorem hidxNe : (by @@ -508,16 +477,7 @@ private theorem hcentU : intro base U u hUeq rw [hUeq, (TileTranslationFormulas base u).2.2.2.2.1] -private theorem hcentV : - (by - classical - exact - ∀ (base : ProtoTile), ∀ (V : ProtoTile), ∀ (v : GaussianInt), (V = TileTranslation base - v) → (TileCentroid V = ((TileCentroid base).1 + (v.re : ℝ), (TileCentroid base).2 + - (v.im : ℝ))) ) := by - classical - intro base V v hVeq - rw [hVeq, (TileTranslationFormulas base v).2.2.2.2.1] +private abbrev hcentV := ApollonianSuperharmonic.OpposingStarGeometry.hcentU private theorem hcentUV : (by diff --git a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean index 1d137f2a10..9e4c23c10f 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean @@ -140,23 +140,7 @@ private theorem forwardInterior : intro base forward a b tileAt F forall₂_interior forall₂_mem z hz exact forall₂_mem forall₂_interior z hz -private theorem reverseInterior : - (by - classical - exact - ∀ (base : ProtoTile), ∀ (reverse : List ProtoTile), ∀ (a : GaussianInt), ∀ (b : - GaussianInt), - let tileAt : Int × Int → ProtoTile := fun z => - TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) - ∀ (G : List (ℤ × ℤ)), (List.Forall₂ (fun (T : ProtoTile) (z : ℤ × ℤ) => T = (fun (z : ℤ × - ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) z) - (List.drop (1 : ℕ) reverse).dropLast (List.drop (1 : ℕ) G).dropLast) → ((∀ - {α : Type}, ∀ {β : Type}, ∀ {Rel : α → β → Prop}, ∀ {xs : List α}, ∀ {ys : List β}, - (List.Forall₂ Rel xs ys) → (∀ z ∈ ys, ∃ x ∈ xs, Rel x z)) → (∀ (z : Int × Int), (z ∈ - (G.drop 1).dropLast) → (∃ T ∈ (reverse.drop 1).dropLast, T = tileAt z))) ) := by - classical - intro base reverse a b tileAt G rfor₂_interior forall₂_mem z hz - exact forall₂_mem rfor₂_interior z hz +private abbrev reverseInterior := ApollonianSuperharmonic.OpposingInterfaceGeometry.forwardInterior private theorem hshift : (by @@ -796,22 +780,7 @@ private theorem hRrho : rw [← htileXi r, ← hir] exact PP.rho_common (faceAt f0) ir -private theorem hSrho : - (by - classical - exact - ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), - let tileAt : Int × Int → ProtoTile := fun z => - TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) - ∀ (s : ℤ × ℤ), ∀ (ι : Type), ∀ (PP : PeriodicTileComplex ι), ∀ (xi : ℤ × ℤ → ι), ∀ - (faceAt : AffineTriangularFace → PP.plane.Face), (∀ (z : ℤ × ℤ), PP.tile (xi z) = - tileAt z) → (∀ (g0 : AffineTriangularFace), ∀ (is : Fin (3 : ℕ)), - (PP.plane.faceVertex (faceAt g0) is = xi s) → (PP.rho (faceAt g0) ∈ FootprintVertices - (tileAt s))) ) := by - classical - intro base a b tileAt s ι PP xi faceAt htileXi g0 is his - rw [← htileXi s, ← his] - exact PP.rho_common (faceAt g0) is +private abbrev hSrho := ApollonianSuperharmonic.OpposingInterfaceGeometry.hRrho private theorem htileAlign : (by @@ -1208,8 +1177,9 @@ private theorem unrotatedInterface : exact ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (R : ProtoTile), ∀ (S : ProtoTile), ∀ (forward : List ProtoTile), ∀ (reverse : List ProtoTile), ∀ (a : - GaussianInt), ∀ (b : GaussianInt), ((0 : ℤ) < a.re * b.im - a.im * b.re) → ((a ∈ - TilingLattice C) → ((b ∈ TilingLattice C) → ((∀ (w : ↥(TilingLattice C)), ∃! z : ℤ × + GaussianInt), ∀ (b : GaussianInt), ((0 : ℤ) < a.re * b.im - a.im * b.re) → ( + ( + ((∀ (w : ↥(TilingLattice C)), ∃! z : ℤ × ℤ, (↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b = (↑w : GaussianInt)) → ((∀ (U : ProtoTile), U ∈ RegularTileFamily base (TilingLattice C) ↔ ∃! z : ℤ × ℤ, U = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) @@ -1218,20 +1188,8 @@ private theorem unrotatedInterface : TileCentroid T = GaussianRealPoint v else TileTouching T U) ((fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) x) ((fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) - * b)) y) ↔ TriangularLatticeAdjacent x y) → ((∀ (x : ℤ × ℤ), ∀ (y : ℤ × ℤ), ∀ (z : ℤ - × ℤ), ((TileCentroid ((fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) - * a + (↑z.2 : GaussianInt) * b)) z)).2 - (TileCentroid ((fun (z : ℤ × ℤ) => - TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) x)).2) * - ((TileCentroid ((fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + - (↑z.2 : GaussianInt) * b)) y)).1 - (TileCentroid ((fun (z : ℤ × ℤ) => TileTranslation - base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) x)).1) - ((TileCentroid - ((fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : - GaussianInt) * b)) z)).1 - (TileCentroid ((fun (z : ℤ × ℤ) => TileTranslation base - ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) x)).1) * ((TileCentroid ((fun - (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) - * b)) y)).2 - (TileCentroid ((fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : - GaussianInt) * a + (↑z.2 : GaussianInt) * b)) x)).2) = (↑(a.re * b.im - a.im * b.re) - : ℝ) * (↑(TriangularSignedHeight x y z) : ℝ)) → ((∀ (R : ProtoTile), ∀ (S : + * b)) y) ↔ TriangularLatticeAdjacent x y) → ( + ((∀ (R : ProtoTile), ∀ (S : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (r : ℤ × ℤ), ∀ (s : ℤ × ℤ), R = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b)) r → S = (fun (z : ℤ × ℤ) => TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : @@ -1274,10 +1232,9 @@ private theorem unrotatedInterface : (forward.drop 1).dropLast, {x, y} ∈ FootprintEdges a) ∧ (∃ b ∈ (reverse.drop 1).dropLast, {x, y} ∈ FootprintEdges b)))))))))))))))))))))))))))) ) := by classical - intro C orientation base R S forward reverse a b hdet ha hb hcoords hfamily hadj hheight - htransport tileAt r hrcoord hruniq s hscoord hsuniq hR hS F G hFtiles hFstrip hGtiles - hGstrip hrs hnadjCoord forall₂_interior rfor₂_interior forwardInterior reverseInterior x - hcells ha1 hb1 + intro C orientation base R S forward reverse a b hdet hcoords hfamily hadj htransport tileAt r + hrcoord hruniq s hscoord hsuniq hR hS F G hFtiles hFstrip hGtiles hGstrip hrs hnadjCoord + forall₂_interior rfor₂_interior forwardInterior reverseInterior x hcells ha1 hb1 subst a subst b obtain ⟨p, hphead, hplast, hpchain, hpvertices, hpedges⟩ := @@ -1421,8 +1378,8 @@ theorem OpposingStringInterfacePath {x, y} ∈ FootprintEdges a) ∧ (∃ b ∈ (reverse.drop 1).dropLast, {x, y} ∈ FootprintEdges b) := OpposingUnitInterface.unrotatedInterface C - orientation base R S forward reverse a b hdet ha hb hcoords hfamily hadj - hheight htransport r hrcoord hruniq s hscoord hsuniq hR hS F G hFtiles + orientation base R S forward reverse a b hdet hcoords hfamily hadj + htransport r hrcoord hruniq s hscoord hsuniq hR hS F G hFtiles hFstrip hGtiles hGstrip hrs hnadjCoord forall₂_interior rfor₂_interior forwardInterior reverseInterior x hcells ha1 hb1 exact unrotatedInterface diff --git a/LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean b/LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean index 55590a2c54..1be624c67e 100644 --- a/LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/OrderedGeneralOdometerAdjacencyClassification.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryDomainTransport public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryMarkedDataCovariance @@ -237,22 +238,7 @@ private theorem hedgeg : · rw [edges]; exact ⟨edge, hleft, rfl⟩ · rw [edges]; exact ⟨edge, hright, rfl⟩ -private theorem hgsubAt347 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T₀ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (C' : BandCircle), ∀ - (T' : ProtoTile), ∀ (h' : PartialOdometer), (TileSubodometer C.1.1 C'.1.1 T₀ T' h₀ - h') → (∀ (g : BandPackingSymmetry), - ∀ (Cg : BandCircle), (Cg.1.1 = BandPackingSymmetryCircleAction g C.1.1) → (∀ (Dg : - BandCircle), (Dg.1.1 = BandPackingSymmetryCircleAction g C'.1.1) → (TileSubodometer - Cg.1.1 Dg.1.1 (BandPackingSymmetryTileAction - g T₀) (BandPackingSymmetryTileAction g T') (BandPackingSymmetryPartialOdometerAction - g h₀) (BandPackingSymmetryPartialOdometerAction g h')))) ) := by - classical - intro C T₀ h₀ C' T' h' hsub g Cg hCg Dg hDg - rw [hCg, hDg] - exact (BandPackingSymmetryMarkedDataCovariance.1 g _ _ _ _ _ _).mp hsub +private abbrev hgsubAt347 := ApollonianSuperharmonic.OdometerAdjacencyGeometry.hgsubAt296 private theorem heqOrig : (by @@ -276,18 +262,12 @@ private theorem hab : (by classical exact - ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ : PartialOdometer), - ∀ (g : BandPackingSymmetry), ∀ (qbar : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : - BandOrderedGeneralConfiguration qbar), ∀ (Cg : BandCircle), ∀ (Ig : BandCircle), ∀ - (cert : BandOrderedGeneralLayoutCertificate qbar cfg Cg - (BandPackingSymmetryTileAction g T₀)), ∀ (a : PeriodicSubtileIndex), (a ∈ - P4261T1ExteriorIndices) → ((P4261T1PlacedOdometer cert - (BandPackingSymmetryPartialOdometerAction g h₀) Ig (BandPackingSymmetryTileAction g - T) (BandPackingSymmetryPartialOdometerAction g h) a) → (∀ (b : PeriodicSubtileIndex), - (b.first = (0 : ℤ)) → ((b.second = (0 : ℤ)) → ((¬AllowedSubtileIncidence a b) → (a ≠ - b))))) ) := by + ∀ (a : PeriodicSubtileIndex), + a ∈ P4261T1ExteriorIndices → + ∀ (b : PeriodicSubtileIndex), b.first = (0 : ℤ) → b.second = (0 : ℤ) → a ≠ b + ) := by classical - intro T T₀ h h₀ g qbar cfg Cg Ig cert a ha pa b hb₁ hb₂ hinc heq + intro a ha b hb₁ hb₂ heq have hzero : a.first = 0 ∧ a.second = 0 := by simpa [heq] using And.intro hb₁ hb₂ have ha' := ha simp only [P4261T1ExteriorIndices, Finset.mem_insert, Finset.mem_singleton] at ha' @@ -315,18 +295,7 @@ private theorem hsmall : · rw [hempty]; exact Set.subsingleton_empty · exact hsmall -private theorem forward : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (f : PartialOdometer), ∀ (z : GaussianInt), (z ∈ f.domain) - → (BandPackingSymmetryVectorAction g z ∈ (BandPackingSymmetryPartialOdometerAction g - f).domain) ) := by - classical - intro g f z hz - change _ ∈ ((BandPackingSymmetryPartialOdometerAction g f).domain : Set GaussianInt) - rw [(BandPackingSymmetryPartialOdometerActionFormulas g f f).1] - exact ⟨z, hz, rfl⟩ +private abbrev forward := ApollonianSuperharmonic.BandPackingSymmetryDomainTransport.forward end OdometerAdjacencyGeometry @@ -487,8 +456,8 @@ theorem OrderedGeneralOdometerAdjacencyClassification : have back := transportS ginv Dg Ig C' Cᵢ hbackD hbackI _ _ _ _ hreverse simpa only [htile, hfun] using back · -- A nonledger contact stays a raw subsingleton, not a reversed adjacency. - have hab : a ≠ b := OdometerAdjacencyGeometry.hab T T₀ h h₀ g qbar cfg Cg Ig cert a ha pa b - hb₁ hb₂ hinc + have hab : a ≠ b := OdometerAdjacencyGeometry.hab a ha b + hb₁ hb₂ have hraw := (BandOriginalOccurrenceIntersectionClassification qbar cfg Cg (BandPackingSymmetryTileAction g T₀) cert a b hab).2 hinc have hsmall : ((FootprintVertices diff --git a/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean index 855e1e251a..47eac73b2d 100644 --- a/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean +++ b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique @@ -2468,20 +2469,7 @@ private theorem centered_back_displacement : apply Prod.ext <;> norm_num [GaussianRealPoint] <;> linarith only [hc.1,hc.2,hd.1,hd.2,hvp.1,hvp.2] -private theorem point_injective : - (by - classical - exact - Function.Injective GaussianRealPoint ) := by - classical - intro x y h - apply Zsqrtd.ext - · have hr := congrArg Prod.fst h - change (x.re : Real) = (y.re : Real) at hr - exact_mod_cast hr - · have hi := congrArg Prod.snd h - change (x.im : Real) = (y.im : Real) at hi - exact_mod_cast hi +private abbrev point_injective := ApollonianSuperharmonic.GaussianRealPointProperties.injective private theorem first_requested : (by diff --git a/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean index 28d4b4f0db..2ac1f31837 100644 --- a/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean @@ -6,6 +6,9 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.P4055T1GridPathImage +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.ExactTileInterfaceTriple @@ -844,41 +847,7 @@ private theorem halfTurnComparison : have obs := BandPrototileCentroidUnique C Ysharp U hband hU hcentEq exact ⟨hc.trans obs.1, fun he => (ha he).trans (obs.2 (hc ▸ he))⟩ -private theorem pathMap : - (by - classical - exact - ∀ (f : GaussianInt → GaussianInt), (Function.Injective f) → ((∀ a b : GaussianInt, - (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → - (f b = f a + 1 ∨ f b = f a - 1 ∨ - f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩)) → (∀ (V : Set GaussianInt), ∀ (E : Set - (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (y : GaussianInt), - (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween (f '' V) ((fun e : - Finset GaussianInt => e.image f) '' E) (f x) (f y)))) ) := by - classical - intro f hf hstep V E x y h - rcases h with ⟨p, hn, hl, hh, ht, hv, hs, he⟩ - refine ⟨p.map f, hn.map hf, by simpa using hl, ?_, ?_, ?_, ?_, ?_⟩ - · rw [List.head?_map, hh]; rfl - · rw [List.getLast?_map, ht]; rfl - · rw [hv]; ext z; simp - · exact List.isChain_iff_forall_rel_of_append_cons_cons.mp - (List.isChain_map_of_isChain f hstep - (List.isChain_iff_forall_rel_of_append_cons_cons.mpr hs)) - · intro e - constructor - · rintro ⟨d, hd, rfl⟩ - rcases (he d).mp hd with ⟨a, b, l₁, l₂, hp, rfl⟩ - refine ⟨f a, f b, l₁.map f, l₂.map f, ?_, ?_⟩ - · simpa using congrArg (List.map f) hp - · simp - · rintro ⟨a, b, l₁, l₂, hp, rfl⟩ - obtain ⟨k, r, hkr, hk, hr⟩ := List.map_eq_append_iff.mp hp - obtain ⟨a₀, r₁, hr₁, ha, hm₁⟩ := List.map_eq_cons_iff.mp hr - obtain ⟨b₀, r₂, hr₂, hb, hm₂⟩ := List.map_eq_cons_iff.mp hm₁ - refine ⟨{a₀, b₀}, (he _).mpr ⟨a₀, b₀, k, r₂, ?_, rfl⟩, ?_⟩ - · rw [hkr, hr₁, hr₂] - · simp [ha, hb] +private abbrev pathMap := ApollonianSuperharmonic.P4055T1GridPathImage private theorem tripleMap : (by @@ -991,16 +960,7 @@ private theorem tripleTurn : rw [Finset.image_image] rfl -private theorem translateZero : - (by - classical - exact - ∀ (Y : ProtoTile), TileTranslation Y 0 = Y ) := by - classical - intro Y - have h : GaussianTranslation 0 = id := by funext z; simp [GaussianTranslation] - cases Y - simp [TileTranslation, h] +private abbrev translateZero := ApollonianSuperharmonic.TileTranslationProperties.zero private theorem turnTranslate : (by @@ -1728,15 +1688,7 @@ private theorem halfPackage : exact add_right_cancel (hl.symm.trans (h.trans he)) exact ⟨D', L', E', hp', hn', endpointRelations _ _ _ _ D' L' E' hp' hn'⟩ -private theorem realAdd : - (by - classical - exact - ∀ (a : GaussianInt), ∀ (b : GaussianInt), GaussianRealPoint (a + b) = GaussianRealPoint a - + GaussianRealPoint b ) := by - classical - intro a b - ext <;> simp [GaussianRealPoint] +private abbrev realAdd := ApollonianSuperharmonic.GaussianRealPointProperties.add private theorem realSub : (by diff --git a/LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean index 102ac62b3b..6b6cf00aba 100644 --- a/LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P3381T1TriangulationBoundary.lean @@ -479,28 +479,61 @@ private theorem hnotAt427 : linarith private theorem hNX : - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (X : Set (Real × Real)), ∀ (K : Set (Real - × Real)), ∀ (t : P3381T1PairedTriangulation p X K), ∀ (k : Fin t.count), ∀ (b : Fin - t.count → ℝ × ℝ → Fin (3 : ℕ) → ℝ), (∀ (k : Fin t.count), ∀ (z : ℝ × ℝ), z ∈ (convexHull - ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (Set.range (p.vertex ∘ t.face k)) ↔ ∀ (j : Fin (3 : ℕ)), - (0 : ℝ) ≤ b k z j) → ((∀ (a : Fin 3), ∀ (b : Fin 3), ∀ (c : Fin 3), (a ≠ b) → ((a ≠ - c) → ((b ≠ c) → (∀ j, j = - a ∨ j = b ∨ j = c)))) → (∀ (i : Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), ∀ (u : ℝ), - let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex j - ∀ (l : Fin t.count), ∀ (a : Fin (3 : ℕ)), ∀ (d : Fin (3 : ℕ)), ∀ (c : Fin (3 : ℕ)), (t.face k - a = i) → ((t.face k d = j) → ((a ≠ d) → ((a ≠ c) → ((d ≠ c) → ((b k z a = (1 : ℝ) - u) → - ((b k z d = u) → ((b k z c = (0 : ℝ)) → (∀ (e : Fin (3 : ℕ)), ∀ (f : Fin (3 : ℕ)), ∀ (g : - Fin (3 : ℕ)), (t.face l e = i) → ((t.face l f = j) → ((e ≠ f) → ((e ≠ g) → ((f ≠ g) → - ((b - l z e = (1 : ℝ) - u) → ((b l z f = u) → ((b l z g = (0 : ℝ)) → ((b l (p.vertex (t.face k - c)) g < (0 : ℝ)) → ((b l (p.vertex (t.face k a)) g = 0) → ((b l (p.vertex (t.face k d)) g - = 0) → ((∀ y, b l y g = b k y c * b l (p.vertex (t.face k c)) g) → ( - let N : Set (Real × Real) := - {y | 0 < b k y a ∧ 0 < b k y d} ∩ {y | 0 < b l y e ∧ 0 < b l y f} - (IsOpen N) → ((z ∈ N) → (N ⊆ X)))))))))))))))))))))))) := by + ∀ (n : Nat), + ∀ (p : P3381T1PolygonBoundary n), + ∀ (X : Set (Real × Real)), + ∀ (K : Set (Real × Real)), + ∀ (t : P3381T1PairedTriangulation p X K), + ∀ (k : Fin t.count), + ∀ (b : Fin t.count → ℝ × ℝ → Fin (3 : ℕ) → ℝ), + (∀ (k : Fin t.count), + ∀ (z : ℝ × ℝ), + z ∈ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + (Set.range (p.vertex ∘ t.face k)) ↔ + ∀ (j : Fin (3 : ℕ)), (0 : ℝ) ≤ b k z j) → + (∀ (a : Fin 3), + ∀ (b : Fin 3), + ∀ (c : Fin 3), + a ≠ b → a ≠ c → b ≠ c → ∀ j, j = a ∨ j = b ∨ j = c) → + ∀ (i : Fin (n + (3 : ℕ))), + ∀ (j : Fin (n + (3 : ℕ))), + ∀ (u : ℝ), + let z : Real × Real := (1 - u) • p.vertex i + u • p.vertex j; + ∀ (l : Fin t.count), + ∀ (a : Fin (3 : ℕ)), + ∀ (d : Fin (3 : ℕ)), + ∀ (c : Fin (3 : ℕ)), + t.face k a = i → + t.face k d = j → + a ≠ d → + a ≠ c → + d ≠ c → + b k z a = (1 : ℝ) - u → + b k z d = u → + b k z c = (0 : ℝ) → + ∀ (e : Fin (3 : ℕ)), + ∀ (f : Fin (3 : ℕ)), + ∀ (g : Fin (3 : ℕ)), + t.face l e = i → + t.face l f = j → + e ≠ f → + e ≠ g → + f ≠ g → + b l z e = (1 : ℝ) - u → + b l z f = u → + b l z g = (0 : ℝ) → + b l (p.vertex (t.face k c)) g < (0 : ℝ) → + b l (p.vertex (t.face k a)) g = 0 → + b l (p.vertex (t.face k d)) g = 0 → + (∀ y, b l y g = b k y c * b l (p.vertex (t.face k c)) g) → + let N : Set (Real × Real) := + {y | 0 < b k y a ∧ 0 < b k y d} ∩ + {y | 0 < b l y e ∧ 0 < b l y f}; + N ⊆ X := by classical - intro n p X K t k b bhull indices i j u z l a d c hka hkd had hac hdc hza hzd hzc e f g hle hlf - hef heg hfg hze hzf hzg hnegative hlga hlgd relation N hN hzN y hy + intro n p X K t k b bhull indices i j u z l a d c hka hkd had hac hdc hza hzd hzc e f g hle + hlf hef heg hfg hze hzf hzg hnegative hlga hlgd relation N y hy rw [t.source_cover] by_cases hc : 0 ≤ b k y c · refine Set.mem_iUnion.mpr ⟨k, (bhull k y).mpr ?_⟩ @@ -1453,7 +1486,7 @@ theorem P3381T1TriangulationBoundary {n : Nat} exact ⟨⟨sub_pos.mpr hu.2, hu.1⟩, ⟨sub_pos.mpr hu.2, hu.1⟩⟩ have hNX := TriangulationBoundaryProof.hNX n p X K t k b bhull indices i j u l a d c hka hkd had hac hdc hza hzd hzc e f g hle hlf hef heg hfg hze hzf hzg hnegative hlga - hlgd relation hN hzN + hlgd relation have hzint : z ∈ interior X := (hN.subset_interior_iff.mpr hNX) hzN simp only [hneighbor, not_false_eq_true, iff_true] exact hzint diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean index 8ecdbfac01..8795bb54f0 100644 --- a/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintVertexDegreeTwo public import LeanPool.ApollonianSuperharmonic.P5620T1BoundaryComponentCycle @@ -744,16 +745,7 @@ private theorem vertex_rational (gridPath : List GaussianInt) (gridPath_length_f refine ⟨((v i).re : Rat), ((v i).im : Rat), ?_⟩ simp only [GaussianRealPoint, Rat.cast_intCast] -private theorem point_injective : Function.Injective GaussianRealPoint := by - classical - intro a b hab - apply Zsqrtd.ext - · have h := congrArg Prod.fst hab - change (a.re : Real) = (b.re : Real) at h - exact_mod_cast h - · have h := congrArg Prod.snd hab - change (a.im : Real) = (b.im : Real) at h - exact_mod_cast h +private abbrev point_injective := ApollonianSuperharmonic.GaussianRealPointProperties.injective private theorem v_adj (gridPath : List GaussianInt) (y : GaussianInt) (x : GaussianInt) (gridPath_head : gridPath.head? = some x) (gridPath_last : gridPath.getLast? = some y) diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean index 7e996303fa..67e44a1ca3 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean @@ -1133,26 +1133,7 @@ private theorem hxoldAt785 : simp only [faceUnion, Set.mem_iUnion, Finset.mem_coe] exact ⟨F, hF, hxParent⟩ -private theorem hxoldAt793 : - (by - classical - exact - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : - P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set - (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), - let c := P3523T1InsertionConstruction s t - ∀ (F : Finset (Fin (n + (3 : ℕ)))), - let faceUnion (v : Fin (n + 3) → Real × Real) - (faces : Finset (Finset (Fin (n + 3)))) : Set (Real × Real) := - ⋃ F ∈ (faces : Set (Finset (Fin (n + 3)))), - convexHull Real (v '' (F : Set (Fin (n + 3)))) - ∀ (v : Fin (n + (3 : ℕ)) → ℝ × ℝ), ∀ (h : ℕ), ∀ (x : ℝ × ℝ), (F ∈ c.faces h) → ((x ∈ - (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) (v '' (↑F : Set (Fin (n + (3 : ℕ)))))) → - (x ∈ faceUnion v (c.faces h))) ) := by - classical - intro r n q p s X K t c F faceUnion v h x hF hxG - simp only [faceUnion, Set.mem_iUnion, Finset.mem_coe] - exact ⟨F, hF, hxG⟩ +private abbrev hxoldAt793 := ApollonianSuperharmonic.FacialInsertionGeometry.hxoldAt785 private theorem hchildrenAt804 : (by @@ -1917,53 +1898,11 @@ private theorem hdGactual : intro r n q p s X K t c h G hh e G₀ hGsame hdG hd exact hdG (hGsame ▸ hd) -private theorem hnotFactual : - (by - classical - exact - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : - P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set - (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), - let c := P3523T1InsertionConstruction s t - ∀ (h : ℕ), ∀ (F : Finset (Fin (n + (3 : ℕ)))), ∀ (hh : h < c.steps.length), - let e := c.steps.get ⟨h, hh⟩ - ∀ (F₀ : Finset (Fin (n + (3 : ℕ)))), (¬(e.1 ∈ F₀ ∧ e.2.2 ∈ F₀)) → ((F = F₀) → (¬ (e.1 ∈ F - ∧ e.2.2 ∈ F))) ) := by - classical - intro r n q p s X K t c h F hh e F₀ hnotF hFsame hit - exact hnotF ⟨hFsame ▸ hit.1, hFsame ▸ hit.2⟩ +private abbrev hnotFactual := ApollonianSuperharmonic.FacialInsertionGeometry.hnotGactual -private theorem hdF : - (by - classical - exact - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : - P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set - (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), - let c := P3523T1InsertionConstruction s t - ∀ (h : ℕ), ∀ (hh : h < c.steps.length), - let e := c.steps.get ⟨h, hh⟩ - (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.1 ∉ - (P3523T1InsertionConstruction s t).vertices h) → (∀ (F₀ : Finset (Fin (n + (3 : - ℕ)))), (F₀ ⊆ (P3523T1InsertionConstruction s t).vertices h) → (e.2.1 ∉ F₀)) ) := by - classical - intro r n q p s X K t c h hh e hdV F₀ hF₀subset hd - exact hdV (hF₀subset hd) +private abbrev hdF := ApollonianSuperharmonic.FacialInsertionGeometry.hdG -private theorem hdFactual : - (by - classical - exact - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : - P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set - (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), - let c := P3523T1InsertionConstruction s t - ∀ (h : ℕ), ∀ (F : Finset (Fin (n + (3 : ℕ)))), ∀ (hh : h < c.steps.length), - let e := c.steps.get ⟨h, hh⟩ - ∀ (F₀ : Finset (Fin (n + (3 : ℕ)))), (F = F₀) → ((e.2.1 ∉ F₀) → (e.2.1 ∉ F)) ) := by - classical - intro r n q p s X K t c h F hh e F₀ hFsame hdF hd - exact hdF (hFsame ▸ hd) +private abbrev hdFactual := ApollonianSuperharmonic.FacialInsertionGeometry.hdGactual private theorem enumUnion : (by diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean index adbc4c498f..2335f9b359 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import Mathlib.Tactic.TypeStar public import LeanPool.ApollonianSuperharmonic.P3523T1OrderedInsertion public import LeanPool.ApollonianSuperharmonic.P3523T1FaceEnumeration @@ -1565,26 +1566,9 @@ private theorem hvertex0_start : rcases Finset.mem_image.mp hx with ⟨i, -, hi⟩ exact ⟨i, hi⟩ -private theorem pair_filter_card_symmetry : - (by - classical - exact - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : - P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set - (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), - let c := P3523T1InsertionConstruction s t - let fs := c.faces c.steps.length - let f := P3523T1FaceEnumeration fs - ((∀ h : Nat, h ≤ c.steps.length → ∀ a b : Fin (n + 3), a ≠ b → ((c.faces h).filter (fun F - => a ∈ F ∧ b ∈ F)).card = if {a, b} ∈ c.boundary h then 1 else if ∃ F ∈ c.faces h, a - ∈ F ∧ b ∈ F then 2 else 0) → (∀ (i : Fin (n + 3)), ∀ (j : Fin (n + 3)), (i ≠ j) → - (Set.ncard {k : Fin fs.card | i ∈ Set.range (f k) ∧ j ∈ Set.range (f k)} = if j = i + - 1 ∨ i = j + 1 then 1 else if ∃ k, i ∈ Set.range (f k) ∧ j ∈ Set.range (f k) then 2 - else 0))) → (∀ (A : Finset (Finset (Fin (n + (3 : ℕ))))), ∀ (x : Fin (n + (3 : ℕ))), - ∀ (y : Fin (n + (3 : ℕ))), {F ∈ A | x ∈ F ∧ y ∈ F}.card = {F ∈ A | y ∈ F ∧ x ∈ - F}.card) ) := by - classical - intro r n q p s X K t c fs f hindexed_ledger A x y +private theorem pair_filter_card_symmetry {α : Type*} [DecidableEq α] + (A : Finset (Finset α)) (x y : α) : + {F ∈ A | x ∈ F ∧ y ∈ F}.card = {F ∈ A | y ∈ F ∧ x ∈ F}.card := by congr 1 ext F simp only [Finset.mem_filter] @@ -1741,8 +1725,7 @@ theorem P3523T1InsertionIncidence {r n : Nat} (hxd : x ≠ d) (hyd : y ≠ d) := InsertionIncidenceProof.old_boundary_membership n B a b d x y hxd hyd have pair_filter_card_symmetry (A : Finset (Finset (Fin (n + 3)))) (x y : Fin (n + 3)) := - InsertionDetails.pair_filter_card_symmetry r - n q p s X K t hindexed_ledger A x y + InsertionDetails.pair_filter_card_symmetry A x y have old_pair_ledger_transfer (old new : Nat) (onBoundary removed : Prop) [Decidable onBoundary] [Decidable removed] (hold : old = if onBoundary then 1 else if 0 < old then 2 else 0) diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean b/LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean index 13208346d1..a4d0a9c4b4 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean @@ -699,10 +699,7 @@ private theorem hACinterAC (A : Real × Real) (C : Real × Real) : ({A,C} : Set classical exact Set.inter_self _ -private theorem hBCinterBC (B : Real × Real) (C : Real × Real) : ({B,C} : Set (Real × Real)) ∩ - {B,C} = {B,C} := by - classical - exact Set.inter_self _ +private abbrev hBCinterBC := ApollonianSuperharmonic.TwoTriangleSplit.hACinterAC private theorem hACinterBC (A : Real × Real) (B : Real × Real) (C : Real × Real) (hn : P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : ({A,C} : Set (Real × Real)) ∩ {B,C} = {C} := by @@ -783,11 +780,7 @@ private theorem hCinterAC (A : Real × Real) (C : Real × Real) : ({C} : Set (Re ext z simp [] -private theorem hCinterBC (B : Real × Real) (C : Real × Real) : ({C} : Set (Real × Real)) ∩ {B,C} - = {C} := by - classical - ext z - simp [] +private abbrev hCinterBC := ApollonianSuperharmonic.TwoTriangleSplit.hCinterAC private theorem hfaces (A : Real × Real) (B : Real × Real) (C : Real × Real) (u : Real) (hu : 0 < u ∧ u < 1) (hn : P3381T1TriangleDeterminant ![A, B, C] ≠ 0) : ∀ J : Set (Real × Real), J ⊆ diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean index 7dedbc1a5c..96a2559e78 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean @@ -624,26 +624,49 @@ private theorem hshared : linarith private theorem hnotboth : - ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), (∀ (i : Fin (n + 3)), i + 1 + 1 ≠ i) → ∀ (i : - Fin (n + (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), (i ≠ j) → ∀ (x : ℝ × ℝ), (x ∈ segment ℝ (q - j) (q (j + (1 : Fin (n + (3 : ℕ)))))) → ∀ (t : ℝ), (x = ((1 : ℝ) - t) • q j + t • q (j + - (1 : Fin (n + (3 : ℕ))))) → (((1 : ℝ) - t) * P3381T1TriangleDeterminant ![q i, q (i + - (1 : Fin (n + (3 : ℕ)))), q j] + t * P3381T1TriangleDeterminant ![q i, q (i + (1 : Fin - (n + (3 : ℕ)))), q (j + (1 : Fin (n + (3 : ℕ))))] = (0 : ℝ)) → - (P3381T1TriangleDeterminant ![q i, q (i + (1 : Fin (n + (3 : ℕ)))), ((1 : ℝ) - t) • q j - + t • q (j + (1 : Fin (n + (3 : ℕ))))] = ((1 : ℝ) - t) * P3381T1TriangleDeterminant ![q - i, q (i + (1 : Fin (n + (3 : ℕ)))), q j] + t * P3381T1TriangleDeterminant ![q i, q (i + - (1 : Fin (n + (3 : ℕ)))), q (j + (1 : Fin (n + (3 : ℕ))))]) → (0 ≤ (1-t) * - P3381T1TriangleDeterminant ![q i, q (i+1), q j]) → (0 ≤ t * - P3381T1TriangleDeterminant ![q i, q (i+1), q (j+1)]) → ((1-t) * - P3381T1TriangleDeterminant ![q i, q (i+1), q j] = 0) → (t * - P3381T1TriangleDeterminant ![q i, q (i+1), q (j+1)] = 0) → (j ≠ i ∧ j ≠ i+1 → 0 < - P3381T1TriangleDeterminant ![q i, q (i+1), q j]) → (j+1 ≠ i ∧ j+1 ≠ i+1 → 0 < - P3381T1TriangleDeterminant ![q i, q (i+1), q (j+1)]) → ((j = i ∨ j = i+1) ∨ (j+1 = i ∨ - j+1 = i+1)) → ¬ ((j = i ∨ j = i+1) ∧ (j+1 = i ∨ j+1 = i+1)) := by + ∀ (n : Nat), + ∀ (q : Fin (n + 3) → Real × Real), + (∀ (i : Fin (n + 3)), i + 1 + 1 ≠ i) → + ∀ (i : Fin (n + (3 : ℕ))), + ∀ (j : Fin (n + (3 : ℕ))), + i ≠ j → + ∀ (x : ℝ × ℝ), + ∀ (t : ℝ), + x = ((1 : ℝ) - t) • q j + t • q (j + (1 : Fin (n + (3 : ℕ)))) → + ((1 : ℝ) - t) * + P3381T1TriangleDeterminant + ![q i, q (i + (1 : Fin (n + (3 : ℕ)))), q j] + + t * + P3381T1TriangleDeterminant + ![q i, q (i + (1 : Fin (n + (3 : ℕ)))), + q (j + (1 : Fin (n + (3 : ℕ))))] = + (0 : ℝ) → + P3381T1TriangleDeterminant + ![q i, q (i + (1 : Fin (n + (3 : ℕ)))), + ((1 : ℝ) - t) • q j + t • q (j + (1 : Fin (n + (3 : ℕ))))] = + ((1 : ℝ) - t) * + P3381T1TriangleDeterminant + ![q i, q (i + (1 : Fin (n + (3 : ℕ)))), q j] + + t * + P3381T1TriangleDeterminant + ![q i, q (i + (1 : Fin (n + (3 : ℕ)))), + q (j + (1 : Fin (n + (3 : ℕ))))] → + 0 ≤ (1 - t) * P3381T1TriangleDeterminant ![q i, q (i + 1), q j] → + 0 ≤ + t * P3381T1TriangleDeterminant ![q i, q (i + 1), q (j + 1)] → + (1 - t) * P3381T1TriangleDeterminant ![q i, q (i + 1), q j] = + 0 → + t * P3381T1TriangleDeterminant ![q i, q (i + 1), q (j + 1)] = + 0 → + (j ≠ i ∧ j ≠ i + 1 → + 0 < P3381T1TriangleDeterminant ![q i, q (i + 1), q j]) → + (j + 1 ≠ i ∧ j + 1 ≠ i + 1 → + 0 < P3381T1TriangleDeterminant ![q i, q (i + 1), q (j + 1)]) → + (j = i ∨ j = i + 1) ∨ j + 1 = i ∨ j + 1 = i + 1 → + ¬((j = i ∨ j = i + 1) ∧ (j + 1 = i ∨ j + 1 = i + 1)) := by classical - intro n q no_two_cycle i j hij x hxj t hxt hz hcomb hleft hright hleftzero hrightzero - hleftstrict hrightstrict hshared + intro n q no_two_cycle i j hij x t hxt hz hcomb hleft hright hleftzero hrightzero hleftstrict + hrightstrict hshared rintro ⟨hj, hj'⟩ rcases hj with hj | hj <;> rcases hj' with hj' | hj' · subst j @@ -1083,7 +1106,7 @@ private theorem edge_intersections : have hshared : (j = i ∨ j = i+1) ∨ (j+1 = i ∨ j+1 = i+1) := ParabolaHullInterior.hshared n q i j t hleftzero hrightzero hleftstrict hrightstrict have hnotboth : ¬ ((j = i ∨ j = i+1) ∧ (j+1 = i ∨ j+1 = i+1)) := - ParabolaHullInterior.hnotboth n q no_two_cycle i j hij x hxj t hxt hz hcomb hleft + ParabolaHullInterior.hnotboth n q no_two_cycle i j hij x t hxt hz hcomb hleft hright hleftzero hrightzero hleftstrict hrightstrict hshared have hxend : x = q j ∧ (j = i ∨ j = i+1) ∨ x = q (j+1) ∧ (j+1 = i ∨ j+1 = i+1) := ParabolaHullInterior.hxend n q i j x t hxt hleftzero diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean index b51fee2052..0d2dc177df 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean @@ -28,16 +28,17 @@ namespace ApollonianSuperharmonic namespace SavedDissectionProof private theorem hsetAt164 : - ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), ∀ (a : Fin (n + (3 : ℕ))), ∀ (b : Fin (n + (3 - : ℕ))), ∀ (c : Fin (n + (3 : ℕ))), ([a, b, c].Nodup) → ((∃ (k : ℕ), [a, b, c].Sublist - ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k)) → (([a, b, c].Nodup) → ((∃ (k : - ℕ), [a, b, c].Sublist ((List.ofFn fun (i : Fin (n + (3 : ℕ))) => i).rotate k)) → (((a ≠ b - ∧ a ≠ c) ∧ b ≠ c) → ( - let f : Fin 3 → Fin (n + 3) := ![a, b, c] - (Function.Injective f) → ((P3381T1TriangleDeterminant (q ∘ f) ≠ 0) → (q '' {i | i ∈ [a, b, - c]} = Set.range (q ∘ f)))))))) := by + ∀ (n : Nat), + ∀ (q : Fin (n + 3) → Real × Real), + ∀ (a : Fin (n + (3 : ℕ))), + ∀ (b : Fin (n + (3 : ℕ))), + ∀ (c : Fin (n + (3 : ℕ))), + (a ≠ b ∧ a ≠ c) ∧ b ≠ c → + let f : Fin 3 → Fin (n + 3) := ![a, b, c]; + P3381T1TriangleDeterminant (q ∘ f) ≠ 0 → + q '' {i | i ∈ [a, b, c]} = Set.range (q ∘ f) := by classical - intro n q a b c hboundary hcyclic hnd hcyc hnd' f hfi hdet + intro n q a b c hnd' f hdet ext x change (∃ i, i ∈ [a, b, c] ∧ q i = x) ↔ ∃ j : Fin 3, q (f j) = x constructor @@ -888,7 +889,7 @@ private theorem triangleCase : have hdet : P3381T1TriangleDeterminant (q ∘ f) ≠ 0 := hsupport.2.1 f hfi have hset := SavedDissectionProof.hsetAt164 - n q a b c hboundary hcyclic hnd hcyc hnd' hfi hdet + n q a b c hnd' hdet refine ⟨?_, by simp, ?_, ?_, ?_⟩ · intro g hg simp only [List.mem_singleton] at hg diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean b/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean index df0970acdf..ad8b1f6ec8 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean @@ -1175,16 +1175,7 @@ private theorem hdv0 : intro n p x d hdv det2 m v i simpa [det2, v] using hdv i -private theorem hdv'0 : - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (x : Real × Real), ∀ (d' : Real × Real), - (∀ i, d'.1 * (p.vertex i - x).2 - d'.2 * (p.vertex i - x).1 ≠ 0) → ( - let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 - let m := n+2 - let v : Fin (m+1) → Real × Real := p.vertex - ∀ i, det2 d' (v i-x) ≠ 0) := by - classical - intro n p x d' hdv' det2 m v i - simpa [det2, v] using hdv' i +private abbrev hdv'0 := ApollonianSuperharmonic.DirectionParityLemmas.hdv0 private theorem hdn : ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (x : Real × Real), ∀ (d : Real × Real), @@ -1198,17 +1189,7 @@ private theorem hdn : rw [hz] at h exact h (by simp [det2]) -private theorem hd'n : - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (x : Real × Real), ∀ (d' : Real × Real), - let det2 (v w : Real × Real) : Real := v.1 * w.2 - v.2 * w.1 - let m := n+2 - let v : Fin (m+1) → Real × Real := p.vertex - (∀ i, det2 d' (v i-x) ≠ 0) → (d' ≠ 0) := by - classical - intro n p x d' det2 m v hdv'0 hz - have h := hdv'0 0 - rw [hz] at h - exact h (by simp [det2]) +private abbrev hd'n := ApollonianSuperharmonic.DirectionParityLemmas.hdn end DirectionParityLemmas diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean b/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean index 5a009a5596..acd462ad72 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean @@ -1277,47 +1277,6 @@ private theorem hright_wrap (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : simp [lastR, Fin.val_add_eq_ite, hrightLen, Nat.mod_eq_of_lt (by omega : 1 < N - k + 1)] -private theorem hleft_ord_edge (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext - : b ≠ a + 1) (hprev : a ≠ b + 1) (i : Fin ((leftN n a b) + 3)) (hi : i.val < (k n a b)) : - (il n a b hab hnext hprev) (i + 1) = (il n a b hab hnext hprev) i + 1 := by - classical - let N := n + 3 - let rot : Fin N → Fin N := fun i => a + i - let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b - have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b - have hkle : k + 2 ≤ N := hkle n a b hprev - let root : List (Fin N) := List.ofFn (fun i : Fin N => i) - have hrootlen : root.length = N := hrootlen n - let leftN := k - 2 - have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev - let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ - have hleft_succ (i : Fin (leftN + 3)) (hi : i.val < k) : - il (i + 1) = il i + 1 := hleft_succ n a b hab hnext hprev i hi - dsimp only [CyclicChildrenConstruction.k, CyclicChildrenConstruction.leftN] at * - change (il (i + 1) = il i + 1) - exact hleft_succ i hi - -private theorem hright_ord_edge (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) - (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) (i : Fin ((rightN n a b) + 3)) (hi : i.val < (N n) - - (k n a b)) : - (ir n a b hab hnext hprev) (i + 1) = (ir n a b hab hnext hprev) i + 1 := by - classical - let N := n + 3 - let rot : Fin N → Fin N := fun i => a + i - let k : Nat := (b.val + N - a.val) % N - let rightN := N - k - 2 - let posR : Fin (rightN + 3) → Nat := fun i => - if i.val = N - k then 0 else k + i.val - have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i - let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ - have hright_succ (i : Fin (rightN + 3)) (hi : i.val < N - k) : - ir (i + 1) = ir i + 1 := hright_succ n a b hab hnext hprev i hi - dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k, - CyclicChildrenConstruction.rightN] at * - change (ir (i + 1) = ir i + 1) - exact hright_succ i hi - private theorem hleft_last_edge (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b ≠ a + 1) (hprev : a ≠ b + 1) : segment Real (p.vertex ((il n a b hab hnext hprev) (ik n a b hab hnext hprev))) (p.vertex diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean b/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean index b6a8c977be..e714bc77ef 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean @@ -608,32 +608,45 @@ private theorem hnotLeft : (by classical exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), (∀ (i - : Fin (n + (3 : ℕ))), p.vertex i ∈ (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) - {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, - p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))} → i = E.b - (1 : Fin (n + (3 : ℕ))) ∨ i = - E.b ∨ i = E.b + (1 : Fin (n + (3 : ℕ)))) → ( - let a := p.vertex (E.b - 1) - let b := p.vertex E.b - let c := p.vertex (E.b + 1) - let v : Fin 3 → Real × Real := ![a, b, c] - ∀ (hind : AffineIndependent Real v), ∀ (hspan : affineSpan Real (Set.range v) = ⊤), - let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩ - let T := convexHull Real ({a, b, c} : Set (Real × Real)) - (A.coord 0 a = 1 ∧ A.coord 1 a = 0 ∧ A.coord 2 a = 0) → ((A.coord 0 b = 0 ∧ A.coord 1 b = - 1 ∧ A.coord 2 b = 0) → ((A.coord 0 c = 0 ∧ A.coord 1 c = 0 ∧ A.coord 2 c = 1) → (∀ (x - : ℝ × ℝ), ∀ (j : Fin (n + (3 : ℕ))), ((0 : ℝ) < (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → - ℝ) x ∧ (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ (0 : ℝ) < (A.coord (2 : - Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x) → ((x ∈ T) → ((¬j = E.b - (1 : Fin (n + (3 : ℕ)))) → - ((¬j = E.b) → (∀ (t : ℝ), ((AffineMap.lineMap (p.vertex j) (p.vertex (j + (1 : Fin (n - + (3 : ℕ))))) : ℝ → ℝ × ℝ) t = x) → ( - let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) - (q t = x) → ((Continuous q) → ((∀ (i : Fin 3), Continuous (fun s => A.coord i (q s))) → - ((∀ (i : Fin 3), ∀ (s : Real), A.coord i (q s) = (1 - s) * A.coord i (p.vertex j) + s - * A.coord i (p.vertex (j + 1))) → (x ≠ p.vertex j))))))))))))) ) := by - classical - intro n p E hempty a b c v hind hspan A T hcoordA hcoordB hcoordC x j hxb hxT hja hjb t hqt q - hqtq hqcont hfc hline h + ∀ (n : Nat), + ∀ (p : P3381T1PolygonBoundary n), + ∀ (E : P3650T1ExposedCorner p), + (∀ (i : Fin (n + (3 : ℕ))), + p.vertex i ∈ + (convexHull ℝ : Set (ℝ × ℝ) → Set (ℝ × ℝ)) + {p.vertex (E.b - (1 : Fin (n + (3 : ℕ)))), p.vertex E.b, + p.vertex (E.b + (1 : Fin (n + (3 : ℕ))))} → + i = E.b - (1 : Fin (n + (3 : ℕ))) ∨ + i = E.b ∨ i = E.b + (1 : Fin (n + (3 : ℕ)))) → + let a := p.vertex (E.b - 1); + let b := p.vertex E.b; + let c := p.vertex (E.b + 1); + let v : Fin 3 → Real × Real := ![a, b, c]; + ∀ (hind : AffineIndependent Real v), + ∀ (hspan : affineSpan Real (Set.range v) = ⊤), + let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨v, hind, hspan⟩; + let T := convexHull Real ({ a, b, c } : Set (Real × Real)); + A.coord 0 a = 1 ∧ A.coord 1 a = 0 ∧ A.coord 2 a = 0 → + A.coord 0 b = 0 ∧ A.coord 1 b = 1 ∧ A.coord 2 b = 0 → + A.coord 0 c = 0 ∧ A.coord 1 c = 0 ∧ A.coord 2 c = 1 → + ∀ (x : ℝ × ℝ), + ∀ (j : Fin (n + (3 : ℕ))), + (0 : ℝ) < (A.coord (0 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x ∧ + (A.coord (1 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x = (0 : ℝ) ∧ + (0 : ℝ) < (A.coord (2 : Fin (3 : ℕ)) : ℝ × ℝ → ℝ) x → + x ∈ T → + ¬j = E.b - (1 : Fin (n + (3 : ℕ))) → + ¬j = E.b → + ∀ (t : ℝ), + (AffineMap.lineMap (p.vertex j) + (p.vertex (j + (1 : Fin (n + (3 : ℕ))))) : + ℝ → ℝ × ℝ) + t = + x → + x ≠ p.vertex j + ) := by + classical + intro n p E hempty a b c v hind hspan A T hcoordA hcoordB hcoordC x j hxb hxT hja hjb t hqt h have hjT : p.vertex j ∈ T := by rw [← h]; exact hxT obtain hja' | hjb' | hjc' := hempty j (by simpa [T, a, b, c] using hjT) · subst j @@ -1384,18 +1397,7 @@ private theorem hsideA : exact hqseg0 simpa [a] using this -private theorem hqseg1 : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (j : Fin (n + (3 : ℕ))), - let q : Real → Real × Real := AffineMap.lineMap (p.vertex j) (p.vertex (j + 1)) - ∀ (s1 : ℝ), (s1 ∈ Set.Icc (0 : ℝ) (1 : ℝ)) → (q s1 ∈ segment Real (p.vertex j) (p.vertex - (j + 1))) ) := by - classical - intro n p j q s1 hs1 - rw [segment_eq_image_lineMap] - exact ⟨s1, hs1, rfl⟩ +private abbrev hqseg1 := ApollonianSuperharmonic.TriangleDiagonalGeometry.hqseg0 private theorem hqc : (by @@ -1844,7 +1846,7 @@ private theorem hbaseAvoid : (TriangleDiagonalGeometry.hcoordLine n p E hind hspan) j i s have ht' := TriangleDiagonalGeometry.ht' n p x j t ht hqtq (TriangleDiagonalGeometry.hnotLeft n p E hempty hind hspan hcoordA hcoordB hcoordC x j - hxb hxT hja hjb t hqt hqtq hqcont hfc hline) (TriangleDiagonalGeometry.hnotRight n p + hxb hxT hja hjb t hqt) (TriangleDiagonalGeometry.hnotRight n p E hempty hind hspan hcoordA hcoordB hcoordC x j hxb hxT) have hzero := TriangleDiagonalGeometry.hzero n p E hind hspan x j hxb t hqtq hline diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean b/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean index 605604bde8..682c977d61 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean @@ -835,37 +835,38 @@ private theorem hsignsOpp : (by classical exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (a : Fin (n + 3)), ∀ (b : Fin (n + - 3)), ∀ (C : P3650T1CyclicChildren p a b), (∀ x ∉ P3544T1BoundaryCarrier C.left, x - ∉ P3544T1BoundaryCarrier C.right → (x ∈ P3544T1RayParity p ↔ x ∈ - P3544T1RayParity C.left ∧ x ∉ P3544T1RayParity C.right ∨ x ∉ P3544T1RayParity - C.left ∧ x ∈ P3544T1RayParity C.right)) → ( - let Op := P3544T1RayParity p - let OL := P3544T1RayParity C.left - let OR := P3544T1RayParity C.right - ∀ (x : ℝ × ℝ), - let ilast : Fin (C.leftParameter + 3) := Fin.last (C.leftParameter + 2) - let irlast : Fin (C.rightParameter + 3) := Fin.last (C.rightParameter + 2) - ∀ (rL : ℝ), ∀ (sL : Bool), (∀ y ∈ Metric.ball x rL, y ∈ P3544T1RayParity C.left ↔ if sL - = true then (0 : ℝ) < P3381T1TriangleDeterminant ![C.left.vertex ilast, - C.left.vertex (ilast + (1 : Fin (C.leftParameter + (3 : ℕ)))), y] else - P3381T1TriangleDeterminant ![C.left.vertex ilast, C.left.vertex (ilast + (1 : Fin - (C.leftParameter + (3 : ℕ)))), y] < (0 : ℝ)) → (∀ (rR : ℝ), ∀ (sR : Bool), (∀ y ∈ - Metric.ball x rR, y ∈ P3544T1RayParity C.right ↔ if sR = true then (0 : ℝ) < - P3381T1TriangleDeterminant ![C.right.vertex irlast, C.right.vertex (irlast + (1 : - Fin (C.rightParameter + (3 : ℕ)))), y] else P3381T1TriangleDeterminant ![C.right.vertex - irlast, C.right.vertex (irlast + (1 : Fin (C.rightParameter + (3 : ℕ)))), y] < (0 : - ℝ)) → ( - let H : Real × Real → Real := fun y => - P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] - (∀ y ∈ Metric.ball x rL, (y ∈ OL ↔ if !sL then 0 < H y else H y < 0)) → ((∀ y ∈ - Metric.ball x rR, (y ∈ OR ↔ if sR then 0 < H y else H y < 0)) → (∀ (rp : ℝ), - (Metric.ball x rp ⊆ Op) → ( - let rho := min (min rL rR) rp - (∃ y ∈ Metric.ball x rho, if sL then H y < 0 else 0 < H y) → (sR = sL))))))) ) := by + ∀ (n : Nat), + ∀ (p : P3381T1PolygonBoundary n), + ∀ (a : Fin (n + 3)), + ∀ (b : Fin (n + 3)), + ∀ (C : P3650T1CyclicChildren p a b), + (∀ x ∉ P3544T1BoundaryCarrier C.left, + x ∉ P3544T1BoundaryCarrier C.right → + (x ∈ P3544T1RayParity p ↔ + x ∈ P3544T1RayParity C.left ∧ x ∉ P3544T1RayParity C.right ∨ + x ∉ P3544T1RayParity C.left ∧ x ∈ P3544T1RayParity C.right)) → + let Op := P3544T1RayParity p; + let OL := P3544T1RayParity C.left; + let OR := P3544T1RayParity C.right; + ∀ (x : ℝ × ℝ), + ∀ (rL : ℝ), + ∀ (sL : Bool), + ∀ (rR : ℝ), + ∀ (sR : Bool), + let H : Real × Real → Real := fun y => + P3381T1TriangleDeterminant ![p.vertex a, p.vertex b, y] + (∀ y ∈ Metric.ball x rL, + y ∈ OL ↔ if !sL then 0 < H y else H y < 0) → + (∀ y ∈ Metric.ball x rR, + y ∈ OR ↔ if sR then 0 < H y else H y < 0) → + ∀ (rp : ℝ), + Metric.ball x rp ⊆ Op → + let rho := min (min rL rR) rp + (∃ y ∈ Metric.ball x rho, if sL then H y < 0 else 0 < H y) → + sR = sL + ) := by classical - intro n p a b C hsum Op OL OR x ilast irlast rL sL hsideL rR sR hsideR H hcanonL hcanonR rp - hparentball rho htransverse + intro n p a b C hsum Op OL OR x rL sL rR sR H hcanonL hcanonR rp hparentball rho htransverse cases sL <;> cases sR · rfl · exfalso @@ -1094,8 +1095,8 @@ theorem P3650T1LocalCoherence {n : Nat} (p : P3381T1PolygonBoundary n) have htransverse : ∃ y ∈ Metric.ball x rho, if sL then H y < 0 else 0 < H y := LocalCoherenceProof.htransverse n p a b x rL sL rR rp hcoord hxdet hshiftV hshiftH hdelta hballV hballH hballDelta hballNegDelta - have hsignsOpp : sR = sL := LocalCoherenceProof.hsignsOpp n p a b C hsum x rL sL hsideL rR sR - hsideR hcanonL hcanonR rp hparentball htransverse + have hsignsOpp : sR = sL := LocalCoherenceProof.hsignsOpp n p a b C hsum x rL sL rR sR hcanonL + hcanonR rp hparentball htransverse let s := !sL let r := min (min rL rR) rp refine ⟨r, lt_min (lt_min hrL hrR) hrp, s, ?_⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean index 5dcbfc6add..e651964a71 100644 --- a/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean @@ -1810,18 +1810,7 @@ private theorem hiL : obtain ⟨z, hz⟩ := Set.mem_range.mp hik exact ⟨L.face k z, by simpa only [Function.comp_apply] using hz⟩ -private theorem hjL : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL - : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), ∀ (j : Fin (n + (3 - : ℕ))), ∀ (k : Fin L.count), (j ∈ Set.range (S.il ∘ L.face k)) → (j ∈ Set.range S.il) - ) := by - classical - intro n p S XL L j k hjk - obtain ⟨z, hz⟩ := Set.mem_range.mp hjk - exact ⟨L.face k z, by simpa only [Function.comp_apply] using hz⟩ +private abbrev hjL := ApollonianSuperharmonic.IndexedFaceLedgerProof.hiL private abbrev hnoRAt1259 := ApollonianSuperharmonic.IndexedFaceLedgerProof.hnoRAt1159 @@ -1864,18 +1853,7 @@ private theorem hiR : obtain ⟨z, hz⟩ := Set.mem_range.mp hik exact ⟨R.face k z, by simpa only [Function.comp_apply] using hz⟩ -private theorem hjR : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR - : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), ∀ (j : Fin (n + - (3 : ℕ))), ∀ (k : Fin R.count), (j ∈ Set.range (S.ir ∘ R.face k)) → (j ∈ Set.range - S.ir) ) := by - classical - intro n p S XR R j k hjk - obtain ⟨z, hz⟩ := Set.mem_range.mp hjk - exact ⟨R.face k z, by simpa only [Function.comp_apply] using hz⟩ +private abbrev hjR := ApollonianSuperharmonic.IndexedFaceLedgerProof.hiR private abbrev hnoLAt1285 := ApollonianSuperharmonic.IndexedFaceLedgerProof.hnoLAt1180 diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean index 4cdfe8ce2c..db5bef3a7a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean @@ -2298,36 +2298,60 @@ private theorem hpoly : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), ∀ (a : ι), - ∀ (b : ι), ∀ (localStar : (a : ι) → { b : ι // P3723T1EdgeContact P a b } → (↑(Icc - (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2 - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), ∀ (hab : - P3723T1EdgeContact P a b), - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a - ∀ (polyab : P3723T1PolygonalParameterization (g a b)), ∀ (polyba : - P3723T1PolygonalParameterization (g b a)), - let clip (x : Real) : Icc (0 : Real) 1 := - ⟨max 0 (min 1 x), le_max_left _ _, max_le (by norm_num) (min_le_left _ _)⟩ - let left : Icc (0 : Real) 1 → Real × Real := fun s => g a b (clip (2 * s)) - let right : Icc (0 : Real) 1 → Real × Real := fun s => g b a (clip (2 - 2 * s)) - let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} - let f : Icc (0 : Real) 1 → Real × Real := A.piecewise left right - (∀ (s : Icc (0 : Real) 1), (s ∈ A) → ((clip (2 * s) : Real) = 2 * s)) → ((∀ (s : Icc (0 : - Real) 1), (s ∉ A) → ((clip (2 - 2 * s) : Real) = 2 - - 2 * s)) → (∀ (p : ℝ × ℝ), (g a b ⟨1, by norm_num⟩ = p) → ((g b a ⟨1, - by norm_num⟩ = p) → (Nonempty (P3723T1PolygonalParameterization f)))))) := by + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1ContactPorts P), + ∀ (a : ι), + ∀ (b : ι), + ∀ + (localStar : + (a : ι) → + { b : ι // P3723T1EdgeContact P a b } → + (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), + let rep (a : ι) : ι := + Classical.choose (P.vertex_orbit_representatives a).exists; + ∀ + (rep_spec : + ∀ (a : ι), + rep a ∈ P.vertexOrbitReps ∧ + ∃ u : P.lattice, a = P.shift u (rep a)), + let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; + ∀ + (pulled_contact : + ∀ (a : ι), + ∀ (b : ι), + P3723T1EdgeContact P a b → + P3723T1EdgeContact P (rep a) (P.shift (-period a) b)), + let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := + if hab : P3723T1EdgeContact P a b then + localStar (rep a) + ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + + GaussianRealPoint (period a) + else D.position a + ∀ (polyab : P3723T1PolygonalParameterization (g a b)), + ∀ (polyba : P3723T1PolygonalParameterization (g b a)), + let clip (x : Real) : Icc (0 : Real) 1 := + ⟨max 0 (min 1 x), le_max_left _ _, + max_le (by norm_num) (min_le_left _ _)⟩ + let left : Icc (0 : Real) 1 → Real × Real := fun s => + g a b (clip (2 * s)) + let right : Icc (0 : Real) 1 → Real × Real := fun s => + g b a (clip (2 - 2 * s)) + let A : Set (Icc (0 : Real) 1) := {s | (s : Real) ≤ 1 / 2} + let f : Icc (0 : Real) 1 → Real × Real := + A.piecewise left right + (∀ (s : Icc (0 : Real) 1), + s ∈ A → (clip (2 * s) : Real) = 2 * s) → + (∀ (s : Icc (0 : Real) 1), + s ∉ A → (clip (2 - 2 * s) : Real) = 2 - 2 * s) → + ∀ (p : ℝ × ℝ), + g a b ⟨1, by norm_num⟩ = p → + g b a ⟨1, by norm_num⟩ = p → + Nonempty (P3723T1PolygonalParameterization f) + ) := by classical - intro ι P D a b localStar rep rep_spec period pulled_contact hab g polyab polyba clip left - right A f hscale_left hscale_right p hendab hendba + intro ι P D a b localStar rep rep_spec period pulled_contact g polyab polyba clip left right A + f hscale_left hscale_right p hendab hendba let m := polyab.count let n := polyba.count have hmpos : 0 < m := polyab.positive @@ -2602,7 +2626,7 @@ private theorem full_parameters : have hrange := ContactDrawingGeometry.hrange ι P D a b localStar rep_spec pulled_contact hab hba p hendab hendba have hpoly : Nonempty (P3723T1PolygonalParameterization f) := - ContactDrawingConcatenation.hpoly ι P D a b localStar rep_spec pulled_contact hab polyab + ContactDrawingConcatenation.hpoly ι P D a b localStar rep_spec pulled_contact polyab polyba hscale_left hscale_right p hendab hendba exact ⟨f, hfcont, hfinj, hrange, hf0, hf1, hpoly⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean index 7f0bcb1a94..129308980f 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.PeriodicEdgeContactSymmetry public import LeanPool.ApollonianSuperharmonic.P3723T1ContactPorts @@ -524,15 +525,7 @@ private theorem period_shift : rw [← rep_shift u a, ← period_spec] _ = P.shift (u + period a) (rep a) := by rw [P.shift_add, ← period_spec] -private theorem real_add : - (by - classical - exact - ∀ (z : GaussianInt), ∀ (w : GaussianInt), GaussianRealPoint (z + w) = GaussianRealPoint z - + GaussianRealPoint w ) := by - classical - intro z w - ext <;> simp [GaussianRealPoint] +private abbrev real_add := ApollonianSuperharmonic.GaussianRealPointProperties.add private theorem position_cell : (by diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1FixedGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3776T1FixedGeometry.lean index 32e4de306e..67c67f9719 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1FixedGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1FixedGeometry.lean @@ -98,10 +98,9 @@ private theorem harc : exact isCompact_range (continuous_subtype_val.comp h.continuous) private theorem hexterior : - ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), (∃ u : P.lattice, u ≠ 0) → (∀ (B : Real), - IsPreconnected {x : Real × Real | B < ‖x‖}) := by + ∀ (B : Real), IsPreconnected {x : Real × Real | B < ‖x‖} := by classical - intro ι P hnonzero B + intro B let R : Set (Real × Real) := Set.Ioi B ×ˢ Set.univ let T : Set (Real × Real) := Set.univ ×ˢ Set.Ioi B let L : Set (Real × Real) := Set.Iio (-B) ×ˢ Set.univ @@ -692,7 +691,7 @@ theorem P3776T1FixedGeometry {ι : Type} (P : PeriodicTileCore ι) : (harc _ _ (P.plane.face_edges f 1 2 (by decide)))).union (harc _ _ (P.plane.face_edges f 2 0 (by decide))) have hexterior (B : Real) : IsPreconnected {x : Real × Real | B < ‖x‖} := - FixedPeriodicGeometryProof.hexterior ι P hnonzero B + FixedPeriodicGeometryProof.hexterior B have hcompact (f : P.plane.Face) : IsCompact (closure (P.plane.faceRegion f)) := FixedPeriodicGeometryProof.hcompact ι P hnonzero hfacefree hfront hexterior f have hfiniteTrans (K A : Set (Real × Real)) (hK : IsCompact K) (hA : IsCompact A) : diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean b/LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean index b2231f8338..8a88ed5653 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean @@ -96,9 +96,9 @@ private theorem hseg : rw [hmin, hsEq]; norm_num [Nat.cast_add] private theorem hlastD : - ∀ (p : List GaussianInt), (p ≠ []) → p.getLast?.getD 0 = p.getD (p.length - 1) 0 := by + ∀ (p : List GaussianInt), p.getLast?.getD 0 = p.getD (p.length - 1) 0 := by classical - intro p hp + intro p induction p using List.reverseRecOn with | nil => simp | append_singleton q a ih => simp [List.getLast?_append] @@ -192,17 +192,23 @@ private theorem hcombo : nlinarith [h1, h2] private theorem walk_continuous : - ∀ (p : List GaussianInt), (p ≠ []) → (∀ (a : GaussianInt), Continuous (P3776T1WalkMap [a])) - → (∀ (q : List GaussianInt), ∀ (k : Nat), (k < q.length - 1) → ∀ (t : Set.Icc (0 : Real) - 1), ((k : Real) / (q.length - 1) ≤ (t : Real)) → ((t : Real) ≤ ((k + 1 : Nat) : Real) / - (q.length - 1)) → P3776T1WalkMap q t = (1 - ((q.length - 1 : Nat) * (t : Real) - k)) • - GaussianRealPoint (q.getD k 0) + ((q.length - 1 : Nat) * (t : Real) - k) • - GaussianRealPoint (q.getD (k + 1) 0)) → (p.getLast?.getD 0 = p.getD (p.length - 1) 0) → - ((0 < p.length - 1) → ∀ (t : Set.Icc (0 : Real) 1), ∃ k, k < p.length - 1 ∧ (k : Real) / - (p.length - 1) ≤ (t : Real) ∧ (t : Real) ≤ ((k + 1 : Nat) : Real) / (p.length - 1)) → - Continuous (P3776T1WalkMap p) := by + ∀ (p : List GaussianInt), + p ≠ [] → + (∀ (a : GaussianInt), Continuous (P3776T1WalkMap [a])) → + (∀ (q : List GaussianInt), + ∀ (k : Nat), + k < q.length - 1 → + ∀ (t : Set.Icc (0 : Real) 1), + (k : Real) / (q.length - 1) ≤ (t : Real) → + (t : Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1) → + P3776T1WalkMap q t = + (1 - ((q.length - 1 : Nat) * (t : Real) - k)) • + GaussianRealPoint (q.getD k 0) + + ((q.length - 1 : Nat) * (t : Real) - k) • + GaussianRealPoint (q.getD (k + 1) 0)) → + p.getLast?.getD 0 = p.getD (p.length - 1) 0 → Continuous (P3776T1WalkMap p) := by classical - intro p hp hsingle hseg hlastD hinterval + intro p hp hsingle hseg hlastD by_cases hp1 : p.length = 1 · obtain ⟨a, rfl⟩ : ∃ a : GaussianInt, p = [a] := by cases p with @@ -312,17 +318,23 @@ private theorem walk_continuous : exact hall private theorem walk_start : - ∀ (p : List GaussianInt), (p ≠ []) → (∀ (q : List GaussianInt), ∀ (k : Nat), (k < q.length - - 1) → ∀ (t : Set.Icc (0 : Real) 1), ((k : Real) / (q.length - 1) ≤ (t : Real)) → ((t : - Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1)) → P3776T1WalkMap q t = (1 - ((q.length - - 1 : Nat) * (t : Real) - k)) • GaussianRealPoint (q.getD k 0) + ((q.length - 1 : Nat) * - (t : Real) - k) • GaussianRealPoint (q.getD (k + 1) 0)) → (p.getLast?.getD 0 = p.getD - (p.length - 1) 0) → ((0 < p.length - 1) → ∀ (t : Set.Icc (0 : Real) 1), ∃ k, k < p.length - - 1 ∧ (k : Real) / (p.length - 1) ≤ (t : Real) ∧ (t : Real) ≤ ((k + 1 : Nat) : Real) / - (p.length - 1)) → (Continuous (P3776T1WalkMap p)) → P3776T1WalkMap p ⟨0, by norm_num⟩ - = GaussianRealPoint (p.getD 0 0) := by + ∀ (p : List GaussianInt), + p ≠ [] → + (∀ (q : List GaussianInt), + ∀ (k : Nat), + k < q.length - 1 → + ∀ (t : Set.Icc (0 : Real) 1), + (k : Real) / (q.length - 1) ≤ (t : Real) → + (t : Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1) → + P3776T1WalkMap q t = + (1 - ((q.length - 1 : Nat) * (t : Real) - k)) • + GaussianRealPoint (q.getD k 0) + + ((q.length - 1 : Nat) * (t : Real) - k) • + GaussianRealPoint (q.getD (k + 1) 0)) → + p.getLast?.getD 0 = p.getD (p.length - 1) 0 → + P3776T1WalkMap p ⟨0, by norm_num⟩ = GaussianRealPoint (p.getD 0 0) := by classical - intro p hp hseg hlastD hinterval walk_continuous + intro p hp hseg hlastD by_cases hp1 : p.length = 1 · obtain ⟨a, rfl⟩ : ∃ a : GaussianInt, p = [a] := by cases p with @@ -346,18 +358,24 @@ private theorem walk_start : simpa [t0] using hval private theorem walk_end : - ∀ (p : List GaussianInt), (p ≠ []) → (∀ (q : List GaussianInt), ∀ (k : Nat), (k < q.length - - 1) → ∀ (t : Set.Icc (0 : Real) 1), ((k : Real) / (q.length - 1) ≤ (t : Real)) → ((t : - Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1)) → P3776T1WalkMap q t = (1 - ((q.length - - 1 : Nat) * (t : Real) - k)) • GaussianRealPoint (q.getD k 0) + ((q.length - 1 : Nat) * - (t : Real) - k) • GaussianRealPoint (q.getD (k + 1) 0)) → (p.getLast?.getD 0 = p.getD - (p.length - 1) 0) → ((0 < p.length - 1) → ∀ (t : Set.Icc (0 : Real) 1), ∃ k, k < p.length - - 1 ∧ (k : Real) / (p.length - 1) ≤ (t : Real) ∧ (t : Real) ≤ ((k + 1 : Nat) : Real) / - (p.length - 1)) → (Continuous (P3776T1WalkMap p)) → (P3776T1WalkMap p ⟨0, by - norm_num⟩ = GaussianRealPoint (p.getD 0 0)) → P3776T1WalkMap p ⟨1, by norm_num⟩ = - GaussianRealPoint (p.getLast?.getD 0) := by + ∀ (p : List GaussianInt), + p ≠ [] → + (∀ (q : List GaussianInt), + ∀ (k : Nat), + k < q.length - 1 → + ∀ (t : Set.Icc (0 : Real) 1), + (k : Real) / (q.length - 1) ≤ (t : Real) → + (t : Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1) → + P3776T1WalkMap q t = + (1 - ((q.length - 1 : Nat) * (t : Real) - k)) • + GaussianRealPoint (q.getD k 0) + + ((q.length - 1 : Nat) * (t : Real) - k) • + GaussianRealPoint (q.getD (k + 1) 0)) → + p.getLast?.getD 0 = p.getD (p.length - 1) 0 → + P3776T1WalkMap p ⟨0, by norm_num⟩ = GaussianRealPoint (p.getD 0 0) → + P3776T1WalkMap p ⟨1, by norm_num⟩ = GaussianRealPoint (p.getLast?.getD 0) := by classical - intro p hp hseg hlastD hinterval walk_continuous walk_start + intro p hp hseg hlastD walk_start by_cases hp1 : p.length = 1 · obtain ⟨a, rfl⟩ : ∃ a : GaussianInt, p = [a] := by cases p with @@ -392,20 +410,34 @@ private theorem walk_end : Nat.sub_add_cancel (by omega : 1 ≤ n)] using hval private theorem walk_reverse : - ∀ (p : List GaussianInt), (p ≠ []) → (∀ (q : List GaussianInt), ∀ (k : Nat), (k < q.length - - 1) → ∀ (t : Set.Icc (0 : Real) 1), ((k : Real) / (q.length - 1) ≤ (t : Real)) → ((t : - Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1)) → P3776T1WalkMap q t = (1 - ((q.length - - 1 : Nat) * (t : Real) - k)) • GaussianRealPoint (q.getD k 0) + ((q.length - 1 : Nat) * - (t : Real) - k) • GaussianRealPoint (q.getD (k + 1) 0)) → (p.getLast?.getD 0 = p.getD - (p.length - 1) 0) → ((0 < p.length - 1) → ∀ (t : Set.Icc (0 : Real) 1), ∃ k, k < p.length - - 1 ∧ (k : Real) / (p.length - 1) ≤ (t : Real) ∧ (t : Real) ≤ ((k + 1 : Nat) : Real) / - (p.length - 1)) → (Continuous (P3776T1WalkMap p)) → (P3776T1WalkMap p ⟨0, by - norm_num⟩ = GaussianRealPoint (p.getD 0 0)) → (P3776T1WalkMap p ⟨1, by norm_num⟩ = - GaussianRealPoint (p.getLast?.getD 0)) → (∀ t : Set.Icc (0 : Real) 1, - P3776T1WalkMap p.reverse t = - P3776T1WalkMap p ⟨1 - (t : Real), by constructor <;> linarith [t.2.1, t.2.2]⟩) := by + ∀ (p : List GaussianInt), + p ≠ [] → + (∀ (q : List GaussianInt), + ∀ (k : Nat), + k < q.length - 1 → + ∀ (t : Set.Icc (0 : Real) 1), + (k : Real) / (q.length - 1) ≤ (t : Real) → + (t : Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1) → + P3776T1WalkMap q t = + (1 - ((q.length - 1 : Nat) * (t : Real) - k)) • + GaussianRealPoint (q.getD k 0) + + ((q.length - 1 : Nat) * (t : Real) - k) • + GaussianRealPoint (q.getD (k + 1) 0)) → + p.getLast?.getD 0 = p.getD (p.length - 1) 0 → + (0 < p.length - 1 → + ∀ (t : Set.Icc (0 : Real) 1), + ∃ k, + k < p.length - 1 ∧ + (k : Real) / (p.length - 1) ≤ (t : Real) ∧ + (t : Real) ≤ ((k + 1 : Nat) : Real) / (p.length - 1)) → + P3776T1WalkMap p ⟨0, by norm_num⟩ = GaussianRealPoint (p.getD 0 0) → + P3776T1WalkMap p ⟨1, by norm_num⟩ = GaussianRealPoint (p.getLast?.getD 0) → + ∀ t : Set.Icc (0 : Real) 1, + P3776T1WalkMap p.reverse t = + P3776T1WalkMap p + ⟨1 - (t : Real), by constructor <;> linarith [t.2.1, t.2.2]⟩ := by classical - intro p hp hseg hlastD hinterval walk_continuous walk_start walk_end t + intro p hp hseg hlastD hinterval walk_start walk_end t by_cases hp1 : p.length = 1 · obtain ⟨a, rfl⟩ : ∃ a : GaussianInt, p = [a] := by cases p with @@ -492,22 +524,38 @@ private theorem walk_reverse : module private theorem walk_translate : - ∀ (p : List GaussianInt), (p ≠ []) → (∀ (q : List GaussianInt), ∀ (k : Nat), (k < q.length - - 1) → ∀ (t : Set.Icc (0 : Real) 1), ((k : Real) / (q.length - 1) ≤ (t : Real)) → ((t : - Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1)) → P3776T1WalkMap q t = (1 - ((q.length - - 1 : Nat) * (t : Real) - k)) • GaussianRealPoint (q.getD k 0) + ((q.length - 1 : Nat) * - (t : Real) - k) • GaussianRealPoint (q.getD (k + 1) 0)) → (p.getLast?.getD 0 = p.getD - (p.length - 1) 0) → ((0 < p.length - 1) → ∀ (t : Set.Icc (0 : Real) 1), ∃ k, k < p.length - - 1 ∧ (k : Real) / (p.length - 1) ≤ (t : Real) ∧ (t : Real) ≤ ((k + 1 : Nat) : Real) / - (p.length - 1)) → (Continuous (P3776T1WalkMap p)) → (P3776T1WalkMap p ⟨0, by - norm_num⟩ = GaussianRealPoint (p.getD 0 0)) → (P3776T1WalkMap p ⟨1, by norm_num⟩ = - GaussianRealPoint (p.getLast?.getD 0)) → ((∀ t : Set.Icc (0 : Real) 1, P3776T1WalkMap - p.reverse t = P3776T1WalkMap p ⟨1 - (t : Real), by constructor <;> linarith [t.2.1, - t.2.2]⟩)) → (∀ u : GaussianInt, ∀ t : Set.Icc (0 : Real) 1, - P3776T1WalkMap (p.map (fun z => z + u)) t = - P3776T1WalkMap p t + GaussianRealPoint u) := by + ∀ (p : List GaussianInt), + p ≠ [] → + (∀ (q : List GaussianInt), + ∀ (k : Nat), + k < q.length - 1 → + ∀ (t : Set.Icc (0 : Real) 1), + (k : Real) / (q.length - 1) ≤ (t : Real) → + (t : Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1) → + P3776T1WalkMap q t = + (1 - ((q.length - 1 : Nat) * (t : Real) - k)) • + GaussianRealPoint (q.getD k 0) + + ((q.length - 1 : Nat) * (t : Real) - k) • + GaussianRealPoint (q.getD (k + 1) 0)) → + p.getLast?.getD 0 = p.getD (p.length - 1) 0 → + (0 < p.length - 1 → + ∀ (t : Set.Icc (0 : Real) 1), + ∃ k, + k < p.length - 1 ∧ + (k : Real) / (p.length - 1) ≤ (t : Real) ∧ + (t : Real) ≤ ((k + 1 : Nat) : Real) / (p.length - 1)) → + P3776T1WalkMap p ⟨0, by norm_num⟩ = GaussianRealPoint (p.getD 0 0) → + P3776T1WalkMap p ⟨1, by norm_num⟩ = GaussianRealPoint (p.getLast?.getD 0) → + (∀ t : Set.Icc (0 : Real) 1, + P3776T1WalkMap p.reverse t = + P3776T1WalkMap p + ⟨1 - (t : Real), by constructor <;> linarith [t.2.1, t.2.2]⟩) → + ∀ u : GaussianInt, + ∀ t : Set.Icc (0 : Real) 1, + P3776T1WalkMap (p.map fun z => z + u) t = + P3776T1WalkMap p t + GaussianRealPoint u := by classical - intro p hp hseg hlastD hinterval walk_continuous walk_start walk_end walk_reverse u t + intro p hp hseg hlastD hinterval walk_start walk_end walk_reverse u t have hpoint (z : GaussianInt) : GaussianRealPoint (z + u) = GaussianRealPoint z + GaussianRealPoint u := by ext <;> simp [GaussianRealPoint] @@ -540,29 +588,50 @@ private theorem walk_translate : module private theorem walk_contained : - ∀ (p : List GaussianInt), (p ≠ []) → (∀ (q : List GaussianInt), ∀ (k : Nat), (k < q.length - - 1) → ∀ (t : Set.Icc (0 : Real) 1), ((k : Real) / (q.length - 1) ≤ (t : Real)) → ((t : - Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1)) → P3776T1WalkMap q t = (1 - ((q.length - - 1 : Nat) * (t : Real) - k)) • GaussianRealPoint (q.getD k 0) + ((q.length - 1 : Nat) * - (t : Real) - k) • GaussianRealPoint (q.getD (k + 1) 0)) → (p.getLast?.getD 0 = p.getD - (p.length - 1) 0) → ((0 < p.length - 1) → ∀ (t : Set.Icc (0 : Real) 1), ∃ k, k < p.length - - 1 ∧ (k : Real) / (p.length - 1) ≤ (t : Real) ∧ (t : Real) ≤ ((k + 1 : Nat) : Real) / - (p.length - 1)) → (∀ (lo : Real × Real), ∀ (hi : Real × Real), ∀ (a : Real × Real), ∀ (b - : Real × Real), (a ∈ Set.Icc lo hi) → (b ∈ Set.Icc lo hi) → ∀ (r : Real), (0 ≤ r) → (r ≤ - 1) → (1 - r) • a + r • b ∈ Set.Icc lo hi) → (Continuous (P3776T1WalkMap p)) → - (P3776T1WalkMap p ⟨0, by norm_num⟩ = GaussianRealPoint (p.getD 0 0)) → - (P3776T1WalkMap p ⟨1, by norm_num⟩ = GaussianRealPoint (p.getLast?.getD 0)) → ((∀ t : - Set.Icc (0 : Real) 1, P3776T1WalkMap p.reverse t = P3776T1WalkMap p ⟨1 - (t : Real), - by constructor <;> linarith [t.2.1, t.2.2]⟩)) → ((∀ u : GaussianInt, ∀ t : Set.Icc (0 : - Real) 1, P3776T1WalkMap (p.map (fun z => z + u)) t = P3776T1WalkMap p t + - GaussianRealPoint u)) → (∀ T : ProtoTile, LatticeTile T → - (∀ z ∈ p, z ∈ FootprintVertices T) → - (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, - p = l₁ ++ a :: b :: l₂ → {a, b} ∈ FootprintEdges T) → - ∀ t, P3776T1WalkMap p t ∈ TileRealization T) := by + ∀ (p : List GaussianInt), + p ≠ [] → + (∀ (q : List GaussianInt), + ∀ (k : Nat), + k < q.length - 1 → + ∀ (t : Set.Icc (0 : Real) 1), + (k : Real) / (q.length - 1) ≤ (t : Real) → + (t : Real) ≤ ((k + 1 : Nat) : Real) / (q.length - 1) → + P3776T1WalkMap q t = + (1 - ((q.length - 1 : Nat) * (t : Real) - k)) • + GaussianRealPoint (q.getD k 0) + + ((q.length - 1 : Nat) * (t : Real) - k) • + GaussianRealPoint (q.getD (k + 1) 0)) → + p.getLast?.getD 0 = p.getD (p.length - 1) 0 → + (0 < p.length - 1 → + ∀ (t : Set.Icc (0 : Real) 1), + ∃ k, + k < p.length - 1 ∧ + (k : Real) / (p.length - 1) ≤ (t : Real) ∧ + (t : Real) ≤ ((k + 1 : Nat) : Real) / (p.length - 1)) → + (∀ (lo : Real × Real), + ∀ (hi : Real × Real), + ∀ (a : Real × Real), + ∀ (b : Real × Real), + a ∈ Set.Icc lo hi → + b ∈ Set.Icc lo hi → + ∀ (r : Real), + 0 ≤ r → r ≤ 1 → (1 - r) • a + r • b ∈ Set.Icc lo hi) → + P3776T1WalkMap p ⟨0, by norm_num⟩ = GaussianRealPoint (p.getD 0 0) → + P3776T1WalkMap p ⟨1, by norm_num⟩ = + GaussianRealPoint (p.getLast?.getD 0) → + (∀ t : Set.Icc (0 : Real) 1, + P3776T1WalkMap p.reverse t = + P3776T1WalkMap p + ⟨1 - (t : Real), by constructor <;> linarith [t.2.1, t.2.2]⟩) → + ∀ T : ProtoTile, + LatticeTile T → + (∀ z ∈ p, z ∈ FootprintVertices T) → + (∀ a b : GaussianInt, + ∀ l₁ l₂ : List GaussianInt, + p = l₁ ++ a :: b :: l₂ → { a, b } ∈ FootprintEdges T) → + ∀ t, P3776T1WalkMap p t ∈ TileRealization T := by classical - intro p hp hseg hlastD hinterval hcombo walk_continuous walk_start walk_end walk_reverse - walk_translate T hT hv hed t + intro p hp hseg hlastD hinterval hcombo walk_start walk_end walk_reverse T hT hv hed t have hdisc : Nonempty ((Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) ≃ₜ TileRealization T) := by @@ -739,7 +808,7 @@ theorem P3776T1WalkMapProperties (p : List GaussianInt) (hp : p ≠ []) : GaussianRealPoint (q.getD k 0) + ((q.length - 1 : Nat) * (t : Real) - k) • GaussianRealPoint (q.getD (k + 1) 0) := WalkMapLemmas.hseg q k hk t ht1 ht2 - have hlastD : p.getLast?.getD 0 = p.getD (p.length - 1) 0 := WalkMapLemmas.hlastD p hp + have hlastD : p.getLast?.getD 0 = p.getD (p.length - 1) 0 := WalkMapLemmas.hlastD p have hinterval (hn : 0 < p.length - 1) (t : Set.Icc (0 : Real) 1) : ∃ k, k < p.length - 1 ∧ (k : Real) / (p.length - 1) ≤ (t : Real) ∧ @@ -748,27 +817,26 @@ theorem P3776T1WalkMapProperties (p : List GaussianInt) (hp : p ≠ []) : (hb : b ∈ Set.Icc lo hi) (r : Real) (hr0 : 0 ≤ r) (hr1 : r ≤ 1) : (1 - r) • a + r • b ∈ Set.Icc lo hi := WalkMapLemmas.hcombo lo hi a b ha hb r hr0 hr1 have walk_continuous : Continuous (P3776T1WalkMap p) := WalkMapLemmas.walk_continuous p hp - hsingle hseg hlastD hinterval + hsingle hseg hlastD have walk_start : P3776T1WalkMap p ⟨0, by norm_num⟩ = GaussianRealPoint (p.getD 0 0) := - WalkMapLemmas.walk_start p hp hseg hlastD hinterval walk_continuous + WalkMapLemmas.walk_start p hp hseg hlastD have walk_end : P3776T1WalkMap p ⟨1, by norm_num⟩ = - GaussianRealPoint (p.getLast?.getD 0) := WalkMapLemmas.walk_end p hp hseg hlastD hinterval - walk_continuous walk_start + GaussianRealPoint (p.getLast?.getD 0) := WalkMapLemmas.walk_end p hp hseg hlastD walk_start have walk_reverse : (∀ t : Set.Icc (0 : Real) 1, P3776T1WalkMap p.reverse t = P3776T1WalkMap p ⟨1 - (t : Real), by constructor <;> linarith [t.2.1, t.2.2]⟩) := - WalkMapLemmas.walk_reverse p hp hseg hlastD hinterval walk_continuous walk_start + WalkMapLemmas.walk_reverse p hp hseg hlastD hinterval walk_start walk_end have walk_translate : (∀ u : GaussianInt, ∀ t : Set.Icc (0 : Real) 1, P3776T1WalkMap (p.map (fun z => z + u)) t = P3776T1WalkMap p t + GaussianRealPoint u) := WalkMapLemmas.walk_translate p hp hseg - hlastD hinterval walk_continuous walk_start walk_end walk_reverse + hlastD hinterval walk_start walk_end walk_reverse have walk_contained : (∀ T : ProtoTile, LatticeTile T → (∀ z ∈ p, z ∈ FootprintVertices T) → (∀ a b : GaussianInt, ∀ l₁ l₂ : List GaussianInt, p = l₁ ++ a :: b :: l₂ → {a, b} ∈ FootprintEdges T) → ∀ t, P3776T1WalkMap p t ∈ TileRealization T) := WalkMapLemmas.walk_contained p hp hseg - hlastD hinterval hcombo walk_continuous walk_start walk_end walk_reverse walk_translate + hlastD hinterval hcombo walk_start walk_end walk_reverse exact ⟨walk_continuous, walk_start, walk_end, walk_reverse, walk_translate, walk_contained⟩ end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean index 7e3f570471..976d504c2c 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean @@ -797,33 +797,7 @@ private theorem hpclose : (close_in_cell up rp hup) hh.le _ = h := mul_one h -private theorem hqclose : - ∀ (q : ℂ), - let openbox (u : GaussianInt) (z : ℂ) : Prop := - (u.re : ℝ) < z.re ∧ z.re < (u.re : ℝ) + 1 ∧ - (u.im : ℝ) < z.im ∧ z.im < (u.im : ℝ) + 1 - ∀ (η : ℝ), ∀ (εp : ℝ), ∀ (εq : ℝ), - let h : ℝ := min η (min εp εq) / 10 - (0 < h) → (∀ (s : ℝ), ∀ (t : ℝ), - let o : ℂ := (h * s : ℝ) + (h * t : ℝ) * Complex.I - let rq : ℂ := (q - o) / (h : ℂ) - ∀ (uq : GaussianInt), (openbox uq rq) → ((∀ (u : GaussianInt), ∀ (z : ℂ), (openbox u z) → (‖z - - GridCellCenter u‖ ≤ 1)) → (‖q - ((h : ℂ) * GridCellCenter uq + o)‖ ≤ h))) := by - classical - intro q openbox η εp εq h hh s t o rq uq huq close_in_cell - have hq_eq : q = (h : ℂ) * rq + o := by - dsimp [rq] - rw [mul_div_cancel₀ (q - o) (by exact_mod_cast hh.ne')] - ring - have heq : q - ((h : ℂ) * GridCellCenter uq + o) = - (h : ℂ) * (rq - GridCellCenter uq) := by rw [hq_eq]; ring - rw [heq, norm_mul] - have hnorm : ‖(h : ℂ)‖ = h := by rw [Complex.norm_real, Real.norm_eq_abs, abs_of_pos hh] - rw [hnorm] - calc - h * ‖rq - GridCellCenter uq‖ ≤ h * 1 := mul_le_mul_of_nonneg_left - (close_in_cell uq rq huq) hh.le - _ = h := mul_one h +private abbrev hqclose := ApollonianSuperharmonic.ComponentContoursProof.hpclose private theorem hpcenter_comp : ∀ (K : Set ℂ), (∀ (p : ℂ), ∀ (η : ℝ), ∀ (εp : ℝ), (Metric.ball p εp ⊆ Kᶜ) → (∀ (εq : ℝ), @@ -1361,13 +1335,18 @@ private theorem hKne : isPreconnected_univ.connectedComponentIn (Set.mem_univ q)] private theorem hKV : - ∀ (K : Set ℂ), ∀ (N : Set ℂ), (K ⊆ N) → (∀ (p : ℂ), ∀ (q : ℂ), (p ∈ Kᶜ) → ((q ∈ Kᶜ) → - ((connectedComponentIn Kᶜ p ≠ connectedComponentIn Kᶜ q) → ((Bornology.IsBounded - (connectedComponentIn Kᶜ p)) → ( - let V := N ∩ ({p, q} : Set ℂ)ᶜ - (IsOpen V) → (K ⊆ V)))))) := by + ∀ (K : Set ℂ), + ∀ (N : Set ℂ), + K ⊆ N → + ∀ (p : ℂ), + ∀ (q : ℂ), + p ∈ Kᶜ → + q ∈ Kᶜ → + connectedComponentIn Kᶜ p ≠ connectedComponentIn Kᶜ q → + let V := N ∩ ({ p, q } : Set ℂ)ᶜ; + K ⊆ V := by classical - intro K N hKN p q hp hq hne hb V hV z hz + intro K N hKN p q hp hq hne V z hz refine ⟨hKN hz, ?_⟩ simp only [Set.mem_compl_iff, Set.mem_insert_iff, Set.mem_singleton_iff] rintro (rfl | rfl) @@ -1646,7 +1625,7 @@ theorem P3821T1ComponentContours (K N : Set ℂ) (hK : IsCompact K) let V := N ∩ ({p, q} : Set ℂ)ᶜ have hV : IsOpen V := hN.inter (isClosed_singleton.union isClosed_singleton).isOpen_compl - have hKV : K ⊆ V := ComponentContourDetails.hKV K N hKN p q hp hq hne hb hV + have hKV : K ⊆ V := ComponentContourDetails.hKV K N hKN p q hp hq hne obtain ⟨η, hη, hcollar⟩ := hK.exists_thickening_subset_open hV hKV obtain ⟨εp, hεp, hballp⟩ := Metric.isOpen_iff.mp hK.isClosed.isOpen_compl p hp obtain ⟨εq, hεq, hballq⟩ := Metric.isOpen_iff.mp hK.isClosed.isOpen_compl q hq diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean index 6d57dfb8cf..17d30f71c0 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean @@ -221,36 +221,11 @@ private theorem fseg₂ : simp [f, mid, q₂, not_le.mpr (by linarith : 1 < x), not_le.mpr h₂x, hc] -private theorem hint₀₁ : - ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), (a ≠ b) → (b ≠ - c) → (c ≠ a) → (P.adjacent a b) → (P.adjacent b c) → ∀ (h₀ : (↑(Set.Icc (0 : ℝ) 1) : - Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ((↑((h₀ : (↑(Set.Icc (0 : ℝ) 1) : Type) → - (↑(P.edgeArc a b) : Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position a) → ((↑((h₀ : - (↑(Set.Icc (0 : ℝ) 1) : Type) → (↑(P.edgeArc a b) : Type)) ⟨1, (by norm_num)⟩) : ℝ × ℝ) = - P.position b) → ∀ (h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), - ((↑((h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) → (↑(P.edgeArc b c) : Type)) ⟨0, (by norm_num)⟩) - : ℝ × ℝ) = P.position b) → ((↑((h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) → (↑(P.edgeArc b c) : - Type)) ⟨1, (by norm_num)⟩) : ℝ × ℝ) = P.position c) → ∀ (h₂ : (↑(Set.Icc (0 : ℝ) 1) : - Type) ≃ₜ (↑(P.edgeArc c a) : Type)), - let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := - ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ - let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) - let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) - let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) - (Continuous q₀) → (Continuous q₁) → - let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x - (Continuous mid) → - let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x - (Continuous f) → (f 0 = f 3) → ∀ [this : Fact (0 < (3 : ℝ))], - let ℓ : AddCircle (3 : ℝ) → Real × Real := AddCircle.liftIco 3 0 f - (Continuous ℓ) → (∀ (x : ℝ), ∀ (hx : 0 ≤ x), ∀ (h₁x : x ≤ 1), f x = (h₀ ⟨x, ⟨hx, h₁x⟩⟩ : - P.edgeArc a b)) → (∀ (x : ℝ), ∀ (h₁x : 1 < x), ∀ (h₂x : x ≤ 2), f x = (h₁ ⟨x - 1, ⟨by - linarith [h₁x], by linarith [h₂x]⟩⟩ : P.edgeArc b c)) → (∀ (x : ℝ), ∀ (h₂x : 2 < x), ∀ - (h₃x : x < 3), f x = (h₂ ⟨x - 2, ⟨by linarith [h₂x], by linarith [h₃x]⟩⟩ : P.edgeArc c - a)) → P.edgeArc a b ∩ P.edgeArc b c = {P.position b} := by +private theorem adjacentArcIntersection (ι : Type) (P : PlaneTriangulation ι) + (a b c : ι) (hab : a ≠ b) (hca : c ≠ a) + (eab : P.adjacent a b) (ebc : P.adjacent b c) : + P.edgeArc a b ∩ P.edgeArc b c = {P.position b} := by classical - intro ι P a b c hab hbc hca eab ebc h₀ h₀a h₀b h₁ h₁b h₁c h₂ clamp q₀ q₁ q₂ hq₀ hq₁ mid hmid f - hf hf0 this ℓ hℓc fseg₀ fseg₁ fseg₂ have hne : ({a, b} : Set ι) ≠ {b, c} := by intro hh have ha : a ∈ ({b, c} : Set ι) := by rw [← hh]; simp @@ -273,113 +248,6 @@ private theorem hint₀₁ : rw [hcommon] simp -private theorem hint₁₂ : - ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), (a ≠ b) → (b ≠ - c) → (c ≠ a) → (P.adjacent b c) → (P.adjacent c a) → ∀ (h₀ : (↑(Set.Icc (0 : ℝ) 1) : - Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ∀ (h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ - (↑(P.edgeArc b c) : Type)), ((↑((h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) → (↑(P.edgeArc b c) : - Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position b) → ((↑((h₁ : (↑(Set.Icc (0 : ℝ) 1) : - Type) → (↑(P.edgeArc b c) : Type)) ⟨1, (by norm_num)⟩) : ℝ × ℝ) = P.position c) → ∀ (h₂ : - (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc c a) : Type)), ((↑((h₂ : (↑(Set.Icc (0 - : ℝ) - 1) : Type) → (↑(P.edgeArc c a) : Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position c) → - ((↑((h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) → (↑(P.edgeArc c a) : Type)) ⟨1, (by norm_num)⟩) - : ℝ × ℝ) = P.position a) → - let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := - ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ - let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) - let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) - let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) - (Continuous q₁) → (Continuous q₂) → - let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x - (Continuous mid) → - let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x - (Continuous f) → (f 0 = f 3) → ∀ [this : Fact (0 < (3 : ℝ))], - let ℓ : AddCircle (3 : ℝ) → Real × Real := AddCircle.liftIco 3 0 f - (Continuous ℓ) → (∀ (x : ℝ), ∀ (hx : 0 ≤ x), ∀ (h₁x : x ≤ 1), f x = (h₀ ⟨x, ⟨hx, h₁x⟩⟩ : - P.edgeArc a b)) → (∀ (x : ℝ), ∀ (h₁x : 1 < x), ∀ (h₂x : x ≤ 2), f x = (h₁ ⟨x - 1, ⟨by - linarith [h₁x], by linarith [h₂x]⟩⟩ : P.edgeArc b c)) → (∀ (x : ℝ), ∀ (h₂x : 2 < x), ∀ - (h₃x : x < 3), f x = (h₂ ⟨x - 2, ⟨by linarith [h₂x], by linarith [h₃x]⟩⟩ : P.edgeArc c - a)) → (P.edgeArc a b ∩ P.edgeArc b c = {P.position b}) → P.edgeArc b c ∩ P.edgeArc c a = - {P.position c} := by - classical - intro ι P a b c hab hbc hca ebc eca h₀ h₁ h₁b h₁c h₂ h₂c h₂a clamp q₀ q₁ q₂ hq₁ hq₂ mid hmid f - hf hf0 this ℓ hℓc fseg₀ fseg₁ fseg₂ hint₀₁ - have hne : ({b, c} : Set ι) ≠ {c, a} := by - intro hh - have hb : b ∈ ({c, a} : Set ι) := by rw [← hh]; simp - simp [hbc, hab.symm] at hb - have hcommon : ({b, c} : Set ι) ∩ {c, a} = {c} := by - ext x - simp only [Set.mem_inter_iff, Set.mem_insert_iff, Set.mem_singleton_iff] - constructor - · rintro ⟨h, k⟩ - rcases h with h | h - · subst x - rcases k with k | k - · exact (hbc k).elim - · exact (hab k.symm).elim - · subst x - rfl - · rintro rfl - simp - rw [P.arc_intersections b c c a ebc eca hne] - rw [hcommon] - simp - -private theorem hint₂₀ : - ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), (a ≠ b) → (b ≠ - c) → (c ≠ a) → (P.adjacent a b) → (P.adjacent c a) → ∀ (h₀ : (↑(Set.Icc (0 : ℝ) 1) : - Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ((↑((h₀ : (↑(Set.Icc (0 : ℝ) 1) : Type) → - (↑(P.edgeArc a b) : Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position a) → ((↑((h₀ : - (↑(Set.Icc (0 : ℝ) 1) : Type) → (↑(P.edgeArc a b) : Type)) ⟨1, (by norm_num)⟩) : ℝ × ℝ) = - P.position b) → ∀ (h₁ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc b c) : Type)), ∀ - (h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc c a) : Type)), ((↑((h₂ : (↑(Set.Icc - (0 : ℝ) 1) : Type) → (↑(P.edgeArc c a) : Type)) ⟨0, (by norm_num)⟩) : ℝ × ℝ) = P.position - c) → ((↑((h₂ : (↑(Set.Icc (0 : ℝ) 1) : Type) → (↑(P.edgeArc c a) : Type)) ⟨1, (by - norm_num)⟩) : ℝ × ℝ) = P.position a) → - let clamp (x : ℝ) : Set.Icc (0 : ℝ) 1 := - ⟨max 0 (min x 1), ⟨le_max_left _ _, max_le_iff.mpr ⟨by norm_num, min_le_right _ _⟩⟩⟩ - let q₀ : ℝ → Real × Real := fun x => (h₀ (clamp x) : Real × Real) - let q₁ : ℝ → Real × Real := fun x => (h₁ (clamp (x - 1)) : Real × Real) - let q₂ : ℝ → Real × Real := fun x => (h₂ (clamp (x - 2)) : Real × Real) - (Continuous q₀) → (Continuous q₂) → - let mid : ℝ → Real × Real := fun x => if x ≤ 2 then q₁ x else q₂ x - (Continuous mid) → - let f : ℝ → Real × Real := fun x => if x ≤ 1 then q₀ x else mid x - (Continuous f) → (f 0 = f 3) → ∀ [this : Fact (0 < (3 : ℝ))], - let ℓ : AddCircle (3 : ℝ) → Real × Real := AddCircle.liftIco 3 0 f - (Continuous ℓ) → (∀ (x : ℝ), ∀ (hx : 0 ≤ x), ∀ (h₁x : x ≤ 1), f x = (h₀ ⟨x, ⟨hx, h₁x⟩⟩ : - P.edgeArc a b)) → (∀ (x : ℝ), ∀ (h₁x : 1 < x), ∀ (h₂x : x ≤ 2), f x = (h₁ ⟨x - 1, ⟨by - linarith [h₁x], by linarith [h₂x]⟩⟩ : P.edgeArc b c)) → (∀ (x : ℝ), ∀ (h₂x : 2 < x), ∀ - (h₃x : x < 3), f x = (h₂ ⟨x - 2, ⟨by linarith [h₂x], by linarith [h₃x]⟩⟩ : P.edgeArc c - a)) → (P.edgeArc a b ∩ P.edgeArc b c = {P.position b}) → (P.edgeArc b c ∩ P.edgeArc c a = - {P.position c}) → P.edgeArc c a ∩ P.edgeArc a b = {P.position a} := by - classical - intro ι P a b c hab hbc hca eab eca h₀ h₀a h₀b h₁ h₂ h₂c h₂a clamp q₀ q₁ q₂ hq₀ hq₂ mid hmid f - hf hf0 this ℓ hℓc fseg₀ fseg₁ fseg₂ hint₀₁ hint₁₂ - have hne : ({c, a} : Set ι) ≠ {a, b} := by - intro hh - have hc : c ∈ ({a, b} : Set ι) := by rw [← hh]; simp - simp [hca, hbc.symm] at hc - have hcommon : ({c, a} : Set ι) ∩ {a, b} = {a} := by - ext x - simp only [Set.mem_inter_iff, Set.mem_insert_iff, Set.mem_singleton_iff] - constructor - · rintro ⟨h, k⟩ - rcases h with h | h - · subst x - rcases k with k | k - · exact (hca k).elim - · exact (hbc k.symm).elim - · subst x - rfl - · rintro rfl - simp - rw [P.arc_intersections c a a b eca eab hne] - rw [hcommon] - simp - private theorem cross₀₁ : ∀ (ι : Type), ∀ (P : PlaneTriangulation ι), ∀ (a : ι), ∀ (b : ι), ∀ (c : ι), ∀ (h₀ : (↑(Set.Icc (0 : ℝ) 1) : Type) ≃ₜ (↑(P.edgeArc a b) : Type)), ((↑((h₀ : (↑(Set.Icc (0 : ℝ) @@ -760,15 +628,12 @@ theorem P3821T1ThreeArcCircle {ι : Type} (P : PlaneTriangulation ι) have fseg₂ (x : ℝ) (h₂x : 2 < x) (h₃x : x < 3) : f x = (h₂ ⟨x - 2, ⟨by linarith [h₂x], by linarith [h₃x]⟩⟩ : P.edgeArc c a) := ThreeArcCircleLemmas.fseg₂ ι P a b c h₀ h₁ h₂ clamp_eq_self x h₂x h₃x - have hint₀₁ : P.edgeArc a b ∩ P.edgeArc b c = {P.position b} := ThreeArcCircleLemmas.hint₀₁ ι P - a b c hab hbc hca eab ebc h₀ h₀a h₀b h₁ h₁b h₁c h₂ hq₀ hq₁ hmid hf hf0 (this := this) hℓc - fseg₀ fseg₁ fseg₂ - have hint₁₂ : P.edgeArc b c ∩ P.edgeArc c a = {P.position c} := ThreeArcCircleLemmas.hint₁₂ ι P - a b c hab hbc hca ebc eca h₀ h₁ h₁b h₁c h₂ h₂c h₂a hq₁ hq₂ hmid hf hf0 (this := this) hℓc - fseg₀ fseg₁ fseg₂ hint₀₁ - have hint₂₀ : P.edgeArc c a ∩ P.edgeArc a b = {P.position a} := ThreeArcCircleLemmas.hint₂₀ ι P - a b c hab hbc hca eab eca h₀ h₀a h₀b h₁ h₂ h₂c h₂a hq₀ hq₂ hmid hf hf0 (this := this) hℓc - fseg₀ fseg₁ fseg₂ hint₀₁ hint₁₂ + have hint₀₁ : P.edgeArc a b ∩ P.edgeArc b c = {P.position b} := + ThreeArcCircleLemmas.adjacentArcIntersection ι P a b c hab hca eab ebc + have hint₁₂ : P.edgeArc b c ∩ P.edgeArc c a = {P.position c} := + ThreeArcCircleLemmas.adjacentArcIntersection ι P b c a hbc hab ebc eca + have hint₂₀ : P.edgeArc c a ∩ P.edgeArc a b = {P.position a} := + ThreeArcCircleLemmas.adjacentArcIntersection ι P c a b hca hbc eca eab have cross₀₁ {x y : ℝ} (hx₀ : 0 ≤ x) (hx₁ : x ≤ 1) (hy₁ : 1 < y) (hy₂ : y ≤ 2) (hxy : f x = f y) : x = y := ThreeArcCircleLemmas.cross₀₁ ι P a b c h₀ h₀b h₁ h₁b h₂ fseg₀ fseg₁ hint₀₁ (x := x) (y := y) hx₀ hx₁ hy₁ hy₂ hxy diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean index e997e8f3fc..0e9d25a219 100644 --- a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean @@ -1515,17 +1515,7 @@ private theorem ht'At987 : calc t = dist z x := hdist.symm _ = rho := by simpa [Metric.mem_sphere, dist_eq_norm] using hzS -private theorem hnormAt994 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (u : ι → ℝ × ℝ), (∀ (c : ι), - P.plane.adjacent a c → ‖u c‖ = (1 : ℝ)) → (∀ (d : ι), (P.plane.adjacent a d) → (∀ (t - : ℝ), ((0 : ℝ) ≤ t) → (‖t • u d‖ = t))) ) := by - classical - intro ι P a u hunit d had t ht0 - rw [norm_smul, hunit d had, Real.norm_eq_abs, abs_of_nonneg ht0] - ring +private abbrev hnormAt994 := ApollonianSuperharmonic.FaceGapProof.hnormAt978 private abbrev hdistAt997 := ApollonianSuperharmonic.FaceGapProof.hdistAt981 diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean b/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean index 2278d084a1..2825e64dad 100644 --- a/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean @@ -35,13 +35,7 @@ private theorem huOrig : intro u hu uOrig exact hu -private theorem hvOrig : - ∀ (v : Real × Real), (‖v‖ = 1) → ( - let vOrig := v - ‖vOrig‖ = 1) := by - classical - intro v hv vOrig - exact hv +private abbrev hvOrig := ApollonianSuperharmonic.TwoRaySectorsProof.huOrig end TwoRaySectorsProof diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean index 04a26fe535..7f81d427b1 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean @@ -155,10 +155,8 @@ private theorem localResult : ∀ (p : P3723T1PolygonalParameterization g), ∀ (q : P3723T1PolygonalParameterization h), ∀ (hgrange : Set.range g = S), - P3934T1PolygonalSide U₁ g p e → - ∀ (hhrange : Set.range h = S), - P3934T1PolygonalSide U₂ h q d → - let gfun : Set.Icc (0 : Real) 1 → S := fun x => + ∀ (hhrange : Set.range h = S), + let gfun : Set.Icc (0 : Real) 1 → S := fun x => ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; let hfun : Set.Icc (0 : Real) 1 → S := fun x => ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; @@ -177,8 +175,6 @@ private theorem localResult : let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont; let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := GH.trans HH.symm; - let i0 : Fin p.count := ⟨0, p.positive⟩; - let j0 : Fin q.count := ⟨0, q.positive⟩; let i1 : Fin (p.count + 1) := ⟨1, by have hp := p.positive; omega⟩; let j1 : Fin (q.count + 1) := @@ -193,21 +189,15 @@ private theorem localResult : ∀ (hcpos : 0 < c), ∀ (hc_le_one : c ≤ 1), let r1 : Set.Icc (0 : Real) 1 := - ⟨c / 3, ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ + ⟨c / 3, ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩; let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ - let xL : Set.Icc (0 : Real) 1 := phi.symm r1 - let xR : Set.Icc (0 : Real) 1 := phi.symm r2 + ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩; + let xL : Set.Icc (0 : Real) 1 := phi.symm r1; + let xR : Set.Icc (0 : Real) 1 := phi.symm r2; ∀ (Bg : ℝ × ℝ), Bg ≠ (0 : ℝ × ℝ) → - (∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), - p.time i0.castSucc < (↑t : ℝ) → - (↑t : ℝ) < p.time i0.succ → P3934T1LocalSide U₁ (g t) Bg e) → ∀ (Bh : ℝ × ℝ), - (∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), - q.time j0.castSucc < (↑t : ℝ) → - (↑t : ℝ) < q.time j0.succ → P3934T1LocalSide U₂ (h t) Bh d) → let scale : Real := ((xR : Real) - (xL : Real)) / ((r2 : Real) - (r1 : Real)) 0 < scale → @@ -217,9 +207,9 @@ private theorem localResult : P3934T1LocalSide U₂ z Bh d → (U₁ = U₂ → e = d) ∧ (Disjoint U₁ U₂ → e ≠ d) := by classical - intro S e d U₁ U₂ g h p q hgrange hps hhrange hqs gfun hfun hgfun_inj hhfun_inj hgfun_surj - hhfun_surj ge he hgfun_cont hhfun_cont GH HH phi i0 j0 i1 j1 hpi hqj hpi1 hqj1 α β c hcpos - hc_le_one r1 r2 xL xR Bg hBg hgside Bh hhside scale hscale_pos hscale z hlocG hlocH + intro S e d U₁ U₂ g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj + ge he hgfun_cont hhfun_cont GH HH phi i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_one r1 r2 + xL xR Bg hBg Bh scale hscale_pos hscale z hlocG hlocH rcases hlocG with ⟨r, hr, hEqU⟩ rcases hlocH with ⟨s, hs, hEqV⟩ let v : Real × Real := (-Bg.2, Bg.1) @@ -1324,10 +1314,10 @@ private theorem compareCore : rw [hz] at hh change P3934T1LocalSide U₂ (g xL) Bh d at hh exact hh - have localResult := ArcComparisonGeometry.localResult S e d U₁ U₂ g h p q hgrange hps hhrange - hqs hgfun_inj + have localResult := ArcComparisonGeometry.localResult S e d U₁ U₂ g h p q hgrange hhrange + hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hpi hqj hpi1 hqj1 hcpos - hc_le_one Bg hBg hgside Bh hhside hscale_pos hscale hlocG hlocH + hc_le_one Bg hBg Bh hscale_pos hscale hlocG hlocH exact localResult end ArcComparisonMainProof diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean index db5e1b3afa..eb2d837fa4 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean @@ -754,32 +754,63 @@ private theorem noExtra : exact noThreeDir i j k hij hik hjk ha hb hc private theorem cyclicToEdge : - ∀ (F : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (u : GaussianInt), ∀ (v : - GaussianInt), ((4 : ℕ) ≤ p.length) → ((p.head? = some u) → ((p.getLast? = some v) → - ((FourNeighborAdjacent v u) → ((∀ (e : Finset GaussianInt), e ∈ F ↔ e = {v, u} ∨ ∃ (a : - GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ - a :: b :: l₂ ∧ e = {a, b}) → (( - let cyclicEdges := p.zip p.tail ++ [(v, u)]; - ∀ (q : LatticeCell), ((q + (1 : LatticeCell), q - + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ - cyclicEdges ∧ (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell)) ∉ - cyclicEdges → GridRayCrossingIndex (q + (1 : LatticeCell)) p = GridRayCrossingIndex q p) - ∧ ((q + (1 : LatticeCell), q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ (q - + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell)) ∈ cyclicEdges → - (GridRayCrossingIndex (q + (1 : LatticeCell)) p - GridRayCrossingIndex q p).natAbs = (1 : - ℕ)) ∧ ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges - ∧ (q + ⟨(0 : ℤ), (1 : ℤ)⟩, q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ cyclicEdges → - GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) p = GridRayCrossingIndex q p) ∧ ((q + (1 : - LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges ∨ (q + ⟨(0 : ℤ), - (1 : ℤ)⟩, q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ cyclicEdges → - (GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) p - GridRayCrossingIndex q p).natAbs = (1 - : ℕ))) → ((∀ (g : Finset GaussianInt), (g ∈ F) → (g = {v, u} ∨ ∃ a b l₁ l₂, p = l₁ ++ a - :: b :: l₂ ∧ g = {a, b})) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), (({a, b} : Finset - GaussianInt) ∈ F) → ((a, b) ∈ (p.zip p.tail) ++ [(v, u)] ∨ (b, a) ∈ (p.zip p.tail) ++ - [(v, u)])) → ((u ∈ p) → ((v ∈ p) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), (a, b) ∈ - p.zip p.tail ++ [(v, u)] → {a, b} ∈ F)))))))))) := by + ∀ (F : Set (Finset GaussianInt)), + ∀ (p : List GaussianInt), + ∀ (u : GaussianInt), + ∀ (v : GaussianInt), + (4 : ℕ) ≤ p.length → + p.head? = some u → + p.getLast? = some v → + (∀ (e : Finset GaussianInt), + e ∈ F ↔ + e = { v, u } ∨ + ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ + : List GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = { a, b }) → + (let cyclicEdges := p.zip p.tail ++ [(v, u)]; + ∀ (q : LatticeCell), + ((q + (1 : LatticeCell), + q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ + cyclicEdges ∧ + (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, + q + (1 : LatticeCell)) ∉ + cyclicEdges → + GridRayCrossingIndex (q + (1 : LatticeCell)) p = + GridRayCrossingIndex q p) ∧ + ((q + (1 : LatticeCell), + q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ + cyclicEdges ∨ + (q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, + q + (1 : LatticeCell)) ∈ + cyclicEdges → + (GridRayCrossingIndex (q + (1 : LatticeCell)) p - + GridRayCrossingIndex q p).natAbs = + (1 : ℕ)) ∧ + ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, + q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ + cyclicEdges ∧ + (q + ⟨(0 : ℤ), (1 : ℤ)⟩, + q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∉ + cyclicEdges → + GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) p = + GridRayCrossingIndex q p) ∧ + ((q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩, + q + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ + cyclicEdges ∨ + (q + ⟨(0 : ℤ), (1 : ℤ)⟩, + q + (1 : LatticeCell) + ⟨(0 : ℤ), (1 : ℤ)⟩) ∈ + cyclicEdges → + (GridRayCrossingIndex (q + ⟨(0 : ℤ), (1 : ℤ)⟩) p - + GridRayCrossingIndex q p).natAbs = + (1 : ℕ))) → + (∀ (g : Finset GaussianInt), + g ∈ F → + g = { v, u } ∨ + ∃ a b l₁ l₂, p = l₁ ++ a :: b :: l₂ ∧ g = { a, b }) → + ∀ (a : GaussianInt), + ∀ (b : GaussianInt), + (a, b) ∈ p.zip p.tail ++ [(v, u)] → { a, b } ∈ F := by classical - intro F p u v hlen hhead hlast hclose hedges hcross hcycleEdge cyclicPair huMem hvMem a b hab + intro F p u v hlen hhead hlast hedges hcross hcycleEdge a b hab rcases List.mem_append.mp hab with h | h · rw [List.mem_iff_getElem] at h rcases h with ⟨i, hi, hpair⟩ @@ -998,32 +1029,7 @@ private theorem hWeqAt1029 : have h := crossNorthEq c2 hnc simpa [I, c1, c2, c2i] using h -private theorem hNeqAt1093 : - ∀ (F : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (p : List GaussianInt), ∀ (u : - GaussianInt), ∀ (v : GaussianInt), - let c0 : GaussianInt := x - let c1 : GaussianInt := x - 1 - (∀ (a : GaussianInt), ∀ (b : GaussianInt), ((a, b) ∈ p.zip p.tail ++ [(v, u)]) → (({a, b} : - Finset GaussianInt) ∈ F)) → ( - let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p - (∀ (q : GaussianInt), ((q + 1, q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ (q + 1 + ⟨0, 1⟩, - q + 1) ∉ p.zip p.tail ++ [(v, u)]) → (GridRayCrossingIndex (q + 1) p = - GridRayCrossingIndex q p)) → ((c1 + 1 = x) → ((({x, x + ⟨0, 1⟩} : Finset GaussianInt) ∉ - F) → (I c0 = I c1)))) := by - classical - intro F x p u v c0 c1 cyclicToEdge I crossEastEq c1add hNabsent - have hnc : - (c1 + 1, c1 + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ - (c1 + 1 + ⟨0, 1⟩, c1 + 1) ∉ p.zip p.tail ++ [(v, u)] := by - constructor - · intro h - apply hNabsent - convert cyclicToEdge _ _ h using 1; simp [c1] - · intro h - apply hNabsent - convert cyclicToEdge _ _ h using 1; simp [c1, Finset.pair_comm] - have h := crossEastEq c1 hnc - simpa [I, c0, c1, c1add] using h +private abbrev hNeqAt1093 := ApollonianSuperharmonic.ExteriorMixedCycleProof.hNeqAt966 private theorem verticalSupport : (∀ (a : GaussianInt), @@ -2035,7 +2041,7 @@ theorem P3963T1ExteriorMixedCycleObstruction have cyclicToEdge (a b : GaussianInt) (hab : (a, b) ∈ p.zip p.tail ++ [(v, u)]) : ({a, b} : Finset GaussianInt) ∈ F := ExteriorMixedCycleProof.cyclicToEdge F p u v hlen - hhead hlast hclose hedges hcross hcycleEdge cyclicPair huMem hvMem a b hab + hhead hlast hedges hcross hcycleEdge a b hab let I : GaussianInt → Int := fun q => GridRayCrossingIndex q p have crossEastEq (q : GaussianInt) (hnc : (q + 1, q + 1 + ⟨0, 1⟩) ∉ p.zip p.tail ++ [(v, u)] ∧ diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean index 88add13604..87f6ae69a8 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean @@ -339,11 +339,7 @@ private theorem hp₁ne : intro p₁ hlen₁ h simp [h] at hlen₁ -private theorem hp₂ne : - ∀ (p₂ : List GaussianInt), ((4 : ℕ) ≤ p₂.length) → (p₂ ≠ []) := by - classical - intro p₂ hlen₂ h - simp [h] at hlen₂ +private abbrev hp₂ne := ApollonianSuperharmonic.MixedCycleDetails.hp₁ne private theorem hx₁ : ∀ (V₁ : Set GaussianInt), ∀ (V₂ : Set GaussianInt), ∀ (p₁ : List GaussianInt), (V₁ = @@ -361,21 +357,9 @@ private theorem hx₂ : rw [hV₂] at hx exact List.mem_toFinset.mp hx.2 -private theorem hy₁ : - ∀ (V₁ : Set GaussianInt), ∀ (V₂ : Set GaussianInt), ∀ (p₁ : List GaussianInt), (V₁ = - (↑p₁.toFinset : Set GaussianInt)) → (∀ (y : GaussianInt), (y ∈ V₁ ∩ V₂) → (y ∈ p₁)) := by - classical - intro V₁ V₂ p₁ hV₁ y hy - rw [hV₁] at hy - exact List.mem_toFinset.mp hy.1 +private abbrev hy₁ := ApollonianSuperharmonic.MixedCycleDetails.hx₁ -private theorem hy₂ : - ∀ (V₁ : Set GaussianInt), ∀ (V₂ : Set GaussianInt), ∀ (p₂ : List GaussianInt), (V₂ = - (↑p₂.toFinset : Set GaussianInt)) → (∀ (y : GaussianInt), (y ∈ V₁ ∩ V₂) → (y ∈ p₂)) := by - classical - intro V₁ V₂ p₂ hV₂ y hy - rw [hV₂] at hy - exact List.mem_toFinset.mp hy.2 +private abbrev hy₂ := ApollonianSuperharmonic.MixedCycleDetails.hx₂ private theorem hrot₁x : ∀ (p₁ : List GaussianInt), ∀ (x : GaussianInt), (x ∈ p₁) → ((p₁.idxOf x < p₁.length) → @@ -385,13 +369,7 @@ private theorem hrot₁x : rw [List.head?_rotate hidx₁x] exact List.getElem?_idxOf hx₁ -private theorem hrot₂x : - ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), (x ∈ p₂) → ((p₂.idxOf x < p₂.length) → - ((p₂.rotate (p₂.idxOf x)).head? = some x)) := by - classical - intro p₂ x hx₂ hidx₂x - rw [List.head?_rotate hidx₂x] - exact List.getElem?_idxOf hx₂ +private abbrev hrot₂x := ApollonianSuperharmonic.MixedCycleDetails.hrot₁x private theorem cycle_chain : ∀ (p : List GaussianInt), @@ -489,14 +467,13 @@ private theorem hxNotTail : exact (List.nodup_cons.mp this).1 private theorem hzx : - ∀ (V₁ : Set GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), - let c₂ := p₂.rotate (p₂.idxOf x) - let good (z : GaussianInt) : Bool := @decide (z ∉ V₁) (Classical.propDecidable _) - let rest₂ := c₂.tail.dropWhile good - ∀ (z : GaussianInt), ∀ (zs : List GaussianInt), (rest₂ = z :: zs) → ((z ∈ V₁) → ((z ∈ - c₂.tail) → ((x ∉ c₂.tail) → (z ≠ x)))) := by + Set GaussianInt → + ∀ (p₂ : List GaussianInt), + ∀ (x : GaussianInt), + let c₂ := p₂.rotate (p₂.idxOf x); + ∀ (z : GaussianInt), List GaussianInt → z ∈ c₂.tail → x ∉ c₂.tail → z ≠ x := by classical - intro V₁ p₂ x c₂ good rest₂ z zs hrest₂ hzV₁ hzTail hxNotTail h + intro V₁ p₂ x c₂ z zs hzTail hxNotTail h subst z exact hxNotTail hzTail @@ -655,29 +632,9 @@ private theorem hp₁cycleeq : apply Cycle.coe_eq_coe.mpr exact (List.isRotated_iff_mod).2 ⟨p₁.idxOf z, Nat.le_of_lt hidx₁z, rfl⟩ -private theorem hc₁edgeCycle : - ∀ (E₁ : Set (Finset GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - (Cycle.Chain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁) (p₁ : Cycle GaussianInt)) → - (((p₁ : Cycle GaussianInt) = (c₁ : Cycle GaussianInt)) → (Cycle.Chain (fun u v => ({u, v} - : Finset GaussianInt) ∈ E₁) - (c₁ : Cycle GaussianInt))) := by - classical - intro E₁ p₁ z c₁ sourceE₁ hp₁cycleeq - rw [← hp₁cycleeq] - exact sourceE₁ +private abbrev hc₁edgeCycle := ApollonianSuperharmonic.MixedCycleDetails.hc₂edgeCycle -private theorem hc₁edgeChain : - ∀ (E₁ : Set (Finset GaussianInt)), ∀ (p₁ : List GaussianInt), ∀ (z : GaussianInt), - let c₁ := p₁.rotate (p₁.idxOf z) - (c₁ = z :: c₁.tail) → ((Cycle.Chain (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁) (c₁ : - Cycle GaussianInt)) → ((z :: (c₁.tail ++ [z])).IsChain - (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁))) := by - classical - intro E₁ p₁ z c₁ hc₁shape hc₁edgeCycle - rw [hc₁shape] at hc₁edgeCycle - exact (Cycle.chain_coe_cons (fun u v => ({u, v} : Finset GaussianInt) ∈ E₁) - z c₁.tail).mp hc₁edgeCycle +private abbrev hc₁edgeChain := ApollonianSuperharmonic.MixedCycleDetails.hc₂edgeChain private theorem hQlast : ∀ (V₁ : Set GaussianInt), ∀ (p₂ : List GaussianInt), ∀ (x : GaussianInt), @@ -1316,7 +1273,7 @@ theorem P3963T1MixedBoundaryCycle List.takeWhile_append_dropWhile have hzTail := MixedCycleDetails.hzTail V₁ p₂ x z zs hrest₂ have hxNotTail := MixedCycleDetails.hxNotTail p₂ x hrot₂x hc₂nodup - have hzx := MixedCycleDetails.hzx V₁ p₂ x z zs hrest₂ hzV₁ hzTail hxNotTail + have hzx := MixedCycleDetails.hzx V₁ p₂ x z zs hzTail hxNotTail have hq2head : (x :: (c₂.tail.takeWhile good ++ [z])).head? = some x := by simp let c₁ := p₁.rotate (p₁.idxOf z) have hidx₁z : p₁.idxOf z < p₁.length := diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean b/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean index 4ad61ed6ca..22338dca0a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean +++ b/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.P3996T1SRowTable public import LeanPool.ApollonianSuperharmonic.P3045T1RightBoundaryDisplacementAlgebra @@ -365,20 +366,7 @@ private theorem flip_incoming : exact (VectorRecursionLaws bundle.normalizedPresentation bundle.configuration.proper.1).2.2.2.2 bundle.configuration.proper i |>.1 -private theorem realPoint_injective : - (by - classical - exact - Function.Injective GaussianRealPoint ) := by - classical - intro v w h - apply Zsqrtd.ext - · have h' := congrArg Prod.fst h - dsimp [GaussianRealPoint] at h' - exact_mod_cast h' - · have h' := congrArg Prod.snd h - dsimp [GaussianRealPoint] at h' - exact_mod_cast h' +private abbrev realPoint_injective := ApollonianSuperharmonic.GaussianRealPointProperties.injective private theorem branchDisplacement_nonzero : (by @@ -527,14 +515,7 @@ private theorem centerAlgSecond : have hreal := congrArg GaussianRealPoint hvec exact cancel2 _ _ (hleft.trans (hreal.trans hright)) -private theorem gp_neg_any : - (by - classical - exact - ∀ (g : GaussianInt), GaussianRealPoint (-g) = -GaussianRealPoint g ) := by - classical - intro g - ext <;> simp [GaussianRealPoint] +private abbrev gp_neg_any := ApollonianSuperharmonic.GaussianRealPointProperties.negation private theorem first_center : (by @@ -726,15 +707,7 @@ private theorem third_period : rw [h1, h2, h3] ring -private theorem gp_add : - (by - classical - exact - ∀ (v : GaussianInt), ∀ (w : GaussianInt), GaussianRealPoint (v + w) = GaussianRealPoint v - + GaussianRealPoint w ) := by - classical - intro v w - ext <;> simp [GaussianRealPoint] +private abbrev gp_add := ApollonianSuperharmonic.GaussianRealPointProperties.add private theorem parent_center : (by @@ -865,7 +838,8 @@ private theorem row_data : bundle.routedDirection), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : BandOrderedGeneralSelectedContactRow bundle.normalizedPresentation bundle.configuration bundle.normalizedCircle bundle.normalizedFixed placement.layout - a b), (placement.exteriorIndex = a) → ((placement.centralIndex = b) → (∀ (z : + a b), (placement.exteriorIndex = a) → ( + (∀ (z : P3996T1SRowParameters), (P3996T1SRowTable bundle.normalizedPresentation bundle.configuration bundle.normalizedCircle bundle.normalizedFixed placement.layout row = some z) → ( @@ -917,7 +891,7 @@ private theorem row_data : (branchDisplacement bundle.selectedSlot) n ∧ z.oldShift = if n.val < 2 then -o bundle.selectedSlot else o bundle.selectedSlot))))))))))) ) := by classical - intro C D T N h k x bundle placement a b row ha hb z hz occurrence exteriorSlot selected_slot I + intro C D T N h k x bundle placement a b row ha z hz occurrence exteriorSlot selected_slot I branchDisplacement quarterTurn branchCenter cOff gp_neg_any q o e d exteriorCenter period0 period1 third_period gp_add occurrence_center raw_centers -- Evaluate the twelve literal exterior occurrences using the shared centers. @@ -1094,6 +1068,7 @@ theorem P3996T1PlacementCompanionBlocks BandVectors.1 (q 0) (q placement.rightSecondSlot.succ) = z.oldShift) := by -- BODY classical + subst hb -- Distinct parent areas identify the selected slot without assuming its sign. have area_of_band := PlacementCompanionGeometry.area_of_band let occurrence := SubtileOccurrenceInterpretation placement.layout.P @@ -1191,8 +1166,9 @@ theorem P3996T1PlacementCompanionBlocks have translate_center (V : ProtoTile) (w : GaussianInt) : TileCentroid (TileTranslation V w) = TileCentroid V + GaussianRealPoint w := (TileTranslationFormulas V w).2.2.2.2.1 - have row_data := PlacementCompanionGeometry.row_data C D T N h k x bundle placement a b row ha - hb z hz + have row_data := PlacementCompanionGeometry.row_data C D T N h k x bundle placement a + placement.centralIndex row ha z + hz selected_slot gp_neg_any period0 period1 (PlacementCompanionGeometry.third_period C D T N h k x bundle) (PlacementCompanionGeometry.gp_add) (PlacementCompanionGeometry.occurrence_center C D T N h k x bundle placement diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean index 9192217ea3..574aa4084e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean @@ -64,53 +64,13 @@ private theorem haUim : have h := congrArg Prod.snd haU simpa [GaussianRealPoint] using h -private theorem haWre : - (by - classical - exact - ∀ (W : ProtoTile), ∀ (aW : GaussianInt), (GaussianRealPoint aW = ((TileCentroid W).1 + - (TileCentroid W).2, (TileCentroid W).2 - (TileCentroid W).1)) → ((aW.re : Real) = - (TileCentroid W).1 + (TileCentroid W).2) ) := by - classical - intro W aW haW - have h := congrArg Prod.fst haW - simpa [GaussianRealPoint] using h +private abbrev haWre := ApollonianSuperharmonic.OppositeEndpointGeometry.haUre -private theorem haWim : - (by - classical - exact - ∀ (W : ProtoTile), ∀ (aW : GaussianInt), (GaussianRealPoint aW = ((TileCentroid W).1 + - (TileCentroid W).2, (TileCentroid W).2 - (TileCentroid W).1)) → ((aW.im : Real) = - (TileCentroid W).2 - (TileCentroid W).1) ) := by - classical - intro W aW haW - have h := congrArg Prod.snd haW - simpa [GaussianRealPoint] using h +private abbrev haWim := ApollonianSuperharmonic.OppositeEndpointGeometry.haUim -private theorem haZre : - (by - classical - exact - ∀ (Z : ProtoTile), ∀ (aZ : GaussianInt), (GaussianRealPoint aZ = ((TileCentroid Z).1 + - (TileCentroid Z).2, (TileCentroid Z).2 - (TileCentroid Z).1)) → ((aZ.re : Real) = - (TileCentroid Z).1 + (TileCentroid Z).2) ) := by - classical - intro Z aZ haZ - have h := congrArg Prod.fst haZ - simpa [GaussianRealPoint] using h +private abbrev haZre := ApollonianSuperharmonic.OppositeEndpointGeometry.haUre -private theorem haZim : - (by - classical - exact - ∀ (Z : ProtoTile), ∀ (aZ : GaussianInt), (GaussianRealPoint aZ = ((TileCentroid Z).1 + - (TileCentroid Z).2, (TileCentroid Z).2 - (TileCentroid Z).1)) → ((aZ.im : Real) = - (TileCentroid Z).2 - (TileCentroid Z).1) ) := by - classical - intro Z aZ haZ - have h := congrArg Prod.snd haZ - simpa [GaussianRealPoint] using h +private abbrev haZim := ApollonianSuperharmonic.OppositeEndpointGeometry.haUim private theorem hWpCent : (by @@ -397,29 +357,9 @@ private theorem hUedges : ext e simp only [FootprintEdges, Set.mem_ofPred_eq, hUc] -private theorem hWedges : - (by - classical - exact - ∀ (W : ProtoTile), ∀ (aW : GaussianInt), ((TileTranslation (TileQuarterTurn W) aW).cells - = W.cells) → (FootprintEdges (TileTranslation (TileQuarterTurn W) aW) = - FootprintEdges W) ) := by - classical - intro W aW hWc - ext e - simp only [FootprintEdges, Set.mem_ofPred_eq, hWc] +private abbrev hWedges := ApollonianSuperharmonic.OppositeEndpointGeometry.hUedges -private theorem hZedges : - (by - classical - exact - ∀ (Z : ProtoTile), ∀ (aZ : GaussianInt), ((TileTranslation (TileQuarterTurn Z) aZ).cells - = Z.cells) → (FootprintEdges (TileTranslation (TileQuarterTurn Z) aZ) = - FootprintEdges Z) ) := by - classical - intro Z aZ hZc - ext e - simp only [FootprintEdges, Set.mem_ofPred_eq, hZc] +private abbrev hZedges := ApollonianSuperharmonic.OppositeEndpointGeometry.hUedges private theorem hFvU : (by @@ -935,76 +875,24 @@ private theorem hstep : (by classical exact - ∀ (r : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (U : - ProtoTile), ∀ (W : ProtoTile), ∀ (Z : ProtoTile), - let q : GaussianInt := ⟨0, 1⟩ - ∀ (aU : GaussianInt), (GaussianRealPoint aU = ((TileCentroid U).1 + (TileCentroid U).2, - (TileCentroid U).2 - (TileCentroid U).1)) → (((TileTranslation (TileQuarterTurn U) - aU).cells = U.cells) → ((U.cells = ∅ → (TileTranslation (TileQuarterTurn U) - aU).anchor = U.anchor) → ((FootprintVertices (TileTranslation (TileQuarterTurn U) aU) - = FootprintVertices U) → (∀ (aW : GaussianInt), ∀ (aZ : GaussianInt), - let Wp := TileTranslation W (aU - aW) - let Zp := TileTranslation Z (aU - aZ) - (BandPrototile (r i.succ) Wp) → ((BandPrototile (r ((if Even s.val then i - 1 else i + - 1).succ)) Zp) → (((aU.re : Real) = (TileCentroid U).1 + (TileCentroid U).2) → - (((aU.im : Real) = (TileCentroid U).2 - (TileCentroid U).1) → ((TileCentroid Wp - - TileCentroid U = (-(TileCentroid W - TileCentroid U).2, (TileCentroid W - - TileCentroid U).1)) → ((TileCentroid Zp - TileCentroid U = (-(TileCentroid Z - - TileCentroid U).2, (TileCentroid Z - TileCentroid U).1)) → ( - let t : Fin 4 := s + 1 - (TileCentroid Wp - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * - (BandVectors.1 (r i.succ) (r 0) + BandVectors.1 (r 0) (r i.succ)))) → ((TileCentroid - Zp - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * (if Even t.val - then BandVectors.1 (r ((i + 1).succ)) (r 0) - BandVectors.1 (r 0) (r ((i + 1).succ)) - else BandVectors.1 (r 0) (r ((i - 1).succ)) - BandVectors.1 (r ((i - 1).succ)) (r - 0)))) → ( - ((pairedEndpointPackage r U) i t Wp - Zp) → ( - let F : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x + aU - let f : GaussianInt → GaussianInt := fun x => - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))) - (∀ (x : GaussianInt), f (F x) = x) → ((∀ (x : GaussianInt), F (f x) = x) → - ((Function.Injective f) → ((FootprintEdges (TileTranslation (TileQuarterTurn U) aU) = - FootprintEdges U) → ((FootprintVertices U = F '' FootprintVertices U) → - ((FootprintEdges U = (fun e : Finset GaussianInt => e.image F) '' FootprintEdges U) → - ((FootprintVertices Wp = F '' FootprintVertices W) → ((FootprintVertices Zp = F '' - FootprintVertices Z) → ((FootprintEdges Wp = (fun e : Finset GaussianInt => e.image - F) '' FootprintEdges W) → ((FootprintEdges Zp = (fun e : Finset GaussianInt => - e.image F) '' FootprintEdges Z) → ((∀ (S : Set GaussianInt), f '' (F '' S) = S) → ((∀ - (E : Set (Finset GaussianInt)), (fun e : Finset GaussianInt => e.image f) '' ((fun e - : Finset GaussianInt => e.image F) '' E) = E) → ((∀ (v : GaussianInt), F ∘ - GaussianTranslation v = GaussianTranslation (GaussianQuarterTurn v) ∘ F) → ((∀ (v : - GaussianInt), (fun e : Finset GaussianInt => e.image F) ∘ (fun e : Finset GaussianInt - => e.image (GaussianTranslation v)) = (fun e : Finset GaussianInt => e.image - (GaussianTranslation (GaussianQuarterTurn v))) ∘ (fun e : Finset GaussianInt => - e.image F)) → ((∀ (v : GaussianInt), FootprintVertices (TileTranslation U - (GaussianQuarterTurn v)) = F '' FootprintVertices (TileTranslation U v)) → ((∀ (v : - GaussianInt), FootprintEdges (TileTranslation U (GaussianQuarterTurn v)) = (fun e : - Finset GaussianInt => e.image F) '' FootprintEdges (TileTranslation U v)) → ( - let q3 : GaussianInt → GaussianInt := fun x => - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) - (FootprintVertices U = f '' FootprintVertices U) → ((FootprintEdges U = (fun e : Finset - GaussianInt => e.image f) '' FootprintEdges U) → ((FootprintVertices W = f '' - FootprintVertices Wp) → ((FootprintVertices Z = f '' FootprintVertices Zp) → - ((FootprintEdges W = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges Wp) - → ((FootprintEdges Z = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges - Zp) → ((∀ (v : GaussianInt), FootprintVertices (TileTranslation U (q3 v)) = f '' - FootprintVertices (TileTranslation U v)) → ((∀ (v : GaussianInt), FootprintEdges - (TileTranslation U (q3 v)) = (fun e : Finset GaussianInt => e.image f) '' - FootprintEdges (TileTranslation U v)) → (∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 - ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → (f b = f a + 1 ∨ f b = f a - 1 ∨ f b = f a + ⟨0, - 1⟩ ∨ f b = f a - ⟨0, 1⟩)))))))))))))))))))))))))))))))))))))) ) := by + (Fin (4 : ℕ) → CircleCoordinates) → + Fin (3 : ℕ) → + Fin (4 : ℕ) → + ProtoTile → + ProtoTile → + ∀ (aU : GaussianInt), + GaussianInt → + GaussianInt → + let f : GaussianInt → GaussianInt := fun x => + GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn (x - aU))); + ∀ a b : GaussianInt, + b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩ → + f b = f a + 1 ∨ + f b = f a - 1 ∨ f b = f a + ⟨0, 1⟩ ∨ f b = f a - ⟨0, 1⟩ + ) := by classical - intro r i s U W Z q aU haU hUc hUa hUv aW aZ Wp Zp hWp hZp haUre haUim hWpCent hZpCent t hWsrc - hZsrc sourceData F f hFf hfF hf hUedges hFvU hFeU hFvW hFvZ hFeW hFeZ hinvV hinvE - hFtranslate hFtranslateE hFchildV hFchildE q3 hbaseV hbaseE hparentWV hparentZV hparentWE - hparentZE hchildV hchildE a b hab - let uR : GaussianInt := q ^ s.val * - (if Even s.val then BandVectors.1 (r 0) (r i.succ) - else BandVectors.1 (r i.succ) (r 0)) - let uL : GaussianInt := q ^ s.val * - (if Even s.val then BandVectors.1 (r i.succ) (r 0) - else BandVectors.1 (r 0) (r i.succ)) + intro r i s W Z aU aW aZ f a b hab rcases hab with h | h | h | h · subst b right @@ -1300,10 +1188,7 @@ theorem P4055T1OrderedGeneralOppositeEndpoints : even2 notEven1 notEven3 hq3mul have hdispL := OppositeEndpointGeometry.hdispL r i s hq2 hq3 hq2act even0 even2 notEven1 notEven3 hq3mul - have hstep := OppositeEndpointGeometry.hstep r i s U W Z aU - haU hUc hUa hUv aW aZ hWp hZp haUre haUim hWpCent hZpCent hWsrc hZsrc sourceData hFf - hfF hf hUedges hFvU hFeU hFvW hFvZ hFeW hFeZ hinvV hinvE hFtranslate hFtranslateE - hFchildV hFchildE hbaseV hbaseE hparentWV hparentZV hparentWE hparentZE hchildV hchildE + have hstep := OppositeEndpointGeometry.hstep r i s W Z aU aW aZ rcases sourceData with ⟨Rsrc, Isrc, Asrc, hRsrc, hIneq, hICA, hRCA, hAAB⟩ have hchildVR := OppositeEndpointGeometry.hchildVR r i s U aU hchildV hdispR diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean index 494af7aa7c..c2963aee34 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandQuadrupleCyclicRotation public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryCovariance @@ -24,37 +25,7 @@ namespace ApollonianSuperharmonic namespace PlacementNormalizationProof -private theorem hq : - (by - classical - exact - ∀ (r : Fin 4 → CircleCoordinates), (ProperBandQuadruple r) → (∀ (a : Fin 3), - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - ProperBandQuadruple q) ) := by - classical - intro r hproper a q - fin_cases a - · convert hproper using 1; funext x; fin_cases x <;> rfl - · have rotated := SemiProperQuadruple.rotate hproper.1 - have properRotated : ProperBandQuadruple ![r 0, r 2, r 3, r 1] := by - refine ⟨rotated, ?_⟩ - intro j - fin_cases j - · simpa using hproper.2 (1 : Fin 3) - · simpa using hproper.2 (2 : Fin 3) - · simpa using hproper.2 (0 : Fin 3) - simpa [q] using properRotated - · have rotated := SemiProperQuadruple.rotate - (SemiProperQuadruple.rotate hproper.1) - have properRotated : ProperBandQuadruple ![r 0, r 3, r 1, r 2] := by - refine ⟨rotated, ?_⟩ - intro j - fin_cases j - · simpa using hproper.2 (2 : Fin 3) - · simpa using hproper.2 (0 : Fin 3) - · simpa using hproper.2 (1 : Fin 3) - simpa [q] using properRotated +private abbrev hq := ApollonianSuperharmonic.BandQuadrupleCyclicRotation.proper private theorem hU' : (by @@ -734,54 +705,70 @@ private theorem hdispW : (by classical exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (W - : ProtoTile), ∀ (Z : ProtoTile), (BandPrototile (r (if Even (↑s : ℕ) then i - (1 : - Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ) Z) → (((0 : ℤ) < (r (if Even (↑s : ℕ) - then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → ((TileCentroid W - - TileCentroid U = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ^ (↑s : ℕ) * (BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : - Fin (4 : ℕ))) (r i.succ)))) → ((TileCentroid Z - TileCentroid U = (1 / 2 : ℝ) • - GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : ℕ) - then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (i - (1 : Fin (3 : ℕ))).succ) - - BandVectors.1 (r (i - (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) else - BandVectors.1 (r (i + (1 : Fin (3 : ℕ))).succ) (r (0 : Fin (4 : ℕ))) - BandVectors.1 - (r (0 : Fin (4 : ℕ))) (r (i + (1 : Fin (3 : ℕ))).succ))) → (∀ (a : Fin 3), - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - ∀ (g' : BandPackingSymmetry), - let qg := BandPackingSymmetryQuadrupleAction g' q - let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' - then -(i - a) else i - a - (BandVectors.1 (qg k.succ) (qg 0) = BandPackingSymmetryVectorAction g' (BandVectors.1 (r - i.succ) (r 0))) → ((BandVectors.1 (qg 0) (qg k.succ) = (if - BandPackingSymmetryReversesOrientation g' then -BandPackingSymmetryVectorAction g' - (BandVectors.1 (r 0) (r i.succ)) else BandPackingSymmetryVectorAction g' - (BandVectors.1 (r 0) (r i.succ)))) → ((∀ (s₀ : Fin 4), ((-s₀ - 1 : Fin 4) : Nat) = (3 - - s₀.val) % 4) → ( - let ii : GaussianInt := ⟨0, 1⟩ - (ii ^ 2 = -1) → ((∀ (x : GaussianInt), x - ii * x = -ii * (x + ii * x)) → ((∀ (x : - GaussianInt), -ii * (x - ii * x) = -(x + ii * x)) → ((∀ (x : GaussianInt), -(x - ii * - x) = ii * (x + ii * x)) → ((∀ (x : GaussianInt), ii * (x - ii * x) = x + ii * x) → - ((ii ^ 3 = -ii) → (((-ii) ^ 2 = -1) → (((-ii) ^ 3 = ii) → ((∀ (g₀ : - BandPackingSymmetry), ∀ (x : GaussianInt), ∀ (y : GaussianInt), - BandPackingSymmetryVectorAction g₀ (x + y) = BandPackingSymmetryVectorAction g₀ x + - BandPackingSymmetryVectorAction g₀ y) → ((∀ (g₀ : BandPackingSymmetry), ∀ (n : Nat), - ∀ (x : GaussianInt), BandPackingSymmetryVectorAction g₀ (ii ^ n * x) = (if - BandPackingSymmetryReversesOrientation g₀ then (-ii) ^ n else ii ^ n) * - BandPackingSymmetryVectorAction g₀ x) → ( - let vR := BandVectors.1 (r i.succ) (r 0) - let vL := BandVectors.1 (r 0) (r i.succ) - let vR' := BandVectors.1 (qg k.succ) (qg 0) - let vL' := BandVectors.1 (qg 0) (qg k.succ) - (vL' = ii * vR') → ( - let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' - then -s - 1 else s - BandPackingSymmetryVectorAction g' (ii ^ s.val * (vR + vL)) = ii ^ t.val * (vR' + - vL'))))))))))))))))))) ) := by + ∀ (r : Fin 4 → CircleCoordinates), + ∀ (i : Fin 3), + ∀ (s : Fin 4), + (0 : ℤ) < + (r + (if Even (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) + else i + (1 : Fin (3 : ℕ))).succ).1 → + ∀ (a : Fin 3), + let q : Fin 4 → CircleCoordinates := + ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] + ∀ (g' : BandPackingSymmetry), + let qg := BandPackingSymmetryQuadrupleAction g' q + let k : Fin 3 := + if BandPackingSymmetryReversesOrientation g' then -(i - a) + else i - a + BandVectors.1 (qg k.succ) (qg 0) = + BandPackingSymmetryVectorAction g' + (BandVectors.1 (r i.succ) (r 0)) → + (BandVectors.1 (qg 0) (qg k.succ) = + if BandPackingSymmetryReversesOrientation g' then + -BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r i.succ)) + else + BandPackingSymmetryVectorAction g' + (BandVectors.1 (r 0) (r i.succ))) → + (∀ (s₀ : Fin 4), ((-s₀ - 1 : Fin 4) : Nat) = (3 - s₀.val) % 4) → + let ii : GaussianInt := ⟨0, 1⟩ + ii ^ 2 = -1 → + (∀ (x : GaussianInt), x - ii * x = -ii * (x + ii * x)) → + (∀ (x : GaussianInt), -ii * (x - ii * x) = -(x + ii * x)) → + (∀ (x : GaussianInt), -(x - ii * x) = ii * (x + ii * x)) → + (∀ (x : GaussianInt), ii * (x - ii * x) = x + ii * x) → + ii ^ 3 = -ii → + (-ii) ^ 2 = -1 → + (-ii) ^ 3 = ii → + (∀ (g₀ : BandPackingSymmetry), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + BandPackingSymmetryVectorAction g₀ (x + y) = + BandPackingSymmetryVectorAction g₀ x + + BandPackingSymmetryVectorAction g₀ y) → + (∀ (g₀ : BandPackingSymmetry), + ∀ (n : Nat), + ∀ (x : GaussianInt), + BandPackingSymmetryVectorAction g₀ (ii ^ n * x) = + (if BandPackingSymmetryReversesOrientation g₀ then + (-ii) ^ n + else ii ^ n) * + BandPackingSymmetryVectorAction g₀ x) → + let vR := BandVectors.1 (r i.succ) (r 0) + let vL := BandVectors.1 (r 0) (r i.succ) + let vR' := BandVectors.1 (qg k.succ) (qg 0) + let vL' := BandVectors.1 (qg 0) (qg k.succ) + vL' = ii * vR' → + let t : Fin 4 := + if BandPackingSymmetryReversesOrientation g' then -s - 1 + else s + BandPackingSymmetryVectorAction g' + (ii ^ s.val * (vR + vL)) = + ii ^ t.val * (vR' + vL') + ) := by classical - intro r i s U W Z hZ hZpos hWcent hZcent a q g' qg k hvectorForward hvectorBackward hnegVal ii - iiSq iiCaseA' iiCaseB' iiCaseC' iiCaseD' iiCube negIiSq negIiCube ladd lpow vR vL vR' vL' - hbackEq' t + intro r i s hZpos a q g' qg k hvectorForward hvectorBackward hnegVal ii iiSq iiCaseA' iiCaseB' + iiCaseC' iiCaseD' iiCube negIiSq negIiCube ladd lpow vR vL vR' vL' hbackEq' t have hvecR : BandPackingSymmetryVectorAction g' vR = vR' := by simpa [vR, vR'] using hvectorForward.symm have hvecL : BandPackingSymmetryVectorAction g' vL = @@ -2073,7 +2060,7 @@ theorem P4055T1PlacementNormalization simpa [vR', vL'] using hbackEqual let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' then -s - 1 else s - have hdispW := PlacementNormalizationProof.hdispW r i s U W Z hZ hZpos hWcent hZcent a g' + have hdispW := PlacementNormalizationProof.hdispW r i s hZpos a g' hvectorForward hvectorBackward hnegVal iiSq iiCaseA' iiCaseB' iiCaseC' iiCaseD' iiCube negIiSq negIiCube ladd lpow hbackEq' have quarterParity (s₀ : Fin 4) := PlacementNormalizationProof.quarterParity evenZero evenTwo diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean b/LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean index a2ecb0223d..5347a30ea3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordTileCellMembership public import LeanPool.ApollonianSuperharmonic.FordTile public import LeanPool.ApollonianSuperharmonic.FordVertexDomain @@ -155,17 +156,7 @@ private theorem hFcells (q : Nat) (hqpos : 0 < q) : (FordTile q).cells.Nonempty Int.natCast_eq_zero, Prod.exists, exists_eq_right_right, exists_eq_right, and_self] exact hqpos -private theorem hcellTiles (q : Nat) (z : GaussianInt) : - z ∈ (FordTile q).cells ↔ - 0 ≤ z.re ∧ z.re < (q : Int) ∧ - 0 ≤ z.im ∧ z.im < (q : Int) := by - classical - have hcellCoord (z : GaussianInt) : - z ∈ FordCellDomain q ↔ - 0 ≤ z.re ∧ z.re < (q : Int) ∧ - 0 ≤ z.im ∧ z.im < (q : Int) := hcellCoord q z - change z ∈ FordCellDomain q ↔ _ - exact hcellCoord z +private abbrev hcellTiles := ApollonianSuperharmonic.FordTileCellMembership private theorem hhoriz (q : Nat) (z : GaussianInt) : ((z ∈ (FordTile q).cells ∧ z - ⟨0, 1⟩ ∉ (FordTile q).cells) ∨ diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean index 5de6eed47a..f15078e137 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean @@ -249,33 +249,9 @@ private theorem hparAt293 : intro P hP hsum hcrossdet hpos₁ hpos₂ horder hdlt hdetdiff H hHq hredParent Q exact ⟨rfl, rfl, rfl, rfl⟩ -private theorem hch₀' : - (by - classical - exact - ∀ (P₁ : FordFareyParameter), ∀ (H : FordFareyParameter), (∀ x ∈ - FordRecursiveVertexDomains P₁ (0 : Fin (4 : ℕ)), Classical.choose - FordOdometerFamilyExistsUnique P₁ x = Classical.choose FordOdometerFamilyExistsUnique - H x) → (∀ y, y ∈ FordRecursiveVertexDomains P₁ 0 → FordOdometer P₁ y = FordOdometer H - y) ) := by - classical - intro P₁ H hch₀ y hy - simpa [FordOdometer] using hch₀ y hy +private abbrev hch₀' := ApollonianSuperharmonic.OverlapDescentDetails.hrec₀' -private theorem hch₁' : - (by - classical - exact - ∀ (P₁ : FordFareyParameter), ∀ (H : FordFareyParameter), (∀ x ∈ - FordRecursiveVertexDomains P₁ (1 : Fin (4 : ℕ)), Classical.choose - FordOdometerFamilyExistsUnique P₁ x = Classical.choose FordOdometerFamilyExistsUnique - H (x - ⟨(↑P₁.q₂ : ℤ), (↑P₁.q₂ : ℤ)⟩) + P₁.p₂ * x.re + P₁.p₂ * x.im - P₁.p₂ * (↑P₁.q₂ - : ℤ) + (1 : ℤ)) → (∀ z, z ∈ FordRecursiveVertexDomains P₁ 1 → FordOdometer P₁ z = - FordOdometer H (z-⟨(P₁.q₂ : Int), (P₁.q₂ : Int)⟩) + P₁.p₂*z.re + P₁.p₂*z.im - - P₁.p₂*(P₁.q₂ : Int)+1) ) := by - classical - intro P₁ H hch₁ z hz - simpa [FordOdometer] using hch₁ z hz +private abbrev hch₁' := ApollonianSuperharmonic.OverlapDescentDetails.hrec₁' private theorem hcoordsAt312 : (by @@ -291,14 +267,13 @@ private theorem hcoordsAt312 : (hr 1 = (P4062T1InteriorSquare P.q₁).image fun y => y + ⟨(P.q₂ : Int), (P.q₂ : Int)⟩) → - FordFareyParameter → - ∀ x ∈ hr (0 : Fin (4 : ℕ)) ∩ hr (1 : Fin (4 : ℕ)), - (↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.re ∧ - x.re ≤ (↑P.q₁ : ℤ) - (1 : ℤ) ∧ - (↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₁ : ℤ) - (1 : ℤ) + ∀ x ∈ hr (0 : Fin (4 : ℕ)) ∩ hr (1 : Fin (4 : ℕ)), + (↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.re ∧ + x.re ≤ (↑P.q₁ : ℤ) - (1 : ℤ) ∧ + (↑P.q₂ : ℤ) + (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₁ : ℤ) - (1 : ℤ) ) := by classical - intro P squareCoordinates hr hA0 hA1 H x hx + intro P squareCoordinates hr hA0 hA1 x hx rcases Finset.mem_inter.mp hx with ⟨h0,h1⟩ rw [hA0] at h0 have b0 := (squareCoordinates P.q₁ x).mp h0 @@ -525,43 +500,28 @@ private theorem hparAt498 : simpa [hQeq] using (show Q.p₁ = P.p₁ ∧ Q.q₁ = P.q₁ ∧ Q.p₂ = P.p₂-P.p₁ ∧ Q.q₂ = P.q₂-P.q₁ from ⟨rfl,rfl,rfl,rfl⟩) -private theorem hch₃' : - (by - classical - exact - ∀ (P₂ : FordFareyParameter), ∀ (H : FordFareyParameter), (∀ x ∈ - FordRecursiveVertexDomains P₂ (3 : Fin (4 : ℕ)), Classical.choose - FordOdometerFamilyExistsUnique P₂ x = Classical.choose FordOdometerFamilyExistsUnique - H (x - ⟨(0 : ℤ), (↑P₂.q₁ : ℤ)⟩) + P₂.p₁ * x.re) → (∀ z, z ∈ - FordRecursiveVertexDomains P₂ 3 → FordOdometer P₂ z = FordOdometer H (z-⟨0,(P₂.q₁ : - Int)⟩) + P₂.p₁*z.re) ) := by - classical - intro P₂ H hch₃ z hz - simpa [FordOdometer] using hch₃ z hz +private abbrev hch₃' := ApollonianSuperharmonic.OverlapDescentDetails.hrec₃' private theorem hcoordsAt511 : (by classical exact ∀ (P : FordFareyParameter), - FordFareyParameter → - (∀ (q : Nat), - ∀ (x : GaussianInt), - x ∈ P4062T1InteriorSquare q ↔ - 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → - ∀ (hr : Fin (4 : ℕ) → Finset GaussianInt), - (hr 2 = - (P4062T1InteriorSquare P.q₂).image fun y => y + ⟨(P.q₁ : Int), 0⟩) → - (hr 3 = - (P4062T1InteriorSquare P.q₂).image fun y => y + ⟨0, (P.q₁ : Int)⟩) → - FordFareyParameter → - ∀ x ∈ hr (2 : Fin (4 : ℕ)) ∩ hr (3 : Fin (4 : ℕ)), - (↑P.q₁ : ℤ) + (1 : ℤ) ≤ x.re ∧ - x.re ≤ (↑P.q₂ : ℤ) - (1 : ℤ) ∧ - (↑P.q₁ : ℤ) + (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₂ : ℤ) - (1 : ℤ) + (∀ (q : Nat), + ∀ (x : GaussianInt), + x ∈ P4062T1InteriorSquare q ↔ + 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1) → + ∀ (hr : Fin (4 : ℕ) → Finset GaussianInt), + (hr 2 = (P4062T1InteriorSquare P.q₂).image fun y => y + ⟨(P.q₁ : Int), 0⟩) → + (hr 3 = + (P4062T1InteriorSquare P.q₂).image fun y => y + ⟨0, (P.q₁ : Int)⟩) → + ∀ x ∈ hr (2 : Fin (4 : ℕ)) ∩ hr (3 : Fin (4 : ℕ)), + (↑P.q₁ : ℤ) + (1 : ℤ) ≤ x.re ∧ + x.re ≤ (↑P.q₂ : ℤ) - (1 : ℤ) ∧ + (↑P.q₁ : ℤ) + (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₂ : ℤ) - (1 : ℤ) ) := by classical - intro P P₂ squareCoordinates hr hA2 hA3 R x hx + intro P squareCoordinates hr hA2 hA3 x hx rcases Finset.mem_inter.mp hx with ⟨h2,h3⟩ rw [hA2] at h2 rw [hA3] at h3 @@ -980,7 +940,7 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) have hch₀' := OverlapDescentDetails.hch₀' P₁ H hch₀ have hch₁' := OverlapDescentDetails.hch₁' P₁ H hch₁ have hcoords (x : GaussianInt) (hx : x ∈ hr 0 ∩ hr 1) := OverlapDescentDetails.hcoordsAt312 - P squareCoordinates hr hA0 hA1 H x hx + P squareCoordinates hr hA0 hA1 x hx have htarget := OverlapDescentDetails.htargetAt327 P P₁ hq₁ hsum hcrossdet hpos₁ hpos₂ hrec₀' hrec₁' hlapAffine hrec0Member hrec1Member hr horder hdlt hdetdiff H hHq hredParent R hR hpar hparP hch₀' hch₁' hcoords @@ -1053,7 +1013,7 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) rcases hchildRec with ⟨_, _, hch₂, hch₃⟩ have hch₃' := OverlapDescentDetails.hch₃' P₂ H hch₃ have hcoords (x : GaussianInt) (hx : x ∈ hr 2 ∩ hr 3) := OverlapDescentDetails.hcoordsAt511 P - P₂ squareCoordinates hr hA2 hA3 R x hx + squareCoordinates hr hA2 hA3 x hx have htarget := OverlapDescentDetails.htargetAt542 P P₂ hq₂ hsum hlt₂ hrec₂' hlapAffine hrec2Member hr horder H R hR hpar hch₃' hcoords refine ⟨H, hHp, hHq, by simpa [hHq] using hdlt, diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean index 2764eda39b..b40b0fb217 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordInteriorSquareCoordinates public import LeanPool.ApollonianSuperharmonic.P4112T1PathGeometry @@ -63,26 +64,7 @@ private theorem hneq : have hsum := P.sum_q omega -private theorem squareCoordinates : - (by - classical - exact - ∀ (q : ℕ), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare q ↔ (1 : ℤ) ≤ z.re ∧ z.re ≤ - (↑q : ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ z.im ∧ z.im ≤ (↑q : ℤ) - (1 : ℤ) - ) := by - classical - intro q z - unfold P4062T1InteriorSquare - constructor - · intro hz - obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hz - obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab - exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, - (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ - · rintro ⟨ha, ha', hb, hb'⟩ - exact Finset.mem_image.mpr ⟨(z.re, z.im), - Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨ha, ha'⟩, - Finset.mem_Icc.mpr ⟨hb, hb'⟩⟩, by cases z; rfl⟩ +private abbrev squareCoordinates := ApollonianSuperharmonic.FordInteriorSquareCoordinates.membership private theorem natAbs_form : (by @@ -1315,28 +1297,50 @@ private theorem firstPathAscendingCount : (by classical exact - ∀ (P : FordFareyParameter), ((0 : ℕ) < P.q₁) → ((P.q = P.q₁ + P.q₂) → ( - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) - (B 0).2 (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - (∀ (q : ℕ), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare q ↔ (1 : ℤ) ≤ z.re ∧ z.re ≤ - (↑q : ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ z.im ∧ z.im ≤ (↑q : ℤ) - (1 : ℤ)) → ( - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - (∀ (j : Fin 2), ∀ (x : GaussianInt), (x ∈ (B j).1) → (((B j).1.filter (fun y => - FourNeighborAdjacent y x ∧ d y < d x)).card = - (({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter - (fun y => y ∈ (B j).1 ∧ rootDist j y < rootDist j x)).card)) → ((∀ (S : Finset - GaussianInt), ∀ (ρ : GaussianInt → ℕ), ∀ (x : GaussianInt), ρ x = (0 : ℕ) → ({y ∈ - {x + (1 : GaussianInt), x - (1 : GaussianInt), x + ⟨(0 : ℤ), (1 : ℤ)⟩, - x - ⟨(0 : ℤ), (1 : ℤ)⟩} | y ∈ S ∧ ρ y < ρ x} : Finset GaussianInt) = ∅) → (∀ (x : - GaussianInt), (x ∈ (P4062T1RemainderPaths P (0 : Fin (2 : ℕ))).1) → ((x ∈ (B - 0).1) → ((P.q₂ < P.q₁) → (((B (0 : Fin 2)).1.filter (fun y => FourNeighborAdjacent - y x ∧ d y < d x)).card = (if x = (B (0 : Fin 2)).2 then 0 else 1)))))))))) := by + ∀ (P : FordFareyParameter), + (0 : ℕ) < P.q₁ → + P.q = P.q₁ + P.q₂ → + let B := P4062T1RemainderPaths P; + let d : GaussianInt → Nat := fun x => + let a := + @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) (B 0).2 + (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs; + (∀ (q : ℕ), + ∀ (z : GaussianInt), + z ∈ P4062T1InteriorSquare q ↔ + (1 : ℤ) ≤ z.re ∧ + z.re ≤ (↑q : ℤ) - (1 : ℤ) ∧ + (1 : ℤ) ≤ z.im ∧ z.im ≤ (↑q : ℤ) - (1 : ℤ)) → + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re - (B j).2.re).natAbs + (z.im - (B j).2.im).natAbs; + (∀ (j : Fin 2), + ∀ (x : GaussianInt), + x ∈ (B j).1 → + ((B j).1.filter fun y => + FourNeighborAdjacent y x ∧ d y < d x).card = + (({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : + Finset GaussianInt).filter + fun y => y ∈ (B j).1 ∧ rootDist j y < rootDist j x).card) → + (∀ (S : Finset GaussianInt), + ∀ (ρ : GaussianInt → ℕ), + ∀ (x : GaussianInt), + ρ x = (0 : ℕ) → + ({y ∈ + {x + (1 : GaussianInt), x - (1 : GaussianInt), + x + ⟨(0 : ℤ), (1 : ℤ)⟩, x - ⟨(0 : ℤ), (1 : ℤ)⟩} | + y ∈ S ∧ ρ y < ρ x} : + Finset GaussianInt) = + ∅) → + ∀ (x : GaussianInt), + x ∈ (B 0).1 → + P.q₂ < P.q₁ → + ((B (0 : Fin 2)).1.filter fun y => + FourNeighborAdjacent y x ∧ d y < d x).card = + if x = (B (0 : Fin 2)).2 then 0 else 1 + ) := by classical - intro P hq1pos hsum B d squareCoordinates rootDist count_eq root_candidate_empty x hx hxB horder + intro P hq1pos hsum B d squareCoordinates rootDist count_eq root_candidate_empty x hxB horder have hb0 : (B 0).1 = (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re)) := by @@ -1410,28 +1414,52 @@ private theorem firstPathDescendingCount : (by classical exact - ∀ (P : FordFareyParameter), ((0 : ℕ) < P.q₁) → ((P.q = P.q₁ + P.q₂) → ((P.q₁ ≠ P.q₂) → ( - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) - (B 0).2 (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - (∀ (q : ℕ), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare q ↔ (1 : ℤ) ≤ z.re ∧ z.re ≤ - (↑q : ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ z.im ∧ z.im ≤ (↑q : ℤ) - (1 : ℤ)) → ( - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - (∀ (j : Fin 2), ∀ (x : GaussianInt), (x ∈ (B j).1) → (((B j).1.filter (fun y => - FourNeighborAdjacent y x ∧ d y < d x)).card = - (({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter - (fun y => y ∈ (B j).1 ∧ rootDist j y < rootDist j x)).card)) → ((∀ (S : Finset - GaussianInt), ∀ (ρ : GaussianInt → ℕ), ∀ (x : GaussianInt), ρ x = (0 : ℕ) → ({y ∈ - {x + (1 : GaussianInt), x - (1 : GaussianInt), x + ⟨(0 : ℤ), (1 : ℤ)⟩, - x - ⟨(0 : ℤ), (1 : ℤ)⟩} | y ∈ S ∧ ρ y < ρ x} : Finset GaussianInt) = ∅) → (∀ (x : - GaussianInt), (x ∈ (P4062T1RemainderPaths P (0 : Fin (2 : ℕ))).1) → ((x ∈ (B - 0).1) → ((¬P.q₂ < P.q₁) → (((B (0 : Fin 2)).1.filter (fun y => FourNeighborAdjacent - y x ∧ d y < d x)).card = (if x = (B (0 : Fin 2)).2 then 0 else 1))))))))))) := by + ∀ (P : FordFareyParameter), + (0 : ℕ) < P.q₁ → + P.q = P.q₁ + P.q₂ → + P.q₁ ≠ P.q₂ → + let B := P4062T1RemainderPaths P; + let d : GaussianInt → Nat := fun x => + let a := + @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) (B 0).2 + (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs; + (∀ (q : ℕ), + ∀ (z : GaussianInt), + z ∈ P4062T1InteriorSquare q ↔ + (1 : ℤ) ≤ z.re ∧ + z.re ≤ (↑q : ℤ) - (1 : ℤ) ∧ + (1 : ℤ) ≤ z.im ∧ z.im ≤ (↑q : ℤ) - (1 : ℤ)) → + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re - (B j).2.re).natAbs + (z.im - (B j).2.im).natAbs; + (∀ (j : Fin 2), + ∀ (x : GaussianInt), + x ∈ (B j).1 → + ((B j).1.filter fun y => + FourNeighborAdjacent y x ∧ d y < d x).card = + (({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : + Finset GaussianInt).filter + fun y => + y ∈ (B j).1 ∧ rootDist j y < rootDist j x).card) → + (∀ (S : Finset GaussianInt), + ∀ (ρ : GaussianInt → ℕ), + ∀ (x : GaussianInt), + ρ x = (0 : ℕ) → + ({y ∈ + {x + (1 : GaussianInt), x - (1 : GaussianInt), + x + ⟨(0 : ℤ), (1 : ℤ)⟩, x - ⟨(0 : ℤ), (1 : ℤ)⟩} | + y ∈ S ∧ ρ y < ρ x} : + Finset GaussianInt) = + ∅) → + ∀ (x : GaussianInt), + x ∈ (B 0).1 → + ¬P.q₂ < P.q₁ → + ((B (0 : Fin 2)).1.filter fun y => + FourNeighborAdjacent y x ∧ d y < d x).card = + if x = (B (0 : Fin 2)).2 then 0 else 1 + ) := by classical - intro P hq1pos hsum hneq B d squareCoordinates rootDist count_eq root_candidate_empty x hx hxB + intro P hq1pos hsum hneq B d squareCoordinates rootDist count_eq root_candidate_empty x hxB horder have horder' : P.q₁ < P.q₂ := by omega have hb0 : (B 0).1 = (P4062T1InteriorSquare P.q).filter @@ -1496,28 +1524,50 @@ private theorem secondPathAscendingCount : (by classical exact - ∀ (P : FordFareyParameter), ((0 : ℕ) < P.q₁) → ((P.q = P.q₁ + P.q₂) → ( - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) - (B 0).2 (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - (∀ (q : ℕ), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare q ↔ (1 : ℤ) ≤ z.re ∧ z.re ≤ - (↑q : ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ z.im ∧ z.im ≤ (↑q : ℤ) - (1 : ℤ)) → ( - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - (∀ (j : Fin 2), ∀ (x : GaussianInt), (x ∈ (B j).1) → (((B j).1.filter (fun y => - FourNeighborAdjacent y x ∧ d y < d x)).card = - (({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter - (fun y => y ∈ (B j).1 ∧ rootDist j y < rootDist j x)).card)) → ((∀ (S : Finset - GaussianInt), ∀ (ρ : GaussianInt → ℕ), ∀ (x : GaussianInt), ρ x = (0 : ℕ) → ({y ∈ - {x + (1 : GaussianInt), x - (1 : GaussianInt), x + ⟨(0 : ℤ), (1 : ℤ)⟩, - x - ⟨(0 : ℤ), (1 : ℤ)⟩} | y ∈ S ∧ ρ y < ρ x} : Finset GaussianInt) = ∅) → (∀ (x : - GaussianInt), (x ∈ (P4062T1RemainderPaths P (1 : Fin (2 : ℕ))).1) → ((x ∈ (B - 1).1) → ((P.q₂ < P.q₁) → (((B (1 : Fin 2)).1.filter (fun y => FourNeighborAdjacent - y x ∧ d y < d x)).card = (if x = (B (1 : Fin 2)).2 then 0 else 1)))))))))) := by + ∀ (P : FordFareyParameter), + (0 : ℕ) < P.q₁ → + P.q = P.q₁ + P.q₂ → + let B := P4062T1RemainderPaths P; + let d : GaussianInt → Nat := fun x => + let a := + @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) (B 0).2 + (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs; + (∀ (q : ℕ), + ∀ (z : GaussianInt), + z ∈ P4062T1InteriorSquare q ↔ + (1 : ℤ) ≤ z.re ∧ + z.re ≤ (↑q : ℤ) - (1 : ℤ) ∧ + (1 : ℤ) ≤ z.im ∧ z.im ≤ (↑q : ℤ) - (1 : ℤ)) → + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re - (B j).2.re).natAbs + (z.im - (B j).2.im).natAbs; + (∀ (j : Fin 2), + ∀ (x : GaussianInt), + x ∈ (B j).1 → + ((B j).1.filter fun y => + FourNeighborAdjacent y x ∧ d y < d x).card = + (({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : + Finset GaussianInt).filter + fun y => y ∈ (B j).1 ∧ rootDist j y < rootDist j x).card) → + (∀ (S : Finset GaussianInt), + ∀ (ρ : GaussianInt → ℕ), + ∀ (x : GaussianInt), + ρ x = (0 : ℕ) → + ({y ∈ + {x + (1 : GaussianInt), x - (1 : GaussianInt), + x + ⟨(0 : ℤ), (1 : ℤ)⟩, x - ⟨(0 : ℤ), (1 : ℤ)⟩} | + y ∈ S ∧ ρ y < ρ x} : + Finset GaussianInt) = + ∅) → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → + P.q₂ < P.q₁ → + ((B (1 : Fin 2)).1.filter fun y => + FourNeighborAdjacent y x ∧ d y < d x).card = + if x = (B (1 : Fin 2)).2 then 0 else 1 + ) := by classical - intro P hq1pos hsum B d squareCoordinates rootDist count_eq root_candidate_empty x hx hxB horder + intro P hq1pos hsum B d squareCoordinates rootDist count_eq root_candidate_empty x hxB horder have hb1 : (B 1).1 = (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im)) := by @@ -1589,30 +1639,54 @@ private theorem secondPathDescendingCount : (by classical exact - ∀ (P : FordFareyParameter), ((2 : ℕ) < P.q) → (((0 : ℕ) < P.q₁) → ((P.q = P.q₁ + P.q₂) → - ((P.q₁ ≠ P.q₂) → ( - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) - (B 0).2 (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - (∀ (q : ℕ), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare q ↔ (1 : ℤ) ≤ z.re ∧ z.re ≤ - (↑q : ℤ) - (1 : ℤ) ∧ (1 : ℤ) ≤ z.im ∧ z.im ≤ (↑q : ℤ) - (1 : ℤ)) → ( - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - (∀ (j : Fin 2), ∀ (x : GaussianInt), (x ∈ (B j).1) → (((B j).1.filter (fun y => - FourNeighborAdjacent y x ∧ d y < d x)).card = - (({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter - (fun y => y ∈ (B j).1 ∧ rootDist j y < rootDist j x)).card)) → ((∀ (S : Finset - GaussianInt), ∀ (ρ : GaussianInt → ℕ), ∀ (x : GaussianInt), ρ x = (0 : ℕ) → ({y ∈ - {x + (1 : GaussianInt), x - (1 : GaussianInt), x + ⟨(0 : ℤ), (1 : ℤ)⟩, - x - ⟨(0 : ℤ), (1 : ℤ)⟩} | y ∈ S ∧ ρ y < ρ x} : Finset GaussianInt) = ∅) → (∀ (x : - GaussianInt), (x ∈ (P4062T1RemainderPaths P (1 : Fin (2 : ℕ))).1) → ((x ∈ (B - 1).1) → ((¬P.q₂ < P.q₁) → (((B (1 : Fin 2)).1.filter (fun y => FourNeighborAdjacent - y x ∧ d y < d x)).card = (if x = (B (1 : Fin 2)).2 then 0 else 1)))))))))))) := by + ∀ (P : FordFareyParameter), + (2 : ℕ) < P.q → + (0 : ℕ) < P.q₁ → + P.q = P.q₁ + P.q₂ → + P.q₁ ≠ P.q₂ → + let B := P4062T1RemainderPaths P; + let d : GaussianInt → Nat := fun x => + let a := + @ite GaussianInt (x ∈ (B 0).1) (Classical.propDecidable _) (B 0).2 + (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs; + (∀ (q : ℕ), + ∀ (z : GaussianInt), + z ∈ P4062T1InteriorSquare q ↔ + (1 : ℤ) ≤ z.re ∧ + z.re ≤ (↑q : ℤ) - (1 : ℤ) ∧ + (1 : ℤ) ≤ z.im ∧ z.im ≤ (↑q : ℤ) - (1 : ℤ)) → + let rootDist (j : Fin 2) (z : GaussianInt) : Nat := + (z.re - (B j).2.re).natAbs + (z.im - (B j).2.im).natAbs; + (∀ (j : Fin 2), + ∀ (x : GaussianInt), + x ∈ (B j).1 → + ((B j).1.filter fun y => + FourNeighborAdjacent y x ∧ d y < d x).card = + (({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : + Finset GaussianInt).filter + fun y => + y ∈ (B j).1 ∧ rootDist j y < rootDist j x).card) → + (∀ (S : Finset GaussianInt), + ∀ (ρ : GaussianInt → ℕ), + ∀ (x : GaussianInt), + ρ x = (0 : ℕ) → + ({y ∈ + {x + (1 : GaussianInt), x - (1 : GaussianInt), + x + ⟨(0 : ℤ), (1 : ℤ)⟩, x - ⟨(0 : ℤ), (1 : ℤ)⟩} | + y ∈ S ∧ ρ y < ρ x} : + Finset GaussianInt) = + ∅) → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → + ¬P.q₂ < P.q₁ → + ((B (1 : Fin 2)).1.filter fun y => + FourNeighborAdjacent y x ∧ d y < d x).card = + if x = (B (1 : Fin 2)).2 then 0 else 1 + ) := by classical - intro P hP hq1pos hsum hneq B d squareCoordinates rootDist count_eq root_candidate_empty x hx - hxB horder + intro P hP hq1pos hsum hneq B d squareCoordinates rootDist count_eq root_candidate_empty x hxB + horder have horder' : P.q₁ < P.q₂ := by omega have hb1 : (B 1).1 = (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.im) ∨ @@ -1749,13 +1823,13 @@ theorem P4112T1LowerNeighbors (P : FordFareyParameter) (hP : 2 < P.q) : ((B (0 : Fin 2)).1.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = (if x = (B (0 : Fin 2)).2 then 0 else 1) := LowerOrderCases.firstPathAscendingCount P - hq1pos hsum squareCoordinates count_eq root_candidate_empty x hx hxB horder + hq1pos hsum squareCoordinates count_eq root_candidate_empty x hxB horder exact firstPathAscendingCount · have firstPathDescendingCount : ((B (0 : Fin 2)).1.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = (if x = (B (0 : Fin 2)).2 then 0 else 1) := LowerOrderCases.firstPathDescendingCount P - hq1pos hsum hneq squareCoordinates count_eq root_candidate_empty x hx hxB horder + hq1pos hsum hneq squareCoordinates count_eq root_candidate_empty x hxB horder exact firstPathDescendingCount · intro x hx change ((B 1).1.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = @@ -1767,13 +1841,13 @@ theorem P4112T1LowerNeighbors (P : FordFareyParameter) (hP : 2 < P.q) : ((B (1 : Fin 2)).1.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = (if x = (B (1 : Fin 2)).2 then 0 else 1) := LowerOrderCases.secondPathAscendingCount P - hq1pos hsum squareCoordinates count_eq root_candidate_empty x hx hxB horder + hq1pos hsum squareCoordinates count_eq root_candidate_empty x hxB horder exact secondPathAscendingCount · have secondPathDescendingCount : ((B (1 : Fin 2)).1.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = (if x = (B (1 : Fin 2)).2 then 0 else 1) := LowerOrderCases.secondPathDescendingCount P - hP hq1pos hsum hneq squareCoordinates count_eq root_candidate_empty x hx hxB horder + hP hq1pos hsum hneq squareCoordinates count_eq root_candidate_empty x hxB horder exact secondPathDescendingCount end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean index be974c79a1..8bb7408891 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordInteriorSquareCoordinates public import LeanPool.ApollonianSuperharmonic.FordFareySum public import LeanPool.ApollonianSuperharmonic.P4062T1RemainderPaths @@ -112,23 +113,7 @@ private theorem hsum : intro P exact_mod_cast P.sum_q -private theorem squareCoordinates : - ∀ (n : Nat), ∀ (z : GaussianInt), z ∈ P4062T1InteriorSquare n ↔ - 1 ≤ z.re ∧ z.re ≤ (n : Int) - 1 ∧ - 1 ≤ z.im ∧ z.im ≤ (n : Int) - 1 := by - classical - intro n z - unfold P4062T1InteriorSquare - constructor - · intro hz - obtain ⟨⟨a, b⟩, hab, rfl⟩ := Finset.mem_image.mp hz - obtain ⟨ha, hb⟩ := Finset.mem_product.mp hab - exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, - (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ - · intro hz - exact Finset.mem_image.mpr ⟨(z.re, z.im), - Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨hz.1, hz.2.1⟩, - Finset.mem_Icc.mpr hz.2.2⟩, by cases z; rfl⟩ +private abbrev squareCoordinates := ApollonianSuperharmonic.FordInteriorSquareCoordinates.membership private theorem mem0 : ∀ (P : FordFareyParameter), diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean index 29208c4271..e8e5fb35b0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordInteriorSquareCoordinates public import LeanPool.ApollonianSuperharmonic.FordFareySum public import Mathlib.Topology.MetricSpace.Pseudo.Constructions public import Mathlib.Topology.MetricSpace.Pseudo.Real @@ -116,23 +117,7 @@ private theorem hsumInt : intro P r s hsum exact_mod_cast hsum -private theorem squareCoordinates : - ∀ (n : Nat), ∀ (x : GaussianInt), x ∈ P4062T1InteriorSquare n ↔ - 1 ≤ x.re ∧ x.re ≤ (n : Int)-1 ∧ - 1 ≤ x.im ∧ x.im ≤ (n : Int)-1 := by - classical - intro n x - unfold P4062T1InteriorSquare - constructor - · intro hx - obtain ⟨⟨a,b⟩, hab, rfl⟩ := Finset.mem_image.mp hx - obtain ⟨ha,hb⟩ := Finset.mem_product.mp hab - exact ⟨(Finset.mem_Icc.mp ha).1, (Finset.mem_Icc.mp ha).2, - (Finset.mem_Icc.mp hb).1, (Finset.mem_Icc.mp hb).2⟩ - · intro h - exact Finset.mem_image.mpr ⟨(x.re,x.im), - Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨h.1,h.2.1⟩, - Finset.mem_Icc.mpr h.2.2⟩, by cases x; rfl⟩ +private abbrev squareCoordinates := ApollonianSuperharmonic.FordInteriorSquareCoordinates.membership private theorem mem0 : ∀ (P : FordFareyParameter), @@ -1092,37 +1077,83 @@ private theorem smallZeroNeighbors : private theorem smallOneNeighbors : ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - let r := P.q₁ - let s := P.q₂ - (P.q = P.q₁ + P.q₂) → ((have s := P.q₂; (0 : ℕ) < s) → ((∀ (x : GaussianInt), r < s → (x ∈ - (P4062T1RemainderPaths P (1 : Fin (2 : ℕ))).1 ↔ x.re = (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ x.im - ∧ x.im ≤ (↑P.q : ℤ) - (1 : ℤ) ∨ x.im = (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q : - ℤ) - (1 : ℤ))) → ((∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), c ≤ a → c ≤ b → (a.dist c).dist - (b.dist c) = a.dist b) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.re = y.re) → ((0 - ≤ x.im) → ((0 ≤ y.im) → ((Nat.dist (d x) (d y) = Nat.dist x.im.toNat y.im.toNat) → - (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1))))) → - ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im = y.im) → ((0 ≤ x.re) → ((0 ≤ y.re) → - ((Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat) → (FourNeighborAdjacent x y ↔ - (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1))))) → (((r < s) → (∀ (x : - GaussianInt), (x ∈ (B 1).1) → ((x.re = (s:Int)) → ((0 ≤ x.im) → (((s:Int) ≤ x.im) → (d x - = Nat.dist x.im.toNat s)))))) → (((r < s) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → ((x.im - = (s:Int)) → ((0 ≤ x.re) → (((s:Int) ≤ x.re) → (d x = Nat.dist x.re.toNat s)))))) → ((∀ - (a : Nat), ∀ (b : Nat), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.re = (a:Int)) → - ((y.im = (b:Int)) → ((d x = Nat.dist x.im.toNat b) → ((d y = Nat.dist y.re.toNat a) → ((0 - ≤ x.re) → ((0 ≤ x.im) → ((0 ≤ y.re) → ((0 ≤ y.im) → (FourNeighborAdjacent x y ↔ (x.re = - y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1))))))))) → ((∀ (a : Nat), ∀ (b : Nat), ∀ - (x : GaussianInt), ∀ (y : GaussianInt), (x.im = (b:Int)) → ((y.re = (a:Int)) → ((d x = - Nat.dist x.re.toNat a) → ((d y = Nat.dist y.im.toNat b) → ((0 ≤ x.re) → ((0 ≤ x.im) → ((0 - ≤ y.re) → ((0 ≤ y.im) → (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ - Nat.dist (d x) (d y) = 1))))))))) → ((r < s) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (∀ - (y : GaussianInt), (y ∈ (B 1).1) → (FourNeighborAdjacent x y ↔ - (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1))))))))))))) := by + let B := P4062T1RemainderPaths P; + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs; + let r := P.q₁; + let s := P.q₂; + P.q = P.q₁ + P.q₂ → + (∀ (x : GaussianInt), + r < s → + (x ∈ (P4062T1RemainderPaths P (1 : Fin (2 : ℕ))).1 ↔ + x.re = (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q : ℤ) - (1 : ℤ) ∨ + x.im = (↑P.q₂ : ℤ) ∧ (↑P.q₂ : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q : ℤ) - (1 : ℤ))) → + (∀ (a : ℕ), + ∀ (b : ℕ), ∀ (c : ℕ), c ≤ a → c ≤ b → (a.dist c).dist (b.dist c) = a.dist b) → + (∀ (x : GaussianInt), + ∀ (y : GaussianInt), + x.re = y.re → + 0 ≤ x.im → + 0 ≤ y.im → + Nat.dist (d x) (d y) = Nat.dist x.im.toNat y.im.toNat → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)) → + (∀ (x : GaussianInt), + ∀ (y : GaussianInt), + x.im = y.im → + 0 ≤ x.re → + 0 ≤ y.re → + Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)) → + (r < s → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → + x.re = (s : Int) → + 0 ≤ x.im → (s : Int) ≤ x.im → d x = Nat.dist x.im.toNat s) → + (r < s → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → + x.im = (s : Int) → + 0 ≤ x.re → (s : Int) ≤ x.re → d x = Nat.dist x.re.toNat s) → + (∀ (a : Nat), + ∀ (b : Nat), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + x.re = (a : Int) → + y.im = (b : Int) → + d x = Nat.dist x.im.toNat b → + d y = Nat.dist y.re.toNat a → + 0 ≤ x.re → + 0 ≤ x.im → + 0 ≤ y.re → + 0 ≤ y.im → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)) → + (∀ (a : Nat), + ∀ (b : Nat), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + x.im = (b : Int) → + y.re = (a : Int) → + d x = Nat.dist x.re.toNat a → + d y = Nat.dist y.im.toNat b → + 0 ≤ x.re → + 0 ≤ x.im → + 0 ≤ y.re → + 0 ≤ y.im → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)) → + r < s → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → + ∀ (y : GaussianInt), + y ∈ (B 1).1 → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1) := by classical - intro P B d r s hsum hs memB1Small distDistUp lineVertical lineHorizontal dSmall1V dSmall1H + intro P B d r s hsum memB1Small distDistUp lineVertical lineHorizontal dSmall1V dSmall1H cornerVH cornerHV hsmall x hx y hy have hxB : x ∈ (B 1).1 := by simpa using hx have hyB : y ∈ (B 1).1 := by simpa using hy @@ -1171,40 +1202,91 @@ private theorem smallOneNeighbors : exact lineHorizontal x y (by omega) (by omega) (by omega) hlevel private theorem largeZeroNeighbors : - ∀ (P : FordFareyParameter), (2 < P.q) → ( - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - let r := P.q₁ - let s := P.q₂ - (P.q = P.q₁ + P.q₂) → ((have s := P.q₂; (0 : ℕ) < s) → (((0 : ℕ) < P.q₁) → ((∀ (x : - GaussianInt), s < r → (x ∈ (P4062T1RemainderPaths P (0 : Fin (2 : ℕ))).1 ↔ x.re = - (↑P.q₁ : ℤ) ∧ (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₂ : ℤ) ∨ x.im = (↑P.q₂ : ℤ) ∧ (↑P.q₁ : ℤ) ≤ - x.re ∧ x.re ≤ (↑P.q : ℤ) - (1 : ℤ))) → ((∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), a ≤ c → b ≤ c → - (a.dist c).dist (b.dist c) = a.dist b) → ((∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), c ≤ a → c ≤ b - → (a.dist c).dist (b.dist c) = a.dist b) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), - (x.re = y.re) → ((0 ≤ x.im) → ((0 ≤ y.im) → ((Nat.dist (d x) (d y) = Nat.dist x.im.toNat - y.im.toNat) → (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d - y) = 1))))) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im = y.im) → ((0 ≤ x.re) → - ((0 ≤ y.re) → ((Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat) → - (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1))))) → - (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → ((x.re = (r:Int)) → ((0 ≤ x.im) → - ((x.im ≤ (s:Int)) → (d x = Nat.dist x.im.toNat s)))))) → (((s < r) → (∀ (x : - GaussianInt), (x ∈ (B 0).1) → ((x.im = (s:Int)) → ((0 ≤ x.re) → (((r:Int) ≤ x.re) → (d x - = Nat.dist x.re.toNat r)))))) → ((∀ (a : Nat), ∀ (b : Nat), ∀ (x : GaussianInt), ∀ (y : - GaussianInt), (x.re = (a:Int)) → ((y.im = (b:Int)) → ((d x = Nat.dist x.im.toNat b) → ((d - y = Nat.dist y.re.toNat a) → ((0 ≤ x.re) → ((0 ≤ x.im) → ((0 ≤ y.re) → ((0 ≤ y.im) → - (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = - 1))))))))) → ((∀ (a : Nat), ∀ (b : Nat), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im - = (b:Int)) → ((y.re = (a:Int)) → ((d x = Nat.dist x.re.toNat a) → ((d y = Nat.dist - y.im.toNat b) → ((0 ≤ x.re) → ((0 ≤ x.im) → ((0 ≤ y.re) → ((0 ≤ y.im) → - (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = - 1))))))))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (∀ (y : GaussianInt), (y ∈ - (B 0).1) → (FourNeighborAdjacent x y ↔ - (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)))))))))))))))) := by + ∀ (P : FordFareyParameter), + 2 < P.q → + let B := P4062T1RemainderPaths P; + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs; + let r := P.q₁; + let s := P.q₂; + P.q = P.q₁ + P.q₂ → + (0 : ℕ) < P.q₁ → + (∀ (x : GaussianInt), + s < r → + (x ∈ (P4062T1RemainderPaths P (0 : Fin (2 : ℕ))).1 ↔ + x.re = (↑P.q₁ : ℤ) ∧ (1 : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q₂ : ℤ) ∨ + x.im = (↑P.q₂ : ℤ) ∧ + (↑P.q₁ : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q : ℤ) - (1 : ℤ))) → + (∀ (a : ℕ), + ∀ (b : ℕ), + ∀ (c : ℕ), a ≤ c → b ≤ c → (a.dist c).dist (b.dist c) = a.dist b) → + (∀ (a : ℕ), + ∀ (b : ℕ), + ∀ (c : ℕ), c ≤ a → c ≤ b → (a.dist c).dist (b.dist c) = a.dist b) → + (∀ (x : GaussianInt), + ∀ (y : GaussianInt), + x.re = y.re → + 0 ≤ x.im → + 0 ≤ y.im → + Nat.dist (d x) (d y) = Nat.dist x.im.toNat y.im.toNat → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)) → + (∀ (x : GaussianInt), + ∀ (y : GaussianInt), + x.im = y.im → + 0 ≤ x.re → + 0 ≤ y.re → + Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)) → + (s < r → + ∀ (x : GaussianInt), + x ∈ (B 0).1 → + x.re = (r : Int) → + 0 ≤ x.im → x.im ≤ (s : Int) → d x = Nat.dist x.im.toNat s) → + (s < r → + ∀ (x : GaussianInt), + x ∈ (B 0).1 → + x.im = (s : Int) → + 0 ≤ x.re → (r : Int) ≤ x.re → d x = Nat.dist x.re.toNat r) → + (∀ (a : Nat), + ∀ (b : Nat), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + x.re = (a : Int) → + y.im = (b : Int) → + d x = Nat.dist x.im.toNat b → + d y = Nat.dist y.re.toNat a → + 0 ≤ x.re → + 0 ≤ x.im → + 0 ≤ y.re → + 0 ≤ y.im → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)) → + (∀ (a : Nat), + ∀ (b : Nat), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + x.im = (b : Int) → + y.re = (a : Int) → + d x = Nat.dist x.re.toNat a → + d y = Nat.dist y.im.toNat b → + 0 ≤ x.re → + 0 ≤ x.im → + 0 ≤ y.re → + 0 ≤ y.im → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)) → + s < r → + ∀ (x : GaussianInt), + x ∈ (B 0).1 → + ∀ (y : GaussianInt), + y ∈ (B 0).1 → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1) := by classical - intro P hP B d r s hsum hs hr memB0Large distDistDown distDistUp lineVertical lineHorizontal + intro P hP B d r s hsum hr memB0Large distDistDown distDistUp lineVertical lineHorizontal dLarge0V dLarge0H cornerVH cornerHV hlarge x hx y hy have hxB : x ∈ (B 0).1 := by simpa using hx have hyB : y ∈ (B 0).1 := by simpa using hy @@ -1253,40 +1335,91 @@ private theorem largeZeroNeighbors : exact lineHorizontal x y (by omega) (by omega) (by omega) hlevel private theorem largeOneNeighbors : - ∀ (P : FordFareyParameter), (2 < P.q) → ( - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - let r := P.q₁ - let s := P.q₂ - (P.q = P.q₁ + P.q₂) → ((have s := P.q₂; (0 : ℕ) < s) → (((0 : ℕ) < P.q₁) → ((∀ (x : - GaussianInt), s < r → (x ∈ (P4062T1RemainderPaths P (1 : Fin (2 : ℕ))).1 ↔ x.im = - (↑P.q₁ : ℤ) ∧ (1 : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q₂ : ℤ) ∨ x.re = (↑P.q₂ : ℤ) ∧ (↑P.q₁ : ℤ) ≤ - x.im ∧ x.im ≤ (↑P.q : ℤ) - (1 : ℤ))) → ((∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), a ≤ c → b ≤ c → - (a.dist c).dist (b.dist c) = a.dist b) → ((∀ (a : ℕ), ∀ (b : ℕ), ∀ (c : ℕ), c ≤ a → c ≤ b - → (a.dist c).dist (b.dist c) = a.dist b) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), - (x.re = y.re) → ((0 ≤ x.im) → ((0 ≤ y.im) → ((Nat.dist (d x) (d y) = Nat.dist x.im.toNat - y.im.toNat) → (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d - y) = 1))))) → ((∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im = y.im) → ((0 ≤ x.re) → - ((0 ≤ y.re) → ((Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat) → - (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1))))) → - (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → ((x.im = (r:Int)) → ((0 ≤ x.re) → - ((x.re ≤ (s:Int)) → (d x = Nat.dist x.re.toNat s)))))) → (((s < r) → (∀ (x : - GaussianInt), (x ∈ (B 1).1) → ((x.re = (s:Int)) → ((0 ≤ x.im) → (((r:Int) ≤ x.im) → (d x - = Nat.dist x.im.toNat r)))))) → ((∀ (a : Nat), ∀ (b : Nat), ∀ (x : GaussianInt), ∀ (y : - GaussianInt), (x.re = (a:Int)) → ((y.im = (b:Int)) → ((d x = Nat.dist x.im.toNat b) → ((d - y = Nat.dist y.re.toNat a) → ((0 ≤ x.re) → ((0 ≤ x.im) → ((0 ≤ y.re) → ((0 ≤ y.im) → - (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = - 1))))))))) → ((∀ (a : Nat), ∀ (b : Nat), ∀ (x : GaussianInt), ∀ (y : GaussianInt), (x.im - = (b:Int)) → ((y.re = (a:Int)) → ((d x = Nat.dist x.re.toNat a) → ((d y = Nat.dist - y.im.toNat b) → ((0 ≤ x.re) → ((0 ≤ x.im) → ((0 ≤ y.re) → ((0 ≤ y.im) → - (FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = - 1))))))))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (∀ (y : GaussianInt), (y ∈ - (B 1).1) → (FourNeighborAdjacent x y ↔ - (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)))))))))))))))) := by + ∀ (P : FordFareyParameter), + 2 < P.q → + let B := P4062T1RemainderPaths P; + let d : GaussianInt → Nat := fun x => + let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 + (x.re - a.re).natAbs + (x.im - a.im).natAbs; + let r := P.q₁; + let s := P.q₂; + P.q = P.q₁ + P.q₂ → + (0 : ℕ) < P.q₁ → + (∀ (x : GaussianInt), + s < r → + (x ∈ (P4062T1RemainderPaths P (1 : Fin (2 : ℕ))).1 ↔ + x.im = (↑P.q₁ : ℤ) ∧ (1 : ℤ) ≤ x.re ∧ x.re ≤ (↑P.q₂ : ℤ) ∨ + x.re = (↑P.q₂ : ℤ) ∧ + (↑P.q₁ : ℤ) ≤ x.im ∧ x.im ≤ (↑P.q : ℤ) - (1 : ℤ))) → + (∀ (a : ℕ), + ∀ (b : ℕ), + ∀ (c : ℕ), a ≤ c → b ≤ c → (a.dist c).dist (b.dist c) = a.dist b) → + (∀ (a : ℕ), + ∀ (b : ℕ), + ∀ (c : ℕ), c ≤ a → c ≤ b → (a.dist c).dist (b.dist c) = a.dist b) → + (∀ (x : GaussianInt), + ∀ (y : GaussianInt), + x.re = y.re → + 0 ≤ x.im → + 0 ≤ y.im → + Nat.dist (d x) (d y) = Nat.dist x.im.toNat y.im.toNat → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)) → + (∀ (x : GaussianInt), + ∀ (y : GaussianInt), + x.im = y.im → + 0 ≤ x.re → + 0 ≤ y.re → + Nat.dist (d x) (d y) = Nat.dist x.re.toNat y.re.toNat → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)) → + (s < r → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → + x.im = (r : Int) → + 0 ≤ x.re → x.re ≤ (s : Int) → d x = Nat.dist x.re.toNat s) → + (s < r → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → + x.re = (s : Int) → + 0 ≤ x.im → (r : Int) ≤ x.im → d x = Nat.dist x.im.toNat r) → + (∀ (a : Nat), + ∀ (b : Nat), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + x.re = (a : Int) → + y.im = (b : Int) → + d x = Nat.dist x.im.toNat b → + d y = Nat.dist y.re.toNat a → + 0 ≤ x.re → + 0 ≤ x.im → + 0 ≤ y.re → + 0 ≤ y.im → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)) → + (∀ (a : Nat), + ∀ (b : Nat), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + x.im = (b : Int) → + y.re = (a : Int) → + d x = Nat.dist x.re.toNat a → + d y = Nat.dist y.im.toNat b → + 0 ≤ x.re → + 0 ≤ x.im → + 0 ≤ y.re → + 0 ≤ y.im → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1)) → + s < r → + ∀ (x : GaussianInt), + x ∈ (B 1).1 → + ∀ (y : GaussianInt), + y ∈ (B 1).1 → + (FourNeighborAdjacent x y ↔ + (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1) := by classical - intro P hP B d r s hsum hs hr memB1Large distDistDown distDistUp lineVertical lineHorizontal + intro P hP B d r s hsum hr memB1Large distDistDown distDistUp lineVertical lineHorizontal dLarge1V dLarge1H cornerVH cornerHV hlarge x hx y hy have hxB : x ∈ (B 1).1 := by simpa using hx have hyB : y ∈ (B 1).1 := by simpa using hy @@ -1510,20 +1643,20 @@ theorem P4112T1PathGeometry (P : FordFareyParameter) (hP : 2 < P.q) : (y : GaussianInt) (hy : y ∈ (B 1).1) : FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1 := - PathAdjacencyProof.smallOneNeighbors P hsum hs memB1Small distDistUp lineVertical + PathAdjacencyProof.smallOneNeighbors P hsum memB1Small distDistUp lineVertical lineHorizontal dSmall1V dSmall1H cornerVH cornerHV hsmall x hx y hy have largeZeroNeighbors (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 0).1) (y : GaussianInt) (hy : y ∈ (B 0).1) : FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1 := - PathAdjacencyProof.largeZeroNeighbors P hP hsum hs hr memB0Large distDistDown + PathAdjacencyProof.largeZeroNeighbors P hP hsum hr memB0Large distDistDown distDistUp lineVertical lineHorizontal dLarge0V dLarge0H cornerVH cornerHV hlarge x hx y hy have largeOneNeighbors (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 1).1) (y : GaussianInt) (hy : y ∈ (B 1).1) : FourNeighborAdjacent x y ↔ (x.re = y.re ∨ x.im = y.im) ∧ Nat.dist (d x) (d y) = 1 := - PathAdjacencyProof.largeOneNeighbors P hP hsum hs hr memB1Large distDistDown + PathAdjacencyProof.largeOneNeighbors P hP hsum hr memB1Large distDistDown distDistUp lineVertical lineHorizontal dLarge1V dLarge1H cornerVH cornerHV hlarge x hx y hy refine ⟨partition, hdisj, hcross, ?_⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean index 5aeda9edb7..dd06e00363 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean @@ -1319,62 +1319,17 @@ private theorem noBoundaryFour : (by classical exact - ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : - GaussianInt), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ - BoundaryFootprintVertices T) → ((∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ - T.cells) → ((∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) → ( - let y : GaussianInt := x - u - (1 ≤ y.re ∧ y.re ≤ (P.q : Int) - 1 ∧ 1 ≤ y.im ∧ y.im ≤ (P.q : Int) - 1) → ((x ∈ - FootprintVertices (S 0 true) ↔ 0 ≤ y.re ∧ y.re ≤ P.q₁ ∧ 0 ≤ y.im ∧ y.im ≤ P.q₁) → ((x - ∈ FootprintVertices (S 0 false) ↔ P.q₂ ≤ y.re ∧ y.re ≤ P.q ∧ P.q₂ ≤ y.im ∧ y.im ≤ - P.q) → ((x ∈ FootprintVertices (S 1 true) ↔ P.q₁ ≤ y.re ∧ y.re ≤ P.q ∧ 0 ≤ y.im ∧ - y.im ≤ P.q₂) → ((x ∈ FootprintVertices (S 1 false) ↔ 0 ≤ y.re ∧ y.re ≤ P.q₂ ∧ P.q₁ ≤ - y.im ∧ y.im ≤ P.q) → ((y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) ↔ - (0 : Int) ≤ y.re ∧ y.re ≤ P.q₁ ∧ 0 ≤ y.im ∧ y.im ≤ P.q₁ ∧ (y.re = 0 ∨ y.re = P.q₁ ∨ - y.im = 0 ∨ y.im = P.q₁)) → ((y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P - 1) ↔ (P.q₂ : Int) ≤ y.re ∧ y.re ≤ P.q ∧ P.q₂ ≤ y.im ∧ y.im ≤ P.q ∧ (y.re = P.q₂ ∨ - y.re = P.q ∨ y.im = P.q₂ ∨ y.im = P.q)) → ((y ∈ LatticeVertexBoundary - (FordRecursiveVertexDomains P 2) ↔ P.q₁ ≤ y.re ∧ y.re ≤ P.q ∧ (0 : Int) ≤ y.im ∧ y.im - ≤ P.q₂ ∧ (y.re = P.q₁ ∨ y.re = P.q ∨ y.im = 0 ∨ y.im = P.q₂)) → ((y ∈ - LatticeVertexBoundary (FordRecursiveVertexDomains P 3) ↔ (0 : Int) ≤ y.re ∧ y.re ≤ - P.q₂ ∧ P.q₁ ≤ y.im ∧ y.im ≤ P.q ∧ (y.re = 0 ∨ y.re = P.q₂ ∨ y.im = P.q₁ ∨ y.im = - P.q)) → ((x ∈ BoundaryFootprintVertices (S 0 true) ↔ y ∈ LatticeVertexBoundary - (FordRecursiveVertexDomains P 0)) → ((x ∈ BoundaryFootprintVertices (S 0 false) ↔ y ∈ - LatticeVertexBoundary (FordRecursiveVertexDomains P 1)) → ((x ∈ - BoundaryFootprintVertices (S 1 true) ↔ y ∈ LatticeVertexBoundary - (FordRecursiveVertexDomains P 2)) → ((x ∈ BoundaryFootprintVertices (S 1 false) ↔ y ∈ - LatticeVertexBoundary (FordRecursiveVertexDomains P 3)) → ((x ∉ - BoundaryFootprintVertices (S 2 true)) → ((x ∉ BoundaryFootprintVertices (S 2 false)) - → ((Nat.card {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} = (if x - ∈ BoundaryFootprintVertices (S 0 true) then 1 else 0) + (if x ∈ - BoundaryFootprintVertices (S 0 false) then 1 else 0) + (if x ∈ - BoundaryFootprintVertices (S 1 true) then 1 else 0) + (if x ∈ - BoundaryFootprintVertices (S 1 false) then 1 else 0) + (if x ∈ - BoundaryFootprintVertices (S 2 true) then 1 else 0) + (if x ∈ - BoundaryFootprintVertices (S 2 false) then 1 else 0)) → ((FordBoundaryMultiplicity P - y = Nat.card - {i : Fin 4 // y ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P i)}) → - ((FordBoundaryMultiplicity P y = (if y ∈ LatticeVertexBoundary - (FordRecursiveVertexDomains P 0) then 1 else 0) + (if y ∈ LatticeVertexBoundary - (FordRecursiveVertexDomains P 1) then 1 else 0) + (if y ∈ LatticeVertexBoundary - (FordRecursiveVertexDomains P 2) then 1 else 0) + (if y ∈ LatticeVertexBoundary - (FordRecursiveVertexDomains P 3) then 1 else 0)) → ((Nat.card - {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} = - FordBoundaryMultiplicity P y) → (((GaussianRealPoint x = TileCentroid T) → (((y.re : - Int) : Real) = (P.q : Real) / 2 ∧ ((y.im : Int) : Real) = (P.q : Real) / 2)) → - (((GaussianRealPoint x = TileCentroid T) → (2 * y.re = (P.q : Int) ∧ 2 * y.im = (P.q - : Int))) → (((GaussianRealPoint x = TileCentroid T) → (FordBoundaryMultiplicity P y ≠ - 2)) → (((Nat.card {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} = - 4) → (P.q = 2 ∧ GaussianRealPoint x = TileCentroid T)) → ((∀ (R : ProtoTile), ∀ (j : - Fin 4), (LatticeVertexIncidentCell x j ∈ R.cells) → (x ∈ FootprintVertices R)) → - (∀ (R : ProtoTile), (∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ - R.cells) → x ∉ - BoundaryFootprintVertices R))))))))))))))))))))))))))))) := by + ∀ (T : ProtoTile), + GaussianInt → + ∀ (x : GaussianInt), + x ∈ FootprintVertices T → + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) → + ∀ (R : ProtoTile), + (∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ R.cells) → + x ∉ BoundaryFootprintVertices R + ) := by classical - intro P T S u x hx hxb hsome cells y hbounds foot0 foot1 foot2 foot3 domain0 domain1 domain2 - domain3 label0 label1 label2 label3 lineTrue lineFalse hcardSix hcardFour hcardFourFormula - hcount centerCoords centerTwice noCenteredCountTwo countFourConclusion incidentFootprint R - hall + intro T u x hx cells R hall have hneR : R.cells.Nonempty := ⟨_, hall 0⟩ intro hx simp only [BoundaryFootprintVertices, ite_eq_left hneR, @@ -1709,10 +1664,7 @@ theorem P4120T1FordGeometry (hc : LatticeVertexIncidentCell x j ∈ R.cells) := FordTileGeometry.incidentFootprint x R j hc have noBoundaryFour (R : ProtoTile) (hall : ∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ R.cells) := - FordTileGeometry.noBoundaryFour P T S u x hx hxb hsome cells hbounds foot0 foot1 foot2 - foot3 domain0 domain1 domain2 domain3 label0 label1 label2 label3 lineTrue lineFalse - hcardSix hcardFour hcardFourFormula hcount centerCoords centerTwice noCenteredCountTwo - countFourConclusion incidentFootprint R hall + FordTileGeometry.noBoundaryFour T u x hx cells R hall have incidentOwner (j : Fin 4) := FordTileGeometry.incidentOwner P T S u x cells cellCanonical Sc hcover hparentCells j have twoBoundaryCount (a b : Fin 3 × Bool) (hab : a ≠ b) diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean index 9a43499381..3766a57ce3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.InteriorFootprintIncidence public import LeanPool.ApollonianSuperharmonic.AllowedSubtileIncidenceZeroOppositeChord @@ -64,18 +65,7 @@ private theorem hOsub : rw [cert.precursor_cells] at hz exact (cert.minus_union z).mpr ⟨0, true, hz⟩ -private theorem tile_zero : - (by - classical - exact - ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by - classical - intro U - cases U - have hz : GaussianTranslation 0 = id := by - funext z - simp [GaussianTranslation] - simp [TileTranslation, hz, Finset.image_id] +private abbrev tile_zero := ApollonianSuperharmonic.TileTranslationProperties.zero private theorem modified_cell_owner : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean index aa678b7c77..1d3241cba8 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean @@ -444,22 +444,7 @@ private theorem U_edge : rw [hUa] exact hEdgeU -private theorem V_edge : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin (3 : ℕ)), ∀ (u : - GaussianInt), ∀ (PP : PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (x : GaussianInt), - let z : GaussianInt := - if (x - u).im = (if i = 0 then (P.q₁ : Int) else P.q₂) - then x else x - ⟨0, 1⟩ - ∀ (V : ProtoTile), ({z, z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)} ∈ FootprintEdges V) → (∀ - (b : ↥(TilingLattice Ci)), (PP.tile b = V) → ({z, z + ⟨0, 1⟩} ∈ FootprintEdges - (PP.tile b))) ) := by - classical - intro P Ci i u PP x z V hEdgeV b hVb - rw [hVb] - exact hEdgeV +private abbrev V_edge := ApollonianSuperharmonic.EdgeSectorGeometry.U_edge private theorem T_bounds : (by @@ -1328,22 +1313,7 @@ private theorem hdisET'At847 : apply ford_disjoint_im simp [Zsqrtd.im_add] -private theorem he_ne_aAt851 : - (by - classical - exact - ∀ (Ci : BandCircle), ∀ (T : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (PP : - PeriodicTileComplex ↥(TilingLattice Ci)), ∀ (U : ProtoTile), ∀ (a : ↥(TilingLattice - Ci)), (PP.tile a = U) → ((U.cells ⊆ T.cells) → (∀ (cf : LatticeCell), (cf ∈ U.cells) - → (∀ (e : ↥(TilingLattice Ci)), (PP.tile e = Rplus) → ((Disjoint Rplus.cells T.cells) - → (e ≠ a))))) ) := by - classical - intro Ci T Rplus PP U a hUa U_in_T cf hcf e he hdisET heq - have hcfA : cf ∈ (PP.tile a).cells := by simpa [hUa] using hcf - have hcfE : cf ∈ Rplus.cells := by - rw [← he] - simpa [heq] using hcfA - exact (Finset.disjoint_left.mp hdisET) hcfE (U_in_T hcf) +private abbrev he_ne_aAt851 := ApollonianSuperharmonic.EdgeSectorGeometry.he_ne_bAt755 private abbrev he_ne_bAt858 := ApollonianSuperharmonic.EdgeSectorGeometry.he_ne_bAt755 @@ -1743,14 +1713,12 @@ private theorem hq1castAt1045 : exact ∀ (P : FordFareyParameter), (0 : ℕ) < P.q₁ → - GaussianInt → - GaussianInt → - (P.q₁ : Int) + P.q₂ = P.q → - ((P.q - 1 : Nat) : Int) = (P.q : Int) - 1 → - ((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1 + (P.q₁ : Int) + P.q₂ = P.q → + ((P.q - 1 : Nat) : Int) = (P.q : Int) - 1 → + ((P.q₁ - 1 : Nat) : Int) = (P.q₁ : Int) - 1 ) := by classical - intro P hrpos u x hqsum hqcast + intro P hrpos hqsum hqcast exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q₁) private theorem hmcAt1049 : @@ -2462,7 +2430,7 @@ theorem P4158T1EdgeSectorSelection : exact_mod_cast P.sum_q.symm have hqcast : ((P.q - 1 : Nat) : Int) = (P.q : Int) - 1 := by exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q) - have hq1cast := EdgeSectorGeometry.hq1castAt1045 P hrpos u x hqsum hqcast + have hq1cast := EdgeSectorGeometry.hq1castAt1045 P hrpos hqsum hqcast let m : GaussianInt := x - 1 have hmc := EdgeSectorGeometry.hmcAt1049 P u x hxre'' hxim'' hqsum hqcast have hRmem : Rminus ∈ tiles := List.mem_of_head? hf.2.1 diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean index cf2cb61bd9..80f3987ab0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordFareySum public import LeanPool.ApollonianSuperharmonic.AncestorOdometer public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification @@ -173,17 +174,7 @@ private theorem hAncV : · intro y hy exact (hvalue' 0 true y hy).symm -private theorem hcross : - (by - classical - exact - ∀ (P : FordFareyParameter), P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 ) := by - classical - intro P - have h := P.det₁ - rw [P.sum_q, P.sum_p] at h - push_cast at h - nlinarith +private abbrev hcross := ApollonianSuperharmonic.FordFareySum.determinant private theorem hcop : (by @@ -376,13 +367,12 @@ private theorem fordCentroid : (by classical exact - FordFareyParameter → - ∀ (n : ℕ), - (0 : ℕ) < n → - TileCentroid (FordTile n) = ((↑n : ℝ) / (2 : ℝ), (↑n : ℝ) / (2 : ℝ)) + ∀ (n : ℕ), + (0 : ℕ) < n → + TileCentroid (FordTile n) = ((↑n : ℝ) / (2 : ℝ), (↑n : ℝ) / (2 : ℝ)) ) := by classical - intro P n hn + intro n hn let D : Finset GaussianInt := (Finset.range n).product (Finset.range n) |>.image (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) @@ -996,7 +986,7 @@ theorem P4158T1LargeFirstRestrictions have hvsecond := LargeFirstRestrictions.hvsecond P hq hv20 have hvsol := LargeFirstRestrictions.hvsol P hvsum hvfirst hvsecond have haslope32 := LargeFirstRestrictions.haslope32 P ha32 - have fordCentroid (n : Nat) (hn : 0 < n) := LargeFirstRestrictions.fordCentroid P n hn + have fordCentroid (n : Nat) (hn : 0 < n) := LargeFirstRestrictions.fordCentroid n hn let Uc := TileTranslation (FordTile P.q₁) (u + ⟨P.q₂, P.q₂⟩) let Vc := TileTranslation (FordTile P.q₁) (u + ⟨P.q, P.q₁⟩) have hUcBand : BandPrototile Ci.1.1 Uc := diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean index 4c39064f5d..af400ca8b0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid +public import LeanPool.ApollonianSuperharmonic.FordFareySum public import LeanPool.ApollonianSuperharmonic.AncestorOdometer public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification @@ -34,12 +36,13 @@ private theorem hcurv : (by classical exact - ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), (FordRecursiveQuadruple P (2 : Fin (4 : - ℕ)) = Ci.1.1) → (((1 : ℤ) < Ci.1.1.1) → ((P.q₁ < P.q₂) → (∀ (T' : ProtoTile), ∀ (u : - GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) (u + ⟨-(↑P.q : ℤ), (↑P.q₂ : - ℤ)⟩)).cells) → (1 < P.q₂)))) ) := by + ∀ (P : FordFareyParameter), + ∀ (Ci : BandCircle), + FordRecursiveQuadruple P (2 : Fin (4 : ℕ)) = Ci.1.1 → + (1 : ℤ) < Ci.1.1.1 → P.q₁ < P.q₂ → 1 < P.q₂ + ) := by classical - intro P Ci hCi hlarge horder T' u hc' + intro P Ci hCi hlarge horder have hlarge' : (1 : Int) < (P.q₂ * P.q₂ : Nat) := by rw [← hCi] at hlarge simpa [FordRecursiveQuadruple, FordCircleCoordinate] using hlarge @@ -105,17 +108,7 @@ private theorem hVk : rw [← hCi] exact hchild₂ 1 true -private theorem hcross : - (by - classical - exact - ∀ (P : FordFareyParameter), P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 ) := by - classical - intro P - have hd := P.det₁ - rw [P.sum_q, P.sum_p] at hd - push_cast at hd - nlinarith +private abbrev hcross := ApollonianSuperharmonic.FordFareySum.determinant private theorem hcross2 : (by @@ -299,94 +292,7 @@ private theorem hoffV : (2⁻¹ * (P.q₁ : Real), -(2⁻¹ * (P.q₁ : Real))) := by simpa [V] using hh _ = ((P.q₁ : Real) / 2, -(P.q₁ : Real) / 2) := by ext <;> ring -private theorem fordCentroid : - (by - classical - exact - ∀ (n : ℕ), - (0 : ℕ) < n → - TileCentroid (FordTile n) = ((↑n : ℝ) / (2 : ℝ), (↑n : ℝ) / (2 : ℝ)) - ) := by - classical - intro n hn - let domain : Finset GaussianInt := FordCellDomain n - have hne : domain.Nonempty := by - refine ⟨⟨0, 0⟩, ?_⟩ - apply Finset.mem_image.mpr - exact ⟨(0, 0), Finset.mem_product.mpr ⟨by simpa using hn, by simpa using hn⟩, rfl⟩ - have hinj : Set.InjOn - (fun a : Nat × Nat => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) - ↑((Finset.range n).product (Finset.range n)) := by - intro a ha b hb hab - apply Prod.ext - · have he := congrArg (fun z : GaussianInt => z.re) hab - change (a.1 : Int) = (b.1 : Int) at he - exact_mod_cast he - · have he := congrArg (fun z : GaussianInt => z.im) hab - change (a.2 : Int) = (b.2 : Int) at he - exact_mod_cast he - have hcard : domain.card = n * n := by - calc - domain.card = ((Finset.range n).product (Finset.range n)).card := by - dsimp [domain, FordCellDomain] - exact Finset.card_image_iff.mpr hinj - _ = n * n := by simp - have hsumRe : domain.sum (fun z : GaussianInt => z.re) = - (n : Int) * ((n - 1 : Nat) : Int) / 2 * (n : Int) := by - have hrange : (Finset.range n).sum (fun x => (x : Int)) = - (n : Int) * ((n - 1 : Nat) : Int) / 2 := by - rw [← Nat.cast_sum] - simp [Finset.sum_range_id] - simp only [FordCellDomain, Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, - Finset.coe_range, Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, - implies_true, Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, - Finset.sum_const, Finset.card_range, Int.nsmul_eq_mul, domain] - conv_lhs => rw [← Finset.mul_sum (Finset.range n) (fun x => (x : Int)) (n : Int)] - rw [hrange] - ring - have hsumIm : domain.sum (fun z : GaussianInt => z.im) = - (n : Int) * ((n - 1 : Nat) : Int) / 2 * (n : Int) := by - have hrange : (Finset.range n).sum (fun x => (x : Int)) = - (n : Int) * ((n - 1 : Nat) : Int) / 2 := by - rw [← Nat.cast_sum] - simp [Finset.sum_range_id] - simp only [FordCellDomain, Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, - Finset.coe_range, Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, - implies_true, Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, - Finset.sum_const, Finset.card_range, Int.nsmul_eq_mul, domain] - rw [hrange] - ring - change (if domain.Nonempty then - ((↑(domain.sum (fun z : GaussianInt => z.re) : Int) / ↑domain.card + (1 / 2 : Real)), - (↑(domain.sum (fun z : GaussianInt => z.im) : Int) / ↑domain.card + (1 / 2 : Real))) else - _) = _ - rw [ite_eq_left hne, hcard, hsumRe, hsumIm] - norm_num - field_simp - have arith := Finset.sum_range_id_mul_two n - have rangeSum : (Finset.range n).sum (fun x => (x : Int)) = - (n : Int) * ((n - 1 : Nat) : Int) / 2 := by - rw [← Nat.cast_sum] - simp [Finset.sum_range_id] - have arithCast : ((Finset.range n).sum (fun x => (x : Int))) * 2 = - (n : Int) * ((n - 1 : Nat) : Int) := by - rw [← Nat.cast_sum] - exact_mod_cast arith - rw [rangeSum] at arithCast - have hqcast : ((n - 1 : Nat) : Int) = (n : Int) - 1 := by omega - rw [hqcast] at arithCast - norm_num [Int.subNatNat, pow_two] - have natIdentity : n * (n - 1) / 2 * 2 + n = n * n := by - rw [← Finset.sum_range_id n] - rw [Finset.sum_range_id_mul_two] - rw [Nat.mul_sub_left_distrib] - simp only [Nat.mul_one] - have bound : n ≤ n * n := by - calc - n = n * 1 := by omega - _ ≤ n * n := Nat.mul_le_mul_left n (by omega) - rw [Nat.sub_add_cancel bound] - exact_mod_cast natIdentity +private abbrev fordCentroid := ApollonianSuperharmonic.P4210T1FordSquareCentroid private theorem rootCentroidEq : (by @@ -670,16 +576,7 @@ private theorem hUoffSlope : intro P p pU hxU hyU constructor <;> linarith -private theorem hpRootV : - (by - classical - exact - ∀ (h' : PartialOdometer), ∀ (p' : Real × Real), (PartialOdometerSlope h' = some p') → (∀ - (pRootV : ℝ × ℝ), (PartialOdometerSlope h' = some pRootV) → (pRootV = p')) ) := by - classical - intro h' p' hs' pRootV hrootV - apply Option.some.inj - exact hrootV.symm.trans hs' +private abbrev hpRootV := ApollonianSuperharmonic.LargeSecondRestrictions.hpRootU private theorem hVoffSlope : (by @@ -913,7 +810,7 @@ theorem P4158T1LargeSecondRestrictions FordRecursiveQuadruple Q 0 = Ci.1.1 ∧ 1 < Q.q := by -- BODY classical - have hcurv := LargeSecondRestrictions.hcurv P Ci hCi hlarge horder T' u hc' + have hcurv := LargeSecondRestrictions.hcurv P Ci hCi hlarge horder have hqgt := LargeSecondRestrictions.hqgt P hcurv have hq0 : 1 < (FordRecursiveQuadruple P 0).1 := LargeSecondRestrictions.hq0 P hqgt have hd := TileOdometerReindexedDecomposition diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean index ac14ffa2f8..f1877e0b96 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean @@ -29,13 +29,13 @@ private theorem hidx : (by classical exact - ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P - i.succ = Ci.1.1) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ((1 : ℤ) < Ci.1.1.1) → - ((TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 - (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))))) → (i - ≠ 2))) ) := by + ∀ (P : FordFareyParameter), + ∀ (Ci : BandCircle), + ∀ (i : Fin 3), + FordRecursiveQuadruple P i.succ = Ci.1.1 → (1 : ℤ) < Ci.1.1.1 → i ≠ 2 + ) := by classical - intro P Ci i hCi T T' hlarge hcent hi + intro P Ci i hCi hlarge hi subst i have hc := congrArg (fun x : CircleCoordinates => x.1) hCi simp [FordRecursiveQuadruple] at hc @@ -45,13 +45,14 @@ private theorem hqgt : (by classical exact - ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P - i.succ = Ci.1.1) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ((1 : ℤ) < Ci.1.1.1) → - ((TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 - (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))))) → - ((i ≠ 2) → (1 < P.q)))) ) := by + ∀ (P : FordFareyParameter), + ∀ (Ci : BandCircle), + ∀ (i : Fin 3), + FordRecursiveQuadruple P i.succ = Ci.1.1 → + (1 : ℤ) < Ci.1.1.1 → i ≠ 2 → 1 < P.q + ) := by classical - intro P Ci i hCi T T' hlarge hcent hidx + intro P Ci i hCi hlarge hidx have hsumq : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by exact_mod_cast P.sum_q have hc := congrArg (fun x : CircleCoordinates => x.1) hCi @@ -95,13 +96,14 @@ private theorem hneq : (by classical exact - ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P - i.succ = Ci.1.1) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ((1 : ℤ) < Ci.1.1.1) → - ((TileCentroid T' - TileCentroid T = GaussianRealPoint (BandVectors.1 - (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))))) → - ((i ≠ 2) → ((0 < P.q₁) → ((0 < P.q₂) → (P.q₁ ≠ P.q₂)))))) ) := by + ∀ (P : FordFareyParameter), + ∀ (Ci : BandCircle), + ∀ (i : Fin 3), + FordRecursiveQuadruple P i.succ = Ci.1.1 → + (1 : ℤ) < Ci.1.1.1 → i ≠ 2 → 0 < P.q₁ → 0 < P.q₂ → P.q₁ ≠ P.q₂ + ) := by classical - intro P Ci i hCi T T' hlarge hcent hidx hrpos hspos heq + intro P Ci i hCi hlarge hidx hrpos hspos heq have hcross : P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 := by have h := P.det₁ rw [P.sum_q, P.sum_p] at h @@ -192,20 +194,7 @@ private theorem hTnon : rw [hu.1] simpa [TileTranslation] using hFnon.image (GaussianTranslation u) -private theorem hT'non : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (T' : ProtoTile), ∀ (h' : PartialOdometer), ∀ (H : - PartialOdometer), ∀ (v : GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) - v).cells ∧ (T'.cells = ∅ → T'.anchor = (TileTranslation (FordTile P.q) v).anchor) ∧ ∃ - (a : GaussianInt) (b : ℤ), (∀ (x : GaussianInt), x ∈ h'.domain ↔ x - v ∈ H.domain) ∧ - ∀ x ∈ h'.domain, h'.value x = H.value (x - v) + a.re * x.re + a.im * x.im + b) → - (((FordTile P.q).cells.Nonempty) → (T'.cells.Nonempty)) ) := by - classical - intro P T' h' H v hv hFnon - rw [hv.1] - simpa [TileTranslation] using hFnon.image (GaussianTranslation v) +private abbrev hT'non := ApollonianSuperharmonic.MatchedFordGeometry.hTnon private theorem hcentT : (by @@ -334,18 +323,24 @@ private theorem hvec : (by classical exact - ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P - i.succ = Ci.1.1) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), (TileCentroid T' - - TileCentroid T = GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))))) → ((i ≠ 2) → ((BandVectors.1 - (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : - ℕ))) = (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt)) → ((BandVectors.1 - (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (0 : Fin (4 : - ℕ))) = (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt)) → (BandVectors.1 - (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P 0) = if i = 0 then ⟨(P.q - : Int), (P.q₁ : Int)⟩ else ⟨-(P.q : Int), (P.q₂ : Int)⟩))))) ) := by + ∀ (P : FordFareyParameter), + ∀ (Ci : BandCircle), + ∀ (i : Fin 3), + FordRecursiveQuadruple P i.succ = Ci.1.1 → + i ≠ 2 → + BandVectors.1 (FordRecursiveQuadruple P (1 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = + (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) → + BandVectors.1 (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) + (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) = + (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt) → + BandVectors.1 (FordRecursiveQuadruple P i.succ) + (FordRecursiveQuadruple P 0) = + if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ + else ⟨-(P.q : Int), (P.q₂ : Int)⟩ + ) := by classical - intro P Ci i hCi T T' hcent hidx hvec0 hvec1 + intro P Ci i hCi hidx hvec0 hvec1 fin_cases i · simpa using hvec0 · simpa using hvec1 @@ -671,12 +666,12 @@ theorem P4158T1MatchedFordPair (x - u).im ≤ (P.q : Int)) := by -- BODY classical - have hidx : i ≠ 2 := MatchedFordGeometry.hidx P Ci i hCi T T' hlarge hcent - have hqgt : 1 < P.q := MatchedFordGeometry.hqgt P Ci i hCi T T' hlarge hcent hidx + have hidx : i ≠ 2 := MatchedFordGeometry.hidx P Ci i hCi hlarge + have hqgt : 1 < P.q := MatchedFordGeometry.hqgt P Ci i hCi hlarge hidx have hqpos : 0 < P.q := by omega have hrpos : 0 < P.q₁ := MatchedFordGeometry.hrpos P hqgt have hspos : 0 < P.q₂ := P.q₂_pos - have hneq : P.q₁ ≠ P.q₂ := MatchedFordGeometry.hneq P Ci i hCi T T' hlarge hcent hidx hrpos hspos + have hneq : P.q₁ ≠ P.q₂ := MatchedFordGeometry.hneq P Ci i hCi hlarge hidx hrpos hspos have hcurv : 0 < (FordCircleCoordinate P.p P.q).1 := MatchedFordGeometry.hcurv P hqpos obtain ⟨H, hHO, hHD, hHV⟩ := FordTileOdometerRestriction P have hHcircle : TileOdometer C0.1.1 (FordTile P.q) H := MatchedFordGeometry.hHcircle P C0 hC0 H @@ -704,7 +699,7 @@ theorem P4158T1MatchedFordPair have hvec : BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P 0) = if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ - else ⟨-(P.q : Int), (P.q₂ : Int)⟩ := MatchedFordGeometry.hvec P Ci i hCi T T' hcent hidx + else ⟨-(P.q : Int), (P.q₂ : Int)⟩ := MatchedFordGeometry.hvec P Ci i hCi hidx hvec0 hvec1 have hshift : v - u = if i = 0 then ⟨(P.q : Int), (P.q₁ : Int)⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean index d9c7d3c3f4..092a0c7fbc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties +public import LeanPool.ApollonianSuperharmonic.FordTileCellMembership public import LeanPool.ApollonianSuperharmonic.ListEndpointFacts public import LeanPool.ApollonianSuperharmonic.AncestorOdometer @@ -33,25 +35,34 @@ private theorem hqone : (by classical exact - ∀ (P : FordFareyParameter), ∀ (Ci : BandCircle), ∀ (i : Fin 3), (FordRecursiveQuadruple P - i.succ = Ci.1.1) → (((1 : ℤ) < Ci.1.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ i - = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : - GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : - ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : - GaussianInt))).cells) → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ - FootprintVertices T' ↔ ((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 - : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ - (x - u).im ≤ (↑P.q : ℤ)) → (∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), - (TileCentroid Rminus - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin - (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - TileCentroid T = (1 / 2 - : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → (((P.q : Int) = P.q₁ + - P.q₂) → (1 < P.q)))))))) ) := by + ∀ (P : FordFareyParameter), + ∀ (Ci : BandCircle), + ∀ (i : Fin 3), + FordRecursiveQuadruple P i.succ = Ci.1.1 → + (1 : ℤ) < Ci.1.1.1 → + i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ + i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁ → + ∀ (T : ProtoTile), + ∀ (T' : ProtoTile), + ∀ (u : GaussianInt), + T'.cells = + (TileTranslation (FordTile P.q) + (u + + if i = (0 : Fin (3 : ℕ)) then + (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) + else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells → + (∀ (x : GaussianInt), + x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ + ((x - u).re = + if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) ∧ + (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) + else (↑P.q₂ : ℤ)) ≤ + (x - u).im ∧ + (x - u).im ≤ (↑P.q : ℤ)) → + (P.q : Int) = P.q₁ + P.q₂ → 1 < P.q + ) := by classical - intro P Ci i hCi hlarge hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hsum + intro P Ci i hCi hlarge hsmall T T' u hc' hsegment hsum by_contra hn have he : P.q = 1 := by have := P.q_pos; omega have hunit := P.unit_case he @@ -194,30 +205,6 @@ private theorem hFord : rw [hpQ, hqQ] at hF simpa [n, ← hCi, FordRecursiveQuadruple] using hF -private theorem fordcell : - (by - classical - exact - ∀ (m : Nat), - ∀ (z : GaussianInt), - z ∈ (FordTile m).cells ↔ 0 ≤ z.re ∧ z.re < m ∧ 0 ≤ z.im ∧ z.im < m - ) := by - classical - intro m z - change z ∈ ((Finset.range m).product (Finset.range m)).image - (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) ↔ _ - rw [Finset.mem_image] - constructor - · rintro ⟨⟨j, k⟩, hjk, rfl⟩ - have hjk := Finset.mem_product.mp hjk - simp only [Finset.mem_range] at hjk - dsimp; omega - · rintro ⟨h0, h1, h2, h3⟩ - exact ⟨(z.re.toNat, z.im.toNat), - Finset.mem_product.mpr ⟨Finset.mem_range.mpr (by omega), - Finset.mem_range.mpr (by omega)⟩, - by ext <;> dsimp <;> omega⟩ - private theorem fordcent : (by classical @@ -556,20 +543,7 @@ private theorem hnormdelta : · simp [vm, vp, n, Zsqrtd.norm_def] ring -private theorem pointinj : - (by - classical - exact - Function.Injective GaussianRealPoint ) := by - classical - intro x y he - apply Zsqrtd.ext - · have hh := congrArg Prod.fst he - dsimp [GaussianRealPoint] at hh - exact_mod_cast hh - · have hh := congrArg Prod.snd he - dsimp [GaussianRealPoint] at hh - exact_mod_cast hh +private abbrev pointinj := ApollonianSuperharmonic.GaussianRealPointProperties.injective private theorem hRS : (by @@ -791,49 +765,80 @@ private theorem hminusheight : classical exact ∀ (P : FordFareyParameter), - (∀ (Ci : BandCircle), ∀ (i : Fin 3), - (FordRecursiveQuadruple P i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ - i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : - GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : - ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : - GaussianInt))).cells) → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ - FootprintVertices T' ↔ ((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 - : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ - (x - u).im ≤ (↑P.q : ℤ)) → (∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), - (TileCentroid Rminus - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin - (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - TileCentroid T = (1 / 2 - : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → (((P.q : Int) = P.q₁ + - P.q₂) → ( - let n := if i = 0 then P.q₁ else P.q₂; - (0 < n) → ((n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ((BandPrototile Ci.1.1 - (FordTile n)) → ((∀ (A : ProtoTile), ∀ (m : Nat), (0 < m) → (∀ (v : GaussianInt), - (A.cells = (TileTranslation (FordTile m) v).cells) → (FootprintVertices A = - FootprintVertices (TileTranslation (FordTile m) v) ∧ TileCentroid A = TileCentroid - (TileTranslation (FordTile m) v)))) → ( - let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩; - let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩; - (BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P - i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (FordRecursiveQuadruple - P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) → ((TileCentroid Rminus = - TileCentroid (TileTranslation (FordTile n) vm)) → ((TileCentroid Rplus = TileCentroid - (TileTranslation (FordTile n) vp)) → ((Rminus.cells = (TileTranslation (FordTile n) - vm).cells) → ((Rplus.cells = (TileTranslation (FordTile n) vp).cells) → - ((TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint (vp - vm)) → - ((Zsqrtd.norm (vp - vm) = (P.q : Int) ^ 2 + (n : Int) ^ 2) → (∀ (walk : List - GaussianInt), (∀ (x : GaussianInt), (x ∈ walk) → ((x - u).re = (if i = 0 then (P.q : - Int) else 0) ∧ (n : Int) ≤ (x - u).im ∧ (x - u).im ≤ P.q)) → ((∀ (m : Nat), (0 < m) → - (∀ (v : GaussianInt), ∀ (x : GaussianInt), x ∈ FootprintVertices (TileTranslation - (FordTile m) v) ↔ 0 ≤ (x - v).re ∧ (x - v).re ≤ m ∧ 0 ≤ (x - v).im ∧ (x - v).im ≤ m)) - → (∀ (x : GaussianInt), (x ∈ walk) → ((x ∈ FootprintVertices Rminus) → ((x - u).im = - if i = 0 then (n : Int) else P.q))))))))))))))))))))))))) ) := by + ∀ (Ci : BandCircle), + ∀ (i : Fin 3), + FordRecursiveQuadruple P i.succ = Ci.1.1 → + i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ + i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁ → + ∀ (T : ProtoTile), + ∀ (T' : ProtoTile), + ∀ (u : GaussianInt), + T'.cells = + (TileTranslation (FordTile P.q) + (u + + if i = (0 : Fin (3 : ℕ)) then + (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) + else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells → + (∀ (x : GaussianInt), + x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ + ((x - u).re = + if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) ∧ + (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) + else (↑P.q₂ : ℤ)) ≤ + (x - u).im ∧ + (x - u).im ≤ (↑P.q : ℤ)) → + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + (P.q : Int) = P.q₁ + P.q₂ → + let n := if i = 0 then P.q₁ else P.q₂; + 0 < n → + n < P.q → + Ci.1.1.1 = (n : Int) ^ 2 → + 1 < n → + BandPrototile Ci.1.1 (FordTile n) → + (∀ (A : ProtoTile), + ∀ (m : Nat), + 0 < m → + ∀ (v : GaussianInt), + A.cells = (TileTranslation (FordTile m) v).cells → + FootprintVertices A = + FootprintVertices (TileTranslation (FordTile m) v) ∧ + TileCentroid A = + TileCentroid (TileTranslation (FordTile m) v)) → + let vm : GaussianInt := + u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩; + let vp : GaussianInt := + u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩; + TileCentroid Rminus = + TileCentroid (TileTranslation (FordTile n) vm) → + TileCentroid Rplus = + TileCentroid (TileTranslation (FordTile n) vp) → + Rminus.cells = (TileTranslation (FordTile n) vm).cells → + Rplus.cells = (TileTranslation (FordTile n) vp).cells → + TileCentroid Rplus - TileCentroid Rminus = + GaussianRealPoint (vp - vm) → + Zsqrtd.norm (vp - vm) = (P.q : Int) ^ 2 + (n : Int) ^ 2 → + ∀ (walk : List GaussianInt), + (∀ (x : GaussianInt), + x ∈ walk → + ((x - u).re = if i = 0 then (P.q : Int) else 0) ∧ + (n : Int) ≤ (x - u).im ∧ (x - u).im ≤ P.q) → + (∀ (m : Nat), + 0 < m → + ∀ (v : GaussianInt), + ∀ (x : GaussianInt), + x ∈ FootprintVertices (TileTranslation (FordTile m) v) ↔ + 0 ≤ (x - v).re ∧ + (x - v).re ≤ m ∧ 0 ≤ (x - v).im ∧ (x - v).im ≤ m) → + ∀ (x : GaussianInt), + x ∈ walk → + x ∈ FootprintVertices Rminus → + (x - u).im = if i = 0 then (n : Int) else P.q + ) := by classical - intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hsum n hnpos hnq hCicurv - hnlarge hFord cellobs vm vp hflip hcmcand hcpcand heqm heqp hdelta hnormdelta walk - hwsegment squarefoot x hx hxm + intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hsum n hnpos hnq hCicurv hnlarge + hFord cellobs vm vp hcmcand hcpcand heqm heqp hdelta hnormdelta walk hwsegment squarefoot + x hx hxm rw [(cellobs Rminus n hnpos vm heqm).1] at hxm have hxbox := (squarefoot n hnpos vm x).mp hxm have hxseg := hwsegment x hx @@ -845,51 +850,84 @@ private theorem hplusheight : classical exact ∀ (P : FordFareyParameter), - (∀ (Ci : BandCircle), ∀ (i : Fin 3), - (FordRecursiveQuadruple P i.succ = Ci.1.1) → ((i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ - i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁) → (∀ (T : ProtoTile), ∀ (T' : ProtoTile), ∀ (u : - GaussianInt), (T'.cells = (TileTranslation (FordTile P.q) (u + if i = (0 : Fin (3 : - ℕ)) then (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : - GaussianInt))).cells) → ((∀ (x : GaussianInt), x ∈ FootprintVertices T ∩ - FootprintVertices T' ↔ ((x - u).re = if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 - : ℤ)) ∧ (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) else (↑P.q₂ : ℤ)) ≤ (x - u).im ∧ - (x - u).im ≤ (↑P.q : ℤ)) → (∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), - (TileCentroid Rminus - TileCentroid T = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P (0 : Fin - (4 : ℕ))) - BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P i.succ))) → ((TileCentroid Rplus - TileCentroid T = (1 / 2 - : ℝ) • GaussianRealPoint (BandVectors.1 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) → (((P.q : Int) = P.q₁ + - P.q₂) → ( - let n := if i = 0 then P.q₁ else P.q₂; - (0 < n) → ((n < P.q) → ((Ci.1.1.1 = (n : Int) ^ 2) → ((1 < n) → ((BandPrototile Ci.1.1 - (FordTile n)) → ((∀ (A : ProtoTile), ∀ (m : Nat), (0 < m) → (∀ (v : GaussianInt), - (A.cells = (TileTranslation (FordTile m) v).cells) → (FootprintVertices A = - FootprintVertices (TileTranslation (FordTile m) v) ∧ TileCentroid A = TileCentroid - (TileTranslation (FordTile m) v)))) → ( - let vm : GaussianInt := u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩; - let vp : GaussianInt := u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩; - (BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P - i.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (FordRecursiveQuadruple - P i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) → ((TileCentroid Rminus = - TileCentroid (TileTranslation (FordTile n) vm)) → ((TileCentroid Rplus = TileCentroid - (TileTranslation (FordTile n) vp)) → ((Rminus.cells = (TileTranslation (FordTile n) - vm).cells) → ((Rplus.cells = (TileTranslation (FordTile n) vp).cells) → - ((TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint (vp - vm)) → - ((Zsqrtd.norm (vp - vm) = (P.q : Int) ^ 2 + (n : Int) ^ 2) → (∀ (walk : List - GaussianInt), (∀ (x : GaussianInt), (x ∈ walk) → ((x - u).re = (if i = 0 then (P.q : - Int) else 0) ∧ (n : Int) ≤ (x - u).im ∧ (x - u).im ≤ P.q)) → ((∀ (m : Nat), (0 < m) → - (∀ (v : GaussianInt), ∀ (x : GaussianInt), x ∈ FootprintVertices (TileTranslation - (FordTile m) v) ↔ 0 ≤ (x - v).re ∧ (x - v).re ≤ m ∧ 0 ≤ (x - v).im ∧ (x - v).im ≤ m)) - → ((∀ (x : GaussianInt), (x ∈ walk) → ((x ∈ FootprintVertices Rminus) → ((x - u).im = - if i = 0 then (n : Int) else P.q))) → (∀ (x : GaussianInt), (x ∈ walk) → ((x ∈ - FootprintVertices Rplus) → ((x - u).im = if i = 0 then (P.q : Int) else - n)))))))))))))))))))))))))) ) := by + ∀ (Ci : BandCircle), + ∀ (i : Fin 3), + FordRecursiveQuadruple P i.succ = Ci.1.1 → + i = (0 : Fin (3 : ℕ)) ∧ P.q₁ < P.q₂ ∨ + i = (1 : Fin (3 : ℕ)) ∧ P.q₂ < P.q₁ → + ∀ (T : ProtoTile), + ∀ (T' : ProtoTile), + ∀ (u : GaussianInt), + T'.cells = + (TileTranslation (FordTile P.q) + (u + + if i = (0 : Fin (3 : ℕ)) then + (⟨(↑P.q : ℤ), (↑P.q₁ : ℤ)⟩ : GaussianInt) + else (⟨-(↑P.q : ℤ), (↑P.q₂ : ℤ)⟩ : GaussianInt))).cells → + (∀ (x : GaussianInt), + x ∈ FootprintVertices T ∩ FootprintVertices T' ↔ + ((x - u).re = + if i = (0 : Fin (3 : ℕ)) then (↑P.q : ℤ) else (0 : ℤ)) ∧ + (if i = (0 : Fin (3 : ℕ)) then (↑P.q₁ : ℤ) + else (↑P.q₂ : ℤ)) ≤ + (x - u).im ∧ + (x - u).im ≤ (↑P.q : ℤ)) → + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + (P.q : Int) = P.q₁ + P.q₂ → + let n := if i = 0 then P.q₁ else P.q₂; + 0 < n → + n < P.q → + Ci.1.1.1 = (n : Int) ^ 2 → + 1 < n → + BandPrototile Ci.1.1 (FordTile n) → + (∀ (A : ProtoTile), + ∀ (m : Nat), + 0 < m → + ∀ (v : GaussianInt), + A.cells = (TileTranslation (FordTile m) v).cells → + FootprintVertices A = + FootprintVertices (TileTranslation (FordTile m) v) ∧ + TileCentroid A = + TileCentroid (TileTranslation (FordTile m) v)) → + let vm : GaussianInt := + u + if i = 0 then ⟨P.q, 0⟩ else ⟨0, P.q⟩; + let vp : GaussianInt := + u + if i = 0 then ⟨P.q₂, P.q⟩ else ⟨-(P.q₂ : Int), 0⟩; + TileCentroid Rminus = + TileCentroid (TileTranslation (FordTile n) vm) → + TileCentroid Rplus = + TileCentroid (TileTranslation (FordTile n) vp) → + Rminus.cells = (TileTranslation (FordTile n) vm).cells → + Rplus.cells = (TileTranslation (FordTile n) vp).cells → + TileCentroid Rplus - TileCentroid Rminus = + GaussianRealPoint (vp - vm) → + Zsqrtd.norm (vp - vm) = (P.q : Int) ^ 2 + (n : Int) ^ 2 → + ∀ (walk : List GaussianInt), + (∀ (x : GaussianInt), + x ∈ walk → + ((x - u).re = if i = 0 then (P.q : Int) else 0) ∧ + (n : Int) ≤ (x - u).im ∧ (x - u).im ≤ P.q) → + (∀ (m : Nat), + 0 < m → + ∀ (v : GaussianInt), + ∀ (x : GaussianInt), + x ∈ FootprintVertices (TileTranslation (FordTile m) v) ↔ + 0 ≤ (x - v).re ∧ + (x - v).re ≤ m ∧ 0 ≤ (x - v).im ∧ (x - v).im ≤ m) → + (∀ (x : GaussianInt), + x ∈ walk → + x ∈ FootprintVertices Rminus → + (x - u).im = if i = 0 then (n : Int) else P.q) → + ∀ (x : GaussianInt), + x ∈ walk → + x ∈ FootprintVertices Rplus → + (x - u).im = if i = 0 then (P.q : Int) else n + ) := by classical - intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hcm hcp hsum n hnpos hnq hCicurv - hnlarge hFord cellobs vm vp hflip hcmcand hcpcand heqm heqp hdelta hnormdelta walk - hwsegment squarefoot hminusheight x hx hxp + intro P Ci i hCi hsmall T T' u hc' hsegment Rminus Rplus hsum n hnpos hnq hCicurv hnlarge + hFord cellobs vm vp hcmcand hcpcand heqm heqp hdelta hnormdelta walk hwsegment squarefoot + hminusheight x hx hxp rw [(cellobs Rplus n hnpos vp heqp).1] at hxp have hxbox := (squarefoot n hnpos vp x).mp hxp have hxseg := hwsegment x hx @@ -1088,8 +1126,7 @@ theorem P4158T1SmallerStringEdges -- BODY classical have hsum : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q - have hqone := SmallerStringGeometry.hqone P Ci i hCi hlarge hsmall T T' u hc' hsegment Rminus - Rplus hcm hcp hsum + have hqone := SmallerStringGeometry.hqone P Ci i hCi hlarge hsmall T T' u hc' hsegment hsum have hrpos := SmallerStringGeometry.hrpos P hsum hqone have hspos := P.q₂_pos let n := if i = 0 then P.q₁ else P.q₂ @@ -1103,7 +1140,7 @@ theorem P4158T1SmallerStringEdges (SmallerStringGeometry.determinantCoprime) have fordcell (m : Nat) (z : GaussianInt) : z ∈ (FordTile m).cells ↔ - 0 ≤ z.re ∧ z.re < m ∧ 0 ≤ z.im ∧ z.im < m := SmallerStringGeometry.fordcell m z + 0 ≤ z.re ∧ z.re < m ∧ 0 ≤ z.im ∧ z.im < m := FordTileCellMembership m z have fordne (m : Nat) (hm : 0 < m) : (FordTile m).cells.Nonempty := ⟨0, (fordcell m 0).mpr (by simp; omega)⟩ have fordcent := SmallerStringGeometry.fordcent fordcell fordne @@ -1155,10 +1192,10 @@ theorem P4158T1SmallerStringEdges walk hwvertices (SmallerStringGeometry.ancestorFoot C0 Ci hC0pos)) have squarefoot := SmallerStringGeometry.squarefoot have hminusheight := SmallerStringGeometry.hminusheight P Ci i hCi hsmall T T' u hc' - hsegment Rminus Rplus hcm hcp hsum hnpos hnq hCicurv hnlarge hFord cellobs hflip hcmcand + hsegment Rminus Rplus hsum hnpos hnq hCicurv hnlarge hFord cellobs hcmcand hcpcand heqm heqp hdelta hnormdelta walk hwsegment squarefoot have hplusheight := SmallerStringGeometry.hplusheight P Ci i hCi hsmall T T' u hc' hsegment - Rminus Rplus hcm hcp hsum hnpos hnq hCicurv hnlarge hFord cellobs hflip hcmcand hcpcand + Rminus Rplus hsum hnpos hnq hCicurv hnlarge hFord cellobs hcmcand hcpcand heqm heqp hdelta hnormdelta walk hwsegment squarefoot hminusheight have crossing := SmallerStringGeometry.crossing have stepPair := SmallerStringGeometry.stepPair u diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean b/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean index 5996185dba..bd11dfb146 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean @@ -1909,16 +1909,7 @@ private theorem haaIm : dsimp at h linarith -private theorem haa : - (by - classical - exact - ∀ (aa : GaussianInt), ((aa.re : Real) = 0) → (((aa.im : Real) = 0) → (aa = 0)) ) := by - classical - intro aa haaRe haaIm - apply Zsqrtd.ext - · exact_mod_cast haaRe - · exact_mod_cast haaIm +private abbrev haa := ApollonianSuperharmonic.NestedCompatibilityGeometry.hshift private theorem boundaryRaw : (by @@ -2385,52 +2376,6 @@ private theorem hxLS3 : rw [hdomS3] exact boundaryRaw _ _ hxLS -private theorem hxLK0 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (k : Fin (3 : ℕ) → Bool → - PartialOdometer), ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (l : Fin (3 : ℕ) → Bool → - PartialOdometer), (((k 0 false).domain : Set GaussianInt) = FootprintVertices (U 0 - false) ∧ ((l 0 true).domain : Set GaussianInt) = FootprintVertices (V 0 true) ∧ ((k 0 - false).domain : Set GaussianInt) = ((l 0 true).domain : Set GaussianInt) ∧ ∃ c : Int, - ∀ x, x ∈ (k 0 false).domain → x ∈ (l 0 true).domain → (l 0 true).value x - (k 0 - false).value x = c) → ((∀ (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ - BoundaryFootprintVertices X) → (x ∈ FootprintVertices X)) → ((FootprintVertices - cert.O = FootprintVertices (U 0 false)) → (∀ (xL : GaussianInt), (xL ∈ - BoundaryFootprintVertices cert.O) → (xL ∈ ((k 0 false).domain : Set GaussianInt))))) - ) := by - classical - intro q cfg C T cert U k V l precursorConstant boundaryRaw oFootU xL hxLO - rw [precursorConstant.1] - rw [← oFootU] - exact boundaryRaw _ _ hxLO - -private theorem hxLL0 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (k : Fin (3 : ℕ) → Bool → - PartialOdometer), ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (l : Fin (3 : ℕ) → Bool → - PartialOdometer), (((k 0 false).domain : Set GaussianInt) = FootprintVertices (U 0 - false) ∧ ((l 0 true).domain : Set GaussianInt) = FootprintVertices (V 0 true) ∧ ((k 0 - false).domain : Set GaussianInt) = ((l 0 true).domain : Set GaussianInt) ∧ ∃ c : Int, - ∀ x, x ∈ (k 0 false).domain → x ∈ (l 0 true).domain → (l 0 true).value x - (k 0 - false).value x = c) → ((∀ (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ - BoundaryFootprintVertices X) → (x ∈ FootprintVertices X)) → ((FootprintVertices - cert.O = FootprintVertices (V 0 true)) → (∀ (xL : GaussianInt), (xL ∈ - BoundaryFootprintVertices cert.O) → (xL ∈ ((l 0 true).domain : Set GaussianInt))))) ) - := by - classical - intro q cfg C T cert U k V l precursorConstant boundaryRaw oFootV xL hxLO - rw [precursorConstant.2.1] - rw [← oFootV] - exact boundaryRaw _ _ hxLO - private theorem hxRK3 : (by classical @@ -2463,52 +2408,6 @@ private theorem hxRS2 : rw [hdomS2] exact boundaryRaw _ _ hxRS -private theorem hxRK0 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (k : Fin (3 : ℕ) → Bool → - PartialOdometer), ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (l : Fin (3 : ℕ) → Bool → - PartialOdometer), (((k 0 false).domain : Set GaussianInt) = FootprintVertices (U 0 - false) ∧ ((l 0 true).domain : Set GaussianInt) = FootprintVertices (V 0 true) ∧ ((k 0 - false).domain : Set GaussianInt) = ((l 0 true).domain : Set GaussianInt) ∧ ∃ c : Int, - ∀ x, x ∈ (k 0 false).domain → x ∈ (l 0 true).domain → (l 0 true).value x - (k 0 - false).value x = c) → ((∀ (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ - BoundaryFootprintVertices X) → (x ∈ FootprintVertices X)) → ((FootprintVertices - cert.O = FootprintVertices (U 0 false)) → (∀ (xR : GaussianInt), (xR ∈ - BoundaryFootprintVertices cert.O) → (xR ∈ ((k 0 false).domain : Set GaussianInt))))) - ) := by - classical - intro q cfg C T cert U k V l precursorConstant boundaryRaw oFootU xR hxRO - rw [precursorConstant.1] - rw [← oFootU] - exact boundaryRaw _ _ hxRO - -private theorem hxRL0 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (U : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (k : Fin (3 : ℕ) → Bool → - PartialOdometer), ∀ (V : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (l : Fin (3 : ℕ) → Bool → - PartialOdometer), (((k 0 false).domain : Set GaussianInt) = FootprintVertices (U 0 - false) ∧ ((l 0 true).domain : Set GaussianInt) = FootprintVertices (V 0 true) ∧ ((k 0 - false).domain : Set GaussianInt) = ((l 0 true).domain : Set GaussianInt) ∧ ∃ c : Int, - ∀ x, x ∈ (k 0 false).domain → x ∈ (l 0 true).domain → (l 0 true).value x - (k 0 - false).value x = c) → ((∀ (X : ProtoTile), ∀ (x : GaussianInt), (x ∈ - BoundaryFootprintVertices X) → (x ∈ FootprintVertices X)) → ((FootprintVertices - cert.O = FootprintVertices (V 0 true)) → (∀ (xR : GaussianInt), (xR ∈ - BoundaryFootprintVertices cert.O) → (xR ∈ ((l 0 true).domain : Set GaussianInt))))) ) - := by - classical - intro q cfg C T cert U k V l precursorConstant boundaryRaw oFootV xR hxRO - rw [precursorConstant.2.1] - rw [← oFootV] - exact boundaryRaw _ _ hxRO - private theorem crossOneConstant : (by classical @@ -2994,16 +2893,20 @@ private theorem nestedCompatibilityConclusion : rcases hxR with ⟨hxRQ, hxRS, hxRO⟩ have hxLK := NestedCompatibilityGeometry.hxLK q cfg C T cert k hdomQ boundaryRaw xL hxLQ have hxLS3 := NestedCompatibilityGeometry.hxLS3 q cfg C T cert l boundaryRaw hdomS3 xL hxLS - have hxLK0 := NestedCompatibilityGeometry.hxLK0 q cfg C T cert U k V l precursorConstant - boundaryRaw oFootU xL hxLO - have hxLL0 := NestedCompatibilityGeometry.hxLL0 q cfg C T cert U k V l precursorConstant - boundaryRaw oFootV xL hxLO + have precursorKMembership (x : GaussianInt) (hx : x ∈ BoundaryFootprintVertices cert.O) : + x ∈ ((k 0 false).domain : Set GaussianInt) := by + rw [precursorConstant.1, ← oFootU] + exact boundaryRaw _ _ hx + have precursorLMembership (x : GaussianInt) (hx : x ∈ BoundaryFootprintVertices cert.O) : + x ∈ ((l 0 true).domain : Set GaussianInt) := by + rw [precursorConstant.2.1, ← oFootV] + exact boundaryRaw _ _ hx + have hxLK0 := precursorKMembership xL hxLO + have hxLL0 := precursorLMembership xL hxLO have hxRK3 := NestedCompatibilityGeometry.hxRK3 q cfg C T cert k boundaryRaw hdomQ3 xR hxRQ have hxRS2 := NestedCompatibilityGeometry.hxRS2 q cfg C T cert l boundaryRaw hdomS2 xR hxRS - have hxRK0 := NestedCompatibilityGeometry.hxRK0 q cfg C T cert U k V l precursorConstant - boundaryRaw oFootU xR hxRO - have hxRL0 := NestedCompatibilityGeometry.hxRL0 q cfg C T cert U k V l precursorConstant - boundaryRaw oFootV xR hxRO + have hxRK0 := precursorKMembership xR hxRO + have hxRL0 := precursorLMembership xR hxRO have crossOneConstant := NestedCompatibilityGeometry.crossOneConstant k l compatCross1 xL hxLK hxLS3 have crossTwoConstant := NestedCompatibilityGeometry.crossTwoConstant k l compatCross2 xR hxRK3 diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean b/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean index 4d9c4b1f76..55a8b17640 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.RightSubtileOdometerCompatibility @@ -1328,20 +1329,7 @@ private theorem hraw : intro q cfg C T cert a b hab exact (BandOriginalOccurrenceIntersectionClassification q cfg C T cert a b hab).2 -private theorem htransZero : - (by - classical - exact - ∀ (Z : ProtoTile), TileTranslation Z 0 = Z ) := by - classical - intro Z - cases Z with - | mk cells anchor => - change ProtoTile.mk (cells.image (fun x => x + 0)) (GaussianTranslation 0 anchor) = - ProtoTile.mk cells anchor - apply congrArg₂ ProtoTile.mk - · simp [] - · simp [GaussianTranslation] +private abbrev htransZero := ApollonianSuperharmonic.TileTranslationProperties.zero private theorem noAE : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean index 47f9fe1889..828d042ec7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean @@ -355,13 +355,22 @@ private theorem edge_vertices : (by classical exact - ∀ (E : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : - GaussianInt), (p.head? = some x) → ((p.getLast? = some y) → ((FourNeighborAdjacent y - x) → ((∀ (e : Finset GaussianInt), e ∈ E ↔ e = {y, x} ∨ ∃ (a : GaussianInt) (b : - GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ - ∧ e = {a, b}) → (∀ e ∈ E, ∀ z ∈ e, z ∈ p)))) ) := by + ∀ (E : Set (Finset GaussianInt)), + ∀ (p : List GaussianInt), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + p.head? = some x → + p.getLast? = some y → + (∀ (e : Finset GaussianInt), + e ∈ E ↔ + e = { y, x } ∨ + ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) + (l₂ : List GaussianInt), + p = l₁ ++ a :: b :: l₂ ∧ e = { a, b }) → + ∀ e ∈ E, ∀ z ∈ e, z ∈ p + ) := by classical - intro E p x y hpHead hpLast hclose hpEdges e he z hz + intro E p x y hpHead hpLast hpEdges e he z hz rcases (hpEdges e).mp he with rfl | ⟨a, b, l₁, l₂, hd, rfl⟩ · simp only [Finset.mem_insert, Finset.mem_singleton] at hz rcases hz with rfl | rfl @@ -498,16 +507,27 @@ private theorem es_edge : (by classical exact - ∀ (E : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (x : GaussianInt), ∀ (y : - GaussianInt), (p.head? = some x) → ((p.getLast? = some y) → ((FourNeighborAdjacent y - x) → ((∀ (e : Finset GaussianInt), e ∈ E ↔ e = {y, x} ∨ ∃ (a : GaussianInt) (b : - GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ - ∧ e = {a, b}) → ((∀ (r : List GaussianInt), ∀ a, ∀ b, (a, b) ∈ r.zip r.tail → ∃ l₁ - l₂, r = l₁ ++ a :: b :: l₂) → ( - let es := (p.zip p.tail) ++ [(y, x)] - ∀ a, ∀ b, (a, b) ∈ es → ({a, b} : Finset GaussianInt) ∈ E))))) ) := by + ∀ (E : Set (Finset GaussianInt)), + ∀ (p : List GaussianInt), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + p.head? = some x → + p.getLast? = some y → + (∀ (e : Finset GaussianInt), + e ∈ E ↔ + e = { y, x } ∨ + ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) + (l₂ : List GaussianInt), + p = l₁ ++ a :: b :: l₂ ∧ e = { a, b }) → + (∀ (r : List GaussianInt), + ∀ a, + ∀ b, + (a, b) ∈ r.zip r.tail → ∃ l₁ l₂, r = l₁ ++ a :: b :: l₂) → + let es := p.zip p.tail ++ [(y, x)] + ∀ a, ∀ b, (a, b) ∈ es → ({ a, b } : Finset GaussianInt) ∈ E + ) := by classical - intro E p x y hpHead hpLast hclose hpEdges zip_decomp es a b hab + intro E p x y hpHead hpLast hpEdges zip_decomp es a b hab simp only [es, List.mem_append, List.mem_singleton, Prod.mk.injEq] at hab apply (hpEdges _).mpr rcases hab with hab | ⟨rfl, rfl⟩ @@ -729,43 +749,100 @@ private theorem cycle_segments : (by classical exact - ∀ (T : ProtoTile), ∀ (E : Set (Finset GaussianInt)), ∀ (p : List GaussianInt), ∀ (x : - GaussianInt), ∀ (y : GaussianInt), (p.head? = some x) → ((p.getLast? = some y) → - ((FourNeighborAdjacent y x) → ((∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : - List GaussianInt), ∀ (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ → - FourNeighborAdjacent a b) → ((∀ (e : Finset GaussianInt), e ∈ E ↔ e = {y, x} ∨ ∃ (a : - GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = - l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → ((∀ z ∈ p, z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - ⟨0, - 1⟩ ∈ T.cells ∧ z - 1 - ⟨0, 1⟩ ∈ T.cells) → ( - let es := (p.zip p.tail) ++ [(y, x)] - (∀ a, ∀ b, (a, b) ∈ es → ({a, b} : Finset GaussianInt) ∈ E) → (( - let cyclicEdges := p.zip p.tail ++ [(y, x)]; ∀ (q : LatticeCell), ((q + (1 : - LatticeCell), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ - cyclicEdges ∧ (q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (1 : - LatticeCell)) ∉ cyclicEdges → GridRayCrossingIndex (q + (1 : LatticeCell)) p = - GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell), q + (1 : LatticeCell) + (⟨(0 : - ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt), q + (1 : LatticeCell)) ∈ cyclicEdges → (GridRayCrossingIndex (q + - (1 : LatticeCell)) p - GridRayCrossingIndex q p).natAbs = (1 : ℕ)) ∧ ((q + (1 : - LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt)) ∉ cyclicEdges ∧ (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), q + (1 : - LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ cyclicEdges → - GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p = - GridRayCrossingIndex q p) ∧ ((q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt), q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ cyclicEdges ∨ (q + (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt), q + (1 : LatticeCell) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) - ∈ cyclicEdges → (GridRayCrossingIndex (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p - - GridRayCrossingIndex q p).natAbs = (1 : ℕ))) → ((∀ (U : ProtoTile), ∀ (a : - GaussianInt), ∀ (b : GaussianInt), (a ∈ U.cells) → ((b ∈ U.cells) → - ((FourNeighborAdjacent a b) → (∀ t : Set.Icc (0 : Real) 1, ((1 - (t : Real)) * (a.re - : Real) + (t : Real) * (b.re : Real), (1 - (t : Real)) * (a.im : Real) + (t : Real) * - (b.im : Real)) ∈ TileRealization U)))) → (∀ a b : GaussianInt, ((∃ l₁ l₂ : List - GaussianInt, p = l₁ ++ a :: b :: l₂) ∨ (a = y ∧ b = x)) → ∀ t : Set.Icc (0 : Real) 1, - ((1 - (t : Real)) * (a.re : Real) + (t : Real) * (b.re : Real), (1 - (t : Real)) * - (a.im : Real) + (t : Real) * (b.im : Real)) ∈ TileRealization T))))))))) ) := by + ∀ (T : ProtoTile), + ∀ (E : Set (Finset GaussianInt)), + ∀ (p : List GaussianInt), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + p.head? = some x → + p.getLast? = some y → + FourNeighborAdjacent y x → + (∀ (a : GaussianInt), + ∀ (b : GaussianInt), + ∀ (l₁ : List GaussianInt), + ∀ (l₂ : List GaussianInt), + p = l₁ ++ a :: b :: l₂ → FourNeighborAdjacent a b) → + (∀ (e : Finset GaussianInt), + e ∈ E ↔ + e = { y, x } ∨ + ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : + List GaussianInt) (l₂ : List GaussianInt), + p = l₁ ++ a :: b :: l₂ ∧ e = { a, b }) → + (∀ z ∈ p, + z ∈ T.cells ∧ + z - 1 ∈ T.cells ∧ + z - ⟨0, 1⟩ ∈ T.cells ∧ z - 1 - ⟨0, 1⟩ ∈ T.cells) → + (let cyclicEdges := p.zip p.tail ++ [(y, x)]; + ∀ (q : LatticeCell), + ((q + (1 : LatticeCell), + q + (1 : LatticeCell) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ + cyclicEdges ∧ + (q + (1 : LatticeCell) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), + q + (1 : LatticeCell)) ∉ + cyclicEdges → + GridRayCrossingIndex (q + (1 : LatticeCell)) p = + GridRayCrossingIndex q p) ∧ + ((q + (1 : LatticeCell), + q + (1 : LatticeCell) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ + cyclicEdges ∨ + (q + (1 : LatticeCell) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), + q + (1 : LatticeCell)) ∈ + cyclicEdges → + (GridRayCrossingIndex (q + (1 : LatticeCell)) p - + GridRayCrossingIndex q p).natAbs = + (1 : ℕ)) ∧ + ((q + (1 : LatticeCell) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), + q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ + cyclicEdges ∧ + (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), + q + (1 : LatticeCell) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∉ + cyclicEdges → + GridRayCrossingIndex + (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p = + GridRayCrossingIndex q p) ∧ + ((q + (1 : LatticeCell) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), + q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ + cyclicEdges ∨ + (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), + q + (1 : LatticeCell) + + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∈ + cyclicEdges → + (GridRayCrossingIndex + (q + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) p - + GridRayCrossingIndex q p).natAbs = + (1 : ℕ))) → + (∀ (U : ProtoTile), + ∀ (a : GaussianInt), + ∀ (b : GaussianInt), + a ∈ U.cells → + b ∈ U.cells → + FourNeighborAdjacent a b → + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * (a.re : Real) + + (t : Real) * (b.re : Real), + (1 - (t : Real)) * (a.im : Real) + + (t : Real) * (b.im : Real)) ∈ + TileRealization U) → + ∀ a b : GaussianInt, + (∃ l₁ l₂ : List GaussianInt, p = l₁ ++ a :: b :: l₂) ∨ + a = y ∧ b = x → + ∀ t : Set.Icc (0 : Real) 1, + ((1 - (t : Real)) * (a.re : Real) + + (t : Real) * (b.re : Real), + (1 - (t : Real)) * (a.im : Real) + + (t : Real) * (b.im : Real)) ∈ + TileRealization T + ) := by classical - intro T E p x y hpHead hpLast hclose hpAdjacent hpEdges hpCells es es_edge index_control - unit_segment a b hab + intro T E p x y hpHead hpLast hclose hpAdjacent hpEdges hpCells index_control unit_segment a b + hab rcases hab with ⟨l₁, l₂, hd⟩ | ⟨rfl, rfl⟩ · have ha : a ∈ p := by rw [hd]; simp have hb : b ∈ p := by rw [hd]; simp @@ -1245,12 +1322,12 @@ theorem P4250T2InterfaceCycleExclusion (InterfaceCycleGeometry.hpNotP D P p hpInDifference) have hTne : T.cells.Nonempty := (LatticeTileGridStructure T hlat).1.1 -- Absence of a boundary edge forces all four incident cells to be present. - have edge_vertices := InterfaceCycleGeometry.edge_vertices E p x y hpHead hpLast hclose hpEdges + have edge_vertices := InterfaceCycleGeometry.edge_vertices E p x y hpHead hpLast hpEdges have parent_regular := InterfaceCycleGeometry.parent_regular C q cfg T cert -- A cycle side cannot lie between two cells of one parent. have zip_decomp := InterfaceCycleGeometry.zip_decomp let es := (p.zip p.tail) ++ [(y, x)] - have es_edge := InterfaceCycleGeometry.es_edge E p x y hpHead hpLast hclose hpEdges zip_decomp + have es_edge := InterfaceCycleGeometry.es_edge E p x y hpHead hpLast hpEdges zip_decomp have index_control := GridRayCrossingIndexAdjacentCell p x y hpHead hpLast hpNodup (by omega) (InterfaceCycleGeometry.hzipAdjacent p hpAdjacent zip_decomp) hclose have index_horizontal := InterfaceCycleGeometry.index_horizontal E p x y es_edge index_control @@ -1258,7 +1335,7 @@ theorem P4250T2InterfaceCycleExclusion have outside_zero := InterfaceCycleGeometry.outside_zero T hlat p x y hpHead hpLast hclose hpAdjacent (InterfaceCycleGeometry.cycle_segments T E p x y hpHead hpLast hclose hpAdjacent hpEdges (InterfaceCycleGeometry.hpCells T p hpInteriorT hTne - (InterfaceCycleGeometry.vertex_cells)) es_edge index_control + (InterfaceCycleGeometry.vertex_cells)) index_control (InterfaceCycleGeometry.unit_segment)) (InterfaceCycleGeometry.unoccupied_center_outside T) have horizontal_vertical_ne := InterfaceCycleGeometry.horizontal_vertical_ne -- The common outer side anchors the index throughout each parent. diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean index 5c507420b4..347ea2fbc5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorStarClassification @@ -920,16 +921,7 @@ private theorem hk23 : have hk4 := hclass.2.2.1 omega -private theorem hzeroAt680 : - (by - classical - exact - ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by - classical - intro U - have hz : GaussianTranslation 0 = id := by funext z; simp [GaussianTranslation] - cases U - simp [TileTranslation, hz, GaussianTranslation] +private abbrev hzeroAt680 := ApollonianSuperharmonic.TileTranslationProperties.zero private theorem hcoverAt684 : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean index d0deb210db..b92d102213 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandLayoutParentNonempty public import LeanPool.ApollonianSuperharmonic.P4261T1PlacedOdometer public import LeanPool.ApollonianSuperharmonic.P4261T1ExteriorIndices @@ -32,61 +33,6 @@ namespace ApollonianSuperharmonic namespace SubtileCoordinateGeometry -private theorem hsuper : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), - let edge : Fin 3 → GaussianInt := fun k => - BandVectors.1 (q ((k + 2).succ)) (q ((k + 1).succ)) - (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 - : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : - ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) - + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : - Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin - (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 - : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q - (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = - BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ - (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q - j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin - (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → (edge 0 + edge 1 + - edge 2 = 0) ) := by - classical - intro q edge hvlaws - dsimp [edge] - linear_combination hvlaws.1 - -private theorem hflip : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ( - let incoming : Fin 3 → GaussianInt := fun k => - BandVectors.1 (q k.succ) (q 0) - let outgoing : Fin 3 → GaussianInt := fun k => - BandVectors.1 (q 0) (q k.succ) - (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 - : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : - ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) - + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : - Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin - (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 - : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q - (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = - BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ - (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q - j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin - (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → (∀ k, outgoing k = - (⟨0, 1⟩ : GaussianInt) * incoming k)) ) := by - classical - intro q cfg incoming outgoing hvlaws k - simpa [outgoing, incoming] using (hvlaws.2.2.2.2 cfg.proper k).1 - private theorem hu : (by classical @@ -375,22 +321,7 @@ private theorem hsuppliedCentroid : TileCentroid T₀) + TileCentroid T₀ := by rw [hcent', hrowCentroid] _ = TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) := by abel -private theorem hparentNonempty : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T₀), ∀ k, ∀ e, (cert.P k e).cells.Nonempty ) := by - classical - intro q cfg C₀ T₀ cert k e - rcases cert.parent_lattice k e with ⟨realization⟩ - have hball : (0 : ℝ × ℝ) ∈ Metric.closedBall (0 : ℝ × ℝ) 1 := by simp - have hreal : (realization ⟨0, hball⟩ : ℝ × ℝ) ∈ TileRealization (cert.P k e) := - (realization ⟨0, hball⟩).property - simp only [TileRealization, Set.mem_iUnion] at hreal - rcases hreal with ⟨x, hx, _⟩ - exact ⟨x, hx⟩ +private abbrev hparentNonempty := ApollonianSuperharmonic.BandLayoutParentNonempty.cells private theorem hbandOcc : (by @@ -634,365 +565,6 @@ private theorem hcircle : rw [hslot.1] exact hqi.symm.trans hparent -private theorem hA13 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (BandVectors.1 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : - ℕ))) + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.1 (q - (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (q (3 : - Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin - (4 : ℕ))) + BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : - GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = - BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ - BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.2 (q (1 : Fin - (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 - (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple q → ∀ (j : Fin (3 - : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (q (0 : - Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (q - j.succ) (q (0 : Fin (4 : ℕ))))) → ( - let A : GaussianInt := BandVectors.2 (q 2) (q 1) - let B : GaussianInt := BandVectors.2 (q 3) (q 2) - BandVectors.2 (q 1) (q 3) = -A - B) ) := by - classical - intro q hvlaws A B - dsimp [A, B] - linear_combination hvlaws.2.1 - -private theorem hA01 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((BandVectors.1 - (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q - (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : - GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + - BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : Fin - (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : - ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : - ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 - : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = - BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ - (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q - j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin - (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → ( - let I : GaussianInt := ⟨0, 1⟩ - let A : GaussianInt := BandVectors.2 (q 2) (q 1) - let B : GaussianInt := BandVectors.2 (q 3) (q 2) - (BandVectors.2 (q 1) (q 3) = -A - B) → (BandVectors.2 (q 0) (q 1) = A + I * (A + B)))) ) - := by - classical - intro q cfg hvlaws I A B hA13 - have hin := hvlaws.2.2.2.1 - have hf := (hvlaws.2.2.2.2 cfg.proper 0).2 - calc - BandVectors.2 (q 0) (q 1) = - -(⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 1) (q 0) := hf - _ = -(⟨0, 1⟩ : GaussianInt) * - (BandVectors.2 (q 1) (q 3) + (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 2) (q 1)) := - by rw [hin] - _ = A + I * (A + B) := by rw [hA13]; dsimp [I, A, B]; ext <;> simp <;> ring - -private theorem hA02 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((BandVectors.1 - (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q - (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : - GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + - BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : Fin - (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : - ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : - ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 - : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = - BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ - (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q - j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin - (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → ((BandVectors.1 - (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (3 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 (![q (0 : Fin (4 : ℕ)), - q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) - (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (3 : Fin (4 : ℕ))) + BandVectors.1 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), - q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), - q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ BandVectors.2 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : - Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : - Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + - BandVectors.2 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 - : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 - : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) + BandVectors.2 (![q (0 : Fin - (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 - : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin - (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : - ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 - : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : - ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (![q (0 : Fin (4 : ℕ)), q - (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![q - (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 - : Fin (4 : ℕ))) ∧ BandVectors.2 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : - Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : - Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = - BandVectors.2 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 - : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 - : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin - (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : Fin - (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ - (ProperBandQuadruple ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), - q (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (![q (0 : Fin (4 : ℕ)), q - (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![q - (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] - j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (![q (0 : Fin (4 : ℕ)), - q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] j.succ) (![q (0 : Fin - (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 - : ℕ))) ∧ BandVectors.2 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin - (4 : ℕ)), q (1 : Fin (4 : ℕ))] j.succ) (![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q - (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → ( - let I : GaussianInt := ⟨0, 1⟩ - let A : GaussianInt := BandVectors.2 (q 2) (q 1) - let B : GaussianInt := BandVectors.2 (q 3) (q 2) - BandVectors.2 (q 0) (q 2) = B - I * A))) ) := by - classical - intro q cfg hvlaws hvlaws₂ I A B - have hin := hvlaws₂.2.2.2.1 - have hf := (hvlaws.2.2.2.2 cfg.proper 1).2 - have hin' : BandVectors.2 (q 2) (q 0) = A + I * B := by - simpa [A, B] using hin - calc - BandVectors.2 (q 0) (q 2) = - -(⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 2) (q 0) := hf - _ = -(⟨0, 1⟩ : GaussianInt) * (A + I * B) := by rw [hin'] - _ = B - I * A := by dsimp [I]; ext <;> simp <;> ring - -private theorem hA03 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((BandVectors.1 - (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q - (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : - GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + - BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : Fin - (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : - ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : - ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 - : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = - BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ - (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q - j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin - (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → ((BandVectors.1 - (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : - ℕ))] (3 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 - : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : - ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 (![![q (0 : Fin (4 : ℕ)), - q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q - (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 - : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 - : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : - Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![![q (0 : - Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin - (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin - (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin - (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin - (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (3 : Fin (4 : - ℕ))) + BandVectors.1 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : - ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : - ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.2 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q - (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q - (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q - (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q - (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 - : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q - (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q - (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q - (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 - : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 - : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 (![![q (0 : Fin - (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 - : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 - : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) - (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : - ℕ))] (3 : Fin (4 : ℕ))) + BandVectors.2 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : - ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : - ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) - = (0 : GaussianInt) ∧ BandVectors.1 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q - (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q - (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q - (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 - : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 - : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : ℕ)), q (2 - : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : - Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin - (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin - (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin - (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 - (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : - ℕ))] (1 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 - : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : - ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * - BandVectors.1 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q - (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q - (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q - (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q - (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 - : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q - (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q - (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q - (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 - : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 - : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (![![q (0 : Fin - (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 - : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 - : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) - (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : - ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : - ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : - ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.2 (![![q (0 : Fin (4 : ℕ)), q (2 : - Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : - Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin - (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin - (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin - (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![![q (0 : Fin - (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 - : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 - : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) - ∧ (ProperBandQuadruple ![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : - ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (![![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : - ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) - (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : - ℕ))] j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (![![q (0 : Fin (4 - : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : - ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] j.succ) (![![q (0 : - Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin - (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin - (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin - (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin - (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (0 : Fin (4 : - ℕ))) ∧ BandVectors.2 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin (4 : - ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : - ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : - ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : - ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : - ℕ))] (3 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : - ℕ)), q (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : - Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : - Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q (0 : - Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin - (4 : ℕ))] (1 : Fin (4 : ℕ))] j.succ) (![![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q - (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q - (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ)), ![q - (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] (3 - : Fin (4 : ℕ)), ![q (0 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 - : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → ( - let I : GaussianInt := ⟨0, 1⟩ - let A : GaussianInt := BandVectors.2 (q 2) (q 1) - let B : GaussianInt := BandVectors.2 (q 3) (q 2) - (BandVectors.2 (q 1) (q 3) = -A - B) → (BandVectors.2 (q 0) (q 3) = -A - B - I * B)))) ) - := by - classical - intro q cfg hvlaws hvlaws₃ I A B hA13 - have hin := hvlaws₃.2.2.2.1 - have hf := (hvlaws.2.2.2.2 cfg.proper 2).2 - have hin' : BandVectors.2 (q 3) (q 0) = B + I * (-A - B) := by - simpa [A, B, hA13, add_comm, add_left_comm, add_assoc] using hin - calc - BandVectors.2 (q 0) (q 3) = - -(⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 3) (q 0) := hf - _ = -(⟨0, 1⟩ : GaussianInt) * (B + I * (-A - B)) := by rw [hin'] - _ = -A - B - I * B := by dsimp [I]; ext <;> simp <;> ring - private theorem hAedgeAux : (by classical @@ -1065,34 +637,6 @@ private theorem hrowPointAux : P4250T1SlopeOffset, -GaussianInt.intCast_re, -GaussianInt.intCast_im] <;> ring_nf <;> trivial -private theorem hflipAffine : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (BandOrderedGeneralConfiguration q) → ((BandVectors.1 - (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q - (3 : Fin (4 : ℕ))) + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : - GaussianInt) ∧ BandVectors.2 (q (3 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))) + - BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + BandVectors.2 (q (2 : Fin - (4 : ℕ))) (q (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (q (1 : Fin (4 : - ℕ))) (q (0 : Fin (4 : ℕ))) = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : - ℕ))) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (1 - : Fin (4 : ℕ))) ∧ BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) = - BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (3 : Fin (4 : ℕ))) + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))) ∧ - (ProperBandQuadruple q → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (q (0 : Fin (4 : ℕ))) (q - j.succ) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 (q j.succ) (q (0 : Fin - (4 : ℕ))) ∧ BandVectors.2 (q (0 : Fin (4 : ℕ))) (q j.succ) = -(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.2 (q j.succ) (q (0 : Fin (4 : ℕ))))) → ( - let I : GaussianInt := ⟨0, 1⟩ - ∀ k : Fin 3, BandVectors.2 (q k.succ) (q 0) = I * BandVectors.2 (q 0) (q k.succ))) ) := by - classical - intro q cfg hvlaws I k - have hf := (hvlaws.2.2.2.2 cfg.proper k).2 - rw [hf] - dsimp [I] - ext <;> simp - private theorem hslopePair : (by classical @@ -1188,14 +732,17 @@ theorem P4261T1SubtileCoordinates have hvlaws₂ := VectorRecursionLaws _ (SemiProperQuadruple.rotate cfg.proper.1) have hvlaws₃ := VectorRecursionLaws _ (SemiProperQuadruple.rotate (SemiProperQuadruple.rotate cfg.proper.1)) - have hsuper := SubtileCoordinateGeometry.hsuper q hvlaws + have hsuper : edge 0 + edge 1 + edge 2 = 0 := by + dsimp [edge] + linear_combination hvlaws.1 have hin0 : incoming 0 = edge 1 - (⟨0, 1⟩ : GaussianInt) * edge 2 := by simpa [incoming, edge] using hvlaws.2.2.1 have hin1 : incoming 1 = edge 2 - (⟨0, 1⟩ : GaussianInt) * edge 0 := by simpa [incoming, edge] using hvlaws₂.2.2.1 have hin2 : incoming 2 = edge 0 - (⟨0, 1⟩ : GaussianInt) * edge 1 := by simpa [incoming, edge] using hvlaws₃.2.2.1 - have hflip := SubtileCoordinateGeometry.hflip q cfg hvlaws + have hflip (k : Fin 3) : outgoing k = (⟨0, 1⟩ : GaussianInt) * incoming k := by + simpa [outgoing, incoming] using (hvlaws.2.2.2.2 cfg.proper k).1 have hu := SubtileCoordinateGeometry.hu q cfg C₀ T₀ cert have hv := SubtileCoordinateGeometry.hv q cfg C₀ T₀ cert have hcentroidRows := SubtileCoordinateGeometry.hcentroidRows q cfg C₀ T₀ cert @@ -1247,10 +794,39 @@ theorem P4261T1SubtileCoordinates let I : GaussianInt := ⟨0, 1⟩ let A : GaussianInt := BandVectors.2 (q 2) (q 1) let B : GaussianInt := BandVectors.2 (q 3) (q 2) - have hA13 := SubtileCoordinateGeometry.hA13 q hvlaws - have hA01 := SubtileCoordinateGeometry.hA01 q cfg hvlaws hA13 - have hA02 := SubtileCoordinateGeometry.hA02 q cfg hvlaws hvlaws₂ - have hA03 := SubtileCoordinateGeometry.hA03 q cfg hvlaws hvlaws₃ hA13 + have hA13 : BandVectors.2 (q 1) (q 3) = -A - B := by + dsimp [A, B] + linear_combination hvlaws.2.1 + have hA01 : BandVectors.2 (q 0) (q 1) = A + I * (A + B) := by + have hin := hvlaws.2.2.2.1 + have hf := (hvlaws.2.2.2.2 cfg.proper 0).2 + calc + BandVectors.2 (q 0) (q 1) = + -(⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 1) (q 0) := hf + _ = -(⟨0, 1⟩ : GaussianInt) * + (BandVectors.2 (q 1) (q 3) + (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 2) (q 1)) := + by rw [hin] + _ = A + I * (A + B) := by rw [hA13]; dsimp [I, A, B]; ext <;> simp <;> ring + have hA02 : BandVectors.2 (q 0) (q 2) = B - I * A := by + have hin := hvlaws₂.2.2.2.1 + have hf := (hvlaws.2.2.2.2 cfg.proper 1).2 + have hin' : BandVectors.2 (q 2) (q 0) = A + I * B := by + simpa [A, B] using hin + calc + BandVectors.2 (q 0) (q 2) = + -(⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 2) (q 0) := hf + _ = -(⟨0, 1⟩ : GaussianInt) * (A + I * B) := by rw [hin'] + _ = B - I * A := by dsimp [I]; ext <;> simp <;> ring + have hA03 : BandVectors.2 (q 0) (q 3) = -A - B - I * B := by + have hin := hvlaws₃.2.2.2.1 + have hf := (hvlaws.2.2.2.2 cfg.proper 2).2 + have hin' : BandVectors.2 (q 3) (q 0) = B + I * (-A - B) := by + simpa [A, B, hA13, add_comm, add_left_comm, add_assoc] using hin + calc + BandVectors.2 (q 0) (q 3) = + -(⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 3) (q 0) := hf + _ = -(⟨0, 1⟩ : GaussianInt) * (B + I * (-A - B)) := by rw [hin'] + _ = -A - B - I * B := by dsimp [I]; ext <;> simp <;> ring have hAedgeAux := SubtileCoordinateGeometry.hAedgeAux q hA13 have hAroot := SubtileCoordinateGeometry.hAroot q hA01 hA02 hA03 have hrowPointAux := SubtileCoordinateGeometry.hrowPointAux q hA01 hA02 hAedgeAux hAroot @@ -1259,7 +835,11 @@ theorem P4261T1SubtileCoordinates hrootSlope, hfunctionSlope, ?_⟩ have hflipAffine : ∀ k : Fin 3, BandVectors.2 (q k.succ) (q 0) = - I * BandVectors.2 (q 0) (q k.succ) := SubtileCoordinateGeometry.hflipAffine q cfg hvlaws + I * BandVectors.2 (q 0) (q k.succ) := by + intro k + rw [(hvlaws.2.2.2.2 cfg.proper k).2] + dsimp [I] + ext <;> simp have hs1 := by simpa [hparent, hq₀, cert.child_eq.symm, hflipAffine j] using hslope₁ have hs2 := by diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean index 8b1449f8bb..1b07290c2a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean @@ -583,20 +583,7 @@ private theorem hpform : canonicalSlope] rfl -private theorem hrform : - (by - classical - exact - ∀ (k : PartialOdometer), ∀ (z : GaussianInt), ∀ (v : LatticeCell), ∀ (a' : GaussianInt), - ∀ (b' : ℤ), (k = PartialOdometerAffineTranslate (CurvatureOneOdometer z) v a' b') → - ((∀ (w : GaussianInt), PartialOdometerSlope (CurvatureOneOdometer w) = some (((w.im : - ℝ) / 2), ((w.im : ℝ) / 2))) → (PartialOdometerSlope k = some ((z.im : ℝ) / 2 + a'.re, - (z.im : ℝ) / 2 + a'.im))) ) := by - classical - intro k z v a' b' hkeq canonicalSlope - rw [hkeq, (PartialOdometerAffineTranslateFormulas _ v a' b').2.2.2.2.2, - canonicalSlope] - rfl +private abbrev hrform := ApollonianSuperharmonic.UnitBoundaryDetails.hpform private theorem hmatrix : (by @@ -747,17 +734,7 @@ private theorem hdomSq : ext y simp [hdu, FootprintVertices, hTu] -private theorem kdomSq : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (k : PartialOdometer), ∀ (v : LatticeCell), (U.cells = {v}) → - (((↑k.domain : Set GaussianInt) = FootprintVertices U) → ((k.domain : Set - GaussianInt) = {v, v + 1, v + ⟨0, 1⟩, v + 1 + ⟨0, 1⟩})) ) := by - classical - intro U k v hUv hdu' - ext y - simp [hdu', FootprintVertices, hUv] +private abbrev kdomSq := ApollonianSuperharmonic.UnitBoundaryDetails.hdomSq private theorem hval : (by @@ -772,18 +749,7 @@ private theorem hval : rw [hheq] at hy ⊢ exact (PartialOdometerAffineTranslateFormulas _ u a b).2.2.1 y hy -private theorem kval : - (by - classical - exact - ∀ (k : PartialOdometer), ∀ (z : GaussianInt), ∀ (v : LatticeCell), ∀ (a' : GaussianInt), - ∀ (b' : ℤ), (k = PartialOdometerAffineTranslate (CurvatureOneOdometer z) v a' b') → - (∀ y ∈ k.domain, k.value y = (CurvatureOneOdometer z).value (y - v) + a'.re * y.re + - a'.im * y.im + b') ) := by - classical - intro k z v a' b' hkeq y hy - rw [hkeq] at hy ⊢ - exact (PartialOdometerAffineTranslateFormulas _ v a' b').2.2.1 y hy +private abbrev kval := ApollonianSuperharmonic.UnitBoundaryDetails.hval private theorem hcoefAt798 : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean index e5d96616b2..64c3720d03 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.P4261T2LiteralInterface public import LeanPool.ApollonianSuperharmonic.OpposingBoundaryOdometerStrings @@ -158,20 +159,7 @@ private theorem hnormBig : have hn := GaussianInt.norm_nonneg w nlinarith [hnormSq, sq_nonneg (Zsqrtd.norm w - 5)] -private theorem hrealPointInj : - (by - classical - exact - Function.Injective GaussianRealPoint ) := by - classical - intro x y hxy - apply Zsqrtd.ext - · have hr := congrArg Prod.fst hxy - change ((x.re : Int) : Real) = ((y.re : Int) : Real) at hr - exact_mod_cast hr - · have hi := congrArg Prod.snd hxy - change ((x.im : Int) : Real) = ((y.im : Int) : Real) at hi - exact_mod_cast hi +private abbrev hrealPointInj := ApollonianSuperharmonic.GaussianRealPointProperties.injective private theorem hRminusNeRplus : (by @@ -854,9 +842,8 @@ private theorem hwalkStart : classical exact ∀ (T : ProtoTile), ∀ (U : ProtoTile), ∀ (centerShift : GaussianInt), ∀ (Rminus : - ProtoTile), ∀ (Rplus : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (reverseTiles : List - ProtoTile), - let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift + ProtoTile), ∀ (Rplus : ProtoTile), + let F : ProtoTile → ProtoTile := fun X => TileTranslation (TileHalfTurn X) centerShift; ∀ (Eimage : ExactTileInterfaceTriple (F T) (F U) (F Rplus)), ∀ (hvFT : FootprintVertices (F T) = FootprintVertices U), ∀ (hvFU : FootprintVertices (F U) = FootprintVertices T), ∀ (hvFR : FootprintVertices (F Rplus) = FootprintVertices Rminus), ∀ (heFT : @@ -872,24 +859,18 @@ private theorem hwalkStart : pathCA := by simpa [hvFR, hvFT, heFR, heFT] using Eimage.pathCA unique_common := by intro z - simpa [hvFT, hvFU, hvFR] using Eimage.unique_common z } + simpa [hvFT, hvFU, hvFR] using Eimage.unique_common z }; ∀ (walk : List GaussianInt), (∃ (x : GaussianInt), walk.head? = some x ∧ x ∈ - FootprintVertices Rminus) → ((∃ (y : GaussianInt), walk.getLast? = some y ∧ y ∈ - FootprintVertices Rplus) → ((List.IsChain (fun (x y : GaussianInt) => y = x + (1 : - GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) walk) → ((∀ x ∈ walk, (∃ a ∈ (List.drop - (1 : ℕ) tiles).dropLast, x ∈ FootprintVertices a) ∧ ∃ b ∈ (List.drop (1 : ℕ) - reverseTiles).dropLast, x ∈ FootprintVertices b) → ((∀ (x : GaussianInt), ∀ (y : - GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), walk = l₁ ++ x :: - y :: l₂ → (∃ a ∈ (List.drop (1 : ℕ) tiles).dropLast, {x, y} ∈ FootprintEdges a) ∧ ∃ b - ∈ (List.drop (1 : ℕ) reverseTiles).dropLast, {x, y} ∈ FootprintEdges b) → ((∀ x, x ∈ - walk → x ∈ FootprintVertices T ∩ FootprintVertices U) → ((∀ x y : GaussianInt, ∀ pre - post : List GaussianInt, walk = pre ++ x :: y :: post → {x, y} ∈ FootprintEdges T ∩ - FootprintEdges U) → (∃ z, walk.head? = some z ∧ z = Enegative.point))))))) ) := by + FootprintVertices Rminus) → ( + ( + ( + ( + ((∀ x, x ∈ + walk → x ∈ FootprintVertices T ∩ FootprintVertices U) → ( + (∃ z, walk.head? = some z ∧ z = Enegative.point))))))) ) := by classical - intro T U centerShift Rminus Rplus tiles reverseTiles F Eimage hvFT hvFU hvFR heFT heFU heFR - Enegative walk hwalkHead hwalkLast hwalkChain hwalkVertices hwalkEdges hwalkInOuter - hwalkOuterEdges + intro T U centerShift Rminus Rplus F Eimage hvFT hvFU hvFR heFT heFU heFR Enegative walk + hwalkHead hwalkInOuter obtain ⟨z, hzhead, hzR⟩ := hwalkHead have hmem : z ∈ walk := by cases walk with @@ -1342,9 +1323,8 @@ theorem P4261T2UnitInterface have hwalkOuterEdges := UnitInterfaceGeometry.hwalkOuterEdges C D T U h k tiles reverseTiles functions reverseFunctions hrestrictionsForward hrestrictionsBackward walk hwalkEdges (UnitInterfaceGeometry.edgeAncestor C D) - have hwalkStart := UnitInterfaceGeometry.hwalkStart T U centerShift Rminus Rplus tiles - reverseTiles Eimage hvFT hvFU hvFR heFT heFU heFR walk hwalkHead hwalkLast hwalkChain - hwalkVertices hwalkEdges hwalkInOuter hwalkOuterEdges + have hwalkStart := UnitInterfaceGeometry.hwalkStart T U centerShift Rminus Rplus Eimage hvFT + hvFU hvFR heFT heFU heFR walk hwalkHead hwalkInOuter have hwalkFinish := UnitInterfaceGeometry.hwalkFinish T U Rplus Epositive walk hwalkLast hwalkInOuter obtain ⟨path, hpathNodup, hpathLength, hpathHead, hpathLast, diff --git a/LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean b/LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean index d3ee4e48f7..fc41b6c4f6 100644 --- a/LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean +++ b/LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralInteriorStarClassification @@ -24,22 +25,7 @@ namespace ApollonianSuperharmonic namespace PositivePrecursorGeometry -private theorem raw_incident : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ FootprintVertices U) → - (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells)) ) := by - classical - intro U x hn hx - rw [FootprintVertices, ite_eq_left hn] at hx - obtain ⟨z, hz, rfl | rfl | rfl | rfl⟩ := hx - · exact ⟨0, hz⟩ - · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hz⟩ - · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hz⟩ - · refine ⟨2, ?_⟩ - change z + 1 + ⟨0, 1⟩ - 1 - ⟨0, 1⟩ ∈ U.cells - convert hz using 1; abel +private abbrev raw_incident := ApollonianSuperharmonic.LatticeFootprintIncidence.incidentCell private theorem boundary_incident : (by @@ -70,15 +56,20 @@ private theorem full_nonboundary : (by classical exact - ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : - BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : - BandOrderedGeneralLayoutCertificate q cfg C T), (Finset.Nonempty cert.O.cells) → - ((cert.O.cells = ∅ ↔ (cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → - ((Finset.Nonempty cert.O.cells → LatticeTile cert.O) → (∀ (U : ProtoTile), ∀ (x : - GaussianInt), (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells) → (x ∉ - BoundaryFootprintVertices U)))) ) := by + ∀ (C : BandCircle), + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + (cert.O.cells = ∅ ↔ + (cfg.firstPredecessor (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → + ∀ (U : ProtoTile), + ∀ (x : GaussianInt), + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells) → + x ∉ BoundaryFootprintVertices U + ) := by classical - intro C q cfg T cert hO hzero hOlattice U x hall + intro C q cfg T cert hzero U x hall have hn : U.cells.Nonempty := ⟨x, hall 0⟩ intro hx rw [BoundaryFootprintVertices, ite_eq_left hn] at hx @@ -818,8 +809,7 @@ theorem P4339T1PositivePrecursorRoots have hBcomp := cert.precursor_complement_lattice.2 have raw_incident := PositivePrecursorGeometry.raw_incident have boundary_incident := PositivePrecursorGeometry.boundary_incident - have full_nonboundary := PositivePrecursorGeometry.full_nonboundary C q cfg T cert hO hzero - hOlattice + have full_nonboundary := PositivePrecursorGeometry.full_nonboundary C q cfg T cert hzero have hallAB := PositivePrecursorGeometry.hallAB C q cfg T cert (PositivePrecursorGeometry.trans_zero (PositivePrecursorGeometry.htrans0)) have inD := PositivePrecursorGeometry.inD C q cfg T cert D hD full_nonboundary diff --git a/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean index 82fb06c50b..9255f6c737 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties +public import LeanPool.ApollonianSuperharmonic.ListEndpointFacts public import LeanPool.ApollonianSuperharmonic.P4366T1PrecursorRemainderFamily public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry @@ -286,23 +288,32 @@ private theorem hreflectab : (by classical exact - ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : - BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : - BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (a : GaussianInt), ∀ (b : - GaussianInt), (a ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset - GaussianInt)) → ((b ∈ - ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ((a - ≠ b) → (∀ (g : List - GaussianInt), (g.head? = some a) → ((g.getLast? = some b) → (((a = - cert.precursorBoundary.a ∧ b = cert.precursorBoundary.b) ∨ (a = - cert.precursorBoundary.b ∧ b = cert.precursorBoundary.a)) → ((GaussianRealPoint - cert.precursorBoundary.b = ((2 : ℝ) * (TileCentroid cert.O).1 - (GaussianRealPoint - cert.precursorBoundary.a).1, (2 : ℝ) * (TileCentroid cert.O).2 - (GaussianRealPoint - cert.precursorBoundary.a).2)) → (GaussianRealPoint b = (2 * (TileCentroid cert.O).1 - - (GaussianRealPoint a).1, 2 * (TileCentroid cert.O).2 - (GaussianRealPoint - a).2)))))))) ) := by + ∀ (C : BandCircle), + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (a : GaussianInt), + ∀ (b : GaussianInt), + a ≠ b → + ∀ (g : List GaussianInt), + g.head? = some a → + g.getLast? = some b → + a = cert.precursorBoundary.a ∧ + b = cert.precursorBoundary.b ∨ + a = cert.precursorBoundary.b ∧ + b = cert.precursorBoundary.a → + GaussianRealPoint cert.precursorBoundary.b = + ((2 : ℝ) * (TileCentroid cert.O).1 - + (GaussianRealPoint cert.precursorBoundary.a).1, + (2 : ℝ) * (TileCentroid cert.O).2 - + (GaussianRealPoint cert.precursorBoundary.a).2) → + GaussianRealPoint b = + (2 * (TileCentroid cert.O).1 - (GaussianRealPoint a).1, + 2 * (TileCentroid cert.O).2 - (GaussianRealPoint a).2) + ) := by classical - intro C q cfg T cert a b ha hb hab g hga hgb ordered hreflect + intro C q cfg T cert a b hab g hga hgb ordered hreflect rcases ordered with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ · exact hreflect · apply Prod.ext @@ -313,30 +324,6 @@ private theorem hreflectab : dsimp at h ⊢ linarith -private theorem roots_ab : - (by - classical - exact - ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : - BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : - BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (a : GaussianInt), ∀ (b : - GaussianInt), (a ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset - GaussianInt)) → ((b ∈ - ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) → ((a - ≠ b) → (∀ (g : List - GaussianInt), (g.head? = some a) → ((g.getLast? = some b) → (((a = - cert.precursorBoundary.a ∧ b = cert.precursorBoundary.b) ∨ (a = - cert.precursorBoundary.b ∧ b = cert.precursorBoundary.a)) → ((GaussianRealPoint b = - (2 * (TileCentroid cert.O).1 - (GaussianRealPoint a).1, 2 * (TileCentroid cert.O).2 - - (GaussianRealPoint a).2)) → (∀ (z : GaussianInt), (z ∈ ({cert.precursorBoundary.a, - cert.precursorBoundary.b} : - Finset GaussianInt)) → (z = a ∨ z = b)))))))) ) := by - classical - intro C q cfg T cert a b ha hb hab g hga hgb ordered hreflectab z hz - rcases ordered with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ - · simpa only [Finset.mem_insert, Finset.mem_singleton] using hz - · simpa only [Finset.mem_insert, Finset.mem_singleton, or_comm] using hz - private theorem arc_props : (by classical @@ -363,28 +350,6 @@ private theorem arc_props : · intro z hz exact boundary_raw cert.O hO (hfoot (by simpa using hz)) -private theorem hkl : - (by - classical - exact - ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : - BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : - BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (a : GaussianInt), ∀ (b : - GaussianInt), (a ≠ b) → (∀ (k : List GaussianInt), (k.Nodup) → ((k.head? = some b) → - ((k.getLast? = some a) → ((∀ (u : GaussianInt), ∀ (v : GaussianInt), (u, v) ∈ k.zip - k.tail → {u, v} ∈ BoundaryFootprintEdges cert.O) → ((∀ z ∈ k, z ∈ FootprintVertices - cert.O) → (2 ≤ k.length)))))) ) := by - classical - intro C q cfg T cert a b hab k hkn hkb hka hkboundary hkraw - cases k with - | nil => simp at hkb - | cons c l => - cases l with - | nil => simp only [List.head?_cons, List.getLast?_singleton, - Option.some.injEq] at hkb hka - exact (hab (hka.symm.trans hkb)).elim - | cons d ds => simp - private theorem kedge_raw : (by classical @@ -406,16 +371,7 @@ private theorem kedge_raw : · exact Or.inl h.1 · exact Or.inr h.2 -private theorem trans_zero : - (by - classical - exact - ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by - classical - intro U - cases U - simp [TileTranslation, GaussianTranslation, show GaussianTranslation 0 = id from - funext (fun z => add_zero z)] +private abbrev trans_zero := ApollonianSuperharmonic.TileTranslationProperties.zero private theorem kstar : (by @@ -672,10 +628,14 @@ theorem P4366T1PrecursorPathLoop rcases cert.precursorBoundary.branch with hp | hn · exact hp.2 · exact ((Finset.nonempty_iff_ne_empty.mp hO) hn.1).elim) - have hreflectab := PrecursorLoopGeometry.hreflectab C q cfg T cert a b ha hb hab g hga hgb + have hreflectab := PrecursorLoopGeometry.hreflectab C q cfg T cert a b hab g hga hgb ordered hreflect - have roots_ab := PrecursorLoopGeometry.roots_ab C q cfg T cert a b ha hb hab g hga hgb ordered - hreflectab + have roots_ab (z : GaussianInt) + (hz : z ∈ ({cert.precursorBoundary.a, cert.precursorBoundary.b} : Finset GaussianInt)) : + z = a ∨ z = b := by + rcases ordered with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ + · simpa only [Finset.mem_insert, Finset.mem_singleton] using hz + · simpa only [Finset.mem_insert, Finset.mem_singleton, or_comm] using hz have gnoO := P4397T1PathAvoidsPrecursorEdges cert.O (TileCentroid cert.O) (BandPrototileCentralSymmetry _ _ hOband) a b hab hreflectab g hgn hga hgb gsteps @@ -698,7 +658,7 @@ theorem P4366T1PrecursorPathLoop (fun z hz => (hmf ▸ hz).2) (fun u v l1 l2 hl => (hme u v l1 l2 hl).2) · exact arc_props plusArc hpn hph hpl (fun z hz => (hpf ▸ hz).2) (fun u v l1 l2 hl => (hpe u v l1 l2 hl).2) - have hkl := PrecursorLoopGeometry.hkl C q cfg T cert a b hab k hkn hkb hka hkboundary hkraw + have hkl := ListEndpointFacts.twoLeLength a b hab k hkb hka have ksteps (u v : GaussianInt) (he : (u, v) ∈ k.zip k.tail) : FourNeighborAdjacent u v := boundary_step cert.O u v (hkboundary u v he) have kedge_raw (u v : GaussianInt) (he : (u, v) ∈ k.zip k.tail) : diff --git a/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean b/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean index 60bca055e2..634c0f0e3a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry public import LeanPool.ApollonianSuperharmonic.P4366T1PrecursorRemainderFamily @@ -25,18 +26,7 @@ namespace ApollonianSuperharmonic namespace RemainderAttachmentGeometry -private theorem zero_translation : - (by - classical - exact - ∀ (U : ProtoTile), TileTranslation U 0 = U ) := by - classical - intro U - have htranslation : GaussianTranslation 0 = id := by - funext a - exact add_zero a - cases U - simp [TileTranslation, htranslation] +private abbrev zero_translation := ApollonianSuperharmonic.TileTranslationProperties.zero private theorem isolated : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean index 453611649c..ff7494a6ad 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean @@ -1220,33 +1220,9 @@ private theorem hchange'At1020 : intro T0 T0' outerLabel x sectorSide i hchange heq exact hchange (by simp only [sectorSide, heq]) -private theorem hUVAt1027 : - (by - classical - exact - ∀ (Ci : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (a : - TilingLattice Ci), ∀ (b : TilingLattice Ci), (P.tile a = P.tile b) → (a = b)) → (∀ - (UL : ProtoTile), ∀ (VL : ProtoTile), ∀ (iaL : ↥(TilingLattice Ci)), ∀ (ibL : - ↥(TilingLattice Ci)), (P.tile iaL = UL) → ((P.tile ibL = VL) → ((iaL ≠ ibL) → (UL ≠ - VL)))) ) := by - classical - intro Ci P index_eq_of_tile_eq UL VL iaL ibL hULidx hVLidx hidxLne heq - exact hidxLne (index_eq_of_tile_eq iaL ibL - (hULidx.trans (heq.trans hVLidx.symm))) +private abbrev hUVAt1027 := ApollonianSuperharmonic.LocalSectorGeometry.hUVAt563 -private theorem hUVAt1038 : - (by - classical - exact - ∀ (Ci : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (a : - TilingLattice Ci), ∀ (b : TilingLattice Ci), (P.tile a = P.tile b) → (a = b)) → (∀ - (UR : ProtoTile), ∀ (VR : ProtoTile), ∀ (iaR : ↥(TilingLattice Ci)), ∀ (ibR : - ↥(TilingLattice Ci)), (P.tile iaR = UR) → ((P.tile ibR = VR) → ((iaR ≠ ibR) → (UR ≠ - VR)))) ) := by - classical - intro Ci P index_eq_of_tile_eq UR VR iaR ibR hURidx hVRidx hidxRne heq - exact hidxRne (index_eq_of_tile_eq iaR ibR - (hURidx.trans (heq.trans hVRidx.symm))) +private abbrev hUVAt1038 := ApollonianSuperharmonic.LocalSectorGeometry.hUVAt563 end LocalSectorGeometry @@ -1440,10 +1416,10 @@ private theorem interiorSector : T0'.cells) → (∀ (path : List GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := - ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] + ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1]; let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := ![{x, x + ⟨0, 1⟩}, {x - 1, x}, - {x - ⟨0, 1⟩, x}, {x, x + 1}] + {x - ⟨0, 1⟩, x}, {x, x + 1}]; (∀ (x : GaussianInt), ∀ (j : Fin 4), x ∈ edgeAt x j ∧ neighbor x j ∈ edgeAt x j) → ((∀ (x : GaussianInt), ∀ {j : Fin 4}, ∀ {k : Fin 4}, (edgeAt x j = edgeAt x k) → (j = k)) → ((∀ (R : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x @@ -1451,14 +1427,14 @@ private theorem interiorSector : FootprintEdges R)) → ( let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => if LatticeVertexIncidentCell x j ∈ T0.cells then 0 - else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 + else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2; (∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0.cells) → (outerLabel x j = 0)) → ((∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ T0'.cells) → (outerLabel x j = 1)) → ((∀ (U : ProtoTile), ∀ (T : ProtoTile), ∀ (g : PartialOdometer), ∀ (h : PartialOdometer), (AncestorOdometer Ci.1.1 C0.1.1 U T g h) → (U.cells ⊆ T.cells)) → ( let owner : GaussianInt → TilingLattice Ci := fun c => - Classical.choose (PeriodicTileIndexedMultiplicityOne P c) + Classical.choose (PeriodicTileIndexedMultiplicityOne P c); (∀ (c : GaussianInt), ∀ (a : TilingLattice Ci), (c ∈ (P.tile a).cells) → (owner c = a)) → ((∀ (a : TilingLattice Ci), ∀ (b : TilingLattice Ci), (P.tile a = P.tile b) → (a = b)) → ((∀ (c : GaussianInt), ∀ (a : TilingLattice Ci), c ∈ (P.tile a).cells ↔ owner c @@ -1484,7 +1460,8 @@ private theorem interiorSector : P.tile ib = V ∧ ia ≠ ib ∧ (LatticeVertexIncidentCell x j ∈ (P.tile ia).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (P.tile ib).cells ∨ LatticeVertexIncidentCell x j ∈ (P.tile ib).cells ∧ LatticeVertexIncidentCell x (j + 1) ∈ (P.tile ia).cells)))) → - (∀ (x : GaussianInt), (x ∈ path) → ((∀ (y : GaussianInt), y = x ∨ y = x + (1 : + (∀ (x : GaussianInt), + ((∀ (y : GaussianInt), y = x ∨ y = x + (1 : GaussianInt) ∨ y = x - (1 : GaussianInt) ∨ y = x + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ FootprintVertices T0 ∨ y ∈ FootprintVertices T0') → ((path.Nodup) → ((∀ (e : Finset GaussianInt), e ∈ @@ -1504,7 +1481,7 @@ private theorem interiorSector : intro C0 Ci T0 T0' h0 h0' tiles reverseTiles hs reverseHs hT hT' hdis path P neighbor edgeAt edgeAt_mem edgeAt_injective edge_of_sector_cell outerLabel label_T0 label_T0' ancestor_cells owner owner_unique index_eq_of_tile_eq owner_mem_iff owner_no_fourfold - owner_no_checkerboard indexed_transition x hx hstar hnodup hedgesPath pre hpre y rest hsplit + owner_no_checkerboard indexed_transition x hstar hnodup hedgesPath pre hpre y rest hsplit have hpre' : pre ≠ [] := hpre let z := pre.getLast hpre' let pre' := pre.dropLast @@ -1764,7 +1741,7 @@ theorem P4366T2LocalSectors exact (LocalSectorConclusions.interiorSector C0 Ci T0 T0' h0 h0' tiles reverseTiles hs reverseHs hT hT' hdis path P edgeAt_mem edgeAt_injective edge_of_sector_cell label_T0 label_T0' ancestor_cells owner_unique index_eq_of_tile_eq owner_mem_iff - owner_no_fourfold owner_no_checkerboard indexed_transition x hx hstar hnodup + owner_no_fourfold owner_no_checkerboard indexed_transition x hstar hnodup hedgesPath pre hpre y rest hsplit) end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean index 6573399e23..75c077d1ed 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween @@ -586,17 +587,7 @@ private theorem hEroot'Eq : intro T0 T0' centerShift hFroot'Cells simp [FootprintEdges, hFroot'Cells] -private theorem hEplusEq : - (by - classical - exact - ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (centerShift : GaussianInt), - ((TileTranslation (TileHalfTurn Rplus) centerShift).cells = Rminus.cells) → - (FootprintEdges Rminus = FootprintEdges (TileTranslation (TileHalfTurn Rplus) - centerShift)) ) := by - classical - intro Rminus Rplus centerShift hpc - simp [FootprintEdges, hpc] +private abbrev hEplusEq := ApollonianSuperharmonic.OuterGeometry.hEroot'Eq private theorem heT0 : (by @@ -626,19 +617,7 @@ private theorem heT0' : intro T0 T0' centerShift f hEdgeCov hEroot'Eq rw [hEroot'Eq, hEdgeCov] -private theorem hePlus : - (by - classical - exact - ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (centerShift : GaussianInt), - let f : GaussianInt → GaussianInt := fun x => -x + centerShift - (∀ (X : ProtoTile), FootprintEdges (TileTranslation (TileHalfTurn X) centerShift) = (fun - e : Finset GaussianInt => e.image f) '' FootprintEdges X) → ((FootprintEdges Rminus = - FootprintEdges (TileTranslation (TileHalfTurn Rplus) centerShift)) → (FootprintEdges - Rminus = (fun e : Finset GaussianInt => e.image f) '' FootprintEdges Rplus)) ) := by - classical - intro Rminus Rplus centerShift f hEdgeCov hEplusEq - rw [hEplusEq, hEdgeCov] +private abbrev hePlus := ApollonianSuperharmonic.OuterGeometry.heT0' private theorem vAB : (by @@ -1291,20 +1270,7 @@ private theorem hvecZero : rw [hcentEq] ext <;> simp -private theorem hinjAt979 : - (by - classical - exact - Function.Injective GaussianRealPoint ) := by - classical - intro x y hxy - apply Zsqrtd.ext - · have hx := congrArg Prod.fst hxy - dsimp [GaussianRealPoint] at hx - exact_mod_cast hx - · have hy := congrArg Prod.snd hxy - dsimp [GaussianRealPoint] at hy - exact_mod_cast hy +private abbrev hinjAt979 := ApollonianSuperharmonic.GaussianRealPointProperties.injective private theorem hvZero : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean b/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean index 1b0fd601b5..81bafe0c0b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean @@ -61,34 +61,32 @@ private theorem hshift : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - (P4418T3SelectedInterfaceData (SubtileOccurrenceInterpretation cert.P cert.u cert.v - a) (SubtileOccurrenceInterpretation cert.P cert.u cert.v b) - (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4418T3EndpointOwnerIndices - q cfg C T cert a b row).1) (SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2)) → (∀ (x : GaussianInt), ∀ - (j : Fin 4), ∀ (edge : Finset GaussianInt), (edge ∈ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b)) → - ((LatticeVertexIncidentCell x j ∈ (SubtileOccurrenceInterpretation cert.P cert.u - cert.v a).cells) → ((LatticeVertexIncidentCell x (j + (2 : Fin (4 : ℕ))) ∈ - (SubtileOccurrenceInterpretation cert.P cert.u cert.v b).cells) → ( - let shift : GaussianInt := match P3996T1SRowTable q cfg C T cert row with - | some z => z.oldShift - | none => match a.label with - | .A => if a.first = -1 then -cert.u else cert.u - | .B => if a.first = 1 then cert.u else -cert.u - | .C => -cert.v - | .D => cert.v - | .E | .F => 0 - let oldCoord : Int × Int := routedOldCoordinates row - shift = (oldCoord.1 : GaussianInt) * cert.u + (oldCoord.2 : GaussianInt) * cert.v)))) ) + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (a : PeriodicSubtileIndex), + ∀ (b : PeriodicSubtileIndex), + ∀ (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let shift : GaussianInt := + match P3996T1SRowTable q cfg C T cert row with + | some z => z.oldShift + | none => + match a.label with + | .A => if a.first = -1 then -cert.u else cert.u + | .B => if a.first = 1 then cert.u else -cert.u + | .C => -cert.v + | .D => cert.v + | .E | .F => 0 + let oldCoord : Int × Int := routedOldCoordinates row + shift = + (oldCoord.1 : GaussianInt) * cert.u + + (oldCoord.2 : GaussianInt) * cert.v + ) := by classical - intro q cfg C T cert a b row data x j edge hedge ha hb shift oldCoord + intro q cfg C T cert a b row shift oldCoord cases row <;> simp [shift, oldCoord, routedOldCoordinates, P3996T1SRowTable] <;> ring private theorem root_disjoint : @@ -226,22 +224,7 @@ private theorem hVroot : intro q cfg C T cert a V root_cells c hc exact root_cells a c (by simpa [V] using hc) -private theorem hWroot : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (b : PeriodicSubtileIndex), - let W := SubtileOccurrenceInterpretation cert.P cert.u cert.v b - (∀ (o : PeriodicSubtileIndex), ∀ (c : LatticeCell), (c ∈ (SubtileOccurrenceInterpretation - cert.P cert.u cert.v o).cells) → (c ∈ (TileTranslation T ((o.first : GaussianInt) * - cert.u + (o.second : GaussianInt) * cert.v)).cells)) → (∀ c : LatticeCell, c ∈ - W.cells → c ∈ (TileTranslation T ((b.first : GaussianInt) * cert.u + (b.second : - GaussianInt) * cert.v)).cells) ) := by - classical - intro q cfg C T cert b W root_cells c hc - exact root_cells b c (by simpa [W] using hc) +private abbrev hWroot := ApollonianSuperharmonic.RoutedBlockGeometry.hVroot private theorem hG₀root : (by @@ -525,12 +508,12 @@ private theorem hfirst_criterion : LatticeVertexIncidentCell z k ∈ U.cells → z ∈ FootprintVertices U) → let V := - SubtileOccurrenceInterpretation cert.P cert.u cert.v a + SubtileOccurrenceInterpretation cert.P cert.u cert.v a; let W := - SubtileOccurrenceInterpretation cert.P cert.u cert.v b + SubtileOccurrenceInterpretation cert.P cert.u cert.v b; let G₀ := SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1; (∀ c : LatticeCell, c ∈ G₀.cells → c ∈ @@ -545,8 +528,6 @@ private theorem hfirst_criterion : cert.v)).cells) → Disjoint V.cells (TileTranslation T shift).cells → Disjoint W.cells (TileTranslation T shift).cells → - (∃ e : Finset GaussianInt, - x ∈ e ∧ e ∈ FootprintEdges V ∩ FootprintEdges W) → (x = data.first ∨ x = data.last ∨ ∃ (e : Finset GaussianInt) (f : Finset GaussianInt), @@ -572,8 +553,8 @@ private theorem hfirst_criterion : ) := by classical intro q cfg C T cert a b row data x j edge hx hedge ha hb shift oldCoord hshift root_disjoint - old_nonempty footprint_incident incident_footprint V W G₀ hG₀root hVold hWold hxedge htri - o₀ hfirst + old_nonempty footprint_incident incident_footprint V W G₀ hG₀root hVold hWold htri o₀ + hfirst subst x obtain ⟨k, hk⟩ := ((LocalLatticeInterfaceSectors.1 V W G₀ data.first data.latticeV @@ -699,12 +680,12 @@ private theorem hlast_criterion : LatticeVertexIncidentCell z k ∈ U.cells → z ∈ FootprintVertices U) → let V := - SubtileOccurrenceInterpretation cert.P cert.u cert.v a + SubtileOccurrenceInterpretation cert.P cert.u cert.v a; let W := - SubtileOccurrenceInterpretation cert.P cert.u cert.v b + SubtileOccurrenceInterpretation cert.P cert.u cert.v b; let G₁ := SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 + (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2; (∀ c : LatticeCell, c ∈ G₁.cells → c ∈ @@ -719,8 +700,6 @@ private theorem hlast_criterion : cert.v)).cells) → Disjoint V.cells (TileTranslation T shift).cells → Disjoint W.cells (TileTranslation T shift).cells → - (∃ e : Finset GaussianInt, - x ∈ e ∧ e ∈ FootprintEdges V ∩ FootprintEdges W) → (x = data.first ∨ x = data.last ∨ ∃ (e : Finset GaussianInt) (f : Finset GaussianInt), @@ -751,8 +730,8 @@ private theorem hlast_criterion : ) := by classical intro q cfg C T cert a b row data x j edge hx hedge ha hb shift oldCoord hshift root_disjoint - old_nonempty footprint_incident incident_footprint V W G₁ hG₁root hVold hWold hxedge htri - o₀ o₁ hfirst_criterion hlast + old_nonempty footprint_incident incident_footprint V W G₁ hG₁root hVold hWold htri o₀ o₁ + hfirst_criterion hlast subst x obtain ⟨k, hk⟩ := ((LocalLatticeInterfaceSectors.1 V W G₁ data.last data.latticeV @@ -969,7 +948,7 @@ theorem P4418T3RoutedBlockCriterion | .D => cert.v | .E | .F => 0 let oldCoord : Int × Int := routedOldCoordinates row - have hshift := RoutedBlockGeometry.hshift q cfg C T cert a b row data x j edge hedge ha hb + have hshift := RoutedBlockGeometry.hshift q cfg C T cert a b row have a_coord_ne : (a.first, a.second) ≠ oldCoord := by cases row <;> simp [oldCoord, routedOldCoordinates] have b_coord_ne : (b.first, b.second) ≠ oldCoord := by @@ -1010,10 +989,10 @@ theorem P4418T3RoutedBlockCriterion let o₁ := (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 have hfirst_criterion := RoutedBlockGeometry.hfirst_criterion q cfg C T cert a b row data x j edge hx hedge ha hb hshift root_disjoint old_nonempty - footprint_incident incident_footprint hG₀root hVold hWold hxedge htri + footprint_incident incident_footprint hG₀root hVold hWold htri have hlast_criterion := RoutedBlockGeometry.hlast_criterion q cfg C T cert a b row data x j edge hx hedge ha hb hshift root_disjoint old_nonempty - footprint_incident incident_footprint hG₁root hVold hWold hxedge htri hfirst_criterion + footprint_incident incident_footprint hG₁root hVold hWold htri hfirst_criterion have hcriterion : x ∈ FootprintVertices (TileTranslation T shift) ↔ (x = data.first ∧ oldCoord = (o₀.first, o₀.second)) ∨ (x = data.last ∧ oldCoord = (o₁.first, o₁.second)) := RoutedBlockGeometry.hcriterion q cfg diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean index 431331b909..8729133243 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean @@ -574,29 +574,24 @@ private theorem faceDistinct : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - let P := cert.P - let O := cert.O - let u := cert.u - let v := cert.v - ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b))) → ( - let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row - let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modifiedFaceEquivalence.symm face0 - let F1 := cert.modifiedFaceEquivalence.symm face1 - F0 ≠ F1) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (a : PeriodicSubtileIndex), + ∀ (b : PeriodicSubtileIndex), + ∀ (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b), + let face0 : PeriodicSubtileFaceIndex := + selectedFirstFace q cfg C T cert a b row + let face1 : PeriodicSubtileFaceIndex := + selectedSecondFace q cfg C T cert a b row + let F0 := cert.modifiedFaceEquivalence.symm face0 + let F1 := cert.modifiedFaceEquivalence.symm face1 + F0 ≠ F1 + ) := by classical - intro q cfg C T cert a b row P O u v retargeted face0 face1 F0 F1 h + intro q cfg C T cert a b row face0 face1 F0 F1 h have hf := congrArg cert.modifiedFaceEquivalence h cases row <;> simp [F0, F1, face0, face1, selectedFirstFace, selectedSecondFace] at hf @@ -1216,37 +1211,9 @@ private theorem disjointData : pairCells _ _ (by decide) (by decide), pairCells _ _ (by decide) (by decide)⟩ -private theorem translateAdd : - (by - classical - exact - ∀ (X : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), TileTranslation - (TileTranslation X x) y = TileTranslation X (x + y) ) := by - classical - intro X x y - cases X with - | mk cells anchor => - apply congrArg₂ ProtoTile.mk - · simp only [TileTranslation, Finset.image_image, Function.comp_def] - congr 1 - funext z - simp only [GaussianTranslation, add_assoc] - · change (anchor + x) + y = anchor + (x + y) - exact add_assoc anchor x y +private abbrev translateAdd := ApollonianSuperharmonic.TileTranslationProperties.add -private theorem translateZero : - (by - classical - exact - ∀ (X : ProtoTile), TileTranslation X 0 = X ) := by - classical - intro X - cases X with - | mk cells anchor => - apply congrArg₂ ProtoTile.mk - · change Finset.image (fun z : GaussianInt => z + 0) cells = cells - simp - · simp [GaussianTranslation] +private abbrev translateZero := ApollonianSuperharmonic.TileTranslationProperties.zero private theorem touchingData : (by @@ -1256,54 +1223,29 @@ private theorem touchingData : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - let P := cert.P - let O := cert.O - let u := cert.u - let v := cert.v - ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b))) → ( - let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v - let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row - let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row - let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F0 := cert.modifiedFaceEquivalence.symm face0 - let F1 := cert.modifiedFaceEquivalence.symm face1 - (F0 ≠ F1) → ((a ≠ b) → ((AllowedSubtileIncidence a b) → (((FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v b)).Nonempty) → ((∃ x y : - GaussianInt, SimpleGridPathBetween (FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b)) (FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v b)) x y) → ((SimpleGridPathBetween - (FootprintVertices (occurrence a) ∩ FootprintVertices (occurrence b)) (FootprintEdges - (occurrence a) ∩ FootprintEdges (occurrence b)) (cert.modified.rho F0) - (cert.modified.rho F1)) → ((cert.modified.rho F0 ≠ cert.modified.rho F1) → (∀ (iA : - Fin (3 : ℕ)), ∀ (iB : Fin (3 : ℕ)), ∀ (iO : Fin (3 : ℕ)), - (cert.modified.plane.faceVertex F0 iA = a) → ((cert.modified.plane.faceVertex F0 iB = - b) → ((cert.modified.plane.faceVertex F0 iO = owners.1) → (∀ (jA : Fin (3 : ℕ)), ∀ - (jB : Fin (3 : ℕ)), ∀ (jO : Fin (3 : ℕ)), (cert.modified.plane.faceVertex F1 jA = a) - → ((cert.modified.plane.faceVertex F1 jB = b) → ((cert.modified.plane.faceVertex F1 - jO = owners.2) → ((cert.modified.rho F0 ∈ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b)) → ((cert.modified.rho F1 ∈ - FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ - FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)) → - ((cert.modified.rho F0 ∈ FootprintVertices (occurrence owners.1)) → - ((cert.modified.rho F1 ∈ FootprintVertices (occurrence owners.2)) → - ((cert.modified.rho F0 ∈ FootprintVertices (occurrence a) ∩ FootprintVertices - (occurrence b)) → ((cert.modified.rho F1 ∈ FootprintVertices (occurrence a) ∩ - FootprintVertices (occurrence b)) → ((Disjoint (occurrence a).cells (occurrence - b).cells ∧ Disjoint (occurrence a).cells (occurrence owners.1).cells ∧ Disjoint - (occurrence b).cells (occurrence owners.1).cells ∧ Disjoint (occurrence a).cells - (occurrence owners.2).cells ∧ Disjoint (occurrence b).cells (occurrence - owners.2).cells) → ((∀ (X : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), + ( + let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v; + let owners := P4418T3EndpointOwnerIndices q cfg C T cert a b row; + ( + ( + ( + ( + ( + ( + ( + ( + ( + ( + ( + ( + ( + ( + ( + ( + ( + ( + ( + ((∀ (X : ProtoTile), ∀ (x : GaussianInt), ∀ (y : GaussianInt), TileTranslation (TileTranslation X x) y = TileTranslation X (x + y)) → ((∀ (X : ProtoTile), TileTranslation X 0 = X) → ((∀ (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (Z : ProtoTile), ∀ (d : GaussianInt), (TouchingTriple X Y Z) → (TouchingTriple @@ -1334,11 +1276,10 @@ private theorem touchingData : (occurrence a) (occurrence b) (occurrence owners.1) ∧ TouchingTriple (occurrence a) (occurrence b) (occurrence owners.2)))))))))))))))))))))))))))))))))))))) ) := by classical - intro q cfg C T cert a b row P O u v retargeted occurrence owners face0 face1 F0 F1 - faceDistinct hne allowed modifiedEdges modifiedPath pathAtOwners endpointsDistinct iA iB iO - ha0 hb0 ho0 jA jB jO ha1 hb1 ho1 commonPair0 commonPair1 ownerPoint0 ownerPoint1 - originalPair0 originalPair1 disjointData translateAdd translateZero touchTranslate touchXZY - touchYXZ touchYZX touchZXY touchZYX out1 out2 out3 out4 out5 out6 out7 out8 + intro q cfg C T cert a b row occurrence owners translateAdd translateZero touchTranslate + touchXZY touchYXZ touchYZX touchZXY touchZYX out1 out2 out3 out4 out5 out6 out7 out8 + let u := cert.u + let v := cert.v cases row with | positiveL1 _ _ => constructor @@ -1601,10 +1542,8 @@ private theorem selectedCertificate : have touchingData : TouchingTriple (occurrence a) (occurrence b) (occurrence owners.1) ∧ TouchingTriple (occurrence a) (occurrence b) (occurrence owners.2) := - SelectedInterfaceGeometry.touchingData q cfg C T cert a b row retargeted faceDistinct - hne allowed modifiedEdges modifiedPath pathAtOwners endpointsDistinct iA iB iO ha0 hb0 - ho0 jA jB jO ha1 hb1 ho1 commonPair0 commonPair1 ownerPoint0 ownerPoint1 originalPair0 - originalPair1 disjointData translateAdd translateZero touchTranslate touchXZY touchYXZ + SelectedInterfaceGeometry.touchingData q cfg C T cert a b row translateAdd translateZero + touchTranslate touchXZY touchYXZ touchYZX touchZXY touchZYX out1 out2 out3 out4 out5 out6 out7 out8 have touching0 := touchingData.1 have touching1 := touchingData.2 @@ -1748,7 +1687,6 @@ theorem P4418T3SelectedInterfaceExists cert.modified.plane.faceVertex (cert.modifiedFaceEquivalence.symm f) i = SixSubtileFaceVertices f i := SelectedInterfaceGeometry.faceVertex q cfg C T cert f i have faceDistinct : F0 ≠ F1 := SelectedInterfaceGeometry.faceDistinct q cfg C T cert a b row - retargeted have faceTable : (∃ iA iB iO : Fin 3, cert.modified.plane.faceVertex F0 iA = a ∧ diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean b/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean index a531ed456d..046deb2a36 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties +public import LeanPool.ApollonianSuperharmonic.LatticeTileNonempty public import LeanPool.ApollonianSuperharmonic.BandTileSimultaneousInduction public import LeanPool.ApollonianSuperharmonic.TouchingTriple @@ -26,19 +28,7 @@ namespace ApollonianSuperharmonic namespace BandGraphTriangleGeometry -private theorem hTne : - (by - classical - exact - ∀ (T : ProtoTile), (LatticeTile T) → (T.cells.Nonempty) ) := by - classical - intro T hT1 - obtain ⟨e⟩ := hT1 - let p := (e ⟨(0 : Real × Real), by simp⟩).val - have hp : p ∈ TileRealization T := (e ⟨(0 : Real × Real), by simp⟩).property - simp only [TileRealization, Set.mem_iUnion] at hp - rcases hp with ⟨x, hx, _⟩ - exact ⟨x, hx⟩ +private abbrev hTne := ApollonianSuperharmonic.LatticeTileNonempty.cells private theorem hcentCells : (by @@ -65,20 +55,17 @@ private theorem hturnedCells : exact ∀ (T : ProtoTile), ∀ (g : GaussianInt), - GaussianRealPoint g = - ((TileCentroid T).1 + (TileCentroid T).2, - (TileCentroid T).2 - (TileCentroid T).1) → - (TileTranslation (TileQuarterTurn T) g).cells = T.cells → - let rot : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x - 1 - let cent : GaussianInt → GaussianInt := fun x => - GaussianTranslation g (rot x) - T.cells.image cent = T.cells → - ∀ (d : GaussianInt), - (TileTranslation (TileQuarterTurn (TileTranslation T d)) g).cells = - (TileTranslation T (GaussianQuarterTurn d)).cells + (TileTranslation (TileQuarterTurn T) g).cells = T.cells → + let rot : GaussianInt → GaussianInt := fun x => GaussianQuarterTurn x - 1 + let cent : GaussianInt → GaussianInt := fun x => + GaussianTranslation g (rot x) + T.cells.image cent = T.cells → + ∀ (d : GaussianInt), + (TileTranslation (TileQuarterTurn (TileTranslation T d)) g).cells = + (TileTranslation T (GaussianQuarterTurn d)).cells ) := by classical - intro T g hg hcenter rot cent hcentCells d + intro T g hcenter rot cent hcentCells d rw [(TileTranslationFormulas (TileQuarterTurn (TileTranslation T d)) g).1, (TileQuarterTurnFormulas (TileTranslation T d)).1, (TileTranslationFormulas T d).1, @@ -238,23 +225,7 @@ private theorem hxy : apply (chart.adjacent_iff x y).mp simpa [hxa, hyb] using hab -private theorem hyz : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : - PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int - => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : - GaussianInt) * BandVectors.1 (q 2) (q 0)))), ∀ (b : ι), ∀ (c : ι), (P.plane.adjacent - b c) → ( - let y : Int × Int := chart.vertexEquiv.symm b - let z : Int × Int := chart.vertexEquiv.symm c - (chart.vertexEquiv y = b) → ((chart.vertexEquiv z = c) → (TriangularLatticeAdjacent y - z))) ) := by - classical - intro q T ι P chart b c hbc y z hyb hzc - apply (chart.adjacent_iff y z).mp - simpa [hyb, hzc] using hbc +private abbrev hyz := ApollonianSuperharmonic.BandGraphTriangleGeometry.hxy private theorem hzx : (by @@ -292,23 +263,7 @@ private theorem hpAt297 : simp [TriangularLatticeAdjacent, p] at hxy ⊢ simpa [Prod.sub_def, Prod.ext_iff] using hxy -private theorem hr : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (ι : Type), ∀ (P : - PeriodicTileComplex ι), ∀ (chart : AffineTriangularComplexChart P (fun mn : Int × Int - => TileTranslation T ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (mn.2 : - GaussianInt) * BandVectors.1 (q 2) (q 0)))), ∀ (a : ι), ∀ (c : ι), - let x : Int × Int := chart.vertexEquiv.symm a - let z : Int × Int := chart.vertexEquiv.symm c - (TriangularLatticeAdjacent x z) → ( - let r := z - x - TriangularLatticeAdjacent (0, 0) r) ) := by - classical - intro q T ι P chart a c x z hzx' r - simp [TriangularLatticeAdjacent, r] at hzx' ⊢ - simpa [Prod.sub_def, Prod.ext_iff] using hzx' +private abbrev hr := ApollonianSuperharmonic.BandGraphTriangleGeometry.hpAt297 private theorem hpr : (by @@ -490,26 +445,7 @@ private theorem shift_mne2 : rw [hc] abel -private theorem transAssoc : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (s : GaussianInt), ∀ (t : GaussianInt), TileTranslation - (TileTranslation A s) t = TileTranslation A (s + t) ) := by - classical - intro A s t - cases A with - | mk cells anchor => - apply congrArg₂ ProtoTile.mk - · change (cells.image (GaussianTranslation s)).image (GaussianTranslation t) = - cells.image (GaussianTranslation (s + t)) - rw [Finset.image_image] - apply Finset.image_congr - intro x hx - simp [GaussianTranslation, add_assoc] - · change GaussianTranslation t (GaussianTranslation s anchor) = - GaussianTranslation (s + t) anchor - simp [GaussianTranslation, add_assoc] +private abbrev transAssoc := ApollonianSuperharmonic.TileTranslationProperties.add private theorem upFace : (by @@ -909,7 +845,7 @@ theorem P4456T2BandGraphTriangle (q : Fin 4 → CircleCoordinates) have hturnedCells (d : GaussianInt) : (TileTranslation (TileQuarterTurn (TileTranslation T d)) g).cells = (TileTranslation T (GaussianQuarterTurn d)).cells := - BandGraphTriangleGeometry.hturnedCells T g hg hcenter hcentCells d + BandGraphTriangleGeometry.hturnedCells T g hcenter hcentCells d have hOpp : TouchingTriple T (TileTranslation T (-u)) (TileTranslation T v) := BandGraphTriangleGeometry.hOpp q T hT3 hTne g hcenter hturnedCells intro a b c habc hbcc hca hab hbc hca' diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean b/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean index 34a799d4a6..c398117fcd 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean @@ -60,17 +60,7 @@ private theorem hxmem : rw [hpVerts] at hx simpa using hx -private theorem hymem : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (y : GaussianInt), (y ∈ BoundaryFootprintVertices T) → (∀ (p : List - GaussianInt), (BoundaryFootprintVertices T = (↑p.toFinset : Set GaussianInt)) → (y ∈ - p)) ) := by - classical - intro T y hy p hpVerts - rw [hpVerts] at hy - simpa using hy +private abbrev hymem := ApollonianSuperharmonic.CrosscutIndexProof.hxmem private theorem hchordBoundary : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean b/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean index e8103b8d5a..6e9471f3a7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2MissingEdge.lean @@ -6,6 +6,9 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence +public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.P4456T2BandGraphTriangle public import LeanPool.ApollonianSuperharmonic.BandRegularTranslatePeriodicComplex @@ -26,34 +29,23 @@ namespace ApollonianSuperharmonic namespace MissingEdgeGeometry -private theorem hzero : - (by - classical - exact - ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), (BandPrototile - (q (0 : Fin (4 : ℕ))) T) → ((∀ (u : ↥(TilingLattice C)), ∀ (x : LatticeCell), ∀ (y : - LatticeCell), FourNeighborAdjacent x y → x ∈ BoundaryFootprintVertices - (TileTranslation T (↑u : GaussianInt)) → y ∈ BoundaryFootprintVertices - (TileTranslation T (↑u : GaussianInt)) → ¬OpenLatticeEdge x y ⊆ interior - (TileRealization (TileTranslation T (↑u : GaussianInt)))) → (∀ (P : - PeriodicTileComplex ↥(TilingLattice C)), (∀ (u : ↥(TilingLattice C)), P.tile u = - TileTranslation T (↑u : GaussianInt)) → ((AffineTriangularComplexChart P fun (mn : ℤ - × ℤ) => TileTranslation T ((↑mn.1 : GaussianInt) * BandVectors.1 (q (1 : Fin (4 : - ℕ))) (q (0 : Fin (4 : ℕ))) + (↑mn.2 : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : - ℕ))) (q (0 : Fin (4 : ℕ))))) → (∀ (x : GaussianInt), (x ∈ FootprintVertices T) → (∀ - (y : GaussianInt), (y ∈ FootprintVertices T) → (({x, y} ∉ FootprintEdges T) → (P.tile - 0 = T))))))) ) := by - classical - intro C q T hT hnochord P htile chart x hx y hy hnot - rw [htile 0] - cases T with - | mk cells anchor => - change ProtoTile.mk (cells.image (GaussianTranslation 0)) - (GaussianTranslation 0 anchor) = ProtoTile.mk cells anchor - apply congrArg₂ ProtoTile.mk - · ext c - simp [GaussianTranslation] - · simp [GaussianTranslation] +private theorem adjacent_ne (x y : GaussianInt) (hxy : FourNeighborAdjacent x y) : x ≠ y := by + intro heq + subst y + simp only [FourNeighborAdjacent] at hxy + rcases hxy with h | h | h | h + · have hr := congrArg Zsqrtd.re h + simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr + omega + · have hr := congrArg Zsqrtd.re h + simp only [Zsqrtd.re_sub, Zsqrtd.re_one] at hr + omega + · have hi := congrArg Zsqrtd.im h + simp only [Zsqrtd.im_add] at hi + omega + · have hi := congrArg Zsqrtd.im h + simp only [Zsqrtd.im_sub] at hi + omega private theorem hzwT : (by @@ -75,129 +67,8 @@ private theorem hzwT : hedgeT ((hedgeFacts T).1.mpr h) exact not_or.mp hh -private theorem ha0 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), - (P.tile 0 = T) → (∀ (z : GaussianInt), ∀ (w : GaussianInt), (z ∉ T.cells ∧ w ∉ - T.cells) → (∀ (a : ↥(TilingLattice C)), (z ∈ (P.tile a).cells) → ((∀ (y : - ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => z ∈ (P.tile a).cells) y → y = - a) → (a ≠ 0)))) ) := by - classical - intro C T P hzero z w hzwT a ha hauniq heq - subst a - exact hzwT.1 (by simpa [hzero] using ha) - -private theorem hb0 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), - (P.tile 0 = T) → (∀ (z : GaussianInt), ∀ (w : GaussianInt), (z ∉ T.cells ∧ w ∉ - T.cells) → (∀ (b : ↥(TilingLattice C)), (w ∈ (P.tile b).cells) → ((∀ (y : - ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => w ∈ (P.tile a).cells) y → y = - b) → (b ≠ 0)))) ) := by - classical - intro C T P hzero z w hzwT b hb hbuniq heq - subst b - exact hzwT.2 (by simpa [hzero] using hb) - -private theorem incident_of_footprint : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (v : GaussianInt), (U.cells.Nonempty) → ((v ∈ FootprintVertices U) → - (∃ j : Fin 4, LatticeVertexIncidentCell v j ∈ U.cells)) ) := by - classical - intro U v hne hv - simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hv - rcases hv with ⟨c, hc, hcase⟩ - rcases hcase with hcase | hcase | hcase | hcase - · exact ⟨0, by simpa [LatticeVertexIncidentCell, hcase] using hc⟩ - · subst v - exact ⟨1, by simpa [LatticeVertexIncidentCell, sub_eq_add_neg] using hc⟩ - · subst v - exact ⟨3, by simpa [LatticeVertexIncidentCell, sub_eq_add_neg] using hc⟩ - · subst v - exact ⟨2, by simpa [LatticeVertexIncidentCell, sub_eq_add_neg, add_assoc, - add_comm, add_left_comm] using hc⟩ - -private theorem hTne : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), - ProperBandQuadruple q → - ∀ (T : ProtoTile), - BandPrototile (q (0 : Fin (4 : ℕ))) T → - (1 : ℤ) < (q (0 : Fin (4 : ℕ))).1 → T.cells.Nonempty - ) := by - classical - intro q hq T hT hlarge - have harea := (BandTileSimultaneousInduction q hq T hT).2.1 - rw [Finset.nonempty_iff_ne_empty] - intro he - have hzeroarea : TileArea T = 0 := by simp [TileArea, he] - rw [harea] at hzeroarea - have hpos : 0 < Int.toNat (q 0).1 := by omega - omega - -private theorem hmissT : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ - (x : GaussianInt), (x ∈ FootprintVertices T) → (∀ (y : GaussianInt), (y ∈ - FootprintVertices T) → ((FourNeighborAdjacent x y) → (({x, y} ∉ FootprintEdges T) → - (∀ (z : GaussianInt), ∀ (w : GaussianInt), ((x = z + (1 : GaussianInt) ∧ y = z + (1 : - GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = z + (1 : GaussianInt) ∧ x = z - + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∧ w = z + (1 : GaussianInt) - ∨ (x = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∧ y = z + (⟨(0 : - ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ∧ x = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∧ w = z + (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt)) → ((∀ (U : ProtoTile), ({x, y} ∈ FootprintEdges U ↔ z ∈ U.cells ∨ - w ∈ U.cells) ∧ ({x, y} ∈ BoundaryFootprintEdges U ↔ z ∈ U.cells ∧ w ∉ U.cells ∨ z ∉ - U.cells ∧ w ∈ U.cells) ∧ (z ∈ U.cells ∨ w ∈ U.cells → x ∈ FootprintVertices U ∧ y ∈ - FootprintVertices U ∧ ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (((1 : ℝ) - (↑t : - ℝ)) * (↑x.re : ℝ) + (↑t : ℝ) * (↑y.re : ℝ), ((1 : ℝ) - (↑t : ℝ)) * (↑x.im : ℝ) + (↑t - : ℝ) * (↑y.im : ℝ)) ∈ TileRealization U) ∧ (z ∈ U.cells ∧ w ∈ U.cells → - OpenLatticeEdge x y ⊆ interior (TileRealization U)) ∧ ((∀ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell x j ∈ U.cells) → z ∈ U.cells ∧ w ∈ U.cells)) → ((({x, y} : - Finset GaussianInt) ∉ FootprintEdges T) → ((z ∉ T.cells ∧ w ∉ T.cells) → (∀ (a : - ↥(TilingLattice C)), ∀ (b : ↥(TilingLattice C)), (x ∈ FootprintVertices (P.tile a)) → - ((y ∈ FootprintVertices (P.tile a)) → ((x ∈ FootprintVertices (P.tile b)) → ((y ∈ - FootprintVertices (P.tile b)) → (∀ (v : GaussianInt), (v = x ∨ v = y) → (∃ j : Fin 4, - LatticeVertexIncidentCell v j ∉ T.cells))))))))))))) ) := by - classical - intro C T P x hx y hy hxy hnot z w hform hedgeFacts hedgeT hzwT a b hxa hya hxb hyb v hv - rcases hform with ⟨hor, hw⟩ | ⟨hor, hw⟩ - · rcases hor with ⟨hx0, hy0⟩ | ⟨hy0, hx0⟩ - · rcases hv with rfl | rfl - · refine ⟨1, ?_⟩ - simpa [LatticeVertexIncidentCell, hx0, sub_eq_add_neg] using hzwT.1 - · refine ⟨2, ?_⟩ - simpa [LatticeVertexIncidentCell, hy0, sub_eq_add_neg, add_assoc, - add_comm, add_left_comm] using hzwT.1 - · rcases hv with rfl | rfl - · refine ⟨2, ?_⟩ - simpa [LatticeVertexIncidentCell, hx0, sub_eq_add_neg, add_assoc, - add_comm, add_left_comm] using hzwT.1 - · refine ⟨1, ?_⟩ - simpa [LatticeVertexIncidentCell, hy0, sub_eq_add_neg] using hzwT.1 - · rcases hor with ⟨hx0, hy0⟩ | ⟨hy0, hx0⟩ - · rcases hv with rfl | rfl - · refine ⟨1, ?_⟩ - simpa [LatticeVertexIncidentCell, hx0, hw, sub_eq_add_neg, add_assoc, - add_comm, add_left_comm] using hzwT.2 - · refine ⟨0, ?_⟩ - simpa [LatticeVertexIncidentCell, hy0, hw] using hzwT.2 - · rcases hv with rfl | rfl - · refine ⟨0, ?_⟩ - simpa [LatticeVertexIncidentCell, hx0, hw] using hzwT.2 - · refine ⟨1, ?_⟩ - simpa [LatticeVertexIncidentCell, hy0, hx0, hw, sub_eq_add_neg, add_assoc, - add_comm, add_left_comm] using hzwT.2 +private abbrev incident_of_footprint := + ApollonianSuperharmonic.LatticeFootprintIncidence.incidentCell private theorem hmissingA : (by @@ -220,108 +91,6 @@ private theorem hmissingA : have heq := (hindexed (LatticeVertexIncidentCell v j)).unique hzeroCell hja exact ha0 heq.symm -private theorem hmissingB : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), - (P.tile 0 = T) → ((∀ (x : LatticeCell), ∃! a : ↥(TilingLattice C), x ∈ (P.tile - a).cells) → (∀ (b : ↥(TilingLattice C)), (b ≠ 0) → ((∀ (U : ProtoTile), ∀ (v : - GaussianInt), (U.cells.Nonempty) → ((v ∈ FootprintVertices U) → (∃ j : Fin 4, - LatticeVertexIncidentCell v j ∈ U.cells))) → ((T.cells.Nonempty) → (∀ (v : - GaussianInt), (v ∈ FootprintVertices T) → (∃ j : Fin 4, LatticeVertexIncidentCell v j - ∉ (P.tile b).cells)))))) ) := by - classical - intro C T P hzero hindexed b hb0 incident_of_footprint hTne v hv - obtain ⟨j, hj⟩ := incident_of_footprint T v hTne hv - refine ⟨j, ?_⟩ - intro hjb - have hzeroCell : LatticeVertexIncidentCell v j ∈ (P.tile 0).cells := by - simpa [hzero] using hj - have heq := (hindexed (LatticeVertexIncidentCell v j)).unique hzeroCell hjb - exact hb0 heq.symm - -private theorem hneqxy : - (by - classical - exact - ∀ (C : BandCircle), - ∀ (T : ProtoTile), - ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), - ∀ (x : GaussianInt), - ∀ (y : GaussianInt), - y ∈ FootprintVertices T → - FourNeighborAdjacent x y → - { x, y } ∉ FootprintEdges T → - ∀ (z : GaussianInt), - ∀ (w : GaussianInt), - (x = z + (1 : GaussianInt) ∧ - y = - z + (1 : GaussianInt) + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ - y = z + (1 : GaussianInt) ∧ - x = - z + (1 : GaussianInt) + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∧ - w = z + (1 : GaussianInt) ∨ - (x = - z + (1 : GaussianInt) + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∧ - y = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ - y = - z + (1 : GaussianInt) + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∧ - x = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) ∧ - w = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → - (∀ (U : ProtoTile), - ({ x, y } ∈ FootprintEdges U ↔ - z ∈ U.cells ∨ w ∈ U.cells) ∧ - ({ x, y } ∈ BoundaryFootprintEdges U ↔ - z ∈ U.cells ∧ w ∉ U.cells ∨ z ∉ U.cells ∧ w ∈ U.cells) ∧ - (z ∈ U.cells ∨ w ∈ U.cells → - x ∈ FootprintVertices U ∧ - y ∈ FootprintVertices U ∧ - ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), - (((1 : ℝ) - (↑t : ℝ)) * (↑x.re : ℝ) + - (↑t : ℝ) * (↑y.re : ℝ), - ((1 : ℝ) - (↑t : ℝ)) * (↑x.im : ℝ) + - (↑t : ℝ) * (↑y.im : ℝ)) ∈ - TileRealization U) ∧ - (z ∈ U.cells ∧ w ∈ U.cells → - OpenLatticeEdge x y ⊆ interior (TileRealization U)) ∧ - ((∀ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell x j ∈ U.cells) → - z ∈ U.cells ∧ w ∈ U.cells)) → - ({ x, y } : Finset GaussianInt) ∉ FootprintEdges T → - ∀ (a : ↥(TilingLattice C)), - ∀ (b : ↥(TilingLattice C)), - y ∈ FootprintVertices (P.tile a) → - y ∈ FootprintVertices (P.tile b) → - (∀ (v : GaussianInt), - v = x ∨ v = y → - ∃ j : Fin 4, LatticeVertexIncidentCell v j ∉ T.cells) → - y ∈ BoundaryFootprintVertices (P.tile a) → - y ∈ BoundaryFootprintVertices (P.tile b) → x ≠ y - ) := by - classical - intro C T P x y hy hxy hnot z w hform hedgeFacts hedgeT a b hya hyb hmissT hboundA_y hboundB_y - hxy' - subst y - simp only [FourNeighborAdjacent] at hxy - rcases hxy with h | h | h | h - · have hr := congrArg Zsqrtd.re h - simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr - omega - · have hr := congrArg Zsqrtd.re h - simp only [Zsqrtd.re_sub, Zsqrtd.re_one] at hr - omega - · have hi := congrArg Zsqrtd.im h - simp only [Zsqrtd.im_add] at hi - omega - · have hi := congrArg Zsqrtd.im h - simp only [Zsqrtd.im_sub] at hi - omega - private theorem habEdge : (by classical @@ -380,110 +149,6 @@ private theorem hzeroaEdge : private abbrev hzerobEdge := ApollonianSuperharmonic.MissingEdgeGeometry.hzeroaEdge -private theorem habneq : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), (∀ (u : ↥(TilingLattice C)), ∀ (x : LatticeCell), - ∀ (y : LatticeCell), FourNeighborAdjacent x y → x ∈ BoundaryFootprintVertices - (TileTranslation T (↑u : GaussianInt)) → y ∈ BoundaryFootprintVertices - (TileTranslation T (↑u : GaussianInt)) → ¬OpenLatticeEdge x y ⊆ interior - (TileRealization (TileTranslation T (↑u : GaussianInt)))) → (∀ (P : - PeriodicTileComplex ↥(TilingLattice C)), (∀ (u : ↥(TilingLattice C)), P.tile u = - TileTranslation T (↑u : GaussianInt)) → (∀ (x : GaussianInt), ∀ (y : GaussianInt), - (FourNeighborAdjacent x y) → (∀ (z : GaussianInt), ∀ (w : GaussianInt), ((x = z + (1 - : GaussianInt) ∧ y = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = - z + (1 : GaussianInt) ∧ x = z + (1 : GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt)) ∧ w = z + (1 : GaussianInt) ∨ (x = z + (1 : GaussianInt) + (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt) ∧ y = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = z + (1 : - GaussianInt) + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∧ x = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt)) ∧ w = z + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt)) → ((∀ (U : ProtoTile), - ({x, y} ∈ FootprintEdges U ↔ z ∈ U.cells ∨ w ∈ U.cells) ∧ ({x, y} ∈ - BoundaryFootprintEdges U ↔ z ∈ U.cells ∧ w ∉ U.cells ∨ z ∉ U.cells ∧ w ∈ U.cells) ∧ - (z ∈ U.cells ∨ w ∈ U.cells → x ∈ FootprintVertices U ∧ y ∈ FootprintVertices U ∧ ∀ (t - : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), (((1 : ℝ) - (↑t : ℝ)) * (↑x.re : ℝ) + (↑t : - ℝ) * (↑y.re : ℝ), ((1 : ℝ) - (↑t : ℝ)) * (↑x.im : ℝ) + (↑t : ℝ) * (↑y.im : ℝ)) ∈ - TileRealization U) ∧ (z ∈ U.cells ∧ w ∈ U.cells → OpenLatticeEdge x y ⊆ interior - (TileRealization U)) ∧ ((∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell x j ∈ - U.cells) → z ∈ U.cells ∧ w ∈ U.cells)) → ((z ∉ T.cells ∧ w ∉ T.cells) → (∀ (a : - ↥(TilingLattice C)), (z ∈ (P.tile a).cells) → (∀ (b : ↥(TilingLattice C)), (w ∈ - (P.tile b).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => w - ∈ (P.tile a).cells) y → y = b) → ((b ≠ 0) → ((w ∈ (P.tile b).cells) → ((x ∈ - FootprintVertices (P.tile b)) → ((y ∈ FootprintVertices (P.tile b)) → (((P.tile - b).cells.Nonempty) → ((∀ (v : GaussianInt), (v ∈ FootprintVertices T) → (∃ j : Fin 4, - LatticeVertexIncidentCell v j ∉ (P.tile b).cells)) → ((x ∈ BoundaryFootprintVertices - (P.tile a)) → ((y ∈ BoundaryFootprintVertices (P.tile a)) → ((x ∈ - BoundaryFootprintVertices (P.tile b)) → ((y ∈ BoundaryFootprintVertices (P.tile b)) → - (((FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty) → - (((FootprintEdges (P.tile 0) ∩ FootprintEdges (P.tile b)).Nonempty) → (a ≠ - b))))))))))))))))))))) ) := by - classical - intro C T hnochord P htile x y hxy z w hform hedgeFacts hzwT a ha b hb hbuniq hb0 hwb hxb hyb - hnonemptyB hmissingB hboundA_x hboundA_y hboundB_x hboundB_y habEdge hzerobEdge heq - subst b - have hboth : z ∈ (P.tile a).cells ∧ w ∈ (P.tile a).cells := ⟨ha, hb⟩ - have hzw : z ≠ w := by - rcases hform with ⟨_, rfl⟩ | ⟨_, rfl⟩ - · intro hh - have hr := congrArg Zsqrtd.re hh - norm_num at hr - · intro hh - have hi := congrArg Zsqrtd.im hh - norm_num at hi - have hsingleZ : ({x, y} : Finset GaussianInt) ∈ - FootprintEdges (⟨{z}, z⟩ : ProtoTile) := by - exact (hedgeFacts (⟨{z}, z⟩ : ProtoTile)).1.mpr (Or.inl (by simp)) - have hsingleW : ({x, y} : Finset GaussianInt) ∈ - FootprintEdges (⟨{w}, w⟩ : ProtoTile) := by - exact (hedgeFacts (⟨{w}, w⟩ : ProtoTile)).1.mpr (Or.inr (by simp)) - have hinside := (P4456T2EdgeInterior (P.tile a) x y z w hxy hzw - hsingleZ hsingleW).2 hboth - have hchord := hnochord a x y hxy - (by simpa [htile] using hboundA_x) - (by simpa [htile] using hboundA_y) - have hinside' : OpenLatticeEdge x y ⊆ - interior (TileRealization (TileTranslation T (a : GaussianInt))) := by - simpa [htile] using hinside - exact hchord hinside' - -private theorem hxcommon : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ - (x : GaussianInt), (x ∈ FootprintVertices T) → (∀ (y : GaussianInt), (P.tile 0 = T) → - (∀ (a : ↥(TilingLattice C)), ∀ (b : ↥(TilingLattice C)), (∀ (U : ProtoTile), ∀ (v : - GaussianInt), (U.cells.Nonempty) → ((v ∈ FootprintVertices U) → (∃ j : Fin 4, - LatticeVertexIncidentCell v j ∈ U.cells))) → ((T.cells.Nonempty) → ((∀ (v : - GaussianInt), (v = x ∨ v = y) → (∃ j : Fin 4, LatticeVertexIncidentCell v j ∉ - T.cells)) → ((x ∈ BoundaryFootprintVertices (P.tile a)) → ((x ∈ - BoundaryFootprintVertices (P.tile b)) → (x ∈ BoundaryFootprintVertices (P.tile 0) ∧ x - ∈ BoundaryFootprintVertices (P.tile a) ∧ x ∈ BoundaryFootprintVertices (P.tile - b)))))))) ) := by - classical - intro C T P x hx y hzero a b incident_of_footprint hTne hmissT hboundA_x hboundB_x - exact ⟨by simpa [hzero] using (P3161T2IncidentBoundary T x - (incident_of_footprint T x hTne hx) (hmissT x (Or.inl rfl))), hboundA_x, hboundB_x⟩ - -private theorem hycommon : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ - (x : GaussianInt), ∀ (y : GaussianInt), (y ∈ FootprintVertices T) → ((P.tile 0 = T) → - (∀ (a : ↥(TilingLattice C)), ∀ (b : ↥(TilingLattice C)), (∀ (U : ProtoTile), ∀ (v : - GaussianInt), (U.cells.Nonempty) → ((v ∈ FootprintVertices U) → (∃ j : Fin 4, - LatticeVertexIncidentCell v j ∈ U.cells))) → ((T.cells.Nonempty) → ((∀ (v : - GaussianInt), (v = x ∨ v = y) → (∃ j : Fin 4, LatticeVertexIncidentCell v j ∉ - T.cells)) → ((y ∈ BoundaryFootprintVertices (P.tile a)) → ((y ∈ - BoundaryFootprintVertices (P.tile b)) → (y ∈ BoundaryFootprintVertices (P.tile 0) ∧ y - ∈ BoundaryFootprintVertices (P.tile a) ∧ y ∈ BoundaryFootprintVertices (P.tile - b)))))))) ) := by - classical - intro C T P x y hy hzero a b incident_of_footprint hTne hmissT hboundA_y hboundB_y - exact ⟨by simpa [hzero] using (P3161T2IncidentBoundary T y - (incident_of_footprint T y hTne hy) (hmissT y (Or.inr rfl))), hboundA_y, hboundB_y⟩ - end MissingEdgeGeometry theorem P4456T2MissingEdge (C : BandCircle) @@ -513,17 +178,23 @@ theorem P4456T2MissingEdge (C : BandCircle) classical intro x hx y hy hxy by_contra hnot - have hzero : P.tile 0 = T := MissingEdgeGeometry.hzero C q T hT hnochord P htile chart x hx y - hy hnot + have hzero : P.tile 0 = T := by + rw [htile 0] + exact TileTranslationProperties.zero T have hindexed := PeriodicTileIndexedMultiplicityOne P obtain ⟨z, w, hform⟩ := (P4397T1UnitEdgeCells.1 x y hxy) have hedgeFacts := P4397T1UnitEdgeCells.2 x y z w hform have hedgeT : ({x, y} : Finset GaussianInt) ∉ FootprintEdges T := hnot have hzwT : z ∉ T.cells ∧ w ∉ T.cells := MissingEdgeGeometry.hzwT T x y z w hedgeFacts hedgeT - obtain ⟨a, ha, hauniq⟩ := hindexed z - obtain ⟨b, hb, hbuniq⟩ := hindexed w - have ha0 : a ≠ 0 := MissingEdgeGeometry.ha0 C T P hzero z w hzwT a ha hauniq - have hb0 : b ≠ 0 := MissingEdgeGeometry.hb0 C T P hzero z w hzwT b hb hbuniq + obtain ⟨a, ha, _⟩ := hindexed z + obtain ⟨b, hb, _⟩ := hindexed w + have notZeroOfCell (u : TilingLattice C) (c : GaussianInt) + (hnot : c ∉ T.cells) (hmem : c ∈ (P.tile u).cells) : u ≠ 0 := by + intro heq + subst u + exact hnot (by simpa [hzero] using hmem) + have ha0 : a ≠ 0 := notZeroOfCell a z hzwT.1 ha + have hb0 : b ≠ 0 := notZeroOfCell b w hzwT.2 hb have hza : z ∈ (P.tile a).cells := ha have hwb : w ∈ (P.tile b).cells := hb have hxa : x ∈ FootprintVertices (P.tile a) := by @@ -540,16 +211,42 @@ theorem P4456T2MissingEdge (C : BandCircle) MissingEdgeGeometry.incident_of_footprint U v hne hv have hnonemptyA : (P.tile a).cells.Nonempty := ⟨z, ha⟩ have hnonemptyB : (P.tile b).cells.Nonempty := ⟨w, hb⟩ - have hTne : T.cells.Nonempty := MissingEdgeGeometry.hTne q hq T hT hlarge + have hTne : T.cells.Nonempty := BandPrototileNonempty.positive (q 0) T (by omega) hT have hmissT (v : GaussianInt) (hv : v = x ∨ v = y) : - ∃ j : Fin 4, LatticeVertexIncidentCell v j ∉ T.cells := MissingEdgeGeometry.hmissT C T P x - hx y hy hxy hnot z w hform hedgeFacts hedgeT hzwT a b hxa hya hxb hyb v hv + ∃ j : Fin 4, LatticeVertexIncidentCell v j ∉ T.cells := by + rcases hform with ⟨hor, hw⟩ | ⟨hor, hw⟩ + · rcases hor with ⟨hx0, hy0⟩ | ⟨hy0, hx0⟩ + · rcases hv with rfl | rfl + · refine ⟨1, ?_⟩ + simpa [LatticeVertexIncidentCell, hx0, sub_eq_add_neg] using hzwT.1 + · refine ⟨2, ?_⟩ + simpa [LatticeVertexIncidentCell, hy0, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hzwT.1 + · rcases hv with rfl | rfl + · refine ⟨2, ?_⟩ + simpa [LatticeVertexIncidentCell, hx0, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hzwT.1 + · refine ⟨1, ?_⟩ + simpa [LatticeVertexIncidentCell, hy0, sub_eq_add_neg] using hzwT.1 + · rcases hor with ⟨hx0, hy0⟩ | ⟨hy0, hx0⟩ + · rcases hv with rfl | rfl + · refine ⟨1, ?_⟩ + simpa [LatticeVertexIncidentCell, hx0, hw, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hzwT.2 + · refine ⟨0, ?_⟩ + simpa [LatticeVertexIncidentCell, hy0, hw] using hzwT.2 + · rcases hv with rfl | rfl + · refine ⟨0, ?_⟩ + simpa [LatticeVertexIncidentCell, hx0, hw] using hzwT.2 + · refine ⟨1, ?_⟩ + simpa [LatticeVertexIncidentCell, hy0, hx0, hw, sub_eq_add_neg, add_assoc, + add_comm, add_left_comm] using hzwT.2 have hmissingA (v : GaussianInt) (hv : v ∈ FootprintVertices T) : ∃ j : Fin 4, LatticeVertexIncidentCell v j ∉ (P.tile a).cells := MissingEdgeGeometry.hmissingA C T P hzero hindexed a ha0 incident_of_footprint hTne v hv have hmissingB (v : GaussianInt) (hv : v ∈ FootprintVertices T) : ∃ j : Fin 4, LatticeVertexIncidentCell v j ∉ (P.tile b).cells := - MissingEdgeGeometry.hmissingB C T P hzero hindexed b hb0 incident_of_footprint hTne v hv + MissingEdgeGeometry.hmissingA C T P hzero hindexed b hb0 incident_of_footprint hTne v hv have hboundA_x : x ∈ BoundaryFootprintVertices (P.tile a) := P3161T2IncidentBoundary (P.tile a) x (incident_of_footprint (P.tile a) x hnonemptyA hxa) (hmissingA x hx) @@ -562,8 +259,7 @@ theorem P4456T2MissingEdge (C : BandCircle) have hboundB_y : y ∈ BoundaryFootprintVertices (P.tile b) := P3161T2IncidentBoundary (P.tile b) y (incident_of_footprint (P.tile b) y hnonemptyB hyb) (hmissingB y hy) - have hneqxy : x ≠ y := MissingEdgeGeometry.hneqxy C T P x y hy hxy hnot z w hform hedgeFacts - hedgeT a b hya hyb hmissT hboundA_y hboundB_y + have hneqxy : x ≠ y := MissingEdgeGeometry.adjacent_ne x y hxy have hclass := (PeriodicTileIntersectionClassification P).1 have habEdge : (FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty := MissingEdgeGeometry.habEdge C P x y z w hedgeFacts a b hza hwb @@ -571,9 +267,33 @@ theorem P4456T2MissingEdge (C : BandCircle) MissingEdgeGeometry.hzeroaEdge C T P x hx y hy hzero a ha0 hxa hya hneqxy hclass have hzerobEdge : (FootprintEdges (P.tile 0) ∩ FootprintEdges (P.tile b)).Nonempty := MissingEdgeGeometry.hzerobEdge C T P x hx y hy hzero b hb0 hxb hyb hneqxy hclass - have habneq : a ≠ b := MissingEdgeGeometry.habneq C T hnochord P htile x y hxy z w hform - hedgeFacts hzwT a ha b hb hbuniq hb0 hwb hxb hyb hnonemptyB hmissingB hboundA_x hboundA_y - hboundB_x hboundB_y habEdge hzerobEdge + have habneq : a ≠ b := by + intro heq + subst b + have hboth : z ∈ (P.tile a).cells ∧ w ∈ (P.tile a).cells := ⟨ha, hb⟩ + have hzw : z ≠ w := by + rcases hform with ⟨_, rfl⟩ | ⟨_, rfl⟩ + · intro hh + have hr := congrArg Zsqrtd.re hh + norm_num at hr + · intro hh + have hi := congrArg Zsqrtd.im hh + norm_num at hi + have hsingleZ : ({x, y} : Finset GaussianInt) ∈ + FootprintEdges (⟨{z}, z⟩ : ProtoTile) := by + exact (hedgeFacts (⟨{z}, z⟩ : ProtoTile)).1.mpr (Or.inl (by simp)) + have hsingleW : ({x, y} : Finset GaussianInt) ∈ + FootprintEdges (⟨{w}, w⟩ : ProtoTile) := by + exact (hedgeFacts (⟨{w}, w⟩ : ProtoTile)).1.mpr (Or.inr (by simp)) + have hinside := (P4456T2EdgeInterior (P.tile a) x y z w hxy hzw + hsingleZ hsingleW).2 hboth + have hchord := hnochord a x y hxy + (by simpa [htile] using hboundA_x) + (by simpa [htile] using hboundA_y) + have hinside' : OpenLatticeEdge x y ⊆ + interior (TileRealization (TileTranslation T (a : GaussianInt))) := by + simpa [htile] using hinside + exact hchord hinside' have habAdj : P.plane.adjacent a b := (hclass a b habneq).1.mp habEdge have h0aAdj : P.plane.adjacent 0 a := (hclass 0 a (Ne.symm ha0)).1.mp hzeroaEdge @@ -584,12 +304,14 @@ theorem P4456T2MissingEdge (C : BandCircle) obtain ⟨_, _, _, v, hv, hvuniq⟩ := htriple have hxcommon : x ∈ BoundaryFootprintVertices (P.tile 0) ∧ x ∈ BoundaryFootprintVertices (P.tile a) ∧ x ∈ BoundaryFootprintVertices (P.tile b) := - MissingEdgeGeometry.hxcommon C T P x hx y hzero a b incident_of_footprint hTne hmissT - hboundA_x hboundB_x + ⟨by simpa [hzero] using (P3161T2IncidentBoundary T x + (incident_of_footprint T x hTne hx) (hmissT x (Or.inl rfl))), + hboundA_x, hboundB_x⟩ have hycommon : y ∈ BoundaryFootprintVertices (P.tile 0) ∧ y ∈ BoundaryFootprintVertices (P.tile a) ∧ y ∈ BoundaryFootprintVertices (P.tile b) := - MissingEdgeGeometry.hycommon C T P x y hy hzero a b incident_of_footprint hTne hmissT - hboundA_y hboundB_y + ⟨by simpa [hzero] using (P3161T2IncidentBoundary T y + (incident_of_footprint T y hTne hy) (hmissT y (Or.inr rfl))), + hboundA_y, hboundB_y⟩ have hvx := hvuniq x hxcommon have hvy := hvuniq y hycommon exact hneqxy (hvx.trans hvy.symm) diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean b/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean index 686d9e7bea..0537983d21 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties +public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership public import LeanPool.ApollonianSuperharmonic.BandLayoutCentroidCoordinates public import LeanPool.ApollonianSuperharmonic.TileHalfTurnGeometry @@ -71,34 +73,6 @@ private theorem hsub : private abbrev ht := BandLayoutCentroidCoordinates.doubledCenter -private theorem hcenter : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (z : GaussianInt), z ∈ U.cells ↔ ((z.re : Real) + 1 / 2, (z.im : - Real) + 1 / 2) ∈ TileRealization U ) := by - classical - intro U z - constructor - · intro hz - simp only [TileRealization, Set.mem_iUnion] - refine ⟨z, hz, ?_⟩ - norm_num [ClosedSquareRealization, Set.mem_Icc] - · intro hp - simp only [TileRealization, Set.mem_iUnion] at hp - obtain ⟨b, hb, hbox⟩ := hp - simp only [ClosedSquareRealization, Set.mem_Icc] at hbox - have hr₁ : b.re < z.re + 1 := by - exact_mod_cast (show (b.re : Real) < (z.re : Real) + 1 by linarith [hbox.1.1]) - have hr₂ : z.re < b.re + 1 := by - exact_mod_cast (show (z.re : Real) < (b.re : Real) + 1 by linarith [hbox.2.1]) - have hi₁ : b.im < z.im + 1 := by - exact_mod_cast (show (b.im : Real) < (z.im : Real) + 1 by linarith [hbox.1.2]) - have hi₂ : z.im < b.im + 1 := by - exact_mod_cast (show (z.im : Real) < (b.im : Real) + 1 by linarith [hbox.2.2]) - have hbz : b = z := by apply Zsqrtd.ext <;> omega - exact hbz ▸ hb - private theorem hHsigned : (by classical @@ -266,18 +240,7 @@ private theorem chord_vertex : have hU := P4397T1UnitEdgeCells.2 x y z z' hform U exact (hU.2.2.1 (hU.1.mp heU)).1 -private theorem trans0 : - (by - classical - exact - ∀ U : ProtoTile, TileTranslation U 0 = U ) := by - classical - intro U - have hz : GaussianTranslation (0 : GaussianInt) = id := by - funext z - exact add_zero z - cases U - simp [TileTranslation, hz] +private abbrev trans0 := ApollonianSuperharmonic.TileTranslationProperties.zero private theorem hOparents : (by @@ -541,7 +504,9 @@ theorem P4456T2OrderedNoChord have htau := TileHalfTurnGeometry.involutive q u have hHcells := TileHalfTurnGeometry.cells q u have hHreal := TileHalfTurnGeometry.realization q T u ht - have hcenter := OrderedNoChordGeometry.hcenter + have hcenter (U : ProtoTile) (z : GaussianInt) : + z ∈ U.cells ↔ ((z.re : Real) + 1 / 2, (z.im : Real) + 1 / 2) ∈ TileRealization U := by + simpa [GaussianRealPoint] using (P3776T1CellCenterMembership U z).symm have hHsigned := OrderedNoChordGeometry.hHsigned q cfg C T layout u htau hHcells hHreal hcenter have touch_flip := OrderedNoChordGeometry.touch_flip q cfg C T layout hne u hHsigned have touch_sym := OrderedNoChordGeometry.touch_sym diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2VertexInterior.lean b/LeanPool/ApollonianSuperharmonic/P4456T2VertexInterior.lean index 6260f8a037..a61727699a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2VertexInterior.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2VertexInterior.lean @@ -39,19 +39,24 @@ namespace ApollonianSuperharmonic namespace VertexInteriorLemmas private theorem hsector : - ∀ (T : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin (4 : ℕ)), (LatticeVertexIncidentCell x j ∉ - T.cells) → ∀ (ε : ℝ), - let δ : ℝ := min ε 1 / 4 - (0 < δ) → (δ < 1) → - let X : ℝ := (x.re : Int) - let Y : ℝ := (x.im : Int) - let Q : Fin 4 → ℝ × ℝ := fun k => - if k = 0 then (X + δ, Y + δ) else - if k = 1 then (X - δ, Y + δ) else - if k = 2 then (X - δ, Y - δ) else (X + δ, Y - δ) - (∀ (k : Fin 4), Q k ∈ TileRealization T) → LatticeVertexIncidentCell x j ∈ T.cells := by + ∀ (T : ProtoTile), + ∀ (x : GaussianInt), + ∀ (j : Fin (4 : ℕ)), + ∀ (ε : ℝ), + let δ : ℝ := min ε 1 / 4 + 0 < δ → + δ < 1 → + let X : ℝ := (x.re : Int) + let Y : ℝ := (x.im : Int) + let Q : Fin 4 → ℝ × ℝ := fun k => + if k = 0 then (X + δ, Y + δ) + else + if k = 1 then (X - δ, Y + δ) + else if k = 2 then (X - δ, Y - δ) else (X + δ, Y - δ) + (∀ (k : Fin 4), Q k ∈ TileRealization T) → + LatticeVertexIncidentCell x j ∈ T.cells := by classical - intro T x j hnot ε δ hδpos hδone X Y Q hQreal + intro T x j ε δ hδpos hδone X Y Q hQreal -- Square membership in the corresponding open quadrant forces its base. fin_cases j · have hq := hQreal 0 @@ -260,7 +265,7 @@ theorem P4456T2VertexInterior (T : ProtoTile) (hne : T.cells.Nonempty) Fin.zero_eta] <;> exact hδeps have hQreal (k : Fin 4) : Q k ∈ TileRealization T := hsub (hQball k) have hsector : LatticeVertexIncidentCell x j ∈ T.cells := VertexInteriorLemmas.hsector T x - j hnot ε hδpos hδone hQreal + j ε hδpos hδone hQreal exact hnot hsector · intro hall have h0 : x ∈ T.cells := by diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean index d0d57b98b8..e0e3a2040a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1FirstProperRows.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.BoundaryFrameJoinGeometry public import LeanPool.ApollonianSuperharmonic.BandPrototileCentroidUnique @@ -1020,20 +1021,7 @@ private theorem hrightAdjacent : · rw [← hxIm] exact congrArg Prod.snd hplusSlope -private theorem pointInjective : - (by - classical - exact - Function.Injective GaussianRealPoint ) := by - classical - intro a b hab - apply Zsqrtd.ext - · have h := congrArg Prod.fst hab - change (a.re : ℝ) = (b.re : ℝ) at h - exact_mod_cast h - · have h := congrArg Prod.snd hab - change (a.im : ℝ) = (b.im : ℝ) at h - exact_mod_cast h +private abbrev pointInjective := ApollonianSuperharmonic.GaussianRealPointProperties.injective end FirstProperRowDetails diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean index 601949c014..17e2ea0eae 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean @@ -1343,144 +1343,32 @@ private theorem leftString : (by classical exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (p : Fin 4 → CircleCoordinates), (![F.q (0 : Fin (4 - : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin - (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : - ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : - GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 - + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin - (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ((F.q F.slot.succ = p 0) → - ((F.q ((F.slot + 1).succ) = p 2) → ((F.q ((F.slot + 2).succ) = p 3) → ((F.q 0 = (2 * - (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p - 3).2 - (p 1).2)) → ((0 < (F.q F.slot.succ).1) → (((F.q F.slot.succ).1 < (F.q 0).1) → - ((AncestorOdometer (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) F.tile - (D.functions F.slot false) - F.odometer) → ((TileOdometer (F.q F.slot.succ) (D.tiles F.slot false) (D.functions - F.slot false)) → ((∃ s, PartialOdometerSlope (D.functions F.slot false) = some s) → ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - (ProperBandQuadruple r) → ((r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * - (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → ((r 1 = p 0) → ((r - 2 = p 2) → ((r 3 = p 3) → ( - let I : GaussianInt := ⟨0, 1⟩ - let w : GaussianInt := BandVectors.1 (r 3) (r 2) - let x : GaussianInt := BandVectors.1 (r 1) (r 3) - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - let wa : GaussianInt := BandVectors.2 (r 3) (r 2) - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - let ya : GaussianInt := BandVectors.2 (r 2) (r 1) - (w + x + y = 0) → ((wa + xa + ya = 0) → ((BandVectors.1 (r 1) (r 0) = x - I * y) → - ((BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.1 (r 0) (r 1) = I * - BandVectors.1 (r 1) (r 0)) → ((BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) - (r 0)) → ((BandPrototile (F.q F.slot.succ) (D.tiles F.slot false)) → - ((FootprintVertices (D.tiles F.slot false) ⊆ FootprintVertices F.tile) → - ((TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then - (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot - + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - - (-(GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q - (F.slot + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q - (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → - ((TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • - (GaussianRealPoint w - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) → - ((TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → ((w.re + x.re + y.re = 0) - → ((w.im + x.im + y.im = 0) → ((-w + I * w - BandVectors.1 (r 1) (r 0) + - BandVectors.1 (r 0) (r 1) = 2 * y) → (((↑(-w + I * w - BandVectors.1 (r (1 : Fin (4 : - ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : - ℕ)))).re : ℝ) = (↑((2 : GaussianInt) * y).re : ℝ)) → (((↑(-w + I * w - BandVectors.1 - (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r - (1 : Fin (4 : ℕ)))).im : ℝ) = (↑((2 : GaussianInt) * y).im : ℝ)) → ((TileCentroid - (D.tiles F.slot false) - TileCentroid Rminus = GaussianRealPoint y) → ((r 1 = C.1.1) - → ((y ∈ TilingLattice C) → (∀ (u : ↥(TilingLattice C)), (Rminus = TileTranslation - base (↑u : GaussianInt)) → ((∀ (y : ↥(TilingLattice C)), (fun (u : ↥(TilingLattice - C)) => Rminus = TileTranslation base (↑u : GaussianInt)) y → y = u) → ( - let join : ProtoTile := TileTranslation base (u + y) - (join = TileTranslation Rminus y) → ((BandPrototile C.1.1 join) → ((join ∈ - RegularTileFamily base (TilingLattice C)) → ((TileCentroid join = TileCentroid Rminus - + GaussianRealPoint y) → ((TileCentroid (D.tiles F.slot false) = TileCentroid join) → - ((BandPrototile C.1.1 (D.tiles F.slot false)) → (((D.tiles F.slot false).cells = - join.cells ∧ ((D.tiles F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = - join.anchor)) → ((TileOdometer C.1.1 join (D.functions F.slot false)) → - ((AncestorOdometer C.1.1 F.outer.1.1 join F.tile (D.functions F.slot false) - F.odometer) → (((D.tiles F.slot false).cells.Nonempty) → ((join.cells.Nonempty) → - ((FootprintVertices join = FootprintVertices (D.tiles F.slot false)) → - ((FootprintVertices join ⊆ FootprintVertices F.tile) → ((BandSubtileOccurrence F.q - F.tile F.slot false join) → ((BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1) + - w - I * w = 2 * I * x) → ((TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • - GaussianRealPoint (BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1))) → - ((TileCentroid Rplus - TileCentroid join = GaussianRealPoint (I * x)) → (∀ (rootSlope - : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (PartialOdometerSlope F.odometer = some rootSlope) → - ((PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → ((joinSlope.1 - - rootSlope.1 = -(1 / 2 : ℝ) * ((↑wa.re : ℝ) - (↑wa.im : ℝ))) → ((joinSlope.2 - - rootSlope.2 = -(1 / 2 : ℝ) * ((↑wa.im : ℝ) + (↑wa.re : ℝ))) → ((rootSlope = - F.outerSlope) → ((joinSlope - rootSlope = (-(1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ) + (1 / 2 - : ℝ) * ((wa.im : ℤ) : ℝ), -(1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - (1 / 2 : ℝ) * ((wa.re : - ℤ) : ℝ))) → ((F.minusSlope - F.outerSlope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex - (BandVectors.2 (r 1) (r 0))).re - (GaussianInt.toComplex (BandVectors.2 (r 0) (r - 1))).re), (1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - - (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im))) → ((F.plusSlope - - F.outerSlope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r - 0))).re + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) * - ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im + (GaussianInt.toComplex - (BandVectors.2 (r 0) (r 1))).im))) → ((wa.re + xa.re + ya.re = 0) → ((wa.im + xa.im + - ya.im = 0) → (((BandVectors.2 (r 1) (r 0)).re = xa.re - ya.im) → (((BandVectors.2 (r - 1) (r 0)).im = xa.im + ya.re) → (((BandVectors.2 (r 0) (r 1)).re = xa.im + ya.re) → - (((BandVectors.2 (r 0) (r 1)).im = -xa.re + ya.im) → ((-(1 + I) * wa - BandVectors.2 - (r 1) (r 0) + BandVectors.2 (r 0) (r 1) = 2 * ya) → (((1 - I) * BandVectors.2 (r 1) - (r 0) + (1 + I) * wa = -2 * I * xa) → (((GaussianInt.toComplex (BandVectors.2 (r 1) - (r 0))).re = (GaussianInt.toComplex xa).re - (GaussianInt.toComplex ya).im) → - (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im = (GaussianInt.toComplex - xa).im + (GaussianInt.toComplex ya).re) → (((GaussianInt.toComplex (BandVectors.2 (r - 0) (r 1))).re = (GaussianInt.toComplex xa).im + (GaussianInt.toComplex ya).re) → - (((GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im = -(GaussianInt.toComplex - xa).re + (GaussianInt.toComplex ya).im) → (((GaussianInt.toComplex wa).re + - (GaussianInt.toComplex xa).re + (GaussianInt.toComplex ya).re = 0) → - (((GaussianInt.toComplex wa).im + (GaussianInt.toComplex xa).im + - (GaussianInt.toComplex ya).im = 0) → (((((1 : GaussianInt) - I) * BandVectors.2 (r (1 - : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + ((1 : GaussianInt) + I) * wa).re = ((-2 : - GaussianInt) * I * xa).re) → (((((1 : GaussianInt) - I) * BandVectors.2 (r (1 : Fin - (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + ((1 : GaussianInt) + I) * wa).im = ((-2 : - GaussianInt) * I * xa).im) → (((BandVectors.2 (r 1) (r 0)).re + (BandVectors.2 (r 1) - (r 0)).im + wa.re - wa.im = 2 * xa.im) → (((BandVectors.2 (r 1) (r 0)).im - - (BandVectors.2 (r 1) (r 0)).re + wa.im + wa.re = -2 * xa.re) → - (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex - (BandVectors.2 (r 1) (r 0))).im + (GaussianInt.toComplex wa).re - - (GaussianInt.toComplex wa).im = 2 * (GaussianInt.toComplex xa).im) → - (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - (GaussianInt.toComplex - (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex wa).im + - (GaussianInt.toComplex wa).re = -2 * (GaussianInt.toComplex xa).re) → ((joinSlope - - F.minusSlope = GaussianRealPoint ya) → ((F.plusSlope - joinSlope = - GaussianRealPoint (-I * xa)) → ((y = BandVectors.1 (p 2) (p 0)) → ((x = BandVectors.1 - (p 0) (p 3)) → ((xa = BandVectors.2 (p 0) (p 3)) → ((ya = BandVectors.2 (p 2) (p 0)) - → ((TileCentroid join - TileCentroid Rminus = GaussianRealPoint y) → ((TileTouching - Rminus join) → ((TileTouching join Rplus) → ((joinSlope - F.minusSlope = - GaussianRealPoint ya) → ((joinSlope.1 - F.minusSlope.1 = (ya.re : ℝ)) → - ((joinSlope.2 - F.minusSlope.2 = (ya.im : ℝ)) → ((LeftLatticeAdjacent C Rminus join - hminus (D.functions F.slot false)) → ((F.plusSlope - joinSlope = GaussianRealPoint - (-I * xa)) → ((F.plusSlope.1 - joinSlope.1 = ((-I * xa).re : ℝ)) → ((F.plusSlope.2 - - joinSlope.2 = ((-I * xa).im : ℝ)) → ((LeftLatticeAdjacent C join Rplus (D.functions - F.slot false) hplus) → ((Rminus.cells.Nonempty) → ((Rminus ≠ join) → ((join ≠ Rplus) - → ((C.1.1.1 ≠ 1) → (TileString C orientation base Rminus join [Rminus, - join]))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - ))))))))))))))))))))))))))))) ) := by + ∀ (C : BandCircle), + ∀ (orientation : Bool), + ∀ (base : ProtoTile), + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + ∀ (hminus : PartialOdometer), + ∀ (hplus : PartialOdometer), + ∀ + (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus + hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q (F.slot + 1).succ, + F.q (F.slot + 2).succ]; + let y : GaussianInt := BandVectors.1 (r 2) (r 1); + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y); + join ∈ RegularTileFamily base (TilingLattice C) → + TileTouching Rminus join → + Rminus ≠ join → + C.1.1.1 ≠ 1 → + TileString C orientation base Rminus join [Rminus, join] + ) := by classical - intro C orientation base Rminus Rplus hminus hplus F D p hstep hq1 hq2 hq3 houter hCpositive - hstrict hselectedAnc hselectedOdo hnegativeSlope r hr hrstep hr1 hr2 hr3 I w x y wa xa ya - hvsum hasum hvrec harec hvflip haflip hUband hUfoot hUcent hUcenter hMcenter hvsumRe - hvsumIm hcenterVector hcenterRe hcenterIm hcenter hRparent hyLattice u huRminus - hRminusUnique join hjoin_eq hjoinBand hjoinFamily hjoinCenter hjoinCenterEq hUbandC - hjoinCells hjoinOdo hjoinAncestor hUnonempty hJnonempty hjoinFootEq hjoinFoot - hjoinOccurrence hplusVector hPcenter hPlusJoin rootSlope joinSlope hrootSlope hjoinSlope - hjoinSlopeRe hjoinSlopeIm hrootSlopeEq hDoffset hFminusSlope hFplusSlope hasumRe hasumIm - ha10Re ha10Im ha01Re ha01Im hminusSlopeVector hplusSlopeVector ha10ReC ha10ImC ha01ReC - ha01ImC hsumReC hsumImC hplusVectorRe hplusVectorIm hplusVectorRe' hplusVectorIm' - hplusVectorReC hplusVectorImC hminusSlope hplusSlope hy hx hxa haya hleftCent hleftTouch - hrightTouch hleftSlope hleftSlope1 hleftSlope2 hleftAdjacent hrightSlope hrightSlope1 - hrightSlope2 hrightAdjacent hMnonempty hleftNe hrightNe hnonunit + intro C orientation base Rminus Rplus hminus hplus F r y u join hjoinFamily hleftTouch hleftNe + hnonunit unfold TileString refine ⟨F.base_band, ?_, ?_, ?_, ?_, ?_, ?_⟩ · rfl @@ -1513,143 +1401,32 @@ private theorem rightString : (by classical exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (p : Fin 4 → CircleCoordinates), (![F.q (0 : Fin (4 - : ℕ)), F.q F.slot.succ, F.q (F.slot + (1 : Fin (3 : ℕ))).succ, F.q (F.slot + (2 : Fin - (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : - ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : - GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 - + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin - (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ((F.q F.slot.succ = p 0) → - ((F.q ((F.slot + 1).succ) = p 2) → ((F.q ((F.slot + 2).succ) = p 3) → ((F.q 0 = (2 * - (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p - 3).2 - (p 1).2)) → ((0 < (F.q F.slot.succ).1) → (((F.q F.slot.succ).1 < (F.q 0).1) → - ((AncestorOdometer (F.q F.slot.succ) F.outer.1.1 (D.tiles F.slot false) F.tile - (D.functions F.slot false) - F.odometer) → ((TileOdometer (F.q F.slot.succ) (D.tiles F.slot false) (D.functions - F.slot false)) → ((∃ s, PartialOdometerSlope (D.functions F.slot false) = some s) → ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - (ProperBandQuadruple r) → ((r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * - (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) → ((r 1 = p 0) → ((r - 2 = p 2) → ((r 3 = p 3) → ( - let I : GaussianInt := ⟨0, 1⟩ - let w : GaussianInt := BandVectors.1 (r 3) (r 2) - let x : GaussianInt := BandVectors.1 (r 1) (r 3) - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - let wa : GaussianInt := BandVectors.2 (r 3) (r 2) - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - let ya : GaussianInt := BandVectors.2 (r 2) (r 1) - (w + x + y = 0) → ((wa + xa + ya = 0) → ((BandVectors.1 (r 1) (r 0) = x - I * y) → - ((BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.1 (r 0) (r 1) = I * - BandVectors.1 (r 1) (r 0)) → ((BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) - (r 0)) → ((BandPrototile (F.q F.slot.succ) (D.tiles F.slot false)) → - ((FootprintVertices (D.tiles F.slot false) ⊆ FootprintVertices F.tile) → - ((TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = (if false = true then - (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (F.q (F.slot - + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ)) - - (-(GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q - (F.slot + (1 : Fin (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (F.q - (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → - ((TileCentroid (D.tiles F.slot false) - TileCentroid F.tile = -(1 / 2 : ℝ) • - (GaussianRealPoint w - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) → - ((TileCentroid Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1))) → ((w.re + x.re + y.re = 0) - → ((w.im + x.im + y.im = 0) → ((-w + I * w - BandVectors.1 (r 1) (r 0) + - BandVectors.1 (r 0) (r 1) = 2 * y) → (((↑(-w + I * w - BandVectors.1 (r (1 : Fin (4 : - ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : - ℕ)))).re : ℝ) = (↑((2 : GaussianInt) * y).re : ℝ)) → (((↑(-w + I * w - BandVectors.1 - (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r - (1 : Fin (4 : ℕ)))).im : ℝ) = (↑((2 : GaussianInt) * y).im : ℝ)) → ((TileCentroid - (D.tiles F.slot false) - TileCentroid Rminus = GaussianRealPoint y) → ((r 1 = C.1.1) - → ((y ∈ TilingLattice C) → (∀ (u : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y) - (join = TileTranslation Rminus y) → ((BandPrototile C.1.1 join) → ((join ∈ - RegularTileFamily base (TilingLattice C)) → ((TileCentroid join = TileCentroid Rminus - + GaussianRealPoint y) → ((TileCentroid (D.tiles F.slot false) = TileCentroid join) → - ((BandPrototile C.1.1 (D.tiles F.slot false)) → (((D.tiles F.slot false).cells = - join.cells ∧ ((D.tiles F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = - join.anchor)) → ((TileOdometer C.1.1 join (D.functions F.slot false)) → - ((AncestorOdometer C.1.1 F.outer.1.1 join F.tile (D.functions F.slot false) - F.odometer) → (((D.tiles F.slot false).cells.Nonempty) → ((join.cells.Nonempty) → - ((FootprintVertices join = FootprintVertices (D.tiles F.slot false)) → - ((FootprintVertices join ⊆ FootprintVertices F.tile) → ((BandSubtileOccurrence F.q - F.tile F.slot false join) → ((BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1) + - w - I * w = 2 * I * x) → ((TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • - GaussianRealPoint (BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1))) → - ((TileCentroid Rplus - TileCentroid join = GaussianRealPoint (I * x)) → (∀ (rootSlope - : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (PartialOdometerSlope F.odometer = some rootSlope) → - ((PartialOdometerSlope (D.functions F.slot false) = some joinSlope) → ((joinSlope.1 - - rootSlope.1 = -(1 / 2 : ℝ) * ((↑wa.re : ℝ) - (↑wa.im : ℝ))) → ((joinSlope.2 - - rootSlope.2 = -(1 / 2 : ℝ) * ((↑wa.im : ℝ) + (↑wa.re : ℝ))) → ((rootSlope = - F.outerSlope) → ((joinSlope - rootSlope = (-(1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ) + (1 / 2 - : ℝ) * ((wa.im : ℤ) : ℝ), -(1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ) - (1 / 2 : ℝ) * ((wa.re : - ℤ) : ℝ))) → ((F.minusSlope - F.outerSlope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex - (BandVectors.2 (r 1) (r 0))).re - (GaussianInt.toComplex (BandVectors.2 (r 0) (r - 1))).re), (1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - - (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im))) → ((F.plusSlope - - F.outerSlope = ((1 / 2 : ℝ) * ((GaussianInt.toComplex (BandVectors.2 (r 1) (r - 0))).re + (GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).re), (1 / 2 : ℝ) * - ((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im + (GaussianInt.toComplex - (BandVectors.2 (r 0) (r 1))).im))) → ((wa.re + xa.re + ya.re = 0) → ((wa.im + xa.im + - ya.im = 0) → (((BandVectors.2 (r 1) (r 0)).re = xa.re - ya.im) → (((BandVectors.2 (r - 1) (r 0)).im = xa.im + ya.re) → (((BandVectors.2 (r 0) (r 1)).re = xa.im + ya.re) → - (((BandVectors.2 (r 0) (r 1)).im = -xa.re + ya.im) → ((-(1 + I) * wa - BandVectors.2 - (r 1) (r 0) + BandVectors.2 (r 0) (r 1) = 2 * ya) → (((1 - I) * BandVectors.2 (r 1) - (r 0) + (1 + I) * wa = -2 * I * xa) → (((GaussianInt.toComplex (BandVectors.2 (r 1) - (r 0))).re = (GaussianInt.toComplex xa).re - (GaussianInt.toComplex ya).im) → - (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im = (GaussianInt.toComplex - xa).im + (GaussianInt.toComplex ya).re) → (((GaussianInt.toComplex (BandVectors.2 (r - 0) (r 1))).re = (GaussianInt.toComplex xa).im + (GaussianInt.toComplex ya).re) → - (((GaussianInt.toComplex (BandVectors.2 (r 0) (r 1))).im = -(GaussianInt.toComplex - xa).re + (GaussianInt.toComplex ya).im) → (((GaussianInt.toComplex wa).re + - (GaussianInt.toComplex xa).re + (GaussianInt.toComplex ya).re = 0) → - (((GaussianInt.toComplex wa).im + (GaussianInt.toComplex xa).im + - (GaussianInt.toComplex ya).im = 0) → (((((1 : GaussianInt) - I) * BandVectors.2 (r (1 - : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + ((1 : GaussianInt) + I) * wa).re = ((-2 : - GaussianInt) * I * xa).re) → (((((1 : GaussianInt) - I) * BandVectors.2 (r (1 : Fin - (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + ((1 : GaussianInt) + I) * wa).im = ((-2 : - GaussianInt) * I * xa).im) → (((BandVectors.2 (r 1) (r 0)).re + (BandVectors.2 (r 1) - (r 0)).im + wa.re - wa.im = 2 * xa.im) → (((BandVectors.2 (r 1) (r 0)).im - - (BandVectors.2 (r 1) (r 0)).re + wa.im + wa.re = -2 * xa.re) → - (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex - (BandVectors.2 (r 1) (r 0))).im + (GaussianInt.toComplex wa).re - - (GaussianInt.toComplex wa).im = 2 * (GaussianInt.toComplex xa).im) → - (((GaussianInt.toComplex (BandVectors.2 (r 1) (r 0))).im - (GaussianInt.toComplex - (BandVectors.2 (r 1) (r 0))).re + (GaussianInt.toComplex wa).im + - (GaussianInt.toComplex wa).re = -2 * (GaussianInt.toComplex xa).re) → ((joinSlope - - F.minusSlope = GaussianRealPoint ya) → ((F.plusSlope - joinSlope = - GaussianRealPoint (-I * xa)) → ((y = BandVectors.1 (p 2) (p 0)) → ((x = BandVectors.1 - (p 0) (p 3)) → ((xa = BandVectors.2 (p 0) (p 3)) → ((ya = BandVectors.2 (p 2) (p 0)) - → ((TileCentroid join - TileCentroid Rminus = GaussianRealPoint y) → ((TileTouching - Rminus join) → ((TileTouching join Rplus) → ((joinSlope - F.minusSlope = - GaussianRealPoint ya) → ((joinSlope.1 - F.minusSlope.1 = (ya.re : ℝ)) → - ((joinSlope.2 - F.minusSlope.2 = (ya.im : ℝ)) → ((LeftLatticeAdjacent C Rminus join - hminus (D.functions F.slot false)) → ((F.plusSlope - joinSlope = GaussianRealPoint - (-I * xa)) → ((F.plusSlope.1 - joinSlope.1 = ((-I * xa).re : ℝ)) → ((F.plusSlope.2 - - joinSlope.2 = ((-I * xa).im : ℝ)) → ((LeftLatticeAdjacent C join Rplus (D.functions - F.slot false) hplus) → ((Rplus.cells.Nonempty) → ((Rminus ≠ join) → ((join ≠ Rplus) → - ((C.1.1.1 ≠ 1) → ((TileString C orientation base Rminus join [Rminus, join]) → - (TileString C orientation base join Rplus [join, - Rplus])))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - ))))))))))))))))))))))))))))) ) := by + ∀ (C : BandCircle), + ∀ (orientation : Bool), + ∀ (base : ProtoTile), + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + ∀ (hminus : PartialOdometer), + ∀ (hplus : PartialOdometer), + ∀ + (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus + hplus), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q (F.slot + 1).succ, + F.q (F.slot + 2).succ]; + let y : GaussianInt := BandVectors.1 (r 2) (r 1); + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y); + join ∈ RegularTileFamily base (TilingLattice C) → + TileTouching join Rplus → + join ≠ Rplus → + C.1.1.1 ≠ 1 → + TileString C orientation base join Rplus [join, Rplus] + ) := by classical - intro C orientation base Rminus Rplus hminus hplus F D p hstep hq1 hq2 hq3 houter hCpositive - hstrict hselectedAnc hselectedOdo hnegativeSlope r hr hrstep hr1 hr2 hr3 I w x y wa xa ya - hvsum hasum hvrec harec hvflip haflip hUband hUfoot hUcent hUcenter hMcenter hvsumRe - hvsumIm hcenterVector hcenterRe hcenterIm hcenter hRparent hyLattice u join hjoin_eq - hjoinBand hjoinFamily hjoinCenter hjoinCenterEq hUbandC hjoinCells hjoinOdo hjoinAncestor - hUnonempty hJnonempty hjoinFootEq hjoinFoot hjoinOccurrence hplusVector hPcenter hPlusJoin - rootSlope joinSlope hrootSlope hjoinSlope hjoinSlopeRe hjoinSlopeIm hrootSlopeEq hDoffset - hFminusSlope hFplusSlope hasumRe hasumIm ha10Re ha10Im ha01Re ha01Im hminusSlopeVector - hplusSlopeVector ha10ReC ha10ImC ha01ReC ha01ImC hsumReC hsumImC hplusVectorRe - hplusVectorIm hplusVectorRe' hplusVectorIm' hplusVectorReC hplusVectorImC hminusSlope - hplusSlope hy hx hxa haya hleftCent hleftTouch hrightTouch hleftSlope hleftSlope1 - hleftSlope2 hleftAdjacent hrightSlope hrightSlope1 hrightSlope2 hrightAdjacent hPnonempty - hleftNe hrightNe hnonunit leftString + intro C orientation base Rminus Rplus hminus hplus F r y u join hjoinFamily hrightTouch + hrightNe hnonunit unfold TileString refine ⟨F.base_band, ?_, ?_, ?_, ?_, ?_, ?_⟩ · rfl @@ -2339,33 +2116,11 @@ private theorem largestParentCertificate : u hrightTouch hPnonempty have hnonunit : C.1.1.1 ≠ 1 := by omega have leftString := LargestParentGeometry.leftString C orientation base Rminus Rplus hminus - hplus F D p hstep hq1 hq2 hq3 houter hCpositive hstrict hselectedAnc hselectedOdo - hnegativeSlope hr hrstep hr1 hr2 hr3 hvsum hasum hvrec harec hvflip haflip hUband hUfoot - hUcent hUcenter hMcenter hvsumRe hvsumIm hcenterVector hcenterRe hcenterIm hcenter hRparent - hyLattice u huRminus hRminusUnique hjoin_eq hjoinBand hjoinFamily hjoinCenter hjoinCenterEq - hUbandC hjoinCells hjoinOdo hjoinAncestor hUnonempty hJnonempty hjoinFootEq hjoinFoot - hjoinOccurrence hplusVector hPcenter hPlusJoin rootSlope joinSlope hrootSlope hjoinSlope - hjoinSlopeRe hjoinSlopeIm hrootSlopeEq hDoffset hFminusSlope hFplusSlope hasumRe hasumIm - ha10Re ha10Im ha01Re ha01Im hminusSlopeVector hplusSlopeVector ha10ReC ha10ImC ha01ReC - ha01ImC hsumReC hsumImC hplusVectorRe hplusVectorIm hplusVectorRe' hplusVectorIm' - hplusVectorReC hplusVectorImC hminusSlope hplusSlope hy hx hxa haya hleftCent hleftTouch - hrightTouch hleftSlope hleftSlope1 hleftSlope2 hleftAdjacent hrightSlope hrightSlope1 - hrightSlope2 hrightAdjacent hMnonempty hleftNe hrightNe hnonunit + hplus F u hjoinFamily hleftTouch hleftNe hnonunit refine ⟨⟨join, hjoinCells.1.symm, hjoinOdo, hjoinAncestor, hjoinOccurrence, .direct leftString hleftAdjacent, - .direct (LargestParentGeometry.rightString C orientation base Rminus Rplus hminus hplus F D p - hstep hq1 hq2 hq3 houter hCpositive hstrict hselectedAnc hselectedOdo hnegativeSlope hr - hrstep hr1 hr2 hr3 hvsum hasum hvrec harec hvflip haflip hUband hUfoot hUcent hUcenter - hMcenter hvsumRe hvsumIm hcenterVector hcenterRe hcenterIm hcenter hRparent hyLattice u - hjoin_eq hjoinBand hjoinFamily hjoinCenter hjoinCenterEq hUbandC hjoinCells hjoinOdo - hjoinAncestor hUnonempty hJnonempty hjoinFootEq hjoinFoot hjoinOccurrence hplusVector - hPcenter hPlusJoin rootSlope joinSlope hrootSlope hjoinSlope hjoinSlopeRe hjoinSlopeIm - hrootSlopeEq hDoffset hFminusSlope hFplusSlope hasumRe hasumIm ha10Re ha10Im ha01Re - ha01Im hminusSlopeVector hplusSlopeVector ha10ReC ha10ImC ha01ReC ha01ImC hsumReC hsumImC - hplusVectorRe hplusVectorIm hplusVectorRe' hplusVectorIm' hplusVectorReC hplusVectorImC - hminusSlope hplusSlope hy hx hxa haya hleftCent hleftTouch hrightTouch hleftSlope - hleftSlope1 hleftSlope2 hleftAdjacent hrightSlope hrightSlope1 hrightSlope2 - hrightAdjacent hPnonempty hleftNe hrightNe hnonunit leftString) hrightAdjacent⟩⟩ + .direct (LargestParentGeometry.rightString C orientation base Rminus Rplus hminus hplus F u + hjoinFamily hrightTouch hrightNe hnonunit) hrightAdjacent⟩⟩ end LargestParentConclusion diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean b/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean index 4fea317343..134940460a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1RespectAppend.lean @@ -278,14 +278,17 @@ private theorem hUtail : simpa using hUstart private theorem hUneR : - ∀ (R : ProtoTile), ∀ (S : ProtoTile), ∀ (left : List ProtoTile), ∀ (right : List ProtoTile), - (List.Pairwise (fun (T U : ProtoTile) => T ≠ U) (left.dropLast ++ right)) → (∀ (U : - ProtoTile), (U ∈ (List.drop (1 : ℕ) (left.dropLast ++ right)).dropLast) → ((U ∈ - (left.dropLast ++ right).drop 1) → ((U ∈ left.dropLast ++ right) → ((U ∈ (left.dropLast - ++ right).dropLast) → ((U ≠ S) → ((left.dropLast ++ right = R :: (left.dropLast ++ - right).tail) → ((U ∈ (left.dropLast ++ right).tail) → (U ≠ R)))))))) := by + ∀ (R : ProtoTile), + ∀ (S : ProtoTile), + ∀ (left : List ProtoTile), + ∀ (right : List ProtoTile), + List.Pairwise (fun (T U : ProtoTile) => T ≠ U) (left.dropLast ++ right) → + ∀ (U : ProtoTile), + U ≠ S → + left.dropLast ++ right = R :: (left.dropLast ++ right).tail → + U ∈ (left.dropLast ++ right).tail → U ≠ R := by classical - intro R S left right hcatPairwise U hU hUstart hUall hUdropLast hUneS hshape hUtail he + intro R S left right hcatPairwise U hUneS hshape hUtail he subst U have hnot : R ∉ (left.dropLast ++ right).tail := by rw [hshape] at hcatPairwise @@ -480,8 +483,7 @@ theorem P4458T1RespectAppend RespectAppendDetails.hshape R left right hcatHead have hUtail : U ∈ (left.dropLast ++ right).tail := RespectAppendDetails.hUtail R left right U hUstart hshape - have hUneR : U ≠ R := RespectAppendDetails.hUneR R S left right hcatPairwise U hU hUstart hUall - hUdropLast hUneS hshape hUtail + have hUneR : U ≠ R := RespectAppendDetails.hUneR R S left right hcatPairwise U hUneS hshape hUtail rcases List.mem_append.mp hUall with hUL | hUR · have hUneJ : U ≠ J := RespectAppendDetails.hUneJ J left right hdisj hJmem U hUL cases left with diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean index 1253a696fa..deb79fb5c1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean @@ -1087,235 +1087,92 @@ private theorem leftString : (by classical exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin (3 : ℕ)), ∀ (p : Fin (4 : ℕ) → - CircleCoordinates), ∀ (hp : ProperBandQuadruple p), (![F.q (0 : Fin (4 : - ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] - = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) - * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin - (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 - : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : - ℕ)), p (3 : Fin (4 : ℕ))]) → (∀ (hB : F.slot = a + (1 : Fin (3 : ℕ)) → C.1.1.1 = (1 : - ℤ) → UnitOccurrenceOrientation p (1 : Fin (3 : ℕ)) orientation), (F.slot = a + - (2 : Fin (3 : ℕ)) → C.1.1.1 = (1 : ℤ) → UnitOccurrenceOrientation p (2 : Fin (3 : ℕ)) - orientation) → ((F.slot ≠ a) → (∀ (t : Fin (4 : ℕ) → CircleCoordinates), (F.slot = a - + (2 : Fin (3 : ℕ)) → C.1.1.1 = (1 : ℤ) → - UnitOccurrenceOrientation t (0 : Fin (3 : ℕ)) orientation) → ((0 < (F.q - F.slot.succ).1) → (((F.q F.slot.succ).1 < (F.q 0).1) → ((AncestorOdometer (F.q - F.slot.succ) F.outer.1.1 (D.tiles F.slot false) F.tile - (D.functions F.slot false) - F.odometer) → ((TileOdometer (F.q F.slot.succ) (D.tiles F.slot false) - (D.functions F.slot false)) → ((∃ s, PartialOdometerSlope - (D.functions F.slot false) = some s) → ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - (ProperBandQuadruple r) → ((r 1 = C.1.1) → ( - let I : GaussianInt := ⟨0, 1⟩ - let w : GaussianInt := BandVectors.1 (r 3) (r 2) - let x : GaussianInt := BandVectors.1 (r 1) (r 3) - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - let wa : GaussianInt := BandVectors.2 (r 3) (r 2) - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - let ya : GaussianInt := BandVectors.2 (r 2) (r 1) - (w + x + y = 0) → ((wa + xa + ya = 0) → (∀ (hvrec : BandVectors.1 (r 1) - (r 0) = x - I * y), (BandVectors.2 (r 1) (r 0) = xa + I * ya) → (∀ (hvflip : - BandVectors.1 (r 0) (r 1) = I * BandVectors.1 (r 1) (r 0)), (BandVectors.2 - (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → ((w.re + x.re + y.re = 0) → ((w.im + - x.im + y.im = 0) → ((BandPrototile (F.q F.slot.succ) - (D.tiles F.slot false)) → ((FootprintVertices (D.tiles F.slot false) ⊆ - FootprintVertices F.tile) → ((TileCentroid (D.tiles F.slot false) - - TileCentroid F.tile = (if false = true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • - (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q - (F.slot + (1 : Fin (3 : ℕ))).succ)) - (-(GaussianRealPoint (BandVectors.1 (F.q - (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q (F.slot + (1 : Fin (3 : ℕ))).succ))).2, - (GaussianRealPoint (BandVectors.1 (F.q (F.slot + (2 : Fin (3 : ℕ))).succ) (F.q - (F.slot + (1 : Fin (3 : ℕ))).succ))).1))) → ((TileCentroid (D.tiles F.slot - false) - TileCentroid F.tile = -(1 / 2 : ℝ) • (GaussianRealPoint w - - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1))) → (∀ (hMcenter : TileCentroid - Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.1 (r 1) - (r 0) - BandVectors.1 (r 0) (r 1))), (-w + I * w - BandVectors.1 (r - 1) (r 0) + BandVectors.1 (r 0) (r 1) = 2 * y) → (((↑(-w + I * w - - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.1 (r (0 : Fin - (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).re : ℝ) = (↑((2 : GaussianInt) * y).re : ℝ)) → - (((↑(-w + I * w - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : - ℕ))) + BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im : ℝ) = (↑((2 : - GaussianInt) * y).im : ℝ)) → (∀ (hcenter : TileCentroid (D.tiles F.slot false) - - TileCentroid Rminus = GaussianRealPoint y), (y ∈ TilingLattice C) → (∀ (u : - ↥(TilingLattice C)), (Rminus = TileTranslation base (↑u : GaussianInt)) → ( - let join : ProtoTile := TileTranslation base (u + y) - (join = TileTranslation Rminus y) → ((BandPrototile C.1.1 join) → (∀ (hjoinFamily : join - ∈ RegularTileFamily base (TilingLattice C)), (TileCentroid join = TileCentroid Rminus - + GaussianRealPoint y) → (∀ (hjoinCenterEq : TileCentroid (D.tiles F.slot false) = - TileCentroid join), (BandPrototile - C.1.1 (D.tiles F.slot false)) → (((D.tiles F.slot false).cells = - join.cells ∧ ((D.tiles F.slot false).cells = ∅ → (D.tiles F.slot false).anchor = - join.anchor)) → (∀ (hjoinOdo : TileOdometer C.1.1 join (D.functions F.slot false)), - (AncestorOdometer C.1.1 F.outer.1.1 join F.tile (D.functions F.slot - false) F.odometer) → (((D.tiles F.slot false).cells.Nonempty) → - ((join.cells.Nonempty) → ((FootprintVertices join = - FootprintVertices (D.tiles F.slot false)) → ((FootprintVertices join ⊆ - FootprintVertices F.tile) → ((BandSubtileOccurrence F.q F.tile - F.slot false join) → ((F.q 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p - 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2)) → ((F.q a.succ = p - 0) → ((F.q (a + 1).succ = p 2) → ((F.q (a + 2).succ = p 3) → (∀ (rootNeg : ℝ × ℝ), ∀ - (joinSlope : ℝ × ℝ), (PartialOdometerSlope F.odometer = some - rootNeg) → (∀ (hjoinSlope : PartialOdometerSlope (D.functions F.slot false) = some - joinSlope), (rootNeg = F.outerSlope) → (∀ (hSB : F.slot = a + (1 : Fin - (3 : ℕ))), (r 1 = p 2) → ((r 2 = p 3) → ((r 3 = p 0) → ((F.q a.succ = p 0) → ((0 < - (F.q a.succ).1) → (∀ (rootSlope : ℝ × ℝ), (joinSlope.2 - rootSlope.2 = -(1 / 2 : - ℝ) * ((↑wa.im : ℝ) + (↑wa.re : - ℝ))) → ((joinSlope.1 - rootSlope.1 = -(1 / 2 : ℝ) * ((↑wa.re : ℝ) - - (↑wa.im : ℝ))) → (∀ (aSlope : ℝ × ℝ), (PartialOdometerSlope F.odometer = - some rootSlope) → (∀ (haSlope : PartialOdometerSlope (D.functions a true) = some - aSlope), (aSlope.1 - rootSlope.1 = (if true = true then (1 : ℝ) else (-1 : - ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 - : Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) - (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((aSlope.2 - rootSlope.2 = (if - true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + - (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + - (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : - ℕ))).succ)).re : ℝ))) → ((rootSlope = F.outerSlope) → ( - let outerA : BandCircle := - ⟨⟨p 0, ⟨Or.inl (ProperBandCurvatureStructure p hp).1, - ⟨p, hp.1, 0, rfl⟩⟩⟩, (ProperBandCurvatureStructure p hp).1⟩ - (outerA.1.1 = F.q a.succ) → (∀ (hparentB : p (2 : Fin (4 : - ℕ)) = C.1.1), ∀ (houterOdo : TileOdometer (p (0 : Fin (4 : ℕ))) (D.tiles a true) - (D.functions a true)), ∀ (houterBand : BandPrototile (p (0 : Fin (4 : ℕ))) (D.tiles a - true)), (AncestorOdometer (p (0 : Fin (4 : ℕ))) F.outer.1.1 (D.tiles a - true) F.tile (D.functions a true) - F.odometer) → (∀ (hBA : BandVectors.1 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) = - x), (BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) = xa) → (∀ (hvAB : - BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))) = I * x), - (BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))) = -I * xa) → (∀ (hidx2 - : Fin.succ (1 : Fin (3 : ℕ)) = (2 : Fin ((3 : ℕ) + (1 : ℕ)))), ∀ (hAocc : - TileCentroid - (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • (GaussianRealPoint y - - (-(GaussianRealPoint y).2, (GaussianRealPoint y).1))), (aSlope.1 - - rootSlope.1 = (1 / 2 : ℝ) * ((↑ya.re : ℝ) - (↑ya.im : ℝ))) → ((aSlope.2 - - rootSlope.2 = (1 / 2 : ℝ) * ((↑ya.im : ℝ) + (↑ya.re : ℝ))) → ((wa.re + - xa.re + ya.re = (0 : ℤ)) → ((wa.im + xa.im + ya.im = (0 : ℤ)) → (((↑wa.re : ℝ) + - (↑xa.re : ℝ) + (↑ya.re : ℝ) = (0 : ℝ)) → (((↑wa.im : ℝ) + - (↑xa.im : ℝ) + (↑ya.im : ℝ) = (0 : ℝ)) → (∀ (hminusSlopeOffset : joinSlope - aSlope = - (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : - ℕ))) - BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))))), (F.plusSlope - - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r (1 : Fin - (4 : ℕ))) (r (0 : Fin (4 : ℕ))) + BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 - : ℕ))))) → ((F.plusSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * - (((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (1 : Fin (4 : ℕ))) (r - (0 : Fin (4 : ℕ))))).re + ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 - (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))))).re)) → ((F.plusSlope.2 - - rootSlope.2 = (1 / 2 : ℝ) * (((GaussianInt.toComplex : GaussianInt → ℂ) - (BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))))).im + - ((GaussianInt.toComplex : GaussianInt → ℂ) (BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 - : Fin (4 : ℕ))))).im)) → (((BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin - (4 : ℕ)))).re = xa.re - ya.im) → (((BandVectors.2 (r (1 : Fin (4 : ℕ))) (r - (0 : Fin (4 : ℕ)))).im = xa.im + ya.re) → (((BandVectors.2 (r (0 : Fin (4 : - ℕ))) (r (1 : Fin (4 : ℕ)))).re = xa.im + ya.re) → (((BandVectors.2 (r (0 : - Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im = -xa.re + ya.im) → (((BandVectors.2 (p (2 : - Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) + BandVectors.2 (p (0 : - Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ)))).re = xa.re + xa.im) → (((BandVectors.2 (p (2 : - Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) + BandVectors.2 (p (0 : - Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ)))).im = xa.im - xa.re) → ((F.plusSlope.1 - - rootSlope.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (r (1 : Fin (4 : ℕ))) - (r (0 : Fin (4 : ℕ)))).re : ℝ) + (↑(BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin - (4 : ℕ)))).re : ℝ))) → ((F.plusSlope.2 - rootSlope.2 = (1 / 2 : ℝ) * - ((↑(BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ)))).im : ℝ) + - (↑(BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im : ℝ))) → (∀ - (hplusSlopeOffset : F.plusSlope - aSlope = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) + BandVectors.2 (p (0 : - Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))))), - let G : P4458T1BoundaryFrame C orientation base join Rplus - (D.functions F.slot false) hplus := { - outer := outerA - q := p - proper := hp - slot := 1 - child := rfl - parent := hparentB - tile := D.tiles a true - odometer := D.functions a true - outer_odo := houterOdo - minus_odo := hjoinOdo - plus_odo := F.plus_odo - outer_band := houterBand - base_band := F.base_band - minus_family := hjoinFamily - plus_family := F.plus_family - chart := by - intro hunit - exact hB hSB (by simpa only [hparentB] using hunit) - minus_centroid := by - rw [hidx2] - rw [show TileCentroid join - TileCentroid (D.tiles a true) = - (TileCentroid join - TileCentroid Rminus) + - (TileCentroid Rminus - TileCentroid F.tile) - - (TileCentroid (D.tiles a true) - TileCentroid F.tile) by - ext <;> dsimp <;> ring] - rw [← hjoinCenterEq, hcenter, hMcenter, hAocc, - hvflip, hvrec, hBA, hvAB] - apply Prod.ext <;> - simp [GaussianRealPoint, I, Prod.smul_mk, - Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring - plus_centroid := by - rw [hidx2] - rw [show TileCentroid Rplus - TileCentroid (D.tiles a true) = - (TileCentroid Rplus - TileCentroid F.tile) - - (TileCentroid (D.tiles a true) - TileCentroid F.tile) by - ext <;> dsimp <;> ring] - have hPcenter : TileCentroid Rplus - TileCentroid F.tile = - (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.1 (r 1) (r 0) + BandVectors.1 (r 0) (r 1)) := by - simpa [r] using F.plus_centroid - rw [hPcenter, hAocc, hvflip, hvrec, hBA, hvAB] - apply Prod.ext <;> - simp [GaussianRealPoint, I, Prod.smul_mk, - Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring - outerSlope := aSlope - minusSlope := joinSlope - plusSlope := F.plusSlope - slope_outer := haSlope - slope_minus := hjoinSlope - slope_plus := F.slope_plus - minus_difference := hminusSlopeOffset - plus_difference := hplusSlopeOffset - } - (G.outer.1.1 = F.q a.succ) → - ((P4458T1BoundarySide F join Rplus (D.functions F.slot false) hplus) → - ((F.minusSlope - rootSlope = (1 / 2 : ℝ) • GaussianRealPoint (BandVectors.2 (r (1 : - Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin - (4 : ℕ))))) → ((F.minusSlope.1 - rootSlope.1 = (1 / 2 : ℝ) * ((↑(BandVectors.2 (r (1 - : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ)))).re : ℝ) - (↑(BandVectors.2 (r (0 : Fin (4 : - ℕ))) (r (1 : Fin (4 : ℕ)))).re : ℝ))) → ((F.minusSlope.2 - rootSlope.2 = (1 / 2 : ℝ) - * ((↑(BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ)))).im : ℝ) - - (↑(BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ)))).im : ℝ))) → - ((((BandVectors.2 (r 1) (r 0)).re : ℝ) = (xa.re : ℝ) - (ya.im : ℝ)) → - ((((BandVectors.2 (r 1) (r 0)).im : ℝ) = (xa.im : ℝ) + (ya.re : ℝ)) → - ((((BandVectors.2 (r 0) (r 1)).re : ℝ) = (xa.im : ℝ) + (ya.re : ℝ)) → - ((((BandVectors.2 (r 0) (r 1)).im : ℝ) = -(xa.re : ℝ) + (ya.im : ℝ)) → ((joinSlope - - F.minusSlope = GaussianRealPoint ya) → ((TileCentroid join - TileCentroid Rminus = - GaussianRealPoint y) → ((TileTouching Rminus join) → ((LeftLatticeAdjacent C Rminus - join hminus (D.functions F.slot false)) → ((Rminus.cells.Nonempty) → - ((join.cells.Nonempty) → ((Rminus ≠ join) → ((C.1.1.1 ≠ 1) → (TileString C - orientation base Rminus join [Rminus, - join]))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - )))))))))))))))))))))))) := by + ∀ (C : BandCircle), + ∀ (orientation : Bool), + ∀ (base : ProtoTile), + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + ∀ (hminus : PartialOdometer), + ∀ (hplus : PartialOdometer), + ∀ + (F : + P4458T1BoundaryFrame C orientation base Rminus Rplus hminus + hplus), + ∀ (D : P4458T1RestrictionFamily F), + ∀ (a : Fin (3 : ℕ)), + ∀ (p : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple p → + (F.slot = a + (1 : Fin (3 : ℕ)) → + C.1.1.1 = (1 : ℤ) → + UnitOccurrenceOrientation p (1 : Fin (3 : ℕ)) + orientation) → + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q F.slot.succ, F.q (F.slot + 1).succ, + F.q (F.slot + 2).succ]; + let I : GaussianInt := ⟨0, 1⟩; + let x : GaussianInt := BandVectors.1 (r 1) (r 3); + let y : GaussianInt := BandVectors.1 (r 2) (r 1); + BandVectors.1 (r 1) (r 0) = x - I * y → + BandVectors.1 (r 0) (r 1) = + I * BandVectors.1 (r 1) (r 0) → + TileCentroid Rminus - TileCentroid F.tile = + (1 / 2 : ℝ) • + GaussianRealPoint + (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1)) → + TileCentroid (D.tiles F.slot false) - + TileCentroid Rminus = + GaussianRealPoint y → + ∀ (u : ↥(TilingLattice C)), + let join : ProtoTile := TileTranslation base (u + y); + join ∈ RegularTileFamily base (TilingLattice C) → + TileCentroid (D.tiles F.slot false) = TileCentroid join → + TileOdometer C.1.1 join (D.functions F.slot false) → + ∀ (joinSlope : ℝ × ℝ), + PartialOdometerSlope (D.functions F.slot false) = + some joinSlope → + F.slot = a + (1 : Fin (3 : ℕ)) → + ∀ (aSlope : ℝ × ℝ), + PartialOdometerSlope (D.functions a true) = some aSlope → + p (2 : Fin (4 : ℕ)) = C.1.1 → + TileOdometer (p (0 : Fin (4 : ℕ))) (D.tiles a true) + (D.functions a true) → + BandPrototile (p (0 : Fin (4 : ℕ))) (D.tiles a true) → + BandVectors.1 (p (2 : Fin (4 : ℕ))) + (p (0 : Fin (4 : ℕ))) = + x → + BandVectors.1 (p (0 : Fin (4 : ℕ))) + (p (2 : Fin (4 : ℕ))) = + I * x → + Fin.succ (1 : Fin (3 : ℕ)) = + (2 : Fin ((3 : ℕ) + (1 : ℕ))) → + TileCentroid (D.tiles a true) - TileCentroid F.tile = + (1 / 2 : ℝ) • + (GaussianRealPoint y - + (-(GaussianRealPoint y).2, (GaussianRealPoint y).1)) → + joinSlope - aSlope = + (1 / 2 : ℝ) • + GaussianRealPoint + (BandVectors.2 (p (2 : Fin (4 : ℕ))) + (p (0 : Fin (4 : ℕ))) - + BandVectors.2 (p (0 : Fin (4 : ℕ))) + (p (2 : Fin (4 : ℕ)))) → + F.plusSlope - aSlope = + (1 / 2 : ℝ) • + GaussianRealPoint + (BandVectors.2 (p (2 : Fin (4 : ℕ))) + (p (0 : Fin (4 : ℕ))) + + BandVectors.2 (p (0 : Fin (4 : ℕ))) + (p (2 : Fin (4 : ℕ)))) → + TileTouching Rminus join → + Rminus ≠ join → + C.1.1.1 ≠ 1 → + TileString C orientation base Rminus join [Rminus, join] + ) := by classical - intro C orientation base Rminus Rplus hminus hplus F D a p hp hstep hB hD selected t olderChart - hCpositive hstrict hselectedAnc hselectedOdo hnegativeSlope r hr hRparent I w x y wa xa ya - hvsum hasum hvrec harec hvflip haflip hvsumRe hvsumIm hUband hUfoot hUcent hUcenter - hMcenter hcenterVector hcenterRe hcenterIm hcenter hyLattice u huRminus join hjoin_eq - hjoinBand hjoinFamily hjoinCenter hjoinCenterEq hUbandC hjoinCells hjoinOdo hjoinAncestor - hUnonempty hJoinNonemptyBase hjoinFootEq hjoinFoot hjoinOccurrence hq0 hqA hqB hqD rootNeg - joinSlope hrootNeg hjoinSlope hrootNegEq hSB hr1 hr2 hr3 hAcoord hApos' rootSlope - hjoinSlopeIm hjoinSlopeRe aSlope hrootSlope haSlope hARe hAIm hrootSlopeEq outerA hparentA - hparentB houterOdo houterBand houterAnc hBA haBA hvAB haAB hidx2 hAocc hARe' hAIm' hasumRe - hasumIm hasumReR hasumImR hminusSlopeOffset hFplusSlope hFplusRe hFplusIm ha10Re ha10Im - ha01Re ha01Im hplusReVec hplusImVec hFplusRe' hFplusIm' hplusSlopeOffset G houterEq hright - hFminusSlope hFminusRe hFminusIm ha10ReR ha10ImR ha01ReR ha01ImR hdirectSlope hleftCent - hleftTouch hleftAdjacent hMnonempty hJnonempty hleftNe hnonunit + intro C orientation base Rminus Rplus hminus hplus F D a p hp hB r I x y hvrec hvflip hMcenter + hcenter u join hjoinFamily hjoinCenterEq hjoinOdo joinSlope hjoinSlope hSB aSlope haSlope + hparentB houterOdo houterBand hBA hvAB hidx2 hAocc hminusSlopeOffset hplusSlopeOffset + hleftTouch hleftNe hnonunit unfold TileString refine ⟨F.base_band, ?_, ?_, ?_, ?_, ?_, ?_⟩ · rfl @@ -1803,72 +1660,11 @@ private theorem hAIm'At948 : intro C orientation base Rminus Rplus hminus hplus F a p r xa hqB hqD hr1 hr3 rootA slopeA hAIm simpa [hqD, hqB, hr1, hr3, xa] using hAIm -private theorem ha10ImAt955 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let I : GaussianInt := ⟨0, 1⟩ - let xa : GaussianInt := BandVectors.2 (r 1) (r 3) - let ya : GaussianInt := BandVectors.2 (r 2) (r 1) - (BandVectors.2 (r 1) (r 0) = xa + I * ya) → ((BandVectors.2 (r 1) (r 0)).im = xa.im + - ya.re) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r I xa ya harec - have h := congrArg (fun z : GaussianInt => z.im) harec - norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ - omega +private abbrev ha10ImAt955 := ApollonianSuperharmonic.SecondNewerRowsGeometry.ha10ImAt513 -private theorem ha01ReAt959 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - ( - ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)]; - let I : GaussianInt := ⟨0, 1⟩; - let xa : GaussianInt := BandVectors.2 (r 1) (r 3); - let ya : GaussianInt := BandVectors.2 (r 2) (r 1); - (BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → (((BandVectors.2 (r 1) (r - 0)).im = xa.im + ya.re) → ((BandVectors.2 (r 0) (r 1)).re = xa.im + ya.re)))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r I xa ya haflip ha10Im - have h := congrArg (fun z : GaussianInt => z.re) haflip - norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ - omega +private abbrev ha01ReAt959 := ApollonianSuperharmonic.SecondNewerRowsGeometry.ha01ReAt517 -private theorem ha01ImAt963 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - ( - ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)]; - let I : GaussianInt := ⟨0, 1⟩; - let xa : GaussianInt := BandVectors.2 (r 1) (r 3); - let ya : GaussianInt := BandVectors.2 (r 2) (r 1); - (BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0)) → (((BandVectors.2 (r 1) (r - 0)).re = xa.re - ya.im) → ((BandVectors.2 (r 0) (r 1)).im = -xa.re + ya.im)))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r I xa ya haflip ha10Re - have h := congrArg (fun z : GaussianInt => z.im) haflip - norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ - omega +private abbrev ha01ImAt963 := ApollonianSuperharmonic.SecondNewerRowsGeometry.ha01ImAt522 private theorem hRotARe : (by @@ -1898,60 +1694,12 @@ private theorem hRotAIm : norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ omega -private theorem hFminusSlopeAt991 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - ∀ (rootA : ℝ × ℝ), (rootA = F.outerSlope) → (F.minusSlope - rootA = (1 / 2 : ℝ) • - GaussianRealPoint (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r rootA hrootAEq - rw [hrootAEq] - exact F.minus_difference +private abbrev hFminusSlopeAt991 := + ApollonianSuperharmonic.SecondNewerRowsGeometry.hFminusSlopeAt641 -private theorem hFminusReAt996 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - ∀ (rootA : ℝ × ℝ), (F.minusSlope - rootA = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) → (F.minusSlope.1 - rootA.1 - = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).re : ℝ) - ((BandVectors.2 (r 0) (r - 1)).re : ℝ))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r rootA hFminusSlope - have h := congrArg Prod.fst hFminusSlope - simpa [GaussianRealPoint, Prod.smul_mk] using h +private abbrev hFminusReAt996 := ApollonianSuperharmonic.SecondNewerRowsGeometry.hFminusReAt646 -private theorem hFminusImAt1002 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - ∀ (rootA : ℝ × ℝ), (F.minusSlope - rootA = (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.2 (r 1) (r 0) - BandVectors.2 (r 0) (r 1))) → (F.minusSlope.2 - rootA.2 - = (1 / 2 : ℝ) * (((BandVectors.2 (r 1) (r 0)).im : ℝ) - ((BandVectors.2 (r 0) (r - 1)).im : ℝ))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r rootA hFminusSlope - have h := congrArg Prod.snd hFminusSlope - simpa [GaussianRealPoint, Prod.smul_mk] using h +private abbrev hFminusImAt1002 := ApollonianSuperharmonic.SecondNewerRowsGeometry.hFminusImAt652 private theorem hleftAslopeMinus : (by @@ -2374,62 +2122,11 @@ private theorem hBIm' : rw [← hyaImR, ← hyaReR] at hBIm exact hBIm -private theorem hjoinSlopeReB : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let wa : GaussianInt := BandVectors.2 (r 3) (r 2) - ∀ (rootNeg : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (joinSlope.1 - rootNeg.1 = -(1 / 2 : ℝ) * - ((↑wa.re : ℝ) - (↑wa.im : ℝ))) → (∀ (rootB : ℝ × ℝ), (rootNeg = rootB) → (joinSlope.1 - - rootB.1 = -(1 / 2 : ℝ) * ((wa.re : ℝ) - (wa.im : ℝ)))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r wa rootNeg joinSlope hjoinSlopeRe rootB - hrootNegB - rw [← hrootNegB] - exact hjoinSlopeRe +private abbrev hjoinSlopeReB := ApollonianSuperharmonic.SecondNewerRowsGeometry.hjoinSlopeReA -private theorem hjoinSlopeImB : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let wa : GaussianInt := BandVectors.2 (r 3) (r 2) - ∀ (rootNeg : ℝ × ℝ), ∀ (joinSlope : ℝ × ℝ), (joinSlope.2 - rootNeg.2 = -(1 / 2 : ℝ) * - ((↑wa.im : ℝ) + (↑wa.re : ℝ))) → (∀ (rootB : ℝ × ℝ), (rootNeg = rootB) → (joinSlope.2 - - rootB.2 = -(1 / 2 : ℝ) * ((wa.im : ℝ) + (wa.re : ℝ)))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r wa rootNeg joinSlope hjoinSlopeIm rootB - hrootNegB - rw [← hrootNegB] - exact hjoinSlopeIm +private abbrev hjoinSlopeImB := ApollonianSuperharmonic.SecondNewerRowsGeometry.hjoinSlopeImA -private theorem hFplusSlopeB : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - ∀ (rootB : ℝ × ℝ), (rootB = F.outerSlope) → (F.plusSlope - rootB = (1 / 2 : ℝ) • - GaussianRealPoint (BandVectors.2 (r 1) (r 0) + BandVectors.2 (r 0) (r 1))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r rootB hrootBEq - rw [hrootBEq] - exact F.plus_difference +private abbrev hFplusSlopeB := ApollonianSuperharmonic.SecondNewerRowsGeometry.hFplusSlope private theorem hFplusReB : (by @@ -3110,21 +2807,11 @@ private theorem firstParentPlacement : hminus hplus F positiveCells refine ⟨⟨join, hjoinCells.1.symm, hjoinOdo, hjoinAncestor, hjoinOccurrence, .direct (SecondNewerRowsGeometry.leftString C orientation base Rminus - Rplus hminus hplus F D a p hp hstep hB hD selected t olderChart hCpositive hstrict - hselectedAnc hselectedOdo hnegativeSlope hr hRparent hvsum hasum hvrec harec hvflip - haflip hvsumRe hvsumIm hUband hUfoot hUcent hUcenter hMcenter hcenterVector hcenterRe - hcenterIm hcenter hyLattice u huRminus hjoin_eq hjoinBand hjoinFamily hjoinCenter - hjoinCenterEq hUbandC hjoinCells hjoinOdo hjoinAncestor hUnonempty hJoinNonemptyBase - hjoinFootEq hjoinFoot hjoinOccurrence hq0 hqA hqB hqD rootNeg joinSlope hrootNeg - hjoinSlope hrootNegEq hSB hr1 hr2 hr3 hAcoord hApos' rootSlope hjoinSlopeIm - hjoinSlopeRe aSlope hrootSlope haSlope hARe hAIm hrootSlopeEq hparentA - hparentB houterOdo houterBand houterAnc hBA haBA hvAB haAB hidx2 hAocc hARe' hAIm' - hasumRe hasumIm hasumReR hasumImR hminusSlopeOffset hFplusSlope hFplusRe hFplusIm - ha10Re ha10Im ha01Re ha01Im hplusReVec hplusImVec hFplusRe' hFplusIm' - hplusSlopeOffset houterEq hright hFminusSlope hFminusRe hFminusIm ha10ReR ha10ImR - ha01ReR ha01ImR hdirectSlope hleftCent hleftTouch hleftAdjacent hMnonempty - (SecondNewerRowsGeometry.hJnonempty C orientation base Rminus Rplus hminus hplus F D - u hjoinCells hUnonempty) (SecondNewerRowsGeometry.hleftNe C orientation base Rminus + Rplus hminus hplus F D a p hp hB hvrec hvflip hMcenter hcenter u hjoinFamily + hjoinCenterEq hjoinOdo joinSlope + hjoinSlope hSB aSlope haSlope + hparentB houterOdo houterBand hBA hvAB hidx2 hAocc hminusSlopeOffset + hplusSlopeOffset hleftTouch (SecondNewerRowsGeometry.hleftNe C orientation base Rminus Rplus hminus hplus F u hleftTouch hMnonempty) (SecondNewerRowsGeometry.hnonunit C t ht htC)) hleftAdjacent, hright⟩⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean index 3a614a1f58..938954d4fe 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean @@ -285,128 +285,40 @@ private theorem hslopeJ : ring private theorem hslopeA : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (![F.q - (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 : ℕ))).succ, F.q (a + (2 : Fin (3 : - ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + - (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : - Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 - : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p - (3 : Fin (4 : ℕ))]) → ((F.slot = a + (1 : Fin (3 : ℕ))) → (∀ (J : ProtoTile), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (ProperBandQuadruple r) → ((r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p - 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2)) → ((r 1 = p 0) → ((r 2 = p 2) → ((r 3 = p 3) - → ((r 2 = C.1.1) → ( - let I : GaussianInt := ⟨0, 1⟩ - let w := BandVectors.1 (r 3) (r 2) - let x := BandVectors.1 (r 1) (r 3) - let y := BandVectors.1 (r 2) (r 1) - let wa := BandVectors.2 (r 3) (r 2) - let xa := BandVectors.2 (r 1) (r 3) - let ya := BandVectors.2 (r 2) (r 1) - (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : - ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 - : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r - (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 - (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : - Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : - ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) - (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r - j.succ) (r (0 : Fin (4 : ℕ))))) → ((SemiProperQuadruple ![r 0, r 2, r 3, r 1]) → - ((BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) + BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : - ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), - r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) + BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : - ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), - r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.1 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : - ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ - BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : - Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = BandVectors.2 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (3 : Fin - (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : - ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) ∧ - (ProperBandQuadruple ![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r - (1 : Fin (4 : ℕ))] → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : - Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 : Fin - (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : - ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin - (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (![r (0 : Fin (4 : ℕ)), - r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) (![r (0 - : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) = - -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r (3 : - Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] j.succ) (![r (0 : Fin (4 : ℕ)), r (2 : Fin (4 : ℕ)), r - (3 : Fin (4 : ℕ)), r (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))))) → ((BandVectors.1 (r 2) (r - 0) = y - I * w) → ((BandVectors.2 (r 2) (r 0) = ya + I * wa) → ((BandVectors.1 (r 0) (r - 2) = I * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → - ((BandVectors.1 (p 0) (p 2) = I * y) → ((BandVectors.2 (p 0) (p 2) = -I * ya) → ((-(w - I - * w) - (x - I * y - I * (x - I * y)) = (2 : GaussianInt) * y ∧ x - I * y + I * (x - I * - y) + (w - I * w) = (2 : GaussianInt) * I * x ∧ -(x - I * x) - (w - I * w) = y - I * y ∧ y - - I * w + I * (y - I * w) - (w - I * w) = y + I * y ∧ w - I * x - I * (w - I * x) - (w - - I * w) = -I * x - x ∧ -(y - I * y) - (w - I * w) = -I * x + x ∧ y - I * w - I * (y - I * - w) - (y - I * y) = -I * w - w ∧ -(x - I * x) - (y - I * y) = -I * w + w ∧ -(y - I * y) - - (x - I * x) = w - I * w ∧ w - I * x + I * (w - I * x) - (x - I * x) = w + I * w) → ((-(wa - - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * ya - + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - - (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya - + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ -(ya - - -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - (ya - - -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ -(ya - -I - * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * - xa) = wa + -I * wa) → ((-(xa - -I * xa) - (wa - -I * wa) = ya - -I * ya) → ((ya - -I * wa - + -I * (ya - -I * wa) - (wa - -I * wa) = ya + -I * ya) → ((BandVectors.1 (r 0) (r 2) = I - * (y - I * w)) → ((BandVectors.2 (r 0) (r 2) = -I * (ya + I * wa)) → ((TileCentroid J - - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * x))) → ((TileCentroid - (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (w - I * w)) → - ((TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint ((y - I * w) - + I * (y - I * w))) → ((TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • - GaussianRealPoint (y - I * y)) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = - (1 / 2 : ℝ) • GaussianRealPoint (y + I * y)) → ((TileOdometer (p 0) (D.tiles a true) - (D.functions a true)) → ((BandPrototile (p 0) (D.tiles a true)) → ((F.q a.succ = p 0) → - ((F.q ((a + 1).succ) = p 2) → ((TileCentroid Rplus - TileCentroid (D.tiles a true) = (1 / - 2 : ℝ) • GaussianRealPoint (BandVectors.1 (p 2) (p 0) + BandVectors.1 (p 0) (p 2))) → (∀ - (sJ : ℝ × ℝ), (0 < (F.q a.succ).1) → (∀ (sA : ℝ × ℝ), (PartialOdometerSlope (D.functions - a true) = some sA) → ((sA.1 - F.outerSlope.1 = (if true = true then (1 : ℝ) else (-1 : - ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q (a + (1 : - Fin (3 : ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) (F.q - (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ))) → ((sA.2 - F.outerSlope.2 = (if true = true - then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : - ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (F.q (a + (2 : - Fin (3 : ℕ))).succ) (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → ((sJ - F.outerSlope - = (1 / 2 : ℝ) • GaussianRealPoint (-(xa - (-I) * xa))) → (sA - F.outerSlope = (1 / 2 : - ℝ) • GaussianRealPoint (wa - (-I) * wa))))))))))))))))))))))))))))))))))))))) := by + ∀ (C : BandCircle), + ∀ (orientation : Bool), + ∀ (base : ProtoTile), + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + ∀ (hminus : PartialOdometer), + ∀ (hplus : PartialOdometer), + ∀ (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + ∀ (a : Fin 3), + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ]; + let I : GaussianInt := ⟨0, 1⟩; + let wa := BandVectors.2 (r 3) (r 2); + ∀ (sA : ℝ × ℝ), + sA.1 - F.outerSlope.1 = + (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) + (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : + ℝ) - + (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) + (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : + ℝ)) → + sA.2 - F.outerSlope.2 = + (if true = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : ℝ) * + ((↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) + (F.q (a + (1 : Fin (3 : ℕ))).succ)).im : + ℝ) + + (↑(BandVectors.2 (F.q (a + (2 : Fin (3 : ℕ))).succ) + (F.q (a + (1 : Fin (3 : ℕ))).succ)).re : + ℝ)) → + sA - F.outerSlope = + (1 / 2 : ℝ) • GaussianRealPoint (wa - -I * wa) := by classical - intro C orientation base Rminus Rplus hminus hplus F D a p hstep hslot J r hr hcoord hA hB hE - hparent I w x y wa xa ya laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird - aFourth vflip aflip hcentJ hcentK hcentR hcentJK hcentRK hodoK hbandK hAcoord hBcoord - hcentRnew sJ hqapos sA hsA hreA himA hslopeJ + intro C orientation base Rminus Rplus hminus hplus F a r I wa sA hreA himA have hslotvec : BandVectors.2 (F.q ((a + 2).succ)) (F.q ((a + 1).succ)) = wa := by fin_cases a <;> simp [r, wa] @@ -1086,10 +998,7 @@ theorem P4536T1AFrameB sJ hreJ himJ have hslopeA : sA - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (wa - (-I) * wa) := AFrameBProof.hslopeA C orientation - base Rminus Rplus hminus hplus F D a p hstep hslot J hr hcoord hA hB hE hparent - laws hrot rlaws hv ha hflipv hflipa hvp hap vAlg aAlg aThird aFourth vflip aflip - hcentJ hcentK hcentR hcentJK hcentRK hodoK hbandK hAcoord hBcoord hcentRnew sJ - hqapos sA hsA hreA himA hslopeJ + base Rminus Rplus hminus hplus F a sA hreA himA have hminusSlope : sJ - sA = (1 / 2 : ℝ) • GaussianRealPoint (ya - (-I) * ya) := AFrameBProof.hminusSlope C orientation base Rminus Rplus hminus hplus F a aThird sJ sA hslopeJ hslopeA diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean index 50abe4c9ab..615bec3f49 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean @@ -28,17 +28,21 @@ namespace ApollonianSuperharmonic namespace FrameDiagonalProof private theorem hrAt128 : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), (![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = - ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p - 3).2 - (p 1).2), p 0, p 2, p 3]) → ((F.slot = a + 2) → ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - ProperBandQuadruple r)) := by + ∀ (C : BandCircle), + ∀ (orientation : Bool), + ∀ (base : ProtoTile), + ∀ (Rminus : ProtoTile), + ∀ (Rplus : ProtoTile), + ∀ (hminus : PartialOdometer), + ∀ (hplus : PartialOdometer), + ∀ (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), + ∀ (a : Fin 3), + F.slot = a + 2 → + let r : Fin 4 → CircleCoordinates := + ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] + ProperBandQuadruple r := by classical - intro C orientation base Rminus Rplus hminus hplus F a p hstep hslot r + intro C orientation base Rminus Rplus hminus hplus F a hslot r fin_cases a · have heq : r = F.q := by funext j @@ -980,14 +984,7 @@ private theorem hrootAEq : intro C orientation base Rminus Rplus hminus hplus F rootA hrootA exact Option.some.inj (hrootA.symm.trans F.slope_outer) -private theorem hrootJEq : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (rootJ : ℝ × ℝ), - (PartialOdometerSlope F.odometer = some rootJ) → (rootJ = F.outerSlope) := by - classical - intro C orientation base Rminus Rplus hminus hplus F rootJ hrootJ - exact Option.some.inj (hrootJ.symm.trans F.slope_outer) +private abbrev hrootJEq := ApollonianSuperharmonic.FrameDiagonalProof.hrootAEq private theorem slopeK : ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ @@ -1219,7 +1216,7 @@ theorem P4536T1AFrameD let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] have hr := FrameDiagonalProof.hrAt128 C orientation base Rminus Rplus - hminus hplus F a p hstep hslot + hminus hplus F a hslot have hrstep := FrameDiagonalProof.hrstep C orientation base Rminus Rplus hminus hplus F a p hstep have r1 := FrameDiagonalProof.r1 C orientation base Rminus Rplus hminus hplus F a p hrstep diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean index f8da9b51f4..d21872e144 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.LatticeTileNonempty public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm @@ -128,22 +129,7 @@ private theorem cancel_translationAt227 : simp [GaussianTranslation, add_comm] · simp [GaussianTranslation, add_comm] -private theorem translate_comp : - (by - classical - exact - ∀ (X : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), TileTranslation - (TileTranslation X a) b = TileTranslation X (a + b) ) := by - classical - intro X a b - cases X with - | mk cells anchor => - apply congrArg₂ ProtoTile.mk - · ext z - simp [TileTranslation, GaussianTranslation, add_comm, - add_left_comm] - · simp [TileTranslation, GaussianTranslation, add_comm, - add_left_comm] +private abbrev translate_comp := ApollonianSuperharmonic.TileTranslationProperties.add private theorem touching_pair_congr : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean index bc13ba5a74..da4385cc76 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2FordGeometry.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeTileNonempty public import LeanPool.ApollonianSuperharmonic.BandPrototileTranslationNormalForm public import LeanPool.ApollonianSuperharmonic.BandSubtileOccurrenceTranslation @@ -272,25 +273,7 @@ private theorem translated_root_cells : (TileTranslationFormulas (TileTranslation F w) v).1, (TileTranslationFormulas T v).1, hcellsT] -private theorem lattice_cells_nonempty : - (by - classical - exact - ∀ (A : ProtoTile), (LatticeTile A) → (A.cells.Nonempty) ) := by - classical - intro A hA - by_contra hn - have hc : A.cells = ∅ := Finset.not_nonempty_iff_eq_empty.mp hn - have hr : (TileRealization A).Nonempty := by - change Nonempty - ((Metric.closedBall (0 : Real × Real) 1 : Set (Real × Real)) ≃ₜ - TileRealization A) at hA - rcases hA with ⟨e⟩ - exact ⟨(e ⟨0, by simp⟩).1, (e ⟨0, by simp⟩).2⟩ - have : TileRealization A = ∅ := by simp [TileRealization, hc] - rw [this] at hr - rcases hr with ⟨x, hx⟩ - simp at hx +private abbrev lattice_cells_nonempty := ApollonianSuperharmonic.LatticeTileNonempty.cells private theorem hoccStar : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean b/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean index 2b188d608e..cb5ccda00a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean @@ -88,17 +88,19 @@ private theorem hb : classical exact ∀ (q : Fin 4 → CircleCoordinates), - (((q (2 : Fin (4 : ℕ))).1 ≤ (q - (1 : Fin (4 : ℕ))).1) → (((1 : ℤ) < (q (2 : Fin (4 : ℕ))).1) → (((0 : ℤ) < (q (0 : - Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ ∀ (i : Fin (3 : - ℕ)), ∀ (j : Fin (3 : ℕ)), (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) → - ((∃ i : Fin 4, (q i).1 = 0) → (∀ (b : Fin (3 : ℕ)), ∀ (h : BandPackingSymmetry), ∀ - (F' : FordFareyParameter), ((q (b + (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ)) → - ((BandPackingSymmetryQuadrupleAction h ![q (0 : Fin (4 : ℕ)), q b.succ, q (b + (1 : - Fin (3 : ℕ))).succ, q (b + (2 : Fin (3 : ℕ))).succ] = FordRecursiveQuadruple F') → (b - = 0))))))) ) := by + (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → + (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → + ((0 : ℤ) < (q (0 : Fin (4 : ℕ))).1 ∧ + (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (q i.succ).1) ∧ + ∀ (i : Fin (3 : ℕ)), + ∀ (j : Fin (3 : ℕ)), + (q i.succ).1 = (0 : ℤ) → (q j.succ).1 = (0 : ℤ) → i = j) → + (∃ i : Fin 4, (q i).1 = 0) → + ∀ (b : Fin (3 : ℕ)), + (q (b + (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ) → b = 0 + ) := by classical - intro q h12 hlarge qcur hlineq b h F' hzero hnorm + intro q h12 hlarge qcur hlineq b hzero fin_cases b · rfl · have := qcur.2.1 0 @@ -281,65 +283,13 @@ private theorem hPp : intro P gN ep Pp hpmem hep i s simpa [hep i s] using hpmem i s -private theorem heq : - (by - classical - exact - ∀ (h : BandPackingSymmetry), (BandPackingSymmetryReversesOrientation h = false) → (∀ (gN - : BandPackingSymmetry), (BandPackingSymmetryReversesOrientation gN = - BandPackingSymmetryReversesOrientation h) → (∀ (dq : Bool), ∀ (eq : Fin (3 : ℕ) × - Bool ≃ Fin (3 : ℕ) × Bool), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (eq : Fin (3 : ℕ) × - Bool → Fin (3 : ℕ) × Bool) (i, s) = ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation gN = true then -i else i) i, s ^^ dq)) → ((dq - = false) → (∀ (i : Fin 3), ∀ (s : Bool), eq (i, s) = (i, s))))) ) := by - classical - intro h hrev gN horientationAdapt dq eq hqe hdq i s - rw [hqe] - simp [horientationAdapt, hrev, hdq] +private abbrev heq := ApollonianSuperharmonic.FordT6Geometry.hep -private theorem hes : - (by - classical - exact - ∀ (h : BandPackingSymmetry), (BandPackingSymmetryReversesOrientation h = false) → (∀ (gN - : BandPackingSymmetry), (BandPackingSymmetryReversesOrientation gN = - BandPackingSymmetryReversesOrientation h) → (∀ (ds : Bool), ∀ (es : Fin (3 : ℕ) × - Bool ≃ Fin (3 : ℕ) × Bool), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (es : Fin (3 : ℕ) × - Bool → Fin (3 : ℕ) × Bool) (i, s) = ((fun (i : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation gN = true then -i else i) i, s ^^ ds)) → ((ds - = false) → (∀ (i : Fin 3), ∀ (s : Bool), es (i, s) = (i, s))))) ) := by - classical - intro h hrev gN horientationAdapt ds es hse hds i s - rw [hse] - simp [horientationAdapt, hrev, hds] +private abbrev hes := ApollonianSuperharmonic.FordT6Geometry.hep -private theorem hQp : - (by - classical - exact - ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gN : BandPackingSymmetry), ∀ (eq : Fin (3 : ℕ) - × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (Qp : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 - : ℕ)), ∀ (s : Bool), Qp ((eq : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 - ((eq : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).2 = - BandPackingSymmetryTileAction gN (Q i s)) → ((∀ (i : Fin 3), ∀ (s : Bool), eq (i, s) - = (i, s)) → (∀ i, ∀ s, Qp i s = BandPackingSymmetryTileAction gN (Q i s))) ) := by - classical - intro Q gN eq Qp hqmem heq i s - simpa [heq i s] using hqmem i s +private abbrev hQp := ApollonianSuperharmonic.FordT6Geometry.hPp -private theorem hSp : - (by - classical - exact - ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gN : BandPackingSymmetry), ∀ (es : Fin (3 : ℕ) - × Bool ≃ Fin (3 : ℕ) × Bool), ∀ (Sp : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 - : ℕ)), ∀ (s : Bool), Sp ((es : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 - ((es : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).2 = - BandPackingSymmetryTileAction gN (S i s)) → ((∀ (i : Fin 3), ∀ (s : Bool), es (i, s) - = (i, s)) → (∀ i, ∀ s, Sp i s = BandPackingSymmetryTileAction gN (S i s))) ) := by - classical - intro S gN es Sp hsmem hes i s - simpa [hes i s] using hsmem i s +private abbrev hSp := ApollonianSuperharmonic.FordT6Geometry.hPp private theorem hFord : (by @@ -687,41 +637,9 @@ private theorem hPfoot : intro P gN Pp hPp Pn w Pbar f hfv i s simpa [Pbar, Pn, hPp i s] using hfv (P i s) -private theorem hQfoot : - (by - classical - exact - ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gN : BandPackingSymmetry), ∀ (Qp : Fin (3 : ℕ) - → Bool → ProtoTile), (∀ i, ∀ s, Qp i s = BandPackingSymmetryTileAction gN (Q i s)) → ( - let Qn : Fin 3 → Bool → ProtoTile := Qp - ∀ (w : GaussianInt), - let Qbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Qn i s) (-w) - let f : GaussianInt → GaussianInt := fun z => - GaussianTranslation (-w) (BandPackingSymmetryVectorAction gN z) - (∀ (X : ProtoTile), FootprintVertices (TileTranslation (BandPackingSymmetryTileAction gN - X) (-w)) = f '' FootprintVertices X) → (∀ (i : Fin 3), ∀ (s : Bool), - FootprintVertices (Qbar i s) = f '' FootprintVertices (Q i s))) ) := by - classical - intro Q gN Qp hQp Qn w Qbar f hfv i s - simpa [Qbar, Qn, hQp i s] using hfv (Q i s) +private abbrev hQfoot := ApollonianSuperharmonic.FordT6Geometry.hPfoot -private theorem hSfoot : - (by - classical - exact - ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (gN : BandPackingSymmetry), ∀ (Sp : Fin (3 : ℕ) - → Bool → ProtoTile), (∀ i, ∀ s, Sp i s = BandPackingSymmetryTileAction gN (S i s)) → ( - let Sn : Fin 3 → Bool → ProtoTile := Sp - ∀ (w : GaussianInt), - let Sbar : Fin 3 → Bool → ProtoTile := fun i s => TileTranslation (Sn i s) (-w) - let f : GaussianInt → GaussianInt := fun z => - GaussianTranslation (-w) (BandPackingSymmetryVectorAction gN z) - (∀ (X : ProtoTile), FootprintVertices (TileTranslation (BandPackingSymmetryTileAction gN - X) (-w)) = f '' FootprintVertices X) → (∀ (i : Fin 3), ∀ (s : Bool), - FootprintVertices (Sbar i s) = f '' FootprintVertices (S i s))) ) := by - classical - intro S gN Sp hSp Sn w Sbar f hfv i s - simpa [Sbar, Sn, hSp i s] using hfv (S i s) +private abbrev hSfoot := ApollonianSuperharmonic.FordT6Geometry.hPfoot private theorem hOccNorm : (by @@ -1075,7 +993,7 @@ theorem P4564T2FordT6Transport : have hlineq := FordT6Geometry.hlineq q hq a g F hnormal h12 hlarge qcur obtain ⟨b, h, F', hF', hrev, hword, hzero, hnorm⟩ := FordRegimeConverse q hq hlineq - have hb := FordT6Geometry.hb q h12 hlarge qcur hlineq b h F' hzero hnorm + have hb := FordT6Geometry.hb q h12 hlarge qcur hlineq b hzero subst b have hnormq := FordT6Geometry.hnormq q h F' hnorm obtain ⟨negative, hphase, hphaseR, hphaseT, hcircle, horientation, diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean b/LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean index fa79da2014..6598a74283 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean @@ -51,32 +51,33 @@ private theorem order_forces : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (a : Fin 3), ∀ (g : - BandPackingSymmetry), (BandPackingSymmetryScopedPhase g ![q (0 : Fin (4 : ℕ)), q - a.succ, q (a + (1 : Fin (3 : ℕ))).succ, q (a + (2 : Fin (3 : ℕ))).succ] false) → ((∀ - (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = - ![q (0 : Fin (4 : ℕ)), q a.succ, q (a + (1 : Fin (3 : ℕ))).succ, q (a + (2 : Fin (3 : - ℕ))).succ] (1 : Fin (Nat.succ (3 : ℕ))) → r (2 : Fin (4 : ℕ)) = ![q (0 : Fin (4 : - ℕ)), q a.succ, q (a + (1 : Fin (3 : ℕ))).succ, q (a + (2 : Fin (3 : ℕ))).succ] (2 : - Fin (Nat.succ (3 : ℕ))) → r (3 : Fin (4 : ℕ)) = ![q (0 : Fin (4 : ℕ)), q a.succ, q (a - + (1 : Fin (3 : ℕ))).succ, q (a + (2 : Fin (3 : ℕ))).succ] (3 : Fin (Nat.succ (3 : - ℕ))) → BandPackingSymmetryScopedPhase g r false) → (∀ (cfg : - BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g ![q 0, q - a.succ, q (a + 1).succ, q (a + 2).succ])), ∀ (C : BandCircle), - (BandOrderedGeneralLayoutCertificate (BandPackingSymmetryQuadrupleAction g ![q 0, q - a.succ, q (a + 1).succ, q (a + 2).succ]) cfg C (BandPackingSymmetryTileAction g T)) → - (((q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1) → (((q (3 : Fin (4 : ℕ))).1 ≤ (q - (2 : Fin (4 : ℕ))).1) → ((∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction - g C).1 = C.1) → (((BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q - a.succ, q (a + (1 : Fin (3 : ℕ))).succ, q (a + (2 : Fin (3 : ℕ))).succ] (2 : Fin (4 : - ℕ))).1 < (BandPackingSymmetryQuadrupleAction g ![q (0 : Fin (4 : ℕ)), q a.succ, q (a - + (1 : Fin (3 : ℕ))).succ, q (a + (2 : Fin (3 : ℕ))).succ] (1 : Fin (4 : ℕ))).1) → - ((((BandPackingSymmetryQuadrupleAction g ![q 0, q a.succ, q (a + 1).succ, q (a + - 2).succ]) 3).1 < ((BandPackingSymmetryQuadrupleAction g ![q 0, q a.succ, q (a + - 1).succ, q (a + 2).succ]) 2).1) → (a = 0 ∧ BandPackingSymmetryReversesOrientation g = - false)))))))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (a : Fin 3), + ∀ (g : BandPackingSymmetry), + (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → + (q (3 : Fin (4 : ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → + (∀ (C : CircleCoordinates), + (BandPackingSymmetryCircleAction g C).1 = C.1) → + (BandPackingSymmetryQuadrupleAction g + ![q (0 : Fin (4 : ℕ)), q a.succ, + q (a + (1 : Fin (3 : ℕ))).succ, + q (a + (2 : Fin (3 : ℕ))).succ] + (2 : Fin (4 : ℕ))).1 < + (BandPackingSymmetryQuadrupleAction g + ![q (0 : Fin (4 : ℕ)), q a.succ, + q (a + (1 : Fin (3 : ℕ))).succ, + q (a + (2 : Fin (3 : ℕ))).succ] + (1 : Fin (4 : ℕ))).1 → + ((BandPackingSymmetryQuadrupleAction g + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ]) + 3).1 < + ((BandPackingSymmetryQuadrupleAction g + ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ]) + 2).1 → + a = 0 ∧ BandPackingSymmetryReversesOrientation g = false + ) := by classical - intro q T a g hphase hpredecessor cfg C cert h12 h23 curvature normalized12 normalized23 + intro q a g h12 h23 curvature normalized12 normalized23 cases hg : BandPackingSymmetryReversesOrientation g <;> fin_cases a <;> simp [BandPackingSymmetryQuadrupleAction, hg, curvature] at normalized12 normalized23 ⊢ <;> omega @@ -471,7 +472,7 @@ theorem P4564T2GeneralT6Transport (q : Fin 4 → CircleCoordinates) (hq : Proper ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ]) 2).1 := GeneralT6Geometry.normalized23 q a g cfg have order_forces : a = 0 ∧ BandPackingSymmetryReversesOrientation g = false := - GeneralT6Geometry.order_forces q T a g hphase hpredecessor cfg C cert h12 h23 curvature + GeneralT6Geometry.order_forces q a g h12 h23 curvature normalized12 normalized23 obtain ⟨rfl, hg⟩ := order_forces have hrotate : diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean index 97ca576f03..1e37e33ff4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean @@ -349,31 +349,7 @@ private theorem hfpoint : · exact Or.inl (by simpa [p1] using rhoFace f _ h) · exact Or.inr (by simpa [pJ] using rhoFace f _ h) -private theorem hgpoint : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (g : cert.modified.plane.Face), ((cert.modifiedFaceEquivalence : - cert.modified.plane.Face → PeriodicSubtileFaceIndex) g = (⟨SixSubtileFaceLabel.I1, (0 - : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modifiedFaceEquivalence : - cert.modified.plane.Face → PeriodicSubtileFaceIndex) g = (⟨SixSubtileFaceLabel.J3, - (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( - let p1 := cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) - let pJ := cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm ⟨.J3, -1, -1⟩) - (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = - cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho g = p1 ∨ - cert.modified.rho g = pJ)) ) := by - classical - intro q cfg C T cert g hgclass p1 pJ rhoFace - rcases hgclass with h | h - · exact Or.inl (by simpa [p1] using rhoFace g _ h) - · exact Or.inr (by simpa [pJ] using rhoFace g _ h) +private abbrev hgpoint := ApollonianSuperharmonic.JunctionRefinementGeometry.hfpoint private theorem hx_p1_or_pJ : (by @@ -711,31 +687,7 @@ private theorem hf2point : · exact Or.inl (by simpa [p2] using rhoFace2 f2 _ h) · exact Or.inr (by simpa [pJ4] using rhoFace2 f2 _ h) -private theorem hg2point : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (g2 : cert.modified.plane.Face), ((cert.modifiedFaceEquivalence : - cert.modified.plane.Face → PeriodicSubtileFaceIndex) g2 = (⟨SixSubtileFaceLabel.I2, - (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modifiedFaceEquivalence : - cert.modified.plane.Face → PeriodicSubtileFaceIndex) g2 = (⟨SixSubtileFaceLabel.J4, - (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( - let p2 := cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) - let pJ4 := cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm ⟨.J4, 0, 0⟩) - (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = - cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho g2 = p2 ∨ - cert.modified.rho g2 = pJ4)) ) := by - classical - intro q cfg C T cert g2 hg2class p2 pJ4 rhoFace2 - rcases hg2class with h | h - · exact Or.inl (by simpa [p2] using rhoFace2 g2 _ h) - · exact Or.inr (by simpa [pJ4] using rhoFace2 g2 _ h) +private abbrev hg2point := ApollonianSuperharmonic.JunctionRefinementGeometry.hf2point private theorem hx_p2_or_pJ4 : (by @@ -819,20 +771,7 @@ private theorem hp2D : simpa [p2, faceI2, dI2, ModifiedSubtileOccurrenceInterpretation, TileTranslation, GaussianTranslation, htransZero, Finset.image_id] using hh -private theorem hCtile0 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), (GaussianTranslation (0 : GaussianInt) = id) → ( - let c0 : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - cert.modified.tile c0 = cert.P 1 true) ) := by - classical - intro q cfg C T cert htransZero c0 - rw [cert.modified_tile] - simp [c0, ModifiedSubtileOccurrenceInterpretation, - TileTranslation, htransZero] +private abbrev hCtile0 := ApollonianSuperharmonic.JunctionRefinementGeometry.hCtile private theorem hFtile0 : (by @@ -999,31 +938,7 @@ private theorem hf3point : · exact Or.inl (by simpa [p3] using rhoFace3 f3 _ h) · exact Or.inr (by simpa [pJ8] using rhoFace3 f3 _ h) -private theorem hg3point : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (g3 : cert.modified.plane.Face), ((cert.modifiedFaceEquivalence : - cert.modified.plane.Face → PeriodicSubtileFaceIndex) g3 = (⟨SixSubtileFaceLabel.I3, - (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modifiedFaceEquivalence : - cert.modified.plane.Face → PeriodicSubtileFaceIndex) g3 = (⟨SixSubtileFaceLabel.J8, - (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( - let p3 := cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) - let pJ8 := cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm ⟨.J8, 0, 0⟩) - (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = - cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho g3 = p3 ∨ - cert.modified.rho g3 = pJ8)) ) := by - classical - intro q cfg C T cert g3 hg3class p3 pJ8 rhoFace3 - rcases hg3class with h | h - · exact Or.inl (by simpa [p3] using rhoFace3 g3 _ h) - · exact Or.inr (by simpa [pJ8] using rhoFace3 g3 _ h) +private abbrev hg3point := ApollonianSuperharmonic.JunctionRefinementGeometry.hf3point private theorem hx_p3_or_pJ8 : (by @@ -1250,31 +1165,7 @@ private theorem hf4point : · exact Or.inl (by simpa [p4] using rhoFace4 f4 _ h) · exact Or.inr (by simpa [pJ7] using rhoFace4 f4 _ h) -private theorem hg4point : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (g4 : cert.modified.plane.Face), ((cert.modifiedFaceEquivalence : - cert.modified.plane.Face → PeriodicSubtileFaceIndex) g4 = (⟨SixSubtileFaceLabel.I4, - (0 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex) ∨ (cert.modifiedFaceEquivalence : - cert.modified.plane.Face → PeriodicSubtileFaceIndex) g4 = (⟨SixSubtileFaceLabel.J7, - (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileFaceIndex)) → ( - let p4 := cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm ⟨.I4, 0, 0⟩) - let pJ7 := cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm ⟨.J7, 1, 0⟩) - (∀ (F : cert.modified.plane.Face), ∀ (face : PeriodicSubtileFaceIndex), - (cert.modifiedFaceEquivalence F = face) → (cert.modified.rho F = - cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm face))) → (cert.modified.rho g4 = p4 ∨ - cert.modified.rho g4 = pJ7)) ) := by - classical - intro q cfg C T cert g4 hg4class p4 pJ7 rhoFace4 - rcases hg4class with h | h - · exact Or.inl (by simpa [p4] using rhoFace4 g4 _ h) - · exact Or.inr (by simpa [pJ7] using rhoFace4 g4 _ h) +private abbrev hg4point := ApollonianSuperharmonic.JunctionRefinementGeometry.hf4point private theorem endpointAlternative : (by @@ -1515,40 +1406,41 @@ private theorem hxJ7neq : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ BoundaryFootprintVertices - T) → ((∀ (W : ProtoTile), ∀ (y : GaussianInt), (W.cells.Nonempty) → ((y ∈ - FootprintVertices W) → (∃ j : Fin 4, LatticeVertexIncidentCell y j ∈ W.cells))) → ((∀ - j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) → ((x ∈ T.cells ∧ x - 1 ∈ T.cells - ∧ x - 1 - ⟨0, 1⟩ ∈ T.cells ∧ x - ⟨0, 1⟩ ∈ T.cells) → (((x ∈ FootprintVertices (cert.P - 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ FootprintVertices (cert.P 1 - true)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∧ - LatticeVertexIncidentCell x j ∉ (cert.P 0 false).cells ∧ LatticeVertexIncidentCell x - j ∉ (cert.P 1 true).cells)) → ((x ∈ FootprintVertices (cert.P (0 : Fin (3 : ℕ)) - false) ∧ x ∈ FootprintVertices (cert.P (1 : Fin (3 : ℕ)) false) ∧ x ∈ - FootprintVertices (cert.P (2 : Fin (3 : ℕ)) true)) → ( - let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ - let e0 : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ - ∀ (f4 : cert.modified.plane.Face), ∀ (g4 : cert.modified.plane.Face), ((x ∈ - FootprintVertices (cert.P 0 false) ∧ x ∈ FootprintVertices (cert.P 1 false) ∧ x ∈ - FootprintVertices (cert.P 2 true)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ - (cert.P 0 false).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.modified.tile - d0).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.modified.tile e0).cells)) → ((x ∈ - FootprintVertices (cert.modified.tile d0) ∩ FootprintVertices (cert.modified.tile - e0)) → ((x ∈ CommonFootprintEdgeVertices (cert.modified.tile d0) (cert.modified.tile - e0)) → ((x = cert.modified.rho f4 ∨ x = cert.modified.rho g4) → ( - let pJ7 := cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm ⟨.J7, 1, 0⟩) - let cJ7 : PeriodicSubtileIndex := ⟨.C, 1, 0⟩ - (pJ7 ∈ FootprintVertices (cert.modified.tile cJ7)) → ((Disjoint T.cells (TileTranslation - T ((↑(1 : ℤ) : GaussianInt) * cert.u + (↑(0 : ℤ) : GaussianInt) * cert.v)).cells) → - ((∀ (z : GaussianInt), (z ∈ (cert.modified.tile cJ7).cells) → (z ∈ (TileTranslation T - ((1 : GaussianInt) * cert.u + (0 : GaussianInt) * cert.v)).cells)) → ((x = pJ7) → (x - ≠ pJ7))))))))))))))) ) := by - classical - intro q cfg C T cert x hx hxb incident hmissingT hfourCells hthirdABC hBDE d0 e0 f4 g4 hthirdB - hxDE hxvDE hxendpointDE pJ7 cJ7 hpJ7c hblockSepDE hblockCellDE hxJ7 hEq + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (x : GaussianInt), + (∀ (W : ProtoTile), + ∀ (y : GaussianInt), + W.cells.Nonempty → + y ∈ FootprintVertices W → + ∃ j : Fin 4, LatticeVertexIncidentCell y j ∈ W.cells) → + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) → + ∀ (f4 : cert.modified.plane.Face), + ∀ (g4 : cert.modified.plane.Face), + x = cert.modified.rho f4 ∨ x = cert.modified.rho g4 → + let pJ7 := + cert.unmodified.core.rho + (cert.unmodified.faceEquiv.symm ⟨.J7, 1, 0⟩); + let cJ7 : PeriodicSubtileIndex := ⟨.C, 1, 0⟩; + pJ7 ∈ FootprintVertices (cert.modified.tile cJ7) → + Disjoint T.cells + (TileTranslation T + ((↑(1 : ℤ) : GaussianInt) * cert.u + + (↑(0 : ℤ) : GaussianInt) * cert.v)).cells → + (∀ (z : GaussianInt), + z ∈ (cert.modified.tile cJ7).cells → + z ∈ + (TileTranslation T + ((1 : GaussianInt) * cert.u + + (0 : GaussianInt) * cert.v)).cells) → + x ≠ pJ7 + ) := by + classical + intro q cfg C T cert x incident hmissingT f4 g4 hxendpointDE pJ7 cJ7 hpJ7c hblockSepDE + hblockCellDE hEq subst x obtain ⟨j, hj⟩ := incident (cert.modified.tile cJ7) pJ7 (LatticeTileGridStructure _ (cert.modified.tiles_are_disks cJ7)).1.1 hpJ7c @@ -1563,49 +1455,96 @@ private theorem firstJunction : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ BoundaryFootprintVertices - T) → ((GaussianTranslation (0 : GaussianInt) = id) → ((∀ (W : ProtoTile), ∀ (y : - GaussianInt), Finset.Nonempty W.cells → y ∈ FootprintVertices W → ∃ (j : Fin (4 : - ℕ)), LatticeVertexIncidentCell y j ∈ W.cells) → ((∀ j : Fin 4, - LatticeVertexIncidentCell x j ∈ T.cells) → ((x ∈ T.cells ∧ x - (1 : GaussianInt) ∈ - T.cells ∧ x - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells ∧ x - - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells) → ((∀ (U : ProtoTile), ∀ (V : - ProtoTile), ∀ (W : ProtoTile), ∀ (p : GaussianInt), ∀ (q : GaussianInt), ∀ (vertex : - GaussianInt), ∀ (vertices : Set GaussianInt), LatticeTile U → LatticeTile V → - Disjoint U.cells V.cells → SimpleGridPathBetween vertices (FootprintEdges U ∩ - FootprintEdges V) p q → vertex ∈ vertices → (∃ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell vertex j ∈ W.cells ∧ LatticeVertexIncidentCell vertex j ∉ - U.cells ∧ LatticeVertexIncidentCell vertex j ∉ V.cells) → vertex = p ∨ vertex = q) → ( - let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ - let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - (cert.modified.plane.adjacent b c) → ((PeriodicTileAdjacentContactRegularity - cert.modified) → (∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), - ((∃ (i : Fin (3 : ℕ)), cert.modified.plane.faceVertex f i = b) ∧ ∃ (i : Fin (3 : ℕ)), - cert.modified.plane.faceVertex f i = c) → (((∃ (i : Fin (3 : ℕ)), - cert.modified.plane.faceVertex g i = b) ∧ ∃ (i : Fin (3 : ℕ)), - cert.modified.plane.faceVertex g i = c) → ((SimpleGridPathBetween - (CommonFootprintEdgeVertices (cert.modified.tile b) (cert.modified.tile c)) - (FootprintEdges (cert.modified.tile b) ∩ FootprintEdges (cert.modified.tile c)) - (cert.modified.rho f) (cert.modified.rho g)) → ((∀ (m : ℤ), ∀ (n : ℤ), (m, n) ≠ ((0 : - ℤ), (0 : ℤ)) → Disjoint T.cells (TileTranslation T ((↑m : GaussianInt) * cert.u + (↑n - : GaussianInt) * cert.v)).cells) → ((∀ (label : SixSubtileLabel), ∀ (m : Int), ∀ (n : - Int), ∀ (a : GaussianInt), (a ∈ (cert.modified.tile ⟨label, m, n⟩).cells) → (a ∈ - (TileTranslation T ((m : GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells)) - → ((cert.modified.tile b = cert.P 0 false) → ((cert.modified.tile c = cert.P 1 true) - → ((Disjoint (cert.modified.tile b).cells (cert.modified.tile c).cells) → (((x ∈ - FootprintVertices (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ - FootprintVertices (cert.P 1 true)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ - (cert.P 0 true).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.P 0 false).cells ∧ - LatticeVertexIncidentCell x j ∉ (cert.P 1 true).cells)) → (((x ∈ FootprintVertices - (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ FootprintVertices - (cert.P 1 true)) → x ∈ FootprintVertices (cert.Q 1 true) ∩ FootprintVertices (cert.S - 2 false) ∩ FootprintVertices (cert.P 1 true)))))))))))))))))))) ) := by - classical - intro q cfg C T cert x hx hxb htransZero incident hmissingT hfourCells path_endpoint_of_third b - c hbc hregular f g hf hg hBCpath blockSeparation tileCellInBlock hBtile hCtile hBCdis - hthirdABC hABC + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (x : GaussianInt), + GaussianTranslation (0 : GaussianInt) = id → + (∀ (W : ProtoTile), + ∀ (y : GaussianInt), + Finset.Nonempty W.cells → + y ∈ FootprintVertices W → + ∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell y j ∈ W.cells) → + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) → + (∀ (U : ProtoTile), + ∀ (V : ProtoTile), + ∀ (W : ProtoTile), + ∀ (p : GaussianInt), + ∀ (q : GaussianInt), + ∀ (vertex : GaussianInt), + ∀ (vertices : Set GaussianInt), + LatticeTile U → + LatticeTile V → + Disjoint U.cells V.cells → + SimpleGridPathBetween vertices + (FootprintEdges U ∩ FootprintEdges V) p q → + vertex ∈ vertices → + (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell vertex j ∈ W.cells ∧ + LatticeVertexIncidentCell vertex j ∉ U.cells ∧ + LatticeVertexIncidentCell vertex j ∉ V.cells) → + vertex = p ∨ vertex = q) → + let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ + let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ + cert.modified.plane.adjacent b c → + PeriodicTileAdjacentContactRegularity cert.modified → + ∀ (f : cert.modified.plane.Face), + ∀ (g : cert.modified.plane.Face), + ((∃ (i : Fin (3 : ℕ)), + cert.modified.plane.faceVertex f i = b) ∧ + ∃ (i : Fin (3 : ℕ)), + cert.modified.plane.faceVertex f i = c) → + ((∃ (i : Fin (3 : ℕ)), + cert.modified.plane.faceVertex g i = b) ∧ + ∃ (i : Fin (3 : ℕ)), + cert.modified.plane.faceVertex g i = c) → + SimpleGridPathBetween + (CommonFootprintEdgeVertices (cert.modified.tile b) + (cert.modified.tile c)) + (FootprintEdges (cert.modified.tile b) ∩ + FootprintEdges (cert.modified.tile c)) + (cert.modified.rho f) (cert.modified.rho g) → + (∀ (m : ℤ), + ∀ (n : ℤ), + (m, n) ≠ ((0 : ℤ), (0 : ℤ)) → + Disjoint T.cells + (TileTranslation T + ((↑m : GaussianInt) * cert.u + + (↑n : GaussianInt) * cert.v)).cells) → + (∀ (label : SixSubtileLabel), + ∀ (m : Int), + ∀ (n : Int), + ∀ (a : GaussianInt), + a ∈ (cert.modified.tile ⟨label, m, n⟩).cells → + a ∈ + (TileTranslation T + ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v)).cells) → + cert.modified.tile b = cert.P 0 false → + cert.modified.tile c = cert.P 1 true → + Disjoint (cert.modified.tile b).cells + (cert.modified.tile c).cells → + (x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 true) → + ∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.P 0 false).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.P 1 true).cells) → + x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 true) → + x ∈ + FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.S 2 false) ∩ + FootprintVertices (cert.P 1 true) + ) := by + classical + intro q cfg C T cert x htransZero incident hmissingT path_endpoint_of_third b c hbc hregular f + g hf hg hBCpath blockSeparation tileCellInBlock hBtile hCtile hBCdis hthirdABC hABC have hxv : x ∈ CommonFootprintEdgeVertices (cert.modified.tile b) (cert.modified.tile c) := JunctionRefinementGeometry.hxv q cfg C T cert x hbc hregular (JunctionRefinementGeometry.hxBC q cfg C T cert x hBtile hCtile @@ -1652,47 +1591,81 @@ private theorem secondJunction : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ BoundaryFootprintVertices - T) → ((GaussianTranslation (0 : GaussianInt) = id) → ((∀ (W : ProtoTile), ∀ (y : - GaussianInt), Finset.Nonempty W.cells → y ∈ FootprintVertices W → ∃ (j : Fin (4 : - ℕ)), LatticeVertexIncidentCell y j ∈ W.cells) → ((∀ j : Fin 4, - LatticeVertexIncidentCell x j ∈ T.cells) → ((x ∈ T.cells ∧ x - (1 : GaussianInt) ∈ - T.cells ∧ x - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells ∧ x - - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells) → ((∀ y ∈ - CellSupportedFootprintVertices cert.O, ∀ (a : GaussianInt), y ∈ FootprintVertices - (⟨{a}, a⟩ : ProtoTile) → a ∈ (cert.P (0 : Fin (3 : ℕ)) true).cells ∨ a ∈ (cert.P (0 : - Fin (3 : ℕ)) false).cells) → ((∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (W : - ProtoTile), ∀ (p : GaussianInt), ∀ (q : GaussianInt), ∀ (vertex : GaussianInt), ∀ - (vertices : Set GaussianInt), LatticeTile U → LatticeTile V → Disjoint U.cells - V.cells → SimpleGridPathBetween vertices (FootprintEdges U ∩ FootprintEdges V) p q → - vertex ∈ vertices → (∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell vertex j ∈ - W.cells ∧ LatticeVertexIncidentCell vertex j ∉ U.cells ∧ LatticeVertexIncidentCell - vertex j ∉ V.cells) → vertex = p ∨ vertex = q) → (((cert.P (0 : Fin (3 : ℕ)) - true).cells ∩ (cert.P (0 : Fin (3 : ℕ)) false).cells = cert.O.cells) → ((∀ (i : Fin - (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), (i, s) ≠ (j, t) → ¬(i = (0 - : Fin (3 : ℕ)) ∧ j = (0 : Fin (3 : ℕ))) → Disjoint (cert.P i s).cells (cert.P j - t).cells) → ((PeriodicTileAdjacentContactRegularity cert.modified) → ((∀ (m : ℤ), ∀ - (n : ℤ), (m, n) ≠ ((0 : ℤ), (0 : ℤ)) → Disjoint T.cells (TileTranslation T ((↑m : - GaussianInt) * cert.u + (↑n : GaussianInt) * cert.v)).cells) → ((∀ (label : - SixSubtileLabel), ∀ (m : Int), ∀ (n : Int), ∀ (a : GaussianInt), (a ∈ - (cert.modified.tile ⟨label, m, n⟩).cells) → (a ∈ (TileTranslation T ((m : - GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells)) → (((x ∈ - FootprintVertices (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ - FootprintVertices (cert.P 1 true)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ - (cert.P 0 true).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.P 0 false).cells ∧ - LatticeVertexIncidentCell x j ∉ (cert.P 1 true).cells)) → ((((x ∈ FootprintVertices - (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ FootprintVertices - (cert.P 1 true)) → x ∈ FootprintVertices (cert.Q 1 true) ∩ FootprintVertices (cert.S - 2 false) ∩ FootprintVertices (cert.P 1 true))) → (((x ∈ FootprintVertices (cert.P 0 - true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ FootprintVertices (cert.P 1 - false)) → x ∈ FootprintVertices (cert.Q 2 true) ∩ FootprintVertices (cert.S 1 false) - ∩ FootprintVertices (cert.P 1 false))))))))))))))))) ) := by - classical - intro q cfg C T cert x hx hxb htransZero incident hmissingT hfourCells - precursorIsolationSupported path_endpoint_of_third hABO hseparate hregular blockSeparation - tileCellInBlock hthirdABC firstJunction hABD + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (x : GaussianInt), + GaussianTranslation (0 : GaussianInt) = id → + (∀ (W : ProtoTile), + ∀ (y : GaussianInt), + Finset.Nonempty W.cells → + y ∈ FootprintVertices W → + ∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell y j ∈ W.cells) → + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) → + (∀ y ∈ CellSupportedFootprintVertices cert.O, + ∀ (a : GaussianInt), + y ∈ FootprintVertices (⟨{ a }, a⟩ : ProtoTile) → + a ∈ (cert.P (0 : Fin (3 : ℕ)) true).cells ∨ + a ∈ (cert.P (0 : Fin (3 : ℕ)) false).cells) → + (∀ (U : ProtoTile), + ∀ (V : ProtoTile), + ∀ (W : ProtoTile), + ∀ (p : GaussianInt), + ∀ (q : GaussianInt), + ∀ (vertex : GaussianInt), + ∀ (vertices : Set GaussianInt), + LatticeTile U → + LatticeTile V → + Disjoint U.cells V.cells → + SimpleGridPathBetween vertices + (FootprintEdges U ∩ FootprintEdges V) p q → + vertex ∈ vertices → + (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell vertex j ∈ W.cells ∧ + LatticeVertexIncidentCell vertex j ∉ U.cells ∧ + LatticeVertexIncidentCell vertex j ∉ V.cells) → + vertex = p ∨ vertex = q) → + (cert.P (0 : Fin (3 : ℕ)) true).cells ∩ + (cert.P (0 : Fin (3 : ℕ)) false).cells = + cert.O.cells → + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + ∀ (j : Fin (3 : ℕ)), + ∀ (t : Bool), + (i, s) ≠ (j, t) → + ¬(i = (0 : Fin (3 : ℕ)) ∧ j = (0 : Fin (3 : ℕ))) → + Disjoint (cert.P i s).cells (cert.P j t).cells) → + PeriodicTileAdjacentContactRegularity cert.modified → + (∀ (m : ℤ), + ∀ (n : ℤ), + (m, n) ≠ ((0 : ℤ), (0 : ℤ)) → + Disjoint T.cells + (TileTranslation T + ((↑m : GaussianInt) * cert.u + + (↑n : GaussianInt) * cert.v)).cells) → + (∀ (label : SixSubtileLabel), + ∀ (m : Int), + ∀ (n : Int), + ∀ (a : GaussianInt), + a ∈ (cert.modified.tile ⟨label, m, n⟩).cells → + a ∈ + (TileTranslation T + ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v)).cells) → + x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 false) → + x ∈ + FootprintVertices (cert.Q 2 true) ∩ + FootprintVertices (cert.S 1 false) ∩ + FootprintVertices (cert.P 1 false) + ) := by + classical + intro q cfg C T cert x htransZero incident hmissingT precursorIsolationSupported + path_endpoint_of_third hABO hseparate hregular blockSeparation tileCellInBlock hABD let a0 : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ have hAtile : cert.modified.tile a0 = @@ -1779,47 +1752,74 @@ private theorem thirdJunction : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ BoundaryFootprintVertices - T) → ((GaussianTranslation (0 : GaussianInt) = id) → ((∀ (W : ProtoTile), ∀ (y : - GaussianInt), Finset.Nonempty W.cells → y ∈ FootprintVertices W → ∃ (j : Fin (4 : - ℕ)), LatticeVertexIncidentCell y j ∈ W.cells) → ((∀ j : Fin 4, - LatticeVertexIncidentCell x j ∈ T.cells) → ((x ∈ T.cells ∧ x - (1 : GaussianInt) ∈ - T.cells ∧ x - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells ∧ x - - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells) → ((∀ (U : ProtoTile), ∀ (V : - ProtoTile), ∀ (W : ProtoTile), ∀ (p : GaussianInt), ∀ (q : GaussianInt), ∀ (vertex : - GaussianInt), ∀ (vertices : Set GaussianInt), LatticeTile U → LatticeTile V → - Disjoint U.cells V.cells → SimpleGridPathBetween vertices (FootprintEdges U ∩ - FootprintEdges V) p q → vertex ∈ vertices → (∃ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell vertex j ∈ W.cells ∧ LatticeVertexIncidentCell vertex j ∉ - U.cells ∧ LatticeVertexIncidentCell vertex j ∉ V.cells) → vertex = p ∨ vertex = q) → - ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), (i, s) ≠ (j, - t) → ¬(i = (0 : Fin (3 : ℕ)) ∧ j = (0 : Fin (3 : ℕ))) → Disjoint (cert.P i s).cells - (cert.P j t).cells) → ((Disjoint (cert.P 0 true).cells (cert.P 1 true).cells) → - ((PeriodicTileAdjacentContactRegularity cert.modified) → ((∀ (m : ℤ), ∀ (n : ℤ), (m, - n) ≠ ((0 : ℤ), (0 : ℤ)) → Disjoint T.cells (TileTranslation T ((↑m : GaussianInt) * - cert.u + (↑n : GaussianInt) * cert.v)).cells) → ((∀ (label : SixSubtileLabel), ∀ (m : - Int), ∀ (n : Int), ∀ (a : GaussianInt), (a ∈ (cert.modified.tile ⟨label, m, - n⟩).cells) → (a ∈ (TileTranslation T ((m : GaussianInt) * cert.u + (n : GaussianInt) - * cert.v)).cells)) → (((x ∈ FootprintVertices (cert.P 0 true) ∧ x ∈ FootprintVertices - (cert.P 0 false) ∧ x ∈ FootprintVertices (cert.P 1 true)) → (∃ j : Fin 4, - LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∧ LatticeVertexIncidentCell x j - ∉ (cert.P 0 false).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.P 1 true).cells)) → - ((((x ∈ FootprintVertices (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ - x ∈ FootprintVertices (cert.P 1 true)) → x ∈ FootprintVertices (cert.Q 1 true) ∩ - FootprintVertices (cert.S 2 false) ∩ FootprintVertices (cert.P 1 true))) → ((((x ∈ - FootprintVertices (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ - FootprintVertices (cert.P 1 false)) → x ∈ FootprintVertices (cert.Q 2 true) ∩ - FootprintVertices (cert.S 1 false) ∩ FootprintVertices (cert.P 1 false))) → (((x ∈ - FootprintVertices (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 1 true) ∧ x ∈ - FootprintVertices (cert.P 2 false)) → x ∈ FootprintVertices (cert.Q 1 true) ∩ - FootprintVertices (cert.P 1 true) ∩ FootprintVertices (cert.P 2 - false))))))))))))))))) ) := by - classical - intro q cfg C T cert x hx hxb htransZero incident hmissingT hfourCells path_endpoint_of_third - hseparate hACseparate hregular blockSeparation tileCellInBlock hthirdABC firstJunction - secondJunction hACF + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (x : GaussianInt), + GaussianTranslation (0 : GaussianInt) = id → + (∀ (W : ProtoTile), + ∀ (y : GaussianInt), + Finset.Nonempty W.cells → + y ∈ FootprintVertices W → + ∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell y j ∈ W.cells) → + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) → + (∀ (U : ProtoTile), + ∀ (V : ProtoTile), + ∀ (W : ProtoTile), + ∀ (p : GaussianInt), + ∀ (q : GaussianInt), + ∀ (vertex : GaussianInt), + ∀ (vertices : Set GaussianInt), + LatticeTile U → + LatticeTile V → + Disjoint U.cells V.cells → + SimpleGridPathBetween vertices + (FootprintEdges U ∩ FootprintEdges V) p q → + vertex ∈ vertices → + (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell vertex j ∈ W.cells ∧ + LatticeVertexIncidentCell vertex j ∉ U.cells ∧ + LatticeVertexIncidentCell vertex j ∉ V.cells) → + vertex = p ∨ vertex = q) → + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + ∀ (j : Fin (3 : ℕ)), + ∀ (t : Bool), + (i, s) ≠ (j, t) → + ¬(i = (0 : Fin (3 : ℕ)) ∧ j = (0 : Fin (3 : ℕ))) → + Disjoint (cert.P i s).cells (cert.P j t).cells) → + Disjoint (cert.P 0 true).cells (cert.P 1 true).cells → + PeriodicTileAdjacentContactRegularity cert.modified → + (∀ (m : ℤ), + ∀ (n : ℤ), + (m, n) ≠ ((0 : ℤ), (0 : ℤ)) → + Disjoint T.cells + (TileTranslation T + ((↑m : GaussianInt) * cert.u + + (↑n : GaussianInt) * cert.v)).cells) → + (∀ (label : SixSubtileLabel), + ∀ (m : Int), + ∀ (n : Int), + ∀ (a : GaussianInt), + a ∈ (cert.modified.tile ⟨label, m, n⟩).cells → + a ∈ + (TileTranslation T + ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v)).cells) → + x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 1 true) ∧ + x ∈ FootprintVertices (cert.P 2 false) → + x ∈ + FootprintVertices (cert.Q 1 true) ∩ + FootprintVertices (cert.P 1 true) ∩ + FootprintVertices (cert.P 2 false) + ) := by + classical + intro q cfg C T cert x htransZero incident hmissingT path_endpoint_of_third hseparate + hACseparate hregular blockSeparation tileCellInBlock hACF let c0 : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ let f0 : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ have hCtile0 : cert.modified.tile c0 = cert.P 1 true := @@ -1888,49 +1888,88 @@ private theorem fourthJunction : (by classical exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ BoundaryFootprintVertices - T) → ((GaussianTranslation (0 : GaussianInt) = id) → ((∀ (W : ProtoTile), ∀ (y : - GaussianInt), Finset.Nonempty W.cells → y ∈ FootprintVertices W → ∃ (j : Fin (4 : - ℕ)), LatticeVertexIncidentCell y j ∈ W.cells) → ((∀ j : Fin 4, - LatticeVertexIncidentCell x j ∈ T.cells) → ((x ∈ T.cells ∧ x - (1 : GaussianInt) ∈ - T.cells ∧ x - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells ∧ x - - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells) → ((∀ (U : ProtoTile), ∀ (V : - ProtoTile), ∀ (W : ProtoTile), ∀ (p : GaussianInt), ∀ (q : GaussianInt), ∀ (vertex : - GaussianInt), ∀ (vertices : Set GaussianInt), LatticeTile U → LatticeTile V → - Disjoint U.cells V.cells → SimpleGridPathBetween vertices (FootprintEdges U ∩ - FootprintEdges V) p q → vertex ∈ vertices → (∃ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell vertex j ∈ W.cells ∧ LatticeVertexIncidentCell vertex j ∉ - U.cells ∧ LatticeVertexIncidentCell vertex j ∉ V.cells) → vertex = p ∨ vertex = q) → - ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), (i, s) ≠ (j, - t) → ¬(i = (0 : Fin (3 : ℕ)) ∧ j = (0 : Fin (3 : ℕ))) → Disjoint (cert.P i s).cells - (cert.P j t).cells) → ((PeriodicTileAdjacentContactRegularity cert.modified) → ((∀ (m - : ℤ), ∀ (n : ℤ), (m, n) ≠ ((0 : ℤ), (0 : ℤ)) → Disjoint T.cells (TileTranslation T - ((↑m : GaussianInt) * cert.u + (↑n : GaussianInt) * cert.v)).cells) → ((∀ (label : - SixSubtileLabel), ∀ (m : Int), ∀ (n : Int), ∀ (a : GaussianInt), (a ∈ - (cert.modified.tile ⟨label, m, n⟩).cells) → (a ∈ (TileTranslation T ((m : - GaussianInt) * cert.u + (n : GaussianInt) * cert.v)).cells)) → (((x ∈ - FootprintVertices (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ - FootprintVertices (cert.P 1 true)) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ - (cert.P 0 true).cells ∧ LatticeVertexIncidentCell x j ∉ (cert.P 0 false).cells ∧ - LatticeVertexIncidentCell x j ∉ (cert.P 1 true).cells)) → ((((x ∈ FootprintVertices - (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ FootprintVertices - (cert.P 1 true)) → x ∈ FootprintVertices (cert.Q 1 true) ∩ FootprintVertices (cert.S - 2 false) ∩ FootprintVertices (cert.P 1 true))) → ((((x ∈ FootprintVertices (cert.P 0 - true) ∧ x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ FootprintVertices (cert.P 1 - false)) → x ∈ FootprintVertices (cert.Q 2 true) ∩ FootprintVertices (cert.S 1 false) - ∩ FootprintVertices (cert.P 1 false))) → ((((x ∈ FootprintVertices (cert.P 0 true) ∧ - x ∈ FootprintVertices (cert.P 1 true) ∧ x ∈ FootprintVertices (cert.P 2 false)) → x ∈ - FootprintVertices (cert.Q 1 true) ∩ FootprintVertices (cert.P 1 true) ∩ - FootprintVertices (cert.P 2 false))) → (((x ∈ FootprintVertices (cert.P 0 false) ∧ x - ∈ FootprintVertices (cert.P 1 false) ∧ x ∈ FootprintVertices (cert.P 2 true)) → x ∈ - FootprintVertices (cert.S 1 false) ∩ FootprintVertices (cert.P 1 false) ∩ - FootprintVertices (cert.P 2 true))))))))))))))))) ) := by + ∀ (q : Fin 4 → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (x : GaussianInt), + x ∈ FootprintVertices T → + x ∉ BoundaryFootprintVertices T → + GaussianTranslation (0 : GaussianInt) = id → + (∀ (W : ProtoTile), + ∀ (y : GaussianInt), + Finset.Nonempty W.cells → + y ∈ FootprintVertices W → + ∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell y j ∈ W.cells) → + (∀ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) → + x ∈ T.cells ∧ + x - (1 : GaussianInt) ∈ T.cells ∧ + x - (1 : GaussianInt) - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ + T.cells ∧ + x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ T.cells → + (∀ (U : ProtoTile), + ∀ (V : ProtoTile), + ∀ (W : ProtoTile), + ∀ (p : GaussianInt), + ∀ (q : GaussianInt), + ∀ (vertex : GaussianInt), + ∀ (vertices : Set GaussianInt), + LatticeTile U → + LatticeTile V → + Disjoint U.cells V.cells → + SimpleGridPathBetween vertices + (FootprintEdges U ∩ FootprintEdges V) p q → + vertex ∈ vertices → + (∃ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell vertex j ∈ W.cells ∧ + LatticeVertexIncidentCell vertex j ∉ U.cells ∧ + LatticeVertexIncidentCell vertex j ∉ V.cells) → + vertex = p ∨ vertex = q) → + (∀ (i : Fin (3 : ℕ)), + ∀ (s : Bool), + ∀ (j : Fin (3 : ℕ)), + ∀ (t : Bool), + (i, s) ≠ (j, t) → + ¬(i = (0 : Fin (3 : ℕ)) ∧ j = (0 : Fin (3 : ℕ))) → + Disjoint (cert.P i s).cells (cert.P j t).cells) → + PeriodicTileAdjacentContactRegularity cert.modified → + (∀ (m : ℤ), + ∀ (n : ℤ), + (m, n) ≠ ((0 : ℤ), (0 : ℤ)) → + Disjoint T.cells + (TileTranslation T + ((↑m : GaussianInt) * cert.u + + (↑n : GaussianInt) * cert.v)).cells) → + (∀ (label : SixSubtileLabel), + ∀ (m : Int), + ∀ (n : Int), + ∀ (a : GaussianInt), + a ∈ (cert.modified.tile ⟨label, m, n⟩).cells → + a ∈ + (TileTranslation T + ((m : GaussianInt) * cert.u + + (n : GaussianInt) * cert.v)).cells) → + (x ∈ FootprintVertices (cert.P 0 true) ∧ + x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 true) → + ∃ j : Fin 4, + LatticeVertexIncidentCell x j ∈ (cert.P 0 true).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.P 0 false).cells ∧ + LatticeVertexIncidentCell x j ∉ (cert.P 1 true).cells) → + x ∈ FootprintVertices (cert.P 0 false) ∧ + x ∈ FootprintVertices (cert.P 1 false) ∧ + x ∈ FootprintVertices (cert.P 2 true) → + x ∈ + FootprintVertices (cert.S 1 false) ∩ + FootprintVertices (cert.P 1 false) ∩ + FootprintVertices (cert.P 2 true) + ) := by classical intro q cfg C T cert x hx hxb htransZero incident hmissingT hfourCells path_endpoint_of_third - hseparate hregular blockSeparation tileCellInBlock hthirdABC firstJunction secondJunction - thirdJunction hBDE + hseparate hregular blockSeparation tileCellInBlock hthirdABC hBDE let d0 : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ let e0 : PeriodicSubtileIndex := ⟨.E, 0, 0⟩ have hDtile0 : cert.modified.tile d0 = cert.P 1 false := @@ -2041,9 +2080,9 @@ private theorem fourthJunction : FootprintVertices (cert.P 1 false) ∩ FootprintVertices (cert.P 2 true) := ⟨⟨hpNS, hpND⟩, hpNE⟩ simpa [hpNisP4] using htarget - · have hxJ7neq := JunctionRefinementGeometry.hxJ7neq q cfg C T cert x hx hxb - incident hmissingT hfourCells hthirdABC hBDE f4 g4 hthirdB hxDE hxvDE hxendpointDE - hpJ7c hblockSepDE hblockCellDE hxJ7 + · have hxJ7neq := JunctionRefinementGeometry.hxJ7neq q cfg C T cert x + incident hmissingT f4 g4 hxendpointDE + hpJ7c hblockSepDE hblockCellDE exact (hxJ7neq hxJ7).elim end JunctionCases @@ -2133,8 +2172,8 @@ theorem P4590T1JunctionRefinement x ∈ FootprintVertices (cert.P 1 true)) → x ∈ FootprintVertices (cert.Q 1 true) ∩ FootprintVertices (cert.S 2 false) ∩ FootprintVertices (cert.P 1 true)) := - JunctionCases.firstJunction q cfg C T cert x hx hxb htransZero incident hmissingT - hfourCells path_endpoint_of_third hbc hregular f g hf hg hBCpath blockSeparation + JunctionCases.firstJunction q cfg C T cert x htransZero incident hmissingT + path_endpoint_of_third hbc hregular f g hf hg hBCpath blockSeparation tileCellInBlock hBtile hCtile hBCdis hthirdABC have secondJunction : ((x ∈ FootprintVertices (cert.P 0 true) ∧ @@ -2142,18 +2181,18 @@ theorem P4590T1JunctionRefinement x ∈ FootprintVertices (cert.P 1 false)) → x ∈ FootprintVertices (cert.Q 2 true) ∩ FootprintVertices (cert.S 1 false) ∩ FootprintVertices (cert.P 1 false)) := - JunctionCases.secondJunction q cfg C T cert x hx hxb htransZero incident - hmissingT hfourCells precursorIsolationSupported path_endpoint_of_third hABO - hseparate hregular blockSeparation tileCellInBlock hthirdABC firstJunction + JunctionCases.secondJunction q cfg C T cert x htransZero incident + hmissingT precursorIsolationSupported path_endpoint_of_third hABO + hseparate hregular blockSeparation tileCellInBlock have thirdJunction : ((x ∈ FootprintVertices (cert.P 0 true) ∧ x ∈ FootprintVertices (cert.P 1 true) ∧ x ∈ FootprintVertices (cert.P 2 false)) → x ∈ FootprintVertices (cert.Q 1 true) ∩ FootprintVertices (cert.P 1 true) ∩ FootprintVertices (cert.P 2 false)) := - JunctionCases.thirdJunction q cfg C T cert x hx hxb htransZero incident hmissingT - hfourCells path_endpoint_of_third hseparate hACseparate hregular blockSeparation - tileCellInBlock hthirdABC firstJunction secondJunction + JunctionCases.thirdJunction q cfg C T cert x htransZero incident hmissingT + path_endpoint_of_third hseparate hACseparate hregular blockSeparation + tileCellInBlock have fourthJunction : ((x ∈ FootprintVertices (cert.P 0 false) ∧ x ∈ FootprintVertices (cert.P 1 false) ∧ @@ -2162,7 +2201,7 @@ theorem P4590T1JunctionRefinement FootprintVertices (cert.P 1 false) ∩ FootprintVertices (cert.P 2 true)) := JunctionCases.fourthJunction q cfg C T cert x hx hxb htransZero incident hmissingT hfourCells path_endpoint_of_third hseparate hregular blockSeparation - tileCellInBlock hthirdABC firstJunction secondJunction thirdJunction + tileCellInBlock hthirdABC exact ⟨firstJunction, secondJunction, thirdJunction, fourthJunction⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1MixedCompanionMarks.lean b/LeanPool/ApollonianSuperharmonic/P4590T1MixedCompanionMarks.lean index 951c525d0e..c481bb2a5d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1MixedCompanionMarks.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1MixedCompanionMarks.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTouchingDisjoint public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate public import LeanPool.ApollonianSuperharmonic.BandOrientedChildParentEndpoints @@ -325,18 +326,7 @@ private theorem incident : convert ha using 1 ext <;> simp -private theorem touchDisjoint : - (by - classical - exact - ∀ (M : ProtoTile), ∀ (N : ProtoTile), (M.cells.Nonempty) → ((N.cells.Nonempty) → - ((TileTouching M N) → (Disjoint M.cells N.cells))) ) := by - classical - intro M N hm hn ht - rcases ht with ht | ht | ht - · exact ht.2.2.1 - · rw [ht.1] at hm; simp at hm - · rw [ht.1] at hn; simp at hn +private abbrev touchDisjoint := ApollonianSuperharmonic.TileTouchingDisjoint.cells private theorem nested : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean index c319f9002b..58ba5eca3d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence public import LeanPool.ApollonianSuperharmonic.P4590T1OppositeCellsStar public import LeanPool.ApollonianSuperharmonic.P4339T1PrecursorSupportGeometry @@ -25,20 +26,7 @@ namespace ApollonianSuperharmonic namespace MixedInteriorGeometry -private theorem raw_incident : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (z : GaussianInt), (U.cells.Nonempty) → ((z ∈ FootprintVertices U) → - (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ U.cells)) ) := by - classical - intro U z hne hz - simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hz - rcases hz with ⟨a, ha, rfl | rfl | rfl | rfl⟩ - · exact ⟨0, by simpa [LatticeVertexIncidentCell] using ha⟩ - · exact ⟨1, by simpa [LatticeVertexIncidentCell] using ha⟩ - · exact ⟨3, by simpa [LatticeVertexIncidentCell] using ha⟩ - · exact ⟨2, by simpa [LatticeVertexIncidentCell, sub_sub] using ha⟩ +private abbrev raw_incident := ApollonianSuperharmonic.LatticeFootprintIncidence.incidentCell private theorem incident_foot : (by @@ -359,125 +347,20 @@ private theorem pair_result : exact noOtherFoot a b k hab hak hbk hnot (hthird k (fun h => hak h.symm) (fun h => hbk h.symm)) ha hb -private theorem hthirdAD : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), (∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → - ((¬ (i = 0 ∧ j = 0)) → (Disjoint (cert.P i s).cells (cert.P j t).cells))) → ( - let A : Fin 3 × Bool := (0, true) - let D : Fin 3 × Bool := (1, false) - ∀ c', c' ≠ A → c' ≠ D → Disjoint (cert.P A.1 A.2).cells (cert.P c'.1 c'.2).cells ∨ - Disjoint (cert.P D.1 D.2).cells (cert.P c'.1 c'.2).cells) ) := by - classical - intro q cfg C T cert selected_disjoint A D c' hca hcd - rcases c' with ⟨i, s⟩ - fin_cases i <;> cases s - all_goals first - | exact Or.inl (selected_disjoint _ _ _ _ (by decide) (by decide)) - | exact Or.inr (selected_disjoint _ _ _ _ (by decide) (by decide)) - -private theorem hthirdAF : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), (∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → - ((¬ (i = 0 ∧ j = 0)) → (Disjoint (cert.P i s).cells (cert.P j t).cells))) → ( - let A : Fin 3 × Bool := (0, true) - let F : Fin 3 × Bool := (2, false) - ∀ c', c' ≠ A → c' ≠ F → Disjoint (cert.P A.1 A.2).cells (cert.P c'.1 c'.2).cells ∨ - Disjoint (cert.P F.1 F.2).cells (cert.P c'.1 c'.2).cells) ) := by - classical - intro q cfg C T cert selected_disjoint A F c' hca hcf - rcases c' with ⟨i, s⟩ - fin_cases i <;> cases s - all_goals first - | exact Or.inl (selected_disjoint _ _ _ _ (by decide) (by decide)) - | exact Or.inr (selected_disjoint _ _ _ _ (by decide) (by decide)) - -private theorem hthirdCB : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), (∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → - ((¬ (i = 0 ∧ j = 0)) → (Disjoint (cert.P i s).cells (cert.P j t).cells))) → ( - let B : Fin 3 × Bool := (0, false) - let C' : Fin 3 × Bool := (1, true) - ∀ c', c' ≠ C' → c' ≠ B → Disjoint (cert.P C'.1 C'.2).cells (cert.P c'.1 c'.2).cells ∨ - Disjoint (cert.P B.1 B.2).cells (cert.P c'.1 c'.2).cells) ) := by - classical - intro q cfg C T cert selected_disjoint B C' c' hcc hcb - rcases c' with ⟨i, s⟩ - fin_cases i <;> cases s - all_goals first - | exact Or.inl (selected_disjoint _ _ _ _ (by decide) (by decide)) - | exact Or.inr (selected_disjoint _ _ _ _ (by decide) (by decide)) - -private theorem hthirdEB : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), (∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → - ((¬ (i = 0 ∧ j = 0)) → (Disjoint (cert.P i s).cells (cert.P j t).cells))) → ( - let B : Fin 3 × Bool := (0, false) - let E : Fin 3 × Bool := (2, true) - ∀ c', c' ≠ E → c' ≠ B → Disjoint (cert.P E.1 E.2).cells (cert.P c'.1 c'.2).cells ∨ - Disjoint (cert.P B.1 B.2).cells (cert.P c'.1 c'.2).cells) ) := by - classical - intro q cfg C T cert selected_disjoint B E c' hce hcb - rcases c' with ⟨i, s⟩ - fin_cases i <;> cases s - all_goals first - | exact Or.inl (selected_disjoint _ _ _ _ (by decide) (by decide)) - | exact Or.inr (selected_disjoint _ _ _ _ (by decide) (by decide)) - -private theorem hthirdCF : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), (∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → - ((¬ (i = 0 ∧ j = 0)) → (Disjoint (cert.P i s).cells (cert.P j t).cells))) → ( - let C' : Fin 3 × Bool := (1, true) - let F : Fin 3 × Bool := (2, false) - ∀ c', c' ≠ C' → c' ≠ F → Disjoint (cert.P C'.1 C'.2).cells (cert.P c'.1 c'.2).cells ∨ - Disjoint (cert.P F.1 F.2).cells (cert.P c'.1 c'.2).cells) ) := by - classical - intro q cfg C T cert selected_disjoint C' F c' hcc hcf - rcases c' with ⟨i, s⟩ - fin_cases i <;> cases s - all_goals first - | exact Or.inl (selected_disjoint _ _ _ _ (by decide) (by decide)) - | exact Or.inr (selected_disjoint _ _ _ _ (by decide) (by decide)) - -private theorem hthirdED : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), (∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (s : Bool), ∀ (t : Bool), ((i, s) ≠ (j, t)) → - ((¬ (i = 0 ∧ j = 0)) → (Disjoint (cert.P i s).cells (cert.P j t).cells))) → ( - let D : Fin 3 × Bool := (1, false) - let E : Fin 3 × Bool := (2, true) - ∀ c', c' ≠ E → c' ≠ D → Disjoint (cert.P E.1 E.2).cells (cert.P c'.1 c'.2).cells ∨ - Disjoint (cert.P D.1 D.2).cells (cert.P c'.1 c'.2).cells) ) := by - classical - intro q cfg C T cert selected_disjoint D E c' hce hcd - rcases c' with ⟨i, s⟩ - fin_cases i <;> cases s - all_goals first - | exact Or.inl (selected_disjoint _ _ _ _ (by decide) (by decide)) - | exact Or.inr (selected_disjoint _ _ _ _ (by decide) (by decide)) +private theorem thirdFamilyDisjointness (P : Fin 3 → Bool → ProtoTile) + (hdisjoint : ∀ i j s t, (i, s) ≠ (j, t) → ¬(i = 0 ∧ j = 0) → + Disjoint (P i s).cells (P j t).cells) + (a b c : Fin 3 × Bool) (hab : a.1 ≠ b.1) : + Disjoint (P a.1 a.2).cells (P c.1 c.2).cells ∨ + Disjoint (P b.1 b.2).cells (P c.1 c.2).cells := by + by_cases hac : a.1 = c.1 + · right + have hbc : b.1 ≠ c.1 := fun hbc => hab (hac.trans hbc.symm) + exact hdisjoint _ _ _ _ (fun h => hbc (congrArg Prod.fst h)) + (fun h => hbc (h.1.trans h.2.symm)) + · left + exact hdisjoint _ _ _ _ (fun h => hac (congrArg Prod.fst h)) + (fun h => hac (h.1.trans h.2.symm)) end MixedInteriorGeometry @@ -612,28 +495,34 @@ theorem P4590T1MixedInteriorGeometry let F : Fin 3 × Bool := (2, false) have hthirdAD : ∀ c', c' ≠ A → c' ≠ D → Disjoint (cert.P A.1 A.2).cells (cert.P c'.1 c'.2).cells ∨ - Disjoint (cert.P D.1 D.2).cells (cert.P c'.1 c'.2).cells := - MixedInteriorGeometry.hthirdAD q cfg C T cert selected_disjoint + Disjoint (cert.P D.1 D.2).cells (cert.P c'.1 c'.2).cells := by + intro c' hfirst hsecond + exact MixedInteriorGeometry.thirdFamilyDisjointness cert.P selected_disjoint A D c' (by decide) have hthirdAF : ∀ c', c' ≠ A → c' ≠ F → Disjoint (cert.P A.1 A.2).cells (cert.P c'.1 c'.2).cells ∨ - Disjoint (cert.P F.1 F.2).cells (cert.P c'.1 c'.2).cells := - MixedInteriorGeometry.hthirdAF q cfg C T cert selected_disjoint + Disjoint (cert.P F.1 F.2).cells (cert.P c'.1 c'.2).cells := by + intro c' hfirst hsecond + exact MixedInteriorGeometry.thirdFamilyDisjointness cert.P selected_disjoint A F c' (by decide) have hthirdCB : ∀ c', c' ≠ C' → c' ≠ B → Disjoint (cert.P C'.1 C'.2).cells (cert.P c'.1 c'.2).cells ∨ - Disjoint (cert.P B.1 B.2).cells (cert.P c'.1 c'.2).cells := - MixedInteriorGeometry.hthirdCB q cfg C T cert selected_disjoint + Disjoint (cert.P B.1 B.2).cells (cert.P c'.1 c'.2).cells := by + intro c' hfirst hsecond + exact MixedInteriorGeometry.thirdFamilyDisjointness cert.P selected_disjoint C' B c' (by decide) have hthirdEB : ∀ c', c' ≠ E → c' ≠ B → Disjoint (cert.P E.1 E.2).cells (cert.P c'.1 c'.2).cells ∨ - Disjoint (cert.P B.1 B.2).cells (cert.P c'.1 c'.2).cells := - MixedInteriorGeometry.hthirdEB q cfg C T cert selected_disjoint + Disjoint (cert.P B.1 B.2).cells (cert.P c'.1 c'.2).cells := by + intro c' hfirst hsecond + exact MixedInteriorGeometry.thirdFamilyDisjointness cert.P selected_disjoint E B c' (by decide) have hthirdCF : ∀ c', c' ≠ C' → c' ≠ F → Disjoint (cert.P C'.1 C'.2).cells (cert.P c'.1 c'.2).cells ∨ - Disjoint (cert.P F.1 F.2).cells (cert.P c'.1 c'.2).cells := - MixedInteriorGeometry.hthirdCF q cfg C T cert selected_disjoint + Disjoint (cert.P F.1 F.2).cells (cert.P c'.1 c'.2).cells := by + intro c' hfirst hsecond + exact MixedInteriorGeometry.thirdFamilyDisjointness cert.P selected_disjoint C' F c' (by decide) have hthirdED : ∀ c', c' ≠ E → c' ≠ D → Disjoint (cert.P E.1 E.2).cells (cert.P c'.1 c'.2).cells ∨ - Disjoint (cert.P D.1 D.2).cells (cert.P c'.1 c'.2).cells := - MixedInteriorGeometry.hthirdED q cfg C T cert selected_disjoint + Disjoint (cert.P D.1 D.2).cells (cert.P c'.1 c'.2).cells := by + intro c' hfirst hsecond + exact MixedInteriorGeometry.thirdFamilyDisjointness cert.P selected_disjoint E D c' (by decide) refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ · intro ha hd exact pair_result A D B (by decide) (by decide) (by decide) (by simp [A, D]) diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean index 543d3c1669..8121daf4ff 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean @@ -71,20 +71,23 @@ private theorem rawBoundary : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ - BoundaryFootprintVertices T) → ((Nat.card - { is : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 - : ℕ)) → ((GaussianRealPoint x ≠ TileCentroid T) → ((x ∈ BoundaryFootprintVertices - (cert.P (0 : Fin (3 : ℕ)) true)) → ((x ∈ BoundaryFootprintVertices (cert.P (0 : Fin - (3 : ℕ)) false)) → ( - let O := cert.O - let seg := cert.exceptionalSegments - (O.cells.Nonempty ∨ x ≠ seg.a) → (∀ (U : ProtoTile), (U.cells.Nonempty) → ((x ∈ - BoundaryFootprintVertices U) → (x ∈ FootprintVertices U))))))))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (x : GaussianInt), + Nat.card + { is : Fin (3 : ℕ) × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = + (2 : ℕ) → + GaussianRealPoint x ≠ TileCentroid T → + ∀ (U : ProtoTile), + U.cells.Nonempty → + x ∈ BoundaryFootprintVertices U → x ∈ FootprintVertices U + ) := by classical - intro q cfg C T cert x hx hxb hk hnoncentral hA hB O seg hnonemptyO U hUne hb + intro q cfg C T cert x hk hnoncentral U hUne hb simp only [BoundaryFootprintVertices, hUne, ite_true, Set.mem_ofPred_eq] at hb obtain ⟨e, he, hz⟩ := hb simp only [FootprintVertices, hUne, ite_true, Set.mem_ofPred_eq] @@ -102,23 +105,28 @@ private theorem boundary_sectors : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ - BoundaryFootprintVertices T) → ((Nat.card - { is : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 - : ℕ)) → ((GaussianRealPoint x ≠ TileCentroid T) → ((x ∈ BoundaryFootprintVertices - (cert.P (0 : Fin (3 : ℕ)) true)) → ((x ∈ BoundaryFootprintVertices (cert.P (0 : Fin - (3 : ℕ)) false)) → ( - let O := cert.O - let seg := cert.exceptionalSegments - (O.cells.Nonempty ∨ x ≠ seg.a) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → ((x ∈ - BoundaryFootprintVertices U) → (x ∈ FootprintVertices U))) → (∀ (U : ProtoTile), - (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → ((∃ j : Fin 4, - LatticeVertexIncidentCell x j ∈ U.cells) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell x - j ∉ U.cells))))))))))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (x : GaussianInt), + Nat.card + { is : Fin (3 : ℕ) × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = + (2 : ℕ) → + GaussianRealPoint x ≠ TileCentroid T → + (∀ (U : ProtoTile), + U.cells.Nonempty → + x ∈ BoundaryFootprintVertices U → x ∈ FootprintVertices U) → + ∀ (U : ProtoTile), + U.cells.Nonempty → + x ∈ BoundaryFootprintVertices U → + (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells) ∧ + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ U.cells + ) := by classical - intro q cfg C T cert x hx hxb hk hnoncentral hA hB O seg hnonemptyO rawBoundary U hne hb + intro q cfg C T cert x hk hnoncentral rawBoundary U hne hb have hraw := rawBoundary U hne hb refine ⟨?_, ?_⟩ · simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hraw @@ -405,37 +413,29 @@ private theorem incidentRaw : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ - BoundaryFootprintVertices T) → ((Nat.card - { is : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 - : ℕ)) → ((GaussianRealPoint x ≠ TileCentroid T) → ((x ∈ BoundaryFootprintVertices - (cert.P (0 : Fin (3 : ℕ)) true)) → ((x ∈ BoundaryFootprintVertices (cert.P (0 : Fin - (3 : ℕ)) false)) → ( - let A := cert.P 0 true - let B := cert.P 0 false - let O := cert.O - let seg := cert.exceptionalSegments - (O.cells.Nonempty ∨ x ≠ seg.a) → ((∀ (U : ProtoTile), (U.cells.Nonempty) → ((x ∈ - BoundaryFootprintVertices U) → (x ∈ FootprintVertices U))) → ((∀ (U : ProtoTile), - (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices U) → ((∃ j : Fin 4, - LatticeVertexIncidentCell x j ∈ U.cells) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell x - j ∉ U.cells)))) → (((∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ A.cells) ∧ (∃ j : - Fin 4, LatticeVertexIncidentCell x j ∉ A.cells)) → (((∃ j : Fin 4, - LatticeVertexIncidentCell x j ∈ B.cells) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell x - j ∉ B.cells)) → ((∀ (i : Fin 3), ∀ (s : Bool), ((i, s) ≠ ((0 : Fin 3), true)) → (((i, - s) ≠ ((0 : Fin 3), false)) → ((x ∈ BoundaryFootprintVertices (cert.P i s)) → - (False)))) → ((x ∉ FootprintVertices O ∨ O.cells.Nonempty) → ((x ∈ FootprintVertices - A) → ((x ∈ FootprintVertices B) → ((x ∉ FootprintVertices O → x ∈ FootprintVertices - (TileCellComplement A O) ∩ FootprintVertices B) → ((x ∉ FootprintVertices O → x ∈ - seg.left ∨ x ∈ seg.middle ∨ x ∈ seg.right) → (∀ (U : ProtoTile), (U.cells.Nonempty) → - ((x ∈ FootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ - U.cells))))))))))))))))))) ) := by + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (x : GaussianInt), + Nat.card + { is : Fin (3 : ℕ) × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = + (2 : ℕ) → + GaussianRealPoint x ≠ TileCentroid T → + (∀ (i : Fin 3), + ∀ (s : Bool), + (i, s) ≠ ((0 : Fin 3), true) → + (i, s) ≠ ((0 : Fin 3), false) → + x ∈ BoundaryFootprintVertices (cert.P i s) → False) → + ∀ (U : ProtoTile), + U.cells.Nonempty → + x ∈ FootprintVertices U → + ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells + ) := by classical - intro q cfg C T cert x hx hxb hk hnoncentral hA hB A B O seg hnonemptyO rawBoundary - boundary_sectors hIncidentA hIncidentB noThird hnotO hxA' hxB' hmodifiedCommon - hsegMembership U hUne hu + intro q cfg C T cert x hk hnoncentral noThird U hUne hu simp only [FootprintVertices, hUne, ite_true, Set.mem_ofPred_eq] at hu rcases hu with ⟨z, hz, hcorner⟩ rcases hcorner with h | h | h | h @@ -945,14 +945,13 @@ theorem P4590T1RestoredBoundaryGeometry : have hnonemptyO := RestoredBoundaryGeometry.hnonemptyO q cfg C T cert x hnoncentral hempty_anchor have rawBoundary (U : ProtoTile) (hUne : U.cells.Nonempty) (hb : x ∈ BoundaryFootprintVertices U) : x ∈ FootprintVertices U := - RestoredBoundaryGeometry.rawBoundary q cfg C T cert x hx hxb hk hnoncentral hA hB - hnonemptyO U hUne hb + RestoredBoundaryGeometry.rawBoundary q cfg C T cert x hk hnoncentral U hUne hb have boundary_sectors (U : ProtoTile) (hne : U.cells.Nonempty) (hb : x ∈ BoundaryFootprintVertices U) : (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ U.cells) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ U.cells) := - RestoredBoundaryGeometry.boundary_sectors q cfg C T cert x hx hxb hk hnoncentral hA hB - hnonemptyO rawBoundary U hne hb + RestoredBoundaryGeometry.boundary_sectors q cfg C T cert x hk hnoncentral rawBoundary U + hne hb have hIncidentA : (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ A.cells) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ A.cells) := boundary_sectors A hAne (by simpa [A] using hA) @@ -994,9 +993,7 @@ theorem P4590T1RestoredBoundaryGeometry : (RestoredBoundaryGeometry.hf1 q cfg C T cert f g hfaces) (RestoredBoundaryGeometry.hf2 q cfg C T cert f g hfaces) (RestoredBoundaryGeometry.hf12 q cfg C T cert) hrho1 hrho2) hconnectorWalk - have incidentRaw := RestoredBoundaryGeometry.incidentRaw q cfg C T cert x hx hxb hk hnoncentral - hA hB hnonemptyO rawBoundary boundary_sectors hIncidentA hIncidentB noThird hnotO hxA' hxB' - hmodifiedCommon hsegMembership + have incidentRaw := RestoredBoundaryGeometry.incidentRaw q cfg C T cert x hk hnoncentral noThird have hOpositive := RestoredBoundaryGeometry.hOpositive q cfg C T cert x hnoncentral hOcent have hOcuts := RestoredBoundaryGeometry.hOcuts q cfg C T cert x hpre hIncidentA hIncidentB translation_zero incidentRaw hOpositive diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean index 4cf3a10904..cf93126376 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion +public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence public import LeanPool.ApollonianSuperharmonic.PairAssignmentFacts public import LeanPool.ApollonianSuperharmonic.BandLayoutCentroidCoordinates public import LeanPool.ApollonianSuperharmonic.BandLayoutFaceSupport @@ -299,45 +301,9 @@ private theorem touching_disjoint : · rw [ht.1] at hVne simp at hVne -private theorem rawIncident : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (z : GaussianInt), (U.cells.Nonempty) → ((z ∈ FootprintVertices U) → - (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ U.cells)) ) := by - classical - intro U z hne hz - simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hz - rcases hz with ⟨cell, hc, h | h | h | h⟩ - · refine ⟨0, ?_⟩ - simpa [LatticeVertexIncidentCell] using h ▸ hc - · refine ⟨1, ?_⟩ - subst z - simpa [LatticeVertexIncidentCell] using hc - · refine ⟨3, ?_⟩ - subst z - simpa [LatticeVertexIncidentCell] using hc - · refine ⟨2, ?_⟩ - change z - 1 - ⟨0, 1⟩ ∈ U.cells - rw [h] - convert hc using 1; ext <;> simp +private abbrev rawIncident := ApollonianSuperharmonic.LatticeFootprintIncidence.incidentCell -private theorem edgeEndpoint : - (by - classical - exact - ∀ (U : ProtoTile), - ∀ (e : Finset GaussianInt), - e ∈ FootprintEdges U → ∀ (z : GaussianInt), z ∈ e → z ∈ FootprintVertices U - ) := by - classical - intro U e he z hz - rcases he with ⟨cell, hc, hshape | hshape | hshape | hshape⟩ - all_goals rw [hshape] at hz - all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hz - all_goals rw [FootprintVertices, ite_eq_left (show U.cells.Nonempty from ⟨cell, hc⟩)] - all_goals refine ⟨cell, hc, ?_⟩ - all_goals rcases hz with hz | hz <;> simp [hz] +private abbrev edgeEndpoint := ApollonianSuperharmonic.BoundaryFootprintInclusion.edgeVertex private theorem threeBoundaries : (by @@ -1158,10 +1124,9 @@ private theorem hEdgesQC : FootprintVertices (cert.P 1 true) ⊆ FootprintVertices (cert.Q 1 true) ∩ FootprintVertices (cert.P 1 true) → - (cert.P 1 true).cells.Nonempty → - (∃ y z : GaussianInt, - ∃ e f : Finset GaussianInt, - e ≠ f ∧ + (∃ y z : GaussianInt, + ∃ e f : Finset GaussianInt, + e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ e ∈ @@ -1173,17 +1138,17 @@ private theorem hEdgesQC : e = { y, x } ∧ f = { x, z } ∧ FourNeighborAdjacent y x ∧ FourNeighborAdjacent x z) → - (∀ x ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true), - ∀ y ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true), + (∀ x ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true), + ∀ y ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true), FourNeighborAdjacent x y → { x, y } ∈ FootprintEdges (cert.Q (1 : Fin (3 : ℕ)) true)) → - (∀ x ∈ FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true), + (∀ x ∈ FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true), ∀ y ∈ FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true), FourNeighborAdjacent x y → { x, y } ∈ FootprintEdges (cert.P (1 : Fin (3 : ℕ)) true)) → - ∃ e f : Finset GaussianInt, + ∃ e f : Finset GaussianInt, e ≠ f ∧ x ∈ e ∧ x ∈ f ∧ @@ -1195,7 +1160,7 @@ private theorem hEdgesQC : FootprintEdges (cert.P 1 true) ) := by classical - intro q cfg C T cert x edgeEndpoint raw_support hCne hpathEndpoints regQ regC + intro q cfg C T cert x edgeEndpoint raw_support hpathEndpoints regQ regC obtain ⟨y, z, e, f, hef, hxe, hxf, he, hf, rfl, rfl, hyx, hxz⟩ := hpathEndpoints have hyA := edgeEndpoint (cert.P 0 true) @@ -1709,41 +1674,62 @@ private theorem hstar : (by classical exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ - BoundaryFootprintVertices T) → ((Nat.card - { is : Fin (3 : ℕ) × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = (2 - : ℕ)) → (∀ (u : GaussianInt), - let w := BandVectors.1 (q 3) (q 2) - let t : GaussianInt := - ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ - (x ∈ FootprintVertices (cert.P (0 : Fin (3 : ℕ)) false)) → ((x ∈ FootprintVertices - (cert.P (1 : Fin (3 : ℕ)) false)) → ( - let F : GaussianInt → GaussianInt := fun z => t - z - let v : GaussianInt := F x - (∀ (i : Fin 3), F '' FootprintVertices (cert.P i true) = FootprintVertices (cert.P i - false)) → ((∀ (i : Fin 3), ∀ (s : Bool), v ∈ BoundaryFootprintVertices (cert.P i s) ↔ - x ∈ BoundaryFootprintVertices (cert.P i (!s))) → ((v ∈ FootprintVertices (cert.P 0 - true)) → ((v ∈ FootprintVertices (cert.P 1 true)) → ( - let A := {is : Fin 3 × Bool // - v ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} - (Nat.card A = 2) → ((v ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∧ (∀ (y : - GaussianInt), y = v ∨ y = v + (1 : GaussianInt) ∨ y = v - (1 : GaussianInt) ∨ y = v + - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ y = v - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → y ∈ - FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∨ y ∈ FootprintVertices (cert.P (1 - : Fin (3 : ℕ)) true)) ∧ ∀ (z : GaussianInt), z = v ∨ z = v - (1 : GaussianInt) ∨ z = - v - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ z = v - (1 : GaussianInt) - (⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) → z ∈ (cert.Q (1 : Fin (3 : ℕ)) true).cells ∨ z ∈ (cert.P (1 : Fin - (3 : ℕ)) true).cells) → ((F '' FootprintVertices (cert.Q 1 true) = FootprintVertices - (cert.S 1 false)) → ((∀ (U : ProtoTile), ∀ (V : ProtoTile), (F '' FootprintVertices U - = FootprintVertices V) → (∀ (z : GaussianInt), (F z ∈ FootprintVertices U) → (z ∈ - FootprintVertices V))) → (∀ (y : GaussianInt), (y = x ∨ y = x + 1 ∨ y = x - 1 ∨ - y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → (y ∈ FootprintVertices (cert.S 1 false) ∨ y ∈ - FootprintVertices (cert.P 1 false))))))))))))))) ) := by - classical - intro q cfg C T cert x hx hxb hk u w t hB hD F v parentFootprint hboundaryFlip hvA hvC A hvk - hpositive childFoot moveFoot y hy + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (cfg : BandOrderedGeneralConfiguration q), + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C T), + ∀ (x : GaussianInt), + Nat.card + { is : Fin (3 : ℕ) × Bool // + x ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } = + (2 : ℕ) → + ∀ (u : GaussianInt), + let w := BandVectors.1 (q 3) (q 2); + let t : GaussianInt := + ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩; + let F : GaussianInt → GaussianInt := fun z => t - z; + let v : GaussianInt := F x; + (∀ (i : Fin 3), + F '' FootprintVertices (cert.P i true) = + FootprintVertices (cert.P i false)) → + let A := + { is : Fin 3 × Bool // + v ∈ BoundaryFootprintVertices (cert.P is.1 is.2) } + Nat.card A = 2 → + (v ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∧ + (∀ (y : GaussianInt), + y = v ∨ + y = v + (1 : GaussianInt) ∨ + y = v - (1 : GaussianInt) ∨ + y = v + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ + y = v - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → + y ∈ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∨ + y ∈ FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true)) ∧ + ∀ (z : GaussianInt), + z = v ∨ + z = v - (1 : GaussianInt) ∨ + z = v - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ + z = + v - (1 : GaussianInt) - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) → + z ∈ (cert.Q (1 : Fin (3 : ℕ)) true).cells ∨ + z ∈ (cert.P (1 : Fin (3 : ℕ)) true).cells) → + F '' FootprintVertices (cert.Q 1 true) = + FootprintVertices (cert.S 1 false) → + (∀ (U : ProtoTile), + ∀ (V : ProtoTile), + F '' FootprintVertices U = FootprintVertices V → + ∀ (z : GaussianInt), + F z ∈ FootprintVertices U → z ∈ FootprintVertices V) → + ∀ (y : GaussianInt), + y = x ∨ + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ FootprintVertices (cert.S 1 false) ∨ + y ∈ FootprintVertices (cert.P 1 false) + ) := by + classical + intro q cfg C T cert x hk u w t F v parentFootprint A hvk hpositive childFoot moveFoot y hy have hFinvol (z : GaussianInt) : F (F z) = z := by dsimp [F] abel @@ -2093,7 +2079,7 @@ private theorem positiveCase : touching_disjoint _ _ _ hQne hCne cert.double_third have hresult := interfaceConclusion point (cert.Q 1 true) (cert.P 1 true) hQ hCtile hdis (RightInteriorGeometry.hEdgesQC q cfg C T cert point - edgeEndpoint raw_support hCne (RightInteriorGeometry.hpathEndpoints q cfg C T cert point + edgeEndpoint raw_support (RightInteriorGeometry.hpathEndpoints q cfg C T cert point twoPathEdges hA hC (RightInteriorGeometry.hcompleteOriginal q cfg C T cert hretainEdges hretainVertices (RightInteriorGeometry.hcomplete q cfg C T cert htileA htileC hraw f g hpath hpair hrho1 hrho3)) (RightInteriorGeometry.hz1ne q cfg C T cert point hk @@ -2267,8 +2253,8 @@ theorem P4590T1RightInteriorGeometry : z ∈ FootprintVertices V := RightInteriorGeometry.moveFoot q u hFinvol image_mem U V hUV z hz exact ⟨by exact moveFoot _ _ childFoot x (by simpa [hFinvol] using hpositive.1), - (RightInteriorGeometry.hstar q cfg C T cert x hx hxb hk u hB hD parentFootprint - hboundaryFlip hvA hvC hvk hpositive childFoot moveFoot), + (RightInteriorGeometry.hstar q cfg C T cert x hk u parentFootprint hvk hpositive childFoot + moveFoot), (RightInteriorGeometry.hcellsAt1062 q cfg C T cert x u outerCells hpositive hHQcells (RightInteriorGeometry.moveCell q u hHcells) (RightInteriorGeometry.hcellLift q x u))⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean b/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean index 64211c612e..a7b0474647 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean @@ -456,49 +456,94 @@ private theorem cornerRescue : (by classical exact - ∀ (Dplus : ProtoTile), ∀ (Dminus : ProtoTile), ∀ (O : ProtoTile), ∀ (O' : ProtoTile), ∀ - (X : ProtoTile), ∀ (Y : ProtoTile), ∀ (U : ProtoTile), ∀ (V : ProtoTile), - (Finset.Nonempty O.cells) → ((Finset.Nonempty X.cells) → ((Finset.Nonempty Y.cells) → - ((Finset.Nonempty U.cells) → ((Finset.Nonempty V.cells) → ((PrecursorBoundaryArcData - Dplus Dminus O O' X Y U V) → ((NoCheckerboardCellVertex (Dplus.cells : Set - LatticeCell)) → ((NoCheckerboardCellVertex (Dminus.cells : Set LatticeCell)) → - ((Disjoint Dplus.cells O.cells) → ((Disjoint Dminus.cells O.cells) → ((∀ (T : - ProtoTile), ∀ (y : GaussianInt), ∀ (j : Fin 4), ((LatticeVertexIncidentCell y j ∈ - T.cells ∧ LatticeVertexIncidentCell y (j + 1) ∉ T.cells) ∨ (LatticeVertexIncidentCell - y j ∉ T.cells ∧ LatticeVertexIncidentCell y (j + 1) ∈ T.cells)) → (y ∈ - BoundaryFootprintVertices T)) → ((∀ (y : GaussianInt), ∀ (j : Fin 4), - ((LatticeVertexIncidentCell y j ∈ O.cells ∧ LatticeVertexIncidentCell y (j + 1) ∉ - O.cells) ∨ (LatticeVertexIncidentCell y j ∉ O.cells ∧ LatticeVertexIncidentCell y (j - + 1) ∈ O.cells)) → ((LatticeVertexIncidentCell y j ∉ O.cells) → - (LatticeVertexIncidentCell y j ∈ Dplus.cells ∨ LatticeVertexIncidentCell y j ∈ - Dminus.cells))) → ((∀ (y : GaussianInt), ∀ (j : Fin 4), ((LatticeVertexIncidentCell y - j ∈ O.cells ∧ LatticeVertexIncidentCell y (j + 1) ∉ O.cells) ∨ - (LatticeVertexIncidentCell y j ∉ O.cells ∧ LatticeVertexIncidentCell y (j + 1) ∈ - O.cells)) → ((LatticeVertexIncidentCell y (j + 1) ∉ O.cells) → - (LatticeVertexIncidentCell y (j + 1) ∈ Dplus.cells ∨ LatticeVertexIncidentCell y (j + - 1) ∈ Dminus.cells))) → ((∀ (T : ProtoTile), (NoCheckerboardCellVertex (T.cells : Set - LatticeCell)) → (∀ (y : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell y (j - + 1) ∈ T.cells) → ((LatticeVertexIncidentCell y (j + 3) ∈ T.cells) → - ((LatticeVertexIncidentCell y j ∉ T.cells) → (LatticeVertexIncidentCell y (j + 2) ∈ - T.cells))))) → ((∀ (J : ProtoTile), ∀ (K : ProtoTile), (J.cells.Nonempty) → - ((K.cells.Nonempty) → ((J.cells ⊆ Dplus.cells) → ((K.cells ⊆ Dminus.cells) → - ((TileTouching J K) → (∀ (y : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell - y j ∈ O.cells) → (((LatticeVertexIncidentCell y (j + 1) ∈ Dplus.cells ∧ - LatticeVertexIncidentCell y (j + 3) ∈ Dminus.cells) ∨ (LatticeVertexIncidentCell y (j - + 1) ∈ Dminus.cells ∧ LatticeVertexIncidentCell y (j + 3) ∈ Dplus.cells)) → - ((LatticeVertexIncidentCell y (j + 2) ∉ Dplus.cells) → ((LatticeVertexIncidentCell y - (j + 2) ∉ Dminus.cells) → ((y ∈ BoundaryFootprintVertices J) → ((y ∈ - BoundaryFootprintVertices K) → (False)))))))))))) → (∀ (y : GaussianInt), ∀ (j : Fin - (4 : ℕ)), LatticeVertexIncidentCell y j ∈ O.cells → LatticeVertexIncidentCell y (j + - (2 : Fin (4 : ℕ))) ∉ O.cells → LatticeVertexIncidentCell y (j + (1 : Fin (4 : ℕ))) ∉ - O.cells → LatticeVertexIncidentCell y (j + (3 : Fin (4 : ℕ))) ∉ O.cells → - LatticeVertexIncidentCell y (j + (2 : Fin (4 : ℕ))) ∈ Dplus.cells ∨ - LatticeVertexIncidentCell y (j + (2 : Fin (4 : ℕ))) ∈ Dminus.cells))))))))))))))) ) + ∀ (Dplus : ProtoTile), + ∀ (Dminus : ProtoTile), + ∀ (O : ProtoTile), + ∀ (O' : ProtoTile), + ∀ (X : ProtoTile), + ∀ (Y : ProtoTile), + ∀ (U : ProtoTile), + ∀ (V : ProtoTile), + Finset.Nonempty O.cells → + Finset.Nonempty X.cells → + Finset.Nonempty Y.cells → + Finset.Nonempty U.cells → + Finset.Nonempty V.cells → + PrecursorBoundaryArcData Dplus Dminus O O' X Y U V → + NoCheckerboardCellVertex (Dplus.cells : Set LatticeCell) → + NoCheckerboardCellVertex + (Dminus.cells : Set LatticeCell) → + Disjoint Dplus.cells O.cells → + Disjoint Dminus.cells O.cells → + (∀ (T : ProtoTile), + ∀ (y : GaussianInt), + ∀ (j : Fin 4), + LatticeVertexIncidentCell y j ∈ T.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∉ T.cells ∨ + LatticeVertexIncidentCell y j ∉ T.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∈ T.cells → + y ∈ BoundaryFootprintVertices T) → + (∀ (y : GaussianInt), + ∀ (j : Fin 4), + LatticeVertexIncidentCell y j ∈ O.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∉ O.cells ∨ + LatticeVertexIncidentCell y j ∉ O.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∈ O.cells → + LatticeVertexIncidentCell y j ∉ O.cells → + LatticeVertexIncidentCell y j ∈ Dplus.cells ∨ + LatticeVertexIncidentCell y j ∈ Dminus.cells) → + (∀ (y : GaussianInt), + ∀ (j : Fin 4), + LatticeVertexIncidentCell y j ∈ O.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∉ O.cells ∨ + LatticeVertexIncidentCell y j ∉ O.cells ∧ + LatticeVertexIncidentCell y (j + 1) ∈ O.cells → + LatticeVertexIncidentCell y (j + 1) ∉ O.cells → + LatticeVertexIncidentCell y (j + 1) ∈ Dplus.cells ∨ + LatticeVertexIncidentCell y (j + 1) ∈ Dminus.cells) → + (∀ (T : ProtoTile), + NoCheckerboardCellVertex (T.cells : Set LatticeCell) → + ∀ (y : GaussianInt), + ∀ (j : Fin 4), + LatticeVertexIncidentCell y (j + 1) ∈ T.cells → + LatticeVertexIncidentCell y (j + 3) ∈ T.cells → + LatticeVertexIncidentCell y j ∉ T.cells → + LatticeVertexIncidentCell y (j + 2) ∈ T.cells) → + (∀ (J : ProtoTile), + ∀ (K : ProtoTile), + J.cells.Nonempty → + K.cells.Nonempty → + J.cells ⊆ Dplus.cells → + K.cells ⊆ Dminus.cells → + TileTouching J K → + ∀ (y : GaussianInt), + ∀ (j : Fin 4), + LatticeVertexIncidentCell y j ∈ O.cells → + LatticeVertexIncidentCell y (j + 1) ∈ Dplus.cells ∧ + LatticeVertexIncidentCell y (j + 3) ∈ Dminus.cells ∨ + LatticeVertexIncidentCell y (j + 1) ∈ Dminus.cells ∧ + LatticeVertexIncidentCell y (j + 3) ∈ Dplus.cells → + LatticeVertexIncidentCell y (j + 2) ∉ Dplus.cells → + LatticeVertexIncidentCell y (j + 2) ∉ Dminus.cells → + y ∈ BoundaryFootprintVertices J → + y ∈ BoundaryFootprintVertices K → False) → + ∀ (y : GaussianInt), + ∀ (j : Fin (4 : ℕ)), + LatticeVertexIncidentCell y j ∈ O.cells → + LatticeVertexIncidentCell y (j + (1 : Fin (4 : ℕ))) ∉ + O.cells → + LatticeVertexIncidentCell y (j + (3 : Fin (4 : ℕ))) ∉ + O.cells → + LatticeVertexIncidentCell y (j + (2 : Fin (4 : ℕ))) ∈ + Dplus.cells ∨ + LatticeVertexIncidentCell y (j + (2 : Fin (4 : ℕ))) ∈ + Dminus.cells + ) := by classical intro Dplus Dminus O O' X Y U V hO hX hY hU hV data hcheckPlus hcheckMinus hdisjPlusO hdisjMinusO boundaryVertexOfCross coverLeft coverRight noCheckerboardDiagonal - mixedCornerContradiction y j hcenter hdiagO hside1O hside3O + mixedCornerContradiction y j hcenter hside1O hside3O by_cases hdiagPlus : LatticeVertexIncidentCell y (j + 2) ∈ Dplus.cells · exact Or.inl hdiagPlus by_cases hdiagMinus : LatticeVertexIncidentCell y (j + 2) ∈ Dminus.cells @@ -922,7 +967,7 @@ theorem P4638T1ContactStarCoverage (Dplus Dminus O O' X Y U V : ProtoTile) (hside3O : LatticeVertexIncidentCell y (j + 3) ∉ O.cells) := ContactStarCases.cornerRescue Dplus Dminus O O' X Y U V hO hX hY hU hV data hcheckPlus hcheckMinus hdisjPlusO hdisjMinusO boundaryVertexOfCross coverLeft coverRight noCheckerboardDiagonal - mixedCornerContradiction y j hcenter hdiagO hside1O hside3O + mixedCornerContradiction y j hcenter hside1O hside3O have singletonCorner (y : GaussianInt) (j : Fin 4) := ContactStarCases.singletonCorner y j intro y hy a hya obtain ⟨jo, hjo⟩ := incident O y hO hy diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean index 182bf2ab72..913330f33a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean @@ -31,15 +31,17 @@ private theorem hρ : (by classical exact - ∀ (r : Fin 4 → CircleCoordinates), ((r (1 : Fin (4 : ℕ))).1 = (0 : ℤ)) → (((0 : ℤ) < (r - (0 : Fin (4 : ℕ))).1 ∧ (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (r i.succ).1) ∧ ∀ (i : Fin (3 - : ℕ)), ∀ (j : Fin (3 : ℕ)), (r i.succ).1 = (0 : ℤ) → (r j.succ).1 = (0 : ℤ) → i = j) - → (∀ (ρ : Fin (3 : ℕ)), ∀ (g₀ : BandPackingSymmetry), ∀ (P : FordFareyParameter), ((r - (ρ + (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ)) → ((BandPackingSymmetryQuadrupleAction g₀ - ![r (0 : Fin (4 : ℕ)), r ρ.succ, r (ρ + (1 : Fin (3 : ℕ))).succ, r (ρ + (2 : Fin (3 : - ℕ))).succ] = FordRecursiveQuadruple P) → (ρ = 1)))) ) := by - classical - intro r hline hcurve ρ g₀ P hz hrec + ∀ (r : Fin 4 → CircleCoordinates), + (r (1 : Fin (4 : ℕ))).1 = (0 : ℤ) → + ((0 : ℤ) < (r (0 : Fin (4 : ℕ))).1 ∧ + (∀ (i : Fin (3 : ℕ)), (0 : ℤ) ≤ (r i.succ).1) ∧ + ∀ (i : Fin (3 : ℕ)), + ∀ (j : Fin (3 : ℕ)), + (r i.succ).1 = (0 : ℤ) → (r j.succ).1 = (0 : ℤ) → i = j) → + ∀ (ρ : Fin (3 : ℕ)), (r (ρ + (2 : Fin (3 : ℕ))).succ).1 = (0 : ℤ) → ρ = 1 + ) := by + classical + intro r hline hcurve ρ hz have huni := hcurve.2.2 fin_cases ρ · have hbad := huni 0 2 hline (by simpa using hz) @@ -249,39 +251,41 @@ private theorem hword : (by classical exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (g₀ : BandPackingSymmetry), ∀ (P : - FordFareyParameter), (∃ (w : GaussianInt), g₀ = BandPackingSymmetry.shift w ∨ g₀ = - (BandPackingSymmetry.shift w).comp BandPackingSymmetry.negate) → ( - let p : Fin 4 → CircleCoordinates := ![r 0, r 2, r 3, r 1] - ∀ (g : BandPackingSymmetry), (g = g₀ ∨ g = (BandPackingSymmetry.negate.comp - BandPackingSymmetry.negate).comp g₀) → ((∀ (C : CircleCoordinates), - BandPackingSymmetryCircleAction g C = BandPackingSymmetryCircleAction g₀ C) → - ((BandPackingSymmetryReversesOrientation g = BandPackingSymmetryReversesOrientation - g₀) → ((∀ (p : Fin (4 : ℕ) → CircleCoordinates), BandPackingSymmetryQuadrupleAction g - p = BandPackingSymmetryQuadrupleAction g₀ p) → ((BandPackingSymmetryScopedPhase g p - false) → ((∀ (r : Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : - Fin (4 : ℕ)) = p (1 : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = p (2 : Fin (4 : ℕ)) → r (3 - : Fin (4 : ℕ)) = p (3 : Fin (4 : ℕ)) → BandPackingSymmetryScopedPhase g r false) → - ((BandPackingSymmetryQuadrupleAction g p = FordRecursiveQuadruple P) → - ((BandPackingSymmetryReversesOrientation g = false) → - ((BandPackingSymmetryScopedPhase g p false) → ((BandVectors.1 - ((FordRecursiveQuadruple P) 2) ((FordRecursiveQuadruple P) 1) = - BandPackingSymmetryVectorAction g (BandVectors.1 (p 2) (p 1))) → - ((BandPackingSymmetryVectorAction g (BandVectors.1 (r 3) (r 2)) = -((P.q₁ : Int) : - GaussianInt) + ⟨0, (P.q₂ : Int)⟩) → ( - let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := - if k = 0 then T else if k = 1 then TileQuarterTurn T else - if k = 2 then TileQuarterTurn (TileQuarterTurn T) else - TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)) - let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := - if k = 0 then z else if k = 1 then GaussianQuarterTurn z else - if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) - ∃ k : Fin 4, (∀ T, BandPackingSymmetryTileAction g T = TP k T) ∧ (∀ z, - BandPackingSymmetryVectorAction g z = VP k z))))))))))))) ) := by + (Fin 4 → CircleCoordinates) → + ∀ (g₀ : BandPackingSymmetry), + (∃ (w : GaussianInt), + g₀ = BandPackingSymmetry.shift w ∨ + g₀ = (BandPackingSymmetry.shift w).comp BandPackingSymmetry.negate) → + ∀ (g : BandPackingSymmetry), + g = g₀ ∨ + g = + (BandPackingSymmetry.negate.comp BandPackingSymmetry.negate).comp + g₀ → + BandPackingSymmetryReversesOrientation g = + BandPackingSymmetryReversesOrientation g₀ → + BandPackingSymmetryReversesOrientation g = false → + let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := + if k = 0 then T + else + if k = 1 then TileQuarterTurn T + else + if k = 2 then TileQuarterTurn (TileQuarterTurn T) + else TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)) + let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := + if k = 0 then z + else + if k = 1 then GaussianQuarterTurn z + else + if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) + else + GaussianQuarterTurn + (GaussianQuarterTurn (GaussianQuarterTurn z)) + ∃ k : Fin 4, + (∀ T, BandPackingSymmetryTileAction g T = TP k T) ∧ + ∀ z, BandPackingSymmetryVectorAction g z = VP k z + ) := by classical - intro r g₀ P hw₀ p g hg hcirg horientg hquadg hfalse hfalsecyc hrecg hgfalse hphase2 hcanonical - htargetvec TP VP + intro r g₀ hw₀ g hg horientg hgfalse TP VP rcases hw₀ with ⟨w, hw₀⟩ rcases hg with hsame | hadapt · subst g @@ -302,25 +306,25 @@ private theorem hcellpow : classical exact ∀ (g : BandPackingSymmetry), - let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 - ∀ (cellTurn_bij : Function.Bijective cellTurn), - let E1 : GaussianInt ≃ GaussianInt := Equiv.ofBijective cellTurn cellTurn_bij - let E2 : GaussianInt ≃ GaussianInt := E1.trans E1 - let E3 : GaussianInt ≃ GaussianInt := E2.trans E1 - let E : Fin 4 → GaussianInt ≃ GaussianInt := ![Equiv.refl _, E1, E2, E3] - let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := - if k = 0 then T else if k = 1 then TileQuarterTurn T else - if k = 2 then TileQuarterTurn (TileQuarterTurn T) else - TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)) - let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := - if k = 0 then z else if k = 1 then GaussianQuarterTurn z else - if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) - ∀ (k : Fin (4 : ℕ)), (∀ (T : ProtoTile), BandPackingSymmetryTileAction g T = TP k T) → - ((∀ (z : GaussianInt), BandPackingSymmetryVectorAction g z = VP k z) → (∀ T, - (BandPackingSymmetryTileAction g T).cells = T.cells.image (E k))) ) := by + let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1; + ∀ (cellTurn_bij : Function.Bijective cellTurn), + let E1 : GaussianInt ≃ GaussianInt := Equiv.ofBijective cellTurn cellTurn_bij; + let E2 : GaussianInt ≃ GaussianInt := E1.trans E1; + let E3 : GaussianInt ≃ GaussianInt := E2.trans E1; + let E : Fin 4 → GaussianInt ≃ GaussianInt := ![Equiv.refl _, E1, E2, E3]; + let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := + if k = 0 then T + else + if k = 1 then TileQuarterTurn T + else + if k = 2 then TileQuarterTurn (TileQuarterTurn T) + else TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)); + ∀ (k : Fin (4 : ℕ)), + (∀ (T : ProtoTile), BandPackingSymmetryTileAction g T = TP k T) → + ∀ T, (BandPackingSymmetryTileAction g T).cells = T.cells.image (E k) + ) := by classical - intro g cellTurn cellTurn_bij E1 E2 E3 E TP VP k htilepow hvecpow T + intro g cellTurn cellTurn_bij E1 E2 E3 E TP k htilepow T rw [htilepow] fin_cases k <;> simp [TP, E, E1, E2, E3, cellTurn, TileQuarterTurnFormulas, @@ -331,26 +335,21 @@ private theorem hanchorpow : classical exact ∀ (g : BandPackingSymmetry), - let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 - ∀ (cellTurn_bij : Function.Bijective cellTurn), - let E1 : GaussianInt ≃ GaussianInt := Equiv.ofBijective cellTurn cellTurn_bij - let E2 : GaussianInt ≃ GaussianInt := E1.trans E1 - let E3 : GaussianInt ≃ GaussianInt := E2.trans E1 - let E : Fin 4 → GaussianInt ≃ GaussianInt := ![Equiv.refl _, E1, E2, E3] let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := if k = 0 then T else if k = 1 then TileQuarterTurn T else if k = 2 then TileQuarterTurn (TileQuarterTurn T) else - TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)) + TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)); let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := if k = 0 then z else if k = 1 then GaussianQuarterTurn z else if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) + GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)); ∀ (k : Fin (4 : ℕ)), (∀ (T : ProtoTile), BandPackingSymmetryTileAction g T = TP k T) → - ((∀ (z : GaussianInt), BandPackingSymmetryVectorAction g z = VP k z) → ((∀ T, - (BandPackingSymmetryTileAction g T).cells = T.cells.image (E k)) → (∀ T, + ( + ( + (∀ T, (BandPackingSymmetryTileAction g T).anchor = VP k T.anchor))) ) := by classical - intro g cellTurn cellTurn_bij E1 E2 E3 E TP VP k htilepow hvecpow hcellpow T + intro g TP VP k htilepow T rw [htilepow] fin_cases k <;> simp [TP, VP, TileQuarterTurnFormulas, GaussianQuarterTurn] @@ -359,30 +358,21 @@ private theorem hcentpow : classical exact ∀ (g : BandPackingSymmetry), - let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 - ∀ (cellTurn_bij : Function.Bijective cellTurn), - let E1 : GaussianInt ≃ GaussianInt := Equiv.ofBijective cellTurn cellTurn_bij - let E2 : GaussianInt ≃ GaussianInt := E1.trans E1 - let E3 : GaussianInt ≃ GaussianInt := E2.trans E1 - let E : Fin 4 → GaussianInt ≃ GaussianInt := ![Equiv.refl _, E1, E2, E3] let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := if k = 0 then T else if k = 1 then TileQuarterTurn T else if k = 2 then TileQuarterTurn (TileQuarterTurn T) else - TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)) + TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)); let RP (k : Fin 4) (x : Real × Real) : Real × Real := if k = 0 then x else if k = 1 then (-x.2, x.1) else - if k = 2 then (-x.1, -x.2) else (x.2, -x.1) - let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := - if k = 0 then z else if k = 1 then GaussianQuarterTurn z else - if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) + if k = 2 then (-x.1, -x.2) else (x.2, -x.1); ∀ (k : Fin (4 : ℕ)), (∀ (T : ProtoTile), BandPackingSymmetryTileAction g T = TP k T) → - ((∀ (z : GaussianInt), BandPackingSymmetryVectorAction g z = VP k z) → ((∀ T, - (BandPackingSymmetryTileAction g T).cells = T.cells.image (E k)) → ((∀ T, - (BandPackingSymmetryTileAction g T).anchor = VP k T.anchor) → (∀ T, TileCentroid + ( + ( + ( + (∀ T, TileCentroid (BandPackingSymmetryTileAction g T) = RP k (TileCentroid T))))) ) := by classical - intro g cellTurn cellTurn_bij E1 E2 E3 E TP RP VP k htilepow hvecpow hcellpow hanchorpow T + intro g TP RP k htilepow T rw [htilepow] fin_cases k <;> simp [TP, RP, TileQuarterTurnFormulas] @@ -666,20 +656,7 @@ private theorem hAproto : rw [hchild] at h exact h.mp hA -private theorem hBproto : - (by - classical - exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (B : ProtoTile), (BandPrototile (r (0 : Fin (4 : - ℕ))) B) → (∀ (P : FordFareyParameter), ∀ (g : BandPackingSymmetry), - (BandPackingSymmetryCircleAction g (r 0) = (FordRecursiveQuadruple P) 0) → - (BandPrototile ((FordRecursiveQuadruple P) 0) (BandPackingSymmetryTileAction g B))) ) - := by - classical - intro r B hB P g hchild - have h := (BandPackingSymmetryCovariance g).2.1 (r 0) B - rw [hchild] at h - exact h.mp hB +private abbrev hBproto := ApollonianSuperharmonic.EmptyFordGeometry.hAproto private theorem hmodel : (by @@ -854,7 +831,7 @@ theorem P4638T1EmptyFordLocalization (r : Fin 4 → CircleCoordinates) have hcurve := ProperBandCurvatureStructure r hr obtain ⟨ρ, g₀, P, hP, hg₀, hw₀, hz, hrec⟩ := FordRegimeConverse r hr ⟨1, hline⟩ - have hρ := EmptyFordGeometry.hρ r hline hcurve ρ g₀ P hz hrec + have hρ := EmptyFordGeometry.hρ r hline hcurve ρ hz subst ρ let p : Fin 4 → CircleCoordinates := ![r 0, r 2, r 3, r 1] have hp := EmptyFordGeometry.hp r hr @@ -891,12 +868,11 @@ theorem P4638T1EmptyFordLocalization (r : Fin 4 → CircleCoordinates) if k = 0 then z else if k = 1 then GaussianQuarterTurn z else if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) - have hword := EmptyFordGeometry.hword r g₀ P hw₀ g hg hcirg horientg hquadg hfalse hfalsecyc - hrecg hgfalse hphase2 hcanonical htargetvec + have hword := EmptyFordGeometry.hword r g₀ hw₀ g hg horientg hgfalse obtain ⟨k, htilepow, hvecpow⟩ := hword - have hcellpow := EmptyFordGeometry.hcellpow g cellTurn_bij k htilepow hvecpow - have hanchorpow := EmptyFordGeometry.hanchorpow g cellTurn_bij k htilepow hvecpow hcellpow - have hcentpow := EmptyFordGeometry.hcentpow g cellTurn_bij k htilepow hvecpow hcellpow hanchorpow + have hcellpow := EmptyFordGeometry.hcellpow g cellTurn_bij k htilepow + have hanchorpow := EmptyFordGeometry.hanchorpow g k htilepow + have hcentpow := EmptyFordGeometry.hcentpow g k htilepow have hchild := EmptyFordGeometry.hchild r P g hrecg hgfalse let D : GaussianInt → Real × Real := fun z => (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean b/LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean index 6e4bb3d6cc..f1b9b62734 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.P4677T2DrawingData public import LeanPool.ApollonianSuperharmonic.SubtileOccurrenceInterpretation @@ -308,16 +309,7 @@ private noncomputable abbrev point (p1 : GaussianInt) (p2 : GaussianInt) (p3 : G | .J1 => p5 | .J2 => p6 | .J3 => p7 | .J4 => p8 | .J5 => p9 | .J6 => p10 | .J7 => p11 | .J8 => p12 -private theorem translate_zero (T : ProtoTile) : TileTranslation T 0 = T := by - classical - cases T with - | mk cells anchor => - simp only [TileTranslation] - rw [ProtoTile.mk.injEq] - constructor - · ext z - simp [GaussianTranslation] - · simp [GaussianTranslation] +private abbrev translate_zero := ApollonianSuperharmonic.TileTranslationProperties.zero private theorem zero_membership (P : Fin 3 → Bool → ProtoTile) (u : GaussianInt) (v : GaussianInt) (p1 : GaussianInt) (p2 : GaussianInt) (p3 : GaussianInt) (p4 : GaussianInt) (p5 @@ -446,19 +438,7 @@ private theorem zero_membership (P : Fin 3 → Bool → ProtoTile) (u : Gaussian · simpa [point, SixSubtileFaceVertices, SubtileOccurrenceInterpretation, translate_zero] using h12.2.2 -private theorem translate_comp (T : ProtoTile) (a b : GaussianInt) : - TileTranslation (TileTranslation T a) b = TileTranslation T (a + b) := by - classical - cases T with - | mk cells anchor => - simp only [TileTranslation] - rw [ProtoTile.mk.injEq] - constructor - · rw [Finset.image_image] - congr 1 - funext x - simp [GaussianTranslation, add_assoc] - · simp [GaussianTranslation, add_assoc] +private abbrev translate_comp := ApollonianSuperharmonic.TileTranslationProperties.add private theorem occurrence_shift (P : Fin 3 → Bool → ProtoTile) (u : GaussianInt) (v : GaussianInt) (translate_comp : ∀ (T : ProtoTile) (a b : GaussianInt), TileTranslation diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean index e4e0b9e068..09b9593f46 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean @@ -131,16 +131,7 @@ private theorem edge_parent : rcases he with ⟨c, hc, hshape⟩ exact ⟨c, hTc hc, hshape⟩ -private theorem edge_parentB : - (by - classical - exact - ∀ (B : ProtoTile), ∀ (T : ProtoTile), T.cells ⊆ B.cells → ∀ e ∈ FootprintEdges T, e ∈ - FootprintEdges B ) := by - classical - intro B T hTc e he - rcases he with ⟨c, hc, hshape⟩ - exact ⟨c, hTc hc, hshape⟩ +private abbrev edge_parentB := ApollonianSuperharmonic.PrecursorWalkGeometry.edge_parent private theorem p₁chain : (by @@ -190,19 +181,7 @@ private theorem p₁mem : have hzv := hp₁v z hz exact ⟨hXf hzv.1, hYf hzv.2⟩ -private theorem p₃mem : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (Z : ProtoTile), ∀ (W : ProtoTile), - (FootprintVertices Z ⊆ FootprintVertices A) → ((FootprintVertices W ⊆ - FootprintVertices B) → (∀ (p₃ : List GaussianInt), (∀ z ∈ p₃, z ∈ FootprintVertices Z - ∩ FootprintVertices W) → (∀ z ∈ p₃, z ∈ FootprintVertices A ∩ FootprintVertices B))) - ) := by - classical - intro A B Z W hZf hWf p₃ hp₃v z hz - have hzv := hp₃v z hz - exact ⟨hZf hzv.1, hWf hzv.2⟩ +private abbrev p₃mem := ApollonianSuperharmonic.PrecursorWalkGeometry.p₁mem private theorem qmem : (by @@ -228,18 +207,7 @@ private theorem aq : have : a ∈ (q.toFinset : Set GaussianInt) := by rw [← hqvertices]; exact ha.2.2 simpa using this -private theorem bq : - (by - classical - exact - ∀ (Z : ProtoTile), ∀ (W : ProtoTile), ∀ (O : ProtoTile), ∀ (b : GaussianInt), (b ∈ - BoundaryFootprintVertices Z ∧ b ∈ BoundaryFootprintVertices W ∧ b ∈ - BoundaryFootprintVertices O) → (∀ (q : List GaussianInt), (BoundaryFootprintVertices - O = (↑q.toFinset : Set GaussianInt)) → (b ∈ q)) ) := by - classical - intro Z W O b hb q hqvertices - have : b ∈ (q.toFinset : Set GaussianInt) := by rw [← hqvertices]; exact hb.2.2 - simpa using this +private abbrev bq := ApollonianSuperharmonic.PrecursorWalkGeometry.aq private theorem S_symm : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean index f6bc14c64b..bd01d85b5f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean +++ b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.P4812T1AffineDrawing public import LeanPool.ApollonianSuperharmonic.P4677T2TouchingWalk @@ -69,25 +71,7 @@ private theorem boundaryFoot : · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ · simpa [BoundaryFootprintVertices, FootprintVertices, hW] using hz -private theorem translateComp : - (by - classical - exact - ∀ (W : ProtoTile), ∀ (v : GaussianInt), ∀ (w : GaussianInt), TileTranslation - (TileTranslation W v) w = TileTranslation W (v + w) - ) := by - classical - intro W v w - cases W with - | mk cells anchor => - simp only [TileTranslation] - rw [ProtoTile.mk.injEq] - constructor - · rw [Finset.image_image] - congr 1 - funext z - simp [GaussianTranslation, add_assoc] - · simp [GaussianTranslation, add_assoc] +private abbrev translateComp := ApollonianSuperharmonic.TileTranslationProperties.add private theorem edgeDiff : (by @@ -280,25 +264,7 @@ private theorem rho_mem : exact boundaryFoot _ _ (translateBoundary (TileTranslation T (b : GaussianInt)) rd (x : GaussianInt) rdb) -private theorem transZero : - (by - classical - exact - ∀ (W : ProtoTile), TileTranslation W (0 : GaussianInt) = W - ) := by - classical - intro W - cases W with - | mk cells anchor => - simp only [TileTranslation] - rw [ProtoTile.mk.injEq] - constructor - · change cells.image (GaussianTranslation 0) = cells - have h : GaussianTranslation 0 = id := by - funext z - simp [GaussianTranslation] - rw [h, Finset.image_id] - · simp [GaussianTranslation] +private abbrev transZero := ApollonianSuperharmonic.TileTranslationProperties.zero private theorem mapTranslateRev : (by @@ -340,29 +306,7 @@ private theorem ifMap3 : by_cases hq0 : Q0 <;> by_cases hq1 : Q1 <;> by_cases hq2 : Q2 <;> simp [h0, h1, h2, hq0, hq1, hq2, m0, m1, m2] -private theorem boundaryEdgeFoot : - (by - classical - exact - ∀ (W : ProtoTile), ∀ e ∈ BoundaryFootprintEdges W, e ∈ FootprintEdges W - ) := by - classical - intro W e he - simp only [BoundaryFootprintEdges, Set.mem_ofPred_eq] at he - simp only [FootprintEdges, Set.mem_ofPred_eq] - change ∃ c ∈ W.cells, - e = {c, c + 1} ∨ e = {c, c + ⟨0, 1⟩} ∨ - e = {c + 1, c + 1 + ⟨0, 1⟩} ∨ - e = {c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩} - rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ - · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ - · exact ⟨z, hz, Or.inl rfl⟩ - · refine ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr ?_))⟩ - congr 1 <;> simp [Zsqrtd.ext_iff] - · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ - · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ - congr 1 <;> simp [] +private abbrev boundaryEdgeFoot := ApollonianSuperharmonic.BoundaryFootprintInclusion.boundaryEdge private theorem commonEdgeTouch : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean b/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean index 8732608d98..8e670f8617 100644 --- a/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean +++ b/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean @@ -215,12 +215,14 @@ private theorem Bmono : nlinarith [Bnonneg k, hM] private theorem hxpos : - ∀ (q : IntegerLatticeFunction), ∀ (M : ℤ), (∃ z, q z = 0) → ∀ (N : ℕ), - let S : Set GaussianInt := {x | 0 < q x} - let B : ℕ → ℤ := fun n => Nat.rec 0 (fun _ b => 4 * b + M) n - (∀ (n : ℕ), 0 ≤ B n) → ∀ (x : GaussianInt), (B (N + 1) < q x) → x ∈ S := by + ∀ (q : IntegerLatticeFunction), + ∀ (M : ℤ), + ∀ (N : ℕ), + let S : Set GaussianInt := {x | 0 < q x} + let B : ℕ → ℤ := fun n => Nat.rec 0 (fun _ b => 4 * b + M) n + (∀ (n : ℕ), 0 ≤ B n) → ∀ (x : GaussianInt), B (N + 1) < q x → x ∈ S := by classical - intro q M hzero N S B Bnonneg x hx + intro q M N S B Bnonneg x hx change 0 < q x have hB := Bnonneg (N + 1) omega @@ -417,7 +419,7 @@ theorem P4849T1LargePositiveComponents (q : IntegerLatticeFunction) (M : ℤ) have Bmono (n m : ℕ) (hnm : n ≤ m) : B n ≤ B m := PositiveComponentLemmas.Bmono M hM Bsucc Bnonneg n m hnm obtain ⟨x, hx⟩ := hunbounded (B (N + 1)) - have hxpos : x ∈ S := PositiveComponentLemmas.hxpos q M hzero N Bnonneg x hx + have hxpos : x ∈ S := PositiveComponentLemmas.hxpos q M N Bnonneg x hx obtain ⟨z₀, hz₀⟩ := hzero let C : Set GaussianInt := {y | reach x y} have hxC : x ∈ C := PositiveComponentLemmas.hxC q x diff --git a/LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean b/LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean index c79349cb71..9c5d805f28 100644 --- a/LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean +++ b/LeanPool/ApollonianSuperharmonic/P4953T1TriangleSections.lean @@ -96,12 +96,7 @@ private theorem hden₁ (A : ℂ) (x : ℂ) (hAx : A.im < x.im) : x.im - A.im have huw : u < w := huw A x hAx exact ne_of_gt (sub_pos.mpr huw) -private theorem hden₂ (x : ℂ) (B : ℂ) (hxB : x.im < B.im) : B.im - x.im ≠ 0 := by - classical - let w := x.im - let v := B.im - have hwv : w < v := hwv x B hxB - exact ne_of_gt (sub_pos.mpr hwv) +private abbrev hden₂ := ApollonianSuperharmonic.TriangleSections.hden₁ private noncomputable def pts (A : ℂ) (x : ℂ) (B : ℂ) : Fin 3 → ℂ := ![x, A, B] diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean b/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean index b3ecfc3b23..dc9e5cbc53 100644 --- a/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean +++ b/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean @@ -348,32 +348,44 @@ private theorem keep : (by classical exact - ∀ (L : Real), ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (∀ (j : Fin - 3), ((0 : ℤ) < (q j.succ).1) → ((dist (((q j.succ).2 : Complex) / ((q j.succ).1 : - Real)) (((q 0).2 : Complex) / ((q 0).1 : Real)) = 1 / ((q j.succ).1 : Real) + 1 / ((q - 0).1 : Real)) → ( - let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real) - let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real) - let a := p j.succ - let x := p 0 - let R := rad j.succ - let S := rad 0 - (0 < R) → ((dist a x = R + S) → ( - let α := R / (R + S) - (0 < α) → ((α < 1) → ((α * (R + S) = R) → (((1 - α) * (R + S) = S) → ( - let t := a + α • (x - a) - (‖x - a‖ = R + S) → ((dist t a = R) → ((dist t x = S) → ((a ∈ P4909T1ParentPolygon L q) - → ((t ∈ segment Real a x) → ((t ∈ P4909T1ParentPolygon L q) → ((∀ (k : Fin 3), (0 < - (q k.succ).1) → (rad k.succ ≤ dist t (p k.succ))) → ((t ∈ P4984T1ClosedGap L q) → - ((t ∈ P4984T1ClosedGap L q ∩ Metric.sphere a R) → (∀ [ IsClosed - (P4984T1ClosedGap L q ∩ Metric.sphere a R)], ((P4984T1ClosedGap L q ∩ - Metric.sphere a R).Nonempty) → ((∀ (b : Fin 3), ∀ (k : Fin 3), P4828T1Step - (P4828T1Rotate q b) k.succ = if k = 0 then q 0 else q ((k + b).succ)) → (∀ (b : Fin - (3 : ℕ)), b ≠ j ↔ ∃ (k : Fin (3 : ℕ)), P4828T1Step (P4828T1Rotate q b) k.succ = q - j.succ)))))))))))))))))))) ) := by + ∀ (L : Real), + ∀ (q : Fin 4 → CircleCoordinates), + ProperBandQuadruple q → + ∀ (j : Fin 3), + (0 : ℤ) < (q j.succ).1 → + dist (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)) + (((q 0).2 : Complex) / ((q 0).1 : Real)) = + 1 / ((q j.succ).1 : Real) + 1 / ((q 0).1 : Real) → + let p (i : Fin 4) : Complex := (q i).2 / ((q i).1 : Real); + let rad (i : Fin 4) : Real := 1 / ((q i).1 : Real); + let a := p j.succ; + let x := p 0; + let R := rad j.succ; + let S := rad 0; + 0 < R → + dist a x = R + S → + let α := R / (R + S); + 0 < α → + α < 1 → + α * (R + S) = R → + (1 - α) * (R + S) = S → + let t := a + α • (x - a); + ‖x - a‖ = R + S → + dist t a = R → + dist t x = S → + ∀ [IsClosed (P4984T1ClosedGap L q ∩ Metric.sphere a R)], + (∀ (b : Fin 3), + ∀ (k : Fin 3), + P4828T1Step (P4828T1Rotate q b) k.succ = + if k = 0 then q 0 else q (k + b).succ) → + ∀ (b : Fin (3 : ℕ)), + b ≠ j ↔ + ∃ (k : Fin (3 : ℕ)), + P4828T1Step (P4828T1Rotate q b) k.succ = q j.succ + ) := by classical intro L q hq j hj hparentContactDistance p rad a x R S hR hax α hα hαlt hαmul hcompmul t - hnormax hta htx haPoly htseg htPoly hfar htGap htA hAclosed hANonempty slot b + hnormax hta htx hAclosed slot b constructor · intro hb fin_cases b <;> fin_cases j @@ -761,7 +773,7 @@ theorem P4984T1IncidentArcs (L : Real) ⟨t, htA⟩ have slot (b k : Fin 3) := IncidentArcGeometry.slot q b k have keep (b : Fin 3) := @IncidentArcGeometry.keep L q hq j hj hparentContactDistance hR hax hα - hαlt hαmul hcompmul hnormax hta htx haPoly htseg htPoly hfar htGap htA hAclosed hANonempty + hαlt hαmul hcompmul hnormax hta htx hAclosed slot b have closedGapOfParent (u : Fin 4 → CircleCoordinates) (m : Fin 3) (hm : 0 < (u m.succ).1) := IncidentArcGeometry.closedGapOfParent L u m hm diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean b/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean index 0b9d1d9372..72e22069d6 100644 --- a/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean @@ -151,10 +151,7 @@ private theorem ceilPerturb : ∀ (N M d q E : ℤ) (hd : 0 < d) (hdq : d < q), classical exact P5188T1CeilingStability -private theorem ceilShift : ∀ (M C q : ℤ) (hq : q ≠ 0), IntegerCeilDiv (M + C * q) q hq = - IntegerCeilDiv M q hq + C := by - classical - exact P5188T1CeilingShift +private abbrev ceilShift := ApollonianSuperharmonic.P5188T1CeilingShift private theorem ceilZero (d : Int) (hd : d ≠ 0) : IntegerCeilDiv 0 d hd = 0 := by classical diff --git a/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean b/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean index d360362433..11ac81e8a7 100644 --- a/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.SimpleGridPathBetween public import LeanPool.ApollonianSuperharmonic.P5260T1PlacementLedger @@ -621,24 +622,7 @@ private theorem translatePathTiles : (TileTranslationFormulas X u).2.2.2.2.2.2.1, (TileTranslationFormulas Y u).2.2.2.2.2.2.1] using hi -private theorem translateComp : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (u : GaussianInt), ∀ (v : GaussianInt), TileTranslation - (TileTranslation T u) v = TileTranslation T (u + v) ) := by - classical - intro T u v - cases T with - | mk cells anchor => - apply congrArg₂ ProtoTile.mk - · simp only [TileTranslation] - rw [Finset.image_image] - congr 1 - funext z - simp [GaussianTranslation, add_comm, add_left_comm] - · simp [TileTranslation, GaussianTranslation, add_comm, - add_left_comm] +private abbrev translateComp := ApollonianSuperharmonic.TileTranslationProperties.add private theorem hEmShift : (by @@ -794,19 +778,7 @@ private theorem pathWDrev : intro k reversePath N D W pathDW simpa only [Set.inter_comm] using reversePath pathDW -private theorem translateZero : - (by - classical - exact - ∀ (T : ProtoTile), TileTranslation T 0 = T ) := by - classical - intro T - cases T with - | mk cells anchor => - apply congrArg₂ ProtoTile.mk - · change Finset.image (fun z => z + (0 : GaussianInt)) cells = cells - simp - · simp [GaussianTranslation] +private abbrev translateZero := ApollonianSuperharmonic.TileTranslationProperties.zero private theorem hlowTile : (by diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean b/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean index 893369cd5c..76baf39678 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import Mathlib.Data.Finset.Card public import Mathlib.Tactic.FinCases public import Mathlib.Tactic.NormNum @@ -381,13 +382,7 @@ private theorem singletonSquareEdges (c : GaussianInt) : rw [(P5253T1SingletonBoundary c c).2] simp [Finset.pair_comm] -private theorem tileTranslationZero (T : ProtoTile) : TileTranslation T 0 = T := by - cases T with - | mk cells anchor => - have hf : GaussianTranslation 0 = id := by - funext z - simp [GaussianTranslation] - simp [TileTranslation, hf, Finset.image_id] +private abbrev tileTranslationZero := ApollonianSuperharmonic.TileTranslationProperties.zero private theorem oneUnitContacts (k : Nat) (hk : 0 < k) : unitContactConclusion k 1 := by diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean b/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean index 0bc2ab708a..8b9b93e66f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean @@ -261,19 +261,13 @@ private theorem haAt253 : (by classical exact - ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( - ( - ( - let k : Int := K.1; - let C (p q : Int) : Prop := - 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ - -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1; - let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1; - (C (⟨-k, k⟩ : GaussianInt).re (⟨-k, k⟩ : GaussianInt).im) → ((U ((⟨-k, k⟩ : - GaussianInt).re - (-k - (1 : ℤ))) ((⟨-k, k⟩ : GaussianInt).im - k)) → - ((Int.natAbs (1-k) : Int) = k-1))))) ) := by + ∀ (K : DiamondParameter), + (1 : ℕ) < K.1 → + let k : Int := K.1; + (Int.natAbs (1 - k) : Int) = k - 1 + ) := by classical - intro K hk k C U center unitCenter + intro K hk k rw [Int.natCast_natAbs, abs_of_nonpos (by omega : 1-k ≤ 0)] omega @@ -281,19 +275,13 @@ private theorem hbAt256 : (by classical exact - ∀ (K : DiamondParameter), ((1 : ℕ) < K.1) → ( - ( - ( - let k : Int := K.1; - let C (p q : Int) : Prop := - 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ - -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1; - let U (p q : Int) : Prop := 0 ≤ p ∧ p ≤ 1 ∧ 0 ≤ q ∧ q ≤ 1; - (C (⟨-k, k⟩ : GaussianInt).re (⟨-k, k⟩ : GaussianInt).im) → ((U ((⟨-k, k⟩ : - GaussianInt).re - (-k - (1 : ℤ))) ((⟨-k, k⟩ : GaussianInt).im - k)) → - (((Int.natAbs (1-k) : Int) = k-1) → ((Int.natAbs (-k) : Int) = k)))))) ) := by + ∀ (K : DiamondParameter), + (1 : ℕ) < K.1 → + let k : Int := K.1; + (Int.natAbs (1 - k) : Int) = k - 1 → (Int.natAbs (-k) : Int) = k + ) := by classical - intro K hk k C U center unitCenter ha + intro K hk k ha rw [Int.natCast_natAbs, abs_of_nonpos (by omega : -k ≤ 0)] omega @@ -488,8 +476,8 @@ theorem P5352T2FirstUnit (K : DiamondParameter) (hk : 1 < K.1) have hn := child (-k) (k+1) (by dsimp [C]; omega) have hs := child (-k) (k-1) (by dsimp [C]; omega) have hc := child (-k) k (by dsimp [C]; omega) - have ha : (Int.natAbs (1-k) : Int) = k-1 := FirstUnitProof.haAt253 K hk center unitCenter - have hb : (Int.natAbs (-k) : Int) = k := FirstUnitProof.hbAt256 K hk center unitCenter ha + have ha : (Int.natAbs (1-k) : Int) = k-1 := FirstUnitProof.haAt253 K hk + have hb : (Int.natAbs (-k) : Int) = k := FirstUnitProof.hbAt256 K hk ha simp only [P4207T1DiamondFormula, ha, hb] at he hn hs hc rw [show 1-k-k = 1-2*k by ring, show k-1-1 = k-2 by ring, sqp] at he rw [show -k-(k+1) = -1-2*k by ring, sqm] at hn diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean index 0331a5a93a..31eb6b3504 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean @@ -73,27 +73,16 @@ private theorem boundaryCase : ∀ (hk : (1 : ℕ) < K.1), ∀ (f : IntegerLatticeFunction), let k : Int := K.1; - let d : GaussianInt := ⟨k, 1 - k⟩; let r : GaussianInt := ⟨2 * k, 0⟩; let child := P5352T2Sources K hk 0; - let pred := P5352T2Sources K hk 3; (∀ y ∈ FootprintVertices child.1, f y = child.2.1 y) → ∀ (p : ℤ), ∀ (q : ℤ), ⟨p, q⟩ ∈ FootprintVertices child.1 → - ⟨p, q⟩ - d ∈ FootprintVertices pred.1 → - (∀ (y : GaussianInt), - y = ⟨p, q⟩ ∨ - y = ⟨p, q⟩ + (1 : GaussianInt) ∨ - y = ⟨p, q⟩ - (1 : GaussianInt) ∨ - y = ⟨p, q⟩ + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ - y = ⟨p, q⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → - y ∈ FootprintVertices child.1 ∨ - y - d ∈ FootprintVertices pred.1) → - (1 : ℤ) ≤ q + k ∧ - q ≤ (2 : ℤ) * (k - (1 : ℤ)) + ((1 : ℤ) - k) ∧ - k ≤ p + (k - (1 : ℤ)) ∧ - p ≤ k - (1 : ℤ) + k ∧ + (1 : ℤ) ≤ q + k ∧ + q ≤ (2 : ℤ) * (k - (1 : ℤ)) + ((1 : ℤ) - k) ∧ + k ≤ p + (k - (1 : ℤ)) ∧ + p ≤ k - (1 : ℤ) + k ∧ (1 : ℤ) ≤ p - k + (1 : ℤ) + q + k ∧ p ≤ q - ((1 : ℤ) - k) + (1 : ℤ) + k ∧ q ≤ @@ -102,17 +91,17 @@ private theorem boundaryCase : p ≤ (2 : ℤ) * (k - (1 : ℤ)) - (q - ((1 : ℤ) - k)) + (1 : ℤ) + k → - (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ) → - (0 : ℤ) ≤ q ∧ - q ≤ (2 : ℤ) * k ∧ + (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ) → + (0 : ℤ) ≤ q ∧ + q ≤ (2 : ℤ) * k ∧ -k ≤ p ∧ p ≤ k ∧ -q - (1 : ℤ) ≤ p ∧ p ≤ q + (1 : ℤ) ∧ -((2 : ℤ) * k - q + (1 : ℤ)) ≤ p ∧ p ≤ (2 : ℤ) * k - q + (1 : ℤ) → - (1 : ℤ) ≤ p → - q = p - (1 : ℤ) ∨ q = p → + (1 : ℤ) ≤ p → + q = p - (1 : ℤ) ∨ q = p → (∀ (a : Int), ∀ (b : Int), 0 ≤ b → @@ -132,8 +121,7 @@ private theorem boundaryCase : FourNeighborLaplacian f ⟨p, p⟩ = (1 : ℤ)) ) := by classical - intro K hk f k d r child pred hchild p q hz hpz hcover hdpred hcast hdchild hp1 hq childMem - hqp + intro K hk f k r child hchild p q hz hdpred hcast hdchild hp1 hq childMem hqp subst q have hplt : p < k := by omega have hpadd : p+1 ≤ k := Int.lt_iff_add_one_le.mp hplt @@ -302,22 +290,33 @@ private theorem hComp : (by classical exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), - let k : Int := K.1 - let d : GaussianInt := ⟨k, 1-k⟩ - let r : GaussianInt := ⟨2*k, 0⟩ - let child := P5352T2Sources K hk 0 - let pred := P5352T2Sources K hk 3 - ∀ (p : ℤ), ∀ (q : ℤ), (⟨p, q⟩ ∈ FootprintVertices child.1) → ((⟨p, q⟩ - d ∈ - FootprintVertices pred.1) → (((↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ)) → (((1 : ℤ) ≤ p) - → ((p ≤ k) → ((∀ (a : Int), ∀ (b : Int), (0 ≤ b) → ((b ≤ 2*k) → ((-k ≤ a) → ((a ≤ k) - → ((-b-1 ≤ a) → ((a ≤ b+1) → ((-(2*k-b+1) ≤ a) → ((a ≤ 2*k-b+1) → ((⟨a,b⟩ : - GaussianInt) ∈ FootprintVertices (DiamondTile K.1)))))))))) → ((q = p - (1 : ℤ)) → ( - let zA : GaussianInt := ⟨p,p-1⟩ - (zA ∈ FootprintVertices (DiamondTile K.1)) → (zA-r ∈ FootprintVertices (DiamondTile K.1) - ↔ p=k)))))))) ) := by + ∀ (K : DiamondParameter), + (1 : ℕ) < K.1 → + let k : Int := K.1; + let r : GaussianInt := ⟨2 * k, 0⟩; + ∀ (p : ℤ), + ∀ (q : ℤ), + (↑(K.1 - (1 : ℕ)) : ℤ) = k - (1 : ℤ) → + (1 : ℤ) ≤ p → + p ≤ k → + (∀ (a : Int), + ∀ (b : Int), + 0 ≤ b → + b ≤ 2 * k → + -k ≤ a → + a ≤ k → + -b - 1 ≤ a → + a ≤ b + 1 → + -(2 * k - b + 1) ≤ a → + a ≤ 2 * k - b + 1 → + (⟨a, b⟩ : GaussianInt) ∈ + FootprintVertices (DiamondTile K.1)) → + q = p - (1 : ℤ) → + let zA : GaussianInt := ⟨p, p - 1⟩; + zA - r ∈ FootprintVertices (DiamondTile K.1) ↔ p = k + ) := by classical - intro K hk k d r child pred p q hz hpz hcast hp1 hpk childMem hq zA hzA + intro K hk k r p q hcast hp1 hpk childMem hq zA constructor · intro hh have hb := (P5352T2DomainRows K (zA-r)).1.mp hh @@ -598,13 +597,7 @@ private theorem qPs : rw [show (p-k)-(p-1-1-(1-k)) = 1-2*(k-1) by ring, floorOdd] rw [show -(p-k) = k-p by omega] -private theorem tri : - (by - classical - exact - ∀ (a : ℤ), (2 : ℤ) * (a * (a - (1 : ℤ)) / (2 : ℤ)) = a * (a - (1 : ℤ)) - ) := by - exact DiamondQuadraticArithmetic.triangularScale +private abbrev tri := ApollonianSuperharmonic.DiamondQuadraticArithmetic.triangularScale private theorem tdiff : (by @@ -929,7 +922,7 @@ theorem P5352T2Predecessor0 (K : DiamondParameter) (hk : 1 < K.1) FourNeighborLaplacian f ⟨p,p⟩ = 0) ∧ ((⟨p,p⟩ : GaussianInt)-r ∉ FootprintVertices child.1 → FourNeighborLaplacian f ⟨p,p⟩ = 1) := FirstPredecessorCases.boundaryCase K hk f hchild - p q hz hpz hcover hdpred hcast hdchild hp1 hq childMem hqp + p q hz hdpred hcast hdchild hp1 hq childMem hqp let Q : Int → Int → Int := fun a b => (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1) / 2 - (a-b)^2/4 have childValue (w : GaussianInt) @@ -953,7 +946,7 @@ theorem P5352T2Predecessor0 (K : DiamondParameter) (hk : 1 < K.1) let zA : GaussianInt := ⟨p,p-1⟩ have hzA : zA ∈ FootprintVertices (DiamondTile K.1) := by simpa [zA, child, P5352T2Sources, hq] using hz - have hComp := FirstPredecessorCases.hComp K hk p q hz hpz hcast hp1 hpk childMem hq hzA + have hComp := FirstPredecessorCases.hComp K hk p q hcast hp1 hpk childMem hq have hzEq : zA = (⟨p,p-1⟩ : GaussianInt) := rfl have hW : (⟨p-1,p-1⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := childMem (p-1) (p-1) (by omega) (by omega) (by omega) (by omega) diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean index 255d07ade1..bb5b5d90e9 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean @@ -379,9 +379,7 @@ private theorem sqOdd : norm_num at h ⊢ omega -private theorem tri : - ∀ (a : Int), 2 * (a * (a - 1) / 2) = a * (a - 1) := by - exact DiamondQuadraticArithmetic.triangularScale +private abbrev tri := ApollonianSuperharmonic.DiamondQuadraticArithmetic.triangularScale private theorem tdiff : (∀ (a : Int), 2 * (a * (a - 1) / 2) = a * (a - 1)) → diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean index 77dd19c699..c5ec146fcf 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean @@ -7,6 +7,7 @@ module public import LeanPool.ApollonianSuperharmonic.DiamondQuadraticArithmetic public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FourNeighborLaplacianProperties public import LeanPool.ApollonianSuperharmonic.P5352T2PlacementData public import LeanPool.ApollonianSuperharmonic.P5352T2DomainRows @@ -210,32 +211,49 @@ private theorem hComp : (by classical exact - ∀ (K : DiamondParameter), ∀ (hk : (1 : ℕ) < K.1), - let k : Int := K.1 - let child := P5352T2Sources K hk 0 - let pred := P5352T2Sources K hk 3 - let d : GaussianInt := ⟨-k, 1-k⟩ - let r : GaussianInt := ⟨-2*k, 0⟩ - (((K.1-1 : Nat) : Int) = k-1) → ((∀ (a : Int), ∀ (b : Int), (0 ≤ b ∧ b ≤ 2*k ∧ -k ≤ a ∧ a - ≤ k ∧ -b-1 ≤ a ∧ a ≤ b+1 ∧ -(2*k-b+1) ≤ a ∧ a ≤ 2*k-b+1) → ((⟨a,b⟩ : GaussianInt) ∈ - FootprintVertices (DiamondTile K.1))) → (∀ (t : ℤ), ((1 : ℤ) ≤ t) → ((t ≤ k) → ((⟨-t, - t - (1 : ℤ)⟩ ∈ FootprintVertices child.1) → ((⟨-t, t - (1 : ℤ)⟩ - d ∈ - FootprintVertices pred.1) → ((∀ (y : GaussianInt), y = ⟨-t, t - (1 : ℤ)⟩ ∨ y = ⟨-t, t - - (1 : ℤ)⟩ + (1 : GaussianInt) ∨ y = ⟨-t, t - (1 : ℤ)⟩ - (1 : GaussianInt) ∨ y = ⟨-t, - t - (1 : ℤ)⟩ + ⟨(0 : ℤ), (1 : ℤ)⟩ ∨ y = ⟨-t, t - (1 : ℤ)⟩ - ⟨(0 : ℤ), (1 : ℤ)⟩ → y ∈ - FootprintVertices child.1 ∨ y - d ∈ FootprintVertices pred.1) → (((0 : ℤ) ≤ t - (1 : - ℤ) ∧ t - (1 : ℤ) ≤ (2 : ℤ) * (↑K.1 : ℤ) ∧ -(↑K.1 : ℤ) ≤ -t ∧ -t ≤ (↑K.1 : ℤ) ∧ -(t - - (1 : ℤ)) - (1 : ℤ) ≤ -t ∧ -t ≤ t - (1 : ℤ) + (1 : ℤ) ∧ -((2 : ℤ) * (↑K.1 : ℤ) - (t - - (1 : ℤ)) + (1 : ℤ)) ≤ -t ∧ -t ≤ (2 : ℤ) * (↑K.1 : ℤ) - (t - (1 : ℤ)) + (1 : ℤ)) → - (((0 : ℤ) ≤ t - (1 : ℤ) - ((1 : ℤ) - k) ∧ t - (1 : ℤ) - ((1 : ℤ) - k) ≤ (2 : ℤ) * (k - - (1 : ℤ)) ∧ -(k - (1 : ℤ)) ≤ -t - -k ∧ -t - -k ≤ k - (1 : ℤ) ∧ -(t - (1 : ℤ) - ((1 : - ℤ) - k)) - (1 : ℤ) ≤ -t - -k ∧ -t - -k ≤ t - (1 : ℤ) - ((1 : ℤ) - k) + (1 : ℤ) ∧ -((2 - : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) ≤ -t - -k ∧ -t - -k ≤ - (2 : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + (1 : ℤ)) → ( - let x : GaussianInt := ⟨-t,t-1⟩ - x-r ∈ FootprintVertices (DiamondTile K.1) ↔ t=k))))))))) ) := by + ∀ (K : DiamondParameter), + (1 : ℕ) < K.1 → + let k : Int := K.1; + let r : GaussianInt := ⟨-2 * k, 0⟩; + ((K.1 - 1 : Nat) : Int) = k - 1 → + (∀ (a : Int), + ∀ (b : Int), + 0 ≤ b ∧ + b ≤ 2 * k ∧ + -k ≤ a ∧ + a ≤ k ∧ + -b - 1 ≤ a ∧ + a ≤ b + 1 ∧ -(2 * k - b + 1) ≤ a ∧ a ≤ 2 * k - b + 1 → + (⟨a, b⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1)) → + ∀ (t : ℤ), + (1 : ℤ) ≤ t → + t ≤ k → + (0 : ℤ) ≤ t - (1 : ℤ) ∧ + t - (1 : ℤ) ≤ (2 : ℤ) * (↑K.1 : ℤ) ∧ + -(↑K.1 : ℤ) ≤ -t ∧ + -t ≤ (↑K.1 : ℤ) ∧ + -(t - (1 : ℤ)) - (1 : ℤ) ≤ -t ∧ + -t ≤ t - (1 : ℤ) + (1 : ℤ) ∧ + -((2 : ℤ) * (↑K.1 : ℤ) - (t - (1 : ℤ)) + (1 : ℤ)) ≤ -t ∧ + -t ≤ (2 : ℤ) * (↑K.1 : ℤ) - (t - (1 : ℤ)) + (1 : ℤ) → + (0 : ℤ) ≤ t - (1 : ℤ) - ((1 : ℤ) - k) ∧ + t - (1 : ℤ) - ((1 : ℤ) - k) ≤ (2 : ℤ) * (k - (1 : ℤ)) ∧ + -(k - (1 : ℤ)) ≤ -t - -k ∧ + -t - -k ≤ k - (1 : ℤ) ∧ + -(t - (1 : ℤ) - ((1 : ℤ) - k)) - (1 : ℤ) ≤ -t - -k ∧ + -t - -k ≤ t - (1 : ℤ) - ((1 : ℤ) - k) + (1 : ℤ) ∧ + -((2 : ℤ) * (k - (1 : ℤ)) - + (t - (1 : ℤ) - ((1 : ℤ) - k)) + + (1 : ℤ)) ≤ + -t - -k ∧ + -t - -k ≤ + (2 : ℤ) * (k - (1 : ℤ)) - (t - (1 : ℤ) - ((1 : ℤ) - k)) + + (1 : ℤ) → + let x : GaussianInt := ⟨-t, t - 1⟩ + x - r ∈ FootprintVertices (DiamondTile K.1) ↔ t = k + ) := by classical - intro K hk k child pred d r hkm childMem t ht1 htk hz hpz hcover hc hp x + intro K hk k r hkm childMem t ht1 htk hc hp x constructor · intro hh have h := (P5352T2DomainRows K (x-r)).1.mp hh @@ -363,13 +381,7 @@ private theorem hPredS : have h := predTranslatedValue ⟨-t,t-2⟩ (by rw [hy]; exact hPS) convert h using 1; simp [hy,d] -private theorem tri : - (by - classical - exact - ∀ (n : ℤ), (2 : ℤ) * (n * (n - (1 : ℤ)) / (2 : ℤ)) = n * (n - (1 : ℤ)) - ) := by - exact DiamondQuadraticArithmetic.triangularScale +private abbrev tri := ApollonianSuperharmonic.DiamondQuadraticArithmetic.triangularScale private theorem tdiff : (by @@ -501,19 +513,17 @@ private theorem qPredWlt : classical exact ∀ (K : DiamondParameter), - IntegerLatticeFunction → - Int → - let k : Int := K.1; - let Q : Int → Int → Int := fun a b => - (Int.natAbs a : Int) * ((Int.natAbs a : Int) - 1) / 2 - (a - b) ^ 2 / 4; - (∀ (m : Int), (1 - 2 * m) ^ 2 / 4 = m ^ 2 - m) → - ∀ (t : ℤ), - t < k → - Q (k - t - (1 : ℤ)) (k + t - (2 : ℤ)) = - (k - t - (1 : ℤ)) * (k - t - (2 : ℤ)) / (2 : ℤ) - (t * t - t) + let k : Int := K.1; + let Q : Int → Int → Int := fun a b => + (Int.natAbs a : Int) * ((Int.natAbs a : Int) - 1) / 2 - (a - b) ^ 2 / 4; + (∀ (m : Int), (1 - 2 * m) ^ 2 / 4 = m ^ 2 - m) → + ∀ (t : ℤ), + t < k → + Q (k - t - (1 : ℤ)) (k + t - (2 : ℤ)) = + (k - t - (1 : ℤ)) * (k - t - (2 : ℤ)) / (2 : ℤ) - (t * t - t) ) := by classical - intro K f B k Q floorOdd t ht + intro K k Q floorOdd t ht simp only [Q, Int.natCast_natAbs] rw [abs_of_nonneg (by omega : 0 ≤ k-t-1)] rw [show (k-t-1)-(k+t-2)=1-2*t by ring, floorOdd] @@ -674,17 +684,7 @@ private theorem hSouthDiff : rw [hs, hPredS, hChildC, hAgree, qPredS, qPredC] ring -private theorem lapIdentity : - (by - classical - exact - ∀ (g : IntegerLatticeFunction), ∀ (w : GaussianInt), FourNeighborLaplacian g w = g (w + - (1 : GaussianInt)) - g w + (g (w - (1 : GaussianInt)) - g w) + (g (w + ⟨(0 : ℤ), (1 : - ℤ)⟩) - g w) + (g (w - ⟨(0 : ℤ), (1 : ℤ)⟩) - g w) ) := by - classical - intro g w - unfold FourNeighborLaplacian - ring +private abbrev lapIdentity := ApollonianSuperharmonic.FourNeighborLaplacianProperties.differences private theorem lap0 : (by @@ -904,7 +904,7 @@ theorem P5352T2Predecessor3 (K : DiamondParameter) (hk : 1 < K.1) subst b let x : GaussianInt := ⟨-t,t-1⟩ have hComp : x-r ∈ FootprintVertices (DiamondTile K.1) ↔ t=k := - FourthPredecessorCases.hComp K hk hkm childMem t ht1 htk hz hpz hcover hc hp + FourthPredecessorCases.hComp K hk hkm childMem t ht1 htk hc hp have hX : x ∈ FootprintVertices (DiamondTile K.1) := by apply childMem (-t) (t-1); omega have hE : (⟨1-t,t-1⟩ : GaussianInt) ∈ FootprintVertices (DiamondTile K.1) := by @@ -931,7 +931,7 @@ theorem P5352T2Predecessor3 (K : DiamondParameter) (hk : 1 < K.1) have qChildN := FourthPredecessorCases.qChildN K f B floorEven t ht1 hChildC hPredC hPredW tri tdiff have qPredC := FourthPredecessorCases.qPredC K f B floorEven t htk hChildC hPredC hPredW - have qPredWlt (ht : t simp [I, Zsqrtd.ext_iff] - · rcases h with ⟨hz, _⟩ | ⟨_, hz⟩ - · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ - congr 1 <;> simp [] +private abbrev boundaryEdge := ApollonianSuperharmonic.BoundaryFootprintInclusion.boundaryEdge private theorem hnewe : (by @@ -1146,22 +1142,7 @@ private theorem hslopeU : rw [(PartialOdometerAffineTranslateFormulas h u au 0).2.2.2.2.2, hp] rfl -private theorem hslopeU' : - (by - classical - exact - ∀ (C : BandCircle), ∀ (h : PartialOdometer), ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : - ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), - let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] - ∀ (w : Fin (4 : ℕ)), ∀ (p : ℝ × ℝ), (PartialOdometerSlope h = some p) → ( - let u' : GaussianInt := owner w - ∀ (au' : GaussianInt), - let hu'Odo : PartialOdometer := PartialOdometerAffineTranslate h u' au' 0 - PartialOdometerSlope hu'Odo = some (p.1 + (au'.re : ℝ), p.2 + (au'.im : ℝ))) ) := by - classical - intro C h a0 a1 a2 a3 owner w p hp u' au' hu'Odo - rw [(PartialOdometerAffineTranslateFormulas h u' au' 0).2.2.2.2.2, hp] - rfl +private abbrev hslopeU' := ApollonianSuperharmonic.WebLaplacianGeometry.hslopeU private theorem cellVertex : (by @@ -1277,56 +1258,81 @@ private theorem hstar : (by classical exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (x : GaussianInt), ∀ (v - : GaussianInt), ∀ (hv : v ∈ TilingLattice C), (x ∈ BoundaryFootprintVertices - (TileTranslation T v)) → (∀ (P : PeriodicTileComplex ↥(TilingLattice C)), - let iv : TilingLattice C := ⟨v, hv⟩ - (x ∈ BoundaryFootprintVertices (P.tile iv)) → ((∃ y ∈ (P.tile iv).cells, y = x ∨ y = x - - 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩) → ((∃ y, y ∉ (P.tile iv).cells ∧ (y = x ∨ y - = x - 1 ∨ y = x - 1 - ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩)) → (∀ (a0 : ↥(TilingLattice C)), (x ∈ - (P.tile a0).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - ∈ (P.tile a).cells) y → y = a0) → (∀ (a1 : ↥(TilingLattice C)), (x - (1 : - LatticeCell) ∈ (P.tile a1).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : - ↥(TilingLattice C)) => x - (1 : LatticeCell) ∈ (P.tile a).cells) y → y = a1) → (∀ (a2 - : ↥(TilingLattice C)), (x - (1 : LatticeCell) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ - (P.tile a2).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - - (1 : LatticeCell) - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = - a2) → (∀ (a3 : ↥(TilingLattice C)), (x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile - a3).cells) → ((∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (⟨(0 - : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = a3) → ( - let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] - ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), - let next : Fin 4 → Fin 4 := ![1, 2, 3, 0] - ∀ (e : Fin (4 : ℕ)), - let sector : Fin 4 → GaussianInt := - ![x, x - 1, x - 1 - ⟨0, 1⟩, x - ⟨0, 1⟩] - let edge : Fin 4 → Finset GaussianInt := - ![{x, x + ⟨0, 1⟩}, {x - 1, x}, - {x - ⟨0, 1⟩, x}, {x, x + 1}] - (∀ i, sector i ∈ (P.tile (owner i)).cells) → ((∀ (i : Fin 4), ∀ (j : Fin 4), (owner i ≠ - owner j) → (sector j ∉ (P.tile (owner i)).cells)) → ((∀ (i : Fin 4), (owner i ≠ owner - (next i)) → (edge i ∈ BoundaryFootprintEdges (P.tile (owner i)) ∧ edge i ∈ - BoundaryFootprintEdges (P.tile (owner (next i))))) → ((edge e ∈ - BoundaryFootprintEdges (P.tile (owner e))) → ((edge e ∈ BoundaryFootprintEdges - (P.tile (owner (next e)))) → ( - let u : GaussianInt := owner m - let u' : GaussianInt := owner w - ∀ (au : GaussianInt), ∀ (au' : GaussianInt), - let huOdo : PartialOdometer := PartialOdometerAffineTranslate h u au 0 - let hu'Odo : PartialOdometer := PartialOdometerAffineTranslate h u' au' 0 - (∀ (i : Fin 4), ∀ (y : GaussianInt), (y = sector i ∨ y = sector i + 1 ∨ y = sector i + - ⟨0, 1⟩ ∨ y = sector i + 1 + ⟨0, 1⟩) → (y ∈ FootprintVertices (P.tile (owner i)))) → - ((∀ i : Fin 4, x = sector i ∨ x = sector i + 1 ∨ x = sector i + ⟨0, 1⟩ ∨ x = sector i - + 1 + ⟨0, 1⟩) → ((∀ (i : Fin 4), ∀ (j : Fin 4), (i ≠ j) → (owner i = owner m ∨ owner - i = owner w ∨ owner j = owner m ∨ owner j = owner w)) → ((∀ (y : GaussianInt), (y ∈ - FootprintVertices (P.tile (owner m)) ∨ y ∈ FootprintVertices (P.tile (owner w))) → (y - ∈ huOdo.domain ∨ y ∈ hu'Odo.domain)) → ((x ∈ huOdo.domain) → ((x ∈ hu'Odo.domain) → - (∀ y, y = x ∨ y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → y ∈ - huOdo.domain ∨ y ∈ hu'Odo.domain))))))))))))))))))))))) ) := by + ∀ (C : BandCircle), + ∀ (h : PartialOdometer), + ∀ (x : GaussianInt), + ∀ (v : GaussianInt), + v ∈ TilingLattice C → + ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), + ∀ (a0 : ↥(TilingLattice C)), + (∀ (y : ↥(TilingLattice C)), + (fun (a : ↥(TilingLattice C)) => x ∈ (P.tile a).cells) y → + y = a0) → + ∀ (a1 : ↥(TilingLattice C)), + (∀ (y : ↥(TilingLattice C)), + (fun (a : ↥(TilingLattice C)) => + x - (1 : LatticeCell) ∈ (P.tile a).cells) + y → + y = a1) → + ∀ (a2 : ↥(TilingLattice C)), + (∀ (y : ↥(TilingLattice C)), + (fun (a : ↥(TilingLattice C)) => + x - (1 : LatticeCell) - + (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ + (P.tile a).cells) + y → + y = a2) → + ∀ (a3 : ↥(TilingLattice C)), + (∀ (y : ↥(TilingLattice C)), + (fun (a : ↥(TilingLattice C)) => + x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) + y → + y = a3) → + let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3]; + ∀ (m : Fin (4 : ℕ)), + ∀ (w : Fin (4 : ℕ)), + let sector : Fin 4 → GaussianInt := + ![x, x - 1, x - 1 - ⟨0, 1⟩, x - ⟨0, 1⟩]; + (∀ (i : Fin 4), + ∀ (j : Fin 4), + owner i ≠ owner j → sector j ∉ (P.tile (owner i)).cells) → + let u : GaussianInt := owner m; + let u' : GaussianInt := owner w; + ∀ (au : GaussianInt), + ∀ (au' : GaussianInt), + let huOdo : PartialOdometer := + PartialOdometerAffineTranslate h u au 0; + let hu'Odo : PartialOdometer := + PartialOdometerAffineTranslate h u' au' 0; + (∀ (i : Fin 4), + ∀ (y : GaussianInt), + y = sector i ∨ + y = sector i + 1 ∨ + y = sector i + ⟨0, 1⟩ ∨ y = sector i + 1 + ⟨0, 1⟩ → + y ∈ FootprintVertices (P.tile (owner i))) → + (∀ i : Fin 4, + x = sector i ∨ + x = sector i + 1 ∨ + x = sector i + ⟨0, 1⟩ ∨ x = sector i + 1 + ⟨0, 1⟩) → + (∀ (i : Fin 4), + ∀ (j : Fin 4), + i ≠ j → + owner i = owner m ∨ + owner i = owner w ∨ + owner j = owner m ∨ owner j = owner w) → + (∀ (y : GaussianInt), + y ∈ FootprintVertices (P.tile (owner m)) ∨ + y ∈ FootprintVertices (P.tile (owner w)) → + y ∈ huOdo.domain ∨ y ∈ hu'Odo.domain) → + x ∈ huOdo.domain → + ∀ y, + y = x ∨ + y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ → + y ∈ huOdo.domain ∨ y ∈ hu'Odo.domain + ) := by classical - intro C T h x v hv hx P iv hxi hcorner hcornerOutside a0 ha0 hu0 a1 ha1 hu1 a2 ha2 hu2 a3 ha3 - hu3 owner m w next e sector edge hsector hsectorNot hedgeBoundary edge_mem_e edge_mem_next - u u' au au' huOdo hu'Odo cellVertex sectorCornerX pairCovered toDomains hxM hxW y hy + intro C h x v hv P a0 hu0 a1 hu1 a2 hu2 a3 hu3 owner m w sector hsectorNot u u' au au' huOdo + hu'Odo cellVertex sectorCornerX pairCovered toDomains hxM y hy rcases hy with rfl | rfl | rfl | rfl | rfl · exact Or.inl hxM · have hpair : x + 1 ∈ FootprintVertices (P.tile (owner m)) ∨ @@ -1634,8 +1640,8 @@ theorem PeriodicBoundaryWebLaplacian (C : BandCircle) have hxi : x ∈ BoundaryFootprintVertices (P.tile iv) := by simpa [hPv] using hx have hcells := WebLaplacianGeometry.hcells C v hv P - have hcorner := WebLaplacianGeometry.hcorner C T x v hv hx P hxi hcells - have hcornerOutside := WebLaplacianGeometry.hcornerOutside C T x v hv hx P hxi hcells hcorner + have hcorner := WebLaplacianGeometry.hcorner C x v hv P hxi hcells + have hcornerOutside := WebLaplacianGeometry.hcornerOutside C x v hv P hxi hcells hcorner obtain ⟨a0, ha0, hu0⟩ := PeriodicTileIndexedMultiplicityOne P x obtain ⟨a1, ha1, hu1⟩ := PeriodicTileIndexedMultiplicityOne P (x - 1) obtain ⟨a2, ha2, hu2⟩ := @@ -1746,11 +1752,10 @@ theorem PeriodicBoundaryWebLaplacian (C : BandCircle) (TileTranslation T u') huOdo hu'Odo hadjOdo).1 have hweb := (OdometerWeb).1 C (TileTranslation T u) (TileTranslation T u') huOdo hu'Odo g x hcompat hextu hextu' hxM hxW - (WebLaplacianGeometry.hstar C T h x v hv hx P hxi hcorner hcornerOutside a0 ha0 hu0 a1 - ha1 hu1 a2 ha2 hu2 a3 ha3 hu3 m w e hsector hsectorNot hedgeBoundary edge_mem_e - edge_mem_next au au' cellVertex sectorCornerX (WebLaplacianGeometry.pairCovered C a0 a1 + (WebLaplacianGeometry.hstar C h x v hv P a0 hu0 a1 hu1 a2 hu2 a3 hu3 m w hsectorNot au + au' cellVertex sectorCornerX (WebLaplacianGeometry.pairCovered C a0 a1 a2 a3 m w hcover) (WebLaplacianGeometry.toDomains C T h P a0 a1 a2 a3 m w au au' hdomu - hdomu' tileM tileW) hxM hxW) + hdomu' tileM tileW) hxM) exact hweb.1 hadjOdo end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRoutingRigidity.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRoutingRigidity.lean index 260855958c..6be4dec4f5 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRoutingRigidity.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileContactRoutingRigidity.lean @@ -281,24 +281,46 @@ private theorem avoid : (by classical exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), (∀ - {a : ι}, ∀ {b : ι}, (P.plane.adjacent a b) → (P3723T1EdgeContact P a b)) → (∀ - [Nontrivial ι], ∀ (a : ι), ∀ (b : ι), (a ≠ b) → (((FootprintEdges (P.tile a) ∩ - FootprintEdges (P.tile b)).Nonempty) → ((P3723T1EdgeContact P a b) → (∀ (h : - (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) ≃ₜ (↑(D.edgeArc a b) : Type)), ((↑((h : - (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → (↑(D.edgeArc a b) : Type)) ⟨(0 : ℝ), - (by norm_num)⟩) : ℝ × ℝ) = D.position a) → (((↑((h : (↑(Set.Icc - (0 : ℝ) (1 : ℝ)) : Type) → (↑(D.edgeArc a b) : Type)) ⟨(1 : ℝ), - (by norm_num)⟩) : ℝ × ℝ) = D.position b) → ((¬P.plane.adjacent - a b) → ( - let g : Set.Icc (0 : Real) 1 → Real × Real := fun t => h t - (Continuous g) → ((Function.Injective g) → ((∀ {c : ι}, ∀ {d : ι}, (P.plane.adjacent c d) - → (({a, b} : Set ι) ≠ {c, d})) → (∀ t : Set.Icc (0 : Real) 1, 0 < (t : Real) → (t : - Real) < 1 → g t ∉ Set.range D.position ∪ {p | ∃ c d, P.plane.adjacent c d ∧ p ∈ - D.edgeArc c d})))))))))) ) := by + ∀ (ι : Type), + ∀ (P : PeriodicTileComplex ι), + ∀ (D : P3723T1AllContactRouting P), + (∀ {a : ι}, ∀ {b : ι}, P.plane.adjacent a b → P3723T1EdgeContact P a b) → + ∀ [Nontrivial ι], + ∀ (a : ι), + ∀ (b : ι), + a ≠ b → + P3723T1EdgeContact P a b → + ∀ + (h : + (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) ≃ₜ + (↑(D.edgeArc a b) : Type)), + (↑((h : + (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → + (↑(D.edgeArc a b) : Type)) + ⟨(0 : ℝ), by norm_num⟩) : + ℝ × ℝ) = + D.position a → + (↑((h : + (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → + (↑(D.edgeArc a b) : Type)) + ⟨(1 : ℝ), by norm_num⟩) : + ℝ × ℝ) = + D.position b → + let g : Set.Icc (0 : Real) 1 → Real × Real := fun t => + h t; + Function.Injective g → + (∀ {c : ι}, + ∀ {d : ι}, + P.plane.adjacent c d → ({ a, b } : Set ι) ≠ { c, d }) → + ∀ t : Set.Icc (0 : Real) 1, + 0 < (t : Real) → + (t : Real) < 1 → + g t ∉ + Set.range D.position ∪ + {p | ∃ c d, P.plane.adjacent c d ∧ p ∈ D.edgeArc c d} + ) := by classical - intro ι P D contact this a b hab hcontact saved_contact h hstart hend hn g gc gi different t - ht0 ht1 + intro ι P D contact this a b hab saved_contact h hstart hend g gi different t ht0 ht1 have hga : g t ≠ D.position a := by intro heq have ht := gi (heq.trans hstart.symm) @@ -532,8 +554,8 @@ theorem PeriodicTileContactRoutingRigidity {ι : Type} h.injective (Subtype.ext hst) have different {c d : ι} (hcd : P.plane.adjacent c d) := ContactRoutingGeometry.different ι P symmetric a b hab hn (c := c) (d := d) hcd - have avoid := ContactRoutingGeometry.avoid ι P D contact a b hab hcontact - saved_contact h hstart hend hn gc gi different + have avoid := ContactRoutingGeometry.avoid ι P D contact a b hab + saved_contact h hstart hend gi different obtain ⟨f, ⟨i, hi⟩, ⟨j, hj⟩, _⟩ := P3861T1ExtraArcLocalization P D F disjoint_faces a b g gc gi hstart hend avoid apply hn diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionPaths.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionPaths.lean index d24f2d4fe7..fea4730e12 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileIntersectionPaths.lean @@ -355,36 +355,6 @@ private theorem hw : rw [← htrace_eq] exact Or.inl ⟨w, rfl⟩ -private theorem hcd : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (a : ι), ∀ (b : ι), (a ≠ b) → ((∀ (f : - P.plane.Face), (∃ i, P.plane.faceVertex f i = a) → ((∃ i, P.plane.faceVertex f i = b) - → (∃ c : ι, c ≠ a ∧ c ≠ b ∧ ∃ i, P.plane.faceVertex f i = c))) → ((((FootprintEdges - (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty ↔ P.plane.adjacent a b) ∧ - ((FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile b)).Nonempty → SimpleGridPath - (CommonFootprintEdgeVertices (P.tile a) (P.tile b)) (FootprintEdges (P.tile a) ∩ - FootprintEdges (P.tile b)) ∧ FootprintVertices (P.tile a) ∩ FootprintVertices (P.tile - b) = CommonFootprintEdgeVertices (P.tile a) (P.tile b)) ∧ (¬(FootprintEdges (P.tile - a) ∩ FootprintEdges (P.tile b)).Nonempty → FootprintVertices (P.tile a) ∩ - FootprintVertices (P.tile b) = ∅ ∨ (FootprintVertices (P.tile a) ∩ FootprintVertices - (P.tile b)).Subsingleton)) → (((FootprintEdges (P.tile a) ∩ FootprintEdges (P.tile - b)).Nonempty ↔ P.plane.adjacent a b) → ((P.plane.adjacent a b) → (∀ (f : - P.plane.Face), ∀ (g : P.plane.Face), ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = - a) ∧ ∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = b) → (((∃ (i : Fin (3 : ℕ)), - P.plane.faceVertex g i = a) ∧ ∃ (i : Fin (3 : ℕ)), P.plane.faceVertex g i = b) → ((∀ - (h : P.plane.Face), ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex h i = a) ∧ ∃ (i : Fin - (3 : ℕ)), P.plane.faceVertex h i = b) → h = f ∨ h = g) → (∀ (c : ι), (c ≠ a) → ((c ≠ - b) → ((∃ (i : Fin (3 : ℕ)), P.plane.faceVertex f i = c) → (∀ (d : ι), (d ≠ a) → ((d ≠ - b) → ((c = d → ∀ w : ι, w = a ∨ w = b ∨ w = c) → (c ≠ d)))))))))))))) ) := by - classical - intro ι P a b hab third_vertex hclassification hcriterion hadj f g hf hg hfaces c hca hcb hfc d - hda hdb hcellular h - let : Infinite ι := P3192T1PeriodicIndicesInfinite P - obtain ⟨w, hw⟩ := ({a, b, c} : Finset ι).exists_notMem - rcases hcellular h w with rfl | rfl | rfl <;> exact hw (by simp) - private theorem hxAt393 : (by classical @@ -597,8 +567,11 @@ theorem PeriodicTileIntersectionPaths {ι : Type} (P : PeriodicTileComplex ι) (face_adjacent f c a hca hfc hf.1) hw with hc | ha · exact Or.inr (Or.inr hc) · exact Or.inl ha - have hcd := IntersectionPathGeometry.hcd ι P a b hab third_vertex hclassification hcriterion - hadj f g hf hg hfaces c hca hcb hfc d hda hdb hcellular + have hcd : c ≠ d := by + intro h + let : Infinite ι := P3192T1PeriodicIndicesInfinite P + obtain ⟨w, hw⟩ := ({a, b, c} : Finset ι).exists_notMem + rcases hcellular h w with rfl | rfl | rfl <;> exact hw (by simp) have hfac := face_adjacent f a c hca.symm hf.1 hfc have hfbc := face_adjacent f b c hcb.symm hf.2 hfc have hx (h : P.plane.Face) diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean index e0db7b854d..a56d62d6c2 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean @@ -534,39 +534,47 @@ private theorem hshared : (by classical exact - ∀ (T : ProtoTile), (FourNeighborConnected (↑T.cells : Set LatticeCell) ∧ - NoCheckerboardCellVertex (↑T.cells : Set LatticeCell) ∧ SimpleGridCycle - (BoundaryFootprintVertices T) (BoundaryFootprintEdges T)) → (((∀ (x : LatticeCell), ∀ - (y : LatticeCell), FourNeighborAdjacent x y → x ∈ BoundaryFootprintVertices T → y ∈ - BoundaryFootprintVertices T → ¬OpenLatticeEdge x y ⊆ interior (TileRealization T)) ∧ - (∀ x ∈ FootprintVertices T, ∀ y ∈ FootprintVertices T, FourNeighborAdjacent x y → {x, - y} ∈ FootprintEdges T) ∧ ∀ x ∈ FootprintVertices T, GaussianRealPoint x ∈ interior - (TileRealization T) ↔ x ∉ BoundaryFootprintVertices T) → ( - let I : GaussianInt := ⟨0, 1⟩ - let cornerBag : Multiset GaussianInt := T.cells.1.bind fun c => - ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) - let N : Nat → Nat := fun k => - (cornerBag.toFinset.filter fun z => cornerBag.count z = k).card - ((4 : ℕ) * Finset.card T.cells = N (1 : ℕ) + (2 : ℕ) * N (2 : ℕ) + (3 : ℕ) * N (3 : ℕ) + - (4 : ℕ) * N (4 : ℕ) ∧ (FootprintVertices T).ncard = N (1 : ℕ) + N (2 : ℕ) + N (3 : ℕ) - + N (4 : ℕ) ∧ (2 : ℕ) * (FootprintEdges T).ncard = (4 : ℕ) * Finset.card T.cells + - (BoundaryFootprintEdges T).ncard ∧ (BoundaryFootprintEdges T).ncard = N (1 : ℕ) + N - (2 : ℕ) + N (3 : ℕ)) → ( - let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => - if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} - let V := cornerBag.toFinset - let E := (V.product (Finset.univ : Finset Bool)).filter - fun e => edgeOf e ∈ FootprintEdges T - let A := E.filter fun e => edgeOf e ∉ BoundaryFootprintEdges T - (∀ (q : GaussianInt × Bool), q ∈ E ↔ if q.2 then (q.1 ∈ T.cells ∨ q.1 - 1 ∈ T.cells) else - (q.1 ∈ T.cells ∨ q.1 - I ∈ T.cells)) → ((∀ (q : GaussianInt × Bool), edgeOf q ∈ - BoundaryFootprintEdges T ↔ if q.2 then ((q.1 ∈ T.cells ∧ q.1 - 1 ∉ T.cells) ∨ (q.1 ∉ - T.cells ∧ q.1 - 1 ∈ T.cells)) else ((q.1 ∈ T.cells ∧ q.1 - I ∉ T.cells) ∨ (q.1 ∉ - T.cells ∧ q.1 - I ∈ T.cells))) → (∀ (q : GaussianInt × Bool), (q ∈ A) → (if q.2 then - (q.1 ∈ T.cells ∧ q.1 - 1 ∈ T.cells) else (q.1 ∈ T.cells ∧ q.1 - I ∈ T.cells))))))) ) + ∀ (T : ProtoTile), + let I : GaussianInt := ⟨0, 1⟩ + let cornerBag : Multiset GaussianInt := + T.cells.1.bind fun c => ([c, c + 1, c + I, c + 1 + I] : List GaussianInt) + let N : Nat → Nat := fun k => + (cornerBag.toFinset.filter fun z => cornerBag.count z = k).card + (4 : ℕ) * Finset.card T.cells = + N (1 : ℕ) + (2 : ℕ) * N (2 : ℕ) + (3 : ℕ) * N (3 : ℕ) + + (4 : ℕ) * N (4 : ℕ) ∧ + (FootprintVertices T).ncard = + N (1 : ℕ) + N (2 : ℕ) + N (3 : ℕ) + N (4 : ℕ) ∧ + (2 : ℕ) * (FootprintEdges T).ncard = + (4 : ℕ) * Finset.card T.cells + (BoundaryFootprintEdges T).ncard ∧ + (BoundaryFootprintEdges T).ncard = N (1 : ℕ) + N (2 : ℕ) + N (3 : ℕ) → + let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => + if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} + let V := cornerBag.toFinset + let E := + (V.product (Finset.univ : Finset Bool)).filter fun e => + edgeOf e ∈ FootprintEdges T + let A := E.filter fun e => edgeOf e ∉ BoundaryFootprintEdges T + (∀ (q : GaussianInt × Bool), + q ∈ E ↔ + if q.2 then q.1 ∈ T.cells ∨ q.1 - 1 ∈ T.cells + else q.1 ∈ T.cells ∨ q.1 - I ∈ T.cells) → + (∀ (q : GaussianInt × Bool), + edgeOf q ∈ BoundaryFootprintEdges T ↔ + if q.2 then + q.1 ∈ T.cells ∧ q.1 - 1 ∉ T.cells ∨ + q.1 ∉ T.cells ∧ q.1 - 1 ∈ T.cells + else + q.1 ∈ T.cells ∧ q.1 - I ∉ T.cells ∨ + q.1 ∉ T.cells ∧ q.1 - I ∈ T.cells) → + ∀ (q : GaussianInt × Bool), + q ∈ A → + if q.2 then q.1 ∈ T.cells ∧ q.1 - 1 ∈ T.cells + else q.1 ∈ T.cells ∧ q.1 - I ∈ T.cells + ) := by classical - intro T htiles hreg I cornerBag N hinc edgeOf V E A hEocc hBEocc q hq + intro T I cornerBag N hinc edgeOf V E A hEocc hBEocc q hq rcases Finset.mem_filter.mp hq with ⟨hqe, hqb⟩ rw [hEocc] at hqe rw [hBEocc] at hqb @@ -1109,41 +1117,40 @@ private theorem hcell_residue_unique : (by classical exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (g : - IntegerLatticeFunction), ((↑h.domain : Set GaussianInt) = FootprintVertices T) → - ((BandPrototile C.1.1 T) → ((LatticeTile T) → ((ExactTileTiling (RegularTileFamily T - (TilingLattice C))) → ((∀ x ∈ BoundaryFootprintVertices T, FourNeighborLaplacian g x - = (1 : ℤ)) → ((∀ (D : Finset GaussianInt), (∀ z, z ∈ D ↔ z ∈ FootprintVertices T ∧ z - ∉ BoundaryFootprintVertices T) → ((∀ z, z ∈ FootprintVertices T → z ∉ - BoundaryFootprintVertices T → z ∈ T.cells ∧ z - 1 ∈ T.cells ∧ z - (⟨0, 1⟩ : - GaussianInt) ∈ T.cells ∧ z - 1 - (⟨0, 1⟩ : GaussianInt) ∈ T.cells) → ((3 * (D.card : - Int) - T.cells.card + 1) = (D.filter fun z => z + 1 ∈ D).card + (D.filter fun z => z - + (⟨0, 1⟩ : GaussianInt) ∈ D).card))) → ((FourNeighborConnected (↑T.cells : Set - LatticeCell) ∧ NoCheckerboardCellVertex (↑T.cells : Set LatticeCell) ∧ - SimpleGridCycle (BoundaryFootprintVertices T) (BoundaryFootprintEdges T)) → - (((FootprintVertices T).ncard + Finset.card T.cells = (FootprintEdges T).ncard + (1 : - ℕ)) → (((∀ (x : LatticeCell), ∀ (y : LatticeCell), FourNeighborAdjacent x y → x ∈ - BoundaryFootprintVertices T → y ∈ BoundaryFootprintVertices T → ¬OpenLatticeEdge x y - ⊆ interior (TileRealization T)) ∧ (∀ x ∈ FootprintVertices T, ∀ y ∈ FootprintVertices - T, FourNeighborAdjacent x y → {x, y} ∈ FootprintEdges T) ∧ ∀ x ∈ FootprintVertices T, - GaussianRealPoint x ∈ interior (TileRealization T) ↔ x ∉ BoundaryFootprintVertices T) - → ( - let D : Finset GaussianInt := h.domain.filter - (fun x => @decide (x ∉ BoundaryFootprintVertices T) - (Classical.propDecidable _)) - (T.cells.Nonempty) → (∀ (p : List GaussianInt), ∀ (x₀ : GaussianInt), ∀ (x₁ : - GaussianInt), (BoundaryFootprintVertices T = (↑p.toFinset : Set GaussianInt)) → ((∀ - (e : Finset GaussianInt), e ∈ BoundaryFootprintEdges T ↔ e = {x₁, x₀} ∨ ∃ (a : - GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) (l₂ : List GaussianInt), p = - l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (((BoundaryFootprintVertices T).ncard = p.length) - → ((∀ (z : GaussianInt), z ∈ D ↔ z ∈ FootprintVertices T ∧ z ∉ - BoundaryFootprintVertices T) → ((∀ (v : GaussianInt), (T.cells.image (fun z => z + v) - = T.cells) → (v = 0)) → ((∀ (z : GaussianInt), ∃ a ∈ T.cells, ∃ v ∈ TilingLattice C, - z = a + v) → (∀ (a : GaussianInt), ∀ (a' : GaussianInt), (a ∈ T.cells) → ((a' ∈ - T.cells) → ((a - a' ∈ TilingLattice C) → (a = a'))))))))))))))))))) ) := by - classical - intro C T h g hdom hT hlat htile hweb hcountBridge htiles heuler hreg D hcells p x₀ x₁ hverts - hedges hboundary_card hDmem htranslation_rigid hcell_cover a a' ha ha' hres + ∀ (C : BandCircle), + ∀ (T : ProtoTile), + ∀ (h : PartialOdometer), + ∀ (g : IntegerLatticeFunction), + (↑h.domain : Set GaussianInt) = FootprintVertices T → + ExactTileTiling (RegularTileFamily T (TilingLattice C)) → + (∀ x ∈ BoundaryFootprintVertices T, + FourNeighborLaplacian g x = (1 : ℤ)) → + (FootprintVertices T).ncard + Finset.card T.cells = + (FootprintEdges T).ncard + (1 : ℕ) → + ∀ (p : List GaussianInt), + ∀ (x₀ : GaussianInt), + ∀ (x₁ : GaussianInt), + BoundaryFootprintVertices T = + (↑p.toFinset : Set GaussianInt) → + (∀ (e : Finset GaussianInt), + e ∈ BoundaryFootprintEdges T ↔ + e = { x₁, x₀ } ∨ + ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : + List GaussianInt) (l₂ : List GaussianInt), + p = l₁ ++ a :: b :: l₂ ∧ e = { a, b }) → + (BoundaryFootprintVertices T).ncard = p.length → + (∀ (v : GaussianInt), + (T.cells.image fun z => z + v) = T.cells → v = 0) → + (∀ (z : GaussianInt), + ∃ a ∈ T.cells, ∃ v ∈ TilingLattice C, z = a + v) → + ∀ (a : GaussianInt), + ∀ (a' : GaussianInt), + a ∈ T.cells → + a' ∈ T.cells → a - a' ∈ TilingLattice C → a = a' + ) := by + classical + intro C T h g hdom htile hweb heuler p x₀ x₁ hverts hedges hboundary_card htranslation_rigid + hcell_cover a a' ha ha' hres let v := a - a' have htransmem : a ∈ (TileTranslation T v).cells := by change a ∈ T.cells.image (fun z => z + v) @@ -1929,7 +1936,7 @@ private theorem hcountBridge : let J := A.filter fun q => q.1 ∈ D ∧ q.1 + step q.2 ∈ D have hdegree_count : A.card + J.card = 4 * D.card := PeriodicIndegreeGeometry.hdegree_count T D (PeriodicIndegreeGeometry.hAendpoint T D hDmem hreg hEV hEmem - (PeriodicIndegreeGeometry.hshared T htiles hreg hinc hEocc + (PeriodicIndegreeGeometry.hshared T hinc hEocc (PeriodicIndegreeGeometry.hBEocc T edgeOf_injective)) (PeriodicIndegreeGeometry.hhorizontal T) (PeriodicIndegreeGeometry.hvertical T) hedgeOf) (PeriodicIndegreeGeometry.hdegree_sum T D (PeriodicIndegreeGeometry.hdegree T D hDmem @@ -1998,9 +2005,9 @@ theorem PeriodicTileTotalIndegree (C : BandCircle) have hDmem := PeriodicIndegreeGeometry.hDmem T h hdom -- Exact tiling makes the cell bases a finite set of residue representatives. have hcell_cover := PeriodicIndegreeGeometry.hcell_cover C T htile - have hcell_residue_unique := PeriodicIndegreeGeometry.hcell_residue_unique C T h g hdom hT hlat - htile hweb hcountBridge htiles heuler hreg hcells p x₀ x₁ hverts hedges - (PeriodicIndegreeGeometry.hboundary_card T p hpnd hverts) hDmem + have hcell_residue_unique := PeriodicIndegreeGeometry.hcell_residue_unique C T h g hdom + htile hweb heuler p x₀ x₁ hverts hedges + (PeriodicIndegreeGeometry.hboundary_card T p hpnd hverts) (PeriodicIndegreeGeometry.htranslation_rigid T hcells) hcell_cover have hfund := PeriodicIndegreeGeometry.hfund C T hcell_cover hcell_residue_unique obtain ⟨R, hR, hRcard⟩ := TilingLatticeIndex C diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean index 5281b06928..b996c972bc 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean @@ -43,21 +43,33 @@ private theorem hlat : (by classical exact - ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (h : - PartialOdometer), ∀ (H : ℤ × ℤ → PartialOdometer), (BandPrototile C.1.1 T) → - ((TileOdometer C.1.1 T h) → ((∀ (kl : ℤ × ℤ), - let w := (↑kl.1 : GaussianInt) * BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : - ℕ))) + (↑kl.2 : GaussianInt) * BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : - ℕ))); - let a := (↑kl.1 : GaussianInt) * BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : - ℕ))) + (↑kl.2 : GaussianInt) * BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : - ℕ))); TileOdometer C.1.1 (TileTranslation T w) (H kl) ∧ (∀ (x : GaussianInt), x ∈ (H - kl).domain ↔ x - w ∈ h.domain) ∧ ∀ x ∈ (H kl).domain, (H kl).value x = h.value (x - - w) + a.re * x.re + a.im * x.im) → (((h.domain : Set GaussianInt) = FootprintVertices - T) → ((ExactTileTiling (RegularTileFamily T (TilingLattice C))) → (LatticeTile T))))) - ) := by + ∀ (C : BandCircle), + ∀ (q : Fin (4 : ℕ) → CircleCoordinates), + ∀ (T : ProtoTile), + ∀ (h : PartialOdometer), + ∀ (H : ℤ × ℤ → PartialOdometer), + (∀ (kl : ℤ × ℤ), + let w := + (↑kl.1 : GaussianInt) * + BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + + (↑kl.2 : GaussianInt) * + BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))); + let a := + (↑kl.1 : GaussianInt) * + BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + + (↑kl.2 : GaussianInt) * + BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))); + TileOdometer C.1.1 (TileTranslation T w) (H kl) ∧ + (∀ (x : GaussianInt), x ∈ (H kl).domain ↔ x - w ∈ h.domain) ∧ + ∀ x ∈ (H kl).domain, + (H kl).value x = + h.value (x - w) + a.re * x.re + a.im * x.im) → + (h.domain : Set GaussianInt) = FootprintVertices T → + ExactTileTiling (RegularTileFamily T (TilingLattice C)) → + LatticeTile T + ) := by classical - intro C q T h H hT hodo htrans hdom tiling + intro C q T h H htrans hdom tiling apply tiling.1 T refine ⟨0, (TilingLattice C).zero_mem, ?_⟩ cases T @@ -353,7 +365,7 @@ theorem PositiveCurvatureGeneratorCocycles (C : BandCircle) domain_from_odo _ _ _ hodo have tiling : ExactTileTiling (RegularTileFamily T (TilingLattice C)) := (BandTileTopologyApplication C q hq hqC T (by simpa [hqC] using hT)).1 - have hlat := GeneratorCocycleGeometry.hlat C q T h H hT hodo htrans hdom tiling + have hlat := GeneratorCocycleGeometry.hlat C q T h H htrans hdom tiling have hglobal := GeneratorCocycleGeometry.hglobal C q T h H htrans hcompat domain_from_odo hdom (GeneratorCocycleGeometry.hcoords C q hq hqC) tiling (GeneratorCocycleGeometry.hfamily C q T hq hqC tiling) diff --git a/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean b/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean index 52595def13..693967aa4d 100644 --- a/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean @@ -392,30 +392,7 @@ private theorem hzPAt435 : rw [← hpverts] exact hzV -private theorem hrootAt463 : - (by - classical - exact - ∀ (C₀ : BandCircle), - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), - ProperBandQuadruple q → q (0 : Fin (4 : ℕ)) = C₀.1.1 → 1 < (q 0).1 - ) := by - classical - intro C₀ q hq hqC - have hnon := (ProperBandCurvatureStructure q hq).2.1 - have hunique := (ProperBandCurvatureStructure q hq).2.2 - have hnon0 := hnon 0 - have hnon1 := hnon 1 - have hpq0 := hq.2 (0 : Fin 3) - have hpq1 := hq.2 (1 : Fin 3) - have huniq01 := hunique 0 1 - have hpos : 0 < (q 0).1 := by simpa [hqC] using C₀.property - by_contra hn0 - have hle : (q 0).1 ≤ 1 := by omega - have hz0 : (q (0 : Fin 3).succ).1 = 0 := by omega - have hz1 : (q (1 : Fin 3).succ).1 = 0 := by omega - have bad := huniq01 hz0 hz1 - omega +private abbrev hrootAt463 := ApollonianSuperharmonic.RightCompatibilityGeometry.hrootAt310 private theorem edgeStepAt482 : (by diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean index 2be874ef26..406bc7650d 100644 --- a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEndpointPairUnique.lean @@ -26,32 +26,62 @@ namespace ApollonianSuperharmonic namespace EndpointPairProof private theorem hpne : - ∀ (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (x : GaussianInt), ∀ (y : - GaussianInt), ∀ (p : List GaussianInt), (p.Nodup) → (((2 : ℕ) ≤ p.length) → ((p.head? = - some x) → ((p.getLast? = some y) → ((V = (↑p.toFinset : Set GaussianInt)) → ((∀ (a : - GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), - p = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + - { re := (0 : ℤ), im := (1 : ℤ) } ∨ b = a - { re := (0 : ℤ), im := (1 : ℤ) }) → ((∀ (e : - Finset GaussianInt), e ∈ E ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List - GaussianInt) (l₂ : List GaussianInt), p = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (p ≠ - []))))))) := by + ∀ (V : Set GaussianInt), + ∀ (E : Set (Finset GaussianInt)), + ∀ (x : GaussianInt), + ∀ (y : GaussianInt), + ∀ (p : List GaussianInt), + (2 : ℕ) ≤ p.length → + p.head? = some x → + p.getLast? = some y → + V = (↑p.toFinset : Set GaussianInt) → + (∀ (a : GaussianInt), + ∀ (b : GaussianInt), + ∀ (l₁ : List GaussianInt), + ∀ (l₂ : List GaussianInt), + p = l₁ ++ a :: b :: l₂ → + b = a + (1 : GaussianInt) ∨ + b = a - (1 : GaussianInt) ∨ + b = a + { re := (0 : ℤ), im := (1 : ℤ) } ∨ + b = a - { re := (0 : ℤ), im := (1 : ℤ) }) → + (∀ (e : Finset GaussianInt), + e ∈ E ↔ + ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) + (l₂ : List GaussianInt), + p = l₁ ++ a :: b :: l₂ ∧ e = { a, b }) → + p ≠ [] := by classical - intro V E x y p hp hlen hx hy hV hstep hE he + intro V E x y p hlen hx hy hV hstep hE he subst p simp at hlen private theorem hqne : - ∀ (V : Set GaussianInt), ∀ (E : Set (Finset GaussianInt)), ∀ (x' : GaussianInt), ∀ (y' : - GaussianInt), ∀ (q : List GaussianInt), (q.Nodup) → (((2 : ℕ) ≤ q.length) → ((q.head? = - some x') → ((q.getLast? = some y') → ((V = (↑q.toFinset : Set GaussianInt)) → ((∀ (a : - GaussianInt), ∀ (b : GaussianInt), ∀ (l₁ : List GaussianInt), ∀ (l₂ : List GaussianInt), - q = l₁ ++ a :: b :: l₂ → b = a + (1 : GaussianInt) ∨ b = a - (1 : GaussianInt) ∨ b = a + - { re := (0 : ℤ), im := (1 : ℤ) } ∨ b = a - { re := (0 : ℤ), im := (1 : ℤ) }) → ((∀ (e : - Finset GaussianInt), e ∈ E ↔ ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List - GaussianInt) (l₂ : List GaussianInt), q = l₁ ++ a :: b :: l₂ ∧ e = {a, b}) → (q ≠ - []))))))) := by + ∀ (V : Set GaussianInt), + ∀ (E : Set (Finset GaussianInt)), + ∀ (x' : GaussianInt), + ∀ (y' : GaussianInt), + ∀ (q : List GaussianInt), + (2 : ℕ) ≤ q.length → + q.head? = some x' → + q.getLast? = some y' → + V = (↑q.toFinset : Set GaussianInt) → + (∀ (a : GaussianInt), + ∀ (b : GaussianInt), + ∀ (l₁ : List GaussianInt), + ∀ (l₂ : List GaussianInt), + q = l₁ ++ a :: b :: l₂ → + b = a + (1 : GaussianInt) ∨ + b = a - (1 : GaussianInt) ∨ + b = a + { re := (0 : ℤ), im := (1 : ℤ) } ∨ + b = a - { re := (0 : ℤ), im := (1 : ℤ) }) → + (∀ (e : Finset GaussianInt), + e ∈ E ↔ + ∃ (a : GaussianInt) (b : GaussianInt) (l₁ : List GaussianInt) + (l₂ : List GaussianInt), + q = l₁ ++ a :: b :: l₂ ∧ e = { a, b }) → + q ≠ [] := by classical - intro V E x' y' q hq hqlen hx' hy' hV' hstep' hE' he + intro V E x' y' q hqlen hx' hy' hV' hstep' hE' he subst q simp at hqlen @@ -370,14 +400,7 @@ private theorem hxy : intro x y p hp hlen hx hy endpoint_ne exact endpoint_ne p x y hp hlen hx hy -private theorem hxy' : - ∀ (x' : GaussianInt), ∀ (y' : GaussianInt), ∀ (q : List GaussianInt), (q.Nodup) → (((2 : ℕ) ≤ - q.length) → ((q.head? = some x') → ((q.getLast? = some y') → ((∀ (r : List GaussianInt), - ∀ (u : GaussianInt), ∀ (v : GaussianInt), r.Nodup → 2 ≤ r.length → r.head? = some u → - r.getLast? = some v → u ≠ v) → (x' ≠ y'))))) := by - classical - intro x' y' q hq hqlen hx' hy' endpoint_ne - exact endpoint_ne q x' y' hq hqlen hx' hy' +private abbrev hxy' := ApollonianSuperharmonic.EndpointPairProof.hxy end EndpointPairProof @@ -390,8 +413,8 @@ theorem SimpleGridPathEndpointPairUnique -- BODY rcases h with ⟨p, hp, hlen, hx, hy, hV, hstep, hE⟩ rcases h' with ⟨q, hq, hqlen, hx', hy', hV', hstep', hE'⟩ - have hpne : p ≠ [] := EndpointPairProof.hpne V E x y p hp hlen hx hy hV hstep hE - have hqne : q ≠ [] := EndpointPairProof.hqne V E x' y' q hq hqlen hx' hy' hV' hstep' hE' + have hpne : p ≠ [] := EndpointPairProof.hpne V E x y p hlen hx hy hV hstep hE + have hqne : q ≠ [] := EndpointPairProof.hqne V E x' y' q hqlen hx' hy' hV' hstep' hE' have hpform : ∃ r, p = x :: r := EndpointPairProof.hpform V E x y p hp hlen hx hy hV hstep hE hpne have hqform : ∃ r, q = x' :: r := EndpointPairProof.hqform V E x' y' q hq hqlen hx' hy' hV' hstep' hE' hqne diff --git a/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean index 19648fcfa7..e571b82c63 100644 --- a/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/SubtileLatticeAdjacentPackingSymmetryTransport.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts public import LeanPool.ApollonianSuperharmonic.TileOdometerSlopeNonempty public import LeanPool.ApollonianSuperharmonic.P5625T1CentroidSlopeDifferenceCovariance @@ -127,50 +128,11 @@ private theorem rotation_transport : Fin.val_neg', Fin.sub_def, Fin.add_def] all_goals ext <;> simp [R, I] <;> ring -private theorem support_nonempty : - (by - classical - exact - ∀ (C : CircleCoordinates), - ∀ (U : ProtoTile), - ∀ (h : PartialOdometer), - ∀ (p : ℝ × ℝ), - TileOdometer C U h → PartialOdometerSlope h = some p → U.cells.Nonempty - ) := by - intro C U k p hO hp - exact TileOdometerSlopeNonempty.cells C U k p hO hp +private abbrev support_nonempty := ApollonianSuperharmonic.TileOdometerSlopeNonempty.cells -private theorem hsr₀ : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (T₀ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (p₀ : ℝ × - ℝ), (PartialOdometerSlope h₀ = some p₀) → ((Finset.Nonempty T₀.cells) → - ((Finset.Nonempty T₀.cells → PartialOdometerSlope - (BandPackingSymmetryPartialOdometerAction g h₀) = Option.map - (BandPackingSymmetrySlopeAction g T₀) (PartialOdometerSlope h₀)) → - (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h₀) = some - (BandPackingSymmetrySlopeAction g T₀ p₀)))) ) := by - classical - intro g T₀ h₀ p₀ hp₀ hT₀ne hST₀ - simpa [Option.map] using (hST₀ hT₀ne).trans - (congrArg (Option.map (BandPackingSymmetrySlopeAction g T₀)) hp₀) +private abbrev hsr₀ := ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts.slopeAction -private theorem hsrᵢ : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (Tᵢ : ProtoTile), ∀ (hᵢ : PartialOdometer), ∀ (pᵢ : ℝ × - ℝ), (PartialOdometerSlope hᵢ = some pᵢ) → ((Finset.Nonempty Tᵢ.cells) → - ((Finset.Nonempty Tᵢ.cells → PartialOdometerSlope - (BandPackingSymmetryPartialOdometerAction g hᵢ) = Option.map - (BandPackingSymmetrySlopeAction g Tᵢ) (PartialOdometerSlope hᵢ)) → - (PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g hᵢ) = some - (BandPackingSymmetrySlopeAction g Tᵢ pᵢ)))) ) := by - classical - intro g Tᵢ hᵢ pᵢ hpᵢ hTᵢne hSTᵢ - simpa [Option.map] using (hSTᵢ hTᵢne).trans - (congrArg (Option.map (BandPackingSymmetrySlopeAction g Tᵢ)) hpᵢ) +private abbrev hsrᵢ := ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts.slopeAction private theorem incoming : (by diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean index a5c90c2a33..1b749cb0b4 100644 --- a/LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerCentralSymmetry.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianCoordinateFacts public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurn public import LeanPool.ApollonianSuperharmonic.PartialOdometerHalfTurnFormulas @@ -29,16 +30,7 @@ namespace ApollonianSuperharmonic namespace CentralSymmetryGeometry -private theorem gaussian_equal : - (by - classical - exact - ∀ (u : GaussianInt), ∀ (v : GaussianInt), (u.re = v.re) → ((u.im = v.im) → (u = v)) ) := by - classical - intro u v hre him - rcases u with ⟨u, u'⟩ - rcases v with ⟨v, v'⟩ - simp_all +private abbrev gaussian_equal := ApollonianSuperharmonic.GaussianCoordinateFacts.equal private theorem unit_reflection : (by diff --git a/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean index 81186c4b88..816f245c21 100644 --- a/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean @@ -176,14 +176,7 @@ private theorem turn_up_left (a : GaussianInt) : rw [add_comm] exact turn_up a -private theorem turn_one_up (a : GaussianInt) : - GaussianQuarterTurn (a + 1 + ⟨0, 1⟩) = - GaussianQuarterTurn a - 1 + ⟨0, 1⟩ := by - classical - have turn_up_right (a : GaussianInt) : - GaussianQuarterTurn (a + 1 + ⟨0, 1⟩) = - GaussianQuarterTurn a - 1 + ⟨0, 1⟩ := turn_up_right a - exact turn_up_right a +private abbrev turn_one_up := ApollonianSuperharmonic.QuarterTurnFormulas.turn_up_right private theorem turn_one_up_left (a : GaussianInt) : GaussianQuarterTurn (1 + (⟨0, 1⟩ + a)) = diff --git a/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean b/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean index c9f937003c..df3f73dd06 100644 --- a/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean @@ -214,37 +214,71 @@ private theorem adj : (by classical exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), (BandPrototile C.1.1 - base) → (∀ (a : GaussianInt), ∀ (b : GaussianInt), ((0 : ℤ) < a.re * b.im - a.im * - b.re) → ((a ∈ TilingLattice C) → ((b ∈ TilingLattice C) → ((∀ (w : ↥(TilingLattice - C)), ∃! z : ℤ × ℤ, (↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b = (↑w : - GaussianInt)) → ((C.1.1.1 = (1 : ℤ) ∧ (orientation = true ∧ a = (1 : GaussianInt) ∧ b - = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ orientation = false ∧ a = (⟨(0 : ℤ), (1 : ℤ)⟩ - : GaussianInt) ∧ b = (-1 : GaussianInt)) ∨ (1 : ℤ) < C.1.1.1 ∧ ∃ (q : Fin (4 : ℕ) → - CircleCoordinates), ProperBandQuadruple q ∧ q (0 : Fin (4 : ℕ)) = C.1.1 ∧ (a = - BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) ∧ b = BandVectors.1 (q (2 : - Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) ∨ a = BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : - Fin (4 : ℕ))) ∧ b = BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))))) → ( - let index := fun z : Int × Int => (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b - let tileAt := fun z : Int × Int => TileTranslation base (index z) - let adjacent := fun T U : ProtoTile => - if C.1.1.1 = 1 then - ∃ v : GaussianInt, UnitTriangularStep orientation v ∧ - TileCentroid U - TileCentroid T = GaussianRealPoint v - else TileTouching T U - (∀ (z : Int × Int), index z ∈ TilingLattice C) → ((Function.Injective index) → - ((Function.Injective tileAt) → ((∀ (U : ProtoTile), U ∈ RegularTileFamily base - (TilingLattice C) ↔ ∃! z : Int × Int, U = tileAt z) → ((∀ (z : Int × Int), tileAt z ∈ - RegularTileFamily base (TilingLattice C)) → ((Function.Injective GaussianRealPoint) → - ((∀ (z : Int × Int), TileCentroid (tileAt z) = ((TileCentroid base).1 + ((index z).re - : Int), (TileCentroid base).2 + ((index z).im : Int))) → ((∀ (x : Int × Int), ∀ (y : - Int × Int), index (y - x) = index y - index x) → ((∀ (x : Int × Int), ∀ (y : Int × - Int), TileCentroid (tileAt y) - TileCentroid (tileAt x) = GaussianRealPoint (index (y - - x))) → (∀ (x : Int × Int), ∀ (y : Int × Int), adjacent (tileAt x) (tileAt y) ↔ - TriangularLatticeAdjacent x y))))))))))))))) ) := by + ∀ (C : BandCircle), + ∀ (orientation : Bool), + ∀ (base : ProtoTile), + BandPrototile C.1.1 base → + ∀ (a : GaussianInt), + ∀ (b : GaussianInt), + (0 : ℤ) < a.re * b.im - a.im * b.re → + (∀ (w : ↥(TilingLattice C)), + ∃! z : ℤ × ℤ, + (↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * b = + (↑w : GaussianInt)) → + (C.1.1.1 = (1 : ℤ) ∧ + (orientation = true ∧ + a = (1 : GaussianInt) ∧ + b = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∨ + orientation = false ∧ + a = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∧ + b = (-1 : GaussianInt)) ∨ + (1 : ℤ) < C.1.1.1 ∧ + ∃ (q : Fin (4 : ℕ) → CircleCoordinates), + ProperBandQuadruple q ∧ + q (0 : Fin (4 : ℕ)) = C.1.1 ∧ + (a = + BandVectors.1 (q (1 : Fin (4 : ℕ))) + (q (0 : Fin (4 : ℕ))) ∧ + b = + BandVectors.1 (q (2 : Fin (4 : ℕ))) + (q (0 : Fin (4 : ℕ))) ∨ + a = + BandVectors.1 (q (2 : Fin (4 : ℕ))) + (q (0 : Fin (4 : ℕ))) ∧ + b = + BandVectors.1 (q (1 : Fin (4 : ℕ))) + (q (0 : Fin (4 : ℕ))))) → + let index := fun z : Int × Int => + (z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b; + let tileAt := fun z : Int × Int => + TileTranslation base (index z); + let adjacent := fun T U : ProtoTile => + if C.1.1.1 = 1 then + ∃ v : GaussianInt, + UnitTriangularStep orientation v ∧ + TileCentroid U - TileCentroid T = GaussianRealPoint v + else TileTouching T U; + Function.Injective index → + (∀ (U : ProtoTile), + U ∈ RegularTileFamily base (TilingLattice C) ↔ + ∃! z : Int × Int, U = tileAt z) → + (∀ (z : Int × Int), + tileAt z ∈ RegularTileFamily base (TilingLattice C)) → + Function.Injective GaussianRealPoint → + (∀ (x : Int × Int), + ∀ (y : Int × Int), index (y - x) = index y - index x) → + (∀ (x : Int × Int), + ∀ (y : Int × Int), + TileCentroid (tileAt y) - TileCentroid (tileAt x) = + GaussianRealPoint (index (y - x))) → + ∀ (x : Int × Int), + ∀ (y : Int × Int), + adjacent (tileAt x) (tileAt y) ↔ + TriangularLatticeAdjacent x y + ) := by classical - intro C orientation base hbase a b hdet ha hb hcoord hsource index tileAt adjacent index_mem - index_inj tile_inj family tile_mem point_inj centroid index_sub difference x y + intro C orientation base hbase a b hdet hcoord hsource index tileAt adjacent index_inj family + tile_mem point_inj index_sub difference x y rw [show adjacent (tileAt x) (tileAt y) = (if C.1.1.1 = 1 then ∃ v : GaussianInt, UnitTriangularStep orientation v ∧ TileCentroid (tileAt y) - TileCentroid (tileAt x) = GaussianRealPoint v @@ -794,8 +828,7 @@ theorem TileStringCoordinateTransport (C : BandCircle) (orientation : Bool) StringCoordinateGeometry.difference base a b centroid index_sub x y have adj (x y : Int × Int) : adjacent (tileAt x) (tileAt y) ↔ TriangularLatticeAdjacent x y := StringCoordinateGeometry.adj C orientation base hbase a b - hdet ha hb hcoord hsource index_mem index_inj tile_inj family tile_mem point_inj - centroid index_sub difference x y + hdet hcoord hsource index_inj family tile_mem point_inj index_sub difference x y have height (x y z : Int × Int) : ((TileCentroid (tileAt z)).2 - (TileCentroid (tileAt x)).2) * ((TileCentroid (tileAt y)).1 - (TileCentroid (tileAt x)).1) - diff --git a/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean b/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean index a41b8ce036..2f35b27469 100644 --- a/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean +++ b/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.P3776T1CellCenterMembership public import LeanPool.ApollonianSuperharmonic.BandLayoutCentroidCoordinates public import LeanPool.ApollonianSuperharmonic.TileHalfTurnGeometry @@ -211,37 +212,6 @@ private theorem harea : private abbrev ht := BandLayoutCentroidCoordinates.doubledCenter -private theorem hcenter : - (by - classical - exact - ∀ (U : ProtoTile), - ∀ (z : GaussianInt), - z ∈ U.cells ↔ - ((z.re : Real) + 1 / 2, (z.im : Real) + 1 / 2) ∈ TileRealization U - ) := by - classical - intro U z - constructor - · intro hz - simp only [TileRealization, Set.mem_iUnion] - refine ⟨z, hz, ?_⟩ - norm_num [ClosedSquareRealization, Set.mem_Icc] - · intro hp - simp only [TileRealization, Set.mem_iUnion] at hp - obtain ⟨b, hb, hbox⟩ := hp - simp only [ClosedSquareRealization, Set.mem_Icc] at hbox - have hr₁ : b.re < z.re + 1 := by - exact_mod_cast (show (b.re : Real) < (z.re : Real) + 1 by linarith [hbox.1.1]) - have hr₂ : z.re < b.re + 1 := by - exact_mod_cast (show (z.re : Real) < (b.re : Real) + 1 by linarith [hbox.2.1]) - have hi₁ : b.im < z.im + 1 := by - exact_mod_cast (show (b.im : Real) < (z.im : Real) + 1 by linarith [hbox.1.2]) - have hi₂ : z.im < b.im + 1 := by - exact_mod_cast (show (z.im : Real) < (b.im : Real) + 1 by linarith [hbox.2.2]) - have hbz : b = z := by apply Zsqrtd.ext <;> omega - exact hbz ▸ hb - private theorem hreflectCells : (by classical @@ -360,7 +330,9 @@ theorem TileT1DiskArea (q : Fin 4 → CircleCoordinates) have htau := TileHalfTurnGeometry.involutive q u have hHcells := TileHalfTurnGeometry.cells q u have hHreal := TileHalfTurnGeometry.realization q T u ht - have hcenter := DiskAreaGeometry.hcenter + have hcenter (U : ProtoTile) (z : GaussianInt) : + z ∈ U.cells ↔ ((z.re : Real) + 1 / 2, (z.im : Real) + 1 / 2) ∈ TileRealization U := by + simpa [GaussianRealPoint] using (P3776T1CellCenterMembership U z).symm have hreflectCells := DiskAreaGeometry.hreflectCells q T u hHreal hcenter have hHT : (H T).cells = T.cells := hreflectCells T T (BandPrototileCentralSymmetry (q 0) T hT) diff --git a/LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean b/LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean index 6cac264f23..416ac23db8 100644 --- a/LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean +++ b/LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.BandVectorParentSums public import LeanPool.ApollonianSuperharmonic.TilingLatticeIndex @@ -24,34 +25,7 @@ namespace ApollonianSuperharmonic namespace TilingBasisProof -private theorem relation : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), (ProperBandQuadruple q) → (BandVectors.1 (q 1) (q 0) + - BandVectors.1 (q 2) (q 0) + BandVectors.1 (q 3) (q 0) = 0) ) := by - classical - intro q hq - let r : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] - have hr : SemiProperQuadruple r := by - simpa [r] using SemiProperQuadruple.rotate hq.1 - let s : Fin 4 → CircleCoordinates := ![r 0, r 2, r 3, r 1] - have hs : SemiProperQuadruple s := by - simpa [s] using SemiProperQuadruple.rotate hr - have first := VectorRecursionLaws q hq.1 - have second := VectorRecursionLaws r hr - have third := VectorRecursionLaws s hs - have e0 := first.2.2.1 - have e1 := second.2.2.1 - have e2 := third.2.2.1 - simp only [Fin.isValue, Matrix.cons_val_one, Matrix.cons_val_zero, Int.reduceNeg, - Matrix.cons_val, r, s] at e1 e2 - rw [e0, e1, e2] - calc - _ = (1 - (⟨0, 1⟩ : GaussianInt)) * - (BandVectors.1 (q 3) (q 2) + BandVectors.1 (q 1) (q 3) + - BandVectors.1 (q 2) (q 1)) := by ring - _ = 0 := by rw [first.1]; simp +private abbrev relation := ApollonianSuperharmonic.BandVectorIncomingSum private theorem flipA : (by From e96e708f9fb61bad8eab2e9df07f2db0622d7dc4 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 13 Nov 2026 09:25:12 +0000 Subject: [PATCH 15/23] Share Ford geometry facts and isolate vector negation dependencies --- .../BandPackingSymmetryT3T5Covariance.lean | 3 +- .../BandPackingSymmetryVectorAction.lean | 17 ++++ .../FordOpposingBoundaryStarLocalization.lean | 25 +---- .../FordTileCellMembership.lean | 19 ++++ .../LatticeAdjacentPackingSymmetryFacts.lean | 22 +---- .../P4062T1CanonicalSupport.lean | 66 +------------ .../P4120T1FordGeometry.lean | 33 +------ .../P4158T1EdgeSectorSelection.lean | 22 +---- .../P4158T1LargeFirstRestrictions.lean | 93 +------------------ .../P4158T1MatchedFordPair.lean | 31 +------ 10 files changed, 52 insertions(+), 279 deletions(-) diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean index 3b85c9e2dc..656b84347a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean @@ -8,7 +8,6 @@ module public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnTranslation public import LeanPool.ApollonianSuperharmonic.GaussianQuarterTurnProperties -public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts public import LeanPool.ApollonianSuperharmonic.BandPackingSymmetryLinearIdentities public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties @@ -566,7 +565,7 @@ private theorem rminus : cases hh : BandPackingSymmetryReversesOrientation h <;> simp [GaussianRealPoint, GaussianQuarterTurn, sub_eq_add_neg] -private abbrev lneg := ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts.vectorNegation +private abbrev lneg := ApollonianSuperharmonic.BandPackingSymmetryVectorAction.negation private theorem tile_surj : (by diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean index e0f922196d..d074d4bfc9 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean @@ -45,6 +45,23 @@ def BandPackingSymmetryVectorAction : BandPackingSymmetryVectorAction g (BandPackingSymmetryVectorAction h v) +namespace BandPackingSymmetryVectorAction + +/-- The canonical Gaussian vector action commutes with negation. -/ +theorem negation (a : BandPackingSymmetry) (v : GaussianInt) : + BandPackingSymmetryVectorAction a (-v) = -BandPackingSymmetryVectorAction a v := by + induction a generalizing v with + | identity => rfl + | negate => rcases v with ⟨x, y⟩; rfl + | conjugate => rcases v with ⟨x, y⟩; rfl + | shift w => rfl + | comp a b iha ihb => + change BandPackingSymmetryVectorAction a (BandPackingSymmetryVectorAction b (-v)) = + -BandPackingSymmetryVectorAction a (BandPackingSymmetryVectorAction b v) + rw [ihb, iha] + +end BandPackingSymmetryVectorAction + end ApollonianSuperharmonic end diff --git a/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean index ad22ff9445..93f2677251 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOpposingBoundaryStarLocalization.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordTileCellMembership public import LeanPool.ApollonianSuperharmonic.P4158T1MatchedFordPair public import LeanPool.ApollonianSuperharmonic.P4158T1LargeFirstRestrictions @@ -57,30 +58,8 @@ private theorem squareCell : 0 ≤ (z - v).re ∧ (z - v).re < (n : Int) ∧ 0 ≤ (z - v).im ∧ (z - v).im < (n : Int) ) := by - classical intro n v z - change z ∈ (FordCellDomain n).image (GaussianTranslation v) ↔ _ - constructor - · rintro hz - obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz - obtain ⟨a, ha, rfl⟩ := Finset.mem_image.mp hw - have hrange := Finset.mem_product.mp ha - have hm := Finset.mem_range.mp hrange.1 - have hn := Finset.mem_range.mp hrange.2 - simp only [GaussianTranslation, add_sub_cancel_right] - change 0 ≤ (a.1 : Int) ∧ (a.1 : Int) < n ∧ - 0 ≤ (a.2 : Int) ∧ (a.2 : Int) < n - exact ⟨by omega, by omega, by omega, by omega⟩ - · rintro ⟨h0r, hnr, h0i, hni⟩ - apply Finset.mem_image.mpr - refine ⟨z - v, ?_, by simp [GaussianTranslation]⟩ - apply Finset.mem_image.mpr - refine ⟨((z - v).re.toNat, (z - v).im.toNat), ?_, ?_⟩ - · apply Finset.mem_product.mpr - constructor <;> apply Finset.mem_range.mpr <;> omega - · apply Zsqrtd.ext - · exact Int.toNat_of_nonneg h0r - · exact Int.toNat_of_nonneg h0i + exact FordTileCellMembership.translated n v z private theorem smaller : (by diff --git a/LeanPool/ApollonianSuperharmonic/FordTileCellMembership.lean b/LeanPool/ApollonianSuperharmonic/FordTileCellMembership.lean index a3d089b137..2f74c95266 100644 --- a/LeanPool/ApollonianSuperharmonic/FordTileCellMembership.lean +++ b/LeanPool/ApollonianSuperharmonic/FordTileCellMembership.lean @@ -7,6 +7,7 @@ module public import LeanPool.ApollonianSuperharmonic.FordTile public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileTranslation /-! # Ford tile cell membership @@ -37,6 +38,24 @@ theorem FordTileCellMembership (m : Nat) (z : GaussianInt) : Finset.mem_range.mpr (by omega)⟩, by ext <;> dsimp <;> omega⟩ +namespace FordTileCellMembership + +/-- Translating a Ford square translates its coordinate bounds. -/ +theorem translated (n : Nat) (v z : GaussianInt) : + z ∈ (TileTranslation (FordTile n) v).cells ↔ + 0 ≤ (z - v).re ∧ (z - v).re < n ∧ 0 ≤ (z - v).im ∧ (z - v).im < n := by + classical + rw [← FordTileCellMembership n (z - v)] + change z ∈ (FordTile n).cells.image (GaussianTranslation v) ↔ _ + constructor + · intro hz + obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hw + · intro hz + exact Finset.mem_image.mpr ⟨z - v, hz, by simp [GaussianTranslation]⟩ + +end FordTileCellMembership + end ApollonianSuperharmonic end diff --git a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentPackingSymmetryFacts.lean b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentPackingSymmetryFacts.lean index 082aa4d29b..19f57baeec 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentPackingSymmetryFacts.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentPackingSymmetryFacts.lean @@ -96,26 +96,8 @@ theorem vectorNegation : exact ∀ (a : BandPackingSymmetry), ∀ (v : GaussianInt), BandPackingSymmetryVectorAction a (-v) = -BandPackingSymmetryVectorAction a v ) := by - classical - intro a - induction a with - | identity => intro v; rfl - | negate => - intro v - rcases v with ⟨a, b⟩ - rfl - | conjugate => - intro v - rcases v with ⟨a, b⟩ - rfl - | shift w => intro v; rfl - | comp a b iha ihb => - intro v - change BandPackingSymmetryVectorAction a - (BandPackingSymmetryVectorAction b (-v)) = - -BandPackingSymmetryVectorAction a - (BandPackingSymmetryVectorAction b v) - rw [ihb, iha] + intro a v + exact BandPackingSymmetryVectorAction.negation a v /-- The affine vector action commutes with simultaneous negation. -/ theorem affineNegation : diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean b/LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean index 5347a30ea3..336ccf6faf 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1CanonicalSupport.lean @@ -28,41 +28,6 @@ namespace ApollonianSuperharmonic namespace CanonicalSupport -private theorem hcellCoord (q : Nat) (z : GaussianInt) : - z ∈ FordCellDomain q ↔ - 0 ≤ z.re ∧ z.re < (q : Int) ∧ - 0 ≤ z.im ∧ z.im < (q : Int) := by - classical - constructor - · intro hz - change z ∈ ((Finset.range q).product (Finset.range q)).image - (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) at hz - rcases Finset.mem_image.mp hz with ⟨a, ha, heq⟩ - have hab := Finset.mem_product.mp ha - rcases a with ⟨m, n⟩ - have hm := Finset.mem_range.mp hab.1 - have hn := Finset.mem_range.mp hab.2 - have hre : z.re = (m : Int) := by - have hh := congrArg (fun w : GaussianInt => w.re) heq - simpa using hh.symm - have him : z.im = (n : Int) := by - have hh := congrArg (fun w : GaussianInt => w.im) heq - simpa using hh.symm - simp [hre, him, hm, hn] - · rintro ⟨hzr, hzr', hzi, hzi'⟩ - let m := z.re.toNat - let n := z.im.toNat - have hmcast : (m : Int) = z.re := Int.toNat_of_nonneg hzr - have hncast : (n : Int) = z.im := Int.toNat_of_nonneg hzi - have hm : m < q := by - exact_mod_cast (show (m : Int) < q by omega) - have hn : n < q := by - exact_mod_cast (show (n : Int) < q by omega) - apply Finset.mem_image.mpr - refine ⟨(m, n), Finset.mem_product.mpr - ⟨Finset.mem_range.mpr hm, Finset.mem_range.mpr hn⟩, ?_⟩ - apply Zsqrtd.ext <;> simp [hmcast, hncast] - private theorem hfootSquare (q : Nat) (hqpos : 0 < q) : FootprintVertices (FordTile q) = FordVertexDomain q := by classical @@ -311,36 +276,7 @@ theorem P4062T1CanonicalSupport (q : Nat) (hqpos : 0 < q) : {x | 0 ≤ x.re ∧ x.re ≤ (q : Int) ∧ 0 ≤ x.im ∧ x.im ≤ (q : Int) ∧ (x.re = 0 ∨ x.re = (q : Int) ∨ x.im = 0 ∨ x.im = (q : Int))} := by --- BODY - classical - have hcellCoord (z : GaussianInt) : - z ∈ FordCellDomain q ↔ - 0 ≤ z.re ∧ z.re < (q : Int) ∧ - 0 ≤ z.im ∧ z.im < (q : Int) := CanonicalSupport.hcellCoord q z - have hfootSquare : - FootprintVertices (FordTile q) = FordVertexDomain q := CanonicalSupport.hfootSquare q hqpos - have hFcells : (FordTile q).cells.Nonempty := CanonicalSupport.hFcells q hqpos - have hcellTiles (z : GaussianInt) : - z ∈ (FordTile q).cells ↔ - 0 ≤ z.re ∧ z.re < (q : Int) ∧ - 0 ≤ z.im ∧ z.im < (q : Int) := CanonicalSupport.hcellTiles q z - have hhoriz (z : GaussianInt) : - ((z ∈ (FordTile q).cells ∧ z - ⟨0, 1⟩ ∉ (FordTile q).cells) ∨ - (z ∉ (FordTile q).cells ∧ z - ⟨0, 1⟩ ∈ (FordTile q).cells)) ↔ - 0 ≤ z.re ∧ z.re < (q : Int) ∧ - (z.im = 0 ∨ z.im = q) := CanonicalSupport.hhoriz q z - have hvert (z : GaussianInt) : - ((z ∈ (FordTile q).cells ∧ z - 1 ∉ (FordTile q).cells) ∨ - (z ∉ (FordTile q).cells ∧ z - 1 ∈ (FordTile q).cells)) ↔ - 0 ≤ z.im ∧ z.im < (q : Int) ∧ - (z.re = 0 ∨ z.re = q) := CanonicalSupport.hvert q z - have hboundarySquare : - BoundaryFootprintVertices (FordTile q) = - {x | 0 ≤ x.re ∧ x.re ≤ (q : Int) ∧ - 0 ≤ x.im ∧ x.im ≤ (q : Int) ∧ - (x.re = 0 ∨ x.re = (q : Int) ∨ - x.im = 0 ∨ x.im = (q : Int))} := CanonicalSupport.hboundarySquare q hqpos - exact ⟨hfootSquare, hboundarySquare⟩ + exact ⟨CanonicalSupport.hfootSquare q hqpos, CanonicalSupport.hboundarySquare q hqpos⟩ end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean index dd06e00363..421a56dce1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordTileCellMembership public import LeanPool.ApollonianSuperharmonic.InteriorFootprintIncidence public import LeanPool.ApollonianSuperharmonic.FordTileRecursiveIdentification @@ -59,38 +60,8 @@ private theorem squareCell : exact ∀ (P : FordFareyParameter), ∀ (z : GaussianInt), z ∈ (FordTile P.q).cells ↔ (0 : ℤ) ≤ z.re ∧ z.re < (↑P.q : ℤ) ∧ (0 : ℤ) ≤ z.im ∧ z.im < (↑P.q : ℤ) ) := by - classical intro P z - change z ∈ FordCellDomain P.q ↔ _ - change z ∈ ((Finset.range P.q).product (Finset.range P.q)).image - (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) ↔ _ - rw [Finset.mem_image] - constructor - · rintro ⟨⟨a, b⟩, hab, hz⟩ - have hab := Finset.mem_product.mp hab - have ha := Finset.mem_range.mp hab.1 - have hb := Finset.mem_range.mp hab.2 - have hre : z.re = (a : Int) := by - have hh := congrArg (fun w : GaussianInt => w.re) hz - simpa using hh.symm - have him : z.im = (b : Int) := by - have hh := congrArg (fun w : GaussianInt => w.im) hz - simpa using hh.symm - rw [hre, him] - exact ⟨by exact_mod_cast (Nat.zero_le a), - by exact_mod_cast ha, - by exact_mod_cast (Nat.zero_le b), - by exact_mod_cast hb⟩ - · rintro ⟨hr, hrq, hi, hiq⟩ - let a := z.re.toNat - let b := z.im.toNat - have ha : (a : Int) = z.re := Int.toNat_of_nonneg hr - have hb : (b : Int) = z.im := Int.toNat_of_nonneg hi - have haq : a < P.q := by exact_mod_cast (show (a : Int) < P.q by omega) - have hbq : b < P.q := by exact_mod_cast (show (b : Int) < P.q by omega) - refine ⟨(a, b), Finset.mem_product.mpr - ⟨Finset.mem_range.mpr haq, Finset.mem_range.mpr hbq⟩, ?_⟩ - apply Zsqrtd.ext <;> simp [ha, hb] + exact FordTileCellMembership P.q z private theorem hbounds : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean index 1d3241cba8..f218453114 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordTileCellMembership public import LeanPool.ApollonianSuperharmonic.AncestorOdometer public import LeanPool.ApollonianSuperharmonic.FordFareyParameter @@ -195,27 +196,8 @@ private theorem translated_ford_bounds : c ∈ (TileTranslation (FordTile n) w).cells → 0 ≤ (c - w).re ∧ (c - w).re < n ∧ 0 ≤ (c - w).im ∧ (c - w).im < n ) := by - classical intro n w c hc - change c ∈ (FordCellDomain n).image (GaussianTranslation w) at hc - obtain ⟨t, ht, htc⟩ := Finset.mem_image.mp hc - change t ∈ FordCellDomain n at ht - change t + w = c at htc - simp only [FordCellDomain, Finset.mem_image] at ht - obtain ⟨a, ha, hat⟩ := ht - obtain ⟨ha₁, ha₂⟩ := Finset.mem_product.mp ha - simp only [Finset.mem_range] at ha₁ ha₂ - have ht_eq : (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt) = t := hat - have hcw : c - w = t := by rw [← htc]; abel - have hr : (c-w).re = (a.1 : Int) := by rw [hcw, ← ht_eq] - have hi : (c-w).im = (a.2 : Int) := by rw [hcw, ← ht_eq] - constructor - · rw [hr]; omega - constructor - · rw [hr]; exact_mod_cast ha₁ - constructor - · rw [hi]; omega - · rw [hi]; exact_mod_cast ha₂ + exact (FordTileCellMembership.translated n w c).mp hc private theorem translated_ford_cell : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean index 80f3987ab0..41d844ccfe 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean @@ -6,6 +6,8 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.P4210T1FordSquareCentroid +public import LeanPool.ApollonianSuperharmonic.FordTileCellMembership public import LeanPool.ApollonianSuperharmonic.FordFareySum public import LeanPool.ApollonianSuperharmonic.AncestorOdometer @@ -371,84 +373,7 @@ private theorem fordCentroid : (0 : ℕ) < n → TileCentroid (FordTile n) = ((↑n : ℝ) / (2 : ℝ), (↑n : ℝ) / (2 : ℝ)) ) := by - classical - intro n hn - let D : Finset GaussianInt := - (Finset.range n).product (Finset.range n) |>.image - (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) - have hne : D.Nonempty := by - refine ⟨⟨0, 0⟩, ?_⟩ - simp [D, hn] - have hinj : Set.InjOn - (fun a : Nat × Nat => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) - ↑((Finset.range n).product (Finset.range n)) := by - intro a ha b hb hab - apply Prod.ext - · have hh := congrArg (fun z : GaussianInt => z.re) hab - change (a.1 : Int) = b.1 at hh - exact_mod_cast hh - · have hh := congrArg (fun z : GaussianInt => z.im) hab - change (a.2 : Int) = b.2 at hh - exact_mod_cast hh - have hcard : D.card = n * n := by - calc - D.card = ((Finset.range n).product (Finset.range n)).card := by - dsimp [D] - exact Finset.card_image_iff.mpr hinj - _ = n * n := by simp - have hsumR : D.sum (fun z : GaussianInt => z.re) = - (n : Int) * ((n - 1 : Nat) : Int) / 2 * (n : Int) := by - have hrange : (Finset.range n).sum (fun a => (a : Int)) = - (n : Int) * ((n - 1 : Nat) : Int) / 2 := by - rw [← Nat.cast_sum] - simp [Finset.sum_range_id] - simp only [Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, Finset.coe_range, - Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, implies_true, - Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, Finset.sum_const, - Finset.card_range, Int.nsmul_eq_mul, D] - conv_lhs => rw [← Finset.mul_sum (Finset.range n) - (fun a => (a : Int)) (n : Int)] - rw [hrange] - ring - have hsumI : D.sum (fun z : GaussianInt => z.im) = - (n : Int) * ((n - 1 : Nat) : Int) / 2 * (n : Int) := by - have hrange : (Finset.range n).sum (fun a => (a : Int)) = - (n : Int) * ((n - 1 : Nat) : Int) / 2 := by - rw [← Nat.cast_sum] - simp [Finset.sum_range_id] - simp only [Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, Finset.coe_range, - Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, implies_true, - Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, Finset.sum_const, - Finset.card_range, Int.nsmul_eq_mul, D] - rw [hrange] - ring - change (if D.Nonempty then - (((D.sum (fun z : GaussianInt => z.re) : Int) : Real) / D.card + 1 / 2, - ((D.sum (fun z : GaussianInt => z.im) : Int) : Real) / D.card + 1 / 2) - else _) = _ - rw [ite_eq_left hne, hcard, hsumR, hsumI] - have hncast : ((n - 1 : Nat) : Int) = (n : Int) - 1 := by omega - rw [hncast] - norm_num - field_simp - have rangeSum : (Finset.range n).sum (fun a => (a : Int)) = - (n : Int) * ((n - 1 : Nat) : Int) / 2 := by - rw [← Nat.cast_sum] - simp [Finset.sum_range_id] - have arithmeticCast : - ((Finset.range n).sum (fun a => (a : Int))) * 2 = - (n : Int) * ((n - 1 : Nat) : Int) := by - rw [← Nat.cast_sum] - exact_mod_cast Finset.sum_range_id_mul_two n - rw [rangeSum] at arithmeticCast - rw [hncast] at arithmeticCast - have hreal : - ((((n : Int) * ((n : Int) - 1) / 2 : Int) : Real) * 2) = - (((n : Int) * ((n : Int) - 1) : Int) : Real) := by - exact_mod_cast arithmeticCast - rw [hreal] - push_cast - ring + exact P4210T1FordSquareCentroid private theorem rootNonempty : (by @@ -456,18 +381,8 @@ private theorem rootNonempty : exact ∀ (n : ℕ), (0 : ℕ) < n → ∀ (z : GaussianInt), Finset.Nonempty (TileTranslation (FordTile n) z).cells ) := by - classical intro n hn z - refine ⟨z, ?_⟩ - rw [(TileTranslationFormulas (FordTile n) z).1] - apply Finset.mem_image.mpr - refine ⟨0, ?_, ?_⟩ - · change (0 : GaussianInt) ∈ FordCellDomain n - unfold FordCellDomain - apply Finset.mem_image.mpr - refine ⟨(0, 0), Finset.mem_product.mpr ⟨by simp [hn], by simp [hn]⟩, ?_⟩ - ext <;> simp - · simp [GaussianTranslation] + exact ⟨z, (FordTileCellMembership.translated n z z).mpr (by simpa using And.intro hn hn)⟩ private theorem hrootCent : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean index f1877e0b96..b8ef421217 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.FordTileCellMembership public import LeanPool.ApollonianSuperharmonic.FordTileOdometerRestriction public import LeanPool.ApollonianSuperharmonic.TileOdometerTranslationUniqueness @@ -396,36 +397,8 @@ private theorem squareCell : z ∈ (FordTile P.q).cells ↔ 0 ≤ z.re ∧ z.re < (P.q : Int) ∧ 0 ≤ z.im ∧ z.im < (P.q : Int) ) := by - classical intro P z - change z ∈ FordCellDomain P.q ↔ _ - change z ∈ ((Finset.range P.q).product (Finset.range P.q)).image - (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) ↔ _ - rw [Finset.mem_image] - constructor - · rintro ⟨⟨a,b⟩, hab, hz⟩ - have hab := Finset.mem_product.mp hab - have ha := Finset.mem_range.mp hab.1 - have hb := Finset.mem_range.mp hab.2 - have hre : z.re = (a : Int) := by - have hh := congrArg (fun w : GaussianInt => w.re) hz - simpa using hh.symm - have him : z.im = (b : Int) := by - have hh := congrArg (fun w : GaussianInt => w.im) hz - simpa using hh.symm - rw [hre, him] - exact ⟨by exact_mod_cast Nat.zero_le a, by exact_mod_cast ha, - by exact_mod_cast Nat.zero_le b, by exact_mod_cast hb⟩ - · rintro ⟨hr, hrq, hi, hiq⟩ - let a := z.re.toNat - let b := z.im.toNat - have ha : (a : Int) = z.re := Int.toNat_of_nonneg hr - have hb : (b : Int) = z.im := Int.toNat_of_nonneg hi - have haq : a < P.q := by exact_mod_cast (show (a : Int) < P.q by omega) - have hbq : b < P.q := by exact_mod_cast (show (b : Int) < P.q by omega) - refine ⟨(a,b), Finset.mem_product.mpr - ⟨Finset.mem_range.mpr haq, Finset.mem_range.mpr hbq⟩, ?_⟩ - apply Zsqrtd.ext <;> simp [ha, hb] + exact FordTileCellMembership P.q z private theorem translatedCell : (by From 991527a1c92d90362d2552184d9068bafeaed567 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 13 Nov 2026 10:56:19 +0000 Subject: [PATCH 16/23] Remove unused proof scaffolding and narrow geometry helpers --- .../AffineTriangularPlaneTriangulation.lean | 2 - .../AffineTriangularStrip.lean | 1 - .../AncestorOdometerRestriction.lean | 24 - .../BandCircleEnclosureDichotomy.lean | 3 - .../BandDescartesGapSubdivision.lean | 6 - .../BandDoubleDecomposition.lean | 1 - ...BandExceptionalRestorationSectorOrder.lean | 24 - .../BandModifiedCellPartition.lean | 15 - .../BandOdometerMaximality.lean | 1 - .../BandOrderedGeneralChildInterfaces.lean | 3 - ...deredGeneralLargestParentOdometerRows.lean | 38 - .../BandOrderedGeneralLayout.lean | 2 - ...dOrderedGeneralOuterMixedOdometerRows.lean | 9 - ...BandOrderedGeneralPositiveCutGeometry.lean | 10 - ...OrderedGeneralPositiveCutOdometerRows.lean | 15 - ...eneralRightInterfaceCertificateExists.lean | 72 -- ...dGeneralRightRoutingCertificateExists.lean | 12 - ...rderedGeneralRightSelectedRowGeometry.lean | 84 -- ...andOrderedGeneralSubtileCanonicalRows.lean | 5 - ...eredGeneralSubtileCanonicalSeparation.lean | 11 - ...eralSubtileInterfaceCertificateExists.lean | 223 +---- ...SubtileNormalizationCertificateExists.lean | 77 +- .../BandOriginalPairSeparation.lean | 13 - ...ndPackingSymmetryMarkedDataCovariance.lean | 23 - .../BandPackingSymmetryT3T5Covariance.lean | 2 - ...PackingSymmetryTileOdometerCovariance.lean | 21 - .../BandPackingSymmetryTilingTransport.lean | 3 - .../BandPeriodicSuperharmonicity.lean | 1 - ...ndPositiveCutBranchCompanionExclusion.lean | 2 - .../BandPrototileCentroidUnique.lean | 3 - .../BandPrototileExists.lean | 3 - .../BandPrototileReindexedDecomposition.lean | 3 - .../BandPrototileTranslationNormalForm.lean | 4 - .../BandRegularTranslatePeriodicComplex.lean | 129 +-- .../BandRetainedBoundaryGenealogy.lean | 23 - .../BandSuccessorClassification.lean | 1 - .../BandTileAcyclicIndegree.lean | 4 - .../BandTileTopologyApplication.lean | 12 - .../BoundaryJoinChamberCertificate.lean | 1 - .../BoundaryStringConcatenation.lean | 2 - .../CircleMatrixEnclosureCriterion.lean | 4 - .../ConnectedGridEdgeCarrierGraph.lean | 39 - .../CurvatureOnePeriodicOdometer.lean | 10 - .../DiamondBaseT2.lean | 30 - .../DiamondCoordinateConfiguration.lean | 8 - .../DiamondExceptionalMaximality.lean | 13 - ...amondOpposingBoundaryStarLocalization.lean | 3 - ...isjointBoundaryCommonEdgeGraphAcyclic.lean | 58 -- .../DisjointSquareUnionCommonEdgeCarrier.lean | 7 - .../FiniteAcyclicOrientationObstruction.lean | 4 - .../FiniteBiconnectedHorizontalRunTree.lean | 12 - ...niteConnectedAcyclicDegreeTwoGridPath.lean | 3 - .../FordCoordinateConfiguration.lean | 21 - .../FordLaplacianTable.lean | 2 - .../FordLeftBoundaryCompatibility.lean | 6 - .../FordOrientedChildParentEndpoints.lean | 10 - .../GridHorizontalLogLiftDelta.lean | 2 - .../GridRayCrossingIndexAdjacentCell.lean | 27 +- .../GridVerticalDownLogLiftDelta.lean | 1 - .../GridVerticalUpLogLiftDelta.lean | 2 - .../IntegerSuperharmonicClosedness.lean | 3 - .../IntegralityLatticeIndex.lean | 13 - .../LatticeAdjacentInterfacePath.lean | 149 +--- ...LatticeDiskUnionIntersectionConnected.lean | 1 - .../LatticeTileBoundarySimpleGridCycle.lean | 9 - .../LatticeTileComplementGridConnected.lean | 6 - .../LatticeTileGridEulerCount.lean | 2 - .../LatticeVertexSectorFacts.lean | 1 - .../LocalLatticeInterfaceSectors.lean | 4 - .../MarkedOdometerAdjacencyReduction.lean | 42 - ...RespectRegularFamilyCentralCovariance.lean | 3 - .../OpposingBoundaryOdometerStrings.lean | 23 - .../OpposingStringInterfacePath.lean | 12 - ...siteRoutedCommonEdgeOutsideCellUnique.lean | 1 - .../OrientedTouchingCovariance.lean | 3 - ...eredGeneralMixedAggregateJunctionData.lean | 91 -- ...dGeneralMixedAggregatePairedEndpoints.lean | 6 - .../P3092T1CenteredRectangleDisk.lean | 59 -- .../P3092T1DiamondCenteredRectangles.lean | 1 - .../P3475T1GridBoundary.lean | 72 -- .../P3475T1PolygonalSeparation.lean | 3 - .../P3475T1SquareUnionIdentification.lean | 9 - .../P3497T1SingleStraightDeletion.lean | 9 - .../P3511T1LeafOrder.lean | 49 -- .../P3523T1InsertionGeometry.lean | 14 - .../P3523T1InsertionIncidence.lean | 1 - .../P3523T1OrderedInsertion.lean | 35 - .../P3523T1TargetBoundary.lean | 1 - .../P3523T1TwoTriangleSplit.lean | 109 +-- .../P3544T1TriangleRayGeometry.lean | 1 - .../P3555T2ParabolaChordCuts.lean | 2 - .../P3555T2ParabolaHullFrontier.lean | 12 - .../P3555T2ParabolaSupporting.lean | 1 - .../P3555T2SavedDissectionGeometry.lean | 7 - .../P3597T1DirectionParity.lean | 43 - .../P3597T1GenericRayStability.lean | 26 - .../P3597T1SideCrossing.lean | 7 - .../P3597T1VertexSectors.lean | 9 - .../P3650T1CyclicChildrenExists.lean | 221 +---- .../P3650T1EmptyTriangleDiagonal.lean | 16 - .../P3650T1ExposedCornerExists.lean | 67 +- .../P3650T1LocalCoherence.lean | 5 - .../P3650T1MaximalHeightDiagonal.lean | 5 - .../P3650T1OldArcEven.lean | 52 -- .../P3650T1ParitySum.lean | 8 - .../P3650T1TriangleEntry.lean | 1 - .../P3652T1IndexedFaceLedger.lean | 13 - .../P3723T1AllContactDrawingExists.lean | 18 - .../P3723T1ContactPortsExist.lean | 2 - .../P3723T1PairedModelSegmentPullback.lean | 34 - .../P3776T1BoundedDisplacementSurjective.lean | 2 - .../P3776T1DualEdgesExist.lean | 2 - .../P3776T1PlaneMapExists.lean | 3 - .../P3776T1SectorMapsExist.lean | 6 - .../P3776T1StarWeightsExist.lean | 1 - .../P3776T1WalkMapProperties.lean | 9 - .../P3821T1CircleComponentBound.lean | 25 - .../P3821T1ComponentContours.lean | 7 - .../P3821T1ControlledNeighborhood.lean | 169 ---- .../P3821T1LoopIndexLaws.lean | 5 - .../P3821T1ThreeArcCircle.lean | 17 - .../P3861T1FixedFacialDeletion.lean | 4 - .../P3889T1ExactRadialStar.lean | 12 - .../P3889T1FaceGapCoverage.lean | 34 - .../P3889T1TwoRaySectors.lean | 5 - .../P3913T1RoutedFaceSubdivision.lean | 10 - .../P3934T1ArcSideComparison.lean | 821 +----------------- .../P3934T1PolygonalSidePropagation.lean | 5 - .../P3934T1SectorContinuation.lean | 49 -- .../P3963T1ExteriorMixedCycleObstruction.lean | 14 - .../P3963T1MixedBoundaryCycle.lean | 9 - .../P3996T1PlacementCompanionBlocks.lean | 15 - .../P3996T1SRowAlignment.lean | 14 - ...4055T1OrderedGeneralOppositeEndpoints.lean | 7 - .../P4055T1PlacementNormalization.lean | 28 - .../P4062T1InteriorGeometry.lean | 11 - .../P4062T1LiteralReduction.lean | 1 - .../P4062T1OverlapDescent.lean | 25 - .../P4062T1ParentalRestriction.lean | 4 - .../P4112T1BoundaryMultiplicity.lean | 2 - .../P4112T1LowerNeighbors.lean | 8 - .../P4112T1ParentalNeighbors.lean | 26 - .../P4112T1PathGeometry.lean | 14 - .../P4120T1FordGeometry.lean | 28 - .../P4120T1GeneralDescent.lean | 16 - .../P4120T1RootNormalization.lean | 4 - .../P4158T1EdgeSectorSelection.lean | 13 - .../P4158T1LargeFirstRestrictions.lean | 1 - .../P4158T1LargeSecondRestrictions.lean | 10 - .../P4158T1MatchedFordPair.lean | 5 - .../P4158T1SmallerStringEdges.lean | 2 - .../P4194T1DiamondBoundaryLedger.lean | 1 - .../P4207T1FloorArithmetic.lean | 2 - .../P4210T1FordCellRectangles.lean | 1 - .../P4250T1NestedCompatibility.lean | 26 - .../P4250T1OrdinaryCompatibility.lean | 7 - .../P4250T1ReflectedGluingSlope.lean | 8 - .../P4250T2FiniteForestCompletion.lean | 3 - .../P4250T2InterfaceNeighborCount.lean | 11 - .../P4261T1RightCoordinates.lean | 1 - .../P4261T2AncestorSymmetry.lean | 8 - .../P4261T2UnitBoundary.lean | 2 - .../P4261T2UnitInterface.lean | 20 - .../P4366T1PrecursorPathLoop.lean | 2 - .../P4366T1RemainderOuterAttachments.lean | 3 - .../P4366T2LocalSectors.lean | 13 - .../P4366T2OuterGeometry.lean | 19 - .../P4397T1UnitEdgeCells.lean | 4 - .../P4418T3NestedCompanionEndpoint.lean | 2 - .../P4418T3OuterCompanionAlignment.lean | 115 +-- .../P4418T3PresentedRowAdjacency.lean | 2 - .../P4418T3RoutedBlockCriterion.lean | 6 - .../P4418T3SelectedInterfaceExists.lean | 71 +- .../P4456T2BandGraphTriangle.lean | 7 - .../P4456T2CrosscutIndex.lean | 5 - .../P4456T2OrderedNoChord.lean | 10 - .../P4456T2ParentSide.lean | 2 - .../P4456T2SquareEdges.lean | 5 - .../P4458T1LargestParentRows.lean | 4 - .../P4458T1SecondNewerRows.lean | 10 - .../P4536T1AFrameB.lean | 9 - .../P4536T1AFrameD.lean | 7 - .../P4564T2DiamondGeometry.lean | 3 - .../P4564T2FordT6Transport.lean | 11 - .../P4564T2GeneralT6Transport.lean | 51 +- .../P4566T1SmallRetainedSides.lean | 4 - .../P4590T1JunctionRefinement.lean | 6 - .../P4590T1MixedInteriorGeometry.lean | 3 - .../P4590T1OppositeCellsStar.lean | 2 - .../P4590T1RestoredBoundaryGeometry.lean | 20 - .../P4590T1RightInteriorGeometry.lean | 20 - .../P4616T1FirstPredecessorCentroids.lean | 1 - .../P4630T1CellRouteLift.lean | 3 - .../P4638T1ContactStarCoverage.lean | 10 +- .../P4638T1EmptyFordLocalization.lean | 9 - .../P4638T1MidpointReflection.lean | 1 - .../P4677T2IncidenceLedger.lean | 39 - .../P4677T2PrecursorWalk.lean | 13 - .../P4677T2ThreeConnected.lean | 2 - .../P4715T1CoefficientFaces.lean | 23 - .../P4812T1RegularFaceWalks.lean | 2 - .../P4818T1Representatives.lean | 1 - .../P4828T1CircularPlacement.lean | 98 --- .../P4828T1ConstructorSupport.lean | 1 - .../P4828T1LeftRootGeometry.lean | 45 - .../P4828T1LinePlacement.lean | 7 - .../P4828T1ResidualPatches.lean | 53 -- .../P4828T1RightRootGeometry.lean | 45 - .../P4849T1InfiniteLimitComponent.lean | 5 - .../P4849T1LargePositiveComponents.lean | 4 - .../P4909T1LineFan.lean | 90 -- .../P4909T1OmittedDiskBarrier.lean | 1 - .../P4909T1TriangleFan.lean | 76 -- .../P4953T1QuadrilateralSections.lean | 55 -- .../P4984T1ClosedSubdivision.lean | 7 - .../P4984T1IncidentArcs.lean | 3 - .../P4984T1RootGaps.lean | 18 - .../P4984T1UnitIncidence.lean | 3 - .../P4994T6NonunitBirth.lean | 1 - .../P5023T1CircularEstimate.lean | 3 - .../P5023T1CircularSide.lean | 9 - .../P5050T1TangentLineSection.lean | 6 - .../P5064T3OrderedPredecessor.lean | 1 - .../P5110T1SquareInterface.lean | 47 - .../P5124T1EmptyParents.lean | 18 - .../P5130T5ParentArithmetic.lean | 1 - .../P5130T5SameParentOverlaps.lean | 24 - .../P5188T1E1Boundary.lean | 9 - .../P5188T1E2Boundary.lean | 4 - .../P5188T1E3E4Boundary.lean | 3 - .../P5260T1LiteralPlacement.lean | 1 - .../P5260T1PredecessorInterfaces.lean | 19 - .../P5290T1EqualDiamondPaths.lean | 26 - .../P5290T1PredecessorPath.lean | 1 - .../P5290T1UnitContactPaths.lean | 3 - .../P5300T1CanonicalRowArithmetic.lean | 1 - .../P5332T1Parent1Rotation0Values.lean | 14 - .../P5332T1Parent1Rotation1Values.lean | 7 - .../P5332T1Parent1Rotation2Values.lean | 1 - .../P5332T1Parent1Rotation3Values.lean | 2 - .../P5332T1Parent2Rotation0Values.lean | 18 - .../P5332T1Parent2Rotation1Values.lean | 17 - .../P5332T1Parent2Rotation2Values.lean | 7 - .../P5332T1Parent2Rotation3Values.lean | 4 - .../P5332T1RightFirstValues.lean | 3 - .../P5332T1RightHorizontalValues.lean | 1 - .../P5332T1RightSecondValues.lean | 8 - .../P5352T2FirstUnit.lean | 1 - .../P5352T2Predecessor0.lean | 7 - .../P5352T2Predecessor1.lean | 1 - .../P5352T2Predecessor2.lean | 4 - .../P5352T2Predecessor3.lean | 4 - .../P5352T2RightFirst.lean | 2 - .../P5352T2RightHorizontal.lean | 9 - .../P5352T2RightSecond.lean | 2 - .../P5352T2SourceCertificates.lean | 1 - .../P5416T1SecondUnitGeometry.lean | 1 - .../P5442T1LaplacianBound.lean | 1 - .../P5442T1WebGeometry.lean | 2 - .../P5448T1CenteredFordGeometry.lean | 6 - .../P5455T2OccurrenceDeterministic.lean | 1 - .../P5472T1FordNormalization.lean | 4 - .../P5472T1FordSlopeDifference.lean | 1 - .../P5491T1DiamondRightBoundary.lean | 8 - .../P5491T1FordParentBoundary.lean | 1 - .../P5532T1SymmetryOrientationTransport.lean | 1 - .../P5537T1UnitParentBoundary.lean | 1 - ...MarkedRightOdometerAdjacencyReduction.lean | 9 - ...0T1SymmetricMatrixPositivityCriterion.lean | 1 - .../P5635T1EndpointDiagonalOwnership.lean | 4 - .../P5635T1RightBoundaryInterfaceRecords.lean | 2 - ...67T1CyclicChildrenOldArcsPreconnected.lean | 8 - .../P5667T1RoundedSupportingSlope.lean | 4 - .../P5667T1StraightFrontierLocalSides.lean | 2 - .../P5691T1DiamondReflectionFootprints.lean | 34 - .../P5691T1PosDefQuadraticLowerBound.lean | 5 +- .../ParentalOrientationGluing.lean | 8 - ...artialOdometerAffineTranslateFormulas.lean | 68 -- .../PartialOdometerHalfTurnFormulas.lean | 8 - .../PeriodicBoundaryWebConnected.lean | 16 - .../PeriodicBoundaryWebLaplacian.lean | 17 - .../PeriodicOdometerIndicatorRigidity.lean | 10 - .../PeriodicQuadraticRemainder.lean | 18 - .../PeriodicTileTotalIndegree.lean | 19 - .../PositiveCurvatureGeneratorCocycles.lean | 15 - .../PositiveDefiniteRepresentativeGap.lean | 1 - .../ProperBandCurvatureStructure.lean | 3 - ...QuarterTurnSymmetricCenteredTransport.lean | 6 - ...rTurnSymmetricExactInterfaceTransport.lean | 10 - ...tticeAdjacentPackingSymmetryTransport.lean | 1 - .../RightSubtileOdometerCompatibility.lean | 11 - .../SemiProperForestClassification.lean | 1 - .../SimpleGridPathEquivariance.lean | 5 - .../SimpleGridPathPointTrichotomy.lean | 12 - .../SuperharmonicDownwardClosure.lean | 1 - .../TileHalfTurnFormulas.lean | 7 - .../TileOdometerExists.lean | 3 - .../TileOdometerTranslationUniqueness.lean | 1 - .../TileQuarterTurnFormulas.lean | 22 - .../TileStringCoordinateTransport.lean | 4 - ...eStringRegularFamilyCentralCovariance.lean | 3 - .../TileT1DiskArea.lean | 1 - .../TileT2QuarterTurn.lean | 7 - .../TileT4ParentTranslateTouching.lean | 3 - .../TileTouchingCovariance.lean | 5 - .../TileTranslationFormulas.lean | 17 - .../TilingLatticeBasis.lean | 4 - .../TilingLatticeInclusion.lean | 1 - .../TilingLatticeIndex.lean | 26 - ...gicalDiskLocallyPuncturedPreconnected.lean | 5 - .../TriangularStripSegmentOrderInterval.lean | 9 - 311 files changed, 106 insertions(+), 5623 deletions(-) diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean index ecd919ceed..99f3abf516 100644 --- a/LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean @@ -902,7 +902,6 @@ private theorem endpoint_parameters : · have hx : x.1 ≠ y.1 := by intro hx have hx' : (x.1 : Real) = (y.1 : Real) := by exact_mod_cast hx - have hst : s = t := by linarith [h.1] have hy : x.2 = y.2 := by exact_mod_cast (show (x.2 : Real) = (y.2 : Real) by linarith [h.2]) have heq := Prod.ext hx hy @@ -1112,7 +1111,6 @@ theorem AffineTriangularPlaneTriangulation : have arc_homeo (a b : (Int × Int)) (hne : a ≠ b) := AffineTriangulationLemmas.arc_homeo coord_injective segment_homeo a b hne let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} - let C : Set (Real × Real) := {p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 ≤ 1} have open_T := AffineTriangulationLemmas.open_T have closed_C := AffineTriangulationLemmas.closed_C have convex_T := AffineTriangulationLemmas.convex_T diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularStrip.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularStrip.lean index 7552464759..7e56a1b4c6 100644 --- a/LeanPool/ApollonianSuperharmonic/AffineTriangularStrip.lean +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularStrip.lean @@ -577,7 +577,6 @@ private theorem stripSegment : · exact (List.isChain_map f).mpr (hc.imp fun m n h => (hadj m n).mpr h) · intro path hp have hco := hcoords path hp - have hl : (l.map f).map g = l := by simp [List.map_map, Function.comp_def, hgf] have he : path.map g = l := intUnique _ _ _ _ hco ⟨hh, ht, hn, hc⟩ have hp' := hp simp only [TriangularStripSegment, ite_eq_right hxy] at hp' diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean index 46cce64196..c2e11133ce 100644 --- a/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean @@ -88,9 +88,7 @@ private theorem parent_gt_one : 0).1)) ) := by classical intro q hq facts - have hp := facts.1 by_contra hn - have hle : (q 0).1 ≤ 1 := by omega have z0 : (q (0 : Fin 3).succ).1 = 0 := by have hb := hq.2 0 have hn0 := facts.2.1 (0 : Fin 3) @@ -217,9 +215,6 @@ private theorem hrestrict : (Set.ext_iff.mp (restrict_domain X.2 g) x |>.mp hx) have hxhs : x ∈ (hs a s).domain := Set.ext_iff.mp (domain_from_odo _ _ _ (hcells a s)) x |>.mpr hx' - have hxg : x ∈ g.domain := - Set.ext_iff.mp hgd x |>.mpr - (hfoot (Set.ext_iff.mp (restrict_domain X.2 g) x |>.mp hx)) simp [restrict, hx, hcompat a s x hxhs] rw [hkeq] have ho := hcells a s @@ -425,8 +420,6 @@ theorem AncestorOdometerRestriction (k : PartialOdometer), TileOdometer c U k → (k.domain : Set GaussianInt) = FootprintVertices U := TileOdometerDomain - have positive_cells : ∀ (c : CircleCoordinates) (U : ProtoTile), - 0 < c.1 → BandPrototile c U → U.cells.Nonempty := BandPrototileNonempty.positive let vertices : ProtoTile → Finset GaussianInt := fun U => if U.cells.Nonempty then U.cells.biUnion (fun x => {x, x + 1, x + ⟨0, 1⟩, x + 1 + ⟨0, 1⟩}) @@ -451,20 +444,6 @@ theorem AncestorOdometerRestriction ((restrict U g).domain : Set GaussianInt) = FootprintVertices U := by intro U g exact vertices_spec U - have restrict_subset : ∀ U g V, - (g.domain : Set GaussianInt) = FootprintVertices V → - FootprintVertices U ⊆ FootprintVertices V → - (restrict U g).domain ⊆ g.domain := by - intro U g V hgd hincl x hx - have hx' : x ∈ FootprintVertices U := - Set.ext_iff.mp (restrict_domain U g) x |>.mp hx - have hx'' := hincl hx' - exact Set.ext_iff.mp hgd x |>.mpr hx'' - have restrict_agrees : ∀ U g, - ∀ x, x ∈ (restrict U g).domain → (restrict U g).value x = g.value x := by - intro U g x hx - have hx' : x ∈ vertices U := hx - simp [restrict, hx'] have odo_eq : ∀ a b : PartialOdometer, (a.domain : Set GaussianInt) = b.domain → (∀ x, x ∈ a.domain → a.value x = b.value x) → a = b := AncestorRestrictionProof.odo_eq @@ -493,9 +472,6 @@ theorem AncestorOdometerRestriction TileOdometer X.1 X.2 (restrict X.2 g) := by intro X Y hedge g hgd hgo rcases hedge with ⟨q, i, s, hq, hq0, hqi, hY, hX, hfoot, hcent⟩ - have band_one : ∀ c : CircleCoordinates, ∀ U : ProtoTile, - BandPrototile c U → c.1 = 1 → ∃ x : GaussianInt, U.cells = {x} := - AncestorRestrictionProof.band_one have facts := ProperBandCurvatureStructure q hq have parent_gt_one : 1 < (q 0).1 := AncestorRestrictionProof.parent_gt_one q hq facts have hrestrict : TileOdometer X.1 X.2 (restrict X.2 g) := AncestorRestrictionProof.hrestrict diff --git a/LeanPool/ApollonianSuperharmonic/BandCircleEnclosureDichotomy.lean b/LeanPool/ApollonianSuperharmonic/BandCircleEnclosureDichotomy.lean index 35ab6b4775..3db0a8d9f3 100644 --- a/LeanPool/ApollonianSuperharmonic/BandCircleEnclosureDichotomy.lean +++ b/LeanPool/ApollonianSuperharmonic/BandCircleEnclosureDichotomy.lean @@ -45,9 +45,6 @@ theorem BandCircleEnclosureDichotomy (E : EuclideanCircleData) : obtain ⟨D, hD⟩ := hexterior let d : Real := dist E.center (BandCircleEuclideanData D).center let r : Real := (BandCircleEuclideanData D).radius - have hd : d < r := by - dsimp [d, r] - exact lt_of_not_ge hD have hrd : r < d + E.radius := by by_contra h have hh : d + E.radius ≤ r := le_of_not_gt h diff --git a/LeanPool/ApollonianSuperharmonic/BandDescartesGapSubdivision.lean b/LeanPool/ApollonianSuperharmonic/BandDescartesGapSubdivision.lean index 9fabd2909f..e603108e96 100644 --- a/LeanPool/ApollonianSuperharmonic/BandDescartesGapSubdivision.lean +++ b/LeanPool/ApollonianSuperharmonic/BandDescartesGapSubdivision.lean @@ -62,8 +62,6 @@ theorem BandDescartesGapSubdivision dsimp at classified rcases classified with special | classified · exfalso - have hpos := curvature.1 - have n1 : 0 ≤ (q 1).1 := by simpa using curvature.2.1 (0 : Fin 3) have n2 : 0 ≤ (q 2).1 := by simpa using curvature.2.1 (1 : Fin 3) have n3 : 0 ≤ (q 3).1 := by simpa using curvature.2.1 (2 : Fin 3) have hlt : (q 1).1 < (q 0).1 := by simpa using hq.2 (0 : Fin 3) @@ -71,7 +69,6 @@ theorem BandDescartesGapSubdivision change 2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1 = 1 at special have hz2 : (q 2).1 = 0 := by omega have hz3 : (q 3).1 = 0 := by omega - have hz1 : (q 1).1 = 0 := by omega have : (1 : Fin 3) = 2 := hzero 1 2 (by simpa using hz2) (by simpa using hz3) exact (by decide : (1 : Fin 3) ≠ 2) this rcases classified with ⟨hs, h0, h2, h3⟩ @@ -79,9 +76,6 @@ theorem BandDescartesGapSubdivision ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), q 0, q 2, q 3] - have hsdef : s = ![(2 * (q 0).1 + 2 * (q 2).1 + 2 * (q 3).1 - (q 1).1, - 2 * (q 0).2 + 2 * (q 2).2 + 2 * (q 3).2 - (q 1).2), - q 0, q 2, q 3] := rfl have hssemi : SemiProperQuadruple s := by simpa [s] using successor have hdpos : 0 < (s 0).1 := by diff --git a/LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean b/LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean index d7cb196d9a..dc55627ea9 100644 --- a/LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean +++ b/LeanPool/ApollonianSuperharmonic/BandDoubleDecomposition.lean @@ -702,7 +702,6 @@ private theorem precursors : intro q r hq hr hr0 hr2 h12 h2four x P Q S hQ hS rotatedT5 I a b c d e hc hr32 he hd inverse p0x p0y m0x m0y q0x q0y q1x q1y q2x q2y s1x s1y s2x s2y have rsmall (j : Fin 3) : Int.toNat (r j.succ).1 < Int.toNat (q 0).1 := by - have hn := (SemiProperForestClassification r hr.1).1 j.succ have hl := hr.2 j have hq1 := hq.2 0 change (q 1).1 < (q 0).1 at hq1 diff --git a/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean b/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean index 6ee3538ead..18b9829acc 100644 --- a/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean +++ b/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean @@ -1215,9 +1215,6 @@ private theorem sectorOrderCertificate : have hSmissQ : ∃ j, LatticeVertexIncidentCell x j ∉ S.cells := ⟨hQinc.choose, fun hs => Finset.disjoint_left.mp hQSC hQinc.choose_spec hs⟩ - have hOmissQ : ∃ j, LatticeVertexIncidentCell x j ∉ Q.cells := - ⟨hOinc.choose, fun hq => - Finset.disjoint_left.mp (hQO hOne) hq hOinc.choose_spec⟩ have hbQ := P3161T2IncidentBoundary Q x hQinc hQmissS have hbS := P3161T2IncidentBoundary S x hSinc hSmissQ have hOmissO : ∃ j, LatticeVertexIncidentCell x j ∉ O.cells := @@ -1241,9 +1238,6 @@ private theorem sectorOrderCertificate : have hVmissR : ∃ j, LatticeVertexIncidentCell x j ∉ V.cells := ⟨hRinc.choose, fun hv => Finset.disjoint_left.mp hRVD hRinc.choose_spec hv⟩ - have hOmissR : ∃ j, LatticeVertexIncidentCell x j ∉ R.cells := - ⟨hOinc.choose, fun hr => - Finset.disjoint_left.mp (hRO hOne) hr hOinc.choose_spec⟩ have hbR := P3161T2IncidentBoundary R x hRinc hRmissV have hbV := P3161T2IncidentBoundary V x hVinc hVmissR have hOmissO : ∃ j, LatticeVertexIncidentCell x j ∉ O.cells := @@ -1330,11 +1324,9 @@ theorem BandExceptionalRestorationSectorOrder tile_from_band have nonempty_cells := RestorationSectorGeometry.nonempty_cells have touching_disjoint := TileTouchingDisjoint.cells - have hA : LatticeTile A := cert.parent_lattice 0 true have hB : LatticeTile B := cert.parent_lattice 0 false have hCparent : LatticeTile C := cert.parent_lattice 1 true have hDparent : LatticeTile D := cert.parent_lattice 1 false - have hAne := nonempty_cells A hA have hBne := nonempty_cells B hB have hCne := nonempty_cells C hCparent have hDne := nonempty_cells D hDparent @@ -1349,10 +1341,6 @@ theorem BandExceptionalRestorationSectorOrder have trzero := RestorationSectorGeometry.trzero have hsep := BandOriginalPairSeparation cert.P O cert.u cert.v seg.precursor_in_left seg.precursor_in_right cert.partition - let iA : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ - let iB : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ - let iC : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let iD : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ have hcompB : Disjoint (TileCellComplement A O).cells B.cells := RestorationSectorGeometry.hcompB q cfg C₀ T cert (RestorationSectorGeometry.htileComp q cfg C₀ T cert trzero) (RestorationSectorGeometry.htileB q cfg C₀ T cert trzero) @@ -1361,12 +1349,6 @@ theorem BandExceptionalRestorationSectorOrder i.label = .B ∧ j.label = .A) ∧ i.first = j.first ∧ i.second = j.second)) : Disjoint (SubtileOccurrenceInterpretation cert.P cert.u cert.v i).cells (SubtileOccurrenceInterpretation cert.P cert.u cert.v j).cells := hsep.2 i j hij hlabels - have hBC := RestorationSectorGeometry.hBC q cfg C₀ T cert trzero - indexed_disjoint - have hBD := RestorationSectorGeometry.hBD q cfg C₀ T cert trzero - indexed_disjoint - have hCD := RestorationSectorGeometry.hCD q cfg C₀ T cert trzero - indexed_disjoint have hOC := RestorationSectorGeometry.hOC q cfg C₀ T cert (RestorationSectorGeometry.hAC q cfg C₀ T cert trzero indexed_disjoint) have hOD := RestorationSectorGeometry.hOD q cfg C₀ T cert (RestorationSectorGeometry.hAD q cfg @@ -1386,15 +1368,9 @@ theorem BandExceptionalRestorationSectorOrder have boundary_missing_incident := RestorationSectorGeometry.boundary_missing_incident have hQO := RestorationSectorGeometry.hQO q cfg C₀ T cert touching_disjoint hQne - have hSO := RestorationSectorGeometry.hSO q cfg - C₀ T cert touching_disjoint hSne have hRO := RestorationSectorGeometry.hRO q cfg C₀ T cert touching_disjoint hRne - have hVO := RestorationSectorGeometry.hVO q cfg - C₀ T cert touching_disjoint hVne have rho_mem := RestorationSectorGeometry.rho_mem q cfg C₀ T cert - let f1 : PeriodicSubtileFaceIndex := ⟨.I1, 0, 0⟩ - let f2 : PeriodicSubtileFaceIndex := ⟨.I2, 0, 0⟩ have hp1QS : p1 ∈ FootprintVertices Q ∩ FootprintVertices S := by exact cert.inner_first have hp2RV : p2 ∈ FootprintVertices R ∩ FootprintVertices V := by diff --git a/LeanPool/ApollonianSuperharmonic/BandModifiedCellPartition.lean b/LeanPool/ApollonianSuperharmonic/BandModifiedCellPartition.lean index 2ced86a1f1..e8cf166229 100644 --- a/LeanPool/ApollonianSuperharmonic/BandModifiedCellPartition.lean +++ b/LeanPool/ApollonianSuperharmonic/BandModifiedCellPartition.lean @@ -73,14 +73,6 @@ private theorem map_mem (P : Fin 3 -> Bool -> ProtoTile) (O : ProtoTile) (L : Ad SixSubtileLabel, {y : GaussianInt // y ∈ (base P O) j}) : (representative L R hfund) z.2 ∈ R := by classical - let base : SixSubtileLabel → Finset GaussianInt := fun j => - match j with - | .A => (P 0 true).cells \ O.cells - | .B => (P 0 false).cells - | .C => (P 1 true).cells - | .D => (P 1 false).cells - | .E => (P 2 true).cells - | .F => (P 2 false).cells let representative : GaussianInt → GaussianInt := fun y => Classical.choose (hfund y) have representative_spec (y : GaussianInt) : @@ -464,15 +456,8 @@ theorem BandModifiedCellPartition (P : Fin 3 -> Bool -> ProtoTile) have representative_spec (y : GaussianInt) : representative y ∈ R ∧ y - representative y ∈ L := ModifiedCellPartitionConstruction.representative_spec L R hfund y - have map_mem (z : Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}) : - representative z.2 ∈ R := ModifiedCellPartitionConstruction.map_mem P O L R hfund z let mapped : (Σ j : SixSubtileLabel, {y : GaussianInt // y ∈ base j}) → GaussianInt := fun z => representative z.2 - have hsurj : Set.SurjOn mapped (incidences : Set _) (R : Set GaussianInt) := - ModifiedCellPartitionConstruction.hsurj P O u v L R hu hv hfund hcover - have hcard : incidences.card = R.card := ModifiedCellPartitionConstruction.hcard P O R harea - have himage : incidences.image mapped = R := ModifiedCellPartitionConstruction.himage P O u v L - R hu hv hfund hcover have hinj : Set.InjOn mapped (incidences : Set _) := ModifiedCellPartitionConstruction.hinj P O u v L R hu hv hfund hcover harea have decode : ∀ (o : PeriodicSubtileIndex) (x : GaussianInt), diff --git a/LeanPool/ApollonianSuperharmonic/BandOdometerMaximality.lean b/LeanPool/ApollonianSuperharmonic/BandOdometerMaximality.lean index 6dd5e83cc6..733b91f19a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOdometerMaximality.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOdometerMaximality.lean @@ -105,7 +105,6 @@ theorem BandOdometerMaximality (C : BandCircle) ((-a.re : Int) : GaussianInt) * b = 0 := by ext <;> simp [him.1, him.2]; ring have hpair := he (by simpa using hzero) - have hbre : b.re = 0 := congrArg Prod.fst hpair have hare : a.re = 0 := by have hh := congrArg Prod.snd hpair simpa using neg_eq_zero.mp hh diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean index 5aa7d5963e..3cf303c408 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean @@ -1492,7 +1492,6 @@ theorem BandOrderedGeneralChildInterfaces hdisjBC hdisjCA (ChildInterfaceGeometry.hcommonAB q cfg C₀ T cert) (ChildInterfaceGeometry.hcommonBC q cfg C₀ T cert) (ChildInterfaceGeometry.hcommonCA q cfg C₀ T cert) hLA' hLB' hLC' - let retargetTriple := retargetNonemptyTriple have hzero : (TileTranslation T 0).cells = T.cells := ChildInterfaceGeometry.hzero T have rootNe : T.cells.Nonempty := ChildInterfaceGeometry.rootNe q cfg C₀ T cert blockEq hLA' hzero have transZeroNe : (TileTranslation T 0).cells.Nonempty := by @@ -1507,8 +1506,6 @@ theorem BandOrderedGeneralChildInterfaces have rowJunction := ChildInterfaceGeometry.rowJunction q cfg C₀ T cert patchForAt blockDisjoint patchUnion blockLattice have blockEdge := ChildInterfaceGeometry.blockEdge q cfg C₀ T cert - let τ1 : Finset (Int × Int) := {(0,0),(1,0),(0,-1)} - let τ3 : Finset (Int × Int) := {(0,0),(-1,-1),(-1,0)} have row1 := ChildInterfaceGeometry.row1 q cfg C₀ T cert rowJunction blockEdge have row3 := ChildInterfaceGeometry.row3 q cfg C₀ T cert diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean index 0d416b21ec..3726589535 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLargestParentOdometerRows.lean @@ -1634,15 +1634,8 @@ private theorem positiveLargestCase : let cOff (z : GaussianInt) : Real × Real := (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) - let sOff (z : GaussianInt) : Real × Real := - (1 / 2 : Real) • - (((z.re : Int) : Real) - ((z.im : Int) : Real), - ((z.im : Int) : Real) + ((z.re : Int) : Real)) let I : GaussianInt := ⟨0, 1⟩ - let U : GaussianInt := BandVectors.1 (q 2) (q 1) let W : GaussianInt := BandVectors.1 (q 3) (q 2) - let A : GaussianInt := BandVectors.2 (q 2) (q 1) - let B : GaussianInt := BandVectors.2 (q 3) (q 2) let C₂ : BandCircle := ⟨⟨q 2, ⟨Or.inl hpos2, q, cfg.proper.1, ⟨2, rfl⟩⟩⟩, hpos2⟩ let C₃ : BandCircle := ⟨⟨q 3, @@ -1650,12 +1643,8 @@ private theorem positiveLargestCase : rcases positiveRow with ⟨left_mem, right_mem, star, companion, rfl⟩ have bq : BandPrototile (cfg.firstPredecessor 2) (Q 1 true) := band_of_odo _ _ _ (data.hQ 1 true) - have bs : BandPrototile (cfg.firstPredecessor 3) (S 2 false) := - band_of_odo _ _ _ (data.hS 2 false) have bp : BandPrototile (q 2) (P 1 true) := by simpa [cfg.firstParentTwo] using band_of_odo _ _ _ (data.hP 1 true) - have hc := data.hQcent 1 true - have hs := data.hScent 2 false have hQleaf := LargestParentOdometerGeometry.hQleafAt284 q cfg C0 T cert h P r Q S u v g data have hSleaf := LargestParentOdometerGeometry.hSleafAt293 q cfg C0 T cert h P r Q S u v g data have hQleafOff := LargestParentOdometerGeometry.hQleafOffAt302 q cfg P Q hQleaf @@ -1836,28 +1825,17 @@ private theorem reflectedLargestCase : let cOff (z : GaussianInt) : Real × Real := (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) - let sOff (z : GaussianInt) : Real × Real := - (1 / 2 : Real) • - (((z.re : Int) : Real) - ((z.im : Int) : Real), - ((z.im : Int) : Real) + ((z.re : Int) : Real)) let I : GaussianInt := ⟨0, 1⟩ - let U : GaussianInt := BandVectors.1 (q 2) (q 1) let W : GaussianInt := BandVectors.1 (q 3) (q 2) - let A : GaussianInt := BandVectors.2 (q 2) (q 1) - let B : GaussianInt := BandVectors.2 (q 3) (q 2) let C₂ : BandCircle := ⟨⟨q 2, ⟨Or.inl hpos2, q, cfg.proper.1, ⟨2, rfl⟩⟩⟩, hpos2⟩ let C₃ : BandCircle := ⟨⟨q 3, ⟨Or.inl hpos3, q, cfg.proper.1, ⟨3, rfl⟩⟩⟩, hpos3⟩ rcases reflectedRow with ⟨left_mem, right_mem, star, companion, rfl⟩ - have bq : BandPrototile (cfg.firstPredecessor 3) (Q 2 true) := - band_of_odo _ _ _ (data.hQ 2 true) have bs : BandPrototile (cfg.firstPredecessor 2) (S 1 false) := band_of_odo _ _ _ (data.hS 1 false) have bp : BandPrototile (q 2) (P 1 false) := by simpa [cfg.firstParentTwo] using band_of_odo _ _ _ (data.hP 1 false) - have hc := data.hQcent 2 true - have hs := data.hScent 1 false have hQleaf := LargestParentOdometerGeometry.hQleafAt647 q cfg C0 T cert h P r Q S u v g data have hSleaf := LargestParentOdometerGeometry.hSleafAt656 q cfg C0 T cert h P r Q S u v g data have hQleafOff := LargestParentOdometerGeometry.hQleafOffAt665 q cfg P Q hQleaf @@ -2018,18 +1996,6 @@ theorem BandOrderedGeneralLargestParentOdometerRows -- BODY classical have band_of_odo := TileOdometerBandPrototile - let cOff (z : GaussianInt) : Real × Real := - (1 / 2 : Real) • (GaussianRealPoint z - - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) - let sOff (z : GaussianInt) : Real × Real := - (1 / 2 : Real) • - (((z.re : Int) : Real) - ((z.im : Int) : Real), - ((z.im : Int) : Real) + ((z.re : Int) : Real)) - let I : GaussianInt := ⟨0, 1⟩ - let U : GaussianInt := BandVectors.1 (q 2) (q 1) - let W : GaussianInt := BandVectors.1 (q 3) (q 2) - let A : GaussianInt := BandVectors.2 (q 2) (q 1) - let B : GaussianInt := BandVectors.2 (q 3) (q 2) have v21 := LargestParentOdometerGeometry.v21 q cfg (LargestParentOdometerGeometry.firstRotateV q cfg) have a21 := LargestParentOdometerGeometry.a21 q cfg (LargestParentOdometerGeometry.firstRotateA @@ -2040,10 +2006,6 @@ theorem BandOrderedGeneralLargestParentOdometerRows have slopeAlgebra := LargestParentOdometerGeometry.slopeAlgebra q have hpos2 := LargestParentOdometerGeometry.hpos2 q cfg have hpos3 := LargestParentOdometerGeometry.hpos3 q cfg - let C₂ : BandCircle := ⟨⟨q 2, - ⟨Or.inl hpos2, q, cfg.proper.1, ⟨2, rfl⟩⟩⟩, hpos2⟩ - let C₃ : BandCircle := ⟨⟨q 3, - ⟨Or.inl hpos3, q, cfg.proper.1, ⟨3, rfl⟩⟩⟩, hpos3⟩ rcases largest with leftCase | rightCase · have positiveRow : (exists diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean index 8140044b31..ec8961ce77 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralLayout.lean @@ -571,8 +571,6 @@ private theorem abEdge : (P 0 true) (P 0 false) O (hPr true) (hPr false) he (zero he) (by simpa [O] using hac) (by simpa [O] using hbc) let a := (BandPackingSymmetryTileAction g O).anchor - have h1' : 0 < (F.q₁ : Int) := by exact_mod_cast h1 - have h2' : 0 < (F.q₂ : Int) := by exact_mod_cast h2 have hA : a ∈ (BandPackingSymmetryTileAction g (P 0 true)).cells := by apply (upper a).mpr simp only [a, sub_self] diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean index 96fc4fb4ba..6a84057768 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralOuterMixedOdometerRows.lean @@ -2155,15 +2155,9 @@ theorem BandOrderedGeneralOuterMixedOdometerRows rw [← pow_two, hI2] let U : GaussianInt := BandVectors.1 (q 2) (q 1) let W : GaussianInt := BandVectors.1 (q 3) (q 2) - let A : GaussianInt := BandVectors.2 (q 2) (q 1) - let B : GaussianInt := BandVectors.2 (q 3) (q 2) let cOff (z : GaussianInt) : Real × Real := (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) - let sOff (z : GaussianInt) : Real × Real := - (1 / 2 : Real) • - (((z.re : Int) : Real) - ((z.im : Int) : Real), - ((z.im : Int) : Real) + ((z.re : Int) : Real)) have laws := VectorRecursionLaws q cfg.proper.1 have firstLaws := VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1 have secondFlip := (VectorRecursionLaws cfg.secondPredecessor @@ -2187,9 +2181,6 @@ theorem BandOrderedGeneralOuterMixedOdometerRows have hpos2 := OuterMixedOdometerGeometry.hpos2 q cfg have hpos3 := OuterMixedOdometerGeometry.hpos3 q cfg have hpos1 := OuterMixedOdometerGeometry.hpos1 q cfg - let C1 : BandCircle := ⟨⟨q 1, Or.inl hpos1, q, cfg.proper.1, 1, rfl⟩, hpos1⟩ - let C2 : BandCircle := ⟨⟨q 2, Or.inl hpos2, q, cfg.proper.1, 2, rfl⟩, hpos2⟩ - let C3 : BandCircle := ⟨⟨q 3, Or.inl hpos3, q, cfg.proper.1, 3, rfl⟩, hpos3⟩ have pPack := OuterMixedOdometerGeometry.pPack q cfg C0 T cert h P r Q S u v g data have p0plus := pPack 0 true have p1minus := pPack 1 false diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean index e984177c2a..c8eb727a8e 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean @@ -87,8 +87,6 @@ private theorem birthData : · rcases bad with ⟨birth, hp, _, h0, h2, h3, _, hlt⟩ have h₂ : (ρ 3).1 ≤ (ρ 2).1 := by simpa [ρ, cfg.firstParentTwo, cfg.firstParentThree] using cfg.order23 - have hbad : (ρ 2).1 < (ρ 3).1 := by - exact hlt omega private abbrev prototile_lattice := ApollonianSuperharmonic.P4590T1PositivePrototileDisk @@ -1766,22 +1764,15 @@ theorem BandOrderedGeneralPositiveCutGeometry have hQ3S2 := touching_disjoint _ _ cert.precursor_second.1 hQ3ne hS2ne have hS2O := touching_disjoint _ _ cert.precursor_second.2.1 hS2ne hOne have hOQ3 := touching_disjoint _ _ cert.precursor_second.2.2.1 hOne hQ3ne - have hQ2S2 := touching_disjoint _ _ cert.double_first.1 hQ2ne hS3ne have hOQ1 := touching_disjoint _ _ cert.precursor_first.2.2.1 hOne hQ2ne - have hS1O := touching_disjoint _ _ cert.precursor_second.2.1 hS2ne hOne - have selectB_Q := PositiveCutGeometry.selectB_Q q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check - hS2check hOcheck hQ3occ hS2occ hBowners hOoccB hQ3S2 hS2O hOQ3 have normalize_selected := PositiveCutGeometry.normalize_selected have ne_of_disjoint := PositiveCutGeometry.ne_of_disjoint - have hneQ2S2 := ne_of_disjoint _ _ hQ2S2 hQ2ne have hneQ1S1 := ne_of_disjoint _ _ (PositiveCutGeometry.hQ1S1 q cfg C₀ T cert hOQ1 (PositiveCutGeometry.houterIntersection q cfg C₀ T cert)) hQ2ne have hneA_QS := ne_of_disjoint _ _ hQS hQ2ne have hneA_QO := ne_of_disjoint _ _ hOQ.symm hQ2ne have hneA_SO := ne_of_disjoint _ _ hSO hS3ne - have hneB_QS := ne_of_disjoint _ _ hQ3S2 hQ3ne have hneB_QO := ne_of_disjoint _ _ hOQ3.symm hQ3ne - have hneB_SO := ne_of_disjoint _ _ hS2O hS2ne have hneB_SQ := ne_of_disjoint _ _ hQ3S2.symm hS2ne have hneB_SO' := ne_of_disjoint _ _ hS2O hS2ne have hneB_QO' := ne_of_disjoint _ _ hOQ3.symm hQ3ne @@ -1808,7 +1799,6 @@ theorem BandOrderedGeneralPositiveCutGeometry let I : GaussianInt := ⟨0, 1⟩ have hI2 : I ^ 2 = -1 := by dsimp [I]; decide have hI3 : I ^ 3 = -I := by dsimp [I]; decide - have hnotEven3 := PositiveCutGeometry.hnotEven3 have hodd3 : ¬ (∃ r : ℕ, 3 = r + r) := by omega have occurrence_centroid := PositiveCutGeometry.occurrence_centroid have vectorSystem : RecursiveVectorSystem BandVectors := by diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutOdometerRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutOdometerRows.lean index d0aad43693..d9ebbfe341 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutOdometerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutOdometerRows.lean @@ -897,7 +897,6 @@ theorem BandOrderedGeneralPositiveCutOdometerRows have posO := PositiveCutOdometerGeometry.posO q cfg C0 T cert x geometry (PositiveCutOdometerGeometry.positive_of_nonempty) have nestedPositive := PositiveCutOdometerGeometry.nestedPositive q cfg pos2 pos3 posO - let I : GaussianInt := ⟨0, 1⟩ let cOff (z : GaussianInt) : Real × Real := (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) @@ -905,11 +904,7 @@ theorem BandOrderedGeneralPositiveCutOdometerRows ((1 / 2 : Real) * ((z.re : Real) - (z.im : Real)), (1 / 2 : Real) * ((z.im : Real) + (z.re : Real))) let W := BandVectors.1 (q 3) (q 2) - let Z := BandVectors.1 (cfg.firstPredecessor 1) (q 3) - let X := BandVectors.1 (q 2) (cfg.firstPredecessor 1) let A := BandVectors.2 (q 3) (q 2) - let B := BandVectors.2 (cfg.firstPredecessor 1) (q 3) - let D := BandVectors.2 (q 2) (cfg.firstPredecessor 1) have cadd (a b : GaussianInt) : cOff (a + b) = cOff a + cOff b := by apply Prod.ext <;> simp [cOff, GaussianRealPoint, Prod.smul_mk] <;> ring have sadd (a b : GaussianInt) : sOff (a + b) = sOff a + sOff b := by @@ -995,16 +990,6 @@ theorem BandOrderedGeneralPositiveCutOdometerRows slopePm have slopeS2 := PositiveCutOdometerGeometry.slopeS2 q cfg sumS z zm zS2 dzS2 slopePm - let cTarget (s : Fin 4) : Real × Real := - (1 / 2 : Real) • GaussianRealPoint - (I ^ s.val * - (BandVectors.1 (geometry.birth geometry.parentIndex.succ) (geometry.birth 0) + - BandVectors.1 (geometry.birth 0) (geometry.birth geometry.parentIndex.succ))) - let sTarget (s : Fin 4) : Real × Real := - (1 / 2 : Real) • GaussianRealPoint - ((-I) ^ s.val * - (BandVectors.2 (geometry.birth geometry.parentIndex.succ) (geometry.birth 0) + - BandVectors.2 (geometry.birth 0) (geometry.birth geometry.parentIndex.succ))) have flip := (VectorRecursionLaws geometry.birth geometry.proper.1).2.2.2.2 geometry.proper geometry.parentIndex have cforms := PositiveCutOdometerGeometry.cforms q cfg C0 T cert x geometry flip diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean index 246d5af363..40a3257cae 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean @@ -858,54 +858,6 @@ theorem BandOrderedGeneralRightInterfaceCertificateExists -- BODY classical have touchingRetarget := ObservableTileRetargeting.triple - have swapAB : forall (A B D : ProtoTile), - ExactTileInterfaceTriple A B D -> ExactTileInterfaceTriple B A D := by - intro A B D E - exact - { point := E.point - otherAB := E.otherAB - otherBC := E.otherCA - otherCA := E.otherBC - pathAB := by simpa [Set.inter_comm] using E.pathAB - pathBC := by simpa [Set.inter_comm] using E.pathCA - pathCA := by simpa [Set.inter_comm] using E.pathBC - unique_common := by - intro y - simpa [Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using - E.unique_common y } - have cycleCAB : forall (A B D : ProtoTile), - ExactTileInterfaceTriple A B D -> ExactTileInterfaceTriple D A B := by - intro A B D E - exact - { point := E.point - otherAB := E.otherCA - otherBC := E.otherAB - otherCA := E.otherBC - pathAB := E.pathCA - pathBC := E.pathAB - pathCA := E.pathBC - unique_common := by - intro y - simpa [Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using - E.unique_common y } - have retargetFirst : forall (A A' B D : ProtoTile), - A.cells = A'.cells -> (A.cells = ∅ -> A.anchor = A'.anchor) -> - ExactTileInterfaceTriple A B D -> ExactTileInterfaceTriple A' B D := by - intro A A' B D hAc hAa E - have hAo := ProtoTileObservableExtensionality A A' hAc hAa - have hAe : FootprintEdges A = FootprintEdges A' := RightInterfaceCertificateGeometry.hAeAt211 - A A' hAc - exact - { point := E.point - otherAB := E.otherAB - otherBC := E.otherBC - otherCA := E.otherCA - pathAB := by simpa [hAo.1, hAe] using E.pathAB - pathBC := E.pathBC - pathCA := by simpa [hAo.1, hAe] using E.pathCA - unique_common := by - intro y - simpa [hAo.1] using E.unique_common y } have centeredTurnTouching := RightInterfaceCertificateGeometry.centeredTurnTouching touchingRetarget (TileQuarterTurnTranslation.translated) @@ -975,30 +927,6 @@ theorem BandOrderedGeneralRightInterfaceCertificateExists (BandVectors.1 (q (2 : Fin 3).succ) (q 0)) (-BandVectors.1 (q (((2 : Fin 3) + 1).succ)) (q 0)) normalization.fixed_quarter_turn X2 - have X0p : ExactTileInterfaceTriple F - (TileTranslation F (BandVectors.1 (q 0) (q 1))) - (TileTranslation F (-BandVectors.1 (q 0) (q 2))) := by - simpa [turn0, turn1, turn_neg] using X0p0 - have X1p : ExactTileInterfaceTriple F - (TileTranslation F (BandVectors.1 (q 0) (q 2))) - (TileTranslation F (-BandVectors.1 (q 0) (q 3))) := by - simpa [turn1, turn2, turn_neg] using X1p0 - have X2p : ExactTileInterfaceTriple F - (TileTranslation F (BandVectors.1 (q 0) (q 3))) - (TileTranslation F (-BandVectors.1 (q 0) (q 1))) := by - simpa [turn2, turn0, turn_neg] using X2p0 - have X0m : ExactTileInterfaceTriple F - (TileTranslation F (-BandVectors.1 (q 0) (q 1))) - (TileTranslation F (BandVectors.1 (q 0) (q 2))) := by - simpa [turn_three, turn_two, turn0, turn1, turn_neg] using X0m0 - have X1m : ExactTileInterfaceTriple F - (TileTranslation F (-BandVectors.1 (q 0) (q 2))) - (TileTranslation F (BandVectors.1 (q 0) (q 3))) := by - simpa [turn_three, turn_two, turn1, turn2, turn_neg] using X1m0 - have X2m : ExactTileInterfaceTriple F - (TileTranslation F (-BandVectors.1 (q 0) (q 3))) - (TileTranslation F (BandVectors.1 (q 0) (q 1))) := by - simpa [turn_three, turn_two, turn2, turn0, turn_neg] using X2m0 have touch0p : TouchingTriple F (TileTranslation F (BandVectors.1 (q 0) (q 1))) (TileTranslation F (-BandVectors.1 (q 0) (q 2))) := diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean index 50431d440a..b16c40884b 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightRoutingCertificateExists.lean @@ -912,18 +912,6 @@ theorem BandOrderedGeneralRightRoutingCertificateExists (normalization.piece_cell_cover _).mp hjroot obtain ⟨centralSlot, centralSign, hcentral⟩ := (normalization.layout.outer_union _).mp hjfixed - have laws := VectorRecursionLaws q normalization.configuration.proper.1 - have flip := laws.2.2.2.2 normalization.configuration.proper - have turn_flip (s : Fin 3) : - GaussianQuarterTurn (BandVectors.1 (q s.succ) (q 0)) = - BandVectors.1 (q 0) (q s.succ) := BandParentVectorQuarterTurn.turn - (normalization).normalizedPresentation (fun j => (flip j).1) s - have turn0 : GaussianQuarterTurn (BandVectors.1 (q 1) (q 0)) = - BandVectors.1 (q 0) (q 1) := by simpa using turn_flip (0 : Fin 3) - have turn1 : GaussianQuarterTurn (BandVectors.1 (q 2) (q 0)) = - BandVectors.1 (q 0) (q 2) := by simpa using turn_flip (1 : Fin 3) - have turn2 : GaussianQuarterTurn (BandVectors.1 (q 3) (q 0)) = - BandVectors.1 (q 0) (q 3) := by simpa using turn_flip (2 : Fin 3) have period0 : BandVectors.1 (q 0) (q 1) = normalization.layout.u := normalization.layout.period_u.symm have period1 : BandVectors.1 (q 0) (q 2) = normalization.layout.v := diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean index 03685a7557..0f6d58e1e6 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean @@ -588,9 +588,6 @@ private theorem originalSelectedPath : classical intro C D T N h k x bundle placement selectedEdge hx hedge modifiedPath P u v selectedOccurrenceRetarget selectedPath - let q := bundle.normalizedPresentation - let cfg := bundle.configuration - let F := bundle.normalizedFixed rcases modifiedPath with ⟨selectedStart, selectedEnd, hpath⟩ have hpath' := hpath rw [placement.layout.modified_tile placement.exteriorIndex, @@ -4158,10 +4155,7 @@ theorem BandOrderedGeneralRightSelectedRowGeometry let q := bundle.normalizedPresentation let cfg := bundle.configuration let F := bundle.normalizedFixed - let root := bundle.normalizedRoot have edgeVertex := SelectedRowGeometry.edgeVertex - let norm := SelectedRowNormalization.certificate C D T N h k x bundle placement - have outer := (BandOrderedGeneralRightInterfaceCertificateExists norm).some have childInterfaces := BandOrderedGeneralChildInterfaces q cfg bundle.normalizedCircle F placement.layout (TileT2QuarterTurn q cfg bundle.normalizedCircle F placement.layout) @@ -4184,7 +4178,6 @@ theorem BandOrderedGeneralRightSelectedRowGeometry have boundaryRecords := P5635T1RightBoundaryInterfaceRecords C D T N h k x bundle placement have centeredExactTurn := SelectedRowGeometry.centeredExactTurn C D T N h k x bundle placement - have twiceExactTurn := SelectedRowGeometry.twiceExactTurn C D T N h k x bundle centeredExactTurn have tripleTurnOutgoing (ell : Fin 3) : GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn (BandVectors.1 (q ell.succ) (q 0)))) = @@ -4195,35 +4188,9 @@ theorem BandOrderedGeneralRightSelectedRowGeometry (GaussianQuarterTurn (-BandVectors.1 (q (ell + 1).succ) (q 0)))) = BandVectors.1 (q 0) (q (ell + 1).succ) := SelectedRowGeometry.tripleTurnNegativeNext C D T N h k x bundle turnOutgoing turnNeg turnThrice ell - have swapExact (A B D : ProtoTile) (E : ExactTileInterfaceTriple A B D) : - ExactTileInterfaceTriple B A D := SelectedRowExactInterfaces.swapExact A B D E - have cycleExact (A B D : ProtoTile) (E : ExactTileInterfaceTriple A B D) : - ExactTileInterfaceTriple D A B := SelectedRowExactInterfaces.cycleExact A B D E - have retargetExactFirst (A A' B D : ProtoTile) - (hcell : A.cells = A'.cells) - (hanchor : A.cells = ∅ → A.anchor = A'.anchor) - (E : ExactTileInterfaceTriple A B D) : ExactTileInterfaceTriple A' B D := - SelectedRowExactInterfaces.retargetExactFirst A A' B D hcell hanchor E have touchingRetarget := ObservableTileRetargeting.triple have centeredTurnTouching := SelectedRowGeometry.centeredTurnTouching touchingRetarget (TileQuarterTurnTranslation.translated) (SelectedRowGeometry.translateObs) - have exactPlus (ell : Fin 3) : ExactTileInterfaceTriple F - (TileTranslation F (BandVectors.1 (q 0) (q ell.succ))) - (TileTranslation F (-BandVectors.1 (q 0) (q (ell + 1).succ))) := by - let E := Classical.choice (centeredExactTurn - (BandVectors.1 (q ell.succ) (q 0)) - (-BandVectors.1 (q (ell + 1).succ) (q 0)) - (Classical.choice (childInterfaces.1 ell))) - simpa [turnOutgoing, turnNeg] using E - have exactMinus (ell : Fin 3) : ExactTileInterfaceTriple F - (TileTranslation F (-BandVectors.1 (q 0) (q ell.succ))) - (TileTranslation F (BandVectors.1 (q 0) (q (ell + 1).succ))) := by - let E := Classical.choice ((SelectedRowGeometry.thriceExactTurn C D T N h k x bundle - centeredExactTurn) - (BandVectors.1 (q ell.succ) (q 0)) - (-BandVectors.1 (q (ell + 1).succ) (q 0)) - (Classical.choice (childInterfaces.1 ell))) - simpa only [tripleTurnOutgoing, tripleTurnNegativeNext] using E have touchingPlus := SelectedRowGeometry.touchingPlus C D T N h k x bundle placement translatedTouching turnOutgoing turnNeg centeredTurnTouching have touchingMinus := SelectedRowGeometry.touchingMinus C D T N h k x bundle placement @@ -4236,58 +4203,10 @@ theorem BandOrderedGeneralRightSelectedRowGeometry have modifiedAdjacent : placement.layout.modified.plane.adjacent placement.exteriorIndex placement.centralIndex := (placement.layout.modified_adjacency _ _).2 originalAllowed - let P := placement.layout.P - let u := placement.layout.u - let v := placement.layout.v have selectedOccurrenceRetarget := P5640T1NonpairedOccurrenceIntersections q cfg bundle.normalizedCircle F placement.layout placement.exteriorIndex placement.centralIndex originalAllowed (SelectedRowGeometry.noPairedOccurrence C D T N h k x bundle placement row) - let selectedPath : Prop := - (∃ selectedStart selectedEnd : GaussianInt, - SimpleGridPathBetween - (FootprintVertices - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintVertices - (SubtileOccurrenceInterpretation P u v placement.centralIndex)) - (FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.centralIndex)) - selectedStart selectedEnd ∧ - selectedEdge ∈ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.exteriorIndex) ∩ - FootprintEdges - (SubtileOccurrenceInterpretation P u v placement.centralIndex) ∧ - bundle.normalizedPoint ∈ selectedEdge) - let rightGeometry := fun (i j : Fin 3) (sgn : GaussianInt) - (firstSign secondSign : Bool) ↦ - let firstCompanion := TileTranslation F - (sgn * BandVectors.1 (q 0) (q i.succ)) - let secondCompanion := TileTranslation F - (sgn * BandVectors.1 (q 0) (q j.succ)) - let firstPiece := TileTranslation (placement.layout.P i firstSign) - placement.rightNeighborDisplacement - let secondPiece := TileTranslation (placement.layout.P j secondSign) - placement.rightNeighborDisplacement - ∃ firstBoundaryData : ExactTileInterfaceTriple F firstCompanion firstPiece, - ∃ secondBoundaryData : ExactTileInterfaceTriple F secondCompanion secondPiece, - ∃ firstData : ExactTileInterfaceTriple root F firstCompanion, - ∃ secondData : ExactTileInterfaceTriple root F secondCompanion, - firstBoundaryData.point = firstData.point ∧ - secondBoundaryData.point = secondData.point ∧ - LatticeTile root ∧ LatticeTile F ∧ LatticeTile firstCompanion ∧ - LatticeTile secondCompanion ∧ Disjoint root.cells firstCompanion.cells ∧ - Disjoint F.cells firstCompanion.cells ∧ - Disjoint root.cells secondCompanion.cells ∧ - Disjoint F.cells secondCompanion.cells ∧ - Disjoint firstCompanion.cells secondCompanion.cells ∧ - TouchingTriple root F firstCompanion ∧ - TouchingTriple root F secondCompanion ∧ - firstData.point ≠ secondData.point ∧ - secondData.point = firstData.otherAB ∧ - secondData.otherAB = firstData.point ∧ selectedPath have canonicalFinish := SelectedRowGeometry.canonicalFinish C D T N h k x bundle placement selectedEdge hedge edgeVertex blockCells fixedPositive touchingRetarget have coordinateFactsApos := SelectedRowGeometry.coordinateFactsApos @@ -4304,9 +4223,6 @@ theorem BandOrderedGeneralRightSelectedRowGeometry bundle placement (SelectedRowGeometry.outgoingSum C D T N h k x bundle turnOutgoing (SelectedRowGeometry.turnAdd) (SelectedRowGeometry.incomingSum C D T N h k x bundle)) period0 period1 - have castTripleOtherABSecond := SelectedRowGeometry.castTripleOtherABSecond - have castRoundTrip (P : ProtoTile → Type) {a b : ProtoTile} - (h : a = b) (z : P a) := SelectedRowGeometry.castRoundTrip P (a := a) (b := b) h z have packageGeometry := SelectedRowGeometry.packageGeometry C D T N h k x bundle placement selectedEdge edgeVertex (SelectedRowGeometry.geometryFields C D T N h k x bundle placement selectedEdge edgeVertex (SelectedRowGeometry.originalSelectedPath C D T N h k x bundle diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalRows.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalRows.lean index f5dabf5a9b..0f76433c9f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalRows.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalRows.lean @@ -160,11 +160,6 @@ theorem BandOrderedGeneralSubtileCanonicalRows have f1im := congrArg (fun z : GaussianInt => z.im) hf1 have f2re := congrArg (fun z : GaussianInt => z.re) hf2 have f2im := congrArg (fun z : GaussianInt => z.im) hf2 - have even0 : Even 0 := ⟨0, rfl⟩ - have notEven1 : ¬ Even 1 := by - rintro ⟨r, hr⟩ - omega - have even2 : Even 2 := ⟨1, rfl⟩ have notEven3 : ¬ Even 3 := by rintro ⟨r, hr⟩ omega diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean index e613c35b18..2a7bc8922f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean @@ -299,22 +299,11 @@ theorem BandOrderedGeneralSubtileCanonicalSeparation (TileTranslation T ((o.first : GaussianInt) * u + (o.second : GaussianInt) * v)).cells := GeneralSeparationProof.occurrence_subset_block P O T u v hOB hBlockCells o - have disjoint_of_blocks (a b : PeriodicSubtileIndex) - (hcoord : (a.first, a.second) ≠ (b.first, b.second)) : - Disjoint (SubtileOccurrenceInterpretation P u v a).cells - (SubtileOccurrenceInterpretation P u v b).cells := by - apply Finset.disjoint_left.2 - intro z hza hzb - exact (Finset.disjoint_left.1 (hblocks a.first a.second b.first b.second hcoord) - (occurrence_subset_block a hza) (occurrence_subset_block b hzb)) have root_occurrence_disjoint (o : PeriodicSubtileIndex) (hnonzero : (o.first, o.second) ≠ (0, 0)) : Disjoint T.cells (SubtileOccurrenceInterpretation P u v o).cells := GeneralSeparationProof.root_occurrence_disjoint P T u v hblocks occurrence_subset_block o hnonzero - have turn_map_injective : Function.Injective (fun z : LatticeCell => - GaussianTranslation g (GaussianQuarterTurn z - 1)) := - GeneralSeparationProof.turn_map_injective g have turn_mem (A : ProtoTile) (z : LatticeCell) (hz : z ∈ A.cells) : GaussianTranslation g (GaussianQuarterTurn z - 1) ∈ (TileTranslation (TileQuarterTurn A) g).cells := by diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean index ed8ff2a0d0..56eb892e75 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean @@ -404,6 +404,13 @@ end SubtileInterfacePreparation namespace SubtileInterfaceAssembly +private theorem transportedEndpoints {A B B' C : ProtoTile} (h : B = B') + (data : ExactTileInterfaceTriple A B' C) : + (h.symm ▸ data).point = data.point ∧ (h.symm ▸ data).otherCA = data.otherCA := by + cases h + exact ⟨rfl, rfl⟩ + + private theorem hUBand : (by classical @@ -886,40 +893,6 @@ private theorem hUbarCent : ) := by classical intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing uBar rowsAt quarterPower Ubar - let uIndex : PeriodicSubtileIndex := - if normalization.normalizedParentSlot = 0 then - if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 1, 1⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ - else ⟨.A, -1, -1⟩ - else if normalization.normalizedParentSlot = 1 then - if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, 0⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ - else ⟨.C, 1, 0⟩ - else if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 0, -1⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ - else ⟨.E, 0, 1⟩ - let vIndex : PeriodicSubtileIndex := - if normalization.normalizedParentSlot = 0 then - if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 0⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, 0⟩ - else ⟨.E, -1, 0⟩ - else if normalization.normalizedParentSlot = 1 then - if normalization.normalizedQuarterTurn = 0 then ⟨.E, 0, 1⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 0, -1⟩ - else ⟨.A, 0, -1⟩ - else if normalization.normalizedQuarterTurn = 0 then ⟨.A, -1, -1⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 1, 1⟩ - else ⟨.C, 1, 1⟩ - let U := SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v uIndex - let V := SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v vIndex rw [← quarterPower normalization.normalizedQuarterTurn (incoming normalization.normalizedParentSlot + outgoing normalization.normalizedParentSlot)] @@ -1196,40 +1169,6 @@ private theorem hVbarCent : (normalization.normalizedParentSlot - 1)))))) ) := by classical intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing hflips vBar rowsAt Vbar - let uIndex : PeriodicSubtileIndex := - if normalization.normalizedParentSlot = 0 then - if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 1, 1⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ - else ⟨.A, -1, -1⟩ - else if normalization.normalizedParentSlot = 1 then - if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, 0⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ - else ⟨.C, 1, 0⟩ - else if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 0, -1⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ - else ⟨.E, 0, 1⟩ - let vIndex : PeriodicSubtileIndex := - if normalization.normalizedParentSlot = 0 then - if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 0⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 1, 0⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, 0⟩ - else ⟨.E, -1, 0⟩ - else if normalization.normalizedParentSlot = 1 then - if normalization.normalizedQuarterTurn = 0 then ⟨.E, 0, 1⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 0, 1⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 0, -1⟩ - else ⟨.A, 0, -1⟩ - else if normalization.normalizedQuarterTurn = 0 then ⟨.A, -1, -1⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, -1⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 1, 1⟩ - else ⟨.C, 1, 1⟩ - let U := SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v uIndex - let V := SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v vIndex have hf0 : outgoing 0 = (⟨0, 1⟩ : GaussianInt) * incoming 0 := by simpa [outgoing, incoming] using (hflips 0).1 have hf1 : outgoing 1 = (⟨0, 1⟩ : GaussianInt) * incoming 1 := by @@ -1299,139 +1238,6 @@ private theorem hVbarCent : apply Zsqrtd.ext <;> simp [hf1, notEven3, Fin.sub_def, pow_succ] <;> ring -private theorem hWExact : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), - let Q := normalization.normalizedPresentation - let incoming : Fin 3 → GaussianInt := fun j => - BandVectors.1 (Q j.succ) (Q 0) - let outgoing : Fin 3 → GaussianInt := fun j => - BandVectors.1 (Q 0) (Q j.succ) - ∀ (wShift : GaussianInt), ∀ (W : ProtoTile), (W = TileTranslation - normalization.normalizedRoot wShift) → ((wShift = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ^ (↑normalization.normalizedQuarterTurn : ℕ) * if Even - (↑normalization.normalizedQuarterTurn : ℕ) then incoming - normalization.normalizedParentSlot else outgoing normalization.normalizedParentSlot) - → (W = TileTranslation normalization.normalizedRoot ((⟨0, 1⟩ : GaussianInt) ^ - normalization.normalizedQuarterTurn.val * (if Even - normalization.normalizedQuarterTurn.val then BandVectors.1 (Q - normalization.normalizedParentSlot.succ) (Q 0) else BandVectors.1 (Q 0) (Q - normalization.normalizedParentSlot.succ))))) ) := by - classical - intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing wShift W hW hwShift - rw [hW, hwShift] - -private theorem hincomingPoint : - (by - classical - exact - ∀ (C₀ Cᵢ : BandCircle) - (q : Fin (4 : ℕ) → CircleCoordinates) - (i : Fin (3 : ℕ)) (T₀ Tᵢ : ProtoTile) - (h₀ hᵢ : PartialOdometer) (x : GaussianInt) - (normalization : - BandOrderedGeneralSubtileNormalizationCertificate C₀ - Cᵢ q i T₀ Tᵢ h₀ hᵢ x), - let Q := normalization.normalizedPresentation; - ∀ (uIndex : PeriodicSubtileIndex) - (W : ProtoTile), - let source := - SubtileOccurrenceInterpretation - normalization.layout.P normalization.layout.u normalization.layout.v - uIndex; - ∀ - (incomingRaw : - ExactTileInterfaceTriple - normalization.normalizedRoot - (TileTranslation normalization.normalizedRoot - ({ re := (0 : ℤ), im := (1 : ℤ) } ^ - (↑normalization.normalizedQuarterTurn : ℕ) * - if Even (↑normalization.normalizedQuarterTurn : ℕ) then - BandVectors.1 - (Q normalization.normalizedParentSlot.succ) - (Q (0 : Fin (4 : ℕ))) - else - BandVectors.1 (Q (0 : Fin (4 : ℕ))) - (Q normalization.normalizedParentSlot.succ))) - source) - (hWExact : - W = - TileTranslation normalization.normalizedRoot - ({ re := (0 : ℤ), im := (1 : ℤ) } ^ - (↑normalization.normalizedQuarterTurn : ℕ) * - if Even (↑normalization.normalizedQuarterTurn : ℕ) then - BandVectors.1 - (Q normalization.normalizedParentSlot.succ) - (Q (0 : Fin (4 : ℕ))) - else - BandVectors.1 (Q (0 : Fin (4 : ℕ))) - (Q normalization.normalizedParentSlot.succ))), - let incomingData := Eq.symm hWExact ▸ incomingRaw; - incomingData.point = incomingRaw.point) := by - classical - intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q uIndex W source incomingRaw hWExact incomingData - dsimp [incomingData] - cases hWExact - rfl - -private theorem hincomingOtherCA : - (by - classical - exact - ∀ (C₀ Cᵢ : BandCircle) - (q : Fin (4 : ℕ) → CircleCoordinates) - (i : Fin (3 : ℕ)) (T₀ Tᵢ : ProtoTile) - (h₀ hᵢ : PartialOdometer) (x : GaussianInt) - (normalization : - BandOrderedGeneralSubtileNormalizationCertificate C₀ - Cᵢ q i T₀ Tᵢ h₀ hᵢ x), - let Q := normalization.normalizedPresentation; - ∀ (uIndex : PeriodicSubtileIndex) - (W : ProtoTile), - let source := - SubtileOccurrenceInterpretation - normalization.layout.P normalization.layout.u normalization.layout.v - uIndex; - ∀ - (incomingRaw : - ExactTileInterfaceTriple - normalization.normalizedRoot - (TileTranslation normalization.normalizedRoot - ({ re := (0 : ℤ), im := (1 : ℤ) } ^ - (↑normalization.normalizedQuarterTurn : ℕ) * - if Even (↑normalization.normalizedQuarterTurn : ℕ) then - BandVectors.1 - (Q normalization.normalizedParentSlot.succ) - (Q (0 : Fin (4 : ℕ))) - else - BandVectors.1 (Q (0 : Fin (4 : ℕ))) - (Q normalization.normalizedParentSlot.succ))) - source) - (hWExact : - W = - TileTranslation normalization.normalizedRoot - ({ re := (0 : ℤ), im := (1 : ℤ) } ^ - (↑normalization.normalizedQuarterTurn : ℕ) * - if Even (↑normalization.normalizedQuarterTurn : ℕ) then - BandVectors.1 - (Q normalization.normalizedParentSlot.succ) - (Q (0 : Fin (4 : ℕ))) - else - BandVectors.1 (Q (0 : Fin (4 : ℕ))) - (Q normalization.normalizedParentSlot.succ))), - let incomingData := Eq.symm hWExact ▸ incomingRaw; - incomingData.otherCA = incomingRaw.otherCA) := by - classical - intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q uIndex W source incomingRaw hWExact incomingData - dsimp [incomingData] - cases hWExact - rfl - private theorem hEndpoints : (by classical @@ -2011,15 +1817,12 @@ private theorem subtileInterfaceCertificate : BandVectors.1 (Q normalization.normalizedParentSlot.succ) (Q 0) else BandVectors.1 - (Q 0) (Q normalization.normalizedParentSlot.succ))) := - SubtileInterfaceAssembly.hWExact C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization wShift W - hW hwShift + (Q 0) (Q normalization.normalizedParentSlot.succ))) := by + rw [hW, hwShift] let incomingData : ExactTileInterfaceTriple normalization.normalizedRoot W source := hWExact.symm ▸ incomingRaw - have hincomingPoint := SubtileInterfaceAssembly.hincomingPoint C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x - normalization uIndex W incomingRaw hWExact - have hincomingOtherCA := SubtileInterfaceAssembly.hincomingOtherCA C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x - normalization uIndex W incomingRaw hWExact + have hincomingPoint := (SubtileInterfaceAssembly.transportedEndpoints hWExact incomingRaw).1 + have hincomingOtherCA := (SubtileInterfaceAssembly.transportedEndpoints hWExact incomingRaw).2 obtain ⟨startSource, hswapPoint, hswapOtherAB, hswapOtherBC, hswapOtherCA⟩ := ExactTileInterfaceTripleSwapLast normalization.normalizedRoot W source incomingData @@ -2148,8 +1951,6 @@ theorem BandOrderedGeneralSubtileInterfaceCertificateExists have occurrenceBand := SubtileInterfacePreparation.occurrenceBand C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization have quarterSymmetricTranslation := SubtileInterfaceGeometry.quarterSymmetricTranslation - have occurrenceSymmetric := SubtileInterfacePreparation.occurrenceSymmetric C₀ Cᵢ q i T₀ Tᵢ h₀ - hᵢ x normalization quarterSymmetricTranslation obtain ⟨g, hg, hrootBar, hrootAnchor, hrootFoot, hrootCentroid⟩ := QuarterTurnSymmetricCenteredTransport normalization.normalizedRoot normalization.root_quarter_turn @@ -2227,8 +2028,6 @@ theorem BandOrderedGeneralSubtileInterfaceCertificateExists (if Even normalization.normalizedQuarterTurn.val then incoming normalization.normalizedParentSlot else outgoing normalization.normalizedParentSlot) - let U := SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v uIndex let V := SubtileOccurrenceInterpretation normalization.layout.P normalization.layout.u normalization.layout.v vIndex let W := TileTranslation normalization.normalizedRoot wShift diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean index fa7d7b4286..3dca62a842 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileNormalizationCertificateExists.lean @@ -222,72 +222,6 @@ private theorem hqbarᵢPos : have hnl := cfg.noLine ibar.succ omega -private theorem hadjbar : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), - ∀ (h₀ : PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (r : Fin (3 : ℕ)), ∀ (g : - BandPackingSymmetry), - let qrot : Fin 4 → CircleCoordinates := - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] - let irot : Fin 3 := i - r - let qbar := BandPackingSymmetryQuadrupleAction g qrot - ∀ (hqbar : ProperBandQuadruple qbar), ∀ (p₀bar : ℝ × ℝ), ∀ (pᵢbar : ℝ × ℝ), ∀ (sbar : Fin - (4 : ℕ)), (TileOdometer (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) - (BandPackingSymmetryTileAction g T₀) (BandPackingSymmetryPartialOdometerAction g h₀)) - → ((TileOdometer (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) - => if BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ) - (BandPackingSymmetryTileAction g Tᵢ) (BandPackingSymmetryPartialOdometerAction g hᵢ)) - → ((PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g h₀) = some - p₀bar) → ((PartialOdometerSlope (BandPackingSymmetryPartialOdometerAction g hᵢ) = - some pᵢbar) → ((TileCentroid (BandPackingSymmetryTileAction g Tᵢ) - TileCentroid - (BandPackingSymmetryTileAction g T₀) = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 - : ℤ)⟩ : GaussianInt) ^ (↑sbar : ℕ) * (BandVectors.1 - (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ) - (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) + BandVectors.1 - (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ)))) → - ((pᵢbar.1 - p₀bar.1 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt)) ^ (↑sbar : ℕ) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction g - qrot ((fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true - then -j else j) irot).succ) (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : - ℕ))) + BandVectors.2 (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ)))).1) → - ((pᵢbar.2 - p₀bar.2 = ((1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt)) ^ (↑sbar : ℕ) * (BandVectors.2 (BandPackingSymmetryQuadrupleAction g - qrot ((fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true - then -j else j) irot).succ) (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : - ℕ))) + BandVectors.2 (BandPackingSymmetryQuadrupleAction g qrot (0 : Fin (4 : ℕ))) - (BandPackingSymmetryQuadrupleAction g qrot ((fun (j : Fin (3 : ℕ)) => if - BandPackingSymmetryReversesOrientation g = true then -j else j) irot).succ)))).2) → ( - let reverse := BandPackingSymmetryReversesOrientation g - let ibar : Fin 3 := if reverse then -irot else irot - let T₀bar := BandPackingSymmetryTileAction g T₀ - let Tᵢbar := BandPackingSymmetryTileAction g Tᵢ - let h₀bar := BandPackingSymmetryPartialOdometerAction g h₀ - let hᵢbar := BandPackingSymmetryPartialOdometerAction g hᵢ - ∀ (hqbar₀Pos : 0 < (qbar 0).1), ∀ (hqbarᵢPos : 0 < (qbar ibar.succ).1), - let C₀bar : BandCircle := - ⟨⟨qbar 0, ⟨Or.inl hqbar₀Pos, ⟨qbar, hqbar.1, ⟨0, rfl⟩⟩⟩⟩, hqbar₀Pos⟩ - let Cᵢbar : BandCircle := - ⟨⟨qbar ibar.succ, - ⟨Or.inl hqbarᵢPos, ⟨qbar, hqbar.1, ⟨ibar.succ, rfl⟩⟩⟩⟩, - hqbarᵢPos⟩ - SubtileLatticeAdjacent C₀bar Cᵢbar T₀bar Tᵢbar h₀bar hᵢbar))))))) ) := by - classical - intro q i T₀ Tᵢ h₀ hᵢ r g qrot irot qbar hqbar p₀bar pᵢbar sbar hO₀bar hOᵢbar hp₀bar hpᵢbar - hcentroidBar hslopexBar hslopeyBar reverse ibar T₀bar Tᵢbar h₀bar hᵢbar hqbar₀Pos hqbarᵢPos - C₀bar Cᵢbar - refine ⟨hO₀bar, hOᵢbar, p₀bar, pᵢbar, hp₀bar, hpᵢbar, - qbar, ibar, sbar, hqbar, rfl, rfl, ?_, ?_, ?_⟩ - · simpa [qbar, reverse, ibar] using hcentroidBar - · simpa [qbar, reverse, ibar] using hslopexBar - · simpa [qbar, reverse, ibar] using hslopeyBar - private theorem hsmallT1 : (by classical @@ -1029,8 +963,6 @@ theorem BandOrderedGeneralSubtileNormalizationCertificateExists let qbar := BandPackingSymmetryQuadrupleAction g qrot have hqbar : ProperBandQuadruple qbar := BandPackingSymmetryProperCovariance g qrot hqrot - have hqbar₀ : qbar 0 = BandPackingSymmetryCircleAction g C₀.1.1 := by - simp [qbar, qrot, BandPackingSymmetryQuadrupleAction, hq₀] have hgeneral : Nonempty (BandOrderedGeneralConfiguration qbar) := SubtileNormalizationGeometry.hgeneral C₀ q horbit hq₀ r g hregime obtain ⟨cfg⟩ := hgeneral @@ -1084,9 +1016,12 @@ theorem BandOrderedGeneralSubtileNormalizationCertificateExists have hx₀bar : xbar ∈ h₀bar.domain := BandPackingSymmetryDomainTransport.forward g h₀ x hx₀ have hxᵢbar : xbar ∈ hᵢbar.domain := BandPackingSymmetryDomainTransport.forward g hᵢ x hxᵢ have hadjbar : SubtileLatticeAdjacent C₀bar Cᵢbar - T₀bar Tᵢbar h₀bar hᵢbar := SubtileNormalizationGeometry.hadjbar q i T₀ Tᵢ h₀ hᵢ r g hqbar - p₀bar pᵢbar sbar hO₀bar hOᵢbar hp₀bar hpᵢbar hcentroidBar hslopexBar hslopeyBar - hqbar₀Pos hqbarᵢPos + T₀bar Tᵢbar h₀bar hᵢbar := by + refine ⟨hO₀bar, hOᵢbar, p₀bar, pᵢbar, hp₀bar, hpᵢbar, + qbar, ibar, sbar, hqbar, rfl, rfl, ?_, ?_, ?_⟩ + · simpa [qbar, reverse, ibar] using hcentroidBar + · simpa [qbar, reverse, ibar] using hslopexBar + · simpa [qbar, reverse, ibar] using hslopeyBar have hT₀barBand : BandPrototile (qbar 0) T₀bar := TileOdometerBandPrototile _ _ _ hO₀bar have hTᵢbarBand : BandPrototile (qbar ibar.succ) Tᵢbar := diff --git a/LeanPool/ApollonianSuperharmonic/BandOriginalPairSeparation.lean b/LeanPool/ApollonianSuperharmonic/BandOriginalPairSeparation.lean index 0a098daf5c..b10ed84ffd 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOriginalPairSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOriginalPairSeparation.lean @@ -55,19 +55,6 @@ theorem BandOriginalPairSeparation (P : Fin 3 -> Bool -> ProtoTile) (P 0 false).cells.image (GaussianTranslation ((m : GaussianInt) * u + (n : GaussianInt) * v)) := by rfl - have original_cells (o : PeriodicSubtileIndex) : - (SubtileOccurrenceInterpretation P u v o).cells = - (match o.label with - | .A => (P 0 true).cells - | .B => (P 0 false).cells - | .C => (P 1 true).cells - | .D => (P 1 false).cells - | .E => (P 2 true).cells - | .F => (P 2 false).cells).image - (GaussianTranslation ((o.first : GaussianInt) * u + (o.second : GaussianInt) * v)) := by - cases o with - | mk label first second => - cases label <;> rfl constructor · intro m n apply Finset.ext diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean index 6965743e79..3a10b27eaa 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean @@ -1122,23 +1122,15 @@ private theorem finiteCompanion : classical intro L rev delta s a a' hneg hquarter hphase dsimp - let s' : Fin 4 := if rev then -s - 1 + (if delta then 2 else 0) - else s + (if delta then 2 else 0) have qm (z : GaussianInt) : GaussianQuarterTurn z = (⟨0, 1⟩ : GaussianInt) * z := by ext <;> simp [GaussianQuarterTurn] - have p0 (z : GaussianInt) : (⟨0, 1⟩ : GaussianInt)^0 * z = z := by simp - have p1 (z : GaussianInt) : (⟨0, 1⟩ : GaussianInt)^1 * z = - GaussianQuarterTurn z := by simpa using (qm z).symm have unit2 : (⟨0, 1⟩ : GaussianInt)^2 = -1 := by simp only [pow_two] ext <;> norm_num have unit3 : (⟨0, 1⟩ : GaussianInt)^3 = -⟨0, 1⟩ := by rw [pow_succ, unit2] norm_num - have q2 (z : GaussianInt) : - GaussianQuarterTurn (GaussianQuarterTurn z) = -z := by - ext <;> simp [GaussianQuarterTurn] have qneg (z : GaussianInt) : GaussianQuarterTurn (-z) = -GaussianQuarterTurn z := by ext <;> simp [GaussianQuarterTurn] @@ -1154,7 +1146,6 @@ private theorem finiteCompanion : _ = -GaussianQuarterTurn z := by rw [qm] have ev0 : Even 0 := ⟨0, by omega⟩ have ev2 : Even 2 := ⟨1, by omega⟩ - have odd1 : ¬ Even 1 := by rintro ⟨r, hr⟩; omega have odd3 : ¬ Even 3 := by rintro ⟨r, hr⟩; omega cases hrev : rev <;> cases hdel : delta <;> fin_cases s all_goals @@ -1260,7 +1251,6 @@ private theorem hphase : ) := by classical intro g q i delta hdelta q' sigma a a' - let b' := BandVectors.1 (q' 0) (q' (sigma i).succ) have hh := hdelta i dsimp [BandPackingSymmetryScopedPhase, sigma, a', a] at hh cases delta <;> simpa using hh.1 @@ -1547,12 +1537,7 @@ private theorem forwardSub : let Z : GaussianInt × GaussianInt := (W, A) let M : GaussianInt × GaussianInt := (W - GaussianQuarterTurn W, A + GaussianQuarterTurn A) - let W' := BandVectors.1 (q' ((sigma i + 2).succ)) - (q' ((sigma i + 1).succ)) - let A' := BandVectors.2 (q' ((sigma i + 2).succ)) - (q' ((sigma i + 1).succ)) let eReal : ℝ := if e then 1 else -1 - let deltaReal : ℝ := if delta then -1 else 1 let k : ℝ := eReal / 2 have hcentM := MarkedCovarianceGeometry.hcentM T T' q i e hcent have hWphase := MarkedCovarianceGeometry.hWphase g q i delta hphase @@ -1575,12 +1560,9 @@ private theorem forwardSub : rw [circleCurvature, ← hqC'] exact hzero · right - have hnonneg := (ProperBandCurvatureStructure q hq).2.1 i - have hpos : 0 < (q i.succ).1 := by omega rcases hslope with hz | ⟨p, p', hsp, hsp', hRe, hIm⟩ · have heq := congrArg Prod.fst hqC' exact False.elim (hzero (by simpa [heq] using hz)) - have hposC := MarkedCovarianceGeometry.hposC C q hq hqC have hTne := positiveSupport C T h p hO hsp have heq := congrArg Prod.fst hqC' have hT'ne := positiveSupport C' T' h' p' hO' hsp' @@ -1669,10 +1651,6 @@ theorem BandPackingSymmetryMarkedDataCovariance : have starCov := MarkedCovarianceGeometry.starCov negStar conjugateStar have partialValueCov := MarkedCovarianceGeometry.partialValueCov have differenceTransport := P5625T1CentroidSlopeDifferenceCovariance.2 - let affineQuarter : GaussianInt × GaussianInt → GaussianInt × GaussianInt := - fun z => (GaussianQuarterTurn z.1, -GaussianQuarterTurn z.2) - have affineQuarterNeg (z : GaussianInt × GaussianInt) := - MarkedCovarianceGeometry.affineQuarterNeg z have affineFacts := MarkedCovarianceGeometry.affineFacts have affineFirst := MarkedCovarianceGeometry.affineFirst have circleCurvature := MarkedCovarianceGeometry.circleCurvature @@ -1710,7 +1688,6 @@ theorem BandPackingSymmetryMarkedDataCovariance : let b := BandVectors.1 (q 0) (q i.succ) let a' := BandVectors.1 (q' (sigma i).succ) (q' 0) let b' := BandVectors.1 (q' 0) (q' (sigma i).succ) - let epsilon : GaussianInt := if delta then -1 else 1 let d := (⟨0, 1⟩ : GaussianInt)^s.val * (if Even s.val then b else a) let d' := (⟨0, 1⟩ : GaussianInt)^s'.val * (if Even s'.val then b' else a') diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean index 656b84347a..071903c87c 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryT3T5Covariance.lean @@ -886,8 +886,6 @@ theorem BandPackingSymmetryT3T5Covariance : have quarter_translate := PackingCovarianceProof.quarter_translate have qtwo := PackingCovarianceProof.qtwo -- Two centered integral quarter-turns give a common centered half-turn. - let H (w : GaussianInt) (A : ProtoTile) := - TileTranslation (TileQuarterTurn (TileQuarterTurn A)) w have half_translate := PackingCovarianceProof.half_translate translate_add quarter_translate qtwo have half_cov := PackingCovarianceProof.half_cov have half_center := PackingCovarianceProof.half_center etrans etranslate equarter translate_add diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean index 906f5c45bf..0245a7eca2 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean @@ -480,8 +480,6 @@ private theorem hcorner : add_zero] at hdx have hd1 : d1 = wr * v.re + wi * v.im := by simpa [d1] using hdx0 - have hd2 : d2 = -wr * v.im + wi * v.re := by - simpa [d2] using hdy0 have hv : BandPackingShiftPotential ⟨wr, wi⟩ (v + ⟨0, 1⟩) = BandPackingShiftPotential ⟨wr, wi⟩ v + d2 := by dsimp [d2] @@ -988,8 +986,6 @@ private theorem hT' : s).cells) → (BandPrototile (q' 0) (B a U))) ) := by classical intro U q hT a Q B q' cov - let sigma : Fin 3 → Fin 3 := fun i => - if BandPackingSymmetryReversesOrientation a then -i else i have ht := cov.2.1 (q 0) U have ht' := ht.mp hT simpa [q', Q, B, BandPackingSymmetryQuadrupleAction] using ht' @@ -1085,7 +1081,6 @@ private theorem hdom' : exact ⟨x, hxs, rfl⟩ · rintro ⟨j, s, hy⟩ let p := e.symm (j, s) - have hp : e p = (j, s) := e.apply_symm_apply (j, s) change y ∈ ((P a (hs p.1 p.2)).domain : Set GaussianInt) at hy rw [(BandPackingSymmetryPartialOdometerActionFormulas a (hs p.1 p.2) (hs p.1 p.2)).1] at hy @@ -1603,10 +1598,6 @@ private theorem hpsi : BandPackingShiftPotential (⟨wr, wi⟩ : GaussianInt) v⟩ : GaussianInt).im * v.im) ) := by classical intro z wr wi v hcorner r hr - let d1 := BandPackingShiftPotential ⟨wr, wi⟩ (v + 1) - - BandPackingShiftPotential ⟨wr, wi⟩ v - let d2 := BandPackingShiftPotential ⟨wr, wi⟩ (v + ⟨0, 1⟩) - - BandPackingShiftPotential ⟨wr, wi⟩ v exact TileOdometerSymmetryProof.hpsi z wr wi v hcorner r hr @@ -1763,9 +1754,6 @@ private theorem unitSymmetry : | negate => rcases htrans with ⟨v, a0, b0, hvdom, hvval⟩ let I : GaussianInt := ⟨0, 1⟩ - let vn := GaussianQuarterTurn v - 1 - let an := GaussianQuarterTurn a0 + ⟨0, z.im⟩ - let bn := b0 - z.im * vn.im have hcell : (TileQuarterTurn U).cells = {GaussianQuarterTurn x - 1} := TileOdometerSymmetryProof.hcellAt653 U x hU have hdomain := TileOdometerSymmetryProof.hdomainAt657 U k hdom @@ -1786,9 +1774,6 @@ private theorem unitSymmetry : | conjugate => rcases htrans with ⟨v, a0, b0, hvdom, hvval⟩ let I : GaussianInt := ⟨0, 1⟩ - let vk := -GaussianReflection v - 1 - let ak := -GaussianReflection a0 + ⟨0, z.im⟩ - let bk := b0 - z.im * vk.im have hcell : (BandPackingSymmetryTileAction .conjugate U).cells = {-GaussianReflection x - 1} := TileOdometerSymmetryProof.hcellAt753 U x hU @@ -1855,10 +1840,6 @@ theorem BandPackingSymmetryTileOdometerCovariance have circleCurvature := TileOdometerSymmetryProof.circleCurvature have extractUnit := TileOdometerSymmetryProof.extractUnit have differenceTransport := TileOdometerSymmetryProof.differenceTransport - let symmetryMix : Bool → GaussianInt × GaussianInt → GaussianInt × GaussianInt := - fun r z => if r then - (z.1 + GaussianQuarterTurn z.1, z.2 - GaussianQuarterTurn z.2) - else (z.1 - GaussianQuarterTurn z.1, z.2 + GaussianQuarterTurn z.2) have affineMix := TileOdometerSymmetryProof.affineMix have transform : ∀ (D : CircleCoordinates) (U : ProtoTile) (k : PartialOdometer), TileOdometer D U k → ∀ a : BandPackingSymmetry, @@ -1878,7 +1859,6 @@ theorem BandPackingSymmetryTileOdometerCovariance | @decompose q hq S U hs h hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope ih => intro a let Q := BandPackingSymmetryQuadrupleAction - let A := BandPackingSymmetryCircleAction let B := BandPackingSymmetryTileAction let P := BandPackingSymmetryPartialOdometerAction let q' := Q a q @@ -1903,7 +1883,6 @@ theorem BandPackingSymmetryTileOdometerCovariance have hfoot' : ∀ i s, FootprintVertices (S' i s) ⊆ FootprintVertices (B a U) := fun i s => (hocc' i s).2.1 have hcentroid' := TileOdometerAssembly.hcentroid' U q a S' hocc' - have hcompatInput := BandPackingSymmetryPartialOdometerActionFormulas a h h obtain ⟨negative, hphaseAffine, hvecAffine⟩ := BandPackingSymmetryAffineVectorCovariance a q hq have hphaseEq := TileOdometerAssembly.hphaseEq q hq a delta hphase negative hphaseAffine diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean index 80004e9232..3697cbe1e9 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean @@ -369,9 +369,6 @@ private theorem conjugation : have image_subsingleton (f : GaussianInt → GaussianInt) (hf : Function.Injective f) (A B : Set GaussianInt) := TilingTransportProof.image_subsingletonAt247 f hf A B - have reflection_injective : Function.Injective - (fun z : GaussianInt => -GaussianReflection z) := - TilingTransportDetails.reflection_injective refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ · intro T exact ((TileDiskAreaCovariance T 0).2.2.1).trans diff --git a/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean b/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean index cbb58b91c5..036698a11f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPeriodicSuperharmonicity.lean @@ -426,7 +426,6 @@ theorem BandPeriodicSuperharmonicity (C : BandCircle) have hcross : |b.1 * x.re + b.2 * x.im| ≤ ε / 4 * ((x.re : ℝ)^2 + (x.im : ℝ)^2) + (b.1^2 + b.2^2) / ε := PeriodicSuperharmonicGeometry.hcross b ε hε x - have hnon : 0 ≤ (x.re : ℝ)^2 + (x.im : ℝ)^2 := by positivity have hbase : |(g x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x| ≤ ε / 2 * ((x.re : ℝ)^2 + (x.im : ℝ)^2) + K := PeriodicSuperharmonicGeometry.hbase C g b R hvals ε hε x r hF hM hcross diff --git a/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean b/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean index 45051016d7..2f5b54274a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPositiveCutBranchCompanionExclusion.lean @@ -1345,7 +1345,6 @@ private theorem fourthParentExclusion : hI3 hI2mul hOcent hQ2cent hQ3cent hS2cent hS3cent hPminus gaussianPoint_neg gaussianPoint_Iminus_one hsumGaussianPointFst hsumGaussianPointSnd hp4 let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) - let w : GaussianInt := BandVectors.1 (q 3) (q 2) let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) have hf4 := (VectorRecursionLaws birth hproper.1).2.2.2.2 hproper have hforward2 : BandVectors.1 (birth 0) (birth 2) = I * u := by @@ -1530,7 +1529,6 @@ theorem BandPositiveCutBranchCompanionExclusion have hI2mul : I * I = -1 := by dsimp [I]; decide let u : GaussianInt := BandVectors.1 (q 2) (cfg.firstPredecessor 1) let w : GaussianInt := BandVectors.1 (q 3) (q 2) - let t : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) have hOcent := PositiveCutExclusionGeometry.hOcent q cfg C₀ T cert occurrence_centroid have hQ2cent := PositiveCutExclusionGeometry.hQ2cent q cfg C₀ T cert occurrence_centroid diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileCentroidUnique.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileCentroidUnique.lean index 79e4c3f44b..815c4f081a 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileCentroidUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileCentroidUnique.lean @@ -57,10 +57,7 @@ theorem BandPrototileCentroidUnique (C : CircleCoordinates) (T U : ProtoTile) have child0 := hp.2 0 have child1 := hp.2 1 have child2 := hp.2 2 - have non0 := nonnegative r hr 0 have non1 := nonnegative r hr 1 - have non2 := nonnegative r hr 2 - have non3 := nonnegative r hr 3 dsimp at h child0 child1 child2 omega let property : CircleCoordinates → ProtoTile → Prop := fun D V => diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean index a397f4f03e..fe2586bcb8 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileExists.lean @@ -101,9 +101,6 @@ private theorem hqbase : + 1).succ, q (r + 2).succ])) ) := by classical intro q hproper r g regime - let q' : Fin 4 → CircleCoordinates := - BandPackingSymmetryQuadrupleAction g - ![q 0, q r.succ, q (r + 1).succ, q (r + 2).succ] fin_cases r · have heq : ![q 0, q 1, q 2, q 3] = q := by funext i diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileReindexedDecomposition.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileReindexedDecomposition.lean index d6f531e4de..4255782892 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileReindexedDecomposition.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileReindexedDecomposition.lean @@ -53,10 +53,7 @@ theorem BandPrototileReindexedDecomposition (q : Fin 4 → CircleCoordinates) · simpa using hp.2 1 | @successor r hr ih => intro h hp - have a := nonnegative r hr 0 have b := nonnegative r hr 1 - have c := nonnegative r hr 2 - have d := nonnegative r hr 3 have h1 := hp.2 0 have h2 := hp.2 1 have h3 := hp.2 2 diff --git a/LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean b/LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean index 4da9aaa2d0..046705083f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPrototileTranslationNormalForm.lean @@ -69,10 +69,7 @@ private theorem noProperUnit : · simpa using hp.2 1 | @successor r hr ih => intro h hp - have a := nonnegative r hr 0 have b := nonnegative r hr 1 - have c := nonnegative r hr 2 - have d := nonnegative r hr 3 have h1 := hp.2 0 have h2 := hp.2 1 have h3 := hp.2 2 @@ -179,7 +176,6 @@ theorem BandPrototileTranslationNormalForm (C : CircleCoordinates) · intro q' hq' S' V' hS' hcells' hfoot' hcentroid' ih' hC have hbad := hq'.2 0 have hnon := nonnegative q' hq'.1 1 - have hnon' : 0 ≤ (q' 1).1 := by simpa using hnon rw [hC] at hbad have hbad' : (q' 1).1 < 0 := by simpa using hbad have : False := by omega diff --git a/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean b/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean index 1ae6303ec0..040313979c 100644 --- a/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean +++ b/LeanPool/ApollonianSuperharmonic/BandRegularTranslatePeriodicComplex.lean @@ -131,126 +131,6 @@ private theorem hc1 : have he := hc.2.2 0 1 (hz 0) (hz 1) norm_num at he -private theorem hne : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), (1 < (q 0).1) → ((LatticeTile T ∧ - TileArea T = (q (0 : Fin (4 : ℕ))).1.toNat ∧ (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), - (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : - LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → ∀ (i - : Fin (3 : ℕ)), ∀ (s : Bool), LatticeTile (TileCellComplement T (S i s)) ∧ - TileTouching (TileCellComplement T (S i s)) (S i s)) ∧ QuarterTurnSymmetric T ∧ ((1 : - ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), TouchingTriple T (TileTranslation - T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation T - (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) ∧ ((1 : ℤ) - < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile (q - i.succ) U → TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 - (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple T (TileTranslation T - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (U : - ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → BandPrototile (q (i + (1 - : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • - (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V - - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin - (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin - (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple T U V) ∧ ∀ (r : Fin (4 - : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin - (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : - Fin (4 : ℕ)) → (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → (q (3 : Fin (4 : - ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → ∀ (P : Fin (3 - : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) - → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i - s (P i s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ - (P i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : - Fin (3 : ℕ)) true) i s (Q i s)) → (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) - true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (Q i s).cells) → (∀ (i : Fin (3 : - ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : Fin (3 : ℕ)) false) i s (S i s)) → - (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s - : Bool), x ∈ (S i s).cells) → - let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); - let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); (∀ (a : - PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)).Nonempty → AllowedSubtileIncidence a b) ∧ - (¬AllowedSubtileIncidence a b → FootprintVertices (SubtileOccurrenceInterpretation P - u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ - (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ FootprintVertices (P (0 : - Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ⊆ FootprintVertices - (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ - FootprintVertices (P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (0 : Fin (3 : ℕ)) - false) ⊆ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin - (3 : ℕ)) false) ∪ FootprintVertices (Q (0 : Fin (3 : ℕ)) false) ∪ FootprintVertices - (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → - (T.cells.Nonempty)) ) := by - classical - intro q T hc1 hgeom - apply Finset.card_pos.mp - have harea : T.cells.card = Int.toNat (q 0).1 := hgeom.2.1 - omega - -private theorem htu : - (by - classical - exact - ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (k : ℤ × ℤ ≃+ - ↥(TilingLattice C)), (1 < (q 0).1) → ((LatticeTile T ∧ TileArea T = (q (0 : Fin (4 : - ℕ))).1.toNat ∧ (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : - Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ - (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), - LatticeTile (TileCellComplement T (S i s)) ∧ TileTouching (TileCellComplement T (S i - s)) (S i s)) ∧ QuarterTurnSymmetric T ∧ ((1 : ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : - Fin (3 : ℕ)), TouchingTriple T (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : - Fin (4 : ℕ))))) (TileTranslation T (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) - (q (0 : Fin (4 : ℕ)))))) ∧ ((1 : ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), - ∀ (U : ProtoTile), BandPrototile (q i.succ) U → TileCentroid U - TileCentroid T = (1 - / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple - T (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ (∀ (i : - Fin (3 : ℕ)), ∀ (U : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → - BandPrototile (q (i + (1 : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = - (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V - - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin - (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin - (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple T U V) ∧ ∀ (r : Fin (4 - : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin - (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : - Fin (4 : ℕ)) → (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → (q (3 : Fin (4 : - ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → ∀ (P : Fin (3 - : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) - → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i - s (P i s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ - (P i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : - Fin (3 : ℕ)) true) i s (Q i s)) → (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) - true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (Q i s).cells) → (∀ (i : Fin (3 : - ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : Fin (3 : ℕ)) false) i s (S i s)) → - (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s - : Bool), x ∈ (S i s).cells) → - let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); - let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); (∀ (a : - PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)).Nonempty → AllowedSubtileIncidence a b) ∧ - (¬AllowedSubtileIncidence a b → FootprintVertices (SubtileOccurrenceInterpretation P - u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ - (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ FootprintVertices (P (0 : - Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ⊆ FootprintVertices - (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ - FootprintVertices (P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (0 : Fin (3 : ℕ)) - false) ⊆ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin - (3 : ℕ)) false) ∪ FootprintVertices (Q (0 : Fin (3 : ℕ)) false) ∪ FootprintVertices - (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → (((k - (1, 0) : GaussianInt) = BandVectors.1 (q 1) (q 0)) → (((k (0, 1) : GaussianInt) = - BandVectors.1 (q 2) (q 0)) → (TouchingTriple T (TileTranslation T (k (1, 0) : - GaussianInt)) (TileTranslation T (-(k (0, 1) : GaussianInt))))))) ) := by - classical - intro C q T k hc1 hgeom ka kb - simpa [ka, kb] using hgeom.2.2.2.2.1 hc1 0 - private theorem fs_zero : (by classical @@ -599,15 +479,18 @@ theorem BandRegularTranslatePeriodicComplex (C : BandCircle) have hc := ProperBandCurvatureStructure q hq have hc1 : 1 < (q 0).1 := RegularPeriodicGeometry.hc1 q hq hc have hgeom := BandTileSimultaneousInduction q hq T hT - have hne : T.cells.Nonempty := RegularPeriodicGeometry.hne q T hc1 hgeom + have hne : T.cells.Nonempty := by + apply Finset.card_pos.mp + have harea : T.cells.card = Int.toNat (q 0).1 := hgeom.2.1 + omega have ka : (k (1, 0) : GaussianInt) = BandVectors.1 (q 1) (q 0) := by simp [hk] have kb : (k (0, 1) : GaussianInt) = BandVectors.1 (q 2) (q 0) := by simp [hk] have htu : TouchingTriple T (TileTranslation T (k (1, 0) : GaussianInt)) - (TileTranslation T (-(k (0, 1) : GaussianInt))) := RegularPeriodicGeometry.htu C q T k hc1 - hgeom ka kb + (TileTranslation T (-(k (0, 1) : GaussianInt))) := by + simpa [ka, kb] using hgeom.2.2.2.2.1 hc1 0 have htd := P4812T1ReflectedTouching T (k (1, 0)) (k (0, 1)) hne hgeom.2.2.2.1 htu let fs (u : TilingLattice C) (f : D.plane.Face) := diff --git a/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean b/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean index a88d2d498b..cf1101555e 100644 --- a/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean +++ b/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean @@ -57,7 +57,6 @@ private theorem curvatureBound : rw [hz] simp · have curv := ProperBandCurvatureStructure r old - have hpos : 0 < (r 0).1 := curv.1 have h1 : (r 1).1 < (r 0).1 := old.2 0 have h2lt : (r 2).1 < (r 0).1 := old.2 1 have h3lt : (r 3).1 < (r 0).1 := old.2 2 @@ -71,7 +70,6 @@ private theorem curvatureBound : have hz2 : (r 2).1 = 0 := by omega have hz3 : (r 3).1 = 0 := by omega have e : (1 : Fin 3) = 2 := curv.2.2 1 2 hz2 hz3 - have ev := congrArg Fin.val e omega have hlarge0 : 4 ≤ (r 0).1 := by rcases ih 0 with hz | hone | hlarge @@ -121,11 +119,7 @@ private theorem buildConfiguration : have hn : (p 2).1 ≠ 0 := by simpa [h2] using hnl 2 omega have hu0large : 4 < (u 0).1 := by - have hp0 : 0 < (p 0).1 := by - have hn : (p 0).1 ≠ 0 := by simpa [h0] using hnl 1 - omega have hp1lt : (p 1).1 < (p 0).1 := by simpa using hp.2 0 - have hp2lt : (p 2).1 < (p 0).1 := by simpa using hp.2 1 have hp3lt : (p 3).1 < (p 0).1 := by simpa using hp.2 2 have hf := congrArg (fun z : Fin 4 → CircleCoordinates => (z 0).1) hs simp at hf @@ -191,11 +185,6 @@ private theorem hq0large : (p 3).1) → ((0 < (p 2).1) → (4 < (q 0).1)))))))))))) := by classical intro q hnoLine positiveLarge p hp hsucc h0 hlt cq cp hp1nonneg' hp1lt' hp3 hp2 - have hp0 : 0 < (p 0).1 := by - have hn : (p 0).1 ≠ 0 := by simpa [h0] using hnoLine 1 - omega - have hp1nonneg := cp.2.1 0 - have hp1lt := hp.2 0 have hqformula := congrArg (fun z : Fin 4 → CircleCoordinates => (z 0).1) hsucc simp only [Fin.isValue, Nat.succ_eq_add_one, Nat.reduceAdd, Matrix.cons_val_zero] @@ -392,7 +381,6 @@ private theorem hp3 : classical intro q hnoLine p h3 cp hp3nonneg' have hn : (p 3).1 ≠ 0 := by simpa [h3] using hnoLine 3 - have hn' : 0 ≤ (p 3).1 := by simpa using cp.2.1 2 omega private theorem hp2 : @@ -404,8 +392,6 @@ private theorem hp2 : (0 < (p 2).1)))))) := by classical intro q hnoLine p h2 hlt cp hp2nonneg' hp3 - have hn : (p 2).1 ≠ 0 := by simpa [h2] using hnoLine 2 - have hn' : 0 ≤ (p 2).1 := by simpa using cp.2.1 1 omega private theorem hq2large : @@ -1059,9 +1045,6 @@ private theorem firstParentCase : have hp1lt' : (p 1).1 < (p 0).1 := by simpa using hp.2 0 have hp2nonneg' : 0 ≤ (p 2).1 := by simpa using cp.2.1 1 have hp3nonneg' : 0 ≤ (p 3).1 := by simpa using cp.2.1 2 - have hq2nonneg := cq.2.1 1 - have hp2nonneg := cp.2.1 1 - have hp3nonneg := cp.2.1 2 have hp3 := RetainedBoundaryDetails.hp3 q hnoLine p h3 cp hp3nonneg' have hp2 := RetainedBoundaryDetails.hp2 q hnoLine p h2 hlt cp hp2nonneg' hp3 have hq0large := RetainedBoundaryProof.hq0large q hnoLine positiveLarge p @@ -1109,8 +1092,6 @@ private theorem firstParentCase : have hs' := RetainedBoundaryProof.hs'At413 q p hsucc negOneSucc negTwoSucc have negOne : (-1 : Fin 3) = 2 := by decide have negTwo : (-2 : Fin 3) = 1 := by decide - let reflect : CircleCoordinates → CircleCoordinates := - fun C => (C.1, GaussianReflection C.2) have h0' := RetainedBoundaryDetails.h0'At562 q p h0 negOne negTwo have h2' := RetainedBoundaryDetails.h2'At566 q p h3 negOne negTwo have h3' := RetainedBoundaryDetails.h3'At570 q p h2 negOne negTwo @@ -1205,8 +1186,6 @@ private theorem secondParentCase : have negOneSucc : (-1 : Fin 3).succ = 3 := by decide have negTwoSucc : (-2 : Fin 3).succ = 2 := by decide have hs' := RetainedBoundaryProof.hs'At528 q p hsucc negOneSucc negTwoSucc - let reflect : CircleCoordinates → CircleCoordinates := fun C => (C.1, GaussianReflection - C.2) have h0' := RetainedBoundaryDetails.h0'At670 q p h0 negOneSucc negTwoSucc have h2' := RetainedBoundaryDetails.h2'At673 q p h3 negOneSucc negTwoSucc have h3' := RetainedBoundaryDetails.h3'At676 q p h2 negOneSucc negTwoSucc @@ -1300,8 +1279,6 @@ private theorem thirdParentCase : have negOneSucc : (-1 : Fin 3).succ = 3 := by decide have negTwoSucc : (-2 : Fin 3).succ = 2 := by decide have hs' := RetainedBoundaryProof.hs'At631 q p hsucc negOneSucc negTwoSucc - let reflect : CircleCoordinates → CircleCoordinates := fun C => (C.1, GaussianReflection - C.2) have h0' := RetainedBoundaryDetails.h0'At771 q p h0 negOneSucc negTwoSucc have h2' := RetainedBoundaryDetails.h2'At774 q p h3 negOneSucc negTwoSucc have h3' := RetainedBoundaryDetails.h3'At777 q p h2 negOneSucc negTwoSucc diff --git a/LeanPool/ApollonianSuperharmonic/BandSuccessorClassification.lean b/LeanPool/ApollonianSuperharmonic/BandSuccessorClassification.lean index f3633e4208..362a4bf1a1 100644 --- a/LeanPool/ApollonianSuperharmonic/BandSuccessorClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/BandSuccessorClassification.lean @@ -73,7 +73,6 @@ theorem BandSuccessorClassification (q : Fin 4 → CircleCoordinates) · change SemiProperQuadruple _ ∧ _ refine ⟨SemiProperQuadruple.successor proper.1, ?_⟩ have h0 : (q 1).1 < (q 0).1 := by simpa using proper.2 0 - have h1 : (q 2).1 < (q 0).1 := by simpa using proper.2 1 have h2 : (q 3).1 < (q 0).1 := by simpa using proper.2 2 intro j fin_cases j diff --git a/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean b/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean index 38e4a774b7..dc91161c6f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTileAcyclicIndegree.lean @@ -492,8 +492,6 @@ private theorem kids : ∀ a, Nonempty (AcyclicIndegreeOrientation (A a) σ)))) ) := by classical intro n U s V k l ih q hn r qr p hp hcurv hpos cfg B cert restrict ls hlsdom hls G hrest A σ a - let D := l.domain.filter fun x => - @decide (x ∉ BoundaryFootprintVertices V) (Classical.propDecidable _) have hsmall : (p a.1.succ).1.toNat < n := by rw [← hn, ← hcurv] exact (Int.toNat_lt_toNat hpos).mpr (hp.2 a.1) @@ -708,8 +706,6 @@ theorem BandTileAcyclicIndegree : let A := fun a : Fin 3 × Bool => (ls a.1 a.2).domain.filter fun x => @decide (x ∉ BoundaryFootprintVertices (cert.P a.1 a.2)) (Classical.propDecidable _) - let I := (ks true).domain.filter fun x => - @decide (x ∉ BoundaryFootprintVertices cert.O) (Classical.propDecidable _) let σ := fun x => 2 + FourNeighborLaplacian G x have kids := BandAcyclicIndegreeGeometry.kids n U s k ih q hn r hp hcurv hpos cfg cert hlsdom hls G hrest diff --git a/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean index f9bedb2e98..76fe05520f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean @@ -111,16 +111,6 @@ private theorem border_touch : obtain ⟨a, ha, hua⟩ := RegularTileFamilyTranslationUnique T (TilingLattice C) U hU have hUform : U = TileTranslation T (a : GaussianInt) := ha - have ha0 : a ≠ 0 := by - intro hz - apply hneq - rw [hUform, hz] - cases T with - | mk cells anchor => - apply congrArg₂ ProtoTile.mk - · ext z - simp [GaussianTranslation] - · simp [GaussianTranslation] rw [hUform] intro ht rcases ht with ht | ht | ht @@ -625,8 +615,6 @@ theorem BandTileTopologyApplication (C : BandCircle) TileCentroid (TileTranslation T y) - TileCentroid (TileTranslation T x) = GaussianRealPoint (y - x) := TileTopologyGeometry.centroid_difference T x y have translate_zero : TileTranslation T 0 = T := TileTranslationProperties.zero T - have realPoint_injective : Function.Injective GaussianRealPoint := - GaussianRealPointProperties.injective have hpositive : 0 < (q 0).1 := (ProperBandCurvatureStructure q hq).1 have harea := (BandTileSimultaneousInduction q hq T hT).2.1 have hnonempty (x : GaussianInt) : diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryJoinChamberCertificate.lean b/LeanPool/ApollonianSuperharmonic/BoundaryJoinChamberCertificate.lean index dd1c89dfa1..d134445cae 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryJoinChamberCertificate.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryJoinChamberCertificate.lean @@ -130,7 +130,6 @@ theorem BoundaryJoinChamberCertificate rw [← hpre, ← hpim, ← hrre, ← hrim] ring rw [physical_det, covolume] at factor - have positive_curvature := C.2 nlinarith have common_chamber : ∃ n, P4994T6Chamber n p ∧ P4994T6Chamber n r := by by_cases hunit : C.1.1.1 = 1 diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean b/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean index 0c32ad1fe3..b034eca982 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean @@ -844,7 +844,6 @@ theorem BoundaryStringConcatenation BandVectors.1 (q ((i + 1).succ)) (q i.succ) := BoundaryConcatenationGeometry.hin q hq i have hflip := (VectorRecursionLaws q hq.1).2.2.2.2 hq i let I : GaussianInt := ⟨0, 1⟩ - let w := BandVectors.1 (q ((i + 2).succ)) (q ((i + 1).succ)) let x := BandVectors.1 (q i.succ) (q ((i + 2).succ)) let y := BandVectors.1 (q ((i + 1).succ)) (q i.succ) have hminus' := BoundaryConcatenationGeometry.hminus' q i T₀ Tminus hminus @@ -924,7 +923,6 @@ theorem BoundaryStringConcatenation {x y : Int × Int} {path : List (Int × Int)} (hseg : TriangularStripSegment x y path) := BoundaryConcatenationGeometry.mapSegment ρ hadjρ hheightρ hmaxρ (x := x) (y := y) (path := path) hseg - have hσrNe := BoundaryConcatenationGeometry.hσrNe r m σ a b c d hdetσ hσmr have hPσ := mapSegment σ hσadj hσheight hmaxσ hP.2 rw [hσm] at hPσ have hQσ := mapSegment σ hσadj hσheight hmaxσ hQ.2 diff --git a/LeanPool/ApollonianSuperharmonic/CircleMatrixEnclosureCriterion.lean b/LeanPool/ApollonianSuperharmonic/CircleMatrixEnclosureCriterion.lean index 4ea2c1f6b8..904e7b0ef0 100644 --- a/LeanPool/ApollonianSuperharmonic/CircleMatrixEnclosureCriterion.lean +++ b/LeanPool/ApollonianSuperharmonic/CircleMatrixEnclosureCriterion.lean @@ -112,10 +112,6 @@ theorem CircleMatrixEnclosureCriterion hCircleCoordinates.1) let x := SymmetricMatrixCoordinates A let e := BandCircleEuclideanData C - have entrySub (P Q : Matrix (Fin 2) (Fin 2) Real) (i j : Fin 2) : - (P - Q) i j = P i j - Q i j := by rfl - have entrySmul (a : Real) (P : Matrix (Fin 2) (Fin 2) Real) (i j : Fin 2) : - (a • P) i j = a * P i j := by rfl have hminus : CircleMatrix C - A = (2 : Real)⁻¹ • ((![![e.radius - x.2 + (e.center - x.1).re, diff --git a/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierGraph.lean b/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierGraph.lean index aa9d157cab..563be4f4dd 100644 --- a/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierGraph.lean +++ b/LeanPool/ApollonianSuperharmonic/ConnectedGridEdgeCarrierGraph.lean @@ -521,55 +521,16 @@ theorem ConnectedGridEdgeCarrierGraph let G : SimpleGraph X := SimpleGraph.fromRel fun a b => ({a.1, b.1} : Finset GaussianInt) ∈ E change G.Connected - let J : GaussianInt := ⟨0, 1⟩ - have carrier_pair (a b : GaussianInt) : - GridEdgeCarrier ({a, b} : Finset GaussianInt) = - Set.uIcc (GaussianRealPoint a) (GaussianRealPoint b) := ConnectedEdgeGraph.carrier_pair a b - have canonical (e : Finset GaussianInt) (he : e ∈ E) : - ∃ a : GaussianInt, e = {a, a + 1} ∨ e = {a, a + J} := ConnectedEdgeGraph.canonical E hgrid - e he - have point_of_common {e f : Finset GaussianInt} {z : GaussianInt} - (hze : z ∈ e) (hzf : z ∈ f) : - (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty := ConnectedEdgeGraph.point_of_common (e - := e) (f := f) (z := z) hze hzf - have horizontal_inter (a c : GaussianInt) : - (GridEdgeCarrier ({a, a + 1} : Finset GaussianInt) ∩ - GridEdgeCarrier ({c, c + 1} : Finset GaussianInt)).Nonempty → - ∃ z, z ∈ ({a, a + 1} : Finset GaussianInt) ∧ - z ∈ ({c, c + 1} : Finset GaussianInt) := ConnectedEdgeGraph.horizontal_inter a c - have vertical_inter (a c : GaussianInt) : - (GridEdgeCarrier ({a, a + J} : Finset GaussianInt) ∩ - GridEdgeCarrier ({c, c + J} : Finset GaussianInt)).Nonempty → - ∃ z, z ∈ ({a, a + J} : Finset GaussianInt) ∧ - z ∈ ({c, c + J} : Finset GaussianInt) := ConnectedEdgeGraph.vertical_inter a c - have cross_inter (a c : GaussianInt) : - (GridEdgeCarrier ({a, a + 1} : Finset GaussianInt) ∩ - GridEdgeCarrier ({c, c + J} : Finset GaussianInt)).Nonempty → - ∃ z, z ∈ ({a, a + 1} : Finset GaussianInt) ∧ - z ∈ ({c, c + J} : Finset GaussianInt) := ConnectedEdgeGraph.cross_inter a c - have carrier_intersection {e f : Finset GaussianInt} (he : e ∈ E) (hf : f ∈ E) : - (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty ↔ - ∃ z, z ∈ e ∧ z ∈ f := ConnectedEdgeGraph.carrier_intersection E hgrid (e := e) (f := f) - he hf let step : Finset GaussianInt → Finset GaussianInt → Prop := fun e f => e ∈ E ∧ f ∈ E ∧ (GridEdgeCarrier e ∩ GridEdgeCarrier f).Nonempty let reach : Finset GaussianInt → Finset GaussianInt → Prop := Relation.ReflTransGen step - have step_symm {e f : Finset GaussianInt} (hef : step e f) : step f e := - ConnectedEdgeGraph.step_symm E (e := e) (f := f) hef have reach_symm {e f : Finset GaussianInt} (hef : reach e f) : reach f e := ConnectedEdgeGraph.reach_symm E (e := e) (f := f) hef - have carrier_closed {e : Finset GaussianInt} (he : e ∈ E) : - IsClosed (GridEdgeCarrier e) := ConnectedEdgeGraph.carrier_closed E hgrid (e := e) he - have carrier_nonempty {e : Finset GaussianInt} (he : e ∈ E) : - (GridEdgeCarrier e).Nonempty := ConnectedEdgeGraph.carrier_nonempty E hgrid (e := e) he have E_nonempty : E.Nonempty := ConnectedEdgeGraph.E_nonempty E hconnected rcases E_nonempty with ⟨e0, he0⟩ have reach_all : ∀ f ∈ E, reach e0 f := ConnectedEdgeGraph.reach_all E hEfinite hgrid hconnected e0 he0 - have edge_reachable {e : Finset GaussianInt} (he : e ∈ E) - (u v : X) (hu : u.1 ∈ e) (hv : v.1 ∈ e) : G.Reachable u v := - ConnectedEdgeGraph.edge_reachable E hgrid (e := e) he u v hu hv have chain_graph : ∀ {e f : Finset GaussianInt}, e ∈ E → f ∈ E → reach e f → ∀ (u v : X), u.1 ∈ e → v.1 ∈ f → G.Reachable u v := ConnectedEdgeGraph.chain_graph E hgrid have X_nonempty : Nonempty X := ConnectedEdgeGraph.X_nonempty E hgrid e0 he0 diff --git a/LeanPool/ApollonianSuperharmonic/CurvatureOnePeriodicOdometer.lean b/LeanPool/ApollonianSuperharmonic/CurvatureOnePeriodicOdometer.lean index 9f42abae71..9bbc62f73a 100644 --- a/LeanPool/ApollonianSuperharmonic/CurvatureOnePeriodicOdometer.lean +++ b/LeanPool/ApollonianSuperharmonic/CurvatureOnePeriodicOdometer.lean @@ -160,11 +160,6 @@ theorem CurvatureOnePeriodicOdometer (C : BandCircle) have circle_formula : CircleMatrix C = ![![((1 + z.re : ℤ) : ℝ), (z.im : ℝ)], ![(z.im : ℝ), (-z.re : ℝ)]] := CurvatureOneProof.circle_formula C z hradius hcenter - have triangular_real (a b : ℤ) : - (((a + b) * (a + b - 1) / 2 : ℤ) : ℝ) = - ((a * (a - 1) / 2 : ℤ) : ℝ) + - ((b * (b - 1) / 2 : ℤ) : ℝ) + (a * b : ℝ) := by - exact_mod_cast triangular a b have linear_difference (x : GaussianInt) : (g x : ℝ) - LatticeQuadraticForm (CircleMatrix C) x = (-(1 + (z.re : ℝ)) / 2) * x.re + ((z.re : ℝ) / 2) * x.im := @@ -218,7 +213,6 @@ theorem CurvatureOnePeriodicOdometer (C : BandCircle) let K : ℝ := |α| ^ 2 + |β| ^ 2 refine ⟨(2 * K / ε ^ 2) + 1, ?_⟩ intro x hx - have hx0 : 0 ≤ (x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2 := by positivity have ha : |α * (x.re : ℝ)| ≤ ε / 4 * (x.re : ℝ) ^ 2 + |α| ^ 2 / ε := by have heq : ε / 4 * (x.re : ℝ) ^ 2 + |α| ^ 2 / ε = (ε ^ 2 * (x.re : ℝ) ^ 2 / 4 + |α| ^ 2) / ε := by field_simp @@ -245,8 +239,6 @@ theorem CurvatureOnePeriodicOdometer (C : BandCircle) (ε / 4 * (x.im : ℝ) ^ 2 + |β| ^ 2 / ε) := add_le_add ha hb _ = _ := by dsimp [K]; ring rw [difference] - have hrel : ε ^ 2 * (K / ε ^ 2) = K := by field_simp - have hrel2 : ε * (K / ε) = K := by field_simp have hbound : K / ε ≤ ε * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) / 2 := by have hK : 0 ≤ K := by dsimp [K]; positivity have hmul := mul_le_mul_of_nonneg_right hx (by positivity : 0 ≤ ε / 2) @@ -274,8 +266,6 @@ theorem CurvatureOnePeriodicOdometer (C : BandCircle) ring_nf omega · intro v hv - have hvtop : v ∈ (⊤ : AddSubgroup GaussianInt) := by - trivial have hlat : TilingLattice C = ⊤ := by simp [TilingLattice, hcoord] rw [hlat] at hv diff --git a/LeanPool/ApollonianSuperharmonic/DiamondBaseT2.lean b/LeanPool/ApollonianSuperharmonic/DiamondBaseT2.lean index afcdd0f261..9bbf0612cc 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondBaseT2.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondBaseT2.lean @@ -148,12 +148,7 @@ private theorem reflectY_mem (K : DiamondParameter) (z : GaussianInt) (hz : z change (reflectY z ∈ domain) rw [mem_domain] at hz ⊢ rcases hz with ⟨y, hy, him, hlo, hhi⟩ - have hypos : y ≤ 2 * k := Nat.le_of_lt_succ (by omega) have hcast : ((2 * k - y : Nat) : Int) = 2 * (k : Int) - y := by omega - have hlo' : -min ((y : Int) + 1) (2 * (k : Int) - y) ≤ z.re := by - simpa [Nat.cast_min, hcast] using hlo - have hhi' : z.re < min ((y : Int) + 1) (2 * (k : Int) - y) := by - simpa [Nat.cast_min, hcast] using hhi have hr : (2 * k - 1 - y + 1).min (2 * k - (2 * k - 1 - y)) = (y + 1).min (2 * k - y) := by have hfirst : 2 * k - 1 - y + 1 = 2 * k - y := by omega @@ -364,38 +359,13 @@ theorem DiamondBaseT2 (K : DiamondParameter) : QuarterTurnSymmetric (DiamondTile K.1) := by -- BODY let k : Nat := K.1 - have hk : 0 < k := DiamondQuarterTurnConstruction.hk K - have mem_domain (z : GaussianInt) : z ∈ DiamondCellDomain k ↔ - ∃ y : Nat, y < 2 * k ∧ - (let r := Nat.min (y + 1) (2 * k - y); - z.im = (y : Int) ∧ -(r : Int) ≤ z.re ∧ z.re < (r : Int)) := - DiamondQuarterTurnConstruction.mem_domain K z let domain : Finset GaussianInt := DiamondCellDomain k - have domain_nonempty : domain.Nonempty := DiamondQuarterTurnConstruction.domain_nonempty K - let reflectX : GaussianInt → GaussianInt := - fun z => (⟨-z.re - 1, z.im⟩ : GaussianInt) - let reflectY : GaussianInt → GaussianInt := - fun z => (⟨z.re, 2 * (k : Int) - 1 - z.im⟩ : GaussianInt) - have reflectX_mem (z : GaussianInt) (hz : z ∈ domain) : reflectX z ∈ domain := - DiamondQuarterTurnConstruction.reflectX_mem K z hz - have reflectY_mem (z : GaussianInt) (hz : z ∈ domain) : reflectY z ∈ domain := - DiamondQuarterTurnConstruction.reflectY_mem K z hz - have sum_re_reflect : domain.sum (fun z => z.re) = - domain.sum (fun z => (reflectX z).re) := DiamondQuarterTurnConstruction.sum_re_reflect K - have sum_re_formula : domain.sum (fun z => z.re) * 2 = - -(domain.card : Int) := DiamondQuarterTurnConstruction.sum_re_formula K - have sum_im_reflect : domain.sum (fun z => z.im) = - domain.sum (fun z => (reflectY z).im) := DiamondQuarterTurnConstruction.sum_im_reflect K - have sum_im_formula : domain.sum (fun z => z.im) * 2 = - (2 * (k : Int) - 1) * domain.card := DiamondQuarterTurnConstruction.sum_im_formula K have centroid_formula : TileCentroid (DiamondTile k) = (0, (k : Real)) := DiamondQuarterTurnConstruction.centroid_formula K let rotate : GaussianInt → GaussianInt := fun z => (⟨(k : Int) - 1 - z.im, z.re + k⟩ : GaussianInt) have rotate_mem (z : GaussianInt) (hz : z ∈ domain) : rotate z ∈ domain := DiamondQuarterTurnConstruction.rotate_mem K z hz - have rotate_injective : Set.InjOn rotate (domain : Set GaussianInt) := - DiamondQuarterTurnConstruction.rotate_injective K have rotate_surjective (z : GaussianInt) (hz : z ∈ domain) : ∃ w ∈ domain, rotate w = z := DiamondQuarterTurnConstruction.rotate_surjective K z hz change QuarterTurnSymmetric (DiamondTile k) diff --git a/LeanPool/ApollonianSuperharmonic/DiamondCoordinateConfiguration.lean b/LeanPool/ApollonianSuperharmonic/DiamondCoordinateConfiguration.lean index ccd12aae31..307e40f336 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondCoordinateConfiguration.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondCoordinateConfiguration.lean @@ -386,7 +386,6 @@ private theorem proper : intro K currentSemi refine ⟨currentSemi, ?_⟩ have hk : 0 < K.1 := K.2 - have hk' : 1 ≤ K.1 := by omega have hsub : K.1 - 1 ≤ K.1 := Nat.sub_le _ _ intro j fin_cases j <;> simp [DiamondRecursiveQuadruple] @@ -401,8 +400,6 @@ private theorem properAt : classical intro configuration semi n refine ⟨semi n, ?_⟩ - have hn : 0 < n + 1 := Nat.succ_pos n - have hsub : (n + 1) - 1 ≤ n + 1 := Nat.sub_le _ _ intro j fin_cases j <;> simp [configuration, DiamondRecursiveQuadruple] all_goals nlinarith @@ -474,11 +471,6 @@ private theorem claims : have coordU : ((1 : Int), 1 + 2 * (⟨0, 1⟩ : GaussianInt)) = ((1 : Int), ⟨1, 2⟩) := by norm_num [Zsqrtd.ext_iff] - have coordU2 : ((1 : Int), 1 + 2 * (0 : GaussianInt) + - 2 * (⟨0, 1⟩ : GaussianInt)) = (1, ⟨1, 2⟩) := by - norm_num [Zsqrtd.ext_iff] - have coordB : ((0 : Int), (-1 : GaussianInt)) = - ((0 : Int), ⟨-1, 0⟩) := by rfl have root10' := DiamondConfigurationProof.root10'At246 r21 r13 root10 coordU have hx := DiamondConfigurationProof.hxAt261 r13 coordU have hy : BandVectors.1 (configuration 0 2) (configuration 0 1) = diff --git a/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean index 752e51b987..f6de916933 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondExceptionalMaximality.lean @@ -176,7 +176,6 @@ private theorem finD : have hr := Int.natCast_natAbs x.re have hi := Int.natCast_natAbs (x.im-k) have hk : 0 < k := by dsimp [k]; exact_mod_cast K.2 - have hkdef : (K.1 : Int) = k := rfl simp only [abs_eq_max_neg] at hr hi change x ∈ box dsimp only [box] @@ -489,7 +488,6 @@ theorem DiamondExceptionalMaximality (K : DiamondParameter) : -- BODY classical let g := DiamondOdometer K - let k : Int := K.1 let a : GaussianInt := ⟨0, -(2 * K.1 : Int)⟩ let b : GaussianInt := ⟨(K.1 + 1 : Int), (K.1 : Int)⟩ let D := DiamondVertexDomains K true @@ -501,17 +499,6 @@ theorem DiamondExceptionalMaximality (K : DiamondParameter) : AddSubgroup.subset_closure (Or.inl rfl) have hb : b ∈ DiamondExceptionalLattice K := AddSubgroup.subset_closure (Or.inr rfl) - let H : AddSubgroup GaussianInt := - { carrier := {v | ∀ x, FourNeighborLaplacian g (x+v) = FourNeighborLaplacian g x} - zero_mem' := by intro x; simp - add_mem' := by - intro u v hu hv x - rw [← add_assoc, hv, hu] - neg_mem' := by - intro v hv x - have h := hv (x-v) - rw [sub_add_cancel] at h - simpa only [sub_eq_add_neg] using h.symm } have hgen := ExceptionalMaximalityProof.hgen K tab have periods := ExceptionalMaximalityProof.periods K hgen have bound := ExceptionalMaximalityProof.bound K tab ha hb periods diff --git a/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean index 5217b4ffc8..459856bb41 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean @@ -1537,7 +1537,6 @@ theorem DiamondOpposingBoundaryStarLocalization hT0'cent have hshift' := DiamondBoundaryStarGeometry.hshift' K u u' hshift have Hmem := DiamondBoundaryStarGeometry.Hmem K H hHdom - let z := x - u have hzUpper := DiamondBoundaryStarGeometry.hzUpper K h0 x hx0 H u huDom Hmem have hzLower := DiamondBoundaryStarGeometry.hzLower K h0' x hx0' H u u' hu'Dom hshift' Hmem @@ -1614,7 +1613,6 @@ theorem DiamondOpposingBoundaryStarLocalization hxu have h21 := DiamondBoundaryStarGeometry.h21 K hqD hA21 let Kprev : DiamondParameter := ⟨m, hmpos⟩ - let qprev := DiamondRecursiveQuadruple Kprev rcases DiamondCoordinateConfiguration Kprev with ⟨_, hqprev, _, _, hcentprev, _, _, hsloprev, _, _, _⟩ have hKrel : m + 1 = K.1 := by dsimp [m]; omega @@ -1623,7 +1621,6 @@ theorem DiamondOpposingBoundaryStarLocalization have hmreal := DiamondBoundaryStarGeometry.hmreal K hKreal have hqprev0 := DiamondBoundaryStarGeometry.hqprev0 K Ci hCi hmpos hKrel hKcast - have hv30' := DiamondBoundaryStarGeometry.hv30'At635 K hv30 have hchildcent := DiamondBoundaryStarGeometry.hchildcent K T0 T0' S S' hmpos hcentprev hKreal (DiamondBoundaryStarGeometry.hrootcent K T0 T0' hv30 hcentroid) (DiamondBoundaryStarGeometry.hUreverse T0 S diff --git a/LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean b/LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean index c645fc7c87..d5f3974dd1 100644 --- a/LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean +++ b/LeanPool/ApollonianSuperharmonic/DisjointBoundaryCommonEdgeGraphAcyclic.lean @@ -413,8 +413,6 @@ private theorem huOut (U : ProtoTile) (u : ApollonianSuperharmonic.LatticeCell) have := huMax (u + 1) hu1 simp at this -private abbrev hvOut := ApollonianSuperharmonic.CommonBoundaryAcyclicityConstruction.huOut - private theorem huNotV (U : ProtoTile) (V : ProtoTile) (hdisjoint : Disjoint U.cells V.cells) (u : ApollonianSuperharmonic.LatticeCell) (hu : u ∈ U.cells) : u ∉ V.cells := by classical @@ -574,44 +572,6 @@ theorem DisjointBoundaryCommonEdgeGraphAcyclic (U V : ProtoTile) FootprintEdges U ∩ FootprintEdges V change G.IsAcyclic intro v c hc - have cycle_subcycle_eq {B : SimpleGraph GaussianInt} {u w : GaussianInt} - (outer : B.Walk u u) (inner : B.Walk w w) - (houter : outer.IsCycle) (hinner : inner.IsCycle) - (hle : inner.toSubgraph ≤ outer.toSubgraph) : - inner.toSubgraph = outer.toSubgraph := - CommonBoundaryAcyclicityConstruction.cycle_subcycle_eq (B := B) (u := u) (w := w) outer - inner houter hinner hle - let boundaryGraph (T : ProtoTile) : SimpleGraph GaussianInt := - SimpleGraph.fromRel fun a b => - ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T - have pair_eq_iff_sym2 (a b r s' : GaussianInt) : - ({a, b} : Finset GaussianInt) = {r, s'} ↔ s(a, b) = s(r, s') := - CommonBoundaryAcyclicityConstruction.pair_eq_iff_sym2 a b r s' - have boundary_cycle (T : ProtoTile) - (ht : SimpleGridCycle (BoundaryFootprintVertices T) - (BoundaryFootprintEdges T)) : - ∃ (z : GaussianInt) (d : (boundaryGraph T).Walk z z), d.IsCycle ∧ - ∀ {a b : GaussianInt}, a ≠ b → - (({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ - d.toSubgraph.Adj a b) := CommonBoundaryAcyclicityConstruction.boundary_cycle T ht - have boundary_pair_common (T : ProtoTile) - (ht : SimpleGridCycle (BoundaryFootprintVertices T) - (BoundaryFootprintEdges T)) - (hsub : FootprintEdges U ∩ FootprintEdges V ⊆ - BoundaryFootprintEdges T) : - ∀ {a b : GaussianInt}, a ≠ b → - ({a, b} : Finset GaussianInt) ∈ BoundaryFootprintEdges T → - ({a, b} : Finset GaussianInt) ∈ FootprintEdges U ∩ FootprintEdges V := - CommonBoundaryAcyclicityConstruction.boundary_pair_common U V v c hc T ht hsub - have hsubU : FootprintEdges U ∩ FootprintEdges V ⊆ - BoundaryFootprintEdges U := CommonBoundaryAcyclicityConstruction.hsubU U V hedges - have hsubV : FootprintEdges U ∩ FootprintEdges V ⊆ - BoundaryFootprintEdges V := CommonBoundaryAcyclicityConstruction.hsubV U V hedges - have vertical_boundary_iff (T : ProtoTile) (z : GaussianInt) : - ({z, z + ⟨0, 1⟩} : Finset GaussianInt) ∈ BoundaryFootprintEdges T ↔ - ((z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ - (z ∉ T.cells ∧ z - 1 ∈ T.cells)) := - CommonBoundaryAcyclicityConstruction.vertical_boundary_iff T z obtain ⟨e, heU, heV⟩ := hcommon obtain ⟨u0, hu0, _⟩ := heU obtain ⟨v0, hv0, _⟩ := heV @@ -619,24 +579,6 @@ theorem DisjointBoundaryCommonEdgeGraphAcyclic (U V : ProtoTile) U.cells.exists_max_image (fun q => q.re) ⟨u0, hu0⟩ obtain ⟨v', hv', hvMax⟩ := V.cells.exists_max_image (fun q => q.re) ⟨v0, hv0⟩ - have huOut : u + 1 ∉ U.cells := CommonBoundaryAcyclicityConstruction.huOut U u huMax - have hvOut : v' + 1 ∉ V.cells := CommonBoundaryAcyclicityConstruction.hvOut V v' hvMax - have huNotV : u ∉ V.cells := CommonBoundaryAcyclicityConstruction.huNotV U V hdisjoint u hu - have hvNotU : v' ∉ U.cells := CommonBoundaryAcyclicityConstruction.hvNotU U V hdisjoint v' hv' - have hUne : u + 1 ≠ u + 1 + ⟨0, 1⟩ := CommonBoundaryAcyclicityConstruction.hUne u - have hVne : v' + 1 ≠ v' + 1 + ⟨0, 1⟩ := CommonBoundaryAcyclicityConstruction.hVne v' - have hUright : ({u + 1, u + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ - BoundaryFootprintEdges U := CommonBoundaryAcyclicityConstruction.hUright U u hu huMax - have hVright : ({v' + 1, v' + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ - BoundaryFootprintEdges V := CommonBoundaryAcyclicityConstruction.hVright V v' hv' hvMax - have hUcommon := boundary_pair_common U hUcycle hsubU hUne hUright - have hVcommon := boundary_pair_common V hVcycle hsubV hVne hVright - have hUrightV : ({u + 1, u + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ - BoundaryFootprintEdges V := CommonBoundaryAcyclicityConstruction.hUrightV U V hUcycle - hedges v u c hu huMax hc - have hVrightU : ({v' + 1, v' + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ - BoundaryFootprintEdges U := CommonBoundaryAcyclicityConstruction.hVrightU U V hVcycle - hedges v v' c hv' hvMax hc have hu1V : u + 1 ∈ V.cells := CommonBoundaryAcyclicityConstruction.hu1V U V hdisjoint hUcycle hedges v u c hu huMax hc have hv1U : v' + 1 ∈ U.cells := CommonBoundaryAcyclicityConstruction.hv1U U V hdisjoint hVcycle diff --git a/LeanPool/ApollonianSuperharmonic/DisjointSquareUnionCommonEdgeCarrier.lean b/LeanPool/ApollonianSuperharmonic/DisjointSquareUnionCommonEdgeCarrier.lean index c1bb1a79c5..ca8f76655e 100644 --- a/LeanPool/ApollonianSuperharmonic/DisjointSquareUnionCommonEdgeCarrier.lean +++ b/LeanPool/ApollonianSuperharmonic/DisjointSquareUnionCommonEdgeCarrier.lean @@ -53,7 +53,6 @@ private theorem edge_endpoint_square (c : LatticeCell) (e : Finset GaussianInt) (z : GaussianInt) (hz : z ∈ e) : GaussianRealPoint z ∈ ClosedSquareRealization c := by classical - let I : GaussianInt := ⟨0, 1⟩ rcases he with rfl | rfl | rfl | rfl all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hz all_goals rcases hz with rfl | rfl @@ -100,12 +99,6 @@ theorem DisjointSquareUnionCommonEdgeCarrier (U V : ProtoTile) let I : GaussianInt := ⟨0, 1⟩ have footprint_finite (T : ProtoTile) : (FootprintEdges T).Finite := SquareUnionCommonCarrierConstruction.footprint_finite T - have edge_endpoint_square (c : LatticeCell) (e : Finset GaussianInt) - (he : e = {c, c + 1} ∨ e = {c, c + I} ∨ - e = {c + 1, c + 1 + I} ∨ e = {c + I, c + 1 + I}) - (z : GaussianInt) (hz : z ∈ e) : - GaussianRealPoint z ∈ ClosedSquareRealization c := - SquareUnionCommonCarrierConstruction.edge_endpoint_square c e he z hz have edge_carrier_subset (T : ProtoTile) (e : Finset GaussianInt) (he : e ∈ FootprintEdges T) : GridEdgeCarrier e ⊆ TileRealization T := SquareUnionCommonCarrierConstruction.edge_carrier_subset T e he diff --git a/LeanPool/ApollonianSuperharmonic/FiniteAcyclicOrientationObstruction.lean b/LeanPool/ApollonianSuperharmonic/FiniteAcyclicOrientationObstruction.lean index d0c34eaea0..196dd3e563 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteAcyclicOrientationObstruction.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteAcyclicOrientationObstruction.lean @@ -92,10 +92,6 @@ theorem FiniteAcyclicOrientationObstruction intro h have q := congrArg (fun z : GaussianInt => z.re) h simp at q - have h24 : x - 1 ≠ x - ⟨0, 1⟩ := by - intro h - have q := congrArg (fun z : GaussianInt => z.re) h - simp at q have h34 : x + ⟨0, 1⟩ ≠ x - ⟨0, 1⟩ := by intro h have q := congrArg (fun z : GaussianInt => z.im) h diff --git a/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean b/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean index 9481982d69..2c21430a71 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteBiconnectedHorizontalRunTree.lean @@ -215,7 +215,6 @@ private theorem vertical_reachable : exact not_not.mp hzJ have hminLeft : leftmost.re ≤ (z - 1).re := hmin (z - 1) hpair.1 change leftmost.re ≤ z.re - 1 at hminLeft - have hminZ : leftmost.re ≤ z.re := hmin z hz have hdec : Int.toNat ((z - 1).re - leftmost.re) < n := by change Int.toNat (z.re - 1 - leftmost.re) < n rw [← hmeasure] @@ -283,13 +282,8 @@ private theorem hconnected : obtain ⟨p, hphead, hplast, hpmem, hpadj⟩ := hinside.2 a.1 a.2 b.1 b.2 have hpne : p ≠ [] := by intro hp; simp [hp] at hphead - have hpchain : List.IsChain FourNeighborAdjacent p := by - rw [List.isChain_iff_forall_rel_of_append_cons_cons] - exact hpadj let toX : GaussianInt → X := fun z => if hz : z ∈ S then ⟨z, hz⟩ else ⟨base, hbase⟩ - have toX_eq (z : GaussianInt) (hz : z ∈ S) : (toX z).1 = z := by - simp [toX, hz] have hpchain' : List.IsChain (fun x y : GaussianInt => G.Reachable (toX x) (toX y)) p := by rw [List.isChain_iff_forall_rel_of_append_cons_cons] @@ -543,10 +537,6 @@ private theorem htopzero : rcases hn with ⟨e, he, rfl⟩ rw [List.mem_iff_getElem] at he rcases he with ⟨i, hi, he⟩ - have hit : i < path.tail.length := by - simpa [List.length_zip] using hi - have hip : i < path.length := - lt_of_lt_of_le hi (by simp [List.length_zip]) rw [List.getElem_zip, List.getElem_tail] at he have he1 := congrArg Prod.fst he have he2 := congrArg Prod.snd he @@ -783,8 +773,6 @@ private theorem hfarzero : apply path_vertex_re_min rw [List.mem_iff_getElem] at he rcases he with ⟨i, hi, he⟩ - have hip : i < path.length := - lt_of_lt_of_le hi (by simp [List.length_zip]) rw [List.getElem_zip] at he have he1 := congrArg Prod.fst he simp [← he1] diff --git a/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean b/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean index 50bbbbfcb2..1e1df59672 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteConnectedAcyclicDegreeTwoGridPath.lean @@ -477,11 +477,8 @@ theorem FiniteConnectedAcyclicDegreeTwoGridPath let G : SimpleGraph X := SimpleGraph.fromRel fun a b : X => ({a.1, b.1} : Finset GaussianInt) ∈ E have hXfinite : X.Finite := GridPathProof.hXfinite X E hEfinite hendpoints - let vertexFiniteness : Fintype X := hXfinite.fintype have hXne : X.Nonempty := GridPathProof.hXne X E hEne hendpoints hgrid let vertexNonempty : Nonempty X := GridPathProof.vertexNonempty X hXne - let pairFiniteness : Fintype (Sym2 X) := Fintype.ofFinite _ - let edgeFiniteness : Fintype G.edgeSet := Fintype.ofFinite _ have hGconn : G.Connected := GridPathProof.hGconn X E hconnected have hGacyc : G.IsAcyclic := GridPathProof.hGacyc X E hacyclic let lengths : Set Nat := {n | ∃ (u v : X) (p : G.Walk u v), diff --git a/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean b/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean index 8b3a60d092..3932adcc13 100644 --- a/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean +++ b/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean @@ -154,8 +154,6 @@ private theorem ha32At288 : intro Q qone hqone hp hq coord2 b2 f1 have hx := f1.2 have hbase := b2.2.2.2.2.2 - have hi : (⟨0, 1⟩ : GaussianInt) * ⟨0, 1⟩ = -1 := by - ext <;> norm_num have hx' : -(⟨0, 1⟩ : GaussianInt) * BandVectors.2 ((FordRecursiveQuadruple Q) 3) ((FordRecursiveQuadruple Q) 2) = @@ -282,11 +280,6 @@ private theorem hv13At359 : rw [rv13, rv32] at hx simp only [FordRecursiveQuadruple, Fin.isValue, Matrix.cons_val_zero, Matrix.cons_val, Int.reduceNeg, mul_neg, R] at hx - have hqdrel : qd + Q.q₂ = Q.q₁ := by - dsimp [qd] - omega - have hqdrel' : (qd : Int) + (Q.q₂ : Int) = (Q.q₁ : Int) := by - exact_mod_cast hqdrel have hcalc : (qd : GaussianInt) + (⟨0, 1⟩ : GaussianInt) * (-((⟨0, 1⟩ : GaussianInt) * (Q.q₂ : GaussianInt))) = @@ -679,10 +672,6 @@ private theorem hv32At473 : have hqdrel : qd + Q.q₁ = Q.q₂ := by dsimp [qd] omega - have hqdrel' : (qd : Int) + (Q.q₁ : Int) = (Q.q₂ : Int) := by - exact_mod_cast hqdrel - have hi : (⟨0, 1⟩ : GaussianInt) * ⟨0, 1⟩ = -1 := by - ext <;> norm_num have hcalc : -((⟨0, 1⟩ : GaussianInt) * (qd : GaussianInt)) - (⟨0, 1⟩ : GaussianInt) * (Q.q₁ : GaussianInt) = -((⟨0, 1⟩ : GaussianInt) * (Q.q₂ : GaussianInt)) := by @@ -785,7 +774,6 @@ private theorem circleExists : · have hp1 : P.q₁ = 0 := by have h := P.q₁_lt omega - have hunit := P.unit_case hu let z : GaussianInt := ⟨0, P.p - 1⟩ have hs : SemiProperQuadruple ![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * (⟨0, 1⟩ : GaussianInt)), @@ -807,14 +795,6 @@ private theorem circleExists : · have hgt : 1 < P.q := by have hpq : 1 ≤ P.q := P.q_pos omega - have hq1pos : 0 < P.q₁ := by - by_contra hz - have hz' : P.q₁ = 0 := by omega - have hd := P.det₁ - simp [hz'] at hd - have hdv : (P.q : Int) ∣ 1 := ⟨P.p₁, by simpa [mul_comm] using hd.symm⟩ - have : (P.q : Int) = 1 := Int.eq_one_of_dvd_one (by omega) hdv - omega have hs := claim P.q P rfl hgt refine ⟨⟨⟨FordCircleCoordinate P.p P.q, ?_⟩, ?_⟩, rfl⟩ · refine ⟨Or.inl (by @@ -1056,7 +1036,6 @@ private theorem hq2ltN : ∀ (n : ℕ), ∀ (Q : FordFareyParameter), (Q.q = n) → ((Q.q₂ < Q.q) → (Q.q₂ < n)) := by classical intro n Q hQ q2lt - have hlt := q2lt omega private theorem hv13At961 : diff --git a/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean index 63f9e2fa6a..652eec339d 100644 --- a/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean +++ b/LeanPool/ApollonianSuperharmonic/FordLaplacianTable.lean @@ -276,7 +276,6 @@ private theorem ha0 : intro P hbig a b hsum let A := P.p₁ by_contra h - have hanon : 0 ≤ a := by dsimp [a]; omega have haz : a = 0 := by omega have hd : (P.q : Int) ∣ 1 := by refine ⟨A, ?_⟩ @@ -1345,7 +1344,6 @@ private theorem interiorLaplacian : have hd : (P.q₁ : Int) ∣ 1 := FordLaplacianDetails.hdAt1050 P he hsum hdet hp have ha1 := Int.le_of_dvd (by norm_num : (0 : Int) < 1) hd have hqa : (P.q₁ : Int) = 1 := by omega - have hqb : (P.q₂ : Int) = 1 := by omega have hqq : (P.q : Int) = 2 := by omega have hx : x = ⟨1, 1⟩ := by ext <;> dsimp <;> omega have hnum : P.p = P.p₁ * 2 - 1 := FordLaplacianDetails.hnum P hdet hqa hqq diff --git a/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean index 60d1c8a5af..dc2b389b3b 100644 --- a/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/FordLeftBoundaryCompatibility.lean @@ -43,7 +43,6 @@ private theorem hcurv : simp only [BandPackingSymmetryQuadrupleAction, Fin.isValue, Matrix.cons_val_zero, neg_zero, ite_self, Fin.succ_zero_eq_one, Matrix.cons_val_one, Matrix.cons_val_succ] at hecurv rw [hc] at hecurv - have hqp : (1 : ℝ) < P0.q := by exact_mod_cast hP0 simp [FordRecursiveQuadruple, FordCircleCoordinate] at hecurv nlinarith @@ -191,7 +190,6 @@ private theorem hCpos : (BandPackingSymmetryQuadrupleAction g2 barq 0).1)) ) := by classical intro w r2 g2 P2 hP2 barq heq0' - have hqpos : (0 : ℝ) < P2.q := by exact_mod_cast P2.q_pos have hh := congrArg Prod.fst heq0' simp [FordRecursiveQuadruple, FordCircleCoordinate] at hh nlinarith @@ -725,10 +723,6 @@ theorem FordLeftBoundaryCompatibility Complex.add_im, Complex.mul_re, Complex.mul_im, Complex.intCast_re, Complex.intCast_im, Complex.I_re, Complex.I_im, zero_mul, add_zero, zero_add, mul_one] at sr sr' si si' - have hreal (v : GaussianInt) : (GaussianInt.toComplex v).re = v.re := by - exact (GaussianInt.intCast_re v).symm - have himag (v : GaussianInt) : (GaussianInt.toComplex v).im = v.im := by - exact (GaussianInt.intCast_im v).symm have haRe : a'.re - a.re = (if (ew ^^ negative) = true then 1 else -1) * (BandVectors.2 (FordRecursiveQuadruple P2 t.succ) diff --git a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean index e1c2f3c875..a3d608aa94 100644 --- a/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/FordOrientedChildParentEndpoints.lean @@ -1509,12 +1509,6 @@ theorem FordOrientedChildParentEndpoints -- BODY classical -- A positive rectangle has the full induced grid graph on its vertices. - let rect : Int → Int → Int → Set GaussianInt := fun a b n => - {z | a ≤ z.re ∧ z.re ≤ a + n ∧ b ≤ z.im ∧ z.im ≤ b + n} - let adj := fun x y : GaussianInt => - y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ - let edges : Set GaussianInt → Set (Finset GaussianInt) := fun V => - {e | ∃ x ∈ V, ∃ y ∈ V, adj x y ∧ e = {x, y}} have obs := FordEndpointProof.obs have edge_inter := FordEndpointProof.edge_inter -- Enumerate every vertex and every edge of a straight segment. @@ -1544,10 +1538,6 @@ theorem FordOrientedChildParentEndpoints ∃ A : ExactTileInterfaceTriple U W Z, R.point ≠ I.point ∧ A.point = I.point ∧ R.otherCA = I.point ∧ I.otherCA = R.point ∧ A.otherAB = R.point - let affine := fun (q : Int) (flip : Bool) (t : GaussianInt) (z : GaussianInt) => - (if flip then (⟨q,q⟩ : GaussianInt) - z else z) + t - let ax := fun (q : Int) (flip : Bool) (t a n : Int) => - (if flip then q-a-n else a)+t have sameobs := FordEndpointProof.sameobs obs sqcell sqne (FordEndpointProof.sqcent (FordEndpointProof.fordcent fordcell)) have carry_squares := FordEndpointProof.carry_squares diff --git a/LeanPool/ApollonianSuperharmonic/GridHorizontalLogLiftDelta.lean b/LeanPool/ApollonianSuperharmonic/GridHorizontalLogLiftDelta.lean index 9e0fbd4bf6..2559c238ff 100644 --- a/LeanPool/ApollonianSuperharmonic/GridHorizontalLogLiftDelta.lean +++ b/LeanPool/ApollonianSuperharmonic/GridHorizontalLogLiftDelta.lean @@ -48,8 +48,6 @@ theorem GridHorizontalLogLiftDelta (q a b : GaussianInt) have haC : (a : ℂ).im = ((a.im : Int) : Real) := by simp have hqC : (q : ℂ).im = ((q.im : Int) : Real) := by simp rw [haC, hqC] at hz - have heq : ((a.im : Int) : Real) - (q.im : Int) = 1 / 2 := by - linarith have heq2 : (((2 * (a.im - q.im) : Int) : Real)) = 1 := by push_cast linarith diff --git a/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexAdjacentCell.lean b/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexAdjacentCell.lean index 9273f4c430..e3e9be620b 100644 --- a/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexAdjacentCell.lean +++ b/LeanPool/ApollonianSuperharmonic/GridRayCrossingIndexAdjacentCell.lean @@ -33,16 +33,6 @@ private theorem open_edges_no_reverse {α : Type} rw [List.mem_iff_getElem] at huv hvu rcases huv with ⟨i, hi, huv⟩ rcases hvu with ⟨j, hj, hvu⟩ - have hi' : i < p.tail.length := by - simpa [List.length_zip] using hi - have hj' : j < p.tail.length := by - simpa [List.length_zip] using hj - have hip : i + 1 < p.length := by - simp only [List.length_tail] at hi' - omega - have hjp : j + 1 < p.length := by - simp only [List.length_tail] at hj' - omega rw [List.getElem_zip, List.getElem_tail] at huv hvu injection huv with huv₁ huv₂ injection hvu with hvu₁ hvu₂ @@ -58,11 +48,6 @@ private theorem open_head_last_not_edge {α : Type} intro hxy rw [List.mem_iff_getElem] at hxy rcases hxy with ⟨i, hi, hxy⟩ - have hi' : i < p.tail.length := by - simpa [List.length_zip] using hi - have hip : i + 1 < p.length := by - simp only [List.length_tail] at hi' - omega rw [List.getElem_zip, List.getElem_tail] at hxy injection hxy with hix hiy have hpne : p ≠ [] := by @@ -109,7 +94,7 @@ private theorem cyclic_edges_no_reverse {α : Type} · exact hxy h.1 private theorem open_last_head_not_edge {α : Type} {p : List α} (hp : p.Nodup) (hlen : 2 ≤ p.length) {x y : α} - (hhead : p.head? = some x) (hlast : p.getLast? = some y) : + (hlast : p.getLast? = some y) : (y, x) ∉ p.zip p.tail := by intro hyx rw [List.mem_iff_getElem] at hyx @@ -124,10 +109,6 @@ private theorem open_last_head_not_edge {α : Type} have hpne : p ≠ [] := by intro hp0 simp [hp0] at hlen - have hzero : 0 < p.length := by omega - have hx0 : p[0] = x := by - rw [← List.head_eq_getElem hpne] - simpa [List.head?_eq_some_head hpne] using hhead have hyLast : p[p.length - 1] = y := by rw [← List.getLast_eq_getElem hpne] rw [List.getLast?_eq_getLast_of_ne_nil hpne] at hlast @@ -145,13 +126,13 @@ private theorem open_edges_nodup {α : Type} exact (hp.getElem_inj_iff).mp hfirst private theorem cyclic_edge_list_nodup {α : Type} {p : List α} (hp : p.Nodup) (hlen : 3 ≤ p.length) {x y : α} - (hhead : p.head? = some x) (hlast : p.getLast? = some y) : + (hlast : p.getLast? = some y) : ((p.zip p.tail) ++ [(y, x)]).Nodup := by rw [List.nodup_append] refine ⟨open_edges_nodup hp, by simp, ?_⟩ intro a ha b hb hab have hbEq : b = (y, x) := by simpa using hb - apply open_last_head_not_edge hp (by omega) hhead hlast + apply open_last_head_not_edge hp (by omega) hlast rw [← hbEq, ← hab] exact ha private theorem signed_target_sum_formula {α : Type} [DecidableEq α] @@ -349,7 +330,7 @@ theorem GridRayCrossingIndexAdjacentCell dsimp only intro q let edges := (p.zip p.tail) ++ [(y, x)] - have hedges : edges.Nodup := cyclic_edge_list_nodup hnodup hlen hhead hlast + have hedges : edges.Nodup := cyclic_edge_list_nodup hnodup hlen hlast have edge_adj : ∀ a b, (a, b) ∈ p.zip p.tail ∨ (a = y ∧ b = x) → FourNeighborAdjacent a b := by intro a b hab diff --git a/LeanPool/ApollonianSuperharmonic/GridVerticalDownLogLiftDelta.lean b/LeanPool/ApollonianSuperharmonic/GridVerticalDownLogLiftDelta.lean index 17af92ae6a..f83bc91ebe 100644 --- a/LeanPool/ApollonianSuperharmonic/GridVerticalDownLogLiftDelta.lean +++ b/LeanPool/ApollonianSuperharmonic/GridVerticalDownLogLiftDelta.lean @@ -143,7 +143,6 @@ theorem GridVerticalDownLogLiftDelta (q a : GaussianInt) linarith [t.2.1, t.2.2] have hlo : (-1 : Int) < a.im - q.im - 1 := by exact_mod_cast hloR have hhi : a.im - q.im - 1 < (1 : Int) := by exact_mod_cast hhiR - have heq : a.im - q.im - 1 = 0 := by omega change a.im - 1 = q.im omega · dsimp [GridCellCenter] at hre diff --git a/LeanPool/ApollonianSuperharmonic/GridVerticalUpLogLiftDelta.lean b/LeanPool/ApollonianSuperharmonic/GridVerticalUpLogLiftDelta.lean index ed02f68768..f6a652159d 100644 --- a/LeanPool/ApollonianSuperharmonic/GridVerticalUpLogLiftDelta.lean +++ b/LeanPool/ApollonianSuperharmonic/GridVerticalUpLogLiftDelta.lean @@ -77,8 +77,6 @@ theorem GridVerticalUpLogLiftDelta (q a : GaussianInt) have ha : ((a.re : Int) : Real) ≤ (q.re : Int) := by exact_mod_cast hcross.2 have haC : (a : ℂ).re ≤ (q : ℂ).re := by simpa using ha - have ht0 : 0 ≤ (t : Real) := t.2.1 - have ht1 : (t : Real) ≤ 1 := t.2.2 linarith have hd := GridSegmentLogLiftDelta (-z0) (-z1) hslit M hM hMexp have hre0 : z0.re < 0 := by diff --git a/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicClosedness.lean b/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicClosedness.lean index b85eb4fbd1..7d211877c6 100644 --- a/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicClosedness.lean +++ b/LeanPool/ApollonianSuperharmonic/IntegerSuperharmonicClosedness.lean @@ -48,8 +48,6 @@ theorem IntegerSuperharmonicClosedness intro d hd rw [Real.dist_eq] simp only [Prod.dist_eq, Real.dist_eq, max_lt_iff] at hd - have h1 : |d.1 - c.1| < e / 2 := by simpa [abs_sub_comm] using hd.1 - have h2 : |d.2 - c.2| < e / 2 := by simpa [abs_sub_comm] using hd.2 calc |(d.1 - d.2) - (c.1 - c.2)| = |(d.1 - c.1) - (d.2 - c.2)| := by ring_nf _ ≤ |d.1 - c.1| + |d.2 - c.2| := by @@ -73,7 +71,6 @@ theorem IntegerSuperharmonicClosedness rw [abs_of_pos (by positivity : (0 : Real) < 1 / (k + 1 : Real))] rw [div_lt_iff₀ (by positivity : (0 : Real) < k + 1)] have hkreal : (N : Real) ≤ k := by exact_mod_cast hk - have hk' : (1 / e : Real) < k + 1 := by linarith have hrec : e * (1 / e : Real) = 1 := by field_simp nlinarith by_cases hij : i = j diff --git a/LeanPool/ApollonianSuperharmonic/IntegralityLatticeIndex.lean b/LeanPool/ApollonianSuperharmonic/IntegralityLatticeIndex.lean index ebc0768914..e70872a16e 100644 --- a/LeanPool/ApollonianSuperharmonic/IntegralityLatticeIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/IntegralityLatticeIndex.lean @@ -61,18 +61,6 @@ theorem IntegralityLatticeIndex (C : BandCircle) : have index_pos : 0 < index := by dsimp [index] exact Fintype.card_pos - have card_multiple (z : GaussianInt ⧸ IntegralityLattice C) : - index • z = 0 := by - have hs := Fintype.sum_equiv (Equiv.addLeft z) (fun x => z + x) - (fun x => x) (fun x => rfl) - have hs' : (∑ x : GaussianInt ⧸ IntegralityLattice C, (z + x)) = - ∑ x : GaussianInt ⧸ IntegralityLattice C, x := by - simpa using hs - rw [Finset.sum_add_distrib, Finset.sum_const] at hs' - have hz : index • z + (∑ x : GaussianInt ⧸ IntegralityLattice C, x) = - 0 + (∑ x : GaussianInt ⧸ IntegralityLattice C, x) := by - simp [index] - exact add_right_cancel hz have multiple (z : GaussianInt) : index • z ∈ IntegralityLattice C := by have hzero : quotientMap (index • z) = 0 := by simp [quotientMap, index] @@ -112,7 +100,6 @@ theorem IntegralityLatticeIndex (C : BandCircle) : have hc_nat : (C.1.1.1.natAbs : ℤ) = C.1.1.1 := Int.natAbs_of_nonneg hc_nonneg have hnat : (C.1.1.1.natAbs : ℤ) ≤ (index : ℤ) := by rw [hc_nat, ← hprod_int] - have hn_one : (1 : ℤ) ≤ n := by omega have hfactor : 0 ≤ (n - 1) * C.1.1.1 := mul_nonneg (by omega) hc_nonneg nlinarith diff --git a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean index 5deba8990c..a49d61ecb1 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean @@ -380,136 +380,6 @@ private theorem hQneg : ext <;> simp [GaussianQuarterTurn] rw [hneg, hQ] -private theorem hrotplus : - (by - classical - exact - (∀ (T : ProtoTile), ∀ (v : GaussianInt), (T.cells.Nonempty) → ((QuarterTurnSymmetric T) → - ((TileTouching T (TileTranslation T v)) → (TileTouching T (TileTranslation T - (GaussianQuarterTurn v)))))) → (∀ (T : ProtoTile), ∀ (q : Fin (4 : ℕ) → - CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (Finset.Nonempty T.cells) → ((LatticeTile T - ∧ TileArea T = (q (0 : Fin (4 : ℕ))).1.toNat ∧ (∀ (S : Fin (3 : ℕ) → Bool → - ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i - s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i - s).cells) → ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), LatticeTile (TileCellComplement T (S i - s)) ∧ TileTouching (TileCellComplement T (S i s)) (S i s)) ∧ QuarterTurnSymmetric T ∧ - ((1 : ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), TouchingTriple T - (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation - T (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) ∧ ((1 : - ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile - (q i.succ) U → TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 - (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple T (TileTranslation T - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (U : - ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → BandPrototile (q (i + (1 - : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • - (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V - - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin - (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin - (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple T U V) ∧ ∀ (r : Fin (4 - : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin - (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : - Fin (4 : ℕ)) → (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → (q (3 : Fin (4 : - ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → ∀ (P : Fin (3 - : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) - → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i - s (P i s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ - (P i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : - Fin (3 : ℕ)) true) i s (Q i s)) → (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) - true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (Q i s).cells) → (∀ (i : Fin (3 : - ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : Fin (3 : ℕ)) false) i s (S i s)) → - (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s - : Bool), x ∈ (S i s).cells) → - let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); - let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); (∀ (a : - PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)).Nonempty → AllowedSubtileIncidence a b) ∧ - (¬AllowedSubtileIncidence a b → FootprintVertices (SubtileOccurrenceInterpretation P - u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ - (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ FootprintVertices (P (0 : - Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ⊆ FootprintVertices - (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ - FootprintVertices (P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (0 : Fin (3 : ℕ)) - false) ⊆ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin - (3 : ℕ)) false) ∪ FootprintVertices (Q (0 : Fin (3 : ℕ)) false) ∪ FootprintVertices - (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → - ((TileTouching T (TileTranslation T (BandVectors.1 (q i.succ) (q 0)))) → - ((GaussianQuarterTurn (BandVectors.1 (q i.succ) (q 0)) = BandVectors.1 (q 0) (q - i.succ)) → (TileTouching T (TileTranslation T (BandVectors.1 (q 0) (q i.succ)))))))) - ) := by - classical - intro rotate_touch T q i hnonempty hsim hplus hQ - have ht := rotate_touch T _ hnonempty hsim.2.2.2.1 hplus - simpa [hQ] using ht - -private theorem hrotminus : - (by - classical - exact - (∀ (T : ProtoTile), ∀ (v : GaussianInt), (T.cells.Nonempty) → ((QuarterTurnSymmetric T) → - ((TileTouching T (TileTranslation T v)) → (TileTouching T (TileTranslation T - (GaussianQuarterTurn v)))))) → (∀ (T : ProtoTile), ∀ (q : Fin (4 : ℕ) → - CircleCoordinates), ∀ (i : Fin (3 : ℕ)), (Finset.Nonempty T.cells) → ((LatticeTile T - ∧ TileArea T = (q (0 : Fin (4 : ℕ))).1.toNat ∧ (∀ (S : Fin (3 : ℕ) → Bool → - ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i - s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i - s).cells) → ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), LatticeTile (TileCellComplement T (S i - s)) ∧ TileTouching (TileCellComplement T (S i s)) (S i s)) ∧ QuarterTurnSymmetric T ∧ - ((1 : ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), TouchingTriple T - (TileTranslation T (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation - T (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) ∧ ((1 : - ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile - (q i.succ) U → TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 - (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple T (TileTranslation T - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (U : - ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U → BandPrototile (q (i + (1 - : Fin (3 : ℕ))).succ) V → TileCentroid U - TileCentroid T = (1 / 2 : ℝ) • - (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V - - TileCentroid T = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin - (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin - (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple T U V) ∧ ∀ (r : Fin (4 - : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : Fin - (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 : - Fin (4 : ℕ)) → (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → (q (3 : Fin (4 : - ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → ∀ (P : Fin (3 - : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) - → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i - s (P i s)) → (∀ (x : LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ - (P i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : - Fin (3 : ℕ)) true) i s (Q i s)) → (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) - true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (Q i s).cells) → (∀ (i : Fin (3 : - ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : Fin (3 : ℕ)) false) i s (S i s)) → - (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s - : Bool), x ∈ (S i s).cells) → - let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); - let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); (∀ (a : - PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)).Nonempty → AllowedSubtileIncidence a b) ∧ - (¬AllowedSubtileIncidence a b → FootprintVertices (SubtileOccurrenceInterpretation P - u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ - (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ FootprintVertices (P (0 : - Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ⊆ FootprintVertices - (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ - FootprintVertices (P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (0 : Fin (3 : ℕ)) - false) ⊆ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin - (3 : ℕ)) false) ∪ FootprintVertices (Q (0 : Fin (3 : ℕ)) false) ∪ FootprintVertices - (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → - ((TileTouching T (TileTranslation T (-BandVectors.1 (q i.succ) (q 0)))) → - ((GaussianQuarterTurn (-BandVectors.1 (q i.succ) (q 0)) = -BandVectors.1 (q 0) (q - i.succ)) → (TileTouching T (TileTranslation T (-BandVectors.1 (q 0) (q i.succ)))))))) - ) := by - classical - intro rotate_touch T q i hnonempty hsim hminus hQneg - have ht := rotate_touch T _ hnonempty hsim.2.2.2.1 hminus - simpa [hQneg] using ht - private theorem htouch : (by classical @@ -670,15 +540,6 @@ private theorem hT5 : ) := by classical intro q hq A B D j hA hB hD hcentB hcentD - have hgt : 1 < (q 0).1 := by - by_contra hn - have hzero : ∀ k : Fin 3, (q k.succ).1 = 0 := by - intro k - have hlt := hq.2 k - have hn' : (q k.succ).1 ≤ 0 := by omega - exact le_antisymm hn' ((ProperBandCurvatureStructure q hq).2.1 k) - have h01 := (ProperBandCurvatureStructure q hq).2.2 0 1 (hzero 0) (hzero 1) - exact (by decide : (0 : Fin 3) ≠ 1) h01 exact (BandTileSimultaneousInduction q hq A hA).2.2.2.2.2.2.1 j B D hB hD hcentB hcentD @@ -841,11 +702,13 @@ theorem LatticeAdjacentInterfacePath : have hQneg : GaussianQuarterTurn (-BandVectors.1 (q i.succ) (q 0)) = -BandVectors.1 (q 0) (q i.succ) := LatticeInterfacePathGeometry.hQneg q i hQ have hrotplus : TileTouching T - (TileTranslation T (BandVectors.1 (q 0) (q i.succ))) := - LatticeInterfacePathGeometry.hrotplus rotate_touch T q i hnonempty hsim hplus hQ + (TileTranslation T (BandVectors.1 (q 0) (q i.succ))) := by + have ht := rotate_touch T _ hnonempty hsim.2.2.2.1 hplus + simpa [hQ] using ht have hrotminus : TileTouching T - (TileTranslation T (-BandVectors.1 (q 0) (q i.succ))) := - LatticeInterfacePathGeometry.hrotminus rotate_touch T q i hnonempty hsim hminus hQneg + (TileTranslation T (-BandVectors.1 (q 0) (q i.succ))) := by + have ht := rotate_touch T _ hnonempty hsim.2.2.2.1 hminus + simpa [hQneg] using ht let v := (if e = true then (BandVectors.1 (q 0) (q i.succ)) else -BandVectors.1 (q 0) (q i.succ)) have htouch : TileTouching T (TileTranslation T v) := LatticeInterfacePathGeometry.htouch T q diff --git a/LeanPool/ApollonianSuperharmonic/LatticeDiskUnionIntersectionConnected.lean b/LeanPool/ApollonianSuperharmonic/LatticeDiskUnionIntersectionConnected.lean index c3ca740b4e..12a874a52b 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeDiskUnionIntersectionConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeDiskUnionIntersectionConnected.lean @@ -119,7 +119,6 @@ theorem LatticeDiskUnionIntersectionConnected (U V W : ProtoTile) rw [← hvertices] at hvertexIE rw [← hedges] at hedgeIE omega - have hEfinite : E.Finite := (edge_finite U).inter_of_left (FootprintEdges V) have hXfinite : X.Finite := (vertex_finite U).inter_of_left (FootprintVertices V) have hgrid : ∀ e ∈ E, ∃ a b : GaussianInt, e = {a, b} ∧ FourNeighborAdjacent a b := by diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean index 78357df39c..fc26d906db 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileBoundarySimpleGridCycle.lean @@ -726,15 +726,6 @@ theorem LatticeTileBoundarySimpleGridCycle (T : ProtoTile) (hT : LatticeTile T) (1 - (t : Real)) * ((a.im : Int) : Real) + (t : Real) * ((b.im : Int) : Real)) ∈ TileRealization T := BoundaryCycleProof.boundary_edge_segment T boundary_edge_card_two a b hab - have cyclic_edge_segment : - ∀ a b : GaussianInt, (a, b) ∈ cyclicEdges → - ∀ t : Set.Icc (0 : Real) 1, - ((1 - (t : Real)) * ((a.re : Int) : Real) + - (t : Real) * ((b.re : Int) : Real), - (1 - (t : Real)) * ((a.im : Int) : Real) + - (t : Real) * ((b.im : Int) : Real)) ∈ TileRealization T := by - intro a b hab - exact boundary_edge_segment a b (cyclic_edge_boundary a b hab) have unoccupied_center_outside (q : LatticeCell) (hq : q ∉ T.cells) : ((((q.re : Int) : Real) + (1 / 2 : Real)), (((q.im : Int) : Real) + (1 / 2 : Real))) ∉ TileRealization T := diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean index c00adb40af..3936a5b8f6 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileComplementGridConnected.lean @@ -526,14 +526,9 @@ private theorem every_outside_reaches : intro T S step reach reach_target_out around base boundary_outside_reaches z exterior hexteriorBase right_halfplane q hqOut by_contra hqbase - have hqle : q.re ≤ z.re := by - by_contra hnot - exact hqbase (Relation.ReflTransGen.trans - (right_halfplane q (by omega)) hexteriorBase) let distance (r : LatticeCell) : Nat := Int.natAbs (z.re - r.re) have hfind : ∃ n, ∃ r : LatticeCell, reach q r ∧ n = distance r := ⟨distance q, q, Relation.ReflTransGen.refl, rfl⟩ - let n := Nat.find hfind rcases Nat.find_spec hfind with ⟨r, hqr, hn⟩ have hrOut : r ∉ S := reach_target_out hqOut hqr have hrbase : ¬ reach r base := by @@ -695,7 +690,6 @@ theorem LatticeTileComplementGridConnected (T : ProtoTile) have hzS : z ∈ S := hz let exterior : LatticeCell := z + 1 have hexteriorOut : exterior ∉ S := ComplementGridPaths.hexteriorOut T z hzmax - let rightEdge : Finset GaussianInt := {z + 1, z + 1 + ⟨0, 1⟩} have hrightEdge := ComplementGridPaths.hrightEdge T z hzS hexteriorOut have hexteriorBase := ComplementGridPaths.hexteriorBase T base boundary_outside_reaches z hexteriorOut hrightEdge diff --git a/LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean b/LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean index cb9fcdd962..fe693df9cc 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeTileGridEulerCount.lean @@ -404,8 +404,6 @@ theorem LatticeTileGridEulerCount (T : ProtoTile) (hT : LatticeTile T) : ¬ (z - 1 ∈ T.cells ∧ z - 1 + I ∈ T.cells)).card have hrun : R = J + 1 := GridEulerGeometry.hrun T hT hgrid have hparts : T.cells.card = H + R ∧ V = Q + J := GridEulerGeometry.hparts T - have hEuler : T.cells.card + Q = H + V + 1 := by - omega have hcornerMem {z : GaussianInt} (hz : z ∈ T.cells) := GridEulerGeometry.hcornerMem T (z := z) hz have hcornerCount (z : GaussianInt) := TileCornerMultiplicity.cornerCount T z diff --git a/LeanPool/ApollonianSuperharmonic/LatticeVertexSectorFacts.lean b/LeanPool/ApollonianSuperharmonic/LatticeVertexSectorFacts.lean index bc6d4b5b28..2376dadd6e 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeVertexSectorFacts.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeVertexSectorFacts.lean @@ -81,7 +81,6 @@ theorem edgeInjective : := by classical intro neighbor edgeAt neighbor_ne_center neighbor_injective edgeAt_mem x j k h - have hx := (edgeAt_mem x j).1 have hn := (edgeAt_mem x j).2 have hnm : neighbor x j ∈ edgeAt x k := by rw [← h]; exact hn have hchoices : neighbor x j = x ∨ neighbor x j = neighbor x k := by diff --git a/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean b/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean index b0e6a242f0..4bf55fed9d 100644 --- a/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/LocalLatticeInterfaceSectors.lean @@ -207,7 +207,6 @@ private theorem hxBoundary : hjY jZ hjZ have hXY := Finset.disjoint_left.mp hXYdisjoint have hYZ := Finset.disjoint_left.mp hYZdisjoint - have hZX := Finset.disjoint_left.mp hZXdisjoint have hxXB : x ∈ BoundaryFootprintVertices X := incident_boundary X x hXne ⟨jX, hjX⟩ ⟨jY, fun h => hXY h hjY⟩ have hxYB : x ∈ BoundaryFootprintVertices Y := @@ -533,9 +532,6 @@ theorem LocalLatticeInterfaceSectors : (hsome : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells) (hmissing : ∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ T.cells) := InterfaceSectorGeometry.incident_boundary T x hsome hmissing - let I : GaussianInt := ⟨0, 1⟩ - let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := - ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] have common_edge_transition (U V : ProtoTile) (x : GaussianInt) (e : Finset GaussianInt) (hdisjoint : Disjoint U.cells V.cells) (hxe : x ∈ e) diff --git a/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean index 0367bfd353..897269ce91 100644 --- a/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean @@ -485,9 +485,6 @@ private theorem hsubInverse : classical intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle markedData C' ginv hcircleL htileL hfunL inversePresentation inverseSlot hinverseProper hinversePositive inverseCircle hinverseCircle hsubNormalized - let g := bundle.symmetry - let sigma : Fin 3 → Fin 3 := fun j => - if BandPackingSymmetryReversesOrientation g then -j else j have htransport := (markedData.1 ginv (BandPackingSymmetryCircleAction bundle.symmetry C₀.1.1) C'.1.1 @@ -2504,10 +2501,6 @@ private theorem leftAdjacencyCase : exact hnotMarked (hmarkedOld.mp hx)) rcases hleftAdj with ⟨hOFixed, hOSelected, pFixed, pSelected, hslopeFixed, hslopeSelected, hleftGeometry⟩ - have hpFixedEq := MarkedAdjacencyGeometry.hpFixedEq C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle pFixed - hslopeFixed - have hpSelectedEq := MarkedAdjacencyGeometry.hpSelectedEq C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle - selectedSlope hslope' pSelected hslopeSelected rcases hleftGeometry with hunit | hpresented · rcases hunit with ⟨hcurvUnit, orientation, v, hunitStep, hcentUnit, hslopeUnitRe, hslopeUnitIm⟩ @@ -2516,28 +2509,6 @@ private theorem leftAdjacencyCase : bundle actionCurvature hcurvUnit have hcentUnitInv := MarkedAdjacencyGeometry.hcentUnitInv C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv htileL v hcentUnit centroidCov - let unitPositive := - ({1, -1, ⟨0, 1⟩, -⟨0, 1⟩, 1 + ⟨0, 1⟩, - -(1 + ⟨0, 1⟩)} : Finset GaussianInt) - let unitNegative := - ({1, -1, ⟨0, 1⟩, -⟨0, 1⟩, -1 + ⟨0, 1⟩, - -(-1 + ⟨0, 1⟩)} : Finset GaussianInt) - let matrixVector (c : CircleCoordinates) (w : GaussianInt) : ℝ × ℝ := - (((1 + (c.2.re : ℝ)) * (w.re : ℝ) + - (c.2.im : ℝ) * (w.im : ℝ)) / 2, - ((c.2.im : ℝ) * (w.re : ℝ) + - (1 - (c.2.re : ℝ)) * (w.im : ℝ)) / 2) - let slopeDifferenceAction : BandPackingSymmetry → GaussianInt → - (ℝ × ℝ) → ℝ × ℝ := - BandPackingSymmetry.rec - (fun _ d => d) - (fun _ d => (-d.2, d.1)) - (fun _ d => (-d.1, d.2)) - (fun z w d => - (d.1 + (z.re : ℝ) * (w.re : ℝ) + (z.im : ℝ) * (w.im : ℝ), - d.2 + (z.im : ℝ) * (w.re : ℝ) - (z.re : ℝ) * (w.im : ℝ))) - (fun a b iha ihb w d => - iha (BandPackingSymmetryVectorAction b w) (ihb w d)) have matrixCov := MarkedAdjacencyGeometry.matrixCov actionCurvature have slopeDiffCov := MarkedAdjacencyGeometry.slopeDiffCov actionCurvature centroidCov matrixCov @@ -2826,10 +2797,6 @@ private theorem forwardAdjacencyCase : BandPackingSymmetryProperCovariance ginv r hr, hrootCoord, hselectedCoord, hcentOriginal, hslopeReInv, hslopeImInv, hnewAdj, ?_⟩) - let companionForward := TileTranslation bundle.normalizedFixed - ((⟨0, 1⟩ : GaussianInt) ^ t.val * - (if Even t.val then BandVectors.1 (r 0) (r j.succ) - else BandVectors.1 (r j.succ) (r 0))) have hpointInv := MarkedAdjacencyGeometry.hpointInvAt1389 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv hvecL hpoint have hmarkCov := @@ -3023,10 +2990,6 @@ private theorem reverseAdjacencyCase : t', hslopeSelectedInv, hslopeFixedOriginal, BandPackingSymmetryProperCovariance ginv r hr, hselectedCoord, hfixedCoord, hcentOriginal, hslopeReInv, hslopeImInv, hnewAdj, ?_⟩) - let companionReverse := TileTranslation selectedSupport - ((⟨0, 1⟩ : GaussianInt) ^ t.val * - (if Even t.val then BandVectors.1 (r 0) (r j.succ) - else BandVectors.1 (r j.succ) (r 0))) have hpointInv := MarkedAdjacencyGeometry.hpointInvAt1389 C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle ginv hvecL hpoint have hmarkCov := @@ -3188,7 +3151,6 @@ theorem MarkedOdometerAdjacencyReduction : · exact P5630T1MarkedRightOdometerAdjacencyReduction · intro C₀ Cᵢ q i s T₀ Tᵢ h₀ hᵢ x p₀ pᵢ horbit hq hq₀ hqᵢ hslope₀ hslopeᵢ hcentroid hslopex hslopey hadj hx₀ hxᵢ hstar - have inversePhase := BandPackingSymmetryInversePhaseCancellation have markedData := BandPackingSymmetryMarkedDataCovariance dsimp obtain ⟨bundle, subtilePlacement, hsubtilePlacement⟩ := @@ -3232,10 +3194,6 @@ theorem MarkedOdometerAdjacencyReduction : hᵢ x bundle transportedFixedSlope hfixedSlope have hnormalizedProper : ProperBandQuadruple normalizationPresentation := BandPackingSymmetryProperCovariance g q hq - let oldUR := TileTranslation T₀ - ((⟨0, 1⟩ : GaussianInt) ^ s.val * - (if Even s.val then BandVectors.1 (q 0) (q i.succ) - else BandVectors.1 (q i.succ) (q 0))) let rowUR := TileTranslation bundle.normalizedRoot ((⟨0, 1⟩ : GaussianInt) ^ transportedRotation.val * (if Even transportedRotation.val then diff --git a/LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean index f1bee5ee48..ebd59e63a9 100644 --- a/LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/OdometerStringRespectRegularFamilyCentralCovariance.lean @@ -59,9 +59,6 @@ theorem OdometerStringRespectRegularFamilyCentralCovariance rcases raw with ⟨rawString, rawTiles, rawChain⟩ rcases hrespect with ⟨originalString, originalTiles, originalChain⟩ rcases originalString with ⟨hbase0, hhead0, hlast0, hpair0, hmem0, hchain0, hheight0⟩ - have source_band : ∀ {T : ProtoTile}, T ∈ tiles → BandPrototile C.1.1 T := by - intro T hT - exact band_of_member (hmem0 T hT) have transportAdjacent : ∀ {T T' U U' : ProtoTile} {g g' : PartialOdometer}, (TileTranslation (TileHalfTurn T) u).cells = U.cells → (TileTranslation (TileHalfTurn T') u).cells = U'.cells → diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean index 86abecb8c0..c405455634 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean @@ -1948,13 +1948,6 @@ private theorem opposingBoundaryConclusion : have hreverseRespect := OdometerStringRespectRegularFamilyCentralCovariance Cᵢ orientation base Rminus Rplus tiles reverseTiles hs gs centerShift a hrespect hreverse hcellPairs htransform - have hreverseHead : reverseTiles.head? = some Rplus := hreverse.2.1 - have hreverseTilesNonempty := OpposingBoundaryGeometry.hreverseTilesNonempty Rplus reverseTiles - hreverseHead - have hgsNonempty : gs ≠ [] := by - have hhead : gs.head? = some hplus := hgsHead - intro h - simp [h] at hhead have forall2_mem_right : ∀ {α β : Type} {r : α → β → Prop} {xs : List α} {ys : List β}, List.Forall₂ r xs ys → @@ -2095,12 +2088,6 @@ theorem OpposingBoundaryOdometerStrings hplusCells, hcellPairs⟩ := TileStringRegularFamilyCentralCovariance Cᵢ orientation base Rminus Rplus tiles hstring - have tile_string_normalization := - @TileStringRegularFamilyCentralCovariance - have odometer_string_normalization := - @OdometerStringRespectRegularFamilyCentralCovariance - have ancestor_inner_normalization := - @AncestorOdometerInnerSupportNormalization have hpouter_eq : pouter = p₀ := OpposingBoundaryGeometry.hpouter_eq h₀ p₀ hs₀ pouter hpouter let pminus := p₀ + (1 / 2 : Real) • GaussianRealPoint (BandVectors.2 (q i.succ) (q 0) - BandVectors.2 (q 0) (q i.succ)) @@ -2218,10 +2205,6 @@ theorem OpposingBoundaryOdometerStrings have htbackZero := finiteTranslationFix Rminus tback hRminusCells hbackCells have hbackSameDomain := OpposingBoundaryGeometry.hbackSameDomain q i hseed centerShift couter tback hbackDomains htbackZero - let hminusAffine := PartialOdometerAffineTranslate hminus 0 cback eback - let bplus : Int := -eback - let hminusBack := PartialOdometerAffineTranslate - (PartialOdometerHalfTurn hplus) centerShift a bplus have hbackBackDomain := OpposingBoundaryGeometry.hbackBackDomain q i hseed centerShift couter eback have hminusBackEq := OpposingBoundaryGeometry.hminusBackEq q i hseed centerShift couter tback @@ -2255,12 +2238,6 @@ theorem OpposingBoundaryOdometerStrings (by dsimp [pminus]; abel) (by dsimp [pplus]; abel) rcases hrespectResult with ⟨_, _, _, hs, hhsHead, hhsLast, hrespect, hancestorForward⟩ have hlengthEq : hs.length = tiles.length := hrespect.2.1.length_eq.symm - have hlengthHs : 2 ≤ hs.length := by omega - let constAt : Nat → Int := fun n => - if n = 0 then 0 else if n + 1 = hs.length then bplus else b - let transformAt : Nat → PartialOdometer → PartialOdometer := fun n h => - PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift a (constAt n) - let gs := hs.mapIdx transformAt have transformForall := OpposingBoundaryGeometry.transformForall centerShift couter eouter eback hs exact (OpposingBoundaryConclusion.opposingBoundaryConclusion q hq C₀ Cᵢ i hC₀ hCᵢ T₀ T₀' h₀ h₀' diff --git a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean index 9e4c23c10f..11760028fa 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean @@ -195,9 +195,6 @@ private theorem hvertsEqAt258 : intro base x tileAt unitAt hcellsEq z have hunitne : (unitAt z).cells.Nonempty := by simp [unitAt, TileTranslation] - have htilene : (tileAt z).cells.Nonempty := by - rw [hcellsEq] - exact hunitne simp [FootprintVertices, hunitne, hcellsEq] private theorem hedgesEqAt266 : @@ -261,9 +258,6 @@ private theorem hvertsEqAt314 : intro base x tileAt x0 unitAt turnedAt hcellCalc z have hturnedne : (turnedAt z).cells.Nonempty := by simp [turnedAt, unitAt, TileQuarterTurn, TileTranslation] - have htilene : (tileAt z).cells.Nonempty := by - rw [hcellCalc] - exact hturnedne simp [FootprintVertices, hturnedne, hcellCalc] private theorem hedgesEqAt322 : @@ -1107,9 +1101,6 @@ private theorem finish : intro base R S forward reverse a b tileAt r s hR hS F G hrs hnadjCoord forwardInterior reverseInterior faces hfacesNe hfirst hlast hfaceChain ι typeclassInstance0 PP xi faceAt hadjXi htileXi hinjFace hinc - let goodV : GaussianInt → Prop := fun x => - (∃ a ∈ (F.drop 1).dropLast, x ∈ FootprintVertices (tileAt a)) ∧ - (∃ b ∈ (G.drop 1).dropLast, x ∈ FootprintVertices (tileAt b)) let goodE : GaussianInt → GaussianInt → Prop := fun x y => (∃ a ∈ (F.drop 1).dropLast, {x, y} ∈ FootprintEdges (tileAt a)) ∧ (∃ b ∈ (G.drop 1).dropLast, {x, y} ∈ FootprintEdges (tileAt b)) @@ -1243,7 +1234,6 @@ private theorem unrotatedInterface : let unitAt : Int × Int → ProtoTile := fun z => TileTranslation (⟨{x}, x⟩ : ProtoTile) (⟨z.1, z.2⟩ : GaussianInt) - have hshift := OpposingInterfaceGeometry.hshift have hcellsEq := OpposingInterfaceGeometry.hcellsEq base x hcells (OpposingInterfaceGeometry.hshift') have hvertsEq (z : Int × Int) : @@ -1386,8 +1376,6 @@ theorem OpposingStringInterfacePath · subst a subst b let x0 : GaussianInt := ⟨x.im, -x.re - 1⟩ - have hx0 : GaussianQuarterTurn x0 - 1 = x := by - ext <;> simp [x0, GaussianQuarterTurn] let unitAt : Int × Int → ProtoTile := fun z => TileTranslation (⟨{x0}, x0⟩ : ProtoTile) (⟨z.1, z.2⟩ : GaussianInt) diff --git a/LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean b/LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean index 2e237e21db..98cc693a4d 100644 --- a/LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean +++ b/LeanPool/ApollonianSuperharmonic/OppositeRoutedCommonEdgeOutsideCellUnique.lean @@ -39,7 +39,6 @@ theorem OppositeRoutedCommonEdgeOutsideCellUnique LatticeVertexIncidentCell x s ∉ F.cells → LatticeVertexIncidentCell x r = LatticeVertexIncidentCell x s := by -- BODY - let I : GaussianInt := ⟨0, 1⟩ obtain ⟨a, _, ha⟩ := P3102T2CommonEdgeSectorTransition E F x edge hdisjoint hx hedge have ha0 : LatticeVertexIncidentCell x a ∈ E.cells ∨ diff --git a/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean b/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean index cee8288ba1..2191ea9a71 100644 --- a/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/OrientedTouchingCovariance.lean @@ -574,9 +574,6 @@ theorem OrientedTouchingCovariance : (GaussianRealPoint (GaussianQuarterTurn z) - GaussianRealPoint (GaussianQuarterTurn w)) → TouchingTriple T U V := TouchingCovarianceProof.turn5 quarter_translate same_touch shift_centroid - have inverse_turn (x : GaussianInt) : - GaussianQuarterTurn ⟨x.im, -x.re⟩ = x := by - ext <;> simp [GaussianQuarterTurn] constructor · intro T₀ Tᵢ i s h₀ hᵢ hc fin_cases s diff --git a/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean index 47eac73b2d..ffcc9d1398 100644 --- a/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean +++ b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregateJunctionData.lean @@ -2262,9 +2262,6 @@ private theorem all_centroids : have d₃ := (cert.outer_occurrence 2 false).2.2 norm_num [Prod.ext_iff,GaussianRealPoint,Fin.succ,Fin.add,Fin.add_def,Fin.ofNat,Matrix.cons_val] at sumV v₁ v₂ v₃ u v f₁ f₂ f₃ c₁ c₂ c₃ d₁ d₂ d₃ - have fin2 : (⟨2,by decide⟩ : Fin 4) = 2 := rfl - have fin3 : (⟨3,by decide⟩ : Fin 4) = 3 := rfl - have fin2_3 : (⟨2,by decide⟩ : Fin 3) = 2 := rfl refine ⟨?_,?_,?_,?_⟩ all_goals intro i; fin_cases i all_goals dsimp only [plusRepresentative,minusRepresentative,firstPeriod,firstParent,firstShift] @@ -2616,61 +2613,8 @@ theorem P1BandOrderedGeneralMixedAggregateJunctionData GaussianRealPoint (BandVectors.1 (q 0) (q ((i + 1).succ)))) → junctionData T U V) := by -- BODY - let mixedNeighbors (a : PeriodicSubtileIndex) : Finset PeriodicSubtileIndex := - let m := a.first - let n := a.second - match a.label with - | .A => {⟨.B,m,n⟩, ⟨.B,m,n+1⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m,n⟩, - ⟨.C,m+1,n+1⟩, ⟨.D,m,n⟩, ⟨.E,m,n+1⟩, ⟨.F,m,n⟩} - | .B => {⟨.A,m,n⟩, ⟨.A,m,n-1⟩, ⟨.A,m-1,n-1⟩, ⟨.C,m,n⟩, - ⟨.D,m-1,n-1⟩, ⟨.D,m,n⟩, ⟨.E,m,n⟩, ⟨.F,m,n-1⟩} - | .C => {⟨.A,m,n⟩, ⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.D,m-1,n⟩, - ⟨.E,m-1,n⟩, ⟨.F,m,n⟩} - | .D => {⟨.A,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, - ⟨.E,m,n⟩, ⟨.F,m+1,n⟩} - | .E => {⟨.A,m,n-1⟩, ⟨.B,m,n⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩} - | .F => {⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.C,m,n⟩, ⟨.D,m-1,n⟩} have mixedNeighbors_iff := MixedAggregateGeometry.mixedNeighbors_iff (MixedAggregateGeometry.mixedNeighbors_symmetric) - let mixedDecode (k : Nat) : PeriodicSubtileIndex := - ⟨match k % 6 with | 0 => .A | 1 => .B | 2 => .C | 3 => .D | 4 => .E | _ => .F, - (k / 6 / 7 : Int) - 3, (k / 6 % 7 : Int) - 3⟩ - let mixedBlock (m n : Int) : Finset PeriodicSubtileIndex := - {⟨.A,m,n⟩,⟨.B,m,n⟩,⟨.C,m,n⟩,⟨.D,m,n⟩,⟨.E,m,n⟩,⟨.F,m,n⟩} - let mixedComponents (r : Nat) : Finset PeriodicSubtileIndex × - Finset PeriodicSubtileIndex × Finset PeriodicSubtileIndex := - (mixedBlock 0 0, match r with - | 0 => (mixedBlock 1 0, {⟨.B,1,1⟩}) - | 1 => (mixedBlock 0 1, {⟨.D,-1,0⟩}) - | 2 => (mixedBlock (-1) (-1), {⟨.F,0,-1⟩}) - | 3 => ({⟨.A,0,-1⟩}, {⟨.C,1,0⟩}) - | 4 => ({⟨.C,1,1⟩}, {⟨.E,0,1⟩}) - | _ => ({⟨.E,-1,0⟩}, {⟨.A,-1,-1⟩})) - let mixedSelection (j : Fin 42) : Finset PeriodicSubtileIndex := - let c := mixedComponents (j.val / 7) - let k := j.val % 7 + 1 - (if k % 2 = 1 then c.1 else ∅) ∪ - (if k / 2 % 2 = 1 then c.2.1 else ∅) ∪ - (if k / 4 % 2 = 1 then c.2.2 else ∅) - let mixedTreeVertices (tree : List (Nat × Nat)) (S : Finset PeriodicSubtileIndex) : - Finset PeriodicSubtileIndex := - tree.foldl (fun S e => insert (mixedDecode e.1) S) S - let mixedTreeCheck (D : Finset PeriodicSubtileIndex) (inside : Bool) - (es : List (Nat × Nat)) (S : Finset PeriodicSubtileIndex) : Bool := - es.foldr (fun (a,b) next S => - decide ((if inside then mixedDecode a ∈ D else mixedDecode a ∉ D) ∧ - mixedDecode b ∈ S ∧ mixedDecode b ∈ mixedNeighbors (mixedDecode a)) && - next (insert (mixedDecode a) S)) (fun _ => true) S - let mixedInTrees : List (List (Nat × Nat)) := MixedAggregateGeometry.incomingCertificateTrees - let mixedOutTrees : List (List (Nat × Nat)) := MixedAggregateGeometry.outgoingCertificateTrees - let mixedInHubs : List Nat := - [144, 186, 144, 193, 144, 186, 144, 144, 150, 144, 105, 144, 150, 144, 144, 96, 144, - 143, 144, 96, 144, 144, 138, 144, 188, 144, 138, 144, 144, 194, 144, 154, 144, 194, - 144, 144, 106, 144, 96, 144, 106, 144] - let original := SubtileOccurrenceInterpretation cert.P cert.u cert.v - let offset (a : PeriodicSubtileIndex) : GaussianInt := - (a.first : GaussianInt) * cert.u + (a.second : GaussianInt) * cert.v - let precursor (a : PeriodicSubtileIndex) := TileTranslation cert.O (offset a) let paired (a : PeriodicSubtileIndex) : PeriodicSubtileIndex := ⟨.B,a.first,a.second⟩ have cellDisk := MixedAggregateGeometry.cellDisk have translation_complement := MixedAggregateGeometry.translation_complement @@ -2679,30 +2623,8 @@ theorem P1BandOrderedGeneralMixedAggregateJunctionData have precursor_subset_B := MixedAggregateGeometry.precursor_subset_B q cfg C₀ T cert (MixedAggregateGeometry.hOB q cfg C₀ T cert) have mod_subset := MixedAggregateGeometry.mod_subset q cfg C₀ T cert mod_nonA mod_A - let exception (j : Fin 42) : Option PeriodicSubtileIndex := - if j.val / 7 = 3 ∧ (j.val % 7 + 1) / 2 % 2 = 1 then some ⟨.A,0,-1⟩ else - if j.val / 7 = 5 ∧ (j.val % 7 + 1) / 4 % 2 = 1 then some ⟨.A,-1,-1⟩ else none - let J : ProtoTile → ProtoTile → ProtoTile → Prop := fun A B C => - ∃ AB BC CA ABC : ProtoTile, - LatticeTile A ∧ LatticeTile B ∧ LatticeTile C ∧ - LatticeTile AB ∧ LatticeTile BC ∧ LatticeTile CA ∧ LatticeTile ABC ∧ - Disjoint A.cells B.cells ∧ Disjoint B.cells C.cells ∧ Disjoint C.cells A.cells ∧ - (∀ z : LatticeCell, z ∈ AB.cells ↔ z ∈ A.cells ∨ z ∈ B.cells) ∧ - (∀ z : LatticeCell, z ∈ BC.cells ↔ z ∈ B.cells ∨ z ∈ C.cells) ∧ - (∀ z : LatticeCell, z ∈ CA.cells ↔ z ∈ C.cells ∨ z ∈ A.cells) ∧ - (∀ z : LatticeCell, z ∈ ABC.cells ↔ z ∈ A.cells ∨ z ∈ B.cells ∨ z ∈ C.cells) ∧ - (FootprintEdges A ∩ FootprintEdges B).Nonempty ∧ - (FootprintEdges B ∩ FootprintEdges C).Nonempty ∧ - (FootprintEdges C ∩ FootprintEdges A).Nonempty - let componentIndices (r : Fin 6) (s : Fin 3) := - let c := mixedComponents r.val - if s = 0 then c.1 else if s = 1 then c.2.1 else c.2.2 let owners (D : Finset PeriodicSubtileIndex) := D ∪ (D.filter (fun a => a.label = .A)).image paired - let unionOf (D : Finset PeriodicSubtileIndex) : ProtoTile := - ⟨D.biUnion (fun a => (original a).cells),0⟩ - let component (r : Fin 6) (s : Fin 3) := unionOf (componentIndices r s) - let selectionIndex (r : Fin 6) (s : Fin 7) : Fin 42 := ⟨r.val * 7 + s.val,by omega⟩ have owners_mono {D E : Finset PeriodicSubtileIndex} (h : D ⊆ E) : owners D ⊆ owners E := by exact Finset.union_subset_union h (Finset.image_mono _ (Finset.filter_subset_filter _ h)) have literal_junctions := MixedAggregateGeometry.literal_junctions q cfg C₀ T cert @@ -2722,25 +2644,12 @@ theorem P1BandOrderedGeneralMixedAggregateJunctionData mod_subset (MixedAggregateGeometry.edge_certificate) (MixedAggregateGeometry.edges_mono)) have retarget := MixedAggregateGeometry.retarget cellDisk have imageJ := MixedAggregateGeometry.imageJ - let back (c : GaussianInt) (S : ProtoTile) : ProtoTile := - TileTranslation (TileQuarterTurn (TileQuarterTurn (TileQuarterTurn S))) (GaussianQuarterTurn c) - let turn (c : GaussianInt) (S : ProtoTile) : ProtoTile := - TileTranslation (TileQuarterTurn S) c have back_shift := MixedAggregateGeometry.back_shift have back_symmetric := MixedAggregateGeometry.back_symmetric (MixedAggregateGeometry.back_turn) (MixedAggregateGeometry.back_congr) have core_cells := MixedAggregateGeometry.core_cells q cfg C₀ T cert (MixedAggregateGeometry.outer_cells q cfg C₀ T cert) have component_zero := MixedAggregateGeometry.component_zero q cfg C₀ T cert core_cells - let firstPeriod (i : Fin 3) : GaussianInt := match i.val with - | 0 => cert.u - | 1 => cert.v - | _ => -cert.u-cert.v - let firstShift (i : Fin 3) : GaussianInt := match i.val with - | 0 => cert.u+cert.v - | 1 => -cert.u - | _ => -cert.v - let firstParent (i : Fin 3) := TileTranslation (cert.P i false) (firstShift i) let plusRepresentative (i : Fin 3) : ProtoTile := match i.val with | 0 => TileTranslation (cert.P 0 true) (-cert.v) | 1 => TileTranslation (cert.P 1 true) (cert.u + cert.v) diff --git a/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean index 2ac1f31837..ff60bf9407 100644 --- a/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/P1BandOrderedGeneralMixedAggregatePairedEndpoints.lean @@ -1976,9 +1976,6 @@ theorem P1BandOrderedGeneralMixedAggregatePairedEndpoints (if i = 0 then -cert.v else if i = 1 then cert.u + cert.v else -cert.u) let qLit (i : Fin 3) := TileTranslation (cert.P (i + 1) true) (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) - let markedPoint (i : Fin 3) := cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm - ⟨.J5, if i = 2 then -1 else 0, if i = 1 then 0 else -1⟩) have literalData (i : Fin 3) : BandPrototile (q i.succ) (pLit i) ∧ BandPrototile (q ((i + 1).succ)) (qLit i) ∧ @@ -2007,9 +2004,6 @@ theorem P1BandOrderedGeneralMixedAggregatePairedEndpoints (if i = 0 then cert.u + cert.v else if i = 1 then -cert.u else -cert.v) let qOdd (i : Fin 3) := TileTranslation (cert.P (i - 1) false) (if i = 0 then cert.u else if i = 1 then cert.v else -cert.u - cert.v) - let oddPoint (i : Fin 3) := cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm - ⟨.J6, if i = 0 then 1 else 0, if i = 2 then 0 else 1⟩) have signedNeg := PairedEndpointGeometry.signedNeg have oddLiteralData (i : Fin 3) : BandPrototile (q i.succ) (pOdd i) ∧ diff --git a/LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean b/LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean index 00acf3a720..2c5c13f220 100644 --- a/LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean +++ b/LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean @@ -649,76 +649,17 @@ theorem P3092T1CenteredRectangleDisk let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) - have hq_nonneg (j : Nat) (hj : j ∈ J) (x : ℝ × ℝ) : 0 ≤ q j x := - CenteredRectangleDiskConstruction.hq_nonneg J a b ha j hj x - have hq_pos (j : Nat) (hj : j ∈ J) (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < q j x := - CenteredRectangleDiskConstruction.hq_pos J a b ha hb j hj x hx - have hg_nonneg (x : ℝ × ℝ) : 0 ≤ g x := CenteredRectangleDiskConstruction.hg_nonneg J hJ a b ha x - have hg_pos (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < g x := CenteredRectangleDiskConstruction.hg_pos J hJ - a b ha hb x hx - have hg_zero : g 0 = 0 := CenteredRectangleDiskConstruction.hg_zero J hJ a b - have hq_smul (t : ℝ) (ht : 0 ≤ t) (j : Nat) (x : ℝ × ℝ) : - q j (t • x) = t * q j x := CenteredRectangleDiskConstruction.hq_smul a b t ht j x - have hg_smul (t : ℝ) (ht : 0 ≤ t) (x : ℝ × ℝ) : g (t • x) = t * g x := - CenteredRectangleDiskConstruction.hg_smul J hJ a b t ht x - have hg_cont : Continuous g := CenteredRectangleDiskConstruction.hg_cont J hJ a b -- The reciprocal of the minimum gauge is the attained outer ray radius. - have hR_eq (x : ℝ × ℝ) (hx : x ≠ 0) : R x = (g x)⁻¹ := CenteredRectangleDiskConstruction.hR_eq - J hJ a b ha hb x hx - have hR_attained (x : ℝ × ℝ) : ∃ j ∈ J, R x = (q j x)⁻¹ := - CenteredRectangleDiskConstruction.hR_attained J hJ a b x - have hR_pos (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < R x := CenteredRectangleDiskConstruction.hR_pos J hJ - a b ha hb x hx - have hR_cont (x : ℝ × ℝ) (hx : x ≠ 0) : ContinuousAt R x := - CenteredRectangleDiskConstruction.hR_cont J hJ a b ha hb x hx have hmem (x : ℝ × ℝ) : c + x ∈ (⋃ j ∈ J, Set.Icc (c.1 - a j, c.2 - b j) (c.1 + a j, c.2 + b j)) ↔ g x ≤ 1 := CenteredRectangleDiskConstruction.hmem J hJ c a b ha hb x - have hray (u : ℝ × ℝ) (hu : ‖u‖ = 1) (t : ℝ) (ht : 0 ≤ t) : - c + t • u ∈ (⋃ j ∈ J, Set.Icc (c.1 - a j, c.2 - b j) - (c.1 + a j, c.2 + b j)) ↔ t ≤ R u := CenteredRectangleDiskConstruction.hray J hJ c a b - ha hb u hu t ht -- Uniform bounds suffice for continuity at the center in both directions. - let j₀ := hJ.choose - have hj₀ : j₀ ∈ J := CenteredRectangleDiskConstruction.hj₀ J hJ - let M := J.sup' hJ (fun j => max (a j) (b j)) - let C := max (a j₀)⁻¹ (b j₀)⁻¹ - have hM_pos : 0 < M := CenteredRectangleDiskConstruction.hM_pos J hJ a b ha - have hC_pos : 0 < C := CenteredRectangleDiskConstruction.hC_pos J hJ a b ha - have hq_bound (j : Nat) (hj : j ∈ J) (x : ℝ × ℝ) : ‖x‖ ≤ M * q j x := - CenteredRectangleDiskConstruction.hq_bound J hJ a b ha hb j hj x - have hg_lower (x : ℝ × ℝ) : ‖x‖ ≤ M * g x := CenteredRectangleDiskConstruction.hg_lower J hJ a - b ha hb x - have hg_upper (x : ℝ × ℝ) : g x ≤ C * ‖x‖ := CenteredRectangleDiskConstruction.hg_upper J hJ a - b ha hb x - have hunit (x : ℝ × ℝ) (hx : x ≠ 0) : ‖‖x‖⁻¹ • x‖ = 1 := - CenteredRectangleDiskConstruction.hunit x hx - have hR_normalized (x : ℝ × ℝ) (hx : x ≠ 0) : R (‖x‖⁻¹ • x) = ‖x‖ / g x := - CenteredRectangleDiskConstruction.hR_normalized J hJ a b ha hb x hx let F : (ℝ × ℝ) → (ℝ × ℝ) := fun x => R (‖x‖⁻¹ • x) • x let G : (ℝ × ℝ) → (ℝ × ℝ) := fun x => (R (‖x‖⁻¹ • x))⁻¹ • x - have hF_zero : F 0 = 0 := CenteredRectangleDiskConstruction.hF_zero J hJ a b - have hG_zero : G 0 = 0 := CenteredRectangleDiskConstruction.hG_zero J hJ a b - have hF_formula (x : ℝ × ℝ) : F x = (‖x‖ / g x) • x := - CenteredRectangleDiskConstruction.hF_formula J hJ a b ha hb x - have hG_formula (x : ℝ × ℝ) : G x = (g x / ‖x‖) • x := - CenteredRectangleDiskConstruction.hG_formula J hJ a b ha hb x - have hF_norm (x : ℝ × ℝ) : ‖F x‖ = (‖x‖ / g x) * ‖x‖ := - CenteredRectangleDiskConstruction.hF_norm J hJ a b ha hb x - have hG_norm (x : ℝ × ℝ) : ‖G x‖ = g x := CenteredRectangleDiskConstruction.hG_norm J hJ a b ha - hb x have hgF (x : ℝ × ℝ) : g (F x) = ‖x‖ := CenteredRectangleDiskConstruction.hgF J hJ a b ha hb x have hGF (x : ℝ × ℝ) : G (F x) = x := CenteredRectangleDiskConstruction.hGF J hJ a b ha hb x have hFG (x : ℝ × ℝ) : F (G x) = x := CenteredRectangleDiskConstruction.hFG J hJ a b ha hb x - have hF_bound (x : ℝ × ℝ) : ‖F x‖ ≤ M * ‖x‖ := CenteredRectangleDiskConstruction.hF_bound J hJ - a b ha hb x - have hG_bound (x : ℝ × ℝ) : ‖G x‖ ≤ C * ‖x‖ := CenteredRectangleDiskConstruction.hG_bound J hJ - a b ha hb x - have hradial_cont (f : (ℝ × ℝ) → (ℝ × ℝ)) (K : ℝ) (hK : 0 ≤ K) - (hf0 : f 0 = 0) (hf_bound : ∀ x, ‖f x‖ ≤ K * ‖x‖) - (hf_off : ∀ x, x ≠ 0 → ContinuousAt f x) : Continuous f := - CenteredRectangleDiskConstruction.hradial_cont f K hK hf0 hf_bound hf_off have hF_cont : Continuous F := CenteredRectangleDiskConstruction.hF_cont J hJ a b ha hb have hG_cont : Continuous G := CenteredRectangleDiskConstruction.hG_cont J hJ a b ha hb let H : (ℝ × ℝ) ≃ₜ (ℝ × ℝ) := diff --git a/LeanPool/ApollonianSuperharmonic/P3092T1DiamondCenteredRectangles.lean b/LeanPool/ApollonianSuperharmonic/P3092T1DiamondCenteredRectangles.lean index 2996028895..56ced850b0 100644 --- a/LeanPool/ApollonianSuperharmonic/P3092T1DiamondCenteredRectangles.lean +++ b/LeanPool/ApollonianSuperharmonic/P3092T1DiamondCenteredRectangles.lean @@ -62,7 +62,6 @@ theorem P3092T1DiamondCenteredRectangles (k : Nat) (hk : 0 < k) : have hreal_y : (r : Real) ≤ (y : Real) + 1 := by exact_mod_cast hry have hreal_y' : (r : Real) + (y : Real) ≤ 2 * (k : Real) := by exact_mod_cast hry' - have hreal_i0 : 0 ≤ (i : Real) := Nat.cast_nonneg _ have hp' : ((i : Real) - (r : Real) ≤ p.1 ∧ (y : Real) ≤ p.2) ∧ (p.1 ≤ (i : Real) - (r : Real) + 1 ∧ p.2 ≤ (y : Real) + 1) := by diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean index 8795bb54f0..90995833c6 100644 --- a/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean @@ -503,7 +503,6 @@ private theorem cyclic_endpoints_mem (gridPath : List GaussianInt) (y : Gaussian some y) (gridPath_length_four : 4 ≤ gridPath.length) (a b : GaussianInt) (hab : (a, b) ∈ (cyclicEdges gridPath y x)) : a ∈ gridPath ∧ b ∈ gridPath := by classical - let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] have zip_mem_decompose (a b : GaussianInt) (hab : (a, b) ∈ gridPath.zip gridPath.tail) : ∃ l₁ l₂ : List GaussianInt, gridPath = l₁ ++ a :: b :: l₂ := zip_mem_decompose gridPath @@ -681,7 +680,6 @@ private theorem cyclic_rep (gridPath : List GaussianInt) (y : GaussianInt) (x : gridPath y x)) : ∃ i : Fin ((n gridPath) + 3), a = (v gridPath gridPath_length_four) i ∧ b = (v gridPath gridPath_length_four) (i + 1) := by classical - let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] let n := gridPath.length - 3 have hn : n + 3 = gridPath.length := hn gridPath gridPath_length_four let v : Fin (n + 3) → GaussianInt := @@ -822,67 +820,11 @@ theorem P3475T1GridBoundary (T : ProtoTile) gridPath_mem_boundary, hz, hmax, hzout, cyclic_edge_boundary, cyclic_edge_fourNeighbor, component_edge_cyclic, hrightCyclic⟩ := P5620T1BoundaryComponentCycle T cells_nonempty boundary_degree_two - have gridPath_length : 3 ≤ gridPath.length := GridBoundaryConstruction.gridPath_length gridPath - gridPath_length_four - have component_index_control := GridRayCrossingIndexAdjacentCell gridPath x y - gridPath_head gridPath_last gridPath_nodup gridPath_length - gridPath_zip_fourNeighbor gridPath_close_fourNeighbor let cyclicEdges := (gridPath.zip gridPath.tail) ++ [(y, x)] - have same_vertical_not_boundary (q : LatticeCell) - (hstatus : q ∈ T.cells ↔ q - 1 ∈ T.cells) : - ({q, q + ⟨0, 1⟩} : Finset GaussianInt) ∉ BoundaryFootprintEdges T := - GridBoundaryConstruction.same_vertical_not_boundary T q hstatus - have same_horizontal_not_boundary (q : LatticeCell) - (hstatus : q ∈ T.cells ↔ q - ⟨0, 1⟩ ∈ T.cells) : - ({q, q + 1} : Finset GaussianInt) ∉ BoundaryFootprintEdges T := - GridBoundaryConstruction.same_horizontal_not_boundary T q hstatus - have adjacent_index_same_status (a b : LatticeCell) - (hs : a ∈ T.cells ↔ b ∈ T.cells) (hab : FourNeighborAdjacent a b) : - GridRayCrossingIndex a gridPath = GridRayCrossingIndex b gridPath := - GridBoundaryConstruction.adjacent_index_same_status T gridPath y x cyclic_edge_boundary - gridPath_head gridPath_last gridPath_nodup gridPath_zip_fourNeighbor - gridPath_close_fourNeighbor gridPath_length_four a b hs hab - have index_constant (S : Set LatticeCell) (hS : FourNeighborConnected S) - (I : LatticeCell → Int) - (hstep : ∀ a, a ∈ S → ∀ b, b ∈ S → - FourNeighborAdjacent a b → I a = I b) - (x : LatticeCell) (hx : x ∈ S) (y : LatticeCell) (hy : y ∈ S) : - I x = I y := GridBoundaryConstruction.index_constant S hS I hstep x hx y hy obtain ⟨w, hw, hmin⟩ := (T.cells ∪ gridPath.toFinset).exists_min_image (fun q => q.re) (by obtain ⟨a, ha⟩ := cells_nonempty exact ⟨a, Finset.mem_union_left _ ha⟩) - let q0 : LatticeCell := ⟨w.re - 1, 0⟩ - have q0_outside : q0 ∉ T.cells := GridBoundaryConstruction.q0_outside T gridPath w hmin - have path_left (a : GaussianInt) (ha : a ∈ gridPath) : q0.re < a.re := - GridBoundaryConstruction.path_left T gridPath w hmin a ha - let step : GaussianInt → GaussianInt → Int := fun a b => - if b = a + ⟨0, 1⟩ ∧ a.im = q0.im ∧ a.re ≤ q0.re then 1 - else if b = a - ⟨0, 1⟩ ∧ b.im = q0.im ∧ a.re ≤ q0.re then -1 else 0 - have step_zero (a : GaussianInt) (ha : a ∈ gridPath) (b : GaussianInt) : - step a b = 0 := GridBoundaryConstruction.step_zero T gridPath w hmin a ha b - have zip_zero (r s : List GaussianInt) (hr : ∀ a ∈ r, a ∈ gridPath) : - (List.zipWith step r s).sum = 0 := GridBoundaryConstruction.zip_zero T gridPath w hmin r s hr - have q0_index_zero : GridRayCrossingIndex q0 gridPath = 0 := - GridBoundaryConstruction.q0_index_zero T gridPath y x gridPath_head gridPath_last w hmin - have unoccupied_index_zero (q : LatticeCell) (hq : q ∉ T.cells) : - GridRayCrossingIndex q gridPath = 0 := GridBoundaryConstruction.unoccupied_index_zero T - houtside gridPath y x cyclic_edge_boundary gridPath_head gridPath_last gridPath_nodup - gridPath_zip_fourNeighbor gridPath_close_fourNeighbor w gridPath_length_four hmin q hq - have hrightJump : - Int.natAbs (GridRayCrossingIndex (z + 1) gridPath - - GridRayCrossingIndex z gridPath) = 1 := GridBoundaryConstruction.hrightJump gridPath y x - gridPath_head gridPath_last gridPath_nodup gridPath_zip_fourNeighbor - gridPath_close_fourNeighbor z gridPath_length_four hrightCyclic - have hzIndexNonzero : GridRayCrossingIndex z gridPath ≠ 0 := - GridBoundaryConstruction.hzIndexNonzero T houtside gridPath y x cyclic_edge_boundary - gridPath_head gridPath_last gridPath_nodup gridPath_zip_fourNeighbor - gridPath_close_fourNeighbor z w gridPath_length_four hrightCyclic hzout hmin - have occupied_index_nonzero (q : LatticeCell) (hq : q ∈ T.cells) : - GridRayCrossingIndex q gridPath ≠ 0 := GridBoundaryConstruction.occupied_index_nonzero T - hinside houtside gridPath y x cyclic_edge_boundary gridPath_head gridPath_last - gridPath_nodup gridPath_zip_fourNeighbor gridPath_close_fourNeighbor z w - gridPath_length_four hrightCyclic hzout hz hmin q hq have boundary_edge_cyclic (e : Finset GaussianInt) (he : e ∈ BoundaryFootprintEdges T) : ∃ a b : GaussianInt, e = {a, b} ∧ @@ -891,13 +833,6 @@ theorem P3475T1GridBoundary (T : ProtoTile) cyclic_edge_boundary gridPath_head gridPath_last gridPath_nodup gridPath_zip_fourNeighbor gridPath_close_fourNeighbor z w gridPath_length_four hrightCyclic hzout hz hmin e he - have zip_mem_decompose (a b : GaussianInt) - (hab : (a, b) ∈ gridPath.zip gridPath.tail) : - ∃ l₁ l₂ : List GaussianInt, gridPath = l₁ ++ a :: b :: l₂ := - GridBoundaryConstruction.zip_mem_decompose gridPath gridPath_length_four a b hab - have cyclic_endpoints_mem (a b : GaussianInt) (hab : (a, b) ∈ cyclicEdges) : - a ∈ gridPath ∧ b ∈ gridPath := GridBoundaryConstruction.cyclic_endpoints_mem gridPath y x - gridPath_head gridPath_last gridPath_length_four a b hab have boundary_vertices_eq : BoundaryFootprintVertices T = (gridPath.toFinset : Set GaussianInt) := GridBoundaryConstruction.boundary_vertices_eq T hinside houtside gridPath y x @@ -910,13 +845,6 @@ theorem P3475T1GridBoundary (T : ProtoTile) fun i => gridPath[i.val]'(by rw [← hn]; exact i.isLt) have v_injective : Function.Injective v := GridBoundaryConstruction.v_injective gridPath gridPath_nodup gridPath_length_four - have successor_val (i : Fin (n + 3)) : - (i + 1).val = if i.val + 1 < n + 3 then i.val + 1 else 0 := - GridBoundaryConstruction.successor_val i - have v_head : v 0 = x := GridBoundaryConstruction.v_head gridPath x gridPath_head - gridPath_length_four - have v_last : v ⟨n + 2, by omega⟩ = y := GridBoundaryConstruction.v_last gridPath y - gridPath_last gridPath_length_four have cyclic_index (i : Fin (n + 3)) : (v i, v (i + 1)) ∈ cyclicEdges := GridBoundaryConstruction.cyclic_index gridPath y x gridPath_head gridPath_last gridPath_length_four i diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1PolygonalSeparation.lean b/LeanPool/ApollonianSuperharmonic/P3475T1PolygonalSeparation.lean index 091e0732dc..365d1f47d4 100644 --- a/LeanPool/ApollonianSuperharmonic/P3475T1PolygonalSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/P3475T1PolygonalSeparation.lean @@ -605,9 +605,6 @@ private theorem hlocalAll : _ = t.face k d := congrArg (t.face k) he _ = i + 1 := hd obtain ⟨c, hac, hdc⟩ := third a d had - have hIuniq (l : Fin t.count) (hl : l ∈ I) : l = k := by - rw [hIeq] at hl - simpa using hl have hvA : p.vertex i = p.vertex (t.face k a) := congrArg p.vertex ha.symm have hvD : p.vertex (i + 1) = p.vertex (t.face k d) := congrArg p.vertex hd.symm have hpoint : diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1SquareUnionIdentification.lean b/LeanPool/ApollonianSuperharmonic/P3475T1SquareUnionIdentification.lean index 79b311390b..0cee116369 100644 --- a/LeanPool/ApollonianSuperharmonic/P3475T1SquareUnionIdentification.lean +++ b/LeanPool/ApollonianSuperharmonic/P3475T1SquareUnionIdentification.lean @@ -484,13 +484,6 @@ private theorem boundary_side_segment_in_C : intro T n p v hvertex hedges C pair_eq_cases e he a b hab habne q hq rw [hedges] at he obtain ⟨i, hi⟩ := he - have hneq : v i ≠ v (i + 1) := by - intro h - have heq : ({v i, v (i + 1)} : Finset GaussianInt) = {a, b} := hi.symm.trans hab - rw [h] at heq - have hcard : ({a, b} : Finset GaussianInt).card = 2 := by simp [habne] - rw [← heq] at hcard - simp at hcard have hp := pair_eq_cases (v i) (v (i + 1)) a b habne (hi.symm.trans hab) rcases hp with ⟨ha, hb⟩ | ⟨ha, hb⟩ · subst a; subst b @@ -721,7 +714,6 @@ private theorem east_same_center_segment_avoids : rw [← hm] linarith [hxlo] have hlow2 : 2 * a.re + 1 ≤ 2 * m := by exact_mod_cast hlow2R - have hlow : a.re + 1 ≤ m := by omega have hhighR : (m : Real) < (a.re : Real) + 2 := by rw [← hm]; linarith have hhigh : m < a.re + 2 := by exact_mod_cast hhighR have hmEq : m = a.re + 1 := by omega @@ -830,7 +822,6 @@ private theorem north_same_center_segment_avoids : rw [← hm] linarith [hylo] have hlow2 : 2 * a.im + 1 ≤ 2 * m := by exact_mod_cast hlow2R - have hlow : a.im + 1 ≤ m := by omega have hhighR : (m : Real) < (a.im : Real) + 2 := by rw [← hm]; linarith [hyhi] have hhigh : m < a.im + 2 := by exact_mod_cast hhighR have hmEq : m = a.im + 1 := by omega diff --git a/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean b/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean index e5ba7b309f..b16b1ab2c5 100644 --- a/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean @@ -148,7 +148,6 @@ private theorem hsigSucc (n : Nat) (k : Fin (L n)) (hk : k.val ≠ 0) : dsimp only [StraightDeletionConstruction.L] at * change (sig (k + 1) = sig k + 1) apply Fin.ext - have hpos : 0 < k.val := Nat.pos_of_ne_zero hk have hk0 : k ≠ 0 := by intro h apply hk @@ -158,7 +157,6 @@ private theorem hsigSucc (n : Nat) (k : Fin (L n)) (hk : k.val ≠ 0) : hk0, hLM, Nat.mod_eq_of_lt hM1, Nat.mod_eq_of_lt hL1] · have hklt : k.val < L := k.isLt have hnext : k.val + 1 < L := by omega - have hbound : k.val + 2 < M := by omega have hcond1 : ¬ L ≤ k.val + 1 := by omega have hcond2 : ¬ M ≤ k.val + 1 + 1 := by omega simp [sig, Fin.val_add_eq_ite, hk, @@ -635,28 +633,21 @@ private theorem firstInt (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i : Fin let rot : Fin M → Fin M := fun h => i + h let sig : Fin L → Fin M := fun k => ⟨if k.val = 0 then 0 else k.val + 1, by split_ifs <;> omega⟩ - have hM : 4 ≤ M := hM n have hM1 : 1 < M := hM1 n have hsigSucc (k : Fin L) (hk : k.val ≠ 0) : sig (k + 1) = sig k + 1 := hsigSucc n k hk let r : Fin M → Real × Real := fun h => p.vertex (rot h) have ha : r 0 ≠ r 1 := ha n p i have hbc : r 1 ≠ r 2 := hbc n p i - have hac : r 0 ≠ r 2 := hac n p i have oldInt (a b : Fin M) (hab : a ≠ b) : segment Real (r a) (r (a + 1)) ∩ segment Real (r b) (r (b + 1)) = {x | (x = r a ∨ x = r (a + 1)) ∧ (x = r b ∨ x = r (b + 1))} := oldInt n p i a b hab have rEq (a b : Fin M) : r a = r b ↔ a = b := rEq n p i a b have sig0 : sig (0 : Fin L) = 0 := sig0 n - have hval2M : (2 : Fin M).val = 2 := hval2M n - have hmod1M : 1 % M = 1 := hmod1M n - have hmod2M : 2 % M = 2 := hmod2M n - have hmod3M : 3 % M = 3 := hmod3M n have new01 : (0 : Fin L) + 1 = 1 := new01 n have sig1 : sig (1 : Fin L) = 2 := sig1 n have old01 : (0 : Fin M) + 1 = 1 := old01 n have old12 : (1 : Fin M) + 1 = 2 := old12 n - have old23 : (2 : Fin M) + 1 = 3 := old23 n have qedge0 : segment Real (r (sig 0)) (r (sig (0 + 1))) = segment Real (r 0) (r 2) := qedge0 n p i have qedgePos (k : Fin L) (hk : k.val ≠ 0) : diff --git a/LeanPool/ApollonianSuperharmonic/P3511T1LeafOrder.lean b/LeanPool/ApollonianSuperharmonic/P3511T1LeafOrder.lean index 091c4c7a27..4ac81e95af 100644 --- a/LeanPool/ApollonianSuperharmonic/P3511T1LeafOrder.lean +++ b/LeanPool/ApollonianSuperharmonic/P3511T1LeafOrder.lean @@ -110,7 +110,6 @@ private theorem supported {α : Type} {l : List α} {fs : List (Face α)} (h : P3511T1CyclicDissection α l fs) : ∀ f ∈ fs, ∀ x ∈ Set.range f, x ∈ l := by classical - let Face (α : Type) := Fin 3 → α induction h with | triangle a b c => intro f hf x hx @@ -143,7 +142,6 @@ private theorem triple_pair {α : Type} {f : Face α} (hf : Function.Injective f {a b : α} (hab : a ≠ b) (ha : a ∈ Set.range f) (hb : b ∈ Set.range f) : ∃ c, a ≠ c ∧ b ≠ c ∧ Set.range f = {a, b, c} := by classical - let Face (α : Type) := Fin 3 → α obtain ⟨i, rfl⟩ := ha obtain ⟨j, rfl⟩ := hb have hij : i ≠ j := fun h => hab (congrArg f h) @@ -383,58 +381,11 @@ theorem P3511T1LeafOrder {n : Nat} let Face (α : Type) := Fin 3 → α let edges {α : Type} (l : List α) : List (α × α) := List.zipWith Prod.mk l (l.rotate 1) - have edges_cons {α : Type} (a : α) (l : List α) : - edges (a :: l) = List.zipWith Prod.mk (a :: l) (l ++ [a]) := - DissectionLeafOrderConstruction.edges_cons (α := α) a l - have path_split {α : Type} (a b z : α) (u v : List α) : - List.zipWith Prod.mk (a :: (u ++ b :: v)) ((u ++ b :: v) ++ [z]) = - List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ - List.zipWith Prod.mk (b :: v) (v ++ [z]) := DissectionLeafOrderConstruction.path_split - (α := α) a b z u v - have edges_split {α : Type} (a b : α) (u v : List α) : - edges (a :: (u ++ b :: v)) = - List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ - List.zipWith Prod.mk (b :: v) (v ++ [a]) := DissectionLeafOrderConstruction.edges_split - (α := α) a b u v - have edges_arc {α : Type} (a b : α) (u : List α) : - edges (a :: (u ++ [b])) = - List.zipWith Prod.mk (a :: u) (u ++ [b]) ++ [(b, a)] := - DissectionLeafOrderConstruction.edges_arc (α := α) a b u - have edges_rotate {α : Type} (l : List α) (k : Nat) : - edges (l.rotate k) = (edges l).rotate k := DissectionLeafOrderConstruction.edges_rotate (α - := α) l k - have edges_members {α : Type} {l : List α} {a b : α} - (h : (a, b) ∈ edges l) : a ∈ l ∧ b ∈ l := DissectionLeafOrderConstruction.edges_members (α - := α) (l := l) (a := a) (b := b) h - have supported {α : Type} {l : List α} {fs : List (Face α)} - (h : P3511T1CyclicDissection α l fs) : - ∀ f ∈ fs, ∀ x ∈ Set.range f, x ∈ l := DissectionLeafOrderConstruction.supported (α := α) (l - := l) (fs := fs) h let Shell {α : Type} (fs : List (Face α)) : Prop := ∀ pre f post, fs = pre ++ f :: post → pre ≠ [] → ∃ a b c : α, a ≠ b ∧ a ≠ c ∧ b ≠ c ∧ Set.range f = {a, b, c} ∧ (∀ g ∈ pre, c ∉ Set.range g) ∧ ∃ g ∈ pre, a ∈ Set.range g ∧ b ∈ Set.range g - have triple_pair {α : Type} {f : Face α} (hf : Function.Injective f) - {a b : α} (hab : a ≠ b) (ha : a ∈ Set.range f) (hb : b ∈ Set.range f) : - ∃ c, a ≠ c ∧ b ≠ c ∧ Set.range f = {a, b, c} := DissectionLeafOrderConstruction.triple_pair - (α := α) (f := f) hf (a := a) (b := b) hab ha hb - have split_lists {α : Type} {a b : α} {u v : List α} - (hn : (a :: (u ++ b :: v)).Nodup) : - (a :: (u ++ [b])).Nodup ∧ (b :: (v ++ [a])).Nodup ∧ a ≠ b ∧ - (∀ x, x ∈ a :: (u ++ [b]) → x ∈ b :: (v ++ [a]) → x = a ∨ x = b) := - DissectionLeafOrderConstruction.split_lists (α := α) (a := a) (b := b) (u := u) (v := - v) hn - have shell_join {α : Type} {left : List (Face α)} {r : Face α} - {tail : List (Face α)} {a b : α} - (hl : Shell left) (hr : Shell (r :: tail)) - (hab : a ≠ b) (hir : Function.Injective r) - (ha : a ∈ Set.range r) (hb : b ∈ Set.range r) - (hattach : ∃ g ∈ left, a ∈ Set.range g ∧ b ∈ Set.range g) - (hsep : ∀ g ∈ left, ∀ f ∈ r :: tail, ∀ x, - x ∈ Set.range g → x ∈ Set.range f → x = a ∨ x = b) : - Shell (left ++ r :: tail) := DissectionLeafOrderConstruction.shell_join (α := α) (left := - left) (r := r) (tail := tail) (a := a) (b := b) hl hr hab hir ha hb hattach hsep have rooted {α : Type} {l : List α} {fs : List (Face α)} (h : P3511T1CyclicDissection α l fs) (hn : l.Nodup) (hi : ∀ f ∈ fs, Function.Injective f) : diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean index 67e44a1ca3..19efc22b63 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean @@ -1330,8 +1330,6 @@ private theorem retainedLeft : subst y exact hnot ⟨hxH, hyH⟩ have hleftRet := (hgeo.2.2 J hJsub hJnot).1 - have hleftFace' : insert d (({a, b, z} : Finset (Fin (n + 3))).erase b) = - {a, d, z} := by simpa [hF] using hleftFace have hlabels : ((F : Set _) ∩ (H : Set _)) ∩ (({a, z} : Finset (Fin (n + 3))) : Set (Fin (n + 3))) = (((insert d (F.erase b) : Finset (Fin (n + 3))) : Set _) ∩ @@ -1484,8 +1482,6 @@ private theorem retainedRight : (({b, z} : Finset (Fin (n + 3))) : Set (Fin (n + 3))) = (((insert d (F.erase a) : Finset (Fin (n + 3))) : Set _) ∩ (H : Set _)) := by - have hrightFace' : insert d (({a, b, z} : Finset (Fin (n + 3))).erase a) = - {d, b, z} := by simpa [hF] using hrightFace ext x rw [hrightFace, hF] simp only [Set.mem_inter_iff, Finset.mem_coe, Finset.mem_insert, @@ -2448,12 +2444,6 @@ private theorem pairState : e.1 e.2.2 hab hboundary F₀ G₀ hF₀ hG₀ hhitF.1 hhitF.2 hhitG.1 hhitG.2 subst G₀ - have haV0 : e.1 ∈ c.vertices h := hF₀subset haF - have hbV0 : e.2.2 ∈ c.vertices h := hF₀subset hbF - have hzV0 : z ∈ c.vertices h := hF₀subset (by rw [hFeq]; simp) - have hda := FacialInsertionGeometry.hda r n q p s X K t h hh hdV haV0 - have hdb := FacialInsertionGeometry.hdb r n q p s X K t h hh hdV hbV0 - have hdz := FacialInsertionGeometry.hdz r n q p s X K t h hh hdV z hzV0 have siblingsPair (L R : Finset (Fin (n + 3))) (hL : L = {e.1, e.2.1, z}) (hR : R = {e.2.1, e.2.2, z}) := FacialInsertionGeometry.siblingsPair r n q p s X @@ -2552,9 +2542,6 @@ theorem P3523T1InsertionGeometry {r n : Nat} have faceMemTransport {I : Type} [DecidableEq I] {fs : Finset (Finset I)} {F G : Finset I} (hFG : F = G) (hG : G ∈ fs) : F ∈ fs := hFG ▸ hG - let triangleMatrix (v : Fin 3 → Real × Real) : - Matrix (Fin 3) (Fin 3) Real := - fun i j => if j = 0 then (v i).1 else if j = 1 then (v i).2 else 1 have det_range_transport {I : Type} (f g : Fin 3 → I) (hf : Function.Injective f) (hg : Function.Injective g) (hr : Set.range f = Set.range g) (v : I → Real × Real) := @@ -2618,7 +2605,6 @@ theorem P3523T1InsertionGeometry {r n : Nat} have sourceState := detState p.vertex sourceInterp sourceInitialDet have targetState := detState (P3523T1InterpolatedTarget s t) targetInterp targetInitialDet - let f := P3523T1FaceEnumeration (c.faces c.steps.length) have terminalFace (k : Fin (c.faces c.steps.length).card) := FacialInsertionGeometry.terminalFace r n q p s X K t hfaceRange k let faceUnion (v : Fin (n + 3) → Real × Real) diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean index 2335f9b359..170736c046 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionIncidence.lean @@ -831,7 +831,6 @@ private theorem hsplit_eq : have hFLFR : FL ≠ FR := by intro h have hda : d ≠ a := by intro hda; subst d; exact hd F hF hpF.1 - have hdb : d ≠ b := by intro hdb; subst d; exact hd F hF hpF.2 have haFL : a ∈ FL := Finset.mem_insert.mpr (Or.inr (Finset.mem_erase.mpr ⟨hab, hpF.1⟩)) have haFR : a ∉ FR := by simp [FR, hda.symm] diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean b/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean index 3432f39cc0..920adab129 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1OrderedInsertion.lean @@ -545,18 +545,6 @@ private theorem hno : have hpw : (w - 1) + 1 = w := by simp have hsw := s.successor (w - 1) rw [hpw] at hsw - have hsamew : s.edge (w - 1) = s.edge w := by - rcases hsw with h | h - · exact h.1.symm - · exact False.elim (hparamw h.2) - have hneW : w - 1 ≠ s.start (s.edge w + 1) := by - intro heqW - have hed := congrArg s.edge heqW - rw [hsamew, s.edge_start] at hed - have hone : (1 : Fin (r + 3)) = 0 := add_left_cancel - (show s.edge w + 1 = s.edge w + 0 by simp at hed) - have hvone := congrArg Fin.val hone - norm_num at hvone have horient := pairCases hne hpair rcases horient with ⟨hleft, hright⟩ | ⟨hleft, hright⟩ · have hwj : w = j := by @@ -584,7 +572,6 @@ private theorem hno : have hwleft : z.1 = w - 1 := congrArg Prod.fst hztuple.symm rw [← hwleft, hright] let b := s.start (s.edge j + 1) - have hparamb : s.parameter b = 0 := s.parameter_start (s.edge j + 1) have hsb := s.successor b have hbnext : s.edge b = s.edge j + 1 := s.edge_start _ have hsameb : s.edge (b + 1) = s.edge b := by @@ -761,9 +748,6 @@ private theorem boundaryCardUpdate : have had : a ≠ d := by intro h exact hd (h ▸ ha) - have hbd : b ≠ d := by - intro h - exact hd (h ▸ hb) have hnewA : ({a, d} : Finset (Fin (n + 3))) ∉ B := by intro hmem have hdmem : d ∈ ({a, d} : Finset (Fin (n + 3))) := by simp @@ -793,7 +777,6 @@ private theorem boundaryCardUpdate : Finset.card_insert_of_notMem hnewBErase, Finset.card_erase_of_mem herase] have hcardpos : 0 < B.card := Finset.card_pos.mpr ⟨{a, b}, herase⟩ - have hcardpos' : 1 ≤ B.card := hcardpos omega private theorem hstate : @@ -1430,15 +1413,6 @@ private theorem hboundary : dsimp [initialBoundary, initialVertices] rw [Finset.card_image_of_injective _ boundaryEdgeInj, Finset.card_image_of_injective _ s.start_injective] - have hinitEndpoints : ∀ P ∈ initialBoundary, ∀ x ∈ P, x ∈ initialVertices := by - intro P hP x hx - rcases Finset.mem_image.mp hP with ⟨i, -, rfl⟩ - simp only [Finset.mem_insert, Finset.mem_singleton] at hx - rcases hx with hx | hx - · subst x - exact Finset.mem_image.mpr ⟨i, Finset.mem_univ _, rfl⟩ - · subst x - exact Finset.mem_image.mpr ⟨i + 1, Finset.mem_univ _, rfl⟩ have pairEq {a b c d : Fin (n + 3)} (hac : a = c) (hbd : b = d) : ({a, b} : Finset (Fin (n + 3))) = {c, d} := by ext z @@ -1492,15 +1466,6 @@ private theorem hboundary : have memStep (j : Fin (n + 3)) (hj : s.parameter j ≠ 0) : (j - 1, j, s.start (s.edge j + 1)) ∈ c.steps := OrderedInsertionGeometry.memStep r n q p s X K t hshiftImage j hj - have offsetNe (a : Fin (r + 3)) (k : Nat) (hk : k < r + 3) - (hkpos : 0 < k) : a + (k : Fin (r + 3)) ≠ a := by - intro heq - have hkfin : (k : Fin (r + 3)) = 0 := - add_left_cancel (show a + (k : Fin (r + 3)) = a + 0 by simpa using heq) - have hv := congrArg Fin.val hkfin - change k % (r + 3) = 0 at hv - rw [Nat.mod_eq_of_lt hk] at hv - omega have noErase (x : Fin (n + 3)) : ∀ e ∈ c.steps, ({x, x + 1} : Finset (Fin (n + 3))) ≠ {e.1, e.2.2} := OrderedInsertionGeometry.noErase r n q p s X K t pairCases targetAdjNe x diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean index aa5b63b5aa..8e54e6fbd8 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1TargetBoundary.lean @@ -39,7 +39,6 @@ private theorem htarget_edge : omega · have heq : i.val + 1 = r + 3 := by omega rw [heq, Nat.mod_self] at hv - have hi_lt := i.isLt omega private theorem haffine_injective : diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean b/LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean index a4d0a9c4b4..0011087b8b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1TwoTriangleSplit.lean @@ -125,7 +125,6 @@ private theorem affineUnique (A : Real × Real) (B : Real × Real) (C : Real × have he1 := congrArg Prod.fst he have he2 := congrArg Prod.snd he simp only [Prod.fst_add, Prod.snd_add, Prod.smul_fst, Prod.smul_snd] at he1 he2 - have hsum : (b - b') + (c - c') = -(a - a') := by linarith have hsumdiff : (a - a') + (b - b') + (c - c') = 0 := by linarith have hx : (b - b') * (B.1 - A.1) + (c - c') * (C.1 - A.1) = 0 := by linear_combination he1 - A.1 * hsumdiff @@ -361,12 +360,6 @@ private theorem hdiag (A : Real × Real) (B : Real × Real) (C : Real × Real) ( linear_combination u * huniq.1 - (1-u) * huniq.2.1 have hl0 : l = 0 := by nlinarith [mul_nonneg hu_nonneg hl, mul_nonneg h1u_nonneg hr] - have hr0 : r = 0 := by - nlinarith [mul_nonneg hu_nonneg hl, mul_nonneg h1u_nonneg hr] - have hmm : m = m' := by - have hbEq := huniq.2.1 - rw [hr0] at hbEq - nlinarith [hu.1] have hmt : m+t = 1 := by nlinarith [hsumL, hl0] refine ⟨m, t, hm, ht, hmt, ?_⟩ calc @@ -515,7 +508,6 @@ private theorem hleftBC (A : Real × Real) (B : Real × Real) (C : Real × Real) convexHull Real ({B, C} : Set (Real × Real)) = convexHull Real ({C} : Set (Real × Real)) := by classical - have h1u_nonneg : 0 ≤ 1-u := h1u_nonneg u hu have distinctAC : A ≠ C := distinctAC A B C hn have hull3 (P Q R x : Real × Real) (hPQ : P ≠ Q) (hPR : P ≠ R) (hQR : Q ≠ R) : @@ -555,7 +547,6 @@ private theorem hleftBC (A : Real × Real) (B : Real × Real) (C : Real × Real) have huniq := affineUnique (l+(1-u)*m) (u*m) t 0 b c hsumOld (by simpa using hsumBC) hpoint have hm0 : m = 0 := by - have hprod : 0 ≤ (1-u)*m := mul_nonneg h1u_nonneg hm nlinarith [huniq.1] have hl0 : l = 0 := by nlinarith [huniq.1, hm0] have ht1 : t = 1 := by nlinarith [hsumL, hl0, hm0] @@ -977,104 +968,8 @@ theorem P3523T1TwoTriangleSplit (A B C : Real × Real) (u : Real) convexHull Real (J ∩ {A, C}) ∧ convexHull Real ({D, B, C} : Set (Real × Real)) ∩ convexHull Real J = convexHull Real (J ∩ {B, C})) := by --- BODY - classical - have hu_nonneg : 0 ≤ u := TwoTriangleSplit.hu_nonneg u hu - have h1u_nonneg : 0 ≤ 1-u := TwoTriangleSplit.h1u_nonneg u hu - let d : Real := (B.1 - A.1) * (C.2 - A.2) - (C.1 - A.1) * (B.2 - A.2) - have hd : d ≠ 0 := TwoTriangleSplit.hd A B C hn - have distinctAB : A ≠ B := TwoTriangleSplit.distinctAB A B C hn - have distinctAC : A ≠ C := TwoTriangleSplit.distinctAC A B C hn - have distinctBC : B ≠ C := TwoTriangleSplit.distinctBC A B C hn - have hull3 (P Q R x : Real × Real) (hPQ : P ≠ Q) (hPR : P ≠ R) - (hQR : Q ≠ R) : - x ∈ convexHull Real ({P, Q, R} : Set (Real × Real)) ↔ - ∃ a b c : Real, 0 ≤ a ∧ 0 ≤ b ∧ 0 ≤ c ∧ a + b + c = 1 ∧ - a • P + b • Q + c • R = x := TwoTriangleSplit.hull3 P Q R x hPQ hPR hQR - have affineUnique (a b c a' b' c' : Real) - (hs : a + b + c = 1) (hs' : a' + b' + c' = 1) - (he : a • A + b • B + c • C = a' • A + b' • B + c' • C) : - a = a' ∧ b = b' ∧ c = c' := TwoTriangleSplit.affineUnique A B C hn a b c a' b' c' hs hs' he - have hDneA : (1 - u) • A + u • B ≠ A := TwoTriangleSplit.hDneA A B C u hu hn - have hDneB : (1 - u) • A + u • B ≠ B := TwoTriangleSplit.hDneB A B C u hu hn - have hDneC : (1 - u) • A + u • B ≠ C := TwoTriangleSplit.hDneC A B C u hn - have hleftHull (x : Real × Real) := hull3 A ((1 - u) • A + u • B) C x - (fun h => hDneA h.symm) distinctAC hDneC - have hrightHull (x : Real × Real) := hull3 ((1 - u) • A + u • B) B C - x hDneB hDneC distinctBC - have holdHull (x : Real × Real) := hull3 A B C x distinctAB distinctAC distinctBC - have coeffSplit (a b c : Real) (ha : 0 ≤ a) (hb : 0 ≤ b) (hc : 0 ≤ c) - (hsum : a + b + c = 1) : - (∃ l m t : Real, 0 ≤ l ∧ 0 ≤ m ∧ 0 ≤ t ∧ l + m + t = 1 ∧ - a = l + (1-u)*m ∧ b = u*m ∧ c = t) ∨ - (∃ m r t : Real, 0 ≤ m ∧ 0 ≤ r ∧ 0 ≤ t ∧ m + r + t = 1 ∧ - a = (1-u)*m ∧ b = u*m+r ∧ c = t) := TwoTriangleSplit.coeffSplit u hu a b c ha hb hc hsum - let D : Real × Real := (1-u) • A + u • B - have hcoverage : convexHull Real ({A, B, C} : Set (Real × Real)) = - convexHull Real ({A, D, C} : Set (Real × Real)) ∪ - convexHull Real ({D, B, C} : Set (Real × Real)) := TwoTriangleSplit.hcoverage A B C u hu hn - change (convexHull Real ({A, B, C} : Set (Real × Real)) = - convexHull Real ({A, D, C} : Set (Real × Real)) ∪ - convexHull Real ({D, B, C} : Set (Real × Real))) ∧ _ ∧ _ - have hdiag : - convexHull Real ({A, D, C} : Set (Real × Real)) ∩ - convexHull Real ({D, B, C} : Set (Real × Real)) = segment Real D C := - TwoTriangleSplit.hdiag A B C u hu hn - have pairACsubL : convexHull Real ({A, C} : Set (Real × Real)) ⊆ - convexHull Real ({A, D, C} : Set (Real × Real)) := TwoTriangleSplit.pairACsubL A B C u - have pairBCsubR : convexHull Real ({B, C} : Set (Real × Real)) ⊆ - convexHull Real ({D, B, C} : Set (Real × Real)) := TwoTriangleSplit.pairBCsubR A B C u - have hleftAC : - convexHull Real ({A, D, C} : Set (Real × Real)) ∩ - convexHull Real ({A, C} : Set (Real × Real)) = - convexHull Real ({A, C} : Set (Real × Real)) := TwoTriangleSplit.hleftAC A B C u - have hrightBC : - convexHull Real ({D, B, C} : Set (Real × Real)) ∩ - convexHull Real ({B, C} : Set (Real × Real)) = - convexHull Real ({B, C} : Set (Real × Real)) := TwoTriangleSplit.hrightBC A B C u - have hrightAC : - convexHull Real ({D, B, C} : Set (Real × Real)) ∩ - convexHull Real ({A, C} : Set (Real × Real)) = - convexHull Real ({C} : Set (Real × Real)) := TwoTriangleSplit.hrightAC A B C u hu hn - have hleftBC : - convexHull Real ({A, D, C} : Set (Real × Real)) ∩ - convexHull Real ({B, C} : Set (Real × Real)) = - convexHull Real ({C} : Set (Real × Real)) := TwoTriangleSplit.hleftBC A B C u hu hn - have leftA : convexHull Real ({A, D, C} : Set (Real × Real)) ∩ - convexHull Real ({A} : Set (Real × Real)) = convexHull Real ({A} : Set (Real × Real)) := - TwoTriangleSplit.leftA A B C u - have rightA : convexHull Real ({D, B, C} : Set (Real × Real)) ∩ - convexHull Real ({A} : Set (Real × Real)) = ∅ := TwoTriangleSplit.rightA A B C u hu hn - have leftB : convexHull Real ({A, D, C} : Set (Real × Real)) ∩ - convexHull Real ({B} : Set (Real × Real)) = ∅ := TwoTriangleSplit.leftB A B C u hu hn - have rightB : convexHull Real ({D, B, C} : Set (Real × Real)) ∩ - convexHull Real ({B} : Set (Real × Real)) = convexHull Real ({B} : Set (Real × Real)) := - TwoTriangleSplit.rightB A B C u - have leftC : convexHull Real ({A, D, C} : Set (Real × Real)) ∩ - convexHull Real ({C} : Set (Real × Real)) = convexHull Real ({C} : Set (Real × Real)) := - TwoTriangleSplit.leftC A B C u - have rightC : convexHull Real ({D, B, C} : Set (Real × Real)) ∩ - convexHull Real ({C} : Set (Real × Real)) = convexHull Real ({C} : Set (Real × Real)) := - TwoTriangleSplit.rightC A B C u - have hACinterAC : ({A,C} : Set (Real × Real)) ∩ {A,C} = {A,C} := TwoTriangleSplit.hACinterAC A C - have hBCinterBC : ({B,C} : Set (Real × Real)) ∩ {B,C} = {B,C} := TwoTriangleSplit.hBCinterBC B C - have hACinterBC : ({A,C} : Set (Real × Real)) ∩ {B,C} = {C} := TwoTriangleSplit.hACinterBC A B - C hn - have hBCinterAC : ({B,C} : Set (Real × Real)) ∩ {A,C} = {C} := TwoTriangleSplit.hBCinterAC A B - C hn - have hAinterAC : ({A} : Set (Real × Real)) ∩ {A,C} = {A} := TwoTriangleSplit.hAinterAC A B C hn - have hAinterBC : ({A} : Set (Real × Real)) ∩ {B,C} = ∅ := TwoTriangleSplit.hAinterBC A B C hn - have hBinterAC : ({B} : Set (Real × Real)) ∩ {A,C} = ∅ := TwoTriangleSplit.hBinterAC A B C hn - have hBinterBC : ({B} : Set (Real × Real)) ∩ {B,C} = {B} := TwoTriangleSplit.hBinterBC A B C hn - have hCinterAC : ({C} : Set (Real × Real)) ∩ {A,C} = {C} := TwoTriangleSplit.hCinterAC A C - have hCinterBC : ({C} : Set (Real × Real)) ∩ {B,C} = {C} := TwoTriangleSplit.hCinterBC B C - have hfaces : ∀ J : Set (Real × Real), J ⊆ {A, B, C} → - ¬(A ∈ J ∧ B ∈ J) → - convexHull Real ({A, D, C} : Set (Real × Real)) ∩ convexHull Real J = - convexHull Real (J ∩ {A, C}) ∧ - convexHull Real ({D, B, C} : Set (Real × Real)) ∩ convexHull Real J = - convexHull Real (J ∩ {B, C}) := TwoTriangleSplit.hfaces A B C u hu hn - exact ⟨hcoverage, hdiag, hfaces⟩ + exact ⟨TwoTriangleSplit.hcoverage A B C u hu hn, + TwoTriangleSplit.hdiag A B C u hu hn, TwoTriangleSplit.hfaces A B C u hu hn⟩ end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean index d41168d5cb..ea68dcfd6c 100644 --- a/LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3544T1TriangleRayGeometry.lean @@ -1662,7 +1662,6 @@ theorem P3544T1TriangleRayGeometry (p : P3381T1PolygonBoundary 0) : let gamma : (Real × Real) → Real := fun x => ((b - a).1 * (x - a).2 - (b - a).2 * (x - a).1) / D let alpha : (Real × Real) → Real := fun x => 1 - beta x - gamma x - have hsum := TriangleRayIntersections.hsum p have hrec := TriangleRayIntersections.hrec p hDneq have hbeta_affine := TriangleRayIntersections.hbeta_affine p hDneq have hgamma_affine := TriangleRayIntersections.hgamma_affine p hDneq diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean index 6356957b79..ac64391513 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaChordCuts.lean @@ -690,7 +690,6 @@ private theorem hrankV : simp [ia, ib] have hr := hrankAt p (hiaB.trans hposB.le) i hpi rw [hr, hrankB'] - have he1 : (emb ia).val < (emb ib).val := hrootOrder have he2 : (emb ib).val < (emb p).val := emb.lt_iff_lt.mpr hposB omega @@ -1242,7 +1241,6 @@ private theorem hVpos : intro h have hformI := hrankHi i h have hformB := hrankLo b (not_le_of_gt hba) - have hiBound : i.val < n+3 := i.isLt omega have hformI := hrankLo i hAi have hformB := hrankLo b (not_le_of_gt hba) diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean index 96a2559e78..47143f7512 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean @@ -345,7 +345,6 @@ private theorem hDK (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (hq : ∀ (i : Fi · dsimp [t] exact sub_nonneg.mpr hjx · dsimp [t] - have hxj' : z.1 ≤ (j.val : Real)+1 := hxj linarith let lower : Real × Real := (1-t) • q jj + t • q jn have hlower : lower = (z.1, L j z.1) := by @@ -396,9 +395,6 @@ private theorem hDK (n : ℕ) (q : Fin (n + 3) → ℝ × ℝ) (hq : ∀ (i : Fi have hc : ((j.val+1 : Nat) : Real) ≤ ((n+2 : Nat) : Real) := by exact_mod_cast (show j.val+1 ≤ n+2 by omega) simpa [M, Nat.cast_add] using hc - have hA : 0 ≤ A := by - dsimp [A] - exact mul_nonneg (Nat.cast_nonneg _) (by linarith) have hB : 0 ≤ B := by dsimp [B] exact mul_nonneg (by positivity) (by linarith [hJplus]) @@ -1236,7 +1232,6 @@ theorem P3555T2ParabolaHullFrontier {n : Nat} apply Prod.ext <;> simp [Fin.sum_univ_three, w, p] let U : Set (Real × Real) := {z | 0 < z.1 ∧ 0 < z.2 ∧ z.1+z.2 < 1} have hUopen : IsOpen U := ParabolaHullInterior.hUopen - have hUsub : U ⊆ convexHull Real (Set.range p) := ParabolaHullInterior.hUsub hw_sum hp_sum have target_subset : Set.range (q ∘ f) ⊆ Set.range q := by rintro x ⟨i, rfl⟩ exact ⟨f i, rfl⟩ @@ -1262,18 +1257,11 @@ theorem P3555T2ParabolaHullFrontier {n : Nat} have ballAt (z : Real × Real) (hz : z ∈ interior D) : ∃ e : Real, 0 < e ∧ Metric.ball z e ⊆ D := Metric.mem_nhds_iff.mp (mem_interior_iff_mem_nhds.mp hz) - have noLeftInterior (z : Real × Real) (hz : z ∈ interior D) : z.1 ≠ 0 := - ParabolaHullInterior.noLeftInterior n ballAt z hz - have noRightInterior (z : Real × Real) (hz : z ∈ interior D) : z.1 ≠ M := - ParabolaHullInterior.noRightInterior n ballAt z hz have noUpperInterior (z : Real × Real) (hz : z ∈ interior D) (heq : z.2 = M*z.1) : False := ParabolaHullInterior.noUpperInterior n ballAt z hz heq have noLowerInterior (z : Real × Real) (hz : z ∈ interior D) (j : Fin (n+2)) (heq : L j z.1 = z.2) : False := ParabolaHullInterior.noLowerInterior n ballAt z hz j heq - have interiorStrict (z : Real × Real) (hz : z ∈ interior D) : z ∈ O := - ParabolaHullInterior.interiorStrict n noLeftInterior noRightInterior noUpperInterior - noLowerInterior z hz apply Set.ext intro x constructor diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaSupporting.lean b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaSupporting.lean index 8e6b0ffd6b..e9a4a0c70c 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaSupporting.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaSupporting.lean @@ -76,7 +76,6 @@ theorem P3555T2ParabolaSupporting {n : Nat} omega have hjlt : j.val < i.val := by have hjne : j.val ≠ i.val := fun h => hji (Fin.ext h) - have hjbound := j.isLt omega have hI : 0 < (i.val : Real) := by exact_mod_cast (show 0 < i.val by omega) have hJ : 0 < (j.val : Real) := by exact_mod_cast hjpos diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean index 0d2dc177df..b906005f57 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2SavedDissectionGeometry.lean @@ -211,7 +211,6 @@ private theorem hcross : classical intro n q a b u v left right hAB hfaceA hfaceB f hf g hg heq have hfi := (hfaceA f hf).1 - have hgi := (hfaceB g hg).1 have hsubA := (hfaceA f hf).2.1 have hsubB := (hfaceB g hg).2.1 have hsmall : Set.range f ⊆ ({a, b} : Set (Fin (n + 3))) := by @@ -540,7 +539,6 @@ private theorem hBget : simp; omega have hlenB : (b :: (v ++ [a])).length = v.length + 2 := by simp have hip : (a :: u).length ≤ j.val := by simp; omega - have hj' : j.val < u.length + v.length + 2 := by simpa [hlenL] using j.isLt let jB : Fin (b :: (v ++ [a])).length := ⟨j.val - (u.length + 1), by rw [hlenB]; omega⟩ have hpre : (a :: u).length = u.length + 1 := by simp @@ -583,7 +581,6 @@ private theorem hNoAEndpoints : have hne : (a :: (u ++ [b])).get i ≠ (a :: (u ++ [b])).get j := by intro heq have hij' := (hndA.get_inj_iff).mp heq - have hv := congrArg Fin.val hij' omega have hia' : (a :: (u ++ [b])).get i = a ∨ (a :: (u ++ [b])).get i = b := by simpa using hia @@ -647,7 +644,6 @@ private theorem hNoBEndpoints : (hndB.get_inj_iff).mp (hja'.trans hend.symm) exact hne (by rw [hiend, hjend]) · have hj0 : j = 0 := (hndB.get_inj_iff).mp (hja'.trans hzero.symm) - have hiendv : i.val = v.length + 1 := congrArg Fin.val hiend have hj0v : j.val = 0 := congrArg Fin.val hj0 omega · have hi0 : i = 0 := (hndB.get_inj_iff).mp (hia'.trans hzero.symm) @@ -754,7 +750,6 @@ private theorem hsecondAt889 : have hfin : (⟨k1.val - (u.length + 1), (show _ by have hlen : (b :: (v ++ [a])).length = v.length + 2 := by simp rw [hlen] - have hkv : k.val < u.length + v.length + 2 := by simpa [hlenL] using k.isLt have hks : k.val + 1 < u.length + v.length + 2 := by dsimp [iB] at hjlast; omega dsimp [k1] omega)⟩ : Fin (b :: (v ++ [a])).length) = iB1 := Fin.ext hidx @@ -794,7 +789,6 @@ private theorem hchildNextAt907 : apply Fin.ext have hlen : (b :: (v ++ [a])).length = v.length + 2 := by simp have hstep : iB.val + 1 < (b :: (v ++ [a])).length := by - have hvlen : v.length < (b :: (v ++ [a])).length := by omega omega have hiB1 : iB1.val = iB.val + 1 := by dsimp [iB, iB1, k1]; omega exact (Nat.mod_eq_of_lt hstep).trans hiB1.symm @@ -1444,7 +1438,6 @@ theorem P3555T2SavedDissectionGeometry {n : Nat} have hlenL : (a :: (u ++ b :: v)).length = u.length + v.length + 2 := by simp; omega have hlenB : (b :: (v ++ [a])).length = v.length + 2 := by simp - have hj' : j.val < u.length + v.length + 2 := by simpa [hlenL] using j.isLt rw [hlenB] omega⟩ := SavedDissectionProof.hBget n a b u v j hj have hNoAEndpoints (i j : Fin (a :: (u ++ [b])).length) diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean b/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean index ad8b1f6ec8..b80ff1694f 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean @@ -48,11 +48,6 @@ private theorem coordA_swap : = coordB d e v) := by classical intro det2 coordA coordB d e v hD - have hED : det2 e d ≠ 0 := by - intro h - have hs : det2 e d = -det2 d e := by dsimp [det2]; ring - rw [hs] at h - exact hD (by linarith) have hnum : det2 v d = -det2 d v := by dsimp [det2]; ring have hden : det2 e d = -det2 d e := by dsimp [det2]; ring dsimp [coordA, coordB] @@ -67,11 +62,6 @@ private theorem coordB_swap : = coordA d e v) := by classical intro det2 coordA coordB d e v hD - have hED : det2 e d ≠ 0 := by - intro h - have hs : det2 e d = -det2 d e := by dsimp [det2]; ring - rw [hs] at h - exact hD (by linarith) have hnum : det2 e v = -det2 v e := by dsimp [det2]; ring have hden : det2 e d = -det2 d e := by dsimp [det2]; ring dsimp [coordA, coordB] @@ -388,12 +378,6 @@ private theorem cyclic_xor_count : have hcard : ((Finset.univ.filter tr).card : Int) = ∑ i : Fin (m+1), if b i = b (cyclicSucc m i) then (0 : Int) else 1 := by simp [tr, Finset.card_filter] - have hk' : ((Finset.univ.filter tr).card : Int) = 2*k := by - rw [hcard] - exact hk - have hk0 : 0 ≤ k := by - have hc : 0 ≤ ((Finset.univ.filter tr).card : Int) := Int.natCast_nonneg _ - omega refine ⟨k.toNat, ?_⟩ omega obtain ⟨k, hk⟩ := htrans @@ -418,10 +402,6 @@ private theorem affine_root_between : intro h rw [h, zero_mul] at hac exact (lt_irrefl 0) hac - have hc : c ≠ 0 := by - intro h - rw [h, mul_zero] at hac - exact (lt_irrefl 0) hac by_cases hap : 0 < a · have hcn : c < 0 := by by_contra hn @@ -535,9 +515,6 @@ private theorem affine_axis_crossing_iff : intro heq rw [heq] at hbd nlinarith [sq_nonneg b] - have hu : u=b/(b-d) := by - apply (eq_div_iff (sub_ne_zero.mpr hbdne)).2 - nlinarith [hroot] have hid : (d-b)*((1-u)*a+u*c)=a*d-b*c := by linear_combination (c-a)*hroot have hcrit : 0<(a*d-b*c)*(d-b) := @@ -982,20 +959,6 @@ private theorem choose_common_generic : rw [hzero] at hh exact hh (by simp []) let k : Real × Real := (-g.2, g.1) - have hGk : det2 g k ≠ 0 := by - intro hzero - have hpos : 0 < g.1^2+g.2^2 := by - have hcoord : g.1 ≠ 0 ∨ g.2 ≠ 0 := by - by_contra h - push Not at h - apply hgn - exact Prod.ext h.1 h.2 - rcases hcoord with hcoord | hcoord - · exact add_pos_of_pos_of_nonneg (sq_pos_of_ne_zero hcoord) (sq_nonneg _) - · exact add_pos_of_nonneg_of_pos (sq_nonneg _) (sq_pos_of_ne_zero hcoord) - have hh : det2 g k = g.1^2+g.2^2 := by dsimp [det2, k]; ring - rw [hh] at hzero - linarith have hIndependent (z : Real × Real) (h1 : det2 g z = 0) (h2 : det2 k z = 0) : z=0 := by have hpos : 0 < g.1^2+g.2^2 := by @@ -1263,18 +1226,12 @@ theorem P3597T1DirectionParity {n : Nat} (p : P3381T1PolygonBoundary n) } let cyclicSucc_eq_add {m : Nat} (i : Fin (m+1)) : cyclicSucc m i = i + 1 := DirectionParityLemmas.cyclicSucc_eq_add (m := m) i - let transition_sum_even {m : Nat} (b : Fin (m+1) → Bool) : - (∑ i : Fin (m+1), (if b i = b (cyclicSucc m i) then (0 : Int) else 1)) % 2 = 0 := - DirectionParityLemmas.transition_sum_even (m := m) b let cyclic_xor_count {m : Nat} (P Q : Fin (m+1) → Prop) [DecidablePred P] [DecidablePred Q] (b : Fin (m+1) → Bool) (hxor : ∀ i, (P i ∧ ¬ Q i ∨ ¬ P i ∧ Q i) ↔ b i ≠ b (cyclicSucc m i)) : (Finset.univ.filter P).card % 2 = (Finset.univ.filter Q).card % 2 := DirectionParityLemmas.cyclic_xor_count (m := m) P Q b hxor - let ncard_filter {m : Nat} (P : Fin (m+1) → Prop) [DecidablePred P] : - Set.ncard {i : Fin (m+1) | P i} = (Finset.univ.filter P).card := - DirectionParityLemmas.ncard_filter (m := m) P let affine_root_between (a c : Real) (hac : a*c < 0) : ∃ u, 0 < u ∧ u < 1 ∧ (1-u)*a+u*c=0 := DirectionParityLemmas.affine_root_between a c hac let axis_root_x_identity (a b c d u : Real) diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1GenericRayStability.lean b/LeanPool/ApollonianSuperharmonic/P3597T1GenericRayStability.lean index 4e023bfe94..e5277308aa 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1GenericRayStability.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1GenericRayStability.lean @@ -62,7 +62,6 @@ private theorem genericRayDirection {n : Nat} (p : P3381T1PolygonBoundary n) : intro he have hv := congrArg Fin.val he simp only [Fin.val_add, Fin.val_one] at hv - have hm : 2 ≤ n + 3 := by omega by_cases hs : i.val + 1 < n + 3 · rw [Nat.mod_eq_of_lt hs] at hv omega @@ -454,36 +453,11 @@ private theorem localRayCrossingStability {n : Nat} (p : P3381T1PolygonBoundary (∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1))))) := by intro x d hx hg hs - let det (v w : Real × Real) := v.1 * w.2 - v.2 * w.1 - have params : ∀ (y a d' e : Real × Real), det d' e ≠ 0 → - y + (det (a - y) e / det d' e) • d' = - a + (det (a - y) d' / det d' e) • e ∧ - (∀ t u : Real, y + t • d' = a + u • e → - t = det (a - y) e / det d' e ∧ u = det (a - y) d' / det d' e) := RayCrossingStability.params - have hitCriterion : ∀ (y a b d' : Real × Real), det d' (b - a) ≠ 0 → - ((∃ t : Real, 0 < t ∧ y + t • d' ∈ segment Real a b) ↔ - 0 < det (a - y) (b - a) / det d' (b - a) ∧ - 0 ≤ det (a - y) d' / det d' (b - a) ∧ - det (a - y) d' / det d' (b - a) ≤ 1) := RayCrossingStability.hitCriterion - have hsegCompact : ∀ i : Fin (n + 3), - IsCompact (segment Real (p.vertex i) (p.vertex (i + 1))) := - RayCrossingStability.hsegCompact n p - have hcarrierCompact : IsCompact (P3544T1BoundaryCarrier p) := - RayCrossingStability.hcarrierCompact n p have hcarrierOpen : IsOpen (P3544T1BoundaryCarrier p)ᶜ := RayCrossingStability.hcarrierOpen n p - let T : Fin (n + 3) → (Real × Real) → Real := fun i y => - (((p.vertex i).1 - y.1) * ((p.vertex (i + 1)).2 - (p.vertex i).2) - - ((p.vertex i).2 - y.2) * ((p.vertex (i + 1)).1 - (p.vertex i).1)) * - (det d (p.vertex (i + 1) - p.vertex i))⁻¹ - let U : Fin (n + 3) → (Real × Real) → Real := fun i y => - (((p.vertex i).1 - y.1) * d.2 - ((p.vertex i).2 - y.2) * d.1) * - (det d (p.vertex (i + 1) - p.vertex i))⁻¹ let G : Fin (n + 3) → (Real × Real) → Real := fun i y => d.1 * ((p.vertex i).2 - y.2) - d.2 * ((p.vertex i).1 - y.1) let H : Fin (n + 3) → (Real × Real) → Prop := fun i y => ∃ t : Real, 0 < t ∧ y + t • d ∈ segment Real (p.vertex i) (p.vertex (i + 1)) - have hcriterion : ∀ i y, H i y ↔ - 0 < T i y ∧ 0 ≤ U i y ∧ U i y ≤ 1 := RayCrossingStability.hcriterion n p d hs have hVi : ∀ i : Fin (n + 3), ∃ V : Set (Real × Real), IsOpen V ∧ x ∈ V ∧ ∀ y ∈ V, G i y ≠ 0 ∧ (H i y ↔ H i x) := RayCrossingStability.hVi n p x d hx hg hs diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean b/LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean index f2e5b899e6..4498f7d582 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1SideCrossing.lean @@ -335,11 +335,6 @@ private theorem hTne : (1 : ℝ))) → (∀ (j : Fin (n + 3)), (j ≠ i) → ((0 < U j x ∧ U j x < 1) → (T j x ≠ 0)))) := by classical intro n p i x hxnotseg d D T U hparam j hji hinside ht - have ht' : (((p.vertex j - x).1 * (p.vertex (j + 1) - p.vertex j).2 - - (p.vertex j - x).2 * (p.vertex (j + 1) - p.vertex j).1) / - (d.1 * (p.vertex (j + 1) - p.vertex j).2 - - d.2 * (p.vertex (j + 1) - p.vertex j).1)) = 0 := by - simpa [T, D] using ht have heq := (hparam j).1 change x + T j x • d = p.vertex j + U j x • (p.vertex (j + 1) - p.vertex j) at heq @@ -1395,9 +1390,7 @@ private theorem hlocal : intro h exact hyC ((hcarrier y hy).mpr h) have hg := hgenericY y hy - have hodd := hparity y hyC hg have hcnt := hcount y hy - have hselected := hiY y hy have hTneY : T i y ≠ 0 := by intro ht apply hFy diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean b/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean index 4529bdd3d8..8f0e52aa2d 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean @@ -719,10 +719,6 @@ private theorem hconstOn : · exact False.elim (hzO (hsame.mpr hzbase)) · simp [hzO, hzbase] simpa [f] using hbool - have hfcont : ContinuousOn (fun z : Real × Real => decide (z ∈ O)) S := by - apply continuousOn_iff_continuous_domRestrict.mpr - change Continuous f - exact hf.continuous let : PreconnectedSpace S := isPreconnected_iff_preconnectedSpace.mp hconn.2 have heq := hf.apply_eq_of_preconnectedSpace ⟨x, hx⟩ ⟨y, hy⟩ change (decide (x ∈ O) = decide (y ∈ O)) at heq @@ -2440,11 +2436,6 @@ private theorem hsectorOpp : have he : (s • q : Real × Real) - (0, 0) = s • q := by ext <;> simp rw [he] at hh exact hh - have hsmallNeg : -(s • q) ∈ Metric.ball ((0 : Real), (0 : Real)) δ := by - rw [Metric.mem_ball, dist_eq_norm] - have he : (-(s • q) : Real × Real) - (0, 0) = -(s • q) := by ext <;> simp - rw [he] - simpa only [norm_neg] using hsmallNorm have hplusball : x0 + s • q ∈ Metric.ball x0 δ := VertexSectorProof.hplusball n p i rK δ s hsmallNorm have hminusball : x0 - s • q ∈ Metric.ball x0 δ := VertexSectorProof.hminusball n p i rK δ s diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean b/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean index acd462ad72..03b2b16d93 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean @@ -145,7 +145,6 @@ private theorem hkne1 (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hnext : b let N := n + 3 have hN : 3 ≤ N := hN n let rot : Fin N → Fin N := fun i => a + i - have hrot_inj : Function.Injective rot := hrot_inj n a let k : Nat := (b.val + N - a.val) % N have hklt : k < N := hklt n a b have hrotk : rot ⟨k, hklt⟩ = b := hrotk n a b @@ -155,7 +154,6 @@ private theorem hkne1 (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hnext : b have hidx : (⟨k, hklt⟩ : Fin N) = 1 := by apply Fin.ext simp [he, Nat.mod_eq_of_lt (show 1 < N by omega)] - have heq := hrot_inj (show rot ⟨k, hklt⟩ = rot 1 by rw [hidx]) apply hnext calc b = rot 1 := hrotk.symm.trans (congrArg rot hidx) @@ -212,7 +210,6 @@ private theorem hk_bounds (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a let N := n + 3 have hN : 3 ≤ N := hN n let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkpos : 0 < k := hkpos n a b hab have hkne1 : k ≠ 1 := hkne1 n a b hnext @@ -292,7 +289,6 @@ private theorem hlu (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hprev : a ≠ let N := n + 3 let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -310,7 +306,6 @@ private theorem hlv (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hprev : a ≠ let N := n + 3 let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -412,7 +407,6 @@ private theorem hleftLen (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a classical let N := n + 3 let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hk_bounds : 2 ≤ k ∧ k ≤ N - 2 := hk_bounds n a b hab hnext hprev let leftN := k - 2 @@ -425,7 +419,6 @@ private theorem hrightLen (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a classical let N := n + 3 let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -443,7 +436,6 @@ private theorem hleftLt (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a classical let N := n + 3 let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -459,7 +451,6 @@ private theorem hrightLt (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a classical let N := n + 3 let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev have hk_bounds : 2 ≤ k ∧ k ≤ N - 2 := hk_bounds n a b hab hnext hprev @@ -506,7 +497,6 @@ private theorem hposRlt (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a let N := n + 3 have hNpos : 0 < N := hNpos n let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -544,7 +534,6 @@ private theorem hleft_inj (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a let rot : Fin N → Fin N := fun i => a + i have hrot_inj : Function.Injective rot := hrot_inj n a let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -567,13 +556,11 @@ private theorem hright_inj (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : let rot : Fin N → Fin N := fun i => a + i have hrot_inj : Function.Injective rot := hrot_inj n a let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hk_bounds : 2 ≤ k ∧ k ≤ N - 2 := hk_bounds n a b hab hnext hprev let leftN := k - 2 let rightN := N - k - 2 have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev - have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev let posR : Fin (rightN + 3) → Nat := fun i => if i.val = N - k then 0 else k + i.val have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i @@ -583,14 +570,6 @@ private theorem hright_inj (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : have heq := hrot_inj hij have hval : posR i = posR j := congrArg Fin.val heq apply Fin.ext - have hi_lt : i.val < N - k + 1 := by - calc i.val < rightN + 3 := i.isLt - _ = N - k + 1 := hrightLen - have hj_lt : j.val < N - k + 1 := by - calc j.val < rightN + 3 := j.isLt - _ = N - k + 1 := hrightLen - have hi : i.val ≤ N - k := by omega - have hj : j.val ≤ N - k := by omega dsimp [posR] at hval split_ifs at hval <;> omega @@ -633,7 +612,6 @@ private theorem hleft_order (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : | succ j => by_cases hjk : j + 1 = k · have hlast : j = u.length := by rw [hlu]; omega - have hpos : j + 1 = k := hjk simp only [List.getElem_cons_succ] rw [List.getElem_append_right (as := u) (bs := [b]) (by omega)] simp only [hlast, Nat.sub_self, List.getElem_cons_zero] @@ -736,7 +714,6 @@ private theorem hAil (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ let N := n + 3 let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hrotzero : rot (0 : Fin N) = a := hrotzero n a have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev @@ -753,11 +730,6 @@ private theorem hik (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b classical let N := n + 3 let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b - have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b - have hkle : k + 2 ≤ N := hkle n a b hprev - let root : List (Fin N) := List.ofFn (fun i : Fin N => i) - have hrootlen : root.length = N := hrootlen n let leftN := k - 2 have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev dsimp only [CyclicChildrenConstruction.k, CyclicChildrenConstruction.leftN] at * @@ -803,20 +775,13 @@ private theorem hBir (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N have hklt : k < N := hklt n a b - have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hrotk : rot ⟨k, hklt⟩ = b := hrotk n a b - have hkle : k + 2 ≤ N := hkle n a b hprev - let root : List (Fin N) := List.ofFn (fun i : Fin N => i) - have hrootlen : root.length = N := hrootlen n - let leftN := k - 2 let rightN := N - k - 2 - have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev let posR : Fin (rightN + 3) → Nat := fun i => if i.val = N - k then 0 else k + i.val have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ - have hik : k < leftN + 3 := hik n a b hab hnext hprev change (ir 0 = b) have hz : ¬ (0 : Nat) = N - k := by omega simp [ir, posR, hz, hrotk] @@ -826,19 +791,8 @@ private theorem hlastRlt (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a classical let N := n + 3 let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b - have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b - have hkle : k + 2 ≤ N := hkle n a b hprev - let root : List (Fin N) := List.ofFn (fun i : Fin N => i) - have hrootlen : root.length = N := hrootlen n - let leftN := k - 2 let rightN := N - k - 2 - have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev - let posR : Fin (rightN + 3) → Nat := fun i => - if i.val = N - k then 0 else k + i.val - have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i - have hik : k < leftN + 3 := hik n a b hab hnext hprev dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k, CyclicChildrenConstruction.rightN] at * change (N - k < rightN + 3) @@ -881,7 +835,6 @@ private theorem hcommon (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a let rot : Fin N → Fin N := fun i => a + i have hrot_inj : Function.Injective rot := hrot_inj n a let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -889,7 +842,6 @@ private theorem hcommon (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a let leftN := k - 2 let rightN := N - k - 2 have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev - have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ let posR : Fin (rightN + 3) → Nat := fun i => if i.val = N - k then 0 else k + i.val @@ -919,12 +871,6 @@ private theorem hcommon (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a apply hrot_inj simpa [il, ir] using hEq.symm have hv : i.val = posR j := congrArg Fin.val hpos - have hi : i.val ≤ k := by - have hbound : i.val < k + 1 := by simpa only [hleftLen] using i.isLt - omega - have hj : j.val ≤ N - k := by - have hbound : j.val < N - k + 1 := by simpa only [hrightLen] using j.isLt - omega by_cases hend : j.val = N - k · have hzero : posR j = 0 := by simp [posR, hend] have hizero : i.val = 0 := by omega @@ -935,7 +881,6 @@ private theorem hcommon (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a _ = il 0 := by rw [hi0] _ = a := hAil · have hposr : posR j = k + j.val := by simp [posR, hend] - have hjeq : j.val = 0 := by omega have hival : i.val = k := by omega have hiK : i = ik := Fin.ext hival apply Or.inr @@ -956,7 +901,6 @@ private theorem hopen_old_disjoint (n : Nat) (p : P3381T1PolygonBoundary n) (a : x ∈ openSegment Real (p.vertex a) (p.vertex b)) (j : Fin (N n)) : x ∉ segment Real (p.vertex j) (p.vertex (j + 1)) := by classical - let N := n + 3 dsimp only [CyclicChildrenConstruction.N] at * intro hxj have hxC : x ∈ P3544T1BoundaryCarrier p := by @@ -968,7 +912,6 @@ private theorem hvertex_side (n : Nat) (p : P3381T1PolygonBoundary n) (e j : Fin p.vertex e ∈ segment Real (p.vertex j) (p.vertex (j + 1))) : e = j ∨ e = j + 1 := by classical - let N := n + 3 dsimp only [CyclicChildrenConstruction.N] at * by_cases heq : e = j · exact Or.inl heq @@ -1029,25 +972,11 @@ private theorem hchord_old (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin (n · rw [hxj1] exact right_mem_segment Real _ _ -private theorem hrot_succ (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext : b - ≠ a + 1) (hprev : a ≠ b + 1) (i : Fin (N n)) : (rot n a) (i + 1) = (rot n a) i + 1 := by +private theorem hrot_succ (n : Nat) (a : Fin (n + 3)) (i : Fin (N n)) : + (rot n a) (i + 1) = (rot n a) i + 1 := by classical let N := n + 3 let rot : Fin N → Fin N := fun i => a + i - let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b - have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b - have hkle : k + 2 ≤ N := hkle n a b hprev - let root : List (Fin N) := List.ofFn (fun i : Fin N => i) - have hrootlen : root.length = N := hrootlen n - let leftN := k - 2 - let rightN := N - k - 2 - have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev - let posR : Fin (rightN + 3) → Nat := fun i => - if i.val = N - k then 0 else k + i.val - have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i - have hik : k < leftN + 3 := hik n a b hab hnext hprev - have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev dsimp only [CyclicChildrenConstruction.N] at * change (rot (i + 1) = rot i + 1) apply Fin.ext @@ -1066,20 +995,10 @@ private theorem hleftLen_gt (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : classical let N := n + 3 let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b - have hkle : k + 2 ≤ N := hkle n a b hprev have hk_bounds : 2 ≤ k ∧ k ≤ N - 2 := hk_bounds n a b hab hnext hprev - let root : List (Fin N) := List.ofFn (fun i : Fin N => i) - have hrootlen : root.length = N := hrootlen n let leftN := k - 2 - let rightN := N - k - 2 have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev - let posR : Fin (rightN + 3) → Nat := fun i => - if i.val = N - k then 0 else k + i.val - have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i - have hik : k < leftN + 3 := hik n a b hab hnext hprev - have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev dsimp only [CyclicChildrenConstruction.leftN] at * change (1 < leftN + 3) rw [hleftLen]; omega @@ -1089,20 +1008,8 @@ private theorem hrightLen_gt (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab classical let N := n + 3 let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b - have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b - have hkle : k + 2 ≤ N := hkle n a b hprev - let root : List (Fin N) := List.ofFn (fun i : Fin N => i) - have hrootlen : root.length = N := hrootlen n - let leftN := k - 2 let rightN := N - k - 2 - have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev - let posR : Fin (rightN + 3) → Nat := fun i => - if i.val = N - k then 0 else k + i.val - have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i - have hik : k < leftN + 3 := hik n a b hab hnext hprev - have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev dsimp only [CyclicChildrenConstruction.rightN] at * change (1 < rightN + 3) rw [hrightLen]; omega @@ -1115,21 +1022,14 @@ private theorem hleft_succ (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : have hN : 3 ≤ N := hN n let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) have hrootlen : root.length = N := hrootlen n let leftN := k - 2 - let rightN := N - k - 2 have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ - let posR : Fin (rightN + 3) → Nat := fun i => - if i.val = N - k then 0 else k + i.val - have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i - have hik : k < leftN + 3 := hik n a b hab hnext hprev - have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev - have hrot_succ (i : Fin N) : rot (i + 1) = rot i + 1 := hrot_succ n a b hab hnext hprev i + have hrot_succ (i : Fin N) : rot (i + 1) = rot i + 1 := hrot_succ n a i have hleftLen_gt : 1 < leftN + 3 := hleftLen_gt n a b hab hnext hprev dsimp only [CyclicChildrenConstruction.k, CyclicChildrenConstruction.leftN] at * change (il (i + 1) = il i + 1) @@ -1164,7 +1064,6 @@ private theorem hright_succ (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : have hN : 3 ≤ N := hN n let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -1177,9 +1076,7 @@ private theorem hright_succ (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : if i.val = N - k then 0 else k + i.val have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ - have hik : k < leftN + 3 := hik n a b hab hnext hprev - have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev - have hrot_succ (i : Fin N) : rot (i + 1) = rot i + 1 := hrot_succ n a b hab hnext hprev i + have hrot_succ (i : Fin N) : rot (i + 1) = rot i + 1 := hrot_succ n a i have hrightLen_gt : 1 < rightN + 3 := hrightLen_gt n a b hab hnext hprev dsimp only [CyclicChildrenConstruction.N, CyclicChildrenConstruction.k, CyclicChildrenConstruction.rightN] at * @@ -1232,21 +1129,12 @@ private theorem hleft_wrap (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : classical let N := n + 3 let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b - have hkle : k + 2 ≤ N := hkle n a b hprev have hk_bounds : 2 ≤ k ∧ k ≤ N - 2 := hk_bounds n a b hab hnext hprev - let root : List (Fin N) := List.ofFn (fun i : Fin N => i) - have hrootlen : root.length = N := hrootlen n let leftN := k - 2 - let rightN := N - k - 2 have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev - let posR : Fin (rightN + 3) → Nat := fun i => - if i.val = N - k then 0 else k + i.val - have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i have hik : k < leftN + 3 := hik n a b hab hnext hprev let ik : Fin (leftN + 3) := ⟨k, hik⟩ - have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev change (ik + 1 = 0) apply Fin.ext simp [ik, Fin.val_add_eq_ite, hleftLen, @@ -1257,19 +1145,8 @@ private theorem hright_wrap (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : classical let N := n + 3 let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b - have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b - have hkle : k + 2 ≤ N := hkle n a b hprev - let root : List (Fin N) := List.ofFn (fun i : Fin N => i) - have hrootlen : root.length = N := hrootlen n - let leftN := k - 2 let rightN := N - k - 2 - have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev - let posR : Fin (rightN + 3) → Nat := fun i => - if i.val = N - k then 0 else k + i.val - have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i - have hik : k < leftN + 3 := hik n a b hab hnext hprev have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev let lastR : Fin (rightN + 3) := ⟨N - k, hlastRlt⟩ change (lastR + 1 = 0) @@ -1286,7 +1163,6 @@ private theorem hleft_last_edge (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fi let N := n + 3 let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -1338,7 +1214,6 @@ private theorem hleft_nonlast (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin let N := n + 3 let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -1393,7 +1268,6 @@ private theorem hleft_old_old (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin let N := n + 3 let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -1469,7 +1343,6 @@ private theorem hleft_old_last (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin let N := n + 3 let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -1577,7 +1450,6 @@ private theorem hleft_last_old (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin let N := n + 3 let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -1865,7 +1737,6 @@ private theorem hcarrier_union (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin let N := n + 3 let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -1879,8 +1750,6 @@ private theorem hcarrier_union (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin if i.val = N - k then 0 else k + i.val have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ - have hleft_inj : Function.Injective il := hleft_inj n a b hab hnext hprev - have hright_inj : Function.Injective ir := hright_inj n a b hab hnext hprev have hik : k < leftN + 3 := hik n a b hab hnext hprev let ik : Fin (leftN + 3) := ⟨k, hik⟩ have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev @@ -1903,44 +1772,6 @@ private theorem hcarrier_union (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) = segment Real (p.vertex (ir i)) (p.vertex (ir i + 1)) := hright_nonlast n p a b hab hnext hprev i hi - have hleft_old_old (i j : Fin (leftN + 3)) (hi : i.val < k) - (hj : j.val < k) (hij : i ≠ j) : - segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) ∩ - segment Real (p.vertex (il j)) (p.vertex (il (j + 1))) = - {x | (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1))) ∧ - (x = p.vertex (il j) ∨ x = p.vertex (il (j + 1)))} := hleft_old_old n p a b hab hnext - hprev i j hi hj hij - have hright_old_old (i j : Fin (rightN + 3)) (hi : i.val < N - k) - (hj : j.val < N - k) (hij : i ≠ j) : - segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) ∩ - segment Real (p.vertex (ir j)) (p.vertex (ir (j + 1))) = - {x | (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1))) ∧ - (x = p.vertex (ir j) ∨ x = p.vertex (ir (j + 1)))} := hright_old_old n p a b hab hnext - hprev i j hi hj hij - have hleft_old_last (i : Fin (leftN + 3)) (hi : i.val < k) : - segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) ∩ - segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) = - {x | (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1))) ∧ - (x = p.vertex (il ik) ∨ x = p.vertex (il (ik + 1)))} := hleft_old_last n p a b hab - hnext hprev hclear i hi - have hright_old_last (i : Fin (rightN + 3)) (hi : i.val < N - k) : - segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) ∩ - segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) = - {x | (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1))) ∧ - (x = p.vertex (ir lastR) ∨ x = p.vertex (ir (lastR + 1)))} := hright_old_last n p a b - hab hnext hprev hclear i hi - have hleft_last_old (i : Fin (leftN + 3)) (hi : i.val < k) : - segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) ∩ - segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) = - {x | (x = p.vertex (il ik) ∨ x = p.vertex (il (ik + 1))) ∧ - (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1)))} := hleft_last_old n p a b hab hnext - hprev hclear i hi - have hright_last_old (i : Fin (rightN + 3)) (hi : i.val < N - k) : - segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) ∩ - segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) = - {x | (x = p.vertex (ir lastR) ∨ x = p.vertex (ir (lastR + 1))) ∧ - (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1)))} := hright_last_old n p a b hab hnext - hprev hclear i hi let leftPoly : P3381T1PolygonBoundary leftN := CyclicChildrenConstruction.leftPoly n p a b hab hnext hprev hclear let rightPoly : P3381T1PolygonBoundary rightN := CyclicChildrenConstruction.rightPoly n p a b @@ -2032,9 +1863,6 @@ private theorem hcarrier_union (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin · have hxiL : x ∈ segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) := by rw [hleft_last_edge] exact hx - have hxiR : x ∈ segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) := by - rw [hright_last_edge] - exact hx exact Or.inl ((hleft_mem x).mpr ⟨ik, hxiL⟩) private theorem hcommon_index (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab : a ≠ b) (hnext @@ -2045,7 +1873,6 @@ private theorem hcommon_index (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (hab let N := n + 3 let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -2074,7 +1901,6 @@ private theorem hpoint_chord (n : Nat) (p : P3381T1PolygonBoundary n) (a : Fin ( (hxs : x = p.vertex s) (hs : s = a ∨ s = b) : x ∈ segment Real (p.vertex a) (p.vertex b) := by classical - let N := n + 3 dsimp only [CyclicChildrenConstruction.N] at * rcases hs with h | h · rw [hxs, h] @@ -2092,7 +1918,6 @@ private theorem hcarrier_intersection (n : Nat) (p : P3381T1PolygonBoundary n) ( let N := n + 3 let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -2134,44 +1959,6 @@ private theorem hcarrier_intersection (n : Nat) (p : P3381T1PolygonBoundary n) ( segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) = segment Real (p.vertex (ir i)) (p.vertex (ir i + 1)) := hright_nonlast n p a b hab hnext hprev i hi - have hleft_old_old (i j : Fin (leftN + 3)) (hi : i.val < k) - (hj : j.val < k) (hij : i ≠ j) : - segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) ∩ - segment Real (p.vertex (il j)) (p.vertex (il (j + 1))) = - {x | (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1))) ∧ - (x = p.vertex (il j) ∨ x = p.vertex (il (j + 1)))} := hleft_old_old n p a b hab hnext - hprev i j hi hj hij - have hright_old_old (i j : Fin (rightN + 3)) (hi : i.val < N - k) - (hj : j.val < N - k) (hij : i ≠ j) : - segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) ∩ - segment Real (p.vertex (ir j)) (p.vertex (ir (j + 1))) = - {x | (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1))) ∧ - (x = p.vertex (ir j) ∨ x = p.vertex (ir (j + 1)))} := hright_old_old n p a b hab hnext - hprev i j hi hj hij - have hleft_old_last (i : Fin (leftN + 3)) (hi : i.val < k) : - segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) ∩ - segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) = - {x | (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1))) ∧ - (x = p.vertex (il ik) ∨ x = p.vertex (il (ik + 1)))} := hleft_old_last n p a b hab - hnext hprev hclear i hi - have hright_old_last (i : Fin (rightN + 3)) (hi : i.val < N - k) : - segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) ∩ - segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) = - {x | (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1))) ∧ - (x = p.vertex (ir lastR) ∨ x = p.vertex (ir (lastR + 1)))} := hright_old_last n p a b - hab hnext hprev hclear i hi - have hleft_last_old (i : Fin (leftN + 3)) (hi : i.val < k) : - segment Real (p.vertex (il ik)) (p.vertex (il (ik + 1))) ∩ - segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) = - {x | (x = p.vertex (il ik) ∨ x = p.vertex (il (ik + 1))) ∧ - (x = p.vertex (il i) ∨ x = p.vertex (il (i + 1)))} := hleft_last_old n p a b hab hnext - hprev hclear i hi - have hright_last_old (i : Fin (rightN + 3)) (hi : i.val < N - k) : - segment Real (p.vertex (ir lastR)) (p.vertex (ir (lastR + 1))) ∩ - segment Real (p.vertex (ir i)) (p.vertex (ir (i + 1))) = - {x | (x = p.vertex (ir lastR) ∨ x = p.vertex (ir (lastR + 1))) ∧ - (x = p.vertex (ir i) ∨ x = p.vertex (ir (i + 1)))} := hright_last_old n p a b hab hnext - hprev hclear i hi let leftPoly : P3381T1PolygonBoundary leftN := CyclicChildrenConstruction.leftPoly n p a b hab hnext hprev hclear let rightPoly : P3381T1PolygonBoundary rightN := CyclicChildrenConstruction.rightPoly n p a b diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean b/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean index e714bc77ef..51960cffdc 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean @@ -1027,10 +1027,6 @@ private theorem hcoord0j : 0 (p.vertex j) = 1 - z0))) ) := by classical intro n p E a b c v hind hspan A j hposj hα0 z0 hsum0 - have hh : A.coord 0 (p.vertex j) + z0 = 1 := by - dsimp [z0] at * - rw [hα0] at hsum0 - simpa only [add_zero] using hsum0 linarith private theorem hcoord01 : @@ -1051,10 +1047,6 @@ private theorem hcoord01 : 1)) = 1) → (A.coord 0 (p.vertex (j + 1)) = 1 - z1))) ) := by classical intro n p E a b c v hind hspan A j hposnext hβ0 z1 hsum1 - have hh : A.coord 0 (p.vertex (j + 1)) + z1 = 1 := by - dsimp [z1] at * - rw [hβ0] at hsum1 - simpa only [add_zero] using hsum1 linarith private theorem hnotIoo0 : @@ -1940,10 +1932,8 @@ private theorem hbaseAvoid : simpa [z0, z1] using hline 2 s have hzt : (1 - t) * z0 + t * z1 = A.coord 2 x := TriangleDiagonalGeometry.hzt n p E hind hspan x j t hqtq hline2 - have hzpos : 0 < (1 - t) * z0 + t * z1 := by rw [hzt]; exact hxb.2.2 have hxsum : A.coord 0 x + A.coord 1 x + A.coord 2 x = 1 := by simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one x - have hzlt := TriangleDiagonalGeometry.hzlt n p E hind hspan x hxb hxsum have hstraddle := TriangleDiagonalGeometry.hstraddle n p E hind hspan x j hxb t ht' hzt (TriangleDiagonalGeometry.hz0case n p E hind hspan j (TriangleDiagonalGeometry.hnotIoo0 n p E hempty hind hspan hmem hcoordA hcoordB @@ -2005,9 +1995,6 @@ theorem P3650T1EmptyTriangleDiagonal {n : Nat} (p : P3381T1PolygonBoundary n) have hind := TriangleDiagonalGeometry.hind n p E hdet have hspan := TriangleDiagonalGeometry.hspan n p E hind let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨triangleVertices, hind, hspan⟩ - have hA0 : A 0 = a := rfl - have hA1 : A 1 = b := rfl - have hA2 : A 2 = c := rfl have hheight : E.height = A.coord 1 := TriangleDiagonalGeometry.hheight n p E hind hspan let T := convexHull Real ({a, b, c} : Set (Real × Real)) have hrange := TriangleDiagonalGeometry.hrangeAt179 n p E hind hspan @@ -2015,7 +2002,6 @@ theorem P3650T1EmptyTriangleDiagonal {n : Nat} (p : P3381T1PolygonBoundary n) hspan hrange have hint := TriangleDiagonalGeometry.hint n p E hind hspan hrange - have hbase := TriangleDiagonalGeometry.hbase n p E have hheightcoord (x : Real × Real) : E.height x = A.coord 1 x := by rw [hheight] have hvertexSide (i j : Fin (n + 3)) := TriangleDiagonalGeometry.hvertexSide n p i j @@ -2027,7 +2013,6 @@ theorem P3650T1EmptyTriangleDiagonal {n : Nat} (p : P3381T1PolygonBoundary n) hind hspan x hx hxs have habdist := TriangleDiagonalGeometry.habdist n p E (TriangleDiagonalGeometry.hacOuter n p E hdet) - have hbcOuter := TriangleDiagonalGeometry.hbcOuter n p E have habNext := TriangleDiagonalGeometry.habNext n p E have hcaNext := TriangleDiagonalGeometry.hcaNext n p hn E have hintAvoid := TriangleDiagonalGeometry.hintAvoid n p E hentry hempty hind hspan hint @@ -2039,7 +2024,6 @@ theorem P3650T1EmptyTriangleDiagonal {n : Nat} (p : P3381T1PolygonBoundary n) have hbaseAvoid := TriangleBaseAvoidance.hbaseAvoid n p E hempty hind hspan hmem hint hvertexSide hleftFace hrightFace habdist habNext hcaNext hintAvoid hcoordA hcoordB hcoordC let O := P3544T1RayParity p - let C := P3544T1BoundaryCarrier p obtain ⟨rcone, hrcone, hcone⟩ := E.cone_odd let m : Real × Real := AffineMap.lineMap a c (1 / 2 : Real) let q : Real → Real × Real := fun t => AffineMap.lineMap b m t diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean index ced476ebdc..c7048a6eaa 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean @@ -87,7 +87,6 @@ private theorem hnextne : intro n b h have hv := congrArg Fin.val h simp only [Fin.val_add, Fin.val_one] at hv - have hN : 2 ≤ n + 3 := by omega by_cases hlt : b.val + 1 < n + 3 · rw [Nat.mod_eq_of_lt hlt] at hv omega @@ -158,7 +157,6 @@ private theorem hellu : ell u < 0)) ) := by classical intro n p v f hqexists q b ell hstrict hprevne B a u - let c := v (b + 1) have hh := hstrict (b - 1) hprevne calc ell u = ell (a - B) := rfl @@ -830,7 +828,6 @@ private theorem hconeUV : rw [he, hB] exact neg_neg_of_pos (mul_pos ht hUV) · rintro ⟨hA, hB⟩ - have hz := hdecomp (x - B) let s := -cross V (x - B) / cross U V let t := cross U (x - B) / cross U V have hs : 0 < s := by dsimp [s]; exact div_pos (neg_pos.mpr hB) hUV @@ -909,10 +906,6 @@ private theorem hconstOn : exact (Set.disjoint_left.mp hdis hzball) hmem simp [hzO, hz'O] simpa [f] using heq - have hfcont : ContinuousOn (fun z : Real × Real => decide (z ∈ O)) S := by - apply continuousOn_iff_continuous_domRestrict.mpr - change Continuous f - exact hf.continuous let : PreconnectedSpace S := isPreconnected_iff_preconnectedSpace.mp hconn.2 have heq := hf.apply_eq_of_preconnectedSpace ⟨x, hx⟩ ⟨y, hy⟩ change decide (x ∈ O) = decide (y ∈ O) at heq @@ -1190,7 +1183,6 @@ private theorem hsegmentHeight : → ell x ≤ ell B)) ) := by classical intro n p v f hqexists q b ell hmax B hsegParam i x hx - let c := v (b + 1) obtain ⟨t, ht, hform⟩ := hsegParam (v i) (v (i + 1)) x hx have hvalue : ell x = (1 - t) * ell (v i) + t * ell (v (i + 1)) := by rw [hform, map_add, map_smul, map_sub] @@ -1782,7 +1774,6 @@ private theorem hyheight : ((0 : ℝ) < ε) → (ell B < ell y) ) := by classical intro n p v f hqexists q b B e ε y ell hε - let c := v (b + 1) have he : ell e = 1 := by simp [e, ell] have hval : ell y = ell B + ε := by change ell (B + ε • e) = ell B + ε @@ -1861,9 +1852,6 @@ private theorem hellD : 0 < ell d)))) := by classical intro n p v f hqexists q b e ε ell d0 T κ hκT d - let B := v b - let c := v (b + 1) - let y : Real × Real := B + ε • e have heval : ell d = ell d0 + κ := by simp [d, e, ell]; ring have hκlarge : -ell d0 + 1 < κ := lt_of_le_of_lt (le_max_right _ _) hκT rw [heval] @@ -1988,7 +1976,6 @@ private theorem hhitsEmpty : hits = ∅))) ) := by classical intro n p v f hqexists q b B e ε y ell hsegmentHeight hyheight d0 κ d hellD hits - let c := v (b + 1) apply Set.eq_empty_iff_forall_notMem.mpr intro i hi obtain ⟨t, ht, hseg⟩ := hi @@ -2455,47 +2442,6 @@ end ExposedCornerGeometry namespace ExposedCornerAssembly -private theorem hN0pc : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - ∀ (b : Fin (n + (3 : ℕ))), - let B := v b - let a := v (b - 1) - let c := v (b + 1) - let u : Real × Real := a - B - let w : Real × Real := c - B - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - ∀ (rK : ℝ), - let r := min rK (min (dist B a / 2) (dist B c / 2)) - ( - let cross := fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1; ∀ (z : ℝ × ℝ), IsLinearMap ℝ - (cross z)) → ( - let U := if 0 < cross u w then u else w - let V := if 0 < cross u w then w else u - ( - let U := if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : - Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex - b) then p.vertex (b - (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b + (1 : - Fin (n + (3 : ℕ)))) - p.vertex b; - let V := if (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * y.1) (p.vertex (b - (1 : - Fin (n + (3 : ℕ)))) - p.vertex b) (p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex - b) then p.vertex (b + (1 : Fin (n + (3 : ℕ)))) - p.vertex b else p.vertex (b - (1 : - Fin (n + (3 : ℕ)))) - p.vertex b; (0 : ℝ) < (fun (x y : ℝ × ℝ) => x.1 * y.2 - x.2 * - y.1) U V) → ( - let N0 : Set (Real × Real) := {z | z ∈ Metric.ball 0 r ∧ - 0 < cross U z ∧ cross V z < 0} - let z0 := U + V - (cross U z0 = cross U V) → ((cross V z0 = -cross U V) → (∀ (τ : ℝ), ((0 : ℝ) < τ) → ((τ • - z0 ∈ Metric.ball (0 : ℝ × ℝ) r) → (IsPathConnected N0)))))) ) := by - classical - intro n p v b B a c u w cross rK r hcrossLinear U V hUV N0 z0 hz0U hz0V τ hτ hτball - exact (ExposedCornerGeometry.hNconvex n p b rK - hcrossLinear).isPathConnected (ExposedCornerGeometry.hN0ne n p b rK hcrossLinear hUV hz0U - hz0V τ hτ hτball) - private theorem hcover : (by classical @@ -2598,11 +2544,6 @@ private theorem hcover : classical intro n p v b B a c hlineMap rK r hr hrA hrC hcarrierLocal hUV hdecomp hradialDist hUendpoint hVendpoint - let u : Real × Real := a - B - let w : Real × Real := c - B - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - let U := if 0 < cross u w then u else w - let V := if 0 < cross u w then w else u exact ExposedCornerGeometry.hcover n p b rK (ExposedCornerGeometry.haxisU n p b hlineMap rK hr hcarrierLocal hUV hdecomp hradialDist hUendpoint (ExposedCornerGeometry.hUdist n p b rK hrA hrC hUendpoint)) (ExposedCornerGeometry.haxisV n @@ -3096,8 +3037,10 @@ theorem P3650T1ExposedCornerExists {n : Nat} (p : P3381T1PolygonBoundary n) : have hz0U : cross U z0 = cross U V := by dsimp [z0]; dsimp [cross]; ring have hz0V : cross V z0 = -cross U V := by dsimp [z0]; dsimp [cross]; ring obtain ⟨τ, hτ, hτball⟩ := hsmallScale z0 r hr - have hN0pc : IsPathConnected N0 := ExposedCornerAssembly.hN0pc n p b rK hcrossLinear hUV hz0U - hz0V τ hτ hτball + have hN0pc : IsPathConnected N0 := by + exact (ExposedCornerGeometry.hNconvex n p b rK + hcrossLinear).isPathConnected (ExposedCornerGeometry.hN0ne n p b rK hcrossLinear hUV hz0U + hz0V τ hτ hτball) have hW1convex : Convex Real W1 := (convex_ball 0 r).inter (convex_halfSpace_lt (hcrossLinear U) 0) have hW2convex : Convex Real W2 := @@ -3128,8 +3071,6 @@ theorem P3650T1ExposedCornerExists {n : Nat} (p : P3381T1PolygonBoundary n) : have hVendpoint := ExposedCornerGeometry.hVendpoint n p b have hcover := ExposedCornerAssembly.hcover n p b hlineMap rK hr hrA hrC hcarrierLocal hUV hdecomp hradialDist hUendpoint hVendpoint - have hellU := ExposedCornerGeometry.hellU n p hqexists b hellu hellw - have hellV := ExposedCornerGeometry.hellV n p hqexists b hellu hellw have htranslate : ∀ z : Real × Real, z ∈ Metric.ball (0 : Real × Real) r → B + z ∈ Metric.ball B r := ExposedCornerGeometry.htranslate n p b rK let e : Real × Real := (1, 0) diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean b/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean index 682c977d61..8ce9be34ae 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1LocalCoherence.lean @@ -978,8 +978,6 @@ theorem P3650T1LocalCoherence {n : Nat} (p : P3381T1PolygonBoundary n) obtain ⟨rL, hrL, hpathL, _⟩ := (P3544T1LocalParity C.left).2.2.2.2.2.2.2.1 iL obtain ⟨rR, hrR, hpathR, _⟩ := (P3544T1LocalParity C.right).2.2.2.2.2.2.2.1 iR have hopenP : IsOpen Op := (P3544T1LocalParity p).2.1 - have hopenL : IsOpen OL := (P3544T1LocalParity C.left).2.1 - have hopenR : IsOpen OR := (P3544T1LocalParity C.right).2.1 have hclosureL : closure OL = OL ∪ CL := by simpa [OL, CL] using (P3544T1LocalParity C.left).1 have hclosureR : closure OR = OR ∪ CR := by @@ -1105,11 +1103,8 @@ theorem P3650T1LocalCoherence {n : Nat} (p : P3381T1PolygonBoundary n) Metric.ball_subset_ball (le_trans (min_le_left (min rL rR) rp) (min_le_left rL rR)) have hsmallR : Metric.ball x r ⊆ Metric.ball x rR := Metric.ball_subset_ball (le_trans (min_le_left (min rL rR) rp) (min_le_right rL rR)) - have hsmallP : Metric.ball x r ⊆ Metric.ball x rp := - Metric.ball_subset_ball (min_le_right (min rL rR) rp) have hyL : y ∈ Metric.ball x rL := hsmallL hy have hyR : y ∈ Metric.ball x rR := hsmallR hy - have hyP : y ∈ Metric.ball x rp := hsmallP hy have hL := hcanonL y hyL have hR := hcanonR y hyR simpa [H, s, hsignsOpp] using And.intro hL hR diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean b/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean index 445db11234..ddade7549a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1MaximalHeightDiagonal.lean @@ -201,9 +201,6 @@ private theorem hheightlt : classical intro n p E d A hcoord_nonneg hsum hheightd hcoord0 hcoord2 rw [hheightd] - have h1 := hcoord_nonneg 1 - have h2 := hcoord_nonneg 2 - have h0 := hcoord0 linarith private theorem hcoordB0 : @@ -487,8 +484,6 @@ private theorem hPdecomp : rw [Fin.sum_univ_three, hA0, hA1, hA2] at hcomb have hsumP : A.coord 0 P + A.coord 1 P + A.coord 2 P = 1 := by simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one P - have hcoord1P : A.coord 1 P = 1 - A.coord 0 P - A.coord 2 P := by - linarith [hsumP] apply Prod.ext · have hxcomb := congrArg Prod.fst hcomb change A.coord 0 P * (p.vertex (E.b - 1)).1 + diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean index 4b6c092e9c..db1c5137ca 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean @@ -604,7 +604,6 @@ private theorem rightPreviousParent : exact hget have hright : some (a - 1) = some (K.ir ⟨K.rightParameter+1, by omega⟩) := hvlast.symm.trans hvget - have hne : K.v ≠ [] := List.ne_nil_of_length_pos K.hv have hright' := hright exact (Option.some.inj hright').symm @@ -633,7 +632,6 @@ private theorem hbaseChild : have hrLen : C.rotation % (List.ofFn (fun i : Fin (n + 3) => i)).length = D.a.val := by simpa only [hrotLen] using (congrArg Fin.val hrot0).symm have hr : C.rotation % (n + 3) = D.a.val := by simpa [hrotLen] using hrLen - have hpos2 : 2 < n + 3 := by omega have hrot2 := List.getElem?_rotate (l := List.ofFn (fun i : Fin (n + 3) => i)) (n := C.rotation) (m := 2) (by omega) rw [C.parent_order] at hrot2 @@ -651,22 +649,6 @@ private theorem hbaseChild : _ = D.b.val := by have hv := congrArg Fin.val habFin simpa only [Fin.val_add, htwo, Nat.add_comm] using hv - have hidxB : (⟨(2 + C.rotation % (List.ofFn (fun i : Fin (n + 3) => i)).length) % - (List.ofFn (fun i : Fin (n + 3) => i)).length, by - have hlt : (2 + C.rotation % (n + 3)) % (n + 3) < n + 3 := Nat.mod_lt _ hN - simpa only [List.length_ofFn] using hlt⟩ : Fin (n + 3)) = D.b := by - apply Fin.ext - have hmod : (2 + C.rotation % (n + 3)) % (n + 3) = - (2 + C.rotation) % (n + 3) := by - have h2lt : 2 < n + 3 := by omega - calc - (2 + C.rotation % (n + 3)) % (n + 3) = - (2 % (n + 3) + C.rotation % (n + 3)) % (n + 3) := by - rw [Nat.mod_eq_of_lt h2lt] - _ = (2 + C.rotation) % (n + 3) := by - rw [Nat.add_mod] - simp [Nat.mod_eq_of_lt h2lt] - simpa only [List.length_ofFn] using hmod.trans hmodB have hsource : (List.ofFn (fun i : Fin (n + 3) => i))[ (2 + C.rotation) % (n + 3)]? = some D.b := by have hidxlt : (2 + C.rotation) % (n + 3) < @@ -702,9 +684,6 @@ private theorem hbaseChild : have huLen : C.u.length = 1 := by by_contra hn have hu2 : 1 < C.u.length := by have hu := C.hu; omega - have hcell : (C.u)[1]'(by omega) = D.b := by - simpa only [List.getElem_cons_succ, - List.getElem_append_left (by omega : 1 < C.u.length)] using hleftCell have hnd : (D.a :: (C.u ++ [D.b])).Nodup := by rw [← C.left_order] exact List.nodup_ofFn_ofInjective C.il_injective @@ -886,7 +865,6 @@ private theorem hseedLAt728 : intro n p E D C e CR OL triangleHull prevIndexNe nextIndexNe ha hb hempty hbaseChild hleftIndexRange hleftVertexRange let j : Fin (n + 3) := C.ir 1 - have hjrange : j ∈ Set.range C.ir := ⟨1, rfl⟩ have hjneA : j ≠ D.a := by intro heq have hfirst : C.ir 0 = D.b := by @@ -1096,12 +1074,6 @@ private theorem hside0 : segment Real vb vc)) ) := by classical intro n p E va vb vc vv hind hspan A x hx h0 - have h0b : A.coord 0 vb = 0 := by - change A.coord 0 (A 1) = 0 - exact A.coord_apply_ne (by decide) - have h0c : A.coord 0 vc = 0 := by - change A.coord 0 (A 2) = 0 - exact A.coord_apply_ne (by decide) have hn := (Set.ext_iff.mp A.convexHull_eq_nonneg_coord x).mp hx have hsum : A.coord 0 x + A.coord 1 x + A.coord 2 x = 1 := by simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one x @@ -1144,12 +1116,6 @@ private theorem hside2 : segment Real va vb)) ) := by classical intro n p E va vb vc vv hind hspan A x hx h2 - have h2a : A.coord 2 va = 0 := by - change A.coord 2 (A 0) = 0 - exact A.coord_apply_ne (by decide) - have h2b : A.coord 2 vb = 0 := by - change A.coord 2 (A 1) = 0 - exact A.coord_apply_ne (by decide) have hn := (Set.ext_iff.mp A.convexHull_eq_nonneg_coord x).mp hx have hsum : A.coord 0 x + A.coord 1 x + A.coord 2 x = 1 := by simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one x @@ -2868,29 +2834,17 @@ theorem P3650T1OldArcEven {n : Nat} (p : P3381T1PolygonBoundary n) (P3544T1RayParity C.left) := by -- BODY classical - let e := segment Real (p.vertex D.a) (p.vertex D.b) let CL := P3544T1BoundaryCarrier C.left let CR := P3544T1BoundaryCarrier C.right - let CP := P3544T1BoundaryCarrier p let OL := P3544T1RayParity C.left let OR := P3544T1RayParity C.right have hLoff := OldArcParityProof.hLoff n p E D C have hRoff := OldArcParityProof.hRoff n p E D C - have hLparent := OldArcParityProof.hLparent n p E D C - have hRparent := OldArcParityProof.hRparent n p E D C have oldArcEvenOnPreconnected {X : Type} [TopologicalSpace X] (O K S : Set X) (hO : IsOpen O) (hclosure : closure O = O ∪ K) (hS : IsPreconnected S) (hSK : Disjoint S K) (x : X) (hx : x ∈ S) (hxO : x ∉ O) := OldArcParityProof.oldArcEvenOnPreconnected (X := X) O K S hO hclosure hS hSK x hx hxO - have oldArcOddOnPreconnected {X : Type} [TopologicalSpace X] - (O K S : Set X) (hO : IsOpen O) (hclosure : closure O = O ∪ K) - (hS : IsPreconnected S) (hSK : Disjoint S K) - (x : X) (hx : x ∈ S) (hxO : x ∈ O) := OldArcParityProof.oldArcOddOnPreconnected - oldArcEvenOnPreconnected (X := X) O K S hO hclosure hS hSK x hx hxO - have oldArcEvenClosure {X : Type} [TopologicalSpace X] - (O S : Set X) (hO : IsOpen O) (hSO : Disjoint S O) := OldArcParityProof.oldArcEvenClosure (X - := X) O S hO hSO obtain ⟨leftArcPreconnected, rightArcPreconnected⟩ := P5667T1CyclicChildrenOldArcsPreconnected p D.a D.b C have leftFirstIndex : C.il 1 = D.a + 1 := OldArcParityProof.leftFirstIndex n p E D C @@ -2921,11 +2875,6 @@ theorem P3650T1OldArcEven {n : Nat} (p : P3381T1PolygonBoundary n) := a) (b := b) (c := c) hdet have prevIndexNe {m : Nat} (i : Fin (m + 3)) := OldArcParityProof.prevIndexNe (m := m) i have nextIndexNe {m : Nat} (i : Fin (m + 3)) := OldArcParityProof.nextIndexNe (m := m) i - have strictUpperHalfplaneEven {m : Nat} (q : P3381T1PolygonBoundary m) - (ell : (Real × Real) →ₗ[Real] Real) (H : Real) - (hbound : ∀ i, ell (q.vertex i) < H) - (x : Real × Real) (hx : H < ell x) := OldArcAssembly.strictUpperHalfplaneEven - upperHalfplaneEven (m := m) q ell H hbound x hx have nonincidentBall {m : Nat} (q : P3381T1PolygonBoundary m) (i : Fin (m + 3)) := OldArcParityProof.nonincidentBall (m := m) q i have rightPreviousParent {m : Nat} (q : P3381T1PolygonBoundary m) @@ -2966,7 +2915,6 @@ theorem P3650T1OldArcEven {n : Nat} (p : P3381T1PolygonBoundary n) have htriangle : p.vertex D.b ∈ convexHull Real (Set.range A) := by simpa [hrange, va, vb, vc] using hvertex have hcoord_nonneg := OldArcParityProof.hcoord_nonneg n p E D hind hspan htriangle - have hcoord_sum := OldArcParityProof.hcoord_sum n p E D hind hspan have hside0 (x : Real × Real) (hx : x ∈ convexHull Real (Set.range A)) (h0 : A.coord 0 x = 0) := OldArcParityProof.hside0 n p E hind hspan x hx h0 have hside2 (x : Real × Real) (hx : x ∈ convexHull Real (Set.range A)) diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1ParitySum.lean b/LeanPool/ApollonianSuperharmonic/P3650T1ParitySum.lean index 7d8ebc8351..86ab49b0bd 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1ParitySum.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1ParitySum.lean @@ -567,14 +567,8 @@ theorem P3650T1ParitySum {n : Nat} (p : P3381T1PolygonBoundary n) (x ∉ P3544T1RayParity C.left ∧ x ∈ P3544T1RayParity C.right)))) := by -- BODY classical - let hit (x d : Real × Real) (i j : Fin (n + 3)) : Prop := - ∃ t : Real, 0 < t ∧ x + t • d ∈ segment Real (p.vertex i) (p.vertex j) - let weight (x d : Real × Real) (i j : Fin (n + 3)) : Nat := - if hit x d i j then 1 else 0 have cardPred {k : Nat} (P : Fin k → Prop) [DecidablePred P] := PolygonParityProof.cardPred (k := k) P - let edges {A : Type} (l : List A) : List (A × A) := - List.zipWith Prod.mk l (l.rotate 1) have edges_cons {A : Type} (a : A) (l : List A) := PolygonParityProof.edges_cons (A := A) a l have path_split {A : Type} (a b z : A) (u v : List A) := PolygonParityProof.path_split (A := A) a b z u v @@ -586,8 +580,6 @@ theorem P3650T1ParitySum {n : Nat} (p : P3381T1PolygonBoundary n) l k have edges_ofFn {k : Nat} {A : Type} (f : Fin (k + 3) → A) := PolygonParityProof.edges_ofFn (k := k) (A := A) f - let edgeWeight (x d : Real × Real) (L : List (Fin (n + 3))) : Nat := - ((edges L).map fun e => weight x d e.1 e.2).sum have hsum_ofFn {k : Nat} (f : Fin (k + 3) → Fin (n + 3)) (x d : Real × Real) := PolygonParityProof.hsum_ofFn n p edges_ofFn (k := k) f x d have hweight_symm (x d : Real × Real) (i j : Fin (n + 3)) := PolygonParityProof.hweight_symm n diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean b/LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean index c00e3b37d8..7e4cc6c821 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1TriangleEntry.lean @@ -226,7 +226,6 @@ private theorem hreach : obtain ⟨m, hmI, hmmax⟩ := hIcompact.exists_isMaxOn ⟨t, htI⟩ continuous_id.continuousOn have htm : t ≤ m := hmmax htI - have hmpos : 0 < m := ht0.trans_le htm have hmheight : 0 < E.height (q m) := by have hhwle : E.height w ≤ E.height (q m) := by rw [← htq, hhq, hhq] diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean index e651964a71..d7602dfe01 100644 --- a/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean @@ -306,9 +306,6 @@ private theorem hleftcoord : have hx : x.val < S.u.length + 2 := by rw [← hlenL]; exact x.isLt have hpre : x.val < (S.a :: (S.u ++ [S.b])).length := by simp; omega have hfullVal : x.val < n + 3 := by omega - have hfull : x.val < (S.a :: (S.u ++ S.b :: S.v)).length := by - simp only [List.length_cons, List.length_append] - omega have hidx? : (List.ofFn S.il)[x.val]? = (S.a :: (S.u ++ [S.b]))[x.val]? := by exact congrArg (fun l : List (Fin (n + 3)) => l[x.val]?) S.left_order have hrotbound : x.val < ((List.ofFn (fun i : Fin (n + 3) => i)).rotate S.rotation).length @@ -681,7 +678,6 @@ private theorem hrightSucc : ℕ)) = (↑(S.ir y) : ℕ) ↔ (↑y : ℕ) = (↑x : ℕ) + (1 : ℕ)))))))) ) := by classical intro n p S hlenP hlenL hlenR hrightcoord hmodShift hmodSucc x y hx - have hoff : S.u.length + 1 + (S.rightParameter + 2) = n + 3 := by omega have hxCoord : (S.ir x).val = (S.rotation + (S.u.length + 1 + x.val)) % (n + 3) := by simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hrightcoord x @@ -691,9 +687,7 @@ private theorem hrightSucc : rw [hxCoord, hyCoord] let tx := S.u.length + 1 + x.val let ty := S.u.length + 1 + y.val - have htx : tx < n + 3 := by dsimp [tx]; omega have htyLe : ty ≤ n + 3 := by dsimp [ty]; omega - have htx1 : tx + 1 ≤ n + 3 := by dsimp [tx]; omega have hs := hmodSucc (m := n + 3) (by omega) (r := S.rotation) (x := tx) have hposMin : 2 ≤ tx := by dsimp [tx]; omega constructor @@ -1024,7 +1018,6 @@ private theorem hcrossNoAdj : rw [hx', hleftB] exact ⟨0, hrightB⟩ have hxlo : 1 ≤ x.val := by omega - have hxlt : x.val < S.u.length + 2 := by rw [← hlenL]; exact x.isLt have hxhi : x.val ≤ S.u.length := by omega have hy0 : y.val ≠ 0 := by intro hy @@ -1042,14 +1035,12 @@ private theorem hcrossNoAdj : rw [hy', hrightA] exact ⟨0, hleftA⟩ have hylo : 1 ≤ y.val := by omega - have hylt : y.val < S.v.length + 2 := by rw [← hlenR]; exact y.isLt have hyhi : y.val ≤ S.v.length := by omega have hxCoord : (S.il x).val = (S.rotation + x.val) % (n + 3) := by simpa only [Nat.add_comm] using hleftcoord x have hyCoord : (S.ir y).val = (S.rotation + (S.u.length + 1 + y.val)) % (n + 3) := by simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hrightcoord y - have hM : S.u.length + S.v.length + 2 = n + 3 := by omega have hoff : S.u.length + 1 + y.val < n + 3 := by omega have hsucc := hmodSucc (m := n + 3) (by omega) (r := S.rotation) (x := x.val) intro h @@ -2272,10 +2263,6 @@ theorem P3652T1IndexedFaceLedger {n : Nat} {p : P3381T1PolygonBoundary n} hlenR hleftcoord hmodShift hmodSucc hparentSuccVal x y have hdiagPair (i j : Fin (n + 3)) (hij : i ≠ j) := IndexedFaceLedgerProof.hdiagPair n p S hleftA hleftB hrightB hrightA i j hij - have hleftZero (i j : Fin (n + 3)) - (hi : i ∉ Set.range S.il) := IndexedFaceLedgerProof.hleftZero n p S XL L i j hi - have hrightZero (i j : Fin (n + 3)) - (hi : i ∉ Set.range S.ir) := IndexedFaceLedgerProof.hrightZero n p S XR R i j hi have husedSplit (i j : Fin (n + 3)) := IndexedFaceLedgerProof.husedSplit n p S XL XR L R i j have hleftCountMapped (i j : Fin (n + 3)) (hi : i ∈ Set.range S.il) (hj : j ∈ Set.range S.il) (hij : i ≠ j) := diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean index db5bef3a7a..55bcb03312 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean @@ -1614,9 +1614,6 @@ private theorem compact_cells_finite : by_cases hne : K.Nonempty · obtain ⟨p₀, hp₀⟩ := hne obtain ⟨C, hC⟩ := Metric.isBounded_iff.mp hK.isBounded - have hCpos : 0 ≤ C := by - have := hC hp₀ hp₀ - simpa using this let B := max (abs p₀.1) (abs p₀.2) + C + 2 obtain ⟨N, hN⟩ := exists_nat_gt (B + 1) let box : Set (Int × Int) := @@ -2468,13 +2465,6 @@ private theorem hpoly : have hhi' : (s : Real) ≤ tm ⟨i.val + 1, by omega⟩ := by rw [← hsucc] exact hhi - have hcurIndex : (⟨n - r, by omega⟩ : Fin (n + 1)) = k.succ := by - apply Fin.ext - dsimp [k] - omega - have hnextIndex : (⟨n - r - 1, by omega⟩ : Fin (n + 1)) = k.castSucc := by - apply Fin.ext - dsimp [k] have hendIndex : (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = ⟨m + 1 + r, by omega⟩ := (show (⟨i.val + 1, by omega⟩ : Fin (m + n + 1)) = ⟨m + 1 + r, by omega⟩ @@ -2744,17 +2734,9 @@ private theorem drawingCertificate : D.position '' (({x, y} : Set ι) ∩ {u, v}) := ContactDrawingGeometry.half_subset ι P D localStar rep_spec pulled_contact gintersections half_disjoint x y u v hxy huv hxyuv - have hstart (x y : ι) (hxy : P3723T1EdgeContact P x y) : - D.position x ∈ edgeArc x y := ContactDrawingGeometry.hstartAt1216 ι P D symmetric - localStar rep_spec pulled_contact gproperties x y hxy have hend (x y : ι) (hxy : P3723T1EdgeContact P x y) : D.position y ∈ edgeArc x y := ContactDrawingGeometry.hendAt1222 ι P D symmetric localStar rep_spec pulled_contact gproperties x y hxy - have vertex_mem (x y i : ι) (hxy : P3723T1EdgeContact P x y) - (hi : i = x ∨ i = y) := ContactDrawingGeometry.vertex_mem ι P D localStar rep_spec - pulled_contact hstart hend x y i hxy hi - have hfull : edgeArc a b = halfArc a b ∪ halfArc b a := rfl - have hfull' : edgeArc c d = halfArc c d ∪ halfArc d c := rfl simp only [edgeArc, halfArc, ite_eq_left hab, ite_eq_left hba, ite_eq_left hcd, ite_eq_left hdc] ext z diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean index 129308980f..a04eba921a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1ContactPortsExist.lean @@ -1392,8 +1392,6 @@ theorem P3723T1ContactPortsExist {ι : Type} (P : PeriodicTileComplex ι) : · have hn : ¬ P3723T1EdgeContact P (P.shift u a) (P.shift u b) := fun h => hab ((contact_periodic u a b).mp h) simp only [edge, ite_eq_right hab, ite_eq_right hn, Finset.image_empty] - let port (a b : ι) : Option (Real × Real) := - if P3723T1EdgeContact P a b then some (midpoint (edge a b)) else none have port_present := ContactPortGeometry.port_present ι P edge have midpoint_periodic (e : Finset GaussianInt) (u : GaussianInt) (he : e.card = 2) : midpoint (e.image (fun z => z + u)) = midpoint e + GaussianRealPoint u := diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1PairedModelSegmentPullback.lean b/LeanPool/ApollonianSuperharmonic/P3723T1PairedModelSegmentPullback.lean index a9cb5ade46..753e876501 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1PairedModelSegmentPullback.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1PairedModelSegmentPullback.lean @@ -51,8 +51,6 @@ private theorem hgconst : have hline : (1 - (s : Real)) • (b : Real × Real) + (s : Real) • (b : Real × Real) = b := by ext <;> simp [smul_eq_mul] <;> ring - have hzero : (1 - (0 : Real)) • (b : Real × Real) + - (0 : Real) • (b : Real × Real) = b := by simp exact (hs.trans hline).trans (h0.trans (by simp)).symm private theorem hFbounds : @@ -293,38 +291,6 @@ private theorem piece : obtain ⟨w1, hw1sum, hw1nonneg, hw1target⟩ := target_weights k (L v) hvE let x0 : Real × Real := ∑ j, w0 j • p.vertex (t.face k j) let x1 : Real × Real := ∑ j, w1 j • p.vertex (t.face k j) - have hx0src : x0 ∈ convexHull Real (Set.range (p.vertex ∘ t.face k)) := by - exact source_hull k w0 hw0sum hw0nonneg - have hx1src : x1 ∈ convexHull Real (Set.range (p.vertex ∘ t.face k)) := by - exact source_hull k w1 hw1sum hw1nonneg - have hx0X : x0 ∈ X := by - rw [t.source_cover] - exact Set.mem_iUnion.mpr ⟨k, hx0src⟩ - have hx1X : x1 ∈ X := by - rw [t.source_cover] - exact Set.mem_iUnion.mpr ⟨k, hx1src⟩ - let z0 : X := ⟨x0, hx0X⟩ - let z1 : X := ⟨x1, hx1X⟩ - have hz0map : (h z0 : Real × Real) = L u := by - calc - (h z0 : Real × Real) = ∑ j, w0 j • t.target (t.face k j) := - haffine k z0 hx0src w0 hw0sum rfl - _ = L u := hw0target.symm - have hz1map : (h z1 : Real × Real) = L v := by - calc - (h z1 : Real × Real) = ∑ j, w1 j • t.target (t.face k j) := - haffine k z1 hx1src w1 hw1sum rfl - _ = L v := hw1target.symm - let su : Set.Icc (0 : Real) 1 := ⟨u, huI'.1⟩ - let sv : Set.Icc (0 : Real) 1 := ⟨v, hvI'.1⟩ - have hg0 : g su = z0 := by - apply h.injective - apply Subtype.ext - rw [hg su, ← hL u, hz0map] - have hg1 : g sv = z1 := by - apply h.injective - apply Subtype.ext - rw [hg sv, ← hL v, hz1map] let B : Real × Real := (v - u)⁻¹ • (x1 - x0) let A : Real × Real := x0 - u • B refine ⟨A, B, ?_⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean b/LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean index 54090ebb63..6dc3953a90 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean @@ -471,8 +471,6 @@ private theorem hJexp (f : ℝ × ℝ → ℝ × ℝ) (hf : Continuous f) (M : change (∀ t, Complex.exp (J t) = 1) intro t have hFval := hF ⟨c t, hcin t⟩ - have hA := hAform t - have hEcomplex : E t = Complex.exp ((θ t : ℂ) * Complex.I) := rfl have hfac : (R : ℂ) * E t * A t = pc (f (c t)) - pc y := by dsimp [A] have hden : (R : ℂ) * E t ≠ 0 := mul_ne_zero (by exact_mod_cast hRpos.ne') (hEne t) diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean b/LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean index 226e34d5b0..4fe99fecdc 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean @@ -823,8 +823,6 @@ theorem P3776T1DualEdgesExist {ι : Type} (P : PeriodicTileCore ι) : P u f a ha have faceShift_cancel (u : P.lattice) (f : P.plane.Face) : P.faceShift u (P.faceShift (-u) f) = f := DualEdgeDetails.faceShift_cancel ι P u f - have faceShift_cancel' (u : P.lattice) (f : P.plane.Face) : - P.faceShift (-u) (P.faceShift u f) = f := DualEdgeDetails.faceShift_cancel' ι P u f have walk_translate (p : List GaussianInt) (hp : p ≠ []) (u : P.lattice) (t : Set.Icc (0 : Real) 1) : P3776T1WalkMap (p.map (fun z => z + (u : GaussianInt))) t = diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1PlaneMapExists.lean b/LeanPool/ApollonianSuperharmonic/P3776T1PlaneMapExists.lean index ee29df3658..b72aad3fb2 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1PlaneMapExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1PlaneMapExists.lean @@ -265,9 +265,6 @@ private theorem hAgree : have hab : a ≠ b := by intro he exact hij (P.plane.face_vertices_distinct g he) - have hcd : c ≠ d := by - intro he - exact hkl (P.plane.face_vertices_distinct h he) have hadj := P.plane.face_edges g i j hij by_cases hsame : ({a, b} : Set ι) = {c, d} · have ha : a = c ∨ a = d := by diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean b/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean index 302f5f1b60..08f97ca0fa 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean @@ -1102,14 +1102,10 @@ private theorem sectorTopPositive : classical intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrderedSum s o hs - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 have hsum := sectorOrderedSum s (sectorI o) (sectorJ o) (sectorK o) o.2.1 o.2.2.1 o.2.2.2 have hj : s.1 (sectorJ o) ≤ s.1 (sectorI o) := hs.1 have hk : s.1 (sectorK o) ≤ s.1 (sectorJ o) := hs.2 - have hj0 := hc.1 (sectorJ o) - have hk0 := hc.1 (sectorK o) linarith private theorem sectorChosenCone_periodic : @@ -1650,7 +1646,6 @@ theorem P3776T1SectorMapsExist {ι : Type} (P : PeriodicTileCore ι) classical let SectorInterval := Set.Icc (0 : ℝ) 1 let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} - let sectorCollapse := P3832T1ConeCollapse have sectorCollapse_surjective := SectorMapsProof.sectorCollapse_surjective have sectorConeDescent (g : C(SectorInterval × SectorInterval, ℝ × ℝ)) (c : ℝ × ℝ) (hzero : ∀ t : SectorInterval, g (⟨0, by norm_num [SectorInterval]⟩, t) = c) := @@ -1671,7 +1666,6 @@ theorem P3776T1SectorMapsExist {ι : Type} (P : PeriodicTileCore ι) let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2 let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) have sectorOrderExists := SectorMapsProof.sectorOrderExists - have sectorChamber_closed := SectorMapsProof.sectorChamber_closed have sectorOrder_cover := SectorMapsProof.sectorOrder_cover sectorOrderExists have sectorIndexCover (o : SectorOrder) (n : Fin 3) := SectorMapsProof.sectorIndexCover o n have sectorOrderedSum (s : SectorSimplex) (i j k : Fin 3) diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1StarWeightsExist.lean b/LeanPool/ApollonianSuperharmonic/P3776T1StarWeightsExist.lean index 1d4a0870ba..3695de0f61 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1StarWeightsExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1StarWeightsExist.lean @@ -85,7 +85,6 @@ private theorem hstarFace : have hdis := (P3767T1FixedFaceComponents P.plane).1 f |>.1 exact fun h => (Set.disjoint_left.mp hdis) (Or.inl ⟨a, rfl⟩) h have hfr : P.plane.position a ∈ frontier (P.plane.faceRegion f) := by - have hopen := P.plane.region_open f have hcl : P.plane.position a ∈ closure (P.plane.faceRegion f) := hxf rw [frontier, (P.plane.region_open f).interior_eq] exact ⟨hcl, hnotreg⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean b/LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean index 8a88ed5653..346512ed1f 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1WalkMapProperties.lean @@ -454,7 +454,6 @@ private theorem walk_reverse : let j := n - 1 - k have hj : j + k + 1 = n := by dsimp [j]; omega have hjlt : j < n := by dsimp [j]; omega - have hnR : (0 : Real) < n := by exact_mod_cast hn have hncast : (n : Real) = (p.length : Real) - 1 := by dsimp [n] rw [Nat.cast_sub (by omega : 1 ≤ p.length)] @@ -724,14 +723,6 @@ private theorem walk_contained : exact List.getD_eq_getElem (l := p) (d := 0) hk0 have hgetB : b = p[k + 1] := by exact List.getD_eq_getElem (l := p) (d := 0) hk1 - have haV : a ∈ FootprintVertices T := by - apply hv a - rw [hgetA] - exact List.getElem_mem hk0 - have hbV : b ∈ FootprintVertices T := by - apply hv b - rw [hgetB] - exact List.getElem_mem hk1 have hdrop0 : p.drop k = a :: p.drop (k + 1) := by calc p.drop k = p[k] :: p.drop (k + 1) := (List.cons_getElem_drop_succ (h := hk0)).symm diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean b/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean index 4564caa861..88e4e0e2f7 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean @@ -80,7 +80,6 @@ private theorem boundedComponent : rw [Metric.isBounded_iff_subset_closedBall (0 : ℂ)] refine ⟨R, ?_⟩ intro v hv - have hvT : v ∈ T := connectedComponentIn_subset T w hv by_contra hvball have hvU : v ∈ U := by change R < ‖v‖ @@ -136,8 +135,6 @@ private theorem hcomp_push : connectedComponentIn T ((h : ℝ × ℝ → ℂ) v)) := by classical intro e h₀ h ec K T S hImageS u v hu hv hcmp - have huT : h u ∈ T := by rw [← hImageS]; exact Set.mem_image_of_mem h hu - have hvT : h v ∈ T := by rw [← hImageS]; exact Set.mem_image_of_mem h hv have hmem : v ∈ connectedComponentIn S u := by rw [hcmp]; exact mem_connectedComponentIn hv have himage := h.continuous.continuousOn.image_connectedComponentIn_subset (s := S) (a := u) hu @@ -290,10 +287,6 @@ private theorem impossible_pair : P3821T1LoopIndex (j.comp (alphaOf (k i) (hkN i))) 0 * P3821T1LoopIndex ec q := index_relation (k i) (hkN i) q hq hqMargin (fun t => (hkAvoid i t).1) - have hBrelP (i : Fin m) : P3821T1LoopIndex (k i) p = - P3821T1LoopIndex (j.comp (alphaOf (k i) (hkN i))) 0 * - P3821T1LoopIndex ec p := - index_relation (k i) (hkN i) p hp hpMargin (fun t => (hkAvoid i t).2) let dk : Fin m → ℝ := fun i => P3821T1LoopIndex (j.comp (alphaOf (k i) (hkN i))) 0 let B : ℝ := ∑ i, dk i @@ -305,20 +298,9 @@ private theorem impossible_pair : _ = B * P3821T1LoopIndex ec q := by dsimp [B] rw [Finset.sum_mul] - have hrowkp : (∑ i, P3821T1LoopIndex (k i) p) = B * - P3821T1LoopIndex ec p := by - calc - _ = ∑ i, dk i * P3821T1LoopIndex ec p := - Finset.sum_congr rfl (fun i _ => hBrelP i) - _ = B * P3821T1LoopIndex ec p := by - dsimp [B] - rw [Finset.sum_mul] have hBq : B * P3821T1LoopIndex ec q = 1 := by rw [← hrowkq] exact hkq - have hBp : B * P3821T1LoopIndex ec p = 0 := by - rw [← hrowkp] - exact hkp have hbzero : P3821T1LoopIndex ec q = 0 := (mul_eq_zero.mp hAzero).resolve_left hAne rw [hbzero] at hBq @@ -423,19 +405,12 @@ theorem P3821T1CircleComponentBound (e : C(Circle, Real × Real)) (hcmp : connectedComponentIn T (h u) = connectedComponentIn T (h v)) : connectedComponentIn S u = connectedComponentIn S v := CircleComponentProof.hcomp_pull e hImageS hSymmImageT u v hu hv hcmp - have hcomp_push (u v : Real × Real) (hu : u ∈ S) (hv : v ∈ S) - (hcmp : connectedComponentIn S u = connectedComponentIn S v) : - connectedComponentIn T (h u) = connectedComponentIn T (h v) := - CircleComponentProof.hcomp_push e hImageS u v hu hv hcmp have hxS : x ∈ S := hx have hyS : y ∈ S := hy have hzS : z ∈ S := hz have hxT : h x ∈ T := by rw [← hImageS]; exact Set.mem_image_of_mem h hxS have hyT : h y ∈ T := by rw [← hImageS]; exact Set.mem_image_of_mem h hyS have hzT : h z ∈ T := by rw [← hImageS]; exact Set.mem_image_of_mem h hzS - have final_of (u v : Real × Real) (hu : u ∈ S) (hv : v ∈ S) - (hcmp : connectedComponentIn T (h u) = connectedComponentIn T (h v)) : - connectedComponentIn S u = connectedComponentIn S v := hcomp_pull u v hu hv hcmp have hKne : K.Nonempty := ⟨ec 1, ⟨1, rfl⟩⟩ have impossible_pair (p q : ℂ) (hp : p ∈ T) (hq : q ∈ T) (hne : connectedComponentIn T p ≠ connectedComponentIn T q) diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean index 976d504c2c..3b7a802d04 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean @@ -811,7 +811,6 @@ private theorem hpcenter_comp : intro K p η εp hballp εq h h2p s t o up hpclose segment_ball have hpath : Set.range (Path.segment p ((h : ℂ) * GridCellCenter up + o)) ⊆ Kᶜ := by rintro z ⟨v, rfl⟩ - have hreal : (v : ℝ) ∈ Set.Icc 0 1 := v.2 apply hballp apply Metric.mem_ball.mpr rw [dist_eq_norm] @@ -834,7 +833,6 @@ private theorem hqcenter_comp : intro K q η εp εq hballq h h2q s t o uq hqclose segment_ball have hpath : Set.range (Path.segment q ((h : ℂ) * GridCellCenter uq + o)) ⊆ Kᶜ := by rintro z ⟨v, rfl⟩ - have hreal : (v : ℝ) ∈ Set.Icc 0 1 := v.2 apply hballq apply Metric.mem_ball.mpr rw [dist_eq_norm] @@ -1588,10 +1586,6 @@ theorem P3821T1ComponentContours (K N : Set ℂ) (hK : IsCompact K) have dart_adjacent (u : GaussianInt) (k : Fin 4) : FourNeighborAdjacent (corner u k) (corner u (k + 1)) := ComponentContourDetails.dart_adjacent u k - let rayStep (r a b : GaussianInt) : ℤ := - if b = a + ⟨0, 1⟩ ∧ a.im = r.im ∧ a.re ≤ r.re then 1 - else if b = a - ⟨0, 1⟩ ∧ b.im = r.im ∧ a.re ≤ r.re then -1 - else 0 let box (u : GaussianInt) (z : ℂ) : Prop := (u.re : ℝ) ≤ z.re ∧ z.re ≤ (u.re : ℝ) + 1 ∧ (u.im : ℝ) ≤ z.im ∧ z.im ≤ (u.im : ℝ) + 1 @@ -1621,7 +1615,6 @@ theorem P3821T1ComponentContours (K N : Set ℂ) (hK : IsCompact K) (h : ℝ) (hh : 0 < h) (o : ℂ) : {u : GaussianInt | (h : ℂ) * GridCellCenter u + o ∈ U}.Finite := ComponentContoursProof.finite_centers center_re center_im U hU h hh o - have hKne : K.Nonempty := ComponentContourDetails.hKne K p q hne let V := N ∩ ({p, q} : Set ℂ)ᶜ have hV : IsOpen V := hN.inter (isClosed_singleton.union isClosed_singleton).isOpen_compl diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean index 14805d8f51..eea5d5899b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean @@ -122,7 +122,6 @@ private theorem hu (e : C(Circle, ℂ)) (he : Function.Injective e) : Continuous exact congrArg Subtype.val h · rintro ⟨z, x, rfl⟩ exact ⟨x, rfl⟩) - have hf : Continuous f := hf e he let ψ : Set.range e → Circle := f.symm have hψc : Continuous ψ := hψc e he let u : Set.range e → ℂ := fun k => (ψ k : ℂ) @@ -169,9 +168,7 @@ private theorem hψUC (e : C(Circle, ℂ)) (he : Function.Injective e) : Uniform exact congrArg Subtype.val h · rintro ⟨z, x, rfl⟩ exact ⟨x, rfl⟩) - have hf : Continuous f := hf e he let ψ : Set.range e → Circle := f.symm - have hψc : Continuous ψ := hψc e he let u : Set.range e → ℂ := fun k => (ψ k : ℂ) have hu : Continuous u := hu e he change (UniformContinuous u) @@ -314,7 +311,6 @@ private theorem hNopen (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range let F : Finset (Set.range e) := hSf.toFinset let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z - have hw_cont (c : Set.range e) : Continuous (w c) := hw_cont e eps η c have hW_cont : Continuous W := hW_cont e eps S η hSf let N : Set ℂ := {z | 0 < W z} dsimp only [ControlledNeighborhoodConstruction.N] at * @@ -328,7 +324,6 @@ private theorem hKN (e : C(Circle, ℂ)) (eps : ℝ) (heps : 0 < eps) (S : Set let r := min (η / 8) (eps / 8) have hrpos : 0 < r := hrpos eps heps η hη let F : Finset (Set.range e) := hSf.toFinset - have hFS : (F : Set (Set.range e)) = S := hFS e S hSf have hcover' : (Set.univ : Set (Set.range e)) ⊆ ⋃ c ∈ (F : Set (Set.range e)), Metric.ball c r := hcover' e eps S η hSf hcover let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) @@ -360,7 +355,6 @@ private theorem hW_N (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑ let F : Finset (Set.range e) := hSf.toFinset let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z - have hw_cont (c : Set.range e) : Continuous (w c) := hw_cont e eps η c have hW_cont : Continuous W := hW_cont e eps S η hSf let N : Set ℂ := {z | 0 < W z} dsimp only [ControlledNeighborhoodConstruction.N] at * @@ -388,7 +382,6 @@ private theorem ha_cont (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z have hw_cont (c : Set.range e) : Continuous (w c) := hw_cont e eps η c - have hW_cont : Continuous W := hW_cont e eps S η hSf let N : Set ℂ := {z | 0 < W z} have hW_N : Continuous (fun z : N => W (z : ℂ)) := hW_N e eps S η hSf let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) @@ -437,10 +430,7 @@ private theorem hv_cont (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : let F : Finset (Set.range e) := hSf.toFinset let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z - have hw_cont (c : Set.range e) : Continuous (w c) := hw_cont e eps η c - have hW_cont : Continuous W := hW_cont e eps S η hSf let N : Set ℂ := {z | 0 < W z} - have hW_N : Continuous (fun z : N => W (z : ℂ)) := hW_N e eps S η hSf let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) have ha_cont (c : Set.range e) : Continuous (fun z : N => a z c) := ha_cont e eps S η hSf c let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c @@ -458,14 +448,12 @@ private theorem hactive (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range let F : Finset (Set.range e) := hSf.toFinset let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z - let N : Set ℂ := {z | 0 < W z} dsimp only [ControlledNeighborhoodConstruction.N] at * change (∃ i ∈ F, 0 < w i (z : ℂ)) by_contra h push Not at h have hsum : (∑ c ∈ F, w c (z : ℂ)) ≤ 0 := Finset.sum_nonpos (fun c hc => h c hc) - have hWle : W (z : ℂ) ≤ 0 := by simpa [W] using hsum have hz : 0 < W (z : ℂ) := z.property linarith @@ -474,10 +462,6 @@ private theorem hw_active_dist (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set dist (z : ℂ) (c : ℂ) < 2 * (r eps η) := by classical let r := min (η / 8) (eps / 8) - let F : Finset (Set.range e) := hSf.toFinset - let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) - let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z - let N : Set ℂ := {z | 0 < W z} dsimp only [ControlledNeighborhoodConstruction.N] at * change (dist (z : ℂ) (c : ℂ) < 2 * r) change 0 < max 0 (2 * r - dist (z : ℂ) (c : ℂ)) at hc @@ -550,7 +534,6 @@ private theorem hv_close (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : let δ := min (δ₀ / 4) (1 / 8) have hδpos : 0 < δ := hδpos δ₀ hδ₀ let r := min (η / 8) (eps / 8) - have hrpos : 0 < r := hrpos eps heps η hη have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ let F : Finset (Set.range e) := hSf.toFinset @@ -664,11 +647,7 @@ private theorem hv_lower (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) let δ := min (δ₀ / 4) (1 / 8) - have hδpos : 0 < δ := hδpos δ₀ hδ₀ let r := min (η / 8) (eps / 8) - have hrpos : 0 < r := hrpos eps heps η hη - have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → - dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ let F : Finset (Set.range e) := hSf.toFinset let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z @@ -676,10 +655,6 @@ private theorem hv_lower (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z - have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : - dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc - have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c - have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z i hi hwi @@ -716,27 +691,14 @@ private theorem hv_pos (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : have hδpos : 0 < δ := hδpos δ₀ hδ₀ have hδlt : δ < 1 / 4 := hδlt δ₀ hδ₀ let r := min (η / 8) (eps / 8) - have hrpos : 0 < r := hrpos eps heps η hη - have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → - dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ let F : Finset (Set.range e) := hSf.toFinset let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z let N : Set ℂ := {z | 0 < W z} let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c - have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z - have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : - dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc - have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c - have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z - have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) - (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z - i hi hwi - have hunit (c : Set.range e) : ‖u c‖ = 1 := hunit e he c have hv_lower (z : N) : 1 - δ < ‖v z‖ := hv_lower e he eps heps S δ₀ η hSf hη hδ₀ hηψ z change (0 < ‖v z‖) - have hδbound : δ < 1 := by linarith [hδlt] linarith [hv_lower z] private noncomputable abbrev p (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (S : Set @@ -778,29 +740,13 @@ private theorem hp_norm (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : exact ⟨x, rfl⟩) let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) - let δ := min (δ₀ / 4) (1 / 8) - have hδpos : 0 < δ := hδpos δ₀ hδ₀ - have hδlt : δ < 1 / 4 := hδlt δ₀ hδ₀ let r := min (η / 8) (eps / 8) - have hrpos : 0 < r := hrpos eps heps η hη - have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → - dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ let F : Finset (Set.range e) := hSf.toFinset let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z let N : Set ℂ := {z | 0 < W z} let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c - have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z - have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : - dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc - have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c - have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z - have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) - (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z - i hi hwi - have hunit (c : Set.range e) : ‖u c‖ = 1 := hunit e he c - have hv_lower (z : N) : 1 - δ < ‖v z‖ := hv_lower e he eps heps S δ₀ η hSf hη hδ₀ hηψ z have hv_pos (z : N) : 0 < ‖v z‖ := hv_pos e he eps heps S δ₀ η hSf hη hδ₀ hηψ z let p : N → ℂ := fun z => v z / (‖v z‖ : ℂ) change (‖p z‖ = 1) @@ -872,34 +818,14 @@ private theorem hp_cont (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : exact ⟨x, rfl⟩) let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) - let δ := min (δ₀ / 4) (1 / 8) - have hδpos : 0 < δ := hδpos δ₀ hδ₀ - have hδlt : δ < 1 / 4 := hδlt δ₀ hδ₀ let r := min (η / 8) (eps / 8) - have hrpos : 0 < r := hrpos eps heps η hη - have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → - dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ let F : Finset (Set.range e) := hSf.toFinset let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z - have hw_cont (c : Set.range e) : Continuous (w c) := hw_cont e eps η c - have hW_cont : Continuous W := hW_cont e eps S η hSf let N : Set ℂ := {z | 0 < W z} - have hW_N : Continuous (fun z : N => W (z : ℂ)) := hW_N e eps S η hSf let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) - have ha_cont (c : Set.range e) : Continuous (fun z : N => a z c) := ha_cont e eps S η hSf c let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c have hv_cont : Continuous v := hv_cont e he eps S η hSf - have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z - have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : - dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc - have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c - have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z - have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) - (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z - i hi hwi - have hunit (c : Set.range e) : ‖u c‖ = 1 := hunit e he c - have hv_lower (z : N) : 1 - δ < ‖v z‖ := hv_lower e he eps heps S δ₀ η hSf hη hδ₀ hηψ z have hv_pos (z : N) : 0 < ‖v z‖ := hv_pos e he eps heps S δ₀ η hSf hη hδ₀ hηψ z let p : N → ℂ := fun z => v z / (‖v z‖ : ℂ) change (Continuous p) @@ -924,35 +850,13 @@ private theorem hphiVal_cont (e : C(Circle, ℂ)) (he : Function.Injective e) (e exact ⟨x, rfl⟩) let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) - let δ := min (δ₀ / 4) (1 / 8) - have hδpos : 0 < δ := hδpos δ₀ hδ₀ - have hδlt : δ < 1 / 4 := hδlt δ₀ hδ₀ let r := min (η / 8) (eps / 8) - have hrpos : 0 < r := hrpos eps heps η hη - have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → - dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ let F : Finset (Set.range e) := hSf.toFinset let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z - have hw_cont (c : Set.range e) : Continuous (w c) := hw_cont e eps η c - have hW_cont : Continuous W := hW_cont e eps S η hSf let N : Set ℂ := {z | 0 < W z} - have hW_N : Continuous (fun z : N => W (z : ℂ)) := hW_N e eps S η hSf let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) - have ha_cont (c : Set.range e) : Continuous (fun z : N => a z c) := ha_cont e eps S η hSf c let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c - have hv_cont : Continuous v := hv_cont e he eps S η hSf - have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z - have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : - dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc - have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c - have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z - have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) - (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z - i hi hwi - have hunit (c : Set.range e) : ‖u c‖ = 1 := hunit e he c - have hv_lower (z : N) : 1 - δ < ‖v z‖ := hv_lower e he eps heps S δ₀ η hSf hη hδ₀ hηψ z - have hv_pos (z : N) : 0 < ‖v z‖ := hv_pos e he eps heps S δ₀ η hSf hη hδ₀ hηψ z let p : N → ℂ := fun z => v z / (‖v z‖ : ℂ) have hp_norm (z : N) : ‖p z‖ = 1 := hp_norm e he eps heps S δ₀ η hSf hη hδ₀ hηψ z let phiVal : N → Circle := fun z => ⟨p z, (mem_sphere_zero_iff_norm).2 (hp_norm z)⟩ @@ -997,28 +901,17 @@ private theorem hphi_near (e : C(Circle, ℂ)) (he : Function.Injective e) (eps let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) let δ := min (δ₀ / 4) (1 / 8) - have hδpos : 0 < δ := hδpos δ₀ hδ₀ - have hδlt : δ < 1 / 4 := hδlt δ₀ hδ₀ let r := min (η / 8) (eps / 8) - have hrpos : 0 < r := hrpos eps heps η hη - have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → - dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ let F : Finset (Set.range e) := hSf.toFinset let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z let N : Set ℂ := {z | 0 < W z} let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c - have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z - have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : - dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc - have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c - have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z i hi hwi have hunit (c : Set.range e) : ‖u c‖ = 1 := hunit e he c - have hv_lower (z : N) : 1 - δ < ‖v z‖ := hv_lower e he eps heps S δ₀ η hSf hη hδ₀ hηψ z have hv_pos (z : N) : 0 < ‖v z‖ := hv_pos e he eps heps S δ₀ η hSf hη hδ₀ hηψ z let p : N → ℂ := fun z => v z / (‖v z‖ : ℂ) have norm_normalize (x : ℂ) (hx : 0 < ‖x‖) : @@ -1038,8 +931,6 @@ private theorem hphi_near (e : C(Circle, ℂ)) (he : Function.Injective e) (eps calc ‖p z - u i‖ = ‖(p z - v z) + (v z - u i)‖ := by congr 1; abel _ ≤ ‖p z - v z‖ + ‖v z - u i‖ := norm_add_le _ _ - have hshift' : ‖p z - v z‖ = |1 - ‖v z‖| := by - simpa [p] using hshift linarith private theorem hphi_circle_close (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps @@ -1060,34 +951,16 @@ private theorem hphi_circle_close (e : C(Circle, ℂ)) (he : Function.Injective let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) let δ := min (δ₀ / 4) (1 / 8) - have hδpos : 0 < δ := hδpos δ₀ hδ₀ - have hδlt : δ < 1 / 4 := hδlt δ₀ hδ₀ let r := min (η / 8) (eps / 8) - have hrpos : 0 < r := hrpos eps heps η hη - have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → - dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ let F : Finset (Set.range e) := hSf.toFinset let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z let N : Set ℂ := {z | 0 < W z} let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c - have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z - have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : - dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc - have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c - have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z - have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) - (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z - i hi hwi - have hunit (c : Set.range e) : ‖u c‖ = 1 := hunit e he c - have hv_lower (z : N) : 1 - δ < ‖v z‖ := hv_lower e he eps heps S δ₀ η hSf hη hδ₀ hηψ z - have hv_pos (z : N) : 0 < ‖v z‖ := hv_pos e he eps heps S δ₀ η hSf hη hδ₀ hηψ z let p : N → ℂ := fun z => v z / (‖v z‖ : ℂ) have hp_norm (z : N) : ‖p z‖ = 1 := hp_norm e he eps heps S δ₀ η hSf hη hδ₀ hηψ z let phiVal : N → Circle := fun z => ⟨p z, (mem_sphere_zero_iff_norm).2 (hp_norm z)⟩ - have norm_normalize (x : ℂ) (hx : 0 < ‖x‖) : - ‖x / (‖x‖ : ℂ) - x‖ = |1 - ‖x‖| := norm_normalize x hx have hphi_near (z : N) : ∀ i ∈ F, 0 < w i (z : ℂ) → ‖p z - u i‖ < 2 * δ := hphi_near e he eps heps S δ₀ η hSf hη hδ₀ hηψ z dsimp only [ControlledNeighborhoodConstruction.N] at * @@ -1118,18 +991,12 @@ theorem P3821T1ControlledNeighborhood (e : C(Circle, ℂ)) · rintro ⟨z, x, rfl⟩ exact ⟨x, rfl⟩) let : T2Space (Set.range e) := inferInstance - have hf : Continuous f := ControlledNeighborhoodConstruction.hf e he let ψ : Set.range e → Circle := f.symm - have hψc : Continuous ψ := ControlledNeighborhoodConstruction.hψc e he - have hψleft : Function.LeftInverse ψ (fun x : Circle => ⟨e x, ⟨x, rfl⟩⟩) := - ControlledNeighborhoodConstruction.hψleft e he let u : Set.range e → ℂ := fun k => (ψ k : ℂ) - have hu : Continuous u := ControlledNeighborhoodConstruction.hu e he have heUC : UniformContinuous e := ControlledNeighborhoodConstruction.heUC e obtain ⟨δ₀, hδ₀, hδ⟩ := Metric.uniformContinuous_iff.mp heUC (eps / 2) (half_pos heps) let δ := min (δ₀ / 4) (1 / 8) have hδpos : 0 < δ := ControlledNeighborhoodConstruction.hδpos δ₀ hδ₀ - have hδlt : δ < 1 / 4 := ControlledNeighborhoodConstruction.hδlt δ₀ hδ₀ have hKcompact : IsCompact (Set.range e) := ControlledNeighborhoodConstruction.hKcompact e let : CompactSpace (Set.range e) := isCompact_iff_compactSpace.mp hKcompact have hψUC : UniformContinuous u := ControlledNeighborhoodConstruction.hψUC e he @@ -1139,67 +1006,31 @@ theorem P3821T1ControlledNeighborhood (e : C(Circle, ℂ)) have hrerr : 2 * r < eps / 2 := ControlledNeighborhoodConstruction.hrerr eps heps η hη have heclose : ∀ u v : Circle, dist u v < 2 * δ → dist (e u) (e v) < eps / 2 := ControlledNeighborhoodConstruction.heclose e eps δ₀ hδ hδ₀ - have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → - dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := - ControlledNeighborhoodConstruction.hψclose e he eps heps δ₀ η hη hηψ have hKcompact' : IsCompact (Set.range e) := ControlledNeighborhoodConstruction.hKcompact e let : CompactSpace (Set.range e) := isCompact_iff_compactSpace.mp hKcompact' obtain ⟨S, hSsub, hSf, hcover⟩ := (isCompact_univ : IsCompact (Set.univ : Set (Set.range e))).finite_cover_balls (X := Set.range e) hrpos let F : Finset (Set.range e) := hSf.toFinset - have hFS : (F : Set (Set.range e)) = S := ControlledNeighborhoodConstruction.hFS e S hSf - have hFsub : (F : Set (Set.range e)) ⊆ Set.univ := ControlledNeighborhoodConstruction.hFsub e S - hSf - have hcover' : (Set.univ : Set (Set.range e)) ⊆ - ⋃ c ∈ (F : Set (Set.range e)), Metric.ball c r := - ControlledNeighborhoodConstruction.hcover' e eps S η hSf hcover let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z - have hw_cont (c : Set.range e) : Continuous (w c) := ControlledNeighborhoodConstruction.hw_cont - e eps η c - have hW_cont : Continuous W := ControlledNeighborhoodConstruction.hW_cont e eps S η hSf let N : Set ℂ := {z | 0 < W z} have hNopen : IsOpen N := ControlledNeighborhoodConstruction.hNopen e eps S η hSf have hKN : Set.range e ⊆ N := ControlledNeighborhoodConstruction.hKN e eps heps S η hSf hcover hη - have hW_N : Continuous (fun z : N => W (z : ℂ)) := ControlledNeighborhoodConstruction.hW_N e - eps S η hSf let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) - have ha_cont (c : Set.range e) : Continuous (fun z : N => a z c) := - ControlledNeighborhoodConstruction.ha_cont e eps S η hSf c let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c - have hv_cont : Continuous v := ControlledNeighborhoodConstruction.hv_cont e he eps S η hSf have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := ControlledNeighborhoodConstruction.hactive e eps S η hSf z have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : dist (z : ℂ) (c : ℂ) < 2 * r := ControlledNeighborhoodConstruction.hw_active_dist e eps S η hSf z c hc have hψmap (c : Set.range e) : e (ψ c) = c := ControlledNeighborhoodConstruction.hψmap e he c - have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := - ControlledNeighborhoodConstruction.ha_nonneg e eps S η hSf z c - have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := ControlledNeighborhoodConstruction.hsum_a e eps S - η hSf z - have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) - (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := ControlledNeighborhoodConstruction.hv_close e - he eps heps S δ₀ η hSf hη hδ₀ hηψ z i hi hwi - have hunit (c : Set.range e) : ‖u c‖ = 1 := ControlledNeighborhoodConstruction.hunit e he c - have hv_lower (z : N) : 1 - δ < ‖v z‖ := ControlledNeighborhoodConstruction.hv_lower e he eps - heps S δ₀ η hSf hη hδ₀ hηψ z - have hv_pos (z : N) : 0 < ‖v z‖ := ControlledNeighborhoodConstruction.hv_pos e he eps heps S δ₀ - η hSf hη hδ₀ hηψ z let p : N → ℂ := fun z => v z / (‖v z‖ : ℂ) have hp_norm (z : N) : ‖p z‖ = 1 := ControlledNeighborhoodConstruction.hp_norm e he eps heps S δ₀ η hSf hη hδ₀ hηψ z let phiVal : N → Circle := fun z => ⟨p z, (mem_sphere_zero_iff_norm).2 (hp_norm z)⟩ - have hp_cont : Continuous p := ControlledNeighborhoodConstruction.hp_cont e he eps heps S δ₀ η - hSf hη hδ₀ hηψ have hphiVal_cont : Continuous phiVal := ControlledNeighborhoodConstruction.hphiVal_cont e he eps heps S δ₀ η hSf hη hδ₀ hηψ - have norm_normalize (x : ℂ) (hx : 0 < ‖x‖) : - ‖x / (‖x‖ : ℂ) - x‖ = |1 - ‖x‖| := ControlledNeighborhoodConstruction.norm_normalize x hx - have hphi_near (z : N) : ∀ i ∈ F, 0 < w i (z : ℂ) → - ‖p z - u i‖ < 2 * δ := ControlledNeighborhoodConstruction.hphi_near e he eps heps S δ₀ η - hSf hη hδ₀ hηψ z have hphi_circle_close (z : N) (i : Set.range e) (hi : i ∈ F) (hwi : 0 < w i (z : ℂ)) : dist (phiVal z) (ψ i) < 2 * δ := ControlledNeighborhoodConstruction.hphi_circle_close e he eps heps S δ₀ η hSf hη hδ₀ diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndexLaws.lean b/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndexLaws.lean index d6dd9e36e5..45d025dfe6 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndexLaws.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1LoopIndexLaws.lean @@ -60,7 +60,6 @@ private theorem integralIndex : refine ⟨n, ?_⟩ change P3821T1AngularIncrement γ p / (2 * Real.pi) = (n : ℝ) rw [hn] - have hpi : (2 * Real.pi : ℝ) ≠ 0 := by positivity field_simp private theorem compositionIndex : @@ -184,7 +183,6 @@ private theorem compositionIndex : ⟨fun t => a t / (2 * Real.pi), by fun_prop⟩ let fracPoint (t : unitInterval) : unitInterval := ⟨Int.fract (xMap t), Int.fract_nonneg _, (Int.fract_lt_one _).le⟩ - have hpi : (2 * Real.pi : ℝ) ≠ 0 := by positivity have hax (t : unitInterval) : a t = 2 * Real.pi * xMap t := by dsimp [xMap] field_simp @@ -340,7 +338,6 @@ private theorem hlocal : have := lt_of_le_of_lt hb (hratioNear z) simpa using this rcases abs_lt.mp hb' with ⟨hlo, hhi⟩ - have hre : (ratio z).re - 1 > -1 := by linarith linarith have hratioCont : Continuous ratio := by apply Continuous.div @@ -604,8 +601,6 @@ theorem P3821T1LoopIndexLaws : ⟨fun z => H (⟨1, by norm_num⟩, z), by fun_prop⟩ p) := by -- BODY classical - let q : C(unitInterval, Circle) := - ⟨fun t => Circle.exp (2 * Real.pi * (t : ℝ)), by fun_prop⟩ rcases P3821T1AngularIncrementLaws with ⟨hlift, _, _⟩ have integralIndex : (∀ (g : C(Circle, ℂ)) (p : ℂ), (∀ z, g z ≠ p) → diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean index 17d30f71c0..0a68a25435 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ThreeArcCircle.lean @@ -281,15 +281,10 @@ private theorem cross₀₁ : rw [← hint₀₁] exact hmem simpa using hm - have hu : u = ⟨1, by norm_num⟩ := by - apply h₀.injective - apply Subtype.ext - exact hpos.trans h₀b.symm have hv : v = ⟨0, by norm_num⟩ := by apply h₁.injective apply Subtype.ext exact hxy.symm.trans hpos |>.trans h₁b.symm - have hx : x = 1 := congrArg Subtype.val hu have hy : y - 1 = 0 := congrArg Subtype.val hv linarith @@ -328,15 +323,10 @@ private theorem cross₁₂ : rw [← hint₁₂] exact hmem simpa using hm - have hu : u = ⟨1, by norm_num⟩ := by - apply h₁.injective - apply Subtype.ext - exact hpos.trans h₁c.symm have hv : v = ⟨0, by norm_num⟩ := by apply h₂.injective apply Subtype.ext exact hxy.symm.trans hpos |>.trans h₂c.symm - have hx : x - 1 = 1 := congrArg Subtype.val hu have hy : y - 2 = 0 := congrArg Subtype.val hv linarith @@ -365,19 +355,12 @@ private theorem cross₀₂ : let v : Set.Icc (0 : ℝ) 1 := ⟨y - 2, ⟨by linarith, by linarith⟩⟩ have hmem₀ : ((h₀ u : P.edgeArc a b) : Real × Real) ∈ P.edgeArc a b := (h₀ u).property have hmem₂ : ((h₂ v : P.edgeArc c a) : Real × Real) ∈ P.edgeArc c a := (h₂ v).property - have hmem : ((h₀ u : P.edgeArc a b) : Real × Real) ∈ - P.edgeArc a b ∩ P.edgeArc c a := ⟨hmem₀, hxy ▸ hmem₂⟩ have hpos : ((h₀ u : P.edgeArc a b) : Real × Real) = P.position a := by have hm : ((h₀ u : P.edgeArc a b) : Real × Real) ∈ ({P.position a} : Set (Real × Real)) := by rw [← hint₂₀] exact ⟨hxy ▸ hmem₂, hmem₀⟩ simpa using hm - have hu : u = ⟨0, by norm_num⟩ := by - apply h₀.injective - apply Subtype.ext - exact hpos.trans h₀a.symm - have hx : x = 0 := congrArg Subtype.val hu have hv : v = ⟨1, by norm_num⟩ := by apply h₂.injective apply Subtype.ext diff --git a/LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean b/LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean index 95674ea575..ab7f1e0ed7 100644 --- a/LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean @@ -937,8 +937,6 @@ theorem P3861T1FixedFacialDeletion {ι : Type} (P : PeriodicTileCore ι) : P.plane.face_boundary f have hCtrace (f : P.plane.Face) : C f ⊆ P3767T1FixedTrace P.plane := htrace.1 f |>.2 - have hCcompact (f : P.plane.Face) := FacialDeletionProof.hCcompact ι P hfront f - have hWopen (f : P.plane.Face) : IsOpen (W f) := isClosed_closure.isOpen_compl have hWnonempty (f : P.plane.Face) := FacialDeletionProof.hWnonempty ι P hgeom f have hWpartition (f : P.plane.Face) := FacialDeletionProof.hWpartition ι P f have hUsub (f : P.plane.Face) := FacialDeletionProof.hUsub ι P f @@ -971,8 +969,6 @@ theorem P3861T1FixedFacialDeletion {ι : Type} (P : PeriodicTileCore ι) : have hSopen (S : Set (Real × Real)) (hS : S = ⋃ v ∈ B, P3776T1OpenStar P v) := FacialDeletionProof.hSopen ι P hgeom f a S hS let S : Set (Real × Real) := ⋃ v ∈ B, P3776T1OpenStar P v - let T : Set (Real × Real) := - ⋃ v ∈ {v : ι | v ∉ A ∧ v ∉ B}, P3776T1OpenStar P v have hSopen' : IsOpen S := hSopen S rfl have hTopen := FacialDeletionProof.hTopen ι P hgeom f a have hST := FacialDeletionProof.hST ι P f a hstarIntersect diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean b/LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean index 2bf05ef1a2..8abc5e5901 100644 --- a/LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean +++ b/LeanPool/ApollonianSuperharmonic/P3889T1ExactRadialStar.lean @@ -357,10 +357,6 @@ private theorem hu_injective : intro ι P D a hadj_contact hlocal localU localEps rN u u_norm localRay rF0 r hr hr_local c d hac had hdirs by_contra hne - have hca : c ≠ a := by - intro h - subst c - exact P.plane.adjacent_irreflexive a hac have hda : d ≠ a := by intro h subst d @@ -496,12 +492,6 @@ theorem P3889T1ExactRadialStar {ι : Type} (P : PeriodicTileComplex ι) have hposition_arc_endpoint (v c d : ι) (hcd : P3723T1EdgeContact P c d) (hv : D.position v ∈ D.edgeArc c d) : v = c ∨ v = d := RadialStarProof.hposition_arc_endpoint ι P D hadj_contact v c d hcd hv - have hincident_position (c : ι) (hac : P.plane.adjacent a c) : - D.position a ∈ D.edgeArc a c := by - obtain ⟨g, _, _, hrange, hg0, _, _⟩ := D.edgeArc_parameterization a c (hadj_contact a c hac) - rw [← hrange] - rw [← hg0] - exact ⟨⟨0, by norm_num⟩, rfl⟩ have hlocal (c : ι) (hac : P.plane.adjacent a c) : ∃ u : Real × Real, ‖u‖ = 1 ∧ ∃ ε > 0, D.edgeArc a c ∩ Metric.ball (D.position a) ε = @@ -550,7 +540,6 @@ theorem P3889T1ExactRadialStar {ι : Type} (P : PeriodicTileComplex ι) rw [← hrange] exact isCompact_range hg let Q : Set (Real × Real) := Metric.closedBall (D.position a) 1 - have hQ : IsCompact Q := by dsimp [Q]; exact isCompact_closedBall _ _ let E : Set (ι × ι) := {e | P3723T1EdgeContact P e.1 e.2 ∧ (D.edgeArc e.1 e.2 ∩ Q).Nonempty} have hE : E.Finite := by @@ -576,7 +565,6 @@ theorem P3889T1ExactRadialStar {ι : Type} (P : PeriodicTileComplex ι) obtain ⟨rF0, hrF0, hballF0⟩ := (Metric.isOpen_iff.mp hAcompact.isClosed.isOpen_compl) (D.position a) hxA have hballF : Metric.ball (D.position a) rF0 ⊆ Aᶜ := hballF0 - have hrF0pos : 0 < rF0 := hrF0 let r : Real := min rN (min rF0 1) / 2 have hr : 0 < r := by dsimp [r]; positivity have hrNlt : r < rN := by dsimp [r]; have := min_le_left rN (min rF0 1); linarith diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean index 0e9d25a219..efeb44820d 100644 --- a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean @@ -1293,23 +1293,6 @@ private theorem hzeroK : exact hmem.1 obtain ⟨cg, dg, hcg, hdg, hcdg, hacg, hadg, hcgi, hdgi, hfrontG⟩ := hincidentSectorData g j hj - have hfrontG := hfrontG.1 - have hmatchG := faceOtherMatch g j hj e hgE hea cg dg hcg hdg hcdg hcgi hdgi - have hqrayG : (q ∈ B ∩ {q | ∃ s : Real, 0 ≤ s ∧ q = x + s • u cg}) ∨ - (q ∈ B ∩ {q | ∃ s : Real, 0 ≤ s ∧ q = x + s • u dg}) := by - rcases hmatchG with hce | hde - · left - refine ⟨hqBF, s, le_of_lt hs, ?_⟩ - simpa [hce] using hqeq - · right - refine ⟨hqBF, s, le_of_lt hs, ?_⟩ - simpa [hde] using hqeq - have hqfrontG : q ∈ frontier (F.region g) := by - have heq := congrArg (fun S : Set (Real × Real) => q ∈ S) hfrontG - have hmem : q ∈ frontier (F.region g) ∩ B := by - apply heq.mpr - simpa only [Set.mem_union, Set.mem_inter_iff] using hqrayG - exact hmem.1 exact Set.mem_iUnion₂.mpr ⟨f, ⟨i, hi⟩, frontier_subset_closure hqfrontF⟩ private theorem huAt878 : @@ -1707,7 +1690,6 @@ private theorem hfaceFillsSector : obtain ⟨c, d, hca, hda, hcd, hac, had, hci, hdi, hfront, ⟨S⟩⟩ := hincidentSectorData f i hi let U := F.region f - let V := (closure U)ᶜ have hxB : x ∈ B := by simp [B, Metric.mem_ball_self hr] have hxfront := FaceGapProof.hxfront ι P D F a r u f c d hfront (FaceGapProof.hxray ι P D a r u c hxB) @@ -1833,7 +1815,6 @@ private theorem hKlocal : (P.plane.every_edge_two_faces a e hae))) obtain ⟨hf0a, hf0e⟩ := hf0 obtain ⟨hf1a, hf1e⟩ := hf1 - have hcase := hexhaust f ⟨⟨i, hi⟩, he⟩ let g := if f = f0 then f1 else f0 have hfg := FaceGapProof.hfg ι P a f e hae hne have hgE := FaceGapProof.hgE ι P a f e hae hf0e hf1e @@ -1846,8 +1827,6 @@ private theorem hKlocal : have heps : 0 < eps := by dsimp [eps]; positivity have heps₁ := FaceGapProof.heps₁ t δ₁ hδ₁ δ₂ have heps₂ := FaceGapProof.heps₂ t δ₁ δ₂ hδ₂ - have hball₂' := FaceGapProof.hball₂' ι P D a r z t δ₁ δ₂ hball₂ - heps₂ have hzeroK := FaceGapProof.hzeroK ι P D F a r u hunit hincidentSectorData faceOtherMatch f z i hi e he hea hae t hzeq hgE j hj δ₁ δ₂ (FaceGapProof.hepst t ht δ₁ δ₂) (FaceGapProof.hball₁' ι P D a r z @@ -1960,9 +1939,6 @@ theorem P3889T1FaceGapCoverage : {q | ∃ c d, P.plane.adjacent c d ∧ q ∈ D.edgeArc c d} have hpB : p ∈ B := hp have hpNotT : p ∉ T := hnot - have hpNotRay (c : ι) (hac : P.plane.adjacent a c) := FaceGapProof.hpNotRay ι P D a r u p hpB - (FaceGapProof.hpNotRays ι P D a r u htrace p hpNotT) c hac - let N : Set ι := {c | P.plane.adjacent a c} have hincidentSectorData (f : P.plane.Face) (i : Fin 3) (hi : P.plane.faceVertex f i = a) := FaceGapProof.hincidentSectorData ι P D F a r u hedge hsectors (FaceGapProof.hfaceFrontier ι P D F a r hforeign) f i hi @@ -1980,14 +1956,6 @@ theorem P3889T1FaceGapCoverage : have hpSphere : p ∈ Metric.sphere x rho := by simp [rho] let I : Set P.plane.Face := {f | ∃ i, P.plane.faceVertex f i = a} - let Nsub := {c : ι // P.plane.adjacent a c} - let first (c : Nsub) : P.plane.Face := - Classical.choose (P.plane.every_edge_two_faces a c.1 c.2) - let second (c : Nsub) : P.plane.Face := - Classical.choose (Classical.choose_spec - (P.plane.every_edge_two_faces a c.1 c.2)) - let facePick : Nsub × Fin 2 → P.plane.Face := fun z => - if z.2 = 0 then first z.1 else second z.1 have faceOtherMatch (g : P.plane.Face) (j : Fin 3) (hj : P.plane.faceVertex g j = a) (e : ι) (he : ∃ k, P.plane.faceVertex g k = e) (hea : e ≠ a) @@ -2002,8 +1970,6 @@ theorem P3889T1FaceGapCoverage : have hKlocal (z : Real × Real) (hzS : z ∈ Metric.sphere x rho) (hzK : z ∈ K) : ∃ δ > 0, Metric.ball z δ ⊆ K := FaceGapSectorGeometry.hKlocal ι P D F hd a r u hunit p hincidentSectorData hfaceFillsSector hrho hrho' faceOtherMatch z hzS hzK - have hSnonempty : (Metric.sphere x rho).Nonempty := by - exact ⟨p, hpSphere⟩ have hAclosed : IsClosed ((Subtype.val : Metric.sphere x rho → Real × Real) ⁻¹' K) := hKclosed.preimage continuous_subtype_val obtain ⟨f, hfI, hpc⟩ := Set.mem_iUnion₂.mp (FaceGapProof.hpK ι P D F a p hpSphere diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean b/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean index 2825e64dad..244b2fc302 100644 --- a/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P3889T1TwoRaySectors.lean @@ -837,8 +837,6 @@ private theorem degenerateCase : (dOrig = 0) → (Nonempty (P3889T1TwoRaySectorDecomposition x r u v)))))) := by classical intro x r u v hr hu hv huv det uOrig vOrig dOrig hd - have hdet0 : u.1 * v.2 - u.2 * v.1 = 0 := by - simpa [dOrig, det, uOrig, vOrig] using hd have hu0 : u ≠ (0, 0) := by intro h rw [h] at hu @@ -881,12 +879,10 @@ private theorem degenerateCase : let j : Real × Real := (-u.2, u.1) have hsqpos : 0 < u.1^2 + u.2^2 := by by_contra h - have hle : u.1^2 + u.2^2 ≤ 0 := le_of_not_gt h have h1 : u.1 = 0 := by nlinarith [sq_nonneg u.1, sq_nonneg u.2] have h2 : u.2 = 0 := by nlinarith [sq_nonneg u.1, sq_nonneg u.2] apply hu0 ext <;> simp [h1, h2] - have hjdet : det u j = u.1^2 + u.2^2 := by dsimp [j, det]; ring have hjnorm : ‖j‖ = 1 := by dsimp [j] simpa [Prod.norm_def, Real.norm_eq_abs, max_comm] using hu @@ -1046,7 +1042,6 @@ private theorem nondegenerateCase : calc ‖positiveFirstDirection + positiveSecondDirection‖ ≤ ‖positiveFirstDirection‖ + ‖positiveSecondDirection‖ := norm_add_le _ _ _ = 2 := by rw [hu, hv]; norm_num - have hr4 : 0 < r / 4 := by positivity let q : Real × Real := x + (r / 4) • (positiveFirstDirection + positiveSecondDirection) have hqball : q ∈ Metric.ball x r := by change dist q x < r diff --git a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean index 242aab8219..9d7ff3d3e9 100644 --- a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean +++ b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean @@ -1193,7 +1193,6 @@ private theorem piece_overlap_forward : _ = (u : Real) := hparam.symm _ ≤ (s k).time r.succ := t.property.2 have htime : (s k).time r.succ = (s k).time r'.castSucc := le_antisymm hmono hback - have hindices : r.succ = r'.castSucc := (s k).strict.injective htime have hu : (u : Real) = (s k).time r.succ := by apply le_antisymm t.property.2 calc @@ -1865,16 +1864,10 @@ theorem P3913T1RoutedFaceSubdivision : (RoutedFaceDetails.faceContact ι P f (RoutedFaceDetails.cyc_ne)) i j hij have v_distinct (i j : Fin 3) (hij : i ≠ j) := RoutedFaceDetails.v_distinct ι P f i j hij - have v01 : v 0 ≠ v 1 := v_distinct 0 1 (by decide) - have v02 : v 0 ≠ v 2 := v_distinct 0 2 (by decide) - have v12 : v 1 ≠ v 2 := v_distinct 1 2 (by decide) have arc_inter_singleton (i j : Fin 3) (hij : i ≠ j) := RoutedFaceDetails.arc_inter_singleton ι P D f arc_inter (RoutedFaceDetails.pair_inter ι P f v_distinct) i j hij have w_arc (k : Fin 3) (i : Fin ((s k).count + 1)) := RoutedFaceDetails.w_arc ι P D f g hr s k i - have w_before_end (k : Fin 3) (i : Fin (s k).count) := RoutedFaceDetails.w_before_end g s k i - have w_start (k : Fin 3) := RoutedFaceDetails.w_start ι P D f g - h0 s k have w_ne_finish (k : Fin 3) (i : Fin (s k).count) : w k i.castSucc ≠ D.position (v (k + 1)) := RoutedSubdivisionProof.w_ne_finish ι P D f g hi s (RoutedFaceDetails.w_finish ι P D f g h1 s) k i @@ -1884,9 +1877,6 @@ theorem P3913T1RoutedFaceSubdivision : w_ne_finish (RoutedFaceDetails.arc12 ι P D f arc_inter_singleton)) (RoutedFaceDetails.no_cross02 ι P D f g s w_arc w_ne_finish (RoutedFaceDetails.arc20 ι P D f arc_inter_singleton)) (RoutedFaceDetails.w_block_injective g hi s) - let b0 (i : Fin m0) : Fin M := Fin.castAdd (m1 + m2) i - let b1 (i : Fin m1) : Fin M := Fin.natAdd m0 (Fin.castAdd m2 i) - let b2 (i : Fin m2) : Fin M := Fin.natAdd m0 (Fin.natAdd m1 i) have hM' : n + 3 = m0 + (m1 + m2) := by simpa [M] using hM have p_edge_piece (i : Fin (n + 3)) : ∃ k : Fin 3, ∃ r : Fin (s k).count, diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean index 7f81d427b1..0bb4cf10ea 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1ArcSideComparison.lean @@ -49,167 +49,21 @@ private theorem reverseLocal : intro _ exact negSign k (B.1 * (q.2 - z.2) - B.2 * (q.1 - z.1)) -private theorem hscale : - ∀ (S : Set (Real × Real)), - ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (p : P3723T1PolygonalParameterization g), - ∀ (q : P3723T1PolygonalParameterization h), - ∀ (hgrange : Set.range g = S), - ∀ (hhrange : Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; - ∀ (hgfun_inj : Function.Injective gfun), - ∀ (hhfun_inj : Function.Injective hfun), - ∀ (hgfun_surj : Function.Surjective gfun), - ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; - let he : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; - ∀ (hgfun_cont : Continuous gfun), - ∀ (hhfun_cont : Continuous hfun), - let GH := - Continuous.homeoOfEquivCompactToT2 (f := ge) - hgfun_cont; - let HH := - Continuous.homeoOfEquivCompactToT2 (f := he) - hhfun_cont; - let phi : - Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := - GH.trans HH.symm; - let i1 : Fin (p.count + 1) := - ⟨1, by have hp := p.positive; omega⟩; - let j1 : Fin (q.count + 1) := - ⟨1, by have hq := q.positive; omega⟩; - ∀ (hpi : 0 < p.time i1), - ∀ (hqj : 0 < q.time j1), - ∀ (hpi1 : p.time i1 ≤ 1), - ∀ (hqj1 : q.time j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := - ⟨p.time i1, hpi.le, hpi1⟩; - let β : Set.Icc (0 : Real) 1 := - ⟨q.time j1, hqj.le, hqj1⟩; - let c : Real := min (phi α : Real) (β : Real); - ∀ (hcpos : 0 < c), - (∀ (hc_le_one : c ≤ 1), - let r1 : Set.Icc (0 : Real) 1 := - ⟨c / 3, - ⟨by linarith [hcpos], by - have := hc_le_one; linarith⟩⟩; - let r2 : Set.Icc (0 : Real) 1 := - ⟨2 * c / 3, - ⟨by linarith [hcpos], by - have := hc_le_one; linarith⟩⟩; - ((r1 : Real) < (r2 : Real)) → - (let xL : Set.Icc (0 : Real) 1 := - phi.symm r1; - let xR : Set.Icc (0 : Real) 1 := - phi.symm r2; - ∀ (Bg : ℝ × ℝ), - ∀ (Bh : ℝ × ℝ), - (((xR : Real) - (xL : Real)) • Bg = - ((r2 : Real) - (r1 : Real)) • - Bh) → - (let scale : Real := - ((xR : Real) - (xL : Real)) / - ((r2 : Real) - (r1 : Real)); - Bh = scale • Bg))) := by - classical - intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he - hgfun_cont hhfun_cont GH HH phi i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_one r1 r2 hr12 - xL xR Bg Bh hvel scale - have hfst := congrArg Prod.fst hvel - have hsnd := congrArg Prod.snd hvel - change ((xR : Real) - (xL : Real)) * Bg.1 = - ((r2 : Real) - (r1 : Real)) * Bh.1 at hfst - change ((xR : Real) - (xL : Real)) * Bg.2 = - ((r2 : Real) - (r1 : Real)) * Bh.2 at hsnd - have hden : (r2 : Real) - (r1 : Real) ≠ 0 := ne_of_gt (sub_pos.mpr hr12) - apply Prod.ext - · change Bh.1 = scale * Bg.1 - dsimp [scale] - calc - Bh.1 = (((r2 : Real) - (r1 : Real)) * Bh.1) / ((r2 : Real) - (r1 : Real)) := by - field_simp - _ = (((xR : Real) - (xL : Real)) * Bg.1) / ((r2 : Real) - (r1 : Real)) := by rw [← hfst] - _ = (((xR : Real) - (xL : Real)) / ((r2 : Real) - (r1 : Real))) * Bg.1 := by ring - · change Bh.2 = scale * Bg.2 - dsimp [scale] - calc - Bh.2 = (((r2 : Real) - (r1 : Real)) * Bh.2) / ((r2 : Real) - (r1 : Real)) := by - field_simp - _ = (((xR : Real) - (xL : Real)) * Bg.2) / ((r2 : Real) - (r1 : Real)) := by rw [← hsnd] - _ = (((xR : Real) - (xL : Real)) / ((r2 : Real) - (r1 : Real))) * Bg.2 := by ring - -private theorem localResult : - ∀ (S : Set (Real × Real)), - ∀ (e : Bool), - ∀ (d : Bool), - ∀ (U₁ : Set (ℝ × ℝ)), - ∀ (U₂ : Set (ℝ × ℝ)), - ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (p : P3723T1PolygonalParameterization g), - ∀ (q : P3723T1PolygonalParameterization h), - ∀ (hgrange : Set.range g = S), - ∀ (hhrange : Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; - ∀ (hgfun_inj : Function.Injective gfun), - ∀ (hhfun_inj : Function.Injective hfun), - ∀ (hgfun_surj : Function.Surjective gfun), - ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; - let he : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; - ∀ (hgfun_cont : Continuous gfun), - ∀ (hhfun_cont : Continuous hfun), - let GH := - Continuous.homeoOfEquivCompactToT2 (f := ge) hgfun_cont; - let HH := Continuous.homeoOfEquivCompactToT2 (f := he) hhfun_cont; - let phi : Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := - GH.trans HH.symm; - let i1 : Fin (p.count + 1) := - ⟨1, by have hp := p.positive; omega⟩; - let j1 : Fin (q.count + 1) := - ⟨1, by have hq := q.positive; omega⟩; - ∀ (hpi : 0 < p.time i1), - ∀ (hqj : 0 < q.time j1), - ∀ (hpi1 : p.time i1 ≤ 1), - ∀ (hqj1 : q.time j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := ⟨p.time i1, hpi.le, hpi1⟩; - let β : Set.Icc (0 : Real) 1 := ⟨q.time j1, hqj.le, hqj1⟩; - let c : Real := min (phi α : Real) (β : Real); - ∀ (hcpos : 0 < c), - ∀ (hc_le_one : c ≤ 1), - let r1 : Set.Icc (0 : Real) 1 := - ⟨c / 3, ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩; - let r2 : Set.Icc (0 : Real) 1 := - ⟨2 * c / 3, - ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩; - let xL : Set.Icc (0 : Real) 1 := phi.symm r1; - let xR : Set.Icc (0 : Real) 1 := phi.symm r2; - ∀ (Bg : ℝ × ℝ), - Bg ≠ (0 : ℝ × ℝ) → - ∀ (Bh : ℝ × ℝ), - let scale : Real := - ((xR : Real) - (xL : Real)) / ((r2 : Real) - (r1 : Real)) - 0 < scale → - Bh = scale • Bg → - let z : Real × Real := g xL - P3934T1LocalSide U₁ z Bg e → - P3934T1LocalSide U₂ z Bh d → - (U₁ = U₂ → e = d) ∧ (Disjoint U₁ U₂ → e ≠ d) := by - classical - intro S e d U₁ U₂ g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj - ge he hgfun_cont hhfun_cont GH HH phi i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_one r1 r2 - xL xR Bg hBg Bh scale hscale_pos hscale z hlocG hlocH +private theorem hscale (xL xR r1 r2 : ℝ) (Bg Bh : ℝ × ℝ) + (hr12 : r1 < r2) (hvel : (xR - xL) • Bg = (r2 - r1) • Bh) : + Bh = ((xR - xL) / (r2 - r1)) • Bg := by + have hden : r2 - r1 ≠ 0 := ne_of_gt (sub_pos.mpr hr12) + calc + Bh = ((r2 - r1)⁻¹ * (r2 - r1)) • Bh := by simp [hden] + _ = (r2 - r1)⁻¹ • ((r2 - r1) • Bh) := by rw [smul_smul] + _ = (r2 - r1)⁻¹ • ((xR - xL) • Bg) := by rw [← hvel] + _ = ((xR - xL) / (r2 - r1)) • Bg := by rw [smul_smul, div_eq_mul_inv, mul_comm] + +private theorem localResult (U₁ U₂ : Set (ℝ × ℝ)) (e d : Bool) + (z Bg Bh : ℝ × ℝ) (scale : ℝ) (hBg : Bg ≠ 0) + (hscale_pos : 0 < scale) (hscale : Bh = scale • Bg) + (hlocG : P3934T1LocalSide U₁ z Bg e) (hlocH : P3934T1LocalSide U₂ z Bh d) : + (U₁ = U₂ → e = d) ∧ (Disjoint U₁ U₂ → e ≠ d) := by rcases hlocG with ⟨r, hr, hEqU⟩ rcases hlocH with ⟨s, hs, hEqV⟩ let v : Real × Real := (-Bg.2, Bg.1) @@ -526,587 +380,6 @@ private theorem hgfun_surj : private abbrev hhfun_surj := ApollonianSuperharmonic.ArcComparisonMainProof.ArcComparisonCoreFacts.hgfun_surj -private theorem hx0L : - ∀ (S : Set (ℝ × ℝ)), - ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (p : P3723T1PolygonalParameterization g), - ∀ (q : P3723T1PolygonalParameterization h), - ∀ (hgrange : Set.range g = S), - ∀ (hhrange : Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; - ∀ (hgfun_inj : Function.Injective gfun), - ∀ (hhfun_inj : Function.Injective hfun), - ∀ (hgfun_surj : Function.Surjective gfun), - ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; - let he : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; - ∀ (hgfun_cont : Continuous gfun), - ∀ (hhfun_cont : Continuous hfun), - let GH := - Continuous.homeoOfEquivCompactToT2 (f := ge) - hgfun_cont; - let HH := - Continuous.homeoOfEquivCompactToT2 (f := he) - hhfun_cont; - let phi : - Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := - GH.trans HH.symm; - let x0 : Set.Icc (0 : Real) 1 := ⟨0, by norm_num⟩; - (phi x0 = x0) → - ((StrictMono phi) → - (let i1 : Fin (p.count + 1) := - ⟨1, by have hp := p.positive; omega⟩; - let j1 : Fin (q.count + 1) := - ⟨1, by have hq := q.positive; omega⟩; - ∀ (hpi : 0 < p.time i1), - ∀ (hqj : 0 < q.time j1), - ∀ (hpi1 : p.time i1 ≤ 1), - ∀ (hqj1 : q.time j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := - ⟨p.time i1, hpi.le, hpi1⟩; - let β : Set.Icc (0 : Real) 1 := - ⟨q.time j1, hqj.le, hqj1⟩; - let c : Real := - min (phi α : Real) (β : Real); - ∀ (hcpos : 0 < c), - (∀ (hc_le_one : c ≤ 1), - let r1 : Set.Icc (0 : Real) 1 := - ⟨c / 3, - ⟨by linarith [hcpos], by - have := hc_le_one; linarith⟩⟩; - (0 < (r1 : Real)) → - (let xL : Set.Icc (0 : Real) 1 := - phi.symm r1; - (phi xL = r1) → (x0 < xL))))) := by - classical - intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he - hgfun_cont hhfun_cont GH HH phi x0 hphi0 hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos - hc_le_one r1 hr1pos xL hφL - by_contra hh - have hle : xL ≤ x0 := le_of_not_gt hh - have hm := hphi_mono.monotone hle - rw [hφL, hphi0] at hm - have h0r : x0 < r1 := by exact_mod_cast hr1pos - exact (not_le_of_gt h0r) hm - -private theorem hx0R : - ∀ (S : Set (ℝ × ℝ)), - ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (p : P3723T1PolygonalParameterization g), - ∀ (q : P3723T1PolygonalParameterization h), - ∀ (hgrange : Set.range g = S), - ∀ (hhrange : Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; - ∀ (hgfun_inj : Function.Injective gfun), - ∀ (hhfun_inj : Function.Injective hfun), - ∀ (hgfun_surj : Function.Surjective gfun), - ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; - let he : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; - ∀ (hgfun_cont : Continuous gfun), - ∀ (hhfun_cont : Continuous hfun), - let GH := - Continuous.homeoOfEquivCompactToT2 (f := ge) - hgfun_cont; - let HH := - Continuous.homeoOfEquivCompactToT2 (f := he) - hhfun_cont; - let phi : - Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := - GH.trans HH.symm; - let x0 : Set.Icc (0 : Real) 1 := ⟨0, by norm_num⟩; - (phi x0 = x0) → - ((StrictMono phi) → - (let i1 : Fin (p.count + 1) := - ⟨1, by have hp := p.positive; omega⟩; - let j1 : Fin (q.count + 1) := - ⟨1, by have hq := q.positive; omega⟩; - ∀ (hpi : 0 < p.time i1), - ∀ (hqj : 0 < q.time j1), - ∀ (hpi1 : p.time i1 ≤ 1), - ∀ (hqj1 : q.time j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := - ⟨p.time i1, hpi.le, hpi1⟩; - let β : Set.Icc (0 : Real) 1 := - ⟨q.time j1, hqj.le, hqj1⟩; - let c : Real := - min (phi α : Real) (β : Real); - ∀ (hcpos : 0 < c), - (∀ (hc_le_one : c ≤ 1), - let r2 : Set.Icc (0 : Real) 1 := - ⟨2 * c / 3, - ⟨by linarith [hcpos], by - have := hc_le_one; linarith⟩⟩; - (0 < (r2 : Real)) → - (let xR : Set.Icc (0 : Real) 1 := - phi.symm r2; - (phi xR = r2) → (x0 < xR))))) := by - classical - intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he - hgfun_cont hhfun_cont GH HH phi x0 hphi0 hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos - hc_le_one r2 hr2pos xR hφR - by_contra hh - have hle : xR ≤ x0 := le_of_not_gt hh - have hm := hphi_mono.monotone hle - rw [hφR, hphi0] at hm - have h0r : x0 < r2 := by exact_mod_cast hr2pos - exact (not_le_of_gt h0r) hm - -private theorem hxLa : - ∀ (S : Set (ℝ × ℝ)), - ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (p : P3723T1PolygonalParameterization g), - ∀ (q : P3723T1PolygonalParameterization h), - ∀ (hgrange : Set.range g = S), - ∀ (hhrange : Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; - ∀ (hgfun_inj : Function.Injective gfun), - ∀ (hhfun_inj : Function.Injective hfun), - ∀ (hgfun_surj : Function.Surjective gfun), - ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; - let he : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; - ∀ (hgfun_cont : Continuous gfun), - ∀ (hhfun_cont : Continuous hfun), - let GH := - Continuous.homeoOfEquivCompactToT2 (f := ge) - hgfun_cont; - let HH := - Continuous.homeoOfEquivCompactToT2 (f := he) - hhfun_cont; - let phi : - Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := - GH.trans HH.symm; - (StrictMono phi) → - (let i1 : Fin (p.count + 1) := - ⟨1, by have hp := p.positive; omega⟩; - let j1 : Fin (q.count + 1) := - ⟨1, by have hq := q.positive; omega⟩; - ∀ (hpi : 0 < p.time i1), - ∀ (hqj : 0 < q.time j1), - ∀ (hpi1 : p.time i1 ≤ 1), - ∀ (hqj1 : q.time j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := - ⟨p.time i1, hpi.le, hpi1⟩; - let β : Set.Icc (0 : Real) 1 := - ⟨q.time j1, hqj.le, hqj1⟩; - let c : Real := - min (phi α : Real) (β : Real); - ∀ (hcpos : 0 < c), - (c ≤ (phi α : Real)) → - (∀ (hc_le_one : c ≤ 1), - let r1 : Set.Icc (0 : Real) 1 := - ⟨c / 3, - ⟨by linarith [hcpos], by - have := hc_le_one; linarith⟩⟩; - (let xL : Set.Icc (0 : Real) 1 := - phi.symm r1; - (phi xL = r1) → (xL < α)))) := by - classical - intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he - hgfun_cont hhfun_cont GH HH phi hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_a - hc_le_one r1 xL hφL - by_contra hh - have hle : α ≤ xL := le_of_not_gt hh - have hm := hphi_mono.monotone hle - rw [hφL] at hm - have hr1c : (r1 : Real) < c := by dsimp [r1]; linarith [hcpos] - have hrc : (r1 : Real) < (phi α : Real) := lt_of_lt_of_le hr1c hc_le_a - have hrc' : r1 < phi α := by exact_mod_cast hrc - exact (not_le_of_gt hrc') hm - -private theorem hxRa : - ∀ (S : Set (ℝ × ℝ)), - ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (p : P3723T1PolygonalParameterization g), - ∀ (q : P3723T1PolygonalParameterization h), - ∀ (hgrange : Set.range g = S), - ∀ (hhrange : Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; - ∀ (hgfun_inj : Function.Injective gfun), - ∀ (hhfun_inj : Function.Injective hfun), - ∀ (hgfun_surj : Function.Surjective gfun), - ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; - let he : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; - ∀ (hgfun_cont : Continuous gfun), - ∀ (hhfun_cont : Continuous hfun), - let GH := - Continuous.homeoOfEquivCompactToT2 (f := ge) - hgfun_cont; - let HH := - Continuous.homeoOfEquivCompactToT2 (f := he) - hhfun_cont; - let phi : - Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := - GH.trans HH.symm; - (StrictMono phi) → - (let i1 : Fin (p.count + 1) := - ⟨1, by have hp := p.positive; omega⟩; - let j1 : Fin (q.count + 1) := - ⟨1, by have hq := q.positive; omega⟩; - ∀ (hpi : 0 < p.time i1), - ∀ (hqj : 0 < q.time j1), - ∀ (hpi1 : p.time i1 ≤ 1), - ∀ (hqj1 : q.time j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := - ⟨p.time i1, hpi.le, hpi1⟩; - let β : Set.Icc (0 : Real) 1 := - ⟨q.time j1, hqj.le, hqj1⟩; - let c : Real := - min (phi α : Real) (β : Real); - ∀ (hcpos : 0 < c), - (c ≤ (phi α : Real)) → - (∀ (hc_le_one : c ≤ 1), - let r2 : Set.Icc (0 : Real) 1 := - ⟨2 * c / 3, - ⟨by linarith [hcpos], by - have := hc_le_one; linarith⟩⟩; - ((r2 : Real) < c) → - (let xR : Set.Icc (0 : Real) 1 := - phi.symm r2; - (phi xR = r2) → (xR < α)))) := by - classical - intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he - hgfun_cont hhfun_cont GH HH phi hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_a - hc_le_one r2 hr2c xR hφR - by_contra hh - have hle : α ≤ xR := le_of_not_gt hh - have hm := hphi_mono.monotone hle - rw [hφR] at hm - have hrc : (r2 : Real) < (phi α : Real) := lt_of_lt_of_le hr2c hc_le_a - have hrc' : r2 < phi α := by exact_mod_cast hrc - exact (not_le_of_gt hrc') hm - -private theorem hxLR : - ∀ (S : Set (ℝ × ℝ)), - ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (p : P3723T1PolygonalParameterization g), - ∀ (q : P3723T1PolygonalParameterization h), - ∀ (hgrange : Set.range g = S), - ∀ (hhrange : Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; - ∀ (hgfun_inj : Function.Injective gfun), - ∀ (hhfun_inj : Function.Injective hfun), - ∀ (hgfun_surj : Function.Surjective gfun), - ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; - let he : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; - ∀ (hgfun_cont : Continuous gfun), - ∀ (hhfun_cont : Continuous hfun), - let GH := - Continuous.homeoOfEquivCompactToT2 (f := ge) - hgfun_cont; - let HH := - Continuous.homeoOfEquivCompactToT2 (f := he) - hhfun_cont; - let phi : - Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := - GH.trans HH.symm; - (StrictMono phi) → - (let i1 : Fin (p.count + 1) := - ⟨1, by have hp := p.positive; omega⟩; - let j1 : Fin (q.count + 1) := - ⟨1, by have hq := q.positive; omega⟩; - ∀ (hpi : 0 < p.time i1), - ∀ (hqj : 0 < q.time j1), - ∀ (hpi1 : p.time i1 ≤ 1), - ∀ (hqj1 : q.time j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := - ⟨p.time i1, hpi.le, hpi1⟩; - let β : Set.Icc (0 : Real) 1 := - ⟨q.time j1, hqj.le, hqj1⟩; - let c : Real := - min (phi α : Real) (β : Real); - ∀ (hcpos : 0 < c), - (∀ (hc_le_one : c ≤ 1), - let r1 : Set.Icc (0 : Real) 1 := - ⟨c / 3, - ⟨by linarith [hcpos], by - have := hc_le_one; linarith⟩⟩; - let r2 : Set.Icc (0 : Real) 1 := - ⟨2 * c / 3, - ⟨by linarith [hcpos], by - have := hc_le_one; linarith⟩⟩; - ((r1 : Real) < (r2 : Real)) → - (let xL : Set.Icc (0 : Real) 1 := - phi.symm r1; - let xR : Set.Icc (0 : Real) 1 := - phi.symm r2; - (phi xL = r1) → - ((phi xR = r2) → (xL < xR))))) := by - classical - intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he - hgfun_cont hhfun_cont GH HH phi hphi_mono i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_one r1 - r2 hr12 xL xR hφL hφR - by_contra hh - have hle : xR ≤ xL := le_of_not_gt hh - have hm := hphi_mono.monotone hle - rw [hφR, hφL] at hm - have hlt : r1 < r2 := by exact_mod_cast hr12 - exact (not_le_of_gt hlt) hm - -private theorem hEqL : - ∀ (S : Set (ℝ × ℝ)), - ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (p : P3723T1PolygonalParameterization g), - ∀ (q : P3723T1PolygonalParameterization h), - ∀ (hgrange : Set.range g = S), - ∀ (hhrange : Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; - ∀ (hgfun_inj : Function.Injective gfun), - ∀ (hhfun_inj : Function.Injective hfun), - ∀ (hgfun_surj : Function.Surjective gfun), - ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; - let he : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; - ∀ (hgfun_cont : Continuous gfun), - ∀ (hhfun_cont : Continuous hfun), - let GH := - Continuous.homeoOfEquivCompactToT2 (f := ge) - hgfun_cont; - let HH := - Continuous.homeoOfEquivCompactToT2 (f := he) - hhfun_cont; - let phi : - Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := - GH.trans HH.symm; - (∀ (x : Set.Icc (0 : Real) 1), h (phi x) = g x) → - (let i1 : Fin (p.count + 1) := - ⟨1, by have hp := p.positive; omega⟩; - let j1 : Fin (q.count + 1) := - ⟨1, by have hq := q.positive; omega⟩; - ∀ (hpi : 0 < p.time i1), - ∀ (hqj : 0 < q.time j1), - ∀ (hpi1 : p.time i1 ≤ 1), - ∀ (hqj1 : q.time j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := - ⟨p.time i1, hpi.le, hpi1⟩; - let β : Set.Icc (0 : Real) 1 := - ⟨q.time j1, hqj.le, hqj1⟩; - let c : Real := - min (phi α : Real) (β : Real); - ∀ (hcpos : 0 < c), - (∀ (hc_le_one : c ≤ 1), - let r1 : Set.Icc (0 : Real) 1 := - ⟨c / 3, - ⟨by linarith [hcpos], by - have := hc_le_one; linarith⟩⟩; - let xL : Set.Icc (0 : Real) 1 := - phi.symm r1; - (phi xL = r1) → - (∀ (Ag : ℝ × ℝ), - ∀ (Bg : ℝ × ℝ), - ∀ (Ah : ℝ × ℝ), - ∀ (Bh : ℝ × ℝ), - (g xL = Ag + (↑xL : ℝ) • Bg) → - ((h r1 = - Ah + (↑r1 : ℝ) • Bh) → - (Ag + (xL : Real) • Bg = - Ah + - (r1 : Real) • Bh))))) := by - classical - intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he - hgfun_cont hhfun_cont GH HH phi hrel i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_one r1 xL - hφL Ag Bg Ah Bh hgL hhL - calc - Ag + (xL : Real) • Bg = g xL := hgL.symm - _ = h (phi xL) := (hrel xL).symm - _ = h r1 := by rw [hφL] - _ = Ah + (r1 : Real) • Bh := hhL - -private theorem hEqR : - ∀ (S : Set (ℝ × ℝ)), - ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (p : P3723T1PolygonalParameterization g), - ∀ (q : P3723T1PolygonalParameterization h), - ∀ (hgrange : Set.range g = S), - ∀ (hhrange : Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; - ∀ (hgfun_inj : Function.Injective gfun), - ∀ (hhfun_inj : Function.Injective hfun), - ∀ (hgfun_surj : Function.Surjective gfun), - ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; - let he : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; - ∀ (hgfun_cont : Continuous gfun), - ∀ (hhfun_cont : Continuous hfun), - let GH := - Continuous.homeoOfEquivCompactToT2 (f := ge) - hgfun_cont; - let HH := - Continuous.homeoOfEquivCompactToT2 (f := he) - hhfun_cont; - let phi : - Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := - GH.trans HH.symm; - (∀ (x : Set.Icc (0 : Real) 1), h (phi x) = g x) → - (let i1 : Fin (p.count + 1) := - ⟨1, by have hp := p.positive; omega⟩; - let j1 : Fin (q.count + 1) := - ⟨1, by have hq := q.positive; omega⟩; - ∀ (hpi : 0 < p.time i1), - ∀ (hqj : 0 < q.time j1), - ∀ (hpi1 : p.time i1 ≤ 1), - ∀ (hqj1 : q.time j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := - ⟨p.time i1, hpi.le, hpi1⟩; - let β : Set.Icc (0 : Real) 1 := - ⟨q.time j1, hqj.le, hqj1⟩; - let c : Real := - min (phi α : Real) (β : Real); - ∀ (hcpos : 0 < c), - (∀ (hc_le_one : c ≤ 1), - let r2 : Set.Icc (0 : Real) 1 := - ⟨2 * c / 3, - ⟨by linarith [hcpos], by - have := hc_le_one; linarith⟩⟩; - let xR : Set.Icc (0 : Real) 1 := - phi.symm r2; - (phi xR = r2) → - (∀ (Ag : ℝ × ℝ), - ∀ (Bg : ℝ × ℝ), - ∀ (Ah : ℝ × ℝ), - ∀ (Bh : ℝ × ℝ), - (g xR = Ag + (↑xR : ℝ) • Bg) → - ((h r2 = - Ah + (↑r2 : ℝ) • Bh) → - (Ag + (xR : Real) • Bg = - Ah + - (r2 : Real) • Bh))))) := by - classical - intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he - hgfun_cont hhfun_cont GH HH phi hrel i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_one r2 xR - hφR Ag Bg Ah Bh hgR hhR - calc - Ag + (xR : Real) • Bg = g xR := hgR.symm - _ = h (phi xR) := (hrel xR).symm - _ = h r2 := by rw [hφR] - _ = Ah + (r2 : Real) • Bh := hhR - -private theorem hvel : - ∀ (S : Set (ℝ × ℝ)), - ∀ (g : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (h : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (p : P3723T1PolygonalParameterization g), - ∀ (q : P3723T1PolygonalParameterization h), - ∀ (hgrange : Set.range g = S), - ∀ (hhrange : Set.range h = S), - let gfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨g x, by rw [← hgrange]; exact ⟨x, rfl⟩⟩; - let hfun : Set.Icc (0 : Real) 1 → S := fun x => - ⟨h x, by rw [← hhrange]; exact ⟨x, rfl⟩⟩; - ∀ (hgfun_inj : Function.Injective gfun), - ∀ (hhfun_inj : Function.Injective hfun), - ∀ (hgfun_surj : Function.Surjective gfun), - ∀ (hhfun_surj : Function.Surjective hfun), - let ge : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective gfun ⟨hgfun_inj, hgfun_surj⟩; - let he : Set.Icc (0 : Real) 1 ≃ S := - Equiv.ofBijective hfun ⟨hhfun_inj, hhfun_surj⟩; - ∀ (hgfun_cont : Continuous gfun), - ∀ (hhfun_cont : Continuous hfun), - let GH := - Continuous.homeoOfEquivCompactToT2 (f := ge) - hgfun_cont; - let HH := - Continuous.homeoOfEquivCompactToT2 (f := he) - hhfun_cont; - let phi : - Set.Icc (0 : Real) 1 ≃ₜ Set.Icc (0 : Real) 1 := - GH.trans HH.symm; - let i1 : Fin (p.count + 1) := - ⟨1, by have hp := p.positive; omega⟩; - let j1 : Fin (q.count + 1) := - ⟨1, by have hq := q.positive; omega⟩; - ∀ (hpi : 0 < p.time i1), - ∀ (hqj : 0 < q.time j1), - ∀ (hpi1 : p.time i1 ≤ 1), - ∀ (hqj1 : q.time j1 ≤ 1), - let α : Set.Icc (0 : Real) 1 := - ⟨p.time i1, hpi.le, hpi1⟩; - let β : Set.Icc (0 : Real) 1 := - ⟨q.time j1, hqj.le, hqj1⟩; - let c : Real := min (phi α : Real) (β : Real); - ∀ (hcpos : 0 < c), - (∀ (hc_le_one : c ≤ 1), - let r1 : Set.Icc (0 : Real) 1 := - ⟨c / 3, - ⟨by linarith [hcpos], by - have := hc_le_one; linarith⟩⟩; - let r2 : Set.Icc (0 : Real) 1 := - ⟨2 * c / 3, - ⟨by linarith [hcpos], by - have := hc_le_one; linarith⟩⟩; - let xL : Set.Icc (0 : Real) 1 := - phi.symm r1; - let xR : Set.Icc (0 : Real) 1 := - phi.symm r2; - ∀ (Ag : ℝ × ℝ), - ∀ (Bg : ℝ × ℝ), - ∀ (Ah : ℝ × ℝ), - ∀ (Bh : ℝ × ℝ), - (Ag + (xL : Real) • Bg = - Ah + (r1 : Real) • Bh) → - ((Ag + (xR : Real) • Bg = - Ah + (r2 : Real) • Bh) → - (((xR : Real) - (xL : Real)) • - Bg = - ((r2 : Real) - - (r1 : Real)) • - Bh))) := by - classical - intro S g h p q hgrange hhrange gfun hfun hgfun_inj hhfun_inj hgfun_surj hhfun_surj ge he - hgfun_cont hhfun_cont GH HH phi i1 j1 hpi hqj hpi1 hqj1 α β c hcpos hc_le_one r1 r2 xL xR - Ag Bg Ah Bh hEqL hEqR - calc - ((xR : Real) - (xL : Real)) • Bg = - (Ag + (xR : Real) • Bg) - (Ag + (xL : Real) • Bg) := by module - _ = (Ah + (r2 : Real) • Bh) - (Ah + (r1 : Real) • Bh) := by rw [hEqR, hEqL] - _ = ((r2 : Real) - (r1 : Real)) • Bh := by module - end ArcComparisonCoreFacts private theorem compareCore : @@ -1213,28 +486,29 @@ private theorem compareCore : let r2 : Set.Icc (0 : Real) 1 := ⟨2 * c / 3, ⟨by linarith [hcpos], by have := hc_le_one; linarith⟩⟩ have hr1pos : 0 < (r1 : Real) := by dsimp [r1]; linarith - have hr2pos : 0 < (r2 : Real) := by dsimp [r2]; linarith have hr12 : (r1 : Real) < (r2 : Real) := by dsimp [r1, r2]; linarith have hr2c : (r2 : Real) < c := by dsimp [r2]; linarith let xL : Set.Icc (0 : Real) 1 := phi.symm r1 let xR : Set.Icc (0 : Real) 1 := phi.symm r2 have hφL : phi xL = r1 := by simp [xL] have hφR : phi xR = r2 := by simp [xR] - have hx0L : x0 < xL := ArcComparisonCoreFacts.hx0L S g h p q hgrange hhrange hgfun_inj - hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi0 hphi_mono hpi hqj hpi1 hqj1 - hcpos hc_le_one hr1pos hφL - have hx0R : x0 < xR := ArcComparisonCoreFacts.hx0R S g h p q hgrange hhrange hgfun_inj - hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi0 hphi_mono hpi hqj hpi1 hqj1 - hcpos hc_le_one hr2pos hφR - have hxLa : xL < α := ArcComparisonCoreFacts.hxLa S g h p q hgrange hhrange hgfun_inj hhfun_inj - hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi_mono hpi hqj hpi1 hqj1 hcpos hc_le_a - hc_le_one hφL - have hxRa : xR < α := ArcComparisonCoreFacts.hxRa S g h p q hgrange hhrange hgfun_inj hhfun_inj - hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi_mono hpi hqj hpi1 hqj1 hcpos hc_le_a - hc_le_one hr2c hφR - have hxLR : xL < xR := ArcComparisonCoreFacts.hxLR S g h p q hgrange hhrange hgfun_inj - hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hphi_mono hpi hqj hpi1 hqj1 hcpos - hc_le_one hr12 hφL hφR + have hx0L : x0 < xL := by + apply hphi_mono.lt_iff_lt.mp + rw [hphi0, hφL] + exact_mod_cast hr1pos + have hxLa : xL < α := by + apply hphi_mono.lt_iff_lt.mp + rw [hφL] + have hr1c : (r1 : Real) < c := by dsimp [r1]; linarith [hcpos] + exact_mod_cast lt_of_lt_of_le hr1c hc_le_a + have hxRa : xR < α := by + apply hphi_mono.lt_iff_lt.mp + rw [hφR] + exact_mod_cast lt_of_lt_of_le hr2c hc_le_a + have hxLR : xL < xR := by + apply hphi_mono.lt_iff_lt.mp + rw [hφL, hφR] + exact_mod_cast hr12 have hu1β : r1 < β := by have h : (r1 : Real) < (β : Real) := lt_of_lt_of_le (by dsimp [r1]; linarith [hcpos]) hc_le_b exact_mod_cast h @@ -1275,23 +549,22 @@ private theorem compareCore : have hgR := hgline xR hplowR hpupR have hhL := hhline r1 hqLow1 hqUp1 have hhR := hhline r2 hqLow2 hqUp2 - have hEqL : Ag + (xL : Real) • Bg = Ah + (r1 : Real) • Bh := ArcComparisonCoreFacts.hEqL S g h - p q hgrange hhrange hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hrel - hpi hqj hpi1 hqj1 hcpos hc_le_one hφL Ag Bg Ah Bh hgL hhL - have hEqR : Ag + (xR : Real) • Bg = Ah + (r2 : Real) • Bh := ArcComparisonCoreFacts.hEqR S g h - p q hgrange hhrange hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hrel - hpi hqj hpi1 hqj1 hcpos hc_le_one hφR Ag Bg Ah Bh hgR hhR - have hvel : ((xR : Real) - (xL : Real)) • Bg = ((r2 : Real) - (r1 : Real)) • Bh := - ArcComparisonCoreFacts.hvel S g h p q hgrange hhrange hgfun_inj hhfun_inj hgfun_surj - hhfun_surj hgfun_cont hhfun_cont hpi hqj hpi1 hqj1 hcpos hc_le_one Ag Bg Ah Bh hEqL - hEqR + have hEqL : Ag + (xL : Real) • Bg = Ah + (r1 : Real) • Bh := + hgL.symm.trans ((hrel xL).symm.trans ((congrArg h hφL).trans hhL)) + have hEqR : Ag + (xR : Real) • Bg = Ah + (r2 : Real) • Bh := + hgR.symm.trans ((hrel xR).symm.trans ((congrArg h hφR).trans hhR)) + have hvel : ((xR : Real) - (xL : Real)) • Bg = ((r2 : Real) - (r1 : Real)) • Bh := by + calc + ((xR : Real) - (xL : Real)) • Bg = + (Ag + (xR : Real) • Bg) - (Ag + (xL : Real) • Bg) := by module + _ = (Ah + (r2 : Real) • Bh) - (Ah + (r1 : Real) • Bh) := by rw [hEqR, hEqL] + _ = ((r2 : Real) - (r1 : Real)) • Bh := by module let scale : Real := ((xR : Real) - (xL : Real)) / ((r2 : Real) - (r1 : Real)) have hscale_pos : 0 < scale := by dsimp [scale] exact div_pos (sub_pos.mpr (by exact_mod_cast hxLR)) (sub_pos.mpr hr12) - have hscale := ArcComparisonGeometry.hscale S g h p q hgrange hhrange - hgfun_inj hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hpi hqj hpi1 hqj1 hcpos - hc_le_one hr12 Bg Bh hvel + have hscale := ArcComparisonGeometry.hscale (xL : Real) (xR : Real) (r1 : Real) (r2 : Real) + Bg Bh hr12 hvel let z : Real × Real := g xL have hplowLstrict : p.time i0.castSucc < (xL : Real) := by rw [hiCast, hpstart] @@ -1314,10 +587,8 @@ private theorem compareCore : rw [hz] at hh change P3934T1LocalSide U₂ (g xL) Bh d at hh exact hh - have localResult := ArcComparisonGeometry.localResult S e d U₁ U₂ g h p q hgrange hhrange - hgfun_inj - hhfun_inj hgfun_surj hhfun_surj hgfun_cont hhfun_cont hpi hqj hpi1 hqj1 hcpos - hc_le_one Bg hBg Bh hscale_pos hscale hlocG hlocH + have localResult := ArcComparisonGeometry.localResult U₁ U₂ e d z Bg Bh scale hBg + hscale_pos hscale hlocG hlocH exact localResult end ArcComparisonMainProof diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSidePropagation.lean b/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSidePropagation.lean index 40e5db450e..b940f4dcfd 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSidePropagation.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1PolygonalSidePropagation.lean @@ -614,9 +614,6 @@ private theorem pieceConstant : · have hl : i.succ ≤ Fin.last (s k).count := Fin.le_last _ calc (s k).time i.succ ≤ (s k).time (Fin.last (s k).count) := (s k).strict.monotone hl _ = 1 := (s k).finish⟩ - have hab : a < b := by - change (s k).time i.castSucc < (s k).time i.succ - exact (s k).strict Fin.castSucc_lt_succ let I := Set.Ioo a b let param (x : I) : Set.Icc (0 : Real) 1 := x.1 let point (t : Set.Icc (0 : Real) 1) @@ -1679,8 +1676,6 @@ theorem P3934T1PolygonalSidePropagation (ht : g l t = g k ⟨1, by norm_num⟩) := PolygonSidePropagation.joinPreimage g hi hjoin hv hinter k l t ht let first (k : Fin 3) : Fin (s k).count := ⟨0, (s k).positive⟩ - let last (k : Fin 3) : Fin (s k).count := - ⟨(s k).count - 1, by have := (s k).positive; omega⟩ have joinSignAgree (k : Fin 3) := PolygonSidePropagation.joinSignAgree g s hi hjoin hinter U pieceSide vertexLabels isolateNeighborhood next_ne joinPreimage k have arcAgree (k : Fin 3) := PolygonSidePropagation.arcAgree g s U pieceSide signChain diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean b/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean index 891f7ad7b5..3847f8f2cf 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean @@ -548,12 +548,6 @@ private theorem sampleA : have heq : qplus' - z = ε • j := by simp [qplus'] rw [heq, norm_smul, Real.norm_eq_abs, abs_of_pos hε, hjnorm] simpa using hεη) - have hqminusB : 0 < B qminus' := hηsub (by - change dist qminus' z < η - rw [dist_eq_norm] - have heq : qminus' - z = -(ε • j) := by simp [qminus', sub_eq_add_neg] - rw [heq, norm_neg, norm_smul, Real.norm_eq_abs, abs_of_pos hε, hjnorm] - simpa using hεη) have hAplus : A qplus' = ε * (a.1 ^ 2 + a.2 ^ 2) := by dsimp [A, qplus', z, j, det] ring @@ -640,12 +634,6 @@ private theorem sampleB : have heq : qminus' - z = -(ε • j) := by simp [qminus', sub_eq_add_neg] rw [heq, norm_neg, norm_smul, Real.norm_eq_abs, abs_of_pos hε, hjnorm] simpa using hεδ - have hqplusA : 0 < A qplus' := hηsub (by - change dist qplus' z < η - rw [dist_eq_norm] - have heq : qplus' - z = ε • j := by simp [qplus'] - rw [heq, norm_smul, Real.norm_eq_abs, abs_of_pos hε, hjnorm] - simpa using hεη) have hqminusA : 0 < A qminus' := hηsub (by change dist qminus' z < η rw [dist_eq_norm] @@ -2105,9 +2093,6 @@ private theorem nondegenerateContinuation : have hCopen := SectorContinuationFacts.hCopen x r u v hAcont have hDopen := SectorContinuationFacts.hDopen x r u v hBcont have hC₂open := SectorContinuationFacts.hC₂open x r u v hCopen hDopen - have hC₁conv := SectorContinuationGeometry.hC₁conv x r u v - have hCconv := SectorContinuationGeometry.hCconv x r u v - have hDconv := SectorContinuationGeometry.hDconv x r u v have hsumNorm := SectorContinuationFacts.hsumNorm u v ha hb have hr4 : 0 < r / 4 := by positivity let qpos : Real × Real := x + (r / 4) • (a + b) @@ -2117,21 +2102,11 @@ private theorem nondegenerateContinuation : have hBqpos : B qpos = (r / 4) * d' := SectorContinuationFacts.hBqpos x r u v have hqposA : 0 < A qpos := by rw [hAqpos]; positivity have hqposB : 0 < B qpos := by rw [hBqpos]; positivity - have hC₁ne : C₁.Nonempty := ⟨qpos, ⟨⟨hqposball, hqposA⟩, hqposB⟩⟩ - have hC₁conn : IsConnected C₁ := hC₁conv.isConnected hC₁ne let qneg : Real × Real := x - (r / 4) • (a + b) have hqnegb := SectorContinuationFacts.hqnegbAt1364 x r u v hr hsumNorm hr4 have hAqneg := SectorContinuationFacts.hAqnegAt1373 x r u v - have hBqneg := SectorContinuationFacts.hBqneg x r u v have hqnegA := SectorContinuationFacts.hqnegAAt1379 x r u v hAqpos hqposA hAqneg - have hqnegB := SectorContinuationFacts.hqnegB x r u v hAqpos hqposA hBqneg - have hCne : C.Nonempty := ⟨qneg, ⟨hqnegb, hqnegA⟩⟩ - have hDne : D.Nonempty := ⟨qneg, ⟨hqnegb, hqnegB⟩⟩ - have hCDne : (C ∩ D).Nonempty := ⟨qneg, ⟨⟨hqnegb, hqnegA⟩, ⟨hqnegb, hqnegB⟩⟩⟩ - have hCconn : IsConnected C := hCconv.isConnected hCne - have hDconn : IsConnected D := hDconv.isConnected hDne - have hC₂conn := SectorContinuationFacts.hC₂conn x r u v hCDne hCconn hDconn have horder := SectorContinuationFacts.horder u v have haRay (k : Real) (hk : 0 ≤ k) := SectorContinuationFacts.haRay x u v horder k hk have hbRay (k : Real) (hk : 0 ≤ k) := SectorContinuationFacts.hbRay x u v horder k hk @@ -2311,26 +2286,6 @@ private theorem oppositeContinuation : have hAcont := SectorContinuationFacts.hAcontAt1604 x u have hPopen := SectorContinuationFacts.hPopen x r u hAcont have hNopen := SectorContinuationFacts.hNopen x r u hAcont - let f : (Real × Real) →ᵃ[Real] Real := { - toFun := A - linear := { - toFun := fun y => det u y - map_add' := by - intro y z - dsimp [det] - ring - map_smul' := by - intro c y - dsimp [det] - ring - } - map_vadd' := by - intro p y - dsimp [A, det] - ring - } - have hPconv := SectorContinuationFacts.hPconv x r u - have hNconv := SectorContinuationFacts.hNconv x r u have hu0 : u ≠ (0, 0) := hu_ne have hsqpos := SectorContinuationFacts.hsqpos u hu0 let j : Real × Real := (-u.2, u.1) @@ -2347,10 +2302,6 @@ private theorem oppositeContinuation : x r u have hqposA : 0 < A qpos := by rw [hAqpos]; exact mul_pos hr4 hsqpos have hqnegA := SectorContinuationFacts.hqnegAAt1672 x r u hsqpos hr4 hAqneg - have hPne : P.Nonempty := ⟨qpos, hqposball, hqposA⟩ - have hNne : N.Nonempty := ⟨qneg, hqnegb, hqnegA⟩ - have hPconn : IsConnected P := hPconv.isConnected hPne - have hNconn : IsConnected N := hNconv.isConnected hNne have hdis := SectorContinuationFacts.hdisAt1679 x r u let Rays : Set (Real × Real) := {p | ∃ t : Real, 0 ≤ t ∧ p = x + t • u} ∪ diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean index eb2d837fa4..6dbb0353e7 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean @@ -466,7 +466,6 @@ private theorem noThreeNeighbors : exact edgeEndpointInW edge hedge z hze let : Finite (Subtype X) := (hWfinite.subset hXsubset).to_subtype have hEsub : E ⊆ F := by intro edge hedge; exact hedge - have hXends : X = {z | ∃ edge ∈ E, z ∈ edge} := rfl have hcycle' : SimpleGridCycle W F := by exact ⟨p, u, v, hnodup, hlen, hhead, hlast, hvertices, hclose, hsteps, hedges⟩ @@ -1923,7 +1922,6 @@ theorem P3963T1ExteriorMixedCycleObstruction have hlen3 : 3 ≤ p.length := by omega have hcross := GridRayCrossingIndexAdjacentCell p u v hhead hlast hnodup hlen3 (ExteriorMixedCycleProof.hadj p hlen hsteps) hclose - have hmixed : e ≠ f := ExteriorIndexCases.hmixed U V hedge F e f he hf have hUedge : e ∈ FootprintEdges U := he.2 have hVedge : f ∈ FootprintEdges V := hf.2 have hcycleEdge (g : Finset GaussianInt) (hg : g ∈ F) : @@ -1982,12 +1980,6 @@ theorem P3963T1ExteriorMixedCycleObstruction have inExterior (q : GaussianInt) (hu : q ∉ U.cells) (hv : q ∉ V.cells) : q ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ := ExteriorIndexCases.inExterior U V q hu hv - have hExteriorPair : - (c1 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ ∧ - c3 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ) ∨ - (c0 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ ∧ - c2 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ) := ExteriorMixedCycleProof.hExteriorPair - U V x no01 no10 no12 no21 no23 no32 no30 no03 hpattern inExterior have pairCases (a b c d : GaussianInt) (hpair : ({a, b} : Finset GaussianInt) = {c, d}) (hcd : c ≠ d) : (a = c ∧ b = d) ∨ (a = d ∧ b = c) := ExteriorMixedCycleProof.pairCases a b c d hpair hcd @@ -2004,7 +1996,6 @@ theorem P3963T1ExteriorMixedCycleObstruction (b, a) ∈ (p.zip p.tail) ++ [(v, u)] := ExteriorMixedCycleProof.cyclicPair F p u v hhead hlast hclose hsteps hedges hcross hcycleEdge (ExteriorMixedCycleProof.adjNe) pairCases (ExteriorMixedCycleProof.adjacentMemZip) a b hab - have hpne : p ≠ [] := ExteriorIndexCases.hpne p hlen have huMem : u ∈ p := ExteriorIndexCases.huMem p u hhead have hvMem : v ∈ p := ExteriorIndexCases.hvMem p v hlast have vertexInW (z : GaussianInt) (hz : z ∈ p) : z ∈ W := ExteriorIndexCases.vertexInW W p @@ -2019,10 +2010,6 @@ theorem P3963T1ExteriorMixedCycleObstruction | 1 => x + 1 | 2 => x - ⟨0, 1⟩ | _ => x - 1 - let nDir : Fin 4 := 0 - let eDir : Fin 4 := 1 - let sDir : Fin 4 := 2 - let wDir : Fin 4 := 3 have dirInj : Function.Injective dir := ExteriorIndexCases.dirInj x have dirNeX (i : Fin 4) : x ≠ dir i := ExteriorIndexCases.dirNeX x i have noThreeDir (i j k : Fin 4) @@ -2064,7 +2051,6 @@ theorem P3963T1ExteriorMixedCycleObstruction (GridRayCrossingIndex (q + ⟨0, 1⟩) p - GridRayCrossingIndex q p).natAbs = 1 := (hcross q).2.2.2 hcyc have c1add : c1 + 1 = x := by dsimp [c1]; ring - have c1addi : c1 + 1 + ⟨0, 1⟩ = x + ⟨0, 1⟩ := by dsimp [c1]; ring have c2add : c2 + 1 = x - ⟨0, 1⟩ := by dsimp [c2]; ring have c2addi : c2 + 1 + ⟨0, 1⟩ = x := by dsimp [c2]; ring have c2i : c2 + ⟨0, 1⟩ = x - 1 := by dsimp [c2]; ring diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean index 87f6ae69a8..206c5c97b3 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean @@ -339,8 +339,6 @@ private theorem hp₁ne : intro p₁ hlen₁ h simp [h] at hlen₁ -private abbrev hp₂ne := ApollonianSuperharmonic.MixedCycleDetails.hp₁ne - private theorem hx₁ : ∀ (V₁ : Set GaussianInt), ∀ (V₂ : Set GaussianInt), ∀ (p₁ : List GaussianInt), (V₁ = (↑p₁.toFinset : Set GaussianInt)) → (∀ (x : GaussianInt), (x ∈ V₁ ∩ V₂) → (x ∈ p₁)) := by @@ -357,8 +355,6 @@ private theorem hx₂ : rw [hV₂] at hx exact List.mem_toFinset.mp hx.2 -private abbrev hy₁ := ApollonianSuperharmonic.MixedCycleDetails.hx₁ - private abbrev hy₂ := ApollonianSuperharmonic.MixedCycleDetails.hx₂ private theorem hrot₁x : @@ -1220,16 +1216,11 @@ theorem P3963T1MixedBoundaryCycle hadj₂, hedge₂⟩ := h₂ have hcommon := MixedCycleDetails.hcommon V₁ V₂ hmultiple obtain ⟨x, y, hx, hy, hxy⟩ := hcommon - have hp₁ne := MixedCycleDetails.hp₁ne p₁ hlen₁ - have hp₂ne := MixedCycleDetails.hp₂ne p₂ hlen₂ have hx₁ := MixedCycleDetails.hx₁ V₁ V₂ p₁ hV₁ x hx have hx₂ := MixedCycleDetails.hx₂ V₁ V₂ p₂ hV₂ x hx - have hy₁ := MixedCycleDetails.hy₁ V₁ V₂ p₁ hV₁ y hy have hy₂ := MixedCycleDetails.hy₂ V₁ V₂ p₂ hV₂ y hy have hidx₁x : p₁.idxOf x < p₁.length := List.idxOf_lt_length_iff.mpr hx₁ - have hidx₁y : p₁.idxOf y < p₁.length := List.idxOf_lt_length_iff.mpr hy₁ have hidx₂x : p₂.idxOf x < p₂.length := List.idxOf_lt_length_iff.mpr hx₂ - have hidx₂y : p₂.idxOf y < p₂.length := List.idxOf_lt_length_iff.mpr hy₂ have hrot₁x := MixedCycleDetails.hrot₁x p₁ x hx₁ hidx₁x have hrot₂x := MixedCycleDetails.hrot₂x p₂ x hx₂ hidx₂x have cycle_chain (p : List GaussianInt) (a b : GaussianInt) diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean b/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean index 22338dca0a..e984d46420 100644 --- a/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean +++ b/LeanPool/ApollonianSuperharmonic/P3996T1PlacementCompanionBlocks.lean @@ -1094,19 +1094,6 @@ theorem P3996T1PlacementCompanionBlocks (PlacementCompanionGeometry.exterior_area C D T N h k x bundle placement (PlacementCompanionGeometry.occurrence_area C D T N h k x bundle placement area_of_band area_translation)) - let pieceOffset : Real × Real := - GaussianRealPoint - (BandVectors.1 - (bundle.normalizedPresentation ((bundle.selectedSlot + 2).succ)) - (bundle.normalizedPresentation ((bundle.selectedSlot + 1).succ))) - - (-((GaussianRealPoint - (BandVectors.1 - (bundle.normalizedPresentation ((bundle.selectedSlot + 2).succ)) - (bundle.normalizedPresentation ((bundle.selectedSlot + 1).succ)))).2), - (GaussianRealPoint - (BandVectors.1 - (bundle.normalizedPresentation ((bundle.selectedSlot + 2).succ)) - (bundle.normalizedPresentation ((bundle.selectedSlot + 1).succ)))).1) have flip_incoming := PlacementCompanionGeometry.flip_incoming C D T N h k x bundle let I : GaussianInt := ⟨0, 1⟩ let branchDisplacement (i : Fin 3) : Real × Real := @@ -1127,8 +1114,6 @@ theorem P3996T1PlacementCompanionBlocks let cOff (w : GaussianInt) : Real × Real := (1 / 2 : Real) • (GaussianRealPoint w - (-(GaussianRealPoint w).2, (GaussianRealPoint w).1)) - let edgeCenter (a : GaussianInt) : Real × Real := - (1 / 2 : Real) • GaussianRealPoint ((I - 1) * a) have cancel2 := PlacementCompanionGeometry.cancel2 have gp_neg_any := PlacementCompanionGeometry.gp_neg_any let q := bundle.normalizedPresentation diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean b/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean index 2e96cb4791..ce9a16160f 100644 --- a/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean +++ b/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean @@ -931,12 +931,10 @@ theorem P3996T1SRowAlignment (SubtileOccurrenceInterpretation cert.P cert.u cert.v ⟨.F, m, n⟩) := SRowAlignmentGeometry.occF q cfg C T cert m n have cellsTranslate := TileTranslationProperties.cells - have anchorTranslate := SRowAlignmentGeometry.anchorTranslate have centroidTranslate := SRowAlignmentGeometry.centroidTranslate have translationCentroidGP (X : ProtoTile) (d : GaussianInt) : TileCentroid (TileTranslation X d) = TileCentroid X + GaussianRealPoint d := SRowAlignmentGeometry.translationCentroidGP centroidTranslate X d - have composeCells := SRowAlignmentGeometry.composeCells cellsTranslate have composeCellsEq := SRowAlignmentGeometry.composeCellsEq cellsTranslate have composeAnchor (X : ProtoTile) (s d : GaussianInt) : (TileTranslation (TileTranslation X s) d).anchor = @@ -947,7 +945,6 @@ theorem P3996T1SRowAlignment t h let I : GaussianInt := ⟨0, 1⟩ have hI2 : I * I = -1 := by dsimp [I]; apply Zsqrtd.ext <;> norm_num - have hIinv : -I * I = 1 := by rw [show -I * I = -(I * I) by ring, hI2]; norm_num have cI2 : (GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) ^ 2 = -1 := by norm_num [GaussianInt.toComplex_def] have cI3 : (GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt)) ^ 3 = @@ -987,17 +984,6 @@ theorem P3996T1SRowAlignment q10 qflip1 have certV : cert.v = I * edgeVector + w := SRowAlignmentGeometry.certV q cfg C T cert hI2 qflip2 q20 - have rflip1 := (VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).2.2.2.2 - cfg.firstProper 1 |>.1 - have rflip2 := (VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).2.2.2.2 - cfg.firstProper 2 |>.1 - have rvec2 : BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = I * edgeVector := - SRowAlignmentGeometry.rvec2 q cfg rflip1 - have rvec3 : BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = I * (edgeVector - + w) := - SRowAlignmentGeometry.rvec3 q cfg hIinv q13 rflip2 - have tvec1 : BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) = I * w := - SRowAlignmentGeometry.tvec1 q cfg have qnormal : BandVectors.1 (q 1) (q 2) = I * edgeVector := SRowAlignmentGeometry.qnormal q cfg have q31 : BandVectors.1 (q 3) (q 1) = I * (edgeVector + w) := SRowAlignmentGeometry.q31 q cfg diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean index 574aa4084e..6481bd596b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean @@ -820,9 +820,6 @@ private theorem hdispR : (∀ (x : GaussianInt), q3 x = q ^ (3 : ℕ) * x) → q3 vR = uL) := by classical intro r i s q t hq2 hq3 hq2act uL q3 vR even0 even2 notEven1 notEven3 hq3mul - let uR : GaussianInt := q ^ s.val * - (if Even s.val then BandVectors.1 (r 0) (r i.succ) - else BandVectors.1 (r i.succ) (r 0)) rw [hq3mul] fin_cases s <;> simp [vR, uL, t, even0, even2, notEven1, notEven3, hq2, hq3] <;> @@ -1099,8 +1096,6 @@ theorem P4055T1OrderedGeneralOppositeEndpoints : have hq4 := OppositeEndpointGeometry.hq4 hq2 have hq3 := OppositeEndpointGeometry.hq3 hq2 have hq2act := OppositeEndpointGeometry.hq2act hq2 - have hq4act := OppositeEndpointGeometry.hq4act hq4 - have hq6act := OppositeEndpointGeometry.hq6act (OppositeEndpointGeometry.hq6 hq2) have hpower := OppositeEndpointGeometry.hpower s hq2 hq4 have hWsrc : TileCentroid Wp - TileCentroid U = (1 / 2 : Real) • GaussianRealPoint (q ^ t.val * @@ -1155,8 +1150,6 @@ theorem P4055T1OrderedGeneralOppositeEndpoints : α) (β := β) (γ := γ) g h S have hFchildV := OppositeEndpointGeometry.hFchildV U aU hFvU hFtranslate setImageComp have hFchildE := OppositeEndpointGeometry.hFchildE U aU hFeU hFtranslateE setImageComp - let q3 : GaussianInt → GaussianInt := fun x => - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn x)) have hQq3 := OppositeEndpointGeometry.hQq3 have hbaseV := OppositeEndpointGeometry.hbaseV U aU hFvU hinvV diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean index c2963aee34..ac144a28a3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean @@ -1301,8 +1301,6 @@ private theorem hZ' : 1).succ))) → (BandPrototile (qg j.succ) (BandPackingSymmetryTileAction g' Z)))) ) := by classical intro r i s Z hZ a q g' qg k htileCov t j hZlabel - let sigma : Fin 3 → Fin 3 := fun m => - if BandPackingSymmetryReversesOrientation g' then -m else m rw [hZlabel] exact (htileCov.2.1 (r ((if Even s.val then i - 1 else i + 1).succ)) Z).mp hZ @@ -1337,8 +1335,6 @@ private theorem hUpos' : := by classical intro r hUpos a q g' qg htileCov hrootLabel - let sigma : Fin 3 → Fin 3 := fun m => - if BandPackingSymmetryReversesOrientation g' then -m else m rw [hrootLabel, htileCov.1] exact hUpos @@ -1374,8 +1370,6 @@ private theorem hWpos' : k.succ).1))) ) := by classical intro r i hWpos a q g' qg k htileCov hWlabel - let sigma : Fin 3 → Fin 3 := fun m => - if BandPackingSymmetryReversesOrientation g' then -m else m rw [hWlabel, htileCov.1] exact hWpos @@ -1417,8 +1411,6 @@ private theorem hZpos' : 1).succ))) → (0 < (qg j.succ).1))) ) := by classical intro r i s hZpos a q g' qg k htileCov t j hZlabel - let sigma : Fin 3 → Fin 3 := fun m => - if BandPackingSymmetryReversesOrientation g' then -m else m rw [hZlabel, htileCov.1] exact hZpos @@ -1979,9 +1971,6 @@ theorem P4055T1PlacementNormalization have hproperG : ProperBandQuadruple qg := BandPackingSymmetryProperCovariance g' q hq have htileCov := BandPackingSymmetryCovariance g' - let U' : ProtoTile := BandPackingSymmetryTileAction g' U - let W' : ProtoTile := BandPackingSymmetryTileAction g' W - let Z' : ProtoTile := BandPackingSymmetryTileAction g' Z have hU' := PlacementNormalizationProof.hU' r U hU a g g' horientg htileCov have hWlabel := PlacementNormalizationProof.hWlabel r i a g' @@ -2016,27 +2005,18 @@ theorem P4055T1PlacementNormalization have hnegVal (s₀ : Fin 4) := PlacementNormalizationProof.hnegVal s₀ let ii : GaussianInt := ⟨0, 1⟩ have iiSq : ii ^ 2 = -1 := by decide +kernel - have iiSqLiteral : (⟨0, 1⟩ : GaussianInt) ^ 2 = -1 := by decide +kernel have iiMul : ii * ii = -1 := by simpa [pow_two] using iiSq - have iiCancel (x : GaussianInt) := PlacementNormalizationProof.iiCancel iiSq x - have iiCancelLiteral (x : GaussianInt) := PlacementNormalizationProof.iiCancelLiteral - iiSqLiteral x have iiSquareMul (x : GaussianInt) := PlacementNormalizationProof.iiSquareMul iiMul x have iiNegSquareMul (x : GaussianInt) := PlacementNormalizationProof.iiNegSquareMul iiSquareMul x - have iiCaseA (x : GaussianInt) := PlacementNormalizationProof.iiCaseA iiSq x - have iiCaseB (x : GaussianInt) := PlacementNormalizationProof.iiCaseB iiSq x - have iiCaseC (x : GaussianInt) := PlacementNormalizationProof.iiCaseC iiSq x have iiCaseA' (x : GaussianInt) := PlacementNormalizationProof.iiCaseA' iiNegSquareMul x have iiCaseB' (x : GaussianInt) := PlacementNormalizationProof.iiCaseB' iiNegSquareMul x have iiCaseC' (x : GaussianInt) := PlacementNormalizationProof.iiCaseC' iiSquareMul x have iiCaseD' (x : GaussianInt) := PlacementNormalizationProof.iiCaseD' iiSquareMul x - have iiCaseE (x : GaussianInt) := PlacementNormalizationProof.iiCaseE iiSq x have iiZCaseA (x : GaussianInt) := PlacementNormalizationProof.iiZCaseA iiNegSquareMul x have iiZCaseB (x : GaussianInt) := PlacementNormalizationProof.iiZCaseB iiNegSquareMul x have iiZCaseC (x : GaussianInt) := PlacementNormalizationProof.iiZCaseC iiSquareMul x have iiZCaseD (x : GaussianInt) := PlacementNormalizationProof.iiZCaseD iiSquareMul x have iiCube := PlacementNormalizationProof.iiCube iiSq - have iiFourth := PlacementNormalizationProof.iiFourth iiMul iiCube have negIiSq := PlacementNormalizationProof.negIiSq iiMul have negIiCube := PlacementNormalizationProof.negIiCube negIiSq have ladd (g₀ : BandPackingSymmetry) (x y : GaussianInt) := PlacementNormalizationProof.ladd g₀ @@ -2053,7 +2033,6 @@ theorem P4055T1PlacementNormalization ii * BandVectors.1 (qg k.succ) (qg 0) := PlacementNormalizationProof.hbackEqual r i a g' hvectorForward hvectorBackward lquarter hflip let vR := BandVectors.1 (r i.succ) (r 0) - let vL := BandVectors.1 (r 0) (r i.succ) let vR' := BandVectors.1 (qg k.succ) (qg 0) let vL' := BandVectors.1 (qg 0) (qg k.succ) have hbackEq' : vL' = ii * vR' := by @@ -2087,8 +2066,6 @@ theorem P4055T1PlacementNormalization hphaseForward hZsigma' have hZphaseBackward := PlacementNormalizationProof.hZphaseBackward r i s a g' cyclicCancel hphaseBackward hZsigma' - let xZ := BandVectors.1 (r adj.succ) (r 0) - let yZ := BandVectors.1 (r 0) (r adj.succ) let xZ' := BandVectors.1 (qg j.succ) (qg 0) let yZ' := BandVectors.1 (qg 0) (qg j.succ) have hZflip : yZ' = ii * xZ' := @@ -2104,10 +2081,6 @@ theorem P4055T1PlacementNormalization have hUpos' := PlacementNormalizationProof.hUpos' r hUpos a g' htileCov hrootLabel have hWpos' := PlacementNormalizationProof.hWpos' r i hWpos a g' htileCov hWlabel have hZpos' := PlacementNormalizationProof.hZpos' r i s hZpos a g' htileCov hZlabel - let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := - BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) - (fun p => (-p.1, p.2)) (fun _ p => p) - (fun _ _ f k p => f (k p)) have rsub (g₀ : BandPackingSymmetry) (p q₀ : Real × Real) := PlacementNormalizationProof.rsub g₀ p q₀ have rsmul (g₀ : BandPackingSymmetry) (c : Real) (p : Real × Real) := @@ -2122,7 +2095,6 @@ theorem P4055T1PlacementNormalization rcentroid have hWvec := PlacementNormalizationProof.hWvec r i s a g' hdispW have hWcentNorm := PlacementNormalizationProof.hWcentNorm r i s U W a g' hWcent' hWvec - have hZvec' := PlacementNormalizationProof.hZvec' r i s a g' hZvec have hZcentNorm := PlacementNormalizationProof.hZcentNorm r i s U Z a g' hZvec hZcent' have hvR : BandPackingSymmetryVectorAction g' vR = vR' := by simpa [vR, vR'] using hvectorForward.symm diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean index 5db0e52155..06004f09db 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean @@ -38,7 +38,6 @@ private theorem hq1pos : have hd := P.det₁ rw [hz] at hd simp only [Nat.cast_zero, zero_mul] at hd - have hqint : 2 < (P.q : Int) := by exact_mod_cast hP by_cases hp : P.p₁ ≤ 0 · have hqnonneg : 0 ≤ (P.q : Int) := by omega have : P.p₁ * (P.q : Int) ≤ 0 := mul_nonpos_of_nonpos_of_nonneg hp hqnonneg @@ -401,16 +400,6 @@ theorem P4062T1InteriorGeometry (P : FordFareyParameter) 1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 ∧ (P.q₁ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1 := InteriorGeometryProof.mem3 P hsum squareCoordinates coord3 x - have bounds (i : Fin 4) (x : GaussianInt) (hx : x ∈ A i) : - (i = 0 → 1 ≤ x.re ∧ x.re ≤ (P.q₁ : Int)-1 ∧ - 1 ≤ x.im ∧ x.im ≤ (P.q₁ : Int)-1) ∧ - (i = 1 → (P.q₂ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ - (P.q₂ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1) ∧ - (i = 2 → (P.q₁ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ - 1 ≤ x.im ∧ x.im ≤ (P.q₂ : Int)-1) ∧ - (i = 3 → 1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 ∧ - (P.q₁ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1) := InteriorGeometryProof.bounds P coord0 - coord1 coord2 coord3 i x hx have adjacentCoordinates (x y : GaussianInt) (h : FourNeighborAdjacent x y) : (x.re = y.re ∧ (y.im = x.im+1 ∨ x.im = y.im+1)) ∨ (x.im = y.im ∧ (y.re = x.re+1 ∨ x.re = y.re+1)) := diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean b/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean index 6ea7304d81..6bab6a8269 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean @@ -452,7 +452,6 @@ theorem P4062T1LiteralReduction : have hqpos : 0 < P.q := P.q_pos obtain ⟨hfootSquare, hboundarySquare⟩ := P4062T1CanonicalSupport P.q P.q_pos have hFcells : (FordTile P.q).cells.Nonempty := LiteralReductionGeometry.hFcells P - have hTcells : T.cells.Nonempty := LiteralReductionGeometry.hTcells P T h k u htrans hFcells have htranslatedCells : (TileTranslation (FordTile P.q) u).cells.Nonempty := by simpa [TileTranslation] using hFcells.image (GaussianTranslation u) have hboundaryTransport : diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean index f15078e137..0d2a53d190 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean @@ -61,7 +61,6 @@ private theorem hpos₁ : have hm : P.p₁ * (P.q : Int) = 1 := by simpa using h calc 1 = P.p₁ * (P.q : Int) := hm.symm _ = (P.q : Int) * P.p₁ := by ring - have hq : 2 < (P.q : Int) := by exact_mod_cast hP have hl := Int.le_of_dvd (by norm_num : (0 : Int) < 1) hd omega @@ -350,30 +349,12 @@ private theorem htargetAt327 : (z-⟨(P.q₂ : Int), (P.q₂ : Int)⟩) + P.p₂*z.re + P.p₂*z.im - P.p₂*(P.q₂ : Int)+1 := by have hz0 := hrec0Member z (by omega) (by omega) (by omega) (by omega) - have hz1 : z ∈ FordRecursiveVertexDomains P 1 := by - apply hrec1Member z hzr ?_ hzi ?_ - · have hs : (P.q₁ : Int) + P.q₂ = P.q := by exact_mod_cast P.sum_q.symm - omega - · have hs : (P.q₁ : Int) + P.q₂ = P.q := by exact_mod_cast P.sum_q.symm - omega - have hy0 : z-⟨(P.q₂ : Int), (P.q₂ : Int)⟩ ∈ - FordRecursiveVertexDomains P₁ 0 := by - change 0 ≤ (z-⟨(P.q₂ : Int),(P.q₂ : Int)⟩).re ∧ - (z-⟨(P.q₂ : Int),(P.q₂ : Int)⟩).re ≤ (P₁.q₁ : Int) ∧ - 0 ≤ (z-⟨(P.q₂ : Int),(P.q₂ : Int)⟩).im ∧ - (z-⟨(P.q₂ : Int),(P.q₂ : Int)⟩).im ≤ (P₁.q₁ : Int) - rw [hparP.2.1] - simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, - ] - constructor <;> omega have hzchild1 : z ∈ FordRecursiveVertexDomains P₁ 1 := by change (P₁.q₂ : Int) ≤ z.re ∧ z.re ≤ (P₁.q : Int) ∧ (P₁.q₂ : Int) ≤ z.im ∧ z.im ≤ (P₁.q : Int) rw [hparP.2.2.2, hq₁] exact ⟨by omega, by omega, by omega, by omega⟩ have houter0 := hrec₀' z hz0 - have houter1 := hrec₁' z hz1 - have hchild0 := hch₀' (z-⟨(P.q₂ : Int),(P.q₂ : Int)⟩) hy0 have hchild1 := hch₁' z hzchild1 have hshift : z-⟨(P.q₂ : Int),(P.q₂ : Int)⟩ = z-⟨(P₁.q₂ : Int),(P₁.q₂ : Int)⟩ := by rw [hparP.2.2.2] @@ -854,7 +835,6 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) have hcrossdet := OverlapDescentDetails.hcrossdet P have hpos₁ := OverlapDescentDetails.hpos₁ P P₁ hP hq₁ hsum have hpos₂ : 0 < P.q₂ := P.q₂_pos - have hlt₁ : P.q₁ < P.q := P.q₁_lt have hlt₂ : P.q₂ < P.q := by omega have hred₁ := OverlapDescentDetails.hred₁ P hcrossdet obtain ⟨_, _, _, _, _, hfamilyRec⟩ := @@ -865,7 +845,6 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) have hrec₁' := OverlapDescentDetails.hrec₁' P P₁ hrec₁ have hrec₂' := OverlapDescentDetails.hrec₂' P P₂ hrec₂ - have hrec₃' := OverlapDescentDetails.hrec₃' P P₂ hrec₃ have hlapAffine (f f' : GaussianInt → Int) (x t : GaussianInt) (A B C : Int) (h0 : f x = f' (x - t) + A * x.re + B * x.im + C) @@ -888,10 +867,6 @@ theorem P4062T1OverlapDescent (P P₁ P₂ : FordFareyParameter) have hrec2Member (z : GaussianInt) (a : (P.q₁ : Int) ≤ z.re) (b : z.re ≤ (P.q : Int)) (c : 0 ≤ z.im) (d : z.im ≤ (P.q₂ : Int)) := OverlapDescentDetails.hrec2Member P z a b c d - have hrec3Member (z : GaussianInt) - (a : 0 ≤ z.re) (b : z.re ≤ (P.q₂ : Int)) - (c : (P.q₁ : Int) ≤ z.im) (d : z.im ≤ (P.q : Int)) := OverlapDescentDetails.hrec3Member P z - a b c d intro hr have hA0 : hr 0 = P4062T1InteriorSquare P.q₁ := by rfl have hA1 : hr 1 = (P4062T1InteriorSquare P.q₁).image diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean b/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean index ab8de80aab..5b99375c2e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1ParentalRestriction.lean @@ -43,7 +43,6 @@ private theorem hparent₁pos : calc 1 = P.p₁ * (P.q : Int) := hmul.symm _ = (P.q : Int) * P.p₁ := by ring - have hqint : 1 < (P.q : Int) := by exact_mod_cast hbig have hle := Int.le_of_dvd (by norm_num : (0 : Int) < 1) hdvd omega @@ -304,9 +303,7 @@ theorem P4062T1ParentalRestriction (P : FordFareyParameter) x ∈ P4062T1InteriorSquare q ↔ 1 ≤ x.re ∧ x.re ≤ (q : Int) - 1 ∧ 1 ≤ x.im ∧ x.im ≤ (q : Int) - 1 := FordInteriorSquareCoordinates.membership q x - have hqpos : 0 < P.q := P.q_pos have hsum : P.q = P.q₁ + P.q₂ := P.sum_q - have hparent₁ : P.q₁ < P.q := P.q₁_lt have hcrossdet : P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1 := by have hdet := P.det₁ have hsumI : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q @@ -431,7 +428,6 @@ theorem P4062T1ParentalRestriction (P : FordFareyParameter) rw [← he] at hcrossdet nlinarith only [hcrossdet] have hb := Int.le_of_dvd (by norm_num : (0 : Int) < 1) hd - have hp := P.q₂_pos omega refine ⟨P₁, P₂, hp₁, hq₁, hp₂, hq₂, ?_, ?_, hne, ?_⟩ · rw [hq₁] diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1BoundaryMultiplicity.lean b/LeanPool/ApollonianSuperharmonic/P4112T1BoundaryMultiplicity.lean index 32f8f1836a..55884248a5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1BoundaryMultiplicity.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1BoundaryMultiplicity.lean @@ -64,7 +64,6 @@ theorem P4112T1BoundaryMultiplicity (P : FordFareyParameter) (hP : 2 < P.q) : simp have hqNat := P.sum_q rw [hzero] at hqNat - have hqlarge : 2 < P.q₂ := by omega have hdet := P.det₁ rw [hq] at hdet rw [hzero] at hdet @@ -97,7 +96,6 @@ theorem P4112T1BoundaryMultiplicity (P : FordFareyParameter) (hP : 2 < P.q) : have hunit := Int.eq_one_of_dvd_one (by omega) hdiv exact_mod_cast hunit have hqNat := P.sum_q - have hqtwo : P.q = 2 := by omega omega have b0 : x ∈ LatticeVertexBoundary (FordRecursiveVertexDomains P 0) ↔ (0 : Int) ≤ x.re ∧ x.re ≤ P.q₁ ∧ (0 : Int) ≤ x.im ∧ x.im ≤ P.q₁ ∧ diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean index b40b0fb217..8d37804d7a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean @@ -38,7 +38,6 @@ private theorem hq1pos : have hd := P.det₁ rw [hz] at hd simp only [Nat.cast_zero, zero_mul] at hd - have hqint : 2 < (P.q : Int) := by exact_mod_cast hP by_cases hp : P.p₁ ≤ 0 · have hqnonneg : 0 ≤ (P.q : Int) := by omega have : P.p₁ * (P.q : Int) ≤ 0 := mul_nonpos_of_nonpos_of_nonneg hp hqnonneg @@ -61,7 +60,6 @@ private theorem hneq : have hd : (P.q₁ : Int) ∣ 1 := ⟨P.p₁ - P.p₂, hm.symm⟩ have hu : (P.q₁ : Int) = 1 := Int.eq_one_of_dvd_one (by exact_mod_cast (Nat.zero_le P.q₁)) hd - have hsum := P.sum_q omega private abbrev squareCoordinates := ApollonianSuperharmonic.FordInteriorSquareCoordinates.membership @@ -1778,7 +1776,6 @@ theorem P4112T1LowerNeighbors (P : FordFareyParameter) (hP : 2 < P.q) : (if x = (B j).2 then 0 else 1) := by -- BODY classical - have hgeom := P4112T1PathGeometry P hP have hq1pos := LowerNeighborGeometry.hq1pos P hP have hcross : P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 := by have h1 : P.p₁ * ((P.q₁ + P.q₂ : Nat) : Int) - @@ -1787,8 +1784,6 @@ theorem P4112T1LowerNeighbors (P : FordFareyParameter) (hP : 2 < P.q) : norm_num [Nat.cast_add] at h1 nlinarith [h1] have hsum : P.q = P.q₁ + P.q₂ := P.sum_q - have hsumInt : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by - exact_mod_cast hsum have hneq := LowerNeighborGeometry.hneq P hP hq1pos hcross hsum let B := P4062T1RemainderPaths P let d : GaussianInt → Nat := fun x => @@ -1800,13 +1795,10 @@ theorem P4112T1LowerNeighbors (P : FordFareyParameter) (hP : 2 < P.q) : ((B j).1.filter (fun y => FourNeighborAdjacent y x ∧ d y < d x)).card = (if x = (B j).2 then 0 else 1) have squareCoordinates (q : Nat) (z : GaussianInt) := LowerNeighborGeometry.squareCoordinates q z - have natAbs_form (z : Int) := LowerNeighborGeometry.natAbs_form z have d_on_path (j : Fin 2) (z : GaussianInt) (hz : z ∈ (B j).1) := LowerNeighborGeometry.d_on_path P hP j z hz have neighbor_filter (S : Finset GaussianInt) (x : GaussianInt) (ρ : GaussianInt → Nat) := LowerNeighborGeometry.neighbor_filter S x ρ - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs have count_eq (j : Fin 2) (x : GaussianInt) (hx : x ∈ (B j).1) := LowerNeighborGeometry.count_eq P d_on_path neighbor_filter j x hx have root_candidate_empty (S : Finset GaussianInt) (ρ : GaussianInt → Nat) diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean index 8bb7408891..2ff9946fb5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1ParentalNeighbors.lean @@ -72,7 +72,6 @@ private theorem q1pos : have hd := P.det₁ rw [hz] at hd simp only [Nat.cast_zero, zero_mul] at hd - have hqint : 2 < (P.q : Int) := by exact_mod_cast hP by_cases hp : P.p₁ ≤ 0 · have hqnonneg : 0 ≤ (P.q : Int) := by omega have : P.p₁ * (P.q : Int) ≤ 0 := mul_nonpos_of_nonpos_of_nonneg hp hqnonneg @@ -101,10 +100,6 @@ private theorem unequal : have hd : (P.q₁ : Int) ∣ 1 := ⟨P.p₁ - P.p₂, hm.symm⟩ have hu : (P.q₁ : Int) = 1 := Int.eq_one_of_dvd_one (by exact_mod_cast (Nat.zero_le P.q₁)) hd - have hq1 : P.q₁ = 1 := by exact_mod_cast hu - have hq2 : P.q₂ = 1 := by omega - have hq : P.q = 2 := by omega - have hqgt : 2 < P.q := by exact_mod_cast hP omega private theorem hsum : @@ -575,10 +570,6 @@ private theorem rowSmallRoot : rw [show (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) + 1 = ⟨(P.q₁ : Int)+1, (P.q₁ : Int)⟩ by ext <;> simp [Zsqrtd.re_add, Zsqrtd.im_add]] exact hright0 - have hup : ((⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) + ⟨0, 1⟩) ∈ E := by - rw [show (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) + ⟨0, 1⟩ = - ⟨(P.q₁ : Int), (P.q₁ : Int)+1⟩ by ext <;> simp []] - exact hup0 have hleft : ((⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) - 1) ∉ E := by rw [show (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) - 1 = ⟨(P.q₁ : Int)-1, (P.q₁ : Int)⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] @@ -587,17 +578,6 @@ private theorem rowSmallRoot : rw [show (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) - ⟨0, 1⟩ = ⟨(P.q₁ : Int), (P.q₁ : Int)-1⟩ by ext <;> simp [Zsqrtd.re_sub, Zsqrtd.im_sub]] exact hdown0 - have hne : (⟨(P.q₁ : Int)+1, (P.q₁ : Int)⟩ : GaussianInt) ≠ - ⟨(P.q₁ : Int), (P.q₁ : Int)+1⟩ := by - intro he - have hr := congrArg (fun z : GaussianInt => z.re) he - simp at hr - have hne' : ((⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) + 1) ≠ - ((⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) + ⟨0, 1⟩) := by - intro he - have hr := congrArg (fun z : GaussianInt => z.re) he - simp only [Zsqrtd.re_add, Zsqrtd.re_one] at hr - omega have hneDirect : ((⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) + 1) ≠ ⟨(P.q₁ : Int), (P.q₁ : Int)+1⟩ := by intro he @@ -714,12 +694,6 @@ private theorem rowSmall : have hi := congrArg (fun z : GaussianInt => z.im) he simp at hi omega - have hne' : ((⟨u, (P.q₁ : Int)⟩ : GaussianInt) + ⟨0, 1⟩) ≠ - (⟨u, (P.q₁ : Int)⟩ - ⟨0, 1⟩) := by - intro he - have hi := congrArg (fun z : GaussianInt => z.im) he - simp only [Zsqrtd.im_add, Zsqrtd.im_sub] at hi - omega have hneDirect : (⟨u, (P.q₁ : Int)+1⟩ : GaussianInt) ≠ ((⟨u, (P.q₁ : Int)⟩ : GaussianInt) - ⟨0, 1⟩) := by intro he diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean index e8e5fb35b0..af0ac34d03 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean @@ -53,7 +53,6 @@ private theorem hr : have hd := P.det₁ rw [hzero] at hd simp only [Nat.cast_zero, zero_mul] at hd - have hqint : 2 < (P.q : Int) := by exact_mod_cast hP by_cases hp : P.p₁ ≤ 0 · have hqnonneg : 0 ≤ (P.q : Int) := by omega have : P.p₁ * (P.q : Int) ≤ 0 := mul_nonpos_of_nonpos_of_nonneg hp hqnonneg @@ -1503,7 +1502,6 @@ theorem P4112T1PathGeometry (P : FordFareyParameter) (hP : 2 < P.q) : have hr := PathGeometryProof.hr P hP hsum have hrs := PathGeometryProof.hrs P hP hsum have horder := PathGeometryProof.horder P hrs - have hsumInt := PathGeometryProof.hsumInt P hsum have squareCoordinates (n : Nat) (x : GaussianInt) := PathGeometryProof.squareCoordinates n x have mem0 (x : GaussianInt) := PathGeometryProof.mem0 P squareCoordinates x @@ -1598,18 +1596,6 @@ theorem P4112T1PathGeometry (P : FordFareyParameter) (hP : 2 < P.q) : (hcoord : x.im = (s:Int)) (hpos : 0 ≤ x.re) (hbound : (s:Int) ≤ x.re) : d x = Nat.dist x.re.toNat s := PathGeometryProof.dSmall1H P natAbsDist dSmall1Root hsmall x hx hcoord hpos - have dLarge0Nat (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 0).1) : - d x = Nat.dist x.re.toNat r + Nat.dist x.im.toNat s := PathGeometryProof.dLarge0Nat P hsum - hs hr memB0Large natAbsDist dLarge0Root hlarge x hx - have dLarge1Nat (hlarge : s < r) (x : GaussianInt) (hx : x ∈ (B 1).1) : - d x = Nat.dist x.re.toNat s + Nat.dist x.im.toNat r := PathGeometryProof.dLarge1Nat P hs hr - memB1Large natAbsDist dLarge1Root hlarge x hx - have dSmall0Nat (hsmall : r < s) (x : GaussianInt) (hx : x ∈ (B 0).1) : - d x = Nat.dist x.re.toNat r + Nat.dist x.im.toNat r := PathGeometryProof.dSmall0Nat P hr - memB0Small natAbsDist dSmall0Root hsmall x hx - have dSmall1Nat (hsmall : r < s) (x : GaussianInt) (hx : x ∈ (B 1).1) : - d x = Nat.dist x.re.toNat s + Nat.dist x.im.toNat s := PathGeometryProof.dSmall1Nat P hsum - hs memB1Small natAbsDist dSmall1Root hsmall x hx have adjacentCoordinates (x y : GaussianInt) (ha : FourNeighborAdjacent x y) := PathGeometryProof.adjacentCoordinates x y ha have adjacentSymm {x y : GaussianInt} (ha : FourNeighborAdjacent x y) := diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean index 421a56dce1..1282b61dc8 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean @@ -170,13 +170,6 @@ private theorem fordCentroid : exact_mod_cast arithmetic rw [rangeSum] at arithmeticCast rw [hqcast] at arithmeticCast - have natIdentity : P.q * (P.q - 1) / 2 * 2 + P.q = P.q * P.q := by - rw [← Finset.sum_range_id P.q] - rw [Finset.sum_range_id_mul_two] - have hprod : P.q ≤ P.q * P.q := by nlinarith - rw [Nat.mul_sub_left_distrib] - simp only [Nat.mul_one] - rw [Nat.sub_add_cancel hprod] norm_num [Int.subNatNat, pow_two] have hreal : (((P.q : Int) * ((P.q : Int) - 1) / 2 : Int) : Real) * 2 = @@ -268,7 +261,6 @@ private theorem hrpos : intro P hP by_contra hn have hz : P.q₁ = 0 := by omega - have hqint : 1 < (P.q : Int) := by exact_mod_cast hP have hdet := P.det₁ rw [hz] at hdet have hdiv : (P.q : Int) ∣ 1 := by @@ -1242,7 +1234,6 @@ private theorem countFourConclusion : _ = 1 := by simpa [mul_comm, mul_left_comm, mul_assoc] using hdet have hdiv : (P.q₁ : Int) ∣ 1 := ⟨P.p₁ - P.p₂, hprod.symm⟩ have hroneInt := Int.eq_one_of_dvd_one (by omega : (0 : Int) ≤ P.q₁) hdiv - have hrone : P.q₁ = 1 := by exact_mod_cast hroneInt have hqone : P.q = 2 := by omega have hyre : y.re = 1 := by omega have hyim : y.im = 1 := by omega @@ -1479,12 +1470,6 @@ private theorem descent : incidentFootprint noBoundaryFour incidentOwner twoBoundaryCount multiplicityBound hno have hkle : Nat.card {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (S a.1 a.2)} ≤ 1 := by - have hmax : Nat.card {a : Fin 3 × Bool // - x ∈ BoundaryFootprintVertices (S a.1 a.2)} ≤ 4 := by - calc - Nat.card {a : Fin 3 × Bool // - x ∈ BoundaryFootprintVertices (S a.1 a.2)} = FordBoundaryMultiplicity P y := hcount - _ ≤ 4 := multiplicityBound omega obtain ⟨a, haCell⟩ := incidentOwner 0 have findInteriorOwner : ∃ b : Fin 3 × Bool, ∃ j : Fin 4, @@ -1552,7 +1537,6 @@ theorem P4120T1FordGeometry have hne := InteriorFootprintIncidence.nonempty T x hx hxb have hsome := InteriorFootprintIncidence.someIncidentCell T x hx hxb hne have cells := InteriorFootprintIncidence.allIncidentCells T x hxb hsome - let y : GaussianInt := x - u have cellCanonical (z : GaussianInt) := FordTileGeometry.cellCanonical P T u hcells z have squareCell (z : GaussianInt) := FordTileGeometry.squareCell P z have hbounds := FordTileGeometry.hbounds P T u x cells cellCanonical squareCell @@ -1575,28 +1559,16 @@ theorem P4120T1FordGeometry have hparentCells (i : Fin 3) (s : Bool) := FordTileGeometry.hparentCells P T S u hS Sc hScTranslated hparentCentroid i s have hrpos := FordTileGeometry.hrpos P hP - have hr : (P.q₁ : Int) > 0 := by exact_mod_cast hrpos have ht : (P.q₂ : Int) > 0 := by exact_mod_cast P.q₂_pos have hqsum : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q have rectBoundary (l r b t : Int) (z : GaussianInt) := FordTileGeometry.rectBoundary l r b t z have boundaryTranslation (A : ProtoTile) (v z : GaussianInt) := FordTileGeometry.boundaryTranslation A v z - have footprintTranslation (A : ProtoTile) (v z : GaussianInt) := - FordTileGeometry.footprintTranslation A v z have hSc00 := FordTileGeometry.hSc00 P Sc h00 hrpos have hSc01 := FordTileGeometry.hSc01 P Sc h01 hrpos have hSc10 := FordTileGeometry.hSc10 P Sc h10 have hSc11 := FordTileGeometry.hSc11 P Sc h11 - have hSc00Foot := FordTileGeometry.hSc00Foot P Sc h00 hrpos - have hSc01Foot := FordTileGeometry.hSc01Foot P Sc h01 hrpos - have hSc10Foot := FordTileGeometry.hSc10Foot P Sc h10 - have hSc11Foot := FordTileGeometry.hSc11Foot P Sc h11 - have foot0 := FordTileGeometry.foot0 P S u x Sc hparentObs hrpos footprintTranslation hSc00Foot - have foot1 := FordTileGeometry.foot1 P S u x Sc hparentObs hrpos hqsum footprintTranslation - hSc01Foot - have foot2 := FordTileGeometry.foot2 P S u x Sc hparentObs hqsum footprintTranslation hSc10Foot - have foot3 := FordTileGeometry.foot3 P S u x Sc hparentObs hqsum footprintTranslation hSc11Foot have squareBoundary (n : Nat) (hn : 0 < n) (z : GaussianInt) := FordTileGeometry.squareBoundary n hn z have domain0 := FordTileGeometry.domain0 P u x rectBoundary diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean index 3766a57ce3..850c0bb038 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean @@ -1430,7 +1430,6 @@ private theorem hbound : classical intro q cfg C T cert x cells modified_cell_owner owner modifiedOwners modifiedOwnerCard BoundaryParents hupper - have hcard : modifiedOwners.card + 1 ≤ 4 := by omega omega end GeneralDescentGeometry @@ -1457,7 +1456,6 @@ theorem P4120T1GeneralDescent have modified_cell_owner := GeneralDescentGeometry.modified_cell_owner q cfg C T cert hOsub let owner : Fin 4 → PeriodicSubtileIndex := fun j => Classical.choose (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) - let I : GaussianInt := ⟨0, 1⟩ have owner_spec (j : Fin 4) : (owner j).first = 0 ∧ (owner j).second = 0 ∧ LatticeVertexIncidentCell x j ∈ (cert.modified.tile (owner j)).cells := Classical.choose_spec (modified_cell_owner (LatticeVertexIncidentCell x j) (cells j)) @@ -1484,7 +1482,6 @@ theorem P4120T1GeneralDescent (h : ({a, b} : Finset GaussianInt) = {c, d}) := GeneralDescentGeometry.pair_right_mem (a := a) (b := b) (c := c) (d := d) h have adjacent_of_edge := GeneralDescentGeometry.adjacent_of_edge q cfg C T cert - let modifiedOwners : Finset PeriodicSubtileIndex := Finset.univ.image owner change ((Nat.card {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} = 2 ∨ Nat.card {a : Fin 3 × Bool // @@ -1530,9 +1527,6 @@ theorem P4120T1GeneralDescent rcases another_parent with ⟨j, hj⟩ let BoundaryParents := {a : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (cert.P a.1 a.2)} - let p0 : BoundaryParents := ⟨parentOwner 0, parentOwner_boundary 0⟩ - let pj : BoundaryParents := ⟨parentOwner j, parentOwner_boundary j⟩ - let chooseTwo : Fin 2 → BoundaryParents := fun n => if n = 0 then p0 else pj have two_le_card : 2 ≤ Nat.card BoundaryParents := GeneralDescentGeometry.two_le_card q cfg C T cert x sourceParent parentOwner_boundary j (GeneralDescentGeometry.chooseTwo_injective q cfg C T cert x sourceParent parentOwner_boundary j (GeneralDescentGeometry.hp0j q @@ -1553,8 +1547,6 @@ theorem P4120T1GeneralDescent | (1, false) => .D | (2, true) => .E | (2, false) => .F - let originalIndex : Fin 3 × Bool → PeriodicSubtileIndex := fun p => - ⟨labelFromParent p, 0, 0⟩ have parent_label_roundtrip := GeneralDescentGeometry.parent_label_roundtrip let parentCellIndex : BoundaryParents → Fin 4 := fun p => Classical.choose (parent_boundary_incident_cell p.1.1 p.1.2 p.2) @@ -1562,12 +1554,6 @@ theorem P4120T1GeneralDescent LatticeVertexIncidentCell x (parentCellIndex p) ∈ (cert.P p.1.1 p.1.2).cells := Classical.choose_spec (parent_boundary_incident_cell p.1.1 p.1.2 p.2) - let ModOwner := {m : PeriodicSubtileIndex // m ∈ modifiedOwners} - let parentMap : BoundaryParents → Sum ModOwner Unit := fun p => - if p.1 = (0, true) then Sum.inr Unit.unit - else - let j := parentCellIndex p - Sum.inl ⟨owner j, Finset.mem_image.mpr ⟨j, Finset.mem_univ _, rfl⟩⟩ have hbound : Nat.card BoundaryParents ≤ 4 := GeneralDescentGeometry.hbound q cfg C T cert x cells modified_cell_owner (GeneralDescentGeometry.modifiedOwnerCard q cfg C T cert x cells modified_cell_owner @@ -1598,8 +1584,6 @@ theorem P4120T1GeneralDescent parent_label_roundtrip) (GeneralDescentGeometry.originalIndex_parent q cfg C T cert (GeneralDescentGeometry.tile_zero))) (GeneralDescentGeometry.hAB q cfg C T cert hseparation (GeneralDescentGeometry.htrans)) parentCellIndex_spec))) - have hlower : 2 ≤ Nat.card BoundaryParents := by - simpa [BoundaryParents] using two_le_card have hk : Nat.card BoundaryParents = 2 ∨ Nat.card BoundaryParents = 3 ∨ Nat.card BoundaryParents = 4 := by omega exact hcount (by simpa [BoundaryParents] using hk) diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1RootNormalization.lean b/LeanPool/ApollonianSuperharmonic/P4120T1RootNormalization.lean index d1fe0c56e4..14b84f8858 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1RootNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1RootNormalization.lean @@ -640,10 +640,6 @@ theorem P4120T1RootNormalization have hodo' := RootNormalizationGeometry.hodo' q T h hodo a s obtain ⟨g', hext', hlap⟩ := BandPackingSymmetryGlobalOdometerTransport s g h x hext - let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := - BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) - (fun p => (-p.1, p.2)) (fun _ p => p) - (fun _ _ f k p => f (k p)) have geom (r : BandPackingSymmetry) := RootNormalizationGeometry.geom r have hgeom := geom s have hinj (r : BandPackingSymmetry) := RootNormalizationGeometry.hinj r diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean index f218453114..7746913b33 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1EdgeSectorSelection.lean @@ -615,7 +615,6 @@ private theorem forward_support : have hzstep : ((z-1)-u).re = (z-u).re - 1 := by simp [Zsqrtd.re_sub] omega - have hneg : 0 ≤ -1 := by simpa [hzstep, hzr] using hb.1 omega private theorem reverse_support : @@ -1580,10 +1579,6 @@ private theorem he_ne_aAt984 : e).cells) → ((Disjoint T.cells Rplus.cells) → (e ≠ a))))))) ) := by classical intro Ci T Rplus PP x U a hUa U_in_T cf hcf n e he hEcell hEidx hdisET heq - have hcfA : cf ∈ (PP.tile a).cells := by simpa [hUa] using hcf - have hcfE : cf ∈ Rplus.cells := by - rw [← he] - simpa [heq] using hcfA have hnA : n ∈ (PP.tile a).cells := by simpa [heq] using hEidx have hnU : n ∈ U.cells := by simpa [hUa] using hnA exact (Finset.disjoint_left.mp hdisET) (U_in_T hnU) hEcell @@ -1601,10 +1596,6 @@ private theorem he_ne_bAt993 : e).cells) → ((Disjoint Rplus.cells T'.cells) → (e ≠ b))))))) ) := by classical intro Ci T' Rplus PP x V b hVb V_in_T' cb hcb n e he hEcell hEidx hdisET' heq - have hcbB : cb ∈ (PP.tile b).cells := by simpa [hVb] using hcb - have hcbE : cb ∈ Rplus.cells := by - rw [← he] - simpa [heq] using hcbB have hnB : n ∈ (PP.tile b).cells := by simpa [heq] using hEidx have hnV : n ∈ V.cells := by simpa [hVb] using hnB exact (Finset.disjoint_left.mp hdisET') hEcell (V_in_T' hnV) @@ -2147,7 +2138,6 @@ private theorem lowerBoundary : let m : GaussianInt := x - 1 - ⟨0,1⟩ have hqcast : ((P.q - 1 : Nat) : Int) = (P.q : Int) - 1 := by exact_mod_cast Nat.cast_sub (by omega : 1 ≤ P.q) - have hq1leq : P.q₁ ≤ P.q := by omega have hmc := EdgeSectorGeometry.hmcAt766 P u x hx hnatcast hqcast have hmTtrans := translated_ford_cell P.q (P.q - 1) (P.q₁ - 1) u (by omega) (by omega) @@ -2272,9 +2262,6 @@ theorem P4158T1EdgeSectorSelection : all_goals classical have regular_index := EdgeSectorGeometry.regular_index Ci base PP htiles - have same_index_of_cell (c : GaussianInt) (a b : TilingLattice Ci) - (ha : c ∈ (PP.tile a).cells) (hb : c ∈ (PP.tile b).cells) : a = b := - (PeriodicTileIndexedMultiplicityOne PP c).unique ha hb have vertical_edge_cells := EdgeSectorGeometry.vertical_edge_cells (EdgeSectorGeometry.pair_eq_iff) have translated_ford_bounds := EdgeSectorGeometry.translated_ford_bounds diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean index 41d844ccfe..140d1da982 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean @@ -914,7 +914,6 @@ theorem P4158T1LargeFirstRestrictions LargeFirstRestrictions.rootNonempty n hn z have hrootCent := LargeFirstRestrictions.hrootCent P T u hc rootNonempty have hrootCent' := LargeFirstRestrictions.hrootCent' P T' u hc' rootNonempty - have hw' := LargeFirstRestrictions.hw' P hvsol have hUoffset := LargeFirstRestrictions.hUoffset P T S hcent hvsol have hVoffset := LargeFirstRestrictions.hVoffset P T' S' hcent' hvsol have hUCcent := LargeFirstRestrictions.hUCcent P T u hq1 S fordCentroid diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean index af400ca8b0..e8eef25fed 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1LargeSecondRestrictions.lean @@ -71,7 +71,6 @@ private theorem hq0 : classical intro P hqgt have hq0sq : (1 : Int) < (P.q * P.q : Nat) := by - have hqreal : (1 : Int) < P.q := by exact_mod_cast hqgt have hqcast : (1 : Int) < (P.q : Int) * P.q := by nlinarith exact_mod_cast hqcast simpa [FordRecursiveQuadruple, FordCircleCoordinate] using hq0sq @@ -303,10 +302,6 @@ private theorem rootCentroidEq : (TileTranslation (FordTile P.q) u)) ) := by classical intro P T u hc - have hneF : (FordTile P.q).cells.Nonempty := by - refine ⟨0, ?_⟩ - apply Finset.mem_image.mpr - exact ⟨(0, 0), Finset.mem_product.mpr ⟨by simpa using P.q_pos, by simpa using P.q_pos⟩, rfl⟩ have hzero : (0 : GaussianInt) ∈ (FordTile P.q).cells := by apply Finset.mem_image.mpr exact ⟨(0, 0), Finset.mem_product.mpr ⟨by simpa using P.q_pos, by simpa using P.q_pos⟩, rfl⟩ @@ -340,10 +335,6 @@ private theorem rootCentroidEq' : TileCentroid T' = TileCentroid (TileTranslation (FordTile P.q) v)) ) := by classical intro P T' u hc' v - have hneF : (FordTile P.q).cells.Nonempty := by - refine ⟨0, ?_⟩ - apply Finset.mem_image.mpr - exact ⟨(0, 0), Finset.mem_product.mpr ⟨by simpa using P.q_pos, by simpa using P.q_pos⟩, rfl⟩ have hzero : (0 : GaussianInt) ∈ (FordTile P.q).cells := by apply Finset.mem_image.mpr exact ⟨(0, 0), Finset.mem_product.mpr ⟨by simpa using P.q_pos, by simpa using P.q_pos⟩, rfl⟩ @@ -869,7 +860,6 @@ theorem P4158T1LargeSecondRestrictions have fordCentroid (n : Nat) (hn : 0 < n) := LargeSecondRestrictions.fordCentroid n hn have rootCentroidEq := LargeSecondRestrictions.rootCentroidEq P T u hc have rootCentroid := LargeSecondRestrictions.rootCentroid P T u fordCentroid rootCentroidEq - let v : GaussianInt := u + ⟨-(P.q : Int), P.q₂⟩ have rootCentroidEq' := LargeSecondRestrictions.rootCentroidEq' P T' u hc' have rootCentroid' := LargeSecondRestrictions.rootCentroid' P T' u fordCentroid rootCentroidEq' have hqreal : (P.q : Real) = (P.q₁ : Real) + P.q₂ := by exact_mod_cast P.sum_q diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean index b8ef421217..cc2226084d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean @@ -511,8 +511,6 @@ private theorem translatedFootprint : ) := by classical intro P hFnon hFfoot w - have htn : (TileTranslation (FordTile P.q) w).cells.Nonempty := by - simpa [TileTranslation] using hFnon.image (GaussianTranslation w) calc FootprintVertices (TileTranslation (FordTile P.q) w) = GaussianTranslation w '' FootprintVertices (FordTile P.q) := @@ -645,7 +643,6 @@ theorem P4158T1MatchedFordPair have hrpos : 0 < P.q₁ := MatchedFordGeometry.hrpos P hqgt have hspos : 0 < P.q₂ := P.q₂_pos have hneq : P.q₁ ≠ P.q₂ := MatchedFordGeometry.hneq P Ci i hCi hlarge hidx hrpos hspos - have hcurv : 0 < (FordCircleCoordinate P.p P.q).1 := MatchedFordGeometry.hcurv P hqpos obtain ⟨H, hHO, hHD, hHV⟩ := FordTileOdometerRestriction P have hHcircle : TileOdometer C0.1.1 (FordTile P.q) H := MatchedFordGeometry.hHcircle P C0 hC0 H hHO @@ -663,8 +660,6 @@ theorem P4158T1MatchedFordPair MatchedFordGeometry.hcentT P T h H u hu hFnon hTnon have hcentT' : TileCentroid T' = TileCentroid (TileTranslation (FordTile P.q) v) := MatchedFordGeometry.hcentT' P T' h' H v hv hFnon hT'non - have hfordcent : TileCentroid (FordTile P.q) = - ((P.q : ℝ) / 2, (P.q : ℝ) / 2) := MatchedFordGeometry.hfordcent P hqgt hqpos have hcentdiff : TileCentroid T' - TileCentroid T = GaussianRealPoint (v - u) := MatchedFordGeometry.hcentdiff P T T' u v hcentT hcentT' obtain ⟨_, hconfig⟩ := FordCoordinateConfiguration P diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean index 092a0c7fbc..54b6c6a1a1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1SmallerStringEdges.lean @@ -670,8 +670,6 @@ private theorem hnotouch : rw [hnormdelta, hincoming] at hnorm have hless := hQless j rw [hCicurv] at hnorm hless - have hnqZ : (n : Int) < P.q := by exact_mod_cast hnq - have hnZ : 0 ≤ (n : Int) := by omega nlinarith private theorem hnadj : diff --git a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean index b824b188a7..d1973fadd7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean @@ -928,7 +928,6 @@ theorem P4194T1DiamondBoundaryLedger let a := z.re let b := z.im have hrow := DiamondBoundaryProof.hrow m z hz - have hm2 : 2 ≤ m := DiamondBoundaryProof.hm2 m hm have hdesclow (hb : b < m) : ∀ j : Fin 4, LatticeVertexIncidentCell z j ∈ DiamondCellDomain (m - 1) := DiamondBoundaryProof.hdesclow m hm z hrow hb diff --git a/LeanPool/ApollonianSuperharmonic/P4207T1FloorArithmetic.lean b/LeanPool/ApollonianSuperharmonic/P4207T1FloorArithmetic.lean index 154720cba0..6849b3e431 100644 --- a/LeanPool/ApollonianSuperharmonic/P4207T1FloorArithmetic.lean +++ b/LeanPool/ApollonianSuperharmonic/P4207T1FloorArithmetic.lean @@ -42,8 +42,6 @@ theorem P4207T1FloorArithmetic : · norm_num have successive (n : Int) : (n + 1) ^ 2 / 4 - n ^ 2 / 4 = (n + 1) / 2 := by have hr0 : 0 ≤ n % 2 := Int.emod_nonneg n (by norm_num) - have hr1 : n % 2 < 2 := Int.emod_lt_of_pos n (by norm_num) - have hn : n = n % 2 + 2 * (n / 2) := by omega have hr : n % 2 = 0 ∨ n % 2 = 1 := by omega generalize hq : n / 2 = q at * rcases hr with hr | hr diff --git a/LeanPool/ApollonianSuperharmonic/P4210T1FordCellRectangles.lean b/LeanPool/ApollonianSuperharmonic/P4210T1FordCellRectangles.lean index 0d1f6ea68a..b7aa9be295 100644 --- a/LeanPool/ApollonianSuperharmonic/P4210T1FordCellRectangles.lean +++ b/LeanPool/ApollonianSuperharmonic/P4210T1FordCellRectangles.lean @@ -62,7 +62,6 @@ theorem P4210T1FordCellRectangles (q : Nat) (z : GaussianInt) : ⟨z - u, hz, by simp [GaussianTranslation]⟩ refine ⟨coordinates q z, ?_⟩ intro r s hq - have hsum : (q : Int) = (r : Int) + (s : Int) := by exact_mod_cast hq simp only [translated_mem, coordinates, Zsqrtd.re_sub, Zsqrtd.im_sub] omega diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean b/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean index bd11dfb146..afaa8bd604 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1NestedCompatibility.lean @@ -214,9 +214,7 @@ private theorem hX : (xv = -v21 - (1 + I) * w))) ) := by classical intro q cfg I w xv v21 hcycV hpredV hv21 - let v13 : GaussianInt := BandVectors.1 (q 1) (q 3) apply eq_of_sub_eq_zero - have hcyc : w + v13 + v21 = 0 := by simpa [w, v13, v21] using hcycV have hpred : w + xv + BandVectors.1 (q 2) (cfg.firstPredecessor 1) = 0 := by simpa [w, xv, cfg.firstParentTwo, cfg.firstParentThree] using hpredV calc @@ -263,9 +261,7 @@ private theorem hXalpha : alpha) → (xa = -a21 - (1 - I) * alpha))) ) := by classical intro q cfg I alpha xa a21 hcycA hpredA ha21 - let a13 : GaussianInt := BandVectors.2 (q 1) (q 3) apply eq_of_sub_eq_zero - have hcyc : alpha + a13 + a21 = 0 := by simpa [alpha, a13, a21] using hcycA have hpred : alpha + xa + BandVectors.2 (q 2) (cfg.firstPredecessor 1) = 0 := by simpa [alpha, xa, cfg.firstParentTwo, cfg.firstParentThree] using hpredA calc @@ -2133,18 +2129,7 @@ private theorem reflectedFoot : dsimp at hsRe hsIm apply Prod.ext <;> dsimp <;> linarith have hcells := (BandPrototileCentroidUnique D Z Y hZband hY hcent).1 - have hXne := bandPositiveNonempty D X - (TileOdometerBandPrototile D X g hX) hD have hYne := bandPositiveNonempty D Y hY hD - have hZne : Z.cells.Nonempty := by - dsimp [Z] - rw [(TileTranslationFormulas (TileHalfTurn X) u).1] - apply Finset.image_nonempty.mpr - have he : (TileHalfTurn X).cells ≠ ∅ := by - intro h - exact (Finset.nonempty_iff_ne_empty.mp hXne) - ((TileHalfTurnFormulas X).2.2.1.mp h) - exact Finset.nonempty_iff_ne_empty.mpr he simp only [Z, FootprintVertices, ite_eq_left hYne, hcells] private theorem hsumAB : @@ -2546,9 +2531,6 @@ private theorem compatAB : right refine ⟨cO, ?_⟩ intro x hxA hxB - have hxraw : x ∈ FootprintVertices A ∩ FootprintVertices B := by - exact ⟨by rw [← hdomA]; exact hxA, - by rw [← hdomBParent]; exact hxB⟩ have hcover : (↑(h 0 true).domain ∩ ↑(h 0 false).domain : Set GaussianInt) ⊆ (↑(k 1 true).domain ∩ ↑(l 2 false).domain) ∪ @@ -2854,7 +2836,6 @@ private theorem nestedCompatibilityConclusion : (k 1 true) odoQ2 (TileOdometerBandPrototile _ _ _ odoS2) pos2 (NestedCompatibilityGeometry.hsumQS q cfg C T cert hcenterQT (NestedCompatibilityGeometry.hcenterSTAt1375 q cfg C T cert hcenterB hcenterS)) - let refl : GaussianInt → GaussianInt := fun x => GaussianTranslation u (-x) have reflectedSet := NestedCompatibilityGeometry.reflectedSet u have reflectedA := reflectedSet A B hreflectAB have reflectedC := reflectedSet (cert.P 1 true) (cert.P 1 false) hreflectCD @@ -2968,13 +2949,10 @@ theorem P4250T1NestedCompatibility (cert.plus_occurrence 2 true).1 (alignA 2 true).1 let I : GaussianInt := ⟨0, 1⟩ let w : GaussianInt := BandVectors.1 (q 3) (q 2) - let xv : GaussianInt := BandVectors.1 (cfg.firstPredecessor 1) (q 3) let v21 : GaussianInt := BandVectors.1 (q 2) (q 1) let v13 : GaussianInt := BandVectors.1 (q 1) (q 3) let alpha : GaussianInt := BandVectors.2 (q 3) (q 2) - let xa : GaussianInt := BandVectors.2 (cfg.firstPredecessor 1) (q 3) let a21 : GaussianInt := BandVectors.2 (q 2) (q 1) - let a13 : GaussianInt := BandVectors.2 (q 1) (q 3) let spatial (z : GaussianInt) : Real × Real := (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) @@ -3056,10 +3034,6 @@ theorem P4250T1NestedCompatibility (NestedCompatibilityGeometry.rootSlopeMinus q h s0 hp) (NestedCompatibilityGeometry.slopeDeltaMinus q cfg s0 secondFlip (NestedCompatibilityGeometry.slopeIdentityMinus q cfg slopeIdentity))) - let x2v : GaussianInt := - BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) - let x2a : GaussianInt := - BandVectors.2 (cfg.firstPredecessor 2) (cfg.firstPredecessor 1) have posRoot3 := NestedCompatibilityGeometry.posRoot3 q cfg let C3 : BandCircle := ⟨⟨q 3, Or.inl posRoot3, q, cfg.proper.1, 3, rfl⟩, posRoot3⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean b/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean index 55a8b17640..1360cb7178 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean @@ -111,7 +111,6 @@ private theorem hpos : intro q cfg i have hn := (ProperBandCurvatureStructure q cfg.proper).2.1 i have hne := cfg.noLine i.succ - have hn' : 0 ≤ (q i.succ).1 := by simpa using hn omega private theorem occCent : @@ -1763,8 +1762,6 @@ theorem P4250T1OrdinaryCompatibility simpa [Fin.add_def, A, sOff] using slope 2 true have hs2m : PartialOdometerSlope (h 2 false) = some (s0 - sOff A) := by simpa [Fin.add_def, A, sOff, sub_eq_add_neg, smul_eq_mul] using slope 2 false - have cadd := OrdinaryCompatibilityGeometry.cadd - have cneg := OrdinaryCompatibilityGeometry.cneg have sadd (a b : GaussianInt) : sOff (a + b) = sOff a + sOff b := by apply Prod.ext <;> simp [sOff, P4250T1SlopeOffset] <;> ring have sneg (a : GaussianInt) : sOff (-a) = -sOff a := by @@ -1790,10 +1787,6 @@ theorem P4250T1OrdinaryCompatibility q cfg)))) (OrdinaryCompatibilityGeometry.hflip03A q cfg hflip03) have slopeCoord := OrdinaryCompatibilityGeometry.slopeCoord have hnegI3 := OrdinaryCompatibilityGeometry.hnegI3 (OrdinaryCompatibilityGeometry.hI3 hI2) - have dompos (i : Fin 3) : 0 < (q i.succ).1 := hpos i - have circleEq1 : C1.1.1 = q 1 := rfl - have circleEq2 : C2.1.1 = q 2 := rfl - have circleEq3 : C3.1.1 = q 3 := rfl have compatSelf (a : PartialOdometer) : OdometerCompatibility a a := OrdinaryCompatibilityGeometry.compatSelf a have compatSymm {a b : PartialOdometer} (hab : OdometerCompatibility a b) := diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean b/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean index 76340889ee..83835ea255 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean @@ -1001,22 +1001,14 @@ theorem P4250T1ReflectedGluingSlope (h 0 true) hpositive (ho 0 true) have htwo_s0 := ReflectedGluingGeometry.htwo_s0 q s0 pchild ai hhalf (ReflectedGluingGeometry.hpchild q h s0 hp pchild hchild) - have hturn := BandSignedOccurrenceHalfTurn q (TileCentroid T) cert.P - (fun j s => (cert.outer_occurrence j s).1) - (fun j s => (cert.outer_occurrence j s).2.2) - have hreflect := ReflectedGluingGeometry.hreflect q cfg C T cert hturn have hcenterIntegral := ReflectedGluingGeometry.hcenterIntegral q cfg C T cert hcells obtain ⟨u, hu⟩ := hcenterIntegral let a := ai - (v + GaussianQuarterTurn v) have ha : GaussianRealPoint a = (2 : Real) • s0 := htwo_s0.symm have positive := ReflectedGluingGeometry.positive q cfg - let reflectedK (j : Fin 3) (s : Bool) : PartialOdometer := - PartialOdometerAffineTranslate - (PartialOdometerHalfTurn (h j (!s))) u a 0 have reflectedChild := ReflectedGluingGeometry.reflectedChild q cfg C T cert h s0 ho hp ai u hu ha positive have childNonempty := ReflectedGluingGeometry.childNonempty q cfg C T cert h ho positive - have halfSet := ReflectedGluingGeometry.halfSet have affineHalfMem := ReflectedGluingGeometry.affineHalfMem q ai u let gsharp := PartialOdometerAffineTranslate (PartialOdometerHalfTurn g) u a 0 have hgsharpdom := ReflectedGluingGeometry.hgsharpdom q cfg C T cert g hgdom ai u diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean b/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean index bf170a002a..fa36fe18d0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2FiniteForestCompletion.lean @@ -91,7 +91,6 @@ private theorem hHacyclic : | @cons u v w hadj p => have hp3 : 3 ≤ p.length + 1 := by simpa using (SimpleGraph.Walk.isCycle_iff_isPath_tail_and_le_length.mp hc).2 - have hp2 : 2 ≤ p.length := by omega have hlen : p.length ≠ 2 := by intro heq have h₁ : H.Adj v (p.getVert 1) := by @@ -826,8 +825,6 @@ theorem P4250T2FiniteForestCompletion let S : Set X := {x | x.val ∈ R} have hcardS : Nat.card S = R.card := ForestCompletionLemmas.hcardS W R hRW have hbudget : G.edgeFinset.card + Nat.card S = Fintype.card X := by - have hc : (W.card : ℤ) - (R.card : ℤ) = (G.edgeFinset.card : ℤ) := - hsumIndicator.symm.trans hcountGraph have hcardX : Fintype.card X = W.card := by simp [X] rw [hcardS, hcardX] omega diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean index 347ea2fbc5..6c2876f8e9 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean @@ -1571,15 +1571,6 @@ theorem P4250T2InterfaceNeighborCount : have hOB := InterfaceNeighborGeometry.hOB C q cfg T cert have hsep := BandOriginalPairSeparation cert.P cert.O cert.u cert.v hOA hOB cert.partition have hAB := InterfaceNeighborGeometry.hAB C q cfg T cert hsep - let parentLabel (a : Fin 3 × Bool) : SixSubtileLabel := - match a.1.val, a.2 with - | 0, true => .A - | 0, false => .B - | 1, true => .C - | 1, false => .D - | 2, true => .E - | _, _ => .F - let parentIndex (a : Fin 3 × Bool) : PeriodicSubtileIndex := ⟨parentLabel a, 0, 0⟩ have parent_disjoint := InterfaceNeighborGeometry.parent_disjoint C q cfg T cert hsep (InterfaceNeighborGeometry.parentLabel_injective) (InterfaceNeighborGeometry.parentOccurrence C q cfg T cert) @@ -1672,8 +1663,6 @@ theorem P4250T2InterfaceNeighborCount : owner_spec owner_iff have hclass := BandOrderedGeneralInteriorStarClassification q cfg C T cert hlat x hxT.1 hxT.2 have hsum := (InterfaceNeighborGeometry.finite_countAt614) owner hdiag hnot_constant - have hhigh : (Finset.univ.image owner).card ≤ 4 := by - exact (Finset.card_image_le).trans (by simp) have hk23 := InterfaceNeighborGeometry.hk23 C q cfg T cert P x neighbor_count owner_exists hcard hncount hclass hsum (InterfaceNeighborGeometry.hlow C q cfg T cert x owner_exists hnot_constant) diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean index 40a3ab47a0..133cf72d50 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean @@ -894,7 +894,6 @@ theorem P4261T1RightCoordinates have hparent : q'' i''.succ = q j.succ := by simpa [j] using hrotate i'' have hvector := RightCoordinateGeometry.hvector q q'' i'' r hrotate - have hslopeVector := RightCoordinateGeometry.hslopeVector q q'' i'' r hrotate have hsCent := RightCoordinateGeometry.hsCent q N q'' i'' s S' hcent' R hrootCent r hvector have hbandSelected := RightCoordinateGeometry.hbandSelected q q'' i'' s S' hs' hchild' r hparent have hbandFresh : BandPrototile (q j.succ) (R j s) := diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean b/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean index 3c1053907e..59d7c7ceaa 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean @@ -486,12 +486,6 @@ theorem P4261T2AncestorSymmetry AncestorSymmetryGeometry.literalRestriction actionForward g k h hsub heq let A := BandPackingSymmetryCircleAction let B := BandPackingSymmetryTileAction - let L := BandPackingSymmetryVectorAction - let O := BandPackingSymmetryReversesOrientation - let Q := BandPackingSymmetryQuadrupleAction - let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := - BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) - (fun p => (-p.1, p.2)) (fun _ p => p) (fun _ _ f k p => f (k p)) let J : (Real × Real) → (Real × Real) := fun p => (-p.2, p.1) let offset : GaussianInt → Real × Real := fun w => (1 / 2 : Real) • (GaussianRealPoint w - J (GaussianRealPoint w)) @@ -499,8 +493,6 @@ theorem P4261T2AncestorSymmetry have rsmul (a : BandPackingSymmetry) (c : Real) (p : Real × Real) := AncestorSymmetryGeometry.rsmul a c p have rneg (a : BandPackingSymmetry) (p : Real × Real) := AncestorSymmetryGeometry.rneg rsmul a p - have rminusq (a : BandPackingSymmetry) (p : Real × Real) := AncestorSymmetryGeometry.rminusq - rneg a p have rpoint (a : BandPackingSymmetry) (w : GaussianInt) := AncestorSymmetryGeometry.rpoint a w have rq (a : BandPackingSymmetry) (p : Real × Real) := AncestorSymmetryGeometry.rq rneg a p have offsetCov (a : BandPackingSymmetry) (w : GaussianInt) := diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean index 1b07290c2a..0cdcfaacdd 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitBoundary.lean @@ -311,7 +311,6 @@ private theorem horizontalPositive : rw [vg _ x1ig, vf _ x1if, vg _ x1g, vf _ x1f] have h01 : (x + 1) - x = 1 := by abel have h11 : (x + 1 + ⟨0, 1⟩) - x = 1 + ⟨0, 1⟩ := by abel - have h00 : (x + 1) - (x + 1) = 0 := by simp have h10 : (x + 1 + ⟨0, 1⟩) - (x + 1) = ⟨0, 1⟩ := by abel have hcoefMul : x.im * β.im - x.im * α.im = x.im * z.im := by calc @@ -450,7 +449,6 @@ private theorem verticalPositive : rw [vg _ x1ig, vf _ x1if, vg _ xig, vf _ xif] have h01 : (x + ⟨0, 1⟩) - x = ⟨0, 1⟩ := by abel have h11 : (x + 1 + ⟨0, 1⟩) - x = 1 + ⟨0, 1⟩ := by abel - have h00 : (x + ⟨0, 1⟩) - (x + ⟨0, 1⟩) = 0 := by simp have h10 : (x + 1 + ⟨0, 1⟩) - (x + ⟨0, 1⟩) = 1 := by abel simp only [CurvatureOneOdometer, Int.reduceNeg, Zsqrtd.ext_iff, Zsqrtd.re_add, Zsqrtd.re_one, add_zero, Zsqrtd.im_add, Zsqrtd.im_one, zero_add, h10, zero_ne_one, diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean b/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean index 64c3720d03..787e01fad7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2UnitInterface.lean @@ -515,8 +515,6 @@ private theorem hvertices : intro centerShift F f X rw [(TileTranslationFormulas (TileHalfTurn X) centerShift).2.2.2.2.2.1, (TileHalfTurnFormulas X).2.2.2.2.2.2.1] - have hq (z : GaussianInt) : GaussianQuarterTurn (GaussianQuarterTurn z) = -z := by - apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] simp only [Set.image_image] congr 1 @@ -1074,7 +1072,6 @@ private theorem hcovered : hstartIndex hfinishIndex hpathIndexEdge hwalkHeadPos hwalkLastPos hwalkVertexPath u v pre post hsplit have hindices := hpathIndexEdge u v pre post hsplit - have humem : u ∈ path := by rw [hsplit]; simp have hvmem : v ∈ path := by rw [hsplit]; simp by_contra hnot have hnoPair : ∀ a b : GaussianInt, ∀ l r : List GaussianInt, @@ -1216,8 +1213,6 @@ theorem P4261T2UnitInterface hcentPlus⟩ have hTband : BandPrototile C.1.1 T := TileOdometerBandPrototile _ _ _ hh have hUband : BandPrototile C.1.1 U := TileOdometerBandPrototile _ _ _ hk - have hRminusBand : BandPrototile D.1.1 Rminus := - TileOdometerBandPrototile _ _ _ hOminus have hRplusBand : BandPrototile D.1.1 Rplus := TileOdometerBandPrototile _ _ _ hOplus obtain ⟨_, _, _, _, hRminusNe⟩ := @@ -1239,7 +1234,6 @@ theorem P4261T2UnitInterface have hcentDiff := UnitInterfaceGeometry.hcentDiff q i T Rminus Rplus (UnitInterfaceGeometry.hcentMinusQ q i T Rminus q' hcentMinus hqi' hq0') (UnitInterfaceGeometry.hcentPlusQ q i T Rplus q' hcentPlus hqi' hq0') - let w : GaussianInt := BandVectors.1 (q 0) (q i.succ) have hneq : (0 : Fin 4) ≠ i.succ := (Fin.succ_ne_zero i).symm have hvector := (VectorSquareProduct q cfg.proper.1 0 i.succ hneq).1 have htangent := TangencyCoordinateIdentity q cfg.proper.1 0 i.succ hneq @@ -1270,9 +1264,6 @@ theorem P4261T2UnitInterface (UnitInterfaceGeometry.hvertices centerShift) (UnitInterfaceGeometry.hedges centerShift) obtain ⟨Epositive⟩ := htriplePositive obtain ⟨Eimage, himagePoint, himageAB⟩ := hpositiveImage Epositive - have hFNeT : (F T).cells.Nonempty := by rw [hFTCells]; exact hUNe - have hFNeU : (F U).cells.Nonempty := by rw [hFUCells]; exact hTNe - have hFNeRminus : (F Rplus).cells.Nonempty := by rw [hFRplusCells]; exact hRminusNe have hvFT : FootprintVertices (F T) = FootprintVertices U := by simp [FootprintVertices, hFTCells, hUNe] have hvFU : FootprintVertices (F U) = FootprintVertices T := by @@ -1285,17 +1276,6 @@ theorem P4261T2UnitInterface simp [FootprintEdges, hFUCells] have heFR : FootprintEdges (F Rplus) = FootprintEdges Rminus := by simp [FootprintEdges, hFRplusCells] - let Enegative : ExactTileInterfaceTriple U T Rminus := { - point := Eimage.point - otherAB := Eimage.otherAB - otherBC := Eimage.otherBC - otherCA := Eimage.otherCA - pathAB := by simpa [hvFT, hvFU, heFT, heFU] using Eimage.pathAB - pathBC := by simpa [hvFU, hvFR, heFU, heFR] using Eimage.pathBC - pathCA := by simpa [hvFR, hvFT, heFR, heFT] using Eimage.pathCA - unique_common := by - intro z - simpa [hvFT, hvFU, hvFR] using Eimage.unique_common z } have hposPath : SimpleGridPathBetween (FootprintVertices T ∩ FootprintVertices U) (FootprintEdges T ∩ FootprintEdges U) diff --git a/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean index 9255f6c737..7766ab2b6f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean @@ -597,11 +597,9 @@ theorem P4366T1PrecursorPathLoop -- BODY classical dsimp only - let F := P4366T1PrecursorRemainderFamily cert.P cert.O obtain ⟨_, _, _, _, _, _, hpair, hdisjoint⟩ := P4339T1PrecursorSupportGeometry C q cfg T cert have hOA := PrecursorLoopGeometry.hOA C q cfg T cert hpair - have hOB := PrecursorLoopGeometry.hOB C q cfg T cert hpair have parent_sub (i : Fin 3) (s : Bool) : (cert.P i s).cells ⊆ T.cells := fun z hz => (cert.outer_union z).mpr ⟨i, s, hz⟩ have hOT : cert.O.cells ⊆ T.cells := fun z hz => parent_sub 0 true (hOA hz) diff --git a/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean b/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean index 634c0f0e3a..6c9fe6dadc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean @@ -480,9 +480,6 @@ theorem P4366T1RemainderOuterAttachments : cert isolated corner z hz have hOsubA : cert.O.cells ⊆ (cert.P 0 true).cells := RemainderAttachmentGeometry.hOsubA C q cfg T cert - have hOsubB : cert.O.cells ⊆ (cert.P 0 false).cells := RemainderAttachmentGeometry.hOsubB C q - cfg T cert - have hpair := (P4339T1PrecursorSupportGeometry C q cfg T cert).2.2.2.2.2.2.1 have hdisjoint := (P4339T1PrecursorSupportGeometry C q cfg T cert).2.2.2.2.2.2.2 have hcover : ∀ z, z ∈ T.cells ∧ z ∉ cert.O.cells ↔ ∃ i s, z ∈ (F i s).cells := RemainderAttachmentGeometry.hcover C q cfg T cert hOsubA hdisjoint diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean index ff7494a6ad..f6e2b946e3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean @@ -1513,7 +1513,6 @@ private theorem interiorSector : exact hznot (List.mem_cons_of_mem x (List.mem_cons_self ..)) have hEdgeNe : ({z, x} : Finset GaussianInt) ≠ {x, y} := LocalSectorGeometry.hEdgeNe x pre y hpre' hzx hzy - have hjne := LocalSectorGeometry.hjne x pre y hpre' jL eL jR eR hzx hzy have hedgeL : {z, x} ∈ FootprintEdges T0 ∩ FootprintEdges T0' := (hedgesPath {z, x}).mpr ⟨z, x, pre', y :: rest, hleft, rfl⟩ have hedgeR : {x, y} ∈ FootprintEdges T0 ∩ FootprintEdges T0' := @@ -1659,27 +1658,17 @@ theorem P4366T2LocalSectors obtain ⟨P, hPlattice, htiles, hadjacent, hposition, hvertices, hedgesP, hfaces, hchart⟩ := BandRegularTranslatePeriodicComplex Ci q hproper hq0 base hbase' - let tileAt : Int × Int → ProtoTile := fun mn => TileTranslation base - ((mn.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + - (mn.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) - let chart : AffineTriangularComplexChart P tileAt := Classical.choice hchart have regular_index := LocalSectorGeometry.regular_index Ci base P htiles have htiles_lattice := LocalSectorGeometry.htiles_lattice Ci base q hproper hbase' P htiles - let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := - ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := ![{x, x + ⟨0, 1⟩}, {x - 1, x}, {x - ⟨0, 1⟩, x}, {x, x + 1}] have edgeAt_mem := LatticeVertexSectorFacts.edgeMembership - have edgeAt_eq_pair := LatticeVertexSectorFacts.edgePair have edgeAt_injective (x : GaussianInt) {j k : Fin 4} (h : edgeAt x j = edgeAt x k) := LatticeVertexSectorFacts.edgeInjective (LatticeVertexSectorFacts.neighborDistinct) (LocalSectorGeometry.neighbor_injective) edgeAt_mem x (j := j) (k := k) h have edge_of_sector_cell := LocalSectorGeometry.edge_of_sector_cell - let outerLabel : GaussianInt → Fin 4 → Fin 3 := fun x j => - if LatticeVertexIncidentCell x j ∈ T0.cells then 0 - else if LatticeVertexIncidentCell x j ∈ T0'.cells then 1 else 2 have label_T0 := LatticeVertexSectorFacts.firstTileLabel T0 T0' have label_T0' := LatticeVertexSectorFacts.secondTileLabel T0 T0' hdis rcases hr with ⟨hbaseR, hheadR, hlastR, hpairR, hfamilyR, hchainR, hheightR⟩ @@ -1703,12 +1692,10 @@ theorem P4366T2LocalSectors (PeriodicTileIndexedMultiplicityOne P c).unique (owner_cell c) hc have index_eq_of_tile_eq := LocalSectorGeometry.index_eq_of_tile_eq Ci P htiles_lattice have owner_mem_iff := LocalSectorGeometry.owner_mem_iff Ci P owner_cell owner_unique - have owner_eq_tile := LocalSectorGeometry.owner_eq_tile Ci P owner_unique have owner_no_fourfold := LocalSectorGeometry.owner_no_fourfold Ci P owner_cell (@LocalSectorGeometry.no_fourfold Ci base q P hchart) have owner_no_checkerboard := LocalSectorGeometry.owner_no_checkerboard Ci P htiles_lattice owner_mem_iff - have cross_ne := LocalSectorGeometry.cross_ne Ci T0 T0' hdis P htiles_lattice have indexed_transition := LocalSectorGeometry.indexed_transition C0 Ci T0 T0' h0 h0' tiles reverseTiles hs reverseHs hdis path P ancestor_cells (LocalSectorGeometry.indexed_edge_witnesses C0 Ci T0 T0' h0 h0' tiles reverseTiles hs diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean index 75c077d1ed..87ac7398f1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean @@ -412,10 +412,6 @@ private theorem hHalfEdges : _ = (fun e : Finset GaussianInt => e.image (fun z => -z)) '' FootprintEdges X := by rw [(TileQuarterTurnFormulas (TileQuarterTurn X)).2.2.2.2.2.2.1, (TileQuarterTurnFormulas X).2.2.2.2.2.2.1] - have hneg : (fun z : GaussianInt => GaussianQuarterTurn (GaussianQuarterTurn z)) = - (fun z => -z) := by - funext z - apply Zsqrtd.ext <;> simp [GaussianQuarterTurn] rw [Set.image_image] have hfin : (fun e : Finset GaussianInt => (e.image GaussianQuarterTurn).image GaussianQuarterTurn) = @@ -467,8 +463,6 @@ private theorem pathMap : let g : GaussianInt → GaussianInt := fun z => -(z - centerShift) have fg (z : GaussianInt) : f (g z) = z := by simp [f, g] - have gf (z : GaussianInt) : g (f z) = z := by - simp [f, g] have hlistInjective : Function.Injective (fun r : List GaussianInt => r.map f) := List.map_injective_iff.mpr finj have unmap (a b : GaussianInt) (l1 l2 : List GaussianInt) @@ -1247,7 +1241,6 @@ private theorem hNoTouch : have hqless := hproper.2 i have hparentEq : (qb 0).1 = (q i.succ).1 := by rw [hqb0, hCi] omega - have hrootPositive : 0 < (q i.succ).1 + (q 0).1 := by omega have hchildPositive : 0 < (qb j.succ).1 + (qb 0).1 := by have hnonneg := (ProperBandCurvatureStructure qb hproperB).2.1 j have hparentPos : 0 < (qb 0).1 := by simpa [hqb0, hCi] using hcurvi @@ -1380,17 +1373,11 @@ theorem P4366T2OuterGeometry have hregular0_induced := hregular0.2.1 have hregular0'_induced := hregular0'.2.1 have centroid_cells_eq := OuterGeometry.centroid_cells_eq - have hFplusne := OuterGeometry.hFplusne Rminus Rplus centerShift hpc hRmne have hcentFminus : TileCentroid (TileTranslation (TileHalfTurn Rminus) centerShift) = TileCentroid Rplus := centroid_cells_eq _ _ hRpne hmc - have hcentFplus : TileCentroid (TileTranslation (TileHalfTurn Rplus) centerShift) = - TileCentroid Rminus := centroid_cells_eq _ _ hRmne hpc have hcentHalfMinus : TileCentroid (TileHalfTurn Rminus) = (-(TileCentroid Rminus).1, -(TileCentroid Rminus).2) := (TileHalfTurnFormulas Rminus).2.2.2.2.2.2.2.1 - have hcentHalfPlus : TileCentroid (TileHalfTurn Rplus) = - (-(TileCentroid Rplus).1, -(TileCentroid Rplus).2) := - (TileHalfTurnFormulas Rplus).2.2.2.2.2.2.2.1 have huCenter : GaussianRealPoint centerShift = (2 : Real) • TileCentroid T0 + GaussianRealPoint (BandVectors.1 (q i.succ) (q 0)) := (OuterGeometry.huCent Rminus Rplus centerShift hcentFminus hcentHalfMinus).trans @@ -1427,9 +1414,6 @@ theorem P4366T2OuterGeometry (P : SimpleGridPathBetween V E x y) := OuterGeometry.pathMap centerShift finj (OuterGeometry.fstep centerShift) (V := V) (E := E) (V' := V') (E' := E') (x := x) (y := y) hV hE P - have hVrootNe := OuterGeometry.hVrootNe T0 T0' centerShift hT0'ne hFrootCells - have hVroot'Ne := OuterGeometry.hVroot'Ne T0 T0' centerShift hT0ne hFroot'Cells - have hVplusNe : (TileTranslation (TileHalfTurn Rplus) centerShift).cells.Nonempty := hFplusne have hVrootEq : FootprintVertices T0' = FootprintVertices (TileTranslation (TileHalfTurn T0) centerShift) := OuterGeometry.hVrootEq T0 T0' centerShift hT0'ne hFrootCells @@ -1477,8 +1461,6 @@ theorem P4366T2OuterGeometry hunique hpt (OuterGeometry.hpairCases T0 T0' Rminus Rplus centerShift Eplus pAB pBC pCA hunique hpt hpair)) (OuterGeometry.reversePath) have hlatMinus := OuterGeometry.hlatMinus Rminus Rplus centerShift hpc hlatPlus - let g : GaussianInt → GaussianInt := - fun x => GaussianTranslation centerShift (-x - 1 - ⟨0, 1⟩) have hcellMap := OuterGeometry.hcellMap centerShift have hdisjoint_image {A B : Finset GaussianInt} (hd : Disjoint A B) := OuterGeometry.hdisjoint_image centerShift (A := A) (B := B) hd @@ -1486,7 +1468,6 @@ theorem P4366T2OuterGeometry hdisjoint0'Plus hFroot'Cells hcellMap hdisjoint_image have hdisjoint0'Minus := OuterGeometry.hdisjoint0'Minus T0 T0' Rminus Rplus centerShift hpc hdisjoint0Plus hFrootCells hcellMap hdisjoint_image - have hproperBase : ProperBandQuadruple qf := hqf have hBandBase : BandPrototile Ci.1.1 base := (by rcases hstring with ⟨hbase, _, _, _, _, _, _⟩ exact hbase) diff --git a/LeanPool/ApollonianSuperharmonic/P4397T1UnitEdgeCells.lean b/LeanPool/ApollonianSuperharmonic/P4397T1UnitEdgeCells.lean index 4f9931ce8f..a41757f5a4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4397T1UnitEdgeCells.lean +++ b/LeanPool/ApollonianSuperharmonic/P4397T1UnitEdgeCells.lean @@ -860,10 +860,6 @@ theorem P4397T1UnitEdgeCells : · placeholder -/ · intro a b z w hform U - have oneNeImag : (1 : GaussianInt) ≠ ⟨0, 1⟩ := by - intro h - have hr := congrArg Zsqrtd.re h - norm_num at hr have hfootV (U : ProtoTile) (z : GaussianInt) : ({z + 1, z + 1 + ⟨0, 1⟩} : Finset GaussianInt) ∈ FootprintEdges U ↔ z ∈ U.cells ∨ z + 1 ∈ U.cells := UnitEdgeCellLemmas.hfootV pairMatch U z diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean b/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean index 7f4571e3dc..d0d227407e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3NestedCompanionEndpoint.lean @@ -687,8 +687,6 @@ theorem P4418T3NestedCompanionEndpoint let V := occ z.childIndex let W := occ z.parentIndex let K := TileTranslation V z.rightShift - let G₀ := occ (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 - let G₁ := occ (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 obtain ⟨_, _, _, _, _, _, hindices, _, _⟩ := P3996T1SRowAlignment q cfg C T cert a b row z hz have hpath := NestedCompanionGeometry.hpath q cfg C T cert a b z E hindices diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean b/LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean index d475044924..5af6d8fbb1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3OuterCompanionAlignment.lean @@ -322,7 +322,6 @@ private theorem geometry : classical intro C D T N h k x bundle placement q cert slot turn shift hin1 hin2 hin3 period_u period_v hout1 hout2 hout3 signed_centroid translated_centroid a ha - let cfg := bundle.configuration rcases ha with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl all_goals @@ -395,107 +394,6 @@ private theorem turn_injective : fin_cases a <;> fin_cases b <;> norm_num [pow_succ, Zsqrtd.ext_iff] at heq <;> rfl -private theorem turn_eq : - (by - classical - exact - ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : - PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : - BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration - bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot - bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction - bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot - bundle.selectedSign bundle.routedDirection), ∀ (s : Fin (4 : ℕ)), - let q := bundle.normalizedPresentation - let cert := placement.layout - let slot : PeriodicSubtileIndex → Fin 3 := fun a => - match a.label with - | .A | .B => 0 - | .C | .D => 1 - | .E | .F => 2 - (TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v - placement.exteriorIndex) - TileCentroid bundle.normalizedRoot = (1 / 2 : ℝ) • - GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * (BandVectors.1 (q (slot - placement.exteriorIndex).succ) (q 0) + BandVectors.1 (q 0) (q (slot - placement.exteriorIndex).succ)))) → ( - let turn : PeriodicSubtileIndex → Fin 4 := fun a => - match a.label with - | .A => if a.first = -1 then 3 else 0 - | .B => if a.first = 1 then 1 else 2 - | .C => if a.second = 0 then 3 else 0 - | .D => if a.second = 0 then 1 else 2 - | .E => if a.first = 0 then 3 else 0 - | .F => if a.first = 0 then 1 else 2 - (∀ (z : GaussianInt), ∀ (w : GaussianInt), ((1 / 2 : ℝ) • GaussianRealPoint z = (1 / 2 : - ℝ) • GaussianRealPoint w) → (z = w)) → ((∀ (j : Fin 3), BandVectors.1 (q j.succ) (q - 0) + BandVectors.1 (q 0) (q j.succ) ≠ 0) → ((∀ (a : Fin 4), ∀ (b : Fin 4), ((⟨0, 1⟩ : - GaussianInt) ^ a.val = (⟨0, 1⟩ : GaussianInt) ^ b.val) → (a = b)) → ((TileCentroid - (SubtileOccurrenceInterpretation cert.P cert.u cert.v placement.exteriorIndex) - - TileCentroid bundle.normalizedRoot = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : - ℤ)⟩ : GaussianInt) ^ (↑(turn placement.exteriorIndex) : ℕ) * (BandVectors.1 (q (slot - placement.exteriorIndex).succ) (q (0 : Fin (4 : ℕ))) + BandVectors.1 (q (0 : Fin (4 : - ℕ))) (q (slot placement.exteriorIndex).succ)))) → (s = turn - placement.exteriorIndex))))) ) := by - classical - intro C D T N h k x bundle placement s q cert slot presented_centroid turn half_point_injective - sum_ne turn_injective expected_centroid - apply turn_injective - apply mul_right_cancel₀ (sum_ne (slot placement.exteriorIndex)) - exact half_point_injective _ _ (presented_centroid.symm.trans expected_centroid) - -private theorem shift_eq : - (by - classical - exact - ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : - PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : - BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration - bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot - bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction - bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot - bundle.selectedSign bundle.routedDirection), ∀ (r : Fin (4 : ℕ) → CircleCoordinates), - ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), (r (0 : Fin (4 : ℕ)) = - bundle.normalizedCircle.1.1) → ((r i.succ = - bundle.normalizedFixedCircle.1.1) → ( - let q := bundle.normalizedPresentation - let cert := placement.layout - let slot : PeriodicSubtileIndex → Fin 3 := fun a => - match a.label with - | .A | .B => 0 - | .C | .D => 1 - | .E | .F => 2 - (bundle.normalizedFixedCircle.1.1 = q (slot placement.exteriorIndex).succ) → ( - let turn : PeriodicSubtileIndex → Fin 4 := fun a => - match a.label with - | .A => if a.first = -1 then 3 else 0 - | .B => if a.first = 1 then 1 else 2 - | .C => if a.second = 0 then 3 else 0 - | .D => if a.second = 0 then 1 else 2 - | .E => if a.first = 0 then 3 else 0 - | .F => if a.first = 0 then 1 else 2 - let shift : PeriodicSubtileIndex → GaussianInt := fun a => - match a.label with - | .A => if a.first = -1 then -cert.u else cert.u - | .B => if a.first = 1 then cert.u else -cert.u - | .C => if a.second = 0 then -cert.v else cert.v - | .D => if a.second = 0 then cert.v else -cert.v - | .E => if a.first = 0 then cert.u + cert.v else -cert.u - cert.v - | .F => if a.first = 0 then -cert.u - cert.v else cert.u + cert.v - (((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑(turn placement.exteriorIndex) : ℕ) * if Even - (↑(turn placement.exteriorIndex) : ℕ) then BandVectors.1 (q (0 : Fin (4 : ℕ))) (q - (slot placement.exteriorIndex).succ) else BandVectors.1 (q (slot - placement.exteriorIndex).succ) (q (0 : Fin (4 : ℕ)))) = shift - placement.exteriorIndex) → ((s = turn placement.exteriorIndex) → ((⟨0, 1⟩ : - GaussianInt) ^ s.val * (if Even s.val then BandVectors.1 (r 0) (r i.succ) else - BandVectors.1 (r i.succ) (r 0)) = shift placement.exteriorIndex))))) ) := by - classical - intro C D T N h k x bundle placement r i s hr0 hri q cert slot parent_eq turn shift - expected_shift turn_eq - have root_eq : r 0 = q 0 := hr0.trans bundle.normalized_circle_eq.symm - simpa only [turn_eq, root_eq, hri, parent_eq] using expected_shift - end CompanionAlignmentGeometry theorem P4418T3OuterCompanionAlignment : @@ -677,15 +575,16 @@ theorem P4418T3OuterCompanionAlignment : (⟨0, 1⟩ : GaussianInt) ^ b.val) : a = b := CompanionAlignmentGeometry.turn_injective a b heq obtain ⟨expected_centroid, expected_shift⟩ := geometry placement.exteriorIndex placement.exterior_index - have turn_eq : s = turn placement.exteriorIndex := CompanionAlignmentGeometry.turn_eq C D T N h - k x bundle placement s presented_centroid half_point_injective sum_ne turn_injective - expected_centroid + have turn_eq : s = turn placement.exteriorIndex := by + apply turn_injective + apply mul_right_cancel₀ (sum_ne (slot placement.exteriorIndex)) + exact half_point_injective _ _ (presented_centroid.symm.trans expected_centroid) have shift_eq : (⟨0, 1⟩ : GaussianInt) ^ s.val * (if Even s.val then BandVectors.1 (r 0) (r i.succ) - else BandVectors.1 (r i.succ) (r 0)) = shift placement.exteriorIndex := - CompanionAlignmentGeometry.shift_eq C D T N h k x bundle placement r i s hr0 hri - parent_eq expected_shift turn_eq + else BandVectors.1 (r i.succ) (r 0)) = shift placement.exteriorIndex := by + have root_eq : r 0 = q 0 := hr0.trans bundle.normalized_circle_eq.symm + simpa only [turn_eq, root_eq, hri, parent_eq] using expected_shift refine ⟨?_, ?_, ?_⟩ · cases hl : placement.exteriorIndex.label <;> simpa [slot, hl] using parent_eq · rw [turn_eq] diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean b/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean index 6e6c3f5a6e..c2ad30b88d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean @@ -1309,8 +1309,6 @@ theorem P4418T3PresentedRowAdjacency : obtain ⟨a13, a12, a31, a23, a01, a02, a03, sum12, sum13, sum23⟩ := P4387T1ParentSlopeNormalForms q cfg simp only [q] at a13 a12 a31 a23 a01 a02 a03 sum12 sum13 sum23 - have fin2 : (⟨2, by decide⟩ : Fin 4) = 2 := rfl - have fin3 : (⟨3, by decide⟩ : Fin 4) = 3 := rfl -- Keep the table's predecessor, parent slot, rotation, and directed order. have presentedAdjacency : let S := bundle.pieces bundle.selectedSlot bundle.selectedSign diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean b/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean index 81bafe0c0b..285a7059c4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3RoutedBlockCriterion.lean @@ -966,12 +966,6 @@ theorem P4418T3RoutedBlockCriterion (z : GaussianInt) (k : Fin 4) (hk : LatticeVertexIncidentCell z k ∈ U.cells) := RoutedBlockGeometry.incident_footprint U hne z k hk - let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v a - let W := SubtileOccurrenceInterpretation cert.P cert.u cert.v b - let G₀ := SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).1 - let G₁ := SubtileOccurrenceInterpretation cert.P cert.u cert.v - (P4418T3EndpointOwnerIndices q cfg C T cert a b row).2 have root_cells (o : PeriodicSubtileIndex) (c : LatticeCell) (hc : c ∈ (SubtileOccurrenceInterpretation cert.P cert.u cert.v o).cells) := RoutedBlockGeometry.root_cells q cfg C T cert o c hc diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean index 8729133243..403b6785f6 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3SelectedInterfaceExists.lean @@ -1052,68 +1052,6 @@ private theorem ownerPoint1 : rw [ho1, cert.modified_tile] at h exact modifiedFootSubset owners.2 h -private theorem originalPair0 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - let P := cert.P - let O := cert.O - let u := cert.u - let v := cert.v - ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b))) → ( - let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v - let face0 : PeriodicSubtileFaceIndex := selectedFirstFace q cfg C T cert a b row - let F0 := cert.modifiedFaceEquivalence.symm face0 - (cert.modified.rho F0 ∈ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u - v a) ∩ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)) → - (cert.modified.rho F0 ∈ FootprintVertices (occurrence a) ∩ FootprintVertices - (occurrence b))) ) := by - classical - intro q cfg C T cert a b row P O u v retargeted occurrence face0 F0 commonPair0 - simpa only [retargeted.2] using commonPair0 - -private theorem originalPair1 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), ∀ (a : PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), ∀ (row : - BandOrderedGeneralSelectedContactRow q cfg C T cert a b), - let P := cert.P - let O := cert.O - let u := cert.u - let v := cert.v - ((FootprintEdges (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintEdges - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)) ∧ (FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v a) ∩ FootprintVertices - (ModifiedSubtileOccurrenceInterpretation P O u v b) = FootprintVertices - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b))) → ( - let occurrence := SubtileOccurrenceInterpretation cert.P cert.u cert.v - let face1 : PeriodicSubtileFaceIndex := selectedSecondFace q cfg C T cert a b row - let F1 := cert.modifiedFaceEquivalence.symm face1 - (cert.modified.rho F1 ∈ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u - v a) ∩ FootprintVertices (ModifiedSubtileOccurrenceInterpretation P O u v b)) → - (cert.modified.rho F1 ∈ FootprintVertices (occurrence a) ∩ FootprintVertices - (occurrence b))) ) := by - classical - intro q cfg C T cert a b row P O u v retargeted occurrence face1 F1 commonPair1 - simpa only [retargeted.2] using commonPair1 - private theorem latticeOccurrence : (by classical @@ -1503,11 +1441,11 @@ private theorem selectedCertificate : SelectedInterfaceGeometry.ownerPoint1 q cfg C T cert a b row modifiedFootSubset jO ho1 have originalPair0 : cert.modified.rho F0 ∈ - FootprintVertices (occurrence a) ∩ FootprintVertices (occurrence b) := - SelectedInterfaceGeometry.originalPair0 q cfg C T cert a b row retargeted commonPair0 + FootprintVertices (occurrence a) ∩ FootprintVertices (occurrence b) := by + simpa only [retargeted.2] using commonPair0 have originalPair1 : cert.modified.rho F1 ∈ - FootprintVertices (occurrence a) ∩ FootprintVertices (occurrence b) := - SelectedInterfaceGeometry.originalPair1 q cfg C T cert a b row retargeted commonPair1 + FootprintVertices (occurrence a) ∩ FootprintVertices (occurrence b) := by + simpa only [retargeted.2] using commonPair1 have latticeOccurrence : ∀ x : PeriodicSubtileIndex, LatticeTile (occurrence x) := SelectedInterfaceGeometry.latticeOccurrence q cfg C T cert have disjointData : @@ -1522,7 +1460,6 @@ private theorem selectedCertificate : SelectedInterfaceGeometry.translateAdd X x y have translateZero (X : ProtoTile) : TileTranslation X 0 = X := SelectedInterfaceGeometry.translateZero X - have cancelSum (x y : GaussianInt) : x + (y + (-x + -y)) = 0 := by abel have touchTranslate (X Y Z : ProtoTile) (d : GaussianInt) (h : TouchingTriple X Y Z) : TouchingTriple (TileTranslation X d) (TileTranslation Y d) diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean b/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean index 046deb2a36..4e6f662634 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2BandGraphTriangle.lean @@ -127,9 +127,6 @@ private theorem hOpp : (hCe : BoundaryFootprintEdges C = BoundaryFootprintEdges C') (hnA : A.cells.Nonempty) (hnB : B.cells.Nonempty) (hnC : C.cells.Nonempty) (hh : TouchingTriple A B C) : TouchingTriple A' B' C' := by - have hnA' : A'.cells.Nonempty := by rw [← hAc]; exact hnA - have hnB' : B'.cells.Nonempty := by rw [← hBc]; exact hnB - have hnC' : C'.cells.Nonempty := by rw [← hCc]; exact hnC have touch (X X' Y Y' : ProtoTile) (hX : X.cells = X'.cells) (hY : Y.cells = Y'.cells) (hXb : BoundaryFootprintVertices X = BoundaryFootprintVertices X') @@ -888,10 +885,6 @@ theorem P4456T2BandGraphTriangle (q : Fin 4 → CircleCoordinates) BandGraphTriangleGeometry.shift_e1 q shift_add w have shift_e2 (w : Int × Int) : shift (w + (0, 1)) = shift w + v := BandGraphTriangleGeometry.shift_e2 q shift_add w - have shift_neg_e1 (w : Int × Int) : shift (w - (1, 0)) = shift w - u := - BandGraphTriangleGeometry.shift_neg_e1 q shift_add w - have shift_neg_e2 (w : Int × Int) : shift (w - (0, 1)) = shift w - v := - BandGraphTriangleGeometry.shift_neg_e2 q shift_add w have shift_mne1 (w : Int × Int) : shift (w + (-1, 0)) = shift w - u := BandGraphTriangleGeometry.shift_mne1 q shift_add w have shift_mne2 (w : Int × Int) : shift (w + (0, -1)) = shift w - v := diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean b/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean index c398117fcd..d017f177b7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean @@ -212,9 +212,6 @@ private theorem hrLast : intro x y p k q j hj hyidx hjpos r change (q.take (j + 1)).getLast? = some y rw [List.getLast?_take] - have hqj : q[j]? = some y := by - rw [List.getElem?_eq_getElem hj] - exact congrArg some hyidx rw [ite_eq_right (show j + 1 ≠ 0 by omega)] have hj' : j + 1 - 1 = j := by omega rw [hj'] @@ -243,7 +240,6 @@ private theorem hrLen : dsimp [r] at hsmall simp only [List.length_take] at hsmall omega - have hjnot0 : j ≠ 0 := by omega have hj1 : j = 1 := by omega have hqxy : ({x, y} : Finset GaussianInt) ∈ BoundaryFootprintEdges T := by have hqchain := (List.isChain_iff_getElem.mp hqBoundaryChain) 0 (by @@ -799,7 +795,6 @@ theorem P4456T2CrosscutIndex (T : ProtoTile) (hT : LatticeTile T) rcases hf with ⟨hfc, hfd⟩ have hfcOrig := hfc have hfdOrig := hfd - have hcdAdj := CrosscutIndexProof.hcdAdj c d hcd f hfc hfd change (∃ z ∈ ({c} : Finset GaussianInt), f = {z, z + 1} ∨ f = {z, z + ⟨0, 1⟩} ∨ f = {z + 1, z + 1 + ⟨0, 1⟩} ∨ diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean b/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean index 0537983d21..978f172ff6 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2OrderedNoChord.lean @@ -494,13 +494,7 @@ theorem P4456T2OrderedNoChord -- Construct one integral half-turn centered at the outer centroid. obtain ⟨u, hu, _⟩ := QuarterTurnSymmetricCenteredTransport (layout.P 0 false) (layout.parent_quarter_turn 0 false) - let w := BandVectors.1 (q 3) (q 2) - let t : GaussianInt := - ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ have ht := OrderedNoChordGeometry.ht q cfg C T layout u hu - let H : ProtoTile → ProtoTile := fun U => - TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t - let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ have htau := TileHalfTurnGeometry.involutive q u have hHcells := TileHalfTurnGeometry.cells q u have hHreal := TileHalfTurnGeometry.realization q T u ht @@ -510,10 +504,6 @@ theorem P4456T2OrderedNoChord have hHsigned := OrderedNoChordGeometry.hHsigned q cfg C T layout u htau hHcells hHreal hcenter have touch_flip := OrderedNoChordGeometry.touch_flip q cfg C T layout hne u hHsigned have touch_sym := OrderedNoChordGeometry.touch_sym - let V : Fin 6 → Fin 3 × Bool := - ![(0, true), (2, false), (1, true), (0, false), (2, true), (1, false)] - let P : Fin 6 → ProtoTile := fun j => layout.P (V j).1 (V j).2 - let l : Fin 6 → Int := fun j => k (V j).1 (V j).2 have hlabels := OrderedNoChordGeometry.hlabels q cfg C T layout side k hk have hcontacts := OrderedNoChordGeometry.hcontacts q cfg C T layout touch_flip touch_sym obtain ⟨z, z', hform⟩ := P4397T1UnitEdgeCells.1 x y hxy diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2ParentSide.lean b/LeanPool/ApollonianSuperharmonic/P4456T2ParentSide.lean index 870d3559c2..5b70ba0111 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2ParentSide.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2ParentSide.lean @@ -56,8 +56,6 @@ theorem P4456T2ParentSide (T U : ProtoTile) (hfc : f ∈ FootprintEdges (⟨{c}, c⟩ : ProtoTile)) (hfd : f ∈ FootprintEdges (⟨{d}, d⟩ : ProtoTile)) (hfeq : f = {x, y}) (hlabels : side c ≠ side d) : False := by - have hf : f ∈ FootprintEdges (⟨{c}, c⟩ : ProtoTile) ∩ - FootprintEdges (⟨{d}, d⟩ : ProtoTile) := ⟨hfc, hfd⟩ have hab : {x, y} ∈ FootprintEdges (⟨{c}, c⟩ : ProtoTile) := by rw [← hfeq] exact hfc diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean b/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean index c6c581a1ef..db1b1940c8 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean @@ -137,8 +137,6 @@ private theorem hvertex_box : simp only [Zsqrtd.re_add, Zsqrtd.im_add, ] norm_num - have ha' : (a : Int) < n := by exact_mod_cast ha - have hb' : (b : Int) < n := by exact_mod_cast hb omega private theorem hstarCoords : @@ -817,9 +815,6 @@ theorem P4456T2SquareEdges (n : Nat) (hn : 0 < n) ∃ a b : Nat, a ≤ n ∧ b ≤ n ∧ v = w + (⟨(a : Int), (b : Int)⟩ : GaussianInt) := SquareEdgeProof.hvertex_coords n w T hcell hnonempty v hv - have hvertex_box (v : GaussianInt) (hv : v ∈ FootprintVertices T) : - (w.re : Int) ≤ v.re ∧ v.re ≤ w.re + n ∧ - w.im ≤ v.im ∧ v.im ≤ w.im + n := SquareEdgeProof.hvertex_box n w T hcell hnonempty v hv have hstarCoords (a b : Nat) (ha0 : 0 < a) (haN : a < n) (hb0 : 0 < b) (hbN : b < n) : ∀ j : Fin 4, LatticeVertexIncidentCell diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean index 17e2ea0eae..ab9ee65a46 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean @@ -931,8 +931,6 @@ private theorem hplusSlope : intro C orientation base Rminus Rplus hminus hplus F r I wa xa ya rootSlope joinSlope hrootSlopeEq hDoffset hFplusSlope hplusSlopeVector ha10ReC ha10ImC ha01ReC ha01ImC hsumReC hsumImC - have hre := congrArg (fun z : GaussianInt => (z.re : ℝ)) hplusSlopeVector - have him := congrArg (fun z : GaussianInt => (z.im : ℝ)) hplusSlopeVector have hDoffset' : joinSlope - rootSlope = (-(1 / 2 : ℝ) * ((wa.re : ℤ) : ℝ) + (1 / 2 : ℝ) * ((wa.im : ℤ) : ℝ), @@ -973,9 +971,7 @@ private theorem hCgt1 : intro C p hp hCcoord rw [hCcoord] have hfacts := ProperBandCurvatureStructure p hp - have hpositive' : 0 < (p 0).1 := hfacts.1 by_contra hn - have hle : (p 0).1 ≤ 1 := by omega have hz : ∀ i : Fin 3, (p i.succ).1 = 0 := by intro i have hnonneg := hfacts.2.1 i diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean index deb79fb5c1..b985990631 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean @@ -1071,7 +1071,6 @@ private theorem hnonunit : have hcurv := ProperBandCurvatureStructure t ht have hrootlarge : 1 < (t 0).1 := by by_contra hn - have hrootle : (t 0).1 ≤ 1 := by omega have hzeros : ∀ k : Fin 3, (t k.succ).1 = 0 := by intro k have hnonneg := hcurv.2.1 k @@ -3545,7 +3544,6 @@ private theorem recursiveParentCase : (-(GaussianRealPoint x).2, (GaussianRealPoint x).1)) := SecondNewerRowsGeometry.hAoccAt816 C orientation base Rminus Rplus hminus hplus F D a p hqB hqD hr1 hr3 - let pRot : Fin 4 → CircleCoordinates := ![p 0, p 3, p 1, p 2] have hpRot := SecondNewerRowsGeometry.hpRot p hp have hRotV := SecondNewerRowsGeometry.hRotV p hpRot have hRotA := SecondNewerRowsGeometry.hRotA p hpRot @@ -3577,14 +3575,6 @@ private theorem recursiveParentCase : have toRealIm (z : GaussianInt) : (GaussianInt.toComplex z).im = (z.im : ℝ) := (GaussianInt.intCast_im z).symm - have hrecVC := SecondNewerRowsGeometry.hrecVC C orientation base Rminus Rplus hminus hplus - F hvrec - have hflipVC := SecondNewerRowsGeometry.hflipVC C orientation base Rminus Rplus hminus - hplus F hvflip - have hRotVC := SecondNewerRowsGeometry.hRotVC p hRotV - have hyRotC : GaussianInt.toComplex y = - GaussianInt.toComplex (BandVectors.1 (p 0) (p 3)) := - congrArg GaussianInt.toComplex hyRot have hleftAminus := SecondNewerRowsGeometry.hleftAminus C orientation base Rminus Rplus hminus hplus F D a p hMcenter hAocc hRotVReR hRotVImR hrecVReR hrecVImR hflipVReR hflipVImR hyRot diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean index 938954d4fe..52ad57df3f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean @@ -164,7 +164,6 @@ private theorem hcentJK : classical intro C orientation base Rminus Rplus hminus hplus F D a J r I w x y vAlg halfPoint halfPoint_sub hcentJ hcentK - have h := vAlg.2.2.1 calc _ = (TileCentroid J - TileCentroid F.tile) - (TileCentroid (D.tiles a true) - TileCentroid F.tile) := by abel @@ -897,20 +896,14 @@ theorem P4536T1AFrameB ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] have hr : ProperBandQuadruple r := AFrameBProof.hr C orientation base Rminus Rplus hminus hplus F a - have hcoord : r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, - 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2) := AFrameBDetails.hcoord C - orientation base Rminus Rplus hminus hplus F a p hstep have hA : r 1 = p 0 := AFrameBDetails.hA C orientation base Rminus Rplus hminus hplus F a p hstep have hB : r 2 = p 2 := AFrameBDetails.hB C orientation base Rminus Rplus hminus hplus F a p hstep - have hE : r 3 = p 3 := AFrameBDetails.hE C orientation base Rminus Rplus hminus hplus F a p - hstep have hparent : r 2 = C.1.1 := AFrameBDetails.hparent C orientation base Rminus Rplus hminus hplus F a hslot have hpB : p 2 = C.1.1 := hB.symm.trans hparent have hposA : 0 < (p 0).1 := (ProperBandCurvatureStructure p hp).1 - have hposB : 0 < (p 2).1 := by rw [hpB]; exact C.2 let I : GaussianInt := ⟨0, 1⟩ let w := BandVectors.1 (r 3) (r 2) let x := BandVectors.1 (r 1) (r 3) @@ -939,7 +932,6 @@ theorem P4536T1AFrameB have aThird := aAlg.2.2.1 have aFourth := aAlg.2.2.2.1 have vflip := hflipv - have aflip := hflipa let halfPoint : GaussianInt → ℝ × ℝ := fun z => (1 / 2 : ℝ) • GaussianRealPoint z have halfPoint_sub (u v : GaussianInt) : @@ -966,7 +958,6 @@ theorem P4536T1AFrameB AFrameBDetails.hodoK C orientation base Rminus Rplus hminus hplus F D a p hA have hbandK : BandPrototile (p 0) (D.tiles a true) := TileOdometerBandPrototile _ _ _ hodoK - have hparentNew : p 2 = C.1.1 := hpB have hAcoord : F.q a.succ = p 0 := by simpa [r] using hA have hBcoord : F.q ((a + 1).succ) = p 2 := by simpa [r] using hB have hfamilyR : Rplus ∈ RegularTileFamily base (TilingLattice C) := by diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean index 615bec3f49..aa66fe7ba6 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean @@ -1233,16 +1233,9 @@ theorem P4536T1AFrameD have hC := FrameDiagonalProof.hC C orientation base Rminus Rplus hminus hplus F p hparent have positiveA := FrameDiagonalProof.positiveA p hp - have positiveE := FrameDiagonalProof.positiveE C p hC let I : GaussianInt := ⟨0, 1⟩ - let wv := BandVectors.1 (r 3) (r 2) - let xv := BandVectors.1 (r 1) (r 3) - let yv := BandVectors.1 (r 2) (r 1) - let wa := BandVectors.2 (r 3) (r 2) let xa := BandVectors.2 (r 1) (r 3) - let ya := BandVectors.2 (r 2) (r 1) have laws := FrameDiagonalProof.laws C orientation base Rminus Rplus hminus hplus F a hr - let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] have hrr := FrameDiagonalProof.hrr C orientation base Rminus Rplus hminus hplus F a hr have lawsR := FrameDiagonalProof.lawsR C orientation base Rminus Rplus hminus hplus F a hrr diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean index d21872e144..1c99338caf 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2DiamondGeometry.lean @@ -444,9 +444,6 @@ private theorem arbitrary_family : (TileRealization (TileCellComplement D (R' i s))) at hDcompDisk rw [hcompObs.2.2.2.1] at hDcompDisk exact hDcompDisk - have hTcompNe : (TileCellComplement T' (R' i s)).cells.Nonempty := by - rw [← hDcompCells] - exact hDcompNe have hTcompTouch : TileTouching (TileCellComplement T' (R' i s)) (R' i s) := by exact (touching_same_cells _ _ _ hDcompCells hDcompNe diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean b/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean index cb5ccda00a..90e0197dca 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2FordT6Transport.lean @@ -66,16 +66,10 @@ private theorem hlineq : | exact ⟨1, (hcurv (q 2)).symm.trans hact⟩ | exact ⟨2, (hcurv (q 3)).symm.trans hact⟩ rcases hparent with ⟨j, hj⟩ - have hp1 := qcur.2.1 0 - have hp2 := qcur.2.1 1 have hq1 : 0 < (q 1).1 := by have := hq.2 0 simp at this omega - have hq2 : 0 < (q 2).1 := by - have := hq.2 1 - simp at this - omega fin_cases j · simp at hj omega @@ -1081,11 +1075,6 @@ theorem P4564T2FordT6Transport : (by simpa [rN] using hr2hat) (by simpa [rN] using hr3hat) horder hlarge' Pbar Qbar Sbar hPford hQbar hSbar rcases hFordBase with ⟨hledgerN, hraw1N, hraw2N⟩ - let v0 := BandVectors.1 (q 0) (q 2) - let uN := BandVectors.1 ((FordRecursiveQuadruple F') 0) - ((FordRecursiveQuadruple F') 1) - let vN := BandVectors.1 ((FordRecursiveQuadruple F') 0) - ((FordRecursiveQuadruple F') 2) have hq0 := FordT6Geometry.hq0 q h F' hrev gN horientationAdapt hqhat have hq1 := FordT6Geometry.hq1At383 q h F' hrev gN horientationAdapt hqhat have hq2 := FordT6Geometry.hq2At387 q h F' hrev gN horientationAdapt hqhat diff --git a/LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean b/LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean index 6598a74283..f524b69227 100644 --- a/LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4564T2GeneralT6Transport.lean @@ -272,52 +272,6 @@ private theorem callerClassification : simpa only [(samePeriodic o).1, (samePeriodic p).1, (samePeriodic o).2, (samePeriodic p).2] using classification o p hop -private theorem callerRaw : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (T : ProtoTile), ∀ (g : BandPackingSymmetry), ∀ (C : - BandCircle), ∀ (P : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → - ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (cfg : - BandOrderedGeneralConfiguration (BandPackingSymmetryQuadrupleAction g q)), ∀ (cert : - BandOrderedGeneralLayoutCertificate (BandPackingSymmetryQuadrupleAction g q) cfg C - (BandPackingSymmetryTileAction g T)), - let P' : Fin 3 → Bool → ProtoTile := fun i s => BandPackingSymmetryTileAction g (P i s) - let Q' : Fin 3 → Bool → ProtoTile := fun i s => BandPackingSymmetryTileAction g (Q i s) - let S' : Fin 3 → Bool → ProtoTile := fun i s => BandPackingSymmetryTileAction g (S i s) - (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (BandPackingSymmetryTileAction g (P i s)).cells = - (cert.P i s).cells ∧ ((BandPackingSymmetryTileAction g (P i s)).cells = ∅ → - (BandPackingSymmetryTileAction g (P i s)).anchor = (cert.P i s).anchor) ∧ - FootprintVertices (BandPackingSymmetryTileAction g (P i s)) = FootprintVertices - (cert.P i s) ∧ TileCentroid (BandPackingSymmetryTileAction g (P i s)) = TileCentroid - (cert.P i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (BandPackingSymmetryTileAction g - (Q i s)).cells = (cert.Q i s).cells ∧ ((BandPackingSymmetryTileAction g (Q i - s)).cells = ∅ → (BandPackingSymmetryTileAction g (Q i s)).anchor = (cert.Q i - s).anchor) ∧ FootprintVertices (BandPackingSymmetryTileAction g (Q i s)) = - FootprintVertices (cert.Q i s) ∧ TileCentroid (BandPackingSymmetryTileAction g (Q i - s)) = TileCentroid (cert.Q i s)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), - (BandPackingSymmetryTileAction g (S i s)).cells = (cert.S i s).cells ∧ - ((BandPackingSymmetryTileAction g (S i s)).cells = ∅ → (BandPackingSymmetryTileAction - g (S i s)).anchor = (cert.S i s).anchor) ∧ FootprintVertices - (BandPackingSymmetryTileAction g (S i s)) = FootprintVertices (cert.S i s) ∧ - TileCentroid (BandPackingSymmetryTileAction g (S i s)) = TileCentroid (cert.S i s)) → - ((FootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.P (1 : - Fin (3 : ℕ)) true) ⊆ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∩ - FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true) ∧ FootprintVertices (cert.P (0 : - Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.P (0 : Fin (3 : ℕ)) false) ⊆ - FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.S (2 : - Fin (3 : ℕ)) false) ∪ FootprintVertices (cert.Q (0 : Fin (3 : ℕ)) false) ∪ - FootprintVertices (cert.Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.S (1 : - Fin (3 : ℕ)) false)) → (FootprintVertices (P' 0 true) ∩ FootprintVertices (P' 1 true) - ⊆ FootprintVertices (Q' 1 true) ∩ FootprintVertices (P' 1 true) ∧ FootprintVertices - (P' 0 true) ∩ FootprintVertices (P' 0 false) ⊆ (FootprintVertices (Q' 1 true) ∩ - FootprintVertices (S' 2 false)) ∪ FootprintVertices (Q' 0 false) ∪ (FootprintVertices - (Q' 2 true) ∩ FootprintVertices (S' 1 false)))))) ) := by - classical - intro q T g C P Q S cfg cert P' Q' S' sameP sameQ sameS raw - simpa only [P', Q', S', (sameP _ _).2.2.1, (sameQ _ _).2.2.1, - (sameS _ _).2.2.1] using raw - private theorem period_u : (by classical @@ -556,8 +510,9 @@ theorem P4564T2GeneralT6Transport (q : Fin 4 → CircleCoordinates) (hq : Proper FootprintVertices (P' 0 true) ∩ FootprintVertices (P' 0 false) ⊆ (FootprintVertices (Q' 1 true) ∩ FootprintVertices (S' 2 false)) ∪ FootprintVertices (Q' 0 false) ∪ - (FootprintVertices (Q' 2 true) ∩ FootprintVertices (S' 1 false)) := - GeneralT6Geometry.callerRaw q T g C P Q S cfg cert sameP sameQ sameS raw + (FootprintVertices (Q' 2 true) ∩ FootprintVertices (S' 1 false)) := by + simpa only [P', Q', S', (sameP _ _).2.2.1, (sameQ _ _).2.2.1, + (sameS _ _).2.2.1] using raw -- Use the same false phase for the ordered periods before pulling back. let L := BandPackingSymmetryVectorAction g have period_u : cert.u = L (BandVectors.1 (q 0) (q 1)) := GeneralT6Geometry.period_u q T g C hg diff --git a/LeanPool/ApollonianSuperharmonic/P4566T1SmallRetainedSides.lean b/LeanPool/ApollonianSuperharmonic/P4566T1SmallRetainedSides.lean index 7955e541c6..67ba7e085f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4566T1SmallRetainedSides.lean +++ b/LeanPool/ApollonianSuperharmonic/P4566T1SmallRetainedSides.lean @@ -100,10 +100,6 @@ private theorem rootValues : GaussianInt) + (2 : GaussianInt) * z + (2 : GaussianInt) * I) = (-1 : GaussianInt))))) := by classical intro p I baseLaw stepLaw flipLaw z - let q : Fin 4 → CircleCoordinates := - ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, - 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), - p 0, p 2, p 3] let b : Fin 4 → CircleCoordinates := ![(1, 1 + 2 * z), (1, 1 + 2 * z + 2 * I), (0, 1), (0, -1)] have hb : SemiProperQuadruple b := SemiProperQuadruple.base z diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean index 1e37e33ff4..2935bc194f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean @@ -1566,7 +1566,6 @@ private theorem firstJunction : have hx_p1_or_pJ := JunctionRefinementGeometry.hx_p1_or_pJ q cfg C T cert x f g hxendpoint (JunctionRefinementGeometry.hfpoint q cfg C T cert f hfclass rhoFace) (JunctionRefinementGeometry.hgpoint q cfg C T cert g hgclass rhoFace) - let faceJ : PeriodicSubtileFaceIndex := ⟨.J3, -1, -1⟩ let aJ : PeriodicSubtileIndex := ⟨.A, -1, -1⟩ have hpJa := JunctionRefinementGeometry.hpJa q cfg C T cert (JunctionRefinementGeometry.hJvertex q cfg C T cert) @@ -1724,7 +1723,6 @@ private theorem secondJunction : cert x f2 g2 hxendpointAD (JunctionRefinementGeometry.hf2point q cfg C T cert f2 hf2class rhoFace2) (JunctionRefinementGeometry.hg2point q cfg C T cert g2 hg2class rhoFace2) - let faceJ4 : PeriodicSubtileFaceIndex := ⟨.J4, 0, 0⟩ let bJ4 : PeriodicSubtileIndex := ⟨.B, 1, 1⟩ have hpJ4b := JunctionRefinementGeometry.hpJ4b q cfg C T cert (JunctionRefinementGeometry.hJ4vertex q cfg C T cert) @@ -1865,7 +1863,6 @@ private theorem thirdJunction : cert x f3 g3 hxendpointCF (JunctionRefinementGeometry.hf3point q cfg C T cert f3 hf3class rhoFace3) (JunctionRefinementGeometry.hg3point q cfg C T cert g3 hg3class rhoFace3) - let faceJ8 : PeriodicSubtileFaceIndex := ⟨.J8, 0, 0⟩ let dJ8 : PeriodicSubtileIndex := ⟨.D, -1, 0⟩ have hpJ8d := JunctionRefinementGeometry.hpJ8d q cfg C T cert (JunctionRefinementGeometry.hJ8vertex q cfg C T cert) @@ -2026,13 +2023,10 @@ private theorem fourthJunction : have hg4class := classifyDEface g4 hg4 let p4 := cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I4, 0, 0⟩) - let pJ7 := cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm ⟨.J7, 1, 0⟩) have rhoFace4 := JunctionRefinementGeometry.rhoFace4 q cfg C T cert have endpointAlternative := JunctionRefinementGeometry.endpointAlternative q cfg C T cert f4 g4 (JunctionRefinementGeometry.hf4point q cfg C T cert f4 hf4class rhoFace4) (JunctionRefinementGeometry.hg4point q cfg C T cert g4 hg4class rhoFace4) - let faceJ7 : PeriodicSubtileFaceIndex := ⟨.J7, 1, 0⟩ let cJ7 : PeriodicSubtileIndex := ⟨.C, 1, 0⟩ have hpJ7c := JunctionRefinementGeometry.hpJ7c q cfg C T cert (JunctionRefinementGeometry.hJ7vertex q cfg C T cert) diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean index 58ba5eca3d..ac0afac9cc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1MixedInteriorGeometry.lean @@ -246,7 +246,6 @@ private theorem pair_result : intro q cfg C T cert x footprint_iff_incident selected_disjoint pair_boundary noOtherFoot pair_cover a b k hab hak hbk hnot hthird ha hb have hdisjAB := selected_disjoint a.1 b.1 a.2 b.2 hab hnot - have hboundaryAB := pair_boundary a.1 b.1 a.2 b.2 hab hnot ha hb have hcover := pair_cover a b k hab hak hbk hnot hthird ha hb have hU := (footprint_iff_incident a.1 a.2).1 ha have hV := (footprint_iff_incident b.1 b.2).1 hb @@ -419,8 +418,6 @@ theorem P4590T1MixedInteriorGeometry have hsep : ∀ (i : Fin 3) (s : Bool) (j : Fin 3) (t : Bool), (i, s) ≠ (j, t) → ¬ (i = 0 ∧ j = 0) → Disjoint (cert.P i s).cells (cert.P j t).cells := hprec.2.2.2.2.2.2.2 - have hzero : (cert.P 0 true).cells ∩ (cert.P 0 false).cells = cert.O.cells := - hprec.2.2.2.2.2.2.1 have hboundaryCount : Nat.card {is : Fin 3 × Bool // x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} = 2 := hk have incident_foot (U : ProtoTile) (j : Fin 4) diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1OppositeCellsStar.lean b/LeanPool/ApollonianSuperharmonic/P4590T1OppositeCellsStar.lean index 3758fc814c..e5f9664b20 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1OppositeCellsStar.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1OppositeCellsStar.lean @@ -31,8 +31,6 @@ theorem P4590T1OppositeCellsStar (U V : ProtoTile) (x : GaussianInt) y ∈ FootprintVertices U ∨ y ∈ FootprintVertices V := by -- BODY obtain ⟨j, hj, hk⟩ := hopp - have hU : U.cells.Nonempty := ⟨_, hj⟩ - have hV : V.cells.Nonempty := ⟨_, hk⟩ have raw (W : ProtoTile) (a : GaussianInt) (ha : a ∈ W.cells) (y : GaussianInt) (hy : y = a ∨ y = a + 1 ∨ y = a + ⟨0, 1⟩ ∨ diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean index 8121daf4ff..257d2ffd02 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean @@ -500,7 +500,6 @@ private theorem hOcuts : intro q cfg C T cert x A B O seg hpre hIncidentA hIncidentB translation_zero incidentRaw hOpositive hxO have hOne := hOpositive hxO - have hOlat : LatticeTile O := hpre.2.2.2.1 hOne have hOneCell := incidentRaw O hOne hxO have isolated (j : Fin 4) : LatticeVertexIncidentCell x j ∈ A.cells ∨ @@ -550,10 +549,6 @@ private theorem hOcuts : change LatticeVertexIncidentCell x jB ∉ B.cells \ O.cells intro h exact hjB (Finset.mem_sdiff.mp h).1 - have hDplusNe : (TileCellComplement A O).cells.Nonempty := - ⟨LatticeVertexIncidentCell x jB, hDplusIn⟩ - have hDminusNe : (TileCellComplement B O).cells.Nonempty := - ⟨LatticeVertexIncidentCell x jA, hDminusIn⟩ have hOB : x ∈ BoundaryFootprintVertices O := by exact P3161T2IncidentBoundary O x hOneCell ⟨jA, hjAO⟩ have hDplusB : x ∈ BoundaryFootprintVertices (TileCellComplement A O) := by @@ -927,15 +922,7 @@ theorem P4590T1RestoredBoundaryGeometry : let V := cert.S 1 false let seg := cert.exceptionalSegments let sec := BandExceptionalRestorationSectorOrder q cfg C T cert - have hsec := sec have hpre := P4339T1PrecursorSupportGeometry C q cfg T cert - have hABcells : A.cells ∩ B.cells = O.cells := by - simpa [A, B, O] using hpre.2.2.2.2.2.2.1 - have hsep := hpre.2.2.2.2.2.2.2 - have hABdisj : Disjoint A.cells Ctile.cells := by - simpa [A, Ctile] using hsep 0 true 1 true (by decide) (by decide) - have hBDdisj : Disjoint B.cells Dtile.cells := by - simpa [B, Dtile] using hsep 0 false 1 false (by decide) (by decide) have hAne : A.cells.Nonempty := (LatticeTileGridStructure A (cert.parent_lattice 0 true)).1.1 have hBne : B.cells.Nonempty := @@ -959,8 +946,6 @@ theorem P4590T1RestoredBoundaryGeometry : (∃ j : Fin 4, LatticeVertexIncidentCell x j ∉ B.cells) := boundary_sectors B hBne (by simpa [B] using hB) have noThird := RestoredBoundaryGeometry.noThird q cfg C T cert x hk hA hB - have hnotO := RestoredBoundaryGeometry.hnotO q cfg C T cert x hnoncentral hOcent - have hrawAB := BandOrderedGeneralRawSupport q cfg C T cert have hxA' := rawBoundary A hAne (by simpa [A] using hA) have hxB' := rawBoundary B hBne (by simpa [B] using hB) have hdeletedNe : (TileCellComplement A O).cells.Nonempty := @@ -997,11 +982,6 @@ theorem P4590T1RestoredBoundaryGeometry : have hOpositive := RestoredBoundaryGeometry.hOpositive q cfg C T cert x hnoncentral hOcent have hOcuts := RestoredBoundaryGeometry.hOcuts q cfg C T cert x hpre hIncidentA hIncidentB translation_zero incidentRaw hOpositive - have hsupport := RestoredBoundaryGeometry.hsupport q cfg C T cert x hrawAB hxA' hxB' - let p1 := cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) - let p2 := cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm ⟨.I2, 0, 0⟩) have hQne : Q.cells.Nonempty := hpre.2.2.2.2.1 have hSne : S.cells.Nonempty := hpre.2.2.2.2.2.1 have hCparent : LatticeTile Ctile := cert.parent_lattice 1 true diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean index cf93126376..c59a4dbf7b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean @@ -119,9 +119,6 @@ private theorem halfTurnBoundary : apply Finset.nonempty_iff_ne_empty.mpr intro he exact hne.ne_empty ((TileHalfTurnFormulas U).2.2.1.mp he) - have hqne : (TileQuarterTurn (TileQuarterTurn U)).cells.Nonempty := by - rw [← hcells] - exact hhalfne have hhalfBound : BoundaryFootprintVertices (TileHalfTurn U) = BoundaryFootprintVertices (TileQuarterTurn (TileQuarterTurn U)) := by have hempty : (TileHalfTurn U).cells = ∅ → @@ -1169,8 +1166,6 @@ private theorem hEdgesQC : {y, x} he.1 x (by simp) have hyC := edgeEndpoint (cert.P 1 true) {y, x} he.2 y (by simp) have hxC := edgeEndpoint (cert.P 1 true) {y, x} he.2 x (by simp) - have hxA' := edgeEndpoint (cert.P 0 true) - {x, z} hf.1 x (by simp) have hzA := edgeEndpoint (cert.P 0 true) {x, z} hf.1 z (by simp) have hxC' := edgeEndpoint (cert.P 1 true) {x, z} hf.2 x (by simp) @@ -2029,8 +2024,6 @@ private theorem positiveCase : have hrho3 : cert.modified.rho f3 = cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩) := cert.modified_face_points _ - have hz13 := RightInteriorGeometry.hz13 q cfg C T cert f g hpair hrho1 hrho3 - (RightInteriorGeometry.hend q cfg C T cert f g hpath) let b : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ let fidx : PeriodicSubtileIndex := ⟨.F, 0, 0⟩ have hfa10 : cert.modified.plane.faceVertex f1 0 = a := by @@ -2121,7 +2114,6 @@ theorem P4590T1RightInteriorGeometry : ⟨u.re - u.im + w.re + w.im, u.re + u.im + w.im - w.re⟩ let H : ProtoTile → ProtoTile := fun U => TileTranslation (TileHalfTurn U) t - let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ have hHcells := RightInteriorGeometry.hHcells q u have halfTurnRealization := RightInteriorGeometry.halfTurnRealization q T u (RightInteriorGeometry.ht q cfg C T cert u hu) @@ -2193,18 +2185,6 @@ theorem P4590T1RightInteriorGeometry : exact (image_mem _ _ (parentFootprint 0) v).2 (by simpa [v, F] using hB) have hvC : v ∈ FootprintVertices (cert.P 1 true) := by exact (image_mem _ _ (parentFootprint 1) v).2 (by simpa [v, F] using hD) - let A := {is : Fin 3 × Bool // - v ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} - let B := {is : Fin 3 × Bool // - x ∈ BoundaryFootprintVertices (cert.P is.1 is.2)} - let e : A ≃ B := - { toFun := fun a => ⟨(a.val.1, !a.val.2), hboundaryFlip a.val.1 a.val.2 |>.mp a.property⟩ - invFun := fun b => ⟨(b.val.1, !b.val.2), by - have hb : x ∈ BoundaryFootprintVertices - (cert.P b.val.1 (!(!b.val.2))) := by simpa using b.property - exact (hboundaryFlip b.val.1 (!b.val.2)).mpr hb⟩ - left_inv := by intro a; apply Subtype.ext; simp - right_inv := by intro b; apply Subtype.ext; simp } have hvk := RightInteriorGeometry.hvk q cfg C T cert x hk u hboundaryFlip have hpositive := positiveCase v hvk hvA hvC let wo := BandVectors.1 (q 3) (q 2) diff --git a/LeanPool/ApollonianSuperharmonic/P4616T1FirstPredecessorCentroids.lean b/LeanPool/ApollonianSuperharmonic/P4616T1FirstPredecessorCentroids.lean index 9a5d665a87..2378b33e76 100644 --- a/LeanPool/ApollonianSuperharmonic/P4616T1FirstPredecessorCentroids.lean +++ b/LeanPool/ApollonianSuperharmonic/P4616T1FirstPredecessorCentroids.lean @@ -58,7 +58,6 @@ theorem P4616T1FirstPredecessorCentroids have hE := (cert.outer_occurrence 2 true).2.2 have hF := (cert.outer_occurrence 2 false).2.2 have hs := congrArg GaussianRealPoint (VectorRecursionLaws q cfg.proper.1).1 - have h20 := congrArg GaussianRealPoint cfg.firstVectorTwo have hf2 := congrArg GaussianRealPoint (((VectorRecursionLaws cfg.firstPredecessor cfg.firstProper.1).2.2.2.2 cfg.firstProper 1).1) diff --git a/LeanPool/ApollonianSuperharmonic/P4630T1CellRouteLift.lean b/LeanPool/ApollonianSuperharmonic/P4630T1CellRouteLift.lean index c4b701908b..8f3c1d3787 100644 --- a/LeanPool/ApollonianSuperharmonic/P4630T1CellRouteLift.lean +++ b/LeanPool/ApollonianSuperharmonic/P4630T1CellRouteLift.lean @@ -426,11 +426,8 @@ theorem P4630T1CellRouteLift classical let safe := fun a : PeriodicSubtileIndex => ¬ (a.first = 0 ∧ a.second = 0) ∧ ∀ i k, a ≠ P4630T1RingIndex i k - let shift := fun a : PeriodicSubtileIndex => - (a.first : GaussianInt) * cert.u + (a.second : GaussianInt) * cert.v let clean := fun x : LatticeCell => ∀ i k, x ∉ (SubtileOccurrenceInterpretation cert.P cert.u cert.v (P4630T1RingIndex i k)).cells - let O := fun a : PeriodicSubtileIndex => TileTranslation cert.O (shift a) let V := fun a : PeriodicSubtileIndex => (⟨(cert.modified.tile a).cells.filter clean, (cert.modified.tile a).anchor⟩ : ProtoTile) let E := fun c d => AllowedSubtileIncidence c d ∧ safe c ∧ safe d diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean b/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean index a7b0474647..c98fde6054 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean @@ -116,9 +116,6 @@ private theorem hpathPlusO : · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hDplus).elim · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hO).elim -private abbrev hpathMinusO := - ApollonianSuperharmonic.ContactStarCases.hpathPlusO - private abbrev boundaryEdgeFootprint := BoundaryFootprintInclusion.boundaryEdge @@ -880,16 +877,12 @@ theorem P4638T1ContactStarCoverage (Dplus Dminus O O' X Y U V : ProtoTile) (LatticeTileGridStructure Dplus hplus).1.1 have hDminus : Dminus.cells.Nonempty := (LatticeTileGridStructure Dminus hminus).1.1 - have hcheckO : NoCheckerboardCellVertex (O.cells : Set LatticeCell) := - (LatticeTileGridStructure O hOL).2.1 have hcheckPlus : NoCheckerboardCellVertex (Dplus.cells : Set LatticeCell) := (LatticeTileGridStructure Dplus hplus).2.1 have hcheckMinus : NoCheckerboardCellVertex (Dminus.cells : Set LatticeCell) := (LatticeTileGridStructure Dminus hminus).2.1 have hdisjPlusO := ContactStarCases.hdisjPlusO Dplus O hO htplus hDplus have hdisjMinusO := ContactStarCases.hdisjMinusO Dminus O hO htminus hDminus - have hpathPlusO := ContactStarCases.hpathPlusO Dplus O hO htplus hDplus - have hpathMinusO := ContactStarCases.hpathMinusO Dminus O hO htminus hDminus have boundaryEdgeFootprint (T : ProtoTile) (e : Finset GaussianInt) (he : e ∈ BoundaryFootprintEdges T) := ContactStarCases.boundaryEdgeFootprint T e he let edgeAt (y : GaussianInt) : Fin 4 → Finset GaussianInt := @@ -968,9 +961,8 @@ theorem P4638T1ContactStarCoverage (Dplus Dminus O O' X Y U V : ProtoTile) Dplus Dminus O O' X Y U V hO hX hY hU hV data hcheckPlus hcheckMinus hdisjPlusO hdisjMinusO boundaryVertexOfCross coverLeft coverRight noCheckerboardDiagonal mixedCornerContradiction y j hcenter hside1O hside3O - have singletonCorner (y : GaussianInt) (j : Fin 4) := ContactStarCases.singletonCorner y j intro y hy a hya - obtain ⟨jo, hjo⟩ := incident O y hO hy + obtain ⟨jo, hjo⟩ := incident O y (LatticeTileGridStructure O hOL).1.1 hy have ha := ContactStarCases.ha y a hya have coverAt (i : Fin 4) := ContactStarCases.coverAt Dplus Dminus O coverLeft coverRight cornerRescue y jo hjo i diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean index 913330f33a..85a94f89ac 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean @@ -857,10 +857,6 @@ theorem P4638T1EmptyFordLocalization (r : Fin 4 → CircleCoordinates) let E2 : GaussianInt ≃ GaussianInt := E1.trans E1 let E3 : GaussianInt ≃ GaussianInt := E2.trans E1 let E : Fin 4 → GaussianInt ≃ GaussianInt := ![Equiv.refl _, E1, E2, E3] - let TP (k : Fin 4) (T : ProtoTile) : ProtoTile := - if k = 0 then T else if k = 1 then TileQuarterTurn T else - if k = 2 then TileQuarterTurn (TileQuarterTurn T) else - TileQuarterTurn (TileQuarterTurn (TileQuarterTurn T)) let RP (k : Fin 4) (x : Real × Real) : Real × Real := if k = 0 then x else if k = 1 then (-x.2, x.1) else if k = 2 then (-x.1, -x.2) else (x.2, -x.1) @@ -874,8 +870,6 @@ theorem P4638T1EmptyFordLocalization (r : Fin 4 → CircleCoordinates) have hanchorpow := EmptyFordGeometry.hanchorpow g k htilepow have hcentpow := EmptyFordGeometry.hcentpow g k htilepow have hchild := EmptyFordGeometry.hchild r P g hrecg hgfalse - let D : GaussianInt → Real × Real := fun z => - (1 / 2 : Real) • (GaussianRealPoint z - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) have hpointrot (z : GaussianInt) := EmptyFordGeometry.hpointrot k z have hDrot (z : GaussianInt) := EmptyFordGeometry.hDrot k z have hDcanonical := EmptyFordGeometry.hDcanonical r P g htargetvec k hvecpow hDrot @@ -883,19 +877,16 @@ theorem P4638T1EmptyFordLocalization (r : Fin 4 → CircleCoordinates) fin_cases k <;> ext <;> simp [RP] <;> ring have hRPsub (x y : Real × Real) : RP k (x - y) = RP k x - RP k y := by fin_cases k <;> ext <;> simp [RP] <;> ring - have hOempty := EmptyFordGeometry.hOempty O hempty g cellTurn_bij k hcellpow let w₀ := (BandPackingSymmetryTileAction g O).anchor have hw₀ : w₀ = VP k O.anchor := EmptyFordGeometry.hw₀ O g k hanchorpow have hObase : TileCentroid O = GaussianRealPoint O.anchor := by simp [TileCentroid, hempty, GaussianRealPoint] - have hOcent := EmptyFordGeometry.hOcent O k g hw₀ hcentpow hpointrot hObase have hAcent' := EmptyFordGeometry.hAcent' r A O hAcent have hBcent' := EmptyFordGeometry.hBcent' r B O hBcent have hAactual := EmptyFordGeometry.hAactual r A O P k g hw₀ hcentpow hpointrot hDcanonical hRPadd hObase hAcent' have hBactual := EmptyFordGeometry.hBactual r B O P k g hw₀ hcentpow hpointrot hDcanonical hRPsub hObase hBcent' - have hfordC : (FordRecursiveQuadruple P) 0 = FordCircleCoordinate P.p P.q := by rfl have hAproto := EmptyFordGeometry.hAproto r A hA P g hchild have hBproto := EmptyFordGeometry.hBproto r B hB P g hchild let uA : GaussianInt := w₀ - ⟨(P.q₁ : Int), 0⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1MidpointReflection.lean b/LeanPool/ApollonianSuperharmonic/P4638T1MidpointReflection.lean index 9b8f417ca4..0ea935b3d0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1MidpointReflection.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1MidpointReflection.lean @@ -34,7 +34,6 @@ theorem P4638T1MidpointReflection (C : CircleCoordinates) (T U : ProtoTile) have htransnonempty : (TileTranslation T u).cells.Nonempty := by rw [(TileTranslationFormulas T u).1] exact hnonempty.image _ - have hUnonempty : U.cells.Nonempty := hcells.symm ▸ htransnonempty have hcentcells : TileCentroid U = TileCentroid (TileTranslation T u) := by simp only [TileCentroid, ite_eq_left htransnonempty, hcells] have hrealcells : TileRealization U = TileRealization (TileTranslation T u) := by diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2IncidenceLedger.lean b/LeanPool/ApollonianSuperharmonic/P4677T2IncidenceLedger.lean index 2ad25ed270..3421bfac86 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2IncidenceLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2IncidenceLedger.lean @@ -95,45 +95,6 @@ theorem P4677T2IncidenceLedger : induction h with | symm _ ih => exact ih.symm | _ => simp [forward] - have positive (a b : PeriodicSubtileIndex) (h : forward a b) : - AllowedSubtileIncidence a b := by - rcases a with ⟨al, m, n⟩ - rcases b with ⟨bl, p, q⟩ - cases al <;> cases bl <;> simp only [forward] at h - · rcases h with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ - · exact AllowedSubtileIncidence.AB _ _ - · exact AllowedSubtileIncidence.AB01 _ _ - · exact AllowedSubtileIncidence.AB11 _ _ - · rcases h with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ - · exact AllowedSubtileIncidence.AC _ _ - · exact AllowedSubtileIncidence.AC11 _ _ - · rcases h with ⟨rfl, rfl⟩ - exact AllowedSubtileIncidence.AD _ _ - · rcases h with ⟨rfl, rfl⟩ - exact AllowedSubtileIncidence.AE01 _ _ - · rcases h with ⟨rfl, rfl⟩ - exact AllowedSubtileIncidence.AF _ _ - · rcases h with ⟨rfl, rfl⟩ - exact AllowedSubtileIncidence.BC _ _ - · rcases h with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ - · exact AllowedSubtileIncidence.BD _ _ - · exact AllowedSubtileIncidence.BDm1m1 _ _ - · rcases h with ⟨rfl, rfl⟩ - exact AllowedSubtileIncidence.BE _ _ - · rcases h with ⟨rfl, rfl⟩ - exact AllowedSubtileIncidence.BF0m1 _ _ - · rcases h with ⟨rfl, rfl⟩ - exact AllowedSubtileIncidence.CDm10 _ _ - · rcases h with ⟨rfl, rfl⟩ - exact AllowedSubtileIncidence.CEm10 _ _ - · rcases h with ⟨rfl, rfl⟩ - exact AllowedSubtileIncidence.CF _ _ - · rcases h with ⟨rfl, rfl⟩ - exact AllowedSubtileIncidence.DE _ _ - · rcases h with ⟨rfl, rfl⟩ - exact AllowedSubtileIncidence.DF10 _ _ - have normal_iff (a b) : AllowedSubtileIncidence a b ↔ forward a b ∨ forward b a := - ⟨normal, fun h => h.elim (positive a b) (fun h => .symm (positive b a h))⟩ refine ⟨fun a b => ⟨AllowedSubtileIncidence.symm, AllowedSubtileIncidence.symm⟩, ?_, ?_, ?_, ?_, ?_⟩ · intro a h diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean index 09b9593f46..3c10c05cbe 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean @@ -181,8 +181,6 @@ private theorem p₁mem : have hzv := hp₁v z hz exact ⟨hXf hzv.1, hYf hzv.2⟩ -private abbrev p₃mem := ApollonianSuperharmonic.PrecursorWalkGeometry.p₁mem - private theorem qmem : (by classical @@ -402,15 +400,10 @@ theorem P4677T2PrecursorWalk : P4677T2TouchingWalk X Y x a hfirst.1 ⟨hx.1, hx.2⟩ ⟨haX, haY⟩ obtain ⟨p₃, hp₃h, hp₃l, hp₃v, hp₃e⟩ := P4677T2TouchingWalk Z W b y hlast.1 ⟨hbZ, hbW⟩ ⟨hy.1, hy.2⟩ - have hOeq : O.cells = O'.cells := hcell let R : GaussianInt → GaussianInt → Prop := fun u v => u ∈ FootprintVertices A ∩ FootprintVertices B ∧ v ∈ FootprintVertices A ∩ FootprintVertices B ∧ {u, v} ∈ FootprintEdges A ∩ FootprintEdges B - have R_symm (u v : GaussianInt) (huv : R u v) : R v u := PrecursorWalkGeometry.R_symm A B u v huv - have reverse_reach {u v : GaussianInt} - (h : Relation.ReflTransGen R u v) : Relation.ReflTransGen R v u := - PrecursorWalkGeometry.reverse_reach A B R_symm (u := u) (v := v) h have head_reach (u : GaussianInt) (l : List GaussianInt) (hc : List.IsChain R (u :: l)) : ∀ z ∈ u :: l, Relation.ReflTransGen R u z := PrecursorWalkGeometry.head_reach A B u l hc @@ -429,12 +422,6 @@ theorem P4677T2PrecursorWalk : hp₁v hp₁e edge_parent edge_parentB have p₃chain : List.IsChain R p₃ := PrecursorWalkGeometry.p₃chain A B Z W hZc hWc hZf hWf p₃ hp₃v hp₃e edge_parent edge_parentB - have p₁mem (z : GaussianInt) (hz : z ∈ p₁) : - z ∈ FootprintVertices A ∩ FootprintVertices B := PrecursorWalkGeometry.p₁mem A B X Y hXf - hYf p₁ hp₁v z hz - have p₃mem (z : GaussianInt) (hz : z ∈ p₃) : - z ∈ FootprintVertices A ∩ FootprintVertices B := PrecursorWalkGeometry.p₃mem A B Z W hZf - hWf p₃ hp₃v z hz by_cases hneO : O.cells.Nonempty · have hneO' : O'.cells.Nonempty := by rw [← hcell]; exact hneO have hcycle := LatticeTileBoundarySimpleGridCycle O (hdisk hneO) diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean b/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean index a7267dd6f3..08bb64f0dc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean @@ -880,8 +880,6 @@ theorem P4677T2ThreeConnected cases z with | mk l m n => cases l <;> simp [linkList] have nonempty (z : PeriodicSubtileIndex) : linkList z ≠ [] := by cases z with | mk l m n => cases l <;> simp [linkList] - have adjacent (z : PeriodicSubtileIndex) : - ∀ u ∈ linkList z, AllowedSubtileIncidence z u := ThreeConnectivityProof.adjacent z have edge_mem_link {z u : PeriodicSubtileIndex} (h : AllowedSubtileIncidence z u) : u ∈ linkList z ∧ z ∈ linkList u := ThreeConnectivityProof.edge_mem_link (z := z) (u := u) h diff --git a/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean index fd9ffcacd4..27b6c459ee 100644 --- a/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P4715T1CoefficientFaces.lean @@ -146,14 +146,12 @@ private theorem D_closure : rw [Real.dist_eq] have heq : ((1-r) • z + r • c).1 - z.1 = r * (1/3-z.1) := by dsimp [c]; ring rw [heq, abs_mul, abs_of_pos hr0] - have hz1 : 0 ≤ z.1 ∧ z.1 ≤ 1 := ⟨hzw.1, by linarith [hzw.2.1]⟩ have hc : |(1:ℝ)/3-z.1| ≤ 1 := by rw [abs_le]; constructor <;> linarith nlinarith [mul_le_mul_of_nonneg_left hc hr0.le] have hcoord2 : dist y.2 z.2 ≤ r := by rw [Real.dist_eq] have heq : ((1-r) • z + r • c).2 - z.2 = r * (1/3-z.2) := by dsimp [c]; ring rw [heq, abs_mul, abs_of_pos hr0] - have hz2 : 0 ≤ z.2 ∧ z.2 ≤ 1 := ⟨hzw.2.1, by linarith [hzw.2.2]⟩ have hc : |(1:ℝ)/3-z.2| ≤ 1 := by rw [abs_le]; constructor <;> linarith nlinarith [mul_le_mul_of_nonneg_left hc hr0.le] have hdist : dist y z ≤ r := by @@ -1358,7 +1356,6 @@ theorem P4715T1CoefficientFaces : have Dopen := CoefficientFaceTopology.Dopen have Dconvex := CoefficientFaceProof.Dconvex have D_nonempty := CoefficientFaceTopology.D_nonempty - let W : Set (ℝ × ℝ) := {z | 0 ≤ z.1 ∧ 0 ≤ z.2 ∧ z.1+z.2 ≤ 1} have D_subset_W := CoefficientFaceTopology.D_subset_W have W_closed := CoefficientFaceTopology.W_closed have D_closure := CoefficientFaceProof.D_closure D_subset_W @@ -1370,20 +1367,9 @@ theorem P4715T1CoefficientFaces : have image_segment (q v w : ℝ×ℝ) (hd : v.1*w.2-v.2*w.1≠0) (x y : ℝ×ℝ) := CoefficientFaceTopology.image_segment inv_right inv_left q v w hd x y - let stdPts : Fin 3 → ℝ×ℝ := ![(0,0),(1,0),(0,1)] have W_convex := CoefficientFaceTopology.W_convex have W_eq_stdHull := CoefficientFaceProof.W_eq_stdHull W_convex - let affineLin (v w : ℝ×ℝ) : (ℝ×ℝ) →ₗ[ℝ] (ℝ×ℝ) := { - toFun := lin v w - map_add' := by intro x y; ext <;> simp [lin] <;> ring - map_smul' := by intro c x; ext <;> simp [lin] <;> ring - } - let affineMapTri (q v w : ℝ×ℝ) : AffineMap ℝ (ℝ×ℝ) (ℝ×ℝ) := { - toFun := fun x => q + lin v w x - linear := affineLin v w - map_vadd' := by intro x y; ext <;> simp [affineLin,lin] <;> ring - } have hull_affine (q v w : ℝ×ℝ) := CoefficientFaceTopology.hull_affine W_eq_stdHull q v w have region_image (f : PeriodicSubtileFaceIndex) (hd : faceDet f ≠ 0) := CoefficientFaceProof.region_image delta_nonzero inv_right @@ -1407,15 +1393,6 @@ theorem P4715T1CoefficientFaces : (hij : i ≠ j) := CoefficientFaceProof.region_disjoint_arc faceDet_nonzero delta_nonzero inv_right inv_left image_segment region_image std_edge_disjoint f i j hij - let translation (k : Int × Int) : AffineMap ℝ (ℝ × ℝ) (ℝ × ℝ) := { - toFun := fun x => x + ((k.1 : Real), (k.2 : Real)) - linear := LinearMap.id - map_vadd' := by intro x y; simp [add_assoc] - } - let bary (f : PeriodicSubtileFaceIndex) (s t : Real) : ℝ × ℝ := - (1 - s - t) • P4715T1Position (SixSubtileFaceVertices f 0) + - s • P4715T1Position (SixSubtileFaceVertices f 1) + - t • P4715T1Position (SixSubtileFaceVertices f 2) have bary_shift (k : Int × Int) (j : Fin 12) (s t : Real) := CoefficientFaceTopology.bary_shift position_shift face_vertex_shift k j s t have region_shift (k : Int × Int) (j : Fin 12) := CoefficientFaceProof.region_shift bary_shift k j diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean index bd01d85b5f..031d04c1c4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean +++ b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean @@ -2642,8 +2642,6 @@ theorem P4812T1RegularFaceWalks have aNeNegB := RegularFaceDetails.aNeNegB L k have aNeAmB := RegularFaceDetails.aNeAmB L k have negBNeAmB := RegularFaceDetails.negBNeAmB L k - let fs := fun (u : L) (f : D.plane.Face) => - D.faces (Sum.map (u + ·) (u + ·) (D.faces.symm f)) refine ⟨rho, ?_, (RegularFaceProperties.rhoPeriodic L k D ru rd), path, (RegularFaceProperties.pathReverse L k D p0 p1 p2), (RegularFaceProperties.pathPeriodic L k D p0 p1 p2 (RegularFaceDetails.shiftEq L) mapTranslate diff --git a/LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean b/LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean index e0c4908c63..f880277421 100644 --- a/LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean +++ b/LeanPool/ApollonianSuperharmonic/P4818T1Representatives.lean @@ -678,7 +678,6 @@ theorem P4818T1Representatives (K : DiamondParameter) : let a : GaussianInt := ⟨0, -2 * k⟩ let b : GaussianInt := ⟨k + 1, k⟩ let c : GaussianInt := ⟨-k - 1, k⟩ - have hk : 0 < k := RepresentativesProof.hk K obtain ⟨hcoeff, hA, hB, hC⟩ := P4818T1ClosedOverlaps K have hmem (z : GaussianInt) : z ∈ DiamondVertexDomains K false ↔ -k ≤ z.re ∧ z.re ≤ k ∧ 0 ≤ z.im ∧ z.im ≤ 2 * k ∧ diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean b/LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean index a5a7f93c5c..00531f5db8 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean @@ -881,10 +881,6 @@ theorem P4828T1CircularPlacement (L : Real) P4828T1Disk (q 0) ⊆ P4828T1Gap L q := by -- BODY have hchild : 0 < (q 0).1 := CircularPlacementConstruction.hchild q hq - have hcpos : ∀ i : Fin 4, 0 < (q i).1 := CircularPlacementConstruction.hcpos q hq hpositive - have normCast (w : GaussianInt) : - Complex.normSq (w : Complex) = (Zsqrtd.norm w : Real) := - CircularPlacementConstruction.normCast w have circleDist (i j : Fin 4) (hij : i ≠ j) (hi : 0 < (q i).1) (hj : 0 < (q j).1) : dist (((q i).2 : Complex) / (q i).1) @@ -892,48 +888,7 @@ theorem P4828T1CircularPlacement (L : Real) 1 / (q i).1 + 1 / (q j).1 := CircularPlacementConstruction.circleDist q hq i j hij hi hj let ctr (i : Fin 4) : Complex := ((q i).2 : Complex) / (q i).1 let rad (i : Fin 4) : Real := 1 / (q i).1 - have rpos (i : Fin 4) : 0 < rad i := CircularPlacementConstruction.rpos q hq hpositive i - have ctrDist (i j : Fin 4) (hij : i ≠ j) : - dist (ctr i) (ctr j) = rad i + rad j := CircularPlacementConstruction.ctrDist q hq - hpositive i j hij - have hd12 := ctrDist 1 2 (by decide) - have hd13 := ctrDist 1 3 (by decide) - have hd10 := ctrDist 1 0 (by decide) - have hd23 := ctrDist 2 3 (by decide) - have hd20 := ctrDist 2 0 (by decide) - have hd30 := ctrDist 3 0 (by decide) - have hd21 : dist (ctr 2) (ctr 1) = rad 2 + rad 1 := CircularPlacementConstruction.hd21 q hq - hpositive - have hd31 : dist (ctr 3) (ctr 1) = rad 3 + rad 1 := CircularPlacementConstruction.hd31 q hq - hpositive - have hd32 : dist (ctr 3) (ctr 2) = rad 3 + rad 2 := CircularPlacementConstruction.hd32 q hq - hpositive let crossC : Complex → Complex → Real := fun z w => z.re * w.im - z.im * w.re - let dotC : Complex → Complex → Real := fun z w => z.re * w.re + z.im * w.im - have soddySameSide (A B C D : Complex) (a b c d : Real) - (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) (hd : 0 < d) - (hdA : d < a) (hdB : d < b) - (hAB : dist A B = a + b) (hAC : dist A C = a + c) (hAD : dist A D = a + d) - (hBC : dist B C = b + c) (hBD : dist B D = b + d) (hCD : dist C D = c + d) : - 0 < crossC (B - A) (C - A) * crossC (B - A) (D - A) ∧ - (d * (a + b)) ^ 2 < crossC (B - A) (D - A) ^ 2 := - CircularPlacementConstruction.soddySameSide A - B C D a b c d ha hb hc hd hdA hdB hAB hAC hAD hBC hBD hCD - have crossSq_le (z w : Complex) : - crossC z w ^ 2 ≤ Complex.normSq z * Complex.normSq w := - CircularPlacementConstruction.crossSq_le z w - have diskEdgeSide (A B D p : Complex) (a d : Real) - (ha : 0 < a) (hd : 0 < d) - (hAB : dist A B = a) - (hmargin : (d * a) ^ 2 < crossC (B - A) (D - A) ^ 2) - (hpD : dist D p < d) : - 0 < crossC (B - A) (D - A) * crossC (B - A) (p - A) := - CircularPlacementConstruction.diskEdgeSide A - B D p a d ha hd hAB hmargin hpD - have sideTrans (x y z : Real) (hxy : 0 < x * y) (hyz : 0 < y * z) : - 0 < x * z := CircularPlacementConstruction.sideTrans x y z hxy hyz - have ratioPos (x y : Real) (hxy : 0 < x * y) : 0 < y / x := - CircularPlacementConstruction.ratioPos x y hxy have strictSides (A B C p : Complex) (harea : crossC (B - A) (C - A) ≠ 0) (hC : 0 < crossC (B - A) (p - A) / crossC (B - A) (C - A)) @@ -942,68 +897,15 @@ theorem P4828T1CircularPlacement (L : Real) crossC (B - A) (p - A) / crossC (B - A) (C - A)) : p ∈ interior (convexHull Real ({A, B, C} : Set Complex)) := CircularPlacementConstruction.strictSides A B C p harea hC hB hA - have radChildLtParent (j : Fin 3) : rad 0 < rad j.succ := - CircularPlacementConstruction.radChildLtParent q hq hpositive j - have hr01 : rad 0 < rad 1 := CircularPlacementConstruction.hr01 q hq hpositive - have hr02 : rad 0 < rad 2 := CircularPlacementConstruction.hr02 q hq hpositive - have hr03 : rad 0 < rad 3 := CircularPlacementConstruction.hr03 q hq hpositive - have hside123 := soddySameSide (ctr 1) (ctr 2) (ctr 3) (ctr 0) - (rad 1) (rad 2) (rad 3) (rad 0) - (rpos 1) (rpos 2) (rpos 3) (rpos 0) hr01 hr02 - hd12 hd13 hd10 hd23 hd20 hd30 - have hside231 := soddySameSide (ctr 2) (ctr 3) (ctr 1) (ctr 0) - (rad 2) (rad 3) (rad 1) (rad 0) - (rpos 2) (rpos 3) (rpos 1) (rpos 0) hr02 hr03 - hd23 hd21 hd20 hd31 hd30 hd10 - have hside312 := soddySameSide (ctr 3) (ctr 1) (ctr 2) (ctr 0) - (rad 3) (rad 1) (rad 2) (rad 0) - (rpos 3) (rpos 1) (rpos 2) (rpos 0) hr03 hr01 - hd31 hd32 hd30 hd12 hd10 hd20 intro p hp change dist p (ctr 0) < rad 0 at hp - have hp12 := diskEdgeSide (ctr 1) (ctr 2) (ctr 0) p - (rad 1 + rad 2) (rad 0) (add_pos (rpos 1) (rpos 2)) (rpos 0) - (ctrDist 1 2 (by decide)) hside123.2 (by simpa only [ctr, rad, Complex.ofReal_intCast, - dist_comm] using hp) - have hp23 := diskEdgeSide (ctr 2) (ctr 3) (ctr 0) p - (rad 2 + rad 3) (rad 0) (add_pos (rpos 2) (rpos 3)) (rpos 0) - (ctrDist 2 3 (by decide)) hside231.2 (by simpa only [ctr, rad, Complex.ofReal_intCast, - dist_comm] using hp) - have hp31 := diskEdgeSide (ctr 3) (ctr 1) (ctr 0) p - (rad 3 + rad 1) (rad 0) (add_pos (rpos 3) (rpos 1)) (rpos 0) - (ctrDist 3 1 (by decide)) hside312.2 (by simpa only [ctr, rad, Complex.ofReal_intCast, - dist_comm] using hp) - have htri123 := sideTrans - (crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1)) - (crossC (ctr 2 - ctr 1) (ctr 0 - ctr 1)) - (crossC (ctr 2 - ctr 1) (p - ctr 1)) hside123.1 hp12 - have htri231 := sideTrans - (crossC (ctr 3 - ctr 2) (ctr 1 - ctr 2)) - (crossC (ctr 3 - ctr 2) (ctr 0 - ctr 2)) - (crossC (ctr 3 - ctr 2) (p - ctr 2)) hside231.1 hp23 - have htri312 := sideTrans - (crossC (ctr 1 - ctr 3) (ctr 2 - ctr 3)) - (crossC (ctr 1 - ctr 3) (ctr 0 - ctr 3)) - (crossC (ctr 1 - ctr 3) (p - ctr 3)) hside312.1 hp31 let den : Real := crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1) have harea : crossC (ctr 2 - ctr 1) (ctr 3 - ctr 1) ≠ 0 := CircularPlacementConstruction.harea q hq hpositive have hLamC : 0 < crossC (ctr 2 - ctr 1) (p - ctr 1) / den := CircularPlacementConstruction.hLamC q hq hpositive p hp - have hden312 : crossC (ctr 1 - ctr 3) (ctr 2 - ctr 3) = den := - CircularPlacementConstruction.hden312 q - have hnum312 : crossC (ctr 1 - ctr 3) (p - ctr 3) = - crossC (p - ctr 1) (ctr 3 - ctr 1) := CircularPlacementConstruction.hnum312 q p have hLamB : 0 < crossC (p - ctr 1) (ctr 3 - ctr 1) / den := CircularPlacementConstruction.hLamB q hq hpositive p hp - have hden231 : crossC (ctr 3 - ctr 2) (ctr 1 - ctr 2) = den := - CircularPlacementConstruction.hden231 q - have hnum231 : crossC (ctr 3 - ctr 2) (p - ctr 2) = - crossC (ctr 3 - ctr 2) (ctr 1 - ctr 2) - - crossC (p - ctr 1) (ctr 3 - ctr 1) - - crossC (ctr 2 - ctr 1) (p - ctr 1) := CircularPlacementConstruction.hnum231 q p - have hLamA : 0 < crossC (ctr 3 - ctr 2) (p - ctr 2) / den := - CircularPlacementConstruction.hLamA q hq hpositive p hp have hA : 0 < 1 - crossC (p - ctr 1) (ctr 3 - ctr 1) / den - crossC (ctr 2 - ctr 1) (p - ctr 1) / den := CircularPlacementConstruction.hA q hq hpositive diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1ConstructorSupport.lean b/LeanPool/ApollonianSuperharmonic/P4828T1ConstructorSupport.lean index ab0f0516c2..5448915ebd 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1ConstructorSupport.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1ConstructorSupport.lean @@ -47,7 +47,6 @@ theorem P4828T1ConstructorSupport (L : Real) (by simpa only [hidx] using hk) (by simpa only [hidx] using hj) have facts := ProperBandCurvatureStructure t ht have p0 := facts.1 - have n0 := (SemiProperForestClassification t ht.1).1 (0 : Fin 4) have n1 := facts.2.1 (0 : Fin 3) have n2 := facts.2.1 (1 : Fin 3) have n3 := facts.2.1 (2 : Fin 3) diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean index 32895bb136..21cf55ce6a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1LeftRootGeometry.lean @@ -432,55 +432,12 @@ theorem P4828T1LeftRootGeometry (a : GaussianInt) : fin_cases k <;> fin_cases j <;> simp [P4828T1Root] at hk hj ⊢; ring let y : Real := 2 * (a.im : Real) - let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ - (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, - (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, - (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} - let bl : Complex := ⟨L, y⟩ let br : Complex := ⟨L + 1, y⟩ - let tl : Complex := ⟨L, y + 2⟩ let tr : Complex := ⟨L + 1, y + 2⟩ have hU0 : ((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩ := RootComplexCoordinates.lowerGaussianCoordinate a have hU1 : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = ⟨L + 1, y + 2⟩ := RootComplexCoordinates.upperGaussianCoordinate a - have hU0c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (a : Complex) = ⟨L + 1, y⟩ := RootComplexCoordinates.lowerComplexCoordinate a - have hU1c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (⟨0, 1⟩ : GaussianInt) = ⟨L + 1, y + 2⟩ := RootComplexCoordinates.upperComplexCoordinate a - have htwo_re : (GaussianInt.toComplex (2 : GaussianInt)).re = 2 := RootComplexCoordinates.twoReal - have htwo_im : (GaussianInt.toComplex (2 : GaussianInt)).im = 0 := - RootComplexCoordinates.twoImaginary - have hvertices : vertices = {bl, br, tl, tr} := RootGeometryLeft.hvertices a - have himage : Complex.equivRealProdLm '' vertices = - ({L, L + 1} : Set Real) ×ˢ {y, y + 2} := RootGeometryLeft.himage a - have hcornerHull : convexHull Real - (({L, L + 1} : Set Real) ×ˢ ({y, y + 2} : Set Real)) = - Set.Icc L (L + 1) ×ˢ Set.Icc y (y + 2) := RootGeometryLeft.hcornerHull a - have hrectImage : Complex.equivRealProdLm '' - ((Set.Icc L (L + 1)) ×ℂ (Set.Icc y (y + 2))) = - Set.Icc L (L + 1) ×ˢ Set.Icc y (y + 2) := RootGeometryLeft.hrectImage a - have himageLin : Complex.equivRealProdLm.toLinearMap '' vertices = - ({L, L + 1} : Set Real) ×ˢ {y, y + 2} := RootGeometryLeft.himageLin a - have hrectImageLin : Complex.equivRealProdLm.toLinearMap '' - ((Set.Icc L (L + 1)) ×ℂ (Set.Icc y (y + 2))) = - Set.Icc L (L + 1) ×ˢ Set.Icc y (y + 2) := RootGeometryLeft.hrectImageLin a - have hHull : convexHull Real vertices = - (Set.Icc L (L + 1)) ×ℂ (Set.Icc y (y + 2)) := RootGeometryLeft.hHull a - have rectangleInterior (l u v w : Real) : - interior (Set.Icc l u ×ℂ Set.Icc v w) = - {z : Complex | l < z.re ∧ z.re < u ∧ v < z.im ∧ z.im < w} := - RootComplexCoordinates.rectangleInterior l u v w - have hInterior : interior (convexHull Real vertices) = - {p : Complex | L < p.re ∧ p.re < L + 1 ∧ y < p.im ∧ p.im < y + 2} := - RootGeometryLeft.hInterior a - have hcenter0 : - ((q (0 : Fin 3).succ).2 : Complex) / ((q (0 : Fin 3).succ).1 : Real) = - ((1 + 2 * a : GaussianInt) : Complex) := RootGeometryLeft.hcenter0 a - have hcenter1 : - ((q (2 : Fin 3).succ).2 : Complex) / ((q (2 : Fin 3).succ).1 : Real) = - ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) := RootGeometryLeft.hcenter1 a have hGap : P4828T1Gap L q = {p : Complex | L < p.re ∧ p.re < L + 1 ∧ y < p.im ∧ p.im < y + 2 ∧ 1 < dist p ((1 + 2 * a : GaussianInt) : Complex) ∧ @@ -489,8 +446,6 @@ theorem P4828T1LeftRootGeometry (a : GaussianInt) : have hchild : ((q (0 : Fin 4)).2 : Complex) / ((q (0 : Fin 4)).1 : Real) = child := RootGeometryLeft.hchild a - have hs25 : Real.sqrt (25 : Real) = 5 := RootComplexCoordinates.sqrtTwentyFive - have hs16 : Real.sqrt (16 : Real) = 4 := RootComplexCoordinates.sqrtSixteen have hdist0 : dist child br = (5 : Real) / 4 := RootGeometryLeft.hdist0 a have hdist1 : dist child tr = (5 : Real) / 4 := RootGeometryLeft.hdist1 a · constructor diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1LinePlacement.lean b/LeanPool/ApollonianSuperharmonic/P4828T1LinePlacement.lean index d04e1e2d99..895c05759e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1LinePlacement.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1LinePlacement.lean @@ -211,11 +211,7 @@ theorem P4828T1LinePlacement (L : Real) (hline : ∃ j : Fin 3, (q j.succ).1 = 0) : P4828T1Disk (q 0) ⊆ P4828T1Gap L q := by -- BODY - have hc := ProperBandCurvatureStructure q hq rcases hline with ⟨j, hj⟩ - have hparent_nonneg : ∀ i : Fin 3, 0 ≤ (q i.succ).1 := LinePlacementConstruction.hparent_nonneg - q hq - have hline_unique := hc.2.2 have hparent_pos : ∀ i : Fin 3, i ≠ j → 0 < (q i.succ).1 := LinePlacementConstruction.hparent_pos q hq j hj have hchild_pos : 0 < (q 0).1 := LinePlacementConstruction.hchild_pos q hq @@ -228,9 +224,6 @@ theorem P4828T1LinePlacement (L : Real) -n * ((center k).re - b) = 1 / (q k).1) ∧ (if (q j.succ).2 = -1 then L else L + 2) = b := LinePlacementConstruction.hsupport L q hs j hj rcases hsupport with ⟨n, boundary, hn, hcenterX, hfoot⟩ - have centerCoordSq : ∀ u v : Fin 4, u ≠ v → 0 < (q u).1 → 0 < (q v).1 → - ((center u).re - (center v).re)^2 + ((center u).im - (center v).im)^2 = - (1 / (q u).1 + 1 / (q v).1)^2 := LinePlacementConstruction.centerCoordSq q hq have verticalSq : ∀ u v : Fin 4, u ≠ v → 0 < (q u).1 → 0 < (q v).1 → -n * ((center u).re - boundary) = 1 / (q u).1 → -n * ((center v).re - boundary) = 1 / (q v).1 → diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1ResidualPatches.lean b/LeanPool/ApollonianSuperharmonic/P4828T1ResidualPatches.lean index 22e26bf2c5..0175f8080c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1ResidualPatches.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1ResidualPatches.lean @@ -187,10 +187,6 @@ private theorem foot_cover (L : Real) (q : Fin 4 → CircleCoordinates) (hs : P4 classical let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) let r (i : Fin 4) : ℝ := 1 / ((q i).1 : ℝ) - have rpos (i : Fin 4) (hi : 0 < (q i).1) : 0 < r i := rpos q i hi - have support (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : - if (q k).2 = -1 then (p i).re = L + r i - else (p i).re = L + 2 - r i := support L q hs k i hk hi have foot_dist (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : dist (p i) ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ = r i := foot_dist L q hs k i hk hi change (segment ℝ (p i) @@ -289,11 +285,6 @@ private theorem geometry (L : Real) (q : Fin 4 → CircleCoordinates) (hq : Prop let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) let P := P4909T1ParentPolygon L q let F (b : Fin 3) := P4909T1ParentPolygon L (s b) - have gap_iff (t : Fin 4 → CircleCoordinates) (z : ℂ) : - z ∈ P4828T1Gap L t ↔ - z ∈ interior (P4909T1ParentPolygon L t) ∧ - ∀ j : Fin 3, 0 < (t j.succ).1 → - 1 / ((t j.succ).1 : ℝ) < dist z ((t j.succ).2 / ((t j.succ).1 : ℝ)) := gap_iff L t z have hc := ProperBandCurvatureStructure q hq have rpos (i : Fin 4) (hi : 0 < (q i).1) : 0 < r i := rpos q i hi have hcenter : p 0 ∈ interior P := hcenter L q hq hinside @@ -341,17 +332,7 @@ private theorem omitted (L : Real) (q : Fin 4 → CircleCoordinates) (hq : Prope have parent (b j : Fin 3) : s b j.succ = q (idx b j) := parent q b j have idx_inj (b : Fin 3) : Function.Injective (idx b) := idx_inj b have idx_ne (b j : Fin 3) : idx b j ≠ b.succ := idx_ne b j - have gap_iff (t : Fin 4 → CircleCoordinates) (z : ℂ) : - z ∈ P4828T1Gap L t ↔ - z ∈ interior (P4909T1ParentPolygon L t) ∧ - ∀ j : Fin 3, 0 < (t j.succ).1 → - 1 / ((t j.succ).1 : ℝ) < dist z ((t j.succ).2 / ((t j.succ).1 : ℝ)) := gap_iff L t z - have hc := ProperBandCurvatureStructure q hq have rpos (i : Fin 4) (hi : 0 < (q i).1) : 0 < r i := rpos q i hi - have hcenter : p 0 ∈ interior P := hcenter L q hq hinside - have support (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : - if (q k).2 = -1 then (p i).re = L + r i - else (p i).re = L + 2 - r i := support L q hs k i hk hi have foot_dist (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : dist (p i) ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ = r i := foot_dist L q hs k i hk hi have foot_cover (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : @@ -440,8 +421,6 @@ private theorem gap_subset (L : Real) (q : Fin 4 → CircleCoordinates) (hq : Pr let F (b : Fin 3) := P4909T1ParentPolygon L (s b) let idx (b j : Fin 3) : Fin 4 := ![0, (b + 1).succ, (b + 2).succ] j have parent (b j : Fin 3) : s b j.succ = q (idx b j) := parent q b j - have idx_inj (b : Fin 3) : Function.Injective (idx b) := idx_inj b - have idx_ne (b j : Fin 3) : idx b j ≠ b.succ := idx_ne b j have old_retained (b j : Fin 3) (hne : j ≠ b) : ∃ k : Fin 3, idx b k = j.succ := old_retained b j hne have gap_iff (t : Fin 4 → CircleCoordinates) (z : ℂ) : @@ -449,24 +428,6 @@ private theorem gap_subset (L : Real) (q : Fin 4 → CircleCoordinates) (hq : Pr z ∈ interior (P4909T1ParentPolygon L t) ∧ ∀ j : Fin 3, 0 < (t j.succ).1 → 1 / ((t j.succ).1 : ℝ) < dist z ((t j.succ).2 / ((t j.succ).1 : ℝ)) := gap_iff L t z - have hc := ProperBandCurvatureStructure q hq - have rpos (i : Fin 4) (hi : 0 < (q i).1) : 0 < r i := rpos q i hi - have hcenter : p 0 ∈ interior P := hcenter L q hq hinside - have support (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : - if (q k).2 = -1 then (p i).re = L + r i - else (p i).re = L + 2 - r i := support L q hs k i hk hi - have foot_dist (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : - dist (p i) ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ = r i := foot_dist L q hs k i hk hi - have foot_cover (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : - segment ℝ (p i) - ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ ⊆ - Metric.closedBall (p i) (r i) := foot_cover L q hs k i hk hi - have line_dist (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) - (z : ℂ) (hz : z.re = if (q k).2 = -1 then L else L + 2) : - r i ≤ dist z (p i) := line_dist L q hs k i hk hi z hz - have center_dist (i j : Fin 4) (hij : i ≠ j) - (hi : 0 < (q i).1) (hj : 0 < (q j).1) : - dist (p i) (p j) = r i + r j := center_dist q hq i j hij hi hj have geometry : (∀ b, F b ⊆ P ∧ (0 < (q b.succ).1 → p b.succ ∉ F b) ∧ frontier (F b) ⊆ P4909T1ParentEdges L (s b)) ∧ @@ -517,10 +478,6 @@ theorem P4828T1ResidualPatches (L : Real) let F (b : Fin 3) := P4909T1ParentPolygon L (s b) let idx (b j : Fin 3) : Fin 4 := ![0, (b + 1).succ, (b + 2).succ] j have parent (b j : Fin 3) : s b j.succ = q (idx b j) := ResidualGapConstruction.parent q b j - have idx_inj (b : Fin 3) : Function.Injective (idx b) := ResidualGapConstruction.idx_inj b - have idx_ne (b j : Fin 3) : idx b j ≠ b.succ := ResidualGapConstruction.idx_ne b j - have old_retained (b j : Fin 3) (hne : j ≠ b) : - ∃ k : Fin 3, idx b k = j.succ := ResidualGapConstruction.old_retained b j hne have gap_iff (t : Fin 4 → CircleCoordinates) (z : ℂ) : z ∈ P4828T1Gap L t ↔ z ∈ interior (P4909T1ParentPolygon L t) ∧ @@ -529,11 +486,7 @@ theorem P4828T1ResidualPatches (L : Real) ResidualGapConstruction.gap_iff L t z have hc := ProperBandCurvatureStructure q hq have rpos (i : Fin 4) (hi : 0 < (q i).1) : 0 < r i := ResidualGapConstruction.rpos q i hi - have hcenter : p 0 ∈ interior P := ResidualGapConstruction.hcenter L q hq hinside -- Divide the signed supporting-line equation, preserving its actual offset. - have support (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : - if (q k).2 = -1 then (p i).re = L + r i - else (p i).re = L + 2 - r i := ResidualGapConstruction.support L q hs k i hk hi have foot_dist (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) : dist (p i) ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ = r i := ResidualGapConstruction.foot_dist L q hs k i hk hi @@ -541,9 +494,6 @@ theorem P4828T1ResidualPatches (L : Real) segment ℝ (p i) ⟨if (q k).2 = -1 then L else L + 2, (p i).im⟩ ⊆ Metric.closedBall (p i) (r i) := ResidualGapConstruction.foot_cover L q hs k i hk hi - have line_dist (k i : Fin 4) (hk : (q k).1 = 0) (hi : 0 < (q i).1) - (z : ℂ) (hz : z.re = if (q k).2 = -1 then L else L + 2) : - r i ≤ dist z (p i) := ResidualGapConstruction.line_dist L q hs k i hk hi z hz -- External tangency is obtained directly from the registered norm identity. have center_dist (i j : Fin 4) (hij : i ≠ j) (hi : 0 < (q i).1) (hj : 0 < (q j).1) : @@ -560,9 +510,6 @@ theorem P4828T1ResidualPatches (L : Real) ⟨if (q k.succ).2 = -1 then L else L + 2, (p 0).im⟩) → ∃ b, z ∈ interior (F b)) := ResidualGapConstruction.geometry L q hq hs hinside -- No point of an omitted open disk can cross the concrete boundary carrier. - have omitted (b : Fin 3) (hb : 0 < (q b.succ).1) : - ∀ z ∈ interior (F b), r b.succ < dist z (p b.succ) := ResidualGapConstruction.omitted L q - hq hs hinside b hb have inserted_exterior (b : Fin 3) (z : ℂ) (hz : z ∈ P4828T1Gap L (s b)) : r 0 < dist z (p 0) := ResidualGapConstruction.inserted_exterior L q hq b z hz diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean index b404bf908a..8d6346923d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1RightRootGeometry.lean @@ -447,55 +447,12 @@ theorem P4828T1RightRootGeometry (a : GaussianInt) : fin_cases k <;> fin_cases j <;> simp [P4828T1Root] at hk hj ⊢ <;> norm_num at hk hj ⊢ <;> ring let y : Real := 2 * (a.im : Real) - let vertices : Set Complex := {p | ∃ j : Fin 3, 0 < (q j.succ).1 ∧ - (p = (q j.succ).2 / ((q j.succ).1 : Real) ∨ ∃ k : Fin 3, - (q k.succ).1 = 0 ∧ p = ⟨if (q k.succ).2 = -1 then L else L + 2, - (((q j.succ).2 : Complex) / ((q j.succ).1 : Real)).im⟩)} let bl : Complex := ⟨L + 1, y⟩ - let br : Complex := ⟨L + 2, y⟩ let tl : Complex := ⟨L + 1, y + 2⟩ - let tr : Complex := ⟨L + 2, y + 2⟩ have hU0 : ((1 + 2 * a : GaussianInt) : Complex) = ⟨L + 1, y⟩ := RootComplexCoordinates.lowerGaussianCoordinate a have hU1 : ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) = ⟨L + 1, y + 2⟩ := RootComplexCoordinates.upperGaussianCoordinate a - have hU0c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (a : Complex) = ⟨L + 1, y⟩ := RootComplexCoordinates.lowerComplexCoordinate a - have hU1c : (1 : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (a : Complex) + GaussianInt.toComplex (2 : GaussianInt) * - (⟨0, 1⟩ : GaussianInt) = ⟨L + 1, y + 2⟩ := RootComplexCoordinates.upperComplexCoordinate a - have htwo_re : (GaussianInt.toComplex (2 : GaussianInt)).re = 2 := RootComplexCoordinates.twoReal - have htwo_im : (GaussianInt.toComplex (2 : GaussianInt)).im = 0 := - RootComplexCoordinates.twoImaginary - have hvertices : vertices = {bl, br, tl, tr} := RootGeometryRight.hvertices a - have himage : Complex.equivRealProdLm '' vertices = - ({L + 1, L + 2} : Set Real) ×ˢ {y, y + 2} := RootGeometryRight.himage a - have hcornerHull : convexHull Real - (({L + 1, L + 2} : Set Real) ×ˢ ({y, y + 2} : Set Real)) = - Set.Icc (L + 1) (L + 2) ×ˢ Set.Icc y (y + 2) := RootGeometryRight.hcornerHull a - have hrectImage : Complex.equivRealProdLm '' - ((Set.Icc (L + 1) (L + 2)) ×ℂ (Set.Icc y (y + 2))) = - Set.Icc (L + 1) (L + 2) ×ˢ Set.Icc y (y + 2) := RootGeometryRight.hrectImage a - have himageLin : Complex.equivRealProdLm.toLinearMap '' vertices = - ({L + 1, L + 2} : Set Real) ×ˢ {y, y + 2} := RootGeometryRight.himageLin a - have hrectImageLin : Complex.equivRealProdLm.toLinearMap '' - ((Set.Icc (L + 1) (L + 2)) ×ℂ (Set.Icc y (y + 2))) = - Set.Icc (L + 1) (L + 2) ×ˢ Set.Icc y (y + 2) := RootGeometryRight.hrectImageLin a - have hHull : convexHull Real vertices = - (Set.Icc (L + 1) (L + 2)) ×ℂ (Set.Icc y (y + 2)) := RootGeometryRight.hHull a - have rectangleInterior (l u v w : Real) : - interior (Set.Icc l u ×ℂ Set.Icc v w) = - {z : Complex | l < z.re ∧ z.re < u ∧ v < z.im ∧ z.im < w} := - RootComplexCoordinates.rectangleInterior l u v w - have hInterior : interior (convexHull Real vertices) = - {p : Complex | L + 1 < p.re ∧ p.re < L + 2 ∧ - y < p.im ∧ p.im < y + 2} := RootGeometryRight.hInterior a - have hcenter0 : - ((q (0 : Fin 3).succ).2 : Complex) / ((q (0 : Fin 3).succ).1 : Real) = - ((1 + 2 * a : GaussianInt) : Complex) := RootGeometryRight.hcenter0 a - have hcenter1 : - ((q (1 : Fin 3).succ).2 : Complex) / ((q (1 : Fin 3).succ).1 : Real) = - ((1 + 2 * a + 2 * ⟨0, 1⟩ : GaussianInt) : Complex) := RootGeometryRight.hcenter1 a have hGap : P4828T1Gap L q = {p : Complex | L + 1 < p.re ∧ p.re < L + 2 ∧ y < p.im ∧ p.im < y + 2 ∧ 1 < dist p ((1 + 2 * a : GaussianInt) : Complex) ∧ @@ -504,8 +461,6 @@ theorem P4828T1RightRootGeometry (a : GaussianInt) : have hchild : ((q (0 : Fin 4)).2 : Complex) / ((q (0 : Fin 4)).1 : Real) = child := RootGeometryRight.hchild a - have hs25 : Real.sqrt (25 : Real) = 5 := RootComplexCoordinates.sqrtTwentyFive - have hs16 : Real.sqrt (16 : Real) = 4 := RootComplexCoordinates.sqrtSixteen have hdist0 : dist child bl = (5 : Real) / 4 := RootGeometryRight.hdist0 a have hdist1 : dist child tl = (5 : Real) / 4 := RootGeometryRight.hdist1 a · constructor diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1InfiniteLimitComponent.lean b/LeanPool/ApollonianSuperharmonic/P4849T1InfiniteLimitComponent.lean index 21f97fe7c8..46995e10d5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4849T1InfiniteLimitComponent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4849T1InfiniteLimitComponent.lean @@ -62,7 +62,6 @@ private theorem hconnX : have hrev : p.reverse.IsChain FourNeighborAdjacent := List.isChain_reverse.mpr hpc' have hqtail : q.tail.IsChain FourNeighborAdjacent := hqc.tail - have hpn : p ≠ [] := by intro he; simp [he] at hp have hqn : q ≠ [] := by intro he; simp [he] at hq have hjoin : (p.reverse ++ q.tail).IsChain FourNeighborAdjacent := by apply hrev.append hqtail @@ -88,7 +87,6 @@ private theorem hconnX : simpa using hw · apply prefixReach q hq hqmem hqc w exact List.mem_of_mem_tail hw - have hpne' : p.reverse ≠ [] := List.reverse_ne_nil_iff.mpr hpn have hhead : (p.reverse ++ q.tail).head? = some x := by simp [List.head?_append, List.head?_reverse, hpx] have hlast : (p.reverse ++ q.tail).getLast? = some y := by @@ -118,7 +116,6 @@ private theorem hadjClose : intro L a reachable X x hx y hy hxy rcases hx with ⟨p, hp, hpx, hpmem, hpc⟩ have hchain : p.IsChain FourNeighborAdjacent := hpc - have hpn : p ≠ [] := by intro he; simp [he] at hp refine ⟨p ++ [y], ?_, ?_, ?_, ?_⟩ · simp [List.head?_append, hp] · simp [hpx] @@ -215,13 +212,11 @@ private theorem hXinf : firstExit p a hp hpb hpmem (List.isChain_iff_forall_rel_of_append_cons_cons.mpr hpadj) haX hbnotX - have hxC : x ∈ C n := hpmem x hxP have hyC : y ∈ C n := hpmem y hyP have hxShell : x ∈ shell := by simp [shell, hxX] have hyShell : y ∈ shell := by rcases hxy with rfl | rfl | rfl | rfl <;> simp [shell, hxX] have hnN : n ≥ N := by dsimp [n]; omega - have hxL : x ∈ L := (hN n hnN x (hshellfin.mem_toFinset.mpr hxShell)).mp hxC have hyL : y ∈ L := (hN n hnN y (hshellfin.mem_toFinset.mpr hyShell)).mp hyC exact hyX (hadjClose x hxX y hyL hxy) diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean b/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean index 8e670f8617..cfcbe810fc 100644 --- a/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean +++ b/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean @@ -403,10 +403,6 @@ theorem P4849T1LargePositiveComponents (q : IntegerLatticeFunction) (M : ℤ) have chainReach (p : List GaussianInt) (hp : p.IsChain edge) (hne : p ≠ []) : ∀ y, y ∈ p → Relation.ReflTransGen edge (p.head hne) y := PositiveComponentLemmas.chainReach q p hp hne - have walkReach : ∀ (p : List GaussianInt) (a b : GaussianInt), - p.head? = some a → p.getLast? = some b → - (∀ x ∈ p, x ∈ S) → p.IsChain FourNeighborAdjacent → reach a b := - PositiveComponentLemmas.walkReach q have reachPos {a b : GaussianInt} (ha : a ∈ S) (h : reach a b) : b ∈ S := PositiveComponentLemmas.reachPos q (a := a) (b := b) ha h have reachWalk : ∀ (x y : GaussianInt), x ∈ S → reach x y → diff --git a/LeanPool/ApollonianSuperharmonic/P4909T1LineFan.lean b/LeanPool/ApollonianSuperharmonic/P4909T1LineFan.lean index ba144645b1..5571db5adb 100644 --- a/LeanPool/ApollonianSuperharmonic/P4909T1LineFan.lean +++ b/LeanPool/ApollonianSuperharmonic/P4909T1LineFan.lean @@ -156,12 +156,8 @@ private theorem hne (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl l).succ).im ≠ ((p q) (b₀ l).succ).im := by classical let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) - let P := P4909T1ParentPolygon L q let h := if (q l.succ).2 = -1 then L else L + 2 - let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 let x := p 0 - have hσ : σ ^ 2 = 1 := hσ q l - have side (i : Fin 4) (hi : 0 < (q i).1) : 0 < σ * ((p i).re - h) := side L q l hside i hi let a₀ : Fin 3 := if l = 0 then 1 else 0 let b₀ : Fin 3 := if l = 2 then 1 else 2 have ha₀ : a₀ ≠ l := ha₀ L q l hl hpos hnormal hside @@ -196,12 +192,6 @@ private theorem hvertices (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3 (B q b).im⟩} : Set ℂ)) : (A q a) ∈ (P L q) ∧ (B q b) ∈ (P L q) ∧ (foot L q l) (A q a) ∈ (P L q) ∧ (foot L q l) (B q b) ∈ (P L q) := by classical - let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) - let P := P4909T1ParentPolygon L q - let h := if (q l.succ).2 = -1 then L else L + 2 - let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ - let A := p a.succ - let B := p b.succ rw [hP] exact ⟨subset_convexHull ℝ _ (by simp), subset_convexHull ℝ _ (by simp), subset_convexHull ℝ _ (by simp), subset_convexHull ℝ _ (by simp)⟩ @@ -256,9 +246,7 @@ private theorem subC (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hi := by classical let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) - let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) let P := P4909T1ParentPolygon L q - let F (c : Fin 3) := P4909T1ParentPolygon L (s c) let h := if (q l.succ).2 = -1 then L else L + 2 let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ let x := p 0 @@ -289,16 +277,12 @@ private theorem subU (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hi q).im < ((p q) b.succ).im) : (F L q) a ⊆ (P L q) := by classical let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) - let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) let P := P4909T1ParentPolygon L q - let F (c : Fin 3) := P4909T1ParentPolygon L (s c) let h := if (q l.succ).2 = -1 then L else L + 2 - let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ let x := p 0 let A := p a.succ let B := p b.succ - have hxi := (qint x).mp hinside have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP have hxP : x ∈ P := hxP L q hinside have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB @@ -326,16 +310,12 @@ private theorem subD (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hi q).im < ((p q) b.succ).im) : (F L q) b ⊆ (P L q) := by classical let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) - let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) let P := P4909T1ParentPolygon L q - let F (c : Fin 3) := P4909T1ParentPolygon L (s c) let h := if (q l.succ).2 = -1 then L else L + 2 - let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ let x := p 0 let A := p a.succ let B := p b.succ - have hxi := (qint x).mp hinside have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP have hxP : x ∈ P := hxP L q hinside have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB @@ -427,9 +407,7 @@ private theorem sub (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl have hx := side 0 hzero have hxi := (qint x).mp hinside have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP - have hxP : x ∈ P := hxP L q hinside have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB - have convexP : Convex ℝ P := convexP L q have subC : F l ⊆ P := subC L q l hinside a b hP hC have subU : F a ⊆ P := subU L q l hinside a b qmem qint hP hU hAx hxB have subD : F b ⊆ P := subD L q l hinside a b qmem qint hP hD hAx hxB @@ -517,9 +495,7 @@ private theorem omitted (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) have hx := side 0 hzero have hxi := (qint x).mp hinside have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP - have hxP : x ∈ P := hxP L q hinside have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB - have convexP : Convex ℝ P := convexP L q have subC : F l ⊆ P := subC L q l hinside a b hP hC have subU : F a ⊆ P := subU L q l hinside a b qmem qint hP hU hAx hxB have subD : F b ⊆ P := subD L q l hinside a b qmem qint hP hD hAx hxB @@ -665,14 +641,9 @@ private theorem frontC (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) ( classical let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) - let F (c : Fin 3) := P4909T1ParentPolygon L (s c) let x := p 0 - let A := p a.succ - let B := p b.succ have ha := hpos a hal have hb := hpos b hbl - have root (c : Fin 3) : s c (0 : Fin 3).succ = q 0 := root q slots c - have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := keep q slots c i hi have radial (c i : Fin 3) (hi : i ≠ c) (hpi : 0 < (q i.succ).1) : segment ℝ x (p i.succ) ⊆ P4909T1ParentEdges L (s c) := radial L q hzero slots c i hi hpi have retained (c i j : Fin 3) (hi : i ≠ c) (hj : j ≠ c) @@ -694,14 +665,11 @@ private theorem frontU (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) ( classical let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) - let F (c : Fin 3) := P4909T1ParentPolygon L (s c) let h := if (q l.succ).2 = -1 then L else L + 2 let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ let x := p 0 let B := p b.succ have hb := hpos b hbl - have root (c : Fin 3) : s c (0 : Fin 3).succ = q 0 := root q slots c - have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := keep q slots c i hi have radial (c i : Fin 3) (hi : i ≠ c) (hpi : 0 < (q i.succ).1) : segment ℝ x (p i.succ) ⊆ P4909T1ParentEdges L (s c) := radial L q hzero slots c i hi hpi have rootFoot (c : Fin 3) (hc : l ≠ c) : @@ -735,8 +703,6 @@ private theorem frontD (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) ( let x := p 0 let A := p a.succ have ha := hpos a hal - have root (c : Fin 3) : s c (0 : Fin 3).succ = q 0 := root q slots c - have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := keep q slots c i hi have radial (c i : Fin 3) (hi : i ≠ c) (hpi : 0 < (q i.succ).1) : segment ℝ x (p i.succ) ⊆ P4909T1ParentEdges L (s c) := radial L q hzero slots c i hi hpi have rootFoot (c : Fin 3) (hc : l ≠ c) : @@ -834,20 +800,10 @@ private theorem front (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (h have hx := side 0 hzero have hxi := (qint x).mp hinside have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP - have hxP : x ∈ P := hxP L q hinside have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB - have convexP : Convex ℝ P := convexP L q have subC : F l ⊆ P := subC L q l hinside a b hP hC have subU : F a ⊆ P := subU L q l hinside a b qmem qint hP hU hAx hxB have subD : F b ⊆ P := subD L q l hinside a b qmem qint hP hD hAx hxB - have root (c : Fin 3) : s c (0 : Fin 3).succ = q 0 := root q slots c - have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := keep q slots c i hi - have radial (c i : Fin 3) (hi : i ≠ c) (hpi : 0 < (q i.succ).1) : - segment ℝ x (p i.succ) ⊆ P4909T1ParentEdges L (s c) := radial L q hzero slots c i hi hpi - have retained (c i j : Fin 3) (hi : i ≠ c) (hj : j ≠ c) - (hij : i ≠ j) (hpi : 0 < (q i.succ).1) (hpj : 0 < (q j.succ).1) : - segment ℝ (p i.succ) (p j.succ) ⊆ P4909T1ParentEdges L (s c) := retained L q slots c i j - hi hj hij hpi hpj have rootFoot (c : Fin 3) (hc : l ≠ c) : segment ℝ x (foot x) ⊆ P4909T1ParentEdges L (s c) := rootFoot L q l hl hzero slots c hc have retainedFoot (c i : Fin 3) (hc : l ≠ c) (hi : i ≠ c) @@ -879,15 +835,8 @@ private theorem sepCU (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (a - (fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im)) : Disjoint (interior ((F L q) l)) (interior ((F L q) a)) := by classical - let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) let F (c : Fin 3) := P4909T1ParentPolygon L (s c) - let h := if (q l.succ).2 = -1 then L else L + 2 - let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 - let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ - let x := p 0 - let A := p a.succ - let B := p b.succ change (Disjoint (interior (F l)) (interior (F a))) apply Set.disjoint_left.mpr intro z ht hu @@ -905,15 +854,8 @@ private theorem sepCD (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (a (z.re - (fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im)) : Disjoint (interior ((F L q) l)) (interior ((F L q) b)) := by classical - let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) let F (c : Fin 3) := P4909T1ParentPolygon L (s c) - let h := if (q l.succ).2 = -1 then L else L + 2 - let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 - let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ - let x := p 0 - let A := p a.succ - let B := p b.succ change (Disjoint (interior (F l)) (interior (F b))) apply Set.disjoint_left.mpr intro z ht hd @@ -929,15 +871,8 @@ private theorem sepUD (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (a (σ q l) * ((fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - z.re)) : Disjoint (interior ((F L q) a)) (interior ((F L q) b)) := by classical - let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) let F (c : Fin 3) := P4909T1ParentPolygon L (s c) - let h := if (q l.succ).2 = -1 then L else L + 2 - let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 - let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ - let x := p 0 - let A := p a.succ - let B := p b.succ change (Disjoint (interior (F a)) (interior (F b))) apply Set.disjoint_left.mpr intro z hu hd @@ -1023,20 +958,10 @@ private theorem sep (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl have hx := side 0 hzero have hxi := (qint x).mp hinside have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP - have hxP : x ∈ P := hxP L q hinside have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB - have convexP : Convex ℝ P := convexP L q have subC : F l ⊆ P := subC L q l hinside a b hP hC have subU : F a ⊆ P := subU L q l hinside a b qmem qint hP hU hAx hxB have subD : F b ⊆ P := subD L q l hinside a b qmem qint hP hD hAx hxB - have root (c : Fin 3) : s c (0 : Fin 3).succ = q 0 := root q slots c - have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := keep q slots c i hi - have radial (c i : Fin 3) (hi : i ≠ c) (hpi : 0 < (q i.succ).1) : - segment ℝ x (p i.succ) ⊆ P4909T1ParentEdges L (s c) := radial L q hzero slots c i hi hpi - have retained (c i j : Fin 3) (hi : i ≠ c) (hj : j ≠ c) - (hij : i ≠ j) (hpi : 0 < (q i.succ).1) (hpj : 0 < (q j.succ).1) : - segment ℝ (p i.succ) (p j.succ) ⊆ P4909T1ParentEdges L (s c) := retained L q slots c i j - hi hj hij hpi hpj have rootFoot (c : Fin 3) (hc : l ≠ c) : segment ℝ x (foot x) ⊆ P4909T1ParentEdges L (s c) := rootFoot L q l hl hzero slots c hc have retainedFoot (c i : Fin 3) (hc : l ≠ c) (hi : i ≠ c) @@ -1090,11 +1015,8 @@ private theorem cover (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (a classical let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) - let P := P4909T1ParentPolygon L q let F (c : Fin 3) := P4909T1ParentPolygon L (s c) - let h := if (q l.succ).2 = -1 then L else L + 2 let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 - let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ let x := p 0 let A := p a.succ let B := p b.succ @@ -1206,9 +1128,7 @@ theorem P4909T1LineFan (L : ℝ) (q : Fin 4 → CircleCoordinates) -- Containment uses only convexity and the inserted foot's actual height. have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := LineFanConstruction.hvertices L q l a b hP - have hxP : x ∈ P := LineFanConstruction.hxP L q hinside have hfxP : foot x ∈ P := LineFanConstruction.hfxP L q l hinside a b qmem qint hAx hxB - have convexP : Convex ℝ P := LineFanConstruction.convexP L q have subC : F l ⊆ P := LineFanConstruction.subC L q l hinside a b hP hC have subU : F a ⊆ P := LineFanConstruction.subU L q l hinside a b qmem qint hP hU hAx hxB have subD : F b ⊆ P := LineFanConstruction.subD L q l hinside a b qmem qint hP hD hAx hxB @@ -1220,16 +1140,6 @@ theorem P4909T1LineFan (L : ℝ) (q : Fin 4 → CircleCoordinates) umem tupper qint qfront dint dfront uint ufront tint tfront hal hbl hab hP hD hC hU hAx hxB c hc -- Build the literal edge witnesses without identifying same-center records. - have root (c : Fin 3) : s c (0 : Fin 3).succ = q 0 := LineFanConstruction.root q slots c - have keep (c i : Fin 3) (hi : i ≠ c) : s c (i - c).succ = q i.succ := LineFanConstruction.keep - q slots c i hi - have radial (c i : Fin 3) (hi : i ≠ c) (hpi : 0 < (q i.succ).1) : - segment ℝ x (p i.succ) ⊆ P4909T1ParentEdges L (s c) := LineFanConstruction.radial L q - hzero slots c i hi hpi - have retained (c i j : Fin 3) (hi : i ≠ c) (hj : j ≠ c) - (hij : i ≠ j) (hpi : 0 < (q i.succ).1) (hpj : 0 < (q j.succ).1) : - segment ℝ (p i.succ) (p j.succ) ⊆ P4909T1ParentEdges L (s c) := - LineFanConstruction.retained L q slots c i j hi hj hij hpi hpj have rootFoot (c : Fin 3) (hc : l ≠ c) : segment ℝ x (foot x) ⊆ P4909T1ParentEdges L (s c) := LineFanConstruction.rootFoot L q l hl hzero slots c hc diff --git a/LeanPool/ApollonianSuperharmonic/P4909T1OmittedDiskBarrier.lean b/LeanPool/ApollonianSuperharmonic/P4909T1OmittedDiskBarrier.lean index fbb33457ea..e9e0a072bd 100644 --- a/LeanPool/ApollonianSuperharmonic/P4909T1OmittedDiskBarrier.lean +++ b/LeanPool/ApollonianSuperharmonic/P4909T1OmittedDiskBarrier.lean @@ -41,7 +41,6 @@ theorem P4909T1OmittedDiskBarrier (P : Set ℂ) (a : ℂ) (r : ℝ) simpa only [Real.dist_eq] using hu have hprod := (lt_div_iff₀ (by linarith : 0 < ‖z - a‖ + 1)).mp hu' nlinarith [abs_nonneg (u - t)] - have hball : a ∈ Metric.ball a r := Metric.mem_ball_self hr have hdisj : Disjoint (interior P) (interior Pᶜ) := by rw [Set.disjoint_left] intro z hz hc diff --git a/LeanPool/ApollonianSuperharmonic/P4909T1TriangleFan.lean b/LeanPool/ApollonianSuperharmonic/P4909T1TriangleFan.lean index 8010450905..62b1b722ec 100644 --- a/LeanPool/ApollonianSuperharmonic/P4909T1TriangleFan.lean +++ b/LeanPool/ApollonianSuperharmonic/P4909T1TriangleFan.lean @@ -908,97 +908,21 @@ theorem P4909T1TriangleFan (L : ℝ) (q : Fin 4 → CircleCoordinates) classical dsimp only -- Establish affine-coordinate topology directly from real and imaginary parts. - have normRealSmul (r : ℝ) (z : ℂ) : ‖r • z‖ = |r| * ‖z‖ := TriangleFanConstruction.normRealSmul - r z - have smallStep (z d : ℂ) (ε : ℝ) (hε : 0 < ε) : - ∃ t : ℝ, 0 < t ∧ t • d + z ∈ Metric.ball z ε := TriangleFanConstruction.smallStep z d ε hε - have contRe : Continuous (fun z : ℂ => z.re) := TriangleFanConstruction.contRe - have contIm : Continuous (fun z : ℂ => z.im) := TriangleFanConstruction.contIm - have affineContinuous (f : ℂ →ᵃ[ℝ] ℝ) : Continuous f := TriangleFanConstruction.affineContinuous f - have affineShift (f : ℂ →ᵃ[ℝ] ℝ) (z a b : ℂ) (t : ℝ) : - f (t • (a - b) + z) = t * (f a - f b) + f z := TriangleFanConstruction.affineShift f z a b t - have interiorHull (D : AffineBasis (Fin 3) ℝ ℂ) : - interior (convexHull ℝ (Set.range D)) = {z | ∀ i, 0 < D.coord i z} := - TriangleFanConstruction.interiorHull D - have spanOfInterior (S : Set ℂ) (x : ℂ) - (hx : x ∈ interior (convexHull ℝ S)) : affineSpan ℝ S = ⊤ := - TriangleFanConstruction.spanOfInterior S x hx let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) let s (b : Fin 3) := P4828T1Step (P4828T1Rotate q b) let P := P4909T1ParentPolygon L q let F (b : Fin 3) := P4909T1ParentPolygon L (s b) - let v : Fin 3 → ℂ := fun i => p i.succ - have parentHull (t : Fin 4 → CircleCoordinates) - (ht : ∀ i : Fin 3, 0 < (t i.succ).1) : - P4909T1ParentPolygon L t = - convexHull ℝ (Set.range fun i : Fin 3 => - ((t i.succ).2 : ℂ) / ((t i.succ).1 : ℝ)) := TriangleFanConstruction.parentHull L t ht - have hP : P = convexHull ℝ (Set.range v) := TriangleFanConstruction.hP L q hpos - have hxmem : p 0 ∈ interior (convexHull ℝ (Set.range v)) := TriangleFanConstruction.hxmem L q - hpos hinside - have hspan : affineSpan ℝ (Set.range v) = ⊤ := TriangleFanConstruction.hspan L q hpos hinside - have hvspan : vectorSpan ℝ (Set.range v) = ⊤ := TriangleFanConstruction.hvspan L q hpos hinside - have hind : AffineIndependent ℝ v := TriangleFanConstruction.hind L q hpos hinside - let A : AffineBasis (Fin 3) ℝ ℂ := ⟨v, hind, hspan⟩ - have hmem (z : ℂ) : z ∈ P ↔ ∀ i, 0 ≤ A.coord i z := TriangleFanConstruction.hmem L q hpos - hinside z - have hint (z : ℂ) : z ∈ interior P ↔ ∀ i, 0 < A.coord i z := TriangleFanConstruction.hint L q - hpos hinside z - let alpha (i : Fin 3) : ℝ := A.coord i (p 0) - have alphaPos (i : Fin 3) : 0 < alpha i := TriangleFanConstruction.alphaPos L q hpos hinside i -- The child basis replaces precisely the omitted parent by the inserted center. - let u (b : Fin 3) : Fin 3 → ℂ := Function.update v b (p 0) - have huind (b : Fin 3) : AffineIndependent ℝ (u b) := TriangleFanConstruction.huind L q hpos - hinside b - have hutot (b : Fin 3) : affineSpan ℝ (Set.range (u b)) = ⊤ := TriangleFanConstruction.hutot L - q hpos hinside b - let B (b : Fin 3) : AffineBasis (Fin 3) ℝ ℂ := ⟨u b, huind b, hutot b⟩ - have hBself (b : Fin 3) : B b b = p 0 := TriangleFanConstruction.hBself L q hpos hinside b - have hBother (b i : Fin 3) (hi : i ≠ b) : B b i = v i := TriangleFanConstruction.hBother L q - hpos hinside b i hi - have hparents (b : Fin 3) : ∀ i : Fin 3, 0 < (s b i.succ).1 := TriangleFanConstruction.hparents - q hpos b - have hparentPoint (b j : Fin 3) : - ((s b j.succ).2 : ℂ) / ((s b j.succ).1 : ℝ) = B b (j + b) := - TriangleFanConstruction.hparentPoint L q hpos hinside b j - have hchild (b : Fin 3) : F b = convexHull ℝ (Set.range (B b)) := - TriangleFanConstruction.hchild L q hpos hinside b - have hBmem (b : Fin 3) (z : ℂ) : z ∈ F b ↔ ∀ i, 0 ≤ (B b).coord i z := - TriangleFanConstruction.hBmem L q hpos hinside b z - have hBint (b : Fin 3) (z : ℂ) : - z ∈ interior (F b) ↔ ∀ i, 0 < (B b).coord i z := TriangleFanConstruction.hBint L q hpos - hinside b z - have coordSelf (b : Fin 3) : - A.coord b = alpha b • (B b).coord b := TriangleFanConstruction.coordSelf L q hpos hinside b - have coordOther (b i : Fin 3) (hi : i ≠ b) : - A.coord i = alpha i • (B b).coord b + (B b).coord i := TriangleFanConstruction.coordOther L - q hpos hinside b i hi - have coordSelfApply (b : Fin 3) (z : ℂ) : - A.coord b z = alpha b * (B b).coord b z := TriangleFanConstruction.coordSelfApply L q hpos - hinside b z - have coordOtherApply (b i : Fin 3) (hi : i ≠ b) (z : ℂ) : - A.coord i z = alpha i * (B b).coord b z + (B b).coord i z := - TriangleFanConstruction.coordOtherApply L q hpos hinside b i hi z have childSubset (b : Fin 3) : F b ⊆ P := TriangleFanConstruction.childSubset L q hpos hinside b have omittedNotIn (b : Fin 3) : p b.succ ∉ F b := TriangleFanConstruction.omittedNotIn L q hpos hinside b -- A minimum barycentric ratio makes all child coordinates nonnegative. have childCover (z : ℂ) (hz : z ∈ P) : ∃ b : Fin 3, z ∈ F b := TriangleFanConstruction.childCover L q hpos hinside z hz - have intRatio (b : Fin 3) (z : ℂ) (hz : z ∈ interior (F b)) - (i : Fin 3) (hi : i ≠ b) : - A.coord b z / alpha b < A.coord i z / alpha i := TriangleFanConstruction.intRatio L q hpos - hinside b z hz i hi have disjointInt (b c : Fin 3) (hbc : b ≠ c) : Disjoint (interior (F b)) (interior (F c)) := TriangleFanConstruction.disjointInt L q hpos hinside b c hbc -- A zero coordinate leaves a convex combination of the other two vertices. - have segmentOfZero (D : AffineBasis (Fin 3) ℝ ℂ) (z : ℂ) - (hnonneg : ∀ i, 0 ≤ D.coord i z) (i : Fin 3) (hi : D.coord i z = 0) : - ∃ j k : Fin 3, j ≠ k ∧ j ≠ i ∧ k ≠ i ∧ z ∈ segment ℝ (D j) (D k) := - TriangleFanConstruction.segmentOfZero D z hnonneg i hi - have childClosed (b : Fin 3) : IsClosed (F b) := TriangleFanConstruction.childClosed L q hpos - hinside b have childFrontier (b : Fin 3) : frontier (F b) ⊆ P4909T1ParentEdges L (s b) := TriangleFanConstruction.childFrontier L q hpos hinside b have offSeam (z : ℂ) (hz : z ∈ interior P) diff --git a/LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean b/LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean index 6529f9b902..f57bcf9176 100644 --- a/LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean +++ b/LeanPool/ApollonianSuperharmonic/P4953T1QuadrilateralSections.lean @@ -651,8 +651,6 @@ private theorem hSegA (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hσ : σ ^ 2 = 1 classical let fA : ℂ := ⟨h, A.im⟩ let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) - let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ - 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} have hda : d A.im = A.re := hda A B hAB have segCoords (P R z : ℂ) : z ∈ segment ℝ P R ↔ ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ @@ -679,8 +677,6 @@ private theorem hSegB (h : ℝ) (σ : ℝ) (A : ℂ) (B : ℂ) (hσ : σ ^ 2 = 1 classical let fB : ℂ := ⟨h, B.im⟩ let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) - let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ - 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} have hdb : d B.im = B.re := hdb A B hAB have segCoords (P R z : ℂ) : z ∈ segment ℝ P R ↔ ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ @@ -921,68 +917,17 @@ theorem P4953T1QuadrilateralSections (h σ : ℝ) (A B : ℂ) let fB : ℂ := ⟨h, B.im⟩ let d (y : ℝ) := A.re + (B.re - A.re) * (y - A.im) / (B.im - A.im) let Q := convexHull ℝ ({A, B, fA, fB} : Set ℂ) - have hσsq : σ * σ = 1 := SignSquareProduct.product σ hσ let T : Set ℂ := {z | A.im ≤ z.im ∧ z.im ≤ B.im ∧ 0 ≤ σ * (z.re - h) ∧ 0 ≤ σ * (d z.im - z.re)} - have hconv : Convex ℝ T := QuadrilateralSectionsConstruction.hconv h σ A B hAB - have hda : d A.im = A.re := QuadrilateralSectionsConstruction.hda A B hAB - have hdb : d B.im = B.re := QuadrilateralSectionsConstruction.hdb A B hAB - have hQsub : Q ⊆ T := QuadrilateralSectionsConstruction.hQsub h σ A B hA hB hAB - have hTsub : T ⊆ Q := QuadrilateralSectionsConstruction.hTsub h σ A B hσ hA hB hAB have hQeq : Q = T := QuadrilateralSectionsConstruction.hQeq h σ A B hσ hA hB hAB let S : Set ℂ := {z | A.im < z.im} ∩ {z | z.im < B.im} ∩ {z | 0 < σ * (z.re - h)} ∩ {z | 0 < σ * (d z.im - z.re)} - have hcReLip : LipschitzWith 1 (fun z : ℂ => z.re) := QuadrilateralSectionsConstruction.hcReLip - have hcImLip : LipschitzWith 1 (fun z : ℂ => z.im) := QuadrilateralSectionsConstruction.hcImLip - have hcIm : Continuous fun z : ℂ => z.im := QuadrilateralSectionsConstruction.hcIm - have hcRe : Continuous fun z : ℂ => z.re := QuadrilateralSectionsConstruction.hcRe - have hcD : Continuous fun z : ℂ => d z.im := QuadrilateralSectionsConstruction.hcD A B - have hcSide : Continuous fun z : ℂ => σ * (z.re - h) := - QuadrilateralSectionsConstruction.hcSide h σ - have hcTop : Continuous fun z : ℂ => σ * (d z.im - z.re) := - QuadrilateralSectionsConstruction.hcTop σ A B - have hSopen : IsOpen S := QuadrilateralSectionsConstruction.hSopen h σ A B - have hSsub : S ⊆ Q := QuadrilateralSectionsConstruction.hSsub h σ A B hσ hA hB hAB - have hSinter : S ⊆ interior Q := QuadrilateralSectionsConstruction.hSinter h σ A B hσ hA hB hAB - have hInteriorRev (x : ℂ) (hx : x ∈ interior Q) : x ∈ S := - QuadrilateralSectionsConstruction.hInteriorRev h σ A B hσ hA hB hAB x hx have hInteriorEq : interior Q = S := QuadrilateralSectionsConstruction.hInteriorEq h σ A B hσ hA hB hAB - have hTclosed : IsClosed T := QuadrilateralSectionsConstruction.hTclosed h σ A B have hfrontier : frontier Q = Q \ interior Q := QuadrilateralSectionsConstruction.hfrontier h σ A B hσ hA hB hAB - have segCoords (P R z : ℂ) : z ∈ segment ℝ P R ↔ - ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ - z.re = (1 - t) * P.re + t * R.re ∧ - z.im = (1 - t) * P.im + t * R.im := QuadrilateralSectionsConstruction.segCoords P R z - have hDinterp (t : ℝ) : d ((1 - t) * A.im + t * B.im) = - (1 - t) * A.re + t * B.re := QuadrilateralSectionsConstruction.hDinterp A B hAB t - have heightParam (y u v : ℝ) (huv : u < v) (hyu : u ≤ y) (hyv : y ≤ v) : - ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ y = (1 - t) * u + t * v := - QuadrilateralSectionsConstruction.heightParam y u v huv hyu hyv - have sideParam (x c : ℝ) (hc : 0 < σ * (c - h)) - (hlo : 0 ≤ σ * (x - h)) (hhi : 0 ≤ σ * (c - x)) : - ∃ t : ℝ, 0 ≤ t ∧ t ≤ 1 ∧ x = (1 - t) * c + t * h := - QuadrilateralSectionsConstruction.sideParam h σ hσ x c hc hlo hhi - have hSegFoot (z : ℂ) (hzY₁ : A.im ≤ z.im) (hzY₂ : z.im ≤ B.im) - (hzx : z.re = h) : z ∈ segment ℝ fA fB := QuadrilateralSectionsConstruction.hSegFoot h A B - hAB z hzY₁ hzY₂ hzx - have hSegDiag (z : ℂ) (hzY₁ : A.im ≤ z.im) (hzY₂ : z.im ≤ B.im) - (hzd : z.re = d z.im) : z ∈ segment ℝ A B := QuadrilateralSectionsConstruction.hSegDiag A B - hAB z hzY₁ hzY₂ hzd - have hSegA (z : ℂ) (hz : z ∈ T) (hzy : z.im = A.im) : - z ∈ segment ℝ A fA := QuadrilateralSectionsConstruction.hSegA h σ A B hσ hA hAB z hz hzy - have hSegB (z : ℂ) (hz : z ∈ T) (hzy : z.im = B.im) : - z ∈ segment ℝ B fB := QuadrilateralSectionsConstruction.hSegB h σ A B hσ hB hAB z hz hzy let E := segment ℝ A B ∪ segment ℝ A fA ∪ segment ℝ B fB ∪ segment ℝ fA fB - have hAin : A ∈ Q := QuadrilateralSectionsConstruction.hAin h A B - have hBin : B ∈ Q := QuadrilateralSectionsConstruction.hBin h A B - have hfAin : fA ∈ Q := QuadrilateralSectionsConstruction.hfAin h A B - have hfBin : fB ∈ Q := QuadrilateralSectionsConstruction.hfBin h A B - have hEsub : E ⊆ Q \ interior Q := QuadrilateralSectionsConstruction.hEsub h σ A B hσ hA hB hAB - have hBoundarySub : Q \ interior Q ⊆ E := QuadrilateralSectionsConstruction.hBoundarySub h σ A - B hσ hA hB hAB have hBoundary : Q \ interior Q = E := QuadrilateralSectionsConstruction.hBoundary h σ A B hσ hA hB hAB refine ⟨?_, ?_, ?_⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1ClosedSubdivision.lean b/LeanPool/ApollonianSuperharmonic/P4984T1ClosedSubdivision.lean index ca23ab07b5..adf9ac328b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4984T1ClosedSubdivision.lean +++ b/LeanPool/ApollonianSuperharmonic/P4984T1ClosedSubdivision.lean @@ -480,10 +480,6 @@ private theorem makeChild : · have hp : s b k.succ = q 0 := by rw [parent, hzero] simpa only [hp, p, r] using hinsert · obtain ⟨j, hj⟩ := Fin.exists_succ_eq.mpr hzero - have hjb : j ≠ b := by - intro he - subst j - exact idx_ne b k (by simp only [hj]) have hp : s b k.succ = q j.succ := by rw [parent, hj] have hjpos : 0 < (q j.succ).1 := by simpa only [hp] using hk have hh := hold j hjpos @@ -605,13 +601,10 @@ theorem P4984T1ClosedSubdivision (L : Real) have hzunique := hcurv.2.2 have fan := ClosedSubdivisionProof.fan L q hs hchildpos hparentsNonneg hinside hzunique - have polygonClosed (t : Fin 4 → CircleCoordinates) := ClosedSubdivisionProof.polygonClosed L t have gapClosed (t : Fin 4 → CircleCoordinates) := ClosedSubdivisionProof.gapClosed L t have hHclosed : IsClosed H := by change IsClosed (P4984T1ClosedGap L q) exact gapClosed q - have hchildClosed (b : Fin 3) : IsClosed (child b) := by - exact gapClosed (s b) let idx (b j : Fin 3) : Fin 4 := ![0, (b + 1).succ, (b + 2).succ] j have parent (b j : Fin 3) : s b j.succ = q (idx b j) := by fin_cases b <;> fin_cases j <;> rfl diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean b/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean index dc9e5cbc53..9e5563c3fe 100644 --- a/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean +++ b/LeanPool/ApollonianSuperharmonic/P4984T1IncidentArcs.lean @@ -777,9 +777,6 @@ theorem P4984T1IncidentArcs (L : Real) slot b have closedGapOfParent (u : Fin 4 → CircleCoordinates) (m : Fin 3) (hm : 0 < (u m.succ).1) := IncidentArcGeometry.closedGapOfParent L u m hm - let arc (b : Fin 3) := - P4984T1ClosedGap L (P4828T1Step (P4828T1Rotate q b)) ∩ - Metric.sphere a R have hchildCover := IncidentArcGeometry.hchildCover L q hq hs hi j hax have hchildSub (b : Fin 3) := IncidentArcGeometry.hchildSub L q hq hs hi j b have hAllUnion := IncidentArcGeometry.hAllUnion L q j hchildCover hchildSub diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1RootGaps.lean b/LeanPool/ApollonianSuperharmonic/P4984T1RootGaps.lean index d46688645e..64a03c6a98 100644 --- a/LeanPool/ApollonianSuperharmonic/P4984T1RootGaps.lean +++ b/LeanPool/ApollonianSuperharmonic/P4984T1RootGaps.lean @@ -110,9 +110,7 @@ private theorem rectHull : let s : ℝ := z.re - u let t : ℝ := (z.im - v) / 2 let w : Fin 4 → ℝ := ![(1 - s) * (1 - t), s * (1 - t), (1 - s) * t, s * t] - have hs0 : 0 ≤ s := by dsimp [s]; linarith have hs1 : s ≤ 1 := by dsimp [s]; linarith - have ht0 : 0 ≤ t := by dsimp [t]; linarith have ht1 : t ≤ 1 := by change (z.im - v) / 2 ≤ 1; linarith have hw : ∀ i, 0 ≤ w i := by intro i @@ -149,17 +147,9 @@ private theorem hpolyMinus : have hI : GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt) = Complex.I := by rw [GaussianInt.toComplex_def₂] apply Complex.ext <;> simp - have hB : 1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a + - GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt) = - ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ) + 2⟩ := by - rw [h2, GaussianInt.toComplex_def₂ a, hI] - apply Complex.ext <;> simp; ring have hA' : 1 + 2 * (a : ℂ) = ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ)⟩ := by simpa [h2] using hA - have hB' : 1 + 2 * (a : ℂ) + 2 * Complex.I = - ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ) + 2⟩ := by - simpa [h2, hI] using hB apply congrArg (convexHull ℝ) ext z simp [P4828T1Root, Fin.exists_fin_succ] @@ -191,17 +181,9 @@ private theorem hpolyPlus : have hI : GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt) = Complex.I := by rw [GaussianInt.toComplex_def₂] apply Complex.ext <;> simp - have hB : 1 + GaussianInt.toComplex 2 * GaussianInt.toComplex a + - GaussianInt.toComplex 2 * GaussianInt.toComplex (⟨0, 1⟩ : GaussianInt) = - ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ) + 2⟩ := by - rw [h2, GaussianInt.toComplex_def₂ a, hI] - apply Complex.ext <;> simp; ring have hA' : 1 + 2 * (a : ℂ) = ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ)⟩ := by simpa [h2] using hA - have hB' : 1 + 2 * (a : ℂ) + 2 * Complex.I = - ⟨2 * (a.re : ℝ) + 1, 2 * (a.im : ℝ) + 2⟩ := by - simpa [h2, hI] using hB apply congrArg (convexHull ℝ) ext z simp [P4828T1Root, Fin.exists_fin_succ] diff --git a/LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean b/LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean index 99ac40a09f..ce3716ca33 100644 --- a/LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean +++ b/LeanPool/ApollonianSuperharmonic/P4984T1UnitIncidence.lean @@ -937,9 +937,6 @@ theorem P4984T1UnitIncidence (a : GaussianInt) : simp [arc, A, roots, P4828T1Evaluate] have hArc3 : arc (a - ⟨0, 1⟩, true, []) = A 3 := by simp [arc, A, roots, P4828T1Evaluate] - let γ (left upper : Bool) (t : Real) : Complex := - u + (if left then -(Real.sqrt (1 - t^2) : Real) else Real.sqrt (1 - t^2)) + - ((if upper then t else -t : Real) : Complex) * Complex.I have hγcontinuous (left upper : Bool) := UnitIncidenceDetails.hγcontinuous u left upper have hQimage (left upper : Bool) := UnitIncidenceProof.hQimage a u huDef hu left upper have hclosed := UnitIncidenceDetails.hclosed a u hA (UnitIncidenceDetails.hQclosed u diff --git a/LeanPool/ApollonianSuperharmonic/P4994T6NonunitBirth.lean b/LeanPool/ApollonianSuperharmonic/P4994T6NonunitBirth.lean index c89b8eadde..4e332ddc81 100644 --- a/LeanPool/ApollonianSuperharmonic/P4994T6NonunitBirth.lean +++ b/LeanPool/ApollonianSuperharmonic/P4994T6NonunitBirth.lean @@ -79,7 +79,6 @@ theorem P4994T6NonunitBirth : rw [← hpre, ← hpim, ← hrre, ← hrim] ring rw [signed, hC, covolume] at factor - have positive_curvature := C.2 nlinarith have steps : TriangularLatticeAdjacent 0 p ∧ TriangularLatticeAdjacent 0 r ∧ TriangularLatticeAdjacent p r := by diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1CircularEstimate.lean b/LeanPool/ApollonianSuperharmonic/P5023T1CircularEstimate.lean index 827a4ebd41..4ce8a5c9fa 100644 --- a/LeanPool/ApollonianSuperharmonic/P5023T1CircularEstimate.lean +++ b/LeanPool/ApollonianSuperharmonic/P5023T1CircularEstimate.lean @@ -37,7 +37,6 @@ theorem P5023T1CircularEstimate (r R : ℝ) (hR : 0 < R) have hprod : 0 ≤ (1 - |(r - R) / (r + R)|) * (1 + |(r - R) / (r + R)|) := mul_nonneg (sub_nonneg.mpr hquot) (by positivity) - have hsq : |(r - R) / (r + R)| ^ 2 ≤ 1 := by nlinarith rw [← sq_abs] nlinarith have hidentity : @@ -57,8 +56,6 @@ theorem P5023T1CircularEstimate (r R : ℝ) (hR : 0 < R) have hdenSq : 0 < (r + R) ^ 2 := sq_pos_of_pos hden field_simp [ne_of_gt hdenSq] nlinarith [mul_le_mul_of_nonneg_right hrCube hR.le] - have hleft : 0 ≤ 2 * r * Real.sqrt (1 - ((r - R) / (r + R)) ^ 2) := by - exact mul_nonneg (mul_nonneg (by norm_num) (by linarith)) (Real.sqrt_nonneg _) have hright : 0 ≤ 4 * Real.sqrt R := by positivity nlinarith diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean b/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean index b542720d6d..c0f055b615 100644 --- a/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean +++ b/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean @@ -193,7 +193,6 @@ private theorem capBound : nlinarith [sq_nonneg (e.re * v.im - e.im * v.re)] have hplus : 4 * t ^ 2 ≤ Complex.normSq (x + y) := by have := cauchy2 (x + y) - have hnonneg : 0 ≤ dot (x + y) e := le_trans (by positivity) hsumdot nlinarith have hsum : Complex.normSq (x - y) + Complex.normSq (x + y) = 4 := by repeat rw [Complex.normSq_apply] @@ -208,7 +207,6 @@ private theorem capBound : rw [Complex.normSq_eq_norm_sq] at hminus' have hnorm : ‖x - y‖ ^ 2 ≤ (2 * Real.sqrt (1 - t ^ 2)) ^ 2 := by nlinarith [hminus', Real.sq_sqrt hrad] - have hleft : 0 ≤ ‖x - y‖ := norm_nonneg _ have hright : 0 ≤ 2 * Real.sqrt (1 - t ^ 2) := by positivity nlinarith @@ -1078,22 +1076,15 @@ theorem P5023T1CircularSide : have hRr : rad 0 < rad i.succ := CircularSideProof.hRr q i hparent hless have hden : 0 < rad i.succ + rad 0 := by linarith have other_nonneg : ∀ a : Fin 3, 0 ≤ (q a.succ).1 := curv.2.1 - have other_unique : ∀ a b : Fin 3, (q a.succ).1 = 0 → - (q b.succ).1 = 0 → a = b := curv.2.2 have hji : j ≠ i := by fin_cases i <;> decide have hki : k ≠ i := by fin_cases i <;> decide - have hjk : j ≠ k := by fin_cases i <;> decide have hjpos : 0 < (q j.succ).1 ∨ (q j.succ).1 = 0 := CircularSideProof.hjpos q i other_nonneg have hkpos : 0 < (q k.succ).1 ∨ (q k.succ).1 = 0 := CircularSideProof.hkpos q i other_nonneg - have hnotbothzero : ¬ ((q j.succ).1 = 0 ∧ (q k.succ).1 = 0) := CircularSideProof.hnotbothzero q - i other_unique hjk have centerDistance (a b : Fin 4) (hab : a ≠ b) (ha : 0 < (q a).1) (hb : 0 < (q b).1) : dist (p a) (p b) = rad a + rad b := CircularSideProof.centerDistance q hq a b hab ha hb have hchild_parent : dist (p 0) (p i.succ) = rad 0 + rad i.succ := CircularSideProof.hchild_parent q i hchild hparent centerDistance - have hside_nonneg : 0 ≤ (q j.succ).1 ∧ 0 ≤ (q k.succ).1 := - ⟨other_nonneg j, other_nonneg k⟩ let dot (x y : ℂ) : ℝ := x.re * y.re + x.im * y.im have capBound (x y e : ℂ) (t : ℝ) (hx : Complex.normSq x = 1) (hy : Complex.normSq y = 1) diff --git a/LeanPool/ApollonianSuperharmonic/P5050T1TangentLineSection.lean b/LeanPool/ApollonianSuperharmonic/P5050T1TangentLineSection.lean index 06943011a7..1e9213151f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5050T1TangentLineSection.lean +++ b/LeanPool/ApollonianSuperharmonic/P5050T1TangentLineSection.lean @@ -450,12 +450,6 @@ theorem P5050T1TangentLineSection (h σ : ℝ) (a b : ℂ) (r s : ℝ) rw [hperm] exact hsub exact convexHull_mono hs hzTwo - have hσsqOuter : σ * σ = 1 := by nlinarith [hσ] - have hσmulOuter : ∀ x : ℝ, σ * (σ * x) = x := by - intro x - calc - σ * (σ * x) = (σ * σ) * x := by ring - _ = x := by rw [hσsqOuter]; ring have absSigned (y t : ℝ) (ht : 0 < t) (hy : σ * (y - h) = t) : |y - h| = t := by have hh := congrArg (fun x : ℝ => x ^ 2) hy diff --git a/LeanPool/ApollonianSuperharmonic/P5064T3OrderedPredecessor.lean b/LeanPool/ApollonianSuperharmonic/P5064T3OrderedPredecessor.lean index bc1a679c28..91aefe59d6 100644 --- a/LeanPool/ApollonianSuperharmonic/P5064T3OrderedPredecessor.lean +++ b/LeanPool/ApollonianSuperharmonic/P5064T3OrderedPredecessor.lean @@ -52,7 +52,6 @@ theorem P5064T3OrderedPredecessor (P : FordFareyParameter) have hh : (P.q₂ : Int) * (P.q₂ : Int) ≤ (P.q₁ : Int) * (P.q₁ : Int) := by simpa [FordRecursiveQuadruple, FordCircleCoordinate, hn] using h12 by_contra h - have hgt : (P.q₁ : Int) < (P.q₂ : Int) := by omega nlinarith [Nat.cast_nonneg (α := Int) P.q₁, Nat.cast_nonneg (α := Int) P.q₂] have cross : P.p₁ * (P.q₂ : Int) - (P.q₁ : Int) * P.p₂ = 1 := by diff --git a/LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean b/LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean index 1b538edbf7..2a304e73c3 100644 --- a/LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean @@ -725,24 +725,6 @@ theorem P5110T1SquareInterface (n m : Nat) (hn : 0 < n) (hm : 0 < m) SimpleGridPath (BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B) (BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B) := by -- BODY - have cell (h : Nat) (c z : GaussianInt) : - z ∈ (TileTranslation (FordTile h) c).cells ↔ - c.re ≤ z.re ∧ z.re < c.re + (h : Int) ∧ - c.im ≤ z.im ∧ z.im < c.im + (h : Int) := SquareInterfaceConstruction.cell h c z - have vertex (h : Nat) (hh : 0 < h) (c z : GaussianInt) : - z ∈ BoundaryFootprintVertices (TileTranslation (FordTile h) c) ↔ - c.re ≤ z.re ∧ z.re ≤ c.re + (h : Int) ∧ - c.im ≤ z.im ∧ z.im ≤ c.im + (h : Int) ∧ - (z.re = c.re ∨ z.re = c.re + (h : Int) ∨ - z.im = c.im ∨ z.im = c.im + (h : Int)) := SquareInterfaceConstruction.vertex h hh c z - have edge (h : Nat) (hh : 0 < h) (c : GaussianInt) (e : Finset GaussianInt) : - e ∈ BoundaryFootprintEdges (TileTranslation (FordTile h) c) ↔ - (∃ z : GaussianInt, e = {z, z + 1} ∧ - c.re ≤ z.re ∧ z.re < c.re + (h : Int) ∧ - (z.im = c.im ∨ z.im = c.im + (h : Int))) ∨ - (∃ z : GaussianInt, e = {z, z + ⟨0, 1⟩} ∧ - c.im ≤ z.im ∧ z.im < c.im + (h : Int) ∧ - (z.re = c.re ∨ z.re = c.re + (h : Int))) := SquareInterfaceConstruction.edge h hh c e let A := TileTranslation (FordTile n) a let B := TileTranslation (FordTile m) b let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) @@ -759,45 +741,16 @@ theorem P5110T1SquareInterface (n m : Nat) (hn : 0 < n) (hm : 0 < m) {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} := SquareInterfaceConstruction.vertices n m hn hm a b vertical hside hoverlap - have endpoints (e : Finset GaussianInt) - (he : e ∈ BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B) - (z : GaussianInt) (hz : z ∈ e) : - z ∈ BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B := - SquareInterfaceConstruction.endpoints n m hn hm a b e he z hz have edges : BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = {e | ∃ t : Int, l ≤ t ∧ t < u ∧ e = if vertical then {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := SquareInterfaceConstruction.edges n m hn hm a b vertical hside hoverlap - have hlu : l < u := SquareInterfaceConstruction.hlu n m a b vertical hoverlap - have hdelta : (((u - l).toNat : Nat) : Int) = u - l := SquareInterfaceConstruction.hdelta n m a - b vertical hoverlap - have positive_length : 0 < (u - l).toNat := SquareInterfaceConstruction.positive_length n m a b - vertical hoverlap - have finj : Function.Injective f := SquareInterfaceConstruction.finj n m hn hm a b vertical - hside hoverlap have pnd : p.Nodup := SquareInterfaceConstruction.pnd n m hn hm a b vertical hside hoverlap have plen : 2 ≤ p.length := SquareInterfaceConstruction.plen n m a b vertical hoverlap have pvertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = (p.toFinset : Set GaussianInt) := SquareInterfaceConstruction.pvertices n m hn hm a b vertical hside hoverlap - let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ - y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ - have fstep (k : Nat) : adj (f k) (f (k + 1)) := SquareInterfaceConstruction.fstep n m hn hm a b - vertical hside hoverlap k - have chain : p.IsChain adj := SquareInterfaceConstruction.chain n m hn hm a b vertical hside - hoverlap - have step : ∀ x y l₁ l₂, p = l₁ ++ x :: y :: l₂ → adj x y := SquareInterfaceConstruction.step n - m hn hm a b vertical hside hoverlap - have occurs (k : Nat) (hk : k < (u - l).toNat) : - ∃ l₁ l₂, p = l₁ ++ f k :: f (k + 1) :: l₂ := SquareInterfaceConstruction.occurs n m a b - vertical k hk - have edge_step (k : Nat) (hk : k < (u - l).toNat) : - {f k, f (k + 1)} ∈ BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B := - SquareInterfaceConstruction.edge_step n m hn hm a b vertical hside hoverlap k hk - have adjacent_indices (j k : Nat) (h : adj (f j) (f k)) : - k = j + 1 ∨ j = k + 1 := SquareInterfaceConstruction.adjacent_indices n m hn hm a b - vertical hside hoverlap j k h have path : SimpleGridPath (BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B) (BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B) := SquareInterfaceConstruction.path n m hn hm a b vertical hside hoverlap diff --git a/LeanPool/ApollonianSuperharmonic/P5124T1EmptyParents.lean b/LeanPool/ApollonianSuperharmonic/P5124T1EmptyParents.lean index 03fd4653a5..187f1fed32 100644 --- a/LeanPool/ApollonianSuperharmonic/P5124T1EmptyParents.lean +++ b/LeanPool/ApollonianSuperharmonic/P5124T1EmptyParents.lean @@ -784,13 +784,6 @@ theorem P5124T1EmptyParents : have hVa : V.anchor = ⟨-1, 0⟩ := by dsimp [V, P5124T1ParentModel]; decide +kernel have hVne : ¬ V.cells.Nonempty := by rw [hVc]; simp have hWc : W.cells = {⟨1, 0⟩} := by dsimp [W, P5124T1ParentModel] - let sqE : Set (Finset GaussianInt) := {e | - e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩} ∨ - e = {⟨-1, 2⟩, ⟨0, 2⟩} ∨ e = {⟨0, 2⟩, ⟨1, 2⟩} ∨ - e = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ e = {⟨1, 0⟩, ⟨1, 1⟩} ∨ - e = {⟨-1, 1⟩, ⟨-1, 2⟩} ∨ e = {⟨1, 1⟩, ⟨1, 2⟩}} - let sqV : Set GaussianInt := {⟨-1, 0⟩, ⟨0, 0⟩, ⟨1, 0⟩, - ⟨-1, 1⟩, ⟨1, 1⟩, ⟨-1, 2⟩, ⟨0, 2⟩, ⟨1, 2⟩} let r : Int → Int := fun b => min (b + 1) (2 * (1 : Int) - b) let H : Int → Int → Prop := fun a b => ((b = 0 ∨ b = 2 * (1 : Int)) ∧ -1 ≤ a ∧ a < 1) ∨ @@ -811,8 +804,6 @@ theorem P5124T1EmptyParents : e = {⟨-1, 0⟩, ⟨0, 0⟩} ∨ e = {⟨0, 0⟩, ⟨1, 0⟩} ∨ e = {⟨-1, -2⟩, ⟨-1, -1⟩} ∨ e = {⟨1, -2⟩, ⟨1, -1⟩} ∨ e = {⟨-1, -1⟩, ⟨-1, 0⟩} ∨ e = {⟨1, -1⟩, ⟨1, 0⟩}} - let lowV : Set GaussianInt := {⟨-1, -2⟩, ⟨0, -2⟩, ⟨1, -2⟩, - ⟨-1, -1⟩, ⟨1, -1⟩, ⟨-1, 0⟩, ⟨0, 0⟩, ⟨1, 0⟩} obtain ⟨_, _, _, _, _, _, _, hBV, hBE⟩ := TileTranslationFormulas D ⟨0, -2⟩ have hBe : BoundaryFootprintEdges B = lowE := by change BoundaryFootprintEdges (TileTranslation D ⟨0, -2⟩) = lowE @@ -832,10 +823,6 @@ theorem P5124T1EmptyParents : have pairEq {α : Type} [DecidableEq α] (a b c d : α) := EmptyParentGeometry.pairEq (α := α) a b c d have hDBe := EmptyParentGeometry.hDBe hDe hBe pairEq - let unitE : Set (Finset GaussianInt) := {e | - e = {⟨-2, 0⟩, ⟨-1, 0⟩} ∨ e = {⟨-2, 0⟩, ⟨-2, 1⟩} ∨ - e = {⟨-1, 0⟩, ⟨-1, 1⟩} ∨ e = {⟨-2, 1⟩, ⟨-1, 1⟩}} - let unitV : Set GaussianInt := {⟨-2, 0⟩, ⟨-1, 0⟩, ⟨-2, 1⟩, ⟨-1, 1⟩} have hUe := EmptyParentGeometry.hUe hUc have hUne : U.cells.Nonempty := by rw [hUc]; simp have hUv := EmptyParentGeometry.hUv hUe hUne @@ -843,10 +830,6 @@ theorem P5124T1EmptyParents : simp only [W, U, P5124T1ParentModel, TileTranslation] constructor obtain ⟨_, _, _, _, _, _, _, hWtV, hWtE⟩ := TileTranslationFormulas U ⟨3, 0⟩ - let rightE : Set (Finset GaussianInt) := {e | - e = {⟨1, 0⟩, ⟨2, 0⟩} ∨ e = {⟨1, 0⟩, ⟨1, 1⟩} ∨ - e = {⟨2, 0⟩, ⟨2, 1⟩} ∨ e = {⟨1, 1⟩, ⟨2, 1⟩}} - let rightV : Set GaussianInt := {⟨1, 0⟩, ⟨2, 0⟩, ⟨1, 1⟩, ⟨2, 1⟩} have gt20 : GaussianTranslation ⟨3, 0⟩ ⟨-2, 0⟩ = ⟨1, 0⟩ := by decide +kernel have gt10 : GaussianTranslation ⟨3, 0⟩ ⟨-1, 0⟩ = ⟨2, 0⟩ := by decide +kernel have gt21 : GaussianTranslation ⟨3, 0⟩ ⟨-2, 1⟩ = ⟨1, 1⟩ := by decide +kernel @@ -896,7 +879,6 @@ theorem P5124T1EmptyParents : have hWn : W.cells.Nonempty := by rw [hWc]; simp have hDBdis : Disjoint D.cells B.cells := by rw [hDc, hBc]; decide +kernel have hDUdis : Disjoint D.cells U.cells := by rw [hDc, hUc]; decide +kernel - have hDWdis : Disjoint D.cells W.cells := by rw [hDc, hWc]; decide +kernel have pDB : SimpleGridPath (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices B) (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges B) := by diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5ParentArithmetic.lean b/LeanPool/ApollonianSuperharmonic/P5130T5ParentArithmetic.lean index 99f1125f94..034a5c978a 100644 --- a/LeanPool/ApollonianSuperharmonic/P5130T5ParentArithmetic.lean +++ b/LeanPool/ApollonianSuperharmonic/P5130T5ParentArithmetic.lean @@ -44,7 +44,6 @@ theorem P5130T5ParentArithmetic (P : FordFareyParameter) (hq : 1 < P.q) : have hz : P.q₁ = 0 := by omega rw [hz] at hd simp only [Nat.cast_zero, zero_mul, sub_zero] at hd - have hqi : (1 : Int) < P.q := by exact_mod_cast hq have : (P.q : Int) ∣ 1 := ⟨P.p₁, by nlinarith [hd]⟩ have := Int.le_of_dvd (by norm_num : (0 : Int) < 1) this omega diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean b/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean index 13ca866259..da4e02c0d4 100644 --- a/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean +++ b/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean @@ -221,31 +221,20 @@ private theorem first_parent_overlap : have hqle : (P.q₁ : Int) ≤ 1 := Int.le_of_dvd (by norm_num) hdiv have hqone : P.q₁ = 1 := by omega have hq2one : P.q₂ = 1 := by omega - have hq1int : (P.q₁ : Int) = 1 := by exact_mod_cast hqone have hq2int : (P.q₂ : Int) = 1 := by exact_mod_cast hq2one have hxre : x.re = 1 := by omega have hxim : x.im = 1 := by omega let c : GaussianInt := ⟨1, 1⟩ have hxc : x = c := by ext <;> simp [c, hxre, hxim] have hpone : P.p₁ = P.p₂ + 1 := by nlinarith [hmul, hqone] - have hPq : P.q = 2 := by have hs := P.sum_q; omega have hP1q : P₁.q = 1 := by omega - have hP2q : P₂.q = 1 := by omega let z : GaussianInt := ⟨0, 0⟩ - let u : GaussianInt := ⟨0, 1⟩ - let v : GaussianInt := ⟨1, 0⟩ have hz1 : G P₁ z = 0 := by have hb := hB P₁ (by omega) z (by simp [z, FordDoubledBoundary, FordVertexDomain]) simpa [z, IntegerCeilDiv] using hb have hc1 : G P₁ c = P₁.p := by have hb := hB P₁ (by omega) c (by simp [c, hP1q, FordDoubledBoundary, FordVertexDomain]) simpa [c, IntegerCeilDiv, hP1q] using hb - have hu2 : G P₂ u = 0 := by - have hb := hB P₂ (by omega) u (by simp [u, hP2q, FordDoubledBoundary, FordVertexDomain]) - simpa [u, IntegerCeilDiv] using hb - have hv2 : G P₂ v = 0 := by - have hb := hB P₂ (by omega) v (by simp [v, hP2q, FordDoubledBoundary, FordVertexDomain]) - simpa [v, IntegerCeilDiv] using hb have hval : P₁.p = P₂.p + 1 := by omega rw [hxc] simp only [P5130T5Prescription, Matrix.cons_val_zero, Matrix.cons_val_one, @@ -280,8 +269,6 @@ theorem P5130T5SameParentOverlaps (P P₁ P₂ : FordFareyParameter) have hq2 : P₂.q = P.q₂ := SameParentOverlapLemmas.hq2 P P₂ hq₂ have hp1 : P₁.p = P.p₁ := SameParentOverlapLemmas.hp1 P P₁ hp₁ have hp2 : P₂.p = P.p₂ := SameParentOverlapLemmas.hp2 P P₂ hp₂ - have hq1pos' : 0 < P₁.q := SameParentOverlapLemmas.hq1pos' P P₁ hq₁ hq1pos - have hq2pos' : 0 < P₂.q := SameParentOverlapLemmas.hq2pos' P P₂ hq₂ hq2pos have hq1lt' : P₁.q < P.q := SameParentOverlapLemmas.hq1lt' P P₁ hq₁ hq1lt have hq2lt' : P₂.q < P.q := SameParentOverlapLemmas.hq2lt' P P₂ hq₂ hq2lt have first_parent_overlap : ∀ x, @@ -296,7 +283,6 @@ theorem P5130T5SameParentOverlaps (P P₁ P₂ : FordFareyParameter) let q4 : Nat := P.q₂ - P.q₁ let p4 : Int := P.p₂ - P.p₁ have hq4pos : 0 < q4 := by dsimp [q4]; omega - have hq4lt : q4 < P.q₂ := by dsimp [q4]; omega have hq4cast : (P.q₂ : Int) = (P.q₁ : Int) + (q4 : Int) := by dsimp [q4] rw [Nat.cast_sub hlt.le] @@ -356,7 +342,6 @@ theorem P5130T5SameParentOverlaps (P P₁ P₂ : FordFareyParameter) rcases hx3 with ⟨hx3r, hx3r', hx3i, hx3i'⟩ let u : GaussianInt := x - ⟨(P.q₁ : Int), 0⟩ let v : GaussianInt := x - ⟨0, (P.q₁ : Int)⟩ - let w : GaussianInt := x - ⟨(P.q₁ : Int), (P.q₁ : Int)⟩ have hu3 : u ∈ FordRecursiveVertexDomains P₂ 3 := by simp only [FordRecursiveVertexDomains, Matrix.cons_val_three] change 0 ≤ u.re ∧ u.re ≤ (P₂.q₂ : Int) ∧ @@ -403,32 +388,23 @@ theorem P5130T5SameParentOverlaps (P P₁ P₂ : FordFareyParameter) have hdiv : (P.q₁ : Int) ∣ (1 : Int) := ⟨P.p₁ - P.p₂, hmul.symm⟩ have hqle : (P.q₁ : Int) ≤ 1 := Int.le_of_dvd (by norm_num) hdiv have hqone : P.q₁ = 1 := by omega - have hq2one : P.q₂ = 1 := by omega simp only [FordRecursiveVertexDomains] at hx2 hx3 rcases hx2 with ⟨hx2r, hx2r', hx2i, hx2i'⟩ rcases hx3 with ⟨hx3r, hx3r', hx3i, hx3i'⟩ have hq1int : (P.q₁ : Int) = 1 := by exact_mod_cast hqone - have hq2int : (P.q₂ : Int) = 1 := by exact_mod_cast hq2one have hxre : x.re = 1 := by omega have hxim : x.im = 1 := by omega let c : GaussianInt := ⟨1, 1⟩ have hxc : x = c := by ext <;> simp [c, hxre, hxim] - have hpone : P.p₁ = P.p₂ + 1 := by nlinarith [hmul, hqone] - have hPq : P.q = 2 := by have hs := P.sum_q; omega - have hP1q : P₁.q = 1 := by omega have hP2q : P₂.q = 1 := by omega let u : GaussianInt := ⟨0, 1⟩ let v : GaussianInt := ⟨1, 0⟩ - have hc1 : G P₁ c = P₁.p := by - have hb := hB P₁ (by omega) c (by simp [c, hP1q, FordDoubledBoundary, FordVertexDomain]) - simpa [c, IntegerCeilDiv, hP1q] using hb have hu2 : G P₂ u = 0 := by have hb := hB P₂ (by omega) u (by simp [u, hP2q, FordDoubledBoundary, FordVertexDomain]) simpa [u, IntegerCeilDiv] using hb have hv2 : G P₂ v = 0 := by have hb := hB P₂ (by omega) v (by simp [v, hP2q, FordDoubledBoundary, FordVertexDomain]) simpa [v, IntegerCeilDiv] using hb - have hval : P₁.p = P₂.p + 1 := by omega rw [hxc] simp only [P5130T5Prescription, Matrix.cons_val_two, Matrix.cons_val_three] diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1E1Boundary.lean b/LeanPool/ApollonianSuperharmonic/P5188T1E1Boundary.lean index d9d2e938a3..42640213f3 100644 --- a/LeanPool/ApollonianSuperharmonic/P5188T1E1Boundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5188T1E1Boundary.lean @@ -39,29 +39,20 @@ theorem P5188T1E1Boundary (P P₁ : FordFareyParameter) IntegerCeilDiv (P.p * x.re * x.im) P.q (by exact_mod_cast P.q_pos.ne') := by -- BODY have hsum : (P.q : Int) = P.q₁ + P.q₂ := by exact_mod_cast P.sum_q - have hps : P.p = P.p₁ + P.p₂ := P.sum_p - have hcross := (P5130T5ParentArithmetic P hq).2.2.2.2.2.2 have hdet₁ := P.det₁ - have hdet₂ := P.det₂ have hqpos : 0 < (P.q : Int) := by exact_mod_cast P.q_pos have ha : 0 < (P.q₁ : Int) := by have := (P5130T5ParentArithmetic P hq).1; exact_mod_cast this have hb : 0 < (P.q₂ : Int) := by have := P.q₂_pos; exact_mod_cast this have hab : (P.q₁ : Int) < P.q := by have := P.q₁_lt; exact_mod_cast this - have hbb : (P.q₂ : Int) < P.q := by rw [hsum]; omega let a : Int := P.q₁ let b : Int := P.q₂ let A : Int := P.p₁ - let D : Int := P.p₂ - have haq : a + b = P.q := by dsimp [a, b]; exact hsum.symm - have hpq : A + D = P.p := by dsimp [A, D]; exact hps.symm have hAq : A * P.q - a * P.p = 1 := by simpa [a, A] using hdet₁ have hpqa : P.p * a = A * P.q - 1 := by have haux : A * P.q - P.p * a = 1 := by rw [mul_comm P.p a] exact hAq omega - have hDq : D * P.q - b * P.p = -1 := by simpa [b, D] using hdet₂ - have hAB : A * b - D * a = 1 := by simpa [a, b, A, D] using hcross have ceilPerturb := P5188T1CeilingStability have ceilBelow := P5188T1CeilingBelow have ceilMul (c t d : Int) (hd : d ≠ 0) : diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean b/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean index 72e22069d6..fb86f8cc29 100644 --- a/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean @@ -329,21 +329,17 @@ theorem P5188T1E2Boundary (P P₁ : FordFareyParameter) have hsum : (P.q : Int) = P.q₁ + P.q₂ := SecondEdgeBoundaryConstruction.hsum P have hps : P.p = P.p₁ + P.p₂ := SecondEdgeBoundaryConstruction.hps P have hcross := SecondEdgeBoundaryConstruction.hcross P hq - have hdet₁ := SecondEdgeBoundaryConstruction.hdet₁ P have hdet₂ := SecondEdgeBoundaryConstruction.hdet₂ P have hqpos : 0 < (P.q : Int) := SecondEdgeBoundaryConstruction.hqpos P have ha : 0 < (P.q₁ : Int) := SecondEdgeBoundaryConstruction.ha P hq have hb : 0 < (P.q₂ : Int) := SecondEdgeBoundaryConstruction.hb P have hab : (P.q₁ : Int) < P.q := SecondEdgeBoundaryConstruction.hab P - have hbb : (P.q₂ : Int) < P.q := SecondEdgeBoundaryConstruction.hbb P hsum ha let a : Int := P.q₁ let b : Int := P.q₂ let A : Int := P.p₁ let D : Int := P.p₂ have haq : a + b = P.q := SecondEdgeBoundaryConstruction.haq P hsum have hpq : A + D = P.p := SecondEdgeBoundaryConstruction.hpq P hps - have hAq : A * P.q - a * P.p = 1 := SecondEdgeBoundaryConstruction.hAq P hdet₁ - have hpqa : P.p * a = A * P.q - 1 := SecondEdgeBoundaryConstruction.hpqa P hAq have hDq : D * P.q - b * P.p = -1 := SecondEdgeBoundaryConstruction.hDq P hdet₂ have hAB : A * b - D * a = 1 := SecondEdgeBoundaryConstruction.hAB P hcross have ceilPerturb := SecondEdgeBoundaryConstruction.ceilPerturb diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1E3E4Boundary.lean b/LeanPool/ApollonianSuperharmonic/P5188T1E3E4Boundary.lean index fcab666cb8..6dfea99247 100644 --- a/LeanPool/ApollonianSuperharmonic/P5188T1E3E4Boundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5188T1E3E4Boundary.lean @@ -49,11 +49,9 @@ theorem P5188T1E3E4Boundary (P P₂ : FordFareyParameter) have hps : P.p = P.p₁ + P.p₂ := P.sum_p have hcross := (P5130T5ParentArithmetic P hq).2.2.2.2.2.2 have hdet₁ := P.det₁ - have hdet₂ := P.det₂ have hqpos : 0 < (P.q : Int) := by exact_mod_cast P.q_pos have ha : 0 < (P.q₁ : Int) := by have := (P5130T5ParentArithmetic P hq).1; exact_mod_cast this have hb : 0 < (P.q₂ : Int) := by have := P.q₂_pos; exact_mod_cast this - have hab : (P.q₁ : Int) < P.q := by have := P.q₁_lt; exact_mod_cast this have hbb : (P.q₂ : Int) < P.q := by rw [hsum]; omega let a : Int := P.q₁ let b : Int := P.q₂ @@ -67,7 +65,6 @@ theorem P5188T1E3E4Boundary (P P₂ : FordFareyParameter) rw [mul_comm P.p a] exact hAq omega - have hDq : D * P.q - b * P.p = -1 := by simpa [b, D] using hdet₂ have hAB : A * b - D * a = 1 := by simpa [a, b, A, D] using hcross have ceilPerturb := P5188T1CeilingStability have ceilBelow := P5188T1CeilingBelow diff --git a/LeanPool/ApollonianSuperharmonic/P5260T1LiteralPlacement.lean b/LeanPool/ApollonianSuperharmonic/P5260T1LiteralPlacement.lean index fa482494ca..13dcb6b9f9 100644 --- a/LeanPool/ApollonianSuperharmonic/P5260T1LiteralPlacement.lean +++ b/LeanPool/ApollonianSuperharmonic/P5260T1LiteralPlacement.lean @@ -109,7 +109,6 @@ theorem P5260T1LiteralPlacement : (ProtoTileObservableExtensionality _ _ hcU haU).2.2.2.2 let g := fun z : GaussianInt => a + (if s.val < 2 then z else C - z - 1 - ⟨0, 1⟩) - let f := fun z : GaussianInt => a + (if s.val < 2 then z else C - z) have image_place (S : Finset GaussianInt) (center v : GaussianInt) (hsym : S.image (fun z => center - z - 1 - ⟨0, 1⟩) = S) : (S.image (GaussianTranslation diff --git a/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean b/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean index 11ac81e8a7..45bec0083a 100644 --- a/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean @@ -230,8 +230,6 @@ private theorem capBetween : have him' : z.im - u.im = 2 * (m : Int) := by simpa only [Zsqrtd.im_sub] using him have hre' : z.re - u.re = (z - u).re := by simp - have hlo' : -1 ≤ z.re - u.re := by simpa only [Zsqrtd.re_sub] using hlow - have hhi' : z.re - u.re ≤ 1 := by simpa only [Zsqrtd.re_sub] using hhigh have hre : (z - u).re = -1 ∨ (z - u).re = 0 ∨ (z - u).re = 1 := by omega rcases hre with h | h | h · left @@ -1127,8 +1125,6 @@ private theorem capBoundaryVerticesEq : · rintro ⟨him, hlo, hhi⟩ have him' : z.im - v.im = 2 * (m : Int) := by simpa only [Zsqrtd.im_sub] using him - have hlo' : -1 ≤ z.re - v.re := by simpa only [Zsqrtd.re_sub] using hlo - have hhi' : z.re - v.re ≤ 1 := by simpa only [Zsqrtd.re_sub] using hhi have hcase : (z - v).re = -1 ∨ (z - v).re = 0 ∨ (z - v).re = 1 := by omega rcases hcase with h | h | h @@ -2150,7 +2146,6 @@ private theorem sameCellObs : | mk uc ua => dsimp only at hc subst uc - have hne' : tc.Nonempty := hne simp [FootprintVertices, FootprintEdges, hne] private theorem JtranslatedVertices : @@ -2950,7 +2945,6 @@ private theorem reflectedInterfaces : let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ let U : ProtoTile := ⟨{⟨0, -1⟩}, ⟨0, -1⟩⟩ let x : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ - let y : GaussianInt := 1 have Jinj := PredecessorInterfaceGeometry.Jinj k have Jstep := PredecessorInterfaceGeometry.Jstep k have hzero : (0 : GaussianInt) = @@ -3078,7 +3072,6 @@ theorem P5260T1PredecessorInterfaces (k : Nat) (hk : 1 < k) (b : Bool) : let shiftR : GaussianInt := ⟨2 * (k : Int), 0⟩ have hpStart := PredecessorInterfaceGeometry.hpStart have hpEnd := PredecessorInterfaceGeometry.hpEnd k hk - have pathWD := PredecessorInterfaceGeometry.pathWD k pathDW have translateZero (T : ProtoTile) : TileTranslation T 0 = T := PredecessorInterfaceGeometry.translateZero T let shiftLow : GaussianInt := ⟨0, -(2 * (k : Int))⟩ @@ -3100,7 +3093,6 @@ theorem P5260T1PredecessorInterfaces (k : Nat) (hk : 1 < k) (b : Bool) : zero_add, sub_zero, Prod.mk.injEq] at hu have huEq := PredecessorInterfaceGeometry.huEq k u hu let Q : GaussianInt → GaussianInt := GaussianQuarterTurn - let F : GaussianInt → GaussianInt := fun z => Q z + u have F_inj := PredecessorInterfaceGeometry.F_inj u have quarterVertices := PredecessorInterfaceGeometry.quarterVertices k u have quarterBaseVertices := PredecessorInterfaceGeometry.quarterBaseVertices k u @@ -3143,28 +3135,17 @@ theorem P5260T1PredecessorInterfaces (k : Nat) (hk : 1 < k) (b : Bool) : have hUedgeBot' : {0, 1} ∈ BoundaryFootprintEdges U := (PredecessorInterfaceGeometry.hUedgeBot) have hyDL := PredecessorInterfaceGeometry.hyDL k (PredecessorInterfaceGeometry.hDLboundary k hkpos hlowTile capBoundaryVerticesEq) (PredecessorInterfaceGeometry.hcapRight k) - have hyDW := PredecessorInterfaceGeometry.hyDW k hDWv have hsmallTriple := P5124T1SmallerParents k hk have hIboundaryUnique := PredecessorInterfaceGeometry.hIboundaryUnique k hyDL (PredecessorInterfaceGeometry.hyLW k hLWv) (PredecessorInterfaceGeometry.hsmallI k hsmallTriple) - let J : GaussianInt → GaussianInt := fun z => - GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) have Jcoordinate := PredecessorInterfaceGeometry.Jcoordinate k - have reflectedPath {V : Set GaussianInt} {E : Set (Finset GaussianInt)} - {x y : GaussianInt} (hp : SimpleGridPathBetween V E x y) := - PredecessorInterfaceGeometry.reflectedPath k (V := V) (E := E) (x := x) (y := y) hp - let x : GaussianInt := ⟨(k : Int), (k : Int) - 1⟩ - let y : GaussianInt := 1 have hDWraw := PredecessorInterfaceGeometry.hDWraw k rawBoundaryVertices diamondCellsNonempty hkpos hDWd hDWv hWne - have hLWraw := PredecessorInterfaceGeometry.hLWraw k rawBoundaryVertices - translatedDiamondCellsNonempty hkpos hLWd hLWv hWne have hlowStart : shiftLow + ⟨1, 2 * (k : Int)⟩ = 1 := by apply Zsqrtd.ext <;> simp [shiftLow] have hlowEnd : shiftLow + ⟨-1, 2 * (k : Int)⟩ = -1 := by apply Zsqrtd.ext <;> simp [shiftLow] - have hIABoundary := PredecessorInterfaceGeometry.hIABoundary k hIboundaryUnique exact (PredecessorReflection.reflectedInterfaces k hk b hkpos hsmall translateZero (PredecessorInterfaceGeometry.Jx k Jcoordinate) (PredecessorInterfaceGeometry.Jy k Jcoordinate) (PredecessorInterfaceGeometry.sameCellObs) diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean b/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean index b1f1fae123..aefd35a483 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean @@ -2022,7 +2022,6 @@ private theorem rowFirst0 : classical intro k imagePath qinj decBetween D Q dzeroD c hcEq Fc F_inj hDne quarterVerticesAt quarterEdgesAt dShift cellMapZero da cellMapRight ddisjD dneDright disjointImage - let F : GaussianInt → GaussianInt := fun z => Q z + c exact ⟨hDne, (DiamondPathComparison.firstCells₁ k c cellMapRight dneDright), (DiamondPathComparison.firstCellsDisj k c (DiamondPathComparison.F_cell_inj qinj c) cellMapZero cellMapRight ddisjD disjointImage), (DiamondPathComparison.firstTurn k @@ -2177,7 +2176,6 @@ private theorem h0 : classical intro k dV decVertices D Q dzeroD c hcEq F_inj quarterVerticesAt dShift zeroQ da secondVertices rowFirst0 rowSecond0 - let F : GaussianInt → GaussianInt := fun z => Q z + c exact DiamondPathComparison.h0 k c (DiamondPathComparison.firstVertices k decVertices c F_inj (DiamondPathComparison.zeroFvertices k dzeroD c quarterVerticesAt zeroQ) @@ -2350,7 +2348,6 @@ theorem P5290T1EqualDiamondPaths (k : Nat) (hk : 0 < k) 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1} let dP : Nat → GaussianInt := fun j => ⟨(k : Int) - (j / 2 : Nat), (k : Int) + ((j + 1) / 2 : Nat)⟩ - let dE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {dP j, dP (j + 1)}} have dq (j : Nat) : GaussianQuarterTurn (q j) = dP j := by exact qenum j have dec := P5203T1DecreasingInterface k hk 0 @@ -2364,15 +2361,6 @@ theorem P5290T1EqualDiamondPaths (k : Nat) (hk : 0 < k) qImagePath (DiamondPathComparison.qendpoint₀ k qenum) (DiamondPathComparison.qendpoint₁ k hk qenum) (DiamondPathComparison.dVimage k dq (DiamondPathComparison.dVenum k hk hN)) (DiamondPathComparison.dEimage k dq)) decVertices decEdges - let iV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ - z.re - 1 ≤ z.im ∧ z.im ≤ z.re} - let iP : Nat → GaussianInt := fun j => - ⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ - let iE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {iP j, iP (j + 1)}} - let iq : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 - have iqenum (j : Nat) : iq j = iP j := by - apply Zsqrtd.ext <;> simp [iq, iP, P5157T1StaircasePoint] - have iEeq := DiamondPathComparison.iEeq k iqenum have inc := P5203T1IncreasingInterface k hk 0 dsimp only at inc rcases inc with ⟨ine, ine', idisj, ivertex0, iedge0, _⟩ @@ -2422,8 +2410,6 @@ theorem P5290T1EqualDiamondPaths (k : Nat) (hk : 0 < k) ⟨z.im - (k : Int), (k : Int) - 1 - z.re⟩ have qInvLeft (z : GaussianInt) : Q (Qinv z) = z := by apply Zsqrtd.ext <;> simp [Q, Qinv, GaussianQuarterTurn] - have qInvRight (z : GaussianInt) : Qinv (Q z) = z := by - apply Zsqrtd.ext <;> simp [Q, Qinv, GaussianQuarterTurn] have GF (z : GaussianInt) : G (F z) = z := by apply Zsqrtd.ext <;> simp [G, F, Q, GaussianQuarterTurn, hcEq] have FG (z : GaussianInt) : F (G z) = z := by @@ -2468,8 +2454,6 @@ theorem P5290T1EqualDiamondPaths (k : Nat) (hk : 0 < k) simpa only [zero_add] using ine' have iaTurn : Qinv ia = ⟨-(k : Int), -(k : Int) - 1⟩ := by apply Zsqrtd.ext <;> simp [Qinv, ia]; ring - have iaNeg : ⟨-(k : Int) - 1, (k : Int)⟩ + ia = 0 := by - apply Zsqrtd.ext <;> simp [ia] let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ have translateInj (u : GaussianInt) := DiamondPathComparison.translateInj u have shiftCellsOne := DiamondPathComparison.shiftCellsOne k @@ -2480,9 +2464,6 @@ theorem P5290T1EqualDiamondPaths (k : Nat) (hk : 0 < k) have hnestedV : BoundaryFootprintVertices (TileTranslation (TileTranslation D ia) shift) = BoundaryFootprintVertices D := vertexCellsEq hnested hDne - have hnestedE : BoundaryFootprintEdges - (TileTranslation (TileTranslation D ia) shift) = BoundaryFootprintEdges D := - edgeCellsEq hnested have secondPath := DiamondRowPaths.secondPath k decBetween have secondCellsDisj : Disjoint D.cells (TileTranslation D da).cells := ddisjD have secondCells₂ : (TileTranslation D da).cells.Nonempty := dneDright @@ -2493,13 +2474,6 @@ theorem P5290T1EqualDiamondPaths (k : Nat) (hk : 0 < k) (DiamondPathComparison.shiftCellsTwo k dzeroD translateCells)) have secondVertices : BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D da) = dV := decVertices - have firstEdges := DiamondPathComparison.firstEdges k decEdges c F_inj - (DiamondPathComparison.zeroFedges k dzeroD c quarterEdgesAt zeroQ) - (DiamondPathComparison.rightFedges k c quarterEdgesAt dShift) - have thirdEdges := DiamondPathComparison.thirdEdges k incEdges G_inj inverseEdgesAt - inverseEdgesZero - have fourthEdges := DiamondPathComparison.fourthEdges k (DiamondPathComparison.shiftEdges k - incEdges translateInj hnestedE) have rowFirst0 := DiamondRowConclusions.rowFirst0 k imagePath qinj decBetween dzeroD c hcEq F_inj hDne quarterVerticesAt quarterEdgesAt dShift cellMapZero cellMapRight ddisjD dneDright disjointImage diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean b/LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean index 19a79bbd6d..b850a20827 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1PredecessorPath.lean @@ -830,7 +830,6 @@ theorem P5290T1PredecessorPath (k : Nat) (hk : 1 < k) : have hDedges : BoundaryFootprintEdges D = (fun e : Finset GaussianInt => e.image J) '' BoundaryFootprintEdges D := PredecessorPathDetails.hDedges k hScells hSedges hBoundaryE - let JE : Finset GaussianInt → Finset GaussianInt := fun e => e.image J have hJEinj := PredecessorPathProof.hJEinj k hJinj have hVerticesInter := PredecessorPathProof.hVerticesInter k hJinj hZvertices hDvertices have hEdgesInter := PredecessorPathProof.hEdgesInter k hZedges hDedges hJEinj diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean b/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean index 76baf39678..354a3e69cf 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean @@ -388,7 +388,6 @@ private theorem oneUnitContacts (k : Nat) (hk : 0 < k) : unitContactConclusion k 1 := by classical have makePath := UnitContactProof.makePath - have rightContact := UnitContactProof.rightContact k hk have singletonPath := UnitContactProof.singletonPath makePath let M := P5260T1PlacementLedger k 1 false let D := DiamondTile k @@ -534,8 +533,6 @@ private theorem oneUnitContacts (k : Nat) (hk : 0 < k) : (by simpa [Finset.pair_comm] using hPairEdgeRight) (Or.inr (Or.inl rfl)) let z1 : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ - have hPairBase : c1 + ⟨0, 1⟩ = z1 := by - ext <;> simp [c1, z1] have hPairBaseCoord : (⟨-(k : Int) - 1, (k : Int) - 1⟩ : GaussianInt) + ⟨0, 1⟩ = ⟨-(k : Int) - 1, (k : Int)⟩ := by diff --git a/LeanPool/ApollonianSuperharmonic/P5300T1CanonicalRowArithmetic.lean b/LeanPool/ApollonianSuperharmonic/P5300T1CanonicalRowArithmetic.lean index a2640eb45c..4c297d8c86 100644 --- a/LeanPool/ApollonianSuperharmonic/P5300T1CanonicalRowArithmetic.lean +++ b/LeanPool/ApollonianSuperharmonic/P5300T1CanonicalRowArithmetic.lean @@ -74,7 +74,6 @@ theorem P5300T1CanonicalRowArithmetic (K : DiamondParameter) -- BODY classical dsimp only - let q := DiamondRecursiveQuadruple K let b : Bool := decide (s.val % 2 = 1) let j : Fin 3 := if Even s.val then i - 1 else i + 1 let M := P5260T1PlacementLedger K.1 i b diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation0Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation0Values.lean index ca8012aaca..ba35473c84 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation0Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation0Values.lean @@ -46,13 +46,10 @@ theorem P5332T1Parent1Rotation0Values (P A : FordFareyParameter) (hq : 1 < P.q) t = 0 ∧ Even (0+0 : Nat)) := by -- BODY classical - have hq' : 1 < (P.q : Int) := by exact_mod_cast hq have hqn : (P.q : Int) ≠ 0 := by omega have par := P5130T5ParentArithmetic P hq have hr : 0 < (P.q₁ : Int) := by exact_mod_cast par.1 - have hs : 0 < (P.q₂ : Int) := Int.natCast_pos.mpr P.q₂_pos have hrs : (P.q₁ : Int) + P.q₂ = P.q := by exact_mod_cast P.sum_q.symm - have hpa : P.p₁ * P.q - (P.q₁ : Int) * P.p = 1 := P.det₁ have hpb : P.p₂ * P.q - (P.q₂ : Int) * P.p = -1 := P.det₂ have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ _ at laws @@ -79,11 +76,6 @@ theorem P5332T1Parent1Rotation0Values (P A : FordFareyParameter) (hq : 1 < P.q) omega let t : Int := X - (P.q₂ : Int) have ht0 : 0 ≤ t := by dsimp [t]; omega - have htr0 : t ≤ (P.q₁ : Int) := by - have := hchild.2.1 - have hAq' : (A.q : Int) = P.q₁ := by exact_mod_cast hAq - dsimp [t] - omega have hstarTop := hstar 3 have hstarRight := hstar 1 dsimp [P5332T1ParentRows] at hstarTop hstarRight @@ -98,7 +90,6 @@ theorem P5332T1Parent1Rotation0Values (P A : FordFareyParameter) (hq : 1 < P.q) omega have hcenter : (⟨X,Y⟩ : GaussianInt) = (P5332T1ParentRows P 0 0 t).center := by ext <;> simp [P5332T1ParentRows, t, hY] - have hcenter0 := hbase (⟨X,Y⟩ : GaussianInt) hx have hcenter1 := hother (⟨X,Y⟩ : GaussianInt) (by change 0 ≤ X-(P.q₂ : Int) ∧ X-(P.q₂ : Int) ≤ (A.q : Int) ∧ 0 ≤ Y-(P.q : Int) ∧ Y-(P.q : Int) ≤ (A.q : Int) @@ -111,11 +102,6 @@ theorem P5332T1Parent1Rotation0Values (P A : FordFareyParameter) (hq : 1 < P.q) have he : -(N.p*u*(N.q : Int)) = (-N.p*u)*(N.q : Int) := by ring rw [he, Int.mul_ediv_cancel _ (by exact_mod_cast N.q_pos.ne')] ring - have left (N : FordFareyParameter) (v : Int) - (hv : 0 ≤ v) (hvq : v ≤ (N.q : Int)) : - FordOdometer N ⟨0,v⟩ = 0 := by - rw [boundary N 0 v (by omega) (by omega) hv hvq (by omega)] - simp [IntegerCeilDiv] have bottom (N : FordFareyParameter) (u : Int) (hu : 0 ≤ u) (huq : u ≤ (N.q : Int)) : FordOdometer N ⟨u,0⟩ = 0 := by diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation1Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation1Values.lean index 78c59df3d0..d85e2b82ea 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation1Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation1Values.lean @@ -78,10 +78,8 @@ theorem P5332T1Parent1Rotation1Values (P A : FordFareyParameter) (hq : 1 < P.q) t = 0 ∧ Even (1+0 : Nat)) := by -- BODY classical - have hq' : 1 < (P.q : Int) := by exact_mod_cast hq have hqn : (P.q : Int) ≠ 0 := by omega have rposN := (P5130T5ParentArithmetic P hq).1 - have rpos : 0 < (P.q₁ : Int) := by exact_mod_cast rposN have spos : 0 < (P.q₂ : Int) := by exact_mod_cast P.q₂_pos have rq : (P.q₁ : Int) + P.q₂ = P.q := by have := P.sum_q @@ -108,7 +106,6 @@ theorem P5332T1Parent1Rotation1Values (P A : FordFareyParameter) (hq : 1 < P.q) simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub] at hx'0 have hAqNat : A.q = P.q₁ := hAq have hAq : (A.q : Int) = P.q₁ := by exact_mod_cast hAqNat - have hAp' : A.p = P.p₁ := hAp have hX : X = 0 := by omega subst X let t : Int := Y-P.q₂ @@ -121,9 +118,6 @@ theorem P5332T1Parent1Rotation1Values (P A : FordFareyParameter) (hq : 1 < P.q) dsimp [t] omega have hY : Y = P.q₂+t := by dsimp [t]; omega - have hcenter : (⟨0,Y⟩ : GaussianInt) = - (P5332T1ParentRows P 0 1 t).center := by - simp [P5332T1ParentRows, hY] have hcenterbase : f ⟨0,Y⟩ = 0 := by rw [hbase _ hx] rw [boundary P 0 Y (by omega) (by omega) (by omega) (by omega) (by omega)] @@ -264,7 +258,6 @@ theorem P5332T1Parent1Rotation1Values (P A : FordFareyParameter) (hq : 1 < P.q) by rw [rowCompanion] simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub] - have hbelow : Y < (P.q : Int) := by rw [hY]; omega intro h omega constructor diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation2Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation2Values.lean index 471d18e8fe..63a12d5f71 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation2Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation2Values.lean @@ -46,7 +46,6 @@ theorem P5332T1Parent1Rotation2Values (P A : FordFareyParameter) (hq : 1 < P.q) t = 0 ∧ Even (2+0 : Nat)) := by -- BODY classical - have hq' : 1 < (P.q : Int) := by exact_mod_cast hq have hqtwo : 2 ≤ (P.q : Int) := by omega have hqn : (P.q : Int) ≠ 0 := by omega have hrpos : 0 < P.q₁ := by diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation3Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation3Values.lean index c4e3d5c9ed..15c441b35a 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation3Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent1Rotation3Values.lean @@ -52,7 +52,6 @@ theorem P5332T1Parent1Rotation3Values (P A : FordFareyParameter) (hq : 1 < P.q) have hz : P.q₁ = 0 := by omega have : P.p₁ * (P.q : Int) = 1 := by simpa [hz] using P.det₁ - have hqpos : 1 < (P.q : Int) := by exact_mod_cast hq by_cases hp : P.p₁ ≤ 0 · nlinarith · have hp1 : 1 ≤ P.p₁ := by omega @@ -138,7 +137,6 @@ theorem P5332T1Parent1Rotation3Values (P A : FordFareyParameter) (hq : 1 < P.q) rw [arg] change 0 ≤ (1 : Int) ∧ (1 : Int) ≤ (A.q : Int) ∧ 0 ≤ Y ∧ Y ≤ (A.q : Int) - have hrA : 0 < (A.q : Int) := by rw [hA]; exact_mod_cast hq1_pos exact ⟨by omega, by omega, hYlow, by simpa [hA] using hYhigh⟩) dsimp [P5332T1ParentRows] at he rw [arg, boundary A 1 Y (by omega) (by omega) hYlow diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean index a0b5424406..f63086c63e 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation0Values.lean @@ -163,7 +163,6 @@ private theorem values : simpa only [hy] using hp · simp only [Int.reduceNeg, Nat.succ_eq_add_one, Nat.reduceAdd, Fin.reduceFinMk, Matrix.cons_val, Zsqrtd.add_def, add_zero, Fin.isValue] - have northArg : (⟨0,Y⟩ : GaussianInt) + ⟨0,1⟩ = ⟨0,Y+1⟩ := by ext <;> simp have hh := hbase ⟨0,Y+1⟩ (by change (0 : Int) ≤ 0 ∧ 0 ≤ (P.q : Int) ∧ 0 ≤ Y+1 ∧ Y+1 ≤ (P.q : Int) omega) @@ -171,7 +170,6 @@ private theorem values : simp [P5332T1ParentRows] · simp only [Int.reduceNeg, Nat.succ_eq_add_one, Nat.reduceAdd, Fin.reduceFinMk, Matrix.cons_val, Fin.isValue] - have southArg : (⟨0,Y⟩ : GaussianInt) - ⟨0,1⟩ = ⟨0,Y-1⟩ := by ext <;> simp have southPlus : (⟨0,Y⟩ : GaussianInt) + (-⟨0,1⟩) = ⟨0,Y-1⟩ := by ext <;> simp; ring rw [southPlus] @@ -201,8 +199,6 @@ private theorem companion : rw [hcomp] at h simp only [FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub] at h - have hy : Y ≥ 0 := hx0.2.2.1 - have hqnat : (P.q : Int) = (P.q₁ : Int)+(P.q₂ : Int) := qsum omega · rintro ⟨_, he⟩ exact (hn he).elim @@ -236,14 +232,7 @@ theorem P5332T1Parent2Rotation0Values (P A : FordFareyParameter) (hq : 1 < P.q) have qsum : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by exact_mod_cast P.sum_q have rpos : 0 < (P.q₁ : Int) := Parent2Rotation0Proof.rpos P hq hq' have spos : 0 < (P.q₂ : Int) := by exact_mod_cast P.q₂_pos - have rlt : (P.q₁ : Int) < P.q := by exact_mod_cast P.q₁_lt - have slt : (P.q₂ : Int) < P.q := by omega - have hqn : (P.q : Int) ≠ 0 := by omega have hsn : (P.q₂ : Int) ≠ 0 := by omega - have hdet : P.p₂ * (P.q : Int) - (P.q₂ : Int) * P.p = -1 := P.det₂ - have hsumP : P.p = P.p₁ + P.p₂ := P.sum_p - have hcross : P.p₁ * (P.q₂ : Int) - P.p₂ * (P.q₁ : Int) = 1 := by - nlinarith [P.det₁, P.det₂, P.sum_q, P.sum_p] have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ (∀ P x, x ∈ FordDoubledBoundary P.q → FordOdometer P x = _) ∧ _ at laws @@ -290,13 +279,6 @@ theorem P5332T1Parent2Rotation0Values (P A : FordFareyParameter) (hq : 1 < P.q) FordOdometer P ⟨0,v⟩ = 0 := by rw [boundary P 0 v (by omega) (by omega) hv hvq (by omega)] simp [IntegerCeilDiv] - have valRight (v : Int) (hv : 0 ≤ v) (hvq : v ≤ P.q) : - FordOdometer P ⟨(P.q : Int),v⟩ = P.p*v := by - rw [boundary P P.q v (by omega) (by omega) hv hvq (by omega)] - unfold IntegerCeilDiv - rw [show -(P.p*(P.q : Int)*v) = -(P.p*v)*(P.q : Int) by ring, - Int.mul_ediv_cancel _ hqn] - ring have valChildEast (v : Int) (hv : 0 ≤ v) (hvq : v ≤ P.q) : FordOdometer P ⟨1,v⟩ = IntegerCeilDiv (P.p*v) P.q (by exact_mod_cast P.q_pos.ne') := by rw [boundary P 1 v (by omega) (by omega) hv hvq (by omega)] diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean index 8353e559bc..97d41cd327 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation1Values.lean @@ -129,10 +129,6 @@ private theorem southVal : have hsource : (⟨X,Y⟩-⟨0,1⟩ : GaussianInt) = ⟨P.q₁+t,-1⟩ := by rw [southArg, hX, hy] ext <;> simp - have yarg : (⟨X,Y⟩-⟨0,1⟩ : GaussianInt) - - (P5332T1ParentRows P 1 1 0).displacement = ⟨t,P.q₂-1⟩ := by - rw [hsource, hdis] - ext <;> simp [t]; omega have hychild : (⟨t,P.q₂-1⟩ : GaussianInt) ∈ FordVertexDomain A.q := by simp only [FordVertexDomain, Set.mem_ofPred_eq] omega @@ -206,14 +202,11 @@ theorem P5332T1Parent2Rotation1Values (P A : FordFareyParameter) (hq : 1 < P.q) t = 0 ∧ Even (1+1 : Nat)) := by -- BODY classical - have hq' : 1 < (P.q : Int) := by exact_mod_cast hq have hqn : (P.q : Int) ≠ 0 := by omega have hrpos : 0 < P.q₁ := ParentTwoRotationOneProof.hrpos P hq have hspos : 0 < P.q₂ := P.q₂_pos have hsumq : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := by exact_mod_cast P.sum_q - have hpairs : P.p = P.p₁ + P.p₂ := P.sum_p have hdet1 : P.p₁ * (P.q : Int) - (P.q₁ : Int) * P.p = 1 := P.det₁ - have hdet2 : P.p₂ * (P.q : Int) - (P.q₂ : Int) * P.p = -1 := P.det₂ have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ _ at laws have boundaryP (r z : Int) (hr : 0 ≤ r) (hrq : r ≤ P.q) @@ -232,8 +225,6 @@ theorem P5332T1Parent2Rotation1Values (P A : FordFareyParameter) (hq : 1 < P.q) change (0 ≤ r ∧ r ≤ (A.q : Int) ∧ 0 ≤ z ∧ z ≤ (A.q : Int)) ∧ ¬ (2 ≤ r ∧ r ≤ (A.q : Int)-2 ∧ 2 ≤ z ∧ z ≤ (A.q : Int)-2) omega - have hr : 0 < (P.q₁ : Int) := by omega - have hs : 0 < (P.q₂ : Int) := by exact_mod_cast hspos have hqsum : (P.q : Int) = (P.q₁ : Int) + (P.q₂ : Int) := hsumq rcases x with ⟨X,Y⟩ have hxcoord := hx @@ -245,12 +236,10 @@ theorem P5332T1Parent2Rotation1Values (P A : FordFareyParameter) (hq : 1 < P.q) ] at hx' have hAqInt : (A.q : Int) = P.q₂ := by exact_mod_cast hAq have hy : Y = 0 := by omega - have hXlo : (P.q₁ : Int) ≤ X := by omega have hXhi : X ≤ (P.q : Int) := hxcoord.2.1 have htdef : 0 ≤ X-(P.q₁ : Int) ∧ X-(P.q₁ : Int) ≤ P.q₂ := by omega let t : Int := X-(P.q₁ : Int) have ht0 : 0 ≤ t := htdef.1 - have htle : t ≤ P.q₂ := htdef.2 have hX : X = P.q₁ + t := by dsimp [t]; omega have hxrow : (⟨X,Y⟩ : GaussianInt) = (P5332T1ParentRows P 1 1 t).center := by rw [hX, hy] @@ -273,7 +262,6 @@ theorem P5332T1Parent2Rotation1Values (P A : FordFareyParameter) (hq : 1 < P.q) have hrow0 : (P5332T1ParentRows P 1 1 0).linear = ⟨-P.p₂,P.p₁⟩ := by rfl simp only [hrow0] at hxother rw [hX, hy] at hxother - have hpnum : P.p₂ * (P.q : Int) - P.q₂ * P.p = -1 := hdet2 have hcenterP : FordOdometer P ⟨X,Y⟩ = 0 := by rw [hX, hy, boundaryP (P.q₁+t) 0 (by omega) (by omega) (by omega) (by omega) (by omega)] simp [IntegerCeilDiv] @@ -285,11 +273,6 @@ theorem P5332T1Parent2Rotation1Values (P A : FordFareyParameter) (hq : 1 < P.q) rw [hX, hy] at hxcenter linear_combination hxcenter - hxother subst B - have valueChild (u v : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) - (hv : 0 ≤ v) (hvq : v ≤ P.q) - (hb : u ≤ 1 ∨ P.q-1 ≤ u ∨ v ≤ 1 ∨ P.q-1 ≤ v) : - f ⟨u,v⟩ = IntegerCeilDiv (P.p*u*v) P.q hqn := by - exact (hbase ⟨u,v⟩ ⟨hu,huq,hv,hvq⟩).trans (boundaryP u v hu huq hv hvq hb) have centerVal : f ⟨X,Y⟩ = 0 := by rw [hbase _ hx, hcenterP] have eastArg : (⟨X,Y⟩ : GaussianInt)+1 = ⟨X+1,Y⟩ := by ext <;> simp have westArg : (⟨X,Y⟩ : GaussianInt)-1 = ⟨X-1,Y⟩ := by ext <;> simp diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean index 198a97b4f6..2aa66561ce 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation2Values.lean @@ -332,23 +332,16 @@ theorem P5332T1Parent2Rotation2Values (P A : FordFareyParameter) (hq : 1 < P.q) let p : Int := P.p let a : Int := P.p₁ let b : Int := P.p₂ - have hqI : 1 < q := by dsimp [q]; exact_mod_cast hq have hsum : q = r + s := by dsimp [q, r, s] exact_mod_cast P.sum_q - have hpsum : p = a + b := by dsimp [p,a,b]; exact P.sum_p have hr : 0 < r := by have hpos := (P5130T5ParentArithmetic P hq).1 dsimp [r] exact_mod_cast hpos have hs : 0 < s := by dsimp [s]; exact_mod_cast P.q₂_pos - have hrq : r < q := by omega - have hsq : s < q := by omega have hdet₁ : a*q - r*p = 1 := by exact P.det₁ - have hdet₂ : b*q - s*p = -1 := by - change P.p₂ * (P.q : Int) - (P.q₂ : Int) * P.p = -1 - exact P.det₂ have hqn : q ≠ 0 := by omega have hsn : s ≠ 0 := by omega have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation3Values.lean b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation3Values.lean index 443d32e3a6..46811b954e 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation3Values.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1Parent2Rotation3Values.lean @@ -46,7 +46,6 @@ theorem P5332T1Parent2Rotation3Values (P A : FordFareyParameter) (hq : 1 < P.q) t = 0 ∧ Even (3+1 : Nat)) := by -- BODY classical - have hqI : 1 < (P.q : Int) := by exact_mod_cast hq have hqn : (P.q : Int) ≠ 0 := by omega have hrpos : 0 < P.q₁ := by by_contra hn @@ -59,7 +58,6 @@ theorem P5332T1Parent2Rotation3Values (P A : FordFareyParameter) (hq : 1 < P.q) have hspos : 0 < P.q₂ := P.q₂_pos have hsum : (P.q₁ : Int) + (P.q₂ : Int) = (P.q : Int) := by exact_mod_cast P.sum_q.symm - have hq2le : (P.q₂ : Int) ≤ P.q := by omega have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ _ at laws -- The parameter record for the child is P itself; use its principal boundary law. @@ -87,12 +85,10 @@ theorem P5332T1Parent2Rotation3Values (P A : FordFareyParameter) (hq : 1 < P.q) Matrix.head_cons, Matrix.tail_cons, FordVertexDomain, Set.mem_ofPred_eq, Zsqrtd.re_sub, Zsqrtd.im_sub, sub_zero] at hx'0 change 0 ≤ X ∧ X ≤ (A.q : Int) ∧ 0 ≤ Y - P.q ∧ Y - P.q ≤ (A.q : Int) at hx'0 - have hXle : X ≤ (P.q₂ : Int) := by omega have hY : Y = P.q := by omega have htdef : 0 ≤ (P.q₂ : Int) - X := by omega let t : Int := (P.q₂ : Int) - X have ht0 : 0 ≤ t := by dsimp [t]; omega - have htle : t ≤ P.q₂ := by dsimp [t]; omega have hstrict : t < P.q₂ := by have hbad := hstar (⟨2, by omega⟩ : Fin 5) dsimp at hbad diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1RightFirstValues.lean b/LeanPool/ApollonianSuperharmonic/P5332T1RightFirstValues.lean index 6249fc2b18..54c47bf34d 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1RightFirstValues.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1RightFirstValues.lean @@ -49,7 +49,6 @@ theorem P5332T1RightFirstValues (P : FordFareyParameter) (hq : 1 < P.q) 0 < t ∧ t < (P.q₂ : Int)) := by -- BODY classical - have hq' : 1 < (P.q : Int) := by exact_mod_cast hq have hqn : (P.q : Int) ≠ 0 := by omega have hr : 0 < P.q₁ := by by_contra h @@ -57,8 +56,6 @@ theorem P5332T1RightFirstValues (P : FordFareyParameter) (hq : 1 < P.q) have hd := P.det₁ rw [hz] at hd norm_num at hd - have hqpos : 0 < (P.q : Int) := by exact_mod_cast P.q_pos - have hpone : P.p₁ * (P.q : Int) = 1 := hd have hqdiv : (P.q : Int) ∣ 1 := ⟨P.p₁, by nlinarith [mul_comm P.p₁ (P.q : Int)]⟩ have hqle : (P.q : Int) ≤ 1 := Int.le_of_dvd (by norm_num) hqdiv omega diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1RightHorizontalValues.lean b/LeanPool/ApollonianSuperharmonic/P5332T1RightHorizontalValues.lean index fc67a51652..92882bd5b9 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1RightHorizontalValues.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1RightHorizontalValues.lean @@ -49,7 +49,6 @@ theorem P5332T1RightHorizontalValues (P : FordFareyParameter) (hq : 1 < P.q) 0 < t ∧ t < (P.q : Int)) := by -- BODY classical - have hq' : 1 < (P.q : Int) := by exact_mod_cast hq have hqn : (P.q : Int) ≠ 0 := by omega have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ _ at laws diff --git a/LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean b/LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean index 321d27a2a0..d448d9a355 100644 --- a/LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean +++ b/LeanPool/ApollonianSuperharmonic/P5332T1RightSecondValues.lean @@ -84,7 +84,6 @@ private theorem hWest : dsimp [P5332T1RightRows] change 0 ≤ -1 - (-(P.q₂ : Int)) ∧ -1 - (-(P.q₂ : Int)) ≤ P.q ∧ 0 ≤ (0 : Int) - (-(P.q : Int)) ∧ (0 : Int) - (-(P.q : Int)) ≤ P.q - have hq₂nat : 1 ≤ P.q₂ := Nat.succ_le_of_lt P.q₂_pos omega have hw := hother ⟨-1,0⟩ hmem dsimp [P5332T1RightRows] at hw @@ -120,8 +119,6 @@ private theorem hSouth : dsimp [P5332T1RightRows] change 0 ≤ t - (-(P.q₂ : Int)) ∧ t - (-(P.q₂ : Int)) ≤ P.q ∧ 0 ≤ -1 - (-(P.q : Int)) ∧ -1 - (-(P.q : Int)) ≤ P.q - have hq2nat : 1 ≤ P.q₂ := Nat.succ_le_of_lt P.q₂_pos - have hq1nat : 1 ≤ P.q₁ := Nat.succ_le_of_lt (by exact_mod_cast hq₁pos) omega have hsarg : (⟨t,-1⟩ : GaussianInt) - (⟨-(P.q₂ : Int),-(P.q : Int)⟩ : GaussianInt) = ⟨t+P.q₂,P.q-1⟩ := by @@ -247,7 +244,6 @@ theorem P5332T1RightSecondValues (P : FordFareyParameter) (hq : 1 < P.q) 0 < t ∧ t < (P.q₁ : Int)) := by -- BODY classical - have hq' : 1 < (P.q : Int) := by exact_mod_cast hq have hqn : (P.q : Int) ≠ 0 := by omega have laws := (Classical.choose_spec FordOdometerFamilyExistsUnique).1 change (∀ P x, P.q = 1 → FordOdometer P x = _) ∧ _ at laws @@ -288,12 +284,9 @@ theorem P5332T1RightSecondValues (P : FordFareyParameter) (hq : 1 < P.q) let t : Int := X have ht : 0 ≤ t := hX have htr : t ≤ P.q₁ := hXr - have hcenter : x₀ = (P5332T1RightRows P 1 t).center := by - simp [x₀, t, P5332T1RightRows] have hB : B = -P.p * (P.q₂ : Int) := RightSecondValuesProof.hB P hq f B hbase hother bottom top X hsum hx hx' ht subst B - have hq1le : (P.q₁ : Int) ≤ P.q := by omega have hbaseval (u v : Int) (hu : 0 ≤ u) (huq : u ≤ P.q) (hv : 0 ≤ v) (hvq : v ≤ P.q) (hs : u ≤ 1 ∨ P.q - 1 ≤ u ∨ v ≤ 1 ∨ P.q - 1 ≤ v) : @@ -326,7 +319,6 @@ theorem P5332T1RightSecondValues (P : FordFareyParameter) (hq : 1 < P.q) · simpa [P5332T1RightRows, t, IntegerCeilDiv] using hNorth · simpa [P5332T1RightRows, t] using hSouth · have hq1lt : (P.q₁ : Int) < P.q := by exact_mod_cast P.q₁_lt - have hq2nat : 1 ≤ P.q₂ := Nat.succ_le_of_lt P.q₂_pos have dval : (P5332T1RightRows P 1 0).displacement = (⟨-(P.q₂ : Int),-(P.q : Int)⟩ : GaussianInt) := by simp [P5332T1RightRows] diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean b/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean index 8b9b93e66f..fc9a628abe 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2FirstUnit.lean @@ -392,7 +392,6 @@ theorem P5352T2FirstUnit (K : DiamondParameter) (hk : 1 < K.1) -- BODY classical let k : Int := K.1 - have hk2 : 2 ≤ k := by dsimp [k]; omega let C (p q : Int) : Prop := 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean index 31eb6b3504..a2945f0cb1 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean @@ -123,8 +123,6 @@ private theorem boundaryCase : classical intro K hk f k r child hchild p q hz hdpred hcast hdchild hp1 hq childMem hqp subst q - have hplt : p < k := by omega - have hpadd : p+1 ≤ k := Int.lt_iff_add_one_le.mp hplt have hEb : 0 ≤ p ∧ p ≤ 2*k ∧ -k ≤ p+1 ∧ p+1 ≤ k ∧ -p-1 ≤ p+1 ∧ p+1 ≤ p+1 ∧ -(2*k-p+1) ≤ p+1 ∧ p+1 ≤ 2*k-p+1 := by omega @@ -874,7 +872,6 @@ theorem P5352T2Predecessor0 (K : DiamondParameter) (hk : 1 < K.1) have productGap (a b : Int) : (b-1)*(a-2)-(b-1)*(a-1)=-(b-1) := by ring have lapZeroAlgebra (a : Int) : (a-1)+(1-a)=0 := by ring have lapOneAlgebra (a : Int) : a+(1-a)=1 := by ring - have endAlgebra (b : Int) := FirstPredecessorCases.endAlgebra b have endAlgebraB (b c : Int) := FirstPredecessorCases.endAlgebraB b c let k : Int := K.1 let d : GaussianInt := ⟨k, 1-k⟩ @@ -894,7 +891,6 @@ theorem P5352T2Predecessor0 (K : DiamondParameter) (hk : 1 < K.1) (z - M.2.2 ∈ FootprintVertices child.1 → FourNeighborLaplacian f z = 0) ∧ (z - M.2.2 ∉ FootprintVertices child.1 → FourNeighborLaplacian f z = 1) intro hchild hpred hz hpz hcover - have hkI : 2 ≤ k := by dsimp [k]; exact_mod_cast (show 2 ≤ K.1 by omega) have hm : M.1 = d ∧ M.2.1 = ⟨0,k-1⟩ ∧ M.2.2 = r := by simp [M, d, r, P5352T2PlacementData, k] rcases hm with ⟨hdisp, hcoeff, hr⟩ @@ -966,7 +962,6 @@ theorem P5352T2Predecessor0 (K : DiamondParameter) (hk : 1 < K.1) have hPe := FirstPredecessorCases.hPe K hk p q hcast hp1 hpk predFoot hq have hPs := FirstPredecessorCases.hPs K hk p q hcast hp1 hpk predFoot hq let val0 : Int := Q p (p-1) - let valW : Int := Q (p-1) (p-1) let valN : Int := Q p p have hC0 : f zA = val0 := childValue zA hzA have hCW := FirstPredecessorCases.hCW K f p childValue hW @@ -981,8 +976,6 @@ theorem P5352T2Predecessor0 (K : DiamondParameter) (hk : 1 < K.1) have qCW := FirstPredecessorCases.qCW p q hp1 hq have qCN : valN = p*(p-1)/2 := by simp [valN, Q, abs_of_nonneg (show 0 ≤ p by omega)] - have qCS : Q p (p-2) = p*(p-1)/2-1 := by - simp [Q, abs_of_nonneg (show 0 ≤ p by omega)] have floorEven (m : Int) := FirstPredecessorCases.floorEven m have floorOdd (m : Int) := FirstPredecessorCases.floorOdd m have qP0 := FirstPredecessorCases.qP0 K p q hpk hq floorEven diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean index bb5b5d90e9..fbea0705a4 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor1.lean @@ -636,7 +636,6 @@ private theorem hcompAt434 (K : DiamondParameter) (hk : 1 < K.1) (p : Int) (upper : p ≤ (K.1 : Int)) : (⟨p, 2 * (K.1 : Int) + 1 - p⟩ : GaussianInt) - ⟨2 * (K.1 : Int), 0⟩ ∈ FootprintVertices (DiamondTile K.1) ↔ p = (K.1 : Int) := by - have positive : 2 ≤ (K.1 : Int) := by exact_mod_cast (show 2 ≤ K.1 by omega) rw [(P5352T2DomainRows K _).1] simp only [Zsqrtd.im_sub, Zsqrtd.re_sub, sub_zero] constructor diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean index 6e680d9c4b..b657be7204 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor2.lean @@ -210,7 +210,6 @@ private theorem ht : ℤ)) → (1≤-a ∧ -a≤k ∧ (b=2*k+1+a ∨ b=2*k+a)))) ) := by classical intro K k a b hdpred hcast hdchild - have h : -k≤a ∧ a≤-1 ∧ (b-a=2*k+1 ∨ b-a=2*k) := by omega omega private theorem hcompAt243 : @@ -417,7 +416,6 @@ private theorem hPW : (k-t)+(-t-1)-k*(2*k+1-t)+B)) ) := by classical intro K f B k d a Q predTranslatedValue t zA hpw - have he : (zA-1)-d=(⟨k-t-1,k-t⟩:GaussianInt) := by ext <;> simp [zA,d] <;> ring have hv := predTranslatedValue (zA-1) hpw convert hv using 1; simp [zA,d]; ring @@ -439,7 +437,6 @@ private theorem hPN : (k+1-t)+(-t)-k*(2*k+2-t)+B)) ) := by classical intro K f B k d a Q predTranslatedValue t zA hpn - have he : (zA+⟨0,1⟩)-d=(⟨k-t,k+1-t⟩:GaussianInt) := by ext <;> simp [zA,d] <;> ring have hv := predTranslatedValue (zA+⟨0,1⟩) hpn convert hv using 1; simp [zA,d]; ring @@ -883,7 +880,6 @@ theorem P5352T2Predecessor2 (K : DiamondParameter) (hk : 1 < K.1) let child := P5352T2Sources K hk 0 let pred := P5352T2Sources K hk 3 let M := (P5352T2PlacementData K.1 2).2 2 - have hkI : 2 ≤ k := by dsimp [k]; exact_mod_cast (show 2 ≤ K.1 by omega) have hm : M.1=d ∧ M.2.1=⟨1,-k⟩ ∧ M.2.2=r := by simp [M,d,r,P5352T2PlacementData,k] rcases hm with ⟨hdisp,hcoeff,hr⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean index c5ec146fcf..30cc027c58 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean @@ -636,7 +636,6 @@ private theorem hWestDiff : have htd : (k-t)*(k-t-1)/2-(k-t-1)*(k-t-2)/2=k-t-1 := by simpa [show k-t-1-1=k-t-2 by ring] using tdiff (k-t) have htd' : (k-t-1)*(k-t-2)/2-(k-t)*(k-t-1)/2=1-(k-t) := by - have h := htd omega linear_combination htd' @@ -841,7 +840,6 @@ theorem P5352T2Predecessor3 (K : DiamondParameter) (hk : 1 < K.1) let r : GaussianInt := ⟨-2*k, 0⟩ let Q : Int → Int → Int := fun a b => (Int.natAbs a : Int) * ((Int.natAbs a : Int)-1)/2 - (a-b)^2/4 - have hk2 : 2 ≤ k := by dsimp [k]; exact_mod_cast (show 2 ≤ K.1 by omega) have hm : M.1 = d ∧ M.2.1 = ⟨1-k,-1⟩ ∧ M.2.2 = r := by simp [M, d, r, P5352T2PlacementData, k] rcases hm with ⟨hd, ha, hr⟩ @@ -874,7 +872,6 @@ theorem P5352T2Predecessor3 (K : DiamondParameter) (hk : 1 < K.1) (h : 0 ≤ b ∧ b ≤ 2*(k-1) ∧ -(k-1) ≤ a ∧ a ≤ k-1 ∧ -b-1 ≤ a ∧ a ≤ b+1 ∧ -(2*(k-1)-b+1) ≤ a ∧ a ≤ 2*(k-1)-b+1) := FourthPredecessorCases.predMem K hk hkm a b h - let Kp : DiamondParameter := ⟨K.1-1, by omega⟩ have childValue (w : GaussianInt) (hw : w ∈ FootprintVertices (DiamondTile K.1)) : f w = Q w.re w.im := FourthPredecessorCases.childValue K hk f hchild hchildTile hchildSrc @@ -980,7 +977,6 @@ theorem P5352T2Predecessor3 (K : DiamondParameter) (hk : 1 < K.1) have hn : x+⟨0,1⟩ = (⟨-u,u+1⟩ : GaussianInt) := by ext <;> simp [x] have hs : x-⟨0,1⟩ = (⟨-u,u-1⟩ : GaussianInt) := by ext <;> simp [x] have hLap := FourthPredecessorCases.hLap K f u h0 h1 h2 h3 h4 he hw hn hs - have huK := FourthPredecessorCases.huK K u huk have hFalse : x ∈ DiamondVertexDomains K false := by exact hFoot ▸ hX have habsA := FourthPredecessorCases.habsA u hu1 diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2RightFirst.lean b/LeanPool/ApollonianSuperharmonic/P5352T2RightFirst.lean index 9fcbd15cf9..886368643e 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2RightFirst.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2RightFirst.lean @@ -580,7 +580,6 @@ theorem P5352T2RightFirst (K : DiamondParameter) (hk : 1 < K.1) intro hC hR hz hzR hstar let k : Int := K.1 let rho : GaussianInt := ⟨-k, k+1⟩ - have hkI : 2 ≤ k := by dsimp [k]; exact_mod_cast hk change (∀ y, y ∈ FootprintVertices (DiamondTile K.1) → f y = DiamondOdometer K y) at hC change (∀ y, y-rho ∈ FootprintVertices (DiamondTile K.1) → @@ -609,7 +608,6 @@ theorem P5352T2RightFirst (K : DiamondParameter) (hk : 1 < K.1) have contact := DiamondRightFirst.contact K z hz hzR foot let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 - let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 have tri (a : Int) := DiamondQuadraticArithmetic.triangularScale a have square (a : Int) := DiamondQuadraticArithmetic.squareScale a -- Scaling removes both divisions, including for negative odd arguments. diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean b/LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean index a7cccd7dd3..7d2644fbe6 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2RightHorizontal.lean @@ -72,7 +72,6 @@ private theorem hzr : classical intro K z n M hzB hzMB have hlow := hzMB.2.2.1 - have hhigh := hzB.2.2.2.1 dsimp [M] at hlow omega @@ -103,11 +102,6 @@ private theorem hzi : rcases hzMB with ⟨_, _, _, _, _, _, hbound, _⟩ have him : (z-M).im = z.im := by simp [M] have hre : (z-M).re = z.re-2*n := by simp [M] - have hreM : (z-M).re = -n := by rw [hre, hzr]; omega - have hlower : n-1 ≤ z.im := by rw [← hzr]; omega - have hupper : z.im ≤ n+1 := by - rw [him, hreM] at hbound - omega have hnotlow : z.im ≠ n-1 := by intro heq have hsouth := hstar (z-⟨0,1⟩) (Or.inr (Or.inr (Or.inr (Or.inr rfl))) : @@ -497,7 +491,6 @@ theorem P5352T2RightHorizontal (K : DiamondParameter) (hk : 1 < K.1) dsimp only intro hC hR hz hzM hstar let n : Int := K.1 - have hn : 2 ≤ n := by dsimp [n]; exact_mod_cast hk let M : GaussianInt := ⟨2*n, 0⟩ let Q (x : GaussianInt) : Int := (Int.natAbs x.re : Int) * ((Int.natAbs x.re : Int)-1)/2 - @@ -537,8 +530,6 @@ theorem P5352T2RightHorizontal (K : DiamondParameter) (hk : 1 < K.1) rw [hNc]; exact foot n (n+1) (by constructor <;> omega) have hsouth : z-⟨0,1⟩ ∈ FootprintVertices (DiamondTile K.1) := by rw [hSc]; exact foot n (n-1) (by constructor <;> omega) - have hchildCenter : z-M ∈ FootprintVertices (DiamondTile K.1) := by - simpa [hA, hM] using hzM have hchildEast := DiamondRightHorizontal.hchildEast K hk z hzr foot hEc have hparent (w : GaussianInt) (hw : w ∈ FootprintVertices (DiamondTile K.1)) : f w = Q w := DiamondRightHorizontal.hparent K hk f hC w hw diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean b/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean index 3f6eefb81b..84b6509978 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2RightSecond.lean @@ -586,7 +586,6 @@ theorem P5352T2RightSecond (K : DiamondParameter) (hk : 1 < K.1) intro hC hR hz hzR hstar let k : Int := K.1 let rho : GaussianInt := ⟨-k, -k-1⟩ - have hkI : 2 ≤ k := by dsimp [k]; exact_mod_cast hk change (∀ y, y ∈ FootprintVertices (DiamondTile K.1) → f y = DiamondOdometer K y) at hC change (∀ y, y-rho ∈ FootprintVertices (DiamondTile K.1) → @@ -636,7 +635,6 @@ theorem P5352T2RightSecond (K : DiamondParameter) (hk : 1 < K.1) ht0 htk let Q (a b : Int) : Int := (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 - let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 have tri (a : Int) := DiamondQuadraticArithmetic.triangularScale a have square (a : Int) := DiamondQuadraticArithmetic.squareScale a have scale (a b : Int) := DiamondQuadraticArithmetic.quadraticScale tri square a b diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2SourceCertificates.lean b/LeanPool/ApollonianSuperharmonic/P5352T2SourceCertificates.lean index 5ea8bce1f1..e0cfd4cfd4 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2SourceCertificates.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2SourceCertificates.lean @@ -83,7 +83,6 @@ theorem P5352T2SourceCertificates (K : DiamondParameter) (hk : 1 < K.1) · change 0 < (2 * ((K.1 - 1 : Nat) : Int) * (K.1 : Int)) have hsub : 0 < K.1 - 1 := by omega have hki : 0 < (K.1 : Int) := by omega - have hsi : 0 < ((K.1 - 1 : Nat) : Int) := by exact_mod_cast hsub positivity · simpa [P5352T2Sources, Nat.cast_sub (by omega : 1 ≤ K.1)] using P4194T1DiamondCentroid (K.1 - 1) (by omega) diff --git a/LeanPool/ApollonianSuperharmonic/P5416T1SecondUnitGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5416T1SecondUnitGeometry.lean index 133298321f..6680c01bef 100644 --- a/LeanPool/ApollonianSuperharmonic/P5416T1SecondUnitGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P5416T1SecondUnitGeometry.lean @@ -40,7 +40,6 @@ theorem P5416T1SecondUnitGeometry (K : DiamondParameter) (hk : 1 < K.1) -- BODY classical let k : Int := K.1 - have hk2 : 2 ≤ k := by dsimp [k]; omega let C (p q : Int) : Prop := 0 ≤ q ∧ q ≤ 2*k ∧ -k ≤ p ∧ p ≤ k ∧ -q-1 ≤ p ∧ p ≤ q+1 ∧ -(2*k-q+1) ≤ p ∧ p ≤ 2*k-q+1 diff --git a/LeanPool/ApollonianSuperharmonic/P5442T1LaplacianBound.lean b/LeanPool/ApollonianSuperharmonic/P5442T1LaplacianBound.lean index 812ef27880..93a647763e 100644 --- a/LeanPool/ApollonianSuperharmonic/P5442T1LaplacianBound.lean +++ b/LeanPool/ApollonianSuperharmonic/P5442T1LaplacianBound.lean @@ -72,7 +72,6 @@ theorem P5442T1LaplacianBound (P : FordFareyParameter) : · have hab : P.q₁ = 1 ∧ P.q₂ = 1 := by have hs := P.sum_q have ht := P.q₁_lt - have hpos := P.q₂_pos have hd := P.det₁ rw [h2] at hs ht hd by_cases hz : P.q₁ = 0 diff --git a/LeanPool/ApollonianSuperharmonic/P5442T1WebGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5442T1WebGeometry.lean index c0c6a4763f..35d22e5892 100644 --- a/LeanPool/ApollonianSuperharmonic/P5442T1WebGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P5442T1WebGeometry.lean @@ -212,7 +212,6 @@ private theorem bridge : refine ⟨0, n, (boundary _).mpr ?_⟩ rw [horizVec] dsimp [t] - have hj' : (j : Int) ≤ P.q := by exact_mod_cast hj omega) convert hh using 1 ext <;> simp; ring @@ -297,7 +296,6 @@ private theorem reach0 : refine ⟨m, n, (boundary _).mpr ?_⟩ rw [horizVec] dsimp [t] at hb ⊢ - have hj' : (j : Int) ≤ k := by exact_mod_cast hj rcases hb with hb | hb <;> omega) have he : (⟨n*(P.q : Int), x.im⟩ : GaussianInt) + k • 1 = x := by ext <;> simp [hk] diff --git a/LeanPool/ApollonianSuperharmonic/P5448T1CenteredFordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P5448T1CenteredFordGeometry.lean index 0d207105ef..0a8ff77897 100644 --- a/LeanPool/ApollonianSuperharmonic/P5448T1CenteredFordGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P5448T1CenteredFordGeometry.lean @@ -89,12 +89,6 @@ theorem P5448T1CenteredFordGeometry let c := BandPackingSymmetryVectorAction s x let H := PartialOdometerAffineTranslate (BandPackingSymmetryPartialOdometerAction s h) (-c) 0 0 - let U := TileTranslation (BandPackingSymmetryTileAction s (P 0 (!delta))) (-c) - let V := TileTranslation (BandPackingSymmetryTileAction s (P 0 delta)) (-c) - let hp := PartialOdometerAffineTranslate - (BandPackingSymmetryPartialOdometerAction s (r 0 (!delta))) (-c) 0 0 - let hm := PartialOdometerAffineTranslate - (BandPackingSymmetryPartialOdometerAction s (r 0 delta)) (-c) 0 0 obtain ⟨g', hext', hlap'⟩ := BandPackingSymmetryGlobalOdometerTransport s g h x hext let f : IntegerLatticeFunction := fun z => g' (z + c) diff --git a/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean index cb20179a5f..00ae0232af 100644 --- a/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean +++ b/LeanPool/ApollonianSuperharmonic/P5455T2OccurrenceDeterministic.lean @@ -172,7 +172,6 @@ private theorem main : j = (j - r) + r := by simp _ = (j' - r') + r' := by rw [← hia, ← hib, hr] _ = j' := sub_add_cancel j' r' - have hrEq := hr rcases rowA with ⟨hj, ho⟩ | ⟨hj, ho⟩ <;> rcases rowB with ⟨hj', ho'⟩ | ⟨hj', ho'⟩ <;> simp_all · rcases rootB with ⟨z', htb, rowB⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1FordNormalization.lean b/LeanPool/ApollonianSuperharmonic/P5472T1FordNormalization.lean index fcb0035e83..5591692ce6 100644 --- a/LeanPool/ApollonianSuperharmonic/P5472T1FordNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P5472T1FordNormalization.lean @@ -411,10 +411,6 @@ theorem P5472T1FordNormalization have hridx := FordNormalizationProof.hridx q cfg hzero hcurv ridx hline subst ridx have hford' := FordNormalizationProof.hford' q cfg s F hford - let succ (a : Fin 4 → CircleCoordinates) : Fin 4 → CircleCoordinates := - ![(2 * (a 0).1 + 2 * (a 2).1 + 2 * (a 3).1 - (a 1).1, - 2 * (a 0).2 + 2 * (a 2).2 + 2 * (a 3).2 - (a 1).2), - a 0, a 2, a 3] have hqSucc := FordNormalizationProof.hqSucc q cfg have hsuccCov := FordNormalizationProof.hsuccCov q cfg s hword have hF0 : BandPackingSymmetryCircleAction s (t 0) = diff --git a/LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean b/LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean index fb49155d7f..de75964ba2 100644 --- a/LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean +++ b/LeanPool/ApollonianSuperharmonic/P5472T1FordSlopeDifference.lean @@ -72,7 +72,6 @@ theorem P5472T1FordSlopeDifference simp only [Fin.isValue, FordCircleCoordinate, Nat.cast_mul, Int.reduceNeg] at hh have : 0 < F.q * F.q := Nat.mul_pos F.q_pos F.q_pos omega - let I : GaussianInt := ⟨0, 1⟩ let Wsource : GaussianInt := BandVectors.1 (q 3) (q 2) let Asource : GaussianInt := BandVectors.2 (q 3) (q 2) have hrawSlope (b : Bool) : diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean index 4c169b99f2..29613ac243 100644 --- a/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5491T1DiamondRightBoundary.lean @@ -627,19 +627,11 @@ theorem P5491T1DiamondRightBoundary (K : DiamondParameter) (hk : 1 < K.1) -- BODY dsimp only let n : Int := K.1 - have hn : 2 ≤ n := by dsimp [n]; exact_mod_cast hk - have hA : (P5352T2Sources K hk 0).1 = DiamondTile K.1 := by - simp [P5352T2Sources] have hF (z : GaussianInt) (hz : z ∈ FootprintVertices (DiamondTile K.1)) := DiamondBoundaryDetails.hF K hk z hz have hfloorEven (m : Int) := DiamondBoundaryDetails.hfloorEven m have hfloorOdd (m : Int) := DiamondBoundaryDetails.hfloorOdd m - let Q (a b : Int) : Int := - (Int.natAbs a : Int)*((Int.natAbs a : Int)-1)/2-(a-b)^2/4 - let S (a b : Int) : Int := 2*a^2-2*|a|-(a-b)^2+(a-b)%2 have tri (a : Int) : 2*(a*(a-1)/2) = a*(a-1) := DiamondRightBoundaryProof.tri a - have square (a : Int) : 4*(a^2/4) = a^2-a%2 := DiamondQuadraticArithmetic.squareScale a - have scale (a b : Int) := DiamondQuadraticArithmetic.quadraticScale tri square a b have foot (z : GaussianInt) := DiamondBoundaryDetails.foot K z have hpositive : ∀ (i : Fin 3) (x : GaussianInt), x ∈ FootprintVertices (DiamondTile K.1) → diff --git a/LeanPool/ApollonianSuperharmonic/P5491T1FordParentBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5491T1FordParentBoundary.lean index fc72f88e4a..28b96be8e8 100644 --- a/LeanPool/ApollonianSuperharmonic/P5491T1FordParentBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5491T1FordParentBoundary.lean @@ -33,7 +33,6 @@ theorem P5491T1FordParentBoundary : R.linear.im*x.im - FordOdometer P x = b))) := by intro P A hq j s hp hd -- BODY - have hnP : (P.q : ℤ) ≠ 0 := by exact_mod_cast P.q_pos.ne' have boundary (N : FordFareyParameter) (x y : ℤ) (hx : 0 ≤ x) (hxq : x ≤ N.q) (hy : 0 ≤ y) (hyq : y ≤ N.q) (hb : x = 0 ∨ x = N.q ∨ y = 0 ∨ y = N.q) : diff --git a/LeanPool/ApollonianSuperharmonic/P5532T1SymmetryOrientationTransport.lean b/LeanPool/ApollonianSuperharmonic/P5532T1SymmetryOrientationTransport.lean index c43f636895..d262d0c0a9 100644 --- a/LeanPool/ApollonianSuperharmonic/P5532T1SymmetryOrientationTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/P5532T1SymmetryOrientationTransport.lean @@ -133,7 +133,6 @@ theorem P5532T1SymmetryOrientationTransport obtain ⟨y, hy, hyx⟩ := hb exact hnb ((grid s).1.1 hyx ▸ hy) let e : GaussianInt ≃ GaussianInt := Equiv.ofBijective L (grid s).1 - have heL : ∀ x, e x = L x := fun _ => rfl have hD : D = E.image e.symm := by rw [hE, Finset.image_image] have hf : e.symm ∘ L = id := by diff --git a/LeanPool/ApollonianSuperharmonic/P5537T1UnitParentBoundary.lean b/LeanPool/ApollonianSuperharmonic/P5537T1UnitParentBoundary.lean index 14f3a03f07..f7ff4c0952 100644 --- a/LeanPool/ApollonianSuperharmonic/P5537T1UnitParentBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5537T1UnitParentBoundary.lean @@ -35,7 +35,6 @@ theorem P5537T1UnitParentBoundary (K : DiamondParameter) (hk : 1 < K.1) : D.2.1 (x-M.1) + M.2.1.re*x.re + M.2.1.im*x.im - A.2.1 x = b := by -- BODY dsimp only - have hn : 2 ≤ (K.1 : Int) := by exact_mod_cast hk have unitMem (z : GaussianInt) : z ∈ FootprintVertices (⟨{0},0⟩ : ProtoTile) ↔ 0 ≤ z.re ∧ z.re ≤ 1 ∧ 0 ≤ z.im ∧ z.im ≤ 1 := by diff --git a/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean index 16becec209..9a18605643 100644 --- a/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean @@ -911,7 +911,6 @@ theorem P5630T1MarkedRightOdometerAdjacencyReduction : else BandVectors.1 (q i.succ) (q 0)))))) := by -- BODY intro C T T₀ h h₀ x horbit hadj hx hx₀ hstar - have inversePhase := BandPackingSymmetryInversePhaseCancellation have markedData := BandPackingSymmetryMarkedDataCovariance obtain ⟨bundle, rightPlacement, hrightPlacement⟩ := BandOrderedGeneralRightNormalizedBundleExists @@ -926,9 +925,6 @@ theorem P5630T1MarkedRightOdometerAdjacencyReduction : rightPlacement.exterior_routed_cell rightPlacement.central_routed_cell rightPlacement.selected_star obtain ⟨row⟩ := selectedRow - have rightGeometry := BandOrderedGeneralRightSelectedRowGeometry - C C T T₀ h h₀ x bundle rightPlacement selectedEdge - hxSelectedEdge hselectedEdge row have selectedAdjacency := BandOrderedGeneralRightSelectedAdjacency C C T T₀ h h₀ x bundle rightPlacement selectedEdge hxSelectedEdge hselectedEdge row @@ -1026,11 +1022,6 @@ theorem P5630T1MarkedRightOdometerAdjacencyReduction : ginv hnorm actionCurvature hinverseProper hinversePositive hinverseCircle have hcoverOriginal := MarkedRightAdjacencyGeometry.hcoverOriginal C T T₀ h h₀ x markedData bundle (MarkedRightAdjacencyGeometry.coverShape) - let oldRight := TileTranslation bundle.normalizedFixed - ((if rightPlacement.rightNeighborPositive = true then (-1 : GaussianInt) - else 1) * - BandVectors.1 (bundle.normalizedPresentation 0) - (bundle.normalizedPresentation bundle.selectedSlot.succ)) have hcompanionCov := markedData.2.2 ginv bundle.normalizedPresentation hq bundle.selectedSlot s delta hphaseInv bundle.normalizedFixed diff --git a/LeanPool/ApollonianSuperharmonic/P5630T1SymmetricMatrixPositivityCriterion.lean b/LeanPool/ApollonianSuperharmonic/P5630T1SymmetricMatrixPositivityCriterion.lean index c88bee0cab..f023cf39cb 100644 --- a/LeanPool/ApollonianSuperharmonic/P5630T1SymmetricMatrixPositivityCriterion.lean +++ b/LeanPool/ApollonianSuperharmonic/P5630T1SymmetricMatrixPositivityCriterion.lean @@ -66,7 +66,6 @@ theorem P5630T1SymmetricMatrixPositivityCriterion (s u v : Real) : have hprod : 0 ≤ s * v ^ 2 := mul_nonneg hs0 (sq_nonneg v) rcases eq_zero_or_eq_zero_of_mul_eq_zero hsprod with hs | hv · have hp' : 0 ≤ v := by nlinarith [hp] - have hm' : v ≤ 0 := by nlinarith [hm] linarith · exact (sq_eq_zero_iff.mp hv) rw [hv0] diff --git a/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean b/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean index a5b16aff2f..466db06960 100644 --- a/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean +++ b/LeanPool/ApollonianSuperharmonic/P5635T1EndpointDiagonalOwnership.lean @@ -1620,8 +1620,6 @@ theorem P5635T1EndpointDiagonalOwnership {ι : Type} -- BODY classical have triple_label_pattern := EndpointDiagonalGeometry.triple_label_pattern - let neighbor (x : GaussianInt) : Fin 4 → GaussianInt := - ![x + ⟨0, 1⟩, x - 1, x - ⟨0, 1⟩, x + 1] let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := ![{x, x + ⟨0, 1⟩}, {x - 1, x}, {x - ⟨0, 1⟩, x}, {x, x + 1}] @@ -1708,8 +1706,6 @@ theorem P5635T1EndpointDiagonalOwnership {ι : Type} have hownerAligned := EndpointDiagonalGeometry.hownerAligned ι P owner owner_mem_iff T0 T0' U V hdis ia ib hUidx hVidx hUsub hVsub x label_T0 label_T0' jAB htransABx hownerAB have hlabelsAB := EndpointDiagonalGeometry.hlabelsAB T0 T0' x label_T0 label_T0' jAB htransABx - let o0 := owner (LatticeVertexIncidentCell x jAB) - let o1 := owner (LatticeVertexIncidentCell x (jAB + 1)) let o2 := owner (LatticeVertexIncidentCell x (jAB + 2)) let o3 := owner (LatticeVertexIncidentCell x (jAB + 3)) have hownerAligned' := EndpointDiagonalGeometry.hownerAligned' ι owner T0 T0' ia ib x jAB diff --git a/LeanPool/ApollonianSuperharmonic/P5635T1RightBoundaryInterfaceRecords.lean b/LeanPool/ApollonianSuperharmonic/P5635T1RightBoundaryInterfaceRecords.lean index f140358f74..c19a0ab05a 100644 --- a/LeanPool/ApollonianSuperharmonic/P5635T1RightBoundaryInterfaceRecords.lean +++ b/LeanPool/ApollonianSuperharmonic/P5635T1RightBoundaryInterfaceRecords.lean @@ -1013,8 +1013,6 @@ theorem P5635T1RightBoundaryInterfaceRecords let j := placement.rightSecondSlot let directionSlot := placement.rightDirectionSlot obtain ⟨hsum, hi, hj, hk⟩ := cyclicVectorRecurrence i j directionSlot hcyc - let a := BandVectors.1 (q directionSlot.succ) (q j.succ) - let b := BandVectors.1 (q i.succ) (q directionSlot.succ) let c := BandVectors.1 (q j.succ) (q i.succ) have aux := auxiliaryDisplacements i j directionSlot hcyc have hJprev := RightBoundaryRecordsGeometry.hJprev C D T N h k x bundle placement hcyc diff --git a/LeanPool/ApollonianSuperharmonic/P5667T1CyclicChildrenOldArcsPreconnected.lean b/LeanPool/ApollonianSuperharmonic/P5667T1CyclicChildrenOldArcsPreconnected.lean index 70d86b48b4..d344a1053b 100644 --- a/LeanPool/ApollonianSuperharmonic/P5667T1CyclicChildrenOldArcsPreconnected.lean +++ b/LeanPool/ApollonianSuperharmonic/P5667T1CyclicChildrenOldArcsPreconnected.lean @@ -202,14 +202,6 @@ theorem P5667T1CyclicChildrenOldArcsPreconnected {n : Nat} (p : P3381T1PolygonBo let e := segment Real (p.vertex a) (p.vertex b) let CL := P3544T1BoundaryCarrier C.left let CR := P3544T1BoundaryCarrier C.right - have chainUnionPreconnected {X : Type} [TopologicalSpace X] {m : Nat} - (S : Fin (m + 1) → Set X) (hpre : ∀ i, IsPreconnected (S i)) - (hadj : ∀ i : Fin m, (S i.castSucc ∩ S i.succ).Nonempty) : - IsPreconnected (⋃ i, S i) := OldArcs.chainUnionPreconnected (X := X) (m := m) S hpre hadj - have segmentSdiffPreconnected (a b : Real × Real) - (z : Set (Real × Real)) - (hdisj : Disjoint (openSegment Real a b) z) : - IsPreconnected (segment Real a b \ z) := OldArcs.segmentSdiffPreconnected a b z hdisj have polygonOldArcPreconnected {m : Nat} (q : P3381T1PolygonBoundary m) : IsPreconnected (P3544T1BoundaryCarrier q \ segment Real (q.vertex 0) (q.vertex (Fin.last (m + 2)))) := diff --git a/LeanPool/ApollonianSuperharmonic/P5667T1RoundedSupportingSlope.lean b/LeanPool/ApollonianSuperharmonic/P5667T1RoundedSupportingSlope.lean index 725de40493..0c2e3ad2bb 100644 --- a/LeanPool/ApollonianSuperharmonic/P5667T1RoundedSupportingSlope.lean +++ b/LeanPool/ApollonianSuperharmonic/P5667T1RoundedSupportingSlope.lean @@ -114,10 +114,6 @@ theorem P5667T1RoundedSupportingSlope (1 / 2 : Real) * (abs x.im + abs y.im) := by nlinarith [this] simpa [ax] using h1a - have hxa : (0 : Real) ≤ (abs x.re + abs x.im : Int) := by - exact_mod_cast (add_nonneg (abs_nonneg x.re) (abs_nonneg x.im)) - have hya : (0 : Real) ≤ (abs y.re + abs y.im : Int) := by - exact_mod_cast (add_nonneg (abs_nonneg y.re) (abs_nonneg y.im)) have herr : -( |((p.re : Real) - (Matrix.mulVec A vx) 0) * ((x.re : Real) - y.re)| + |((p.im : Real) - (Matrix.mulVec A vx) 1) * ((x.im : Real) - y.im)|) ≤ diff --git a/LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean b/LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean index e7c411a3e0..a2b42cdbc3 100644 --- a/LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean +++ b/LeanPool/ApollonianSuperharmonic/P5667T1StraightFrontierLocalSides.lean @@ -75,7 +75,6 @@ private theorem hDleft : ) := by classical intro x B r n d D ray E hcol hleftball hleftnotray q hq hzero - have hqball := hleftball q hq have hy : d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) = 0 := by simpa [D] using hzero obtain ⟨c, hc⟩ := hcol (q - x) (by simpa using hy) @@ -112,7 +111,6 @@ private theorem hDright : ) := by classical intro x B r n d D ray E hcol hrightball hrightnotray q hq hzero - have hqball := hrightball q hq have hy : d.1 * (q.2 - x.2) - d.2 * (q.1 - x.1) = 0 := by simpa [D] using hzero obtain ⟨c, hc⟩ := hcol (q - x) (by simpa using hy) diff --git a/LeanPool/ApollonianSuperharmonic/P5691T1DiamondReflectionFootprints.lean b/LeanPool/ApollonianSuperharmonic/P5691T1DiamondReflectionFootprints.lean index 05034a5cdb..e06a6f67be 100644 --- a/LeanPool/ApollonianSuperharmonic/P5691T1DiamondReflectionFootprints.lean +++ b/LeanPool/ApollonianSuperharmonic/P5691T1DiamondReflectionFootprints.lean @@ -307,40 +307,6 @@ theorem P5691T1DiamondReflectionFootprints classical let J : GaussianInt → GaussianInt := fun z => GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) - have diamondCellsNonempty (m : Nat) (hm : 0 < m) : - (DiamondTile m).cells.Nonempty := - DiamondReflectionFootprintConstruction.diamondCellsNonempty m hm - have sameCellObs (T T' : ProtoTile) (hc : T.cells = T'.cells) - (hne : T.cells.Nonempty) : - FootprintVertices T = FootprintVertices T' ∧ - FootprintEdges T = FootprintEdges T' := - DiamondReflectionFootprintConstruction.sameCellObs T T' hc hne - have centeredCellEq (m : Nat) : - (TileTranslation (TileReflection (DiamondTile m)) - ⟨0, 2 * (m : Int)⟩).cells = (DiamondTile m).cells := - DiamondReflectionFootprintConstruction.centeredCellEq m - have centeredVertices (m : Nat) (hm : 0 < m) : - GaussianTranslation ⟨0, 2 * (m : Int)⟩ '' - FootprintVertices (TileReflection (DiamondTile m)) = - FootprintVertices (DiamondTile m) := - DiamondReflectionFootprintConstruction.centeredVertices m hm - have centeredEdges (m : Nat) (hm : 0 < m) : - (fun e : Finset GaussianInt => - e.image (GaussianTranslation ⟨0, 2 * (m : Int)⟩)) '' - FootprintEdges (TileReflection (DiamondTile m)) = - FootprintEdges (DiamondTile m) := DiamondReflectionFootprintConstruction.centeredEdges - m hm - have rhoVertexImage (m : Nat) (hm : 0 < m) : - (fun z => GaussianTranslation ⟨0, 2 * (m : Int)⟩ - (GaussianReflection z)) '' - FootprintVertices (DiamondTile m) = FootprintVertices (DiamondTile m) := - DiamondReflectionFootprintConstruction.rhoVertexImage m hm - have rhoEdgeImage (m : Nat) (hm : 0 < m) : - (fun e : Finset GaussianInt => - e.image (fun z => GaussianTranslation ⟨0, 2 * (m : Int)⟩ - (GaussianReflection z))) '' - FootprintEdges (DiamondTile m) = FootprintEdges (DiamondTile m) := - DiamondReflectionFootprintConstruction.rhoEdgeImage m hm have JtranslatedVertices (m : Nat) (hm : 0 < m) (s t : GaussianInt) (hst : t = ⟨s.re, 2 * (k : Int) - 2 * (m : Int) - s.im⟩) : diff --git a/LeanPool/ApollonianSuperharmonic/P5691T1PosDefQuadraticLowerBound.lean b/LeanPool/ApollonianSuperharmonic/P5691T1PosDefQuadraticLowerBound.lean index 2743dda867..809168516f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5691T1PosDefQuadraticLowerBound.lean +++ b/LeanPool/ApollonianSuperharmonic/P5691T1PosDefQuadraticLowerBound.lean @@ -77,10 +77,9 @@ theorem P5691T1PosDefQuadraticLowerBound (a * d - b ^ 2) / (2 * (a + d)) * ((x.re : ℝ)^2 + (x.im : ℝ)^2) := by rw [hquad] - have hs1 : 0 ≤ (a * (x.re : ℝ) + b * (x.im : ℝ)) ^ 2 := sq_nonneg _ - have hs2 : 0 ≤ (b * (x.re : ℝ) + d * (x.im : ℝ)) ^ 2 := sq_nonneg _ field_simp - nlinarith + nlinarith only [sq_nonneg (a * (x.re : ℝ) + b * (x.im : ℝ)), + sq_nonneg (b * (x.re : ℝ) + d * (x.im : ℝ))] let k : ℝ := (a * d - b ^ 2) / (2 * (a + d)) have hk : 0 < k := by dsimp [k] diff --git a/LeanPool/ApollonianSuperharmonic/ParentalOrientationGluing.lean b/LeanPool/ApollonianSuperharmonic/ParentalOrientationGluing.lean index 7d7cefa2d9..fdab66d664 100644 --- a/LeanPool/ApollonianSuperharmonic/ParentalOrientationGluing.lean +++ b/LeanPool/ApollonianSuperharmonic/ParentalOrientationGluing.lean @@ -278,8 +278,6 @@ private theorem rank_one_bound : intro D₁ σ o₁ x hx exact Finset.le_sup hx -private abbrev rank_two_bound := ApollonianSuperharmonic.ParentalOrientationLemmas.rank_one_bound - private theorem rank_increasing : ∀ (D₁ : Finset GaussianInt), ∀ (D₂ : Finset GaussianInt), ∀ (σ : GaussianInt → ℤ), ∀ (o₁ : AcyclicIndegreeOrientation D₁ σ), ∀ (o₂ : AcyclicIndegreeOrientation D₂ σ), (∀ x ∈ D₁ ∩ @@ -298,15 +296,12 @@ private theorem rank_increasing : intro D₁ D₂ σ o₁ o₂ hclosed₁ hclosed₂ I agreement edge M rank rank_one_bound x y hxy by_cases h1 : x ∈ D₁ ∧ y ∈ D₁ · have he := (by simpa [edge, h1] using hxy : o₁.edge x y) - have hxI : x ∈ I ↔ x ∈ D₂ := by simp [I, h1.1] - have hyI : y ∈ I ↔ y ∈ D₂ := by simp [I, h1.2] by_cases hx' : x ∈ I · by_cases hy' : y ∈ I · simp only [hx', ↓reduceIte, hy', gt_iff_lt, rank] exact o₁.increasing x y he · simp [rank, hx', hy', h1.2] have hm : 0 < M := by simp [M] - have hr := rank_one_bound y h1.2 have hp := rank_one_bound x h1.1 simp [M] at * omega @@ -375,7 +370,6 @@ theorem ParentalOrientationGluing (I.filter (fun y => @decide (o₁.edge y x) (o₁.edgeDecidable y x))).card = (I.filter (fun y => @decide (o₂.edge y x) (o₂.edgeDecidable y x))).card := ParentalOrientationLemmas.incoming_card D₁ D₂ σ o₁ o₂ incoming_one incoming_two - let B := I.filter (fun x => ∃ y ∈ I, o₁.edge x y ≠ o₂.edge x y) have agreement : ∀ x ∈ I, ∀ y ∈ I, o₁.edge x y ↔ o₂.edge x y := ParentalOrientationLemmas.agreement D₁ D₂ σ o₁ o₂ incoming_card let edge : GaussianInt → GaussianInt → Prop := fun x y => @@ -396,8 +390,6 @@ theorem ParentalOrientationGluing ParentalOrientationLemmas.edge_oriented D₁ D₂ σ o₁ o₂ hcross have rank_one_bound : ∀ x ∈ D₁, o₁.rank x ≤ D₁.sup o₁.rank := ParentalOrientationLemmas.rank_one_bound D₁ σ o₁ - have rank_two_bound : ∀ x ∈ D₂, o₂.rank x ≤ D₂.sup o₂.rank := - ParentalOrientationLemmas.rank_two_bound D₂ σ o₂ have rank_increasing : ∀ x y, edge x y → rank x < rank y := ParentalOrientationLemmas.rank_increasing D₁ D₂ σ o₁ o₂ hclosed₁ hclosed₂ agreement rank_one_bound diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslateFormulas.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslateFormulas.lean index 9333a75ff3..823ac7122c 100644 --- a/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslateFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometerAffineTranslateFormulas.lean @@ -114,7 +114,6 @@ theorem PartialOdometerAffineTranslateFormulas exact membership x · intro x hx change x ∈ h.domain.image (GaussianTranslation u) at hx - have hxu := (membership x).mp hx simp [hx] · intro T hT rw [setImage, hT] @@ -129,77 +128,10 @@ theorem PartialOdometerAffineTranslateFormulas intro x hx simp [hx] } : PartialOdometer) = _ have translatedSquares := PartialTranslationSquares.translatedSquares h u a b - have valueFormula (z : GaussianInt) (hz : z ∈ h.domain) : - (if GaussianTranslation u z ∈ h.domain.image (GaussianTranslation u) then - h.value (GaussianTranslation u z - u) + a.re * (GaussianTranslation u z).re + - a.im * (GaussianTranslation u z).im + b - else 0) = - h.value z + a.re * (GaussianTranslation u z).re + - a.im * (GaussianTranslation u z).im + b := by - have hz' : GaussianTranslation u z - u ∈ h.domain := by - simpa [GaussianTranslation, add_assoc, add_comm, add_left_comm] using hz - rw [ite_eq_left ((membership _).mpr hz')] - simp [GaussianTranslation, add_comm, add_left_comm] - have reAdd (x y : GaussianInt) : - ((x + y).re : ℝ) = (x.re : ℝ) + (y.re : ℝ) := by - cases x; cases y; simp - have imAdd (x y : GaussianInt) : - ((x + y).im : ℝ) = (x.im : ℝ) + (y.im : ℝ) := by - cases x; cases y; simp have reInt (x y : GaussianInt) : (x + y).re = x.re + y.re := by cases x; cases y; rfl have imInt (x y : GaussianInt) : (x + y).im = x.im + y.im := by cases x; cases y; rfl - have horizontal (x : GaussianInt) (hx : x ∈ PartialOdometerSquares h) : - (((if GaussianTranslation u (x + 1) ∈ h.domain.image (GaussianTranslation u) then - h.value (GaussianTranslation u (x + 1) - u) + a.re * (GaussianTranslation u (x + 1)).re + - a.im * (GaussianTranslation u (x + 1)).im + b else 0) - - (if GaussianTranslation u x ∈ h.domain.image (GaussianTranslation u) then - h.value (GaussianTranslation u x - u) + a.re * (GaussianTranslation u x).re + - a.im * (GaussianTranslation u x).im + b else 0) + - (if GaussianTranslation u (x + 1 + ⟨0, 1⟩) ∈ h.domain.image (GaussianTranslation u) then - h.value (GaussianTranslation u (x + 1 + ⟨0, 1⟩) - u) + a.re * (GaussianTranslation u (x - + 1 + ⟨0, 1⟩)).re + - a.im * (GaussianTranslation u (x + 1 + ⟨0, 1⟩)).im + b else 0) - - (if GaussianTranslation u (x + ⟨0, 1⟩) ∈ h.domain.image (GaussianTranslation u) then - h.value (GaussianTranslation u (x + ⟨0, 1⟩) - u) + a.re * (GaussianTranslation u (x + - ⟨0, 1⟩)).re + - a.im * (GaussianTranslation u (x + ⟨0, 1⟩)).im + b else 0) : ℤ) : ℝ) = - ((h.value (x + 1) - h.value x + h.value (x + 1 + ⟨0, 1⟩) - - h.value (x + ⟨0, 1⟩) : ℤ) : ℝ) + 2 * (a.re : ℝ) := by - have hx0 := (Finset.mem_filter.mp hx).1 - have hx1 := (Finset.mem_filter.mp hx).2.1 - have hxi := (Finset.mem_filter.mp hx).2.2.1 - have hx1i := (Finset.mem_filter.mp hx).2.2.2 - rw [valueFormula (x + 1) hx1, valueFormula x hx0, - valueFormula (x + 1 + ⟨0, 1⟩) hx1i, valueFormula (x + ⟨0, 1⟩) hxi] - simp [GaussianTranslation, reInt, imInt] - ring - have vertical (x : GaussianInt) (hx : x ∈ PartialOdometerSquares h) : - (((if GaussianTranslation u (x + ⟨0, 1⟩) ∈ h.domain.image (GaussianTranslation u) then - h.value (GaussianTranslation u (x + ⟨0, 1⟩) - u) + a.re * (GaussianTranslation u (x + - ⟨0, 1⟩)).re + - a.im * (GaussianTranslation u (x + ⟨0, 1⟩)).im + b else 0) - - (if GaussianTranslation u x ∈ h.domain.image (GaussianTranslation u) then - h.value (GaussianTranslation u x - u) + a.re * (GaussianTranslation u x).re + - a.im * (GaussianTranslation u x).im + b else 0) + - (if GaussianTranslation u (x + 1 + ⟨0, 1⟩) ∈ h.domain.image (GaussianTranslation u) then - h.value (GaussianTranslation u (x + 1 + ⟨0, 1⟩) - u) + a.re * (GaussianTranslation u (x - + 1 + ⟨0, 1⟩)).re + - a.im * (GaussianTranslation u (x + 1 + ⟨0, 1⟩)).im + b else 0) - - (if GaussianTranslation u (x + 1) ∈ h.domain.image (GaussianTranslation u) then - h.value (GaussianTranslation u (x + 1) - u) + a.re * (GaussianTranslation u (x + 1)).re + - a.im * (GaussianTranslation u (x + 1)).im + b else 0) : ℤ) : ℝ) = - ((h.value (x + ⟨0, 1⟩) - h.value x + h.value (x + 1 + ⟨0, 1⟩) - - h.value (x + 1) : ℤ) : ℝ) + 2 * (a.im : ℝ) := by - have hx0 := (Finset.mem_filter.mp hx).1 - have hx1 := (Finset.mem_filter.mp hx).2.1 - have hxi := (Finset.mem_filter.mp hx).2.2.1 - have hx1i := (Finset.mem_filter.mp hx).2.2.2 - rw [valueFormula (x + ⟨0, 1⟩) hxi, valueFormula x hx0, - valueFormula (x + 1 + ⟨0, 1⟩) hx1i, valueFormula (x + 1) hx1] - simp [GaussianTranslation, reInt, imInt] - ring simp only [PartialOdometerSlope] rw [translatedSquares] have injectiveTranslation : Function.Injective (GaussianTranslation u) := by diff --git a/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurnFormulas.lean b/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurnFormulas.lean index 0e1716b6d4..0a431e50cc 100644 --- a/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurnFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/PartialOdometerHalfTurnFormulas.lean @@ -139,14 +139,6 @@ theorem PartialOdometerHalfTurnFormulas (h : PartialOdometer) : have hx1 := (Finset.mem_filter.mp hx).2.1 have hxi := (Finset.mem_filter.mp hx).2.2.1 have hx1i := (Finset.mem_filter.mp hx).2.2.2 - have hm0 : -x ∈ h.domain.image (fun z => -z) := by - apply (membership _).mpr; simpa using hx0 - have hm1 : -(x + 1) ∈ h.domain.image (fun z => -z) := by - apply (membership _).mpr; simpa using hx1 - have hmi : -(x + ⟨0, 1⟩) ∈ h.domain.image (fun z => -z) := by - apply (membership _).mpr; simpa using hxi - have hm1i : -(x + 1 + ⟨0, 1⟩) ∈ h.domain.image (fun z => -z) := by - apply (membership _).mpr; simpa using hx1i have ha : -x - 1 - ⟨0, 1⟩ + 1 ∈ h.domain.image (fun z => -z) := by apply (membership _).mpr simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hxi diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean index cfae60a13d..d27938a3fa 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean @@ -605,12 +605,6 @@ private theorem indexBoundaryPath : h2head h2last h2mem h2chain exact ⟨l, hhead, hlast, hmem, hchain⟩ -private abbrev indexedDisjoint := - ApollonianSuperharmonic.BoundaryWebGeometry.indexedDisjointEarly - -private abbrev edgeBoundary := - ApollonianSuperharmonic.BoundaryWebGeometry.edgeBoundaryEarly - private theorem noBoundaryIncident : (by classical @@ -692,11 +686,6 @@ private theorem incidentCellsOwned : intro he exact noBoundaryIncident U x hne hxnot {x - 1, x - 1 + 1} he (by simp [Zsqrtd.ext_iff]) - have hdiagonal : ({x - I, x - I + I} : Finset GaussianInt) ∉ - BoundaryFootprintEdges U := by - intro he - exact noBoundaryIncident U x hne hxnot {x - I, x - I + I} he (by - simp [I, Zsqrtd.ext_iff]) have hbelowCell : x - I ∈ U.cells := (horizontalStatus U x htop) |>.mp hxcell have hleftCell : x - 1 ∈ U.cells := @@ -780,7 +769,6 @@ private theorem ownerFootprint : classical intro C P ownerExists owner ownerCell x have hx := ownerCell x - have hne := (owner x).property by_cases hcells : (P.tile (owner x)).cells.Nonempty · rw [FootprintVertices, ite_eq_left hcells] exact ⟨x, hx, Or.inl rfl⟩ @@ -996,10 +984,6 @@ theorem PeriodicBoundaryWebConnected : (BoundaryWebGeometry.commonBoundaryVertex C P (BoundaryWebGeometry.boundaryEndpoint) (BoundaryWebGeometry.edgeBoundaryEarly C P (BoundaryWebGeometry.indexedDisjointEarly C P))) - have edgeBoundary := BoundaryWebGeometry.edgeBoundary C P - (BoundaryWebGeometry.indexedDisjoint C P) - let I : GaussianInt := ⟨0, 1⟩ - have tileCellsNonempty := BoundaryWebGeometry.tileCellsNonempty C P have ownerExists := BoundaryWebGeometry.ownerExists C P let owner : GaussianInt → TilingLattice C := fun x => Classical.choose (ownerExists x) diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean index db6b856618..dee1a11837 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean @@ -131,10 +131,6 @@ private theorem hunit : norm_num at h omega intro y - have hre (x w : GaussianInt) : (x + w).re = x.re + w.re := by - cases x; cases w; rfl - have him (x w : GaussianInt) : (x + w).im = x.im + w.im := by - cases x; cases w; rfl have hpairs : g (y + 1) + g (y - 1) - 2 * g y = g 1 + g (-1) := by have hsub : y - 1 = y + (-1) := by abel @@ -1663,7 +1659,6 @@ theorem PeriodicBoundaryWebLaplacian (C : BandCircle) have hother := WebLaplacianGeometry.hother C v hv a0 a1 a2 a3 m hm (WebLaplacianGeometry.hnotall C v hv a0 a1 a2 a3 hvnotfour) obtain ⟨w, hmw, hcover⟩ := secondOwnerCoversThree owner m hother hnotinj - let next : Fin 4 → Fin 4 := ![1, 2, 3, 0] have colorCycle := WebLaplacianGeometry.colorCycle let col : Fin 4 → Fin 3 := fun i => if owner i = owner m then 0 else if owner i = owner w then 1 else 2 @@ -1672,11 +1667,6 @@ theorem PeriodicBoundaryWebLaplacian (C : BandCircle) have hcol2unique := WebLaplacianGeometry.hcol2unique C a0 a1 a2 a3 m w hmw hcover obtain ⟨e, hecolor⟩ := colorCycle col ⟨m, hmcol⟩ ⟨w, hwcol⟩ hcol2unique have hepair := WebLaplacianGeometry.hepair C a0 a1 a2 a3 m w e hecolor - let sector : Fin 4 → GaussianInt := - ![x, x - 1, x - 1 - ⟨0, 1⟩, x - ⟨0, 1⟩] - let edge : Fin 4 → Finset GaussianInt := - ![{x, x + ⟨0, 1⟩}, {x - 1, x}, - {x - ⟨0, 1⟩, x}, {x, x + 1}] have hsector := WebLaplacianGeometry.hsector C x P a0 ha0 a1 ha1 a2 ha2 a3 ha3 have hsectorNot := WebLaplacianGeometry.hsectorNot C x P a0 a1 a2 a3 hsector have hedgeBoundary := WebLaplacianGeometry.hedgeBoundary C x P a0 ha0 a1 ha1 a2 ha2 a3 ha3 @@ -1694,7 +1684,6 @@ theorem PeriodicBoundaryWebLaplacian (C : BandCircle) obtain ⟨p, hp⟩ := slope_for C.1.1 T h hodo hcurvature let u : GaussianInt := owner m let u' : GaussianInt := owner w - have hu_eq := WebLaplacianGeometry.hu_eq C v hv a0 a1 a2 a3 m hm have hu_mem : u ∈ TilingLattice C := (owner m).property have hu'_mem : u' ∈ TilingLattice C := (owner w).property obtain ⟨au, hAu, hshiftu⟩ := hcocycle u hu_mem @@ -1723,8 +1712,6 @@ theorem PeriodicBoundaryWebLaplacian (C : BandCircle) simpa [hu'Odo] using translateExtends u' au' hshiftu' have hmatrixDiff := WebLaplacianGeometry.hmatrixDiff C a0 a1 a2 a3 m w au hAu au' hAu' have hincoming := CircleMatrixIncomingVector C q hsemi hqC j - have hAdiff := WebLaplacianGeometry.hAdiff C q a0 a1 a2 a3 m w j hsign au au' hmatrixDiff - hincoming have tileM : P.tile (owner m) = TileTranslation T u := by simpa [u] using hPtile (owner m) have tileW : P.tile (owner w) = TileTranslation T u' := by @@ -1743,10 +1730,6 @@ theorem PeriodicBoundaryWebLaplacian (C : BandCircle) w j au au' hmatrixDiff hincoming) (WebLaplacianGeometry.aDiffMinus C q a0 a1 a2 a3 m w j au au' hmatrixDiff hincoming) (WebLaplacianGeometry.hslopeU C h a0 a1 a2 a3 m p hp au) (WebLaplacianGeometry.hslopeU' C h a0 a1 a2 a3 w p hp au') - have hnoCheckerboard0 := WebLaplacianGeometry.hnoCheckerboard0 C x P a0 ha0 a1 hu1 a2 ha2 a3 hu3 - have hnoCheckerboard1 := WebLaplacianGeometry.hnoCheckerboard1 C x P a0 hu0 a1 ha1 a2 hu2 a3 ha3 - have hnoCheckerboard2 := WebLaplacianGeometry.hnoCheckerboard2 C x P a0 ha0 a1 hu1 a2 ha2 a3 hu3 - have hnoCheckerboard3 := WebLaplacianGeometry.hnoCheckerboard3 C x P a0 hu0 a1 ha1 a2 hu2 a3 ha3 have hcompat : OdometerCompatibility huOdo hu'Odo := (LeftAdjacentOdometerCompatibility C (TileTranslation T u) (TileTranslation T u') huOdo hu'Odo hadjOdo).1 diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean b/LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean index 875c956410..a5c2b84404 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean @@ -251,7 +251,6 @@ private theorem Yconn : have hrev : p.reverse.IsChain FourNeighborAdjacent := List.isChain_reverse.mpr hpc' have hqtail : q.tail.IsChain FourNeighborAdjacent := hqc.tail - have hpn : p ≠ [] := by intro he; simp [he] at hp have hqn : q ≠ [] := by intro he; simp [he] at hq have hjoin : (p.reverse ++ q.tail).IsChain FourNeighborAdjacent := by apply hrev.append hqtail @@ -510,14 +509,6 @@ private theorem hlapInd : rw [show p + v - ⟨0, 1⟩ - v = p - ⟨0, 1⟩ by abel] at hh simp only [not_not] at hh exact hh - have h2'' : -1 + p ∈ Z ↔ -1 + p + v ∉ X := by - convert h2' using 1 <;> abel - have h4'' : -⟨0, 1⟩ + p ∈ Z ↔ -⟨0, 1⟩ + p + v ∉ X := by - convert h4' using 1 <;> abel - have e1 : 1 + p + v ∉ X ↔ p + 1 ∈ Z := by - convert h1'.symm using 1; abel - have e2 : -1 + p + v ∉ X ↔ p - 1 ∈ Z := by - convert h2'.symm using 1; abel have e3 : p + v + ⟨0, 1⟩ ∉ X ↔ p + ⟨0, 1⟩ ∈ Z := h3'.symm have e4 : p + v - ⟨0, 1⟩ ∉ X ↔ p - ⟨0, 1⟩ ∈ Z := h4'.symm simp only [FourNeighborLaplacian] @@ -641,7 +632,6 @@ theorem PeriodicOdometerIndicatorRigidity (C : BandCircle) p.head? = some a ∧ p.getLast? = some b ∧ (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent let Y : Set GaussianInt := {y | reachable x y} - have Ynonempty := PeriodicIndicatorGeometry.Ynonempty X x hxX have xY := PeriodicIndicatorGeometry.xY X x hxX have Yout := PeriodicIndicatorGeometry.Yout X x have Yconn := PeriodicIndicatorGeometry.Yconn X x xY diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicQuadraticRemainder.lean b/LeanPool/ApollonianSuperharmonic/PeriodicQuadraticRemainder.lean index c9a7c36c2e..5141f263b3 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicQuadraticRemainder.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicQuadraticRemainder.lean @@ -64,13 +64,6 @@ theorem PeriodicQuadraticRemainder (C : BandCircle) have delta_zero : d 0 = 0 := by have hz := delta_add 0 0 (TilingLattice C).zero_mem simpa using hz - have delta_neg : ∀ v, v ∈ TilingLattice C → d (-v) = -d v := by - intro v hv - have h := delta_add (-v) v hv - have hmem : -v ∈ TilingLattice C := (TilingLattice C).neg_mem hv - have hzero : -v + v = 0 := by simp - rw [hzero, delta_zero] at h - linarith let deltaHom : TilingLattice C →+ ℝ := { toFun := fun v => d v map_zero' := delta_zero @@ -115,13 +108,6 @@ theorem PeriodicQuadraticRemainder (C : BandCircle) have hone : (1, 0) = mn := hmu (1, 0) (by simp [hz]) have hh := congrArg Prod.fst (hone.trans hzero.symm) norm_num at hh - have hv0 : v ≠ 0 := by - intro hz - obtain ⟨mn, hm, hmu⟩ := hcoord ⟨0, (TilingLattice C).zero_mem⟩ - have hzero : (0 : Int × Int) = mn := hmu (0, 0) (by simp [hz]) - have hone : (0, 1) = mn := hmu (0, 1) (by simp [hz]) - have hh := congrArg Prod.snd (hone.trans hzero.symm) - norm_num at hh by_cases hreal : v.re = 0 ∧ u.re = 0 · have himag : v.im ≠ 0 ∨ u.im ≠ 0 := by by_cases hvim : v.im = 0 @@ -177,10 +163,6 @@ theorem PeriodicQuadraticRemainder (C : BandCircle) obtain ⟨mn, hm, hmu⟩ := hcoord w have hlinear : d ((mn.1 : GaussianInt) * u + (mn.2 : GaussianInt) * v) = (mn.1 : ℝ) * d u + (mn.2 : ℝ) * d v := by - have hu' : (⟨u, hu⟩ : TilingLattice C) = - (⟨u, hu⟩ : TilingLattice C) := rfl - have hv' : (⟨v, hv⟩ : TilingLattice C) = - (⟨v, hv⟩ : TilingLattice C) := rfl have hm1 := deltaHom.map_zsmul mn.1 (⟨u, hu⟩ : TilingLattice C) have hm2 := deltaHom.map_zsmul mn.2 (⟨v, hv⟩ : TilingLattice C) have hadd := deltaHom.map_add diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean index a56d62d6c2..4629c8312a 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean @@ -1440,10 +1440,6 @@ private theorem hDfilter : intro T h D hDcells ext z rw [hDcells, Finset.mem_filter] - have hdec : @decide (z ∉ BoundaryFootprintVertices T) - (Classical.propDecidable _) = true ↔ - z ∉ BoundaryFootprintVertices T := by - cases Classical.propDecidable _ <;> simp simp [] private theorem hsumFund : @@ -1784,12 +1780,6 @@ private theorem hD_lap_real : intro T h g D hsumDelta_one B hsum_partition hB_lap have hs := hsum_partition (fun x => (FourNeighborLaplacian g x : ℝ)) rw [hB_lap] at hs - have hreal : - (∑ x ∈ D, (FourNeighborLaplacian g x : ℝ)) + - (B.card : ℝ) = 1 := by - calc - _ = ∑ x ∈ T.cells, (FourNeighborLaplacian g x : ℝ) := hs - _ = 1 := hsumDelta_one linarith private theorem hD_lap_int : @@ -1925,8 +1915,6 @@ private theorem hcountBridge : (PeriodicIndegreeGeometry.hBEset T hEset (PeriodicIndegreeGeometry.hBEsub T)) let A := E.filter fun e => edgeOf e ∉ BoundaryFootprintEdges T have hApart : A.card + BE.card = E.card := PeriodicIndegreeGeometry.hApart T - have hAcount : (A.card : Int) = D.card + T.cells.card - 1 := by - omega have hEocc := PeriodicIndegreeGeometry.hEocc T edgeOf_injective hEmem -- A shared side has an open rectangle inside its two incident squares. let step : Bool → GaussianInt := fun b => if b then I else 1 @@ -1991,7 +1979,6 @@ theorem PeriodicTileTotalIndegree (C : BandCircle) PeriodicCountBridge.hcountBridge C T hT hlat D hDmem hsectorAll have htiles := LatticeTileGridStructure T hlat have heuler := LatticeTileGridEulerCount T hlat - have hreg := LatticeEdgeRegularity C T hT hlat let D : Finset GaussianInt := h.domain.filter (fun x => @decide (x ∉ BoundaryFootprintVertices T) (Classical.propDecidable _)) @@ -2014,14 +2001,12 @@ theorem PeriodicTileTotalIndegree (C : BandCircle) have hcell_curv : T.cells.card = C.1.1.1.natAbs := PeriodicIndegreeGeometry.hcell_curv C T R hRcard (PeriodicIndegreeGeometry.hcell_card C T hcell_residue_unique hfund R hR) - let I : GaussianInt := ⟨0, 1⟩ have hsectorAll := PeriodicIndegreeGeometry.hsectorAll T (PeriodicIndegreeGeometry.hstatusRight T hcells) (PeriodicIndegreeGeometry.hstatusDown T hcells) (PeriodicIndegreeGeometry.hstatusLeft T hcells) (PeriodicIndegreeGeometry.hsomeSector T hcells) have hDcells := PeriodicIndegreeGeometry.hDcells T h hDmem hsectorAll (PeriodicIndegreeGeometry.hcellBaseFV T hcells) - have hDfilter := PeriodicIndegreeGeometry.hDfilter T h hDcells have hsumTranslate := PeriodicIndegreeGeometry.hsumTranslate C T hfund (PeriodicIndegreeGeometry.hsumFund C) (PeriodicIndegreeGeometry.hfundTranslate C T hfund) -- Each translated periodic stencil has the same sum over the representatives. @@ -2030,10 +2015,6 @@ theorem PeriodicTileTotalIndegree (C : BandCircle) LatticeQuadraticForm (CircleMatrix C) x - (b.1 * x.re + b.2 * x.im) have hFperiod (x v : GaussianInt) (hv : v ∈ TilingLattice C) : F (x + v) = F x := hb v hv x - let u : GaussianInt → ℝ := fun x => (g x : ℝ) - let vfun : GaussianInt → ℝ := fun x => - LatticeQuadraticForm (CircleMatrix C) x + - dotProduct ![b.1, b.2] ![(x.re : ℝ), (x.im : ℝ)] have hDfilterProp := PeriodicIndegreeGeometry.hDfilterProp T h hDcells let B : Finset GaussianInt := T.cells.filter (fun x => x ∈ BoundaryFootprintVertices T) diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean index b996c972bc..ee4320bd79 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean @@ -150,20 +150,6 @@ private theorem hglobal : simp [] rw [he'] exact ha - have baseDomain : x - ((kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + - (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) ∈ h.domain := by - change x - ((kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + - (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) ∈ - (h.domain : Set GaussianInt) - rw [hdom] - have nonempty : T.cells.Nonempty := ⟨_, base⟩ - simp only [FootprintVertices, ite_eq_left nonempty, Set.mem_ofPred_eq] - exact ⟨_, base, Or.inl rfl⟩ - have hv : x ∈ FootprintVertices (TileTranslation T - ((kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + - (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0))) := by - rw [← (domain_from_odo _ _ _ (htrans kl).1)] - exact (htrans kl).2.1 x |>.mpr baseDomain have vertex (z : GaussianInt) (hz : z = x - ((kl.1 : GaussianInt) * BandVectors.1 (q 1) (q 0) + (kl.2 : GaussianInt) * BandVectors.1 (q 2) (q 0)) ∨ @@ -365,7 +351,6 @@ theorem PositiveCurvatureGeneratorCocycles (C : BandCircle) domain_from_odo _ _ _ hodo have tiling : ExactTileTiling (RegularTileFamily T (TilingLattice C)) := (BandTileTopologyApplication C q hq hqC T (by simpa [hqC] using hT)).1 - have hlat := GeneratorCocycleGeometry.hlat C q T h H htrans hdom tiling have hglobal := GeneratorCocycleGeometry.hglobal C q T h H htrans hcompat domain_from_odo hdom (GeneratorCocycleGeometry.hcoords C q hq hqC) tiling (GeneratorCocycleGeometry.hfamily C q T hq hqC tiling) diff --git a/LeanPool/ApollonianSuperharmonic/PositiveDefiniteRepresentativeGap.lean b/LeanPool/ApollonianSuperharmonic/PositiveDefiniteRepresentativeGap.lean index 12a6287fe4..421e39e25a 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveDefiniteRepresentativeGap.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveDefiniteRepresentativeGap.lean @@ -59,7 +59,6 @@ theorem PositiveDefiniteRepresentativeGap (le_trans (le_max_left Rh (2 * M / k)) (le_max_right Rg (max Rh (2 * M / k)))) hx) have hq := hlower x - have hn : 0 ≤ (x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2 := by positivity have hmain : k / 2 * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) ≤ (g x : ℝ) - (h x : ℝ) := by have hgl : -(k / 4 * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2)) ≤ diff --git a/LeanPool/ApollonianSuperharmonic/ProperBandCurvatureStructure.lean b/LeanPool/ApollonianSuperharmonic/ProperBandCurvatureStructure.lean index c051474cd2..3d168f5ecc 100644 --- a/LeanPool/ApollonianSuperharmonic/ProperBandCurvatureStructure.lean +++ b/LeanPool/ApollonianSuperharmonic/ProperBandCurvatureStructure.lean @@ -83,9 +83,6 @@ theorem ProperBandCurvatureStructure (q : Fin 4 → CircleCoordinates) 2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1 := by simpa using hpbelow (0 : Fin 3) have a := nonneg (0 : Fin 4) - have b := nonneg (1 : Fin 4) - have c := nonneg (2 : Fin 4) - have d := nonneg (3 : Fin 4) change 0 < 2 * (r 0).1 + 2 * (r 2).1 + 2 * (r 3).1 - (r 1).1 omega constructor diff --git a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean index 227f73f624..6441c665bd 100644 --- a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean @@ -81,11 +81,6 @@ theorem QuarterTurnSymmetricCenteredTransport : ∀ (T : ProtoTile), TileCentroid T := by -- BODY intro T hT - have center_mem : ∀ (S : ProtoTile) (x : GaussianInt), - x ∈ S.cells ↔ - (((x.re : Int) : Real) + (1 / 2 : Real), - ((x.im : Int) : Real) + (1 / 2 : Real)) ∈ TileRealization S := - CenteredTransportLemmas.center_mem by_cases hempty : T.cells = ∅ · let u : GaussianInt := ⟨T.anchor.re + T.anchor.im, T.anchor.im - T.anchor.re⟩ @@ -120,7 +115,6 @@ theorem QuarterTurnSymmetricCenteredTransport : ∀ (T : ProtoTile), have real_ne : real_parts.Nonempty := hne.image _ have imag_ne : imag_parts.Nonempty := hne.image _ let xmin : Int := real_parts.min' real_ne - let xmax : Int := real_parts.max' real_ne let ymin : Int := imag_parts.min' imag_ne let ymax : Int := imag_parts.max' imag_ne have lower_re : ∀ p : Real × Real, p ∈ TileRealization T → diff --git a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricExactInterfaceTransport.lean b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricExactInterfaceTransport.lean index f786ebf457..5886393e89 100644 --- a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricExactInterfaceTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricExactInterfaceTransport.lean @@ -430,10 +430,6 @@ theorem QuarterTurnSymmetricExactInterfaceTransport apply Zsqrtd.ext · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.im) h · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.re) h - have tinj : Function.Injective (GaussianTranslation u) := by - intro x y h - dsimp [GaussianTranslation] at h - exact add_right_cancel h have finj : Function.Injective (fun z : GaussianInt => GaussianQuarterTurn z + u) := by intro x y h apply qinj @@ -454,12 +450,6 @@ theorem QuarterTurnSymmetricExactInterfaceTransport rw [Set.image_image] at hbaseV' have hbaseE' := hbaseE rw [Set.image_image] at hbaseE' - have point_map (d x : GaussianInt) : - GaussianQuarterTurn (GaussianTranslation d x) + u = - GaussianTranslation (GaussianQuarterTurn d) - (GaussianQuarterTurn x + u) := by - simp [GaussianTranslation, GaussianQuarterTurn, add_comm, - add_left_comm] have vertex_cov (d : GaussianInt) : FootprintVertices (TileTranslation T (GaussianQuarterTurn d)) = (fun x : GaussianInt => GaussianQuarterTurn x + u) '' diff --git a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean index dd245acc4c..7a049a3707 100644 --- a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean @@ -767,7 +767,6 @@ theorem RightLatticeAdjacentPackingSymmetryTransport have newFlipRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) newFlip have newFlipIm := congrArg (fun z : GaussianInt => (z.im : ℝ)) newFlip have turn_mul (z : GaussianInt) := RightLatticeTransportGeometry.turn_mul z - have neg_turn_mul (z : GaussianInt) := RightLatticeTransportGeometry.neg_turn_mul turn_mul z have neg_turn_mul' (z : GaussianInt) := RightLatticeTransportGeometry.neg_turn_mul' z have oldPair := RightLatticeTransportGeometry.oldPair q i oldFlip oldFlipVec turn_mul neg_turn_mul' diff --git a/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean b/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean index 693967aa4d..b0c3610f16 100644 --- a/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/RightSubtileOdometerCompatibility.lean @@ -215,7 +215,6 @@ private theorem hrootAt310 : have hpq1 := hq.2 (1 : Fin 3) have huniq01 := hunique 0 1 by_contra hn - have hle : (q 0).1 ≤ 1 := by omega have hz0 : (q (0 : Fin 3).succ).1 = 0 := by omega have hz1 : (q (1 : Fin 3).succ).1 = 0 := by omega have bad := huniq01 hz0 hz1 @@ -331,9 +330,6 @@ private theorem edgeStepAt328 : (Int.toNat_lt_toNat (by simpa [hqC] using C.property)).2 hlt have hCeq : Int.toNat C.1.1.1 = Int.toNat (q 0).1 := by simp [hqC] - have hsum : Int.toNat C.1.1.1 + Int.toNat (q j.succ).1 < - Int.toNat C.1.1.1 + Int.toNat (q 0).1 := - Nat.add_lt_add_left hltNat _ have hltSum : Int.toNat C.1.1.1 + Int.toNat (q j.succ).1 < n := by omega have hltSum' : Int.toNat C.1.1.1 + Int.toNat Cj.1.1.1 < n := by @@ -517,8 +513,6 @@ private theorem edgeStepAt482 : simp [Cj] have hltSum : Int.toNat Cᵢ.1.1.1 + Int.toNat (q j.succ).1 < n := by omega - have hcpt := (ih (Int.toNat Cᵢ.1.1.1 + Int.toNat Cj.1.1.1) - (by simpa [Cj] using hltSum)).2 have common : ∃ c : ℤ, ∀ z, (z = u ∨ z = v) → z ∈ hᵢ.domain → z ∈ h₀.domain → hᵢ.value z - h₀.value z = c := by have child_mem : ∀ z, z = u ∨ z = v → z ∈ (hsx j t).domain := by @@ -611,11 +605,6 @@ theorem RightSubtileOdometerCompatibility : -- BODY have singleton_case := RightCompatibilityGeometry.singleton_case have list_glue := RightCompatibilityGeometry.list_glue - have child_circle : ∀ (q : Fin 4 → CircleCoordinates), - ProperBandQuadruple q → ∀ j : Fin 3, 0 < (q j.succ).1 → BandCircle := by - intro q hq j hj - refine ⟨⟨q j.succ, ?_⟩, hj⟩ - exact ⟨Or.inl hj, ⟨q, hq.1, ⟨j.succ, rfl⟩⟩⟩ have edge_endpoints := RightCompatibilityGeometry.edge_endpoints have main : ∀ n : Nat, (∀ (C : BandCircle) (T T' : ProtoTile) (h h' : PartialOdometer), diff --git a/LeanPool/ApollonianSuperharmonic/SemiProperForestClassification.lean b/LeanPool/ApollonianSuperharmonic/SemiProperForestClassification.lean index 65e9908d22..ac9634ff97 100644 --- a/LeanPool/ApollonianSuperharmonic/SemiProperForestClassification.lean +++ b/LeanPool/ApollonianSuperharmonic/SemiProperForestClassification.lean @@ -127,7 +127,6 @@ theorem SemiProperForestClassification (q : Fin 4 → CircleCoordinates) change SemiProperQuadruple _ ∧ _ refine ⟨SemiProperQuadruple.successor proper.1, ?_⟩ have h0 : (r 1).1 < (r 0).1 := by simpa using proper.2 0 - have h1 : (r 2).1 < (r 0).1 := by simpa using proper.2 1 have h2 : (r 3).1 < (r 0).1 := by simpa using proper.2 2 intro j fin_cases j diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean index 02af32a164..3baeca1499 100644 --- a/LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathEquivariance.lean @@ -191,11 +191,6 @@ theorem SimpleGridPathEquivariance : have backward := PathEquivariance.backward let qb : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ - have hqb : Function.Injective qb := by - intro a b h - apply Zsqrtd.ext - · simpa [qb] using congrArg (fun z : GaussianInt => z.im) h - · simpa [qb] using congrArg (fun z : GaussianInt => z.re) h have transStep : ∀ a b : GaussianInt, (b = a + 1 ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → (GaussianTranslation u b = GaussianTranslation u a + 1 ∨ diff --git a/LeanPool/ApollonianSuperharmonic/SimpleGridPathPointTrichotomy.lean b/LeanPool/ApollonianSuperharmonic/SimpleGridPathPointTrichotomy.lean index 2c7f2bd29b..9e5607c7fa 100644 --- a/LeanPool/ApollonianSuperharmonic/SimpleGridPathPointTrichotomy.lean +++ b/LeanPool/ApollonianSuperharmonic/SimpleGridPathPointTrichotomy.lean @@ -44,18 +44,6 @@ lemma SimpleGridPathPointTrichotomy simp · rw [hraw] simp - have hpne : p ≠ [] := by - intro hpnil - have hzero : (2 : Nat) ≤ 0 := by simpa only [hpnil, List.length_nil] using hlen - omega - have hfirst : ∀ z : GaussianInt, p.head? = some z → p = z :: p.tail := by - intro z hz - cases p with - | nil => exact False.elim (hpne rfl) - | cons q r => - simp only [List.head?_cons, Option.some.injEq] at hz - subst q - rfl have split_mem : ∀ (r : List GaussianInt) (z : GaussianInt), z ∈ r → ∃ l t, r = l ++ z :: t := by intro r z hz diff --git a/LeanPool/ApollonianSuperharmonic/SuperharmonicDownwardClosure.lean b/LeanPool/ApollonianSuperharmonic/SuperharmonicDownwardClosure.lean index 6aaf94b8ce..5cdc6448a7 100644 --- a/LeanPool/ApollonianSuperharmonic/SuperharmonicDownwardClosure.lean +++ b/LeanPool/ApollonianSuperharmonic/SuperharmonicDownwardClosure.lean @@ -70,7 +70,6 @@ theorem SuperharmonicDownwardClosure apply (div_le_iff₀ hε).mp at hlarge' nlinarith have hmul := mul_le_mul_of_nonneg_right hprod ht - have hsquare' := mul_le_mul_of_nonneg_left hsquare (by norm_num : (0 : ℝ) ≤ 16) have hsum : |(x.re : ℝ)| + |(x.im : ℝ)| ≤ ε * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) / 4 := by nlinarith [sq_nonneg (ε * ((x.re : ℝ) ^ 2 + (x.im : ℝ) ^ 2) - diff --git a/LeanPool/ApollonianSuperharmonic/TileHalfTurnFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileHalfTurnFormulas.lean index 07c6913406..e78ed05e69 100644 --- a/LeanPool/ApollonianSuperharmonic/TileHalfTurnFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/TileHalfTurnFormulas.lean @@ -54,9 +54,6 @@ theorem TileHalfTurnFormulas : ∀ T : ProtoTile, apply gaussian_equal <;> simp have half_anchor (a : GaussianInt) : -(-a) = a := by apply gaussian_equal <;> simp - have half_map_normal (x : GaussianInt) : - ⟨0, 1⟩ - (-x - 1) - 1 - ⟨0, 1⟩ = x := by - apply gaussian_equal <;> simp have quarter_twice (x : GaussianInt) : GaussianQuarterTurn (GaussianQuarterTurn x - 1) - 1 = -x - 1 - ⟨0, 1⟩ := by @@ -66,10 +63,6 @@ theorem TileHalfTurnFormulas : ∀ T : ProtoTile, apply gaussian_equal <;> simp [GaussianQuarterTurn] have image_empty (s : Finset GaussianInt) : s.image (fun x => -x - 1 - ⟨0, 1⟩) = ∅ ↔ s = ∅ := by - have inj : Function.Injective (fun x : GaussianInt => -x - 1 - ⟨0, 1⟩) := by - intro a b h - have := congrArg (fun z => -z - 1 - ⟨0, 1⟩) h - simpa [half_map] using this exact Finset.image_eq_empty.trans (by simp []) have proto_equal (A B : ProtoTile) (hc : A.cells = B.cells) (ha : A.anchor = B.anchor) : A = B := by diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean index 29e095cfe0..7cdfcd0990 100644 --- a/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerExists.lean @@ -516,9 +516,6 @@ theorem TileOdometerExists (C : BandCircle) : intro p V U W hp hV _ i hU hW hcU hcW exact (BandTileSimultaneousInduction p hp V hV).2.2.2.2.2.2.1 i U W hU hW hcU hcW) - let D : Fin 3 → BandCircle := fun i => - ⟨⟨q' i.succ, Or.inl (hpositive i), - q', cfg.proper.1, i.succ, rfl⟩, hpositive i⟩ choose U k hU hk using (TileOdometerExistenceGeometry.parents C n ih hn q r g hcurv cfg hpositive) choose p a hp ha hnonempty using fun i => diff --git a/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean b/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean index 4ee8b370fb..28d96460f6 100644 --- a/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean +++ b/LeanPool/ApollonianSuperharmonic/TileOdometerTranslationUniqueness.lean @@ -170,7 +170,6 @@ private theorem unit_shift : ) := by classical intro z x V k hc hd v hv - have hn : V.cells.Nonempty := by rw [hc]; simp have h0 : v ∈ FootprintVertices V := by rw [← hd] exact (hv v).mpr (by simp [CurvatureOneOdometer]) diff --git a/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean index 816f245c21..84bc06468b 100644 --- a/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean @@ -330,8 +330,6 @@ end QuarterTurnFormulas private theorem quarterTurnCentroid (T : ProtoTile) : TileCentroid (TileQuarterTurn T) = (-(TileCentroid T).2, (TileCentroid T).1) := by - have quarter_re := QuarterTurnFormulas.quarter_re - have quarter_im := QuarterTurnFormulas.quarter_im have quarter_re_cast := QuarterTurnFormulas.quarter_re_cast have quarter_im_cast := QuarterTurnFormulas.quarter_im_cast have quarter_re_base := QuarterTurnFormulas.quarter_re_base @@ -351,14 +349,6 @@ private theorem quarterTurnCentroid (T : ProtoTile) : have coordIm (x : GaussianInt) : (GaussianInt.toComplex x).im = (x.im : Real) := by exact (GaussianInt.intCast_im x).symm - have sumRe (x : GaussianInt) : - (GaussianInt.toComplex (GaussianQuarterTurn x - 1)).re = - -(GaussianInt.toComplex x).im - 1 := by - rw [quarter_re, coordIm] - have sumIm (x : GaussianInt) : - (GaussianInt.toComplex (GaussianQuarterTurn x - 1)).im = - (GaussianInt.toComplex x).re := by - rw [quarter_im, coordRe] have sumReInt (x : GaussianInt) : ((GaussianQuarterTurn x - 1).re : Real) = -(x.im : Real) - 1 := quarter_re_cast x @@ -404,24 +394,12 @@ theorem TileQuarterTurnFormulas : ∀ T : ProtoTile, BoundaryFootprintEdges T := by -- BODY intro T - have quarter_re (x : GaussianInt) : - (GaussianInt.toComplex (GaussianQuarterTurn x - 1)).re = - -(x.im : Real) - 1 := QuarterTurnFormulas.quarter_re x - have quarter_im (x : GaussianInt) : - (GaussianInt.toComplex (GaussianQuarterTurn x - 1)).im = - (x.re : Real) := QuarterTurnFormulas.quarter_im x have quarter_re_cast (x : GaussianInt) : ((GaussianQuarterTurn x - 1).re : Real) = -(x.im : Real) - 1 := QuarterTurnFormulas.quarter_re_cast x have quarter_im_cast (x : GaussianInt) : ((GaussianQuarterTurn x - 1).im : Real) = (x.re : Real) := QuarterTurnFormulas.quarter_im_cast x - have quarter_re_base (x : GaussianInt) : - (GaussianInt.toComplex (GaussianQuarterTurn x)).re = -(x.im : Real) := - QuarterTurnFormulas.quarter_re_base x - have quarter_im_base (x : GaussianInt) : - (GaussianInt.toComplex (GaussianQuarterTurn x)).im = (x.re : Real) := - QuarterTurnFormulas.quarter_im_base x have turn_up (a : GaussianInt) : GaussianQuarterTurn (a + ⟨0, 1⟩) = GaussianQuarterTurn a - 1 := QuarterTurnFormulas.turn_up a have turn_right (a : GaussianInt) : diff --git a/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean b/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean index df3f73dd06..e499e1388f 100644 --- a/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/TileStringCoordinateTransport.lean @@ -445,10 +445,6 @@ private theorem internal_strip : cases pre with | nil => simp at hp | cons a tail => simp - have htl : 0 < post.length := by - cases post with - | nil => simp at ht - | cons a tail => simp omega · rintro ⟨hh, ht, hn, hc, hi⟩ have hne : xs ≠ [] := by intro he; simp [he] at hh diff --git a/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean index 746b75d388..d6d1c1bf9f 100644 --- a/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean @@ -619,9 +619,6 @@ theorem TileStringRegularFamilyCentralCovariance let tileAt := fun z : Int × Int => TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) let reflect := fun z : Int × Int => (r.1 + s.1 - z.1, r.2 + s.2 - z.2) - have coordinate_value := RegularStringCentralGeometry.coordinate_value base a b - have reflected_corr := RegularStringCentralGeometry.reflected_corr base tiles a b coordinates - hcorr let reverseTiles := coordinates.map (fun z => tileAt (reflect z)) have reverse_string := RegularStringCentralGeometry.reverse_string C orientation base R S a b htransport r hr s hs coordinates (RegularStringCentralGeometry.reflected_segment r s diff --git a/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean b/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean index 2f35b27469..a0217a8530 100644 --- a/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean +++ b/LeanPool/ApollonianSuperharmonic/TileT1DiskArea.lean @@ -326,7 +326,6 @@ theorem TileT1DiskArea (q : Fin 4 → CircleCoordinates) have ht := DiskAreaGeometry.ht q cfg C₀ T cert u hu let H : ProtoTile → ProtoTile := fun U => TileTranslation (TileQuarterTurn (TileQuarterTurn U)) t - let tau : GaussianInt → GaussianInt := fun z => t - z - 1 - ⟨0, 1⟩ have htau := TileHalfTurnGeometry.involutive q u have hHcells := TileHalfTurnGeometry.cells q u have hHreal := TileHalfTurnGeometry.realization q T u ht diff --git a/LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean b/LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean index 5cce1a9d5c..e035217bf5 100644 --- a/LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean +++ b/LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean @@ -570,13 +570,9 @@ theorem TileT2QuarterTurn (q : Fin 4 → CircleCoordinates) QuarterTurnSymmetricCenteredTransport ring hRing let turn (x : GaussianInt) : GaussianInt := ⟨-x.im - 1 + u.re, x.re + u.im⟩ - let back (x : GaussianInt) : GaussianInt := - ⟨x.im - u.im, -x.re - 1 + u.re⟩ have turn_back (x : GaussianInt) := QuarterTurnTileGeometry.turn_back u x have back_turn (x : GaussianInt) := QuarterTurnTileGeometry.back_turn u x have hRingImage := QuarterTurnTileGeometry.hRingImage ring u hRingCells - have turn_add (x d : GaussianInt) := QuarterTurnTileGeometry.turn_add u x d - have back_add (x d : GaussianInt) := QuarterTurnTileGeometry.back_add u x d dsimp [UniqueBoundedGridComplementComponent] at hUnique let gridConnected := fun S : Set GaussianInt => S.Nonempty ∧ ∀ x ∈ S, ∀ y ∈ S, ∃ p : List GaussianInt, @@ -616,14 +612,11 @@ theorem TileT2QuarterTurn (q : Fin 4 → CircleCoordinates) (-(p.2) + (u.re : Real), p.1 + (u.im : Real)) have hreal := QuarterTurnTileGeometry.hreal T u hCells have hset := QuarterTurnTileGeometry.hset T u hreal - let unrotate (p : Real × Real) : Real × Real := - (p.2 - (u.im : Real), -p.1 + (u.re : Real)) have hrotate (p : Real × Real) : rotate p = ((TileCentroid T).1 - (p.2 - (TileCentroid T).2), (TileCentroid T).2 + (p.1 - (TileCentroid T).1)) := QuarterTurnTileGeometry.hrotate T u hu_re hu_im p have hleft (p : Real × Real) := QuarterTurnTileGeometry.hleft u p - have hright (p : Real × Real) := QuarterTurnTileGeometry.hright u p have hforward (p : Real × Real) (hp : p ∈ TileRealization T) := QuarterTurnTileGeometry.hforward T u hset p hp have hback (p : Real × Real) (hp : p ∈ TileRealization T) := QuarterTurnTileGeometry.hback T diff --git a/LeanPool/ApollonianSuperharmonic/TileT4ParentTranslateTouching.lean b/LeanPool/ApollonianSuperharmonic/TileT4ParentTranslateTouching.lean index 76b9ef2418..323290ced2 100644 --- a/LeanPool/ApollonianSuperharmonic/TileT4ParentTranslateTouching.lean +++ b/LeanPool/ApollonianSuperharmonic/TileT4ParentTranslateTouching.lean @@ -102,9 +102,6 @@ theorem TileT4ParentTranslateTouching (q : Fin 4 → CircleCoordinates) FootprintVertices (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) ∩ FootprintVertices Tᵢ := hbc.2.2.2.trans hbc.1.symm - have hsetCA : BoundaryFootprintVertices Tᵢ ∩ BoundaryFootprintVertices T₀ = - FootprintVertices Tᵢ ∩ FootprintVertices T₀ := - hca.2.2.2.trans hca.1.symm have htriple : ∀ x : GaussianInt, (x ∈ BoundaryFootprintVertices T₀ ∧ x ∈ BoundaryFootprintVertices (TileTranslation T₀ (BandVectors.1 (q i.succ) (q 0))) ∧ diff --git a/LeanPool/ApollonianSuperharmonic/TileTouchingCovariance.lean b/LeanPool/ApollonianSuperharmonic/TileTouchingCovariance.lean index 7dc8cf2221..fa69830aef 100644 --- a/LeanPool/ApollonianSuperharmonic/TileTouchingCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/TileTouchingCovariance.lean @@ -45,11 +45,6 @@ theorem TileTouchingCovariance : ∀ (T U : ProtoTile) (u : GaussianInt), · rintro ⟨⟨a, ha, hax⟩, ⟨b, hb, hbx⟩⟩ have hab : a = b := hf (hax.trans hbx.symm) exact ⟨a, ⟨ha, hab ▸ hb⟩, hax⟩ - have image_disjoint : ∀ (A B : Set GaussianInt) (f : GaussianInt → GaussianInt), - Function.Injective f → - (Disjoint A B ↔ Disjoint (f '' A) (f '' B)) := by - intro A B f hf - exact (Set.disjoint_image_iff hf).symm have image_mem : ∀ (A : Set GaussianInt) (f : GaussianInt → GaussianInt), Function.Bijective f → ∀ x, (x ∈ A ↔ f x ∈ f '' A) := by intro A f hf x diff --git a/LeanPool/ApollonianSuperharmonic/TileTranslationFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileTranslationFormulas.lean index 861e802cde..8cf08b804a 100644 --- a/LeanPool/ApollonianSuperharmonic/TileTranslationFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/TileTranslationFormulas.lean @@ -49,12 +49,6 @@ private theorem translationRealization (T : ProtoTile) (u : GaussianInt) : have imagAdd (z w : GaussianInt) : (((z + w).im : Int) : Real) = (z.im : Real) + (w.im : Real) := by cases z; cases w; simp - have realCoord (w : GaussianInt) : - (GaussianInt.toComplex w).re = (w.re : Real) := by - exact (GaussianInt.intCast_re w).symm - have imagCoord (w : GaussianInt) : - (GaussianInt.toComplex w).im = (w.im : Real) := by - exact (GaussianInt.intCast_im w).symm constructor · rintro ⟨i, hi, hp⟩ rcases Finset.mem_image.mp hi with ⟨a, ha, hia⟩ @@ -188,17 +182,6 @@ private theorem translationBoundaryVertices (T : ProtoTile) (u : GaussianInt) : simpa [add_comm] using ha · intro hz exact ⟨z - u, hz, by simp⟩ - have imageMem (z : GaussianInt) : - (∃ a ∈ T.cells, a + u = z) ↔ z - u ∈ T.cells := cellMem z - have absentMem (z : GaussianInt) : - (∀ a ∈ T.cells, ¬a + u = z) ↔ z - u ∉ T.cells := by - constructor - · intro ha hz - obtain ⟨a, hca, heq⟩ := (cellMem z).mpr hz - exact ha a hca heq - · intro hz a ha heq - apply hz - exact (cellMem z).mp ⟨a, ha, heq⟩ have translatedCell (z : GaussianInt) : z ∈ (TileTranslation T u).cells ↔ z - u ∈ T.cells := by change z ∈ T.cells.image (GaussianTranslation u) ↔ z - u ∈ T.cells diff --git a/LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean b/LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean index 416ac23db8..2f80124fb1 100644 --- a/LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean +++ b/LeanPool/ApollonianSuperharmonic/TilingLatticeBasis.lean @@ -716,9 +716,6 @@ theorem TilingLatticeBasis (C : BandCircle) have determinant := VectorDeterminant successorQuad (SemiProperQuadruple.successor hq.1) (by simpa [successorQuad] using positive) have determinant_value := TilingBasisProof.determinant_value q determinant - let determinantNumber : Int := - (BandVectors.1 (q 1) (q 0)).re * (BandVectors.1 (q 2) (q 0)).im - - (BandVectors.1 (q 1) (q 0)).im * (BandVectors.1 (q 2) (q 0)).re have determinant_nonzero := TilingBasisProof.determinant_nonzero q relation positive determinant_value have coordinate_for := TilingBasisProof.coordinate_for q @@ -778,7 +775,6 @@ theorem TilingLatticeBasis (C : BandCircle) let ii : GaussianInt := ⟨0, 1⟩ have iiSquare := TilingBasisProof.iiSquareAt530 have hunit : -ii * ii = 1 := TilingBasisProof.hunitAt533 iiSquare - have hunit' : ii * (-ii) = 1 := by simpa [mul_comm] using hunit have image_tiling := TilingBasisProof.image_tiling C q flipA flipB lattice_le lattice_eq first_layout second_layout have layout_preimage := TilingBasisProof.layout_preimage C q flipA flipB first_mem diff --git a/LeanPool/ApollonianSuperharmonic/TilingLatticeInclusion.lean b/LeanPool/ApollonianSuperharmonic/TilingLatticeInclusion.lean index 2ce00db096..26e9d0f686 100644 --- a/LeanPool/ApollonianSuperharmonic/TilingLatticeInclusion.lean +++ b/LeanPool/ApollonianSuperharmonic/TilingLatticeInclusion.lean @@ -78,7 +78,6 @@ theorem TilingLatticeInclusion (C : BandCircle) : intro i obtain ⟨q, hq, j, hj⟩ := C.1.2.2 obtain ⟨a, b, ha, hb⟩ := parity q hq j - have hreal : (q j).1 = C.1.1.1 := by simp [hj] have hxr : C.1.1.2.re = 1 + 2 * a := by simpa [hj] using ha have hxi : C.1.1.2.im = 2 * b := by simpa [hj] using hb fin_cases i diff --git a/LeanPool/ApollonianSuperharmonic/TilingLatticeIndex.lean b/LeanPool/ApollonianSuperharmonic/TilingLatticeIndex.lean index b02ab2e6fa..538a396ebf 100644 --- a/LeanPool/ApollonianSuperharmonic/TilingLatticeIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/TilingLatticeIndex.lean @@ -445,34 +445,8 @@ theorem TilingLatticeIndex (C : BandCircle) : have determinant_value : Int.natAbs (a.re * b.im - a.im * b.re) = C.1.1.1.natAbs := TilingIndexProof.determinant_value C q hC successor_semi successor_positive have determinant_positive := TilingIndexProof.determinant_positive C q determinant_value - let f : (Fin 2 → ℤ) →ₗ[ℤ] K := - { toFun := fun x => ⟨x 0 • a + x 1 • b, - K.add_mem (K.zsmul_mem (AddSubgroup.subset_closure (by simp [])) (x 0)) - (K.zsmul_mem (AddSubgroup.subset_closure (by simp [])) (x 1))⟩ - map_add' := by - intro x y - apply Subtype.ext - simp [zsmul_eq_mul, Int.cast_add] - ring - map_smul' := by - intro n x - apply Subtype.ext - simp [zsmul_eq_mul, Int.cast_mul] - ring } have f_injective := TilingIndexProof.f_injective q determinant_positive have f_surjective := TilingIndexProof.f_surjective q - let coordinates : GaussianInt ≃ₗ[ℤ] (Fin 2 → ℤ) := - { toFun := fun z => ![z.re, z.im] - invFun := fun x => ⟨x 0, x 1⟩ - left_inv := by intro z; ext <;> simp - right_inv := by intro x; funext i; fin_cases i <;> simp - map_add' := by intro x y; funext i; fin_cases i <;> simp - map_smul' := by intro n x; funext i; fin_cases i <;> simp } - let e : (Fin 2 → ℤ) ≃ₗ[ℤ] K := - LinearEquiv.ofBijective f ⟨f_injective, f_surjective⟩ - let basisK : Module.Basis (Fin 2) ℤ K := (Pi.basisFun ℤ (Fin 2)).map e - let basisG : Module.Basis (Fin 2) ℤ GaussianInt := - Module.Basis.ofEquivFun coordinates have index_value : K.index = Int.natAbs (a.re * b.im - a.im * b.re) := TilingIndexProof.index_value q f_injective f_surjective have quotient_card : Nat.card (GaussianInt ⧸ K) = C.1.1.1.natAbs := by diff --git a/LeanPool/ApollonianSuperharmonic/TopologicalDiskLocallyPuncturedPreconnected.lean b/LeanPool/ApollonianSuperharmonic/TopologicalDiskLocallyPuncturedPreconnected.lean index d4b4d5ed5e..b2d7d77f27 100644 --- a/LeanPool/ApollonianSuperharmonic/TopologicalDiskLocallyPuncturedPreconnected.lean +++ b/LeanPool/ApollonianSuperharmonic/TopologicalDiskLocallyPuncturedPreconnected.lean @@ -259,11 +259,6 @@ theorem TopologicalDiskLocallyPuncturedPreconnected (U : Set S) (hU : U ∈ nhds z) : ∃ W ∈ nhds z, W ⊆ U ∧ IsConnected (W \ {z}) := by -- BODY - have punctured_rect_pathConnected - (a b d : Real × Real) (h1 : a.1 < b.1) (h2 : a.2 < b.2) - (hd : d ∈ Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2) : - IsPathConnected ((Set.Icc a.1 b.1 ×ˢ Set.Icc a.2 b.2) \ {d}) := - PuncturedDiskConstruction.punctured_rect_pathConnected a b d h1 h2 hd have disk_locally_punctured_preconnected (d : Metric.closedBall (0 : Real × Real) 1) (V₀ : Set (Metric.closedBall (0 : Real × Real) 1)) (hV₀ : V₀ ∈ nhds d) : diff --git a/LeanPool/ApollonianSuperharmonic/TriangularStripSegmentOrderInterval.lean b/LeanPool/ApollonianSuperharmonic/TriangularStripSegmentOrderInterval.lean index 85d0b45c75..ec55055bc4 100644 --- a/LeanPool/ApollonianSuperharmonic/TriangularStripSegmentOrderInterval.lean +++ b/LeanPool/ApollonianSuperharmonic/TriangularStripSegmentOrderInterval.lean @@ -218,9 +218,6 @@ private theorem trim_property : have hqb : q ≠ b := by intro hqb subst q - have hlast_mem : b ∈ (d :: s) := by - apply List.mem_of_getLast? - exact htail have hdup : d :: s = (d :: s).dropLast ++ [b] := (List.dropLast_append_getLast? b (by simpa using htail)).symm rw [hdup] at htail_nodup @@ -320,12 +317,6 @@ theorem TriangularStripSegmentOrderInterval exact List.mem_of_getLast? hdata.2.1 obtain ⟨m, hm⟩ := order.surjective ⟨x, hdata.2.2.2.1 x hxmem⟩ obtain ⟨n, hn⟩ := order.surjective ⟨y, hdata.2.2.2.1 y hymem⟩ - have hmn : m ≠ n := by - intro he - apply hxy - have hh : (⟨x, _⟩ : {z : Int × Int // TriangularBoundaryStrip x y z}) = - ⟨y, _⟩ := hm.symm.trans ((congrArg order he).trans hn) - exact congrArg Subtype.val hh have walk : ∀ (p : List Int) (a b : Int), p.head? = some a → p.getLast? = some b → p.Nodup → p.IsChain (fun u v : Int => v = u + 1 ∨ u = v + 1) → From ce59cd59586f3bb117b072bd243453987c936b8f Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 13 Nov 2026 11:34:59 +0000 Subject: [PATCH 17/23] Generalize touching-to-bordering to nonempty tiles --- .../BandTileTopologyApplication.lean | 53 +++++-------------- 1 file changed, 12 insertions(+), 41 deletions(-) diff --git a/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean index 76fe05520f..a14c7dd2d0 100644 --- a/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean +++ b/LeanPool/ApollonianSuperharmonic/BandTileTopologyApplication.lean @@ -78,40 +78,9 @@ private theorem hnonempty : have hp : 0 < Int.toNat (q 0).1 := by omega omega -private theorem border_touch : - (by - classical - exact - ∀ (C : BandCircle), - ∀ (q : Fin 4 → CircleCoordinates), - ∀ (T : ProtoTile), - ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), - (∀ (u : ↥(TilingLattice C)), - P.tile u = TileTranslation T (↑u : GaussianInt)) → - ∀ - [Nonempty - (AffineTriangularComplexChart P fun (mn : ℤ × ℤ) => - TileTranslation T - ((↑mn.1 : GaussianInt) * - BandVectors.1 (q (1 : Fin (4 : ℕ))) - (q (0 : Fin (4 : ℕ))) + - (↑mn.2 : GaussianInt) * - BandVectors.1 (q (2 : Fin (4 : ℕ))) - (q (0 : Fin (4 : ℕ)))))], - RegularTileFamily T (TilingLattice C) = Set.range P.tile → - TileTranslation T 0 = T → - TileArea T = (q (0 : Fin (4 : ℕ))).1.toNat → - (∀ (x : GaussianInt), (TileTranslation T x).cells.Nonempty) → - ∀ (U : ProtoTile), - U ∈ RegularTileFamily T (TilingLattice C) → - U ≠ T → TileTouching T U → TileBordering T U - ) := by - classical - intro C q T P htile hchart family_eq translate_zero harea hnonempty U hU hneq - obtain ⟨a, ha, hua⟩ := RegularTileFamilyTranslationUnique T - (TilingLattice C) U hU - have hUform : U = TileTranslation T (a : GaussianInt) := ha - rw [hUform] +private theorem border_touch (T U : ProtoTile) + (hT : T.cells.Nonempty) (hU : U.cells.Nonempty) : + TileTouching T U → TileBordering T U := by intro ht rcases ht with ht | ht | ht · exact ⟨ht.2.2.1, by @@ -125,8 +94,8 @@ private theorem border_touch : refine ⟨{x, y}, ?_⟩ rw [hed] exact ⟨x, y, [], p, by simp⟩⟩ - · exact False.elim ((hnonempty 0).ne_empty (by simpa [translate_zero] using ht.1)) - · exact False.elim ((hnonempty (a : GaussianInt)).ne_empty ht.1) + · exact False.elim (hT.ne_empty ht.1) + · exact False.elim (hU.ne_empty ht.1) private theorem border_iff_index : (by @@ -601,7 +570,7 @@ theorem BandTileTopologyApplication (C : BandCircle) TileBordering T U} = 6 := by -- BODY classical - obtain ⟨P, hPlattice, htile, hadj, hpos, hv, he, hf, hchart⟩ := + obtain ⟨P, _, htile, hadj, _, _, _, _, _⟩ := BandRegularTranslatePeriodicComplex C q hq hqC T hT have family_eq : RegularTileFamily T (TilingLattice C) = Set.range P.tile := TileTopologyGeometry.family_eq C T P htile @@ -620,10 +589,12 @@ theorem BandTileTopologyApplication (C : BandCircle) have hnonempty (x : GaussianInt) : (TileTranslation T x).cells.Nonempty := TileTopologyGeometry.hnonempty q T hpositive harea x - have border_touch (U : ProtoTile) (hU : U ∈ RegularTileFamily T (TilingLattice C)) - (hneq : U ≠ T) : TileTouching T U → TileBordering T U := - @TileTopologyGeometry.border_touch C q T P htile hchart family_eq translate_zero harea - hnonempty U hU hneq + have border_touch (U : ProtoTile) (hU : U ∈ RegularTileFamily T (TilingLattice C)) : + U ≠ T → TileTouching T U → TileBordering T U := by + obtain ⟨a, _, rfl⟩ := hU + intro _ + exact TileTopologyGeometry.border_touch T (TileTranslation T a) + (by simpa only [translate_zero] using hnonempty 0) (hnonempty a) have border_iff_index (a : TilingLattice C) (ha0 : a ≠ 0) : TileBordering T (P.tile a) ↔ ∃ j : Fin 3, (a : GaussianInt) = BandVectors.1 (q j.succ) (q 0) ∨ From bafbfebaac87a48c1ea76d4929ead6cb46fecb92 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 13 Nov 2026 13:20:55 +0000 Subject: [PATCH 18/23] Share tile-string construction and remove unused geometric setup --- ...eralSubtileInterfaceCertificateExists.lean | 117 +---- LeanPool/ApollonianSuperharmonic/Imports.lean | 1 + .../P3497T1SingleStraightDeletion.lean | 35 +- .../P3511T1LeafOrder.lean | 1 - .../P3650T1CyclicChildrenExists.lean | 15 - .../P3821T1ControlledNeighborhood.lean | 44 +- .../P4458T1LargestParentRows.lean | 125 +---- .../P4458T1SecondNewerRows.lean | 132 +---- .../P4909T1LineFan.lean | 460 ++---------------- .../P5110T1SquareInterface.lean | 237 +-------- .../P5596T1LeftWeb.lean | 122 +---- .../TileStringPair.lean | 64 +++ 12 files changed, 147 insertions(+), 1206 deletions(-) create mode 100644 LeanPool/ApollonianSuperharmonic/TileStringPair.lean diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean index 56eb892e75..6cff9ddb54 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean @@ -601,55 +601,6 @@ private theorem hfixedCent : intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing simpa [Q, incoming, outgoing] using normalization.normalized_adjacency_centroid -private theorem hcentUF : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), - let Q := normalization.normalizedPresentation - let incoming : Fin 3 → GaussianInt := fun j => - BandVectors.1 (Q j.succ) (Q 0) - let outgoing : Fin 3 → GaussianInt := fun j => - BandVectors.1 (Q 0) (Q j.succ) - let uIndex : PeriodicSubtileIndex := - if normalization.normalizedParentSlot = 0 then - if normalization.normalizedQuarterTurn = 0 then ⟨.A, 0, -1⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.B, 1, 1⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.B, 0, 1⟩ - else ⟨.A, -1, -1⟩ - else if normalization.normalizedParentSlot = 1 then - if normalization.normalizedQuarterTurn = 0 then ⟨.C, 1, 1⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.D, -1, 0⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.D, -1, -1⟩ - else ⟨.C, 1, 0⟩ - else if normalization.normalizedQuarterTurn = 0 then ⟨.E, -1, 0⟩ - else if normalization.normalizedQuarterTurn = 1 then ⟨.F, 0, -1⟩ - else if normalization.normalizedQuarterTurn = 2 then ⟨.F, 1, 0⟩ - else ⟨.E, 0, 1⟩ - let U := SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v uIndex - (TileCentroid U - TileCentroid normalization.normalizedRoot = (1 / 2 : Real) • - GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ normalization.normalizedQuarterTurn.val * - (incoming normalization.normalizedParentSlot + outgoing - normalization.normalizedParentSlot))) → ((TileCentroid normalization.normalizedFixed - - TileCentroid normalization.normalizedRoot = (1 / 2 : Real) • GaussianRealPoint - ((⟨0, 1⟩ : GaussianInt) ^ normalization.normalizedQuarterTurn.val * (incoming - normalization.normalizedParentSlot + outgoing normalization.normalizedParentSlot))) → - (TileCentroid U = TileCentroid normalization.normalizedFixed)) ) := by - classical - intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q incoming outgoing uIndex U hUcent hfixedCent - calc - TileCentroid U = - (TileCentroid U - TileCentroid normalization.normalizedRoot) + - TileCentroid normalization.normalizedRoot := by abel - _ = (TileCentroid normalization.normalizedFixed - - TileCentroid normalization.normalizedRoot) + - TileCentroid normalization.normalizedRoot := by rw [hUcent, hfixedCent] - _ = TileCentroid normalization.normalizedFixed := by abel - private theorem hrow' : (by classical @@ -1238,60 +1189,6 @@ private theorem hVbarCent : apply Zsqrtd.ext <;> simp [hf1, notEven3, Fin.sub_def, pow_succ] <;> ring -private theorem hEndpoints : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), - let Q := normalization.normalizedPresentation - ∀ (uIndex : PeriodicSubtileIndex), ∀ (V : ProtoTile), ∀ (W : ProtoTile), - let source := SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v uIndex - ∀ (incomingRaw : ExactTileInterfaceTriple normalization.normalizedRoot (TileTranslation - normalization.normalizedRoot ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ - (↑normalization.normalizedQuarterTurn : ℕ) * if Even - (↑normalization.normalizedQuarterTurn : ℕ) then BandVectors.1 (Q - normalization.normalizedParentSlot.succ) (Q (0 : Fin (4 : ℕ))) else BandVectors.1 (Q - (0 : Fin (4 : ℕ))) (Q normalization.normalizedParentSlot.succ))) source), ∀ (t5Data : - ExactTileInterfaceTriple normalization.normalizedRoot source V), (incomingRaw.otherCA - = t5Data.point) → ((t5Data.otherAB = incomingRaw.point) → (∀ (hWExact : W = - TileTranslation normalization.normalizedRoot ((⟨0, 1⟩ : GaussianInt) ^ - normalization.normalizedQuarterTurn.val * (if Even - normalization.normalizedQuarterTurn.val then BandVectors.1 (Q - normalization.normalizedParentSlot.succ) (Q 0) else BandVectors.1 (Q 0) (Q - normalization.normalizedParentSlot.succ)))), - let incomingData : ExactTileInterfaceTriple - normalization.normalizedRoot W source := hWExact.symm ▸ incomingRaw - (incomingData.point = incomingRaw.point) → ((incomingData.otherCA = incomingRaw.otherCA) - → (∀ (startSource : ExactTileInterfaceTriple normalization.normalizedRoot source W), - (startSource.point = incomingData.point) → ((startSource.otherAB = - incomingData.otherCA) → (∀ (startData : ExactTileInterfaceTriple - normalization.normalizedRoot normalization.normalizedFixed W), (startData.point = - startSource.point) → ((startData.otherAB = startSource.otherAB) → (∀ (endData : - ExactTileInterfaceTriple normalization.normalizedRoot normalization.normalizedFixed - V), (endData.point = t5Data.point) → ((endData.otherAB = t5Data.otherAB) → - (endData.point = startData.otherAB ∧ endData.otherAB = startData.point)))))))))) ) := by - classical - intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization Q uIndex V W source incomingRaw t5Data - hincomingOther ht5Other hWExact incomingData hincomingPoint hincomingOtherCA startSource - hswapPoint hswapOtherAB startData hstartPoint hstartOtherAB endData hendPoint hendOtherAB - constructor - · calc - endData.point = t5Data.point := hendPoint - _ = incomingRaw.otherCA := hincomingOther.symm - _ = incomingData.otherCA := hincomingOtherCA.symm - _ = startSource.otherAB := hswapOtherAB.symm - _ = startData.otherAB := hstartOtherAB.symm - · calc - endData.otherAB = t5Data.otherAB := hendOtherAB - _ = incomingRaw.point := ht5Other - _ = incomingData.point := hincomingPoint.symm - _ = startSource.point := hswapPoint.symm - _ = startData.point := hstartPoint.symm - end SubtileInterfaceAssembly namespace SubtileInterfaceRowPackage @@ -1597,8 +1494,8 @@ private theorem rowPackage : have hfixedEq := BandPrototileCentroidUnique (Q normalization.normalizedParentSlot.succ) U normalization.normalizedFixed hUBand (SubtileInterfaceAssembly.hFixedBand C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization) - (SubtileInterfaceAssembly.hcentUF C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization hUcent - (SubtileInterfaceAssembly.hfixedCent C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization)) + (sub_left_inj.mp (hUcent.trans + (SubtileInterfaceAssembly.hfixedCent C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization).symm)) refine ⟨W, V, g, wShift, uIndex, uBar, vIndex, vBar, wBlock, (SubtileInterfaceAssembly.hrow' C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization), hfixedEq.1.symm, rfl, rfl, rfl, hrootBar, ?_, ?_, ?_, @@ -1870,10 +1767,12 @@ private theorem subtileInterfaceCertificate : startData := startData endData := endData normalized_point_on_start_path := ⟨hPointRoot, hPointFixed⟩ - interface_endpoints := (SubtileInterfaceAssembly.hEndpoints C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x - normalization uIndex V W incomingRaw t5Data hincomingOther ht5Other hWExact - hincomingPoint hincomingOtherCA startSource hswapPoint hswapOtherAB startData - hstartPoint hstartOtherAB endData hendPoint hendOtherAB) + interface_endpoints := (by + constructor + · exact hendPoint.trans (hincomingOther.symm.trans (hincomingOtherCA.symm.trans + (hswapOtherAB.symm.trans hstartOtherAB.symm))) + · exact hendOtherAB.trans (ht5Other.trans (hincomingPoint.symm.trans + (hswapPoint.symm.trans hstartPoint.symm)))) root_lattice := hRootLattice fixed_lattice := hFixedLattice start_lattice := hWLattice diff --git a/LeanPool/ApollonianSuperharmonic/Imports.lean b/LeanPool/ApollonianSuperharmonic/Imports.lean index c4a83526f0..7f211e0219 100644 --- a/LeanPool/ApollonianSuperharmonic/Imports.lean +++ b/LeanPool/ApollonianSuperharmonic/Imports.lean @@ -1250,6 +1250,7 @@ public import LeanPool.ApollonianSuperharmonic.TileString public import LeanPool.ApollonianSuperharmonic.TileStringCentralCovariance public import LeanPool.ApollonianSuperharmonic.TileStringCoordinateTransport public import LeanPool.ApollonianSuperharmonic.TileStringExists +public import LeanPool.ApollonianSuperharmonic.TileStringPair public import LeanPool.ApollonianSuperharmonic.TileStringRegularFamilyCentralCovariance public import LeanPool.ApollonianSuperharmonic.TileStringUnique public import LeanPool.ApollonianSuperharmonic.TileSubodometer diff --git a/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean b/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean index b16b1ab2c5..bdc105d4d5 100644 --- a/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean @@ -709,7 +709,6 @@ private noncomputable abbrev q (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i have hsigSucc (k : Fin L) (hk : k.val ≠ 0) : sig (k + 1) = sig k + 1 := hsigSucc n k hk let r : Fin M → Real × Real := fun h => p.vertex (rot h) - have ha : r 0 ≠ r 1 := ha n p i have oldInt (a b : Fin M) (hab : a ≠ b) : segment Real (r a) (r (a + 1)) ∩ segment Real (r b) (r (b + 1)) = {x | (x = r a ∨ x = r (a + 1)) ∧ (x = r b ∨ x = r (b + 1))} := oldInt n p i a b hab @@ -756,9 +755,6 @@ private noncomputable abbrev q (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i private noncomputable def boundarySubdivision {n : Nat} (p : P3381T1PolygonBoundary (n + 1)) (i : Fin ((n + 1) + 3)) - (hdet : P3381T1TriangleDeterminant (fun j : Fin 3 => - p.vertex (i + ⟨j.val, Nat.lt_of_lt_of_le j.isLt - (Nat.le_add_left 3 (n + 1))⟩)) = 0) (t : Real) (ht0 : 0 < t) (ht1 : t < 1) (hsplice : r n p i 1 = (1 - t) • r n p i 0 + t • r n p i 2) (hunion : segment Real (r n p i 0) (r n p i 1) ∪ @@ -773,40 +769,17 @@ private noncomputable def boundarySubdivision {n : Nat} (p : P3381T1PolygonBound ⟨if k.val = 0 then 0 else k.val + 1, by split_ifs <;> omega⟩ have hM : 4 ≤ M := StraightDeletionConstruction.hM n have hM1 : 1 < M := StraightDeletionConstruction.hM1 n - have hM2 : 2 < M := StraightDeletionConstruction.hM2 n - have hM3 : 3 < M := StraightDeletionConstruction.hM3 n - have hL1 : 1 < L := StraightDeletionConstruction.hL1 n - have hLM : L + 1 = M := StraightDeletionConstruction.hLM n have hrot : Function.Injective rot := StraightDeletionConstruction.hrot n i have hsig : Function.Injective sig := StraightDeletionConstruction.hsig n have hrotSucc (h : Fin M) : rot (h + 1) = rot h + 1 := StraightDeletionConstruction.hrotSucc n i h - have hsigSucc (k : Fin L) (hk : k.val ≠ 0) : - sig (k + 1) = sig k + 1 := StraightDeletionConstruction.hsigSucc n k hk let r : Fin M → Real × Real := fun h => p.vertex (rot h) - have hr : Function.Injective r := StraightDeletionConstruction.hr n p i - have ha : r 0 ≠ r 1 := StraightDeletionConstruction.ha n p i - have hbc : r 1 ≠ r 2 := StraightDeletionConstruction.hbc n p i - have hac : r 0 ≠ r 2 := StraightDeletionConstruction.hac n p i - have hdet' : P3381T1TriangleDeterminant ![r 0, r 1, r 2] = 0 := - StraightDeletionConstruction.hdet' n p i hdet - have hint : segment Real (r 0) (r 1) ∩ segment Real (r 1) (r 2) = {r 1} := - StraightDeletionConstruction.hint n p i - have oldInt (a b : Fin M) (hab : a ≠ b) : - segment Real (r a) (r (a + 1)) ∩ segment Real (r b) (r (b + 1)) = - {x | (x = r a ∨ x = r (a + 1)) ∧ (x = r b ∨ x = r (b + 1))} := - StraightDeletionConstruction.oldInt n p i a b hab - have rEq (a b : Fin M) : r a = r b ↔ a = b := StraightDeletionConstruction.rEq n p i a b have sig0 : sig (0 : Fin L) = 0 := StraightDeletionConstruction.sig0 n - have hval1L : (1 : Fin L).val = 1 := StraightDeletionConstruction.hval1L n - have hval2M : (2 : Fin M).val = 2 := StraightDeletionConstruction.hval2M n have hmod1M : 1 % M = 1 := StraightDeletionConstruction.hmod1M n have hmod2M : 2 % M = 2 := StraightDeletionConstruction.hmod2M n - have hmod3M : 3 % M = 3 := StraightDeletionConstruction.hmod3M n have new01 : (0 : Fin L) + 1 = 1 := StraightDeletionConstruction.new01 n have sig1 : sig (1 : Fin L) = 2 := StraightDeletionConstruction.sig1 n have old01 : (0 : Fin M) + 1 = 1 := StraightDeletionConstruction.old01 n have old12 : (1 : Fin M) + 1 = 2 := StraightDeletionConstruction.old12 n - have old23 : (2 : Fin M) + 1 = 3 := StraightDeletionConstruction.old23 n have qedge0 : segment Real (r (sig 0)) (r (sig (0 + 1))) = segment Real (r 0) (r 2) := StraightDeletionConstruction.qedge0 n p i have qedgePos (k : Fin L) (hk : k.val ≠ 0) : @@ -829,12 +802,6 @@ private noncomputable def boundarySubdivision {n : Nat} (p : P3381T1PolygonBound col (h + 1) = col h + 1 := StraightDeletionConstruction.colSucc n h hh have invSucc (j : Fin M) : invrot (j + 1) = invrot j + 1 := StraightDeletionConstruction.invSucc n i j - have firstInt (c : Fin L) (hc : c.val ≠ 0) : - segment Real (r (sig 0)) (r (sig (0 + 1))) ∩ - segment Real (r (sig c)) (r (sig (c + 1))) = - {x | (x = r (sig 0) ∨ x = r (sig (0 + 1))) ∧ - (x = r (sig c) ∨ x = r (sig (c + 1)))} := StraightDeletionConstruction.firstInt n p i - hunion c hc let q : P3381T1PolygonBoundary n := StraightDeletionConstruction.q n p i hunion change r 1 = (1 - t) • r 0 + t • r 2 at hsplice change segment Real (r 0) (r 1) ∪ segment Real (r 1) (r 2) = @@ -1063,7 +1030,7 @@ theorem P3497T1SingleStraightDeletion {n : Nat} (StraightDeletionConstruction.hbc n p i) (StraightDeletionConstruction.hdet' n p i hdet) (StraightDeletionConstruction.hint n p i) refine ⟨StraightDeletionConstruction.q n p i hunion, ?_, - ⟨StraightDeletionConstruction.boundarySubdivision p i hdet t ht0 ht1 hsplice hunion⟩⟩ + ⟨StraightDeletionConstruction.boundarySubdivision p i t ht0 ht1 hsplice hunion⟩⟩ intro k rfl diff --git a/LeanPool/ApollonianSuperharmonic/P3511T1LeafOrder.lean b/LeanPool/ApollonianSuperharmonic/P3511T1LeafOrder.lean index 4ac81e95af..18434ce70a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3511T1LeafOrder.lean +++ b/LeanPool/ApollonianSuperharmonic/P3511T1LeafOrder.lean @@ -132,7 +132,6 @@ private theorem supported {α : Type} {l : List α} {fs : List (Face α)} private noncomputable abbrev Shell {α : Type} (fs : List (Face α)) : Prop := by classical - let Face (α : Type) := Fin 3 → α exact ∀ pre f post, fs = pre ++ f :: post → pre ≠ [] → ∃ a b c : α, a ≠ b ∧ a ≠ c ∧ b ≠ c ∧ Set.range f = {a, b, c} ∧ (∀ g ∈ pre, c ∉ Set.range g) ∧ diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean b/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean index 03b2b16d93..bed651d81b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1CyclicChildrenExists.lean @@ -469,7 +469,6 @@ private noncomputable abbrev il (n : Nat) (a : Fin (n + 3)) (b : Fin (n + 3)) (h let N := n + 3 let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) @@ -1537,22 +1536,16 @@ private noncomputable abbrev leftPoly (n : Nat) (p : P3381T1PolygonBoundary n) ( let N := n + 3 let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b have hkle : k + 2 ≤ N := hkle n a b hprev let root : List (Fin N) := List.ofFn (fun i : Fin N => i) have hrootlen : root.length = N := hrootlen n let leftN := k - 2 - let rightN := N - k - 2 have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev let il : Fin (leftN + 3) → Fin N := fun i => rot ⟨i.val, by rw [hleftLen] at i; omega⟩ - let posR : Fin (rightN + 3) → Nat := fun i => - if i.val = N - k then 0 else k + i.val - have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i have hleft_inj : Function.Injective il := hleft_inj n a b hab hnext hprev have hik : k < leftN + 3 := hik n a b hab hnext hprev let ik : Fin (leftN + 3) := ⟨k, hik⟩ - have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev have hleft_old_old (i j : Fin (leftN + 3)) (hi : i.val < k) (hj : j.val < k) (hij : i ≠ j) : segment Real (p.vertex (il i)) (p.vertex (il (i + 1))) ∩ @@ -1617,21 +1610,13 @@ private noncomputable abbrev rightPoly (n : Nat) (p : P3381T1PolygonBoundary n) let N := n + 3 let rot : Fin N → Fin N := fun i => a + i let k : Nat := (b.val + N - a.val) % N - have hklt : k < N := hklt n a b - have hkv : k = if a.val ≤ b.val then b.val - a.val else b.val + N - a.val := hkv n a b - have hkle : k + 2 ≤ N := hkle n a b hprev - let root : List (Fin N) := List.ofFn (fun i : Fin N => i) - have hrootlen : root.length = N := hrootlen n - let leftN := k - 2 let rightN := N - k - 2 - have hleftLen : leftN + 3 = k + 1 := hleftLen n a b hab hnext hprev have hrightLen : rightN + 3 = N - k + 1 := hrightLen n a b hab hnext hprev let posR : Fin (rightN + 3) → Nat := fun i => if i.val = N - k then 0 else k + i.val have hposRlt (i : Fin (rightN + 3)) : posR i < N := hposRlt n a b hab hnext hprev i let ir : Fin (rightN + 3) → Fin N := fun i => rot ⟨posR i, hposRlt i⟩ have hright_inj : Function.Injective ir := hright_inj n a b hab hnext hprev - have hik : k < leftN + 3 := hik n a b hab hnext hprev have hlastRlt : N - k < rightN + 3 := hlastRlt n a b hab hnext hprev let lastR : Fin (rightN + 3) := ⟨N - k, hlastRlt⟩ have hright_old_old (i j : Fin (rightN + 3)) (hi : i.val < N - k) diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean index eea5d5899b..28a49ec6b8 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean @@ -762,46 +762,10 @@ private noncomputable abbrev phiVal (e : C(Circle, ℂ)) (he : Function.Injectiv (heps : 0 < eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) : (N e eps S η hSf) → Circle := by - classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) - let ψ : Set.range e → Circle := f.symm - let u : Set.range e → ℂ := fun k => (ψ k : ℂ) - let δ := min (δ₀ / 4) (1 / 8) - have hδpos : 0 < δ := hδpos δ₀ hδ₀ - have hδlt : δ < 1 / 4 := hδlt δ₀ hδ₀ - let r := min (η / 8) (eps / 8) - have hrpos : 0 < r := hrpos eps heps η hη - have hψclose : ∀ k l : Set.range e, dist k l < 4 * r → - dist ((ψ k : Circle) : ℂ) ((ψ l : Circle) : ℂ) < δ := hψclose e he eps heps δ₀ η hη hηψ - let F : Finset (Set.range e) := hSf.toFinset - let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) - let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z - let N : Set ℂ := {z | 0 < W z} - let a : N → Set.range e → ℝ := fun z c => w c (z : ℂ) / W (z : ℂ) - let v : N → ℂ := fun z => ∑ c ∈ F, (a z c : ℂ) * u c - have hactive (z : N) : ∃ i ∈ F, 0 < w i (z : ℂ) := hactive e eps S η hSf z - have hw_active_dist (z : N) (c : Set.range e) (hc : 0 < w c (z : ℂ)) : - dist (z : ℂ) (c : ℂ) < 2 * r := hw_active_dist e eps S η hSf z c hc - have ha_nonneg (z : N) (c : Set.range e) : 0 ≤ a z c := ha_nonneg e eps S η hSf z c - have hsum_a (z : N) : (∑ c ∈ F, a z c) = 1 := hsum_a e eps S η hSf z - have hv_close (z : N) (i : Set.range e) (hi : i ∈ F) - (hwi : 0 < w i (z : ℂ)) : ‖v z - u i‖ < δ := hv_close e he eps heps S δ₀ η hSf hη hδ₀ hηψ z - i hi hwi - have hunit (c : Set.range e) : ‖u c‖ = 1 := hunit e he c - have hv_lower (z : N) : 1 - δ < ‖v z‖ := hv_lower e he eps heps S δ₀ η hSf hη hδ₀ hηψ z - have hv_pos (z : N) : 0 < ‖v z‖ := hv_pos e he eps heps S δ₀ η hSf hη hδ₀ hηψ z - let p : N → ℂ := fun z => v z / (‖v z‖ : ℂ) - have hp_norm (z : N) : ‖p z‖ = 1 := hp_norm e he eps heps S δ₀ η hSf hη hδ₀ hηψ z - dsimp only [ControlledNeighborhoodConstruction.N] at * - change (N → Circle) - exact fun z => ⟨p z, (mem_sphere_zero_iff_norm).2 (hp_norm z)⟩ + exact fun z => + ⟨p e he eps S η hSf z, + (mem_sphere_zero_iff_norm).2 (hp_norm e he eps heps S δ₀ η hSf hη hδ₀ hηψ z)⟩ + private theorem hp_cont (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) (hηψ diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean index ab9ee65a46..8d627aea2d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileStringPair public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.BoundaryFrameJoinGeometry public import LeanPool.ApollonianSuperharmonic.BoundaryFrameRowGeometry @@ -1335,122 +1336,6 @@ private theorem hrightNe : · exact hPnonempty.ne_empty h.1 · exact hPnonempty.ne_empty h.1 -private theorem leftString : - (by - classical - exact - ∀ (C : BandCircle), - ∀ (orientation : Bool), - ∀ (base : ProtoTile), - ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), - ∀ (hminus : PartialOdometer), - ∀ (hplus : PartialOdometer), - ∀ - (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus - hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q (F.slot + 1).succ, - F.q (F.slot + 2).succ]; - let y : GaussianInt := BandVectors.1 (r 2) (r 1); - ∀ (u : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y); - join ∈ RegularTileFamily base (TilingLattice C) → - TileTouching Rminus join → - Rminus ≠ join → - C.1.1.1 ≠ 1 → - TileString C orientation base Rminus join [Rminus, join] - ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r y u join hjoinFamily hleftTouch hleftNe - hnonunit - unfold TileString - refine ⟨F.base_band, ?_, ?_, ?_, ?_, ?_, ?_⟩ - · rfl - · rfl - · simpa using hleftNe - · intro T hT - simp only [List.mem_cons] at hT - rcases hT with hT | hT - · rcases hT with rfl - exact F.minus_family - · rcases hT with hT | hT - · rcases hT with rfl - exact hjoinFamily - · simp at hT - · simpa [List.IsChain, List.isChain_pair, hnonunit] using hleftTouch - · intro pre T post heq hpre hpost - have hlen := congrArg List.length heq - have hp : 1 ≤ pre.length := by - cases pre with - | nil => simp at hpre - | cons x xs => simp - have hq : 1 ≤ post.length := by - cases post with - | nil => simp at hpost - | cons x xs => simp - simp at hlen - omega - -private theorem rightString : - (by - classical - exact - ∀ (C : BandCircle), - ∀ (orientation : Bool), - ∀ (base : ProtoTile), - ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), - ∀ (hminus : PartialOdometer), - ∀ (hplus : PartialOdometer), - ∀ - (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus - hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q (F.slot + 1).succ, - F.q (F.slot + 2).succ]; - let y : GaussianInt := BandVectors.1 (r 2) (r 1); - ∀ (u : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y); - join ∈ RegularTileFamily base (TilingLattice C) → - TileTouching join Rplus → - join ≠ Rplus → - C.1.1.1 ≠ 1 → - TileString C orientation base join Rplus [join, Rplus] - ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r y u join hjoinFamily hrightTouch - hrightNe hnonunit - unfold TileString - refine ⟨F.base_band, ?_, ?_, ?_, ?_, ?_, ?_⟩ - · rfl - · rfl - · simpa using hrightNe - · intro T hT - simp only [List.mem_cons] at hT - rcases hT with hT | hT - · rcases hT with rfl - exact hjoinFamily - · rcases hT with hT | hT - · rcases hT with rfl - exact F.plus_family - · simp at hT - · simpa [List.IsChain, List.isChain_pair, hnonunit] using hrightTouch - · intro pre T post heq hpre hpost - have hlen := congrArg List.length heq - have hp : 1 ≤ pre.length := by - cases pre with - | nil => simp at hpre - | cons x xs => simp - have hq : 1 ≤ post.length := by - cases post with - | nil => simp at hpost - | cons x xs => simp - simp at hlen - omega - end LargestParentGeometry namespace LargestParentConclusion @@ -2111,12 +1996,12 @@ private theorem largestParentCertificate : have hrightNe := LargestParentGeometry.hrightNe C orientation base Rminus Rplus hminus hplus F u hrightTouch hPnonempty have hnonunit : C.1.1.1 ≠ 1 := by omega - have leftString := LargestParentGeometry.leftString C orientation base Rminus Rplus hminus - hplus F u hjoinFamily hleftTouch hleftNe hnonunit + have leftString := TileStringPairOfNonunit C orientation base Rminus join F.base_band + F.minus_family hjoinFamily hleftNe hnonunit hleftTouch refine ⟨⟨join, hjoinCells.1.symm, hjoinOdo, hjoinAncestor, hjoinOccurrence, .direct leftString hleftAdjacent, - .direct (LargestParentGeometry.rightString C orientation base Rminus Rplus hminus hplus F u - hjoinFamily hrightTouch hrightNe hnonunit) hrightAdjacent⟩⟩ + .direct (TileStringPairOfNonunit C orientation base join Rplus F.base_band + hjoinFamily F.plus_family hrightNe hnonunit hrightTouch) hrightAdjacent⟩⟩ end LargestParentConclusion diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean index b985990631..941e689bfd 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileStringPair public import LeanPool.ApollonianSuperharmonic.BandPrototileNonempty public import LeanPool.ApollonianSuperharmonic.BoundaryFrameJoinGeometry public import LeanPool.ApollonianSuperharmonic.BoundaryFrameRowGeometry @@ -1082,124 +1083,6 @@ private theorem hnonunit : rw [← hcurvEq] exact ne_of_gt hrootlarge -private theorem leftString : - (by - classical - exact - ∀ (C : BandCircle), - ∀ (orientation : Bool), - ∀ (base : ProtoTile), - ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), - ∀ (hminus : PartialOdometer), - ∀ (hplus : PartialOdometer), - ∀ - (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus - hplus), - ∀ (D : P4458T1RestrictionFamily F), - ∀ (a : Fin (3 : ℕ)), - ∀ (p : Fin (4 : ℕ) → CircleCoordinates), - ProperBandQuadruple p → - (F.slot = a + (1 : Fin (3 : ℕ)) → - C.1.1.1 = (1 : ℤ) → - UnitOccurrenceOrientation p (1 : Fin (3 : ℕ)) - orientation) → - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q (F.slot + 1).succ, - F.q (F.slot + 2).succ]; - let I : GaussianInt := ⟨0, 1⟩; - let x : GaussianInt := BandVectors.1 (r 1) (r 3); - let y : GaussianInt := BandVectors.1 (r 2) (r 1); - BandVectors.1 (r 1) (r 0) = x - I * y → - BandVectors.1 (r 0) (r 1) = - I * BandVectors.1 (r 1) (r 0) → - TileCentroid Rminus - TileCentroid F.tile = - (1 / 2 : ℝ) • - GaussianRealPoint - (BandVectors.1 (r 1) (r 0) - BandVectors.1 (r 0) (r 1)) → - TileCentroid (D.tiles F.slot false) - - TileCentroid Rminus = - GaussianRealPoint y → - ∀ (u : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y); - join ∈ RegularTileFamily base (TilingLattice C) → - TileCentroid (D.tiles F.slot false) = TileCentroid join → - TileOdometer C.1.1 join (D.functions F.slot false) → - ∀ (joinSlope : ℝ × ℝ), - PartialOdometerSlope (D.functions F.slot false) = - some joinSlope → - F.slot = a + (1 : Fin (3 : ℕ)) → - ∀ (aSlope : ℝ × ℝ), - PartialOdometerSlope (D.functions a true) = some aSlope → - p (2 : Fin (4 : ℕ)) = C.1.1 → - TileOdometer (p (0 : Fin (4 : ℕ))) (D.tiles a true) - (D.functions a true) → - BandPrototile (p (0 : Fin (4 : ℕ))) (D.tiles a true) → - BandVectors.1 (p (2 : Fin (4 : ℕ))) - (p (0 : Fin (4 : ℕ))) = - x → - BandVectors.1 (p (0 : Fin (4 : ℕ))) - (p (2 : Fin (4 : ℕ))) = - I * x → - Fin.succ (1 : Fin (3 : ℕ)) = - (2 : Fin ((3 : ℕ) + (1 : ℕ))) → - TileCentroid (D.tiles a true) - TileCentroid F.tile = - (1 / 2 : ℝ) • - (GaussianRealPoint y - - (-(GaussianRealPoint y).2, (GaussianRealPoint y).1)) → - joinSlope - aSlope = - (1 / 2 : ℝ) • - GaussianRealPoint - (BandVectors.2 (p (2 : Fin (4 : ℕ))) - (p (0 : Fin (4 : ℕ))) - - BandVectors.2 (p (0 : Fin (4 : ℕ))) - (p (2 : Fin (4 : ℕ)))) → - F.plusSlope - aSlope = - (1 / 2 : ℝ) • - GaussianRealPoint - (BandVectors.2 (p (2 : Fin (4 : ℕ))) - (p (0 : Fin (4 : ℕ))) + - BandVectors.2 (p (0 : Fin (4 : ℕ))) - (p (2 : Fin (4 : ℕ)))) → - TileTouching Rminus join → - Rminus ≠ join → - C.1.1.1 ≠ 1 → - TileString C orientation base Rminus join [Rminus, join] - ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D a p hp hB r I x y hvrec hvflip hMcenter - hcenter u join hjoinFamily hjoinCenterEq hjoinOdo joinSlope hjoinSlope hSB aSlope haSlope - hparentB houterOdo houterBand hBA hvAB hidx2 hAocc hminusSlopeOffset hplusSlopeOffset - hleftTouch hleftNe hnonunit - unfold TileString - refine ⟨F.base_band, ?_, ?_, ?_, ?_, ?_, ?_⟩ - · rfl - · rfl - · simpa using hleftNe - · intro T hT - simp only [List.mem_cons] at hT - rcases hT with hT | hT - · rcases hT with rfl - exact F.minus_family - · rcases hT with hT | hT - · rcases hT with rfl - exact hjoinFamily - · simp at hT - · simpa [List.IsChain, List.isChain_pair, hnonunit] using hleftTouch - · intro pre T post heq hpre hpost - have hlen := congrArg List.length heq - have hp' : 1 ≤ pre.length := by - cases pre with - | nil => simp at hpre - | cons x xs => simp - have hq' : 1 ≤ post.length := by - cases post with - | nil => simp at hpost - | cons x xs => simp - simp at hlen - omega - private theorem hr2At770 : (by classical @@ -2805,14 +2688,11 @@ private theorem firstParentPlacement : have hMnonempty := SecondNewerRowsGeometry.hMnonempty C orientation base Rminus Rplus hminus hplus F positiveCells refine ⟨⟨join, hjoinCells.1.symm, hjoinOdo, hjoinAncestor, - hjoinOccurrence, .direct (SecondNewerRowsGeometry.leftString C orientation base Rminus - Rplus hminus hplus F D a p hp hB hvrec hvflip hMcenter hcenter u hjoinFamily - hjoinCenterEq hjoinOdo joinSlope - hjoinSlope hSB aSlope haSlope - hparentB houterOdo houterBand hBA hvAB hidx2 hAocc hminusSlopeOffset - hplusSlopeOffset hleftTouch (SecondNewerRowsGeometry.hleftNe C orientation base Rminus - Rplus hminus hplus F u hleftTouch hMnonempty) (SecondNewerRowsGeometry.hnonunit C t ht - htC)) hleftAdjacent, hright⟩⟩ + hjoinOccurrence, .direct (TileStringPairOfNonunit C orientation base Rminus join + F.base_band F.minus_family + hjoinFamily (SecondNewerRowsGeometry.hleftNe C orientation base Rminus + Rplus hminus hplus F u hleftTouch hMnonempty) + (SecondNewerRowsGeometry.hnonunit C t ht htC) hleftTouch) hleftAdjacent, hright⟩⟩ private theorem secondParentPlacement : (by diff --git a/LeanPool/ApollonianSuperharmonic/P4909T1LineFan.lean b/LeanPool/ApollonianSuperharmonic/P4909T1LineFan.lean index 5571db5adb..af4f9d65f4 100644 --- a/LeanPool/ApollonianSuperharmonic/P4909T1LineFan.lean +++ b/LeanPool/ApollonianSuperharmonic/P4909T1LineFan.lean @@ -330,185 +330,6 @@ private theorem subD (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hi · exact hvertices.2.2.1 · exact hfxP -private theorem sub (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q l.succ).1 = 0) - (hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1) (hzero : 0 < (q 0).1) (hnormal : (q l.succ).2 - = -1 ∨ (q l.succ).2 = 1) (hside : ∀ i : Fin 4, 0 < (q i).1 → if (q l.succ).2 = -1 then L < - (((q i).2 : ℂ) / ((q i).1 : ℝ)).re else (((q i).2 : ℂ) / ((q i).1 : ℝ)).re < L + 2) (hinside - : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (a : Fin 3) (b : Fin - 3) (qmem : ∀ (z : ℂ), z ∈ ((P L q)) ↔ (A q a).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * - (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re)) (dmem : ∀ (z : ℂ), z ∈ ((F L q) b) ↔ - (A q a).im ≤ z.im ∧ z.im ≤ (x q).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun - y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) z.im - - z.re)) (tlower : ∀ (z : ℂ), (A q a).im ≤ z.im → z.im ≤ (x q).im → (z ∈ ((F L q) l) ↔ 0 ≤ (σ - q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - - (A q a).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (umem : ∀ (z : ℂ), z ∈ ((F L q) a) ↔ - (x q).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun - y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - - z.re)) (tupper : ∀ (z : ℂ), (x q).im ≤ z.im → z.im ≤ (B q b).im → (z ∈ ((F L q) l) ↔ 0 ≤ (σ q - l) * (z.re - (fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x - q).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q - a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (qint : ∀ (z : ℂ), z ∈ interior (((P L - q))) ↔ (A q a).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) - * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q - a).im)) z.im - z.re)) (qfront : frontier (((P L q))) = segment ℝ (A q a) (B q b) ∪ segment ℝ - (A q a) ⟨(h L q l), (A q a).im⟩ ∪ segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ segment ℝ ⟨(h L - q l), (A q a).im⟩ ⟨(h L q l), (B q b).im⟩) (dint : ∀ (z : ℂ), z ∈ interior (((F L q) b)) ↔ (A - q a).im < z.im ∧ z.im < (x q).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y - => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) z.im - - z.re)) (dfront : frontier (((F L q) b)) = segment ℝ (A q a) (x q) ∪ segment ℝ (A q a) ⟨(h L q - l), (A q a).im⟩ ∪ segment ℝ (x q) ⟨(h L q l), (x q).im⟩ ∪ segment ℝ ⟨(h L q l), (A q a).im⟩ - ⟨(h L q l), (x q).im⟩) (uint : ∀ (z : ℂ), z ∈ interior (((F L q) a)) ↔ (x q).im < z.im ∧ z.im - < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y => (x q).re + ((B q - b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - z.re)) (ufront : - frontier (((F L q) a)) = segment ℝ (x q) (B q b) ∪ segment ℝ (x q) ⟨(h L q l), (x q).im⟩ ∪ - segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ segment ℝ ⟨(h L q l), (x q).im⟩ ⟨(h L q l), (B q - b).im⟩) (tint : ∀ (z : ℂ), z ∈ interior (((F L q) l)) ↔ 0 < (σ q l) * ((fun y => (A q a).re + - ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re) ∧ 0 < - (σ q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x - q).im - (A q a).im)) z.im) ∧ 0 < (σ q l) * (z.re - (fun y => (x q).re + ((B q b).re - (x - q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im)) (tfront : frontier (((F L q) l)) = - segment ℝ (x q) (A q a) ∪ segment ℝ (x q) (B q b) ∪ segment ℝ (A q a) (B q b)) (hal : a ≠ l) - (hbl : b ≠ l) (hab : a ≠ b) (hP : (P L q) = convexHull ℝ ({(A q a), (B q b), ⟨(h L q l), (A q - a).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hD : (F L q) b = convexHull ℝ ({(A q a), (x q), - ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), (x q).im⟩} : Set ℂ)) (hC : (F L q) l = convexHull ℝ ({(x - q), (A q a), (B q b)} : Set ℂ)) (hU : (F L q) a = convexHull ℝ ({(x q), (B q b), ⟨(h L q l), - (x q).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hAx : ((p q) a.succ).im < (x q).im) (hxB : (x - q).im < ((p q) b.succ).im) (c : Fin 3) : (F L q) c ⊆ (P L q) := by - classical - let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) - let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) - let P := P4909T1ParentPolygon L q - let F (c : Fin 3) := P4909T1ParentPolygon L (s c) - let h := if (q l.succ).2 = -1 then L else L + 2 - let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 - let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ - let x := p 0 - have hσ : σ ^ 2 = 1 := hσ q l - have side (i : Fin 4) (hi : 0 < (q i).1) : 0 < σ * ((p i).re - h) := side L q l hside i hi - let a₀ : Fin 3 := if l = 0 then 1 else 0 - let b₀ : Fin 3 := if l = 2 then 1 else 2 - have ha₀ : a₀ ≠ l := ha₀ L q l hl hpos hnormal hside - have hb₀ : b₀ ≠ l := hb₀ L q l hl hpos hnormal hside - have hab₀ : a₀ ≠ b₀ := hab₀ L q l hl hpos hnormal hside - have hp₀ := (P4953T1LiteralHulls L q l a₀ b₀ ha₀ hb₀ hab₀ hl - (hpos a₀ ha₀) (hpos b₀ hb₀) hzero).1 - have hheight := P4953T1HullHeight h (p a₀.succ) (p b₀.succ) x (by - rw [← hp₀]; exact hinside) - have hne : (p a₀.succ).im ≠ (p b₀.succ).im := hne L q l hl hpos hzero hnormal hside hinside - let A := p a.succ - let B := p b.succ - have ha := hpos a hal - have hb := hpos b hbl - have classes (c : Fin 3) : c = l ∨ c = a ∨ c = b := classes l a b hal hbl hab c - have hA := side a.succ ha - have hB := side b.succ hb - have hx := side 0 hzero - have hxi := (qint x).mp hinside - have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP - have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB - have subC : F l ⊆ P := subC L q l hinside a b hP hC - have subU : F a ⊆ P := subU L q l hinside a b qmem qint hP hU hAx hxB - have subD : F b ⊆ P := subD L q l hinside a b qmem qint hP hD hAx hxB - change (F c ⊆ P) - rcases classes c with rfl | rfl | rfl - · exact subC - · exact subU - · exact subD - -private theorem omitted (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q l.succ).1 = - 0) (hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1) (hzero : 0 < (q 0).1) (hnormal : (q - l.succ).2 = -1 ∨ (q l.succ).2 = 1) (hside : ∀ i : Fin 4, 0 < (q i).1 → if (q l.succ).2 = -1 - then L < (((q i).2 : ℂ) / ((q i).1 : ℝ)).re else (((q i).2 : ℂ) / ((q i).1 : ℝ)).re < L + 2) - (hinside : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (a : Fin 3) - (b : Fin 3) (qmem : ∀ (z : ℂ), z ∈ ((P L q)) ↔ (A q a).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ - q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * - (y - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re)) (dmem : ∀ (z : ℂ), z ∈ ((F L q) - b) ↔ (A q a).im ≤ z.im ∧ z.im ≤ (x q).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * - ((fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) - z.im - z.re)) (tlower : ∀ (z : ℂ), (A q a).im ≤ z.im → z.im ≤ (x q).im → (z ∈ ((F L q) l) ↔ 0 - ≤ (σ q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x - q).im - (A q a).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) - * (y - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (umem : ∀ (z : ℂ), z ∈ ((F L - q) a) ↔ (x q).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) - * ((fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) - z.im - z.re)) (tupper : ∀ (z : ℂ), (x q).im ≤ z.im → z.im ≤ (B q b).im → (z ∈ ((F L q) l) ↔ 0 - ≤ (σ q l) * (z.re - (fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q - b).im - (x q).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * - (y - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (qint : ∀ (z : ℂ), z ∈ interior - (((P L q))) ↔ (A q a).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < - (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - - (A q a).im)) z.im - z.re)) (qfront : frontier (((P L q))) = segment ℝ (A q a) (B q b) ∪ - segment ℝ (A q a) ⟨(h L q l), (A q a).im⟩ ∪ segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ - segment ℝ ⟨(h L q l), (A q a).im⟩ ⟨(h L q l), (B q b).im⟩) (dint : ∀ (z : ℂ), z ∈ interior - (((F L q) b)) ↔ (A q a).im < z.im ∧ z.im < (x q).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < - (σ q l) * ((fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A - q a).im)) z.im - z.re)) (dfront : frontier (((F L q) b)) = segment ℝ (A q a) (x q) ∪ segment - ℝ (A q a) ⟨(h L q l), (A q a).im⟩ ∪ segment ℝ (x q) ⟨(h L q l), (x q).im⟩ ∪ segment ℝ ⟨(h L q - l), (A q a).im⟩ ⟨(h L q l), (x q).im⟩) (uint : ∀ (z : ℂ), z ∈ interior (((F L q) a)) ↔ (x - q).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y - => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - - z.re)) (ufront : frontier (((F L q) a)) = segment ℝ (x q) (B q b) ∪ segment ℝ (x q) ⟨(h L q - l), (x q).im⟩ ∪ segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ segment ℝ ⟨(h L q l), (x q).im⟩ - ⟨(h L q l), (B q b).im⟩) (tint : ∀ (z : ℂ), z ∈ interior (((F L q) l)) ↔ 0 < (σ q l) * ((fun - y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q a).im)) - z.im - z.re) ∧ 0 < (σ q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A - q a).im) / ((x q).im - (A q a).im)) z.im) ∧ 0 < (σ q l) * (z.re - (fun y => (x q).re + ((B q - b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im)) (tfront : frontier (((F - L q) l)) = segment ℝ (x q) (A q a) ∪ segment ℝ (x q) (B q b) ∪ segment ℝ (A q a) (B q b)) - (hal : a ≠ l) (hbl : b ≠ l) (hab : a ≠ b) (hP : (P L q) = convexHull ℝ ({(A q a), (B q b), - ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hD : (F L q) b = convexHull ℝ - ({(A q a), (x q), ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), (x q).im⟩} : Set ℂ)) (hC : (F L q) l = - convexHull ℝ ({(x q), (A q a), (B q b)} : Set ℂ)) (hU : (F L q) a = convexHull ℝ ({(x q), (B - q b), ⟨(h L q l), (x q).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hAx : ((p q) a.succ).im < (x - q).im) (hxB : (x q).im < ((p q) b.succ).im) (c : Fin 3) (hc : 0 < (q c.succ).1) : (p q) - c.succ ∉ (F L q) c := by - classical - let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) - let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) - let P := P4909T1ParentPolygon L q - let F (c : Fin 3) := P4909T1ParentPolygon L (s c) - let h := if (q l.succ).2 = -1 then L else L + 2 - let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 - let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ - let x := p 0 - have hσ : σ ^ 2 = 1 := hσ q l - have side (i : Fin 4) (hi : 0 < (q i).1) : 0 < σ * ((p i).re - h) := side L q l hside i hi - let a₀ : Fin 3 := if l = 0 then 1 else 0 - let b₀ : Fin 3 := if l = 2 then 1 else 2 - have ha₀ : a₀ ≠ l := ha₀ L q l hl hpos hnormal hside - have hb₀ : b₀ ≠ l := hb₀ L q l hl hpos hnormal hside - have hab₀ : a₀ ≠ b₀ := hab₀ L q l hl hpos hnormal hside - have hp₀ := (P4953T1LiteralHulls L q l a₀ b₀ ha₀ hb₀ hab₀ hl - (hpos a₀ ha₀) (hpos b₀ hb₀) hzero).1 - have hheight := P4953T1HullHeight h (p a₀.succ) (p b₀.succ) x (by - rw [← hp₀]; exact hinside) - have hne : (p a₀.succ).im ≠ (p b₀.succ).im := hne L q l hl hpos hzero hnormal hside hinside - let A := p a.succ - let B := p b.succ - have ha := hpos a hal - have hb := hpos b hbl - have classes (c : Fin 3) : c = l ∨ c = a ∨ c = b := classes l a b hal hbl hab c - have hA := side a.succ ha - have hB := side b.succ hb - have hx := side 0 hzero - have hxi := (qint x).mp hinside - have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP - have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB - have subC : F l ⊆ P := subC L q l hinside a b hP hC - have subU : F a ⊆ P := subU L q l hinside a b qmem qint hP hU hAx hxB - have subD : F b ⊆ P := subD L q l hinside a b qmem qint hP hD hAx hxB - change (p c.succ ∉ F c) - rcases classes c with rfl | rfl | rfl - · omega - · intro hz - have hh := ((umem A).mp hz).1 - exact (not_le_of_gt hAx) hh - · intro hz - have hh := ((dmem B).mp hz).2.1 - exact (not_le_of_gt hxB) hh - private theorem root (q : Fin 4 → CircleCoordinates) (slots : ∀ (c j : Fin 3), (fun c => ApollonianSuperharmonic.P4828T1Step (ApollonianSuperharmonic.P4828T1Rotate q c)) c j.succ = if j = 0 then q 0 else q (j + c).succ) (c : Fin 3) : (s q) c (0 : Fin 3).succ = q 0 := by @@ -720,111 +541,6 @@ private theorem frontD (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) ( (retainedFoot b a hbl.symm hab ha)) (rootFoot b hbl.symm)) ((footLine A x).trans (lineCarrier b hbl.symm)) -private theorem front (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q l.succ).1 = 0) - (hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1) (hzero : 0 < (q 0).1) (hnormal : (q l.succ).2 - = -1 ∨ (q l.succ).2 = 1) (hside : ∀ i : Fin 4, 0 < (q i).1 → if (q l.succ).2 = -1 then L < - (((q i).2 : ℂ) / ((q i).1 : ℝ)).re else (((q i).2 : ℂ) / ((q i).1 : ℝ)).re < L + 2) (hinside - : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (a : Fin 3) (b : Fin - 3) (qmem : ∀ (z : ℂ), z ∈ ((P L q)) ↔ (A q a).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * - (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re)) (dmem : ∀ (z : ℂ), z ∈ ((F L q) b) ↔ - (A q a).im ≤ z.im ∧ z.im ≤ (x q).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun - y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) z.im - - z.re)) (tlower : ∀ (z : ℂ), (A q a).im ≤ z.im → z.im ≤ (x q).im → (z ∈ ((F L q) l) ↔ 0 ≤ (σ - q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - - (A q a).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (umem : ∀ (z : ℂ), z ∈ ((F L q) a) ↔ - (x q).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun - y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - - z.re)) (tupper : ∀ (z : ℂ), (x q).im ≤ z.im → z.im ≤ (B q b).im → (z ∈ ((F L q) l) ↔ 0 ≤ (σ q - l) * (z.re - (fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x - q).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q - a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (qint : ∀ (z : ℂ), z ∈ interior (((P L - q))) ↔ (A q a).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) - * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q - a).im)) z.im - z.re)) (qfront : frontier (((P L q))) = segment ℝ (A q a) (B q b) ∪ segment ℝ - (A q a) ⟨(h L q l), (A q a).im⟩ ∪ segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ segment ℝ ⟨(h L - q l), (A q a).im⟩ ⟨(h L q l), (B q b).im⟩) (dint : ∀ (z : ℂ), z ∈ interior (((F L q) b)) ↔ (A - q a).im < z.im ∧ z.im < (x q).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y - => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) z.im - - z.re)) (dfront : frontier (((F L q) b)) = segment ℝ (A q a) (x q) ∪ segment ℝ (A q a) ⟨(h L q - l), (A q a).im⟩ ∪ segment ℝ (x q) ⟨(h L q l), (x q).im⟩ ∪ segment ℝ ⟨(h L q l), (A q a).im⟩ - ⟨(h L q l), (x q).im⟩) (uint : ∀ (z : ℂ), z ∈ interior (((F L q) a)) ↔ (x q).im < z.im ∧ z.im - < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y => (x q).re + ((B q - b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - z.re)) (ufront : - frontier (((F L q) a)) = segment ℝ (x q) (B q b) ∪ segment ℝ (x q) ⟨(h L q l), (x q).im⟩ ∪ - segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ segment ℝ ⟨(h L q l), (x q).im⟩ ⟨(h L q l), (B q - b).im⟩) (tint : ∀ (z : ℂ), z ∈ interior (((F L q) l)) ↔ 0 < (σ q l) * ((fun y => (A q a).re + - ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re) ∧ 0 < - (σ q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x - q).im - (A q a).im)) z.im) ∧ 0 < (σ q l) * (z.re - (fun y => (x q).re + ((B q b).re - (x - q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im)) (tfront : frontier (((F L q) l)) = - segment ℝ (x q) (A q a) ∪ segment ℝ (x q) (B q b) ∪ segment ℝ (A q a) (B q b)) (slots : ∀ (c - j : Fin 3), (fun c => ApollonianSuperharmonic.P4828T1Step - (ApollonianSuperharmonic.P4828T1Rotate q c)) c j.succ = if j = 0 then q 0 else q (j + - c).succ) (hal : a ≠ l) (hbl : b ≠ l) (hab : a ≠ b) (hP : (P L q) = convexHull ℝ ({(A q a), (B - q b), ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hD : (F L q) b = - convexHull ℝ ({(A q a), (x q), ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), (x q).im⟩} : Set ℂ)) (hC - : (F L q) l = convexHull ℝ ({(x q), (A q a), (B q b)} : Set ℂ)) (hU : (F L q) a = convexHull - ℝ ({(x q), (B q b), ⟨(h L q l), (x q).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hAx : ((p q) - a.succ).im < (x q).im) (hxB : (x q).im < ((p q) b.succ).im) (c : Fin 3) : frontier ((F L q) - c) ⊆ P4909T1ParentEdges L ((s q) c) := by - classical - let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) - let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) - let P := P4909T1ParentPolygon L q - let F (c : Fin 3) := P4909T1ParentPolygon L (s c) - let h := if (q l.succ).2 = -1 then L else L + 2 - let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 - let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ - let x := p 0 - have hσ : σ ^ 2 = 1 := hσ q l - have side (i : Fin 4) (hi : 0 < (q i).1) : 0 < σ * ((p i).re - h) := side L q l hside i hi - let a₀ : Fin 3 := if l = 0 then 1 else 0 - let b₀ : Fin 3 := if l = 2 then 1 else 2 - have ha₀ : a₀ ≠ l := ha₀ L q l hl hpos hnormal hside - have hb₀ : b₀ ≠ l := hb₀ L q l hl hpos hnormal hside - have hab₀ : a₀ ≠ b₀ := hab₀ L q l hl hpos hnormal hside - have hp₀ := (P4953T1LiteralHulls L q l a₀ b₀ ha₀ hb₀ hab₀ hl - (hpos a₀ ha₀) (hpos b₀ hb₀) hzero).1 - have hheight := P4953T1HullHeight h (p a₀.succ) (p b₀.succ) x (by - rw [← hp₀]; exact hinside) - have hne : (p a₀.succ).im ≠ (p b₀.succ).im := hne L q l hl hpos hzero hnormal hside hinside - let A := p a.succ - let B := p b.succ - have ha := hpos a hal - have hb := hpos b hbl - have classes (c : Fin 3) : c = l ∨ c = a ∨ c = b := classes l a b hal hbl hab c - have hA := side a.succ ha - have hB := side b.succ hb - have hx := side 0 hzero - have hxi := (qint x).mp hinside - have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP - have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB - have subC : F l ⊆ P := subC L q l hinside a b hP hC - have subU : F a ⊆ P := subU L q l hinside a b qmem qint hP hU hAx hxB - have subD : F b ⊆ P := subD L q l hinside a b qmem qint hP hD hAx hxB - have rootFoot (c : Fin 3) (hc : l ≠ c) : - segment ℝ x (foot x) ⊆ P4909T1ParentEdges L (s c) := rootFoot L q l hl hzero slots c hc - have retainedFoot (c i : Fin 3) (hc : l ≠ c) (hi : i ≠ c) - (hpi : 0 < (q i.succ).1) : - segment ℝ (p i.succ) (foot (p i.succ)) ⊆ P4909T1ParentEdges L (s c) := retainedFoot L q l - hl slots c i hc hi hpi - have lineCarrier (c : Fin 3) (hc : l ≠ c) : - {z : ℂ | z.re = h} ⊆ P4909T1ParentEdges L (s c) := lineCarrier L q l hl slots c hc - have footLine (u v : ℂ) : segment ℝ (foot u) (foot v) ⊆ {z : ℂ | z.re = h} := footLine L q l u v - have frontC : frontier (F l) ⊆ P4909T1ParentEdges L (s l) := frontC L q l hpos hzero a b - tfront slots hal hbl hab - have frontU : frontier (F a) ⊆ P4909T1ParentEdges L (s a) := frontU L q l hl hpos hzero a b - ufront slots hal hbl hab - have frontD : frontier (F b) ⊆ P4909T1ParentEdges L (s b) := frontD L q l hl hpos hzero a b - dfront slots hal hbl hab - change (frontier (F c) ⊆ P4909T1ParentEdges L (s c)) - rcases classes c with rfl | rfl | rfl - · exact frontC - · exact frontU - · exact frontD - private theorem sepCU (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (a : Fin 3) (b : Fin 3) (uint : ∀ (z : ℂ), z ∈ interior (((F L q) a)) ↔ (x q).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y => (x q).re + ((B q b).re - (x q).re) * (y @@ -878,123 +594,6 @@ private theorem sepUD (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (a intro z hu hd exact (not_lt_of_gt ((uint z).mp hu).1) ((dint z).mp hd).2.1 -private theorem sep (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (hl : (q l.succ).1 = 0) - (hpos : ∀ i : Fin 3, i ≠ l → 0 < (q i.succ).1) (hzero : 0 < (q 0).1) (hnormal : (q l.succ).2 - = -1 ∨ (q l.succ).2 = 1) (hside : ∀ i : Fin 4, 0 < (q i).1 → if (q l.succ).2 = -1 then L < - (((q i).2 : ℂ) / ((q i).1 : ℝ)).re else (((q i).2 : ℂ) / ((q i).1 : ℝ)).re < L + 2) (hinside - : ((q 0).2 : ℂ) / ((q 0).1 : ℝ) ∈ interior (P4909T1ParentPolygon L q)) (a : Fin 3) (b : Fin - 3) (qmem : ∀ (z : ℂ), z ∈ ((P L q)) ↔ (A q a).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * - (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re)) (dmem : ∀ (z : ℂ), z ∈ ((F L q) b) ↔ - (A q a).im ≤ z.im ∧ z.im ≤ (x q).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun - y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) z.im - - z.re)) (tlower : ∀ (z : ℂ), (A q a).im ≤ z.im → z.im ≤ (x q).im → (z ∈ ((F L q) l) ↔ 0 ≤ (σ - q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - - (A q a).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (umem : ∀ (z : ℂ), z ∈ ((F L q) a) ↔ - (x q).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun - y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - - z.re)) (tupper : ∀ (z : ℂ), (x q).im ≤ z.im → z.im ≤ (B q b).im → (z ∈ ((F L q) l) ↔ 0 ≤ (σ q - l) * (z.re - (fun y => (x q).re + ((B q b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x - q).im)) z.im) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q - a).im) / ((B q b).im - (A q a).im)) z.im - z.re))) (qint : ∀ (z : ℂ), z ∈ interior (((P L - q))) ↔ (A q a).im < z.im ∧ z.im < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) - * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q - a).im)) z.im - z.re)) (qfront : frontier (((P L q))) = segment ℝ (A q a) (B q b) ∪ segment ℝ - (A q a) ⟨(h L q l), (A q a).im⟩ ∪ segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ segment ℝ ⟨(h L - q l), (A q a).im⟩ ⟨(h L q l), (B q b).im⟩) (dint : ∀ (z : ℂ), z ∈ interior (((F L q) b)) ↔ (A - q a).im < z.im ∧ z.im < (x q).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y - => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x q).im - (A q a).im)) z.im - - z.re)) (dfront : frontier (((F L q) b)) = segment ℝ (A q a) (x q) ∪ segment ℝ (A q a) ⟨(h L q - l), (A q a).im⟩ ∪ segment ℝ (x q) ⟨(h L q l), (x q).im⟩ ∪ segment ℝ ⟨(h L q l), (A q a).im⟩ - ⟨(h L q l), (x q).im⟩) (uint : ∀ (z : ℂ), z ∈ interior (((F L q) a)) ↔ (x q).im < z.im ∧ z.im - < (B q b).im ∧ 0 < (σ q l) * (z.re - (h L q l)) ∧ 0 < (σ q l) * ((fun y => (x q).re + ((B q - b).re - (x q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im - z.re)) (ufront : - frontier (((F L q) a)) = segment ℝ (x q) (B q b) ∪ segment ℝ (x q) ⟨(h L q l), (x q).im⟩ ∪ - segment ℝ (B q b) ⟨(h L q l), (B q b).im⟩ ∪ segment ℝ ⟨(h L q l), (x q).im⟩ ⟨(h L q l), (B q - b).im⟩) (tint : ∀ (z : ℂ), z ∈ interior (((F L q) l)) ↔ 0 < (σ q l) * ((fun y => (A q a).re + - ((B q b).re - (A q a).re) * (y - (A q a).im) / ((B q b).im - (A q a).im)) z.im - z.re) ∧ 0 < - (σ q l) * (z.re - (fun y => (A q a).re + ((x q).re - (A q a).re) * (y - (A q a).im) / ((x - q).im - (A q a).im)) z.im) ∧ 0 < (σ q l) * (z.re - (fun y => (x q).re + ((B q b).re - (x - q).re) * (y - (x q).im) / ((B q b).im - (x q).im)) z.im)) (tfront : frontier (((F L q) l)) = - segment ℝ (x q) (A q a) ∪ segment ℝ (x q) (B q b) ∪ segment ℝ (A q a) (B q b)) (slots : ∀ (c - j : Fin 3), (fun c => ApollonianSuperharmonic.P4828T1Step - (ApollonianSuperharmonic.P4828T1Rotate q c)) c j.succ = if j = 0 then q 0 else q (j + - c).succ) (hal : a ≠ l) (hbl : b ≠ l) (hab : a ≠ b) (hP : (P L q) = convexHull ℝ ({(A q a), (B - q b), ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hD : (F L q) b = - convexHull ℝ ({(A q a), (x q), ⟨(h L q l), (A q a).im⟩, ⟨(h L q l), (x q).im⟩} : Set ℂ)) (hC - : (F L q) l = convexHull ℝ ({(x q), (A q a), (B q b)} : Set ℂ)) (hU : (F L q) a = convexHull - ℝ ({(x q), (B q b), ⟨(h L q l), (x q).im⟩, ⟨(h L q l), (B q b).im⟩} : Set ℂ)) (hAx : ((p q) - a.succ).im < (x q).im) (hxB : (x q).im < ((p q) b.succ).im) (c d : Fin 3) (hcd : c ≠ d) : - Disjoint (interior ((F L q) c)) (interior ((F L q) d)) := by - classical - let p (i : Fin 4) : ℂ := (q i).2 / ((q i).1 : ℝ) - let s (c : Fin 3) := P4828T1Step (P4828T1Rotate q c) - let P := P4909T1ParentPolygon L q - let F (c : Fin 3) := P4909T1ParentPolygon L (s c) - let h := if (q l.succ).2 = -1 then L else L + 2 - let σ : ℝ := if (q l.succ).2 = -1 then 1 else -1 - let foot (z : ℂ) : ℂ := ⟨h, z.im⟩ - let x := p 0 - have hσ : σ ^ 2 = 1 := hσ q l - have side (i : Fin 4) (hi : 0 < (q i).1) : 0 < σ * ((p i).re - h) := side L q l hside i hi - let a₀ : Fin 3 := if l = 0 then 1 else 0 - let b₀ : Fin 3 := if l = 2 then 1 else 2 - have ha₀ : a₀ ≠ l := ha₀ L q l hl hpos hnormal hside - have hb₀ : b₀ ≠ l := hb₀ L q l hl hpos hnormal hside - have hab₀ : a₀ ≠ b₀ := hab₀ L q l hl hpos hnormal hside - have hp₀ := (P4953T1LiteralHulls L q l a₀ b₀ ha₀ hb₀ hab₀ hl - (hpos a₀ ha₀) (hpos b₀ hb₀) hzero).1 - have hheight := P4953T1HullHeight h (p a₀.succ) (p b₀.succ) x (by - rw [← hp₀]; exact hinside) - have hne : (p a₀.succ).im ≠ (p b₀.succ).im := hne L q l hl hpos hzero hnormal hside hinside - let A := p a.succ - let B := p b.succ - have ha := hpos a hal - have hb := hpos b hbl - have classes (c : Fin 3) : c = l ∨ c = a ∨ c = b := classes l a b hal hbl hab c - have hA := side a.succ ha - have hB := side b.succ hb - have hx := side 0 hzero - have hxi := (qint x).mp hinside - have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := hvertices L q l a b hP - have hfxP : foot x ∈ P := hfxP L q l hinside a b qmem qint hAx hxB - have subC : F l ⊆ P := subC L q l hinside a b hP hC - have subU : F a ⊆ P := subU L q l hinside a b qmem qint hP hU hAx hxB - have subD : F b ⊆ P := subD L q l hinside a b qmem qint hP hD hAx hxB - have rootFoot (c : Fin 3) (hc : l ≠ c) : - segment ℝ x (foot x) ⊆ P4909T1ParentEdges L (s c) := rootFoot L q l hl hzero slots c hc - have retainedFoot (c i : Fin 3) (hc : l ≠ c) (hi : i ≠ c) - (hpi : 0 < (q i.succ).1) : - segment ℝ (p i.succ) (foot (p i.succ)) ⊆ P4909T1ParentEdges L (s c) := retainedFoot L q l - hl slots c i hc hi hpi - have lineCarrier (c : Fin 3) (hc : l ≠ c) : - {z : ℂ | z.re = h} ⊆ P4909T1ParentEdges L (s c) := lineCarrier L q l hl slots c hc - have footLine (u v : ℂ) : segment ℝ (foot u) (foot v) ⊆ {z : ℂ | z.re = h} := footLine L q l u v - have frontC : frontier (F l) ⊆ P4909T1ParentEdges L (s l) := frontC L q l hpos hzero a b - tfront slots hal hbl hab - have frontU : frontier (F a) ⊆ P4909T1ParentEdges L (s a) := frontU L q l hl hpos hzero a b - ufront slots hal hbl hab - have frontD : frontier (F b) ⊆ P4909T1ParentEdges L (s b) := frontD L q l hl hpos hzero a b - dfront slots hal hbl hab - have sepCU : Disjoint (interior (F l)) (interior (F a)) := sepCU L q l a b uint tint - have sepCD : Disjoint (interior (F l)) (interior (F b)) := sepCD L q l a b dint tint - have sepUD : Disjoint (interior (F a)) (interior (F b)) := sepUD L q l a b dint uint - change (Disjoint (interior (F c)) (interior (F d))) - rcases classes c with rfl | rfl | rfl - · rcases classes d with rfl | rfl | rfl - · exact (hcd rfl).elim - · exact sepCU - · exact sepCD - · rcases classes d with rfl | rfl | rfl - · exact sepCU.symm - · exact (hcd rfl).elim - · exact sepUD - · rcases classes d with rfl | rfl | rfl - · exact sepCD.symm - · exact sepUD.symm - · exact (hcd rfl).elim - private theorem cover (L : ℝ) (q : Fin 4 → CircleCoordinates) (l : Fin 3) (a : Fin 3) (b : Fin 3) (qmem : ∀ (z : ℂ), z ∈ ((P L q)) ↔ (A q a).im ≤ z.im ∧ z.im ≤ (B q b).im ∧ 0 ≤ (σ q l) * (z.re - (h L q l)) ∧ 0 ≤ (σ q l) * ((fun y => (A q a).re + ((B q b).re - (A q a).re) * (y - @@ -1126,30 +725,22 @@ theorem P4909T1LineFan (L : ℝ) (q : Fin 4 → CircleCoordinates) P4953T1TriangleSections σ A x B hAx hxB hxi.2.2.2 rw [← hC] at tint tlower tupper tfront -- Containment uses only convexity and the inserted foot's actual height. - have hvertices : A ∈ P ∧ B ∈ P ∧ foot A ∈ P ∧ foot B ∈ P := LineFanConstruction.hvertices L q l - a b hP - have hfxP : foot x ∈ P := LineFanConstruction.hfxP L q l hinside a b qmem qint hAx hxB have subC : F l ⊆ P := LineFanConstruction.subC L q l hinside a b hP hC have subU : F a ⊆ P := LineFanConstruction.subU L q l hinside a b qmem qint hP hU hAx hxB have subD : F b ⊆ P := LineFanConstruction.subD L q l hinside a b qmem qint hP hD hAx hxB - have sub (c : Fin 3) : F c ⊆ P := LineFanConstruction.sub L q l hl hpos hzero hnormal hside - hinside a b qmem dmem tlower umem tupper qint qfront dint dfront uint ufront tint tfront - hal hbl hab hP hD hC hU hAx hxB c - have omitted (c : Fin 3) (hc : 0 < (q c.succ).1) : p c.succ ∉ F c := - LineFanConstruction.omitted L q l hl hpos hzero hnormal hside hinside a b qmem dmem tlower - umem tupper qint qfront dint dfront uint ufront tint tfront hal hbl hab hP hD hC hU hAx hxB - c hc + have sub (c : Fin 3) : F c ⊆ P := by + rcases classes c with rfl | rfl | rfl + · exact subC + · exact subU + · exact subD + have omitted (c : Fin 3) (hc : 0 < (q c.succ).1) : p c.succ ∉ F c := by + rcases classes c with rfl | rfl | rfl + · omega + · intro hz + exact (not_le_of_gt hAx) ((umem A).mp hz).1 + · intro hz + exact (not_le_of_gt hxB) ((dmem B).mp hz).2.1 -- Build the literal edge witnesses without identifying same-center records. - have rootFoot (c : Fin 3) (hc : l ≠ c) : - segment ℝ x (foot x) ⊆ P4909T1ParentEdges L (s c) := LineFanConstruction.rootFoot L q l - hl hzero slots c hc - have retainedFoot (c i : Fin 3) (hc : l ≠ c) (hi : i ≠ c) - (hpi : 0 < (q i.succ).1) : - segment ℝ (p i.succ) (foot (p i.succ)) ⊆ P4909T1ParentEdges L (s c) := - LineFanConstruction.retainedFoot L q l hl slots c i hc hi hpi - have lineCarrier (c : Fin 3) (hc : l ≠ c) : - {z : ℂ | z.re = h} ⊆ P4909T1ParentEdges L (s c) := LineFanConstruction.lineCarrier L q l - hl slots c hc have footLine (u v : ℂ) : segment ℝ (foot u) (foot v) ⊆ {z : ℂ | z.re = h} := LineFanConstruction.footLine L q l u v have frontC : frontier (F l) ⊆ P4909T1ParentEdges L (s l) := LineFanConstruction.frontC L q l @@ -1158,10 +749,11 @@ theorem P4909T1LineFan (L : ℝ) (q : Fin 4 → CircleCoordinates) hl hpos hzero a b ufront slots hal hbl hab have frontD : frontier (F b) ⊆ P4909T1ParentEdges L (s b) := LineFanConstruction.frontD L q l hl hpos hzero a b dfront slots hal hbl hab - have front (c : Fin 3) : frontier (F c) ⊆ P4909T1ParentEdges L (s c) := - LineFanConstruction.front L q l hl hpos hzero hnormal hside hinside a b qmem dmem tlower - umem tupper qint qfront dint dfront uint ufront tint tfront slots hal hbl hab hP hD hC hU - hAx hxB c + have front (c : Fin 3) : frontier (F c) ⊆ P4909T1ParentEdges L (s c) := by + rcases classes c with rfl | rfl | rfl + · exact frontC + · exact frontU + · exact frontD -- Strict affine inequalities separate the central and lateral interiors. have sepCU : Disjoint (interior (F l)) (interior (F a)) := LineFanConstruction.sepCU L q l a b uint tint @@ -1169,10 +761,20 @@ theorem P4909T1LineFan (L : ℝ) (q : Fin 4 → CircleCoordinates) dint tint have sepUD : Disjoint (interior (F a)) (interior (F b)) := LineFanConstruction.sepUD L q l a b dint uint - have sep (c d : Fin 3) (hcd : c ≠ d) : Disjoint (interior (F c)) (interior (F d)) := - LineFanConstruction.sep L q l hl hpos hzero hnormal hside hinside a b qmem dmem tlower umem - tupper qint qfront dint dfront uint ufront tint tfront slots hal hbl hab hP hD hC hU hAx - hxB c d hcd + have sep (c d : Fin 3) (hcd : c ≠ d) : Disjoint (interior (F c)) (interior (F d)) := by + rcases classes c with rfl | rfl | rfl + · rcases classes d with rfl | rfl | rfl + · exact (hcd rfl).elim + · exact sepCU + · exact sepCD + · rcases classes d with rfl | rfl | rfl + · exact sepCU.symm + · exact (hcd rfl).elim + · exact sepUD + · rcases classes d with rfl | rfl | rfl + · exact sepCD.symm + · exact sepUD.symm + · exact (hcd rfl).elim have cover (z : ℂ) (hz : z ∈ P) : ∃ c, z ∈ F c := LineFanConstruction.cover L q l a b qmem dmem tlower umem tupper z hz refine ⟨fun c => ⟨sub c, omitted c, front c⟩, sep, ?_, ?_⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean b/LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean index 2a304e73c3..9f7b6291be 100644 --- a/LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P5110T1SquareInterface.lean @@ -283,17 +283,6 @@ private theorem edges (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : Gaussia apply Zsqrtd.ext <;> simp · dsimp; omega -private theorem hlu (n : Nat) (m : Nat) (a : GaussianInt) (b : GaussianInt) (vertical : Bool) - (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im else b.re) < min - ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else b.re) + (m : - Int))) : (l a b vertical) < (u n m a b vertical) := by - classical - let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) - let u := min ((if vertical then a.im else a.re) + (n : Int)) - ((if vertical then b.im else b.re) + (m : Int)) - change (l < u) - exact hoverlap - private theorem hdelta (n : Nat) (m : Nat) (a : GaussianInt) (b : GaussianInt) (vertical : Bool) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else b.re) + (m : @@ -306,43 +295,8 @@ private theorem hdelta (n : Nat) (m : Nat) (a : GaussianInt) (b : GaussianInt) ( change ((((u - l).toNat : Nat) : Int) = u - l) omega -private theorem positive_length (n : Nat) (m : Nat) (a : GaussianInt) (b : GaussianInt) (vertical - : Bool) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im else b.re) < - min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else b.re) + (m : - Int))) : 0 < ((u n m a b vertical) - (l a b vertical)).toNat := by - classical - let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) - let u := min ((if vertical then a.im else a.re) + (n : Int)) - ((if vertical then b.im else b.re) + (m : Int)) - have hdelta : (((u - l).toNat : Nat) : Int) = u - l := hdelta n m a b vertical hoverlap - change (0 < (u - l).toNat) - omega - -private theorem finj (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : - GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else b.im = - a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im - else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else - b.re) + (m : Int))) : Function.Injective (f a b vertical) := by - classical - let A := TileTranslation (FordTile n) a - let B := TileTranslation (FordTile m) b - let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) - let u := min ((if vertical then a.im else a.re) + (n : Int)) - ((if vertical then b.im else b.re) + (m : Int)) - let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) - else (⟨l + (k : Int), b.im⟩ : GaussianInt) - have vertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = - {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u - else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} := vertices n m hn hm a b vertical hside hoverlap - have edges : BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = - {e | ∃ t : Int, l ≤ t ∧ t < u ∧ e = if vertical then - {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} - else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := edges n m hn hm a b vertical hside - hoverlap - have hlu : l < u := hlu n m a b vertical hoverlap - have hdelta : (((u - l).toNat : Nat) : Int) = u - l := hdelta n m a b vertical hoverlap - have positive_length : 0 < (u - l).toNat := positive_length n m a b vertical hoverlap - change (Function.Injective f) +private theorem finj (a b : GaussianInt) (vertical : Bool) : + Function.Injective (f a b vertical) := by intro j k he cases vertical · have h := congrArg Zsqrtd.re he @@ -352,21 +306,9 @@ private theorem finj (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : Gaussian dsimp [f] at h omega -private theorem pnd (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : - GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else b.im = - a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im - else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else - b.re) + (m : Int))) : (p n m a b vertical).Nodup := by - classical - let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) - let u := min ((if vertical then a.im else a.re) + (n : Int)) - ((if vertical then b.im else b.re) + (m : Int)) - let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) - else (⟨l + (k : Int), b.im⟩ : GaussianInt) - let p := (List.range ((u - l).toNat + 1)).map f - have finj : Function.Injective f := finj n m hn hm a b vertical hside hoverlap - change (p.Nodup) - exact List.nodup_range.map finj +private theorem pnd (n m : Nat) (a b : GaussianInt) (vertical : Bool) : + (p n m a b vertical).Nodup := by + exact List.nodup_range.map (finj a b vertical) private theorem plen (n : Nat) (m : Nat) (a : GaussianInt) (b : GaussianInt) (vertical : Bool) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im else b.re) < min @@ -401,17 +343,7 @@ private theorem pvertices (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : Gau have vertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} := vertices n m hn hm a b vertical hside hoverlap - have edges : BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = - {e | ∃ t : Int, l ≤ t ∧ t < u ∧ e = if vertical then - {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} - else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := edges n m hn hm a b vertical hside - hoverlap - have hlu : l < u := hlu n m a b vertical hoverlap have hdelta : (((u - l).toNat : Nat) : Int) = u - l := hdelta n m a b vertical hoverlap - have positive_length : 0 < (u - l).toNat := positive_length n m a b vertical hoverlap - have finj : Function.Injective f := finj n m hn hm a b vertical hside hoverlap - have pnd : p.Nodup := pnd n m hn hm a b vertical hside hoverlap - have plen : 2 ≤ p.length := plen n m a b vertical hoverlap change (BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = (p.toFinset : Set GaussianInt)) ext z @@ -433,79 +365,21 @@ private theorem pvertices (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : Gau private noncomputable abbrev adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ -private theorem fstep (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : - GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else b.im = - a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im - else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else - b.re) + (m : Int))) (k : Nat) : adj ((f a b vertical) k) ((f a b vertical) (k + 1)) := by - classical - let A := TileTranslation (FordTile n) a - let B := TileTranslation (FordTile m) b - let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) - let u := min ((if vertical then a.im else a.re) + (n : Int)) - ((if vertical then b.im else b.re) + (m : Int)) - let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) - else (⟨l + (k : Int), b.im⟩ : GaussianInt) - let p := (List.range ((u - l).toNat + 1)).map f - have vertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = - {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u - else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} := vertices n m hn hm a b vertical hside hoverlap - have edges : BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = - {e | ∃ t : Int, l ≤ t ∧ t < u ∧ e = if vertical then - {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} - else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := edges n m hn hm a b vertical hside - hoverlap - have hlu : l < u := hlu n m a b vertical hoverlap - have hdelta : (((u - l).toNat : Nat) : Int) = u - l := hdelta n m a b vertical hoverlap - have positive_length : 0 < (u - l).toNat := positive_length n m a b vertical hoverlap - have finj : Function.Injective f := finj n m hn hm a b vertical hside hoverlap - have pnd : p.Nodup := pnd n m hn hm a b vertical hside hoverlap - have plen : 2 ≤ p.length := plen n m a b vertical hoverlap - have pvertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = - (p.toFinset : Set GaussianInt) := pvertices n m hn hm a b vertical hside hoverlap - let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ - y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ - change (adj (f k) (f (k + 1))) +private theorem fstep (a b : GaussianInt) (vertical : Bool) (k : Nat) : + adj (f a b vertical k) (f a b vertical (k + 1)) := by cases vertical · left; apply Zsqrtd.ext <;> simp [f, add_assoc] · right; right; left; apply Zsqrtd.ext <;> simp [f, add_assoc] -private theorem chain (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : - GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else b.im = - a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im - else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else - b.re) + (m : Int))) : (p n m a b vertical).IsChain adj := by - classical - let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) - let u := min ((if vertical then a.im else a.re) + (n : Int)) - ((if vertical then b.im else b.re) + (m : Int)) - let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) - else (⟨l + (k : Int), b.im⟩ : GaussianInt) - let p := (List.range ((u - l).toNat + 1)).map f - let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ - y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ - have fstep (k : Nat) : adj (f k) (f (k + 1)) := fstep n m hn hm a b vertical hside hoverlap k - change (p.IsChain adj) - apply (List.isChain_map f).mpr - exact (List.isChain_range_succ _ (u - l).toNat).mpr (fun k _ => fstep k) +private theorem chain (n m : Nat) (a b : GaussianInt) (vertical : Bool) : + (p n m a b vertical).IsChain adj := by + apply (List.isChain_map (f a b vertical)).mpr + exact (List.isChain_range_succ _ (u n m a b vertical - l a b vertical).toNat).mpr + (fun k _ => fstep a b vertical k) -private theorem step (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : - GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else b.im = - a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then b.im - else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im else - b.re) + (m : Int))) : ∀ x y l₁ l₂, (p n m a b vertical) = l₁ ++ x :: y :: l₂ → adj x y := by - classical - let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) - let u := min ((if vertical then a.im else a.re) + (n : Int)) - ((if vertical then b.im else b.re) + (m : Int)) - let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) - else (⟨l + (k : Int), b.im⟩ : GaussianInt) - let p := (List.range ((u - l).toNat + 1)).map f - let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ - y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ - have chain : p.IsChain adj := chain n m hn hm a b vertical hside hoverlap - change (∀ x y l₁ l₂, p = l₁ ++ x :: y :: l₂ → adj x y) - exact List.isChain_iff_forall_rel_of_append_cons_cons.mp chain +private theorem step (n m : Nat) (a b : GaussianInt) (vertical : Bool) : + ∀ x y l₁ l₂, p n m a b vertical = l₁ ++ x :: y :: l₂ → adj x y := by + exact List.isChain_iff_forall_rel_of_append_cons_cons.mp (chain n m a b vertical) private theorem occurs (n : Nat) (m : Nat) (a : GaussianInt) (b : GaussianInt) (vertical : Bool) (k : Nat) (hk : k < ((u n m a b vertical) - (l a b vertical)).toNat) : @@ -542,80 +416,20 @@ private theorem edge_step (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : Gau ((if vertical then b.im else b.re) + (m : Int)) let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) else (⟨l + (k : Int), b.im⟩ : GaussianInt) - let p := (List.range ((u - l).toNat + 1)).map f - have vertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = - {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u - else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} := vertices n m hn hm a b vertical hside hoverlap have edges : BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = {e | ∃ t : Int, l ≤ t ∧ t < u ∧ e = if vertical then {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := edges n m hn hm a b vertical hside hoverlap - have hlu : l < u := hlu n m a b vertical hoverlap have hdelta : (((u - l).toNat : Nat) : Int) = u - l := hdelta n m a b vertical hoverlap - have positive_length : 0 < (u - l).toNat := positive_length n m a b vertical hoverlap - have finj : Function.Injective f := finj n m hn hm a b vertical hside hoverlap - have pnd : p.Nodup := pnd n m hn hm a b vertical hside hoverlap - have plen : 2 ≤ p.length := plen n m a b vertical hoverlap - have pvertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = - (p.toFinset : Set GaussianInt) := pvertices n m hn hm a b vertical hside hoverlap - let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ - y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ - have fstep (k : Nat) : adj (f k) (f (k + 1)) := fstep n m hn hm a b vertical hside hoverlap k - have chain : p.IsChain adj := chain n m hn hm a b vertical hside hoverlap - have step : ∀ x y l₁ l₂, p = l₁ ++ x :: y :: l₂ → adj x y := step n m hn hm a b vertical hside - hoverlap - have occurs (k : Nat) (hk : k < (u - l).toNat) : - ∃ l₁ l₂, p = l₁ ++ f k :: f (k + 1) :: l₂ := occurs n m a b vertical k hk change k < (u - l).toNat at hk change ({f k, f (k + 1)} ∈ BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B) rw [edges] refine ⟨l + (k : Int), by omega, by omega, ?_⟩ cases vertical <;> simp [f, add_assoc] -private theorem adjacent_indices (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) - (b : GaussianInt) (vertical : Bool) (hside : if vertical then b.re = a.re + (n : Int) else - b.im = a.im + (n : Int)) (hoverlap : max (if vertical then a.im else a.re) (if vertical then - b.im else b.re) < min ((if vertical then a.im else a.re) + (n : Int)) ((if vertical then b.im - else b.re) + (m : Int))) (j k : Nat) (h : adj ((f a b vertical) j) ((f a b vertical) k)) : - k = j + 1 ∨ j = k + 1 := by - classical - let A := TileTranslation (FordTile n) a - let B := TileTranslation (FordTile m) b - let l := max (if vertical then a.im else a.re) (if vertical then b.im else b.re) - let u := min ((if vertical then a.im else a.re) + (n : Int)) - ((if vertical then b.im else b.re) + (m : Int)) - let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) - else (⟨l + (k : Int), b.im⟩ : GaussianInt) - let p := (List.range ((u - l).toNat + 1)).map f - have vertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = - {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u - else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} := vertices n m hn hm a b vertical hside hoverlap - have edges : BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = - {e | ∃ t : Int, l ≤ t ∧ t < u ∧ e = if vertical then - {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} - else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := edges n m hn hm a b vertical hside - hoverlap - have hlu : l < u := hlu n m a b vertical hoverlap - have hdelta : (((u - l).toNat : Nat) : Int) = u - l := hdelta n m a b vertical hoverlap - have positive_length : 0 < (u - l).toNat := positive_length n m a b vertical hoverlap - have finj : Function.Injective f := finj n m hn hm a b vertical hside hoverlap - have pnd : p.Nodup := pnd n m hn hm a b vertical hside hoverlap - have plen : 2 ≤ p.length := plen n m a b vertical hoverlap - have pvertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = - (p.toFinset : Set GaussianInt) := pvertices n m hn hm a b vertical hside hoverlap - let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ - y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ - have fstep (k : Nat) : adj (f k) (f (k + 1)) := fstep n m hn hm a b vertical hside hoverlap k - have chain : p.IsChain adj := chain n m hn hm a b vertical hside hoverlap - have step : ∀ x y l₁ l₂, p = l₁ ++ x :: y :: l₂ → adj x y := step n m hn hm a b vertical hside - hoverlap - have occurs (k : Nat) (hk : k < (u - l).toNat) : - ∃ l₁ l₂, p = l₁ ++ f k :: f (k + 1) :: l₂ := occurs n m a b vertical k hk - have edge_step (k : Nat) (hk : k < (u - l).toNat) : - {f k, f (k + 1)} ∈ BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B := edge_step n m hn - hm a b vertical hside hoverlap k hk - change adj (f j) (f k) at h +private theorem adjacent_indices (a b : GaussianInt) (vertical : Bool) (j k : Nat) + (h : adj (f a b vertical j) (f a b vertical k)) : k = j + 1 ∨ j = k + 1 := by cases vertical <;> simp [adj, f, Zsqrtd.ext_iff] at h <;> omega private theorem path (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : GaussianInt) (b : @@ -634,35 +448,26 @@ private theorem path (n : Nat) (m : Nat) (hn : 0 < n) (hm : 0 < m) (a : Gaussian let f := fun k : Nat => if vertical then (⟨b.re, l + (k : Int)⟩ : GaussianInt) else (⟨l + (k : Int), b.im⟩ : GaussianInt) let p := (List.range ((u - l).toNat + 1)).map f - have vertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = - {z | if vertical then z.re = b.re ∧ l ≤ z.im ∧ z.im ≤ u - else z.im = b.im ∧ l ≤ z.re ∧ z.re ≤ u} := vertices n m hn hm a b vertical hside hoverlap have edges : BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B = {e | ∃ t : Int, l ≤ t ∧ t < u ∧ e = if vertical then {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := edges n m hn hm a b vertical hside hoverlap - have hlu : l < u := hlu n m a b vertical hoverlap have hdelta : (((u - l).toNat : Nat) : Int) = u - l := hdelta n m a b vertical hoverlap - have positive_length : 0 < (u - l).toNat := positive_length n m a b vertical hoverlap - have finj : Function.Injective f := finj n m hn hm a b vertical hside hoverlap - have pnd : p.Nodup := pnd n m hn hm a b vertical hside hoverlap + have pnd : p.Nodup := pnd n m a b vertical have plen : 2 ≤ p.length := plen n m a b vertical hoverlap have pvertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = (p.toFinset : Set GaussianInt) := pvertices n m hn hm a b vertical hside hoverlap let adj := fun x y : GaussianInt => y = x + 1 ∨ y = x - 1 ∨ y = x + ⟨0, 1⟩ ∨ y = x - ⟨0, 1⟩ - have fstep (k : Nat) : adj (f k) (f (k + 1)) := fstep n m hn hm a b vertical hside hoverlap k - have chain : p.IsChain adj := chain n m hn hm a b vertical hside hoverlap - have step : ∀ x y l₁ l₂, p = l₁ ++ x :: y :: l₂ → adj x y := step n m hn hm a b vertical hside - hoverlap + have step : ∀ x y l₁ l₂, p = l₁ ++ x :: y :: l₂ → adj x y := step n m a b vertical have occurs (k : Nat) (hk : k < (u - l).toNat) : ∃ l₁ l₂, p = l₁ ++ f k :: f (k + 1) :: l₂ := occurs n m a b vertical k hk have edge_step (k : Nat) (hk : k < (u - l).toNat) : {f k, f (k + 1)} ∈ BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B := edge_step n m hn hm a b vertical hside hoverlap k hk have adjacent_indices (j k : Nat) (h : adj (f j) (f k)) : - k = j + 1 ∨ j = k + 1 := adjacent_indices n m hn hm a b vertical hside hoverlap j k h + k = j + 1 ∨ j = k + 1 := adjacent_indices a b vertical j k h change (SimpleGridPath (BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B) (BoundaryFootprintEdges A ∩ BoundaryFootprintEdges B)) refine ⟨p, pnd, plen, pvertices, step, ?_⟩ @@ -746,7 +551,7 @@ theorem P5110T1SquareInterface (n m : Nat) (hn : 0 < n) (hm : 0 < m) {(⟨b.re, t⟩ : GaussianInt), ⟨b.re, t + 1⟩} else {(⟨t, b.im⟩ : GaussianInt), ⟨t + 1, b.im⟩}} := SquareInterfaceConstruction.edges n m hn hm a b vertical hside hoverlap - have pnd : p.Nodup := SquareInterfaceConstruction.pnd n m hn hm a b vertical hside hoverlap + have pnd : p.Nodup := SquareInterfaceConstruction.pnd n m a b vertical have plen : 2 ≤ p.length := SquareInterfaceConstruction.plen n m a b vertical hoverlap have pvertices : BoundaryFootprintVertices A ∩ BoundaryFootprintVertices B = (p.toFinset : Set GaussianInt) := SquareInterfaceConstruction.pvertices n m hn hm a b diff --git a/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean b/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean index 9992b95539..a15b62ae21 100644 --- a/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean +++ b/LeanPool/ApollonianSuperharmonic/P5596T1LeftWeb.lean @@ -580,121 +580,6 @@ private theorem hnadj : have hlt := hq.2 i omega -private theorem hUn : - (by - classical - exact - ( - (∀ (q : Fin (4 : ℕ) → CircleCoordinates), - ((ProperBandQuadruple q) → (∀ (U : ProtoTile), ∀ (V : ProtoTile), (LatticeTile U ∧ - TileArea U = (q (0 : Fin (4 : ℕ))).1.toNat ∧ (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), - (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q U i s (S i s)) → (∀ - (x : LatticeCell), x ∈ U.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i - s).cells) → ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), LatticeTile (TileCellComplement U - (S i s)) ∧ - TileTouching (TileCellComplement U (S i s)) (S i s)) ∧ QuarterTurnSymmetric U ∧ ((1 : - ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), TouchingTriple U (TileTranslation - U (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation U - (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) ∧ ((1 : ℤ) - < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), ∀ (U_1 : ProtoTile), BandPrototile - (q i.succ) U_1 → TileCentroid U_1 - TileCentroid U = (1 / 2 : ℝ) • (GaussianRealPoint - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 - (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple U (TileTranslation U - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U_1) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (U_1 - : ProtoTile), ∀ (V : ProtoTile), BandPrototile (q i.succ) U_1 → BandPrototile (q - (i + - (1 : Fin (3 : ℕ))).succ) V → TileCentroid U_1 - TileCentroid U = (1 / 2 : ℝ) • - (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid V - - TileCentroid U = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : Fin - (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : Fin - (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple U U_1 V) ∧ ∀ (r : Fin - (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 : - Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q (3 - : Fin (4 : ℕ)) → (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → (q (3 : Fin (4 : - ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → ∀ (P : Fin (3 - : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin (3 : ℕ) - → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q U i - s (P i s)) → (∀ (x : LatticeCell), x ∈ U.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ - (P i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : - Fin (3 : ℕ)) true) i s (Q i s)) → (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) - true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (Q i s).cells) → (∀ (i : Fin (3 : - ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P (0 : Fin (3 : ℕ)) false) i s (S i s)) → - (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s - : Bool), x ∈ (S i s).cells) → - let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); - let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); (∀ (a : - PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)).Nonempty → AllowedSubtileIncidence a b) ∧ - (¬AllowedSubtileIncidence a b → FootprintVertices (SubtileOccurrenceInterpretation P - u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ - (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ FootprintVertices (P (0 : - Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ⊆ FootprintVertices - (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ - FootprintVertices (P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (0 : Fin (3 : ℕ)) - false) ⊆ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin - (3 : ℕ)) false) ∪ FootprintVertices (Q (0 : Fin (3 : ℕ)) false) ∪ FootprintVertices - (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → - ((LatticeTile V ∧ TileArea V = (q (0 : Fin (4 : ℕ))).1.toNat ∧ (∀ (S : Fin (3 : ℕ) → - Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q V i s - (S i s)) → (∀ (x : LatticeCell), x ∈ V.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S - i s).cells) → ∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), LatticeTile (TileCellComplement V (S - i s)) ∧ TileTouching (TileCellComplement V (S i s)) (S i s)) ∧ QuarterTurnSymmetric V - ∧ ((1 : ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), TouchingTriple V - (TileTranslation V (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) (TileTranslation - V (-BandVectors.1 (q (i + (1 : Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))))) ∧ ((1 : - ℤ) < (q (0 : Fin (4 : ℕ))).1 → ∀ (i : Fin (3 : ℕ)), ∀ (U : ProtoTile), BandPrototile - (q i.succ) U → TileCentroid U - TileCentroid V = (1 / 2 : ℝ) • (GaussianRealPoint - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + GaussianRealPoint (BandVectors.1 - (q (0 : Fin (4 : ℕ))) (q i.succ))) → TouchingTriple V (TileTranslation V - (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ))))) U) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (U : - ProtoTile), ∀ (V_1 : ProtoTile), BandPrototile (q i.succ) U → BandPrototile (q (i + - (1 : Fin (3 : ℕ))).succ) V_1 → TileCentroid U - TileCentroid V = (1 / 2 : ℝ) • - (GaussianRealPoint (BandVectors.1 (q i.succ) (q (0 : Fin (4 : ℕ)))) + - GaussianRealPoint (BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ))) → TileCentroid - V_1 - TileCentroid V = (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q (i + (1 : - Fin (3 : ℕ))).succ) (q (0 : Fin (4 : ℕ)))) - GaussianRealPoint (BandVectors.1 (q (0 : - Fin (4 : ℕ))) (q (i + (1 : Fin (3 : ℕ))).succ))) → TouchingTriple V U V_1) ∧ ∀ (r : - Fin (4 : ℕ) → CircleCoordinates), ProperBandQuadruple r → r (0 : Fin (4 : ℕ)) = q (1 - : Fin (4 : ℕ)) → r (2 : Fin (4 : ℕ)) = q (2 : Fin (4 : ℕ)) → r (3 : Fin (4 : ℕ)) = q - (3 : Fin (4 : ℕ)) → (q (2 : Fin (4 : ℕ))).1 ≤ (q (1 : Fin (4 : ℕ))).1 → (q (3 : Fin - (4 : ℕ))).1 ≤ (q (2 : Fin (4 : ℕ))).1 → (1 : ℤ) < (q (2 : Fin (4 : ℕ))).1 → ∀ (P : - Fin (3 : ℕ) → Bool → ProtoTile), ∀ (Q : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (S : Fin - (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), - BandSubtileOccurrence q V i s (P i s)) → (∀ (x : LatticeCell), x ∈ V.cells ↔ ∃ (i : - Fin (3 : ℕ)) (s : Bool), x ∈ (P i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), - BandSubtileOccurrence r (P (0 : Fin (3 : ℕ)) true) i s (Q i s)) → (∀ (x : - LatticeCell), x ∈ (P (0 : Fin (3 : ℕ)) true).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), - x ∈ (Q i s).cells) → (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence r (P - (0 : Fin (3 : ℕ)) false) i s (S i s)) → (∀ (x : LatticeCell), x ∈ (P (0 : Fin (3 : - ℕ)) false).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → - let u := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (1 : Fin (4 : ℕ))); - let v := BandVectors.1 (q (0 : Fin (4 : ℕ))) (q (2 : Fin (4 : ℕ))); (∀ (a : - PeriodicSubtileIndex), ∀ (b : PeriodicSubtileIndex), a ≠ b → ((FootprintEdges - (SubtileOccurrenceInterpretation P u v a) ∩ FootprintEdges - (SubtileOccurrenceInterpretation P u v b)).Nonempty → AllowedSubtileIncidence a b) ∧ - (¬AllowedSubtileIncidence a b → FootprintVertices (SubtileOccurrenceInterpretation P - u v a) ∩ FootprintVertices (SubtileOccurrenceInterpretation P u v b) = ∅ ∨ - (FootprintVertices (SubtileOccurrenceInterpretation P u v a) ∩ FootprintVertices - (SubtileOccurrenceInterpretation P u v b)).Subsingleton)) ∧ FootprintVertices (P (0 : - Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ⊆ FootprintVertices - (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (1 : Fin (3 : ℕ)) true) ∧ - FootprintVertices (P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (P (0 : Fin (3 : ℕ)) - false) ⊆ FootprintVertices (Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (2 : Fin - (3 : ℕ)) false) ∪ FootprintVertices (Q (0 : Fin (3 : ℕ)) false) ∪ FootprintVertices - (Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (S (1 : Fin (3 : ℕ)) false)) → - (U.cells.Nonempty)))))) ) := by - classical - intro q hq U V hgeomU hgeomV - have ha := hgeomU.2.1 - have hp := (ProperBandCurvatureStructure q hq).1 - by_contra he - simp only [TileArea, Finset.not_nonempty_iff_eq_empty.mp he, - Finset.card_empty] at ha - omega - private theorem hmatrixAt529 : (by classical @@ -1006,7 +891,12 @@ private theorem positiveStep : TileCentroid Rplus - TileCentroid Rminus = GaussianRealPoint v := LeftWebGeometry.hnadj q i hq hunit hpos U orientation Rminus Rplus r hcminus hcplus hnorm - have hUn : U.cells.Nonempty := LeftWebGeometry.hUn q hq U V hgeomU hgeomV + have hUn : U.cells.Nonempty := by + apply Finset.card_pos.mp + change 0 < TileArea U + rw [hgeomU.2.1] + have positive := (ProperBandCurvatureStructure q hq).1 + omega have hVn : V.cells.Nonempty := Finset.nonempty_iff_ne_empty.mpr hnV have hselection := P5589T1UnitInterfaceSelection C Ci hunit orientation base Rminus Rplus U V tiles reverseTiles hs reverseHs hminus hplus f k diff --git a/LeanPool/ApollonianSuperharmonic/TileStringPair.lean b/LeanPool/ApollonianSuperharmonic/TileStringPair.lean new file mode 100644 index 0000000000..8480485b26 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/TileStringPair.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.TileString + +/-! +# Two-tile strings + +Shared construction from the upstream two-tile string proofs. A pair has no +interior tiles, so endpoint membership, distinctness and selected adjacency suffice. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic + +theorem TileStringPair (C : BandCircle) (orientation : Bool) (base R S : ProtoTile) + (hbase : BandPrototile C.1.1 base) + (hR : R ∈ RegularTileFamily base (TilingLattice C)) + (hS : S ∈ RegularTileFamily base (TilingLattice C)) (hne : R ≠ S) + (hadjacent : if C.1.1.1 = 1 then + ∃ v : GaussianInt, UnitTriangularStep orientation v ∧ + TileCentroid S - TileCentroid R = GaussianRealPoint v + else TileTouching R S) : + TileString C orientation base R S [R, S] := by + classical + unfold TileString + refine ⟨hbase, rfl, rfl, ?_, ?_, ?_, ?_⟩ + · simpa using hne + · intro T hT + simp only [List.mem_cons, List.not_mem_nil, or_false] at hT + rcases hT with rfl | rfl + · exact hR + · exact hS + · simpa [List.IsChain, List.isChain_pair] using hadjacent + · intro pre T post heq hpre hpost + have hlength := congrArg List.length heq + simp only [List.length_cons, List.length_nil, List.length_append] at hlength + have hpreLength : 1 ≤ pre.length := List.length_pos_iff.mpr hpre + have hpostLength : 1 ≤ post.length := List.length_pos_iff.mpr hpost + have hbound : 3 ≤ pre.length + (post.length + 1) := + Nat.add_le_add hpreLength (Nat.succ_le_succ hpostLength) + have hfalse : ¬ (3 : ℕ) ≤ 2 := by decide + apply False.elim + apply hfalse + calc + 3 ≤ pre.length + (post.length + 1) := hbound + _ = 2 := hlength.symm + +theorem TileStringPairOfNonunit (C : BandCircle) (orientation : Bool) (base R S : ProtoTile) + (hbase : BandPrototile C.1.1 base) + (hR : R ∈ RegularTileFamily base (TilingLattice C)) + (hS : S ∈ RegularTileFamily base (TilingLattice C)) (hne : R ≠ S) + (hnonunit : C.1.1.1 ≠ 1) (htouching : TileTouching R S) : + TileString C orientation base R S [R, S] := by + apply TileStringPair C orientation base R S hbase hR hS hne + simpa only [ite_eq_right hnonunit] using htouching + +end ApollonianSuperharmonic From f6c11c9c514c9920092298da441145125def177a Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 13 Nov 2026 14:36:13 +0000 Subject: [PATCH 19/23] Reuse canonical sector, tile and face-path constructions --- .../AffineTriangularPlaneTriangulation.lean | 233 ++------ .../BandOrientedChildParentEndpoints.lean | 162 +----- .../P3776T1SectorMapsExist.lean | 399 ++------------ .../P3821T1ControlledNeighborhood.lean | 262 +-------- .../P4812T1RegularFaceWalks.lean | 517 ++++-------------- 5 files changed, 219 insertions(+), 1354 deletions(-) diff --git a/LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean b/LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean index 99f3abf516..a978132eb8 100644 --- a/LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean +++ b/LeanPool/ApollonianSuperharmonic/AffineTriangularPlaneTriangulation.lean @@ -4,29 +4,20 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Wesley Pegden -/ module - public import Mathlib.Init - public import LeanPool.ApollonianSuperharmonic.PlaneTriangulation public import LeanPool.ApollonianSuperharmonic.TriangularLatticeAdjacent public import Mathlib.Analysis.Convex.Topology public import Mathlib.Analysis.Convex.PathConnected - -- [TABLET NODE: AffineTriangularPlaneTriangulation] - /-! # AffineTriangularPlaneTriangulation - Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. -/ - @[expose] public section - namespace ApollonianSuperharmonic - namespace AffineTriangulationLemmas - private theorem symm_adj : ∀ (a : (Int × Int)), ∀ (b : (Int × Int)), TriangularLatticeAdjacent a b ↔ TriangularLatticeAdjacent b a := by @@ -34,13 +25,11 @@ private theorem symm_adj : intro a b simp only [TriangularLatticeAdjacent, Prod.ext_iff, Prod.fst_sub, Prod.snd_sub] omega - private theorem irrefl_adj : ∀ (a : (Int × Int)), ¬ TriangularLatticeAdjacent a a := by classical intro a simp [TriangularLatticeAdjacent, Prod.ext_iff] - private theorem finite_adj : ∀ (a : (Int × Int)), Set.Finite {b | TriangularLatticeAdjacent a b} := by classical @@ -54,7 +43,6 @@ private theorem finite_adj : all_goals simp only [Prod.ext_iff, Prod.fst_sub, Prod.snd_sub, Prod.fst_add, Prod.snd_add] at h ⊢ all_goals omega - private theorem distinct_fv : let fv : (Sum (Int × Int) (Int × Int)) → Fin 3 → (Int × Int) := fun | Sum.inl x => ![x, x + (1, 0), x - (0, 1)] @@ -64,7 +52,6 @@ private theorem distinct_fv : intro fv f i j h cases f <;> fin_cases i <;> fin_cases j <;> simp [fv, Prod.ext_iff] at h ⊢ <;> omega - private theorem edges_fv : let fv : (Sum (Int × Int) (Int × Int)) → Fin 3 → (Int × Int) := fun | Sum.inl x => ![x, x + (1, 0), x - (0, 1)] @@ -75,7 +62,6 @@ private theorem edges_fv : intro fv f i j h cases f <;> fin_cases i <;> fin_cases j <;> simp [fv, TriangularLatticeAdjacent, Prod.ext_iff] at h ⊢ - private theorem two_faces : let fv : (Sum (Int × Int) (Int × Int)) → Fin 3 → (Int × Int) := fun | Sum.inl x => ![x, x + (1, 0), x - (0, 1)] @@ -172,7 +158,6 @@ private theorem two_faces : simp only [Prod.ext_iff, Prod.fst_sub, Prod.snd_sub] at h ⊢ omega · exact positive a b (Or.inr (Or.inr h)) - private theorem int_walk : ∀ {R : (Int × Int) → (Int × Int) → Prop}, (∀ a b, R a b → R b a) → (∀ (f : Int → (Int × Int)), (∀ k, R (f k) (f (k + 1))) → (∀ (m : Int), ∀ (n : Int), Relation.ReflTransGen R (f @@ -192,7 +177,6 @@ private theorem int_walk : by_cases hmn : m ≤ n · exact forward m n hmn · exact reverse (forward n m (by omega)) - private theorem deletion_walk : (∀ (a : (Int × Int)), ∀ (b : (Int × Int)), TriangularLatticeAdjacent a b ↔ TriangularLatticeAdjacent b a) → ((∀ {R : (Int × Int) → (Int × Int) → Prop}, (∀ a b, R a @@ -276,7 +260,6 @@ private theorem deletion_walk : · exact hl.induction (fun x => x ∉ D) (a :: l) (fun {_ _} h _ => h.2.2) (fun _ => ha) · intro x y l₁ l₂ heq exact ((List.isChain_iff_forall_rel_of_append_cons_cons.mp hl) heq).1 - private theorem coord_injective : let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) Function.Injective coord := by @@ -286,7 +269,6 @@ private theorem coord_injective : have h2 := congrArg Prod.snd h simp only [coord] at h1 h2 exact Prod.ext (by exact_mod_cast h1) (by exact_mod_cast h2) - private theorem segment_homeo : ∀ (a : (Real × Real)), ∀ (b : (Real × Real)), (a ≠ b) → (∃ h : (Set.Icc (0 : Real) 1) ≃ₜ segment Real a b, @@ -315,7 +297,6 @@ private theorem segment_homeo : simp · change AffineMap.lineMap a b (1 : Real) = b simp - private theorem arc_homeo : let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) let shear : (Real × Real) ≃ₜ (Real × Real) := { @@ -341,7 +322,6 @@ private theorem arc_homeo : rw [h0] · change shear ((h ⟨1, by norm_num⟩ : segment Real (coord a) (coord b)) : (Real × Real)) = _ rw [h1] - private theorem open_T : let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} IsOpen T := by @@ -350,7 +330,6 @@ private theorem open_T : exact (isOpen_lt continuous_const continuous_fst).inter ((isOpen_lt continuous_const continuous_snd).inter (isOpen_lt (continuous_fst.add continuous_snd) continuous_const)) - private theorem closed_C : let C : Set (Real × Real) := {p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 ≤ 1} IsClosed C := by @@ -359,7 +338,6 @@ private theorem closed_C : exact (isClosed_le continuous_const continuous_fst).inter ((isClosed_le continuous_const continuous_snd).inter (isClosed_le (continuous_fst.add continuous_snd) continuous_const)) - private theorem convex_T : let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} Convex Real T := by @@ -369,14 +347,12 @@ private theorem convex_T : ((convex_halfSpace_gt (LinearMap.snd Real Real Real).isLinear 0).inter (convex_halfSpace_lt ((LinearMap.fst Real Real Real) + (LinearMap.snd Real Real Real)).isLinear 1)) - private theorem connected_T : let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} (Convex Real T) → (IsConnected T) := by classical intro T convex_T exact convex_T.isConnected ⟨(1 / 3, 1 / 3), by norm_num [T]⟩ - private theorem closure_T : let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} let C : Set (Real × Real) := {p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 ≤ 1} @@ -399,7 +375,6 @@ private theorem closure_T : mul_nonneg ha.le (show 0 ≤ 1 - (p.1 + p.2) by linarith [hp.2.2])] apply closure_mono hsegment exact segment_subset_closure_openSegment (left_mem_segment Real p (1 / 3, 1 / 3)) - private theorem boundary_T : let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} let C : Set (Real × Real) := {p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 ≤ 1} @@ -441,23 +416,25 @@ private theorem boundary_T : all_goals norm_num at h0 h1 ⊢ all_goals constructor all_goals assumption - +private noncomputable abbrev tile : + Sum (Int × Int) (Int × Int) → (Real × Real) ≃ₜ (Real × Real) := fun + | Sum.inl x => { + toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) + invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } + | Sum.inr x => { + toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) + invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) + left_inv := by intro p; ext <;> dsimp <;> ring + right_inv := by intro p; ext <;> dsimp <;> ring + continuous_toFun := by fun_prop + continuous_invFun := by fun_prop } private theorem tile_segment : - let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun - | Sum.inl x => { - toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) - invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } - | Sum.inr x => { - toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) - invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := + AffineTriangulationLemmas.tile ∀ (f : (Sum (Int × Int) (Int × Int))), ∀ (a : (Real × Real)), ∀ (b : (Real × Real)), tile f '' segment Real a b = segment Real (tile f a) (tile f b) := by classical @@ -467,34 +444,19 @@ private theorem tile_segment : funext t cases f <;> ext <;> simp [tile, Prod.smul_fst, Prod.smul_snd, smul_eq_mul] <;> ring - private theorem tile_vertices : let fv : (Sum (Int × Int) (Int × Int)) → Fin 3 → (Int × Int) := fun | Sum.inl x => ![x, x + (1, 0), x - (0, 1)] | Sum.inr x => ![x, x - (1, 0), x + (0, 1)] let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) - let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun - | Sum.inl x => { - toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) - invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } - | Sum.inr x => { - toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) - invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := + AffineTriangulationLemmas.tile ∀ (f : (Sum (Int × Int) (Int × Int))), tile f (0, 0) = coord (fv f 0) ∧ tile f (1, 0) = coord (fv f 1) ∧ tile f (0, 1) = coord (fv f 2) := by classical intro fv coord tile f cases f <;> simp [tile, fv, coord] - private theorem boundary_region : let fv : (Sum (Int × Int) (Int × Int)) → Fin 3 → (Int × Int) := fun | Sum.inl x => ![x, x + (1, 0), x - (0, 1)] @@ -511,21 +473,8 @@ private theorem boundary_region : let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} (frontier T = segment Real ((0, 0) : (Real × Real)) (1, 0) ∪ segment Real ((1, 0) : (Real × Real)) (0, 1) ∪ segment Real ((0, 1) : (Real × Real)) (0, 0)) → ( - let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun - | Sum.inl x => { - toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) - invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } - | Sum.inr x => { - toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) - invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := + AffineTriangulationLemmas.tile let region (f : (Sum (Int × Int) (Int × Int))) : Set (Real × Real) := shear '' tile f '' T (∀ (f : (Sum (Int × Int) (Int × Int))), ∀ (a : (Real × Real)), ∀ (b : (Real × Real)), tile f '' segment Real a b = segment Real (tile f a) (tile f b)) → ((∀ (f : (Sum (Int × Int) @@ -538,7 +487,6 @@ private theorem boundary_region : rw [← shear.image_frontier, ← (tile f).image_frontier, boundary_T] simp only [Set.image_union, tile_segment] rw [(tile_vertices f).1, (tile_vertices f).2.1, (tile_vertices f).2.2] - private theorem open_region : let shear : (Real × Real) ≃ₜ (Real × Real) := { toFun p := (p.1 - p.2 / 2, p.2) @@ -549,27 +497,13 @@ private theorem open_region : continuous_invFun := by fun_prop } let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} (IsOpen T) → ( - let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun - | Sum.inl x => { - toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) - invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } - | Sum.inr x => { - toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) - invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := + AffineTriangulationLemmas.tile let region (f : (Sum (Int × Int) (Int × Int))) : Set (Real × Real) := shear '' tile f '' T ∀ (f : (Sum (Int × Int) (Int × Int))), IsOpen (region f)) := by classical intro shear T open_T tile region f exact shear.isOpenMap _ ((tile f).isOpenMap _ open_T) - private theorem connected_region : let shear : (Real × Real) ≃ₜ (Real × Real) := { toFun p := (p.1 - p.2 / 2, p.2) @@ -580,45 +514,18 @@ private theorem connected_region : continuous_invFun := by fun_prop } let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} (IsConnected T) → ( - let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun - | Sum.inl x => { - toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) - invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } - | Sum.inr x => { - toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) - invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := + AffineTriangulationLemmas.tile let region (f : (Sum (Int × Int) (Int × Int))) : Set (Real × Real) := shear '' tile f '' T ∀ (f : (Sum (Int × Int) (Int × Int))), IsConnected (region f)) := by classical intro shear T connected_T tile region f exact (connected_T.image (tile f) (tile f).continuous.continuousOn).image shear shear.continuous.continuousOn - private theorem closed_cover : let C : Set (Real × Real) := {p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 ≤ 1} - let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun - | Sum.inl x => { - toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) - invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } - | Sum.inr x => { - toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) - invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := + AffineTriangulationLemmas.tile ∀ (p : (Real × Real)), ∃ f : (Sum (Int × Int) (Int × Int)), p ∈ tile f '' C := by classical intro C tile p @@ -637,7 +544,6 @@ private theorem closed_cover : · simp only [C, Set.mem_ofPred_eq] exact ⟨by linarith, by linarith, by linarith⟩ · ext <;> simp [tile] - private theorem strip_unique : ∀ (m : Int), ∀ (n : Int), ∀ (r : Real), ((m : Real) < r ∧ r < (m : Real) + 1) → (((n : Real) < r ∧ r < (n : Real) + 1) → (m = n)) := by @@ -649,24 +555,10 @@ private theorem strip_unique : · exact h · have h' : (n : Real) + 1 ≤ (m : Real) := by exact_mod_cast (show n + 1 ≤ m by omega) linarith - private theorem tiles_disjoint : let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} - let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun - | Sum.inl x => { - toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) - invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } - | Sum.inr x => { - toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) - invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := + AffineTriangulationLemmas.tile (∀ (m : Int), ∀ (n : Int), ∀ (r : Real), ((m : Real) < r ∧ r < (m : Real) + 1) → (((n : Real) < r ∧ r < (n : Real) + 1) → (m = n))) → (Pairwise fun f g => Disjoint (tile f '' T) (tile g '' T)) := by @@ -726,7 +618,6 @@ private theorem tiles_disjoint : have hy : x.2 = y.2 := strip_unique x.2 y.2 ((x.2 : Real) + u.2) ⟨by linarith [hu.2.1], by linarith⟩ ⟨by linarith [hv.2.1, heq.2], by linarith [heq.2]⟩ exact hfg (congrArg Sum.inr (Prod.ext (by omega) hy)) - private theorem regions_disjoint : let shear : (Real × Real) ≃ₜ (Real × Real) := { toFun p := (p.1 - p.2 / 2, p.2) @@ -736,21 +627,8 @@ private theorem regions_disjoint : continuous_toFun := by fun_prop continuous_invFun := by fun_prop } let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} - let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun - | Sum.inl x => { - toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) - invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } - | Sum.inr x => { - toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) - invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := + AffineTriangulationLemmas.tile let region (f : (Sum (Int × Int) (Int × Int))) : Set (Real × Real) := shear '' tile f '' T (Pairwise fun f g => Disjoint (tile f '' T) (tile g '' T)) → (Pairwise fun f g => Disjoint (region f) (region g)) := by @@ -758,7 +636,6 @@ private theorem regions_disjoint : intro shear T tile region tiles_disjoint f g hfg exact (tiles_disjoint hfg).image (shear.injective.injOn (s := Set.univ)) (Set.subset_univ _) (Set.subset_univ _) - private theorem plane_cover : let fv : (Sum (Int × Int) (Int × Int)) → Fin 3 → (Int × Int) := fun | Sum.inl x => ![x, x + (1, 0), x - (0, 1)] @@ -777,21 +654,8 @@ private theorem plane_cover : let T : Set (Real × Real) := {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 < 1} let C : Set (Real × Real) := {p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 ≤ 1} (closure T = C) → ( - let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun - | Sum.inl x => { - toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) - invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } - | Sum.inr x => { - toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) - invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := + AffineTriangulationLemmas.tile let region (f : (Sum (Int × Int) (Int × Int))) : Set (Real × Real) := shear '' tile f '' T (∀ (f : (Sum (Int × Int) (Int × Int))), frontier (region f) = arc (fv f 0) (fv f 1) ∪ arc (fv f 1) (fv f 2) ∪ arc (fv f 2) (fv f 0)) → ((∀ (p : (Real × Real)), ∃ f : (Sum (Int × Int) @@ -816,7 +680,6 @@ private theorem plane_cover : · exact Or.inl (Or.inr ⟨fv f 0, fv f 1, edges_fv f 0 1 (by decide), hp⟩) · exact Or.inl (Or.inr ⟨fv f 1, fv f 2, edges_fv f 1 2 (by decide), hp⟩) · exact Or.inl (Or.inr ⟨fv f 2, fv f 0, edges_fv f 2 0 (by decide), hp⟩) - private theorem fraction_integer : ∀ (m : Int), ∀ (n : Int), ∀ (s : Real), (s ∈ Set.Icc (0 : Real) 1) → (((m : Real) + s = (n : Real)) → (s = 0 ∨ s = 1)) := by @@ -830,7 +693,6 @@ private theorem fraction_integer : left; linarith · have h' : (n : Real) = (m : Real) + 1 := by exact_mod_cast heq right; linarith - private theorem fraction_gap : ∀ (m : Int), ∀ (n : Int), ∀ (s : Real), ∀ (t : Real), (s ∈ Set.Icc (0 : Real) 1) → ((t ∈ Set.Icc (0 : Real) 1) → (((m : Real) + s = (n : Real) + t) → ((m ≠ n) → ((s = 0 ∨ s = 1) @@ -845,7 +707,6 @@ private theorem fraction_gap : · have h' : (n : Real) + 1 ≤ (m : Real) := by exact_mod_cast (show n + 1 ≤ m by omega) exact ⟨Or.inl (by linarith [hs.1, hs.2, ht.1, ht.2]), Or.inr (by linarith [hs.1, hs.2, ht.1, ht.2])⟩ - private theorem endpoint_parameters : let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) let delta : Fin 3 → (Int × Int) := ![(1, 0), (0, 1), (1, 1)] @@ -907,7 +768,6 @@ private theorem endpoint_parameters : have heq := Prod.ext hx hy exact hne (by rw [heq]) exact fraction_gap x.1 y.1 s t hs ht h.1 hx - private theorem canonical_intersection : let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) (Function.Injective coord) → ( @@ -950,7 +810,6 @@ private theorem canonical_intersection : · rcases hb with rfl | rfl · exact left_mem_segment Real _ _ · exact right_mem_segment Real _ _ - private theorem orient_edge : let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) let delta : Fin 3 → (Int × Int) := ![(1, 0), (0, 1), (1, 1)] @@ -978,7 +837,6 @@ private theorem orient_edge : · have heq : b = a + delta 2 := by simp [delta, Prod.ext_iff] at h ⊢; omega subst b exact ⟨2, a, rfl, rfl⟩ - private theorem segment_intersections : let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) let delta : Fin 3 → (Int × Int) := ![(1, 0), (0, 1), (1, 1)] @@ -1000,7 +858,6 @@ private theorem segment_intersections : rw [hp, hq] at hne rw [he, hf, hp, hq] exact canonical_intersection x y k l hne - private theorem arc_symmetric : let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) let shear : (Real × Real) ≃ₜ (Real × Real) := { @@ -1016,7 +873,6 @@ private theorem arc_symmetric : intro coord shear arc a b dsimp [arc] rw [segment_symm] - private theorem arc_intersections : let coord (x : (Int × Int)) : (Real × Real) := (x.1, x.2) let shear : (Real × Real) ≃ₜ (Real × Real) := { @@ -1040,9 +896,7 @@ private theorem arc_intersections : dsimp only [arc] rw [← Set.image_inter shear.injective, segment_intersections a b c d hab hcd hne, Set.image_image] - end AffineTriangulationLemmas - theorem AffineTriangularPlaneTriangulation : ∃ (P : PlaneTriangulation (Int × Int)) (up down : (Int × Int) → P.Face), @@ -1118,21 +972,8 @@ theorem AffineTriangularPlaneTriangulation : have closure_T := AffineTriangulationLemmas.closure_T closed_C have boundary_T := AffineTriangulationLemmas.boundary_T open_T closure_T - let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := fun - | Sum.inl x => { - toFun := fun q => ((x.1 : Real) + q.1, (x.2 : Real) - q.2) - invFun := fun p => (p.1 - (x.1 : Real), (x.2 : Real) - p.2) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } - | Sum.inr x => { - toFun := fun q => ((x.1 : Real) - q.1, (x.2 : Real) + q.2) - invFun := fun p => ((x.1 : Real) - p.1, p.2 - (x.2 : Real)) - left_inv := by intro p; ext <;> dsimp <;> ring - right_inv := by intro p; ext <;> dsimp <;> ring - continuous_toFun := by fun_prop - continuous_invFun := by fun_prop } + let tile : (Sum (Int × Int) (Int × Int)) → (Real × Real) ≃ₜ (Real × Real) := + AffineTriangulationLemmas.tile let region (f : (Sum (Int × Int) (Int × Int))) : Set (Real × Real) := shear '' tile f '' T have tile_segment (f : (Sum (Int × Int) (Int × Int))) (a b : (Real × Real)) := AffineTriangulationLemmas.tile_segment f a b @@ -1241,7 +1082,5 @@ theorem AffineTriangularPlaneTriangulation : change shear '' tile (Sum.inr x) '' T = _ rw [Set.image_image] rfl - end ApollonianSuperharmonic - end diff --git a/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentEndpoints.lean b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentEndpoints.lean index 65e47734a0..16a15924d7 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrientedChildParentEndpoints.lean @@ -4,30 +4,21 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Wesley Pegden -/ module - public import Mathlib.Init - public import LeanPool.ApollonianSuperharmonic.FordOrientedChildParentEndpoints public import LeanPool.ApollonianSuperharmonic.DiamondOrientedChildParentEndpoints public import LeanPool.ApollonianSuperharmonic.P4055T1PlacementNormalization public import LeanPool.ApollonianSuperharmonic.P4055T1BandQuarterTurn public import LeanPool.ApollonianSuperharmonic.P4055T1OrderedGeneralOppositeEndpoints - -- [TABLET NODE: BandOrientedChildParentEndpoints] - /-! # BandOrientedChildParentEndpoints - Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. -/ - @[expose] public section - namespace ApollonianSuperharmonic - namespace OrientedEndpointGeometry - private theorem hregimeNormalized : (by classical @@ -46,7 +37,6 @@ private theorem hregimeNormalized : classical intro r a g' p qg hregimeQ simpa [qg] using hregimeQ - private theorem normalized : (by classical @@ -171,7 +161,6 @@ private theorem normalized : simpa only [j, ht, ite_true, ite_false] using hZcentNorm) cert hUQuarter (P4055T1BandQuarterTurn _ _ hW') (P4055T1BandQuarterTurn _ _ hZ') - private theorem transR : (by classical @@ -202,7 +191,6 @@ private theorem transR : intro r i s U a g' p qg k t U' ii hdispR uR vR rw [(BandPackingSymmetryTilingTransport g').2.2.2.2.2.2.1] exact congrArg (TileTranslation U') hdispR - private theorem transL : (by classical @@ -233,7 +221,6 @@ private theorem transL : intro r i s U a g' p qg k t U' ii hdispL uL vL rw [(BandPackingSymmetryTilingTransport g').2.2.2.2.2.2.1] exact congrArg (TileTranslation U') hdispL - private theorem hv : (by classical @@ -245,7 +232,6 @@ private theorem hv : classical intro g' f hfun T simpa only [hfun] using (BandPackingSymmetryTilingTransport g').2.2.2.2.2.2.2.1 T - private theorem he : (by classical @@ -257,7 +243,6 @@ private theorem he : classical intro g' f hfun T simpa only [hfun] using (BandPackingSymmetryTilingTransport g').2.2.2.2.2.2.2.2.1 T - private theorem hiv : (by classical @@ -270,7 +255,6 @@ private theorem hiv : intro g' f hv T rw [hv] simp [Set.image_image] - private theorem hie : (by classical @@ -284,131 +268,7 @@ private theorem hie : intro g' f he T rw [he] simp [Set.image_image, Finset.image_image] - -private theorem hivR : - (by - classical - exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (a - : Fin (3 : ℕ)), ∀ (g' : BandPackingSymmetry), - let p : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - let qg := BandPackingSymmetryQuadrupleAction g' p - let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' - then -(i - a) else i - a - let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' - then -s - 1 else s - let U' := BandPackingSymmetryTileAction g' U - let ii : GaussianInt := ⟨0, 1⟩ - let uR := ii ^ s.val * - (if Even s.val then BandVectors.1 (r 0) (r i.succ) - else BandVectors.1 (r i.succ) (r 0)) - let vR := ii ^ t.val * - (if Even t.val then BandVectors.1 (qg 0) (qg k.succ) - else BandVectors.1 (qg k.succ) (qg 0)) - (BandPackingSymmetryTileAction g' (TileTranslation U uR) = TileTranslation U' vR) → (∀ (f - : GaussianInt ≃ GaussianInt), (∀ (T : ProtoTile), FootprintVertices T = f.symm '' - FootprintVertices (BandPackingSymmetryTileAction g' T)) → (FootprintVertices - (TileTranslation U uR) = f.symm '' FootprintVertices (TileTranslation U' vR))) ) := by - classical - intro r i s U a g' p qg k t U' ii uR vR transR f hiv - rw [← transR] - exact hiv _ - -private theorem hieR : - (by - classical - exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (a - : Fin (3 : ℕ)), ∀ (g' : BandPackingSymmetry), - let p : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - let qg := BandPackingSymmetryQuadrupleAction g' p - let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' - then -(i - a) else i - a - let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' - then -s - 1 else s - let U' := BandPackingSymmetryTileAction g' U - let ii : GaussianInt := ⟨0, 1⟩ - let uR := ii ^ s.val * - (if Even s.val then BandVectors.1 (r 0) (r i.succ) - else BandVectors.1 (r i.succ) (r 0)) - let vR := ii ^ t.val * - (if Even t.val then BandVectors.1 (qg 0) (qg k.succ) - else BandVectors.1 (qg k.succ) (qg 0)) - (BandPackingSymmetryTileAction g' (TileTranslation U uR) = TileTranslation U' vR) → (∀ (f - : GaussianInt ≃ GaussianInt), (∀ (T : ProtoTile), FootprintEdges T = (fun e : Finset - GaussianInt => e.image f.symm) '' FootprintEdges (BandPackingSymmetryTileAction g' - T)) → (FootprintEdges (TileTranslation U uR) = (fun e : Finset GaussianInt => e.image - f.symm) '' FootprintEdges (TileTranslation U' vR))) ) := by - classical - intro r i s U a g' p qg k t U' ii uR vR transR f hie - rw [← transR] - exact hie _ - -private theorem hivL : - (by - classical - exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (a - : Fin (3 : ℕ)), ∀ (g' : BandPackingSymmetry), - let p : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - let qg := BandPackingSymmetryQuadrupleAction g' p - let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' - then -(i - a) else i - a - let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' - then -s - 1 else s - let U' := BandPackingSymmetryTileAction g' U - let ii : GaussianInt := ⟨0, 1⟩ - let uL := ii ^ s.val * - (if Even s.val then BandVectors.1 (r i.succ) (r 0) - else BandVectors.1 (r 0) (r i.succ)) - let vL := ii ^ t.val * - (if Even t.val then BandVectors.1 (qg k.succ) (qg 0) - else BandVectors.1 (qg 0) (qg k.succ)) - (BandPackingSymmetryTileAction g' (TileTranslation U uL) = TileTranslation U' vL) → (∀ (f - : GaussianInt ≃ GaussianInt), (∀ (T : ProtoTile), FootprintVertices T = f.symm '' - FootprintVertices (BandPackingSymmetryTileAction g' T)) → (FootprintVertices - (TileTranslation U uL) = f.symm '' FootprintVertices (TileTranslation U' vL))) ) := by - classical - intro r i s U a g' p qg k t U' ii uL vL transL f hiv - rw [← transL] - exact hiv _ - -private theorem hieL : - (by - classical - exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (U : ProtoTile), ∀ (a - : Fin (3 : ℕ)), ∀ (g' : BandPackingSymmetry), - let p : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - let qg := BandPackingSymmetryQuadrupleAction g' p - let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' - then -(i - a) else i - a - let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' - then -s - 1 else s - let U' := BandPackingSymmetryTileAction g' U - let ii : GaussianInt := ⟨0, 1⟩ - let uL := ii ^ s.val * - (if Even s.val then BandVectors.1 (r i.succ) (r 0) - else BandVectors.1 (r 0) (r i.succ)) - let vL := ii ^ t.val * - (if Even t.val then BandVectors.1 (qg k.succ) (qg 0) - else BandVectors.1 (qg 0) (qg k.succ)) - (BandPackingSymmetryTileAction g' (TileTranslation U uL) = TileTranslation U' vL) → (∀ (f - : GaussianInt ≃ GaussianInt), (∀ (T : ProtoTile), FootprintEdges T = (fun e : Finset - GaussianInt => e.image f.symm) '' FootprintEdges (BandPackingSymmetryTileAction g' - T)) → (FootprintEdges (TileTranslation U uL) = (fun e : Finset GaussianInt => e.image - f.symm) '' FootprintEdges (TileTranslation U' vL))) ) := by - classical - intro r i s U a g' p qg k t U' ii uL vL transL f hie - rw [← transL] - exact hie _ - end OrientedEndpointGeometry - theorem BandOrientedChildParentEndpoints (r : Fin 4 → CircleCoordinates) (hproper : ProperBandQuadruple r) (i : Fin 3) (s : Fin 4) (U W Z : ProtoTile) @@ -555,17 +415,21 @@ theorem BandOrientedChildParentEndpoints FootprintEdges (BandPackingSymmetryTileAction g' T) := OrientedEndpointGeometry.hie g' f he T have hivR : FootprintVertices (TileTranslation U uR) = - f.symm '' FootprintVertices (TileTranslation U' vR) := OrientedEndpointGeometry.hivR r i s - U a g' transR f hiv + f.symm '' FootprintVertices (TileTranslation U' vR) := by + rw [← transR] + exact hiv _ have hieR : FootprintEdges (TileTranslation U uR) = - (fun e : Finset GaussianInt => e.image f.symm) '' FootprintEdges (TileTranslation U' vR) := - OrientedEndpointGeometry.hieR r i s U a g' transR f hie + (fun e : Finset GaussianInt => e.image f.symm) '' FootprintEdges (TileTranslation U' vR) := by + rw [← transR] + exact hie _ have hivL : FootprintVertices (TileTranslation U uL) = - f.symm '' FootprintVertices (TileTranslation U' vL) := OrientedEndpointGeometry.hivL r i s - U a g' transL f hiv + f.symm '' FootprintVertices (TileTranslation U' vL) := by + rw [← transL] + exact hiv _ have hieL : FootprintEdges (TileTranslation U uL) = - (fun e : Finset GaussianInt => e.image f.symm) '' FootprintEdges (TileTranslation U' vL) := - OrientedEndpointGeometry.hieL r i s U a g' transL f hie + (fun e : Finset GaussianInt => e.image f.symm) '' FootprintEdges (TileTranslation U' vL) := by + rw [← transL] + exact hie _ obtain ⟨R₀, hrp, _, _, hrc⟩ := P4055T1ExactTripleImage f.symm f.symm.injective hi _ _ _ U (TileTranslation U uR) W (hiv U) hivR (hiv W) (hie U) hieR (hie W) R @@ -582,7 +446,5 @@ theorem BandOrientedChildParentEndpoints · rw [hrc, hip, hrca] · rw [hic, hrp, hica] · rw [hab, hrp, haab] - end ApollonianSuperharmonic - end diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean b/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean index 08f97ca0fa..55294f8d07 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1SectorMapsExist.lean @@ -4,39 +4,28 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Wesley Pegden -/ module - public import Mathlib.Init - public import Mathlib.Algebra.Order.Interval.Set.Instances - public import LeanPool.ApollonianSuperharmonic.P3776T1SectorMaps public import LeanPool.ApollonianSuperharmonic.P3832T1CollapsedConeDescent public import LeanPool.ApollonianSuperharmonic.P3832T1ChamberOverlap public import LeanPool.ApollonianSuperharmonic.P3832T1FiniteClosedCoverPasting public import Mathlib.Algebra.BigOperators.Fin - -- [TABLET NODE: P3776T1SectorMapsExist] - /-! # P3776T1SectorMapsExist - Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. -/ - @[expose] public section - namespace ApollonianSuperharmonic - namespace SectorMapsProof - private theorem sectorCollapse_surjective : let sectorCollapse := P3832T1ConeCollapse Function.Surjective sectorCollapse := by classical intro sectorCollapse exact (P3832T1CollapsedConeDescent (Y := ℝ × ℝ)).1 - private theorem sectorConeDescent : let SectorInterval := Set.Icc (0 : ℝ) 1 let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} @@ -47,7 +36,6 @@ private theorem sectorConeDescent : classical intro SectorInterval SectorCone sectorCollapse g c hzero exact (P3832T1CollapsedConeDescent (Y := ℝ × ℝ)).2 g c hzero - private theorem sectorSupportedHalfCone : let SectorInterval := Set.Icc (0 : ℝ) 1 let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} @@ -73,7 +61,6 @@ private theorem sectorSupportedHalfCone : ⟨fun z => H.homotopy a z.1 (E.half f a b z.2), hc⟩ exact sectorConeDescent g (H.center a) (fun t => H.zero a _ (hp.2.2.2.1 t).1) - private theorem sectorOrderExists : ∀ x : Fin 3 → ℝ, ∃ i j k : Fin 3, i ≠ j ∧ i ≠ k ∧ j ≠ k ∧ x k ≤ x j ∧ x j ≤ x i := by @@ -90,7 +77,6 @@ private theorem sectorOrderExists : · by_cases h12 : x 1 ≤ x 2 · exact ⟨0,2,1,by decide,by decide,by decide,by linarith,by linarith⟩ · exact ⟨0,1,2,by decide,by decide,by decide,by linarith,by linarith⟩ - private theorem sectorChamber_closed : let SectorSimplex := StandardSimplex (Fin 3) let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => @@ -103,7 +89,6 @@ private theorem sectorChamber_closed : ((continuous_apply i).comp continuous_subtype_val) · exact isClosed_le ((continuous_apply k).comp continuous_subtype_val) ((continuous_apply j).comp continuous_subtype_val) - private theorem sectorOrder_cover : let SectorSimplex := StandardSimplex (Fin 3) let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => @@ -120,7 +105,6 @@ private theorem sectorOrder_cover : intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrderExists s obtain ⟨i,j,k,hij,hik,hjk,hkj,hji⟩ := sectorOrderExists s.1 exact ⟨⟨(i,j,k),hij,hik,hjk⟩,hji,hkj⟩ - private theorem sectorIndexCover : let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2} @@ -136,7 +120,6 @@ private theorem sectorIndexCover : have huniv := Finset.eq_univ_of_card t hcard have hn : n ∈ t := by rw [huniv]; simp simpa [t] using hn - private theorem sectorOrderedSum : let SectorSimplex := StandardSimplex (Fin 3) ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j @@ -150,10 +133,44 @@ private theorem sectorOrderedSum : first | contradiction | simpa [Fin.sum_univ_succ, add_assoc, add_comm, add_left_comm] using hs - -private theorem sectorParam_values : +private noncomputable abbrev sectorParameter : let SectorInterval := Set.Icc (0 : ℝ) 1; let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1}; + let SectorSimplex := StandardSimplex (Fin 3); + let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => + {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j}; + let SectorOrder := {t : Fin 3 × Fin 3 × Fin 3 // + t.1 ≠ t.2.1 ∧ t.1 ≠ t.2.2 ∧ t.2.1 ≠ t.2.2}; + let sectorI : SectorOrder → Fin 3 := fun o => o.1.1; + let sectorJ : SectorOrder → Fin 3 := fun o => o.1.2.1; + let sectorK : SectorOrder → Fin 3 := fun o => o.1.2.2; + let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o); + (∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i + ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))) → + ∀ (o : SectorOrder) (s : SectorSimplex), s ∈ sectorCh o → SectorCone := by + classical + intro SectorInterval SectorCone SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK + sectorCh sectorOrderedSum + exact fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => + let i := sectorI o + let j := sectorJ o + let k := sectorK o + have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by + simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 + have hsum : s.1 i + s.1 j + s.1 k = 1 := + sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 + have hxy := hs.1 + have hyz := hs.2 + have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + linarith [hc.1 j, hc.1 k] + have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by + linarith [hc.1 i, hsum] + have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] + have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by + nlinarith [hc.1 k] + (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, + ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) +private theorem sectorParam_values : let SectorSimplex := StandardSimplex (Fin 3); let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j}; @@ -165,37 +182,16 @@ private theorem sectorParam_values : let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o); ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone); + let sectorParam := SectorMapsProof.sectorParameter sectorOrderedSum; ∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), (sectorParam o s hs).1.1 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o) ∧ (sectorParam o s hs).1.2 = 2*(s.1 (sectorJ o)-s.1 (sectorK o)) := by classical - intro SectorInterval SectorCone SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK + intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrderedSum sectorParam o s hs constructor <;> rfl - private theorem sectorParam_continuous : - let SectorInterval := Set.Icc (0 : ℝ) 1 - let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} let SectorSimplex := StandardSimplex (Fin 3) let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} @@ -207,29 +203,11 @@ private theorem sectorParam_continuous : let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + let sectorParam := SectorMapsProof.sectorParameter sectorOrderedSum ∀ (o : SectorOrder), Continuous (fun s : {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2) := by classical - intro SectorInterval SectorCone SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK + intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrderedSum sectorParam o let A := {s : SectorSimplex // s ∈ sectorCh o} let y : A → ℝ := fun s => s.1.1 (sectorJ o) @@ -248,7 +226,6 @@ private theorem sectorParam_continuous : exact hr · apply Continuous.subtype_mk exact hb - private theorem sectorOrdersTie : let SectorSimplex := StandardSimplex (Fin 3) let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => @@ -265,7 +242,6 @@ private theorem sectorOrdersTie : classical intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' exact (P3832T1ChamberOverlap s.1 o o' ho ho').1 - private theorem sectorOrderedBetaTop : let SectorSimplex := StandardSimplex (Fin 3) let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => @@ -282,7 +258,6 @@ private theorem sectorOrderedBetaTop : classical intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' ht exact ((P3832T1ChamberOverlap s.1 o o' ho ho').2.1 ht).2.1 - private theorem sectorOrderedRBottom : let SectorSimplex := StandardSimplex (Fin 3) let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => @@ -300,10 +275,7 @@ private theorem sectorOrderedRBottom : classical intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' ht exact ((P3832T1ChamberOverlap s.1 o o' ho ho').2.2 ht).2.1 - private theorem sectorTopTieParams : - let SectorInterval := Set.Icc (0 : ℝ) 1 - let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1} let SectorSimplex := StandardSimplex (Fin 3) let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j} @@ -315,25 +287,7 @@ private theorem sectorTopTieParams : let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + let sectorParam := SectorMapsProof.sectorParameter sectorOrderedSum (∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), (sectorParam o s hs).1.1 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o) ∧ (sectorParam o s hs).1.2 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))) → ((∀ (s : SectorSimplex), ∀ (o : @@ -344,7 +298,7 @@ private theorem sectorTopTieParams : (sectorJ o)) → ((sectorParam o s ho).1.1=1 ∧ (sectorParam o s ho).1.2=(sectorParam o' s ho').1.2))) := by classical - intro SectorInterval SectorCone SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK + intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrderedSum sectorParam sectorParam_values sectorOrderedBetaTop s o o' ho ho' ht rcases sectorParam_values o s ho with ⟨hr,hb⟩ rcases sectorParam_values o' s ho' with ⟨_,hb'⟩ @@ -361,10 +315,7 @@ private theorem sectorTopTieParams : · apply Subtype.ext rw [hb,hb'] exact sectorOrderedBetaTop s o o' ho ho' ht - private theorem sectorBottomTieParams : - let SectorInterval := Set.Icc (0 : ℝ) 1; - let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1}; let SectorSimplex := StandardSimplex (Fin 3); let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j}; @@ -376,25 +327,7 @@ private theorem sectorBottomTieParams : let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o); ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone); + let sectorParam := SectorMapsProof.sectorParameter sectorOrderedSum; (∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ sectorCh o') → ((s.1 (sectorJ o)=s.1 (sectorK o)) → (2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o)= 2*(s.1 (sectorJ o')-s.1 (sectorK o'))+3*s.1 (sectorK o'))))) → (∀ @@ -402,7 +335,7 @@ private theorem sectorBottomTieParams : ∀ (ho' : s ∈ sectorCh o'), (s.1 (sectorJ o)=s.1 (sectorK o)) → ((sectorParam o s ho).1.2=0 ∧ (sectorParam o s ho).1.1=(sectorParam o' s ho').1.1)) := by classical - intro SectorInterval SectorCone SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK + intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrderedSum sectorParam sectorOrderedRBottom s o o' ho ho' ht constructor @@ -413,7 +346,6 @@ private theorem sectorBottomTieParams : change 2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o) = 2*(s.1 (sectorJ o')-s.1 (sectorK o'))+3*s.1 (sectorK o') exact sectorOrderedRBottom s o o' ho ho' ht - private theorem sectorBottomSameTop : let SectorSimplex := StandardSimplex (Fin 3) let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => @@ -430,7 +362,6 @@ private theorem sectorBottomSameTop : classical intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' ht exact ((P3832T1ChamberOverlap s.1 o o' ho ho').2.2 ht).2.2 - private theorem sectorTopTieOther : let SectorSimplex := StandardSimplex (Fin 3) let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => @@ -447,7 +378,6 @@ private theorem sectorTopTieOther : classical intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' ht exact ((P3832T1ChamberOverlap s.1 o o' ho ho').2.1 ht).1 - private theorem sectorBottomTieOther : let SectorSimplex := StandardSimplex (Fin 3) let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => @@ -464,7 +394,6 @@ private theorem sectorBottomTieOther : classical intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' ht exact ((P3832T1ChamberOverlap s.1 o o' ho ho').2.2 ht).1 - private theorem sectorTopPairClassify : let SectorSimplex := StandardSimplex (Fin 3); let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => @@ -484,7 +413,6 @@ private theorem sectorTopPairClassify : intro SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh s o o' ho ho' ht exact ((P3832T1ChamberOverlap s.1 o o' ho ho').2.1 ht).2.2 - private theorem sectorChosenCone_spec : ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), @@ -517,7 +445,6 @@ private theorem sectorChosenCone_spec : (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩) z - private theorem sectorChosenPiece_top : ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), @@ -540,25 +467,7 @@ private theorem sectorChosenPiece_top : let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + let sectorParam := SectorMapsProof.sectorParameter sectorOrderedSum ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), (∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), ∀ (ho : s ∈ sectorCh o), ∀ (ho' : s ∈ sectorCh @@ -608,7 +517,6 @@ private theorem sectorChosenPiece_top : have hin := (hp.2.2.2.1 t).1 simpa [t] using H.one (P.plane.faceVertex f (sectorI o)) (E.half f (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) t) hin - private theorem sectorChosenPiece_bottom : ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), @@ -631,25 +539,7 @@ private theorem sectorChosenPiece_bottom : let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + let sectorParam := SectorMapsProof.sectorParameter sectorOrderedSum ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), (∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), ∀ (ho : s ∈ sectorCh o), ∀ (ho' : s ∈ sectorCh @@ -697,10 +587,8 @@ private theorem sectorChosenPiece_bottom : (P.plane.face_edges f (sectorI o) (sectorJ o) o.2.1) ⟨sectorI o,rfl⟩ ⟨sectorJ o,rfl⟩ rw [hp.2.1] - private theorem sectorParam_beta_zero : let SectorInterval := Set.Icc (0 : ℝ) 1; - let SectorCone := {z : SectorInterval × SectorInterval // (z.2 : ℝ) ≤ z.1}; let SectorSimplex := StandardSimplex (Fin 3); let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => {s | s.1 j ≤ s.1 i ∧ s.1 k ≤ s.1 j}; @@ -712,39 +600,20 @@ private theorem sectorParam_beta_zero : let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o); ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone); + let sectorParam := SectorMapsProof.sectorParameter sectorOrderedSum; (∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), (sectorParam o s hs).1.1 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o) ∧ (sectorParam o s hs).1.2 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))) → (∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), (s.1 (sectorJ o)=s.1 (sectorK o)) → ((sectorParam o s hs).1.2=⟨0,by norm_num [SectorInterval]⟩)) := by classical - intro SectorInterval SectorCone SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK + intro SectorInterval SectorSimplex sectorChamber SectorOrder sectorI sectorJ sectorK sectorCh sectorOrderedSum sectorParam sectorParam_values o s hs ht apply Subtype.ext rcases sectorParam_values o s hs with ⟨_,hb⟩ rw [hb,ht] norm_num - private theorem sectorChosenPieces_agree : ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), @@ -767,25 +636,7 @@ private theorem sectorChosenPieces_agree : let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + let sectorParam := SectorMapsProof.sectorParameter sectorOrderedSum ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), (∀ (s : SectorSimplex), ∀ (o : SectorOrder), ∀ (o' : SectorOrder), (s ∈ sectorCh o) → ((s ∈ sectorCh o') → (o = @@ -912,7 +763,6 @@ private theorem sectorChosenPieces_agree : GaussianRealPoint (P.rho f) := by simpa using hone _ = H.homotopy (P.plane.faceVertex f (sectorI o')) 1 _ := by simpa using hone'.symm - private theorem sectorGlobalMap : ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), @@ -937,25 +787,7 @@ private theorem sectorGlobalMap : SectorSimplex, ∃ o : SectorOrder, s ∈ sectorCh o) → (∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + let sectorParam := SectorMapsProof.sectorParameter sectorOrderedSum ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), let sectorPiece (o : SectorOrder) @@ -997,7 +829,6 @@ private theorem sectorGlobalMap : exact sectorChosenPieces_agree f s o o' ho ho' obtain ⟨F,hF⟩ := P3832T1FiniteClosedCoverPasting (S:=S) hclosed hcover φ hagree exact ⟨F,fun o s hs => hF o s hs⟩ - private theorem sectorChosenPiece_support : ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), @@ -1021,25 +852,7 @@ private theorem sectorChosenPiece_support : let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + let sectorParam := SectorMapsProof.sectorParameter sectorOrderedSum ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), let sectorPiece (o : SectorOrder) @@ -1085,7 +898,6 @@ private theorem sectorChosenPiece_support : exact H.support (P.plane.faceVertex f (sectorI o)) w.1 w.1.2 (E.half f (P.plane.faceVertex f (sectorI o)) (P.plane.faceVertex f (sectorJ o)) w.2) hmember - private theorem sectorTopPositive : let SectorSimplex := StandardSimplex (Fin 3) let sectorChamber : Fin 3 → Fin 3 → Fin 3 → Set SectorSimplex := fun i j k => @@ -1107,7 +919,6 @@ private theorem sectorTopPositive : have hj : s.1 (sectorJ o) ≤ s.1 (sectorI o) := hs.1 have hk : s.1 (sectorK o) ≤ s.1 (sectorJ o) := hs.2 linarith - private theorem sectorChosenCone_periodic : ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), @@ -1163,7 +974,6 @@ private theorem sectorChosenCone_periodic : _ = sectorChosenCone f o (sectorCollapse w) + GaussianRealPoint u := by rw [sectorChosenCone_spec f o w] _ = sectorChosenCone f o z + GaussianRealPoint u := by rw [hw] - private theorem sectorGlobalChosen_periodic : ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), @@ -1187,25 +997,7 @@ private theorem sectorGlobalChosen_periodic : (∀ s : SectorSimplex, ∃ o : SectorOrder, s ∈ sectorCh o) → (∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + let sectorParam := SectorMapsProof.sectorParameter sectorOrderedSum ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), let sectorPiece (o : SectorOrder) @@ -1242,7 +1034,6 @@ private theorem sectorGlobalChosen_periodic : change sectorChosenCone (P.faceShift u f) o (sectorParam o s ho) = sectorChosenCone f o (sectorParam o s ho) + GaussianRealPoint u exact sectorChosenCone_periodic u f o (sectorParam o s ho) - private theorem sectorGlobalChosen_support : ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), @@ -1266,25 +1057,7 @@ private theorem sectorGlobalChosen_support : (∀ s : SectorSimplex, ∃ o : SectorOrder, s ∈ sectorCh o) → (∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + let sectorParam := SectorMapsProof.sectorParameter sectorOrderedSum ∀ (sectorParam_continuous : ∀ (o : SectorOrder), Continuous (fun s : {s : SectorSimplex // s ∈ sectorCh o} => sectorParam o s.1 s.2)), let sectorPiece (o : SectorOrder) @@ -1320,7 +1093,6 @@ private theorem sectorGlobalChosen_support : refine ⟨sectorI o, sectorTopPositive s o ho, ?_⟩ rw [sectorGlobalChosen_spec f o s ho] exact sectorChosenPiece_support f o s ho - private theorem sectorGlobalChosen_vertex : ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), @@ -1345,25 +1117,7 @@ private theorem sectorGlobalChosen_vertex : 3), n = sectorI o ∨ n = sectorJ o ∨ n = sectorK o) → (∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + let sectorParam := SectorMapsProof.sectorParameter sectorOrderedSum (∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), (sectorParam o s hs).1.1 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o) ∧ (sectorParam o s hs).1.2 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))) → (∀ (sectorParam_continuous : ∀ (o : @@ -1458,7 +1212,6 @@ private theorem sectorGlobalChosen_vertex : rw [hI] rw [hI] at hm0 exact H.zero (P.plane.faceVertex f i) (GaussianRealPoint (P.rho f)) hm0 - private theorem sectorGlobalChosen_edge : ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (H : P3776T1TileContractions P), ∀ (E : P3776T1DualEdges P), @@ -1481,25 +1234,7 @@ private theorem sectorGlobalChosen_edge : let sectorCh := fun o : SectorOrder => sectorChamber (sectorI o) (sectorJ o) (sectorK o) ∀ (sectorOrderedSum : ∀ (s : SectorSimplex), ∀ (i : Fin 3), ∀ (j : Fin 3), ∀ (k : Fin 3), (i ≠ j) → ((i ≠ k) → ((j ≠ k) → (s.1 i + s.1 j + s.1 k = 1)))), - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + let sectorParam := SectorMapsProof.sectorParameter sectorOrderedSum (∀ (o : SectorOrder), ∀ (s : SectorSimplex), ∀ (hs : s ∈ sectorCh o), (sectorParam o s hs).1.1 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))+3*s.1 (sectorK o) ∧ (sectorParam o s hs).1.2 = 2*(s.1 (sectorJ o)-s.1 (sectorK o))) → (∀ (sectorParam_continuous : ∀ (o : @@ -1636,9 +1371,7 @@ private theorem sectorGlobalChosen_edge : have hone : one = ⟨1, by norm_num [SectorInterval]⟩ := by apply Subtype.ext; rfl rw [hone, hp.2.2.1] rw [ite_eq_right hr] - end SectorMapsProof - theorem P3776T1SectorMapsExist {ι : Type} (P : PeriodicTileCore ι) (H : P3776T1TileContractions P) (E : P3776T1DualEdges P) : Nonempty (P3776T1SectorMaps P H E) := by @@ -1671,25 +1404,7 @@ theorem P3776T1SectorMapsExist {ι : Type} (P : PeriodicTileCore ι) have sectorOrderedSum (s : SectorSimplex) (i j k : Fin 3) (hij : i ≠ j) (hik : i ≠ k) (hjk : j ≠ k) := SectorMapsProof.sectorOrderedSum s i j k hij hik hjk - let sectorParam := fun (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) => - let i := sectorI o - let j := sectorJ o - let k := sectorK o - have hc : (∀ n, 0 ≤ s.1 n) ∧ ∑ n : Fin 3, s.1 n = 1 := by - simpa only [SectorSimplex, StandardSimplex, Set.mem_ofPred_eq] using s.2 - have hsum : s.1 i + s.1 j + s.1 k = 1 := - sectorOrderedSum s i j k o.2.1 o.2.2.1 o.2.2.2 - have hxy := hs.1 - have hyz := hs.2 - have hr0 : 0 ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - linarith [hc.1 j, hc.1 k] - have hr1 : 2 * (s.1 j - s.1 k) + 3 * s.1 k ≤ 1 := by - linarith [hc.1 i, hsum] - have hb0 : 0 ≤ 2 * (s.1 j - s.1 k) := by linarith [hyz] - have hbr : 2 * (s.1 j - s.1 k) ≤ 2 * (s.1 j - s.1 k) + 3 * s.1 k := by - nlinarith [hc.1 k] - (⟨⟨⟨2*(s.1 j-s.1 k)+3*s.1 k,hr0,hr1⟩, - ⟨2*(s.1 j-s.1 k),hb0,le_trans hbr hr1⟩⟩,hbr⟩ : SectorCone) + let sectorParam := SectorMapsProof.sectorParameter sectorOrderedSum have sectorParam_values (o : SectorOrder) (s : SectorSimplex) (hs : s ∈ sectorCh o) := SectorMapsProof.sectorParam_values sectorOrderedSum o s hs have sectorParam_continuous (o : SectorOrder) := SectorMapsProof.sectorParam_continuous @@ -1821,7 +1536,5 @@ theorem P3776T1SectorMapsExist {ι : Type} (P : PeriodicTileCore ι) exact sectorGlobalChosen_edge f i j hij r s hcoord · intro u f s exact sectorGlobalChosen_periodic u f s - end ApollonianSuperharmonic - end diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean index 28a49ec6b8..ce0a340295 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean @@ -4,30 +4,21 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Wesley Pegden -/ module - public import Mathlib.Init public import Mathlib.Tactic.Positivity - public import Mathlib.Algebra.BigOperators.Field public import Mathlib.Algebra.Order.Algebra public import Mathlib.Analysis.Complex.Circle public import Mathlib.Analysis.SpecialFunctions.Log.Basic - -- [TABLET NODE: P3821T1ControlledNeighborhood] - /-! # P3821T1ControlledNeighborhood - Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. -/ - @[expose] public section - namespace ApollonianSuperharmonic - namespace ControlledNeighborhoodConstruction - private noncomputable abbrev f (e : C(Circle, ℂ)) (he : Function.Injective e) : Circle ≃ Set.range e := by classical @@ -39,109 +30,57 @@ private noncomputable abbrev f (e : C(Circle, ℂ)) (he : Function.Injective e) exact congrArg Subtype.val h · rintro ⟨z, x, rfl⟩ exact ⟨x, rfl⟩) - private theorem hf (e : C(Circle, ℂ)) (he : Function.Injective e) : Continuous (f e he) := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he change (Continuous f) change Continuous (fun x : Circle => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) exact Continuous.subtype_mk e.continuous (fun x => ⟨x, rfl⟩) - private noncomputable abbrev ψ (e : C(Circle, ℂ)) (he : Function.Injective e) : Set.range e → Circle := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he exact fun x => f.symm x - private theorem hψc (e : C(Circle, ℂ)) (he : Function.Injective e) : Continuous (ψ e he) := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he have hf : Continuous f := hf e he let ψ : Set.range e → Circle := f.symm change (Continuous ψ) exact hf.continuous_symm_of_equiv_compact_to_t2 - private theorem hψleft (e : C(Circle, ℂ)) (he : Function.Injective e) : Function.LeftInverse (ψ e he) (fun x : Circle => ⟨e x, ⟨x, rfl⟩⟩) := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm change (Function.LeftInverse ψ (fun x : Circle => ⟨e x, ⟨x, rfl⟩⟩)) intro x exact f.symm_apply_apply x - private noncomputable abbrev u (e : C(Circle, ℂ)) (he : Function.Injective e) : Set.range e → ℂ := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm exact fun k => (ψ k : ℂ) - private theorem hu (e : C(Circle, ℂ)) (he : Function.Injective e) : Continuous (u e he) := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm have hψc : Continuous ψ := hψc e he let u : Set.range e → ℂ := fun k => (ψ k : ℂ) change (Continuous u) exact continuous_subtype_val.comp hψc - private theorem heUC (e : C(Circle, ℂ)) : UniformContinuous e := by classical exact CompactSpace.uniformContinuous_of_continuous e.continuous - private noncomputable abbrev δ (δ₀ : ℝ) := by classical exact min (δ₀ / 4) (1 / 8) - private theorem hδpos (δ₀ : ℝ) (hδ₀ : δ₀ > 0) : 0 < (δ δ₀) := by classical let δ := min (δ₀ / 4) (1 / 8) change (0 < δ) dsimp [δ]; positivity - private theorem hδlt (δ₀ : ℝ) (hδ₀ : δ₀ > 0) : (δ δ₀) < 1 / 4 := by classical let δ := min (δ₀ / 4) (1 / 8) @@ -150,40 +89,28 @@ private theorem hδlt (δ₀ : ℝ) (hδ₀ : δ₀ > 0) : (δ δ₀) < 1 / 4 := dsimp [δ] have : min (δ₀ / 4) (1 / 8) ≤ 1 / 8 := min_le_right _ _ linarith - private theorem hKcompact (e : C(Circle, ℂ)) : IsCompact (Set.range e) := by classical exact isCompact_range e.continuous - private theorem hψUC (e : C(Circle, ℂ)) (he : Function.Injective e) : UniformContinuous (u e he) := by classical let : CompactSpace (Set.range e) := isCompact_iff_compactSpace.mp (isCompact_range e.continuous) - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) have hu : Continuous u := hu e he change (UniformContinuous u) exact CompactSpace.uniformContinuous_of_continuous hu - private noncomputable abbrev r (eps : ℝ) (η : ℝ) := by classical exact min (η / 8) (eps / 8) - private theorem hrpos (eps : ℝ) (heps : 0 < eps) (η : ℝ) (hη : η > 0) : 0 < (r eps η) := by classical let r := min (η / 8) (eps / 8) change (0 < r) dsimp [r]; positivity - private theorem hrerr (eps : ℝ) (heps : 0 < eps) (η : ℝ) (hη : η > 0) : 2 * (r eps η) < eps / 2 := by classical @@ -193,7 +120,6 @@ private theorem hrerr (eps : ℝ) (heps : 0 < eps) (η : ℝ) (hη : η > 0) : 2 dsimp [r] have hle : min (η / 8) (eps / 8) ≤ eps / 8 := min_le_right _ _ linarith - private theorem heclose (e : C(Circle, ℂ)) (eps : ℝ) (δ₀ : ℝ) (hδ : ∀ ⦃a b : Circle⦄, dist a b < δ₀ → dist (e a) (e b) < eps / 2) (hδ₀ : δ₀ > 0) : ∀ u v : Circle, dist u v < 2 * (δ δ₀) → dist (e u) (e v) < eps / 2 := by @@ -205,20 +131,12 @@ private theorem heclose (e : C(Circle, ℂ)) (eps : ℝ) (δ₀ : ℝ) (hδ : apply hδ have hle : δ ≤ δ₀ / 4 := by dsimp [δ]; exact min_le_left _ _ linarith - private theorem hψclose (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) (δ₀ : ℝ) (η : ℝ) (hη : η > 0) (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) : ∀ k l : Set.range e, dist k l < 4 * (r eps η) → dist (((ψ e he) k : Circle) : ℂ) (((ψ e he) l : Circle) : ℂ) < (δ δ₀) := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm let δ := min (δ₀ / 4) (1 / 8) let r := min (η / 8) (eps / 8) @@ -229,26 +147,22 @@ private theorem hψclose (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : apply hηψ have hle : r ≤ η / 8 := by dsimp [r]; exact min_le_left _ _ linarith - private noncomputable abbrev F (e : C(Circle, ℂ)) (S : Set ↑(Set.range ⇑e)) (hSf : S.Finite) : Finset (Set.range e) := by classical exact hSf.toFinset - private theorem hFS (e : C(Circle, ℂ)) (S : Set ↑(Set.range ⇑e)) (hSf : S.Finite) : ((F e S hSf) : Set (Set.range e)) = S := by classical let F : Finset (Set.range e) := hSf.toFinset change ((F : Set (Set.range e)) = S) ext c; simp [F] - private theorem hFsub (e : C(Circle, ℂ)) (S : Set ↑(Set.range ⇑e)) (hSf : S.Finite) : ((F e S hSf) : Set (Set.range e)) ⊆ Set.univ := by classical let F : Finset (Set.range e) := hSf.toFinset change ((F : Set (Set.range e)) ⊆ Set.univ) simp - private theorem hcover' (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) (hcover : Set.univ ⊆ ⋃ x ∈ S, Metric.ball x (r eps η)) : (Set.univ : Set (Set.range e)) ⊆ @@ -260,12 +174,10 @@ private theorem hcover' (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range change ((Set.univ : Set (Set.range e)) ⊆ ⋃ c ∈ (F : Set (Set.range e)), Metric.ball c r) simpa [hFS] using hcover - private noncomputable abbrev w (e : C(Circle, ℂ)) (eps : ℝ) (η : ℝ) : Set.range e → ℂ → ℝ := by classical let r := min (η / 8) (eps / 8) exact fun c z => max 0 (2 * r - dist z (c : ℂ)) - private noncomputable abbrev W (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) : ℂ → ℝ := by classical @@ -273,7 +185,6 @@ private noncomputable abbrev W (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set let F : Finset (Set.range e) := hSf.toFinset let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) exact fun z => ∑ c ∈ F, w c z - private theorem hw_cont (e : C(Circle, ℂ)) (eps : ℝ) (η : ℝ) (c : Set.range e) : Continuous ((w e eps η) c) := by classical @@ -282,7 +193,6 @@ private theorem hw_cont (e : C(Circle, ℂ)) (eps : ℝ) (η : ℝ) (c : Set.ran change (Continuous (w c)) dsimp [w] fun_prop - private theorem hW_cont (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) : Continuous (W e eps S η hSf) := by classical @@ -294,7 +204,6 @@ private theorem hW_cont (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range change (Continuous W) dsimp [W] exact continuous_finsetSum F (fun c hc => hw_cont c) - private noncomputable abbrev N (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) : Set ℂ := by classical @@ -303,7 +212,6 @@ private noncomputable abbrev N (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set let w : Set.range e → ℂ → ℝ := fun c z => max 0 (2 * r - dist z (c : ℂ)) let W : ℂ → ℝ := fun z => ∑ c ∈ F, w c z exact {z | 0 < W z} - private theorem hNopen (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) : IsOpen (N e eps S η hSf) := by classical @@ -316,7 +224,6 @@ private theorem hNopen (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range dsimp only [ControlledNeighborhoodConstruction.N] at * change (IsOpen N) exact isOpen_lt continuous_const hW_cont - private theorem hKN (e : C(Circle, ℂ)) (eps : ℝ) (heps : 0 < eps) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) (hcover : Set.univ ⊆ ⋃ x ∈ S, Metric.ball x (r eps η)) (hη : η > 0) : Set.range e ⊆ (N e eps S η hSf) := by @@ -347,7 +254,6 @@ private theorem hKN (e : C(Circle, ℂ)) (eps : ℝ) (heps : 0 < eps) (S : Set (fun j hj => le_max_left 0 (2 * r - dist z (j : ℂ))) (a := c) hcF') change 0 < W z linarith - private theorem hW_N (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) : Continuous (fun z : (N e eps S η hSf) => (W e eps S η hSf) (z : ℂ)) := by classical @@ -360,7 +266,6 @@ private theorem hW_N (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑ dsimp only [ControlledNeighborhoodConstruction.N] at * change (Continuous (fun z : N => W (z : ℂ))) exact hW_cont.comp continuous_subtype_val - private noncomputable abbrev a (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) : (N e eps S η hSf) → Set.range e → ℝ := by classical @@ -372,7 +277,6 @@ private noncomputable abbrev a (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set dsimp only [ControlledNeighborhoodConstruction.N] at * change (N → Set.range e → ℝ) exact fun z c => w c (z : ℂ) / W (z : ℂ) - private theorem ha_cont (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) (c : Set.range e) : Continuous (fun z : (N e eps S η hSf) => (a e eps S η hSf) z c) := by @@ -389,18 +293,10 @@ private theorem ha_cont (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range change (Continuous (fun z : N => a z c)) dsimp [a] exact (hw_cont c).comp continuous_subtype_val |>.div hW_N (fun z => ne_of_gt z.property) - private noncomputable abbrev v (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) : (N e eps S η hSf) → ℂ := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) let r := min (η / 8) (eps / 8) @@ -412,18 +308,10 @@ private noncomputable abbrev v (e : C(Circle, ℂ)) (he : Function.Injective e) dsimp only [ControlledNeighborhoodConstruction.N] at * change (N → ℂ) exact fun z => ∑ c ∈ F, (a z c : ℂ) * u c - private theorem hv_cont (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) : Continuous (v e he eps S η hSf) := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) let r := min (η / 8) (eps / 8) @@ -440,7 +328,6 @@ private theorem hv_cont (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : intro c hc have hac := ha_cont c fun_prop - private theorem hactive (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) (z : (N e eps S η hSf)) : ∃ i ∈ (F e S hSf), 0 < (w e eps η) i (z : ℂ) := by classical @@ -456,7 +343,6 @@ private theorem hactive (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range Finset.sum_nonpos (fun c hc => h c hc) have hz : 0 < W (z : ℂ) := z.property linarith - private theorem hw_active_dist (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) (z : (N e eps S η hSf)) (c : Set.range e) (hc : 0 < (w e eps η) c (z : ℂ)) : dist (z : ℂ) (c : ℂ) < 2 * (r eps η) := by @@ -466,18 +352,10 @@ private theorem hw_active_dist (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set change (dist (z : ℂ) (c : ℂ) < 2 * r) change 0 < max 0 (2 * r - dist (z : ℂ) (c : ℂ)) at hc exact sub_pos.mp ((lt_max_iff.mp hc).resolve_left (lt_irrefl 0)) - private theorem hψmap (e : C(Circle, ℂ)) (he : Function.Injective e) (c : Set.range e) : e ((ψ e he) c) = c := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm have hψleft : Function.LeftInverse ψ (fun x : Circle => ⟨e x, ⟨x, rfl⟩⟩) := hψleft e he change (e (ψ c) = c) @@ -486,7 +364,6 @@ private theorem hψmap (e : C(Circle, ℂ)) (he : Function.Injective e) (c : Set have hh := hψleft x change ψ ⟨e x, ⟨x, rfl⟩⟩ = x at hh rw [hh] - private theorem ha_nonneg (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) (z : (N e eps S η hSf)) (c : Set.range e) : 0 ≤ (a e eps S η hSf) z c := by classical @@ -500,7 +377,6 @@ private theorem ha_nonneg (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.rang apply div_nonneg · exact le_max_left 0 _ · exact le_of_lt z.property - private theorem hsum_a (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) (z : (N e eps S η hSf)) : (∑ c ∈ (F e S hSf), (a e eps S η hSf) z c) = 1 := by classical @@ -514,21 +390,13 @@ private theorem hsum_a (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range rw [← Finset.sum_div] rw [show (∑ c ∈ F, w c (z : ℂ)) = W (z : ℂ) by rfl] exact div_self z.property.ne' - private theorem hv_close (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) (z : (N e eps S η hSf)) (i : Set.range e) (hi : i ∈ (F e S hSf)) (hwi : 0 < (w e eps η) i (z : ℂ)) : ‖(v e he eps S η hSf) z - (u e he) i‖ < (δ δ₀) := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) let δ := min (δ₀ / 4) (1 / 8) @@ -613,37 +481,21 @@ private theorem hv_close (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : exact norm_sum_le _ _ _ < ∑ c ∈ F, a z c * δ := hsum_strict _ = δ := by rw [← Finset.sum_mul, hsum_a z]; ring - private theorem hunit (e : C(Circle, ℂ)) (he : Function.Injective e) (c : Set.range e) : ‖(u e he) c‖ = 1 := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) change (‖u c‖ = 1) dsimp [u] exact Circle.norm_coe (ψ c) - private theorem hv_lower (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) (z : (N e eps S η hSf)) : 1 - (δ δ₀) < ‖(v e he eps S η hSf) z‖ := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) let δ := min (δ₀ / 4) (1 / 8) @@ -671,20 +523,12 @@ private theorem hv_lower (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : _ ≤ ‖u i - v z‖ + ‖v z‖ := norm_add_le _ _ _ = ‖v z - u i‖ + ‖v z‖ := by rw [hrev] linarith - private theorem hv_pos (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) (z : (N e eps S η hSf)) : 0 < ‖(v e he eps S η hSf) z‖ := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) let δ := min (δ₀ / 4) (1 / 8) @@ -700,18 +544,10 @@ private theorem hv_pos (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : have hv_lower (z : N) : 1 - δ < ‖v z‖ := hv_lower e he eps heps S δ₀ η hSf hη hδ₀ hηψ z change (0 < ‖v z‖) linarith [hv_lower z] - private noncomputable abbrev p (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) : (N e eps S η hSf) → ℂ := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) let r := min (η / 8) (eps / 8) @@ -724,20 +560,12 @@ private noncomputable abbrev p (e : C(Circle, ℂ)) (he : Function.Injective e) dsimp only [ControlledNeighborhoodConstruction.N] at * change (N → ℂ) exact fun z => v z / (‖v z‖ : ℂ) - private theorem hp_norm (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) (z : (N e eps S η hSf)) : ‖(p e he eps S η hSf) z‖ = 1 := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) let r := min (η / 8) (eps / 8) @@ -757,7 +585,6 @@ private theorem hp_norm (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : _ = ‖v z‖ := abs_of_nonneg (norm_nonneg _) rw [norm_div, hden] exact div_self (ne_of_gt (hv_pos z)) - private noncomputable abbrev phiVal (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) @@ -765,21 +592,12 @@ private noncomputable abbrev phiVal (e : C(Circle, ℂ)) (he : Function.Injectiv exact fun z => ⟨p e he eps S η hSf z, (mem_sphere_zero_iff_norm).2 (hp_norm e he eps heps S δ₀ η hSf hη hδ₀ hηψ z)⟩ - - private theorem hp_cont (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) : Continuous (p e he eps S η hSf) := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) let r := min (η / 8) (eps / 8) @@ -798,20 +616,12 @@ private theorem hp_cont (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : apply hv_cont.div hden intro z exact_mod_cast (ne_of_gt (hv_pos z)) - private theorem hphiVal_cont (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) : Continuous (phiVal e he eps heps S δ₀ η hSf hη hδ₀ hηψ) := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) let r := min (η / 8) (eps / 8) @@ -828,7 +638,6 @@ private theorem hphiVal_cont (e : C(Circle, ℂ)) (he : Function.Injective e) (e change (Continuous phiVal) dsimp [phiVal] exact Continuous.subtype_mk hp_cont (fun z => (mem_sphere_zero_iff_norm).2 (hp_norm z)) - private theorem norm_normalize (x : ℂ) (hx : 0 < ‖x‖) : ‖x / (‖x‖ : ℂ) - x‖ = |1 - ‖x‖| := by classical @@ -847,21 +656,13 @@ private theorem norm_normalize (x : ℂ) (hx : 0 < ‖x‖) : rw [show 1 / ‖x‖ - 1 = (1 - ‖x‖) / ‖x‖ by field_simp] rw [abs_div, abs_of_pos hx] field_simp - private theorem hphi_near (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ δ₀)) (z : (N e eps S η hSf)) : ∀ i ∈ (F e S hSf), 0 < (w e eps η) i (z : ℂ) → ‖(p e he eps S η hSf) z - (u e he) i‖ < 2 * (δ δ₀) := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) let δ := min (δ₀ / 4) (1 / 8) @@ -896,7 +697,6 @@ private theorem hphi_near (e : C(Circle, ℂ)) (he : Function.Injective e) (eps ‖p z - u i‖ = ‖(p z - v z) + (v z - u i)‖ := by congr 1; abel _ ≤ ‖p z - v z‖ + ‖v z - u i‖ := norm_add_le _ _ linarith - private theorem hphi_circle_close (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) (S : Set ↑(Set.range ⇑e)) (δ₀ : ℝ) (η : ℝ) (hSf : S.Finite) (hη : η > 0) (hδ₀ : δ₀ > 0) (hηψ : ∀ ⦃a b : ↑(Set.range ⇑e)⦄, dist a b < η → dist ((u e he) a) ((u e he) b) < (δ @@ -904,14 +704,7 @@ private theorem hphi_circle_close (e : C(Circle, ℂ)) (he : Function.Injective (hwi : 0 < (w e eps η) i (z : ℂ)) : dist ((phiVal e he eps heps S δ₀ η hSf hη hδ₀ hηψ) z) ((ψ e he) i) < 2 * (δ δ₀) := by classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) let δ := min (δ₀ / 4) (1 / 8) @@ -937,23 +730,14 @@ private theorem hphi_circle_close (e : C(Circle, ℂ)) (he : Function.Injective _ = dist (p z) (u i) := by rfl _ = ‖p z - u i‖ := dist_eq_norm _ _ _ < 2 * δ := h - end ControlledNeighborhoodConstruction - theorem P3821T1ControlledNeighborhood (e : C(Circle, ℂ)) (he : Function.Injective e) (eps : ℝ) (heps : 0 < eps) : ∃ N : Set ℂ, IsOpen N ∧ Set.range e ⊆ N ∧ ∃ phi : C(N, Circle), ∀ z : N, ‖e (phi z) - (z : ℂ)‖ < eps := by -- BODY classical - let f : Circle ≃ Set.range e := Equiv.ofBijective - (fun x => (⟨e x, ⟨x, rfl⟩⟩ : Set.range e)) (by - constructor - · intro x y h - apply he - exact congrArg Subtype.val h - · rintro ⟨z, x, rfl⟩ - exact ⟨x, rfl⟩) + let f : Circle ≃ Set.range e := ControlledNeighborhoodConstruction.f e he let : T2Space (Set.range e) := inferInstance let ψ : Set.range e → Circle := f.symm let u : Set.range e → ℂ := fun k => (ψ k : ℂ) @@ -1013,7 +797,5 @@ theorem P3821T1ControlledNeighborhood (e : C(Circle, ℂ)) rw [hecenter] at hecurve have hzcenter' : dist (i : ℂ) (z : ℂ) < 2 * r := by simpa [dist_comm] using hzcenter linarith [hecurve, hzcenter', hrerr] - end ApollonianSuperharmonic - end diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean index 031d04c1c4..45a74900b3 100644 --- a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean +++ b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean @@ -4,31 +4,22 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Wesley Pegden -/ module - public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties - public import LeanPool.ApollonianSuperharmonic.P4812T1AffineDrawing public import LeanPool.ApollonianSuperharmonic.P4677T2TouchingWalk public import LeanPool.ApollonianSuperharmonic.P4733T1WalkTransport public import LeanPool.ApollonianSuperharmonic.TouchingTriple - -- [TABLET NODE: P4812T1RegularFaceWalks] - /-! # P4812T1RegularFaceWalks - Adapted from Wesley Pegden’s Apache-2.0 Trellis formalization of Levine–Pegden–Smart. Changes: pool module paths, public exports, project namespace and current Mathlib compatibility. -/ - @[expose] public section - namespace ApollonianSuperharmonic - namespace RegularFaceWalkProof - private theorem boundaryFoot : (by classical @@ -70,9 +61,7 @@ private theorem boundaryFoot : · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ · simpa [BoundaryFootprintVertices, FootprintVertices, hW] using hz - private abbrev translateComp := ApollonianSuperharmonic.TileTranslationProperties.add - private theorem edgeDiff : (by classical @@ -119,7 +108,6 @@ private theorem edgeDiff : · have hm : y - x = a + b := by simpa [map_sub, k.apply_symm_apply, a, b, k11] using congrArg k h6 exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl (forward hm))))) - private theorem uniquePair : (by classical @@ -163,7 +151,6 @@ private theorem uniquePair : · rcases hcd' with ⟨hcp, hdq⟩ | ⟨hcq, hdp⟩ · exact Or.inr ⟨hfq.trans hdq.symm, hgp.trans hcp.symm⟩ · exact Or.inl ⟨hfq.trans hcq.symm, hgp.trans hdp.symm⟩ - private theorem rho_mem : (by classical @@ -263,9 +250,7 @@ private theorem rho_mem : rw [← translateComp T (b : GaussianInt) (x : GaussianInt)] exact boundaryFoot _ _ (translateBoundary (TileTranslation T (b : GaussianInt)) rd (x : GaussianInt) rdb) - private abbrev transZero := ApollonianSuperharmonic.TileTranslationProperties.zero - private theorem mapTranslateRev : (by classical @@ -286,7 +271,6 @@ private theorem mapTranslateRev : _ = (((p.map (fun z => z + (x : GaussianInt))).reverse).map (fun z => z + (u : GaussianInt))) := by simp [List.map_reverse] - private theorem ifMap3 : (by classical @@ -305,9 +289,7 @@ private theorem ifMap3 : intro L u P0 P1 P2 Q0 Q1 Q2 h0 h1 h2 A0 A1 A2 B0 B1 B2 m0 m1 m2 by_cases hq0 : Q0 <;> by_cases hq1 : Q1 <;> by_cases hq2 : Q2 <;> simp [h0, h1, h2, hq0, hq1, hq2, m0, m1, m2] - private abbrev boundaryEdgeFoot := ApollonianSuperharmonic.BoundaryFootprintInclusion.boundaryEdge - private theorem commonEdgeTouch : (by classical @@ -337,7 +319,6 @@ private theorem commonEdgeTouch : exact ⟨e, boundaryEdgeFoot V e he.1, boundaryEdgeFoot W e he.2⟩ · exact (Finset.nonempty_iff_ne_empty.mp hneV h.1).elim · exact (Finset.nonempty_iff_ne_empty.mp hneW h.1).elim - private theorem rowEdge2 : (by classical @@ -366,7 +347,6 @@ private theorem rowEdge2 : sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using footprintEdgeTranslate (TileTranslation T (-(b : GaussianInt))) (w : GaussianInt) e2 he2.2 - private theorem rowWalk0 : (by classical @@ -404,7 +384,6 @@ private theorem rowWalk0 : (rho fU) (rho fDa) p0 hb).2 (w : GaussianInt) simpa [P4733T1ContainedWalk, tileAdd, rhoUpShift, rhoDown0Shift, add_assoc, add_comm, add_left_comm] using ht - private theorem rowWalk1 : (by classical @@ -443,7 +422,6 @@ private theorem rowWalk1 : simpa [P4733T1ContainedWalk, translateComp, rhoUpShift, rhoDown1Shift, AddSubgroup.coe_neg, AddSubgroup.coe_sub, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using ht - private theorem rowWalk2 : (by classical @@ -484,7 +462,6 @@ private theorem rowWalk2 : simpa [P4733T1ContainedWalk, translateComp, rhoUpShift, rhoDown2Shift, fDamB, AddSubgroup.coe_neg, AddSubgroup.coe_sub, AddSubgroup.coe_add, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using ht - private theorem row0Inc : (by classical @@ -505,7 +482,6 @@ private theorem row0Inc : · exact ⟨1, by simp [D.up_vertices, a]⟩ · exact ⟨1, by simp [D.down_vertices, a, sub_eq_add_neg]⟩ · exact ⟨0, by simp [D.down_vertices]⟩ - private theorem row1Inc : (by classical @@ -527,7 +503,26 @@ private theorem row1Inc : · exact ⟨0, by simp [D.down_vertices]⟩ · exact ⟨2, by simp [D.down_vertices, b, sub_eq_add_neg, add_comm, add_left_comm]⟩ - +private noncomputable abbrev regularFacePath + (L : AddSubgroup GaussianInt) (k : (Int × Int) ≃+ L) + (D : P4812T1AffineDrawing L k) (a b : L) + (rowPath : Fin 3 → List GaussianInt) : + D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by + letI : ∀ p : Prop, Decidable p := Classical.propDecidable + exact match D.faces.symm f, D.faces.symm g with + | Sum.inl x, Sum.inr y => + if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) + else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) + else if y = x + (a - b) then + (rowPath 2).map (fun z => z + (x : GaussianInt)) + else [] + | Sum.inr y, Sum.inl x => + if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse + else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse + else if y = x + (a - b) then + ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse + else [] + | _, _ => [] private theorem row2CanonicalForward : (by classical @@ -539,22 +534,9 @@ private theorem row2CanonicalForward : ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath (a ≠ a - b) → ((-b ≠ a - b) → (∀ (w : ↥L), path ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inl w)) ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w + a - b))) = List.map (fun (z : GaussianInt) => z + (↑w : GaussianInt)) p2)) @@ -574,10 +556,10 @@ private theorem row2CanonicalForward : simpa [sub_eq_add_neg, add_assoc] using hh exact (add_left_cancel h').symm have ht : w + a - b = w + (a - b) := by abel - simp only [path, D.faces.symm_apply_apply, ite_eq_right hn1, ite_eq_right hn2, + simp only [path, RegularFaceWalkProof.regularFacePath, + D.faces.symm_apply_apply, ite_eq_right hn1, ite_eq_right hn2, ite_eq_left ht, rowPath] simp - private theorem row1CanonicalForward : (by classical @@ -589,22 +571,9 @@ private theorem row1CanonicalForward : ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath (a ≠ -b) → (∀ (w : ↥L), path ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inl w)) ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w - b))) = List.map (fun (z : GaussianInt) => z + (↑w : GaussianInt)) p1) @@ -616,10 +585,9 @@ private theorem row1CanonicalForward : apply aNeNegB have h' : w + (-b) = w + a := by simpa [sub_eq_add_neg] using hh exact (add_left_cancel h').symm - simp only [path, D.faces.symm_apply_apply, ite_eq_right hn, + simp only [path, RegularFaceWalkProof.regularFacePath, D.faces.symm_apply_apply, ite_eq_right hn, rowPath] simp - private theorem row1CanonicalBackward : (by classical @@ -631,22 +599,9 @@ private theorem row1CanonicalBackward : ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath (a ≠ -b) → (∀ (w : ↥L), path ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w - b))) ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inl w)) = (List.map (fun (z : GaussianInt) => z + (↑w : GaussianInt)) p1).reverse) @@ -658,10 +613,9 @@ private theorem row1CanonicalBackward : apply aNeNegB have h' : w + (-b) = w + a := by simpa [sub_eq_add_neg] using hh exact (add_left_cancel h').symm - simp only [path, D.faces.symm_apply_apply, ite_eq_right hn, + simp only [path, RegularFaceWalkProof.regularFacePath, D.faces.symm_apply_apply, ite_eq_right hn, rowPath] simp - private theorem row2CanonicalBackward : (by classical @@ -673,22 +627,9 @@ private theorem row2CanonicalBackward : ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath (a ≠ a - b) → ((-b ≠ a - b) → (∀ (w : ↥L), path ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w + a - b))) ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inl w)) = (List.map (fun (z : GaussianInt) => z + (↑w : GaussianInt)) p2).reverse)) @@ -708,10 +649,10 @@ private theorem row2CanonicalBackward : simpa [sub_eq_add_neg, add_assoc] using hh exact (add_left_cancel h').symm have ht : w + a - b = w + (a - b) := by abel - simp only [path, D.faces.symm_apply_apply, ite_eq_right hn1, ite_eq_right hn2, + simp only [path, RegularFaceWalkProof.regularFacePath, + D.faces.symm_apply_apply, ite_eq_right hn1, ite_eq_right hn2, ite_eq_left ht, rowPath] simp - private theorem walkClaims : (by classical @@ -728,22 +669,9 @@ private theorem walkClaims : ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (fc : D.plane.Face), ∀ (gc : D.plane.Face), ∀ (P : List GaussianInt), P4733T1ContainedWalk A B (rho fc) (rho gc) P → path fc gc = P → path gc fc = P.reverse → ∀ (f : D.plane.Face), ∀ (g : D.plane.Face), f = fc ∧ g = @@ -759,7 +687,6 @@ private theorem walkClaims : · simpa [P4733T1ContainedWalk, hf, hg, hforward] using hw · have hr := (P4733T1WalkTransport A B (rho fc) (rho gc) P hw).1 simpa [P4733T1ContainedWalk, hf, hg, hbackward] using hr - private theorem commonEdgeForAdjacent : (by classical @@ -806,7 +733,6 @@ private theorem commonEdgeForAdjacent : have hy : y + b - b = y := by abel have hx : y + b + a = x := by rw [h]; abel simpa [hy, hx] using rowEdge2 (y + b) - private theorem hcAt922 : (by classical @@ -831,39 +757,7 @@ private theorem hcAt922 : if r = 0 then p0 else if r = 1 then p1 else p2; (let path : D.plane.Face → D.plane.Face → List GaussianInt := - fun f g => - by - letI : ∀ p : Prop, Decidable p := - Classical.propDecidable - exact - match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then - (rowPath 0).map (fun z => z + (x : GaussianInt)) - else - if y = x - b then - (rowPath 1).map - (fun z => z + (x : GaussianInt)) - else - if y = x + (a - b) then - (rowPath 2).map - (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then - ((rowPath 0).map - (fun z => z + (x : GaussianInt))).reverse - else - if y = x - b then - ((rowPath 1).map - (fun z => z + (x : GaussianInt))).reverse - else - if y = x + (a - b) then - ((rowPath 2).map - (fun z => - z + (x : GaussianInt))).reverse - else [] - | _, _ => []; + RegularFaceWalkProof.regularFacePath L k D a b rowPath (∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (fc : D.plane.Face), @@ -940,7 +834,6 @@ private theorem hcAt922 : exact walkClaims (TileTranslation T (w : GaussianInt)) (TileTranslation T ((w - b : L) : GaussianInt)) fc gc (p1.map (fun z => z + (w : GaussianInt))) hw hforward hbackward f g hpair - private theorem hdAt961 : (by classical @@ -972,7 +865,6 @@ private theorem hdAt961 : · refine ⟨2, ?_⟩ change D.plane.faceVertex (D.faces (.inr (w + a - b))) 2 = y exact (D.down_vertices (w + a - b)).2.2.trans h2 - private theorem hdAt1029 : (by classical @@ -1005,11 +897,8 @@ private theorem hdAt1029 : · refine ⟨2, ?_⟩ change D.plane.faceVertex (D.faces (.inr (w + a - b))) 2 = x exact (D.down_vertices (w + a - b)).2.2.trans h2 - end RegularFaceWalkProof - namespace RegularFaceDetails - private theorem translateBoundary : (by classical @@ -1022,7 +911,6 @@ private theorem translateBoundary : rw [(TileTranslationFormulas W v).2.2.2.2.2.2.2.1] exact ⟨z, hz, by simp [GaussianTranslation] ⟩ - private theorem k11 : (by classical @@ -1036,7 +924,6 @@ private theorem k11 : have h : ((1, 1) : Int × Int) = ((1, 0) : Int × Int) + (0, 1) := by ext <;> norm_num rw [h, map_add] - private theorem kneg11 : (by classical @@ -1050,7 +937,6 @@ private theorem kneg11 : have h : ((-1, -1) : Int × Int) = -((1, 1) : Int × Int) := by ext <;> norm_num rw [h, map_neg, k11] - private theorem kneg10 : (by classical @@ -1063,7 +949,6 @@ private theorem kneg10 : have h : ((-1, 0) : Int × Int) = -((1, 0) : Int × Int) := by ext <;> norm_num rw [h, map_neg] - private theorem kneg01 : (by classical @@ -1076,7 +961,6 @@ private theorem kneg01 : have h : ((0, -1) : Int × Int) = -((0, 1) : Int × Int) := by ext <;> norm_num rw [h, map_neg] - private theorem touchSymm : (by classical @@ -1090,7 +974,6 @@ private theorem touchSymm : by simpa [Set.inter_comm] using hp⟩ · exact Or.inr (Or.inr ⟨h.1, h.2⟩) · exact Or.inr (Or.inl ⟨h.1, h.2⟩) - private theorem dmb0 : (by classical @@ -1112,7 +995,6 @@ private theorem dmb0 : intro L k D T b ru rd rho rho_mem transZero fDmb simpa [fDmb, b, D.down_vertices, transZero, add_assoc, add_comm, add_left_comm] using rho_mem (.inr (-b)) 2 - private theorem damB_mb : (by classical @@ -1134,7 +1016,6 @@ private theorem damB_mb : intro L k D T a b ru rd rho rho_mem fDamB have heq : (a - b - a : L) = -b := by abel simpa [fDamB, a, b, D.down_vertices, heq] using rho_mem (.inr (a - b)) 1 - private theorem shiftEq : (by classical @@ -1145,7 +1026,6 @@ private theorem shiftEq : intro L u x y d rw [add_assoc] exact add_left_cancel_iff - private theorem mapTranslate : (by classical @@ -1161,7 +1041,6 @@ private theorem mapTranslate : funext z simp only [AddSubgroup.coe_add] abel - private theorem transNonempty : (by classical @@ -1174,7 +1053,6 @@ private theorem transNonempty : change (T.cells.image (GaussianTranslation v)).Nonempty refine ⟨GaussianTranslation v c, ?_⟩ exact Finset.mem_image.mpr ⟨c, hc, rfl⟩ - private theorem footprintEdgeTranslate : (by classical @@ -1185,7 +1063,6 @@ private theorem footprintEdgeTranslate : intro V v e he rw [(TileTranslationFormulas V v).2.2.2.2.2.2.1] exact ⟨e, he, by simp⟩ - private theorem tileAdd : (by classical @@ -1199,7 +1076,6 @@ private theorem tileAdd : intro L T translateComp v w rw [translateComp] simp only [AddSubgroup.coe_add] - private theorem rowEdge0 : (by classical @@ -1220,7 +1096,6 @@ private theorem rowEdge0 : simpa [tileAdd, add_comm] using footprintEdgeTranslate (TileTranslation T (a : GaussianInt)) (w : GaussianInt) e0 he0.2 - private theorem rowEdge1 : (by classical @@ -1242,7 +1117,6 @@ private theorem rowEdge1 : sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using footprintEdgeTranslate (TileTranslation T (-(b : GaussianInt))) (w : GaussianInt) e1 he1.2 - private theorem rhoUpShift : (by classical @@ -1259,7 +1133,6 @@ private theorem rhoUpShift : classical intro L k D ru rd rho fU w simp [rho, fU, D.faces.symm_apply_apply] - private theorem rhoDown0Shift : (by classical @@ -1277,7 +1150,6 @@ private theorem rhoDown0Shift : classical intro L k D a ru rd rho w simp [rho, D.faces.symm_apply_apply, AddSubgroup.coe_add, add_comm, add_left_comm] - private theorem rhoDown1Shift : (by classical @@ -1296,7 +1168,6 @@ private theorem rhoDown1Shift : intro L k D b ru rd rho w simp [rho, D.faces.symm_apply_apply, sub_eq_add_neg, add_comm, add_left_comm] - private theorem rhoDown2Shift : (by classical @@ -1316,7 +1187,6 @@ private theorem rhoDown2Shift : intro L k D a b ru rd rho w simp [rho, D.faces.symm_apply_apply, AddSubgroup.coe_add, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] - private theorem faceTagsNe : (by classical @@ -1328,7 +1198,6 @@ private theorem faceTagsNe : intro L k D x y h have hh := D.faces.injective h cases hh - private theorem aNeNegB : (by classical @@ -1341,7 +1210,6 @@ private theorem aNeNegB : intro L k a b h have hcoord := congrArg k.symm h norm_num [a, b] at hcoord - private theorem aNeAmB : (by classical @@ -1354,7 +1222,6 @@ private theorem aNeAmB : intro L k a b h have hcoord := congrArg k.symm h norm_num [a, b] at hcoord - private theorem negBNeAmB : (by classical @@ -1367,7 +1234,6 @@ private theorem negBNeAmB : intro L k a b h have hcoord := congrArg k.symm h norm_num [a, b] at hcoord - private theorem row0CanonicalForward : (by classical @@ -1379,29 +1245,15 @@ private theorem row0CanonicalForward : ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath ∀ (w : ↥L), path ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inl w)) ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w + a))) = List.map (fun (z : GaussianInt) => z + (↑w : GaussianInt)) p0 ) := by classical intro L k D a b p0 p1 p2 rowPath path w - simp [path, rowPath, D.faces.symm_apply_apply] - + simp [path, RegularFaceWalkProof.regularFacePath, rowPath, D.faces.symm_apply_apply] private theorem row0CanonicalBackward : (by classical @@ -1413,29 +1265,15 @@ private theorem row0CanonicalBackward : ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath ∀ (w : ↥L), path ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inr (w + a))) ((D.faces : ↥L ⊕ ↥L → D.plane.Face) (Sum.inl w)) = (List.map (fun (z : GaussianInt) => z + (↑w : GaussianInt)) p0).reverse ) := by classical intro L k D a b p0 p1 p2 rowPath path w - simp [path, rowPath, D.faces.symm_apply_apply] - + simp [path, RegularFaceWalkProof.regularFacePath, rowPath, D.faces.symm_apply_apply] private theorem transportContainedWalk : (by classical @@ -1447,7 +1285,6 @@ private theorem transportContainedWalk : intro A B A' B' s t P hA hB hw rw [← hA, ← hB] exact hw - private theorem hs1At1481 : (by classical @@ -1460,7 +1297,6 @@ private theorem hs1At1481 : intro L k b shiftEq u x y have := shiftEq u x y (-b) simpa [sub_eq_add_neg] using this - private theorem hs1At1495 : (by classical @@ -1473,7 +1309,6 @@ private theorem hs1At1495 : intro L k b shiftEq u x y have := shiftEq u y x (-b) simpa [sub_eq_add_neg] using this - private theorem hwAt1515 : (by classical @@ -1497,7 +1332,6 @@ private theorem hwAt1515 : classical intro L k D T a ru rd x rho p0 rowWalk0 y h fc gc simpa [h] using rowWalk0 x - private theorem hcAt1607 : (by classical @@ -1520,7 +1354,6 @@ private theorem hcAt1607 : · refine ⟨1, ?_⟩ change D.plane.faceVertex (D.faces (.inl w)) 1 = y exact (D.up_vertices w).2.1.trans hwy - private theorem hwxAt1656 : (by classical @@ -1537,7 +1370,6 @@ private theorem hwxAt1656 : w + a = y + b + a := by rfl _ = y + (a + b) := by abel _ = x := h.symm - private theorem hcAt1662 : (by classical @@ -1560,7 +1392,6 @@ private theorem hcAt1662 : · refine ⟨1, ?_⟩ change D.plane.faceVertex (D.faces (.inl w)) 1 = x exact (D.up_vertices w).2.1.trans hwx - private theorem hwAt1679 : (by classical @@ -1588,11 +1419,8 @@ private theorem hwAt1679 : classical intro L k D T a b ru rd rho p2 rowWalk2 y w fc gc exact rowWalk2 w - end RegularFaceDetails - namespace RegularFaceProperties - private theorem rhoPeriodic : (by classical @@ -1625,7 +1453,6 @@ private theorem rhoPeriodic : (rd + (x : GaussianInt)) + (u : GaussianInt) simp only [AddSubgroup.coe_add] abel - private theorem pathReverse : (by classical @@ -1637,39 +1464,25 @@ private theorem pathReverse : ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath ∀ f, ∀ g, path g f = (path f g).reverse ) := by classical intro L k D a b p0 p1 p2 rowPath path f g cases hf : D.faces.symm f with | inl x => cases hg : D.faces.symm g with - | inl y => simp [path, hf, hg] + | inl y => simp [path, RegularFaceWalkProof.regularFacePath, hf, hg] | inr y => - simp only [path, hf, hg] + simp only [path, RegularFaceWalkProof.regularFacePath, hf, hg] split_ifs <;> simp | inr x => cases hg : D.faces.symm g with | inl y => - simp only [path, hf, hg] + simp only [path, RegularFaceWalkProof.regularFacePath, hf, hg] split_ifs <;> simp - | inr y => simp [path, hf, hg] - + | inr y => simp [path, RegularFaceWalkProof.regularFacePath, hf, hg] private theorem pathPeriodic : (by classical @@ -1681,22 +1494,9 @@ private theorem pathPeriodic : ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath (∀ (u : L), ∀ (x : L), ∀ (y : L), ∀ (d : L), (u + y = u + x + d) ↔ y = x + d) → ((∀ (p : List GaussianInt), ∀ (x : L), ∀ (u : L), p.map (fun z => z + ((u + x : L) : GaussianInt)) = (p.map (fun z => z + (x : GaussianInt))).map (fun z => z + (u : @@ -1722,9 +1522,9 @@ private theorem pathPeriodic : cases hf : D.faces.symm f with | inl x => cases hg : D.faces.symm g with - | inl y => simp [path, hf, hg, D.faces.symm_apply_apply] + | inl y => simp [path, RegularFaceWalkProof.regularFacePath, hf, hg, D.faces.symm_apply_apply] | inr y => - simp only [path, hf, hg, D.faces.symm_apply_apply, + simp only [path, RegularFaceWalkProof.regularFacePath, hf, hg, D.faces.symm_apply_apply, Sum.map_inl, Sum.map_inr] have hs0 := shiftEq u x y a have hs1 : (u + y = u + x - b) ↔ y = x - b := RegularFaceDetails.hs1At1481 L k @@ -1737,7 +1537,7 @@ private theorem pathPeriodic : | inr x => cases hg : D.faces.symm g with | inl y => - simp only [path, hf, hg, D.faces.symm_apply_apply, + simp only [path, RegularFaceWalkProof.regularFacePath, hf, hg, D.faces.symm_apply_apply, Sum.map_inl, Sum.map_inr] have hs0 := shiftEq u y x a have hs1 : (u + x = u + y - b) ↔ x = y - b := RegularFaceDetails.hs1At1495 L k @@ -1747,8 +1547,7 @@ private theorem pathPeriodic : exact ifMap3 u _ _ _ _ _ _ hs0 hs1 hs2 _ _ _ _ _ _ (mapTranslateRev (rowPath 0) y u) (mapTranslateRev (rowPath 1) y u) (mapTranslateRev (rowPath 2) y u) - | inr y => simp [path, hf, hg, D.faces.symm_apply_apply] - + | inr y => simp [path, RegularFaceWalkProof.regularFacePath, hf, hg, D.faces.symm_apply_apply] private theorem firstForward : (by classical @@ -1773,22 +1572,9 @@ private theorem firstForward : let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 ∀ (y : ↥L), - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath (∀ (w : L), P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) (TileTranslation T ((w + a : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho (D.faces (.inr (w + a)))) (p0.map (fun z => z + (w : GaussianInt)))) → ((∀ (x : L), ∀ (y : L), D.faces @@ -1830,7 +1616,6 @@ private theorem firstForward : (p0.map (fun z => z + (x : GaussianInt))) := RegularFaceDetails.hwAt1515 L k D T ru rd x p0 rowWalk0 y h exact walkClaims _ _ fc gc _ hw hforward hbackward f g hpair - private theorem firstBackward : (by classical @@ -1855,22 +1640,9 @@ private theorem firstBackward : let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 ∀ (y : ↥L), - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath (∀ (w : L), P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) (TileTranslation T ((w + a : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho (D.faces (.inr (w + a)))) (p0.map (fun z => z + (w : GaussianInt)))) → ((∀ (x : L), ∀ (y : L), D.faces @@ -1915,7 +1687,6 @@ private theorem firstBackward : (p0.map (fun z => z + (w : GaussianInt))) := rowWalk0 w have hclaims := walkClaims _ _ fc gc _ hw hforward hbackward f g hpair simpa [h, w, Set.inter_comm, P4733T1ContainedWalk] using hclaims - private theorem secondForward : (by classical @@ -1940,22 +1711,9 @@ private theorem secondForward : let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 ∀ (y : ↥L), - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath (∀ (w : L), P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) (TileTranslation T ((w - b : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho (D.faces (.inr (w - b)))) (p1.map (fun z => z + (w : GaussianInt)))) → ((∀ (x : L), ∀ (y : L), D.faces @@ -2009,7 +1767,6 @@ private theorem secondForward : rcases he x' y' l₁ l₂ hp with ⟨he1, he2⟩ exact ⟨by simpa [hwx, AddSubgroup.coe_sub] using he2, by simpa [w] using he1⟩ - private theorem secondBackward : (by classical @@ -2034,22 +1791,9 @@ private theorem secondBackward : let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 ∀ (y : ↥L), - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath (∀ (w : L), P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) (TileTranslation T ((w - b : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho (D.faces (.inr (w - b)))) (p1.map (fun z => z + (w : GaussianInt)))) → ((∀ (x : L), ∀ (y : L), D.faces @@ -2112,7 +1856,6 @@ private theorem secondBackward : rcases he x' y' l₁ l₂ hp with ⟨he1, he2⟩ exact ⟨by simpa [w] using he1, by simpa [hwy, AddSubgroup.coe_sub] using he2⟩ - private theorem thirdForward : (by classical @@ -2137,22 +1880,9 @@ private theorem thirdForward : let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 ∀ (y : ↥L), - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath (∀ (w : L), P4733T1ContainedWalk (TileTranslation T ((w + a : L) : GaussianInt)) (TileTranslation T ((w - b : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho (D.faces (.inr (w + a - b)))) (p2.map (fun z => z + (w : GaussianInt)))) → ((∀ (x : @@ -2223,7 +1953,6 @@ private theorem thirdForward : rw [hwxG] at he2' rw [hwyG] at he1' exact ⟨he2', he1'⟩ - private theorem thirdBackward : (by classical @@ -2248,22 +1977,9 @@ private theorem thirdBackward : let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 ∀ (y : ↥L), - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath (∀ (w : L), P4733T1ContainedWalk (TileTranslation T ((w + a : L) : GaussianInt)) (TileTranslation T ((w - b : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho (D.faces (.inr (w + a - b)))) (p2.map (fun z => z + (w : GaussianInt)))) → ((∀ (x : @@ -2322,7 +2038,6 @@ private theorem thirdBackward : (congrArg (TileTranslation T) hwxG) (congrArg (TileTranslation T) hwyG) hw exact walkClaims _ _ fc gc _ hw' hforward hbackward f g hpair - private theorem pathDiagonal : (by classical @@ -2334,37 +2049,21 @@ private theorem pathDiagonal : ∀ (p0 : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath ∀ f, path f f = [] ) := by classical intro L k D a b p0 p1 p2 rowPath path f cases hf : D.faces.symm f with | inl x => rw [← D.faces.apply_symm_apply f, hf] - simp only [path, D.faces.symm_apply_apply] + simp only [path, RegularFaceWalkProof.regularFacePath, D.faces.symm_apply_apply] | inr x => rw [← D.faces.apply_symm_apply f, hf] - simp only [path, D.faces.symm_apply_apply] - + simp only [path, RegularFaceWalkProof.regularFacePath, D.faces.symm_apply_apply] end RegularFaceProperties - namespace RegularIncidentWalks - private theorem incidentWalks : (by classical @@ -2389,22 +2088,9 @@ private theorem incidentWalks : List GaussianInt), ∀ (p1 : List GaussianInt), ∀ (p2 : List GaussianInt), let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath (∀ (w : L), P4733T1ContainedWalk (TileTranslation T (w : GaussianInt)) (TileTranslation T ((w + a : L) : GaussianInt)) (rho (D.faces (.inl w))) (rho (D.faces (.inr (w + a)))) (p0.map (fun z => z + (w : GaussianInt)))) → ((∀ (w : L), @@ -2494,9 +2180,7 @@ private theorem incidentWalks : · exact secondBackward h · exact thirdForward h · exact thirdBackward h - end RegularIncidentWalks - theorem P4812T1RegularFaceWalks (L : AddSubgroup GaussianInt) (k : (Int × Int) ≃+ L) (D : P4812T1AffineDrawing L k) (T : ProtoTile) @@ -2604,22 +2288,9 @@ theorem P4812T1RegularFaceWalks ⟨damB_a, (RegularFaceDetails.damB_mb L k D T ru rd rho_mem)⟩ let rowPath : Fin 3 → List GaussianInt := fun r => if r = 0 then p0 else if r = 1 then p1 else p2 - let path : D.plane.Face → D.plane.Face → List GaussianInt := fun f g => by - letI : ∀ p : Prop, Decidable p := Classical.propDecidable - exact match D.faces.symm f, D.faces.symm g with - | Sum.inl x, Sum.inr y => - if y = x + a then (rowPath 0).map (fun z => z + (x : GaussianInt)) - else if y = x - b then (rowPath 1).map (fun z => z + (x : GaussianInt)) - else if y = x + (a - b) then - (rowPath 2).map (fun z => z + (x : GaussianInt)) - else [] - | Sum.inr y, Sum.inl x => - if y = x + a then ((rowPath 0).map (fun z => z + (x : GaussianInt))).reverse - else if y = x - b then ((rowPath 1).map (fun z => z + (x : GaussianInt))).reverse - else if y = x + (a - b) then - ((rowPath 2).map (fun z => z + (x : GaussianInt))).reverse - else [] - | _, _ => [] + let path : D.plane.Face → D.plane.Face → List GaussianInt := + RegularFaceWalkProof.regularFacePath + L k D a b rowPath have mapTranslate (p : List GaussianInt) (x u : L) := RegularFaceDetails.mapTranslate L p x u have commonEdgeTouch (V W : ProtoTile) (hneV : V.cells.Nonempty) (hneW : W.cells.Nonempty) (h : TileTouching V W) := RegularFaceWalkProof.commonEdgeTouch @@ -2670,7 +2341,5 @@ theorem P4812T1RegularFaceWalks (RegularFaceWalkProof.rowEdge2 L k T translateComp e2 he2 footprintEdgeTranslate tileAdd)) x y hxy )) - end ApollonianSuperharmonic - end From 65a99d670c6650c6fe8df836b7f556b4f8a35f0a Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 13 Nov 2026 16:18:52 +0000 Subject: [PATCH 20/23] Remove dead private scaffolding and share lattice primitives --- .../AncestorOdometerRestriction.lean | 25 -- ...BandExceptionalRestorationSectorOrder.lean | 98 -------- .../BandOrderedGeneralChildInterfaces.lean | 10 - ...BandOrderedGeneralPositiveCutGeometry.lean | 50 ---- ...eneralRightInterfaceCertificateExists.lean | 11 - ...rderedGeneralRightSelectedRowGeometry.lean | 90 ------- ...eredGeneralSubtileCanonicalSeparation.lean | 13 - ...eralSubtileInterfaceCertificateExists.lean | 22 -- ...ndPackingSymmetryMarkedDataCovariance.lean | 23 -- .../BandPackingSymmetryTilingTransport.lean | 13 - .../BandPackingSymmetryVectorAction.lean | 56 +++++ .../BoundaryStringConcatenation.lean | 18 -- .../CellDisjointCommonEdgesBoundary.lean | 61 +---- ...CoveredInterfaceOppositeIncidentCells.lean | 59 +---- ...amondOpposingBoundaryStarLocalization.lean | 13 - .../FordCoordinateConfiguration.lean | 151 ++---------- .../FordTerminalWebStencilLedger.lean | 38 +-- LeanPool/ApollonianSuperharmonic/Imports.lean | 1 + .../LatticeCellEdges.lean | 82 +++++++ .../MarkedOdometerAdjacencyReduction.lean | 87 +------ .../OpposingBoundaryOdometerStrings.lean | 11 - .../OpposingStringInterfacePath.lean | 10 - .../P3092T1CenteredRectangleDisk.lean | 77 ------ .../P3102T2CommonEdgeSectorTransition.lean | 59 +---- .../P3475T1GridBoundary.lean | 31 --- .../P3497T1SingleStraightDeletion.lean | 29 --- .../P3523T1InsertionGeometry.lean | 51 ---- .../P3555T2ParabolaHullFrontier.lean | 105 -------- .../P3597T1DirectionParity.lean | 64 ----- .../P3597T1VertexSectors.lean | 26 -- .../P3650T1EmptyTriangleDiagonal.lean | 27 -- .../P3650T1ExposedCornerExists.lean | 104 -------- .../P3650T1OldArcEven.lean | 100 -------- .../P3652T1IndexedFaceLedger.lean | 48 ---- .../P3723T1AllContactDrawingExists.lean | 98 -------- .../P3776T1BoundedDisplacementSurjective.lean | 6 - .../P3776T1DualEdgesExist.lean | 7 - .../P3821T1CircleComponentBound.lean | 24 -- .../P3821T1ComponentContours.lean | 11 - .../P3821T1ControlledNeighborhood.lean | 6 - .../P3861T1FixedFacialDeletion.lean | 31 --- .../P3889T1FaceGapCoverage.lean | 62 ----- .../P3913T1RoutedFaceSubdivision.lean | 55 ----- .../P3934T1SectorContinuation.lean | 216 ---------------- .../P3963T1ExteriorMixedCycleObstruction.lean | 66 ----- .../P3963T1MixedBoundaryCycle.lean | 6 - .../P3996T1SRowAlignment.lean | 93 ------- ...4055T1OrderedGeneralOppositeEndpoints.lean | 50 ---- .../P4055T1PlacementNormalization.lean | 232 +----------------- .../P4062T1InteriorGeometry.lean | 35 --- .../P4062T1LiteralReduction.lean | 15 -- .../P4062T1OverlapDescent.lean | 13 - .../P4112T1LowerNeighbors.lean | 19 -- .../P4112T1PathGeometry.lean | 106 -------- .../P4120T1FordGeometry.lean | 203 --------------- .../P4158T1LargeFirstRestrictions.lean | 13 - .../P4158T1MatchedFordPair.lean | 98 -------- .../P4194T1DiamondBoundaryLedger.lean | 6 - .../P4250T1OrdinaryCompatibility.lean | 26 -- .../P4250T1ReflectedGluingSlope.lean | 32 --- .../P4261T1RightCoordinates.lean | 16 -- .../P4261T1SubtileCoordinates.lean | 125 ++-------- .../P4261T2AncestorSymmetry.lean | 13 - .../P4366T1PrecursorPathLoop.lean | 13 - .../P4366T1RemainderOuterAttachments.lean | 14 -- .../P4366T2LocalSectors.lean | 62 ----- .../P4366T2OuterGeometry.lean | 50 ---- .../P4456T2CrosscutIndex.lean | 78 ------ .../P4456T2PackingNoChord.lean | 8 - .../P4456T2SquareEdges.lean | 23 -- .../P4458T1SecondNewerRows.lean | 76 ------ .../P4536T1AFrameB.lean | 37 --- .../P4536T1AFrameD.lean | 7 - .../P4590T1RestoredBoundaryGeometry.lean | 50 ---- .../P4590T1RightInteriorGeometry.lean | 51 ---- .../P4638T1ContactStarCoverage.lean | 29 --- .../P4638T1EmptyFordLocalization.lean | 41 ---- .../P4677T2PrecursorWalk.lean | 46 ---- .../P4677T2ThreeConnected.lean | 85 ------- .../P4828T1CircularPlacement.lean | 4 - .../P4849T1LargePositiveComponents.lean | 20 -- .../P5023T1CircularSide.lean | 14 -- .../P5130T5SameParentOverlaps.lean | 14 -- .../P5188T1E2Boundary.lean | 29 --- .../P5203T1CapInterface.lean | 12 +- .../P5203T1DecreasingInterface.lean | 12 +- .../P5203T1IncreasingInterface.lean | 31 +-- .../P5253T1BottomSquareContact.lean | 14 +- .../P5253T1LeftSquareContacts.lean | 14 +- .../P5253T1TopSquareContacts.lean | 14 +- .../P5260T1PredecessorInterfaces.lean | 112 --------- .../P5290T1EqualDiamondPaths.lean | 159 ------------ .../P5290T1UnitContactPaths.lean | 12 +- .../P5352T2Predecessor0.lean | 10 - .../P5352T2Predecessor3.lean | 13 - .../P5620T1BoundaryComponentCycle.lean | 3 - ...MarkedRightOdometerAdjacencyReduction.lean | 46 +--- .../PeriodicBoundaryWebConnected.lean | 17 -- .../PeriodicBoundaryWebLaplacian.lean | 200 --------------- .../PeriodicOdometerIndicatorRigidity.lean | 18 -- .../PeriodicTileTotalIndegree.lean | 17 -- .../PositiveCurvatureGeneratorCocycles.lean | 39 --- ...QuarterTurnSymmetricCenteredTransport.lean | 42 ---- ...tticeAdjacentPackingSymmetryTransport.lean | 10 - .../TileQuarterTurnFormulas.lean | 37 --- .../TileReflectionFormulas.lean | 29 --- ...eStringRegularFamilyCentralCovariance.lean | 28 --- .../TileT2QuarterTurn.lean | 46 ---- .../TileTranslationProperties.lean | 12 + 109 files changed, 252 insertions(+), 4792 deletions(-) create mode 100644 LeanPool/ApollonianSuperharmonic/LatticeCellEdges.lean diff --git a/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean b/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean index c2e11133ce..7dede490fd 100644 --- a/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean +++ b/LeanPool/ApollonianSuperharmonic/AncestorOdometerRestriction.lean @@ -52,31 +52,6 @@ private theorem odo_eq : subst bv rfl -private theorem band_one : - (by - classical - exact - ∀ c : CircleCoordinates, ∀ U : ProtoTile, BandPrototile c U → c.1 = 1 → ∃ x : GaussianInt, - U.cells = {x} ) := by - classical - intro c U hu - induction hu with - | line w x hw => - intro hc - norm_num at hc - | unit z x anchor => - intro hc - exact ⟨x, rfl⟩ - | @decompose q hq S U hS hcells hfoot hcent ih => - intro hc - have facts := ProperBandCurvatureStructure q hq - have hz : ∀ j : Fin 3, (q j.succ).1 = 0 := by - intro j - have hlt := hq.2 j - have hn := facts.2.1 j - omega - exact ((by decide : (0 : Fin 3) ≠ 1) (facts.2.2 0 1 (hz 0) (hz 1))).elim - private theorem parent_gt_one : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean b/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean index 18b9829acc..ddff3d1732 100644 --- a/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean +++ b/LeanPool/ApollonianSuperharmonic/BandExceptionalRestorationSectorOrder.lean @@ -270,72 +270,6 @@ private theorem hAD : have h := indexed_disjoint iA iD (by decide) (by simp [iA, iD]) simpa [iA, iD, SubtileOccurrenceInterpretation, trzero] using h -private theorem hBC : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let B := cert.P 0 false - let C := cert.P 1 true - (∀ (Y : ProtoTile), TileTranslation Y 0 = Y) → ( - (∀ (i : PeriodicSubtileIndex), ∀ (j : PeriodicSubtileIndex), (i ≠ j) → ((¬ ((i.label = .A - ∧ j.label = .B ∨ i.label = .B ∧ j.label = .A) ∧ i.first = j.first ∧ i.second = - j.second)) → (Disjoint (SubtileOccurrenceInterpretation cert.P cert.u cert.v i).cells - (SubtileOccurrenceInterpretation cert.P cert.u cert.v j).cells))) → (Disjoint B.cells - C.cells)) ) := by - classical - intro q cfg C₀ T cert B C trzero indexed_disjoint - let iB : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ - let iC : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - have h := indexed_disjoint iB iC (by decide) (by simp [iB, iC]) - simpa [iB, iC, SubtileOccurrenceInterpretation, trzero] using h - -private theorem hBD : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let B := cert.P 0 false - let D := cert.P 1 false - (∀ (Y : ProtoTile), TileTranslation Y 0 = Y) → ( - (∀ (i : PeriodicSubtileIndex), ∀ (j : PeriodicSubtileIndex), (i ≠ j) → ((¬ ((i.label = .A - ∧ j.label = .B ∨ i.label = .B ∧ j.label = .A) ∧ i.first = j.first ∧ i.second = - j.second)) → (Disjoint (SubtileOccurrenceInterpretation cert.P cert.u cert.v i).cells - (SubtileOccurrenceInterpretation cert.P cert.u cert.v j).cells))) → (Disjoint B.cells - D.cells)) ) := by - classical - intro q cfg C₀ T cert B D trzero indexed_disjoint - let iB : PeriodicSubtileIndex := ⟨.B, 0, 0⟩ - let iD : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ - have h := indexed_disjoint iB iD (by decide) (by simp [iB, iD]) - simpa [iB, iD, SubtileOccurrenceInterpretation, trzero] using h - -private theorem hCD : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let C := cert.P 1 true - let D := cert.P 1 false - (∀ (Y : ProtoTile), TileTranslation Y 0 = Y) → ( - (∀ (i : PeriodicSubtileIndex), ∀ (j : PeriodicSubtileIndex), (i ≠ j) → ((¬ ((i.label = .A - ∧ j.label = .B ∨ i.label = .B ∧ j.label = .A) ∧ i.first = j.first ∧ i.second = - j.second)) → (Disjoint (SubtileOccurrenceInterpretation cert.P cert.u cert.v i).cells - (SubtileOccurrenceInterpretation cert.P cert.u cert.v j).cells))) → (Disjoint C.cells - D.cells)) ) := by - classical - intro q cfg C₀ T cert C D trzero indexed_disjoint - let iC : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - let iD : PeriodicSubtileIndex := ⟨.D, 0, 0⟩ - have h := indexed_disjoint iC iD (by decide) (by simp [iC, iD]) - simpa [iC, iD, SubtileOccurrenceInterpretation, trzero] using h - private theorem hOC : (by classical @@ -471,22 +405,6 @@ private theorem hQO : intro q cfg C₀ T cert O Q touching_disjoint hQne hOne exact (touching_disjoint O Q hOne hQne cert.precursor_first.2.2.1).symm -private theorem hSO : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let O := cert.O - let S := cert.S 2 false - (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → ((Y.cells.Nonempty) → - ((TileTouching X Y) → (Disjoint X.cells Y.cells)))) → ((Finset.Nonempty S.cells) → - (O.cells.Nonempty → Disjoint S.cells O.cells)) ) := by - classical - intro q cfg C₀ T cert O S touching_disjoint hSne hOne - exact touching_disjoint S O hSne hOne cert.precursor_first.2.1 - private theorem hRO : (by classical @@ -503,22 +421,6 @@ private theorem hRO : intro q cfg C₀ T cert O R touching_disjoint hRne hOne exact (touching_disjoint O R hOne hRne cert.precursor_second.2.2.1).symm -private theorem hVO : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), - let O := cert.O - let V := cert.S 1 false - (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → ((Y.cells.Nonempty) → - ((TileTouching X Y) → (Disjoint X.cells Y.cells)))) → ((Finset.Nonempty V.cells) → - (O.cells.Nonempty → Disjoint V.cells O.cells)) ) := by - classical - intro q cfg C₀ T cert O V touching_disjoint hVne hOne - exact touching_disjoint V O hVne hOne cert.precursor_second.2.1 - private theorem rho_mem : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean index 3cf303c408..799e27ccc1 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralChildInterfaces.lean @@ -653,16 +653,6 @@ private theorem blockJunction : hLA' hLB' hLC' hLAB hLBC hLCA hLABC hdisjAB hdisjBC hdisjCA hUAB hUBC hUCA hUABC hcommonAB hcommonBC hcommonCA -private theorem ha : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (A' : ProtoTile), (Finset.Nonempty A.cells) → (A.cells = ∅ → - A.anchor = A'.anchor) ) := by - classical - intro A A' hAn he - exact False.elim ((Finset.not_nonempty_iff_eq_empty.mpr he) hAn) - private theorem hzero : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean index c8eb727a8e..5c9e008e98 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean @@ -333,46 +333,6 @@ private theorem selectA_Q : cert.exceptionalSegments.a hQ2lat hS3lat hOlat hQS hSO hOQ hQ2check hS3check hOcheck hAowners hQ2occ hS3occ hOoccA D hD -private theorem selectB_Q : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), (LatticeTile (cert.Q 2 true)) → ((LatticeTile (cert.S 1 false)) → - ((LatticeTile cert.O) → ((NoCheckerboardCellVertex (↑(cert.Q (2 : Fin (3 : ℕ)) - true).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑(cert.S (1 : Fin (3 : - ℕ)) false).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑cert.O.cells : - Set LatticeCell)) → ((∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptionalSegments.b j ∈ (cert.Q 2 true).cells) → ((∃ j : Fin 4, - LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 false).cells) → - ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q 2 - true).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 - false).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ - cert.O.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptionalSegments.b j ∈ cert.O.cells) → ((Disjoint (cert.Q (2 : Fin (3 : ℕ)) - true).cells (cert.S (1 : Fin (3 : ℕ)) false).cells) → ((Disjoint (cert.S (1 : Fin (3 - : ℕ)) false).cells cert.O.cells) → ((Disjoint cert.O.cells (cert.Q (2 : Fin (3 : ℕ)) - true).cells) → (∀ D, D = cert.Q 2 true ∨ D = cert.S 1 false ∨ D = cert.O → ∃ U V R : - ProtoTile, (D = U ∨ D = V) ∧ ((U = cert.Q 2 true ∧ V = cert.S 1 false ∧ R = cert.O) ∨ - (U = cert.S 1 false ∧ V = cert.Q 2 true ∧ R = cert.O) ∨ (U = cert.Q 2 true ∧ V = - cert.O ∧ R = cert.S 1 false) ∨ (U = cert.O ∧ V = cert.Q 2 true ∧ R = cert.S 1 false) - ∨ (U = cert.S 1 false ∧ V = cert.O ∧ R = cert.Q 2 true) ∨ (U = cert.O ∧ V = cert.S 1 - false ∧ R = cert.Q 2 true)) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptionalSegments.b j ∈ U.cells ∧ LatticeVertexIncidentCell - cert.exceptionalSegments.b (j + 2) ∈ V.cells) ∧ cert.exceptionalSegments.b ∈ - FootprintVertices U ∧ cert.exceptionalSegments.b ∈ FootprintVertices V ∧ (∀ y, y = - cert.exceptionalSegments.b ∨ y = cert.exceptionalSegments.b + 1 ∨ y = - cert.exceptionalSegments.b - 1 ∨ y = cert.exceptionalSegments.b + ⟨0, 1⟩ ∨ y = - cert.exceptionalSegments.b - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ - FootprintVertices V)))))))))))))) ) := by - classical - intro q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck hQ3occ hS2occ hBowners - hOoccB hQ3S2 hS2O hOQ3 D hD - exact ThreeOwnerDesignatedOppositePair (cert.Q 2 true) (cert.S 1 false) cert.O - cert.exceptionalSegments.b hQ3lat hS2lat hOlat hQ3S2 hS2O hOQ3 - hQ3check hS2check hOcheck hBowners hQ3occ hS2occ hOoccB D hD - private theorem normalize_selected : (by classical @@ -644,16 +604,6 @@ private theorem hI2mul : I * I = I ^ 2 := by ring _ = -1 := hI2 -private theorem hnotEven3 : - (by - classical - exact - ¬Even 3 - ) := by - classical - rintro ⟨n, hn⟩ - omega - private theorem occurrence_centroid : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean index 40a3257cae..982b64ad06 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightInterfaceCertificateExists.lean @@ -34,17 +34,6 @@ namespace ApollonianSuperharmonic namespace RightInterfaceCertificateGeometry -private theorem hAeAt211 : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (A' : ProtoTile), (A.cells = A'.cells) → (FootprintEdges A = - FootprintEdges A') ) := by - classical - intro A A' hAc - simp only [FootprintEdges] - rw [hAc] - private theorem translateObs : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean index 0f6d58e1e6..68398ec7c0 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean @@ -108,26 +108,6 @@ private theorem centeredExactTurn : (TileT2QuarterTurn q cfg bundle.normalizedCircle F placement.layout) exact ⟨E'⟩ -private theorem twiceExactTurn : - (by - classical - exact - ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : - PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), - let F := bundle.normalizedFixed - (∀ (a : GaussianInt), ∀ (b : GaussianInt), (ExactTileInterfaceTriple F (TileTranslation F - a) (TileTranslation F b)) → (Nonempty (ExactTileInterfaceTriple F (TileTranslation F - (GaussianQuarterTurn a)) (TileTranslation F (GaussianQuarterTurn b))))) → (∀ (a : - GaussianInt), ∀ (b : GaussianInt), (ExactTileInterfaceTriple F (TileTranslation F a) - (TileTranslation F b)) → (Nonempty (ExactTileInterfaceTriple F (TileTranslation F - (GaussianQuarterTurn (GaussianQuarterTurn a))) (TileTranslation F - (GaussianQuarterTurn (GaussianQuarterTurn b)))))) ) := by - classical - intro C D T N h k x bundle F centeredExactTurn a b E - obtain ⟨E1⟩ := centeredExactTurn a b E - exact centeredExactTurn (GaussianQuarterTurn a) (GaussianQuarterTurn b) E1 - private theorem thriceExactTurn : (by classical @@ -196,17 +176,6 @@ private theorem tripleTurnNegativeNext : simp _ = _ := by rw [turnOutgoing] -private theorem hedge : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (A' : ProtoTile), (A.cells = A'.cells) → (FootprintEdges A = - FootprintEdges A') ) := by - classical - intro A A' hcell - simp only [FootprintEdges] - rw [hcell] - private theorem translateObs : (by classical @@ -1276,18 +1245,6 @@ private theorem castTriplePointThird : cases h rfl -private theorem castTripleOtherABSecond : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (B' : ProtoTile), ∀ (C : ProtoTile), ∀ (h : B = - B'), ∀ (d : ExactTileInterfaceTriple A B C), (Eq.mp (congrArg (fun Y => - ExactTileInterfaceTriple A Y C) h) d).otherAB = d.otherAB ) := by - classical - intro A B B' C h d - cases h - rfl - private theorem castTripleOtherABThird : (by classical @@ -4007,53 +3964,6 @@ private theorem thirdCyclicCase : end SelectedRowConclusions -namespace SelectedRowExactInterfaces - -private noncomputable def swapExact (A B D : ProtoTile) (E : ExactTileInterfaceTriple A B D) : - ExactTileInterfaceTriple B A D := - { point := E.point - otherAB := E.otherAB - otherBC := E.otherCA - otherCA := E.otherBC - pathAB := by simpa [Set.inter_comm] using E.pathAB - pathBC := by simpa [Set.inter_comm] using E.pathCA - pathCA := by simpa [Set.inter_comm] using E.pathBC - unique_common := by - intro y - simpa [Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using - E.unique_common y } - -private noncomputable def cycleExact (A B D : ProtoTile) (E : ExactTileInterfaceTriple A B D) : - ExactTileInterfaceTriple D A B := - { point := E.point - otherAB := E.otherCA - otherBC := E.otherAB - otherCA := E.otherBC - pathAB := E.pathCA - pathBC := E.pathAB - pathCA := E.pathBC - unique_common := by - intro y - simpa [Set.inter_comm, Set.inter_left_comm, Set.inter_assoc] using - E.unique_common y } - -private noncomputable def retargetExactFirst (A A' B D : ProtoTile) - (hcell : A.cells = A'.cells) - (hanchor : A.cells = ∅ → A.anchor = A'.anchor) - (E : ExactTileInterfaceTriple A B D) : ExactTileInterfaceTriple A' B D := by - have hobs := ProtoTileObservableExtensionality A A' hcell hanchor - have hedge : FootprintEdges A = FootprintEdges A' := SelectedRowGeometry.hedge A A' hcell - exact - { point := E.point - otherAB := E.otherAB - otherBC := E.otherBC - otherCA := E.otherCA - pathAB := by simpa [hobs.1, hedge] using E.pathAB - pathBC := E.pathBC - pathCA := by simpa [hobs.1, hedge] using E.pathCA - unique_common := by intro y; simpa [hobs.1] using E.unique_common y } - -end SelectedRowExactInterfaces theorem BandOrderedGeneralRightSelectedRowGeometry (C D : BandCircle) (T N : ProtoTile) (h k : PartialOdometer) diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean index 2a7bc8922f..a18c45908f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileCanonicalSeparation.lean @@ -172,19 +172,6 @@ private theorem root_occurrence_disjoint : rw [← hzero] simpa using h.mono_right (occurrence_subset_block o) -private theorem turn_map_injective : - ∀ (g : GaussianInt), Function.Injective (fun z : LatticeCell => GaussianTranslation g - (GaussianQuarterTurn z - 1)) := by - classical - intro g a b hab - apply Zsqrtd.ext - · have him := congrArg (fun z : GaussianInt => z.im) hab - simp [GaussianTranslation, GaussianQuarterTurn] at him - omega - · have hre := congrArg (fun z : GaussianInt => z.re) hab - simp [GaussianTranslation, GaussianQuarterTurn] at hre - omega - end GeneralSeparationProof theorem BandOrderedGeneralSubtileCanonicalSeparation diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean index 6cff9ddb54..43fef7a111 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralSubtileInterfaceCertificateExists.lean @@ -233,28 +233,6 @@ private theorem occurrenceBand : | exact BandPrototileTranslation _ _ _ (normalization.layout.outer_occurrence 2 true).1 -private theorem occurrenceSymmetric : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (i : Fin - 3), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : PartialOdometer), ∀ (hᵢ : - PartialOdometer), ∀ (x : GaussianInt), ∀ (normalization : - BandOrderedGeneralSubtileNormalizationCertificate C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x), (∀ (A : - ProtoTile), ∀ (d : GaussianInt), (QuarterTurnSymmetric A) → (QuarterTurnSymmetric - (TileTranslation A d))) → (∀ (j : Fin 3), ∀ (e : Bool), ∀ (m : Int), ∀ (n : Int), - QuarterTurnSymmetric (SubtileOccurrenceInterpretation normalization.layout.P - normalization.layout.u normalization.layout.v ⟨subtileOccurrenceLabel j e, m, n⟩)) ) - := by - classical - intro C₀ Cᵢ q i T₀ Tᵢ h₀ hᵢ x normalization quarterSymmetricTranslation j e m n - fin_cases j <;> fin_cases e <;> - simpa [subtileOccurrenceLabel, SubtileOccurrenceInterpretation] using - quarterSymmetricTranslation _ - ((m : GaussianInt) * normalization.layout.u + - (n : GaussianInt) * normalization.layout.v) - (normalization.layout.parent_quarter_turn _ _) - private theorem rotatedCentroid : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean index 3a10b27eaa..39238d89fc 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryMarkedDataCovariance.lean @@ -292,18 +292,6 @@ private theorem partialValueCov : (BandPackingSymmetryVectorAction a (BandPackingSymmetryVectorAction b x)) exact iha _ _ _ hxb hkb hb -private theorem affineQuarterNeg : - (by - classical - exact - let affineQuarter : GaussianInt × GaussianInt → GaussianInt × GaussianInt := - fun z => (GaussianQuarterTurn z.1, -GaussianQuarterTurn z.2) - ∀ (z : GaussianInt × GaussianInt), affineQuarter (-z) = -affineQuarter z ) := by - classical - intro affineQuarter z - rcases z with ⟨v, a⟩ - ext <;> simp [affineQuarter, GaussianQuarterTurn] - private theorem affineFacts : (by classical @@ -832,17 +820,6 @@ private theorem hcentGoal : trivial _ = _ := by rfl -private theorem hposC : - (by - classical - exact - ∀ (C : CircleCoordinates), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), (ProperBandQuadruple - q) → ((q (0 : Fin (4 : ℕ)) = C) → (0 < C.1)) ) := by - classical - intro C q hq hqC - rw [← hqC] - exact (ProperBandCurvatureStructure q hq).1 - private theorem hsr : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean index 3697cbe1e9..aaafb4dc1c 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTilingTransport.lean @@ -212,19 +212,6 @@ private theorem quarter_injective : · simpa [GaussianQuarterTurn] using congrArg (fun z : GaussianInt => z.re) hab -private theorem reflection_injective : - (by - classical - exact - Function.Injective (fun z : GaussianInt => -GaussianReflection z) ) := by - classical - intro a b hab - apply Zsqrtd.ext - · simpa [GaussianReflection] using - congrArg (fun z : GaussianInt => z.re) hab - · simpa [GaussianReflection] using - congrArg (fun z : GaussianInt => z.im) hab - private theorem composite_injective : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean index d074d4bfc9..d91ec2c535 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryVectorAction.lean @@ -60,6 +60,62 @@ theorem negation (a : BandPackingSymmetry) (v : GaussianInt) : -BandPackingSymmetryVectorAction a (BandPackingSymmetryVectorAction b v) rw [ihb, iha] +/-- The vector action preserves a lattice point together with its four neighbors. -/ +theorem neighborStar : + (by + classical + exact + ∀ (g : BandPackingSymmetry), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (b = a ∨ b = a + 1 + ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → (BandPackingSymmetryVectorAction g b + = BandPackingSymmetryVectorAction g a ∨ BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a + 1 ∨ BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a - 1 ∨ BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a + ⟨0, 1⟩ ∨ BandPackingSymmetryVectorAction g b = + BandPackingSymmetryVectorAction g a - ⟨0, 1⟩) ) := by + classical + intro g + induction g with + | identity => intro a b hb; simpa [BandPackingSymmetryVectorAction] using hb + | shift w => intro a b hb; simpa [BandPackingSymmetryVectorAction] using hb + | negate => + intro a b hb + rcases hb with hb | hb | hb | hb | hb + · subst b + simp [BandPackingSymmetryVectorAction] + · subst b + right; right; right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] + · subst b + right; right; right; right + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] + · subst b + right; right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn]; try ring + · subst b + right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn]; try ring + | conjugate => + intro a b hb + rcases hb with hb | hb | hb | hb | hb + · subst b + simp [BandPackingSymmetryVectorAction] + · subst b + right; right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection]; try ring + · subst b + right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection]; try ring + · subst b + right; right; right; left + ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] + · subst b + right; right; right; right + ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] + | comp g₁ g₂ ih₁ ih₂ => + intro a b hb + exact ih₁ _ _ (ih₂ _ _ hb) + + end BandPackingSymmetryVectorAction end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean b/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean index b034eca982..d266873e05 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryStringConcatenation.lean @@ -604,24 +604,6 @@ private theorem mapSegment : · apply (List.isChain_map ρ).mpr exact hseg.2.2.2.2.imp (fun u v huv => (hadjρ u v).mpr huv) -private theorem hσrNe : - (by - classical - exact - ∀ (r : ℤ × ℤ), ∀ (m : ℤ × ℤ), ∀ (σ : ℤ × ℤ ≃+ ℤ × ℤ), ∀ (a : ℤ), ∀ (b : ℤ), ∀ (c : ℤ), ∀ - (d : ℤ), (a * d - b * c = (-1 : ℤ)) → ((σ (m - r) = (a, b)) → (σ r ≠ σ m)) ) := by - classical - intro r m σ a b c d hdetσ hσmr heq - have hzero : (a, b) = 0 := by - calc - (a, b) = σ (m - r) := hσmr.symm - _ = σ m - σ r := by rw [map_sub] - _ = 0 := by rw [heq]; simp - have ha : a = 0 := by simpa using congrArg Prod.fst hzero - have hb : b = 0 := by simpa using congrArg Prod.snd hzero - rw [ha, hb] at hdetσ - norm_num at hdetσ - private theorem hinvAdj : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/CellDisjointCommonEdgesBoundary.lean b/LeanPool/ApollonianSuperharmonic/CellDisjointCommonEdgesBoundary.lean index 8c4c680526..9a0886bfd6 100644 --- a/LeanPool/ApollonianSuperharmonic/CellDisjointCommonEdgesBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/CellDisjointCommonEdgesBoundary.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.LatticeCellEdges + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintEdges @@ -30,57 +32,6 @@ theorem CellDisjointCommonEdgesBoundary (U V : ProtoTile) -- BODY classical let I : GaussianInt := ⟨0, 1⟩ - have horiz_unique (x y : GaussianInt) - (h : ({x, x + 1} : Finset GaussianInt) = {y, y + 1}) : x = y := by - have hx : x = y ∨ x = y + 1 := by - have : x ∈ ({y, y + 1} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hy : y = x ∨ y = x + 1 := by - have : y ∈ ({x, x + 1} : Finset GaussianInt) := by rw [h]; simp - simpa using this - rcases hx with hxy | hxy - · exact hxy - rcases hy with hyx | hyx - · exact hyx.symm - · exfalso - have hre := congrArg Zsqrtd.re hxy - have hre' := congrArg Zsqrtd.re hyx - norm_num at hre hre' - omega - have vert_unique (x y : GaussianInt) - (h : ({x, x + I} : Finset GaussianInt) = {y, y + I}) : x = y := by - have hx : x = y ∨ x = y + I := by - have : x ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hy : y = x ∨ y = x + I := by - have : y ∈ ({x, x + I} : Finset GaussianInt) := by rw [h]; simp - simpa using this - rcases hx with hxy | hxy - · exact hxy - rcases hy with hyx | hyx - · exact hyx.symm - · exfalso - have him := congrArg Zsqrtd.im hxy - have him' := congrArg Zsqrtd.im hyx - simp [I] at him him' - omega - have horiz_ne_vert (x y : GaussianInt) : - ({x, x + 1} : Finset GaussianInt) ≠ {y, y + I} := by - intro h - have hx : x = y ∨ x = y + I := by - have : x ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hx1 : x + 1 = y ∨ x + 1 = y + I := by - have : x + 1 ∈ ({y, y + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - rcases hx with hx | hx <;> rcases hx1 with hx1 | hx1 - all_goals - have hre := congrArg Zsqrtd.re hx - have him := congrArg Zsqrtd.im hx - have hre1 := congrArg Zsqrtd.re hx1 - have him1 := congrArg Zsqrtd.im hx1 - simp [I] at hre him hre1 him1 - omega have footprint_normalize (T : ProtoTile) (e : Finset GaussianInt) (he : e ∈ FootprintEdges T) : (∃ z, e = {z, z + 1} ∧ (z ∈ T.cells ∨ z - I ∈ T.cells)) ∨ @@ -110,7 +61,7 @@ theorem CellDisjointCommonEdgesBoundary (U V : ProtoTile) have hd := Finset.disjoint_left.mp hdisjoint rcases footprint_normalize U e heU with ⟨z, hz, hzU⟩ | ⟨z, hz, hzU⟩ <;> rcases footprint_normalize V e heV with ⟨w, hw, hwV⟩ | ⟨w, hw, hwV⟩ - · have bzw : z = w := horiz_unique z w (hz.symm.trans hw) + · have bzw : z = w := LatticeCellEdges.horizontal_unique z w (hz.symm.trans hw) subst w constructor <;> refine ⟨z, Or.inl ⟨?_, ?_⟩⟩ · exact hz @@ -125,9 +76,9 @@ theorem CellDisjointCommonEdgesBoundary (U V : ProtoTile) · exact Or.inr ⟨fun hbad => hd hzU hbad, hzV⟩ · exact Or.inl ⟨hzV, fun hbad => hd hzU hbad⟩ · exact (hd hzU hzV).elim - · exact (horiz_ne_vert z w (hz.symm.trans hw)).elim - · exact (horiz_ne_vert w z (hw.symm.trans hz)).elim - · have bzw : z = w := vert_unique z w (hz.symm.trans hw) + · exact (LatticeCellEdges.horizontal_ne_vertical z w (hz.symm.trans hw)).elim + · exact (LatticeCellEdges.horizontal_ne_vertical w z (hw.symm.trans hz)).elim + · have bzw : z = w := LatticeCellEdges.vertical_unique z w (hz.symm.trans hw) subst w constructor <;> refine ⟨z, Or.inr ⟨?_, ?_⟩⟩ · exact hz diff --git a/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean b/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean index 34b54007dc..5f38419015 100644 --- a/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean +++ b/LeanPool/ApollonianSuperharmonic/CoveredInterfaceOppositeIncidentCells.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.LatticeCellEdges + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.P3102T2CommonEdgeSectorTransition @@ -145,55 +147,6 @@ private theorem hnoR : classical intro A B hAinduced hBinduced D c hAD hBD hc hstarc R let I : GaussianInt := ⟨0, 1⟩ - have horiz_unique (u v : GaussianInt) - (h : ({u, u + 1} : Finset GaussianInt) = {v, v + 1}) : u = v := by - have hu : u = v ∨ u = v + 1 := by - have : u ∈ ({v, v + 1} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hv : v = u ∨ v = u + 1 := by - have : v ∈ ({u, u + 1} : Finset GaussianInt) := by rw [h]; simp - simpa using this - rcases hu with huv | huv - · exact huv - rcases hv with hvu | hvu - · exact hvu.symm - · have hre := congrArg Zsqrtd.re huv - have hre' := congrArg Zsqrtd.re hvu - norm_num at hre hre' - omega - have vert_unique (u v : GaussianInt) - (h : ({u, u + I} : Finset GaussianInt) = {v, v + I}) : u = v := by - have hu : u = v ∨ u = v + I := by - have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hv : v = u ∨ v = u + I := by - have : v ∈ ({u, u + I} : Finset GaussianInt) := by rw [h]; simp - simpa using this - rcases hu with huv | huv - · exact huv - rcases hv with hvu | hvu - · exact hvu.symm - · have him := congrArg Zsqrtd.im huv - have him' := congrArg Zsqrtd.im hvu - simp [I] at him him' - omega - have horiz_ne_vert (u v : GaussianInt) : - ({u, u + 1} : Finset GaussianInt) ≠ {v, v + I} := by - intro h - have hu : u = v ∨ u = v + I := by - have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hu1 : u + 1 = v ∨ u + 1 = v + I := by - have : u + 1 ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - rcases hu with hu | hu <;> rcases hu1 with hu1 | hu1 - all_goals - have hre := congrArg Zsqrtd.re hu - have him := congrArg Zsqrtd.im hu - have hre1 := congrArg Zsqrtd.re hu1 - have him1 := congrArg Zsqrtd.im hu1 - simp [I] at hre him hre1 him1 - omega have no_horizontal (U : ProtoTile) (z : GaussianInt) (hUD : Disjoint U.cells D.cells) (hU : ({z, z + 1} : Finset GaussianInt) ∈ FootprintEdges U) @@ -204,12 +157,12 @@ private theorem hnoR : FootprintEdges U ∩ FootprintEdges D := ⟨hU, hD⟩ rw [CellDisjointCommonEdgesBoundary U D hUD] at hcommon rcases hcommon.2 with ⟨w, ⟨hew, hw⟩ | ⟨hew, hw⟩⟩ - · have hwz : w = z := horiz_unique w z hew.symm + · have hwz : w = z := LatticeCellEdges.horizontal_unique w z hew.symm subst w rcases hw with hw | hw · exact hw.2 hzI · exact hw.1 hz - · exact (horiz_ne_vert z w hew).elim + · exact (LatticeCellEdges.horizontal_ne_vertical z w hew).elim have no_vertical (U : ProtoTile) (z : GaussianInt) (hUD : Disjoint U.cells D.cells) (hU : ({z, z + I} : Finset GaussianInt) ∈ FootprintEdges U) @@ -220,8 +173,8 @@ private theorem hnoR : FootprintEdges U ∩ FootprintEdges D := ⟨hU, hD⟩ rw [CellDisjointCommonEdgesBoundary U D hUD] at hcommon rcases hcommon.2 with ⟨w, ⟨hew, hw⟩ | ⟨hew, hw⟩⟩ - · exact (horiz_ne_vert w z hew.symm).elim - · have hwz : w = z := vert_unique w z hew.symm + · exact (LatticeCellEdges.horizontal_ne_vertical w z hew.symm).elim + · have hwz : w = z := LatticeCellEdges.vertical_unique w z hew.symm subst w rcases hw with hw | hw · exact hw.2 hz1 diff --git a/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean b/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean index 459856bb41..095fe51e18 100644 --- a/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/DiamondOpposingBoundaryStarLocalization.lean @@ -1144,19 +1144,6 @@ private theorem hqprev0 : all_goals rw [hKcast] _ = Ci.1.1 := hCi -private theorem hv30'At635 : - (by - classical - exact - ∀ (K : DiamondParameter), - let q := DiamondRecursiveQuadruple K - (BandVectors.1 (DiamondRecursiveQuadruple K (3 : Fin (4 : ℕ))) (DiamondRecursiveQuadruple - K (0 : Fin (4 : ℕ))) = (⟨(0 : ℤ), -((2 : ℤ) * (↑K.1 : ℤ))⟩ : GaussianInt)) → - (BandVectors.1 (q 3) (q 0) = (⟨0, -(2 * (K.1 : Int))⟩ : GaussianInt)) ) := by - classical - intro K q hv30 - simpa [q] using hv30 - private theorem hrootcent : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean b/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean index 3932adcc13..65c28cc0db 100644 --- a/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean +++ b/LeanPool/ApollonianSuperharmonic/FordCoordinateConfiguration.lean @@ -1141,60 +1141,6 @@ private theorem v21 : rw [neg_add, neg_neg] at hh simpa [add_comm] using hh -private theorem hv20' : - ∀ (P : FordFareyParameter), (BandVectors.1 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple - P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P - (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = - BandVectors.1 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 - : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : - Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.1 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 - : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : - Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ)))) → (BandVectors.1 - ((FordRecursiveQuadruple P) 2) - ((FordRecursiveQuadruple P) 0) = - BandVectors.1 ((FordRecursiveQuadruple P) 2) - ((FordRecursiveQuadruple P) 1) - - (⟨0, 1⟩ : GaussianInt) * - BandVectors.1 ((FordRecursiveQuadruple P) 3) - ((FordRecursiveQuadruple P) 2)) := by - classical - intro P hv20 - simpa using hv20 - -private theorem hv30' : - ∀ (P : FordFareyParameter), (BandVectors.1 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple - P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P - (1 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = - BandVectors.1 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 - : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : - Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.1 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 - : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : - Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ)))) → (BandVectors.1 - ((FordRecursiveQuadruple P) 3) - ((FordRecursiveQuadruple P) 0) = - BandVectors.1 ((FordRecursiveQuadruple P) 3) - ((FordRecursiveQuadruple P) 2) - - (⟨0, 1⟩ : GaussianInt) * - BandVectors.1 ((FordRecursiveQuadruple P) 1) - ((FordRecursiveQuadruple P) 3)) := by - classical - intro P hv30 - simpa using hv30 - private theorem a21 : ∀ (P : FordFareyParameter), (SemiProperQuadruple (FordRecursiveQuadruple P) ∧ BandVectors.1 (FordRecursiveQuadruple P (3 : Fin (4 : ℕ))) (FordRecursiveQuadruple P (2 : Fin (4 : ℕ))) @@ -1237,60 +1183,6 @@ private theorem a21 : rw [hh] abel -private theorem ha20' : - ∀ (P : FordFareyParameter), (BandVectors.2 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple - P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P - (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = - BandVectors.2 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 - : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : - Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.2 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 - : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : - Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (2 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (1 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ)))) → (BandVectors.2 - ((FordRecursiveQuadruple P) 2) - ((FordRecursiveQuadruple P) 0) = - BandVectors.2 ((FordRecursiveQuadruple P) 2) - ((FordRecursiveQuadruple P) 1) + - (⟨0, 1⟩ : GaussianInt) * - BandVectors.2 ((FordRecursiveQuadruple P) 3) - ((FordRecursiveQuadruple P) 2)) := by - classical - intro P ha20 - simpa using ha20 - -private theorem ha30' : - ∀ (P : FordFareyParameter), (BandVectors.2 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple - P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P - (1 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (0 : Fin (4 : ℕ))) = - BandVectors.2 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 - : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : - Fin (4 : ℕ))] (1 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.2 (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), FordRecursiveQuadruple P (3 - : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), FordRecursiveQuadruple P (2 : - Fin (4 : ℕ))] (2 : Fin (4 : ℕ))) (![FordRecursiveQuadruple P (0 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (3 : Fin (4 : ℕ)), FordRecursiveQuadruple P (1 : Fin (4 : ℕ)), - FordRecursiveQuadruple P (2 : Fin (4 : ℕ))] (1 : Fin (4 : ℕ)))) → (BandVectors.2 - ((FordRecursiveQuadruple P) 3) - ((FordRecursiveQuadruple P) 0) = - BandVectors.2 ((FordRecursiveQuadruple P) 3) - ((FordRecursiveQuadruple P) 2) + - (⟨0, 1⟩ : GaussianInt) * - BandVectors.2 ((FordRecursiveQuadruple P) 1) - ((FordRecursiveQuadruple P) 3)) := by - classical - intro P ha30 - simpa using ha30 - end FordConfigurationDetails theorem FordCoordinateConfiguration (P : FordFareyParameter) : @@ -1467,30 +1359,29 @@ theorem FordCoordinateConfiguration (P : FordFareyParameter) : have laws := VectorRecursionLaws (FordRecursiveQuadruple P) hs.1 have v21 := FordConfigurationDetails.v21 P hs laws have hv10 := laws.2.2.1 - have hv20 := (VectorRecursionLaws - ![(FordRecursiveQuadruple P) 0, (FordRecursiveQuadruple P) 2, - (FordRecursiveQuadruple P) 3, (FordRecursiveQuadruple P) 1] (by - simpa using SemiProperQuadruple.rotate hs.1)).2.2.1 - have hv30 := (VectorRecursionLaws - ![(FordRecursiveQuadruple P) 0, (FordRecursiveQuadruple P) 3, - (FordRecursiveQuadruple P) 1, (FordRecursiveQuadruple P) 2] (by - simpa using SemiProperQuadruple.rotate - (SemiProperQuadruple.rotate hs.1))).2.2.1 - have hv20' := FordConfigurationDetails.hv20' P hv20 - have hv30' := FordConfigurationDetails.hv30' P hv30 + let q := FordRecursiveQuadruple P + have rotatedLaws := VectorRecursionLaws ![q 0, q 2, q 3, q 1] + (by simpa [q] using SemiProperQuadruple.rotate hs.1) + have twiceRotatedLaws := VectorRecursionLaws ![q 0, q 3, q 1, q 2] + (by simpa [q] using SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hs.1)) + have hv20' : BandVectors.1 (q 2) (q 0) = + BandVectors.1 (q 2) (q 1) - + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 3) (q 2) := by + simpa [q] using rotatedLaws.2.2.1 + have hv30' : BandVectors.1 (q 3) (q 0) = + BandVectors.1 (q 3) (q 2) - + (⟨0, 1⟩ : GaussianInt) * BandVectors.1 (q 1) (q 3) := by + simpa [q] using twiceRotatedLaws.2.2.1 have a21 := FordConfigurationDetails.a21 P hs laws have ha10 := laws.2.2.2.1 - have ha20 := (VectorRecursionLaws - ![(FordRecursiveQuadruple P) 0, (FordRecursiveQuadruple P) 2, - (FordRecursiveQuadruple P) 3, (FordRecursiveQuadruple P) 1] (by - simpa using SemiProperQuadruple.rotate hs.1)).2.2.2.1 - have ha30 := (VectorRecursionLaws - ![(FordRecursiveQuadruple P) 0, (FordRecursiveQuadruple P) 3, - (FordRecursiveQuadruple P) 1, (FordRecursiveQuadruple P) 2] (by - simpa using SemiProperQuadruple.rotate - (SemiProperQuadruple.rotate hs.1))).2.2.2.1 - have ha20' := FordConfigurationDetails.ha20' P ha20 - have ha30' := FordConfigurationDetails.ha30' P ha30 + have ha20' : BandVectors.2 (q 2) (q 0) = + BandVectors.2 (q 2) (q 1) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 3) (q 2) := by + simpa [q] using rotatedLaws.2.2.2.1 + have ha30' : BandVectors.2 (q 3) (q 0) = + BandVectors.2 (q 3) (q 2) + + (⟨0, 1⟩ : GaussianInt) * BandVectors.2 (q 1) (q 3) := by + simpa [q] using twiceRotatedLaws.2.2.2.1 refine ⟨hproper, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ · rw [hv10, hs.2.2.1, v21] have hi : (⟨0, 1⟩ : GaussianInt) * ⟨0, 1⟩ = -1 := by diff --git a/LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean b/LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean index 2ac3e790cb..88c2d14203 100644 --- a/LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/FordTerminalWebStencilLedger.lean @@ -509,40 +509,6 @@ private theorem hgAt426 : rw [hlap x, lapValues f (x-u) _ hv] exact P5332T1ParentRounding P hq j s t ht ht' -private theorem mark : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (T : ProtoTile), - ∀ (x : GaussianInt), ∀ (j : Fin (2 : ℕ)), ∀ (u : GaussianInt), (∀ (x : GaussianInt), - ∀ (w : GaussianInt), x ∈ FootprintVertices (TileTranslation T w) ↔ x - u - w ∈ - FordVertexDomain P.q) → (((1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ^ (↑s : ℕ) * (BandVectors.1 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.1 (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) = (((↑(![P.q₁, P.q₂] j) : ℝ) - - (↑P.q : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : ℤ)).displacement.re : ℝ), - ((↑(![P.q₁, P.q₂] j) : ℝ) - (↑P.q : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : - ℤ)).displacement.im : ℝ)) ∧ (1 / 2 : ℝ) • GaussianRealPoint ((-(⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt)) ^ (↑s : ℕ) * (BandVectors.2 (FordRecursiveQuadruple P i.succ) - (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) + BandVectors.2 (FordRecursiveQuadruple - P (0 : Fin (4 : ℕ))) (FordRecursiveQuadruple P i.succ))) = (((↑(![P.p₁, P.p₂] j) : ℝ) - - (↑P.p : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : ℤ)).linear.re : ℝ), - ((↑(![P.p₁, P.p₂] j) : ℝ) - (↑P.p : ℝ)) / (2 : ℝ) + (↑(P5332T1ParentRows P j s (0 : - ℤ)).linear.im : ℝ)) ∧ ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : - ℕ) then BandVectors.1 (FordRecursiveQuadruple P (0 : Fin (4 : ℕ))) - (FordRecursiveQuadruple P i.succ) else BandVectors.1 (FordRecursiveQuadruple P - i.succ) (FordRecursiveQuadruple P (0 : Fin (4 : ℕ)))) = (P5332T1ParentRows P j s (0 - : ℤ)).companion) → (∀ (t : ℤ), (x - u - (P5332T1ParentRows P j s (0 : ℤ)).companion - ∈ FordVertexDomain P.q ↔ t = (0 : ℤ) ∧ Even ((↑s : ℕ) + (↑j : ℕ))) → (x ∈ - FootprintVertices (TileTranslation T ((⟨0,1⟩ : GaussianInt)^s.val * (if Even s.val - then BandVectors.1 (FordRecursiveQuadruple P 0) (FordRecursiveQuadruple P i.succ) - else BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P 0)))) - ↔ t = 0 ∧ Even (s.val+j.val)))) ) := by - classical - intro P i s T x j u hfoot vv t hh - rw [hfoot, vv.2.2] - exact hh - end FordTerminalStencilGeometry theorem FordTerminalWebStencilLedger (P : FordFareyParameter) (hq : 1 < P.q) : @@ -726,7 +692,9 @@ theorem FordTerminalWebStencilLedger (P : FordFareyParameter) (hq : 1 < P.q) : (FordRecursiveQuadruple P i.succ) else BandVectors.1 (FordRecursiveQuadruple P i.succ) (FordRecursiveQuadruple P 0)))) ↔ t = 0 ∧ Even (s.val+j.val) := - FordTerminalStencilGeometry.mark P i s T x j u hfoot vv t hh +by + rw [hfoot, vv.2.2] + exact hh constructor · intro hm rw [hg, ite_eq_left (mark.mp hm)] diff --git a/LeanPool/ApollonianSuperharmonic/Imports.lean b/LeanPool/ApollonianSuperharmonic/Imports.lean index 7f211e0219..46d82b6f78 100644 --- a/LeanPool/ApollonianSuperharmonic/Imports.lean +++ b/LeanPool/ApollonianSuperharmonic/Imports.lean @@ -344,6 +344,7 @@ public import LeanPool.ApollonianSuperharmonic.LambdaTiling public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentInterfacePath public import LeanPool.ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts public import LeanPool.ApollonianSuperharmonic.LatticeCell +public import LeanPool.ApollonianSuperharmonic.LatticeCellEdges public import LeanPool.ApollonianSuperharmonic.LatticeDiskUnionIntersectionConnected public import LeanPool.ApollonianSuperharmonic.LatticeEdgeRegularity public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence diff --git a/LeanPool/ApollonianSuperharmonic/LatticeCellEdges.lean b/LeanPool/ApollonianSuperharmonic/LatticeCellEdges.lean new file mode 100644 index 0000000000..c9234c2ab8 --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/LatticeCellEdges.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.LatticeCell +public import Mathlib.Data.Finset.Insert + +/-! +# Lattice cell edges + +Shared elementary edge identities adapted from Wesley Pegden's Apache-2.0 +Trellis formalization of Levine–Pegden–Smart. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic.LatticeCellEdges + +/-- A horizontal edge determines its lower-real-coordinate endpoint. -/ +theorem horizontal_unique (x y : GaussianInt) + (h : ({x, x + 1} : Finset GaussianInt) = {y, y + 1}) : x = y := by + have hx : x = y ∨ x = y + 1 := by + have : x ∈ ({y, y + 1} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hy : y = x ∨ y = x + 1 := by + have : y ∈ ({x, x + 1} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hx with hxy | hxy + · exact hxy + rcases hy with hyx | hyx + · exact hyx.symm + · exfalso + have hre := congrArg Zsqrtd.re hxy + have hre' := congrArg Zsqrtd.re hyx + norm_num at hre hre' + omega + +/-- A vertical edge determines its lower-imaginary-coordinate endpoint. -/ +theorem vertical_unique (x y : GaussianInt) + (h : ({x, x + (⟨0, 1⟩ : GaussianInt)} : Finset GaussianInt) = + {y, y + (⟨0, 1⟩ : GaussianInt)}) : x = y := by + have hx : x = y ∨ x = y + (⟨0, 1⟩ : GaussianInt) := by + have : x ∈ ({y, y + (⟨0, 1⟩ : GaussianInt)} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hy : y = x ∨ y = x + (⟨0, 1⟩ : GaussianInt) := by + have : y ∈ ({x, x + (⟨0, 1⟩ : GaussianInt)} : Finset GaussianInt) := by rw [h]; simp + simpa using this + rcases hx with hxy | hxy + · exact hxy + rcases hy with hyx | hyx + · exact hyx.symm + · exfalso + have him := congrArg Zsqrtd.im hxy + have him' := congrArg Zsqrtd.im hyx + simp at him him' + omega + +/-- A horizontal edge cannot equal a vertical edge. -/ +theorem horizontal_ne_vertical (x y : GaussianInt) : + ({x, x + 1} : Finset GaussianInt) ≠ {y, y + (⟨0, 1⟩ : GaussianInt)} := by + intro h + have hx : x = y ∨ x = y + (⟨0, 1⟩ : GaussianInt) := by + have : x ∈ ({y, y + (⟨0, 1⟩ : GaussianInt)} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + have hx1 : x + 1 = y ∨ x + 1 = y + (⟨0, 1⟩ : GaussianInt) := by + have : x + 1 ∈ ({y, y + (⟨0, 1⟩ : GaussianInt)} : Finset GaussianInt) := by rw [← h]; simp + simpa using this + rcases hx with hx | hx <;> rcases hx1 with hx1 | hx1 + all_goals + have hre := congrArg Zsqrtd.re hx + have him := congrArg Zsqrtd.im hx + have hre1 := congrArg Zsqrtd.re hx1 + have him1 := congrArg Zsqrtd.im hx1 + simp at hre him hre1 him1 + omega + +end ApollonianSuperharmonic.LatticeCellEdges + +end diff --git a/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean index 897269ce91..519383004f 100644 --- a/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/MarkedOdometerAdjacencyReduction.lean @@ -558,60 +558,6 @@ private theorem hxSelectedOriginal : have hback := inverseDomain selectedFunction x (by simpa [hpoint] using hmem) simpa [h'] using hback -private theorem mapStar : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (b = a ∨ b = a + 1 - ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → (BandPackingSymmetryVectorAction g b - = BandPackingSymmetryVectorAction g a ∨ BandPackingSymmetryVectorAction g b = - BandPackingSymmetryVectorAction g a + 1 ∨ BandPackingSymmetryVectorAction g b = - BandPackingSymmetryVectorAction g a - 1 ∨ BandPackingSymmetryVectorAction g b = - BandPackingSymmetryVectorAction g a + ⟨0, 1⟩ ∨ BandPackingSymmetryVectorAction g b = - BandPackingSymmetryVectorAction g a - ⟨0, 1⟩) ) := by - classical - intro g - induction g with - | identity => intro a b hb; simpa [BandPackingSymmetryVectorAction] using hb - | shift w => intro a b hb; simpa [BandPackingSymmetryVectorAction] using hb - | negate => - intro a b hb - rcases hb with hb | hb | hb | hb | hb - · subst b - simp [BandPackingSymmetryVectorAction] - · subst b - right; right; right; left - ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] - · subst b - right; right; right; right - ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] - · subst b - right; right; left - ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn]; try ring - · subst b - right; left - ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn]; try ring - | conjugate => - intro a b hb - rcases hb with hb | hb | hb | hb | hb - · subst b - simp [BandPackingSymmetryVectorAction] - · subst b - right; right; left - ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection]; try ring - · subst b - right; left - ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection]; try ring - · subst b - right; right; right; left - ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] - · subst b - right; right; right; right - ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] - | comp g₁ g₂ ih₁ ih₂ => - intro a b hb - exact ih₁ _ _ (ih₂ _ _ hb) - private theorem hstarOriginal : (by classical @@ -737,36 +683,6 @@ private theorem hinverseCircleFixed : rw [bundle.normalized_fixed_circle_eq] _ = Cᵢ.1.1 := hcircleL Cᵢ.1.1 -private theorem hpFixedEq : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : - PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (pFixed : ℝ × - ℝ), (PartialOdometerSlope bundle.normalizedFixedFunction = some pFixed) → (pFixed = - bundle.normalizedFixedSlope) ) := by - classical - intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle pFixed hslopeFixed - apply Option.some.inj - rw [← hslopeFixed, ← bundle.normalized_fixed_slope] - -private theorem hpSelectedEq : - (by - classical - exact - ∀ (C₀ : BandCircle), ∀ (Cᵢ : BandCircle), ∀ (T₀ : ProtoTile), ∀ (Tᵢ : ProtoTile), ∀ (h₀ : - PartialOdometer), ∀ (hᵢ : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x), ∀ (selectedSlope : - ℝ × ℝ), (PartialOdometerSlope (bundle.functions bundle.selectedSlot - bundle.selectedSign) = some selectedSlope) → (∀ (pSelected : ℝ × ℝ), - (PartialOdometerSlope (bundle.functions bundle.selectedSlot bundle.selectedSign) = - some pSelected) → (pSelected = selectedSlope)) ) := by - classical - intro C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle selectedSlope hslope' pSelected hslopeSelected - apply Option.some.inj - rw [← hslopeSelected, ← hslope'] - private abbrev centroidCov := ApollonianSuperharmonic.LatticeAdjacentPackingSymmetryFacts.centroidTransport @@ -3263,7 +3179,8 @@ theorem MarkedOdometerAdjacencyReduction : ginv hfunL inverseDomain hpoint), (MarkedAdjacencyGeometry.hxSelectedOriginal C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hxSelected' ginv inverseDomain hpoint), (MarkedAdjacencyGeometry.hstarOriginal C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x - bundle hstar' ginv hfunL inverseDomain hpoint (MarkedAdjacencyGeometry.mapStar)), + bundle hstar' ginv hfunL inverseDomain hpoint + (BandPackingSymmetryVectorAction.neighborStar)), (MarkedAdjacencyGeometry.hsizeOriginal C₀ Cᵢ T₀ Tᵢ h₀ hᵢ x bundle hnorm C' hsize' ginv actionCurvature hinverseProper hinversePositive hinverseCircle), ?_⟩ rcases hrowOutput with hleft | hforward | hreverse diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean index c405455634..61020cb663 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean @@ -1529,17 +1529,6 @@ private theorem zip_pair_unique : exact False.elim ((hhead x hx) hxeq.symm) · exact ih htail hy hz -private theorem hreverseTilesNonempty : - (by - classical - exact - ∀ (Rplus : ProtoTile), ∀ (reverseTiles : List ProtoTile), (reverseTiles.head? = some - Rplus) → (reverseTiles ≠ []) ) := by - classical - intro Rplus reverseTiles hreverseHead h - rw [h] at hreverseHead - simp at hreverseHead - private theorem forall2_length : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean index 11760028fa..b29ff3de94 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingStringInterfacePath.lean @@ -142,16 +142,6 @@ private theorem forwardInterior : private abbrev reverseInterior := ApollonianSuperharmonic.OpposingInterfaceGeometry.forwardInterior -private theorem hshift : - (by - classical - exact - ∀ (z : Int × Int), (z.1 : GaussianInt) * 1 + (z.2 : GaussianInt) * ⟨0, 1⟩ = (⟨z.1, z.2⟩ : - GaussianInt) ) := by - classical - intro z - ext <;> simp - private theorem hshift' : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean b/LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean index 2c5c13f220..82eeb26242 100644 --- a/LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean +++ b/LeanPool/ApollonianSuperharmonic/P3092T1CenteredRectangleDisk.lean @@ -140,40 +140,6 @@ private theorem hR_eq (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : rw [heq] exact Finset.le_sup' (fun j => (q j x)⁻¹) hj -private theorem hR_attained (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (x : ℝ - × ℝ) : ∃ j ∈ J, (R J hJ a b) x = ((q a b) j x)⁻¹ := by - classical - let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) - let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) - change (∃ j ∈ J, R x = (q j x)⁻¹) - exact Finset.exists_mem_eq_sup' hJ _ - -private theorem hR_pos (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j ∈ - J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < (R J hJ a b) x := by - classical - let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) - let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) - let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) - have hg_pos (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < g x := hg_pos J hJ a b ha hb x hx - have hR_eq (x : ℝ × ℝ) (hx : x ≠ 0) : R x = (g x)⁻¹ := hR_eq J hJ a b ha hb x hx - change (0 < R x) - rw [hR_eq x hx] - exact inv_pos.mpr (hg_pos x hx) - -private theorem hR_cont (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j - ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) (hx : x ≠ 0) : ContinuousAt (R J hJ a b) x - := by - classical - let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) - let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) - have hq_pos (j : Nat) (hj : j ∈ J) (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < q j x := hq_pos J a b ha hb j - hj x hx - change (ContinuousAt R x) - apply ContinuousAt.finset_sup'_apply hJ - intro j hj - exact ((continuous_fst.abs.div_const _).max - (continuous_snd.abs.div_const _)).continuousAt.inv₀ (hq_pos j hj x hx).ne' - private theorem hmem (J : Finset Nat) (hJ : J.Nonempty) (c : ℝ × ℝ) (a : Nat → ℝ) (b : Nat → ℝ) (ha : ∀ j ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (x : ℝ × ℝ) : c + x ∈ (⋃ j ∈ J, Set.Icc (c.1 - a j, c.2 - b j) @@ -202,27 +168,6 @@ private theorem hmem (J : Finset Nat) (hJ : J.Nonempty) (c : ℝ × ℝ) (a : Na · rintro ⟨⟨h1, h2⟩, h3, h4⟩ exact ⟨⟨by linarith, by linarith⟩, by linarith, by linarith⟩ -private theorem hray (J : Finset Nat) (hJ : J.Nonempty) (c : ℝ × ℝ) (a : Nat → ℝ) (b : Nat → ℝ) - (ha : ∀ j ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) (u : ℝ × ℝ) (hu : ‖u‖ = 1) (t : ℝ) (ht : 0 ≤ - t) : - c + t • u ∈ (⋃ j ∈ J, Set.Icc (c.1 - a j, c.2 - b j) - (c.1 + a j, c.2 + b j)) ↔ t ≤ (R J hJ a b) u := by - classical - let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) - let g : (ℝ × ℝ) → ℝ := fun x => J.inf' hJ (fun j => q j x) - let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) - have hg_pos (x : ℝ × ℝ) (hx : x ≠ 0) : 0 < g x := hg_pos J hJ a b ha hb x hx - have hg_smul (t : ℝ) (ht : 0 ≤ t) (x : ℝ × ℝ) : g (t • x) = t * g x := hg_smul J hJ a b t ht x - have hR_eq (x : ℝ × ℝ) (hx : x ≠ 0) : R x = (g x)⁻¹ := hR_eq J hJ a b ha hb x hx - have hmem (x : ℝ × ℝ) : - c + x ∈ (⋃ j ∈ J, Set.Icc (c.1 - a j, c.2 - b j) - (c.1 + a j, c.2 + b j)) ↔ g x ≤ 1 := hmem J hJ c a b ha hb x - change (c + t • u ∈ (⋃ j ∈ J, Set.Icc (c.1 - a j, c.2 - b j) - (c.1 + a j, c.2 + b j)) ↔ t ≤ R u) - have hu0 : u ≠ 0 := by intro h; simp [h] at hu - rw [hmem, hg_smul t ht, hR_eq u hu0, ← one_div, - le_div_iff₀ (hg_pos u hu0)] - private noncomputable abbrev j₀ (J : Finset Nat) (hJ : J.Nonempty) := hJ.choose private theorem hj₀ (J : Finset Nat) (hJ : J.Nonempty) : (j₀ J hJ) ∈ J := by @@ -613,28 +558,6 @@ private theorem hG_cont (J : Finset Nat) (hJ : J.Nonempty) (a : Nat → ℝ) (b exact (hg_cont.continuousAt.div continuous_norm.continuousAt (norm_ne_zero_iff.mpr hx)).smul continuousAt_id -private noncomputable abbrev H (J : Finset Nat) (hJ : J.Nonempty) (c : ℝ × ℝ) (a : Nat → ℝ) (b : - Nat → ℝ) (ha : ∀ j ∈ J, 0 < a j) (hb : ∀ j ∈ J, 0 < b j) : (ℝ × ℝ) ≃ₜ (ℝ × ℝ) := by - classical - let q : Nat → (ℝ × ℝ) → ℝ := fun j x => max (|x.1| / a j) (|x.2| / b j) - let R : (ℝ × ℝ) → ℝ := fun x => J.sup' hJ (fun j => (q j x)⁻¹) - let F : (ℝ × ℝ) → (ℝ × ℝ) := fun x => R (‖x‖⁻¹ • x) • x - let G : (ℝ × ℝ) → (ℝ × ℝ) := fun x => (R (‖x‖⁻¹ • x))⁻¹ • x - have hGF (x : ℝ × ℝ) : G (F x) = x := hGF J hJ a b ha hb x - have hFG (x : ℝ × ℝ) : F (G x) = x := hFG J hJ a b ha hb x - have hF_cont : Continuous F := hF_cont J hJ a b ha hb - have hG_cont : Continuous G := hG_cont J hJ a b ha hb - exact { - toFun := fun x => c + F x - invFun := fun x => G (x - c) - left_inv := fun x => by simpa using hGF x - right_inv := fun x => by - change c + F (G (x - c)) = x - rw [hFG] - simp - continuous_toFun := continuous_const.add hF_cont - continuous_invFun := hG_cont.comp (continuous_id.sub continuous_const) } - end CenteredRectangleDiskConstruction theorem P3092T1CenteredRectangleDisk diff --git a/LeanPool/ApollonianSuperharmonic/P3102T2CommonEdgeSectorTransition.lean b/LeanPool/ApollonianSuperharmonic/P3102T2CommonEdgeSectorTransition.lean index 55717c260a..3053a71ab3 100644 --- a/LeanPool/ApollonianSuperharmonic/P3102T2CommonEdgeSectorTransition.lean +++ b/LeanPool/ApollonianSuperharmonic/P3102T2CommonEdgeSectorTransition.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.LatticeCellEdges + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.CellDisjointCommonEdgesBoundary @@ -39,60 +41,11 @@ theorem P3102T2CommonEdgeSectorTransition let I : GaussianInt := ⟨0, 1⟩ let edgeAt (x : GaussianInt) : Fin 4 → Finset GaussianInt := ![{x, x + I}, {x - 1, x}, {x - I, x}, {x, x + 1}] - have horiz_unique (u v : GaussianInt) - (h : ({u, u + 1} : Finset GaussianInt) = {v, v + 1}) : u = v := by - have hu : u = v ∨ u = v + 1 := by - have : u ∈ ({v, v + 1} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hv : v = u ∨ v = u + 1 := by - have : v ∈ ({u, u + 1} : Finset GaussianInt) := by rw [h]; simp - simpa using this - rcases hu with huv | huv - · exact huv - rcases hv with hvu | hvu - · exact hvu.symm - · have hre := congrArg Zsqrtd.re huv - have hre' := congrArg Zsqrtd.re hvu - norm_num at hre hre' - omega - have vert_unique (u v : GaussianInt) - (h : ({u, u + I} : Finset GaussianInt) = {v, v + I}) : u = v := by - have hu : u = v ∨ u = v + I := by - have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hv : v = u ∨ v = u + I := by - have : v ∈ ({u, u + I} : Finset GaussianInt) := by rw [h]; simp - simpa using this - rcases hu with huv | huv - · exact huv - rcases hv with hvu | hvu - · exact hvu.symm - · have him := congrArg Zsqrtd.im huv - have him' := congrArg Zsqrtd.im hvu - simp [I] at him him' - omega - have horiz_ne_vert (u v : GaussianInt) : - ({u, u + 1} : Finset GaussianInt) ≠ {v, v + I} := by - intro h - have hu : u = v ∨ u = v + I := by - have : u ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - have hu1 : u + 1 = v ∨ u + 1 = v + I := by - have : u + 1 ∈ ({v, v + I} : Finset GaussianInt) := by rw [← h]; simp - simpa using this - rcases hu with hu | hu <;> rcases hu1 with hu1 | hu1 - all_goals - have hre := congrArg Zsqrtd.re hu - have him := congrArg Zsqrtd.im hu - have hre1 := congrArg Zsqrtd.re hu1 - have him1 := congrArg Zsqrtd.im hu1 - simp [I] at hre him hre1 him1 - omega have hd := Finset.disjoint_left.mp hdisjoint rw [CellDisjointCommonEdgesBoundary U V hdisjoint] at he rcases he.1 with ⟨u, ⟨heu, hu⟩ | ⟨heu, hu⟩⟩ · rcases he.2 with ⟨v, ⟨hev, hv⟩ | ⟨hev, hv⟩⟩ - · have huv : u = v := horiz_unique u v (heu.symm.trans hev) + · have huv : u = v := LatticeCellEdges.horizontal_unique u v (heu.symm.trans hev) subst v have hxuv : x = u ∨ x = u + 1 := by rw [heu] at hxe @@ -116,10 +69,10 @@ theorem P3102T2CommonEdgeSectorTransition · simpa [LatticeVertexIncidentCell, I] using hv.1 · simpa [LatticeVertexIncidentCell, I] using hu.2 · exact (hd hu.2 hv.2).elim - · exact (horiz_ne_vert u v (heu.symm.trans hev)).elim + · exact (LatticeCellEdges.horizontal_ne_vertical u v (heu.symm.trans hev)).elim · rcases he.2 with ⟨v, ⟨hev, hv⟩ | ⟨hev, hv⟩⟩ - · exact (horiz_ne_vert v u (hev.symm.trans heu)).elim - · have huv : u = v := vert_unique u v (heu.symm.trans hev) + · exact (LatticeCellEdges.horizontal_ne_vertical v u (hev.symm.trans heu)).elim + · have huv : u = v := LatticeCellEdges.vertical_unique u v (heu.symm.trans hev) subst v have hxuv : x = u ∨ x = u + I := by rw [heu] at hxe diff --git a/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean b/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean index 90995833c6..56100ddd4f 100644 --- a/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P3475T1GridBoundary.lean @@ -763,37 +763,6 @@ private theorem v_adj (gridPath : List GaussianInt) (y : GaussianInt) (x : Gauss change (FourNeighborAdjacent (v i) (v (i + 1))) exact cyclic_edge_fourNeighbor _ _ (cyclic_index i) -private noncomputable abbrev polygon (gridPath : List GaussianInt) (y : GaussianInt) (x : - GaussianInt) (gridPath_head : gridPath.head? = some x) (gridPath_last : gridPath.getLast? = - some y) (gridPath_nodup : gridPath.Nodup) (gridPath_length_four : 4 ≤ gridPath.length) - (cyclic_edge_fourNeighbor : ∀ (a b : GaussianInt), (a, b) ∈ gridPath.zip gridPath.tail ++ - [(y, x)] → ApollonianSuperharmonic.FourNeighborAdjacent a b) : P3381T1PolygonBoundary (n - gridPath) := by - classical - let n := gridPath.length - 3 - have hn : n + 3 = gridPath.length := hn gridPath gridPath_length_four - let v : Fin (n + 3) → GaussianInt := - fun i => gridPath[i.val]'(by rw [← hn]; exact i.isLt) - have v_injective : Function.Injective v := v_injective gridPath gridPath_nodup - gridPath_length_four - have edge_distinct (i j : Fin (n + 3)) (hij : i ≠ j) : - ({v i, v (i + 1)} : Finset GaussianInt) ≠ {v j, v (j + 1)} := edge_distinct v v_injective i - j hij - have vertex_rational (i : Fin (n + 3)) : - ∃ r s : Rat, GaussianRealPoint (v i) = ((r : Real), (s : Real)) := vertex_rational gridPath - gridPath_length_four i - have point_injective : Function.Injective GaussianRealPoint := point_injective - have v_adj (i : Fin (n + 3)) : FourNeighborAdjacent (v i) (v (i + 1)) := v_adj gridPath y x - gridPath_head gridPath_last gridPath_length_four cyclic_edge_fourNeighbor i - change (P3381T1PolygonBoundary n) - exact { - vertex := GaussianRealPoint ∘ v - rational := vertex_rational - injective := point_injective.comp v_injective - edge_intersection := fun i j hij => - P3475T1UnitSegmentIntersection _ _ _ _ (v_adj i) (v_adj j) - (edge_distinct i j hij) } - end GridBoundaryConstruction theorem P3475T1GridBoundary (T : ProtoTile) diff --git a/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean b/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean index bdc105d4d5..189c03df4e 100644 --- a/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3497T1SingleStraightDeletion.lean @@ -68,14 +68,6 @@ private theorem hM2 (n : Nat) : 2 < (M n) := by change (2 < M) omega -private theorem hM3 (n : Nat) : 3 < (M n) := by - classical - let M := n + 4 - have hM : 4 ≤ M := hM n - dsimp only [StraightDeletionConstruction.M] at * - change (3 < M) - omega - private theorem hL1 (n : Nat) : 1 < (L n) := by classical let M := n + 4 @@ -369,14 +361,6 @@ private theorem hmod2M (n : Nat) : 2 % (M n) = 2 := by change (2 % M = 2) exact Nat.mod_eq_of_lt hM2 -private theorem hmod3M (n : Nat) : 3 % (M n) = 3 := by - classical - let M := n + 4 - have hM3 : 3 < M := hM3 n - dsimp only [StraightDeletionConstruction.M] at * - change (3 % M = 3) - exact Nat.mod_eq_of_lt hM3 - private theorem new01 (n : Nat) : (0 : Fin (L n)) + 1 = 1 := by classical let L := n + 3 @@ -422,19 +406,6 @@ private theorem old12 (n : Nat) : (1 : Fin (M n)) + 1 = 2 := by simp [Fin.val_add_eq_ite, hmod1M, hmod2M] omega -private theorem old23 (n : Nat) : (2 : Fin (M n)) + 1 = 3 := by - classical - let M := n + 4 - have hM : 4 ≤ M := hM n - have hmod1M : 1 % M = 1 := hmod1M n - have hmod2M : 2 % M = 2 := hmod2M n - have hmod3M : 3 % M = 3 := hmod3M n - dsimp only [StraightDeletionConstruction.M] at * - change ((2 : Fin M) + 1 = 3) - apply Fin.ext - simp [Fin.val_add_eq_ite, hmod1M, hmod2M, hmod3M] - omega - private theorem qedge0 (n : Nat) (p : P3381T1PolygonBoundary (n + 1)) (i : Fin ((n + 1) + 3)) : segment Real ((r n p i) ((sig n) 0)) ((r n p i) ((sig n) (0 + 1))) = segment Real ((r n p i) 0) ((r n p i) 2) := by diff --git a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean index 19efc22b63..1a285d6426 100644 --- a/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P3523T1InsertionGeometry.lean @@ -1720,57 +1720,6 @@ private theorem splitFacts : exact ⟨z, haz, hbz, hPeq, by rw [hPeq]; exact hfin.1, by rw [hPeq]; exact hfin.2, u, hu0, hu1, hvalue, hgeo⟩ -private theorem hda : - (by - classical - exact - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : - P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set - (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), - let c := P3523T1InsertionConstruction s t - ∀ (h : ℕ), ∀ (hh : h < c.steps.length), - let e := c.steps.get ⟨h, hh⟩ - (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.1 ∉ - (P3523T1InsertionConstruction s t).vertices h) → ((e.1 ∈ c.vertices h) → (e.2.1 ≠ - e.1)) ) := by - classical - intro r n q p s X K t c h hh e hdV haV0 heq - exact hdV (heq ▸ haV0) - -private theorem hdb : - (by - classical - exact - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : - P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set - (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), - let c := P3523T1InsertionConstruction s t - ∀ (h : ℕ), ∀ (hh : h < c.steps.length), - let e := c.steps.get ⟨h, hh⟩ - (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.1 ∉ - (P3523T1InsertionConstruction s t).vertices h) → ((e.2.2 ∈ c.vertices h) → (e.2.1 ≠ - e.2.2)) ) := by - classical - intro r n q p s X K t c h hh e hdV hbV0 heq - exact hdV (heq ▸ hbV0) - -private theorem hdz : - (by - classical - exact - ∀ (r : Nat), ∀ (n : Nat), ∀ (q : P3381T1PolygonBoundary r), ∀ (p : - P3381T1PolygonBoundary n), ∀ (s : P3475T1BoundarySubdivision q p), ∀ (X : Set - (Real × Real)), ∀ (K : Set (Real × Real)), ∀ (t : P3475T1TriangleTree q X K), - let c := P3523T1InsertionConstruction s t - ∀ (h : ℕ), ∀ (hh : h < c.steps.length), - let e := c.steps.get ⟨h, hh⟩ - (((P3523T1InsertionConstruction s t).steps.get ⟨h, hh⟩).2.1 ∉ - (P3523T1InsertionConstruction s t).vertices h) → (∀ (z : Fin (n + (3 : ℕ))), (z ∈ - c.vertices h) → (e.2.1 ≠ z)) ) := by - classical - intro r n q p s X K t c h hh e hdV z hzV0 heq - exact hdV (heq ▸ hzV0) - private theorem siblingsPair : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean index 47143f7512..56a8f0af9f 100644 --- a/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean +++ b/LeanPool/ApollonianSuperharmonic/P3555T2ParabolaHullFrontier.lean @@ -730,28 +730,6 @@ private theorem hUopen : (isOpen_lt continuous_const continuous_snd)).inter (isOpen_lt (continuous_fst.add continuous_snd) continuous_const) -private theorem hUsub : - let p : Fin 3 → Real × Real := ![(0,0),(1,0),(0,1)] - let w (z : Real × Real) : Fin 3 → Real := ![1-z.1-z.2,z.1,z.2] - (∀ (z : Real × Real), (∑ i, w z i) = 1) → (∀ (z : Real × Real), (∑ i, w z i • p i) = z) → - let U : Set (Real × Real) := {z | 0 < z.1 ∧ 0 < z.2 ∧ z.1+z.2 < 1} - U ⊆ convexHull Real (Set.range p) := by - classical - intro p w hw_sum hp_sum U z hz - apply mem_convexHull_of_exists_fintype (w z) p - · intro i - fin_cases i - · dsimp [w] - linarith [hz.2.2] - · dsimp [w] - exact hz.1.le - · dsimp [w] - exact hz.2.1.le - · exact hw_sum z - · intro i - exact Set.mem_range_self i - · exact hp_sum z - private theorem hImageSub : ∀ (n : Nat), ∀ (q : Fin (n + 3) → Real × Real), let f : Fin 3 → Fin (n+3) := fun i => ⟨i.val, by omega⟩ @@ -806,54 +784,6 @@ private theorem hOopen : ((isOpen_lt continuous_fst continuous_const).inter ((isOpen_lt continuous_snd (by fun_prop)).inter hlow)) -private theorem noLeftInterior : - ∀ (n : Nat), - let M : Real := (n+2 : Nat) - let L (j : Fin (n+2)) (x : Real) : Real := - (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) - let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ - ∀ j : Fin (n+2), L j z.1 ≤ z.2} - (∀ (z : Real × Real), (z ∈ interior D) → ∃ e : Real, 0 < e ∧ Metric.ball z e ⊆ D) → ∀ (z : - Real × Real), (z ∈ interior D) → z.1 ≠ 0 := by - classical - intro n M L D ballAt z hz heq - obtain ⟨e,he,hball⟩ := ballAt z hz - let w : Real × Real := (z.1-e/2,z.2) - have hwball : w ∈ Metric.ball z e := by - change dist w z < e - simp [w, Prod.dist_eq, Real.dist_eq, - abs_of_pos (show 0 < e/2 by linarith)] - linarith - have hwD := hball hwball - rcases hwD with ⟨hw0,_,_,_⟩ - dsimp [w] at hw0 - rw [heq] at hw0 - linarith - -private theorem noRightInterior : - ∀ (n : Nat), - let M : Real := (n+2 : Nat) - let L (j : Fin (n+2)) (x : Real) : Real := - (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) - let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ - ∀ j : Fin (n+2), L j z.1 ≤ z.2} - (∀ (z : Real × Real), (z ∈ interior D) → ∃ e : Real, 0 < e ∧ Metric.ball z e ⊆ D) → ∀ (z : - Real × Real), (z ∈ interior D) → z.1 ≠ M := by - classical - intro n M L D ballAt z hz heq - obtain ⟨e,he,hball⟩ := ballAt z hz - let w : Real × Real := (z.1+e/2,z.2) - have hwball : w ∈ Metric.ball z e := by - change dist w z < e - simp [w, Prod.dist_eq, Real.dist_eq, - abs_of_pos (show 0 < e/2 by linarith)] - linarith - have hwD := hball hwball - rcases hwD with ⟨_,hwM,_,_⟩ - dsimp [w] at hwM - rw [heq] at hwM - linarith - private theorem noUpperInterior : ∀ (n : Nat), let M : Real := (n+2 : Nat) @@ -902,41 +832,6 @@ private theorem noLowerInterior : rw [heq] at hwL linarith -private theorem interiorStrict : - ∀ (n : Nat), - let M : Real := (n+2 : Nat) - let L (j : Fin (n+2)) (x : Real) : Real := - (2 * (j.val : Real) + 1) * x - (j.val : Real) * ((j.val : Real) + 1) - let D : Set (Real × Real) := {z | 0 ≤ z.1 ∧ z.1 ≤ M ∧ z.2 ≤ M*z.1 ∧ - ∀ j : Fin (n+2), L j z.1 ≤ z.2} - let O : Set (Real × Real) := - {z | 0 < z.1 ∧ z.1 < M ∧ z.2 < M*z.1 ∧ ∀ j : Fin (n+2), L j z.1 < z.2} - (∀ (z : Real × Real), (z ∈ interior D) → z.1 ≠ 0) → (∀ (z : Real × Real), (z ∈ interior D) → - z.1 ≠ M) → (∀ (z : Real × Real), (z ∈ interior D) → (z.2 = M*z.1) → False) → (∀ (z : Real - × Real), (z ∈ interior D) → ∀ (j : Fin (n+2)), (L j z.1 = z.2) → False) → ∀ (z : Real × - Real), (z ∈ interior D) → z ∈ O := by - classical - intro n M L D O noLeftInterior noRightInterior noUpperInterior noLowerInterior z hz - have hzD : z ∈ D := interior_subset hz - rcases hzD with ⟨hz0,hzM,hzU,hzL⟩ - have h0 : 0 < z.1 := by - apply lt_of_le_of_ne hz0 - intro h - exact noLeftInterior z hz h.symm - have hM : z.1 < M := by - apply lt_of_le_of_ne hzM - exact noRightInterior z hz - have hU : z.2 < M*z.1 := by - apply lt_of_le_of_ne hzU - intro h - exact noUpperInterior z hz h - have hL : ∀ j : Fin (n+2), L j z.1 < z.2 := by - intro j - apply lt_of_le_of_ne (hzL j) - intro h - exact noLowerInterior z hz j h - exact ⟨h0,hM,hU,hL⟩ - private theorem heqcases : ∀ (n : Nat), let M : Real := (n+2 : Nat) diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean b/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean index b80ff1694f..5f4a04be06 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1DirectionParity.lean @@ -217,59 +217,6 @@ private theorem cyclicSucc_eq_add : apply Fin.ext simp [cyclicSucc, Fin.val_add] -private theorem transition_sum_even : - let cyclicSucc (m : Nat) : Fin (m+1) ≃ Fin (m+1) := { - toFun := fun i => ⟨(i.val + 1) % (m+1), Nat.mod_lt _ (by omega)⟩ - invFun := fun i => ⟨(i.val + m) % (m+1), Nat.mod_lt _ (by omega)⟩ - left_inv := by - intro i - apply Fin.ext - change (((i.val + 1) % (m+1) + m) % (m+1)) = i.val - by_cases hi : i.val = m - · simp [hi] - · have him : i.val < m := by omega - have hinner : (i.val + 1) % (m+1) = i.val + 1 := Nat.mod_eq_of_lt (by omega) - rw [hinner] - have heq : i.val + 1 + m = (m+1) + i.val := by omega - rw [heq, Nat.add_mod, Nat.mod_self, zero_add] - simp [Nat.mod_eq_of_lt i.isLt] - right_inv := by - intro i - apply Fin.ext - change (((i.val + m) % (m+1) + 1) % (m+1)) = i.val - by_cases hi : i.val = 0 - · simp [hi] - · have heq : i.val + m = (m+1) + (i.val-1) := by omega - have hmod : (i.val + m) % (m+1) = i.val - 1 := by - have hmodi : (i.val-1) % (m+1) = i.val-1 := Nat.mod_eq_of_lt (by omega) - rw [heq, Nat.add_mod, Nat.mod_self, zero_add] - simp [hmodi] - rw [hmod] - have hlt : i.val - 1 + 1 < m+1 := by omega - rw [Nat.mod_eq_of_lt hlt] - omega - } - ∀ {m : Nat}, ∀ (b : Fin (m+1) → Bool), (∑ i : Fin (m+1), (if b i = b (cyclicSucc m i) then (0 - : Int) else 1)) % 2 = 0 := by - classical - intro cyclicSucc m b - classical - let w : Fin (m+1) → Int := fun i => if b i then 1 else 0 - let u : Fin (m+1) → Int := fun i => if b i = false ∧ b (cyclicSucc m i) = true then 1 else 0 - have hlocal (i : Fin (m+1)) : - (if b i = b (cyclicSucc m i) then (0 : Int) else 1) = - w i - w (cyclicSucc m i) + 2 * u i := by - simp only [w, u] - cases b i <;> cases b (cyclicSucc m i) <;> norm_num - have hsum : (∑ i, w (cyclicSucc m i)) = ∑ i, w i := (cyclicSucc m).sum_comp w - have heven : ∃ k : Int, (∑ i, if b i = b (cyclicSucc m i) then (0 : Int) else 1) = 2*k := by - refine ⟨∑ i, u i, ?_⟩ - simp_rw [hlocal] - rw [Finset.sum_add_distrib, Finset.sum_sub_distrib, hsum, sub_self, - zero_add, Finset.mul_sum] - obtain ⟨k, hk⟩ := heven - omega - private theorem cyclic_xor_count : let cyclicSucc (m : Nat) : Fin (m+1) ≃ Fin (m+1) := { toFun := fun i => ⟨(i.val + 1) % (m+1), Nat.mod_lt _ (by omega)⟩ @@ -383,17 +330,6 @@ private theorem cyclic_xor_count : obtain ⟨k, hk⟩ := htrans omega -private theorem ncard_filter : - ∀ {m : Nat}, ∀ (P : Fin (m+1) → Prop), ∀ [DecidablePred P], Set.ncard {i : Fin (m+1) | P i} = - (Finset.univ.filter P).card := by - classical - intro m P typeclassInstance0 - classical - rw [Set.ncard_eq_toFinset_card] - congr 1 - ext i - simp - private theorem affine_root_between : ∀ (a : Real), ∀ (c : Real), (a*c < 0) → (∃ u, 0 < u ∧ u < 1 ∧ (1-u)*a+u*c=0) := by classical diff --git a/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean b/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean index 8f0e52aa2d..2e795318bf 100644 --- a/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P3597T1VertexSectors.lean @@ -500,32 +500,6 @@ private theorem hnoPosMultiple : have heq := (right_mem_openSegment_iff.mp hqOpen) exact hnextVertex (by simpa [v] using heq.symm) -private theorem hstraight : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (i : Fin (n + 3)), - let v := p.vertex i - let prev : Fin (n + 3) := - if i.val = 0 then ⟨n + 2, by omega⟩ else ⟨i.val - 1, by omega⟩ - let a := p.vertex (i + 1) - v - let b := p.vertex prev - v - (a ≠ 0) → ((b ≠ 0) → ( - let cross (u z : Real × Real) : Real := u.1 * z.2 - u.2 * z.1 - (∀ x z : Real × Real, x ≠ 0 → cross x z = 0 → ∃ c : Real, z = c • x) → ((¬ ∃ c : Real, 0 < c - ∧ b = c • a) → (cross a b = 0 → ∃ c : Real, c < 0 ∧ b = c • a)))) ) := by - classical - intro n p i v prev a b ha hb cross hcrosszero hnoPosMultiple hD - obtain ⟨c, hba⟩ := hcrosszero a b ha hD - have hcne : c ≠ 0 := by - intro hc - rw [hc, zero_smul] at hba - exact hb hba - have hcnpos : ¬ 0 < c := by - intro hc - exact hnoPosMultiple ⟨c, hc, hba⟩ - exact ⟨c, lt_of_le_of_ne (le_of_not_gt hcnpos) hcne, hba⟩ - private theorem happroach : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean b/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean index 51960cffdc..d297066a3a 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1EmptyTriangleDiagonal.lean @@ -171,21 +171,6 @@ private theorem hint : intro n p E a b c v hind hspan A T hrange x exact Set.ext_iff.mp (by simpa [T, hrange] using A.interior_convexHull) x -private theorem hbase : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), - let a := p.vertex (E.b - 1) - let b := p.vertex E.b - let c := p.vertex (E.b + 1) - let T := convexHull Real ({a, b, c} : Set (Real × Real)) - (convexHull Real ({p.vertex (E.b - 1), p.vertex E.b, p.vertex (E.b + 1)} : Set (Real × - Real))) = T ) := by - classical - intro n p E a b c T - rfl - private theorem hvertexSide : (by classical @@ -315,18 +300,6 @@ private theorem habdist : have hv : p.vertex (E.b - 1) = p.vertex (E.b + 1) := congrArg p.vertex heq exact hacOuter hv -private theorem hbcOuter : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), - p.vertex E.b ≠ p.vertex (E.b + 1) ) := by - classical - intro n p E heq - have hh := congrArg E.height heq - rw [E.height_top, E.height_next] at hh - norm_num at hh - private theorem habNext : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean index c7048a6eaa..50d1416bb1 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1ExposedCornerExists.lean @@ -669,50 +669,6 @@ private theorem hUV : · have hnp : ¬ 0 < cross u w := not_lt_of_gt hn simpa [U, V, hnp, hswap] using neg_pos.mpr hn -private theorem hUne : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - ∀ (b : Fin (n + (3 : ℕ))), - let B := v b - let a := v (b - 1) - let c := v (b + 1) - let u : Real × Real := a - B - let w : Real × Real := c - B - (u ≠ 0) → ((w ≠ 0) → ( - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - let U := if 0 < cross u w then u else w - U ≠ 0)) ) := by - classical - intro n p v b B a c u w hu hw cross U - by_cases hp : 0 < cross u w - · simpa [U, hp] using hu - · simpa [U, hp] using hw - -private theorem hVne : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - ∀ (b : Fin (n + (3 : ℕ))), - let B := v b - let a := v (b - 1) - let c := v (b + 1) - let u : Real × Real := a - B - let w : Real × Real := c - B - (u ≠ 0) → ((w ≠ 0) → ( - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - let V := if 0 < cross u w then w else u - V ≠ 0)) ) := by - classical - intro n p v b B a c u w hu hw cross V - by_cases hp : 0 < cross u w - · simpa [V, hp] using hw - · simpa [V, hp] using hu - private theorem hdecomp : (by classical @@ -1633,66 +1589,6 @@ private theorem hcover : · have hvNeg : cross V (x-B) < 0 := lt_of_le_of_ne hv' hv0 exact Or.inl ⟨hx, huPos, hvNeg⟩ -private theorem hellU : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => - ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) - ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), - let q := Classical.choose hqexists - ∀ (b : Fin (n + (3 : ℕ))), - let c := v (b + 1) - let ell : (Real × Real) →ₗ[Real] Real := - { toFun := fun x => x.1 + q * x.2 - map_add' := by intro x y; simp; ring - map_smul' := by intro c x; simp; ring } - let B := v b - let a := v (b - 1) - let u : Real × Real := a - B - let w : Real × Real := c - B - (ell u < 0) → ((ell w < 0) → ( - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - let U := if 0 < cross u w then u else w - ell U < 0)) ) := by - classical - intro n p v f hqexists q b c ell B a u w hellu hellw cross U - by_cases hp : 0 < cross u w - · simpa [U, hp] using hellu - · simpa [U, hp] using hellw - -private theorem hellV : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), - let v := p.vertex - let f : Fin (n + 3) × Fin (n + 3) → Real := fun ij => - ((v ij.2).1 - (v ij.1).1) / ((v ij.1).2 - (v ij.2).2) - ∀ (hqexists : ∃ q : Real, q ∉ Set.range f), - let q := Classical.choose hqexists - ∀ (b : Fin (n + (3 : ℕ))), - let c := v (b + 1) - let ell : (Real × Real) →ₗ[Real] Real := - { toFun := fun x => x.1 + q * x.2 - map_add' := by intro x y; simp; ring - map_smul' := by intro c x; simp; ring } - let B := v b - let a := v (b - 1) - let u : Real × Real := a - B - let w : Real × Real := c - B - (ell u < 0) → ((ell w < 0) → ( - let cross (x y : Real × Real) : Real := x.1 * y.2 - x.2 * y.1 - let V := if 0 < cross u w then w else u - ell V < 0)) ) := by - classical - intro n p v f hqexists q b c ell B a u w hellu hellw cross V - by_cases hp : 0 < cross u w - · simpa [V, hp] using hellw - · simpa [V, hp] using hellu - private theorem hconeHeight : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean index db1c5137ca..ec6464dff7 100644 --- a/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean +++ b/LeanPool/ApollonianSuperharmonic/P3650T1OldArcEven.lean @@ -76,48 +76,6 @@ private theorem hRoff : rw [C.carrier_intersection] at hi exact hxR.2 hi -private theorem hLparent : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : - P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), - let e := segment Real (p.vertex D.a) (p.vertex D.b) - let CL := P3544T1BoundaryCarrier C.left - let CP := P3544T1BoundaryCarrier p - CL \ e ⊆ CP ) := by - classical - intro n p E D C e CL CP x hx - let CR := P3544T1BoundaryCarrier C.right - have hmem : x ∈ CL ∪ CR := Or.inl hx.1 - change x ∈ P3544T1BoundaryCarrier C.left ∪ - P3544T1BoundaryCarrier C.right at hmem - rw [C.carrier_union] at hmem - rcases hmem with hparent | hdiag - · exact hparent - · exact (hx.2 hdiag).elim - -private theorem hRparent : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : - P3650T1VisibleDiagonal p E), ∀ (C : P3650T1CyclicChildren p D.a D.b), - let e := segment Real (p.vertex D.a) (p.vertex D.b) - let CR := P3544T1BoundaryCarrier C.right - let CP := P3544T1BoundaryCarrier p - CR \ e ⊆ CP ) := by - classical - intro n p E D C e CR CP x hx - let CL := P3544T1BoundaryCarrier C.left - have hmem : x ∈ CL ∪ CR := Or.inr hx.1 - change x ∈ P3544T1BoundaryCarrier C.left ∪ - P3544T1BoundaryCarrier C.right at hmem - rw [C.carrier_union] at hmem - rcases hmem with hparent | hdiag - · exact hparent - · exact (hx.2 hdiag).elim - private theorem oldArcEvenOnPreconnected : (by classical @@ -145,34 +103,6 @@ private theorem oldArcEvenOnPreconnected : · exact False.elim (hxO (hSO hx)) · exact Set.disjoint_left.mpr (fun y hy hyO => hSE hy (Or.inl hyO)) -private theorem oldArcOddOnPreconnected : - (by - classical - exact - (∀ {X : Type}, ∀ [TopologicalSpace X], ∀ (O : Set X), ∀ (K : Set X), ∀ (S : Set X), - (IsOpen O) → ((closure O = O ∪ K) → ((IsPreconnected S) → ((Disjoint S K) → (∀ (x : - X), (x ∈ S) → ((x ∉ O) → (Disjoint S O))))))) → (∀ {X : Type}, ∀ [TopologicalSpace - X], ∀ (O : Set X), ∀ (K : Set X), ∀ (S : Set X), (IsOpen O) → ((closure O = O ∪ K) → - ((IsPreconnected S) → ((Disjoint S K) → (∀ (x : X), (x ∈ S) → ((x ∈ O) → (S ⊆ - O))))))) ) := by - classical - intro oldArcEvenOnPreconnected X typeclassInstance0 O K S hO hclosure hS hSK x hx hxO y hy - by_contra hyO - have hEven := oldArcEvenOnPreconnected O K S hO hclosure hS hSK y hy hyO - exact Set.disjoint_left.mp hEven hx hxO - -private theorem oldArcEvenClosure : - (by - classical - exact - ∀ {X : Type}, ∀ [TopologicalSpace X], ∀ (O : Set X), ∀ (S : Set X), (IsOpen O) → - ((Disjoint S O) → (Disjoint (closure S) O)) ) := by - classical - intro X typeclassInstance0 O S hO hSO - have hsub : S ⊆ Oᶜ := fun y hy hyO => Set.disjoint_left.mp hSO hy hyO - have hclosed : closure S ⊆ Oᶜ := closure_minimal hsub hO.isClosed_compl - exact Set.disjoint_left.mpr (fun y hy hyO => hclosed hy hyO) - private theorem leftFirstIndex : (by classical @@ -1042,23 +972,6 @@ private theorem hcoord_nonneg : have hmem := (Set.ext_iff.mp A.convexHull_eq_nonneg_coord) (p.vertex D.b) exact (hmem.mp htriangle) -private theorem hcoord_sum : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (E : P3650T1ExposedCorner p), ∀ (D : - P3650T1VisibleDiagonal p E), - let va := p.vertex (E.b - 1) - let vb := p.vertex E.b - let vc := p.vertex (E.b + 1) - let vv : Fin 3 → Real × Real := ![va, vb, vc] - ∀ (hind : AffineIndependent Real vv), ∀ (hspan : affineSpan Real (Set.range vv) = ⊤), - let A : AffineBasis (Fin 3) Real (Real × Real) := ⟨vv, hind, hspan⟩ - A.coord 0 (p.vertex D.b) + A.coord 1 (p.vertex D.b) + A.coord 2 (p.vertex D.b) = 1 ) := by - classical - intro n p E D va vb vc vv hind hspan A - simpa only [Fin.sum_univ_three] using A.sum_coord_apply_eq_one (p.vertex D.b) - private theorem hside0 : (by classical @@ -2559,19 +2472,6 @@ end OldArcParityProof namespace OldArcAssembly -private theorem strictUpperHalfplaneEven : - (by - classical - exact - (∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), ∀ (ell : (Real × Real) →ₗ[Real] Real), - ∀ (H : Real), (∀ i, ell (q.vertex i) ≤ H) → (∀ (x : Real × Real), (H < ell x) → (x ∉ - P3544T1RayParity q))) → (∀ {m : Nat}, ∀ (q : P3381T1PolygonBoundary m), ∀ (ell : - (Real × Real) →ₗ[Real] Real), ∀ (H : Real), (∀ i, ell (q.vertex i) < H) → (∀ (x : - Real × Real), (H < ell x) → (x ∉ P3544T1RayParity q))) ) := by - classical - intro upperHalfplaneEven m q ell H hbound x hx - exact upperHalfplaneEven q ell H (fun i => le_of_lt (hbound i)) x hx - private theorem hseedRAt3047 : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean index d7602dfe01..156ad797cc 100644 --- a/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P3652T1IndexedFaceLedger.lean @@ -1244,54 +1244,6 @@ private theorem hrightCountImage : rw [hset] exact R.edge_count x y hxy -private theorem hleftZero : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XL - : Set (Real × Real)), ∀ (L : P3511T1SourceDissection S.left XL), ∀ (i : Fin (n + (3 - : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∉ Set.range S.il → {k : Fin L.count | i ∈ - Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)}.ncard = (0 : ℕ) ) := by - classical - intro n p S XL L i j hi - have hempty : {k : Fin L.count | - i ∈ Set.range (S.il ∘ L.face k) ∧ j ∈ Set.range (S.il ∘ L.face k)} = ∅ := by - ext k - simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false] - constructor - · rintro ⟨hik, _⟩ - apply hi - obtain ⟨z, hz⟩ := Set.mem_range.mp hik - exact ⟨L.face k z, hz⟩ - · intro h - exact False.elim h - rw [hempty] - simp - -private theorem hrightZero : - (by - classical - exact - ∀ (n : Nat), ∀ (p : P3381T1PolygonBoundary n), ∀ (S : P3544T1DiagonalSplit p), ∀ (XR - : Set (Real × Real)), ∀ (R : P3511T1SourceDissection S.right XR), ∀ (i : Fin (n + - (3 : ℕ))), ∀ (j : Fin (n + (3 : ℕ))), i ∉ Set.range S.ir → {k : Fin R.count | i ∈ - Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)}.ncard = (0 : ℕ) ) := by - classical - intro n p S XR R i j hi - have hempty : {k : Fin R.count | - i ∈ Set.range (S.ir ∘ R.face k) ∧ j ∈ Set.range (S.ir ∘ R.face k)} = ∅ := by - ext k - simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false] - constructor - · rintro ⟨hik, _⟩ - apply hi - obtain ⟨z, hz⟩ := Set.mem_range.mp hik - exact ⟨R.face k z, hz⟩ - · intro h - exact False.elim h - rw [hempty] - simp - private theorem husedSplit : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean index 55bcb03312..557ba667b2 100644 --- a/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean +++ b/LeanPool/ApollonianSuperharmonic/P3723T1AllContactDrawingExists.lean @@ -1878,46 +1878,6 @@ private theorem half_subset : · exfalso exact (Set.disjoint_left.mp (half_disjoint x y u v hxy huv hxyuv hxu) hz.1 hz.2) -private theorem hstartAt1216 : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1ContactPorts P), (∀ (a : ι), - ∀ (b : ι), P3723T1EdgeContact P a b ↔ P3723T1EdgeContact - P b a) → ( - ∀ (localStar : (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ (rep_spec : ∀ (a : ι), rep a ∈ P.vertexOrbitReps ∧ ∃ u : P.lattice, a = P.shift u (rep - a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; - ∀ (pulled_contact : ∀ (a : ι), ∀ (b : ι), (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), - ( - let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - (∀ a, ∀ b, P3723T1EdgeContact P a b → - Continuous (g a b) ∧ Function.Injective (g a b) ∧ - g a b ⟨0, by norm_num⟩ = D.position a ∧ - D.port a b = some (g a b ⟨1, by norm_num⟩) ∧ - Nonempty (P3723T1PolygonalParameterization (g a b)) ∧ - Set.range (g a b) ⊆ interior (TileRealization (P.tile a)) ∪ - {g a b ⟨1, by norm_num⟩}) → ( - let halfArc (a b : ι) : Set (Real × Real) := - if P3723T1EdgeContact P a b then Set.range (g a b) else ∅; - let edgeArc (a b : ι) : Set (Real × Real) := halfArc a b ∪ halfArc b a; - ∀ (x : ι), ∀ (y : ι), (P3723T1EdgeContact P x y) → (D.position x ∈ edgeArc x y))))) := by - classical - intro ι P D symmetric localStar rep rep_spec period pulled_contact g gproperties halfArc - edgeArc x y hxy - have hrev := (symmetric x y).mp hxy - simp only [edgeArc, halfArc, ite_eq_left hxy, ite_eq_left hrev] - left - exact ⟨⟨0, by norm_num⟩, (gproperties x y hxy).2.2.1⟩ - private theorem hendAt1222 : (by classical @@ -1958,64 +1918,6 @@ private theorem hendAt1222 : right exact ⟨⟨0, by norm_num⟩, (gproperties y x hrev).2.2.1⟩ -private theorem vertex_mem : - (by - classical - exact - ∀ (ι : Type), - ∀ (P : PeriodicTileComplex ι), - ∀ (D : P3723T1ContactPorts P), - ∀ - (localStar : - (a : ι) → - { b : ι // P3723T1EdgeContact P a b } → - (↑(Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - let rep (a : ι) : ι := - Classical.choose (P.vertex_orbit_representatives a).exists; - ∀ - (rep_spec : - ∀ (a : ι), - rep a ∈ P.vertexOrbitReps ∧ - ∃ u : P.lattice, a = P.shift u (rep a)), - let period (a : ι) : P.lattice := Classical.choose (rep_spec a).2; - ∀ - (pulled_contact : - ∀ (a : ι), - ∀ (b : ι), - (P3723T1EdgeContact P a b) → - (P3723T1EdgeContact P (rep a) (P.shift (-period a) b))), - (let g (a b : ι) (s : Icc (0 : Real) 1) : Real × Real := - if hab : P3723T1EdgeContact P a b then - localStar (rep a) - ⟨P.shift (-period a) b, pulled_contact a b hab⟩ s + - GaussianRealPoint (period a) - else D.position a; - let halfArc (a b : ι) : Set (Real × Real) := - if P3723T1EdgeContact P a b then Set.range (g a b) else ∅; - let edgeArc (a b : ι) : Set (Real × Real) := - halfArc a b ∪ halfArc b a; - (∀ (x : ι), - ∀ (y : ι), - (P3723T1EdgeContact P x y) → - (D.position x ∈ edgeArc x y)) → - ((∀ (x : ι), - ∀ (y : ι), - (P3723T1EdgeContact P x y) → - (D.position y ∈ edgeArc x y)) → - (∀ (x : ι), - ∀ (y : ι), - ∀ (i : ι), - (P3723T1EdgeContact P x y) → - ((i = x ∨ i = y) → (D.position i ∈ edgeArc x y)))))) := by - classical - intro ι P D localStar rep rep_spec period pulled_contact g halfArc edgeArc hstart hend x y i - hxy hi - rcases hi with hi | hi - · rw [hi] - exact hstart x y hxy - · rw [hi] - exact hend x y hxy - private theorem hab_mem : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean b/LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean index 6dc3953a90..4100641f4b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1BoundedDisplacementSurjective.lean @@ -130,12 +130,6 @@ private theorem hcin (M : ℝ) (y : ℝ × ℝ) (hR : 0 ≤ (R M)) : ∀ t, (c M · rw [abs_mul, abs_of_nonneg hR] exact mul_le_of_le_one_right hR (Real.abs_sin_le_one _) -private noncomputable abbrev θ : (T) → Real := by - classical - let T := Set.Icc (0 : Real) 1 - change (T → Real) - exact fun t => 2 * Real.pi * (t : Real) - private noncomputable abbrev E : (T) → ℂ := by classical let T := Set.Icc (0 : Real) 1 diff --git a/LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean b/LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean index 4fe99fecdc..01da8881ea 100644 --- a/LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean +++ b/LeanPool/ApollonianSuperharmonic/P3776T1DualEdgesExist.lean @@ -372,13 +372,6 @@ private theorem faceShift_cancel : intro ι P u f rw [← P.faceShift_add, add_neg_cancel, P.faceShift_zero] -private theorem faceShift_cancel' : - ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (u : ↥P.lattice), ∀ (f : P.plane.Face), - P.faceShift (-u) (P.faceShift u f) = f := by - classical - intro ι P u f - rw [← P.faceShift_add, neg_add_cancel, P.faceShift_zero] - private theorem walk_translate : ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), ∀ (p : List GaussianInt), p ≠ [] → ∀ (u : ↥P.lattice), ∀ (t : (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type)), P3776T1WalkMap (List.map (fun diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean b/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean index 88e4e0e2f7..716644638f 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1CircleComponentBound.lean @@ -120,30 +120,6 @@ private theorem hcomp_pull : simpa [hSymmImageT, h.symm_apply_apply] using him exact connectedComponentIn_eq hmem' -private theorem hcomp_push : - ∀ (e : C(Circle, Real × Real)), - let h₀ : ℂ ≃ₜ (Real × Real) := - Complex.equivRealProd.toHomeomorphOfIsInducing - Complex.isUniformEmbedding_equivRealProd.isInducing - let h : (Real × Real) ≃ₜ ℂ := h₀.symm - let ec : C(Circle, ℂ) := ⟨fun t => h (e t), h.continuous.comp e.continuous⟩ - let K : Set ℂ := Set.range ec - let T : Set ℂ := Kᶜ - let S : Set (Real × Real) := (Set.range e)ᶜ - (h '' S = T) → (∀ (u : ℝ × ℝ), ∀ (v : ℝ × ℝ), u ∈ S → v ∈ S → connectedComponentIn S u = - connectedComponentIn S v → connectedComponentIn T ((h : ℝ × ℝ → ℂ) u) = - connectedComponentIn T ((h : ℝ × ℝ → ℂ) v)) := by - classical - intro e h₀ h ec K T S hImageS u v hu hv hcmp - have hmem : v ∈ connectedComponentIn S u := by rw [hcmp]; exact mem_connectedComponentIn hv - have himage := h.continuous.continuousOn.image_connectedComponentIn_subset - (s := S) (a := u) hu - have hmem' : h v ∈ connectedComponentIn T (h u) := by - have : h v ∈ h '' connectedComponentIn S u := ⟨v, hmem, rfl⟩ - have him := himage this - simpa [hImageS] using him - exact connectedComponentIn_eq hmem' - private theorem impossible_pair : ∀ (e : C(Circle, Real × Real)), (Function.Injective (⇑e : Circle → ℝ × ℝ)) → ( let h₀ : ℂ ≃ₜ (Real × Real) := diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean index 3b7a802d04..94e1b49af5 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ComponentContours.lean @@ -1321,17 +1321,6 @@ private theorem cell_exists : refine ⟨lt_of_le_of_ne (Int.floor_le _) (Ne.symm (hr _)), Int.lt_floor_add_one _, lt_of_le_of_ne (Int.floor_le _) (Ne.symm (hi _)), Int.lt_floor_add_one _⟩ -private theorem hKne : - ∀ (K : Set ℂ), ∀ (p : ℂ), ∀ (q : ℂ), (connectedComponentIn Kᶜ p ≠ connectedComponentIn Kᶜ q) - → (K.Nonempty) := by - classical - intro K p q hne - by_contra h - apply hne - simp only [(Set.not_nonempty_iff_eq_empty.mp h), Set.compl_empty] - rw [isPreconnected_univ.connectedComponentIn (Set.mem_univ p), - isPreconnected_univ.connectedComponentIn (Set.mem_univ q)] - private theorem hKV : ∀ (K : Set ℂ), ∀ (N : Set ℂ), diff --git a/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean b/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean index ce0a340295..25fbdbd779 100644 --- a/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean +++ b/LeanPool/ApollonianSuperharmonic/P3821T1ControlledNeighborhood.lean @@ -157,12 +157,6 @@ private theorem hFS (e : C(Circle, ℂ)) (S : Set ↑(Set.range ⇑e)) (hSf : S. let F : Finset (Set.range e) := hSf.toFinset change ((F : Set (Set.range e)) = S) ext c; simp [F] -private theorem hFsub (e : C(Circle, ℂ)) (S : Set ↑(Set.range ⇑e)) (hSf : S.Finite) : ((F e S - hSf) : Set (Set.range e)) ⊆ Set.univ := by - classical - let F : Finset (Set.range e) := hSf.toFinset - change ((F : Set (Set.range e)) ⊆ Set.univ) - simp private theorem hcover' (e : C(Circle, ℂ)) (eps : ℝ) (S : Set ↑(Set.range ⇑e)) (η : ℝ) (hSf : S.Finite) (hcover : Set.univ ⊆ ⋃ x ∈ S, Metric.ball x (r eps η)) : (Set.univ : Set (Set.range e)) ⊆ diff --git a/LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean b/LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean index ab7f1e0ed7..ea9678f6ed 100644 --- a/LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean +++ b/LeanPool/ApollonianSuperharmonic/P3861T1FixedFacialDeletion.lean @@ -26,37 +26,6 @@ namespace ApollonianSuperharmonic namespace FacialDeletionProof -private theorem hCcompact : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileCore ι), - let U (f : P.plane.Face) := P.plane.faceRegion f - let C (f : P.plane.Face) := frontier (U f) - (∀ (f : P.plane.Face), C f = P.plane.edgeArc (P.plane.faceVertex f 0) (P.plane.faceVertex - f 1) ∪ P.plane.edgeArc (P.plane.faceVertex f 1) (P.plane.faceVertex f 2) ∪ - P.plane.edgeArc (P.plane.faceVertex f 2) (P.plane.faceVertex f 0)) → (∀ (f : - P.plane.Face), IsCompact (C f)) ) := by - classical - intro ι P U C hfront f - rw [hfront f] - have hacomp (a b : ι) (hab : P.plane.adjacent a b) : - IsCompact (P.plane.edgeArc a b) := by - obtain ⟨e, _, _⟩ := P.plane.arc_homeomorph a b hab - have himage : Set.range (fun x : Set.Icc (0 : Real) 1 => - ((e x : P.plane.edgeArc a b) : Real × Real)) = P.plane.edgeArc a b := by - ext x - constructor - · rintro ⟨t, rfl⟩ - exact (e t).property - · intro hx - exact ⟨e.symm ⟨x, hx⟩, by simp⟩ - rw [← himage] - exact isCompact_range (continuous_subtype_val.comp e.continuous) - exact ((hacomp _ _ (P.plane.face_edges f 0 1 (by decide))).union - (hacomp _ _ (P.plane.face_edges f 1 2 (by decide)))).union - (hacomp _ _ (P.plane.face_edges f 2 0 (by decide))) - private theorem hWnonempty : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean index efeb44820d..528b790d0b 100644 --- a/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/P3889T1FaceGapCoverage.lean @@ -143,53 +143,6 @@ private theorem hfaceFrontier : · exact ⟨Or.inr h20, hqB⟩ · exact ⟨Or.inl (Or.inr h12), hqB⟩ -private theorem hpNotRays : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : - ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), ((Set.range D.position ∪ {p : ℝ × ℝ | ∃ (c : ι) (d - : ι), P.plane.adjacent c d ∧ p ∈ D.edgeArc c d}) ∩ Metric.ball (D.position a) r = - Metric.ball (D.position a) r ∩ {p : ℝ × ℝ | ∃ (c : ι), P.plane.adjacent a c ∧ ∃ (t : - ℝ), (0 : ℝ) ≤ t ∧ p = D.position a + t • u c}) → (∀ (p : ℝ × ℝ), - let x := D.position a - let B := Metric.ball x r - let T := Set.range D.position ∪ - {q | ∃ c d, P.plane.adjacent c d ∧ q ∈ D.edgeArc c d} - (p ∉ T) → (p ∉ B ∩ {q | ∃ c, P.plane.adjacent a c ∧ ∃ t : Real, 0 ≤ t ∧ q = x + t • u - c})) ) := by - classical - intro ι P D a r u htrace p x B T hpNotT h - have hpTrace : p ∈ (Set.range D.position ∪ - {q | ∃ c d, P.plane.adjacent c d ∧ q ∈ D.edgeArc c d}) ∩ - Metric.ball (D.position a) r := by - change p ∈ Metric.ball (D.position a) r ∩ - {q | ∃ c, P.plane.adjacent a c ∧ - ∃ t : Real, 0 ≤ t ∧ q = D.position a + t • u c} at h - rw [htrace] - exact h - apply hpNotT - change p ∈ Set.range D.position ∪ - {q | ∃ c d, P.plane.adjacent c d ∧ q ∈ D.edgeArc c d} - exact hpTrace.1 - -private theorem hpNotRay : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : - ι), ∀ (r : ℝ), ∀ (u : ι → ℝ × ℝ), ∀ (p : ℝ × ℝ), - let x := D.position a - let B := Metric.ball x r - (p ∈ B) → ((p ∉ B ∩ {q | ∃ c, P.plane.adjacent a c ∧ ∃ t : Real, 0 ≤ t ∧ q = x + t • u - c}) → (∀ (c : ι), P.plane.adjacent a c → p ∉ {q : ℝ × ℝ | ∃ (t : ℝ), (0 : ℝ) ≤ t ∧ q - = x + t • u c})) ) := by - classical - intro ι P D a r u p x B hpB hpNotRays c hac h - apply hpNotRays - refine ⟨hpB, c, hac, ?_⟩ - simpa [x] using h - private theorem hincidentSectorData : (by classical @@ -1130,21 +1083,6 @@ private theorem hball₁' : intro ι P D a r x B z t δ₁ hball₁ δ₂ eps heps₁ q hq exact hball₁ (Metric.ball_subset_ball (le_of_lt heps₁) hq) -private theorem hball₂' : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (a : - ι), ∀ (r : ℝ), - let x := D.position a - let B := Metric.ball x r - ∀ (z : ℝ × ℝ), ∀ (t : ℝ), ∀ (δ₁ : ℝ), ∀ (δ₂ : ℝ), (Metric.ball z δ₂ ⊆ B) → ( - let eps := min δ₁ (min δ₂ t) / 2 - (eps < δ₂) → (Metric.ball z eps ⊆ B)) ) := by - classical - intro ι P D a r x B z t δ₁ δ₂ hball₂ eps heps₂ q hq - exact hball₂ (Metric.ball_subset_ball (le_of_lt heps₂) hq) - private theorem hzeroK : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean index 9d7ff3d3e9..82f0d6a08c 100644 --- a/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean +++ b/LeanPool/ApollonianSuperharmonic/P3913T1RoutedFaceSubdivision.lean @@ -1403,33 +1403,6 @@ private theorem w_arc : rw [← hr k] exact ⟨τ k i, rfl⟩ -private theorem w_before_end : - (by - classical - exact - ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · have hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · have hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩ - ∀ (k : Fin (3 : ℕ)), - ∀ (i : Fin (s k).count), (↑(τ k i.castSucc) : ℝ) < (1 : ℝ) - ) := by - classical - intro g s τ k i - have hidx : i.castSucc < Fin.last (s k).count := by - apply Fin.mk_lt_mk.mpr - simp - have ht := (s k).strict hidx - rw [(s k).finish] at ht - exact ht - private theorem w_finish : (by classical @@ -1460,34 +1433,6 @@ private theorem w_finish : simp [τ, (s k).finish] simpa [w, he] using h1 k -private theorem w_start : - (by - classical - exact - ∀ (ι : Type), ∀ (P : PeriodicTileComplex ι), ∀ (D : P3723T1AllContactRouting P), ∀ (f : - P.plane.Face), ∀ (g : Fin (3 : ℕ) → (↑(Set.Icc (0 : ℝ) (1 : ℝ)) : Type) → ℝ × ℝ), - ((∀ (k : Fin (3 : ℕ)), g - k ⟨(0 : ℝ), (by norm_num)⟩ = D.position (P.plane.faceVertex - f k)) → (∀ (s : (k : Fin (3 : ℕ)) → P3723T1PolygonalParameterization (g k)), - let τ (k : Fin 3) (i : Fin ((s k).count + 1)) : Set.Icc (0 : Real) 1 := - ⟨(s k).time i, by - constructor - · have hi := (s k).strict.monotone (Fin.zero_le i) - rw [(s k).start] at hi - exact hi - · have hi := (s k).strict.monotone (Fin.le_last i) - rw [(s k).finish] at hi - exact hi⟩; - let w (k : Fin 3) (i : Fin ((s k).count + 1)) := g k (τ k i); - let v : Fin 3 → ι := P.plane.faceVertex f; - ∀ (k : Fin (3 : ℕ)), w k (0 : Fin ((s k).count + (1 : ℕ))) = D.position (v k)))) := by - classical - intro ι P D f g h0 s τ w v k - have he : τ k 0 = ⟨0, by norm_num⟩ := by - apply Subtype.ext - simp [τ, (s k).start] - simpa [w, he] using h0 k - private theorem arc01 : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean b/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean index 3847f8f2cf..cf240b5798 100644 --- a/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean +++ b/LeanPool/ApollonianSuperharmonic/P3934T1SectorContinuation.lean @@ -95,109 +95,6 @@ private theorem hrep : _ = (B p / d') • a + (A p / d') • b := by simp [smul_add, smul_smul, div_eq_mul_inv, mul_comm] -private theorem hC₁conv : - ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), - let det : (Real - × Real) → (Real × Real) → Real := - fun a b => a.1 * b.2 - a.2 * b.1 - let d := det u v - let a : Real × Real := if 0 < d then u else v - let b : Real × Real := if 0 < d then v else u - let A : (Real × Real) → Real := fun p => det a (p - x) - let B : (Real × Real) → Real := fun p => det (p - x) b - let C₁ : Set (Real × Real) := - Metric.ball x r ∩ {p | 0 < A p} ∩ {p | 0 < B p} - Convex ℝ C₁ := by - classical - intro x r u v det d a b A B C₁ p hp q hq α β hα hβ hsum - rcases hp with ⟨⟨hpball, hpA⟩, hpB⟩ - rcases hq with ⟨⟨hqball, hqA⟩, hqB⟩ - have hβ' : β = 1 - α := by linarith - subst β - refine ⟨⟨(convex_ball x r) hpball hqball hα (by positivity) (by linarith), ?_⟩, ?_⟩ - · have hcomb : A (α • p + (1 - α) • q) = α * A p + (1 - α) * A q := by - dsimp [A, det] - ring - change 0 < A (α • p + (1 - α) • q) - rw [hcomb] - by_cases hα0 : α = 0 - · subst α - simpa using hqA - · have hαpos : 0 < α := lt_of_le_of_ne hα (Ne.symm hα0) - exact add_pos_of_pos_of_nonneg (mul_pos hαpos hpA) - (mul_nonneg (by positivity) (le_of_lt hqA)) - · have hcomb : B (α • p + (1 - α) • q) = α * B p + (1 - α) * B q := by - dsimp [B, det] - ring - change 0 < B (α • p + (1 - α) • q) - rw [hcomb] - by_cases hα0 : α = 0 - · subst α - simpa using hqB - · have hαpos : 0 < α := lt_of_le_of_ne hα (Ne.symm hα0) - exact add_pos_of_pos_of_nonneg (mul_pos hαpos hpB) - (mul_nonneg (by positivity) (le_of_lt hqB)) - -private theorem hCconv : - ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), - let det : (Real - × Real) → (Real × Real) → Real := - fun a b => a.1 * b.2 - a.2 * b.1 - let d := det u v - let a : Real × Real := if 0 < d then u else v - let A : (Real × Real) → Real := fun p => det a (p - x) - let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} - Convex ℝ C := by - classical - intro x r u v det d a A C p hp q hq α β hα hβ hsum - rcases hp with ⟨hpball, hpA⟩ - rcases hq with ⟨hqball, hqA⟩ - have hβ' : β = 1 - α := by linarith - subst β - refine ⟨(convex_ball x r) hpball hqball hα (by positivity) (by linarith), ?_⟩ - have hcomb : A (α • p + (1 - α) • q) = α * A p + (1 - α) * A q := by - dsimp [A, det] - ring - change A (α • p + (1 - α) • q) < 0 - rw [hcomb] - by_cases hβ0 : 1 - α = 0 - · have hαone : α = 1 := by linarith - simpa [hαone, hβ0] using hpA - · have hβpos : 0 < 1 - α := lt_of_le_of_ne (by linarith) (Ne.symm hβ0) - exact add_neg_of_nonpos_of_neg - (mul_nonpos_of_nonneg_of_nonpos hα (le_of_lt hpA)) - (mul_neg_of_pos_of_neg hβpos hqA) - -private theorem hDconv : - ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), - let det : (Real - × Real) → (Real × Real) → Real := - fun a b => a.1 * b.2 - a.2 * b.1 - let d := det u v - let b : Real × Real := if 0 < d then v else u - let B : (Real × Real) → Real := fun p => det (p - x) b - let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} - Convex ℝ D := by - classical - intro x r u v det d b B D p hp q hq α β hα hβ hsum - rcases hp with ⟨hpball, hpB⟩ - rcases hq with ⟨hqball, hqB⟩ - have hβ' : β = 1 - α := by linarith - subst β - refine ⟨(convex_ball x r) hpball hqball hα (by positivity) (by linarith), ?_⟩ - have hcomb : B (α • p + (1 - α) • q) = α * B p + (1 - α) * B q := by - dsimp [B, det] - ring - change B (α • p + (1 - α) • q) < 0 - rw [hcomb] - by_cases hβ0 : 1 - α = 0 - · have hαone : α = 1 := by linarith - simpa [hαone, hβ0] using hpB - · have hβpos : 0 < 1 - α := lt_of_le_of_ne (by linarith) (Ne.symm hβ0) - exact add_neg_of_nonpos_of_neg - (mul_nonpos_of_nonneg_of_nonpos hα (le_of_lt hpB)) - (mul_neg_of_pos_of_neg hβpos hqB) - private theorem hRayShape : ∀ (x : Real × Real), ∀ (u : Real × Real), ∀ (v : Real × Real), let det : (Real × Real) → @@ -1420,22 +1317,6 @@ private theorem hAqnegAt1373 : dsimp [A, qneg, det, d'] ring -private theorem hBqneg : - ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), - let det : (Real × Real) → (Real × Real) → Real := - fun a b => a.1 * b.2 - a.2 * b.1 - let d := det u v - let a : Real × Real := if 0 < d then u else v - let b : Real × Real := if 0 < d then v else u - let d' := det a b - let B : (Real × Real) → Real := fun p => det (p - x) b - let qneg : Real × Real := x - (r / 4) • (a + b) - B qneg = -(r / 4) * d' := by - classical - intro x r u v det d a b d' B qneg - dsimp [B, qneg, det, d'] - ring - private theorem hqnegAAt1379 : ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), let det : (Real × Real) → (Real × Real) → Real := @@ -1454,43 +1335,6 @@ private theorem hqnegAAt1379 : rw [hAqneg] nlinarith [hqposA] -private theorem hqnegB : - ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), - let det : (Real × Real) → (Real × Real) → Real := - fun a b => a.1 * b.2 - a.2 * b.1 - let d := det u v - let a : Real × Real := if 0 < d then u else v - let b : Real × Real := if 0 < d then v else u - let d' := det a b - let A : (Real × Real) → Real := fun p => det a (p - x) - let B : (Real × Real) → Real := fun p => det (p - x) b - let qpos : Real × Real := x + (r / 4) • (a + b) - (A qpos = (r / 4) * d') → ((0 < A qpos) → ( - let qneg : Real × Real := x - (r / 4) • (a + b) - (B qneg = -(r / 4) * d') → (B qneg < 0))) := by - classical - intro x r u v det d a b d' A B qpos hAqpos hqposA qneg hBqneg - rw [hBqneg] - nlinarith [hqposA] - -private theorem hC₂conn : - ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), ∀ (v : Real × Real), - let det : (Real × Real) → (Real × Real) → Real := - fun a b => a.1 * b.2 - a.2 * b.1 - let d := det u v - let a : Real × Real := if 0 < d then u else v - let b : Real × Real := if 0 < d then v else u - let A : (Real × Real) → Real := fun p => det a (p - x) - let B : (Real × Real) → Real := fun p => det (p - x) b - let C : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} - let D : Set (Real × Real) := Metric.ball x r ∩ {p | B p < 0} - let C₂ : Set (Real × Real) := C ∪ D - ((C ∩ D).Nonempty) → ((IsConnected C) → ((IsConnected D) → (IsConnected C₂))) := by - classical - intro x r u v det d a b A B C D C₂ hCDne hCconn hDconn - dsimp [C₂] - exact IsConnected.union hCDne hCconn hDconn - private theorem horder : ∀ (u : Real × Real), ∀ (v : Real × Real), let det : (Real × Real) → (Real × Real) → Real := @@ -1793,66 +1637,6 @@ private theorem hNopen : dsimp [N] exact Metric.isOpen_ball.inter (isOpen_Iio.preimage hAcont) -private theorem hPconv : - ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), - let det : (Real × Real) → (Real × Real) → Real := - fun a b => a.1 * b.2 - a.2 * b.1 - let A : (Real × Real) → Real := fun p => det u (p - x) - let P : Set (Real × Real) := Metric.ball x r ∩ {p | 0 < A p} - Convex ℝ P := by - classical - intro x r u det A P - let f : (Real × Real) →ᵃ[Real] Real := { - toFun := A - linear := { - toFun := fun y => det u y - map_add' := by - intro y z - dsimp [det] - ring - map_smul' := by - intro c y - dsimp [det] - ring - } - map_vadd' := by - intro p y - dsimp [A, det] - ring - } - change Convex ℝ (Metric.ball x r ∩ f ⁻¹' Set.Ioi 0) - exact (convex_ball x r).inter ((convex_Ioi 0).affine_preimage f) - -private theorem hNconv : - ∀ (x : Real × Real), ∀ (r : Real), ∀ (u : Real × Real), - let det : (Real × Real) → (Real × Real) → Real := - fun a b => a.1 * b.2 - a.2 * b.1 - let A : (Real × Real) → Real := fun p => det u (p - x) - let N : Set (Real × Real) := Metric.ball x r ∩ {p | A p < 0} - Convex ℝ N := by - classical - intro x r u det A N - let f : (Real × Real) →ᵃ[Real] Real := { - toFun := A - linear := { - toFun := fun y => det u y - map_add' := by - intro y z - dsimp [det] - ring - map_smul' := by - intro c y - dsimp [det] - ring - } - map_vadd' := by - intro p y - dsimp [A, det] - ring - } - change Convex ℝ (Metric.ball x r ∩ f ⁻¹' Set.Iio 0) - exact (convex_ball x r).inter ((convex_Iio 0).affine_preimage f) - private theorem hsqpos : ∀ (u : Real × Real), (u ≠ (0, 0)) → (0 < u.1 ^ 2 + u.2 ^ 2) := by classical diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean index 6dbb0353e7..6890842102 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1ExteriorMixedCycleObstruction.lean @@ -157,57 +157,6 @@ private theorem hpattern : | exact Or.inr (Or.inr (Or.inl ⟨haU, hbV⟩)) | exact Or.inr (Or.inr (Or.inr ⟨haU, hbV⟩)) -private theorem hExteriorPair : - ∀ (U : ProtoTile), ∀ (V : ProtoTile), ∀ (x : GaussianInt), - let c0 : GaussianInt := x - let c1 : GaussianInt := x - 1 - let c2 : GaussianInt := x - 1 - ⟨0, 1⟩ - let c3 : GaussianInt := x - ⟨0, 1⟩ - (¬ (c0 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c1 ∈ U.cells ∧ - c2 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c1 ∈ V.cells)) → ((¬ (c2 ∈ U.cells ∧ c3 ∈ V.cells)) - → ((¬ (c3 ∈ U.cells ∧ c2 ∈ V.cells)) → ((¬ (c3 ∈ U.cells ∧ c0 ∈ V.cells)) → ((¬ (c0 ∈ - U.cells ∧ c3 ∈ V.cells)) → (((c0 ∈ U.cells ∧ c2 ∈ V.cells) ∨ (c2 ∈ U.cells ∧ c0 ∈ - V.cells) ∨ (c1 ∈ U.cells ∧ c3 ∈ V.cells) ∨ (c3 ∈ U.cells ∧ c1 ∈ V.cells)) → ((∀ (q : - GaussianInt), (q ∉ U.cells) → ((q ∉ V.cells) → (q ∈ (↑(U.cells ∪ V.cells) : Set - GaussianInt)ᶜ))) → ((c1 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ ∧ c3 ∈ (↑(U.cells ∪ - V.cells) : Set GaussianInt)ᶜ) ∨ (c0 ∈ (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ ∧ c2 ∈ - (↑(U.cells ∪ V.cells) : Set GaussianInt)ᶜ))))))))))) := by - classical - intro U V x c0 c1 c2 c3 no01 no10 no12 no21 no23 no32 no30 no03 hpattern inExterior - rcases hpattern with ⟨hu0, hv2⟩ | ⟨hu2, hv0⟩ | ⟨hu1, hv3⟩ | ⟨hu3, hv1⟩ - · left - constructor - · apply inExterior - · intro h; exact no12 ⟨h, hv2⟩ - · intro h; exact no01 ⟨hu0, h⟩ - · apply inExterior - · intro h; exact no32 ⟨h, hv2⟩ - · intro h; exact no03 ⟨hu0, h⟩ - · left - constructor - · apply inExterior - · intro h; exact no10 ⟨h, hv0⟩ - · intro h; exact no21 ⟨hu2, h⟩ - · apply inExterior - · intro h; exact no30 ⟨h, hv0⟩ - · intro h; exact no23 ⟨hu2, h⟩ - · right - constructor - · apply inExterior - · intro h; exact no03 ⟨h, hv3⟩ - · intro h; exact no10 ⟨hu1, h⟩ - · apply inExterior - · intro h; exact no23 ⟨h, hv3⟩ - · intro h; exact no12 ⟨hu1, h⟩ - · right - constructor - · apply inExterior - · intro h; exact no01 ⟨h, hv1⟩ - · intro h; exact no30 ⟨hu3, h⟩ - · apply inExterior - · intro h; exact no21 ⟨h, hv1⟩ - · intro h; exact no32 ⟨hu3, h⟩ - private theorem adjNe : ∀ {a : GaussianInt}, ∀ {b : GaussianInt}, FourNeighborAdjacent a b → a ≠ b := by classical @@ -1307,15 +1256,6 @@ end ExteriorCycleDetails namespace ExteriorIndexCases -private theorem hmixed : - ∀ (U : ProtoTile), ∀ (V : ProtoTile), (¬(FootprintEdges U ∩ FootprintEdges V).Nonempty) → (∀ - (F : Set (Finset GaussianInt)), ∀ (e : Finset GaussianInt), ∀ (f : Finset GaussianInt), - (e ∈ F ∩ FootprintEdges U) → ((f ∈ F ∩ FootprintEdges V) → (e ≠ f))) := by - classical - intro U V hedge F e f he hf hef - apply hedge - exact ⟨e, ⟨he.2, by simpa [hef] using hf.2⟩⟩ - private theorem pairEq : ∀ (a : GaussianInt), ∀ (b : GaussianInt), ∀ (c : GaussianInt), ∀ (d : GaussianInt), a = c → b = d → ({a, b} : Finset GaussianInt) = {c, d} := by @@ -1534,12 +1474,6 @@ private theorem inExterior : · exact hu h · exact hv h -private theorem hpne : - ∀ (p : List GaussianInt), ((4 : ℕ) ≤ p.length) → (p ≠ []) := by - classical - intro p hlen h - simp [h] at hlen - private theorem huMem : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean index 206c5c97b3..6c11b8ab50 100644 --- a/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/P3963T1MixedBoundaryCycle.lean @@ -333,12 +333,6 @@ private theorem hcommon : by_contra hxy exact hn ⟨x, y, hx, hy, hxy⟩ -private theorem hp₁ne : - ∀ (p₁ : List GaussianInt), ((4 : ℕ) ≤ p₁.length) → (p₁ ≠ []) := by - classical - intro p₁ hlen₁ h - simp [h] at hlen₁ - private theorem hx₁ : ∀ (V₁ : Set GaussianInt), ∀ (V₂ : Set GaussianInt), ∀ (p₁ : List GaussianInt), (V₁ = (↑p₁.toFinset : Set GaussianInt)) → (∀ (x : GaussianInt), (x ∈ V₁ ∩ V₂) → (x ∈ p₁)) := by diff --git a/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean b/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean index ce9a16160f..a8824ece84 100644 --- a/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean +++ b/LeanPool/ApollonianSuperharmonic/P3996T1SRowAlignment.lean @@ -140,16 +140,6 @@ private theorem occF : exact BandPrototileTranslation _ _ _ (cert.outer_occurrence 2 false).1 -private theorem anchorTranslate : - (by - classical - exact - ∀ (X : ProtoTile), ∀ (d : GaussianInt), (TileTranslation X d).anchor = - GaussianTranslation d X.anchor ) := by - classical - intro X d - exact (TileTranslationFormulas X d).2.1 - private theorem centroidTranslate : (by classical @@ -174,22 +164,6 @@ private theorem translationCentroidGP : rw [centroidTranslate] ext <;> simp [GaussianRealPoint] -private theorem composeCells : - (by - classical - exact - (∀ (X : ProtoTile), ∀ (d : GaussianInt), (TileTranslation X d).cells = X.cells.image - (GaussianTranslation d)) → (∀ (X : ProtoTile), ∀ (s : GaussianInt), ∀ (d : - GaussianInt), (TileTranslation (TileTranslation X s) d).cells = (TileTranslation X (s - + d)).cells) ) := by - classical - intro cellsTranslate X s d - rw [cellsTranslate, cellsTranslate, cellsTranslate, Finset.image_image] - congr 1 - funext x - simp [GaussianTranslation] - abel - private theorem composeCellsEq : (by classical @@ -477,73 +451,6 @@ private theorem certV : ring exact hprod -private theorem rvec2 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), - let a : GaussianInt := BandVectors.1 (q 2) (q 1) - let I : GaussianInt := ⟨0, 1⟩ - (BandVectors.1 (cfg.firstPredecessor (0 : Fin (4 : ℕ))) (cfg.firstPredecessor (Fin.succ - (1 : Fin (3 : ℕ)))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) * BandVectors.1 - (cfg.firstPredecessor (Fin.succ (1 : Fin (3 : ℕ)))) (cfg.firstPredecessor (0 : Fin (4 - : ℕ)))) → (BandVectors.1 (cfg.firstPredecessor 0) (cfg.firstPredecessor 2) = I * a) ) - := by - classical - intro q cfg a I rflip1 - calc - _ = I * BandVectors.1 (cfg.firstPredecessor 2) (cfg.firstPredecessor 0) := rflip1 - _ = I * a := by rw [cfg.firstVectorTwo] - -private theorem rvec3 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), - let a : GaussianInt := BandVectors.1 (q 2) (q 1) - let I : GaussianInt := ⟨0, 1⟩ - (-I * I = 1) → ( - let w : GaussianInt := BandVectors.1 (q 3) (q 2) - (BandVectors.1 (q 1) (q 3) = -a - w) → ((BandVectors.1 (cfg.firstPredecessor (0 : Fin (4 - : ℕ))) (cfg.firstPredecessor (Fin.succ (2 : Fin (3 : ℕ)))) = (⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) * BandVectors.1 (cfg.firstPredecessor (Fin.succ (2 : Fin (3 : ℕ)))) - (cfg.firstPredecessor (0 : Fin (4 : ℕ)))) → (BandVectors.1 (cfg.firstPredecessor 3) - (cfg.firstPredecessor 0) = I * (a + w)))) ) := by - classical - intro q cfg a I hIinv w q13 rflip2 - have hflip : BandVectors.1 (q 1) (q 3) = - I * BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) := by - rw [← cfg.firstChild, ← cfg.firstParentThree] - exact rflip2 - have h : BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) = - -I * BandVectors.1 (q 1) (q 3) := by - calc - _ = (-I * I) * BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0) := by - rw [hIinv, one_mul] - _ = -I * (I * BandVectors.1 (cfg.firstPredecessor 3) (cfg.firstPredecessor 0)) := by ring - _ = -I * BandVectors.1 (q 1) (q 3) := by rw [← hflip] - rw [h, q13] - have hprod : -I * (-a - w) = I * (a + w) := by - rw [show -I * (-a - w) = I * a + I * w by ring] - ring - exact hprod - -private theorem tvec1 : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), - let I : GaussianInt := ⟨0, 1⟩ - let w : GaussianInt := BandVectors.1 (q 3) (q 2) - BandVectors.1 (cfg.secondPredecessor 0) (cfg.secondPredecessor 1) = I * w ) := by - classical - intro q cfg I w - have tf := (VectorRecursionLaws cfg.secondPredecessor cfg.secondProper.1).2.2.2.2 - cfg.secondProper 0 |>.1 - calc - _ = I * BandVectors.1 (cfg.secondPredecessor 1) (cfg.secondPredecessor 0) := tf - _ = I * w := by rw [cfg.secondVectorOne] - private theorem qnormal : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean index 6481bd596b..663f2a8c50 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1OrderedGeneralOppositeEndpoints.lean @@ -23,21 +23,6 @@ Changes: pool module paths, public exports, project namespace and current Mathli namespace ApollonianSuperharmonic -private def pairedEndpointPackage (r : Fin 4 → CircleCoordinates) (T : ProtoTile) - (i : Fin 3) (s : Fin 4) (W Z : ProtoTile) : Prop := - let uR := (⟨0, 1⟩ : GaussianInt) ^ s.val * - (if Even s.val then BandVectors.1 (r 0) (r i.succ) - else BandVectors.1 (r i.succ) (r 0)) - let uL := (⟨0, 1⟩ : GaussianInt) ^ s.val * - (if Even s.val then BandVectors.1 (r i.succ) (r 0) - else BandVectors.1 (r 0) (r i.succ)) - ∃ (rightData : ExactTileInterfaceTriple T (TileTranslation T uR) W) - (incomingData : ExactTileInterfaceTriple T (TileTranslation T uL) W) - (t5Data : ExactTileInterfaceTriple T W Z), - rightData.point = t5Data.point ∧ incomingData.point ≠ t5Data.point ∧ - incomingData.otherCA = t5Data.point ∧ rightData.otherCA = incomingData.point ∧ - t5Data.otherAB = incomingData.point - namespace OppositeEndpointGeometry private theorem haUre : @@ -148,19 +133,6 @@ private theorem hq3 : _ = (-1 : GaussianInt) * q := by rw [hq2] _ = -q := by ring -private theorem hq6 : - (by - classical - exact - let q : GaussianInt := ⟨0, 1⟩ - (q ^ 2 = -1) → (q ^ 6 = -1) ) := by - classical - intro q hq2 - calc - q ^ 6 = (q ^ 2) ^ 3 := by ring - _ = (-1 : GaussianInt) ^ 3 := by rw [hq2] - _ = -1 := by norm_num - private theorem hq2act : (by classical @@ -174,28 +146,6 @@ private theorem hq2act : _ = q ^ 2 * x := by rw [pow_two] _ = -x := by rw [hq2]; ring -private theorem hq4act : - (by - classical - exact - let q : GaussianInt := ⟨0, 1⟩ - (q ^ 4 = 1) → (∀ (x : GaussianInt), q ^ 4 * x = x) ) := by - classical - intro q hq4 x - rw [hq4] - simp - -private theorem hq6act : - (by - classical - exact - let q : GaussianInt := ⟨0, 1⟩ - (q ^ 6 = -1) → (∀ (x : GaussianInt), q ^ 6 * x = -x) ) := by - classical - intro q hq6 x - rw [hq6] - simp - private theorem hpower : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean index ac144a28a3..facf0e2b2a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4055T1PlacementNormalization.lean @@ -347,28 +347,6 @@ private theorem hnegVal : intro s₀ fin_cases s₀ <;> decide +kernel -private theorem iiCancel : - (by - classical - exact - let ii : GaussianInt := ⟨0, 1⟩ - (ii ^ 2 = -1) → (∀ (x : GaussianInt), ii * x - ii ^ 2 * x = ii * x + x) ) := by - classical - intro ii iiSq x - rw [iiSq] - ring - -private theorem iiCancelLiteral : - (by - classical - exact - ((⟨0, 1⟩ : GaussianInt) ^ 2 = -1) → (∀ (x : GaussianInt), (⟨0, 1⟩ : GaussianInt) * x - - (⟨0, 1⟩ : GaussianInt) ^ 2 * x = (⟨0, 1⟩ : GaussianInt) * x + x) ) := by - classical - intro iiSqLiteral x - rw [iiSqLiteral] - ring - private theorem iiSquareMul : (by classical @@ -394,39 +372,6 @@ private theorem iiNegSquareMul : _ = -(-x) := by rw [iiSquareMul] _ = x := by simp -private theorem iiCaseA : - (by - classical - exact - let ii : GaussianInt := ⟨0, 1⟩ - (ii ^ 2 = -1) → (∀ (x : GaussianInt), -(ii * x) + x = -(ii * x) - ii ^ 2 * x) ) := by - classical - intro ii iiSq x - rw [iiSq] - ring - -private theorem iiCaseB : - (by - classical - exact - let ii : GaussianInt := ⟨0, 1⟩ - (ii ^ 2 = -1) → (∀ (x : GaussianInt), -(ii * x) + ii ^ 2 * x = -(ii * x) - x) ) := by - classical - intro ii iiSq x - rw [iiSq] - ring - -private theorem iiCaseC : - (by - classical - exact - let ii : GaussianInt := ⟨0, 1⟩ - (ii ^ 2 = -1) → (∀ (x : GaussianInt), -x + x * ii = x * ii + x * ii ^ 2) ) := by - classical - intro ii iiSq x - rw [iiSq] - ring - private theorem iiCaseA' : (by classical @@ -475,17 +420,6 @@ private theorem iiCaseD' : rw [mul_sub, iiSquareMul] ring -private theorem iiCaseE : - (by - classical - exact - let ii : GaussianInt := ⟨0, 1⟩ - (ii ^ 2 = -1) → (∀ (x : GaussianInt), ii * x + ii ^ 2 * x = ii * x - x) ) := by - classical - intro ii iiSq x - rw [iiSq] - ring - private theorem iiZCaseA : (by classical @@ -545,20 +479,6 @@ private theorem iiCube : rw [pow_succ, iiSq] simp -private theorem iiFourth : - (by - classical - exact - let ii : GaussianInt := ⟨0, 1⟩ - (ii * ii = -1) → ((ii ^ 3 = -ii) → (ii ^ 4 = 1)) ) := by - classical - intro ii iiMul iiCube - rw [show 4 = 3 + 1 by rfl, pow_succ, iiCube] - calc - -ii * ii = -(ii * ii) := by ring - _ = -(-1) := by rw [iiMul] - _ = 1 := by norm_num - private theorem negIiSq : (by classical @@ -1305,115 +1225,6 @@ private theorem hZ' : exact (htileCov.2.1 (r ((if Even s.val then i - 1 else i + 1).succ)) Z).mp hZ -private theorem hUpos' : - (by - classical - exact - ∀ (r : Fin 4 → CircleCoordinates), ((0 : ℤ) < (r (0 : Fin (4 : ℕ))).1) → (∀ (a : Fin 3), - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - ∀ (g' : BandPackingSymmetry), - let qg := BandPackingSymmetryQuadrupleAction g' q - ((∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction g' C).1 = C.1) ∧ (∀ (C : - CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T ↔ BandPrototile - (BandPackingSymmetryCircleAction g' C) (BandPackingSymmetryTileAction g' T)) ∧ ∀ (q : - Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → - ProtoTile), ProperBandQuadruple q → BandPrototile (q (0 : Fin (4 : ℕ))) T → (∀ (i : - Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : - LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → - let sigma := fun (i : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g' = true - then -i else i; ∃ (negative : Bool) (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool) (S' - : Fin (3 : ℕ) → Bool → ProtoTile), BandPackingSymmetryScopedPhase g' q negative ∧ (∀ - (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) - = (sigma i, s ^^ negative)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : - ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × - Bool) (i, s)).2 = BandPackingSymmetryTileAction g' (S i s)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ - (s : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction g' q) - (BandPackingSymmetryTileAction g' T) i s (S' i s)) ∧ ∀ (x : LatticeCell), x ∈ - (BandPackingSymmetryTileAction g' T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S' - i s).cells) → ((qg 0 = BandPackingSymmetryCircleAction g' (r 0)) → (0 < (qg 0).1))) ) - := by - classical - intro r hUpos a q g' qg htileCov hrootLabel - rw [hrootLabel, htileCov.1] - exact hUpos - -private theorem hWpos' : - (by - classical - exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ((0 : ℤ) < (r i.succ).1) → (∀ (a : Fin 3), - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - ∀ (g' : BandPackingSymmetry), - let qg := BandPackingSymmetryQuadrupleAction g' q - let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' - then -(i - a) else i - a - ((∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction g' C).1 = C.1) ∧ (∀ (C : - CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T ↔ BandPrototile - (BandPackingSymmetryCircleAction g' C) (BandPackingSymmetryTileAction g' T)) ∧ ∀ (q : - Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → - ProtoTile), ProperBandQuadruple q → BandPrototile (q (0 : Fin (4 : ℕ))) T → (∀ (i : - Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : - LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → - let sigma := fun (i : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g' = true - then -i else i; ∃ (negative : Bool) (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool) (S' - : Fin (3 : ℕ) → Bool → ProtoTile), BandPackingSymmetryScopedPhase g' q negative ∧ (∀ - (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) - = (sigma i, s ^^ negative)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : - ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × - Bool) (i, s)).2 = BandPackingSymmetryTileAction g' (S i s)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ - (s : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction g' q) - (BandPackingSymmetryTileAction g' T) i s (S' i s)) ∧ ∀ (x : LatticeCell), x ∈ - (BandPackingSymmetryTileAction g' T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S' - i s).cells) → ((qg k.succ = BandPackingSymmetryCircleAction g' (r i.succ)) → (0 < (qg - k.succ).1))) ) := by - classical - intro r i hWpos a q g' qg k htileCov hWlabel - rw [hWlabel, htileCov.1] - exact hWpos - -private theorem hZpos' : - (by - classical - exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ((0 : ℤ) < (r (if Even - (↑s : ℕ) then i - (1 : Fin (3 : ℕ)) else i + (1 : Fin (3 : ℕ))).succ).1) → (∀ (a : - Fin 3), - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - ∀ (g' : BandPackingSymmetry), - let qg := BandPackingSymmetryQuadrupleAction g' q - let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' - then -(i - a) else i - a - ((∀ (C : CircleCoordinates), (BandPackingSymmetryCircleAction g' C).1 = C.1) ∧ (∀ (C : - CircleCoordinates), ∀ (T : ProtoTile), BandPrototile C T ↔ BandPrototile - (BandPackingSymmetryCircleAction g' C) (BandPackingSymmetryTileAction g' T)) ∧ ∀ (q : - Fin (4 : ℕ) → CircleCoordinates), ∀ (T : ProtoTile), ∀ (S : Fin (3 : ℕ) → Bool → - ProtoTile), ProperBandQuadruple q → BandPrototile (q (0 : Fin (4 : ℕ))) T → (∀ (i : - Fin (3 : ℕ)), ∀ (s : Bool), BandSubtileOccurrence q T i s (S i s)) → (∀ (x : - LatticeCell), x ∈ T.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → - let sigma := fun (i : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g' = true - then -i else i; ∃ (negative : Bool) (e : Fin (3 : ℕ) × Bool ≃ Fin (3 : ℕ) × Bool) (S' - : Fin (3 : ℕ) → Bool → ProtoTile), BandPackingSymmetryScopedPhase g' q negative ∧ (∀ - (i : Fin (3 : ℕ)), ∀ (s : Bool), (e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s) - = (sigma i, s ^^ negative)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), S' ((e : Fin (3 : - ℕ) × Bool → Fin (3 : ℕ) × Bool) (i, s)).1 ((e : Fin (3 : ℕ) × Bool → Fin (3 : ℕ) × - Bool) (i, s)).2 = BandPackingSymmetryTileAction g' (S i s)) ∧ (∀ (i : Fin (3 : ℕ)), ∀ - (s : Bool), BandSubtileOccurrence (BandPackingSymmetryQuadrupleAction g' q) - (BandPackingSymmetryTileAction g' T) i s (S' i s)) ∧ ∀ (x : LatticeCell), x ∈ - (BandPackingSymmetryTileAction g' T).cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S' - i s).cells) → ( - let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' - then -s - 1 else s - let j : Fin 3 := if Even t.val then k - 1 else k + 1 - (qg j.succ = BandPackingSymmetryCircleAction g' (r ((if Even s.val then i - 1 else i + - 1).succ))) → (0 < (qg j.succ).1))) ) := by - classical - intro r i s hZpos a q g' qg k htileCov t j hZlabel - rw [hZlabel, htileCov.1] - exact hZpos - private theorem rsub : (by classical @@ -1613,37 +1424,6 @@ private theorem hWcentNorm : rw [hWvec] at hWcent' exact hWcent' -private theorem hZvec' : - (by - classical - exact - ∀ (r : Fin 4 → CircleCoordinates), ∀ (i : Fin 3), ∀ (s : Fin 4), ∀ (a : Fin 3), - let q : Fin 4 → CircleCoordinates := - ![r 0, r a.succ, r (a + 1).succ, r (a + 2).succ] - ∀ (g' : BandPackingSymmetry), - let qg := BandPackingSymmetryQuadrupleAction g' q - let k : Fin 3 := if BandPackingSymmetryReversesOrientation g' - then -(i - a) else i - a - let ii : GaussianInt := ⟨0, 1⟩ - let t : Fin 4 := if BandPackingSymmetryReversesOrientation g' - then -s - 1 else s - let j : Fin 3 := if Even t.val then k - 1 else k + 1 - let adj : Fin 3 := if Even s.val then i - 1 else i + 1 - let xZ := BandVectors.1 (r adj.succ) (r 0) - let yZ := BandVectors.1 (r 0) (r adj.succ) - let xZ' := BandVectors.1 (qg j.succ) (qg 0) - let yZ' := BandVectors.1 (qg 0) (qg j.succ) - (BandPackingSymmetryVectorAction g' (ii ^ s.val * (if Even s.val then yZ - xZ else xZ - - yZ)) = ii ^ t.val * (if Even t.val then yZ' - xZ' else xZ' - yZ')) → - (BandPackingSymmetryVectorAction g' ((⟨0, 1⟩ : GaussianInt) ^ s.val * (if Even s.val - then BandVectors.1 (r 0) (r adj.succ) - BandVectors.1 (r adj.succ) (r 0) else - BandVectors.1 (r adj.succ) (r 0) - BandVectors.1 (r 0) (r adj.succ))) = ii ^ t.val * - (if Even t.val then BandVectors.1 (qg 0) (qg j.succ) - BandVectors.1 (qg j.succ) (qg - 0) else BandVectors.1 (qg j.succ) (qg 0) - BandVectors.1 (qg 0) (qg j.succ))) ) := by - classical - intro r i s a q g' qg k ii t j adj xZ yZ xZ' yZ' hZvec - simpa [ii, adj, xZ, yZ, xZ', yZ'] using hZvec - private theorem hZcentNorm : (by classical @@ -2078,9 +1858,15 @@ theorem P4055T1PlacementNormalization evenZero evenTwo notEvenOne notEvenThree hnegVal iiMul iiZCaseA iiZCaseB iiZCaseC iiZCaseD iiCube negIiSq negIiCube lpow hZflip hZsourceAction have hZ' := PlacementNormalizationProof.hZ' r i s Z hZ a g' htileCov hZlabel - have hUpos' := PlacementNormalizationProof.hUpos' r hUpos a g' htileCov hrootLabel - have hWpos' := PlacementNormalizationProof.hWpos' r i hWpos a g' htileCov hWlabel - have hZpos' := PlacementNormalizationProof.hZpos' r i s hZpos a g' htileCov hZlabel + have hUpos' : 0 < (qg 0).1 := by + rw [hrootLabel, htileCov.1] + exact hUpos + have hWpos' : 0 < (qg k.succ).1 := by + exact lt_of_lt_of_eq hWpos + ((congrArg Prod.fst hWlabel).trans (htileCov.1 _)).symm + have hZpos' : 0 < (qg j.succ).1 := by + exact lt_of_lt_of_eq hZpos + ((congrArg Prod.fst hZlabel).trans (htileCov.1 _)).symm have rsub (g₀ : BandPackingSymmetry) (p q₀ : Real × Real) := PlacementNormalizationProof.rsub g₀ p q₀ have rsmul (g₀ : BandPackingSymmetry) (c : Real) (p : Real × Real) := diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean index 06004f09db..b04b1cdef0 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1InteriorGeometry.lean @@ -184,41 +184,6 @@ private theorem mem3 : · ext <;> simp [ ] -private theorem bounds : - ∀ (P : FordFareyParameter), - let A := P4062T1RecursiveInteriors P - (∀ (x : GaussianInt), (x ∈ A 0) → (1 ≤ x.re ∧ x.re ≤ (P.q₁ : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (P.q₁ - : Int)-1)) → ((∀ (x : GaussianInt), (x ∈ A 1) → ((P.q₂ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : - Int)-1 ∧ (P.q₂ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1)) → ((∀ (x : GaussianInt), (x ∈ A - 2) → ((P.q₁ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ 1 ≤ x.im ∧ x.im ≤ (P.q₂ : Int)-1)) → - ((∀ (x : GaussianInt), (x ∈ A 3) → (1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 ∧ (P.q₁ : Int)+1 ≤ - x.im ∧ x.im ≤ (P.q : Int)-1)) → (∀ (i : Fin 4), ∀ (x : GaussianInt), (x ∈ A i) → ((i = 0 - → 1 ≤ x.re ∧ x.re ≤ (P.q₁ : Int)-1 ∧ - 1 ≤ x.im ∧ x.im ≤ (P.q₁ : Int)-1) ∧ - (i = 1 → (P.q₂ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ - (P.q₂ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1) ∧ - (i = 2 → (P.q₁ : Int)+1 ≤ x.re ∧ x.re ≤ (P.q : Int)-1 ∧ - 1 ≤ x.im ∧ x.im ≤ (P.q₂ : Int)-1) ∧ - (i = 3 → 1 ≤ x.re ∧ x.re ≤ (P.q₂ : Int)-1 ∧ - (P.q₁ : Int)+1 ≤ x.im ∧ x.im ≤ (P.q : Int)-1)))))) := by - classical - intro P A coord0 coord1 coord2 coord3 i x hx - constructor - · intro hi - subst i - exact coord0 x hx - constructor - · intro hi - subst i - exact coord1 x hx - constructor - · intro hi - subst i - exact coord2 x hx - · intro hi - subst i - exact coord3 x hx - private theorem adjacentCoordinates : ∀ (x : GaussianInt), ∀ (y : GaussianInt), (FourNeighborAdjacent x y) → ((x.re = y.re ∧ (y.im = x.im+1 ∨ x.im = y.im+1)) ∨ diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean b/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean index 6bab6a8269..6951ace4bb 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1LiteralReduction.lean @@ -52,21 +52,6 @@ private theorem hFcells : Int.natCast_eq_zero, Prod.exists, exists_eq_right_right, exists_eq_right, and_self] exact P.q_pos -private theorem hTcells : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (T : ProtoTile), ∀ (h : PartialOdometer), ∀ (k : - PartialOdometer), ∀ (u : GaussianInt), (T.cells = (TileTranslation (FordTile P.q) - u).cells ∧ (T.cells = ∅ → T.anchor = (TileTranslation (FordTile P.q) u).anchor) ∧ ∃ - (a : GaussianInt) (b : ℤ), (∀ (x : GaussianInt), x ∈ h.domain ↔ x - u ∈ k.domain) ∧ ∀ - x ∈ h.domain, h.value x = k.value (x - u) + a.re * x.re + a.im * x.im + b) → - (((FordTile P.q).cells.Nonempty) → (T.cells.Nonempty)) ) := by - classical - intro P T h k u htrans hFcells - rw [htrans.1] - simpa [TileTranslation] using hFcells.image (GaussianTranslation u) - private theorem hboundaryTransport : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean index 0d2a53d190..6f5c5c18bd 100644 --- a/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4062T1OverlapDescent.lean @@ -172,19 +172,6 @@ private theorem hrec2Member : 0 ≤ z.im ∧ z.im ≤ (P.q₂ : Int) exact ⟨a, b, c, d⟩ -private theorem hrec3Member : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (z : GaussianInt), (0 : ℤ) ≤ z.re → z.re ≤ (↑P.q₂ : ℤ) → - (↑P.q₁ : ℤ) ≤ z.im → z.im ≤ (↑P.q : ℤ) → z ∈ FordRecursiveVertexDomains P (3 : Fin (4 - : ℕ)) ) := by - classical - intro P z a b c d - change 0 ≤ z.re ∧ z.re ≤ (P.q₂ : Int) ∧ - (P.q₁ : Int) ≤ z.im ∧ z.im ≤ (P.q : Int) - exact ⟨a, b, c, d⟩ - private theorem hdetdiffAt260 : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean index 8d37804d7a..6b27994b86 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean @@ -64,25 +64,6 @@ private theorem hneq : private abbrev squareCoordinates := ApollonianSuperharmonic.FordInteriorSquareCoordinates.membership -private theorem natAbs_form : - (by - classical - exact - ∀ (z : ℤ), z.natAbs = if z ≤ (0 : ℤ) then (-z).toNat else z.toNat - ) := by - classical - intro z - by_cases hz : z ≤ 0 - · rw [ite_eq_left hz] - have hc : (z.natAbs : Int) = -z := Int.ofNat_natAbs_of_nonpos hz - have ht : ((-z).toNat : Int) = -z := Int.toNat_of_nonneg (by omega) - exact_mod_cast hc.trans ht.symm - · rw [ite_eq_right hz] - have hz' : 0 ≤ z := by omega - have hc : (z.natAbs : Int) = z := Int.natAbs_of_nonneg hz' - have ht : (z.toNat : Int) = z := Int.toNat_of_nonneg hz' - exact_mod_cast hc.trans ht.symm - private theorem d_on_path : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean index af0ac34d03..5656bfbb05 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1PathGeometry.lean @@ -107,15 +107,6 @@ private theorem horder : intro P r s hrs exact lt_or_gt_of_ne hrs -private theorem hsumInt : - ∀ (P : FordFareyParameter), - let r := P.q₁ - let s := P.q₂ - (P.q = P.q₁ + P.q₂) → ((P.q : Int) = (r : Int) + (s : Int)) := by - classical - intro P r s hsum - exact_mod_cast hsum - private abbrev squareCoordinates := ApollonianSuperharmonic.FordInteriorSquareCoordinates.membership private theorem mem0 : @@ -768,103 +759,6 @@ private theorem dSmall1H : simp only [sub_self, Int.natAbs_zero, add_zero] simpa using (natAbsDist x.re (s:Int) hpos (by exact_mod_cast (Nat.zero_le s))) -private theorem dLarge0Nat : - ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - let r := P.q₁ - let s := P.q₂ - (P.q = P.q₁ + P.q₂) → ((0 < s) → ((0 < r) → ((∀ (x : GaussianInt), (s < r) → (x ∈ (B 0).1 ↔ - (x.re = (r:Int) ∧ 1 ≤ x.im ∧ x.im ≤ (s:Int)) ∨ (x.im = (s:Int) ∧ (r:Int) ≤ x.re ∧ x.re ≤ - (P.q:Int)-1))) → ((∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = - Nat.dist a.toNat b.toNat))) → (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (d x = - (x.re-(r:Int)).natAbs + (x.im-(s:Int)).natAbs))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ - (B 0).1) → (d x = Nat.dist x.re.toNat r + Nat.dist x.im.toNat s)))))))) := by - classical - intro P B d r s hsum hs hr memB0Large natAbsDist dLarge0Root hlarge x hx - rw [dLarge0Root hlarge x hx] - have hxchar := (memB0Large x hlarge).mp hx - have hre := natAbsDist x.re (r:Int) (by rcases hxchar with h | h <;> omega) - (by exact_mod_cast (Nat.zero_le r)) - have him := natAbsDist x.im (s:Int) (by rcases hxchar with h | h <;> omega) - (by exact_mod_cast (Nat.zero_le s)) - simpa using congrArg₂ (· + ·) hre him - -private theorem dLarge1Nat : - ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - let r := P.q₁ - let s := P.q₂ - (0 < s) → ((0 < r) → ((∀ (x : GaussianInt), (s < r) → (x ∈ (B 1).1 ↔ (x.im = (r:Int) ∧ 1 ≤ - x.re ∧ x.re ≤ (s:Int)) ∨ (x.re = (s:Int) ∧ (r:Int) ≤ x.im ∧ x.im ≤ (P.q:Int)-1))) → ((∀ - (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) - → (((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = (x.re-(s:Int)).natAbs + - (x.im-(r:Int)).natAbs))) → ((s < r) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = - Nat.dist x.re.toNat s + Nat.dist x.im.toNat r))))))) := by - classical - intro P B d r s hs hr memB1Large natAbsDist dLarge1Root hlarge x hx - rw [dLarge1Root hlarge x hx] - have hxchar := (memB1Large x hlarge).mp hx - have hre := natAbsDist x.re (s:Int) (by rcases hxchar with h | h <;> omega) - (by exact_mod_cast (Nat.zero_le s)) - have him := natAbsDist x.im (r:Int) (by rcases hxchar with h | h <;> omega) - (by exact_mod_cast (Nat.zero_le r)) - simpa using congrArg₂ (· + ·) hre him - -private theorem dSmall0Nat : - ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - let r := P.q₁ - let s := P.q₂ - (0 < r) → ((∀ (x : GaussianInt), (r < s) → (x ∈ (B 0).1 ↔ (x.re = (r:Int) ∧ 1 ≤ x.im ∧ x.im ≤ - (r:Int)) ∨ (x.im = (r:Int) ∧ 1 ≤ x.re ∧ x.re ≤ (r:Int)))) → ((∀ (a : Int), ∀ (b : Int), - (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = Nat.dist a.toNat b.toNat))) → (((r < s) → (∀ (x - : GaussianInt), (x ∈ (B 0).1) → (d x = (x.re-(r:Int)).natAbs + - (x.im-(r:Int)).natAbs))) → - ((r < s) → (∀ (x : GaussianInt), (x ∈ (B 0).1) → (d x = Nat.dist x.re.toNat r + Nat.dist - x.im.toNat r)))))) := by - classical - intro P B d r s hr memB0Small natAbsDist dSmall0Root hsmall x hx - rw [dSmall0Root hsmall x hx] - have hxchar := (memB0Small x hsmall).mp hx - have hre := natAbsDist x.re (r:Int) (by rcases hxchar with h | h <;> omega) - (by exact_mod_cast (Nat.zero_le r)) - have him := natAbsDist x.im (r:Int) (by rcases hxchar with h | h <;> omega) - (by exact_mod_cast (Nat.zero_le r)) - simpa using congrArg₂ (· + ·) hre him - -private theorem dSmall1Nat : - ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let d : GaussianInt → Nat := fun x => - let a := if x ∈ (B 0).1 then (B 0).2 else (B 1).2 - (x.re-a.re).natAbs + (x.im-a.im).natAbs - let r := P.q₁ - let s := P.q₂ - (P.q = P.q₁ + P.q₂) → ((0 < s) → ((∀ (x : GaussianInt), (r < s) → (x ∈ (B 1).1 ↔ (x.re = - (s:Int) ∧ (s:Int) ≤ x.im ∧ x.im ≤ (P.q:Int)-1) ∨ (x.im = (s:Int) ∧ (s:Int) ≤ x.re ∧ x.re - ≤ (P.q:Int)-1))) → ((∀ (a : Int), ∀ (b : Int), (0 ≤ a) → ((0 ≤ b) → ((a-b).natAbs = - Nat.dist a.toNat b.toNat))) → (((r < s) → (∀ (x : GaussianInt), (x ∈ (B 1).1) → (d x = - (x.re-(s:Int)).natAbs + (x.im-(s:Int)).natAbs))) → ((r < s) → (∀ (x : GaussianInt), (x ∈ - (B 1).1) → (d x = Nat.dist x.re.toNat s + Nat.dist x.im.toNat s))))))) := by - classical - intro P B d r s hsum hs memB1Small natAbsDist dSmall1Root hsmall x hx - rw [dSmall1Root hsmall x hx] - have hxchar := (memB1Small x hsmall).mp hx - have hre := natAbsDist x.re (s:Int) (by rcases hxchar with h | h <;> omega) - (by exact_mod_cast (Nat.zero_le s)) - have him := natAbsDist x.im (s:Int) (by rcases hxchar with h | h <;> omega) - (by exact_mod_cast (Nat.zero_le s)) - simpa using congrArg₂ (· + ·) hre him - private theorem adjacentCoordinates : ∀ (x : GaussianInt), ∀ (y : GaussianInt), (FourNeighborAdjacent x y) → (x.re = y.re ∨ x.im = y.im) := by diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean index 1282b61dc8..6f94f0b65f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1FordGeometry.lean @@ -325,25 +325,6 @@ private theorem boundaryTranslation : · intro hz exact ⟨z - v, hz, by dsimp [GaussianTranslation]; abel⟩ -private theorem footprintTranslation : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), z ∈ FootprintVertices - (TileTranslation A v) ↔ z - v ∈ FootprintVertices A ) := by - classical - intro A v z - rw [(TileTranslationFormulas A v).2.2.2.2.2.1] - constructor - · rintro ⟨w, hw, he⟩ - have he' : w = z - v := by - rw [← he] - dsimp [GaussianTranslation] - abel - simpa [he'] using hw - · intro hz - exact ⟨z - v, hz, by dsimp [GaussianTranslation]; abel⟩ - private theorem hSc00 : (by classical @@ -446,190 +427,6 @@ private theorem hSc11 : exact False.elim ((Finset.nonempty_iff_ne_empty.mp hne) hempty) exact (ProtoTileObservableExtensionality _ _ h11 ha).2.1 -private theorem hSc00Foot : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), ((Sc (0 : Fin (3 : - ℕ)) true).cells = (FordTile P.q₁).cells) → ((0 < P.q₁) → (FootprintVertices (Sc 0 - true) = FootprintVertices (FordTile P.q₁))) ) := by - classical - intro P Sc h00 hrpos - have hne : (FordTile P.q₁).cells.Nonempty := - ⟨⟨0, 0⟩, by simp [FordTile, FordCellDomain, hrpos]⟩ - have ha : (Sc 0 true).cells = ∅ → - (Sc 0 true).anchor = (FordTile P.q₁).anchor := by - intro he - have hempty := h00.symm.trans he - exact False.elim ((Finset.nonempty_iff_ne_empty.mp hne) hempty) - exact (ProtoTileObservableExtensionality _ _ h00 ha).1 - -private theorem hSc01Foot : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), ((Sc (0 : Fin (3 : - ℕ)) false).cells = (TileTranslation (FordTile P.q₁) ⟨(↑P.q₂ : ℤ), (↑P.q₂ : - ℤ)⟩).cells) → ((0 < P.q₁) → (FootprintVertices (Sc 0 false) = FootprintVertices - (TileTranslation (FordTile P.q₁) ⟨(P.q₂ : Int), (P.q₂ : Int)⟩))) ) := by - classical - intro P Sc h01 hrpos - have hbase : (FordTile P.q₁).cells.Nonempty := - ⟨⟨0, 0⟩, by simp [FordTile, FordCellDomain, hrpos]⟩ - have hne : (TileTranslation (FordTile P.q₁) - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩).cells.Nonempty := by - by_contra hn - have he := Finset.not_nonempty_iff_eq_empty.mp hn - rw [(TileTranslationFormulas _ _).2.2.1] at he - exact (Finset.nonempty_iff_ne_empty.mp hbase) he - have ha : (Sc 0 false).cells = ∅ → - (Sc 0 false).anchor = - (TileTranslation (FordTile P.q₁) - ⟨(P.q₂ : Int), (P.q₂ : Int)⟩).anchor := by - intro he - have hempty := h01.symm.trans he - exact False.elim ((Finset.nonempty_iff_ne_empty.mp hne) hempty) - exact (ProtoTileObservableExtensionality _ _ h01 ha).1 - -private theorem hSc10Foot : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), ((Sc (1 : Fin (3 : - ℕ)) true).cells = (TileTranslation (FordTile P.q₂) ⟨(↑P.q₁ : ℤ), (0 : ℤ)⟩).cells) → - (FootprintVertices (Sc 1 true) = FootprintVertices (TileTranslation (FordTile P.q₂) - ⟨(P.q₁ : Int), 0⟩)) ) := by - classical - intro P Sc h10 - have hbase : (FordTile P.q₂).cells.Nonempty := - ⟨⟨0, 0⟩, by simp [FordTile, FordCellDomain, P.q₂_pos]⟩ - have hne : (TileTranslation (FordTile P.q₂) - ⟨(P.q₁ : Int), 0⟩).cells.Nonempty := by - by_contra hn - have he := Finset.not_nonempty_iff_eq_empty.mp hn - rw [(TileTranslationFormulas _ _).2.2.1] at he - exact (Finset.nonempty_iff_ne_empty.mp hbase) he - have ha : (Sc 1 true).cells = ∅ → - (Sc 1 true).anchor = - (TileTranslation (FordTile P.q₂) ⟨(P.q₁ : Int), 0⟩).anchor := by - intro he - have hempty := h10.symm.trans he - exact False.elim ((Finset.nonempty_iff_ne_empty.mp hne) hempty) - exact (ProtoTileObservableExtensionality _ _ h10 ha).1 - -private theorem hSc11Foot : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), ((Sc (1 : Fin (3 : - ℕ)) false).cells = (TileTranslation (FordTile P.q₂) ⟨(0 : ℤ), (↑P.q₁ : ℤ)⟩).cells) → - (FootprintVertices (Sc 1 false) = FootprintVertices (TileTranslation (FordTile P.q₂) - ⟨0, (P.q₁ : Int)⟩)) ) := by - classical - intro P Sc h11 - have hbase : (FordTile P.q₂).cells.Nonempty := - ⟨⟨0, 0⟩, by simp [FordTile, FordCellDomain, P.q₂_pos]⟩ - have hne : (TileTranslation (FordTile P.q₂) - ⟨0, (P.q₁ : Int)⟩).cells.Nonempty := by - by_contra hn - have he := Finset.not_nonempty_iff_eq_empty.mp hn - rw [(TileTranslationFormulas _ _).2.2.1] at he - exact (Finset.nonempty_iff_ne_empty.mp hbase) he - have ha : (Sc 1 false).cells = ∅ → - (Sc 1 false).anchor = - (TileTranslation (FordTile P.q₂) ⟨0, (P.q₁ : Int)⟩).anchor := by - intro he - have hempty := h11.symm.trans he - exact False.elim ((Finset.nonempty_iff_ne_empty.mp hne) hempty) - exact (ProtoTileObservableExtensionality _ _ h11 ha).1 - -private theorem foot0 : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : - GaussianInt), - let y : GaussianInt := x - u - ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices - (S i s) = FootprintVertices (TileTranslation (Sc i s) u) ∧ BoundaryFootprintVertices - (S i s) = BoundaryFootprintVertices (TileTranslation (Sc i s) u)) → ((0 < P.q₁) → ((∀ - (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), z ∈ FootprintVertices - (TileTranslation A v) ↔ z - v ∈ FootprintVertices A) → ((FootprintVertices (Sc 0 - true) = FootprintVertices (FordTile P.q₁)) → (x ∈ FootprintVertices (S 0 true) ↔ 0 ≤ - y.re ∧ y.re ≤ P.q₁ ∧ 0 ≤ y.im ∧ y.im ≤ P.q₁)))) ) := by - classical - intro P S u x y Sc hparentObs hrpos footprintTranslation hSc00Foot - rw [(hparentObs 0 true).1, footprintTranslation, hSc00Foot, - (P4062T1CanonicalSupport P.q₁ hrpos).1] - dsimp [FordVertexDomain, y] - rfl - -private theorem foot1 : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : - GaussianInt), - let y : GaussianInt := x - u - ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices - (S i s) = FootprintVertices (TileTranslation (Sc i s) u) ∧ BoundaryFootprintVertices - (S i s) = BoundaryFootprintVertices (TileTranslation (Sc i s) u)) → ((0 < P.q₁) → - (((P.q : Int) = P.q₁ + P.q₂) → ((∀ (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : - GaussianInt), z ∈ FootprintVertices (TileTranslation A v) ↔ z - v ∈ FootprintVertices - A) → ((FootprintVertices (Sc 0 false) = FootprintVertices (TileTranslation (FordTile - P.q₁) ⟨(P.q₂ : Int), (P.q₂ : Int)⟩)) → (x ∈ FootprintVertices (S 0 false) ↔ P.q₂ ≤ - y.re ∧ y.re ≤ P.q ∧ P.q₂ ≤ y.im ∧ y.im ≤ P.q))))) ) := by - classical - intro P S u x y Sc hparentObs hrpos hqsum footprintTranslation hSc01Foot - rw [(hparentObs 0 false).1, footprintTranslation, hSc01Foot, - footprintTranslation, (P4062T1CanonicalSupport P.q₁ hrpos).1] - dsimp [FordVertexDomain, y] - omega - -private theorem foot2 : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : - GaussianInt), - let y : GaussianInt := x - u - ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices - (S i s) = FootprintVertices (TileTranslation (Sc i s) u) ∧ BoundaryFootprintVertices - (S i s) = BoundaryFootprintVertices (TileTranslation (Sc i s) u)) → (((P.q : Int) = - P.q₁ + P.q₂) → ((∀ (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), z ∈ - FootprintVertices (TileTranslation A v) ↔ z - v ∈ FootprintVertices A) → - ((FootprintVertices (Sc 1 true) = FootprintVertices (TileTranslation (FordTile P.q₂) - ⟨(P.q₁ : Int), 0⟩)) → (x ∈ FootprintVertices (S 1 true) ↔ P.q₁ ≤ y.re ∧ y.re ≤ P.q ∧ - 0 ≤ y.im ∧ y.im ≤ P.q₂)))) ) := by - classical - intro P S u x y Sc hparentObs hqsum footprintTranslation hSc10Foot - rw [(hparentObs 1 true).1, footprintTranslation, hSc10Foot, - footprintTranslation, (P4062T1CanonicalSupport P.q₂ P.q₂_pos).1] - dsimp [FordVertexDomain, y] - omega - -private theorem foot3 : - (by - classical - exact - ∀ (P : FordFareyParameter), ∀ (S : Fin 3 → Bool → ProtoTile), ∀ (u : GaussianInt), ∀ (x : - GaussianInt), - let y : GaussianInt := x - u - ∀ (Sc : Fin (3 : ℕ) → Bool → ProtoTile), (∀ (i : Fin 3), ∀ (s : Bool), FootprintVertices - (S i s) = FootprintVertices (TileTranslation (Sc i s) u) ∧ BoundaryFootprintVertices - (S i s) = BoundaryFootprintVertices (TileTranslation (Sc i s) u)) → (((P.q : Int) = - P.q₁ + P.q₂) → ((∀ (A : ProtoTile), ∀ (v : GaussianInt), ∀ (z : GaussianInt), z ∈ - FootprintVertices (TileTranslation A v) ↔ z - v ∈ FootprintVertices A) → - ((FootprintVertices (Sc 1 false) = FootprintVertices (TileTranslation (FordTile P.q₂) - ⟨0, (P.q₁ : Int)⟩)) → (x ∈ FootprintVertices (S 1 false) ↔ 0 ≤ y.re ∧ y.re ≤ P.q₂ ∧ - P.q₁ ≤ y.im ∧ y.im ≤ P.q)))) ) := by - classical - intro P S u x y Sc hparentObs hqsum footprintTranslation hSc11Foot - rw [(hparentObs 1 false).1, footprintTranslation, hSc11Foot, - footprintTranslation, (P4062T1CanonicalSupport P.q₂ P.q₂_pos).1] - dsimp [FordVertexDomain, y] - omega - private theorem squareBoundary : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean index 140d1da982..571af12918 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1LargeFirstRestrictions.lean @@ -423,19 +423,6 @@ private theorem hrootCent' : simpa [z] using (ProtoTileObservableExtensionality T' (TileTranslation (FordTile P.q) z) hc' hanch).2.2.2.2 -private theorem hw' : - (by - classical - exact - ∀ (P : FordFareyParameter), - let w := BandVectors.1 (FordRecursiveQuadruple P 3) - (FordRecursiveQuadruple P 2) - (w = ⟨0, -(P.q₂ : Int)⟩) → (BandVectors.1 (FordRecursiveQuadruple P 3) - (FordRecursiveQuadruple P 2) = ⟨0, -(P.q₂ : Int)⟩) ) := by - classical - intro P w hvsol - simpa [w] using hvsol - private theorem hUoffset : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean index cc2226084d..887554b968 100644 --- a/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean +++ b/LeanPool/ApollonianSuperharmonic/P4158T1MatchedFordPair.lean @@ -134,16 +134,6 @@ private theorem hneq : · exact False.elim (hidx rfl) omega -private theorem hcurv : - (by - classical - exact - ∀ (P : FordFareyParameter), (0 < P.q) → (0 < (FordCircleCoordinate P.p P.q).1) ) := by - classical - intro P hqpos - change (0 : ℤ) < ((P.q * P.q : Nat) : ℤ) - exact_mod_cast Nat.mul_pos hqpos hqpos - private theorem hHcircle : (by classical @@ -218,94 +208,6 @@ private theorem hcentT : private abbrev hcentT' := ApollonianSuperharmonic.MatchedFordGeometry.hcentT -private theorem hfordcent : - (by - classical - exact - ∀ (P : FordFareyParameter), - 1 < P.q → 0 < P.q → TileCentroid (FordTile P.q) = ((P.q : ℝ) / 2, (P.q : ℝ) / 2) - ) := by - classical - intro P hqgt hqpos - let domain : Finset GaussianInt := - ((Finset.range P.q).product (Finset.range P.q)).image - (fun a => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) - have hneDomain : domain.Nonempty := by - refine ⟨⟨0, 0⟩, ?_⟩ - apply Finset.mem_image.mpr - exact ⟨(0, 0), by simp [hqpos], rfl⟩ - have hinj : Set.InjOn - (fun a : ℕ × ℕ => (⟨(a.1 : Int), (a.2 : Int)⟩ : GaussianInt)) - ↑((Finset.range P.q).product (Finset.range P.q)) := by - intro a ha b hb hab - apply Prod.ext - · have h := congrArg Zsqrtd.re hab - change (a.1 : Int) = (b.1 : Int) at h - exact_mod_cast h - · have h := congrArg Zsqrtd.im hab - change (a.2 : Int) = (b.2 : Int) at h - exact_mod_cast h - have hcard : domain.card = P.q * P.q := by - calc - domain.card = ((Finset.range P.q).product (Finset.range P.q)).card := by - dsimp [domain] - exact Finset.card_image_iff.mpr hinj - _ = P.q * P.q := by simp - have hsum : domain.sum (fun z : GaussianInt => z.re) = - (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 * (P.q : Int) := by - have hrange : (Finset.range P.q).sum (fun n => (n : Int)) = - (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 := by - rw [← Nat.cast_sum] - simp [Finset.sum_range_id] - simp only [Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, Finset.coe_range, - Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, implies_true, - Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, Finset.sum_const, - Finset.card_range, Int.nsmul_eq_mul, domain] - conv_lhs => rw [← Finset.mul_sum (Finset.range P.q) - (fun n => (n : Int)) (P.q : Int)] - rw [hrange] - ring - have hsumIm : domain.sum (fun z : GaussianInt => z.im) = - (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 * (P.q : Int) := by - have hrange : (Finset.range P.q).sum (fun n => (n : Int)) = - (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 := by - rw [← Nat.cast_sum] - simp [Finset.sum_range_id] - simp only [Int.reduceNeg, Finset.product_eq_sprod, Finset.coe_product, Finset.coe_range, - Zsqrtd.mk.injEq, Nat.cast_inj, Prod.forall, Prod.mk.injEq, implies_true, - Set.injOn_of_eq_iff_eq, Finset.sum_image, Finset.sum_product, Finset.sum_const, - Finset.card_range, Int.nsmul_eq_mul, domain] - rw [hrange] - ring - change (if domain.Nonempty then - ((↑(domain.sum (fun z : GaussianInt => z.re) : Int) / - ↑domain.card + (1 / 2 : Real)), - (↑(domain.sum (fun z : GaussianInt => z.im) : Int) / - ↑domain.card + (1 / 2 : Real))) else _) = _ - rw [ite_eq_left hneDomain, hcard, hsum, hsumIm] - have hqcast : ((P.q - 1 : Nat) : Int) = (P.q : Int) - 1 := by omega - rw [hqcast] - norm_num - field_simp - have arithmetic := Finset.sum_range_id_mul_two P.q - have rangeSum : (Finset.range P.q).sum (fun n => (n : Int)) = - (P.q : Int) * ((P.q - 1 : Nat) : Int) / 2 := by - rw [← Nat.cast_sum] - simp [Finset.sum_range_id] - have arithmeticCast : - ((Finset.range P.q).sum (fun n => (n : Int))) * 2 = - (P.q : Int) * ((P.q - 1 : Nat) : Int) := by - rw [← Nat.cast_sum] - exact_mod_cast arithmetic - rw [rangeSum] at arithmeticCast - rw [hqcast] at arithmeticCast - have arithmeticReal : - ((((P.q : Int) * ((P.q : Int) - 1) / 2 : Int) : ℝ) * 2) = - (P.q : ℝ) * ((P.q : ℝ) - 1) := by - exact_mod_cast arithmeticCast - norm_num [Int.subNatNat, pow_two] at ⊢ - nlinarith [arithmeticReal] - private theorem hcentdiff : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean index d1973fadd7..ecbd9b592a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean +++ b/LeanPool/ApollonianSuperharmonic/P4194T1DiamondBoundaryLedger.lean @@ -49,12 +49,6 @@ private theorem hrow : intro m z hz exact (P4194T1DiamondCellRows m z).2.mp hz -private theorem hm2 : - ∀ (m : Nat), 1 < m → 2 ≤ m := by - classical - intro m hm - omega - private theorem hdesclow : ∀ (m : Nat), (1 < m) → (∀ (z : GaussianInt), let b := z.im diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean b/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean index 1360cb7178..c3c1832616 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1OrdinaryCompatibility.lean @@ -145,32 +145,6 @@ private theorem slope : intro q h s0 hp sOff i e simpa [sOff] using hp i e -private theorem cadd : - (by - classical - exact - let cOff (z : GaussianInt) : Real × Real := - (1 / 2 : Real) • (GaussianRealPoint z - - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) - ∀ (a : GaussianInt), ∀ (b : GaussianInt), cOff (a + b) = cOff a + cOff b ) := by - classical - intro cOff a b - dsimp [cOff, GaussianRealPoint] - ext <;> simp [] <;> ring - -private theorem cneg : - (by - classical - exact - let cOff (z : GaussianInt) : Real × Real := - (1 / 2 : Real) • (GaussianRealPoint z - - (-(GaussianRealPoint z).2, (GaussianRealPoint z).1)) - ∀ (a : GaussianInt), cOff (-a) = -cOff a ) := by - classical - intro cOff a - dsimp [cOff, GaussianRealPoint] - ext <;> simp [] <;> ring - private theorem sY : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean b/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean index 83835ea255..11b804e39e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T1ReflectedGluingSlope.lean @@ -82,27 +82,6 @@ private theorem htwo_s0 : <;> linarith -private theorem hreflect : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg C - T), (∀ (i : Fin (3 : ℕ)), - let w := BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ); - let u := GaussianQuarterTurn w - w; (TileTranslation (cert.P i true) u).cells = (cert.P i - false).cells ∧ ((cert.P i true).cells = ∅ → (TileTranslation (cert.P i true) - u).anchor = (cert.P i false).anchor) ∧ FootprintVertices (TileTranslation (cert.P i - true) u) = FootprintVertices (cert.P i false) ∧ TileCentroid (TileTranslation (cert.P - i true) u) = TileCentroid (cert.P i false) ∧ TileArea (cert.P i true) = TileArea - (cert.P i false) ∧ CentrallyReflectedAt (TileCentroid T) (cert.P i true) (cert.P i - false)) → (CentrallyReflectedAt (TileCentroid T) (cert.P 0 true) (cert.P 0 false)) ) - := by - classical - intro q cfg C T cert hturn - rcases hturn 0 with ⟨_, _, _, _, _, hr⟩ - exact hr - private theorem hcenterIntegral : (by classical @@ -382,17 +361,6 @@ private theorem rootFoot : rcases hz with ⟨x, hxchild, hcorner⟩ exact ⟨x, (cert.outer_union x).2 ⟨j, s, hxchild⟩, hcorner⟩ -private theorem halfSet : - (by - classical - exact - ∀ (f : PartialOdometer), ((PartialOdometerHalfTurn f).domain : Set GaussianInt) = (fun x - : GaussianInt => -x) '' (f.domain : Set GaussianInt) ) := by - classical - intro f - ext z - simp [PartialOdometerHalfTurn] - private theorem affineHalfMem : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean index 133cf72d50..7cf91ce555 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1RightCoordinates.lean @@ -61,22 +61,6 @@ private theorem hvector : intro q q'' i'' r hrotate j rw [hrotate (i'' + 2), hrotate (i'' + 1)]; dsimp [j]; fin_cases r <;> fin_cases i'' <;> rfl -private theorem hslopeVector : - (by - classical - exact - ∀ (q q'' : Fin (4 : ℕ) → CircleCoordinates) - (i'' r : Fin (3 : ℕ)), - (∀ (j : Fin (3 : ℕ)), q'' j.succ = q (j + r).succ) → - let j := i'' + r; - BandVectors.2 (q'' (i'' + (2 : Fin (3 : ℕ))).succ) - (q'' (i'' + (1 : Fin (3 : ℕ))).succ) = - BandVectors.2 (q (j + (2 : Fin (3 : ℕ))).succ) - (q (j + (1 : Fin (3 : ℕ))).succ)) := by - classical - intro q q'' i'' r hrotate j - rw [hrotate (i'' + 2), hrotate (i'' + 1)]; dsimp [j]; fin_cases r <;> fin_cases i'' <;> rfl - private abbrev hsCent := BandParentCentroidComparison.centroidEquality diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean index b92d102213..07a55a98c9 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean @@ -206,74 +206,6 @@ private theorem hslot : intro i' s r j makeIndex a slot htable exact ⟨htable.2.1, htable.2.2⟩ -private theorem hrowCentroid : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T₀), ∀ (i' : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (r : Fin (3 : ℕ)), - let j : Fin 3 := i' + r - let incoming : Fin 3 → GaussianInt := fun k => - BandVectors.1 (q k.succ) (q 0) - let outgoing : Fin 3 → GaussianInt := fun k => - BandVectors.1 (q 0) (q k.succ) - ( - let uIndex := if j = (0 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) then - (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin - (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if - s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : - PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : - PeriodicSubtileIndex) else if j = (1 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) - then (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : - Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) - else if s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : - PeriodicSubtileIndex) else (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex) else if s = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.E, (-1 : - ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin (4 : ℕ)) then - (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (2 : Fin - (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else - (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); - let vIndex := if j = (0 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) then - (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin - (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if - s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex) else (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex) else if j = (1 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) - then (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : - Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else - if s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : - PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : - PeriodicSubtileIndex) else if s = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.A, (-1 : - ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin (4 : ℕ)) then - (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (2 : Fin - (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else - (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); - let U := SubtileOccurrenceInterpretation cert.P cert.u cert.v uIndex; - let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v vIndex; TileCentroid U - - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ^ (↑s : ℕ) * (incoming j + outgoing j)) ∧ TileCentroid V - TileCentroid T₀ = (1 / 2 : - ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : - ℕ) then incoming (j + (1 : Fin (3 : ℕ))) - outgoing (j + (1 : Fin (3 : ℕ))) else - outgoing (j - (1 : Fin (3 : ℕ))) - incoming (j - (1 : Fin (3 : ℕ))))) → ( - let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => - if k = 0 then - if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ - else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ - else if k = 1 then - if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ - else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ - else - if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ - else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ - let a : PeriodicSubtileIndex := makeIndex j s - TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) - TileCentroid T₀ = - (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : GaussianInt) ^ s.val * (incoming j + - outgoing j))) ) := by - classical - intro q cfg C₀ T₀ cert i' s r j incoming outgoing rows makeIndex a - simpa [a, j, incoming, outgoing] using rows.1 - private theorem hsuppliedCentroid : (by classical @@ -660,47 +592,6 @@ private theorem hslopePair : · simpa only [Prod.snd_sub, Prod.smul_mk, GaussianRealPoint, smul_eq_mul, one_div] using hs2 -private theorem hrowPoint : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (i' : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (r : Fin - (3 : ℕ)), - let j : Fin 3 := i' + r - let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => - if k = 0 then - if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ - else if t = 2 then ⟨.B, 0, 1⟩ else ⟨.A, -1, -1⟩ - else if k = 1 then - if t = 0 then ⟨.C, 1, 1⟩ else if t = 1 then ⟨.D, -1, 0⟩ - else if t = 2 then ⟨.D, -1, -1⟩ else ⟨.C, 1, 0⟩ - else - if t = 0 then ⟨.E, -1, 0⟩ else if t = 1 then ⟨.F, 0, -1⟩ - else if t = 2 then ⟨.F, 1, 0⟩ else ⟨.E, 0, 1⟩ - let a : PeriodicSubtileIndex := makeIndex j s - let slot : SixSubtileLabel → Fin 3 × Bool := fun l => match l with - | .A => (0, true) - | .B => (0, false) - | .C => (1, true) - | .D => (1, false) - | .E => (2, true) - | .F => (2, false) - let I : GaussianInt := ⟨0, 1⟩ - (∀ (k : Fin 3), ∀ (t : Fin 4), (1 / 2 : ℝ) • GaussianRealPoint ((-I) ^ t.val * (I * - BandVectors.2 (q 0) (q k.succ) + BandVectors.2 (q 0) (q k.succ))) = (if (slot - (makeIndex k t).label).2 then (1 : ℝ) else -1) • P4250T1SlopeOffset (BandVectors.2 - (q ((k + 2).succ)) (q ((k + 1).succ))) + GaussianRealPoint (((makeIndex k t).first : - GaussianInt) * BandVectors.2 (q 0) (q 1) + ((makeIndex k t).second : GaussianInt) * - BandVectors.2 (q 0) (q 2))) → ((1 / 2 : ℝ) • GaussianRealPoint ((-I) ^ s.val * (I * - BandVectors.2 (q 0) (q j.succ) + BandVectors.2 (q 0) (q j.succ))) = (if (slot - a.label).2 then (1 : ℝ) else -1) • P4250T1SlopeOffset (BandVectors.2 (q ((j + - 2).succ)) (q ((j + 1).succ))) + GaussianRealPoint ((a.first : GaussianInt) * - BandVectors.2 (q 0) (q 1) + (a.second : GaussianInt) * BandVectors.2 (q 0) (q 2))) ) - := by - classical - intro q i' s r j makeIndex a slot I hrowPointAux - simpa [a] using hrowPointAux j s - end SubtileCoordinateGeometry theorem P4261T1SubtileCoordinates @@ -772,7 +663,11 @@ theorem P4261T1SubtileCoordinates have hslot : (slot a.label).1 = j ∧ (slot a.label).2 = (if a.label = .A ∨ a.label = .C ∨ a.label = .E then true else false) := SubtileCoordinateGeometry.hslot i' s r htable - have hrowCentroid := SubtileCoordinateGeometry.hrowCentroid q cfg C₀ T₀ cert i' s r rows + have hrowCentroid : + TileCentroid (SubtileOccurrenceInterpretation cert.P cert.u cert.v a) - TileCentroid T₀ = + (1 / 2 : ℝ) • GaussianRealPoint + ((⟨0, 1⟩ : GaussianInt) ^ s.val * (incoming j + outgoing j)) := by + simpa [a, j, incoming, outgoing] using rows.1 have hsuppliedCentroid := SubtileCoordinateGeometry.hsuppliedCentroid q cfg C₀ T₀ cert T q' i' s hq₀ hcent r hparent hrowCentroid have hparentNonempty := SubtileCoordinateGeometry.hparentNonempty q cfg C₀ T₀ cert @@ -845,7 +740,15 @@ theorem P4261T1SubtileCoordinates have hs2 := by simpa [hparent, hq₀, cert.child_eq.symm, hflipAffine j] using hslope₂ have hslopePair := SubtileCoordinateGeometry.hslopePair q p₀ pᵢ i' s r hs1 hs2 - have hrowPoint := SubtileCoordinateGeometry.hrowPoint q i' s r hrowPointAux + have hrowPoint : + (1 / 2 : ℝ) • GaussianRealPoint + ((-I) ^ s.val * (I * BandVectors.2 (q 0) (q j.succ) + + BandVectors.2 (q 0) (q j.succ))) = + (if (slot a.label).2 then (1 : ℝ) else -1) • + P4250T1SlopeOffset (BandVectors.2 (q ((j + 2).succ)) (q ((j + 1).succ))) + + GaussianRealPoint ((a.first : GaussianInt) * BandVectors.2 (q 0) (q 1) + + (a.second : GaussianInt) * BandVectors.2 (q 0) (q 2)) := by + simpa [a] using hrowPointAux j s change pᵢ - p₀ = (if (slot a.label).2 then (1 : ℝ) else -1) • P4250T1SlopeOffset diff --git a/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean b/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean index 59d7c7ceaa..03bf02c03a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T2AncestorSymmetry.lean @@ -156,19 +156,6 @@ private theorem rneg : intro R rsmul a p simpa using rsmul a (-1) p -private theorem rminusq : - (by - classical - exact - let R : BandPackingSymmetry → (Real × Real) → (Real × Real) := - BandPackingSymmetry.rec (fun p => p) (fun p => (-p.2, p.1)) - (fun p => (-p.1, p.2)) (fun _ p => p) (fun _ _ f k p => f (k p)) - (∀ (a : BandPackingSymmetry), ∀ (p : Real × Real), R a (-p) = -R a p) → (∀ (a : - BandPackingSymmetry), ∀ (p : Real × Real), R a (p.2, -p.1) = -R a (-p.2, p.1)) ) := by - classical - intro R rneg a p - rw [show (p.2, -p.1) = -(-p.2, p.1) by simp, rneg] - private theorem rpoint : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean index 7766ab2b6f..4a6c0c838a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T1PrecursorPathLoop.lean @@ -44,19 +44,6 @@ private theorem hOA : intro C q cfg T cert hpair z hz exact (Finset.mem_inter.mp (hpair.symm ▸ hz)).1 -private theorem hOB : - (by - classical - exact - ∀ (C : BandCircle), ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : - BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : - BandOrderedGeneralLayoutCertificate q cfg C T), ((cert.P (0 : Fin (3 : ℕ)) - true).cells ∩ (cert.P (0 : Fin (3 : ℕ)) false).cells = cert.O.cells) → (cert.O.cells - ⊆ (cert.P 0 false).cells) ) := by - classical - intro C q cfg T cert hpair z hz - exact (Finset.mem_inter.mp (hpair.symm ▸ hz)).2 - private theorem footprint_mono : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean b/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean index 6c9fe6dadc..ff3900d583 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T1RemainderOuterAttachments.lean @@ -106,20 +106,6 @@ private theorem hOsubA : exact (cert.plus_union z).mpr ⟨0, false, by simpa only [← cert.precursor_eq] using hz⟩ -private theorem hOsubB : - (by - classical - exact - ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : - BandOrderedGeneralConfiguration q), ∀ (T : ProtoTile), ∀ (cert : - BandOrderedGeneralLayoutCertificate q cfg C T), cert.O.cells ⊆ (cert.P 0 false).cells - ) := by - classical - intro C q cfg T cert z hz - exact (cert.minus_union z).mpr ⟨0, true, by - rw [← cert.precursor_cells] - exact hz⟩ - private theorem hcover : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean index f6e2b946e3..7dd43709a7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2LocalSectors.lean @@ -198,21 +198,6 @@ private theorem owner_mem_iff : · intro h simpa [h] using owner_cell c -private theorem owner_eq_tile : - (by - classical - exact - ∀ (Ci : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), - let owner : GaussianInt → TilingLattice Ci := fun c => - Classical.choose (PeriodicTileIndexedMultiplicityOne P c) - (∀ (c : GaussianInt), ∀ (a : TilingLattice Ci), (c ∈ (P.tile a).cells) → (owner c = a)) → - (∀ (c : GaussianInt), ∀ (a : TilingLattice Ci), ∀ (T : ProtoTile), (P.tile a = T) → - ((c ∈ T.cells) → (owner c = a))) ) := by - classical - intro Ci P owner owner_unique c a T hPT hc - apply owner_unique - simpa [hPT] using hc - private theorem no_fourfold : (by classical @@ -285,21 +270,6 @@ private theorem owner_no_checkerboard : have hcheck := (LatticeTileGridStructure (P.tile a) (htiles_lattice a)).2.1 x simpa [LatticeVertexIncidentCell, owner_mem_iff] using hcheck -private theorem cross_ne : - (by - classical - exact - ∀ (Ci : BandCircle), ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), (Disjoint T0.cells - T0'.cells) → (∀ (P : PeriodicTileComplex ↥(TilingLattice Ci)), (∀ (a : TilingLattice - Ci), LatticeTile (P.tile a)) → (∀ (a : TilingLattice Ci), ∀ (b : TilingLattice Ci), - ((P.tile a).cells ⊆ T0.cells) → (((P.tile b).cells ⊆ T0'.cells) → (a ≠ b)))) ) := by - classical - intro Ci T0 T0' hdis P htiles_lattice a b ha hb hab - subst b - obtain ⟨c, hc⟩ := (LatticeTileGridStructure (P.tile a) - (htiles_lattice a)).1.1 - exact (Finset.disjoint_left.mp hdis) (ha hc) (hb hc) - private theorem indexed_edge_witnesses : (by classical @@ -562,38 +532,6 @@ private theorem hEdgeNe : · exact hzx hz · exact hzy hz -private theorem hjne : - (by - classical - exact - ∀ (x : GaussianInt), ∀ (pre : List GaussianInt), ∀ (y : GaussianInt), ∀ (hpre' : pre ≠ []), - let z := pre.getLast hpre' - ∀ (jL : Fin (4 : ℕ)), (({z, x} : Finset GaussianInt) = ![{x, x + (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt)}, - {x - (1 : GaussianInt), x}, {x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt), x}, {x, - x + (1 : GaussianInt)}] jL) → (∀ (jR : Fin (4 : ℕ)), (({x, y} : Finset GaussianInt) = - ![{x, x + (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt)}, {x - (1 : GaussianInt), x}, {x - (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt), x}, {x, x + (1 : GaussianInt)}] jR) → ((z ≠ x) → ((z ≠ y) → - (jL ≠ jR)))) ) := by - classical - intro x pre y hpre' z jL eL jR eR hzx hzy heq - have hedgeEq : ({z, x} : Finset GaussianInt) = {x, y} := by - calc - _ = ![{x, x + ⟨0, 1⟩}, {x - 1, x}, - {x - ⟨0, 1⟩, x}, {x, x + 1}] jL := eL - _ = ![{x, x + ⟨0, 1⟩}, {x - 1, x}, - {x - ⟨0, 1⟩, x}, {x, x + 1}] jR := by rw [heq] - _ = {x, y} := eR.symm - have hzm : z = x ∨ z = y := by - have : z ∈ ({x, y} : Finset GaussianInt) := by - rw [← hedgeEq] - exact Finset.mem_insert.mpr (Or.inl rfl) - simpa only [Finset.mem_insert, Finset.mem_singleton] using this - rcases hzm with h | h - · exact (hzx h).elim - · exact hzy h - private theorem hidxX : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean index 87ac7398f1..d07957c797 100644 --- a/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4366T2OuterGeometry.lean @@ -151,32 +151,6 @@ private theorem centroid_cells_eq : intro A B hB hc simp [TileCentroid, hB, hc] -private theorem hFminusne : - (by - classical - exact - ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (centerShift : GaussianInt), - ((TileTranslation (TileHalfTurn Rminus) centerShift).cells = Rplus.cells) → - ((Rplus.cells.Nonempty) → ((TileTranslation (TileHalfTurn Rminus) - centerShift).cells.Nonempty)) ) := by - classical - intro Rminus Rplus centerShift hmc hRpne - rw [hmc] - exact hRpne - -private theorem hFplusne : - (by - classical - exact - ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (centerShift : GaussianInt), - ((TileTranslation (TileHalfTurn Rplus) centerShift).cells = Rminus.cells) → - ((Rminus.cells.Nonempty) → ((TileTranslation (TileHalfTurn Rplus) - centerShift).cells.Nonempty)) ) := by - classical - intro Rminus Rplus centerShift hpc hRmne - rw [hpc] - exact hRmne - private theorem huCent : (by classical @@ -499,30 +473,6 @@ private theorem pathMap : ext z simp [fg] -private theorem hVrootNe : - (by - classical - exact - ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (centerShift : GaussianInt), - (T0'.cells.Nonempty) → (((TileTranslation (TileHalfTurn T0) centerShift).cells = - T0'.cells) → ((TileTranslation (TileHalfTurn T0) centerShift).cells.Nonempty)) ) := by - classical - intro T0 T0' centerShift hT0'ne hFrootCells - rw [hFrootCells] - exact hT0'ne - -private theorem hVroot'Ne : - (by - classical - exact - ∀ (T0 : ProtoTile), ∀ (T0' : ProtoTile), ∀ (centerShift : GaussianInt), - (T0.cells.Nonempty) → (((TileTranslation (TileHalfTurn T0') centerShift).cells = - T0.cells) → ((TileTranslation (TileHalfTurn T0') centerShift).cells.Nonempty)) ) := by - classical - intro T0 T0' centerShift hT0ne hFroot'Cells - rw [hFroot'Cells] - exact hT0ne - private theorem hVrootEq : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean b/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean index d017f177b7..e1cca32de5 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2CrosscutIndex.lean @@ -384,84 +384,6 @@ private theorem hoccAt353 : · exact Or.inr (by simp [edges, hx', hy']) · exact Or.inl (by simp [edges, hx', hy']) -private theorem hcdAdj : - (by - classical - exact - ∀ (c : LatticeCell), - ∀ (d : LatticeCell), - c ≠ d → - ∀ (f : Finset GaussianInt), - f ∈ FootprintEdges (⟨{ c }, c⟩ : ProtoTile) → - f ∈ FootprintEdges (⟨{ d }, d⟩ : ProtoTile) → FourNeighborAdjacent c d - ) := by - classical - intro c d hcd f hfc hfd - have pairMatch (u v w z : GaussianInt) - (heq : ({u, v} : Finset GaussianInt) = {w, z}) (huv : u ≠ v) : - (u = w ∧ v = z) ∨ (u = z ∧ v = w) := by - have huwz : u = w ∨ u = z := by - have hm : u ∈ ({w, z} : Finset GaussianInt) := by rw [← heq]; simp - simpa using hm - have hvwz : v = w ∨ v = z := by - have hm : v ∈ ({w, z} : Finset GaussianInt) := by rw [← heq]; simp - simpa using hm - rcases huwz with huw | huz - · rcases hvwz with hvw | hvz - · exact False.elim (huv (huw.trans hvw.symm)) - · exact Or.inl ⟨huw, hvz⟩ - · rcases hvwz with hvw | hvz - · exact Or.inr ⟨huz, hvw⟩ - · exact False.elim (huv (huz.trans hvz.symm)) - change (∃ z ∈ ({c} : Finset GaussianInt), - f = {z, z + 1} ∨ f = {z, z + ⟨0, 1⟩} ∨ - f = {z + 1, z + 1 + ⟨0, 1⟩} ∨ - f = {z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩}) at hfc - change (∃ z ∈ ({d} : Finset GaussianInt), - f = {z, z + 1} ∨ f = {z, z + ⟨0, 1⟩} ∨ - f = {z + 1, z + 1 + ⟨0, 1⟩} ∨ - f = {z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩}) at hfd - simp only [Finset.mem_singleton] at hfc hfd - rcases hfc with ⟨z, hz, hfc⟩ - have hzc : z = c := by simpa using hz - rw [hzc] at hfc - rcases hfd with ⟨w, hw, hfd⟩ - have hwd : w = d := by simpa using hw - rw [hwd] at hfd - let edgePair (q : GaussianInt) (i : Fin 4) : GaussianInt × GaussianInt := - if i.val = 0 then (q, q + 1) else if i.val = 1 then (q, q + ⟨0, 1⟩) - else if i.val = 2 then (q + 1, q + 1 + ⟨0, 1⟩) - else (q + ⟨0, 1⟩, q + 1 + ⟨0, 1⟩) - have hcEdge : ∃ i : Fin 4, - f = {(edgePair c i).1, (edgePair c i).2} := by - rcases hfc with hfc | hfc | hfc | hfc - · exact ⟨⟨0, by omega⟩, by simpa [edgePair] using hfc⟩ - · exact ⟨⟨1, by omega⟩, by simpa [edgePair] using hfc⟩ - · exact ⟨⟨2, by omega⟩, by simpa [edgePair] using hfc⟩ - · exact ⟨⟨3, by omega⟩, by simpa [edgePair] using hfc⟩ - have hdEdge : ∃ i : Fin 4, - f = {(edgePair d i).1, (edgePair d i).2} := by - rcases hfd with hfd | hfd | hfd | hfd - · exact ⟨⟨0, by omega⟩, by simpa [edgePair] using hfd⟩ - · exact ⟨⟨1, by omega⟩, by simpa [edgePair] using hfd⟩ - · exact ⟨⟨2, by omega⟩, by simpa [edgePair] using hfd⟩ - · exact ⟨⟨3, by omega⟩, by simpa [edgePair] using hfd⟩ - obtain ⟨i, hi⟩ := hcEdge - obtain ⟨j, hj⟩ := hdEdge - have hne : (edgePair c i).1 ≠ (edgePair c i).2 := by - fin_cases i <;> simp [edgePair, Zsqrtd.ext_iff] - have hm := pairMatch (edgePair c i).1 (edgePair c i).2 - (edgePair d j).1 (edgePair d j).2 (hi.symm.trans hj) hne - have hcd' : c.re ≠ d.re ∨ c.im ≠ d.im := by - by_contra hnot - push Not at hnot - apply hcd - ext <;> omega - fin_cases i <;> fin_cases j - all_goals - simp [edgePair, FourNeighborAdjacent, Zsqrtd.ext_iff] at hm ⊢ - omega - private theorem internalNotBoundary : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2PackingNoChord.lean b/LeanPool/ApollonianSuperharmonic/P4456T2PackingNoChord.lean index fd2cb2561a..1c128ec838 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2PackingNoChord.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2PackingNoChord.lean @@ -36,14 +36,6 @@ private noncomputable abbrev NoChord (T : ProtoTile) : Prop := by x ∈ BoundaryFootprintVertices T → y ∈ BoundaryFootprintVertices T → ¬ OpenLatticeEdge x y ⊆ interior (TileRealization T) -private noncomputable abbrev q : Real × Real → Real × Real := by - classical - exact fun p => (-p.2, p.1) - -private noncomputable abbrev r : Real × Real → Real × Real := by - classical - exact fun p => (p.1, -p.2) - private noncomputable abbrev qh : (Real × Real) ≃ₜ (Real × Real) := by classical let q : Real × Real → Real × Real := fun p => (-p.2, p.1) diff --git a/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean b/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean index db1b1940c8..4c503af801 100644 --- a/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/P4456T2SquareEdges.lean @@ -116,29 +116,6 @@ private theorem hvertex_coords : rw [hcw] apply Zsqrtd.ext <;> simp <;> ring -private theorem hvertex_box : - (by - classical - exact - ∀ (n : Nat), ∀ (w : GaussianInt), ∀ (T : ProtoTile), (∀ (c : GaussianInt), c ∈ T.cells ↔ ∃ a - b : Nat, a < n ∧ b < n ∧ c = w + (⟨(a : Int), (b : Int)⟩ : GaussianInt)) → - ((T.cells.Nonempty) → (∀ v ∈ FootprintVertices T, w.re ≤ v.re ∧ v.re ≤ w.re + (↑n : ℤ) ∧ - w.im ≤ v.im ∧ v.im ≤ w.im + (↑n : ℤ))) ) := by - classical - intro n w T hcell hnonempty v hv - unfold FootprintVertices at hv - rw [ite_eq_left hnonempty] at hv - rcases hv with ⟨c, hc, hcorner⟩ - rcases hcell c |>.mp hc with ⟨a,b,ha,hb,hcw⟩ - rcases hcorner with h | h | h | h - all_goals - subst v - rw [hcw] at * - simp only [Zsqrtd.re_add, Zsqrtd.im_add, - ] - norm_num - omega - private theorem hstarCoords : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean index 941e689bfd..153f46d1e7 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean @@ -1014,28 +1014,6 @@ private theorem hMnonempty : apply positiveCells C.1.1 Rminus C.2 exact TileOdometerBandPrototile C.1.1 Rminus hminus F.minus_odo -private theorem hJnonempty : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - ∀ (u : ↥(TilingLattice C)), - let join : ProtoTile := TileTranslation base (u + y) - ((D.tiles F.slot false).cells = join.cells ∧ ((D.tiles F.slot false).cells = ∅ → (D.tiles - F.slot false).anchor = join.anchor)) → (((D.tiles F.slot false).cells.Nonempty) → - (join.cells.Nonempty)) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D r y u join hjoinCells hUnonempty - rw [← hjoinCells.1] - exact hUnonempty - private theorem hleftNe : (by classical @@ -1353,60 +1331,6 @@ private theorem hflipVIm : norm_num [I, Zsqrtd.re_mul, Zsqrtd.im_mul] at h ⊢ omega -private theorem hrecVC : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let I : GaussianInt := ⟨0, 1⟩ - let x : GaussianInt := BandVectors.1 (r 1) (r 3) - let y : GaussianInt := BandVectors.1 (r 2) (r 1) - (BandVectors.1 (r 1) (r 0) = x - I * y) → (GaussianInt.toComplex (BandVectors.1 (r 1) (r - 0)) = GaussianInt.toComplex x - GaussianInt.toComplex I * GaussianInt.toComplex y) ) - := by - classical - intro C orientation base Rminus Rplus hminus hplus F r I x y hvrec - have h := congrArg GaussianInt.toComplex hvrec - simpa only [GaussianInt.toComplex_sub, GaussianInt.toComplex_mul] using h - -private theorem hflipVC : - (by - classical - exact - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ - (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q F.slot.succ, F.q ((F.slot + 1).succ), - F.q ((F.slot + 2).succ)] - let I : GaussianInt := ⟨0, 1⟩ - (BandVectors.1 (r 0) (r 1) = I * BandVectors.1 (r 1) (r 0)) → (GaussianInt.toComplex - (BandVectors.1 (r 0) (r 1)) = GaussianInt.toComplex I * GaussianInt.toComplex - (BandVectors.1 (r 1) (r 0))) ) := by - classical - intro C orientation base Rminus Rplus hminus hplus F r I hvflip - have h := congrArg GaussianInt.toComplex hvflip - simpa only [GaussianInt.toComplex_mul] using h - -private theorem hRotVC : - (by - classical - exact - ∀ (p : Fin (4 : ℕ) → CircleCoordinates), - let I : GaussianInt := ⟨0, 1⟩ - (BandVectors.1 (p 0) (p 3) = I * BandVectors.1 (p 3) (p 0)) → (GaussianInt.toComplex - (BandVectors.1 (p 0) (p 3)) = GaussianInt.toComplex I * GaussianInt.toComplex - (BandVectors.1 (p 3) (p 0))) ) := by - classical - intro p I hRotV - have h := congrArg GaussianInt.toComplex hRotV - simpa only [GaussianInt.toComplex_mul] using h - private theorem hleftAminus : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean index 52ad57df3f..d3152a1990 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean @@ -448,25 +448,6 @@ end AFrameBProof namespace AFrameBDetails -private theorem hcoord : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 - : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + - (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : - ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 - : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : - Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - r 0 = (2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p - 3).2 - (p 1).2)) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p hstep r - have := congrFun hstep 0 - simpa [r] using this - private theorem hA : ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : @@ -503,24 +484,6 @@ private theorem hB : have := congrFun hstep 2 simpa [r] using this -private theorem hE : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), (![F.q (0 : Fin (4 : ℕ)), F.q a.succ, F.q (a + (1 : Fin (3 - : ℕ))).succ, F.q (a + (2 : Fin (3 : ℕ))).succ] = ![((2 : ℤ) * (p (0 : Fin (4 : ℕ))).1 + - (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : ℕ))).1 - (p (1 : Fin (4 : - ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (2 : Fin (4 - : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p (1 : Fin (4 : ℕ))).2), p (0 : - Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - r 3 = p 3) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p hstep r - have := congrFun hstep 3 - simpa [r] using this - private theorem hparent : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean index aa66fe7ba6..f83b80114b 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean @@ -177,13 +177,6 @@ private theorem positiveA : intro p hp exact (ProperBandCurvatureStructure p hp).1 -private theorem positiveE : - ∀ (C : BandCircle), ∀ (p : Fin 4 → CircleCoordinates), (C.1.1 = p 3) → (0 < (p 3).1) := by - classical - intro C p hC - rw [← hC] - exact C.2 - private theorem laws : ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean index 257d2ffd02..c2f123b04d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RestoredBoundaryGeometry.lean @@ -177,27 +177,6 @@ private theorem noThird : _ = Fintype.card Sub := by simp omega -private theorem hnotO : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), ∀ (x : GaussianInt), (GaussianRealPoint x ≠ TileCentroid T) → ( - let O := cert.O - (TileCentroid O = TileCentroid T) → (x ∉ FootprintVertices O ∨ O.cells.Nonempty)) ) := by - classical - intro q cfg C T cert x hnoncentral O hOcent - by_cases hO : O.cells.Nonempty - · exact Or.inr hO - · left - intro hxO - have ha : x = O.anchor := by simpa [FootprintVertices, hO] using hxO - have hcen : GaussianRealPoint O.anchor = TileCentroid T := by - rw [← hOcent] - simp [GaussianRealPoint, TileCentroid, Finset.not_nonempty_iff_eq_empty.mp hO] - exact hnoncentral (by simpa [ha] using hcen) - private theorem hmodifiedCommon : (by classical @@ -580,35 +559,6 @@ private theorem hOcuts : rw [he] at hOne simp at hOne -private theorem hsupport : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), ∀ (x : GaussianInt), - let A := cert.P 0 true - let B := cert.P 0 false - let O := cert.O - let Q := cert.Q 1 true - let S := cert.S 2 false - let R := cert.Q 2 true - let V := cert.S 1 false - (FootprintVertices (cert.P (0 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.P (1 : Fin - (3 : ℕ)) true) ⊆ FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∩ - FootprintVertices (cert.P (1 : Fin (3 : ℕ)) true) ∧ FootprintVertices (cert.P (0 : - Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.P (0 : Fin (3 : ℕ)) false) ⊆ - FootprintVertices (cert.Q (1 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.S (2 : - Fin (3 : ℕ)) false) ∪ FootprintVertices (cert.Q (0 : Fin (3 : ℕ)) false) ∪ - FootprintVertices (cert.Q (2 : Fin (3 : ℕ)) true) ∩ FootprintVertices (cert.S (1 : - Fin (3 : ℕ)) false)) → ((x ∈ FootprintVertices A) → ((x ∈ FootprintVertices B) → (x ∈ - (FootprintVertices Q ∩ FootprintVertices S) ∪ FootprintVertices O ∪ - (FootprintVertices R ∩ FootprintVertices V)))) ) := by - classical - intro q cfg C T cert x A B O Q S R V hrawAB hxA' hxB' - have hs := hrawAB.2 ⟨hxA', hxB'⟩ - simpa [Q, S, O, R, V, ← cert.precursor_eq] using hs - private theorem hVnonzero : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean index c59a4dbf7b..a50114f02a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1RightInteriorGeometry.lean @@ -592,57 +592,6 @@ private theorem hf13 : have hh := congrArg cert.modifiedFaceEquivalence h simp [f1, f3] at hh -private theorem hend : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), - let a : PeriodicSubtileIndex := ⟨.A, 0, 0⟩ - let c : PeriodicSubtileIndex := ⟨.C, 0, 0⟩ - ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), - (SimpleGridPathBetween (CommonFootprintEdgeVertices (cert.modified.tile a) - (cert.modified.tile c)) (FootprintEdges (cert.modified.tile a) ∩ FootprintEdges - (cert.modified.tile c)) (cert.modified.rho f) (cert.modified.rho g)) → - (cert.modified.rho f ≠ cert.modified.rho g) ) := by - classical - intro q cfg C T cert a c f g hpath heq - rcases hpath with ⟨p, hnd, hlen, hh, ht, _, _, _⟩ - have hpne : p ≠ [] := by - intro hp - simp [hp] at hlen - have hh' : p.head hpne = cert.modified.rho f := by - simpa [List.head?_eq_some_head hpne] using hh - have ht' : p.getLast hpne = cert.modified.rho g := by - simpa [List.getLast?_eq_some_getLast hpne] using ht - obtain ⟨z, hz⟩ := (List.Nodup.head_eq_getLast_iff hpne hnd).mp - (hh'.trans (heq.trans ht'.symm)) - simp [hz] at hlen - -private theorem hz13 : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ - (C : BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q - cfg C T), - let f1 := cert.modifiedFaceEquivalence.symm ⟨.I1, 0, 0⟩ - let f3 := cert.modifiedFaceEquivalence.symm ⟨.I3, 0, 0⟩ - ∀ (f : cert.modified.plane.Face), ∀ (g : cert.modified.plane.Face), ((f1 = f ∧ f3 = g) ∨ - (f1 = g ∧ f3 = f)) → ((cert.modified.rho f1 = cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩)) → ((cert.modified.rho f3 = - cert.unmodified.core.rho (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩)) → - ((cert.modified.rho f ≠ cert.modified.rho g) → (cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm ⟨.I1, 0, 0⟩) ≠ cert.unmodified.core.rho - (cert.unmodified.faceEquiv.symm ⟨.I3, 0, 0⟩))))) ) := by - classical - intro q cfg C T cert f1 f3 f g hpair hrho1 hrho3 hend - rw [← hrho1, ← hrho3] - rcases hpair with ⟨h1, h3⟩ | ⟨h1, h3⟩ - · simpa [h1, h3] using hend - · simpa [h1, h3] using hend.symm - private theorem hcomplete : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean b/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean index c98fde6054..260f520101 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1ContactStarCoverage.lean @@ -101,21 +101,6 @@ private theorem hdisjPlusO : private abbrev hdisjMinusO := ApollonianSuperharmonic.ContactStarCases.hdisjPlusO -private theorem hpathPlusO : - (by - classical - exact - ∀ (Dplus : ProtoTile), ∀ (O : ProtoTile), (Finset.Nonempty O.cells) → ((TileTouching - Dplus O) → ((Dplus.cells.Nonempty) → (SimpleGridPath (BoundaryFootprintVertices Dplus - ∩ BoundaryFootprintVertices O) (BoundaryFootprintEdges Dplus ∩ BoundaryFootprintEdges - O)))) ) := by - classical - intro Dplus O hO htplus hDplus - rcases htplus with ⟨_, _, _, hp⟩ | ⟨hE, _⟩ | ⟨hE, _⟩ - · exact hp - · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hDplus).elim - · exact (Finset.not_nonempty_iff_eq_empty.mpr hE hO).elim - private abbrev boundaryEdgeFootprint := BoundaryFootprintInclusion.boundaryEdge @@ -656,20 +641,6 @@ private theorem cornerRescue : · exact Or.inr (noCheckerboardDiagonal Dminus hcheckMinus y j hs1m hs3m (fun h => (Finset.disjoint_left.mp hdisjMinusO h hcenter).elim)) -private theorem singletonCorner : - (by - classical - exact - ∀ (y : GaussianInt), ∀ (j : Fin (4 : ℕ)), y ∈ FootprintVertices - (⟨{LatticeVertexIncidentCell y j}, LatticeVertexIncidentCell y j⟩ : ProtoTile) ) := by - classical - intro y j - simp only [FootprintVertices, Finset.singleton_nonempty, ite_true, - Set.mem_ofPred_eq] - refine ⟨LatticeVertexIncidentCell y j, Finset.mem_singleton_self _, ?_⟩ - fin_cases j <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, - add_comm, add_left_comm, add_assoc] - private theorem ha : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean index 85a94f89ac..805cbde022 100644 --- a/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean +++ b/LeanPool/ApollonianSuperharmonic/P4638T1EmptyFordLocalization.lean @@ -475,24 +475,6 @@ private theorem hDcanonical : intro r P g htargetvec RP VP k hvecpow D hDrot rw [hDrot, ← hvecpow, htargetvec] -private theorem hOempty : - (by - classical - exact - ∀ (O : ProtoTile), (O.cells = ∅) → (∀ (g : BandPackingSymmetry), - let cellTurn : GaussianInt → GaussianInt := fun z => GaussianQuarterTurn z - 1 - ∀ (cellTurn_bij : Function.Bijective cellTurn), - let E1 : GaussianInt ≃ GaussianInt := Equiv.ofBijective cellTurn cellTurn_bij - let E2 : GaussianInt ≃ GaussianInt := E1.trans E1 - let E3 : GaussianInt ≃ GaussianInt := E2.trans E1 - let E : Fin 4 → GaussianInt ≃ GaussianInt := ![Equiv.refl _, E1, E2, E3] - ∀ (k : Fin (4 : ℕ)), (∀ T, (BandPackingSymmetryTileAction g T).cells = T.cells.image (E - k)) → ((BandPackingSymmetryTileAction g O).cells = ∅)) ) := by - classical - intro O hempty g cellTurn cellTurn_bij E1 E2 E3 E k hcellpow - rw [hcellpow, hempty] - simp - private theorem hw₀ : (by classical @@ -510,29 +492,6 @@ private theorem hw₀ : dsimp [w₀] exact hanchorpow O -private theorem hOcent : - (by - classical - exact - ∀ (O : ProtoTile), - let VP (k : Fin 4) (z : GaussianInt) : GaussianInt := - if k = 0 then z else if k = 1 then GaussianQuarterTurn z else - if k = 2 then GaussianQuarterTurn (GaussianQuarterTurn z) else - GaussianQuarterTurn (GaussianQuarterTurn (GaussianQuarterTurn z)) - ∀ (k : Fin (4 : ℕ)), ∀ (g : BandPackingSymmetry), - let w₀ := (BandPackingSymmetryTileAction g O).anchor - (w₀ = VP k O.anchor) → ( - let RP (k : Fin 4) (x : Real × Real) : Real × Real := - if k = 0 then x else if k = 1 then (-x.2, x.1) else - if k = 2 then (-x.1, -x.2) else (x.2, -x.1) - (∀ T, TileCentroid (BandPackingSymmetryTileAction g T) = RP k (TileCentroid T)) → ((∀ (z - : GaussianInt), RP k (GaussianRealPoint z) = GaussianRealPoint (VP k z)) → - ((TileCentroid O = GaussianRealPoint O.anchor) → (TileCentroid - (BandPackingSymmetryTileAction g O) = GaussianRealPoint w₀)))) ) := by - classical - intro O VP k g w₀ hw₀ RP hcentpow hpointrot hObase - rw [hcentpow, hObase, hpointrot O.anchor, ← hw₀] - private theorem hAcent' : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean index 3c10c05cbe..426318303d 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2PrecursorWalk.lean @@ -33,38 +33,6 @@ private abbrev edge_vertex := BoundaryFootprintInclusion.edgeVertex private abbrev boundary_vertex_footprint := BoundaryFootprintInclusion.boundaryVertex -private theorem R_symm : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (B : ProtoTile), - let R : GaussianInt → GaussianInt → Prop := fun u v => - u ∈ FootprintVertices A ∩ FootprintVertices B ∧ - v ∈ FootprintVertices A ∩ FootprintVertices B ∧ - {u, v} ∈ FootprintEdges A ∩ FootprintEdges B - ∀ (u : GaussianInt), ∀ (v : GaussianInt), R u v → R v u ) := by - classical - intro A B R u v huv - refine ⟨huv.2.1, huv.1, ?_⟩ - simpa [Finset.pair_comm] using huv.2.2 - -private theorem reverse_reach : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (B : ProtoTile), - let R : GaussianInt → GaussianInt → Prop := fun u v => - u ∈ FootprintVertices A ∩ FootprintVertices B ∧ - v ∈ FootprintVertices A ∩ FootprintVertices B ∧ - {u, v} ∈ FootprintEdges A ∩ FootprintEdges B - (∀ (u : GaussianInt), ∀ (v : GaussianInt), (R u v) → (R v u)) → (∀ {u : GaussianInt}, ∀ - {v : GaussianInt}, Relation.ReflTransGen R u v → Relation.ReflTransGen R v u) ) := by - classical - intro A B R R_symm u v h - induction h with - | refl => exact .refl - | @tail b c hab hbc ih => exact ih.head (R_symm b c hbc) - private theorem head_reach : (by classical @@ -167,20 +135,6 @@ private theorem p₁chain : private abbrev p₃chain := ApollonianSuperharmonic.PrecursorWalkGeometry.p₁chain -private theorem p₁mem : - (by - classical - exact - ∀ (A : ProtoTile), ∀ (B : ProtoTile), ∀ (X : ProtoTile), ∀ (Y : ProtoTile), - (FootprintVertices X ⊆ FootprintVertices A) → ((FootprintVertices Y ⊆ - FootprintVertices B) → (∀ (p₁ : List GaussianInt), (∀ z ∈ p₁, z ∈ FootprintVertices X - ∩ FootprintVertices Y) → (∀ z ∈ p₁, z ∈ FootprintVertices A ∩ FootprintVertices B))) - ) := by - classical - intro A B X Y hXf hYf p₁ hp₁v z hz - have hzv := hp₁v z hz - exact ⟨hXf hzv.1, hYf hzv.2⟩ - private theorem qmem : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean b/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean index 08bb64f0dc..fa72427e9c 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2ThreeConnected.lean @@ -109,91 +109,6 @@ private theorem chain : refine ⟨(AllowedSubtileIncidence.CDm10 m n).symm, ?_⟩ exact .singleton _ -private theorem adjacent : - (by - classical - exact - let linkList : PeriodicSubtileIndex → List PeriodicSubtileIndex := fun z => - match z with - | ⟨.A,m,n⟩ => - [⟨.B,m,n⟩, ⟨.D,m,n⟩, ⟨.B,m+1,n+1⟩, ⟨.C,m+1,n+1⟩, - ⟨.E,m,n+1⟩, ⟨.B,m,n+1⟩, ⟨.F,m,n⟩, ⟨.C,m,n⟩] - | ⟨.B,m,n⟩ => - [⟨.A,m-1,n-1⟩, ⟨.D,m-1,n-1⟩, ⟨.F,m,n-1⟩, ⟨.A,m,n-1⟩, - ⟨.E,m,n⟩, ⟨.D,m,n⟩, ⟨.A,m,n⟩, ⟨.C,m,n⟩] - | ⟨.C,m,n⟩ => - [⟨.A,m-1,n-1⟩, ⟨.B,m,n⟩, ⟨.A,m,n⟩, ⟨.F,m,n⟩, - ⟨.D,m-1,n⟩, ⟨.E,m-1,n⟩] - | ⟨.D,m,n⟩ => - [⟨.A,m,n⟩, ⟨.B,m,n⟩, ⟨.E,m,n⟩, ⟨.C,m+1,n⟩, - ⟨.F,m+1,n⟩, ⟨.B,m+1,n+1⟩] - | ⟨.E,m,n⟩ => - [⟨.A,m,n-1⟩, ⟨.C,m+1,n⟩, ⟨.D,m,n⟩, ⟨.B,m,n⟩] - | ⟨.F,m,n⟩ => - [⟨.A,m,n⟩, ⟨.B,m,n+1⟩, ⟨.D,m-1,n⟩, ⟨.C,m,n⟩] - ∀ (z : PeriodicSubtileIndex), ∀ (u : PeriodicSubtileIndex), u ∈ linkList z → - AllowedSubtileIncidence z u ) := by - classical - intro linkList z - cases z with - | mk l m n => - cases l - · intro u hu - simp only [List.mem_cons, List.not_mem_nil, or_false, linkList] at hu - rcases hu with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl - · exact .AB m n - · exact .AD m n - · exact .AB11 m n - · exact .AC11 m n - · exact .AE01 m n - · exact .AB01 m n - · exact .AF m n - · exact .AC m n - · intro u hu - simp only [List.mem_cons, List.not_mem_nil, or_false, linkList] at hu - rcases hu with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl - · simpa [sub_add_cancel] using (AllowedSubtileIncidence.AB11 (m-1) (n-1)).symm - · exact AllowedSubtileIncidence.BDm1m1 m n - · exact .BF0m1 m n - · simpa [sub_add_cancel] using (AllowedSubtileIncidence.AB01 m (n-1)).symm - · exact .BE m n - · exact .BD m n - · exact (AllowedSubtileIncidence.AB m n).symm - · exact .BC m n - · intro u hu - simp only [List.mem_cons, List.not_mem_nil, or_false, linkList] at hu - rcases hu with rfl | rfl | rfl | rfl | rfl | rfl - · simpa [sub_add_cancel] using (AllowedSubtileIncidence.AC11 (m-1) (n-1)).symm - · exact (AllowedSubtileIncidence.BC m n).symm - · exact (AllowedSubtileIncidence.AC m n).symm - · exact AllowedSubtileIncidence.CF m n - · exact AllowedSubtileIncidence.CDm10 m n - · exact AllowedSubtileIncidence.CEm10 m n - · intro u hu - simp only [List.mem_cons, List.not_mem_nil, or_false, linkList] at hu - rcases hu with rfl | rfl | rfl | rfl | rfl | rfl - · exact (AllowedSubtileIncidence.AD m n).symm - · exact (AllowedSubtileIncidence.BD m n).symm - · exact AllowedSubtileIncidence.DE m n - · simpa [add_sub_cancel_right] using (AllowedSubtileIncidence.CDm10 (m+1) n).symm - · exact AllowedSubtileIncidence.DF10 m n - · simpa [add_sub_cancel_right] using - (AllowedSubtileIncidence.BDm1m1 (m+1) (n+1)).symm - · intro u hu - simp only [List.mem_cons, List.not_mem_nil, or_false, linkList] at hu - rcases hu with rfl | rfl | rfl | rfl - · simpa [sub_add_cancel] using (AllowedSubtileIncidence.AE01 m (n-1)).symm - · simpa [add_sub_cancel_right] using (AllowedSubtileIncidence.CEm10 (m+1) n).symm - · exact (AllowedSubtileIncidence.DE m n).symm - · exact (AllowedSubtileIncidence.BE m n).symm - · intro u hu - simp only [List.mem_cons, List.not_mem_nil, or_false, linkList] at hu - rcases hu with rfl | rfl | rfl | rfl - · exact (AllowedSubtileIncidence.AF m n).symm - · simpa [add_sub_cancel_right] using (AllowedSubtileIncidence.BF0m1 m (n+1)).symm - · simpa [sub_add_cancel] using (AllowedSubtileIncidence.DF10 (m-1) n).symm - · exact (AllowedSubtileIncidence.CF m n).symm - private theorem edge_mem_link : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean b/LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean index 00531f5db8..67f8856bdd 100644 --- a/LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean +++ b/LeanPool/ApollonianSuperharmonic/P4828T1CircularPlacement.lean @@ -166,10 +166,6 @@ private noncomputable abbrev crossC : Complex → Complex → Real := by classical exact fun z w => z.re * w.im - z.im * w.re -private noncomputable abbrev dotC : Complex → Complex → Real := by - classical - exact fun z w => z.re * w.re + z.im * w.im - private theorem soddySameSide (A B C D : Complex) (a b c d : Real) (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) (hd : 0 < d) (hdA : d < a) (hdB : d < b) diff --git a/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean b/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean index cfcbe810fc..487dc98c9f 100644 --- a/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean +++ b/LeanPool/ApollonianSuperharmonic/P4849T1LargePositiveComponents.lean @@ -126,26 +126,6 @@ private theorem chainReach : have hr := ih h₂ hn y (by simpa using hy) simpa using (Relation.ReflTransGen.single h₁).trans hr -private theorem walkReach : - ∀ (q : IntegerLatticeFunction), - let S : Set GaussianInt := {x | 0 < q x} - let edge (x y : GaussianInt) : Prop := - FourNeighborAdjacent x y ∧ x ∈ S ∧ y ∈ S - let reach (x y : GaussianInt) : Prop := Relation.ReflTransGen edge x y - ∀ (p : List GaussianInt), ∀ (a : GaussianInt), ∀ (b : GaussianInt), p.head? = some a → - p.getLast? = some b → - (∀ x ∈ p, x ∈ S) → p.IsChain FourNeighborAdjacent → reach a b := by - classical - intro q S edge reach p a b hp hlast hmem hchain - have hne : p ≠ [] := by intro he; subst p; simp at hp - have hc : p.IsChain edge := hchain.imp_of_mem_imp - (fun x y hx hy hadj => ⟨hadj, hmem x hx, hmem y hy⟩) - have hr := List.relationReflTransGen_of_exists_isChain p hc hne - have ha : p.head hne = a := by simpa [List.head?_eq_some_head hne] using hp - have hb : p.getLast hne = b := by - simpa [List.getLast?_eq_some_getLast hne] using hlast - simpa [ha, hb] using hr - private theorem reachPos : ∀ (q : IntegerLatticeFunction), let S : Set GaussianInt := {x | 0 < q x} diff --git a/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean b/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean index c0f055b615..a912ee851f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean +++ b/LeanPool/ApollonianSuperharmonic/P5023T1CircularSide.lean @@ -96,20 +96,6 @@ private theorem hkpos : · exact Or.inl hp · exact Or.inr hz.symm -private theorem hnotbothzero : - (by - classical - exact - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (i : Fin (3 : ℕ)), - let j : Fin 3 := i + 1 - let k : Fin 3 := i + 2 - (∀ a b : Fin 3, (q a.succ).1 = 0 → (q b.succ).1 = 0 → a = b) → ((j ≠ k) → (¬ ((q j.succ).1 = - 0 ∧ (q k.succ).1 = 0))) ) := by - classical - intro q i j k other_unique hjk hz - have heq := other_unique j k hz.1 hz.2 - exact hjk heq - private theorem centerDistance : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean b/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean index da4e02c0d4..d3572c6889 100644 --- a/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean +++ b/LeanPool/ApollonianSuperharmonic/P5130T5SameParentOverlaps.lean @@ -54,20 +54,6 @@ private theorem hp2 : intro P P₂ hp₂ exact hp₂ -private theorem hq1pos' : - ∀ (P : FordFareyParameter), - ∀ (P₁ : FordFareyParameter), P₁.q = P.q₁ → 0 < P.q₁ → 0 < P₁.q := by - classical - intro P P₁ hq₁ hq1pos - omega - -private theorem hq2pos' : - ∀ (P : FordFareyParameter), - ∀ (P₂ : FordFareyParameter), P₂.q = P.q₂ → 0 < P.q₂ → 0 < P₂.q := by - classical - intro P P₂ hq₂ hq2pos - omega - private theorem hq1lt' : ∀ (P : FordFareyParameter), ∀ (P₁ : FordFareyParameter), P₁.q = P.q₁ → P.q₁ < P.q → P₁.q < P.q := by diff --git a/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean b/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean index fb86f8cc29..b8fe100690 100644 --- a/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean +++ b/LeanPool/ApollonianSuperharmonic/P5188T1E2Boundary.lean @@ -44,10 +44,6 @@ private theorem hcross (P : FordFareyParameter) (hq : 1 < P.q) : P.p₁ * (↑P. classical exact (P5130T5ParentArithmetic P hq).2.2.2.2.2.2 -private theorem hdet₁ (P : FordFareyParameter) : P.p₁ * (↑P.q : ℤ) - (↑P.q₁ : ℤ) * P.p = 1 := by - classical - exact P.det₁ - private theorem hdet₂ (P : FordFareyParameter) : P.p₂ * (↑P.q : ℤ) - (↑P.q₂ : ℤ) * P.p = -1 := by classical exact P.det₂ @@ -68,11 +64,6 @@ private theorem hab (P : FordFareyParameter) : (P.q₁ : Int) < P.q := by classical have := P.q₁_lt; exact_mod_cast this -private theorem hbb (P : FordFareyParameter) (hsum : - (↑P.q : ℤ) = (↑P.q₁ : ℤ) + (↑P.q₂ : ℤ)) (ha : 0 < (↑P.q₁ : ℤ)) : (P.q₂ : Int) < P.q := by - classical - rw [hsum]; omega - private noncomputable abbrev a (P : FordFareyParameter) : Int := by classical let a : Int := P.q₁ @@ -108,26 +99,6 @@ private theorem hpq (P : FordFareyParameter) (hps : P.p = P.p₁ + P.p₂) : (A change (A + D = P.p) dsimp [A, D]; exact hps.symm -private theorem hAq (P : FordFareyParameter) (hdet₁ : P.p₁ * (↑P.q : ℤ) - (↑P.q₁ : ℤ) * P.p = 1) - : (A P) * P.q - (a P) * P.p = 1 := by - classical - let a : Int := P.q₁ - let A : Int := P.p₁ - change (A * P.q - a * P.p = 1) - simpa [a, A] using hdet₁ - -private theorem hpqa (P : FordFareyParameter) (hAq : - (A P) * (↑P.q : ℤ) - (a P) * P.p = 1) : P.p * (a P) = (A P) * P.q - 1 := by - classical - let a : Int := P.q₁ - let A : Int := P.p₁ - change (A * (↑P.q : ℤ) - a * P.p = 1) at hAq - change (P.p * a = A * P.q - 1) - have haux : A * P.q - P.p * a = 1 := by - rw [mul_comm P.p a] - exact hAq - omega - private theorem hDq (P : FordFareyParameter) (hdet₂ : P.p₂ * (↑P.q : ℤ) - (↑P.q₂ : ℤ) * P.p = -1) : (D P) * P.q - (b P) * P.p = -1 := by classical diff --git a/LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean b/LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean index 86203ad1b8..6c23acd9dd 100644 --- a/LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P5203T1CapInterface.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.DiamondFootprintCoordinates @@ -213,14 +215,8 @@ theorem P5203T1CapInterface (k : Nat) (hk : 0 < k) (u : GaussianInt) : BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = V ∧ BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = E ∧ SimpleGridPath V E have cell (w z : GaussianInt) : - z ∈ (TileTranslation D w).cells ↔ z - w ∈ DiamondCellDomain k := by - change z ∈ (DiamondCellDomain k).image (GaussianTranslation w) ↔ _ - constructor - · rintro hz - obtain ⟨x, hx, rfl⟩ := Finset.mem_image.mp hz - simpa [GaussianTranslation] using hx - · intro hz - exact Finset.mem_image.mpr ⟨z - w, hz, by simp [GaussianTranslation]⟩ + z ∈ (TileTranslation D w).cells ↔ z - w ∈ DiamondCellDomain k := + TileTranslationProperties.mem_cells (DiamondTile k) w z have ne (w : GaussianInt) : (TileTranslation D w).cells.Nonempty := by refine ⟨w, (cell w w).mpr ?_⟩ rw [sub_self] diff --git a/LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean b/LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean index 442678f82d..95f7e77562 100644 --- a/LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P5203T1DecreasingInterface.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.DiamondFootprintCoordinates @@ -322,14 +324,8 @@ theorem P5203T1DecreasingInterface (k : Nat) (hk : 0 < k) (u : GaussianInt) : BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = V ∧ BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = E ∧ SimpleGridPath V E have cell (w z : GaussianInt) : - z ∈ (TileTranslation D w).cells ↔ z - w ∈ DiamondCellDomain k := by - change z ∈ (DiamondCellDomain k).image (GaussianTranslation w) ↔ _ - constructor - · intro hz - obtain ⟨x, hx, rfl⟩ := Finset.mem_image.mp hz - simpa [GaussianTranslation] using hx - · intro hz - exact Finset.mem_image.mpr ⟨z - w, hz, by simp [GaussianTranslation]⟩ + z ∈ (TileTranslation D w).cells ↔ z - w ∈ DiamondCellDomain k := + TileTranslationProperties.mem_cells (DiamondTile k) w z have ne (w : GaussianInt) : (TileTranslation D w).cells.Nonempty := by refine ⟨w, (cell w w).mpr ?_⟩ rw [sub_self] diff --git a/LeanPool/ApollonianSuperharmonic/P5203T1IncreasingInterface.lean b/LeanPool/ApollonianSuperharmonic/P5203T1IncreasingInterface.lean index 1c8c42a02d..23e0b83c2a 100644 --- a/LeanPool/ApollonianSuperharmonic/P5203T1IncreasingInterface.lean +++ b/LeanPool/ApollonianSuperharmonic/P5203T1IncreasingInterface.lean @@ -5,6 +5,10 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.DiamondFootprintCoordinates + +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.P4194T1DiamondVertexIncidence @@ -43,22 +47,7 @@ theorem P5203T1IncreasingInterface (k : Nat) (hk : 0 < k) (u : GaussianInt) : -(k : Int) ≤ z.re ∧ z.re ≤ k ∧ -(z.im + 1) ≤ z.re ∧ z.re ≤ z.im + 1 ∧ -(2 * (k : Int) - z.im + 1) ≤ z.re ∧ - z.re ≤ 2 * (k : Int) - z.im + 1 := by - rw [(P4194T1DiamondVertexIncidence k hk z).1] - simp only [Fin.exists_fin_succ, Fin.exists_fin_succ, Fin.exists_fin_succ, - Fin.exists_fin_succ] - rw [show LatticeVertexIncidentCell z 0 = z by rfl, - show LatticeVertexIncidentCell z (Fin.succ 0) = z - 1 by rfl, - show LatticeVertexIncidentCell z (Fin.succ 0).succ = z - 1 - ⟨0, 1⟩ by rfl, - show LatticeVertexIncidentCell z (Fin.succ 0).succ.succ = z - ⟨0, 1⟩ by rfl] - rw [(P4194T1DiamondCellRows k z).1, - (P4194T1DiamondCellRows k (z - 1)).1, - (P4194T1DiamondCellRows k (z - 1 - ⟨0, 1⟩)).1, - (P4194T1DiamondCellRows k (z - ⟨0, 1⟩)).1] - simp only [Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, - ] - simp [] - omega + z.re ≤ 2 * (k : Int) - z.im + 1 := DiamondFootprintCoordinates.coordinates k hk z let D := DiamondTile k let b : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ let T := TileTranslation D u @@ -79,14 +68,8 @@ theorem P5203T1IncreasingInterface (k : Nat) (hk : 0 < k) (u : GaussianInt) : BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U = V ∧ BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U = E ∧ SimpleGridPath V E have cell (w z : GaussianInt) : - z ∈ (TileTranslation D w).cells ↔ z - w ∈ DiamondCellDomain k := by - change z ∈ (DiamondCellDomain k).image (GaussianTranslation w) ↔ _ - constructor - · intro hz - obtain ⟨x, hx, rfl⟩ := Finset.mem_image.mp hz - simpa [GaussianTranslation] using hx - · intro hz - exact Finset.mem_image.mpr ⟨z - w, hz, by simp [GaussianTranslation]⟩ + z ∈ (TileTranslation D w).cells ↔ z - w ∈ DiamondCellDomain k := + TileTranslationProperties.mem_cells (DiamondTile k) w z have ne (w : GaussianInt) : (TileTranslation D w).cells.Nonempty := by refine ⟨w, (cell w w).mpr ?_⟩ rw [sub_self] diff --git a/LeanPool/ApollonianSuperharmonic/P5253T1BottomSquareContact.lean b/LeanPool/ApollonianSuperharmonic/P5253T1BottomSquareContact.lean index 8ed199c0c6..d46feb5eea 100644 --- a/LeanPool/ApollonianSuperharmonic/P5253T1BottomSquareContact.lean +++ b/LeanPool/ApollonianSuperharmonic/P5253T1BottomSquareContact.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.P5253T1SingletonBoundary @@ -39,15 +41,9 @@ theorem P5253T1BottomSquareContact (k : Nat) (hk : 0 < k) (u : GaussianInt) : 0 ≤ (z - u).im ∧ (z - u).im < 2 * (k : Int) ∧ -((z - u).im + 1) ≤ (z - u).re ∧ (z - u).re < (z - u).im + 1 ∧ -(2 * (k : Int) - (z - u).im) ≤ (z - u).re ∧ - (z - u).re < 2 * (k : Int) - (z - u).im := by - rw [← (P4194T1DiamondCellRows k (z - u)).1] - change z ∈ (DiamondCellDomain k).image (GaussianTranslation u) ↔ _ - constructor - · rintro hz - obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz - simpa [GaussianTranslation] using hw - · intro hz - exact Finset.mem_image.mpr ⟨z - u, hz, by simp [GaussianTranslation]⟩ + (z - u).re < 2 * (k : Int) - (z - u).im := by + exact (TileTranslationProperties.mem_cells (DiamondTile k) u z).trans + (P4194T1DiamondCellRows k (z - u)).1 have inside : u ∈ D.cells := by rw [cell] simp only [sub_self] diff --git a/LeanPool/ApollonianSuperharmonic/P5253T1LeftSquareContacts.lean b/LeanPool/ApollonianSuperharmonic/P5253T1LeftSquareContacts.lean index 19223495c9..8089857c45 100644 --- a/LeanPool/ApollonianSuperharmonic/P5253T1LeftSquareContacts.lean +++ b/LeanPool/ApollonianSuperharmonic/P5253T1LeftSquareContacts.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.P5253T1SingletonBoundary @@ -41,15 +43,9 @@ theorem P5253T1LeftSquareContacts (k : Nat) (hk : 0 < k) 0 ≤ (z - u).im ∧ (z - u).im < 2 * (k : Int) ∧ -((z - u).im + 1) ≤ (z - u).re ∧ (z - u).re < (z - u).im + 1 ∧ -(2 * (k : Int) - (z - u).im) ≤ (z - u).re ∧ - (z - u).re < 2 * (k : Int) - (z - u).im := by - rw [← (P4194T1DiamondCellRows k (z - u)).1] - change z ∈ (DiamondCellDomain k).image (GaussianTranslation u) ↔ _ - constructor - · rintro hz - obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz - simpa [GaussianTranslation] using hw - · intro hz - exact Finset.mem_image.mpr ⟨z - u, hz, by simp [GaussianTranslation]⟩ + (z - u).re < 2 * (k : Int) - (z - u).im := by + exact (TileTranslationProperties.mem_cells (DiamondTile k) u z).trans + (P4194T1DiamondCellRows k (z - u)).1 have inside : c + 1 ∈ D.cells := by rw [cell] simp only [c, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, diff --git a/LeanPool/ApollonianSuperharmonic/P5253T1TopSquareContacts.lean b/LeanPool/ApollonianSuperharmonic/P5253T1TopSquareContacts.lean index 04da83257b..a81ff4e486 100644 --- a/LeanPool/ApollonianSuperharmonic/P5253T1TopSquareContacts.lean +++ b/LeanPool/ApollonianSuperharmonic/P5253T1TopSquareContacts.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.P5253T1SingletonBoundary @@ -40,15 +42,9 @@ theorem P5253T1TopSquareContacts (k : Nat) (hk : 0 < k) 0 ≤ (z - u).im ∧ (z - u).im < 2 * (k : Int) ∧ -((z - u).im + 1) ≤ (z - u).re ∧ (z - u).re < (z - u).im + 1 ∧ -(2 * (k : Int) - (z - u).im) ≤ (z - u).re ∧ - (z - u).re < 2 * (k : Int) - (z - u).im := by - rw [← (P4194T1DiamondCellRows k (z - u)).1] - change z ∈ (DiamondCellDomain k).image (GaussianTranslation u) ↔ _ - constructor - · rintro hz - obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz - simpa [GaussianTranslation] using hw - · intro hz - exact Finset.mem_image.mpr ⟨z - u, hz, by simp [GaussianTranslation]⟩ + (z - u).re < 2 * (k : Int) - (z - u).im := by + exact (TileTranslationProperties.mem_cells (DiamondTile k) u z).trans + (P4194T1DiamondCellRows k (z - u)).1 have boundary (z : GaussianInt) : z ∈ BoundaryFootprintVertices D ↔ (∃ j : Fin 4, LatticeVertexIncidentCell (z - u) j ∈ DiamondCellDomain k) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell (z - u) j ∉ DiamondCellDomain k) := by diff --git a/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean b/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean index 45bec0083a..f3008a0af6 100644 --- a/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean +++ b/LeanPool/ApollonianSuperharmonic/P5260T1PredecessorInterfaces.lean @@ -740,23 +740,6 @@ private theorem htEnd : apply Zsqrtd.ext <;> simp [GaussianTranslation, P5157T1StaircasePoint, shiftR, N] <;> omega -private theorem pathWD : - (by - classical - exact - ∀ (k : Nat), - let N : Nat := 2 * (k - 1) - let D := DiamondTile k - let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ - (SimpleGridPathBetween (FootprintVertices D ∩ FootprintVertices W) (FootprintEdges D ∩ - FootprintEdges W) (P5157T1StaircasePoint 1 false 1 0) (P5157T1StaircasePoint 1 - false 1 N)) → (SimpleGridPathBetween (FootprintVertices W ∩ FootprintVertices D) - (FootprintEdges W ∩ FootprintEdges D) (P5157T1StaircasePoint 1 false 1 0) - (P5157T1StaircasePoint 1 false 1 N)) ) := by - classical - intro k N D W pathDW - simpa only [Set.inter_comm] using pathDW - private theorem pathWDrev : (by classical @@ -1535,24 +1518,6 @@ private theorem hyDL : rw [hDLboundary] simp [hcapRight] -private theorem hyDW : - (by - classical - exact - ∀ (k : Nat), - let D := DiamondTile k - let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ - (BoundaryFootprintVertices (DiamondTile k) ∩ BoundaryFootprintVertices (TileTranslation - (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 : ℤ) - (↑k : ℤ)⟩ : GaussianInt)) = {v : - GaussianInt | ∃ j ≤ (2 : ℕ) * (k - (1 : ℕ)), v = P5157T1StaircasePoint (1 : - GaussianInt) false (1 : ℤ) j}) → ((1 : GaussianInt) ∈ BoundaryFootprintVertices D ∩ - BoundaryFootprintVertices W) ) := by - classical - intro k D W hDWv - rw [hDWv] - exact ⟨0, Nat.zero_le _, - by simp [P5157T1StaircasePoint, Zsqrtd.ext_iff]⟩ - private theorem hyLW : (by classical @@ -1632,40 +1597,6 @@ private theorem Jcoordinate : intro k J z apply Zsqrtd.ext <;> simp [J, GaussianTranslation, GaussianReflection]; omega -private theorem reflectedPath : - (by - classical - exact - ∀ (k : Nat), - let J : GaussianInt → GaussianInt := fun z => - GaussianTranslation ⟨0, 2 * (k : Int)⟩ (GaussianReflection z) - ∀ {V : Set GaussianInt}, ∀ {E : Set (Finset GaussianInt)}, ∀ {x : GaussianInt}, ∀ - {y : GaussianInt}, (SimpleGridPathBetween V E x y) → (SimpleGridPathBetween (J '' V) - ((fun e : Finset GaussianInt => e.image J) '' E) (J x) (J y)) ) := by - classical - intro k J V E x y hp - apply P4055T1GridPathImage J - · intro a b hab - have hR (z : GaussianInt) : GaussianReflection (GaussianReflection z) = z := by - apply Zsqrtd.ext <;> simp [GaussianReflection] - have hinjR : Function.Injective GaussianReflection := by - intro u v huv - calc - u = GaussianReflection (GaussianReflection u) := (hR u).symm - _ = GaussianReflection (GaussianReflection v) := congrArg GaussianReflection huv - _ = v := hR v - exact hinjR (add_right_cancel hab) - · intro a b h - rcases h with h | h | h | h - · subst b; left; apply Zsqrtd.ext <;> simp [J, GaussianTranslation, GaussianReflection] - · subst b; right; left; apply Zsqrtd.ext <;> simp [J, GaussianTranslation, - GaussianReflection] - · subst b; right; right; right; apply Zsqrtd.ext <;> simp [J, GaussianTranslation, - GaussianReflection]; abel - · subst b; right; right; left; apply Zsqrtd.ext <;> simp [J, GaussianTranslation, - GaussianReflection]; abel - · exact hp - private theorem Jx : (by classical @@ -1723,34 +1654,6 @@ private theorem hDWraw : rw [rawBoundaryVertices D W (diamondCellsNonempty k hkpos) hWne hDWd, hDWv] -private theorem hLWraw : - (by - classical - exact - ∀ (k : Nat), (∀ (X : ProtoTile), ∀ (Y : ProtoTile), (X.cells.Nonempty) → - ((Y.cells.Nonempty) → ((Disjoint X.cells Y.cells) → (FootprintVertices X ∩ - FootprintVertices Y = BoundaryFootprintVertices X ∩ BoundaryFootprintVertices Y)))) → - ((∀ (m : Nat), (0 < m) → (∀ (u : GaussianInt), (TileTranslation (DiamondTile m) - u).cells.Nonempty)) → ((0 < k) → ( - let N : Nat := 2 * (k - 1) - let D := DiamondTile k - let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ - let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ - (Disjoint (TileTranslation (DiamondTile k) (⟨(0 : ℤ), -((2 : ℤ) * (↑k : ℤ))⟩ : - GaussianInt)).cells (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 : ℤ) - - (↑k : ℤ)⟩ : GaussianInt)).cells) → ((BoundaryFootprintVertices (TileTranslation - (DiamondTile k) (⟨(0 : ℤ), -((2 : ℤ) * (↑k : ℤ))⟩ : GaussianInt)) ∩ - BoundaryFootprintVertices (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 - : ℤ) - (↑k : ℤ)⟩ : GaussianInt)) = {v : GaussianInt | ∃ j ≤ (2 : ℕ) * (k - (1 : ℕ)), - v = P5157T1StaircasePoint (1 : GaussianInt) false (-1 : ℤ) j}) → ((Finset.Nonempty - (TileTranslation (DiamondTile (k - (1 : ℕ))) (⟨(↑k : ℤ), (1 : ℤ) - (↑k : ℤ)⟩ : - GaussianInt)).cells) → (FootprintVertices L ∩ FootprintVertices W = {v | ∃ j ≤ N, v = - P5157T1StaircasePoint 1 false (-1) j})))))) ) := by - classical - intro k rawBoundaryVertices translatedDiamondCellsNonempty hkpos N D W L hLWd hLWv hWne - rw [rawBoundaryVertices L W (translatedDiamondCellsNonempty k hkpos _) - hWne hLWd, hLWv] - private theorem hWURaw : (by classical @@ -1960,21 +1863,6 @@ private theorem hRBC : rw [hstart, hend] at pathRBC exact pathRBC -private theorem hIABoundary : - (by - classical - exact - ∀ (k : Nat), - let D := DiamondTile k - let W := TileTranslation (DiamondTile (k - 1)) ⟨(k : Int), 1 - (k : Int)⟩ - let L := TileTranslation D ⟨0, -(2 * (k : Int))⟩ - (∀ z, (z ∈ BoundaryFootprintVertices D ∧ z ∈ BoundaryFootprintVertices L ∧ z ∈ - BoundaryFootprintVertices W) ↔ z = 1) → (∀ z, (z ∈ BoundaryFootprintVertices D ∧ z ∈ - BoundaryFootprintVertices L ∧ z ∈ BoundaryFootprintVertices W) ↔ z = 1) ) := by - classical - intro k D W L hIboundaryUnique - exact hIboundaryUnique - private theorem hIuniqueRaw : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean b/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean index aefd35a483..025bca89df 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean @@ -416,26 +416,6 @@ private theorem iVenum : simp only [iV, Set.mem_ofPred_eq, iP] omega -private theorem iEeq : - (by - classical - exact - ∀ (k : Nat), - let N : Nat := 2 * k - 1 - let iP : Nat → GaussianInt := fun j => - ⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ - let iE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {iP j, iP (j + 1)}} - let iq : Nat → GaussianInt := P5157T1StaircasePoint 1 false 1 - (∀ (j : Nat), iq j = iP j) → (iE = {e | ∃ j < N, e = {iq j, iq (j + 1)}}) ) := by - classical - intro k N iP iE iq iqenum - ext e - constructor - · rintro ⟨j, hj, rfl⟩ - exact ⟨j, hj, by simp [iqenum]⟩ - · rintro ⟨j, hj, rfl⟩ - exact ⟨j, hj, by simp [iqenum]⟩ - private theorem incEnumPath : (by classical @@ -1446,35 +1426,6 @@ private theorem shiftVertices : (TileTranslationFormulas (TileTranslation D ia) shift).2.2.2.2.2.2.2.1, ← Set.image_inter (translateInj shift), incVertices] -private theorem shiftEdges : - (by - classical - exact - ∀ (k : Nat), - let N : Nat := 2 * k - 1 - let iP : Nat → GaussianInt := fun j => - ⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ - let iE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {iP j, iP (j + 1)}} - (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation - (DiamondTile k) ⟨(k : Int) + 1, -(k : Int)⟩) = iE) → ( - let D := DiamondTile k - let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ - let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ - (∀ (u : GaussianInt), Function.Injective (GaussianTranslation u)) → - ((BoundaryFootprintEdges (TileTranslation (TileTranslation D ia) shift) = - BoundaryFootprintEdges D) → (BoundaryFootprintEdges (TileTranslation D shift) ∩ - BoundaryFootprintEdges D = (fun e : Finset GaussianInt => e.image - (GaussianTranslation shift)) '' iE))) ) := by - classical - intro k N iP iE incEdges D ia shift translateInj hnestedE - let et : Finset GaussianInt → Finset GaussianInt := - fun e => e.image (GaussianTranslation shift) - have eti : Function.Injective et := Finset.image_injective (translateInj shift) - rw [← hnestedE, - (TileTranslationFormulas D shift).2.2.2.2.2.2.2.2, - (TileTranslationFormulas (TileTranslation D ia) shift).2.2.2.2.2.2.2.2, - ← Set.image_inter eti, incEdges] - private theorem fourthPath : (by classical @@ -1508,23 +1459,6 @@ private theorem zeroFvertices : intro k D Q dzeroD c F quarterVerticesAt zeroQ simpa [D, Q, GaussianQuarterTurn, dzeroD, dzeroD', zeroQ] using quarterVerticesAt 0 -private theorem zeroFedges : - (by - classical - exact - ∀ (k : Nat), - let D := DiamondTile k - let Q := GaussianQuarterTurn - (TileTranslation D 0 = D) → (∀ (c : GaussianInt), - let F : GaussianInt → GaussianInt := fun z => Q z + c - (∀ (d : GaussianInt), BoundaryFootprintEdges (TileTranslation D (Q d)) = (fun e : Finset - GaussianInt => e.image F) '' BoundaryFootprintEdges (TileTranslation D d)) → ((Q 0 = - 0) → (BoundaryFootprintEdges D = (fun e : Finset GaussianInt => e.image F) '' - BoundaryFootprintEdges D))) ) := by - classical - intro k D Q dzeroD c F quarterEdgesAt zeroQ - simpa [D, Q, GaussianQuarterTurn, dzeroD, dzeroD', zeroQ] using quarterEdgesAt 0 - private theorem rightFvertices : (by classical @@ -1545,26 +1479,6 @@ private theorem rightFvertices : rw [← dShift] exact quarterVerticesAt da -private theorem rightFedges : - (by - classical - exact - ∀ (k : Nat), - let D := DiamondTile k - let Q := GaussianQuarterTurn - ∀ (c : GaussianInt), - let F : GaussianInt → GaussianInt := fun z => Q z + c - (∀ (d : GaussianInt), BoundaryFootprintEdges (TileTranslation D (Q d)) = (fun e : Finset - GaussianInt => e.image F) '' BoundaryFootprintEdges (TileTranslation D d)) → ((Q ⟨(k - : Int) + 1, (k : Int)⟩ = ⟨-(k : Int), (k : Int) + 1⟩) → ( - let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ - BoundaryFootprintEdges (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩) = (fun e : Finset - GaussianInt => e.image F) '' BoundaryFootprintEdges (TileTranslation D da))) ) := by - classical - intro k D Q c F quarterEdgesAt dShift da - rw [← dShift] - exact quarterEdgesAt da - private theorem firstVertices : (by classical @@ -1730,79 +1644,6 @@ private theorem fourthSet : refine ⟨w, hw, ?_⟩ apply Zsqrtd.ext <;> simp [w, GaussianTranslation, shift] -private theorem firstEdges : - (by - classical - exact - ∀ (k : Nat), - let N : Nat := 2 * k - 1 - let dP : Nat → GaussianInt := fun j => - ⟨(k : Int) - (j / 2 : Nat), (k : Int) + ((j + 1) / 2 : Nat)⟩ - let dE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {dP j, dP (j + 1)}} - (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation - (DiamondTile k) ⟨(k : Int) + 1, (k : Int)⟩) = dE) → ( - let D := DiamondTile k - let Q := GaussianQuarterTurn - ∀ (c : GaussianInt), - let F : GaussianInt → GaussianInt := fun z => Q z + c - (Function.Injective F) → ( - let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ - (BoundaryFootprintEdges D = (fun e : Finset GaussianInt => e.image F) '' - BoundaryFootprintEdges D) → ((BoundaryFootprintEdges (TileTranslation D ⟨-(k : Int), - (k : Int) + 1⟩) = (fun e : Finset GaussianInt => e.image F) '' BoundaryFootprintEdges - (TileTranslation D da)) → (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges - (TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩) = (fun e : Finset GaussianInt => - e.image F) '' dE)))) ) := by - classical - intro k N dP dE decEdges D Q c F F_inj da zeroFedges rightFedges - rw [zeroFedges, rightFedges, ← Set.image_inter (Finset.image_injective F_inj), decEdges] - -private theorem thirdEdges : - (by - classical - exact - ∀ (k : Nat), - let N : Nat := 2 * k - 1 - let iP : Nat → GaussianInt := fun j => - ⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ - let iE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {iP j, iP (j + 1)}} - (BoundaryFootprintEdges (DiamondTile k) ∩ BoundaryFootprintEdges (TileTranslation - (DiamondTile k) ⟨(k : Int) + 1, -(k : Int)⟩) = iE) → ( - let D := DiamondTile k - let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ - let G : GaussianInt → GaussianInt := fun z => - ⟨z.im - (k : Int), (k : Int) - z.re⟩ - (Function.Injective G) → ((∀ (d : GaussianInt), (fun e : Finset GaussianInt => e.image G) - '' BoundaryFootprintEdges (TileTranslation D d) = BoundaryFootprintEdges - (TileTranslation D (Qinv d))) → (((fun e : Finset GaussianInt => e.image G) '' - BoundaryFootprintEdges D = BoundaryFootprintEdges D) → ( - let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ - BoundaryFootprintEdges D ∩ BoundaryFootprintEdges (TileTranslation D (Qinv ia)) = (fun e - : Finset GaussianInt => e.image G) '' iE)))) ) := by - classical - intro k N iP iE incEdges D Qinv G G_inj inverseEdgesAt inverseEdgesZero ia - rw [← inverseEdgesZero, ← inverseEdgesAt ia, - ← Set.image_inter (Finset.image_injective G_inj), incEdges] - -private theorem fourthEdges : - (by - classical - exact - ∀ (k : Nat), - let N : Nat := 2 * k - 1 - let iP : Nat → GaussianInt := fun j => - ⟨1 + (j / 2 : Nat), ((j + 1) / 2 : Nat)⟩ - let iE : Set (Finset GaussianInt) := {e | ∃ j < N, e = {iP j, iP (j + 1)}} - let D := DiamondTile k - let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ - (BoundaryFootprintEdges (TileTranslation D shift) ∩ BoundaryFootprintEdges D = (fun e : - Finset GaussianInt => e.image (GaussianTranslation shift)) '' iE) → - (BoundaryFootprintEdges D ∩ BoundaryFootprintEdges (TileTranslation D shift) = (fun e - : Finset GaussianInt => e.image (GaussianTranslation shift)) '' iE) ) := by - classical - intro k N iP iE D shift shiftEdges - rw [Set.inter_comm, shiftEdges] - private theorem rows0 : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean b/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean index 354a3e69cf..d43ed34fa2 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1UnitContactPaths.lean @@ -120,15 +120,9 @@ private theorem rightContact : 0 ≤ (z - u).im ∧ (z - u).im < 2 * (k : Int) ∧ -((z - u).im + 1) ≤ (z - u).re ∧ (z - u).re < (z - u).im + 1 ∧ -(2 * (k : Int) - (z - u).im) ≤ (z - u).re ∧ - (z - u).re < 2 * (k : Int) - (z - u).im := by - rw [← (P4194T1DiamondCellRows k (z - u)).1] - change z ∈ (DiamondCellDomain k).image (GaussianTranslation u) ↔ _ - constructor - · rintro hz - obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz - simpa [GaussianTranslation] using hw - · intro hz - exact Finset.mem_image.mpr ⟨z - u, hz, by simp [GaussianTranslation]⟩ + (z - u).re < 2 * (k : Int) - (z - u).im := by + exact (TileTranslationProperties.mem_cells (DiamondTile k) u z).trans + (P4194T1DiamondCellRows k (z - u)).1 have inside : c - 1 ∈ D'.cells := by rw [cell] simp only [c, Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_add, Zsqrtd.im_add, diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean index a2945f0cb1..c62cf9306f 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor0.lean @@ -30,16 +30,6 @@ namespace ApollonianSuperharmonic namespace FirstPredecessorCases -private theorem endAlgebra : - (by - classical - exact - ∀ (b : ℤ), -((b - (1 : ℤ)) ^ (2 : ℕ) - (b - (1 : ℤ))) + (b - (1 : ℤ)) * (b - (1 : ℤ)) - - (-(b - (1 : ℤ)) ^ (2 : ℕ) + (b - (1 : ℤ)) * (b - (1 : ℤ))) = b - (1 : ℤ) ) := by - classical - intro b - ring - private theorem endAlgebraB : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean index 30cc027c58..5d40042e08 100644 --- a/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean +++ b/LeanPool/ApollonianSuperharmonic/P5352T2Predecessor3.lean @@ -755,19 +755,6 @@ private theorem hLap : unfold FourNeighborLaplacian rw [he, hw, hn, hs, h1, h2, h3, h4, h0] -private theorem huK : - (by - classical - exact - ∀ (K : DiamondParameter), - let k : Int := K.1; - ∀ (u : ℤ), u < k → u ≤ (K.1 : Int) - ) := by - classical - intro K k u huk - have huK' : u ≤ k := by omega - exact_mod_cast huK' - private theorem habsA : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/P5620T1BoundaryComponentCycle.lean b/LeanPool/ApollonianSuperharmonic/P5620T1BoundaryComponentCycle.lean index 5d475c0a02..f946744f03 100644 --- a/LeanPool/ApollonianSuperharmonic/P5620T1BoundaryComponentCycle.lean +++ b/LeanPool/ApollonianSuperharmonic/P5620T1BoundaryComponentCycle.lean @@ -26,9 +26,6 @@ namespace ApollonianSuperharmonic namespace BoundaryComponentCycle -private noncomputable def boundaryUniverse (T : ProtoTile) : Finset GaussianInt := - T.cells.biUnion fun z => {z, z + 1, z + ⟨0, 1⟩, z + 1 + ⟨0, 1⟩} - private theorem boundary_vertices_finite (T : ProtoTile) (cells_nonempty : T.cells.Nonempty) : (BoundaryFootprintVertices T).Finite := by classical diff --git a/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean index 9a18605643..8310404514 100644 --- a/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean @@ -293,50 +293,6 @@ private theorem hxSelectedOriginal : have hback := inverseDomain selectedFunction x (by simpa [hpoint] using hxSelected) simpa [h'] using hback -private theorem mapStar : - (by - classical - exact - ∀ (g : BandPackingSymmetry), ∀ (a : GaussianInt), ∀ (b : GaussianInt), (b = a ∨ b = a + 1 - ∨ b = a - 1 ∨ b = a + ⟨0, 1⟩ ∨ b = a - ⟨0, 1⟩) → (BandPackingSymmetryVectorAction g b - = BandPackingSymmetryVectorAction g a ∨ BandPackingSymmetryVectorAction g b = - BandPackingSymmetryVectorAction g a + 1 ∨ BandPackingSymmetryVectorAction g b = - BandPackingSymmetryVectorAction g a - 1 ∨ BandPackingSymmetryVectorAction g b = - BandPackingSymmetryVectorAction g a + ⟨0, 1⟩ ∨ BandPackingSymmetryVectorAction g b = - BandPackingSymmetryVectorAction g a - ⟨0, 1⟩) ) := by - classical - intro g - induction g with - | identity => intro a b hb; simpa [BandPackingSymmetryVectorAction] using hb - | shift w => intro a b hb; simpa [BandPackingSymmetryVectorAction] using hb - | negate => - intro a b hb - rcases hb with hb | hb | hb | hb | hb - · subst b; simp [BandPackingSymmetryVectorAction] - · subst b; right; right; right; left - ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] - · subst b; right; right; right; right - ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn] - · subst b; right; right; left - ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn]; try ring - · subst b; right; left - ext <;> simp [BandPackingSymmetryVectorAction, GaussianQuarterTurn]; try ring - | conjugate => - intro a b hb - rcases hb with hb | hb | hb | hb | hb - · subst b; simp [BandPackingSymmetryVectorAction] - · subst b; right; right; left - ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection]; try ring - · subst b; right; left - ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection]; try ring - · subst b; right; right; right; left - ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] - · subst b; right; right; right; right - ext <;> simp [BandPackingSymmetryVectorAction, GaussianReflection] - | comp g₁ g₂ ih₁ ih₂ => - intro a b hb - exact ih₁ _ _ (ih₂ _ _ hb) - private theorem hstarOriginal : (by classical @@ -997,7 +953,7 @@ theorem P5630T1MarkedRightOdometerAdjacencyReduction : have hxSelectedOriginal := MarkedRightAdjacencyGeometry.hxSelectedOriginal C T T₀ h h₀ x bundle hxSelected ginv inverseDomain hpoint have hstarOriginal := MarkedRightAdjacencyGeometry.hstarOriginal C T T₀ h h₀ x bundle hstar' - ginv hfunL inverseDomain hpoint (MarkedRightAdjacencyGeometry.mapStar) + ginv hfunL inverseDomain hpoint (BandPackingSymmetryVectorAction.neighborStar) have hselectedCoord : (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) (if BandPackingSymmetryReversesOrientation ginv then diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean index d27938a3fa..5e61328c1d 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebConnected.lean @@ -693,23 +693,6 @@ private theorem incidentCellsOwned : exact ⟨hxcell, hleftCell, hbelowCell, (horizontalStatus U (x - 1) hbottom).mp hleftCell⟩ -private theorem tileCellsNonempty : - (by - classical - exact - ∀ (C : BandCircle), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), ∀ (a : TilingLattice - C), (P.tile a).cells.Nonempty ) := by - classical - intro C P a - have hreal : (TileRealization (P.tile a)).Nonempty := by - rcases P.tiles_are_disks a with ⟨e⟩ - let z : Metric.closedBall (0 : Real × Real) 1 := ⟨0, by simp⟩ - exact ⟨e z, (e z).property⟩ - rcases hreal with ⟨z, hz⟩ - simp only [TileRealization, Set.mem_iUnion] at hz - rcases hz with ⟨x, hx, _⟩ - exact ⟨x, hx⟩ - private theorem ownerExists : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean index dee1a11837..6514f9566a 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicBoundaryWebLaplacian.lean @@ -858,23 +858,6 @@ private theorem hcurvature : have hpos : 0 < C.1.1.1 := C.2 omega -private theorem hu_eq : - (by - classical - exact - ∀ (C : BandCircle), ∀ (v : GaussianInt), ∀ (hv : v ∈ TilingLattice C), - let iv : TilingLattice C := ⟨v, hv⟩ - ∀ (a0 : ↥(TilingLattice C)), ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ - (a3 : ↥(TilingLattice C)), - let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] - ∀ (m : Fin (4 : ℕ)), (owner m = iv) → ( - let u : GaussianInt := owner m - u = v) ) := by - classical - intro C v hv iv a0 a1 a2 a3 owner m hm u - change (owner m : GaussianInt) = v - rw [hm] - private theorem translateExtends : (by classical @@ -966,77 +949,6 @@ private theorem hmatrixDiff : · simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, hre, him] linarith -private theorem hAdiff : - (by - classical - exact - ∀ (C : BandCircle), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), ∀ (a0 : ↥(TilingLattice C)), - ∀ (a1 : ↥(TilingLattice C)), ∀ (a2 : ↥(TilingLattice C)), ∀ (a3 : ↥(TilingLattice C)), - let owner : Fin 4 → TilingLattice C := ![a0, a1, a2, a3] - ∀ (m : Fin (4 : ℕ)), ∀ (w : Fin (4 : ℕ)), ∀ (j : Fin (3 : ℕ)), ((↑(owner w) : - GaussianInt) - (↑(owner m) : GaussianInt) = BandVectors.1 (q j.succ) (q (0 : Fin (4 : - ℕ))) ∨ (↑(owner w) : GaussianInt) - (↑(owner m) : GaussianInt) = -BandVectors.1 (q - j.succ) (q (0 : Fin (4 : ℕ)))) → ( - let u : GaussianInt := owner m - let u' : GaussianInt := owner w - ∀ (au : GaussianInt), ∀ (au' : GaussianInt), (Matrix.mulVec (CircleMatrix C) ![((u' - - u).re : ℝ), ((u' - u).im : ℝ)] = ![((au' - au).re : ℝ), ((au' - au).im : ℝ)]) → - (((CircleMatrix C).mulVec ![(↑(BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ)))).re : - ℝ), (↑(BandVectors.1 (q j.succ) (q (0 : Fin (4 : ℕ)))).im : ℝ)] = ![(↑(BandVectors.2 - (q j.succ) (q (0 : Fin (4 : ℕ)))).re : ℝ), (↑(BandVectors.2 (q j.succ) (q (0 : Fin (4 - : ℕ)))).im : ℝ)]) → (au' - au = BandVectors.2 (q j.succ) (q 0) ∨ au' - au = - -BandVectors.2 (q j.succ) (q 0)))) ) := by - classical - intro C q a0 a1 a2 a3 owner m w j hsign u u' au au' hmatrixDiff hincoming - rcases hsign with hplus | hminus - · have hmd := hmatrixDiff - rw [hplus] at hmd - left - have hvec := hmd.symm.trans hincoming - ext - · have hh : ((au' - au).re : ℝ) = - ((BandVectors.2 (q j.succ) (q 0)).re : ℝ) := by - simpa using congrFun hvec 0 - exact_mod_cast hh - · have hh : ((au' - au).im : ℝ) = - ((BandVectors.2 (q j.succ) (q 0)).im : ℝ) := by - simpa using congrFun hvec 1 - exact_mod_cast hh - · have hmd := hmatrixDiff - rw [hminus] at hmd - right - have hneg' : Matrix.mulVec (CircleMatrix C) - ![(-((BandVectors.1 (q j.succ) (q 0)).re : ℝ)), - (-((BandVectors.1 (q j.succ) (q 0)).im : ℝ))] = - ![(-((BandVectors.2 (q j.succ) (q 0)).re : ℝ)), - (-((BandVectors.2 (q j.succ) (q 0)).im : ℝ))] := by - ext k - fin_cases k - · have hc := congrFun hincoming 0 - simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] at hc ⊢ - linarith - · have hc := congrFun hincoming 1 - simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] at hc ⊢ - linarith - have hneg : Matrix.mulVec (CircleMatrix C) - ![((-BandVectors.1 (q j.succ) (q 0)).re : ℝ), - ((-BandVectors.1 (q j.succ) (q 0)).im : ℝ)] = - ![((-BandVectors.2 (q j.succ) (q 0)).re : ℝ), - ((-BandVectors.2 (q j.succ) (q 0)).im : ℝ)] := by - simpa [Zsqrtd.re_neg, Zsqrtd.im_neg] using hneg' - have hmd' := hmd - simp only [Zsqrtd.re_neg, Zsqrtd.im_neg] at hmd' - have hvec := hmd'.symm.trans hneg - ext - · have hh : ((au' - au).re : ℝ) = - (-((BandVectors.2 (q j.succ) (q 0)).re : ℝ)) := by - simpa using congrFun hvec 0 - exact_mod_cast hh - · have hh : ((au' - au).im : ℝ) = - (-((BandVectors.2 (q j.succ) (q 0)).im : ℝ)) := by - simpa using congrFun hvec 1 - exact_mod_cast hh - private theorem aDiffPlus : (by classical @@ -1488,118 +1400,6 @@ private theorem hadjOdo : linarith simpa using hr -private theorem hnoCheckerboard0 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (x : GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), - ∀ (a0 : ↥(TilingLattice C)), (x ∈ (P.tile a0).cells) → (∀ (a1 : ↥(TilingLattice C)), - (∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (1 : LatticeCell) ∈ - (P.tile a).cells) y → y = a1) → (∀ (a2 : ↥(TilingLattice C)), (x - (1 : LatticeCell) - - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a2).cells) → (∀ (a3 : ↥(TilingLattice - C)), (∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (⟨(0 : ℤ), (1 - : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = a3) → (a0 = a2 → a0 = a1 ∨ a0 = - a3)))) ) := by - classical - intro C x P a0 ha0 a1 hu1 a2 ha2 a3 hu3 h02 - by_cases h01 : a0 = a1 - · exact Or.inl h01 - by_cases h03 : a0 = a3 - · exact Or.inr h03 - have hx1 : x - 1 ∉ (P.tile a0).cells := by - intro hx1 - exact h01 (hu1 a0 hx1) - have hx3 : x - ⟨0, 1⟩ ∉ (P.tile a0).cells := by - intro hx3 - exact h03 (hu3 a0 hx3) - have hnc := (LatticeTileGridStructure (P.tile a0) - (P.tiles_are_disks a0)).2.1 - exact (hnc x (Or.inl ⟨ha0, by simpa [h02] using ha2, hx1, hx3⟩)).elim - -private theorem hnoCheckerboard1 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (x : GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), - ∀ (a0 : ↥(TilingLattice C)), (∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice - C)) => x ∈ (P.tile a).cells) y → y = a0) → (∀ (a1 : ↥(TilingLattice C)), (x - (1 : - LatticeCell) ∈ (P.tile a1).cells) → (∀ (a2 : ↥(TilingLattice C)), (∀ (y : - ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (1 : LatticeCell) - (⟨(0 : - ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = a2) → (∀ (a3 : - ↥(TilingLattice C)), (x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a3).cells) → - (a1 = a3 → a1 = a0 ∨ a1 = a2)))) ) := by - classical - intro C x P a0 hu0 a1 ha1 a2 hu2 a3 ha3 h13 - by_cases h10 : a1 = a0 - · exact Or.inl h10 - by_cases h12 : a1 = a2 - · exact Or.inr h12 - have hx0 : x ∉ (P.tile a1).cells := by - intro hx0 - exact h10 (hu0 a1 hx0) - have hx2 : x - 1 - ⟨0, 1⟩ ∉ (P.tile a1).cells := by - intro hx2 - exact h12 (hu2 a1 hx2) - have hnc := (LatticeTileGridStructure (P.tile a1) - (P.tiles_are_disks a1)).2.1 - exact (hnc x (Or.inr ⟨ha1, by simpa [h13] using ha3, hx0, hx2⟩)).elim - -private theorem hnoCheckerboard2 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (x : GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), - ∀ (a0 : ↥(TilingLattice C)), (x ∈ (P.tile a0).cells) → (∀ (a1 : ↥(TilingLattice C)), - (∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (1 : LatticeCell) ∈ - (P.tile a).cells) y → y = a1) → (∀ (a2 : ↥(TilingLattice C)), (x - (1 : LatticeCell) - - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a2).cells) → (∀ (a3 : ↥(TilingLattice - C)), (∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (⟨(0 : ℤ), (1 - : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = a3) → (a2 = a0 → a2 = a1 ∨ a2 = - a3)))) ) := by - classical - intro C x P a0 ha0 a1 hu1 a2 ha2 a3 hu3 h20 - by_cases h21 : a2 = a1 - · exact Or.inl h21 - by_cases h23 : a2 = a3 - · exact Or.inr h23 - have hx1 : x - 1 ∉ (P.tile a2).cells := by - intro hx1 - exact h21 (hu1 a2 hx1) - have hx3 : x - ⟨0, 1⟩ ∉ (P.tile a2).cells := by - intro hx3 - exact h23 (hu3 a2 hx3) - have hnc := (LatticeTileGridStructure (P.tile a2) - (P.tiles_are_disks a2)).2.1 - exact (hnc x (Or.inl ⟨by simpa [h20] using ha0, ha2, hx1, hx3⟩)).elim - -private theorem hnoCheckerboard3 : - (by - classical - exact - ∀ (C : BandCircle), ∀ (x : GaussianInt), ∀ (P : PeriodicTileComplex ↥(TilingLattice C)), - ∀ (a0 : ↥(TilingLattice C)), (∀ (y : ↥(TilingLattice C)), (fun (a : ↥(TilingLattice - C)) => x ∈ (P.tile a).cells) y → y = a0) → (∀ (a1 : ↥(TilingLattice C)), (x - (1 : - LatticeCell) ∈ (P.tile a1).cells) → (∀ (a2 : ↥(TilingLattice C)), (∀ (y : - ↥(TilingLattice C)), (fun (a : ↥(TilingLattice C)) => x - (1 : LatticeCell) - (⟨(0 : - ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a).cells) y → y = a2) → (∀ (a3 : - ↥(TilingLattice C)), (x - (⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ∈ (P.tile a3).cells) → - (a3 = a1 → a3 = a0 ∨ a3 = a2)))) ) := by - classical - intro C x P a0 hu0 a1 ha1 a2 hu2 a3 ha3 h31 - by_cases h30 : a3 = a0 - · exact Or.inl h30 - by_cases h32 : a3 = a2 - · exact Or.inr h32 - have hx0 : x ∉ (P.tile a3).cells := by - intro hx0 - exact h30 (hu0 a3 hx0) - have hx2 : x - 1 - ⟨0, 1⟩ ∉ (P.tile a3).cells := by - intro hx2 - exact h32 (hu2 a3 hx2) - have hnc := (LatticeTileGridStructure (P.tile a3) - (P.tiles_are_disks a3)).2.1 - exact (hnc x (Or.inr ⟨by simpa [h31] using ha1, ha3, hx0, hx2⟩)).elim - end WebLaplacianGeometry theorem PeriodicBoundaryWebLaplacian (C : BandCircle) diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean b/LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean index a5c2b84404..733542b52d 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicOdometerIndicatorRigidity.lean @@ -152,24 +152,6 @@ private theorem hWsub : exact List.getLast_mem hne exact hall w hwmem -private theorem Ynonempty : - (by - classical - exact - ∀ (X : Set GaussianInt), ∀ (x : GaussianInt), (x ∉ X) → ( - let reachable (a b : GaussianInt) : Prop := ∃ p : List GaussianInt, - p.head? = some a ∧ p.getLast? = some b ∧ - (∀ z ∈ p, z ∉ X) ∧ p.IsChain FourNeighborAdjacent - let Y : Set GaussianInt := {y | reachable x y} - Y.Nonempty) ) := by - classical - intro X x hxX reachable Y - refine ⟨x, ?_⟩ - refine ⟨[x], rfl, rfl, ?_, List.isChain_singleton _⟩ - intro z hz - simp only [List.mem_singleton] at hz - simpa [hz] using hxX - private theorem xY : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean index 4629c8312a..6d6c975751 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean @@ -1425,23 +1425,6 @@ private theorem hDcells : apply hDmem z |>.mpr exact ⟨hcellBaseFV z hzc, hzb⟩ -private theorem hDfilter : - (by - classical - exact - ∀ (T : ProtoTile), ∀ (h : PartialOdometer), - let D : Finset GaussianInt := h.domain.filter - (fun x => @decide (x ∉ BoundaryFootprintVertices T) - (Classical.propDecidable _)) - (∀ (z : GaussianInt), z ∈ D ↔ z ∈ T.cells ∧ z ∉ BoundaryFootprintVertices T) → (D = - T.cells.filter (fun z => @decide (z ∉ BoundaryFootprintVertices T) - (Classical.propDecidable _))) ) := by - classical - intro T h D hDcells - ext z - rw [hDcells, Finset.mem_filter] - simp [] - private theorem hsumFund : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean index ee4320bd79..d57be3cade 100644 --- a/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean +++ b/LeanPool/ApollonianSuperharmonic/PositiveCurvatureGeneratorCocycles.lean @@ -39,45 +39,6 @@ private theorem hcoords : intro C q hq hqC w exact (TilingLatticeBasis C q hq hqC).2.2.1 w |>.exists -private theorem hlat : - (by - classical - exact - ∀ (C : BandCircle), - ∀ (q : Fin (4 : ℕ) → CircleCoordinates), - ∀ (T : ProtoTile), - ∀ (h : PartialOdometer), - ∀ (H : ℤ × ℤ → PartialOdometer), - (∀ (kl : ℤ × ℤ), - let w := - (↑kl.1 : GaussianInt) * - BandVectors.1 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + - (↑kl.2 : GaussianInt) * - BandVectors.1 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))); - let a := - (↑kl.1 : GaussianInt) * - BandVectors.2 (q (1 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))) + - (↑kl.2 : GaussianInt) * - BandVectors.2 (q (2 : Fin (4 : ℕ))) (q (0 : Fin (4 : ℕ))); - TileOdometer C.1.1 (TileTranslation T w) (H kl) ∧ - (∀ (x : GaussianInt), x ∈ (H kl).domain ↔ x - w ∈ h.domain) ∧ - ∀ x ∈ (H kl).domain, - (H kl).value x = - h.value (x - w) + a.re * x.re + a.im * x.im) → - (h.domain : Set GaussianInt) = FootprintVertices T → - ExactTileTiling (RegularTileFamily T (TilingLattice C)) → - LatticeTile T - ) := by - classical - intro C q T h H htrans hdom tiling - apply tiling.1 T - refine ⟨0, (TilingLattice C).zero_mem, ?_⟩ - cases T - congr 1 - · rw [show GaussianTranslation 0 = id by funext z; simp [GaussianTranslation]] - simp only [Finset.image_id] - · simp [GaussianTranslation] - private theorem hfamily : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean index 6441c665bd..d09de285de 100644 --- a/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/QuarterTurnSymmetricCenteredTransport.lean @@ -23,48 +23,6 @@ Changes: pool module paths, public exports, project namespace and current Mathli namespace ApollonianSuperharmonic -namespace CenteredTransportLemmas - -private theorem center_mem : - ∀ (S : ProtoTile), ∀ (x : GaussianInt), x ∈ S.cells ↔ - (((x.re : Int) : Real) + (1 / 2 : Real), - ((x.im : Int) : Real) + (1 / 2 : Real)) ∈ TileRealization S := by - classical - intro S x - constructor - · intro hx - change (((x.re : Int) : Real) + (1 / 2 : Real), - ((x.im : Int) : Real) + (1 / 2 : Real)) ∈ - ⋃ y ∈ S.cells, ClosedSquareRealization y - simp only [Set.mem_iUnion] - refine ⟨x, hx, ?_⟩ - simp [ClosedSquareRealization] - norm_num - · intro hp - change (((x.re : Int) : Real) + (1 / 2 : Real), - ((x.im : Int) : Real) + (1 / 2 : Real)) ∈ - ⋃ y ∈ S.cells, ClosedSquareRealization y at hp - simp only [Set.mem_iUnion] at hp - rcases hp with ⟨y, hy, hbox⟩ - simp only [ClosedSquareRealization, Set.mem_Icc] at hbox - have re_one : (y.re : Int) < x.re + 1 := by - exact_mod_cast (show (y.re : Real) < (x.re : Real) + 1 by linarith [hbox.1.1]) - have re_two : x.re < (y.re : Int) + 1 := by - exact_mod_cast (show (x.re : Real) < (y.re : Real) + 1 by linarith [hbox.2.1]) - have im_one : (y.im : Int) < x.im + 1 := by - exact_mod_cast (show (y.im : Real) < (x.im : Real) + 1 by linarith [hbox.1.2]) - have im_two : x.im < (y.im : Int) + 1 := by - exact_mod_cast (show (x.im : Real) < (y.im : Real) + 1 by linarith [hbox.2.2]) - have re_eq : y.re = x.re := by omega - have im_eq : y.im = x.im := by omega - have xy : y = x := by - cases y - cases x - rw [Zsqrtd.ext_iff] - exact ⟨re_eq, im_eq⟩ - simpa [xy] using hy - -end CenteredTransportLemmas theorem QuarterTurnSymmetricCenteredTransport : ∀ (T : ProtoTile), QuarterTurnSymmetric T → diff --git a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean index 7a049a3707..4b8e15b99e 100644 --- a/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean +++ b/LeanPool/ApollonianSuperharmonic/RightLatticeAdjacentPackingSymmetryTransport.lean @@ -274,16 +274,6 @@ private theorem turn_mul : rcases z with ⟨a, b⟩ ext <;> simp [GaussianQuarterTurn] -private theorem neg_turn_mul : - (by - classical - exact - (∀ (z : GaussianInt), (⟨0, 1⟩ : GaussianInt) * z = GaussianQuarterTurn z) → (∀ (z : - GaussianInt), -((⟨0, 1⟩ : GaussianInt) * z) = -GaussianQuarterTurn z) ) := by - classical - intro turn_mul z - rw [turn_mul] - private theorem neg_turn_mul' : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean index 84bc06468b..3180968e16 100644 --- a/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/TileQuarterTurnFormulas.lean @@ -30,20 +30,6 @@ namespace ApollonianSuperharmonic namespace QuarterTurnFormulas -private theorem quarter_re (x : GaussianInt) : - (GaussianInt.toComplex (GaussianQuarterTurn x - 1)).re = - -(x.im : Real) - 1 := by - classical - rcases x with ⟨a, b⟩ - simp [GaussianQuarterTurn, GaussianInt.toComplex_def] - -private theorem quarter_im (x : GaussianInt) : - (GaussianInt.toComplex (GaussianQuarterTurn x - 1)).im = - (x.re : Real) := by - classical - rcases x with ⟨a, b⟩ - simp [GaussianQuarterTurn, GaussianInt.toComplex_def] - private theorem quarter_re_int (x : GaussianInt) : (GaussianQuarterTurn x - 1).re = -x.im - 1 := by classical @@ -178,35 +164,12 @@ private theorem turn_up_left (a : GaussianInt) : private abbrev turn_one_up := ApollonianSuperharmonic.QuarterTurnFormulas.turn_up_right -private theorem turn_one_up_left (a : GaussianInt) : - GaussianQuarterTurn (1 + (⟨0, 1⟩ + a)) = - GaussianQuarterTurn a - 1 + ⟨0, 1⟩ := by - classical - have turn_one_up (a : GaussianInt) : - GaussianQuarterTurn (a + 1 + ⟨0, 1⟩) = - GaussianQuarterTurn a - 1 + ⟨0, 1⟩ := turn_one_up a - rw [show 1 + (⟨0, 1⟩ + a) = a + 1 + ⟨0, 1⟩ by - simp [add_assoc, add_comm, add_left_comm]] - exact turn_one_up a - -private theorem one_up_comm : (1 : GaussianInt) + ⟨0, 1⟩ = ⟨0, 1⟩ + 1 := by - classical - have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) - (him : u.im = v.im) : u = v := gaussian_equal u v hre him - apply gaussian_equal <;> simp - private theorem one_sub_one (u : GaussianInt) : u + 1 - 1 = u := by classical have gaussian_equal (u v : GaussianInt) (hre : u.re = v.re) (him : u.im = v.im) : u = v := gaussian_equal u v hre him apply gaussian_equal <;> simp -private theorem add_one_up (u : GaussianInt) : - u + (1 + ⟨0, 1⟩) = u + (⟨0, 1⟩ + 1) := by - classical - have one_up_comm : (1 : GaussianInt) + ⟨0, 1⟩ = ⟨0, 1⟩ + 1 := one_up_comm - rw [one_up_comm] - private theorem inverse_horizontal (z : GaussianInt) : cellInverse (z - ⟨0, 1⟩) = cellInverse z - 1 := by classical diff --git a/LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean b/LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean index ab47bf22a6..0d25cdc8d8 100644 --- a/LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean +++ b/LeanPool/ApollonianSuperharmonic/TileReflectionFormulas.lean @@ -82,14 +82,6 @@ private theorem f_one (z : GaussianInt) : f (z + 1) = f z + 1 := by change (f (z + 1) = f z + 1) apply gaussian_ext <;> simp [f, GaussianReflection] -private theorem f_up (z : GaussianInt) : f (z + ⟨0, 1⟩) = f z - ⟨0, 1⟩ := by - classical - let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ - have gaussian_ext (u v : GaussianInt) (hre : u.re = v.re) - (him : u.im = v.im) : u = v := gaussian_ext u v hre him - change (f (z + ⟨0, 1⟩) = f z - ⟨0, 1⟩) - apply gaussian_ext <;> simp [f, GaussianReflection]; omega - private theorem reflection_f (z : GaussianInt) : GaussianReflection (f z) = z + ⟨0, 1⟩ := by classical let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ @@ -164,27 +156,6 @@ private theorem f_im (z : GaussianInt) : rcases z with ⟨a, b⟩ simp [f, GaussianReflection] -private theorem reflectedCellRe (z : GaussianInt) : - (GaussianInt.toComplex (GaussianReflection z - ⟨0, 1⟩)).re = - (GaussianInt.toComplex z).re := by - classical - let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ - have f_re (z : GaussianInt) : - (GaussianInt.toComplex (f z)).re = (GaussianInt.toComplex z).re := f_re z - change (GaussianInt.toComplex (f z)).re = _ - exact f_re z - -private theorem reflectedCellIm (z : GaussianInt) : - (GaussianInt.toComplex (GaussianReflection z - ⟨0, 1⟩)).im = - -(GaussianInt.toComplex z).im - 1 := by - classical - let f : GaussianInt → GaussianInt := fun z => GaussianReflection z - ⟨0, 1⟩ - have f_im (z : GaussianInt) : - (GaussianInt.toComplex (f z)).im = - -(GaussianInt.toComplex z).im - 1 := f_im z - change (GaussianInt.toComplex (f z)).im = _ - exact f_im z - private theorem f_im_cast (z : GaussianInt) : ((f z).im : Real) = -(z.im : Real) - 1 := by classical diff --git a/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean b/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean index d6d1c1bf9f..64c7d69206 100644 --- a/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/TileStringRegularFamilyCentralCovariance.lean @@ -26,19 +26,6 @@ namespace ApollonianSuperharmonic namespace RegularStringCentralGeometry -private theorem coordinate_value : - (by - classical - exact - ∀ (base : ProtoTile), ∀ (a : GaussianInt), ∀ (b : GaussianInt), - let tileAt := fun z : Int × Int => - TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) - ∀ T, ∀ z, T = tileAt z → T = TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : - GaussianInt) * b) ) := by - classical - intro base a b tileAt T z hz - exact hz - private theorem reflect_height : (by classical @@ -181,21 +168,6 @@ private theorem reflected_segment : simp [TriangularStripSegment, hrs']] exact htarget -private theorem reflected_corr : - (by - classical - exact - ∀ (base : ProtoTile), ∀ (tiles : List ProtoTile), ∀ (a : GaussianInt), ∀ (b : - GaussianInt), ∀ (coordinates : List (ℤ × ℤ)), (List.Forall₂ (fun (T : ProtoTile) (z : - ℤ × ℤ) => T = TileTranslation base ((↑z.1 : GaussianInt) * a + (↑z.2 : GaussianInt) * - b)) tiles coordinates) → ( - let tileAt := fun z : Int × Int => - TileTranslation base ((z.1 : GaussianInt) * a + (z.2 : GaussianInt) * b) - List.Forall₂ (fun T z => T = tileAt z) tiles (coordinates)) ) := by - classical - intro base tiles a b coordinates hcorr tileAt - simpa [tileAt] using hcorr - private theorem reverse_corr : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean b/LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean index e035217bf5..ab0f2ef250 100644 --- a/LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean +++ b/LeanPool/ApollonianSuperharmonic/TileT2QuarterTurn.lean @@ -83,36 +83,6 @@ private theorem hRingImage : rw [Finset.image_image, hf] at h exact congrArg (fun s : Finset GaussianInt => (s : Set GaussianInt)) h -private theorem turn_add : - (by - classical - exact - ∀ (u : GaussianInt), - let turn (x : GaussianInt) : GaussianInt := - ⟨-x.im - 1 + u.re, x.re + u.im⟩ - ∀ (x : GaussianInt), ∀ (d : GaussianInt), turn (x + d) = turn x + ⟨-d.im, d.re⟩ ) := by - classical - intro u turn x d - rcases x with ⟨a, b⟩ - rcases d with ⟨c, e⟩ - apply Zsqrtd.ext_iff.mpr - constructor <;> simp [turn] <;> abel - -private theorem back_add : - (by - classical - exact - ∀ (u : GaussianInt), - let back (x : GaussianInt) : GaussianInt := - ⟨x.im - u.im, -x.re - 1 + u.re⟩ - ∀ (x : GaussianInt), ∀ (d : GaussianInt), back (x + d) = back x + ⟨d.im, -d.re⟩ ) := by - classical - intro u back x d - rcases x with ⟨a, b⟩ - rcases d with ⟨c, e⟩ - apply Zsqrtd.ext_iff.mpr - constructor <;> simp [back] <;> abel - private theorem turn_neighbor : (by classical @@ -502,22 +472,6 @@ private theorem hleft : · linarith [hu_re, hu_im] · linarith [hu_re, hu_im] -private theorem hright : - (by - classical - exact - ∀ (u : GaussianInt), - let rotate (p : Real × Real) : Real × Real := - (-(p.2) + (u.re : Real), p.1 + (u.im : Real)) - let unrotate (p : Real × Real) : Real × Real := - (p.2 - (u.im : Real), -p.1 + (u.re : Real)) - ∀ (p : Real × Real), rotate (unrotate p) = p ) := by - classical - intro u rotate unrotate p - apply Prod.ext <;> dsimp [rotate, unrotate] - · linarith [hu_re, hu_im] - · linarith [hu_re, hu_im] - private theorem hforward : (by classical diff --git a/LeanPool/ApollonianSuperharmonic/TileTranslationProperties.lean b/LeanPool/ApollonianSuperharmonic/TileTranslationProperties.lean index 2085ead152..baee1e3f38 100644 --- a/LeanPool/ApollonianSuperharmonic/TileTranslationProperties.lean +++ b/LeanPool/ApollonianSuperharmonic/TileTranslationProperties.lean @@ -72,6 +72,18 @@ theorem cellsSubset (X Y : ProtoTile) (hXY : X.cells ⊆ Y.cells) (d : GaussianI obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hz exact Finset.mem_image.mpr ⟨w, hXY hw, rfl⟩ +/-- A cell belongs to a translated tile exactly when its inverse translate belongs to the tile. -/ +theorem mem_cells (T : ProtoTile) (w z : GaussianInt) : + z ∈ (TileTranslation T w).cells ↔ z - w ∈ T.cells := by + classical + rw [cells] + constructor + · intro hz + obtain ⟨x, hx, rfl⟩ := Finset.mem_image.mp hz + simpa [GaussianTranslation] using hx + · intro hz + exact Finset.mem_image.mpr ⟨z - w, hz, by simp [GaussianTranslation]⟩ + end TileTranslationProperties end ApollonianSuperharmonic From 81d23d7b95a5308ba3edd74457d92a6a3d5c0912 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 13 Nov 2026 17:21:59 +0000 Subject: [PATCH 21/23] Share adjacent-cell geometry and simplify forwarding proofs --- .../AdjacentCellInterior.lean | 90 +++++++++++++ LeanPool/ApollonianSuperharmonic/Imports.lean | 1 + .../InteriorFootprintIncidence.lean | 16 +-- .../OpposingBoundaryOdometerStrings.lean | 53 +------- .../P4250T2InterfaceCycleExclusion.lean | 71 +---------- .../P4250T2InterfaceNeighborCount.lean | 95 ++------------ .../P4261T1SubtileCoordinates.lean | 70 +---------- .../P4418T3PresentedRowAdjacency.lean | 70 +---------- .../P4812T1RegularFaceWalks.lean | 107 +--------------- ...MarkedRightOdometerAdjacencyReduction.lean | 118 ++---------------- 10 files changed, 134 insertions(+), 557 deletions(-) create mode 100644 LeanPool/ApollonianSuperharmonic/AdjacentCellInterior.lean diff --git a/LeanPool/ApollonianSuperharmonic/AdjacentCellInterior.lean b/LeanPool/ApollonianSuperharmonic/AdjacentCellInterior.lean new file mode 100644 index 0000000000..f7ab540afa --- /dev/null +++ b/LeanPool/ApollonianSuperharmonic/AdjacentCellInterior.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Wesley Pegden. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wesley Pegden +-/ +module + +public import LeanPool.ApollonianSuperharmonic.OpenLatticeEdge +public import LeanPool.ApollonianSuperharmonic.TileRealization +public import Mathlib.Topology.Algebra.Ring.Real +public import Mathlib.Topology.Constructions.SumProd +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum + +/-! +# Interiors of adjacent lattice cells + +Shared open-rectangle arguments adapted from Wesley Pegden's Apache-2.0 +Trellis formalization of Levine–Pegden–Smart. No disk or circle hypotheses are needed. +-/ + +@[expose] public section + +namespace ApollonianSuperharmonic.AdjacentCellInterior + +/-- The common horizontal edge of two cells lies inside their tile realization. -/ +theorem horizontal (U : ProtoTile) (z : GaussianInt) + (hu : z ∈ U.cells) (hl : z - ⟨0, 1⟩ ∈ U.cells) : + OpenLatticeEdge z (z + 1) ⊆ interior (TileRealization U) := by + classical + as_aux_lemma => + let R := Set.Ioo (z.re : ℝ) ((z.re : ℝ) + 1) ×ˢ + Set.Ioo ((z.im : ℝ) - 1) ((z.im : ℝ) + 1) + have hopen : IsOpen R := isOpen_Ioo.prod isOpen_Ioo + have hsub : R ⊆ TileRealization U := by + intro p hp + rcases hp with ⟨⟨hxl, hxu⟩, ⟨hyl, hyu⟩⟩ + by_cases hside : p.2 ≤ (z.im : ℝ) + · apply Set.mem_iUnion.mpr + refine ⟨z - ⟨0, 1⟩, Set.mem_iUnion.mpr ⟨hl, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + norm_num + rw [GaussianInt.toComplex_def₂] + change ((z.re : ℝ) ≤ p.1 ∧ (z.im : ℝ) ≤ p.2 + 1) ∧ + (p.1 ≤ (z.re : ℝ) + 1 ∧ p.2 ≤ (z.im : ℝ)) + constructor <;> constructor <;> linarith + · apply Set.mem_iUnion.mpr + refine ⟨z, Set.mem_iUnion.mpr ⟨hu, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor <;> constructor <;> linarith + intro p hp + apply hopen.subset_interior_iff.mpr hsub + rcases hp with ⟨t, ht0, ht1, rfl⟩ + norm_num [R, GaussianRealPoint, Prod.smul_fst, Prod.smul_snd, smul_eq_mul] + constructor <;> constructor <;> nlinarith + +/-- The common vertical edge of two cells lies inside their tile realization. -/ +theorem vertical (U : ProtoTile) (z : GaussianInt) + (hr : z ∈ U.cells) (hl : z - 1 ∈ U.cells) : + OpenLatticeEdge z (z + ⟨0, 1⟩) ⊆ interior (TileRealization U) := by + classical + as_aux_lemma => + let R := Set.Ioo ((z.re : ℝ) - 1) ((z.re : ℝ) + 1) ×ˢ + Set.Ioo (z.im : ℝ) ((z.im : ℝ) + 1) + have hopen : IsOpen R := isOpen_Ioo.prod isOpen_Ioo + have hsub : R ⊆ TileRealization U := by + intro p hp + rcases hp with ⟨⟨hxl, hxu⟩, ⟨hyl, hyu⟩⟩ + by_cases hside : p.1 ≤ (z.re : ℝ) + · apply Set.mem_iUnion.mpr + refine ⟨z - 1, Set.mem_iUnion.mpr ⟨hl, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + norm_num + rw [GaussianInt.toComplex_def₂] + change ((z.re : ℝ) ≤ p.1 + 1 ∧ (z.im : ℝ) ≤ p.2) ∧ + (p.1 ≤ (z.re : ℝ) ∧ p.2 ≤ (z.im : ℝ) + 1) + constructor <;> constructor <;> linarith + · apply Set.mem_iUnion.mpr + refine ⟨z, Set.mem_iUnion.mpr ⟨hr, ?_⟩⟩ + simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] + constructor <;> constructor <;> linarith + intro p hp + apply hopen.subset_interior_iff.mpr hsub + rcases hp with ⟨t, ht0, ht1, rfl⟩ + norm_num [R, GaussianRealPoint, Prod.smul_fst, Prod.smul_snd, smul_eq_mul] + constructor <;> constructor <;> nlinarith + +end ApollonianSuperharmonic.AdjacentCellInterior + +end diff --git a/LeanPool/ApollonianSuperharmonic/Imports.lean b/LeanPool/ApollonianSuperharmonic/Imports.lean index 46d82b6f78..63ff114805 100644 --- a/LeanPool/ApollonianSuperharmonic/Imports.lean +++ b/LeanPool/ApollonianSuperharmonic/Imports.lean @@ -8,6 +8,7 @@ module -- shake: keep-all --deprecated_module: ignore -- Generated project imports; run `lake exe mk_all`. public import LeanPool.ApollonianSuperharmonic public import LeanPool.ApollonianSuperharmonic.AcyclicIndegreeOrientation +public import LeanPool.ApollonianSuperharmonic.AdjacentCellInterior public import LeanPool.ApollonianSuperharmonic.AffineLineMapProperties public import LeanPool.ApollonianSuperharmonic.AffineOpposingStripCorridor public import LeanPool.ApollonianSuperharmonic.AffineTriangularComplexChart diff --git a/LeanPool/ApollonianSuperharmonic/InteriorFootprintIncidence.lean b/LeanPool/ApollonianSuperharmonic/InteriorFootprintIncidence.lean index 0803748a7b..9b5a372b7d 100644 --- a/LeanPool/ApollonianSuperharmonic/InteriorFootprintIncidence.lean +++ b/LeanPool/ApollonianSuperharmonic/InteriorFootprintIncidence.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence + public import LeanPool.ApollonianSuperharmonic.FootprintVertices public import LeanPool.ApollonianSuperharmonic.P3161T2IncidentBoundary public import Mathlib.Init @@ -36,7 +38,7 @@ theorem nonempty : apply hxb simp [BoundaryFootprintVertices, hn, hx] -/-- Shared someIncidentCell identity for InteriorFootprintIncidence. -/ +/-- Incident-cell existence in the calling convention for interior footprint vertices. -/ theorem someIncidentCell : (by classical @@ -44,16 +46,8 @@ theorem someIncidentCell : ∀ (T : ProtoTile), ∀ (x : GaussianInt), (x ∈ FootprintVertices T) → ((x ∉ BoundaryFootprintVertices T) → ((T.cells.Nonempty) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ T.cells))) ) := by - classical - intro T x hx hxb hne - rw [FootprintVertices, ite_eq_left hne] at hx - rcases hx with ⟨y, hy, rfl | rfl | rfl | rfl⟩ - · exact ⟨0, by simpa [LatticeVertexIncidentCell] using hy⟩ - · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hy⟩ - · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hy⟩ - · refine ⟨2, ?_⟩ - simpa [LatticeVertexIncidentCell, sub_eq_add_neg, - add_assoc, add_comm, add_left_comm] using hy + intro T x hx _ hne + exact LatticeFootprintIncidence.incidentCell T x hne hx /-- Shared allIncidentCells identity for InteriorFootprintIncidence. -/ theorem allIncidentCells : diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean index 61020cb663..6d7680783a 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean @@ -1280,51 +1280,6 @@ private theorem htailLength : | nil => simp at hhsHead | cons x xs => simp [List.length_cons, List.tail]; omega -private theorem hinteriorTransforms : - (by - classical - exact - (∀ (centerShift : GaussianInt), - (∀ (couter : GaussianInt), - ∀ (eouter : ℤ), - let a : GaussianInt := -couter; - let b : Int := -eouter; - ∀ (eback : ℤ), - let bplus : Int := -eback; - ∀ (hs : List PartialOdometer), - let constAt : Nat → Int := fun n => - if n = 0 then 0 else if n + 1 = hs.length then bplus else b; - let transformAt : Nat → PartialOdometer → PartialOdometer := - fun n h => - PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) - centerShift a (constAt n); - let gs := hs.mapIdx transformAt; - (∀ n, - ∀ (l : List PartialOdometer), - 0 < n → - hs.length = n + l.length → - List.Forall₂ - (fun h g => - g = - PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a b) - l.dropLast - ((l.mapIdx - (fun j h => transformAt (n + j) h)).dropLast)) → - ((gs.drop 1 = - hs.tail.mapIdx (fun j h => transformAt (1 + j) h)) → - ((hs.length = 1 + hs.tail.length) → - (List.Forall₂ - (fun h g => - g = - PartialOdometerAffineTranslate - (PartialOdometerHalfTurn h) centerShift a b) - ((hs.drop 1).dropLast) ((gs.drop 1).dropLast))))))) := by - classical - intro centerShift couter eouter a b eback bplus hs constAt transformAt gs interiorTransforms - hgsTail htailLength - simpa [hgsTail] using interiorTransforms 1 hs.tail (by omega) htailLength - private theorem zipForall₂ : (by classical @@ -1903,8 +1858,12 @@ private theorem opposingBoundaryConclusion : have hgsTail := OpposingBoundaryGeometry.hgsTail q i hseed centerShift couter eouter eback hs hhsHead have htailLength := OpposingBoundaryGeometry.htailLength q i hseed hs hhsHead - have hinteriorTransforms := OpposingBoundaryGeometry.hinteriorTransforms - centerShift couter eouter eback hs interiorTransforms hgsTail htailLength + have hinteriorTransforms : List.Forall₂ + (fun h g => g = PartialOdometerAffineTranslate + (PartialOdometerHalfTurn h) centerShift (-couter) (-eouter)) + ((hs.drop 1).dropLast) ((gs.drop 1).dropLast) := by + rw [hgsTail] + simpa only [List.drop_one] using interiorTransforms 1 hs.tail (by omega) htailLength have hinteriorZip : List.Forall₂ (fun X Y => cellRelation X.1 Y.1 ∧ Y.2 = PartialOdometerAffineTranslate diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean index 828d042ec7..f8e49b530e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceCycleExclusion.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.AdjacentCellInterior + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.BandOrderedGeneralLayoutCertificate @@ -286,71 +288,6 @@ private theorem hpCells : intro T p hpInteriorT hTne vertex_cells z hz exact vertex_cells T hTne z (hpInteriorT z hz).1 (hpInteriorT z hz).2 -private theorem horizontal_interior : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ((z - ⟨0, 1⟩ ∈ U.cells) → - (OpenLatticeEdge z (z + 1) ⊆ interior (TileRealization U))) ) := by - classical - intro U z hz hzs - as_aux_lemma => - let R : Set (Real × Real) := - Set.Ioo (z.re : Real) ((z.re : Real) + 1) ×ˢ - Set.Ioo ((z.im : Real) - 1) ((z.im : Real) + 1) - have hRopen : IsOpen R := isOpen_Ioo.prod isOpen_Ioo - have hRU : R ⊆ TileRealization U := by - intro a ha - rcases ha with ⟨ha₁, ha₂⟩ - by_cases hs : a.2 ≤ (z.im : Real) - · apply Set.mem_iUnion.mpr - refine ⟨z - ⟨0, 1⟩, Set.mem_iUnion.mpr ⟨hzs, ?_⟩⟩ - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, - Zsqrtd.re_sub, Zsqrtd.im_sub, Int.cast_sub, Int.cast_one, sub_zero] - constructor <;> constructor <;> linarith [ha₁.1, ha₁.2, ha₂.1, ha₂.2] - · apply Set.mem_iUnion.mpr - refine ⟨z, Set.mem_iUnion.mpr ⟨hz, ?_⟩⟩ - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - constructor <;> constructor <;> linarith [ha₁.1, ha₁.2, ha₂.1, ha₂.2] - intro a ha - apply interior_maximal hRU hRopen - obtain ⟨t, ht₀, ht₁, rfl⟩ := ha - simp [R, GaussianRealPoint] - constructor <;> constructor <;> nlinarith - -private theorem vertical_interior : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ((z - 1 ∈ U.cells) → - (OpenLatticeEdge z (z + ⟨0, 1⟩) ⊆ interior (TileRealization U))) ) := by - classical - intro U z hz hzw - as_aux_lemma => - let R : Set (Real × Real) := - Set.Ioo ((z.re : Real) - 1) ((z.re : Real) + 1) ×ˢ - Set.Ioo (z.im : Real) ((z.im : Real) + 1) - have hRopen : IsOpen R := isOpen_Ioo.prod isOpen_Ioo - have hRU : R ⊆ TileRealization U := by - intro a ha - rcases ha with ⟨ha₁, ha₂⟩ - by_cases hw : a.1 ≤ (z.re : Real) - · apply Set.mem_iUnion.mpr - refine ⟨z - 1, Set.mem_iUnion.mpr ⟨hzw, ?_⟩⟩ - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def, - Zsqrtd.re_sub, Zsqrtd.im_sub, Zsqrtd.re_one, Zsqrtd.im_one, - Int.cast_sub, Int.cast_one, sub_zero] - constructor <;> constructor <;> linarith [ha₁.1, ha₁.2, ha₂.1, ha₂.2] - · apply Set.mem_iUnion.mpr - refine ⟨z, Set.mem_iUnion.mpr ⟨hz, ?_⟩⟩ - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - constructor <;> constructor <;> linarith [ha₁.1, ha₁.2, ha₂.1, ha₂.2] - intro a ha - apply interior_maximal hRU hRopen - obtain ⟨t, ht₀, ht₁, rfl⟩ := ha - simp [R, GaussianRealPoint] - constructor <;> constructor <;> nlinarith - private theorem edge_vertices : (by classical @@ -1346,9 +1283,9 @@ theorem P4250T2InterfaceCycleExclusion (InterfaceCycleGeometry.parent_index_eq C q cfg T cert p (InterfaceCycleGeometry.parent_step C q cfg T cert E p (InterfaceCycleGeometry.no_horizontal C q cfg T cert E p hpParentBoundary - (InterfaceCycleGeometry.horizontal_interior) edge_vertices parent_regular) + (AdjacentCellInterior.horizontal) edge_vertices parent_regular) (InterfaceCycleGeometry.no_vertical C q cfg T cert E p hpParentBoundary - (InterfaceCycleGeometry.vertical_interior) edge_vertices parent_regular) index_horizontal + (AdjacentCellInterior.vertical) edge_vertices parent_regular) index_horizontal index_vertical) (InterfaceCycleGeometry.list_end_eq)) (InterfaceCycleGeometry.parent_anchor C q cfg T cert attachment E p index_horizontal index_vertical outside_zero (InterfaceCycleGeometry.boundary_not_cycle T E p hpInteriorT hTne edge_vertices) diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean index 6c2876f8e9..8a70de3dfb 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean @@ -5,6 +5,10 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.AdjacentCellInterior + +public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties @@ -38,22 +42,6 @@ private theorem incident_foot : refine ⟨_, hj, ?_⟩ fin_cases j <;> simp [LatticeVertexIncidentCell, Zsqrtd.ext_iff] -private theorem foot_incident : - (by - classical - exact - ∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ (z : GaussianInt), (z ∈ FootprintVertices U) → - (∃ j : Fin 4, LatticeVertexIncidentCell z j ∈ U.cells)) ) := by - classical - intro U hne z hz - as_aux_lemma => - rw [FootprintVertices, ite_eq_left hne] at hz - rcases hz with ⟨c, hc, rfl | rfl | rfl | rfl⟩ - · exact ⟨0, by simpa [LatticeVertexIncidentCell] using hc⟩ - · exact ⟨1, by simpa [LatticeVertexIncidentCell] using hc⟩ - · exact ⟨3, by simpa [LatticeVertexIncidentCell] using hc⟩ - · exact ⟨2, by simpa [LatticeVertexIncidentCell, sub_sub] using hc⟩ - private theorem full_iff : (by classical @@ -128,74 +116,6 @@ private theorem boundary_foot : sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hw.2) · simpa [FootprintVertices, BoundaryFootprintVertices, hne] using hz -private theorem horizontal_interior : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ((z - ⟨0, 1⟩ ∈ U.cells) → - (OpenLatticeEdge z (z + 1) ⊆ interior (TileRealization U))) ) := by - classical - intro U z hu hl - as_aux_lemma => - let R := Set.Ioo (z.re : ℝ) ((z.re : ℝ) + 1) ×ˢ - Set.Ioo ((z.im : ℝ) - 1) ((z.im : ℝ) + 1) - have hopen : IsOpen R := isOpen_Ioo.prod isOpen_Ioo - have hsub : R ⊆ TileRealization U := by - intro p hp - rcases hp with ⟨⟨hxl, hxu⟩, ⟨hyl, hyu⟩⟩ - by_cases hside : p.2 ≤ (z.im : ℝ) - · apply Set.mem_iUnion.mpr - refine ⟨z - ⟨0, 1⟩, Set.mem_iUnion.mpr ⟨hl, ?_⟩⟩ - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - norm_num - rw [GaussianInt.toComplex_def₂] - change ((z.re : ℝ) ≤ p.1 ∧ (z.im : ℝ) ≤ p.2 + 1) ∧ - (p.1 ≤ (z.re : ℝ) + 1 ∧ p.2 ≤ (z.im : ℝ)) - constructor <;> constructor <;> linarith - · apply Set.mem_iUnion.mpr - refine ⟨z, Set.mem_iUnion.mpr ⟨hu, ?_⟩⟩ - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - constructor <;> constructor <;> linarith - intro p hp - apply hopen.subset_interior_iff.mpr hsub - rcases hp with ⟨t, ht0, ht1, rfl⟩ - norm_num [R, GaussianRealPoint, Prod.smul_fst, Prod.smul_snd, smul_eq_mul] - constructor <;> constructor <;> nlinarith - -private theorem vertical_interior : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ((z - 1 ∈ U.cells) → - (OpenLatticeEdge z (z + ⟨0, 1⟩) ⊆ interior (TileRealization U))) ) := by - classical - intro U z hr hl - as_aux_lemma => - let R := Set.Ioo ((z.re : ℝ) - 1) ((z.re : ℝ) + 1) ×ˢ - Set.Ioo (z.im : ℝ) ((z.im : ℝ) + 1) - have hopen : IsOpen R := isOpen_Ioo.prod isOpen_Ioo - have hsub : R ⊆ TileRealization U := by - intro p hp - rcases hp with ⟨⟨hxl, hxu⟩, ⟨hyl, hyu⟩⟩ - by_cases hside : p.1 ≤ (z.re : ℝ) - · apply Set.mem_iUnion.mpr - refine ⟨z - 1, Set.mem_iUnion.mpr ⟨hl, ?_⟩⟩ - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - norm_num - rw [GaussianInt.toComplex_def₂] - change ((z.re : ℝ) ≤ p.1 + 1 ∧ (z.im : ℝ) ≤ p.2) ∧ - (p.1 ≤ (z.re : ℝ) ∧ p.2 ≤ (z.im : ℝ) + 1) - constructor <;> constructor <;> linarith - · apply Set.mem_iUnion.mpr - refine ⟨z, Set.mem_iUnion.mpr ⟨hr, ?_⟩⟩ - simp only [ClosedSquareRealization, Set.mem_Icc, Prod.le_def] - constructor <;> constructor <;> linarith - intro p hp - apply hopen.subset_interior_iff.mpr hsub - rcases hp with ⟨t, ht0, ht1, rfl⟩ - norm_num [R, GaussianRealPoint, Prod.smul_fst, Prod.smul_snd, smul_eq_mul] - constructor <;> constructor <;> nlinarith - private theorem edge_endpoint : (by classical @@ -1564,7 +1484,8 @@ theorem P4250T2InterfaceNeighborCount : classical exact (by have incident_foot := InterfaceNeighborGeometry.incident_foot - have foot_incident := InterfaceNeighborGeometry.foot_incident + have foot_incident := fun (U : ProtoTile) (hne : U.cells.Nonempty) (z : GaussianInt) => + LatticeFootprintIncidence.incidentCell U z hne have full_iff := InterfaceNeighborGeometry.full_iff incident_foot foot_incident have boundary_foot := InterfaceNeighborGeometry.boundary_foot incident_foot have hOA := InterfaceNeighborGeometry.hOA C q cfg T cert @@ -1617,8 +1538,8 @@ theorem P4250T2InterfaceNeighborCount : -- Each edge is counted precisely when its two incident cells share a parent. have neighbor_bridge := InterfaceNeighborGeometry.neighbor_bridge C q cfg T cert D P hD hP incident_foot full_iff (InterfaceNeighborGeometry.edge_endpoint - (InterfaceNeighborGeometry.horizontal_interior) - (InterfaceNeighborGeometry.vertical_interior)) parent_regular x no_parent_interior + (AdjacentCellInterior.horizontal) + (AdjacentCellInterior.vertical)) parent_regular x no_parent_interior shared_cells have neighbor_injective := InterfaceNeighborGeometry.neighbor_injective x have neighbor_adjacent (j : Fin 4) : FourNeighborAdjacent (neighbor j) x := by diff --git a/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean b/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean index 07a55a98c9..a501619928 100644 --- a/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean +++ b/LeanPool/ApollonianSuperharmonic/P4261T1SubtileCoordinates.lean @@ -79,71 +79,6 @@ private theorem hcentroidRows : intro q cfg C₀ T₀ cert edge k e simpa [edge] using (cert.outer_occurrence k e).2.2 -private theorem rows : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T₀ : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T₀), ∀ (i' : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (r : Fin (3 : ℕ)), - let j : Fin 3 := i' + r - let edge : Fin 3 → GaussianInt := fun k => - BandVectors.1 (q ((k + 2).succ)) (q ((k + 1).succ)) - let incoming : Fin 3 → GaussianInt := fun k => - BandVectors.1 (q k.succ) (q 0) - let outgoing : Fin 3 → GaussianInt := fun k => - BandVectors.1 (q 0) (q k.succ) - (edge 0 + edge 1 + edge 2 = 0) → ((incoming 0 = edge 1 - (⟨0, 1⟩ : GaussianInt) * edge 2) - → ((incoming 1 = edge 2 - (⟨0, 1⟩ : GaussianInt) * edge 0) → ((incoming 2 = edge 0 - - (⟨0, 1⟩ : GaussianInt) * edge 1) → ((∀ k, outgoing k = (⟨0, 1⟩ : GaussianInt) * - incoming k) → ((cert.u = outgoing 0) → ((cert.v = outgoing 1) → ((∀ k, ∀ e, - TileCentroid (cert.P k e) - TileCentroid T₀ = (if e = true then (1 : ℝ) else -1) • - ((1 / 2 : ℝ) • (GaussianRealPoint (edge k) - (-((GaussianRealPoint (edge k)).2), - (GaussianRealPoint (edge k)).1)))) → ( - let uIndex := if j = (0 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) then - (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin - (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if - s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : - PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (-1 : ℤ), (-1 : ℤ)⟩ : - PeriodicSubtileIndex) else if j = (1 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) - then (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : - Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) - else if s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : - PeriodicSubtileIndex) else (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex) else if s = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.E, (-1 : - ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin (4 : ℕ)) then - (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (2 : Fin - (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else - (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); - let vIndex := if j = (0 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) then - (⟨SixSubtileLabel.C, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin - (4 : ℕ)) then (⟨SixSubtileLabel.F, (1 : ℤ), (0 : ℤ)⟩ : PeriodicSubtileIndex) else if - s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.D, (-1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex) else (⟨SixSubtileLabel.E, (-1 : ℤ), (0 : ℤ)⟩ : - PeriodicSubtileIndex) else if j = (1 : Fin (3 : ℕ)) then if s = (0 : Fin (4 : ℕ)) - then (⟨SixSubtileLabel.E, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : - Fin (4 : ℕ)) then (⟨SixSubtileLabel.B, (0 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else - if s = (2 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.F, (0 : ℤ), (-1 : ℤ)⟩ : - PeriodicSubtileIndex) else (⟨SixSubtileLabel.A, (0 : ℤ), (-1 : ℤ)⟩ : - PeriodicSubtileIndex) else if s = (0 : Fin (4 : ℕ)) then (⟨SixSubtileLabel.A, (-1 : - ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (1 : Fin (4 : ℕ)) then - (⟨SixSubtileLabel.D, (-1 : ℤ), (-1 : ℤ)⟩ : PeriodicSubtileIndex) else if s = (2 : Fin - (4 : ℕ)) then (⟨SixSubtileLabel.B, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex) else - (⟨SixSubtileLabel.C, (1 : ℤ), (1 : ℤ)⟩ : PeriodicSubtileIndex); - let U := SubtileOccurrenceInterpretation cert.P cert.u cert.v uIndex; - let V := SubtileOccurrenceInterpretation cert.P cert.u cert.v vIndex; TileCentroid U - - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) - ^ (↑s : ℕ) * (incoming j + outgoing j)) ∧ TileCentroid V - TileCentroid T₀ = (1 / 2 : - ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if Even (↑s : - ℕ) then incoming (j + (1 : Fin (3 : ℕ))) - outgoing (j + (1 : Fin (3 : ℕ))) else - outgoing (j - (1 : Fin (3 : ℕ))) - incoming (j - (1 : Fin (3 : ℕ)))))))))))) ) := by - classical - intro q cfg C₀ T₀ cert i' s r j edge incoming outgoing hsuper hin0 hin1 hin2 hflip hu hv - hcentroidRows - exact BandOrderedGeneralSubtileCanonicalRows - cert.P T₀ cert.u cert.v j s edge incoming outgoing hsuper hin0 hin1 hin2 - hflip hu hv hcentroidRows - private theorem tableFacts : (by classical @@ -637,8 +572,9 @@ theorem P4261T1SubtileCoordinates have hu := SubtileCoordinateGeometry.hu q cfg C₀ T₀ cert have hv := SubtileCoordinateGeometry.hv q cfg C₀ T₀ cert have hcentroidRows := SubtileCoordinateGeometry.hcentroidRows q cfg C₀ T₀ cert - have rows := SubtileCoordinateGeometry.rows q cfg C₀ T₀ cert i' s r hsuper hin0 hin1 hin2 - hflip hu hv hcentroidRows + have rows := BandOrderedGeneralSubtileCanonicalRows + cert.P T₀ cert.u cert.v j s edge incoming outgoing hsuper hin0 hin1 hin2 + hflip hu hv hcentroidRows let makeIndex : Fin 3 → Fin 4 → PeriodicSubtileIndex := fun k t => if k = 0 then if t = 0 then ⟨.A, 0, -1⟩ else if t = 1 then ⟨.B, 1, 1⟩ diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean b/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean index c2ad30b88d..c4bceaaf66 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean @@ -346,71 +346,6 @@ private theorem selected_sign : rw [(cert.outer_occurrence _ _).2.2] at hc exact signed_injective _ (cyclic_nonzero _) _ _ hc -private theorem fixed_circle : - (by - classical - exact - ∀ (C : BandCircle), ∀ (D : BandCircle), ∀ (T : ProtoTile), ∀ (N : ProtoTile), ∀ (h : - PartialOdometer), ∀ (k : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C D T N h k x), ∀ (placement : - BandOrderedGeneralSubtilePlacement bundle.normalizedPresentation bundle.configuration - bundle.normalizedCircle bundle.normalizedFixedCircle bundle.normalizedRoot - bundle.normalizedFixed bundle.normalizedRootFunction bundle.normalizedFixedFunction - bundle.normalizedPoint bundle.pieces bundle.functions bundle.selectedSlot - bundle.selectedSign bundle.routedDirection), ∀ (row : - BandOrderedGeneralSelectedContactRow bundle.normalizedPresentation - bundle.configuration bundle.normalizedCircle bundle.normalizedRoot placement.layout - placement.exteriorIndex placement.centralIndex), ∀ (r : Fin 4 → CircleCoordinates), ∀ - (i : Fin 3), ∀ (s : Fin 4), - let q := bundle.normalizedPresentation - let slot : SixSubtileLabel → Fin 3 := fun l => match l with - | .A | .B => 0 - | .C | .D => 1 - | .E | .F => 2 - (bundle.normalizedFixedCircle.1.1 = - bundle.normalizedPresentation ((match placement.exteriorIndex.label with - | SixSubtileLabel.A => (1 : Fin (4 : ℕ)) - | SixSubtileLabel.B => (1 : Fin (4 : ℕ)) - | SixSubtileLabel.C => (2 : Fin (4 : ℕ)) - | SixSubtileLabel.D => (2 : Fin (4 : ℕ)) - | SixSubtileLabel.E => (3 : Fin (4 : ℕ)) - | SixSubtileLabel.F => (3 : Fin (4 : ℕ)) - )) ∧ - ((↑s : ℕ) = (match placement.exteriorIndex.label with - | SixSubtileLabel.A => if placement.exteriorIndex.first = (-1 : ℤ) then (3 : ℕ) - else (0 : ℕ) - | SixSubtileLabel.B => if placement.exteriorIndex.first = (1 : ℤ) then (1 : ℕ) else - (2 : ℕ) - | SixSubtileLabel.C => if placement.exteriorIndex.second = (0 : ℤ) then (3 : ℕ) - else (0 : ℕ) - | SixSubtileLabel.D => if placement.exteriorIndex.second = (0 : ℤ) then (1 : ℕ) - else (2 : ℕ) - | SixSubtileLabel.E => if placement.exteriorIndex.first = (0 : ℤ) then (3 : ℕ) else - (0 : ℕ) - | SixSubtileLabel.F => if placement.exteriorIndex.first = (0 : ℤ) then (1 : ℕ) else - (2 : ℕ) - )) ∧ ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) - * if Even (↑s : ℕ) then BandVectors.1 (r (0 : Fin (4 : ℕ))) (r i.succ) else - BandVectors.1 (r i.succ) (r (0 : Fin (4 : ℕ)))) = match P3996T1SRowTable - bundle.normalizedPresentation bundle.configuration bundle.normalizedCircle - bundle.normalizedRoot placement.layout row with - | some z => z.oldShift - | none => - (match placement.exteriorIndex.label with - | SixSubtileLabel.A => if placement.exteriorIndex.first = (-1 : ℤ) then - -placement.layout.u else placement.layout.u - | SixSubtileLabel.B => if placement.exteriorIndex.first = (1 : ℤ) then - placement.layout.u else -placement.layout.u - | SixSubtileLabel.C => -placement.layout.v - | SixSubtileLabel.D => placement.layout.v - | SixSubtileLabel.E => (0 : ℤ√(-1 : ℤ)) - | SixSubtileLabel.F => (0 : ℤ√(-1 : ℤ)) - )) → - (bundle.normalizedFixedCircle.1.1 = q (slot placement.exteriorIndex.label).succ) ) := by - classical - intro C D T N h k x bundle placement row r i s q slot outer - cases he : placement.exteriorIndex.label <;> simpa [slot, he, q] using outer.1 - private theorem selected_slope : (by classical @@ -1202,8 +1137,9 @@ theorem P4418T3PresentedRowAdjacency : placement positive_parent area_of_band) selected_area have selected_circle : C'.1.1 = q (slot placement.centralIndex.label).succ := by exact hC'.trans (congrArg (fun j : Fin 3 => q j.succ) selected_slot) - have fixed_circle := PresentedRowAdjacencyGeometry.fixed_circle C - D T N h k x bundle placement row r i s outer + have fixed_circle : bundle.normalizedFixedCircle.1.1 = + q (slot placement.exteriorIndex.label).succ := by + cases he : placement.exteriorIndex.label <;> simpa [slot, he, q] using outer.1 have selected_slope : p - bundle.normalizedRootSlope = (if sign placement.centralIndex.label = true then (1 : ℝ) else -1) • ((1 / 2 : ℝ) • GaussianRealPoint diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean index 45a74900b3..e6a8a8ce45 100644 --- a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean +++ b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean @@ -733,107 +733,6 @@ private theorem commonEdgeForAdjacent : have hy : y + b - b = y := by abel have hx : y + b + a = x := by rw [h]; abel simpa [hy, hx] using rowEdge2 (y + b) -private theorem hcAt922 : - (by - classical - exact - ∀ (L : AddSubgroup GaussianInt), - ∀ (k : (Int × Int) ≃+ L), - ∀ (D : P4812T1AffineDrawing L k), - ∀ (T : ProtoTile), - let a : L := k (1, 0); - let b : L := k (0, 1); - ∀ (ru : GaussianInt), - ∀ (rd : GaussianInt), - ∀ (x : ↥L), - let rho : D.plane.Face → GaussianInt := fun f => - match D.faces.symm f with - | Sum.inl x => (ru : GaussianInt) + (x : GaussianInt) - | Sum.inr x => (rd : GaussianInt) + (x : GaussianInt); - ∀ (p0 : List GaussianInt), - ∀ (p1 : List GaussianInt), - ∀ (p2 : List GaussianInt), - let rowPath : Fin 3 → List GaussianInt := fun r => - if r = 0 then p0 else if r = 1 then p1 else p2; - (let path : - D.plane.Face → D.plane.Face → List GaussianInt := - RegularFaceWalkProof.regularFacePath L k D a b rowPath - (∀ (A : ProtoTile), - ∀ (B : ProtoTile), - ∀ (fc : D.plane.Face), - ∀ (gc : D.plane.Face), - ∀ (P : List GaussianInt), - (P4733T1ContainedWalk A B (rho fc) (rho gc) - P) → - ((path fc gc = P) → - ((path gc fc = P.reverse) → - (∀ (f : D.plane.Face), - ∀ (g : D.plane.Face), - ((f = fc ∧ g = gc) ∨ - (f = gc ∧ g = fc)) → - ((path f g).head? = - some (rho f) ∧ - (path f g).getLast? = - some (rho g) ∧ - (∀ z ∈ path f g, - z ∈ - FootprintVertices A ∩ - FootprintVertices - B) ∧ - ∀ x y : GaussianInt, - ∀ l₁ l₂ : - List GaussianInt, - path f g = - l₁ ++ - x :: y :: l₂ → - { x, y } ∈ - FootprintEdges A ∩ - FootprintEdges - B))))) → - (∀ (f : D.plane.Face), - ∀ (g : D.plane.Face), - let w := x; - let fc := D.faces (.inl w); - let gc := D.faces (.inr (w - b)); - (f = fc ∧ g = gc ∨ f = gc ∧ g = fc) → - ((path fc gc = - p1.map (fun z => z + (w : GaussianInt))) → - ((path gc fc = - (p1.map - (fun z => - z + (w : GaussianInt))).reverse) → - ((P4733T1ContainedWalk - (TileTranslation T (w : GaussianInt)) - (TileTranslation T - ((w - b : L) : GaussianInt)) - (rho fc) (rho gc) - (p1.map - (fun z => z + (w : GaussianInt)))) → - ((path f g).head? = some (rho f) ∧ - (path f g).getLast? = some (rho g) ∧ - (∀ z ∈ path f g, - z ∈ - FootprintVertices - (TileTranslation T ↑w) ∩ - FootprintVertices - (TileTranslation T - ↑(w - b))) ∧ - ∀ x' y' : GaussianInt, - ∀ l₁ l₂ : List GaussianInt, - path f g = - l₁ ++ x' :: y' :: l₂ → - { x', y' } ∈ - FootprintEdges - (TileTranslation T ↑w) ∩ - FootprintEdges - (TileTranslation T - ↑(w - b))))))))) := by - classical - intro L k D T a b ru rd x rho p0 p1 p2 rowPath path walkClaims f g w fc gc hpair hforward - hbackward hw - exact walkClaims (TileTranslation T (w : GaussianInt)) - (TileTranslation T ((w - b : L) : GaussianInt)) fc gc - (p1.map (fun z => z + (w : GaussianInt))) hw hforward hbackward f g hpair private theorem hdAt961 : (by classical @@ -1844,8 +1743,10 @@ private theorem secondBackward : ∀ x' y' : GaussianInt, ∀ l₁ l₂ : List GaussianInt, path f g = l₁ ++ x' :: y' :: l₂ → {x', y'} ∈ FootprintEdges (TileTranslation T ↑w) ∩ - FootprintEdges (TileTranslation T ↑(w - b)) := RegularFaceWalkProof.hcAt922 - L k D T ru rd x p0 p1 p2 walkClaims f g hpair hforward hbackward hw + FootprintEdges (TileTranslation T ↑(w - b)) := + walkClaims (TileTranslation T (w : GaussianInt)) + (TileTranslation T ((w - b : L) : GaussianInt)) fc gc + (p1.map (fun z => z + (w : GaussianInt))) hw hforward hbackward f g hpair rcases hc with ⟨hh, hl, hv, he⟩ refine ⟨hh, hl, ?_, ?_⟩ · intro z hz diff --git a/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean index 8310404514..1dc2bdfd8c 100644 --- a/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean @@ -625,55 +625,6 @@ private theorem coverShape : · subst z; simpa [LatticeVertexIncidentCell] using h 3 · subst z; simpa [LatticeVertexIncidentCell] using h 2 -private theorem hcoverOriginal : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ - : PartialOdometer), ∀ (x : GaussianInt), ((∀ (g : BandPackingSymmetry), ∀ (C : - CircleCoordinates), ∀ (C' : CircleCoordinates), ∀ (T : ProtoTile), ∀ (T' : - ProtoTile), ∀ (h : PartialOdometer), ∀ (h' : PartialOdometer), TileSubodometer C C' T - T' h h' ↔ TileSubodometer (BandPackingSymmetryCircleAction g C) - (BandPackingSymmetryCircleAction g C') (BandPackingSymmetryTileAction g T) - (BandPackingSymmetryTileAction g T') (BandPackingSymmetryPartialOdometerAction g h) - (BandPackingSymmetryPartialOdometerAction g h')) ∧ (∀ (g : BandPackingSymmetry), ∀ (x - : GaussianInt), ∀ (T : ProtoTile), ∀ (U : ProtoTile), (∀ (j : Fin (4 : ℕ)), - LatticeVertexIncidentCell x j ∈ T.cells ∨ LatticeVertexIncidentCell x j ∈ U.cells) ↔ - ∀ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell (BandPackingSymmetryVectorAction g x) - j ∈ (BandPackingSymmetryTileAction g T).cells ∨ LatticeVertexIncidentCell - (BandPackingSymmetryVectorAction g x) j ∈ (BandPackingSymmetryTileAction g U).cells) - ∧ ∀ (g : BandPackingSymmetry), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), - ProperBandQuadruple q → ∀ (i : Fin (3 : ℕ)), ∀ (s : Fin (4 : ℕ)), ∀ (delta : Bool), - BandPackingSymmetryScopedPhase g q delta → ∀ (T : ProtoTile), ∀ (x : GaussianInt), - let q' := BandPackingSymmetryQuadrupleAction g q; - let sigma := fun (j : Fin (3 : ℕ)) => if BandPackingSymmetryReversesOrientation g = true - then -j else j; - let s' := if BandPackingSymmetryReversesOrientation g = true then -s - (1 : Fin (4 : ℕ)) - + if delta = true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)) else s + if delta = - true then (2 : Fin (4 : ℕ)) else (0 : Fin (4 : ℕ)); - let oldRight := TileTranslation T ((⟨(0 : ℤ), (1 : ℤ)⟩ : GaussianInt) ^ (↑s : ℕ) * if - Even (↑s : ℕ) then BandVectors.1 (q (0 : Fin (4 : ℕ))) (q i.succ) else BandVectors.1 - (q i.succ) (q (0 : Fin (4 : ℕ)))); - let newRight := TileTranslation (BandPackingSymmetryTileAction g T) ((⟨(0 : ℤ), (1 : ℤ)⟩ - : GaussianInt) ^ (↑s' : ℕ) * if Even (↑s' : ℕ) then BandVectors.1 (q' (0 : Fin (4 : - ℕ))) (q' (sigma i).succ) else BandVectors.1 (q' (sigma i).succ) (q' (0 : Fin (4 : - ℕ)))); BandPackingSymmetryTileAction g oldRight = newRight ∧ (x ∈ FootprintVertices - oldRight ↔ BandPackingSymmetryVectorAction g x ∈ FootprintVertices newRight)) → (∀ - (bundle : BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), (∀ (a : - GaussianInt), ∀ (A : ProtoTile), ∀ (B : ProtoTile), (∀ z, z = a ∨ z = a - 1 ∨ z = a - - ⟨0, 1⟩ ∨ z = a - 1 - ⟨0, 1⟩ → z ∈ A.cells ∨ z ∈ B.cells) ↔ (∀ j : Fin 4, - LatticeVertexIncidentCell a j ∈ A.cells ∨ LatticeVertexIncidentCell a j ∈ B.cells)) → - ((∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ z = x - 1 - ⟨0, 1⟩ → z ∈ T.cells ∨ z ∈ - T₀.cells) ↔ (∀ z, z = bundle.normalizedPoint ∨ z = bundle.normalizedPoint - 1 ∨ z = - bundle.normalizedPoint - ⟨0, 1⟩ ∨ z = bundle.normalizedPoint - 1 - ⟨0, 1⟩ → z ∈ - bundle.normalizedRoot.cells ∨ z ∈ bundle.normalizedFixed.cells))) ) := by - classical - intro C T T₀ h h₀ x markedData bundle coverShape - rw [coverShape, coverShape] - simpa [bundle.normalized_point_eq, bundle.normalized_root_eq, - bundle.normalized_fixed_eq] using - (markedData.2.1 bundle.symmetry x T T₀) - private theorem hpointInverse : (by classical @@ -760,61 +711,6 @@ private theorem hmarkTransport : rw [hpointInverse] at hcompanionFootprint simpa [bundle.normalized_fixed_eq, htileL, ht'] using hcompanionFootprint -private theorem hmarkedOriginal : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ - : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (rightPlacement : - BandOrderedGeneralRightPlacement bundle.normalizedPresentation bundle.configuration - bundle.normalizedCircle bundle.normalizedRoot bundle.normalizedFixed - bundle.normalizedRootFunction bundle.normalizedFixedFunction bundle.normalizedPoint - bundle.pieces bundle.functions bundle.selectedSlot bundle.selectedSign - bundle.routedDirection), ((¬∀ (z : GaussianInt), z = bundle.normalizedPoint ∨ z = - bundle.normalizedPoint - (1 : GaussianInt) ∨ z = bundle.normalizedPoint - (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt) ∨ z = bundle.normalizedPoint - (1 : GaussianInt) - (⟨(0 : ℤ), - (1 : ℤ)⟩ : GaussianInt) → z ∈ bundle.normalizedRoot.cells ∨ z ∈ - bundle.normalizedFixed.cells) ↔ bundle.normalizedPoint ∈ FootprintVertices - (TileTranslation bundle.normalizedFixed ((if rightPlacement.rightNeighborPositive = - true then (-1 : GaussianInt) else (1 : GaussianInt)) * BandVectors.1 - (bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (bundle.normalizedPresentation - bundle.selectedSlot.succ)))) → (∀ (ginv : BandPackingSymmetry), ∀ (t' : Fin (4 : ℕ)), - ((∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ z = x - 1 - ⟨0, 1⟩ → z ∈ T.cells ∨ z ∈ - T₀.cells) ↔ (∀ z, z = bundle.normalizedPoint ∨ z = bundle.normalizedPoint - 1 ∨ z = - bundle.normalizedPoint - ⟨0, 1⟩ ∨ z = bundle.normalizedPoint - 1 - ⟨0, 1⟩ → z ∈ - bundle.normalizedRoot.cells ∨ z ∈ bundle.normalizedFixed.cells)) → ( - let oldRight := TileTranslation bundle.normalizedFixed - ((if rightPlacement.rightNeighborPositive = true then (-1 : GaussianInt) - else 1) * - BandVectors.1 (bundle.normalizedPresentation 0) - (bundle.normalizedPresentation bundle.selectedSlot.succ)) - (bundle.normalizedPoint ∈ FootprintVertices oldRight ↔ x ∈ FootprintVertices - (TileTranslation T₀ ((⟨0, 1⟩ : GaussianInt) ^ t'.val * (if Even t'.val then - BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv - bundle.normalizedPresentation) 0) ((BandPackingSymmetryQuadrupleAction ginv - bundle.normalizedPresentation) (if BandPackingSymmetryReversesOrientation ginv then - -bundle.selectedSlot else bundle.selectedSlot).succ) else BandVectors.1 - ((BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) (if - BandPackingSymmetryReversesOrientation ginv then -bundle.selectedSlot else - bundle.selectedSlot).succ) ((BandPackingSymmetryQuadrupleAction ginv - bundle.normalizedPresentation) 0))))) → ((¬ (∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ - ∨ z = x - 1 - ⟨0, 1⟩ → z ∈ T.cells ∨ z ∈ T₀.cells)) ↔ x ∈ FootprintVertices - (TileTranslation T₀ ((⟨0, 1⟩ : GaussianInt) ^ t'.val * (if Even t'.val then - BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv - bundle.normalizedPresentation) 0) ((BandPackingSymmetryQuadrupleAction ginv - bundle.normalizedPresentation) (if BandPackingSymmetryReversesOrientation ginv then - -bundle.selectedSlot else bundle.selectedSlot).succ) else BandVectors.1 - ((BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) (if - BandPackingSymmetryReversesOrientation ginv then -bundle.selectedSlot else - bundle.selectedSlot).succ) ((BandPackingSymmetryQuadrupleAction ginv - bundle.normalizedPresentation) 0))))))) ) := by - classical - intro C T T₀ h h₀ x bundle rightPlacement outerMarkingCriterion ginv t' hcoverOriginal oldRight - hmarkTransport - exact (not_congr hcoverOriginal).trans - (outerMarkingCriterion.trans hmarkTransport) - end MarkedRightAdjacencyGeometry theorem P5630T1MarkedRightOdometerAdjacencyReduction : @@ -976,8 +872,15 @@ theorem P5630T1MarkedRightOdometerAdjacencyReduction : have actionCurvature := BandPackingSymmetryCurvature.preserved have hsizeOriginal := MarkedRightAdjacencyGeometry.hsizeOriginal C T T₀ h h₀ x bundle C' hsize ginv hnorm actionCurvature hinverseProper hinversePositive hinverseCircle - have hcoverOriginal := MarkedRightAdjacencyGeometry.hcoverOriginal C T T₀ h h₀ x markedData - bundle (MarkedRightAdjacencyGeometry.coverShape) + have hcoverOriginal : + (∀ z, z = x ∨ z = x - 1 ∨ z = x - ⟨0, 1⟩ ∨ z = x - 1 - ⟨0, 1⟩ → + z ∈ T.cells ∨ z ∈ T₀.cells) ↔ + (∀ z, z = bundle.normalizedPoint ∨ z = bundle.normalizedPoint - 1 ∨ + z = bundle.normalizedPoint - ⟨0, 1⟩ ∨ z = bundle.normalizedPoint - 1 - ⟨0, 1⟩ → + z ∈ bundle.normalizedRoot.cells ∨ z ∈ bundle.normalizedFixed.cells) := by + rw [MarkedRightAdjacencyGeometry.coverShape, MarkedRightAdjacencyGeometry.coverShape] + simpa [bundle.normalized_point_eq, bundle.normalized_root_eq, + bundle.normalized_fixed_eq] using markedData.2.1 bundle.symmetry x T T₀ have hcompanionCov := markedData.2.2 ginv bundle.normalizedPresentation hq bundle.selectedSlot s delta hphaseInv bundle.normalizedFixed @@ -992,8 +895,7 @@ theorem P5630T1MarkedRightOdometerAdjacencyReduction : BandPackingSymmetryProperCovariance ginv bundle.normalizedPresentation hq, hrootCoord, hselectedCoord, hcentOriginal, hslopeReInv, hslopeImInv, hnewAdj, hxFixedOriginal, hxSelectedOriginal, hstarOriginal, - hsizeOriginal, (MarkedRightAdjacencyGeometry.hmarkedOriginal C T T₀ h h₀ x bundle - rightPlacement outerMarkingCriterion ginv t' hcoverOriginal + hsizeOriginal, (not_congr hcoverOriginal).trans (outerMarkingCriterion.trans (MarkedRightAdjacencyGeometry.hmarkTransport C T T₀ h h₀ x bundle rightPlacement s hcompanion ginv htileL delta t' ht' hcompanionFootprint (MarkedRightAdjacencyGeometry.hpointInverse C T T₀ h h₀ x bundle ginv hvecL hpoint)))⟩ From ae250f7fd37277509d05bcfffd55708abd106500 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 13 Nov 2026 19:09:19 +0000 Subject: [PATCH 22/23] Share frame algebra and boundary incidence proofs --- ...rderedGeneralRightSelectedRowGeometry.lean | 29 +- .../BoundaryFootprintInclusion.lean | 5 + .../FiniteSquareIncidenceIdentities.lean | 71 +- .../LatticeAdjacentInterfacePath.lean | 58 +- .../LatticeCellEdges.lean | 11 + .../OpposingBoundaryOdometerStrings.lean | 5 +- .../P4120T1GeneralDescent.lean | 28 +- .../P4250T2InterfaceNeighborCount.lean | 32 +- .../P4339T1PositivePrecursorRoots.lean | 35 +- .../P4418T3PresentedRowAdjacency.lean | 17 +- .../P4536T1AFrameD.lean | 1158 ++--------------- .../P4590T1JunctionRefinement.lean | 26 +- .../P4677T2FacePoints.lean | 55 +- .../P4812T1RegularFaceWalks.lean | 44 +- .../P5290T1EqualDiamondPaths.lean | 108 +- ...MarkedRightOdometerAdjacencyReduction.lean | 39 +- .../PeriodicTileTotalIndegree.lean | 89 +- 17 files changed, 204 insertions(+), 1606 deletions(-) diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean index 68398ec7c0..3d36574b99 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralRightSelectedRowGeometry.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnTranslation public import LeanPool.ApollonianSuperharmonic.ObservableTileRetargeting @@ -29,24 +31,6 @@ namespace ApollonianSuperharmonic namespace SelectedRowGeometry -private theorem edgeVertex : - (by - classical - exact - ∀ (tile : ProtoTile), (tile.cells.Nonempty) → (∀ (edge : Finset GaussianInt), (edge ∈ - FootprintEdges tile) → (∀ (point : GaussianInt), (point ∈ edge) → (point ∈ - FootprintVertices tile))) ) := by - classical - intro tile hnon edge hedge point hpoint - rcases hedge with ⟨a, ha, hshape⟩ - rcases hshape with hshape | hshape | hshape | hshape - all_goals rw [hshape] at hpoint - all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hpoint - all_goals simp only [FootprintVertices, ite_eq_left hnon, Set.mem_ofPred_eq] - all_goals rcases hpoint with hpoint | hpoint - all_goals rw [hpoint] - all_goals refine ⟨a, ha, ?_⟩; simp - private theorem turnOutgoing : (by classical @@ -2681,16 +2665,14 @@ private noncomputable def certificate normalized_point_eq := bundle.normalized_point_eq normalized_point_root_domain := by obtain ⟨edge, hp, he⟩ := bundle.edgeAtPoint - have hne := (LatticeTileGridStructure root bundle.root_lattice).1.1 - have hvert := SelectedRowGeometry.edgeVertex root hne edge he.1 bundle.normalizedPoint hp + have hvert := BoundaryFootprintInclusion.edgeVertex root edge he.1 bundle.normalizedPoint hp have hdom := PositiveCurvatureTileOdometerDomain (q 0) root bundle.normalizedRootFunction (ProperBandCurvatureStructure q cfg.proper).1 bundle.normalized_root_odometer exact (Set.ext_iff.mp hdom bundle.normalizedPoint).mpr hvert normalized_point_fixed_domain := by obtain ⟨edge, hp, he⟩ := bundle.edgeAtPoint - have hne := (LatticeTileGridStructure F bundle.fixed_lattice).1.1 - have hvert := SelectedRowGeometry.edgeVertex F hne edge he.2 bundle.normalizedPoint hp + have hvert := BoundaryFootprintInclusion.edgeVertex F edge he.2 bundle.normalizedPoint hp have hdom := PositiveCurvatureTileOdometerDomain bundle.normalizedCircle.1.1 F bundle.normalizedFixedFunction bundle.normalizedCircle.property placement.adjacency.2.1 @@ -4065,7 +4047,8 @@ theorem BandOrderedGeneralRightSelectedRowGeometry let q := bundle.normalizedPresentation let cfg := bundle.configuration let F := bundle.normalizedFixed - have edgeVertex := SelectedRowGeometry.edgeVertex + have edgeVertex := fun (T : ProtoTile) (_ : T.cells.Nonempty) => + BoundaryFootprintInclusion.edgeVertex T have childInterfaces := BandOrderedGeneralChildInterfaces q cfg bundle.normalizedCircle F placement.layout (TileT2QuarterTurn q cfg bundle.normalizedCircle F placement.layout) diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryFootprintInclusion.lean b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintInclusion.lean index fe42b90671..ab3fe5c698 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryFootprintInclusion.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryFootprintInclusion.lean @@ -92,6 +92,11 @@ theorem boundaryVertex : subst x simp [FootprintVertices, hne] +/-- Every boundary footprint vertex is a footprint vertex, including empty tiles. -/ +theorem boundaryVertex_mem (T : ProtoTile) (x : GaussianInt) + (hx : x ∈ BoundaryFootprintVertices T) : x ∈ FootprintVertices T := + boundaryVertex boundaryEdge edgeVertex T x hx + end BoundaryFootprintInclusion end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean b/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean index f541bd47a3..1a207ef048 100644 --- a/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean +++ b/LeanPool/ApollonianSuperharmonic/FiniteSquareIncidenceIdentities.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.LatticeCellEdges + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.PairAssignmentFacts public import LeanPool.ApollonianSuperharmonic.TileCornerMultiplicity @@ -355,67 +357,6 @@ private theorem hedgeIdentity : rw [hedgePartition, ← hedgeBagCard] at ⊢ omega -private abbrev pair_eq := - @PairAssignmentFacts.finsetPair GaussianInt inferInstance - -private theorem edgeOf_injective : - let I : GaussianInt := ⟨0, 1⟩ - let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => - if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} - (∀ {a : GaussianInt}, - ∀ {b : GaussianInt}, - ∀ {c : GaussianInt}, - ∀ {d : GaussianInt}, - ({ a, b } : Finset GaussianInt) = { c, d } → a = c ∧ b = d ∨ a = d ∧ b = c) → - Function.Injective edgeOf := by - classical - intro I edgeOf pair_eq - rintro ⟨z, b⟩ ⟨w, d⟩ h - cases b <;> cases d - · change ({z, z + 1} : Finset GaussianInt) = {w, w + 1} at h - replace h := pair_eq h - rcases h with ⟨h, _⟩ | ⟨h1, h2⟩ - · subst w; rfl - · exfalso - have h1r := congrArg Zsqrtd.re h1 - have h2r := congrArg Zsqrtd.re h2 - norm_num at h1r h2r - omega - · change ({z, z + 1} : Finset GaussianInt) = {w, w + I} at h - replace h := pair_eq h - rcases h with ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> exfalso - · have h1i := congrArg Zsqrtd.im h1 - have h2i := congrArg Zsqrtd.im h2 - dsimp only [I] at h1i h2i - norm_num at h1i h2i - omega - · have h1r := congrArg Zsqrtd.re h1 - have h2r := congrArg Zsqrtd.re h2 - norm_num at h1r h2r - omega - · change ({z, z + I} : Finset GaussianInt) = {w, w + 1} at h - replace h := pair_eq h - rcases h with ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> exfalso - · have h1r := congrArg Zsqrtd.re h1 - have h2r := congrArg Zsqrtd.re h2 - norm_num at h1r h2r - omega - · have h1i := congrArg Zsqrtd.im h1 - have h2i := congrArg Zsqrtd.im h2 - dsimp only [I] at h1i h2i - norm_num at h1i h2i - omega - · change ({z, z + I} : Finset GaussianInt) = {w, w + I} at h - replace h := pair_eq h - rcases h with ⟨h, _⟩ | ⟨h1, h2⟩ - · subst w; rfl - · exfalso - have h1i := congrArg Zsqrtd.im h1 - have h2i := congrArg Zsqrtd.im h2 - dsimp only [I] at h1i h2i - norm_num at h1i h2i - omega - private theorem hedgeSet : ∀ (T : ProtoTile), let I : GaussianInt := ⟨0, 1⟩ @@ -900,12 +841,8 @@ theorem FiniteSquareIncidenceIdentities (T : ProtoTile) (hne : T.cells.Nonempty) SquareIncidenceProof.hedgeIdentity T hedgeBagCard hedgeMultiplicity hedgePartition let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} - have pair_eq {a b c d : GaussianInt} - (h : ({a, b} : Finset GaussianInt) = {c, d}) : - (a = c ∧ b = d) ∨ (a = d ∧ b = c) := SquareIncidenceProof.pair_eq (a := a) (b := b) (c := - c) (d := d) h - have edgeOf_injective : Function.Injective edgeOf := SquareIncidenceProof.edgeOf_injective - pair_eq + have edgeOf_injective : Function.Injective edgeOf := + LatticeCellEdges.edge_encoding_injective have hedgeSet : ((edgeBag.toFinset.image edgeOf : Finset (Finset GaussianInt)) : Set (Finset GaussianInt)) = FootprintEdges T := SquareIncidenceProof.hedgeSet T diff --git a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean index a49d61ecb1..385b2b43a3 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeAdjacentInterfacePath.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.TileQuarterTurnTranslation public import LeanPool.ApollonianSuperharmonic.BandPrototileQuarterTurn @@ -49,60 +51,6 @@ private theorem incident_boundary : obtain ⟨j, hj⟩ := hu exact ⟨j, fun h => hd' hj h⟩ -private theorem boundary_subset_footprint : - (by - classical - exact - ∀ (T : ProtoTile), BoundaryFootprintVertices T ⊆ FootprintVertices T ) := by - classical - intro T x hx - by_cases hne : T.cells.Nonempty - · have hx' : ∃ e ∈ BoundaryFootprintEdges T, x ∈ e := by - simpa [BoundaryFootprintVertices, hne] using hx - obtain ⟨e, he, hxe⟩ := hx' - rcases he with ⟨z, ⟨rfl, hcross⟩ | ⟨rfl, hcross⟩⟩ - · rcases hcross with ⟨hz, _⟩ | ⟨_, hz⟩ - · change x ∈ FootprintVertices T - simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] - refine ⟨z, hz, ?_⟩ - rcases Finset.mem_insert.mp hxe with h | h - · subst x; exact Or.inl rfl - · have hxz : x = z + 1 := by simpa using h - subst x; exact Or.inr (Or.inl rfl) - · have hz' : z - ⟨0, 1⟩ ∈ T.cells := hz - change x ∈ FootprintVertices T - simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] - refine ⟨z - ⟨0, 1⟩, hz', ?_⟩ - rcases (Finset.mem_insert.mp hxe) with hxz | hxz - · subst x - exact Or.inr (Or.inr (Or.inl (by simp))) - · have : x = z + 1 := by simpa using hxz - subst x - exact Or.inr (Or.inr (Or.inr (by simp [sub_eq_add_neg, add_comm, add_left_comm]))) - · rcases hcross with ⟨hz, _⟩ | ⟨_, hz⟩ - · change x ∈ FootprintVertices T - simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] - refine ⟨z, hz, ?_⟩ - rcases (Finset.mem_insert.mp hxe) with hxz | hxz - · subst x - exact Or.inl rfl - · have : x = z + ⟨0, 1⟩ := by simpa using hxz - subst x - exact Or.inr (Or.inr (Or.inl rfl)) - · have hz' : z - 1 ∈ T.cells := hz - change x ∈ FootprintVertices T - simp only [FootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] - refine ⟨z - 1, hz', ?_⟩ - rcases (Finset.mem_insert.mp hxe) with hxz | hxz - · subst x - exact Or.inr (Or.inl (by simp)) - · have : x = z + ⟨0, 1⟩ := by simpa using hxz - subst x - exact Or.inr (Or.inr (Or.inr (by simp [sub_eq_add_neg, add_comm, add_left_comm]))) - · simp only [BoundaryFootprintVertices, hne, ↓reduceIte, Set.mem_singleton_iff, - FootprintVertices] at hx ⊢ - exact hx - private theorem touching_path : (by classical @@ -648,7 +596,7 @@ theorem LatticeAdjacentInterfacePath : LatticeInterfacePathGeometry.incident_boundary U V x hd hu hv have boundary_subset_footprint (T : ProtoTile) : BoundaryFootprintVertices T ⊆ FootprintVertices T := - LatticeInterfacePathGeometry.boundary_subset_footprint T + BoundaryFootprintInclusion.boundaryVertex_mem T have touching_path (U V : ProtoTile) (hU : U.cells.Nonempty) (hV : V.cells.Nonempty) (ht : TileTouching U V) : ∃ x y, SimpleGridPathBetween diff --git a/LeanPool/ApollonianSuperharmonic/LatticeCellEdges.lean b/LeanPool/ApollonianSuperharmonic/LatticeCellEdges.lean index c9234c2ab8..aa776b576a 100644 --- a/LeanPool/ApollonianSuperharmonic/LatticeCellEdges.lean +++ b/LeanPool/ApollonianSuperharmonic/LatticeCellEdges.lean @@ -77,6 +77,17 @@ theorem horizontal_ne_vertical (x y : GaussianInt) : simp at hre him hre1 him1 omega +/-- A lattice edge has a unique base point and horizontal/vertical direction tag. -/ +theorem edge_encoding_injective : + Function.Injective (fun p : GaussianInt × Bool => + if p.2 then ({p.1, p.1 + ⟨0, 1⟩} : Finset GaussianInt) else {p.1, p.1 + 1}) := by + rintro ⟨z, b⟩ ⟨w, d⟩ h + cases b <;> cases d + · exact Prod.ext (horizontal_unique z w h) rfl + · exact (horizontal_ne_vertical z w h).elim + · exact (horizontal_ne_vertical w z h.symm).elim + · exact Prod.ext (vertical_unique z w h) rfl + end ApollonianSuperharmonic.LatticeCellEdges end diff --git a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean index 6d7680783a..e2da45ca21 100644 --- a/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean +++ b/LeanPool/ApollonianSuperharmonic/OpposingBoundaryOdometerStrings.lean @@ -1862,8 +1862,9 @@ private theorem opposingBoundaryConclusion : (fun h g => g = PartialOdometerAffineTranslate (PartialOdometerHalfTurn h) centerShift (-couter) (-eouter)) ((hs.drop 1).dropLast) ((gs.drop 1).dropLast) := by - rw [hgsTail] - simpa only [List.drop_one] using interiorTransforms 1 hs.tail (by omega) htailLength + exact (congrArg List.dropLast (List.drop_one (l := hs))).symm ▸ + ((congrArg List.dropLast hgsTail).symm ▸ + interiorTransforms 1 hs.tail (by omega) htailLength) have hinteriorZip : List.Forall₂ (fun X Y => cellRelation X.1 Y.1 ∧ Y.2 = PartialOdometerAffineTranslate diff --git a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean index 850c0bb038..bab9dc1727 100644 --- a/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean +++ b/LeanPool/ApollonianSuperharmonic/P4120T1GeneralDescent.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties public import LeanPool.ApollonianSuperharmonic.InteriorFootprintIncidence @@ -274,29 +276,6 @@ private theorem edge_support : · refine Or.inr (Or.inl ⟨?_, Or.inr rfl⟩) simp [I, add_comm, add_left_comm] -private theorem boundary_edge_is_footprint : - (by - classical - exact - let I : GaussianInt := ⟨0, 1⟩ - (∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ({z, z + I} ∈ FootprintEdges U)) - → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ({z + 1, z + 1 + I} ∈ - FootprintEdges U)) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) → ({z, - z + 1} ∈ FootprintEdges U)) → ((∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ U.cells) - → ({z + I, z + 1 + I} ∈ FootprintEdges U)) → (∀ (U : ProtoTile), ∀ (e : Finset - GaussianInt), (e ∈ BoundaryFootprintEdges U) → (e ∈ FootprintEdges U))))) ) := by - classical - intro I cell_edge_vleft cell_edge_vright cell_edge_hbottom cell_edge_htop U e he - rcases he with ⟨z, ⟨rfl, hside⟩ | ⟨rfl, hside⟩⟩ - · rcases hside with ⟨hz, _⟩ | ⟨_, hz⟩ - · exact cell_edge_hbottom U z hz - · have hz' := cell_edge_htop U (z - I) hz - simpa [I, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hz' - · rcases hside with ⟨hz, _⟩ | ⟨_, hz⟩ - · exact cell_edge_vleft U z hz - · have hz' := cell_edge_vright U (z - 1) hz - simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hz' - private theorem parent_boundary_incident_cell : (by classical @@ -1473,8 +1452,7 @@ theorem P4120T1GeneralDescent (cert.P i s).cells.Nonempty := (LatticeTileGridStructure _ (cert.parent_lattice i s)).1.1 have parent_boundary_incident_cell := GeneralDescentGeometry.parent_boundary_incident_cell q - cfg C T cert x edge_support (GeneralDescentGeometry.boundary_edge_is_footprint - cell_edge_vleft cell_edge_vright cell_edge_hbottom cell_edge_htop) parent_cells_nonempty + cfg C T cert x edge_support (BoundaryFootprintInclusion.boundaryEdge) parent_cells_nonempty have pair_left_mem {a b c d : GaussianInt} (h : ({a, b} : Finset GaussianInt) = {c, d}) := GeneralDescentGeometry.pair_left_mem (a := a) (b := b) (c := c) (d := d) h diff --git a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean index 8a70de3dfb..8fa22ad9c1 100644 --- a/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean +++ b/LeanPool/ApollonianSuperharmonic/P4250T2InterfaceNeighborCount.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion + public import LeanPool.ApollonianSuperharmonic.AdjacentCellInterior public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence @@ -88,34 +90,6 @@ private theorem full_iff : add_assoc, add_comm, add_left_comm] using hall 2) · exact hw.1 (by simpa [LatticeVertexIncidentCell] using hall 3) -private theorem boundary_foot : - (by - classical - exact - (∀ (U : ProtoTile), ∀ (z : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell z j ∈ - U.cells) → (z ∈ FootprintVertices U)) → (∀ (U : ProtoTile), ∀ (z : GaussianInt), (z ∈ - BoundaryFootprintVertices U) → (z ∈ FootprintVertices U)) ) := by - classical - intro incident_foot U z hz - as_aux_lemma => - by_cases hne : U.cells.Nonempty - · rw [BoundaryFootprintVertices, ite_eq_left hne] at hz - rcases hz with ⟨e, ⟨w, (⟨rfl, hw⟩ | ⟨rfl, hw⟩)⟩, hze⟩ - all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hze - · rcases hze with rfl | rfl <;> rcases hw with hw | hw - · exact incident_foot U _ 0 hw.1 - · exact incident_foot U _ 3 (by simpa [LatticeVertexIncidentCell] using hw.2) - · exact incident_foot U (w + 1) 1 (by simpa [LatticeVertexIncidentCell] using hw.1) - · exact incident_foot U (w + 1) 2 (by simpa [LatticeVertexIncidentCell, sub_sub] using - hw.2) - · rcases hze with rfl | rfl <;> rcases hw with hw | hw - · exact incident_foot U _ 0 hw.1 - · exact incident_foot U _ 1 (by simpa [LatticeVertexIncidentCell] using hw.2) - · exact incident_foot U (w + ⟨0, 1⟩) 3 (by simpa [LatticeVertexIncidentCell] using hw.1) - · exact incident_foot U (w + ⟨0, 1⟩) 2 (by simpa [LatticeVertexIncidentCell, - sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hw.2) - · simpa [FootprintVertices, BoundaryFootprintVertices, hne] using hz - private theorem edge_endpoint : (by classical @@ -1487,7 +1461,7 @@ theorem P4250T2InterfaceNeighborCount : have foot_incident := fun (U : ProtoTile) (hne : U.cells.Nonempty) (z : GaussianInt) => LatticeFootprintIncidence.incidentCell U z hne have full_iff := InterfaceNeighborGeometry.full_iff incident_foot foot_incident - have boundary_foot := InterfaceNeighborGeometry.boundary_foot incident_foot + have boundary_foot := BoundaryFootprintInclusion.boundaryVertex_mem have hOA := InterfaceNeighborGeometry.hOA C q cfg T cert have hOB := InterfaceNeighborGeometry.hOB C q cfg T cert have hsep := BandOriginalPairSeparation cert.P cert.O cert.u cert.v hOA hOB cert.partition diff --git a/LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean b/LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean index fc41b6c4f6..e9c2148599 100644 --- a/LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean +++ b/LeanPool/ApollonianSuperharmonic/P4339T1PositivePrecursorRoots.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence @@ -190,35 +192,6 @@ private theorem hOB : intro C q cfg T cert z hz exact (cert.minus_union z).mpr ⟨0, true, by rw [← cert.precursor_cells]; exact hz⟩ -private theorem incident_footprint : - (by - classical - exact - ∀ (U : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), (LatticeVertexIncidentCell x j ∈ - U.cells) → (x ∈ FootprintVertices U) ) := by - classical - intro U x j hj - have hn : U.cells.Nonempty := ⟨_, hj⟩ - rw [FootprintVertices, ite_eq_left hn] - refine ⟨LatticeVertexIncidentCell x j, hj, ?_⟩ - fin_cases j <;> simp [LatticeVertexIncidentCell, sub_eq_add_neg, - add_comm, add_left_comm, add_assoc] - -private theorem boundary_footprint : - (by - classical - exact - (∀ (U : ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ - BoundaryFootprintVertices U) → (∃ j : Fin 4, LatticeVertexIncidentCell x j ∈ - U.cells))) → ((∀ (U : ProtoTile), ∀ (x : GaussianInt), ∀ (j : Fin 4), - (LatticeVertexIncidentCell x j ∈ U.cells) → (x ∈ FootprintVertices U)) → (∀ (U : - ProtoTile), ∀ (x : GaussianInt), (U.cells.Nonempty) → ((x ∈ BoundaryFootprintVertices - U) → (x ∈ FootprintVertices U)))) ) := by - classical - intro boundary_incident incident_footprint U x hn hb - obtain ⟨j, hj⟩ := boundary_incident U x hn hb - exact incident_footprint U x j hj - private theorem haPlus : (by classical @@ -816,8 +789,8 @@ theorem P4339T1PositivePrecursorRoots (PositivePrecursorGeometry.hallT C q cfg T cert hallAB) have hOA := PositivePrecursorGeometry.hOA C q cfg T cert have hOB := PositivePrecursorGeometry.hOB C q cfg T cert - have boundary_footprint := PositivePrecursorGeometry.boundary_footprint boundary_incident - (PositivePrecursorGeometry.incident_footprint) + have boundary_footprint := fun (U : ProtoTile) (x : GaussianInt) + (_ : U.cells.Nonempty) => BoundaryFootprintInclusion.boundaryVertex_mem U x have hbranch := cert.precursorBoundary.branch rcases hbranch with ⟨_, plusArc, minusArc, _, _, hplusHead, hplusLast, hminusHead, hminusLast, hplusSet, hminusSet, _, _, hunion, hinter, _, _⟩ | hdeg diff --git a/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean b/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean index c4bceaaf66..6ea05ee716 100644 --- a/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean +++ b/LeanPool/ApollonianSuperharmonic/P4418T3PresentedRowAdjacency.lean @@ -28,6 +28,18 @@ namespace ApollonianSuperharmonic namespace PresentedRowAdjacencyGeometry +private theorem exteriorSlot (label : SixSubtileLabel) : + (match label with + | .A | .B => (1 : Fin 4) + | .C | .D => 2 + | .E | .F => 3) = + (match label with + | .A | .B => (0 : Fin 3) + | .C | .D => 1 + | .E | .F => 2).succ := by + cases label <;> rfl + + private theorem selected_cells : (by classical @@ -1138,8 +1150,9 @@ theorem P4418T3PresentedRowAdjacency : have selected_circle : C'.1.1 = q (slot placement.centralIndex.label).succ := by exact hC'.trans (congrArg (fun j : Fin 3 => q j.succ) selected_slot) have fixed_circle : bundle.normalizedFixedCircle.1.1 = - q (slot placement.exteriorIndex.label).succ := by - cases he : placement.exteriorIndex.label <;> simpa [slot, he, q] using outer.1 + q (slot placement.exteriorIndex.label).succ := + outer.1.trans (congrArg q (PresentedRowAdjacencyGeometry.exteriorSlot + placement.exteriorIndex.label)) have selected_slope : p - bundle.normalizedRootSlope = (if sign placement.centralIndex.label = true then (1 : ℝ) else -1) • ((1 / 2 : ℝ) • GaussianRealPoint diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean index f83b80114b..ebfbbb1973 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean @@ -27,431 +27,38 @@ namespace ApollonianSuperharmonic namespace FrameDiagonalProof -private theorem hrAt128 : - ∀ (C : BandCircle), - ∀ (orientation : Bool), - ∀ (base : ProtoTile), - ∀ (Rminus : ProtoTile), - ∀ (Rplus : ProtoTile), - ∀ (hminus : PartialOdometer), - ∀ (hplus : PartialOdometer), - ∀ (F : P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), - ∀ (a : Fin 3), - F.slot = a + 2 → - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - ProperBandQuadruple r := by - classical - intro C orientation base Rminus Rplus hminus hplus F a hslot r +private theorem properRotation (q : Fin 4 → CircleCoordinates) + (hq : ProperBandQuadruple q) (a : Fin 3) : + let r : Fin 4 → CircleCoordinates := ![q 0, q a.succ, q (a + 1).succ, q (a + 2).succ] + ProperBandQuadruple r := by + intro r fin_cases a - · have heq : r = F.q := by + · have heq : r = q := by funext j fin_cases j <;> rfl rw [heq] - exact F.proper - · refine ⟨SemiProperQuadruple.rotate F.proper.1, ?_⟩ - have heq : r = ![F.q 0, F.q 2, F.q 3, F.q 1] := by + exact hq + · refine ⟨SemiProperQuadruple.rotate hq.1, ?_⟩ + have heq : r = ![q 0, q 2, q 3, q 1] := by funext k fin_cases k <;> rfl rw [heq] intro j fin_cases j - · exact F.proper.2 1 - · exact F.proper.2 2 - · exact F.proper.2 0 - · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate F.proper.1), ?_⟩ - have heq : r = ![F.q 0, F.q 3, F.q 1, F.q 2] := by + · exact hq.2 1 + · exact hq.2 2 + · exact hq.2 0 + · refine ⟨SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hq.1), ?_⟩ + have heq : r = ![q 0, q 3, q 1, q 2] := by funext k fin_cases k <;> rfl rw [heq] intro j fin_cases j - · exact F.proper.2 2 - · exact F.proper.2 0 - · exact F.proper.2 1 - -private theorem hrstep : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), (![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = - ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p - 3).2 - (p 1).2), p 0, p 2, p 3]) → ( - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, - 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p hstep r - simpa [r] using hstep - -private theorem r1 : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p - 3).2 - (p 1).2), p 0, p 2, p 3]) → (r 1 = p 0) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p r hrstep - simpa using congrFun hrstep 1 - -private theorem r2 : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p - 3).2 - (p 1).2), p 0, p 2, p 3]) → (r 2 = p 2) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p r hrstep - simpa using congrFun hrstep 2 - -private theorem r3 : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p - 3).2 - (p 1).2), p 0, p 2, p 3]) → (r 3 = p 3) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p r hrstep - simpa using congrFun hrstep 3 - -private theorem hparent : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), (![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = - ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p - 3).2 - (p 1).2), p 0, p 2, p 3]) → ((F.slot = a + 2) → (F.q (F.slot).succ = p 3)) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p hstep hslot - have hqE : F.q (a + 2).succ = p 3 := by - have h := congrFun hstep 3 - simpa using h - rw [hslot] - exact hqE - -private theorem hparentR : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (r 3 = p 3) → ((F.q (F.slot).succ = p 3) → (F.q F.slot.succ = r 3)) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p r r3 hparent - exact hparent.trans r3.symm - -private theorem hzero : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - F.q 0 = r 0 := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r - exact rfl - -private theorem hC : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (p : Fin 4 → - CircleCoordinates), (F.q (F.slot).succ = p 3) → (C.1.1 = p 3) := by - classical - intro C orientation base Rminus Rplus hminus hplus F p hparent - exact F.parent.symm.trans hparent - -private theorem positiveA : - ∀ (p : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → (0 < (p 0).1) := by - classical - intro p hp - exact (ProperBandCurvatureStructure p hp).1 - -private theorem laws : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (ProperBandQuadruple r) → (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + - BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ - BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + - BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - - { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : - ℕ))) ∧ - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + - { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 - : ℕ))) ∧ - (ProperBandQuadruple r → - ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) (r j.succ) = - { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = - -{ re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (r j.succ) (r (0 : Fin (4 : - ℕ))))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r hr - exact VectorRecursionLaws r hr.1 - -private theorem hrr : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (ProperBandQuadruple r) → ( - let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] - ProperBandQuadruple rr) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r hr rr - have hrot := SemiProperQuadruple.rotate (SemiProperQuadruple.rotate hr.1) - refine ⟨hrot, ?_⟩ - intro j - fin_cases j - · simpa [rr] using hr.2 2 - · simpa [rr] using hr.2 0 - · simpa [rr] using hr.2 1 - -private theorem lawsR : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] - (ProperBandQuadruple rr) → (BandVectors.1 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + - BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + - BandVectors.1 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ - BandVectors.2 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + - BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + - BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ - BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) = - BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) - - { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 - : ℕ))) ∧ - BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) = - BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + - { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin - (4 : ℕ))) ∧ - (ProperBandQuadruple rr → - ∀ (j : Fin (3 : ℕ)), BandVectors.1 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = - { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (rr j.succ) (rr (0 : Fin (4 : - ℕ))) ∧ - BandVectors.2 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = - -{ re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (rr j.succ) (rr (0 : Fin (4 : - ℕ))))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r rr hrr - exact VectorRecursionLaws rr hrr.1 - -private theorem win : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let wv := BandVectors.1 (r 3) (r 2) - let xv := BandVectors.1 (r 1) (r 3) - let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] - (BandVectors.1 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + BandVectors.1 (rr (1 : Fin (4 - : ℕ))) (rr (3 : Fin (4 : ℕ))) + BandVectors.1 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : - ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + - BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + BandVectors.2 (rr (2 : Fin - (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (rr (1 : Fin (4 : - ℕ))) (rr (0 : Fin (4 : ℕ))) = BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) - - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ - BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) = BandVectors.2 (rr (1 : Fin - (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (rr (2 : Fin (4 : - ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple rr → ∀ (j : Fin (3 : ℕ)), - BandVectors.1 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (rr - j.succ) (rr (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = -⟨(0 - : ℤ), (1 : ℤ)⟩ * BandVectors.2 (rr j.succ) (rr (0 : Fin (4 : ℕ))))) → (BandVectors.1 (r - 3) (r 0) = wv - I * xv) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r I wv xv rr lawsR - simpa [rr, wv, xv, I] using lawsR.2.2.1 - -private theorem ain : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let wa := BandVectors.2 (r 3) (r 2) - let xa := BandVectors.2 (r 1) (r 3) - let rr : Fin 4 → CircleCoordinates := ![r 0, r 3, r 1, r 2] - (BandVectors.1 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + BandVectors.1 (rr (1 : Fin (4 - : ℕ))) (rr (3 : Fin (4 : ℕ))) + BandVectors.1 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : - ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (rr (3 : Fin (4 : ℕ))) (rr (2 : Fin (4 : ℕ))) + - BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + BandVectors.2 (rr (2 : Fin - (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (rr (1 : Fin (4 : - ℕ))) (rr (0 : Fin (4 : ℕ))) = BandVectors.1 (rr (1 : Fin (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) - - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (rr (2 : Fin (4 : ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ - BandVectors.2 (rr (1 : Fin (4 : ℕ))) (rr (0 : Fin (4 : ℕ))) = BandVectors.2 (rr (1 : Fin - (4 : ℕ))) (rr (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (rr (2 : Fin (4 : - ℕ))) (rr (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple rr → ∀ (j : Fin (3 : ℕ)), - BandVectors.1 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (rr - j.succ) (rr (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (rr (0 : Fin (4 : ℕ))) (rr j.succ) = -⟨(0 - : ℤ), (1 : ℤ)⟩ * BandVectors.2 (rr j.succ) (rr (0 : Fin (4 : ℕ))))) → (BandVectors.2 (r - 3) (r 0) = wa + I * xa) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r I wa xa rr lawsR - simpa [rr, wa, xa, I] using lawsR.2.2.2.1 + · exact hq.2 2 + · exact hq.2 0 + · exact hq.2 1 -private theorem hv : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let wv := BandVectors.1 (r 3) (r 2) - let xv := BandVectors.1 (r 1) (r 3) - let yv := BandVectors.1 (r 2) (r 1) - (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : - ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 - : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r - (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 - (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : - Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : - ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) - (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r - j.succ) (r (0 : Fin (4 : ℕ))))) → (-(wv - I * wv) - (xv - I * yv - I * (xv - I * yv)) = - (2 : GaussianInt) * yv ∧ - xv - I * yv + I * (xv - I * yv) + (wv - I * wv) = (2 : GaussianInt) * I * xv ∧ - -(xv - I * xv) - (wv - I * wv) = yv - I * yv ∧ - yv - I * wv + I * (yv - I * wv) - (wv - I * wv) = yv + I * yv ∧ - wv - I * xv - I * (wv - I * xv) - (wv - I * wv) = -I * xv - xv ∧ - -(yv - I * yv) - (wv - I * wv) = -I * xv + xv ∧ - yv - I * wv - I * (yv - I * wv) - (yv - I * yv) = -I * wv - wv ∧ - -(xv - I * xv) - (yv - I * yv) = -I * wv + wv ∧ - -(yv - I * yv) - (xv - I * xv) = wv - I * wv ∧ - wv - I * xv + I * (wv - I * xv) - (xv - I * xv) = wv + I * wv) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r I wv xv yv laws - exact P4536T1EndpointAlgebra I wv xv yv (by decide +kernel) laws.1 - -private theorem ha : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let wa := BandVectors.2 (r 3) (r 2) - let xa := BandVectors.2 (r 1) (r 3) - let ya := BandVectors.2 (r 2) (r 1) - (BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + BandVectors.1 (r (1 : Fin (4 : - ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.2 (r (2 : Fin (4 - : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.1 (r (1 : Fin (4 : ℕ))) (r - (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : - ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 - (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : - Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : - ℕ))) ∧ (ProperBandQuadruple r → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) - (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r - j.succ) (r (0 : Fin (4 : ℕ))))) → (-(wa - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) - = (2 : GaussianInt) * ya ∧ - xa - -I * ya + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ - -(xa - -I * xa) - (wa - -I * wa) = ya - -I * ya ∧ - ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = ya + -I * ya ∧ - wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ - -(ya - -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ - ya - -I * wa - -I * (ya - -I * wa) - (ya - -I * ya) = - -I * wa - wa ∧ - -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ - -(ya - -I * ya) - (xa - -I * xa) = wa - -I * wa ∧ - wa - -I * xa + -I * (wa - -I * xa) - (xa - -I * xa) = wa + -I * wa) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r I wa xa ya laws - exact P4536T1EndpointAlgebra (-I) wa xa ya (by decide +kernel) laws.2.1 - -private theorem vflip : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (ProperBandQuadruple r) → ((BandVectors.1 (r (3 : Fin (4 : ℕ))) (r (2 : Fin (4 : ℕ))) + - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + BandVectors.1 (r (2 : Fin (4 - : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ BandVectors.2 (r (3 : Fin (4 : ℕ))) (r - (2 : Fin (4 : ℕ))) + BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + - BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.1 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = BandVectors.1 (r (1 : Fin (4 - : ℕ))) (r (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (r (2 : Fin (4 : ℕ))) - (r (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (0 : Fin (4 : ℕ))) = - BandVectors.2 (r (1 : Fin (4 : ℕ))) (r (3 : Fin (4 : ℕ))) + ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.2 (r (2 : Fin (4 : ℕ))) (r (1 : Fin (4 : ℕ))) ∧ (ProperBandQuadruple r → ∀ (j - : Fin (3 : ℕ)), BandVectors.1 (r (0 : Fin (4 : ℕ))) (r j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.1 (r j.succ) (r (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (r (0 : Fin (4 : ℕ))) (r - j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (r j.succ) (r (0 : Fin (4 : ℕ))))) → - (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = - { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin - (4 : ℕ))) ∧ - BandVectors.2 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = - -{ re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : - Fin (4 : ℕ))))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r hr laws - exact (laws.2.2.2.2 hr) 2 - -private theorem vflip' : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (r - (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 - (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → (BandVectors.1 (r 0) (r 3) = I - * BandVectors.1 (r 3) (r 0)) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r I vflip - simpa using vflip.1 - -private theorem aflip' : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - (BandVectors.1 (r (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.1 (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (r - (0 : Fin (4 : ℕ))) (r (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 - (r (Fin.succ (2 : Fin (3 : ℕ)))) (r (0 : Fin (4 : ℕ)))) → (BandVectors.2 (r 0) (r 3) = -I - * BandVectors.2 (r 3) (r 0)) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r I aflip - simpa using aflip.2 private theorem centMinus : ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ @@ -570,415 +177,6 @@ private theorem halfDiff : (1 / 2 : ℝ) * (Z.im : ℝ) linarith -private theorem hcentR : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let wv := BandVectors.1 (r 3) (r 2) - let xv := BandVectors.1 (r 1) (r 3) - let yv := BandVectors.1 (r 2) (r 1) - (-(wv - I * wv) - (xv - I * yv - I * (xv - I * yv)) = (2 : GaussianInt) * yv ∧ xv - I * yv + - I * (xv - I * yv) + (wv - I * wv) = (2 : GaussianInt) * I * xv ∧ -(xv - I * xv) - (wv - I - * wv) = yv - I * yv ∧ yv - I * wv + I * (yv - I * wv) - (wv - I * wv) = yv + I * yv ∧ wv - - I * xv - I * (wv - I * xv) - (wv - I * wv) = -I * xv - xv ∧ -(yv - I * yv) - (wv - I * - wv) = -I * xv + xv ∧ yv - I * wv - I * (yv - I * wv) - (yv - I * yv) = -I * wv - wv ∧ - -(xv - I * xv) - (yv - I * yv) = -I * wv + wv ∧ -(yv - I * yv) - (xv - I * xv) = wv - I * - wv ∧ wv - I * xv + I * (wv - I * xv) - (xv - I * xv) = wv + I * wv) → ((TileCentroid - Rminus - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint ((wv - I * xv) - I * (wv - - I * xv))) → ((TileCentroid (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • - GaussianRealPoint (wv - I * wv)) → ((∀ {X : GaussianInt}, ∀ {Y : GaussianInt}, ∀ - {Z : GaussianInt}, (X - Y = Z) → ((1 / 2 : ℝ) • GaussianRealPoint X - (1 / 2 : ℝ) • - GaussianRealPoint Y = (1 / 2 : ℝ) • GaussianRealPoint Z)) → (TileCentroid Rminus - - TileCentroid (D.tiles a true) = - (1 / 2 : ℝ) • GaussianRealPoint (-I * xv - xv))))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D a r I wv xv yv hv centMinus centK halfDiff - calc - _ = (TileCentroid Rminus - TileCentroid F.tile) - - (TileCentroid (D.tiles a true) - TileCentroid F.tile) := by abel - _ = _ := by rw [centMinus, centK]; exact halfDiff hv.2.2.2.2.1 - -private theorem hcentJ : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (J : ProtoTile), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let wv := BandVectors.1 (r 3) (r 2) - let xv := BandVectors.1 (r 1) (r 3) - let yv := BandVectors.1 (r 2) (r 1) - (-(wv - I * wv) - (xv - I * yv - I * (xv - I * yv)) = (2 : GaussianInt) * yv ∧ xv - I * yv + - I * (xv - I * yv) + (wv - I * wv) = (2 : GaussianInt) * I * xv ∧ -(xv - I * xv) - (wv - I - * wv) = yv - I * yv ∧ yv - I * wv + I * (yv - I * wv) - (wv - I * wv) = yv + I * yv ∧ wv - - I * xv - I * (wv - I * xv) - (wv - I * wv) = -I * xv - xv ∧ -(yv - I * yv) - (wv - I * - wv) = -I * xv + xv ∧ yv - I * wv - I * (yv - I * wv) - (yv - I * yv) = -I * wv - wv ∧ - -(xv - I * xv) - (yv - I * yv) = -I * wv + wv ∧ -(yv - I * yv) - (xv - I * xv) = wv - I * - wv ∧ wv - I * xv + I * (wv - I * xv) - (xv - I * xv) = wv + I * wv) → ((TileCentroid J - - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(yv - I * yv))) → ((TileCentroid - (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (wv - I * wv)) → - ((∀ {X : GaussianInt}, ∀ {Y : GaussianInt}, ∀ {Z : GaussianInt}, (X - Y = Z) → ((1 / 2 : - ℝ) • GaussianRealPoint X - (1 / 2 : ℝ) • GaussianRealPoint Y = (1 / 2 : ℝ) • - GaussianRealPoint Z)) → (TileCentroid J - TileCentroid (D.tiles a true) = - (1 / 2 : ℝ) • GaussianRealPoint (-I * xv + xv))))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D a J r I wv xv yv hv centJ centK halfDiff - calc - _ = (TileCentroid J - TileCentroid F.tile) - - (TileCentroid (D.tiles a true) - TileCentroid F.tile) := by abel - _ = _ := by rw [centJ, centK]; exact halfDiff hv.2.2.2.2.2.1 - -private theorem lawsP : - ∀ (p : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → (BandVectors.1 (p (3 : Fin (4 : - ℕ))) (p (2 : Fin (4 : ℕ))) + BandVectors.1 (p (1 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) + - BandVectors.1 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ - BandVectors.2 (p (3 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))) + - BandVectors.2 (p (1 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) + - BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 : ℕ))) = - (0 : GaussianInt) ∧ - BandVectors.1 (p (1 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) = - BandVectors.1 (p (1 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) - - { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 : - ℕ))) ∧ - BandVectors.2 (p (1 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) = - BandVectors.2 (p (1 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) + - { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 - : ℕ))) ∧ - (ProperBandQuadruple p → - ∀ (j : Fin (3 : ℕ)), BandVectors.1 (p (0 : Fin (4 : ℕ))) (p j.succ) = - { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (p j.succ) (p (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (p (0 : Fin (4 : ℕ))) (p j.succ) = - -{ re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (p j.succ) (p (0 : Fin (4 : - ℕ))))) := by - classical - intro p hp - exact VectorRecursionLaws p hp.1 - -private theorem pflip : - ∀ (p : Fin 4 → CircleCoordinates), (ProperBandQuadruple p) → ((BandVectors.1 (p (3 : Fin (4 : - ℕ))) (p (2 : Fin (4 : ℕ))) + BandVectors.1 (p (1 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) + - BandVectors.1 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 : ℕ))) = (0 : GaussianInt) ∧ - BandVectors.2 (p (3 : Fin (4 : ℕ))) (p (2 : Fin (4 : ℕ))) + BandVectors.2 (p (1 : Fin (4 - : ℕ))) (p (3 : Fin (4 : ℕ))) + BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 : ℕ))) - = (0 : GaussianInt) ∧ BandVectors.1 (p (1 : Fin (4 : ℕ))) (p (0 : Fin (4 : ℕ))) = - BandVectors.1 (p (1 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) - ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.1 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 : ℕ))) ∧ BandVectors.2 (p (1 : Fin (4 - : ℕ))) (p (0 : Fin (4 : ℕ))) = BandVectors.2 (p (1 : Fin (4 : ℕ))) (p (3 : Fin (4 : ℕ))) - + ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (p (2 : Fin (4 : ℕ))) (p (1 : Fin (4 : ℕ))) ∧ - (ProperBandQuadruple p → ∀ (j : Fin (3 : ℕ)), BandVectors.1 (p (0 : Fin (4 : ℕ))) (p - j.succ) = ⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.1 (p j.succ) (p (0 : Fin (4 : ℕ))) ∧ - BandVectors.2 (p (0 : Fin (4 : ℕ))) (p j.succ) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 (p - j.succ) (p (0 : Fin (4 : ℕ))))) → (BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (Fin.succ (2 : - Fin (3 : ℕ)))) = - { re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.1 (p (Fin.succ (2 : Fin (3 : ℕ)))) (p (0 : Fin - (4 : ℕ))) ∧ - BandVectors.2 (p (0 : Fin (4 : ℕ))) (p (Fin.succ (2 : Fin (3 : ℕ)))) = - -{ re := (0 : ℤ), im := (1 : ℤ) } * BandVectors.2 (p (Fin.succ (2 : Fin (3 : ℕ)))) (p (0 : - Fin (4 : ℕ))))) := by - classical - intro p hp lawsP - exact (lawsP.2.2.2.2 hp) 2 - -private theorem hxcoordV : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (r 1 = p 0) → ((r 3 = p 3) → ( - let xv := BandVectors.1 (r 1) (r 3) - BandVectors.1 (p 0) (p 3) = xv)) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p r r1 r3 xv - rw [← r1, ← r3] - -private theorem hxcoordA : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (r 1 = p 0) → ((r 3 = p 3) → ( - let xa := BandVectors.2 (r 1) (r 3) - BandVectors.2 (p 0) (p 3) = xa)) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p r r1 r3 xa - rw [← r1, ← r3] - -private theorem hI2 : - let I : GaussianInt := ⟨0, 1⟩ - I * I = -1 := by - classical - intro I - decide +kernel - -private theorem he2 : - let I : GaussianInt := ⟨0, 1⟩ - let e : GaussianInt := -I - e * e = -1 := by - classical - intro I e - decide +kernel - -private theorem hIneg : - let I : GaussianInt := ⟨0, 1⟩ - (I * I = -1) → (-I * I = 1) := by - classical - intro I hI2 - calc - -I * I = -(I * I) := by ring - _ = -(-1) := by rw [hI2] - _ = 1 := by norm_num - -private theorem heneg : - let I : GaussianInt := ⟨0, 1⟩ - let e : GaussianInt := -I - (e * e = -1) → (-e * e = 1) := by - classical - intro I e he2 - calc - -e * e = -(e * e) := by ring - _ = -(-1) := by rw [he2] - _ = 1 := by norm_num - -private theorem hxv : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let xv := BandVectors.1 (r 1) (r 3) - (BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.1 (p (Fin.succ (2 : Fin (3 : ℕ)))) (p (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (p - (0 : Fin (4 : ℕ))) (p (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 - (p (Fin.succ (2 : Fin (3 : ℕ)))) (p (0 : Fin (4 : ℕ)))) → ((BandVectors.1 (p 0) (p 3) = - xv) → (xv = I * BandVectors.1 (p 3) (p 0))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p r I xv pflip hxcoordV - rw [← hxcoordV] - simpa using pflip.1 - -private theorem hza : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let xv := BandVectors.1 (r 1) (r 3) - (-I * I = 1) → ((xv = I * BandVectors.1 (p 3) (p 0)) → (BandVectors.1 (p 3) (p 0) = -I * xv)) - := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p r I xv hIneg hxv - calc - _ = 1 * BandVectors.1 (p 3) (p 0) := by simp - _ = (-I * I) * BandVectors.1 (p 3) (p 0) := by rw [hIneg] - _ = -I * (I * BandVectors.1 (p 3) (p 0)) := by - simp [mul_assoc] - _ = _ := by rw [← hxv] - -private theorem hxa : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let xa := BandVectors.2 (r 1) (r 3) - let e : GaussianInt := -I - (BandVectors.1 (p (0 : Fin (4 : ℕ))) (p (Fin.succ (2 : Fin (3 : ℕ)))) = ⟨(0 : ℤ), (1 : ℤ)⟩ * - BandVectors.1 (p (Fin.succ (2 : Fin (3 : ℕ)))) (p (0 : Fin (4 : ℕ))) ∧ BandVectors.2 (p - (0 : Fin (4 : ℕ))) (p (Fin.succ (2 : Fin (3 : ℕ)))) = -⟨(0 : ℤ), (1 : ℤ)⟩ * BandVectors.2 - (p (Fin.succ (2 : Fin (3 : ℕ)))) (p (0 : Fin (4 : ℕ)))) → ((BandVectors.2 (p 0) (p 3) = - xa) → (xa = e * BandVectors.2 (p 3) (p 0))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p r I xa e pflip hxcoordA - rw [← hxcoordA] - simpa [e, I] using pflip.2 - -private theorem hzaA : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let xa := BandVectors.2 (r 1) (r 3) - let e : GaussianInt := -I - (-e * e = 1) → ((xa = e * BandVectors.2 (p 3) (p 0)) → (BandVectors.2 (p 3) (p 0) = -e * xa)) - := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p r I xa e heneg hxa - calc - _ = 1 * BandVectors.2 (p 3) (p 0) := by simp - _ = (-e * e) * BandVectors.2 (p 3) (p 0) := by rw [heneg] - _ = -e * (e * BandVectors.2 (p 3) (p 0)) := by - simp [mul_assoc] - _ = _ := by rw [← hxa] - -private theorem hminusVecV : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let xv := BandVectors.1 (r 1) (r 3) - (BandVectors.1 (p 0) (p 3) = xv) → ((BandVectors.1 (p 3) (p 0) = -I * xv) → (BandVectors.1 (p - 3) (p 0) - BandVectors.1 (p 0) (p 3) = - -I * xv - xv)) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p r I xv hxcoordV hza - rw [hza, hxcoordV] - -private theorem hplusVecV : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let xv := BandVectors.1 (r 1) (r 3) - (BandVectors.1 (p 0) (p 3) = xv) → ((BandVectors.1 (p 3) (p 0) = -I * xv) → (BandVectors.1 (p - 3) (p 0) + BandVectors.1 (p 0) (p 3) = - -I * xv + xv)) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p r I xv hxcoordV hza - rw [hza, hxcoordV] - -private theorem hminusVecA : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let xa := BandVectors.2 (r 1) (r 3) - let e : GaussianInt := -I - (BandVectors.2 (p 0) (p 3) = xa) → ((BandVectors.2 (p 3) (p 0) = -e * xa) → (BandVectors.2 (p - 3) (p 0) - BandVectors.2 (p 0) (p 3) = - -e * xa - xa)) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p r I xa e hxcoordA hzaA - rw [hzaA, hxcoordA] - -private theorem hplusVecA : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let xa := BandVectors.2 (r 1) (r 3) - let e : GaussianInt := -I - (BandVectors.2 (p 0) (p 3) = xa) → ((BandVectors.2 (p 3) (p 0) = -e * xa) → (BandVectors.2 (p - 3) (p 0) + BandVectors.2 (p 0) (p 3) = - -e * xa + xa)) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p r I xa e hxcoordA hzaA - rw [hzaA, hxcoordA] - -private theorem houterA : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), ∀ (p - : Fin 4 → CircleCoordinates), (![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] = - ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p - 3).2 - (p 1).2), p 0, p 2, p 3]) → (F.q a.succ = p 0) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a p hstep - have h := congrFun hstep 1 - simpa using h - -private theorem hindicesA : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - F.q ((a + 2).succ) = r 3 ∧ F.q ((a + 1).succ) = r 2 := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r - constructor <;> rfl - -private theorem hvecA : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let wa := BandVectors.2 (r 3) (r 2) - (F.q ((a + 2).succ) = r 3 ∧ F.q ((a + 1).succ) = r 2) → (BandVectors.2 (F.q ((a + 2).succ)) - (F.q ((a + 1).succ)) = wa) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r wa hindicesA - rw [hindicesA.1, hindicesA.2] - -private theorem hindicesJ : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - (F.slot + 2 = a + 1) → ((F.slot + 1 = a) → (F.q ((F.slot + 2).succ) = r 2 ∧ - F.q ((F.slot + 1).succ) = r 1)) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r hslotplus2 hslotplus1 - rw [hslotplus2, hslotplus1] - constructor <;> rfl - -private theorem hvecJ : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let ya := BandVectors.2 (r 2) (r 1) - (F.q ((F.slot + 2).succ) = r 2 ∧ F.q ((F.slot + 1).succ) = r 1) → (BandVectors.2 (F.q - ((F.slot + 2).succ)) - (F.q ((F.slot + 1).succ)) = ya) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r ya hindicesJ - rw [hindicesJ.1, hindicesJ.2] - -private theorem hpositiveSlot : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), 0 < (F.q - F.slot.succ).1 := by - classical - intro C orientation base Rminus Rplus hminus hplus F - rw [F.parent] - exact C.2 - -private theorem hrootAEq : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (rootA : ℝ × ℝ), - (PartialOdometerSlope F.odometer = some rootA) → (rootA = F.outerSlope) := by - classical - intro C orientation base Rminus Rplus hminus hplus F rootA hrootA - exact Option.some.inj (hrootA.symm.trans F.slope_outer) - -private abbrev hrootJEq := ApollonianSuperharmonic.FrameDiagonalProof.hrootAEq - private theorem slopeK : ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : @@ -1070,118 +268,18 @@ private theorem slopeMinusRoot : rw [hparentR, hzero, aflip', ain] at h simpa [e, I] using h -private theorem slopeMinusA : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let wa := BandVectors.2 (r 3) (r 2) - let xa := BandVectors.2 (r 1) (r 3) - let ya := BandVectors.2 (r 2) (r 1) - (-(wa - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * - ya + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - - (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = - ya + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ - -(ya - -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - - (ya - -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ - -(ya - -I * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - - (xa - -I * xa) = wa + -I * wa) → ((∀ {X : GaussianInt}, ∀ {Y : GaussianInt}, ∀ - {Z : GaussianInt}, (X - Y = Z) → ((1 / 2 : ℝ) • GaussianRealPoint X - (1 / 2 : ℝ) • - GaussianRealPoint Y = (1 / 2 : ℝ) • GaussianRealPoint Z)) → ( - let e : GaussianInt := -I - ∀ (sA : ℝ × ℝ), (sA - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (wa - e * wa)) → - ((F.minusSlope - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint ((wa - e * xa) - e * - (wa - e * xa))) → (F.minusSlope - sA = - (1 / 2 : ℝ) • GaussianRealPoint (-e * xa - xa))))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r I wa xa ya ha halfDiff e sA slopeK - slopeMinusRoot - calc - _ = (F.minusSlope - F.outerSlope) - (sA - F.outerSlope) := by abel - _ = _ := by rw [slopeMinusRoot, slopeK]; exact halfDiff ha.2.2.2.2.1 +private theorem reverseQuarterTurn {u v : GaussianInt} (t : GaussianInt) + (ht : t * t = -1) (h : u = t * v) : v = -t * u := by + rw [h, ← mul_assoc, neg_mul, ht] + simp -private theorem slopeJminusA : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let wa := BandVectors.2 (r 3) (r 2) - let xa := BandVectors.2 (r 1) (r 3) - let ya := BandVectors.2 (r 2) (r 1) - (-(wa - -I * wa) - (xa - -I * ya - -I * (xa - -I * ya)) = (2 : GaussianInt) * ya ∧ xa - -I * - ya + -I * (xa - -I * ya) + (wa - -I * wa) = (2 : GaussianInt) * -I * xa ∧ -(xa - -I * xa) - - (wa - -I * wa) = ya - -I * ya ∧ ya - -I * wa + -I * (ya - -I * wa) - (wa - -I * wa) = - ya + -I * ya ∧ wa - -I * xa - -I * (wa - -I * xa) - (wa - -I * wa) = - -I * xa - xa ∧ - -(ya - -I * ya) - (wa - -I * wa) = - -I * xa + xa ∧ ya - -I * wa - -I * (ya - -I * wa) - - (ya - -I * ya) = - -I * wa - wa ∧ -(xa - -I * xa) - (ya - -I * ya) = - -I * wa + wa ∧ - -(ya - -I * ya) - (xa - -I * xa) = wa - -I * wa ∧ wa - -I * xa + -I * (wa - -I * xa) - - (xa - -I * xa) = wa + -I * wa) → ((∀ {X : GaussianInt}, ∀ {Y : GaussianInt}, ∀ - {Z : GaussianInt}, (X - Y = Z) → ((1 / 2 : ℝ) • GaussianRealPoint X - (1 / 2 : ℝ) • - GaussianRealPoint Y = (1 / 2 : ℝ) • GaussianRealPoint Z)) → ( - let e : GaussianInt := -I - ∀ (sA : ℝ × ℝ), ∀ (sJ : ℝ × ℝ), (sA - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (wa - e - * wa)) → ((sJ - F.outerSlope = (1 / 2 : ℝ) • GaussianRealPoint (-(ya - e * ya))) → (sJ - - sA = - (1 / 2 : ℝ) • GaussianRealPoint (-e * xa + xa))))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F a r I wa xa ya ha halfDiff e sA sJ slopeK - slopeJ +private theorem relativeDifference {A B C : ℝ × ℝ} {X Y Z : GaussianInt} + (ha : A - C = (1 / 2 : ℝ) • GaussianRealPoint X) + (hb : B - C = (1 / 2 : ℝ) • GaussianRealPoint Y) + (hxy : X - Y = Z) : A - B = (1 / 2 : ℝ) • GaussianRealPoint Z := by calc - _ = (sJ - F.outerSlope) - (sA - F.outerSlope) := by abel - _ = _ := by rw [slopeJ, slopeK]; exact halfDiff ha.2.2.2.2.2.1 - -private theorem centMinusA : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let xv := BandVectors.1 (r 1) (r 3) - (TileCentroid Rminus - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint (-I * - xv - xv)) → ((BandVectors.1 (p 3) (p 0) - BandVectors.1 (p 0) (p 3) = -I * xv - xv) → - (TileCentroid Rminus - TileCentroid (D.tiles a true) = - (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.1 (p 3) (p 0) - BandVectors.1 (p 0) (p 3)))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D a p r I xv hcentR hminusVecV - rw [hminusVecV] - exact hcentR - -private theorem centJA : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), ∀ (J : - ProtoTile), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let xv := BandVectors.1 (r 1) (r 3) - (TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint (-I * xv + - xv)) → ((BandVectors.1 (p 3) (p 0) + BandVectors.1 (p 0) (p 3) = -I * xv + xv) → - (TileCentroid J - TileCentroid (D.tiles a true) = - (1 / 2 : ℝ) • GaussianRealPoint - (BandVectors.1 (p 3) (p 0) + BandVectors.1 (p 0) (p 3)))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D a p J r I xv hcentJ hplusVecV - rw [hplusVecV] - exact hcentJ - -private theorem hodoA : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (p : Fin 4 → CircleCoordinates), (F.q - a.succ = p 0) → (TileOdometer (p 0) (D.tiles a true) (D.functions a true)) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D a p houterA - simpa [houterA] using D.odometers a true + _ = (A - C) - (B - C) := by abel + _ = _ := by rw [ha, hb]; exact halfDiff hxy end FrameDiagonalProof @@ -1208,128 +306,96 @@ theorem P4536T1AFrameD classical let r : Fin 4 → CircleCoordinates := ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - have hr := FrameDiagonalProof.hrAt128 C orientation base Rminus Rplus - hminus hplus F a hslot - have hrstep := FrameDiagonalProof.hrstep C orientation base Rminus Rplus hminus hplus F a p hstep - have r1 := FrameDiagonalProof.r1 C orientation base Rminus Rplus hminus hplus F a p - hrstep - have r2 := FrameDiagonalProof.r2 C orientation base Rminus Rplus hminus hplus F a p - hrstep - have r3 := FrameDiagonalProof.r3 C orientation base Rminus Rplus hminus hplus F a p - hrstep - have hparent := FrameDiagonalProof.hparent C orientation base Rminus - Rplus hminus hplus F a p hstep hslot - have hparentR := FrameDiagonalProof.hparentR C orientation base Rminus - Rplus hminus hplus F a p r3 hparent - have hzero := FrameDiagonalProof.hzero C orientation base Rminus Rplus hminus - hplus F a - have hC := FrameDiagonalProof.hC C orientation base Rminus Rplus hminus hplus F p - hparent - have positiveA := FrameDiagonalProof.positiveA p hp + have hr := FrameDiagonalProof.properRotation F.q F.proper a + have hrstep : r = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3] := hstep + have r1 : r 1 = p 0 := by simpa using congrFun hrstep 1 + have r3 : r 3 = p 3 := by simpa using congrFun hrstep 3 + have hparent : F.q F.slot.succ = p 3 := by + rw [hslot] + simpa using congrFun hstep 3 + have hparentR := hparent.trans r3.symm + have hzero : F.q 0 = r 0 := rfl + have hC := F.parent.symm.trans hparent + have positiveA := (ProperBandCurvatureStructure p hp).1 let I : GaussianInt := ⟨0, 1⟩ + let wv := BandVectors.1 (r 3) (r 2) + let xv := BandVectors.1 (r 1) (r 3) + let yv := BandVectors.1 (r 2) (r 1) + let wa := BandVectors.2 (r 3) (r 2) let xa := BandVectors.2 (r 1) (r 3) - have laws := FrameDiagonalProof.laws C orientation base Rminus Rplus hminus hplus F a hr - have hrr := FrameDiagonalProof.hrr C orientation base Rminus Rplus - hminus hplus F a hr - have lawsR := FrameDiagonalProof.lawsR C orientation base Rminus Rplus hminus hplus F a hrr - have win := FrameDiagonalProof.win C orientation base - Rminus Rplus hminus hplus F a lawsR - have ain := FrameDiagonalProof.ain C orientation base - Rminus Rplus hminus hplus F a lawsR - have hv := FrameDiagonalProof.hv C orientation base Rminus Rplus hminus hplus F a laws - have ha := FrameDiagonalProof.ha C orientation base Rminus Rplus hminus hplus F a laws - have vflip := FrameDiagonalProof.vflip C orientation base Rminus Rplus hminus hplus F a hr laws - have vflip' := FrameDiagonalProof.vflip' C orientation base Rminus Rplus hminus hplus F a vflip - have aflip' := FrameDiagonalProof.aflip' C orientation base Rminus Rplus hminus hplus F a vflip - have centMinus := FrameDiagonalProof.centMinus C orientation base Rminus Rplus hminus hplus F a - p r3 - hparent hzero win vflip' - have centJ := FrameDiagonalProof.centJ C orientation - base Rminus Rplus hminus hplus F D a hslot J hcent - have centK := FrameDiagonalProof.centK C orientation - base Rminus Rplus hminus hplus F D a - have halfDiff {X Y Z : GaussianInt} (hxy : X - Y = Z) := FrameDiagonalProof.halfDiff (X := X) - (Y := Y) (Z - := Z) hxy - have hcentR := FrameDiagonalProof.hcentR C orientation - base Rminus Rplus hminus hplus F D a hv centMinus centK halfDiff - have hcentJ := FrameDiagonalProof.hcentJ C orientation - base Rminus Rplus hminus hplus F D a J hv centJ centK halfDiff + let ya := BandVectors.2 (r 2) (r 1) + have laws := VectorRecursionLaws r hr.1 + have hrr := FrameDiagonalProof.properRotation r hr 2 + have lawsR := VectorRecursionLaws _ hrr.1 + have win : BandVectors.1 (r 3) (r 0) = wv - I * xv := by + simpa [wv, xv, I] using lawsR.2.2.1 + have ain : BandVectors.2 (r 3) (r 0) = wa + I * xa := by + simpa [wa, xa, I] using lawsR.2.2.2.1 + have hI2 : I * I = -1 := by decide +kernel + have hv := P4536T1EndpointAlgebra I wv xv yv hI2 laws.1 + have ha := P4536T1EndpointAlgebra (-I) wa xa ya (by decide +kernel) laws.2.1 + have vflip := (laws.2.2.2.2 hr) 2 + have vflip' : BandVectors.1 (r 0) (r 3) = I * BandVectors.1 (r 3) (r 0) := vflip.1 + have aflip' : BandVectors.2 (r 0) (r 3) = -I * BandVectors.2 (r 3) (r 0) := vflip.2 + have centMinus := FrameDiagonalProof.centMinus C orientation base Rminus Rplus hminus hplus + F a p r3 hparent hzero win vflip' + have centJ := FrameDiagonalProof.centJ C orientation base Rminus Rplus hminus hplus + F D a hslot J hcent + have centK := FrameDiagonalProof.centK C orientation base Rminus Rplus hminus hplus F D a + have hcentR := FrameDiagonalProof.relativeDifference centMinus centK hv.2.2.2.2.1 + have hcentJ := FrameDiagonalProof.relativeDifference centJ centK hv.2.2.2.2.2.1 let e : GaussianInt := -I - have lawsP := FrameDiagonalProof.lawsP p hp - have pflip := FrameDiagonalProof.pflip p hp lawsP - have hxcoordV := FrameDiagonalProof.hxcoordV C orientation - base Rminus Rplus hminus hplus F a p r1 r3 - have hxcoordA := FrameDiagonalProof.hxcoordA C orientation - base Rminus Rplus hminus hplus F a p r1 r3 - have hI2 := FrameDiagonalProof.hI2 - have he2 := FrameDiagonalProof.he2 - have hIneg := FrameDiagonalProof.hIneg hI2 - have heneg := FrameDiagonalProof.heneg he2 - have hxv := FrameDiagonalProof.hxv C orientation base - Rminus Rplus hminus hplus F a p pflip hxcoordV - have hza := FrameDiagonalProof.hza C orientation base - Rminus Rplus hminus hplus F a p hIneg hxv - have hxa := FrameDiagonalProof.hxa C orientation base - Rminus Rplus hminus hplus F a p pflip hxcoordA - have hzaA := FrameDiagonalProof.hzaA C orientation base - Rminus Rplus hminus hplus F a p heneg hxa - have hminusVecV := FrameDiagonalProof.hminusVecV C orientation base Rminus Rplus hminus hplus - F a p hxcoordV hza - have hplusVecV := FrameDiagonalProof.hplusVecV C orientation base Rminus Rplus hminus hplus F - a p hxcoordV hza + have lawsP := VectorRecursionLaws p hp.1 + have pflip := (lawsP.2.2.2.2 hp) 2 + have hxcoordV : BandVectors.1 (p 0) (p 3) = xv := by rw [← r1, ← r3] + have hxcoordA : BandVectors.2 (p 0) (p 3) = xa := by rw [← r1, ← r3] + have he2 : e * e = -1 := by decide +kernel + have hxv : xv = I * BandVectors.1 (p 3) (p 0) := by + rw [← hxcoordV] + exact pflip.1 + have hza := FrameDiagonalProof.reverseQuarterTurn I hI2 hxv + have hxa : xa = e * BandVectors.2 (p 3) (p 0) := by + rw [← hxcoordA] + simpa [e, I] using pflip.2 + have hzaA := FrameDiagonalProof.reverseQuarterTurn e he2 hxa + have hminusVecV : BandVectors.1 (p 3) (p 0) - BandVectors.1 (p 0) (p 3) = + -I * xv - xv := by rw [hza, hxcoordV] + have hplusVecV : BandVectors.1 (p 3) (p 0) + BandVectors.1 (p 0) (p 3) = + -I * xv + xv := by rw [hza, hxcoordV] have hminusVecA : BandVectors.2 (p 3) (p 0) - BandVectors.2 (p 0) (p 3) = - -e * xa - xa := FrameDiagonalProof.hminusVecA C orientation base Rminus Rplus hminus hplus - F a p hxcoordA hzaA + -e * xa - xa := by rw [hzaA, hxcoordA] have hplusVecA : BandVectors.2 (p 3) (p 0) + BandVectors.2 (p 0) (p 3) = - -e * xa + xa := FrameDiagonalProof.hplusVecA C orientation base Rminus Rplus hminus hplus F - a p hxcoordA hzaA - have houterA := FrameDiagonalProof.houterA C orientation base Rminus Rplus - hminus hplus F a p hstep - let A : BandCircle := - ⟨⟨p 0, Or.inl positiveA, p, hp.1, 0, rfl⟩, positiveA⟩ - have hindicesA := FrameDiagonalProof.hindicesA C orientation base Rminus Rplus hminus hplus F a - have hvecA := FrameDiagonalProof.hvecA C orientation base Rminus Rplus hminus hplus F a hindicesA - have hslotplus2 : F.slot + 2 = a + 1 := by - rw [hslot] - fin_cases a <;> decide - have hslotplus1 : F.slot + 1 = a := by - rw [hslot] - fin_cases a <;> decide - have hindicesJ := FrameDiagonalProof.hindicesJ C orientation base Rminus - Rplus hminus hplus F a hslotplus2 hslotplus1 - have hvecJ := FrameDiagonalProof.hvecJ C orientation base Rminus Rplus - hminus hplus F a hindicesJ - have hpositiveSlot := FrameDiagonalProof.hpositiveSlot C orientation - base Rminus Rplus hminus hplus F + -e * xa + xa := by rw [hzaA, hxcoordA] + have houterA : F.q a.succ = p 0 := r1 + let A : BandCircle := ⟨⟨p 0, Or.inl positiveA, p, hp.1, 0, rfl⟩, positiveA⟩ + have hvecA : BandVectors.2 (F.q ((a + 2).succ)) (F.q ((a + 1).succ)) = wa := rfl + have hslotplus2 : F.slot + 2 = a + 1 := by rw [hslot]; fin_cases a <;> decide + have hslotplus1 : F.slot + 1 = a := by rw [hslot]; fin_cases a <;> decide + have hvecJ : BandVectors.2 (F.q ((F.slot + 2).succ)) + (F.q ((F.slot + 1).succ)) = ya := by + rw [hslotplus2, hslotplus1] + rfl + have hpositiveSlot : 0 < (F.q F.slot.succ).1 := by rw [F.parent]; exact C.2 obtain hzA | ⟨rootA, sA, hrootA, hsA, hARe, hAIm⟩ := D.slopes a true · rw [houterA] at hzA omega - have hrootAEq := FrameDiagonalProof.hrootAEq C orientation base Rminus - Rplus hminus hplus F rootA hrootA + have hrootAEq := Option.some.inj (hrootA.symm.trans F.slope_outer) subst rootA obtain hzJ | ⟨rootJ, sJ, hrootJ, hsJ, hJRe, hJIm⟩ := D.slopes F.slot false · omega - have hrootJEq := FrameDiagonalProof.hrootJEq C orientation base Rminus - Rplus hminus hplus F rootJ hrootJ + have hrootJEq := Option.some.inj (hrootJ.symm.trans F.slope_outer) subst rootJ - have slopeK := FrameDiagonalProof.slopeK C orientation - base Rminus Rplus hminus hplus F a hvecA sA hARe hAIm - have slopeJ := FrameDiagonalProof.slopeJ C orientation - base Rminus Rplus hminus hplus F a hvecJ sJ hJRe hJIm - have slopeMinusRoot := FrameDiagonalProof.slopeMinusRoot C orientation base Rminus Rplus hminus - hplus F a - hparentR hzero ain aflip' - have slopeMinusA := FrameDiagonalProof.slopeMinusA C - orientation base Rminus Rplus hminus hplus F a ha halfDiff sA slopeK slopeMinusRoot - have slopeJminusA := FrameDiagonalProof.slopeJminusA C - orientation base Rminus Rplus hminus hplus F a ha halfDiff sA sJ slopeK slopeJ - have centMinusA := FrameDiagonalProof.centMinusA - C orientation base Rminus Rplus hminus hplus F D a p hcentR hminusVecV - have centJA := FrameDiagonalProof.centJA C - orientation base Rminus Rplus hminus hplus F D a p J hcentJ hplusVecV - have hodoA := FrameDiagonalProof.hodoA C orientation base Rminus Rplus hminus hplus F D a p - houterA + have slopeK := FrameDiagonalProof.slopeK C orientation base Rminus Rplus hminus hplus + F a hvecA sA hARe hAIm + have slopeJ := FrameDiagonalProof.slopeJ C orientation base Rminus Rplus hminus hplus + F a hvecJ sJ hJRe hJIm + have slopeMinusRoot := FrameDiagonalProof.slopeMinusRoot C orientation base Rminus Rplus + hminus hplus F a hparentR hzero ain aflip' + have slopeMinusA := FrameDiagonalProof.relativeDifference slopeMinusRoot slopeK ha.2.2.2.2.1 + have slopeJminusA := FrameDiagonalProof.relativeDifference slopeJ slopeK ha.2.2.2.2.2.1 + have hodoA : TileOdometer (p 0) (D.tiles a true) (D.functions a true) := by + simpa [houterA] using D.odometers a true let G : P4458T1BoundaryFrame C orientation base Rminus J hminus (D.functions F.slot false) := { outer := A @@ -1350,8 +416,18 @@ theorem P4536T1AFrameD minus_family := F.minus_family plus_family := hfamily chart := hchart - minus_centroid := centMinusA - plus_centroid := centJA + minus_centroid := by + change TileCentroid Rminus - TileCentroid (D.tiles a true) = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (p 3) (p 0) - BandVectors.1 (p 0) (p 3)) + rw [hminusVecV] + exact hcentR + plus_centroid := by + change TileCentroid J - TileCentroid (D.tiles a true) = + (1 / 2 : ℝ) • GaussianRealPoint + (BandVectors.1 (p 3) (p 0) + BandVectors.1 (p 0) (p 3)) + rw [hplusVecV] + exact hcentJ outerSlope := sA minusSlope := F.minusSlope plusSlope := sJ diff --git a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean index 2935bc194f..0477ead589 100644 --- a/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean +++ b/LeanPool/ApollonianSuperharmonic/P4590T1JunctionRefinement.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.LatticeFootprintIncidence @@ -1241,27 +1243,6 @@ private theorem hS1disk : have h := cfg.secondLarge omega -private theorem boundaryFootprint : - (by - classical - exact - ∀ (U : ProtoTile), (U.cells.Nonempty) → (∀ (z : GaussianInt), (z ∈ - BoundaryFootprintVertices U) → (z ∈ FootprintVertices U)) ) := by - classical - intro U hne z hz - simp only [BoundaryFootprintVertices, hne, ite_true, Set.mem_ofPred_eq] at hz - obtain ⟨e, he, hz⟩ := hz - simp only [FootprintVertices, hne, ite_true, Set.mem_ofPred_eq] - obtain ⟨a, ⟨rfl, ha⟩ | ⟨rfl, ha⟩⟩ := he - all_goals - simp only [Finset.mem_insert, Finset.mem_singleton] at hz - rcases ha with ⟨ha, _⟩ | ⟨_, ha⟩ - · refine ⟨a, ha, ?_⟩ - rcases hz with rfl | rfl <;> simp - · refine ⟨_, ha, ?_⟩ - rcases hz with rfl | rfl <;> - simp [sub_eq_add_neg, add_comm, add_left_comm, add_assoc] - private theorem nestedCellsInsideT : (by classical @@ -2041,7 +2022,8 @@ private theorem fourthJunction : T cert have hS1ne : (cert.S 1 false).cells.Nonempty := (LatticeTileGridStructure _ hS1disk).1.1 - have boundaryFootprint := JunctionRefinementGeometry.boundaryFootprint + have boundaryFootprint := fun (U : ProtoTile) (_ : U.cells.Nonempty) => + BoundaryFootprintInclusion.boundaryVertex_mem U obtain ⟨pN, hpN, hpNUnique⟩ := cert.double_fourth.2.2.2 have hpNS : pN ∈ FootprintVertices (cert.S 1 false) := boundaryFootprint _ hS1ne _ hpN.1 diff --git a/LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean b/LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean index f1b9b62734..2f5abb85aa 100644 --- a/LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean +++ b/LeanPool/ApollonianSuperharmonic/P4677T2FacePoints.lean @@ -5,6 +5,8 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.TileTranslationProperties @@ -28,57 +30,6 @@ namespace ApollonianSuperharmonic namespace FacePointConstruction -private theorem boundary_to_footprint (T : ProtoTile) (x : GaussianInt) - (hx : x ∈ BoundaryFootprintVertices T) : x ∈ FootprintVertices T := by - classical - have edge_to_footprint (e : Finset GaussianInt) - (he : e ∈ BoundaryFootprintEdges T) : e ∈ FootprintEdges T := by - change ∃ z : GaussianInt, - (e = {z, z + 1} ∧ - ((z ∈ T.cells ∧ z - ⟨0, 1⟩ ∉ T.cells) ∨ - (z ∉ T.cells ∧ z - ⟨0, 1⟩ ∈ T.cells))) ∨ - (e = {z, z + ⟨0, 1⟩} ∧ - ((z ∈ T.cells ∧ z - 1 ∉ T.cells) ∨ - (z ∉ T.cells ∧ z - 1 ∈ T.cells))) at he - change ∃ c ∈ T.cells, - e = {c, c + 1} ∨ e = {c, c + ⟨0, 1⟩} ∨ - e = {c + 1, c + 1 + ⟨0, 1⟩} ∨ - e = {c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩} - rcases he with ⟨z, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inl rfl⟩ - · refine ⟨z - ⟨0, 1⟩, hz, Or.inr (Or.inr (Or.inr ?_))⟩ - congr 1 <;> simp [Zsqrtd.ext_iff] - · rcases h with ⟨hz, -⟩ | ⟨-, hz⟩ - · exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · refine ⟨z - 1, hz, Or.inr (Or.inr (Or.inl ?_))⟩ - congr 1 <;> simp [] - by_cases hne : T.cells.Nonempty - · simp only [BoundaryFootprintVertices, ite_eq_left hne, Set.mem_ofPred_eq] at hx - rcases hx with ⟨e, he, hxe⟩ - have he' := edge_to_footprint e he - rcases he' with ⟨z, hz, he⟩ - rcases he with h | h | h | h - all_goals - rw [h] at hxe - simp only [Finset.mem_insert, Finset.mem_singleton] at hxe - simp only [FootprintVertices, ite_eq_left hne] - · rcases hxe with hxe | hxe - · subst x; exact ⟨z, hz, Or.inl rfl⟩ - · subst x; exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · rcases hxe with hxe | hxe - · subst x; exact ⟨z, hz, Or.inl rfl⟩ - · subst x; exact ⟨z, hz, Or.inr (Or.inr (Or.inl rfl))⟩ - · rcases hxe with hxe | hxe - · subst x; exact ⟨z, hz, Or.inr (Or.inl rfl)⟩ - · subst x; exact ⟨z, hz, Or.inr (Or.inr (Or.inr rfl))⟩ - · rcases hxe with hxe | hxe - · subst x; exact ⟨z, hz, Or.inr (Or.inr (Or.inl rfl))⟩ - · subst x; exact ⟨z, hz, Or.inr (Or.inr (Or.inr rfl))⟩ - · simp only [BoundaryFootprintVertices, ite_eq_right hne, Set.mem_singleton_iff] at hx - subst x - simp [FootprintVertices, hne] - private theorem touching_point (A B C : ProtoTile) (h : TouchingTriple A B C) : ∃ x : GaussianInt, x ∈ BoundaryFootprintVertices A ∧ x ∈ BoundaryFootprintVertices B ∧ x ∈ BoundaryFootprintVertices C := by @@ -559,7 +510,7 @@ theorem P4677T2FacePoints classical have boundary_to_footprint (T : ProtoTile) (x : GaussianInt) (hx : x ∈ BoundaryFootprintVertices T) : x ∈ FootprintVertices T := - FacePointConstruction.boundary_to_footprint T x hx + BoundaryFootprintInclusion.boundaryVertex_mem T x hx have touching_point (A B C : ProtoTile) (h : TouchingTriple A B C) : ∃ x : GaussianInt, x ∈ BoundaryFootprintVertices A ∧ x ∈ BoundaryFootprintVertices B ∧ x ∈ BoundaryFootprintVertices C := diff --git a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean index e6a8a8ce45..70a3c1c94a 100644 --- a/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean +++ b/LeanPool/ApollonianSuperharmonic/P4812T1RegularFaceWalks.lean @@ -20,47 +20,6 @@ Changes: pool module paths, public exports, project namespace and current Mathli @[expose] public section namespace ApollonianSuperharmonic namespace RegularFaceWalkProof -private theorem boundaryFoot : - (by - classical - exact - ∀ (W : ProtoTile), ∀ z ∈ BoundaryFootprintVertices W, z ∈ FootprintVertices W - ) := by - classical - intro W z hz - by_cases hW : W.cells.Nonempty - · simp only [BoundaryFootprintVertices, ite_eq_left hW, Set.mem_ofPred_eq] at hz - rcases hz with ⟨e, he, hze⟩ - have he' : e ∈ FootprintEdges W := by - change ∃ c ∈ W.cells, - e = {c, c + 1} ∨ e = {c, c + ⟨0, 1⟩} ∨ - e = {c + 1, c + 1 + ⟨0, 1⟩} ∨ - e = {c + ⟨0, 1⟩, c + 1 + ⟨0, 1⟩} - rcases he with ⟨w, ⟨rfl, h⟩ | ⟨rfl, h⟩⟩ - · rcases h with ⟨hw, _⟩ | ⟨_, hw⟩ - · exact ⟨w, hw, Or.inl rfl⟩ - · refine ⟨w - ⟨0, 1⟩, hw, Or.inr (Or.inr (Or.inr ?_))⟩ - congr 1 <;> simp [Zsqrtd.ext_iff] - · rcases h with ⟨hw, _⟩ | ⟨_, hw⟩ - · exact ⟨w, hw, Or.inr (Or.inl rfl)⟩ - · refine ⟨w - 1, hw, Or.inr (Or.inr (Or.inl ?_))⟩ - congr 1 <;> simp [] - rcases he' with ⟨c, hc, hcE⟩ - rcases hcE with hcE | hcE | hcE | hcE - all_goals - simp only [FootprintVertices, ite_eq_left hW] - rw [hcE] at hze - simp only [Finset.mem_insert, Finset.mem_singleton] at hze - rcases hze with hze | hze <;> subst z - · exact ⟨c, hc, Or.inl rfl⟩ - · exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ - · exact ⟨c, hc, Or.inl rfl⟩ - · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ - · exact ⟨c, hc, Or.inr (Or.inl rfl)⟩ - · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ - · exact ⟨c, hc, Or.inr (Or.inr (Or.inl rfl))⟩ - · exact ⟨c, hc, Or.inr (Or.inr (Or.inr rfl))⟩ - · simpa [BoundaryFootprintVertices, FootprintVertices, hW] using hz private abbrev translateComp := ApollonianSuperharmonic.TileTranslationProperties.add private theorem edgeDiff : (by @@ -2150,7 +2109,8 @@ theorem P4812T1RegularFaceWalks have rho_mem (q : Sum L L) (i : Fin 3) : rho (D.faces q) ∈ FootprintVertices (TileTranslation T (D.plane.faceVertex (D.faces q) i : GaussianInt)) := - RegularFaceWalkProof.rho_mem L k D T ru rd (RegularFaceWalkProof.boundaryFoot) + RegularFaceWalkProof.rho_mem L k D T ru rd + (BoundaryFootprintInclusion.boundaryVertex_mem) (RegularFaceDetails.translateBoundary) translateComp ru0 rua rub rd0 rda rdb q i have transZero (W : ProtoTile) : TileTranslation W 0 = W := RegularFaceWalkProof.transZero W diff --git a/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean b/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean index 025bca89df..33c63378e7 100644 --- a/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean +++ b/LeanPool/ApollonianSuperharmonic/P5290T1EqualDiamondPaths.lean @@ -1713,87 +1713,6 @@ private theorem rows1 : rcases hm with ⟨rfl, rfl, rfl, rfl⟩ exact rowSecond1 -private theorem h0 : - (by - classical - exact - ∀ (k : Nat), - let dV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ - 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1} - let D := DiamondTile k - let Q := GaussianQuarterTurn - ∀ (c : GaussianInt), - let F : GaussianInt → GaussianInt := fun z => Q z + c - let da : GaussianInt := ⟨(k : Int) + 1, (k : Int)⟩ - (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D ⟨-(k : Int), - (k : Int) + 1⟩) = F '' dV) → ((BoundaryFootprintVertices D ∩ - BoundaryFootprintVertices (TileTranslation D da) = dV) → ((F '' dV = {z : GaussianInt - | -(k : Int) ≤ z.re ∧ z.re ≤ 0 ∧ (k : Int) + 1 ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ 2 * (k - : Int) ≤ z.im - z.re ∧ z.im - z.re ≤ 2 * (k : Int) + 1}) → ((dV = {z : GaussianInt | - 1 ≤ z.re ∧ z.re ≤ (k : Int) ∧ (k : Int) ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ 2 * (k : Int) - ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1}) → ((∀ T, ∀ U, ∀ a, ∀ e, (T, U, a, - e) ∈ [(D, TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩, (⟨0, 2 * (k : Int)⟩ : - GaussianInt), ⟨-(k : Int), (k : Int) + 1⟩), (D, TileTranslation D da, (⟨1, 2 * (k : - Int)⟩ : GaussianInt), ⟨(k : Int), (k : Int)⟩)] → Finset.Nonempty T.cells ∧ - Finset.Nonempty U.cells ∧ Disjoint T.cells U.cells ∧ SimpleGridPathBetween - (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) (BoundaryFootprintEdges T - ∩ BoundaryFootprintEdges U) a e) → ((∀ T, ∀ U, ∀ a, ∀ e, (T, U, a, e) ∈ [(D, - TileTranslation D ⟨-(k : Int), (k : Int) + 1⟩, (⟨0, 2 * (k : Int)⟩ : GaussianInt), - ⟨-(k : Int), (k : Int) + 1⟩), (D, TileTranslation D da, (⟨1, 2 * (k : Int)⟩ : - GaussianInt), ⟨(k : Int), (k : Int)⟩)] → Finset.Nonempty T.cells ∧ Finset.Nonempty - U.cells ∧ Disjoint T.cells U.cells ∧ SimpleGridPathBetween (BoundaryFootprintVertices - T ∩ BoundaryFootprintVertices U) (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges - U) a e) ∧ (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D - ⟨-(k : Int), (k : Int) + 1⟩) = {z | -(k : Int) ≤ z.re ∧ z.re ≤ 0 ∧ (k : Int) + 1 ≤ - z.im ∧ z.im ≤ 2 * (k : Int) ∧ 2 * (k : Int) ≤ z.im - z.re ∧ z.im - z.re ≤ 2 * (k : - Int) + 1}) ∧ (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices - (TileTranslation D da) = {z | 1 ≤ z.re ∧ z.re ≤ (k : Int) ∧ (k : Int) ≤ z.im ∧ z.im ≤ - 2 * (k : Int) ∧ 2 * (k : Int) ≤ z.re + z.im ∧ z.re + z.im ≤ 2 * (k : Int) + 1})))))) - ) := by - classical - intro k dV D Q c F da firstVertices secondVertices firstSet secondSet rows0 - exact ⟨rows0, by rw [firstVertices, firstSet], by rw [secondVertices, secondSet]⟩ - -private theorem h1 : - (by - classical - exact - ∀ (k : Nat), - let iV : Set GaussianInt := {z | 1 ≤ z.re ∧ z.re ≤ k ∧ - z.re - 1 ≤ z.im ∧ z.im ≤ z.re} - let D := DiamondTile k - let Qinv : GaussianInt → GaussianInt := fun z => ⟨z.im, -z.re⟩ - let G : GaussianInt → GaussianInt := fun z => - ⟨z.im - (k : Int), (k : Int) - z.re⟩ - let ia : GaussianInt := ⟨(k : Int) + 1, -(k : Int)⟩ - let shift : GaussianInt := ⟨-(k : Int) - 1, (k : Int)⟩ - (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D (Qinv ia)) = - G '' iV) → ((BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation - D shift) = GaussianTranslation shift '' iV) → ((G '' iV = {z : GaussianInt | -(k : - Int) ≤ z.re ∧ z.re ≤ 0 ∧ 0 ≤ z.im ∧ z.im ≤ (k : Int) - 1 ∧ -1 ≤ z.re + z.im ∧ z.re + - z.im ≤ 0}) → ((GaussianTranslation shift '' iV = {z : GaussianInt | -(k : Int) ≤ z.re - ∧ z.re ≤ -1 ∧ (k : Int) ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ 2 * (k : Int) ≤ z.im - z.re ∧ - z.im - z.re ≤ 2 * (k : Int) + 1}) → ((∀ T, ∀ U, ∀ a, ∀ e, (T, U, a, e) ∈ [(D, - TileTranslation D (Qinv ia), (⟨-(k : Int), (k : Int) - 1⟩ : GaussianInt), 0), (D, - TileTranslation D shift, (⟨-(k : Int), (k : Int)⟩ : GaussianInt), ⟨-1, 2 * (k : - Int)⟩)] → Finset.Nonempty T.cells ∧ Finset.Nonempty U.cells ∧ Disjoint T.cells - U.cells ∧ SimpleGridPathBetween (BoundaryFootprintVertices T ∩ - BoundaryFootprintVertices U) (BoundaryFootprintEdges T ∩ BoundaryFootprintEdges U) a - e) → ((∀ T, ∀ U, ∀ a, ∀ e, (T, U, a, e) ∈ [(D, TileTranslation D (Qinv ia), (⟨-(k : - Int), (k : Int) - 1⟩ : GaussianInt), 0), (D, TileTranslation D shift, (⟨-(k : Int), - (k : Int)⟩ : GaussianInt), ⟨-1, 2 * (k : Int)⟩)] → Finset.Nonempty T.cells ∧ - Finset.Nonempty U.cells ∧ Disjoint T.cells U.cells ∧ SimpleGridPathBetween - (BoundaryFootprintVertices T ∩ BoundaryFootprintVertices U) (BoundaryFootprintEdges T - ∩ BoundaryFootprintEdges U) a e) ∧ (BoundaryFootprintVertices D ∩ - BoundaryFootprintVertices (TileTranslation D (Qinv ia)) = {z | -(k : Int) ≤ z.re ∧ - z.re ≤ 0 ∧ 0 ≤ z.im ∧ z.im ≤ (k : Int) - 1 ∧ -1 ≤ z.re + z.im ∧ z.re + z.im ≤ 0}) ∧ - (BoundaryFootprintVertices D ∩ BoundaryFootprintVertices (TileTranslation D shift) = - {z | -(k : Int) ≤ z.re ∧ z.re ≤ -1 ∧ (k : Int) ≤ z.im ∧ z.im ≤ 2 * (k : Int) ∧ 2 * (k - : Int) ≤ z.im - z.re ∧ z.im - z.re ≤ 2 * (k : Int) + 1})))))) ) := by - classical - intro k iV D Qinv G ia shift thirdVertices fourthVertices thirdSet fourthSet rows1 - exact ⟨rows1, by rw [thirdVertices, thirdSet], by rw [fourthVertices, fourthSet]⟩ - end DiamondPathComparison namespace DiamondRowConclusions @@ -2017,13 +1936,12 @@ private theorem h0 : classical intro k dV decVertices D Q dzeroD c hcEq F_inj quarterVerticesAt dShift zeroQ da secondVertices rowFirst0 rowSecond0 - exact DiamondPathComparison.h0 k c - (DiamondPathComparison.firstVertices k decVertices c F_inj - (DiamondPathComparison.zeroFvertices k dzeroD c quarterVerticesAt zeroQ) - (DiamondPathComparison.rightFvertices k c quarterVerticesAt dShift)) - secondVertices (DiamondPathComparison.firstSet k c hcEq) - (DiamondPathComparison.secondSet k) (DiamondPathComparison.rows0 k - rowFirst0 rowSecond0) + have firstVertices := DiamondPathComparison.firstVertices k decVertices c F_inj + (DiamondPathComparison.zeroFvertices k dzeroD c quarterVerticesAt zeroQ) + (DiamondPathComparison.rightFvertices k c quarterVerticesAt dShift) + exact ⟨DiamondPathComparison.rows0 k rowFirst0 rowSecond0, + by rw [firstVertices]; exact DiamondPathComparison.firstSet k c hcEq, + by rw [secondVertices]; exact DiamondPathComparison.secondSet k⟩ private theorem h1 : (by @@ -2072,13 +1990,13 @@ private theorem h1 : classical intro k incVertices D Qinv G_inj inverseVerticesAt inverseVerticesZero ia shift translateInj hnestedV rowFirst1 rowSecond1 - exact DiamondPathComparison.h1 k - (DiamondPathComparison.thirdVertices k incVertices G_inj inverseVerticesAt - inverseVerticesZero) - (DiamondPathComparison.fourthVertices k (DiamondPathComparison.shiftVertices k - incVertices translateInj hnestedV)) (DiamondPathComparison.thirdSet k) - (DiamondPathComparison.fourthSet k) (DiamondPathComparison.rows1 k - rowFirst1 rowSecond1) + have thirdVertices := DiamondPathComparison.thirdVertices k incVertices G_inj + inverseVerticesAt inverseVerticesZero + have fourthVertices := DiamondPathComparison.fourthVertices k + (DiamondPathComparison.shiftVertices k incVertices translateInj hnestedV) + exact ⟨DiamondPathComparison.rows1 k rowFirst1 rowSecond1, + by rw [thirdVertices]; exact DiamondPathComparison.thirdSet k, + by rw [fourthVertices]; exact DiamondPathComparison.fourthSet k⟩ end DiamondRowConclusions diff --git a/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean index 1dc2bdfd8c..87326e6a60 100644 --- a/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean +++ b/LeanPool/ApollonianSuperharmonic/P5630T1MarkedRightOdometerAdjacencyReduction.lean @@ -434,41 +434,6 @@ private theorem hOFixedOriginal : bundle.normalized_fixed_function_eq, hfunL] at h exact h -private theorem hcentOriginal : - (by - classical - exact - ∀ (C : BandCircle), ∀ (T : ProtoTile), ∀ (T₀ : ProtoTile), ∀ (h : PartialOdometer), ∀ (h₀ - : PartialOdometer), ∀ (x : GaussianInt), ∀ (bundle : - BandOrderedGeneralNormalizedOccurrenceBundle C C T T₀ h h₀ x), ∀ (ginv : - BandPackingSymmetry), (∀ (T_1 : ProtoTile), BandPackingSymmetryTileAction ginv - (BandPackingSymmetryTileAction bundle.symmetry T_1) = T_1) → (∀ (t' : Fin (4 : ℕ)), - (TileCentroid (BandPackingSymmetryTileAction ginv (bundle.pieces bundle.selectedSlot - bundle.selectedSign)) - TileCentroid (BandPackingSymmetryTileAction ginv - bundle.normalizedFixed) = (1 / 2 : ℝ) • GaussianRealPoint ((⟨(0 : ℤ), (1 : ℤ)⟩ : - GaussianInt) ^ (↑t' : ℕ) * (BandVectors.1 (BandPackingSymmetryQuadrupleAction ginv - bundle.normalizedPresentation (if BandPackingSymmetryReversesOrientation ginv = true - then -bundle.selectedSlot else bundle.selectedSlot).succ) - (BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation (0 : Fin (4 : - ℕ))) + BandVectors.1 (BandPackingSymmetryQuadrupleAction ginv - bundle.normalizedPresentation (0 : Fin (4 : ℕ))) (BandPackingSymmetryQuadrupleAction - ginv bundle.normalizedPresentation (if BandPackingSymmetryReversesOrientation ginv = - true then -bundle.selectedSlot else bundle.selectedSlot).succ)))) → ( - let selectedSupport := bundle.pieces bundle.selectedSlot bundle.selectedSign - let T' := BandPackingSymmetryTileAction ginv selectedSupport - TileCentroid T' - TileCentroid T₀ = (1 / 2 : ℝ) • GaussianRealPoint ((⟨0, 1⟩ : - GaussianInt) ^ t'.val * (BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv - bundle.normalizedPresentation) (if BandPackingSymmetryReversesOrientation ginv then - -bundle.selectedSlot else bundle.selectedSlot).succ) - ((BandPackingSymmetryQuadrupleAction ginv bundle.normalizedPresentation) 0) + - BandVectors.1 ((BandPackingSymmetryQuadrupleAction ginv - bundle.normalizedPresentation) 0) ((BandPackingSymmetryQuadrupleAction ginv - bundle.normalizedPresentation) (if BandPackingSymmetryReversesOrientation ginv then - -bundle.selectedSlot else bundle.selectedSlot).succ))))) ) := by - classical - intro C T T₀ h h₀ x bundle ginv htileL t' hcentInv selectedSupport T' - simpa [T', bundle.normalized_fixed_eq, htileL] using hcentInv - private theorem hrootCoord : (by classical @@ -860,8 +825,8 @@ theorem P5630T1MarkedRightOdometerAdjacencyReduction : simpa [hselectedCoord, T', h'] using hOSelectedInv have hslopeFixedOriginal : PartialOdometerSlope h₀ = some pFixed := by simpa [bundle.normalized_fixed_function_eq, hfunL] using hslopeFixedInv - have hcentOriginal := MarkedRightAdjacencyGeometry.hcentOriginal C T T₀ h h₀ x bundle ginv - htileL t' hcentInv + have hcentOriginal := hcentInv + rw [bundle.normalized_fixed_eq, htileL] at hcentOriginal have hrootCoord := MarkedRightAdjacencyGeometry.hrootCoord C T T₀ h h₀ x bundle ginv hcircleL hnorm have hnewAdj := MarkedRightAdjacencyGeometry.hnewAdj C T T₀ h h₀ x bundle hq ginv pFixed diff --git a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean index 6d6c975751..a9f757ed12 100644 --- a/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean +++ b/LeanPool/ApollonianSuperharmonic/PeriodicTileTotalIndegree.lean @@ -5,6 +5,10 @@ Authors: Wesley Pegden -/ module +public import LeanPool.ApollonianSuperharmonic.LatticeCellEdges + +public import LeanPool.ApollonianSuperharmonic.BoundaryFootprintInclusion + public import Mathlib.Init public import LeanPool.ApollonianSuperharmonic.PairAssignmentFacts public import LeanPool.ApollonianSuperharmonic.TileCornerMultiplicity @@ -188,89 +192,9 @@ private theorem hvertex_partition : intro T D heuler I cornerBag N hinc hN4 omega -private abbrev pair_eq := - @PairAssignmentFacts.finsetPair GaussianInt inferInstance - -private theorem edgeOf_injective : - (by - classical - exact - let I : GaussianInt := ⟨0, 1⟩ - let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => - if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} - (∀ {a : GaussianInt}, - ∀ {b : GaussianInt}, - ∀ {c : GaussianInt}, - ∀ {d : GaussianInt}, - ({ a, b } : Finset GaussianInt) = { c, d } → - a = c ∧ b = d ∨ a = d ∧ b = c) → - Function.Injective edgeOf - ) := by - classical - intro I edgeOf pair_eq - rintro ⟨z, b⟩ ⟨w, d⟩ h - cases b <;> cases d - · change ({z, z + 1} : Finset GaussianInt) = {w, w + 1} at h - replace h := pair_eq h - rcases h with ⟨h, _⟩ | ⟨h1, h2⟩ - · subst w; rfl - · exfalso - have h1r := congrArg Zsqrtd.re h1 - have h2r := congrArg Zsqrtd.re h2 - norm_num at h1r h2r - omega - · change ({z, z + 1} : Finset GaussianInt) = {w, w + I} at h - replace h := pair_eq h - rcases h with ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> exfalso - · have h1i := congrArg Zsqrtd.im h1 - have h2i := congrArg Zsqrtd.im h2 - dsimp only [I] at h1i h2i - norm_num at h1i h2i - omega - · have h1r := congrArg Zsqrtd.re h1 - have h2r := congrArg Zsqrtd.re h2 - norm_num at h1r h2r - omega - · change ({z, z + I} : Finset GaussianInt) = {w, w + 1} at h - replace h := pair_eq h - rcases h with ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> exfalso - · have h1r := congrArg Zsqrtd.re h1 - have h2r := congrArg Zsqrtd.re h2 - norm_num at h1r h2r - omega - · have h1i := congrArg Zsqrtd.im h1 - have h2i := congrArg Zsqrtd.im h2 - dsimp only [I] at h1i h2i - norm_num at h1i h2i - omega - · change ({z, z + I} : Finset GaussianInt) = {w, w + I} at h - replace h := pair_eq h - rcases h with ⟨h, _⟩ | ⟨h1, h2⟩ - · subst w; rfl - · exfalso - have h1i := congrArg Zsqrtd.im h1 - have h2i := congrArg Zsqrtd.im h2 - dsimp only [I] at h1i h2i - norm_num at h1i h2i - omega - private abbrev hV := TileCornerMultiplicity.vertexSupport -private theorem hEV : - (by - classical - exact - ∀ (T : ProtoTile), (T.cells.Nonempty) → (∀ (e : Finset GaussianInt), (e ∈ FootprintEdges - T) → (∀ (z : GaussianInt), (z ∈ e) → (z ∈ FootprintVertices T))) ) := by - classical - intro T hcells e he z hz - rcases he with ⟨c, hc, rfl | rfl | rfl | rfl⟩ - all_goals rw [FootprintVertices, ite_eq_left hcells] - all_goals refine ⟨c, hc, ?_⟩ - all_goals simp only [Finset.mem_insert, Finset.mem_singleton] at hz - all_goals rcases hz with rfl | rfl <;> simp - private theorem hEmem : (by classical @@ -1882,10 +1806,9 @@ private theorem hcountBridge : -- A base point and direction give a unique tag for each footprint edge. let edgeOf : GaussianInt × Bool → Finset GaussianInt := fun p => if p.2 then {p.1, p.1 + I} else {p.1, p.1 + 1} - have edgeOf_injective := PeriodicIndegreeGeometry.edgeOf_injective - (PeriodicIndegreeGeometry.pair_eq) + have edgeOf_injective := LatticeCellEdges.edge_encoding_injective let V := cornerBag.toFinset - have hEV := PeriodicIndegreeGeometry.hEV T hcells + have hEV := BoundaryFootprintInclusion.edgeVertex T let E := (V.product (Finset.univ : Finset Bool)).filter fun e => edgeOf e ∈ FootprintEdges T have hEmem := PeriodicIndegreeGeometry.hEmem T (PeriodicIndegreeGeometry.hV T hcells) hEV From 7eff4715c73dc5f69bfeb2deb9502c55f5e480fe Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 13 Nov 2026 20:14:36 +0000 Subject: [PATCH 23/23] Generalize Gaussian coordinates and neighbor selection proofs --- ...BandOrderedGeneralPositiveCutGeometry.lean | 222 ++-------- ...PackingSymmetryTileOdometerCovariance.lean | 35 +- .../BandRetainedBoundaryGenealogy.lean | 104 +---- .../BoundaryFrameJoinGeometry.lean | 16 +- .../GaussianRealPointProperties.lean | 21 + .../P4112T1LowerNeighbors.lean | 418 +++++------------- .../P4458T1LargestParentRows.lean | 20 +- .../P4458T1SecondNewerRows.lean | 34 +- .../P4536T1AFrameB.lean | 91 +--- .../P4536T1AFrameD.lean | 38 +- 10 files changed, 229 insertions(+), 770 deletions(-) diff --git a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean index 5c9e008e98..ed8f524f0f 100644 --- a/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BandOrderedGeneralPositiveCutGeometry.lean @@ -293,46 +293,6 @@ private theorem hQ1S1 : exact Finset.mem_inter.mpr ⟨hxP, hxM⟩ exact Finset.disjoint_left.mp hOQ1.symm hxQ hxO -private theorem selectA_Q : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), (LatticeTile (cert.Q 1 true)) → ((LatticeTile (cert.S 2 false)) → - ((LatticeTile cert.O) → ((NoCheckerboardCellVertex (↑(cert.Q (1 : Fin (3 : ℕ)) - true).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑(cert.S (2 : Fin (3 : - ℕ)) false).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑cert.O.cells : - Set LatticeCell)) → ((∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptionalSegments.a j ∈ (cert.Q 1 true).cells) → ((∃ j : Fin 4, - LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.S 2 false).cells) → - ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.Q 1 - true).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.S 2 - false).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ - cert.O.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptionalSegments.a j ∈ cert.O.cells) → ((Disjoint (cert.Q (1 : Fin (3 : ℕ)) - true).cells (cert.S (2 : Fin (3 : ℕ)) false).cells) → ((Disjoint (cert.S (2 : Fin (3 - : ℕ)) false).cells cert.O.cells) → ((Disjoint cert.O.cells (cert.Q (1 : Fin (3 : ℕ)) - true).cells) → (∀ D, D = cert.Q 1 true ∨ D = cert.S 2 false ∨ D = cert.O → ∃ U V R : - ProtoTile, (D = U ∨ D = V) ∧ ((U = cert.Q 1 true ∧ V = cert.S 2 false ∧ R = cert.O) ∨ - (U = cert.S 2 false ∧ V = cert.Q 1 true ∧ R = cert.O) ∨ (U = cert.Q 1 true ∧ V = - cert.O ∧ R = cert.S 2 false) ∨ (U = cert.O ∧ V = cert.Q 1 true ∧ R = cert.S 2 false) - ∨ (U = cert.S 2 false ∧ V = cert.O ∧ R = cert.Q 1 true) ∨ (U = cert.O ∧ V = cert.S 2 - false ∧ R = cert.Q 1 true)) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptionalSegments.a j ∈ U.cells ∧ LatticeVertexIncidentCell - cert.exceptionalSegments.a (j + 2) ∈ V.cells) ∧ cert.exceptionalSegments.a ∈ - FootprintVertices U ∧ cert.exceptionalSegments.a ∈ FootprintVertices V ∧ (∀ y, y = - cert.exceptionalSegments.a ∨ y = cert.exceptionalSegments.a + 1 ∨ y = - cert.exceptionalSegments.a - 1 ∨ y = cert.exceptionalSegments.a + ⟨0, 1⟩ ∨ y = - cert.exceptionalSegments.a - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ - FootprintVertices V)))))))))))))) ) := by - classical - intro q cfg C₀ T cert hQ2lat hS3lat hOlat hQ2check hS3check hOcheck hQ2occ hS3occ hAowners - hOoccA hQS hSO hOQ D hD - exact ThreeOwnerDesignatedOppositePair (cert.Q 1 true) (cert.S 2 false) cert.O - cert.exceptionalSegments.a hQ2lat hS3lat hOlat hQS hSO hOQ - hQ2check hS3check hOcheck hAowners hQ2occ hS3occ hOoccA D hD - private theorem normalize_selected : (by classical @@ -445,153 +405,6 @@ private theorem ne_of_disjoint : rcases hne with ⟨c, hc⟩ exact Finset.disjoint_left.mp h hc hc -private theorem selectB_S : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), (LatticeTile (cert.Q 2 true)) → ((LatticeTile (cert.S 1 false)) → - ((LatticeTile cert.O) → ((NoCheckerboardCellVertex (↑(cert.Q (2 : Fin (3 : ℕ)) - true).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑(cert.S (1 : Fin (3 : - ℕ)) false).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑cert.O.cells : - Set LatticeCell)) → ((∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptionalSegments.b j ∈ (cert.Q 2 true).cells) → ((∃ j : Fin 4, - LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 false).cells) → - ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q 2 - true).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 - false).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ - cert.O.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptionalSegments.b j ∈ cert.O.cells) → ((Disjoint (cert.Q (2 : Fin (3 : ℕ)) - true).cells (cert.S (1 : Fin (3 : ℕ)) false).cells) → ((Disjoint (cert.S (1 : Fin (3 - : ℕ)) false).cells cert.O.cells) → ((Disjoint cert.O.cells (cert.Q (2 : Fin (3 : ℕ)) - true).cells) → (∀ D, D = cert.S 1 false ∨ D = cert.Q 2 true ∨ D = cert.O → ∃ U V R : - ProtoTile, (D = U ∨ D = V) ∧ ((U = cert.S 1 false ∧ V = cert.Q 2 true ∧ R = cert.O) ∨ - (U = cert.Q 2 true ∧ V = cert.S 1 false ∧ R = cert.O) ∨ (U = cert.S 1 false ∧ V = - cert.O ∧ R = cert.Q 2 true) ∨ (U = cert.O ∧ V = cert.S 1 false ∧ R = cert.Q 2 true) ∨ - (U = cert.Q 2 true ∧ V = cert.O ∧ R = cert.S 1 false) ∨ (U = cert.O ∧ V = cert.Q 2 - true ∧ R = cert.S 1 false)) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptionalSegments.b j ∈ U.cells ∧ LatticeVertexIncidentCell - cert.exceptionalSegments.b (j + 2) ∈ V.cells) ∧ cert.exceptionalSegments.b ∈ - FootprintVertices U ∧ cert.exceptionalSegments.b ∈ FootprintVertices V ∧ (∀ y, y = - cert.exceptionalSegments.b ∨ y = cert.exceptionalSegments.b + 1 ∨ y = - cert.exceptionalSegments.b - 1 ∨ y = cert.exceptionalSegments.b + ⟨0, 1⟩ ∨ y = - cert.exceptionalSegments.b - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ - FootprintVertices V)))))))))))))) ) := by - classical - intro q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck hQ3occ hS2occ hBowners - hOoccB hQ3S2 hS2O hOQ3 D hD - have owners : ∀ j : Fin 4, - LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 false).cells ∨ - LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q 2 true).cells ∨ - LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ cert.O.cells := by - intro j - rcases hBowners j with hq | hs | ho - · exact Or.inr (Or.inl hq) - · exact Or.inl hs - · exact Or.inr (Or.inr ho) - exact ThreeOwnerDesignatedOppositePair (cert.S 1 false) (cert.Q 2 true) cert.O - cert.exceptionalSegments.b hS2lat hQ3lat hOlat hQ3S2.symm hOQ3.symm hS2O.symm - hS2check hQ3check hOcheck owners hS2occ hQ3occ hOoccB D hD - -private theorem selectA_O : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), (LatticeTile (cert.Q 1 true)) → ((LatticeTile (cert.S 2 false)) → - ((LatticeTile cert.O) → ((NoCheckerboardCellVertex (↑(cert.Q (1 : Fin (3 : ℕ)) - true).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑(cert.S (2 : Fin (3 : - ℕ)) false).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑cert.O.cells : - Set LatticeCell)) → ((∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptionalSegments.a j ∈ (cert.Q 1 true).cells) → ((∃ j : Fin 4, - LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.S 2 false).cells) → - ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.Q 1 - true).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.S 2 - false).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ - cert.O.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptionalSegments.a j ∈ cert.O.cells) → ((Disjoint (cert.Q (1 : Fin (3 : ℕ)) - true).cells (cert.S (2 : Fin (3 : ℕ)) false).cells) → ((Disjoint (cert.S (2 : Fin (3 - : ℕ)) false).cells cert.O.cells) → ((Disjoint cert.O.cells (cert.Q (1 : Fin (3 : ℕ)) - true).cells) → (∀ D, D = cert.O ∨ D = cert.Q 1 true ∨ D = cert.S 2 false → ∃ U V R : - ProtoTile, (D = U ∨ D = V) ∧ ((U = cert.O ∧ V = cert.Q 1 true ∧ R = cert.S 2 false) ∨ - (U = cert.Q 1 true ∧ V = cert.O ∧ R = cert.S 2 false) ∨ (U = cert.O ∧ V = cert.S 2 - false ∧ R = cert.Q 1 true) ∨ (U = cert.S 2 false ∧ V = cert.O ∧ R = cert.Q 1 true) ∨ - (U = cert.Q 1 true ∧ V = cert.S 2 false ∧ R = cert.O) ∨ (U = cert.S 2 false ∧ V = - cert.Q 1 true ∧ R = cert.O)) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptionalSegments.a j ∈ U.cells ∧ LatticeVertexIncidentCell - cert.exceptionalSegments.a (j + 2) ∈ V.cells) ∧ cert.exceptionalSegments.a ∈ - FootprintVertices U ∧ cert.exceptionalSegments.a ∈ FootprintVertices V ∧ (∀ y, y = - cert.exceptionalSegments.a ∨ y = cert.exceptionalSegments.a + 1 ∨ y = - cert.exceptionalSegments.a - 1 ∨ y = cert.exceptionalSegments.a + ⟨0, 1⟩ ∨ y = - cert.exceptionalSegments.a - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ - FootprintVertices V)))))))))))))) ) := by - classical - intro q cfg C₀ T cert hQ2lat hS3lat hOlat hQ2check hS3check hOcheck hQ2occ hS3occ hAowners - hOoccA hQS hSO hOQ D hD - have owners : ∀ j : Fin 4, - LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ cert.O.cells ∨ - LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.Q 1 true).cells ∨ - LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.S 2 false).cells := by - intro j - rcases hAowners j with hq | hs | ho - · exact Or.inr (Or.inl hq) - · exact Or.inr (Or.inr hs) - · exact Or.inl ho - exact ThreeOwnerDesignatedOppositePair cert.O (cert.Q 1 true) (cert.S 2 false) - cert.exceptionalSegments.a hOlat hQ2lat hS3lat hOQ hQS hSO - hOcheck hQ2check hS3check owners hOoccA hQ2occ hS3occ D hD - -private theorem selectB_O : - (by - classical - exact - ∀ (q : Fin 4 → CircleCoordinates), ∀ (cfg : BandOrderedGeneralConfiguration q), ∀ (C₀ : - BandCircle), ∀ (T : ProtoTile), ∀ (cert : BandOrderedGeneralLayoutCertificate q cfg - C₀ T), (LatticeTile (cert.Q 2 true)) → ((LatticeTile (cert.S 1 false)) → - ((LatticeTile cert.O) → ((NoCheckerboardCellVertex (↑(cert.Q (2 : Fin (3 : ℕ)) - true).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑(cert.S (1 : Fin (3 : - ℕ)) false).cells : Set LatticeCell)) → ((NoCheckerboardCellVertex (↑cert.O.cells : - Set LatticeCell)) → ((∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptionalSegments.b j ∈ (cert.Q 2 true).cells) → ((∃ j : Fin 4, - LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 false).cells) → - ((∀ j : Fin 4, LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q 2 - true).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 - false).cells ∨ LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ - cert.O.cells) → ((∃ (j : Fin (4 : ℕ)), LatticeVertexIncidentCell - cert.exceptionalSegments.b j ∈ cert.O.cells) → ((Disjoint (cert.Q (2 : Fin (3 : ℕ)) - true).cells (cert.S (1 : Fin (3 : ℕ)) false).cells) → ((Disjoint (cert.S (1 : Fin (3 - : ℕ)) false).cells cert.O.cells) → ((Disjoint cert.O.cells (cert.Q (2 : Fin (3 : ℕ)) - true).cells) → (∀ D, D = cert.O ∨ D = cert.S 1 false ∨ D = cert.Q 2 true → ∃ U V R : - ProtoTile, (D = U ∨ D = V) ∧ ((U = cert.O ∧ V = cert.S 1 false ∧ R = cert.Q 2 true) ∨ - (U = cert.S 1 false ∧ V = cert.O ∧ R = cert.Q 2 true) ∨ (U = cert.O ∧ V = cert.Q 2 - true ∧ R = cert.S 1 false) ∨ (U = cert.Q 2 true ∧ V = cert.O ∧ R = cert.S 1 false) ∨ - (U = cert.S 1 false ∧ V = cert.Q 2 true ∧ R = cert.O) ∨ (U = cert.Q 2 true ∧ V = - cert.S 1 false ∧ R = cert.O)) ∧ (∃ j : Fin 4, LatticeVertexIncidentCell - cert.exceptionalSegments.b j ∈ U.cells ∧ LatticeVertexIncidentCell - cert.exceptionalSegments.b (j + 2) ∈ V.cells) ∧ cert.exceptionalSegments.b ∈ - FootprintVertices U ∧ cert.exceptionalSegments.b ∈ FootprintVertices V ∧ (∀ y, y = - cert.exceptionalSegments.b ∨ y = cert.exceptionalSegments.b + 1 ∨ y = - cert.exceptionalSegments.b - 1 ∨ y = cert.exceptionalSegments.b + ⟨0, 1⟩ ∨ y = - cert.exceptionalSegments.b - ⟨0, 1⟩ → y ∈ FootprintVertices U ∨ y ∈ - FootprintVertices V)))))))))))))) ) := by - classical - intro q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck hQ3occ hS2occ hBowners - hOoccB hQ3S2 hS2O hOQ3 D hD - have owners : ∀ j : Fin 4, - LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ cert.O.cells ∨ - LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 false).cells ∨ - LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q 2 true).cells := by - intro j - rcases hBowners j with hq | hs | ho - · exact Or.inr (Or.inr hq) - · exact Or.inr (Or.inl hs) - · exact Or.inl ho - exact ThreeOwnerDesignatedOppositePair cert.O (cert.S 1 false) (cert.Q 2 true) - cert.exceptionalSegments.b hOlat hS2lat hQ3lat hS2O.symm hQ3S2.symm hOQ3.symm - hOcheck hS2check hQ3check owners hOoccB hS2occ hQ3occ D hD - private theorem hI2mul : (by classical @@ -1730,22 +1543,41 @@ theorem BandOrderedGeneralPositiveCutGeometry have hneA_OS := ne_of_disjoint _ _ hSO.symm hOne have hneB_OS := ne_of_disjoint _ _ hS2O.symm hOne have hneB_OQ := ne_of_disjoint _ _ hOQ3 hOne + have ownersAFromO (j : Fin 4) : + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ cert.O.cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.Q 1 true).cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.a j ∈ (cert.S 2 false).cells := by + simpa only [or_assoc, or_comm, or_left_comm] using hAowners j + have ownersBFromS (j : Fin 4) : + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 false).cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q 2 true).cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ cert.O.cells := by + simpa only [or_assoc, or_comm, or_left_comm] using hBowners j + have ownersBFromO (j : Fin 4) : + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ cert.O.cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.S 1 false).cells ∨ + LatticeVertexIncidentCell cert.exceptionalSegments.b j ∈ (cert.Q 2 true).cells := by + simpa only [or_assoc, or_comm, or_left_comm] using hBowners j have selected_p2_a := normalize_selected (cert.Q 1 true) (cert.S 2 false) cert.O cert.exceptionalSegments.a hneA_QS hneA_QO - ((PositiveCutGeometry.selectA_Q q cfg C₀ T cert hQ2lat hS3lat hOlat hQ2check hS3check hOcheck - hQ2occ hS3occ hAowners hOoccA hQS hSO hOQ) (cert.Q 1 true) (Or.inl rfl)) + (ThreeOwnerDesignatedOppositePair (cert.Q 1 true) (cert.S 2 false) cert.O + cert.exceptionalSegments.a hQ2lat hS3lat hOlat hQS hSO hOQ + hQ2check hS3check hOcheck hAowners hQ2occ hS3occ hOoccA _ (Or.inl rfl)) have selected_p2_b := normalize_selected (cert.S 1 false) (cert.Q 2 true) cert.O cert.exceptionalSegments.b hneB_SQ hneB_SO' - ((PositiveCutGeometry.selectB_S q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck - hQ3occ hS2occ hBowners hOoccB hQ3S2 hS2O hOQ3) (cert.S 1 false) (Or.inl rfl)) + (ThreeOwnerDesignatedOppositePair (cert.S 1 false) (cert.Q 2 true) cert.O + cert.exceptionalSegments.b hS2lat hQ3lat hOlat hQ3S2.symm hOQ3.symm hS2O.symm + hS2check hQ3check hOcheck ownersBFromS hS2occ hQ3occ hOoccB _ (Or.inl rfl)) have selected_p4_a := normalize_selected cert.O (cert.Q 1 true) (cert.S 2 false) cert.exceptionalSegments.a hneA_OQ hneA_OS - ((PositiveCutGeometry.selectA_O q cfg C₀ T cert hQ2lat hS3lat hOlat hQ2check hS3check hOcheck - hQ2occ hS3occ hAowners hOoccA hQS hSO hOQ) cert.O (Or.inl rfl)) + (ThreeOwnerDesignatedOppositePair cert.O (cert.Q 1 true) (cert.S 2 false) + cert.exceptionalSegments.a hOlat hQ2lat hS3lat hOQ hQS hSO + hOcheck hQ2check hS3check ownersAFromO hOoccA hQ2occ hS3occ _ (Or.inl rfl)) have selected_p4_b := normalize_selected cert.O (cert.S 1 false) (cert.Q 2 true) cert.exceptionalSegments.b hneB_OS hneB_OQ - ((PositiveCutGeometry.selectB_O q cfg C₀ T cert hQ3lat hS2lat hOlat hQ3check hS2check hOcheck - hQ3occ hS2occ hBowners hOoccB hQ3S2 hS2O hOQ3) cert.O (Or.inl rfl)) + (ThreeOwnerDesignatedOppositePair cert.O (cert.S 1 false) (cert.Q 2 true) + cert.exceptionalSegments.b hOlat hS2lat hQ3lat hS2O.symm hQ3S2.symm hOQ3.symm + hOcheck hS2check hQ3check ownersBFromO hOoccB hS2occ hQ3occ _ (Or.inl rfl)) let I : GaussianInt := ⟨0, 1⟩ have hI2 : I ^ 2 = -1 := by dsimp [I]; decide have hI3 : I ^ 3 = -I := by dsimp [I]; decide diff --git a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean index 0245a7eca2..a2831dd497 100644 --- a/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean +++ b/LeanPool/ApollonianSuperharmonic/BandPackingSymmetryTileOdometerCovariance.lean @@ -1634,39 +1634,6 @@ private theorem hphaseEq : exact BandPackingSymmetryScopedPhaseUnique a q hq negative delta hphaseAffine hphase -private theorem hOorig : - (by - classical - exact - ∀ (h : PartialOdometer), ∀ (U : ProtoTile), ∀ (q : Fin (4 : ℕ) → CircleCoordinates), - (ProperBandQuadruple q) → (∀ (S : Fin (3 : ℕ) → Bool → ProtoTile), ∀ (hs : Fin (3 : - ℕ) → Bool → PartialOdometer), (BandPrototile (q (0 : Fin (4 : ℕ))) U) → ((∀ (i : Fin - (3 : ℕ)), ∀ (s : Bool), TileOdometer (q i.succ) (S i s) (hs i s)) → ((∀ (x : - LatticeCell), x ∈ U.cells ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (S i s).cells) → ((∀ - (i : Fin (3 : ℕ)), ∀ (s : Bool), FootprintVertices (S i s) ⊆ FootprintVertices U) → - ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), TileCentroid (S i s) - TileCentroid U = (if s = - true then (1 : ℝ) else (-1 : ℝ)) • (1 / 2 : ℝ) • (GaussianRealPoint (BandVectors.1 (q - (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ)) - - (-(GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin - (3 : ℕ))).succ))).2, (GaussianRealPoint (BandVectors.1 (q (i + (2 : Fin (3 : - ℕ))).succ) (q (i + (1 : Fin (3 : ℕ))).succ))).1))) → ((∀ (x : GaussianInt), x ∈ - h.domain ↔ ∃ (i : Fin (3 : ℕ)) (s : Bool), x ∈ (hs i s).domain) → ((∀ (i : Fin (3 : - ℕ)), ∀ (s : Bool), ∀ x ∈ (hs i s).domain, h.value x = (hs i s).value x) → ((∀ (i : - Fin (3 : ℕ)), ∀ (s : Bool), ∀ (j : Fin (3 : ℕ)), ∀ (t : Bool), OdometerCompatibility - (hs i s) (hs j t)) → ((∀ (i : Fin (3 : ℕ)), ∀ (s : Bool), (q i.succ).1 = (0 : ℤ) ∨ ∃ - (p : ℝ × ℝ) (p_i : ℝ × ℝ), PartialOdometerSlope h = some p ∧ PartialOdometerSlope (hs - i s) = some p_i ∧ p_i.1 - p.1 = (if s = true then (1 : ℝ) else (-1 : ℝ)) * (1 / 2 : - ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : Fin (3 : - ℕ))).succ)).re : ℝ) - (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : - Fin (3 : ℕ))).succ)).im : ℝ)) ∧ p_i.2 - p.2 = (if s = true then (1 : ℝ) else (-1 : - ℝ)) * (1 / 2 : ℝ) * ((↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q (i + (1 : - Fin (3 : ℕ))).succ)).im : ℝ) + (↑(BandVectors.2 (q (i + (2 : Fin (3 : ℕ))).succ) (q - (i + (1 : Fin (3 : ℕ))).succ)).re : ℝ))) → (TileOdometer (q 0) U h)))))))))) ) := by - classical - intro h U q hq S hs hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope - exact TileOdometer.decompose hq hT hsub hcells hfoot hcentroid - hdom hvalue hcompat hslope - end TileOdometerAssembly namespace TileOdometerConclusion @@ -1888,7 +1855,7 @@ theorem BandPackingSymmetryTileOdometerCovariance have hphaseEq := TileOdometerAssembly.hphaseEq q hq a delta hphase negative hphaseAffine have hUne : U.cells.Nonempty := positiveCells (q 0) U (ProperBandCurvatureStructure q hq).1 hT - have hOorig := TileOdometerAssembly.hOorig h U q hq S hs hT hsub hcells hfoot hcentroid + have hOorig := TileOdometer.decompose hq hT hsub hcells hfoot hcentroid hdom hvalue hcompat hslope have hUdom := PositiveCurvatureTileOdometerDomain (q 0) U h (ProperBandCurvatureStructure q hq).1 hOorig diff --git a/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean b/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean index cf1101555e..4587df50f2 100644 --- a/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean +++ b/LeanPool/ApollonianSuperharmonic/BandRetainedBoundaryGenealogy.lean @@ -268,80 +268,18 @@ private theorem haum'At397 : have he := hatMostOneUnit (index i) (index j) hi' hj' fin_cases i <;> fin_cases j <;> simp [index] at he ⊢ -private theorem hs'At413 : - ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (q = ![((2 : ℤ) * - (p (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : - ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : - GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p - (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ( - let pr : Fin 4 → CircleCoordinates := p - let u := BandPackingSymmetryQuadrupleAction .conjugate q - let pp := BandPackingSymmetryQuadrupleAction .conjugate pr - ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → (u = ![(2 * (pp 0).1 + 2 * (pp 2).1 + 2 - * (pp 3).1 - (pp 1).1, - 2 * (pp 0).2 + 2 * (pp 2).2 + 2 * (pp 3).2 - (pp 1).2), pp 0, pp 2, pp 3]))) := by - classical - intro q p hsucc pr u pp negOneSucc negTwoSucc - have hss := congrArg - (fun z => BandPackingSymmetryQuadrupleAction .conjugate z) hsucc - change BandPackingSymmetryQuadrupleAction .conjugate q = _ - convert hss using 1; - simp only [Nat.succ_eq_add_one, Nat.reduceAdd, BandPackingSymmetryQuadrupleAction, - BandPackingSymmetryCircleAction, Fin.isValue, GaussianReflection, Int.reduceNeg, - BandPackingSymmetryReversesOrientation, ↓reduceIte, neg_zero, Fin.succ_zero_eq_one, - negOneSucc, negTwoSucc, Matrix.cons_val_zero, Matrix.cons_val, Matrix.cons_val_one, - Zsqrtd.re_sub, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.re_ofNat, Nat.cast_ofNat, - Zsqrtd.im_ofNat, mul_zero, zero_mul, add_zero, Zsqrtd.im_sub, Zsqrtd.im_add, - Zsqrtd.im_mul, neg_sub, Matrix.vecCons_inj, Prod.mk.injEq, sub_left_inj, and_true, pp, - pr]; - try { constructor - · ring - · ext <;> simp [] <;> ring } - -private theorem hs'At528 : - ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (![q (0 : Fin (4 - : ℕ)), q (2 : Fin (4 : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p - (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : - ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : - GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p - (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ( - let base : Fin 4 → CircleCoordinates := ![q 0, q 2, q 3, q 1] - let u := BandPackingSymmetryQuadrupleAction .conjugate base +private theorem conjugateSuccessor (base p : Fin 4 → CircleCoordinates) + (hsucc : base = + ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, + 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) : let pp := BandPackingSymmetryQuadrupleAction .conjugate p - ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → (u = ![(2 * (pp 0).1 + 2 * (pp 2).1 + 2 - * (pp 3).1 - (pp 1).1, - 2 * (pp 0).2 + 2 * (pp 2).2 + 2 * (pp 3).2 - (pp 1).2), pp 0, pp 2, pp 3]))) := by + BandPackingSymmetryQuadrupleAction .conjugate base = + ![(2 * (pp 0).1 + 2 * (pp 2).1 + 2 * (pp 3).1 - (pp 1).1, + 2 * (pp 0).2 + 2 * (pp 2).2 + 2 * (pp 3).2 - (pp 1).2), pp 0, pp 2, pp 3] := by classical - intro q p hsucc base u pp negOneSucc negTwoSucc - have hss := congrArg (fun z => BandPackingSymmetryQuadrupleAction .conjugate z) hsucc - change BandPackingSymmetryQuadrupleAction .conjugate base = _ - convert hss using 1; - simp only [Nat.succ_eq_add_one, Nat.reduceAdd, BandPackingSymmetryQuadrupleAction, - BandPackingSymmetryCircleAction, Fin.isValue, GaussianReflection, Int.reduceNeg, - BandPackingSymmetryReversesOrientation, ↓reduceIte, neg_zero, Fin.succ_zero_eq_one, - negOneSucc, negTwoSucc, Matrix.cons_val_zero, Matrix.cons_val, Matrix.cons_val_one, - Zsqrtd.re_sub, Zsqrtd.re_add, Zsqrtd.re_mul, Zsqrtd.re_ofNat, Nat.cast_ofNat, - Zsqrtd.im_ofNat, mul_zero, zero_mul, add_zero, Zsqrtd.im_sub, Zsqrtd.im_add, - Zsqrtd.im_mul, neg_sub, Matrix.vecCons_inj, Prod.mk.injEq, sub_left_inj, and_true, pp]; - try { constructor - · ring - · ext <;> simp [] <;> ring } - -private theorem hs'At631 : - ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (![q (0 : Fin (4 - : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p - (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : - ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : - GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p - (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ( - let base : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] - let u := BandPackingSymmetryQuadrupleAction .conjugate base - let pp := BandPackingSymmetryQuadrupleAction .conjugate p - ((-1 : Fin 3).succ = 3) → (((-2 : Fin 3).succ = 2) → (u = ![(2 * (pp 0).1 + 2 * (pp 2).1 + 2 - * (pp 3).1 - (pp 1).1, - 2 * (pp 0).2 + 2 * (pp 2).2 + 2 * (pp 3).2 - (pp 1).2), pp 0, pp 2, pp 3]))) := by - classical - intro q p hsucc base u pp negOneSucc negTwoSucc + intro pp + have negOneSucc : (-1 : Fin 3).succ = 3 := by decide + have negTwoSucc : (-2 : Fin 3).succ = 2 := by decide have hss := congrArg (fun z => BandPackingSymmetryQuadrupleAction .conjugate z) hsucc change BandPackingSymmetryQuadrupleAction .conjugate base = _ convert hss using 1; @@ -834,20 +772,6 @@ private theorem haum'At723 : one_ne_zero, zero_ne_one] at hi hj ⊢ <;> (exfalso; have e := hatMostOneUnit _ _ hi hj; omega) -private theorem hs'At727 : - ∀ (q : Fin 4 → CircleCoordinates), ∀ (p : Fin (4 : ℕ) → CircleCoordinates), (![q (0 : Fin (4 - : ℕ)), q (3 : Fin (4 : ℕ)), q (1 : Fin (4 : ℕ)), q (2 : Fin (4 : ℕ))] = ![((2 : ℤ) * (p - (0 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (2 : Fin (4 : ℕ))).1 + (2 : ℤ) * (p (3 : Fin (4 : - ℕ))).1 - (p (1 : Fin (4 : ℕ))).1, (2 : GaussianInt) * (p (0 : Fin (4 : ℕ))).2 + (2 : - GaussianInt) * (p (2 : Fin (4 : ℕ))).2 + (2 : GaussianInt) * (p (3 : Fin (4 : ℕ))).2 - (p - (1 : Fin (4 : ℕ))).2), p (0 : Fin (4 : ℕ)), p (2 : Fin (4 : ℕ)), p (3 : Fin (4 : ℕ))]) → ( - let u : Fin 4 → CircleCoordinates := ![q 0, q 3, q 1, q 2] - u = ![(2 * (p 0).1 + 2 * (p 2).1 + 2 * (p 3).1 - (p 1).1, - 2 * (p 0).2 + 2 * (p 2).2 + 2 * (p 3).2 - (p 1).2), p 0, p 2, p 3]) := by - classical - intro q p hsucc u - simpa [u] using hsucc - private abbrev hb := ApollonianSuperharmonic.RetainedBoundaryDetails.huAt713 @@ -1089,7 +1013,7 @@ private theorem firstParentCase : have haum' := RetainedBoundaryProof.haum'At397 q hatMostOneUnit have negOneSucc : (-1 : Fin 3).succ = 3 := by decide have negTwoSucc : (-2 : Fin 3).succ = 2 := by decide - have hs' := RetainedBoundaryProof.hs'At413 q p hsucc negOneSucc negTwoSucc + have hs' := RetainedBoundaryProof.conjugateSuccessor q p hsucc have negOne : (-1 : Fin 3) = 2 := by decide have negTwo : (-2 : Fin 3) = 1 := by decide have h0' := RetainedBoundaryDetails.h0'At562 q p h0 negOne negTwo @@ -1185,7 +1109,7 @@ private theorem secondParentCase : have haum' := RetainedBoundaryDetails.haum'At660 q hatMostOneUnit p hsecond have negOneSucc : (-1 : Fin 3).succ = 3 := by decide have negTwoSucc : (-2 : Fin 3).succ = 2 := by decide - have hs' := RetainedBoundaryProof.hs'At528 q p hsucc negOneSucc negTwoSucc + have hs' := RetainedBoundaryProof.conjugateSuccessor base p hsucc have h0' := RetainedBoundaryDetails.h0'At670 q p h0 negOneSucc negTwoSucc have h2' := RetainedBoundaryDetails.h2'At673 q p h3 negOneSucc negTwoSucc have h3' := RetainedBoundaryDetails.h3'At676 q p h2 negOneSucc negTwoSucc @@ -1252,7 +1176,7 @@ private theorem thirdParentCase : have hu := RetainedBoundaryDetails.huAt713 q hq have hnl' := RetainedBoundaryDetails.hnl'At720 q hnoLine have haum' := RetainedBoundaryDetails.haum'At723 q hatMostOneUnit p hthird - have hs' := RetainedBoundaryDetails.hs'At727 q p hsucc + have hs' := hsucc have h0' : p 0 = u 1 := by simpa [u] using h0 have h2' : p 2 = u 2 := by simpa [u] using h2 have h3' : p 3 = u 3 := by simpa [u] using h3 @@ -1278,7 +1202,7 @@ private theorem thirdParentCase : have haum' := RetainedBoundaryDetails.haum'At761 q hatMostOneUnit p hthird have negOneSucc : (-1 : Fin 3).succ = 3 := by decide have negTwoSucc : (-2 : Fin 3).succ = 2 := by decide - have hs' := RetainedBoundaryProof.hs'At631 q p hsucc negOneSucc negTwoSucc + have hs' := RetainedBoundaryProof.conjugateSuccessor base p hsucc have h0' := RetainedBoundaryDetails.h0'At771 q p h0 negOneSucc negTwoSucc have h2' := RetainedBoundaryDetails.h2'At774 q p h3 negOneSucc negTwoSucc have h3' := RetainedBoundaryDetails.h3'At777 q p h2 negOneSucc negTwoSucc diff --git a/LeanPool/ApollonianSuperharmonic/BoundaryFrameJoinGeometry.lean b/LeanPool/ApollonianSuperharmonic/BoundaryFrameJoinGeometry.lean index af8bd9388d..4c4c7c65a9 100644 --- a/LeanPool/ApollonianSuperharmonic/BoundaryFrameJoinGeometry.lean +++ b/LeanPool/ApollonianSuperharmonic/BoundaryFrameJoinGeometry.lean @@ -97,8 +97,8 @@ theorem firstVectorSumReal : (w + x + y = 0) → (w.re + x.re + y.re = 0) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r w x y hvsum - have h := congrArg (fun z : GaussianInt => z.re) hvsum - simpa [w, x, y] using h + simpa only [Zsqrtd.re_add, Zsqrtd.re_zero] using + congrArg (fun z : GaussianInt => z.re) hvsum /-- Shared firstVectorSumImaginary identity for BoundaryFrameJoinGeometry. -/ theorem firstVectorSumImaginary : @@ -117,8 +117,8 @@ theorem firstVectorSumImaginary : (w + x + y = 0) → (w.im + x.im + y.im = 0) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r w x y hvsum - have h := congrArg (fun z : GaussianInt => z.im) hvsum - simpa [w, x, y] using h + simpa only [Zsqrtd.im_add, Zsqrtd.im_zero] using + congrArg (fun z : GaussianInt => z.im) hvsum /-- Shared joinFamily identity for BoundaryFrameJoinGeometry. -/ theorem joinFamily : @@ -310,8 +310,8 @@ theorem secondVectorSumReal : (wa + xa + ya = 0) → (wa.re + xa.re + ya.re = 0) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum - have h := congrArg (fun z : GaussianInt => z.re) hasum - simpa [wa, xa, ya] using h + simpa only [Zsqrtd.re_add, Zsqrtd.re_zero] using + congrArg (fun z : GaussianInt => z.re) hasum /-- Shared secondVectorSumImaginary identity for BoundaryFrameJoinGeometry. -/ theorem secondVectorSumImaginary : @@ -330,8 +330,8 @@ theorem secondVectorSumImaginary : (wa + xa + ya = 0) → (wa.im + xa.im + ya.im = 0) ) := by classical intro C orientation base Rminus Rplus hminus hplus F r wa xa ya hasum - have h := congrArg (fun z : GaussianInt => z.im) hasum - simpa [wa, xa, ya] using h + simpa only [Zsqrtd.im_add, Zsqrtd.im_zero] using + congrArg (fun z : GaussianInt => z.im) hasum end BoundaryFrameJoinGeometry end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/GaussianRealPointProperties.lean b/LeanPool/ApollonianSuperharmonic/GaussianRealPointProperties.lean index cd9332fc67..ca9bb797a5 100644 --- a/LeanPool/ApollonianSuperharmonic/GaussianRealPointProperties.lean +++ b/LeanPool/ApollonianSuperharmonic/GaussianRealPointProperties.lean @@ -58,6 +58,27 @@ theorem injective : dsimp [GaussianRealPoint] at h exact_mod_cast h +/-- The Gaussian embedding preserves subtraction. -/ +theorem sub (x y : GaussianInt) : + GaussianRealPoint (x - y) = GaussianRealPoint x - GaussianRealPoint y := by + rw [sub_eq_add_neg, add, negation, sub_eq_add_neg] + +/-- Scalar multiples of the Gaussian embedding preserve differences. -/ +theorem scaledSub (c : ℝ) (x y : GaussianInt) : + c • GaussianRealPoint x - c • GaussianRealPoint y = + c • GaussianRealPoint (x - y) := by + rw [sub, smul_sub] + +/-- Differences of coordinates relative to a common origin cancel that origin. -/ +theorem relativeDifference {A B C : ℝ × ℝ} {X Y Z : GaussianInt} (c : ℝ) + (ha : A - C = c • GaussianRealPoint X) + (hb : B - C = c • GaussianRealPoint Y) + (hxy : X - Y = Z) : A - B = c • GaussianRealPoint Z := by + calc + _ = (A - C) - (B - C) := (sub_sub_sub_cancel_right A B C).symm + _ = c • GaussianRealPoint (X - Y) := by rw [ha, hb, scaledSub] + _ = _ := by rw [hxy] + end GaussianRealPointProperties end ApollonianSuperharmonic diff --git a/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean b/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean index 6b27994b86..5882a14481 100644 --- a/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean +++ b/LeanPool/ApollonianSuperharmonic/P4112T1LowerNeighbors.lean @@ -25,6 +25,24 @@ namespace ApollonianSuperharmonic -- [TABLET NODE: P4112T1LowerNeighbors] namespace LowerNeighborGeometry +private theorem filterFour {α : Type*} [DecidableEq α] + (S : Finset α) (p : α → Prop) [DecidablePred p] (a b c d chosen : α) + (hchoice : chosen = a ∨ chosen = b ∨ chosen = c ∨ chosen = d) + (hmem : chosen ∈ S) (hp : p chosen) + (ha : a = chosen ∨ ¬ (a ∈ S ∧ p a)) (hb : b = chosen ∨ ¬ (b ∈ S ∧ p b)) + (hc : c = chosen ∨ ¬ (c ∈ S ∧ p c)) (hd : d = chosen ∨ ¬ (d ∈ S ∧ p d)) : + ({a, b, c, d} : Finset α).filter (fun y => y ∈ S ∧ p y) = {chosen} := by + ext y + simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] + constructor + · rintro ⟨rfl | rfl | rfl | rfl, hmem, hpy⟩ + · exact ha.resolve_right (fun hn => hn ⟨hmem, hpy⟩) + · exact hb.resolve_right (fun hn => hn ⟨hmem, hpy⟩) + · exact hc.resolve_right (fun hn => hn ⟨hmem, hpy⟩) + · exact hd.resolve_right (fun hn => hn ⟨hmem, hpy⟩) + · rintro rfl + exact ⟨hchoice, hmem, hp⟩ + private theorem hq1pos : (by classical @@ -288,42 +306,6 @@ private theorem hnotPredAt325 : exact hn omega -private theorem hsetAt338 : - (by - classical - exact - ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - ∀ (x : GaussianInt), (x + ⟨0, 1⟩ ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = - (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re))) → - ((rootDist 0 (x + ⟨0, 1⟩) < rootDist 0 x) → ((x + 1 ∉ (P4062T1InteriorSquare - P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : - Int) ∧ (P.q₁ : Int) ≤ z.re))) → ((x - 1 ∉ (P4062T1InteriorSquare P.q).filter (fun z - => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) - ≤ z.re))) → ((¬ rootDist 0 (x - ⟨0, 1⟩) < rootDist 0 x) → ((({x + 1, x - 1, x + ⟨0, - 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare - P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : - Int) ∧ (P.q₁ : Int) ≤ z.re)) ∧ rootDist 0 y < rootDist 0 x)) = {x + ⟨0, 1⟩}))))) - ) := by - classical - intro P B rootDist x hpred hpredDist hnotRight hnotLeft hnotPred - ext y - simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] - constructor - · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ - · subst y - exact (hnotRight (Finset.mem_filter.mpr hmem)).elim - · subst y - exact (hnotLeft (Finset.mem_filter.mpr hmem)).elim - · exact hy - · subst y - exact (hnotPred hdist).elim - · intro hy - subst y - exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ - private theorem hpredAt376 : (by classical @@ -405,42 +387,6 @@ private theorem hnotDownAt419 : omega · simp [Zsqrtd.im_sub, hr] at hz -private theorem hsetAt429 : - (by - classical - exact - ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - ∀ (x : GaussianInt), (x - 1 ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = - (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re))) → - ((rootDist 0 (x - 1) < rootDist 0 x) → ((¬ rootDist 0 (x + 1) < rootDist 0 x) → ((x + - ⟨0, 1⟩ ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ - (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re))) → ((x - ⟨0, 1⟩ ∉ - (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : - Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re))) → ((({x + 1, x - 1, x + ⟨0, 1⟩, - x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare - P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : - Int) ∧ (P.q₁ : Int) ≤ z.re)) ∧ rootDist 0 y < rootDist 0 x)) = {x - 1}))))) - ) := by - classical - intro P B rootDist x hpred hpredDist hnotRight hnotUp hnotDown - ext y - simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] - constructor - · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ - · subst y - exact (hnotRight hdist).elim - · exact hy - · subst y - exact (hnotUp (Finset.mem_filter.mpr hmem)).elim - · subst y - exact (hnotDown (Finset.mem_filter.mpr hmem)).elim - · intro hy - subst y - exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ - private theorem hpredAt476 : (by classical @@ -563,42 +509,6 @@ private theorem hnotPredAt521 : exact hn omega -private theorem hsetAt535 : - (by - classical - exact - ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - ∀ (x : GaussianInt), (x + ⟨0, 1⟩ ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = - (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))) → - ((rootDist 0 (x + ⟨0, 1⟩) < rootDist 0 x) → ((x + 1 ∉ (P4062T1InteriorSquare - P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : - Int) ∧ z.re ≤ (P.q₁ : Int)))) → ((x - 1 ∉ (P4062T1InteriorSquare P.q).filter (fun z - => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ - : Int)))) → ((¬ rootDist 0 (x - ⟨0, 1⟩) < rootDist 0 x) → ((({x + 1, x - 1, x + ⟨0, - 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare - P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : - Int) ∧ z.re ≤ (P.q₁ : Int))) ∧ rootDist 0 y < rootDist 0 x)) = {x + ⟨0, 1⟩}))))) - ) := by - classical - intro P B rootDist x hpred hpredDist hnotRight hnotLeft hnotPred - ext y - simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] - constructor - · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ - · subst y - exact (hnotRight (Finset.mem_filter.mpr hmem)).elim - · subst y - exact (hnotLeft (Finset.mem_filter.mpr hmem)).elim - · exact hy - · subst y - exact (hnotPred hdist).elim - · intro hy - subst y - exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ - private theorem hpredAt570 : (by classical @@ -720,42 +630,6 @@ private theorem hnotDownAt618 : omega · simp [Zsqrtd.im_sub, hr] at hz -private theorem hsetAt628 : - (by - classical - exact - ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - ∀ (x : GaussianInt), (x + 1 ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = - (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))) → - ((rootDist 0 (x + 1) < rootDist 0 x) → ((¬ rootDist 0 (x - 1) < rootDist 0 x) → ((x + - ⟨0, 1⟩ ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ - (P.q₁ : Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))) → ((x - ⟨0, 1⟩ ∉ - (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : - Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int)))) → ((({x + 1, x - 1, x + ⟨0, 1⟩, - x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare - P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : - Int) ∧ z.re ≤ (P.q₁ : Int))) ∧ rootDist 0 y < rootDist 0 x)) = {x + 1}))))) - ) := by - classical - intro P B rootDist x hpred hpredDist hnotLeft hnotUp hnotDown - ext y - simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] - constructor - · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ - · exact hy - · subst y - exact (hnotLeft hdist).elim - · subst y - exact (hnotUp (Finset.mem_filter.mpr hmem)).elim - · subst y - exact (hnotDown (Finset.mem_filter.mpr hmem)).elim - · intro hy - subst y - exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ - private theorem hpredAt680 : (by classical @@ -863,42 +737,6 @@ private theorem hnotDownAt728 : · simp [Zsqrtd.re_sub] at hz omega -private theorem hsetAt738 : - (by - classical - exact - ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - ∀ (x : GaussianInt), (x + 1 ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.im = - (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im))) → - ((rootDist 1 (x + 1) < rootDist 1 x) → ((¬ rootDist 1 (x - 1) < rootDist 1 x) → ((x + - ⟨0, 1⟩ ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ z.re ≤ - (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im))) → ((x - ⟨0, 1⟩ ∉ - (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : - Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im))) → ((({x + 1, x - 1, x + ⟨0, 1⟩, - x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare - P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : - Int) ∧ (P.q₁ : Int) ≤ z.im)) ∧ rootDist 1 y < rootDist 1 x)) = {x + 1}))))) - ) := by - classical - intro P B rootDist x hpred hpredDist hnotLeft hnotUp hnotDown - ext y - simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] - constructor - · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ - · exact hy - · subst y - exact (hnotLeft hdist).elim - · subst y - exact (hnotUp (Finset.mem_filter.mpr hmem)).elim - · subst y - exact (hnotDown (Finset.mem_filter.mpr hmem)).elim - · intro hy - subst y - exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ - private theorem hpredAt775 : (by classical @@ -982,42 +820,6 @@ private theorem hnotLeftAt817 : · simp [Zsqrtd.re_sub] at hz omega -private theorem hsetAt828 : - (by - classical - exact - ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - ∀ (x : GaussianInt), (x - ⟨0, 1⟩ ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.im = - (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im))) → - ((rootDist 1 (x - ⟨0, 1⟩) < rootDist 1 x) → ((¬ rootDist 1 (x + ⟨0, 1⟩) < rootDist 1 - x) → ((x + 1 ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ - z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im))) → ((x - 1 ∉ - (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : - Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im))) → ((({x + 1, x - 1, x + ⟨0, 1⟩, - x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare - P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : - Int) ∧ (P.q₁ : Int) ≤ z.im)) ∧ rootDist 1 y < rootDist 1 x)) = {x - ⟨0, 1⟩}))))) - ) := by - classical - intro P B rootDist x hpred hpredDist hnotUp hnotRight hnotLeft - ext y - simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] - constructor - · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ - · subst y - exact (hnotRight (Finset.mem_filter.mpr hmem)).elim - · subst y - exact (hnotLeft (Finset.mem_filter.mpr hmem)).elim - · subst y - exact (hnotUp hdist).elim - · exact hy - · intro hy - subst y - exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ - private theorem hpredAt877 : (by classical @@ -1111,42 +913,6 @@ private theorem hnotLeftAt919 : · simp [Zsqrtd.im_sub] at hz omega -private theorem hsetAt929 : - (by - classical - exact - ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - ∀ (x : GaussianInt), (x - ⟨0, 1⟩ ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = - (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))) → - ((rootDist 1 (x - ⟨0, 1⟩) < rootDist 1 x) → ((¬ rootDist 1 (x + ⟨0, 1⟩) < rootDist 1 - x) → ((x + 1 ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ - (P.q₂ : Int) ≤ z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))) → ((x - 1 ∉ - (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ - z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))) → ((({x + 1, x - 1, x + ⟨0, 1⟩, - x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare - P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.im) ∨ (z.im = (P.q₂ : - Int) ∧ (P.q₂ : Int) ≤ z.re)) ∧ rootDist 1 y < rootDist 1 x)) = {x - ⟨0, 1⟩}))))) - ) := by - classical - intro P B rootDist x hpred hpredDist hnotUp hnotRight hnotLeft - ext y - simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] - constructor - · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ - · subst y - exact (hnotRight (Finset.mem_filter.mpr hmem)).elim - · subst y - exact (hnotLeft (Finset.mem_filter.mpr hmem)).elim - · subst y - exact (hnotUp hdist).elim - · exact hy - · intro hy - subst y - exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ - private theorem hpredAt966 : (by classical @@ -1232,42 +998,6 @@ private theorem hnotDownAt1008 : · simp [Zsqrtd.im_sub] at hz omega -private theorem hsetAt1018 : - (by - classical - exact - ∀ (P : FordFareyParameter), - let B := P4062T1RemainderPaths P - let rootDist (j : Fin 2) (z : GaussianInt) : Nat := - (z.re-(B j).2.re).natAbs + (z.im-(B j).2.im).natAbs - ∀ (x : GaussianInt), (x - 1 ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = - (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))) → - ((rootDist 1 (x - 1) < rootDist 1 x) → ((¬ rootDist 1 (x + 1) < rootDist 1 x) → ((x + - ⟨0, 1⟩ ∉ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ - : Int) ≤ z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))) → ((x - ⟨0, 1⟩ ∉ - (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ - z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re))) → ((({x + 1, x - 1, x + ⟨0, 1⟩, - x - ⟨0, 1⟩} : Finset GaussianInt).filter (fun y => y ∈ (P4062T1InteriorSquare - P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.im) ∨ (z.im = (P.q₂ : - Int) ∧ (P.q₂ : Int) ≤ z.re)) ∧ rootDist 1 y < rootDist 1 x)) = {x - 1}))))) - ) := by - classical - intro P B rootDist x hpred hpredDist hnotRight hnotUp hnotDown - ext y - simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton] - constructor - · rintro ⟨hy | hy | hy | hy, hmem, hdist⟩ - · subst y - exact (hnotRight hdist).elim - · exact hy - · subst y - exact (hnotUp (Finset.mem_filter.mpr hmem)).elim - · subst y - exact (hnotDown (Finset.mem_filter.mpr hmem)).elim - · intro hy - subst y - exact ⟨by simp, Finset.mem_filter.mp hpred, hpredDist⟩ - end LowerNeighborGeometry namespace LowerOrderCases @@ -1351,8 +1081,18 @@ private theorem firstPathAscendingCount : have hnotRight := LowerNeighborGeometry.hnotRightAt305 P x hr hhi have hnotLeft := LowerNeighborGeometry.hnotLeftAt315 P x hr hhi have hnotPred := LowerNeighborGeometry.hnotPredAt325 P x hb0root hr hhi - have hset := LowerNeighborGeometry.hsetAt338 P x hpred hpredDist hnotRight hnotLeft - hnotPred + have hset : + ({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im + ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re)) ∧ + rootDist 0 y < rootDist 0 x) = {x + ⟨0, 1⟩} := by + exact LowerNeighborGeometry.filterFour _ (fun y => rootDist 0 y < rootDist 0 x) + (x + 1) (x - 1) (x + ⟨0, 1⟩) (x - ⟨0, 1⟩) (x + ⟨0, 1⟩) + (Or.inr (Or.inr (Or.inl rfl))) hpred hpredDist + (Or.inr (fun h => hnotRight h.1)) + (Or.inr (fun h => hnotLeft h.1)) + (Or.inl rfl) + (Or.inr (fun h => hnotPred h.2)) rw [hset] simp [hb0root, hroot] · by_cases hroot : x = (⟨(P.q₁ : Int), (P.q₂ : Int)⟩ : GaussianInt) @@ -1384,8 +1124,18 @@ private theorem firstPathAscendingCount : have hnotRight := LowerNeighborGeometry.hnotRightAt398 P x hb0root hr hgt have hnotUp := LowerNeighborGeometry.hnotUpAt409 P x hr hgt have hnotDown := LowerNeighborGeometry.hnotDownAt419 P x hr hgt - have hset := LowerNeighborGeometry.hsetAt429 P - x hpred hpredDist hnotRight hnotUp hnotDown + have hset : + ({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im + ≤ (P.q₂ : Int)) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.re)) ∧ + rootDist 0 y < rootDist 0 x) = {x - 1} := by + exact LowerNeighborGeometry.filterFour _ (fun y => rootDist 0 y < rootDist 0 x) + (x + 1) (x - 1) (x + ⟨0, 1⟩) (x - ⟨0, 1⟩) (x - 1) + (Or.inr (Or.inl rfl)) hpred hpredDist + (Or.inr (fun h => hnotRight h.2)) + (Or.inl rfl) + (Or.inr (fun h => hnotUp h.1)) + (Or.inr (fun h => hnotDown h.1)) rw [hset] simp [hb0root, hroot] @@ -1471,8 +1221,18 @@ private theorem firstPathDescendingCount : have hnotRight := LowerNeighborGeometry.hnotRightAt501 P x hr hhi have hnotLeft := LowerNeighborGeometry.hnotLeftAt511 P x hr hhi have hnotPred := LowerNeighborGeometry.hnotPredAt521 P x hb0root hr hhi - have hset := LowerNeighborGeometry.hsetAt535 P x hpred hpredDist hnotRight hnotLeft - hnotPred + have hset : + ({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im + ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int))) ∧ + rootDist 0 y < rootDist 0 x) = {x + ⟨0, 1⟩} := by + exact LowerNeighborGeometry.filterFour _ (fun y => rootDist 0 y < rootDist 0 x) + (x + 1) (x - 1) (x + ⟨0, 1⟩) (x - ⟨0, 1⟩) (x + ⟨0, 1⟩) + (Or.inr (Or.inr (Or.inl rfl))) hpred hpredDist + (Or.inr (fun h => hnotRight h.1)) + (Or.inr (fun h => hnotLeft h.1)) + (Or.inl rfl) + (Or.inr (fun h => hnotPred h.2)) rw [hset] simp [hb0root, hroot] · by_cases hroot : x = (⟨(P.q₁ : Int), (P.q₁ : Int)⟩ : GaussianInt) @@ -1494,8 +1254,18 @@ private theorem firstPathDescendingCount : have hnotLeft := LowerNeighborGeometry.hnotLeftAt594 P x hb0root hr hhi have hnotUp := LowerNeighborGeometry.hnotUpAt608 P x hr hhi have hnotDown := LowerNeighborGeometry.hnotDownAt618 P x hr hhi - have hset := LowerNeighborGeometry.hsetAt628 P - x hpred hpredDist hnotLeft hnotUp hnotDown + have hset : + ({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₁ : Int) ∧ z.im + ≤ (P.q₁ : Int)) ∨ (z.im = (P.q₁ : Int) ∧ z.re ≤ (P.q₁ : Int))) ∧ + rootDist 0 y < rootDist 0 x) = {x + 1} := by + exact LowerNeighborGeometry.filterFour _ (fun y => rootDist 0 y < rootDist 0 x) + (x + 1) (x - 1) (x + ⟨0, 1⟩) (x - ⟨0, 1⟩) (x + 1) + (Or.inl rfl) hpred hpredDist + (Or.inl rfl) + (Or.inr (fun h => hnotLeft h.2)) + (Or.inr (fun h => hnotUp h.1)) + (Or.inr (fun h => hnotDown h.1)) rw [hset] simp [hb0root, hroot] @@ -1577,8 +1347,18 @@ private theorem secondPathAscendingCount : have hnotLeft := LowerNeighborGeometry.hnotLeftAt704 P x hb1root hr hhi have hnotUp := LowerNeighborGeometry.hnotUpAt718 P x hr hhi have hnotDown := LowerNeighborGeometry.hnotDownAt728 P x hr hhi - have hset := LowerNeighborGeometry.hsetAt738 P - x hpred hpredDist hnotLeft hnotUp hnotDown + have hset : + ({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ z.re + ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im)) ∧ + rootDist 1 y < rootDist 1 x) = {x + 1} := by + exact LowerNeighborGeometry.filterFour _ (fun y => rootDist 1 y < rootDist 1 x) + (x + 1) (x - 1) (x + ⟨0, 1⟩) (x - ⟨0, 1⟩) (x + 1) + (Or.inl rfl) hpred hpredDist + (Or.inl rfl) + (Or.inr (fun h => hnotLeft h.2)) + (Or.inr (fun h => hnotUp h.1)) + (Or.inr (fun h => hnotDown h.1)) rw [hset] simp [hb1root, hroot] · by_cases hroot : x = (⟨(P.q₂ : Int), (P.q₁ : Int)⟩ : GaussianInt) @@ -1609,8 +1389,18 @@ private theorem secondPathAscendingCount : have hnotUp := LowerNeighborGeometry.hnotUpAt797 P x hb1root hr hlo have hnotRight := LowerNeighborGeometry.hnotRightAt807 P x harm hr have hnotLeft := LowerNeighborGeometry.hnotLeftAt817 P x harm hr hlo - have hset := LowerNeighborGeometry.hsetAt828 P x hpred hpredDist hnotUp hnotRight - hnotLeft + have hset : + ({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.im = (P.q₁ : Int) ∧ z.re + ≤ (P.q₂ : Int)) ∨ (z.re = (P.q₂ : Int) ∧ (P.q₁ : Int) ≤ z.im)) ∧ + rootDist 1 y < rootDist 1 x) = {x - ⟨0, 1⟩} := by + exact LowerNeighborGeometry.filterFour _ (fun y => rootDist 1 y < rootDist 1 x) + (x + 1) (x - 1) (x + ⟨0, 1⟩) (x - ⟨0, 1⟩) (x - ⟨0, 1⟩) + (Or.inr (Or.inr (Or.inr rfl))) hpred hpredDist + (Or.inr (fun h => hnotRight h.1)) + (Or.inr (fun h => hnotLeft h.1)) + (Or.inr (fun h => hnotUp h.2)) + (Or.inl rfl) rw [hset] simp [hb1root, hroot] @@ -1706,8 +1496,18 @@ private theorem secondPathDescendingCount : have hnotUp := LowerNeighborGeometry.hnotUpAt899 P x hb1root hr hlo have hnotRight := LowerNeighborGeometry.hnotRightAt909 P x hr hlo have hnotLeft := LowerNeighborGeometry.hnotLeftAt919 P x hr hlo - have hset := LowerNeighborGeometry.hsetAt929 P x hpred hpredDist hnotUp hnotRight - hnotLeft + have hset : + ({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ + (P.q₂ : Int) ≤ z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re)) ∧ + rootDist 1 y < rootDist 1 x) = {x - ⟨0, 1⟩} := by + exact LowerNeighborGeometry.filterFour _ (fun y => rootDist 1 y < rootDist 1 x) + (x + 1) (x - 1) (x + ⟨0, 1⟩) (x - ⟨0, 1⟩) (x - ⟨0, 1⟩) + (Or.inr (Or.inr (Or.inr rfl))) hpred hpredDist + (Or.inr (fun h => hnotRight h.1)) + (Or.inr (fun h => hnotLeft h.1)) + (Or.inr (fun h => hnotUp h.2)) + (Or.inl rfl) rw [hset] simp [hb1root, hroot] · by_cases hroot : x = (⟨(P.q₂ : Int), (P.q₂ : Int)⟩ : GaussianInt) @@ -1738,8 +1538,18 @@ private theorem secondPathDescendingCount : have hnotRight := LowerNeighborGeometry.hnotRightAt987 P x hb1root hr hlo have hnotUp := LowerNeighborGeometry.hnotUpAt997 P x harm hr hlo have hnotDown := LowerNeighborGeometry.hnotDownAt1008 P x harm hr - have hset := LowerNeighborGeometry.hsetAt1018 P - x hpred hpredDist hnotRight hnotUp hnotDown + have hset : + ({x + 1, x - 1, x + ⟨0, 1⟩, x - ⟨0, 1⟩} : Finset GaussianInt).filter + (fun y => y ∈ (P4062T1InteriorSquare P.q).filter (fun z => (z.re = (P.q₂ : Int) ∧ + (P.q₂ : Int) ≤ z.im) ∨ (z.im = (P.q₂ : Int) ∧ (P.q₂ : Int) ≤ z.re)) ∧ + rootDist 1 y < rootDist 1 x) = {x - 1} := by + exact LowerNeighborGeometry.filterFour _ (fun y => rootDist 1 y < rootDist 1 x) + (x + 1) (x - 1) (x + ⟨0, 1⟩) (x - ⟨0, 1⟩) (x - 1) + (Or.inr (Or.inl rfl)) hpred hpredDist + (Or.inr (fun h => hnotRight h.2)) + (Or.inl rfl) + (Or.inr (fun h => hnotUp h.1)) + (Or.inr (fun h => hnotDown h.1)) rw [hset] simp [hb1root, hroot] diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean index 8d627aea2d..92575530cf 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1LargestParentRows.lean @@ -2068,10 +2068,12 @@ theorem P4458T1LargestParentRows D hUcent have hMcenter := BoundaryFrameJoinGeometry.minusCentroid C orientation base Rminus Rplus hminus hplus F - have hvsumRe := BoundaryFrameJoinGeometry.firstVectorSumReal C orientation base Rminus Rplus - hminus hplus F hvsum - have hvsumIm := BoundaryFrameJoinGeometry.firstVectorSumImaginary C orientation base Rminus - Rplus hminus hplus F hvsum + have hvsumRe : w.re + x.re + y.re = 0 := by + simpa only [Zsqrtd.re_add, Zsqrtd.re_zero] using + congrArg (fun z : GaussianInt => z.re) hvsum + have hvsumIm : w.im + x.im + y.im = 0 := by + simpa only [Zsqrtd.im_add, Zsqrtd.im_zero] using + congrArg (fun z : GaussianInt => z.im) hvsum have hcenterVector := LargestParentGeometry.hcenterVector C orientation base Rminus Rplus hminus hplus F hvrec hvflip hvsumRe hvsumIm have hcenterRe := congrArg (fun z : GaussianInt => (z.re : ℝ)) hcenterVector @@ -2138,10 +2140,12 @@ theorem P4458T1LargestParentRows hplus F have hFplusSlope := LargestParentGeometry.hFplusSlope C orientation base Rminus Rplus hminus hplus F - have hasumRe := BoundaryFrameJoinGeometry.secondVectorSumReal C orientation base Rminus Rplus - hminus hplus F hasum - have hasumIm := BoundaryFrameJoinGeometry.secondVectorSumImaginary C orientation base Rminus - Rplus hminus hplus F hasum + have hasumRe : wa.re + xa.re + ya.re = 0 := by + simpa only [Zsqrtd.re_add, Zsqrtd.re_zero] using + congrArg (fun z : GaussianInt => z.re) hasum + have hasumIm : wa.im + xa.im + ya.im = 0 := by + simpa only [Zsqrtd.im_add, Zsqrtd.im_zero] using + congrArg (fun z : GaussianInt => z.im) hasum have ha10Re := LargestParentGeometry.ha10Re C orientation base Rminus Rplus hminus hplus F harec have ha10Im := LargestParentGeometry.ha10Im C orientation base Rminus Rplus hminus hplus F harec have ha01Re := LargestParentGeometry.ha01Re C orientation base Rminus Rplus hminus hplus F diff --git a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean index 153f46d1e7..a392398eb8 100644 --- a/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean +++ b/LeanPool/ApollonianSuperharmonic/P4458T1SecondNewerRows.lean @@ -3177,12 +3177,12 @@ private theorem directParentCase : hplus F a p hqB hqD hr1 hr2 rootSlope aSlope hARe have hAIm' := SecondNewerRowsGeometry.hAIm'At435 C orientation base Rminus Rplus hminus hplus F a p hqB hqD hr1 hr2 rootSlope aSlope hAIm - have hasumRe := BoundaryFrameJoinGeometry.secondVectorSumReal C orientation base Rminus Rplus - hminus - hplus F hasum - have hasumIm := BoundaryFrameJoinGeometry.secondVectorSumImaginary C orientation base Rminus - Rplus hminus - hplus F hasum + have hasumRe : wa.re + xa.re + ya.re = 0 := by + simpa only [Zsqrtd.re_add, Zsqrtd.re_zero] using + congrArg (fun z : GaussianInt => z.re) hasum + have hasumIm : wa.im + xa.im + ya.im = 0 := by + simpa only [Zsqrtd.im_add, Zsqrtd.im_zero] using + congrArg (fun z : GaussianInt => z.im) hasum have hasumReR : (wa.re : ℝ) + (xa.re : ℝ) + (ya.re : ℝ) = 0 := by exact_mod_cast hasumRe have hasumImR : (wa.im : ℝ) + (xa.im : ℝ) + (ya.im : ℝ) = 0 := by @@ -3417,10 +3417,12 @@ private theorem recursiveParentCase : have hFminusIm := SecondNewerRowsGeometry.hFminusImAt1002 C orientation base Rminus Rplus hminus hplus F rootA hFminusSlope have hrootNegA : rootNeg = rootA := hrootNegEq.trans hrootAEq.symm - have hasumRe := BoundaryFrameJoinGeometry.secondVectorSumReal C orientation base Rminus Rplus - hminus hplus F hasum - have hasumIm := BoundaryFrameJoinGeometry.secondVectorSumImaginary C orientation base Rminus Rplus - hminus hplus F hasum + have hasumRe : wa.re + xa.re + ya.re = 0 := by + simpa only [Zsqrtd.re_add, Zsqrtd.re_zero] using + congrArg (fun z : GaussianInt => z.re) hasum + have hasumIm : wa.im + xa.im + ya.im = 0 := by + simpa only [Zsqrtd.im_add, Zsqrtd.im_zero] using + congrArg (fun z : GaussianInt => z.im) hasum have hasumReR : (wa.re : ℝ) + (xa.re : ℝ) + (ya.re : ℝ) = 0 := by exact_mod_cast hasumRe have hasumImR : (wa.im : ℝ) + (xa.im : ℝ) + (ya.im : ℝ) = 0 := by @@ -3491,12 +3493,12 @@ theorem P4458T1SecondNewerRows : simpa [I] using (VectorRecursionLaws r hr.1).2.2.2.2 hr 0 |>.1 have haflip : BandVectors.2 (r 0) (r 1) = -I * BandVectors.2 (r 1) (r 0) := by simpa [I] using (VectorRecursionLaws r hr.1).2.2.2.2 hr 0 |>.2 - have hvsumRe := BoundaryFrameJoinGeometry.firstVectorSumReal C orientation base Rminus Rplus - hminus hplus - F hvsum - have hvsumIm := BoundaryFrameJoinGeometry.firstVectorSumImaginary C orientation base Rminus - Rplus hminus hplus - F hvsum + have hvsumRe : w.re + x.re + y.re = 0 := by + simpa only [Zsqrtd.re_add, Zsqrtd.re_zero] using + congrArg (fun z : GaussianInt => z.re) hvsum + have hvsumIm : w.im + x.im + y.im = 0 := by + simpa only [Zsqrtd.im_add, Zsqrtd.im_zero] using + congrArg (fun z : GaussianInt => z.im) hvsum rcases hselectedOcc with ⟨hUband, hUfoot, hUcent⟩ have hUcenter := BoundaryFrameJoinGeometry.selectedCentroid C orientation base Rminus Rplus hminus diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean index d3152a1990..cac5cc1b5e 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameB.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointAlgebra @@ -137,77 +138,6 @@ private theorem hcentR : simpa [y, w, I, r, GaussianRealPoint, Zsqrtd.re_mul, Zsqrtd.im_mul] using h -private theorem hcentJK : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin 3), ∀ (J : ProtoTile), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let w := BandVectors.1 (r 3) (r 2) - let x := BandVectors.1 (r 1) (r 3) - let y := BandVectors.1 (r 2) (r 1) - (-(w - I * w) - (x - I * y - I * (x - I * y)) = (2 : GaussianInt) * y ∧ x - I * y + I * (x - - I * y) + (w - I * w) = (2 : GaussianInt) * I * x ∧ -(x - I * x) - (w - I * w) = y - I * y - ∧ y - I * w + I * (y - I * w) - (w - I * w) = y + I * y ∧ w - I * x - I * (w - I * x) - - (w - I * w) = -I * x - x ∧ -(y - I * y) - (w - I * w) = -I * x + x ∧ y - I * w - I * (y - - I * w) - (y - I * y) = -I * w - w ∧ -(x - I * x) - (y - I * y) = -I * w + w ∧ -(y - I * - y) - (x - I * x) = w - I * w ∧ w - I * x + I * (w - I * x) - (x - I * x) = w + I * w) → ( - let halfPoint : GaussianInt → ℝ × ℝ := - fun z => (1 / 2 : ℝ) • GaussianRealPoint z - (∀ (u : GaussianInt), ∀ (v : GaussianInt), halfPoint u - halfPoint v = halfPoint (u - v)) → - ((TileCentroid J - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * x))) - → ((TileCentroid (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint - (w - I * w)) → (TileCentroid J - TileCentroid (D.tiles a true) = (1 / 2 : ℝ) • - GaussianRealPoint (y - I * y))))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D a J r I w x y vAlg halfPoint - halfPoint_sub hcentJ hcentK - calc - _ = (TileCentroid J - TileCentroid F.tile) - - (TileCentroid (D.tiles a true) - TileCentroid F.tile) := by abel - _ = _ := by - rw [hcentJ, hcentK] - change halfPoint (-(x - I * x)) - halfPoint (w - I * w) = _ - rw [halfPoint_sub, vAlg.2.2.1] - -private theorem hcentRK : - ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ - (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : - P4458T1BoundaryFrame C orientation base Rminus Rplus hminus hplus), ∀ (D : - P4458T1RestrictionFamily F), ∀ (a : Fin 3), - let r : Fin 4 → CircleCoordinates := - ![F.q 0, F.q a.succ, F.q (a + 1).succ, F.q (a + 2).succ] - let I : GaussianInt := ⟨0, 1⟩ - let w := BandVectors.1 (r 3) (r 2) - let x := BandVectors.1 (r 1) (r 3) - let y := BandVectors.1 (r 2) (r 1) - (-(w - I * w) - (x - I * y - I * (x - I * y)) = (2 : GaussianInt) * y ∧ x - I * y + I * (x - - I * y) + (w - I * w) = (2 : GaussianInt) * I * x ∧ -(x - I * x) - (w - I * w) = y - I * y - ∧ y - I * w + I * (y - I * w) - (w - I * w) = y + I * y ∧ w - I * x - I * (w - I * x) - - (w - I * w) = -I * x - x ∧ -(y - I * y) - (w - I * w) = -I * x + x ∧ y - I * w - I * (y - - I * w) - (y - I * y) = -I * w - w ∧ -(x - I * x) - (y - I * y) = -I * w + w ∧ -(y - I * - y) - (x - I * x) = w - I * w ∧ w - I * x + I * (w - I * x) - (x - I * x) = w + I * w) → ( - let halfPoint : GaussianInt → ℝ × ℝ := - fun z => (1 / 2 : ℝ) • GaussianRealPoint z - (∀ (u : GaussianInt), ∀ (v : GaussianInt), halfPoint u - halfPoint v = halfPoint (u - v)) → - ((TileCentroid (D.tiles a true) - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint - (w - I * w)) → ((TileCentroid Rplus - TileCentroid F.tile = (1 / 2 : ℝ) • - GaussianRealPoint ((y - I * w) + I * (y - I * w))) → (TileCentroid Rplus - TileCentroid - (D.tiles a true) = (1 / 2 : ℝ) • GaussianRealPoint (y + I * y))))) := by - classical - intro C orientation base Rminus Rplus hminus hplus F D a r I w x y vAlg halfPoint halfPoint_sub - hcentK hcentR - calc - _ = (TileCentroid Rplus - TileCentroid F.tile) - - (TileCentroid (D.tiles a true) - TileCentroid F.tile) := by abel - _ = _ := by - rw [hcentR, hcentK] - change halfPoint ((y - I * w) + I * (y - I * w)) - - halfPoint (w - I * w) = _ - rw [halfPoint_sub, vAlg.2.2.2.1] - private theorem hslopeJ : ∀ (C : BandCircle), ∀ (orientation : Bool), @@ -598,14 +528,6 @@ private theorem hap : have hf := (h.2.2.2.2 hp 1).2 simpa [I, ya, r, hA, hB] using hf -private theorem halfPoint_sub : - let halfPoint : GaussianInt → ℝ × ℝ := - fun z => (1 / 2 : ℝ) • GaussianRealPoint z - ∀ (u : GaussianInt), ∀ (v : GaussianInt), halfPoint u - halfPoint v = halfPoint (u - v) := by - classical - intro halfPoint u v - apply Prod.ext <;> simp [halfPoint, GaussianRealPoint] <;> ring - private theorem hcentK : ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : @@ -898,7 +820,8 @@ theorem P4536T1AFrameB let halfPoint : GaussianInt → ℝ × ℝ := fun z => (1 / 2 : ℝ) • GaussianRealPoint z have halfPoint_sub (u v : GaussianInt) : - halfPoint u - halfPoint v = halfPoint (u - v) := AFrameBDetails.halfPoint_sub u v + halfPoint u - halfPoint v = halfPoint (u - v) := + GaussianRealPointProperties.scaledSub (1 / 2) u v have hcentJ : TileCentroid J - TileCentroid F.tile = (1 / 2 : ℝ) • GaussianRealPoint (-(x - I * x)) := AFrameBProof.hcentJ C orientation base Rminus Rplus hminus hplus F D a hslot J hcent @@ -910,11 +833,11 @@ theorem P4536T1AFrameB C orientation base Rminus Rplus hminus hplus F a hslot hv vflip have hcentJK : TileCentroid J - TileCentroid (D.tiles a true) = - (1 / 2 : ℝ) • GaussianRealPoint (y - I * y) := AFrameBProof.hcentJK C orientation base - Rminus Rplus hminus hplus F D a J vAlg halfPoint_sub hcentJ hcentK + (1 / 2 : ℝ) • GaussianRealPoint (y - I * y) := + GaussianRealPointProperties.relativeDifference (1 / 2) hcentJ hcentK vAlg.2.2.1 have hcentRK : TileCentroid Rplus - TileCentroid (D.tiles a true) = - (1 / 2 : ℝ) • GaussianRealPoint (y + I * y) := AFrameBProof.hcentRK C orientation base - Rminus Rplus hminus hplus F D a vAlg halfPoint_sub hcentK hcentR + (1 / 2 : ℝ) • GaussianRealPoint (y + I * y) := + GaussianRealPointProperties.relativeDifference (1 / 2) hcentR hcentK vAlg.2.2.2.1 let houter : BandCircle := ⟨⟨p 0, ⟨Or.inl hposA, ⟨p, hp.1, ⟨0, rfl⟩⟩⟩⟩, hposA⟩ have hodoK : TileOdometer (p 0) (D.tiles a true) (D.functions a true) := diff --git a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean index ebfbbb1973..dde10533c6 100644 --- a/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean +++ b/LeanPool/ApollonianSuperharmonic/P4536T1AFrameD.lean @@ -6,6 +6,7 @@ Authors: Wesley Pegden module public import Mathlib.Init +public import LeanPool.ApollonianSuperharmonic.GaussianRealPointProperties public import LeanPool.ApollonianSuperharmonic.P4458T1RestrictionFamily public import LeanPool.ApollonianSuperharmonic.P4536T1EndpointAlgebra @@ -158,25 +159,6 @@ private theorem centK : rw [h] ext <;> simp [GaussianRealPoint, I, Zsqrtd.re_mul, Zsqrtd.im_mul] <;> ring -private theorem halfDiff : - ∀ {X : GaussianInt}, ∀ {Y : GaussianInt}, ∀ {Z : GaussianInt}, (X - Y = Z) → ((1 / 2 : ℝ) • - GaussianRealPoint X - - (1 / 2 : ℝ) • GaussianRealPoint Y = - (1 / 2 : ℝ) • GaussianRealPoint Z) := by - classical - intro X Y Z hxy - have hr := congrArg (fun z : GaussianInt => z.re) hxy - have hi := congrArg (fun z : GaussianInt => z.im) hxy - have hr' : (X.re : ℝ) - (Y.re : ℝ) = (Z.re : ℝ) := by exact_mod_cast (by simpa using hr) - have hi' : (X.im : ℝ) - (Y.im : ℝ) = (Z.im : ℝ) := by exact_mod_cast (by simpa using hi) - apply Prod.ext - · change (1 / 2 : ℝ) * (X.re : ℝ) - (1 / 2 : ℝ) * (Y.re : ℝ) = - (1 / 2 : ℝ) * (Z.re : ℝ) - linarith - · change (1 / 2 : ℝ) * (X.im : ℝ) - (1 / 2 : ℝ) * (Y.im : ℝ) = - (1 / 2 : ℝ) * (Z.im : ℝ) - linarith - private theorem slopeK : ∀ (C : BandCircle), ∀ (orientation : Bool), ∀ (base : ProtoTile), ∀ (Rminus : ProtoTile), ∀ (Rplus : ProtoTile), ∀ (hminus : PartialOdometer), ∀ (hplus : PartialOdometer), ∀ (F : @@ -273,14 +255,6 @@ private theorem reverseQuarterTurn {u v : GaussianInt} (t : GaussianInt) rw [h, ← mul_assoc, neg_mul, ht] simp -private theorem relativeDifference {A B C : ℝ × ℝ} {X Y Z : GaussianInt} - (ha : A - C = (1 / 2 : ℝ) • GaussianRealPoint X) - (hb : B - C = (1 / 2 : ℝ) • GaussianRealPoint Y) - (hxy : X - Y = Z) : A - B = (1 / 2 : ℝ) • GaussianRealPoint Z := by - calc - _ = (A - C) - (B - C) := by abel - _ = _ := by rw [ha, hb]; exact halfDiff hxy - end FrameDiagonalProof theorem P4536T1AFrameD @@ -343,8 +317,8 @@ theorem P4536T1AFrameD have centJ := FrameDiagonalProof.centJ C orientation base Rminus Rplus hminus hplus F D a hslot J hcent have centK := FrameDiagonalProof.centK C orientation base Rminus Rplus hminus hplus F D a - have hcentR := FrameDiagonalProof.relativeDifference centMinus centK hv.2.2.2.2.1 - have hcentJ := FrameDiagonalProof.relativeDifference centJ centK hv.2.2.2.2.2.1 + have hcentR := GaussianRealPointProperties.relativeDifference (1 / 2) centMinus centK hv.2.2.2.2.1 + have hcentJ := GaussianRealPointProperties.relativeDifference (1 / 2) centJ centK hv.2.2.2.2.2.1 let e : GaussianInt := -I have lawsP := VectorRecursionLaws p hp.1 have pflip := (lawsP.2.2.2.2 hp) 2 @@ -392,8 +366,10 @@ theorem P4536T1AFrameD F a hvecJ sJ hJRe hJIm have slopeMinusRoot := FrameDiagonalProof.slopeMinusRoot C orientation base Rminus Rplus hminus hplus F a hparentR hzero ain aflip' - have slopeMinusA := FrameDiagonalProof.relativeDifference slopeMinusRoot slopeK ha.2.2.2.2.1 - have slopeJminusA := FrameDiagonalProof.relativeDifference slopeJ slopeK ha.2.2.2.2.2.1 + have slopeMinusA := + GaussianRealPointProperties.relativeDifference (1 / 2) slopeMinusRoot slopeK ha.2.2.2.2.1 + have slopeJminusA := + GaussianRealPointProperties.relativeDifference (1 / 2) slopeJ slopeK ha.2.2.2.2.2.1 have hodoA : TileOdometer (p 0) (D.tiles a true) (D.functions a true) := by simpa [houterA] using D.odometers a true let G : P4458T1BoundaryFrame C orientation base Rminus J hminus